diff -Nru acl2-6.2/GNUmakefile acl2-6.3/GNUmakefile
--- acl2-6.2/GNUmakefile	2013-06-06 16:31:01.000000000 +0000
+++ acl2-6.3/GNUmakefile	2013-09-29 21:31:26.000000000 +0000
@@ -1,6 +1,6 @@
 #  -*- Fundamental -*- 
 
-# ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+# ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 # Copyright (C) 2013, Regents of the University of Texas
 
 # This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -72,33 +72,10 @@
 #   make regression-everything
 #                    ; Same as make regression, except that target "everything"
 #                    ; is used in community books file, Makefile.
-#   make regression-legacy-fast [DEPRECATED as is books/regression-targets (legacy)]
-#                    ; NOTE: This target was not tested before the v6-2 release.
-#                    ; (WARNING: This target uses variable ACL2, with default value
-#                    ;      "acl2", so it is probably a good idea to run after
-#                    ;      explicitly setting ACL2=<path_to_ACL2>.
-#                    ;      End of warning.)
-#                    ; Certify a substantial portion of the books that
-#                    ; would be certified by `make regression', but
-#                    ; with better parallelism.  We have used this
-#                    ; with option "-j 24" to obtain over a 12x
-#                    ; speedup.  This target assumes that
-#                    ; books/Makefile-fast is up-to-date; if you are
-#                    ; using an "alpha" version, just follow
-#                    ; instructions in books/regression-targets to
-#                    ; update that file first and then update
-#                    ; books/Makefile-fast as follows:
-#                    ;   cd books/
-#                    ;   ./cert.pl -s Makefile-fast --targets regression-targets -b .
 #   make clean-books ; Remove certificate files, object files, log files,
 #                    ; debris, ..., created by `make certify-books',
 #                    ; `make regression', etc.
 
-# Also included are various legacy versions of these targets, which
-# correspond to targets through ACL2 Version  6.1.  For example, target
-# regression-legacy in this file corresponds to target regression in
-# older versions of htis file.
-
 ###############################################################################
 
 #  NOTE:  Users need not read below this line.  Neither should installers of
@@ -111,14 +88,7 @@
 #  Example invocations for CLI implementors:
 
 #   NOTE:  Make large completely recompiles, initializes and
-#   saves.  Consider some of the "fast" and "very-fast" options below if only
-#   part of the system needs to be rebuilt.
-
-#   make very-fast init 
-#                  ; Build the system, recompiling as little as possible
-#                  ; (perhaps don't even recompile TMP1.lisp).
-
-#   make fast init ; Compile as needed, initialize, build saved_acl2
+#   saves.
 
 #   make full      ; A complete recompilation whether needed or not.
 #   make full init ; Completely recompile, initialize and save.
@@ -130,7 +100,6 @@
 #                  ; Note:  Allegro is not always named cl at CLI.  See
 #                  ; ~moore/allegro/runcl for some clues.
 #   make full LISP=lispworks PREFIX=lispworks- ; makes acl2 in lispworks
-#   make copy DIR=targetdir  ; copies all of acl2 to targetdir.  Don't use ~ notation.
 #   make copy-distribution DIR=/stage/ftp/pub/moore/acl2/v2-9/acl2-sources
 #                  ; copies all of acl2 plus books, doc, etc., to the named
 #                  ; directory, as for compiling on another architecture or
@@ -148,15 +117,13 @@
 #                  ; proofs during pass 2.  Does not save an image.  Uses same
 #                  ; flags used to build full-size image.
 
-#  Metering:  If the currently compiled version is unmetered and you wish
-#  it metered, the fastest thing to do is to (push :acl2-metering *features*)
-#  and then yank in and recompile just those definitions that mention
-#  acl2-metering.  However, if you would like to install metering as part
-#  of a system-wide recompilation, you must use the full-meter option below,
-#  rather than the fast-meter option.  If, while running a fully metered
-#  system you wish to do what would otherwise be a make fast but you want
-#  to preserve the metering, use the fast-meter option.  If you want to
-#  get rid of the metering in the compiled code, do make full.
+#  Metering: If the currently compiled version is unmetered and you
+#  wish it metered, the fastest thing to do is to (push :acl2-metering
+#  *features*) and then yank in and recompile just those definitions
+#  that mention acl2-metering.  However, if you would like to install
+#  metering as part of a system-wide recompilation, use the full-meter
+#  option below.  If you want to get rid of the metering in the
+#  compiled code, do make full.
 
 LISP = ccl
 DIR = /tmp
@@ -188,15 +155,32 @@
 	ACL2_SUFFIX := $(ACL2_SUFFIX)r
 endif
 
-# The user may legally edit the following variable, or set it on the command
-# line, only when :acl2-mv-as-values is pushed on to *features*.  In that case,
-# this variable may be set to ":REUSE", as shown in the comment below.  That
-# will cause the use of the existing acl2-proclaims.lisp, which will save one
-# compile and one initialization.  BUT this should only be done if the
-# acl2-proclaims.lisp that would otherwise be generated would be identical to
-# the existing acl2-proclaims.lisp.
-USE_ACL2_PROCLAIMS =
-# USE_ACL2_PROCLAIMS = :REUSE
+# The following variable, ACL2_PROCLAIMS_ACTION, is intended to be
+# user-settable to one of three values, as shown below.  By default,
+# it avoids consideration of file acl2-proclaims.lisp: that file is
+# neither consulted (i.e., reused) nor generated.
+
+ifndef ACL2_PROCLAIMS_ACTION
+
+# Default action: Do not reuse or build acl2-proclaims.lisp.
+ACL2_PROCLAIMS_ACTION := default
+
+# Use the existing acl2-proclaims.lisp for compilation.
+# ACL2_PROCLAIMS_ACTION ?= reuse
+
+# Do compile/initialize twice, in order to build acl2-proclaims.lisp
+# and then consult it before the second compile.
+# ACL2_PROCLAIMS_ACTION ?= generate_and_reuse
+
+endif
+
+# Variable ACL2_PROCLAIMS_ACTION is not to be set by the user.  We use
+# override directives to ensure this.
+ifeq ($(ACL2_PROCLAIMS_ACTION), reuse)
+USE_ACL2_PROCLAIMS := t
+else
+USE_ACL2_PROCLAIMS :=
+endif
 
 # The user may define PREFIX; otherwise it is implicitly the empty string.
 PREFIX = 
@@ -297,7 +281,7 @@
 	echo "(defparameter *acl2-safety* $(ACL2_SAFETY))" >> acl2r.lisp ;\
 	fi
 	if [ "$(ACL2_SIZE)" != "" ] ; then \
-	echo '(or (find-package "ACL2") (#+gcl defpackage:defpackage #-gcl defpackage "ACL2" (:size $(ACL2_SIZE)) (:use)))' >> acl2r.lisp ;\
+	echo '(or (find-package "ACL2") (#+(and gcl (not ansi-cl)) defpackage:defpackage #-(and gcl (not ansi-cl)) defpackage "ACL2" (:size $(ACL2_SIZE)) (:use)))' >> acl2r.lisp ;\
 	fi
 	if [ "$(ACL2_COMPILER_DISABLED)" != "" ] ; then \
 	echo '(DEFPARAMETER *ACL2-COMPILER-ENABLED* NIL)' >> acl2r.lisp ;\
@@ -347,17 +331,6 @@
 	fi
 	@echo "Initialization SUCCEEDED."
 
-.PHONY: fast
-fast:
-	date
-	rm -f workxxx
-	echo '(load "init.lisp")' > workxxx
-	echo '(acl2::quick-compile-acl2 nil)' >> workxxx
-	echo '(acl2::exit-lisp)' >> workxxx
-	${LISP} < workxxx
-	@$(MAKE) check_compile_ok
-	rm -f workxxx
-
 .PHONY: compile-ok
 compile-ok:  
 	date
@@ -368,28 +341,6 @@
 	${LISP} < workxxx
 	rm -f workxxx
 
-.PHONY: very-fast
-very-fast:
-	date
-	rm -f workxxx
-	echo '(load "init.lisp")' > workxxx
-	echo '(acl2::quick-compile-acl2 t)' >> workxxx
-	echo '(acl2::exit-lisp)' >> workxxx
-	${LISP} < workxxx
-	@$(MAKE) check_compile_ok
-	rm -f workxxx
-
-.PHONY: fast-meter
-fast-meter:
-	date
-	rm -f workxxx
-	echo '(load "init.lisp") (push :acl2-metering *features*)' > workxxx
-	echo '(acl2::quick-compile-acl2 nil)' >> workxxx
-	echo '(acl2::exit-lisp)' >> workxxx
-	${LISP} < workxxx
-	@$(MAKE) check_compile_ok
-	rm -f workxxx
-
 .PHONY: check-sum
 check-sum:
 	date
@@ -423,15 +374,6 @@
 	@$(MAKE) check_compile_ok
 	rm -f workxxx
 
-.PHONY: copy
-copy:
-	rm -f workxxx
-	echo '(load "init.lisp")' > workxxx
-	echo '(acl2::copy-acl2 "${DIR}")' >> workxxx
-	echo '(acl2::exit-lisp)' >> workxxx
-	${LISP} < workxxx
-	rm -f workxxx
-
 .PHONY: copy-distribution
 copy-distribution:
 # WARNING: Execute this from an ACL2 source directory.
@@ -472,7 +414,9 @@
 # useful when building a hons or parallel version after a normal version, or
 # vice-versa.
 .PHONY: TAGS!
-TAGS!:  acl2r TAGS
+TAGS!:  acl2r
+	rm -f TAGS
+	$(MAKE) TAGS
 
 .PHONY: move-to-old
 move-to-old:
@@ -488,6 +432,7 @@
 	if [ -f nsaved_acl2.${LISPEXT} ]; then \
 	mv -f nsaved_acl2.${LISPEXT} ${PREFIXsaved_acl2}.${LISPEXT} ; fi
 
+# See Section "PROCLAIMING" in acl2-fns.lisp.
 acl2-proclaims.lisp: ${sources}
 	rm -f acl2-proclaims.lisp
 	rm -f workxxx
@@ -499,12 +444,17 @@
 	${LISP} < workxxx
 	[ -f acl2-proclaims.lisp ]
 
+# If ACL2_PROCLAIMS_ACTION has value generate_and_reuse, then the
+# following target remakes acl2-proclaims.lisp and recompiles, as
+# follows.  The first subsidiary call of $(MAKE) initializes, i.e.,
+# gets ACL2 to LD its own sources.  Then, a second $(MAKE) uses that
+# file of proclaim forms to recompile.
+# See also the Section "PROCLAIMING" in acl2-fns.lisp.
 .PHONY: make-acl2-proclaims
 make-acl2-proclaims:
-	if [ "$(USE_ACL2_PROCLAIMS)" != ":REUSE" ]; then \
-	rm -f acl2-proclaims.lisp; \
+	if [ "$(ACL2_PROCLAIMS_ACTION)" = "generate_and_reuse" ]; then \
 	$(MAKE) acl2-proclaims.lisp; \
-	$(MAKE) full USE_ACL2_PROCLAIMS=t; \
+	$(MAKE) full ACL2_PROCLAIMS_ACTION=reuse; \
 	fi
 
 .PHONY: init
@@ -843,10 +793,10 @@
 clean-books-nonstd:
 ifndef ACL2
 	cd books/nonstd ; \
-	$(MAKE) $(ACL2_IGNORE) ACL2=$(shell pwd)/saved_acl2 clean
+	$(MAKE) $(ACL2_IGNORE) ACL2=$(shell pwd)/saved_acl2 clean clean-links
 else
 	cd books/nonstd ; \
-	$(MAKE) $(ACL2_IGNORE) ACL2=$(ACL2) clean
+	$(MAKE) $(ACL2_IGNORE) ACL2=$(ACL2) clean clean-links
 endif
 
 # This following should be executed inside the acl2-sources directory.
@@ -948,98 +898,3 @@
 else
 	cd books ; $(MAKE) $(ACL2_IGNORE) chk-include-book-worlds ACL2=$(ACL2)
 endif
-
-##########
-### Legacy targets
-### (renamed using "-legacy" and deprecated after ACL2 Version 6.1):
-##########
-
-# Here we provide support for a convenient way to pass -j down to the
-# community books Makefile, for both `make' and cert.pl.  It seems
-# cleanest and perhaps critical that below, when we call in the books
-# directory we do so with an explicit -j, rather than leaving this to
-# the Makefile in the books/ directory.
-export ACL2_HONS_OPT
-ifdef ACL2_JOBS
-# Note: Because of recursive call of make, ACL2_HONS_OPT could
-# ultimately include many -j options.  This anomaly seems harmless, so
-# we leave it for now but may revisit it later.
-ACL2_HONS_OPT += -j$(ACL2_JOBS)
-ACL2_JOBS_OPT := -j $(ACL2_JOBS)
-endif
-
-.PHONY: clean-books-legacy
-clean-books-legacy:
-	cd books ; $(MAKE) -f Makefile.legacy $(ACL2_IGNORE) clean
-
-.PHONY: regression-legacy
-regression-legacy:
-	uname -a
-	cd books ; $(MAKE) -f Makefile.legacy $(ACL2_IGNORE) $(ACL2_JOBS_OPT) all-plus
-
-# For a HONS regression, we do regression-legacy-hons-only first to get the
-# extra parallelism provided by cert.pl.  For regression-legacy-hons-only the
-# default for ACL2 is saved_acl2h in the development directory; for
-# regression-legacy, saved_acl2.  So the user might be happiest simply
-# providing a value for ACL2.
-.PHONY: regression-legacy-hons-only
-regression-legacy-hons-only:
-	uname -a
-	cd books ; $(MAKE) -f Makefile.legacy $(ACL2_IGNORE) hons
-
-.PHONY: regression-legacy-hons
-# For a legacy HONS regression, we do regression-legacy-hons-only
-# first to get the extra parallelism provided by cert.pl.  For
-# regression-legacy-hons-only the default for ACL2 is saved_acl2h in
-# the development directory; for regression-legacy, saved_acl2.  So
-# the user might be happiest simply providing a value for ACL2.
-regression-legacy-hons:
-	$(MAKE) regression-legacy-hons-only
-	$(MAKE) regression-legacy ACL2_CENTAUR=skip ACL2_HONS_REGRESSION=t
-
-.PHONY: clean-books-nonstd-legacy
-clean-books-legacy-nonstd:
-	cd books/nonstd ; $(MAKE) -f Makefile.legacy $(ACL2_IGNORE) clean-nonstd
-
-.PHONY: regression-legacy-nonstd
-regression-legacy-nonstd:
-	uname -a
-	cd books/nonstd ; $(MAKE) -f Makefile.legacy $(ACL2_IGNORE) $(ACL2_JOBS_OPT) all-nonstd
-
-# Warning: We are no longer actively maintaining books/Makefile-fast.
-.PHONY: regression-legacy-fast
-regression-legacy-fast:
-	uname -a
-	cd books ; pwd ; $(MAKE) $(ACL2_IGNORE) $(ACL2_JOBS_OPT) -f Makefile-fast
-
-.PHONY: regression-legacy-fresh regression-legacy-fast-fresh regression-legacy-nonstd-fresh
-regression-legacy-fresh: clean-books-legacy
-	$(MAKE) $(ACL2_IGNORE) regression-legacy
-regression-legacy-hons-fresh: clean-books-legacy
-	$(MAKE) $(ACL2_IGNORE) regression-legacy-hons
-regression-legacy-fast-fresh: clean-books-legacy
-	$(MAKE) $(ACL2_IGNORE) regression-legacy-fast
-regression-legacy-nonstd-fresh: clean-books-legacy-nonstd
-	$(MAKE) $(ACL2_IGNORE) regression-legacy-nonstd
-
-.PHONY: certify-books-legacy
-certify-books-legacy:
-	cd books ; $(MAKE) -f Makefile.legacy $(ACL2_JOBS_OPT) $(ACL2_IGNORE)
-
-# Certify main books from scratch.
-.PHONY: certify-books-legacy-fresh
-certify-books-legacy-fresh: clean-books-legacy
-	$(MAKE) $(ACL2_IGNORE) $(ACL2_JOBS_OPT) certify-books-legacy
-
-# The following allows for a relatively short test, in response to a request
-# from GCL maintainer Camm Maguire.
-.PHONY: certify-books-legacy-short
-certify-books-legacy-short:
-	cd books ; $(MAKE) -f Makefile.legacy $(ACL2_JOBS_OPT) short-test
-
-# Next is a legacy version of a developer target.
-.PHONY: chk-include-book-worlds
-chk-include-book-worlds-legacy:
-	uname -a
-	cd books ; $(MAKE) -f Makefile.legacy $(ACL2_IGNORE) chk-include-book-worlds-top
-
diff -Nru acl2-6.2/TAGS acl2-6.3/TAGS
--- acl2-6.2/TAGS	2013-06-07 04:02:15.000000000 +0000
+++ acl2-6.3/TAGS	2013-09-30 17:38:32.000000000 +0000
@@ -1,8622 +1,8645 @@
 
-acl2.lisp,3673
-(defvar *acl2-compiler-enabled*)67,3198
-(defun acl2-set-character-encoding 305,15257
-(defun our-file-encoding 422,19679
-(defconstant acl2::*the-live-state* 695,30681
-(defvar acl2::*compiling-certified-file* 730,33041
-(defun acl2::defconst-redeclare-error 732,33088
-(defparameter acl2::*safe-mode-verified-p*753,34031
-(defmacro acl2::defconst 762,34324
-(defvar acl2::*copy-of-common-lisp-symbols-from-main-lisp-package*)836,37218
-(defvar acl2::*copy-of-common-lisp-specials-and-constants*)837,37286
-(defvar acl2::*copy-of-acl2-version*)838,37346
-(defconstant acl2::*acl2-files*840,37385
-(defparameter *compiled-file-extension*958,41354
-(defmacro initialize-state-globals 968,41764
-(defconstant *suppress-compile-build-time*1027,44413
-(defparameter *global-package-prefix* 1039,44801
-(defparameter *1*-package-prefix* 1041,44856
-(defun make-global-package 1043,44904
-(defun make-*1*-package 1051,45157
-(defconstant *main-lisp-package*1069,45716
-(defconstant *main-lisp-package-name-raw*1072,45782
-(defparameter acl2::*initial-lisp-symbol-mark*1095,46664
-(defconstant *acl2-package* 1106,47093
-(defmacro with-redefinition-suppressed 1136,48254
-(defmacro with-warnings-suppressed 1172,49605
-(defmacro with-more-warnings-suppressed 1219,51267
-(defmacro with-suppression 1254,52402
-(defconstant acl2::*acl2-status-file*1269,53032
-(defun acl2::check-suitability-for-acl2 1273,53139
-(defun note-compile-ok 1289,53661
-(defvar *lisp-extension* 1320,55199
-(defmacro our-with-compilation-unit 1356,56726
-(defconstant *acl2-read-character-terminators*1385,58048
-(defparameter *acl2-readtable*1420,59372
-(defparameter *host-readtable*1426,59583
-(defun set-new-dispatch-macro-character 1431,59756
-(defun define-sharp-dot 1469,61321
-(defun define-sharp-comma 1475,61417
-(defun define-sharp-atsign 1481,61517
-(defun define-sharp-bang 1487,61623
-(defun define-sharp-u 1493,61725
-(defvar *old-character-reader*1499,61821
-(defun modify-acl2-readtable 1502,61895
-(defvar *reckless-acl2-readtable*1591,64642
-(defvar *load-compiled-verbose* 1608,65168
-(defun load-compiled 1610,65206
-(defun compile-acl2 1861,75188
-(defun no-object-file-or-out-of-date-object-file 1962,79278
-(defun quick-compile-acl2 1970,79611
-(defvar user::*fast-acl2-gcl-build* 2030,81802
-(defun load-acl2 2032,81844
-(defparameter *acl2-panic-exit-status* 2117,85111
-(defun exit-lisp 2119,85156
-(defconstant *slashable-array*2224,89891
-(defconstant *suspiciously-first-numeric-array*2237,90338
-(defconstant *suspiciously-first-hex-array*2248,90674
-(defconstant *base-10-array*2262,91095
-(defconstant *hex-array*2273,91373
-(defconstant *letter-array*2286,91722
-(defmacro suspiciously-first-numeric-array 2300,92201
-(defmacro numeric-array 2305,92366
-(defconstant *char-code-backslash* 2310,92474
-(defconstant *char-code-slash* 2312,92527
-(defconstant *char-code-double-gritch* 2314,92576
-(defconstant *big-n-special-object* 2320,92832
-(defconstant *number-of-return-values*2322,92883
-(defconstant *boole-array*2328,92985
-(defconstant *mo-f* 2366,94352
-(defconstant *mo-h* 2367,94391
-(defconstant *mo-o* 2368,94430
-(defconstant *mf-old-caller* 2373,94523
-(defconstant *mf-start-hons* 2374,94580
-(defconstant *mf-start-pons* 2375,94637
-(defconstant *mf-start-bytes* 2376,94694
-(defconstant *mf-ans* 2377,94753
-(defconstant *mf-ans-p* 2378,94796
-(defconstant *mf-ma* 2379,94843
-(defconstant *mf-args* 2380,94884
-(defconstant *mf-2mmf* 2381,94929
-(defconstant *mf-2mmf-fnn* 2382,94977
-(defconstant *mf-count-loc* 2383,95033
-(defconstant *attached-fn-temp* 2385,95092
-(defvar *debug-prompt-suffix* 2412,96240
-(defun break-level-for-acl2 2414,96354
-
-acl2-fns.lisp,2682
-(defmacro qfuncall 23,881
-(defun acl2-realp 46,1863
-(defun gcl-version-> 62,2406
-(defun gcl-version->=87,3499
-(defvar *do-proclaims*143,6479
-(defmacro defun-one-output 147,6526
-(defun macroexpand-till 155,6769
-(defun get-type-from-dcls 172,7479
-(defun arg-declarations 180,7735
-(defun collect-types 185,7920
-(defun convert-type-to-integer-pair 196,8259
-(defvar *acl2-output-type-abort* 210,8693
-(defun min-integer-* 212,8732
-(defun max-integer-* 217,8838
-(defun max-output-type-for-declare-form 222,8944
-(defun max-output-type-for-declare-form-lst 302,11900
-(defun output-type-for-declare-form-rec 337,13314
-(defun output-type-for-declare-form-rec-list 479,19266
-(defun output-type-for-declare-form 490,19760
-(defun make-defun-declare-form 536,21509
-(defun make-defconst-declare-form 569,22927
-(defun make-defstobj-declare-form 587,23561
-(defmacro eval-or-print 618,24956
-(defun proclaim-form 626,25142
-(defun proclaim-file 660,26391
-(defparameter *comma* 712,28982
-(defparameter *comma-atsign* 716,29148
-(defparameter *backquote-counter* 720,29342
-(defun backquote 727,29674
-(defun backquote-lst 770,31852
-(defun rev1@ 795,32723
-(defun acl2-read-character-string 805,32930
-(defun acl2-character-reader 877,36013
-(defvar *inside-sharp-dot-read* 886,36331
-(defvar *inhibit-sharp-comma-warning* 888,36369
-(defvar *inside-sharp-u-read* 890,36413
-(defun sharp-comma-read 892,36449
-(defun sharp-dot-read 903,36980
-(defun sharp-bang-read 933,38316
-(defun sharp-u-read 956,39289
-(defmacro sharp-atsign-read-er 987,40680
-(defun sharp-atsign-read 993,40935
-(defvar *sharp-reader-array-size*1040,42909
-(defvar *sharp-reader-array*1047,43097
-(defvar *sharp-reader-array-size-multiplier*1050,43169
-(defconstant *sharp-reader-max-array-size*1057,43349
-(defvar *sharp-reader-max-index*1065,43601
-(defun update-sharp-reader-max-index 1078,44268
-(defun reckless-sharp-sharp-read 1107,45453
-(defun reckless-sharp-equal-read 1113,45613
-(defmacro with-reckless-read 1121,45945
-(defun symbol-package-name 1143,46827
-(defmacro gv 1175,48276
-(defun getenv$-raw 1198,49257
-(defun get-os 1221,50080
-(defmacro our-ignore-errors 1230,50294
-(defmacro safe-open 1234,50370
-(defun our-truename 1237,50442
-(defun our-pwd 1303,53317
-(defun cancel-dot-dots 1314,53664
-(defun unix-full-pathname 1322,53982
-(defun our-user-homedir-pathname 1350,54997
-(defun ser-cons-reader-macro 1402,57273
-(defun ser-hons-reader-macro 1408,57550
-(defmacro special-form-or-op-p 1425,58440
-(defvar *startup-package-name* 1432,58664
-(defmacro save-def 1434,58704
-(defun our-function-lambda-expression 1456,59561
-(defmacro defg 1476,60202
-(defmacro defv 1490,60696
-
-acl2-init.lisp,1877
-(defconstant *current-acl2-world-key*306,14371
-(defun system-call 360,16578
-(defun copy-acl2 433,19000
-(defun our-probe-file 450,19515
-(defun copy-distribution 471,20257
-(defun make-tags 639,27883
-(defvar *saved-build-date-lst*)680,30010
-(defvar *saved-mode*)681,30042
-(defconstant *acl2-svn-revision-string*683,30065
-(defun acl2-svn-revision-string 688,30297
-(defvar *saved-string*707,31023
-(defun maybe-load-acl2-init 732,31934
-(defun chmod-executable 738,32132
-(defun saved-build-dates 741,32220
-(defmacro our-with-standard-io-syntax 758,32822
-(defmacro write-exec-file 763,32953
-(defun save-acl2-in-akcl-aux 792,34099
-(defun save-acl2-in-akcl 834,35916
-(defun save-exec-raw 1054,44958
-(defvar *acl2-default-restart-complete* 1059,45168
-(defun fix-default-pathname-defaults 1061,45214
-(defun acl2-default-restart 1085,46046
-(defun cmulisp-restart 1133,47518
-(defun sbcl-restart 1139,47616
-(defun save-acl2-in-lucid 1145,47750
-(defun lispworks-save-exec-aux 1151,47946
-(defun save-acl2-in-lispworks 1245,52256
-(defun save-exec-raw 1254,52590
-(defun save-acl2-in-cmulisp-aux 1262,52782
-(defun save-acl2-in-cmulisp 1305,54522
-(defun save-exec-raw 1314,54839
-(defvar *sbcl-dynamic-space-size*1319,54981
-(defun save-acl2-in-sbcl-aux 1366,57533
-(defun save-acl2-in-sbcl 1445,60955
-(defun save-exec-raw 1461,61593
-(defun save-acl2-in-allegro-aux 1467,61766
-(defun save-acl2-in-allegro 1520,63994
-(defun save-exec-raw 1534,64466
-(defun rc-filename 1538,64601
-(defun write-acl2rc 1541,64666
-(defun save-acl2-in-clisp-aux 1560,65380
-(defun save-acl2-in-clisp 1604,67227
-(defun save-exec-raw 1613,67539
-(defun save-acl2-in-ccl-aux 1618,67678
-(defun save-acl2-in-ccl 1687,70685
-(defun save-exec-raw 1699,71152
-(defun save-acl2 1706,71436
-(defun proclaim-files 1768,73679
-(defun generate-acl2-proclaims 1791,74543
-(defun acl2 1811,75348
-
-akcl-acl2-trace.lisp,340
-(defmacro trace 36,1430
-(defmacro untrace 92,3486
-(defun trace-ppr-gcl 100,3630
-(defun trace-fix-entry-raw 132,4972
-(defun trace-fix-entry 148,5602
-(defun trace-values 163,6141
-(defun trace-values 173,6430
-(defun make-nths 178,6515
-(defun trace-fix-exit-raw 184,6637
-(defun trace-fix-exit 199,7204
-(defun trace-fix-cond 220,8176
-
-allegro-acl2-trace.lisp,341
-(defvar *trace-arglist*)52,2090
-(defvar *trace-values*)54,2116
-(defconst *trace-sublis* 56,2141
-(defun trace-pre-process 101,4371
-(defun trace-entry 129,5368
-(defun trace-values 158,6478
-(defun trace-values 168,6767
-(defun make-nths 173,6852
-(defun trace-exit 179,6974
-(defun traced-fns-lst 215,8449
-(defun trace-process 218,8514
-
-openmcl-acl2-trace.lisp,320
-(defvar *trace-arglist*)56,2188
-(defvar *trace-values*)58,2214
-(defparameter *trace-sublis* 60,2239
-(defun trace-pre-process 66,2516
-(defun trace-entry 101,3869
-(defun trace-values 126,5007
-(defun trace-exit 135,5321
-(defun traced-fns-lst 164,6651
-(defun trace-process 167,6716
-(defun acl2-traced-fns 187,7620
-
-serialize-raw.lisp,1886
-(defparameter *ser-verbose* 269,12198
-(defmacro ser-time? 271,12232
-(defmacro ser-print? 276,12314
-(defmacro ser-write-char 290,12862
-(defmacro ser-write-byte 293,12943
-(defmacro ser-read-char 296,13048
-(defmacro ser-read-byte 301,13275
-(defun ser-encode-magic 304,13373
-(defun ser-decode-magic 311,13607
-(defun ser-encode-nat-fixnum 371,16345
-(defun ser-encode-nat-large 387,16885
-(defmacro ser-encode-nat 405,17568
-(defun ser-decode-nat-large 417,17885
-(defmacro ser-decode-nat-body 435,18544
-(defun ser-decode-nat 469,19951
-(defun ser-encode-rat 498,20874
-(defun ser-decode-rat 504,21070
-(defun ser-encode-complex 533,22164
-(defun ser-decode-complex 538,22310
-(defun ser-encode-str 564,23389
-(defun ser-decode-str 573,23727
-(defstruct ser-decoder605,24863
-(defun ser-encode-nats 624,25485
-(defun ser-decode-and-load-nats 631,25686
-(defun ser-encode-rats 651,26435
-(defun ser-decode-and-load-rats 658,26637
-(defun ser-encode-complexes 677,27321
-(defun ser-decode-and-load-complexes 684,27532
-(defun ser-encode-chars 703,28217
-(defun ser-decode-and-load-chars 710,28421
-(defun ser-encode-strs 729,29094
-(defun ser-decode-and-load-strs 736,29294
-(defun ser-encode-package 780,31261
-(defun ser-decode-and-load-package 789,31570
-(defun ser-encode-packages 817,32914
-(defun ser-decode-and-load-packages 825,33238
-(defun ser-hashtable-init 841,33776
-(defstruct ser-encoder854,34211
-(defmacro ser-see-obj 924,37257
-(defun ser-gather-atoms 934,37510
-(defun ser-make-atom-map 1070,43758
-(defun ser-encode-conses1178,48408
-(defmacro ser-decode-loop 1230,50856
-(defun ser-decode-and-load-conses 1267,52419
-(defun ser-encode-fals 1355,56706
-(defun ser-decode-and-restore-fals 1383,57845
-(defun ser-encode-atoms 1410,59185
-(defun ser-encode-to-stream 1425,59808
-(defun ser-decode-and-load-atoms 1498,62752
-(defun ser-decode-from-stream 1508,63170
-
-axioms.lisp,68220
-(acl2::defconst acl2::*common-lisp-symbols-from-main-lisp-package*81,4294
-(defconst *common-lisp-specials-and-constants*593,26922
-(defconst *stobj-inline-declare*671,31242
-(defmacro make-package-entry 914,42484
-(defmacro find-package-entry 955,44431
-(defmacro package-entry-name 958,44533
-(defmacro package-entry-imports 961,44604
-(defmacro package-entry-hidden-p 964,44679
-(defmacro package-entry-book-path 967,44756
-(defmacro package-entry-defpkg-event-form 970,44835
-(defmacro package-entry-tterm 973,44928
-(defmacro find-non-hidden-package-entry 976,45009
-(defmacro remove-package-entry 981,45202
-(defmacro change-package-entry-hidden-p 984,45313
-(defmacro getprop 994,45683
-(defvar *user-stobj-alist* 1012,46394
-(defparameter *wormholep* 1041,48186
-(defun-one-output replace-bad-lisp-object 1048,48497
-(defun-one-output replace-bad-lisp-object-list 1060,48818
-(defun-one-output wormhole-er 1066,48991
-(defparameter *wormhole-cleanup-form* 1079,49517
-(defstruct (cloaking-device1120,52327
-(defun-one-output cloaked-set-w! 1127,52541
-(defun-one-output assoc-eq-butlast-2 1135,52817
-(defun-one-output assoc-eq-equal-butlast-2 1146,53239
-(defun-one-output push-wormhole-undo-formi 1159,53746
-(defconstant *open-input-channel-key*1283,60510
-(defconstant *open-input-channel-type-key*1289,60725
-(defconstant *open-output-channel-key*1292,60819
-(defconstant *open-output-channel-type-key*1295,60905
-(defconstant *non-existent-stream*1298,61001
-(defmacro live-state-p 1301,61081
-(defvar *acl2-error-p* 1307,61257
-(defun interface-er 1309,61286
-(defun-one-output acl2-numberp 1343,62601
-(defun-one-output binary-+ 1346,62652
-(defun-one-output binary-* 1348,62695
-(defun-one-output unary-- 1350,62738
-(defun-one-output unary-/ 1352,62776
-(defparameter *in-recover-world-flg* 1358,62991
-(defparameter *ever-known-package-alist*1363,63178
-(defparameter *package-alist* 1389,64394
-(defun-one-output find-package-fast 1391,64430
-(defvar **1*-symbol-key* 1397,64630
-(defvar *global-symbol-key* 1399,64690
-(defun global-symbol 1401,64756
-(defun *1*-symbol 1410,65095
-(defun *1*-symbol? 1420,65459
-(defmacro defun-*1* 1432,65940
-(defparameter *defun-overrides* 1435,66013
-(defmacro defun-overrides 1437,66051
-(defmacro defpkg 1452,66623
-(defmacro defuns 1465,67104
-(defmacro defun-std 1470,67234
-(defmacro defuns-std 1478,67460
-(defmacro defthm 1481,67515
-(defmacro defthmd 1485,67579
-(defmacro defthm-std 1490,67669
-(defmacro defaxiom 1494,67737
-(defmacro skip-proofs 1498,67803
-(defmacro deflabel 1501,67839
-(defmacro defdoc 1505,67905
-(defmacro deftheory 1509,67969
-(defun-one-output stobj-initial-statep-arr 1513,68036
-(defun-one-output stobj-initial-statep-entry 1518,68209
-(defun-one-output stobj-initial-statep1 1548,69129
-(defun-one-output stobj-initial-statep 1556,69520
-(defun remove-stobj-inline-declare 1570,70103
-(defun congruent-stobj-rep-raw 1577,70314
-(defmacro defstobj 1589,70699
-(defmacro value-triple 1715,76196
-(defmacro verify-termination-boot-strap 1719,76266
-(defmacro verify-guards 1723,76353
-(defmacro in-theory 1727,76424
-(defmacro in-arithmetic-theory 1731,76491
-(defmacro regenerate-tau-database 1735,76569
-(defmacro push-untouchable 1739,76650
-(defmacro remove-untouchable 1743,76724
-(defmacro set-body 1747,76800
-(defmacro table 1751,76866
-(defmacro encapsulate 1762,77243
-(defparameter *inside-include-book-fn*1805,79047
-(defmacro include-book 1816,79497
-(defmacro certify-book 1830,80064
-(defmacro local 1841,80565
-(defmacro defchoose 1845,80616
-(defmacro mutual-recursion 1855,81031
-(defmacro make-event 1858,81092
-(deflabel programming1876,82014
-(deflabel acl2-built-ins1893,82635
-(deflabel miscellaneous1909,83346
-(defconst *standard-co* 1923,83721
-(defconst *standard-oi* 1925,83797
-(defconst *standard-ci* 1927,83868
-(defconst nil 1949,84323
-(defconst t 1957,84491
-(defun insist 1963,84644
-(defun iff 1972,84871
-(defun xor 1987,85263
-(defun eq 2002,85631
-(defun booleanp 2029,86749
-(defthm iff-is-an-equivalence2051,87339
-(defun implies 2059,87554
-(defthm iff-implies-equal-implies-12074,87928
-(defthm iff-implies-equal-implies-22079,88077
-(defun not 2085,88243
-(defthm iff-implies-equal-not2102,88659
-(defun hide 2107,88790
-(defun rewrite-equiv 2213,93435
-(defmacro real/rationalp 2227,93921
-(defmacro complex/complex-rationalp 2245,94545
-(defun true-listp 2267,95355
-(defun list-macro 2283,95745
-(defmacro list 2292,95946
-(defun and-macro 2307,96350
-(defmacro and 2318,96582
-(defun or-macro 2334,97025
-(defmacro or 2346,97279
-(defmacro - 2389,98378
-(defthm booleanp-compound-recognizer2434,100239
-(defun integer-abs 2448,100734
-(defun xxxjoin 2454,100843
-(defmacro + 2473,101364
-(defun-one-output len2 2484,101623
-(defun len1 2489,101733
-(defun len 2518,103030
-(defun length 2547,103822
-(defun-one-output complex-rationalp 2571,104466
-(defun acl2-count 2574,104523
-(defun cond-clausesp 2629,106670
-(defun cond-macro 2638,106926
-(defmacro cond 2665,107923
-(defun eqlablep 2687,108648
-(defthm eqlablep-recog2711,109526
-(defun eqlable-listp 2720,109727
-(defun eql 2738,110210
-(defun atom 2761,110928
-(defun make-character-list 2780,111391
-(defun eqlable-alistp 2802,111974
-(defun alistp 2820,112524
-(defthm alistp-forward-to-true-listp2836,112917
-(defthm eqlable-alistp-forward-to-alistp2841,113039
-(defun acons 2847,113186
-(defun endp 2866,113759
-(defmacro caar 2890,114478
-(defmacro cadr 2899,114668
-(defmacro cdar 2908,114858
-(defmacro cddr 2917,115048
-(defmacro caaar 2926,115238
-(defmacro caadr 2935,115431
-(defmacro cadar 2944,115624
-(defmacro caddr 2953,115817
-(defmacro cdaar 2962,116010
-(defmacro cdadr 2971,116203
-(defmacro cddar 2980,116396
-(defmacro cdddr 2989,116589
-(defmacro caaaar 2998,116782
-(defmacro caaadr 3007,116978
-(defmacro caadar 3016,117174
-(defmacro caaddr 3025,117370
-(defmacro cadaar 3034,117566
-(defmacro cadadr 3043,117762
-(defmacro caddar 3052,117958
-(defmacro cadddr 3061,118154
-(defmacro cdaaar 3070,118350
-(defmacro cdaadr 3079,118546
-(defmacro cdadar 3088,118742
-(defmacro cdaddr 3097,118938
-(defmacro cddaar 3106,119134
-(defmacro cddadr 3115,119330
-(defmacro cdddar 3124,119526
-(defmacro cddddr 3133,119722
-(defun null 3142,119918
-(defun symbol-listp 3160,120430
-(defthm symbol-listp-forward-to-true-listp3176,120848
-(defun symbol-doublet-listp 3181,120982
-(defun reverse-strip-cars 3308,125508
-(defun strip-cars 3314,125697
-(defun reverse-strip-cdrs 3339,126447
-(defun strip-cdrs 3345,126636
-(defmacro let-mbe 3369,127377
-(defun return-last 3375,127507
-(defmacro return-last 3889,149626
-(defmacro mbe1-raw 3937,151760
-(defmacro mbe1 3945,151962
-(defmacro must-be-equal 3964,152530
-(defmacro mbe 3992,153792
-(defmacro mbt 4135,159815
-(defdoc equality-variants4238,163986
-(defdoc equality-variants-details4351,169641
-(defun member-eq-exec 4534,176537
-(defun member-eql-exec 4542,176803
-(defun member-equal 4550,177074
-(defmacro member-eq 4559,177376
-(defthm member-eq-exec-is-member-equal4562,177436
-(defthm member-eql-exec-is-member-equal4566,177536
-(defmacro member 4571,177655
-(defun subsetp-eq-exec 4626,179721
-(defun subsetp-eql-exec 4637,180080
-(defun subsetp-equal 4649,180430
-(defmacro subsetp-eq 4660,180785
-(defthm subsetp-eq-exec-is-subsetp-equal4663,180843
-(defthm subsetp-eql-exec-is-subsetp-equal4667,180947
-(defmacro subsetp 4672,181070
-(defun symbol-alistp 4723,183024
-(defthm symbol-alistp-forward-to-eqlable-alistp4740,183525
-(defun assoc-eq-exec 4747,183678
-(defun assoc-eql-exec 4755,183965
-(defun assoc-equal 4763,184257
-(defmacro assoc-eq 4772,184573
-(defthm assoc-eq-exec-is-assoc-equal4775,184631
-(defthm assoc-eql-exec-is-assoc-equal4779,184727
-(defmacro assoc 4784,184842
-(defun assoc-eq-equal-alistp 4837,186953
-(defun assoc-eq-equal 4845,187208
-(defmacro <=4865,187955
-(defun = =
4880,188287
-(defun /=4905,188941
-(defmacro > 4929,189644
-(defmacro >=4944,189948
-(deflabel zero-test-idioms4958,190266
-(defmacro int=5127,198679
-(defun zp 5149,199424
-(defun-one-output zp 5189,200674
-(defthm zp-compound-recognizer5193,200743
-(defthm zp-open5208,201225
-(defun zip 5235,202087
-(defun-one-output zip 5275,203263
-(defthm zip-compound-recognizer5277,203299
-(defthm zip-open5286,203494
-(defun nth 5295,203702
-(defun char 5322,204455
-(defun proper-consp 5346,205187
-(defun improper-consp 5361,205580
-(defmacro * 5378,206039
-(defun conjugate 5407,206704
-(defmacro prog2$ 5428,207255
-(deflabel Other5505,210174
-(deflabel acl2-help5515,210476
-(defmacro ec-call1-raw 5528,210903
-(defmacro ec-call1 5562,212603
-(defmacro ec-call 5570,212878
-(defmacro non-exec 5717,218706
-(defmacro / 5815,221759
-(defaxiom closure5853,222656
-(defaxiom Associativity-of-+5860,222813
-(defaxiom Commutativity-of-+5863,222882
-(defun fix 5866,222939
-(defaxiom Unicity-of-05886,223441
-(defaxiom Inverse-of-+5890,223501
-(defaxiom Associativity-of-*5893,223550
-(defaxiom Commutativity-of-*5896,223619
-(defaxiom Unicity-of-15899,223676
-(defaxiom Inverse-of-*5903,223736
-(defaxiom Distributivity5908,223863
-(defaxiom <-on-others5912,223943
-(defaxiom Zero5917,224032
-(defaxiom Trichotomy5921,224085
-(defaxiom Positive5933,224355
-(defaxiom Rational-implies15943,224636
-(defaxiom Rational-implies25950,224835
-(defaxiom integer-implies-rational5958,225068
-(defaxiom rational-implies-real5963,225189
-(defaxiom complex-implies15969,225338
-(defaxiom complex-definition5976,225522
-(defaxiom nonzero-imagpart5987,225859
-(defaxiom realpart-imagpart-elim5992,225990
-(defaxiom realpart-complex6001,226277
-(defaxiom imagpart-complex6009,226507
-(defthm complex-equal6017,226731
-(defun force 6036,227439
-(defconst *force-xnume*6165,234578
-(defun immediate-force-modep 6172,234699
-(defconst *immediate-force-modep-xnume*6221,236604
-(defun case-split 6224,236668
-(defmacro disable-forcing 6278,238751
-(defmacro enable-forcing 6301,239498
-(defmacro disable-immediate-force-modep 6326,240296
-(defmacro enable-immediate-force-modep 6352,241234
-(defun synp 6378,242158
-(defmacro syntaxp 6414,243804
-(deflabel syntaxp-examples6638,254511
-(defmacro bind-free 6841,261023
-(deflabel bind-free-examples7063,270825
-(defun extra-info 7245,277567
-(defconst *extra-info-fn*7252,277729
-(deflabel rule-classes7267,278401
-(defun tau-system 7560,296049
-(defconst *tau-status-boot-strap-settings*8002,316069
-(defconst *tau-system-xnume*8021,317052
-(defconst *tau-acl2-numberp-pair* 8025,317177
-(defconst *tau-integerp-pair*8026,317232
-(defconst *tau-rationalp-pair*8031,317351
-(defconst *tau-natp-pair*8036,317473
-(defconst *tau-posp-pair*8041,317582
-(defconst *tau-minusp-pair*8046,317691
-(defconst *tau-booleanp-pair*8051,317806
-(defaxiom nonnegative-product8075,318775
-(defaxiom Integer-08105,319771
-(defaxiom Integer-18109,319828
-(defaxiom Integer-step8113,319885
-(defaxiom Lowest-Terms8119,320027
-(defthm basic-tau-rules8147,321073
-(defaxiom car-cdr-elim8200,322909
-(defaxiom car-cons 8205,323022
-(defaxiom cdr-cons 8207,323070
-(defaxiom cons-equal8209,323118
-(defaxiom booleanp-characterp8222,323523
-(defaxiom characterp-page8226,323603
-(defaxiom characterp-tab8230,323673
-(defaxiom characterp-rubout8234,323741
-(defun no-duplicatesp-eq-exec 8240,323833
-(defun no-duplicatesp-eql-exec 8246,324022
-(defun no-duplicatesp-equal 8252,324211
-(defmacro no-duplicatesp-eq 8258,324397
-(defthm no-duplicatesp-eq-exec-is-no-duplicatesp-equal8261,324464
-(defthm no-duplicatesp-eql-exec-is-no-duplicatesp-equal8265,324592
-(defmacro no-duplicatesp 8269,324722
-(defun chk-no-duplicatesp 8321,326621
-(defun r-eqlable-alistp 8329,326799
-(defun r-symbol-alistp 8349,327388
-(defun rassoc-eq-exec 8368,327932
-(defun rassoc-eql-exec 8376,328223
-(defun rassoc-equal 8384,328519
-(defmacro rassoc-eq 8393,328838
-(defthm rassoc-eq-exec-is-rassoc-equal8396,328902
-(defthm rassoc-eql-exec-is-rassoc-equal8400,329010
-(defmacro rassoc 8405,329137
-(defconst *standard-chars*8461,331479
-(defun standard-char-p 8471,331948
-(defun standard-char-listp 8497,332734
-(defun character-listp 8519,333336
-(defthm character-listp-forward-to-eqlable-listp8535,333757
-(defthm standard-char-listp-forward-to-character-listp8540,333903
-(defaxiom coerce-inverse-18545,334061
-(defaxiom coerce-inverse-28574,335093
-(defaxiom character-listp-coerce8584,335394
-(defun string 8616,336824
-(defun alpha-char-p 8654,338109
-(defun upper-case-p 8682,339069
-(defun lower-case-p 8711,340112
-(defun char-upcase 8740,341154
-(defun char-downcase 8796,343118
-(defthm lower-case-p-char-downcase8851,345133
-(defthm upper-case-p-char-upcase8856,345280
-(defthm lower-case-p-forward-to-alpha-char-p8861,345423
-(defthm upper-case-p-forward-to-alpha-char-p8867,345598
-(defthm alpha-char-p-forward-to-characterp8873,345773
-(defthm characterp-char-downcase8878,345907
-(defthm characterp-char-upcase8882,346010
-(defun string-downcase1 8891,346335
-(defthm character-listp-string-downcase-18900,346614
-(defun string-downcase 8904,346716
-(defun string-upcase1 8931,347696
-(defthm character-listp-string-upcase1-18940,347969
-(defun string-upcase 8944,348068
-(defun our-digit-char-p 8965,348783
-(defmacro digit-char-p 9038,351034
-(defun char-equal 9061,351934
-(defun atom-listp 9085,352726
-(defthm atom-listp-forward-to-true-listp9103,353186
-(defthm eqlable-listp-forward-to-atom-listp9108,353316
-(defun good-atom-listp 9113,353452
-(defthm good-atom-listp-forward-to-atom-listp9137,354167
-(defthm characterp-nth9142,354307
-(defun ifix 9148,354459
-(defun rfix 9167,354972
-(defun realfix 9196,356026
-(defun nfix 9215,356553
-(defun string-equal1 9236,357117
-(defun string-equal 9261,358040
-(defun standard-string-alistp 9288,359024
-(defthm standard-string-alistp-forward-to-alistp9309,359740
-(defun assoc-string-equal 9314,359886
-(defdoc e0-ordinalp9350,361212
-(defdoc e0-ord-<9367,362014
-(defun natp 9384,362830
-(defthm natp-compound-recognizer9403,363484
-(defun posp 9409,363626
-(defthm posp-compound-recognizer9426,364205
-(defun o-finp 9432,364346
-(defmacro o-infp 9447,364837
-(defun o-first-expt 9457,365056
-(defun o-first-coeff 9477,365743
-(defun o-rst 9497,366451
-(defun o<g 9514,367111
-(defun o< 9526,367377
-(defmacro o> 9601,371170
-(defmacro o<=9610,371366
-(defmacro o>=9619,371583
-(defun o-p 9628,371803
-(defthm o-p-implies-o<g9813,378888
-(defun make-ord 9819,378974
-(defun list*-macro 9858,380361
-(defmacro list* 9868,380638
-(defmacro throw-without-attach 9887,381111
-(defvar *aokp*9894,381346
-(defmacro aokp 9901,381518
-(defvar *attached-fn-called* 9905,381555
-(defmacro update-attached-fn-called 9908,381597
-(defmacro throw-or-attach 9912,381715
-(defun throw-or-attach-call 9940,382832
-(defun null-body-er 9984,384651
-(defconst *main-lisp-package-name*10006,385782
-(defconst *initial-known-package-alist*10021,386467
-(defaxiom stringp-symbol-package-name10042,387484
-(defaxiom symbolp-intern-in-package-of-symbol10046,387595
-(defaxiom symbolp-pkg-witness10050,387724
-(defparameter *ld-level*10055,387836
-(defvar *hard-error-returns-nilp* 10088,389654
-(defun-one-output throw-raw-ev-fncall 10091,389711
-(defun hard-error 10112,390499
-(defun illegal 10229,395947
-(defmacro intern 10297,398756
-(defmacro intern$ 10364,401754
-(defun keywordp 10385,402457
-(defthm keywordp-forward-to-symbolp10414,403259
-(defaxiom intern-in-package-of-symbol-symbol-name10419,403379
-(defthm symbol-package-name-of-symbol-is-not-empty-string10432,404039
-(defconst *pkg-witness-name* 10448,404834
-(defaxiom symbol-name-pkg-witness10450,404884
-(defaxiom symbol-package-name-pkg-witness-name10454,404995
-(defun member-symbol-name 10471,405657
-(defthm symbol-equality10480,405930
-(defaxiom symbol-name-intern-in-package-of-symbol10500,406601
-(defaxiom symbol-package-name-intern-in-package-of-symbol10505,406798
-(defaxiom intern-in-package-of-symbol-is-identity10514,407160
-(defaxiom symbol-listp-pkg-imports10525,407567
-(defaxiom no-duplicatesp-eq-pkg-imports10529,407712
-(defaxiom completion-of-pkg-imports10533,407819
-(defaxiom acl2-input-channel-package10546,408222
-(defaxiom acl2-output-channel-package10550,408319
-(defaxiom acl2-package10554,408418
-(defaxiom keyword-package10558,408528
-(defaxiom string-is-not-circular10566,408767
-(defaxiom nil-is-not-circular10574,409096
-(defun-one-output intern-in-package-of-symbol 10609,410744
-(defdoc pkg-imports10646,412601
-(defun-one-output pkg-imports 10702,414978
-(defdoc pkg-witness10710,415344
-(defun-one-output pkg-witness 10727,416084
-(defun binary-append 10745,416780
-(defmacro append 10764,417260
-(defthm true-listp-append10785,418087
-(defthm standard-char-listp-append10815,418947
-(defthm character-listp-append10822,419220
-(defthm append-to-nil10828,419417
-(defmacro concatenate 10834,419539
-(defun string-append 10889,421869
-(defun string-listp 10925,423082
-(defun string-append-lst 10944,423483
-(defmacro 1+ 10957,423845
-(defmacro 1- 10971,424107
-(defun remove-eq-exec 10986,424362
-(defun remove-eql-exec 10995,424663
-(defun remove-equal 11004,424970
-(defmacro remove-eq 11014,425302
-(defthm remove-eq-exec-is-remove-equal11017,425362
-(defthm remove-eql-exec-is-remove-equal11021,425462
-(defmacro remove 11026,425581
-(defun remove1-eq-exec 11084,427692
-(defun remove1-eql-exec 11093,427976
-(defun remove1-equal 11102,428265
-(defmacro remove1-eq 11109,428458
-(defthm remove1-eq-exec-is-remove1-equal11112,428520
-(defthm remove1-eql-exec-is-remove1-equal11116,428624
-(defmacro remove1 11120,428730
-(deflabel pairlis11173,430779
-(defun pairlis$ 11183,431019
-(defun remove-duplicates-eq-exec 11211,432023
-(defun remove-duplicates-eql-exec 11218,432260
-(defun remove-duplicates-equal 11225,432498
-(defmacro remove-duplicates-eq 11232,432730
-(defthm remove-duplicates-eq-exec-is-remove-duplicates-equal11235,432803
-(defthm remove-duplicates-eql-exec-is-remove-duplicates-equal11239,432943
-(defmacro remove-duplicates-logic 11243,433085
-(defmacro remove-duplicates 11251,433303
-(defthm character-listp-remove-duplicates11323,436350
-(deflabel events11332,436707
-(deflabel documentation11364,438302
-(deflabel history11561,446783
-(defmacro first 11588,447956
-(defmacro second 11597,448133
-(defmacro third 11606,448313
-(defmacro fourth 11615,448492
-(defmacro fifth 11624,448674
-(defmacro sixth 11633,448866
-(defmacro seventh 11642,449059
-(defmacro eighth 11651,449257
-(defmacro ninth 11660,449454
-(defmacro tenth 11669,449661
-(defmacro rest 11678,449869
-(defun identity 11692,450156
-(defun revappend 11706,450455
-(defthm character-listp-revappend11740,451411
-(defun reverse 11751,451755
-(defdoc switches-parameters-and-modes11774,452402
-(defconst *valid-output-names*11783,452731
-(defun set-difference-eq-exec 11789,452888
-(defun set-difference-eql-exec 11799,453298
-(defun set-difference-equal 11809,453710
-(defmacro set-difference-eq 11817,454012
-(defthm set-difference-eq-exec-is-set-difference-equal11820,454089
-(defthm set-difference-eql-exec-is-set-difference-equal11824,454225
-(defmacro set-difference$ 11828,454363
-(defun listp 11886,456757
-(defconst *summary-types*11906,457250
-(defun with-output-fn 11909,457354
-(defun last 12070,464561
-(defun first-n-ac 12099,465248
-(defun take 12107,465503
-(defun butlast 12155,467001
-(defmacro with-output 12196,468250
-(defmacro with-output 12200,468324
-(defun mutual-recursion-guardp 12377,475833
-(defun collect-cadrs-when-car-eq 12386,476202
-(defmacro value 12394,476513
-(defun value-triple-fn 12400,476589
-(defmacro value-triple 12427,477729
-(defmacro assert-event 12469,479573
-(defun xd-name 12514,481602
-(defun defund-name-list 12525,481949
-(defun throw-nonexec-error 12538,482395
-(defun defun-nx-fn 12582,483909
-(defmacro defun-nx 12596,484429
-(defmacro defund-nx 12672,487542
-(defun update-mutual-recursion-for-defun-nx-1 12678,487744
-(defun update-mutual-recursion-for-defun-nx 12693,488333
-(defmacro mutual-recursion 12702,488652
-(defun pseudo-termp 12841,494279
-(defun pseudo-term-listp 12924,498473
-(defthm pseudo-term-listp-forward-to-true-listp12932,498665
-(defun pseudo-term-list-listp 12943,498957
-(defun add-to-set-eq-exec 12954,499192
-(defun add-to-set-eql-exec 12961,499422
-(defun add-to-set-equal 12968,499652
-(defmacro add-to-set-eq 12981,500087
-(defmacro add-to-set-eql 12986,500242
-(defthm add-to-set-eq-exec-is-add-to-set-equal12989,500312
-(defthm add-to-set-eql-exec-is-add-to-set-equal12993,500432
-(defmacro add-to-set 13001,500706
-(defmacro variablep 13053,502848
-(defmacro nvariablep 13055,502889
-(defmacro fquotep 13057,502932
-(defun quotep 13059,502989
-(defconst *t* 13064,503083
-(defconst *nil* 13065,503116
-(defconst *0* 13066,503153
-(defconst *1* 13067,503186
-(defconst *-1* 13068,503219
-(defun kwote 13070,503255
-(defun kwote-lst 13099,504085
-(defmacro unquote 13114,504540
-(defmacro ffn-symb 13116,504579
-(defun fn-symb 13118,504618
-(defmacro fargs 13125,504747
-(defun all-vars1 13129,504802
-(defun all-vars1-lst 13138,505103
-(defun all-vars 13152,505538
-(defmacro translate-and-test 13197,507884
-(defun intersectp-eq-exec 13265,511395
-(defun intersectp-eql-exec 13274,511726
-(defun intersectp-equal 13283,512058
-(defmacro intersectp-eq 13290,512285
-(defthm intersectp-eq-exec-is-intersectp-equal13293,512349
-(defthm intersectp-eql-exec-is-intersectp-equal13297,512465
-(defmacro intersectp 13301,512583
-(defun make-fmt-bindings 13351,514483
-(defmacro msg 13360,514858
-(defun check-vars-not-free-test 13376,515569
-(defmacro check-vars-not-free 13384,515875
-(defun er-progn-fn 13400,516454
-(defmacro er-progn 13424,517453
-(defun er-progn-fn@par 13477,519410
-(defmacro er-progn@par 13500,520365
-(defun legal-case-clausesp 13514,520632
-(defun case-test 13530,521150
-(defun case-list 13535,521307
-(defun case-list-check 13547,521730
-(defmacro case 13564,522439
-(defun position-ac-eq-exec 13631,524059
-(defun position-ac-eql-exec 13642,524420
-(defun position-equal-ac 13653,524786
-(defmacro position-ac-equal 13667,525242
-(defmacro position-eq-ac 13671,525375
-(defmacro position-ac-eq 13679,525620
-(defthm position-ac-eq-exec-is-position-equal-ac13682,525705
-(defthm position-ac-eql-exec-is-position-equal-ac13686,525843
-(defmacro position-ac 13690,525983
-(defun position-eq-exec 13708,526638
-(defun position-eql-exec 13714,526863
-(defun position-equal 13723,527208
-(defmacro position-eq 13732,527539
-(defthm position-eq-exec-is-position-equal13735,527609
-(defthm position-eql-exec-is-position-equal13740,527777
-(defmacro position 13745,527914
-(defun nonnegative-integer-quotient 13799,530108
-(defun true-list-listp 13835,531328
-(defthm true-list-listp-forward-to-true-listp13852,531853
-(defun legal-let*-p 13857,531993
-(defun well-formed-type-decls-p 13896,534019
-(defun symbol-list-listp 13908,534426
-(defun get-type-decls 13914,534602
-(defun let*-macro 13925,535114
-(defun collect-cdrs-when-car-eq 13968,537506
-(defun append-lst 13977,537859
-(defun restrict-alist 13982,538014
-(defmacro let* 13998,538435
-(defmacro progn 14082,542200
-(defun floor1 14130,544036
-(defdoc real14140,544195
-(defun floor 14193,546387
-(defun ceiling 14263,548969
-(defun truncate 14322,550916
-(defun round 14385,553030
-(defun mod 14457,555119
-(defun rem 14491,555927
-(defun evenp 14525,556749
-(defun oddp 14545,557305
-(defun zerop 14564,557786
-(defun plusp 14593,558727
-(defun minusp 14615,559266
-(defun min 14637,559809
-(defun max 14661,560394
-(defun abs 14687,561103
-(defun signum 14712,561844
-(defun lognot 14749,563050
-(defthm standard-char-p-nth14776,563852
-(deflabel proof-of-well-foundedness14789,564351
-(defun expt 14970,571691
-(defun logcount 15002,572788
-(defun nthcdr 15029,573461
-(defun logbitp 15064,574410
-(defun ash 15088,575186
-(defthm expt-type-prescription-non-zero-base15116,576068
-(defthm realp-expt-type-prescription15125,576351
-(defthm rationalp-expt-type-prescription15130,576477
-(deflabel characters15139,576693
-(defaxiom char-code-linear15207,579457
-(defaxiom code-char-type15216,579695
-(defaxiom code-char-char-code-is-identity15220,579786
-(defaxiom char-code-code-char-is-identity15224,579912
-(defun char< 15231,580126
-(defun char> 15251,580699
-(defun char<=15271,581278
-(defun char>=15291,581877
-(defun string<-l 15310,582465
-(defun string< 15324,582892
-(defun string> 15361,583932
-(defun string<=15382,584559
-(defun string>=15408,585424
-(defun symbol-< 15433,586272
-(defthm string<-l-irreflexive15459,587221
-(defthm string<-irreflexive15462,587279
-(defun substitute-ac 15465,587331
-(defun substitute 15479,587777
-(defun sublis 15515,589121
-(defun subst 15545,590161
-(defmacro pprogn 15570,590986
-(defmacro progn$ 15633,592941
-(defmacro pprogn@par 15659,593652
-(defparameter *acl2-unwind-protect-stack* 15788,601268
-(defvar *lp-ever-entered-p* 15791,601333
-(defmacro push-car 15794,601384
-(defmacro acl2-unwind-protect 15812,602204
-(defun-one-output acl2-unwind 15918,607111
-(defmacro when-logic 16094,616840
-(defmacro in-package 16118,617721
-(defmacro defpkg 16147,618570
-(defdoc managing-acl2-packages16269,624406
-(deflabel hidden-defpkg16278,624681
-(deflabel hidden-death-package16286,624813
-(defmacro defun 16348,627439
-(defmacro defun-std 16593,639401
-(defmacro defuns 16609,639764
-(defmacro defuns-std 16652,641027
-(defmacro verify-termination 16667,641401
-(defmacro verify-termination-boot-strap 16831,649469
-(defmacro verify-guards 16841,649750
-(defdoc defpun17160,664582
-(defmacro defmacro 17195,665937
-(defmacro defconst 17288,669947
-(defmacro defthm 17359,672977
-(defmacro defthmd 17440,676020
-(defmacro defthm-std 17486,677394
-(defmacro defaxiom 17514,678136
-(defmacro deflabel 17561,679832
-(deflabel theories17602,681357
-(defmacro deftheory 17761,689852
-(defmacro deftheory-static 17846,693164
-(defmacro defstobj 17925,696523
-(defmacro in-theory 18365,717775
-(defmacro in-arithmetic-theory 18430,720615
-(defmacro regenerate-tau-database 18489,723100
-(defmacro push-untouchable 18568,727185
-(defmacro remove-untouchable 18626,729606
-(defmacro set-body 18725,734222
-(defmacro table 18766,735834
-(defmacro encapsulate 18983,747295
-(defconst *load-compiled-file-values*19264,760967
-(defmacro include-book 19268,761056
-(defmacro make-event 19472,772007
-(defdoc make-event-details20040,797421
-(defdoc using-tables-efficiently20264,809315
-(defmacro record-expansion 20345,812514
-(defmacro skip-proofs 20548,823129
-(defmacro local 20656,828677
-(defmacro defchoose 20716,831143
-(deflabel conservativity-of-defchoose20877,837343
-(defmacro defattach 21287,857351
-(defun attachment-symbol 21804,881136
-(defun set-attachment-symbol-form 21811,881313
-(defmacro defattach 21814,881406
-(deflabel worldp)21895,885187
-(defun plist-worldp 21897,885244
-(defthm plist-worldp-forward-to-assoc-eq-equal-alistp21932,886702
-(defdoc getprop21937,886858
-(defun putprop 21953,887300
-(defparameter meter-maid-cnt 22017,889575
-(defun meter-maid 22020,889625
-(defconst *acl2-property-unbound* 22038,890441
-(defun getprop-default 22040,890500
-(defun-one-output sgetprop1 22056,891009
-(defun fgetprop 22163,895375
-(defun sgetprop 22221,897960
-(defun ordered-symbol-alistp 22259,899573
-(defthm ordered-symbol-alistp-forward-to-symbol-alistp22277,900124
-(defun add-pair 22282,900282
-(defun delete-assoc-eq-exec 22296,900697
-(defun delete-assoc-eql-exec 22304,901020
-(defun delete-assoc-equal 22312,901348
-(defmacro delete-assoc-eq 22318,901573
-(defthm delete-assoc-eq-exec-is-delete-assoc-equal22321,901649
-(defthm delete-assoc-eql-exec-is-delete-assoc-equal22325,901781
-(defmacro delete-assoc 22329,901915
-(defun getprops1 22382,904126
-(defun getprops 22397,904747
-(defthm equal-char-code22442,906536
-(defun has-propsp1 22456,906937
-(defun has-propsp 22477,907884
-(defun extend-world 22509,909250
-(defun retract-world 22529,909917
-(defun global-val 22549,910586
-(defun function-symbolp 22566,911255
-(defun translate-declaration-to-guard/integer 22587,912319
-(defun weak-satisfies-type-spec-p 22633,914217
-(defun translate-declaration-to-guard1 22647,914728
-(defun translate-declaration-to-guard 22833,922264
-(defun translate-declaration-to-guard-lst 22906,925690
-(deflabel declare22932,926568
-(deflabel type-spec22994,928985
-(defun the-check 23071,932341
-(defun the-fn 23081,932737
-(defmacro the 23131,935155
-(defconst *maximum-positive-32-bit-integer*23258,941331
-(defconst *our-array-total-size-limit*23262,941413
-(defun-one-output chk-make-array$ 23274,941845
-(defmacro make-array$ 23307,943317
-(defparameter *acl2-array-cache*23406,948182
-(defmacro set-acl2-array-property 23414,948450
-(defmacro get-acl2-array-property 23463,950251
-(defun bounded-integer-alistp 23491,951241
-(defthm bounded-integer-alistp-forward-to-eqlable-alistp23507,951814
-(defun keyword-value-listp 23512,951978
-(defthm keyword-value-listp-forward-to-true-listp23530,952521
-(defun assoc-keyword 23535,952669
-(defthm keyword-value-listp-assoc-keyword23557,953392
-(defthm consp-assoc-equal23563,953622
-(defmacro f-get-global 23582,954480
-(defun our-import 23643,956515
-(defvar *defpkg-virgins* 23662,957533
-(defun check-proposed-imports 23664,957564
-(defun-one-output defpkg-raw1 23723,960537
-(defun package-has-no-imports 23817,964552
-(defmacro maybe-make-package 23825,964793
-(defmacro maybe-introduce-empty-pkg-1 23909,967846
-(defmacro maybe-introduce-empty-pkg-2 23954,969828
-(defmacro defpkg-raw 23962,970149
-(defun-one-output slow-array-warning 23992,971408
-(deflabel arrays24009,972099
-(deflabel arrays-example24424,994547
-(deflabel slow-array-warning24504,997392
-(defun array1p 24608,1002822
-(defthm array1p-forward24659,1005134
-(defthm array1p-linear24679,1006295
-(defun bounded-integer-alistp2 24688,1006799
-(defun assoc2 24707,1007629
-(defun array2p 24719,1007934
-(defthm array2p-forward24762,1009664
-(defthm array2p-linear24787,1011229
-(defun header 24800,1011960
-(defun dimensions 24832,1012950
-(defun maximum-length 24859,1014040
-(defun default 24883,1014933
-(defun aref1 24931,1017202
-(defun compress11 24982,1018982
-(defconstant *invisible-array-mark* 24997,1019573
-(defun array-order 24999,1019654
-(defun compress1 25012,1020047
-(defthm array1p-cons25279,1032909
-(defun aset1 25289,1033267
-(defun aref2 25413,1039363
-(defun compress211 25460,1041057
-(defun compress21 25476,1041695
-(defun compress2 25489,1042181
-(defthm array2p-cons25667,1050142
-(defun aset2 25678,1050520
-(defun flush-compress 25791,1055394
-(defparameter *return-values*25952,1061729
-(defmacro declare-return-values 25959,1061918
-(defun declare-return-values1 25962,1061996
-(defun in-akcl-with-mv-set-and-ref 25973,1062218
-(defconstant *akcl-mv-ref-and-set-inclusive-upper-bound* 25976,1062293
-(defmacro special-location 25978,1062354
-(defmacro set-mv 25988,1062763
-(defmacro mv-ref 26001,1063229
-(defun mv-refs-fn 26013,1063661
-(defmacro mv-refs 26021,1063795
-(defun cdrn 26038,1064218
-(defun mv-nth 26044,1064384
-(defun make-mv-nths 26096,1066405
-(defun mv-bindings 26104,1066717
-(defun mv-set-mvs 26114,1067041
-(defmacro mv 26119,1067206
-(defmacro mv? 26267,1072761
-(defmacro mv-let 26338,1075125
-(defmacro mv?-let 26492,1081751
-(defun mv-list 26548,1083386
-(defmacro mv-list 26593,1085168
-(defmacro mv-list 26598,1085318
-(deflabel state26601,1085395
-(defdoc programming-with-state26776,1094559
-(defdoc error-triples27311,1117678
-(defun update-nth 27339,1118863
-(defun update-nth-array 27382,1120183
-(defmacro maximum-positive-32-bit-integer 27393,1120613
-(defmacro maximum-positive-32-bit-integer-minus-1 27396,1120696
-(defun 32-bit-integerp 27399,1120798
-(defthm 32-bit-integerp-forward-to-integerp27405,1120981
-(defun acl2-number-listp 27410,1121117
-(defthm acl2-number-listp-forward-to-true-listp27427,1121541
-(defun rational-listp 27432,1121685
-(defthm rational-listp-forward-to-acl2-number-listp27449,1122115
-(defun real-listp 27457,1122348
-(defdoc real-listp27464,1122512
-(defthm real-listp-forward-to-acl2-number-listp27476,1122861
-(defun integer-listp 27481,1123005
-(defthm integer-listp-forward-to-rational-listp27498,1123415
-(defun nat-listp 27503,1123559
-(defthm nat-listp-forward-to-integer-listp27520,1123968
-(defthm rational-listp-forward-to-real-listp27528,1124195
-(defun 32-bit-integer-listp 27533,1124333
-(defthm 32-bit-integer-listp-forward-to-integer-listp27539,1124521
-(defun open-input-channels 27548,1124872
-(defun update-open-input-channels 27552,1124962
-(defun open-output-channels 27556,1125070
-(defun update-open-output-channels 27560,1125161
-(defun global-table 27564,1125270
-(defun update-global-table 27568,1125353
-(defun t-stack 27572,1125454
-(defun update-t-stack 27576,1125532
-(defun 32-bit-integer-stack 27580,1125628
-(defun update-32-bit-integer-stack 27584,1125719
-(defun big-clock-entry 27588,1125828
-(defun update-big-clock-entry 27592,1125914
-(defun idates 27596,1126018
-(defun update-idates 27600,1126095
-(defun acl2-oracle 27604,1126190
-(defun update-acl2-oracle 27608,1126272
-(defun file-clock 27612,1126372
-(defun update-file-clock 27616,1126453
-(defun readable-files 27620,1126552
-(defun written-files 27624,1126637
-(defun update-written-files 27628,1126722
-(defun read-files 27632,1126825
-(defun update-read-files 27636,1126907
-(defun writeable-files 27640,1127007
-(defun list-all-package-names-lst 27644,1127094
-(defun update-list-all-package-names-lst 27648,1127192
-(defun user-stobj-alist1 27656,1127520
-(defun update-user-stobj-alist1 27660,1127609
-(defconst *initial-raw-arity-alist*27665,1127736
-(defconst *initial-checkpoint-processors*27691,1128463
-(defconst *primitive-program-fns-with-raw-code*27710,1129201
-(defconst *primitive-logic-fns-with-raw-code*27823,1133389
-(defconst *primitive-macros-with-raw-code*27983,1139779
-(defmacro with-live-state 28075,1143329
-(defun init-iprint-ar 28184,1147432
-(defconst *iprint-soft-bound-default* 28216,1148825
-(defconst *iprint-hard-bound-default* 28217,1148869
-(defdoc parallelism28219,1148915
-(defdoc parallel-programming28256,1150870
-(defdoc parallel-proof28294,1152765
-(defun default-total-parallelism-work-limit 28307,1153193
-(defconst *fmt-soft-right-margin-default* 28385,1157162
-(defconst *fmt-hard-right-margin-default* 28386,1157208
-(defconst *initial-global-table*28388,1157255
-(defun all-boundp 28678,1169861
-(defun known-package-alistp 28686,1170132
-(defthm known-package-alistp-forward-to-true-list-listp-and-alistp28697,1170513
-(defun timer-alistp 28703,1170717
-(defthm timer-alistp-forward-to-true-list-listp-and-symbol-alistp28715,1171029
-(defun typed-io-listp 28721,1171231
-(defthm typed-io-listp-forward-to-true-listp28733,1171682
-(defconst *file-types* 28738,1171824
-(defun open-channel1 28740,1171877
-(defthm open-channel1-forward-to-true-listp-and-consp28754,1172292
-(defun open-channel-listp 28760,1172470
-(defun open-channels-p 28773,1172827
-(defthm open-channels-p-forward28778,1172949
-(defun file-clock-p 28784,1173128
-(defthm file-clock-p-forward-to-integerp28788,1173194
-(defun readable-file 28793,1173320
-(defthm readable-file-forward-to-true-listp-and-consp28805,1173682
-(defun readable-files-listp 28811,1173860
-(defthm readable-files-listp-forward-to-true-list-listp-and-alistp28817,1174046
-(defun readable-files-p 28823,1174250
-(defthm readable-files-p-forward-to-readable-files-listp28827,1174336
-(defun written-file 28832,1174498
-(defthm written-file-forward-to-true-listp-and-consp28845,1174897
-(defun written-file-listp 28851,1175073
-(defthm written-file-listp-forward-to-true-list-listp-and-alistp28857,1175254
-(defun written-files-p 28863,1175454
-(defthm written-files-p-forward-to-written-file-listp28867,1175537
-(defun read-file-listp1 28872,1175693
-(defthm read-file-listp1-forward-to-true-listp-and-consp28881,1175923
-(defun read-file-listp 28887,1176107
-(defthm read-file-listp-forward-to-true-list-listp28893,1176286
-(defun read-files-p 28898,1176436
-(defthm read-files-p-forward-to-read-file-listp28902,1176513
-(defun writable-file-listp1 28907,1176657
-(defthm writable-file-listp1-forward-to-true-listp-and-consp28915,1176862
-(defun writable-file-listp 28921,1177054
-(defthm writable-file-listp-forward-to-true-list-listp28927,1177245
-(defun writeable-files-p 28932,1177403
-(defthm writeable-files-p-forward-to-writable-file-listp28936,1177489
-(defun state-p1 28941,1177651
-(defthm state-p1-forward28976,1179081
-(defun state-p 29019,1180977
-(defthm state-p-implies-and-forward-to-state-p129029,1181234
-(defmacro build-state29122,1186551
-(defconst *default-state*29146,1187484
-(defun build-state1 29151,1187618
-(defun coerce-state-to-object 29179,1188878
-(defun coerce-object-to-state 29183,1188947
-(defun-one-output strip-numeric-postfix 29193,1189120
-(defun global-table-cars1 29201,1189360
-(defun global-table-cars 29226,1190504
-(defun boundp-global1 29233,1190708
-(defun boundp-global 29242,1191034
-(defmacro f-boundp-global 29250,1191282
-(defun makunbound-global 29266,1191814
-(defun get-global 29294,1192856
-(defun put-global 29307,1193333
-(defmacro f-put-global 29328,1194153
-(defmacro f-put-global@par 29391,1196752
-(defconst *initial-ld-special-bindings*29409,1197354
-(defun always-boundp-global 29434,1198240
-(defun state-global-let*-bindings-p 29441,1198437
-(defun state-global-let*-get-globals 29458,1199068
-(defun state-global-let*-put-globals 29487,1200618
-(defun state-global-let*-cleanup 29520,1202345
-(defparameter *possible-parallelism-hazards*29571,1205234
-(defmacro with-parallelism-hazard-warnings 29612,1206597
-(defmacro warn-about-parallelism-hazard 29622,1206847
-(defmacro with-ensured-parallelism-finishing 29679,1209670
-(defmacro state-global-let* 29692,1210068
-(defmacro state-free-global-let* 29812,1215445
-(defun integer-range-p 29855,1217468
-(defun signed-byte-p 29881,1218503
-(defun unsigned-byte-p 29889,1218723
-(defthm integer-range-p-forward29900,1219028
-(defthm signed-byte-p-forward-to-integerp29908,1219278
-(defthm unsigned-byte-p-forward-to-nonnegative-integerp29913,1219412
-(defmacro the-fixnum 29921,1219675
-(defun-one-output zpf 29925,1219753
-(defun zpf 29929,1219862
-(defmacro logand 30178,1228056
-(defmacro logeqv 30201,1228788
-(defmacro logior 30224,1229532
-(defmacro logxor 30247,1230276
-(defun integer-length 30270,1231020
-(defun binary-logand 30299,1232000
-(defun lognand 30313,1232467
-(defun binary-logior 30332,1233043
-(defun logorc1 30338,1233220
-(defun logorc2 30359,1233904
-(defun logandc1 30380,1234589
-(defun logandc2 30401,1235263
-(defun binary-logeqv 30421,1235921
-(defun binary-logxor 30427,1236088
-(defun lognor 30433,1236247
-(defun logtest 30454,1236863
-(defconst *BOOLE-1* 30478,1237603
-(defconst *BOOLE-2* 30479,1237631
-(defconst *BOOLE-AND* 30480,1237659
-(defconst *BOOLE-ANDC1* 30481,1237687
-(defconst *BOOLE-ANDC2* 30482,1237715
-(defconst *BOOLE-C1* 30483,1237743
-(defconst *BOOLE-C2* 30484,1237771
-(defconst *BOOLE-CLR* 30485,1237799
-(defconst *BOOLE-EQV* 30486,1237827
-(defconst *BOOLE-IOR* 30487,1237855
-(defconst *BOOLE-NAND* 30488,1237883
-(defconst *BOOLE-NOR* 30489,1237911
-(defconst *BOOLE-ORC1* 30490,1237939
-(defconst *BOOLE-ORC2* 30491,1237967
-(defconst *BOOLE-SET* 30492,1237995
-(defconst *BOOLE-XOR* 30493,1238023
-(defun boole$ 30495,1238052
-(deflabel io30565,1240634
-(defdoc output-to-file30808,1251584
-(defdoc *standard-co*30863,1253807
-(defdoc *standard-oi*30902,1255880
-(defdoc *standard-ci*30916,1256460
-(defdoc print-control30932,1257068
-(defdoc character-encoding31031,1262352
-(defun set-forms-from-bindings 31078,1264539
-(defconst *print-control-defaults*31090,1264999
-(defun alist-difference-eq 31115,1266293
-(defmacro with-print-defaults 31131,1266837
-(defmacro reset-print-control 31140,1267308
-(defun digit-to-char 31144,1267419
-(defun print-base-p 31185,1268433
-(defun explode-nonnegative-integer 31192,1268586
-(defthm true-listp-explode-nonnegative-integer31240,1270206
-(defun explode-atom 31269,1271130
-(defun explode-atom+ 31313,1272781
-(defthm true-list-listp-forward-to-true-listp-assoc-equal31349,1274248
-(defthm true-listp-cadr-assoc-eq-for-open-channels-p31368,1275216
-(defun open-input-channel-p1 31383,1275730
-(defun open-output-channel-p1 31398,1276393
-(defun open-input-channel-p 31412,1277035
-(defun open-output-channel-p 31418,1277304
-(defun open-output-channel-any-p1 31424,1277575
-(defun open-output-channel-any-p 31431,1277916
-(defun open-input-channel-any-p1 31436,1278128
-(defun open-input-channel-any-p 31443,1278465
-(defmacro print-case 31448,1278675
-(defmacro acl2-print-case 31457,1278940
-(defun set-print-case 31460,1279012
-(defmacro set-acl2-print-case 31500,1280998
-(defmacro print-base 31506,1281195
-(defmacro acl2-print-base 31509,1281276
-(defmacro print-radix 31512,1281348
-(defmacro acl2-print-radix 31515,1281431
-(defun check-print-base 31518,1281505
-(defun set-print-base 31575,1284347
-(defmacro set-acl2-print-base 31615,1285652
-(defun set-print-circle 31621,1285849
-(defun set-print-escape 31625,1285967
-(defun set-print-pretty 31629,1286085
-(defun set-print-radix 31633,1286203
-(defun set-print-readably 31675,1287400
-(defun check-null-or-natp 31679,1287522
-(defun set-print-length 31690,1287870
-(defun set-print-level 31696,1288107
-(defun set-print-lines 31702,1288341
-(defun set-print-right-margin 31708,1288575
-(defmacro get-input-stream-from-channel 31715,1288847
-(defmacro get-output-stream-from-channel 31722,1289037
-(defmacro with-print-controls 31729,1289229
-(defun princ$ 31793,1292421
-(defun write-byte$ 31962,1299517
-(defvar *print-circle-stream* 31991,1300685
-(defmacro er 31993,1300721
-(defmacro er@par 32105,1306237
-(defun get-serialize-character 32128,1307162
-(defun w 32133,1307369
-(defun hons-enabledp 32145,1307896
-(defun set-serialize-character 32150,1308059
-(defun print-object$-ser 32177,1309245
-(defthm all-boundp-preserves-assoc-equal32231,1311525
-(defun print-object$ 32248,1312094
-(defparameter *file-clock* 32284,1313800
-(defun make-input-channel 32287,1313844
-(defun make-output-channel 32301,1314354
-(defun-one-output setup-standard-io 32323,1315368
-(defun-one-output lisp-book-syntaxp1 32363,1316860
-(defun-one-output lisp-book-syntaxp 32444,1319983
-(defparameter *parser* 32469,1321119
-(defun-one-output parse-infix-file 32482,1321589
-(defun open-input-channel 32512,1322831
-(defthm nth-update-nth32627,1328001
-(defthm true-listp-update-nth32634,1328187
-(defthm nth-update-nth-array32647,1328537
-(defun close-input-channel 32653,1328718
-(defun open-output-channel 32698,1330612
-(defun open-output-channel! 32798,1335707
-(defmacro assert$ 32929,1340446
-(defun fmt-to-comment-window 32953,1341250
-(defun fmt-to-comment-window! 33004,1343346
-(defun pairlis2 33018,1343708
-(defmacro cw 33026,1343992
-(defmacro cw! 33147,1348484
-(defun subseq-list 33166,1349135
-(defun subseq 33177,1349502
-(defun lock-symbol-name-p 33217,1351269
-(defun assign-lock 33226,1351561
-(defmacro with-lock 33247,1352239
-(defmacro deflock 33258,1352638
-(defun get-output-stream-string$-fn 33302,1354388
-(defmacro get-output-stream-string$ 33348,1356400
-(defun close-output-channel 33368,1357328
-(defun maybe-finish-output$ 33474,1362143
-(defmacro legal-acl2-character-p 33494,1362853
-(defun read-char$ 33510,1363401
-(defun peek-char$ 33545,1364876
-(defun read-byte$ 33571,1365926
-(defun-one-output parse-infix-from-terminal 33600,1367075
-(defparameter *acl2-read-suppress* 33625,1368130
-(defun read-object 33627,1368171
-(defun read-object-suppress 33723,1372478
-(defconst *suspiciously-first-numeric-chars*33740,1373236
-(defconst *suspiciously-first-hex-chars*33747,1373436
-(defconst *base-10-chars*33757,1373688
-(defconst *hex-chars*33764,1373830
-(defconst *letter-chars*33773,1374020
-(defconst *slashable-chars*33783,1374340
-(defun some-slashable 33791,1374625
-(defun prin1-with-slashes1 33799,1374830
-(defun prin1-with-slashes 33818,1375569
-(defmacro suspiciously-first-numeric-chars 33844,1376656
-(defmacro numeric-chars 33849,1376821
-(defun may-need-slashes1 33854,1376929
-(defmacro potential-numberp 33878,1377961
-(defun may-need-slashes-fn 33940,1380387
-(defmacro may-need-slashes 34189,1391328
-(defun needs-slashes 34198,1391722
-(defparameter *t-stack* 34214,1392250
-(defparameter *t-stack-length* 34216,1392292
-(defun t-stack-length1 34221,1392331
-(defun t-stack-length 34232,1392666
-(defun make-list-ac 34239,1392864
-(defmacro make-list 34246,1393072
-(defun extend-t-stack 34263,1393704
-(defconst *directory-separator*34338,1396370
-(defconst *directory-separator-string*34341,1396410
-(defmacro os-er 34344,1396484
-(defun os 34352,1396752
-(defun mswindows-drive1 34362,1396990
-(defun mswindows-drive 34387,1398195
-(defun pathname-os-to-unix 34402,1398817
-(defun ccl-at-least-1-3-p 34443,1400327
-(defun pathname-unix-to-os 34450,1400638
-(defun shrink-t-stack 34504,1403027
-(defun aref-t-stack 34529,1403884
-(defun aset-t-stack 34544,1404398
-(defparameter *32-bit-integer-stack*34572,1405189
-(defparameter *32-bit-integer-stack-length* 34575,1405278
-(defun 32-bit-integer-stack-length1 34579,1405329
-(defun 32-bit-integer-stack-length 34587,1405638
-(defun extend-32-bit-integer-stack 34594,1405862
-(defun shrink-32-bit-integer-stack 34642,1408180
-(defun aref-32-bit-integer-stack 34673,1409310
-(defun aset-32-bit-integer-stack 34696,1410080
-(defmacro f-big-clock-negative-p 34725,1411109
-(defmacro f-decrement-big-clock 34734,1411347
-(defun big-clock-negative-p 34753,1411931
-(defun decrement-big-clock 34773,1412813
-(defun list-all-package-names 34798,1413767
-(defun user-stobj-alist 34814,1414367
-(defun update-user-stobj-alist 34824,1414687
-(defun power-eval 34836,1415121
-(defun-one-output idate 34844,1415331
-(defun read-idate 34856,1415643
-(defun read-run-time 34875,1416300
-(defparameter *next-acl2-oracle-value* 34914,1417766
-(defun read-acl2-oracle 34916,1417811
-(defun read-acl2-oracle@par 34937,1418490
-(defun read-acl2-oracle@par 34962,1419519
-(defun getenv$ 34983,1420508
-(defun setenv$ 35012,1421534
-(defun random$ 35068,1423659
-(defthm natp-random$35107,1425117
-(defthm random$-linear35111,1425208
-(defvar *last-sys-call-status* 35128,1425658
-(defun sys-call 35130,1425693
-(defun sys-call-status 35216,1429086
-(defthm update-acl2-oracle-preserves-state-p135321,1434091
-(defthm read-run-time-preserves-state-p135334,1434454
-(defthm read-acl2-oracle-preserves-state-p135342,1434743
-(defthm nth-0-read-run-time-type-prescription35358,1435226
-(defun main-timer 35376,1435793
-(defun put-assoc-eq-exec 35389,1436296
-(defun put-assoc-eql-exec 35401,1436756
-(defun put-assoc-equal 35413,1437221
-(defmacro put-assoc-eq 35419,1437493
-(defmacro put-assoc-eql 35424,1437665
-(defthm put-assoc-eq-exec-is-put-assoc-equal35427,1437752
-(defthm put-assoc-eql-exec-is-put-assoc-equal35431,1437886
-(defmacro put-assoc 35435,1438022
-(defun set-timer 35502,1440684
-(defun get-timer 35511,1440968
-(defun push-timer 35522,1441345
-(defthm rationalp-+35531,1441729
-(defthm rationalp-*35627,1445995
-(defthm rationalp-unary--35632,1446110
-(defthm rationalp-unary-/35636,1446193
-(defthm realp-+35645,1446529
-(defthm realp-*35651,1446653
-(defthm realp-unary--35657,1446777
-(defthm realp-unary-/35662,1446873
-(defthm rationalp-implies-acl2-numberp35668,1447019
-(defun pop-timer 35671,1447103
-(defun add-timers 35689,1447728
-(defthm nth-0-cons35703,1448291
-(defthm nth-add135713,1448493
-(defthm main-timer-type-prescription35720,1448693
-(defthm ordered-symbol-alistp-add-pair-forward35726,1448888
-(defthm assoc-add-pair35735,1449157
-(defthm add-pair-preserves-all-boundp35743,1449437
-(defthm state-p1-update-main-timer35750,1449696
-(defun increment-timer 35781,1451087
-(defun print-rational-as-decimal 35804,1452082
-(defun print-timer 35825,1452852
-(defun known-package-alist 35833,1453195
-(defun prin1$ 35849,1453601
-(defun current-package 36030,1462391
-(defthm state-p1-update-nth-2-world36084,1465238
-(defconst *initial-untouchable-fns*36122,1466597
-(defconst *initial-untouchable-vars*36204,1469086
-(defun ld-skip-proofsp 36357,1473361
-(defun-one-output bad-lisp-objectp 36468,1479158
-(defun-one-output chk-bad-lisp-object 36702,1491028
-(defmacro assign 36744,1492262
-(defmacro @ 36784,1493788
-(defun make-var-lst1 36818,1495068
-(defun make-var-lst 36845,1495974
-(defun union-eq-exec 36853,1496204
-(defun union-eql-exec 36863,1496586
-(defun union-equal 36873,1496970
-(defmacro union-eq 36879,1497205
-(defthm union-eq-exec-is-union-equal36882,1497266
-(defthm union-eql-exec-is-union-equal36886,1497366
-(defun parse-args-and-test 36890,1497468
-(defmacro union$ 36939,1499712
-(defun subst-for-nth-arg 37011,1502847
-(defmacro the-mv 37021,1503149
-(defmacro the-mv 37075,1505083
-(defmacro the2s 37086,1505627
-(deflabel bibliography37089,1505676
-(defun non-free-var-runes 37110,1506478
-(defun free-var-runes 37125,1507196
-(defthm natp-position-ac 37133,1507415
-(defun absolute-pathname-string-p 37141,1507751
-(defun include-book-dir-alistp 37187,1509878
-(defun illegal-ruler-extenders-values 37196,1510193
-(defun intersection-eq-exec 37208,1510610
-(defun intersection-eql-exec 37220,1511026
-(defun intersection-equal 37231,1511447
-(defmacro intersection-eq 37241,1511769
-(defthm intersection-eq-exec-is-intersection-equal37244,1511844
-(defthm intersection-eql-exec-is-intersection-equal37248,1511972
-(defmacro intersection$ 37252,1512102
-(defun table-alist 37333,1515669
-(defun ruler-extenders-msg-aux 37341,1515899
-(defun ruler-extenders-msg 37358,1516667
-(defmacro chk-ruler-extenders 37391,1518196
-(defmacro fixnum-bound 37401,1518653
-(defconst *default-step-limit*37404,1518753
-(deflabel acl2-defaults-table37548,1523848
-(defmacro set-enforce-redundancy 37877,1538139
-(defmacro set-enforce-redundancy 37950,1541870
-(defmacro set-ignore-doc-string-error 37955,1541955
-(defmacro set-ignore-doc-string-error 38000,1543804
-(defmacro default-verify-guards-eagerness-from-table 38004,1543877
-(defun default-verify-guards-eagerness 38008,1544006
-(defmacro set-verify-guards-eagerness 38016,1544345
-(defmacro set-verify-guards-eagerness 38072,1547179
-(defun default-compile-fns 38076,1547252
-(defmacro set-compile-fns 38082,1547509
-(defmacro set-compile-fns 38140,1550035
-(defun set-compiler-enabled 38144,1550096
-(defun default-measure-function 38169,1551180
-(defmacro set-measure-function 38176,1551470
-(defmacro set-measure-function 38216,1553082
-(defun default-well-founded-relation 38220,1553154
-(defmacro set-well-founded-relation 38227,1553446
-(defmacro set-well-founded-relation 38266,1555184
-(defmacro default-defun-mode-from-table 38272,1555297
-(defun default-defun-mode 38282,1555596
-(defun default-defun-mode-from-state 38324,1557968
-(defmacro logic 38329,1558108
-(defmacro logic 38368,1559524
-(defmacro program 38371,1559566
-(defmacro program 38427,1561350
-(defun invisible-fns-table 38429,1561377
-(defmacro set-invisible-fns-table 38477,1563483
-(defun unary-function-symbol-listp 38550,1566254
-(defun invisible-fns-entryp 38568,1567053
-(defmacro add-invisible-fns 38580,1567372
-(defmacro remove-invisible-fns 38622,1569223
-(defmacro set-invisible-fns-alist 38667,1571117
-(defmacro invisible-fns-alist 38674,1571423
-(defmacro set-bogus-defun-hints-ok 38681,1571658
-(defmacro set-bogus-defun-hints-ok 38704,1572479
-(defmacro set-bogus-mutual-recursion-ok 38709,1572566
-(defmacro set-bogus-mutual-recursion-ok 38759,1574711
-(defdoc ruler-extenders38763,1574786
-(defmacro set-ruler-extenders 39166,1591069
-(defmacro set-ruler-extenders 39191,1591967
-(defmacro set-irrelevant-formals-ok 39196,1592049
-(defmacro set-irrelevant-formals-ok 39231,1593282
-(defmacro set-ignore-ok 39236,1593370
-(defmacro set-ignore-ok 39280,1595040
-(defmacro set-inhibit-warnings 39285,1595116
-(defmacro set-inhibit-warnings 39290,1595205
-(defmacro set-inhibit-output-lst 39332,1596800
-(defmacro set-inhibited-summary-types 39400,1600013
-(defmacro set-state-ok 39455,1602305
-(defmacro set-state-ok 39528,1605467
-(defmacro set-let*-abstractionp 39537,1605703
-(defmacro set-let*-abstractionp 39584,1607602
-(defmacro set-let*-abstraction 39588,1607669
-(defun let*-abstractionp 39596,1607903
-(defconst *initial-backchain-limit* 39610,1608399
-(defconst *initial-default-backchain-limit* 39612,1608448
-(defmacro set-backchain-limit 39615,1608522
-(defmacro set-backchain-limit 39668,1610886
-(defun backchain-limit 39672,1610959
-(defmacro set-default-backchain-limit 39831,1617810
-(defmacro set-default-backchain-limit 39897,1621160
-(defun default-backchain-limit 39901,1621241
-(defun step-limit-from-table 39977,1624555
-(defparameter *step-limit-error-p*39996,1625363
-(defmacro set-prover-step-limit 40005,1625641
-(defmacro set-prover-step-limit 40163,1632749
-(defparameter *rewrite-depth-max* 40182,1633486
-(defparameter *rewrite-depth-alist* 40183,1633557
-(defconst *default-rewrite-stack-limit*40231,1635395
-(defmacro set-rewrite-stack-limit 40245,1636024
-(defmacro set-rewrite-stack-limit 40285,1637659
-(defun rewrite-stack-limit 40289,1637736
-(defmacro set-nu-rewriter-mode 40335,1639580
-(defmacro set-nu-rewriter-mode 40389,1641921
-(defun nu-rewriter-mode 40393,1641987
-(defun case-split-limitations 40413,1642952
-(defmacro sr-limit 40442,1644195
-(defmacro case-limit 40445,1644263
-(defmacro set-case-split-limitations 40449,1644351
-(defmacro set-case-split-limitations 40591,1651808
-(defconst *initial-acl2-defaults-table*40602,1652280
-(defun untrans-table 40608,1652501
-(defmacro add-macro-fn 40647,1653581
-(defmacro add-binop 40690,1655764
-(defmacro remove-macro-fn 40701,1656075
-(defmacro remove-binop 40730,1657238
-(defun match-free-default 40744,1657704
-(defmacro set-match-free-default 40752,1658035
-(defmacro set-match-free-default 40813,1660921
-(defmacro set-match-free-error 40817,1660989
-(defun match-free-override 40862,1663140
-(defmacro add-match-free-override 40880,1663899
-(defmacro add-match-free-override 41067,1673162
-(defmacro add-include-book-dir 41071,1673253
-(defmacro delete-include-book-dir 41129,1676246
-(defconst *non-linear-rounds-value* 41170,1678012
-(defun non-linearp 41172,1678052
-(defmacro set-non-linearp 41183,1678388
-(defmacro set-non-linearp 41207,1679105
-(defmacro set-non-linear 41211,1679176
-(defun tau-auto-modep 41219,1679402
-(defmacro set-tau-auto-mode 41257,1681092
-(defmacro set-tau-auto-mode 41377,1687870
-(defmacro defttag 41382,1687960
-(defmacro defttag 41649,1701428
-(defun ttag 41653,1701493
-(defdoc complex-rationalp41665,1701877
-(deflabel let41679,1702325
-(defdoc flet41804,1707896
-(defun-one-output what-is-the-global-state 41934,1712948
-(deflabel macro-aliases-table42001,1716103
-(defun macro-aliases 42117,1720550
-(defmacro add-macro-alias 42121,1720669
-(defmacro remove-macro-alias 42186,1723423
-(deflabel nth-aliases-table42219,1724792
-(defun nth-aliases 42259,1726220
-(defmacro add-nth-alias 42263,1726335
-(defmacro remove-nth-alias 42284,1726985
-(deflabel default-hints-table42320,1728615
-(defun default-hints 42341,1729381
-(defmacro set-default-hints 42366,1730343
-(defmacro set-default-hints! 42425,1732753
-(defmacro set-default-hints! 42443,1733445
-(defmacro add-default-hints 42447,1733513
-(defmacro add-default-hints! 42496,1735654
-(defmacro add-default-hints! 42516,1736500
-(defmacro remove-default-hints 42520,1736568
-(defmacro remove-default-hints! 42560,1738111
-(defmacro remove-default-hints! 42578,1738885
-(defmacro set-override-hints-macro 42583,1738973
-(defmacro set-override-hints-macro 42589,1739195
-(defmacro add-override-hints! 42593,1739277
-(defmacro add-override-hints 42607,1739779
-(defmacro set-override-hints! 42637,1741051
-(defmacro set-override-hints 42650,1741492
-(defmacro remove-override-hints! 42674,1742349
-(defmacro remove-override-hints 42687,1742850
-(defmacro set-rw-cache-state 42713,1743913
-(defmacro set-rw-cache-state! 42991,1759363
-(defmacro set-rw-cache-state! 43006,1759886
-(defconst *legal-rw-cache-states*43010,1759955
-(defun fix-true-list 43019,1760160
-(defthm pairlis$-fix-true-list43037,1760620
-(defun boolean-listp 43041,1760718
-(defthm boolean-listp-cons43052,1761036
-(defthm boolean-listp-forward43061,1761289
-(defthm boolean-listp-forward-to-symbol-listp43071,1761552
-(defaxiom completion-of-+43089,1762330
-(defthm default-+-143100,1762569
-(defthm default-+-243105,1762702
-(defaxiom completion-of-*43110,1762835
-(defthm default-*-143119,1763022
-(defthm default-*-243123,1763108
-(defaxiom completion-of-unary-minus43127,1763194
-(defthm default-unary-minus43134,1763331
-(defaxiom completion-of-unary-/43138,1763423
-(defthm default-unary-/43146,1763598
-(defaxiom completion-of-<43153,1763778
-(defthm default-<-143165,1764202
-(defthm default-<-243174,1764435
-(defaxiom completion-of-car43183,1764668
-(defthm default-car43191,1764811
-(defaxiom completion-of-cdr43195,1764892
-(defthm default-cdr43203,1765035
-(defthm cons-car-cdr43207,1765116
-(defaxiom completion-of-char-code43213,1765237
-(defthm default-char-code43220,1765386
-(defaxiom completion-of-code-char43225,1765531
-(defaxiom completion-of-complex43246,1766126
-(defthm default-complex-143254,1766353
-(defthm default-complex-243262,1766586
-(defthm complex-043271,1766908
-(defthm add-def-complex43279,1767123
-(defthm realpart-+43294,1767798
-(defthm imagpart-+43299,1767928
-(defaxiom completion-of-coerce43304,1768058
-(defthm default-coerce-143315,1768321
-(defthm make-character-list-make-character-list43321,1768504
-(defthm default-coerce-243325,1768643
-(defthm default-coerce-343339,1769201
-(defaxiom completion-of-denominator43345,1769385
-(defthm default-denominator43352,1769539
-(defaxiom completion-of-floor143363,1769921
-(defthm default-floor143374,1770171
-(defaxiom floor1-integer-x43382,1770377
-(defaxiom floor1-x-<=43389,1770560
-(defaxiom x-<-add1-floor1-x43397,1770754
-(defthm floor1-value43407,1771073
-(defaxiom completion-of-imagpart43415,1771263
-(defthm default-imagpart43422,1771411
-(defaxiom completion-of-intern-in-package-of-symbol43427,1771525
-(defaxiom completion-of-numerator43446,1772185
-(defthm default-numerator43453,1772333
-(defaxiom completion-of-realpart43458,1772446
-(defthm default-realpart43465,1772594
-(defaxiom completion-of-symbol-name43470,1772708
-(defthm default-symbol-name43477,1772861
-(defaxiom completion-of-symbol-package-name43483,1773028
-(defthm default-symbol-package-name43490,1773205
-(defdoc i-small43499,1773485
-(defdoc i-close43508,1773734
-(defdoc i-large43516,1773989
-(defdoc i-limited43525,1774252
-(defdoc standardp43534,1774500
-(defdoc standard-part43555,1775525
-(defun i-small 43567,1775880
-(defun i-close 43572,1775990
-(defun i-large 43578,1776116
-(defmacro i-limited 43584,1776239
-(defaxiom i-large-integer-is-large43591,1776454
-(defaxiom standardp-plus43599,1776741
-(defaxiom standardp-uminus43604,1776861
-(defaxiom standardp-times43608,1776947
-(defaxiom standardp-udivide43613,1777068
-(defaxiom standardp-complex43617,1777155
-(defaxiom standardp-one43625,1777473
-(defaxiom standard-part-of-standardp43631,1777597
-(defaxiom standardp-standard-part43636,1777740
-(defaxiom standard-part-of-reals-is-idempotent43640,1777843
-(defaxiom standard-part-of-complex43645,1778003
-(defaxiom standard-part-of-plus43651,1778181
-(defaxiom standard-part-of-uminus43656,1778322
-(defaxiom standard-part-of-times43660,1778427
-(defaxiom standard-part-of-udivide43665,1778609
-(defaxiom standard-part-<=43671,1778793
-(defaxiom small-are-limited43677,1778953
-(defaxiom standards-are-limited43684,1779129
-(defthm standard-constants-are-limited43690,1779298
-(defaxiom limited-integers-are-standard43698,1779547
-(defaxiom standard+small->i-limited43705,1779783
-(defdoc acl2-numberp43713,1779967
-(defdoc +43721,1780173
-(defdoc binary-+43737,1780482
-(defdoc binary-*43763,1781092
-(defdoc -43787,1781656
-(defdoc unary--43816,1782147
-(defdoc unary-/43838,1782651
-(defdoc <43862,1783215
-(defdoc car43892,1784126
-(defdoc cdr43911,1784538
-(defdoc char-code43930,1784952
-(defdoc characterp43948,1785335
-(defdoc code-char43956,1785503
-(defdoc complex43979,1786058
-(defdoc cons44027,1787879
-(defdoc consp44036,1788162
-(defdoc coerce44043,1788323
-(defdoc denominator44092,1789974
-(defdoc equal44110,1790316
-(defdoc if44121,1790597
-(defdoc imagpart44137,1791009
-(defdoc integerp44155,1791342
-(defdoc intern-in-package-of-symbol44162,1791501
-(defdoc numerator44218,1793716
-(defdoc rationalp44236,1794049
-(defdoc realpart44244,1794245
-(defdoc stringp44262,1794573
-(defdoc symbol-name44269,1794722
-(defdoc symbol-package-name44287,1795060
-(defdoc symbolp44314,1796012
-(defdoc quote44321,1796161
-(defun double-rewrite 44329,1796326
-(defparameter *acl2-time-limit* 44562,1807291
-(defparameter *acl2-time-limit-boundp* 44564,1807329
-(defun chk-with-prover-time-limit-arg 44568,1807377
-(defmacro with-prover-time-limit1-raw 44585,1808050
-(defmacro with-prover-time-limit1 44605,1808929
-(defmacro with-prover-time-limit 44608,1809035
-(defparameter *time-limit-tags* 44702,1813830
-(defmacro catch-time-limit5 44704,1813868
-(defmacro catch-time-limit5@par 44728,1814852
-(defun time-limit5-reached-p 44764,1816486
-(defmacro catch-step-limit 44808,1818533
-(defconst *guard-checking-values*44837,1819728
-(defun chk-with-guard-checking-arg 44840,1819794
-(defmacro with-guard-checking1-raw 44852,1820313
-(defmacro with-guard-checking1 44863,1820709
-(defmacro with-guard-checking 44866,1820807
-(defun abort! 44892,1821746
-(defmacro a! 44906,1822049
-(defun p! 44930,1822917
-(defparameter *wormhole-status-alist* 44973,1824606
-(defparameter *inhibit-wormhole-activityp* 44976,1824667
-(defun wormhole1 44978,1824716
-(defun wormhole-p 45074,1828723
-(defun duplicates 45091,1829203
-(defun evens 45098,1829436
-(defun odds 45104,1829582
-(defun set-equalp-equal 45108,1829660
-(defparameter *metafunction-context* 45230,1836606
-(DEFMACRO |Access 45350,1841128
-(defun record-error 45367,1841699
-(defun record-accessor-function-name 45373,1841869
-(defmacro access 45385,1842254
-(defun mfc-clause 45394,1842594
-(defun mfc-rdepth 45428,1843992
-(defun type-alist-entryp 45438,1844287
-(defun type-alistp 45454,1844775
-(defun mfc-type-alist 45461,1844934
-(defun mfc-ancestors 45477,1845377
-(defun mfc-unify-subst 45493,1845814
-(defun mfc-world 45503,1846129
-(defthm pseudo-term-listp-mfc-clause45516,1846500
-(defthm type-alistp-mfc-type-alist45519,1846578
-(defun bad-atom 45554,1848570
-(defthm bad-atom-compound-recognizer45565,1848788
-(defun-one-output bad-atom<=45577,1849082
-(defaxiom booleanp-bad-atom<=45586,1849436
-(defaxiom bad-atom<=45591,1849572
-(defaxiom bad-atom<=45599,1849778
-(defaxiom bad-atom<=45608,1850041
-(defun alphorder 45618,1850311
-(defun lexorder 45694,1852914
-(defthm alphorder-reflexive45759,1854966
-(defthm alphorder-transitive45776,1855483
-(defthm alphorder-anti-symmetric45787,1855817
-(defthm alphorder-total45811,1856832
-(defthm lexorder-reflexive45826,1857369
-(defthm lexorder-anti-symmetric45829,1857415
-(defthm lexorder-transitive45834,1857554
-(defthm lexorder-total45839,1857704
-(defun merge-lexorder 45855,1858235
-(defthm true-listp-merge-sort-lexorder45881,1858983
-(defun merge-sort-lexorder 45887,1859176
-(defdoc bdd45902,1859802
-(defun if* 45936,1861252
-(defun resize-list 46120,1868402
-(deflabel theory-functions46136,1868922
-(defun e/d-fn 46171,1870545
-(defmacro e/d 46182,1871066
-(defun mod-expt 46261,1874049
-(defmacro fcons-term* 46305,1875822
-(defun conjoin2 46322,1876500
-(defun conjoin 46336,1876998
-(defun conjoin2-untranslated-terms 46342,1877167
-(defun conjoin-untranslated-terms 46358,1877609
-(defun disjoin2 46370,1877948
-(defun disjoin 46382,1878306
-(defun disjoin-lst 46388,1878491
-(defun conjoin-clauses 46394,1878713
-(defconst *true-clause* 46398,1878847
-(defconst *false-clause* 46400,1878884
-(defun clauses-result 46402,1878915
-(defdoc sharp-dot-reader46407,1879063
-(defdoc sharp-comma-reader46446,1880352
-(defdoc sharp-bang-reader46454,1880557
-(defdoc sharp-u-reader46486,1881355
-(defdoc evisc-table46538,1882889
-(defconst *top-hint-keywords*46782,1891422
-(defconst *hint-keywords*46792,1891830
-(defmacro add-custom-keyword-hint 46837,1893233
-(defmacro add-custom-keyword-hint 46925,1897017
-(defmacro remove-custom-keyword-hint 46929,1897098
-(defmacro show-custom-keyword-hint-expansion 46962,1898235
-(defun splice-keyword-alist 46989,1899066
-(deflabel custom-keyword-hints47002,1899608
-(defun search-fn-guard 47014,1899955
-(defun search-from-start 47062,1902103
-(defun search-from-end 47085,1902963
-(defmacro search 47266,1908619
-(defthm eqlablep-nth47330,1911662
-(defun count-stringp 47335,1911791
-(defun count-listp 47350,1912324
-(defmacro count 47385,1913456
-(defun make-sharp-atsign 47425,1915048
-(defun sharp-atsign-alist 47432,1915264
-(defmacro time$1-raw 47539,1920224
-(defmacro time$1 47559,1920907
-(defmacro time$ 47562,1920977
-(defmacro our-multiple-value-prog1 47744,1927694
-(defconst *mv-vars*47760,1928182
-(defconst *mv-var-values*47767,1928327
-(defconst *mv-extra-var* 47771,1928421
-(defun protect-mv 47773,1928457
-(defmacro our-time 47821,1930221
-(defun-one-output gc$-fn 47956,1936162
-(defun gc$-fn 47980,1937006
-(defmacro gc$ 47985,1937089
-(defun-one-output gc-verbose-fn 48014,1938074
-(defun gc-verbose-fn 48029,1938542
-(defmacro gc-verbose 48034,1938630
-(defun get-wormhole-status 48059,1939525
-(defun file-write-date$ 48088,1940619
-(defun debugger-enable 48106,1941131
-(defun break$ 48111,1941322
-(defun print-call-history 48146,1942490
-(defun debugger-enabledp 48196,1944336
-(defun maybe-print-call-history 48203,1944612
-(defmacro with-reckless-readtable 48210,1944903
-(defmacro set-debugger-enable 48228,1945510
-(defun set-debugger-enable-fn 48362,1951401
-(defun add-@par-suffix 48387,1952490
-(defun generate-@par-mappings 48393,1952665
-(defconst *@par-mappings*48410,1953510
-(defun make-identity-for-@par-mappings 48604,1960360
-(defmacro define-@par-macros 48618,1960925
-(defun replace-defun@par-with-defun 48635,1961521
-(defmacro mutual-recursion@par 48646,1961888
-(defun defun@par-fn 48650,1962007
-(defun mutual-recursion@par-guardp 48670,1962749
-(defun mutual-recursion@par-fn 48682,1963231
-(defmacro mutual-recursion@par 48704,1964192
-(defmacro defun@par 48708,1964360
-(defmacro serial-first-form-parallel-second-form 48722,1964858
-(defmacro serial-first-form-parallel-second-form@par 48730,1965019
-(defmacro serial-only 48737,1965169
-(defmacro serial-only@par 48744,1965251
-(defmacro parallel-only 48751,1965347
-(defmacro parallel-only@par 48759,1965458
-(defmacro mv@par 48766,1965544
-(defmacro value@par 48772,1965704
-(defmacro state-mac 48778,1965778
-(defmacro state-mac@par 48785,1965860
-(defmacro mv-let@par 48792,1965939
-(defmacro warning$@par 48798,1966130
-(defmacro error-in-parallelism-mode 48807,1966379
-(defmacro error-in-parallelism-mode@par 48812,1966499
-(defun increment-timer@par 48834,1967412
-(defconst *waterfall-printing-values*48842,1967638
-(defconst *waterfall-parallelism-values*48845,1967712
-(defun symbol-constant-fn 48852,1967940
-(defun stobjs-in 48863,1968293
-(defmacro oracle-funcall 48878,1968697
-(defun all-nils 48912,1969805
-(defun oracle-apply-guard 48918,1969971
-(defun oracle-apply 48931,1970465
-(defun oracle-apply-raw 49057,1976100
-(defun time-tracker-fn 49092,1977556
-(defmacro time-tracker 49161,1979867
-(defmacro time-tracker 49166,1980065
-(defdoc time-tracker49170,1980135
-(defdoc time-tracker-tau49411,1992959
-(defg *inside-absstobj-update* 49478,1995556
-(defun set-absstobj-debug-fn 49480,1995594
-(defmacro set-absstobj-debug 49511,1997026
-(defun <? 49749,2007176
-(defun tau-interval-domainp 49783,2008342
-(defun tau-interval-dom 49791,2008598
-(defun tau-interval-lo-rel 49812,2009166
-(defun tau-interval-lo 49834,2009914
-(defun tau-interval-hi-rel 49856,2010613
-(defun tau-interval-hi 49877,2011360
-(defun make-tau-interval 49899,2012059
-(defun tau-intervalp 49959,2014802
-(defun in-tau-intervalp 50071,2018961
-
-memoize.lisp,831
-(defmacro defn 31,1268
-(defmacro defnd 40,1466
-(defdoc hons-and-memoization49,1682
-(defn clear-memoize-table 364,17583
-(defn clear-memoize-tables 379,18018
-(defn memoize-summary 395,18526
-(defn clear-memoize-statistics 410,19062
-(defmacro memsum 423,19510
-(defconst *hons-primitive-fns*444,20337
-(defconst *hons-primitives*473,20939
-(defconst *mht-default-size* 484,21211
-(defun memoize-form 486,21245
-(defmacro memoize 634,28081
-(defmacro unmemoize 921,43447
-(defmacro profile 972,45052
-(defmacro memoize-on-raw 1025,47519
-(defmacro memoize-on 1029,47587
-(defmacro memoize-off-raw 1040,47969
-(defmacro memoize-off 1044,48038
-(defmacro memoizedp-world 1054,48412
-(defmacro memoizedp 1065,48789
-(defparameter *never-profile-ht*1094,49641
-(defun never-memoize-fn 1098,49739
-(defmacro never-memoize 1103,49842
-
-hons.lisp,1363
-(defdoc normed35,1575
-(defn hons-copy 102,4467
-(defn hons-copy-persistent 141,6056
-(defn hons 164,6943
-(defn hons-equal 196,8130
-(defn hons-equal-lite 222,9274
-(defn hons-clear 248,10388
-(defn hons-wash 282,11784
-(defn hons-summary 316,13304
-(defmacro hons-resize 339,14200
-(defn hons-resize-fn 418,17291
-(defdoc hons-note427,17635
-(defdoc fast-alists491,20704
-(defn hons-assoc-equal 538,23041
-(defdoc slow-alist-warning563,24030
-(defmacro set-slow-alist-action 592,25244
-(defn get-slow-alist-action 598,25474
-(defn hons-get 606,25743
-(defn hons-acons 628,26672
-(defn hons-acons! 694,29637
-(defn make-fast-alist 758,32300
-(defn hons-shrink-alist 783,33378
-(defn hons-shrink-alist! 832,35378
-(defn fast-alist-len 853,36267
-(defn fast-alist-free 873,37101
-(defn fast-alist-summary 901,38211
-(defdoc with-fast-alist920,38911
-(defdoc with-stolen-alist989,41311
-(defdoc fast-alist-free-on-exit1010,42322
-(defined in 1032,43100
-(defmacro with-fast-alist-raw 1047,43528
-(defmacro with-fast-alist 1052,43649
-(defmacro with-stolen-alist-raw 1056,43774
-(defmacro with-stolen-alist 1061,43897
-(defmacro fast-alist-free-on-exit-raw 1065,44026
-(defmacro fast-alist-free-on-exit 1070,44155
-(defn cons-subtrees 1073,44263
-(defn number-subtrees 1093,44816
-(defn clear-hash-tables 1112,45486
-(defn flush-hons-get-hash-table-link 1126,45931
-
-serialize.lisp,287
-(defdoc serialize38,1448
-(defmacro serialize-write 55,2188
-(defun serialize-write-fn 84,3117
-(defmacro serialize-read 117,4200
-(defun serialize-read-fn 160,6021
-(defdoc serialize-alternatives196,7254
-(defdoc serialize-in-books212,7966
-(defmacro with-serialize-character 255,9650
-
-basis.lisp,17837
-(defun enforce-redundancy-er-args 39,1746
-(defmacro enforce-redundancy 48,2209
-(defdoc gcl71,3270
-(defun wormhole-statusp 307,14303
-(defun wormhole-entry-code 326,14818
-(defun wormhole-data 345,15378
-(defun set-wormhole-entry-code 361,15809
-(defun set-wormhole-data 388,16833
-(defun make-wormhole-status 412,17694
-(defun tree-occur-eq 471,20320
-(defun wormhole-eval 482,20570
-(deflock *wormhole-lock*)585,25641
-(defmacro wormhole-eval 588,25685
-(defmacro wormhole 644,28280
-(deflabel wormhole-implementation1159,52912
-(defun global-set 1242,57403
-(defun defabbrev1 1247,57574
-(defun legal-variable-or-constant-namep 1253,57776
-(defun legal-constantp1 1319,60693
-(defun tilde-@-illegal-variable-or-constant-name-phrase 1334,61190
-(defun legal-constantp 1365,62869
-(defun defined-constant 1375,63183
-(defun legal-variablep 1392,63922
-(defun genvar1 1400,64207
-(defun genvar 1436,65983
-(defun packn1 1478,68167
-(defun packn 1484,68351
-(defun packn-pos 1492,68596
-(defun pack2 1498,68833
-(defun gen-formals-from-pretty-flags1 1501,68879
-(defun gen-formals-from-pretty-flags 1526,69902
-(defun defstub-body 1538,70496
-(defun collect-non-x 1561,71330
-(defmacro defproxy 1573,71709
-(defmacro defproxy 1910,83557
-(defun defstub-ignores 1926,84341
-(defun partition-rest-and-keyword-args1 1950,85218
-(defun partition-rest-and-keyword-args2 1959,85519
-(defun partition-rest-and-keyword-args 1976,86215
-(defmacro defstub 1995,87005
-(defun lambda-keywordp 2099,91713
-(defun arglistp1 2103,91808
-(defun arglistp 2111,91997
-(defun find-first-bad-arg 2115,92073
-(defun process-defabbrev-declares 2143,93442
-(defmacro defabbrev 2166,94524
-(defconst *primitive-formals-and-guards*2303,100788
-(defconst *primitive-monadic-booleans*2382,103814
-(defun equal-x-constant 2405,104415
-(defun match-tests-and-bindings 2421,104882
-(defun match-clause 2495,108206
-(defun match-clause-list 2503,108454
-(defmacro case-match 2511,108765
-(defconst *non-standard-primitives*2594,112166
-(defun cons-term1-cases 2599,112257
-(defconst *cons-term1-alist*2647,114445
-(defmacro cons-term1-body 2650,114528
-(defun quote-listp 2659,114795
-(defun cons-term1 2665,114957
-(defun cons-term 2670,115114
-(defmacro cons-term* 2676,115282
-(defmacro mcons-term 2679,115354
-(defmacro mcons-term* 2686,115531
-(defmacro fcons-term 2693,115722
-(defun fargn1 2710,116383
-(defmacro fargn 2716,116567
-(defun cdr-nest 2719,116618
-(defun all-but-last 2723,116692
-(defconst *evisceration-mark* 2759,118501
-(defconst *evisceration-hash-mark* 2769,119002
-(defconst *evisceration-ellipsis-mark* 2770,119069
-(defconst *evisceration-world-mark*2771,119142
-(defconst *evisceration-state-mark*2773,119218
-(defconst *evisceration-error-triple-marks*2775,119294
-(defconst *evisceration-hiding-mark*2777,119382
-(defconst *anti-evisceration-mark*2780,119461
-(defmacro evisceratedp 2783,119548
-(defconst *sharp-atsign-ar* 2869,124621
-(defun get-sharp-atsign 2878,124996
-(defun update-iprint-alist 2888,125334
-(defun eviscerate1 2908,126117
-(defun eviscerate1-lst 2940,127628
-(defun eviscerate1p 2974,129004
-(defun eviscerate1p-lst 2990,129677
-(defun eviscerate 3002,130155
-(defun eviscerate-simple 3062,132771
-(defun aset1-lst 3074,133259
-(defun iprint-hard-bound 3084,133574
-(defun iprint-soft-bound 3087,133651
-(defun iprint-last-index* 3090,133728
-(defun iprint-last-index 3097,133938
-(defun iprint-ar-illegal-index 3100,134028
-(defun iprint-enabledp 3109,134371
-(defun iprint-ar-aref1 3112,134466
-(defun collect-posp-indices-to-header 3135,135241
-(defun rollover-iprint-ar 3151,135834
-(defun update-iprint-ar 3224,139301
-(defun eviscerate-top 3247,140280
-(defun world-evisceration-alist 3264,141102
-(defun stobj-print-name 3271,141330
-(defun evisceration-stobj-mark 3278,141494
-(defun evisceration-stobj-marks1 3290,141806
-(defconst *error-triple-sig*3302,142214
-(defconst *cmp-sig*3305,142264
-(defun evisceration-stobj-marks 3308,142299
-(defun eviscerate-stobjs1 3316,142609
-(defun eviscerate-stobjs 3337,143673
-(defun eviscerate-stobjs-top 3386,145727
-(defmacro mv-letc 3458,149678
-(defmacro er-hard-val 3463,149805
-(defmacro the-fixnum! 3473,150149
-(defmacro the-half-fixnum! 3491,150723
-(defmacro the-unsigned-byte! 3509,151354
-(defmacro the-string! 3518,151659
-(defun xxxjoin-fixnum 3525,151823
-(defmacro +f 3540,152227
-(defmacro -f 3543,152284
-(defmacro 1-f 3549,152458
-(defmacro 1+f 3553,152539
-(defmacro charf 3557,152620
-(defmacro *f 3561,152694
-(defmacro ppr-flat-right-margin 3852,164733
-(defun set-ppr-flat-right-margin 3855,164817
-(defun keyword-param-valuep 3868,165383
-(defun cons-ppr1 3888,166340
-(defun flsz-integer 4030,172331
-(defun flsz-atom 4040,172709
-(defun flsz1 4116,175983
-(defun output-in-infixp 4149,177297
-(defun flatsize-infix 4153,177419
-(defun flsz 4169,178133
-(defun max-width 4175,178397
-(defun ppr1 4183,178608
-(defun ppr1-lst 4278,182915
-(defun newline 4324,184908
-(defun fmt-hard-right-margin 4327,184976
-(defun fmt-soft-right-margin 4331,185077
-(defun set-fmt-hard-right-margin 4335,185178
-(defun set-fmt-soft-right-margin 4371,186506
-(defun write-for-read 4393,187162
-(defun spaces1 4396,187233
-(defun make-spaces-array-rec 4413,187954
-(defun make-spaces-array 4423,188181
-(defconst *acl2-built-in-spaces-array*4432,188487
-(defun spaces 4438,188610
-(defun flpr1 4460,189365
-(defun flpr11 4473,189828
-(defun-one-output print-flat-infix 4490,190331
-(defun flpr 4504,190839
-(defun ppr2-flat 4516,191242
-(defun ppr2-column 4536,191894
-(defun ppr2 4553,192595
-(defconst *fmt-ppr-indentation* 4600,194554
-(defun ppr 4602,194590
-(defun scan-past-whitespace 4628,195638
-(defun zero-one-or-more 4638,195965
-(defun find-alternative-skip 4646,196134
-(defun find-alternative-start1 4684,197611
-(defun fmt-char 4727,199571
-(defun find-alternative-start 4749,200423
-(defun find-alternative-stop 4781,201893
-(defun punctp 4817,203408
-(defun fmt-tilde-s1 4822,203497
-(defun fmt-var 4877,205916
-(defun splat-atom 4889,206482
-(defun splat 4907,207213
-(defun splat1 4920,207782
-(defun number-of-digits 4954,209520
-(defun left-pad-with-blanks 4972,210192
-(defmacro maybe-newline 4992,210958
-(defun evisc-tuple 5019,212203
-(defun standard-evisc-tuplep 5083,215084
-(defun abbrev-evisc-tuple 5094,215391
-(defmacro gag-mode 5110,216087
-(defun default-evisc-tuple 5124,216391
-(defun term-evisc-tuple 5132,216806
-(defun gag-mode-evisc-tuple 5161,218057
-(defun ld-evisc-tuple 5169,218294
-(deflabel eviscerate-hide-terms5195,219578
-(defun-one-output print-infix 5213,220177
-(defun fmt-ppr 5253,222053
-(defun fmt0* 5270,222580
-(defun fmt0&v 5309,224372
-(defun spell-number 5355,226358
-(defun fmt-tilde-s 5425,229862
-(defun fmt0 5475,231779
-(defun tilde-*-&v-strings 5921,255562
-(defun fmt1 5966,257501
-(defun fmt 5990,258310
-(defun fms 6429,278201
-(defun fmt1! 6447,278679
-(defun fmt! 6470,279516
-(defun fms! 6493,280329
-(defmacro fmx 6515,281106
-(defun fmt-doc-example1 6522,281371
-(defun fmt-doc-example 6530,281681
-(defun fmt-abbrev1 6551,282772
-(defun fmt-abbrev 6569,283564
-(defconst *fmt-ctx-spacers*6575,283760
-(defun fmt-ctx 6604,284305
-(defun fmt-in-ctx 6647,285976
-(defun error-fms-channel 6663,286517
-(defun error-fms 6686,287472
-(defvar *accumulated-warnings* 6700,287874
-(defun push-warning-frame 6702,287911
-(defun absorb-frame 6708,288048
-(defun pop-warning-frame 6714,288170
-(defun push-warning 6749,289692
-(defun member-string-equal 6772,290595
-(defabbrev flambda-applicationp 6778,290750
-(defabbrev lambda-applicationp 6784,290850
-(defabbrev flambdap 6788,290946
-(defabbrev lambda-formals 6794,291036
-(defabbrev lambda-body 6796,291077
-(defabbrev make-lambda 6798,291116
-(defabbrev make-let 6801,291180
-(defun doubleton-list-p 6804,291246
-(defmacro er-let* 6810,291433
-(defmacro er-let*@par 6838,292455
-(defmacro match 6863,293398
-(defmacro match! 6866,293460
-(defun def-basic-type-sets1 6873,293688
-(defmacro def-basic-type-sets 6880,293981
-(defun list-of-the-type-set 6894,294449
-(defmacro ts=6900,294611
-(defmacro ts-complement0 6906,294819
-(defmacro ts-complementp 6909,294911
-(defun ts-union0-fn 6912,294961
-(defmacro ts-union0 6919,295174
-(defmacro ts-intersection0 6923,295267
-(defmacro ts-disjointp 6927,295377
-(defmacro ts-intersectp 6930,295464
-(defun ts-builder-case-listp 6937,295788
-(defun ts-builder-macro1 6970,297161
-(defun ts-builder-macro 6990,298136
-(defmacro ts-builder 6996,298345
-(defabbrev strip-not 7002,298576
-(defun record-maker-function-name 7223,307183
-(defun record-changer-function-name 7233,307482
-(defmacro make 7242,307719
-(defmacro change 7252,308076
-(defun make-record-car-cdrs1 7260,308409
-(defun make-record-car-cdrs 7264,308543
-(defun make-record-accessors 7273,309002
-(defun symbol-name-tree-occur 7297,310159
-(defun some-symbol-name-tree-occur 7313,310747
-(defun make-record-changer-cons 7318,310946
-(defun make-record-changer-let-bindings 7337,311692
-(defun make-record-changer-let 7359,312730
-(defun make-record-changer 7385,313926
-(defun make-record-maker-cons 7396,314240
-(defun make-record-maker-let 7423,315434
-(defun make-record-maker 7436,315910
-(defun make-record-field-lst 7446,316186
-(defun record-maker-recognizer-name 7453,316470
-(defun make-record-recognizer-body 7463,316772
-(defun make-record-recognizer 7487,317525
-(defun record-macros 7496,317912
-(defmacro defrec 7518,319068
-(defabbrev equalityp 7526,319363
-(defabbrev inequalityp 7537,319727
-(defabbrev consityp 7548,320089
-(defun power-rep 7557,320313
-(defun decode-idate 7563,320425
-(defun pcd2 7586,321191
-(defun print-idate 7593,321407
-(defun print-current-idate 7621,322343
-(defconst *window-descriptions*7676,325398
-(defun io?-nil-output 7694,325994
-(defmacro check-exact-free-vars 7701,326286
-(defun formal-bindings 7728,327415
-(defrec io-record7740,327762
-(defmacro io-record-forms 7751,328051
-(defun push-io-record 7758,328208
-(defun saved-output-token-p 7766,328511
-(defun io?-wormhole-bindings 7771,328741
-(defmacro io? 7779,329046
-(defmacro io?@par 7925,335828
-(defmacro io?-prove 7938,336267
-(defmacro io?-gag 7946,336446
-(defun output-ignored-p 7951,336587
-(defun error1 7956,336760
-(defun error1@par 7997,338214
-(defun error1-safe 8009,338534
-(defconst *uninhibited-warning-summaries*8020,338805
-(defun warning-off-p1 8034,339210
-(defun warning-off-p 8058,340204
-(defrec state-vars8061,340304
-(defmacro default-state-vars8071,340552
-(defun warning1-body 8125,342970
-(defmacro warning1-form 8141,343480
-(defun warning1 8175,344608
-(defmacro warning$ 8182,344811
-(defmacro warning-disabled-p 8210,345947
-(defmacro observation1-body 8222,346330
-(defun observation1 8247,347493
-(defun observation1-cw 8255,347698
-(defmacro observation 8258,347772
-(defmacro observation-cw 8346,351433
-(defun skip-when-logic 8376,352528
-(defun chk-inhibit-output-lst 8384,352777
-(defconst *ld-special-error*8417,354374
-(defun chk-ld-skip-proofsp 8421,354488
-(defun set-ld-skip-proofsp 8431,354819
-(defmacro set-ld-skip-proofs 8439,355038
-(defun set-write-acl2x 8448,355333
-(defconst *check-sum-exclusive-maximum* 8670,367576
-(defconst *check-length-exclusive-maximum* 8674,367727
-(defconst *-check-sum-exclusive-maximum* 8682,367999
-(defconst *1-check-length-exclusive-maximum*8684,368076
-(defun ascii-code! 8687,368163
-(defun check-sum1 8696,368309
-(defun check-sum 8722,369663
-(defun check-sum-inc 8788,373221
-(defun check-sum-natural 8819,374698
-(defun check-sum-string1 8826,374990
-(defun check-sum-string2 8844,375744
-(defun check-sum-string 8866,376633
-(defun check-sum-obj1 8872,376882
-(defun old-check-sum-obj 8913,378781
-(defun plus-mod-m31 8984,382626
-(defun double-mod-m31 9018,384147
-(defun times-expt-2-16-mod-m31 9033,384649
-(defun times-mod-m31 9079,386649
-(defun fchecksum-natural-aux 9149,389656
-(defun fchecksum-natural 9200,391631
-(defun fchecksum-string1 9205,391761
-(defun fchecksum-string2 9263,394180
-(defun fchecksum-string 9307,395940
-(defvar *fchecksum-symbol-memo*9332,396919
-(defun fchecksum-atom 9335,396959
-(defun fchecksum-obj 9407,400165
-(defun check-sum-obj 9442,401690
-(defun read-file-iterate 9577,406338
-(defun read-file 9584,406560
-(defun formals 9594,406926
-(defun arity 9607,407432
-(defun stobjs-out 9613,407656
-(deflabel user-defined-functions-table9630,408198
-(defconst *user-defined-functions-table-keys*9708,411516
-(defrec def-body9725,412165
-(defun latest-body 9739,412504
-(defun def-body 9745,412645
-(defun body 9748,412735
-(defun symbol-class 9776,414269
-(defmacro fdefun-mode 9829,417159
-(defmacro programp 9837,417325
-(defmacro logicalp 9840,417398
-(defun program-termp 9845,417496
-(defun program-term-listp 9854,417841
-(defdoc common-lisp9860,418007
-(deflabel defun-mode-caveat9897,419979
-(deflabel generalized-booleans9995,424605
-(defun defun-mode 10101,428444
-(defun get-stobj-recognizer 10251,435535
-(defun stobj-recognizer-terms 10262,435972
-(defun mcons-term-smart 10272,436398
-(defun optimize-stobj-recognizers1 10285,436726
-(defun optimize-stobj-recognizers1-lst 10329,438623
-(defun optimize-stobj-recognizers 10337,438975
-(defun guard 10362,440109
-(defdoc extra-info10425,442875
-(defdoc guard-debug10433,443119
-(deflabel guard-quick-reference10527,447640
-(deflabel guard-introduction10603,450506
-(deflabel guards-and-evaluation10651,452890
-(deflabel guards-for-specification11025,469778
-(deflabel guard-miscellany11082,472141
-(deflabel guard-evaluation-examples-script11160,476537
-(deflabel guard-evaluation-examples-log11323,482019
-(deflabel guard-evaluation-table12050,501811
-(defun guard-lst 12164,507839
-(defmacro equivalence-relationp 12169,508005
-(defun >=12194,509002
-(defun all->=12202,509170
-(defun strip-cadrs 12209,509359
-(defun strip-cddrs 12216,509559
-(defun global-set-lst 12221,509703
-(defmacro cons-term1-body-mv2 12228,509960
-(defun cons-term1-mv2 12238,510299
-(defun sublis-var1 12245,510488
-(defun sublis-var1-lst 12265,511354
-(defun sublis-var 12280,511961
-(defun sublis-var-lst 12306,512992
-(defun subcor-var1 12315,513316
-(defun subcor-var 12326,513717
-(defun subcor-var-lst 12342,514396
-(defun car-cdr-nest1 12356,514928
-(defun car-cdr-nest 12370,515436
-(defun collect-non-trivial-bindings 12393,516141
-(defun untranslate-and 12400,516435
-(defun untranslate-or 12416,516875
-(defun case-length 12426,517132
-(defun cond-length 12460,518477
-(defconst *untranslate-boolean-primitives*12468,518711
-(defun right-associated-args 12471,518767
-(defun dumb-negate-lit 12485,519279
-(defun dumb-negate-lit-lst 12502,519844
-(defun term-stobjs-out-alist 12509,520020
-(defun term-stobjs-out 12518,520317
-(defun accessor-root 12561,521925
-(defvar *load-compiled-stack* 12598,523769
-(defun observe-raw-mode-setting 12601,523822
-(defmacro progn! 12682,527933
-(defmacro progn! 12811,533991
-(defun ld-redefinition-action 12851,536011
-(deflabel redefining-programs13020,545641
-(defun chk-ld-redefinition-action 13149,552334
-(defun set-ld-redefinition-action 13157,552675
-(defmacro redef 13164,552887
-(defmacro redef! 13183,553470
-(defmacro redef+ 13202,554054
-(defmacro redef- 13250,555779
-(defun chk-current-package 13284,556798
-(defun set-current-package 13289,557005
-(defun standard-oi 13300,557280
-(defun read-standard-oi 13326,558499
-(defun chk-standard-oi 13339,558987
-(defun set-standard-oi 13352,559361
-(defun standard-co 13358,559553
-(defun chk-standard-co 13380,560499
-(defun set-standard-co 13387,560701
-(defun proofs-co 13394,560869
-(defun chk-proofs-co 13412,561496
-(defun set-proofs-co 13419,561694
-(deflabel prompt13426,561854
-(defun ld-prompt 13447,562743
-(defun chk-ld-prompt 13490,564821
-(defun set-ld-prompt 13501,565237
-(defun ld-keyword-aliases 13508,565397
-(defun ld-keyword-aliasesp 13557,567752
-(defun chk-ld-keyword-aliases 13584,568752
-(defun set-ld-keyword-aliases 13589,568937
-(defun ld-missing-input-ok 13596,569133
-(defun msgp 13618,570072
-(defun chk-ld-missing-input-ok 13624,570194
-(defun set-ld-missing-input-ok 13631,570446
-(defun ld-pre-eval-filter 13638,570646
-(defun new-namep 13668,572088
-(defun chk-ld-pre-eval-filter 13761,575884
-(defun set-ld-pre-eval-filter 13771,576298
-(defun ld-pre-eval-print 13778,576494
-(defun chk-ld-pre-eval-print 13814,578363
-(defun set-ld-pre-eval-print 13819,578542
-(defun ld-post-eval-print 13826,578734
-(defun chk-ld-post-eval-print 13888,582367
-(defun set-ld-post-eval-print 13893,582562
-(defun ld-error-triples 13900,582758
-(defun chk-ld-error-triples 13925,583920
-(defun set-ld-error-triples 13930,584090
-(defun ld-error-action 13937,584278
-(defun chk-ld-error-action 14052,590565
-(defun set-ld-error-action 14057,590761
-(defun ld-query-control-alist 14064,590945
-(defun ld-query-control-alistp 14122,594188
-(defun cdr-assoc-query-id 14136,594678
-(defun chk-ld-query-control-alist 14141,594839
-(defun set-ld-query-control-alist 14147,595019
-(defun ld-verbose 14154,595231
-(defun chk-ld-verbose 14185,596670
-(defun set-ld-verbose 14194,596947
-(defconst *nqthm-to-acl2-primitives*14201,597111
-(defconst *nqthm-to-acl2-commands*14269,599079
-(defun nqthm-to-acl2-fn 14361,602779
-(defmacro nqthm-to-acl2 14480,607314
-(defun allocate-fixnum-range 14688,615372
-(defmacro allegro-allocate-slowly 14747,618198
-(defun allegro-allocate-slowly-fn 14756,618757
-(defmacro clear-pstk 14793,620374
-(defconst *pstk-vars*14800,620554
-(defun pstk-bindings-and-args 14815,620777
-(defmacro pstk 14847,621858
-(defun pstack-fn 14895,623702
-(defmacro pstack 14918,624561
-(defun verbose-pstack 14987,627000
-(defun pop-inhibit-output-lst-stack 15020,628249
-(defun push-inhibit-output-lst-stack 15030,628680
-(defun set-gc-threshold$-fn 15036,628925
-(defmacro set-gc-threshold$ 15104,631883
-
-parallel.lisp,2398
-(defdoc deflock49,1910
-(defdoc compiling-acl2p133,5099
-(defdoc parallel172,6442
-(defdoc parallelism-build182,6596
-(defun set-parallel-execution-fn 190,6749
-(defmacro set-parallel-execution 231,8769
-(defdoc parallel-execution291,11345
-(defun waterfall-printing-value-for-parallelism-value 301,11627
-(defdoc unsupported-waterfall-parallelism-features335,13125
-(defdoc unsupported-parallelism-features492,21395
-(defdoc waterfall-printing534,23391
-(defdoc waterfall-parallelism542,23565
-(defun print-set-waterfall-parallelism-notice 550,23738
-(defun check-for-no-override-hints 586,25276
-(defun set-waterfall-parallelism-fn 616,26726
-(defmacro set-waterfall-parallelism1 706,31141
-(defmacro save-memo-table 735,32355
-(defun clear-memo-table-events 743,32539
-(defmacro clear-memo-table 751,32808
-(defmacro save-and-clear-memoization-settings 759,33029
-(defun set-memo-table-events 785,33703
-(defmacro restore-memoization-settings 793,33979
-(defmacro set-waterfall-parallelism 819,34577
-(defdoc waterfall-parallelism-for-book-certification970,41910
-(defun set-waterfall-printing-fn 1001,43191
-(defmacro set-waterfall-printing 1023,44114
-(defun set-waterfall-parallelism-hacks-enabled-guard 1099,47512
-(defmacro set-waterfall-parallelism-hacks-enabled 1110,47976
-(defmacro set-waterfall-parallelism-hacks-enabled! 1148,49563
-(defdoc parallelism-at-the-top-level1168,50190
-(defdoc parallelism-tutorial1223,52539
-(defdoc granularity1507,63922
-(defdoc parallelism-performance1615,68363
-(defdoc early-termination1652,70135
-(defdoc parallel-pushing-of-subgoals-for-induction1702,72336
-(defun caar-is-declarep 1744,74768
-(defun declare-granularity-p 1753,74979
-(defun check-and-parse-for-granularity-form 1766,75357
-(defmacro pargs 1803,77045
-(defmacro plet 1858,79471
-(defun binary-pand 1908,81361
-(defmacro pand 1916,81509
-(defun binary-por 2010,85305
-(defmacro por 2018,85461
-(defun or-list 2083,87981
-(defun and-list 2091,88136
-(defun cpu-core-count 2098,88283
-(defmacro spec-mv-let 2324,98021
-(defdoc error-triples-and-parallelism2448,103112
-(defdoc with-output-lock2498,105651
-(defdoc acl2p-key-checkpoints2600,108604
-(defun set-total-parallelism-work-limit-fn 2715,113681
-(defmacro set-total-parallelism-work-limit 2720,113889
-(defun set-total-parallelism-work-limit-error-fn 2776,116331
-(defmacro set-total-parallelism-work-limit-error 2781,116543
-
-hons-raw.lisp,5514
-(defconstant *hl-mht-default-rehash-size* 92,4372
-(defconstant *hl-mht-default-rehash-threshold* 93,4419
-(defun hl-mht 95,4472
-(defconstant hl-cache-table-size244,11754
-(defconstant hl-cache-table-cutoff249,11841
-(defstruct hl-cache253,11976
-(defabbrev hl-machine-hash 267,12345
-(defun hl-cache-set 291,13410
-(defun hl-cache-get 316,14347
-(defun hl-cache-clear 343,15102
-(defparameter *hl-hspace-str-ht-default-size* 567,25296
-(defparameter *hl-ctables-nil-ht-default-size* 568,25353
-(defparameter *hl-ctables-cdr-ht-default-size* 569,25410
-(defparameter *hl-ctables-cdr-ht-eql-default-size* 570,25469
-(defparameter *hl-hspace-addr-ht-default-size* 571,25526
-(defparameter *hl-hspace-sbits-default-size* 572,25585
-(defparameter *hl-hspace-other-ht-default-size* 573,25646
-(defparameter *hl-hspace-fal-ht-default-size* 574,25703
-(defparameter *hl-hspace-persist-ht-default-size* 575,25760
-(defstruct hl-ctables580,25833
-(defun hl-initialize-faltable-table 597,26399
-(defstruct hl-falslot638,28510
-(defstruct (hl-faltable 660,29241
-(defun hl-faltable-init 684,30179
-(defstruct (hl-hspace 689,30321
-(defun hl-hspace-init 740,31777
-(defabbrev hl-flex-alist-too-long 822,35611
-(defabbrev hl-flex-assoc 838,36213
-(defabbrev hl-flex-acons 848,36509
-(defun hl-hspace-truly-static-honsp 890,38014
-(defabbrev hl-hspace-find-alist-for-cdr 905,38557
-(defun hl-hspace-honsp 925,39283
-(defun hl-hspace-honsp-wrapper 943,39750
-(defun hl-hspace-faltable-wrapper 949,39944
-(defun hl-hspace-normedp 956,40142
-(defun hl-hspace-normedp-wrapper 977,40688
-(defun hl-hspace-hons-equal-lite 990,41087
-(defun hl-hspace-hons-equal 1010,41658
-(defconstant hl-minimum-static-int1086,44643
-(defconstant hl-maximum-static-int1091,44783
-(defconstant hl-num-static-ints1096,44919
-(defconstant hl-dynamic-base-addr1101,45102
-(defconstant hl-static-int-shift1110,45391
-(ccl::defstatic *hl-symbol-addr-lock*1118,45780
-(defabbrev hl-symbol-addr 1123,45945
-(defun hl-addr-of-unusual-atom 1171,48156
-(defmacro hl-addr-of 1214,49860
-(defun hl-nat-combine* 1237,50769
-(defabbrev hl-addr-combine* 1251,51327
-(defparameter *hl-addr-limit-minimum*1331,55267
-(defun hl-make-addr-limit-current 1339,55592
-(defun hl-make-addr-limit-next 1352,56022
-(defun hl-addr-ht-fullness 1370,56778
-(defparameter *hl-addr-limit-should-clear-memo-tables*1376,57001
-(defun hl-addr-limit-action 1381,57121
-(defun hl-hspace-grow-sbits 1441,59604
-(defun hl-hspace-norm-atom 1485,61857
-(defun hl-hspace-hons-normed 1523,63181
-(defun hl-hspace-norm-aux 1677,70918
-(defun hl-hspace-norm-expensive 1703,71858
-(defun hl-hspace-norm 1721,72493
-(defun hl-hspace-persistent-norm 1730,72714
-(defabbrev hl-hspace-hons 1755,73751
-(defun hl-slow-alist-warning 1858,78298
-(defun hl-faltable-maphash 1876,79063
-(defun hl-faltable-load-empty-slot 1903,79928
-(defun hl-faltable-eject 1926,80815
-(defun hl-faltable-get-free-slot 1944,81499
-(defun hl-faltable-slot-lookup 1959,82066
-(defun hl-faltable-general-lookup 1986,83098
-(defun hl-faltable-remove 2001,83753
-(defun hl-hspace-fast-alist-free 2024,84769
-(defun hl-hspace-hons-get 2032,84973
-(defun hl-hspace-hons-acons 2058,86006
-(defun hl-alist-stolen-warning 2118,88450
-(defun hl-hspace-hons-acons! 2136,89204
-(defun hl-alist-longest-normed-tail 2185,91151
-(defun hl-make-fast-norm-keys 2205,91948
-(defun hl-make-fast-alist-put-pairs 2231,92925
-(defun hl-hspace-make-fast-alist 2247,93582
-(defun hl-shrink-alist-aux-really-slow 2299,95969
-(defun hl-shrink-alist-aux-slow 2321,96967
-(defun hl-shrink-alist-aux-fast 2347,98152
-(defun hl-hspace-shrink-alist 2378,99529
-(defun hl-hspace-fast-alist-len 2452,102887
-(defun hl-check-alist-for-serialize-restore 2471,103611
-(defun hl-hspace-restore-fal-for-serialize 2490,104283
-(defun hl-restore-fal-for-serialize 2516,105527
-(defun hl-hspace-number-subtrees-aux 2527,105921
-(defun hl-hspace-number-subtrees 2539,106255
-(defun hl-system-gc 2566,107171
-(defun hl-hspace-classic-restore 2585,107715
-(defun hl-hspace-hons-clear 2641,110102
-(defun hl-hspace-static-restore 2721,113412
-(defun hl-hspace-hons-clear 2763,115246
-(defun hl-fix-sbits-after-gc 2859,119441
-(defun hl-rebuild-addr-ht 2880,120248
-(defparameter *hl-addr-ht-resize-cutoff*2917,122063
-(defun hl-hspace-hons-wash 2925,122436
-(defun hl-maybe-resize-ht 3073,129310
-(defun hl-hspace-resize 3101,130477
-(defun hl-get-final-cdr 3178,133299
-(defun hl-hspace-fast-alist-summary 3183,133400
-(defun hl-hspace-hons-summary 3226,135179
-(defparameter *default-hs*3310,138343
-(defun hl-maybe-initialize-default-hs 3340,139490
-(defun hl-maybe-initialize-default-hs-wrapper 3347,139630
-(defun hons 3351,139754
-(defun hons-copy 3356,139890
-(defun hons-copy-persistent 3361,140027
-(defun hons-equal 3367,140194
-(defun hons-equal-lite 3373,140399
-(defun hons-summary 3378,140584
-(defun hons-clear 3383,140707
-(defun hons-wash 3388,140831
-(defun hons-resize-fn 3393,140948
-(defun hons-acons 3405,141369
-(defun hons-acons! 3411,141586
-(defun hons-shrink-alist 3416,141774
-(defun hons-shrink-alist! 3421,141925
-(defun hons-get 3427,142103
-(defun fast-alist-free 3433,142310
-(defun fast-alist-len 3439,142529
-(defun number-subtrees 3445,142746
-(defun fast-alist-summary 3450,142927
-(defun make-fast-alist 3455,143062
-(defmacro with-fast-alist-raw 3460,143202
-(defmacro with-stolen-alist-raw 3489,144434
-(defmacro fast-alist-free-on-exit-raw 3518,145693
-(defun clear-hash-tables 3525,145882
-(defun wash-memory 3530,145996
-
-memoize-raw.lisp,7816
-(defconstant most-positive-mfixnum 69,2711
-(deftype mfixnum 71,2765
-(defmacro our-syntax 86,3276
-(defmacro our-syntax-nice 112,4228
-(defmacro our-syntax-brief 122,4588
-(defmacro ofn 131,4813
-(defun-one-output ofnum 134,4895
-(defmacro ofni 145,5220
-(defmacro ofnm 148,5343
-(defmacro oft 151,5451
-(defmacro oftr 155,5582
-(defv *number-of-arguments-and-values-ht*165,5858
-(defun-one-output input-output-number-error 208,7395
-(defun-one-output number-of-arguments 218,7889
-(defun-one-output number-of-return-values 242,8711
-(defg *float-ticks/second* 265,9496
-(defg *float-internal-time-units-per-second*267,9529
-(defabbrev internal-real-time 273,9712
-(defun-one-output float-ticks/second-init 281,10037
-(defun-one-output safe-incf-aux-error 303,10770
-(defmacro safe-incf-aux 307,10912
-(defmacro safe-incf 338,12083
-(defparameter *count-pons-calls* 384,13857
-(defg *pons-call-counter* 390,14101
-(defg *pons-misses-counter* 391,14130
-(defmacro maybe-count-pons-calls 395,14254
-(defmacro maybe-count-pons-misses 399,14384
-(defun-one-output assoc-no-error-at-end 403,14518
-(defun-one-output too-long 419,15062
-(defconstant atom-case-fudge 432,15669
-(defconstant most-positive-fudge 433,15719
-(defconstant most-negative-fudge 434,15770
-(defconstant -most-negative-fudge 435,15820
-(defun-one-output atom-case 438,15890
-(defmacro sqmpf 457,16642
-(defmacro hmnf 460,16694
-(defmacro static-hons-shift 466,16784
-(defun-one-output addr-for 470,16883
-(defun-one-output pons 529,19370
-(defmacro pist* 608,21885
-(defparameter *record-bytes*1008,33601
-(defparameter *record-calls* 1016,33921
-(defparameter *record-hits* 1020,34043
-(defparameter *record-hons-calls* 1025,34218
-(defparameter *record-mht-calls* 1029,34344
-(defparameter *record-pons-calls* 1034,34545
-(defparameter *record-time* 1038,34683
-(defv *report-bytes* 1045,34870
-(defv *report-calls* 1049,35026
-(defv *report-calls-from* 1053,35131
-(defv *report-calls-to* 1058,35303
-(defv *report-hits* 1063,35483
-(defv *report-hons-calls* 1067,35631
-(defv *report-mht-calls* 1071,35772
-(defv *report-pons-calls* 1079,36191
-(defv *report-time* 1083,36314
-(defv *report-on-memo-tables* 1087,36448
-(defv *report-on-pons-tables* 1091,36581
-(defg *memoize-info-ht*1095,36714
-(defrec memoize-info-ht-entry1106,37019
-(defg *memoize-call-array*1150,38966
-(defg *compute-array* 1182,40655
-(defv *initial-max-memoize-fns* 1199,41173
-(defg *2max-memoize-fns* 1201,41211
-(defconstant *ma-bytes-index* 1203,41270
-(defconstant *ma-hits-index* 1204,41309
-(defconstant *ma-mht-index* 1205,41348
-(defconstant *ma-hons-index* 1206,41387
-(defconstant *ma-pons-index* 1207,41426
-(defconstant *ma-initial-max-symbol-to-fixnum* 1209,41466
-(defg *max-symbol-to-fixnum* 1211,41517
-(defg *caller* 1219,41770
-(defn memoize-here-come 1226,42026
-(defun memoize-flush1 1269,43836
-(defmacro memoize-flush 1287,44714
-(defparameter *memo-max-sizes*1298,44881
-(defrec memo-max-sizes-entry1315,45672
-(defun make-initial-memoize-hash-table 1325,46120
-(defun make-initial-memoize-pons-table 1376,48761
-(defun update-memo-max-sizes 1409,50571
-(defun print-memo-max-sizes 1438,52109
-(defmacro heap-bytes-allocated 1470,53539
-(defn sync-memoize-call-array 1473,53621
-(defun memoize-call-array-grow1498,54541
-(defun-one-output symbol-to-fixnum-create 1527,55885
-(defun-one-output symbol-to-fixnum 1551,56849
-(defun-one-output fixnum-to-symbol 1557,57065
-(defun-one-output coerce-index 1562,57224
-(defun-one-output memoize-eval-compile 1575,57398
-(defun-one-output memoizedp-raw 1584,57666
-(defg *hons-gentemp-counter* 1588,57773
-(defun-one-output hons-gentemp 1590,57806
-(defun-one-output st-lst 1599,58136
-(defun-one-output dcls 1611,58512
-(defg *assoc-eq-hack-ht* 1624,58922
-(defn assoc-eq-hack 1627,59011
-(defun abbrev 1640,59570
-(defun prine 1664,60578
-(defun prine-alist 1669,60709
-(defun-one-output mf-trace-exit 1701,61754
-(defg *memoize-fn-signature-error*1711,62073
-(defg *sort-to-from-by-calls* 1720,62452
-(defvar *memoize-use-attachment-warning-p* 1722,62488
-(defun memoize-use-attachment-warning 1724,62535
-(defun-one-output memoize-fn-suffix 1751,63976
-(defun-one-output mis-ordered-commutative-args 1759,64201
-(defun our-function-lambda-expression 1790,65448
-(defun memoize-look-up-def 1808,66012
-(defg *memoize-init-done* 1852,67782
-(defun memoize-fn 1854,67814
-(defun-one-output unmemoize-fn 2524,98980
-(defun-one-output maybe-unmemoize 2574,101067
-(defun-one-output memoized-functions 2586,101589
-(defun-one-output length-memoized-functions 2596,101878
-(defun-one-output unmemoize-all 2605,102162
-(defun-one-output memoize-info 2620,102702
-(defun-one-output rememoize-all 2666,104712
-(defun-one-output uses-state 2688,105375
-(defun profile-fn 2697,105737
-(defun-one-output profiled-functions 2704,105935
-(defun-one-output unmemoize-profiled 2719,106376
-(defmacro memoize-on-raw 2730,106664
-(defmacro memoize-off-raw 2743,107177
-(defun-one-output memoize-condition 2756,107686
-(defn global-restore-memoize 2762,107847
-(defg *memoize-summary-order-list*2772,108125
-(defg *memoize-summary-limit* 2803,108981
-(defg *shorten-ht* 2809,109189
-(defn shorten 2811,109230
-(defg *memoize-summary-order-reversed* 2840,110538
-(defg *print-alist-width* 2846,110745
-(defun-one-output print-alist 2848,110776
-(defmacro very-unsafe-incf 2878,111848
-(defmacro very-very-unsafe-aref-incf 2892,112183
-(defun-one-output pons-summary 2898,112396
-(defun memoized-values 2939,113985
-(defn print-call-stack 2961,114820
-(defun-one-output hons-calls 2996,116049
-(defun-one-output pons-calls 3009,116418
-(defun-one-output bytes-allocated 3022,116785
-(defun-one-output number-of-hits 3034,117180
-(defun-one-output number-of-memoized-entries 3046,117572
-(defun-one-output number-of-mht-calls 3061,118066
-(defun-one-output time-for-non-hits/call 3073,118467
-(defun-one-output time/call 3078,118641
-(defun-one-output hits/calls 3083,118779
-(defun-one-output bytes-allocated/call 3089,118940
-(defn char-list-fraction 3096,119108
-(defn symbol-name-order 3102,119239
-(defun-one-output execution-order 3110,119464
-(defn compute-calls-and-times 3120,119758
-(defun-one-output number-of-calls 3163,121695
-(defun-one-output print-not-called 3172,121938
-(defun-one-output total-time 3189,122495
-(defn lex-> 3200,122765
-(defun-one-output memoize-summary-sort 3208,122957
-(defun-one-output memoize-summary 3227,123580
-(defg *short-symbol-name-width* 3303,126581
-(defn short-symbol-name 3305,126618
-(defun-one-output outside-p 3314,126942
-(defun-one-output memoize-summary-after-compute-calls-and-times 3318,127067
-(defun-one-output empty-ht-p 3633,141573
-(defn clear-one-memo-and-pons-hash 3637,141686
-(defun-one-output clear-memoize-table 3661,142829
-(defun-one-output clear-memoize-tables 3670,143016
-(defn clear-memoize-call-array 3685,143393
-(defn clear-memoize-statistics 3695,143722
-(defun-one-output memoize-init 3700,143794
-(defg *max-mem-usage* 3739,145080
-(defg *gc-min-threshold* 3747,145325
-(defun-one-output set-gc-threshold 3755,145457
-(defmacro globlet 3764,145666
-(defmacro globlet 3794,146902
-(defmacro with-lower-overhead 3805,147232
-(defun acl2h-init-memoizations 3831,148328
-(defun acl2h-init-unmemoizations 3868,149678
-(defun looking-at 3897,150746
-(defun meminfo 3925,151804
-(defvar *sol-gc-installed* 3960,153094
-(defun set-and-reset-gc-thresholds 3964,153138
-(defun start-sol-gc 3987,154042
-(defun-one-output acl2h-init 4082,157915
-(defun memstat 4181,161745
-(defmacro memo-on 4184,161802
-(defmacro memo-off 4187,161852
-(defun clear-memo-tables 4190,161904
-(defn lower-overhead 4197,162042
-(defun our-gctime 4214,162515
-(defun update-memo-entry-for-attachments 4217,162598
-(defun update-memo-entries-for-attachments 4239,163531
-
-translate.lisp,9824
-(deflabel syntax23,881
-(deflabel term41,1351
-(defun termp 228,11066
-(defun term-listp 254,11935
-(defun computed-hint-tuple-listp 261,12065
-(defun macro-args 281,12620
-(defconst *macro-expansion-ctx* 384,15627
-(defun remove-keyword 386,15679
-(defun error-trace-suggestion 392,15872
-(defun ignored-attachment-msg 403,16223
-(defun ev-fncall-null-body-er-msg 410,16566
-(defun ev-fncall-null-body-er 431,17336
-(defun ev-fncall-creator-er-msg 436,17490
-(defun unknown-pkg-error-msg 448,18091
-(defun illegal-msg 454,18278
-(defun program-only-er-msg 458,18369
-(defconst *safe-mode-guard-er-addendum*470,18976
-(defun find-first-non-nil 475,19220
-(defun latch-stobjs1 482,19418
-(defun latch-stobjs 535,21963
-(defvar *raw-guard-warningp*)560,23192
-(defun actual-stobjs-out1 562,23223
-(defun apply-symbol-alist 578,24030
-(defun apply-inverse-symbol-alist 592,24653
-(defun actual-stobjs-out 607,25190
-(defun raw-ev-fncall 618,25670
-(defun translated-acl2-unwind-protectp4 714,30252
-(defun translated-acl2-unwind-protectp 789,33851
-(defun stobjp 800,34255
-(defun acl2-system-namep 1146,49632
-(defparameter *ev-shortcut-okp*1219,51897
-(defun w-of-any-state 1234,52561
-(defun untranslate-preprocess-fn 1247,53124
-(defmacro untranslate* 1253,53389
-(defmacro raw-guard-warningp-binding 1269,54042
-(defun untouchable-fn-p 1297,55562
-(defun save-ev-fncall-guard-er 1301,55729
-(defrec attachment1310,56037
-(defrec attachment-component1317,56155
-(defun attachment-record-pairs 1324,56272
-(defun all-attachments 1332,56508
-(defun gc-off1 1336,56637
-(defun gc-off 1340,56732
-(defun return-last-lookup 1357,57227
-(defun make-let-or-let* 1372,57700
-(defmacro untranslate*-lst 1386,58176
-(defun apply-user-stobj-alist-or-kwote 1397,58470
-(defun ev-fncall-rec-logical 1436,60300
-(defun ev-fncall-rec 1761,73522
-(defun ev-rec-return-last 1808,75389
-(defun ev-rec 1908,80312
-(defun ev-rec-lst 2094,89636
-(defun ev-rec-acl2-unwind-protect 2127,91106
-(defun ev-fncall-w 2348,101188
-(defun ev-fncall-guard-er-msg 2416,103764
-(defun ev-fncall-guard-er 2472,106190
-(defun ev-fncall-msg 2483,106591
-(defun untranslate1 2534,108423
-(defun untranslate-cons1 2763,120575
-(defun untranslate-cons 2783,121577
-(defun untranslate-if 2794,122022
-(defun untranslate-into-case-clauses 2813,122985
-(defun untranslate-into-cond-clauses 2855,125306
-(defun untranslate1-lst 2870,126047
-(defun ev-fncall 2881,126480
-(defun ev 2894,127059
-(defun ev-lst 2928,128363
-(defun untranslate 2946,129103
-(defun untranslate-lst 2973,130182
-(defun ev-w 3011,131740
-(defun ev-w-lst 3072,134285
-(defun silent-error 3198,140470
-(defmacro cmp-to-error-triple 3201,140519
-(defmacro cmp-to-error-triple@par 3217,141077
-(defmacro cmp-to-error-double 3233,141660
-(defmacro cmp-and-value-to-error-quadruple 3249,142291
-(defmacro cmp-and-value-to-error-quadruple@par 3271,143205
-(defun er-cmp-fn 3291,144038
-(defmacro er-cmp 3299,144218
-(defmacro value-cmp 3306,144403
-(defun er-progn-fn-cmp 3309,144444
-(defmacro er-progn-cmp 3331,145402
-(defmacro er-let*-cmp 3336,145547
-(defun warning1-cw 3361,146504
-(defmacro warning$-cw1 3368,146708
-(defmacro warning$-cw 3393,147530
-(defun chk-length-and-keys 3406,148076
-(defun bind-macro-args-keys1 3426,148924
-(defun bind-macro-args-keys 3485,151782
-(defun bind-macro-args-after-rest 3503,152499
-(defun bind-macro-args-optional 3513,152896
-(defun bind-macro-args1 3548,154406
-(defun bind-macro-args 3574,155535
-(defun macroexpand1-cmp 3582,155885
-(defun macroexpand1 3641,158473
-(defun chk-declare 3645,158632
-(defun collect-dcls 3665,159587
-(defun acceptable-dcls-alist 3676,159968
-(defconst *documentation-strings-permitted*3705,161181
-(defconst *dcl-explanation-alist*3711,161332
-(defun tilde-*-conjunction-phrase1 3721,161854
-(defun tilde-*-conjunction-phrase 3732,162332
-(defun collect-non-legal-variableps 3749,162985
-(defun optimize-alistp 3755,163213
-(defun chk-dcl-lst 3768,163634
-(defun number-of-strings 3946,173109
-(defun remove-strings 3952,173272
-(defun get-string 3958,173438
-(defun collect-declarations-cmp 3963,173562
-(defun collect-declarations 4003,175554
-(defun listify 4008,175814
-(defun translate-declaration-to-guard-var-lst 4012,175912
-(defun translate-dcl-lst 4026,176575
-(defun dcl-guardian 4040,177171
-(defun ignore-vars 4073,178708
-(defun ignorable-vars 4079,178891
-(defun mv-nth-list 4085,179086
-(defabbrev translate-bind 4090,179263
-(defun translate-deref 4096,179398
-(defun translate-unbound 4112,179964
-(defun listlis 4120,180168
-(defun find-first-var 4130,180375
-(defun find-first-var-lst 4138,180613
-(defun find-first-fnsymb 4146,180784
-(defun find-first-fnsymb-lst 4154,181058
-(defun find-pkg-witness 4160,181219
-(defmacro trans-er 4179,181935
-(defmacro trans-er+ 4195,182670
-(defmacro trans-er+? 4214,183440
-(defmacro trans-value 4230,184094
-(defmacro trans-er-let* 4236,184241
-(defun hide-ignored-actuals 4259,185078
-(defun augment-ignore-vars 4285,186047
-(defun compute-stobj-flags 4393,191862
-(defun prettyify-stobj-flags 4406,192355
-(defun unprettyify-stobj-flags 4415,192641
-(defun prettyify-stobjs-out 4420,192815
-(defun defstobj-supporterp 4429,193111
-(defun stobj-creatorp 4445,193824
-(defun defstobj-fnname 4457,194242
-(defun parse-with-local-stobj 4516,196855
-(defun ffnnamep 4536,197362
-(defun ffnnamep-lst 4550,197815
-(defconst *synp-trans-err-string*4560,198036
-(defconst *ttag-fns-and-macros*4566,198384
-(defun unknown-binding-msg 4588,199063
-(defconst *oneify-primitives*4606,200205
-(defconst *macros-for-nonexpansion-in-raw-lisp*4652,201978
-(defun chk-no-duplicate-defuns-cmp 4712,204284
-(defun chk-no-duplicate-defuns 4722,204704
-(defun chk-state-ok-msg 4725,204815
-(defun chk-state-ok 4740,205441
-(defun chk-arglist-msg 4745,205587
-(defun msg-to-cmp 4762,206321
-(defun chk-arglist-cmp 4771,206562
-(defun@par chk-arglist 4774,206670
-(defun logical-name-type 4779,206856
-(defun chk-all-but-new-name-cmp 4804,207855
-(defun chk-all-but-new-name 4835,209112
-(defun chk-defuns-tuples-cmp 4838,209241
-(defun chk-defuns-tuples 4882,211119
-(defun non-trivial-encapsulate-ee-entries 4886,211313
-(defconst *ec-call-bad-ops*4895,211721
-(defmacro return-last-call 4905,212114
-(defmacro prog2$-call 4908,212201
-(defun name-dropper 4911,212275
-(defun first-assoc-eq 4927,212990
-(defun context-for-encapsulate-pass-2 4935,213255
-(defconst *brr-globals*4965,214670
-(defun unknown-binding-msg-er 4971,214764
-(defun congruent-stobj-rep 4991,215750
-(defun congruent-stobjsp 4997,215951
-(defun stobjs-in-out1 5001,216068
-(defun stobjs-in-matchp 5026,217228
-(defun stobjs-in-out 5034,217491
-(defun non-trivial-stobj-binding 5072,219281
-(defun formalized-varlistp 5084,219869
-(defun throw-nonexec-error-p1 5096,220350
-(defun throw-nonexec-error-p 5116,221134
-(defun chk-flet-declarations 5131,221849
-(defun chk-flet-declare-form 5157,223173
-(defun chk-flet-declare-form-list 5172,223774
-(defun translate-stobj-type-to-guard 5179,224073
-(defun get-stobj-creator 5214,225858
-(defun stobj-updater-guess-from-accessor 5238,226883
-(defun parse-stobj-let1 5259,227639
-(defun illegal-stobj-let-msg 5351,231761
-(defun parse-stobj-let 5355,231885
-(defun pairlis-x1 5449,235991
-(defun pairlis-x2 5457,236179
-(defun no-duplicatesp-checks-for-stobj-let-actuals/alist 5465,236371
-(defun no-duplicatesp-checks-for-stobj-let-actuals 5479,237068
-(defun stobj-let-fn 5503,238095
-(defun the-live-var 5537,239593
-(defun the-live-var-bindings 5556,240444
-(defun the-maybe-live-var-bindings 5562,240686
-(defun stobj-let-fn-raw 5572,241090
-(defun stobj-field-accessor-p 5658,244556
-(defun chk-stobj-let/bindings 5680,245143
-(defun chk-stobj-let/updaters1 5718,247042
-(defun chk-stobj-let/updaters 5748,248518
-(defun chk-stobj-let 5755,248778
-(defun all-nils-or-x 5777,249672
-(defun stobj-field-fn-of-stobj-type-p 5786,249934
-(defun stobj-recognizer-p 5798,250490
-(defmacro trans-or 5807,250765
-(defun translate11-flet-alist 5838,252099
-(defun translate11-flet-alist1 5852,252757
-(defun translate11-flet 6054,262340
-(defun translate-stobj-calls 6122,265280
-(defun translate11-let 6158,267101
-(defun translate11-let* 6364,277843
-(defun translate11-mv-let 6389,279068
-(defun translate11-wormhole-eval 6609,290173
-(defun translate11-call 6704,294507
-(defun translate11 6890,303899
-(defun translate11-lst 8074,363006
-(defun translate1-cmp 8196,369297
-(defun@par translate1 8261,372386
-(defun collect-programs 8266,372603
-(defun all-fnnames1 8298,373758
-(defmacro all-fnnames 8317,374450
-(defmacro all-fnnames-lst 8320,374513
-(defun translate-cmp 8323,374576
-(defun@par translate 8348,375733
-(defun translatable-p 8379,377201
-(defmacro chk-translatable 8386,377492
-(defun replaced-stobj 8412,378746
-(defun replace-stobjs1 8418,378915
-(defun replace-stobjs 8426,379211
-(defun non-stobjps 8467,381104
-(defun user-stobjsp 8474,381355
-(defun put-assoc-eq-alist 8481,381559
-(defun-one-output chk-user-stobj-alist 8515,383280
-(defun user-stobj-alist-safe 8540,384371
-(defun ev-for-trans-eval 8549,384645
-(defun ev-w-for-trans-eval 8601,386935
-(defun trans-eval 8637,388212
-(defun simple-translate-and-eval 8683,390082
-(defun error-fms-cw 8777,394706
-(defmacro error-fms@par 8794,395387
-(defun simple-translate-and-eval-cmp 8797,395451
-(defun simple-translate-and-eval-error-double 8859,398421
-(defun simple-translate-and-eval@par 8888,399705
-(defun tilde-*-alist-phrase1 8904,400537
-(defun tilde-*-alist-phrase 8910,400803
-(defun set-temp-touchable-fns 8922,401098
-(defun set-temp-touchable-vars 8939,401793
-(defun clear-temp-touchable-fns 8956,402491
-(defun clear-temp-touchable-vars 8959,402580
-(defun mapcar$ 8975,403345
-(defun mapdo 8997,404249
-(defun always 9010,404708
-(defun thereis 9024,405125
-
-type-set-a.lisp,1856
-(defconst *ts-non-negative-integer* 124,5901
-(defconst *ts-non-positive-integer* 127,6030
-(defconst *ts-integer* 130,6159
-(defconst *ts-rational* 134,6318
-(defconst *ts-real* 141,6570
-(defconst *ts-complex* 151,6940
-(defconst *ts-acl2-number*160,7355
-(defconst *ts-rational-acl2-number* 166,7525
-(defconst *ts-non-rational-acl2-number* 170,7683
-(defconst *ts-negative-rational* 174,7913
-(defconst *ts-positive-rational* 177,8046
-(defconst *ts-non-positive-rational* 180,8179
-(defconst *ts-non-negative-rational* 183,8311
-(defconst *ts-ratio* 186,8443
-(defconst *ts-non-ratio* 197,8772
-(defconst *ts-negative-real* 200,8895
-(defconst *ts-positive-real* 204,9084
-(defconst *ts-non-positive-real* 208,9273
-(defconst *ts-non-negative-real* 211,9393
-(defconst *ts-cons* 215,9515
-(defconst *ts-boolean* 218,9616
-(defconst *ts-true-list* 220,9669
-(defconst *ts-non-nil* 222,9734
-(defconst *ts-symbol* 224,9785
-(defconst *ts-true-list-or-string* 228,9929
-(defconst *ts-empty* 230,10005
-(defconst *ts-unknown* 232,10030
-(defun one-bit-type-setp 240,10392
-(defconst *code-type-set-alist*278,12045
-(defun logior-lst 362,15691
-(defun logand-lst 368,15821
-(defun ts-complement-fn 376,15970
-(defun ts-union-fn 382,16117
-(defun ts-intersection-fn 392,16425
-(defun eval-type-set 402,16744
-(defun eval-type-set-lst 423,17560
-(defmacro ts-complement 436,17878
-(defmacro ts-intersection 439,17952
-(defmacro ts-union 442,18036
-(defmacro ts-subsetp 445,18106
-(defun type-set-binary-+-alist-entry 460,18553
-(defun type-set-binary-+-alist1 592,25217
-(defun type-set-binary-+-alist 601,25623
-(defun type-set-binary-*-alist-entry 609,25887
-(defun type-set-binary-*-alist1 742,32974
-(defun type-set-binary-*-alist 752,33433
-(defun type-set-<-alist-entry 760,33697
-(defun type-set-<-alist1 844,37738
-(defun type-set-<-alist 854,38117
-
-linear-a.lisp,4999
-(defabbrev ts-acl2-numberp 35,1338
-(defabbrev ts-rationalp 38,1407
-(defabbrev ts-real/rationalp 41,1470
-(defabbrev ts-integerp 47,1618
-(defun all-quoteps 50,1679
-(defun dumb-occur 57,1826
-(defun dumb-occur-lst 68,2143
-(defrec history-entry84,2675
-(defun pt-occur 193,9106
-(defun pt-intersectp 201,9304
-(deflabel ttree293,13656
-(defun tag-tree-occur 320,14942
-(defun remove-tag-from-tag-tree 328,15118
-(defun remove-tag-from-tag-tree! 339,15416
-(defmacro extend-tag-tree 354,15866
-(defun add-to-tag-tree 362,16043
-(defun add-to-tag-tree! 381,16622
-(defconst *fake-rune-for-anonymous-enabled-rule*404,17454
-(defabbrev push-lemma 407,17552
-(defun delete-assoc-eq-assoc-eq-1 431,18808
-(defun delete-assoc-eq-assoc-eq 444,19349
-(defun cons-tag-trees1 450,19526
-(defun cons-tag-trees 471,20536
-(defmacro tagged-objects 493,21399
-(defmacro tagged-objectsp 501,21558
-(defun tagged-object 511,21865
-(deflock *ttree-lock*)537,23163
-(defun@par accumulate-ttree-and-step-limit-into-state 539,23187
-(defun pts-to-ttree-lst 582,25156
-(defun marry-parents 594,25695
-(defun collect-parents1 606,26088
-(defun collect-parents0 615,26319
-(defun collect-parents 622,26479
-(defun ignore-polyp 631,26844
-(defun to-be-ignoredp1 646,27492
-(defun to-be-ignoredp 651,27644
-(defrec assumnote 679,28813
-(defrec assumption694,29746
-(defrec fc-derivation755,33360
-(defun contains-assumptionp 767,33715
-(defun contains-assumptionp-fc-derivations 777,34074
-(defun remove-assumption-entries-from-type-alist 783,34296
-(defun force-assumption1802,35012
-(defun dumb-occur-in-type-alist 832,36345
-(defun all-dumb-occur-in-type-alist 841,36541
-(defun force-assumption848,36755
-(defun tag-tree-occur-assumption-nil-1 945,42074
-(defun tag-tree-occur-assumption-nil 952,42290
-(defun assumption-free-ttreep 959,42535
-(defconst *impossible-assumption*979,43381
-(deflabel linear-arithmetic1483,63384
-(defmacro fn-count-evg-max-val 1590,68216
-(defmacro fn-count-evg-max-val-neg 1598,68462
-(defmacro fn-count-evg-max-calls 1601,68532
-(defun min-fixnum 1612,68842
-(defun fn-count-evg-rec 1620,69075
-(defmacro fn-count-evg 1693,72318
-(defun var-fn-count-1 1696,72380
-(defmacro var-fn-count 1798,77743
-(defmacro var-or-fn-count-< 1804,77896
-(defun term-order1 1831,79223
-(defun arith-term-order 1902,83620
-(defrec poly1916,83960
-(defabbrev first-var 2046,90529
-(defabbrev first-coefficient 2048,90586
-(defun good-coefficient 2071,91644
-(defun good-pot-varp 2074,91694
-(defun good-polyp 2084,92074
-(defun logical-< 2094,92468
-(defun logical-<=2107,92880
-(defun evaluate-ground-poly 2117,93206
-(defun impossible-polyp 2126,93475
-(defun true-polyp 2130,93584
-(defun silly-polyp 2134,93678
-(defun impossible-poly 2141,93884
-(defun base-poly0 2151,94121
-(defun base-poly 2164,94486
-(defun poly-alist-equal 2177,94859
-(defun poly-equal 2191,95256
-(defun poly-weakerp 2202,95635
-(defun poly-member 2235,97018
-(defun new-and-ugly-linear-varsp 2251,97675
-(defun filter-polys 2277,98693
-(defun add-linear-variable1 2304,99663
-(defun zero-factor-p 2328,100653
-(defun get-coefficient 2349,101487
-(defun add-linear-variable 2363,102025
-(defun dumb-eval-yields-quotep 2385,102699
-(defun dumb-eval 2407,103504
-(defun add-linear-term 2436,104490
-(defun add-linear-terms-fn 2506,107054
-(defmacro add-linear-terms 2520,107505
-(defun normalize-poly1 2538,108056
-(defun normalize-poly 2545,108249
-(defun normalize-poly-lst 2561,108652
-(defrec linear-pot 2574,108927
-(defun modify-linear-pot 2583,109431
-(defconst *max-linear-pot-loop-stopper-value* 2657,112361
-(defun loop-stopper-value-of-var 2659,112411
-(defun set-loop-stopper-values 2670,112800
-(defun var-in-pot-lst-p 2702,114447
-(defun bounds-poly-with-var 2712,114712
-(defun bounds-polys-with-var 2738,115940
-(defun polys-with-var1 2763,116869
-(defun polys-with-var 2770,117172
-(defun polys-with-pots 2782,117608
-(defun new-vars-in-pot-lst 2795,118024
-(defun changed-pot-vars 2843,120598
-(defun infect-polys 2869,121822
-(defun infect-first-n-polys 2884,122406
-(defun infect-new-polys 2899,123017
-(defun fcomplementary-multiplep1 2970,126312
-(defun fcomplementary-multiplep 2983,126796
-(defun already-used-by-find-equational-polyp-lst 2998,127451
-(defun already-used-by-find-equational-polyp 3003,127667
-(defun cons-term-binary-+-constant 3032,129115
-(defun cons-term-unary-- 3041,129412
-(defun cons-term-binary-*-constant 3047,129646
-(defun find-equational-poly-rhs1 3058,130009
-(defun find-equational-poly-rhs 3072,130511
-(defun find-equational-poly3 3103,131546
-(defun find-equational-poly2 3131,132829
-(defun find-equational-poly1 3151,133529
-(defun find-equational-poly 3171,134277
-(defun get-coeff-for-cancel1 3208,135903
-(defun cancel2 3232,136711
-(defun cancel1 3240,136914
-(defun cancel 3266,137953
-(defun cancel-poly-against-all-polys 3336,141335
-(defun add-poly 3427,145440
-(defun prune-poly-lst 3554,150929
-(defun add-polys1 3562,151192
-(defun add-polys0 3607,153282
-
-type-set-b.lisp,11735
-(defconst *number-of-numeric-type-set-bits*26,995
-(defconst *type-set-binary-+-table-list*30,1099
-(defconst *type-set-binary-+-table*39,1468
-(defconst *type-set-binary-*-table-list*43,1589
-(defconst *type-set-binary-*-table*52,1958
-(defconst *type-set-<-table-list*60,2240
-(defconst *type-set-<-table*75,2691
-(defun assoc-equal-cdr 89,3292
-(defun runep 97,3517
-(defmacro base-symbol 228,10269
-(defmacro strip-base-symbols 242,10835
-(deflabel executable-counterpart245,10898
-(deflabel world324,14702
-(deflabel rune433,21437
-(deflabel rule-names580,28785
-(defun fnume 595,29023
-(defun frunic-mapping-pair 611,29800
-(defun fn-rune-nume 619,30054
-(defun definition-runes 635,30839
-(defun get-next-nume 640,31021
-(defun deref-macro-name 676,32855
-(defun deref-macro-name-lst 682,33014
-(defconst *abbrev-rune-alist*687,33260
-(defun translate-abbrev-rune 693,33403
-(defun rule-name-designatorp 703,33758
-(defun theoryp1 748,36001
-(defun theoryp 754,36205
-(defun theoryp!1 762,36478
-(defun theoryp! 784,37507
-(defun runic-theoryp1 789,37627
-(defun runic-theoryp 804,38175
-(defun find-mapping-pairs-tail1 880,42450
-(defun find-mapping-pairs-tail 895,43118
-(defun augment-runic-theory1 912,43941
-(defun augment-runic-theory 934,44999
-(defconst *bad-runic-designator-string*959,46319
-(defun convert-theory-to-unordered-mapping-pairs1 965,46679
-(defun convert-theory-to-unordered-mapping-pairs 1025,49030
-(defun duplicitous-cons-car 1043,49847
-(defun duplicitous-revappend-car 1052,50099
-(defun duplicitous-merge-car 1060,50362
-(defun duplicitous-sort-car 1094,52187
-(defun augment-theory 1115,53192
-(defmacro assert$-runic-theoryp 1143,54581
-(defun runic-theory 1157,54899
-(defrec enabled-structure1198,56839
-(defun enabled-numep 1282,61643
-(defun enabled-arith-numep 1297,62147
-(defun enabled-runep 1317,62997
-(defmacro active-runep 1325,63279
-(defun enabled-xfnp 1360,64465
-(defun sublis-var! 1381,65302
-(defun sublis-var!-lst 1490,69492
-(defun theory-warning-fns-aux 1507,70081
-(defun theory-warning-fns 1535,71298
-(defun@par maybe-warn-about-theory 1562,72904
-(defrec theory-invariant-record1617,75301
-(defun@par chk-theory-invariant1 1621,75370
-(defun@par chk-theory-invariant 1709,79790
-(defrec clause-id1735,80701
-(defun pos-listp 1748,81154
-(defun all-digits-p 1755,81315
-(defun d-pos-listp 1764,81658
-(defun clause-id-p 1776,82100
-(defconst *initial-clause-id*1791,82467
-(defun chars-for-tilde-@-clause-id-phrase/periods 1815,83611
-(defun chars-for-tilde-@-clause-id-phrase/primes 1825,83958
-(defun chars-for-tilde-@-clause-id-phrase 1833,84237
-(defun string-for-tilde-@-clause-id-phrase 1859,85552
-(defun@par load-theory-into-enabled-structure1867,85777
-(defun initial-global-enabled-structure 1955,90372
-(defun recompress-global-enabled-structure 1984,91590
-(defun recompress-stobj-accessor-arrays 2044,94494
-(defconst *fake-rune-for-type-set*2100,97530
-(defun puffert 2105,97667
-(defun immediate-forcep 2115,98079
-(defmacro numeric-type-set 2123,98288
-(defmacro rational-type-set 2146,99235
-(defmacro real-type-set 2167,100017
-(defun type-set-binary-+ 2188,100793
-(defun type-set-binary-* 2230,102850
-(defun type-set-not 2246,103418
-(defun type-set-<-1 2254,103618
-(defun type-set-< 2371,108055
-(defun type-set-unary-- 2533,115792
-(defun type-set-unary-/ 2556,116814
-(defun type-set-numerator 2575,117712
-(defun type-set-realpart 2590,118396
-(defun type-set-imagpart 2601,118789
-(defun type-set-complex 2622,119568
-(defun type-set-floor1 2665,121386
-(defun type-set-standard-part 2680,122063
-(defun type-set-standardp 2696,122731
-(defrec recognizer-tuple2712,123257
-(defconst *initial-recognizer-alist*2822,127951
-(defun most-recent-enabled-recog-tuple 2928,131698
-(defun type-set-recognizer 2940,132209
-(defun type-set-car 2973,133765
-(defun type-set-cdr 2977,133902
-(defun type-set-coerce 2988,134256
-(defun type-set-intern-in-package-of-symbol 3010,135128
-(defun type-set-length 3017,135414
-(defun type-set-cons 3028,135782
-(defconst *singleton-type-sets*3039,136135
-(defun type-set-equal 3042,136204
-(defun type-set-quote 3055,136737
-(defun type-set-char-code 3092,138039
-(defun fn-count-1 3102,138387
-(defmacro fn-count 3140,140215
-(defun term-order 3143,140273
-(defrec type-prescription3298,147920
-(defun find-runed-type-prescription 3341,149710
-(defconst *expandable-boot-strap-non-rec-fns*3352,150037
-(defun mv-atf 3410,152883
-(defun assume-true-false-error 3448,154460
-(defun non-cons-cdr 3457,154830
-(defconst *one-way-unify1-implicit-fns*3475,155630
-(defun one-way-unify1 3486,155794
-(defun one-way-unify1-lst 3719,167461
-(defun one-way-unify1-equal1 3736,168121
-(defun one-way-unify1-equal 3760,169273
-(defun one-way-unify 3768,169512
-(defun canonical-representative 3828,172431
-(defun subst-type-alist1-check 3874,174043
-(defun nil-fn 3885,174424
-(defconst *nil-fn-ts-entry*3893,174642
-(defun subst-type-alist1 3898,174772
-(defun subst-type-alist 3966,177969
-(defun infect-type-alist-entry 3981,178571
-(defun infect-new-type-alist-entries2 3989,178789
-(defun infect-new-type-alist-entries1 4008,179587
-(defun infect-new-type-alist-entries 4021,180131
-(defun extend-type-alist-simple 4040,181045
-(defun extend-type-alist1 4059,181825
-(defun extend-type-alist 4137,185090
-(defun zip-variable-type-alist 4188,187338
-(defun assoc-equiv 4202,187949
-(defun assoc-equiv+ 4221,188700
-(defun assoc-type-alist 4287,191679
-(defun look-in-type-alist 4304,192295
-(defun member-char-stringp 4309,192451
-(defun terminal-substringp1 4320,192836
-(defun terminal-substringp 4336,193472
-(defun evg-occur 4346,193898
-(defun occur 4415,196809
-(defun occur-lst 4427,197210
-(defun pseudo-variantp 4452,198053
-(defun pseudo-variantp-list 4487,199469
-(defun worse-than-builtin 4749,207467
-(defun worse-than-or-equal-builtin 4787,209210
-(defun basic-worse-than-lst1 4819,210512
-(defun basic-worse-than-lst2 4838,211361
-(defun basic-worse-than 4854,212033
-(defun some-subterm-worse-than-or-equal 4904,214302
-(defun some-subterm-worse-than-or-equal-lst 4924,215140
-(defun worse-than-lst 4935,215678
-(defattach (worse-than 4973,216897
-(defattach (worse-than-or-equal 4976,216959
-(defrec ancestor4981,217082
-(defmacro make-ancestor-binding-hyp 4995,217597
-(defmacro ancestor-binding-hyp-p 5002,217770
-(defmacro ancestor-binding-hyp/hyp 5006,217867
-(defmacro ancestor-binding-hyp/unify-subst 5009,217941
-(defun push-ancestor 5014,218081
-(defun ancestor-listp 5044,219448
-(defun earlier-ancestor-biggerp 5072,220535
-(defun equal-mod-commuting 5102,222021
-(defun ancestors-check1 5130,223016
-(defun ancestors-check-builtin 5271,230556
-(defproxy ancestors-check 5319,232590
-(defattach (ancestors-check 5321,232638
-(defun map-multiply-car 5386,235037
-(defun normalize-addend 5392,235284
-(defun insert-cdr-term-order 5416,236243
-(defun normalize-linear-sum-2 5425,236501
-(defun normalize-linear-sum-1 5437,236969
-(defun normalize-linear-sum 5487,239324
-(defun normalize-linear-sum-p1 5557,242134
-(defun normalize-linear-sum-p 5566,242526
-(defun type-set-finish-1 5594,243758
-(defun type-set-finish 5786,254215
-(defun search-type-alist-rec 5824,255889
-(defun free-varsp 5862,257639
-(defun free-varsp-lst 5867,257805
-(defun search-type-alist-with-rest 5874,257968
-(defun search-type-alist 5907,259517
-(defun term-and-typ-to-lookup 5956,261923
-(defun lookup-hyp 5977,262832
-(defun bind-free-vars-to-unbound-free-vars 5987,263222
-(defabbrev x-xrunep 6070,267627
-(defabbrev hyp-xrune 6074,267733
-(defabbrev hyp-xrune-rune 6078,267830
-(defabbrev conc-xrune 6083,267963
-(defabbrev conc-xrune-rune 6087,268058
-(defabbrev xrune-rune 6092,268192
-(defabbrev rune=6099,268355
-(defabbrev xrune=6103,268464
-(defun prettyify-xrune 6113,268825
-(defrec accp-info6123,269164
-(defrec accp-entry6156,270359
-(defun merge-accumulated-persistence-aux 6226,273765
-(defun merge-accumulated-persistence-rec 6249,274867
-(defun merge-accumulated-persistence 6258,275202
-(defun add-accumulated-persistence-s 6368,279607
-(defun add-accumulated-persistence-f 6395,280748
-(defun accumulated-persistence-make-failures 6425,282011
-(defun add-accumulated-persistence 6437,282560
-(defmacro accumulated-persistence 6461,283659
-(defmacro set-accumulated-persistence 6862,304577
-(defdoc accumulated-persistence-subtleties6865,304657
-(defun merge-car-> 6995,309798
-(defun merge-sort-car-> 7002,310023
-(defconst *accp-major-separator*7007,310188
-(defconst *accp-minor-separator*7010,310265
-(defun show-accumulated-persistence-phrase0 7013,310342
-(defun show-accumulated-persistence-phrase1 7041,311348
-(defun show-accumulated-persistence-remove-useless 7073,312710
-(defun show-accumulated-persistence-phrase-key 7083,313114
-(defun show-accumulated-persistence-phrase2-merge 7100,313827
-(defun show-accumulated-persistence-phrase2-not-merge 7130,315051
-(defun show-accumulated-persistence-phrase2 7139,315498
-(defun split-xrune-alist 7143,315711
-(defun sort-xrune-alist-by-rune1 7164,316730
-(defun sort-xrune-alist-by-rune 7197,318336
-(defun pop-accp-fn 7215,319172
-(defun pop-accp-fn-iterate 7272,321700
-(defun show-accumulated-persistence-phrase 7288,322374
-(defmacro show-accumulated-persistence 7360,325988
-(defun push-accp 7410,328392
-(defun pop-accp 7456,331054
-(defmacro with-accumulated-persistence 7473,331815
-(defun assume-true-false-<7523,334017
-(defun mv-atf-2 7729,342635
-(defun binding-hyp-p 7782,344760
-(defmacro adjust-ignore-for-atf 7830,347138
-(defun backchain-limit-reachedp1 7842,347537
-(defun backchain-limit-reachedp 7847,347704
-(defun new-backchain-limit 7858,348223
-(defproxy oncep-tp 7885,349162
-(defun oncep-tp-builtin 7887,349194
-(defattach (oncep-tp 7892,349310
-(defun type-set-rec 7897,349387
-(defun type-set-lst 8429,373922
-(defun type-set-relieve-hyps-free 8450,374947
-(defun type-set-relieve-hyps1 8493,377002
-(defun type-set-relieve-hyps 8649,382804
-(defun extend-type-alist-with-bindings 8920,395576
-(defun type-set-with-rule 8947,396757
-(defun type-set-with-rule1 9036,400812
-(defun type-set-with-rules 9073,402863
-(defun type-set-primitive 9126,405256
-(defun assume-true-false-if 9663,427822
-(defun assume-true-false-rec 9963,443098
-(defun assume-true-false1 11066,498228
-(defun proper/improper-cons-ts-tuple 11124,500807
-(defun extend-with-proper/improper-cons-ts-tuple11198,504314
-(defun type-set 11217,505133
-(defun assume-true-false 11372,512808
-(defun ok-to-force-ens 11379,513124
-(defun add-linear-assumption 11388,513481
-(defun return-type-alist11496,518354
-(defun type-alist-equality-loop1 11526,519511
-(defun clean-up-alist 11617,523567
-(defun duplicate-keysp 11630,524132
-(defun clean-type-alist 11643,524629
-(defun type-alist-equality-loop-exit 11660,525391
-(defconst *type-alist-equality-loop-max-depth* 11666,525613
-(defun type-alist-equality-loop 11668,525665
-(defun put-assoc-equal-ts 11699,527049
-(defun reconsider-type-alist 11711,527589
-(defun type-alist-clause-finish1 11773,530512
-(defun type-alist-clause-finish 11809,532253
-(defun type-alist-clause 11941,539350
-(defun known-whether-nil 12003,542946
-(defun ts-booleanp 12035,544632
-(defun weak-cons-occur 12046,545119
-(defun equal-x-cons-x-yp 12060,545577
-(defun not-ident 12135,548929
-(defun first-if 12170,550568
-(defun all-variablep 12184,551056
-(defun normalize-with-type-set 12189,551191
-(defun normalize 12221,552379
-(defun normalize-lst 12370,559473
-(defun normalize-or-distribute-first-if 12379,559937
-(defun distribute-first-if 12397,560743
-(defun decode-type-set1 12517,566224
-(defun decode-type-set 12527,566622
-(defmacro dts 12545,567342
-(defun ens 12562,567853
-(defmacro git 12565,567923
-
-linear-b.lisp,427
-(defun polys-from-type-set 36,1154
-(defun add-type-set-polys 133,5323
-(defun add-polynomial-inequalities 176,7396
-(defparameter *add-polys-counter*203,8547
-(defun add-polys 210,8702
-(defun eval-ground-subexpressions 231,9291
-(defun eval-ground-subexpressions-lst 326,12671
-(defun poly-set 341,13175
-(defun linearize1 423,17357
-(defun linearize 802,33926
-(defun linearize-lst1847,36093
-(defun linearize-lst877,37416
-
-non-linear.lisp,1066
-(defun cleanse-type-alist 29,1083
-(defun var-with-divisionp 56,1948
-(defun varify 87,3196
-(defun varify! 110,3790
-(defun varify!-lst1 119,4021
-(defun varify!-lst 124,4141
-(defun invert-var 131,4311
-(defun part-of1 172,6125
-(defun part-of 203,7114
-(defun product-already-triedp 220,7633
-(defun too-many-polysp 234,8146
-(defun expanded-new-vars-in-pot-lst2 252,8721
-(defun expanded-new-vars-in-pot-lst1 285,10134
-(defun expanded-new-vars-in-pot-lst 331,12494
-(defun extract-bounds 355,13495
-(defun good-bounds-in-pot 397,15667
-(defun inverse-polys 426,16721
-(defun add-inverse-polys 762,33525
-(defun add-polys-from-type-set 805,35285
-(defun length-of-shortest-polys-with-var 841,36731
-(defun shortest-polys-with-var1 861,37649
-(defun shortest-polys-with-var 873,38158
-(defun binary-*-leaves 905,39466
-(defun binary-*-tree 911,39624
-(defun merge-arith-term-order 929,40137
-(defun insert-arith-term-order 936,40398
-(defun sort-arith-term-order 945,40654
-(defun multiply-alist-and-const 952,40855
-(defun collect-rational-poly-p-lst 967,41543
-
-tau.lisp,11706
-(defun almost-lexorder-singletons 49,2456
-(defun member-nil-neg-evgs 57,2733
-(defun member-neg-evgs1 61,2844
-(defun member-neg-evgs 71,3173
-(defun insert-neg-evgs1 84,3633
-(defun insert-neg-evgs 96,4077
-(defun merge-car-< 106,4456
-(defun merge-sort-car-< 113,4681
-(defun merge-cadr-< 121,4921
-(defun merge-sort-cadr-< 128,5151
-(defun strip-caddrs 136,5398
-(defun unprettyify/add-hyps-to-pairs 148,5972
-(defun flatten-ands-in-lit 157,6311
-(defun unprettyify 170,6843
-(defun reprettyify 219,9041
-(defun remove-guard-holders1 274,11766
-(defun remove-guard-holders1-lst 319,13839
-(defun contains-guard-holdersp 329,14165
-(defun contains-guard-holdersp-lst 350,14873
-(defun remove-guard-holders 355,15051
-(defun remove-guard-holders-lst 364,15293
-(defun contains-guard-holdersp-lst-lst 372,15514
-(defun remove-guard-holders1-lst-lst 377,15703
-(defun remove-guard-holders-lst-lst 382,15890
-(defun convert-returned-vars-to-term-lst 397,16394
-(defun implicate 402,16601
-(defrec type-set-inverter-rule 414,16927
-(defconst *initial-type-set-inverter-rules*442,18350
-(defun convert-type-set-to-term-lst 665,28821
-(defun subst-var 705,30517
-(defun subst-var-lst 716,30916
-(defun convert-type-set-to-term 726,31224
-(defun convert-type-prescription-to-term 768,33175
-(defun all-runes-in-lmi 792,34361
-(defun all-runes-in-lmi-lst 807,34956
-(defun all-runes-in-var-to-runes-alist 812,35164
-(defun all-runes-in-var-to-runes-alist-lst 818,35363
-(defun all-runes-in-elim-sequence-lst 826,35595
-(defun all-runes-in-elim-sequence 832,35793
-(defun all-runes-in-ttree-fc-derivation-lst 847,36474
-(defun all-runes-in-ttree-find-equational-poly-lst 856,36823
-(defun all-runes-in-ttree 866,37240
-(defun all-runes-in-ttree-lst 993,41413
-(defdoc introduction-to-the-tau-system1000,41601
-(defdoc dealing-with-tau-problems1227,53081
-(defdoc future-work-related-to-the-tau-system1367,60209
-(defrec tau-interval 1836,83943
-(defconst *tau-empty-interval*2007,92105
-(defun tau-empty-intervalp 2020,92522
-(defun <?-number-v-rational 2171,98271
-(defun <?-rational-v-number 2197,99066
-(defun eval-tau-interval1 2223,99861
-(defun eval-tau-interval 2237,100443
-(defun decode-tau-interval 2252,101012
-(defrec tau2290,102854
-(defconst *tau-empty*2438,108644
-(defconst *nil-singleton-evg-list* 2457,109388
-(defconst *tau-t* 2459,109437
-(defconst *tau-nil* 2466,109665
-(defconst *tau-non-nil* 2473,109920
-(defconst *tau-contradiction* 2559,114571
-(defrec signature-rule 2594,116718
-(defrec big-switch-rule 2650,119886
-(defun tau-simple-implicants 2655,120108
-(defun tau-pair-member1 2667,120617
-(defun tau-pair-member 2674,120836
-(defun ev-fncall-w-tau-recog 2794,127433
-(defun bad-val-or-unknowns 2975,135309
-(defun exists-bad-valp 3002,136462
-(defun all-eval-valp 3028,137556
-(defun delete-bad-vals 3052,138461
-(defun delete-bad-vals1 3072,139199
-(defun tau-pairs-subsetp 3112,140793
-(defun tau-pairs-near-subsetp 3125,141267
-(defun tau-pairs-intersectionp 3152,142674
-(defun insert-tau-pair 3168,143248
-(defun interval-decider 3246,146126
-(defun signate 3270,147205
-(defun reduce-sign/recog 3355,150493
-(defun every-neg-evg-in-tau-p13816,169658
-(defun every-neg-evg-in-tau-p 3861,172167
-(defun lower-bound-<=4036,179664
-(defun upper-bound->=4051,180061
-(defun lower-bound-> 4063,180296
-(defun upper-bound-< 4075,180530
-(defun tau-subintervalp 4240,186639
-(defun tau-implies 4282,188810
-(defun empty-tau-intervalp 4328,190903
-(defun singleton-tau-intervalp 4337,191126
-(defun make-identity-interval 4354,191722
-(defun identity-intervalp 4385,193011
-(defun delete-consecutive-integers-upward 4466,196848
-(defun delete-consecutive-integers-downward 4498,198543
-(defun collect-<?-x-k 4531,200113
-(defun collect-<?-k-x 4567,202103
-(defun adjust-upper-bound-with-neg-evgs 4586,202830
-(defun adjust-lower-bound-with-neg-evgs 4617,204446
-(defun squeeze-k 4648,206058
-(defun set-tau-pos-evg 4696,207877
-(defun positive-lower-boundp 4730,209154
-(defun nonnegative-lower-boundp 4736,209269
-(defun negative-upper-boundp 4739,209329
-(defun tighten-bound 4745,209444
-(defun add-to-tau1 4906,217323
-(defun add-recogs-to-tau1 5303,234971
-(defun tau-interval-endpoint-to-sign-k-token 5327,236061
-(defun tau-union 5343,236682
-(defun all-integers-in-range-excludedp1 5419,240062
-(defun all-integers-in-range-excludedp 5444,241352
-(defun add-to-tau 5474,242665
-(defun pos-evg-near-subsetp 5686,252722
-(defun neg-evgs-near-subsetp5709,253656
-(defun tau-interval-endpoint-implication 6020,268358
-(defun tau-interval-near-subsetp 6148,272927
-(defun tau-near-subsetp 6329,282925
-(defun tau-put 6897,309166
-(defun tau-put* 7177,320239
-(defun tau-put*-tau 7250,323456
-(defun tau-put*-interval-endpoints 7312,325778
-(defun tau-put*-recogs 7356,327472
-(defconst *non-tau-monadic-boolean-functions*7445,332035
-(defun classicalp 7449,332135
-(defun classical-fn-list-p 7470,332919
-(defun monadic-boolean-fnp 7476,333097
-(defun putprop-if-different 7509,334203
-(defun tau-visit-function-introduction 7520,334568
-(defun tau-visit-function-introductions 7554,336129
-(defun putprop-tau-pair 7560,336339
-(defun initialize-tau-pred 7578,337131
-(defun initialize-tau-preds 7613,338904
-(defun tau-boolean-formp 7618,339087
-(defun tau-eval-formp 7633,339599
-(defun set-tau-runes 7644,340015
-(defun add-tau-boolean-rule 7665,340927
-(defun add-tau-eval-rule 7689,342069
-(defun tau-like-subject-criterion 7728,344017
-(defun tau-like-term 7744,344728
-(defun tau-like-term-listp 7842,348934
-(defun tau-conjunctive-formp 7867,350079
-(defun tau-simple-formp 7900,351389
-(defun add-tau-simple-rule 7909,351734
-(defun convert-tau-like-terms-to-tau 7938,353302
-(defun add-tau-conjunctive-rule 7960,354132
-(defun partition-signature-hyps-into-tau-alist-and-others8047,358025
-(defun tau-boolean-signature-formp 8090,360210
-(defun tau-signature-formp 8128,361646
-(defun replace-vars-by-bindings 8234,365936
-(defun add-tau-signature-rule 8244,366312
-(defun switch-varp 8345,370948
-(defun tau-big-switch-equationp 8360,371404
-(defun tau-big-switch-var 8397,372704
-(defun tau-big-switch-formp 8418,373515
-(defun add-tau-big-switch-rule 8422,373628
-(defun tau-mv-nth-synonym-formp 8444,374510
-(defun add-tau-mv-nth-synonym-rule 8459,374954
-(defrec bounder-correctness8475,375563
-(defun all-cars-nil 8522,377722
-(defun find-subject-bounder-link-term 8527,377864
-(defun tau-bounder-doms-extraction 8547,378864
-(defun tau-bounder-hyp-extraction8573,379916
-(defconst *all-interval-domains*8650,382871
-(defun acceptable-domains-for-bounder8653,382947
-(defun bounder-args 8668,383569
-(defun tau-bounder-formp 8674,383781
-(defun pairwise-subsetp-eq 8892,394674
-(defun bounder-subsumedp 8898,394889
-(defun bounder-subsumedp-by-some 8918,395933
-(defun delete-some-subsumed-bounders 8923,396121
-(defun add-bounder-to-bounders 8931,396420
-(defun add-tau-bounder-rule 8935,396593
-(defun strip-force-and-case-split 8979,398503
-(defun strip-force-and-case-split-in-hyps-of-pairs 8988,398834
-(defun acceptable-tau-rulep 9054,402236
-(defun acceptable-tau-rulesp 9070,402864
-(defun acceptable-tau-rules 9084,403392
-(defun cross-prod1 9094,403767
-(defun cross-prod 9099,403909
-(defun cnf-dnf 9104,404067
-(defun split-on-conjoined-disjunctions 9177,407086
-(defun split-on-conjoined-disjunctions-in-hyps-of-pairs 9193,407636
-(defun chk-acceptable-tau-rule 9210,408517
-(defun add-tau-rule1 9270,411486
-(defun add-tau-rule 9343,415095
-(defun discover-tau-pred 9406,418329
-(defun discover-tau-preds 9436,419792
-(defun tau-rules-from-type-prescriptions 9441,419979
-(defun original-def-body1 9509,423147
-(defun original-def-body 9515,423369
-(defun tau-like-propositionp 9522,423599
-(defun expand-tau-like-proposition 9559,425305
-(defun add-only-simple-and-conjunctive-tau-rules 9607,427634
-(defun convert-normalized-term-to-pairs 9631,428396
-(defun complementaryp 9708,431055
-(defun subsumes-but-for-one-negation 9736,432272
-(defun remove-ancestor-literals-from-pairs1 9982,444524
-(defun remove-ancestor-literals-from-pairs 10010,445658
-(defun convert-term-to-pairs 10025,446223
-(defun tau-subrs 10087,448799
-(defun tau-visit-defuns1 10130,450539
-(defun tau-visit-defuns 10181,452571
-(defun tau-visit-defun 10210,453885
-(defun corollaries-and-runes-of-enabled-rules10265,457148
-(defun tau-visit-defthm1 10297,458613
-(defun tau-visit-defthm 10321,459664
-(defun tau-visit-event 10339,460453
-(defun apply-conjunctive-tau-rule 10400,463257
-(defun apply-conjunctive-tau-rules2 10429,464572
-(defun apply-conjunctive-tau-rules1 10460,465782
-(defun apply-conjunctive-tau-rules 10511,468534
-(defun add-to-tau! 10529,469247
-(defun all-tau-emptyp 10562,470881
-(defun all-unrestricted-signature-rulesp 10567,471026
-(defun disjoin-intervals 10615,473570
-(defun conjoin-intervals 10715,478358
-(defun combine-pos/neg-pairs-from-tau1 10840,483426
-(defun augment-pos/neg-pairs-with-implicit-numeric-recogs10929,487352
-(defun combine-pos/neg-pairs-from-tau 10958,488544
-(defun combine-tau 10982,489523
-(defun push-mv-nth-down 11103,495781
-(defun tau-expand-big-switch 11124,496513
-(defun deconstruct-conjunction 11179,498945
-(defun ok-to-fire-signature-rulep1 11209,499912
-(defun smart-member-equal-+- 11237,501441
-(defmacro recursivep 11281,503511
-(defun find-first-acceptable-domain 11290,503742
-(defun tau-lst-with-acceptable-domainsp 11322,505725
-(defun collect-bounder-args 11358,507575
-(defun bounding-interval 11390,509344
-(defun conjoin-bounding-intervals 11416,510374
-(defun apply-tau-bounders 11429,510879
-(defun tau-interval-equal-decider 11478,512976
-(defun tau-interval-<-decider 11530,515104
-(defun tau-term 11572,516720
-(defun tau-term-lst 11966,535030
-(defun tau-rewrite 12000,536546
-(defun relieve-dependent-hyps 12057,538879
-(defun ok-to-fire-signature-rulep 12098,541033
-(defun apply-signature-tau-rule 12115,541776
-(defun apply-signature-tau-rules1 12136,542805
-(defun apply-signature-tau-rules 12171,544496
-(defun tau-assume-basic 12192,545688
-(defun tau-assume 12236,547647
-(defun annotate-clause-with-key-numbers 12569,565761
-(defun tau-clause1p 12593,566675
-(defun tau-get-all-preds 12642,568807
-(defun tau-get-stats-new-max-block 12648,569039
-(defun tau-size 12667,569648
-(defun tau-get-stats-on-implicant-sizes 12673,569838
-(defun decode-recog 12696,570832
-(defun decode-recog-lst 12710,571285
-(defun decode-tau1 12715,571454
-(defun decode-tau 12732,572154
-(defun decode-tau-conjunctive-rule 12796,574367
-(defun decode-tau-conjunctive-rules 12815,575169
-(defun decode-tau-lst 12820,575356
-(defun decode-tau-alist 12827,575644
-(defun decode-tau-signature-rule 12835,575985
-(defun decode-tau-signature-rules1 12873,577580
-(defun decode-tau-signature-rules2 12878,577811
-(defun decode-tau-signature-rules 12885,578144
-(defun tau-get-all-sig-fns 12903,578988
-(defun some-slot-has-multiple-tau-sigs 12911,579385
-(defun count-tau-sigs-by-slot 12916,579559
-(defun collect-rules-with-dependent-hyps 12921,579721
-(defun collect-rules-with-dependent-hyps-across-mv 12930,580084
-(defun tau-get-stats-on-signatures1 12936,580363
-(defun tau-get-stats-on-signatures 12979,582194
-(defun collect-tau-big-switches 13010,584006
-(defun tau-sum-lst 13017,584296
-(defun tau-get-stats 13023,584530
-(defmacro tau-status 13074,586737
-(defun tau-data-fn 13143,589253
-(defmacro tau-data 13184,590940
-(defun all-fnnames-world1 13223,592268
-(defun all-fnnames-world 13240,593012
-(defun tau-data-fns 13251,593350
-(defun tau-database 13260,593668
-(defun initialize-tau-globals 13317,596260
-(defun collect-tau-relevant-triples 13344,597031
-(deflabel bounders13359,597803
-
-rewrite.lisp,18562
-(defrec congruence-rule 268,13538
-(defconst *geneqv-iff*427,21586
-(defun refinementp 445,22361
-(defun geneqv-refinementp1 506,24900
-(defun geneqv-refinementp 518,25339
-(defun some-congruence-rule-disabledp 572,28274
-(defun filter-geneqv1 578,28503
-(defun filter-geneqv 584,28752
-(defun some-geneqv-disabledp 598,29232
-(defun filter-geneqv-lst1 603,29408
-(defun filter-geneqv-lst 608,29573
-(defun refinementp1 627,30350
-(defun pair-congruence-rules-with-coarsenings 640,30844
-(defun add-to-cr-and-coarsenings652,31324
-(defun union-geneqv1 702,33574
-(defun union-geneqv 729,35029
-(defun pairwise-union-geneqv 749,35845
-(defun geneqv-lst1 766,36572
-(defun geneqv-lst 872,41694
-(defun subst-expr1 983,46700
-(defun subst-expr1-lst 993,47082
-(defun subst-expr-error 1003,47414
-(defun subst-expr 1010,47661
-(defun scons-term 1088,51739
-(defun subst-equiv-expr1 1154,54301
-(defun subst-equiv-expr1-lst 1209,57055
-(defun subst-equiv-expr 1232,57980
-(defun ffnnamesp 1245,58415
-(defun ffnnamesp-lst 1260,58967
-(defun collect-ffnnames 1270,59115
-(defun collect-ffnnames-lst 1293,59983
-(defun comm-equal 1300,60168
-(defun member-term2 1314,60559
-(defun member-complement-term2 1328,61026
-(defun member-complement-term1 1337,61348
-(defun member-term 1352,61794
-(defun member-complement-term 1367,62342
-(defun instr-listp 1385,62982
-(defun spliced-instr-listp 1404,63805
-(defun next-tag 1422,64539
-(defun if-compile-formal 1430,64752
-(defun ffnnamep-hide 1445,65404
-(defun ffnnamep-hide-lst 1464,66144
-(defun if-compile 1476,66432
-(defun if-compile-lst 1575,71201
-(defun if-interp-assume-true 1630,74357
-(defun if-interp-switch 1650,75178
-(defun if-interp-assumed-value0 1663,75677
-(defun if-interp-assumed-value1 1674,76072
-(defun if-interp-assumed-value2-equal-constant 1686,76566
-(defun if-interp-assumed-value2 1736,79074
-(defun if-interp-assumed-value3 1774,80880
-(defun if-interp-assumed-value4 1791,81638
-(defun if-interp-assumed-value-x 1808,82429
-(defun if-interp-assumed-value 1841,83935
-(defun convert-assumptions-to-clause-segment 1859,84703
-(defun convert-clause-to-assumptions 1982,90789
-(defun simplifiable-mv-nth1 2004,91896
-(defun simplifiable-mv-nth 2033,93136
-(defun simplifiable-mv-nthp 2060,94315
-(defun call-stack 2069,94532
-(defun ret-stack 2192,99758
-(defun extra-info-lit-p 2196,99863
-(defun subsetp-equal-mod-extra-info-lits 2204,100096
-(defun quick-and-dirty-subsumption-replacement-step1 2213,100411
-(defun quick-and-dirty-subsumption-replacement-step 2234,101271
-(defstub quick-and-dirty-srs 2414,109310
-(defun quick-and-dirty-srs-builtin 2416,109352
-(defattach quick-and-dirty-srs 2421,109471
-(defun if-interp-add-clause 2423,109532
-(defun if-interp 2442,110294
-(defun splice-instrs1 2581,117884
-(defun splice-instrs 2611,118975
-(defun strip-branches 2615,119089
-(defun merge-length 2643,120206
-(defun merge-sort-length 2652,120546
-(defun member-equal-+- 2658,120763
-(defun arg1-almost-subsumes-arg2 2672,121364
-(defun find-subsumer-replacement 2721,123604
-(defun remove-one-complement 2740,124585
-(defun weak-disc-tree 2747,124869
-(defun sweep-clauses1 2757,125233
-(defun sweep-clauses 2763,125457
-(defun filter-with-and-without 2767,125564
-(defun disc-tree 2785,126359
-(defun find-clauses1 2809,127536
-(defun find-clauses 2829,128472
-(defun remove-one-+- 2832,128542
-(defun store-clause1 2838,128729
-(defun store-clause 2876,130226
-(defun substitute1-ac 2895,130816
-(defun substitute1 2910,131323
-(defun replace-clause1 2915,131496
-(defun replace-clause 2941,132516
-(defun extra-info-lits 2946,132722
-(defun rev-union-equal 2952,132918
-(defun merge-extra-info-lits 2961,133200
-(defun subsumption-replacement-loop 2969,133459
-(defun clausify 3022,135778
-(defun find-rewriting-equivalence 3063,137666
-(defun obj-table 3133,141473
-(defun rewrite-solidify-rec 3178,143230
-(defconst *rewrite-equiv-solidify-iteration-bound*3309,148635
-(defun rewrite-solidify 3316,148835
-(defun rewrite-if11 3366,150703
-(defun rewrite-if13377,151099
-(defun equal-mod-alist 3424,153029
-(defun equal-mod-alist-lst 3458,154399
-(defun member-equal-mod-alist 3465,154634
-(defun not-to-be-rewrittenp1 3471,154857
-(defun not-to-be-rewrittenp 3483,155202
-(defun rewrite-recognizer 3499,155917
-(defun remove-invisible-fncalls 3558,158476
-(defun term-order+ 3572,158902
-(defun invisible-fns 3709,164344
-(defun loop-stopperp-rec 3742,165544
-(defun loop-stopperp 3760,166133
-(defrec rewrite-rule 3764,166257
-(defun relevant-ground-lemmas 3820,169167
-(defun search-ground-units13830,169500
-(defun search-ground-units3891,172441
-(defun if-tautologyp 3905,173014
-(defun expand-some-non-rec-fns 3938,174537
-(defun expand-some-non-rec-fns-lst 3952,175126
-(defun tautologyp 3959,175337
-(defun make-true-list-cons-nest 4003,177350
-(defun being-openedp-rec 4014,177803
-(defmacro being-openedp 4036,178917
-(defun recursive-fn-on-fnstackp 4056,179899
-(defun fnstack-term-member 4069,180361
-(defun var-counts1 4318,192225
-(defun var-counts1-lst 4336,192731
-(defun var-counts 4345,193028
-(defun count-ifs 4399,196081
-(defun count-ifs-lst 4411,196458
-(defun too-many-ifs0 4441,197537
-(defproxy too-many-ifs-pre-rewrite 4471,198775
-(defun too-many-ifs-pre-rewrite-builtin 4473,198823
-(defattach (too-many-ifs-pre-rewrite 4489,199501
-(defun occur-cnt-bounded 4519,200323
-(defun occur-cnt-bounded-lst 4547,201432
-(defun too-many-ifs1 4566,202210
-(defproxy too-many-ifs-post-rewrite 4592,203191
-(defun too-many-ifs-post-rewrite-builtin 4594,203240
-(defattach (too-many-ifs-post-rewrite 4608,203808
-(defun all-args-occur-in-top-clausep 4611,203900
-(defun cons-count-bounded-ac 4616,204109
-(defun cons-count-bounded 4633,204793
-(defun max-form-count 4639,204901
-(defun max-form-count-lst 4715,208411
-(defun controller-complexity1 4726,208737
-(defun controller-complexity 4749,209681
-(defun controller-pocket-simplerp 4762,210257
-(defun constant-controller-pocketp1 4780,210981
-(defun constant-controller-pocketp 4789,211381
-(defun some-controller-pocket-constant-and-non-controller-simplerp4800,211840
-(defun rewrite-fncallp 4816,212551
-(defun rewrite-fncallp-listp 4882,215529
-(defun contains-rewriteable-callp4900,216199
-(defun contains-rewriteable-callp-lst4930,217518
-(defrec linear-lemma 4943,217969
-(defrec current-literal 4955,218265
-(defrec rewrite-constant4957,218309
-(defconst *default-rw-cache-state*5084,224277
-(defconst *empty-rewrite-constant*5087,224322
-(defrec metafunction-context5110,225020
-(defun ok-to-force 5125,225652
-(defun plist-to-alist 5214,229703
-(defmacro adjust-rdepth 5223,229985
-(defun add-rewrite-args 5232,230204
-(defrec step-limit-record5252,231026
-(defun step-limit-start 5267,231649
-(defun step-limit-strictp 5276,231943
-(defun initial-step-limit 5288,232362
-(defun step-limit-error1 5317,233795
-(defmacro step-limit-error 5329,234170
-(defmacro decrement-step-limit 5351,234913
-(defmacro rewrite-entry 5373,235632
-(deflabel free-variables5452,239288
-(deflabel free-variables-type-prescription5658,249881
-(deflabel free-variables-examples5753,253104
-(deflabel free-variables-examples-rewrite5767,253673
-(deflabel free-variables-examples-forward-chaining6320,272877
-(defconst *fake-rune-for-linear*6519,279921
-(defrec gframe 6526,280108
-(defparameter *deep-gstack* 6566,281840
-(defmacro push-gframe 6568,281874
-(defparameter *saved-deep-gstack* 6607,283469
-(defmacro initial-gstack 6609,283509
-(defun tilde-@-bkptr-phrase 6624,284076
-(defun cw-gframe 6672,286557
-(defun cw-gstack1 6744,289545
-(defun cw-gstack-fn 6751,289855
-(defmacro cw-gstack 6813,292711
-(defun restore-brr-globals1 6975,301974
-(defun restore-brr-globals 6984,302292
-(defun save-brr-globals 7012,303400
-(defun get-brr-global 7036,304348
-(defun exit-brr-wormhole 7073,306213
-(defmacro brr-wormhole 7082,306538
-(defun initialize-brr-stack 7134,308866
-(defun lookup-brr-stack 7153,309604
-(defun clean-brr-stack1 7165,310126
-(defun clean-brr-stack 7171,310298
-(defun get-brr-local 7219,312886
-(defun put-brr-local1 7232,313511
-(defun put-brr-local 7243,313993
-(defun put-brr-local-lst 7258,314669
-(defun some-cdr-equalp 7263,314867
-(defun push-brr-stack-frame 7271,315087
-(defun pop-brr-stack-frame 7302,316502
-(defun decode-type-alist 7313,316953
-(defun translate-break-condition 7324,317387
-(defun eval-break-condition 7340,318005
-(defconst *default-free-vars-display-limit* 7357,318631
-(defmacro set-free-vars-display-limit 7359,318680
-(defun free-vars-display-limit 7369,319112
-(defun limit-failure-reason 7379,319432
-(defun limit-failure-reason-alist 7401,320466
-(defun fix-free-failure-reason 7426,321692
-(defun fix-free-failure-reason-alist 7439,322044
-(defun tilde-@-failure-reason-free-phrase 7454,322446
-(defun tilde-@-failure-reason-phrase1 7491,324189
-(defun tilde-@-failure-reason-phrase 7616,330669
-(defun stuff-standard-oi 7630,331407
-(deflabel break-rewrite7655,332660
-(deflabel break-lemma7908,346174
-(deflabel brr-commands7989,349827
-(defdoc dmr8035,351925
-(defun raw-mode-p 8196,360225
-(defun defun-mode-prompt-string 8199,360293
-(defun brr-prompt 8220,360807
-(defun ts< 8234,361290
-(defun add-to-type-alist-segments 8260,361742
-(defun merge-term-order 8273,362080
-(defun merge-sort-term-order 8280,362317
-(defun sort-type-alist-segments 8285,362507
-(defun type-alist-segments 8297,362920
-(defun print-terms 8306,363244
-(defun print-type-alist-segments 8321,363702
-(defun print-type-alist 8339,364442
-(defun tilde-*-ancestors-stack-msg1 8344,364599
-(defun tilde-*-ancestors-stack-msg 8368,365808
-(defun brkpt1 8372,365973
-(defun brkpt2 8608,375117
-(defrec expand-hint8876,385941
-(defun binds-to-constants-p 8893,386315
-(defun expand-permission-result1 8900,386588
-(defun remove1-by-position 8975,390479
-(defun expand-permission-result 8985,390875
-(defun expand-permission-p 9062,393954
-(defun one-way-unify-restrictions1 9074,394491
-(defun one-way-unify-restrictions 9084,394854
-(defun ev-fncall! 9090,395036
-(defun ev-fncall-meta 9134,396945
-(defun get-evg 9168,398578
-(defun ev-synp 9180,398885
-(defun bad-synp-alist1 9212,400366
-(defun bad-synp-alist 9242,401653
-(defun evgs-or-t 9263,402523
-(deflabel nu-rewriter9625,420475
-(defparameter *nth-update-tracingp* 9736,425275
-(defparameter *lambda-abstractp* 9739,425354
-(defparameter *nu-memos* 9742,425428
-(defparameter *nu-memos-ens* 9745,425515
-(defparameter *nu-memos-wrld* 9748,425587
-(defparameter *ring-buffer-size* 9751,425660
-(defun-one-output initialize-nu-memos 9765,426299
-(defun-one-output clear-nu-memos1 9776,426662
-(defun-one-output clear-nu-memos 9795,427444
-(defmacro this-item 9814,428256
-(defmacro next-ptr 9815,428291
-(defmacro prev-ptr 9816,428326
-(defun-one-output link-em 9827,428632
-(defun-one-output destructive-get-memo1 9832,428751
-(defun-one-output destructive-get-memo 9880,430205
-(defun get-memo 9894,430753
-(defun-one-output destructive-retire-memo 9949,432683
-(defun-one-output destructive-insert-memo 9961,433120
-(defun-one-output nu-memo-stats1 9980,433751
-(defun-one-output nu-memo-stats 9997,434429
-(defun memo-key1 10011,434828
-(defun bounded-length 10042,436079
-(defun memo-key 10053,436304
-(defun mk 10077,437169
-(defun show-rbuff1 10085,437370
-(defun show-rbuff 10088,437467
-(defun memo-exit 10103,438237
-(defun nfix-quote 10149,439941
-(defun bound-in-framep 10170,440581
-(defun non-rec-defun1 10179,440864
-(defun non-rec-defun 10225,443165
-(defun deref-var 10286,445793
-(defun deref 10299,446260
-(defun equal-derefs 10368,448513
-(defun filter-args 10383,448952
-(defun foccurrences 10391,449222
-(defun foccurrences-lst 10420,450196
-(defun every-var-at-most-oncep 10427,450427
-(defun every-actual-simple 10437,450734
-(defun make-clean-lambda-application 10444,450925
-(defun lambda-stack 10497,453283
-(defun shorten-each-stack-to-len 10524,454422
-(defun all-equal-stacks 10535,454855
-(defun non-quoted-stack 10544,455239
-(defun cdr-all 10550,455418
-(defun len-common-tail 10554,455514
-(defun butlast-all-stacks 10559,455683
-(defun min-stack-len 10566,455936
-(defun reconcile-stacks 10576,456266
-(defun reconcile-terms 10625,458208
-(defun all-equal 10631,458382
-(defun recon 10636,458511
-(defun with-reconciliation-let-bindings 10659,459500
-(defmacro with-reconciliation 10665,459759
-(defun lambda-stack-one-way-unify1 10698,460737
-(defun lambda-stack-one-way-unify1-lst 10747,462586
-(defun lambda-stack-one-way-unify 10767,463410
-(defun apply-abbrevs-to-lambda-stack1 10796,464410
-(defun apply-abbrevs-to-lambda-stack 10839,466493
-(defconst *fake-rune-for-nu-rewriter*10936,470173
-(defun nth-update-rewriter1-continue10943,470320
-(defun nth-update-rewriter111001,472403
-(defun nth-update-rewriter1-lst 11548,495584
-(defun nth-update-rewriter-targetp 11571,496590
-(defun nth-update-rewriter-target-lstp 11585,497201
-(defun make-stack-from-alist 11594,497446
-(defun nth-update-rewriter 11617,498342
-(defun collect-by-position 11733,503151
-(defun make-lambda-application 11751,503854
-(defun lambda-nest-hidep 11786,505070
-(defun lambda-nest-unhide 11802,505525
-(defun search-type-alist+ 11813,505817
-(defun oncep 11833,506652
-(defabbrev memo-activep 11847,507274
-(defabbrev activate-memo 11850,507344
-(defmacro zero-depthp 11853,507409
-(defmacro rdepth-error 11870,508078
-(defun bad-synp-hyp-msg1 11902,509782
-(defun bad-synp-hyp-msg 12056,518557
-(defmacro sl-let 12083,519844
-(defmacro sl-let@par 12094,520097
-(defmacro rewrite-entry-extending-failure 12106,520465
-(defun set-difference-assoc-eq 12121,521324
-(defun relieve-hyp-synp 12131,521759
-(defun push-lemma? 12242,526724
-(defmacro push-lemma+ 12247,526810
-(defmacro push-splitter? 12262,527379
-(defmacro prepend-step-limit 12280,528101
-(defrec rw-cache-entry12291,528449
-(defmacro free-failure-p 12353,531106
-(defabbrev combine-free-failure-reasons 12356,531170
-(defun combine-free-failure-alists 12369,531611
-(defun combine-sorted-rw-cache-lists1 12410,533080
-(defun split-psorted-list1 12463,535443
-(defun split-psorted-list 12471,535704
-(defun merge-lexorder-fast 12484,536202
-(defun merge-sort-lexorder-fast 12501,536860
-(defun sort-rw-cache-list 12541,538509
-(defun combine-rw-cache-lists 12559,539113
-(defun merge-rw-caches 12583,540077
-(defmacro sorted-rw-cache-p 12615,541597
-(defun merge-symbol-alistp 12621,541728
-(defun merge-sort-symbol-alistp 12631,542013
-(defun cdr-sort-rw-cache 12643,542482
-(defun combine-rw-caches 12658,542953
-(defun unify-subst-subsetp 12676,543668
-(defun rw-cache-list-lookup 12688,544056
-(defstub relieve-hyp-failure-entry-skip-p12717,545360
-(defun relieve-hyp-failure-entry-skip-p-builtin 12721,545451
-(defattach (relieve-hyp-failure-entry-skip-p12727,545703
-(defmacro rw-cache-active-p 12730,545804
-(defun assoc-rw-cache 12734,545931
-(defun put-assoc-rw-cache1 12742,546159
-(defun put-assoc-rw-cache 12754,546653
-(defun relieve-hyp-failure-entry 12763,546931
-(defun maybe-extend-tag-tree 12788,547963
-(defun accumulate-rw-cache1 12795,548140
-(defun accumulate-rw-cache 12842,550104
-(defun accumulate-rw-cache? 12861,551024
-(defun dumb-occur-var 12877,551709
-(defun dumb-occur-var-lst 12887,552038
-(defun restrict-alist-to-all-vars1 12893,552202
-(defun all-vars-boundp 12911,552947
-(defun all-vars-lst-boundp 12919,553229
-(defun restrict-alist-to-all-vars 12928,553512
-(defun push-rw-cache-entry 12951,554509
-(defstub rw-cache-debug12973,555267
-(defstub rw-cache-debug-action12977,555363
-(defun rw-cache-debug-builtin 12981,555466
-(defun rw-cache-debug-action-builtin 12987,555691
-(defun rw-cacheable-failure-reason-builtin 13005,556322
-(defattach (rw-cacheable-failure-reason 13015,556760
-(defun rw-cacheable-nil-tag 13018,556856
-(defun note-relieve-hyp-failure 13039,557730
-(defun replace-free-rw-cache-entry1 13089,560185
-(defun replace-free-rw-cache-entry 13110,561189
-(defun rw-cache-alist-nil-tag-p 13129,561859
-(defabbrev merge-free-failure-reasons-nil-tag 13143,562474
-(defun merge-free-failure-alists-nil-tag 13156,563054
-(defun note-rw-cache-free-nil-tag 13202,564836
-(defun note-relieve-hyps-failure-free 13253,566964
-(defun rw-cache-enter-context 13290,568365
-(defun erase-rw-cache 13298,568640
-(defun rw-cache-exit-context 13307,568864
-(defun restore-rw-cache-any-tag 13335,570123
-(defun cons-tag-trees-rw-cache 13358,571311
-(defun normalize-rw-any-cache 13429,574131
-(defun cons-tag-trees-rw-cache-first 13441,574527
-(defun alist-keys-subsetp 13455,574959
-(defmacro tag-tree-tags-subsetp 13461,575113
-(defun rw-cache 13467,575226
-(defun rw-cached-failure-pair 13482,575685
-(defun extend-rw-cache-alist-free 13503,576655
-(defun rw-cache-add-failure-reason 13523,577672
-(defun rewrite 13548,578695
-(defun rewrite-solidify-plus 14220,609692
-(defun rewrite-if 14279,612457
-(defun rewrite-args 14430,620450
-(defun rewrite-primitive 14458,621507
-(defun rewrite-equal 14496,623022
-(defun relieve-hyp14799,637026
-(defun relieve-hyps1 15168,656190
-(defun relieve-hyps1-free-115310,663142
-(defun relieve-hyps1-free-215429,668677
-(defun relieve-hyps 15618,676778
-(defun rewrite-with-lemma 15753,683077
-(defun rewrite-with-lemmas1 16100,700519
-(defun rewrite-fncall 16144,702466
-(defun rewrite-with-lemmas 16530,722882
-(defun rewrite-linear-term 16671,729699
-(defun rewrite-linear-term-lst 16760,733714
-(defun add-linear-lemma 16813,736085
-(defun add-linear-lemmas 17051,747203
-(defun multiply-alists2 17104,749416
-(defun multiply-alists1 17163,752065
-(defun multiply-alists 17210,753790
-(defun multiply-polys1 17266,755777
-(defun multiply-polys 17438,763391
-(defun multiply-pots2 17500,765991
-(defun multiply-pots1 17561,768114
-(defun multiply-pots-super-filter 17610,769790
-(defun multiply-pots-filter 17666,771965
-(defun multiply-pots 17720,774194
-(defun add-multiplied-polys-filter 17773,776142
-(defun add-multiplied-polys 17853,779742
-(defun deal-with-product1 17937,783251
-(defun deal-with-product 18056,788937
-(defun deal-with-factor 18102,790831
-(defun deal-with-division 18190,794937
-(defun non-linear-arithmetic1 18307,800068
-(defun non-linear-arithmetic 18400,804414
-(defun add-polys-and-lemmas2-nl 18689,815996
-(defun add-polys-and-lemmas1-nl 18782,820206
-(defun add-polys-and-lemmas1 18906,825449
-(defun add-polys-and-lemmas 18972,828161
-(defun add-disjunct-polys-and-lemmas 19069,832235
-(defun add-disjuncts-polys-and-lemmas 19183,837367
-(defun add-terms-and-lemmas 19355,845467
-(defun rewrite-with-linear 19450,849823
-
-simplify.lisp,9746
-(defun negate-lit 65,2819
-(defun pegate-lit 86,3645
-(defun add-literal 107,4440
-(defun add-each-literal 144,5860
-(defun subsumes-rec 206,8828
-(defun subsumes1-equality-with-const 252,11316
-(defun subsumes1 301,14150
-(defun subsumes!-rec 336,15656
-(defun subsumes!1-equality-with-const 363,16943
-(defun subsumes!1 399,18696
-(defconst *init-subsumes-count*419,19397
-(defun subsumes 439,20215
-(defun some-member-subsumes 462,21200
-(defun conjoin-clause-to-clause-set 475,21722
-(defun add-each-literal-lst 494,22646
-(defun conjoin-clause-sets 500,22849
-(defun some-element-member-complement-term 506,23055
-(defun disjoin-clauses1 514,23376
-(defun disjoin-clauses 530,24029
-(defun disjoin-clause-segment-to-clause-set 548,24640
-(defun split-on-assumptions 567,25558
-(defun rewrite-clause-action 581,26033
-(defrec forward-chaining-rule717,33879
-(defrec fc-activation727,34373
-(defun suspend-fc-activation 840,40932
-(defun prettyify-fc-activation 901,43353
-(defun prettyify-fc-activations 976,46700
-(defun make-fc-activation 981,46897
-(defun make-fc-activations 1029,49411
-(defun collect-terms-and-activations 1039,49820
-(defun collect-terms-and-activations-lst1092,52378
-(defun collect-terms-and-activations-from-fcd-lst 1105,52966
-(defun sublis-varp 1137,54353
-(defun sublis-var-lstp 1146,54638
-(defun mult-search-type-alist 1155,54885
-(defun mult-lookup-hyp 1226,58673
-(defun ev-respecting-ens 1245,59482
-(defun ev-lst-respecting-ens 1302,62400
-(defun add-fc-derivations 1401,67961
-(defun prettyify-fc-derivation 1438,69596
-(defun prettyify-fc-derivations 1499,72210
-(defun expunge-fc-derivations-lst 1507,72441
-(defun expunge-fc-derivations 1517,72952
-(defun current-fc-call-number 1707,82792
-(defun current-fc-call-alist 1711,82911
-(defun put-current-fc-call-alist 1715,83029
-(defun initialize-fc-wormhole-sites 1733,83866
-(deflabel forward-chaining-reports1748,84317
-(defun show-fc-criteria 2034,97548
-(defun reset-fc-reporting 2057,98085
-(defun translate-fc-criterion 2088,98952
-(defun translate-fc-criteria 2119,100167
-(defun set-fc-criteria-fn 2136,100902
-(defmacro set-fc-criteria 2160,101707
-(defun set-fc-report-on-the-fly 2232,104949
-(defun new-fc-call 2290,107213
-(defun member-one-way-unify1 2336,109245
-(defun satisfying-fc-activation1p 2350,109693
-(defun satisfying-fc-activationp 2369,110392
-(defun collect-satisfying-fc-activations 2374,110600
-(defun satisfying-virtual-fc-activation1p 2392,111530
-(defun satisfying-virtual-fc-activationp 2418,112618
-(defun satisfying-fc-derivation1p 2430,113223
-(defun satisfying-fc-derivationp 2444,113701
-(defun collect-satisfying-fc-derivations 2449,113909
-(defun filter-satisfying-virtual-fc-activation 2464,114566
-(defun filter-all-satisfying-fc-derivations 2517,117086
-(defun filter-satisfying-fc-activations 2562,119083
-(defun filter-redundant-approved-fc-derivation 2596,120409
-(defun collect-rune-trigger-pairs-from-fc-activations 2696,124749
-(defun collect-rune-trigger-pairs-from-fc-derivations 2706,125248
-(defun prettyify-subst 2717,125751
-(defun collect-fc-status-site-1 2724,126024
-(defun collect-fc-status-sites-2-3-5 2750,127282
-(defun prettyify-blocked-fc-inst-hyp 2784,128971
-(defun collect-fc-status-site-4 2803,129775
-(defun collect-fc-status 2831,131067
-(defun make-fc-activity-report1 2843,131585
-(defun make-fc-activity-report 2855,132166
-(defun fc-report1 2881,133210
-(defun fc-report 2920,134589
-(defun fc-exit 2954,135612
-(defun advance-fc-activation13072,141659
-(defun advance-fc-activation23230,148410
-(defun advance-fc-activation33462,158532
-(defun advance-fc-activation 3486,159501
-(defun advance-fc-activations 3511,160540
-(defun fc-pair-lst 3532,161578
-(defun fc-pair-lst-type-alist 3554,162602
-(defmacro fcd-runep 3676,168253
-(defun fcd-runep-lst 3687,168794
-(defmacro fcd-worse-than-or-equal 3693,169041
-(defun fcd-worse-than-or-equal-lst 3705,169640
-(defun exists-fcd-worse-than-or-equal 3741,171456
-(defun all-dumb-occur-lst 3757,172181
-(defun all-args-occur-after-strip-not 3762,172344
-(defun approved-fc-derivationp 3778,173038
-(defun approve-fc-derivations 3864,176138
-(defun max-level-no 3892,177536
-(defun max-level-no-lst 3907,178175
-(defun get-level-no 3912,178338
-(defun sort-approved1-rating1 3926,178638
-(defun sort-approved1-rating1-lst 3944,179487
-(defun sort-approved1-rating 3951,179738
-(defun sort-approved1 3969,180665
-(defun sort-approved 3978,180968
-(defun strip-fcd-concls 3985,181225
-(defun type-alist-fcd-lst 3993,181502
-(defun every-concl-member-equalp 4043,183741
-(defun forward-chain1 4057,184252
-(defun forward-chain-top 4135,188551
-(defun forward-chain 4240,193567
-(defun select-forward-chained-concls-and-ttrees 4258,194442
-(defun rewrite-clause-type-alist 4532,207276
-(defun maximal-multiples1 4836,221859
-(defun maximal-multiples 4850,222355
-(defun lambda-abstract1 4863,222790
-(defun lambda-abstract 4872,223141
-(defun mutually-exclusive-tests 4889,223660
-(defun mutually-exclusive-subsumptionp 4920,224777
-(defun cleanup-if-expr 4940,225471
-(defun cleanup-if-expr-lst 4964,226383
-(defun all-type-reasoning-tags-p1 4970,226573
-(defun all-type-reasoning-tags-p 4977,226831
-(defun try-clause 4980,226935
-(defconst *trivial-non-nil-ttree*4995,227362
-(defun make-non-nil-ttree 4998,227414
-(defun try-type-set-and-clause 5002,227493
-(defun lambda-subtermp 5033,228923
-(defun lambda-subtermp-lst 5043,229177
-(defun rewrite-atm 5051,229335
-(defun every-occurrence-equiv-hittablep15432,246164
-(defun every-occurrence-equiv-hittablep1-listp5471,247512
-(defun every-occurrence-equiv-hittablep 5489,248007
-(defun every-occurrence-equiv-hittablep-in-clausep 5510,248867
-(defun some-occurrence-equiv-hittablep1 5532,249623
-(defun some-occurrence-equiv-hittablep1-listp5564,250702
-(defun some-occurrence-equiv-hittablep 5580,251133
-(defun equiv-hittable-in-some-other-lit 5597,251740
-(defun find-trivial-equivalence15610,252296
-(defun find-trivial-equivalence 5766,260335
-(defun add-literal-and-pt1 5817,262821
-(defun add-literal-and-pt 5835,263637
-(defun add-binding-to-tag-tree 5866,264771
-(defun subst-equiv-and-maybe-delete-lit5880,265299
-(defun remove-trivial-equivalences5935,268048
-(defrec built-in-clause 6006,271892
-(defconst *initial-built-in-clauses*6019,272604
-(defun built-in-clausep2 6247,281121
-(defun built-in-clausep1 6260,281711
-(defun possible-trivial-clause-p 6283,282851
-(defun trivial-clause-p 6307,283780
-(defun built-in-clausep 6312,283930
-(defun crunch-clause-segments1 6385,287747
-(defun crunch-clause-segments2 6425,289938
-(defun crunch-clause-segments 6439,290449
-(defun strip-non-rewrittenp-assumptions1 6506,294109
-(defun strip-non-rewrittenp-assumptions 6521,294816
-(defun assumnote-list-to-token-list 6538,295548
-(defun resume-suspended-assumption-rewriting16544,295761
-(defun resume-suspended-assumption-rewriting6702,303689
-(defun helpful-little-ecnt-msg 6797,308838
-(defun rewrite-clause 6811,309213
-(defun rewrite-clause-lst 7169,326436
-(defun setup-simplify-clause-pot-lst1 7237,329276
-(defun setup-simplify-clause-pot-lst 7270,330611
-(defun sequential-subst-var-term 7357,333898
-(defun process-equational-polys7369,334364
-(defun enumerate-elements 7548,342989
-(defun already-used-by-fertilize-clausep 7552,343110
-(defun unhidden-lit-info 7569,343969
-(defun tilde-@-hyp-phrase 7588,344821
-(defun simplify-clause1 7617,345931
-(defun some-element-dumb-occur-lst 7795,354551
-(defrec prove-spec-var7808,355121
-(defrec gag-info7835,356297
-(defrec gag-state7851,356859
-(defconst *initial-gag-state*7859,357255
-(defconst *empty-prove-spec-var*7867,357428
-(defun controller-unify-subst2 7882,357830
-(defun controller-unify-subst1 7889,358069
-(defun controller-unify-subst 7897,358402
-(defun filter-disabled-expand-terms 7904,358703
-(defun found-hit-rewrite-hist-entry 7985,362752
-(defabbrev append? 7999,363321
-(defun simplify-clause 8003,363395
-(defun settled-down-clause 8357,381955
-(defun member-class-name-runes 8380,382927
-(defun extract-and-classify-lemmas2 8388,383200
-(defun extract-and-classify-lemmas1 8413,384498
-(defun runes-to-class-alist1 8430,385265
-(defun strict-merge-symbol-< 8444,385897
-(defun strict-merge-sort-symbol-< 8465,386730
-(defun strict-symbol-<-sortedp 8482,387241
-(defun sort-symbol-listp 8489,387469
-(defun strict-merge-sort-symbol-<-cdrs 8495,387637
-(defun runes-to-class-alist 8501,387871
-(defun extract-and-classify-lemmas 8508,388063
-(deflabel Simple8540,389455
-(defun tilde-*-conjunction-of-possibly-forced-names-phrase1 8573,390850
-(defun tilde-*-conjunction-of-possibly-forced-names-phrase 8587,391398
-(defconst *fake-rune-alist*8602,392001
-(defun rune-< 8615,392464
-(defun merge-runes 8630,392822
-(defun merge-sort-runes 8637,393040
-(defun tilde-*-simp-phrase1 8642,393205
-(defun tilde-*-raw-simp-phrase1 8772,398347
-(defun recover-forced-runes1 8821,400637
-(defun recover-forced-runes 8833,401014
-(defun tilde-*-raw-simp-phrase 8845,401555
-(defun tilde-*-simp-phrase 8872,402507
-(defun tilde-@-pool-name-phrase 8904,403928
-(defun tilde-@-pool-name-phrase-lst 8942,405866
-(defun tilde-@-clause-id-phrase 8947,406092
-(defrec bddnote9036,409059
-(defun tilde-@-bddnote-phrase 9040,409160
-(defun parse-natural1 9054,409673
-(defun parse-natural 9080,410625
-(defun parse-dotted-naturals 9101,411431
-(defun parse-match 9137,413109
-(defun parse-primes 9151,413672
-(defun parse-clause-id2 9177,414655
-(defun parse-clause-id1 9207,415667
-(defun parse-clause-id 9272,417946
-(defun tilde-@-case-split-limitations-phrase 9310,419249
-(defun simplify-clause-msg1 9325,419791
-(deflabel specious-simplification9447,426022
-(defun settled-down-clause-msg1 9559,431610
-
-bdd.lisp,4141
-(defmacro mvf 45,1569
-(defmacro logandf 57,2133
-(defmacro logxorf 60,2201
-(defmacro logiorf 63,2268
-(defmacro ashf 66,2335
-(defmacro mx-id-bound 70,2441
-(defmacro 1+mx-id 78,2692
-(defmacro bdd-error 130,4826
-(defmacro unique-id 212,8206
-(defmacro tst 214,8255
-(defmacro cst-boolp 220,8545
-(defmacro tbr 222,8583
-(defmacro fbr 223,8615
-(defmacro leafp 225,8648
-(defmacro trm 228,8691
-(defun bdd-constructors 230,8722
-(defun make-leaf-cst 240,9074
-(defun evg-fn-symb 250,9376
-(defun bdd-constructor-trm-p 279,10363
-(defun evg-type 285,10576
-(defun make-if-cst 301,11116
-(defconst *cst-t* 360,14043
-(defconst *cst-nil* 361,14088
-(defmacro cst=363,14136
-(defmacro cst-tp 367,14214
-(defmacro cst-nilp 370,14265
-(defmacro cst-varp 373,14318
-(defun cst-nonnilp 376,14371
-(defun bool-mask1 400,15428
-(defun boolean-term-var 417,16248
-(defun boolean-hyps-vars 450,17432
-(defun first-boolean-type-prescription 465,17812
-(defun recognizer-rune 500,19423
-(defun bool-mask 510,19849
-(defun commutative-p1 554,21438
-(defun find-equivalence-rune 583,22834
-(defun equivalence-rune1 594,23187
-(defun equivalence-rune 621,24183
-(defun commutative-p 631,24554
-(defun op-alist 648,25192
-(defun op-alist-info 684,26727
-(defmacro if-op-code 707,27339
-(defmacro hash-size 709,27367
-(defmacro if-hash-index 736,28445
-(defun op-hash-index1 748,28866
-(defmacro op-hash-index 775,29913
-(defmacro op-hash-index-2 780,30048
-(defmacro op-hash-index-if 790,30319
-(defun if-search-bucket 800,30630
-(defun cst=811,30920
-(defmacro eq-op 817,31043
-(defun op-search-bucket 823,31150
-(defun op-search-bucket-2 836,31629
-(defun op-search-bucket-if 853,32363
-(defun chk-memo 869,32977
-(defun chk-memo-2 887,33646
-(defun chk-memo-if 903,34180
-(defmacro half-hash-size 923,34894
-(defmacro fourth-hash-size 926,34948
-(defun op-hash-index-string 929,35004
-(defun op-hash-index-evg 942,35400
-(defun op-search-bucket-quote 975,36439
-(defun chk-memo-quotep 983,36714
-(defun bdd-quotep 999,37198
-(defmacro bdd-quotep+ 1032,38309
-(defrec bdd-rule1049,39128
-(defun rewrite-rule-to-bdd-rule 1053,39170
-(defun bdd-rules-alist11059,39372
-(defun extra-rules-for-bdds 1137,43507
-(defun bdd-rules-alist 1204,46159
-(defmacro one-way-unify1-cst-2 1266,48779
-(defmacro one-way-unify1-cst-3 1280,49397
-(defun one-way-unify1-cst 1298,50127
-(defun one-way-unify1-cst-lst 1479,60972
-(defun one-way-unify1-cst-equal 1497,61625
-(defun some-one-way-unify-cst-lst 1511,62114
-(defun leaf-cst-list 1540,63265
-(defun decode-cst 1562,64118
-(defun decode-cst-lst 1600,65389
-(defun decode-cst-alist1 1612,65756
-(defun decode-cst-alist 1624,66204
-(defun leaf-cst-list-array 1630,66386
-(defconst *some-non-nil-value* 1637,66617
-(defun falsifying-assignment1 1639,66671
-(defun falsifying-assignment 1676,68058
-(defun make-if 1686,68419
-(defun make-if-no-memo 1765,72006
-(defmacro split-var 1799,73285
-(defun min-var 1812,73624
-(defun combine-op-csts1 1832,74212
-(defun bool-flg 1865,75735
-(defun some-bdd-constructorp 1887,76386
-(defun combine-op-csts-simple1894,76643
-(defmacro bdd-mv-let 1946,78574
-(defmacro combine-if-csts+ 2009,80999
-(defun combine-if-csts1 2018,81322
-(defun combine-if-csts2038,82047
-(defun cst-list-to-evg-list 2116,85211
-(defun cst-quote-listp 2122,85374
-(defrec bddspv2130,85558
-(defun bdd-ev-fncall2141,85961
-(defmacro combine-op-csts+ 2171,87181
-(defun make-if-for-op2189,88128
-(defun combine-op-csts 2239,89644
-(defun combine-op-csts-comm 2269,90778
-(defun combine-op-csts-guts2346,94005
-(defun bdd 2467,99178
-(defun bdd-alist 2588,103955
-(defun bdd-list 2607,104679
-(defun if-ht-max-length 2634,105613
-(defun op-ht-max-length 2639,105768
-(defun leaf-cst-list-to-alist 2644,105923
-(defvar *request-bigger-fixnum-table*2658,106351
-(defun bdd-top 2661,106441
-(defun get-bool-vars 2769,112114
-(defun bdd-clause1 2787,112719
-(defmacro expand-and-or-simple+2913,118147
-(defun expand-and-or-simple2925,118612
-(defun expand-clause3072,125108
-(defun bdd-clause 3097,126110
-(deflabel obdd3213,132073
-(deflabel bdd-algorithm3221,132227
-(deflabel bdd-introduction3731,157420
-
-other-processes.lisp,3301
-(defun strip-final-digits1 30,1253
-(defun strip-final-digits 51,2117
-(defconst *var-families-by-type*76,3315
-(defun assoc-ts-subsetp 97,4014
-(defun first-non-member-eq 107,4281
-(defun abbreviate-hyphenated-string1 120,4689
-(defun abbreviate-hyphenated-string 147,5788
-(defun generate-variable-root1 164,6375
-(defun generate-variable-root 225,8865
-(defun generate-variable 244,9569
-(defun generate-variable-lst 256,10121
-(defrec elim-rule290,11827
-(defun occurs-nowhere-else 296,11965
-(defun first-nomination 308,12364
-(defun second-nomination 315,12532
-(defun some-hyp-probably-nilp 328,12953
-(defun sublis-expr 354,13821
-(defun sublis-expr-lst 372,14513
-(defun nominate-destructor-candidate379,14679
-(defun nominate-destructor-candidates504,21176
-(defun nominate-destructor-candidates-lst527,22004
-(defun sum-level-nos 554,23112
-(defun pick-highest-sum-level-nos 570,23777
-(defun select-instantiated-elim-rule 589,24561
-(defun type-restriction-segment 640,27174
-(defun subterm-one-way-unify 736,31670
-(defun subterm-one-way-unify-lst 749,32208
-(defrec generalize-rule 759,32501
-(defun apply-generalize-rule 761,32553
-(defun generalize-rule-segment1 800,34317
-(defun generalize-rule-segment 822,35419
-(defun generalize1 846,36598
-(defun apply-instantiated-elim-rule 879,38225
-(defun eliminate-destructors-clause1 995,44107
-(defun owned-vars 1140,51274
-(defun eliminate-destructors-clause 1219,55508
-(defun prettyify-clause1 1253,57158
-(defun prettyify-clause2 1258,57344
-(defun prettyify-clause 1272,57954
-(defun prettyify-clause-lst 1285,58505
-(defun prettyify-clause-set 1291,58789
-(defun tilde-*-elim-phrase/alist1 1297,59054
-(defun tilde-*-elim-phrase/alist 1304,59325
-(defun tilde-*-elim-phrase3 1316,59769
-(defun tilde-*-elim-phrase2 1324,60172
-(defun tilde-*-elim-phrase1 1351,61496
-(defun tilde-*-elim-phrase 1384,63126
-(defun tilde-*-untranslate-lst-phrase 1404,63744
-(defun eliminate-destructors-clause-msg1 1409,63890
-(defun almost-quotep1 1462,66324
-(defun almost-quotep1-listp 1473,66697
-(defun almost-quotep 1480,66862
-(defun destructor-applied-to-varsp 1492,67217
-(defun dumb-occur-lst-except 1509,67900
-(defun fertilize-feasible 1527,68709
-(defun fertilize-complexity 1545,69499
-(defun maximize-fertilize-complexity 1555,69834
-(defun first-fertilize-lit 1562,70038
-(defun cross-fertilizep/c 1596,71602
-(defun cross-fertilizep/d 1610,72093
-(defun cross-fertilizep 1624,72584
-(defun delete-from-ttree 1649,73901
-(defun fertilize-clause1 1661,74427
-(defun fertilize-clause 1865,84067
-(defun fertilize-clause-msg1 1953,88534
-(defun collectable-fnp 1998,90495
-(defun smallest-common-subterms1 2016,91124
-(defun smallest-common-subterms1-lst 2077,93556
-(defun dumb-fn-count-1 2098,94237
-(defun dumb-fn-count 2112,94766
-(defun smallest-common-subterms 2135,95655
-(defun generalizing-relationp 2151,96368
-(defun generalizable-terms-across-relations 2182,97735
-(defun generalizable-terms-across-literals1 2197,98356
-(defun generalizable-terms-across-literals 2203,98602
-(defun generalizable-terms 2215,99081
-(defun generalize-clause 2226,99435
-(defun tilde-*-gen-phrase/alist1 2307,103268
-(defun tilde-*-gen-phrase/alist 2314,103537
-(defun tilde-*-gen-phrase 2322,103706
-(defun generalize-clause-msg1 2376,106558
-
-induct.lisp,5029
-(defun select-x-cl-set 23,881
-(defun unchangeables 35,1336
-(defun changeables 50,1930
-(defun sound-induction-principle-mask1 66,2516
-(defun sound-induction-principle-mask 104,4307
-(defrec candidate162,7269
-(defun count-non-nils 209,10209
-(defun controllers 214,10354
-(defun changed/unchanged-vars 221,10637
-(defrec tests-and-alists 228,10925
-(defun tests-and-alists/alist 230,10971
-(defun tests-and-alists/alists 257,12146
-(defrec tests-and-calls 279,13169
-(defrec justification294,14018
-(defun tests-and-alists 299,14132
-(defun tests-and-alists-lst 315,14877
-(defun flesh-out-induction-principle 327,15346
-(defun intrinsic-suggested-induction-cand364,16488
-(defrec induction-rule 404,18660
-(defun apply-induction-rule 408,18751
-(defun suggested-induction-cands1518,22845
-(defun suggested-induction-cands577,25248
-(defun get-induction-cands 601,26255
-(defun get-induction-cands-lst 617,26774
-(defun get-induction-cands-from-cl-set1 632,27150
-(defun get-induction-cands-from-cl-set 659,28281
-(defun pigeon-holep-apply 694,29800
-(defun pigeon-holep 736,31588
-(defun pigeon-holep1 755,32410
-(defun flush-cand1-down-cand2 776,33110
-(defun flush-candidates 812,34945
-(defun alists-agreep 837,36181
-(defun irreconcilable-alistsp 850,36682
-(defun affinity 868,37448
-(defun member-affinity 881,37921
-(defun occur-affinity 890,38209
-(defun some-occur-affinity 906,38779
-(defun all-occur-affinity 915,39113
-(defun contains-affinity 924,39446
-(defun antagonistic-tests-and-alists-lstp 937,39933
-(defun antagonistic-tests-and-alists-lstsp 963,40864
-(defun every-alist1-matedp 978,41349
-(defun merge-alist1-into-alist2 999,42274
-(defun merge-alist1-lst-into-alist2 1020,43207
-(defun merge-lst1-into-alist2 1034,43679
-(defun merge-lst1-into-alist2-lst 1050,44156
-(defun merge-lst1-into-lst2 1055,44392
-(defun merge-tests-and-alists-lsts 1065,44803
-(defun merge-cand1-into-cand2 1146,49374
-(defun merge-candidates 1244,54737
-(defun controller-variables1 1259,55207
-(defun controller-variables 1274,55837
-(defun induct-vars1 1288,56542
-(defun induct-vars 1302,56966
-(defun vetoedp 1321,57713
-(defun compute-vetoes1 1345,58716
-(defun compute-vetoes2 1367,59557
-(defun compute-vetoes 1383,60108
-(defun induction-complexity1 1447,63447
-(defun maximal-elements-apply 1465,64260
-(defun maximal-elements1 1478,64700
-(defun maximal-elements 1503,65735
-(defun intersectp-eq/union-equal 1527,66628
-(defun equal/union-equal 1533,66816
-(defun subsetp-equal/smaller 1539,66969
-(defun m&m-apply 1544,67087
-(defun count-off 1557,67604
-(defun m&m-search 1565,67810
-(defun m&m1 1583,68570
-(defun m&m 1634,70709
-(defun cons-subset-tree 1719,75214
-(defabbrev car-subset-tree 1736,75638
-(defabbrev cdr-subset-tree 1742,75723
-(defun or-subset-trees 1748,75808
-(defun m&m-over-powerset1 1760,76306
-(defun m&m-over-powerset 1786,77103
-(defun all-picks2 1895,82378
-(defun all-picks2r 1901,82558
-(defun all-picks1 1907,82747
-(defun all-picks 1916,83066
-(defun dumb-negate-lit-lst-lst 1957,85038
-(defun induction-hyp-clause-segments2 1969,85533
-(defun induction-hyp-clause-segments1 1975,85778
-(defun induction-hyp-clause-segments 1987,86196
-(defun induction-formula3 2023,87958
-(defun induction-formula2 2066,89723
-(defun induction-formula1 2095,90969
-(defun induction-formula 2111,91721
-(defun all-picks-size 2183,94929
-(defun induction-formula-size1 2190,95132
-(defun induction-formula-size 2206,95866
-(defconst *maximum-induct-size* 2221,96462
-(defun termify-clause-set 2226,96584
-(defun inform-simplify3 2243,97257
-(defun inform-simplify2 2252,97576
-(defun inform-simplify1 2262,97864
-(defun inform-simplify 2276,98433
-(defun all-vars1-lst-lst 2327,101319
-(defun gen-new-name1 2336,101620
-(defun gen-new-name 2346,101945
-(defun unmeasured-variables3 2354,102177
-(defun unmeasured-variables2 2362,102489
-(defun unmeasured-variables1 2368,102719
-(defun unmeasured-variables 2377,103131
-(defun tilde-@-well-founded-relation-phrase 2388,103620
-(defun measured-variables 2406,104367
-(defun induct-msg/continue 2416,104756
-(defun rec-fnnames 2597,113148
-(defun rec-fnnames-lst 2608,113630
-(defun induct-msg/lose 2615,113801
-(defun@par load-hint-settings-into-rcnst 2677,116943
-(defun update-hint-settings 2747,120320
-(defun@par load-hint-settings-into-pspv 2762,120885
-(defun restore-hint-settings-in-pspv 2795,122351
-(defun remove-trivial-clauses 2834,124475
-(defun non-standard-vector-check 2843,124755
-(defun merge-ns-check 2851,125019
-(defun trap-non-standard-vector-aux 2859,125302
-(defun remove-adjacent-duplicates 2873,125997
-(defun non-standard-induction-vars 2880,126272
-(defun trap-non-standard-vector 2892,126696
-(defun induct 2900,127058
-(defun pair-vars-with-lits 3091,135667
-(defun ffnnames-subsetp 3104,136009
-(defun ffnnames-subsetp-listp 3118,136513
-(defun probably-not-validp 3128,136793
-(defun irrelevant-lits 3161,138369
-(defun eliminate-irrelevance-clause 3173,138852
-(defun eliminate-irrelevance-clause-msg1 3203,140170
-
-history-management.lisp,28297
-(defrec goal-tree 37,1262
-(deflabel proof-tree95,4572
-(deflabel proof-tree-examples181,8507
-(defun start-proof-tree-fn 452,18636
-(defmacro start-proof-tree 465,19018
-(defmacro start-proof-tree 494,20059
-(defmacro checkpoint-forced-goals 504,20350
-(defun stop-proof-tree-fn 526,21134
-(defmacro stop-proof-tree 532,21345
-(deflabel proof-tree-details560,22404
-(defun insert-into-goal-tree-rec 605,24607
-(defun insert-into-goal-tree-lst 613,24929
-(defun insert-into-goal-tree 637,25726
-(defun set-difference-equal-changedp 660,26743
-(defun prune-goal-tree 678,27394
-(defun prune-goal-tree-lst 765,31055
-(defun prune-proof-tree 782,31722
-(defun print-string-repeat 796,32340
-(defconst *format-proc-alist*808,32743
-(defun format-forced-subgoals 821,33141
-(defun format-processor 850,34261
-(defun format-goal-tree-lst903,36276
-(defun format-goal-tree 935,37528
-(defun format-proof-tree 985,39680
-(defun print-proof-tree1 1009,40661
-(defconst *proof-failure-string*1022,41221
-(defun print-proof-tree-ctx 1025,41287
-(defconst *proof-tree-start-delimiter* 1050,42144
-(defconst *proof-tree-end-delimiter* 1052,42194
-(defun print-proof-tree-finish 1054,42241
-(defun print-proof-tree 1064,42669
-(defun decorate-forced-goals-1 1089,43517
-(defun decorate-forced-goals-1-lst1106,44227
-(defun decorate-forced-goals 1131,45124
-(defun decorate-forced-goals-in-proof-tree1149,45764
-(defun assumnote-list-to-clause-id-list 1167,46501
-(defun assumnote-list-list-to-clause-id-list-list 1173,46723
-(defun extend-proof-tree-for-forcing-round1179,46994
-(defun initialize-proof-tree1 1213,48216
-(defun initialize-proof-tree 1251,49760
-(defconst *star-1-clause-id*1276,50788
-(defun revert-goal-tree-rec 1285,50945
-(defun revert-goal-tree-lst 1310,52080
-(defun revert-goal-tree 1337,53296
-(defrec pool-element 1358,54210
-(defun pool-lst1 1360,54268
-(defun pool-lst 1367,54522
-(defun increment-proof-tree1388,55371
-(defun goal-tree-with-cl-id 1477,59673
-(defun goal-tree-choose-disjunct-rec 1486,59949
-(defun goal-tree-choose-disjunct-lst 1515,61177
-(defun goal-tree-choose-disjunct 1530,61982
-(defun install-disjunct-into-proof-tree 1541,62419
-(defun logical-namep 1599,65288
-(defun logical-name-type-string 1618,65979
-(defun signature-fns 1717,71018
-(defun make-event-tuple 1732,71630
-(defun access-event-tuple-number 1784,74129
-(defun access-event-tuple-depth 1792,74377
-(defun access-event-tuple-type 1795,74452
-(defun access-event-tuple-namex 1804,74688
-(defun access-event-tuple-form 1827,75490
-(defun access-event-tuple-symbol-class 1832,75580
-(defrec command-tuple1856,76809
-(defun make-command-tuple 1873,77469
-(defun access-command-tuple-number 1891,78183
-(defun access-command-tuple-defun-mode 1894,78259
-(defun access-command-tuple-form 1900,78425
-(defun safe-access-command-tuple-form 1910,78667
-(defun access-command-tuple-last-make-event-expansion 1923,79017
-(defun access-command-tuple-cbd 1926,79131
-(defun max-absolute-event-number 1931,79239
-(defun next-absolute-event-number 1941,79638
-(defun max-absolute-command-number 1944,79721
-(defun next-absolute-command-number 1952,80000
-(defun scan-to-event 1957,80117
-(defun scan-to-command 1968,80405
-(defun scan-to-landmark-number 1978,80667
-(defun add-to-zap-table 2115,88260
-(defun fetch-from-zap-table 2123,88502
-(defconst *event-index-interval* 2142,89183
-(defconst *command-index-interval* 2143,89220
-(defun update-world-index 2145,89260
-(defun lookup-world-index1 2219,92801
-(defun lookup-world-index 2241,93707
-(defun store-absolute-event-number 2270,94959
-(defun the-namex-symbol-class1 2303,96187
-(defun the-namex-symbol-class 2325,97459
-(defun add-event-landmark 2333,97710
-(defun scan-to-defpkg 2363,99108
-(defun scan-to-include-book 2378,99745
-(defun assoc-equal-cadr 2392,100348
-(defun multiple-assoc-terminal-substringp1 2397,100508
-(defun multiple-assoc-terminal-substringp 2403,100817
-(defun possibly-add-lisp-extension 2412,101207
-(defun decode-logical-name 2428,101683
-(defun er-decode-logical-name 2471,103230
-(defun renew-lemmas 2503,104500
-(defun renew-name/erase 2514,104942
-(defun renew-name/overwrite 2540,105980
-(defun renew-name 2693,112019
-(defun renew-names 2736,114109
-(defun collect-redefined 2742,114327
-(defun scrunch-eq 2762,115120
-(defun print-redefinition-warning 2767,115289
-(defun initialize-summary-accumulators 2805,116935
-(defun print-warnings-summary 2842,118485
-(defun print-time-summary 2866,119304
-(defun print-steps-summary 2929,121863
-(defun print-rules-summary 2954,123016
-(defun merge-cdr-> 2984,124239
-(defun merge-sort-cdr-> 2992,124485
-(defconst *gag-prefix* 2997,124650
-(defconst *gag-suffix* 2998,124680
-(defun gag-start-msg 3000,124718
-(defun print-gag-info 3008,124959
-(defun set-checkpoint-summary-limit-fn 3019,125398
-(defmacro set-checkpoint-summary-limit 3038,126049
-(defun print-gag-stack-rev 3102,128436
-(defun maybe-print-nil-goal-generated 3127,129618
-(defun print-gag-state1 3135,129940
-(defun erase-gag-state 3223,133715
-(defun print-gag-state 3233,134168
-(defun clause-id-is-top-level 3241,134399
-(defun clause-id-is-induction-round 3246,134557
-(defun clause-id-is-forcing-round 3251,134714
-(defun print-acl2p-checkpoints1 3259,134912
-(deflock *acl2p-checkpoint-saving-lock*)3303,137031
-(defun erase-acl2p-checkpoints-for-summary 3306,137084
-(defun print-acl2p-checkpoints 3311,137245
-(defun print-failure 3342,138726
-(defstub initialize-event-user 3355,139221
-(defstub finalize-event-user 3357,139278
-(defdoc initialize-event-user3359,139333
-(defdoc finalize-event-user3427,141882
-(defun lmi-seed 3553,146634
-(defun lmi-techs 3571,147329
-(defun lmi-seed-lst 3581,147633
-(defun lmi-techs-lst 3586,147803
-(defun filter-atoms 3591,147972
-(defun print-runes-summary 3601,148257
-(defun use-names-in-ttree 3614,148635
-(defun by-names-in-ttree 3621,148902
-(defrec clause-processor-hint3628,149154
-(defun clause-processor-fns 3632,149225
-(defun cl-proc-names-in-ttree 3639,149524
-(defun print-hint-events-summary 3645,149762
-(defun print-splitter-rules-summary 3668,150840
-(defun print-rules-and-hint-events-summary 3727,153446
-(defun print-summary 3755,154791
-(defun with-prover-step-limit-fn 3898,161066
-(defmacro with-prover-step-limit 3993,164851
-(defmacro with-prover-step-limit 4147,172021
-(defmacro with-prover-step-limit! 4154,172296
-(defrec proved-functional-instances-alist-entry4170,172948
-(defun supply-name-for-proved-functional-instances-alist-entry 4226,175851
-(defun proved-functional-instances-from-tagged-objects 4233,176161
-(defun add-command-landmark 4472,184580
-(defun find-longest-common-retraction1 4508,186340
-(defun find-longest-common-retraction1-event 4514,186562
-(defun find-longest-common-retraction 4520,186786
-(defun install-global-enabled-structure 4541,187635
-(defvar *defattach-fns*)4577,189346
-(defun set-w 4579,189372
-(defun set-w! 4656,192808
-(defmacro save-event-state-globals 4766,198290
-(defun attachment-alist 4784,198872
-(defun attachment-pair 4793,199256
-(defconst *protected-system-state-globals*4799,199480
-(defun state-global-bindings 4854,202997
-(defmacro protect-system-state-globals 4860,203196
-(defun formal-value-triple 4871,203545
-(defun formal-value-triple@par 4882,203841
-(defun@par translate-simple-or-error-triple 4889,203998
-(defun xtrans-eval 4978,208429
-(defun xtrans-eval-with-ev-w 5070,212266
-(defun xtrans-eval@par 5146,215166
-(defmacro xtrans-eval-state-fn-attachment 5149,215305
-(defmacro with-ctx-summarized 5183,216737
-(defmacro revert-world-on-error 5270,221042
-(defun@par chk-theory-expr-value1 5288,221823
-(defun@par chk-theory-expr-value 5316,223178
-(defun theory-fn-translated-callp 5324,223527
-(defun eval-theory-expr 5343,224127
-(defun eval-theory-expr@par 5378,225326
-(defun append-strip-cdrs 5420,226871
-(defun no-rune-based-on 5427,227028
-(defun revappend-delete-runes-based-on-symbols1 5433,227216
-(defun revappend-delete-runes-based-on-symbols 5445,227770
-(defun current-theory1 5466,228709
-(defun first-n-ac-rev 5504,230516
-(defun longest-common-tail-length-rec 5520,231073
-(defun longest-common-tail-length 5534,231640
-(defun extend-current-theory 5543,231988
-(defun update-current-theory 5578,233472
-(defun put-cltl-command 5602,234689
-(defun strip-non-nil-base-symbols 5619,235458
-(defun install-proof-supporters 5627,235722
-(defun install-event 5665,237557
-(deflabel redundant-events5881,249523
-(defun stop-redundant-event 6179,264485
-(defrec command-number-baseline-info6240,267190
-(defun absolute-to-relative-command-number 6244,267270
-(defun relative-to-absolute-command-number 6249,267457
-(defun normalize-absolute-command-number 6254,267644
-(defun tree-occur 6304,269574
-(defun cd-form-matchp 6313,269763
-(defun cd-some-event-matchp 6326,270139
-(defun cd-search 6345,270919
-(defun superior-command-world 6386,272723
-(defun er-decode-cd 6417,274211
-(defrec ldd-status6604,283424
-(defun make-ldd-flags 6608,283562
-(defun make-ldd 6621,284239
-(defun access-ldd-class 6638,284924
-(defun access-ldd-markp 6639,284968
-(defun access-ldd-status 6640,285012
-(defun access-ldd-fullp 6641,285056
-(defun access-ldd-n 6642,285100
-(defun access-ldd-form 6643,285143
-(defun big-d-little-d-name1 6645,285187
-(defun big-d-little-d-name 6659,285811
-(defun big-d-little-d-clique1 6673,286453
-(defun big-d-little-d-clique 6686,287003
-(defun big-d-little-d-event 6697,287462
-(defun big-d-little-d-command-block 6723,288678
-(defun big-m-little-m-name 6766,290688
-(defun big-m-little-m-clique1 6779,291123
-(defun big-m-little-m-clique 6792,291615
-(defun big-m-little-m-event 6802,291983
-(defun big-m-little-m-command-block 6816,292517
-(defun symbol-class-char 6844,293591
-(defun defun-mode-string 6855,293907
-(defun big-c-little-c-event 6863,294161
-(defun big-c-little-c-command-block 6890,295430
-(defun print-ldd-full-or-sketch/mutual-recursion 6928,297230
-(defun print-ldd-full-or-sketch/encapsulate 6937,297538
-(defun normalize-char 6950,298064
-(defun normalize-string1 6956,298220
-(defun normalize-string 6968,298754
-(defun string-matchp 6978,299159
-(defun string-search1 7004,300147
-(defun string-search 7011,300374
-(defun doc-stringp 7028,300965
-(defconst *zapped-doc-string*7045,301465
-(defun zap-doc-string-from-event-form/all-but-last 7048,301534
-(defun zap-doc-string-from-event-form/second-arg 7057,301893
-(defun zap-doc-string-from-event-form/third-arg 7067,302161
-(defun zap-doc-string-from-event-form/mutual-recursion 7078,302485
-(defun zap-doc-string-from-event-form/doc-keyword 7083,302726
-(defun zap-doc-string-from-event-form 7104,303692
-(defun print-ldd-full-or-sketch 7123,304473
-(defmacro with-base-10 7172,306263
-(defun print-ldd-formula-column 7202,307587
-(defun print-ldd 7207,307731
-(defun print-ldds 7264,309963
-(defun make-command-ldd 7295,311518
-(defun make-event-ldd 7314,312351
-(defun make-ldds-command-sequence 7329,312905
-(defun make-ldds-command-block1 7353,314032
-(defun make-ldds-command-block 7424,316448
-(defun pcb-pcb!-fn 7442,317233
-(defun pcb!-fn 7455,317696
-(defun pcb-fn 7458,317751
-(defmacro pcb! 7461,317807
-(defun pc-fn 7481,318438
-(defmacro pc 7493,318847
-(defun pcs-fn 7625,324979
-(defmacro pcs 7680,327553
-(defun get-command-sequence-fn1 7705,328496
-(defun get-command-sequence-fn 7718,328918
-(defmacro get-command-sequence 7743,329994
-(defmacro gcs 7767,330867
-(defmacro pbt 7770,330929
-(defmacro pcb 7794,331822
-(defun print-indented-list-msg 7825,333300
-(defun print-indented-list 7844,333949
-(defun print-book-path 7851,334235
-(defun pe-fn1 7866,334745
-(defun pe-fn2 7896,335792
-(defun pe-fn 7906,336330
-(defmacro pe 7964,338901
-(defmacro pe! 8012,340736
-(defun command-block-names1 8027,341139
-(defun command-block-names 8062,342834
-(defun symbol-name-lst 8071,343207
-(defun acl2-query-simulate-interaction 8076,343352
-(defun acl2-query1 8094,344064
-(defun acl2-query 8147,346180
-(defun collect-names-in-defun-modes 8197,348518
-(defun ubt-ubu-query 8208,348961
-(defmacro ubt 8331,355851
-(defmacro ubt! 8374,357812
-(defmacro ubu 8392,358352
-(defmacro ubu! 8423,359566
-(defmacro u 8442,360141
-(defun chk-virgin 8464,360822
-(deflabel name8476,361082
-(defun chk-boot-strap-redefineable-namep 8523,363309
-(defun maybe-coerce-overwrite-to-erase 8539,364020
-(defun redefinition-renewal-mode 8545,364198
-(defun redefined-names1 8882,380923
-(defun redefined-names 8892,381301
-(defun chk-redefineable-namep 8943,383178
-(defun chk-just-new-name 9002,385732
-(defun no-new-namesp 9054,388090
-(defun chk-just-new-names 9063,388310
-(defconst *return-character* 9089,389528
-(defun read-symbol-from-string1 9091,389574
-(defun read-symbol-from-string2 9106,390138
-(defun read-symbol-from-string 9115,390469
-(defun scan-past-newline 9166,393029
-(defun scan-past-newlines 9173,393245
-(defun scan-past-tilde-slash 9180,393458
-(defun scan-to-doc-string-part1 9192,394023
-(defun scan-to-doc-string-part 9203,394326
-(defun get-one-liner-as-string1 9222,395088
-(defun get-one-liner-as-string 9227,395262
-(defun read-doc-string-citations1 9235,395545
-(defun read-doc-string-citations 9249,396053
-(defun doc-topicp 9265,396822
-(defun ignore-doc-string-error 9268,396914
-(defmacro er-doc 9272,397055
-(defun chk-doc-string-citations 9286,397691
-(defun chk-well-formed-doc-string 9318,399256
-(defun translate-doc 9412,403843
-(defun translate-doc-lst 9434,404762
-(defun get-cites 9441,405040
-(defun alpha-< 9452,405377
-(defun merge-alpha-< 9472,406120
-(defun merge-sort-alpha-< 9479,406345
-(defun update-alpha-<-alist 9484,406520
-(defun put-cited-bys 9496,406970
-(defun update-doc-database 9521,407911
-(defun update-doc-database-lst 9546,408989
-(defun putprop-unless 9554,409258
-(defun redefined-warning 9562,409520
-(defun get-event 9575,409978
-(defun redundant-labelp 9588,410334
-(defun deflabel-fn 9598,410698
-(defun defdoc-fn 9647,412508
-(defmacro defdoc 9697,414307
-(defun access-doc-string-database 9769,417657
-(defun get-doc-string 9802,418806
-(defun get-doc-string-de-indent1 9809,418988
-(defun get-doc-string-de-indent 9813,419129
-(defun use-doc-string-de-indent 9825,419645
-(defun doc-prefix 9836,419965
-(defun princ-prefix 9841,420086
-(defun length-prefix 9847,420328
-(defun save-more-doc-state 9851,420453
-(defun doc-char-subst-table-p 9860,420842
-(defun set-doc-char-subst-table 9873,421137
-(defun doc-char-subst-table 9883,421558
-(defun doc-fmt-alist 9889,421683
-(defconst *terminal-markup-table*9892,421752
-(defun doc-markup-table 10021,428496
-(defun doc-scan-past-tilde-key 10026,428665
-(defun doc-scan-past-tilde-arg10054,429931
-(defun doc-scan-past-tilde10126,432767
-(defun assoc-char-alist-stringp 10164,434524
-(defun apply-char-subst-table1 10174,434837
-(defun apply-char-subst-table 10195,435730
-(defun read-pointer-and-text1 10222,436785
-(defun read-pointer-and-text2 10246,437871
-(defun read-pointer-and-text-raw 10255,438203
-(defun posn-char-stringp 10268,438614
-(defun replace-colons 10278,438838
-(defun read-pointer-and-text 10291,439257
-(defun lookup-fmt-alist 10299,439484
-(defun bar-sep-p 10389,443626
-(defun char-to-string-alistp 10393,443735
-(defun missing-fmt-alist-chars1 10404,444065
-(defun missing-fmt-alist-chars 10425,444950
-(defun complete-fmt-alist 10451,446169
-(defmacro mv-to-state 10478,447399
-(defun print-par-entry 10492,447827
-(defun print-doc-string-part1 10500,448081
-(defun print-doc-string-part-mv10815,464533
-(defun print-doc-string-part10912,469161
-(defun get-doc-section 10921,469502
-(defmacro pstate-global-let* 10929,469797
-(defun print-doc 10943,470225
-(defun print-doc-lst 11036,474233
-(defun degree-of-match2 11053,474912
-(defun degree-of-match1 11061,475211
-(defun degree-of-match 11067,475457
-(defun find-likely-near-misses 11081,475994
-(defun print-doc-dwim 11099,476809
-(defun end-doc 11116,477448
-(defun doc-fn 11130,477912
-(defun more-fn 11186,480475
-(defun doc!-fn 11210,481528
-(defmacro more 11236,482725
-(defmacro more! 11284,484800
-(defun print-doc-outline11309,485651
-(defun print-doc-outline-lst 11339,486776
-(deflabel apropos11353,487505
-(deflabel markup11366,487857
-(deflabel doc-string11649,499322
-(deflabel print-doc-start-column11881,512024
-(defmacro doc 11903,512912
-(defmacro doc! 11965,515804
-(defun more-doc-fn 11983,516222
-(defmacro more-doc 12002,516997
-(defun get-doc-section-symbols 12028,517975
-(defun get-docs-apropos1 12033,518168
-(defun get-docs-apropos 12039,518443
-(defun docs-fn 12042,518548
-(defmacro docs 12097,520714
-(defun print-top-doc-topics 12146,522730
-(defun help-fn 12158,523187
-(deflabel q12216,525750
-(defmacro help 12238,526549
-(deflabel logical-name12253,526792
-(deflabel command12328,530335
-(deflabel command-descriptor12354,531372
-(defun trans-fn 12442,535753
-(defun trans!-fn 12469,536957
-(defmacro trans 12490,537804
-(defmacro trans! 12536,539214
-(defun trans1-fn 12553,539683
-(defmacro trans1 12563,540070
-(defun tilde-*-props-fn-phrase1 12583,540588
-(defun tilde-*-props-fn-phrase 12590,540824
-(defun props-fn 12594,540940
-(defmacro props 12615,541714
-(deflabel enter-boot-strap-mode12630,542011
-(deflabel exit-boot-strap-mode12661,543460
-(defun walkabout-nth 12685,544424
-(defun walkabout-ip 12708,545247
-(defun walkabout-huh 12719,545567
-(defun walkabout1 12724,545720
-(defun walkabout 12823,549895
-(defun walkabout=12938,552938
-(defmacro walkabout=12943,553082
-(defun lookup-bddnote 12948,553213
-(defun update-bddnote-with-term 12955,553410
-(defmacro show-bdd 12968,553888
-(defun show-bdd-goal 13057,557742
-(defun merge-car-term-order 13108,559899
-(defun merge-sort-car-term-order 13115,560160
-(defun falsifying-pair-p 13120,560370
-(defun bogus-falsifying-assignment-var 13129,560667
-(defun show-falsifying-assignment 13140,560919
-(defun show-bdd-term 13216,564553
-(defun tilde-*-substitution-phrase1 13285,567490
-(defun tilde-*-substitution-phrase 13296,568022
-(defun show-bdd-backtrace 13302,568275
-(defun show-bdd-fn 13331,569339
-(defun get-docs 13393,572299
-(defun get-guards2 13406,572737
-(defun get-guards1 13490,576416
-(defun get-guards 13493,576497
-(defun get-guardsp 13538,578492
-(defconst *no-measure*13556,579360
-(defun get-measures1 13559,579393
-(defun get-measures2 13590,580924
-(defun get-measures 13598,581227
-(defconst *no-ruler-extenders*13614,581857
-(defconst *basic-ruler-extenders*13617,581898
-(defun get-ruler-extenders1 13620,581959
-(defun get-ruler-extenders2 13665,584054
-(defmacro default-ruler-extenders-from-table 13674,584483
-(defun default-ruler-extenders 13680,584679
-(defun get-ruler-extenders-lst 13699,585519
-(defun get-hints1 13717,586318
-(defun get-hints 13744,587235
-(defun get-guard-hints1 13754,587547
-(defun get-guard-hints 13782,588526
-(defun get-std-hints1 13793,588887
-(defun get-std-hints 13822,589849
-(defun get-normalizep 13832,590177
-(defun get-normalizeps 13871,591577
-(defconst *unspecified-xarg-value*13882,592074
-(defun get-unambiguous-xargs-flg1/edcls1 13889,592216
-(defun get-unambiguous-xargs-flg1/edcls 13922,593934
-(defun get-unambiguous-xargs-flg1 13933,594322
-(defun get-unambiguous-xargs-flg 13951,595263
-(defun get-unambiguous-xargs-flg-lst 13980,596795
-(defun chk-xargs-keywords1 14001,597820
-(defun chk-xargs-keywords 14018,598666
-(defun get-names 14039,599492
-(defun get-bodies 14044,599612
-(defun find-nontrivial-rulers 14051,599760
-(defun find-nontrivial-rulers-lst 14076,600802
-(defun tilde-@-free-vars-phrase 14085,601135
-(defun chk-free-vars 14112,602471
-(defun chk-declared-ignores 14131,603311
-(defun chk-free-and-ignored-vars 14143,603828
-(defun chk-free-and-ignored-vars-lsts 14200,606808
-(defun putprop-x-lst1 14237,608997
-(defun putprop-x-lst2 14247,609305
-(defun putprop-x-lst2-unless 14258,609651
-(defun@par translate-term-lst 14274,610358
-(defun find-named-lemma 14370,615015
-(defun find-runed-lemma 14387,615677
-(defun free-varsp-member 14400,616026
-(defun free-varsp-member-lst 14408,616276
-(defun@par translate-expand-term1 14415,616457
-(defun@par translate-expand-term 14540,622251
-(defun@par translate-expand-hint1 14568,623390
-(defun@par translate-expand-hint 14581,623945
-(defun cons-all-to-lst 14635,626080
-(defun@par translate-substitution 14640,626262
-(defun@par translate-substitution-lst 14689,628575
-(defun get-rewrite-and-defn-runes-from-runic-mapping-pairs 14699,628927
-(defun@par translate-restrict-hint 14708,629269
-(defconst *do-not-processes*14757,631359
-(defun coerce-to-process-name-lst 14761,631495
-(defun coerce-to-acl2-package-lst 14768,631734
-(defun@par chk-do-not-expr-value 14775,631947
-(defun@par translate-do-not-hint 14803,633232
-(defun@par translate-do-not-induct-hint 14844,634803
-(defun@par translate-hands-off-hint1 14870,636124
-(defun@par translate-hands-off-hint 14910,637662
-(defun truncated-class 14932,638430
-(defun tests-and-alists-lst-from-fn 14946,639125
-(defun corollary 14967,640144
-(defun formula 15048,643624
-(defun pf-fn 15069,644531
-(defmacro pf 15104,645969
-(defun merge-symbol-< 15125,646610
-(defun merge-sort-symbol-< 15132,646883
-(defconst *non-instantiable-primitives*15140,647146
-(defun instantiablep 15180,648795
-(defun all-ffn-symbs 15218,650471
-(defun all-ffn-symbs-lst 15228,650866
-(defconst *unknown-constraints*15235,651034
-(defun constraint-info 15243,651257
-(defdoc constraint15310,654231
-(defun@par chk-equal-arities 15761,674367
-(defun extend-sorted-symbol-alist 15781,674977
-(defun@par chk-equiv-classicalp 15795,675344
-(defun@par translate-functional-substitution 15814,676149
-(defun sublis-fn-rec 15936,681870
-(defun sublis-fn-rec-lst 16054,688073
-(defun sublis-fn 16069,688639
-(defun sublis-fn-simple 16076,688853
-(defun sublis-fn-lst-simple 16086,689176
-(defun instantiable-ffn-symbs 16097,689457
-(defun instantiable-ffn-symbs-lst 16124,690459
-(defun unknown-constraint-supporters 16135,690853
-(defun collect-instantiablep1 16155,691756
-(defun all-instantiablep 16166,692133
-(defun collect-instantiablep 16172,692296
-(defun immediate-instantiable-ancestors 16181,692558
-(defun instantiable-ancestors 16226,694819
-(defun hitp 16245,695481
-(defun hitp-lst 16258,695923
-(defun event-responsible-for-proved-constraint 16265,696072
-(defun getprop-x-lst 16310,698328
-(defun filter-hitps 16316,698561
-(defun relevant-constraints1 16323,698754
-(defun relevant-constraints1-axioms 16489,706915
-(defun relevant-constraints 16539,709424
-(defun bound-vars 16590,711677
-(defun bound-vars-lst 16601,712081
-(defun@par translate-lmi/instance 16609,712242
-(defun@par translate-lmi/functional-instance 16650,714333
-(defun@par translate-lmi 16747,719322
-(deflabel functional-instantiation-in-acl2r16854,723916
-(deflabel lemma-instance16877,724970
-(defun@par translate-use-hint1 16986,731048
-(defun@par translate-use-hint 17009,732187
-(defun convert-name-tree-to-new-name1 17121,737669
-(defun convert-name-tree-to-new-name 17148,739017
-(defun@par translate-by-hint 17170,740074
-(defun@par translate-cases-hint 17238,743159
-(defun@par translate-case-split-limitations-hint 17253,743647
-(defun@par translate-no-op-hint 17277,744595
-(defun character-alistp 17283,744743
-(defun tilde-@p 17298,745205
-(defun@par translate-error-hint 17305,745374
-(defun@par translate-induct-hint 17314,745667
-(defconst *built-in-executable-counterparts*17326,746144
-(defconst *s-prop-theory*17346,746810
-(defconst *definition-minimal-theory*17359,747308
-(defdoc theories-and-primitives17362,747407
-(defun translate-in-theory-hint17470,751199
-(defun translate-in-theory-hint@par17537,754263
-(defun all-function-symbolps 17616,758086
-(defun non-function-symbols 17622,758309
-(defun collect-non-logic-mode 17629,758551
-(defun@par translate-bdd-hint1 17637,758862
-(defun@par translate-bdd-hint 17723,762893
-(defun@par translate-nonlinearp-hint 17741,763527
-(defun@par translate-backchain-limit-rw-hint 17753,763868
-(defun@par translate-no-thanks-hint 17763,764193
-(defun@par translate-reorder-hint 17769,764343
-(defun arity-mismatch-msg 17781,764708
-(defun@par translate-clause-processor-hint 17812,766010
-(defun@par translate-custom-keyword-hint 17933,771865
-(defun custom-keyword-hint 17989,774529
-(defun remove-all-no-ops 18000,774863
-(defun remove-redundant-no-ops 18008,775168
-(defun find-first-custom-keyword-hint 18027,775765
-(defconst *custom-keyword-max-iterations*18047,776530
-(defun@par custom-keyword-hint-interpreter118050,776580
-(defun@par custom-keyword-hint-interpreter18224,784113
-(defun custom-keyword-hint-in-computed-hint-form 18255,785559
-(defun@par put-cl-id-of-custom-keyword-hint-in-computed-hint-form18294,787420
-(defun make-disjunctive-clause-id 18322,788594
-(defun make-disjunctive-goal-spec 18330,788885
-(defun minimally-well-formed-or-hintp 18335,789071
-(defun split-keyword-alist 18343,789341
-(defun distribute-other-hints-into-or1 18354,789779
-(defun distribute-other-hints-into-or 18359,789970
-(defconst *hint-expression-basic-vars*18380,790718
-(defconst *hint-expression-override-vars*18383,790829
-(defconst *hint-expression-backtrack-vars*18386,790926
-(defconst *hint-expression-all-vars*18391,791111
-(defun@par translate-hint-expression 18396,791317
-(defun@par translate-backtrack-hint 18583,798706
-(defun@par translate-rw-cache-state-hint 18586,798849
-(defun@par translate-or-hint 18597,799191
-(defun@par translate-hint-settings 18649,801457
-(defun@par translate-x-hint-value 18683,802794
-(defun replace-goal-spec-in-name-tree1 18757,805419
-(defun replace-goal-spec-in-name-tree 18777,806160
-(defun@par translate-hint 18799,807157
-(defun@par translate-hint-expressions 19138,824228
-(defun@par check-translated-override-hint 19158,825098
-(defun@par translate-hints1 19169,825546
-(defun@par warn-on-duplicate-hint-goal-specs 19256,830557
-(defun@par translate-hints2 19277,831759
-(defun override-hints 19289,832408
-(defun@par translate-hints 19433,840130
-(defun@par translate-hints+1 19437,840294
-(defun translate-hints+ 19448,840668
-(defun translate-override-hints 19457,841052
-(defun@par apply-override-hint119472,841663
-(defun@par apply-override-hint19585,846223
-(defun@par apply-override-hints19608,847453
-(defun@par eval-and-translate-hint-expression19631,848236
-(deflabel goal-spec19881,860167
-(deflabel hints-and-the-waterfall19988,864494
-(deflabel hints20191,876406
-(deflabel clause-identifier20933,912292
-(deflabel computed-hints20986,914342
-(deflabel using-computed-hints-121139,922643
-(deflabel using-computed-hints-221190,923864
-(deflabel using-computed-hints-321295,928102
-(deflabel using-computed-hints-421415,933077
-(deflabel using-computed-hints-521560,939191
-(deflabel using-computed-hints-621624,941552
-(deflabel using-computed-hints-721880,951731
-(deflabel using-computed-hints-822111,960962
-(deflabel using-computed-hints22153,962858
-(defmacro ttags-seen 22259,967421
-(defrec certify-book-info22317,969953
-(defun active-book-name 22321,970048
-(defrec deferred-ttag-note22332,970530
-(defun fms-to-standard-co 22336,970604
-(defun print-ttag-note 22343,970839
-(defun show-ttag-notes1 22398,973492
-(defun show-ttag-notes-fn 22410,973993
-(defmacro show-ttag-notes 22427,974792
-(defun set-deferred-ttag-notes 22431,974892
-(defun ttags-from-deferred-ttag-notes1 22518,978546
-(defun ttags-from-deferred-ttag-notes 22528,978923
-(defun print-deferred-ttag-notes-summary 22531,979023
-(defun notify-on-defttag 22548,979797
-(defun ttag-allowed-p 22585,981324
-(defun chk-acceptable-ttag1 22609,982312
-(defun chk-acceptable-ttag 22675,985631
-(defun chk-acceptable-ttags2 22690,986115
-(defun chk-acceptable-ttags1 22706,987056
-(defun chk-acceptable-ttags 22735,988748
-(defun chk-table-nil-args 22751,989493
-(defun chk-table-guard 22763,989898
-(defun chk-table-guards-rec 22805,991698
-(defun chk-table-guards 22819,992390
-(defun put-assoc-equal-fast 22832,993014
-(defun global-set? 22844,993435
-(defun cltl-def-from-name2 22849,993547
-(defrec absstobj-info22872,994468
-(defun cltl-def-from-name1 22876,994524
-(defun cltl-def-from-name 22901,995638
-(defun table-cltl-cmd 22913,996100
-(defun table-fn1 23000,1000548
-(defun table-fn 23189,1009578
-(defun set-override-hints-fn 23291,1013995
-
-prove.lisp,10740
-(defun abbreviationp1 37,1383
-(defun abbreviationp1-lst 55,2103
-(defun abbreviationp 63,2362
-(defun all-vars-bag 76,2858
-(defun all-vars-bag-lst 81,3012
-(defun find-abbreviation-lemma 87,3175
-(defun expand-abbreviations-with-lemma 122,4780
-(defun expand-abbreviations 150,5859
-(defun expand-abbreviations-lst 453,20221
-(defun and-orp 473,21210
-(defun find-and-or-lemma 484,21540
-(defun expand-and-or 516,23118
-(defun clausify-input1 601,26844
-(defun clausify-input1-lst 674,30392
-(defun clausify-input 694,31378
-(defun expand-some-non-rec-fns-in-clauses 720,32749
-(defun no-op-histp 739,33542
-(defun expand-any-final-implies1 775,35128
-(defun expand-any-final-implies1-lst 807,36375
-(defun expand-any-final-implies 816,36617
-(defun rw-cache-state 839,37471
-(defmacro make-rcnst 844,37641
-(defun cheap-type-alist-and-pot-lst 875,39023
-(defconst *tau-ttree*911,40835
-(defun tau-clausep 916,40966
-(defun tau-clausep-lst-rec 946,41994
-(defun tau-clausep-lst 973,42990
-(defun preprocess-clause 985,43401
-(defun tilde-*-preprocess-phrase 1186,54018
-(defun tilde-*-raw-preprocess-phrase 1212,54921
-(defun preprocess-clause-msg1 1237,55747
-(defun more-than-simplifiedp 1295,58274
-(defun delete-assoc-eq-lst 1315,59135
-(defun delete-assumptions-1 1323,59406
-(defun delete-assumptions 1347,60511
-(defun save-and-print-acl2p-checkpoint 1367,61215
-(defun find-the-first-checkpoint 1431,64304
-(defun acl2p-push-clause-printing 1457,65375
-(defun@par push-clause 1498,67094
-(defun push-clause-msg1-abort 1848,82575
-(defun push-clause-msg1 1888,84245
-(deflabel otf-flg1912,85169
-(defun clause-set-subsumes-1 1956,87012
-(defun clause-set-subsumes 1970,87755
-(defun apply-use-hint-clauses 1983,88224
-(defun apply-cases-hint-clause 2096,93373
-(defun term-list-listp 2132,94644
-(defun non-term-listp-msg 2139,94810
-(defun non-term-list-listp-msg 2156,95256
-(defun eval-clause-processor 2174,95729
-(defun eval-clause-processor@par 2235,98343
-(defun apply-top-hints-clause1 2310,101617
-(defun@par apply-top-hints-clause 2590,114249
-(defun tilde-@-lmi-phrase 2683,118997
-(defun or-hit-msg 2760,122391
-(defun apply-top-hints-clause-msg12783,123571
-(defun previous-process-was-speciousp 2990,133626
-(defconst *preprocess-clause-ledge*3088,138636
-(defmacro initialize-pspv-for-gag-mode 3119,139882
-(defun waterfall-update-gag-state 3194,143096
-(defun waterfall-update-gag-state@par 3374,152263
-(defun@par record-gag-state 3383,152597
-(defun@par gag-state-exiting-cl-id 3389,152784
-(defun remove-pool-lst-from-gag-state 3464,156744
-(defun pop-clause-update-gag-state-pop 3518,159159
-(defun gag-mode-jppl-flg 3539,159836
-(defmacro splitter-output 3560,160672
-(defdoc splitter3576,161362
-(defmacro set-splitter-output 3732,168692
-(defun waterfall-msg13766,170325
-(defmacro io?-prove-cw 3827,172538
-(defmacro io?-prove@par 3839,172819
-(defun waterfall-print-clause-body 3846,172978
-(defmacro waterfall-print-clause-id-fmt1-call 3860,173446
-(defmacro waterfall-print-clause-id-fmt1-call@par 3873,173822
-(defmacro waterfall-print-clause-id 3886,174220
-(defmacro waterfall-print-clause-id@par 3893,174418
-(defproxy print-clause-id-okp 3934,176469
-(defun print-clause-id-okp-builtin 3936,176510
-(defattach (print-clause-id-okp 3941,176632
-(defun@par waterfall-print-clause 3944,176712
-(defun some-parent-is-checkpointp 3965,177591
-(defun@par waterfall-msg3973,177870
-(defun put-ttree-into-pspv 4061,181890
-(defun set-cl-ids-of-assumptions1 4066,182080
-(defun set-cl-ids-of-assumptions 4076,182549
-(defun collect-assumptions1 4095,183436
-(defun collect-assumptions 4113,184157
-(defun sublis-var-lst-lst 4137,185296
-(defun add-segments-to-clause 4142,185484
-(defun split-initial-extra-info-lits 4148,185719
-(defun conjoin-clause-to-clause-set-extra-info1 4155,185992
-(defun conjoin-clause-to-clause-set-extra-info 4201,188101
-(defun conjoin-clause-sets-extra-info 4221,189172
-(defun maybe-add-extra-info-lit 4238,189975
-(defun conjoin-clause-sets+ 4247,190332
-(defconst *equality-aliases*4251,190512
-(defun term-equated-to-constant 4258,190716
-(defun simplify-clause-for-term-equal-const-1 4269,191044
-(defun simplify-clause-for-term-equal-const 4289,191954
-(defun add-literal-smart 4298,192209
-(defun guard-clauses 4317,192860
-(defun guard-clauses-lst 4567,204254
-(defun linked-variables1 4582,204757
-(defun linked-variables 4599,205477
-(defun contains-constrained-constantp 4660,208847
-(defun contains-constrained-constantp-lst 4674,209491
-(defun disvar-type-alist1 4682,209772
-(defun collect-all-vars 4690,210146
-(defun disvar-type-alist 4694,210273
-(defun unencumber-type-alist 4714,211137
-(defun unencumber-assumption 4757,213143
-(defun unencumber-assumptions 4827,215371
-(defun dumb-type-alist-implicationp1 4864,216958
-(defun dumb-type-alist-implicationp2 4876,217589
-(defun dumb-type-alist-implicationp 4882,217869
-(defun partition-according-to-assumption-term 4946,221247
-(defun exists-assumption-with-weaker-type-alist 4968,222138
-(defun add-assumption-with-weak-type-alist 4986,222925
-(defun dumb-keep-assumptions-with-weakest-type-alists 5011,224050
-(defun dumb-assumption-subsumption1 5046,225566
-(defun dumb-assumption-subsumption 5062,226092
-(defun clausify-type-alist 5079,226898
-(defun clausify-assumption 5106,228137
-(defun clausify-assumptions 5121,228538
-(defun strip-assumption-terms 5139,229259
-(defun add-splitters-to-ttree1 5147,229518
-(defun add-splitters-to-ttree 5156,229832
-(defun maybe-add-splitters-to-ttree 5170,230312
-(defun extract-and-clausify-assumptions 5176,230566
-(defun@par waterfall-step1 5301,237060
-(defun@par process-backtrack-hint 5336,238195
-(defun set-rw-cache-state-in-pspv 5377,240109
-(defun maybe-set-rw-cache-state-disabled 5385,240421
-(defun maybe-set-rw-cache-state-enabled 5393,240703
-(defun accumulate-rw-cache-into-pspv 5401,240984
-(defun erase-rw-cache-from-pspv 5431,242460
-(defconst *simplify-clause-ledge*5452,243354
-(defconst *simplify-clause-ledge-complement*5455,243447
-(defun@par waterfall-step-cleanup 5459,243587
-(defun@par waterfall-step 5619,250549
-(defun@par find-applicable-hint-settings15791,259193
-(defun@par find-applicable-hint-settings 5974,268448
-(defun@par thanks-for-the-hint 5988,269137
-(defun lmi-name-or-rune 6056,272161
-(defun enabled-lmi-names1 6069,272561
-(defun enabled-lmi-names 6084,273103
-(defdoc using-enabled-rules6105,273811
-(defun@par maybe-warn-for-use-hint 6180,276827
-(defun@par maybe-warn-about-theory-simple 6203,277676
-(defun@par maybe-warn-about-theory-from-rcnsts 6214,278189
-(defun waterfall-or-hit-msg-a 6260,280279
-(defun waterfall-or-hit-msg-b 6296,281611
-(defun tilde-*-or-hit-summary-phrase1 6316,282497
-(defun tilde-*-or-hit-summary-phrase 6329,282970
-(defun waterfall-or-hit-msg-c 6342,283403
-(defun term-difficulty1 6411,286527
-(defun term-difficulty1-lst 6425,287130
-(defun term-difficulty 6431,287318
-(defun clause-difficulty 6439,287663
-(defun clause-set-difficulty 6444,287781
-(defun pool-difficulty 6453,288141
-(defun how-many-to-be-proved 6464,288544
-(defun pick-best-pspv-for-waterfall0-or-hit16476,288938
-(defun pick-best-pspv-for-waterfall0-or-hit 6529,291542
-(defun change-or-hit-history-entry 6563,292954
-(defun@par pair-cl-id-with-hint-setting 6615,295070
-(defun apply-reorder-hint-front 6648,296753
-(defun apply-reorder-hint-back 6655,296997
-(defun filter-> 6662,297354
-(defun@par apply-reorder-hint 6669,297539
-(defun pspv-equal-except-for-tag-tree-and-pool 6700,298891
-(defun list-extensionp-aux 6732,300368
-(defun list-extensionp 6743,300696
-(defun find-list-extensions 6752,300919
-(defun combine-pspv-pools 6759,301138
-(defun combine-pspv-tag-trees 6770,301449
-(defun print-pspvs 6779,301750
-(defun combine-prove-spec-vars 6788,301941
-(defun speculative-execution-valid 6844,303915
-(defun abort-will-occur-in-pool 6859,304455
-(defrec maybe-to-be-proved-by-induction6901,306617
-(defun convert-maybes-to-tobe-subgoals 6911,306894
-(defun convert-maybes-to-tobes 6926,307503
-(defun convert-maybes-to-tobes-in-pspv 6994,310499
-(defun erase-rw-cache-any-tag-from-pspv 7003,310844
-(defun restore-rw-cache-state-in-pspv 7014,311210
-(defvar *waterfall-parallelism-timings-ht-alist* 7028,311964
-(defvar *waterfall-parallelism-timings-ht* 7034,312258
-(defun setup-waterfall-parallelism-ht-for-name 7042,312644
-(defun clear-current-waterfall-parallelism-ht 7066,313808
-(defun flush-waterfall-parallelism-hashtables 7072,313941
-(defun save-waterfall-timings-for-cl-id 7080,314169
-(defun lookup-waterfall-timings-for-cl-id 7087,314389
-(defmacro waterfall1-wrapper 7095,314671
-(defparameter *acl2p-starting-proof-time* 7106,315126
-(defun waterfall1-wrapper@par-before 7109,315187
-(defun waterfall1-wrapper@par-after 7146,316727
-(defmacro waterfall1-wrapper@par 7171,317721
-(defun increment-waterfall-parallelism-counter 7184,318174
-(defun halves-with-length 7209,318945
-(defun@par waterfall17224,319460
-(defun@par waterfall0-with-hint-settings7305,323045
-(defun@par waterfall0 7348,324866
-(defun@par waterfall0-or-hit 7653,337532
-(defun waterfall1-lst 7866,347131
-(defun waterfall1-lst@par-serial 7941,349998
-(defun waterfall1-tree@par-pseudo-parallel 8005,352736
-(defun waterfall1-tree@par-parallel 8170,360732
-(defun waterfall1-lst@par 8385,371483
-(defun waterfall 8524,377337
-(defun some-pool-member-subsumes 8624,382186
-(defun add-to-pop-history8640,382891
-(defun pop-clause1 8686,385035
-(defun make-defthm-forms-for-byes 8762,388521
-(defun pop-clause-msg1 8773,388923
-(defun pop-clause-msg 8939,397008
-(defun subsumed-clause-ids-from-pop-history 8964,397895
-(defun increment-proof-tree-pop-clause 8978,398473
-(defun pop-clause 8991,399056
-(defun tilde-@-assumnotes-phrase-lst 9027,400689
-(defun tilde-*-assumnotes-column-phrase 9079,403519
-(defun tilde-@-assumnotes-phrase-lst-gag-mode 9086,403736
-(defun tilde-*-assumnotes-column-phrase-gag-mode 9126,405615
-(defun process-assumptions-msg1 9133,405844
-(defun process-assumptions-msg 9170,407325
-(deflabel forcing-round9217,409557
-(deflabel failure9352,416908
-(deflabel failed-forcing9398,419551
-(defun count-assumptions 9545,426574
-(defun add-type-alist-runes-to-ttree1 9552,426760
-(defun add-type-alist-runes-to-ttree 9560,427032
-(defun process-assumptions-ttree 9569,427453
-(defun process-assumptions 9581,427872
-(defun do-not-induct-msg 9661,431226
-(defun prove-loop2 9688,432158
-(defun prove-loop1 9795,436943
-(defun print-pstack-and-gag-state 9806,437349
-(defun prove-loop0 9837,438680
-(defmacro bind-acl2-time-limit 9862,439736
-(defun prove-loop 9885,440741
-(defmacro make-pspv 9917,442104
-(defun chk-assumption-free-ttree 9941,443113
-(defun prove 9993,445551
-
-defuns.lisp,11502
-(defconst *mutual-recursion-ctx-string*31,1307
-(defun translate-bodies1 34,1394
-(defun chk-non-executable-bodies 112,4978
-(defun translate-bodies 148,6709
-(defun chk-mutual-recursion-bad-names 179,8164
-(defconst *chk-mutual-recursion-string*187,8476
-(defun chk-mutual-recursion1 196,8863
-(defun chk-mutual-recursion 216,9530
-(defun ffnnamep-mod-mbe 245,10735
-(defun ffnnamep-mod-mbe-lst 264,11537
-(defun putprop-recursivep-lst 279,11955
-(defrec tests-and-call 307,13291
-(defun all-calls 316,13658
-(defun all-calls-lst 345,14963
-(defun all-calls-alist 354,15203
-(defun termination-machine1 363,15528
-(defun ffnnamesp-eq 383,16304
-(defun ffnnamesp-eq-lst 393,16685
-(defun member-eq-all 401,16823
-(defun termination-machine 407,16918
-(defun termination-machine-for-list 514,21848
-(defun termination-machines 522,22236
-(defun proper-dumb-occur-as-output 537,22839
-(defun always-tested-and-changedp 562,23997
-(defun guess-measure 588,25059
-(defun guess-measure-alist 644,28120
-(defun remove-built-in-clauses 679,29922
-(defun length-exceedsp 714,31407
-(defun clean-up-clause-set 719,31533
-(defun measure-clause-for-branch 801,35292
-(defun measure-clauses-for-fn1 832,36427
-(defun measure-clauses-for-fn 846,37045
-(defun measure-clauses-for-clique 877,38160
-(defun tilde-*-measure-phrase1 894,38868
-(defun tilde-*-measure-phrase 902,39209
-(defun find-?-measure 930,40209
-(defun prove-termination 939,40512
-(defun putprop-justification-lst 1140,50681
-(defun union-equal-to-end 1168,51805
-(defun cross-tests-and-calls3 1177,52062
-(defun cross-tests-and-calls2 1193,52931
-(defun cross-tests-and-calls1 1201,53190
-(defun sublis-tests-rev 1210,53505
-(defun all-calls-test-alist 1228,54252
-(defun cross-tests-and-calls 1240,54658
-(defun induction-machine-for-fn1 1307,58160
-(defun induction-machine-for-fn1-lst 1667,76386
-(defun term-equated-to-constant-in-termlist 1691,77460
-(defun simplify-tests 1700,77761
-(defun simplify-tests-and-calls 1721,78696
-(defun simplify-tests-and-calls-lst 1745,79651
-(defun induction-machine-for-fn 1767,80368
-(defun induction-machines 1789,81289
-(defun putprop-induction-machine-lst 1809,82178
-(defun quick-block-initial-settings 1823,82732
-(defun quick-block-info1 1828,82907
-(defun quick-block-info2 1833,83056
-(defun quick-block-settings 1841,83282
-(defun quick-block-down-t-machine 1850,83715
-(defun quick-block-info 1866,84344
-(defun putprop-quick-block-info-lst 1884,85111
-(deflabel subversive-recursions1900,85741
-(deflabel subversive-inductions2054,93730
-(defmacro big-mutrec 2064,93898
-(defmacro update-w 2074,94303
-(defun get-sig-fns1 2098,95151
-(defun get-sig-fns 2109,95574
-(defun selected-all-fnnames-lst 2112,95657
-(defun subversivep 2120,95957
-(defun subversive-cliquep 2153,97299
-(defun prove-termination-non-recursive 2188,99102
-(defun prove-termination-recursive 2233,100922
-(defun put-induction-info-recursive 2276,102577
-(defun put-induction-info 2328,104652
-(defun destructure-definition 2411,108643
-(defun member-rewrite-rule-rune 2468,110654
-(defun replace-rewrite-rule-rune 2477,110947
-(defun preprocess-hyp 2489,111365
-(defun preprocess-hyps 2508,112180
-(defun add-definition-rule-with-ttree 2513,112336
-(defun add-definition-rule 2594,116022
-(defun listof-standardp-macro 2603,116396
-(defun putprop-body-lst 2618,116806
-(defun type-set-implied-by-term1 2907,132454
-(defun type-set-implied-by-term 2932,133474
-(defun putprop-initial-type-prescriptions 2952,134369
-(defun map-returned-formals-via-formals 3001,136559
-(defun map-type-sets-via-formals 3032,138197
-(defun vector-ts-union 3048,138906
-(defun map-cons-tag-trees 3057,139218
-(defun type-set-and-returned-formals-with-rule13066,139437
-(defun type-set-and-returned-formals-with-rule 3122,141717
-(defun type-set-and-returned-formals-with-rules3203,144933
-(defun type-set-and-returned-formals 3274,147897
-(defun type-set-and-returned-formals-lst3562,161931
-(defun guess-type-prescription-for-fn-step 3580,162698
-(defconst *clique-step-install-interval*3625,164760
-(defun guess-and-putprop-type-prescription-lst-for-clique-step3633,165039
-(defun cleanse-type-prescriptions3697,167679
-(defun guess-and-putprop-type-prescription-lst-for-clique3765,170925
-(defun get-normalized-bodies 3816,173301
-(defun putprop-type-prescription-lst 3832,173921
-(defun putprop-level-no-lst 3977,179451
-(defun primitive-recursive-argp 4003,180791
-(defun primitive-recursive-callp 4067,184392
-(defun primitive-recursive-callsp 4072,184624
-(defun primitive-recursive-machinep 4077,184856
-(defun putprop-primitive-recursive-defunp-lst 4094,185612
-(defun make-controller-pocket 4128,187157
-(defun make-controller-alist1 4141,187630
-(defun make-controller-alist 4165,188779
-(defun max-nume-exceeded-error 4182,189635
-(defun putprop-defun-runic-mapping-pairs1 4191,190055
-(defun putprop-defun-runic-mapping-pairs 4228,191820
-(defun eval-ground-subexpressions-lst-lst 4310,196034
-(defun guard-clauses+ 4325,196617
-(defun guard-clauses-for-body 4334,197065
-(defun guard-clauses-for-fn 4358,198081
-(defun guard-clauses-for-clique 4428,201030
-(defun print-verify-guards-msg 4449,201891
-(defun collect-ideals 4475,202795
-(defun collect-non-ideals 4481,203034
-(defun collect-non-common-lisp-compliants 4487,203273
-(defun all-fnnames1-exec 4494,203593
-(defmacro all-fnnames-exec 4522,204785
-(defun chk-common-lisp-compliant-subfunctions4525,204858
-(defun chk-acceptable-verify-guards-formula 4554,206300
-(defun chk-acceptable-verify-guards 4601,208443
-(defun guard-obligation-clauses 4687,212141
-(defun guard-obligation 4760,215204
-(defun prove-guard-clauses-msg 4840,218771
-(defmacro verify-guards-formula 4877,220360
-(defun prove-guard-clauses 4925,222524
-(defun verify-guards-fn1 5013,226510
-(defun verify-guards-fn 5249,236636
-(defconst *super-defun-wart-table*5340,240289
-(defun project-out-columns-i-and-j 5389,242971
-(defconst *super-defun-wart-binding-alist*5395,243170
-(defconst *super-defun-wart-stobjs-in-alist*5398,243276
-(defun super-defun-wart-bindings 5401,243384
-(defun store-stobjs-ins 5408,243672
-(defun store-super-defun-warts-stobjs-in 5414,243924
-(defun collect-old-nameps 5428,244408
-(defun defuns-fn-short-cut 5434,244632
-(defun print-defun-msg/collect-type-prescriptions 5471,246434
-(defun print-defun-msg/type-prescriptions1 5495,247428
-(defun print-defun-msg/type-prescriptions 5537,249307
-(defun simple-signaturep 5580,250824
-(defun all-simple-signaturesp 5593,251304
-(defun print-defun-msg/signatures1 5598,251488
-(defun print-defun-msg/signatures 5622,252383
-(defun print-defun-msg 5635,252844
-(defun get-ignores 5663,253998
-(defun get-ignorables 5669,254162
-(defun chk-all-stobj-names 5675,254335
-(defun get-declared-stobj-names 5691,255036
-(defun get-stobjs-in-lst 5732,256888
-(defun chk-stobjs-out-bound 5784,259501
-(defun store-stobjs-out 5792,259836
-(defun unparse-signature 5801,260129
-(defun chk-defun-mode 5813,260556
-(defun scan-to-cltl-command 5827,261040
-(defconst *xargs-keywords*5841,261526
-(defun plausible-dclsp1 5851,261850
-(defun plausible-dclsp 5870,262671
-(defun dcl-fields1 5899,264032
-(defun dcl-fields 5906,264319
-(defun strip-keyword-list 5920,264837
-(defun strip-dcls1 5934,265340
-(defun strip-dcls 5947,265954
-(defun fetch-dcl-fields2 5965,266789
-(defun fetch-dcl-fields1 5975,267202
-(defun fetch-dcl-fields 5986,267745
-(defun fetch-dcl-field 5997,268251
-(defun set-equalp-eq 6015,269137
-(defun non-identical-defp-chk-measures 6023,269441
-(defun non-identical-defp 6077,271911
-(defun identical-defp 6260,281283
-(defun redundant-or-reclassifying-defunp0 6267,281524
-(defun redundant-or-reclassifying-defunp 6504,291700
-(defun redundant-or-reclassifying-defunsp10 6527,293081
-(defun redundant-or-reclassifying-defunsp1 6547,293961
-(defun recover-defs-lst 6552,294250
-(defun get-clique 6617,297517
-(defun redundant-or-reclassifying-defunsp0 6631,298113
-(defun get-unnormalized-bodies 6679,300930
-(defun strip-last-elements 6685,301179
-(defun redundant-or-reclassifying-defunsp 6691,301380
-(defun collect-when-cadr-eq 6842,309519
-(defun all-programp 6848,309733
-(defun formal-position 6925,313564
-(defun make-posns 6930,313723
-(defun relevant-posns-term 6937,313911
-(defun relevant-posns-term-lst 6958,314801
-(defun relevant-posns-call 6965,315073
-(defun relevant-posns-clique1 6995,316464
-(defun relevant-posns-clique-recur 7023,317690
-(defun relevant-posns-clique-init 7030,318078
-(defun relevant-posns-lambdas 7077,319869
-(defun relevant-posns-lambdas-lst 7089,320273
-(defun relevant-posns-merge 7096,320481
-(defun relevant-posns-lambdas-top 7108,321013
-(defun relevant-posns-clique 7112,321175
-(defun irrelevant-non-lambda-slots-clique2 7129,322125
-(defun irrelevant-non-lambda-slots-clique1 7137,322446
-(defun irrelevant-non-lambda-slots-clique 7149,322998
-(defun tilde-*-irrelevant-formals-msg1 7167,324016
-(defun tilde-*-irrelevant-formals-msg 7175,324382
-(defun chk-irrelevant-formals 7178,324514
-(deflabel irrelevant-formals7209,325859
-(defun chk-logic-subfunctions 7282,329270
-(defun get-non-classical-fns-from-list 7309,330527
-(defmacro get-non-classical-fns 7321,331048
-(defun get-non-classical-fns-aux 7325,331164
-(defun strip-missing-measures 7340,331779
-(defun chk-classical-measures 7348,332036
-(defun chk-no-recursive-non-classical 7368,332918
-(defun union-collect-non-x 7405,334697
-(defun translate-measures 7410,334872
-(defun redundant-predefined-error-msg 7442,336381
-(defun chk-acceptable-defuns-redundancy 7456,337055
-(defun chk-acceptable-defuns-verify-guards-er 7543,340687
-(defun chk-non-executablep 7604,343440
-(defun chk-acceptable-defuns0 7626,344330
-(defun get-boolean-unambiguous-xargs-flg-lst 7682,346821
-(defun chk-acceptable-defuns1 7690,347232
-(defun conditionally-memoized-fns 7988,360865
-(defun chk-acceptable-defuns 8006,361638
-(deflabel XARGS8131,367709
-(defmacro link-doc-to-keyword 8279,374766
-(defmacro link-doc-to 8295,375091
-(defun build-valid-std-usage-clause 8456,381772
-(defun verify-valid-std-usage 8464,382096
-(defun union-eq1-rev 8543,385702
-(defun collect-hereditarily-constrained-fnnames 8553,385973
-(defun putprop-hereditarily-constrained-fnnames-lst 8567,386553
-(defun defuns-fn1 8608,388565
-(defun defuns-fn0 8771,395990
-(defun strip-non-hidden-package-names 8822,397638
-(defun in-package-fn 8831,398062
-(defun defstobj-functionsp 8853,398905
-(defun index-of-non-number 8917,402541
-(defun non-std-error 8926,402747
-(defun non-std-body 8935,403153
-(defun non-std-def-lst 8949,403646
-(defun make-udf-insigs 8964,404212
-(defun intro-udf 8973,404501
-(defun intro-udf-lst1 9012,405896
-(defun intro-udf-lst2 9018,406101
-(defun intro-udf-lst 9056,407940
-(defun defun-ctx 9074,408758
-(defun install-event-defuns 9092,409382
-(defun defuns-fn 9143,411529
-(defun defun-fn 9286,417334
-(defun args-fn 9301,417877
-(defmacro args 9388,422087
-(defun make-verify-termination-def 9409,422720
-(defun make-verify-termination-defs-lst 9438,423972
-(defun chk-acceptable-verify-termination1 9454,424762
-(defun uniform-defun-modes 9492,426907
-(defun chk-acceptable-verify-termination 9506,427511
-(defun verify-termination1 9577,430722
-(defun verify-termination-boot-strap-fn 9610,432163
-(defmacro when-logic3 9641,433249
-(defun verify-termination-fn 9650,433515
-(defun fns-used-in-axioms 9677,434708
-(defun check-out-instantiablep1 9703,435681
-(defun check-out-instantiablep 9712,435969
-
-proof-checker-pkg.lisp,26
-(defpkg "ACL2-PC" 23,881
-
-proof-checker-a.lisp,4256
-(defmacro pc-value 29,1271
-(defmacro pc-assign 35,1467
-(defun initialize-pc-acl2 44,1747
-(defmacro state-stack 55,2076
-(defmacro old-ss 58,2129
-(defmacro ss-alist 63,2244
-(defun define-global-name 66,2291
-(defmacro define-global 71,2407
-(define-global pc-prompt)78,2623
-(define-global pc-prompt-depth-prefix)79,2649
-(define-global pc-print-macroexpansion-flg)80,2688
-(define-global pc-print-prompt-and-instr-flg)82,2786
-(defrec pc-state93,3346
-(defconst *pc-state-fields-for-primitives*102,3459
-(defmacro instruction 105,3572
-(defmacro goals 112,3790
-(defmacro abbreviations 119,3996
-(defmacro local-tag-tree 126,4218
-(defmacro pc-ens 133,4442
-(defmacro tag-tree 140,4650
-(defrec goal153,5192
-(defconst *goal-fields*159,5279
-(defmacro conc 162,5354
-(defmacro hyps 165,5449
-(defmacro current-addr 168,5544
-(defmacro goal-name 171,5655
-(defmacro depends-on 174,5760
-(defmacro make-official-pc-command 177,5867
-(defun intern-in-keyword-package 181,6021
-(defun make-pretty-pc-command 185,6142
-(defun make-pretty-pc-instr 190,6308
-(defmacro change-pc-state 201,6703
-(defun make-official-pc-instr 204,6787
-(defun check-formals-length 221,7430
-(defun check-&optional-and-&rest 250,8843
-(defun make-let-pairs-from-formals 276,9986
-(defun all-symbols 292,10609
-(defun all-symbols-list 306,10959
-(defun make-access-bindings 314,11099
-(defun let-form-for-pc-state-vars 320,11356
-(defun check-field-names 332,11875
-(defmacro print-no-change 342,12293
-(defmacro print-no-change2 345,12399
-(defun print-no-change-fn 349,12509
-(defmacro maybe-update-instruction 369,13303
-(defun add-pc-doc-header 378,13703
-(defun remove-doc 389,13990
-(defun pc-primitive-defun-form 396,14302
-(defun pc-command-table-guard 419,15194
-(defmacro add-pc-command 452,16071
-(defmacro pc-command-type 455,16167
-(defmacro print-no-change3 458,16273
-(defun add-pc-command-1 462,16412
-(defun toggle-pc-macro-fn 469,16616
-(defun pc-meta-or-macro-defun 494,18233
-(defun goal-names 513,19018
-(defun instructions-of-state-stack 519,19162
-(defmacro fms0 528,19442
-(defmacro with-output-forced 542,19986
-(defun print-pc-prompt 566,20775
-(defun pc-macroexpand 577,21128
-(defun find-goal 605,22419
-(defun print-all-goals-proved-message 612,22600
-(defmacro when-goals 621,22874
-(defmacro when-goals-trip 626,22979
-(defun current-immediate-deps 632,23125
-(defun goal-dependent-p 642,23550
-(defun current-all-deps 650,23766
-(defun maybe-print-proved-goal-message 660,24179
-(defun accumulate-ttree-in-pc-state 703,26335
-(defun pc-process-assumptions 710,26628
-(defun make-implication 737,27407
-(defun cl-set-to-implications 743,27557
-(defun known-assumptions 750,27792
-(defun add-assumptions-to-top-goal767,28524
-(defun unproved-goals 794,29767
-(defun make-pc-ens 802,29986
-(defun initial-rcnst-from-ens 807,30072
-(defun make-new-goals-fixed-hyps 817,30496
-(defun pc-single-step-primitive 830,30977
-(defun maybe-print-macroexpansion 1014,40452
-(defun pc-single-step-1 1033,41476
-(defun union-lastn-pc-tag-trees 1105,45355
-(defun pc-single-step 1118,45751
-(defconst *pc-complete-signal* 1149,47365
-(defmacro catch-throw-to-local-top-level 1151,47416
-(defun pc-main-loop 1179,48411
-(defun make-initial-goal 1264,51976
-(defun initial-state-stack 1272,52134
-(defun event-name-and-types-and-raw-term 1282,52526
-(defmacro install-initial-state-stack 1285,52648
-(defun pc-main1 1295,53051
-(defun pc-main 1302,53300
-(defun pc-top 1308,53624
-(defun illegal-fnp 1329,54338
-(defun illegal-fnp-list 1343,54725
-(defun verify-fn 1349,54868
-(defun print-unproved-goals-message 1403,56789
-(defun state-stack-from-instructions1412,57176
-(defun state-from-instructions1423,57657
-(defun print-pc-defthm 1431,57947
-(defmacro print-pc-goal 1442,58320
-(defmacro print-pc-state 1467,59442
-(defun proof-checker1486,60241
-(deflabel proof-checker-commands1571,64102
-(deflabel macro-command1581,64405
-(defmacro verify 1608,65634
-(deflabel instructions1660,67491
-(defun sublis-expr-non-quoteps 2246,89480
-(defun sublis-expr-non-quoteps-lst 2264,90244
-(defun invert-abbreviations-alist 2271,90446
-(defun abbreviate 2278,90677
-(defmacro untrans0 2283,90835
-(defun untrans0-lst-fn 2289,91030
-(defmacro untrans0-lst 2295,91260
-
-defthm.lisp,15168
-(defun remove-lambdas 51,2105
-(defun remove-lambdas-lst 61,2420
-(defun interpret-term-as-rewrite-rule2 72,2676
-(defun interpret-term-as-rewrite-rule1 107,3973
-(defun interpret-term-as-rewrite-rule 144,5842
-(defun non-recursive-fnnames 191,7520
-(defun non-recursive-fnnames-lst 206,8212
-(defun hide-lambdas1 217,8637
-(defun hide-lambdas 227,8991
-(defun variantp 237,9369
-(defun surrounding-fns1 255,9841
-(defun surrounding-fns-lst 283,10936
-(defun surrounding-fns 291,11154
-(defun loop-stopper1 317,12154
-(defun loop-stopper 327,12573
-(defun remove-irrelevant-loop-stopper-pairs 502,22921
-(defun put-match-free-value 520,23572
-(defun free-vars-in-hyps 538,24207
-(defun free-vars-in-hyps-simple 578,26063
-(defun free-vars-in-fc-hyps 590,26581
-(defun free-vars-in-hyps-considering-bind-free 602,26998
-(defun all-vars-in-hyps 669,30005
-(defun match-free-value 700,31295
-(defun match-free-fc-value 710,31608
-(defun rule-backchain-limit-lst 723,32205
-(defun create-rewrite-rule 731,32546
-(defun hyps-that-instantiate-free-vars 773,34336
-(defun maybe-one-way-unify 790,35023
-(defun maybe-one-way-unify-lst 808,35722
-(defun maybe-one-way-unify-with-some 815,36003
-(defun maybe-subsumes 824,36378
-(defun subsumes-rewrite-rule 849,37587
-(defun find-subsumed-rule-names 901,39816
-(defun find-subsuming-rule-names 918,40669
-(defun forced-hyps 934,41477
-(defun strip-top-level-nots-and-forces 943,41803
-(defun free-variable-error? 957,42386
-(defun extend-geneqv-alist 976,43434
-(defun covered-geneqv-alist 988,43848
-(defun covered-geneqv-alist-lst 1009,44746
-(defun uncovered-equivs 1019,45169
-(defun uncovered-equivs-alist 1029,45553
-(defun uncovered-equivs-alist-lst 1123,49818
-(defun double-rewrite-opportunities 1143,50828
-(defun show-double-rewrite-opportunities1 1244,56794
-(defun show-double-rewrite-opportunities 1279,58722
-(defun irrelevant-loop-stopper-pairs 1301,59814
-(defun chk-rewrite-rule-warnings 1313,60194
-(defun chk-acceptable-rewrite-rule2 1496,69429
-(defun chk-acceptable-rewrite-rule1 1527,70890
-(defun chk-acceptable-rewrite-rule 1546,71748
-(defun add-rewrite-rule2 1565,72732
-(defun add-rewrite-rule1 1638,76388
-(defun add-rewrite-rule 1659,77355
-(deflabel linear1675,78020
-(defun expand-inequality-fncall1 1813,85802
-(defun expand-inequality-fncall 1836,86777
-(defun all-vars-in-poly-lst 1881,89011
-(defun subbagp-eq 1892,89362
-(defun always-biggerp-data 1899,89561
-(defun always-biggerp-data-lst 1907,89752
-(defun always-biggerp 1915,89945
-(defun no-element-always-biggerp 1939,90998
-(defun maximal-terms1 1949,91355
-(defun maximal-terms 1964,91978
-(defun collect-when-ffnnamesp 1999,93714
-(defun make-free-max-terms-msg1 2009,94019
-(defun make-free-max-terms-msg 2036,95386
-(defun external-linearize 2052,95990
-(defun bad-synp-hyp-msg-for-linear 2062,96233
-(defun show-double-rewrite-opportunities-linear 2071,96613
-(defun chk-acceptable-linear-rule22092,97514
-(defun chk-acceptable-linear-rule1 2231,105251
-(defun chk-acceptable-linear-rule 2247,105930
-(defun add-linear-rule3 2265,106785
-(defun add-linear-rule2 2307,108738
-(defun add-linear-rule1 2322,109441
-(defun add-linear-rule 2338,110244
-(deflabel well-founded-relation2380,111640
-(defun destructure-well-founded-relation-rule 2557,119472
-(defun chk-acceptable-well-founded-relation-rule 2596,120789
-(defun add-well-founded-relation-rule 2633,122418
-(deflabel built-in-clause2645,122904
-(defun chk-acceptable-built-in-clause-rule2 2782,128255
-(defun chk-acceptable-built-in-clause-rule1 2807,129354
-(defun chk-acceptable-built-in-clause-rule 2821,129881
-(defun fn-and-maximal-level-no 2837,130613
-(defun fn-and-maximal-level-no-lst 2863,131870
-(defun built-in-clause-discriminator-fn 2872,132118
-(defun all-fnnames-subsumer 2878,132291
-(defun make-built-in-clause-rules1 2902,133724
-(defun chk-initial-built-in-clauses 2926,134901
-(defun make-built-in-clause-rules 2955,136141
-(defun classify-and-store-built-in-clause-rules 2971,136807
-(defun add-built-in-clause-rule 3017,139276
-(deflabel compound-recognizer3049,140776
-(defun destructure-compound-recognizer 3261,150903
-(defun make-recognizer-tuple 3319,153456
-(defun comment-on-new-recog-tuple1 3386,156444
-(defun comment-on-new-recog-tuple 3444,159543
-(defun chk-acceptable-compound-recognizer-rule 3507,162672
-(defun add-compound-recognizer-rule 3564,165075
-(deflabel forward-chaining3587,166134
-(defun chk-triggers 3739,174159
-(defun destructure-forward-chaining-term 3865,181363
-(defun chk-acceptable-forward-chaining-rule 3906,183285
-(defun putprop-forward-chaining-rules-lst3927,184031
-(defun add-forward-chaining-rule 3949,184996
-(deflabel meta3965,185733
-(deflabel evaluator-restrictions4350,205289
-(deflabel extended-metafunctions4823,222608
-(deflabel meta-extract5182,238726
-(defun evaluator-clause/arglist 5509,254946
-(defun evaluator-clause 5523,255536
-(defun evaluator-clauses1 5551,256533
-(defun evaluator-clauses 5556,256736
-(defun cdrp 5657,262216
-(defun expand-eq-and-atom-term-lst 5673,262765
-(defun normalize-alleged-evaluator-clause 5727,265166
-(defun normalize-alleged-evaluator-clause-set 5737,265511
-(defun shallow-clausify1 5742,265725
-(defun shallow-clausify 5755,266107
-(defun find-evfn-lst-in-clause 5775,266976
-(defun guess-evfn-lst-for-evfn 5806,268060
-(defun find-fn-in-clause 5818,268541
-(defun guess-fn-args-lst-for-evfn 5832,269057
-(defun normalized-evaluator-cl-set 5846,269742
-(defun chk-evaluator 5856,270066
-(defun defevaluator-form/defthms 5937,274080
-(defun defevaluator-form/fns-clauses 5952,274820
-(defconst *defevaluator-form-base-theory*5974,275590
-(defun defevaluator-form 5983,275933
-(defun pairs-to-macro-alias-msgs 6035,277998
-(defun defevaluator-check-msg 6042,278288
-(defun defevaluator-check 6078,280130
-(defun defevaluator-check-form 6104,281266
-(defmacro defevaluator 6118,281625
-(deflabel term-table6240,286660
-(defun remove-meta-extract-contextual-hyps 6276,288033
-(defun remove-meta-extract-global-hyps 6307,289428
-(defun meta-rule-hypothesis-functions 6327,290137
-(defun meta-fn-args 6369,291864
-(defun chk-meta-function 6395,292714
-(defun ev-lst-from-ev 6449,295121
-(defun attached-fns 6458,295327
-(defun siblings 6469,295778
-(defun canonical-sibling 6474,295937
-(defun canonical-ffn-symbs 6483,296238
-(defun canonical-ffn-symbs-lst 6510,297166
-(defun collect-canonical-siblings 6521,297442
-(defun immediate-canonical-ancestors 6533,297854
-(defun canonical-ancestors-rec 6560,299265
-(defun canonical-ancestors 6575,299810
-(defun canonical-ancestors-lst 6588,300347
-(defun chk-evaluator-use-in-rule 6596,300613
-(defun chk-rule-fn-guard 6748,308065
-(defun chk-acceptable-meta-rule 6792,310139
-(defun add-meta-rule1 6906,315584
-(defun maybe-putprop-lst 6920,316130
-(defun mark-attachment-disallowed2 6930,316483
-(defun mark-attachment-disallowed1 6956,317628
-(defun mark-attachment-disallowed 6965,317986
-(defun add-meta-rule 6978,318493
-(deflabel elim7033,320592
-(defun destructors 7174,327721
-(defun destructors-lst 7190,328355
-(defun strip-ffn-symbs 7197,328515
-(defun chk-acceptable-elim-rule1 7202,328657
-(defun chk-acceptable-elim-rule 7225,329668
-(defun add-elim-rule1 7280,331986
-(defun add-elim-rule 7305,333094
-(deflabel generalize7317,333537
-(defun chk-acceptable-generalize-rule 7346,334677
-(defun add-generalize-rule 7353,334869
-(deflabel type-prescription7365,335301
-(defun find-type-prescription-pat 7534,344405
-(defun type-prescription-disjunctp 7576,346152
-(defun type-prescription-conclp 7622,348359
-(defun subst-nil-into-type-prescription-disjunct 7647,349457
-(defun subst-nil-into-type-prescription-concl 7672,350410
-(defun unprettyify-tp 7704,351847
-(defun destructure-type-prescription 7721,352417
-(defun add-type-prescription-rule 7882,361549
-(defun strong-compound-recognizer-p 7959,364846
-(defun warned-non-rec-fns-for-tp 7969,365329
-(defun warned-non-rec-fns-tp-hyps1 7995,366406
-(defun warned-non-rec-fns-tp-hyps 8012,367243
-(defun chk-acceptable-type-prescription-rule 8017,367443
-(deflabel equivalence8140,374189
-(defun boolean-fn 8439,384067
-(defun reflexivity 8447,384265
-(defun symmetry 8453,384355
-(defun transitivity 8460,384469
-(defun equivalence-relation-condition 8468,384620
-(defun find-candidate-equivalence-relation 8486,385380
-(defun collect-problematic-pre-equivalence-rule-names 8500,385895
-(defun chk-acceptable-equivalence-rule 8519,386941
-(defun add-equivalence-rule 8642,393077
-(deflabel refinement8782,399185
-(defun chk-acceptable-refinement-rule 8833,401305
-(defun collect-coarsenings 8872,403240
-(defun putprop-coarsenings 8882,403569
-(defun union-values 8910,404870
-(defun extend-value-set 8918,405109
-(defun extend-each-value-set 8932,405774
-(defun close-value-sets 8942,406105
-(defun add-refinement-rule 8956,406733
-(deflabel congruence8977,407527
-(defun corresponding-args-eq-except 9121,414358
-(defun interpret-term-as-congruence-rule 9135,414951
-(defun some-congruence-rule-same 9216,418879
-(defun some-congruence-rule-has-refinement 9225,419175
-(defun chk-acceptable-congruence-rule 9235,419533
-(defun putnth 9313,423279
-(defun add-congruence-rule-to-congruence 9320,423541
-(defun add-congruence-rule 9330,423948
-(deflabel definition9376,426136
-(defun chk-destructure-definition 9536,435561
-(defun chk-acceptable-definition-install-body 9548,436124
-(defun chk-acceptable-definition-rule9619,439071
-(deflabel induction9669,441217
-(defun chk-acceptable-induction-rule 9837,449925
-(defun add-induction-rule 9844,450116
-(deflabel type-set-inverter9861,450786
-(defun chk-acceptable-type-set-inverter-rule 9918,453280
-(defun add-type-set-inverter-rule 9986,456170
-(deflabel clause-processor10015,457292
-(defun tilde-@-illegal-clause-processor-sig-msg 10290,470622
-(defun destructure-clause-processor-rule 10325,471833
-(defun chk-acceptable-clause-processor-rule 10350,472832
-(defun add-clause-processor-rule 10458,478452
-(defun trusted-clause-processor-table-guard 10503,480310
-(defmacro define-trusted-clause-processor10584,484159
-(defun primitive-instructionp 11014,503721
-(defun non-primitive-instructions 11022,504034
-(defun chk-primitive-instruction-listp 11032,504347
-(defun translate-instructions 11040,504586
-(defun controller-alistp 11047,504834
-(defun alist-to-keyword-alist 11067,505571
-(defun loop-stopper-alist-p 11079,506009
-(defun guess-controller-alist-for-definition-rule 11092,506363
-(defun chk-legal-linear-trigger-terms1 11107,507086
-(defun chk-legal-linear-trigger-terms 11128,508116
-(defun backchain-limit-listp 11156,509530
-(defun eliminate-macro-aliases 11169,509840
-(defun translate-rule-class-alist 11196,511212
-(defun translate-rule-class1 11909,549554
-(defun reason-for-non-keyword-value-listp 11970,552287
-(defun translate-rule-class 11989,552851
-(defun translate-rule-classes1 12040,555158
-(defun translate-rule-classes 12062,556016
-(defun chk-acceptable-x-rule 12093,557485
-(defun chk-acceptable-x-rules 12178,561277
-(defun collect-keys-eq 12193,561980
-(defun chk-acceptable-rules 12202,562336
-(defun add-x-rule 12292,565558
-(defun add-rules1 12403,570588
-(defun truncate-class-alist 12422,571428
-(defun truncate-classes 12440,572219
-(defun make-runes1 12458,573098
-(defun make-runes 12497,574743
-(defun make-runic-mapping-pairs 12505,574981
-(defun add-rules 12519,575520
-(defun redundant-theoremp 12542,576728
-(defun non-tautological-classes 12555,577306
-(defun prove-corollaries1 12573,578103
-(defun prove-corollaries 12633,581134
-(defun enabled-runep-string 12667,582557
-(defun untranslate-hyps 12672,582671
-(defun info-for-lemmas 12677,582848
-(defun world-to-next-event 12714,584831
-(defun assoc-eq-eq 12722,585082
-(defun actual-props 12733,585418
-(defun info-for-well-founded-relation-rules 12751,586040
-(defun info-for-built-in-clause-rules1 12766,586638
-(defun info-for-built-in-clause-rules 12783,587427
-(defun info-for-compound-recognizer-rules 12789,587667
-(defun info-for-generalize-rules 12813,588849
-(defun info-for-linear-lemmas 12830,589612
-(defun info-for-eliminate-destructors-rule 12860,591245
-(defun info-for-congruences 12888,592722
-(defun info-for-coarsenings 12896,592931
-(defun info-for-forward-chaining-rules 12904,593124
-(defun decode-type-set-lst 12932,594502
-(defun info-for-type-prescriptions 12938,594641
-(defun info-for-induction-rules 12968,596211
-(defun info-for-type-set-inverter-rules 12991,597320
-(defun info-for-x-rules 13011,598263
-(defun info-for-rules 13070,600376
-(defun print-info-for-rules-entry 13080,600767
-(defun print-info-for-rules 13105,601962
-(defun pr-body 13115,602342
-(defun pr-fn 13124,602584
-(defun print-clause-processor-rules1 13138,603249
-(defmacro print-clause-processor-rules 13151,603772
-(defun new-numes 13157,604006
-(defun world-to-next-command 13168,604359
-(defun pr!-fn 13175,604627
-(defmacro pr 13184,604918
-(defmacro pr! 13231,606511
-(defun disabledp-fn-lst 13258,607441
-(defun disabledp-fn 13265,607762
-(defmacro disabledp 13288,608758
-(defun access-x-rule-rune 13318,609992
-(defun collect-x-rules-of-rune 13362,612248
-(defun collect-congruence-rules-of-rune-in-geneqv-lst 13373,612653
-(defun collect-congruence-rules-of-rune 13385,613102
-(defun find-rules-of-rune2 13400,613748
-(defun find-rules-of-rune1 13494,617830
-(defun find-rules-of-rune 13510,618581
-(defun collect-non-backchain-subclass 13554,620591
-(defun chk-acceptable-monitor 13564,620967
-(defun chk-acceptable-monitors 13639,624593
-(defun monitor1 13660,625446
-(defun unmonitor1 13679,626212
-(defun monitor-fn 13698,626999
-(defun unmonitor-fn 13724,627823
-(defun monitored-runes-fn 13767,629398
-(defun brr-fn 13783,629857
-(defmacro brr 13798,630286
-(deflabel why-brr13870,634252
-(defmacro brr@ 13927,637323
-(defmacro monitor 14054,644088
-(defmacro unmonitor 14224,653168
-(defmacro monitored-runes 14251,654043
-(defun proceed-from-brkpt1 14267,654428
-(defun exit-brr 14299,655695
-(defun ok-if-fn 14310,656066
-(defmacro ok-if 14318,656311
-(defun print-rule-storage-dependencies 14365,658356
-(defun defaxiom-supporters 14382,658968
-(defun defaxiom-fn 14435,661809
-(defun warn-on-inappropriate-defun-mode 14528,666196
-(defun add-hyp-standardp-var-lst 14542,666716
-(defun strengthen-hyps-using-transfer-principle 14549,666904
-(defun weaken-using-transfer-principle 14561,667244
-(defun remove-standardp-hyp 14585,668114
-(defun remove-standardp-hyps 14593,668349
-(defun remove-standardp-hyps-and-standardp-conclusion 14605,668752
-(defun chk-classical-term-or-standardp-of-classical-term 14616,669109
-(defmacro with-waterfall-parallelism-timings 14634,669866
-(defmacro with-waterfall-parallelism-timings 14644,670274
-(defun defthm-fn1 14648,670366
-(defun defthm-fn 14794,677436
-(defmacro thm 14817,678038
-(defun thm-fn 14849,678863
-(defun chk-extensible-rule-classes 14882,680292
-(defun extend-rule-classes 14891,680640
-(defun gen-new-name-in-package-of-symbol1 14902,681000
-(defun gen-new-name-in-package-of-symbol 14922,681796
-(defmacro defequiv 14942,682518
-(defmacro defrefinement 15001,684610
-(defmacro defcong 15056,686545
-
-other-events.lisp,31305
-(defun legal-initp 46,2129
-(defun macro-arglist-keysp 58,2576
-(defun macro-arglist-after-restp 91,4156
-(defun macro-arglist-optionalp 98,4362
-(defun macro-arglist1p 125,5340
-(defun subsequencep 142,5953
-(defun collect-lambda-keywordps 155,6395
-(defun macro-args-structurep 162,6655
-(defun macro-vars-key 182,7611
-(defun macro-vars-after-rest 206,8490
-(defun macro-vars-optional 219,8841
-(defun macro-vars 240,9591
-(defun chk-legal-defconst-name 260,10312
-(defun defconst-fn1 274,10944
-(defvar *hcomp-fn-ht* 285,11207
-(defvar *hcomp-const-ht* 286,11234
-(defvar *hcomp-macro-ht* 287,11264
-(defvar *hcomp-fn-alist* 288,11294
-(defvar *hcomp-const-alist* 289,11324
-(defvar *hcomp-macro-alist* 290,11357
-(defconstant *hcomp-fake-value* 291,11390
-(defvar *hcomp-book-ht* 292,11457
-(defvar *hcomp-const-restore-ht* 293,11486
-(defvar *hcomp-fn-macro-restore-ht*294,11524
-(defvar *declaim-list* 327,12707
-(defrec hcomp-book-ht-entry331,12739
-(defun defconst-val-raw 341,13031
-(defun defconst-val 352,13520
-(defun defconst-fn 437,16794
-(defun chk-legal-init-msg 495,19265
-(defun chk-legal-init 520,20228
-(defun chk-macro-arglist-keys 525,20372
-(defun chk-macro-arglist-after-rest 598,24489
-(defun chk-macro-arglist-optional 605,24749
-(defun chk-macro-arglist1 640,26388
-(defun chk-macro-arglist-msg 660,27229
-(defun chk-macro-arglist 740,31252
-(defun defmacro-fn1 745,31438
-(defun chk-defmacro-width 761,31975
-(defun redundant-defmacrop 775,32477
-(defun defmacro-fn 793,33303
-(defconst *initial-event-defmacros*924,40005
-(defun boot-translate 1145,47975
-(defun primordial-event-macro-and-fn1 1188,49682
-(defun primordial-event-macro-and-fn 1217,51099
-(defun primordial-event-macros-and-fns 1352,57759
-(defconst *initial-type-prescriptions*1368,58354
-(defun collect-world-globals 1390,59173
-(defun primordial-world-globals 1397,59443
-(defun arglists-to-nils 1543,66376
-(defconst *unattachable-primitives*1549,66604
-(defun primordial-world 1567,67327
-(defun same-name-twice 1633,69758
-(defun conflicting-imports 1641,69990
-(defun chk-new-stringp-name 1648,70161
-(deflabel package-reincarnation-import-restrictions1687,71708
-(defun chk-package-reincarnation-import-restrictions 1750,75064
-(defun convert-book-name-to-cert-name 1762,75502
-(defun unrelativize-book-path 1785,76393
-(defun tilde-@-defpkg-error-phrase 1794,76769
-(defconst *1*-pkg-prefix*1843,79444
-(defun chk-acceptable-defpkg 1856,79870
-(defun defpkg-fn 2051,88540
-(defun theory-fn-callp 2227,97463
-(defun intersection-augmented-theories-fn1 2250,98324
-(defmacro check-theory 2270,99292
-(defun intersection-theories-fn 2278,99602
-(defmacro intersection-theories 2287,99949
-(defun union-augmented-theories-fn1 2319,100932
-(defun union-theories-fn1 2336,101784
-(defun union-theories-fn 2360,102881
-(defmacro union-theories 2399,104341
-(defun set-difference-augmented-theories-fn1 2445,105634
-(defun set-difference-theories-fn1 2460,106357
-(defun set-difference-theories-fn 2484,107437
-(defmacro set-difference-theories 2515,108629
-(defun universal-theory-fn1 2554,109927
-(defun universal-theory-fn 2606,112784
-(defmacro universal-theory 2637,114333
-(defun function-theory-fn1 2687,116381
-(defun function-theory-fn 2747,119291
-(defmacro function-theory 2763,119949
-(defun executable-counterpart-theory-fn 2802,121270
-(defmacro executable-counterpart-theory 2817,121907
-(defun standard-theories 2860,123458
-(defun current-theory-fn 2866,123708
-(defmacro current-theory 2886,124505
-(defconst *initial-return-last-table*3020,129504
-(defun end-prehistoric-world 3048,130808
-(defun theory-namep 3092,132859
-(defun theory-fn 3101,133116
-(defmacro theory 3113,133525
-(defun deftheory-fn 3143,134378
-(defun in-theory-fn 3265,139739
-(defun in-arithmetic-theory-fn 3331,142458
-(defmacro disable 3394,145088
-(defmacro enable 3434,146420
-(defmacro theory-invariant 3488,148320
-(defmacro theory-invariant 3689,158301
-(defmacro incompatible 3693,158375
-(deflabel signature3734,159849
-(defconst *generic-bad-signature-string*3883,167450
-(defconst *signature-keywords*3889,167737
-(defun duplicate-key-in-keyword-value-listp 3894,167844
-(defun chk-signature 3901,168089
-(defun chk-signatures 4167,180936
-(defun chk-acceptable-encapsulate1 4219,183551
-(defun primitive-event-macros 4270,186130
-(deflabel embedded-event-form4409,190800
-(defun name-introduced 4564,197104
-(defun chk-embedded-event-form-orig-form-msg 4641,200584
-(defun chk-embedded-event-form 4648,200833
-(defun destructure-expansion 5005,218572
-(defun rebuild-expansion 5020,219160
-(defun set-raw-mode-on 5025,219337
-(defun set-raw-mode-off 5030,219504
-(defmacro set-raw-mode-on! 5036,219691
-(defmacro set-raw-mode 5054,220339
-(defun-one-output stobj-out 5193,226900
-(defun mv-ref! 5204,227292
-(defmacro add-raw-arity 5243,228120
-(defmacro remove-raw-arity 5296,230136
-(defun raw-arity 5320,230967
-(defun alist-to-bindings 5383,233679
-(defun-one-output acl2-raw-eval-form-to-eval 5390,233861
-(defun acl2-raw-eval 5420,235084
-(defun acl2-raw-eval 5443,235969
-(defun acl2-raw-eval 5461,236665
-(defun get-and-chk-last-make-event-expansion 5464,236740
-(defconst *local-value-triple-elided*5491,237923
-(defun elide-locals-rec 5501,238181
-(defun elide-locals-lst 5556,240791
-(defun elide-locals 5567,241232
-(defun make-record-expansion 5591,242397
-(defun eval-event-lst 5598,242620
-(defun equal-insig 5803,252953
-(defun bad-signature-alist 5823,253870
-(defmacro if-ns 5888,256999
-(defun tilde-*-bad-insigs-phrase1 5907,257523
-(defun tilde-*-bad-insigs-phrase 5934,258822
-(defun union-eq-cars 5946,259318
-(defun chk-acceptable-encapsulate2 5950,259441
-(defun conjoin-into-alist 5993,261193
-(defun classes-theorems 6007,261722
-(defun constraints-introduced1 6019,262106
-(defun new-trips 6035,262733
-(defun constraints-introduced 6115,267054
-(defun putprop-constraints 6235,272283
-(deflabel local-incompatibility6269,273783
-(defun maybe-install-acl2-defaults-table 6371,278910
-(defun in-encapsulatep 6389,279602
-(defun update-for-redo-flat 6405,280163
-(defmacro redo-flat 6424,280906
-(defun cert-op 6574,287996
-(defun eval-event-lst-environment 6592,288728
-(defun process-embedded-events6611,289465
-(defun constrained-functions 6901,304925
-(defun collect-logicals 6927,306172
-(defun exported-function-names 6936,306456
-(defun get-subversives 6948,306874
-(defun ancestral-ffn-symbs-lst 6958,307299
-(defun constraints-list 6962,307454
-(defun encapsulate-constraint 6977,308166
-(defun new-dependent-clause-processors 7087,313388
-(defun bogus-exported-compliants 7104,314095
-(defun encapsulate-pass-2 7157,316678
-(defun tilde-@-abbreviate-object-phrase 7948,346964
-(defun encapsulate-ctx 7982,348021
-(defun print-encapsulate-msg1 8008,349088
-(defun print-encapsulate-msg2 8025,349794
-(defun print-encapsulate-msg3/exported-names 8037,350128
-(defun print-encapsulate-msg3/constraints 8056,350732
-(defun print-encapsulate-msg3 8104,352720
-(defun find-first-non-local-name 8181,356750
-(defun find-first-non-local-name-lst 8252,359586
-(defun corresponding-encap-events 8271,360415
-(defun corresponding-encaps 8298,361521
-(defun redundant-encapsulate-tuplep 8306,361765
-(defun redundant-encapsulatep 8345,363772
-(defun mark-missing-as-hidden-p 8427,367834
-(defun known-package-alist-included-p 8440,368359
-(defun encapsulate-fix-known-package-alist 8453,368913
-(defun subst-by-position1 8488,370868
-(defun subst-by-position 8508,371585
-(defun intro-udf-guards 8526,372404
-(defun intro-udf-non-classicalp 8567,374210
-(defun assoc-proof-supporters-alist 8582,374989
-(defun update-proof-supporters-alist-3 8590,375281
-(defun posn-first-non-event 8617,376481
-(defun update-proof-supporters-alist-2 8624,376732
-(defun update-proof-supporters-alist-1 8635,377231
-(defun update-proof-supporters-alist 8653,378114
-(defun install-proof-supporters-alist 8674,379006
-(defun encapsulate-fn 8687,379599
-(defun progn-fn1 9043,398591
-(defun progn-fn 9131,402618
-(defun progn!-fn 9134,402686
-(defun make-event-ctx 9140,403003
-(defun protected-eval 9145,403171
-(defun make-event-debug-pre 9206,405982
-(defun make-event-debug-post 9223,406705
-(defmacro do-proofs? 9232,407067
-(defun make-event-fn 9249,407582
-(deflabel books9552,422175
-(deflabel community-books9616,425444
-(defun chk-book-name 9634,426147
-(defun include-book-alist-subsetp 9679,428197
-(defun get-portcullis-cmds 9719,430150
-(defun remove-after-last-directory-separator 9752,431556
-(defun merge-using-dot-dot 9760,431880
-(defun our-merge-pathnames 9794,433187
-(defun expand-tilde-to-user-home-dir 9825,434336
-(defvar *canonical-unix-pathname-action*9862,435835
-(defun canonical-unix-pathname 9874,436366
-(defun unix-truename-pathname 9960,441338
-(defun chk-live-state-p 9980,442153
-(defun-overrides canonical-pathname 9992,442584
-(defun acl2-magic-canonical-pathname 9999,442813
-(defdoc canonical-pathname10030,443816
-(defun canonical-dirname! 10069,445706
-(defun directory-of-absolute-pathname 10080,446132
-(defun extend-pathname 10086,446342
-(defun maybe-add-separator 10130,448363
-(defun set-cbd-fn 10136,448563
-(defmacro set-cbd 10174,450117
-(defun set-cbd-state 10205,451176
-(defun parse-book-name 10221,451675
-(defun cbd-fn 10276,454056
-(defmacro cbd 10283,454363
-(defun make-include-books-absolute 10399,460059
-(defun make-include-books-absolute-lst 10607,469850
-(defun first-known-package-alist 10620,470378
-(defmacro string-prefixp 10640,471070
-(defun relativize-book-path 10649,471348
-(defun relativize-book-path-lst1 10674,472345
-(defun relativize-book-path-lst 10681,472631
-(defun defpkg-items-rec 10689,472932
-(defun defpkg-items 10762,476526
-(defun new-defpkg-list2 10775,477038
-(defun make-hidden-defpkg 10799,477873
-(defun new-defpkg-list110808,478183
-(defun new-defpkg-list 10842,479515
-(defun term-ignore-okp 10885,481908
-(defun term-list-ignore-okp 10896,482290
-(defun hidden-defpkg-events1 10904,482441
-(defun hidden-defpkg-events 10960,484643
-(defun fix-portcullis-cmds1 10968,484971
-(defun fix-portcullis-cmds 10979,485478
-(defun collect-uncertified-books 11031,488129
-(defun chk-in-package 11045,488706
-(defmacro ill-formed-certificate-er 11088,490605
-(defun include-book-er-warning-summary 11114,491553
-(defun include-book-er1 11162,493453
-(defun include-book-er 11177,494124
-(defun post-alist-from-channel 11202,495440
-(defun certificate-file-and-input-channel1 11229,496612
-(defmacro pcert-op-p 11237,496883
-(defun certificate-file-and-input-channel 11240,496994
-(defun cert-annotations-and-checksum-from-cert-file 11280,498896
-(defun tilde-@-cert-post-alist-phrase 11300,499726
-(defun tilde-*-book-check-sums-phrase1 11339,501808
-(defun tilde-*-book-check-sums-phrase 11398,504513
-(defun get-cmds-from-portcullis1 11414,505251
-(defun hidden-defpkg-events-simple 11445,506497
-(defun get-cmds-from-portcullis 11469,507187
-(defun convert-book-name-to-port-name 11501,508490
-(defun chk-raise-portcullis2 11510,508807
-(defun initial-acl2-defaults-table 11592,512966
-(defun chk-raise-portcullis1 11600,513293
-(defun mark-local-included-books 11631,514554
-(defun unmark-and-delete-local-included-books 11663,516234
-(defun decimal-string-to-number 11678,516956
-(defun parse-version 11709,518339
-(defun-one-output latest-release-note-string 11754,520387
-(defun earlier-acl2-versionp 11762,520689
-(defun acl2-version-r-p 11791,521781
-(defun ttag-alistp 11797,521954
-(defun cert-annotationsp 11809,522295
-(defun include-book-alist-entryp 11823,522688
-(defun include-book-alistp1 11835,523143
-(defun include-book-alistp 11850,523692
-(defrec cert-obj11860,524127
-(defun check-sum-cert-obj 11874,524705
-(defun chk-raise-portcullis 11885,525212
-(defun chk-certificate-file1 12106,535518
-(defun certificate-file 12219,540889
-(defun chk-certificate-file 12227,541233
-(defun equal-modulo-hidden-defpkgs 12321,546230
-(defun cert-obj-for-convert 12339,546933
-(defun symbol-name-equal 12386,549592
-(defun chk-acceptable-certify-book1 12391,549723
-(defun translate-book-names 12502,554912
-(defun fix-ttags 12516,555501
-(defun chk-well-formed-ttags 12556,557418
-(defun check-certificate-file-exists 12567,557827
-(defun chk-acceptable-certify-book 12601,559610
-(defun print-objects 12766,568451
-(defun replace-initial-substring 12771,568627
-(defun replace-string-prefix-in-tree 12784,569101
-(defmacro with-output-object-channel-sharing 12796,569682
-(defun elide-locals-and-split-expansion-alist 12833,571106
-(defun make-certificate-file1 12879,573610
-(defun make-certificate-file-relocated 12958,576967
-(defun make-certificate-file 12975,577648
-(defun make-certificate-files 13120,584990
-(defun open-input-object-file 13163,587055
-(defun read-object-file1 13185,587937
-(defun read-object-file 13197,588391
-(defun chk-cert-annotations13214,589223
-(defun chk-cert-annotations-post-alist13282,592526
-(defun chk-input-object-file 13369,596616
-(defun include-book-dir 13383,597252
-(defmacro include-book-dir-with-chk 13395,597813
-(defun newly-defined-top-level-fns-rec 13414,598762
-(defun newly-defined-top-level-fns 13448,600376
-(defun accumulate-post-alist 13479,601548
-(defun skipped-proofsp-in-post-alist 13498,602418
-(defun check-sum-cert 13517,603095
-(defmacro with-hcomp-bindings 13530,603632
-(defmacro with-hcomp-bindings 13535,603728
-(defmacro with-hcomp-ht-bindings 13552,604342
-(defmacro with-hcomp-ht-bindings 13556,604408
-(defun get-declaim-list 13589,605954
-(defun tilde-@-book-stack-msg 13595,606078
-(defun convert-book-name-to-acl2x-name 13627,607631
-(defun acl2x-alistp 13639,608030
-(defun read-acl2x-file 13649,608298
-(defun eval-port-file 13710,610908
-(defun getenv! 13783,614271
-(defun update-pcert-books 13792,614517
-(defun convert-non-nil-symbols-to-keywords 13800,614773
-(defun include-book-fn1 13808,615061
-(defun include-book-fn 14533,652155
-(defun spontaneous-decertificationp1 14635,656687
-(defun spontaneous-decertificationp 14681,658839
-(defun remove-duplicates-equal-from-end 14691,659260
-(defun include-book-alist-subsetp-failure-witnesses 14697,659523
-(defun expansion-filename 14807,665854
-(defun write-expansion-file 14824,666490
-(defun collect-ideal-user-defuns1 14999,674887
-(defun collect-ideal-user-defuns 15028,675947
-(defun set-difference-eq-sorted 15035,676186
-(defun expansion-alist-pkg-names0 15048,676719
-(defun hons-union-ordered-string-lists 15063,677240
-(defun expansion-alist-pkg-names-memoize 15080,677782
-(defun expansion-alist-pkg-names 15090,678093
-(defun delete-names-from-kpa 15121,679524
-(defun print-certify-book-step-2 15130,679806
-(defun print-certify-book-step-3 15160,681504
-(defun print-certify-book-guards-warning15170,681926
-(defun chk-certify-book-step-3 15198,683003
-(defun print-certify-book-step-4 15262,686709
-(defun print-certify-book-step-5 15278,687391
-(defun hcomp-build-from-portcullis 15285,687648
-(defstub acl2x-expansion-alist 15384,693165
-(defun hons-copy-with-state 15395,693640
-(defun identity-with-state 15400,693766
-(defattach (acl2x-expansion-alist15405,693879
-(defun write-acl2x-file 15415,694233
-(defun merge-into-expansion-alist1 15436,694992
-(defun acl2x-alistp-domains-subsetp 15463,696477
-(defun merge-into-expansion-alist 15476,696866
-(defun restrict-expansion-alist 15502,698110
-(defun elide-locals-from-expansion-alist 15514,698521
-(defun write-port-file 15530,699189
-(defmacro save-parallelism-settings 15559,700199
-(defun include-book-alist-equal-modulo-local 15572,700649
-(defun copy-object-channel-until-marker 15594,701841
-(defun copy-pcert0-to-pcert1 15604,702245
-(defun touch? 15635,703719
-(defun convert-book-name-to-compiled-name 15672,705430
-(defun certify-book-finish-convert 15682,705836
-(defun delete-cert-files 15715,707539
-(defun include-book-alist-uncertified-books 15725,707898
-(defun count-forms-in-channel 15762,709612
-(defun skip-forms-in-channel 15768,709821
-(defun post-alist-from-pcert1-1 15775,710101
-(defun post-alist-from-pcert1 15823,711809
-(defun certificate-post-alist 15840,712283
-(defun certify-book-finish-complete 15856,713028
-(defun expansion-alist-conflict 15910,715398
-(defun chk-absstobj-invariants 15942,717101
-(defun certify-book-fn 15997,719672
-(defmacro certify-book 16819,768510
-(defmacro certify-book! 17064,782409
-(defdoc provisional-certification17098,783820
-(deflabel pathname17421,802358
-(deflabel book-example17466,804708
-(deflabel full-book-name17637,813663
-(deflabel book-name17682,815510
-(deflabel book-contents17773,819761
-(deflabel certificate17851,823068
-(deflabel portcullis17934,827462
-(deflabel version18046,833569
-(deflabel keep18140,838572
-(deflabel uncertified-books18173,840142
-(deflabel books-certification-classic18236,843598
-(defdoc books-certification18481,855428
-(defun redundant-defchoosep 18747,867243
-(defun chk-arglist-for-defchoose 18761,867852
-(defun defchoose-constraint-basic 18779,868686
-(defun generate-variable-lst-simple 18820,870027
-(defun defchoose-constraint-extra 18837,870680
-(defun defchoose-constraint 18912,874553
-(defun defchoose-fn 18925,875128
-(defun non-acceptable-defun-sk-p 19095,883562
-(defmacro defun-sk 19175,887562
-(deflabel forall19548,904343
-(deflabel exists19562,904734
-(deflabel defun-sk-example19576,905129
-(defdoc quantifier-tutorial19672,908623
-(deflabel quantifiers20275,936125
-(deflabel quantifiers-using-recursion20312,937884
-(deflabel quantifiers-using-defun-sk20343,938717
-(deflabel quantifiers-using-defun-sk-extended20393,940343
-(defun doublet-style-symbol-to-symbol-alistp 20487,943473
-(defun chk-legal-defstobj-name 20500,943999
-(defun chk-unrestricted-guards-for-user-fns 20513,944479
-(defconst *expt2-28* 20526,945026
-(defun fix-stobj-array-type 20528,945061
-(defun chk-stobj-field-descriptor 20550,945915
-(defun chk-acceptable-defstobj-renaming20734,955082
-(defun defconst-name 20864,961324
-(defun chk-acceptable-defstobj120869,961446
-(defconst *defstobj-keywords*20962,966426
-(defun defstobj-redundancy-bundle 20965,966500
-(defun old-defstobj-redundancy-bundle 20999,967568
-(defun redundant-defstobjp 21012,968059
-(defun congruent-stobj-fields 21038,969418
-(defun chk-acceptable-defstobj 21049,969851
-(defun defstobj-fields-template 21217,977677
-(defun defstobj-template 21263,979678
-(defun defstobj-component-recognizer-calls 21309,981825
-(defun defstobj-component-recognizer-axiomatic-defs 21336,982969
-(defun defstobj-field-fns-axiomatic-defs 21408,986233
-(defun defstobj-axiomatic-init-fields 21522,992011
-(defun defstobj-creator-fn 21546,992953
-(defun defstobj-axiomatic-defs 21556,993245
-(defun simple-array-type 21595,995032
-(defun-one-output stobj-copy-array-aref 21607,995417
-(defun-one-output stobj-copy-array-svref 21625,996128
-(defun-one-output stobj-copy-array-fix-aref 21640,996585
-(defmacro live-stobjp 21657,997260
-(defun array-etype-is-fixnum-type 21667,997692
-(defun defstobj-field-fns-raw-defs 21703,999081
-(defun defstobj-raw-init-fields 21884,1007773
-(defun defstobj-raw-init 21941,1010272
-(defun defstobj-raw-defs 21949,1010517
-(defun put-stobjs-in-and-outs1 21996,1012527
-(defun put-stobjs-in-and-outs 22042,1014193
-(defun defconst-name-alist 22095,1016510
-(defun accessor-array 22101,1016670
-(defun strip-accessor-names 22111,1017089
-(defun defstobj-defconsts 22121,1017336
-(defun defstobj-fn 22127,1017521
-(defun absstobj-name 22575,1041832
-(defmacro defabsstobj 22604,1042988
-(defmacro defabsstobj 22715,1047678
-(defun concrete-stobj 23372,1080108
-(defmacro defabsstobj-missing-events 23380,1080387
-(defun redundant-defabsstobjp 23426,1082466
-(defun absstobj-correspondence-concl-lst 23430,1082628
-(defun absstobj-correspondence-formula 23441,1083156
-(defun absstobj-preserved-formula 23492,1085192
-(defrec absstobj-method23542,1087074
-(defun fn-stobj-updates-p 23561,1087787
-(defun stobj-updates-p 23585,1088477
-(defun stobj-updates-listp 23660,1091277
-(defun unprotected-export-p 23670,1091632
-(defun translate-absstobj-field 23674,1091777
-(defun simple-translate-absstobj-fields 24020,1111048
-(defun one-way-unify-p 24042,1112003
-(defun obviously-iff-equiv-terms 24052,1112266
-(defun chk-defabsstobj-method-lemmas 24097,1114285
-(defun chk-defabsstobj-method 24210,1119801
-(defun chk-acceptable-defabsstobj1 24234,1120858
-(defun first-keyword 24281,1122822
-(defun chk-acceptable-defabsstobj 24288,1123009
-(defun defabsstobj-axiomatic-defs 24373,1126942
-(defun defabsstobj-raw-def 24393,1127989
-(defun defabsstobj-raw-defs-rec 24443,1130121
-(defun defabsstobj-raw-defs 24451,1130338
-(defun expand-recognizer 24487,1131969
-(defun put-absstobjs-in-and-outs 24502,1132632
-(defun method-exec 24520,1133491
-(defun defabsstobj-raw-init 24529,1133826
-(defun defabsstobj-missing-msg 24532,1133920
-(defun update-guard-post 24556,1135021
-(defun defabsstobj-logic-subst 24576,1136127
-(defun chk-defabsstobj-guard 24582,1136387
-(defun chk-defabsstobj-guards1 24607,1137666
-(defun chk-defabsstobj-guards 24623,1138400
-(defun make-absstobj-logic-exec-pairs 24635,1138980
-(defun defabsstobj-fn1 24641,1139264
-(defun defabsstobj-fn 24858,1149879
-(deflabel stobj24878,1150944
-(deflabel stobj-example-124981,1156337
-(deflabel declare-stobjs25214,1165595
-(deflabel stobj-example-1-defuns25265,1167835
-(deflabel stobj-example-1-implementation25384,1172480
-(deflabel stobj-example-1-proofs25459,1175292
-(deflabel stobj-example-225609,1180852
-(deflabel stobj-example-325703,1183936
-(defdoc resize-list25941,1192963
-(defun-one-output mv-let-for-with-local-stobj 25955,1193483
-(defmacro with-local-stobj 26021,1196856
-(deflabel with-local-stobj26257,1203103
-(defun create-state 26337,1206209
-(defmacro with-local-state 26341,1206306
-(defmacro stobj-let 26630,1218057
-(defun push-untouchable-fn 27138,1240951
-(defun remove-untouchable-fn 27193,1243032
-(defun def-body-lemmas 27248,1245216
-(defmacro show-bodies 27256,1245526
-(defun set-body-fn1 27306,1247628
-(defun set-body-fn 27316,1247994
-(defdoc trace27362,1249653
-(defparameter *trace-evisc-tuple*27390,1250792
-(defparameter *trace-evisc-tuple-world*27393,1250834
-(defun trace-evisc-tuple 27396,1250882
-(defun trace-multiplicity 27405,1251151
-(defun first-trace-printing-column 27418,1251504
-(defun trace-ppr 27434,1251993
-(defvar *inside-trace$* 27445,1252293
-(defun custom-trace-ppr 27448,1252340
-(defun *1*defp 27509,1254938
-(defun trace$-er-msg 27514,1255084
-(defun decls-and-doc 27518,1255180
-(defun trace$-when-gcond 27528,1255456
-(defun stobj-evisceration-alist 27533,1255545
-(defun trace-evisceration-alist 27541,1255940
-(defun set-trace-evisc-tuple 27545,1256098
-(defun chk-trace-options-aux 27621,1259142
-(defun trace$-value-msgp 27648,1260324
-(defun chk-trace-options 27661,1260771
-(defun memoize-off-trace-error 27755,1264882
-(defun untrace$-fn1 27763,1265243
-(defun untrace$-rec 27814,1267209
-(defun untrace$-fn 27833,1267859
-(defun maybe-untrace$-fn 27844,1268250
-(defmacro maybe-untrace$ 27853,1268554
-(defmacro maybe-untrace 27857,1268637
-(defun maybe-untrace! 27867,1268903
-(defun increment-trace-level 27891,1269642
-(defun trace$-def 27897,1269823
-(defun trace$-install 28073,1278009
-(defun oneified-def 28105,1279331
-(defun trace$-fn-general 28121,1279950
-(defun trace$-fn-simple 28313,1289160
-(defconst *trace-keywords*28316,1289259
-(defconst *trace-keywords-needing-ttag*28325,1289507
-(defun all-keywords-p 28332,1289730
-(defun first-assoc-keyword 28338,1289890
-(defconst *illegal-trace-spec-fmt-string*28346,1290169
-(defun trace$-fn 28351,1290397
-(defun trace$-lst 28385,1292189
-(defmacro trace$ 28396,1292534
-(defmacro with-ubt! 28924,1316150
-(defmacro trace! 28944,1316966
-(defmacro untrace$ 29185,1324461
-(defun open-trace-file-fn 29209,1325179
-(defmacro open-trace-file 29235,1326279
-(defun close-trace-file-fn 29256,1326904
-(defmacro close-trace-file 29269,1327406
-(defmacro break-on-error 29285,1327875
-(defun defexec-extract-key 29386,1332788
-(defun parse-defexec-dcls-1 29408,1333832
-(defun fix-exec-xargs 29531,1339273
-(defun parse-defexec-dcls 29560,1340522
-(defmacro defexec 29632,1344122
-(defrec sar 29887,1355451
-(defun applicable-rewrite-rules1 29902,1356295
-(defun applicable-linear-rules1 29962,1358887
-(defun pc-relieve-hyp 30014,1360955
-(defun pc-relieve-hyps1 30096,1364453
-(defun pc-relieve-hyps 30136,1366425
-(defun remove-trivial-lits 30149,1367024
-(defun unrelieved-hyps 30172,1368073
-(defun untranslate-subst-abb 30196,1369089
-(defun show-rewrite-linear 30203,1369357
-(defun show-rewrites-linears 30296,1374078
-(defun expand-assumptions-1 30369,1377177
-(defun expand-assumptions 30384,1377821
-(defun hyps-type-alist 30394,1378052
-(defun show-rewrites-linears-fn 30408,1378713
-(defun show-meta-lemmas1 30508,1383459
-(defun show-meta-lemmas 30565,1386089
-(defun decoded-type-set-from-tp-rule 30575,1386504
-(defun show-type-prescription-rule 30595,1387268
-(defun show-type-prescription-rules1 30635,1389283
-(defun show-type-prescription-rules 30657,1390323
-(defun pl2-fn 30689,1391749
-(defun pl-fn 30747,1394666
-(defmacro pl 30784,1396179
-(defmacro pl2 30830,1398394
-(defun acl2-defaults-table-local-ctx-p 30916,1403189
-(defun add-include-book-dir-fn 30923,1403452
-(defun delete-include-book-dir-fn 31015,1407891
-(defun add-custom-keyword-hint-fn 31070,1410405
-(defmacro reset-prehistory 31158,1414320
-(defmacro reset-prehistory 31163,1414411
-(defun checkpoint-world 31219,1416780
-(defvar *checkpoint-world-len-and-alist-stack*31226,1416886
-(defmacro checkpoint-world-len-and-alist 31229,1416941
-(defun checkpoint-world1 31232,1417035
-(defun checkpoint-world 31258,1418142
-(defun reset-kill-ring 31270,1418421
-(defun reset-prehistory-fn 31309,1420061
-(defun memoize-table-chk-commutative 31371,1422888
-(defun memoize-table-chk 31422,1425339
-(defun remove-stobjs-in-by-position 31623,1435132
-(defun alist-to-doublets 31634,1435613
-(defun print-gv1 31640,1435819
-(defun print-gv-fn 31662,1436555
-(defmacro print-gv 31692,1437741
-(defun disable-iprint-ar 31854,1443171
-(defun enable-iprint-ar 31877,1444327
-(defconst *iprint-actions*31895,1445122
-(defun set-iprint-fn1 31898,1445189
-(defun set-iprint-fn 31927,1446207
-(defun set-iprint-hard-bound 31939,1446670
-(defun set-iprint-soft-bound 31952,1447141
-(defmacro set-iprint 31965,1447612
-(defconst *evisc-tuple-sites*32196,1457711
-(defun set-site-evisc-tuple 32199,1457783
-(defun chk-evisc-tuple 32229,1459271
-(defun set-evisc-tuple-lst 32238,1459596
-(defun set-evisc-tuple-fn1 32249,1460044
-(defun iprint-virginp 32292,1462001
-(defun set-evisc-tuple-fn 32299,1462266
-(defmacro set-evisc-tuple 32365,1465289
-(defmacro top-level 32479,1471022
-(defun translate-defattach-helpers 33149,1507869
-(defconst *defattach-keys*33207,1510313
-(defun defattach-unknown-constraints-error 33213,1510450
-(defun intersection-domains 33225,1510993
-(defun process-defattach-args1 33235,1511314
-(defun duplicate-keysp-eq 33536,1527007
-(defun split-at-first-keyword 33546,1527309
-(defun filter-for-attachment 33561,1527809
-(defconst *defattach-keys-plus-skip-checks*33583,1528944
-(defun process-defattach-args 33586,1529029
-(defun prove-defattach-guards1 33715,1535063
-(defun prove-defattach-guards 33781,1538210
-(defun defattach-constraint-rec 33810,1539481
-(defun defattach-constraint 33879,1542629
-(defun prove-defattach-constraint 33889,1543097
-(defun attachment-component-owner 34140,1556287
-(defun intersection1-eq 34169,1557761
-(defun defattach-component-has-owner 34178,1558094
-(defun defattach-merge-into-component 34194,1558886
-(defun defattach-merge-components 34310,1562852
-(defun defattach-merge 34352,1564768
-(defun defattach-merge-lst 34376,1565735
-(defun defattach-merge-lst-lst 34394,1566498
-(defun defattach-loop-error-msg 34420,1567788
-(defun defattach-loop-error 34429,1568104
-(defun defattach-close 34436,1568387
-(defun defattach-erase-components 34445,1568721
-(defun defattach-erase-p 34476,1570342
-(defun defattach-erase1 34494,1571174
-(defun defattach-erase 34529,1572674
-(defun collect-ext-anc 34549,1573691
-(defun extend-attachment-components 34560,1574076
-(defun component-path-extension 34600,1576125
-(defun extend-attachment-record 34617,1576957
-(defun update-attachment-records1 34654,1578632
-(defun update-attachment-records 34685,1580172
-(defun attachment-records 34722,1582088
-(defun chk-defattach-loop 34738,1582699
-(defun defaxiom-supporter-msg-list 34773,1584288
-(defun chk-acceptable-defattach 34783,1584792
-(defun attachment-cltl-cmd 34894,1590273
-(defun defattach-fn 34908,1590837
-(defun chk-return-last-entry 34991,1595180
-(defdoc return-last-table35053,1598070
-(defmacro defmacro-last 35079,1599372
-(defdoc printing-to-strings35102,1600269
-(defconst *fmt-control-defaults*35160,1603112
-(defconst *fixed-fmt-controls*35184,1604224
-(defun fmt-control-bindings1 35193,1604484
-(defun fmt-control-bindings 35217,1605605
-(defun set-iprint-ar 35222,1605772
-(defmacro channel-to-string 35230,1606036
-(defun fms-to-string-fn 35337,1610579
-(defmacro fms-to-string 35342,1610811
-(defun fms!-to-string-fn 35346,1611020
-(defmacro fms!-to-string 35351,1611254
-(defun fmt-to-string-fn 35355,1611465
-(defmacro fmt-to-string 35360,1611697
-(defun fmt!-to-string-fn 35364,1611906
-(defmacro fmt!-to-string 35370,1612170
-(defun fmt1-to-string-fn 35374,1612381
-(defmacro fmt1-to-string 35380,1612653
-(defun fmt1!-to-string-fn 35385,1612903
-(defmacro fmt1!-to-string 35391,1613175
-(defdoc dead-events35403,1613812
-(defun attachment-pairs 35544,1621578
-(defun sibling-attachments 35556,1621914
-(defun extended-ancestors4 35562,1622077
-(defun extended-ancestors3 35573,1622441
-(defun extended-ancestors2 35588,1622981
-(defun canonical-cdrs 35610,1624081
-(defun extended-ancestors1 35617,1624332
-(defun attachment-records-fal 35640,1625500
-(defun extended-ancestors 35648,1625822
-(defun ext-anc-attachment-missing 35662,1626358
-(defun ext-anc-attachments-valid-p-1 35672,1626635
-(defun ext-anc-attachments-valid-p 35683,1627009
-(defconst *inline-suffix* 35710,1628210
-(defconst *inline-suffix-len-minus-1* 35711,1628247
-(defconst *notinline-suffix* 35712,1628316
-(defconst *notinline-suffix-len-minus-1* 35713,1628359
-(defconst *non-stobj-var-root* 35714,1628434
-(defun defun-inline-form 35716,1628511
-(defmacro defun-inline 35746,1629762
-(defmacro defund-inline 35864,1635257
-(defmacro defun-notinline 35878,1635704
-(defmacro defund-notinline 35900,1636752
-(defun regenerate-tau-database-fn0 35914,1637215
-(defun regenerate-tau-database-fn135958,1639348
-(defun regenerate-tau-database-fn 36029,1642852
-(defun rational-to-decimal-string 36075,1644574
-(defvar *time-tracker-alist* 36090,1645134
-(defvar *time-tracker-disabled-p* 36092,1645169
-(defstruct time-tracker36094,1645209
-(defun tt-print-msg 36123,1646499
-(defun tt-init 36138,1647072
-(defun tt-end 36181,1648764
-(defun tt-print? 36191,1649104
-(defun tt-stop 36243,1651532
-(defun tt-start 36265,1652399
-(defun program-declared-p1 36288,1653282
-(defun program-declared-p 36298,1653619
-(defmacro defund 36310,1654038
-(defmacro defund 36366,1656222
-(defun magic-ev-fncall-cl-proc 36375,1656632
-(defun-overrides magic-ev-fncall 36400,1657321
-
-ld.lisp,13208
-(defun default-print-prompt 27,1032
-(defun print-prompt 133,5763
-(defun initialize-timers 164,6996
-(defun maybe-add-command-landmark 171,7199
-(defun replace-last-cdr 230,9917
-(defun ld-standard-oi-missing 235,10077
-(defun chk-acceptable-ld-fn1-pair 248,10704
-(defun close-channels 400,17494
-(defun chk-acceptable-ld-fn1 435,19081
-(defun chk-acceptable-ld-fn 555,25471
-(defun f-put-ld-specials 596,27392
-(defun f-get-ld-specials 656,29897
-(defun ld-read-keyword-command1 698,31607
-(defun exit-ld 717,32331
-(defun macro-minimal-arity1 726,32646
-(defun macro-minimal-arity 733,32849
-(defun ld-read-keyword-command 739,33104
-(defun ld-read-command 811,36066
-(deflabel acl2-customization847,37907
-(deflabel keyword-commands924,42058
-(defun ld-print-command 979,44529
-(defun ld-filter-command 1001,45110
-(defun-one-output ppr? 1025,46360
-(defun ld-print-results 1038,46733
-(defun ld-print-prompt 1147,51370
-(defun good-bye-fn 1163,51957
-(defmacro good-bye 1169,52085
-(defun ld-return-error 1206,53303
-(defun initialize-accumulated-warnings 1214,53559
-(defun ld-read-eval-print 1219,53664
-(defun ld-loop 1353,59853
-(defvar *first-entry-to-ld-fn-body-flg*)1379,60994
-(defun update-cbd 1381,61036
-(defun ld-fn-body 1416,62650
-(defun ld-fn1 1511,67073
-(defun ld-fn-alist 1551,68997
-(defmacro with-interrupts 1583,70499
-(defun ld-fn0 1600,70999
-(defun ld-fn 1785,81011
-(defmacro ld 1845,83353
-(defdoc calling-ld-in-bad-contexts2166,101206
-(defmacro quick-test 2205,103084
-(defun wormhole-prompt 2229,103968
-(defun reset-ld-specials-fn 2241,104470
-(defmacro reset-ld-specials 2254,105010
-(defun maybe-reset-defaults-table12283,106333
-(defun maybe-reset-defaults-table22322,108008
-(defun maybe-reset-defaults-table 2331,108354
-(defun delete-something 2336,108656
-(defun store-in-kill-ring 2346,108983
-(defun rotate-kill-ring1 2366,109999
-(defun rotate-kill-ring 2371,110166
-(defun ubt-ubu-fn1 2383,110712
-(defun ubt-ubu-fn 2439,112864
-(defun ubt!-ubu!-fn 2491,115262
-(defmacro ubt-prehistory 2508,115719
-(defun ubt-prehistory-fn 2521,116168
-(defun oops-warning 2557,117763
-(defun oops-fn 2571,118333
-(defmacro oops 2598,119644
-(defmacro i-am-here 2695,124074
-(defun rebuild-fn-read-filter 2729,125188
-(defun rebuild-fn 2761,126658
-(defmacro rebuild 2787,127486
-(defconst *basic-sweep-error-str*2993,138098
-(defun sweep-symbol-binding-for-bad-symbol 3000,138472
-(defun sweep-global-lst 3022,139489
-(defun sweep-stack-entry-for-bad-symbol 3031,139809
-(defun sweep-t-stack 3054,140866
-(defun sweep-acl2-oracle 3062,141180
-(defun sweep-global-state-for-lisp-objects 3077,141714
-(deflabel compilation3123,143408
-(defdoc book-compiled-file3170,145569
-(deflabel escape-to-common-lisp3262,151245
-(deflabel copyright3277,151677
-(deflabel acknowledgments3305,152680
-(deflabel breaks3451,159931
-(deflabel saving-and-restoring3496,162084
-(deflabel ordinals3509,162646
-(defmacro wet 3651,169663
-(defmacro disassemble$ 3833,178187
-(deflabel release-notes3891,180878
-(deflabel note13903,181198
-(deflabel note23924,181827
-(deflabel note33958,183454
-(deflabel note44060,189292
-(deflabel note54221,196332
-(deflabel note64468,208647
-(deflabel note74593,214020
-(deflabel note84792,222755
-(deflabel note8-update5139,238551
-(deflabel note95199,240770
-(deflabel note-2-05280,243827
-(deflabel note-2-15313,245050
-(deflabel note-2-25331,245430
-(deflabel note-2-35393,248316
-(deflabel note-2-45453,250613
-(deflabel note-2-55499,252166
-(deflabel |NOTE-2-5(5829,268570
-(deflabel note-2-65845,268867
-(deflabel note-2-6-new-functionality5864,269523
-(deflabel note-2-6-proofs6047,278564
-(deflabel note-2-6-rules6159,284274
-(deflabel note-2-6-guards6230,287636
-(deflabel note-2-6-proof-checker6298,290672
-(deflabel note-2-6-system6324,291581
-(deflabel note-2-6-other6371,293749
-(deflabel |NOTE-2-6(6491,299306
-(deflabel note-2-76507,299633
-(deflabel note-2-7-bug-fixes6594,303172
-(deflabel note-2-7-new-functionality6881,317633
-(deflabel note-2-7-proofs7037,325587
-(deflabel note-2-7-rules7139,331062
-(deflabel note-2-7-guards7160,331982
-(deflabel note-2-7-proof-checker7190,332802
-(deflabel note-2-7-system7201,333085
-(deflabel note-2-7-other7271,336162
-(deflabel |NOTE-2-7(7444,344462
-(deflabel note-2-87469,345226
-(deflabel note-2-8-bug-fixes7632,352221
-(deflabel note-2-8-new-functionality8082,373272
-(deflabel note-2-8-proofs8228,381421
-(deflabel note-2-8-rules8305,385670
-(deflabel note-2-8-guards8346,387430
-(deflabel note-2-8-proof-checker8357,387652
-(deflabel note-2-8-system8390,389318
-(deflabel note-2-8-ordinals8419,390602
-(deflabel note-2-8-other8427,390750
-(deflabel |NOTE-2-8(8503,393902
-(deflabel note-2-98520,394375
-(deflabel |NOTE-2-9(9108,419946
-(deflabel note-2-9-19123,420273
-(deflabel note-2-9-29337,429618
-(deflabel note-2-9-39559,439366
-(deflabel note-2-9-3-ppr-change9791,449938
-(deflabel note-2-9-410069,458469
-(deflabel note-2-9-510452,477788
-(deflabel note-3-010807,494560
-(deflabel |NOTE-3-0(10834,495578
-(deflabel note-3-0-110849,495881
-(deflabel |NOTE-3-0-1(11176,512595
-(deflabel note-3-0-211191,512908
-(deflabel note-3-111706,535340
-(deflabel |NOTE-3-1(11721,535745
-(deflabel note-3-211737,536053
-(deflabel |NOTE-3-2(12404,565231
-(deflabel note-3-2-112431,566128
-(deflabel |NOTE-3-2-1(12707,579611
-(deflabel note-3-312720,579809
-(deflabel |NOTE-3-3(13223,602978
-(deflabel note-3-413236,603172
-(deflabel |NOTE-3-4(13987,639221
-(deflabel note-3-514007,639794
-(deflabel |NOTE-3-5(14975,685537
-(deflabel note-3-615053,688506
-(deflabel |NOTE-3-6(15509,707928
-(deflabel note-3-6-115522,708120
-(deflabel note-4-015571,710035
-(deflabel |NOTE-4-0(16612,757914
-(deflabel note-4-0-wormhole-changes16625,758099
-(deflabel note-4-116692,760630
-(deflabel |NOTE-4-1(16852,767799
-(deflabel note-4-216865,767989
-(deflabel |NOTE-4-2(17424,795911
-(deflabel note-4-317437,796099
-(deflabel |NOTE-4-3(18260,830975
-(deflabel note-5-018273,831160
-(deflabel note-6-019502,888018
-(deflabel note-6-120049,914356
-(deflabel note-6-220462,933184
-(deflabel the-method20959,957358
-(deflabel lp21054,962643
-(defun-one-output compiled-function-p! 21122,966233
-(defun compile-function 21134,966689
-(defun getpid$ 21196,968946
-(defun-one-output tmp-filename 21220,969772
-(defun keep-tmp-files 21246,970805
-(defun comp-fn 21249,970876
-(defmacro comp 21364,975166
-(defmacro comp 21369,975237
-(defmacro comp-gcl 21476,980693
-(defun scan-past-deeper-event-landmarks 21495,981421
-(defun puffable-encapsulate-p 21515,982177
-(defun puffable-command-blockp 21526,982591
-(defun puffable-command-numberp 21560,984025
-(defun puff-command-block 21575,984565
-(defun commands-back-to 21713,991268
-(defun puffed-command-sequence 21728,991819
-(defun puff-fn1 21751,992701
-(defun puff-report 21843,997335
-(defun puff-fn 21856,997927
-(defun puff*-fn11 21860,998058
-(defun puff*-fn1 21881,998808
-(defun puff*-fn 21909,1000136
-(defmacro puff 21977,1003194
-(defmacro puff* 22110,1010951
-(defmacro mini-proveall 22188,1014016
-(defmacro exit 22426,1021227
-(defmacro quit 22437,1021421
-(defmacro set-guard-checking 22448,1021615
-(defun dmr-stop-fn 22724,1033679
-(defmacro dmr-stop 22730,1033823
-(defun dmr-start-fn 22734,1033937
-(defmacro dmr-start 22743,1034200
-(defconst *home-page*22747,1034317
-(defconst *home-page-references*23197,1049464
-(deflabel |Pages 23210,1050021
-(deflabel |Undocumented 23233,1051171
-(deflabel |Common 23239,1051343
-(deflabel |An 23289,1053377
-(deflabel |The 23327,1054745
-(deflabel |A 23370,1056760
-(deflabel |About 23413,1058731
-(deflabel |A 23443,1059903
-(deflabel |What 23470,1060949
-(deflabel |About 23497,1061822
-(deflabel |Models 23524,1062606
-(deflabel |The 23549,1063207
-(deflabel |Corroborating 23571,1063921
-(deflabel |Models 23616,1065954
-(deflabel |A 23654,1066952
-(deflabel |Functions 23681,1067836
-(deflabel |Common 23714,1068951
-(deflabel |Analyzing 23751,1070480
-(deflabel |What 23791,1071894
-(deflabel |A 23816,1072711
-(deflabel |What 23825,1072925
-(deflabel |What 23847,1073733
-(deflabel |ACL2 23861,1074163
-(deflabel |ACL2 23874,1074633
-(deflabel |ACL2 23905,1075986
-(deflabel |Modeling 23930,1077107
-(deflabel |Running 23956,1077903
-(deflabel |Symbolic 23988,1078993
-(deflabel |Proving 24013,1079611
-(deflabel |What 24050,1080912
-(deflabel |How 24081,1081852
-(deflabel |Other 24103,1082780
-(deflabel |The 24132,1083531
-(deflabel |An 24149,1083877
-(deflabel |How 24200,1086096
-(deflabel |How 24230,1087260
-(deflabel |The 24263,1088565
-(deflabel |A 24308,1089988
-(deflabel |Revisiting 24327,1090653
-(deflabel |Evaluating 24368,1092080
-(deflabel |Conversion|24410,1093056
-(deflabel |The 24441,1094516
-(deflabel |The 24483,1095910
-(deflabel |Free 24515,1097196
-(deflabel |The 24559,1098912
-(deflabel |Name 24616,1101816
-(deflabel |Perhaps|24625,1102081
-(deflabel |Suggested 24634,1102316
-(deflabel |Subsumption 24657,1102987
-(deflabel |Flawed 24680,1103701
-(deflabel |The 24703,1104359
-(deflabel |The 24724,1105099
-(deflabel |The 24753,1105915
-(deflabel |The 24774,1106445
-(deflabel |The 24785,1106795
-(deflabel |Nontautological 24798,1107257
-(deflabel |Overview 24809,1107703
-(deflabel |On 24840,1108848
-(deflabel |Overview 24852,1109310
-(deflabel |The 24865,1109912
-(deflabel |The 24884,1110532
-(deflabel |The 24904,1111182
-(deflabel |Overview 24925,1111786
-(deflabel |The 24936,1112323
-(deflabel |The 24954,1112908
-(deflabel |The 24980,1113972
-(deflabel |The 25001,1114663
-(deflabel |The 25020,1115294
-(deflabel |The 25042,1116124
-(deflabel |The 25064,1116899
-(deflabel |The 25086,1117645
-(deflabel |The 25108,1118364
-(deflabel |The 25130,1119177
-(deflabel |The 25154,1120050
-(deflabel |The 25174,1120752
-(deflabel |The 25193,1121385
-(deflabel |Overview 25213,1121925
-(deflabel |Overview 25241,1122766
-(deflabel |Overview 25250,1123159
-(deflabel |The 25260,1123524
-(deflabel |The 25278,1124128
-(deflabel |The 25295,1124667
-(deflabel |The 25311,1125123
-(deflabel |The 25330,1125664
-(deflabel |Popping 25360,1126548
-(deflabel |The 25370,1126928
-(deflabel |The 25379,1127211
-(deflabel |The 25394,1127954
-(deflabel |Guiding 25410,1128645
-(deflabel |Rewrite 25437,1129628
-(deflabel |You 25471,1130587
-(deflabel |Using 25501,1131595
-(deflabel |Overview 25521,1132231
-(deflabel |The 25572,1133906
-(deflabel |The 25593,1134791
-(deflabel |A 25612,1135495
-(deflabel |The 25646,1136734
-(deflabel |The 25658,1137110
-(deflabel |ACL2 25691,1138199
-(deflabel |Hey 25718,1139325
-(deflabel |Guards|25743,1140275
-(deflabel |About 25780,1142010
-(deflabel |The 25848,1145733
-(deflabel |About 25895,1148035
-(deflabel |About 25926,1149681
-(deflabel |Numbers 25971,1152049
-(deflabel |ACL2 26026,1154350
-(deflabel |ACL2 26045,1155175
-(deflabel |ACL2 26063,1156023
-(deflabel |ACL2 26108,1158697
-(deflabel |Guessing 26141,1160208
-(defconst *meta-level-function-problem-1*26186,1162177
-(defconst *meta-level-function-problem-1a*26190,1162376
-(defconst *meta-level-function-problem-1b*26194,1162586
-(defconst *meta-level-function-problem-1c*26199,1162813
-(defconst *meta-level-function-problem-1d*26205,1163142
-(defconst *meta-level-function-problem-1e*26212,1163503
-(defconst *meta-level-function-problem-2*26218,1163821
-(defconst *meta-level-function-problem-3*26225,1164175
-(defun acl2-magic-mfc 26245,1165368
-(defun mfc-ts-raw 26299,1167262
-(defun mfc-rw-raw 26381,1170900
-(defun mfc-relieve-hyp-raw 26463,1175116
-(defun-one-output mfc-ap-raw 26571,1180656
-(defmacro mfc-ts 26677,1186852
-(defmacro mfc-rw 26686,1187173
-(defmacro mfc-rw+ 26704,1188015
-(defmacro mfc-relieve-hyp 26713,1188410
-(defmacro mfc-ap 26724,1188906
-(defun congruence-rule-listp 26729,1189082
-(defun term-alistp-failure-msg 26742,1189546
-(defun find-runed-linear-lemma 26759,1190248
-(defun mfc-force-flg 26770,1190592
-(defun update-rncst-for-forcep 26775,1190740
-(defun trans-eval-lst 26825,1192887
-(defun print-saved-output 26831,1193103
-(defmacro pso 26874,1194977
-(defmacro psog 26889,1195452
-(defmacro pso! 26903,1195837
-(defdoc nil-goal26918,1196322
-(defmacro set-saved-output 26957,1198599
-(defmacro set-raw-proof-format 27062,1204362
-(defmacro set-print-clause-ids 27089,1205429
-(defun set-standard-co-state 27137,1207456
-(defun set-proofs-co-state 27146,1207791
-(defmacro with-standard-co-and-proofs-co-to-file 27155,1208120
-(defmacro wof 27179,1208967
-(defmacro psof 27205,1209829
-(defun set-gag-mode-fn 27240,1211534
-(defmacro set-gag-mode 27271,1212666
-(defparameter *initial-cbd* 27381,1218065
-(defun save-exec 27383,1218099
-(deflabel about-acl227474,1221737
-(defun defun-for-state-name 27501,1222556
-(defmacro defun-for-state 27506,1222686
-(defun set-ld-evisc-tuple 27516,1223012
-(defun-for-state set-ld-evisc-tuple 27521,1223139
-(defun set-abbrev-evisc-tuple 27523,1223189
-(defun-for-state set-abbrev-evisc-tuple 27528,1223324
-(defun set-gag-mode-evisc-tuple 27530,1223378
-(defun-for-state set-gag-mode-evisc-tuple 27535,1223517
-(defun set-term-evisc-tuple 27537,1223573
-(defun-for-state set-term-evisc-tuple 27542,1223704
-(defun without-evisc-fn 27544,1223756
-(defmacro without-evisc 27555,1224159
-
-proof-checker-b.lisp,10417
-(defmacro install-new-pc-meta-or-macro 23,881
-(defun define-pc-meta-or-macro-fn 27,1084
-(defmacro define-pc-meta 41,1553
-(defmacro define-pc-macro 56,2123
-(defmacro define-pc-atomic-macro 95,3725
-(defmacro toggle-pc-macro 98,3857
-(defmacro define-pc-primitive 126,4867
-(define-pc-primitive comment 150,5925
-(defun non-bounded-nums 169,6340
-(defun delete-by-position 182,6807
-(define-pc-primitive drop 192,7191
-(define-pc-meta lisp 232,8583
-(define-pc-primitive fail-primitive 296,11125
-(define-pc-macro fail 300,11213
-(define-pc-macro illegal 322,11807
-(defun chk-assumption-free-ttree-1 344,12485
-(defun put-cdr-assoc-query-id 358,12997
-(defun set-query-val 364,13251
-(defmacro query-on-exit 377,13662
-(defun replay-query 380,13760
-(define-pc-meta exit 393,14482
-(define-pc-meta undo 557,23037
-(define-pc-meta restore 611,25007
-(defun print-commands 642,26110
-(defun make-pretty-start-instr 657,26708
-(defun raw-indexed-instrs 667,27066
-(define-pc-macro sequence-no-restore 684,28051
-(define-pc-macro skip 687,28155
-(defmacro define-pc-help 700,28401
-(defun evisc-indexed-instrs-1 735,29742
-(defun evisc-indexed-instrs-rec 747,30285
-(defun mark-unfinished-instrs 767,31258
-(defun evisc-indexed-instrs 783,32054
-(define-pc-help commands 789,32322
-(define-pc-macro comm 831,33959
-(defun promote-guts 887,36275
-(define-pc-primitive promote 899,36651
-(defun remove-by-indices 938,38349
-(define-pc-macro print 950,38915
-(defun bounded-integer-listp 982,40156
-(defun fetch-term-and-cl 995,40571
-(defun fetch-term 1037,42711
-(defun governors 1047,43038
-(defun term-id-iff 1055,43330
-(defmacro ? 1103,45606
-(defstub ?-fn 1106,45638
-(defun abbreviations-alist 1113,45848
-(defun chk-?s 1122,46111
-(defun chk-?s-lst 1143,46989
-(defun remove-?s 1151,47178
-(defun translate-abb 1156,47365
-(defmacro trans0 1169,47696
-(defun p-body 1172,47809
-(define-pc-help p 1180,48161
-(define-pc-help pp 1203,48857
-(defun take-by-indices 1222,49379
-(defun print-hyps 1231,49748
-(defun some-> 1244,50375
-(defun print-hyps-top 1253,50622
-(defun print-governors-top 1262,50987
-(defun pair-indices 1271,51346
-(define-pc-macro hyps 1287,52014
-(define-pc-primitive demote 1405,57392
-(defun pair-keywords 1461,59695
-(defun null-pool 1476,60332
-(defun initial-pspv 1483,60499
-(defun pc-prove 1491,60816
-(defun sublis-equal 1514,61855
-(defun abbreviations-alist-? 1524,62138
-(defun find-?-fn 1534,62541
-(defun unproved-pc-prove-clauses 1544,62849
-(defun prover-call 1547,62947
-(defun make-new-goals 1620,67251
-(defun same-goal 1632,67763
-(defun remove-byes-from-tag-tree 1638,67959
-(define-pc-primitive prove 1641,68042
-(defun add-string-val-pair-to-string-val-alist 1723,71420
-(defconst *bash-skip-forcing-round-hints*1741,72221
-(define-pc-atomic-macro bash 1759,72731
-(define-pc-primitive dive 1811,74781
-(define-pc-atomic-macro split 1872,77210
-(define-pc-primitive add-abbreviation 1914,78936
-(defun not-in-domain-eq 1980,81959
-(define-pc-primitive remove-abbreviations 1991,82325
-(defun print-abbreviations 2033,84056
-(define-pc-help show-abbreviations 2077,85740
-(defun drop-from-end 2112,87093
-(define-pc-primitive up 2119,87333
-(define-pc-atomic-macro top 2159,89092
-(defmacro expand-address-recurse2179,89808
-(defmacro dive-once-more-error 2194,90359
-(defun abbreviation-raw-term-p 2201,90632
-(defmacro addr-recur 2205,90710
-(defun or-addr 2220,91231
-(defun and-addr 2270,93105
-(defmacro add-dive-into-macro 2328,95558
-(defmacro remove-dive-into-macro 2343,96029
-(defun dive-into-macros-table 2359,96593
-(defun rassoc-eq-as-car 2403,98411
-(defun expand-address 2409,98588
-(defmacro dv-error 2771,116530
-(define-pc-atomic-macro dv 2781,116874
-(defun deposit-term 2878,120115
-(defun deposit-term-lst 2888,120468
-(defun geneqv-at-subterm 2906,121183
-(defun geneqv-at-subterm-top 2925,121954
-(defun maybe-truncate-current-address 2968,123766
-(defun deposit-term-in-goal 2996,124995
-(defun split-implies 3015,125758
-(defun equiv-refinementp 3028,126221
-(defun find-equivalence-hyp-term 3032,126362
-(defun flatten-ands-in-lit-lst 3053,127250
-(define-pc-primitive equiv 3059,127402
-(define-pc-primitive casesplit3171,132803
-(define-pc-macro top? 3268,137268
-(define-pc-macro contrapose-last 3274,137379
-(define-pc-macro drop-last 3282,137652
-(define-pc-macro drop-conc 3290,137907
-(define-pc-atomic-macro claim 3293,137993
-(define-pc-atomic-macro induct 3360,140977
-(defun print-on-separate-lines 3399,142440
-(define-pc-help goals 3409,142853
-(defun modified-error-triple-for-sequence 3428,143406
-(define-pc-meta sequence3465,145266
-(define-pc-macro negate 3591,151912
-(define-pc-macro succeed 3613,152577
-(define-pc-macro do-all 3635,153199
-(define-pc-macro do-strict 3662,154146
-(define-pc-macro do-all-no-prompt 3680,154683
-(define-pc-macro th 3698,155256
-(define-pc-macro protect 3730,156491
-(defun extract-goal 3749,157093
-(define-pc-primitive change-goal 3759,157472
-(define-pc-macro cg 3812,159721
-(defun change-by-position 3828,160130
-(define-pc-primitive contrapose 3838,160494
-(define-pc-macro contradict 3878,162288
-(define-pc-atomic-macro pro 3887,162463
-(define-pc-atomic-macro nx 3902,162838
-(define-pc-atomic-macro bk 3927,163691
-(define-pc-help p-top 3958,164782
-(define-pc-macro repeat 3996,166349
-(define-pc-macro repeat-rec 4014,166823
-(defmacro define-pc-bind 4022,166983
-(define-pc-bind quiet4039,167689
-(define-pc-bind noise 4057,168097
-(defun find-equivalence-hyp-term-no-target 4076,168741
-(define-pc-atomic-macro if-not-proved 4102,170005
-(define-pc-atomic-macro = =
4121,170694
-(define-pc-macro set-success 4323,180728
-(define-pc-macro orelse 4326,180817
-(defun applicable-rewrite-rules 4346,181412
-(define-pc-help show-rewrites 4365,182377
-(define-pc-macro sr 4409,184480
-(define-pc-help show-linears 4424,184771
-(define-pc-macro sls 4455,186002
-(define-pc-macro pl 4472,186494
-(define-pc-macro pr 4506,187749
-(define-pc-help show-type-prescriptions 4540,189004
-(define-pc-macro st 4567,190093
-(defun translate-subst-abb1 4582,190407
-(defun single-valued-symbolp-alistp 4605,191541
-(defun check-cars-are-variables 4612,191763
-(defun translate-subst-abb 4631,192541
-(defun make-rewrite-instr 4662,193825
-(define-pc-primitive rewrite 4669,194089
-(defun applicable-linear-rules 4920,207264
-(defun make-linear-instr 4934,207839
-(define-pc-primitive apply-linear 4941,208101
-(define-pc-macro al 5186,220726
-(defun pc-help-fn 5199,220959
-(defmacro state-only 5245,223157
-(define-pc-help help 5251,223291
-(defun pc-help!-fn 5316,225968
-(define-pc-help help! 5358,227886
-(define-pc-macro help-long 5372,228388
-(define-pc-help more 5383,228656
-(define-pc-help more! 5395,228913
-(defun pc-rewrite*-15406,229225
-(defun pc-rewrite*5450,231305
-(defun make-goals-from-assumptions 5464,231852
-(defun make-new-goals-from-assumptions 5477,232428
-(defconst *default-s-repeat-limit* 5487,232749
-(define-pc-primitive s 5489,232789
-(defun build-pc-enabled-structure-from-ens 5746,244997
-(define-pc-primitive in-theory 5773,246256
-(define-pc-atomic-macro s-prop 5865,250401
-(define-pc-atomic-macro x 5888,251160
-(define-pc-primitive expand 5947,253483
-(define-pc-atomic-macro x-dumb 6044,257175
-(define-pc-macro bookmark 6059,257587
-(defun change-last 6080,258313
-(defun assign-event-name-and-rule-classes 6088,258490
-(defun save-fn 6104,259290
-(define-pc-macro save 6113,259522
-(defmacro retrieve 6161,261595
-(define-pc-macro retrieve 6179,261999
-(defun unsave-fn 6205,263024
-(defmacro unsave 6209,263126
-(define-pc-help unsave 6227,263498
-(defun show-retrieved-goal 6261,264888
-(defun retrieve-fn 6271,265285
-(defun print-all-goals 6316,267270
-(define-pc-help print-all-goals 6322,267430
-(defmacro print-conc 6334,267729
-(defun print-all-concs 6346,268210
-(define-pc-help print-all-concs 6353,268416
-(defun gen-var-marker 6366,268753
-(defun translate-generalize-alist-1 6371,268842
-(defun non-gen-var-markers 6426,270927
-(defun find-duplicate-generalize-entries 6435,271215
-(defun translate-generalize-alist-2 6444,271528
-(defun translate-generalize-alist 6455,271995
-(defun all-vars-goals 6473,272918
-(defun pc-state-vars 6480,273173
-(define-pc-primitive generalize 6484,273358
-(define-pc-atomic-macro use 6551,276209
-(define-pc-atomic-macro clause-processor 6579,277160
-(define-pc-macro cl-proc 6609,278121
-(defun fromto 6618,278374
-(define-pc-atomic-macro retain 6624,278513
-(define-pc-atomic-macro reduce 6658,279643
-(define-pc-macro run-instr-on-goal 6702,281291
-(defun run-instr-on-goals-guts 6713,281547
-(define-pc-macro run-instr-on-new-goals 6720,281796
-(define-pc-macro then 6733,282263
-(defun print-help-separator 6758,283109
-(defun print-pc-help-rec 6763,283241
-(defun print-all-pc-help-fn 6775,283546
-(defmacro print-all-pc-help 6791,284229
-(define-pc-macro nil 6794,284341
-(define-pc-atomic-macro free 6822,285376
-(define-pc-macro replay 6845,286044
-(defun instr-name 6889,287969
-(defun pc-free-instr-p 6895,288105
-(defun find-possible-put 6900,288274
-(define-pc-macro put 6912,288760
-(define-pc-macro reduce-by-induction 6954,290574
-(define-pc-macro r 6996,292170
-(define-pc-atomic-macro sl 7008,292378
-(define-pc-atomic-macro elim 7040,293649
-(define-pc-macro ex 7059,294293
-(defun save-fc-report-settings 7074,294612
-(defun restore-fc-report-settings 7089,295098
-(define-pc-help type-alist 7104,295611
-(define-pc-help print-main 7207,300349
-(define-pc-macro pso 7219,300587
-(define-pc-macro psog 7239,301296
-(define-pc-macro pso! 7260,302033
-(define-pc-macro acl2-wrap 7281,302782
-(defmacro acl2-wrap 7297,303145
-(define-pc-macro check-proved-goal 7304,303295
-(define-pc-macro check-proved 7312,303544
-(define-pc-atomic-macro forwardchain 7320,303725
-(define-pc-atomic-macro bdd 7404,306924
-(define-pc-macro runes 7428,307750
-(define-pc-macro lemmas-used 7449,308560
-(defun goal-terms 7457,308731
-(defun wrap1-aux1 7468,309032
-(defun wrap1-aux2 7489,309930
-(define-pc-primitive wrap1 7504,310531
-(define-pc-atomic-macro wrap 7583,313845
-(define-pc-atomic-macro wrap-induct 7629,315802
-(define-pc-macro finish-error 7661,316719
-(define-pc-macro finish 7666,316871
-(defun show-geneqv 7687,317597
-(define-pc-macro geneqv 7695,317941
-(defun goals-to-clause-list 7729,319650
-(defun proof-checker-clause-list 7736,319894
-(defun proof-checker-cl-proc 7739,319970
-
-tutorial.lisp,4176
-(deflabel ACL2-Tutorial45,1562
-(deflabel alternative-introduction111,4534
-(deflabel annotated-acl2-scripts743,34484
-(deflabel Emacs811,37396
-(deflabel ACL2-As-Standalone-Program825,37884
-(deflabel acl2-sedan931,40895
-(deflabel solution-to-simple-example953,41995
-(deflabel Tutorial1-Towers-of-Hanoi1009,43994
-(deflabel Tutorial2-Eights-Problem1267,53213
-(deflabel Tutorial3-Phonebook-Example1396,57390
-(deflabel Tutorial4-Defun-Sk-Example2222,89653
-(deflabel Tutorial5-Miscellaneous-Examples2323,93583
-(deflabel file-reading-example2333,93863
-(deflabel guard-example2389,96296
-(deflabel mutual-recursion-proof-example2699,105463
-(deflabel functional-instantiation-example2847,111876
-(deflabel Startup2992,116769
-(deflabel Tidbits3077,119680
-(deflabel Tips3161,123247
-(deflabel introduction-to-the-theorem-prover3623,144893
-(deflabel dealing-with-key-combinations-of-function-symbols3956,161983
-(deflabel post-induction-key-checkpoints4138,169872
-(deflabel generalizing-key-checkpoints4187,172148
-(deflabel strong-rewrite-rules4282,176104
-(deflabel practice-formulating-strong-rules4376,180114
-(deflabel practice-formulating-strong-rules-14440,181925
-(deflabel practice-formulating-strong-rules-24537,186250
-(deflabel practice-formulating-strong-rules-34593,188285
-(deflabel practice-formulating-strong-rules-44720,193180
-(deflabel practice-formulating-strong-rules-54760,194437
-(deflabel practice-formulating-strong-rules-64822,196884
-(deflabel introduction-to-key-checkpoints4930,200843
-(deflabel programming-knowledge-taken-for-granted5090,210273
-(deflabel example-induction-scheme-nat-recursion5381,224315
-(deflabel example-induction-scheme-down-by-25434,225942
-(deflabel example-induction-scheme-on-lists5492,227621
-(deflabel example-induction-scheme-binary-trees5539,228978
-(deflabel example-induction-scheme-on-several-variables5581,230014
-(deflabel example-induction-scheme-upwards5627,231017
-(deflabel example-induction-scheme-with-accumulators5678,232543
-(deflabel example-induction-scheme-with-multiple-induction-steps5761,235398
-(deflabel example-inductions5825,237170
-(deflabel logic-knowledge-taken-for-granted-inductive-proof5884,240004
-(deflabel logic-knowledge-taken-for-granted-base-case6034,247690
-(deflabel logic-knowledge-taken-for-granted-q1-answer6061,248539
-(deflabel logic-knowledge-taken-for-granted-q2-answer6147,252564
-(deflabel logic-knowledge-taken-for-granted-q3-answer6291,257212
-(deflabel logic-knowledge-taken-for-granted-instance6332,258426
-(deflabel logic-knowledge-taken-for-granted-propositional-calculus6372,259774
-(deflabel logic-knowledge-taken-for-granted-rewriting6620,269107
-(deflabel logic-knowledge-taken-for-granted-rewriting-repeatedly6859,279161
-(deflabel logic-knowledge-taken-for-granted-equals-for-equals6953,282609
-(deflabel logic-knowledge-taken-for-granted-evaluation7004,284516
-(deflabel logic-knowledge-taken-for-granted7042,285900
-(deflabel special-cases-for-rewrite-rules7258,294500
-(deflabel equivalent-formulas-different-rewrite-rules7312,296860
-(deflabel introduction-to-rewrite-rules-part-27385,299808
-(deflabel specific-kinds-of-formulas-as-rewrite-rules7624,314123
-(deflabel further-information-on-rewriting7711,318452
-(deflabel introduction-to-rewrite-rules-part-17830,325226
-(deflabel introduction-to-the-database8009,334245
-(deflabel introduction-to-hints8241,346171
-(deflabel introduction-to-a-few-system-considerations8341,351342
-(deflabel architecture-of-the-prover8524,360136
-(deflabel frequently-asked-questions-by-newcomers8605,364193
-(deflabel introductory-challenges9182,396611
-(deflabel introductory-challenge-problem-19218,398163
-(deflabel introductory-challenge-problem-1-answer9251,398974
-(deflabel introductory-challenge-problem-29299,400314
-(deflabel introductory-challenge-problem-2-answer9322,400885
-(deflabel introductory-challenge-problem-39369,402201
-(deflabel introductory-challenge-problem-3-answer9405,403125
-(deflabel introductory-challenge-problem-49524,407130
-(deflabel introductory-challenge-problem-4-answer9581,409402
-(deflabel interesting-applications10163,432053
-(deflabel advanced-features10283,439549
-
-interface-raw.lisp,7813
-(defun-*1* mv-list 676,29373
-(defun-*1* return-last 680,29447
-(defun-*1* wormhole-eval 750,32381
-(defun-*1* acl2-numberp 757,32569
-(defun-*1* binary-* 760,32613
-(defun-*1* binary-+ 768,32797
-(defun-*1* unary-- 779,33071
-(defun-*1* unary-/ 785,33180
-(defun-*1* < 791,33309
-(defun-*1* apply 816,34292
-(defun-*1* bad-atom<=820,34414
-(defun-*1* car 830,34740
-(defun-*1* cdr 838,34843
-(defun-*1* char-code 846,34946
-(defun-*1* characterp 851,35040
-(defun-*1* code-char 854,35085
-(defun-*1* complex 861,35236
-(defun-*1* complex-rationalp 865,35400
-(defun-*1* complexp 871,35541
-(defun-*1* coerce 874,35582
-(defun-*1* cons 888,35912
-(defun-*1* consp 891,35949
-(defun-*1* denominator 894,35984
-(defun-*1* equal 899,36083
-(defun-*1* floor1 903,36147
-(defun-*1* if 912,36351
-(defun-*1* imagpart 917,36552
-(defun-*1* integerp 922,36640
-(defun-*1* intern-in-package-of-symbol 925,36681
-(defun-*1* pkg-imports 931,36863
-(defun-*1* pkg-witness 936,36970
-(defun-*1* numerator 946,37389
-(defun-*1* rationalp 951,37482
-(defun-*1* realp 957,37601
-(defun-*1* realpart 960,37636
-(defun-*1* stringp 965,37724
-(defun-*1* symbol-name 968,37763
-(defun-*1* symbol-package-name 973,37861
-(defun-*1* symbolp 979,38028
-(defun standardp 995,38669
-(defun-*1* standardp 999,38719
-(defun standard-part 1003,38773
-(defun-*1* standard-part 1006,38803
-(defun i-large-integer 1009,38838
-(defun-*1* i-large-integer 1012,38936
-(defun-one-output macroexpand1! 1017,39041
-(defvar *acl2-gentemp-counter* 1023,39211
-(defun-one-output acl2-gentemp 1024,39245
-(defun-one-output oneify-flet-bindings 1036,39685
-(defun-one-output oneify 1063,41009
-(defun-one-output oneify-lst 1266,48996
-(defun-one-output select-stobj 1274,49191
-(defun-one-output super-defstobj-wart-stobjs-in 1279,49375
-(defun-one-output oneify-fail-form 1287,49712
-(defun-one-output get-declared-stobjs 1308,50421
-(defun-one-output warn-for-guard-body 1322,50944
-(defun-one-output create-live-user-stobjp-test 1334,51529
-(defun oneify-cltl-code 1344,51843
-(defvar *saved-raw-prompt* 2088,89063
-(defvar *saved-raw-prompt-p* 2089,89095
-(defun-one-output install-new-raw-prompt 2094,89148
-(defun-one-output install-old-raw-prompt 2101,89418
-(defun-one-output install-new-raw-prompt 2111,89685
-(defun-one-output install-old-raw-prompt 2122,90173
-(defun-one-output install-new-raw-prompt 2132,90447
-(defun-one-output install-old-raw-prompt 2139,90678
-(defun-one-output install-new-raw-prompt 2146,90808
-(defun-one-output install-old-raw-prompt 2158,91360
-(defun-one-output install-new-raw-prompt 2172,91852
-(defun-one-output install-old-raw-prompt 2189,92694
-(defun-one-output install-new-raw-prompt 2207,93337
-(defun-one-output install-old-raw-prompt 2210,93389
-(defvar *dmr-interval* 2223,93743
-(defvar *dmr-interval-acl2-par-hack* 2224,93772
-(defvar *dmr-interval-used*)2225,93817
-(defvar *dmr-indent-max* 2232,94090
-(defvar *dmr-file-name*)2238,94374
-(defun dmr-file-name 2240,94400
-(defparameter *dmr-stream*2253,94998
-(defparameter *dmr-counter*2256,95033
-(defun dmr-acl2-par-hack-p 2265,95263
-(defun dmr-stop-fn-raw 2268,95352
-(defun initialize-dmr-interval-used 2274,95481
-(defun dmr-start-fn-raw 2282,95713
-(defvar *dmr-array*2296,96178
-(defun reverse-into-dmr-array 2299,96262
-(defparameter *dmr-reusable-string*2309,96564
-(defvar *dmr-indent*)2321,96916
-(defmacro dmr-increment-indent 2323,96939
-(defun tilde-@-bkptr-string 2327,97026
-(defvar *dmr-interp-state*2385,99861
-(defun dmr-interp-fresh-rewrite-p 2390,100003
-(defun dmr-prefix 2397,100216
-(defun dmr-interp 2410,100672
-(defvar *dmr-delete-string*2485,103412
-(defun dmr-string 2491,103528
-(defun dmr-flush1 2575,107292
-(defvar *dmr-lock* 2590,107724
-(defun dmr-flush 2592,107757
-(defun dmr-display 2604,108192
-(defun cw-gstack-short 2616,108569
-(defun-one-output fmakunbound! 2771,117320
-(defun-one-output maybe-push-undo-stack 2778,117589
-(defun-one-output maybe-pop-undo-stack 2951,125827
-(defun-one-output flush-undo-stack 2964,126168
-(defparameter *current-acl2-world-key-ordering*3275,142599
-(defun-one-output key-lesseqp 3299,143328
-(defun-one-output merge-into-alist 3308,143604
-(defun-one-output destructive-push-assoc 3320,144175
-(defun-one-output destructive-pop-assoc 3337,145045
-(defun-one-output remove-current-acl2-world-key 3343,145240
-(defun hcomp-init 4139,190426
-(defabbrev reclassifying-value-p 4199,193077
-(defmacro make-reclassifying-value 4206,193230
-(defmacro unmake-reclassifying-value 4212,193360
-(defun hcomp-transfer-to-hash-tables 4218,193472
-(defvar *saved-hcomp-restore-hts* 4262,195292
-(defun hcomp-restore-defs 4264,195332
-(defun missing-compiled-book 4316,197619
-(defun load-compiled-book 4378,200600
-(defun include-book-raw 4506,206320
-(defun include-book-raw-top 4763,219893
-(defmacro hcomp-ht-from-type 4795,221402
-(defmacro hcomp-build-p 4804,221690
-(defun install-for-add-trip-hcomp-build 4809,221877
-(defun install-for-add-trip-include-book 4866,224468
-(defun install-for-add-trip 4952,228499
-(defun install-defs-for-add-trip 4968,229138
-(defun hcomp-build-from-portcullis-raw 5088,234699
-(defun hcomp-alists-from-hts 5176,238569
-(defun-one-output add-trip 5221,240428
-(defun-one-output undo-trip 5789,268590
-(defun-one-output flush-trip 5831,270410
-(defvar *bad-wrld*)5861,271611
-(defun check-acl2-world-invariant 5863,271632
-(defparameter *known-worlds* 5881,272430
-(defun update-wrld-structures 5883,272465
-(defun-one-output extend-world1 5894,272802
-(defun-one-output retract-world1 6007,277962
-(defun-one-output recover-world1 6108,282353
-(defun-one-output recover-world 6123,283012
-(defun-one-output virginp 6251,289634
-(defun-one-output chk-virgin2 6262,290020
-(defun-one-output chk-package-reincarnation-import-restrictions26329,293242
-(defvar user::*acl2-keep-tmp-files* 6368,294478
-(defun-one-output enter-boot-strap-mode 6370,294520
-(defun-one-output move-current-acl2-world-key-to-front 6465,298799
-(defun-one-output exit-boot-strap-mode 6554,303406
-(defun-one-output ld-alist-raw 6577,304380
-(defun enter-boot-strap-pass-2 6601,305234
-(defconst *acl2-pass-2-files*6621,305948
-(defun our-update-ht 6638,306401
-(defun note-fns-in-form 6647,306698
-(defun note-fns-in-file 6736,309881
-(defun note-fns-in-files 6751,310324
-(defun raw-source-name-p 6764,310895
-(defvar *check-built-in-constants-debug* 6771,311176
-(defun fns-different-wrt-acl2-loop-only 6773,311223
-(defun collect-monadic-booleans 6841,314760
-(defun check-built-in-constants 6855,315357
-(defun-one-output check-none-ideal 7070,325362
-(defun check-state-globals-initialized 7110,326974
-(defun-one-output check-acl2-initialization 7127,327587
-(defun set-initial-cbd 7133,327796
-(defun initialize-acl2 7161,328937
-(defun our-abort 7452,342457
-(defun initial-customization-filename 7548,346774
-(defun spawn-extra-lispworks-listener 7631,350238
-(defun lp 7657,351441
-(defmacro lp! 7884,361933
-(defun acl2-compile-file 7890,362100
-(defun-one-output delete-auxiliary-book-files 7959,365139
-(defun delete-expansion-file 7992,366821
-(defun compile-uncompiled-defuns 8000,367114
-(defun compile-uncompiled-*1*-defuns 8173,375037
-(defun compile-certified-file 8404,385930
-(defun compile-for-include-book 8418,386536
-(defun-one-output enabled-structurep 8485,389980
-(defun-one-output rcnstp 8508,390967
-(defvar *trace-alist*8524,391381
-(defun-one-output assoc-eq-trace-alist 8527,391448
-(defun-one-output print-list-without-stobj-arrays 8535,391673
-(defun-one-output stobj-print-symbol 8542,391872
-(defun-one-output trace-hide-world-and-state 8559,392627
-(defun-one-output saved-build-date-string 8613,394876
-(defun-one-output get-stobjs-out-for-declare-form 8624,395172
-(defun fix-trace-untrace 8649,396145
-(defun fix-trace 8661,396585
-
-defpkgs.lisp,63
-(defconst *acl2-exports*34,1565
-(defpkg "ACL2-USER"638,27281
-
-boot-strap-pass-2.lisp,2141
-(defattach too-many-ifs-post-rewrite 487,19522
-(defattach (too-many-ifs-pre-rewrite 503,20156
-(defthm fn-count-evg-rec-type-prescription524,20788
-(defthm fn-count-evg-rec-bound529,20942
-(defthm fn-count-1-type546,21393
-(defthm symbol-listp-cdr-assoc-equal571,22588
-(defthm integerp-nth-0-var-fn-count-1579,22915
-(defthm integerp-nth-1-var-fn-count-1606,24205
-(defthm integerp-nth-2-var-fn-count-1629,25266
-(defun member-equal-mod-commuting 660,26527
-(defun strip-ancestor-literals 673,27135
-(defattach (ancestors-check 753,30277
-(defattach worse-than 756,30389
-(defattach worse-than-or-equal 758,30432
-(defattach (acl2x-expansion-alist768,30727
-(defattach rw-cache-debug 779,31047
-(defattach rw-cache-debug-action 783,31174
-(defattach rw-cacheable-failure-reason 787,31321
-(defthm d-pos-listp-forward-to-true-listp812,32089
-(defattach print-clause-id-okp 829,32654
-(defattach oncep-tp 863,33895
-(defthm pos-listp-forward-to-integer-listp885,34833
-(defthm true-listp-chars-for-tilde-@-clause-id-phrase/periods892,35035
-(defthm true-listp-explode-atom896,35198
-(deftheory definition-minimal-theory991,38048
-(deftheory executable-counterpart-minimal-theory997,38158
-(deftheory minimal-theory1003,38285
-(deftheory ground-zero 1053,40237
-(defund meta-extract-formula 1084,41170
-(defun typespec-check 1111,42319
-(defun meta-extract-rw+-term 1123,42693
-(defun meta-extract-contextual-fact 1154,43840
-(defun rewrite-rule-term 1199,45908
-(defmacro meta-extract-global-fact 1213,46340
-(defun fncall-term 1217,46473
-(defun logically-equivalent-states 1234,47115
-(defun meta-extract-global-fact+ 1238,47230
-(defun pair-fns-with-measured-subsets 1295,49630
-(defun new-verify-guards-fns1 1312,50422
-(defun new-verify-guards-fns 1334,51448
-(defconst *system-verify-guards-alist*1345,51890
-(defconst *len-system-verify-guards-alist*1398,53542
-(defmacro chk-new-verified-guards 1401,53627
-(defun system-verify-guards-fn-1 1435,55121
-(defun cons-absolute-event-numbers 1448,55730
-(defun sort->-absolute-event-number 1465,56475
-(defun system-verify-guards-fn 1470,56693
-(defmacro system-verify-guards 1480,57046
-
-multi-threading-raw.lisp,2050
-(defmacro without-interrupts 68,2994
-(defmacro unwind-protect-disable-interrupts-during-cleanup91,3890
-(defstruct (atomically-modifiable-counter130,5555
-(defun make-atomically-modifiable-counter 151,6759
-(defmacro define-atomically-modifiable-counter 161,6998
-(defmacro atomically-modifiable-counter-read 164,7138
-(defmacro atomic-incf 174,7342
-(defmacro atomic-incf-multiple 209,8732
-(defmacro atomic-decf 237,9909
-(defun lockp 261,10910
-(defun make-lock 273,11297
-(defmacro reset-lock 302,12540
-(defmacro with-lock 312,12897
-(defun run-thread 335,13668
-(defun interrupt-thread 370,15022
-(defun kill-thread 390,15718
-(defun all-threads 402,15977
-(defun current-thread 412,16209
-(defun thread-wait 422,16387
-(defmacro with-potential-timeout 437,16980
-(defun make-condition-variable 532,21197
-(defmacro signal-condition-variable 551,21762
-(defmacro broadcast-condition-variable 580,22863
-(defun wait-on-condition-variable 592,23152
-(defstruct acl2-semaphore627,24633
-(defstruct acl2-semaphore633,24772
-(defun make-semaphore 638,24893
-(defun semaphorep 695,27666
-(defun make-semaphore-notification 722,28667
-(defun semaphore-notification-status 737,29143
-(defun clear-semaphore-notification-status 754,29787
-(defun set-semaphore-notification-status 771,30525
-(defun signal-semaphore 780,30877
-(defun wait-on-semaphore 807,31791
-(defvar *throwable-worker-thread*929,37533
-(defun throw-all-threads-in-list 943,38210
-(defun kill-all-threads-in-list 991,40264
-(defun thread-name 1003,40635
-(defconstant *worker-thread-name* 1013,40876
-(defun worker-threads1 1015,40928
-(defun worker-threads 1023,41190
-(defun all-worker-threads-are-dead 1030,41351
-(defun all-given-threads-are-reset 1037,41473
-(defun all-worker-threads-are-dead-or-reset 1044,41682
-(defun send-die-to-worker-threads 1056,42093
-(defun kill-all-worker-threads 1088,43418
-(defun core-count-raw 1103,43915
-(defvar *core-count*1123,44653
-(defvar *unassigned-and-active-work-count-limit*1131,44892
-(defconstant *max-idle-thread-count*1149,45854
-
-futures-raw.lisp,3756
-(defstruct st-future49,1893
-(defmacro st-future 59,2101
-(defun st-future-read 69,2471
-(defun st-future-abort 83,3032
-(defstruct atomic-notification199,6821
-(defstruct barrier218,7691
-(defun broadcast-barrier 243,8941
-(defun wait-on-barrier 256,9451
-(defstruct mt-future266,9779
-(define-atomically-modifiable-counter *last-slot-saved* 277,10024
-(define-atomically-modifiable-counter *last-slot-taken* 278,10083
-(defvar *future-array*)295,11068
-(defvar *thread-array*)296,11092
-(defvar *future-dependencies*)297,11116
-(defparameter *future-queue-length-history*299,11148
-(defvar *current-thread-index*305,11241
-(defconstant *starting-core* 312,11416
-(defconstant *resumptive-core* 313,11453
-(defvar *allocated-core*315,11498
-(defvar *decremented-idle-future-thread-count* 338,12667
-(defvar *idle-future-core-count*340,12720
-(defvar *idle-future-resumptive-core-count*342,12806
-(defvar *idle-core* 344,12908
-(define-atomically-modifiable-counter *idle-future-thread-count*346,12947
-(defvar *future-added* 365,14032
-(defvar *idle-resumptive-core* 367,14074
-(defvar *threads-spawned* 370,14142
-(define-atomically-modifiable-counter *unassigned-and-active-future-count*372,14172
-(define-atomically-modifiable-counter *total-future-count*382,14524
-(defconstant *future-array-size* 394,14967
-(defmacro faref 396,15009
-(defvar *resource-and-timing-based-parallelizations*403,15243
-(defvar *resource-and-timing-based-serializations*408,15429
-(defvar *resource-based-parallelizations*413,15618
-(defvar *resource-based-serializations*418,15782
-(defun reset-future-queue-length-history 423,15949
-(defun reset-future-parallelism-variables 426,16038
-(defun reset-all-parallelism-variables 498,18678
-(defun futures-parallelism-buffer-has-space-available 505,18992
-(defun not-too-many-futures-already-in-existence 512,19257
-(defun futures-resources-available 556,21331
-(defmacro unwind-protect-disable-interrupts-during-cleanup574,22240
-(define-atomically-modifiable-counter *threads-waiting-for-starting-core*596,23131
-(defun claim-starting-core 607,23615
-(defun claim-resumptive-core 631,24705
-(defun free-allocated-core 669,26043
-(defun early-terminate-children 691,26850
-(defvar *aborted-futures-via-flag* 706,27452
-(defvar *aborted-futures-total* 707,27490
-(defvar *futures-resources-available-count* 710,27545
-(defvar *futures-resources-unavailable-count* 711,27592
-(defun set-thread-check-for-abort-and-funcall 713,27642
-(defvar *throwable-future-worker-thread*762,29825
-(defun wait-for-a-closure 778,30433
-(defvar *busy-wait-var* 860,35369
-(defvar *current-waiting-thread* 861,35396
-(defvar *fresh-waiting-threads* 862,35434
-(defun make-tclet-thrown-symbol1 867,35579
-(defun make-tclet-thrown-symbol 878,35896
-(defun make-tclet-bindings1 881,35990
-(defun make-tclet-bindings 888,36178
-(defun make-tclet-thrown-tags1 891,36264
-(defun make-tclet-thrown-tags 897,36433
-(defun make-tclet-catches 900,36525
-(defun make-tclet-cleanups 910,36891
-(defmacro throw-catch-let 918,37143
-(defun eval-a-closure 989,39646
-(defun eval-closures 1044,42000
-(defun number-of-idle-threads-and-threads-waiting-for-a-starting-core 1079,43152
-(defun spawn-closure-consumers 1088,43455
-(defun make-future-with-closure 1122,45285
-(defun add-future-to-queue 1162,47400
-(defmacro mt-future 1174,47732
-(defun mt-future-read 1265,51772
-(defvar *aborted-futures-via-throw* 1312,53815
-(defvar *almost-aborted-future-count* 1313,53854
-(defun mt-future-abort 1315,53896
-(defun abort-future-indices 1387,57344
-(defun print-non-nils-in-array 1401,57856
-(defun futures-still-in-flight 1410,58135
-(defmacro future 1421,58440
-(defun future-read 1424,58481
-(defun future-abort 1427,58527
-(defun abort-futures 1430,58575
-
-parallel-raw.lisp,2414
-(defstruct parallelism-piece 213,9963
-(defparameter *reset-parallelism-variables* 348,16353
-(defparameter *reset-core-count-too*350,16403
-(defun reset-parallelism-variables 360,16828
-(defun eval-and-save-result 422,18939
-(defun pop-work-and-set-thread 440,19673
-(defun consume-work-on-work-queue-when-there 471,21080
-(defun spawn-worker-threads-if-needed 617,28131
-(defun add-work-list-to-queue 661,30311
-(defun combine-array-results-into-list 685,31421
-(defun remove-thread-array-from-work-queue-rec695,31745
-(defun remove-thread-array-from-work-queue 729,33013
-(defun terminate-siblings 738,33336
-(defun generate-work-list-from-closure-list-rec751,33974
-(defun generate-work-list-from-closure-list771,34835
-(defun pargs-parallelism-buffer-has-space-available 799,35995
-(defun not-too-many-pieces-of-parallelism-work-already-in-existence 803,36176
-(defun parallelism-resources-available 814,36751
-(defun throw-threads-in-array 832,37681
-(defun decrement-children-left 861,39140
-(defun wait-for-children-to-finish869,39459
-(defun wait-for-resumptive-parallelism-resources 887,40210
-(defun early-terminate-children-and-rewait907,41150
-(defun prepare-to-wait-for-children 940,42428
-(defun parallelize-closure-list 959,43169
-(defun parallelize-fn 1069,48024
-(defmacro closure-for-expression 1085,48731
-(defmacro closure-list-for-expression-list 1088,48799
-(defun parallelism-condition 1097,49082
-(defmacro pargs 1107,49401
-(defun plet-doublets 1127,50104
-(defun make-closures 1134,50313
-(defun identity-list 1147,50810
-(defun make-list-until-non-declare 1149,50849
-(defun parse-additional-declare-forms-for-let 1155,51114
-(defmacro plet 1165,51510
-(defmacro pand 1189,52475
-(defmacro por 1210,53261
-(defun signal-semaphores 1232,54030
-(defmacro spec-mv-let 1238,54184
-(defun number-of-active-threads-aux 1277,55525
-(defun number-of-active-threads 1289,55865
-(defun number-of-threads-waiting-on-a-child-aux 1292,55951
-(defun number-of-threads-waiting-on-a-child 1304,56335
-(defun future-queue-length 1307,56445
-(defun total-number-of-threads 1325,57206
-(defvar *refresh-rate-indicator* 1328,57267
-(defmacro value-of-symbol 1330,57304
-(defun acl2p-sum-list1 1344,57930
-(defun acl2p-sum-list 1350,58086
-(defun average-future-queue-size 1357,58241
-(defun print-interesting-parallelism-variables-str 1361,58391
-(defun print-interesting-parallelism-variables 1420,60474
+acl2.lisp,6270
+(defvar *acl2-compiler-enabled*)*acl2-compiler-enabled*
67,3198
+(defun acl2-set-character-encoding ()acl2-set-character-encoding
308,15326
+(defun our-file-encoding (pathname ef-spec buffer length)our-file-encoding
425,19748
+(defconstant acl2::*the-live-state* 'acl2_invisible::|The Live State Itself|)acl2::*the-live-state*
706,31094
+(defvar acl2::*compiling-certified-file* nil)acl2::*compiling-certified-file*
741,33454
+(defun acl2::defconst-redeclare-error (name)acl2::defconst-redeclare-error
743,33501
+(defparameter acl2::*safe-mode-verified-p*acl2::*safe-mode-verified-p*
764,34444
+(defmacro acl2::defconst (name term &rest rst)acl2::defconst
773,34737
+(defvar acl2::*copy-of-common-lisp-symbols-from-main-lisp-package*)acl2::*copy-of-common-lisp-symbols-from-main-lisp-package*
847,37631
+(defvar acl2::*copy-of-common-lisp-specials-and-constants*)acl2::*copy-of-common-lisp-specials-and-constants*
848,37699
+(defvar acl2::*copy-of-acl2-version*)acl2::*copy-of-acl2-version*
849,37759
+(defconstant acl2::*acl2-files*acl2::*acl2-files*
851,37798
+(defparameter *compiled-file-extension**compiled-file-extension*
969,41767
+(defmacro initialize-state-globals ()initialize-state-globals
979,42177
+(defconstant *suppress-compile-build-time**suppress-compile-build-time*
1039,44898
+(defparameter *global-package-prefix* "ACL2_GLOBAL_")*global-package-prefix*
1051,45286
+(defparameter *1*-package-prefix* "ACL2_*1*_")*1*-package-prefix*
1053,45341
+(defun make-global-package (x)make-global-package
1055,45389
+(defun make-*1*-package (x)make-*1*-package
1063,45642
+(defconstant *main-lisp-package**main-lisp-package*
1081,46201
+(defconstant *main-lisp-package-name-raw**main-lisp-package-name-raw*
1084,46267
+(defparameter acl2::*initial-lisp-symbol-mark*acl2::*initial-lisp-symbol-mark*
1107,47149
+(defconstant *acl2-package* (find-package "ACL2"))*acl2-package*
1118,47578
+(defmacro with-redefinition-suppressed (&rest forms)with-redefinition-suppressed
1148,48739
+(defmacro with-warnings-suppressed (&rest forms)with-warnings-suppressed
1184,50090
+(defmacro with-more-warnings-suppressed (&rest forms)with-more-warnings-suppressed
1231,51752
+(defmacro with-suppression (&rest forms)with-suppression
1266,52887
+(defconstant acl2::*acl2-status-file*acl2::*acl2-status-file*
1281,53517
+(defun acl2::check-suitability-for-acl2 ()acl2::check-suitability-for-acl2
1285,53624
+(defun note-compile-ok ()note-compile-ok
1301,54146
+(defvar *lisp-extension* "lisp")*lisp-extension*
1332,55684
+(defmacro our-with-compilation-unit (form)our-with-compilation-unit
1368,57211
+(defconstant *acl2-read-character-terminators**acl2-read-character-terminators*
1397,58533
+(defparameter *acl2-readtable**acl2-readtable*
1432,59857
+(defparameter *host-readtable**host-readtable*
1438,60068
+(defun set-new-dispatch-macro-character (char subchar fn)set-new-dispatch-macro-character
1443,60241
+(defun define-sharp-dot ()define-sharp-dot
1504,63280
+(defun define-sharp-comma ()define-sharp-comma
1510,63376
+(defun define-sharp-atsign ()define-sharp-atsign
1516,63476
+(defun define-sharp-bang ()define-sharp-bang
1522,63582
+(defun define-sharp-u ()define-sharp-u
1528,63684
+(defvar *old-character-reader**old-character-reader*
1534,63780
+(defun modify-acl2-readtable (do-all-changes)modify-acl2-readtable
1537,63854
+(defvar *reckless-acl2-readtable**reckless-acl2-readtable*
1626,66601
+(defvar *load-compiled-verbose* nil)*load-compiled-verbose*
1643,67127
+(defun load-compiled (filename &optional verbose)load-compiled
1645,67165
+(defun non-trivial-acl2-proclaims-file-p ()non-trivial-acl2-proclaims-file-p
1896,77147
+(defun compile-acl2 (&optional use-acl2-proclaims)compile-acl2
1912,77809
+(defvar user::*fast-acl2-gcl-build* nil)user::*fast-acl2-gcl-build*
2023,82445
+(defun load-acl2 (&optional fast)load-acl2
2025,82487
+(defparameter *acl2-panic-exit-status* nil)*acl2-panic-exit-status*
2129,86611
+(defun exit-lisp (&optional (status '0 status-p))exit-lisp
2131,86656
+(defconstant *slashable-array**slashable-array*
2236,91391
+(defconstant *suspiciously-first-numeric-array**suspiciously-first-numeric-array*
2249,91838
+(defconstant *suspiciously-first-hex-array**suspiciously-first-hex-array*
2260,92174
+(defconstant *base-10-array**base-10-array*
2274,92595
+(defconstant *hex-array**hex-array*
2285,92873
+(defconstant *letter-array**letter-array*
2298,93222
+(defmacro suspiciously-first-numeric-array (print-base)suspiciously-first-numeric-array
2312,93701
+(defmacro numeric-array (print-base)numeric-array
2317,93866
+(defconstant *char-code-backslash* (char-code #\\))*char-code-backslash*
2322,93974
+(defconstant *char-code-slash* (char-code #\/))*char-code-slash*
2324,94027
+(defconstant *char-code-double-gritch* (char-code #\"))*char-code-double-gritch*
2326,94076
+(defconstant *big-n-special-object* '(nil . nil))*big-n-special-object*
2332,94332
+(defconstant *number-of-return-values**number-of-return-values*
2334,94383
+(defconstant *boole-array**boole-array*
2340,94485
+(defconstant *mo-f* (make-symbol "F"))*mo-f*
2378,95852
+(defconstant *mo-h* (make-symbol "H"))*mo-h*
2379,95891
+(defconstant *mo-o* (make-symbol "O"))*mo-o*
2380,95930
+(defconstant *mf-old-caller* (make-symbol "OLD-CALLER"))*mf-old-caller*
2385,96023
+(defconstant *mf-start-hons* (make-symbol "START-HONS"))*mf-start-hons*
2386,96080
+(defconstant *mf-start-pons* (make-symbol "START-PONS"))*mf-start-pons*
2387,96137
+(defconstant *mf-start-bytes* (make-symbol "START-BYTES"))*mf-start-bytes*
2388,96194
+(defconstant *mf-ans* (make-symbol "ANS"))*mf-ans*
2389,96253
+(defconstant *mf-ans-p* (make-symbol "ANS-P"))*mf-ans-p*
2390,96296
+(defconstant *mf-ma* (make-symbol "MA"))*mf-ma*
2391,96343
+(defconstant *mf-args* (make-symbol "ARGS"))*mf-args*
2392,96384
+(defconstant *mf-2mmf* (make-symbol "MF-2MMF"))*mf-2mmf*
2393,96429
+(defconstant *mf-2mmf-fnn* (make-symbol "MF-2MMF-FNN"))*mf-2mmf-fnn*
2394,96477
+(defconstant *mf-count-loc* (make-symbol "MF-COUNT-LOC"))*mf-count-loc*
2395,96533
+(defconstant *attached-fn-temp* (make-symbol "ATTACHED-FN-TEMP"))*attached-fn-temp*
2397,96592
+(defvar *debug-prompt-suffix* "")*debug-prompt-suffix*
2424,97740
+(defun break-level-for-acl2 (at &optional env)break-level-for-acl2
2426,97854
+
+acl2-check.lisp,0
+
+acl2-fns.lisp,5127
+(defmacro qfuncall (fn &rest args)qfuncall
27,1067
+(defmacro defun-one-output (&rest args)defun-one-output
40,1583
+(defparameter *package-alist* nil)*package-alist*
51,2044
+(defun-one-output find-package-fast (string)find-package-fast
53,2080
+(defvar *global-symbol-key* (make-symbol "*GLOBAL-SYMBOL-KEY*"))*global-symbol-key*
59,2287
+(defun global-symbol (x)global-symbol
61,2353
+(defmacro live-state-p (x)live-state-p
70,2692
+(defun get-global (x state-state)get-global
74,2771
+(defmacro f-get-global (x st)f-get-global
84,3106
+(defun acl2-realp (x)acl2-realp
117,4489
+(defun gcl-version-> (major minor extra &optional weak)gcl-version->
133,5032
+(defun gcl-version->= (major minor extra)gcl-version->=
158,6125
+(defvar *do-proclaims**do-proclaims*
225,9744
+(defun macroexpand-till (form sym)macroexpand-till
249,10778
+(defun get-type-from-dcls (var dcls)get-type-from-dcls
265,11486
+(defun arg-declarations (formals dcls)arg-declarations
273,11742
+(defun collect-types (l)collect-types
278,11927
+(defun convert-type-to-integer-pair (typ)convert-type-to-integer-pair
289,12266
+(defvar *acl2-output-type-abort* nil)*acl2-output-type-abort*
303,12700
+(defun min-integer-* (x y)min-integer-*
305,12739
+(defun max-integer-* (x y)max-integer-*
310,12845
+(defun max-output-type-for-declare-form (type1 type2)max-output-type-for-declare-form
315,12951
+(defun max-output-type-for-declare-form-lst (type-list1 type-list2)max-output-type-for-declare-form-lst
395,15907
+(defun output-type-for-declare-form-rec (form flet-alist)output-type-for-declare-form-rec
430,17321
+(defun output-type-for-declare-form-rec-list (forms flet-alist)output-type-for-declare-form-rec-list
572,23273
+(defun output-type-for-declare-form (fn form)output-type-for-declare-form
583,23767
+(defun make-defun-declare-form (fn formmake-defun-declare-form
629,25516
+(defun make-defconst-declare-form (form)make-defconst-declare-form
662,26934
+(defun make-defstobj-declare-form (form)make-defstobj-declare-form
680,27568
+(defmacro eval-or-print (form stream)eval-or-print
711,28963
+(defun proclaim-form (form &optional stream)proclaim-form
719,29149
+(defun proclaim-file (name &optional stream)proclaim-file
765,30747
+(defparameter *comma* (make-symbol "COMMA")*comma*
817,33359
+(defparameter *comma-atsign* (make-symbol "COMMA-ATSIGN")*comma-atsign*
821,33525
+(defparameter *backquote-counter* 0*backquote-counter*
825,33719
+(defun backquote (x)backquote
832,34051
+(defun backquote-lst (l)backquote-lst
875,36229
+(defun rev1@ (x acc)rev1@
900,37100
+(defun acl2-read-character-string (s acc)acl2-read-character-string
910,37307
+(defun acl2-character-reader (s c n)acl2-character-reader
982,40390
+(defvar *inside-sharp-dot-read* nil)*inside-sharp-dot-read*
991,40708
+(defvar *inhibit-sharp-comma-warning* nil)*inhibit-sharp-comma-warning*
993,40746
+(defvar *inside-sharp-u-read* nil)*inside-sharp-u-read*
995,40790
+(defun sharp-comma-read (stream char n)sharp-comma-read
997,40826
+(defun sharp-dot-read (stream char n)sharp-dot-read
1008,41357
+(defun sharp-bang-read (stream char n)sharp-bang-read
1044,42891
+(defun sharp-u-read (stream char n)sharp-u-read
1067,43864
+(defmacro sharp-atsign-read-er (str &rest format-args)sharp-atsign-read-er
1098,45255
+(defun sharp-atsign-read (stream char n)sharp-atsign-read
1104,45510
+(defvar *sharp-reader-array-size**sharp-reader-array-size*
1151,47484
+(defvar *sharp-reader-array**sharp-reader-array*
1158,47672
+(defvar *sharp-reader-array-size-multiplier**sharp-reader-array-size-multiplier*
1161,47744
+(defconstant *sharp-reader-max-array-size**sharp-reader-max-array-size*
1168,47924
+(defvar *sharp-reader-max-index**sharp-reader-max-index*
1176,48176
+(defun update-sharp-reader-max-index (index)update-sharp-reader-max-index
1189,48843
+(defun reckless-sharp-sharp-read (stream char arg)reckless-sharp-sharp-read
1218,50028
+(defun reckless-sharp-equal-read (stream char arg)reckless-sharp-equal-read
1224,50188
+(defmacro with-reckless-read (&rest forms)with-reckless-read
1232,50520
+(defun symbol-package-name (x)symbol-package-name
1254,51402
+(defmacro gv (fn args val)gv
1286,52851
+(defun getenv$-raw (string)getenv$-raw
1309,53832
+(defun get-os ()get-os
1332,54655
+(defmacro our-ignore-errors (x)our-ignore-errors
1341,54869
+(defmacro safe-open (&rest args)safe-open
1345,54945
+(defun our-truename (filename &optional namestringp)our-truename
1348,55017
+(defun our-pwd ()our-pwd
1418,58112
+(defun cancel-dot-dots (full-pathname)cancel-dot-dots
1429,58500
+(defun unix-full-pathname (name &optional extension)unix-full-pathname
1437,58818
+(defun our-user-homedir-pathname ()our-user-homedir-pathname
1465,59833
+(defun ser-cons-reader-macro (stream subchar arg)ser-cons-reader-macro
1517,62109
+(defun ser-hons-reader-macro (stream subchar arg)ser-hons-reader-macro
1523,62386
+(defmacro special-form-or-op-p (name)special-form-or-op-p
1540,63276
+(defvar *startup-package-name* "ACL2")*startup-package-name*
1547,63500
+(defmacro save-def (def-form)save-def
1549,63540
+(defmacro defg (&rest r)defg
1574,64516
+(defmacro defv (&rest r)defv
1588,65010
 
 init.lisp,0
 
-acl2-check.lisp,0
+acl2-init.lisp,4182
+(defconstant *current-acl2-world-key**current-acl2-world-key*
306,14371
+(defun system-call (string arguments)system-call
360,16578
+(defun copy-acl2 (dir)copy-acl2
435,18977
+(defun our-probe-file (filename)our-probe-file
452,19492
+(defun copy-distribution (output-file source-directory target-directorycopy-distribution
473,20234
+(defun make-tags ()make-tags
643,27955
+(defvar *saved-build-date-lst*)*saved-build-date-lst*
684,30082
+(defvar *saved-mode*)*saved-mode*
685,30114
+(defun svn-revision-from-line (s)svn-revision-from-line
687,30137
+(defconstant *acl2-svn-revision-string**acl2-svn-revision-string*
698,30541
+(defvar *saved-string**saved-string*
726,31884
+(defun maybe-load-acl2-init ()maybe-load-acl2-init
754,32947
+(defun chmod-executable (sysout-name)chmod-executable
760,33145
+(defun saved-build-dates (separator)saved-build-dates
763,33233
+(defmacro our-with-standard-io-syntax (&rest args)our-with-standard-io-syntax
780,33835
+(defun user-args-string (inert-args &optional (separator '"--"))user-args-string
785,33966
+(defmacro write-exec-file (stream prefix string &rest args)write-exec-file
801,34631
+(defun proclaim-files (&optional outfilename infilename infile-optional-p)proclaim-files
829,35770
+(defun insert-string (s)insert-string
880,37745
+(defvar *saved-system-banner**saved-system-banner*
885,37841
+(defun save-acl2-in-akcl-aux (sysout-name gcl-exec-namesave-acl2-in-akcl-aux
905,38678
+(defun save-acl2-in-akcl (sysout-name gcl-exec-namesave-acl2-in-akcl
957,41023
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)save-exec-raw
1180,50255
+(defvar *acl2-default-restart-complete* nil)*acl2-default-restart-complete*
1186,50542
+(defun fix-default-pathname-defaults ()fix-default-pathname-defaults
1188,50588
+(defvar *print-startup-banner**print-startup-banner*
1212,51420
+(defvar *lp-ever-entered-p* nil)*lp-ever-entered-p*
1227,52097
+(defun acl2-default-restart ()acl2-default-restart
1229,52131
+(defun cmulisp-restart ()cmulisp-restart
1303,54523
+(defun sbcl-restart ()sbcl-restart
1310,54655
+(defun save-acl2-in-lucid (sysout-name &optional mode)save-acl2-in-lucid
1316,54789
+(defun lispworks-save-exec-aux (sysout-name eventual-sysout-namelispworks-save-exec-aux
1322,54985
+(defun save-acl2-in-lispworks (sysout-name mode eventual-sysout-name)save-acl2-in-lispworks
1419,59502
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)save-exec-raw
1429,59871
+(defun save-acl2-in-cmulisp-aux (sysout-name core-namesave-acl2-in-cmulisp-aux
1438,60142
+(defun save-acl2-in-cmulisp (sysout-name &optional mode core-name)save-acl2-in-cmulisp
1500,62823
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)save-exec-raw
1509,63148
+(defvar *sbcl-dynamic-space-size**sbcl-dynamic-space-size*
1514,63342
+(defvar *sbcl-contrib-dir* nil)*sbcl-contrib-dir*
1561,65894
+(defun save-acl2-in-sbcl-aux (sysout-name core-namesave-acl2-in-sbcl-aux
1564,65934
+(defun save-acl2-in-sbcl (sysout-name &optional mode core-name)save-acl2-in-sbcl
1656,70213
+(defun save-exec-raw (sysout-name host-lisp-args toplevel-args inert-args)save-exec-raw
1666,70572
+(defun save-acl2-in-allegro-aux (sysout-name dxl-namesave-acl2-in-allegro-aux
1673,70851
+(defun save-acl2-in-allegro (sysout-name &optional mode dxl-name)save-acl2-in-allegro
1729,73236
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)save-exec-raw
1743,73716
+(defun rc-filename (dir)rc-filename
1747,73903
+(defun write-acl2rc (dir)write-acl2rc
1750,73968
+(defun save-acl2-in-clisp-aux (sysout-name mem-name host-lisp-args inert-args)save-acl2-in-clisp-aux
1769,74682
+(defun save-acl2-in-clisp (sysout-name &optional mode mem-name)save-acl2-in-clisp
1815,76662
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)save-exec-raw
1824,76982
+(defun save-acl2-in-ccl-aux (sysout-name core-namesave-acl2-in-ccl-aux
1829,77173
+(defun save-acl2-in-ccl (sysout-name &optional mode core-name)save-acl2-in-ccl
1933,82211
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)save-exec-raw
1939,82391
+(defun save-acl2 (&optional mode other-infosave-acl2
1946,82727
+(defun generate-acl2-proclaims ()generate-acl2-proclaims
2006,84857
+
+akcl-acl2-trace.lisp,663
+(defmacro trace (&rest fns)trace
36,1430
+(defmacro untrace (&rest fns)untrace
92,3486
+(defun trace-ppr-gcl (direction x &aux (state *the-live-state*))trace-ppr-gcl
100,3630
+(defun trace-fix-entry-raw (name l)trace-fix-entry-raw
132,4972
+(defun trace-fix-entry (name l)trace-fix-entry
148,5602
+(defun trace-values (name)trace-values
163,6141
+(defun trace-values (name)trace-values
173,6430
+(defun make-nths (i n var)make-nths
178,6515
+(defun trace-fix-exit-raw (name l)trace-fix-exit-raw
184,6637
+(defun trace-fix-exit (name original-name l &aux (state *the-live-state*))trace-fix-exit
199,7204
+(defun trace-fix-cond (trace-spec)trace-fix-cond
220,8176
+
+allegro-acl2-trace.lisp,616
+(defvar *trace-arglist*)*trace-arglist*
52,2090
+(defvar *trace-values*)*trace-values*
54,2116
+(defconst *trace-sublis* '((values . *trace-values*)*trace-sublis*
56,2141
+(defun trace-pre-process (lst)trace-pre-process
101,4371
+(defun trace-entry (name l)trace-entry
129,5368
+(defun trace-values (name)trace-values
158,6478
+(defun trace-values (name)trace-values
168,6767
+(defun make-nths (i n var)make-nths
173,6852
+(defun trace-exit (name original-name l &aux (state *the-live-state*))trace-exit
179,6974
+(defun traced-fns-lst (lst)traced-fns-lst
215,8449
+(defun trace-process (lst)trace-process
218,8514
+
+openmcl-acl2-trace.lisp,575
+(defvar *trace-arglist*)*trace-arglist*
56,2188
+(defvar *trace-values*)*trace-values*
58,2214
+(defparameter *trace-sublis* '((values . *trace-values*)*trace-sublis*
60,2239
+(defun trace-pre-process (lst &aux (state *the-live-state*))trace-pre-process
66,2516
+(defun trace-entry (name l)trace-entry
101,3869
+(defun trace-values (name)trace-values
126,5007
+(defun trace-exit (name original-name l)trace-exit
135,5321
+(defun traced-fns-lst (lst)traced-fns-lst
164,6651
+(defun trace-process (lst)trace-process
167,6716
+(defun acl2-traced-fns ()acl2-traced-fns
187,7620
+
+axioms.lisp,111044
+(acl2::defconst acl2::*common-lisp-symbols-from-main-lisp-package*acl2::*common-lisp-symbols-from-main-lisp-package*
81,4294
+(defconst *common-lisp-specials-and-constants**common-lisp-specials-and-constants*
593,26922
+(defconst *stobj-inline-declare**stobj-inline-declare*
671,31242
+(defmacro make-package-entry (&key name imports hidden-p book-pathmake-package-entry
914,42484
+(defmacro find-package-entry (name known-package-alist)find-package-entry
955,44431
+(defmacro package-entry-name (package-entry)package-entry-name
958,44533
+(defmacro package-entry-imports (package-entry)package-entry-imports
961,44604
+(defmacro package-entry-hidden-p (package-entry)package-entry-hidden-p
964,44679
+(defmacro package-entry-book-path (package-entry)package-entry-book-path
967,44756
+(defmacro package-entry-defpkg-event-form (package-entry)package-entry-defpkg-event-form
970,44835
+(defmacro package-entry-tterm (package-entry)package-entry-tterm
973,44928
+(defmacro find-non-hidden-package-entry (name known-package-alist)find-non-hidden-package-entry
976,45009
+(defmacro remove-package-entry (name known-package-alist)remove-package-entry
981,45202
+(defmacro change-package-entry-hidden-p (entry value)change-package-entry-hidden-p
984,45313
+(defmacro getprop (symb key default world-name world-alist)getprop
994,45683
+(defvar *user-stobj-alist* nil)*user-stobj-alist*
1012,46394
+(defparameter *wormholep* nil)*wormholep*
1041,48186
+(defun-one-output replace-bad-lisp-object (x)replace-bad-lisp-object
1048,48497
+(defun-one-output replace-bad-lisp-object-list (x)replace-bad-lisp-object-list
1060,48818
+(defun-one-output wormhole-er (fn args)wormhole-er
1066,48991
+(defparameter *wormhole-cleanup-form* nil)*wormhole-cleanup-form*
1079,49517
+(defun-one-output cloaked-set-w! (x state)cloaked-set-w!
1127,52541
+(defun-one-output assoc-eq-butlast-2 (x alist)assoc-eq-butlast-2
1135,52817
+(defun-one-output assoc-eq-equal-butlast-2 (x y alist)assoc-eq-equal-butlast-2
1146,53239
+(defun-one-output push-wormhole-undo-formi (op arg1 arg2)push-wormhole-undo-formi
1159,53746
+(defconstant *open-input-channel-key**open-input-channel-key*
1283,60510
+(defconstant *open-input-channel-type-key**open-input-channel-type-key*
1289,60725
+(defconstant *open-output-channel-key**open-output-channel-key*
1292,60819
+(defconstant *open-output-channel-type-key**open-output-channel-type-key*
1295,60905
+(defconstant *non-existent-stream**non-existent-stream*
1298,61001
+(defvar *acl2-error-p* nil)*acl2-error-p*
1304,61195
+(defun interface-er (&rest args)interface-er
1306,61224
+(defun-one-output acl2-numberp (x)acl2-numberp
1416,65177
+(defun-one-output binary-+ (x y) (+ x y))binary-+
1419,65228
+(defun-one-output binary-* (x y) (* x y))binary-*
1421,65271
+(defun-one-output unary-- (x) (- x))unary--
1423,65314
+(defun-one-output unary-/ (x) (/ x))unary-/
1425,65352
+(defparameter *in-recover-world-flg* nil)*in-recover-world-flg*
1431,65567
+(defparameter *ever-known-package-alist**ever-known-package-alist*
1436,65754
+(defvar **1*-symbol-key* (make-symbol "**1*-SYMBOL-KEY*"))**1*-symbol-key*
1459,66752
+(defun *1*-symbol (x)*1*-symbol
1461,66812
+(defun *1*-symbol? (x)*1*-symbol?
1471,67176
+(defmacro defun-*1* (fn &rest args)defun-*1*
1483,67657
+(defparameter *defun-overrides* nil)*defun-overrides*
1486,67730
+(defmacro defun-overrides (name formals &rest rest)defun-overrides
1488,67768
+(defmacro defpkg (&whole event-form name importsdefpkg
1503,68340
+(defmacro defuns (&rest lst)defuns
1516,68821
+(defmacro defun-std (name formals &rest args)defun-std
1521,68951
+(defmacro defuns-std (&rest args)defuns-std
1529,69177
+(defmacro defthm (&rest args)defthm
1532,69232
+(defmacro defthmd (&rest args)defthmd
1536,69296
+(defmacro defthm-std (&rest args)defthm-std
1541,69386
+(defmacro defaxiom (&rest args)defaxiom
1545,69454
+(defmacro skip-proofs (arg)skip-proofs
1549,69520
+(defmacro deflabel (&rest args)deflabel
1552,69556
+(defmacro defdoc (&rest args)defdoc
1556,69622
+(defmacro deftheory (&rest args)deftheory
1560,69686
+(defun-one-output stobj-initial-statep-arr (n i arr init)stobj-initial-statep-arr
1564,69753
+(defun-one-output stobj-initial-statep-entry (temp entry)stobj-initial-statep-entry
1569,69926
+(defun-one-output stobj-initial-statep1 (field-templates ndx stobj)stobj-initial-statep1
1599,70846
+(defun-one-output stobj-initial-statep (stobj field-templates)stobj-initial-statep
1607,71237
+(defun remove-stobj-inline-declare (x)remove-stobj-inline-declare
1621,71820
+(defun congruent-stobj-rep-raw (name)congruent-stobj-rep-raw
1628,72031
+(defmacro defstobj (name &rest args)defstobj
1640,72416
+(defmacro value-triple (&rest args)value-triple
1766,77913
+(defmacro verify-termination-boot-strap (&rest args)verify-termination-boot-strap
1770,77983
+(defmacro verify-guards (&rest args)verify-guards
1774,78070
+(defmacro in-theory (&rest args)in-theory
1778,78141
+(defmacro in-arithmetic-theory (&rest args)in-arithmetic-theory
1782,78208
+(defmacro regenerate-tau-database (&rest args)regenerate-tau-database
1786,78286
+(defmacro push-untouchable (&rest args)push-untouchable
1790,78367
+(defmacro remove-untouchable (&rest args)remove-untouchable
1794,78441
+(defmacro set-body (&rest args)set-body
1798,78517
+(defmacro table (&rest args)table
1802,78583
+(defmacro encapsulate (signatures &rest lst)encapsulate
1813,78960
+(defparameter *inside-include-book-fn**inside-include-book-fn*
1856,80764
+(defmacro include-book (user-book-nameinclude-book
1867,81214
+(defmacro certify-book (&rest args)certify-book
1881,81781
+(defmacro local (x)local
1892,82282
+(defmacro defchoose (&rest args)defchoose
1896,82333
+(defmacro mutual-recursion (&rest lst)mutual-recursion
1906,82748
+(defmacro make-event (&whole event-formmake-event
1909,82809
+(deflabel programmingprogramming
1929,83792
+(deflabel acl2-built-insacl2-built-ins
1946,84413
+(deflabel miscellaneousmiscellaneous
1962,85124
+(defconst *standard-co* 'acl2-output-channel::standard-character-output-0)*standard-co*
1976,85499
+(defconst *standard-oi* 'acl2-input-channel::standard-object-input-0)*standard-oi*
1978,85575
+(defconst *standard-ci* 'acl2-input-channel::standard-character-input-0)*standard-ci*
1980,85646
+(defconst nil 'nilnil
2002,86101
+(defconst t 'tt
2010,86269
+(defun insist (x)insist
2016,86422
+(defun iff (p q)iff
2025,86649
+(defun xor (p q)xor
2040,87041
+(defun eq (x y)eq
2055,87409
+(defun booleanp (x)booleanp
2082,88527
+(defthm iff-is-an-equivalenceiff-is-an-equivalence
2104,89117
+(defun implies (p q)implies
2112,89332
+(defthm iff-implies-equal-implies-1iff-implies-equal-implies-1
2127,89706
+(defthm iff-implies-equal-implies-2iff-implies-equal-implies-2
2132,89855
+(defun not (p)not
2138,90021
+(defthm iff-implies-equal-notiff-implies-equal-not
2155,90437
+(defun hide (x)hide
2160,90568
+(defun rewrite-equiv (x)rewrite-equiv
2266,95213
+(defmacro real/rationalp (x)real/rationalp
2280,95699
+(defmacro complex/complex-rationalp (x)complex/complex-rationalp
2298,96323
+(defun true-listp (x)true-listp
2320,97133
+(defun list-macro (lst)list-macro
2336,97523
+(defmacro list (&rest args)list
2345,97724
+(defun and-macro (lst)and-macro
2360,98128
+(defmacro and (&rest args)and
2371,98360
+(defun or-macro (lst)or-macro
2387,98803
+(defmacro or (&rest args)or
2399,99057
+(defmacro - (x &optional (y 'nil binary-casep))-
2442,100156
+(defthm booleanp-compound-recognizerbooleanp-compound-recognizer
2487,102017
+(defun integer-abs (x)integer-abs
2501,102512
+(defun xxxjoin (fn args)xxxjoin
2507,102621
+(defmacro + (&rest rst)+
2526,103142
+(defun-one-output len2 (x acc)len2
2537,103401
+(defun len1 (x acc)len1
2542,103511
+(defun len (x)len
2571,104808
+(defun length (x)length
2600,105600
+(defun-one-output complex-rationalp (x)complex-rationalp
2624,106244
+(defun acl2-count (x)acl2-count
2627,106301
+(defun cond-clausesp (clauses)cond-clausesp
2682,108448
+(defun cond-macro (clauses)cond-macro
2691,108704
+(defmacro cond (&rest clauses)cond
2718,109701
+(defun eqlablep (x)eqlablep
2740,110426
+(defthm eqlablep-recogeqlablep-recog
2764,111304
+(defun eqlable-listp (l)eqlable-listp
2773,111505
+(defun eql (x y)eql
2791,111988
+(defun atom (x)atom
2814,112706
+(defun make-character-list (x)make-character-list
2833,113169
+(defun eqlable-alistp (x)eqlable-alistp
2855,113752
+(defun alistp (l)alistp
2873,114302
+(defthm alistp-forward-to-true-listpalistp-forward-to-true-listp
2889,114695
+(defthm eqlable-alistp-forward-to-alistpeqlable-alistp-forward-to-alistp
2894,114817
+(defun acons (key datum alist)acons
2900,114964
+(defun endp (x)endp
2919,115537
+(defmacro caar (x)caar
2943,116253
+(defmacro cadr (x)cadr
2952,116443
+(defmacro cdar (x)cdar
2961,116633
+(defmacro cddr (x)cddr
2970,116823
+(defmacro caaar (x)caaar
2979,117013
+(defmacro caadr (x)caadr
2988,117206
+(defmacro cadar (x)cadar
2997,117399
+(defmacro caddr (x)caddr
3006,117592
+(defmacro cdaar (x)cdaar
3015,117785
+(defmacro cdadr (x)cdadr
3024,117978
+(defmacro cddar (x)cddar
3033,118171
+(defmacro cdddr (x)cdddr
3042,118364
+(defmacro caaaar (x)caaaar
3051,118557
+(defmacro caaadr (x)caaadr
3060,118753
+(defmacro caadar (x)caadar
3069,118949
+(defmacro caaddr (x)caaddr
3078,119145
+(defmacro cadaar (x)cadaar
3087,119341
+(defmacro cadadr (x)cadadr
3096,119537
+(defmacro caddar (x)caddar
3105,119733
+(defmacro cadddr (x)cadddr
3114,119929
+(defmacro cdaaar (x)cdaaar
3123,120125
+(defmacro cdaadr (x)cdaadr
3132,120321
+(defmacro cdadar (x)cdadar
3141,120517
+(defmacro cdaddr (x)cdaddr
3150,120713
+(defmacro cddaar (x)cddaar
3159,120909
+(defmacro cddadr (x)cddadr
3168,121105
+(defmacro cdddar (x)cdddar
3177,121301
+(defmacro cddddr (x)cddddr
3186,121497
+(defun null (x)null
3195,121693
+(defun symbol-listp (lst)symbol-listp
3213,122205
+(defthm symbol-listp-forward-to-true-listpsymbol-listp-forward-to-true-listp
3229,122623
+(defun symbol-doublet-listp (lst)symbol-doublet-listp
3234,122757
+(defun reverse-strip-cars (x a)reverse-strip-cars
3361,127283
+(defun strip-cars (x)strip-cars
3367,127472
+(defun reverse-strip-cdrs (x a)reverse-strip-cdrs
3392,128222
+(defun strip-cdrs (x)strip-cdrs
3398,128411
+(defmacro let-mbe (bindings &key logic exec)let-mbe
3422,129152
+(defun return-last (fn eager-arg last-arg)return-last
3428,129282
+(defmacro return-last (qfn arg2 arg3)return-last
3942,151401
+(defmacro mbe1-raw (exec logic)mbe1-raw
3990,153535
+(defmacro mbe1 (exec logic)mbe1
3998,153737
+(defmacro must-be-equal (logic exec)must-be-equal
4017,154305
+(defmacro mbe (&key (exec 'nil exec-p) (logic 'nil logic-p))mbe
4045,155567
+(defmacro mbt (x)mbt
4188,161590
+(defdoc equality-variantsequality-variants
4291,165761
+(defdoc equality-variants-detailsequality-variants-details
4404,171416
+(defun member-eq-exec (x lst)member-eq-exec
4587,178312
+(defun member-eql-exec (x lst)member-eql-exec
4595,178578
+(defun member-equal (x lst)member-equal
4603,178849
+(defmacro member-eq (x lst)member-eq
4612,179151
+(defthm member-eq-exec-is-member-equalmember-eq-exec-is-member-equal
4615,179211
+(defthm member-eql-exec-is-member-equalmember-eql-exec-is-member-equal
4619,179311
+(defmacro member (x l &key (test ''eql))member
4624,179430
+(defun subsetp-eq-exec (x y)subsetp-eq-exec
4679,181496
+(defun subsetp-eql-exec (x y)subsetp-eql-exec
4690,181855
+(defun subsetp-equal (x y)subsetp-equal
4702,182205
+(defmacro subsetp-eq (x y)subsetp-eq
4713,182560
+(defthm subsetp-eq-exec-is-subsetp-equalsubsetp-eq-exec-is-subsetp-equal
4716,182618
+(defthm subsetp-eql-exec-is-subsetp-equalsubsetp-eql-exec-is-subsetp-equal
4720,182722
+(defmacro subsetp (x y &key (test ''eql))subsetp
4725,182845
+(defun symbol-alistp (x)symbol-alistp
4776,184799
+(defthm symbol-alistp-forward-to-eqlable-alistpsymbol-alistp-forward-to-eqlable-alistp
4793,185300
+(defun assoc-eq-exec (x alist)assoc-eq-exec
4800,185453
+(defun assoc-eql-exec (x alist)assoc-eql-exec
4808,185740
+(defun assoc-equal (x alist)assoc-equal
4816,186032
+(defmacro assoc-eq (x lst)assoc-eq
4825,186348
+(defthm assoc-eq-exec-is-assoc-equalassoc-eq-exec-is-assoc-equal
4828,186406
+(defthm assoc-eql-exec-is-assoc-equalassoc-eql-exec-is-assoc-equal
4832,186502
+(defmacro assoc (x alist &key (test ''eql))assoc
4837,186617
+(defun assoc-eq-equal-alistp (x)assoc-eq-equal-alistp
4890,188728
+(defun assoc-eq-equal (x y alist)assoc-eq-equal
4898,188983
+(defmacro <= (x y)<=
4918,189730
+(defun = (x y)=
4933,190062
+(defun /= (x y)/=
4958,190716
+(defmacro > (x y)>
4982,191419
+(defmacro >= (x y)>=
4997,191723
+(deflabel zero-test-idiomszero-test-idioms
5011,192041
+(defmacro int= (i j)int=
5180,200454
+(defun zp (x)zp
5202,201199
+(defun-one-output zp (x)zp
5242,202449
+(defthm zp-compound-recognizerzp-compound-recognizer
5246,202518
+(defthm zp-openzp-open
5261,203000
+(defun zip (x)zip
5288,203862
+(defun-one-output zip (x) (= x 0))zip
5328,205038
+(defthm zip-compound-recognizerzip-compound-recognizer
5330,205074
+(defthm zip-openzip-open
5339,205269
+(defun nth (n l)nth
5348,205477
+(defun char (s n)char
5375,206230
+(defun proper-consp (x)proper-consp
5399,206962
+(defun improper-consp (x)improper-consp
5414,207355
+(defmacro * (&rest rst)*
5431,207814
+(defun conjugate (x)conjugate
5460,208479
+(defmacro prog2$ (x y)prog2$
5481,209030
+(deflabel OtherOther
5558,211949
+(deflabel acl2-helpacl2-help
5568,212251
+(defmacro ec-call1-raw (ign x)ec-call1-raw
5581,212678
+(defmacro ec-call1 (ign x)ec-call1
5615,214378
+(defmacro ec-call (x)ec-call
5623,214653
+(defmacro non-exec (x)non-exec
5770,220482
+(defmacro / (x &optional (y 'nil binary-casep))/
5868,223535
+(defaxiom closureclosure
5906,224432
+(defaxiom Associativity-of-+Associativity-of-+
5913,224589
+(defaxiom Commutativity-of-+Commutativity-of-+
5916,224658
+(defun fix (x)fix
5919,224715
+(defaxiom Unicity-of-0Unicity-of-0
5939,225217
+(defaxiom Inverse-of-+Inverse-of-+
5943,225277
+(defaxiom Associativity-of-*Associativity-of-*
5946,225326
+(defaxiom Commutativity-of-*Commutativity-of-*
5949,225395
+(defaxiom Unicity-of-1Unicity-of-1
5952,225452
+(defaxiom Inverse-of-*Inverse-of-*
5956,225512
+(defaxiom DistributivityDistributivity
5961,225639
+(defaxiom <-on-others<-on-others
5965,225719
+(defaxiom ZeroZero
5970,225808
+(defaxiom TrichotomyTrichotomy
5974,225861
+(defaxiom PositivePositive
5986,226131
+(defaxiom Rational-implies1Rational-implies1
5996,226412
+(defaxiom Rational-implies2Rational-implies2
6003,226611
+(defaxiom integer-implies-rationalinteger-implies-rational
6011,226844
+(defaxiom rational-implies-realrational-implies-real
6016,226965
+(defaxiom complex-implies1complex-implies1
6022,227114
+(defaxiom complex-definitioncomplex-definition
6029,227298
+(defaxiom nonzero-imagpartnonzero-imagpart
6040,227635
+(defaxiom realpart-imagpart-elimrealpart-imagpart-elim
6045,227766
+(defaxiom realpart-complexrealpart-complex
6054,228053
+(defaxiom imagpart-compleximagpart-complex
6062,228283
+(defthm complex-equalcomplex-equal
6070,228507
+(defun force (x)force
6089,229215
+(defconst *force-xnume**force-xnume*
6228,237055
+(defun immediate-force-modep ()immediate-force-modep
6235,237176
+(defconst *immediate-force-modep-xnume**immediate-force-modep-xnume*
6284,239081
+(defun case-split (x)case-split
6287,239145
+(defmacro disable-forcing nildisable-forcing
6349,241713
+(defmacro enable-forcing nilenable-forcing
6372,242460
+(defmacro disable-immediate-force-modep ()disable-immediate-force-modep
6397,243258
+(defmacro enable-immediate-force-modep ()enable-immediate-force-modep
6423,244196
+(defun synp (vars form term)synp
6449,245120
+(defmacro syntaxp (form)syntaxp
6485,246766
+(deflabel syntaxp-examplessyntaxp-examples
6715,257753
+(defmacro bind-free (form &optional (vars))bind-free
6918,264265
+(deflabel bind-free-examplesbind-free-examples
7221,277543
+(defun extra-info (x y)extra-info
7408,284547
+(defconst *extra-info-fn**extra-info-fn*
7415,284709
+(deflabel rule-classesrule-classes
7430,285381
+(defun tau-system (x)tau-system
7723,303021
+(defconst *tau-status-boot-strap-settings**tau-status-boot-strap-settings*
8165,323041
+(defconst *tau-system-xnume**tau-system-xnume*
8184,324024
+(defconst *tau-acl2-numberp-pair* '(0 . ACL2-NUMBERP))*tau-acl2-numberp-pair*
8188,324149
+(defconst *tau-integerp-pair**tau-integerp-pair*
8189,324204
+(defconst *tau-rationalp-pair**tau-rationalp-pair*
8194,324323
+(defconst *tau-natp-pair**tau-natp-pair*
8199,324445
+(defconst *tau-posp-pair**tau-posp-pair*
8204,324554
+(defconst *tau-minusp-pair**tau-minusp-pair*
8209,324663
+(defconst *tau-booleanp-pair**tau-booleanp-pair*
8214,324778
+(defaxiom nonnegative-productnonnegative-product
8238,325747
+(defaxiom Integer-0Integer-0
8268,326743
+(defaxiom Integer-1Integer-1
8272,326800
+(defaxiom Integer-stepInteger-step
8276,326857
+(defaxiom Lowest-TermsLowest-Terms
8282,326999
+(defthm basic-tau-rulesbasic-tau-rules
8310,328045
+(defaxiom car-cdr-elimcar-cdr-elim
8363,329881
+(defaxiom car-cons (equal (car (cons x y)) x))car-cons
8368,329994
+(defaxiom cdr-cons (equal (cdr (cons x y)) y))cdr-cons
8370,330042
+(defaxiom cons-equalcons-equal
8372,330090
+(defaxiom booleanp-characterpbooleanp-characterp
8385,330495
+(defaxiom characterp-pagecharacterp-page
8389,330575
+(defaxiom characterp-tabcharacterp-tab
8393,330645
+(defaxiom characterp-ruboutcharacterp-rubout
8397,330713
+(defun no-duplicatesp-eq-exec (l)no-duplicatesp-eq-exec
8403,330805
+(defun no-duplicatesp-eql-exec (l)no-duplicatesp-eql-exec
8409,330994
+(defun no-duplicatesp-equal (l)no-duplicatesp-equal
8415,331183
+(defmacro no-duplicatesp-eq (x)no-duplicatesp-eq
8421,331369
+(defthm no-duplicatesp-eq-exec-is-no-duplicatesp-equalno-duplicatesp-eq-exec-is-no-duplicatesp-equal
8424,331436
+(defthm no-duplicatesp-eql-exec-is-no-duplicatesp-equalno-duplicatesp-eql-exec-is-no-duplicatesp-equal
8428,331564
+(defmacro no-duplicatesp (x &key (test ''eql))no-duplicatesp
8432,331694
+(defun chk-no-duplicatesp (lst)chk-no-duplicatesp
8484,333593
+(defun r-eqlable-alistp (x)r-eqlable-alistp
8492,333771
+(defun r-symbol-alistp (x)r-symbol-alistp
8512,334360
+(defun rassoc-eq-exec (x alist)rassoc-eq-exec
8531,334904
+(defun rassoc-eql-exec (x alist)rassoc-eql-exec
8539,335195
+(defun rassoc-equal (x alist)rassoc-equal
8547,335491
+(defmacro rassoc-eq (x alist)rassoc-eq
8556,335810
+(defthm rassoc-eq-exec-is-rassoc-equalrassoc-eq-exec-is-rassoc-equal
8559,335874
+(defthm rassoc-eql-exec-is-rassoc-equalrassoc-eql-exec-is-rassoc-equal
8563,335982
+(defmacro rassoc (x alist &key (test ''eql))rassoc
8568,336109
+(defconst *standard-chars**standard-chars*
8624,338451
+(defun standard-char-p (x)standard-char-p
8634,338920
+(defun standard-char-listp (l)standard-char-listp
8660,339706
+(defun character-listp (l)character-listp
8682,340308
+(defthm character-listp-forward-to-eqlable-listpcharacter-listp-forward-to-eqlable-listp
8698,340729
+(defthm standard-char-listp-forward-to-character-listpstandard-char-listp-forward-to-character-listp
8703,340875
+(defaxiom coerce-inverse-1coerce-inverse-1
8708,341033
+(defaxiom coerce-inverse-2coerce-inverse-2
8737,342065
+(defaxiom character-listp-coercecharacter-listp-coerce
8747,342366
+(defun string (x)string
8779,343796
+(defun alpha-char-p (x)alpha-char-p
8817,345081
+(defun upper-case-p (x)upper-case-p
8845,346041
+(defun lower-case-p (x)lower-case-p
8874,347084
+(defun char-upcase (x)char-upcase
8903,348126
+(defun char-downcase (x)char-downcase
8959,350090
+(defthm lower-case-p-char-downcaselower-case-p-char-downcase
9014,352105
+(defthm upper-case-p-char-upcaseupper-case-p-char-upcase
9019,352252
+(defthm lower-case-p-forward-to-alpha-char-plower-case-p-forward-to-alpha-char-p
9024,352395
+(defthm upper-case-p-forward-to-alpha-char-pupper-case-p-forward-to-alpha-char-p
9030,352570
+(defthm alpha-char-p-forward-to-characterpalpha-char-p-forward-to-characterp
9036,352745
+(defthm characterp-char-downcasecharacterp-char-downcase
9041,352879
+(defthm characterp-char-upcasecharacterp-char-upcase
9045,352982
+(defun string-downcase1 (l)string-downcase1
9054,353307
+(defthm character-listp-string-downcase-1character-listp-string-downcase-1
9063,353586
+(defun string-downcase (x)string-downcase
9067,353688
+(defun string-upcase1 (l)string-upcase1
9094,354668
+(defthm character-listp-string-upcase1-1character-listp-string-upcase1-1
9103,354941
+(defun string-upcase (x)string-upcase
9107,355040
+(defun our-digit-char-p (ch radix)our-digit-char-p
9128,355755
+(defmacro digit-char-p (ch &optional (radix '10))digit-char-p
9201,358006
+(defun char-equal (x y)char-equal
9224,358906
+(defun atom-listp (lst)atom-listp
9248,359698
+(defthm atom-listp-forward-to-true-listpatom-listp-forward-to-true-listp
9266,360158
+(defthm eqlable-listp-forward-to-atom-listpeqlable-listp-forward-to-atom-listp
9271,360288
+(defun good-atom-listp (lst)good-atom-listp
9276,360424
+(defthm good-atom-listp-forward-to-atom-listpgood-atom-listp-forward-to-atom-listp
9300,361139
+(defthm characterp-nthcharacterp-nth
9305,361279
+(defun ifix (x)ifix
9311,361431
+(defun rfix (x)rfix
9330,361944
+(defun realfix (x)realfix
9359,362998
+(defun nfix (x)nfix
9378,363525
+(defun string-equal1 (str1 str2 i maximum)string-equal1
9399,364089
+(defun string-equal (str1 str2)string-equal
9424,365012
+(defun standard-string-alistp (x)standard-string-alistp
9451,365996
+(defthm standard-string-alistp-forward-to-alistpstandard-string-alistp-forward-to-alistp
9472,366712
+(defun assoc-string-equal (str alist)assoc-string-equal
9477,366858
+(defdoc e0-ordinalpe0-ordinalp
9513,368184
+(defdoc e0-ord-<e0-ord-<
9530,368986
+(defun natp (x)natp
9547,369802
+(defthm natp-compound-recognizernatp-compound-recognizer
9566,370456
+(defun posp (x)posp
9572,370598
+(defthm posp-compound-recognizerposp-compound-recognizer
9589,371177
+(defun o-finp (x)o-finp
9595,371318
+(defmacro o-infp (x)o-infp
9610,371809
+(defun o-first-expt (x)o-first-expt
9620,372028
+(defun o-first-coeff (x)o-first-coeff
9640,372715
+(defun o-rst (x)o-rst
9660,373423
+(defun o<g (x)o<g
9677,374083
+(defun o< (x y)o<
9689,374349
+(defmacro o> (x y)o>
9764,378142
+(defmacro o<= (x y)o<=
9773,378338
+(defmacro o>= (x y)o>=
9782,378555
+(defun o-p (x)o-p
9791,378775
+(defthm o-p-implies-o<go-p-implies-o<g
9976,385860
+(defun make-ord (fe fco rst)make-ord
9982,385946
+(defun list*-macro (lst)list*-macro
10021,387333
+(defmacro list* (&rest args)list*
10031,387610
+(defmacro throw-without-attach (ignored-attachment fn formals)throw-without-attach
10050,388083
+(defvar *aokp**aokp*
10057,388318
+(defmacro aokp ()aokp
10064,388490
+(defvar *attached-fn-called* nil)*attached-fn-called*
10068,388527
+(defmacro update-attached-fn-called (fn)update-attached-fn-called
10071,388569
+(defmacro throw-or-attach (fn formals &optional *1*-p)throw-or-attach
10075,388687
+(defun throw-or-attach-call (fn formals)throw-or-attach-call
10103,389804
+(defun null-body-er (fn formals maybe-attach)null-body-er
10147,391623
+(defconst *main-lisp-package-name**main-lisp-package-name*
10169,392754
+(defconst *initial-known-package-alist**initial-known-package-alist*
10184,393439
+(defaxiom stringp-symbol-package-namestringp-symbol-package-name
10205,394456
+(defaxiom symbolp-intern-in-package-of-symbolsymbolp-intern-in-package-of-symbol
10209,394567
+(defaxiom symbolp-pkg-witnesssymbolp-pkg-witness
10213,394696
+(defparameter *ld-level**ld-level*
10218,394808
+(defvar *hard-error-returns-nilp* nil)*hard-error-returns-nilp*
10251,396626
+(defun-one-output throw-raw-ev-fncall (val)throw-raw-ev-fncall
10254,396683
+(defun hard-error (ctx str alist)hard-error
10275,397471
+(defun illegal (ctx str alist)illegal
10392,402919
+(defmacro intern (x y)intern
10460,405728
+(defmacro intern$ (x y)intern$
10527,408726
+(defun keywordp (x)keywordp
10548,409429
+(defthm keywordp-forward-to-symbolpkeywordp-forward-to-symbolp
10577,410231
+(defaxiom intern-in-package-of-symbol-symbol-nameintern-in-package-of-symbol-symbol-name
10582,410351
+(defthm symbol-package-name-of-symbol-is-not-empty-stringsymbol-package-name-of-symbol-is-not-empty-string
10595,411011
+(defconst *pkg-witness-name* "ACL2-PKG-WITNESS")*pkg-witness-name*
10611,411806
+(defaxiom symbol-name-pkg-witnesssymbol-name-pkg-witness
10613,411856
+(defaxiom symbol-package-name-pkg-witness-namesymbol-package-name-pkg-witness-name
10617,411967
+(defun member-symbol-name (str l)member-symbol-name
10634,412629
+(defthm symbol-equalitysymbol-equality
10643,412902
+(defaxiom symbol-name-intern-in-package-of-symbolsymbol-name-intern-in-package-of-symbol
10663,413573
+(defaxiom symbol-package-name-intern-in-package-of-symbolsymbol-package-name-intern-in-package-of-symbol
10668,413770
+(defaxiom intern-in-package-of-symbol-is-identityintern-in-package-of-symbol-is-identity
10677,414132
+(defaxiom symbol-listp-pkg-importssymbol-listp-pkg-imports
10688,414539
+(defaxiom no-duplicatesp-eq-pkg-importsno-duplicatesp-eq-pkg-imports
10692,414684
+(defaxiom completion-of-pkg-importscompletion-of-pkg-imports
10696,414791
+(defaxiom acl2-input-channel-packageacl2-input-channel-package
10709,415194
+(defaxiom acl2-output-channel-packageacl2-output-channel-package
10713,415291
+(defaxiom acl2-packageacl2-package
10717,415390
+(defaxiom keyword-packagekeyword-package
10721,415500
+(defaxiom string-is-not-circularstring-is-not-circular
10729,415739
+(defaxiom nil-is-not-circularnil-is-not-circular
10737,416068
+(defun-one-output intern-in-package-of-symbol (str sym)intern-in-package-of-symbol
10772,417716
+(defdoc pkg-importspkg-imports
10809,419573
+(defun-one-output pkg-imports (pkg)pkg-imports
10865,421950
+(defdoc pkg-witnesspkg-witness
10873,422316
+(defun-one-output pkg-witness (pkg)pkg-witness
10890,423056
+(defun binary-append (x y)binary-append
10908,423752
+(defmacro append (&rest rst)append
10927,424232
+(defthm true-listp-appendtrue-listp-append
10948,425059
+(defthm standard-char-listp-appendstandard-char-listp-append
10978,425919
+(defthm character-listp-appendcharacter-listp-append
10985,426192
+(defthm append-to-nilappend-to-nil
10991,426389
+(defmacro concatenate (result-type &rest sequences)concatenate
10997,426511
+(defun string-append (str1 str2)string-append
11052,428841
+(defun string-listp (x)string-listp
11088,430054
+(defun string-append-lst (x)string-append-lst
11107,430455
+(defmacro 1+ (x)1+
11120,430817
+(defmacro 1- (x)1-
11134,431079
+(defun remove-eq-exec (x l)remove-eq-exec
11149,431334
+(defun remove-eql-exec (x l)remove-eql-exec
11158,431635
+(defun remove-equal (x l)remove-equal
11167,431942
+(defmacro remove-eq (x lst)remove-eq
11177,432274
+(defthm remove-eq-exec-is-remove-equalremove-eq-exec-is-remove-equal
11180,432334
+(defthm remove-eql-exec-is-remove-equalremove-eql-exec-is-remove-equal
11184,432434
+(defmacro remove (x l &key (test ''eql))remove
11189,432553
+(defun remove1-eq-exec (x l)remove1-eq-exec
11247,434664
+(defun remove1-eql-exec (x l)remove1-eql-exec
11256,434948
+(defun remove1-equal (x l)remove1-equal
11265,435237
+(defmacro remove1-eq (x lst)remove1-eq
11272,435430
+(defthm remove1-eq-exec-is-remove1-equalremove1-eq-exec-is-remove1-equal
11275,435492
+(defthm remove1-eql-exec-is-remove1-equalremove1-eql-exec-is-remove1-equal
11279,435596
+(defmacro remove1 (x l &key (test ''eql))remove1
11283,435702
+(deflabel pairlispairlis
11336,437751
+(defun pairlis$ (x y)pairlis$
11346,437991
+(defun remove-duplicates-eq-exec (l)remove-duplicates-eq-exec
11374,438995
+(defun remove-duplicates-eql-exec (l)remove-duplicates-eql-exec
11381,439232
+(defun remove-duplicates-equal (l)remove-duplicates-equal
11388,439470
+(defmacro remove-duplicates-eq (x)remove-duplicates-eq
11395,439702
+(defthm remove-duplicates-eq-exec-is-remove-duplicates-equalremove-duplicates-eq-exec-is-remove-duplicates-equal
11398,439775
+(defthm remove-duplicates-eql-exec-is-remove-duplicates-equalremove-duplicates-eql-exec-is-remove-duplicates-equal
11402,439915
+(defmacro remove-duplicates-logic (x)remove-duplicates-logic
11406,440057
+(defmacro remove-duplicates (x &key (test ''eql))remove-duplicates
11414,440275
+(defthm character-listp-remove-duplicatescharacter-listp-remove-duplicates
11486,443322
+(deflabel eventsevents
11495,443679
+(deflabel documentationdocumentation
11526,445219
+(deflabel historyhistory
11725,453827
+(defmacro first (x)first
11752,455000
+(defmacro second (x)second
11761,455177
+(defmacro third (x)third
11770,455357
+(defmacro fourth (x)fourth
11779,455536
+(defmacro fifth (x)fifth
11788,455718
+(defmacro sixth (x)sixth
11797,455910
+(defmacro seventh (x)seventh
11806,456103
+(defmacro eighth (x)eighth
11815,456301
+(defmacro ninth (x)ninth
11824,456498
+(defmacro tenth (x)tenth
11833,456705
+(defmacro rest (x)rest
11842,456913
+(defun identity (x) (declare (xargs :guard t))identity
11856,457200
+(defun revappend (x y)revappend
11870,457499
+(defthm character-listp-revappendcharacter-listp-revappend
11904,458455
+(defun reverse (x)reverse
11915,458799
+(defdoc switches-parameters-and-modesswitches-parameters-and-modes
11938,459446
+(defconst *valid-output-names**valid-output-names*
11947,459775
+(defun set-difference-eq-exec (l1 l2)set-difference-eq-exec
11953,459932
+(defun set-difference-eql-exec (l1 l2)set-difference-eql-exec
11963,460342
+(defun set-difference-equal (l1 l2)set-difference-equal
11973,460754
+(defmacro set-difference-eq (l1 l2)set-difference-eq
11981,461056
+(defthm set-difference-eq-exec-is-set-difference-equalset-difference-eq-exec-is-set-difference-equal
11984,461133
+(defthm set-difference-eql-exec-is-set-difference-equalset-difference-eql-exec-is-set-difference-equal
11988,461269
+(defmacro set-difference$ (l1 l2 &key (test ''eql))set-difference$
11992,461407
+(defun listp (x)listp
12050,463801
+(defconst *summary-types**summary-types*
12070,464294
+(defun with-output-fn (ctx args off on gag-mode off-on-p gag-p stackwith-output-fn
12073,464398
+(defun last (l)last
12234,471605
+(defun first-n-ac (i l ac)first-n-ac
12263,472292
+(defun take (n l)take
12271,472547
+(defun butlast (lst n)butlast
12319,474045
+(defmacro with-output (&rest args)with-output
12360,475294
+(defmacro with-output (&rest args)with-output
12364,475368
+(defun mutual-recursion-guardp (rst)mutual-recursion-guardp
12541,482859
+(defun collect-cadrs-when-car-eq (x alist)collect-cadrs-when-car-eq
12550,483228
+(defmacro value (x)value
12558,483539
+(defun value-triple-fn (form on-skip-proofs check)value-triple-fn
12564,483615
+(defmacro value-triple (form &key on-skip-proofs check)value-triple
12591,484755
+(defmacro assert-event (form &key on-skip-proofs msg)assert-event
12633,486599
+(defun xd-name (event-type name)xd-name
12678,488628
+(defun defund-name-list (defuns acc)defund-name-list
12689,488975
+(defun throw-nonexec-error (fn actuals)throw-nonexec-error
12702,489421
+(defun defun-nx-fn (form disabledp)defun-nx-fn
12746,490935
+(defmacro defun-nx (&whole form &rest rest)defun-nx
12760,491455
+(defmacro defund-nx (&whole form &rest rest)defund-nx
12836,494568
+(defun update-mutual-recursion-for-defun-nx-1 (defs)update-mutual-recursion-for-defun-nx-1
12842,494770
+(defun update-mutual-recursion-for-defun-nx (defs)update-mutual-recursion-for-defun-nx
12857,495359
+(defmacro mutual-recursion (&whole event-form &rest rst)mutual-recursion
12866,495678
+(defun pseudo-termp (x)pseudo-termp
13005,501305
+(defun pseudo-term-listp (lst)pseudo-term-listp
13088,505499
+(defthm pseudo-term-listp-forward-to-true-listppseudo-term-listp-forward-to-true-listp
13096,505691
+(defun pseudo-term-list-listp (l)pseudo-term-list-listp
13107,505983
+(defun add-to-set-eq-exec (x lst)add-to-set-eq-exec
13118,506218
+(defun add-to-set-eql-exec (x lst)add-to-set-eql-exec
13125,506448
+(defun add-to-set-equal (x l)add-to-set-equal
13132,506678
+(defmacro add-to-set-eq (x lst)add-to-set-eq
13145,507113
+(defmacro add-to-set-eql (x lst)add-to-set-eql
13150,507268
+(defthm add-to-set-eq-exec-is-add-to-set-equaladd-to-set-eq-exec-is-add-to-set-equal
13153,507338
+(defthm add-to-set-eql-exec-is-add-to-set-equaladd-to-set-eql-exec-is-add-to-set-equal
13157,507458
+(defmacro add-to-set (x lst &key (test ''eql))add-to-set
13165,507732
+(defmacro variablep (x) (list 'atom x))variablep
13217,509874
+(defmacro nvariablep (x) (list 'consp x))nvariablep
13219,509915
+(defmacro fquotep (x) (list 'eq ''quote (list 'car x)))fquotep
13221,509958
+(defun quotep (x)quotep
13223,510015
+(defconst *t* (quote (quote t)))*t*
13228,510109
+(defconst *nil* (quote (quote nil)))*nil*
13229,510142
+(defconst *0* (quote (quote 0)))*0*
13230,510179
+(defconst *1* (quote (quote 1)))*1*
13231,510212
+(defconst *-1* (quote (quote -1)))*-1*
13232,510245
+(defun kwote (x)kwote
13234,510281
+(defun kwote-lst (lst)kwote-lst
13263,511111
+(defmacro unquote (x) (list 'cadr x))unquote
13278,511566
+(defmacro ffn-symb (x) (list 'car x))ffn-symb
13280,511605
+(defun fn-symb (x)fn-symb
13282,511644
+(defmacro fargs (x) (list 'cdr x))fargs
13289,511773
+(defun all-vars1 (term ans)all-vars1
13293,511828
+(defun all-vars1-lst (lst ans)all-vars1-lst
13302,512129
+(defun all-vars (term)all-vars
13316,512564
+(defmacro translate-and-test (test-fn form)translate-and-test
13361,514910
+(defun intersectp-eq-exec (x y)intersectp-eq-exec
13429,518421
+(defun intersectp-eql-exec (x y)intersectp-eql-exec
13438,518752
+(defun intersectp-equal (x y)intersectp-equal
13447,519084
+(defmacro intersectp-eq (x y)intersectp-eq
13454,519311
+(defthm intersectp-eq-exec-is-intersectp-equalintersectp-eq-exec-is-intersectp-equal
13457,519375
+(defthm intersectp-eql-exec-is-intersectp-equalintersectp-eql-exec-is-intersectp-equal
13461,519491
+(defmacro intersectp (x y &key (test ''eql))intersectp
13465,519609
+(defun make-fmt-bindings (chars forms)make-fmt-bindings
13515,521509
+(defmacro msg (str &rest args)msg
13524,521884
+(defun check-vars-not-free-test (vars term)check-vars-not-free-test
13654,526758
+(defmacro check-vars-not-free (vars form)check-vars-not-free
13662,527064
+(defun er-progn-fn (lst)er-progn-fn
13678,527643
+(defmacro er-progn (&rest lst)er-progn
13702,528642
+(defun er-progn-fn@par (lst)er-progn-fn@par
13755,530599
+(defmacro er-progn@par (&rest lst)er-progn@par
13778,531554
+(defun legal-case-clausesp (tl)legal-case-clausesp
13792,531821
+(defun case-test (x pat)case-test
13808,532339
+(defun case-list (x l)case-list
13813,532496
+(defun case-list-check (l)case-list-check
13825,532919
+(defmacro case (&rest l)case
13842,533628
+(defun position-ac-eq-exec (item lst acc)position-ac-eq-exec
13909,535248
+(defun position-ac-eql-exec (item lst acc)position-ac-eql-exec
13920,535609
+(defun position-equal-ac (item lst acc)position-equal-ac
13931,535975
+(defmacro position-ac-equal (item lst acc)position-ac-equal
13945,536431
+(defmacro position-eq-ac (item lst acc)position-eq-ac
13949,536564
+(defmacro position-ac-eq (item lst acc)position-ac-eq
13957,536809
+(defthm position-ac-eq-exec-is-position-equal-acposition-ac-eq-exec-is-position-equal-ac
13960,536894
+(defthm position-ac-eql-exec-is-position-equal-acposition-ac-eql-exec-is-position-equal-ac
13964,537032
+(defmacro position-ac (item lst acc &key (test ''eql))position-ac
13968,537172
+(defun position-eq-exec (item lst)position-eq-exec
13986,537827
+(defun position-eql-exec (item lst)position-eql-exec
13992,538052
+(defun position-equal (item lst)position-equal
14001,538397
+(defmacro position-eq (item lst)position-eq
14010,538728
+(defthm position-eq-exec-is-position-equalposition-eq-exec-is-position-equal
14013,538798
+(defthm position-eql-exec-is-position-equalposition-eql-exec-is-position-equal
14018,538966
+(defmacro position (x seq &key (test ''eql))position
14023,539103
+(defun nonnegative-integer-quotient (i j)nonnegative-integer-quotient
14077,541297
+(defun true-list-listp (x)true-list-listp
14113,542517
+(defthm true-list-listp-forward-to-true-listptrue-list-listp-forward-to-true-listp
14130,543042
+(defun legal-let*-p (bindings ignore-vars ignored-seen top-form)legal-let*-p
14135,543182
+(defun well-formed-type-decls-p (decls vars)well-formed-type-decls-p
14174,545208
+(defun symbol-list-listp (x)symbol-list-listp
14186,545615
+(defun get-type-decls (var type-decls)get-type-decls
14192,545791
+(defun let*-macro (bindings ignore-vars ignorable-vars type-decls body)let*-macro
14203,546303
+(defun collect-cdrs-when-car-eq (x alist)collect-cdrs-when-car-eq
14246,548695
+(defun append-lst (lst)append-lst
14255,549048
+(defun restrict-alist (keys alist)restrict-alist
14260,549203
+(defmacro let* (&whole form bindings &rest decl-body)let*
14276,549624
+(defmacro progn (&rest r)progn
14360,553389
+(defun floor1 (x)floor1
14408,555225
+(defdoc realreal
14418,555384
+(defun floor (i j)floor
14471,557576
+(defun ceiling (i j)ceiling
14541,560158
+(defun truncate (i j)truncate
14600,562105
+(defun round (i j)round
14663,564219
+(defun mod (x y)mod
14735,566308
+(defun rem (x y)rem
14769,567116
+(defun evenp (x)evenp
14803,567938
+(defun oddp (x)oddp
14823,568494
+(defun zerop (x)zerop
14842,568975
+(defun plusp (x)plusp
14871,569916
+(defun minusp (x)minusp
14893,570455
+(defun min (x y)min
14915,570998
+(defun max (x y)max
14939,571583
+(defun abs (x)abs
14965,572292
+(defun signum (x)signum
14990,573033
+(defun lognot (i)lognot
15027,574239
+(defthm standard-char-p-nthstandard-char-p-nth
15054,575041
+(deflabel proof-of-well-foundednessproof-of-well-foundedness
15067,575540
+(defun expt (r i)expt
15248,582880
+(defun logcount (x)logcount
15280,583977
+(defun nthcdr (n l)nthcdr
15307,584650
+(defun logbitp (i j)logbitp
15342,585599
+(defun ash (i c)ash
15366,586375
+(defthm expt-type-prescription-non-zero-baseexpt-type-prescription-non-zero-base
15394,587257
+(defthm realp-expt-type-prescriptionrealp-expt-type-prescription
15403,587540
+(defthm rationalp-expt-type-prescriptionrationalp-expt-type-prescription
15408,587666
+(deflabel characterscharacters
15417,587882
+(defaxiom char-code-linearchar-code-linear
15485,590646
+(defaxiom code-char-typecode-char-type
15494,590884
+(defaxiom code-char-char-code-is-identitycode-char-char-code-is-identity
15498,590975
+(defaxiom char-code-code-char-is-identitychar-code-code-char-is-identity
15502,591101
+(defun char< (x y)char<
15509,591315
+(defun char> (x y)char>
15529,591888
+(defun char<= (x y)char<=
15549,592467
+(defun char>= (x y)char>=
15569,593066
+(defun string<-l (l1 l2 i)string<-l
15588,593654
+(defun string< (str1 str2)string<
15602,594081
+(defun string> (str1 str2)string>
15639,595121
+(defun string<= (str1 str2)string<=
15660,595748
+(defun string>= (str1 str2)string>=
15686,596613
+(defun symbol-< (x y)symbol-<
15711,597461
+(defthm string<-l-irreflexivestring<-l-irreflexive
15737,598410
+(defthm string<-irreflexivestring<-irreflexive
15740,598468
+(defun substitute-ac (new old seq acc)substitute-ac
15743,598520
+(defun substitute (new old seq)substitute
15757,598966
+(defun sublis (alist tree)sublis
15793,600310
+(defun subst (new old tree)subst
15823,601350
+(defmacro pprogn (&rest lst)pprogn
15848,602175
+(defmacro progn$ (&rest rst)progn$
15911,604130
+(defmacro pprogn@par (&rest rst)pprogn@par
15937,604841
+(defparameter *acl2-unwind-protect-stack* nil)*acl2-unwind-protect-stack*
16066,612457
+(defmacro push-car (item place ctx)push-car
16069,612522
+(defmacro acl2-unwind-protect (expl body cleanup1 cleanup2)acl2-unwind-protect
16087,613342
+(defun-one-output acl2-unwind (n flg)acl2-unwind
16193,618249
+(defmacro when-logic (str x)when-logic
16369,627978
+(defmacro in-package (str)in-package
16393,628859
+(defmacro defpkg (&whole event-form name form &optional doc book-path hidden-p)defpkg
16422,629708
+(defdoc managing-acl2-packagesmanaging-acl2-packages
16544,635544
+(deflabel hidden-defpkghidden-defpkg
16553,635819
+(deflabel hidden-death-packagehidden-death-package
16561,635951
+(defmacro defun (&whole event-form &rest def)defun
16623,638577
+(defmacro defun-std (&whole event-form &rest def)defun-std
16868,650539
+(defmacro defuns (&whole event-form &rest def-lst)defuns
16884,650902
+(defmacro defuns-std (&whole event-form &rest def-lst)defuns-std
16927,652165
+(defmacro verify-termination (&rest lst)verify-termination
16942,652539
+(defmacro verify-termination-boot-strap (&whole event-form &rest lst)verify-termination-boot-strap
17106,660607
+(defmacro verify-guards (&whole event-form name &key hints otf-flg guard-debugverify-guards
17116,660888
+(defmacro verify-guards+ (name &rest rest)verify-guards+
17440,676004
+(defdoc defpundefpun
17518,679780
+(defmacro defmacro (&whole event-form &rest mdef)defmacro
17553,681135
+(defmacro defconst (&whole event-form name form &optional doc)defconst
17646,685145
+(defmacro defthm (&whole event-formdefthm
17717,688175
+(defmacro defthmd (&whole event-formdefthmd
17798,691218
+(defmacro defthm-std (&whole event-formdefthm-std
17844,692592
+(defmacro defaxiom (&whole event-form name termdefaxiom
17872,693334
+(defmacro deflabel (&whole event-form name &key doc)deflabel
17919,695030
+(deflabel theoriestheories
17960,696555
+(defmacro deftheory (&whole event-form name expr &key doc)deftheory
18119,705050
+(defmacro deftheory-static (name theory)deftheory-static
18204,708362
+(defmacro defstobj (&whole event-form name &rest args)defstobj
18283,711721
+(defmacro in-theory (&whole event-form expr &key doc)in-theory
18723,733027
+(defmacro in-arithmetic-theory (&whole event-form expr &key doc)in-arithmetic-theory
18788,735867
+(defmacro regenerate-tau-database (&whole event-form &key doc)regenerate-tau-database
18847,738352
+(defmacro push-untouchable (&whole event-form name fn-p &key doc)push-untouchable
18926,742437
+(defmacro remove-untouchable (&whole event-form name fn-p &key doc)remove-untouchable
18984,744858
+(defmacro set-body (&whole event-form fn name-or-rune)set-body
19083,749474
+(defmacro table (&whole event-form name &rest args)table
19124,751086
+(defmacro encapsulate (&whole event-form signatures &rest cmd-lst)encapsulate
19341,762547
+(defdoc redundant-encapsulateredundant-encapsulate
19602,775116
+(defconst *load-compiled-file-values**load-compiled-file-values*
19695,779137
+(defmacro include-book (&whole event-form user-book-nameinclude-book
19699,779226
+(defmacro make-event (&whole event-formmake-event
19902,790111
+(defdoc make-event-detailsmake-event-details
20641,824716
+(defdoc using-tables-efficientlyusing-tables-efficiently
20865,836610
+(defmacro record-expansion (x y)record-expansion
20946,839809
+(defmacro skip-proofs (x)skip-proofs
21149,850424
+(defmacro local (x)local
21257,855972
+(defmacro defchoose (&whole event-form &rest def)defchoose
21317,858438
+(deflabel conservativity-of-defchooseconservativity-of-defchoose
21478,864638
+(defmacro defattach (&whole event-form &rest args)defattach
21888,884646
+(defun attachment-symbol (x)attachment-symbol
22405,908426
+(defun set-attachment-symbol-form (fn val)set-attachment-symbol-form
22412,908603
+(defmacro defattach (&rest args)defattach
22415,908696
+(deflabel worldp) ; reserving this symbol for later useworldp
22496,912477
+(defun plist-worldp (alist)plist-worldp
22498,912534
+(defthm plist-worldp-forward-to-assoc-eq-equal-alistpplist-worldp-forward-to-assoc-eq-equal-alistp
22533,913992
+(defdoc getpropgetprop
22538,914148
+(defun putprop (symb key value world-alist)putprop
22554,914590
+(defparameter meter-maid-cnt 0)meter-maid-cnt
22618,916865
+(defun meter-maid (fn maximum &optional arg1 arg2 cnt)meter-maid
22621,916915
+(defconst *acl2-property-unbound* :acl2-property-unbound)*acl2-property-unbound*
22639,917731
+(defun getprop-default (symb key default)getprop-default
22641,917790
+(defun-one-output sgetprop1 (symb key default world-alist inst-world-alistsgetprop1
22657,918299
+(defun fgetprop (symb key default world-alist)fgetprop
22764,922665
+(defun sgetprop (symb key default world-name world-alist)sgetprop
22822,925250
+(defun ordered-symbol-alistp (x)ordered-symbol-alistp
22860,926863
+(defthm ordered-symbol-alistp-forward-to-symbol-alistpordered-symbol-alistp-forward-to-symbol-alistp
22878,927414
+(defun add-pair (key value l)add-pair
22883,927572
+(defun delete-assoc-eq-exec (key alist)delete-assoc-eq-exec
22897,927987
+(defun delete-assoc-eql-exec (key alist)delete-assoc-eql-exec
22905,928310
+(defun delete-assoc-equal (key alist)delete-assoc-equal
22913,928638
+(defmacro delete-assoc-eq (key lst)delete-assoc-eq
22919,928863
+(defthm delete-assoc-eq-exec-is-delete-assoc-equaldelete-assoc-eq-exec-is-delete-assoc-equal
22922,928939
+(defthm delete-assoc-eql-exec-is-delete-assoc-equaldelete-assoc-eql-exec-is-delete-assoc-equal
22926,929071
+(defmacro delete-assoc (key alist &key (test ''eql))delete-assoc
22930,929205
+(defun getprops1 (alist)getprops1
22983,931418
+(defun getprops (symb world-name world-alist)getprops
22998,932039
+(defthm equal-char-codeequal-char-code
23043,933828
+(defun has-propsp1 (alist exceptions known-unbound)has-propsp1
23057,934229
+(defun has-propsp (symb exceptions world-name world-alist known-unbound)has-propsp
23078,935176
+(defun extend-world (name wrld)extend-world
23110,936542
+(defun retract-world (name wrld)retract-world
23130,937209
+(defun global-val (var wrld)global-val
23150,937878
+(defun function-symbolp (sym wrld)function-symbolp
23167,938547
+(defun translate-declaration-to-guard/integer (lo var hi)translate-declaration-to-guard/integer
23188,939611
+(defun weak-satisfies-type-spec-p (x)weak-satisfies-type-spec-p
23234,941509
+(defun translate-declaration-to-guard1 (x var wrld)translate-declaration-to-guard1
23248,942020
+(defun translate-declaration-to-guard (x var wrld)translate-declaration-to-guard
23434,949556
+(defun translate-declaration-to-guard-lst (l var wrld)translate-declaration-to-guard-lst
23507,952982
+(deflabel declaredeclare
23533,953860
+(deflabel type-spectype-spec
23595,956277
+(defun the-check (guard x y)the-check
23672,959633
+(defun the-fn (x y)the-fn
23682,960029
+(defmacro the (x y)the
23732,962447
+(defconst *maximum-positive-32-bit-integer**maximum-positive-32-bit-integer*
23859,968623
+(defconst *our-array-total-size-limit**our-array-total-size-limit*
23863,968705
+(defun-one-output chk-make-array$ (dimensions form)chk-make-array$
23875,969137
+(defmacro make-array$ (&whole form dimensions &rest args)make-array$
23908,970609
+(defparameter *acl2-array-cache**acl2-array-cache*
24004,975423
+(defmacro set-acl2-array-property (name prop)set-acl2-array-property
24012,975691
+(defmacro get-acl2-array-property (name)get-acl2-array-property
24061,977492
+(defun bounded-integer-alistp (l n)bounded-integer-alistp
24089,978482
+(defthm bounded-integer-alistp-forward-to-eqlable-alistpbounded-integer-alistp-forward-to-eqlable-alistp
24105,979055
+(defun keyword-value-listp (l)keyword-value-listp
24110,979219
+(defthm keyword-value-listp-forward-to-true-listpkeyword-value-listp-forward-to-true-listp
24128,979762
+(defun assoc-keyword (key l)assoc-keyword
24133,979910
+(defthm keyword-value-listp-assoc-keywordkeyword-value-listp-assoc-keyword
24155,980633
+(defthm consp-assoc-equalconsp-assoc-equal
24161,980863
+(defmacro f-get-global (x st)f-get-global
24181,981738
+(defun our-import (syms pkg)our-import
24219,982850
+(defvar *defpkg-virgins* nil)*defpkg-virgins*
24238,983868
+(defun check-proposed-imports (name package-entry proposed-imports)check-proposed-imports
24240,983899
+(defun-one-output defpkg-raw1 (name imports book-path event-form)defpkg-raw1
24299,986872
+(defun package-has-no-imports (name)package-has-no-imports
24393,990887
+(defmacro maybe-make-package (name)maybe-make-package
24401,991128
+(defmacro maybe-introduce-empty-pkg-1 (name)maybe-introduce-empty-pkg-1
24485,994181
+(defmacro maybe-introduce-empty-pkg-2 (name)maybe-introduce-empty-pkg-2
24530,996163
+(defmacro defpkg-raw (name imports book-path event-form)defpkg-raw
24538,996484
+(defun-one-output slow-array-warning (fn nm)slow-array-warning
24568,997743
+(deflabel arraysarrays
24585,998434
+(deflabel arrays-examplearrays-example
25000,1020882
+(deflabel slow-array-warningslow-array-warning
25080,1023727
+(defun array1p (name l)array1p
25184,1029157
+(defthm array1p-forwardarray1p-forward
25235,1031469
+(defthm array1p-lineararray1p-linear
25255,1032630
+(defun bounded-integer-alistp2 (l i j)bounded-integer-alistp2
25264,1033134
+(defun assoc2 (i j l)assoc2
25283,1033964
+(defun array2p (name l)array2p
25295,1034269
+(defthm array2p-forwardarray2p-forward
25338,1035999
+(defthm array2p-lineararray2p-linear
25363,1037564
+(defun header (name l)header
25376,1038295
+(defun dimensions (name l)dimensions
25408,1039285
+(defun maximum-length (name l)maximum-length
25435,1040375
+(defun default (name l)default
25459,1041268
+(defun aref1 (name l n)aref1
25507,1043537
+(defun compress11 (name l i n default)compress11
25558,1045317
+(defconstant *invisible-array-mark* 'acl2_invisible::|An Invisible Array Mark|)*invisible-array-mark*
25573,1045908
+(defun array-order (header)array-order
25575,1045989
+(defun compress1 (name l)compress1
25588,1046382
+(defthm array1p-consarray1p-cons
25855,1059244
+(defun aset1 (name l n val)aset1
25865,1059602
+(defun aref2 (name l i j)aref2
25989,1065698
+(defun compress211 (name l i x j default)compress211
26036,1067392
+(defun compress21 (name l n i j default)compress21
26052,1068030
+(defun compress2 (name l)compress2
26065,1068516
+(defthm array2p-consarray2p-cons
26243,1076477
+(defun aset2 (name l i j val)aset2
26254,1076855
+(defun flush-compress (name)flush-compress
26367,1081729
+(defparameter *return-values**return-values*
26528,1088064
+(defmacro declare-return-values ()declare-return-values
26535,1088253
+(defun declare-return-values1 ()declare-return-values1
26538,1088331
+(defun in-akcl-with-mv-set-and-ref ()in-akcl-with-mv-set-and-ref
26549,1088553
+(defconstant *akcl-mv-ref-and-set-inclusive-upper-bound* 9)*akcl-mv-ref-and-set-inclusive-upper-bound*
26552,1088628
+(defmacro special-location (i)special-location
26554,1088689
+(defmacro set-mv (i v)set-mv
26564,1089098
+(defmacro mv-ref (i)mv-ref
26577,1089564
+(defun mv-refs-fn (i)mv-refs-fn
26589,1089996
+(defmacro mv-refs (i)mv-refs
26597,1090130
+(defun cdrn (x i)cdrn
26614,1090553
+(defun mv-nth (n l)mv-nth
26620,1090719
+(defun make-mv-nths (args call i)make-mv-nths
26672,1092740
+(defun mv-bindings (lst)mv-bindings
26680,1093052
+(defun mv-set-mvs (bindings i)mv-set-mvs
26690,1093376
+(defmacro mv (&rest l)mv
26695,1093541
+(defmacro mv? (&rest l)mv?
26843,1099096
+(defmacro mv-let (&rest rst)mv-let
26914,1101460
+(defmacro mv?-let (vars form &rest rst)mv?-let
27068,1108086
+(defun mv-list (input-arity x)mv-list
27124,1109721
+(defmacro mv-list (input-arity x)mv-list
27169,1111503
+(defmacro mv-list (input-arity x)mv-list
27174,1111653
+(deflabel statestate
27177,1111730
+(defdoc programming-with-stateprogramming-with-state
27352,1120894
+(defdoc error-tripleserror-triples
27887,1144010
+(defun update-nth (key val l)update-nth
27915,1145195
+(defun update-nth-array (j key val l)update-nth-array
27958,1146515
+(defmacro maximum-positive-32-bit-integer ()maximum-positive-32-bit-integer
27969,1146945
+(defmacro maximum-positive-32-bit-integer-minus-1 ()maximum-positive-32-bit-integer-minus-1
27972,1147028
+(defun 32-bit-integerp (x)32-bit-integerp
27975,1147130
+(defthm 32-bit-integerp-forward-to-integerp32-bit-integerp-forward-to-integerp
27981,1147313
+(defun acl2-number-listp (l)acl2-number-listp
27986,1147449
+(defthm acl2-number-listp-forward-to-true-listpacl2-number-listp-forward-to-true-listp
28003,1147873
+(defun rational-listp (l)rational-listp
28008,1148017
+(defthm rational-listp-forward-to-acl2-number-listprational-listp-forward-to-acl2-number-listp
28025,1148447
+(defun real-listp (l)real-listp
28033,1148680
+(defdoc real-listpreal-listp
28040,1148844
+(defthm real-listp-forward-to-acl2-number-listpreal-listp-forward-to-acl2-number-listp
28052,1149193
+(defun integer-listp (l)integer-listp
28057,1149337
+(defthm integer-listp-forward-to-rational-listpinteger-listp-forward-to-rational-listp
28074,1149747
+(defun nat-listp (l)nat-listp
28079,1149891
+(defthm nat-listp-forward-to-integer-listpnat-listp-forward-to-integer-listp
28096,1150300
+(defthm rational-listp-forward-to-real-listprational-listp-forward-to-real-listp
28104,1150527
+(defun 32-bit-integer-listp (l)32-bit-integer-listp
28109,1150665
+(defthm 32-bit-integer-listp-forward-to-integer-listp32-bit-integer-listp-forward-to-integer-listp
28115,1150853
+(defun open-input-channels (st)open-input-channels
28124,1151204
+(defun update-open-input-channels (x st)update-open-input-channels
28128,1151294
+(defun open-output-channels (st)open-output-channels
28132,1151402
+(defun update-open-output-channels (x st)update-open-output-channels
28136,1151493
+(defun global-table (st)global-table
28140,1151602
+(defun update-global-table (x st)update-global-table
28144,1151685
+(defun t-stack (st)t-stack
28148,1151786
+(defun update-t-stack (x st)update-t-stack
28152,1151864
+(defun 32-bit-integer-stack (st)32-bit-integer-stack
28156,1151960
+(defun update-32-bit-integer-stack (x st)update-32-bit-integer-stack
28160,1152051
+(defun big-clock-entry (st)big-clock-entry
28164,1152160
+(defun update-big-clock-entry (x st)update-big-clock-entry
28168,1152246
+(defun idates (st)idates
28172,1152350
+(defun update-idates (x st)update-idates
28176,1152427
+(defun acl2-oracle (st)acl2-oracle
28180,1152522
+(defun update-acl2-oracle (x st)update-acl2-oracle
28184,1152604
+(defun file-clock (st)file-clock
28188,1152704
+(defun update-file-clock (x st)update-file-clock
28192,1152785
+(defun readable-files (st)readable-files
28196,1152884
+(defun written-files (st)written-files
28200,1152969
+(defun update-written-files (x st)update-written-files
28204,1153054
+(defun read-files (st)read-files
28208,1153157
+(defun update-read-files (x st)update-read-files
28212,1153239
+(defun writeable-files (st)writeable-files
28216,1153339
+(defun list-all-package-names-lst (st)list-all-package-names-lst
28220,1153426
+(defun update-list-all-package-names-lst (x st)update-list-all-package-names-lst
28224,1153524
+(defun user-stobj-alist1 (st)user-stobj-alist1
28232,1153852
+(defun update-user-stobj-alist1 (x st)update-user-stobj-alist1
28236,1153941
+(defconst *initial-raw-arity-alist**initial-raw-arity-alist*
28241,1154068
+(defconst *initial-checkpoint-processors**initial-checkpoint-processors*
28267,1154795
+(defconst *primitive-program-fns-with-raw-code**primitive-program-fns-with-raw-code*
28286,1155533
+(defconst *primitive-logic-fns-with-raw-code**primitive-logic-fns-with-raw-code*
28399,1159724
+(defconst *primitive-macros-with-raw-code**primitive-macros-with-raw-code*
28559,1166091
+(defmacro with-live-state (form)with-live-state
28652,1169692
+(defun init-iprint-ar (hard-bound enabledp)init-iprint-ar
28761,1173795
+(defconst *iprint-soft-bound-default* 1000)*iprint-soft-bound-default*
28793,1175188
+(defconst *iprint-hard-bound-default* 10000)*iprint-hard-bound-default*
28794,1175232
+(defdoc parallelismparallelism
28796,1175278
+(defdoc parallel-programmingparallel-programming
28833,1177233
+(defdoc parallel-proofparallel-proof
28871,1179128
+(defun default-total-parallelism-work-limit ()default-total-parallelism-work-limit
28884,1179556
+(defconst *fmt-soft-right-margin-default* 65)*fmt-soft-right-margin-default*
28962,1183525
+(defconst *fmt-hard-right-margin-default* 77)*fmt-hard-right-margin-default*
28963,1183571
+(defconst *initial-global-table**initial-global-table*
28965,1183618
+(defun all-boundp (alist1 alist2)all-boundp
29257,1196385
+(defun known-package-alistp (x)known-package-alistp
29265,1196656
+(defthm known-package-alistp-forward-to-true-list-listp-and-alistpknown-package-alistp-forward-to-true-list-listp-and-alistp
29276,1197037
+(defun timer-alistp (x)timer-alistp
29282,1197241
+(defthm timer-alistp-forward-to-true-list-listp-and-symbol-alistptimer-alistp-forward-to-true-list-listp-and-symbol-alistp
29294,1197553
+(defun typed-io-listp (l typ)typed-io-listp
29300,1197755
+(defthm typed-io-listp-forward-to-true-listptyped-io-listp-forward-to-true-listp
29312,1198206
+(defconst *file-types* '(:character :byte :object))*file-types*
29317,1198348
+(defun open-channel1 (l)open-channel1
29319,1198401
+(defthm open-channel1-forward-to-true-listp-and-conspopen-channel1-forward-to-true-listp-and-consp
29333,1198816
+(defun open-channel-listp (l)open-channel-listp
29339,1198994
+(defun open-channels-p (x)open-channels-p
29352,1199351
+(defthm open-channels-p-forwardopen-channels-p-forward
29357,1199473
+(defun file-clock-p (x)file-clock-p
29363,1199652
+(defthm file-clock-p-forward-to-integerpfile-clock-p-forward-to-integerp
29367,1199718
+(defun readable-file (x)readable-file
29372,1199844
+(defthm readable-file-forward-to-true-listp-and-conspreadable-file-forward-to-true-listp-and-consp
29384,1200206
+(defun readable-files-listp (x)readable-files-listp
29390,1200384
+(defthm readable-files-listp-forward-to-true-list-listp-and-alistpreadable-files-listp-forward-to-true-list-listp-and-alistp
29396,1200570
+(defun readable-files-p (x)readable-files-p
29402,1200774
+(defthm readable-files-p-forward-to-readable-files-listpreadable-files-p-forward-to-readable-files-listp
29406,1200860
+(defun written-file (x)written-file
29411,1201022
+(defthm written-file-forward-to-true-listp-and-conspwritten-file-forward-to-true-listp-and-consp
29424,1201421
+(defun written-file-listp (x)written-file-listp
29430,1201597
+(defthm written-file-listp-forward-to-true-list-listp-and-alistpwritten-file-listp-forward-to-true-list-listp-and-alistp
29436,1201778
+(defun written-files-p (x)written-files-p
29442,1201978
+(defthm written-files-p-forward-to-written-file-listpwritten-files-p-forward-to-written-file-listp
29446,1202061
+(defun read-file-listp1 (x)read-file-listp1
29451,1202217
+(defthm read-file-listp1-forward-to-true-listp-and-conspread-file-listp1-forward-to-true-listp-and-consp
29460,1202447
+(defun read-file-listp (x)read-file-listp
29466,1202631
+(defthm read-file-listp-forward-to-true-list-listpread-file-listp-forward-to-true-list-listp
29472,1202810
+(defun read-files-p (x)read-files-p
29477,1202960
+(defthm read-files-p-forward-to-read-file-listpread-files-p-forward-to-read-file-listp
29481,1203037
+(defun writable-file-listp1 (x)writable-file-listp1
29486,1203181
+(defthm writable-file-listp1-forward-to-true-listp-and-conspwritable-file-listp1-forward-to-true-listp-and-consp
29494,1203386
+(defun writable-file-listp (x)writable-file-listp
29500,1203578
+(defthm writable-file-listp-forward-to-true-list-listpwritable-file-listp-forward-to-true-list-listp
29506,1203769
+(defun writeable-files-p (x)writeable-files-p
29511,1203927
+(defthm writeable-files-p-forward-to-writable-file-listpwriteable-files-p-forward-to-writable-file-listp
29515,1204013
+(defun state-p1 (x)state-p1
29520,1204175
+(defthm state-p1-forwardstate-p1-forward
29555,1205605
+(defun state-p (state-state)state-p
29598,1207501
+(defthm state-p-implies-and-forward-to-state-p1state-p-implies-and-forward-to-state-p1
29608,1207758
+(defmacro build-statebuild-state
29701,1213075
+(defconst *default-state**default-state*
29725,1214008
+(defun build-state1 (open-input-channelsbuild-state1
29730,1214142
+(defun coerce-state-to-object (x)coerce-state-to-object
29758,1215402
+(defun coerce-object-to-state (x)coerce-object-to-state
29762,1215471
+(defun-one-output strip-numeric-postfix (sym)strip-numeric-postfix
29772,1215644
+(defun global-table-cars1 (state-state)global-table-cars1
29780,1215884
+(defun global-table-cars (state-state)global-table-cars
29805,1217028
+(defun boundp-global1 (x state-state)boundp-global1
29812,1217232
+(defun boundp-global (x state-state)boundp-global
29821,1217558
+(defmacro f-boundp-global (x st)f-boundp-global
29829,1217806
+(defun makunbound-global (x state-state)makunbound-global
29845,1218338
+(defun get-global (x state-state)get-global
29874,1219397
+(defun put-global (key value state-state)put-global
29886,1219812
+(defmacro f-put-global (key value st)f-put-global
29907,1220632
+(defmacro f-put-global@par (key value st)f-put-global@par
29970,1223231
+(defconst *initial-ld-special-bindings**initial-ld-special-bindings*
29988,1223833
+(defun always-boundp-global (x)always-boundp-global
30012,1224688
+(defun state-global-let*-bindings-p (lst)state-global-let*-bindings-p
30019,1224885
+(defun state-global-let*-get-globals (bindings)state-global-let*-get-globals
30036,1225516
+(defun state-global-let*-put-globals (bindings)state-global-let*-put-globals
30065,1227066
+(defun state-global-let*-cleanup (bindings index)state-global-let*-cleanup
30098,1228793
+(defparameter *possible-parallelism-hazards**possible-parallelism-hazards*
30149,1231682
+(defmacro with-parallelism-hazard-warnings (body)with-parallelism-hazard-warnings
30190,1233045
+(defmacro warn-about-parallelism-hazard (call body)warn-about-parallelism-hazard
30200,1233295
+(defmacro with-ensured-parallelism-finishing (form)with-ensured-parallelism-finishing
30257,1236118
+(defmacro state-global-let* (bindings body)state-global-let*
30270,1236516
+(defmacro state-free-global-let* (bindings body)state-free-global-let*
30390,1241893
+(defun integer-range-p (lower upper x)integer-range-p
30433,1243916
+(defun signed-byte-p (bits x)signed-byte-p
30459,1244951
+(defun unsigned-byte-p (bits x)unsigned-byte-p
30484,1245789
+(defthm integer-range-p-forwardinteger-range-p-forward
30512,1246682
+(defthm signed-byte-p-forward-to-integerpsigned-byte-p-forward-to-integerp
30520,1246932
+(defthm unsigned-byte-p-forward-to-nonnegative-integerpunsigned-byte-p-forward-to-nonnegative-integerp
30525,1247066
+(defmacro the-fixnum (n)the-fixnum
30533,1247329
+(defun-one-output zpf (x)zpf
30537,1247407
+(defun zpf (x)zpf
30541,1247516
+(defmacro logand (&rest args)logand
30790,1255710
+(defmacro logeqv (&rest args)logeqv
30813,1256442
+(defmacro logior (&rest args)logior
30836,1257186
+(defmacro logxor (&rest args)logxor
30859,1257930
+(defun integer-length (i)integer-length
30882,1258674
+(defun binary-logand (i j)binary-logand
30911,1259654
+(defun lognand (i j)lognand
30925,1260121
+(defun binary-logior (i j)binary-logior
30944,1260697
+(defun logorc1 (i j)logorc1
30950,1260874
+(defun logorc2 (i j)logorc2
30971,1261558
+(defun logandc1 (i j)logandc1
30992,1262243
+(defun logandc2 (i j)logandc2
31013,1262917
+(defun binary-logeqv (i j)binary-logeqv
31033,1263575
+(defun binary-logxor (i j)binary-logxor
31039,1263742
+(defun lognor (i j)lognor
31045,1263901
+(defun logtest (x y)logtest
31066,1264517
+(defconst *BOOLE-1*      0)*BOOLE-1*
31090,1265257
+(defconst *BOOLE-2*      1)*BOOLE-2*
31091,1265285
+(defconst *BOOLE-AND*    2)*BOOLE-AND*
31092,1265313
+(defconst *BOOLE-ANDC1*  3)*BOOLE-ANDC1*
31093,1265341
+(defconst *BOOLE-ANDC2*  4)*BOOLE-ANDC2*
31094,1265369
+(defconst *BOOLE-C1*     5)*BOOLE-C1*
31095,1265397
+(defconst *BOOLE-C2*     6)*BOOLE-C2*
31096,1265425
+(defconst *BOOLE-CLR*    7)*BOOLE-CLR*
31097,1265453
+(defconst *BOOLE-EQV*    8)*BOOLE-EQV*
31098,1265481
+(defconst *BOOLE-IOR*    9)*BOOLE-IOR*
31099,1265509
+(defconst *BOOLE-NAND*  10)*BOOLE-NAND*
31100,1265537
+(defconst *BOOLE-NOR*   11)*BOOLE-NOR*
31101,1265565
+(defconst *BOOLE-ORC1*  12)*BOOLE-ORC1*
31102,1265593
+(defconst *BOOLE-ORC2*  13)*BOOLE-ORC2*
31103,1265621
+(defconst *BOOLE-SET*   14)*BOOLE-SET*
31104,1265649
+(defconst *BOOLE-XOR*   15)*BOOLE-XOR*
31105,1265677
+(defun boole$ (op i1 i2)boole$
31107,1265706
+(deflabel ioio
31177,1268288
+(defdoc output-to-fileoutput-to-file
31420,1279238
+(defdoc *standard-co**standard-co*
31475,1281461
+(defdoc *standard-oi**standard-oi*
31514,1283534
+(defdoc *standard-ci**standard-ci*
31528,1284114
+(defdoc print-controlprint-control
31544,1284722
+(defdoc character-encodingcharacter-encoding
31643,1290006
+(defun set-forms-from-bindings (bindings)set-forms-from-bindings
31690,1292193
+(defconst *print-control-defaults**print-control-defaults*
31702,1292653
+(defun alist-difference-eq (alist1 alist2)alist-difference-eq
31727,1293947
+(defmacro with-print-defaults (bindings form)with-print-defaults
31743,1294491
+(defmacro reset-print-control ()reset-print-control
31752,1294962
+(defun digit-to-char (n)digit-to-char
31756,1295073
+(defun print-base-p (print-base)print-base-p
31797,1296087
+(defun explode-nonnegative-integer (n print-base ans)explode-nonnegative-integer
31804,1296240
+(defthm true-listp-explode-nonnegative-integertrue-listp-explode-nonnegative-integer
31852,1297860
+(defun explode-atom (x print-base)explode-atom
31881,1298784
+(defun explode-atom+ (x print-base print-radix)explode-atom+
31925,1300435
+(defthm true-list-listp-forward-to-true-listp-assoc-equaltrue-list-listp-forward-to-true-listp-assoc-equal
31961,1301902
+(defthm true-listp-cadr-assoc-eq-for-open-channels-ptrue-listp-cadr-assoc-eq-for-open-channels-p
31980,1302870
+(defun open-input-channel-p1 (channel typ state-state)open-input-channel-p1
31995,1303384
+(defun open-output-channel-p1 (channel typ state-state)open-output-channel-p1
32010,1304047
+(defun open-input-channel-p (channel typ state-state)open-input-channel-p
32024,1304689
+(defun open-output-channel-p (channel typ state-state)open-output-channel-p
32030,1304958
+(defun open-output-channel-any-p1 (channel state-state)open-output-channel-any-p1
32036,1305229
+(defun open-output-channel-any-p (channel state-state)open-output-channel-any-p
32043,1305570
+(defun open-input-channel-any-p1 (channel state-state)open-input-channel-any-p1
32048,1305782
+(defun open-input-channel-any-p (channel state-state)open-input-channel-any-p
32055,1306119
+(defmacro print-case ()print-case
32060,1306329
+(defmacro acl2-print-case (&optional (st 'state))acl2-print-case
32069,1306594
+(defun set-print-case (case state)set-print-case
32072,1306666
+(defmacro set-acl2-print-case (case)set-acl2-print-case
32112,1308652
+(defmacro print-base (&optional (st 'state))print-base
32118,1308849
+(defmacro acl2-print-base (&optional (st 'state))acl2-print-base
32121,1308930
+(defmacro print-radix (&optional (st 'state))print-radix
32124,1309002
+(defmacro acl2-print-radix (&optional (st 'state))acl2-print-radix
32127,1309085
+(defun check-print-base (print-base ctx)check-print-base
32130,1309159
+(defun set-print-base (base state)set-print-base
32187,1312001
+(defmacro set-acl2-print-base (base)set-acl2-print-base
32227,1313306
+(defun set-print-circle (x state)set-print-circle
32233,1313503
+(defun set-print-escape (x state)set-print-escape
32237,1313621
+(defun set-print-pretty (x state)set-print-pretty
32241,1313739
+(defun set-print-radix (x state)set-print-radix
32245,1313857
+(defun set-print-readably (x state)set-print-readably
32287,1315054
+(defun check-null-or-natp (n fn)check-null-or-natp
32291,1315176
+(defun set-print-length (n state)set-print-length
32302,1315524
+(defun set-print-level (n state)set-print-level
32308,1315761
+(defun set-print-lines (n state)set-print-lines
32314,1315995
+(defun set-print-right-margin (n state)set-print-right-margin
32320,1316229
+(defmacro get-input-stream-from-channel (channel)get-input-stream-from-channel
32327,1316501
+(defmacro get-output-stream-from-channel (channel)get-output-stream-from-channel
32334,1316691
+(defmacro with-print-controls (default bindings &rest body)with-print-controls
32341,1316883
+(defun princ$ (x channel state-state)princ$
32405,1320075
+(defun write-byte$ (x channel state-state)write-byte$
32574,1327171
+(defvar *print-circle-stream* nil)*print-circle-stream*
32603,1328339
+(defmacro er (severity context str &rest str-args)er
32605,1328375
+(defmacro er@par (severity context str &rest str-args)er@par
32721,1334037
+(defun get-serialize-character (state)get-serialize-character
32744,1334962
+(defun w (state)w
32749,1335169
+(defun hons-enabledp (state)hons-enabledp
32761,1335696
+(defun set-serialize-character (c state)set-serialize-character
32766,1335859
+(defun print-object$-ser (x serialize-character channel state-state)print-object$-ser
32793,1337045
+(defthm all-boundp-preserves-assoc-equalall-boundp-preserves-assoc-equal
32847,1339325
+(defun print-object$ (x channel state)print-object$
32864,1339894
+(defparameter *file-clock* 1)*file-clock*
32900,1341600
+(defun make-input-channel (file-name clock)make-input-channel
32903,1341644
+(defun make-output-channel (file-name clock)make-output-channel
32917,1342154
+(defun-one-output setup-standard-io ()setup-standard-io
32939,1343168
+(defun-one-output lisp-book-syntaxp1 (s stream)lisp-book-syntaxp1
32979,1344660
+(defun-one-output lisp-book-syntaxp (file)lisp-book-syntaxp
33060,1347783
+(defparameter *parser* nil)*parser*
33085,1348919
+(defun-one-output parse-infix-file (infile outfile)parse-infix-file
33098,1349389
+(defun open-input-channel (file-name typ state-state)open-input-channel
33128,1350631
+(defthm nth-update-nthnth-update-nth
33243,1355801
+(defthm true-listp-update-nthtrue-listp-update-nth
33250,1355987
+(defthm nth-update-nth-arraynth-update-nth-array
33263,1356337
+(defun close-input-channel (channel state-state)close-input-channel
33269,1356518
+(defun open-output-channel (file-name typ state-state)open-output-channel
33314,1358412
+(defun open-output-channel! (file-name typ state)open-output-channel!
33414,1363507
+(defmacro assert$ (test form)assert$
33545,1368246
+(defun fmt-to-comment-window (str alist col evisc-tuple)fmt-to-comment-window
33569,1369050
+(defun fmt-to-comment-window! (str alist col evisc-tuple)fmt-to-comment-window!
33620,1371146
+(defun pairlis2 (x y)pairlis2
33634,1371508
+(defmacro cw (str &rest args)cw
33642,1371792
+(defmacro cw! (str &rest args)cw!
33763,1376284
+(defun subseq-list (lst start end)subseq-list
33782,1376935
+(defun subseq (seq start end)subseq
33793,1377302
+(defun lock-symbol-name-p (lock-symbol)lock-symbol-name-p
33833,1379069
+(defun assign-lock (key)assign-lock
33842,1379361
+(defmacro with-lock (bound-symbol &rest forms)with-lock
33863,1380039
+(defmacro deflock (lock-symbol)deflock
33874,1380438
+(defun get-output-stream-string$-fn (channel state-state)get-output-stream-string$-fn
33918,1382188
+(defmacro get-output-stream-string$ (channel state-stateget-output-stream-string$
33964,1384200
+(defun close-output-channel (channel state-state)close-output-channel
33984,1385128
+(defun maybe-finish-output$ (channel state)maybe-finish-output$
34090,1389943
+(defmacro legal-acl2-character-p (x)legal-acl2-character-p
34110,1390653
+(defun read-char$ (channel state-state)read-char$
34126,1391201
+(defun peek-char$ (channel state-state)peek-char$
34161,1392676
+(defun read-byte$ (channel state-state)read-byte$
34187,1393726
+(defun-one-output parse-infix-from-terminal (eof)parse-infix-from-terminal
34216,1394875
+(defparameter *acl2-read-suppress* nil)*acl2-read-suppress*
34241,1395930
+(defun read-object (channel state-state)read-object
34243,1395971
+(defun read-object-suppress (channel state)read-object-suppress
34339,1400278
+(defconst *suspiciously-first-numeric-chars**suspiciously-first-numeric-chars*
34356,1401036
+(defconst *suspiciously-first-hex-chars**suspiciously-first-hex-chars*
34363,1401236
+(defconst *base-10-chars**base-10-chars*
34373,1401488
+(defconst *hex-chars**hex-chars*
34380,1401630
+(defconst *letter-chars**letter-chars*
34389,1401820
+(defconst *slashable-chars**slashable-chars*
34399,1402140
+(defun some-slashable (l)some-slashable
34407,1402425
+(defun prin1-with-slashes1 (l slash-char channel state)prin1-with-slashes1
34415,1402630
+(defun prin1-with-slashes (s slash-char channel state)prin1-with-slashes
34434,1403369
+(defmacro suspiciously-first-numeric-chars (print-base)suspiciously-first-numeric-chars
34460,1404456
+(defmacro numeric-chars (print-base)numeric-chars
34465,1404621
+(defun may-need-slashes1 (lst flg potnum-chars)may-need-slashes1
34470,1404729
+(defmacro potential-numberp (s0 n0 print-base)potential-numberp
34494,1405761
+(defun may-need-slashes-fn (x print-base)may-need-slashes-fn
34556,1408187
+(defmacro may-need-slashes (x &optional (print-base '10))may-need-slashes
34805,1419128
+(defun needs-slashes (x state)needs-slashes
34814,1419522
+(defparameter *t-stack* (make-array$ 5))*t-stack*
34830,1420050
+(defparameter *t-stack-length* 0)*t-stack-length*
34832,1420092
+(defun t-stack-length1 (state-state)t-stack-length1
34837,1420131
+(defun t-stack-length (state-state)t-stack-length
34848,1420466
+(defun make-list-ac (n val ac)make-list-ac
34855,1420664
+(defmacro make-list (size &key initial-element)make-list
34862,1420872
+(defun extend-t-stack (n val state-state)extend-t-stack
34879,1421504
+(defconst *directory-separator**directory-separator*
34954,1424170
+(defconst *directory-separator-string**directory-separator-string*
34957,1424210
+(defmacro os-er (os fnname)os-er
34960,1424284
+(defun os (wrld)os
34968,1424552
+(defun mswindows-drive1 (filename)mswindows-drive1
34978,1424790
+(defun mswindows-drive (filename state)mswindows-drive
35003,1425995
+(defun pathname-os-to-unix (str os state)pathname-os-to-unix
35018,1426617
+(defun ccl-at-least-1-3-p ()ccl-at-least-1-3-p
35059,1428127
+(defun pathname-unix-to-os (str state)pathname-unix-to-os
35066,1428438
+(defun shrink-t-stack (n state-state)shrink-t-stack
35120,1430827
+(defun aref-t-stack (i state-state)aref-t-stack
35145,1431684
+(defun aset-t-stack (i val state-state)aset-t-stack
35160,1432198
+(defparameter *32-bit-integer-stack**32-bit-integer-stack*
35188,1432989
+(defparameter *32-bit-integer-stack-length* 0)*32-bit-integer-stack-length*
35191,1433078
+(defun 32-bit-integer-stack-length1 (state-state)32-bit-integer-stack-length1
35195,1433129
+(defun 32-bit-integer-stack-length (state-state)32-bit-integer-stack-length
35203,1433438
+(defun extend-32-bit-integer-stack (n val state-state)extend-32-bit-integer-stack
35210,1433662
+(defun shrink-32-bit-integer-stack (n state-state)shrink-32-bit-integer-stack
35258,1435980
+(defun aref-32-bit-integer-stack (i state-state)aref-32-bit-integer-stack
35289,1437110
+(defun aset-32-bit-integer-stack (i val state-state)aset-32-bit-integer-stack
35312,1437880
+(defmacro f-big-clock-negative-p (st)f-big-clock-negative-p
35341,1438909
+(defmacro f-decrement-big-clock (st)f-decrement-big-clock
35350,1439147
+(defun big-clock-negative-p (state-state)big-clock-negative-p
35369,1439731
+(defun decrement-big-clock (state-state)decrement-big-clock
35389,1440613
+(defun list-all-package-names (state-state)list-all-package-names
35414,1441567
+(defun user-stobj-alist (state-state)user-stobj-alist
35430,1442167
+(defun update-user-stobj-alist (x state-state)update-user-stobj-alist
35440,1442487
+(defun power-eval (l b)power-eval
35452,1442921
+(defun-one-output idate ()idate
35460,1443131
+(defun read-idate (state-state)read-idate
35472,1443443
+(defun get-internal-time ()get-internal-time
35492,1444117
+(defdoc get-internal-timeget-internal-time
35497,1444276
+(defun read-run-time (state-state)read-run-time
35547,1446435
+(defparameter *next-acl2-oracle-value* nil)*next-acl2-oracle-value*
35588,1448015
+(defun read-acl2-oracle (state-state)read-acl2-oracle
35590,1448060
+(defun read-acl2-oracle@par (state-state)read-acl2-oracle@par
35611,1448739
+(defun read-acl2-oracle@par (state-state)read-acl2-oracle@par
35636,1449768
+(defun getenv$ (str state)getenv$
35657,1450757
+(defun setenv$ (str val)setenv$
35686,1451783
+(defun random$ (limit state)random$
35742,1453908
+(defthm natp-random$natp-random$
35781,1455366
+(defthm random$-linearrandom$-linear
35785,1455457
+(defvar *last-sys-call-status* 0)*last-sys-call-status*
35802,1455907
+(defun sys-call (command-string args)sys-call
35804,1455942
+(defun sys-call-status (state)sys-call-status
35890,1459304
+(defun read-file-by-lines (file &optional delete-after-reading)read-file-by-lines
35918,1460364
+(defun system-call+ (string arguments)system-call+
35941,1461118
+(defthm update-acl2-oracle-preserves-state-p1update-acl2-oracle-preserves-state-p1
36101,1467765
+(defun sys-call+ (command-string args state)sys-call+
36109,1468021
+(defthm read-run-time-preserves-state-p1read-run-time-preserves-state-p1
36257,1474774
+(defthm read-acl2-oracle-preserves-state-p1read-acl2-oracle-preserves-state-p1
36265,1475063
+(defthm nth-0-read-run-time-type-prescriptionnth-0-read-run-time-type-prescription
36281,1475546
+(defun main-timer (state)main-timer
36299,1476113
+(defun put-assoc-eq-exec (name val alist)put-assoc-eq-exec
36312,1476616
+(defun put-assoc-eql-exec (name val alist)put-assoc-eql-exec
36324,1477076
+(defun put-assoc-equal (name val alist)put-assoc-equal
36336,1477541
+(defmacro put-assoc-eq (name val alist)put-assoc-eq
36342,1477813
+(defmacro put-assoc-eql (name val alist)put-assoc-eql
36347,1477985
+(defthm put-assoc-eq-exec-is-put-assoc-equalput-assoc-eq-exec-is-put-assoc-equal
36350,1478072
+(defthm put-assoc-eql-exec-is-put-assoc-equalput-assoc-eql-exec-is-put-assoc-equal
36354,1478206
+(defmacro put-assoc (name val alist &key (test ''eql))put-assoc
36358,1478342
+(defun set-timer (name val state)set-timer
36425,1481004
+(defun get-timer (name state)get-timer
36434,1481288
+(defun push-timer (name val state)push-timer
36445,1481665
+(defthm rationalp-+rationalp-+
36454,1482049
+(defthm rationalp-*rationalp-*
36550,1486315
+(defthm rationalp-unary--rationalp-unary--
36555,1486430
+(defthm rationalp-unary-/rationalp-unary-/
36559,1486513
+(defthm realp-+realp-+
36568,1486849
+(defthm realp-*realp-*
36574,1486973
+(defthm realp-unary--realp-unary--
36580,1487097
+(defthm realp-unary-/realp-unary-/
36585,1487193
+(defthm rationalp-implies-acl2-numberprationalp-implies-acl2-numberp
36591,1487339
+(defun pop-timer (name flg state)pop-timer
36594,1487423
+(defun add-timers (name1 name2 state)add-timers
36612,1488048
+(defthm nth-0-consnth-0-cons
36626,1488611
+(defthm nth-add1nth-add1
36636,1488813
+(defthm main-timer-type-prescriptionmain-timer-type-prescription
36643,1489013
+(defthm ordered-symbol-alistp-add-pair-forwardordered-symbol-alistp-add-pair-forward
36649,1489208
+(defthm assoc-add-pairassoc-add-pair
36658,1489477
+(defthm add-pair-preserves-all-boundpadd-pair-preserves-all-boundp
36666,1489757
+(defthm state-p1-update-main-timerstate-p1-update-main-timer
36673,1490016
+(defun increment-timer (name state)increment-timer
36704,1491407
+(defun print-rational-as-decimal (x channel state)print-rational-as-decimal
36727,1492402
+(defun print-timer (name channel state)print-timer
36748,1493172
+(defun known-package-alist (state)known-package-alist
36756,1493515
+(defun prin1$ (x channel state)prin1$
36772,1493921
+(defun current-package (state)current-package
36953,1502711
+(defthm state-p1-update-nth-2-worldstate-p1-update-nth-2-world
37007,1505558
+(defconst *initial-untouchable-fns**initial-untouchable-fns*
37045,1506917
+(defconst *initial-untouchable-vars**initial-untouchable-vars*
37127,1509406
+(defun ld-skip-proofsp (state)ld-skip-proofsp
37285,1513923
+(defun-one-output bad-lisp-objectp (x)bad-lisp-objectp
37396,1519720
+(defun-one-output chk-bad-lisp-object (x)chk-bad-lisp-object
37630,1531590
+(defmacro assign (x y)assign
37672,1532824
+(defmacro @ (x)@
37712,1534350
+(defun make-var-lst1 (root sym n acc)make-var-lst1
37746,1535630
+(defun make-var-lst (sym n)make-var-lst
37773,1536536
+(defun union-eq-exec (l1 l2)union-eq-exec
37781,1536766
+(defun union-eql-exec (l1 l2)union-eql-exec
37791,1537148
+(defun union-equal (l1 l2)union-equal
37801,1537532
+(defmacro union-eq (&rest lst)union-eq
37807,1537767
+(defthm union-eq-exec-is-union-equalunion-eq-exec-is-union-equal
37810,1537828
+(defthm union-eql-exec-is-union-equalunion-eql-exec-is-union-equal
37814,1537928
+(defun parse-args-and-test (x tests default ctx form name)parse-args-and-test
37818,1538030
+(defmacro union$ (&whole form &rest x)union$
37867,1540274
+(defun subst-for-nth-arg (new n args)subst-for-nth-arg
37939,1543409
+(defmacro the-mv (args type body &optional state-pos)the-mv
37949,1543711
+(defmacro the-mv (vars type body &optional state-pos)the-mv
38003,1545645
+(defmacro the2s (x y)the2s
38014,1546189
+(deflabel bibliographybibliography
38017,1546238
+(defun non-free-var-runes (runes free-var-runes-once free-var-runes-all acc)non-free-var-runes
38038,1547040
+(defun free-var-runes (flg wrld)free-var-runes
38053,1547758
+(defthm natp-position-ac ; for admission of absolute-pathname-string-pnatp-position-ac
38061,1547977
+(defun absolute-pathname-string-p (str directoryp os)absolute-pathname-string-p
38069,1548313
+(defun include-book-dir-alistp (x os)include-book-dir-alistp
38115,1550440
+(defun illegal-ruler-extenders-values (x wrld)illegal-ruler-extenders-values
38124,1550755
+(defun intersection-eq-exec (l1 l2)intersection-eq-exec
38136,1551172
+(defun intersection-eql-exec (l1 l2)intersection-eql-exec
38148,1551588
+(defun intersection-equal (l1 l2)intersection-equal
38159,1552009
+(defmacro intersection-eq (&rest lst)intersection-eq
38169,1552331
+(defthm intersection-eq-exec-is-intersection-equalintersection-eq-exec-is-intersection-equal
38172,1552406
+(defthm intersection-eql-exec-is-intersection-equalintersection-eql-exec-is-intersection-equal
38176,1552534
+(defmacro intersection$ (&whole form &rest x)intersection$
38180,1552664
+(defun table-alist (name wrld)table-alist
38261,1556231
+(defun ruler-extenders-msg-aux (vals return-last-table)ruler-extenders-msg-aux
38269,1556461
+(defun ruler-extenders-msg (x wrld)ruler-extenders-msg
38286,1557229
+(defmacro chk-ruler-extenders (x soft ctx wrld)chk-ruler-extenders
38319,1558758
+(defmacro fixnum-bound () ; most-positive-fixnum in Allegro CL and many othersfixnum-bound
38329,1559215
+(defconst *default-step-limit**default-step-limit*
38332,1559315
+(deflabel acl2-defaults-tableacl2-defaults-table
38474,1564345
+(defmacro set-enforce-redundancy (x)set-enforce-redundancy
38788,1578037
+(defmacro set-enforce-redundancy (x)set-enforce-redundancy
38861,1581776
+(defmacro set-ignore-doc-string-error (x)set-ignore-doc-string-error
38866,1581861
+(defmacro set-ignore-doc-string-error (x)set-ignore-doc-string-error
38911,1583718
+(defmacro default-verify-guards-eagerness-from-table (alist)default-verify-guards-eagerness-from-table
38915,1583791
+(defun default-verify-guards-eagerness (wrld)default-verify-guards-eagerness
38919,1583920
+(defmacro set-verify-guards-eagerness (x)set-verify-guards-eagerness
38927,1584259
+(defmacro set-verify-guards-eagerness (x)set-verify-guards-eagerness
38983,1587101
+(defun default-compile-fns (wrld)default-compile-fns
38987,1587174
+(defmacro set-compile-fns (x)set-compile-fns
38993,1587431
+(defmacro set-compile-fns (x)set-compile-fns
39051,1589965
+(defun set-compiler-enabled (val state)set-compiler-enabled
39055,1590026
+(defun default-measure-function (wrld)default-measure-function
39080,1591110
+(defmacro set-measure-function (name)set-measure-function
39087,1591400
+(defmacro set-measure-function (name)set-measure-function
39127,1593020
+(defun default-well-founded-relation (wrld)default-well-founded-relation
39131,1593092
+(defmacro set-well-founded-relation (rel)set-well-founded-relation
39138,1593384
+(defmacro set-well-founded-relation (rel)set-well-founded-relation
39177,1595130
+(defmacro default-defun-mode-from-table (alist)default-defun-mode-from-table
39183,1595243
+(defun default-defun-mode (wrld)default-defun-mode
39193,1595542
+(defun default-defun-mode-from-state (state)default-defun-mode-from-state
39235,1597914
+(defmacro logic nillogic
39240,1598054
+(defmacro logic () nil)logic
39279,1599471
+(defmacro program nilprogram
39282,1599513
+(defmacro program () nil)program
39338,1601298
+(defun invisible-fns-table (wrld)invisible-fns-table
39340,1601325
+(defmacro set-invisible-fns-table (alist)set-invisible-fns-table
39388,1603431
+(defun unary-function-symbol-listp (lst wrld)unary-function-symbol-listp
39461,1606202
+(defun invisible-fns-entryp (key val wrld)invisible-fns-entryp
39479,1607001
+(defmacro add-invisible-fns (top-fn &rest unary-fns)add-invisible-fns
39491,1607320
+(defmacro remove-invisible-fns (top-fn &rest unary-fns)remove-invisible-fns
39533,1609171
+(defmacro set-invisible-fns-alist (alist)set-invisible-fns-alist
39578,1611065
+(defmacro invisible-fns-alist (wrld)invisible-fns-alist
39585,1611371
+(defmacro set-bogus-defun-hints-ok (x)set-bogus-defun-hints-ok
39592,1611606
+(defmacro set-bogus-defun-hints-ok (x)set-bogus-defun-hints-ok
39615,1612435
+(defmacro set-bogus-mutual-recursion-ok (x)set-bogus-mutual-recursion-ok
39620,1612522
+(defmacro set-bogus-mutual-recursion-ok (x)set-bogus-mutual-recursion-ok
39670,1614675
+(defdoc ruler-extendersruler-extenders
39674,1614750
+(defmacro set-ruler-extenders (x)set-ruler-extenders
40077,1631033
+(defmacro set-ruler-extenders (x)set-ruler-extenders
40102,1631939
+(defmacro set-irrelevant-formals-ok (x)set-irrelevant-formals-ok
40107,1632021
+(defmacro set-irrelevant-formals-ok (x)set-irrelevant-formals-ok
40142,1633262
+(defmacro set-ignore-ok (x)set-ignore-ok
40147,1633350
+(defmacro set-ignore-ok (x)set-ignore-ok
40191,1635028
+(defmacro set-inhibit-warnings! (&rest x)set-inhibit-warnings!
40196,1635104
+(defmacro set-inhibit-warnings! (&rest lst)set-inhibit-warnings!
40205,1635269
+(defmacro set-inhibit-warnings (&rest lst)set-inhibit-warnings
40224,1636033
+(defmacro set-inhibit-output-lst (lst)set-inhibit-output-lst
40274,1638350
+(defmacro set-inhibited-summary-types (lst)set-inhibited-summary-types
40342,1641563
+(defmacro set-state-ok (x)set-state-ok
40397,1643855
+(defmacro set-state-ok (x)set-state-ok
40470,1647025
+(defmacro set-let*-abstractionp (x)set-let*-abstractionp
40479,1647261
+(defmacro set-let*-abstractionp (x)set-let*-abstractionp
40526,1649168
+(defmacro set-let*-abstraction (x)set-let*-abstraction
40530,1649235
+(defun let*-abstractionp (state)let*-abstractionp
40538,1649469
+(defconst *initial-backchain-limit* '(nil nil))*initial-backchain-limit*
40552,1649965
+(defconst *initial-default-backchain-limit* '(nil nil))*initial-default-backchain-limit*
40554,1650014
+(defmacro set-backchain-limit (limit)set-backchain-limit
40557,1650088
+(defmacro set-backchain-limit (limit)set-backchain-limit
40610,1652460
+(defun backchain-limit (wrld flg)backchain-limit
40614,1652533
+(defmacro set-default-backchain-limit (limit)set-default-backchain-limit
40773,1659384
+(defmacro set-default-backchain-limit (limit)set-default-backchain-limit
40839,1662742
+(defun default-backchain-limit (wrld flg)default-backchain-limit
40843,1662823
+(defun step-limit-from-table (wrld)step-limit-from-table
40919,1666137
+(defparameter *step-limit-error-p**step-limit-error-p*
40938,1666945
+(defmacro set-prover-step-limit (limit)set-prover-step-limit
40947,1667223
+(defmacro set-prover-step-limit (limit)set-prover-step-limit
41109,1674603
+(defparameter *rewrite-depth-max* 0)     ; records max depth per event*rewrite-depth-max*
41128,1675340
+(defparameter *rewrite-depth-alist* nil) ; records max depth per book*rewrite-depth-alist*
41129,1675411
+(defconst *default-rewrite-stack-limit**default-rewrite-stack-limit*
41177,1677249
+(defmacro set-rewrite-stack-limit (limit)set-rewrite-stack-limit
41191,1677878
+(defmacro set-rewrite-stack-limit (limit)set-rewrite-stack-limit
41231,1679521
+(defun rewrite-stack-limit (wrld)rewrite-stack-limit
41235,1679598
+(defmacro set-nu-rewriter-mode (x)set-nu-rewriter-mode
41281,1681442
+(defmacro set-nu-rewriter-mode (x)set-nu-rewriter-mode
41335,1683791
+(defun nu-rewriter-mode (wrld)nu-rewriter-mode
41339,1683857
+(defun case-split-limitations (wrld)case-split-limitations
41359,1684822
+(defmacro sr-limit (wrld)sr-limit
41388,1686065
+(defmacro case-limit (wrld)case-limit
41391,1686133
+(defmacro set-case-split-limitations (lst)set-case-split-limitations
41395,1686221
+(defmacro set-case-split-limitations (lst)set-case-split-limitations
41537,1693686
+(defconst *initial-acl2-defaults-table**initial-acl2-defaults-table*
41548,1694158
+(defun untrans-table (wrld)untrans-table
41554,1694379
+(defmacro add-macro-fn (macro macro-fn &optional right-associate-p)add-macro-fn
41593,1695459
+(defmacro add-binop (macro macro-fn)add-binop
41636,1697642
+(defmacro remove-macro-fn (macro-fn)remove-macro-fn
41647,1697953
+(defmacro remove-binop (macro-fn)remove-binop
41676,1699116
+(defun match-free-default (wrld)match-free-default
41690,1699582
+(defmacro set-match-free-default (x)set-match-free-default
41698,1699913
+(defmacro set-match-free-default (x)set-match-free-default
41759,1702807
+(defmacro set-match-free-error (x)set-match-free-error
41763,1702875
+(defun match-free-override (wrld)match-free-override
41808,1705026
+(defmacro add-match-free-override (flg &rest runes)add-match-free-override
41826,1705785
+(defmacro add-match-free-override (flg &rest runes)add-match-free-override
42013,1715056
+(defmacro add-include-book-dir (keyword dir)add-include-book-dir
42017,1715147
+(defmacro delete-include-book-dir (keyword)delete-include-book-dir
42075,1718140
+(defconst *non-linear-rounds-value* 3)*non-linear-rounds-value*
42116,1719906
+(defun non-linearp (wrld)non-linearp
42118,1719946
+(defmacro set-non-linearp (toggle)set-non-linearp
42129,1720282
+(defmacro set-non-linearp (toggle)set-non-linearp
42153,1721007
+(defmacro set-non-linear (toggle)set-non-linear
42157,1721078
+(defun tau-auto-modep (wrld)tau-auto-modep
42165,1721304
+(defmacro set-tau-auto-mode (toggle)set-tau-auto-mode
42203,1722994
+(defmacro set-tau-auto-mode (toggle)set-tau-auto-mode
42323,1729780
+(defmacro defttag (tag-name &key doc)defttag
42328,1729870
+(defmacro defttag (&rest args)defttag
42595,1743346
+(defun ttag (wrld)ttag
42599,1743411
+(defdoc complex-rationalpcomplex-rationalp
42611,1743795
+(deflabel letlet
42625,1744243
+(defdoc fletflet
42750,1749814
+(defun-one-output what-is-the-global-state ()what-is-the-global-state
42880,1754866
+(deflabel macro-aliases-tablemacro-aliases-table
42947,1758021
+(defun macro-aliases (wrld)macro-aliases
43063,1762468
+(defmacro add-macro-alias (macro-name fn-name)add-macro-alias
43067,1762587
+(defmacro remove-macro-alias (macro-name)remove-macro-alias
43132,1765341
+(deflabel nth-aliases-tablenth-aliases-table
43165,1766710
+(defun nth-aliases (wrld)nth-aliases
43205,1768138
+(defmacro add-nth-alias (alias-name name)add-nth-alias
43209,1768253
+(defmacro remove-nth-alias (alias-name)remove-nth-alias
43230,1768903
+(deflabel default-hints-tabledefault-hints-table
43266,1770533
+(defun default-hints (wrld)default-hints
43287,1771299
+(defmacro set-default-hints (lst)set-default-hints
43312,1772261
+(defmacro set-default-hints! (lst)set-default-hints!
43371,1774670
+(defmacro set-default-hints! (lst)set-default-hints!
43389,1775370
+(defmacro add-default-hints (lst &key at-end)add-default-hints
43393,1775438
+(defmacro add-default-hints! (lst &key at-end)add-default-hints!
43442,1777579
+(defmacro add-default-hints! (lst)add-default-hints!
43462,1778433
+(defmacro remove-default-hints (lst)remove-default-hints
43466,1778501
+(defmacro remove-default-hints! (lst)remove-default-hints!
43506,1780044
+(defmacro remove-default-hints! (lst)remove-default-hints!
43524,1780826
+(defmacro set-override-hints-macro (lst at-end ctx)set-override-hints-macro
43529,1780914
+(defmacro set-override-hints-macro (&rest args)set-override-hints-macro
43535,1781137
+(defmacro add-override-hints! (lst &key at-end)add-override-hints!
43539,1781219
+(defmacro add-override-hints (lst &key at-end)add-override-hints
43553,1781721
+(defmacro set-override-hints! (lst)set-override-hints!
43583,1782993
+(defmacro set-override-hints (lst)set-override-hints
43596,1783434
+(defmacro remove-override-hints! (lst)remove-override-hints!
43620,1784291
+(defmacro remove-override-hints (lst)remove-override-hints
43633,1784792
+(defmacro set-rw-cache-state (val)set-rw-cache-state
43659,1785855
+(defmacro set-rw-cache-state! (val)set-rw-cache-state!
43937,1801305
+(defmacro set-rw-cache-state! (val)set-rw-cache-state!
43952,1801836
+(defconst *legal-rw-cache-states**legal-rw-cache-states*
43956,1801905
+(defun fix-true-list (x)fix-true-list
43965,1802110
+(defthm pairlis$-fix-true-listpairlis$-fix-true-list
43983,1802570
+(defun boolean-listp (lst)boolean-listp
43987,1802668
+(defthm boolean-listp-consboolean-listp-cons
43998,1802986
+(defthm boolean-listp-forwardboolean-listp-forward
44007,1803239
+(defthm boolean-listp-forward-to-symbol-listpboolean-listp-forward-to-symbol-listp
44017,1803502
+(defaxiom completion-of-+completion-of-+
44035,1804280
+(defthm default-+-1default-+-1
44046,1804519
+(defthm default-+-2default-+-2
44051,1804652
+(defaxiom completion-of-*completion-of-*
44056,1804785
+(defthm default-*-1default-*-1
44065,1804972
+(defthm default-*-2default-*-2
44069,1805058
+(defaxiom completion-of-unary-minuscompletion-of-unary-minus
44073,1805144
+(defthm default-unary-minusdefault-unary-minus
44080,1805281
+(defaxiom completion-of-unary-/completion-of-unary-/
44084,1805373
+(defthm default-unary-/default-unary-/
44092,1805548
+(defaxiom completion-of-<completion-of-<
44099,1805728
+(defthm default-<-1default-<-1
44111,1806152
+(defthm default-<-2default-<-2
44120,1806385
+(defaxiom completion-of-carcompletion-of-car
44129,1806618
+(defthm default-cardefault-car
44137,1806761
+(defaxiom completion-of-cdrcompletion-of-cdr
44141,1806842
+(defthm default-cdrdefault-cdr
44149,1806985
+(defthm cons-car-cdrcons-car-cdr
44153,1807066
+(defaxiom completion-of-char-codecompletion-of-char-code
44159,1807187
+(defthm default-char-codedefault-char-code
44166,1807336
+(defaxiom completion-of-code-charcompletion-of-code-char
44171,1807481
+(defaxiom completion-of-complexcompletion-of-complex
44192,1808076
+(defthm default-complex-1default-complex-1
44200,1808303
+(defthm default-complex-2default-complex-2
44208,1808536
+(defthm complex-0complex-0
44217,1808858
+(defthm add-def-complexadd-def-complex
44225,1809073
+(defthm realpart-+realpart-+
44240,1809748
+(defthm imagpart-+imagpart-+
44245,1809878
+(defaxiom completion-of-coercecompletion-of-coerce
44250,1810008
+(defthm default-coerce-1default-coerce-1
44261,1810271
+(defthm make-character-list-make-character-listmake-character-list-make-character-list
44267,1810454
+(defthm default-coerce-2default-coerce-2
44271,1810593
+(defthm default-coerce-3default-coerce-3
44285,1811151
+(defaxiom completion-of-denominatorcompletion-of-denominator
44291,1811335
+(defthm default-denominatordefault-denominator
44298,1811489
+(defaxiom completion-of-floor1completion-of-floor1
44309,1811871
+(defthm default-floor1default-floor1
44320,1812121
+(defaxiom floor1-integer-xfloor1-integer-x
44328,1812327
+(defaxiom floor1-x-<=-xfloor1-x-<=-x
44335,1812510
+(defaxiom x-<-add1-floor1-xx-<-add1-floor1-x
44343,1812704
+(defthm floor1-valuefloor1-value
44353,1813023
+(defaxiom completion-of-imagpartcompletion-of-imagpart
44361,1813213
+(defthm default-imagpartdefault-imagpart
44368,1813361
+(defaxiom completion-of-intern-in-package-of-symbolcompletion-of-intern-in-package-of-symbol
44373,1813475
+(defaxiom completion-of-numeratorcompletion-of-numerator
44392,1814135
+(defthm default-numeratordefault-numerator
44399,1814283
+(defaxiom completion-of-realpartcompletion-of-realpart
44404,1814396
+(defthm default-realpartdefault-realpart
44411,1814544
+(defaxiom completion-of-symbol-namecompletion-of-symbol-name
44416,1814658
+(defthm default-symbol-namedefault-symbol-name
44423,1814811
+(defaxiom completion-of-symbol-package-namecompletion-of-symbol-package-name
44429,1814978
+(defthm default-symbol-package-namedefault-symbol-package-name
44436,1815155
+(defdoc i-smalli-small
44445,1815435
+(defdoc i-closei-close
44454,1815684
+(defdoc i-largei-large
44462,1815939
+(defdoc i-limitedi-limited
44471,1816202
+(defdoc standardpstandardp
44480,1816450
+(defdoc standard-partstandard-part
44501,1817475
+(defun i-small (x)i-small
44513,1817830
+(defun i-close (x y)i-close
44518,1817940
+(defun i-large (x)i-large
44524,1818066
+(defmacro i-limited (x)i-limited
44530,1818189
+(defaxiom i-large-integer-is-largei-large-integer-is-large
44537,1818404
+(defaxiom standardp-plusstandardp-plus
44545,1818691
+(defaxiom standardp-uminusstandardp-uminus
44550,1818811
+(defaxiom standardp-timesstandardp-times
44554,1818897
+(defaxiom standardp-udividestandardp-udivide
44559,1819018
+(defaxiom standardp-complexstandardp-complex
44563,1819105
+(defaxiom standardp-onestandardp-one
44571,1819423
+(defaxiom standard-part-of-standardpstandard-part-of-standardp
44577,1819547
+(defaxiom standardp-standard-partstandardp-standard-part
44582,1819690
+(defaxiom standard-part-of-reals-is-idempotentstandard-part-of-reals-is-idempotent
44586,1819793
+(defaxiom standard-part-of-complexstandard-part-of-complex
44591,1819953
+(defaxiom standard-part-of-plusstandard-part-of-plus
44597,1820131
+(defaxiom standard-part-of-uminusstandard-part-of-uminus
44602,1820272
+(defaxiom standard-part-of-timesstandard-part-of-times
44606,1820377
+(defaxiom standard-part-of-udividestandard-part-of-udivide
44611,1820559
+(defaxiom standard-part-<=standard-part-<=
44617,1820743
+(defaxiom small-are-limitedsmall-are-limited
44623,1820903
+(defaxiom standards-are-limitedstandards-are-limited
44630,1821079
+(defthm standard-constants-are-limitedstandard-constants-are-limited
44636,1821248
+(defaxiom limited-integers-are-standardlimited-integers-are-standard
44644,1821497
+(defaxiom standard+small->i-limitedstandard+small->i-limited
44651,1821733
+(defdoc acl2-numberpacl2-numberp
44659,1821917
+(defdoc ++
44667,1822123
+(defdoc binary-+binary-+
44683,1822432
+(defdoc binary-*binary-*
44709,1823042
+(defdoc --
44733,1823606
+(defdoc unary--unary--
44762,1824097
+(defdoc unary-/unary-/
44784,1824601
+(defdoc <<
44808,1825165
+(defdoc carcar
44838,1826076
+(defdoc cdrcdr
44857,1826488
+(defdoc char-codechar-code
44876,1826902
+(defdoc characterpcharacterp
44894,1827285
+(defdoc code-charcode-char
44902,1827453
+(defdoc complexcomplex
44925,1828008
+(defdoc conscons
44973,1829829
+(defdoc conspconsp
44982,1830112
+(defdoc coercecoerce
44989,1830273
+(defdoc denominatordenominator
45038,1831924
+(defdoc equalequal
45056,1832266
+(defdoc ifif
45067,1832547
+(defdoc imagpartimagpart
45083,1832959
+(defdoc integerpintegerp
45101,1833292
+(defdoc intern-in-package-of-symbolintern-in-package-of-symbol
45108,1833451
+(defdoc numeratornumerator
45164,1835666
+(defdoc rationalprationalp
45182,1835999
+(defdoc realpartrealpart
45190,1836195
+(defdoc stringpstringp
45208,1836523
+(defdoc symbol-namesymbol-name
45215,1836672
+(defdoc symbol-package-namesymbol-package-name
45233,1837010
+(defdoc symbolpsymbolp
45260,1837962
+(defdoc quotequote
45267,1838111
+(defun double-rewrite (x)double-rewrite
45275,1838276
+(defparameter *acl2-time-limit* nil)*acl2-time-limit*
45508,1849241
+(defparameter *acl2-time-limit-boundp* nil)*acl2-time-limit-boundp*
45510,1849279
+(defun chk-with-prover-time-limit-arg (time)chk-with-prover-time-limit-arg
45514,1849327
+(defmacro with-prover-time-limit1-raw (time form)with-prover-time-limit1-raw
45531,1850000
+(defmacro with-prover-time-limit1 (time form)with-prover-time-limit1
45551,1850875
+(defmacro with-prover-time-limit (time form)with-prover-time-limit
45554,1850981
+(defparameter *time-limit-tags* nil)*time-limit-tags*
45651,1855899
+(defmacro catch-time-limit5 (form)catch-time-limit5
45653,1855937
+(defmacro catch-time-limit5@par (form)catch-time-limit5@par
45677,1856921
+(defun time-limit5-reached-p (msg)time-limit5-reached-p
45713,1858555
+(defmacro catch-step-limit (form)catch-step-limit
45757,1860594
+(defconst *guard-checking-values**guard-checking-values*
45786,1861789
+(defun chk-with-guard-checking-arg (val)chk-with-guard-checking-arg
45789,1861855
+(defmacro with-guard-checking1-raw (val form)with-guard-checking1-raw
45801,1862374
+(defmacro with-guard-checking1 (val form)with-guard-checking1
45812,1862770
+(defmacro with-guard-checking (val form)with-guard-checking
45815,1862868
+(defun abort! ()abort!
45841,1863807
+(defmacro a! ()a!
45855,1864110
+(defun p! ()p!
45879,1864978
+(defparameter *wormhole-status-alist* nil)*wormhole-status-alist*
45922,1866667
+(defparameter *inhibit-wormhole-activityp* nil)*inhibit-wormhole-activityp*
45925,1866728
+(defun wormhole1 (name input form ld-specials)wormhole1
45927,1866777
+(defun wormhole-p (state)wormhole-p
46023,1870784
+(defun duplicates (lst)duplicates
46040,1871264
+(defun evens (l)evens
46047,1871497
+(defun odds (l)odds
46053,1871643
+(defun set-equalp-equal (lst1 lst2)set-equalp-equal
46057,1871721
+(defparameter *metafunction-context* nil)*metafunction-context*
46179,1878667
+(DEFMACRO |Access REWRITE-CONSTANT record field CURRENT-CLAUSE||Access
46299,1883189
+(defun record-error (name rec)record-error
46316,1883760
+(defun record-accessor-function-name (name field)record-accessor-function-name
46322,1883930
+(defmacro access (name rec field)access
46334,1884315
+(defun mfc-clause (mfc)mfc-clause
46343,1884655
+(defun mfc-rdepth (mfc)mfc-rdepth
46377,1886053
+(defun type-alist-entryp (x)type-alist-entryp
46387,1886348
+(defun type-alistp (x)type-alistp
46403,1886836
+(defun mfc-type-alist (mfc)mfc-type-alist
46410,1886995
+(defun mfc-ancestors (mfc)mfc-ancestors
46426,1887438
+(defun mfc-unify-subst (mfc)mfc-unify-subst
46442,1887875
+(defun mfc-world (mfc)mfc-world
46452,1888190
+(defthm pseudo-term-listp-mfc-clausepseudo-term-listp-mfc-clause
46465,1888561
+(defthm type-alistp-mfc-type-alisttype-alistp-mfc-type-alist
46468,1888639
+(defun bad-atom (x)bad-atom
46503,1890631
+(defthm bad-atom-compound-recognizerbad-atom-compound-recognizer
46514,1890849
+(defun-one-output bad-atom<= (x y)bad-atom<=
46526,1891143
+(defaxiom booleanp-bad-atom<=booleanp-bad-atom<=
46535,1891497
+(defaxiom bad-atom<=-antisymmetricbad-atom<=-antisymmetric
46540,1891633
+(defaxiom bad-atom<=-transitivebad-atom<=-transitive
46548,1891839
+(defaxiom bad-atom<=-totalbad-atom<=-total
46557,1892102
+(defun alphorder (x y)alphorder
46567,1892372
+(defun lexorder (x y)lexorder
46643,1894975
+(defthm alphorder-reflexivealphorder-reflexive
46708,1897027
+(defthm alphorder-transitivealphorder-transitive
46725,1897544
+(defthm alphorder-anti-symmetricalphorder-anti-symmetric
46736,1897878
+(defthm alphorder-totalalphorder-total
46760,1898893
+(defthm lexorder-reflexivelexorder-reflexive
46775,1899430
+(defthm lexorder-anti-symmetriclexorder-anti-symmetric
46778,1899476
+(defthm lexorder-transitivelexorder-transitive
46783,1899615
+(defthm lexorder-totallexorder-total
46788,1899765
+(defun merge-lexorder (l1 l2 acc)merge-lexorder
46804,1900296
+(defthm true-listp-merge-sort-lexordertrue-listp-merge-sort-lexorder
46830,1901044
+(defun merge-sort-lexorder (l)merge-sort-lexorder
46836,1901237
+(defdoc bddbdd
46851,1901863
+(defun if* (x y z)if*
46885,1903313
+(defun resize-list (lst n default-value)resize-list
47069,1910463
+(deflabel theory-functionstheory-functions
47085,1910983
+(defun e/d-fn (theory e/d-list enable-p)e/d-fn
47120,1912606
+(defmacro e/d (&rest theories)e/d
47131,1913127
+(defun mod-expt (base exp mod)mod-expt
47210,1916110
+(defmacro fcons-term* (&rest x)fcons-term*
47254,1917883
+(defun conjoin2 (t1 t2)conjoin2
47271,1918561
+(defun conjoin (l)conjoin
47285,1919059
+(defun conjoin2-untranslated-terms (t1 t2)conjoin2-untranslated-terms
47291,1919228
+(defun conjoin-untranslated-terms (l)conjoin-untranslated-terms
47307,1919670
+(defun disjoin2 (t1 t2)disjoin2
47319,1920009
+(defun disjoin (lst)disjoin
47331,1920367
+(defun disjoin-lst (clause-list)disjoin-lst
47337,1920552
+(defun conjoin-clauses (clause-list)conjoin-clauses
47343,1920774
+(defconst *true-clause* (list *t*))*true-clause*
47347,1920908
+(defconst *false-clause* nil)*false-clause*
47349,1920945
+(defun clauses-result (tuple)clauses-result
47351,1920976
+(defdoc sharp-dot-readersharp-dot-reader
47356,1921124
+(defdoc sharp-comma-readersharp-comma-reader
47395,1922413
+(defdoc sharp-bang-readersharp-bang-reader
47403,1922618
+(defdoc sharp-u-readersharp-u-reader
47435,1923416
+(defdoc evisc-tableevisc-table
47487,1924950
+(defconst *top-hint-keywords**top-hint-keywords*
47731,1933483
+(defconst *hint-keywords**hint-keywords*
47741,1933891
+(defmacro add-custom-keyword-hint (key uterm1 &key (checker '(value t)))add-custom-keyword-hint
47786,1935294
+(defmacro add-custom-keyword-hint (&rest args)add-custom-keyword-hint
47874,1939078
+(defmacro remove-custom-keyword-hint (keyword)remove-custom-keyword-hint
47878,1939159
+(defun splice-keyword-alist (key new-segment keyword-alist)splice-keyword-alist
47911,1940296
+(deflabel custom-keyword-hintscustom-keyword-hints
47924,1940838
+(defmacro show-custom-keyword-hint-expansion (flg)show-custom-keyword-hint-expansion
47934,1941150
+(defun search-fn-guard (seq1 seq2 from-end test start1 start2 end1 end2search-fn-guard
47963,1942030
+(defun search-from-start (seq1 seq2 start2 end2)search-from-start
48011,1944178
+(defun search-from-end (seq1 seq2 start2 end2 acc)search-from-end
48034,1945038
+(defmacro search (seq1 seq2search
48215,1950694
+(defthm eqlablep-ntheqlablep-nth
48279,1953737
+(defun count-stringp (item x start end)count-stringp
48284,1953866
+(defun count-listp (item x end)count-listp
48299,1954399
+(defmacro count (item sequence &key (start '0) end)count
48334,1955531
+(defun make-sharp-atsign (i)make-sharp-atsign
48374,1957123
+(defun sharp-atsign-alist (i acc)sharp-atsign-alist
48381,1957339
+(defmacro time$1-raw (val x)time$1-raw
48488,1962299
+(defmacro time$1 (val form)time$1
48508,1962982
+(defmacro time$ (x &keytime$
48511,1963052
+(defmacro our-multiple-value-prog1 (form &rest other-forms)our-multiple-value-prog1
48693,1969769
+(defconst *mv-vars**mv-vars*
48709,1970257
+(defconst *mv-var-values**mv-var-values*
48716,1970402
+(defconst *mv-extra-var* (gensym))*mv-extra-var*
48720,1970496
+(defun protect-mv (form &optional multiplicity)protect-mv
48722,1970532
+(defmacro our-time (x &key real-mintime run-mintime minalloc msg args)our-time
48770,1972296
+(defun-one-output gc$-fn (args)gc$-fn
48905,1978237
+(defun gc$-fn (args)gc$-fn
48929,1979081
+(defmacro gc$ (&rest args)gc$
48934,1979164
+(defun-one-output gc-verbose-fn (arg)gc-verbose-fn
48963,1980149
+(defun gc-verbose-fn (arg)gc-verbose-fn
48978,1980617
+(defmacro gc-verbose (arg)gc-verbose
48983,1980705
+(defun get-wormhole-status (name state)get-wormhole-status
49008,1981600
+(defun file-write-date$ (file state)file-write-date$
49037,1982694
+(defun debugger-enable (state)debugger-enable
49055,1983206
+(defun break$ ()break$
49060,1983397
+(defvar *ccl-print-call-history-count**ccl-print-call-history-count*
49096,1984582
+(defun print-call-history ()print-call-history
49119,1985629
+(defun debugger-enabledp (state)debugger-enabledp
49170,1987549
+(defun maybe-print-call-history (state)maybe-print-call-history
49177,1987825
+(defmacro with-reckless-readtable (form)with-reckless-readtable
49184,1988116
+(defmacro set-debugger-enable (val)set-debugger-enable
49202,1988723
+(defun set-debugger-enable-fn (val state)set-debugger-enable-fn
49336,1994614
+(defun add-@par-suffix (symbol)add-@par-suffix
49369,1995976
+(defun generate-@par-mappings (symbols)generate-@par-mappings
49375,1996151
+(defconst *@par-mappings**@par-mappings*
49392,1996996
+(defun make-identity-for-@par-mappings (mappings)make-identity-for-@par-mappings
49586,2003846
+(defmacro define-@par-macros ()define-@par-macros
49600,2004411
+(defun replace-defun@par-with-defun (forms)replace-defun@par-with-defun
49617,2005007
+(defmacro mutual-recursion@par (&rest forms)mutual-recursion@par
49628,2005374
+(defun defun@par-fn (name parallel-version rst)defun@par-fn
49632,2005493
+(defun mutual-recursion@par-guardp (rst)mutual-recursion@par-guardp
49652,2006235
+(defun mutual-recursion@par-fn (forms serial-and-par)mutual-recursion@par-fn
49664,2006717
+(defmacro mutual-recursion@par (&rest forms)mutual-recursion@par
49686,2007678
+(defmacro defun@par (name &rest args)defun@par
49690,2007846
+(defmacro serial-first-form-parallel-second-form (x y)serial-first-form-parallel-second-form
49704,2008344
+(defmacro serial-first-form-parallel-second-form@par (x y)serial-first-form-parallel-second-form@par
49712,2008505
+(defmacro serial-only (x)serial-only
49719,2008655
+(defmacro serial-only@par (x)serial-only@par
49726,2008737
+(defmacro parallel-only (x)parallel-only
49733,2008833
+(defmacro parallel-only@par (x)parallel-only@par
49741,2008944
+(defmacro mv@par (&rest rst)mv@par
49748,2009030
+(defmacro value@par (val)value@par
49754,2009190
+(defmacro state-mac ()state-mac
49760,2009264
+(defmacro state-mac@par ()state-mac@par
49767,2009346
+(defmacro mv-let@par (vars call &rest rst)mv-let@par
49774,2009425
+(defmacro warning$@par (&rest rst)warning$@par
49780,2009616
+(defmacro error-in-parallelism-mode (fake-return-value form)error-in-parallelism-mode
49789,2009865
+(defmacro error-in-parallelism-mode@par (return-value form)error-in-parallelism-mode@par
49794,2009985
+(defun increment-timer@par (name state)increment-timer@par
49816,2010898
+(defconst *waterfall-printing-values**waterfall-printing-values*
49824,2011124
+(defconst *waterfall-parallelism-values**waterfall-parallelism-values*
49827,2011198
+(defun symbol-constant-fn (prefix sym)symbol-constant-fn
49834,2011426
+(defun stobjs-in (fn w)stobjs-in
49845,2011779
+(defmacro oracle-funcall (fn &rest args)oracle-funcall
49860,2012183
+(defun all-nils (lst)all-nils
49894,2013291
+(defun oracle-apply-guard (fn args state)oracle-apply-guard
49900,2013457
+(defun oracle-apply (fn args state)oracle-apply
49913,2013951
+(defun oracle-apply-raw (fn args state)oracle-apply-raw
50039,2019586
+(defun time-tracker-fn (tag kwd kwdp times interval min-time msg)time-tracker-fn
50074,2021042
+(defmacro time-tracker (tag &optional (kwd 'nil kwdp)time-tracker
50143,2023353
+(defmacro time-tracker (&rest args)time-tracker
50148,2023551
+(defdoc time-trackertime-tracker
50152,2023621
+(defdoc time-tracker-tautime-tracker-tau
50397,2036637
+(defg *inside-absstobj-update* #(0))*inside-absstobj-update*
50464,2039234
+(defun set-absstobj-debug-fn (val always)set-absstobj-debug-fn
50466,2039272
+(defmacro set-absstobj-debug (val &key (event-p 't) always on-skip-proofs)set-absstobj-debug
50497,2040704
+(defun <? (rel x y)<?
50735,2050854
+(defun tau-interval-domainp (dom x)tau-interval-domainp
50769,2052020
+(defun tau-interval-dom (x)tau-interval-dom
50777,2052276
+(defun tau-interval-lo-rel (x)tau-interval-lo-rel
50798,2052844
+(defun tau-interval-lo (x)tau-interval-lo
50820,2053592
+(defun tau-interval-hi-rel (x)tau-interval-hi-rel
50842,2054291
+(defun tau-interval-hi (x)tau-interval-hi
50863,2055038
+(defun make-tau-interval (dom lo-rel lo hi-rel hi)make-tau-interval
50885,2055737
+(defun tau-intervalp (int)tau-intervalp
50945,2058480
+(defun in-tau-intervalp (x int)in-tau-intervalp
51057,2062639
+
+memoize.lisp,1304
+(defmacro defn (f a &rest r)defn
31,1268
+(defmacro defnd (f a &rest r)defnd
40,1466
+(defdoc hons-and-memoizationhons-and-memoization
49,1682
+(defn clear-memoize-table (fn)clear-memoize-table
364,17583
+(defn clear-memoize-tables ()clear-memoize-tables
379,18018
+(defn memoize-summary ()memoize-summary
395,18526
+(defn clear-memoize-statistics ()clear-memoize-statistics
410,19062
+(defmacro memsum ()memsum
423,19510
+(defconst *hons-primitive-fns**hons-primitive-fns*
444,20337
+(defconst *hons-primitives**hons-primitives*
473,20939
+(defconst *mht-default-size* 60)*mht-default-size*
484,21211
+(defun memoize-form (fnmemoize-form
486,21245
+(defmacro memoize (fn &keymemoize
634,28081
+(defmacro unmemoize (fn)unmemoize
921,43447
+(defmacro profile (fn &rest r)profile
972,45052
+(defmacro memoize-on-raw (fn form)memoize-on-raw
1025,47519
+(defmacro memoize-on (fn form)memoize-on
1029,47587
+(defmacro memoize-off-raw (fn form)memoize-off-raw
1040,47969
+(defmacro memoize-off (fn form)memoize-off
1044,48038
+(defmacro memoizedp-world (fn wrld)memoizedp-world
1054,48412
+(defmacro memoizedp (fn)memoizedp
1065,48789
+(defparameter *never-profile-ht**never-profile-ht*
1094,49641
+(defun never-memoize-fn (fn)never-memoize-fn
1098,49739
+(defmacro never-memoize (fn)never-memoize
1103,49842
+
+hons.lisp,2416
+(defdoc normednormed
35,1575
+(defn hons-copy (x)hons-copy
102,4467
+(defn hons-copy-persistent (x)hons-copy-persistent
141,6056
+(defn hons (x y)hons
164,6943
+(defn hons-equal (x y)hons-equal
196,8130
+(defn hons-equal-lite (x y)hons-equal-lite
222,9274
+(defn hons-clear (gc)hons-clear
248,10388
+(defn hons-wash ()hons-wash
282,11784
+(defn hons-summary ()hons-summary
316,13304
+(defmacro hons-resize (&key str-ht nil-ht cdr-ht cdr-ht-eqlhons-resize
339,14200
+(defn hons-resize-fn (str-ht nil-ht cdr-ht cdr-ht-eqlhons-resize-fn
418,17291
+(defdoc hons-notehons-note
427,17635
+(defdoc fast-alistsfast-alists
491,20704
+(defn hons-assoc-equal (key alist)hons-assoc-equal
541,23198
+(defdoc slow-alist-warningslow-alist-warning
566,24187
+(defmacro set-slow-alist-action (action)set-slow-alist-action
595,25401
+(defn get-slow-alist-action (state)get-slow-alist-action
601,25631
+(defn hons-get (key alist)hons-get
609,25900
+(defn hons-acons (key val alist)hons-acons
631,26829
+(defn hons-acons! (key val alist)hons-acons!
697,29794
+(defn make-fast-alist (alist)make-fast-alist
761,32457
+(defn hons-shrink-alist (alist ans)hons-shrink-alist
786,33535
+(defn hons-shrink-alist! (alist ans)hons-shrink-alist!
861,36559
+(defn fast-alist-len (alist)fast-alist-len
882,37448
+(defn fast-alist-free (alist)fast-alist-free
902,38282
+(defn fast-alist-summary ()fast-alist-summary
932,39428
+(defdoc with-fast-alistwith-fast-alist
951,40128
+(defdoc with-stolen-alistwith-stolen-alist
1020,42528
+(defdoc fast-alist-free-on-exitfast-alist-free-on-exit
1041,43539
+(defined in the community book ~c[\"books/tools/bstar.lisp\"]) with thein
1063,44348
+(defmacro with-fast-alist-raw (alist form)with-fast-alist-raw
1078,44776
+(defmacro with-fast-alist (alist form)with-fast-alist
1083,44897
+(defmacro with-stolen-alist-raw (alist form)with-stolen-alist-raw
1087,45022
+(defmacro with-stolen-alist (alist form)with-stolen-alist
1092,45145
+(defmacro fast-alist-free-on-exit-raw (alist form)fast-alist-free-on-exit-raw
1096,45274
+(defmacro fast-alist-free-on-exit (alist form)fast-alist-free-on-exit
1101,45403
+(defn cons-subtrees (x al)cons-subtrees
1104,45511
+(defn number-subtrees (x)number-subtrees
1124,46064
+(defn clear-hash-tables ()clear-hash-tables
1143,46734
+(defn flush-hons-get-hash-table-link (alist)flush-hons-get-hash-table-link
1157,47179
+(defun remove-keyword (word l)remove-keyword
1200,48972
+
+serialize.lisp,548
+(defdoc serializeserialize
38,1448
+(defmacro serialize-write (filename obj &key verbosep)serialize-write
55,2188
+(defun serialize-write-fn (filename obj verbosep state)serialize-write-fn
84,3117
+(defmacro serialize-read (filename &keyserialize-read
117,4200
+(defun serialize-read-fn (filename hons-mode verbosep state)serialize-read-fn
160,6021
+(defdoc serialize-alternativesserialize-alternatives
196,7254
+(defdoc serialize-in-booksserialize-in-books
212,7966
+(defmacro with-serialize-character (val form)with-serialize-character
255,9650
+
+basis.lisp,32644
+(defun enforce-redundancy-er-args (event-form-var wrld-var)enforce-redundancy-er-args
39,1746
+(defmacro enforce-redundancy (event-form ctx wrld form)enforce-redundancy
48,2209
+(defdoc gclgcl
71,3270
+(defun wormhole-statusp (whs)wormhole-statusp
307,14303
+(defun wormhole-entry-code (whs)wormhole-entry-code
326,14818
+(defun wormhole-data (whs)wormhole-data
345,15378
+(defun set-wormhole-entry-code (whs code)set-wormhole-entry-code
361,15809
+(defun set-wormhole-data (whs data)set-wormhole-data
388,16833
+(defun make-wormhole-status (old-status new-code new-data)make-wormhole-status
412,17694
+(defun tree-occur-eq (x y)tree-occur-eq
471,20320
+(defun wormhole-eval (qname qlambda free-vars)wormhole-eval
482,20570
+(deflock *wormhole-lock*)*wormhole-lock*
585,25641
+(defmacro wormhole-eval (qname qlambda free-vars)wormhole-eval
588,25685
+(defmacro wormhole (name entry-lambda input formwormhole
644,28280
+(deflabel wormhole-implementationwormhole-implementation
1153,52622
+(defun global-set (var val wrld)global-set
1236,57113
+(defun defabbrev1 (lst)defabbrev1
1241,57284
+(defun legal-variable-or-constant-namep (name)legal-variable-or-constant-namep
1247,57486
+(defun legal-constantp1 (name)legal-constantp1
1313,60403
+(defun tilde-@-illegal-variable-or-constant-name-phrase (name)tilde-@-illegal-variable-or-constant-name-phrase
1328,60900
+(defun legal-constantp (name)legal-constantp
1359,62579
+(defun defined-constant (name w)defined-constant
1369,62893
+(defun legal-variablep (name)legal-variablep
1386,63632
+(defun genvar1 (pkg-witness char-lst avoid-lst cnt)genvar1
1394,63917
+(defun genvar (pkg-witness prefix n avoid-lst)genvar
1430,65693
+(defun packn1 (lst)packn1
1472,67877
+(defun packn (lst)packn
1478,68061
+(defun packn-pos (lst witness)packn-pos
1486,68306
+(defun pack2 (n1 n2)pack2
1492,68543
+(defun gen-formals-from-pretty-flags1 (pretty-flags i avoid)gen-formals-from-pretty-flags1
1495,68589
+(defun gen-formals-from-pretty-flags (pretty-flags)gen-formals-from-pretty-flags
1520,69612
+(defun defstub-body (output)defstub-body
1532,70206
+(defun collect-non-x (x lst)collect-non-x
1555,71040
+(defmacro defproxy (name args-sig arrow body-sig)defproxy
1567,71419
+(defmacro defproxy (name args-sig arrow body-sig)defproxy
1904,83267
+(defun defstub-ignores (formals body)defstub-ignores
1920,84051
+(defun partition-rest-and-keyword-args1 (x)partition-rest-and-keyword-args1
1944,84928
+(defun partition-rest-and-keyword-args2 (keypart keys alist)partition-rest-and-keyword-args2
1953,85229
+(defun partition-rest-and-keyword-args (x keys)partition-rest-and-keyword-args
1970,85925
+(defmacro defstub (name &rest rst)defstub
1989,86715
+(defun lambda-keywordp (x)lambda-keywordp
2093,91423
+(defun arglistp1 (lst)arglistp1
2097,91518
+(defun arglistp (lst)arglistp
2105,91707
+(defun find-first-bad-arg (args)find-first-bad-arg
2109,91783
+(defun process-defabbrev-declares (decls)process-defabbrev-declares
2137,93152
+(defmacro defabbrev (fn args &rest body)defabbrev
2160,94234
+(defconst *primitive-formals-and-guards**primitive-formals-and-guards*
2297,100498
+(defconst *primitive-monadic-booleans**primitive-monadic-booleans*
2376,103524
+(defun equal-x-constant (x const)equal-x-constant
2399,104125
+(defun match-tests-and-bindings (x pat tests bindings)match-tests-and-bindings
2415,104592
+(defun match-clause (x pat forms)match-clause
2489,107916
+(defun match-clause-list (x clauses)match-clause-list
2497,108164
+(defmacro case-match (&rest args)case-match
2505,108475
+(defconst *non-standard-primitives**non-standard-primitives*
2588,111876
+(defun cons-term1-cases (alist)cons-term1-cases
2593,111967
+(defconst *cons-term1-alist**cons-term1-alist*
2641,114155
+(defmacro cons-term1-body ()cons-term1-body
2644,114238
+(defun quote-listp (l)quote-listp
2653,114505
+(defun cons-term1 (fn args)cons-term1
2659,114667
+(defun cons-term (fn args)cons-term
2664,114824
+(defmacro cons-term* (fn &rest args)cons-term*
2670,114992
+(defmacro mcons-term (fn args)mcons-term
2673,115064
+(defmacro mcons-term* (fn &rest args)mcons-term*
2680,115241
+(defmacro fcons-term (fn args)fcons-term
2687,115432
+(defun fargn1 (x n)fargn1
2704,116093
+(defmacro fargn (x n)fargn
2710,116277
+(defun cdr-nest (n v)cdr-nest
2713,116328
+(defun all-but-last (l)all-but-last
2717,116402
+(defconst *evisceration-mark* :evisceration-mark)*evisceration-mark*
2753,118211
+(defconst *evisceration-hash-mark* (cons *evisceration-mark* "#"))*evisceration-hash-mark*
2763,118712
+(defconst *evisceration-ellipsis-mark* (cons *evisceration-mark* "..."))*evisceration-ellipsis-mark*
2764,118779
+(defconst *evisceration-world-mark**evisceration-world-mark*
2765,118852
+(defconst *evisceration-state-mark**evisceration-state-mark*
2767,118928
+(defconst *evisceration-error-triple-marks**evisceration-error-triple-marks*
2769,119004
+(defconst *evisceration-hiding-mark**evisceration-hiding-mark*
2771,119092
+(defconst *anti-evisceration-mark**anti-evisceration-mark*
2774,119171
+(defmacro evisceratedp (eviscp x)evisceratedp
2777,119258
+(defconst *sharp-atsign-ar* ; see get-sharp-atsign*sharp-atsign-ar*
2863,124331
+(defun get-sharp-atsign (i)get-sharp-atsign
2872,124706
+(defun update-iprint-alist (iprint-alist val)update-iprint-alist
2882,125044
+(defun eviscerate1 (x v max-v max-n alist evisc-table hiding-cars iprint-alist)eviscerate1
2902,125827
+(defun eviscerate1-lst (lst v n max-v max-n alist evisc-table hiding-carseviscerate1-lst
2934,127338
+(defun eviscerate1p (x alist evisc-table hiding-cars)eviscerate1p
2968,128714
+(defun eviscerate1p-lst (lst alist evisc-table hiding-cars)eviscerate1p-lst
2984,129387
+(defun eviscerate (x print-level print-length alist evisc-table hiding-carseviscerate
2996,129865
+(defun eviscerate-simple (x print-level print-length alist evisc-tableeviscerate-simple
3056,132481
+(defun aset1-lst (name alist ar)aset1-lst
3068,132969
+(defun iprint-hard-bound (state)iprint-hard-bound
3078,133284
+(defun iprint-soft-bound (state)iprint-soft-bound
3081,133361
+(defun iprint-last-index* (iprint-ar)iprint-last-index*
3084,133438
+(defun iprint-last-index (state)iprint-last-index
3091,133648
+(defun iprint-ar-illegal-index (index state)iprint-ar-illegal-index
3094,133738
+(defun iprint-enabledp (state)iprint-enabledp
3103,134081
+(defun iprint-ar-aref1 (index state)iprint-ar-aref1
3106,134176
+(defun collect-posp-indices-to-header (ar acc)collect-posp-indices-to-header
3129,134951
+(defun rollover-iprint-ar (iprint-alist last-index state)rollover-iprint-ar
3145,135544
+(defun update-iprint-ar (iprint-alist state)update-iprint-ar
3218,139011
+(defun eviscerate-top (x print-level print-length alist evisc-table hiding-carseviscerate-top
3241,139990
+(defun world-evisceration-alist (state alist)world-evisceration-alist
3258,140812
+(defun stobj-print-name (name)stobj-print-name
3265,141040
+(defun evisceration-stobj-mark (name inputp)evisceration-stobj-mark
3272,141204
+(defun evisceration-stobj-marks1 (stobjs-flags inputp)evisceration-stobj-marks1
3284,141516
+(defconst *error-triple-sig**error-triple-sig*
3296,141924
+(defconst *cmp-sig**cmp-sig*
3299,141974
+(defun evisceration-stobj-marks (stobjs-flags inputp)evisceration-stobj-marks
3302,142009
+(defun eviscerate-stobjs1 (estobjs-out lst print-level print-lengtheviscerate-stobjs1
3310,142319
+(defun eviscerate-stobjs (estobjs-out lst print-level print-lengtheviscerate-stobjs
3331,143383
+(defun eviscerate-stobjs-top (estobjs-out lst print-level print-lengtheviscerate-stobjs-top
3380,145437
+(defmacro mv-letc (vars form body)mv-letc
3452,149388
+(defmacro er-hard-val (val &rest args)er-hard-val
3457,149515
+(defmacro the-fixnum! (n ctx)the-fixnum!
3467,149859
+(defmacro the-half-fixnum! (n ctx)the-half-fixnum!
3485,150433
+(defmacro the-unsigned-byte! (bits n ctx)the-unsigned-byte!
3503,151064
+(defmacro the-string! (s ctx)the-string!
3512,151369
+(defun xxxjoin-fixnum (fn args root)xxxjoin-fixnum
3519,151533
+(defmacro +f (&rest args)+f
3534,151937
+(defmacro -f (arg1 &optional arg2)-f
3537,151994
+(defmacro 1-f (x)1-f
3543,152168
+(defmacro 1+f (x)1+f
3547,152249
+(defmacro charf (s i)charf
3551,152330
+(defmacro *f (&rest args)*f
3555,152404
+(defmacro ppr-flat-right-margin ()ppr-flat-right-margin
3846,164443
+(defun set-ppr-flat-right-margin (val state)set-ppr-flat-right-margin
3849,164527
+(defun keyword-param-valuep (tuple eviscp)keyword-param-valuep
3862,165093
+(defun cons-ppr1 (x column width ppr-flat-right-margin eviscp)cons-ppr1
3882,166050
+(defun flsz-integer (x print-base acc)flsz-integer
4024,172041
+(defun flsz-atom (x print-base print-radix acc state)flsz-atom
4034,172419
+(defun flsz1 (x print-base print-radix j maximum state eviscp)flsz1
4110,175693
+(defun output-in-infixp (state)output-in-infixp
4143,177007
+(defun flatsize-infix (x print-base print-radix termp j max state eviscp)flatsize-infix
4147,177129
+(defun flsz (x termp j maximum state eviscp)flsz
4163,177843
+(defun max-width (lst maximum)max-width
4169,178107
+(defun ppr1 (x print-base print-radix width rpc state eviscp)ppr1
4177,178318
+(defun ppr1-lst (lst print-base print-radix width rpc state eviscp)ppr1-lst
4272,182625
+(defun newline (channel state)newline
4318,184618
+(defun fmt-hard-right-margin (state)fmt-hard-right-margin
4321,184686
+(defun fmt-soft-right-margin (state)fmt-soft-right-margin
4325,184787
+(defun set-fmt-hard-right-margin (n state)set-fmt-hard-right-margin
4329,184888
+(defun set-fmt-soft-right-margin (n state)set-fmt-soft-right-margin
4365,186216
+(defun write-for-read (state)write-for-read
4387,186872
+(defun spaces1 (n col hard-right-margin channel state)spaces1
4390,186943
+(defun make-spaces-array-rec (n acc)make-spaces-array-rec
4407,187664
+(defun make-spaces-array (n)make-spaces-array
4417,187891
+(defconst *acl2-built-in-spaces-array**acl2-built-in-spaces-array*
4426,188197
+(defun spaces (n col channel state)spaces
4432,188320
+(defun flpr1 (x channel state eviscp)flpr1
4454,189075
+(defun flpr11 (x channel state eviscp)flpr11
4467,189538
+(defun-one-output print-flat-infix (x termp file eviscp)print-flat-infix
4484,190041
+(defun flpr (x termp channel state eviscp)flpr
4498,190549
+(defun ppr2-flat (x channel state eviscp)ppr2-flat
4510,190952
+(defun ppr2-column (lst loc col channel state eviscp)ppr2-column
4530,191604
+(defun ppr2 (x col channel state eviscp)ppr2
4547,192305
+(defconst *fmt-ppr-indentation* 0)*fmt-ppr-indentation*
4594,194264
+(defun ppr (x col channel state eviscp)ppr
4596,194300
+(defun scan-past-whitespace (s i maximum)scan-past-whitespace
4622,195348
+(defun zero-one-or-more (x)zero-one-or-more
4632,195675
+(defun find-alternative-skip (s i maximum)find-alternative-skip
4640,195844
+(defun find-alternative-start1 (x s i maximum)find-alternative-start1
4678,197321
+(defun fmt-char (s i j maximum err-flg)fmt-char
4721,199281
+(defun find-alternative-start (x s i maximum)find-alternative-start
4743,200133
+(defun find-alternative-stop (s i maximum)find-alternative-stop
4775,201603
+(defun punctp (c)punctp
4811,203118
+(defun fmt-tilde-s1 (s i maximum col channel state)fmt-tilde-s1
4816,203207
+(defun fmt-var (s alist i maximum)fmt-var
4871,205626
+(defun splat-atom (x print-base print-radix indent col channel state)splat-atom
4883,206192
+(defun splat (x print-base print-radix indent col channel state)splat
4901,206923
+(defun splat1 (x print-base print-radix indent col channel state)splat1
4914,207492
+(defun number-of-digits (n print-base print-radix)number-of-digits
4948,209230
+(defun left-pad-with-blanks (n width col channel state)left-pad-with-blanks
4966,209902
+(defmacro maybe-newline (body)maybe-newline
4986,210668
+(defun evisc-tuple (print-level print-length alist hiding-cars)evisc-tuple
5013,211913
+(defun standard-evisc-tuplep (x)standard-evisc-tuplep
5077,214794
+(defun abbrev-evisc-tuple (state)abbrev-evisc-tuple
5088,215101
+(defmacro gag-mode ()gag-mode
5104,215797
+(defun default-evisc-tuple (state)default-evisc-tuple
5118,216101
+(defun term-evisc-tuple (flg state)term-evisc-tuple
5126,216516
+(defun gag-mode-evisc-tuple (state)gag-mode-evisc-tuple
5155,217767
+(defun ld-evisc-tuple (state)ld-evisc-tuple
5163,218004
+(deflabel eviscerate-hide-termseviscerate-hide-terms
5189,219288
+(defun-one-output print-infix (x termp width rpc col file eviscp)print-infix
5207,219887
+(defun fmt-ppr (x termp width rpc col channel state eviscp)fmt-ppr
5247,221763
+(defun fmt0* (str0 str1 str2 str3 lst alist col channel state evisc-tuple)fmt0*
5264,222290
+(defun fmt0&v (flg lst punct col channel state evisc-tuple)fmt0&v
5303,224082
+(defun spell-number (n cap col channel state evisc-tuple)spell-number
5349,226068
+(defun fmt-tilde-s (s col channel state)fmt-tilde-s
5419,229572
+(defun fmt0 (s alist i maximum col channel state evisc-tuple)fmt0
5469,231489
+(defun tilde-*-&v-strings (flg lst punct)tilde-*-&v-strings
5915,255272
+(defun fmt1 (str alist col channel state evisc-tuple)fmt1
5960,257211
+(defun fmt (str alist channel state evisc-tuple)fmt
5984,258020
+(defun fms (str alist channel state evisc-tuple)fms
6423,277911
+(defun fmt1! (str alist col channel state evisc-tuple)fmt1!
6441,278389
+(defun fmt! (str alist channel state evisc-tuple)fmt!
6464,279226
+(defun fms! (str alist channel state evisc-tuple)fms!
6487,280039
+(defmacro fmx (str &rest args)fmx
6509,280816
+(defun fmt-doc-example1 (lst i)fmt-doc-example1
6516,281081
+(defun fmt-doc-example (x state)fmt-doc-example
6524,281391
+(defun fmt-abbrev1 (str alist col channel state suffix-msg)fmt-abbrev1
6545,282482
+(defun fmt-abbrev (str alist col channel state suffix-msg)fmt-abbrev
6563,283274
+(defconst *fmt-ctx-spacers**fmt-ctx-spacers*
6569,283470
+(defun fmt-ctx (ctx col channel state)fmt-ctx
6598,284015
+(defun fmt-in-ctx (ctx col channel state)fmt-in-ctx
6641,285686
+(defun error-fms-channel (hardp ctx str alist channel state)error-fms-channel
6657,286227
+(defun error-fms (hardp ctx str alist state)error-fms
6680,287182
+(defvar *accumulated-warnings* nil)*accumulated-warnings*
6694,287584
+(defun push-warning-frame (state)push-warning-frame
6696,287621
+(defun absorb-frame (lst stk)absorb-frame
6702,287758
+(defun pop-warning-frame (accum-p state)pop-warning-frame
6708,287880
+(defun push-warning (summary state)push-warning
6743,289402
+(defun member-string-equal (str lst)member-string-equal
6766,290305
+(defabbrev flambda-applicationp (term)flambda-applicationp
6772,290460
+(defabbrev lambda-applicationp (term)lambda-applicationp
6778,290560
+(defabbrev flambdap (fn)flambdap
6782,290656
+(defabbrev lambda-formals (x) (cadr x))lambda-formals
6788,290746
+(defabbrev lambda-body (x) (caddr x))lambda-body
6790,290787
+(defabbrev make-lambda (args body)make-lambda
6792,290826
+(defabbrev make-let (bindings body)make-let
6795,290890
+(defun doubleton-list-p (x)doubleton-list-p
6798,290956
+(defmacro er-let* (alist body)er-let*
6804,291143
+(defmacro er-let*@par (alist body)er-let*@par
6832,292165
+(defmacro match (x pat)match
6857,293108
+(defmacro match! (x pat)match!
6860,293170
+(defun def-basic-type-sets1 (lst i)def-basic-type-sets1
6867,293398
+(defmacro def-basic-type-sets (&rest lst)def-basic-type-sets
6874,293691
+(defun list-of-the-type-set (x)list-of-the-type-set
6888,294159
+(defmacro ts= (a b)ts=
6894,294321
+(defmacro ts-complement0 (x)ts-complement0
6900,294529
+(defmacro ts-complementp (x)ts-complementp
6903,294621
+(defun ts-union0-fn (x)ts-union0-fn
6906,294671
+(defmacro ts-union0 (&rest x)ts-union0
6913,294884
+(defmacro ts-intersection0 (&rest x)ts-intersection0
6917,294977
+(defmacro ts-disjointp (&rest x)ts-disjointp
6921,295087
+(defmacro ts-intersectp (&rest x)ts-intersectp
6924,295174
+(defun ts-builder-case-listp (x)ts-builder-case-listp
6931,295498
+(defun ts-builder-macro1 (x case-lst seen)ts-builder-macro1
6964,296871
+(defun ts-builder-macro (x case-lst)ts-builder-macro
6984,297846
+(defmacro ts-builder (&rest args)ts-builder
6990,298055
+(defabbrev strip-not (term)strip-not
6996,298286
+(defun record-maker-function-name (name)record-maker-function-name
7217,306893
+(defun record-changer-function-name (name)record-changer-function-name
7227,307192
+(defmacro make (&rest args)make
7236,307429
+(defmacro change (&rest args)change
7246,307786
+(defun make-record-car-cdrs1 (lst var)make-record-car-cdrs1
7254,308119
+(defun make-record-car-cdrs (field-layout car-cdr-lst)make-record-car-cdrs
7258,308253
+(defun make-record-accessors (name field-lst car-cdrs cheap)make-record-accessors
7267,308712
+(defun symbol-name-tree-occur (sym sym-tree)symbol-name-tree-occur
7291,309869
+(defun some-symbol-name-tree-occur (syms sym-tree)some-symbol-name-tree-occur
7307,310457
+(defun make-record-changer-cons (fields field-layout x)make-record-changer-cons
7312,310656
+(defun make-record-changer-let-bindings (field-layout lst)make-record-changer-let-bindings
7331,311402
+(defun make-record-changer-let (name field-layout cheap rec lst)make-record-changer-let
7353,312440
+(defun make-record-changer (name field-layout cheap)make-record-changer
7379,313636
+(defun make-record-maker-cons (fields field-layout)make-record-maker-cons
7390,313950
+(defun make-record-maker-let (name field-layout cheap lst)make-record-maker-let
7417,315144
+(defun make-record-maker (name field-layout cheap)make-record-maker
7430,315620
+(defun make-record-field-lst (field-layout)make-record-field-lst
7440,315896
+(defun record-maker-recognizer-name (name)record-maker-recognizer-name
7447,316180
+(defun make-record-recognizer-body (field-layout)make-record-recognizer-body
7457,316482
+(defun make-record-recognizer (name field-layout cheap recog-name)make-record-recognizer
7481,317235
+(defun record-macros (name field-layout cheap recog-name)record-macros
7490,317622
+(defmacro defrec (name field-lst cheap &optional recog-name)defrec
7512,318778
+(defabbrev equalityp (term)equalityp
7520,319073
+(defabbrev inequalityp (term)inequalityp
7531,319437
+(defabbrev consityp (term)consityp
7542,319799
+(defun power-rep (n b)power-rep
7551,320023
+(defun decode-idate (n)decode-idate
7557,320135
+(defun pcd2 (n channel state)pcd2
7580,320901
+(defun print-idate (n channel state)print-idate
7587,321117
+(defun print-current-idate (channel state)print-current-idate
7615,322053
+(defconst *window-descriptions**window-descriptions*
7670,325108
+(defun io?-nil-output (lst default-bindings)io?-nil-output
7688,325704
+(defmacro check-exact-free-vars (ctx vars form)check-exact-free-vars
7695,325996
+(defun formal-bindings (vars)formal-bindings
7722,327125
+(defrec io-recordio-record
7734,327472
+(defmacro io-record-forms (io-records)io-record-forms
7745,327761
+(defun push-io-record (io-marker form state)push-io-record
7752,327918
+(defun saved-output-token-p (token state)saved-output-token-p
7760,328221
+(defun io?-wormhole-bindings (i vars)io?-wormhole-bindings
7765,328451
+(defmacro io? (token commentp shape vars bodyio?
7773,328756
+(defmacro io?@par (token commentp &rest rst)io?@par
7919,335538
+(defmacro io?-prove (vars body &rest keyword-args)io?-prove
7932,335977
+(defmacro io?-gag (vars body &rest keyword-args)io?-gag
7940,336156
+(defun output-ignored-p (token state)output-ignored-p
7945,336297
+(defun error1 (ctx str alist state)error1
7950,336470
+(defun error1@par (ctx str alist state)error1@par
7991,337924
+(defun error1-safe (ctx str alist state)error1-safe
8003,338244
+(defconst *uninhibited-warning-summaries**uninhibited-warning-summaries*
8014,338515
+(defun warning-off-p1 (summary wrld ld-skip-proofsp)warning-off-p1
8028,338920
+(defun warning-off-p (summary state)warning-off-p
8051,339854
+(defrec state-varsstate-vars
8054,339954
+(defmacro default-state-varsdefault-state-vars
8064,340202
+(defun warning1-body (ctx summary str alist state)warning1-body
8118,342620
+(defmacro warning1-form (commentp)warning1-form
8134,343130
+(defun warning1 (ctx summary str alist state)warning1
8168,344258
+(defmacro warning$ (&rest args)warning$
8175,344461
+(defmacro warning-disabled-p (summary)warning-disabled-p
8203,345597
+(defmacro observation1-body (commentp)observation1-body
8215,345980
+(defun observation1 (ctx str alist abbrev-p state)observation1
8240,347143
+(defun observation1-cw (ctx str alist abbrev-p)observation1-cw
8248,347348
+(defmacro observation (&rest args)observation
8251,347422
+(defmacro observation-cw (&rest args)observation-cw
8339,351083
+(defun skip-when-logic (str state)skip-when-logic
8369,352178
+(defun chk-inhibit-output-lst (lst ctx state)chk-inhibit-output-lst
8377,352427
+(defconst *ld-special-error**ld-special-error*
8410,354024
+(defun chk-ld-skip-proofsp (val ctx state)chk-ld-skip-proofsp
8414,354138
+(defun set-ld-skip-proofsp (val state)set-ld-skip-proofsp
8424,354469
+(defmacro set-ld-skip-proofs (val state)set-ld-skip-proofs
8432,354688
+(defun set-write-acl2x (val state)set-write-acl2x
8441,354983
+(defconst *check-sum-exclusive-maximum* 268435399*check-sum-exclusive-maximum*
8663,367226
+(defconst *check-length-exclusive-maximum* 2097143*check-length-exclusive-maximum*
8667,367377
+(defconst *-check-sum-exclusive-maximum* (- *check-sum-exclusive-maximum*))*-check-sum-exclusive-maximum*
8675,367649
+(defconst *1-check-length-exclusive-maximum**1-check-length-exclusive-maximum*
8677,367726
+(defun ascii-code! (x)ascii-code!
8680,367813
+(defun check-sum1 (sum len channel state)check-sum1
8689,367959
+(defun check-sum (channel state)check-sum
8715,369313
+(defun check-sum-inc (n state)check-sum-inc
8781,372871
+(defun check-sum-natural (n state)check-sum-natural
8812,374348
+(defun check-sum-string1 (str i len state)check-sum-string1
8819,374640
+(defun check-sum-string2 (str i len state)check-sum-string2
8837,375394
+(defun check-sum-string (str state)check-sum-string
8859,376283
+(defun check-sum-obj1 (obj state)check-sum-obj1
8865,376532
+(defun old-check-sum-obj (obj state)old-check-sum-obj
8906,378431
+(defun plus-mod-m31 (u v)plus-mod-m31
8977,382276
+(defun double-mod-m31 (x)double-mod-m31
9011,383797
+(defun times-expt-2-16-mod-m31 (x)times-expt-2-16-mod-m31
9026,384299
+(defun times-mod-m31 (u v)times-mod-m31
9072,386299
+(defun fchecksum-natural-aux (n ans)fchecksum-natural-aux
9142,389306
+(defun fchecksum-natural (n)fchecksum-natural
9193,391281
+(defun fchecksum-string1 (str i len ans)fchecksum-string1
9198,391411
+(defun fchecksum-string2 (str i len ans)fchecksum-string2
9256,393830
+(defun fchecksum-string (str)fchecksum-string
9300,395590
+(defvar *fchecksum-symbol-memo**fchecksum-symbol-memo*
9325,396569
+(defun fchecksum-atom (x)fchecksum-atom
9328,396609
+(defun fchecksum-obj (x)fchecksum-obj
9400,399815
+(defun check-sum-obj (obj)check-sum-obj
9435,401340
+(defun read-file-iterate (channel acc state)read-file-iterate
9570,405988
+(defun read-file (name state)read-file
9577,406210
+(defun formals (fn w)formals
9587,406576
+(defun arity (fn w)arity
9600,407082
+(defun stobjs-out (fn w)stobjs-out
9606,407306
+(deflabel user-defined-functions-tableuser-defined-functions-table
9623,407850
+(defconst *user-defined-functions-table-keys**user-defined-functions-table-keys*
9701,411168
+(defrec def-bodydef-body
9718,411817
+(defun latest-body (fncall hyp concl)latest-body
9732,412156
+(defun def-body (fn wrld)def-body
9738,412297
+(defun body (fn normalp w)body
9741,412387
+(defun symbol-class (sym wrld)symbol-class
9769,413921
+(defmacro fdefun-mode (fn wrld)fdefun-mode
9822,416811
+(defmacro programp (fn wrld)programp
9830,416977
+(defmacro logicalp (fn wrld)logicalp
9833,417050
+(defun program-termp (term wrld)program-termp
9838,417148
+(defun program-term-listp (lst wrld)program-term-listp
9847,417493
+(defdoc common-lispcommon-lisp
9853,417659
+(deflabel defun-mode-caveatdefun-mode-caveat
9890,419631
+(deflabel generalized-booleansgeneralized-booleans
9988,424257
+(defun defun-mode (name wrld)defun-mode
10094,428096
+(defun get-stobj-recognizer (stobj wrld)get-stobj-recognizer
10244,435187
+(defun stobj-recognizer-terms (known-stobjs wrld)stobj-recognizer-terms
10255,435624
+(defun mcons-term-smart (fn args)mcons-term-smart
10265,436050
+(defun optimize-stobj-recognizers1 (known-stobjs recog-terms term)optimize-stobj-recognizers1
10278,436378
+(defun optimize-stobj-recognizers1-lst (known-stobjs recog-terms lst)optimize-stobj-recognizers1-lst
10322,438275
+(defun optimize-stobj-recognizers (known-stobjs term wrld)optimize-stobj-recognizers
10330,438627
+(defun guard (fn stobj-optp w)guard
10355,439761
+(defdoc extra-infoextra-info
10418,442527
+(defdoc guard-debugguard-debug
10426,442771
+(deflabel guard-quick-referenceguard-quick-reference
10520,447292
+(deflabel guard-introductionguard-introduction
10596,450158
+(deflabel guards-and-evaluationguards-and-evaluation
10644,452542
+(deflabel guards-for-specificationguards-for-specification
11018,469430
+(deflabel guard-miscellanyguard-miscellany
11075,471793
+(deflabel guard-evaluation-examples-scriptguard-evaluation-examples-script
11153,476189
+(deflabel guard-evaluation-examples-logguard-evaluation-examples-log
11316,481671
+(deflabel guard-evaluation-tableguard-evaluation-table
12043,501463
+(defun guard-lst (fns stobj-optp w)guard-lst
12157,507491
+(defmacro equivalence-relationp (fn w)equivalence-relationp
12162,507657
+(defun >=-len (x n)>=-len
12187,508654
+(defun all->=-len (lst n)all->=-len
12195,508822
+(defun strip-cadrs (x)strip-cadrs
12202,509011
+(defun strip-cddrs (x)strip-cddrs
12209,509211
+(defun global-set-lst (alist wrld)global-set-lst
12214,509355
+(defmacro cons-term1-body-mv2 ()cons-term1-body-mv2
12221,509612
+(defun cons-term1-mv2 (fn args form)cons-term1-mv2
12231,509951
+(defun sublis-var1 (alist form)sublis-var1
12238,510140
+(defun sublis-var1-lst (alist l)sublis-var1-lst
12258,511006
+(defun sublis-var (alist form)sublis-var
12273,511613
+(defun sublis-var-lst (alist l)sublis-var-lst
12299,512689
+(defun subcor-var1 (vars terms var)subcor-var1
12308,513013
+(defun subcor-var (vars terms form)subcor-var
12319,513414
+(defun subcor-var-lst (vars terms forms)subcor-var-lst
12335,514093
+(defun car-cdr-nest1 (term ad-lst n)car-cdr-nest1
12349,514625
+(defun car-cdr-nest (term)car-cdr-nest
12363,515133
+(defun collect-non-trivial-bindings (vars vals)collect-non-trivial-bindings
12386,515838
+(defun untranslate-and (p q iff-flg)untranslate-and
12393,516132
+(defun untranslate-or (p q)untranslate-or
12409,516572
+(defun case-length (key term)case-length
12419,516829
+(defun cond-length (term)cond-length
12453,518174
+(defconst *untranslate-boolean-primitives**untranslate-boolean-primitives*
12461,518408
+(defun right-associated-args (fn term)right-associated-args
12464,518464
+(defun dumb-negate-lit (term)dumb-negate-lit
12478,518976
+(defun dumb-negate-lit-lst (lst)dumb-negate-lit-lst
12495,519541
+(defun term-stobjs-out-alist (vars args alist wrld)term-stobjs-out-alist
12502,519717
+(defun term-stobjs-out (term alist wrld)term-stobjs-out
12511,520014
+(defun accessor-root (n term wrld)accessor-root
12554,521622
+(defvar *load-compiled-stack* nil)*load-compiled-stack*
12591,523466
+(defun observe-raw-mode-setting (v state)observe-raw-mode-setting
12594,523519
+(defmacro progn! (&rest r)progn!
12675,527630
+(defmacro progn! (&rest r)progn!
12804,533688
+(defun ld-redefinition-action (state)ld-redefinition-action
12844,535708
+(deflabel redefining-programsredefining-programs
13013,545338
+(defun chk-ld-redefinition-action (val ctx state)chk-ld-redefinition-action
13142,552031
+(defun set-ld-redefinition-action (val state)set-ld-redefinition-action
13150,552372
+(defmacro redef nilredef
13157,552584
+(defmacro redef! nilredef!
13176,553167
+(defmacro redef+ nilredef+
13195,553751
+(defmacro redef- nilredef-
13243,555476
+(defun chk-current-package (val ctx state)chk-current-package
13277,556495
+(defun set-current-package (val state)set-current-package
13282,556702
+(defun standard-oi (state)standard-oi
13293,556977
+(defun read-standard-oi (state)read-standard-oi
13319,558196
+(defun chk-standard-oi (val ctx state)chk-standard-oi
13332,558684
+(defun set-standard-oi (val state)set-standard-oi
13345,559058
+(defun standard-co (state)standard-co
13351,559250
+(defun chk-standard-co (val ctx state)chk-standard-co
13373,560196
+(defun set-standard-co (val state)set-standard-co
13380,560398
+(defun proofs-co (state)proofs-co
13387,560566
+(defun chk-proofs-co (val ctx state)chk-proofs-co
13405,561193
+(defun set-proofs-co (val state)set-proofs-co
13412,561391
+(deflabel promptprompt
13419,561551
+(defun ld-prompt (state)ld-prompt
13440,562440
+(defun chk-ld-prompt (val ctx state)chk-ld-prompt
13483,564518
+(defun set-ld-prompt (val state)set-ld-prompt
13494,564934
+(defun ld-keyword-aliases (state)ld-keyword-aliases
13501,565094
+(defun ld-keyword-aliasesp (key val wrld)ld-keyword-aliasesp
13581,568829
+(defmacro add-ld-keyword-alias! (key val)add-ld-keyword-alias!
13608,569712
+(defmacro add-ld-keyword-alias! (key val)add-ld-keyword-alias!
13615,569957
+(defmacro add-ld-keyword-alias (key val)add-ld-keyword-alias
13619,570036
+(defmacro set-ld-keyword-aliases! (alist)set-ld-keyword-aliases!
13623,570141
+(defmacro set-ld-keyword-aliases! (alist)set-ld-keyword-aliases!
13630,570395
+(defmacro set-ld-keyword-aliases (alist &optional state)set-ld-keyword-aliases
13634,570472
+(defun ld-missing-input-ok (state)ld-missing-input-ok
13642,570730
+(defun msgp (x)msgp
13664,571669
+(defun chk-ld-missing-input-ok (val ctx state)chk-ld-missing-input-ok
13670,571791
+(defun set-ld-missing-input-ok (val state)set-ld-missing-input-ok
13677,572043
+(defun ld-pre-eval-filter (state)ld-pre-eval-filter
13684,572243
+(defun new-namep (name wrld)new-namep
13714,573685
+(defun chk-ld-pre-eval-filter (val ctx state)chk-ld-pre-eval-filter
13807,577481
+(defun set-ld-pre-eval-filter (val state)set-ld-pre-eval-filter
13817,577895
+(defun ld-pre-eval-print (state)ld-pre-eval-print
13824,578091
+(defun chk-ld-pre-eval-print (val ctx state)chk-ld-pre-eval-print
13860,579960
+(defun set-ld-pre-eval-print (val state)set-ld-pre-eval-print
13865,580139
+(defun ld-post-eval-print (state)ld-post-eval-print
13872,580331
+(defun chk-ld-post-eval-print (val ctx state)chk-ld-post-eval-print
13934,583964
+(defun set-ld-post-eval-print (val state)set-ld-post-eval-print
13939,584159
+(defun ld-error-triples (state)ld-error-triples
13946,584355
+(defun chk-ld-error-triples (val ctx state)chk-ld-error-triples
13971,585517
+(defun set-ld-error-triples (val state)set-ld-error-triples
13976,585687
+(defun ld-error-action (state)ld-error-action
13983,585875
+(defun chk-ld-error-action (val ctx state)chk-ld-error-action
14098,592162
+(defun set-ld-error-action (val state)set-ld-error-action
14103,592358
+(defun ld-query-control-alist (state)ld-query-control-alist
14110,592542
+(defun ld-query-control-alistp (val)ld-query-control-alistp
14168,595785
+(defun cdr-assoc-query-id (id alist)cdr-assoc-query-id
14182,596275
+(defun chk-ld-query-control-alist (val ctx state)chk-ld-query-control-alist
14187,596436
+(defun set-ld-query-control-alist (val state)set-ld-query-control-alist
14193,596616
+(defun ld-verbose (state)ld-verbose
14200,596828
+(defun chk-ld-verbose (val ctx state)chk-ld-verbose
14231,598267
+(defun set-ld-verbose (val state)set-ld-verbose
14240,598544
+(defconst *nqthm-to-acl2-primitives**nqthm-to-acl2-primitives*
14247,598708
+(defconst *nqthm-to-acl2-commands**nqthm-to-acl2-commands*
14315,600676
+(defun nqthm-to-acl2-fn (name state)nqthm-to-acl2-fn
14407,604376
+(defmacro nqthm-to-acl2 (x)nqthm-to-acl2
14526,608911
+(defun allocate-fixnum-range (fixnum-lo fixnum-hi)allocate-fixnum-range
14734,616969
+(defmacro allegro-allocate-slowly (&key (free-bytes-new-other '1024)allegro-allocate-slowly
14793,619795
+(defun allegro-allocate-slowly-fn (free-bytes-new-otherallegro-allocate-slowly-fn
14802,620354
+(defmacro clear-pstk ()clear-pstk
14839,621971
+(defconst *pstk-vars**pstk-vars*
14846,622151
+(defun pstk-bindings-and-args (args vars)pstk-bindings-and-args
14861,622374
+(defmacro pstk (form)pstk
14893,623455
+(defun pstack-fn (allp state)pstack-fn
14941,625291
+(defmacro pstack (&optional allp)pstack
14964,626150
+(defun verbose-pstack (flg-or-list)verbose-pstack
15033,628589
+(defun pop-inhibit-output-lst-stack (state)pop-inhibit-output-lst-stack
15066,629838
+(defun push-inhibit-output-lst-stack (state)push-inhibit-output-lst-stack
15076,630269
+(defun set-gc-threshold$-fn (new-threshold verbose-p)set-gc-threshold$-fn
15082,630514
+(defmacro set-gc-threshold$ (new-threshold &optional (verbose-p 't))set-gc-threshold$
15150,633472
+
+parallel.lisp,4019
+(defdoc deflockdeflock
49,1910
+(defdoc compiling-acl2pcompiling-acl2p
133,5099
+(defdoc parallelparallel
172,6442
+(defdoc parallelism-buildparallelism-build
182,6596
+(defun set-parallel-execution-fn (val ctx state)set-parallel-execution-fn
190,6749
+(defmacro set-parallel-execution (value)set-parallel-execution
231,8769
+(defdoc parallel-executionparallel-execution
291,11345
+(defun waterfall-printing-value-for-parallelism-value (value)waterfall-printing-value-for-parallelism-value
301,11627
+(defdoc unsupported-waterfall-parallelism-featuresunsupported-waterfall-parallelism-features
335,13125
+(defdoc unsupported-parallelism-featuresunsupported-parallelism-features
492,21395
+(defdoc waterfall-printingwaterfall-printing
534,23391
+(defdoc waterfall-parallelismwaterfall-parallelism
542,23565
+(defun print-set-waterfall-parallelism-notice (val print-val state)print-set-waterfall-parallelism-notice
550,23738
+(defun check-for-no-override-hints (ctx state)check-for-no-override-hints
586,25276
+(defun set-waterfall-parallelism-fn (val ctx state)set-waterfall-parallelism-fn
616,26726
+(defmacro set-waterfall-parallelism1 (val)set-waterfall-parallelism1
706,31141
+(defmacro save-memo-table ()save-memo-table
735,32355
+(defun clear-memo-table-events (alist acc)clear-memo-table-events
743,32539
+(defmacro clear-memo-table ()clear-memo-table
751,32808
+(defmacro save-and-clear-memoization-settings ()save-and-clear-memoization-settings
759,33029
+(defun set-memo-table-events (alist acc)set-memo-table-events
785,33703
+(defmacro restore-memoization-settings ()restore-memoization-settings
793,33979
+(defmacro set-waterfall-parallelism (val)set-waterfall-parallelism
819,34577
+(defdoc waterfall-parallelism-for-book-certificationwaterfall-parallelism-for-book-certification
970,41910
+(defun set-waterfall-printing-fn (val ctx state)set-waterfall-printing-fn
1001,43191
+(defmacro set-waterfall-printing (val)set-waterfall-printing
1023,44114
+(defun set-waterfall-parallelism-hacks-enabled-guard (wrld)set-waterfall-parallelism-hacks-enabled-guard
1099,47512
+(defmacro set-waterfall-parallelism-hacks-enabled (val)set-waterfall-parallelism-hacks-enabled
1110,47976
+(defmacro set-waterfall-parallelism-hacks-enabled! (val)set-waterfall-parallelism-hacks-enabled!
1148,49563
+(defdoc parallelism-at-the-top-levelparallelism-at-the-top-level
1168,50190
+(defdoc parallelism-tutorialparallelism-tutorial
1223,52539
+(defdoc granularitygranularity
1507,63922
+(defdoc parallelism-performanceparallelism-performance
1615,68363
+(defdoc early-terminationearly-termination
1652,70135
+(defdoc parallel-pushing-of-subgoals-for-inductionparallel-pushing-of-subgoals-for-induction
1702,72336
+(defun caar-is-declarep (x)caar-is-declarep
1744,74768
+(defun declare-granularity-p (x)declare-granularity-p
1753,74979
+(defun check-and-parse-for-granularity-form (x)check-and-parse-for-granularity-form
1766,75357
+(defmacro pargs (&rest forms)pargs
1803,77045
+(defmacro plet (&rest forms)plet
1858,79471
+(defun binary-pand (x y)binary-pand
1908,81361
+(defmacro pand (&rest forms)pand
1916,81509
+(defun binary-por (x y)binary-por
2010,85305
+(defmacro por (&rest forms)por
2018,85461
+(defun or-list (x)or-list
2083,87981
+(defun and-list (x)and-list
2091,88136
+(defun cpu-core-count (state)cpu-core-count
2098,88283
+(defmacro spec-mv-let (bindings computation body)spec-mv-let
2324,98021
+(defdoc error-triples-and-parallelismerror-triples-and-parallelism
2448,103112
+(defdoc with-output-lockwith-output-lock
2498,105651
+(defdoc acl2p-key-checkpointsacl2p-key-checkpoints
2600,108604
+(defun set-total-parallelism-work-limit-fn (val state)set-total-parallelism-work-limit-fn
2715,113681
+(defmacro set-total-parallelism-work-limit (val)set-total-parallelism-work-limit
2720,113889
+(defun set-total-parallelism-work-limit-error-fn (val state)set-total-parallelism-work-limit-error-fn
2776,116331
+(defmacro set-total-parallelism-work-limit-error (val)set-total-parallelism-work-limit-error
2781,116543
+
+translate.lisp,19625
+(deflabel syntaxsyntax
23,881
+(deflabel termterm
41,1351
+(defun termp (x w)termp
228,11066
+(defun term-listp (x w)term-listp
254,11935
+(defun computed-hint-tuple-listp (x wrld)computed-hint-tuple-listp
261,12065
+(defun macro-args (x w)macro-args
281,12620
+(defconst *macro-expansion-ctx* "macro expansion")*macro-expansion-ctx*
384,15627
+(defun error-trace-suggestion (two-leading-spaces)error-trace-suggestion
386,15679
+(defun ignored-attachment-msg (ignored-attachment)ignored-attachment-msg
397,16030
+(defdoc ignored-attachmentignored-attachment
405,16439
+(defun ev-fncall-null-body-er-msg (ignored-attachment fn args)ev-fncall-null-body-er-msg
518,20496
+(defun ev-fncall-null-body-er (ignored-attachment fn args latches)ev-fncall-null-body-er
539,21266
+(defun ev-fncall-creator-er-msg (fn)ev-fncall-creator-er-msg
544,21420
+(defun unknown-pkg-error-msg (fn pkg-name)unknown-pkg-error-msg
556,22021
+(defun illegal-msg ()illegal-msg
562,22208
+(defun program-only-er-msg (fn args safe-mode)program-only-er-msg
566,22299
+(defconst *safe-mode-guard-er-addendum**safe-mode-guard-er-addendum*
578,22906
+(defun find-first-non-nil (lst)find-first-non-nil
583,23150
+(defun latch-stobjs1 (stobjs-out vals latches)latch-stobjs1
590,23348
+(defun latch-stobjs (stobjs-out vals latches)latch-stobjs
643,25893
+(defvar *raw-guard-warningp*)*raw-guard-warningp*
668,27122
+(defun actual-stobjs-out1 (stobjs-in args user-stobj-alist)actual-stobjs-out1
670,27153
+(defun apply-symbol-alist (alist lst acc)apply-symbol-alist
686,27960
+(defun apply-inverse-symbol-alist (alist lst acc)apply-inverse-symbol-alist
700,28583
+(defun actual-stobjs-out (fn args wrld user-stobj-alist)actual-stobjs-out
715,29120
+(defun raw-ev-fncall (fn args latches w user-stobj-alistraw-ev-fncall
726,29600
+(defun translated-acl2-unwind-protectp4 (term)translated-acl2-unwind-protectp4
822,34182
+(defun translated-acl2-unwind-protectp (term)translated-acl2-unwind-protectp
897,37781
+(defun stobjp (x known-stobjs w)stobjp
908,38185
+(defun acl2-system-namep (name wrld)acl2-system-namep
1254,53562
+(defparameter *ev-shortcut-okp**ev-shortcut-okp*
1327,55827
+(defun w-of-any-state (st)w-of-any-state
1342,56491
+(defun untranslate-preprocess-fn (wrld)untranslate-preprocess-fn
1355,57054
+(defmacro untranslate* (term iff-flg wrld)untranslate*
1361,57319
+(defmacro raw-guard-warningp-binding ()raw-guard-warningp-binding
1377,57972
+(defun untouchable-fn-p (fn w)untouchable-fn-p
1405,59492
+(defun save-ev-fncall-guard-er (fn guard stobjs-in args)save-ev-fncall-guard-er
1409,59659
+(defrec attachmentattachment
1418,59967
+(defrec attachment-componentattachment-component
1425,60085
+(defun attachment-record-pairs (records acc)attachment-record-pairs
1432,60202
+(defun all-attachments (wrld)all-attachments
1440,60438
+(defun gc-off1 (guard-checking-on)gc-off1
1444,60567
+(defun gc-off (state)gc-off
1448,60662
+(defun return-last-lookup (sym wrld)return-last-lookup
1465,61157
+(defun make-let-or-let* (bindings body)make-let-or-let*
1480,61630
+(defmacro untranslate*-lst (lst iff-flg wrld)untranslate*-lst
1494,62106
+(defun apply-user-stobj-alist-or-kwote (user-stobj-alist lst acc)apply-user-stobj-alist-or-kwote
1505,62400
+(defun ev-fncall-rec-logical (fn args w user-stobj-alist big-n safe-mode gc-offev-fncall-rec-logical
1544,64230
+(defun ev-fncall-rec (fn args w user-stobj-alist big-n safe-mode gc-off latchesev-fncall-rec
1869,77452
+(defun ev-rec-return-last (fn arg2 arg3 alist w user-stobj-alist big-nev-rec-return-last
1916,79319
+(defun ev-rec (form alist w user-stobj-alist big-n safe-mode gc-off latchesev-rec
2016,84242
+(defun ev-rec-lst (lst alist w user-stobj-alist big-n safe-mode gc-off latchesev-rec-lst
2202,93566
+(defun ev-rec-acl2-unwind-protect (form alist w user-stobj-alist big-nev-rec-acl2-unwind-protect
2235,95036
+(defun ev-fncall-w (fn args w user-stobj-alist safe-mode gc-offev-fncall-w
2456,105118
+(defun ev-fncall-guard-er-msg (fn guard stobjs-in args w user-stobj-alist extra)ev-fncall-guard-er-msg
2524,107694
+(defun ev-fncall-guard-er (fn args w user-stobj-alist latches extra)ev-fncall-guard-er
2580,110120
+(defun ev-fncall-msg (val wrld user-stobj-alist)ev-fncall-msg
2591,110521
+(defun untranslate1 (term iff-flg untrans-tbl preprocess-fn wrld)untranslate1
2642,112353
+(defun untranslate-cons1 (term untrans-tbl preprocess-fn wrld)untranslate-cons1
2871,124505
+(defun untranslate-cons (term untrans-tbl preprocess-fn wrld)untranslate-cons
2891,125507
+(defun untranslate-if (term iff-flg untrans-tbl preprocess-fn wrld)untranslate-if
2902,125952
+(defun untranslate-into-case-clauses (key term iff-flg untrans-tbl preprocess-fnuntranslate-into-case-clauses
2921,126915
+(defun untranslate-into-cond-clauses (term iff-flg untrans-tbl preprocess-fnuntranslate-into-cond-clauses
2963,129236
+(defun untranslate1-lst (lst iff-flg untrans-tbl preprocess-fn wrld)untranslate1-lst
2978,129977
+(defun ev-fncall (fn args state latches hard-error-returns-nilp aok)ev-fncall
2989,130410
+(defun ev (form alist state latches hard-error-returns-nilp aok)ev
3002,130989
+(defun ev-lst (lst alist state latches hard-error-returns-nilp aok)ev-lst
3036,132293
+(defun untranslate (term iff-flg wrld)untranslate
3054,133033
+(defun untranslate-lst (lst iff-flg wrld)untranslate-lst
3081,134112
+(defun ev-w (form alist w user-stobj-alist safe-mode gc-offev-w
3119,135670
+(defun ev-w-lst (lst alist w user-stobj-alist safe-mode gc-offev-w-lst
3180,138215
+(defun silent-error (state)silent-error
3306,144400
+(defmacro cmp-to-error-triple (form)cmp-to-error-triple
3309,144449
+(defmacro cmp-to-error-triple@par (form)cmp-to-error-triple@par
3325,145007
+(defmacro cmp-to-error-double (form)cmp-to-error-double
3341,145590
+(defmacro cmp-and-value-to-error-quadruple (form)cmp-and-value-to-error-quadruple
3357,146221
+(defmacro cmp-and-value-to-error-quadruple@par (form)cmp-and-value-to-error-quadruple@par
3379,147135
+(defun er-cmp-fn (ctx msg)er-cmp-fn
3399,147968
+(defmacro er-cmp (ctx str &rest args)er-cmp
3407,148148
+(defmacro value-cmp (x)value-cmp
3414,148333
+(defun er-progn-fn-cmp (lst)er-progn-fn-cmp
3417,148374
+(defmacro er-progn-cmp (&rest lst)er-progn-cmp
3439,149332
+(defmacro er-let*-cmp (alist body)er-let*-cmp
3444,149477
+(defun warning1-cw (ctx summary str alist wrld state-vars)warning1-cw
3469,150434
+(defmacro warning$-cw1 (&rest args)warning$-cw1
3476,150638
+(defmacro warning$-cw (ctx &rest args)warning$-cw
3501,151460
+(defun chk-length-and-keys (actuals form wrld)chk-length-and-keys
3514,152006
+(defun bind-macro-args-keys1 (args actuals allow-flg alist form wrldbind-macro-args-keys1
3534,152854
+(defun bind-macro-args-keys (args actuals alist form wrld state-vars)bind-macro-args-keys
3593,155712
+(defun bind-macro-args-after-rest (args actuals alist form wrld state-vars)bind-macro-args-after-rest
3611,156429
+(defun bind-macro-args-optional (args actuals alist form wrld state-vars)bind-macro-args-optional
3621,156826
+(defun bind-macro-args1 (args actuals alist form wrld state-vars)bind-macro-args1
3656,158336
+(defun bind-macro-args (args form wrld state-vars)bind-macro-args
3682,159465
+(defun macroexpand1-cmp (x ctx wrld state-vars)macroexpand1-cmp
3690,159815
+(defun macroexpand1 (x ctx state)macroexpand1
3749,162403
+(defun chk-declare (form ctx)chk-declare
3753,162562
+(defun collect-dcls (l ctx)collect-dcls
3773,163517
+(defun acceptable-dcls-alist (state-vars)acceptable-dcls-alist
3784,163898
+(defconst *documentation-strings-permitted**documentation-strings-permitted*
3813,165111
+(defconst *dcl-explanation-alist**dcl-explanation-alist*
3819,165262
+(defun tilde-*-conjunction-phrase1 (syms alist)tilde-*-conjunction-phrase1
3829,165784
+(defun tilde-*-conjunction-phrase (syms alist)tilde-*-conjunction-phrase
3840,166262
+(defun collect-non-legal-variableps (lst)collect-non-legal-variableps
3857,166915
+(defun optimize-alistp (lst)optimize-alistp
3863,167143
+(defun chk-dcl-lst (l vars binder ctx wrld state-vars)chk-dcl-lst
3876,167564
+(defun number-of-strings (l)number-of-strings
4054,177039
+(defun remove-strings (l)remove-strings
4060,177202
+(defun get-string (l)get-string
4066,177368
+(defun collect-declarations-cmp (lst vars binder ctx wrld state-vars)collect-declarations-cmp
4071,177492
+(defun collect-declarations (lst vars binder state ctx)collect-declarations
4111,179484
+(defun listify (l)listify
4116,179744
+(defun translate-declaration-to-guard-var-lst (x var-lst wrld)translate-declaration-to-guard-var-lst
4120,179842
+(defun translate-dcl-lst (edcls wrld)translate-dcl-lst
4134,180505
+(defun dcl-guardian (term-lst)dcl-guardian
4148,181101
+(defun ignore-vars (dcls)ignore-vars
4181,182638
+(defun ignorable-vars (dcls)ignorable-vars
4187,182821
+(defun mv-nth-list (var i maximum)mv-nth-list
4193,183016
+(defabbrev translate-bind (x val bindings)translate-bind
4198,183193
+(defun translate-deref (x bindings)translate-deref
4204,183328
+(defun translate-unbound (x bindings)translate-unbound
4220,183894
+(defun listlis (l1 l2)listlis
4228,184098
+(defun find-first-var (term)find-first-var
4238,184305
+(defun find-first-var-lst (lst)find-first-var-lst
4246,184543
+(defun find-first-fnsymb (term)find-first-fnsymb
4254,184714
+(defun find-first-fnsymb-lst (lst)find-first-fnsymb-lst
4262,184988
+(defun find-pkg-witness (term)find-pkg-witness
4268,185149
+(defmacro trans-er (&rest args)trans-er
4287,185865
+(defmacro trans-er+ (form ctx str &rest args)trans-er+
4303,186600
+(defmacro trans-er+? (cform x ctx str &rest args)trans-er+?
4322,187370
+(defmacro trans-value (x &optional (bindings 'bindings))trans-value
4338,188024
+(defmacro trans-er-let* (alist body)trans-er-let*
4344,188171
+(defun hide-ignored-actuals (ignore-vars bound-vars value-forms)hide-ignored-actuals
4367,189008
+(defun augment-ignore-vars (bound-vars value-forms acc)augment-ignore-vars
4393,189977
+(defun compute-stobj-flags (lst known-stobjs w)compute-stobj-flags
4501,195792
+(defun prettyify-stobj-flags (lst)prettyify-stobj-flags
4514,196285
+(defun unprettyify-stobj-flags (lst)unprettyify-stobj-flags
4523,196571
+(defun prettyify-stobjs-out (stobjs-out)prettyify-stobjs-out
4528,196745
+(defun defstobj-supporterp (name wrld)defstobj-supporterp
4537,197041
+(defun stobj-creatorp (name wrld)stobj-creatorp
4553,197754
+(defun defstobj-fnname (root key1 key2 renaming-alist)defstobj-fnname
4565,198172
+(defun parse-with-local-stobj (x)parse-with-local-stobj
4624,200785
+(defun ffnnamep (fn term)ffnnamep
4644,201292
+(defun ffnnamep-lst (fn l)ffnnamep-lst
4658,201745
+(defconst *synp-trans-err-string**synp-trans-err-string*
4668,201966
+(defconst *ttag-fns-and-macros**ttag-fns-and-macros*
4674,202314
+(defun unknown-binding-msg (stobjs-bound str1 str2 str3)unknown-binding-msg
4696,202993
+(defconst *oneify-primitives**oneify-primitives*
4714,204135
+(defconst *macros-for-nonexpansion-in-raw-lisp**macros-for-nonexpansion-in-raw-lisp*
4760,205908
+(defun chk-no-duplicate-defuns-cmp (lst ctx)chk-no-duplicate-defuns-cmp
4820,208214
+(defun chk-no-duplicate-defuns (lst ctx state)chk-no-duplicate-defuns
4830,208634
+(defun chk-state-ok-msg (wrld)chk-state-ok-msg
4833,208745
+(defun chk-state-ok (ctx wrld state)chk-state-ok
4848,209371
+(defun chk-arglist-msg (args chk-state wrld)chk-arglist-msg
4853,209517
+(defun msg-to-cmp (ctx msg)msg-to-cmp
4870,210251
+(defun chk-arglist-cmp (args chk-state ctx wrld)chk-arglist-cmp
4879,210492
+(defun@par chk-arglist (args chk-state ctx wrld state)chk-arglist
4882,210600
+(defun logical-name-type (name wrld quietp)logical-name-type
4887,210786
+(defun chk-all-but-new-name-cmp (name ctx new-type w)chk-all-but-new-name-cmp
4912,211785
+(defun chk-all-but-new-name (name ctx new-type w state)chk-all-but-new-name
4943,213042
+(defun chk-defuns-tuples-cmp (lst local-p ctx wrld state-vars)chk-defuns-tuples-cmp
4946,213171
+(defun chk-defuns-tuples (lst local-p ctx wrld state)chk-defuns-tuples
4990,215049
+(defun non-trivial-encapsulate-ee-entries (embedded-event-lst)non-trivial-encapsulate-ee-entries
4994,215243
+(defconst *ec-call-bad-ops**ec-call-bad-ops*
5003,215651
+(defmacro return-last-call (fn &rest args)return-last-call
5013,216044
+(defmacro prog2$-call (x y)prog2$-call
5016,216131
+(defun name-dropper (lst)name-dropper
5019,216205
+(defun first-assoc-eq (keys alist)first-assoc-eq
5035,216920
+(defun context-for-encapsulate-pass-2 (wrld in-local-flg)context-for-encapsulate-pass-2
5043,217185
+(defconst *brr-globals**brr-globals*
5073,218600
+(defun unknown-binding-msg-er (x ctx stobjs-bound str1 str2 str3)unknown-binding-msg-er
5079,218694
+(defun congruent-stobj-rep (name wrld)congruent-stobj-rep
5099,219680
+(defun congruent-stobjsp (st1 st2 wrld)congruent-stobjsp
5105,219881
+(defun stobjs-in-out1 (stobjs-in args known-stobjs wrld alist new-stobjs-in)stobjs-in-out1
5109,219998
+(defun stobjs-in-matchp (stobjs-in args)stobjs-in-matchp
5134,221158
+(defun stobjs-in-out (fn args stobjs-out known-stobjs wrld)stobjs-in-out
5142,221421
+(defun non-trivial-stobj-binding (stobj-flags bindings)non-trivial-stobj-binding
5180,223211
+(defun formalized-varlistp (varlist formal-lst)formalized-varlistp
5192,223799
+(defun throw-nonexec-error-p1 (targ1 targ2 name formals)throw-nonexec-error-p1
5204,224280
+(defun throw-nonexec-error-p (body name formals)throw-nonexec-error-p
5224,225064
+(defun chk-flet-declarations (names decls declare-form ctx)chk-flet-declarations
5239,225779
+(defun chk-flet-declare-form (names declare-form ctx)chk-flet-declare-form
5265,227103
+(defun chk-flet-declare-form-list (names declare-form-list ctx)chk-flet-declare-form-list
5280,227704
+(defun translate-stobj-type-to-guard (x var wrld)translate-stobj-type-to-guard
5287,228003
+(defun get-stobj-creator (stobj wrld)get-stobj-creator
5322,229788
+(defun stobj-updater-guess-from-accessor (accessor)stobj-updater-guess-from-accessor
5360,231498
+(defun parse-stobj-let1 (bindings producer-vars bound-vars actuals stobjparse-stobj-let1
5381,232254
+(defun illegal-stobj-let-msg (msg form)illegal-stobj-let-msg
5473,236376
+(defun parse-stobj-let (x)parse-stobj-let
5477,236500
+(defun pairlis-x1 (x1 lst)pairlis-x1
5571,240606
+(defun pairlis-x2 (lst x2)pairlis-x2
5579,240794
+(defun no-duplicatesp-checks-for-stobj-let-actuals/alist (alist)no-duplicatesp-checks-for-stobj-let-actuals/alist
5587,240986
+(defun no-duplicatesp-checks-for-stobj-let-actuals (exprs alist)no-duplicatesp-checks-for-stobj-let-actuals
5601,241683
+(defun stobj-let-fn (x)stobj-let-fn
5625,242710
+(defun the-live-var (name)the-live-var
5659,244208
+(defun the-live-var-bindings (stobj-names)the-live-var-bindings
5678,245059
+(defun the-maybe-live-var-bindings (stobj-names)the-maybe-live-var-bindings
5684,245301
+(defun stobj-let-fn-raw (x)stobj-let-fn-raw
5694,245705
+(defun stobj-field-accessor-p (fn stobj wrld)stobj-field-accessor-p
5780,249171
+(defun chk-stobj-let/bindings (stobj bound-vars actuals wrld)chk-stobj-let/bindings
5802,249758
+(defun chk-stobj-let/updaters1 (updaters accessors lst)chk-stobj-let/updaters1
5840,251657
+(defun chk-stobj-let/updaters (updaters corresp-accessor-fns stobj wrld)chk-stobj-let/updaters
5870,253133
+(defun chk-stobj-let (bound-vars actuals stobj updaters corresp-accessor-fnschk-stobj-let
5877,253393
+(defun all-nils-or-x (x lst)all-nils-or-x
5899,254287
+(defun stobj-field-fn-of-stobj-type-p (fn wrld)stobj-field-fn-of-stobj-type-p
5908,254549
+(defun stobj-recognizer-p (fn wrld)stobj-recognizer-p
5920,255105
+(defmacro trans-or (form1 condition form2 extra-msg)trans-or
5929,255380
+(defun translate11-flet-alist (form fives stobjs-out bindings known-stobjstranslate11-flet-alist
5960,256723
+(defun translate11-flet-alist1 (form five stobjs-out bindings known-stobjstranslate11-flet-alist1
5974,257381
+(defun translate11-flet (x stobjs-out bindings known-stobjs flet-alisttranslate11-flet
6176,266964
+(defun translate-stobj-calls (calls len bindings known-stobjs flet-alisttranslate-stobj-calls
6244,269904
+(defun translate11-let (x tbody0 targs stobjs-out bindings known-stobjstranslate11-let
6280,271725
+(defun translate11-let* (x tbody targs stobjs-out bindings known-stobjstranslate11-let*
6486,282473
+(defun translate11-mv-let (x tbody0 stobjs-out bindings known-stobjstranslate11-mv-let
6511,283698
+(defun translate11-wormhole-eval (x y z bindings flet-alist ctx wrldtranslate11-wormhole-eval
6731,294808
+(defun translate11-call (form fn args stobjs-out stobjs-out2 bindingstranslate11-call
6826,299142
+(defun translate11 (x stobjs-out bindings known-stobjs flet-alisttranslate11
7012,308534
+(defun translate11-lst (lst stobjs-out bindings known-stobjstranslate11-lst
8196,367641
+(defun translate1-cmp (x stobjs-out bindings known-stobjs ctx w state-vars)translate1-cmp
8318,373932
+(defun@par translate1 (x stobjs-out bindings known-stobjs ctx w state)translate1
8383,377021
+(defun collect-programs (names wrld)collect-programs
8388,377238
+(defun all-fnnames1 (flg x acc)all-fnnames1
8420,378393
+(defmacro all-fnnames (term)all-fnnames
8439,379085
+(defmacro all-fnnames-lst (lst)all-fnnames-lst
8442,379148
+(defun translate-cmp (x stobjs-out logic-modep known-stobjs ctx w state-vars)translate-cmp
8445,379211
+(defun@par translate (x stobjs-out logic-modep known-stobjs ctx w state)translate
8470,380368
+(defun translatable-p (form stobjs-out bindings known-stobjs ctx wrld)translatable-p
8501,381836
+(defmacro chk-translatable (form shape)chk-translatable
8508,382127
+(defun replaced-stobj (name)replaced-stobj
8534,383381
+(defun replace-stobjs1 (stobjs-out val)replace-stobjs1
8540,383550
+(defun replace-stobjs (stobjs-out val)replace-stobjs
8548,383846
+(defun non-stobjps (vars known-stobjs w)non-stobjps
8589,385739
+(defun user-stobjsp (stobjs-out)user-stobjsp
8596,385990
+(defun put-assoc-eq-alist (alist1 alist2)put-assoc-eq-alist
8603,386194
+(defun-one-output chk-user-stobj-alist (stobjs alist acc ctx)chk-user-stobj-alist
8637,387915
+(defun user-stobj-alist-safe (ctx stobjs state)user-stobj-alist-safe
8662,389006
+(defun ev-for-trans-eval (trans vars stobjs-out ctx state aok)ev-for-trans-eval
8671,389280
+(defun ev-w-for-trans-eval (trans vars stobjs-out ctx state aok)ev-w-for-trans-eval
8723,391570
+(defun trans-eval (form ctx state aok)trans-eval
8759,392847
+(defun simple-translate-and-eval (x alist ok-stobj-names msg ctx wrld statesimple-translate-and-eval
8805,394717
+(defun error-fms-cw (hardp ctx str alist)error-fms-cw
8899,399341
+(defmacro error-fms@par (&rest args)error-fms@par
8916,400022
+(defun simple-translate-and-eval-cmp (x alist ok-stobj-names msg ctx wrld statesimple-translate-and-eval-cmp
8919,400086
+(defun simple-translate-and-eval-error-double (x alist ok-stobj-names msg ctxsimple-translate-and-eval-error-double
8981,403056
+(defun simple-translate-and-eval@par (x alist ok-stobj-names msg ctx wrld statesimple-translate-and-eval@par
9010,404340
+(defun tilde-*-alist-phrase1 (alist evisc-tuple level)tilde-*-alist-phrase1
9026,405172
+(defun tilde-*-alist-phrase (alist evisc-tuple level)tilde-*-alist-phrase
9032,405438
+(defun set-temp-touchable-fns (x state)set-temp-touchable-fns
9044,405733
+(defun set-temp-touchable-vars (x state)set-temp-touchable-vars
9061,406428
+(defun clear-temp-touchable-fns (state)clear-temp-touchable-fns
9078,407126
+(defun clear-temp-touchable-vars (state)clear-temp-touchable-vars
9081,407215
+(defun mapcar$ (fn l state)mapcar$
9097,407980
+(defun mapdo (fn l state)mapdo
9119,408884
+(defun always (fn l state)always
9132,409343
+(defun thereis (fn l state)thereis
9146,409760
+
+type-set-a.lisp,3571
+(defconst *ts-non-negative-integer* (ts-union0 *ts-zero**ts-non-negative-integer*
124,5901
+(defconst *ts-non-positive-integer* (ts-union0 *ts-zero**ts-non-positive-integer*
127,6030
+(defconst *ts-integer* (ts-union0 *ts-positive-integer**ts-integer*
130,6159
+(defconst *ts-rational* (ts-union0 *ts-integer**ts-rational*
134,6318
+(defconst *ts-real* (ts-union0 *ts-integer**ts-real*
141,6570
+(defconst *ts-complex* (ts-union0 *ts-complex-rational**ts-complex*
151,6940
+(defconst *ts-acl2-number**ts-acl2-number*
160,7355
+(defconst *ts-rational-acl2-number* (ts-union0 *ts-rational**ts-rational-acl2-number*
166,7525
+(defconst *ts-non-rational-acl2-number* (ts-union0 *ts-positive-non-ratio**ts-non-rational-acl2-number*
170,7683
+(defconst *ts-negative-rational* (ts-union0 *ts-negative-integer**ts-negative-rational*
174,7913
+(defconst *ts-positive-rational* (ts-union0 *ts-positive-integer**ts-positive-rational*
177,8046
+(defconst *ts-non-positive-rational* (ts-union0 *ts-zero**ts-non-positive-rational*
180,8179
+(defconst *ts-non-negative-rational* (ts-union0 *ts-zero**ts-non-negative-rational*
183,8311
+(defconst *ts-ratio* (ts-union0 *ts-positive-ratio**ts-ratio*
186,8443
+(defconst *ts-non-ratio* (ts-union0 *ts-positive-non-ratio**ts-non-ratio*
197,8772
+(defconst *ts-negative-real* (ts-union0 *ts-negative-integer**ts-negative-real*
200,8895
+(defconst *ts-positive-real* (ts-union0 *ts-positive-integer**ts-positive-real*
204,9084
+(defconst *ts-non-positive-real* (ts-union0 *ts-zero**ts-non-positive-real*
208,9273
+(defconst *ts-non-negative-real* (ts-union0 *ts-zero**ts-non-negative-real*
211,9393
+(defconst *ts-cons* (ts-union0 *ts-proper-cons**ts-cons*
215,9515
+(defconst *ts-boolean* (ts-union0 *ts-nil* *ts-t*))*ts-boolean*
218,9616
+(defconst *ts-true-list* (ts-union0 *ts-nil* *ts-proper-cons*))*ts-true-list*
220,9669
+(defconst *ts-non-nil* (ts-complement0 *ts-nil*))*ts-non-nil*
222,9734
+(defconst *ts-symbol* (ts-union0 *ts-nil**ts-symbol*
224,9785
+(defconst *ts-true-list-or-string* (ts-union0 *ts-true-list* *ts-string*))*ts-true-list-or-string*
228,9929
+(defconst *ts-empty* 0)*ts-empty*
230,10005
+(defconst *ts-unknown* -1)*ts-unknown*
232,10030
+(defun one-bit-type-setp (ts)one-bit-type-setp
240,10392
+(defconst *code-type-set-alist**code-type-set-alist*
278,12045
+(defun logior-lst (lst ans)logior-lst
362,15691
+(defun logand-lst (lst ans)logand-lst
368,15821
+(defun ts-complement-fn (x)ts-complement-fn
376,15970
+(defun ts-union-fn (x)ts-union-fn
382,16117
+(defun ts-intersection-fn (x)ts-intersection-fn
392,16425
+(defun eval-type-set (x)eval-type-set
402,16744
+(defun eval-type-set-lst (x)eval-type-set-lst
423,17560
+(defmacro ts-complement (x)ts-complement
436,17878
+(defmacro ts-intersection (&rest x)ts-intersection
439,17952
+(defmacro ts-union (&rest x)ts-union
442,18036
+(defmacro ts-subsetp (ts1 ts2)ts-subsetp
445,18106
+(defun type-set-binary-+-alist-entry (ts1 ts2)type-set-binary-+-alist-entry
460,18553
+(defun type-set-binary-+-alist1 (i j lst)type-set-binary-+-alist1
592,25217
+(defun type-set-binary-+-alist (i j lst)type-set-binary-+-alist
601,25623
+(defun type-set-binary-*-alist-entry (ts1 ts2)type-set-binary-*-alist-entry
609,25887
+(defun type-set-binary-*-alist1 (i j lst)type-set-binary-*-alist1
742,32974
+(defun type-set-binary-*-alist (i j lst)type-set-binary-*-alist
752,33433
+(defun type-set-<-alist-entry (ts1 ts2)type-set-<-alist-entry
760,33697
+(defun type-set-<-alist1 (i j lst)type-set-<-alist1
844,37738
+(defun type-set-<-alist (i j lst)type-set-<-alist
854,38117
+
+linear-a.lisp,9228
+(defabbrev ts-acl2-numberp (ts)ts-acl2-numberp
35,1338
+(defabbrev ts-rationalp (ts)ts-rationalp
38,1407
+(defabbrev ts-real/rationalp (ts)ts-real/rationalp
41,1470
+(defabbrev ts-integerp (ts)ts-integerp
47,1618
+(defun all-quoteps (lst)all-quoteps
50,1679
+(defun dumb-occur (x y)dumb-occur
57,1826
+(defun dumb-occur-lst (x lst)dumb-occur-lst
68,2143
+(defrec history-entryhistory-entry
84,2675
+(defun pt-occur (n pt)pt-occur
193,9106
+(defun pt-intersectp (pt1 pt2)pt-intersectp
201,9304
+(deflabel ttreettree
293,13656
+(defun tag-tree-occur (tag val ttree)tag-tree-occur
320,14942
+(defun remove-tag-from-tag-tree (tag ttree)remove-tag-from-tag-tree
328,15118
+(defun remove-tag-from-tag-tree! (tag ttree)remove-tag-from-tag-tree!
339,15416
+(defmacro extend-tag-tree (tag vals ttree)extend-tag-tree
354,15866
+(defun add-to-tag-tree (tag val ttree)add-to-tag-tree
362,16043
+(defun add-to-tag-tree! (tag val ttree)add-to-tag-tree!
381,16622
+(defconst *fake-rune-for-anonymous-enabled-rule**fake-rune-for-anonymous-enabled-rule*
404,17454
+(defabbrev push-lemma (rune ttree)push-lemma
407,17552
+(defun delete-assoc-eq-assoc-eq-1 (alist1 alist2)delete-assoc-eq-assoc-eq-1
431,18808
+(defun delete-assoc-eq-assoc-eq (alist1 alist2)delete-assoc-eq-assoc-eq
444,19349
+(defun cons-tag-trees1 (ttree1 ttree2 ttree3)cons-tag-trees1
450,19526
+(defun cons-tag-trees (ttree1 ttree2)cons-tag-trees
471,20536
+(defmacro tagged-objects (tag ttree)tagged-objects
493,21399
+(defmacro tagged-objectsp (tag ttree)tagged-objectsp
501,21558
+(defun tagged-object (tag ttree)tagged-object
511,21865
+(deflock *ttree-lock*)*ttree-lock*
537,23163
+(defun@par accumulate-ttree-and-step-limit-into-state (ttree step-limit state)accumulate-ttree-and-step-limit-into-state
539,23187
+(defun pts-to-ttree-lst (pts)pts-to-ttree-lst
582,25156
+(defun marry-parents (parents1 parents2)marry-parents
594,25695
+(defun collect-parents1 (pt ans)collect-parents1
606,26088
+(defun collect-parents0 (pts ans)collect-parents0
615,26319
+(defun collect-parents (ttree)collect-parents
622,26479
+(defun ignore-polyp (parents pt)ignore-polyp
631,26844
+(defun to-be-ignoredp1 (pts pt)to-be-ignoredp1
646,27492
+(defun to-be-ignoredp (ttree pt)to-be-ignoredp
651,27644
+(defrec assumnote (cl-id rune . target) t)assumnote
679,28813
+(defrec assumptionassumption
694,29746
+(defrec fc-derivationfc-derivation
755,33360
+(defun contains-assumptionp (ttree)contains-assumptionp
767,33715
+(defun contains-assumptionp-fc-derivations (lst)contains-assumptionp-fc-derivations
777,34074
+(defun remove-assumption-entries-from-type-alist (type-alist)remove-assumption-entries-from-type-alist
783,34296
+(defun force-assumption1force-assumption1
802,35012
+(defun dumb-occur-in-type-alist (var type-alist)dumb-occur-in-type-alist
832,36345
+(defun all-dumb-occur-in-type-alist (vars type-alist)all-dumb-occur-in-type-alist
841,36541
+(defun force-assumptionforce-assumption
848,36755
+(defun tag-tree-occur-assumption-nil-1 (lst)tag-tree-occur-assumption-nil-1
945,42074
+(defun tag-tree-occur-assumption-nil (ttree)tag-tree-occur-assumption-nil
952,42290
+(defun assumption-free-ttreep (ttree)assumption-free-ttreep
959,42535
+(defconst *impossible-assumption**impossible-assumption*
979,43381
+(deflabel linear-arithmeticlinear-arithmetic
1483,63384
+(defmacro fn-count-evg-max-val ()fn-count-evg-max-val
1590,68216
+(defmacro fn-count-evg-max-val-neg ()fn-count-evg-max-val-neg
1598,68462
+(defmacro fn-count-evg-max-calls ()fn-count-evg-max-calls
1601,68532
+(defun min-fixnum (x y)min-fixnum
1612,68842
+(defun fn-count-evg-rec (evg acc calls)fn-count-evg-rec
1620,69075
+(defmacro fn-count-evg (evg)fn-count-evg
1693,72318
+(defun var-fn-count-1 (flg x var-count-acc fn-count-acc p-fn-count-accvar-fn-count-1
1696,72380
+(defmacro var-fn-count (term invisible-fns-table)var-fn-count
1798,77743
+(defmacro var-or-fn-count-< (var-count1 var-count2 fn-count1 fn-count2var-or-fn-count-<
1804,77896
+(defun term-order1 (term1 term2 invisible-fns-table)term-order1
1831,79223
+(defun arith-term-order (term1 term2)arith-term-order
1902,83620
+(defrec polypoly
1916,83960
+(defabbrev first-var (p) (caar (access poly p :alist)))first-var
2046,90529
+(defabbrev first-coefficient (p) (cdar (access poly p :alist)))first-coefficient
2048,90586
+(defun good-coefficient (c)good-coefficient
2071,91644
+(defun good-pot-varp (x)good-pot-varp
2074,91694
+(defun good-polyp (p)good-polyp
2084,92074
+(defun logical-< (x y)logical-<
2094,92468
+(defun logical-<= (x y)logical-<=
2107,92880
+(defun evaluate-ground-poly (p)evaluate-ground-poly
2117,93206
+(defun impossible-polyp (p)impossible-polyp
2126,93475
+(defun true-polyp (p)true-polyp
2130,93584
+(defun silly-polyp (poly)silly-polyp
2134,93678
+(defun impossible-poly (ttree)impossible-poly
2141,93884
+(defun base-poly0 (ttree parents relation rational-poly-p derived-from-not-equalityp)base-poly0
2151,94121
+(defun base-poly (ttree relation rational-poly-p derived-from-not-equalityp)base-poly
2164,94486
+(defun poly-alist-equal (alist1 alist2)poly-alist-equal
2177,94859
+(defun poly-equal (poly1 poly2)poly-equal
2191,95256
+(defun poly-weakerp (poly1 poly2 parents-check)poly-weakerp
2202,95635
+(defun poly-member (p lst)poly-member
2235,97018
+(defun new-and-ugly-linear-varsp (lst flag term)new-and-ugly-linear-varsp
2251,97675
+(defun filter-polys (lst ans)filter-polys
2277,98693
+(defun add-linear-variable1 (n var alist)add-linear-variable1
2304,99663
+(defun zero-factor-p (term)zero-factor-p
2328,100653
+(defun get-coefficient (term acc)get-coefficient
2349,101487
+(defun add-linear-variable (term side p)add-linear-variable
2363,102025
+(defun dumb-eval-yields-quotep (term)dumb-eval-yields-quotep
2385,102699
+(defun dumb-eval (term)dumb-eval
2407,103504
+(defun add-linear-term (term side p)add-linear-term
2436,104490
+(defun add-linear-terms-fn (rst)add-linear-terms-fn
2506,107054
+(defmacro add-linear-terms (&rest rst)add-linear-terms
2520,107505
+(defun normalize-poly1 (coeff alist)normalize-poly1
2538,108056
+(defun normalize-poly (p)normalize-poly
2545,108249
+(defun normalize-poly-lst (poly-lst)normalize-poly-lst
2561,108652
+(defrec linear-pot ((loop-stopper-value . negatives) . (var . positives)) t)linear-pot
2574,108927
+(defun modify-linear-pot (pot pos neg)modify-linear-pot
2583,109431
+(defconst *max-linear-pot-loop-stopper-value* 3)*max-linear-pot-loop-stopper-value*
2657,112361
+(defun loop-stopper-value-of-var (var pot-lst)loop-stopper-value-of-var
2659,112411
+(defun set-loop-stopper-values (new-vars new-pot-lst term value)set-loop-stopper-values
2670,112800
+(defun var-in-pot-lst-p (var pot-lst)var-in-pot-lst-p
2702,114447
+(defun bounds-poly-with-var (poly-lst pt bounds-poly)bounds-poly-with-var
2712,114712
+(defun bounds-polys-with-var (var pot-lst pt)bounds-polys-with-var
2738,115940
+(defun polys-with-var1 (var pot-lst)polys-with-var1
2763,116869
+(defun polys-with-var (var pot-lst)polys-with-var
2770,117172
+(defun polys-with-pots (polys pot-lst ans)polys-with-pots
2782,117608
+(defun new-vars-in-pot-lst (new-pot-lst old-pot-lst include-variableps)new-vars-in-pot-lst
2795,118024
+(defun changed-pot-vars (new-pot-lst old-pot-lst to-be-ignored-lst)changed-pot-vars
2843,120598
+(defun infect-polys (lst ttree parents)infect-polys
2869,121822
+(defun infect-first-n-polys (lst n ttree parents)infect-first-n-polys
2884,122406
+(defun infect-new-polys (new-pot-lst old-pot-lst ttree)infect-new-polys
2899,123017
+(defun fcomplementary-multiplep1 (alist1 alist2)fcomplementary-multiplep1
2970,126312
+(defun fcomplementary-multiplep (poly1 poly2)fcomplementary-multiplep
2983,126796
+(defun already-used-by-find-equational-polyp-lst (poly1 lst)already-used-by-find-equational-polyp-lst
2998,127451
+(defun already-used-by-find-equational-polyp (poly1 hist)already-used-by-find-equational-polyp
3003,127667
+(defun cons-term-binary-+-constant (x term)cons-term-binary-+-constant
3032,129115
+(defun cons-term-unary-- (term)cons-term-unary--
3041,129412
+(defun cons-term-binary-*-constant (x term)cons-term-binary-*-constant
3047,129646
+(defun find-equational-poly-rhs1 (alist)find-equational-poly-rhs1
3058,130009
+(defun find-equational-poly-rhs (poly1)find-equational-poly-rhs
3072,130511
+(defun find-equational-poly3 (poly1 poly2 hist)find-equational-poly3
3103,131546
+(defun find-equational-poly2 (poly1 negatives hist)find-equational-poly2
3131,132829
+(defun find-equational-poly1 (positives negatives hist)find-equational-poly1
3151,133529
+(defun find-equational-poly (pot hist)find-equational-poly
3171,134277
+(defun get-coeff-for-cancel1 (alist1 alist2)get-coeff-for-cancel1
3208,135903
+(defun cancel2 (alist coeff)cancel2
3232,136711
+(defun cancel1 (alist1 alist2 coeff)cancel1
3240,136914
+(defun cancel (p1 p2)cancel
3266,137953
+(defun cancel-poly-against-all-polys (p polys pt ans)cancel-poly-against-all-polys
3336,141335
+(defun add-poly (p pot-lst to-do-next pt nonlinearp)add-poly
3427,145440
+(defun prune-poly-lst (poly-lst ans)prune-poly-lst
3554,150929
+(defun add-polys1 (lst pot-lst new-lst pt nonlinearp max-roundsadd-polys1
3562,151192
+(defun add-polys0 (lst pot-lst pt nonlinearp max-rounds)add-polys0
3607,153282
+
+type-set-b.lisp,22537
+(defconst *number-of-numeric-type-set-bits**number-of-numeric-type-set-bits*
26,995
+(defconst *type-set-binary-+-table-list**type-set-binary-+-table-list*
30,1099
+(defconst *type-set-binary-+-table**type-set-binary-+-table*
39,1468
+(defconst *type-set-binary-*-table-list**type-set-binary-*-table-list*
43,1589
+(defconst *type-set-binary-*-table**type-set-binary-*-table*
52,1958
+(defconst *type-set-<-table-list**type-set-<-table-list*
60,2240
+(defconst *type-set-<-table**type-set-<-table*
75,2691
+(defun assoc-equal-cdr (x alist)assoc-equal-cdr
89,3292
+(defun runep (x wrld)runep
97,3517
+(defmacro base-symbol (rune)base-symbol
228,10269
+(defmacro strip-base-symbols (runes)strip-base-symbols
242,10835
+(deflabel executable-counterpartexecutable-counterpart
245,10898
+(deflabel worldworld
324,14702
+(deflabel runerune
433,21437
+(deflabel rule-namesrule-names
580,28785
+(defun fnume (rune wrld)fnume
595,29023
+(defun frunic-mapping-pair (rune wrld)frunic-mapping-pair
611,29800
+(defun fn-rune-nume (fn nflg xflg wrld)fn-rune-nume
619,30054
+(defun definition-runes (fns xflg wrld)definition-runes
635,30839
+(defun get-next-nume (lst)get-next-nume
640,31021
+(defun deref-macro-name (macro-name macro-aliases)deref-macro-name
676,32855
+(defun deref-macro-name-lst (macro-name-lst macro-aliases)deref-macro-name-lst
682,33014
+(defconst *abbrev-rune-alist**abbrev-rune-alist*
687,33260
+(defun translate-abbrev-rune (x macro-aliases)translate-abbrev-rune
693,33403
+(defun rule-name-designatorp (x macro-aliases wrld)rule-name-designatorp
703,33758
+(defun theoryp1 (lst macro-aliases wrld)theoryp1
748,36001
+(defun theoryp (lst wrld)theoryp
754,36205
+(defun theoryp!1 (lst fail-flg macro-aliases wrld)theoryp!1
762,36478
+(defun theoryp! (lst wrld)theoryp!
784,37507
+(defun runic-theoryp1 (prev-nume lst wrld)runic-theoryp1
789,37627
+(defun runic-theoryp (lst wrld)runic-theoryp
804,38175
+(defun find-mapping-pairs-tail1 (rune mapping-pairs)find-mapping-pairs-tail1
880,42450
+(defun find-mapping-pairs-tail (rune mapping-pairs wrld)find-mapping-pairs-tail
895,43118
+(defun augment-runic-theory1 (lst mapping-pairs wrld ans)augment-runic-theory1
912,43941
+(defun augment-runic-theory (lst wrld)augment-runic-theory
934,44999
+(defconst *bad-runic-designator-string**bad-runic-designator-string*
959,46319
+(defun convert-theory-to-unordered-mapping-pairs1 (lst macro-aliases wrld ans)convert-theory-to-unordered-mapping-pairs1
965,46679
+(defun convert-theory-to-unordered-mapping-pairs (lst wrld)convert-theory-to-unordered-mapping-pairs
1025,49030
+(defun duplicitous-cons-car (x y)duplicitous-cons-car
1043,49847
+(defun duplicitous-revappend-car (lst ans)duplicitous-revappend-car
1052,50099
+(defun duplicitous-merge-car (parity lst1 lst2 ans)duplicitous-merge-car
1060,50362
+(defun duplicitous-sort-car (parity lst)duplicitous-sort-car
1094,52187
+(defun augment-theory (lst wrld)augment-theory
1115,53192
+(defmacro assert$-runic-theoryp (runic-theory-expr wrld)assert$-runic-theoryp
1143,54581
+(defun runic-theory (lst wrld)runic-theory
1157,54899
+(defrec enabled-structureenabled-structure
1198,56839
+(defun enabled-numep (nume ens)enabled-numep
1282,61643
+(defun enabled-arith-numep (nume ens)enabled-arith-numep
1297,62147
+(defun enabled-runep (rune ens wrld)enabled-runep
1317,62997
+(defmacro active-runep (rune)active-runep
1325,63279
+(defun enabled-xfnp (fn ens wrld)enabled-xfnp
1360,64465
+(defun sublis-var! (alist term ens wrld ttree)sublis-var!
1381,65302
+(defun sublis-var!-lst (alist lst ens wrld ttree)sublis-var!-lst
1490,69492
+(defun theory-warning-fns-aux (runes1 runes2 max-numetheory-warning-fns-aux
1507,70081
+(defun theory-warning-fns (ens1 ens2 w)theory-warning-fns
1535,71298
+(defun@par maybe-warn-about-theory (ens1 force-xnume-en1 imm-xnume-en1 ens2maybe-warn-about-theory
1562,72904
+(defrec theory-invariant-recordtheory-invariant-record
1617,75301
+(defun@par chk-theory-invariant1 (theory-expr ens invariant-alist errp-acc ctxchk-theory-invariant1
1621,75370
+(defun@par chk-theory-invariant (theory-expr ens ctx state)chk-theory-invariant
1709,79790
+(defrec clause-idclause-id
1735,80701
+(defun pos-listp (l)pos-listp
1748,81154
+(defun all-digits-p (lst radix)all-digits-p
1755,81315
+(defun d-pos-listp (lst)d-pos-listp
1764,81658
+(defun clause-id-p (cl-id)clause-id-p
1776,82100
+(defconst *initial-clause-id**initial-clause-id*
1791,82467
+(defun chars-for-tilde-@-clause-id-phrase/periods (lst)chars-for-tilde-@-clause-id-phrase/periods
1815,83611
+(defun chars-for-tilde-@-clause-id-phrase/primes (n)chars-for-tilde-@-clause-id-phrase/primes
1825,83958
+(defun chars-for-tilde-@-clause-id-phrase (id)chars-for-tilde-@-clause-id-phrase
1833,84237
+(defun string-for-tilde-@-clause-id-phrase (id)string-for-tilde-@-clause-id-phrase
1859,85552
+(defun@par load-theory-into-enabled-structureload-theory-into-enabled-structure
1867,85777
+(defun initial-global-enabled-structure (root-string)initial-global-enabled-structure
1955,90372
+(defun recompress-global-enabled-structure (varname wrld)recompress-global-enabled-structure
1984,91590
+(defun recompress-stobj-accessor-arrays (stobj-names wrld)recompress-stobj-accessor-arrays
2044,94494
+(defconst *fake-rune-for-type-set**fake-rune-for-type-set*
2100,97530
+(defun puffert (ttree)puffert
2105,97667
+(defun immediate-forcep (fn ens)immediate-forcep
2115,98079
+(defmacro numeric-type-set (ts)numeric-type-set
2123,98288
+(defmacro rational-type-set (ts)rational-type-set
2146,99235
+(defmacro real-type-set (ts)real-type-set
2167,100017
+(defun type-set-binary-+ (term ts1 ts2 ttree ttree0)type-set-binary-+
2188,100793
+(defun type-set-binary-* (ts1 ts2 ttree ttree0)type-set-binary-*
2230,102850
+(defun type-set-not (ts ttree ttree0)type-set-not
2246,103418
+(defun type-set-<-1 (r arg2 commutedp type-alist)type-set-<-1
2254,103618
+(defun type-set-< (arg1 arg2 ts1 ts2 type-alist ttree ttree0 pot-lst pt)type-set-<
2371,108055
+(defun type-set-unary-- (ts ttree ttree0)type-set-unary--
2533,115792
+(defun type-set-unary-/ (ts ttree ttree0)type-set-unary-/
2556,116814
+(defun type-set-numerator (ts ttree ttree0)type-set-numerator
2575,117712
+(defun type-set-realpart (ts ttree ttree0)type-set-realpart
2590,118396
+(defun type-set-imagpart (ts ttree ttree0)type-set-imagpart
2601,118789
+(defun type-set-complex (ts1 ts2 ttree ttree0)type-set-complex
2622,119568
+(defun type-set-floor1 (ts ttree ttree0)type-set-floor1
2665,121386
+(defun type-set-standard-part (ts ttree ttree0)type-set-standard-part
2680,122063
+(defun type-set-standardp (ts ttree ttree0)type-set-standardp
2696,122731
+(defrec recognizer-tuplerecognizer-tuple
2712,123257
+(defconst *initial-recognizer-alist**initial-recognizer-alist*
2822,127951
+(defun most-recent-enabled-recog-tuple (fn alist ens)most-recent-enabled-recog-tuple
2928,131698
+(defun type-set-recognizer (recog-tuple arg-ts ttree ttree0)type-set-recognizer
2940,132209
+(defun type-set-car (ts ttree ttree0)type-set-car
2973,133765
+(defun type-set-cdr (ts ttree ttree0)type-set-cdr
2977,133902
+(defun type-set-coerce (term ts1 ts2 ttree1 ttree2 ttree0)type-set-coerce
2988,134256
+(defun type-set-intern-in-package-of-symbol (ts1 ts2 ttree1 ttree2 ttree0)type-set-intern-in-package-of-symbol
3010,135128
+(defun type-set-length (ts ttree ttree0)type-set-length
3017,135414
+(defun type-set-cons (ts2 ttree ttree0)type-set-cons
3028,135782
+(defconst *singleton-type-sets**singleton-type-sets*
3039,136135
+(defun type-set-equal (ts1 ts2 ttree ttree0)type-set-equal
3042,136204
+(defun type-set-quote (evg)type-set-quote
3055,136737
+(defun type-set-char-code (ts ttree ttree0)type-set-char-code
3092,138039
+(defun fn-count-1 (flg x fn-count-acc p-fn-count-acc)fn-count-1
3102,138387
+(defmacro fn-count (term)fn-count
3140,140215
+(defun term-order (term1 term2)term-order
3143,140273
+(defrec type-prescriptiontype-prescription
3298,147920
+(defun find-runed-type-prescription (rune lst)find-runed-type-prescription
3341,149710
+(defconst *expandable-boot-strap-non-rec-fns**expandable-boot-strap-non-rec-fns*
3352,150037
+(defun mv-atf (not-flg mbt mbf tta fta ttree1 ttree2)mv-atf
3410,152883
+(defun assume-true-false-error (type-alist x temp-temp)assume-true-false-error
3448,154460
+(defun non-cons-cdr (term)non-cons-cdr
3457,154830
+(defconst *one-way-unify1-implicit-fns**one-way-unify1-implicit-fns*
3475,155630
+(defun one-way-unify1 (pat term alist)one-way-unify1
3486,155794
+(defun one-way-unify1-lst (pl tl alist)one-way-unify1-lst
3719,167461
+(defun one-way-unify1-equal1 (pat1 pat2 term1 term2 alist)one-way-unify1-equal1
3736,168121
+(defun one-way-unify1-equal (pat1 pat2 term1 term2 alist)one-way-unify1-equal
3760,169273
+(defun one-way-unify (pat term)one-way-unify
3768,169512
+(defun canonical-representative (equiv term type-alist)canonical-representative
3828,172431
+(defun subst-type-alist1-check (old equiv type-alist)subst-type-alist1-check
3874,174043
+(defun nil-fn ()nil-fn
3885,174424
+(defconst *nil-fn-ts-entry**nil-fn-ts-entry*
3893,174642
+(defun subst-type-alist1 (new old equiv ttree type-alist acc)subst-type-alist1
3898,174772
+(defun subst-type-alist (new old equiv ttree type-alist)subst-type-alist
3966,177969
+(defun infect-type-alist-entry (entry ttree)infect-type-alist-entry
3981,178571
+(defun infect-new-type-alist-entries2 (new-type-alist old-type-alist ttree)infect-new-type-alist-entries2
3989,178789
+(defun infect-new-type-alist-entries1 (new-type-alist old-type-alist ttree n)infect-new-type-alist-entries1
4008,179587
+(defun infect-new-type-alist-entries (new-type-alist old-type-alist ttree)infect-new-type-alist-entries
4021,180131
+(defun extend-type-alist-simple (term ts ttree type-alist)extend-type-alist-simple
4040,181045
+(defun extend-type-alist1 (equiv occursp1 occursp2 both-canonicalp arg1-canonextend-type-alist1
4059,181825
+(defun extend-type-alist (term ts ttree type-alist wrld)extend-type-alist
4137,185090
+(defun zip-variable-type-alist (vars pairs)zip-variable-type-alist
4188,187338
+(defun assoc-equiv (fn arg1 arg2 alist)assoc-equiv
4202,187949
+(defun assoc-equiv+ (equiv arg1 arg2 type-alist)assoc-equiv+
4221,188700
+(defun assoc-type-alist (term type-alist wrld)assoc-type-alist
4287,191679
+(defun look-in-type-alist (term type-alist wrld)look-in-type-alist
4304,192295
+(defun member-char-stringp (chr str i)member-char-stringp
4309,192451
+(defun terminal-substringp1 (str1 str2 max1 max2)terminal-substringp1
4320,192836
+(defun terminal-substringp (str1 str2 max1 max2)terminal-substringp
4336,193472
+(defun evg-occur (x y)evg-occur
4346,193898
+(defun occur (term1 term2)occur
4415,196809
+(defun occur-lst (term1 args2)occur-lst
4427,197210
+(defun pseudo-variantp (term1 term2)pseudo-variantp
4452,198053
+(defun pseudo-variantp-list (args1 args2)pseudo-variantp-list
4487,199469
+(defun worse-than-builtin (term1 term2)worse-than-builtin
4749,207467
+(defun worse-than-or-equal-builtin (term1 term2)worse-than-or-equal-builtin
4787,209210
+(defun basic-worse-than-lst1 (args1 args2)basic-worse-than-lst1
4819,210512
+(defun basic-worse-than-lst2 (args1 args2)basic-worse-than-lst2
4838,211361
+(defun basic-worse-than (term1 term2)basic-worse-than
4854,212033
+(defun some-subterm-worse-than-or-equal (term1 term2)some-subterm-worse-than-or-equal
4904,214302
+(defun some-subterm-worse-than-or-equal-lst (args term2)some-subterm-worse-than-or-equal-lst
4924,215140
+(defun worse-than-lst (args term2)worse-than-lst
4935,215678
+(defrec ancestorancestor
4981,217082
+(defmacro make-ancestor-binding-hyp (hyp unify-subst)make-ancestor-binding-hyp
4995,217597
+(defmacro ancestor-binding-hyp-p (anc)ancestor-binding-hyp-p
5002,217770
+(defmacro ancestor-binding-hyp/hyp (anc)ancestor-binding-hyp/hyp
5006,217867
+(defmacro ancestor-binding-hyp/unify-subst (anc)ancestor-binding-hyp/unify-subst
5009,217941
+(defun push-ancestor (lit tokens ancestors)push-ancestor
5014,218081
+(defun ancestor-listp (x)ancestor-listp
5044,219448
+(defun earlier-ancestor-biggerp (var-cnt fn-cnt p-fn-cnt tokens ancestors)earlier-ancestor-biggerp
5072,220535
+(defun equal-mod-commuting (x y wrld)equal-mod-commuting
5102,222021
+(defun ancestors-check1 (lit-atm lit var-cnt fn-cnt p-fn-cnt ancestors tokens)ancestors-check1
5130,223016
+(defun ancestors-check-builtin (lit ancestors tokens)ancestors-check-builtin
5271,230556
+(defproxy ancestors-check (* * *) => (mv * *))ancestors-check
5319,232590
+(defun map-multiply-car (multiplicative-constant x)map-multiply-car
5386,235037
+(defun normalize-addend (addend)normalize-addend
5392,235284
+(defun insert-cdr-term-order (item list)insert-cdr-term-order
5416,236243
+(defun normalize-linear-sum-2 (term)normalize-linear-sum-2
5425,236501
+(defun normalize-linear-sum-1 (additive-constant term)normalize-linear-sum-1
5437,236969
+(defun normalize-linear-sum (term)normalize-linear-sum
5487,239324
+(defun normalize-linear-sum-p1 (stripped-term term-to-match)normalize-linear-sum-p1
5557,242134
+(defun normalize-linear-sum-p (stripped-term term-to-match)normalize-linear-sum-p
5566,242526
+(defun type-set-finish-1 (additive-const multiplicative-const stripped-termtype-set-finish-1
5594,243758
+(defun type-set-finish (x ts0 ttree0 ts1 ttree1 type-alist)type-set-finish
5786,254215
+(defun search-type-alist-rec (term alt-term typ type-alist unify-subst ttree)search-type-alist-rec
5824,255889
+(defun free-varsp (term alist)free-varsp
5862,257639
+(defun free-varsp-lst (args alist)free-varsp-lst
5867,257805
+(defun search-type-alist-with-rest (term typ type-alist unify-subst ttree wrld)search-type-alist-with-rest
5874,257968
+(defun search-type-alist (term typ type-alist unify-subst ttree wrld)search-type-alist
5907,259517
+(defun term-and-typ-to-lookup (hyp wrld)term-and-typ-to-lookup
5956,261923
+(defun lookup-hyp (hyp type-alist wrld unify-subst ttree)lookup-hyp
5977,262832
+(defun bind-free-vars-to-unbound-free-vars (vars alist)bind-free-vars-to-unbound-free-vars
5987,263222
+(defabbrev x-xrunep (xrune) ; extended xrunepx-xrunep
6070,267627
+(defabbrev hyp-xrune (n rune)hyp-xrune
6074,267733
+(defabbrev hyp-xrune-rune (xrune)hyp-xrune-rune
6078,267830
+(defabbrev conc-xrune (rune)conc-xrune
6083,267963
+(defabbrev conc-xrune-rune (xrune)conc-xrune-rune
6087,268058
+(defabbrev xrune-rune (xrune)xrune-rune
6092,268192
+(defabbrev rune= (rune1 rune2)rune=
6099,268355
+(defabbrev xrune= (xrune1 xrune2)xrune=
6103,268464
+(defun prettyify-xrune (xrune)prettyify-xrune
6113,268825
+(defrec accp-infoaccp-info
6123,269164
+(defrec accp-entryaccp-entry
6156,270359
+(defun merge-accumulated-persistence-aux (xrune entry alist)merge-accumulated-persistence-aux
6226,273765
+(defun merge-accumulated-persistence-rec (new-alist old-alist)merge-accumulated-persistence-rec
6249,274867
+(defun merge-accumulated-persistence (new-alist old-alist)merge-accumulated-persistence
6258,275202
+(defun add-accumulated-persistence-s (xrune delta-s delta-f alistadd-accumulated-persistence-s
6368,279607
+(defun add-accumulated-persistence-f (xrune delta-s delta-f alistadd-accumulated-persistence-f
6395,280748
+(defun accumulated-persistence-make-failures (alist)accumulated-persistence-make-failures
6425,282011
+(defun add-accumulated-persistence (xrune success-p delta-s delta-fadd-accumulated-persistence
6437,282560
+(defmacro accumulated-persistence (flg)accumulated-persistence
6461,283659
+(defmacro set-accumulated-persistence (flg)set-accumulated-persistence
6862,304577
+(defdoc accumulated-persistence-subtletiesaccumulated-persistence-subtleties
6865,304657
+(defun merge-car-> (l1 l2)merge-car->
6995,309798
+(defun merge-sort-car-> (l)merge-sort-car->
7002,310023
+(defconst *accp-major-separator**accp-major-separator*
7007,310188
+(defconst *accp-minor-separator**accp-minor-separator*
7010,310265
+(defun show-accumulated-persistence-phrase0 (entry key)show-accumulated-persistence-phrase0
7013,310342
+(defun show-accumulated-persistence-phrase1 (key alist mergep acc)show-accumulated-persistence-phrase1
7041,311348
+(defun show-accumulated-persistence-remove-useless (alist acc)show-accumulated-persistence-remove-useless
7073,312710
+(defun show-accumulated-persistence-phrase-key (key entry lastcdr)show-accumulated-persistence-phrase-key
7083,313114
+(defun show-accumulated-persistence-phrase2-merge (key alist last-key-info)show-accumulated-persistence-phrase2-merge
7100,313827
+(defun show-accumulated-persistence-phrase2-not-merge (key alist)show-accumulated-persistence-phrase2-not-merge
7130,315051
+(defun show-accumulated-persistence-phrase2 (key alist mergep)show-accumulated-persistence-phrase2
7139,315498
+(defun split-xrune-alist (alist rune-alist hyp-xrune-alist conc-xrune-alist)split-xrune-alist
7143,315711
+(defun sort-xrune-alist-by-rune1 (rune-alist hyp-xrune-alist conc-xrune-alistsort-xrune-alist-by-rune1
7164,316730
+(defun sort-xrune-alist-by-rune (alist display)sort-xrune-alist-by-rune
7197,318336
+(defun pop-accp-fn (info success-p)pop-accp-fn
7215,319172
+(defun pop-accp-fn-iterate (info n)pop-accp-fn-iterate
7272,321700
+(defun show-accumulated-persistence-phrase (key/display accp-info)show-accumulated-persistence-phrase
7288,322374
+(defmacro show-accumulated-persistence (&optional (sortkey ':frames)show-accumulated-persistence
7360,325988
+(defun push-accp (rune x-info)push-accp
7410,328392
+(defun pop-accp (success-p x-info)pop-accp
7456,331054
+(defmacro with-accumulated-persistence (rune vars success-p bodywith-accumulated-persistence
7473,331815
+(defun assume-true-false-<assume-true-false-<
7523,334017
+(defun mv-atf-2 (not-flg true-type-alist false-type-alistmv-atf-2
7729,342635
+(defun binding-hyp-p (hyp alist wrld)binding-hyp-p
7782,344760
+(defmacro adjust-ignore-for-atf (not-flg ignore)adjust-ignore-for-atf
7830,347138
+(defun backchain-limit-reachedp1 (n ancestors)backchain-limit-reachedp1
7842,347537
+(defun backchain-limit-reachedp (n ancestors)backchain-limit-reachedp
7847,347704
+(defun new-backchain-limit (new-offset old-limit ancestors)new-backchain-limit
7858,348223
+(defproxy oncep-tp (* *) => *)oncep-tp
7885,349162
+(defun oncep-tp-builtin (rune wrld)oncep-tp-builtin
7887,349194
+(defun type-set-rec (x force-flg dwp type-alist ancestors ens w ttreetype-set-rec
7897,349387
+(defun type-set-lst (x force-flg dwp type-alist ancestors ens wtype-set-lst
8429,373922
+(defun type-set-relieve-hyps-free (term typ rest-type-alisttype-set-relieve-hyps-free
8450,374947
+(defun type-set-relieve-hyps1 (hyp forcep rune target hyps backchain-limit-lsttype-set-relieve-hyps1
8493,377002
+(defun type-set-relieve-hyps (rune target hyps backchain-limit-lsttype-set-relieve-hyps
8649,382804
+(defun extend-type-alist-with-bindings (alist force-flg dwp type-alistextend-type-alist-with-bindings
8920,395576
+(defun type-set-with-rule (tp term force-flg dwp type-alist ancestors ens wtype-set-with-rule
8947,396757
+(defun type-set-with-rule1 (alist vars force-flg dwp type-alist ancestors ens wtype-set-with-rule1
9036,400812
+(defun type-set-with-rules (tp-lst term force-flg dwp type-alist ancestors enstype-set-with-rules
9073,402863
+(defun type-set-primitive (term force-flg dwp type-alist ancestors ens w ttree0type-set-primitive
9126,405256
+(defun assume-true-false-if (not-flg x xttree force-flg dwpassume-true-false-if
9663,427822
+(defun assume-true-false-rec (x xttree force-flg dwp type-alist ancestors ens wassume-true-false-rec
9963,443098
+(defun assume-true-false1 (not-flg x xttree force-flg dwp type-alist ancestorsassume-true-false1
11066,498228
+(defun proper/improper-cons-ts-tuple (term ts ttree force-flg dwp type-alistproper/improper-cons-ts-tuple
11124,500807
+(defun extend-with-proper/improper-cons-ts-tupleextend-with-proper/improper-cons-ts-tuple
11198,504314
+(defun type-set (x force-flg dwp type-alist ens w ttree pot-lst pt)type-set
11217,505133
+(defun assume-true-false (x xttree force-flg dwp type-alist ens w pot-lst ptassume-true-false
11372,512808
+(defun ok-to-force-ens (ens)ok-to-force-ens
11379,513124
+(defun add-linear-assumption (target term type-alist ensadd-linear-assumption
11388,513481
+(defun return-type-alistreturn-type-alist
11496,518354
+(defun type-alist-equality-loop1 (type-alist top-level-type-alist ens w)type-alist-equality-loop1
11526,519511
+(defun clean-up-alist (alist ans)clean-up-alist
11617,523567
+(defun duplicate-keysp (alist)duplicate-keysp
11630,524132
+(defun clean-type-alist (type-alist)clean-type-alist
11643,524629
+(defun type-alist-equality-loop-exit (type-alist)type-alist-equality-loop-exit
11660,525391
+(defconst *type-alist-equality-loop-max-depth* 10)*type-alist-equality-loop-max-depth*
11666,525613
+(defun type-alist-equality-loop (type-alist0 ens w n)type-alist-equality-loop
11668,525665
+(defun put-assoc-equal-ts (term ts ttree type-alist)put-assoc-equal-ts
11699,527049
+(defun reconsider-type-alist (type-alist xtype-alist force-flg ens w pot-lstreconsider-type-alist
11711,527589
+(defun type-alist-clause-finish1 (lits ttree-lst force-flg type-alist ens wrld)type-alist-clause-finish1
11773,530512
+(defun type-alist-clause-finish (lits ttree-lst force-flg type-alist ens wrldtype-alist-clause-finish
11809,532253
+(defun type-alist-clause (cl ttree-lst force-flg type-alist ens wrldtype-alist-clause
11941,539350
+(defun known-whether-nil (x type-alist ens force-flg dwp wrld ttree)known-whether-nil
12003,542946
+(defun ts-booleanp (term ens wrld)ts-booleanp
12035,544632
+(defun weak-cons-occur (x y)weak-cons-occur
12046,545119
+(defun equal-x-cons-x-yp (lhs rhs)equal-x-cons-x-yp
12060,545577
+(defun not-ident (term1 term2 type-alist ens wrld)not-ident
12135,548929
+(defun first-if (args i)first-if
12170,550568
+(defun all-variablep (lst)all-variablep
12184,551056
+(defun normalize-with-type-set (term iff-flg type-alist ens wrld ttree)normalize-with-type-set
12189,551191
+(defun normalize (term iff-flg type-alist ens wrld ttree)normalize
12221,552379
+(defun normalize-lst (args iff-flg type-alist ens wrld ttree)normalize-lst
12370,559473
+(defun normalize-or-distribute-first-if (term iff-flg type-alist ens wrldnormalize-or-distribute-first-if
12379,559937
+(defun distribute-first-if (term iff-flg type-alist ens wrld ttree)distribute-first-if
12397,560743
+(defun decode-type-set1 (ts alist)decode-type-set1
12517,566224
+(defun decode-type-set (ts)decode-type-set
12527,566622
+(defmacro dts (term type-alist)dts
12545,567342
+(defun ens (state)ens
12562,567853
+(defmacro git (sym prop)git
12565,567923
+
+linear-b.lisp,1003
+(defun polys-from-type-set (term force-flag dwp type-alist ens wrld ttree)polys-from-type-set
36,1154
+(defun add-type-set-polys (var-lst new-pot-lst old-pot-lstadd-type-set-polys
133,5323
+(defun add-polynomial-inequalities (lst pot-lst pt nonlinearp type-alist ensadd-polynomial-inequalities
176,7396
+(defparameter *add-polys-counter**add-polys-counter*
203,8547
+(defun add-polys (lst pot-lst pt nonlinearp type-alist ens force-flg wrld)add-polys
210,8702
+(defun eval-ground-subexpressions (term ens wrld state ttree)eval-ground-subexpressions
231,9291
+(defun eval-ground-subexpressions-lst (lst ens wrld state ttree)eval-ground-subexpressions-lst
326,12671
+(defun poly-set (op poly1 poly2)poly-set
341,13175
+(defun linearize1 (term positivep type-alist ens force-flg wrld ttree state)linearize1
423,17357
+(defun linearize (term positivep type-alist ens force-flg wrld ttree state)linearize
802,33926
+(defun linearize-lst1linearize-lst1
847,36093
+(defun linearize-lstlinearize-lst
877,37416
+
+non-linear.lisp,2036
+(defun cleanse-type-alist (type-alist pt)cleanse-type-alist
29,1083
+(defun var-with-divisionp (var)var-with-divisionp
56,1948
+(defun varify (x)varify
87,3196
+(defun varify! (x)varify!
110,3790
+(defun varify!-lst1 (lst acc)varify!-lst1
119,4021
+(defun varify!-lst (lst)varify!-lst
124,4141
+(defun invert-var (var)invert-var
131,4311
+(defun part-of1 (var1 var2)part-of1
172,6125
+(defun part-of (var1 var2)part-of
203,7114
+(defun product-already-triedp (var-list products-already-tried)product-already-triedp
220,7633
+(defun too-many-polysp (var-lst pot-lst counter)too-many-polysp
234,8146
+(defun expanded-new-vars-in-pot-lst2 (new-var vars-to-skip vars-to-return)expanded-new-vars-in-pot-lst2
252,8721
+(defun expanded-new-vars-in-pot-lst1 (new-pot-lst vars-to-skipexpanded-new-vars-in-pot-lst1
285,10134
+(defun expanded-new-vars-in-pot-lst (new-pot-lst old-pot-lst)expanded-new-vars-in-pot-lst
331,12494
+(defun extract-bounds (bounds-polys)extract-bounds
355,13495
+(defun good-bounds-in-pot (var pot-lst pt)good-bounds-in-pot
397,15667
+(defun inverse-polys (var inv-var pot-lst ttree pt)inverse-polys
426,16721
+(defun add-inverse-polys (varadd-inverse-polys
762,33525
+(defun add-polys-from-type-set (var pot-lst type-alistadd-polys-from-type-set
805,35285
+(defun length-of-shortest-polys-with-var (poly-lst pt n)length-of-shortest-polys-with-var
841,36731
+(defun shortest-polys-with-var1 (poly-lst pt n)shortest-polys-with-var1
861,37649
+(defun shortest-polys-with-var (var pot-lst pt)shortest-polys-with-var
873,38158
+(defun binary-*-leaves (term)binary-*-leaves
905,39466
+(defun binary-*-tree (leaves)binary-*-tree
911,39624
+(defun merge-arith-term-order (l1 l2)merge-arith-term-order
929,40137
+(defun insert-arith-term-order (item list)insert-arith-term-order
936,40398
+(defun sort-arith-term-order (list)sort-arith-term-order
945,40654
+(defun multiply-alist-and-const (alist const poly)multiply-alist-and-const
952,40855
+(defun collect-rational-poly-p-lst (poly-lst)collect-rational-poly-p-lst
967,41543
+
+tau.lisp,22407
+(defun almost-lexorder-singletons (x y)almost-lexorder-singletons
49,2456
+(defun member-nil-neg-evgs (neg-evg-lst)member-nil-neg-evgs
57,2733
+(defun member-neg-evgs1 (evg neg-evg-lst)member-neg-evgs1
61,2844
+(defun member-neg-evgs (x neg-evg-lst)member-neg-evgs
71,3173
+(defun insert-neg-evgs1 (evg x neg-evg-lst)insert-neg-evgs1
84,3633
+(defun insert-neg-evgs (x neg-evg-lst)insert-neg-evgs
96,4077
+(defun merge-car-< (l1 l2)merge-car-<
106,4456
+(defun merge-sort-car-< (l)merge-sort-car-<
113,4681
+(defun merge-cadr-< (l1 l2)merge-cadr-<
121,4921
+(defun merge-sort-cadr-< (l)merge-sort-cadr-<
128,5151
+(defun strip-caddrs (x)strip-caddrs
136,5398
+(defun unprettyify/add-hyps-to-pairs (hyps lst)unprettyify/add-hyps-to-pairs
148,5972
+(defun flatten-ands-in-lit (term)flatten-ands-in-lit
157,6311
+(defun unprettyify (term)unprettyify
170,6843
+(defun reprettyify (hyps concl wrld)reprettyify
219,9041
+(defun remove-guard-holders1 (changedp0 term)remove-guard-holders1
274,11766
+(defun remove-guard-holders1-lst (lst)remove-guard-holders1-lst
363,15730
+(defun remove-guard-holders (term)remove-guard-holders
374,16170
+(defun remove-guard-holders-lst (lst)remove-guard-holders-lst
384,16442
+(defun remove-guard-holders1-lst-lst (lst)remove-guard-holders1-lst-lst
393,16687
+(defun remove-guard-holders-lst-lst (lst)remove-guard-holders-lst-lst
403,17133
+(defun convert-returned-vars-to-term-lst (term vars)convert-returned-vars-to-term-lst
419,17665
+(defun implicate (t1 t2)implicate
424,17872
+(defrec type-set-inverter-rule ((nume . ts) terms . rune) nil)type-set-inverter-rule
436,18198
+(defconst *initial-type-set-inverter-rules**initial-type-set-inverter-rules*
464,19621
+(defun convert-type-set-to-term-lst (ts rules ens lst ttree)convert-type-set-to-term-lst
687,30092
+(defun subst-var (new old form)subst-var
726,31680
+(defun subst-var-lst (new old l)subst-var-lst
737,32079
+(defun convert-type-set-to-term (x ts ens w ttree)convert-type-set-to-term
747,32387
+(defun convert-type-prescription-to-term (tp ens wrld)convert-type-prescription-to-term
789,34338
+(defun all-runes-in-lmi (lmi wrld ans)all-runes-in-lmi
813,35524
+(defun all-runes-in-lmi-lst (lmi-lst wrld ans)all-runes-in-lmi-lst
828,36119
+(defun all-runes-in-var-to-runes-alist (alist ans)all-runes-in-var-to-runes-alist
833,36327
+(defun all-runes-in-var-to-runes-alist-lst (lst ans)all-runes-in-var-to-runes-alist-lst
839,36526
+(defun all-runes-in-elim-sequence-lst (lst ans)all-runes-in-elim-sequence-lst
847,36758
+(defun all-runes-in-elim-sequence (elim-sequence ans)all-runes-in-elim-sequence
853,36956
+(defun all-runes-in-ttree-fc-derivation-lst (lst ans)all-runes-in-ttree-fc-derivation-lst
868,37637
+(defun all-runes-in-ttree-find-equational-poly-lst (lst ans)all-runes-in-ttree-find-equational-poly-lst
877,37986
+(defun all-runes-in-ttree (ttree ans)all-runes-in-ttree
887,38403
+(defun all-runes-in-ttree-lst (lst ans)all-runes-in-ttree-lst
1014,42576
+(defdoc introduction-to-the-tau-systemintroduction-to-the-tau-system
1021,42764
+(defdoc dealing-with-tau-problemsdealing-with-tau-problems
1248,54244
+(defdoc future-work-related-to-the-tau-systemfuture-work-related-to-the-tau-system
1388,61372
+(defrec tau-interval (domain (lo-rel . lo) . (hi-rel . hi)) t)tau-interval
1857,85106
+(defconst *tau-empty-interval**tau-empty-interval*
2028,93268
+(defun tau-empty-intervalp (int)tau-empty-intervalp
2041,93685
+(defun <?-number-v-rational (rel x k)<?-number-v-rational
2192,99434
+(defun <?-rational-v-number (rel k x)<?-rational-v-number
2218,100229
+(defun eval-tau-interval1 (interval x)eval-tau-interval1
2244,101024
+(defun eval-tau-interval (interval evg)eval-tau-interval
2258,101606
+(defun decode-tau-interval (interval e skip-domain-flg)decode-tau-interval
2273,102175
+(defrec tautau
2311,104017
+(defconst *tau-empty**tau-empty*
2459,109807
+(defconst *nil-singleton-evg-list* (cdr *nil*))*nil-singleton-evg-list*
2478,110551
+(defconst *tau-t* (make tau*tau-t*
2480,110600
+(defconst *tau-nil* (make tau*tau-nil*
2487,110828
+(defconst *tau-non-nil* (make tau*tau-non-nil*
2494,111083
+(defconst *tau-contradiction* :contradiction)*tau-contradiction*
2580,115734
+(defrec signature-rule (input-tau-listsignature-rule
2615,117881
+(defrec big-switch-rule (formals switch-var switch-var-pos body) nil)big-switch-rule
2671,121049
+(defun tau-simple-implicants (sign pred wrld)tau-simple-implicants
2676,121271
+(defun tau-pair-member1 (index pairs)tau-pair-member1
2688,121780
+(defun tau-pair-member (pair pairs)tau-pair-member
2695,121999
+(defun ev-fncall-w-tau-recog (fn evg-lst ens wrld)ev-fncall-w-tau-recog
2815,128596
+(defun bad-val-or-unknowns (bad-val pairs evg-lst ens wrld)bad-val-or-unknowns
2996,136472
+(defun exists-bad-valp (bad-val pairs evg-lst ens wrld)exists-bad-valp
3023,137625
+(defun all-eval-valp (good-val pairs evg-lst ens wrld)all-eval-valp
3049,138719
+(defun delete-bad-vals (neg-evgs pos-pairs neg-pairs ens wrld)delete-bad-vals
3073,139624
+(defun delete-bad-vals1 (neg-evgs sign tau-pair ens wrld)delete-bad-vals1
3093,140362
+(defun tau-pairs-subsetp (pairs1 pairs2)tau-pairs-subsetp
3133,141956
+(defun tau-pairs-near-subsetp (pairs1 pairs2 e)tau-pairs-near-subsetp
3146,142430
+(defun tau-pairs-intersectionp (pairs1 pairs2)tau-pairs-intersectionp
3173,143837
+(defun insert-tau-pair (pair pairs)insert-tau-pair
3189,144411
+(defun interval-decider (lo-rel lo hi-rel hi rel k)interval-decider
3267,147289
+(defun signate (sign x)signate
3291,148368
+(defun reduce-sign/recog (tau sign recog ens wrld)reduce-sign/recog
3376,151656
+(defun every-neg-evg-in-tau-p1every-neg-evg-in-tau-p1
3837,170821
+(defun every-neg-evg-in-tau-p (neg-evgs tau ens wrld)every-neg-evg-in-tau-p
3882,173330
+(defun lower-bound-<= (a-rel a b-rel b)lower-bound-<=
4057,180827
+(defun upper-bound->= (a-rel a b-rel b)upper-bound->=
4072,181224
+(defun lower-bound-> (a-rel a b-rel b)lower-bound->
4084,181459
+(defun upper-bound-< (a-rel a b-rel b)upper-bound-<
4096,181693
+(defun tau-subintervalp (interval1 interval2)tau-subintervalp
4261,187802
+(defun tau-implies (tau1 tau2 ens wrld)tau-implies
4303,189973
+(defun empty-tau-intervalp (lo-rel lo hi-rel hi)empty-tau-intervalp
4349,192066
+(defun singleton-tau-intervalp (lo-rel lo hi-rel hi)singleton-tau-intervalp
4358,192289
+(defun make-identity-interval (interval evg)make-identity-interval
4375,192885
+(defun identity-intervalp (int)identity-intervalp
4406,194174
+(defun delete-consecutive-integers-upward (k neg-evgs)delete-consecutive-integers-upward
4487,198011
+(defun delete-consecutive-integers-downward (k neg-evgs)delete-consecutive-integers-downward
4519,199706
+(defun collect-<?-x-k (rel k neg-evgs)collect-<?-x-k
4552,201276
+(defun collect-<?-k-x (rel k neg-evgs)collect-<?-k-x
4588,203266
+(defun adjust-upper-bound-with-neg-evgs (domain rel k neg-evgs)adjust-upper-bound-with-neg-evgs
4607,203993
+(defun adjust-lower-bound-with-neg-evgs (domain rel k neg-evgs)adjust-lower-bound-with-neg-evgs
4638,205609
+(defun squeeze-k (upper-boundp rel k)squeeze-k
4669,207221
+(defun set-tau-pos-evg (tau recog ens wrld)set-tau-pos-evg
4717,209040
+(defun positive-lower-boundp (lo-rel lo)positive-lower-boundp
4751,210317
+(defun nonnegative-lower-boundp (lo)nonnegative-lower-boundp
4757,210432
+(defun negative-upper-boundp (hi-rel hi)negative-upper-boundp
4760,210492
+(defun tighten-bound (tau domain upper-boundp rel k ens wrld)tighten-bound
4766,210607
+(defun add-to-tau1 (sign recog tau ens wrld)add-to-tau1
4927,218486
+(defun add-recogs-to-tau1 (sign recog-lst tau ens wrld)add-recogs-to-tau1
5324,236134
+(defun tau-interval-endpoint-to-sign-k-token (upper-boundp rel k)tau-interval-endpoint-to-sign-k-token
5348,237224
+(defun tau-union (tau1 tau2 ens wrld)tau-union
5364,237845
+(defun all-integers-in-range-excludedp1 (lo hi neg-evgs)all-integers-in-range-excludedp1
5440,241225
+(defun all-integers-in-range-excludedp (lo-rel lo hi-rel hi neg-evgs)all-integers-in-range-excludedp
5465,242515
+(defun add-to-tau (sign recog tau ens wrld)add-to-tau
5495,243828
+(defun pos-evg-near-subsetp (pos-evg1 pos-evg2)pos-evg-near-subsetp
5707,253885
+(defun neg-evgs-near-subsetpneg-evgs-near-subsetp
5730,254819
+(defun tau-interval-endpoint-implication (ap arel k bp brel d)tau-interval-endpoint-implication
6041,269521
+(defun tau-interval-near-subsetp (interval1 interval2)tau-interval-near-subsetp
6169,274090
+(defun tau-near-subsetp (tau1 tau2 ens wrld)tau-near-subsetp
6350,284088
+(defun tau-put (p-sign p-recog q-sign q-recog ens wrld)tau-put
6918,310329
+(defun tau-put* (p-sign p-recog q-sign q-recog ens wrld)tau-put*
7198,321402
+(defun tau-put*-tau (p-sign p-recog tau ens wrld)tau-put*-tau
7271,324619
+(defun tau-put*-interval-endpoints (p-sign p-recog r-interval ens wrld)tau-put*-interval-endpoints
7333,326941
+(defun tau-put*-recogs (p-sign p-recog r-sign r-recogs ens wrld)tau-put*-recogs
7377,328635
+(defconst *non-tau-monadic-boolean-functions**non-tau-monadic-boolean-functions*
7466,333198
+(defun classicalp (fn wrld)classicalp
7470,333298
+(defun classical-fn-list-p (names wrld)classical-fn-list-p
7491,334082
+(defun monadic-boolean-fnp (fn ens wrld)monadic-boolean-fnp
7497,334260
+(defun putprop-if-different (sym prop val wrld)putprop-if-different
7530,335366
+(defun tau-visit-function-introduction (fn wrld)tau-visit-function-introduction
7541,335731
+(defun tau-visit-function-introductions (fns wrld)tau-visit-function-introductions
7575,337292
+(defun putprop-tau-pair (fn wrld)putprop-tau-pair
7581,337502
+(defun initialize-tau-pred (fn wrld)initialize-tau-pred
7599,338294
+(defun initialize-tau-preds (fns wrld)initialize-tau-preds
7634,340067
+(defun tau-boolean-formp (hyps concl wrld)tau-boolean-formp
7639,340250
+(defun tau-eval-formp (hyps concl wrld)tau-eval-formp
7654,340762
+(defun set-tau-runes (flg val wrld)set-tau-runes
7665,341178
+(defun add-tau-boolean-rule (rune hyps concl wrld)add-tau-boolean-rule
7686,342090
+(defun add-tau-eval-rule (rune hyps concl wrld)add-tau-eval-rule
7710,343232
+(defun tau-like-subject-criterion (criterion x)tau-like-subject-criterion
7749,345180
+(defun tau-like-term (term criterion wrld)tau-like-term
7765,345891
+(defun tau-like-term-listp (lst criterion wrld)tau-like-term-listp
7863,350097
+(defun tau-conjunctive-formp (hyps concl wrld)tau-conjunctive-formp
7888,351242
+(defun tau-simple-formp (hyps concl wrld)tau-simple-formp
7921,352552
+(defun add-tau-simple-rule (rune hyps concl ens wrld)add-tau-simple-rule
7930,352897
+(defun convert-tau-like-terms-to-tau (complete-flg terms ens wrld)convert-tau-like-terms-to-tau
7959,354465
+(defun add-tau-conjunctive-rule (rune hyps concl ens wrld)add-tau-conjunctive-rule
7981,355295
+(defun partition-signature-hyps-into-tau-alist-and-otherspartition-signature-hyps-into-tau-alist-and-others
8068,359188
+(defun tau-boolean-signature-formp (hyps concl)tau-boolean-signature-formp
8111,361373
+(defun tau-signature-formp (hyps concl wrld)tau-signature-formp
8149,362809
+(defun replace-vars-by-bindings (vars alist)replace-vars-by-bindings
8255,367099
+(defun add-tau-signature-rule (rune form hyps concl ens wrld)add-tau-signature-rule
8265,367475
+(defun switch-varp (v term wrld)switch-varp
8366,372111
+(defun tau-big-switch-equationp (term wrld)tau-big-switch-equationp
8381,372567
+(defun tau-big-switch-var (term)tau-big-switch-var
8418,373867
+(defun tau-big-switch-formp (hyps concl wrld)tau-big-switch-formp
8439,374678
+(defun add-tau-big-switch-rule (rune hyps concl wrld)add-tau-big-switch-rule
8443,374791
+(defun tau-mv-nth-synonym-formp (hyps concl)tau-mv-nth-synonym-formp
8465,375673
+(defun add-tau-mv-nth-synonym-rule (rune hyps concl wrld)add-tau-mv-nth-synonym-rule
8480,376117
+(defrec bounder-correctnessbounder-correctness
8496,376726
+(defun all-cars-nil (pairs)all-cars-nil
8543,378885
+(defun find-subject-bounder-link-term (pairs pairs0)find-subject-bounder-link-term
8548,379027
+(defun tau-bounder-doms-extraction (term ivars ivar)tau-bounder-doms-extraction
8568,380027
+(defun tau-bounder-hyp-extractiontau-bounder-hyp-extraction
8594,381079
+(defconst *all-interval-domains**all-interval-domains*
8671,384034
+(defun acceptable-domains-for-bounderacceptable-domains-for-bounder
8674,384110
+(defun bounder-args (ivars ivar-to-svar-pos-alist)bounder-args
8689,384732
+(defun tau-bounder-formp (term wrld)tau-bounder-formp
8695,384944
+(defun pairwise-subsetp-eq (doms-lst1 doms-lst2)pairwise-subsetp-eq
8913,395837
+(defun bounder-subsumedp (bc1 bc2)bounder-subsumedp
8919,396052
+(defun bounder-subsumedp-by-some (bc bounders)bounder-subsumedp-by-some
8939,397096
+(defun delete-some-subsumed-bounders (bc bounders)delete-some-subsumed-bounders
8944,397284
+(defun add-bounder-to-bounders (bc bounders)add-bounder-to-bounders
8952,397583
+(defun add-tau-bounder-rule (rune form j bc wrld)add-tau-bounder-rule
8956,397756
+(defun strip-force-and-case-split (lst)strip-force-and-case-split
9000,399666
+(defun strip-force-and-case-split-in-hyps-of-pairs (pairs)strip-force-and-case-split-in-hyps-of-pairs
9009,399997
+(defun acceptable-tau-rulep (pair wrld)acceptable-tau-rulep
9075,403399
+(defun acceptable-tau-rulesp (flg pairs wrld)acceptable-tau-rulesp
9091,404027
+(defun acceptable-tau-rules (pairs wrld)acceptable-tau-rules
9105,404555
+(defun cross-prod1 (a lst2)cross-prod1
9115,404930
+(defun cross-prod (lst1 lst2)cross-prod
9120,405072
+(defun cnf-dnf (sign term cnfp)cnf-dnf
9125,405230
+(defun split-on-conjoined-disjunctions (lst)split-on-conjoined-disjunctions
9198,408249
+(defun split-on-conjoined-disjunctions-in-hyps-of-pairs (pairs)split-on-conjoined-disjunctions-in-hyps-of-pairs
9214,408799
+(defun chk-acceptable-tau-rule (name term ctx wrld state)chk-acceptable-tau-rule
9231,409680
+(defun add-tau-rule1 (lost-rune-action rune pairs ens wrld wrld0)add-tau-rule1
9291,412649
+(defun add-tau-rule (first-visitp rune term ens wrld0)add-tau-rule
9364,416258
+(defun discover-tau-pred (fn ens wrld)discover-tau-pred
9427,419492
+(defun discover-tau-preds (fns ens wrld)discover-tau-preds
9457,420955
+(defun tau-rules-from-type-prescriptions (tp-lst fn ens wrld wrld0)tau-rules-from-type-prescriptions
9462,421142
+(defun original-def-body1 (fn def-bodies)original-def-body1
9530,424310
+(defun original-def-body (fn wrld)original-def-body
9536,424532
+(defun tau-like-propositionp (var term wrld)tau-like-propositionp
9543,424762
+(defun expand-tau-like-proposition (term)expand-tau-like-proposition
9580,426468
+(defun add-only-simple-and-conjunctive-tau-rules (rune pairs ens wrld)add-only-simple-and-conjunctive-tau-rules
9628,428797
+(defun convert-normalized-term-to-pairs (rhyps term ans)convert-normalized-term-to-pairs
9652,429559
+(defun complementaryp (lit1 lit2)complementaryp
9729,432218
+(defun subsumes-but-for-one-negation (hyps1 hyps2 ancestor-lits)subsumes-but-for-one-negation
9757,433435
+(defun remove-ancestor-literals-from-pairs1 (pair1 pairs ancestor-lits)remove-ancestor-literals-from-pairs1
10003,445687
+(defun remove-ancestor-literals-from-pairs (pairs)remove-ancestor-literals-from-pairs
10031,446821
+(defun convert-term-to-pairs (term ens wrld)convert-term-to-pairs
10046,447386
+(defun tau-subrs (rune fn formals rhs ens wrld)tau-subrs
10108,449962
+(defun tau-visit-defuns1 (fns ens wrld wrld0)tau-visit-defuns1
10151,451702
+(defun tau-visit-defuns (fns auto-modep ens wrld0)tau-visit-defuns
10202,453734
+(defun tau-visit-defun (fn auto-modep ens wrld0)tau-visit-defun
10231,455048
+(defun corollaries-and-runes-of-enabled-rulescorollaries-and-runes-of-enabled-rules
10286,458311
+(defun tau-visit-defthm1 (first-visitp terms-and-runes ens wrld wrld0)tau-visit-defthm1
10318,459776
+(defun tau-visit-defthm (first-visitp name auto-modep ens wrld0)tau-visit-defthm
10342,460827
+(defun tau-visit-event (first-visitp ev-type namex auto-modep enstau-visit-event
10360,461616
+(defun apply-conjunctive-tau-rule (tau1 tau2 ens wrld)apply-conjunctive-tau-rule
10421,464420
+(defun apply-conjunctive-tau-rules2 (conjunctive-rules tau ens wrld changedp)apply-conjunctive-tau-rules2
10450,465735
+(defun apply-conjunctive-tau-rules1 (conjunctive-rules tau ens wrld max-loop)apply-conjunctive-tau-rules1
10481,466945
+(defun apply-conjunctive-tau-rules (tau ens wrld calist)apply-conjunctive-tau-rules
10532,469697
+(defun add-to-tau! (sign recog tau ens wrld calist)add-to-tau!
10550,470410
+(defun all-tau-emptyp (lst)all-tau-emptyp
10583,472044
+(defun all-unrestricted-signature-rulesp (sigrules)all-unrestricted-signature-rulesp
10588,472189
+(defun disjoin-intervals (interval1 interval2)disjoin-intervals
10636,474733
+(defun conjoin-intervals (interval1 interval2)conjoin-intervals
10736,479521
+(defun combine-pos/neg-pairs-from-tau1 (sign pos-evg1 pairs1 pos-evg2 pairs2 ens wrld)combine-pos/neg-pairs-from-tau1
10861,484589
+(defun augment-pos/neg-pairs-with-implicit-numeric-recogsaugment-pos/neg-pairs-with-implicit-numeric-recogs
10950,488515
+(defun combine-pos/neg-pairs-from-tau (sign tau1 tau2 ens wrld)combine-pos/neg-pairs-from-tau
10979,489707
+(defun combine-tau (tau1 tau2 ens wrld)combine-tau
11003,490686
+(defun push-mv-nth-down (i term)push-mv-nth-down
11124,496944
+(defun tau-expand-big-switch (body switch-var switch-tau var-alist ens wrld)tau-expand-big-switch
11145,497676
+(defun deconstruct-conjunction (sign a b c)deconstruct-conjunction
11200,500108
+(defun ok-to-fire-signature-rulep1 (formal-tau-lst actual-tau-lst ens wrld)ok-to-fire-signature-rulep1
11230,501075
+(defun smart-member-equal-+- (lit clause)smart-member-equal-+-
11258,502604
+(defmacro recursivep (fn wrld)recursivep
11302,504674
+(defun find-first-acceptable-domain (actual-dom acceptable-domains)find-first-acceptable-domain
11311,504905
+(defun tau-lst-with-acceptable-domainsp (actual-tau-lst doms-lst)tau-lst-with-acceptable-domainsp
11343,506888
+(defun collect-bounder-args (actual-tau-lst doms-lst bounder-args)collect-bounder-args
11379,508738
+(defun bounding-interval (bc actual-tau-lst wrld)bounding-interval
11411,510507
+(defun conjoin-bounding-intervals (bounders actual-tau-lst wrld)conjoin-bounding-intervals
11437,511537
+(defun apply-tau-bounders (bounders actual-tau-lst ens wrld calist)apply-tau-bounders
11450,512042
+(defun tau-interval-equal-decider (int1 int2)tau-interval-equal-decider
11499,514139
+(defun tau-interval-<-decider (int1 int2)tau-interval-<-decider
11551,516267
+(defun tau-term (term tau-alist type-alist pot-lst ens wrld calist)tau-term
11593,517883
+(defun tau-term-lst (vars terms tau-alist type-alist pot-lst ens wrld calist)tau-term-lst
11987,536193
+(defun tau-rewrite (term tau-alist type-alist pot-lst ens wrld calist)tau-rewrite
12021,537709
+(defun relieve-dependent-hyps (hyps formals actualsrelieve-dependent-hyps
12078,540042
+(defun ok-to-fire-signature-rulep (sigrule actuals actual-tau-lstok-to-fire-signature-rulep
12119,542196
+(defun apply-signature-tau-rule (sigrule actuals actual-tau-lstapply-signature-tau-rule
12136,542939
+(defun apply-signature-tau-rules1 (sigrules actuals actual-tau-lst tauapply-signature-tau-rules1
12157,543968
+(defun apply-signature-tau-rules (sigrules actuals actual-tau-lst tauapply-signature-tau-rules
12192,545659
+(defun tau-assume-basic (sign term tau-alist type-alist pot-lst ens wrld calist)tau-assume-basic
12213,546851
+(defun tau-assume (sign term tau-alist type-alist pot-lst ens wrld calist)tau-assume
12257,548810
+(defun annotate-clause-with-key-numbers (clause max i wrld)annotate-clause-with-key-numbers
12590,566924
+(defun tau-clause1p (triples tau-alist type-alist pot-lst ens wrld calist)tau-clause1p
12614,567838
+(defun tau-get-all-preds (wrld ans)tau-get-all-preds
12663,569970
+(defun tau-get-stats-new-max-block (pred prop val-len block)tau-get-stats-new-max-block
12669,570202
+(defun tau-size (tau)tau-size
12688,570811
+(defun tau-get-stats-on-implicant-sizes (preds wrld ans max-block)tau-get-stats-on-implicant-sizes
12694,571001
+(defun decode-recog (sign recog e)decode-recog
12717,571995
+(defun decode-recog-lst (sign lst e)decode-recog-lst
12731,572448
+(defun decode-tau1 (tau e)decode-tau1
12736,572617
+(defun decode-tau (tau e)decode-tau
12753,573317
+(defun decode-tau-conjunctive-rule (tau)decode-tau-conjunctive-rule
12817,575530
+(defun decode-tau-conjunctive-rules (lst)decode-tau-conjunctive-rules
12836,576332
+(defun decode-tau-lst (lst e-lst)decode-tau-lst
12841,576519
+(defun decode-tau-alist (alist seen)decode-tau-alist
12848,576807
+(defun decode-tau-signature-rule (flg fn sr wrld)decode-tau-signature-rule
12856,577148
+(defun decode-tau-signature-rules1 (flg fn sr-lst wrld)decode-tau-signature-rules1
12894,578743
+(defun decode-tau-signature-rules2 (i fn mv-lst wrld)decode-tau-signature-rules2
12899,578974
+(defun decode-tau-signature-rules (flg fn sr-lst wrld)decode-tau-signature-rules
12906,579307
+(defun tau-get-all-sig-fns (wrld fns-seen)tau-get-all-sig-fns
12924,580151
+(defun some-slot-has-multiple-tau-sigs (slots)some-slot-has-multiple-tau-sigs
12932,580548
+(defun count-tau-sigs-by-slot (slots)count-tau-sigs-by-slot
12937,580722
+(defun collect-rules-with-dependent-hyps (fn i rules wrld ans)collect-rules-with-dependent-hyps
12942,580884
+(defun collect-rules-with-dependent-hyps-across-mv (fn i mv-lst wrld ans)collect-rules-with-dependent-hyps-across-mv
12951,581247
+(defun tau-get-stats-on-signatures1 (fn wrldtau-get-stats-on-signatures1
12957,581526
+(defun tau-get-stats-on-signatures (fns wrldtau-get-stats-on-signatures
13000,583357
+(defun collect-tau-big-switches (wrld ans)collect-tau-big-switches
13031,585169
+(defun tau-sum-lst (x)tau-sum-lst
13038,585459
+(defun tau-get-stats (wrld)tau-get-stats
13044,585693
+(defmacro tau-status (&key (system 'nil system-p) (auto-mode 'nil auto-mode-p))tau-status
13095,587900
+(defun tau-data-fn (fn wrld)tau-data-fn
13164,590416
+(defmacro tau-data (fn)tau-data
13205,592103
+(defun all-fnnames-world1 (trips logicp wrld ans)all-fnnames-world1
13244,593431
+(defun all-fnnames-world (mode wrld)all-fnnames-world
13261,594175
+(defun tau-data-fns (fns wrld ans)tau-data-fns
13272,594513
+(defun tau-database (wrld)tau-database
13281,594831
+(defun initialize-tau-globals (wrld)initialize-tau-globals
13338,597423
+(defun collect-tau-relevant-triples (wrld ans)collect-tau-relevant-triples
13365,598194
+(deflabel boundersbounders
13380,598966
+
+rewrite.lisp,35784
+(defrec congruence-rule (nume equiv . rune) t)congruence-rule
268,13538
+(defconst *geneqv-iff**geneqv-iff*
427,21586
+(defun refinementp (equiv1 equiv2 wrld)refinementp
445,22361
+(defun geneqv-refinementp1 (coarsenings geneqv)geneqv-refinementp1
506,24900
+(defun geneqv-refinementp (equiv geneqv wrld)geneqv-refinementp
518,25339
+(defun some-congruence-rule-disabledp (geneqv ens)some-congruence-rule-disabledp
572,28274
+(defun filter-geneqv1 (geneqv ens)filter-geneqv1
578,28503
+(defun filter-geneqv (geneqv ens)filter-geneqv
584,28752
+(defun some-geneqv-disabledp (lst ens)some-geneqv-disabledp
598,29232
+(defun filter-geneqv-lst1 (lst ens)filter-geneqv-lst1
603,29408
+(defun filter-geneqv-lst (lst ens)filter-geneqv-lst
608,29573
+(defun refinementp1 (equiv1 coarsenings1 equiv2)refinementp1
627,30350
+(defun pair-congruence-rules-with-coarsenings (geneqv wrld)pair-congruence-rules-with-coarsenings
640,30844
+(defun add-to-cr-and-coarseningsadd-to-cr-and-coarsenings
652,31324
+(defun union-geneqv1 (geneqv1 old-crs-and-coarsenings wrld)union-geneqv1
702,33574
+(defun union-geneqv (geneqv1 geneqv2 wrld)union-geneqv
729,35029
+(defun pairwise-union-geneqv (lst1 lst2 wrld)pairwise-union-geneqv
749,35845
+(defun geneqv-lst1 (congruences geneqv ens wrld)geneqv-lst1
766,36572
+(defun geneqv-lst (fn geneqv ens wrld)geneqv-lst
872,41694
+(defun subst-expr1 (new old term)subst-expr1
983,46700
+(defun subst-expr1-lst (new old args)subst-expr1-lst
993,47082
+(defun subst-expr-error (const)subst-expr-error
1003,47414
+(defun subst-expr (new old term)subst-expr
1010,47661
+(defun scons-term (fn args ens wrld state ttree)scons-term
1088,51739
+(defun subst-equiv-expr1 (equiv new old geneqv term ens wrld state ttree)subst-equiv-expr1
1154,54301
+(defun subst-equiv-expr1-lst (equiv new old geneqv-lst args ens wrld state ttree)subst-equiv-expr1-lst
1209,57055
+(defun subst-equiv-expr (equiv new old geneqv term ens wrld state ttree)subst-equiv-expr
1232,57980
+(defun ffnnamesp (fns term)ffnnamesp
1245,58415
+(defun ffnnamesp-lst (fns l)ffnnamesp-lst
1260,58967
+(defun collect-ffnnames (fns term ans)collect-ffnnames
1270,59115
+(defun collect-ffnnames-lst (fns l ans)collect-ffnnames-lst
1293,59983
+(defun comm-equal (fn lhs rhs term)comm-equal
1300,60168
+(defun member-term2 (fn lhs rhs cl)member-term2
1314,60559
+(defun member-complement-term2 (fn lhs rhs cl)member-complement-term2
1328,61026
+(defun member-complement-term1 (lit cl)member-complement-term1
1337,61348
+(defun member-term (lit cl)member-term
1352,61794
+(defun member-complement-term (lit cl)member-complement-term
1367,62342
+(defun instr-listp (l)instr-listp
1385,62982
+(defun spliced-instr-listp (l)spliced-instr-listp
1404,63805
+(defun next-tag (l)next-tag
1422,64539
+(defun if-compile-formal (var rformals i)if-compile-formal
1430,64752
+(defun ffnnamep-hide (fn term lambda-exp)ffnnamep-hide
1445,65404
+(defun ffnnamep-hide-lst (fn l lambda-exp)ffnnamep-hide-lst
1464,66144
+(defun if-compile (term lambda-exp ac rformals)if-compile
1476,66432
+(defun if-compile-lst (l lambda-exp ac rformals)if-compile-lst
1575,71201
+(defun if-interp-assume-true (not-flg term assumptions)if-interp-assume-true
1630,74357
+(defun if-interp-switch (assumptions)if-interp-switch
1650,75178
+(defun if-interp-assumed-value0 (var assumptions)if-interp-assumed-value0
1663,75677
+(defun if-interp-assumed-value1 (term assumptions)if-interp-assumed-value1
1674,76072
+(defun if-interp-assumed-value2-equal-constant (arg const1 assumptions)if-interp-assumed-value2-equal-constant
1686,76566
+(defun if-interp-assumed-value2 (fn arg1 arg2 assumptions)if-interp-assumed-value2
1736,79074
+(defun if-interp-assumed-value3 (term assumptions)if-interp-assumed-value3
1774,80880
+(defun if-interp-assumed-value4 (term assumptions)if-interp-assumed-value4
1791,81638
+(defun if-interp-assumed-value-x (term assumptions)if-interp-assumed-value-x
1808,82429
+(defun if-interp-assumed-value (term assumptions)if-interp-assumed-value
1841,83935
+(defun convert-assumptions-to-clause-segment (assumptions ans known-constants)convert-assumptions-to-clause-segment
1859,84703
+(defun convert-clause-to-assumptions (clause ans)convert-clause-to-assumptions
1982,90789
+(defun simplifiable-mv-nth1 (n cons-term alist)simplifiable-mv-nth1
2004,91896
+(defun simplifiable-mv-nth (term alist)simplifiable-mv-nth
2033,93136
+(defun simplifiable-mv-nthp (term alist)simplifiable-mv-nthp
2060,94315
+(defun call-stack (fn lst stack assumptions ac)call-stack
2069,94532
+(defun ret-stack (lst stack)ret-stack
2192,99758
+(defun extra-info-lit-p (lit)extra-info-lit-p
2196,99863
+(defun subsetp-equal-mod-extra-info-lits (x y)subsetp-equal-mod-extra-info-lits
2204,100096
+(defun quick-and-dirty-subsumption-replacement-step1 (cl1 cl2)quick-and-dirty-subsumption-replacement-step1
2213,100411
+(defun quick-and-dirty-subsumption-replacement-step (cl1 lst)quick-and-dirty-subsumption-replacement-step
2234,101271
+(defstub quick-and-dirty-srs (cl1 ac) t)quick-and-dirty-srs
2414,109310
+(defun quick-and-dirty-srs-builtin (cl1 ac)quick-and-dirty-srs-builtin
2416,109352
+(defattach quick-and-dirty-srs quick-and-dirty-srs-builtin)quick-and-dirty-srs
2421,109471
+(defun if-interp-add-clause (assumptions cl ac pflg)if-interp-add-clause
2423,109532
+(defun if-interp (instrs stack frame-ptr-stack assumptions ac pflg)if-interp
2442,110294
+(defun splice-instrs1 (instrs ans alist)splice-instrs1
2581,117884
+(defun splice-instrs (instrs)splice-instrs
2611,118975
+(defun strip-branches (term assumptions lambda-exp)strip-branches
2615,119089
+(defun merge-length (l1 l2)merge-length
2643,120206
+(defun merge-sort-length (l)merge-sort-length
2652,120546
+(defun member-equal-+- (lit clause)member-equal-+-
2658,120763
+(defun arg1-almost-subsumes-arg2 (arg1 arg2)arg1-almost-subsumes-arg2
2672,121364
+(defun find-subsumer-replacement (cl l)find-subsumer-replacement
2721,123604
+(defun remove-one-complement (lit cl)remove-one-complement
2740,124585
+(defun weak-disc-tree (x)weak-disc-tree
2747,124869
+(defun sweep-clauses1 (tree ac)sweep-clauses1
2757,125233
+(defun sweep-clauses (tree)sweep-clauses
2763,125457
+(defun filter-with-and-without (x l with-lst without-lst)filter-with-and-without
2767,125564
+(defun disc-tree (x)disc-tree
2785,126359
+(defun find-clauses1 (clause tree ac)find-clauses1
2809,127536
+(defun find-clauses (clause tree)find-clauses
2829,128472
+(defun remove-one-+- (x l)remove-one-+-
2832,128542
+(defun store-clause1 (clause undisc-lits tree)store-clause1
2838,128729
+(defun store-clause (cl tree)store-clause
2876,130226
+(defun substitute1-ac (new old seq acc)substitute1-ac
2895,130816
+(defun substitute1 (new old seq)substitute1
2910,131323
+(defun replace-clause1 (clause undisc-lits new-clause tree)replace-clause1
2915,131496
+(defun replace-clause (clause new-clause tree)replace-clause
2941,132516
+(defun extra-info-lits (cl acc)extra-info-lits
2946,132722
+(defun rev-union-equal (x y)rev-union-equal
2952,132918
+(defun merge-extra-info-lits (cl cl0 tree)merge-extra-info-lits
2961,133200
+(defun subsumption-replacement-loop (todo done-tree again-flg)subsumption-replacement-loop
2969,133459
+(defun clausify (term assumptions lambda-exp sr-limit)clausify
3022,135778
+(defun find-rewriting-equivalence (lhs type-alist geneqv wrld ttree)find-rewriting-equivalence
3063,137666
+(defun obj-table (term ts ts-ttree obj geneqv wrld ttree)obj-table
3133,141473
+(defun rewrite-solidify-rec (bound term type-alist obj geneqv ens wrld ttreerewrite-solidify-rec
3178,143230
+(defconst *rewrite-equiv-solidify-iteration-bound**rewrite-equiv-solidify-iteration-bound*
3309,148635
+(defun rewrite-solidify (term type-alist obj geneqv ens wrld ttreerewrite-solidify
3316,148835
+(defun rewrite-if11 (term type-alist geneqv wrld ttree)rewrite-if11
3366,150703
+(defun rewrite-if1rewrite-if1
3377,151099
+(defun equal-mod-alist (term1 alist1 term2)equal-mod-alist
3424,153029
+(defun equal-mod-alist-lst (term1-lst alist1 term2-lst)equal-mod-alist-lst
3458,154399
+(defun member-equal-mod-alist (term1 alist1 term2-lst)member-equal-mod-alist
3465,154634
+(defun not-to-be-rewrittenp1 (fn lst)not-to-be-rewrittenp1
3471,154857
+(defun not-to-be-rewrittenp (term alist terms-to-be-ignored-by-rewrite)not-to-be-rewrittenp
3483,155202
+(defun rewrite-recognizer (recog-tuple arg type-alist ens force-flg wrld ttreerewrite-recognizer
3499,155917
+(defun remove-invisible-fncalls (term invisible-fns)remove-invisible-fncalls
3558,158476
+(defun term-order+ (x1 x2 invisible-fns)term-order+
3572,158902
+(defun invisible-fns (fns alist acc)invisible-fns
3709,164344
+(defun loop-stopperp-rec (loop-stopper sbst wrld)loop-stopperp-rec
3742,165544
+(defun loop-stopperp (loop-stopper sbst wrld)loop-stopperp
3760,166133
+(defrec rewrite-rule (rune nume hyps equiv lhs rhsrewrite-rule
3764,166257
+(defun relevant-ground-lemmas (hyp wrld)relevant-ground-lemmas
3820,169167
+(defun search-ground-units1search-ground-units1
3830,169500
+(defun search-ground-unitssearch-ground-units
3891,172441
+(defun if-tautologyp (term)if-tautologyp
3905,173014
+(defun expand-some-non-rec-fns (fns term wrld)expand-some-non-rec-fns
3938,174537
+(defun expand-some-non-rec-fns-lst (fns lst wrld)expand-some-non-rec-fns-lst
3952,175126
+(defun tautologyp (term wrld)tautologyp
3959,175337
+(defun make-true-list-cons-nest (term-lst)make-true-list-cons-nest
4003,177350
+(defun being-openedp-rec (fn fnstack)being-openedp-rec
4014,177803
+(defmacro being-openedp (fn fnstack clique)being-openedp
4036,178917
+(defun recursive-fn-on-fnstackp (fnstack)recursive-fn-on-fnstackp
4056,179899
+(defun fnstack-term-member (term fnstack)fnstack-term-member
4069,180361
+(defun var-counts1 (arg rhs acc)var-counts1
4318,192225
+(defun var-counts1-lst (arg lst acc)var-counts1-lst
4336,192731
+(defun var-counts (lhs-args rhs)var-counts
4345,193028
+(defun count-ifs (term)count-ifs
4399,196081
+(defun count-ifs-lst (lst)count-ifs-lst
4411,196458
+(defun too-many-ifs0 (args counts diff ctx)too-many-ifs0
4441,197537
+(defproxy too-many-ifs-pre-rewrite (* *) => *)too-many-ifs-pre-rewrite
4471,198775
+(defun too-many-ifs-pre-rewrite-builtin (args counts)too-many-ifs-pre-rewrite-builtin
4473,198823
+(defun occur-cnt-bounded (term1 term2 a m bound-m)occur-cnt-bounded
4519,200323
+(defun occur-cnt-bounded-lst (term1 lst a m bound-m)occur-cnt-bounded-lst
4547,201432
+(defun too-many-ifs1 (args val lhs rhs ctx)too-many-ifs1
4566,202210
+(defproxy too-many-ifs-post-rewrite (* *) => *)too-many-ifs-post-rewrite
4592,203191
+(defun too-many-ifs-post-rewrite-builtin (args val)too-many-ifs-post-rewrite-builtin
4594,203240
+(defun all-args-occur-in-top-clausep (args top-clause)all-args-occur-in-top-clausep
4611,203900
+(defun cons-count-bounded-ac (x i)cons-count-bounded-ac
4616,204109
+(defun cons-count-bounded (x)cons-count-bounded
4633,204793
+(defun max-form-count (term)max-form-count
4639,204901
+(defun max-form-count-lst (lst acc)max-form-count-lst
4715,208411
+(defun controller-complexity1 (flg args controller-pocket)controller-complexity1
4726,208737
+(defun controller-complexity (flg term controller-alist)controller-complexity
4749,209681
+(defun controller-pocket-simplerp (call result controller-alist)controller-pocket-simplerp
4762,210257
+(defun constant-controller-pocketp1 (args controller-pocket)constant-controller-pocketp1
4780,210981
+(defun constant-controller-pocketp (term controller-alist)constant-controller-pocketp
4789,211381
+(defun some-controller-pocket-constant-and-non-controller-simplerpsome-controller-pocket-constant-and-non-controller-simplerp
4800,211840
+(defun rewrite-fncallp (call result cliquep top-clause current-clauserewrite-fncallp
4816,212551
+(defun rewrite-fncallp-listp (call lst cliquep top-clause current-clauserewrite-fncallp-listp
4882,215529
+(defun contains-rewriteable-callpcontains-rewriteable-callp
4900,216199
+(defun contains-rewriteable-callp-lstcontains-rewriteable-callp-lst
4930,217518
+(defrec linear-lemma ((nume . hyps) max-term concllinear-lemma
4943,217969
+(defrec current-literal (not-flg . atm) t)current-literal
4955,218265
+(defrec rewrite-constantrewrite-constant
4957,218309
+(defconst *default-rw-cache-state**default-rw-cache-state*
5084,224277
+(defconst *empty-rewrite-constant**empty-rewrite-constant*
5087,224322
+(defrec metafunction-contextmetafunction-context
5110,225020
+(defun ok-to-force (rcnst)ok-to-force
5125,225652
+(defun plist-to-alist (lst)plist-to-alist
5214,229703
+(defmacro adjust-rdepth (rdepth)adjust-rdepth
5223,229985
+(defun add-rewrite-args (extra-formals keyword-extra-formals alist)add-rewrite-args
5232,230204
+(defrec step-limit-recordstep-limit-record
5252,231026
+(defun step-limit-start (state)step-limit-start
5267,231649
+(defun step-limit-strictp (state)step-limit-strictp
5276,231943
+(defun initial-step-limit (wrld state)initial-step-limit
5288,232362
+(defun step-limit-error1 (ctx str start where state)step-limit-error1
5317,233795
+(defmacro step-limit-error (superior-context-p)step-limit-error
5329,234170
+(defmacro decrement-step-limit (step-limit)decrement-step-limit
5351,234913
+(defmacro rewrite-entry (&rest args)rewrite-entry
5373,235632
+(deflabel free-variablesfree-variables
5452,239288
+(deflabel free-variables-type-prescriptionfree-variables-type-prescription
5658,249881
+(deflabel free-variables-examplesfree-variables-examples
5753,253104
+(deflabel free-variables-examples-rewritefree-variables-examples-rewrite
5767,253673
+(deflabel free-variables-examples-forward-chainingfree-variables-examples-forward-chaining
6320,272877
+(defconst *fake-rune-for-linear**fake-rune-for-linear*
6519,279921
+(defrec gframe (sys-fn bkptr . args) t)gframe
6526,280108
+(defparameter *deep-gstack* nil)*deep-gstack*
6566,281840
+(defmacro push-gframe (sys-fn bkptr &rest args)push-gframe
6568,281874
+(defparameter *saved-deep-gstack* nil)*saved-deep-gstack*
6607,283469
+(defmacro initial-gstack (sys-fn bkptr &rest args)initial-gstack
6609,283509
+(defun tilde-@-bkptr-phrase (calling-sys-fn called-sys-fn bkptr)tilde-@-bkptr-phrase
6624,284076
+(defun cw-gframe (i calling-sys-fn frame evisc-tuple)cw-gframe
6672,286557
+(defun cw-gstack1 (i calling-sys-fn lst evisc-tuple)cw-gstack1
6744,289545
+(defun cw-gstack-fn (evisc-tuple frames)cw-gstack-fn
6751,289855
+(defmacro cw-gstack (&key (evisc-tuple 'nil evisc-tuplep) (frames 'nil))cw-gstack
6813,292711
+(defun restore-brr-globals1 (name new-alist old-alist)restore-brr-globals1
6975,301974
+(defun restore-brr-globals (state)restore-brr-globals
6984,302292
+(defun save-brr-globals (state)save-brr-globals
7012,303400
+(defun get-brr-global (var state)get-brr-global
7036,304348
+(defun exit-brr-wormhole (state)exit-brr-wormhole
7073,306213
+(defmacro brr-wormhole (entry-lambda input-alist test-form aliases)brr-wormhole
7082,306538
+(defun initialize-brr-stack (state)initialize-brr-stack
7134,308879
+(defun lookup-brr-stack (var-name stack)lookup-brr-stack
7153,309617
+(defun clean-brr-stack1 (gstack stack)clean-brr-stack1
7165,310139
+(defun clean-brr-stack (gstack stack)clean-brr-stack
7171,310311
+(defun get-brr-local (var state)get-brr-local
7219,312899
+(defun put-brr-local1 (gstack var val stack)put-brr-local1
7232,313524
+(defun put-brr-local (var val state)put-brr-local
7243,314006
+(defun put-brr-local-lst (alist state)put-brr-local-lst
7258,314682
+(defun some-cdr-equalp (little big)some-cdr-equalp
7263,314880
+(defun push-brr-stack-frame (state)push-brr-stack-frame
7271,315100
+(defun pop-brr-stack-frame (state)pop-brr-stack-frame
7302,316515
+(defun decode-type-alist (type-alist)decode-type-alist
7313,316966
+(defun translate-break-condition (xterm ctx state)translate-break-condition
7324,317400
+(defun eval-break-condition (rune term ctx state)eval-break-condition
7340,318018
+(defconst *default-free-vars-display-limit* 30)*default-free-vars-display-limit*
7357,318644
+(defmacro set-free-vars-display-limit (n)set-free-vars-display-limit
7359,318693
+(defun free-vars-display-limit (state)free-vars-display-limit
7369,319125
+(defun limit-failure-reason (failures-remaining failure-reason elided-p)limit-failure-reason
7379,319445
+(defun limit-failure-reason-alist (failures-remaining alist elided-p)limit-failure-reason-alist
7401,320479
+(defun fix-free-failure-reason (failure-reason)fix-free-failure-reason
7426,321705
+(defun fix-free-failure-reason-alist (x acc)fix-free-failure-reason-alist
7439,322057
+(defun tilde-@-failure-reason-free-phrase (hyp-number alist level unify-substtilde-@-failure-reason-free-phrase
7454,322459
+(defun tilde-@-failure-reason-phrase1 (failure-reason level unify-substtilde-@-failure-reason-phrase1
7491,324202
+(defun tilde-@-failure-reason-phrase (failure-reason level unify-substtilde-@-failure-reason-phrase
7616,330682
+(defun stuff-standard-oi (cmds state)stuff-standard-oi
7630,331420
+(deflabel break-rewritebreak-rewrite
7655,332673
+(deflabel break-lemmabreak-lemma
7906,346196
+(deflabel brr-commandsbrr-commands
7987,349849
+(defdoc dmrdmr
8033,351947
+(defun raw-mode-p (state)raw-mode-p
8200,360620
+(defun defun-mode-prompt-string (state)defun-mode-prompt-string
8203,360688
+(defun brr-prompt (channel state)brr-prompt
8224,361202
+(defun ts< (x y)ts<
8238,361685
+(defun add-to-type-alist-segments (ts term segs)add-to-type-alist-segments
8264,362137
+(defun merge-term-order (l1 l2)merge-term-order
8277,362475
+(defun merge-sort-term-order (l)merge-sort-term-order
8284,362712
+(defun sort-type-alist-segments (segs)sort-type-alist-segments
8289,362902
+(defun type-alist-segments (type-alist acc)type-alist-segments
8301,363315
+(defun print-terms (terms iff-flg wrld)print-terms
8310,363639
+(defun print-type-alist-segments (segs wrld)print-type-alist-segments
8325,364097
+(defun print-type-alist (type-alist wrld)print-type-alist
8343,364837
+(defun tilde-*-ancestors-stack-msg1 (i ancestors wrld evisc-tuple)tilde-*-ancestors-stack-msg1
8348,364994
+(defun tilde-*-ancestors-stack-msg (ancestors wrld evisc-tuple)tilde-*-ancestors-stack-msg
8372,366203
+(defun brkpt1 (lemma target unify-subst type-alist ancestors initial-ttreebrkpt1
8376,366368
+(defun brkpt2 (wonp failure-reason unify-subst gstack rewritten-rhs final-ttreebrkpt2
8612,375512
+(defrec expand-hintexpand-hint
8880,386336
+(defun binds-to-constants-p (unify-subst)binds-to-constants-p
8897,386710
+(defun expand-permission-result1 (term expand-lst geneqv wrld)expand-permission-result1
8904,386983
+(defun remove1-by-position (target-index lst acc)remove1-by-position
8979,390874
+(defun expand-permission-result (term rcnst geneqv wrld)expand-permission-result
8989,391270
+(defun expand-permission-p (term rcnst geneqv wrld)expand-permission-p
9066,394349
+(defun one-way-unify-restrictions1 (pat term restrictions)one-way-unify-restrictions1
9078,394886
+(defun one-way-unify-restrictions (pat term restrictions)one-way-unify-restrictions
9088,395249
+(defun ev-fncall! (fn args state latches aok)ev-fncall!
9094,395431
+(defun ev-fncall-meta (fn args state)ev-fncall-meta
9138,397340
+(defun get-evg (q ctx)get-evg
9172,398973
+(defun ev-synp (synp-term unify-subst mfc state)ev-synp
9184,399280
+(defun bad-synp-alist1 (alist unify-subst vars-to-be-bound wrld)bad-synp-alist1
9216,400761
+(defun bad-synp-alist1-lst (alist-lst unify-subst vars-to-be-bound wrld)bad-synp-alist1-lst
9246,402048
+(defun bind-free-info (x unify-subst vars-to-be-bound wrld)bind-free-info
9253,402351
+(defun evgs-or-t (lst alist)evgs-or-t
9281,403507
+(deflabel nu-rewriternu-rewriter
9643,421459
+(defparameter *nth-update-tracingp* nil)*nth-update-tracingp*
9754,426259
+(defparameter *lambda-abstractp* t)*lambda-abstractp*
9757,426338
+(defparameter *nu-memos* (make-array$ '(65535)))*nu-memos*
9760,426412
+(defparameter *nu-memos-ens* nil)*nu-memos-ens*
9763,426499
+(defparameter *nu-memos-wrld* nil)*nu-memos-wrld*
9766,426571
+(defparameter *ring-buffer-size* (the (integer 0 1000) 5))*ring-buffer-size*
9769,426644
+(defun-one-output initialize-nu-memos (i)initialize-nu-memos
9783,427283
+(defun-one-output clear-nu-memos1 (i)clear-nu-memos1
9794,427646
+(defun-one-output clear-nu-memos (reallyp ens wrld)clear-nu-memos
9813,428428
+(defmacro this-item (x) `(car ,x))this-item
9832,429240
+(defmacro next-ptr (x) `(cadr ,x))next-ptr
9833,429275
+(defmacro prev-ptr (x) `(cddr ,x))prev-ptr
9834,429310
+(defun-one-output link-em (x y)link-em
9845,429616
+(defun-one-output destructive-get-memo1 (d1 d2 d3 ptr0 ptr1 ptr2)destructive-get-memo1
9850,429735
+(defun-one-output destructive-get-memo (d1 d2 d3 rbuff)destructive-get-memo
9898,431189
+(defun get-memo (recursively term stack memo-alist)get-memo
9912,431737
+(defun-one-output destructive-retire-memo (item rbuff)destructive-retire-memo
9967,433667
+(defun-one-output destructive-insert-memo (item rbuff)destructive-insert-memo
9979,434104
+(defun-one-output nu-memo-stats1 (i buckets items full-buckets)nu-memo-stats1
9998,434735
+(defun-one-output nu-memo-stats ()nu-memo-stats
10015,435413
+(defun memo-key1 (term)memo-key1
10029,435812
+(defun bounded-length (lst ans max)bounded-length
10060,437063
+(defun memo-key (term stack)memo-key
10071,437288
+(defun mk (term stack)mk
10095,438153
+(defun show-rbuff1 (r s)show-rbuff1
10103,438354
+(defun show-rbuff (r)show-rbuff
10106,438451
+(defun memo-exit (recursivelyp term stack flg term2 stack2 ttree2 memo-alist)memo-exit
10121,439221
+(defun nfix-quote (x)nfix-quote
10167,440925
+(defun bound-in-framep (var vars terms)bound-in-framep
10188,441565
+(defun non-rec-defun1 (lemmas ens ttree)non-rec-defun1
10197,441848
+(defun non-rec-defun (fn ens wrld ttree)non-rec-defun
10243,444149
+(defun deref-var (var stack ens wrld ttree)deref-var
10304,446777
+(defun deref (term stack ens wrld ttree)deref
10317,447244
+(defun equal-derefs (term1 stack1 term2 stack2)equal-derefs
10386,449497
+(defun filter-args (formals vars actuals)filter-args
10401,449936
+(defun foccurrences (term1 term2 ans)foccurrences
10409,450206
+(defun foccurrences-lst (term lst ans)foccurrences-lst
10438,451180
+(defun every-var-at-most-oncep (vars body)every-var-at-most-oncep
10445,451411
+(defun every-actual-simple (args)every-actual-simple
10455,451718
+(defun make-clean-lambda-application (formals body args)make-clean-lambda-application
10462,451909
+(defun lambda-stack (stack term)lambda-stack
10515,454267
+(defun shorten-each-stack-to-len (n terms stacks)shorten-each-stack-to-len
10542,455406
+(defun all-equal-stacks (the-stack terms stacks)all-equal-stacks
10553,455839
+(defun non-quoted-stack (terms stacks)non-quoted-stack
10562,456223
+(defun cdr-all (x)cdr-all
10568,456402
+(defun len-common-tail (n terms stacks)len-common-tail
10572,456498
+(defun butlast-all-stacks (terms stacks n)butlast-all-stacks
10577,456667
+(defun min-stack-len (terms stacks)min-stack-len
10584,456920
+(defun reconcile-stacks (terms stacks)reconcile-stacks
10594,457250
+(defun reconcile-terms (terms exts)reconcile-terms
10643,459192
+(defun all-equal (x lst)all-equal
10649,459366
+(defun recon (terms stacks)recon
10655,459524
+(defun with-reconciliation-let-bindings (terms var)with-reconciliation-let-bindings
10678,460513
+(defmacro with-reconciliation (terms stacks common-stack body)with-reconciliation
10684,460772
+(defun lambda-stack-one-way-unify1 (pat term stack alist ens wrld ttree)lambda-stack-one-way-unify1
10717,461750
+(defun lambda-stack-one-way-unify1-lst (pat-lst term-lst stack alistlambda-stack-one-way-unify1-lst
10766,463599
+(defun lambda-stack-one-way-unify (pat term stack ens wrld ttree)lambda-stack-one-way-unify
10786,464423
+(defun apply-abbrevs-to-lambda-stack1 (term stack ens wrld lemmas ttree)apply-abbrevs-to-lambda-stack1
10815,465423
+(defun apply-abbrevs-to-lambda-stack (hitp term stack ens wrld state ttree)apply-abbrevs-to-lambda-stack
10858,467506
+(defconst *fake-rune-for-nu-rewriter**fake-rune-for-nu-rewriter*
10955,471186
+(defun nth-update-rewriter1-continuenth-update-rewriter1-continue
10962,471333
+(defun nth-update-rewriter1nth-update-rewriter1
11020,473416
+(defun nth-update-rewriter1-lst (recursivelyp args stacknth-update-rewriter1-lst
11567,496597
+(defun nth-update-rewriter-targetp (term wrld)nth-update-rewriter-targetp
11590,497603
+(defun nth-update-rewriter-target-lstp (lst wrld)nth-update-rewriter-target-lstp
11604,498214
+(defun make-stack-from-alist (term alist)make-stack-from-alist
11613,498459
+(defun nth-update-rewriter (recursivep term alist ens wrld state)nth-update-rewriter
11636,499355
+(defun collect-by-position (sub-domain full-domain full-range)collect-by-position
11752,504164
+(defun make-lambda-application (formals body actuals)make-lambda-application
11770,504867
+(defun lambda-nest-hidep (term)lambda-nest-hidep
11805,506083
+(defun lambda-nest-unhide (term)lambda-nest-unhide
11821,506538
+(defun search-type-alist+ (term typ type-alist unify-subst ttree wrld)search-type-alist+
11832,506830
+(defun oncep (nume-runes match-free rune nume)oncep
11852,507665
+(defabbrev memo-activep (memo)memo-activep
11866,508287
+(defabbrev activate-memo (memo)activate-memo
11869,508357
+(defmacro zero-depthp (depth)zero-depthp
11872,508422
+(defmacro rdepth-error (form &optional preprocess-p)rdepth-error
11889,509091
+(defun bad-synp-hyp-msg1 (hyp bound-vars all-vars-bound-p wrld)bad-synp-hyp-msg1
11921,510795
+(defun bad-synp-hyp-msg (hyps bound-vars all-vars-bound-p wrld)bad-synp-hyp-msg
12075,519570
+(defmacro sl-let (vars form &rest rest)sl-let
12102,520857
+(defmacro sl-let@par (vars form &rest rest)sl-let@par
12113,521110
+(defmacro rewrite-entry-extending-failure (unify-subst failure-reason formrewrite-entry-extending-failure
12125,521478
+(defun set-difference-assoc-eq (lst alist)set-difference-assoc-eq
12140,522337
+(defun extend-unify-subst (alist unify-subst)extend-unify-subst
12150,522772
+(defun relieve-hyp-synp (rune hyp0 unify-subst rdepth type-alist wrld staterelieve-hyp-synp
12159,523051
+(defun push-lemma? (rune ttree)push-lemma?
12270,528183
+(defmacro push-lemma+ (rune ttree rcnst ancestors rhs rewritten-rhs)push-lemma+
12275,528269
+(defmacro push-splitter? (rune ttree rcnst ancestors rhs rewritten-rhs)push-splitter?
12290,528838
+(defmacro prepend-step-limit (n form)prepend-step-limit
12308,529560
+(defrec rw-cache-entryrw-cache-entry
12319,529908
+(defmacro free-failure-p (r)free-failure-p
12381,532565
+(defabbrev combine-free-failure-reasons (r1 r2)combine-free-failure-reasons
12384,532629
+(defun combine-free-failure-alists (a1 a2)combine-free-failure-alists
12397,533070
+(defun combine-sorted-rw-cache-lists1 (l1 l2)combine-sorted-rw-cache-lists1
12438,534539
+(defun split-psorted-list1 (lst acc)split-psorted-list1
12491,536902
+(defun split-psorted-list (lst)split-psorted-list
12499,537163
+(defun merge-lexorder-fast (l1 l2)merge-lexorder-fast
12512,537661
+(defun merge-sort-lexorder-fast (l)merge-sort-lexorder-fast
12529,538319
+(defun sort-rw-cache-list (lst)sort-rw-cache-list
12569,539968
+(defun combine-rw-cache-lists (lst1 lst2)combine-rw-cache-lists
12587,540572
+(defun merge-rw-caches (alist1 alist2)merge-rw-caches
12611,541536
+(defmacro sorted-rw-cache-p (cache)sorted-rw-cache-p
12643,543056
+(defun merge-symbol-alistp (a1 a2)merge-symbol-alistp
12649,543187
+(defun merge-sort-symbol-alistp (alist)merge-sort-symbol-alistp
12659,543472
+(defun cdr-sort-rw-cache (cache)cdr-sort-rw-cache
12671,543941
+(defun combine-rw-caches (c1 c2)combine-rw-caches
12686,544412
+(defun unify-subst-subsetp (a1 a2)unify-subst-subsetp
12704,545127
+(defun rw-cache-list-lookup (unify-subst hyps recs)rw-cache-list-lookup
12716,545515
+(defstub relieve-hyp-failure-entry-skip-prelieve-hyp-failure-entry-skip-p
12745,546819
+(defun relieve-hyp-failure-entry-skip-p-builtin (rune unify-subst hyps ttreerelieve-hyp-failure-entry-skip-p-builtin
12749,546910
+(defmacro rw-cache-active-p (rcnst)rw-cache-active-p
12758,547263
+(defun assoc-rw-cache (key alist)assoc-rw-cache
12762,547390
+(defun put-assoc-rw-cache1 (key val alist)put-assoc-rw-cache1
12770,547618
+(defun put-assoc-rw-cache (key val alist)put-assoc-rw-cache
12782,548112
+(defun relieve-hyp-failure-entry (rune unify-subst hyps ttree step-limit)relieve-hyp-failure-entry
12791,548390
+(defun maybe-extend-tag-tree (tag vals ttree)maybe-extend-tag-tree
12816,549422
+(defun accumulate-rw-cache1 (replace-p tag new-ttree old-ttree)accumulate-rw-cache1
12823,549599
+(defun accumulate-rw-cache (replace-p new-ttree old-ttree)accumulate-rw-cache
12870,551563
+(defun accumulate-rw-cache? (replace-p new-ttree old-ttree)accumulate-rw-cache?
12889,552483
+(defun dumb-occur-var (var term)dumb-occur-var
12905,553168
+(defun dumb-occur-var-lst (var lst)dumb-occur-var-lst
12915,553497
+(defun restrict-alist-to-all-vars1 (alist term)restrict-alist-to-all-vars1
12921,553661
+(defun all-vars-boundp (term alist)all-vars-boundp
12939,554406
+(defun all-vars-lst-boundp (lst alist)all-vars-lst-boundp
12947,554688
+(defun restrict-alist-to-all-vars (alist term)restrict-alist-to-all-vars
12956,554971
+(defun push-rw-cache-entry (entry tag rune ttree)push-rw-cache-entry
12979,555968
+(defstub rw-cache-debugrw-cache-debug
13001,556726
+(defstub rw-cache-debug-actionrw-cache-debug-action
13005,556822
+(defun rw-cache-debug-builtin (rune target unify-subst failure-reasonrw-cache-debug-builtin
13009,556925
+(defun rw-cache-debug-action-builtin (rune target unify-subst failure-reasonrw-cache-debug-action-builtin
13015,557150
+(defun rw-cacheable-failure-reason-builtin (failure-reason)rw-cacheable-failure-reason-builtin
13033,557781
+(defun rw-cacheable-nil-tag (failure-reason)rw-cacheable-nil-tag
13046,558315
+(defun note-relieve-hyp-failure (rune unify-subst failure-reason ttree hypsnote-relieve-hyp-failure
13067,559189
+(defun replace-free-rw-cache-entry1 (unify-subst hyps entry recs)replace-free-rw-cache-entry1
13117,561644
+(defun replace-free-rw-cache-entry (entry tag rune unify-subst hyps ttree)replace-free-rw-cache-entry
13138,562648
+(defun rw-cache-alist-nil-tag-p (alist)rw-cache-alist-nil-tag-p
13157,563318
+(defabbrev merge-free-failure-reasons-nil-tag (r1 r2)merge-free-failure-reasons-nil-tag
13171,563933
+(defun merge-free-failure-alists-nil-tag (a1 a2)merge-free-failure-alists-nil-tag
13184,564513
+(defun note-rw-cache-free-nil-tag (rune unify-subst hyps ttreenote-rw-cache-free-nil-tag
13230,566295
+(defun note-relieve-hyps-failure-free (rune unify-subst hyps ttree old-entrynote-relieve-hyps-failure-free
13281,568423
+(defun rw-cache-enter-context (ttree)rw-cache-enter-context
13318,569824
+(defun erase-rw-cache (ttree)erase-rw-cache
13326,570099
+(defun rw-cache-exit-context (old-ttree new-ttree)rw-cache-exit-context
13335,570323
+(defun restore-rw-cache-any-tag (new-ttree old-ttree)restore-rw-cache-any-tag
13363,571582
+(defun cons-tag-trees-rw-cache (ttree1 ttree2)cons-tag-trees-rw-cache
13386,572770
+(defun normalize-rw-any-cache (ttree)normalize-rw-any-cache
13457,575590
+(defun cons-tag-trees-rw-cache-first (ttree1 ttree2)cons-tag-trees-rw-cache-first
13469,575986
+(defun alist-keys-subsetp (x keys)alist-keys-subsetp
13483,576418
+(defmacro tag-tree-tags-subsetp (ttree tags)tag-tree-tags-subsetp
13489,576572
+(defun rw-cache (ttree)rw-cache
13495,576685
+(defun rw-cached-failure-pair (unify-subst rw-cache-alist)rw-cached-failure-pair
13510,577144
+(defun extend-rw-cache-alist-free (rcnst new-unify-substextend-rw-cache-alist-free
13531,578114
+(defun rw-cache-add-failure-reason (rcnst new-unify-substrw-cache-add-failure-reason
13551,579131
+(defun rewrite (term alist bkptr ; &extra formalsrewrite
13576,580154
+(defun rewrite-solidify-plus (term ; &extra formalsrewrite-solidify-plus
14265,611872
+(defun rewrite-if (test unrewritten-test left right alist ; &extra formalsrewrite-if
14324,614637
+(defun rewrite-args (args alist bkptr; &extra formalsrewrite-args
14475,622630
+(defun rewrite-primitive (fn args ; &extra formalsrewrite-primitive
14503,623687
+(defun rewrite-equal (lhs rhs lhs-ancestors rhs-ancestors ; &extra formalsrewrite-equal
14541,625202
+(defun relieve-hyprelieve-hyp
14844,639206
+(defun relieve-hyps1-iter (rune target hyps backchain-limit-lstrelieve-hyps1-iter
15216,658589
+(defun relieve-hyps1 (rune target hyps backchain-limit-lstrelieve-hyps1
15253,660550
+(defun relieve-hyps1-free-1relieve-hyps1-free-1
15412,668177
+(defun relieve-hyps1-free-2relieve-hyps1-free-2
15531,673712
+(defun relieve-hyps (rune target hyps backchain-limit-lstrelieve-hyps
15720,681813
+(defun rewrite-with-lemma (term lemma ; &extra formalsrewrite-with-lemma
15855,688112
+(defun rewrite-with-lemmas1 (term lemmasrewrite-with-lemmas1
16202,705554
+(defun rewrite-fncall (rule term ; &extra formalsrewrite-fncall
16246,707501
+(defun rewrite-with-lemmas (term ; &extra formalsrewrite-with-lemmas
16632,727917
+(defun rewrite-linear-term (term alist ; &extra formalsrewrite-linear-term
16773,734734
+(defun rewrite-linear-term-lst (term-lst ttrees ; &extra formalsrewrite-linear-term-lst
16862,738749
+(defun add-linear-lemma (term lemma ; &extra formalsadd-linear-lemma
16915,741120
+(defun add-linear-lemmas (term linear-lemmas ; &extra formalsadd-linear-lemmas
17153,752238
+(defun multiply-alists2 (alist-entry1 alist-entry2 poly ; &extra formalsmultiply-alists2
17206,754451
+(defun multiply-alists1 (alist-entry alist2 poly ; &extra formalsmultiply-alists1
17265,757100
+(defun multiply-alists (alist1 alist2 poly ; &extra formalsmultiply-alists
17312,758825
+(defun multiply-polys1 (alist1 const1 rel1 alist2 const2 rel2multiply-polys1
17368,760812
+(defun multiply-polys (poly1 poly2 ; &extra formalsmultiply-polys
17540,768426
+(defun multiply-pots2 (poly big-poly-list new-poly-list ; &extra formalsmultiply-pots2
17602,771026
+(defun multiply-pots1 (poly-list big-poly-list new-poly-list ; &extra formalsmultiply-pots1
17663,773149
+(defun multiply-pots-super-filter (var-list pot-lst-to-look-in ; &extra formalsmultiply-pots-super-filter
17712,774825
+(defun multiply-pots-filter (var-list pot-lst-to-look-in ; &extra formalsmultiply-pots-filter
17768,777000
+(defun multiply-pots (var-list pot-lst-to-look-in ; &extra formalsmultiply-pots
17822,779229
+(defun add-multiplied-polys-filter (var-list products-already-triedadd-multiplied-polys-filter
17875,781177
+(defun add-multiplied-polys (var-list products-already-triedadd-multiplied-polys
17955,784777
+(defun deal-with-product1 (part-of-new-var var-listdeal-with-product1
18039,788286
+(defun deal-with-product (new-var pot-lst-to-look-indeal-with-product
18158,793972
+(defun deal-with-factor (new-var pot-lst-to-look-indeal-with-factor
18204,795866
+(defun deal-with-division (new-var inverse-vardeal-with-division
18292,799972
+(defun non-linear-arithmetic1 (new-vars pot-lst ;;; to look-in/step-downnon-linear-arithmetic1
18409,805103
+(defun non-linear-arithmetic (new-vars pot-lst ;;; to look-in/step-downnon-linear-arithmetic
18502,809449
+(defun add-polys-and-lemmas2-nl (new-vars old-pot-lst ; &extra formalsadd-polys-and-lemmas2-nl
18791,821031
+(defun add-polys-and-lemmas1-nl (old-pot-lst cnt ; &extra formalsadd-polys-and-lemmas1-nl
18884,825241
+(defun add-polys-and-lemmas1 (new-vars old-pot-lst ; &extra formalsadd-polys-and-lemmas1
19008,830484
+(defun add-polys-and-lemmas (lst disjunctsp ; &extra formalsadd-polys-and-lemmas
19074,833196
+(defun add-disjunct-polys-and-lemmas (lst1 lst2 ; &extra formalsadd-disjunct-polys-and-lemmas
19171,837270
+(defun add-disjuncts-polys-and-lemmas (split-lst to-do-lateradd-disjuncts-polys-and-lemmas
19285,842402
+(defun add-terms-and-lemmas (term-lst ttrees positivepadd-terms-and-lemmas
19457,850502
+(defun rewrite-with-linear (term ; &extra formalsrewrite-with-linear
19552,854858
+
+simplify.lisp,19196
+(defun negate-lit (term type-alist ens force-flg wrld)negate-lit
65,2819
+(defun pegate-lit (term type-alist ens force-flg wrld)pegate-lit
86,3645
+(defun add-literal (lit cl at-end-flg)add-literal
107,4440
+(defun add-each-literal (cl)add-each-literal
144,5860
+(defun subsumes-rec (count cl1 cl2 alist)subsumes-rec
206,8828
+(defun subsumes1-equality-with-const (count lit x const1 tl1 tl2 cl2 alist)subsumes1-equality-with-const
252,11316
+(defun subsumes1 (count lit tl1 tl2 cl2 alist)subsumes1
301,14150
+(defun subsumes!-rec (cl1 cl2 alist)subsumes!-rec
336,15656
+(defun subsumes!1-equality-with-const (lit x const1 tl1 tl2 cl2 alist)subsumes!1-equality-with-const
363,16943
+(defun subsumes!1 (lit tl1 tl2 cl2 alist)subsumes!1
399,18696
+(defconst *init-subsumes-count**init-subsumes-count*
419,19397
+(defun subsumes (init-subsumes-count cl1 cl2 alist)subsumes
439,20215
+(defun some-member-subsumes (init-subsumes-count cl-set cl acc)some-member-subsumes
462,21200
+(defun conjoin-clause-to-clause-set (cl cl-set)conjoin-clause-to-clause-set
475,21722
+(defun add-each-literal-lst (cl-set)add-each-literal-lst
494,22646
+(defun conjoin-clause-sets (cl-set1 cl-set2)conjoin-clause-sets
500,22849
+(defun some-element-member-complement-term (lst1 lst2)some-element-member-complement-term
506,23055
+(defun disjoin-clauses1 (cl1 cl2)disjoin-clauses1
514,23376
+(defun disjoin-clauses (cl1 cl2)disjoin-clauses
530,24029
+(defun disjoin-clause-segment-to-clause-set (segment cl-set)disjoin-clause-segment-to-clause-set
548,24640
+(defun split-on-assumptions (assumptions cl ans)split-on-assumptions
567,25558
+(defun rewrite-clause-action (lit branches)rewrite-clause-action
581,26033
+(defrec forward-chaining-ruleforward-chaining-rule
717,33879
+(defrec fc-activationfc-activation
727,34373
+(defun suspend-fc-activation (act inst-hyp hyps unify-subst ttree)suspend-fc-activation
840,40932
+(defun prettyify-fc-activation (act level)prettyify-fc-activation
901,43353
+(defun prettyify-fc-activations (acts level)prettyify-fc-activations
976,46700
+(defun make-fc-activation (term rule ttree ens)make-fc-activation
981,46897
+(defun make-fc-activations (term rules ttree ens activations)make-fc-activations
1029,49411
+(defun collect-terms-and-activations (term ttree wrld ens trigger-terms activations)collect-terms-and-activations
1039,49820
+(defun collect-terms-and-activations-lstcollect-terms-and-activations-lst
1092,52378
+(defun collect-terms-and-activations-from-fcd-lst (fcd-lst wrld enscollect-terms-and-activations-from-fcd-lst
1105,52966
+(defun sublis-varp (alist term)sublis-varp
1137,54353
+(defun sublis-var-lstp (alist l)sublis-var-lstp
1146,54638
+(defun mult-search-type-alist (rest-hyps concls term typ type-alistmult-search-type-alist
1155,54885
+(defun mult-lookup-hyp (hyp rest-hyps concls type-alist wrld unify-subst ttreemult-lookup-hyp
1226,58673
+(defun ev-respecting-ens (form alist state latches ttree ens wrld)ev-respecting-ens
1245,59482
+(defun ev-lst-respecting-ens (lst alist state latches ttree ens wrld)ev-lst-respecting-ens
1302,62400
+(defun add-fc-derivations (rune concls unify-subst inst-triggeradd-fc-derivations
1401,67961
+(defun prettyify-fc-derivation (fcd level)prettyify-fc-derivation
1438,69596
+(defun prettyify-fc-derivations (fcd-lst level)prettyify-fc-derivations
1499,72210
+(defun expunge-fc-derivations-lst (fc-derivation-lst ttree)expunge-fc-derivations-lst
1507,72441
+(defun expunge-fc-derivations (ttree)expunge-fc-derivations
1517,72952
+(defun current-fc-call-number (data)current-fc-call-number
1707,82792
+(defun current-fc-call-alist (data)current-fc-call-alist
1711,82911
+(defun put-current-fc-call-alist (call-alist data)put-current-fc-call-alist
1715,83029
+(defun initialize-fc-wormhole-sites ()initialize-fc-wormhole-sites
1733,83866
+(deflabel forward-chaining-reportsforward-chaining-reports
1748,84317
+(defun show-fc-criteria ()show-fc-criteria
2034,97548
+(defun reset-fc-reporting ()reset-fc-reporting
2057,98085
+(defun translate-fc-criterion (x state)translate-fc-criterion
2088,98952
+(defun translate-fc-criteria (lst state)translate-fc-criteria
2119,100167
+(defun set-fc-criteria-fn (x state)set-fc-criteria-fn
2136,100902
+(defmacro set-fc-criteria (&rest x)set-fc-criteria
2160,101707
+(defun set-fc-report-on-the-fly (flg)set-fc-report-on-the-fly
2232,104949
+(defun new-fc-call (caller cl pts force-flg do-not-reconsiderp wrld ensnew-fc-call
2290,107213
+(defun member-one-way-unify1 (term pat-lst unify-subst)member-one-way-unify1
2336,109245
+(defun satisfying-fc-activation1p (criterion act)satisfying-fc-activation1p
2350,109693
+(defun satisfying-fc-activationp (criteria act)satisfying-fc-activationp
2369,110392
+(defun collect-satisfying-fc-activations (criteria acts ans)collect-satisfying-fc-activations
2374,110600
+(defun satisfying-virtual-fc-activation1p (criterion act0 unify-subst)satisfying-virtual-fc-activation1p
2392,111530
+(defun satisfying-virtual-fc-activationp (criteria act0 unify-subst)satisfying-virtual-fc-activationp
2418,112618
+(defun satisfying-fc-derivation1p (criterion fcd)satisfying-fc-derivation1p
2430,113223
+(defun satisfying-fc-derivationp (criteria fcd)satisfying-fc-derivationp
2444,113701
+(defun collect-satisfying-fc-derivations (criteria fcd-lst ans)collect-satisfying-fc-derivations
2449,113909
+(defun filter-satisfying-virtual-fc-activation (act0 inst-hyp hyps unify-subst ttree)filter-satisfying-virtual-fc-activation
2464,114566
+(defun filter-all-satisfying-fc-derivations (fcd-lst)filter-all-satisfying-fc-derivations
2517,117086
+(defun filter-satisfying-fc-activations (acts)filter-satisfying-fc-activations
2562,119083
+(defun filter-redundant-approved-fc-derivation (fcd)filter-redundant-approved-fc-derivation
2596,120409
+(defun collect-rune-trigger-pairs-from-fc-activations (acts ans)collect-rune-trigger-pairs-from-fc-activations
2696,124749
+(defun collect-rune-trigger-pairs-from-fc-derivations (fcds ans)collect-rune-trigger-pairs-from-fc-derivations
2706,125248
+(defun prettyify-subst (alist)prettyify-subst
2717,125751
+(defun collect-fc-status-site-1 (rune inst-trigger acts)collect-fc-status-site-1
2724,126024
+(defun collect-fc-status-sites-2-3-5 (rune inst-trigger all-fcdscollect-fc-status-sites-2-3-5
2750,127282
+(defun prettyify-blocked-fc-inst-hyp (inst-hyp hyps unify-subst)prettyify-blocked-fc-inst-hyp
2784,128971
+(defun collect-fc-status-site-4 (rune inst-trigger acts)collect-fc-status-site-4
2803,129775
+(defun collect-fc-status (rune inst-trigger site1 site2 site3 site4 site5)collect-fc-status
2831,131067
+(defun make-fc-activity-report1 (rune-trigger-pairs site1 site2 site3 site4 site5)make-fc-activity-report1
2843,131585
+(defun make-fc-activity-report (call-alist)make-fc-activity-report
2855,132166
+(defun fc-report1 (whs k)fc-report1
2881,133210
+(defun fc-report (k)fc-report
2920,134589
+(defun fc-exit (flg type-alist ttree-or-fc-pairsfc-exit
2954,135612
+(defun advance-fc-activation1advance-fc-activation1
3072,141659
+(defun advance-fc-activation2advance-fc-activation2
3230,148410
+(defun advance-fc-activation3advance-fc-activation3
3462,158532
+(defun advance-fc-activation (act fc-round type-alist ens force-flg wrld state oncep-overrideadvance-fc-activation
3486,159501
+(defun advance-fc-activations (lst fc-round type-alist ens force-flg wrld state oncep-overrideadvance-fc-activations
3511,160540
+(defun fc-pair-lst (fcd-lst)fc-pair-lst
3532,161578
+(defun fc-pair-lst-type-alist (fc-pair-lst fcd-lst type-alist force-flg ens wrld)fc-pair-lst-type-alist
3554,162602
+(defmacro fcd-runep (rune ttree)fcd-runep
3676,168253
+(defun fcd-runep-lst (rune lst)fcd-runep-lst
3687,168794
+(defmacro fcd-worse-than-or-equal (concl fn-cnt p-fn-cnt ttree)fcd-worse-than-or-equal
3693,169041
+(defun fcd-worse-than-or-equal-lst (concl fn-cnt p-fn-cnt lst)fcd-worse-than-or-equal-lst
3705,169640
+(defun exists-fcd-worse-than-or-equal (fcd-lst concl fn-cnt p-fn-cnt)exists-fcd-worse-than-or-equal
3741,171456
+(defun all-dumb-occur-lst (args cl)all-dumb-occur-lst
3757,172181
+(defun all-args-occur-after-strip-not (term cl)all-args-occur-after-strip-not
3762,172344
+(defun approved-fc-derivationp (fcd cl)approved-fc-derivationp
3778,173038
+(defun approve-fc-derivations (new-fcd-lst cl approved-this-round all-approved)approve-fc-derivations
3864,176138
+(defun max-level-no (term wrld)max-level-no
3892,177536
+(defun max-level-no-lst (args wrld)max-level-no-lst
3907,178175
+(defun get-level-no (fn wrld)get-level-no
3912,178338
+(defun sort-approved1-rating1 (term wrld fc vc)sort-approved1-rating1
3926,178638
+(defun sort-approved1-rating1-lst (lst wrld fc vc)sort-approved1-rating1-lst
3944,179487
+(defun sort-approved1-rating (term wrld)sort-approved1-rating
3951,179738
+(defun sort-approved1 (approved wrld)sort-approved1
3969,180665
+(defun sort-approved (approved wrld)sort-approved
3978,180968
+(defun strip-fcd-concls (fcd-lst)strip-fcd-concls
3985,181225
+(defun type-alist-fcd-lst (fcd-lst type-alisttype-alist-fcd-lst
3993,181502
+(defun every-concl-member-equalp (fcd-lst trigger-terms)every-concl-member-equalp
4043,183741
+(defun forward-chain1 (cl fc-round trigger-terms activations type-alist force-flg wrldforward-chain1
4057,184252
+(defun forward-chain-top (caller cl pts force-flg do-not-reconsiderp wrld ensforward-chain-top
4135,188551
+(defun forward-chain (cl pts force-flg do-not-reconsiderp wrld ensforward-chain
4240,193567
+(defun select-forward-chained-concls-and-ttrees (fc-pair-lst pt lits ttree-lst)select-forward-chained-concls-and-ttrees
4258,194442
+(defun rewrite-clause-type-alist (tail new-clause fc-pair-lst rcnst wrldrewrite-clause-type-alist
4532,207276
+(defun maximal-multiples1 (term-lst new-vars avoid-vars pkg-witness)maximal-multiples1
4836,221859
+(defun maximal-multiples (term pkg-witness)maximal-multiples
4850,222355
+(defun lambda-abstract1 (vars terms)lambda-abstract1
4863,222790
+(defun lambda-abstract (term pkg-witness)lambda-abstract
4872,223141
+(defun mutually-exclusive-tests (a b)mutually-exclusive-tests
4889,223660
+(defun mutually-exclusive-subsumptionp (a b c)mutually-exclusive-subsumptionp
4920,224777
+(defun cleanup-if-expr (x trues falses)cleanup-if-expr
4940,225471
+(defun cleanup-if-expr-lst (x trues falses)cleanup-if-expr-lst
4964,226383
+(defun all-type-reasoning-tags-p1 (lemmas)all-type-reasoning-tags-p1
4970,226573
+(defun all-type-reasoning-tags-p (ttree)all-type-reasoning-tags-p
4977,226831
+(defun try-clause (atm clause wrld)try-clause
4980,226935
+(defconst *trivial-non-nil-ttree**trivial-non-nil-ttree*
4995,227362
+(defun make-non-nil-ttree (ttree)make-non-nil-ttree
4998,227414
+(defun try-type-set-and-clause (atm ans ttree ttree0 current-clause wrld enstry-type-set-and-clause
5002,227493
+(defun lambda-subtermp (term)lambda-subtermp
5033,228923
+(defun lambda-subtermp-lst (termlist)lambda-subtermp-lst
5043,229177
+(defun rewrite-atm (atm not-flg bkptr gstack type-alist wrldrewrite-atm
5051,229335
+(defun every-occurrence-equiv-hittablep1every-occurrence-equiv-hittablep1
5432,246164
+(defun every-occurrence-equiv-hittablep1-listpevery-occurrence-equiv-hittablep1-listp
5471,247512
+(defun every-occurrence-equiv-hittablep (equiv old geneqv term ens wrld)every-occurrence-equiv-hittablep
5489,248007
+(defun every-occurrence-equiv-hittablep-in-clausep (equiv old cl ens wrld)every-occurrence-equiv-hittablep-in-clausep
5510,248867
+(defun some-occurrence-equiv-hittablep1 (equiv old geneqv term ens wrld)some-occurrence-equiv-hittablep1
5532,249623
+(defun some-occurrence-equiv-hittablep1-listpsome-occurrence-equiv-hittablep1-listp
5564,250702
+(defun some-occurrence-equiv-hittablep (equiv old geneqv term ens wrld)some-occurrence-equiv-hittablep
5580,251133
+(defun equiv-hittable-in-some-other-lit (equiv term n cl i ens wrld)equiv-hittable-in-some-other-lit
5597,251740
+(defun find-trivial-equivalence1find-trivial-equivalence1
5610,252296
+(defun find-trivial-equivalence (not-just-quotep-flg cl ens wrld avoid-lst)find-trivial-equivalence
5766,260335
+(defun add-literal-and-pt1 (cl-tail pt cl pt-lst)add-literal-and-pt1
5817,262821
+(defun add-literal-and-pt (lit pt cl pt-lst ttree)add-literal-and-pt
5835,263637
+(defun add-binding-to-tag-tree (var term ttree)add-binding-to-tag-tree
5866,264771
+(defun subst-equiv-and-maybe-delete-litsubst-equiv-and-maybe-delete-lit
5880,265299
+(defun remove-trivial-equivalencesremove-trivial-equivalences
5935,268048
+(defrec built-in-clause ((nume . all-fnnames) clause . rune) t)built-in-clause
6006,271892
+(defconst *initial-built-in-clauses**initial-built-in-clauses*
6019,272604
+(defun built-in-clausep2 (bic-lst cl fns ens)built-in-clausep2
6247,281121
+(defun built-in-clausep1 (bic-alist cl fns ens)built-in-clausep1
6260,281711
+(defun possible-trivial-clause-p (cl)possible-trivial-clause-p
6283,282851
+(defun trivial-clause-p (cl wrld)trivial-clause-p
6307,283780
+(defun built-in-clausep (caller cl ens match-free-override wrld state)built-in-clausep
6312,283930
+(defun crunch-clause-segments1 (seg1 pts1 cl pts)crunch-clause-segments1
6385,287747
+(defun crunch-clause-segments2 (cl pts seg1 pts1)crunch-clause-segments2
6425,289938
+(defun crunch-clause-segments (seg1 pts1 seg2 ens wrld state ttree)crunch-clause-segments
6439,290449
+(defun strip-non-rewrittenp-assumptions1 (recs acc)strip-non-rewrittenp-assumptions1
6506,294109
+(defun strip-non-rewrittenp-assumptions (ttree)strip-non-rewrittenp-assumptions
6521,294816
+(defun assumnote-list-to-token-list (assumnote-list)assumnote-list-to-token-list
6538,295548
+(defun resume-suspended-assumption-rewriting1resume-suspended-assumption-rewriting1
6544,295761
+(defun resume-suspended-assumption-rewritingresume-suspended-assumption-rewriting
6702,303689
+(defun helpful-little-ecnt-msg (case-limit ecnt)helpful-little-ecnt-msg
6797,308838
+(defun rewrite-clause (tail pts bkptr gstack new-clause fc-pair-lst wrldrewrite-clause
6811,309213
+(defun rewrite-clause-lst (segs bkptr gstack cdr-tail cdr-pts new-clauserewrite-clause-lst
7169,326436
+(defun setup-simplify-clause-pot-lst1 (cl ttrees type-alist rcnst wrld statesetup-simplify-clause-pot-lst1
7237,329276
+(defun setup-simplify-clause-pot-lst (cl ttrees fc-pair-lstsetup-simplify-clause-pot-lst
7270,330611
+(defun sequential-subst-var-term (alist term)sequential-subst-var-term
7357,333898
+(defun process-equational-polysprocess-equational-polys
7369,334364
+(defun enumerate-elements (lst i)enumerate-elements
7548,342989
+(defun already-used-by-fertilize-clausep (lit hist get-clause-id)already-used-by-fertilize-clausep
7552,343110
+(defun unhidden-lit-info (hist clause pos wrld)unhidden-lit-info
7569,343969
+(defun tilde-@-hyp-phrase (len-tail cl)tilde-@-hyp-phrase
7588,344821
+(defun simplify-clause1 (top-clause hist rcnst wrld state step-limit)simplify-clause1
7617,345931
+(defun some-element-dumb-occur-lst (lst1 lst2)some-element-dumb-occur-lst
7795,354551
+(defrec prove-spec-varprove-spec-var
7808,355121
+(defrec gag-infogag-info
7835,356297
+(defrec gag-stategag-state
7851,356859
+(defconst *initial-gag-state**initial-gag-state*
7859,357255
+(defconst *empty-prove-spec-var**empty-prove-spec-var*
7867,357428
+(defun controller-unify-subst2 (vars acc)controller-unify-subst2
7882,357830
+(defun controller-unify-subst1 (actuals controllers acc)controller-unify-subst1
7889,358069
+(defun controller-unify-subst (name term def-body)controller-unify-subst
7897,358402
+(defun filter-disabled-expand-terms (terms ens wrld)filter-disabled-expand-terms
7904,358703
+(defun found-hit-rewrite-hist-entry (hist)found-hit-rewrite-hist-entry
7985,362752
+(defabbrev append? (x y)append?
7999,363321
+(defun simplify-clause (cl hist pspv wrld state step-limit)simplify-clause
8003,363395
+(defun settled-down-clause (clause hist pspv wrld state)settled-down-clause
8357,381955
+(defun member-class-name-runes (class name runes)member-class-name-runes
8380,382927
+(defun extract-and-classify-lemmas2 (names class ignore-lst if-intro case-splitextract-and-classify-lemmas2
8388,383200
+(defun extract-and-classify-lemmas1 (class-alist ignore-lst if-intro case-splitextract-and-classify-lemmas1
8413,384498
+(defun runes-to-class-alist1 (runes alist)runes-to-class-alist1
8430,385265
+(defun strict-merge-symbol-< (l1 l2 acc)strict-merge-symbol-<
8444,385897
+(defun strict-merge-sort-symbol-< (l)strict-merge-sort-symbol-<
8465,386730
+(defun strict-symbol-<-sortedp (x)strict-symbol-<-sortedp
8482,387241
+(defun sort-symbol-listp (x)sort-symbol-listp
8489,387469
+(defun strict-merge-sort-symbol-<-cdrs (alist)strict-merge-sort-symbol-<-cdrs
8495,387637
+(defun runes-to-class-alist (runes)runes-to-class-alist
8501,387871
+(defun extract-and-classify-lemmas (ttree ignore-lst forced-runes)extract-and-classify-lemmas
8508,388063
+(deflabel SimpleSimple
8540,389455
+(defun tilde-*-conjunction-of-possibly-forced-names-phrase1 (alist)tilde-*-conjunction-of-possibly-forced-names-phrase1
8573,390850
+(defun tilde-*-conjunction-of-possibly-forced-names-phrase (lst)tilde-*-conjunction-of-possibly-forced-names-phrase
8587,391398
+(defconst *fake-rune-alist**fake-rune-alist*
8602,392001
+(defun rune-< (x y)rune-<
8615,392464
+(defun merge-runes (l1 l2)merge-runes
8630,392822
+(defun merge-sort-runes (l)merge-sort-runes
8637,393040
+(defun tilde-*-simp-phrase1 (alist abbreviations-flg)tilde-*-simp-phrase1
8642,393205
+(defun tilde-*-raw-simp-phrase1 (runes forced-runes punct ignore-lst phrasetilde-*-raw-simp-phrase1
8772,398347
+(defun recover-forced-runes1 (recs ans)recover-forced-runes1
8821,400637
+(defun recover-forced-runes (ttree)recover-forced-runes
8833,401014
+(defun tilde-*-raw-simp-phrase (ttree punct phrase)tilde-*-raw-simp-phrase
8845,401555
+(defun tilde-*-simp-phrase (ttree)tilde-*-simp-phrase
8872,402507
+(defun tilde-@-pool-name-phrase (forcing-round pool-lst)tilde-@-pool-name-phrase
8904,403928
+(defun tilde-@-pool-name-phrase-lst (forcing-round lst)tilde-@-pool-name-phrase-lst
8942,405866
+(defun tilde-@-clause-id-phrase (id)tilde-@-clause-id-phrase
8947,406092
+(defrec bddnotebddnote
9036,409059
+(defun tilde-@-bddnote-phrase (x)tilde-@-bddnote-phrase
9040,409160
+(defun parse-natural1 (str i maximum ans)parse-natural1
9054,409673
+(defun parse-natural (dflg str i maximum)parse-natural
9080,410625
+(defun parse-dotted-naturals (dflg str i maximum ans)parse-dotted-naturals
9101,411431
+(defun parse-match (pat j patmax str i strmax)parse-match
9137,413109
+(defun parse-primes (str i maximum)parse-primes
9151,413672
+(defun parse-clause-id2 (forcing-round pool-lst str i maximum)parse-clause-id2
9177,414655
+(defun parse-clause-id1 (forcing-round str i maximum)parse-clause-id1
9207,415667
+(defun parse-clause-id (str)parse-clause-id
9272,417946
+(defun tilde-@-case-split-limitations-phrase (sr-flg case-flg prefix)tilde-@-case-split-limitations-phrase
9310,419249
+(defun simplify-clause-msg1 (signal cl-id clauses speciousp ttree pspv state)simplify-clause-msg1
9325,419791
+(deflabel specious-simplificationspecious-simplification
9447,426022
+(defun settled-down-clause-msg1 (signal clauses ttree pspv state)settled-down-clause-msg1
9559,431610
+
+bdd.lisp,8083
+(defmacro mvf (x &rest rest)mvf
45,1569
+(defmacro logandf (&rest args)logandf
57,2133
+(defmacro logxorf (&rest args)logxorf
60,2201
+(defmacro logiorf (&rest args)logiorf
63,2268
+(defmacro ashf (x y)ashf
66,2335
+(defmacro mx-id-bound ()mx-id-bound
70,2441
+(defmacro 1+mx-id (x)1+mx-id
78,2692
+(defmacro bdd-error (mx-id fmt-string fmt-alist bad-cst ttree)bdd-error
125,4696
+(defmacro unique-id (x) `(the-fixnum (car ,x)))unique-id
207,8076
+(defmacro tst (x) `(cadr ,x)) ;a cst, not a number; but beware since tst=trmtst
209,8125
+(defmacro cst-boolp (x) `(caddr ,x))cst-boolp
215,8415
+(defmacro tbr (x) `(cadddr ,x))tbr
217,8453
+(defmacro fbr (x) `(cddddr ,x))fbr
218,8485
+(defmacro leafp (x)leafp
220,8518
+(defmacro trm (x) `(cadr ,x))trm
223,8561
+(defun bdd-constructors (wrld)bdd-constructors
225,8592
+(defun make-leaf-cst (unique-id trm boolp)make-leaf-cst
235,8944
+(defun evg-fn-symb (x)evg-fn-symb
245,9246
+(defun bdd-constructor-trm-p (trm bdd-constructors)bdd-constructor-trm-p
274,10233
+(defun evg-type (x)evg-type
280,10446
+(defun make-if-cst (unique-id tst tbr fbr bdd-constructors)make-if-cst
296,10986
+(defconst *cst-t*   (make-leaf-cst 1 *t* t))*cst-t*
355,13913
+(defconst *cst-nil* (make-leaf-cst 2 *nil* t))*cst-nil*
356,13958
+(defmacro cst= (cst1 cst2)cst=
358,14006
+(defmacro cst-tp (cst)cst-tp
362,14084
+(defmacro cst-nilp (cst)cst-nilp
365,14135
+(defmacro cst-varp (cst)cst-varp
368,14188
+(defun cst-nonnilp (cst)cst-nonnilp
371,14241
+(defun bool-mask1 (formals vars rune)bool-mask1
395,15298
+(defun boolean-term-var (x)boolean-term-var
412,16118
+(defun boolean-hyps-vars (hyps)boolean-hyps-vars
445,17302
+(defun first-boolean-type-prescription (type-prescription-list ens formals)first-boolean-type-prescription
460,17682
+(defun recognizer-rune (fn recognizer-alist wrld ens)recognizer-rune
495,19293
+(defun bool-mask (fn recognizer-alist wrld ens)bool-mask
505,19719
+(defun commutative-p1 (fn lemmas ens)commutative-p1
549,21308
+(defun find-equivalence-rune (fn rules)find-equivalence-rune
578,22704
+(defun equivalence-rune1 (fn congruences)equivalence-rune1
589,23057
+(defun equivalence-rune (fn wrld)equivalence-rune
616,24053
+(defun commutative-p (fn ens wrld)commutative-p
626,24424
+(defun op-alist (fns acc i ens wrld)op-alist
643,25062
+(defun op-alist-info (fn op-alist)op-alist-info
679,26597
+(defmacro if-op-code () 3)if-op-code
702,27209
+(defmacro hash-size ()hash-size
704,27237
+(defmacro if-hash-index (x y z)if-hash-index
731,28315
+(defun op-hash-index1 (args i acc)op-hash-index1
743,28736
+(defmacro op-hash-index (op-code args)op-hash-index
770,29783
+(defmacro op-hash-index-2 (op-code arg1 arg2)op-hash-index-2
775,29918
+(defmacro op-hash-index-if (arg1 arg2 arg3)op-hash-index-if
785,30189
+(defun if-search-bucket (x y z lst)if-search-bucket
795,30500
+(defun cst=-lst (x y)cst=-lst
806,30790
+(defmacro eq-op (x y)eq-op
812,30913
+(defun op-search-bucket (op args lst)op-search-bucket
818,31020
+(defun op-search-bucket-2 (op arg1 arg2 lst)op-search-bucket-2
831,31499
+(defun op-search-bucket-if (arg1 arg2 arg3 lst)op-search-bucket-if
848,32233
+(defun chk-memo (op-code op args op-ht)chk-memo
864,32847
+(defun chk-memo-2 (op-code op arg1 arg2 op-ht)chk-memo-2
882,33516
+(defun chk-memo-if (arg1 arg2 arg3 op-ht)chk-memo-if
898,34050
+(defmacro half-hash-size ()half-hash-size
918,34764
+(defmacro fourth-hash-size ()fourth-hash-size
921,34818
+(defun op-hash-index-string (index acc string)op-hash-index-string
924,34874
+(defun op-hash-index-evg (evg)op-hash-index-evg
937,35270
+(defun op-search-bucket-quote (evg bucket)op-search-bucket-quote
970,36309
+(defun chk-memo-quotep (term op-ht)chk-memo-quotep
978,36584
+(defun bdd-quotep (term op-ht mx-id)bdd-quotep
994,37068
+(defmacro bdd-quotep+ (term op-ht if-ht mx-id ttree)bdd-quotep+
1027,38179
+(defrec bdd-rulebdd-rule
1044,38998
+(defun rewrite-rule-to-bdd-rule (lemma)rewrite-rule-to-bdd-rule
1048,39040
+(defun bdd-rules-alist1bdd-rules-alist1
1054,39242
+(defun extra-rules-for-bdds (fn wrld)extra-rules-for-bdds
1132,43377
+(defun bdd-rules-alist (fns all-fns bdd-rules-alist ens wrld)bdd-rules-alist
1199,46029
+(defmacro one-way-unify1-cst-2 (mx-id p1 p2 cst1 cst2 alist op-ht)one-way-unify1-cst-2
1261,48649
+(defmacro one-way-unify1-cst-3 (mx-id p1 p2 p3 cst1 cst2 cst3 alist op-ht)one-way-unify1-cst-3
1275,49267
+(defun one-way-unify1-cst (mx-id pat cst alist op-ht)one-way-unify1-cst
1293,49997
+(defun one-way-unify1-cst-lst (mx-id pl cstl alist op-ht)one-way-unify1-cst-lst
1474,60842
+(defun one-way-unify1-cst-equal (mx-id pat1 pat2 cst1 cst2 alist op-ht)one-way-unify1-cst-equal
1492,61495
+(defun some-one-way-unify-cst-lst (cst-lst rules op-ht mx-id ttree)some-one-way-unify-cst-lst
1506,61984
+(defun leaf-cst-list (lst bool-vars acc mx-id)leaf-cst-list
1535,63135
+(defun decode-cst (cst cst-array)decode-cst
1557,63988
+(defun decode-cst-lst (cst-lst cst-array)decode-cst-lst
1595,65259
+(defun decode-cst-alist1 (alist cst-array)decode-cst-alist1
1607,65626
+(defun decode-cst-alist (cst-alist cst-array)decode-cst-alist
1619,66074
+(defun leaf-cst-list-array (mx-id)leaf-cst-list-array
1625,66256
+(defconst *some-non-nil-value* "Some non-nil value")*some-non-nil-value*
1632,66487
+(defun falsifying-assignment1 (cst acc cst-array)falsifying-assignment1
1634,66541
+(defun falsifying-assignment (cst mx-id)falsifying-assignment
1671,67928
+(defun make-if (mx-id n op args x y z op-ht if-ht bdd-constructors)make-if
1681,68289
+(defun make-if-no-memo (mx-id x y z op-ht if-ht bdd-constructors)make-if-no-memo
1760,71876
+(defmacro split-var (cst)split-var
1794,73155
+(defun min-var (acc args)min-var
1807,73494
+(defun combine-op-csts1 (var-id args)combine-op-csts1
1827,74082
+(defun bool-flg (args mask)bool-flg
1860,75605
+(defun some-bdd-constructorp (args bdd-constructors)some-bdd-constructorp
1882,76256
+(defun combine-op-csts-simplecombine-op-csts-simple
1889,76513
+(defmacro bdd-mv-let (vars form body)bdd-mv-let
1941,78444
+(defmacro combine-if-csts+ (cst1 cst2 cst3 op-ht if-ht mx-id bdd-constructors)combine-if-csts+
2004,80869
+(defun combine-if-csts1 (var-id args)combine-if-csts1
2013,81192
+(defun combine-if-cstscombine-if-csts
2033,81917
+(defun cst-list-to-evg-list (cst-lst)cst-list-to-evg-list
2111,85081
+(defun cst-quote-listp (cst-lst)cst-quote-listp
2117,85244
+(defrec bddspvbddspv
2125,85428
+(defun bdd-ev-fncallbdd-ev-fncall
2136,85831
+(defmacro combine-op-csts+ (mx-id comm-p enabled-exec-p op-code op mask args op-htcombine-op-csts+
2166,87051
+(defun make-if-for-opmake-if-for-op
2184,87998
+(defun combine-op-csts (mx-id enabled-exec-p op-code op mask args op-htcombine-op-csts
2234,89514
+(defun combine-op-csts-comm (mx-id comm-p enabled-exec-p op-code op mask arg1combine-op-csts-comm
2264,90648
+(defun combine-op-csts-gutscombine-op-csts-guts
2341,93875
+(defun bdd (term alist op-ht if-ht mx-id ttree bddspv state)bdd
2462,99048
+(defun bdd-alist (formals actuals alist op-ht if-ht mx-id ttree bddspv state)bdd-alist
2583,103825
+(defun bdd-list (lst alist op-ht if-ht mx-id ttree bddspv state)bdd-list
2602,104549
+(defun if-ht-max-length (state)if-ht-max-length
2629,105483
+(defun op-ht-max-length (state)op-ht-max-length
2634,105638
+(defun leaf-cst-list-to-alist (leaf-cst-list)leaf-cst-list-to-alist
2639,105793
+(defvar *request-bigger-fixnum-table**request-bigger-fixnum-table*
2653,106221
+(defun bdd-top (term input-vars bool-vars bdd-constructors cl-id ens state)bdd-top
2656,106311
+(defun get-bool-vars (vars type-alist ttree acc)get-bool-vars
2764,111984
+(defun bdd-clause1 (hint-alist type-alist cl position ttree0 cl-id ens wrldbdd-clause1
2782,112589
+(defmacro expand-and-or-simple+expand-and-or-simple+
2908,118017
+(defun expand-and-or-simpleexpand-and-or-simple
2920,118482
+(defun expand-clauseexpand-clause
3067,124978
+(defun bdd-clause (bdd-hint cl-id top-clause pspv wrld state)bdd-clause
3092,125980
+(deflabel obddobdd
3208,131943
+(deflabel bdd-algorithmbdd-algorithm
3216,132097
+(deflabel bdd-introductionbdd-introduction
3726,157290
+
+other-processes.lisp,6751
+(defun strip-final-digits1 (lst)strip-final-digits1
30,1253
+(defun strip-final-digits (str)strip-final-digits
51,2117
+(defconst *var-families-by-type**var-families-by-type*
76,3315
+(defun assoc-ts-subsetp (ts alist)assoc-ts-subsetp
97,4014
+(defun first-non-member-eq (lst1 lst2)first-non-member-eq
107,4281
+(defun abbreviate-hyphenated-string1 (str i maximum prev-c)abbreviate-hyphenated-string1
120,4689
+(defun abbreviate-hyphenated-string (str)abbreviate-hyphenated-string
147,5788
+(defun generate-variable-root1 (term avoid-lst type-alist ens wrld)generate-variable-root1
164,6375
+(defun generate-variable-root (term avoid-lst type-alist ens wrld)generate-variable-root
225,8865
+(defun generate-variable (term avoid-lst type-alist ens wrld)generate-variable
244,9569
+(defun generate-variable-lst (term-lst avoid-lst type-alist ens wrld)generate-variable-lst
256,10121
+(defrec elim-ruleelim-rule
290,11827
+(defun occurs-nowhere-else (var args c i)occurs-nowhere-else
296,11965
+(defun first-nomination (term votes nominations)first-nomination
308,12364
+(defun second-nomination (term votes nominations)second-nomination
315,12532
+(defun some-hyp-probably-nilp (hyps type-alist ens wrld)some-hyp-probably-nilp
328,12953
+(defun sublis-expr (alist term)sublis-expr
354,13821
+(defun sublis-expr-lst (alist lst)sublis-expr-lst
372,14513
+(defun nominate-destructor-candidatenominate-destructor-candidate
379,14679
+(defun nominate-destructor-candidatesnominate-destructor-candidates
504,21176
+(defun nominate-destructor-candidates-lstnominate-destructor-candidates-lst
527,22004
+(defun sum-level-nos (lst wrld)sum-level-nos
554,23112
+(defun pick-highest-sum-level-nos (nominations wrld dterm max-score)pick-highest-sum-level-nos
570,23777
+(defun select-instantiated-elim-rule (clause type-alist eliminables ens wrld)select-instantiated-elim-rule
589,24561
+(defun type-restriction-segment (cl terms vars type-alist ens wrld)type-restriction-segment
640,27174
+(defun subterm-one-way-unify (pat term)subterm-one-way-unify
736,31670
+(defun subterm-one-way-unify-lst (pat-lst term)subterm-one-way-unify-lst
749,32208
+(defrec generalize-rule (nume formula . rune) nil)generalize-rule
759,32501
+(defun apply-generalize-rule (gen-rule term ens)apply-generalize-rule
761,32553
+(defun generalize-rule-segment1 (generalize-rules term ens)generalize-rule-segment1
800,34317
+(defun generalize-rule-segment (terms vars ens wrld)generalize-rule-segment
822,35419
+(defun generalize1 (cl type-alist terms vars ens wrld)generalize1
846,36598
+(defun apply-instantiated-elim-rule (rule cl type-alist avoid-vars ens wrld)apply-instantiated-elim-rule
879,38225
+(defun eliminate-destructors-clause1 (cl eliminables avoid-vars ens wrldeliminate-destructors-clause1
995,44107
+(defun owned-vars (process mine-flg history)owned-vars
1140,51274
+(defun eliminate-destructors-clause (clause hist pspv wrld state)eliminate-destructors-clause
1219,55508
+(defun prettyify-clause1 (cl wrld)prettyify-clause1
1253,57158
+(defun prettyify-clause2 (cl wrld)prettyify-clause2
1258,57344
+(defun prettyify-clause (cl let*-abstractionp wrld)prettyify-clause
1272,57954
+(defun prettyify-clause-lst (clauses let*-abstractionp wrld)prettyify-clause-lst
1285,58505
+(defun prettyify-clause-set (clauses let*-abstractionp wrld)prettyify-clause-set
1291,58789
+(defun tilde-*-elim-phrase/alist1 (alist wrld)tilde-*-elim-phrase/alist1
1297,59054
+(defun tilde-*-elim-phrase/alist (alist wrld)tilde-*-elim-phrase/alist
1304,59325
+(defun tilde-*-elim-phrase3 (var-to-runes-alist)tilde-*-elim-phrase3
1316,59769
+(defun tilde-*-elim-phrase2 (alist restricted-vars var-to-runes-alist ttree wrld)tilde-*-elim-phrase2
1324,60172
+(defun tilde-*-elim-phrase1 (lst i already-used wrld)tilde-*-elim-phrase1
1351,61496
+(defun tilde-*-elim-phrase (lst wrld)tilde-*-elim-phrase
1384,63126
+(defun tilde-*-untranslate-lst-phrase (lst flg wrld)tilde-*-untranslate-lst-phrase
1404,63744
+(defun eliminate-destructors-clause-msg1 (signal clauses ttree pspv state)eliminate-destructors-clause-msg1
1409,63890
+(defun almost-quotep1 (term)almost-quotep1
1462,66324
+(defun almost-quotep1-listp (terms)almost-quotep1-listp
1473,66697
+(defun almost-quotep (term)almost-quotep
1480,66862
+(defun destructor-applied-to-varsp (term ens wrld)destructor-applied-to-varsp
1492,67217
+(defun dumb-occur-lst-except (term lst lit)dumb-occur-lst-except
1509,67900
+(defun fertilize-feasible (lit cl hist term ens wrld)fertilize-feasible
1527,68709
+(defun fertilize-complexity (term wrld)fertilize-complexity
1545,69499
+(defun maximize-fertilize-complexity (terms wrld)maximize-fertilize-complexity
1555,69834
+(defun first-fertilize-lit (lst cl hist ens wrld)first-fertilize-lit
1562,70038
+(defun cross-fertilizep/c (equiv cl direction lhs1 rhs1)cross-fertilizep/c
1596,71602
+(defun cross-fertilizep/d (equiv cl direction lhs1 rhs1)cross-fertilizep/d
1610,72093
+(defun cross-fertilizep (equiv cl pspv direction lhs1 rhs1)cross-fertilizep
1624,72584
+(defun delete-from-ttree (tag val ttree)delete-from-ttree
1649,73901
+(defun fertilize-clause1 (cl lit1 equiv lhs1 rhs1fertilize-clause1
1661,74427
+(defun fertilize-clause (cl-id cl hist pspv wrld state)fertilize-clause
1865,84067
+(defun fertilize-clause-msg1 (signal clauses ttree pspv state)fertilize-clause-msg1
1953,88534
+(defun collectable-fnp (fn ens wrld)collectable-fnp
1998,90495
+(defun smallest-common-subterms1 (term1 term2 ens wrld ans)smallest-common-subterms1
2016,91124
+(defun smallest-common-subterms1-lst (terms term2 ens wrld ans)smallest-common-subterms1-lst
2077,93556
+(defun dumb-fn-count-1 (flg x acc)dumb-fn-count-1
2098,94237
+(defun dumb-fn-count (x)dumb-fn-count
2112,94766
+(defun smallest-common-subterms (term1 term2 ens wrld ans)smallest-common-subterms
2135,95655
+(defun generalizing-relationp (term wrld)generalizing-relationp
2151,96368
+(defun generalizable-terms-across-relations (cl ens wrld ans)generalizable-terms-across-relations
2182,97735
+(defun generalizable-terms-across-literals1 (lit1 cl ens wrld ans)generalizable-terms-across-literals1
2197,98356
+(defun generalizable-terms-across-literals (cl ens wrld ans)generalizable-terms-across-literals
2203,98602
+(defun generalizable-terms (cl ens wrld)generalizable-terms
2215,99081
+(defun generalize-clause (cl hist pspv wrld state)generalize-clause
2226,99435
+(defun tilde-*-gen-phrase/alist1 (alist wrld)tilde-*-gen-phrase/alist1
2307,103268
+(defun tilde-*-gen-phrase/alist (alist wrld)tilde-*-gen-phrase/alist
2314,103537
+(defun tilde-*-gen-phrase (alist restricted-vars var-to-runes-alist ttree wrld)tilde-*-gen-phrase
2322,103706
+(defun generalize-clause-msg1 (signal clauses ttree pspv state)generalize-clause-msg1
2376,106558
+
+induct.lisp,9977
+(defun select-x-cl-set (cl-set induct-hint-val)select-x-cl-set
23,881
+(defun unchangeables (formals args quick-block-info subset ans)unchangeables
35,1336
+(defun changeables (formals args quick-block-info subset ans)changeables
50,1930
+(defun sound-induction-principle-mask1 (formals args quick-block-infosound-induction-principle-mask1
66,2516
+(defun sound-induction-principle-mask (term formals quick-block-info subset)sound-induction-principle-mask
104,4307
+(defrec candidatecandidate
162,7269
+(defun count-non-nils (lst)count-non-nils
209,10209
+(defun controllers (formals args subset ans)controllers
214,10354
+(defun changed/unchanged-vars (x args mask ans)changed/unchanged-vars
221,10637
+(defrec tests-and-alists (tests alists) nil)tests-and-alists
228,10925
+(defun tests-and-alists/alist (alist args mask call-args)tests-and-alists/alist
230,10971
+(defun tests-and-alists/alists (alist args mask calls)tests-and-alists/alists
257,12146
+(defrec tests-and-calls (tests . calls) nil)tests-and-calls
279,13169
+(defrec justificationjustification
294,14018
+(defun tests-and-alists (alist args mask tc)tests-and-alists
299,14132
+(defun tests-and-alists-lst (alist args mask machine)tests-and-alists-lst
315,14877
+(defun flesh-out-induction-principle (term formals justification mask machineflesh-out-induction-principle
327,15346
+(defun intrinsic-suggested-induction-candintrinsic-suggested-induction-cand
364,16488
+(defrec induction-rule (nume (pattern . condition) scheme . rune) nil)induction-rule
404,18660
+(defun apply-induction-rule (rule term type-alist xterm ttree seen ens wrld)apply-induction-rule
408,18751
+(defun suggested-induction-cands1suggested-induction-cands1
518,22845
+(defun suggested-induction-candssuggested-induction-cands
577,25248
+(defun get-induction-cands (term type-alist ens wrld ans)get-induction-cands
601,26255
+(defun get-induction-cands-lst (lst type-alist ens wrld ans)get-induction-cands-lst
617,26774
+(defun get-induction-cands-from-cl-set1 (cl-set ens oncep-override wrld stateget-induction-cands-from-cl-set1
632,27150
+(defun get-induction-cands-from-cl-set (cl-set pspv wrld state)get-induction-cands-from-cl-set
659,28281
+(defun pigeon-holep-apply (fn pigeon hole)pigeon-holep-apply
694,29800
+(defun pigeon-holep (pigeons holes filled-holes fn)pigeon-holep
736,31588
+(defun pigeon-holep1 (pigeon pigeons lst n holes filled-holes fn)pigeon-holep1
755,32410
+(defun flush-cand1-down-cand2 (cand1 cand2)flush-cand1-down-cand2
776,33110
+(defun flush-candidates (cand1 cand2)flush-candidates
812,34945
+(defun alists-agreep (alist1 alist2 vars)alists-agreep
837,36181
+(defun irreconcilable-alistsp (alist1 alist2)irreconcilable-alistsp
850,36682
+(defun affinity (aff alist1 alist2 vars)affinity
868,37448
+(defun member-affinity (aff alist alist-lst vars)member-affinity
881,37921
+(defun occur-affinity (aff alist lst vars)occur-affinity
890,38209
+(defun some-occur-affinity (aff alists lst vars)some-occur-affinity
906,38779
+(defun all-occur-affinity (aff alists lst vars)all-occur-affinity
915,39113
+(defun contains-affinity (aff lst vars)contains-affinity
924,39446
+(defun antagonistic-tests-and-alists-lstp (lst vars)antagonistic-tests-and-alists-lstp
937,39933
+(defun antagonistic-tests-and-alists-lstsp (lst1 lst2 vars)antagonistic-tests-and-alists-lstsp
963,40864
+(defun every-alist1-matedp (lst1 lst2 vars)every-alist1-matedp
978,41349
+(defun merge-alist1-into-alist2 (alist1 alist2 vars)merge-alist1-into-alist2
999,42274
+(defun merge-alist1-lst-into-alist2 (alist1-lst alist2 vars)merge-alist1-lst-into-alist2
1020,43207
+(defun merge-lst1-into-alist2 (lst1 alist2 vars)merge-lst1-into-alist2
1034,43679
+(defun merge-lst1-into-alist2-lst (lst1 alist2-lst vars)merge-lst1-into-alist2-lst
1050,44156
+(defun merge-lst1-into-lst2 (lst1 lst2 vars)merge-lst1-into-lst2
1055,44392
+(defun merge-tests-and-alists-lsts (lst1 lst2 vars)merge-tests-and-alists-lsts
1065,44803
+(defun merge-cand1-into-cand2 (cand1 cand2)merge-cand1-into-cand2
1146,49374
+(defun merge-candidates (cand1 cand2)merge-candidates
1244,54737
+(defun controller-variables1 (args controller-pocket)controller-variables1
1259,55207
+(defun controller-variables (term controller-alist)controller-variables
1274,55837
+(defun induct-vars1 (lst wrld)induct-vars1
1288,56542
+(defun induct-vars (cand wrld)induct-vars
1302,56966
+(defun vetoedp (cand vars lst changed-vars-flg)vetoedp
1321,57713
+(defun compute-vetoes1 (lst cand-lst wrld)compute-vetoes1
1345,58716
+(defun compute-vetoes2 (lst cand-lst)compute-vetoes2
1367,59557
+(defun compute-vetoes (cand-lst wrld)compute-vetoes
1383,60108
+(defun induction-complexity1 (lst wrld)induction-complexity1
1447,63447
+(defun maximal-elements-apply (fn x wrld)maximal-elements-apply
1465,64260
+(defun maximal-elements1 (lst winners maximum fn wrld)maximal-elements1
1478,64700
+(defun maximal-elements (lst fn wrld)maximal-elements
1503,65735
+(defun intersectp-eq/union-equal (x y)intersectp-eq/union-equal
1527,66628
+(defun equal/union-equal (x y)equal/union-equal
1533,66816
+(defun subsetp-equal/smaller (x y)subsetp-equal/smaller
1539,66969
+(defun m&m-apply (fn x y)m&m-apply
1544,67087
+(defun count-off (n lst)count-off
1557,67604
+(defun m&m-search (x y-lst del fn)m&m-search
1565,67810
+(defun m&m1 (pairs del ans n fn)m&m1
1583,68570
+(defun m&m (bag fn)m&m
1634,70709
+(defun cons-subset-tree (x y)cons-subset-tree
1719,75214
+(defabbrev car-subset-tree (x)car-subset-tree
1736,75638
+(defabbrev cdr-subset-tree (x)cdr-subset-tree
1742,75723
+(defun or-subset-trees (tree1 tree2)or-subset-trees
1748,75808
+(defun m&m-over-powerset1 (st subset stree ans fn)m&m-over-powerset1
1760,76306
+(defun m&m-over-powerset (st fn)m&m-over-powerset
1786,77103
+(defun all-picks2 (pocket pick ans)all-picks2
1895,82378
+(defun all-picks2r (pocket pick ans)all-picks2r
1901,82558
+(defun all-picks1 (pocket picks ans rflg)all-picks1
1907,82747
+(defun all-picks (pockets rflg)all-picks
1916,83066
+(defun dumb-negate-lit-lst-lst (cl-set)dumb-negate-lit-lst-lst
1957,85038
+(defun induction-hyp-clause-segments2 (alists cl ans)induction-hyp-clause-segments2
1969,85533
+(defun induction-hyp-clause-segments1 (alists cl-set ans)induction-hyp-clause-segments1
1975,85778
+(defun induction-hyp-clause-segments (alists cl-set)induction-hyp-clause-segments
1987,86196
+(defun induction-formula3 (neg-tests hyp-segments cl ans)induction-formula3
2023,87958
+(defun induction-formula2 (cl cl-set ta-lst ans)induction-formula2
2066,89723
+(defun induction-formula1 (lst cl-set ta-lst ans)induction-formula1
2095,90969
+(defun induction-formula (cl-set ta-lst)induction-formula
2111,91721
+(defun all-picks-size (cl-set)all-picks-size
2183,94929
+(defun induction-formula-size1 (hyps-size concl-size ta-lst)induction-formula-size1
2190,95132
+(defun induction-formula-size (cl-set ta-lst)induction-formula-size
2206,95866
+(defconst *maximum-induct-size* 100)*maximum-induct-size*
2221,96462
+(defun termify-clause-set (clauses)termify-clause-set
2226,96584
+(defun inform-simplify3 (alist terms ans)inform-simplify3
2243,97257
+(defun inform-simplify2 (alists terms ans)inform-simplify2
2252,97576
+(defun inform-simplify1 (ta-lst terms ans)inform-simplify1
2262,97864
+(defun inform-simplify (ta-lst terms pspv)inform-simplify
2276,98433
+(defun all-vars1-lst-lst (lst ans)all-vars1-lst-lst
2327,101319
+(defun gen-new-name1 (char-lst wrld i)gen-new-name1
2336,101620
+(defun gen-new-name (root wrld)gen-new-name
2346,101945
+(defun unmeasured-variables3 (vars alist)unmeasured-variables3
2354,102177
+(defun unmeasured-variables2 (vars alists)unmeasured-variables2
2362,102489
+(defun unmeasured-variables1 (vars ta-lst)unmeasured-variables1
2368,102719
+(defun unmeasured-variables (measured-vars cand)unmeasured-variables
2377,103131
+(defun tilde-@-well-founded-relation-phrase (rel wrld)tilde-@-well-founded-relation-phrase
2388,103620
+(defun measured-variables (cand wrld)measured-variables
2406,104367
+(defun induct-msg/continue (pool-lstinduct-msg/continue
2416,104756
+(defun rec-fnnames (term wrld)rec-fnnames
2597,113148
+(defun rec-fnnames-lst (lst wrld)rec-fnnames-lst
2608,113630
+(defun induct-msg/lose (pool-name induct-hint-val state)induct-msg/lose
2615,113801
+(defun@par load-hint-settings-into-rcnst (hint-settings rcnst cl-id wrld ctxload-hint-settings-into-rcnst
2677,116943
+(defun update-hint-settings (new-hint-settings old-hint-settings)update-hint-settings
2747,120320
+(defun@par load-hint-settings-into-pspv (increment-flg hint-settings pspv cl-idload-hint-settings-into-pspv
2762,120885
+(defun restore-hint-settings-in-pspv (new-pspv old-pspv)restore-hint-settings-in-pspv
2795,122351
+(defun remove-trivial-clauses (clauses wrld)remove-trivial-clauses
2834,124475
+(defun non-standard-vector-check (vars accum)non-standard-vector-check
2843,124755
+(defun merge-ns-check (checks clause accum)merge-ns-check
2851,125019
+(defun trap-non-standard-vector-aux (cl-set accum-cl checks wrld)trap-non-standard-vector-aux
2859,125302
+(defun remove-adjacent-duplicates (lst)remove-adjacent-duplicates
2873,125997
+(defun non-standard-induction-vars (candidate wrld)non-standard-induction-vars
2880,126272
+(defun trap-non-standard-vector (cl-set candidate accum-cl wrld)trap-non-standard-vector
2892,126696
+(defun induct (forcing-round pool-lst cl-set hint-settings pspv wrld ctx state)induct
2900,127058
+(defun pair-vars-with-lits (cl)pair-vars-with-lits
3091,135667
+(defun ffnnames-subsetp (term lst)ffnnames-subsetp
3104,136009
+(defun ffnnames-subsetp-listp (terms lst)ffnnames-subsetp-listp
3118,136513
+(defun probably-not-validp (cl)probably-not-validp
3128,136793
+(defun irrelevant-lits (alist)irrelevant-lits
3161,138369
+(defun eliminate-irrelevance-clause (cl hist pspv wrld state)eliminate-irrelevance-clause
3173,138852
+(defun eliminate-irrelevance-clause-msg1 (signal clauses ttree pspv state)eliminate-irrelevance-clause-msg1
3203,140170
+
+history-management.lisp,53405
+(defrec goal-tree (children processor cl-id . fanout) nil)goal-tree
37,1262
+(deflabel proof-treeproof-tree
95,4572
+(deflabel proof-tree-examplesproof-tree-examples
181,8507
+(defun start-proof-tree-fn (remove-inhibit-p state)start-proof-tree-fn
452,18636
+(defmacro start-proof-tree ()start-proof-tree
465,19018
+(defmacro start-proof-tree ()start-proof-tree
494,20059
+(defmacro checkpoint-forced-goals (val)checkpoint-forced-goals
504,20350
+(defun stop-proof-tree-fn (state)stop-proof-tree-fn
526,21134
+(defmacro stop-proof-tree ()stop-proof-tree
532,21345
+(deflabel proof-tree-detailsproof-tree-details
560,22404
+(defun insert-into-goal-tree-rec (cl-id processor n goal-tree)insert-into-goal-tree-rec
605,24607
+(defun insert-into-goal-tree-lst (cl-id processor n goal-tree-lst)insert-into-goal-tree-lst
613,24929
+(defun insert-into-goal-tree (cl-id processor n goal-tree)insert-into-goal-tree
637,25726
+(defun set-difference-equal-changedp (l1 l2)set-difference-equal-changedp
660,26743
+(defun prune-goal-tree (forcing-round dead-clause-ids goal-tree)prune-goal-tree
678,27394
+(defun prune-goal-tree-lst (forcing-round dead-clause-ids goal-tree-lst)prune-goal-tree-lst
765,31055
+(defun prune-proof-tree (forcing-round dead-clause-ids proof-tree)prune-proof-tree
782,31722
+(defun print-string-repeat (increment level col channel state)print-string-repeat
796,32340
+(defconst *format-proc-alist**format-proc-alist*
808,32743
+(defun format-forced-subgoals (clause-ids col max-col channel state)format-forced-subgoals
821,33141
+(defun format-processor (col goal-tree channel state)format-processor
850,34261
+(defun format-goal-tree-lstformat-goal-tree-lst
903,36276
+(defun format-goal-tree (goal-tree level increment checkpointsformat-goal-tree
935,37528
+(defun format-proof-tree (proof-tree-rev increment checkpointsformat-proof-tree
985,39680
+(defun print-proof-tree1 (ctx channel state)print-proof-tree1
1009,40661
+(defconst *proof-failure-string**proof-failure-string*
1022,41221
+(defun print-proof-tree-ctx (ctx channel state)print-proof-tree-ctx
1025,41287
+(defconst *proof-tree-start-delimiter* "#<\\<0")*proof-tree-start-delimiter*
1050,42144
+(defconst *proof-tree-end-delimiter* "#>\\>")*proof-tree-end-delimiter*
1052,42194
+(defun print-proof-tree-finish (state)print-proof-tree-finish
1054,42241
+(defun print-proof-tree (state)print-proof-tree
1064,42669
+(defun decorate-forced-goals-1 (goal-tree clause-id-list forced-clause-id)decorate-forced-goals-1
1089,43517
+(defun decorate-forced-goals-1-lstdecorate-forced-goals-1-lst
1106,44227
+(defun decorate-forced-goals (forcing-round goal-tree clause-id-list-list n)decorate-forced-goals
1131,45124
+(defun decorate-forced-goals-in-proof-treedecorate-forced-goals-in-proof-tree
1149,45764
+(defun assumnote-list-to-clause-id-list (assumnote-list)assumnote-list-to-clause-id-list
1167,46501
+(defun assumnote-list-list-to-clause-id-list-list (assumnote-list-list)assumnote-list-list-to-clause-id-list-list
1173,46723
+(defun extend-proof-tree-for-forcing-roundextend-proof-tree-for-forcing-round
1179,46994
+(defun initialize-proof-tree1 (parent-clause-id x pool-lst forcing-round ctxinitialize-proof-tree1
1213,48216
+(defun initialize-proof-tree (parent-clause-id x ctx state)initialize-proof-tree
1251,49760
+(defconst *star-1-clause-id**star-1-clause-id*
1276,50788
+(defun revert-goal-tree-rec (cl-id revertp goal-tree)revert-goal-tree-rec
1285,50945
+(defun revert-goal-tree-lst (or-p cl-id revertp goal-tree-lst)revert-goal-tree-lst
1310,52080
+(defun revert-goal-tree (cl-id revertp goal-tree)revert-goal-tree
1337,53296
+(defrec pool-element (tag clause-set . hint-settings) t)pool-element
1358,54210
+(defun pool-lst1 (pool n ans)pool-lst1
1360,54268
+(defun pool-lst (pool)pool-lst
1367,54522
+(defun increment-proof-treeincrement-proof-tree
1388,55371
+(defun goal-tree-with-cl-id (cl-id goal-tree-lst)goal-tree-with-cl-id
1477,59673
+(defun goal-tree-choose-disjunct-rec (cl-id disjunct-cl-id goal-tree)goal-tree-choose-disjunct-rec
1486,59949
+(defun goal-tree-choose-disjunct-lst (cl-id disjunct-cl-id goal-tree-lst)goal-tree-choose-disjunct-lst
1515,61177
+(defun goal-tree-choose-disjunct (cl-id disjunct-cl-id goal-tree)goal-tree-choose-disjunct
1530,61982
+(defun install-disjunct-into-proof-tree (cl-id disjunct-cl-id state)install-disjunct-into-proof-tree
1541,62419
+(defun logical-namep (name wrld)logical-namep
1599,65288
+(defun logical-name-type-string (typ)logical-name-type-string
1618,65979
+(defun signature-fns (signatures)signature-fns
1717,71018
+(defun make-event-tuple (n d form ev-type namex symbol-class)make-event-tuple
1732,71630
+(defun access-event-tuple-number (x)access-event-tuple-number
1784,74129
+(defun access-event-tuple-depth (x)access-event-tuple-depth
1792,74377
+(defun access-event-tuple-type (x)access-event-tuple-type
1795,74452
+(defun access-event-tuple-namex (x)access-event-tuple-namex
1804,74688
+(defun access-event-tuple-form (x)access-event-tuple-form
1827,75490
+(defun access-event-tuple-symbol-class (x)access-event-tuple-symbol-class
1832,75580
+(defrec command-tuplecommand-tuple
1856,76809
+(defun make-command-tuple (n defun-mode form cbd last-make-event-expansion)make-command-tuple
1873,77469
+(defun access-command-tuple-number (x)access-command-tuple-number
1891,78183
+(defun access-command-tuple-defun-mode (x)access-command-tuple-defun-mode
1894,78259
+(defun access-command-tuple-form (x)access-command-tuple-form
1900,78425
+(defun safe-access-command-tuple-form (x)safe-access-command-tuple-form
1910,78667
+(defun access-command-tuple-last-make-event-expansion (x)access-command-tuple-last-make-event-expansion
1923,79017
+(defun access-command-tuple-cbd (x)access-command-tuple-cbd
1926,79131
+(defun max-absolute-event-number (wrld)max-absolute-event-number
1931,79239
+(defun next-absolute-event-number (wrld)next-absolute-event-number
1941,79638
+(defun max-absolute-command-number (wrld)max-absolute-command-number
1944,79721
+(defun next-absolute-command-number (wrld)next-absolute-command-number
1952,80000
+(defun scan-to-event (wrld)scan-to-event
1957,80117
+(defun scan-to-command (wrld)scan-to-command
1968,80405
+(defun scan-to-landmark-number (flg n wrld)scan-to-landmark-number
1978,80667
+(defun add-to-zap-table (val zt)add-to-zap-table
2115,88260
+(defun fetch-from-zap-table (n zt)fetch-from-zap-table
2123,88502
+(defconst *event-index-interval* 10)*event-index-interval*
2142,89183
+(defconst *command-index-interval* 10)*command-index-interval*
2143,89220
+(defun update-world-index (flg wrld)update-world-index
2145,89260
+(defun lookup-world-index1 (n interval index wrld)lookup-world-index1
2219,92801
+(defun lookup-world-index (flg n wrld)lookup-world-index
2241,93707
+(defun store-absolute-event-number (namex n wrld boot-strap-flg)store-absolute-event-number
2270,94959
+(defun the-namex-symbol-class1 (lst wrld symbol-class1)the-namex-symbol-class1
2303,96187
+(defun the-namex-symbol-class (namex wrld)the-namex-symbol-class
2325,97459
+(defun add-event-landmark (form ev-type namex wrld boot-strap-flg)add-event-landmark
2333,97710
+(defun scan-to-defpkg (name wrld)scan-to-defpkg
2363,99108
+(defun scan-to-include-book (full-book-name wrld)scan-to-include-book
2378,99745
+(defun assoc-equal-cadr (x alist)assoc-equal-cadr
2392,100348
+(defun multiple-assoc-terminal-substringp1 (x i alist)multiple-assoc-terminal-substringp1
2397,100508
+(defun multiple-assoc-terminal-substringp (x alist)multiple-assoc-terminal-substringp
2403,100817
+(defun possibly-add-lisp-extension (str)possibly-add-lisp-extension
2412,101207
+(defun decode-logical-name (name wrld)decode-logical-name
2428,101683
+(defun er-decode-logical-name (name wrld ctx state)er-decode-logical-name
2471,103230
+(defun renew-lemmas (fn lemmas)renew-lemmas
2503,104500
+(defun renew-name/erase (name old-getprops wrld)renew-name/erase
2514,104942
+(defun renew-name/overwrite (name old-getprops wrld)renew-name/overwrite
2540,105980
+(defun renew-name (name renewal-mode wrld)renew-name
2693,112019
+(defun renew-names (names renewal-mode wrld)renew-names
2736,114109
+(defun collect-redefined (wrld ans)collect-redefined
2742,114327
+(defun scrunch-eq (lst)scrunch-eq
2762,115120
+(defun print-redefinition-warning (wrld ctx state)print-redefinition-warning
2767,115289
+(defun initialize-summary-accumulators (state)initialize-summary-accumulators
2805,116935
+(defun print-warnings-summary (state)print-warnings-summary
2847,118723
+(defun print-time-summary (state)print-time-summary
2871,119542
+(defun prover-steps (state)prover-steps
2934,122101
+(defun print-steps-summary (steps state)print-steps-summary
2954,123001
+(defun print-rules-summary (state)print-rules-summary
2973,123768
+(defun merge-cdr-> (l1 l2)merge-cdr->
3003,124991
+(defun merge-sort-cdr-> (l)merge-sort-cdr->
3011,125237
+(defconst *gag-prefix* "([ ")*gag-prefix*
3016,125402
+(defconst *gag-suffix* (msg "])~|"))*gag-suffix*
3017,125432
+(defun gag-start-msg (cl-id pool-name)gag-start-msg
3019,125470
+(defun print-gag-info (info state)print-gag-info
3027,125711
+(defun set-checkpoint-summary-limit-fn (val state)set-checkpoint-summary-limit-fn
3038,126150
+(defmacro set-checkpoint-summary-limit (val)set-checkpoint-summary-limit
3057,126801
+(defun print-gag-stack-rev (lst limit orig-limit msg chan state)print-gag-stack-rev
3121,129188
+(defun maybe-print-nil-goal-generated (gag-state chan state)maybe-print-nil-goal-generated
3146,130370
+(defun print-gag-state1 (gag-state state)print-gag-state1
3154,130692
+(defun erase-gag-state (state)erase-gag-state
3242,134467
+(defun print-gag-state (state)print-gag-state
3252,134920
+(defun clause-id-is-top-level (cl-id)clause-id-is-top-level
3260,135151
+(defun clause-id-is-induction-round (cl-id)clause-id-is-induction-round
3265,135309
+(defun clause-id-is-forcing-round (cl-id)clause-id-is-forcing-round
3270,135466
+(defun print-acl2p-checkpoints1 (checkpoints top-level-banner-printedprint-acl2p-checkpoints1
3278,135664
+(deflock *acl2p-checkpoint-saving-lock*)*acl2p-checkpoint-saving-lock*
3322,137783
+(defun erase-acl2p-checkpoints-for-summary (state)erase-acl2p-checkpoints-for-summary
3325,137836
+(defun print-acl2p-checkpoints (state)print-acl2p-checkpoints
3330,137997
+(defun character-alistp (x)character-alistp
3361,139478
+(defun tilde-@p (arg)tilde-@p
3376,139940
+(defun print-failure (erp ctx state)print-failure
3383,140109
+(defstub initialize-event-user (ctx qbody state) state)initialize-event-user
3400,140846
+(defstub finalize-event-user (ctx qbody state) state)finalize-event-user
3402,140903
+(defdoc initialize-event-userinitialize-event-user
3404,140958
+(defdoc finalize-event-userfinalize-event-user
3472,143507
+(defun lmi-seed (lmi)lmi-seed
3598,148259
+(defun lmi-techs (lmi)lmi-techs
3616,148954
+(defun lmi-seed-lst (lmi-lst)lmi-seed-lst
3626,149258
+(defun lmi-techs-lst (lmi-lst)lmi-techs-lst
3631,149428
+(defun filter-atoms (flg lst)filter-atoms
3636,149597
+(defun print-runes-summary (ttree channel state)print-runes-summary
3646,149882
+(defun use-names-in-ttree (ttree)use-names-in-ttree
3659,150260
+(defun by-names-in-ttree (ttree)by-names-in-ttree
3666,150527
+(defrec clause-processor-hintclause-processor-hint
3673,150779
+(defun clause-processor-fns (cl-proc-hints)clause-processor-fns
3677,150850
+(defun cl-proc-names-in-ttree (ttree)cl-proc-names-in-ttree
3684,151149
+(defun print-hint-events-summary (ttree channel state)print-hint-events-summary
3690,151387
+(defun print-splitter-rules-summary (cl-id clauses ttree channel state)print-splitter-rules-summary
3713,152465
+(defun print-rules-and-hint-events-summary (state)print-rules-and-hint-events-summary
3772,155071
+(defun last-prover-steps (state)last-prover-steps
3800,156416
+(defun print-summary (erp noop-flg ctx state)print-summary
3854,158784
+(defun with-prover-step-limit-fn (limit form no-change-flg)with-prover-step-limit-fn
4014,165599
+(defmacro with-prover-step-limit (limit formwith-prover-step-limit
4109,169384
+(defmacro with-prover-step-limit (limit formwith-prover-step-limit
4268,176854
+(defmacro with-prover-step-limit! (limit form &optional no-change-flg)with-prover-step-limit!
4275,177129
+(defrec proved-functional-instances-alist-entryproved-functional-instances-alist-entry
4291,177781
+(defun supply-name-for-proved-functional-instances-alist-entry (name lst)supply-name-for-proved-functional-instances-alist-entry
4347,180684
+(defun proved-functional-instances-from-tagged-objects (name lst)proved-functional-instances-from-tagged-objects
4354,180994
+(defun add-command-landmark (defun-mode form cbd last-make-event-expansionadd-command-landmark
4593,189413
+(defun find-longest-common-retraction1 (wrld1 wrld2)find-longest-common-retraction1
4629,191173
+(defun find-longest-common-retraction1-event (wrld1 wrld2)find-longest-common-retraction1-event
4635,191395
+(defun find-longest-common-retraction (event-p wrld1 wrld2)find-longest-common-retraction
4641,191619
+(defun install-global-enabled-structure (wrld state)install-global-enabled-structure
4662,192468
+(defvar *defattach-fns*)*defattach-fns*
4698,194179
+(defun set-w (flg wrld state)set-w
4700,194205
+(defun set-w! (wrld state)set-w!
4777,197641
+(defmacro save-event-state-globals (form)save-event-state-globals
4887,203123
+(defun attachment-alist (fn wrld)attachment-alist
4905,203705
+(defun attachment-pair (fn wrld)attachment-pair
4914,204089
+(defconst *protected-system-state-globals**protected-system-state-globals*
4920,204313
+(defun state-global-bindings (names)state-global-bindings
4974,207737
+(defmacro protect-system-state-globals (form)protect-system-state-globals
4980,207936
+(defun formal-value-triple (erp val)formal-value-triple
4991,208285
+(defun formal-value-triple@par (erp val)formal-value-triple@par
5002,208581
+(defun@par translate-simple-or-error-triple (uform ctx wrld state)translate-simple-or-error-triple
5009,208738
+(defun xtrans-eval (uterm alist trans-flg ev-flg ctx state aok)xtrans-eval
5098,213169
+(defun xtrans-eval-with-ev-w (uterm alist trans-flg ev-flg ctx state aok)xtrans-eval-with-ev-w
5190,217006
+(defun xtrans-eval@par (uterm alist trans-flg ev-flg ctx state aok)xtrans-eval@par
5266,219906
+(defmacro xtrans-eval-state-fn-attachment (form ctx)xtrans-eval-state-fn-attachment
5269,220045
+(defmacro with-ctx-summarized (ctx body)with-ctx-summarized
5303,221477
+(defmacro revert-world-on-error (form)revert-world-on-error
5390,225782
+(defun@par chk-theory-expr-value1 (lst wrld expr macro-aliases ctx state)chk-theory-expr-value1
5408,226563
+(defun@par chk-theory-expr-value (lst wrld expr ctx state)chk-theory-expr-value
5436,227918
+(defun theory-fn-translated-callp (x)theory-fn-translated-callp
5444,228267
+(defun eval-theory-expr (expr ctx wrld state)eval-theory-expr
5463,228867
+(defun eval-theory-expr@par (expr ctx wrld state)eval-theory-expr@par
5498,230066
+(defun append-strip-cdrs (x y)append-strip-cdrs
5540,231611
+(defun no-rune-based-on (runes symbols)no-rune-based-on
5547,231768
+(defun revappend-delete-runes-based-on-symbols1 (runes symbols ans)revappend-delete-runes-based-on-symbols1
5553,231956
+(defun revappend-delete-runes-based-on-symbols (runes symbols ans)revappend-delete-runes-based-on-symbols
5565,232510
+(defun current-theory1 (lst ans redefined)current-theory1
5586,233449
+(defun first-n-ac-rev (i l ac)first-n-ac-rev
5624,235256
+(defun longest-common-tail-length-rec (old new acc)longest-common-tail-length-rec
5640,235813
+(defun longest-common-tail-length (old new)longest-common-tail-length
5654,236380
+(defun extend-current-theory (old-th new-th old-aug-th wrld)extend-current-theory
5663,236728
+(defun update-current-theory (theory0 wrld)update-current-theory
5698,238212
+(defun put-cltl-command (cltl-cmd wrld wrld0)put-cltl-command
5722,239429
+(defun strip-non-nil-base-symbols (runes acc)strip-non-nil-base-symbols
5739,240198
+(defun install-proof-supporters (namex ttree wrld)install-proof-supporters
5747,240462
+(defun install-event (val form ev-type namex ttree cltl-cmdinstall-event
5785,242297
+(deflabel redundant-eventsredundant-events
6001,254263
+(defun stop-redundant-event-fn (ctx state extra-msg)stop-redundant-event-fn
6301,269461
+(defmacro stop-redundant-event (ctx state &optional extra-msg)stop-redundant-event
6332,270602
+(defrec command-number-baseline-infocommand-number-baseline-info
6368,272247
+(defun absolute-to-relative-command-number (n wrld)absolute-to-relative-command-number
6372,272327
+(defun relative-to-absolute-command-number (n wrld)relative-to-absolute-command-number
6377,272514
+(defun normalize-absolute-command-number (n wrld)normalize-absolute-command-number
6382,272701
+(defun tree-occur (x y)tree-occur
6432,274631
+(defun cd-form-matchp (pat form)cd-form-matchp
6441,274820
+(defun cd-some-event-matchp (pat wrld)cd-some-event-matchp
6454,275196
+(defun cd-search (pat earliestp start-wrld end-wrld)cd-search
6473,275976
+(defun superior-command-world (wrld1 wrld ctx state)superior-command-world
6514,277780
+(defun er-decode-cd (cd wrld ctx state)er-decode-cd
6545,279268
+(defrec ldd-statusldd-status
6732,288481
+(defun make-ldd-flags (class markp status fullp)make-ldd-flags
6736,288619
+(defun make-ldd (class markp status n fullp form)make-ldd
6749,289296
+(defun access-ldd-class  (ldd) (caaar ldd))access-ldd-class
6766,289981
+(defun access-ldd-markp  (ldd) (cdaar ldd))access-ldd-markp
6767,290025
+(defun access-ldd-status (ldd) (cadar ldd))access-ldd-status
6768,290069
+(defun access-ldd-fullp  (ldd) (cddar ldd))access-ldd-fullp
6769,290113
+(defun access-ldd-n      (ldd) (cadr ldd))access-ldd-n
6770,290157
+(defun access-ldd-form   (ldd) (cddr ldd))access-ldd-form
6771,290200
+(defun big-d-little-d-name1 (lst ens ans)big-d-little-d-name1
6773,290244
+(defun big-d-little-d-name (name ens wrld)big-d-little-d-name
6787,290868
+(defun big-d-little-d-clique1 (names ens wrld ans)big-d-little-d-clique1
6801,291510
+(defun big-d-little-d-clique (names ens wrld)big-d-little-d-clique
6814,292060
+(defun big-d-little-d-event (ev-tuple ens wrld)big-d-little-d-event
6825,292519
+(defun big-d-little-d-command-block (wrld1 ens wrld s)big-d-little-d-command-block
6851,293735
+(defun big-m-little-m-name (name wrld)big-m-little-m-name
6894,295745
+(defun big-m-little-m-clique1 (names wrld ans)big-m-little-m-clique1
6907,296180
+(defun big-m-little-m-clique (names wrld)big-m-little-m-clique
6920,296672
+(defun big-m-little-m-event (ev-tuple wrld)big-m-little-m-event
6930,297040
+(defun big-m-little-m-command-block (wrld1 wrld s)big-m-little-m-command-block
6944,297574
+(defun symbol-class-char (symbol-class)symbol-class-char
6972,298648
+(defun defun-mode-string (defun-mode)defun-mode-string
6983,298964
+(defun big-c-little-c-event (ev-tuple wrld)big-c-little-c-event
6991,299218
+(defun big-c-little-c-command-block (wrld1 wrld s)big-c-little-c-command-block
7018,300487
+(defun print-ldd-full-or-sketch/mutual-recursion (lst)print-ldd-full-or-sketch/mutual-recursion
7056,302287
+(defun print-ldd-full-or-sketch/encapsulate (lst)print-ldd-full-or-sketch/encapsulate
7065,302595
+(defun normalize-char (c hyphen-is-spacep)normalize-char
7078,303121
+(defun normalize-string1 (str hyphen-is-spacep j ans)normalize-string1
7084,303277
+(defun normalize-string (str hyphen-is-spacep)normalize-string
7096,303811
+(defun string-matchp (pat-lst str j jmax normp skippingp)string-matchp
7106,304216
+(defun string-search1 (pat-lst str j j-max normp)string-search1
7132,305204
+(defun string-search (pat str normp)string-search
7139,305431
+(defun doc-stringp (str)doc-stringp
7156,306022
+(defconst *zapped-doc-string**zapped-doc-string*
7173,306522
+(defun zap-doc-string-from-event-form/all-but-last (lst)zap-doc-string-from-event-form/all-but-last
7176,306591
+(defun zap-doc-string-from-event-form/second-arg (form)zap-doc-string-from-event-form/second-arg
7185,306950
+(defun zap-doc-string-from-event-form/third-arg (form)zap-doc-string-from-event-form/third-arg
7195,307218
+(defun zap-doc-string-from-event-form/mutual-recursion (lst)zap-doc-string-from-event-form/mutual-recursion
7206,307542
+(defun zap-doc-string-from-event-form/doc-keyword (lst)zap-doc-string-from-event-form/doc-keyword
7211,307783
+(defun zap-doc-string-from-event-form (form)zap-doc-string-from-event-form
7232,308749
+(defun print-ldd-full-or-sketch (fullp form)print-ldd-full-or-sketch
7251,309530
+(defmacro with-base-10 (form)with-base-10
7300,311320
+(defun print-ldd-formula-column (state)print-ldd-formula-column
7330,312644
+(defun print-ldd (ldd channel state)print-ldd
7335,312788
+(defun print-ldds (ldds channel state)print-ldds
7392,315020
+(defun make-command-ldd (markp fullp cmd-wrld ens wrld)make-command-ldd
7423,316575
+(defun make-event-ldd (markp indent fullp ev-tuple ens wrld)make-event-ldd
7442,317408
+(defun make-ldds-command-sequence (cmd-wrld1 cmd2 ens wrld markp ans)make-ldds-command-sequence
7457,317962
+(defun make-ldds-command-block1 (wrld1 cmd-ldd indent fullp super-stk ens wrldmake-ldds-command-block1
7481,319089
+(defun make-ldds-command-block (cmd-wrld ens wrld fullp ans)make-ldds-command-block
7552,321505
+(defun pcb-pcb!-fn (cd fullp state)pcb-pcb!-fn
7570,322290
+(defun pcb!-fn (cd state)pcb!-fn
7583,322753
+(defun pcb-fn (cd state)pcb-fn
7586,322808
+(defmacro pcb! (cd)pcb!
7589,322864
+(defun pc-fn (cd state)pc-fn
7609,323495
+(defmacro pc (cd)pc
7621,323904
+(defun pcs-fn (cd1 cd2 markp state)pcs-fn
7753,330037
+(defmacro pcs (cd1 cd2)pcs
7808,332611
+(defun get-command-sequence-fn1 (cmd-wrld1 cmd2 ans)get-command-sequence-fn1
7833,333554
+(defun get-command-sequence-fn (cd1 cd2 state)get-command-sequence-fn
7846,333976
+(defmacro get-command-sequence (cd1 cd2)get-command-sequence
7871,335052
+(defmacro gcs (cd1 cd2)gcs
7895,335925
+(defmacro pbt (cd1)pbt
7898,335987
+(defmacro pcb (cd)pcb
7922,336880
+(defun print-indented-list-msg (objects indent final-string)print-indented-list-msg
7953,338358
+(defun print-indented-list (objects indent last-col channel evisc-tuple state)print-indented-list
7972,339007
+(defun print-book-path (book-path indent channel state)print-book-path
7979,339293
+(defun pe-fn1 (wrld channel ev-wrld cmd-wrld state)pe-fn1
7994,339803
+(defun pe-fn2 (logical-name wrld channel ev-wrld state)pe-fn2
8024,340850
+(defun pe-fn (logical-name state)pe-fn
8034,341388
+(defmacro pe (logical-name)pe
8092,343959
+(defmacro pe! (logical-name)pe!
8140,345794
+(defun command-block-names1 (wrld ans symbol-classes)command-block-names1
8155,346197
+(defun command-block-names (wrld symbol-classes)command-block-names
8190,347892
+(defun symbol-name-lst (lst)symbol-name-lst
8199,348265
+(defun acl2-query-simulate-interaction (msg alist controlledp ans state)acl2-query-simulate-interaction
8204,348410
+(defun acl2-query1 (id qt alist state)acl2-query1
8222,349122
+(defun acl2-query (id qt alist state)acl2-query
8275,351238
+(defun collect-names-in-defun-modes (names defun-modes wrld)collect-names-in-defun-modes
8325,353576
+(defun ubt-ubu-query (kwd wrld1 wrld0 seen kept-commands wrld state banger)ubt-ubu-query
8336,354019
+(defmacro ubt (cd)ubt
8459,360909
+(defmacro ubt! (cd)ubt!
8502,362870
+(defmacro ubu (cd)ubu
8520,363410
+(defmacro ubu! (cd)ubu!
8551,364624
+(defmacro u nilu
8570,365199
+(defun chk-virgin (name new-type wrld)chk-virgin
8592,365880
+(deflabel namename
8604,366140
+(defun chk-boot-strap-redefineable-namep (name ctx wrld state)chk-boot-strap-redefineable-namep
8651,368367
+(defun maybe-coerce-overwrite-to-erase (old-type new-type mode)maybe-coerce-overwrite-to-erase
8667,369078
+(defun redefinition-renewal-mode (name old-type new-type reclassifyingp ctxredefinition-renewal-mode
8673,369256
+(defun redefined-names1 (wrld ans)redefined-names1
9010,385981
+(defun redefined-names (state)redefined-names
9020,386359
+(defun chk-redefineable-namep (name new-type reclassifyingp ctx wrld state)chk-redefineable-namep
9071,388236
+(defun chk-just-new-name (name new-type reclassifyingp ctx w state)chk-just-new-name
9130,390790
+(defun no-new-namesp (lst wrld)no-new-namesp
9182,393148
+(defun chk-just-new-names (names new-type reclassifyingp ctx w state)chk-just-new-names
9191,393368
+(defconst *return-character* (code-char 13))*return-character*
9217,394586
+(defun read-symbol-from-string1 (str i len ans)read-symbol-from-string1
9219,394632
+(defun read-symbol-from-string2 (str i len ans)read-symbol-from-string2
9234,395196
+(defun read-symbol-from-string (str i pkg-witness)read-symbol-from-string
9243,395527
+(defun scan-past-newline (str i maximum)scan-past-newline
9294,398087
+(defun scan-past-newlines (str i maximum)scan-past-newlines
9301,398303
+(defun scan-past-tilde-slash (str i maximum)scan-past-tilde-slash
9308,398516
+(defun scan-to-doc-string-part1 (parti str i maximum)scan-to-doc-string-part1
9320,399081
+(defun scan-to-doc-string-part (i str)scan-to-doc-string-part
9331,399384
+(defun get-one-liner-as-string1 (str i j acc)get-one-liner-as-string1
9350,400146
+(defun get-one-liner-as-string (str)get-one-liner-as-string
9355,400320
+(defun read-doc-string-citations1 (name str i)read-doc-string-citations1
9363,400603
+(defun read-doc-string-citations (name str)read-doc-string-citations
9377,401111
+(defun doc-topicp (name wrld)doc-topicp
9393,401880
+(defun ignore-doc-string-error (wrld)ignore-doc-string-error
9396,401972
+(defmacro er-doc (ctx str &rest str-args)er-doc
9400,402113
+(defun chk-doc-string-citations (str citations wrld)chk-doc-string-citations
9414,402749
+(defun chk-well-formed-doc-string (name doc ctx state)chk-well-formed-doc-string
9446,404314
+(defun translate-doc (name doc ctx state)translate-doc
9540,408901
+(defun translate-doc-lst (names docs ctx state)translate-doc-lst
9562,409820
+(defun get-cites (citations)get-cites
9569,410098
+(defun alpha-< (x y)alpha-<
9580,410435
+(defun merge-alpha-< (l1 l2)merge-alpha-<
9600,411178
+(defun merge-sort-alpha-< (l)merge-sort-alpha-<
9607,411403
+(defun update-alpha-<-alist (key val alist)update-alpha-<-alist
9612,411578
+(defun put-cited-bys (name citations alist)put-cited-bys
9624,412028
+(defun update-doc-database (name doc pair wrld)update-doc-database
9649,412969
+(defun update-doc-database-lst (names docs pairs wrld)update-doc-database-lst
9674,414047
+(defun putprop-unless (sym key val exception wrld)putprop-unless
9682,414316
+(defun redefined-warning (redef ctx state)redefined-warning
9690,414578
+(defun get-event (name wrld)get-event
9703,415036
+(defun redundant-labelp (name event-form wrld)redundant-labelp
9716,415392
+(defun deflabel-fn (name state doc event-form)deflabel-fn
9726,415756
+(defun defdoc-fn (name state doc event-form)defdoc-fn
9775,417566
+(defmacro defdoc (&whole event-form name doc) ;See notedefdoc
9825,419365
+(defun access-doc-string-database (name state)access-doc-string-database
9897,422715
+(defun get-doc-string (name state)get-doc-string
9930,423864
+(defun get-doc-string-de-indent1 (str i)get-doc-string-de-indent1
9937,424046
+(defun get-doc-string-de-indent (str)get-doc-string-de-indent
9941,424187
+(defun use-doc-string-de-indent (d str i maximum)use-doc-string-de-indent
9953,424703
+(defun doc-prefix (state)doc-prefix
9964,425023
+(defun princ-prefix (prefix channel state)princ-prefix
9969,425144
+(defun length-prefix (prefix)length-prefix
9975,425386
+(defun save-more-doc-state (str i maximum de-indent prefix state)save-more-doc-state
9979,425511
+(defun doc-char-subst-table-p (x)doc-char-subst-table-p
9988,425900
+(defun set-doc-char-subst-table (x state)set-doc-char-subst-table
10001,426195
+(defun doc-char-subst-table (state)doc-char-subst-table
10011,426616
+(defun doc-fmt-alist (state)doc-fmt-alist
10017,426741
+(defconst *terminal-markup-table**terminal-markup-table*
10020,426810
+(defun doc-markup-table (state)doc-markup-table
10149,433554
+(defun doc-scan-past-tilde-key (name orig-position posn str maximum acc state)doc-scan-past-tilde-key
10154,433723
+(defun doc-scan-past-tilde-argdoc-scan-past-tilde-arg
10182,434989
+(defun doc-scan-past-tildedoc-scan-past-tilde
10254,437825
+(defun assoc-char-alist-stringp (char-alist str len)assoc-char-alist-stringp
10292,439582
+(defun apply-char-subst-table1 (char-lst acc char-subst-table)apply-char-subst-table1
10302,439895
+(defun apply-char-subst-table (s char-subst-table spack)apply-char-subst-table
10323,440788
+(defun read-pointer-and-text1 (lst pacc sacc)read-pointer-and-text1
10350,441843
+(defun read-pointer-and-text2 (lst acc)read-pointer-and-text2
10374,442929
+(defun read-pointer-and-text-raw (str)read-pointer-and-text-raw
10383,443261
+(defun posn-char-stringp (chr str i)posn-char-stringp
10396,443672
+(defun replace-colons (p)replace-colons
10406,443896
+(defun read-pointer-and-text (str bar-sep-p)read-pointer-and-text
10419,444315
+(defun lookup-fmt-alist (str flag fmt-alist char-subst-table bar-sep-p)lookup-fmt-alist
10427,444542
+(defun bar-sep-p (state)bar-sep-p
10517,448684
+(defun char-to-string-alistp (lst)char-to-string-alistp
10521,448793
+(defun missing-fmt-alist-chars1 (str char-to-tilde-s-string-alist fmt-alist)missing-fmt-alist-chars1
10532,449123
+(defun missing-fmt-alist-chars (str fmt-alist)missing-fmt-alist-chars
10553,450008
+(defun complete-fmt-alist (topic-name fmt-alist undocumented-filecomplete-fmt-alist
10579,451227
+(defmacro mv-to-state (n form)mv-to-state
10606,452457
+(defun print-par-entry (entry fmt-alist char-subst-table channel state)print-par-entry
10620,452885
+(defun print-doc-string-part1 (str i maximum de-indent prefixprint-doc-string-part1
10628,453139
+(defun print-doc-string-part-mvprint-doc-string-part-mv
10943,469591
+(defun print-doc-string-partprint-doc-string-part
11040,474219
+(defun get-doc-section (section alist)get-doc-section
11049,474560
+(defmacro pstate-global-let* (bindings body)pstate-global-let*
11057,474855
+(defun print-doc (name n prefixprint-doc
11071,475283
+(defun print-doc-lst (lst prefixprint-doc-lst
11164,479291
+(defun degree-of-match2 (ch1 ch2 str i maximum)degree-of-match2
11181,479970
+(defun degree-of-match1 (pat-lst str maximum)degree-of-match1
11189,480269
+(defun degree-of-match (pat-lst str)degree-of-match
11195,480515
+(defun find-likely-near-misses (pat-lst alist)find-likely-near-misses
11209,481052
+(defun print-doc-dwim (name ctx state)print-doc-dwim
11227,481867
+(defun end-doc (channel state)end-doc
11244,482486
+(defun doc-fn (name state)doc-fn
11258,482950
+(defun more-fn (ln state)more-fn
11314,485481
+(defun doc!-fn (name state)doc!-fn
11338,486534
+(defmacro more nilmore
11364,487731
+(defmacro more! nilmore!
11412,489806
+(defun print-doc-outlineprint-doc-outline
11437,490657
+(defun print-doc-outline-lst (name-lst prefixprint-doc-outline-lst
11467,491782
+(deflabel finding-documentationfinding-documentation
11481,492511
+(deflabel markupmarkup
11506,493682
+(deflabel doc-stringdoc-string
11789,505147
+(deflabel print-doc-start-columnprint-doc-start-column
12021,517849
+(defmacro doc (name)doc
12043,518737
+(defmacro doc! (name)doc!
12108,521731
+(defun more-doc-fn (name state)more-doc-fn
12126,522149
+(defmacro more-doc (name)more-doc
12145,522924
+(defun get-doc-section-symbols (alist ans)get-doc-section-symbols
12171,523902
+(defun get-docs-apropos1 (pat-lst alist ans)get-docs-apropos1
12176,524095
+(defun get-docs-apropos (pat alist)get-docs-apropos
12182,524370
+(defun docs-fn (x state)docs-fn
12185,524475
+(defmacro docs (x)docs
12240,526641
+(defun print-top-doc-topics (doc-alist channel state)print-top-doc-topics
12289,528657
+(defun help-fn (state)help-fn
12301,529114
+(deflabel qq
12359,531677
+(defmacro help nilhelp
12381,532476
+(deflabel logical-namelogical-name
12396,532719
+(deflabel commandcommand
12471,536262
+(deflabel command-descriptorcommand-descriptor
12497,537299
+(defun trans-fn (form state)trans-fn
12585,541680
+(defun trans!-fn (form state)trans!-fn
12612,542884
+(defmacro trans (form)trans
12633,543731
+(defmacro trans! (form)trans!
12679,545141
+(defun trans1-fn (form state)trans1-fn
12696,545610
+(defmacro trans1 (form)trans1
12706,545997
+(defun tilde-*-props-fn-phrase1 (alist)tilde-*-props-fn-phrase1
12726,546515
+(defun tilde-*-props-fn-phrase (alist)tilde-*-props-fn-phrase
12733,546751
+(defun props-fn (sym state)props-fn
12737,546867
+(defmacro props (sym)props
12758,547641
+(deflabel enter-boot-strap-modeenter-boot-strap-mode
12773,547938
+(deflabel exit-boot-strap-modeexit-boot-strap-mode
12804,549387
+(defun walkabout-nth (i x)walkabout-nth
12828,550351
+(defun walkabout-ip (i x)walkabout-ip
12851,551174
+(defun walkabout-huh (state)walkabout-huh
12862,551494
+(defun walkabout1 (i x state intern-flg evisc-tuple alt-evisc-tuple)walkabout1
12867,551647
+(defun walkabout (x state)walkabout
12966,555822
+(defun walkabout=-fn (var state)walkabout=-fn
13081,558865
+(defmacro walkabout= (var)walkabout=
13086,559009
+(defun lookup-bddnote (cl-id bddnotes)lookup-bddnote
13091,559140
+(defun update-bddnote-with-term (cl-id term bddnotes)update-bddnote-with-term
13098,559337
+(defmacro show-bdd (&optional strshow-bdd
13111,559815
+(defun show-bdd-goal (query-response bddnote chan state)show-bdd-goal
13200,563669
+(defun merge-car-term-order (l1 l2)merge-car-term-order
13251,565826
+(defun merge-sort-car-term-order (l)merge-sort-car-term-order
13258,566087
+(defun falsifying-pair-p (term val asst)falsifying-pair-p
13263,566297
+(defun bogus-falsifying-assignment-var (asst)bogus-falsifying-assignment-var
13272,566594
+(defun show-falsifying-assignment (query-response bddnote chan state)show-falsifying-assignment
13283,566846
+(defun show-bdd-term (query-response bddnote chan state)show-bdd-term
13359,570480
+(defun tilde-*-substitution-phrase1 (alist is-replaced-by-str evisc-tuple wrld)tilde-*-substitution-phrase1
13428,573417
+(defun tilde-*-substitution-phrase (alist is-replaced-by-str evisc-tuple wrld)tilde-*-substitution-phrase
13439,573949
+(defun show-bdd-backtrace (call-stack cst-array chan state)show-bdd-backtrace
13445,574202
+(defun show-bdd-fn (str goal-query-responseshow-bdd-fn
13474,575266
+(defun get-docs (lst)get-docs
13536,578226
+(defun get-guards2 (edcls targets wrld acc)get-guards2
13549,578664
+(defun get-guards1 (edcls targets wrld)get-guards1
13633,582343
+(defun get-guards (lst split-types-lst split-types-p wrld)get-guards
13636,582424
+(defun get-guardsp (lst wrld)get-guardsp
13681,584419
+(defconst *no-measure**no-measure*
13699,585287
+(defun get-measures1 (m edcls ctx state)get-measures1
13702,585320
+(defun get-measures2 (lst ctx state)get-measures2
13733,586851
+(defun get-measures (symbol-class lst ctx state)get-measures
13741,587154
+(defconst *no-ruler-extenders**no-ruler-extenders*
13757,587784
+(defconst *basic-ruler-extenders**basic-ruler-extenders*
13760,587825
+(defun get-ruler-extenders1 (r edcls default ctx wrld state)get-ruler-extenders1
13763,587886
+(defun get-ruler-extenders2 (lst default ctx wrld state)get-ruler-extenders2
13808,589981
+(defmacro default-ruler-extenders-from-table (alist)default-ruler-extenders-from-table
13817,590410
+(defun default-ruler-extenders (wrld)default-ruler-extenders
13823,590606
+(defun get-ruler-extenders-lst (symbol-class lst ctx state)get-ruler-extenders-lst
13842,591446
+(defun get-hints1 (edcls)get-hints1
13860,592245
+(defun get-hints (lst)get-hints
13887,593162
+(defun get-guard-hints1 (edcls)get-guard-hints1
13897,593474
+(defun get-guard-hints (lst)get-guard-hints
13925,594453
+(defun get-std-hints1 (edcls)get-std-hints1
13936,594814
+(defun get-std-hints (lst)get-std-hints
13965,595776
+(defun get-normalizep (edcls ans ctx state)get-normalizep
13975,596104
+(defun get-normalizeps (lst acc ctx state)get-normalizeps
14014,597504
+(defconst *unspecified-xarg-value**unspecified-xarg-value*
14025,598001
+(defun get-unambiguous-xargs-flg1/edcls1 (key v edcls event-msg)get-unambiguous-xargs-flg1/edcls1
14032,598143
+(defun get-unambiguous-xargs-flg1/edcls (key v edcls event-msg ctx state)get-unambiguous-xargs-flg1/edcls
14065,599861
+(defun get-unambiguous-xargs-flg1 (key lst event-msg ctx state)get-unambiguous-xargs-flg1
14076,600249
+(defun get-unambiguous-xargs-flg (key lst default ctx state)get-unambiguous-xargs-flg
14094,601190
+(defun get-unambiguous-xargs-flg-lst (key lst default ctx state)get-unambiguous-xargs-flg-lst
14123,602722
+(defun chk-xargs-keywords1 (edcls keywords ctx state)chk-xargs-keywords1
14144,603747
+(defun chk-xargs-keywords (lst keywords ctx state)chk-xargs-keywords
14161,604593
+(defun get-names (lst)get-names
14182,605419
+(defun get-bodies (lst)get-bodies
14187,605539
+(defun find-nontrivial-rulers (var term)find-nontrivial-rulers
14194,605687
+(defun find-nontrivial-rulers-lst (var termlist flg)find-nontrivial-rulers-lst
14219,606729
+(defun tilde-@-free-vars-phrase (vars term wrld)tilde-@-free-vars-phrase
14228,607062
+(defun chk-free-vars (name formals term loc-str ctx state)chk-free-vars
14255,608398
+(defun chk-declared-ignores (name ignores term loc-str ctx state)chk-declared-ignores
14274,609238
+(defun chk-free-and-ignored-vars (name formals guard split-types-term measurechk-free-and-ignored-vars
14286,609755
+(defun chk-free-and-ignored-vars-lsts (names arglists guards split-types-termschk-free-and-ignored-vars-lsts
14343,612735
+(defun putprop-x-lst1 (symbols key value wrld)putprop-x-lst1
14380,614924
+(defun putprop-x-lst2 (symbols key vals wrld)putprop-x-lst2
14390,615232
+(defun putprop-x-lst2-unless (symbols key vals exception wrld)putprop-x-lst2-unless
14401,615578
+(defun@par translate-term-lst (terms stobjs-out logic-modep known-stobjs-lsttranslate-term-lst
14417,616285
+(defun find-named-lemma (sym lst top-level)find-named-lemma
14513,620942
+(defun find-runed-lemma (rune lst)find-runed-lemma
14530,621604
+(defun free-varsp-member (term vars)free-varsp-member
14543,621953
+(defun free-varsp-member-lst (args vars)free-varsp-member-lst
14551,622203
+(defun@par translate-expand-term1 (name form free-vars ctx wrld state)translate-expand-term1
14558,622384
+(defun@par translate-expand-term (x ctx wrld state)translate-expand-term
14683,628178
+(defun@par translate-expand-hint1 (arg acc ctx wrld state)translate-expand-hint1
14711,629317
+(defun@par translate-expand-hint (arg ctx wrld state)translate-expand-hint
14724,629872
+(defun cons-all-to-lst (new-members lst)cons-all-to-lst
14778,632007
+(defun@par translate-substitution (substn ctx wrld state)translate-substitution
14783,632189
+(defun@par translate-substitution-lst (substn-lst ctx wrld state)translate-substitution-lst
14832,634502
+(defun get-rewrite-and-defn-runes-from-runic-mapping-pairs (pairs)get-rewrite-and-defn-runes-from-runic-mapping-pairs
14842,634854
+(defun@par translate-restrict-hint (arg ctx wrld state)translate-restrict-hint
14851,635196
+(defconst *do-not-processes**do-not-processes*
14900,637286
+(defun coerce-to-process-name-lst (lst)coerce-to-process-name-lst
14904,637422
+(defun coerce-to-acl2-package-lst (lst)coerce-to-acl2-package-lst
14911,637661
+(defun@par chk-do-not-expr-value (lst expr ctx state)chk-do-not-expr-value
14918,637874
+(defun@par translate-do-not-hint (expr ctx state)translate-do-not-hint
14946,639159
+(defun@par translate-do-not-induct-hint (arg ctx wrld state)translate-do-not-induct-hint
14987,640730
+(defun@par translate-hands-off-hint1 (arg ctx wrld state)translate-hands-off-hint1
15013,642051
+(defun@par translate-hands-off-hint (arg ctx wrld state)translate-hands-off-hint
15053,643589
+(defun truncated-class (rune mapping-pairs classes)truncated-class
15075,644357
+(defun tests-and-alists-lst-from-fn (fn wrld)tests-and-alists-lst-from-fn
15089,645052
+(defun corollary (rune wrld)corollary
15110,646071
+(defun formula (name normalp wrld)formula
15191,649551
+(defun pf-fn (name state)pf-fn
15212,650458
+(defmacro pf (name)pf
15247,651896
+(defun merge-symbol-< (l1 l2 acc)merge-symbol-<
15268,652537
+(defun merge-sort-symbol-< (l)merge-sort-symbol-<
15275,652810
+(defconst *non-instantiable-primitives**non-instantiable-primitives*
15283,653073
+(defun instantiablep (fn wrld)instantiablep
15323,654722
+(defun all-ffn-symbs (term ans)all-ffn-symbs
15361,656398
+(defun all-ffn-symbs-lst (lst ans)all-ffn-symbs-lst
15371,656793
+(defconst *unknown-constraints**unknown-constraints*
15378,656961
+(defun constraint-info (fn wrld)constraint-info
15386,657184
+(defdoc constraintconstraint
15453,660158
+(defun@par chk-equal-arities (fn1 n1 fn2 n2 ctx state)chk-equal-arities
15904,680294
+(defun extend-sorted-symbol-alist (pair alist)extend-sorted-symbol-alist
15924,680904
+(defun@par chk-equiv-classicalp (fn1 fn2 termp ctx wrld state)chk-equiv-classicalp
15938,681271
+(defun@par translate-functional-substitution (substn ctx wrld state)translate-functional-substitution
15957,682076
+(defun sublis-fn-rec (alist term bound-vars allow-freevars-p)sublis-fn-rec
16079,687797
+(defun sublis-fn-rec-lst (alist terms bound-vars allow-freevars-p)sublis-fn-rec-lst
16197,694000
+(defun sublis-fn (alist term bound-vars)sublis-fn
16212,694566
+(defun sublis-fn-simple (alist term)sublis-fn-simple
16219,694780
+(defun sublis-fn-lst-simple (alist termlist)sublis-fn-lst-simple
16229,695103
+(defun instantiable-ffn-symbs (term wrld ans ignore-fns)instantiable-ffn-symbs
16240,695384
+(defun instantiable-ffn-symbs-lst (lst wrld ans ignore-fns)instantiable-ffn-symbs-lst
16267,696386
+(defun unknown-constraint-supporters (fn wrld)unknown-constraint-supporters
16278,696780
+(defun collect-instantiablep1 (fns wrld ignore-fns)collect-instantiablep1
16298,697683
+(defun all-instantiablep (fns wrld)all-instantiablep
16309,698060
+(defun collect-instantiablep (fns wrld ignore-fns)collect-instantiablep
16315,698223
+(defun immediate-instantiable-ancestors (fn wrld ignore-fns)immediate-instantiable-ancestors
16324,698485
+(defun instantiable-ancestors (fns wrld ans)instantiable-ancestors
16369,700746
+(defun hitp (term alist)hitp
16388,701408
+(defun hitp-lst (terms alist)hitp-lst
16401,701850
+(defun event-responsible-for-proved-constraint (name alistevent-responsible-for-proved-constraint
16408,701999
+(defun getprop-x-lst (symbols prop wrld)getprop-x-lst
16453,704255
+(defun filter-hitps (lst alist ans)filter-hitps
16459,704488
+(defun relevant-constraints1 (names alist proved-fnl-insts-alist constraintsrelevant-constraints1
16466,704681
+(defun relevant-constraints1-axioms (names alist proved-fnl-insts-alistrelevant-constraints1-axioms
16632,712842
+(defun relevant-constraints (thm alist proved-fnl-insts-alist wrld)relevant-constraints
16682,715351
+(defun bound-vars (term ans)bound-vars
16733,717604
+(defun bound-vars-lst (terms ans)bound-vars-lst
16744,718008
+(defun@par translate-lmi/instance (formula constraints event-names new-entriestranslate-lmi/instance
16752,718169
+(defun@par translate-lmi/functional-instance (formula constraints event-namestranslate-lmi/functional-instance
16793,720260
+(defun@par translate-lmi (lmi normalizep ctx wrld state)translate-lmi
16890,725249
+(deflabel functional-instantiation-in-acl2rfunctional-instantiation-in-acl2r
16997,729843
+(deflabel lemma-instancelemma-instance
17020,730897
+(defun@par translate-use-hint1 (arg ctx wrld state)translate-use-hint1
17129,736975
+(defun@par translate-use-hint (arg ctx wrld state)translate-use-hint
17152,738114
+(defun convert-name-tree-to-new-name1 (name-tree char-lst sym)convert-name-tree-to-new-name1
17264,743596
+(defun convert-name-tree-to-new-name (name-tree wrld)convert-name-tree-to-new-name
17291,744944
+(defun@par translate-by-hint (name-tree arg ctx wrld state)translate-by-hint
17313,746001
+(defun@par translate-cases-hint (arg ctx wrld state)translate-cases-hint
17381,749086
+(defun@par translate-case-split-limitations-hint (arg ctx wrld state)translate-case-split-limitations-hint
17396,749574
+(defun@par translate-no-op-hint (arg ctx wrld state)translate-no-op-hint
17420,750522
+(defun@par translate-error-hint (arg ctx wrld state)translate-error-hint
17426,750670
+(defun@par translate-induct-hint (arg ctx wrld state)translate-induct-hint
17435,750963
+(defconst *built-in-executable-counterparts**built-in-executable-counterparts*
17447,751440
+(defconst *s-prop-theory**s-prop-theory*
17467,752106
+(defconst *definition-minimal-theory**definition-minimal-theory*
17480,752604
+(defdoc theories-and-primitivestheories-and-primitives
17488,752906
+(defun translate-in-theory-hinttranslate-in-theory-hint
17596,756698
+(defun translate-in-theory-hint@partranslate-in-theory-hint@par
17663,759762
+(defun all-function-symbolps (fns wrld)all-function-symbolps
17742,763585
+(defun non-function-symbols (lst wrld)non-function-symbols
17748,763808
+(defun collect-non-logic-mode (alist wrld)collect-non-logic-mode
17755,764050
+(defun@par translate-bdd-hint1 (top-arg rest ctx wrld state)translate-bdd-hint1
17763,764361
+(defun@par translate-bdd-hint (arg ctx wrld state)translate-bdd-hint
17849,768392
+(defun@par translate-nonlinearp-hint (arg ctx wrld state)translate-nonlinearp-hint
17867,769026
+(defun@par translate-backchain-limit-rw-hint (arg ctx wrld state)translate-backchain-limit-rw-hint
17879,769367
+(defun@par translate-no-thanks-hint (arg ctx wrld state)translate-no-thanks-hint
17889,769692
+(defun@par translate-reorder-hint (arg ctx wrld state)translate-reorder-hint
17895,769842
+(defun arity-mismatch-msg (sym expected-arity wrld)arity-mismatch-msg
17907,770207
+(defun@par translate-clause-processor-hint (form ctx wrld state)translate-clause-processor-hint
17938,771509
+(defun@par translate-custom-keyword-hint (arg uterm2 ctx wrld state)translate-custom-keyword-hint
18059,777364
+(defun custom-keyword-hint (key wrld)custom-keyword-hint
18115,780028
+(defun remove-all-no-ops (key-val-lst)remove-all-no-ops
18126,780362
+(defun remove-redundant-no-ops (key-val-lst)remove-redundant-no-ops
18134,780667
+(defun find-first-custom-keyword-hint (user-hints wrld)find-first-custom-keyword-hint
18153,781264
+(defconst *custom-keyword-max-iterations**custom-keyword-max-iterations*
18173,782029
+(defun@par custom-keyword-hint-interpreter1custom-keyword-hint-interpreter1
18176,782079
+(defun@par custom-keyword-hint-interpretercustom-keyword-hint-interpreter
18350,789612
+(defun custom-keyword-hint-in-computed-hint-form (computed-hint-tuple)custom-keyword-hint-in-computed-hint-form
18381,791058
+(defun@par put-cl-id-of-custom-keyword-hint-in-computed-hint-formput-cl-id-of-custom-keyword-hint-in-computed-hint-form
18420,792919
+(defun make-disjunctive-clause-id (cl-id i pkg-name)make-disjunctive-clause-id
18448,794093
+(defun make-disjunctive-goal-spec (str i pkg-name)make-disjunctive-goal-spec
18456,794384
+(defun minimally-well-formed-or-hintp (val)minimally-well-formed-or-hintp
18461,794570
+(defun split-keyword-alist (key keyword-alist)split-keyword-alist
18469,794840
+(defun distribute-other-hints-into-or1 (pre x post)distribute-other-hints-into-or1
18480,795278
+(defun distribute-other-hints-into-or (keyword-alist)distribute-other-hints-into-or
18485,795469
+(defconst *hint-expression-basic-vars**hint-expression-basic-vars*
18506,796217
+(defconst *hint-expression-override-vars**hint-expression-override-vars*
18509,796328
+(defconst *hint-expression-backtrack-vars**hint-expression-backtrack-vars*
18512,796425
+(defconst *hint-expression-all-vars**hint-expression-all-vars*
18517,796610
+(defun@par translate-hint-expression (name-tree term hint-type ctx wrld state)translate-hint-expression
18522,796816
+(defun@par translate-backtrack-hint (name-tree arg ctx wrld state)translate-backtrack-hint
18709,804205
+(defun@par translate-rw-cache-state-hint (arg ctx wrld state)translate-rw-cache-state-hint
18712,804348
+(defun@par translate-or-hint (name-tree str arg ctx wrld state)translate-or-hint
18723,804690
+(defun@par translate-hint-settings (name-tree str key-val-lst ctx wrld state)translate-hint-settings
18775,806956
+(defun@par translate-x-hint-value (name-tree str x arg ctx wrld state)translate-x-hint-value
18809,808293
+(defun replace-goal-spec-in-name-tree1 (name-tree goal-spec)replace-goal-spec-in-name-tree1
18883,810918
+(defun replace-goal-spec-in-name-tree (name-tree goal-spec)replace-goal-spec-in-name-tree
18903,811659
+(defun@par translate-hint (name-tree pair hint-type ctx wrld state)translate-hint
18925,812656
+(defun@par translate-hint-expressions (name-tree terms hint-type ctx wrld state)translate-hint-expressions
19264,829727
+(defun@par check-translated-override-hint (hint uhint ctx state)check-translated-override-hint
19284,830597
+(defun@par translate-hints1 (name-tree lst hint-type override-hints ctx wrld state)translate-hints1
19295,831045
+(defun@par warn-on-duplicate-hint-goal-specs (lst seen ctx state)warn-on-duplicate-hint-goal-specs
19382,836056
+(defun@par translate-hints2 (name-tree lst hint-type override-hints ctx wrld state)translate-hints2
19403,837258
+(defun override-hints (wrld)override-hints
19415,837907
+(defun@par translate-hints (name-tree lst ctx wrld state)translate-hints
19559,845629
+(defun@par translate-hints+1 (name-tree lst default-hints ctx wrld state)translate-hints+1
19563,845793
+(defun translate-hints+ (name-tree lst default-hints ctx wrld state)translate-hints+
19574,846167
+(defun translate-override-hints (name-tree lst ctx wrld state)translate-override-hints
19583,846551
+(defun@par apply-override-hint1apply-override-hint1
19598,847162
+(defun@par apply-override-hintapply-override-hint
19711,851722
+(defun@par apply-override-hintsapply-override-hints
19734,852952
+(defun@par eval-and-translate-hint-expressioneval-and-translate-hint-expression
19757,853735
+(deflabel goal-specgoal-spec
20007,865666
+(deflabel hints-and-the-waterfallhints-and-the-waterfall
20114,869993
+(deflabel hintshints
20317,881905
+(deflabel clause-identifierclause-identifier
21059,917791
+(deflabel computed-hintscomputed-hints
21112,919841
+(deflabel using-computed-hints-1using-computed-hints-1
21265,928142
+(deflabel using-computed-hints-2using-computed-hints-2
21316,929363
+(deflabel using-computed-hints-3using-computed-hints-3
21421,933601
+(deflabel using-computed-hints-4using-computed-hints-4
21541,938576
+(deflabel using-computed-hints-5using-computed-hints-5
21686,944690
+(deflabel using-computed-hints-6using-computed-hints-6
21750,947051
+(deflabel using-computed-hints-7using-computed-hints-7
22006,957230
+(deflabel using-computed-hints-8using-computed-hints-8
22237,966461
+(deflabel using-computed-hintsusing-computed-hints
22279,968357
+(defmacro ttags-seen ()ttags-seen
22385,972920
+(defrec certify-book-infocertify-book-info
22443,975452
+(defun active-book-name (wrld state)active-book-name
22447,975547
+(defrec deferred-ttag-notedeferred-ttag-note
22458,976029
+(defun fms-to-standard-co (str alist state evisc-tuple)fms-to-standard-co
22462,976103
+(defun print-ttag-note (val active-book-name include-bookp deferred-p state)print-ttag-note
22469,976338
+(defun show-ttag-notes1 (notes state)show-ttag-notes1
22524,978991
+(defun show-ttag-notes-fn (state)show-ttag-notes-fn
22536,979492
+(defmacro show-ttag-notes ()show-ttag-notes
22553,980291
+(defun set-deferred-ttag-notes (val state)set-deferred-ttag-notes
22557,980391
+(defun ttags-from-deferred-ttag-notes1 (notes)ttags-from-deferred-ttag-notes1
22644,984045
+(defun ttags-from-deferred-ttag-notes (notes)ttags-from-deferred-ttag-notes
22654,984422
+(defun print-deferred-ttag-notes-summary (state)print-deferred-ttag-notes-summary
22657,984522
+(defun notify-on-defttag (val active-book-name include-bookp state)notify-on-defttag
22674,985296
+(defun ttag-allowed-p (ttag ttags active-book-name acc)ttag-allowed-p
22711,986823
+(defun chk-acceptable-ttag1 (val active-book-name ttags-allowed ttags-seenchk-acceptable-ttag1
22735,987811
+(defun chk-acceptable-ttag (val include-bookp ctx wrld state)chk-acceptable-ttag
22801,991130
+(defun chk-acceptable-ttags2 (ttag filenames ttags-allowed ttags-seenchk-acceptable-ttags2
22816,991614
+(defun chk-acceptable-ttags1 (vals active-book-name ttags-allowed ttags-seenchk-acceptable-ttags1
22832,992555
+(defun chk-acceptable-ttags (vals include-bookp ctx wrld state)chk-acceptable-ttags
22861,994247
+(defun chk-table-nil-args (op bad-arg bad-argn ctx state)chk-table-nil-args
22877,994992
+(defun chk-table-guard (name key val ctx wrld state)chk-table-guard
22889,995397
+(defun chk-table-guards-rec (name alist ctx pair wrld state)chk-table-guards-rec
22931,997197
+(defun chk-table-guards (name alist ctx wrld state)chk-table-guards
22945,997889
+(defun put-assoc-equal-fast (name val alist)put-assoc-equal-fast
22958,998513
+(defun global-set? (var val wrld old-val)global-set?
22970,998934
+(defun cltl-def-from-name2 (fn stobj-function axiomatic-p wrld)cltl-def-from-name2
22975,999046
+(defrec absstobj-infoabsstobj-info
22998,999967
+(defun cltl-def-from-name1 (fn stobj-function axiomatic-p wrld)cltl-def-from-name1
23002,1000023
+(defun cltl-def-from-name (fn wrld)cltl-def-from-name
23027,1001137
+(defun table-cltl-cmd (name key val op ctx wrld)table-cltl-cmd
23039,1001599
+(defun table-fn1 (name key val op term ctx wrld state event-form)table-fn1
23126,1006047
+(defun table-fn (name args state event-form)table-fn
23315,1015077
+(defun set-override-hints-fn (lst at-end ctx wrld state)set-override-hints-fn
23417,1019494
+
+prove.lisp,21496
+(defun abbreviationp1 (lambda-flg vars term2)abbreviationp1
37,1383
+(defun abbreviationp1-lst (lambda-flg vars lst)abbreviationp1-lst
55,2103
+(defun abbreviationp (lambda-flg vars term2)abbreviationp
63,2362
+(defun all-vars-bag (term ans)all-vars-bag
76,2858
+(defun all-vars-bag-lst (lst ans)all-vars-bag-lst
81,3012
+(defun find-abbreviation-lemma (term geneqv lemmas ens wrld)find-abbreviation-lemma
87,3175
+(defun expand-abbreviations-with-lemma (term geneqvexpand-abbreviations-with-lemma
122,4780
+(defun expand-abbreviations (term alist geneqv fns-to-be-ignored-by-rewriteexpand-abbreviations
150,5859
+(defun expand-abbreviations-lst (lst alist geneqv-lstexpand-abbreviations-lst
453,20221
+(defun and-orp (term bool)and-orp
473,21210
+(defun find-and-or-lemma (term bool lemmas ens wrld)find-and-or-lemma
484,21540
+(defun expand-and-or (term bool fns-to-be-ignored-by-rewrite ens wrld stateexpand-and-or
516,23118
+(defun clausify-input1 (term bool fns-to-be-ignored-by-rewrite ens wrld stateclausify-input1
623,28010
+(defun clausify-input1-lst (lst fns-to-be-ignored-by-rewrite ens wrld stateclausify-input1-lst
696,31558
+(defun clausify-input (term fns-to-be-ignored-by-rewrite ens wrld state ttreeclausify-input
716,32544
+(defun expand-some-non-rec-fns-in-clauses (fns clauses wrld)expand-some-non-rec-fns-in-clauses
742,33915
+(defun no-op-histp (hist)no-op-histp
761,34708
+(defun expand-any-final-implies1 (term wrld)expand-any-final-implies1
797,36294
+(defun expand-any-final-implies1-lst (term-lst wrld)expand-any-final-implies1-lst
829,37541
+(defun expand-any-final-implies (cl wrld)expand-any-final-implies
838,37783
+(defun rw-cache-state (wrld)rw-cache-state
861,38637
+(defmacro make-rcnst (ens wrld &rest args)make-rcnst
866,38807
+(defun cheap-type-alist-and-pot-lst (cl ens wrld state)cheap-type-alist-and-pot-lst
897,40189
+(defconst *tau-ttree**tau-ttree*
933,42001
+(defun tau-clausep (clause ens wrld state calist)tau-clausep
938,42132
+(defun tau-clausep-lst-rec (clauses ens wrld ans ttree state calist)tau-clausep-lst-rec
968,43160
+(defun tau-clausep-lst (clauses ens wrld ans ttree state calist)tau-clausep-lst
995,44156
+(defun preprocess-clause (cl hist pspv wrld state step-limit)preprocess-clause
1007,44567
+(defun tilde-*-preprocess-phrase (ttree)tilde-*-preprocess-phrase
1208,55184
+(defun tilde-*-raw-preprocess-phrase (ttree punct)tilde-*-raw-preprocess-phrase
1234,56087
+(defun preprocess-clause-msg1 (signal clauses ttree pspv state)preprocess-clause-msg1
1259,56913
+(defun more-than-simplifiedp (hist)more-than-simplifiedp
1317,59440
+(defun delete-assoc-eq-lst (lst alist)delete-assoc-eq-lst
1337,60301
+(defun delete-assumptions-1 (recs only-immediatep)delete-assumptions-1
1345,60572
+(defun delete-assumptions (ttree only-immediatep)delete-assumptions
1369,61677
+(defun save-and-print-acl2p-checkpoint (cl-id prettyified-clausesave-and-print-acl2p-checkpoint
1389,62381
+(defun find-the-first-checkpoint (h checkpoint-processors)find-the-first-checkpoint
1453,65470
+(defun acl2p-push-clause-printing (cl hist pspv wrld state)acl2p-push-clause-printing
1479,66541
+(defun@par push-clause (cl hist pspv wrld state)push-clause
1520,68260
+(defun push-clause-msg1-abort (cl-id ttree pspv state)push-clause-msg1-abort
1870,83741
+(defun push-clause-msg1 (cl-id signal clauses ttree pspv state)push-clause-msg1
1910,85411
+(deflabel otf-flgotf-flg
1934,86335
+(defun clause-set-subsumes-1 (init-subsumes-count cl-set1 cl-set2 acc)clause-set-subsumes-1
1978,88178
+(defun clause-set-subsumes (init-subsumes-count cl-set1 cl-set2)clause-set-subsumes
1992,88921
+(defun preprocess-clause? (cl hist pspv wrld state step-limit)preprocess-clause?
2005,89390
+(defun apply-use-hint-clauses (temp clauses pspv wrld state step-limit)apply-use-hint-clauses
2012,89736
+(defun apply-cases-hint-clause (temp cl pspv wrld)apply-cases-hint-clause
2125,94886
+(defun term-list-listp (l w)term-list-listp
2161,96157
+(defun non-term-listp-msg (x w)non-term-listp-msg
2168,96323
+(defun non-term-list-listp-msg (l w)non-term-list-listp-msg
2185,96769
+(defun eval-clause-processor (clause term stobjs-out ctx state)eval-clause-processor
2203,97242
+(defun eval-clause-processor@par (clause term stobjs-out ctx state)eval-clause-processor@par
2264,99856
+(defun apply-top-hints-clause1 (temp cl-id cl pspv wrld state step-limit)apply-top-hints-clause1
2339,103130
+(defun@par apply-top-hints-clause (cl-id cl hist pspv wrld ctx state step-limit)apply-top-hints-clause
2622,115943
+(defun tilde-@-lmi-phrase (lmi-lst k event-names)tilde-@-lmi-phrase
2715,120691
+(defun or-hit-msg (gag-mode-only-p cl-id ttree)or-hit-msg
2792,124085
+(defun apply-top-hints-clause-msg1apply-top-hints-clause-msg1
2815,125265
+(defun previous-process-was-speciousp (hist)previous-process-was-speciousp
3022,135320
+(defconst *preprocess-clause-ledge**preprocess-clause-ledge*
3120,140330
+(defmacro initialize-pspv-for-gag-mode (pspv)initialize-pspv-for-gag-mode
3151,141576
+(defun waterfall-update-gag-state (cl-id clause proc signal ttree pspvwaterfall-update-gag-state
3226,144790
+(defun waterfall-update-gag-state@par (cl-id clause proc signal ttree pspv state)waterfall-update-gag-state@par
3406,153957
+(defun@par record-gag-state (gag-state state)record-gag-state
3415,154291
+(defun@par gag-state-exiting-cl-id (signal cl-id pspv state)gag-state-exiting-cl-id
3421,154478
+(defun remove-pool-lst-from-gag-state (pool-lst gag-state state)remove-pool-lst-from-gag-state
3496,158438
+(defun pop-clause-update-gag-state-pop (pool-lsts gag-state msgs msg-p state)pop-clause-update-gag-state-pop
3550,160853
+(defun gag-mode-jppl-flg (gag-state)gag-mode-jppl-flg
3571,161530
+(defmacro splitter-output ()splitter-output
3592,162366
+(defdoc splittersplitter
3608,163056
+(defmacro set-splitter-output (val)set-splitter-output
3764,170386
+(defun waterfall-msg1waterfall-msg1
3798,172019
+(defmacro io?-prove-cw (vars body &rest keyword-args)io?-prove-cw
3859,174232
+(defmacro io?-prove@par (&rest rst)io?-prove@par
3871,174513
+(defun waterfall-print-clause-body (cl-id clause state)waterfall-print-clause-body
3878,174672
+(defmacro waterfall-print-clause-id-fmt1-call (cl-id)waterfall-print-clause-id-fmt1-call
3892,175140
+(defmacro waterfall-print-clause-id-fmt1-call@par (cl-id)waterfall-print-clause-id-fmt1-call@par
3905,175516
+(defmacro waterfall-print-clause-id (cl-id)waterfall-print-clause-id
3918,175914
+(defmacro waterfall-print-clause-id@par (cl-id)waterfall-print-clause-id@par
3925,176112
+(defproxy print-clause-id-okp (*) => *)print-clause-id-okp
3966,178163
+(defun print-clause-id-okp-builtin (cl-id)print-clause-id-okp-builtin
3968,178204
+(defun@par waterfall-print-clause (suppress-print cl-id clause state)waterfall-print-clause
3976,178406
+(defun some-parent-is-checkpointp (hist state)some-parent-is-checkpointp
3997,179285
+(defun@par waterfall-msgwaterfall-msg
4005,179564
+(defun put-ttree-into-pspv (ttree pspv)put-ttree-into-pspv
4093,183584
+(defun set-cl-ids-of-assumptions1 (recs cl-id)set-cl-ids-of-assumptions1
4098,183774
+(defun set-cl-ids-of-assumptions (ttree cl-id)set-cl-ids-of-assumptions
4108,184243
+(defun collect-assumptions1 (recs only-immediatep ans)collect-assumptions1
4127,185130
+(defun collect-assumptions (ttree only-immediatep)collect-assumptions
4145,185851
+(defun sublis-var-lst-lst (alist clauses)sublis-var-lst-lst
4169,186990
+(defun add-segments-to-clause (clause segments)add-segments-to-clause
4174,187178
+(defun split-initial-extra-info-lits (cl hyps-rev)split-initial-extra-info-lits
4180,187413
+(defun conjoin-clause-to-clause-set-extra-info1 (tags-rev cl0 cl cl-setconjoin-clause-to-clause-set-extra-info1
4187,187686
+(defun conjoin-clause-to-clause-set-extra-info (cl cl-set)conjoin-clause-to-clause-set-extra-info
4233,189795
+(defun conjoin-clause-sets-extra-info (cl-set1 cl-set2)conjoin-clause-sets-extra-info
4253,190866
+(defun maybe-add-extra-info-lit (debug-info term clause wrld)maybe-add-extra-info-lit
4270,191669
+(defun conjoin-clause-sets+ (debug-info cl-set1 cl-set2)conjoin-clause-sets+
4279,192026
+(defconst *equality-aliases**equality-aliases*
4283,192206
+(defun term-equated-to-constant (term)term-equated-to-constant
4290,192410
+(defun simplify-clause-for-term-equal-const-1 (var const cl)simplify-clause-for-term-equal-const-1
4301,192738
+(defun simplify-clause-for-term-equal-const (var const cl)simplify-clause-for-term-equal-const
4321,193648
+(defun add-literal-smart (lit cl at-end-flg)add-literal-smart
4330,193903
+(defun guard-clauses (term debug-info stobj-optp clause wrld ttree)guard-clauses
4349,194554
+(defun guard-clauses-lst (lst debug-info stobj-optp clause wrld ttree)guard-clauses-lst
4599,205948
+(defun linked-variables1 (vars direct-links changedp direct-links0)linked-variables1
4614,206451
+(defun linked-variables (vars direct-links)linked-variables
4631,207171
+(defun contains-constrained-constantp (term wrld)contains-constrained-constantp
4692,210541
+(defun contains-constrained-constantp-lst (lst wrld)contains-constrained-constantp-lst
4706,211185
+(defun disvar-type-alist1 (vars type-alist wrld)disvar-type-alist1
4714,211466
+(defun collect-all-vars (lst)collect-all-vars
4722,211840
+(defun disvar-type-alist (type-alist term wrld)disvar-type-alist
4726,211967
+(defun unencumber-type-alist (type-alist term rewrittenp wrld)unencumber-type-alist
4746,212831
+(defun unencumber-assumption (assn wrld)unencumber-assumption
4789,214837
+(defun unencumber-assumptions (assumptions wrld ans)unencumber-assumptions
4859,217065
+(defun dumb-type-alist-implicationp1 (type-alist1 type-alist2 seen)dumb-type-alist-implicationp1
4896,218652
+(defun dumb-type-alist-implicationp2 (type-alist1 type-alist2)dumb-type-alist-implicationp2
4908,219283
+(defun dumb-type-alist-implicationp (type-alist1 type-alist2)dumb-type-alist-implicationp
4914,219563
+(defun partition-according-to-assumption-term (assumptions alist)partition-according-to-assumption-term
4978,222941
+(defun exists-assumption-with-weaker-type-alist (assumption assumptions i)exists-assumption-with-weaker-type-alist
5000,223832
+(defun add-assumption-with-weak-type-alist (assumption assumptions ans)add-assumption-with-weak-type-alist
5018,224619
+(defun dumb-keep-assumptions-with-weakest-type-alists (assumptions kept)dumb-keep-assumptions-with-weakest-type-alists
5043,225744
+(defun dumb-assumption-subsumption1 (partitions ans)dumb-assumption-subsumption1
5078,227260
+(defun dumb-assumption-subsumption (assumptions)dumb-assumption-subsumption
5094,227786
+(defun clausify-type-alist (type-alist cl ens w seen ttree)clausify-type-alist
5111,228592
+(defun clausify-assumption (assumption ens wrld)clausify-assumption
5138,229831
+(defun clausify-assumptions (assumptions ens wrld pairs ttree)clausify-assumptions
5153,230232
+(defun strip-assumption-terms (lst)strip-assumption-terms
5171,230953
+(defun add-splitters-to-ttree1 (assumnotes tag ttree)add-splitters-to-ttree1
5179,231212
+(defun add-splitters-to-ttree (immediatep tag assumptions ttree)add-splitters-to-ttree
5188,231526
+(defun maybe-add-splitters-to-ttree (splitter-output immediatep tagmaybe-add-splitters-to-ttree
5202,232006
+(defun extract-and-clausify-assumptions (cl ttree only-immediatep ens wrldextract-and-clausify-assumptions
5208,232260
+(defun@par waterfall-step1 (processor cl-id clause hist pspv wrld statewaterfall-step1
5333,238754
+(defun@par process-backtrack-hint (cl-id clause clauses processor new-histprocess-backtrack-hint
5368,239889
+(defun set-rw-cache-state-in-pspv (pspv val)set-rw-cache-state-in-pspv
5409,241803
+(defun maybe-set-rw-cache-state-disabled (pspv)maybe-set-rw-cache-state-disabled
5417,242115
+(defun maybe-set-rw-cache-state-enabled (pspv)maybe-set-rw-cache-state-enabled
5425,242397
+(defun accumulate-rw-cache-into-pspv (processor ttree pspv)accumulate-rw-cache-into-pspv
5433,242678
+(defun erase-rw-cache-from-pspv (pspv)erase-rw-cache-from-pspv
5463,244154
+(defconst *simplify-clause-ledge**simplify-clause-ledge*
5484,245048
+(defconst *simplify-clause-ledge-complement**simplify-clause-ledge-complement*
5487,245141
+(defun@par waterfall-step-cleanup (processor cl-id clause hist wrld statewaterfall-step-cleanup
5491,245281
+(defun@par waterfall-step (processor cl-id clause hist pspv wrld ctx statewaterfall-step
5651,252201
+(defun@par find-applicable-hint-settings1find-applicable-hint-settings1
5823,260845
+(defun@par find-applicable-hint-settings (cl-id clause hist pspv ctx hints wrldfind-applicable-hint-settings
6006,270100
+(defun@par thanks-for-the-hint (goal-already-printed-p hint-settings state)thanks-for-the-hint
6020,270789
+(defun lmi-name-or-rune (lmi)lmi-name-or-rune
6088,273813
+(defun enabled-lmi-names1 (ens pairs)enabled-lmi-names1
6101,274213
+(defun enabled-lmi-names (ens lmi-lst wrld)enabled-lmi-names
6116,274755
+(defdoc using-enabled-rulesusing-enabled-rules
6137,275463
+(defun@par maybe-warn-for-use-hint (pspv cl-id ctx wrld state)maybe-warn-for-use-hint
6212,278479
+(defun@par maybe-warn-about-theory-simple (ens1 ens2 ctx wrld state)maybe-warn-about-theory-simple
6235,279328
+(defun@par maybe-warn-about-theory-from-rcnsts (rcnst1 rcnst2 ctx ens wrldmaybe-warn-about-theory-from-rcnsts
6246,279841
+(defun waterfall-or-hit-msg-a (cl-id user-hinti d-cl-id i branch-cnt state)waterfall-or-hit-msg-a
6292,281931
+(defun waterfall-or-hit-msg-b (cl-id d-cl-id branch-cnt state)waterfall-or-hit-msg-b
6328,283263
+(defun tilde-*-or-hit-summary-phrase1 (summary)tilde-*-or-hit-summary-phrase1
6348,284149
+(defun tilde-*-or-hit-summary-phrase (summary)tilde-*-or-hit-summary-phrase
6361,284622
+(defun waterfall-or-hit-msg-c (parent-cl-id results revert-d-cl-id cl-id summarywaterfall-or-hit-msg-c
6374,285055
+(defun term-difficulty1 (term wrld n)term-difficulty1
6443,288179
+(defun term-difficulty1-lst (lst wrld n)term-difficulty1-lst
6457,288782
+(defun term-difficulty (term wrld)term-difficulty
6463,288970
+(defun clause-difficulty (cl wrld)clause-difficulty
6471,289315
+(defun clause-set-difficulty (cl-set wrld)clause-set-difficulty
6476,289433
+(defun pool-difficulty (element0 pool wrld)pool-difficulty
6485,289793
+(defun how-many-to-be-proved (element0 pool)how-many-to-be-proved
6496,290196
+(defun pick-best-pspv-for-waterfall0-or-hit1pick-best-pspv-for-waterfall0-or-hit1
6508,290590
+(defun pick-best-pspv-for-waterfall0-or-hit (results pspv0 wrld)pick-best-pspv-for-waterfall0-or-hit
6561,293194
+(defun change-or-hit-history-entry (i hist cl-id)change-or-hit-history-entry
6595,294606
+(defun@par pair-cl-id-with-hint-setting (cl-id hint-settings)pair-cl-id-with-hint-setting
6647,296722
+(defun apply-reorder-hint-front (indices len clauses acc)apply-reorder-hint-front
6680,298405
+(defun apply-reorder-hint-back (indices current-index clauses acc)apply-reorder-hint-back
6687,298649
+(defun filter-> (lst max)filter->
6694,299006
+(defun@par apply-reorder-hint (pspv clauses ctx state)apply-reorder-hint
6701,299191
+(defun pspv-equal-except-for-tag-tree-and-pool (x y)pspv-equal-except-for-tag-tree-and-pool
6732,300543
+(defun list-extensionp-aux (rev-base rev-extension)list-extensionp-aux
6764,302020
+(defun list-extensionp (base extension)list-extensionp
6775,302348
+(defun find-list-extensions (base extension acc)find-list-extensions
6784,302571
+(defun combine-pspv-pools (base x y debug-pspv)combine-pspv-pools
6791,302790
+(defun combine-pspv-tag-trees (x y)combine-pspv-tag-trees
6802,303101
+(defun print-pspvs (base x y debug-pspv)print-pspvs
6811,303402
+(defun combine-prove-spec-vars (base x y ctx debug-pspv signal1 signal2)combine-prove-spec-vars
6820,303593
+(defun speculative-execution-valid (x y)speculative-execution-valid
6876,305567
+(defun abort-will-occur-in-pool (pool)abort-will-occur-in-pool
6891,306107
+(defrec maybe-to-be-proved-by-inductionmaybe-to-be-proved-by-induction
6933,308269
+(defun convert-maybes-to-tobe-subgoals (pool)convert-maybes-to-tobe-subgoals
6943,308546
+(defun convert-maybes-to-tobes (pool)convert-maybes-to-tobes
6958,309155
+(defun convert-maybes-to-tobes-in-pspv (pspv)convert-maybes-to-tobes-in-pspv
7026,312151
+(defun erase-rw-cache-any-tag-from-pspv (pspv)erase-rw-cache-any-tag-from-pspv
7035,312496
+(defun restore-rw-cache-state-in-pspv (new-pspv old-pspv)restore-rw-cache-state-in-pspv
7046,312862
+(defvar *waterfall-parallelism-timings-ht-alist* nil*waterfall-parallelism-timings-ht-alist*
7060,313616
+(defvar *waterfall-parallelism-timings-ht* nil*waterfall-parallelism-timings-ht*
7066,313910
+(defun setup-waterfall-parallelism-ht-for-name (name)setup-waterfall-parallelism-ht-for-name
7074,314296
+(defun clear-current-waterfall-parallelism-ht ()clear-current-waterfall-parallelism-ht
7098,315460
+(defun flush-waterfall-parallelism-hashtables ()flush-waterfall-parallelism-hashtables
7104,315593
+(defun save-waterfall-timings-for-cl-id (key value)save-waterfall-timings-for-cl-id
7112,315821
+(defun lookup-waterfall-timings-for-cl-id (key)lookup-waterfall-timings-for-cl-id
7119,316041
+(defmacro waterfall1-wrapper (form)waterfall1-wrapper
7127,316323
+(defparameter *acl2p-starting-proof-time* 0.0d0)*acl2p-starting-proof-time*
7138,316778
+(defun waterfall1-wrapper@par-before (cl-id state)waterfall1-wrapper@par-before
7141,316839
+(defun waterfall1-wrapper@par-after (cl-id start-time state)waterfall1-wrapper@par-after
7178,318379
+(defmacro waterfall1-wrapper@par (&rest form)waterfall1-wrapper@par
7203,319373
+(defun increment-waterfall-parallelism-counter (abbreviated-symbol)increment-waterfall-parallelism-counter
7216,319826
+(defun halves-with-length (clauses)halves-with-length
7241,320597
+(defun@par waterfall1waterfall1
7256,321112
+(defun@par waterfall0-with-hint-settingswaterfall0-with-hint-settings
7337,324697
+(defun@par waterfall0 (ledge cl-id clause hist pspv hints ens wrld ctx statewaterfall0
7380,326518
+(defun@par waterfall0-or-hit (ledge cl-id clause hist pspv hints ens wrld ctxwaterfall0-or-hit
7685,339184
+(defun waterfall1-lst (n parent-cl-id clauses hist pspv jppl-flgwaterfall1-lst
7898,348783
+(defun waterfall1-lst@par-serial (n parent-cl-id clauses hist pspv jppl-flgwaterfall1-lst@par-serial
7973,351650
+(defun waterfall1-tree@par-pseudo-parallel (n parent-cl-id clauses hist pspvwaterfall1-tree@par-pseudo-parallel
8037,354388
+(defun waterfall1-tree@par-parallel (n parent-cl-id clauses hist pspv jppl-flgwaterfall1-tree@par-parallel
8202,362384
+(defun waterfall1-lst@par (n parent-cl-id clauses hist pspv jppl-flgwaterfall1-lst@par
8417,373135
+(defun waterfall (forcing-round pool-lst x pspv hints ens wrld ctx statewaterfall
8556,378989
+(defun some-pool-member-subsumes (pool clause-set)some-pool-member-subsumes
8656,383838
+(defun add-to-pop-historyadd-to-pop-history
8672,384543
+(defun pop-clause1 (pool pop-history)pop-clause1
8718,386687
+(defun make-defthm-forms-for-byes (byes wrld)make-defthm-forms-for-byes
8794,390173
+(defun pop-clause-msg1 (forcing-round lst jppl-flg prev-action gag-state msg-ppop-clause-msg1
8805,390575
+(defun pop-clause-msg (forcing-round pop-history jppl-flg pspv state)pop-clause-msg
8971,398660
+(defun subsumed-clause-ids-from-pop-history (forcing-round pop-history)subsumed-clause-ids-from-pop-history
8996,399547
+(defun increment-proof-tree-pop-clause (forcing-round pop-history state)increment-proof-tree-pop-clause
9010,400125
+(defun pop-clause (forcing-round pspv jppl-flg state)pop-clause
9023,400708
+(defun tilde-@-assumnotes-phrase-lst (lst wrld)tilde-@-assumnotes-phrase-lst
9059,402341
+(defun tilde-*-assumnotes-column-phrase (assumnotes wrld)tilde-*-assumnotes-column-phrase
9111,405171
+(defun tilde-@-assumnotes-phrase-lst-gag-mode (lst acc)tilde-@-assumnotes-phrase-lst-gag-mode
9118,405388
+(defun tilde-*-assumnotes-column-phrase-gag-mode (assumnotes)tilde-*-assumnotes-column-phrase-gag-mode
9158,407267
+(defun process-assumptions-msg1 (forcing-round n pairs state)process-assumptions-msg1
9165,407496
+(defun process-assumptions-msg (forcing-round n0 n pairs state)process-assumptions-msg
9202,408977
+(deflabel forcing-roundforcing-round
9249,411209
+(deflabel failurefailure
9384,418560
+(deflabel failed-forcingfailed-forcing
9430,421203
+(defun count-assumptions (ttree)count-assumptions
9577,428226
+(defun add-type-alist-runes-to-ttree1 (type-alist runes)add-type-alist-runes-to-ttree1
9584,428412
+(defun add-type-alist-runes-to-ttree (type-alist ttree)add-type-alist-runes-to-ttree
9592,428684
+(defun process-assumptions-ttree (assns ttree)process-assumptions-ttree
9601,429105
+(defun process-assumptions (forcing-round pspv wrld state)process-assumptions
9613,429524
+(defun do-not-induct-msg (forcing-round pool-lst state)do-not-induct-msg
9693,432878
+(defun prove-loop2 (forcing-round pool-lst clauses pspv hints ens wrld ctxprove-loop2
9720,433810
+(defun prove-loop1 (forcing-round pool-lst clauses pspv hints ens wrld ctxprove-loop1
9827,438595
+(defun print-pstack-and-gag-state (state)print-pstack-and-gag-state
9838,439001
+(defun prove-loop0 (clauses pspv hints ens wrld ctx state)prove-loop0
9869,440332
+(defmacro bind-acl2-time-limit (form)bind-acl2-time-limit
9894,441382
+(defun prove-loop (clauses pspv hints ens wrld ctx state)prove-loop
9917,442387
+(defmacro make-pspv (ens wrld &rest args)make-pspv
9949,443750
+(defun chk-assumption-free-ttree (ttree ctx state)chk-assumption-free-ttree
9973,444759
+(defun prove (term pspv hints ens wrld ctx state)prove
10025,447197
+
+defuns.lisp,23404
+(defconst *mutual-recursion-ctx-string**mutual-recursion-ctx-string*
31,1307
+(defun translate-bodies1 (non-executablep names bodies bindingstranslate-bodies1
34,1394
+(defun chk-non-executable-bodies (names arglists bodies non-executablep ctxchk-non-executable-bodies
112,4978
+(defun translate-bodies (non-executablep names arglists bodies known-stobjs-lsttranslate-bodies
148,6709
+(defun chk-mutual-recursion-bad-names (lst names bodies)chk-mutual-recursion-bad-names
179,8164
+(defconst *chk-mutual-recursion-string**chk-mutual-recursion-string*
187,8476
+(defun chk-mutual-recursion1 (names bodies warnp ctx state)chk-mutual-recursion1
196,8863
+(defun chk-mutual-recursion (names bodies ctx state)chk-mutual-recursion
216,9530
+(defun ffnnamep-mod-mbe (fn term)ffnnamep-mod-mbe
245,10735
+(defun ffnnamep-mod-mbe-lst (fn l)ffnnamep-mod-mbe-lst
264,11537
+(defun putprop-recursivep-lst (names bodies wrld)putprop-recursivep-lst
279,11955
+(defrec tests-and-call (tests call) nil)tests-and-call
307,13291
+(defun all-calls (names term alist ans)all-calls
316,13658
+(defun all-calls-lst (names lst alist ans)all-calls-lst
345,14963
+(defun all-calls-alist (names alist ans)all-calls-alist
354,15203
+(defun termination-machine1 (tests calls ans)termination-machine1
363,15528
+(defun ffnnamesp-eq (fns term)ffnnamesp-eq
383,16304
+(defun ffnnamesp-eq-lst (fns l)ffnnamesp-eq-lst
393,16685
+(defun member-eq-all (a lst)member-eq-all
401,16823
+(defun termination-machine (names body alist tests ruler-extenders)termination-machine
407,16918
+(defun termination-machine-for-list (names bodies alist tests ruler-extenders)termination-machine-for-list
514,21848
+(defun termination-machines (names bodies ruler-extenders-lst)termination-machines
522,22236
+(defun proper-dumb-occur-as-output (x y)proper-dumb-occur-as-output
537,22839
+(defun always-tested-and-changedp (var pos t-machine)always-tested-and-changedp
562,23997
+(defun guess-measure (name defun-flg args pos t-machine ctx wrld state)guess-measure
588,25059
+(defun guess-measure-alist (names arglists measures t-machines ctx wrld state)guess-measure-alist
644,28120
+(defun remove-built-in-clauses (cl-set ens oncep-override wrld state ttree)remove-built-in-clauses
679,29922
+(defun length-exceedsp (lst n)length-exceedsp
714,31407
+(defun clean-up-clause-set (cl-set ens wrld ttree state)clean-up-clause-set
719,31533
+(defun measure-clause-for-branch (name tc measure-alist rel wrld)measure-clause-for-branch
801,35292
+(defun measure-clauses-for-fn1 (name t-machine measure-alist rel wrld)measure-clauses-for-fn1
832,36427
+(defun measure-clauses-for-fn (name t-machine measure-alist mp rel wrld)measure-clauses-for-fn
846,37045
+(defun measure-clauses-for-clique (names t-machines measure-alist mp rel wrld)measure-clauses-for-clique
877,38160
+(defun tilde-*-measure-phrase1 (alist wrld)tilde-*-measure-phrase1
894,38868
+(defun tilde-*-measure-phrase (alist wrld)tilde-*-measure-phrase
902,39209
+(defun find-?-measure (measure-alist)find-?-measure
930,40209
+(defun prove-termination (names t-machines measure-alist mp rel hints otf-flgprove-termination
939,40512
+(defun putprop-justification-lst (measure-alist subset-lst mp relputprop-justification-lst
1142,50446
+(defun union-equal-to-end (x y)union-equal-to-end
1170,51570
+(defun cross-tests-and-calls3 (tacs tacs-lst)cross-tests-and-calls3
1179,51827
+(defun cross-tests-and-calls2 (tacs-lst1 tacs-lst2)cross-tests-and-calls2
1195,52696
+(defun cross-tests-and-calls1 (tacs-lst-lst acc)cross-tests-and-calls1
1203,52955
+(defun sublis-tests-rev (test-alist acc)sublis-tests-rev
1212,53270
+(defun all-calls-test-alist (names test-alist acc)all-calls-test-alist
1230,54017
+(defun cross-tests-and-calls (names top-test-alist top-calls tacs-lst-lst)cross-tests-and-calls
1242,54423
+(defun induction-machine-for-fn1 (names body alist test-alist callsinduction-machine-for-fn1
1309,57925
+(defun induction-machine-for-fn1-lst (names bodies alist ruler-extenders accinduction-machine-for-fn1-lst
1669,76151
+(defun term-equated-to-constant-in-termlist (lst)term-equated-to-constant-in-termlist
1693,77225
+(defun simplify-tests (var const tests)simplify-tests
1702,77526
+(defun simplify-tests-and-calls (tc)simplify-tests-and-calls
1723,78461
+(defun simplify-tests-and-calls-lst (tc-list)simplify-tests-and-calls-lst
1747,79416
+(defun induction-machine-for-fn (names body ruler-extenders)induction-machine-for-fn
1769,80133
+(defun induction-machines (names bodies ruler-extenders-lst)induction-machines
1791,81054
+(defun putprop-induction-machine-lst (names bodies ruler-extenders-lstputprop-induction-machine-lst
1811,81943
+(defun quick-block-initial-settings (formals)quick-block-initial-settings
1825,82497
+(defun quick-block-info1 (var term)quick-block-info1
1830,82672
+(defun quick-block-info2 (setting info1)quick-block-info2
1835,82821
+(defun quick-block-settings (settings formals args)quick-block-settings
1843,83047
+(defun quick-block-down-t-machine (name settings formals t-machine)quick-block-down-t-machine
1852,83480
+(defun quick-block-info (name formals t-machine)quick-block-info
1868,84109
+(defun putprop-quick-block-info-lst (names t-machines wrld)putprop-quick-block-info-lst
1886,84876
+(deflabel subversive-recursionssubversive-recursions
1902,85506
+(deflabel subversive-inductionssubversive-inductions
2056,93495
+(defmacro big-mutrec (names)big-mutrec
2066,93663
+(defmacro update-w (condition new-w &optional retract-p)update-w
2076,94068
+(defun get-sig-fns1 (ee-lst)get-sig-fns1
2100,94916
+(defun get-sig-fns (wrld)get-sig-fns
2111,95339
+(defun selected-all-fnnames-lst (formals subset actuals acc)selected-all-fnnames-lst
2114,95422
+(defun subversivep (fns t-machine formals-and-subset-alist wrld)subversivep
2122,95722
+(defun subversive-cliquep (fns t-machines formals-and-subset-alist wrld)subversive-cliquep
2155,97064
+(defun prove-termination-non-recursive (names bodies mp rel hints otf-flgprove-termination-non-recursive
2190,98867
+(defun prove-termination-recursive (names arglists measures t-machinesprove-termination-recursive
2235,100687
+(defun put-induction-info-recursive (names arglists col ttree measure-alistput-induction-info-recursive
2278,102342
+(defun put-induction-info (names arglists measures ruler-extenders-lst bodiesput-induction-info
2330,104417
+(defun destructure-definition (term install-body ens wrld ttree)destructure-definition
2413,108408
+(defun member-rewrite-rule-rune (rune lst)member-rewrite-rule-rune
2470,110419
+(defun replace-rewrite-rule-rune (rune rule lst)replace-rewrite-rule-rune
2479,110712
+(defun preprocess-hyp (hyp)preprocess-hyp
2491,111130
+(defun preprocess-hyps (hyps)preprocess-hyps
2510,111945
+(defun add-definition-rule-with-ttree (rune nume clique controller-alistadd-definition-rule-with-ttree
2515,112101
+(defun add-definition-rule (rune nume clique controller-alist install-body termadd-definition-rule
2596,115787
+(defun listof-standardp-macro (lst)listof-standardp-macro
2605,116161
+(defun putprop-body-lst (names arglists bodies normalizepsputprop-body-lst
2620,116571
+(defun type-set-implied-by-term1 (term tvar fvar)type-set-implied-by-term1
2909,132219
+(defun type-set-implied-by-term (var not-flg term ens wrld ttree)type-set-implied-by-term
2934,133239
+(defun putprop-initial-type-prescriptions (names wrld)putprop-initial-type-prescriptions
2954,134134
+(defun map-returned-formals-via-formals (formals pockets returned-formals)map-returned-formals-via-formals
3003,136324
+(defun map-type-sets-via-formals (formals ts-lst returned-formals)map-type-sets-via-formals
3034,137962
+(defun vector-ts-union (ts-lst1 ts-lst2)vector-ts-union
3050,138671
+(defun map-cons-tag-trees (lst ttree)map-cons-tag-trees
3059,138983
+(defun type-set-and-returned-formals-with-rule1type-set-and-returned-formals-with-rule1
3068,139202
+(defun type-set-and-returned-formals-with-rule (tp term type-alist ens wrldtype-set-and-returned-formals-with-rule
3124,141482
+(defun type-set-and-returned-formals-with-rulestype-set-and-returned-formals-with-rules
3205,144698
+(defun type-set-and-returned-formals (term type-alist ens wrld ttree)type-set-and-returned-formals
3276,147662
+(defun type-set-and-returned-formals-lsttype-set-and-returned-formals-lst
3564,161696
+(defun guess-type-prescription-for-fn-step (name body ens wrld ttree)guess-type-prescription-for-fn-step
3582,162463
+(defconst *clique-step-install-interval**clique-step-install-interval*
3627,164525
+(defun guess-and-putprop-type-prescription-lst-for-clique-stepguess-and-putprop-type-prescription-lst-for-clique-step
3635,164804
+(defun cleanse-type-prescriptionscleanse-type-prescriptions
3699,167444
+(defun guess-and-putprop-type-prescription-lst-for-cliqueguess-and-putprop-type-prescription-lst-for-clique
3767,170690
+(defun get-normalized-bodies (names wrld)get-normalized-bodies
3818,173066
+(defun putprop-type-prescription-lst (names subversive-p def-nume ens wrldputprop-type-prescription-lst
3834,173686
+(defun putprop-level-no-lst (names wrld)putprop-level-no-lst
3979,179216
+(defun primitive-recursive-argp (var term wrld)primitive-recursive-argp
4005,180556
+(defun primitive-recursive-callp (formals args wrld)primitive-recursive-callp
4069,184157
+(defun primitive-recursive-callsp (formals calls wrld)primitive-recursive-callsp
4074,184389
+(defun primitive-recursive-machinep (formals machine wrld)primitive-recursive-machinep
4079,184621
+(defun putprop-primitive-recursive-defunp-lst (names wrld)putprop-primitive-recursive-defunp-lst
4096,185377
+(defun make-controller-pocket (formals vars)make-controller-pocket
4130,186922
+(defun make-controller-alist1 (names wrld)make-controller-alist1
4143,187395
+(defun make-controller-alist (names wrld)make-controller-alist
4167,188544
+(defun max-nume-exceeded-error (ctx)max-nume-exceeded-error
4184,189400
+(defun putprop-defun-runic-mapping-pairs1 (names def-nume tp-flg ind-flg wrld)putprop-defun-runic-mapping-pairs1
4193,189820
+(defun putprop-defun-runic-mapping-pairs (names tp-flg wrld)putprop-defun-runic-mapping-pairs
4230,191585
+(defun eval-ground-subexpressions-lst-lst (lst-lst ens wrld state ttree)eval-ground-subexpressions-lst-lst
4312,195799
+(defun guard-clauses+ (term debug-info stobj-optp clause ens wrld state ttree)guard-clauses+
4327,196382
+(defun guard-clauses-for-body (hyp-segments body debug-info stobj-optp ensguard-clauses-for-body
4336,196830
+(defun guard-clauses-for-fn (name debug-p ens wrld state ttree)guard-clauses-for-fn
4360,197846
+(defun guard-clauses-for-clique (names debug-p ens wrld state ttree)guard-clauses-for-clique
4430,200795
+(defun print-verify-guards-msg (names col state)print-verify-guards-msg
4451,201656
+(defun collect-ideals (names wrld acc)collect-ideals
4477,202560
+(defun collect-non-ideals (names wrld)collect-non-ideals
4483,202799
+(defun collect-non-common-lisp-compliants (names wrld)collect-non-common-lisp-compliants
4489,203038
+(defun all-fnnames1-exec (flg x acc)all-fnnames1-exec
4496,203358
+(defmacro all-fnnames-exec (term)all-fnnames-exec
4524,204550
+(defun chk-common-lisp-compliant-subfunctionschk-common-lisp-compliant-subfunctions
4527,204623
+(defun chk-acceptable-verify-guards-formula (name x ctx wrld state)chk-acceptable-verify-guards-formula
4556,206065
+(defun chk-acceptable-verify-guards (name ctx wrld state)chk-acceptable-verify-guards
4603,208208
+(defun guard-obligation-clauses (x guard-debug ens wrld state)guard-obligation-clauses
4694,212374
+(defun guard-obligation (x guard-debug ctx state)guard-obligation
4767,215437
+(defun prove-guard-clauses-msg (names cl-set cl-set-ttree displayed-goalprove-guard-clauses-msg
4847,219004
+(defmacro verify-guards-formula (x &key guard-debug &allow-other-keys)verify-guards-formula
4884,220593
+(defun prove-guard-clauses (names hints otf-flg guard-debug ctx ens wrld state)prove-guard-clauses
4932,222757
+(defun verify-guards-fn1 (names hints otf-flg guard-debug ctx state)verify-guards-fn1
5032,227312
+(defun verify-guards-fn (name state hints otf-flg guard-debug doc event-form)verify-guards-fn
5268,237438
+(defconst *super-defun-wart-table**super-defun-wart-table*
5359,241091
+(defun project-out-columns-i-and-j (i j table)project-out-columns-i-and-j
5408,243773
+(defconst *super-defun-wart-binding-alist**super-defun-wart-binding-alist*
5414,243972
+(defconst *super-defun-wart-stobjs-in-alist**super-defun-wart-stobjs-in-alist*
5417,244078
+(defun super-defun-wart-bindings (bindings)super-defun-wart-bindings
5420,244186
+(defun store-stobjs-ins (names stobjs-ins w)store-stobjs-ins
5427,244474
+(defun store-super-defun-warts-stobjs-in (names wrld)store-super-defun-warts-stobjs-in
5433,244726
+(defun collect-old-nameps (names wrld)collect-old-nameps
5447,245210
+(defun defuns-fn-short-cut (names docs pairs guards split-types-terms bodiesdefuns-fn-short-cut
5453,245434
+(defun print-defun-msg/collect-type-prescriptions (names wrld)print-defun-msg/collect-type-prescriptions
5490,247236
+(defun print-defun-msg/type-prescriptions1 (alist simp-phrase col state)print-defun-msg/type-prescriptions1
5514,248230
+(defun print-defun-msg/type-prescriptions (names ttree wrld col state)print-defun-msg/type-prescriptions
5556,250109
+(defun simple-signaturep (fn wrld)simple-signaturep
5599,251626
+(defun all-simple-signaturesp (names wrld)all-simple-signaturesp
5612,252106
+(defun print-defun-msg/signatures1 (names wrld state)print-defun-msg/signatures1
5617,252290
+(defun print-defun-msg/signatures (names wrld state)print-defun-msg/signatures
5641,253185
+(defun print-defun-msg (names ttree wrld col state)print-defun-msg
5654,253646
+(defun get-ignores (lst)get-ignores
5682,254800
+(defun get-ignorables (lst)get-ignorables
5688,254964
+(defun chk-all-stobj-names (lst msg ctx wrld state)chk-all-stobj-names
5694,255137
+(defun get-declared-stobj-names (edcls ctx wrld state)get-declared-stobj-names
5710,255838
+(defun get-stobjs-in-lst (lst ctx wrld state)get-stobjs-in-lst
5751,257690
+(defun chk-stobjs-out-bound (names bindings ctx state)chk-stobjs-out-bound
5803,260303
+(defun store-stobjs-out (names bindings w)store-stobjs-out
5811,260638
+(defun unparse-signature (x)unparse-signature
5820,260931
+(defun chk-defun-mode (defun-mode ctx state)chk-defun-mode
5832,261358
+(defun scan-to-cltl-command (wrld)scan-to-cltl-command
5846,261842
+(defconst *xargs-keywords**xargs-keywords*
5860,262328
+(defun plausible-dclsp1 (lst)plausible-dclsp1
5870,262652
+(defun plausible-dclsp (lst)plausible-dclsp
5889,263473
+(defun dcl-fields1 (lst)dcl-fields1
5918,264834
+(defun dcl-fields (lst)dcl-fields
5925,265121
+(defun strip-keyword-list (fields lst)strip-keyword-list
5939,265639
+(defun strip-dcls1 (fields lst)strip-dcls1
5953,266142
+(defun strip-dcls (fields lst)strip-dcls
5966,266756
+(defun fetch-dcl-fields2 (field-names kwd-list acc)fetch-dcl-fields2
5984,267591
+(defun fetch-dcl-fields1 (field-names lst)fetch-dcl-fields1
5994,268004
+(defun fetch-dcl-fields (field-names lst)fetch-dcl-fields
6005,268547
+(defun fetch-dcl-field (field-name lst)fetch-dcl-field
6016,269053
+(defun set-equalp-eq (lst1 lst2)set-equalp-eq
6034,269939
+(defun non-identical-defp-chk-measures (name new-measures old-measuresnon-identical-defp-chk-measures
6042,270243
+(defun non-identical-defp (def1 def2 chk-measure-p wrld)non-identical-defp
6096,272713
+(defun identical-defp (def1 def2 chk-measure-p wrld)identical-defp
6287,282403
+(defun redundant-or-reclassifying-defunp0 (defun-mode symbol-classredundant-or-reclassifying-defunp0
6294,282644
+(defun redundant-or-reclassifying-defunp (defun-mode symbol-classredundant-or-reclassifying-defunp
6531,292820
+(defun redundant-or-reclassifying-defunsp10 (defun-mode symbol-classredundant-or-reclassifying-defunsp10
6554,294201
+(defun redundant-or-reclassifying-defunsp1 (defun-mode symbol-classredundant-or-reclassifying-defunsp1
6574,295081
+(defun recover-defs-lst (fn wrld)recover-defs-lst
6579,295370
+(defun get-clique (fn wrld)get-clique
6644,298637
+(defun redundant-or-reclassifying-defunsp0 (defun-mode symbol-classredundant-or-reclassifying-defunsp0
6658,299233
+(defun get-unnormalized-bodies (names wrld)get-unnormalized-bodies
6706,302050
+(defun strip-last-elements (lst)strip-last-elements
6712,302299
+(defun redundant-or-reclassifying-defunsp (defun-mode symbol-classredundant-or-reclassifying-defunsp
6718,302500
+(defun collect-when-cadr-eq (sym lst)collect-when-cadr-eq
6869,310639
+(defun all-programp (names wrld)all-programp
6875,310853
+(defun formal-position (var formals i)formal-position
6952,314684
+(defun make-posns (formals vars)make-posns
6957,314843
+(defun relevant-posns-term (fn formals term fns clique-alist posns)relevant-posns-term
6964,315031
+(defun relevant-posns-term-lst (fn formals lst fns clique-alist posns)relevant-posns-term-lst
6985,315921
+(defun relevant-posns-call (fn formals actuals i fns clique-alistrelevant-posns-call
6992,316193
+(defun relevant-posns-clique1 (fns arglists bodies all-fns ans)relevant-posns-clique1
7022,317584
+(defun relevant-posns-clique-recur (fns arglists bodies clique-alist)relevant-posns-clique-recur
7050,318810
+(defun relevant-posns-clique-init (fns arglists guards split-types-termsrelevant-posns-clique-init
7057,319198
+(defun relevant-posns-lambdas (term ans)relevant-posns-lambdas
7104,320989
+(defun relevant-posns-lambdas-lst (termlist ans)relevant-posns-lambdas-lst
7116,321393
+(defun relevant-posns-merge (alist acc)relevant-posns-merge
7123,321601
+(defun relevant-posns-lambdas-top (bodies)relevant-posns-lambdas-top
7135,322133
+(defun relevant-posns-clique (fns arglists guards split-types-terms measuresrelevant-posns-clique
7139,322295
+(defun irrelevant-non-lambda-slots-clique2 (fn formals i posns acc)irrelevant-non-lambda-slots-clique2
7156,323245
+(defun irrelevant-non-lambda-slots-clique1 (fns arglists clique-alist acc)irrelevant-non-lambda-slots-clique1
7164,323566
+(defun irrelevant-non-lambda-slots-clique (fns arglists guardsirrelevant-non-lambda-slots-clique
7176,324118
+(defun tilde-*-irrelevant-formals-msg1 (slots)tilde-*-irrelevant-formals-msg1
7194,325136
+(defun tilde-*-irrelevant-formals-msg (slots)tilde-*-irrelevant-formals-msg
7202,325502
+(defun chk-irrelevant-formals (fns arglists guards split-types-terms measureschk-irrelevant-formals
7205,325634
+(deflabel irrelevant-formalsirrelevant-formals
7236,326979
+(defun chk-logic-subfunctions (names0 names terms wrld str ctx state)chk-logic-subfunctions
7305,330297
+(defun get-non-classical-fns-from-list (names wrld fns-sofar)get-non-classical-fns-from-list
7332,331554
+(defmacro get-non-classical-fns (lst wrld)get-non-classical-fns
7344,332075
+(defun get-non-classical-fns-aux (lst wrld fns-sofar)get-non-classical-fns-aux
7348,332191
+(defun strip-missing-measures (lst accum)strip-missing-measures
7363,332806
+(defun chk-classical-measures (measures names ctx wrld state)chk-classical-measures
7371,333063
+(defun chk-no-recursive-non-classical (non-classical-fns names mp relchk-no-recursive-non-classical
7391,333945
+(defun union-collect-non-x (x lst)union-collect-non-x
7428,335724
+(defun translate-measures (terms ctx wrld state)translate-measures
7433,335899
+(defun redundant-predefined-error-msg (name)redundant-predefined-error-msg
7465,337408
+(defun chk-acceptable-defuns-redundancy (names ctx wrld state)chk-acceptable-defuns-redundancy
7479,338082
+(defun chk-acceptable-defuns-verify-guards-er (names ctx wrld state)chk-acceptable-defuns-verify-guards-er
7566,341714
+(defun chk-non-executablep (defun-mode non-executablep ctx state)chk-non-executablep
7627,344467
+(defun chk-acceptable-defuns0 (fives ctx wrld state)chk-acceptable-defuns0
7649,345357
+(defun get-boolean-unambiguous-xargs-flg-lst (key lst default ctx state)get-boolean-unambiguous-xargs-flg-lst
7705,347848
+(defun chk-acceptable-defuns1 (names fives stobjs-in-lst defun-modechk-acceptable-defuns1
7713,348259
+(defun conditionally-memoized-fns (fns memoize-table)conditionally-memoized-fns
8011,361892
+(defun chk-acceptable-defuns (lst ctx wrld state #+:non-standard-analysis std-p)chk-acceptable-defuns
8029,362665
+(deflabel XARGSXARGS
8154,368736
+(defmacro link-doc-to-keyword (name parent see)link-doc-to-keyword
8303,375895
+(defmacro link-doc-to (name parent see)link-doc-to
8319,376220
+(defun build-valid-std-usage-clause (arglist body)build-valid-std-usage-clause
8488,383255
+(defun verify-valid-std-usage (names arglists bodies hints otf-flgverify-valid-std-usage
8496,383579
+(defun union-eq1-rev (x y)union-eq1-rev
8575,387185
+(defun collect-hereditarily-constrained-fnnames (names wrld ans)collect-hereditarily-constrained-fnnames
8585,387456
+(defun putprop-hereditarily-constrained-fnnames-lst (names bodies wrld)putprop-hereditarily-constrained-fnnames-lst
8599,388036
+(defun defuns-fn1 (tuple ens big-mutrec names arglists docs pairs guardsdefuns-fn1
8640,390048
+(defun defuns-fn0 (names arglists docs pairs guards measuresdefuns-fn0
8803,397473
+(defun strip-non-hidden-package-names (known-package-alist)strip-non-hidden-package-names
8854,399121
+(defun in-package-fn (str state)in-package-fn
8863,399545
+(defun defstobj-functionsp (names embedded-event-lst)defstobj-functionsp
8885,400388
+(defun index-of-non-number (lst)index-of-non-number
8949,404024
+(defun non-std-error (fn index formals actuals)non-std-error
8958,404230
+(defun non-std-body (name formals body)non-std-body
8967,404636
+(defun non-std-def-lst (def-lst)non-std-def-lst
8981,405129
+(defun make-udf-insigs (names wrld)make-udf-insigs
8996,405695
+(defun intro-udf (insig wrld)intro-udf
9005,405984
+(defun intro-udf-lst1 (insigs wrld)intro-udf-lst1
9044,407379
+(defun intro-udf-lst2 (insigs kwd-value-list-lst)intro-udf-lst2
9050,407584
+(defun intro-udf-lst (insigs kwd-value-list-lst wrld)intro-udf-lst
9088,409423
+(defun defun-ctx (def-lst state event-form #+:non-standard-analysis std-p)defun-ctx
9106,410241
+(defun install-event-defuns (names event-form def-lst0 symbol-classinstall-event-defuns
9124,410865
+(defun defuns-fn (def-lst state event-form #+:non-standard-analysis std-p)defuns-fn
9175,413012
+(defun defun-fn (def state event-form #+:non-standard-analysis std-p)defun-fn
9318,418817
+(defun args-fn (name state)args-fn
9333,419360
+(defmacro args (name)args
9420,423570
+(defun make-verify-termination-def (old-def new-dcls wrld)make-verify-termination-def
9441,424203
+(defun make-verify-termination-defs-lst (defs-lst lst wrld)make-verify-termination-defs-lst
9470,425455
+(defun chk-acceptable-verify-termination1 (lst clique fn1 ctx wrld state)chk-acceptable-verify-termination1
9486,426245
+(defun uniform-defun-modes (defun-mode clique wrld)uniform-defun-modes
9524,428390
+(defun chk-acceptable-verify-termination (lst ctx wrld state)chk-acceptable-verify-termination
9538,428994
+(defun verify-termination1 (lst state)verify-termination1
9609,432205
+(defun verify-termination-boot-strap-fn (lst state event-form)verify-termination-boot-strap-fn
9642,433646
+(defmacro when-logic3 (str x)when-logic3
9673,434732
+(defun verify-termination-fn (lst state)verify-termination-fn
9682,434998
+(defun fns-used-in-axioms (lst wrld ans)fns-used-in-axioms
9709,436191
+(defun check-out-instantiablep1 (fns wrld)check-out-instantiablep1
9735,437164
+(defun check-out-instantiablep (wrld)check-out-instantiablep
9744,437452
+
+proof-checker-pkg.lisp,40
+(defpkg "ACL2-PC" nil)"ACL2-PC"
23,881
+
+proof-checker-a.lisp,8305
+(defmacro pc-value (sym)pc-value
29,1271
+(defmacro pc-assign (key val)pc-assign
35,1467
+(defun initialize-pc-acl2 (state)initialize-pc-acl2
44,1747
+(defmacro state-stack ()state-stack
55,2076
+(defmacro old-ss ()old-ss
58,2129
+(defmacro ss-alist ()ss-alist
63,2244
+(defun define-global-name (var)define-global-name
66,2291
+(defmacro define-global (var)define-global
71,2407
+(define-global pc-prompt)pc-prompt
78,2623
+(define-global pc-prompt-depth-prefix)pc-prompt-depth-prefix
79,2649
+(define-global pc-print-macroexpansion-flg)pc-print-macroexpansion-flg
80,2688
+(define-global pc-print-prompt-and-instr-flg)pc-print-prompt-and-instr-flg
82,2786
+(defrec pc-statepc-state
93,3346
+(defconst *pc-state-fields-for-primitives**pc-state-fields-for-primitives*
102,3459
+(defmacro instruction (&optional state-stack-supplied-p)instruction
105,3572
+(defmacro goals (&optional state-stack-supplied-p)goals
112,3790
+(defmacro abbreviations (&optional state-stack-supplied-p)abbreviations
119,3996
+(defmacro local-tag-tree (&optional state-stack-supplied-p)local-tag-tree
126,4218
+(defmacro pc-ens (&optional state-stack-supplied-p)pc-ens
133,4442
+(defmacro tag-tree (&optional state-stack-supplied-p)tag-tree
140,4650
+(defrec goalgoal
153,5192
+(defconst *goal-fields**goal-fields*
159,5279
+(defmacro conc (&optional ss-supplied-p)conc
162,5354
+(defmacro hyps (&optional ss-supplied-p)hyps
165,5449
+(defmacro current-addr (&optional ss-supplied-p)current-addr
168,5544
+(defmacro goal-name (&optional ss-supplied-p)goal-name
171,5655
+(defmacro depends-on (&optional ss-supplied-p)depends-on
174,5760
+(defmacro make-official-pc-command (sym)make-official-pc-command
177,5867
+(defun intern-in-keyword-package (sym)intern-in-keyword-package
181,6021
+(defun make-pretty-pc-command (x)make-pretty-pc-command
185,6142
+(defun make-pretty-pc-instr (instr)make-pretty-pc-instr
190,6308
+(defmacro change-pc-state (pc-s &rest args)change-pc-state
201,6703
+(defun make-official-pc-instr (instr)make-official-pc-instr
204,6787
+(defun check-formals-length (formals args fn ctx state)check-formals-length
221,7430
+(defun check-&optional-and-&rest (formals state)check-&optional-and-&rest
250,8843
+(defun make-let-pairs-from-formals (formals arg)make-let-pairs-from-formals
276,9986
+(defun all-symbols (form)all-symbols
292,10609
+(defun all-symbols-list (x)all-symbols-list
306,10959
+(defun make-access-bindings (record-name record fields)make-access-bindings
314,11099
+(defun let-form-for-pc-state-vars (form)let-form-for-pc-state-vars
320,11356
+(defun check-field-names (formals ctx state)check-field-names
332,11875
+(defmacro print-no-change (&optional str alist (col '0))print-no-change
342,12293
+(defmacro print-no-change2 (&rest args)print-no-change2
345,12399
+(defun print-no-change-fn (str alist col state)print-no-change-fn
349,12509
+(defmacro maybe-update-instruction (instr pc-state-and-state)maybe-update-instruction
369,13303
+(defun add-pc-doc-header (command-type str)add-pc-doc-header
378,13703
+(defun remove-doc (command-type body)remove-doc
389,13990
+(defun pc-primitive-defun-form (raw-name name formals doc body)pc-primitive-defun-form
396,14302
+(defun pc-command-table-guard (key val wrld)pc-command-table-guard
419,15194
+(defmacro add-pc-command (name command-type)add-pc-command
452,16071
+(defmacro pc-command-type (name)pc-command-type
455,16167
+(defmacro print-no-change3 (&optional str alist (col '0))print-no-change3
458,16273
+(defun add-pc-command-1 (name command-type state)add-pc-command-1
462,16412
+(defun toggle-pc-macro-fn (name new-tp state)toggle-pc-macro-fn
469,16616
+(defun pc-meta-or-macro-defun (raw-name name formals doc body)pc-meta-or-macro-defun
494,18233
+(defun goal-names (goals)goal-names
513,19018
+(defun instructions-of-state-stack (ss acc)instructions-of-state-stack
519,19162
+(defmacro fms0 (str &optional alist col (evisc-tuple 'nil evisc-tuple-p))fms0
528,19442
+(defmacro with-output-forced (output-chan signature code)with-output-forced
542,19986
+(defun print-pc-prompt (state)print-pc-prompt
566,20775
+(defun pc-macroexpand (raw-instr state)pc-macroexpand
577,21128
+(defun find-goal (name goals)find-goal
605,22419
+(defun print-all-goals-proved-message (state)print-all-goals-proved-message
612,22600
+(defmacro when-goals (form)when-goals
621,22874
+(defmacro when-goals-trip (form)when-goals-trip
626,22979
+(defun current-immediate-deps (goal-name goal-names)current-immediate-deps
632,23125
+(defun goal-dependent-p (parent name)goal-dependent-p
642,23550
+(defun current-all-deps (goal-name goal-names)current-all-deps
650,23766
+(defun maybe-print-proved-goal-message (goal old-goals goals state)maybe-print-proved-goal-message
660,24179
+(defun accumulate-ttree-in-pc-state (pc-state state)accumulate-ttree-in-pc-state
703,26335
+(defun pc-process-assumptions (pc-ens ttree wrld state)pc-process-assumptions
710,26628
+(defun make-implication (assumptions concl)make-implication
737,27407
+(defun cl-set-to-implications (cl-set)cl-set-to-implications
743,27557
+(defun known-assumptions (type-alist assns)known-assumptions
750,27792
+(defun add-assumptions-to-top-goaladd-assumptions-to-top-goal
767,28524
+(defun unproved-goals (pc-state)unproved-goals
794,29767
+(defun make-pc-ens (pc-ens state)make-pc-ens
802,29986
+(defun initial-rcnst-from-ens (ens wrld splitter-output)initial-rcnst-from-ens
807,30072
+(defun make-new-goals-fixed-hyps (termlist hyps goal-name start-index)make-new-goals-fixed-hyps
817,30496
+(defun pc-single-step-primitive (instr state)pc-single-step-primitive
830,30977
+(defun maybe-print-macroexpansion (instr raw-instr state)maybe-print-macroexpansion
1014,40452
+(defun pc-single-step-1 (raw-instr state)pc-single-step-1
1033,41476
+(defun union-lastn-pc-tag-trees (n ss acc)union-lastn-pc-tag-trees
1105,45355
+(defun pc-single-step (raw-instr state)pc-single-step
1118,45751
+(defconst *pc-complete-signal* 'acl2-pc-complete)*pc-complete-signal*
1149,47365
+(defmacro catch-throw-to-local-top-level (form)catch-throw-to-local-top-level
1151,47416
+(defun pc-main-loop (instr-list quit-conditions last-valuepc-main-loop
1179,48411
+(defun make-initial-goal (term)make-initial-goal
1264,51976
+(defun initial-state-stack (term raw-term event-name rule-classes pc-ens)initial-state-stack
1272,52134
+(defun event-name-and-types-and-raw-term (state-stack)event-name-and-types-and-raw-term
1282,52526
+(defmacro install-initial-state-stack (term raw-term event-name rule-classes)install-initial-state-stack
1285,52648
+(defun pc-main1 (instr-list quit-conditions pc-print-prompt-and-instr-flgpc-main1
1295,53051
+(defun pc-main (term raw-term event-name rule-classes instr-listpc-main
1302,53300
+(defun pc-top (raw-term event-name rule-classes instr-list quit-conditions state)pc-top
1308,53624
+(defun illegal-fnp (x w)illegal-fnp
1329,54338
+(defun illegal-fnp-list (x w)illegal-fnp-list
1343,54725
+(defun verify-fn (raw-term raw-term-supplied-p event-name rule-classesverify-fn
1349,54868
+(defun print-unproved-goals-message (goals state)print-unproved-goals-message
1403,56789
+(defun state-stack-from-instructionsstate-stack-from-instructions
1412,57176
+(defun state-from-instructionsstate-from-instructions
1423,57657
+(defun print-pc-defthm (ev state)print-pc-defthm
1431,57947
+(defmacro print-pc-goal (&optional goal)print-pc-goal
1442,58320
+(defmacro print-pc-state (&optional pc-state)print-pc-state
1467,59442
+(defun proof-checkerproof-checker
1486,60241
+(deflabel proof-checker-commandsproof-checker-commands
1571,64102
+(deflabel macro-commandmacro-command
1581,64405
+(defmacro verify (&optional (raw-term 'nil raw-term-supplied-p)verify
1608,65634
+(deflabel instructionsinstructions
1660,67491
+(defun sublis-expr-non-quoteps (alist term)sublis-expr-non-quoteps
2184,87602
+(defun sublis-expr-non-quoteps-lst (alist lst)sublis-expr-non-quoteps-lst
2202,88366
+(defun invert-abbreviations-alist (alist)invert-abbreviations-alist
2209,88568
+(defun abbreviate (term abbreviations)abbreviate
2216,88799
+(defmacro untrans0 (term &optional iff-flg abbreviations)untrans0
2221,88957
+(defun untrans0-lst-fn (termlist iff-flg abbreviations state)untrans0-lst-fn
2227,89152
+(defmacro untrans0-lst (termlist &optional iff-flg abbreviations)untrans0-lst
2233,89382
+
+defthm.lisp,29770
+(defun remove-lambdas (term)remove-lambdas
51,2105
+(defun remove-lambdas-lst (termlist)remove-lambdas-lst
61,2420
+(defun interpret-term-as-rewrite-rule2 (name hyps lhs rhs wrld)interpret-term-as-rewrite-rule2
72,2676
+(defun interpret-term-as-rewrite-rule1 (term equiv-okp ens wrld)interpret-term-as-rewrite-rule1
107,3973
+(defun interpret-term-as-rewrite-rule (name hyps term ens wrld)interpret-term-as-rewrite-rule
144,5842
+(defun non-recursive-fnnames (term ens wrld)non-recursive-fnnames
191,7520
+(defun non-recursive-fnnames-lst (lst ens wrld)non-recursive-fnnames-lst
206,8212
+(defun hide-lambdas1 (formals)hide-lambdas1
217,8637
+(defun hide-lambdas (lst)hide-lambdas
227,8991
+(defun variantp (term1 term2)variantp
237,9369
+(defun surrounding-fns1 (vars term fn acc)surrounding-fns1
255,9841
+(defun surrounding-fns-lst (vars term-list fn acc)surrounding-fns-lst
283,10936
+(defun surrounding-fns (vars term)surrounding-fns
291,11154
+(defun loop-stopper1 (alist vars lhs)loop-stopper1
317,12154
+(defun loop-stopper (lhs rhs)loop-stopper
327,12573
+(defun remove-irrelevant-loop-stopper-pairs (pairs vars)remove-irrelevant-loop-stopper-pairs
502,22921
+(defun put-match-free-value (match-free-value rune wrld)put-match-free-value
520,23572
+(defun free-vars-in-hyps (hyps bound-vars wrld)free-vars-in-hyps
538,24207
+(defun free-vars-in-hyps-simple (hyps bound-vars)free-vars-in-hyps-simple
578,26063
+(defun free-vars-in-fc-hyps (triggers hyps concls)free-vars-in-fc-hyps
590,26581
+(defun free-vars-in-hyps-considering-bind-free (hyps bound-vars wrld)free-vars-in-hyps-considering-bind-free
602,26998
+(defun all-vars-in-hyps (hyps)all-vars-in-hyps
669,30005
+(defun match-free-value (match-free hyps pat wrld)match-free-value
700,31295
+(defun match-free-fc-value (match-free hyps concls triggers wrld)match-free-fc-value
710,31608
+(defun rule-backchain-limit-lst (backchain-limit-lst hyps wrld flg)rule-backchain-limit-lst
723,32205
+(defun create-rewrite-rule (rune nume hyps equiv lhs rhs loop-stopper-lstcreate-rewrite-rule
731,32546
+(defun hyps-that-instantiate-free-vars (free-vars hyps)hyps-that-instantiate-free-vars
773,34336
+(defun maybe-one-way-unify (pat term alist)maybe-one-way-unify
790,35023
+(defun maybe-one-way-unify-lst (pat-lst term-lst alist)maybe-one-way-unify-lst
808,35722
+(defun maybe-one-way-unify-with-some (pat term-lst alist)maybe-one-way-unify-with-some
815,36003
+(defun maybe-subsumes (cl1 cl2 alist)maybe-subsumes
824,36378
+(defun subsumes-rewrite-rule (rule1 rule2 wrld)subsumes-rewrite-rule
849,37587
+(defun find-subsumed-rule-names (lst rule ens wrld)find-subsumed-rule-names
901,39816
+(defun find-subsuming-rule-names (lst rule ens wrld)find-subsuming-rule-names
918,40669
+(defun forced-hyps (lst)forced-hyps
934,41477
+(defun strip-top-level-nots-and-forces (hyps)strip-top-level-nots-and-forces
943,41803
+(defun free-variable-error? (token name ctx wrld state)free-variable-error?
957,42386
+(defun extend-geneqv-alist (var geneqv alist wrld)extend-geneqv-alist
976,43434
+(defun covered-geneqv-alist (term geneqv alist wrld)covered-geneqv-alist
988,43848
+(defun covered-geneqv-alist-lst (termlist geneqv-lst alist wrld)covered-geneqv-alist-lst
1009,44746
+(defun uncovered-equivs (geneqv covered-geneqv wrld)uncovered-equivs
1019,45169
+(defun uncovered-equivs-alist (term geneqv var-geneqv-alist var-geneqv-alist0uncovered-equivs-alist
1029,45553
+(defun uncovered-equivs-alist-lst (termlist geneqv-lst var-geneqv-alistuncovered-equivs-alist-lst
1123,49818
+(defun double-rewrite-opportunities (hyp-index hyps var-geneqv-alistdouble-rewrite-opportunities
1143,50828
+(defun show-double-rewrite-opportunities1 (location var-equivs-alistshow-double-rewrite-opportunities1
1244,56794
+(defun show-double-rewrite-opportunities (hyp-var-equivs-counts-alist-pairsshow-double-rewrite-opportunities
1279,58722
+(defun irrelevant-loop-stopper-pairs (pairs vars)irrelevant-loop-stopper-pairs
1301,59814
+(defun chk-rewrite-rule-warnings (name match-free loop-stopper rule ctx enschk-rewrite-rule-warnings
1313,60194
+(defun chk-acceptable-rewrite-rule2 (name match-free loop-stopper hyps conclchk-acceptable-rewrite-rule2
1496,69429
+(defun chk-acceptable-rewrite-rule1 (name match-free loop-stopper lst ctx enschk-acceptable-rewrite-rule1
1527,70890
+(defun chk-acceptable-rewrite-rule (name match-free loop-stopper term ctx enschk-acceptable-rewrite-rule
1546,71748
+(defun add-rewrite-rule2 (rune nume hyps concl loop-stopper-lstadd-rewrite-rule2
1565,72732
+(defun add-rewrite-rule1 (rune nume lst loop-stopper-lstadd-rewrite-rule1
1638,76389
+(defun add-rewrite-rule (rune nume loop-stopper-lst termadd-rewrite-rule
1659,77356
+(deflabel linearlinear
1675,78021
+(defun expand-inequality-fncall1 (term)expand-inequality-fncall1
1814,85809
+(defun expand-inequality-fncall (term)expand-inequality-fncall
1837,86784
+(defun all-vars-in-poly-lst (lst)all-vars-in-poly-lst
1882,89018
+(defun subbagp-eq (bag1 bag2)subbagp-eq
1893,89369
+(defun always-biggerp-data (term)always-biggerp-data
1900,89568
+(defun always-biggerp-data-lst (lst)always-biggerp-data-lst
1908,89759
+(defun always-biggerp (abd1 abd2)always-biggerp
1916,89952
+(defun no-element-always-biggerp (abd-lst abd)no-element-always-biggerp
1940,91005
+(defun maximal-terms1 (abd-lst abd-lst0 needed-vars)maximal-terms1
1950,91362
+(defun maximal-terms (lst hyp-vars concl-vars)maximal-terms
1965,91985
+(defun collect-when-ffnnamesp (fns lst)collect-when-ffnnamesp
2000,93721
+(defun make-free-max-terms-msg1 (max-terms vars hyps)make-free-max-terms-msg1
2010,94026
+(defun make-free-max-terms-msg (name max-terms vars hyps)make-free-max-terms-msg
2037,95393
+(defun external-linearize (term ens wrld state)external-linearize
2053,95997
+(defun bad-synp-hyp-msg-for-linear (max-terms hyps wrld)bad-synp-hyp-msg-for-linear
2063,96240
+(defun show-double-rewrite-opportunities-linear (hyps max-terms final-term nameshow-double-rewrite-opportunities-linear
2072,96620
+(defun chk-acceptable-linear-rule2chk-acceptable-linear-rule2
2093,97521
+(defun chk-acceptable-linear-rule1 (name match-free trigger-terms lst ctx enschk-acceptable-linear-rule1
2232,105258
+(defun chk-acceptable-linear-rule (name match-free trigger-terms term ctx enschk-acceptable-linear-rule
2248,105937
+(defun add-linear-rule3 (rune nume hyps concl max-termsadd-linear-rule3
2266,106792
+(defun add-linear-rule2 (rune nume trigger-terms hyps concladd-linear-rule2
2308,108745
+(defun add-linear-rule1 (rune nume trigger-terms lstadd-linear-rule1
2323,109448
+(defun add-linear-rule (rune nume trigger-terms termadd-linear-rule
2339,110251
+(deflabel well-founded-relationwell-founded-relation
2381,111647
+(defun destructure-well-founded-relation-rule (term)destructure-well-founded-relation-rule
2561,119582
+(defun chk-acceptable-well-founded-relation-rule (name term ctx wrld state)chk-acceptable-well-founded-relation-rule
2600,120899
+(defun add-well-founded-relation-rule (rune nume term wrld)add-well-founded-relation-rule
2637,122528
+(deflabel built-in-clausebuilt-in-clause
2649,123014
+(defun chk-acceptable-built-in-clause-rule2 (name hyps concl ctx wrld state)chk-acceptable-built-in-clause-rule2
2786,128489
+(defun chk-acceptable-built-in-clause-rule1 (name lst ctx wrld state)chk-acceptable-built-in-clause-rule1
2811,129588
+(defun chk-acceptable-built-in-clause-rule (name term ctx wrld state)chk-acceptable-built-in-clause-rule
2825,130115
+(defun fn-and-maximal-level-no (term wrld fn max)fn-and-maximal-level-no
2841,130847
+(defun fn-and-maximal-level-no-lst (lst wrld fn max)fn-and-maximal-level-no-lst
2867,132104
+(defun built-in-clause-discriminator-fn (cl wrld)built-in-clause-discriminator-fn
2876,132352
+(defun all-fnnames-subsumer (cl wrld)all-fnnames-subsumer
2882,132525
+(defun make-built-in-clause-rules1 (rune nume clauses wrld)make-built-in-clause-rules1
2906,133958
+(defun chk-initial-built-in-clauses (lst wrld good-lst some-badp)chk-initial-built-in-clauses
2930,135135
+(defun make-built-in-clause-rules (rune nume lst wrld)make-built-in-clause-rules
2959,136375
+(defun classify-and-store-built-in-clause-rules (lst pots wrld)classify-and-store-built-in-clause-rules
2975,137041
+(defun add-built-in-clause-rule (rune nume term wrld)add-built-in-clause-rule
3021,139510
+(deflabel compound-recognizercompound-recognizer
3053,141010
+(defun destructure-compound-recognizer (term)destructure-compound-recognizer
3264,151242
+(defun make-recognizer-tuple (rune nume parity fn var term ens wrld)make-recognizer-tuple
3322,153795
+(defun comment-on-new-recog-tuple1 (new-recog-tuple recognizer-alistcomment-on-new-recog-tuple1
3389,156783
+(defun comment-on-new-recog-tuple (new-recog-tuple ctx ens wrld state)comment-on-new-recog-tuple
3447,159882
+(defun chk-acceptable-compound-recognizer-rule (name term ctx ens wrld state)chk-acceptable-compound-recognizer-rule
3510,163011
+(defun add-compound-recognizer-rule (rune nume term ens wrld)add-compound-recognizer-rule
3567,165414
+(deflabel forward-chainingforward-chaining
3590,166473
+(defun chk-triggers (name match-free hyps terms hyps-vars concls-vars ctx enschk-triggers
3744,174739
+(defun destructure-forward-chaining-term (term)destructure-forward-chaining-term
3870,181943
+(defun chk-acceptable-forward-chaining-rule (name match-free trigger-terms termchk-acceptable-forward-chaining-rule
3911,183865
+(defun putprop-forward-chaining-rules-lstputprop-forward-chaining-rules-lst
3932,184611
+(defun add-forward-chaining-rule (rune nume trigger-terms term match-free wrld)add-forward-chaining-rule
3954,185576
+(deflabel metameta
3970,186313
+(deflabel evaluator-restrictionsevaluator-restrictions
4358,205814
+(deflabel extended-metafunctionsextended-metafunctions
4831,223133
+(deflabel meta-extractmeta-extract
5193,239409
+(defun evaluator-clause/arglist (evfn formals x)evaluator-clause/arglist
5520,255629
+(defun evaluator-clause (evfn fn-args)evaluator-clause
5534,256219
+(defun evaluator-clauses1 (evfn fn-args-lst)evaluator-clauses1
5562,257216
+(defun evaluator-clauses (evfn evfn-lst fn-args-lst)evaluator-clauses
5567,257419
+(defun cdrp (x term)cdrp
5668,262899
+(defun expand-eq-and-atom-term-lst (lst)expand-eq-and-atom-term-lst
5684,263448
+(defun normalize-alleged-evaluator-clause (clause)normalize-alleged-evaluator-clause
5738,265849
+(defun normalize-alleged-evaluator-clause-set (lst)normalize-alleged-evaluator-clause-set
5748,266194
+(defun shallow-clausify1 (lst)shallow-clausify1
5753,266408
+(defun shallow-clausify (term)shallow-clausify
5766,266790
+(defun find-evfn-lst-in-clause (evfn cl)find-evfn-lst-in-clause
5786,267659
+(defun guess-evfn-lst-for-evfn (evfn cl-set)guess-evfn-lst-for-evfn
5817,268743
+(defun find-fn-in-clause (cl wrld)find-fn-in-clause
5829,269224
+(defun guess-fn-args-lst-for-evfn (cl-set wrld)guess-fn-args-lst-for-evfn
5843,269740
+(defun normalized-evaluator-cl-set (ev wrld)normalized-evaluator-cl-set
5857,270425
+(defun chk-evaluator (evfn wrld ctx state)chk-evaluator
5867,270749
+(defun defevaluator-form/defthms (evfn prefix i clauses)defevaluator-form/defthms
5948,274763
+(defun defevaluator-form/fns-clauses (evfn fn-args-lst)defevaluator-form/fns-clauses
5963,275503
+(defconst *defevaluator-form-base-theory**defevaluator-form-base-theory*
5985,276273
+(defun defevaluator-form (evfn evfn-lst fn-args-lst)defevaluator-form
5994,276616
+(defun pairs-to-macro-alias-msgs (alist)pairs-to-macro-alias-msgs
6046,278681
+(defun defevaluator-check-msg (alist macro-aliases wrld bad macro-alist)defevaluator-check-msg
6053,278971
+(defun defevaluator-check (x evfn evfn-lst fn-args-lst ctx state)defevaluator-check
6089,280813
+(defun defevaluator-check-form (x evfn evfn-lst fn-args-lst)defevaluator-check-form
6115,281949
+(defmacro defevaluator (&whole x evfn evfn-lst fn-args-lst &key skip-checks)defevaluator
6129,282308
+(deflabel term-tableterm-table
6251,287343
+(defun remove-meta-extract-contextual-hyps (hyps ev mfc-symbol a)remove-meta-extract-contextual-hyps
6287,288716
+(defun remove-meta-extract-global-hyps (hyps ev)remove-meta-extract-global-hyps
6318,290111
+(defun meta-rule-hypothesis-functions (hyp ev x a mfc-symbol)meta-rule-hypothesis-functions
6338,290820
+(defun meta-fn-args (term extendedp ens state)meta-fn-args
6380,292547
+(defun chk-meta-function (metafn name trigger-fns extendedpchk-meta-function
6406,293397
+(defun ev-lst-from-ev (ev wrld)ev-lst-from-ev
6460,295804
+(defun attached-fns (fns wrld)attached-fns
6469,296010
+(defun siblings (f wrld)siblings
6480,296461
+(defun canonical-sibling (f wrld)canonical-sibling
6485,296620
+(defun canonical-ffn-symbs (term wrld ans ignore-fns rlp)canonical-ffn-symbs
6494,296921
+(defun canonical-ffn-symbs-lst (lst wrld ans ignore-fns rlp)canonical-ffn-symbs-lst
6521,297849
+(defun collect-canonical-siblings (fns wrld ans ignore-fns)collect-canonical-siblings
6532,298125
+(defun immediate-canonical-ancestors (fn wrld ignore-fns rlp)immediate-canonical-ancestors
6544,298537
+(defun canonical-ancestors-rec (fns wrld ans rlp)canonical-ancestors-rec
6571,299948
+(defun canonical-ancestors (fn wrld rlp)canonical-ancestors
6586,300493
+(defun canonical-ancestors-lst (fns wrld)canonical-ancestors-lst
6599,301030
+(defun chk-evaluator-use-in-rule (name meta-fn hyp-fn extra-fns rule-type evchk-evaluator-use-in-rule
6607,301296
+(defun chk-rule-fn-guard (function-string rule-type fn ctx wrld state)chk-rule-fn-guard
6759,308748
+(defun chk-acceptable-meta-rule (name trigger-fns term ctx ens wrld state)chk-acceptable-meta-rule
6803,310822
+(defun add-meta-rule1 (lst rule wrld)add-meta-rule1
6917,316267
+(defun maybe-putprop-lst (symb-lst key val wrld)maybe-putprop-lst
6931,316813
+(defun mark-attachment-disallowed2 (fns msg wrld)mark-attachment-disallowed2
6941,317166
+(defun mark-attachment-disallowed1 (canonical-fns msg wrld)mark-attachment-disallowed1
6967,318311
+(defun mark-attachment-disallowed (meta-fns ev msg wrld)mark-attachment-disallowed
6976,318669
+(defun add-meta-rule (rune nume trigger-fns term backchain-limit wrld)add-meta-rule
6989,319176
+(deflabel elimelim
7044,321275
+(defun destructors (term ans)destructors
7187,328334
+(defun destructors-lst (lst ans)destructors-lst
7203,328968
+(defun strip-ffn-symbs (lst)strip-ffn-symbs
7210,329128
+(defun chk-acceptable-elim-rule1 (name vars dests ctx wrld state)chk-acceptable-elim-rule1
7215,329270
+(defun chk-acceptable-elim-rule (name term ctx wrld state)chk-acceptable-elim-rule
7238,330281
+(defun add-elim-rule1 (rune nume hyps equiv lhs rhs lst dests wrld)add-elim-rule1
7293,332599
+(defun add-elim-rule (rune nume term wrld)add-elim-rule
7318,333707
+(deflabel generalizegeneralize
7330,334150
+(defun chk-acceptable-generalize-rule (name term ctx wrld state)chk-acceptable-generalize-rule
7369,335647
+(defun add-generalize-rule (rune nume term wrld)add-generalize-rule
7376,335839
+(deflabel type-prescriptiontype-prescription
7388,336271
+(defun find-type-prescription-pat (term ens wrld)find-type-prescription-pat
7575,346019
+(defun type-prescription-disjunctp (var term)type-prescription-disjunctp
7617,347766
+(defun type-prescription-conclp (var concl)type-prescription-conclp
7663,349973
+(defun subst-nil-into-type-prescription-disjunct (var term)subst-nil-into-type-prescription-disjunct
7688,351071
+(defun subst-nil-into-type-prescription-concl (var concl)subst-nil-into-type-prescription-concl
7713,352024
+(defun unprettyify-tp (term)unprettyify-tp
7745,353461
+(defun destructure-type-prescription (name typed-term term ens wrld)destructure-type-prescription
7762,354031
+(defun add-type-prescription-rule (rune nume typed-term termadd-type-prescription-rule
7923,363163
+(defun strong-compound-recognizer-p (fn recognizer-alist ens)strong-compound-recognizer-p
8000,366460
+(defun warned-non-rec-fns-for-tp (term recognizer-alist ens wrld)warned-non-rec-fns-for-tp
8010,366943
+(defun warned-non-rec-fns-tp-hyps1 (hyps recognizer-alist ens wrld acc)warned-non-rec-fns-tp-hyps1
8036,368020
+(defun warned-non-rec-fns-tp-hyps (hyps ens wrld)warned-non-rec-fns-tp-hyps
8053,368857
+(defun chk-acceptable-type-prescription-rule (name typed-term termchk-acceptable-type-prescription-rule
8058,369057
+(deflabel equivalenceequivalence
8195,376333
+(defun boolean-fn (fn)boolean-fn
8498,386253
+(defun reflexivity (fn)reflexivity
8506,386451
+(defun symmetry (fn)symmetry
8512,386541
+(defun transitivity (fn)transitivity
8519,386655
+(defun equivalence-relation-condition (fn)equivalence-relation-condition
8527,386806
+(defun find-candidate-equivalence-relation (clauses)find-candidate-equivalence-relation
8545,387566
+(defun collect-problematic-pre-equivalence-rule-names (lst)collect-problematic-pre-equivalence-rule-names
8559,388081
+(defun chk-acceptable-equivalence-rule (name term ctx wrld state)chk-acceptable-equivalence-rule
8578,389127
+(defun add-equivalence-rule (rune nume term ens wrld)add-equivalence-rule
8701,395263
+(deflabel refinementrefinement
8841,401371
+(defun chk-acceptable-refinement-rule (name term ctx wrld state)chk-acceptable-refinement-rule
8898,403559
+(defun collect-coarsenings (wrld)collect-coarsenings
8937,405494
+(defun putprop-coarsenings (alist wrld)putprop-coarsenings
8947,405823
+(defun union-values (lst alist)union-values
8975,407124
+(defun extend-value-set (lst alist)extend-value-set
8983,407363
+(defun extend-each-value-set (alist1 alist2)extend-each-value-set
8997,408028
+(defun close-value-sets (alist)close-value-sets
9007,408359
+(defun add-refinement-rule (name nume term wrld)add-refinement-rule
9021,408987
+(deflabel congruencecongruence
9042,409781
+(defun corresponding-args-eq-except (args1 args2 xk yk)corresponding-args-eq-except
9191,416688
+(defun interpret-term-as-congruence-rule (name term wrld)interpret-term-as-congruence-rule
9205,417281
+(defun some-congruence-rule-same (equiv rules)some-congruence-rule-same
9286,421209
+(defun some-congruence-rule-has-refinement (equiv rules wrld)some-congruence-rule-has-refinement
9295,421505
+(defun chk-acceptable-congruence-rule (name term ctx wrld state)chk-acceptable-congruence-rule
9305,421863
+(defun putnth (val n lst)putnth
9383,425609
+(defun add-congruence-rule-to-congruence (rule k congruence)add-congruence-rule-to-congruence
9390,425871
+(defun add-congruence-rule (rune nume term wrld)add-congruence-rule
9400,426278
+(deflabel definitiondefinition
9446,428466
+(defun chk-destructure-definition (name term ctx wrld state)chk-destructure-definition
9619,438333
+(defun chk-acceptable-definition-install-body (fn hyps equiv args bodychk-acceptable-definition-install-body
9631,438896
+(defun chk-acceptable-definition-rulechk-acceptable-definition-rule
9702,441843
+(deflabel inductioninduction
9752,443989
+(defun chk-acceptable-induction-rule (name term ctx wrld state)chk-acceptable-induction-rule
9915,452723
+(defun add-induction-rule (rune nume pat-term cond-term scheme-term term wrld)add-induction-rule
9922,452914
+(deflabel type-set-invertertype-set-inverter
9939,453584
+(defun chk-acceptable-type-set-inverter-rule (name ts term ctx ens wrld state)chk-acceptable-type-set-inverter-rule
9998,456157
+(defun add-type-set-inverter-rule (rune nume ts term ens wrld)add-type-set-inverter-rule
10066,459047
+(deflabel clause-processorclause-processor
10095,460169
+(defun tilde-@-illegal-clause-processor-sig-msg (cl-proc stobjs-in stobjs-out)tilde-@-illegal-clause-processor-sig-msg
10387,474159
+(defun destructure-clause-processor-rule (term)destructure-clause-processor-rule
10422,475370
+(defun chk-acceptable-clause-processor-rule (name term ctx wrld state)chk-acceptable-clause-processor-rule
10447,476369
+(defun add-clause-processor-rule (name term wrld)add-clause-processor-rule
10555,481989
+(defun trusted-clause-processor-table-guard (key val wrld)trusted-clause-processor-table-guard
10600,483847
+(defmacro define-trusted-clause-processordefine-trusted-clause-processor
10681,487696
+(defun primitive-instructionp (instr state)primitive-instructionp
11111,507258
+(defun non-primitive-instructions (instructions state)non-primitive-instructions
11119,507571
+(defun chk-primitive-instruction-listp (instructions ctx state)chk-primitive-instruction-listp
11129,507884
+(defun translate-instructions (name instructions ctx wrld state)translate-instructions
11137,508123
+(defun controller-alistp (clique alist wrld)controller-alistp
11144,508371
+(defun alist-to-keyword-alist (alist ans)alist-to-keyword-alist
11164,509108
+(defun loop-stopper-alist-p (x wrld)loop-stopper-alist-p
11176,509546
+(defun guess-controller-alist-for-definition-rule (names formals body ctx wrldguess-controller-alist-for-definition-rule
11189,509900
+(defun chk-legal-linear-trigger-terms1 (term lst name ctx state)chk-legal-linear-trigger-terms1
11204,510623
+(defun chk-legal-linear-trigger-terms (terms lst name ctx state)chk-legal-linear-trigger-terms
11225,511653
+(defun backchain-limit-listp (lst)backchain-limit-listp
11253,513067
+(defun eliminate-macro-aliases (lst macro-aliases wrld)eliminate-macro-aliases
11266,513377
+(defun translate-rule-class-alist (token alist seen corollary name x ctx enstranslate-rule-class-alist
11293,514749
+(defun translate-rule-class1 (class tflg name x ctx ens wrld state)translate-rule-class1
12006,553091
+(defun reason-for-non-keyword-value-listp (x)reason-for-non-keyword-value-listp
12067,555824
+(defun translate-rule-class (name x thm ctx ens wrld state)translate-rule-class
12086,556388
+(defun translate-rule-classes1 (name classes thm ctx ens wrld state)translate-rule-classes1
12137,558695
+(defun translate-rule-classes (name classes thm ctx ens wrld state)translate-rule-classes
12159,559553
+(defun chk-acceptable-x-rule (name class ctx ens wrld state)chk-acceptable-x-rule
12190,561022
+(defun chk-acceptable-x-rules (name classes ctx ens wrld state)chk-acceptable-x-rules
12275,564814
+(defun collect-keys-eq (sym-list alist)collect-keys-eq
12290,565517
+(defun chk-acceptable-rules (name classes ctx ens wrld state)chk-acceptable-rules
12299,565873
+(defun add-x-rule (rune nume class ens wrld state)add-x-rule
12389,569095
+(defun add-rules1 (mapping-pairs classes ens wrld state)add-rules1
12500,574125
+(defun truncate-class-alist (alist term)truncate-class-alist
12519,574965
+(defun truncate-classes (classes term)truncate-classes
12537,575756
+(defun make-runes1 (event-name classes runes)make-runes1
12555,576635
+(defun make-runes (event-name classes)make-runes
12594,578280
+(defun make-runic-mapping-pairs (nume runes)make-runic-mapping-pairs
12602,578518
+(defun add-rules (name classes term untranslated-term ens wrld state)add-rules
12616,579057
+(defun redundant-theoremp (name term classes wrld)redundant-theoremp
12639,580265
+(defun non-tautological-classes (term classes)non-tautological-classes
12652,580843
+(defun prove-corollaries1 (name term i n rule-classes ens wrld ctx state ttree)prove-corollaries1
12670,581640
+(defun prove-corollaries (name term rule-classes ens wrld ctx state)prove-corollaries
12730,584671
+(defun enabled-runep-string (rune ens wrld)enabled-runep-string
12764,586094
+(defun untranslate-hyps (hyps wrld)untranslate-hyps
12769,586208
+(defun info-for-lemmas (lemmas numes ens wrld)info-for-lemmas
12774,586385
+(defun world-to-next-event (wrld)world-to-next-event
12811,588368
+(defun assoc-eq-eq (x y alist)assoc-eq-eq
12819,588619
+(defun actual-props (props seen acc)actual-props
12830,588955
+(defun info-for-well-founded-relation-rules (rules)info-for-well-founded-relation-rules
12848,589577
+(defun info-for-built-in-clause-rules1 (rules numes ens wrld)info-for-built-in-clause-rules1
12863,590175
+(defun info-for-built-in-clause-rules (alist numes ens wrld)info-for-built-in-clause-rules
12880,590964
+(defun info-for-compound-recognizer-rules (rules numes ens wrld)info-for-compound-recognizer-rules
12886,591204
+(defun info-for-generalize-rules (rules numes ens wrld)info-for-generalize-rules
12910,592386
+(defun info-for-linear-lemmas (rules numes ens wrld)info-for-linear-lemmas
12927,593149
+(defun info-for-eliminate-destructors-rule (rule numes ens wrld)info-for-eliminate-destructors-rule
12957,594782
+(defun info-for-congruences (val numes ens wrld)info-for-congruences
12985,596259
+(defun info-for-coarsenings (val numes ens wrld)info-for-coarsenings
12993,596468
+(defun info-for-forward-chaining-rules (rules numes ens wrld)info-for-forward-chaining-rules
13001,596661
+(defun decode-type-set-lst (lst)decode-type-set-lst
13029,598039
+(defun info-for-type-prescriptions (rules numes ens wrld)info-for-type-prescriptions
13035,598178
+(defun info-for-induction-rules (rules numes ens wrld)info-for-induction-rules
13065,599748
+(defun info-for-type-set-inverter-rules (rules numes ens wrld)info-for-type-set-inverter-rules
13088,600857
+(defun info-for-x-rules (sym key val numes ens wrld)info-for-x-rules
13108,601800
+(defun info-for-rules (props numes ens wrld)info-for-rules
13167,603913
+(defun print-info-for-rules-entry (keys vals chan state)print-info-for-rules-entry
13177,604304
+(defun print-info-for-rules (info chan state)print-info-for-rules
13202,605499
+(defun pr-body (wrld-segment numes wrld state)pr-body
13212,605879
+(defun pr-fn (name state)pr-fn
13221,606121
+(defun print-clause-processor-rules1 (alist wrld state)print-clause-processor-rules1
13235,606786
+(defmacro print-clause-processor-rules ()print-clause-processor-rules
13248,607309
+(defun new-numes (world-segment)new-numes
13254,607543
+(defun world-to-next-command (wrld ans)world-to-next-command
13265,607896
+(defun pr!-fn (cd state)pr!-fn
13272,608164
+(defmacro pr (name)pr
13281,608455
+(defmacro pr! (cd)pr!
13328,610048
+(defun disabledp-fn-lst (runic-mapping-pairs ens)disabledp-fn-lst
13355,610978
+(defun disabledp-fn (name ens wrld)disabledp-fn
13362,611299
+(defmacro disabledp (name)disabledp
13385,612295
+(defun access-x-rule-rune (x rule)access-x-rule-rune
13415,613529
+(defun collect-x-rules-of-rune (x rune lst ans)collect-x-rules-of-rune
13459,615785
+(defun collect-congruence-rules-of-rune-in-geneqv-lst (geneqv-lst rune ans)collect-congruence-rules-of-rune-in-geneqv-lst
13470,616190
+(defun collect-congruence-rules-of-rune (congruences rune ans)collect-congruence-rules-of-rune
13482,616639
+(defun find-rules-of-rune2 (rune sym key val ans)find-rules-of-rune2
13497,617285
+(defun find-rules-of-rune1 (rune props ans)find-rules-of-rune1
13591,621367
+(defun find-rules-of-rune (rune wrld)find-rules-of-rune
13607,622118
+(defun collect-non-backchain-subclass (rules)collect-non-backchain-subclass
13651,624128
+(defun chk-acceptable-monitor (rune expr ctx state)chk-acceptable-monitor
13661,624504
+(defun chk-acceptable-monitors (lst ctx state)chk-acceptable-monitors
13736,628130
+(defun monitor1 (rune form ctx state)monitor1
13757,628983
+(defun unmonitor1 (rune ctx state)unmonitor1
13776,629749
+(defun monitor-fn (rune expr state)monitor-fn
13795,630536
+(defun unmonitor-fn (rune ctx state)unmonitor-fn
13821,631360
+(defun monitored-runes-fn (state)monitored-runes-fn
13864,632935
+(defun brr-fn (flg state)brr-fn
13880,633394
+(defmacro brr (flg)brr
13895,633823
+(deflabel why-brrwhy-brr
13967,637789
+(defmacro brr@ (sym)brr@
14024,640860
+(defmacro monitor (rune expr)monitor
14151,647625
+(defmacro unmonitor (rune)unmonitor
14321,656705
+(defmacro monitored-runes ()monitored-runes
14348,657580
+(defun proceed-from-brkpt1 (action runes ctx state)proceed-from-brkpt1
14364,657965
+(defun exit-brr (state)exit-brr
14396,659232
+(defun ok-if-fn (term state)ok-if-fn
14407,659603
+(defmacro ok-if (term)ok-if
14415,659848
+(defun print-rule-storage-dependencies (name ttree state)print-rule-storage-dependencies
14462,661893
+(defun defaxiom-supporters (tterm name ctx wrld state)defaxiom-supporters
14479,662505
+(defun defaxiom-fn (name term state rule-classes doc event-form)defaxiom-fn
14532,665346
+(defun warn-on-inappropriate-defun-mode (assumep event-form ctx state)warn-on-inappropriate-defun-mode
14625,669733
+(defun add-hyp-standardp-var-lst (vars)add-hyp-standardp-var-lst
14639,670253
+(defun strengthen-hyps-using-transfer-principle (hyps vars)strengthen-hyps-using-transfer-principle
14646,670441
+(defun weaken-using-transfer-principle (term)weaken-using-transfer-principle
14658,670781
+(defun remove-standardp-hyp (tterm)remove-standardp-hyp
14682,671651
+(defun remove-standardp-hyps (tterm)remove-standardp-hyps
14690,671886
+(defun remove-standardp-hyps-and-standardp-conclusion (tterm)remove-standardp-hyps-and-standardp-conclusion
14702,672289
+(defun chk-classical-term-or-standardp-of-classical-term (tterm term ctx wrld state)chk-classical-term-or-standardp-of-classical-term
14713,672646
+(defmacro with-waterfall-parallelism-timings (name form)with-waterfall-parallelism-timings
14731,673403
+(defmacro with-waterfall-parallelism-timings (name form)with-waterfall-parallelism-timings
14741,673811
+(defun defthm-fn1 (name term statedefthm-fn1
14745,673903
+(defun defthm-fn (name term statedefthm-fn
14891,680973
+(defmacro thm (term &key hints otf-flg doc)thm
14914,681575
+(defun thm-fn (term state hints otf-flg doc)thm-fn
14946,682400
+(defun chk-extensible-rule-classes (rule-classes ctx state)chk-extensible-rule-classes
14979,683829
+(defun extend-rule-classes (class rule-classes)extend-rule-classes
14988,684177
+(defun gen-new-name-in-package-of-symbol1 (char-lst cnt pkgsym wrld)gen-new-name-in-package-of-symbol1
14999,684537
+(defun gen-new-name-in-package-of-symbol (sym pkgsym wrld)gen-new-name-in-package-of-symbol
15019,685333
+(defmacro defequiv (equivdefequiv
15039,686055
+(defmacro defrefinement (equiv1 equiv2defrefinement
15098,688147
+(defmacro defcong (&whole xdefcong
15153,690082
+
+other-events.lisp,60906
+(defun legal-initp (x)legal-initp
46,2129
+(defun macro-arglist-keysp (args keys-passed)macro-arglist-keysp
58,2576
+(defun macro-arglist-after-restp (args)macro-arglist-after-restp
91,4156
+(defun macro-arglist-optionalp (args)macro-arglist-optionalp
98,4362
+(defun macro-arglist1p (args)macro-arglist1p
125,5340
+(defun subsequencep (lst1 lst2)subsequencep
142,5953
+(defun collect-lambda-keywordps (lst)collect-lambda-keywordps
155,6395
+(defun macro-args-structurep (args)macro-args-structurep
162,6655
+(defun macro-vars-key (args)macro-vars-key
182,7611
+(defun macro-vars-after-rest (args)macro-vars-after-rest
206,8490
+(defun macro-vars-optional (args)macro-vars-optional
219,8841
+(defun macro-vars (args)macro-vars
240,9591
+(defun chk-legal-defconst-name (name state)chk-legal-defconst-name
260,10312
+(defun defconst-fn1 (name val doc doc-pair w state)defconst-fn1
274,10944
+(defvar *hcomp-fn-ht* nil)*hcomp-fn-ht*
285,11207
+(defvar *hcomp-const-ht* nil)*hcomp-const-ht*
286,11234
+(defvar *hcomp-macro-ht* nil)*hcomp-macro-ht*
287,11264
+(defvar *hcomp-fn-alist* nil)*hcomp-fn-alist*
288,11294
+(defvar *hcomp-const-alist* nil)*hcomp-const-alist*
289,11324
+(defvar *hcomp-macro-alist* nil)*hcomp-macro-alist*
290,11357
+(defconstant *hcomp-fake-value* 'acl2_invisible::hcomp-fake-value)*hcomp-fake-value*
291,11390
+(defvar *hcomp-book-ht* nil)*hcomp-book-ht*
292,11457
+(defvar *hcomp-const-restore-ht* nil)*hcomp-const-restore-ht*
293,11486
+(defvar *hcomp-fn-macro-restore-ht**hcomp-fn-macro-restore-ht*
294,11524
+(defvar *declaim-list* nil)*declaim-list*
327,12707
+(defrec hcomp-book-ht-entryhcomp-book-ht-entry
331,12739
+(defun defconst-val-raw (full-book-name name)defconst-val-raw
341,13031
+(defun defconst-val (name form ctx wrld state)defconst-val
352,13520
+(defun defconst-fn (name form state doc event-form)defconst-fn
437,16794
+(defun chk-legal-init-msg (x)chk-legal-init-msg
495,19265
+(defun chk-legal-init (x ctx state)chk-legal-init
520,20228
+(defun chk-macro-arglist-keys (args keys-passed)chk-macro-arglist-keys
525,20372
+(defun chk-macro-arglist-after-rest (args)chk-macro-arglist-after-rest
598,24489
+(defun chk-macro-arglist-optional (args)chk-macro-arglist-optional
605,24749
+(defun chk-macro-arglist1 (args)chk-macro-arglist1
640,26388
+(defun chk-macro-arglist-msg (args chk-state wrld)chk-macro-arglist-msg
660,27229
+(defun chk-macro-arglist (args chk-state ctx state)chk-macro-arglist
740,31252
+(defun defmacro-fn1 (name args doc doc-pair guard body w state)defmacro-fn1
745,31438
+(defun chk-defmacro-width (rst)chk-defmacro-width
761,31975
+(defun redundant-defmacrop (name args guard body w)redundant-defmacrop
775,32477
+(defun defmacro-fn (mdef state event-form)defmacro-fn
793,33303
+(defconst *initial-event-defmacros**initial-event-defmacros*
924,40005
+(defun boot-translate (x)boot-translate
1145,47975
+(defun primordial-event-macro-and-fn1 (actuals)primordial-event-macro-and-fn1
1188,49682
+(defun primordial-event-macro-and-fn (form wrld)primordial-event-macro-and-fn
1217,51099
+(defun primordial-event-macros-and-fns (lst wrld)primordial-event-macros-and-fns
1352,57759
+(defconst *initial-type-prescriptions**initial-type-prescriptions*
1368,58354
+(defun collect-world-globals (wrld ans)collect-world-globals
1390,59173
+(defun primordial-world-globals (operating-system)primordial-world-globals
1397,59443
+(defun arglists-to-nils (arglists)arglists-to-nils
1543,66398
+(defconst *unattachable-primitives**unattachable-primitives*
1549,66626
+(defun primordial-world (operating-system)primordial-world
1567,67349
+(defun same-name-twice (l)same-name-twice
1633,69780
+(defun conflicting-imports (l)conflicting-imports
1641,70012
+(defun chk-new-stringp-name (ev-type name ctx w state)chk-new-stringp-name
1648,70183
+(deflabel package-reincarnation-import-restrictionspackage-reincarnation-import-restrictions
1687,71730
+(defun chk-package-reincarnation-import-restrictions (name proposed-imports)chk-package-reincarnation-import-restrictions
1750,75086
+(defun convert-book-name-to-cert-name (x cert-op)convert-book-name-to-cert-name
1762,75524
+(defun unrelativize-book-path (lst dir)unrelativize-book-path
1785,76415
+(defun tilde-@-defpkg-error-phrase (name package-entry new-not-old old-not-newtilde-@-defpkg-error-phrase
1794,76791
+(defconst *1*-pkg-prefix**1*-pkg-prefix*
1843,79466
+(defun chk-acceptable-defpkg (name form defpkg-book-path hidden-p ctx w state)chk-acceptable-defpkg
1856,79892
+(defun defpkg-fn (name form state doc book-path hidden-p event-form)defpkg-fn
2051,88562
+(defun theory-fn-callp (x)theory-fn-callp
2227,97485
+(defun intersection-augmented-theories-fn1 (lst1 lst2 ans)intersection-augmented-theories-fn1
2250,98346
+(defmacro check-theory (lst wrld ctx form)check-theory
2270,99314
+(defun intersection-theories-fn (lst1 lst2 wrld)intersection-theories-fn
2278,99624
+(defmacro intersection-theories (lst1 lst2)intersection-theories
2287,99971
+(defun union-augmented-theories-fn1 (lst1 lst2 ans)union-augmented-theories-fn1
2319,100954
+(defun union-theories-fn1 (lst1 lst2 nume wrld ans)union-theories-fn1
2336,101806
+(defun union-theories-fn (lst1 lst2 lst1-known-to-be-runic wrld)union-theories-fn
2360,102903
+(defmacro union-theories (lst1 lst2)union-theories
2399,104363
+(defun set-difference-augmented-theories-fn1 (lst1 lst2 ans)set-difference-augmented-theories-fn1
2445,105656
+(defun set-difference-theories-fn1 (lst1 lst2 nume wrld ans)set-difference-theories-fn1
2460,106379
+(defun set-difference-theories-fn (lst1 lst2 lst1-known-to-be-runic wrld)set-difference-theories-fn
2484,107459
+(defmacro set-difference-theories (lst1 lst2)set-difference-theories
2515,108651
+(defun universal-theory-fn1 (lst ans redefined)universal-theory-fn1
2554,109949
+(defun universal-theory-fn (logical-name wrld)universal-theory-fn
2606,112806
+(defmacro universal-theory (logical-name)universal-theory
2637,114355
+(defun function-theory-fn1 (token lst ans redefined)function-theory-fn1
2687,116403
+(defun function-theory-fn (logical-name wrld)function-theory-fn
2747,119313
+(defmacro function-theory (logical-name)function-theory
2763,119971
+(defun executable-counterpart-theory-fn (logical-name wrld)executable-counterpart-theory-fn
2802,121292
+(defmacro executable-counterpart-theory (logical-name)executable-counterpart-theory
2817,121929
+(defun standard-theories (wrld)standard-theories
2860,123480
+(defun current-theory-fn (logical-name wrld)current-theory-fn
2866,123730
+(defmacro current-theory (logical-name)current-theory
2886,124527
+(defconst *initial-return-last-table**initial-return-last-table*
3020,129526
+(defun end-prehistoric-world (wrld)end-prehistoric-world
3048,130830
+(defun theory-namep (name wrld)theory-namep
3092,132881
+(defun theory-fn (name wrld)theory-fn
3101,133138
+(defmacro theory (name)theory
3113,133547
+(defun deftheory-fn (name expr state doc event-form)deftheory-fn
3143,134400
+(defun in-theory-fn (expr state doc event-form)in-theory-fn
3265,139761
+(defun in-arithmetic-theory-fn (expr state doc event-form)in-arithmetic-theory-fn
3331,142480
+(defmacro disable (&rest rst)disable
3394,145110
+(defmacro enable (&rest rst)enable
3434,146442
+(defmacro theory-invariant (&whole event-form term &key key (error 't))theory-invariant
3488,148342
+(defmacro theory-invariant (&rest args)theory-invariant
3689,158323
+(defmacro incompatible (rune1 rune2)incompatible
3693,158397
+(deflabel signaturesignature
3734,159871
+(defconst *generic-bad-signature-string**generic-bad-signature-string*
3883,167472
+(defconst *signature-keywords**signature-keywords*
3889,167759
+(defun duplicate-key-in-keyword-value-listp (l)duplicate-key-in-keyword-value-listp
3894,167866
+(defun chk-signature (x ctx wrld state)chk-signature
3901,168111
+(defun chk-signatures (signatures ctx wrld state)chk-signatures
4167,180958
+(defun chk-acceptable-encapsulate1 (signatures form-lst ctx wrld state)chk-acceptable-encapsulate1
4219,183573
+(defun primitive-event-macros ()primitive-event-macros
4270,186152
+(deflabel embedded-event-formembedded-event-form
4410,190850
+(defun name-introduced (trip functionp)name-introduced
4565,197154
+(defun chk-embedded-event-form-orig-form-msg (orig-form state)chk-embedded-event-form-orig-form-msg
4642,200634
+(defun chk-embedded-event-form (form orig-form wrld ctx state names portcullispchk-embedded-event-form
4649,200883
+(defun destructure-expansion (form)destructure-expansion
5006,218724
+(defun rebuild-expansion (wrappers form)rebuild-expansion
5020,219290
+(defun set-raw-mode-on (state)set-raw-mode-on
5025,219467
+(defun set-raw-mode-off (state)set-raw-mode-off
5030,219634
+(defmacro set-raw-mode-on! ()set-raw-mode-on!
5036,219821
+(defmacro set-raw-mode (flg)set-raw-mode
5054,220469
+(defun-one-output stobj-out (val)stobj-out
5193,227030
+(defun mv-ref! (i)mv-ref!
5204,227422
+(defmacro add-raw-arity (name val)add-raw-arity
5243,228250
+(defmacro remove-raw-arity (name)remove-raw-arity
5296,230266
+(defun raw-arity (form wrld state)raw-arity
5320,231097
+(defun alist-to-bindings (alist)alist-to-bindings
5383,233809
+(defun-one-output acl2-raw-eval-form-to-eval (form)acl2-raw-eval-form-to-eval
5390,233991
+(defun acl2-raw-eval (form state)acl2-raw-eval
5420,235214
+(defun acl2-raw-eval (form state)acl2-raw-eval
5443,236099
+(defun acl2-raw-eval (form state)acl2-raw-eval
5461,236795
+(defun get-and-chk-last-make-event-expansion (form wrld ctx state names)get-and-chk-last-make-event-expansion
5464,236870
+(defconst *local-value-triple-elided**local-value-triple-elided*
5491,238053
+(defun elide-locals-rec (form strongp)elide-locals-rec
5501,238311
+(defun elide-locals-lst (x strongp)elide-locals-lst
5556,240902
+(defun elide-locals (form environment strongp)elide-locals
5567,241343
+(defun make-record-expansion (event expansion)make-record-expansion
5591,242508
+(defun eval-event-lst (index expansion-alist ev-lst quietp environmenteval-event-lst
5598,242731
+(defun equal-insig (insig1 insig2)equal-insig
5803,253064
+(defun bad-signature-alist (insigs kwd-value-list-lst udf-fns wrld)bad-signature-alist
5823,253981
+(defmacro if-ns (test tbr fbr ctx)if-ns
5888,257110
+(defun tilde-*-bad-insigs-phrase1 (alist)tilde-*-bad-insigs-phrase1
5907,257634
+(defun tilde-*-bad-insigs-phrase (alist)tilde-*-bad-insigs-phrase
5934,258933
+(defun union-eq-cars (alist)union-eq-cars
5946,259429
+(defun chk-acceptable-encapsulate2 (insigs kwd-value-list-lst wrld ctx state)chk-acceptable-encapsulate2
5950,259552
+(defun conjoin-into-alist (fn thm alist)conjoin-into-alist
5993,261304
+(defun classes-theorems (classes)classes-theorems
6007,261833
+(defun constraints-introduced1 (thms fns ans)constraints-introduced1
6019,262217
+(defun new-trips (wrld3 proto-wrld3 seen acc)new-trips
6035,262844
+(defun constraints-introduced (new-trips fns ans)constraints-introduced
6115,267165
+(defun putprop-constraints (fn constrained-fns constraint-lstputprop-constraints
6235,272394
+(deflabel local-incompatibilitylocal-incompatibility
6269,273894
+(defun maybe-install-acl2-defaults-table (acl2-defaults-table state)maybe-install-acl2-defaults-table
6371,279021
+(defun in-encapsulatep (embedded-event-lst non-trivp)in-encapsulatep
6389,279713
+(defun update-for-redo-flat (n ev-lst state)update-for-redo-flat
6405,280274
+(defmacro redo-flat (&key (succ-ld-skip-proofsp 't)redo-flat
6424,281017
+(defun cert-op (state)cert-op
6574,288107
+(defun eval-event-lst-environment (in-encapsulatep state)eval-event-lst-environment
6592,288839
+(defun process-embedded-eventsprocess-embedded-events
6611,289576
+(defun constrained-functions (exported-fns sig-fns new-trips)constrained-functions
6901,305036
+(defun collect-logicals (names wrld)collect-logicals
6927,306283
+(defun exported-function-names (new-trips)exported-function-names
6936,306567
+(defun get-subversives (fns wrld)get-subversives
6948,306985
+(defun ancestral-ffn-symbs-lst (lst trips ans)ancestral-ffn-symbs-lst
6958,307410
+(defun constraints-list (fns wrld acc seen)constraints-list
6962,307565
+(defun encapsulate-constraint (sig-fns exported-names new-trips wrld)encapsulate-constraint
6977,308277
+(defun new-dependent-clause-processors (new-tbl old-tbl)new-dependent-clause-processors
7087,313499
+(defun bogus-exported-compliants (names exports-with-sig-ancestors sig-fnsbogus-exported-compliants
7104,314206
+(defun encapsulate-pass-2 (insigs kwd-value-list-lst ev-lstencapsulate-pass-2
7157,316789
+(defun tilde-@-abbreviate-object-phrase (x)tilde-@-abbreviate-object-phrase
7948,347075
+(defun encapsulate-ctx (signatures form-lst)encapsulate-ctx
7982,348132
+(defun print-encapsulate-msg1 (insigs form-lst state)print-encapsulate-msg1
8008,349199
+(defun print-encapsulate-msg2 (insigs form-lst state)print-encapsulate-msg2
8025,349905
+(defun print-encapsulate-msg3/exported-names (insigs lst)print-encapsulate-msg3/exported-names
8037,350239
+(defun print-encapsulate-msg3/constraints (constrained-fns constraintsprint-encapsulate-msg3/constraints
8056,350843
+(defun print-encapsulate-msg3 (ctx insigs form-lst exported-namesprint-encapsulate-msg3
8104,352831
+(defun find-first-non-local-name (x)find-first-non-local-name
8181,356861
+(defun find-first-non-local-name-lst (lst)find-first-non-local-name-lst
8252,359697
+(defun corresponding-encap-events (old-evs new-evs ans)corresponding-encap-events
8271,360526
+(defun corresponding-encaps (old new)corresponding-encaps
8298,361632
+(defun redundant-encapsulate-tuplep (event-form mode ruler-extenders vgeredundant-encapsulate-tuplep
8306,361876
+(defun redundant-encapsulatep (signatures ev-lst event-form wrld)redundant-encapsulatep
8345,363883
+(defun mark-missing-as-hidden-p (a1 a2)mark-missing-as-hidden-p
8427,367945
+(defun known-package-alist-included-p (a1 a2)known-package-alist-included-p
8440,368470
+(defun encapsulate-fix-known-package-alist (pass1-k-p-alist wrld)encapsulate-fix-known-package-alist
8453,369024
+(defun subst-by-position1 (alist lst index acc)subst-by-position1
8488,370979
+(defun subst-by-position (alist lst index)subst-by-position
8508,371696
+(defun intro-udf-guards (insigs kwd-value-list-lst wrld-acc wrld ctx state)intro-udf-guards
8526,372515
+(defun intro-udf-non-classicalp (insigs kwd-value-list-lst wrld)intro-udf-non-classicalp
8567,374321
+(defun assoc-proof-supporters-alist (sym alist)assoc-proof-supporters-alist
8582,375100
+(defun update-proof-supporters-alist-3 (names local-alist old new wrld)update-proof-supporters-alist-3
8590,375392
+(defun posn-first-non-event (names wrld idx)posn-first-non-event
8617,376592
+(defun update-proof-supporters-alist-2 (names local-alist wrld)update-proof-supporters-alist-2
8624,376843
+(defun update-proof-supporters-alist-1 (namex names local-alistupdate-proof-supporters-alist-1
8635,377342
+(defun update-proof-supporters-alist (new-proof-supporters-alistupdate-proof-supporters-alist
8653,378225
+(defun install-proof-supporters-alist (new-proof-supporters-alistinstall-proof-supporters-alist
8674,379117
+(defun encapsulate-fn (signatures ev-lst state event-form)encapsulate-fn
8687,379710
+(defun progn-fn1 (ev-lst progn!p bindings state)progn-fn1
9048,398943
+(defun progn-fn (ev-lst state)progn-fn
9137,403018
+(defun progn!-fn (ev-lst bindings state)progn!-fn
9140,403086
+(defun make-event-ctx (event-form)make-event-ctx
9146,403403
+(defun protected-eval (form on-behalf-of ctx state aok)protected-eval
9151,403571
+(defun make-event-debug-pre (form on-behalf-of state)make-event-debug-pre
9211,406334
+(defun make-event-debug-post (debug-depth expansion0 state)make-event-debug-post
9228,407057
+(defmacro do-proofs? (do-proofsp form)do-proofs?
9237,407419
+(defun make-event-fn2 (expansion0 whole-form in-encapsulatep check-expansionmake-event-fn2
9254,407934
+(defun make-event-fn2-lst (expansion-lst whole-form in-encapsulatepmake-event-fn2-lst
9301,409633
+(defun make-event-fn1 (expansion0 whole-form in-encapsulatep check-expansionmake-event-fn1
9326,410739
+(defun ultimate-expansion (x)ultimate-expansion
9337,411259
+(defun make-event-fn (form expansion? check-expansion on-behalf-of whole-formmake-event-fn
9366,412668
+(deflabel booksbooks
9719,430647
+(deflabel community-bookscommunity-books
9786,434029
+(defun chk-book-name (book-name full-book-name ctx state)chk-book-name
9804,434732
+(defun include-book-alist-subsetp (alist1 alist2)include-book-alist-subsetp
9849,436782
+(defun get-portcullis-cmds (wrld cmds cbds names ctx state)get-portcullis-cmds
9889,438735
+(defun remove-after-last-directory-separator (p)remove-after-last-directory-separator
9922,440141
+(defun merge-using-dot-dot (p s)merge-using-dot-dot
9930,440465
+(defun our-merge-pathnames (p s)our-merge-pathnames
9964,441772
+(defun expand-tilde-to-user-home-dir (str os ctx state)expand-tilde-to-user-home-dir
9995,442921
+(defvar *canonical-unix-pathname-action**canonical-unix-pathname-action*
10032,444420
+(defun canonical-unix-pathname (x dir-p state)canonical-unix-pathname
10044,444951
+(defun unix-truename-pathname (x dir-p state)unix-truename-pathname
10130,449923
+(defun chk-live-state-p (fn state)chk-live-state-p
10150,450738
+(defun-overrides canonical-pathname (pathname dir-p state)canonical-pathname
10162,451169
+(defun acl2-magic-canonical-pathname (x)acl2-magic-canonical-pathname
10169,451398
+(defdoc canonical-pathnamecanonical-pathname
10200,452401
+(defun canonical-dirname! (pathname ctx state)canonical-dirname!
10239,454291
+(defun directory-of-absolute-pathname (pathname)directory-of-absolute-pathname
10250,454717
+(defun extend-pathname (dir file-name state)extend-pathname
10256,454927
+(defun maybe-add-separator (str)maybe-add-separator
10300,456948
+(defun set-cbd-fn (str state)set-cbd-fn
10306,457148
+(defmacro set-cbd (str)set-cbd
10344,458702
+(defun set-cbd-state (str state)set-cbd-state
10375,459761
+(defun parse-book-name (dir x extension ctx state)parse-book-name
10391,460260
+(defun cbd-fn (state)cbd-fn
10446,462641
+(defmacro cbd nilcbd
10453,462948
+(defun make-include-books-absolute (form cbd dir names make-event-parent os ctxmake-include-books-absolute
10569,468644
+(defun make-include-books-absolute-lst (forms cbd dir names make-event-parentmake-include-books-absolute-lst
10777,478416
+(defun first-known-package-alist (wrld-segment)first-known-package-alist
10790,478944
+(defmacro string-prefixp (root string)string-prefixp
10810,479636
+(defun relativize-book-path (filename root)relativize-book-path
10819,479914
+(defun relativize-book-path-lst1 (lst root)relativize-book-path-lst1
10844,480911
+(defun relativize-book-path-lst (lst root current)relativize-book-path-lst
10851,481197
+(defun defpkg-items-rec (new-kpa old-kpa system-books-dirdefpkg-items-rec
10859,481498
+(defun defpkg-items (new-kpa ctx w state)defpkg-items
10937,485286
+(defun new-defpkg-list2 (imports all-defpkg-items acc seen)new-defpkg-list2
10950,485798
+(defun make-hidden-defpkg (name imports/doc/book-path)make-hidden-defpkg
10974,486633
+(defun new-defpkg-list1new-defpkg-list1
10983,486943
+(defun new-defpkg-list (defpkg-items base-kpa earlier-kpa)new-defpkg-list
11017,488275
+(defun term-ignore-okp (x)term-ignore-okp
11060,490668
+(defun term-list-ignore-okp (x)term-list-ignore-okp
11071,491050
+(defun hidden-defpkg-events1 (kpa system-books-dirhidden-defpkg-events1
11079,491201
+(defun hidden-defpkg-events (kpa w ctx state)hidden-defpkg-events
11135,493403
+(defun fix-portcullis-cmds1 (dir cmds cbds ans names os ctx state)fix-portcullis-cmds1
11143,493731
+(defun fix-portcullis-cmds (dir cmds cbds names os wrld ctx state)fix-portcullis-cmds
11154,494238
+(defun collect-uncertified-books (alist)collect-uncertified-books
11206,496889
+(defun chk-in-package (channel file empty-okp ctx state)chk-in-package
11220,497466
+(defmacro ill-formed-certificate-er (ctx mark file1 file2ill-formed-certificate-er
11263,499365
+(defun include-book-er-warning-summary (keyword suspect-book-action-alistinclude-book-er-warning-summary
11289,500313
+(defun include-book-er1 (file1 file2 msg warning-summary ctx state)include-book-er1
11337,502213
+(defun include-book-er (file1 file2 msg keyword suspect-book-action-alist ctxinclude-book-er
11352,502884
+(defun post-alist-from-channel (x y ch state)post-alist-from-channel
11377,504200
+(defun certificate-file-and-input-channel1 (full-book-name cert-op state)certificate-file-and-input-channel1
11404,505372
+(defmacro pcert-op-p (cert-op)pcert-op-p
11412,505643
+(defun certificate-file-and-input-channel (full-book-name old-cert-op state)certificate-file-and-input-channel
11415,505754
+(defun cert-annotations-and-checksum-from-cert-file (full-book-name state)cert-annotations-and-checksum-from-cert-file
11455,507656
+(defun tilde-@-cert-post-alist-phrase (full-book-name familiar-nametilde-@-cert-post-alist-phrase
11475,508486
+(defun tilde-*-book-check-sums-phrase1 (reqd-alist actual-alist-cddrs state)tilde-*-book-check-sums-phrase1
11514,510568
+(defun tilde-*-book-check-sums-phrase (reqd-alist actual-alist state)tilde-*-book-check-sums-phrase
11573,513273
+(defun get-cmds-from-portcullis1 (eval-hidden-defpkgs ch ctx state ans)get-cmds-from-portcullis1
11589,514011
+(defun hidden-defpkg-events-simple (kpa acc)hidden-defpkg-events-simple
11620,515257
+(defun get-cmds-from-portcullis (file1 file2 eval-hidden-defpkgs ch ctx state)get-cmds-from-portcullis
11644,515947
+(defun convert-book-name-to-port-name (x)convert-book-name-to-port-name
11676,517250
+(defun chk-raise-portcullis2 (file1 file2 ch port-file-p ctx state ans)chk-raise-portcullis2
11685,517567
+(defun chk-raise-portcullis1 (file1 file2 ch port-file-p ctx state)chk-raise-portcullis1
11767,521726
+(defun mark-local-included-books (post-alist1 post-alist2)mark-local-included-books
11798,522942
+(defun unmark-and-delete-local-included-books (post-alist3)unmark-and-delete-local-included-books
11830,524622
+(defun decimal-string-to-number (s bound expo)decimal-string-to-number
11845,525344
+(defun parse-version (version)parse-version
11876,526727
+(defun-one-output latest-release-note-string ()latest-release-note-string
11921,528775
+(defun earlier-acl2-versionp (version1 version2)earlier-acl2-versionp
11929,529077
+(defun acl2-version-r-p (version)acl2-version-r-p
11958,530169
+(defun ttag-alistp (x)ttag-alistp
11964,530342
+(defun cert-annotationsp (x)cert-annotationsp
11976,530683
+(defun include-book-alist-entryp (entry)include-book-alist-entryp
11990,531076
+(defun include-book-alistp1 (x local-markers-allowedp)include-book-alistp1
12002,531531
+(defun include-book-alistp (x local-markers-allowedp)include-book-alistp
12017,532080
+(defrec cert-objcert-obj
12027,532515
+(defun check-sum-cert-obj (cmds pre-alist post-alist expansion-alist)check-sum-cert-obj
12041,533093
+(defun chk-raise-portcullis (file1 file2 ch light-chkp callerchk-raise-portcullis
12052,533600
+(defun chk-certificate-file1 (file1 file2 ch light-chkp callerchk-certificate-file1
12273,543906
+(defun certificate-file (full-book-name state)certificate-file
12386,549277
+(defun chk-certificate-file (file1 dir caller ctx statechk-certificate-file
12394,549621
+(defun equal-modulo-hidden-defpkgs (cmds1 cmds2)equal-modulo-hidden-defpkgs
12488,554618
+(defun cert-obj-for-convert (full-book-name dir pre-alist fixed-cmdscert-obj-for-convert
12506,555321
+(defun symbol-name-equal (x str)symbol-name-equal
12553,557980
+(defun chk-acceptable-certify-book1 (file dir k cmds cert-obj cbds nameschk-acceptable-certify-book1
12558,558111
+(defun translate-book-names (filenames cbd state acc)translate-book-names
12669,563300
+(defun fix-ttags (ttags ctx cbd state seen acc)fix-ttags
12683,563889
+(defun chk-well-formed-ttags (ttags cbd ctx state)chk-well-formed-ttags
12723,565806
+(defun check-certificate-file-exists (full-book-name cert-op ctx state)check-certificate-file-exists
12734,566215
+(defun chk-acceptable-certify-book (book-name full-book-name dirchk-acceptable-certify-book
12768,567998
+(defun print-objects (lst ch state)print-objects
12933,576839
+(defun replace-initial-substring (s old old-length new)replace-initial-substring
12938,577015
+(defun replace-string-prefix-in-tree (tree old old-length new)replace-string-prefix-in-tree
12951,577489
+(defmacro with-output-object-channel-sharing (chan filename bodywith-output-object-channel-sharing
12963,578070
+(defun elide-locals-and-split-expansion-alist (alist acl2x-alist x y)elide-locals-and-split-expansion-alist
13000,579494
+(defun make-certificate-file1 (file portcullis certification-file post-alist3make-certificate-file1
13046,581998
+(defun make-certificate-file-relocated (file portcullis certification-filemake-certificate-file-relocated
13125,585355
+(defun make-certificate-file (file portcullis post-alist1 post-alist2make-certificate-file
13150,586478
+(defun make-certificate-files (full-book-name portcullis post-alist1make-certificate-files
13295,593820
+(defun open-input-object-file (file ctx state)open-input-object-file
13338,595885
+(defun read-object-file1 (channel state ans)read-object-file1
13360,596767
+(defun read-object-file (file ctx state)read-object-file
13372,597221
+(defun chk-cert-annotationschk-cert-annotations
13389,598053
+(defun chk-cert-annotations-post-alistchk-cert-annotations-post-alist
13457,601356
+(defun chk-input-object-file (file ctx state)chk-input-object-file
13544,605446
+(defun include-book-dir (dir state)include-book-dir
13558,606082
+(defmacro include-book-dir-with-chk (soft-or-hard ctx dir)include-book-dir-with-chk
13570,606643
+(defun newly-defined-top-level-fns-rec (trips collect-p full-book-name acc)newly-defined-top-level-fns-rec
13589,607592
+(defun newly-defined-top-level-fns (old-wrld new-wrld full-book-name)newly-defined-top-level-fns
13623,609206
+(defun accumulate-post-alist (post-alist include-book-alist)accumulate-post-alist
13654,610378
+(defun skipped-proofsp-in-post-alist (post-alist)skipped-proofsp-in-post-alist
13673,611248
+(defun check-sum-cert (portcullis-cmds expansion-alist book-ev-lst)check-sum-cert
13692,611925
+(defmacro with-hcomp-bindings (do-it form)with-hcomp-bindings
13705,612462
+(defmacro with-hcomp-bindings (do-it form)with-hcomp-bindings
13710,612558
+(defmacro with-hcomp-ht-bindings (form)with-hcomp-ht-bindings
13727,613172
+(defmacro with-hcomp-ht-bindings (form)with-hcomp-ht-bindings
13731,613238
+(defun get-declaim-list (state)get-declaim-list
13764,614784
+(defun tilde-@-book-stack-msg (reason load-compiled-stack)tilde-@-book-stack-msg
13770,614908
+(defun convert-book-name-to-acl2x-name (x)convert-book-name-to-acl2x-name
13802,616461
+(defun acl2x-alistp (x index len)acl2x-alistp
13814,616860
+(defun read-acl2x-file (acl2x-file full-book-name len acl2x ctx state)read-acl2x-file
13824,617128
+(defun eval-port-file (full-book-name ctx state)eval-port-file
13885,619738
+(defun getenv! (str state)getenv!
13958,623101
+(defun update-pcert-books (full-book-name pcert-p wrld)update-pcert-books
13967,623347
+(defun convert-non-nil-symbols-to-keywords (x)convert-non-nil-symbols-to-keywords
13975,623603
+(defun include-book-fn1 (user-book-name stateinclude-book-fn1
13983,623891
+(defun include-book-fn (user-book-name stateinclude-book-fn
14708,660985
+(defun spontaneous-decertificationp1 (ibalist alist files)spontaneous-decertificationp1
14810,665517
+(defun spontaneous-decertificationp (alist1 alist2)spontaneous-decertificationp
14856,667669
+(defun remove-duplicates-equal-from-end (lst acc)remove-duplicates-equal-from-end
14866,668090
+(defun include-book-alist-subsetp-failure-witnesses (alist1 strip-cddrs-alist2 acc)include-book-alist-subsetp-failure-witnesses
14872,668353
+(defun expansion-filename (full-book-name convert-to-os-p state)expansion-filename
14982,674684
+(defun write-expansion-file (portcullis-cmds declaim-list new-fns-execwrite-expansion-file
14999,675320
+(defun collect-ideal-user-defuns1 (tl wrld ans)collect-ideal-user-defuns1
15174,683717
+(defun collect-ideal-user-defuns (wrld)collect-ideal-user-defuns
15203,684777
+(defun set-difference-eq-sorted (lst1 lst2 ans)set-difference-eq-sorted
15210,685016
+(defun expansion-alist-pkg-names0 (x base-kpa acc)expansion-alist-pkg-names0
15223,685549
+(defun hons-union-ordered-string-lists (x y)hons-union-ordered-string-lists
15238,686070
+(defun expansion-alist-pkg-names-memoize (x)expansion-alist-pkg-names-memoize
15255,686612
+(defun expansion-alist-pkg-names (x base-kpa)expansion-alist-pkg-names
15265,686923
+(defun delete-names-from-kpa (names kpa)delete-names-from-kpa
15296,688354
+(defun print-certify-book-step-2 (ev-lst expansion-alist pcert0-file acl2x-fileprint-certify-book-step-2
15305,688636
+(defun print-certify-book-step-3 (state)print-certify-book-step-3
15335,690334
+(defun print-certify-book-guards-warningprint-certify-book-guards-warning
15345,690756
+(defun chk-certify-book-step-3 (post-alist2 post-alist1 ctx state)chk-certify-book-step-3
15373,691833
+(defun print-certify-book-step-4 (full-book-name expansion-filename cert-opprint-certify-book-step-4
15437,695539
+(defun print-certify-book-step-5 (full-book-name state)print-certify-book-step-5
15453,696221
+(defun hcomp-build-from-portcullis (trips state)hcomp-build-from-portcullis
15460,696478
+(defstub acl2x-expansion-alist (expansion-alist state)acl2x-expansion-alist
15559,701995
+(defun hons-copy-with-state (x state)hons-copy-with-state
15570,702470
+(defun identity-with-state (x state)identity-with-state
15575,702596
+(defun write-acl2x-file (expansion-alist acl2x-file ctx state)write-acl2x-file
15590,703063
+(defun merge-into-expansion-alist1 (acl2x-expansion-alistmerge-into-expansion-alist1
15611,703822
+(defun acl2x-alistp-domains-subsetp (x y)acl2x-alistp-domains-subsetp
15638,705307
+(defun merge-into-expansion-alist (acl2x-expansion-alistmerge-into-expansion-alist
15651,705696
+(defun restrict-expansion-alist (index expansion-alist)restrict-expansion-alist
15677,706940
+(defun elide-locals-from-expansion-alist (alist acc)elide-locals-from-expansion-alist
15689,707351
+(defun write-port-file (full-book-name cmds ctx state)write-port-file
15705,708019
+(defmacro save-parallelism-settings (form)save-parallelism-settings
15734,709029
+(defun include-book-alist-equal-modulo-local (old-post-alist new-post-alist)include-book-alist-equal-modulo-local
15747,709479
+(defun copy-object-channel-until-marker (marker ch-from ch-to state)copy-object-channel-until-marker
15769,710671
+(defun copy-pcert0-to-pcert1 (from to ctx state)copy-pcert0-to-pcert1
15779,711075
+(defun touch? (filename old-filename ctx state)touch?
15810,712549
+(defun convert-book-name-to-compiled-name (full-book-name state)convert-book-name-to-compiled-name
15847,714260
+(defun certify-book-finish-convert (new-post-alist old-post-alistcertify-book-finish-convert
15857,714666
+(defun delete-cert-files (full-book-name)delete-cert-files
15890,716369
+(defun include-book-alist-uncertified-books (alist acc state)include-book-alist-uncertified-books
15900,716728
+(defun count-forms-in-channel (ch state n)count-forms-in-channel
15937,718442
+(defun skip-forms-in-channel (n ch state)skip-forms-in-channel
15943,718651
+(defun post-alist-from-pcert1-1 (n first-try-p pcert1-file msg ctx state)post-alist-from-pcert1-1
15950,718931
+(defun post-alist-from-pcert1 (pcert1-file msg ctx state)post-alist-from-pcert1
15998,720639
+(defun certificate-post-alist (pcert1-file cert-file full-book-name ctx state)certificate-post-alist
16015,721113
+(defun certify-book-finish-complete (full-book-name ctx state)certify-book-finish-complete
16031,721858
+(defun expansion-alist-conflict (acl2x-expansion-alistexpansion-alist-conflict
16085,724228
+(defun chk-absstobj-invariants (extra-msg state)chk-absstobj-invariants
16117,725931
+(defun certify-book-fn (user-book-name k compile-flg defaxioms-okpcertify-book-fn
16172,728502
+(defmacro certify-book (user-book-namecertify-book
16994,777340
+(defmacro certify-book! (user-book-name &optionalcertify-book!
17239,791239
+(defdoc provisional-certificationprovisional-certification
17273,792650
+(deflabel pathnamepathname
17596,811188
+(deflabel book-examplebook-example
17641,813538
+(deflabel full-book-namefull-book-name
17812,822493
+(deflabel book-namebook-name
17857,824340
+(deflabel book-contentsbook-contents
17948,828591
+(deflabel certificatecertificate
18026,831898
+(deflabel portcullisportcullis
18109,836292
+(deflabel versionversion
18221,842399
+(deflabel keepkeep
18315,847402
+(deflabel uncertified-booksuncertified-books
18348,848972
+(deflabel books-certification-classicbooks-certification-classic
18411,852428
+(defdoc books-certificationbooks-certification
18656,864258
+(defun redundant-defchoosep (name event-form wrld)redundant-defchoosep
18924,876235
+(defun chk-arglist-for-defchoose (args bound-vars-flg ctx state)chk-arglist-for-defchoose
18938,876844
+(defun defchoose-constraint-basic (fn bound-vars formals tbody ctx wrld state)defchoose-constraint-basic
18956,877678
+(defun generate-variable-lst-simple (var-lst avoid-lst)generate-variable-lst-simple
18997,879019
+(defun defchoose-constraint-extra (fn bound-vars formals body)defchoose-constraint-extra
19014,879672
+(defun defchoose-constraint (fn bound-vars formals body tbody strengthen ctxdefchoose-constraint
19089,883545
+(defun defchoose-fn (def state event-form)defchoose-fn
19102,884120
+(defun non-acceptable-defun-sk-p (name args body doc quant-ok rewrite exists-p)non-acceptable-defun-sk-p
19272,892554
+(defmacro defun-sk (name args bodydefun-sk
19352,896554
+(deflabel forallforall
19725,913335
+(deflabel existsexists
19739,913726
+(deflabel defun-sk-exampledefun-sk-example
19753,914121
+(defdoc quantifier-tutorialquantifier-tutorial
19849,917615
+(deflabel quantifiersquantifiers
20452,945117
+(deflabel quantifiers-using-recursionquantifiers-using-recursion
20489,946876
+(deflabel quantifiers-using-defun-skquantifiers-using-defun-sk
20520,947709
+(deflabel quantifiers-using-defun-sk-extendedquantifiers-using-defun-sk-extended
20570,949335
+(defun doublet-style-symbol-to-symbol-alistp (x)doublet-style-symbol-to-symbol-alistp
20664,952465
+(defun chk-legal-defstobj-name (name state)chk-legal-defstobj-name
20677,952991
+(defun chk-unrestricted-guards-for-user-fns (names wrld ctx state)chk-unrestricted-guards-for-user-fns
20690,953471
+(defconst *expt2-28* (expt 2 28))*expt2-28*
20703,954018
+(defun fix-stobj-array-type (type wrld)fix-stobj-array-type
20705,954053
+(defun chk-stobj-field-descriptor (name field-descriptor ctx wrld state)chk-stobj-field-descriptor
20727,954907
+(defun chk-acceptable-defstobj-renamingchk-acceptable-defstobj-renaming
20911,964074
+(defun defconst-name (name)defconst-name
21041,970316
+(defun chk-acceptable-defstobj1chk-acceptable-defstobj1
21046,970438
+(defconst *defstobj-keywords**defstobj-keywords*
21139,975418
+(defun defstobj-redundancy-bundle (args)defstobj-redundancy-bundle
21142,975492
+(defun old-defstobj-redundancy-bundle (name wrld)old-defstobj-redundancy-bundle
21176,976560
+(defun redundant-defstobjp (name args wrld)redundant-defstobjp
21189,977051
+(defun congruent-stobj-fields (fields1 fields2)congruent-stobj-fields
21215,978410
+(defun chk-acceptable-defstobj (name args ctx wrld state)chk-acceptable-defstobj
21226,978843
+(defun defstobj-fields-template (field-descriptors renaming wrld)defstobj-fields-template
21394,986669
+(defun defstobj-template (name args wrld)defstobj-template
21440,988670
+(defun defstobj-component-recognizer-calls (ftemps n var ans)defstobj-component-recognizer-calls
21486,990817
+(defun defstobj-component-recognizer-axiomatic-defs (name template ftemps wrld)defstobj-component-recognizer-axiomatic-defs
21513,991961
+(defun defstobj-field-fns-axiomatic-defs (top-recog var n ftemps wrld)defstobj-field-fns-axiomatic-defs
21585,995225
+(defun defstobj-axiomatic-init-fields (ftemps wrld)defstobj-axiomatic-init-fields
21699,1001003
+(defun defstobj-creator-fn (creator-name field-templates wrld)defstobj-creator-fn
21723,1001945
+(defun defstobj-axiomatic-defs (name template wrld)defstobj-axiomatic-defs
21733,1002237
+(defun simple-array-type (array-etype dimensions)simple-array-type
21772,1004024
+(defun-one-output stobj-copy-array-aref (a1 a2 i n)stobj-copy-array-aref
21784,1004409
+(defun-one-output stobj-copy-array-svref (a1 a2 i n)stobj-copy-array-svref
21802,1005120
+(defun-one-output stobj-copy-array-fix-aref (a1 a2 i n)stobj-copy-array-fix-aref
21817,1005577
+(defmacro live-stobjp (name)live-stobjp
21834,1006252
+(defun array-etype-is-fixnum-type (array-etype)array-etype-is-fixnum-type
21844,1006684
+(defun defstobj-field-fns-raw-defs (var flush-var inline n ftemps)defstobj-field-fns-raw-defs
21880,1008073
+(defun defstobj-raw-init-fields (ftemps)defstobj-raw-init-fields
22061,1016765
+(defun defstobj-raw-init (template)defstobj-raw-init
22118,1019264
+(defun defstobj-raw-defs (name template congruent-stobj-rep wrld)defstobj-raw-defs
22126,1019509
+(defun put-stobjs-in-and-outs1 (name ftemps wrld)put-stobjs-in-and-outs1
22173,1021519
+(defun put-stobjs-in-and-outs (name template wrld)put-stobjs-in-and-outs
22219,1023185
+(defun defconst-name-alist (lst n)defconst-name-alist
22272,1025502
+(defun accessor-array (name field-names)accessor-array
22278,1025662
+(defun strip-accessor-names (x)strip-accessor-names
22288,1026081
+(defun defstobj-defconsts (names index)defstobj-defconsts
22298,1026328
+(defun defstobj-fn (name args state event-form)defstobj-fn
22304,1026513
+(defun absstobj-name (name type)absstobj-name
22752,1050824
+(defmacro defabsstobj (&whole event-formdefabsstobj
22781,1051980
+(defmacro defabsstobj (&whole event-formdefabsstobj
22892,1056670
+(defun concrete-stobj (st wrld)concrete-stobj
23549,1089101
+(defmacro defabsstobj-missing-events (&whole event-formdefabsstobj-missing-events
23557,1089380
+(defun redundant-defabsstobjp (name event-form wrld)redundant-defabsstobjp
23603,1091459
+(defun absstobj-correspondence-concl-lst (stobjs-out i st$c corr-fn)absstobj-correspondence-concl-lst
23607,1091621
+(defun absstobj-correspondence-formula (f$a f$c corr-fn formals guard-pre stabsstobj-correspondence-formula
23618,1092149
+(defun absstobj-preserved-formula (f$a f$c formals guard-pre st st$c st$ap wrld)absstobj-preserved-formula
23669,1094185
+(defrec absstobj-methodabsstobj-method
23719,1096067
+(defun fn-stobj-updates-p (st fn wrld)fn-stobj-updates-p
23738,1096780
+(defun stobj-updates-p (st term wrld)stobj-updates-p
23762,1097470
+(defun stobj-updates-listp (st x wrld)stobj-updates-listp
23837,1100270
+(defun unprotected-export-p (st$c name wrld)unprotected-export-p
23847,1100625
+(defun translate-absstobj-field (st st$c field type protect-defaulttranslate-absstobj-field
23851,1100770
+(defun simple-translate-absstobj-fields (st st$c fields types protect-defaultsimple-translate-absstobj-fields
24197,1120041
+(defun one-way-unify-p (pat term)one-way-unify-p
24219,1120996
+(defun obviously-iff-equiv-terms (x y)obviously-iff-equiv-terms
24229,1121259
+(defun chk-defabsstobj-method-lemmas (method st st$c st$ap corr-fnchk-defabsstobj-method-lemmas
24274,1123278
+(defun chk-defabsstobj-method (method st st$c st$ap corr-fn congruent-tochk-defabsstobj-method
24387,1128794
+(defun chk-acceptable-defabsstobj1 (st st$c st$ap corr-fn fieldschk-acceptable-defabsstobj1
24411,1129851
+(defun first-keyword (lst)first-keyword
24458,1131815
+(defun chk-acceptable-defabsstobj (name st$c recognizer st$ap creator corr-fnchk-acceptable-defabsstobj
24465,1132002
+(defun defabsstobj-axiomatic-defs (st$c methods)defabsstobj-axiomatic-defs
24550,1135935
+(defun defabsstobj-raw-def (method)defabsstobj-raw-def
24570,1136982
+(defun defabsstobj-raw-defs-rec (methods)defabsstobj-raw-defs-rec
24620,1139114
+(defun defabsstobj-raw-defs (st-name methods)defabsstobj-raw-defs
24628,1139331
+(defun expand-recognizer (st-name recognizer see-doc ctx state)expand-recognizer
24664,1140962
+(defun put-absstobjs-in-and-outs (st methods wrld)put-absstobjs-in-and-outs
24679,1141625
+(defun method-exec (name methods)method-exec
24697,1142484
+(defun defabsstobj-raw-init (creator-name methods)defabsstobj-raw-init
24706,1142819
+(defun defabsstobj-missing-msg (missing wrld)defabsstobj-missing-msg
24709,1142913
+(defun update-guard-post (logic-subst methods)update-guard-post
24733,1144014
+(defun defabsstobj-logic-subst (methods)defabsstobj-logic-subst
24753,1145120
+(defun chk-defabsstobj-guard (method ctx wrld state-vars)chk-defabsstobj-guard
24759,1145380
+(defun chk-defabsstobj-guards1 (methods msg ctx wrld state-vars)chk-defabsstobj-guards1
24784,1146659
+(defun chk-defabsstobj-guards (methods congruent-to ctx wrld state)chk-defabsstobj-guards
24800,1147393
+(defun make-absstobj-logic-exec-pairs (methods)make-absstobj-logic-exec-pairs
24812,1147973
+(defun defabsstobj-fn1 (st-name st$c recognizer creator corr-fn exportsdefabsstobj-fn1
24818,1148257
+(defun defabsstobj-fn (st-name st$c recognizer creator corr-fn exportsdefabsstobj-fn
25035,1158872
+(deflabel stobjstobj
25055,1159937
+(deflabel stobj-example-1stobj-example-1
25158,1165330
+(deflabel declare-stobjsdeclare-stobjs
25391,1174588
+(deflabel stobj-example-1-defunsstobj-example-1-defuns
25442,1176828
+(deflabel stobj-example-1-implementationstobj-example-1-implementation
25561,1181473
+(deflabel stobj-example-1-proofsstobj-example-1-proofs
25636,1184285
+(deflabel stobj-example-2stobj-example-2
25786,1189845
+(deflabel stobj-example-3stobj-example-3
25880,1192929
+(defdoc resize-listresize-list
26118,1201956
+(defun-one-output mv-let-for-with-local-stobj (mv-let-form st creator flet-fns w)mv-let-for-with-local-stobj
26132,1202476
+(defmacro with-local-stobj (&rest args)with-local-stobj
26198,1205849
+(deflabel with-local-stobjwith-local-stobj
26434,1212096
+(defun create-state ()create-state
26514,1215202
+(defmacro with-local-state (mv-let-form)with-local-state
26518,1215299
+(defdoc nested-stobjsnested-stobjs
26807,1227050
+(defmacro stobj-let (&whole x &rest args)stobj-let
27371,1252039
+(defun push-untouchable-fn (name fn-p state doc event-form)push-untouchable-fn
27380,1252234
+(defun remove-untouchable-fn (name fn-p state doc event-form)remove-untouchable-fn
27435,1254315
+(defun def-body-lemmas (def-bodies lemmas)def-body-lemmas
27490,1256499
+(defmacro show-bodies (fn)show-bodies
27498,1256809
+(defun set-body-fn1 (rune def-bodies acc)set-body-fn1
27548,1258911
+(defun set-body-fn (fn name-or-rune state event-form)set-body-fn
27558,1259277
+(defdoc tracetrace
27604,1260936
+(defparameter *trace-evisc-tuple**trace-evisc-tuple*
27632,1262075
+(defparameter *trace-evisc-tuple-world**trace-evisc-tuple-world*
27635,1262117
+(defun trace-evisc-tuple ()trace-evisc-tuple
27638,1262165
+(defun trace-multiplicity (name state)trace-multiplicity
27647,1262434
+(defun first-trace-printing-column (state)first-trace-printing-column
27660,1262787
+(defun trace-ppr (x trace-evisc-tuple msgp state)trace-ppr
27676,1263276
+(defvar *inside-trace$* nil)*inside-trace$*
27687,1263576
+(defun custom-trace-ppr (direction x &optional evisc-tuple msgp)custom-trace-ppr
27690,1263623
+(defun *1*defp (trace-spec wrld)*1*defp
27751,1266221
+(defun trace$-er-msg (fn)trace$-er-msg
27756,1266367
+(defun decls-and-doc (forms)decls-and-doc
27760,1266463
+(defun trace$-when-gcond (gcond form)trace$-when-gcond
27770,1266739
+(defun stobj-evisceration-alist (user-stobj-alist state)stobj-evisceration-alist
27775,1266828
+(defun trace-evisceration-alist (state)trace-evisceration-alist
27783,1267223
+(defun set-trace-evisc-tuple (val state)set-trace-evisc-tuple
27787,1267381
+(defun chk-trace-options-aux (form kwd formals ctx wrld state)chk-trace-options-aux
27863,1270425
+(defun trace$-value-msgp (x)trace$-value-msgp
27890,1271607
+(defun chk-trace-options (fn predefined trace-options formals ctx wrld state)chk-trace-options
27903,1272054
+(defun memoize-off-trace-error (fn ctx)memoize-off-trace-error
27997,1276165
+(defun untrace$-fn1 (fn state)untrace$-fn1
28005,1276526
+(defun untrace$-rec (fns ctx state)untrace$-rec
28056,1278492
+(defun untrace$-fn (fns state)untrace$-fn
28075,1279142
+(defun maybe-untrace$-fn (fn state)maybe-untrace$-fn
28086,1279533
+(defmacro maybe-untrace$ (fn)maybe-untrace$
28095,1279837
+(defmacro maybe-untrace (fn)maybe-untrace
28099,1279920
+(defun maybe-untrace! (fn &optional verbose)maybe-untrace!
28109,1280186
+(defun increment-trace-level ()increment-trace-level
28133,1280925
+(defun trace$-def (arglist def trace-options predefined multiplicity ctx)trace$-def
28139,1281106
+(defun trace$-install (fn formals def trace-options predefined multiplicitytrace$-install
28315,1289292
+(defun oneified-def (fn wrld &optional trace-rec-for-none)oneified-def
28347,1290614
+(defun trace$-fn-general (trace-spec ctx state)trace$-fn-general
28363,1291233
+(defun trace$-fn-simple (trace-spec ctx state)trace$-fn-simple
28555,1300443
+(defconst *trace-keywords**trace-keywords*
28558,1300542
+(defconst *trace-keywords-needing-ttag**trace-keywords-needing-ttag*
28567,1300790
+(defun all-keywords-p (keywords)all-keywords-p
28574,1301013
+(defun first-assoc-keyword (keys x)first-assoc-keyword
28580,1301173
+(defconst *illegal-trace-spec-fmt-string**illegal-trace-spec-fmt-string*
28588,1301452
+(defun trace$-fn (trace-spec ctx state)trace$-fn
28593,1301680
+(defun trace$-lst (trace-spec-lst ctx state)trace$-lst
28627,1303472
+(defmacro trace$ (&rest trace-specs)trace$
28638,1303817
+(defmacro with-ubt! (form)with-ubt!
29166,1327433
+(defmacro trace! (&rest fns)trace!
29186,1328249
+(defmacro untrace$ (&rest fns)untrace$
29427,1335744
+(defun open-trace-file-fn (filename state)open-trace-file-fn
29451,1336462
+(defmacro open-trace-file (filename)open-trace-file
29477,1337562
+(defun close-trace-file-fn (quiet-p state)close-trace-file-fn
29498,1338187
+(defmacro close-trace-file ()close-trace-file
29511,1338689
+(defmacro break-on-error (&optional (on 't))break-on-error
29527,1339158
+(defun defexec-extract-key (x keyword result result-p)defexec-extract-key
29628,1344071
+(defun parse-defexec-dcls-1 (alist guard guard-p hints hints-p measureparse-defexec-dcls-1
29650,1345115
+(defun fix-exec-xargs (exec-xargs hints hints-pfix-exec-xargs
29773,1350556
+(defun parse-defexec-dcls (dcls-and-strings finalparse-defexec-dcls
29802,1351805
+(defmacro defexec (&whole whole fn formals &rest rest)defexec
29874,1355405
+(defrec sar ; single-applicable-rewritesar
30129,1366734
+(defun applicable-rewrite-rules1 (term geneqv lemmas current-indexapplicable-rewrite-rules1
30144,1367578
+(defun applicable-linear-rules1 (term lemmas current-index target-name-or-runeapplicable-linear-rules1
30204,1370170
+(defun pc-relieve-hyp (rune hyp unify-subst type-alist wrld state ens ttree)pc-relieve-hyp
30256,1372238
+(defun pc-relieve-hyps1-iter (rune hyps unify-subst-lst unify-substpc-relieve-hyps1-iter
30342,1375846
+(defun pc-relieve-hyps1 (rune hyps unify-subst unify-subst0 ttree0 type-alistpc-relieve-hyps1
30363,1376832
+(defun pc-relieve-hyps (rune hyps unify-subst type-alist keep-unify-subst wrldpc-relieve-hyps
30414,1379235
+(defun remove-trivial-lits (lst type-alist alist wrld ens ttree)remove-trivial-lits
30427,1379834
+(defun unrelieved-hyps (rune hyps unify-subst type-alist keep-unify-subst wrldunrelieved-hyps
30450,1380883
+(defun untranslate-subst-abb (sub abbreviations state)untranslate-subst-abb
30474,1381899
+(defun show-rewrite-linear (caller index col rune nume show-more subst-hypsshow-rewrite-linear
30481,1382167
+(defun show-rewrites-linears (caller app-rules col abbreviationsshow-rewrites-linears
30574,1386888
+(defun expand-assumptions-1 (term)expand-assumptions-1
30647,1389987
+(defun expand-assumptions (x)expand-assumptions
30662,1390631
+(defun hyps-type-alist (assumptions ens wrld state)hyps-type-alist
30672,1390862
+(defun show-rewrites-linears-fn (caller rule-id enabled-only-flg ensshow-rewrites-linears-fn
30686,1391523
+(defun show-meta-lemmas1 (lemmas rule-id term wrld ens state)show-meta-lemmas1
30786,1396269
+(defun show-meta-lemmas (term rule-id state)show-meta-lemmas
30843,1398899
+(defun decoded-type-set-from-tp-rule (tp unify-subst wrld ens)decoded-type-set-from-tp-rule
30853,1399314
+(defun show-type-prescription-rule (rule unify-subst type-alist abbreviationsshow-type-prescription-rule
30873,1400078
+(defun show-type-prescription-rules1 (rules term rule-id type-alistshow-type-prescription-rules1
30913,1402093
+(defun show-type-prescription-rules (term rule-id abbreviations all-hyps ensshow-type-prescription-rules
30935,1403133
+(defun pl2-fn (form rule-id caller state)pl2-fn
30967,1404559
+(defun pl-fn (name state)pl-fn
31025,1407476
+(defmacro pl (name)pl
31062,1408989
+(defmacro pl2 (form rule-id)pl2
31108,1411204
+(defun acl2-defaults-table-local-ctx-p (state)acl2-defaults-table-local-ctx-p
31194,1416001
+(defun add-include-book-dir-fn (keyword dir state)add-include-book-dir-fn
31201,1416264
+(defun delete-include-book-dir-fn (keyword state)delete-include-book-dir-fn
31293,1420703
+(defun add-custom-keyword-hint-fn (key uterm1 uterm2 state)add-custom-keyword-hint-fn
31348,1423217
+(defmacro reset-prehistory (&rest args)reset-prehistory
31436,1427132
+(defmacro reset-prehistory (&whole event-form &optional permanent-p doc)reset-prehistory
31441,1427223
+(defun checkpoint-world (flushp state)checkpoint-world
31497,1429592
+(defvar *checkpoint-world-len-and-alist-stack**checkpoint-world-len-and-alist-stack*
31504,1429698
+(defmacro checkpoint-world-len-and-alist ()checkpoint-world-len-and-alist
31507,1429753
+(defun checkpoint-world1 (flushp wrld state)checkpoint-world1
31510,1429847
+(defun checkpoint-world (flushp state)checkpoint-world
31536,1430954
+(defun reset-kill-ring (n state)reset-kill-ring
31548,1431233
+(defun reset-prehistory-fn (permanent-p state doc event-form)reset-prehistory-fn
31587,1432873
+(defun memoize-table-chk-commutative (str fn val ctx wrld)memoize-table-chk-commutative
31649,1435700
+(defun memoize-table-chk (key val wrld)memoize-table-chk
31700,1438151
+(defun remove-stobjs-in-by-position (lst stobjs-in)remove-stobjs-in-by-position
31901,1447944
+(defun alist-to-doublets (alist)alist-to-doublets
31912,1448425
+(defun print-gv1 (fn-guard-stobjsin-args state)print-gv1
31918,1448631
+(defun print-gv-fn (evisc-tuple state)print-gv-fn
31940,1449367
+(defmacro print-gv (&key (evisc-tupleprint-gv
31970,1450553
+(defun disable-iprint-ar (state)disable-iprint-ar
32132,1455983
+(defun enable-iprint-ar (state)enable-iprint-ar
32155,1457139
+(defconst *iprint-actions**iprint-actions*
32173,1457934
+(defun set-iprint-fn1 (x state)set-iprint-fn1
32176,1458001
+(defun set-iprint-fn (x state)set-iprint-fn
32205,1459019
+(defun set-iprint-hard-bound (n ctx state)set-iprint-hard-bound
32217,1459482
+(defun set-iprint-soft-bound (n ctx state)set-iprint-soft-bound
32230,1459953
+(defmacro set-iprint (&optional (action ':RESET ; default ignoredset-iprint
32243,1460424
+(defconst *evisc-tuple-sites**evisc-tuple-sites*
32474,1470523
+(defun set-site-evisc-tuple (site evisc-tuple ctx state)set-site-evisc-tuple
32477,1470595
+(defun chk-evisc-tuple (evisc-tuple ctx state)chk-evisc-tuple
32507,1472083
+(defun set-evisc-tuple-lst (keys evisc-tuple acc ctx state)set-evisc-tuple-lst
32516,1472408
+(defun set-evisc-tuple-fn1 (keys all-keys evisc-tuple acc ctx state)set-evisc-tuple-fn1
32527,1472856
+(defun iprint-virginp (state)iprint-virginp
32570,1474813
+(defun set-evisc-tuple-fn (evisc-tupleset-evisc-tuple-fn
32577,1475078
+(defmacro set-evisc-tuple (evisc-tupleset-evisc-tuple
32643,1478101
+(defmacro top-level (form &rest declares)top-level
32757,1483834
+(defun translate-defattach-helpers (kwd-value-lst name-tree ctx wrld state)translate-defattach-helpers
33427,1520681
+(defconst *defattach-keys**defattach-keys*
33485,1523125
+(defun defattach-unknown-constraints-error (name wrld ctx state)defattach-unknown-constraints-error
33491,1523262
+(defun intersection-domains (a1 a2)intersection-domains
33503,1523805
+(defun process-defattach-args1 (args ctx wrld state erasures explicit-erasuresprocess-defattach-args1
33513,1524126
+(defun duplicate-keysp-eq (alist)duplicate-keysp-eq
33814,1539819
+(defun split-at-first-keyword (args)split-at-first-keyword
33824,1540121
+(defun filter-for-attachment (attachment-alist helpers-lst attach-by-defaultfilter-for-attachment
33839,1540621
+(defconst *defattach-keys-plus-skip-checks**defattach-keys-plus-skip-checks*
33861,1541756
+(defun process-defattach-args (args ctx state)process-defattach-args
33864,1541841
+(defun prove-defattach-guards1 (i n attachment-alist-tail attachment-alistprove-defattach-guards1
33993,1547875
+(defun prove-defattach-guards (attachment-alist helpers-lst ctx ens wrld state)prove-defattach-guards
34059,1551022
+(defun defattach-constraint-rec (alist full-alist proved-fnl-insts-alistdefattach-constraint-rec
34088,1552293
+(defun defattach-constraint (attachment-alist proved-fnl-insts-alist wrld ctxdefattach-constraint
34157,1555441
+(defun prove-defattach-constraint (goal event-names attachment-alistprove-defattach-constraint
34167,1555909
+(defun attachment-component-owner (g path)attachment-component-owner
34418,1569099
+(defun intersection1-eq (x y)intersection1-eq
34447,1570573
+(defun defattach-component-has-owner (g g0 comps)defattach-component-has-owner
34456,1570906
+(defun defattach-merge-into-component (g0 ext-succ0 comps0 ext-succ1 g1defattach-merge-into-component
34472,1571698
+(defun defattach-merge-components (g0 ext-succ0 comps0 ext-succ1 g1 comps1defattach-merge-components
34588,1575664
+(defun defattach-merge (r0 r1)defattach-merge
34630,1577580
+(defun defattach-merge-lst (r lst changedp)defattach-merge-lst
34654,1578547
+(defun defattach-merge-lst-lst (to-do done changedp)defattach-merge-lst-lst
34672,1579310
+(defun defattach-loop-error-msg (loop end)defattach-loop-error-msg
34698,1580600
+(defun defattach-loop-error (loop ctx state)defattach-loop-error
34707,1580916
+(defun defattach-close (records ctx state)defattach-close
34714,1581199
+(defun defattach-erase-components (components canonical-erased-fs)defattach-erase-components
34723,1581533
+(defun defattach-erase-p (record erasures canonical-erased-fs)defattach-erase-p
34754,1583154
+(defun defattach-erase1 (records attachments erasures canonical-erased-fsdefattach-erase1
34772,1583986
+(defun defattach-erase (records attachments erasures wrld)defattach-erase
34807,1585486
+(defun collect-ext-anc (f records)collect-ext-anc
34827,1586503
+(defun extend-attachment-components (comps g0 ext-succ f g)extend-attachment-components
34838,1586888
+(defun component-path-extension (f comps)component-path-extension
34878,1588937
+(defun extend-attachment-record (pair f-canon g-canon rec)extend-attachment-record
34895,1589769
+(defun update-attachment-records1 (pair f-canon g-canon records)update-attachment-records1
34932,1591444
+(defun update-attachment-records (pair f-canon g-canon records wrld ctx state)update-attachment-records
34963,1592984
+(defun attachment-records (attachments records wrld ctx state)attachment-records
35000,1594900
+(defun chk-defattach-loop (attachments erasures wrld ctx state)chk-defattach-loop
35016,1595511
+(defun defaxiom-supporter-msg-list (symbols wrld)defaxiom-supporter-msg-list
35051,1597100
+(defun chk-acceptable-defattach (args proved-fnl-insts-alist ctx wrld state)chk-acceptable-defattach
35061,1597604
+(defun attachment-cltl-cmd (erasures alist)attachment-cltl-cmd
35172,1603085
+(defun defattach-fn (args state event-form)defattach-fn
35186,1603649
+(defun chk-return-last-entry (key val wrld)chk-return-last-entry
35269,1607992
+(defdoc return-last-tablereturn-last-table
35331,1610882
+(defmacro defmacro-last (fn &key raw (top-level-ok 't))defmacro-last
35357,1612184
+(defdoc printing-to-stringsprinting-to-strings
35380,1613081
+(defconst *fmt-control-defaults**fmt-control-defaults*
35438,1615924
+(defconst *fixed-fmt-controls**fixed-fmt-controls*
35462,1617036
+(defun fmt-control-bindings1 (alist fmt-control-defaults-tail)fmt-control-bindings1
35471,1617296
+(defun fmt-control-bindings (alist)fmt-control-bindings
35495,1618417
+(defun set-iprint-ar (iprint-ar state)set-iprint-ar
35500,1618584
+(defmacro channel-to-string (form channel-varchannel-to-string
35508,1618848
+(defun fms-to-string-fn (str alist evisc-tuple fmt-control-alist iprint-action)fms-to-string-fn
35615,1623391
+(defmacro fms-to-string (str alist &key evisc-tuple fmt-control-alist iprint)fms-to-string
35620,1623623
+(defun fms!-to-string-fn (str alist evisc-tuple fmt-control-alist iprint-action)fms!-to-string-fn
35624,1623832
+(defmacro fms!-to-string (str alist &key evisc-tuple fmt-control-alist iprint)fms!-to-string
35629,1624066
+(defun fmt-to-string-fn (str alist evisc-tuple fmt-control-alist iprint-action)fmt-to-string-fn
35633,1624277
+(defmacro fmt-to-string (str alist &key evisc-tuple fmt-control-alist iprint)fmt-to-string
35638,1624509
+(defun fmt!-to-string-fn (str alist evisc-tuple fmt-control-alistfmt!-to-string-fn
35642,1624718
+(defmacro fmt!-to-string (str alist &key evisc-tuple fmt-control-alist iprint)fmt!-to-string
35648,1624982
+(defun fmt1-to-string-fn (str alist col evisc-tuple fmt-control-alistfmt1-to-string-fn
35652,1625193
+(defmacro fmt1-to-string (str alist col &key evisc-tuple fmt-control-alistfmt1-to-string
35658,1625465
+(defun fmt1!-to-string-fn (str alist col evisc-tuple fmt-control-alistfmt1!-to-string-fn
35663,1625715
+(defmacro fmt1!-to-string (str alist col &key evisc-tuple fmt-control-alistfmt1!-to-string
35669,1625987
+(defdoc dead-eventsdead-events
35681,1626624
+(defun attachment-pairs (fns wrld acc)attachment-pairs
35822,1634390
+(defun sibling-attachments (f wrld)sibling-attachments
35834,1634726
+(defun extended-ancestors4 (fns wrld fal)extended-ancestors4
35840,1634889
+(defun extended-ancestors3 (components wrld fal)extended-ancestors3
35851,1635253
+(defun extended-ancestors2 (canon-gs arfal wrld canon-gs-fal fal)extended-ancestors2
35866,1635793
+(defun canonical-cdrs (alist wrld acc)canonical-cdrs
35888,1636893
+(defun extended-ancestors1 (fns canon-gs arfal wrld fal)extended-ancestors1
35895,1637144
+(defun attachment-records-fal (attachment-records fal)attachment-records-fal
35918,1638312
+(defun extended-ancestors (f wrld)extended-ancestors
35926,1638634
+(defun ext-anc-attachment-missing (alist wrld)ext-anc-attachment-missing
35940,1639170
+(defun ext-anc-attachments-valid-p-1 (fns alist wrld)ext-anc-attachments-valid-p-1
35950,1639447
+(defun ext-anc-attachments-valid-p (fns ext-anc-attachments wrld acc)ext-anc-attachments-valid-p
35961,1639821
+(defconst *inline-suffix* "$INLINE")*inline-suffix*
35988,1641022
+(defconst *inline-suffix-len-minus-1* (1- (length *inline-suffix*)))*inline-suffix-len-minus-1*
35989,1641059
+(defconst *notinline-suffix* "$NOTINLINE")*notinline-suffix*
35990,1641128
+(defconst *notinline-suffix-len-minus-1* (1- (length *notinline-suffix*)))*notinline-suffix-len-minus-1*
35991,1641171
+(defconst *non-stobj-var-root* (coerce (symbol-name 'non-stobj-var) 'list))*non-stobj-var-root*
35992,1641246
+(defun defun-inline-form (name formals lst defun-type suffix)defun-inline-form
35994,1641323
+(defmacro defun-inline (name formals &rest lst)defun-inline
36024,1642574
+(defmacro defund-inline (name formals &rest lst)defund-inline
36142,1648069
+(defmacro defun-notinline (name formals &rest lst)defun-notinline
36156,1648516
+(defmacro defund-notinline (name formals &rest lst)defund-notinline
36178,1649564
+(defun regenerate-tau-database-fn0 (user-auto-modep auto-modep ens tripsregenerate-tau-database-fn0
36192,1650027
+(defun regenerate-tau-database-fn1regenerate-tau-database-fn1
36236,1652160
+(defun regenerate-tau-database-fn (state doc event-form)regenerate-tau-database-fn
36307,1655664
+(defun rational-to-decimal-string (x state)rational-to-decimal-string
36353,1657386
+(defvar *time-tracker-alist* nil)*time-tracker-alist*
36368,1657946
+(defvar *time-tracker-disabled-p* nil)*time-tracker-disabled-p*
36370,1657981
+(defstruct time-trackertime-tracker
36372,1658021
+(defun tt-print-msg (tag msg total)tt-print-msg
36401,1659307
+(defun tt-init (tag times interval msg)tt-init
36416,1659880
+(defun tt-end (tag)tt-end
36459,1661572
+(defun tt-print? (tag min-time msg)tt-print?
36469,1661912
+(defun tt-stop (tag)tt-stop
36521,1664328
+(defun tt-start (tag)tt-start
36543,1665191
+(defun program-declared-p1 (dcls)program-declared-p1
36566,1666070
+(defun program-declared-p (def)program-declared-p
36576,1666407
+(defmacro defund (&rest def)defund
36588,1666826
+(defmacro defund (&rest def)defund
36644,1669010
+(defun magic-ev-fncall-cl-proc (x)magic-ev-fncall-cl-proc
36653,1669420
+(defun-overrides magic-ev-fncall (fn args state hard-error-returns-nilp aok)magic-ev-fncall
36678,1670109
+
+ld.lisp,23815
+(defun default-print-prompt (channel state)default-print-prompt
27,1032
+(defun print-prompt (prompt output-channel state)print-prompt
133,5763
+(defun initialize-timers (state)initialize-timers
164,6996
+(defun maybe-add-command-landmark (old-wrld old-default-defun-mode formmaybe-add-command-landmark
171,7199
+(defun replace-last-cdr (x val)replace-last-cdr
229,9791
+(defun ld-standard-oi-missing (val file-name ld-missing-input-ok ctx state)ld-standard-oi-missing
234,9951
+(defun chk-acceptable-ld-fn1-pair (pair ld-missing-input-ok ctx statechk-acceptable-ld-fn1-pair
247,10578
+(defun close-channels (channel-closing-alist state)close-channels
396,17242
+(defun chk-acceptable-ld-fn1 (alist ld-missing-input-ok ctx state co-stringchk-acceptable-ld-fn1
431,18829
+(defun chk-acceptable-ld-fn (alist state)chk-acceptable-ld-fn
551,25219
+(defun f-put-ld-specials (alist state)f-put-ld-specials
592,27140
+(defun f-get-ld-specials (state)f-get-ld-specials
650,29553
+(defun ld-read-keyword-command1 (n state)ld-read-keyword-command1
690,31173
+(defun exit-ld (state)exit-ld
709,31897
+(defun macro-minimal-arity1 (lst)macro-minimal-arity1
718,32212
+(defun macro-minimal-arity (sym default wrld)macro-minimal-arity
725,32415
+(defun ld-read-keyword-command (key state)ld-read-keyword-command
731,32670
+(defun ld-read-command (state)ld-read-command
802,35594
+(deflabel acl2-customizationacl2-customization
838,37435
+(deflabel keyword-commandskeyword-commands
915,41586
+(defun ld-print-command (keyp form col state)ld-print-command
970,44057
+(defun ld-filter-command (form state)ld-filter-command
992,44638
+(defun-one-output ppr? (x raw-x col channel state)ppr?
1016,45888
+(defun ld-print-results (trans-ans state)ld-print-results
1029,46261
+(defun ld-print-prompt (state)ld-print-prompt
1138,50898
+(defun good-bye-fn (status)good-bye-fn
1154,51485
+(defmacro good-bye (&optional (status '0))good-bye
1160,51613
+(defun ld-return-error (state)ld-return-error
1197,52831
+(defun initialize-accumulated-warnings ()initialize-accumulated-warnings
1205,53087
+(defun ld-read-eval-print (state)ld-read-eval-print
1210,53192
+(defun ld-loop (state)ld-loop
1344,59381
+(defvar *first-entry-to-ld-fn-body-flg*)*first-entry-to-ld-fn-body-flg*
1370,60522
+(defun update-cbd (standard-oi0 state)update-cbd
1372,60564
+(defun ld-fn-body (standard-oi0 new-ld-specials-alist state)ld-fn-body
1407,62178
+(defun ld-fn1 (standard-oi0 alist state bind-flg)ld-fn1
1502,66601
+(defun ld-fn-alist (alist state)ld-fn-alist
1542,68525
+(defmacro with-interrupts (&rest forms)with-interrupts
1574,70027
+(defun ld-fn0 (alist state bind-flg)ld-fn0
1591,70527
+(defun ld-fn (alist state bind-flg)ld-fn
1776,80539
+(defmacro ld (standard-oild
1836,82881
+(defdoc calling-ld-in-bad-contextscalling-ld-in-bad-contexts
2151,100435
+(defmacro quick-test nilquick-test
2190,102313
+(defun wormhole-prompt (channel state)wormhole-prompt
2214,103197
+(defun reset-ld-specials-fn (reset-channels-flg state)reset-ld-specials-fn
2226,103699
+(defmacro reset-ld-specials (reset-channels-flg)reset-ld-specials
2239,104239
+(defun maybe-reset-defaults-table1maybe-reset-defaults-table1
2268,105562
+(defun maybe-reset-defaults-table2maybe-reset-defaults-table2
2306,107198
+(defun maybe-reset-defaults-table (pre-defaults-tbl post-defaults-tbl state)maybe-reset-defaults-table
2315,107544
+(defun delete-something (lst)delete-something
2320,107846
+(defun store-in-kill-ring (x0 ring)store-in-kill-ring
2330,108173
+(defun rotate-kill-ring1 (ring xn)rotate-kill-ring1
2350,109189
+(defun rotate-kill-ring (ring xn)rotate-kill-ring
2355,109356
+(defun ubt-ubu-fn1 (kwd wrld pred-wrld state)ubt-ubu-fn1
2367,109902
+(defun ubt-ubu-fn (kwd cd state)ubt-ubu-fn
2422,112013
+(defun ubt!-ubu!-fn (kwd cd state)ubt!-ubu!-fn
2474,114411
+(defmacro ubt-prehistory ()ubt-prehistory
2491,114868
+(defun ubt-prehistory-fn (state)ubt-prehistory-fn
2504,115317
+(defun oops-warning (state)oops-warning
2540,116912
+(defun oops-fn (state)oops-fn
2554,117482
+(defmacro oops niloops
2581,118793
+(defmacro i-am-here ()i-am-here
2678,123223
+(defun rebuild-fn-read-filter (file state)rebuild-fn-read-filter
2712,124337
+(defun rebuild-fn (file filter filterp dir state)rebuild-fn
2744,125807
+(defmacro rebuild (file &optional (filter 'nil filterp)rebuild
2769,126601
+(defconst *basic-sweep-error-str**basic-sweep-error-str*
2975,137213
+(defun sweep-symbol-binding-for-bad-symbol (sym obj deceased-packages state)sweep-symbol-binding-for-bad-symbol
2982,137587
+(defun sweep-global-lst (l deceased-packages state)sweep-global-lst
3004,138604
+(defun sweep-stack-entry-for-bad-symbol (name i obj deceased-packages state)sweep-stack-entry-for-bad-symbol
3013,138924
+(defun sweep-t-stack (i deceased-packages state)sweep-t-stack
3036,139981
+(defun sweep-acl2-oracle (i deceased-packages state)sweep-acl2-oracle
3044,140295
+(defun sweep-global-state-for-lisp-objects (deceased-packages state)sweep-global-state-for-lisp-objects
3059,140829
+(deflabel compilationcompilation
3105,142523
+(defdoc book-compiled-filebook-compiled-file
3152,144684
+(deflabel escape-to-common-lispescape-to-common-lisp
3244,150360
+(deflabel copyrightcopyright
3259,150792
+(deflabel acknowledgmentsacknowledgments
3287,151795
+(deflabel breaksbreaks
3433,159046
+(deflabel ordinalsordinals
3478,161199
+(defmacro wet (form &rest kwd-args)wet
3620,168216
+(defmacro disassemble$ (fn &rest argsdisassemble$
3802,176740
+(deflabel release-notesrelease-notes
3860,179431
+(deflabel note1note1
3872,179751
+(deflabel note2note2
3893,180380
+(deflabel note3note3
3927,182007
+(deflabel note4note4
4029,187845
+(deflabel note5note5
4190,194885
+(deflabel note6note6
4437,207200
+(deflabel note7note7
4562,212573
+(deflabel note8note8
4761,221308
+(deflabel note8-updatenote8-update
5108,237104
+(deflabel note9note9
5168,239323
+(deflabel note-2-0note-2-0
5249,242380
+(deflabel note-2-1note-2-1
5282,243603
+(deflabel note-2-2note-2-2
5300,243983
+(deflabel note-2-3note-2-3
5362,246869
+(deflabel note-2-4note-2-4
5422,249166
+(deflabel note-2-5note-2-5
5468,250719
+(deflabel |NOTE-2-5(R)||NOTE-2-5
5798,267123
+(deflabel note-2-6note-2-6
5814,267420
+(deflabel note-2-6-new-functionalitynote-2-6-new-functionality
5833,268076
+(deflabel note-2-6-proofsnote-2-6-proofs
6016,277117
+(deflabel note-2-6-rulesnote-2-6-rules
6128,282827
+(deflabel note-2-6-guardsnote-2-6-guards
6199,286189
+(deflabel note-2-6-proof-checkernote-2-6-proof-checker
6267,289225
+(deflabel note-2-6-systemnote-2-6-system
6293,290134
+(deflabel note-2-6-othernote-2-6-other
6340,292302
+(deflabel |NOTE-2-6(R)||NOTE-2-6
6460,297859
+(deflabel note-2-7note-2-7
6476,298186
+(deflabel note-2-7-bug-fixesnote-2-7-bug-fixes
6563,301725
+(deflabel note-2-7-new-functionalitynote-2-7-new-functionality
6850,316186
+(deflabel note-2-7-proofsnote-2-7-proofs
7006,324140
+(deflabel note-2-7-rulesnote-2-7-rules
7108,329615
+(deflabel note-2-7-guardsnote-2-7-guards
7129,330535
+(deflabel note-2-7-proof-checkernote-2-7-proof-checker
7159,331355
+(deflabel note-2-7-systemnote-2-7-system
7170,331638
+(deflabel note-2-7-othernote-2-7-other
7240,334715
+(deflabel |NOTE-2-7(R)||NOTE-2-7
7413,343015
+(deflabel note-2-8note-2-8
7438,343779
+(deflabel note-2-8-bug-fixesnote-2-8-bug-fixes
7601,350774
+(deflabel note-2-8-new-functionalitynote-2-8-new-functionality
8051,371825
+(deflabel note-2-8-proofsnote-2-8-proofs
8197,379974
+(deflabel note-2-8-rulesnote-2-8-rules
8274,384223
+(deflabel note-2-8-guardsnote-2-8-guards
8315,385983
+(deflabel note-2-8-proof-checkernote-2-8-proof-checker
8326,386205
+(deflabel note-2-8-systemnote-2-8-system
8359,387871
+(deflabel note-2-8-ordinalsnote-2-8-ordinals
8388,389155
+(deflabel note-2-8-othernote-2-8-other
8396,389303
+(deflabel |NOTE-2-8(R)||NOTE-2-8
8472,392455
+(deflabel note-2-9note-2-9
8489,392928
+(deflabel |NOTE-2-9(R)||NOTE-2-9
9077,418499
+(deflabel note-2-9-1note-2-9-1
9092,418826
+(deflabel note-2-9-2note-2-9-2
9306,428171
+(deflabel note-2-9-3note-2-9-3
9528,437919
+(deflabel note-2-9-3-ppr-changenote-2-9-3-ppr-change
9760,448491
+(deflabel note-2-9-4note-2-9-4
10038,457022
+(deflabel note-2-9-5note-2-9-5
10421,476341
+(deflabel note-3-0note-3-0
10776,493113
+(deflabel |NOTE-3-0(R)||NOTE-3-0
10803,494131
+(deflabel note-3-0-1note-3-0-1
10818,494434
+(deflabel |NOTE-3-0-1(R)||NOTE-3-0-1
11145,511148
+(deflabel note-3-0-2note-3-0-2
11160,511461
+(deflabel note-3-1note-3-1
11675,533893
+(deflabel |NOTE-3-1(R)||NOTE-3-1
11690,534298
+(deflabel note-3-2note-3-2
11706,534606
+(deflabel |NOTE-3-2(R)||NOTE-3-2
12373,563784
+(deflabel note-3-2-1note-3-2-1
12400,564681
+(deflabel |NOTE-3-2-1(R)||NOTE-3-2-1
12676,578164
+(deflabel note-3-3note-3-3
12689,578362
+(deflabel |NOTE-3-3(R)||NOTE-3-3
13192,601531
+(deflabel note-3-4note-3-4
13205,601725
+(deflabel |NOTE-3-4(R)||NOTE-3-4
13956,637774
+(deflabel note-3-5note-3-5
13976,638347
+(deflabel |NOTE-3-5(R)||NOTE-3-5
14944,684090
+(deflabel note-3-6note-3-6
15022,687059
+(deflabel |NOTE-3-6(R)||NOTE-3-6
15478,706481
+(deflabel note-3-6-1note-3-6-1
15491,706673
+(deflabel note-4-0note-4-0
15540,708588
+(deflabel |NOTE-4-0(R)||NOTE-4-0
16581,756467
+(deflabel note-4-0-wormhole-changesnote-4-0-wormhole-changes
16594,756652
+(deflabel note-4-1note-4-1
16661,759183
+(deflabel |NOTE-4-1(R)||NOTE-4-1
16821,766352
+(deflabel note-4-2note-4-2
16834,766542
+(deflabel |NOTE-4-2(R)||NOTE-4-2
17393,794464
+(deflabel note-4-3note-4-3
17406,794652
+(deflabel |NOTE-4-3(R)||NOTE-4-3
18229,829528
+(deflabel note-5-0note-5-0
18242,829713
+(deflabel note-6-0note-6-0
19471,886571
+(deflabel note-6-1note-6-1
20018,912909
+(deflabel note-6-2note-6-2
20431,931737
+(deflabel note-6-3note-6-3
20932,956015
+(deflabel the-methodthe-method
21360,976638
+(deflabel lplp
21455,981923
+(defun-one-output compiled-function-p! (fn)compiled-function-p!
21523,985513
+(defun compile-function (ctx fn0 state)compile-function
21535,985969
+(defun getpid$ ()getpid$
21597,988226
+(defun-one-output tmp-filename (dir suffix)tmp-filename
21621,989052
+(defun keep-tmp-files (state)keep-tmp-files
21647,990085
+(defun comp-fn (fns gcl-flg tmp-suffix state)comp-fn
21650,990156
+(defmacro comp (fns)comp
21765,994446
+(defmacro comp (fns)comp
21770,994517
+(defmacro comp-gcl (fns)comp-gcl
21880,1000212
+(defun scan-past-deeper-event-landmarks (depth wrld)scan-past-deeper-event-landmarks
21899,1000940
+(defun puffable-encapsulate-p (cddr-car-wrld)puffable-encapsulate-p
21919,1001696
+(defun puffable-command-blockp (wrld cmd-form)puffable-command-blockp
21930,1002110
+(defun puffable-command-numberp (i state)puffable-command-numberp
21964,1003544
+(defun puff-command-block (wrld ans restore-cbd ctx state)puff-command-block
21979,1004084
+(defun commands-back-to (wrld1 wrld2 ans)commands-back-to
22117,1010787
+(defun puffed-command-sequence (cd ctx wrld state)puffed-command-sequence
22132,1011338
+(defun puff-fn1 (cd state)puff-fn1
22155,1012220
+(defun puff-report (caller new-cd1 new-cd2 cd state)puff-report
22246,1016803
+(defun puff-fn (cd state)puff-fn
22259,1017395
+(defun puff*-fn11 (ptr k i j state)puff*-fn11
22263,1017526
+(defun puff*-fn1 (ptr k state)puff*-fn1
22284,1018276
+(defun puff*-fn (cd state)puff*-fn
22312,1019604
+(defmacro puff (cd)puff
22380,1022662
+(defmacro puff* (cd)puff*
22513,1030419
+(defmacro mini-proveall nilmini-proveall
22591,1033484
+(defmacro exit (&optional (status '0))exit
22829,1040695
+(defmacro quit (&optional (status '0))quit
22840,1040889
+(defmacro set-guard-checking (flg)set-guard-checking
22851,1041083
+(defun dmr-stop-fn (state)dmr-stop-fn
23127,1053147
+(defmacro dmr-stop ()dmr-stop
23139,1053642
+(defun dmr-start-fn (state)dmr-start-fn
23143,1053756
+(defmacro dmr-start ()dmr-start
23165,1054675
+(defconst *home-page**home-page*
23169,1054792
+(defconst *home-page-references**home-page-references*
23635,1070572
+(deflabel |Pages Written Especially for the Tours||Pages
23648,1071129
+(deflabel |Undocumented Topic||Undocumented
23671,1072279
+(deflabel |Common Lisp||Common
23677,1072451
+(deflabel |An Example Common Lisp Function Definition||An
23727,1074485
+(deflabel |The Tours||The
23765,1075853
+(deflabel |A Flying Tour of ACL2||A
23808,1077868
+(deflabel |About the ACL2 Home Page||About
23851,1079839
+(deflabel |A Walking Tour of ACL2||A
23881,1081011
+(deflabel |What Is ACL2(Q)||What
23908,1082057
+(deflabel |About Models||About
23935,1082930
+(deflabel |Models in Engineering||Models
23962,1083714
+(deflabel |The Falling Body Model||The
23987,1084315
+(deflabel |Corroborating Models||Corroborating
24009,1085029
+(deflabel |Models of Computer Hardware and Software||Models
24054,1087062
+(deflabel |A Typical State||A
24092,1088060
+(deflabel |Functions for Manipulating these Objects||Functions
24119,1088944
+(deflabel |Common Lisp as a Modeling Language||Common
24152,1090059
+(deflabel |Analyzing Common Lisp Models||Analyzing
24189,1091588
+(deflabel |What is a Mathematical Logic(Q)||What
24229,1093002
+(deflabel |A Trivial Proof||A
24254,1093819
+(deflabel |What is a Mechanical Theorem Prover(Q)||What
24263,1094033
+(deflabel |What is a Mechanical Theorem Prover(Q) (cont)||What
24285,1094841
+(deflabel |ACL2 as an Interactive Theorem Prover||ACL2
24299,1095271
+(deflabel |ACL2 as an Interactive Theorem Prover (cont)||ACL2
24312,1095741
+(deflabel |ACL2 System Architecture||ACL2
24343,1097094
+(deflabel |Modeling in ACL2||Modeling
24368,1098215
+(deflabel |Running Models||Running
24394,1099011
+(deflabel |Symbolic Execution of Models||Symbolic
24426,1100101
+(deflabel |Proving Theorems about Models||Proving
24451,1100719
+(deflabel |What is Required of the User(Q)||What
24488,1102020
+(deflabel |How Long Does It Take to Become an Effective User(Q)||How
24519,1102960
+(deflabel |Other Requirements||Other
24541,1103888
+(deflabel |The End of the Flying Tour||The
24570,1104639
+(deflabel |An Example of ACL2 in Use||An
24587,1104985
+(deflabel |How To Find Out about ACL2 Functions||How
24638,1107204
+(deflabel |How To Find Out about ACL2 Functions (cont)||How
24668,1108368
+(deflabel |The Admission of App||The
24701,1109673
+(deflabel |A Tiny Warning Sign||A
24746,1111096
+(deflabel |Revisiting the Admission of App||Revisiting
24765,1111761
+(deflabel |Evaluating App on Sample Input||Evaluating
24806,1113188
+(deflabel |Conversion||Conversion|
24848,1114164
+(deflabel |The Associativity of App||The
24879,1115624
+(deflabel |The Theorem that App is Associative||The
24921,1117018
+(deflabel |Free Variables in Top-Level Input||Free
24953,1118304
+(deflabel |The Proof of the Associativity of App||The
24997,1120020
+(deflabel |Name the Formula Above||Name
25054,1122924
+(deflabel |Perhaps||Perhaps|
25063,1123189
+(deflabel |Suggested Inductions in the Associativity of App Example||Suggested
25072,1123424
+(deflabel |Subsumption of Induction Candidates in App Example||Subsumption
25095,1124095
+(deflabel |Flawed Induction Candidates in App Example||Flawed
25118,1124809
+(deflabel |The Induction Scheme Selected for the App Example||The
25141,1125467
+(deflabel |The Induction Step in the App Example||The
25162,1126207
+(deflabel |The Base Case in the App Example||The
25191,1127023
+(deflabel |The Justification of the Induction Scheme||The
25212,1127553
+(deflabel |The Instantiation of the Induction Scheme||The
25223,1127903
+(deflabel |Nontautological Subgoals||Nontautological
25236,1128365
+(deflabel |Overview of the Simplification of the Induction Step to T||Overview
25247,1128811
+(deflabel |On the Naming of Subgoals||On
25278,1129956
+(deflabel |Overview of the Expansion of ENDP in the Induction Step||Overview
25290,1130418
+(deflabel |The Expansion of ENDP in the Induction Step (Step 0)||The
25303,1131020
+(deflabel |The Expansion of ENDP in the Induction Step (Step 1)||The
25322,1131640
+(deflabel |The Expansion of ENDP in the Induction Step (Step 2)||The
25342,1132290
+(deflabel |Overview of the Simplification of the Induction Conclusion||Overview
25363,1132894
+(deflabel |The Simplification of the Induction Conclusion (Step 0)||The
25374,1133431
+(deflabel |The Simplification of the Induction Conclusion (Step 1)||The
25392,1134016
+(deflabel |The Simplification of the Induction Conclusion (Step 2)||The
25418,1135080
+(deflabel |The Simplification of the Induction Conclusion (Step 3)||The
25439,1135771
+(deflabel |The Simplification of the Induction Conclusion (Step 4)||The
25458,1136402
+(deflabel |The Simplification of the Induction Conclusion (Step 5)||The
25480,1137232
+(deflabel |The Simplification of the Induction Conclusion (Step 6)||The
25502,1138007
+(deflabel |The Simplification of the Induction Conclusion (Step 7)||The
25524,1138753
+(deflabel |The Simplification of the Induction Conclusion (Step 8)||The
25546,1139472
+(deflabel |The Simplification of the Induction Conclusion (Step 9)||The
25568,1140285
+(deflabel |The Simplification of the Induction Conclusion (Step 10)||The
25592,1141158
+(deflabel |The Simplification of the Induction Conclusion (Step 11)||The
25612,1141860
+(deflabel |The Simplification of the Induction Conclusion (Step 12)||The
25631,1142493
+(deflabel |Overview of the Simplification of the Base Case to T||Overview
25651,1143033
+(deflabel |Overview of the Expansion of ENDP in the Base Case||Overview
25679,1143874
+(deflabel |Overview of the Final Simplification in the Base Case||Overview
25688,1144267
+(deflabel |The Final Simplification in the Base Case (Step 0)||The
25698,1144632
+(deflabel |The Final Simplification in the Base Case (Step 1)||The
25716,1145236
+(deflabel |The Final Simplification in the Base Case (Step 2)||The
25733,1145775
+(deflabel |The Final Simplification in the Base Case (Step 3)||The
25749,1146231
+(deflabel |The End of the Proof of the Associativity of App||The
25768,1146772
+(deflabel |Popping out of an Inductive Proof||Popping
25798,1147656
+(deflabel |The Q.E.D. Message||The
25808,1148036
+(deflabel |The Rules used in the Associativity of App Proof||The
25817,1148319
+(deflabel |The Time Taken to do the Associativity of App Proof||The
25832,1149062
+(deflabel |Guiding the ACL2 Theorem Prover||Guiding
25848,1149753
+(deflabel |Rewrite Rules are Generated from DEFTHM Events||Rewrite
25875,1150736
+(deflabel |You Must Think about the Use of a Formula as a Rule||You
25909,1151695
+(deflabel |Using the Associativity of App to Prove a Trivial Consequence||Using
25939,1152703
+(deflabel |Overview of the Proof of a Trivial Consequence||Overview
25959,1153339
+(deflabel |The WARNING about the Trivial Consequence||The
26010,1155014
+(deflabel |The First Application of the Associativity Rule||The
26031,1155899
+(deflabel |A Sketch of How the Rewriter Works||A
26050,1156603
+(deflabel |The Summary of the Proof of the Trivial Consequence||The
26084,1157842
+(deflabel |The End of the Walking Tour||The
26096,1158218
+(deflabel |ACL2 is an Untyped Language||ACL2
26129,1159307
+(deflabel |Hey Wait!  Is ACL2 Typed or Untyped(Q)||Hey
26156,1160433
+(deflabel |Guards||Guards|
26181,1161383
+(deflabel |About the Prompt||About
26218,1163118
+(deflabel |The Event Summary||The
26286,1166841
+(deflabel |About the Admission of Recursive Definitions||About
26333,1169155
+(deflabel |About Types||About
26364,1170801
+(deflabel |Numbers in ACL2||Numbers
26409,1173169
+(deflabel |ACL2 Characters||ACL2
26464,1175470
+(deflabel |ACL2 Strings||ACL2
26483,1176295
+(deflabel |ACL2 Symbols||ACL2
26501,1177143
+(deflabel |ACL2 Conses or Ordered Pairs||ACL2
26546,1179817
+(deflabel |Guessing the Type of a Newly Admitted Function||Guessing
26579,1181328
+(defconst *meta-level-function-problem-1**meta-level-function-problem-1*
26624,1183297
+(defconst *meta-level-function-problem-1a**meta-level-function-problem-1a*
26628,1183496
+(defconst *meta-level-function-problem-1b**meta-level-function-problem-1b*
26632,1183706
+(defconst *meta-level-function-problem-1c**meta-level-function-problem-1c*
26637,1183933
+(defconst *meta-level-function-problem-1d**meta-level-function-problem-1d*
26643,1184262
+(defconst *meta-level-function-problem-1e**meta-level-function-problem-1e*
26650,1184623
+(defconst *meta-level-function-problem-2**meta-level-function-problem-2*
26656,1184941
+(defconst *meta-level-function-problem-3**meta-level-function-problem-3*
26663,1185295
+(defun acl2-magic-mfc (x)acl2-magic-mfc
26683,1186488
+(defun mfc-ts-raw (term mfc state forcep)mfc-ts-raw
26737,1188382
+(defun mfc-rw-raw (term alist obj equiv-info mfc fn state forcep)mfc-rw-raw
26819,1192020
+(defun mfc-relieve-hyp-raw (hyp alist rune target bkptr mfc statemfc-relieve-hyp-raw
26901,1196236
+(defun-one-output mfc-ap-raw (term mfc state forcep)mfc-ap-raw
27009,1201804
+(defmacro mfc-ts (term mfc st &keymfc-ts
27115,1208000
+(defmacro mfc-rw (term obj equiv-info mfc st &keymfc-rw
27124,1208321
+(defmacro mfc-rw+ (term alist obj equiv-info mfc st &keymfc-rw+
27142,1209163
+(defmacro mfc-relieve-hyp (hyp alist rune target bkptr mfc st &keymfc-relieve-hyp
27151,1209558
+(defmacro mfc-ap (term mfc st &keymfc-ap
27162,1210054
+(defun congruence-rule-listp (x wrld)congruence-rule-listp
27167,1210230
+(defun term-alistp-failure-msg (alist wrld)term-alistp-failure-msg
27180,1210694
+(defun find-runed-linear-lemma (rune lst)find-runed-linear-lemma
27197,1211396
+(defun mfc-force-flg (forcep mfc)mfc-force-flg
27208,1211740
+(defun update-rncst-for-forcep (forcep rcnst)update-rncst-for-forcep
27213,1211888
+(defun trans-eval-lst (lst ctx state aok)trans-eval-lst
27263,1214035
+(defun print-saved-output (inhibit-output-lst gag-mode state)print-saved-output
27269,1214251
+(defmacro pso ()pso
27312,1216125
+(defmacro psog ()psog
27327,1216600
+(defmacro pso! ()pso!
27341,1216985
+(defdoc nil-goalnil-goal
27356,1217470
+(defmacro set-saved-output (save-flg inhibit-flg)set-saved-output
27395,1219747
+(defmacro set-raw-proof-format (flg)set-raw-proof-format
27500,1225510
+(defmacro set-print-clause-ids (flg)set-print-clause-ids
27527,1226577
+(defun set-standard-co-state (val state)set-standard-co-state
27575,1228604
+(defun set-proofs-co-state (val state)set-proofs-co-state
27584,1228939
+(defmacro with-standard-co-and-proofs-co-to-file (filename form)with-standard-co-and-proofs-co-to-file
27593,1229268
+(defmacro wof (filename form) ; Acronym: With Output Filewof
27617,1230135
+(defmacro psof (filename)psof
27643,1230997
+(defun set-gag-mode-fn (action state)set-gag-mode-fn
27678,1232702
+(defmacro set-gag-mode (action)set-gag-mode
27709,1233834
+(defparameter *initial-cbd* nil)*initial-cbd*
27819,1239233
+(defvar *return-from-lp* nil)*return-from-lp*
27822,1239284
+(defun save-exec-fn (exec-filename extra-startup-string host-lisp-argssave-exec-fn
27824,1239315
+(defmacro save-exec (exec-filename extra-startup-stringsave-exec
27886,1241827
+(defdoc command-linecommand-line
28164,1254612
+(deflabel about-acl2about-acl2
28179,1255078
+(defun defun-for-state-name (name)defun-for-state-name
28206,1255897
+(defmacro defun-for-state (name args)defun-for-state
28211,1256027
+(defun set-ld-evisc-tuple (val state)set-ld-evisc-tuple
28221,1256353
+(defun-for-state set-ld-evisc-tuple (val state))set-ld-evisc-tuple
28226,1256480
+(defun set-abbrev-evisc-tuple (val state)set-abbrev-evisc-tuple
28228,1256530
+(defun-for-state set-abbrev-evisc-tuple (val state))set-abbrev-evisc-tuple
28233,1256665
+(defun set-gag-mode-evisc-tuple (val state)set-gag-mode-evisc-tuple
28235,1256719
+(defun-for-state set-gag-mode-evisc-tuple (val state))set-gag-mode-evisc-tuple
28240,1256858
+(defun set-term-evisc-tuple (val state)set-term-evisc-tuple
28242,1256914
+(defun-for-state set-term-evisc-tuple (val state))set-term-evisc-tuple
28247,1257045
+(defun without-evisc-fn (form state)without-evisc-fn
28249,1257097
+(defmacro without-evisc (form)without-evisc
28260,1257500
+
+proof-checker-b.lisp,18559
+(defmacro install-new-pc-meta-or-macro (command-type raw-name name formals doc body)install-new-pc-meta-or-macro
23,881
+(defun define-pc-meta-or-macro-fn (command-type raw-name formals body)define-pc-meta-or-macro-fn
27,1084
+(defmacro define-pc-meta (raw-name formals &rest body)define-pc-meta
41,1553
+(defmacro define-pc-macro (raw-name formals &rest body)define-pc-macro
56,2123
+(defmacro define-pc-atomic-macro (raw-name formals &rest body)define-pc-atomic-macro
95,3725
+(defmacro toggle-pc-macro (name &optional new-tp)toggle-pc-macro
98,3857
+(defmacro define-pc-primitive (raw-name formals &rest body)define-pc-primitive
126,4867
+(define-pc-primitive comment (&rest x)comment
150,5925
+(defun non-bounded-nums (nums lower upper)non-bounded-nums
169,6340
+(defun delete-by-position (lst current-index nums)delete-by-position
182,6807
+(define-pc-primitive drop (&rest nums)drop
192,7191
+(define-pc-meta lisp (form)lisp
232,8583
+(define-pc-primitive fail-primitive ()fail-primitive
296,11125
+(define-pc-macro fail (&optional hard)fail
300,11213
+(define-pc-macro illegal (instr)illegal
322,11807
+(defun chk-assumption-free-ttree-1 (ttree ctx)chk-assumption-free-ttree-1
344,12485
+(defun put-cdr-assoc-query-id (id val alist)put-cdr-assoc-query-id
358,12997
+(defun set-query-val (id val state)set-query-val
364,13251
+(defmacro query-on-exit (&optional (val 'toggle))query-on-exit
377,13662
+(defun replay-query (state)replay-query
380,13760
+(define-pc-meta exit (&optional event-name rule-classes do-it-flg)exit
393,14482
+(define-pc-meta undo (&optional n)undo
559,23291
+(define-pc-meta restore ()restore
613,25261
+(defun print-commands (indexed-instrs state)print-commands
644,26364
+(defun make-pretty-start-instr (state-stack)make-pretty-start-instr
659,26962
+(defun raw-indexed-instrs (start-index finish-index state-stack)raw-indexed-instrs
669,27320
+(define-pc-macro sequence-no-restore (instr-list)sequence-no-restore
686,28305
+(define-pc-macro skip ()skip
689,28409
+(defmacro define-pc-help (name args &rest body)define-pc-help
702,28655
+(defun evisc-indexed-instrs-1 (name rev-indexed-instrs)evisc-indexed-instrs-1
737,29996
+(defun evisc-indexed-instrs-rec (rev-indexed-instrs)evisc-indexed-instrs-rec
749,30539
+(defun mark-unfinished-instrs (indexed-instrs)mark-unfinished-instrs
769,31512
+(defun evisc-indexed-instrs (indexed-instrs)evisc-indexed-instrs
785,32308
+(define-pc-help commands (&optional n evisc-p)commands
791,32576
+(define-pc-macro comm (&optional n)comm
833,34213
+(defun promote-guts (pc-state goals hyps x y no-flatten-flg)promote-guts
889,36529
+(define-pc-primitive promote (&optional do-not-flatten-flag)promote
901,36905
+(defun remove-by-indices (m indices lst)remove-by-indices
940,38603
+(define-pc-macro print (form &optional without-evisc)print
952,39169
+(defun bounded-integer-listp (i j lst)bounded-integer-listp
984,40410
+(defun fetch-term-and-cl (term addr cl)fetch-term-and-cl
997,40825
+(defun fetch-term (term addr)fetch-term
1039,42965
+(defun governors (term addr)governors
1049,43292
+(defun term-id-iff (term address iff-flg)term-id-iff
1057,43584
+(defmacro ? (x)?
1105,45860
+(defstub ?-fn (x)?-fn
1108,45892
+(defun abbreviations-alist (abbreviations)abbreviations-alist
1115,46102
+(defun chk-?s (term ctx state)chk-?s
1124,46365
+(defun chk-?s-lst (term-lst ctx state)chk-?s-lst
1145,47243
+(defun remove-?s (term abbreviations-alist ctx state)remove-?s
1153,47432
+(defun translate-abb (x abbreviations ctx state)translate-abb
1158,47619
+(defmacro trans0 (x &optional abbreviations ctx)trans0
1171,47950
+(defun p-body (conc current-addr abbreviations state)p-body
1174,48063
+(define-pc-help p ()p
1182,48415
+(define-pc-help pp ()pp
1205,49111
+(defun take-by-indices (m indices lst)take-by-indices
1224,49633
+(defun print-hyps (indexed-hyps ndigits abbreviations state)print-hyps
1233,50002
+(defun some-> (lst n)some->
1246,50629
+(defun print-hyps-top (indexed-hyps abbreviations state)print-hyps-top
1255,50876
+(defun print-governors-top (indexed-hyps abbreviations state)print-governors-top
1264,51241
+(defun pair-indices (seed indices lst)pair-indices
1273,51600
+(define-pc-macro hyps (&optional hyps-indices govs-indices)hyps
1289,52268
+(define-pc-primitive demote (&rest rest-args)demote
1407,57646
+(defun pair-keywords (keywords lst)pair-keywords
1463,59949
+(defun null-pool (pool)null-pool
1478,60586
+(defun initial-pspv (term displayed-goal otf-flg ens wrld splitter-output)initial-pspv
1485,60753
+(defun pc-prove (term displayed-goal hints otf-flg ens wrld ctx state)pc-prove
1493,61070
+(defun sublis-equal (alist tree)sublis-equal
1516,62109
+(defun abbreviations-alist-? (abbreviations)abbreviations-alist-?
1526,62392
+(defun find-?-fn (x)find-?-fn
1536,62795
+(defun unproved-pc-prove-clauses (ttree)unproved-pc-prove-clauses
1546,63103
+(defun prover-call (comm term-to-prove rest-args pc-state state)prover-call
1549,63201
+(defun make-new-goals (cl-set goal-name start-index)make-new-goals
1622,67505
+(defun same-goal (goal1 goal2)same-goal
1634,68017
+(defun remove-byes-from-tag-tree (ttree)remove-byes-from-tag-tree
1640,68213
+(define-pc-primitive prove (&rest rest-args)prove
1643,68296
+(defun add-string-val-pair-to-string-val-alist (key key1 val alist)add-string-val-pair-to-string-val-alist
1725,71674
+(defconst *bash-skip-forcing-round-hints**bash-skip-forcing-round-hints*
1743,72475
+(define-pc-atomic-macro bash (&rest hints)bash
1761,72985
+(define-pc-primitive dive (n &rest rest-addr)dive
1813,75035
+(define-pc-atomic-macro split ()split
1874,77464
+(define-pc-primitive add-abbreviation (var &optional raw-term)add-abbreviation
1916,79190
+(defun not-in-domain-eq (lst alist)not-in-domain-eq
1982,82213
+(define-pc-primitive remove-abbreviations (&rest vars)remove-abbreviations
1993,82579
+(defun print-abbreviations (vars abbreviations state)print-abbreviations
2035,84310
+(define-pc-help show-abbreviations (&rest vars)show-abbreviations
2079,85994
+(defun drop-from-end (n l)drop-from-end
2114,87347
+(define-pc-primitive up (&optional n)up
2121,87587
+(define-pc-atomic-macro top ()top
2161,89346
+(defmacro expand-address-recurseexpand-address-recurse
2181,90062
+(defmacro dive-once-more-error ()dive-once-more-error
2196,90613
+(defun abbreviation-raw-term-p (x)abbreviation-raw-term-p
2203,90886
+(defmacro addr-recur (pos b)addr-recur
2207,90964
+(defun or-addr (n term iff-flg)or-addr
2222,91485
+(defun and-addr (n term iff-flg)and-addr
2272,93359
+(defmacro add-dive-into-macro (name val)add-dive-into-macro
2330,95812
+(defmacro remove-dive-into-macro (name)remove-dive-into-macro
2345,96283
+(defun dive-into-macros-table (wrld)dive-into-macros-table
2361,96847
+(defun rassoc-eq-as-car (key alist)rassoc-eq-as-car
2405,98665
+(defun expand-address (addr raw-term term abbreviations iff-flgexpand-address
2411,98842
+(defmacro dv-error (str alist)dv-error
2773,116784
+(define-pc-atomic-macro dv (&rest rest-args)dv
2783,117128
+(defun deposit-term (term addr subterm)deposit-term
2880,120369
+(defun deposit-term-lst (lst n addr subterm)deposit-term-lst
2890,120722
+(defun geneqv-at-subterm (term addr geneqv ens wrld)geneqv-at-subterm
2908,121437
+(defun geneqv-at-subterm-top (term addr ens wrld)geneqv-at-subterm-top
2927,122208
+(defun maybe-truncate-current-address (addr term orig-addr acc state)maybe-truncate-current-address
2970,124020
+(defun deposit-term-in-goal (given-goal conc current-addr new-term state)deposit-term-in-goal
2998,125249
+(defun split-implies (term)split-implies
3017,126012
+(defun equiv-refinementp (equiv1 equiv2 wrld)equiv-refinementp
3030,126475
+(defun find-equivalence-hyp-term (term hyps target equiv w)find-equivalence-hyp-term
3034,126616
+(defun flatten-ands-in-lit-lst (x)flatten-ands-in-lit-lst
3055,127504
+(define-pc-primitive equiv (x y &optional equiv)equiv
3061,127656
+(define-pc-primitive casesplitcasesplit
3173,133057
+(define-pc-macro top? ()top?
3270,137522
+(define-pc-macro contrapose-last ()contrapose-last
3276,137633
+(define-pc-macro drop-last ()drop-last
3284,137906
+(define-pc-macro drop-conc ()drop-conc
3292,138161
+(define-pc-atomic-macro claim (expr &rest rest-args)claim
3295,138247
+(define-pc-atomic-macro induct (&optional raw-term)induct
3362,141231
+(defun print-on-separate-lines (vals evisc-tuple chan state)print-on-separate-lines
3401,142694
+(define-pc-help goals ()goals
3411,143107
+(defun modified-error-triple-for-sequence (erp val success-expr state)modified-error-triple-for-sequence
3430,143660
+(define-pc-meta sequencesequence
3467,145520
+(define-pc-macro negate (&rest instr-list)negate
3593,152166
+(define-pc-macro succeed (&rest instr-list)succeed
3615,152831
+(define-pc-macro do-all (&rest instr-list)do-all
3637,153453
+(define-pc-macro do-strict (&rest instr-list)do-strict
3664,154400
+(define-pc-macro do-all-no-prompt (&rest instr-list)do-all-no-prompt
3682,154937
+(define-pc-macro th (&optional hyps-indices govs-indices)th
3700,155510
+(define-pc-macro protect (&rest instr-list)protect
3732,156745
+(defun extract-goal (name goals)extract-goal
3751,157347
+(define-pc-primitive change-goal (&optional name end-flg)change-goal
3761,157726
+(define-pc-macro cg (&optional name)cg
3814,159975
+(defun change-by-position (lst index new)change-by-position
3830,160384
+(define-pc-primitive contrapose (&optional n)contrapose
3840,160748
+(define-pc-macro contradict (&optional n)contradict
3880,162542
+(define-pc-atomic-macro pro ()pro
3889,162717
+(define-pc-atomic-macro nx ()nx
3904,163092
+(define-pc-atomic-macro bk ()bk
3929,163945
+(define-pc-help p-top ()p-top
3960,165036
+(define-pc-macro repeat (instr)repeat
3998,166603
+(define-pc-macro repeat-rec (instr)repeat-rec
4016,167077
+(defmacro define-pc-bind (name args &optional doc-string declare-form)define-pc-bind
4024,167237
+(define-pc-bind quietquiet
4041,167943
+(define-pc-bind noise (inhibit-output-lst nil)noise
4059,168351
+(defun find-equivalence-hyp-term-no-target (index term hyps equiv w)find-equivalence-hyp-term-no-target
4078,168995
+(define-pc-atomic-macro if-not-proved (goal-name cmd)if-not-proved
4104,170259
+(define-pc-atomic-macro = (&optional x y &rest rest-args)=
4123,170948
+(define-pc-macro set-success (instr form)set-success
4325,180982
+(define-pc-macro orelse (instr1 instr2)orelse
4328,181071
+(defun applicable-rewrite-rules (current-term conc current-addr target-name-or-runeapplicable-rewrite-rules
4348,181666
+(define-pc-help show-rewrites (&optional rule-id enabled-only-flg)show-rewrites
4367,182631
+(define-pc-macro sr (&rest args)sr
4411,184734
+(define-pc-help show-linears (&optional rule-id enabled-only-flg)show-linears
4426,185025
+(define-pc-macro sls (&rest args)sls
4457,186256
+(define-pc-macro pl (&optional x)pl
4474,186748
+(define-pc-macro pr (&optional x)pr
4508,188003
+(define-pc-help show-type-prescriptions (&optional rule-id)show-type-prescriptions
4542,189258
+(define-pc-macro st (&rest args)st
4569,190347
+(defun translate-subst-abb1 (sub abbreviations state)translate-subst-abb1
4584,190661
+(defun single-valued-symbolp-alistp (alist)single-valued-symbolp-alistp
4607,191795
+(defun check-cars-are-variables (alist state)check-cars-are-variables
4614,192017
+(defun translate-subst-abb (sub abbreviations state)translate-subst-abb
4633,192795
+(defun make-rewrite-instr (lemma-id raw-subst instantiate-free)make-rewrite-instr
4664,194079
+(define-pc-primitive rewrite (&optional rule-id raw-sub instantiate-free)rewrite
4671,194343
+(defun applicable-linear-rules (current-term target-name-or-runeapplicable-linear-rules
4926,207783
+(defun make-linear-instr (lemma-id raw-subst instantiate-free)make-linear-instr
4940,208358
+(define-pc-primitive apply-linear (&optional rule-id raw-sub instantiate-free)apply-linear
4947,208620
+(define-pc-macro al (&rest args)al
5192,221245
+(defun pc-help-fn (name state)pc-help-fn
5205,221478
+(defmacro state-only (triple)state-only
5251,223676
+(define-pc-help help (&optional instr)help
5257,223810
+(defun pc-help!-fn (name state)pc-help!-fn
5322,226487
+(define-pc-help help! (&optional instr)help!
5364,228405
+(define-pc-macro help-long (&rest args)help-long
5378,228907
+(define-pc-help more ()more
5389,229175
+(define-pc-help more! ()more!
5401,229432
+(defun pc-rewrite*-1pc-rewrite*-1
5412,229744
+(defun pc-rewrite*pc-rewrite*
5456,231824
+(defun make-goals-from-assumptions (assumptions conc hyps current-addr goal-name start-index)make-goals-from-assumptions
5470,232371
+(defun make-new-goals-from-assumptions (assumptions goal)make-new-goals-from-assumptions
5483,232947
+(defconst *default-s-repeat-limit* 10)*default-s-repeat-limit*
5493,233268
+(define-pc-primitive s (&rest args)s
5495,233308
+(defun build-pc-enabled-structure-from-ens (new-suffix ens)build-pc-enabled-structure-from-ens
5752,245516
+(define-pc-primitive in-theory (&optional theory-expr)in-theory
5779,246775
+(define-pc-atomic-macro s-prop (&rest names)s-prop
5871,250920
+(define-pc-atomic-macro x (&rest args)x
5894,251679
+(define-pc-primitive expand (&optionalexpand
5953,254002
+(define-pc-atomic-macro x-dumb ()x-dumb
6050,257694
+(define-pc-macro bookmark (tag &rest instr-list)bookmark
6065,258106
+(defun change-last (lst val)change-last
6086,258832
+(defun assign-event-name-and-rule-classes (event-name rule-classes state)assign-event-name-and-rule-classes
6094,259009
+(defun save-fn (name ss-alist state)save-fn
6110,259809
+(define-pc-macro save (&optional name do-it-flg)save
6119,260041
+(defmacro retrieve (&optional name)retrieve
6167,262114
+(define-pc-macro retrieve ()retrieve
6185,262518
+(defun unsave-fn (name state)unsave-fn
6211,263543
+(defmacro unsave (name)unsave
6215,263645
+(define-pc-help unsave (&optional name)unsave
6233,264017
+(defun show-retrieved-goal (state-stack state)show-retrieved-goal
6267,265407
+(defun retrieve-fn (name state)retrieve-fn
6277,265804
+(defun print-all-goals (goals state)print-all-goals
6322,267789
+(define-pc-help print-all-goals ()print-all-goals
6328,267949
+(defmacro print-conc (&optional acl2::goal)print-conc
6340,268248
+(defun print-all-concs (goals state)print-all-concs
6352,268729
+(define-pc-help print-all-concs ()print-all-concs
6359,268935
+(defun gen-var-marker (x)gen-var-marker
6372,269272
+(defun translate-generalize-alist-1 (alist state-vars abbreviations state)translate-generalize-alist-1
6377,269361
+(defun non-gen-var-markers (alist)non-gen-var-markers
6432,271446
+(defun find-duplicate-generalize-entries (alist var)find-duplicate-generalize-entries
6441,271734
+(defun translate-generalize-alist-2 (alist avoid-list)translate-generalize-alist-2
6450,272047
+(defun translate-generalize-alist (alist state-vars abbreviations state)translate-generalize-alist
6461,272514
+(defun all-vars-goals (goals)all-vars-goals
6479,273437
+(defun pc-state-vars (pc-state)pc-state-vars
6486,273692
+(define-pc-primitive generalize (&rest args)generalize
6490,273877
+(define-pc-atomic-macro use (&rest args)use
6557,276728
+(define-pc-atomic-macro clause-processor (&rest cl-proc-hints)clause-processor
6585,277679
+(define-pc-macro cl-proc (&rest cl-proc-hints)cl-proc
6615,278640
+(defun fromto (i j)fromto
6624,278893
+(define-pc-atomic-macro retain (arg1 &rest rest-args)retain
6630,279032
+(define-pc-atomic-macro reduce (&rest hints)reduce
6664,280162
+(define-pc-macro run-instr-on-goal (instr goal-name)run-instr-on-goal
6708,281810
+(defun run-instr-on-goals-guts (instr goal-names)run-instr-on-goals-guts
6719,282066
+(define-pc-macro run-instr-on-new-goals (instr existing-goal-namesrun-instr-on-new-goals
6726,282315
+(define-pc-macro then (instr &optional completion must-succeed-flg)then
6739,282782
+(defun print-help-separator (state)print-help-separator
6764,283628
+(defun print-pc-help-rec (lst state)print-pc-help-rec
6769,283760
+(defun print-all-pc-help-fn (filename state)print-all-pc-help-fn
6781,284065
+(defmacro print-all-pc-help (&optional filename)print-all-pc-help
6797,284748
+(define-pc-macro nil ()nil
6800,284860
+(define-pc-atomic-macro free (var)free
6828,285895
+(define-pc-macro replay (&optional n replacement-instr)replay
6851,286563
+(defun instr-name (instr)instr-name
6895,288488
+(defun pc-free-instr-p (var pc-state)pc-free-instr-p
6901,288624
+(defun find-possible-put (var state-stack)find-possible-put
6906,288793
+(define-pc-macro put (var expr)put
6918,289279
+(define-pc-macro reduce-by-induction (&rest hints)reduce-by-induction
6960,291093
+(define-pc-macro r (&rest args)r
7002,292689
+(define-pc-atomic-macro sl (&optional backchain-limit)sl
7014,292897
+(define-pc-atomic-macro elim ()elim
7046,294168
+(define-pc-macro ex ()ex
7065,294812
+(defun save-fc-report-settings ()save-fc-report-settings
7080,295131
+(defun restore-fc-report-settings ()restore-fc-report-settings
7095,295617
+(define-pc-help type-alist (&optional concl-flg govs-flg fc-report-flg)type-alist
7110,296130
+(define-pc-help print-main ()print-main
7213,300868
+(define-pc-macro pso ()pso
7225,301106
+(define-pc-macro psog ()psog
7245,301815
+(define-pc-macro pso! ()pso!
7266,302552
+(define-pc-macro acl2-wrap (x)acl2-wrap
7287,303301
+(defmacro acl2-wrap (x)acl2-wrap
7303,303664
+(define-pc-macro check-proved-goal (goal-name cmd)check-proved-goal
7310,303814
+(define-pc-macro check-proved (x)check-proved
7318,304063
+(define-pc-atomic-macro forwardchain (hypn &optional hints quiet-flg)forwardchain
7326,304244
+(define-pc-atomic-macro bdd (&rest kw-listp)bdd
7410,307443
+(define-pc-macro runes (&optional flg)runes
7434,308269
+(define-pc-macro lemmas-used (&optional flg)lemmas-used
7455,309079
+(defun goal-terms (goals)goal-terms
7463,309250
+(defun wrap1-aux1 (kept-goal-names all-goals kept-goals removed-goals)wrap1-aux1
7474,309551
+(defun wrap1-aux2 (sym index goals kept-goals removed-goals)wrap1-aux2
7495,310449
+(define-pc-primitive wrap1 (&optional kept-goal-names)wrap1
7510,311050
+(define-pc-atomic-macro wrap (&rest instrs)wrap
7589,314364
+(define-pc-atomic-macro wrap-induct (&optional raw-term)wrap-induct
7635,316321
+(define-pc-macro finish-error (instrs)finish-error
7667,317238
+(define-pc-macro finish (&rest instrs)finish
7672,317390
+(defun show-geneqv (x with-runes-p)show-geneqv
7693,318116
+(define-pc-macro geneqv (&optional with-runes-p)geneqv
7701,318460
+(defun goals-to-clause-list (goals)goals-to-clause-list
7735,320169
+(defun proof-checker-clause-list (state)proof-checker-clause-list
7742,320413
+(defun proof-checker-cl-proc (cl instr-list state)proof-checker-cl-proc
7745,320489
+
+tutorial.lisp,6702
+(deflabel ACL2-TutorialACL2-Tutorial
45,1562
+(deflabel alternative-introductionalternative-introduction
111,4534
+(deflabel annotated-acl2-scriptsannotated-acl2-scripts
743,34484
+(deflabel EmacsEmacs
811,37396
+(deflabel ACL2-As-Standalone-ProgramACL2-As-Standalone-Program
825,37884
+(deflabel acl2-sedanacl2-sedan
931,40895
+(deflabel solution-to-simple-examplesolution-to-simple-example
953,41995
+(deflabel Tutorial1-Towers-of-HanoiTutorial1-Towers-of-Hanoi
1009,43994
+(deflabel Tutorial2-Eights-ProblemTutorial2-Eights-Problem
1267,53213
+(deflabel Tutorial3-Phonebook-ExampleTutorial3-Phonebook-Example
1396,57390
+(deflabel Tutorial4-Defun-Sk-ExampleTutorial4-Defun-Sk-Example
2222,89653
+(deflabel Tutorial5-Miscellaneous-ExamplesTutorial5-Miscellaneous-Examples
2323,93583
+(deflabel file-reading-examplefile-reading-example
2333,93863
+(deflabel guard-exampleguard-example
2389,96296
+(deflabel mutual-recursion-proof-examplemutual-recursion-proof-example
2699,105463
+(deflabel functional-instantiation-examplefunctional-instantiation-example
2847,111874
+(deflabel StartupStartup
2992,116767
+(deflabel TidbitsTidbits
3077,119678
+(deflabel TipsTips
3161,123245
+(deflabel introduction-to-the-theorem-proverintroduction-to-the-theorem-prover
3623,144891
+(deflabel dealing-with-key-combinations-of-function-symbolsdealing-with-key-combinations-of-function-symbols
3956,161981
+(deflabel post-induction-key-checkpointspost-induction-key-checkpoints
4138,169870
+(deflabel generalizing-key-checkpointsgeneralizing-key-checkpoints
4187,172146
+(deflabel strong-rewrite-rulesstrong-rewrite-rules
4282,176102
+(deflabel practice-formulating-strong-rulespractice-formulating-strong-rules
4376,180112
+(deflabel practice-formulating-strong-rules-1practice-formulating-strong-rules-1
4440,181923
+(deflabel practice-formulating-strong-rules-2practice-formulating-strong-rules-2
4537,186248
+(deflabel practice-formulating-strong-rules-3practice-formulating-strong-rules-3
4593,188283
+(deflabel practice-formulating-strong-rules-4practice-formulating-strong-rules-4
4720,193178
+(deflabel practice-formulating-strong-rules-5practice-formulating-strong-rules-5
4760,194435
+(deflabel practice-formulating-strong-rules-6practice-formulating-strong-rules-6
4822,196882
+(deflabel introduction-to-key-checkpointsintroduction-to-key-checkpoints
4930,200841
+(deflabel programming-knowledge-taken-for-grantedprogramming-knowledge-taken-for-granted
5090,210271
+(deflabel example-induction-scheme-nat-recursionexample-induction-scheme-nat-recursion
5381,224313
+(deflabel example-induction-scheme-down-by-2example-induction-scheme-down-by-2
5434,225940
+(deflabel example-induction-scheme-on-listsexample-induction-scheme-on-lists
5492,227619
+(deflabel example-induction-scheme-binary-treesexample-induction-scheme-binary-trees
5539,228976
+(deflabel example-induction-scheme-on-several-variablesexample-induction-scheme-on-several-variables
5581,230012
+(deflabel example-induction-scheme-upwardsexample-induction-scheme-upwards
5627,231015
+(deflabel example-induction-scheme-with-accumulatorsexample-induction-scheme-with-accumulators
5678,232541
+(deflabel example-induction-scheme-with-multiple-induction-stepsexample-induction-scheme-with-multiple-induction-steps
5761,235396
+(deflabel example-inductionsexample-inductions
5825,237168
+(deflabel logic-knowledge-taken-for-granted-inductive-prooflogic-knowledge-taken-for-granted-inductive-proof
5884,240002
+(deflabel logic-knowledge-taken-for-granted-base-caselogic-knowledge-taken-for-granted-base-case
6034,247688
+(deflabel logic-knowledge-taken-for-granted-q1-answerlogic-knowledge-taken-for-granted-q1-answer
6061,248537
+(deflabel logic-knowledge-taken-for-granted-q2-answerlogic-knowledge-taken-for-granted-q2-answer
6147,252562
+(deflabel logic-knowledge-taken-for-granted-q3-answerlogic-knowledge-taken-for-granted-q3-answer
6291,257210
+(deflabel logic-knowledge-taken-for-granted-instancelogic-knowledge-taken-for-granted-instance
6332,258424
+(deflabel logic-knowledge-taken-for-granted-propositional-calculuslogic-knowledge-taken-for-granted-propositional-calculus
6372,259772
+(deflabel logic-knowledge-taken-for-granted-rewritinglogic-knowledge-taken-for-granted-rewriting
6620,269105
+(deflabel logic-knowledge-taken-for-granted-rewriting-repeatedlylogic-knowledge-taken-for-granted-rewriting-repeatedly
6859,279159
+(deflabel logic-knowledge-taken-for-granted-equals-for-equalslogic-knowledge-taken-for-granted-equals-for-equals
6953,282607
+(deflabel logic-knowledge-taken-for-granted-evaluationlogic-knowledge-taken-for-granted-evaluation
7004,284514
+(deflabel logic-knowledge-taken-for-grantedlogic-knowledge-taken-for-granted
7042,285898
+(deflabel special-cases-for-rewrite-rulesspecial-cases-for-rewrite-rules
7258,294498
+(deflabel equivalent-formulas-different-rewrite-rulesequivalent-formulas-different-rewrite-rules
7312,296858
+(deflabel introduction-to-rewrite-rules-part-2introduction-to-rewrite-rules-part-2
7385,299806
+(deflabel specific-kinds-of-formulas-as-rewrite-rulesspecific-kinds-of-formulas-as-rewrite-rules
7624,314121
+(deflabel further-information-on-rewritingfurther-information-on-rewriting
7711,318450
+(deflabel introduction-to-rewrite-rules-part-1introduction-to-rewrite-rules-part-1
7830,325224
+(deflabel introduction-to-the-databaseintroduction-to-the-database
8009,334243
+(deflabel introduction-to-hintsintroduction-to-hints
8241,346169
+(deflabel introduction-to-a-few-system-considerationsintroduction-to-a-few-system-considerations
8341,351340
+(deflabel architecture-of-the-proverarchitecture-of-the-prover
8524,360134
+(deflabel frequently-asked-questions-by-newcomersfrequently-asked-questions-by-newcomers
8605,364191
+(deflabel introductory-challengesintroductory-challenges
9182,396609
+(deflabel introductory-challenge-problem-1introductory-challenge-problem-1
9218,398161
+(deflabel introductory-challenge-problem-1-answerintroductory-challenge-problem-1-answer
9251,398972
+(deflabel introductory-challenge-problem-2introductory-challenge-problem-2
9299,400312
+(deflabel introductory-challenge-problem-2-answerintroductory-challenge-problem-2-answer
9322,400883
+(deflabel introductory-challenge-problem-3introductory-challenge-problem-3
9369,402199
+(deflabel introductory-challenge-problem-3-answerintroductory-challenge-problem-3-answer
9405,403123
+(deflabel introductory-challenge-problem-4introductory-challenge-problem-4
9524,407128
+(deflabel introductory-challenge-problem-4-answerintroductory-challenge-problem-4-answer
9581,409400
+(deflabel interesting-applicationsinteresting-applications
10163,432051
+(deflabel advanced-featuresadvanced-features
10283,439547
+
+interface-raw.lisp,13165
+(defun-*1* mv-list (input-arity x)mv-list
676,29373
+(defun-*1* return-last (fn x y)return-last
680,29447
+(defun-*1* wormhole-eval (qname qlambda free-vars)wormhole-eval
750,32381
+(defun-*1* acl2-numberp (x)acl2-numberp
757,32569
+(defun-*1* binary-* (x y)binary-*
760,32613
+(defun-*1* binary-+ (x y)binary-+
768,32797
+(defun-*1* unary-- (x)unary--
779,33071
+(defun-*1* unary-/ (x)unary-/
785,33180
+(defun-*1* < (x y)<
791,33309
+(defun-*1* apply (x y)apply
816,34292
+(defun-*1* bad-atom<= (x y)bad-atom<=
820,34414
+(defun-*1* car (x)car
830,34740
+(defun-*1* cdr (x)cdr
838,34843
+(defun-*1* char-code (x)char-code
846,34946
+(defun-*1* characterp (x)characterp
851,35040
+(defun-*1* code-char (x)code-char
854,35085
+(defun-*1* complex (x y)complex
861,35236
+(defun-*1* complex-rationalp (x)complex-rationalp
865,35400
+(defun-*1* complexp (x)complexp
871,35541
+(defun-*1* coerce (x y)coerce
874,35582
+(defun-*1* cons (x y)cons
888,35912
+(defun-*1* consp (x)consp
891,35949
+(defun-*1* denominator (x)denominator
894,35984
+(defun-*1* equal (x y)equal
899,36083
+(defun-*1* floor1 (x)floor1
903,36147
+(defun-*1* if (x y z)if
912,36351
+(defun-*1* imagpart (x)imagpart
917,36552
+(defun-*1* integerp (x)integerp
922,36640
+(defun-*1* intern-in-package-of-symbol (x y)intern-in-package-of-symbol
925,36681
+(defun-*1* pkg-imports (pkg)pkg-imports
931,36863
+(defun-*1* pkg-witness (pkg)pkg-witness
936,36970
+(defun-*1* numerator (x)numerator
946,37389
+(defun-*1* rationalp (x)rationalp
951,37482
+(defun-*1* realp (x)realp
957,37601
+(defun-*1* realpart (x)realpart
960,37636
+(defun-*1* stringp (x)stringp
965,37724
+(defun-*1* symbol-name (x)symbol-name
968,37763
+(defun-*1* symbol-package-name (x)symbol-package-name
973,37861
+(defun-*1* symbolp (x)symbolp
979,38028
+(defun standardp (x)standardp
995,38669
+(defun-*1* standardp (x)standardp
999,38719
+(defun standard-part (x)standard-part
1003,38773
+(defun-*1* standard-part (x)standard-part
1006,38803
+(defun i-large-integer ()i-large-integer
1009,38838
+(defun-*1* i-large-integer ()i-large-integer
1012,38936
+(defun-one-output macroexpand1! (x)macroexpand1!
1017,39041
+(defvar *acl2-gentemp-counter* 0)*acl2-gentemp-counter*
1023,39211
+(defun-one-output acl2-gentemp (root)acl2-gentemp
1024,39245
+(defun-one-output oneify-flet-bindings (alist fns w)oneify-flet-bindings
1036,39685
+(defun-one-output oneify (x fns w)oneify
1063,41009
+(defun-one-output oneify-lst (lst fns w)oneify-lst
1266,48996
+(defun-one-output select-stobj (name stobjs terms)select-stobj
1274,49191
+(defun-one-output super-defstobj-wart-stobjs-in (formals stobj-flag)super-defstobj-wart-stobjs-in
1279,49375
+(defun-one-output oneify-fail-form (er-type fn formals guard super-stobjs-inoneify-fail-form
1287,49712
+(defun-one-output get-declared-stobjs (edcls)get-declared-stobjs
1308,50421
+(defun-one-output warn-for-guard-body (fn)warn-for-guard-body
1322,50944
+(defun-one-output create-live-user-stobjp-test (stobjs)create-live-user-stobjp-test
1334,51529
+(defun oneify-cltl-code (defun-mode def stobj-flag wrldoneify-cltl-code
1344,51843
+(defvar *saved-raw-prompt* nil)*saved-raw-prompt*
2088,89063
+(defvar *saved-raw-prompt-p* nil)*saved-raw-prompt-p*
2089,89095
+(defun-one-output install-new-raw-prompt ()install-new-raw-prompt
2094,89148
+(defun-one-output install-old-raw-prompt ()install-old-raw-prompt
2101,89418
+(defun-one-output install-new-raw-prompt ()install-new-raw-prompt
2111,89685
+(defun-one-output install-old-raw-prompt ()install-old-raw-prompt
2122,90173
+(defun-one-output install-new-raw-prompt ()install-new-raw-prompt
2132,90447
+(defun-one-output install-old-raw-prompt ()install-old-raw-prompt
2139,90678
+(defun-one-output install-new-raw-prompt ()install-new-raw-prompt
2146,90808
+(defun-one-output install-old-raw-prompt ()install-old-raw-prompt
2158,91360
+(defun-one-output install-new-raw-prompt ()install-new-raw-prompt
2172,91852
+(defun-one-output install-old-raw-prompt ()install-old-raw-prompt
2189,92694
+(defun-one-output install-new-raw-prompt ()install-new-raw-prompt
2207,93337
+(defun-one-output install-old-raw-prompt ()install-old-raw-prompt
2210,93389
+(defvar *dmr-interval* 1000)*dmr-interval*
2223,93743
+(defvar *dmr-interval-acl2-par-hack* 300000)*dmr-interval-acl2-par-hack*
2224,93772
+(defvar *dmr-interval-used*)*dmr-interval-used*
2225,93817
+(defvar *dmr-indent-max* 20)*dmr-indent-max*
2232,94090
+(defvar *dmr-file-name*)*dmr-file-name*
2238,94374
+(defun dmr-file-name ()dmr-file-name
2240,94400
+(defparameter *dmr-stream**dmr-stream*
2253,94998
+(defparameter *dmr-counter**dmr-counter*
2256,95033
+(defun dmr-acl2-par-hack-p ()dmr-acl2-par-hack-p
2265,95263
+(defun dmr-stop-fn-raw ()dmr-stop-fn-raw
2268,95352
+(defun initialize-dmr-interval-used ()initialize-dmr-interval-used
2274,95481
+(defun dmr-start-fn-raw (state)dmr-start-fn-raw
2282,95713
+(defvar *dmr-array**dmr-array*
2296,96178
+(defun reverse-into-dmr-array (lst)reverse-into-dmr-array
2299,96262
+(defparameter *dmr-reusable-string**dmr-reusable-string*
2309,96564
+(defvar *dmr-indent*)*dmr-indent*
2321,96916
+(defmacro dmr-increment-indent ()dmr-increment-indent
2323,96939
+(defun tilde-@-bkptr-string (calling-sys-fn called-sys-fn bkptr)tilde-@-bkptr-string
2327,97026
+(defvar *dmr-interp-state**dmr-interp-state*
2385,99861
+(defun dmr-interp-fresh-rewrite-p (calling-sys-fn frame)dmr-interp-fresh-rewrite-p
2390,100003
+(defun dmr-prefix ()dmr-prefix
2397,100216
+(defun dmr-interp (i calling-sys-fn frame)dmr-interp
2410,100672
+(defvar *dmr-delete-string**dmr-delete-string*
2485,103412
+(defun dmr-string ()dmr-string
2491,103528
+(defun dmr-flush1 (&optional reset-counter)dmr-flush1
2575,107292
+(defvar *dmr-lock* (make-lock))*dmr-lock*
2590,107724
+(defun dmr-flush (&optional reset-counter)dmr-flush
2592,107757
+(defun dmr-display ()dmr-display
2604,108192
+(defun cw-gstack-short ()cw-gstack-short
2616,108569
+(defun-one-output fmakunbound! (name)fmakunbound!
2771,117320
+(defun-one-output maybe-push-undo-stack (fn name &optional extra)maybe-push-undo-stack
2778,117589
+(defun-one-output maybe-pop-undo-stack (name)maybe-pop-undo-stack
2951,125827
+(defun-one-output flush-undo-stack (name)flush-undo-stack
2964,126168
+(defparameter *current-acl2-world-key-ordering**current-acl2-world-key-ordering*
3275,142599
+(defun-one-output key-lesseqp (key1 key2 ordering)key-lesseqp
3299,143328
+(defun-one-output merge-into-alist (key val alist)merge-into-alist
3308,143604
+(defun-one-output destructive-push-assoc (key value alist world-key)destructive-push-assoc
3320,144175
+(defun-one-output destructive-pop-assoc (key alist)destructive-pop-assoc
3337,145045
+(defun-one-output remove-current-acl2-world-key (plist)remove-current-acl2-world-key
3343,145240
+(defun hcomp-init ()hcomp-init
4139,190426
+(defabbrev reclassifying-value-p (x)reclassifying-value-p
4199,193077
+(defmacro make-reclassifying-value (x)make-reclassifying-value
4206,193230
+(defmacro unmake-reclassifying-value (x)unmake-reclassifying-value
4212,193360
+(defun hcomp-transfer-to-hash-tables ()hcomp-transfer-to-hash-tables
4218,193472
+(defvar *saved-hcomp-restore-hts* nil)*saved-hcomp-restore-hts*
4262,195292
+(defun hcomp-restore-defs ()hcomp-restore-defs
4264,195332
+(defun missing-compiled-book (ctx file reason-msg load-compiled-file state)missing-compiled-book
4316,197619
+(defun load-compiled-book (file directory-name load-compiled-file ctx state)load-compiled-book
4378,200600
+(defun include-book-raw (book-name directory-name load-compiled-file dir ctxinclude-book-raw
4506,206320
+(defun include-book-raw-top (full-book-name directory-name load-compiled-fileinclude-book-raw-top
4763,219893
+(defmacro hcomp-ht-from-type (type ctx)hcomp-ht-from-type
4795,221402
+(defmacro hcomp-build-p ()hcomp-build-p
4804,221690
+(defun install-for-add-trip-hcomp-build (def reclassifyingp evalp)install-for-add-trip-hcomp-build
4809,221877
+(defun install-for-add-trip-include-book (type name def reclassifyingp)install-for-add-trip-include-book
4866,224468
+(defun install-for-add-trip (def reclassifyingp evalp)install-for-add-trip
4952,228499
+(defun install-defs-for-add-trip (defs reclassifying-p wrld declaim-p evalp)install-defs-for-add-trip
4968,229138
+(defun hcomp-build-from-portcullis-raw (cltl-cmds state)hcomp-build-from-portcullis-raw
5088,234699
+(defun hcomp-alists-from-hts ()hcomp-alists-from-hts
5176,238569
+(defun-one-output add-trip (world-name world-key trip)add-trip
5221,240428
+(defun-one-output undo-trip (world-name world-key trip)undo-trip
5789,268590
+(defun-one-output flush-trip (name world-key trip)flush-trip
5831,270410
+(defvar *bad-wrld*)*bad-wrld*
5861,271611
+(defun check-acl2-world-invariant (wrld old-wrld)check-acl2-world-invariant
5863,271632
+(defparameter *known-worlds* nil)*known-worlds*
5881,272430
+(defun update-wrld-structures (wrld state)update-wrld-structures
5883,272465
+(defun-one-output extend-world1 (name wrld)extend-world1
5894,272802
+(defun-one-output retract-world1 (name wrld)retract-world1
6007,277962
+(defun-one-output recover-world1 (wrld saved-wrld ans)recover-world1
6108,282353
+(defun-one-output recover-world (op name old-wrld universe pkg)recover-world
6123,283012
+(defun-one-output virginp (name new-type)virginp
6251,289634
+(defun-one-output chk-virgin2 (name new-type wrld)chk-virgin2
6262,290020
+(defun-one-output chk-package-reincarnation-import-restrictions2chk-package-reincarnation-import-restrictions2
6329,293242
+(defvar user::*acl2-keep-tmp-files* nil)user::*acl2-keep-tmp-files*
6368,294478
+(defun-one-output enter-boot-strap-mode (system-books-dir operating-system)enter-boot-strap-mode
6370,294520
+(defun-one-output move-current-acl2-world-key-to-front (wrld)move-current-acl2-world-key-to-front
6465,298799
+(defun-one-output exit-boot-strap-mode ()exit-boot-strap-mode
6554,303406
+(defun-one-output ld-alist-raw (standard-oi ld-skip-proofsp ld-error-action)ld-alist-raw
6577,304380
+(defun enter-boot-strap-pass-2 ()enter-boot-strap-pass-2
6600,305203
+(defconst *acl2-pass-2-files**acl2-pass-2-files*
6620,305917
+(defun our-update-ht (key val ht)our-update-ht
6637,306370
+(defun note-fns-in-form (form ht)note-fns-in-form
6646,306667
+(defun note-fns-in-file (filename ht)note-fns-in-file
6735,309850
+(defun note-fns-in-files (filenames ht loop-only-p)note-fns-in-files
6750,310293
+(defun raw-source-name-p (filename-without-extension)raw-source-name-p
6763,310864
+(defvar *check-built-in-constants-debug* nil)*check-built-in-constants-debug*
6770,311145
+(defun fns-different-wrt-acl2-loop-only (acl2-files)fns-different-wrt-acl2-loop-only
6772,311192
+(defun collect-monadic-booleans (fns ens wrld)collect-monadic-booleans
6840,314729
+(defun check-built-in-constants ()check-built-in-constants
6854,315326
+(defun-one-output check-none-ideal (trips acc)check-none-ideal
7106,326825
+(defun check-state-globals-initialized ()check-state-globals-initialized
7146,328437
+(defun-one-output check-acl2-initialization ()check-acl2-initialization
7163,329050
+(defun set-initial-cbd ()set-initial-cbd
7169,329259
+(defun initialize-acl2 (&optional (pass-2-ld-skip-proofsp 'include-book)initialize-acl2
7197,330400
+(defun our-abort (condition your-abort
7488,343920
+(defun initial-customization-filename ()initial-customization-filename
7584,348237
+(defun spawn-extra-lispworks-listener ()spawn-extra-lispworks-listener
7669,351853
+(defun lp (&rest args)lp
7695,353056
+(defmacro lp! (&rest args)lp!
7919,363205
+(defun acl2-compile-file (full-book-name os-expansion-filename)acl2-compile-file
7925,363372
+(defun-one-output delete-auxiliary-book-files (full-book-name)delete-auxiliary-book-files
7994,366411
+(defun delete-expansion-file (expansion-filename state)delete-expansion-file
8027,368093
+(defun compile-uncompiled-defuns (file &optional (fns :some) gcl-flgcompile-uncompiled-defuns
8035,368386
+(defun compile-uncompiled-*1*-defuns (file &optional (fns :some) gcl-flg chan0compile-uncompiled-*1*-defuns
8215,376717
+(defun compile-certified-file (expansion-filename full-book-name state)compile-certified-file
8451,387908
+(defun compile-for-include-book (full-book-name certified-p ctx state)compile-for-include-book
8465,388514
+(defun-one-output enabled-structurep (x)enabled-structurep
8532,391958
+(defun-one-output rcnstp (x)rcnstp
8555,392945
+(defvar *trace-alist**trace-alist*
8571,393359
+(defun-one-output assoc-eq-trace-alist (val alist)assoc-eq-trace-alist
8574,393426
+(defun-one-output print-list-without-stobj-arrays (lst)print-list-without-stobj-arrays
8582,393651
+(defun-one-output stobj-print-symbol (x user-stobj-alist-tail)stobj-print-symbol
8589,393850
+(defun-one-output trace-hide-world-and-state (l)trace-hide-world-and-state
8606,394605
+(defun-one-output saved-build-date-string ()saved-build-date-string
8660,396854
+(defun-one-output get-stobjs-out-for-declare-form (fn)get-stobjs-out-for-declare-form
8671,397150
+(defun fix-trace-untrace (new-trace-specs old-trace-specs)fix-trace-untrace
8696,398125
+(defun fix-trace (old-trace-specs)fix-trace
8708,398565
+(defun acl2-books-revision ()acl2-books-revision
8720,399057
+
+defpkgs.lisp,90
+(defconst *acl2-exports**acl2-exports*
34,1565
+(defpkg "ACL2-USER""ACL2-USER"
638,27417
+
+boot-strap-pass-2.lisp,3623
+(defattach too-many-ifs-post-rewrite too-many-ifs-post-rewrite-builtin)too-many-ifs-post-rewrite
487,19522
+(defthm fn-count-evg-rec-type-prescriptionfn-count-evg-rec-type-prescription
524,20788
+(defthm fn-count-evg-rec-boundfn-count-evg-rec-bound
529,20942
+(defthm fn-count-1-typefn-count-1-type
546,21393
+(defthm symbol-listp-cdr-assoc-equalsymbol-listp-cdr-assoc-equal
571,22588
+(defthm integerp-nth-0-var-fn-count-1integerp-nth-0-var-fn-count-1
579,22915
+(defthm integerp-nth-1-var-fn-count-1integerp-nth-1-var-fn-count-1
606,24205
+(defthm integerp-nth-2-var-fn-count-1integerp-nth-2-var-fn-count-1
629,25266
+(defun member-equal-mod-commuting (x lst wrld)member-equal-mod-commuting
660,26527
+(defun strip-ancestor-literals (ancestors)strip-ancestor-literals
673,27135
+(defattach worse-than worse-than-builtin)worse-than
756,30389
+(defattach worse-than-or-equal worse-than-or-equal-builtin)worse-than-or-equal
758,30432
+(defattach rw-cache-debug rw-cache-debug-builtin)rw-cache-debug
779,31047
+(defattach rw-cache-debug-action rw-cache-debug-action-builtin)rw-cache-debug-action
783,31174
+(defattach rw-cacheable-failure-reason rw-cacheable-failure-reason-builtin)rw-cacheable-failure-reason
787,31321
+(defthm d-pos-listp-forward-to-true-listpd-pos-listp-forward-to-true-listp
812,32089
+(defattach print-clause-id-okp print-clause-id-okp-builtin)print-clause-id-okp
829,32654
+(defattach oncep-tp oncep-tp-builtin)oncep-tp
863,33895
+(defthm pos-listp-forward-to-integer-listppos-listp-forward-to-integer-listp
885,34833
+(defthm true-listp-chars-for-tilde-@-clause-id-phrase/periodstrue-listp-chars-for-tilde-@-clause-id-phrase/periods
892,35035
+(defthm true-listp-explode-atomtrue-listp-explode-atom
896,35198
+(deftheory definition-minimal-theorydefinition-minimal-theory
991,38048
+(deftheory executable-counterpart-minimal-theoryexecutable-counterpart-minimal-theory
997,38158
+(deftheory minimal-theoryminimal-theory
1003,38285
+(deftheory ground-zero (current-theory :here)ground-zero
1053,40237
+(defund meta-extract-formula (name state)meta-extract-formula
1084,41170
+(defun typespec-check (ts x)typespec-check
1111,42319
+(defun meta-extract-rw+-term (term alist equiv rhs state)meta-extract-rw+-term
1123,42693
+(defun meta-extract-contextual-fact (obj mfc state)meta-extract-contextual-fact
1154,43840
+(defun rewrite-rule-term (x)rewrite-rule-term
1199,45908
+(defmacro meta-extract-global-fact (obj state)meta-extract-global-fact
1213,46340
+(defun fncall-term (fn arglist state)fncall-term
1217,46473
+(defun logically-equivalent-states (st1 st2)logically-equivalent-states
1234,47115
+(defun meta-extract-global-fact+ (obj st state)meta-extract-global-fact+
1238,47230
+(defun pair-fns-with-measured-subsets (fns wrld acc)pair-fns-with-measured-subsets
1295,49630
+(defun new-verify-guards-fns1 (wrld installed-wrld acc)new-verify-guards-fns1
1312,50422
+(defun new-verify-guards-fns (state)new-verify-guards-fns
1334,51448
+(defconst *system-verify-guards-alist**system-verify-guards-alist*
1345,51890
+(defconst *len-system-verify-guards-alist**len-system-verify-guards-alist*
1402,53746
+(defmacro chk-new-verified-guards (n)chk-new-verified-guards
1405,53831
+(defun system-verify-guards-fn-1 (fns-alist acc)system-verify-guards-fn-1
1439,55325
+(defun cons-absolute-event-numbers (fns-alist wrld acc)cons-absolute-event-numbers
1452,55934
+(defun sort->-absolute-event-number (fns-alist wrld)sort->-absolute-event-number
1469,56679
+(defun system-verify-guards-fn (alist wrld acc)system-verify-guards-fn
1474,56897
+(defmacro system-verify-guards ()system-verify-guards
1484,57250
+
+hons-raw.lisp,9768
+(defmacro hl-without-interrupts (&rest forms)hl-without-interrupts
94,4387
+(defun hl-mht-fn (&key (test             'eql)hl-mht-fn
104,4685
+(defvar *allegro-hl-hash-table-size-ht**allegro-hl-hash-table-size-ht*
127,5524
+(defmacro hl-mht (&rest args)hl-mht
131,5637
+(defabbrev hl-static-cons (a b)hl-static-cons
217,9570
+(defabbrev hl-staticp (x)hl-staticp
221,9643
+(defabbrev hl-static-inverse-cons (x)hl-static-inverse-cons
225,9705
+(defabbrev hl-machine-address-of (x)hl-machine-address-of
231,9793
+(defabbrev hl-machine-hash (x)hl-machine-hash
235,9869
+(defconstant hl-cache-table-sizehl-cache-table-size
381,17111
+(defconstant hl-cache-table-cutoffhl-cache-table-cutoff
386,17198
+(defstruct hl-cachehl-cache
390,17333
+(defun hl-cache-set (key val cache)hl-cache-set
402,17687
+(defun hl-cache-get (key cache)hl-cache-get
427,18622
+(defun hl-cache-clear (cache)hl-cache-clear
454,19377
+(defparameter *hl-hspace-str-ht-default-size*      1000)*hl-hspace-str-ht-default-size*
672,29220
+(defparameter *hl-ctables-nil-ht-default-size*     5000)*hl-ctables-nil-ht-default-size*
673,29277
+(defparameter *hl-ctables-cdr-ht-default-size*     100000)*hl-ctables-cdr-ht-default-size*
674,29334
+(defparameter *hl-ctables-cdr-ht-eql-default-size* 1000)*hl-ctables-cdr-ht-eql-default-size*
675,29393
+(defparameter *hl-hspace-addr-ht-default-size*     150000)*hl-hspace-addr-ht-default-size*
676,29450
+(defparameter *hl-hspace-sbits-default-size*       16000000)*hl-hspace-sbits-default-size*
677,29509
+(defparameter *hl-hspace-other-ht-default-size*    1000)*hl-hspace-other-ht-default-size*
678,29570
+(defparameter *hl-hspace-fal-ht-default-size*      1000)*hl-hspace-fal-ht-default-size*
679,29627
+(defparameter *hl-hspace-persist-ht-default-size*  100)*hl-hspace-persist-ht-default-size*
680,29684
+(defstruct hl-ctableshl-ctables
685,29757
+(defun hl-initialize-faltable-table (fal-ht-size)hl-initialize-faltable-table
702,30323
+(defstruct hl-falslothl-falslot
743,32434
+(defun hl-faltable-init (&key (size *hl-hspace-fal-ht-default-size*))hl-faltable-init
789,34103
+(defun hl-hspace-init (&key (str-ht-size       *hl-hspace-str-ht-default-size*)hl-hspace-init
845,35701
+(defabbrev hl-flex-alist-too-long (x)hl-flex-alist-too-long
927,39535
+(defabbrev hl-flex-assoc (key al)hl-flex-assoc
943,40137
+(defabbrev hl-flex-acons (elem al)hl-flex-acons
953,40433
+(defun hl-hspace-truly-static-honsp (x hs)hl-hspace-truly-static-honsp
995,41938
+(defabbrev hl-hspace-find-alist-for-cdr (b ctables)hl-hspace-find-alist-for-cdr
1010,42478
+(defun hl-hspace-honsp (x hs)hl-hspace-honsp
1030,43204
+(defun hl-hspace-honsp-wrapper (x)hl-hspace-honsp-wrapper
1048,43671
+(defun hl-hspace-faltable-wrapper ()hl-hspace-faltable-wrapper
1054,43865
+(defun hl-hspace-normedp (x hs)hl-hspace-normedp
1061,44063
+(defun hl-hspace-normedp-wrapper (x)hl-hspace-normedp-wrapper
1082,44609
+(defun hl-hspace-hons-equal-lite (x y hs)hl-hspace-hons-equal-lite
1095,45008
+(defun hl-hspace-hons-equal (x y hs)hl-hspace-hons-equal
1115,45579
+(defconstant hl-minimum-static-inthl-minimum-static-int
1191,48564
+(defconstant hl-maximum-static-inthl-maximum-static-int
1196,48704
+(defconstant hl-num-static-intshl-num-static-ints
1201,48840
+(defconstant hl-dynamic-base-addrhl-dynamic-base-addr
1206,49023
+(defconstant hl-static-int-shifthl-static-int-shift
1215,49312
+(ccl::defstatic *hl-symbol-addr-lock**hl-symbol-addr-lock*
1223,49701
+(defabbrev hl-symbol-addr (s)hl-symbol-addr
1228,49866
+(defun hl-addr-of-unusual-atom (x str-ht other-ht)hl-addr-of-unusual-atom
1276,52072
+(defmacro hl-addr-of (x str-ht other-ht)hl-addr-of
1319,53771
+(defun hl-nat-combine* (a b)hl-nat-combine*
1342,54677
+(defabbrev hl-addr-combine* (a b)hl-addr-combine*
1356,55235
+(defparameter *hl-addr-limit-minimum**hl-addr-limit-minimum*
1436,59175
+(defun hl-make-addr-limit-current (hs)hl-make-addr-limit-current
1444,59500
+(defun hl-make-addr-limit-next (hs)hl-make-addr-limit-next
1457,59930
+(defun hl-addr-ht-fullness (hs)hl-addr-ht-fullness
1475,60686
+(defparameter *hl-addr-limit-should-clear-memo-tables**hl-addr-limit-should-clear-memo-tables*
1481,60909
+(defun hl-addr-limit-action (hs)hl-addr-limit-action
1486,61029
+(defun hl-hspace-grow-sbits (idx hs)hl-hspace-grow-sbits
1546,63512
+(defun hl-hspace-norm-atom (x hs)hl-hspace-norm-atom
1590,65758
+(defun hl-hspace-hons-normed (a b hint hs)hl-hspace-hons-normed
1628,67077
+(defun hl-hspace-norm-aux (x cache hs)hl-hspace-norm-aux
1782,74804
+(defun hl-hspace-norm-expensive (x hs)hl-hspace-norm-expensive
1808,75744
+(defun hl-hspace-norm (x hs)hl-hspace-norm
1826,76379
+(defun hl-hspace-persistent-norm (x hs)hl-hspace-persistent-norm
1835,76600
+(defabbrev hl-hspace-hons (x y hs)hl-hspace-hons
1860,77637
+(defun hl-slow-alist-warning (name)hl-slow-alist-warning
1963,82184
+(defun hl-faltable-maphash (f faltable)hl-faltable-maphash
1981,82949
+(defun hl-faltable-load-empty-slot (alist slot faltable)hl-faltable-load-empty-slot
2008,83814
+(defun hl-faltable-eject (slot faltable)hl-faltable-eject
2031,84701
+(defun hl-faltable-get-free-slot (faltable)hl-faltable-get-free-slot
2049,85385
+(defun hl-faltable-slot-lookup (alist faltable)hl-faltable-slot-lookup
2064,85952
+(defun hl-faltable-general-lookup (alist faltable)hl-faltable-general-lookup
2091,86984
+(defun hl-faltable-remove (alist faltable)hl-faltable-remove
2106,87639
+(defun hl-hspace-fast-alist-free (alist hs)hl-hspace-fast-alist-free
2129,88655
+(defun hl-hspace-hons-get (key alist hs)hl-hspace-hons-get
2137,88859
+(defun hl-hspace-hons-acons (key value alist hs)hl-hspace-hons-acons
2163,89892
+(defun hl-alist-stolen-warning (name)hl-alist-stolen-warning
2223,92336
+(defun hl-hspace-hons-acons! (key value alist hs)hl-hspace-hons-acons!
2241,93090
+(defun hl-alist-longest-normed-tail (alist hs)hl-alist-longest-normed-tail
2290,95037
+(defun hl-make-fast-norm-keys (alist tail hs)hl-make-fast-norm-keys
2310,95834
+(defun hl-make-fast-alist-put-pairs (alist ht)hl-make-fast-alist-put-pairs
2336,96811
+(defun hl-hspace-make-fast-alist (alist hs)hl-hspace-make-fast-alist
2352,97468
+(defun hl-shrink-alist-aux-really-slow (alist ans honsp hs)hl-shrink-alist-aux-really-slow
2404,99855
+(defun hl-shrink-alist-aux-slow (alist ans table honsp hs)hl-shrink-alist-aux-slow
2426,100853
+(defun hl-shrink-alist-aux-fast (alist ans table honsp hs)hl-shrink-alist-aux-fast
2452,102038
+(defun hl-hspace-shrink-alist (alist ans honsp hs)hl-hspace-shrink-alist
2483,103415
+(defun hl-hspace-fast-alist-len (alist hs)hl-hspace-fast-alist-len
2557,106773
+(defun hl-check-alist-for-serialize-restore (alist hs)hl-check-alist-for-serialize-restore
2576,107497
+(defun hl-hspace-restore-fal-for-serialize (alist count hs)hl-hspace-restore-fal-for-serialize
2595,108169
+(defun hl-restore-fal-for-serialize (alist count)hl-restore-fal-for-serialize
2621,109413
+(defun hl-hspace-number-subtrees-aux (x seen)hl-hspace-number-subtrees-aux
2632,109807
+(defun hl-hspace-number-subtrees (x hs)hl-hspace-number-subtrees
2644,110141
+(defun hl-system-gc ()hl-system-gc
2671,111057
+(defun hl-hspace-classic-restore (x nil-ht cdr-ht cdr-ht-eql seen-ht)hl-hspace-classic-restore
2690,111601
+(defun hl-hspace-hons-clear (gc hs)hl-hspace-hons-clear
2746,113988
+(defun hl-hspace-static-restore (x addr-ht sbits str-ht other-ht)hl-hspace-static-restore
2826,117298
+(defun hl-hspace-hons-clear (gc hs)hl-hspace-hons-clear
2868,119129
+(defun hl-fix-sbits-after-gc (sbits)hl-fix-sbits-after-gc
2958,122869
+(defun hl-rebuild-addr-ht (sbits addr-ht str-ht other-ht)hl-rebuild-addr-ht
2979,123673
+(defparameter *hl-addr-ht-resize-cutoff**hl-addr-ht-resize-cutoff*
3016,125485
+(defun hl-hspace-hons-wash (hs)hl-hspace-hons-wash
3024,125858
+(defun hl-maybe-resize-ht (size src)hl-maybe-resize-ht
3172,132728
+(defun hl-hspace-resize (str-ht-size nil-ht-size cdr-ht-size cdr-ht-eql-sizehl-hspace-resize
3200,133895
+(defun hl-get-final-cdr (alist)hl-get-final-cdr
3277,136717
+(defun hl-hspace-fast-alist-summary (hs)hl-hspace-fast-alist-summary
3282,136818
+(defun hl-hspace-hons-summary (hs)hl-hspace-hons-summary
3325,138597
+(defparameter *default-hs**default-hs*
3409,141756
+(defun hl-maybe-initialize-default-hs ()hl-maybe-initialize-default-hs
3439,142903
+(defun hl-maybe-initialize-default-hs-wrapper ()hl-maybe-initialize-default-hs-wrapper
3446,143043
+(defun hons (x y)hons
3450,143167
+(defun hons-copy (x)hons-copy
3455,143303
+(defun hons-copy-persistent (x)hons-copy-persistent
3460,143440
+(defun hons-equal (x y)hons-equal
3466,143607
+(defun hons-equal-lite (x y)hons-equal-lite
3472,143812
+(defun hons-summary ()hons-summary
3477,143997
+(defun hons-clear (gc)hons-clear
3482,144120
+(defun hons-wash ()hons-wash
3487,144244
+(defun hons-resize-fn (str-ht nil-ht cdr-ht cdr-ht-eqlhons-resize-fn
3492,144361
+(defun hons-acons (key val fal)hons-acons
3504,144782
+(defun hons-acons! (key val fal)hons-acons!
3510,144999
+(defun hons-shrink-alist (alist ans)hons-shrink-alist
3515,145187
+(defun hons-shrink-alist! (alist ans)hons-shrink-alist!
3520,145338
+(defun hons-get (key fal)hons-get
3526,145516
+(defun fast-alist-free (fal)fast-alist-free
3532,145723
+(defun fast-alist-len (fal)fast-alist-len
3538,145942
+(defun number-subtrees (x)number-subtrees
3544,146159
+(defun fast-alist-summary ()fast-alist-summary
3549,146340
+(defun make-fast-alist (alist)make-fast-alist
3554,146475
+(defmacro with-fast-alist-raw (alist form)with-fast-alist-raw
3559,146615
+(defmacro with-stolen-alist-raw (alist form)with-stolen-alist-raw
3588,147847
+(defmacro fast-alist-free-on-exit-raw (alist form)fast-alist-free-on-exit-raw
3617,149106
+(defun clear-hash-tables ()clear-hash-tables
3624,149295
+(defun wash-memory ()wash-memory
3629,149409
+
+memoize-raw.lisp,12915
+(defconstant most-positive-mfixnum (1- (expt 2 60)))most-positive-mfixnum
69,2711
+(deftype mfixnum ()mfixnum
71,2765
+(defmacro our-syntax (&rest args)our-syntax
86,3276
+(defmacro our-syntax-nice (&rest args)our-syntax-nice
112,4228
+(defmacro our-syntax-brief (&rest args)our-syntax-brief
122,4588
+(defmacro ofn (&rest r) ; For forming strings.ofn
131,4813
+(defun-one-output ofnum (n) ; For forming numbers.ofnum
134,4895
+(defmacro ofni (&rest r) ; For forming symbols in package ACL2.ofni
145,5220
+(defmacro ofnm (&rest r) ; For forming uninterned symbols.ofnm
148,5343
+(defmacro oft (&rest r) ; For writing to *standard-output*.oft
151,5451
+(defmacro oftr (&rest r) ; For writing to *trace-output*.oftr
155,5582
+(defv *number-of-arguments-and-values-ht**number-of-arguments-and-values-ht*
165,5858
+(defun-one-output input-output-number-error (fn)input-output-number-error
208,7395
+(defun-one-output number-of-arguments (fn)number-of-arguments
218,7889
+(defun-one-output number-of-return-values (fn)number-of-return-values
242,8711
+(defg *float-ticks/second* 1.0)*float-ticks/second*
265,9496
+(defg *float-internal-time-units-per-second**float-internal-time-units-per-second*
267,9529
+(defabbrev internal-real-time ()internal-real-time
273,9712
+(defun-one-output float-ticks/second-init ()float-ticks/second-init
281,10037
+(defun-one-output safe-incf-aux-error (x inc where)safe-incf-aux-error
303,10770
+(defmacro safe-incf-aux (x inc where)safe-incf-aux
307,10912
+(defmacro safe-incf (x inc &optional where)safe-incf
338,12083
+(defparameter *count-pons-calls* t*count-pons-calls*
384,13857
+(defg *pons-call-counter* 0)*pons-call-counter*
390,14101
+(defg *pons-misses-counter* 0)*pons-misses-counter*
391,14130
+(defmacro maybe-count-pons-calls ()maybe-count-pons-calls
395,14254
+(defmacro maybe-count-pons-misses ()maybe-count-pons-misses
399,14384
+(defun-one-output assoc-no-error-at-end (x l)assoc-no-error-at-end
403,14518
+(defun-one-output too-long (x n)too-long
419,15062
+(defconstant atom-case-fudge (+ 129 (expt 2 25)))atom-case-fudge
432,15669
+(defconstant most-positive-fudge (1- (expt 2 24)))most-positive-fudge
433,15719
+(defconstant most-negative-fudge (- (expt 2 24)))most-negative-fudge
434,15770
+(defconstant -most-negative-fudge (- most-negative-fudge))-most-negative-fudge
435,15820
+(defun-one-output atom-case (s)atom-case
438,15890
+(defmacro sqmpf ()sqmpf
457,16642
+(defmacro hmnf ()hmnf
460,16694
+(defmacro static-hons-shift ()static-hons-shift
466,16784
+(defun-one-output addr-for (x y)addr-for
470,16883
+(defun-one-output pons (x y ht)pons
529,19370
+(defmacro pist* (table &rest x)pist*
608,21885
+(defvar *never-memoize-ht**never-memoize-ht*
624,22514
+(defun never-memoize-fn (fn)never-memoize-fn
981,31074
+(defun never-memoize-p (fn)never-memoize-p
984,31148
+(defparameter *record-bytes**record-bytes*
1008,31947
+(defparameter *record-calls* t*record-calls*
1016,32267
+(defparameter *record-hits* t*record-hits*
1020,32389
+(defparameter *record-hons-calls* t*record-hons-calls*
1025,32564
+(defparameter *record-mht-calls* t*record-mht-calls*
1029,32690
+(defparameter *record-pons-calls* t*record-pons-calls*
1034,32891
+(defparameter *record-time* t*record-time*
1038,33029
+(defv *report-bytes* #+Clozure t #-Clozure nil*report-bytes*
1045,33216
+(defv *report-calls* t*report-calls*
1049,33372
+(defv *report-calls-from* t*report-calls-from*
1053,33477
+(defv *report-calls-to* t*report-calls-to*
1058,33649
+(defv *report-hits* t*report-hits*
1063,33829
+(defv *report-hons-calls* t*report-hons-calls*
1067,33977
+(defv *report-mht-calls* t*report-mht-calls*
1071,34118
+(defv *report-pons-calls* t*report-pons-calls*
1079,34537
+(defv *report-time* t*report-time*
1083,34660
+(defv *report-on-memo-tables* t*report-on-memo-tables*
1087,34794
+(defv *report-on-pons-tables* t*report-on-pons-tables*
1091,34927
+(defg *memoize-info-ht**memoize-info-ht*
1095,35060
+(defrec memoize-info-ht-entrymemoize-info-ht-entry
1106,35365
+(defg *memoize-call-array**memoize-call-array*
1150,37312
+(defg *compute-array* (make-array 0)*compute-array*
1182,39001
+(defv *initial-max-memoize-fns* 500)*initial-max-memoize-fns*
1199,39519
+(defg *2max-memoize-fns* (* 2 *initial-max-memoize-fns*))*2max-memoize-fns*
1201,39557
+(defconstant *ma-bytes-index*       0)*ma-bytes-index*
1203,39616
+(defconstant *ma-hits-index*        1)*ma-hits-index*
1204,39655
+(defconstant *ma-mht-index*         2)*ma-mht-index*
1205,39694
+(defconstant *ma-hons-index*        3)*ma-hons-index*
1206,39733
+(defconstant *ma-pons-index*        4)*ma-pons-index*
1207,39772
+(defconstant *ma-initial-max-symbol-to-fixnum* 4)*ma-initial-max-symbol-to-fixnum*
1209,39812
+(defg *max-symbol-to-fixnum* *ma-initial-max-symbol-to-fixnum*)*max-symbol-to-fixnum*
1211,39863
+(defg *caller* (* *ma-initial-max-symbol-to-fixnum* *2max-memoize-fns*)*caller*
1219,40116
+(defn memoize-here-come (n)memoize-here-come
1226,40372
+(defun memoize-flush1 (lst)memoize-flush1
1269,42182
+(defmacro memoize-flush (st)memoize-flush
1287,43060
+(defparameter *memo-max-sizes**memo-max-sizes*
1298,43227
+(defrec memo-max-sizes-entrymemo-max-sizes-entry
1315,44018
+(defun make-initial-memoize-hash-table (fn init-size)make-initial-memoize-hash-table
1325,44466
+(defun make-initial-memoize-pons-table (fn init-size)make-initial-memoize-pons-table
1376,47107
+(defun update-memo-max-sizes (fn pt-size mt-size)update-memo-max-sizes
1409,48917
+(defun print-memo-max-sizes ()print-memo-max-sizes
1438,50455
+(defmacro heap-bytes-allocated ()heap-bytes-allocated
1470,51885
+(defn sync-memoize-call-array ()sync-memoize-call-array
1473,51967
+(defun memoize-call-array-growmemoize-call-array-grow
1498,52887
+(defun-one-output symbol-to-fixnum-create (s)symbol-to-fixnum-create
1527,54231
+(defun-one-output symbol-to-fixnum (s)symbol-to-fixnum
1551,55195
+(defun-one-output fixnum-to-symbol (n)fixnum-to-symbol
1557,55411
+(defun-one-output coerce-index (x)coerce-index
1562,55570
+(defun-one-output memoize-eval-compile (def)memoize-eval-compile
1575,55744
+(defun-one-output memoizedp-raw (fn)memoizedp-raw
1584,56012
+(defg *hons-gentemp-counter* 0)*hons-gentemp-counter*
1588,56119
+(defun-one-output hons-gentemp (root)hons-gentemp
1590,56152
+(defun-one-output st-lst (st)st-lst
1599,56482
+(defun-one-output dcls (l)dcls
1611,56858
+(defg *assoc-eq-hack-ht* (hl-mht :test 'eql))*assoc-eq-hack-ht*
1624,57268
+(defn assoc-eq-hack (x y)assoc-eq-hack
1627,57357
+(defun abbrev (x &optionalabbrev
1640,57916
+(defun prine (obj &optional stream)prine
1664,58924
+(defun prine-alist (obj &optional stream)prine-alist
1669,59055
+(defun-one-output mf-trace-exit (fn nrv ans)mf-trace-exit
1701,60100
+(defg *memoize-fn-signature-error**memoize-fn-signature-error*
1711,60419
+(defg *sort-to-from-by-calls* nil)*sort-to-from-by-calls*
1720,60798
+(defvar *memoize-use-attachment-warning-p* t)*memoize-use-attachment-warning-p*
1722,60834
+(defun memoize-use-attachment-warning (fn at-fn)memoize-use-attachment-warning
1724,60881
+(defun-one-output memoize-fn-suffix (str sym)memoize-fn-suffix
1751,62322
+(defun-one-output mis-ordered-commutative-args (x y)mis-ordered-commutative-args
1759,62547
+(defun our-function-lambda-expression (sym)our-function-lambda-expression
1787,63706
+(defun memoize-look-up-def (fn cl-defun inline wrld)memoize-look-up-def
1795,64033
+(defun fix-time (ticks ctx)fix-time
1838,65802
+(defg *memoize-init-done* nil)*memoize-init-done*
1848,66137
+(defun memoize-fn (fn &key (condition t) (inline t) (trace nil)memoize-fn
1850,66169
+(defun-one-output unmemoize-fn (fn)unmemoize-fn
2520,97360
+(defun-one-output maybe-unmemoize (fn)maybe-unmemoize
2570,99447
+(defun-one-output memoized-functions ()memoized-functions
2582,99969
+(defun-one-output length-memoized-functions ()length-memoized-functions
2592,100258
+(defun-one-output unmemoize-all ()unmemoize-all
2601,100542
+(defun-one-output memoize-info (k)memoize-info
2616,101082
+(defun-one-output rememoize-all ()rememoize-all
2662,103092
+(defun-one-output uses-state (fn)uses-state
2684,103755
+(defun profile-fn (fn &rest r &key (condition nil) (inline nil)profile-fn
2693,104117
+(defun-one-output profiled-functions ()profiled-functions
2700,104315
+(defun-one-output unmemoize-profiled ()unmemoize-profiled
2715,104756
+(defmacro memoize-on-raw (fn x)memoize-on-raw
2726,105044
+(defmacro memoize-off-raw (fn x)memoize-off-raw
2739,105557
+(defun-one-output memoize-condition (fn)memoize-condition
2752,106066
+(defn global-restore-memoize ()global-restore-memoize
2758,106227
+(defg *memoize-summary-order-list**memoize-summary-order-list*
2768,106505
+(defg *memoize-summary-limit* 20*memoize-summary-limit*
2799,107361
+(defg *shorten-ht* (hl-mht :test 'eql))*shorten-ht*
2805,107569
+(defn shorten (x n)shorten
2807,107610
+(defg *memoize-summary-order-reversed* nil*memoize-summary-order-reversed*
2836,108918
+(defg *print-alist-width* 45)*print-alist-width*
2842,109125
+(defun-one-output print-alist (alist separation)print-alist
2844,109156
+(defmacro very-unsafe-incf (x inc &rest r)very-unsafe-incf
2874,110228
+(defmacro very-very-unsafe-aref-incf (ar loc)very-very-unsafe-aref-incf
2888,110563
+(defun-one-output pons-summary ()pons-summary
2894,110776
+(defun memoized-values (&optional (fn (memoized-functions)))memoized-values
2935,112365
+(defn print-call-stack ()print-call-stack
2957,113200
+(defun-one-output hons-calls (x)hons-calls
2992,114429
+(defun-one-output pons-calls (x)pons-calls
3005,114798
+(defun-one-output bytes-allocated (x)bytes-allocated
3018,115165
+(defun-one-output number-of-hits (x)number-of-hits
3030,115560
+(defun-one-output number-of-memoized-entries (x)number-of-memoized-entries
3042,115952
+(defun-one-output number-of-mht-calls (x)number-of-mht-calls
3057,116446
+(defun-one-output time-for-non-hits/call (x)time-for-non-hits/call
3069,116847
+(defun-one-output time/call (x)time/call
3074,117021
+(defun-one-output hits/calls (x)hits/calls
3079,117159
+(defun-one-output bytes-allocated/call (x)bytes-allocated/call
3085,117320
+(defn char-list-fraction (l)char-list-fraction
3092,117488
+(defn symbol-name-order (s)symbol-name-order
3098,117619
+(defun-one-output execution-order (s)execution-order
3106,117844
+(defn compute-calls-and-times ()compute-calls-and-times
3116,118138
+(defun-one-output number-of-calls (x)number-of-calls
3159,120075
+(defun-one-output print-not-called ()print-not-called
3168,120318
+(defun-one-output total-time (x)total-time
3185,120875
+(defn lex-> (l1 l2)lex->
3196,121145
+(defun-one-output memoize-summary-sort ()memoize-summary-sort
3204,121337
+(defun-one-output memoize-summary ()memoize-summary
3223,121960
+(defg *short-symbol-name-width* 30)*short-symbol-name-width*
3299,124961
+(defn short-symbol-name (sym)short-symbol-name
3301,124998
+(defun-one-output outside-p (x)outside-p
3310,125322
+(defun-one-output memoize-summary-after-compute-calls-and-times ()memoize-summary-after-compute-calls-and-times
3314,125447
+(defun-one-output empty-ht-p (x)empty-ht-p
3629,139953
+(defn clear-one-memo-and-pons-hash (l)clear-one-memo-and-pons-hash
3633,140066
+(defun-one-output clear-memoize-table (k)clear-memoize-table
3657,141209
+(defun-one-output clear-memoize-tables ()clear-memoize-tables
3666,141396
+(defn clear-memoize-call-array ()clear-memoize-call-array
3681,141773
+(defn clear-memoize-statistics ()clear-memoize-statistics
3691,142102
+(defun-one-output memoize-init ()memoize-init
3696,142174
+(defg *max-mem-usage* (expt 2 32)*max-mem-usage*
3735,143460
+(defg *gc-min-threshold* (expt 2 30)*gc-min-threshold*
3743,143705
+(defun-one-output set-gc-threshold (bound)set-gc-threshold
3751,143837
+(defmacro globlet (bindings &rest rest)globlet
3760,144046
+(defmacro globlet (&rest r)globlet
3790,145282
+(defmacro with-lower-overhead (&rest r)with-lower-overhead
3801,145612
+(defun acl2h-init-memoizations ()acl2h-init-memoizations
3827,146708
+(defun acl2h-init-unmemoizations ()acl2h-init-unmemoizations
3864,148058
+(defun looking-at (str1 str2 &key (start1 0) (start2 0))looking-at
3893,149126
+(defun meminfo (pat)meminfo
3921,150184
+(defvar *sol-gc-installed* nil)*sol-gc-installed*
3956,151474
+(defun set-and-reset-gc-thresholds ()set-and-reset-gc-thresholds
3960,151518
+(defun start-sol-gc ()start-sol-gc
3983,152422
+(defun-one-output acl2h-init ()acl2h-init
4078,156295
+(defun memstat (&rest r)memstat
4177,160125
+(defmacro memo-on (&rest r)memo-on
4180,160182
+(defmacro memo-off (&rest r)memo-off
4183,160232
+(defun clear-memo-tables (&rest r)clear-memo-tables
4186,160284
+(defn lower-overhead ()lower-overhead
4193,160422
+(defun our-gctime ()our-gctime
4210,160895
+(defun update-memo-entry-for-attachments (fns entry wrld)update-memo-entry-for-attachments
4213,160978
+(defun update-memo-entries-for-attachments (fns wrld state)update-memo-entries-for-attachments
4235,161911
+
+multi-threading-raw.lisp,3613
+(defmacro without-interrupts (&rest forms)without-interrupts
68,2994
+(defmacro unwind-protect-disable-interrupts-during-cleanupunwind-protect-disable-interrupts-during-cleanup
91,3890
+(defun make-atomically-modifiable-counter (initial-value)make-atomically-modifiable-counter
151,6759
+(defmacro define-atomically-modifiable-counter (name initial-value)define-atomically-modifiable-counter
161,6998
+(defmacro atomically-modifiable-counter-read (counter)atomically-modifiable-counter-read
164,7138
+(defmacro atomic-incf (x)atomic-incf
174,7342
+(defmacro atomic-incf-multiple (counter count)atomic-incf-multiple
209,8732
+(defmacro atomic-decf (x)atomic-decf
237,9909
+(defun lockp (x)lockp
261,10910
+(defun make-lock (&optional lock-name)make-lock
273,11297
+(defmacro reset-lock (bound-symbol)reset-lock
302,12540
+(defmacro with-lock (bound-symbol &rest forms)with-lock
312,12897
+(defun run-thread (name fn-symbol &rest args)run-thread
335,13668
+(defun interrupt-thread (thread function &rest args)interrupt-thread
370,15022
+(defun kill-thread (thread)kill-thread
390,15718
+(defun all-threads ()all-threads
402,15977
+(defun current-thread ()current-thread
412,16209
+(defun thread-wait (fn &rest args)thread-wait
422,16387
+(defmacro with-potential-timeout (body &key timeout)with-potential-timeout
437,16980
+(defun make-condition-variable ()make-condition-variable
532,21197
+(defmacro signal-condition-variable (cv)signal-condition-variable
551,21762
+(defmacro broadcast-condition-variable (cv)broadcast-condition-variable
580,22863
+(defun wait-on-condition-variable (cv lock &key timeout)wait-on-condition-variable
592,23152
+(defstruct acl2-semaphoreacl2-semaphore
627,24633
+(defstruct acl2-semaphoreacl2-semaphore
633,24772
+(defun make-semaphore (&optional name)make-semaphore
638,24893
+(defun semaphorep (semaphore)semaphorep
695,27666
+(defun make-semaphore-notification ()make-semaphore-notification
722,28667
+(defun semaphore-notification-status (semaphore-notification-object)semaphore-notification-status
737,29143
+(defun clear-semaphore-notification-status (semaphore-notification-object)clear-semaphore-notification-status
754,29787
+(defun set-semaphore-notification-status (semaphore-notification-object)set-semaphore-notification-status
771,30525
+(defun signal-semaphore (semaphore)signal-semaphore
780,30877
+(defun wait-on-semaphore (semaphore &key notification timeout)wait-on-semaphore
807,31791
+(defvar *throwable-worker-thread**throwable-worker-thread*
929,37533
+(defun throw-all-threads-in-list (thread-list)throw-all-threads-in-list
943,38210
+(defun kill-all-threads-in-list (thread-list)kill-all-threads-in-list
991,40264
+(defun thread-name (thread)thread-name
1003,40635
+(defconstant *worker-thread-name* "Worker thread")*worker-thread-name*
1013,40876
+(defun worker-threads1 (threads)worker-threads1
1015,40928
+(defun worker-threads ()worker-threads
1023,41190
+(defun all-worker-threads-are-dead ()all-worker-threads-are-dead
1030,41351
+(defun all-given-threads-are-reset (threads)all-given-threads-are-reset
1037,41473
+(defun all-worker-threads-are-dead-or-reset ()all-worker-threads-are-dead-or-reset
1044,41682
+(defun send-die-to-worker-threads ()send-die-to-worker-threads
1056,42093
+(defun kill-all-worker-threads ()kill-all-worker-threads
1088,43418
+(defun core-count-raw (&optional (ctx nil) default)core-count-raw
1103,43915
+(defvar *core-count**core-count*
1123,44653
+(defvar *unassigned-and-active-work-count-limit**unassigned-and-active-work-count-limit*
1131,44892
+(defconstant *max-idle-thread-count**max-idle-thread-count*
1149,45854
+
+futures-raw.lisp,6148
+(defstruct st-futurest-future
49,1893
+(defmacro st-future (x)st-future
59,2101
+(defun st-future-read (st-future)st-future-read
69,2471
+(defun st-future-abort (st-future)st-future-abort
83,3032
+(defstruct atomic-notificationatomic-notification
199,6821
+(defstruct barrierbarrier
218,7691
+(defun broadcast-barrier (barrier)broadcast-barrier
243,8941
+(defun wait-on-barrier (barrier)wait-on-barrier
256,9451
+(defstruct mt-futuremt-future
266,9779
+(define-atomically-modifiable-counter *last-slot-saved* 0)*last-slot-saved*
277,10024
+(define-atomically-modifiable-counter *last-slot-taken* 0)*last-slot-taken*
278,10083
+(defvar *future-array*)*future-array*
295,11068
+(defvar *thread-array*)*thread-array*
296,11092
+(defvar *future-dependencies*)*future-dependencies*
297,11116
+(defparameter *future-queue-length-history**future-queue-length-history*
299,11148
+(defvar *current-thread-index**current-thread-index*
305,11241
+(defconstant *starting-core* 'start)*starting-core*
312,11416
+(defconstant *resumptive-core* 'resumptive)*resumptive-core*
313,11453
+(defvar *allocated-core**allocated-core*
315,11498
+(defvar *decremented-idle-future-thread-count* nil)*decremented-idle-future-thread-count*
338,12667
+(defvar *idle-future-core-count**idle-future-core-count*
340,12720
+(defvar *idle-future-resumptive-core-count**idle-future-resumptive-core-count*
342,12806
+(defvar *idle-core* (make-semaphore))*idle-core*
344,12908
+(define-atomically-modifiable-counter *idle-future-thread-count**idle-future-thread-count*
346,12947
+(defvar *future-added* (make-semaphore))*future-added*
365,14032
+(defvar *idle-resumptive-core* (make-semaphore))*idle-resumptive-core*
367,14074
+(defvar *threads-spawned* 0)*threads-spawned*
370,14142
+(define-atomically-modifiable-counter *unassigned-and-active-future-count**unassigned-and-active-future-count*
372,14172
+(define-atomically-modifiable-counter *total-future-count**total-future-count*
382,14524
+(defconstant *future-array-size* 200000)*future-array-size*
394,14967
+(defmacro faref (array subscript)faref
396,15009
+(defvar *resource-and-timing-based-parallelizations**resource-and-timing-based-parallelizations*
403,15243
+(defvar *resource-and-timing-based-serializations**resource-and-timing-based-serializations*
408,15429
+(defvar *resource-based-parallelizations**resource-based-parallelizations*
413,15618
+(defvar *resource-based-serializations**resource-based-serializations*
418,15782
+(defun reset-future-queue-length-history ()reset-future-queue-length-history
423,15949
+(defun reset-future-parallelism-variables ()reset-future-parallelism-variables
426,16038
+(defun reset-all-parallelism-variables ()reset-all-parallelism-variables
498,18678
+(defun futures-parallelism-buffer-has-space-available ()futures-parallelism-buffer-has-space-available
505,18992
+(defun not-too-many-futures-already-in-existence ()not-too-many-futures-already-in-existence
512,19257
+(defun futures-resources-available ()futures-resources-available
556,21331
+(defmacro unwind-protect-disable-interrupts-during-cleanupunwind-protect-disable-interrupts-during-cleanup
574,22240
+(define-atomically-modifiable-counter *threads-waiting-for-starting-core**threads-waiting-for-starting-core*
596,23131
+(defun claim-starting-core ()claim-starting-core
607,23615
+(defun claim-resumptive-core ()claim-resumptive-core
631,24705
+(defun free-allocated-core ()free-allocated-core
669,26043
+(defun early-terminate-children (index)early-terminate-children
691,26850
+(defvar *aborted-futures-via-flag* 0)*aborted-futures-via-flag*
706,27452
+(defvar *aborted-futures-total* 0)*aborted-futures-total*
707,27490
+(defvar *futures-resources-available-count* 0)*futures-resources-available-count*
710,27545
+(defvar *futures-resources-unavailable-count* 0)*futures-resources-unavailable-count*
711,27592
+(defun set-thread-check-for-abort-and-funcall (future)set-thread-check-for-abort-and-funcall
713,27642
+(defvar *throwable-future-worker-thread**throwable-future-worker-thread*
762,29825
+(defun wait-for-a-closure ()wait-for-a-closure
778,30433
+(defvar *busy-wait-var* 0)*busy-wait-var*
860,35369
+(defvar *current-waiting-thread* nil)*current-waiting-thread*
861,35396
+(defvar *fresh-waiting-threads* 0)*fresh-waiting-threads*
862,35434
+(defun make-tclet-thrown-symbol1 (tags first-tag)make-tclet-thrown-symbol1
867,35579
+(defun make-tclet-thrown-symbol (tags)make-tclet-thrown-symbol
878,35896
+(defun make-tclet-bindings1 (tags)make-tclet-bindings1
881,35990
+(defun make-tclet-bindings (tags)make-tclet-bindings
888,36178
+(defun make-tclet-thrown-tags1 (tags)make-tclet-thrown-tags1
891,36264
+(defun make-tclet-thrown-tags (tags)make-tclet-thrown-tags
897,36433
+(defun make-tclet-catches (rtags body thrown-tag-bindings)make-tclet-catches
900,36525
+(defun make-tclet-cleanups (thrown-tags cleanups)make-tclet-cleanups
910,36891
+(defmacro throw-catch-let (tags body cleanups)throw-catch-let
918,37143
+(defun eval-a-closure ()eval-a-closure
989,39646
+(defun eval-closures ()eval-closures
1044,42000
+(defun number-of-idle-threads-and-threads-waiting-for-a-starting-core ()number-of-idle-threads-and-threads-waiting-for-a-starting-core
1079,43152
+(defun spawn-closure-consumers ()spawn-closure-consumers
1088,43455
+(defun make-future-with-closure (closure)make-future-with-closure
1122,45285
+(defun add-future-to-queue (future)add-future-to-queue
1162,47400
+(defmacro mt-future (x)mt-future
1174,47732
+(defun mt-future-read (future)mt-future-read
1265,51772
+(defvar *aborted-futures-via-throw* 0)*aborted-futures-via-throw*
1312,53815
+(defvar *almost-aborted-future-count* 0)*almost-aborted-future-count*
1313,53854
+(defun mt-future-abort (future)mt-future-abort
1315,53896
+(defun abort-future-indices (indices)abort-future-indices
1387,57344
+(defun print-non-nils-in-array (array n)print-non-nils-in-array
1401,57856
+(defun futures-still-in-flight ()futures-still-in-flight
1410,58135
+(defmacro future (x)future
1422,58485
+(defun future-read (x)future-read
1425,58526
+(defun future-abort (x)future-abort
1428,58572
+(defun abort-futures (futures)abort-futures
1431,58620
+
+parallel-raw.lisp,4364
+(defstruct parallelism-piece ; piece of workparallelism-piece
213,9963
+(defparameter *reset-parallelism-variables* nil)*reset-parallelism-variables*
348,16353
+(defparameter *reset-core-count-too**reset-core-count-too*
350,16403
+(defun reset-parallelism-variables ()reset-parallelism-variables
360,16828
+(defun eval-and-save-result (work)eval-and-save-result
422,18939
+(defun pop-work-and-set-thread ()pop-work-and-set-thread
440,19673
+(defun consume-work-on-work-queue-when-there ()consume-work-on-work-queue-when-there
471,21080
+(defun spawn-worker-threads-if-needed ()spawn-worker-threads-if-needed
617,28131
+(defun add-work-list-to-queue (work-list)add-work-list-to-queue
661,30311
+(defun combine-array-results-into-list (result-array current-position acc)combine-array-results-into-list
685,31421
+(defun remove-thread-array-from-work-queue-recremove-thread-array-from-work-queue-rec
695,31745
+(defun remove-thread-array-from-work-queue (thread-array)remove-thread-array-from-work-queue
729,33013
+(defun terminate-siblings (thread-array)terminate-siblings
738,33336
+(defun generate-work-list-from-closure-list-recgenerate-work-list-from-closure-list-rec
751,33974
+(defun generate-work-list-from-closure-listgenerate-work-list-from-closure-list
771,34835
+(defun pargs-parallelism-buffer-has-space-available ()pargs-parallelism-buffer-has-space-available
799,35995
+(defun not-too-many-pieces-of-parallelism-work-already-in-existence ()not-too-many-pieces-of-parallelism-work-already-in-existence
803,36176
+(defun parallelism-resources-available ()parallelism-resources-available
814,36751
+(defun throw-threads-in-array (thread-array current-position)throw-threads-in-array
832,37681
+(defun decrement-children-left (children-left-ptr semaphore-notification-obj)decrement-children-left
861,39140
+(defun wait-for-children-to-finishwait-for-children-to-finish
869,39459
+(defun wait-for-resumptive-parallelism-resources ()wait-for-resumptive-parallelism-resources
887,40210
+(defun early-terminate-children-and-rewaitearly-terminate-children-and-rewait
907,41150
+(defun prepare-to-wait-for-children ()prepare-to-wait-for-children
940,42428
+(defun parallelize-closure-list (closure-list &optional terminate-early-function)parallelize-closure-list
959,43169
+(defun parallelize-fn (parent-fun-name arg-closures &optional terminate-early-function)parallelize-fn
1069,48024
+(defmacro closure-for-expression (x)closure-for-expression
1085,48731
+(defmacro closure-list-for-expression-list (x)closure-list-for-expression-list
1088,48799
+(defun parallelism-condition (gran-form-exists gran-form)parallelism-condition
1097,49082
+(defmacro pargs (&rest forms)pargs
1107,49401
+(defun plet-doublets (bindings bsym n)plet-doublets
1127,50104
+(defun make-closures (bindings)make-closures
1134,50313
+(defun identity-list (&rest rst) rst)identity-list
1147,50810
+(defun make-list-until-non-declare (remaining-list acc)make-list-until-non-declare
1149,50849
+(defun parse-additional-declare-forms-for-let (x)parse-additional-declare-forms-for-let
1155,51114
+(defmacro plet (&rest forms)plet
1165,51510
+(defmacro pand (&rest forms)pand
1189,52475
+(defmacro por (&rest forms)por
1210,53261
+(defun signal-semaphores (sems)signal-semaphores
1232,54030
+(defmacro spec-mv-let (bindings computation body)spec-mv-let
1238,54184
+(defun number-of-active-threads-aux (threads acc)number-of-active-threads-aux
1277,55525
+(defun number-of-active-threads ()number-of-active-threads
1289,55865
+(defun number-of-threads-waiting-on-a-child-aux (threads acc)number-of-threads-waiting-on-a-child-aux
1292,55951
+(defun number-of-threads-waiting-on-a-child ()number-of-threads-waiting-on-a-child
1304,56335
+(defun future-queue-length ()future-queue-length
1307,56445
+(defun total-number-of-threads ()total-number-of-threads
1325,57206
+(defvar *refresh-rate-indicator* 0)*refresh-rate-indicator*
1328,57267
+(defmacro value-of-symbol (var)value-of-symbol
1330,57304
+(defun acl2p-sum-list1 (lst acc)acl2p-sum-list1
1344,57930
+(defun acl2p-sum-list (lst)acl2p-sum-list
1350,58086
+(defun average-future-queue-size ()average-future-queue-size
1357,58241
+(defun print-interesting-parallelism-variables-str ()print-interesting-parallelism-variables-str
1361,58391
+(defun print-interesting-parallelism-variables ()print-interesting-parallelism-variables
1420,60474
+
+serialize-raw.lisp,3484
+(defparameter *ser-verbose* nil)*ser-verbose*
269,12198
+(defmacro ser-time? (form)ser-time?
271,12232
+(defmacro ser-print? (msg &rest args)ser-print?
276,12314
+(defmacro ser-write-char (x stream)ser-write-char
290,12862
+(defmacro ser-write-byte (x stream)ser-write-byte
293,12943
+(defmacro ser-read-char (stream)ser-read-char
296,13048
+(defmacro ser-read-byte (stream)ser-read-byte
301,13275
+(defun ser-encode-magic (stream)ser-encode-magic
304,13373
+(defun ser-decode-magic (stream)ser-decode-magic
311,13607
+(defun ser-encode-nat-fixnum (n stream)ser-encode-nat-fixnum
371,16345
+(defun ser-encode-nat-large (n stream)ser-encode-nat-large
387,16885
+(defmacro ser-encode-nat (n stream)ser-encode-nat
405,17568
+(defun ser-decode-nat-large (shift value stream)ser-decode-nat-large
417,17885
+(defmacro ser-decode-nat-body (shift)ser-decode-nat-body
435,18544
+(defun ser-decode-nat (stream)ser-decode-nat
469,19951
+(defun ser-encode-rat (x stream)ser-encode-rat
498,20874
+(defun ser-decode-rat (stream)ser-decode-rat
504,21070
+(defun ser-encode-complex (x stream)ser-encode-complex
533,22164
+(defun ser-decode-complex (stream)ser-decode-complex
538,22310
+(defun ser-encode-str (x stream)ser-encode-str
564,23389
+(defun ser-decode-str (version hons-mode stream)ser-decode-str
573,23727
+(defstruct ser-decoderser-decoder
605,24863
+(defun ser-encode-nats (x stream)ser-encode-nats
624,25485
+(defun ser-decode-and-load-nats (decoder stream)ser-decode-and-load-nats
631,25686
+(defun ser-encode-rats (x stream)ser-encode-rats
651,26435
+(defun ser-decode-and-load-rats (decoder stream)ser-decode-and-load-rats
658,26637
+(defun ser-encode-complexes (x stream)ser-encode-complexes
677,27321
+(defun ser-decode-and-load-complexes (decoder stream)ser-decode-and-load-complexes
684,27532
+(defun ser-encode-chars (x stream)ser-encode-chars
703,28217
+(defun ser-decode-and-load-chars (decoder stream)ser-decode-and-load-chars
710,28421
+(defun ser-encode-strs (x stream)ser-encode-strs
729,29094
+(defun ser-decode-and-load-strs (hons-mode decoder stream)ser-decode-and-load-strs
736,29294
+(defun ser-encode-package (pkg x stream)ser-encode-package
780,31261
+(defun ser-decode-and-load-package (check-packagesp decoder stream)ser-decode-and-load-package
789,31570
+(defun ser-encode-packages (alist stream)ser-encode-packages
817,32914
+(defun ser-decode-and-load-packages (check-packagesp decoder stream)ser-decode-and-load-packages
825,33238
+(defun ser-hashtable-init (size test)ser-hashtable-init
841,33776
+(defstruct ser-encoderser-encoder
854,34211
+(defmacro ser-see-obj (x table)ser-see-obj
924,37257
+(defun ser-gather-atoms (x encoder)ser-gather-atoms
934,37510
+(defun ser-make-atom-map (encoder)ser-make-atom-map
1070,43758
+(defun ser-encode-consesser-encode-conses
1178,48408
+(defmacro ser-decode-loop (version hons-mode)ser-decode-loop
1230,50856
+(defun ser-decode-and-load-conses (hons-mode decoder stream)ser-decode-and-load-conses
1267,52419
+(defun ser-encode-fals (encoder)ser-encode-fals
1355,56706
+(defun ser-decode-and-restore-fals (decoder hons-mode stream)ser-decode-and-restore-fals
1383,57845
+(defun ser-encode-atoms (encoder)ser-encode-atoms
1410,59185
+(defun ser-encode-to-stream (obj stream)ser-encode-to-stream
1425,59808
+(defun ser-decode-and-load-atoms (check-packagesp hons-mode decoder stream)ser-decode-and-load-atoms
1498,62752
+(defun ser-decode-from-stream (check-packagesp hons-mode stream)ser-decode-from-stream
1508,63170
diff -Nru acl2-6.2/acl2-check.lisp acl2-6.3/acl2-check.lisp
--- acl2-6.2/acl2-check.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/acl2-check.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/acl2-fns.lisp acl2-6.3/acl2-fns.lisp
--- acl2-6.2/acl2-fns.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/acl2-fns.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -20,6 +20,10 @@
 
 (in-package "ACL2")
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;                            PRELIMINARIES
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defmacro qfuncall (fn &rest args)
 
 ; Avoid noise in CCL about undefined functions, not avoided by funcall alone.
@@ -33,6 +37,73 @@
     #-(and cltl2 (not cmu) (not gcl))
     `(funcall ',fn ,@args)))
 
+(defmacro defun-one-output (&rest args)
+
+; Use this for raw Lisp functions that are known to return a single value in
+; raw Lisp, since make-defun-declare-form uses that assumption to make an
+; appropriate declaration.
+
+  (cons 'defun args))
+
+; The following alist associates package names with Common Lisp packages, and
+; is used in function find-package-fast, which is used by princ$ in place of
+; find-package in order to save perhaps 15% of the print time.
+(defparameter *package-alist* nil)
+
+(defun-one-output find-package-fast (string)
+  (or (cdr (assoc string *package-alist* :test 'equal))
+      (let ((pkg (find-package string)))
+        (push (cons string pkg) *package-alist*)
+        pkg)))
+
+(defvar *global-symbol-key* (make-symbol "*GLOBAL-SYMBOL-KEY*"))
+
+(defun global-symbol (x)
+  (or (get x *global-symbol-key*)
+      (setf (get x *global-symbol-key*)
+            (intern (symbol-name x)
+                    (find-package-fast
+                     (concatenate 'string
+                                  *global-package-prefix*
+                                  (symbol-package-name x)))))))
+
+(defmacro live-state-p (x)
+  (list 'eq x '*the-live-state*))
+
+#-acl2-loop-only
+(defun get-global (x state-state)
+
+; Keep this in sync with the #+acl2-loop-only definition of get-global (which
+; doesn't use qfuncall).
+
+  (cond ((live-state-p state-state)
+         (return-from get-global
+                      (symbol-value (the symbol (global-symbol x))))))
+  (cdr (assoc x (qfuncall global-table state-state))))
+
+(defmacro f-get-global (x st)
+  (cond ((and (consp x)
+              (eq 'quote (car x))
+              (symbolp (cadr x))
+              (null (cddr x)))
+
+; The cmulisp compiler complains about unreachable code every (perhaps) time
+; that f-get-global is called in which st is *the-live-state*.  The following
+; optimization is included primarily in order to eliminate those warnings;
+; the extra efficiency is pretty minor, though a nice side effect.
+
+         (if (eq st '*the-live-state*)
+             `(let ()
+                (declare (special ,(global-symbol (cadr x))))
+                ,(global-symbol (cadr x)))
+           (let ((s (gensym)))
+             `(let ((,s ,st))
+                (declare (special ,(global-symbol (cadr x))))
+                (cond ((live-state-p ,s)
+                       ,(global-symbol (cadr x)))
+                      (t (get-global ,x ,s)))))))
+        (t `(get-global ,x ,st))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;                            SUPPORT FOR NON-STANDARD ANALYSIS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -109,57 +180,79 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ; The variable acl2::*do-proclaims* determines whether or not we proclaim ACL2
-; functions before compiling them.  Normally this seems to improve performance,
-; though we believe that such proclaiming had the opposite effect for some
-; combination of ACL2 and Allegro CL; see comment in proclaim-file.
-
-; The constant acl2::*suppress-compile-build-time* determines whether or not we
-; avoid calling the compiler.  If this variable is false, then in compile-acl2
-; we load each source file, then proclaim it, and finally compile it.  But we
-; skip all that when acl2::*suppress-compile-build-time* is true; we can't
-; proclaim before loading because macros may not all have been defined, and it
-; seems dicey to do the sequence load,proclaim,load because the second load
-; redefines functions.  So in this case, we instead do the build by first
-; optionally (though required in GCL) calling generate-acl2-proclaims to do the
-; entire load/initialization sequence and write out file acl2-proclaims.lisp.
-; At the makefile level (see GNUmakefile), this sequence is accomplished with
+; functions before compiling them.  The intent of proclaiming is to improve
+; performance, though we once observed proclaiming to have had the opposite
+; effect for some combination of ACL2 and Allegro CL; see a comment in
+; proclaim-file.
+
+; In compile-acl2 we load each source file, then proclaim it, and finally
+; compile it, provided acl2::*suppress-compile-build-time* is false.  in
+; compile-acl2 we load each source file, then proclaim it, and finally
+; Otherwise we skip all that: we can't proclaim before loading because macros
+; may not all have been defined, and it seems dicey to do the sequence
+; load,proclaim,load because the second load redefines functions.  So in this
+; case, we could do the build as follow (though this isn't the default; see
+; variable ACL2_PROCLAIMS_ACTION in GNUmakefile): first call
+; generate-acl2-proclaims to do the entire load/initialization sequence, then
+; write out file acl2-proclaims.lisp, then compile again using that file.  At
+; the makefile level (see GNUmakefile), this sequence is accomplished with
 ; target "large" as follows: target "full" does a compile (basically a no-op if
 ; *suppress-compile-build-time* is true), then target "init" first invokes
 ; target "make-acl2-proclaims" to do the load/initialization and writing out of
 ; file acl2-proclaims.lisp, and finally "init" does a new load/initialization
 ; but this time loading the existing acl2-proclaims.lisp to proclaim functions.
 
+; We considered using the above two-step process for GCL, expecting that better
+; proclaim forms would be generated after doing initialization of the
+; boot-strap world, since our code that generates proclaims tries to take
+; advantage of stobjs-out properties.  However, we found (August 8, 2013) that
+; the generated proclaim forms were the same whether we did that, or we merely
+; generated them during the load/proclaim/compile of each source file.  So, we
+; do the latter, which speeds up the build (see :DOC note-6-3).
+
 ; At one time we proclaimed for CCL, but one profiling run of a
 ; compute-intensive include-book form showed that this was costing us some 10%
 ; of the time.  After checking with Gary Byers we decided that there was little
 ; if any benefit in CCL for proclaiming functions, so we no longer do it.
-; Perhaps we should reconsider some time.
+; Perhaps we should reconsider some time; in fact we have done so on 8/9/2013
+; (see comments below in *do-proclaims*).
 
 ; We considered adding &OPTIONAL to the end of every VALUES form (see comments
 ; below), based on output (since forgotten) from SBCL.  But GCL issued several
 ; dozen warnings during the build when this happened, so for now, since we are
-; only proclaiming functions for GCL, we'll remove the &optional and be happy.
+; only proclaiming functions for GCL, we omit the &optional.
 
 (defvar *do-proclaims*
-  #+gcl t
-  #-gcl nil)
 
-(defmacro defun-one-output (&rest args)
+; We may want to experiment for proclaiming with other Lisps besides GCL.  But
+; this might not be a good idea, in particular for Allegro CL and CCL (see
+; above).
+
+; In fact we experimented with CCL and ACL2(h) on 8/9/2013, by temporarily
+; setting this variable to T.  We got these results from "time" for make -j 8
+; with target regression-fresh on dunnottar.cs.utexas.edu.  The results are
+; inconclusive, so we keep things simple (and avoid stepping on the possibility
+; of future CCL improvements) by the lskipping of function proclaiming in CCL.
+
+; Built as follows (not showing here the setting PREFIX=):
+;   make ACL2_HONS=h LISP=ccl-trunk ACL2_SIZE=3000000
+; 27815.314u 1395.775s 1:09:03.35 705.0%        0+0k 2008+1736952io 34pf+0w
+
+; Built as follows (not showing here the setting PREFIX=):
+;   make ACL2_HONS=h LISP=ccl-trunk ACL2_SIZE=3000000 \
+;     ACL2_PROCLAIMS_ACTION=generate_and_reuse
+; 27272.420u 1401.555s 1:09:11.18 690.7%        0+0k 333088+1750384io 303pf+0w
 
-; Use this for raw Lisp functions that are known to return a single value in
-; raw Lisp, since make-defun-declare-form uses that assumption to make an
-; appropriate declaration.
-
-  (cons 'defun args))
+  #+gcl t
+  #-gcl nil)
 
 (defun macroexpand-till (form sym)
 
-; In order to find the THEs that we want to find to do automatic
-; proclaiming of the output types of functions, we need to do
-; macroexpansion at proclaim-time.  It is possible that a given
-; implementation of Common Lisp will macroexpand THE forms further.
-; Hence we gently do the macroexpansion we need, one expansion at a
-; time, looking for the THE we want to find.
+; In order to find the THEs that we want to find to do automatic proclaiming of
+; the output types of functions, we need to do macroexpansion at proclaim-time.
+; It is possible that a given implementation of Common Lisp will macroexpand
+; THE forms further.  Hence we gently do the macroexpansion we need, one
+; expansion at a time, looking for the THE we want to find.
 
   (loop (cond ((and (consp form) (eq (car form) sym))
                (return form))
@@ -624,10 +717,22 @@
          (eval form)))))
 
 (defun proclaim-form (form &optional stream)
+
+; We assume that this function is called under proclaim-file, which binds
+; *package*.  See the comment below for the in-package case.
+
   (when *do-proclaims*
     (cond ((consp form)
            (case (car form)
-             ((in-package) (eval-or-print form stream) nil)
+             ((in-package)
+              (eval-or-print form stream)
+              (when stream
+
+; We make sure that when we're merely printing, nevertheless we are in the
+; correct package as we read the rest of the file.
+
+                (eval form))
+              nil)
              ((defmacro defvar defparameter) nil)
              ((defconst)
               (eval-or-print (make-defconst-declare-form form) stream)
@@ -669,8 +774,8 @@
 ; Lisps other than GCL.  However, our tests in Allegro suggested that this may
 ; not help.  The comment below gives some details.  Perhaps we will proclaim
 ; for MCL in the future.  At any rate, CCL (OpenMCL) is supported starting with
-; Version_2.8, and we proclaim there since Warren Hunt thought that might be
-; useful.
+; Version_2.8.  We tried proclaiming for that Lisp, but no longer do so; see
+; Section "PROCLAIMING" above.
 
 ; Here is a summary of three comparable user times from certifying all the ACL2
 ; books in June 2000, just before Release 2.5 is complete.  The first column,
@@ -917,18 +1022,24 @@
          (val (and (symbolp sym)
                    (qfuncall fgetprop sym 'const nil
                              (qfuncall w *the-live-state*)))))
-    (if val
-        (cond ((and (consp val)
-                    (eq (car val) 'quote)
-                    (consp (cdr val))
-                    (null (cddr val)))
-               (cadr val))
-              (t (error "(Implementation error) Found non-quotep 'const ~%~
-                         property for ~s."
-                        sym)))
+    (cond
+     (val
+      (cond ((and (consp val)
+                  (eq (car val) 'quote)
+                  (consp (cdr val))
+                  (null (cddr val)))
+             (cadr val))
+            (t (error "(Implementation error) Found non-quotep 'const ~%~
+                       property for ~s."
+                      sym))))
+     (sym
+      (error "ACL2 supports #. syntax only for #.*a*, where *a* has been ~%~
+              defined by ~s.  Thus the form #.~s is illegal."
+             'defconst sym))
+     (t ; surprising case
       (error "ACL2 supports #. syntax only for #.*a*, where *a* has been ~%~
               defined by ~s."
-             'defconst))))
+             'defconst)))))
 
 (defun sharp-bang-read (stream char n)
 
@@ -1257,7 +1368,8 @@
 ; Finally, consider namestringp.  If nil, then as above we either return nil or
 ; the truename (a pathname object).  Otherwise, we return the namestring of
 ; such a truename, with the following treatment if that truename is nil: return
-; nil if namestringp is :safe, else cause an error.
+; nil if namestringp is :safe, else cause an error, where if namestringp is a
+; msgp then incorporate it into the error message.
 
   (when (pathnamep filename)
     (setq filename (namestring filename)))
@@ -1296,8 +1408,11 @@
            (cond ((eq namestringp :safe) nil)
                  (t (qfuncall
                      interface-er
-                     "Unable to obtain the truename of file ~x0."
-                     filename))))
+                     "Unable to obtain the truename of file ~x0.~@1"
+                     filename
+                     (if (qfuncall msgp namestringp)
+                         (qfuncall msg "  ~@0" namestringp)
+                       "")))))
           (t (namestring truename)))))
 
 (defun our-pwd ()
@@ -1307,7 +1422,7 @@
 ; make invokes another make in a different directory.
 
   (qfuncall pathname-os-to-unix
-            (our-truename "" t)
+            (our-truename "" "Note: Calling OUR-TRUENAME from OUR-PWD.")
             (get-os)
             *the-live-state*))
 
@@ -1453,23 +1568,6 @@
   #-hons
   def-form)
 
-(defun our-function-lambda-expression (sym)
-
-; This is intended only for #+hons; otherwise it reduces to (mv
-; (function-lambda-expression (symbol-function sym)) nil).
-
-  #-cltl2
-  (declare (ignore sym))
-  #-cltl2
-  (mv nil nil)
-  #+cltl2
-  (let ((temp (get sym 'acl2-saved-def)))
-    (cond (temp (values temp t))
-          (t (let* ((fn (symbol-function sym))
-                    (lam (and fn (function-lambda-expression fn))))
-               (cond (lam (values lam nil))
-                     (t (values nil nil))))))))
-
 ; [Comment from Jared]: We probably should work toward getting rid of
 ; defg/defv's in favor of regular parameters...
 
diff -Nru acl2-6.2/acl2-init.lisp acl2-6.3/acl2-init.lisp
--- acl2-6.2/acl2-init.lisp	2013-06-07 03:22:46.000000000 +0000
+++ acl2-6.3/acl2-init.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -358,14 +358,16 @@
            (apply v rst)))))
 
 (defun system-call (string arguments)
-  #+akcl
+
+; Warning: Keep this in sync with system-call+.
+
+  #+gcl
   (si::system
    (let ((result string))
      (dolist
       (x arguments)
       (setq result (concatenate 'string result " " x)))
      result))
-  #+lucid (user::run-program string :arguments arguments)
   #+lispworks
   (system::call-system
    (let ((result string))
@@ -425,9 +427,9 @@
                   (integerp (cadr status))))
         1 ; just some non-zero exit code here
       (cadr status)))
-  #-(or akcl lucid lispworks allegro cmu sbcl clisp ccl)
+  #-(or gcl lispworks allegro cmu sbcl clisp ccl)
   (declare (ignore string arguments))
-  #-(or akcl lucid lispworks allegro cmu sbcl clisp ccl)
+  #-(or gcl lispworks allegro cmu sbcl clisp ccl)
   (error "SYSTEM-CALL is not yet defined in this Lisp."))
 
 (defun copy-acl2 (dir)
@@ -502,7 +504,9 @@
          (setq source-directory
                (subseq source-directory 0 (1- (length source-directory))))))
   (cond ((not (equal (our-truename (format nil "~a/" source-directory) :safe)
-                     (our-truename "" t)))
+                     (our-truename
+                      ""
+                      "Note: Calling OUR-TRUENAME from COPY-DISTRIBUTION.")))
          (error "We expected to be in the directory~%~s~%~
                  but instead are apparently in the directory~%~s .~%~
                  Either issue, in Unix, the command~%~
@@ -680,26 +684,41 @@
 (defvar *saved-build-date-lst*)
 (defvar *saved-mode*)
 
-(defconstant *acl2-svn-revision-string*
-  "~% WARNING: Do not redistribute.  This is NOT an ACL2 release; it is,~
-   ~% rather, an svn distribution, ~a.~
-   ~% The authors of ACL2 consider svn distributions to be experimental.~%")
-
-(defun acl2-svn-revision-string ()
-
-; Put symbol :release into file acl2-startup-info.txt before doing a release.
-; Otherwise, we expect that file to start with a string of the form
-; "$Revision: n $".
+(defun svn-revision-from-line (s)
+
+; S is a string such as "$Revision: 1053 $" (as in acl2-startup-info.txt) or
+; "Revision: 1998" (as printed by "svn info").  In general, it is a string for
+; which we want the object that is read immediately after the first #\: .  If
+; there is none, then we return nil.
+
+  (let ((p (position #\: s)))
+    (and p
+         (read-from-string s nil nil :start (1+ p)))))
 
+(defconstant *acl2-svn-revision-string*
   (let ((file "acl2-startup-info.txt"))
     (cond ((probe-file file)
            (let ((val (with-open-file
                        (str file :direction :input)
                        (read str))))
              (cond ((eq val :release)
-                    "")
+                    nil)
                    ((stringp val)
-                    (format nil *acl2-svn-revision-string* val))
+                    (let ((n (svn-revision-from-line val)))
+                      (or n (error "Unexpected error in getting svn revision ~
+                                    from string:~%~s~%"
+                                   val))
+                      (format nil
+                              "
+ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ + WARNING: This is NOT an ACL2 release; it is svn revision ~a.     +
+ + The authors of ACL2 consider svn distributions to be experimental; +
+ + they may be incomplete, fragile, and unable to pass our own        +
+ + regression.  Bug reports should include the following line:        +
+ +   ACL2 svn revision ~a; community books svn revision ~a        +
+ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+"
+                              n n "~a")))
                    (t (error "Illegal value in file ~s: ~s"
                              file val)))))
           (t (error "File ~s appears not to exist." file)))))
@@ -713,10 +732,13 @@
     ~% are welcome to redistribute it under certain conditions.  For details,~
     ~% see the LICENSE file distributed with ACL2.~%"
 
-; The following is empty if acl2-startup-info.txt begins with the symbol
-; :release.
+   (or *acl2-svn-revision-string*
+
+; If acl2-startup-info.txt begins with the symbol :release, then
+; *acl2-svn-revision-string* is a string with ~a expecting to be bound to the
+; svn revision of the books.  Otherwise we put "~a" here to be bound to "".
 
-   (acl2-svn-revision-string)
+       "~a")
 
    "~a"
    #+hons
@@ -760,6 +782,22 @@
         #+cltl2 'with-standard-io-syntax
         args))
 
+(defun user-args-string (inert-args &optional (separator '"--"))
+
+; This function is used when saving executable scripts, which may specify that
+; certain command line arguments are not to be processed by Lisp (other than to
+; affect the value of a variable or function such as
+; ccl::*unprocessed-command-line-arguments*; see books/oslib/argv.lisp).  Also
+; see :doc save-exec.  A common convention is that arguments after `--' are not
+; processed by Lisp.
+
+  (cond ((null inert-args)
+         "\"$@\"")
+        ((eq inert-args t)
+         (concatenate 'string separator " \"$@\""))
+        (t
+         (concatenate 'string separator " " inert-args " \"$@\""))))
+
 (defmacro write-exec-file (stream prefix string &rest args)
 
 ; Prefix is generally nil, but can be (string . fmt-args).  String is the
@@ -788,10 +826,92 @@
             ,string
             ,@args)))
 
+(defun proclaim-files (&optional outfilename infilename infile-optional-p)
+
+; IMPORTANT: This function assumes that the defconst and defmacro forms in the
+; given files have already been evaluated.  One way to achieve this state of
+; affairs, of course, is to load the files first.
+
+  (when (and outfilename infilename)
+    (error "It is illegal to supply non-nil values for both optional ~
+            arguments of proclaim-files."))
+  (when (not *do-proclaims*)
+    (return-from proclaim-files nil))
+  (cond
+   (outfilename
+    (format t
+            "Writing proclaim forms for ACL2 source files to file ~s.~%"
+            outfilename))
+   (t
+    (when infilename
+        (cond ((probe-file infilename)
+               (format t
+                       "Loading nontrivial generated file of proclaim forms, ~
+                        ~s...~%"
+                       infilename)
+               (load infilename)
+               (format t
+                       "Completed load of ~s.~%"
+                       infilename)
+               (return-from proclaim-files nil))
+              (infile-optional-p) ; fall through as though infilename is nil
+              (t (error "File ~s is to be loaded by proclaim-files, but does ~
+                         not exist."
+                        infilename))))
+       (format t
+            "Generating and evaluating proclaim forms for ACL2 source ~
+             files.~%")))
+  (let (str)
+    (when outfilename
+      (if (probe-file outfilename)
+          (delete-file outfilename))
+      (or (setq str (safe-open outfilename :direction :output))
+          (error "Unable to open file ~s for output." outfilename)))
+
+; It is tempting to print an in-package form, but we leave that task to
+; proclaim-file, which presumably finds the first form to be an in-package
+; form.
+
+    (dolist (fl *acl2-files*)
+      (proclaim-file (format nil "~a.lisp" fl) str))
+    (when str ; equivalently, when outfilename is non-nil
+      (close str))))
+
+(defun insert-string (s)
+  (cond ((null s) "")
+        (t (concatenate 'string " " s))))
+
+#+gcl
+(defvar *saved-system-banner*
+
+; This variable is only used in GCL 2.6.9 and later, and the following comments
+; pertain only to that case.
+
+; Set this variable to nil before save-exec in order to save an image without a
+; GCL startup banner, as this will leave si::*system-banner* unbound; see
+; below.
+
+; ACL2 keeps this value at nil except when acl2-default-restart unbinds
+; si::*system-banner*, in which case *saved-system-banner* is set to the value
+; of si::*system-banner* just before that unbinding takes place.  When
+; save-exec saves an image, it first checks whether si::*system-banner* is
+; unbound and *saved-system-banner* is non-nil, in which case it sets
+; si::*system-banner* to *saved-system-banner*.  Even if si::*system-banner* is
+; bound, *saved-system-banner* is set to nil before saving an image.
+
+  nil)
+
 #+akcl
 (defun save-acl2-in-akcl-aux (sysout-name gcl-exec-name
                                           write-worklispext
-                                          set-optimize-maximum-pages)
+                                          set-optimize-maximum-pages
+                                          host-lisp-args
+                                          inert-args)
+  (when (and (gcl-version-> 2 6 9 t)
+             *saved-system-banner*)
+    (when (not (boundp 'si::*system-banner*)) ; true, unless user intervened
+      (setq si::*system-banner* *saved-system-banner*))
+    (setq *saved-system-banner* nil))
   (if (and write-worklispext (probe-file "worklispext"))
       (delete-file "worklispext"))
   (let* ((ext "gcl")
@@ -812,7 +932,10 @@
     (if (probe-file gcl-exec-file)
         (delete-file gcl-exec-file))
     (with-open-file (str sysout-name :direction :output)
-                    (write-exec-file str nil "~s $*~%" gcl-exec-file))
+                    (write-exec-file str nil "~s~s ~a~%"
+                                     gcl-exec-file
+                                     (insert-string host-lisp-args)
+                                     (user-args-string inert-args)))
     (cond ((and set-optimize-maximum-pages
                 (boundp 'si::*optimize-maximum-pages*))
 
@@ -961,14 +1084,6 @@
             (lp)))
   (load "akcl-acl2-trace.lisp")
 
-; The following is important so that ACL2 functions are efficient in certain
-; situations.  For example, (aref1 'foo foo n) should avoid boxing a fixnum n.
-
-  (cond (*suppress-compile-build-time*
-         (load "acl2-proclaims.lisp")
-         (load-acl2))
-        (t (proclaim-files)))
-
 ; Return to normal allocation growth.  Keep this in sync with load-acl2, which
 ; had presumably already set the allocation growth to be particularly slow.
 
@@ -979,7 +1094,10 @@
 ; In akcl, at least some versions of it, we cannot call allocate-growth on the
 ; following two types.
 
-          #+gcl contiguous
+; Camm Maguire has told us on 9/22/2013 that certain allocations for contiguous
+; pages, as we now do in acl2.lisp for GCL 2.6.10 and later (which includes GCL
+; 2.6.10pre as of 9/22/2013).
+;          #+gcl contiguous
           #+gcl relocatable
           )
    do
@@ -991,7 +1109,10 @@
     (t (si::allocate-growth type 0 0 0))))
 
 ;  (print "Start (si::gbc nil)") ;debugging GC
-  (si::set-hole-size 500) ; wfs suggestion
+
+; Camm Maguire suggests leaving the hole size alone for GCL 2.6.10pre as of
+; 9/22/2013:
+;  (si::set-hole-size 500) ; wfs suggestion
 
 ; Camm Maguire says (7/04) that "the gc algorithm skips over any pages which
 ; have not been written to since sgc-on was invoked.  So gc really needs to be
@@ -1032,7 +1153,10 @@
                        n))
           do (setq new-hole-size (+ new-hole-size (- n space))))
 ;    (print "Set hole size") ;debugging
-    (si::set-hole-size new-hole-size))
+; Camm Maguire suggests leaving the hole size alone for GCL 2.6.10pre as of
+; 9/22/2013:
+;    (si::set-hole-size new-hole-size)
+    )
 
 ; The calculation above is legacy.  Now we increment the hole size to 20% of
 ; max-pages instead of the default 10%.  Camm Maguire says that "Larger values
@@ -1040,21 +1164,24 @@
 ; part of the virtual (not resident) memory size, rather than being saved to
 ; disk.
 
-  (let ((new-size (floor si:*lisp-maxpages* 5)))
-    (if (< (si:get-hole-size) new-size)
-        (si::set-hole-size new-size)))
+; Camm Maguire suggests leaving the hole size alone for GCL 2.6.10pre as of
+; 9/22/2013:
+;  (let ((new-size (floor si:*lisp-maxpages* 5)))
+;    (if (< (si:get-hole-size) new-size)
+;        (si::set-hole-size new-size)))
 
 ;  (print (true-listp (w *the-live-state*))) ;swap in the world's pages
 
 ;  (print "Save the system") ;debugging
   (when (not do-not-save-gcl)
-    (save-acl2-in-akcl-aux sysout-name gcl-exec-name t t)))
+    (save-acl2-in-akcl-aux sysout-name gcl-exec-name t t nil nil)))
 
 #+akcl
-(defun save-exec-raw (sysout-name)
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)
   (setq *acl2-allocation-alist* nil) ; Don't meddle with allocations.
   (setq *acl2-default-restart-complete* nil)
-  (save-acl2-in-akcl-aux sysout-name sysout-name nil nil))
+  (save-acl2-in-akcl-aux sysout-name sysout-name nil nil host-lisp-args
+                         inert-args))
 
 (defvar *acl2-default-restart-complete* nil)
 
@@ -1082,10 +1209,28 @@
       (setq *default-pathname-defaults* p)))
   nil)
 
+(defvar *print-startup-banner*
+
+; One might want to set this variable to nil in raw Lisp before calling
+; save-exec, in order to avoid seeing startup information.  We do not comment
+; here on whether that is legally appropriate; for example, it suppresses
+; copyright information for ACL2 and, for CCL at least, information about the
+; host Lisp.  We also do not guarantee that this behavior (suppressing printing
+; of startup information) is supported for every host Lisp.
+
+; Note that LD always prints some startup information, regardless of the value
+; of *print-startup-banner*.  To suppress that information, evaluate
+; (set-ld-verbose nil state) in the ACL2 loop.
+
+  t)
+
+(defvar *lp-ever-entered-p* nil)
+
 (defun acl2-default-restart ()
   (if *acl2-default-restart-complete*
       (return-from acl2-default-restart nil))
 
+  (setq *lp-ever-entered-p* nil)
   (#+cltl2
    common-lisp-user::acl2-set-character-encoding
    #-cltl2
@@ -1099,19 +1244,44 @@
 ; In CCL, print greeting now, rather than upon first re-entry to ACL2 loop.
 ; Here we follow a suggestion from Gary Byers.
 
-    (format t "~&Welcome to ~A ~A!~%"
-            (lisp-implementation-type)
-            (lisp-implementation-version))
+    (when *print-startup-banner*
+      (format t "~&Welcome to ~A ~A!~%"
+              (lisp-implementation-type)
+              (lisp-implementation-version)))
     (setq ccl::*inhibit-greeting* t))
+
+  #+gcl
+  (progn
+
+; Some recent versions of GCL (specifically, 2.6.9 in Sept. 2013) do not print
+; the startup banner until we first exit the loop.  So we handle that situation
+; much as we handle a similar issue for CCL above, following GCL source file
+; lsp/gcl_top.lsp.
+
+    (when (and *print-startup-banner*
+               (gcl-version-> 2 6 9 t)
+               (boundp 'si::*system-banner*))
+      (format t si::*system-banner*)
+      (setq *saved-system-banner* si::*system-banner*)
+      (makunbound 'si::*system-banner*)
+      (when (boundp 'si::*tmp-dir*)
+        (format t "Temporary directory for compiler files set to ~a~%"
+                si::*tmp-dir*))))
+
   #+hons (qfuncall acl2h-init)
-  (format t *saved-string*
-          *copy-of-acl2-version*
-          (saved-build-dates :terminal)
-          (cond (*saved-mode*
-                 (format nil "~% Initialized with ~a." *saved-mode*))
-                (t ""))
-          (eval '(latest-release-note-string)) ; avoid possible warning
-          )
+  (when *print-startup-banner*
+    (format t
+            *saved-string*
+            *copy-of-acl2-version*
+            (saved-build-dates :terminal)
+            (if (null *acl2-svn-revision-string*)
+                ""
+              (qfuncall acl2-books-revision))
+            (cond (*saved-mode*
+                   (format nil "~% Initialized with ~a." *saved-mode*))
+                  (t ""))
+            (eval '(latest-release-note-string)) ; avoid possible warning
+            ))
   (maybe-load-acl2-init)
   (eval `(in-package ,*startup-package-name*))
 
@@ -1131,7 +1301,8 @@
 
 #+cmu
 (defun cmulisp-restart ()
-  (extensions::print-herald t)
+  (when *print-startup-banner*
+    (extensions::print-herald t))
   (acl2-default-restart)
   (lp))
 
@@ -1148,7 +1319,8 @@
                   :full-gc t))
 
 #+lispworks
-(defun lispworks-save-exec-aux (sysout-name eventual-sysout-name)
+(defun lispworks-save-exec-aux (sysout-name eventual-sysout-name
+                                            host-lisp-args inert-args)
 
 ; LispWorks support (Dave Fox) pointed out, in the days of LispWorks 4, that we
 ; need to be sure to call (mp:initialize-multiprocessing) when starting up.  Up
@@ -1215,8 +1387,10 @@
 ; changing the underlying Lisp implementation before building ACL2 (again,
 ; presumably based on knowledge of the host Lisp implementation).
 
-                                     "~s -init - -siteinit - $*~%"
-                                     eventual-lw-exec-file))
+                                     "~s -init - -siteinit -~a ~a~%"
+                                     eventual-lw-exec-file
+                                     (insert-string host-lisp-args)
+                                     (user-args-string inert-args)))
     (chmod-executable sysout-name)
     (cond ((and system::*init-file-loaded*
                 system::*complain-about-init-file-loaded*)
@@ -1248,18 +1422,21 @@
       (delete-file "worklispext"))
   (with-open-file (str "worklispext" :direction :output)
                   (format str "lw"))
-  (lispworks-save-exec-aux sysout-name eventual-sysout-name))
+  (lispworks-save-exec-aux sysout-name eventual-sysout-name
+                           nil nil))
 
 #+lispworks
-(defun save-exec-raw (sysout-name)
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)
 
 ; See the comment above about :multiprocessing t.
 
   (setq *acl2-default-restart-complete* nil)
-  (lispworks-save-exec-aux sysout-name sysout-name))
+  (lispworks-save-exec-aux sysout-name sysout-name
+                           host-lisp-args inert-args))
 
 #+cmu
-(defun save-acl2-in-cmulisp-aux (sysout-name core-name)
+(defun save-acl2-in-cmulisp-aux (sysout-name core-name
+                                             host-lisp-args inert-args)
   (let ((eventual-sysout-core
          (unix-full-pathname core-name "core"))
         (sysout-core
@@ -1289,9 +1466,27 @@
                          (t prog1))))
        (write-exec-file str
                         nil
-                        "~s -core ~s -eval '(acl2::cmulisp-restart)' $*~%"
+                        "~s -core ~s -dynamic-space-size ~s -eval ~
+                         '(acl2::cmulisp-restart)'~a ~a~%"
                         prog2
-                        eventual-sysout-core)))
+                        eventual-sysout-core
+
+; In our testing for ACL2 Version_6.2 we found that certification failed for
+; ACL2(h) built on CMUCL for the book tau/bounders/elementary-bounders.lisp,
+; with the error: "CMUCL has run out of dynamic heap space (512 MB)."  This
+; failure doesn't seem to be fully reproduceable, but it seems safest to
+; increase the stack size.  Our CMUCL image, even though on 64-bit linux,
+; reported the following when we tried a value of 2000 here:
+
+; -dynamic-space-size must be no greater than 1632 MBytes.
+
+; Indeed, we have exceeded that in a version of community book
+; books/centaur/gl/solutions.lisp using ACL2(h) built on CMUCL.  So we use the
+; maximum possible value just below.
+
+                        1632
+                        (insert-string host-lisp-args)
+                        (user-args-string inert-args))))
     (chmod-executable sysout-name)
     (system::gc)
     (extensions::save-lisp sysout-core :load-init-file nil :site-init nil
@@ -1308,12 +1503,12 @@
       (delete-file "worklispext"))
   (with-open-file (str "worklispext" :direction :output)
                   (format str "core"))
-  (save-acl2-in-cmulisp-aux sysout-name core-name))
+  (save-acl2-in-cmulisp-aux sysout-name core-name nil nil))
 
 #+cmu
-(defun save-exec-raw (sysout-name)
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)
   (setq *acl2-default-restart-complete* nil)
-  (save-acl2-in-cmulisp-aux sysout-name sysout-name))
+  (save-acl2-in-cmulisp-aux sysout-name sysout-name host-lisp-args inert-args))
 
 #+sbcl
 (defvar *sbcl-dynamic-space-size*
@@ -1363,7 +1558,17 @@
   #-(and x86-64 hons) 2000)
 
 #+sbcl
-(defun save-acl2-in-sbcl-aux (sysout-name core-name)
+(defvar *sbcl-contrib-dir* nil)
+
+#+sbcl
+(defun save-acl2-in-sbcl-aux (sysout-name core-name
+                                          host-lisp-args
+                                          toplevel-args
+                                          inert-args)
+
+; Note that host-lisp-args specifies what the SBCL manual calls "runtime
+; options", while toplevel-args is what it calls "toplevel options".
+
   (declaim (optimize (sb-ext:inhibit-warnings 3)))
   (let ((eventual-sysout-core
          (unix-full-pathname core-name "core"))
@@ -1386,19 +1591,23 @@
 
         ("~a~%"
          (let ((contrib-dir
-                (and (boundp 'sb-ext::*core-pathname*)
-                     (ignore-errors
-                      (let* ((core-dir
-                              (pathname-directory sb-ext::*core-pathname*))
-                             (contrib-dir-pathname
-                              (and (equal (car (last core-dir))
-                                          "output")
-                                   (make-pathname
-                                    :directory
-                                    (append (butlast core-dir 1)
-                                            (list "contrib"))))))
-                        (and (probe-file contrib-dir-pathname)
-                             (namestring contrib-dir-pathname)))))))
+                (or
+                 *sbcl-contrib-dir*
+                 (and (boundp 'sb-ext::*core-pathname*)
+                      (ignore-errors
+                        (let* ((core-dir
+                                (pathname-directory
+                                 sb-ext::*core-pathname*))
+                               (contrib-dir-pathname
+                                (and (equal (car (last core-dir))
+                                            "output")
+                                     (make-pathname
+                                      :directory
+                                      (append (butlast core-dir 1)
+                                              (list "contrib"))))))
+                          (and (probe-file contrib-dir-pathname)
+                               (setq *sbcl-contrib-dir*
+                                     (namestring contrib-dir-pathname)))))))))
            (if contrib-dir
                (format nil
                        "export SBCL_HOME=~s"
@@ -1411,26 +1620,28 @@
 ; to be stack overflow from fmt0, which is not tail recursive.  More recently,
 ; community book centaur/misc/defapply.lisp causes a stack overflow even with
 ; --control-stack-size 4 (though that might disappear after we added (comp t)
-; in a couple of places).  So we use 8 instead of 4.
+; in a couple of places).  Yet more recently, community books
+; books/centaur/regression/common.lisp and books/centaur/tutorial/intro.lisp
+; fail with --control-stack-size 8, due to calls of def-gl-clause-processor.
+; So we use --control-stack-size 16.  We might increase 16 to 32 or greater in
+; the future.
 
 ; See *sbcl-dynamic-space-size* for an explanation of the --dynamic-space-size
 ; setting below.
 
-        "~s --dynamic-space-size ~s --control-stack-size 8 --core ~s~a ~
-         --eval '(acl2::sbcl-restart)'"
+; Note that --no-userinit was introduced into SBCL in Version 0.9.13, hence has
+; been part of SBCL since 2007 (perhaps earlier).  So when Jared Davis pointed
+; out this option to us after ACL2 Version_6.2, we started using it in place of
+; " --userinit /dev/null", which had not worked on Windows.
+
+        "~s --dynamic-space-size ~s --control-stack-size 16 --core ~s~a ~
+         --end-runtime-options --no-userinit --eval '(acl2::sbcl-restart)'~a ~a~%"
         prog
         *sbcl-dynamic-space-size*
         eventual-sysout-core
-
-; We have found (August 2008) that SBCL 1.0.13 on Windows does not like
-; "--userinit /dev/null".  But we have been using this option for quite some
-; time on other platforms.  So we conditionalize here, but we are open to
-; suggestions from SBCL users on a better way to handle this.
-
-        #-mswindows
-        " --userinit /dev/null"
-        #+mswindows
-        "")))
+        (insert-string host-lisp-args)
+        (insert-string toplevel-args)
+        (user-args-string inert-args "--end-toplevel-options"))))
     (chmod-executable sysout-name)
     ;; In SBCL 0.9.3 the read-only space is too small for dumping ACL2 on x86,
     ;; so we have to specify :PURIFY NIL. This will unfortunately result in
@@ -1447,24 +1658,20 @@
    (setq *saved-mode* mode)
    (if (probe-file "worklispext")
        (delete-file "worklispext"))
-   (cond ((and *suppress-compile-build-time*
-               (probe-file "acl2-proclaims.lisp"))
-; We do the following load when *suppress-compile-build-time* in save-acl2, but
-; it's harmless enough to do it again here.
-          (load "acl2-proclaims.lisp"))
-         (t (proclaim-files)))
    (with-open-file (str "worklispext" :direction :output)
                    (format str "core"))
-   (save-acl2-in-sbcl-aux sysout-name core-name)))
+   (save-acl2-in-sbcl-aux sysout-name core-name nil nil nil)))
 
 #+sbcl
-(defun save-exec-raw (sysout-name)
+(defun save-exec-raw (sysout-name host-lisp-args toplevel-args inert-args)
   (with-warnings-suppressed
    (setq *acl2-default-restart-complete* nil)
-   (save-acl2-in-sbcl-aux sysout-name sysout-name)))
+   (save-acl2-in-sbcl-aux sysout-name sysout-name host-lisp-args toplevel-args
+                          inert-args)))
 
 #+allegro
-(defun save-acl2-in-allegro-aux (sysout-name dxl-name)
+(defun save-acl2-in-allegro-aux (sysout-name dxl-name
+                                             host-lisp-args inert-args)
   (excl:gc t) ; Suggestions are welcome for better gc call(s)!
   #+(and allegro-version>= (version>= 4 3))
   (progn
@@ -1502,11 +1709,13 @@
 ; Allegro 6.2 to avoid getting Allegro copyright information printed upon :q if
 ; we start up in the ACL2 read-eval-print loop.
 
-;         "~s -I ~s -L ~s~%"
+;         "~s -I ~s -L ~s ~s~%"
 
-          "~s -I ~s $*~%"
+          "~s -I ~s~s ~a~%"
           (system::command-line-argument 0)
-          eventual-sysout-dxl))
+          eventual-sysout-dxl
+          (insert-string host-lisp-args)
+          (user-args-string inert-args)))
         (chmod-executable sysout-name)
         (excl:dumplisp :name sysout-dxl)))
     #-(and allegro-version>= (version>= 5 0))
@@ -1528,12 +1737,12 @@
   (with-open-file (str "worklispext" :direction :output)
                   (format str "dxl"))
   (load "allegro-acl2-trace.lisp") ; Robert Krug's trace patch
-  (save-acl2-in-allegro-aux sysout-name dxl-name))
+  (save-acl2-in-allegro-aux sysout-name dxl-name nil nil))
 
 #+allegro
-(defun save-exec-raw (sysout-name)
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)
   (setq *acl2-default-restart-complete* nil)
-  (save-acl2-in-allegro-aux sysout-name sysout-name))
+  (save-acl2-in-allegro-aux sysout-name sysout-name host-lisp-args inert-args))
 
 (defun rc-filename (dir)
   (concatenate 'string dir ".acl2rc"))
@@ -1557,7 +1766,7 @@
                   (ACL2::LP)~%")))))
 
 #+clisp
-(defun save-acl2-in-clisp-aux (sysout-name mem-name)
+(defun save-acl2-in-clisp-aux (sysout-name mem-name host-lisp-args inert-args)
   (let ((save-dir (our-pwd))
         (eventual-sysout-mem
          (unix-full-pathname mem-name "mem"))
@@ -1572,7 +1781,7 @@
      (str sysout-name :direction :output)
      (write-exec-file str
                       nil
-                      "~s -i ~s -p ACL2 -M ~s -m ~dMB -E ISO-8859-1 $*~%"
+                      "~s -i ~s -p ACL2 -M ~s -m ~dMB -E ISO-8859-1~a ~a~%"
                       (or (ext:getenv "LISP") "clisp")
                       (rc-filename save-dir)
                       eventual-sysout-mem
@@ -1588,7 +1797,9 @@
 ; write-exec-file seems to put a decimal point after the number when using ~s,
 ; and CLISP complains about that when starting up.
 
-                      10))
+                      10
+                      (insert-string host-lisp-args)
+                      (user-args-string inert-args)))
     (chmod-executable sysout-name)
     (ext:gc)
     (ext:saveinitmem sysout-mem
@@ -1607,15 +1818,18 @@
       (delete-file "worklispext"))
   (with-open-file (str "worklispext" :direction :output)
                   (format str "mem"))
-  (save-acl2-in-clisp-aux sysout-name mem-name))
+  (save-acl2-in-clisp-aux sysout-name mem-name nil nil))
 
 #+clisp
-(defun save-exec-raw (sysout-name)
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)
   (setq *acl2-default-restart-complete* nil)
-  (save-acl2-in-clisp-aux sysout-name sysout-name))
+  (save-acl2-in-clisp-aux sysout-name sysout-name host-lisp-args inert-args))
 
 #+ccl
-(defun save-acl2-in-ccl-aux (sysout-name core-name)
+(defun save-acl2-in-ccl-aux (sysout-name core-name
+                                         &optional
+                                         (host-lisp-args nil save-exec-p)
+                                         inert-args)
   (let* ((ccl-program0
           (or (car ccl::*command-line-argument-list*) ; Gary Byers suggestion
               (error "Unable to determine CCL program pathname!")))
@@ -1667,18 +1881,50 @@
                                      default-dir)
                            "")))
 
+; See the section on "reading characters from files" in file acl2.lisp for an
+; explanation of the -K argument below.
+
 ; It is probably important to use -e just below instead of :toplevel-function,
 ; at least for #+hons.  Jared Davis and Sol Swords have told us that it seems
 ; that with :toplevel-function one gets a new "toplevel" thread at start-up,
 ; which "plays badly with the thread-local hash tables that make up the hons
 ; space".
 
-; See the section on "reading characters from files" in file acl2.lisp for an
-; explanation of the -K argument below.
-
-                      "~s -I ~s -K ISO-8859-1 -e \"(acl2::acl2-default-restart)\" $*~%"
+                      "~s -I ~s~a -K ISO-8859-1 -e ~
+                       \"(acl2::acl2-default-restart)\"~a ~a~%"
                       ccl-program
-                      core-name))
+                      core-name
+                      (if save-exec-p
+
+; For an ACL2 built from sources, the saved script will include "-Z 64M"; see
+; comment below.  But with save-exec, no -Z option will be written.  The new
+; script can then be expected to invoke ACL2 with the same stack sizes as did
+; the original (which had -Z 64M explicitly), unless an explicit -Z option is
+; given to save-exec or globals such as
+; ccl::*initial-listener-default-control-stack-size* (see community book
+; books/centaur/ccl-config.lsp) are set before the save-exec call.
+
+; Turning now to the case of building from sources, as opposed to save-exec:
+
+; We use -Z 64M even though the default for -Z (as of mid-2013) is 2M, in order
+; to get larger stacks.  We have ample evidence that a larger stack would be
+; useful: an ACL2 example from David Russinoff in August 2013 for which 8M was
+; insufficient (defining a constant function with body '(...), a quoted list of
+; length 65536; our own x86 model requiring 4M for an ACL2 proof using
+; def-gl-thm; and more generally, Centaur's routine use of large stacks,
+; equivalent to -Z 256M.  Not surprisingly, we that performance was not hurt
+; using a larger stack size, for two pairs of ACL2(h) regressions as follows.
+; We ran one pair of runs on a Linux system with 32GB of RAM, and one pair of
+; runs on a MacBook Pro with 8GB of RAM, all in August 2013.  For each pair we
+; ran with -Z 64M and also omitting -Z (equivalent to using -Z 2M).  Our main
+; concern was potentially larger backtraces when using (set-debugger-enable
+; :bt), as during a regression.  We solved that by restricting backtrace counts
+; using *ccl-print-call-history-count*.
+
+                          ""
+                        " -Z 64M")
+                      (insert-string host-lisp-args)
+                      (user-args-string inert-args)))
     (chmod-executable sysout-name)
     (ccl::gc)
     (ccl:save-application core-name)))
@@ -1686,19 +1932,13 @@
 #+ccl
 (defun save-acl2-in-ccl (sysout-name &optional mode core-name)
   (setq *saved-mode* mode)
-  (cond ((and *suppress-compile-build-time*
-              (probe-file "acl2-proclaims.lisp"))
-; We do the following load when *suppress-compile-build-time* in save-acl2, but
-; it's harmless enough to do it again here.
-         (load "acl2-proclaims.lisp"))
-        (t (proclaim-files)))
   (load "openmcl-acl2-trace.lisp")
   (save-acl2-in-ccl-aux sysout-name core-name))
 
 #+ccl
-(defun save-exec-raw (sysout-name)
+(defun save-exec-raw (sysout-name host-lisp-args inert-args)
   (setq *acl2-default-restart-complete* nil)
-  (save-acl2-in-ccl-aux sysout-name sysout-name))
+  (save-acl2-in-ccl-aux sysout-name sysout-name host-lisp-args inert-args))
 
 ; Since saved-build-date-string is avoided for MCL, we avoid the following too
 ; (which is not applicable to MCL sessions anyhow).
@@ -1722,8 +1962,6 @@
 ; (ccl::save-application "acl2-image" :size (expt 2 24))
 ; for the Mac.
 
-  (when (and *suppress-compile-build-time* (probe-file "acl2-proclaims.lisp"))
-    (load "acl2-proclaims.lisp"))
   (load-acl2)
   (setq *saved-build-date-lst*
 
@@ -1765,33 +2003,12 @@
   (error "We do not know how to save ACL2 in this Common Lisp.")
   (format t "Saving of ACL2 is complete.~%"))
 
-(defun proclaim-files (&optional outfilename)
+(defun generate-acl2-proclaims ()
 
-; IMPORTANT:  This function assumes that the defconst forms in the
-; given files have already been evaluated.  One way to achieve this
-; state of affairs, of course, is to load the files first.
-
-  (if outfilename
-      (format t
-              "Writing proclaim forms for ACL2 source files to file ~s.~%"
-              outfilename)
-    (format t
-              "Generating and evaluating proclaim forms for ACL2 source ~
-               files.~%"))
-  (let (str)
-    (when outfilename
-      (if (probe-file outfilename)
-          (delete-file outfilename))
-      (or (setq str (safe-open outfilename :direction :output))
-          (error "Unable to open file ~s for output." outfilename))
-      (format str "(in-package \"ACL2\")~%"))
-    (dolist (fl *acl2-files*)
-      (proclaim-file (format nil "~a.lisp" fl) str))))
+; See the section "PROCLAIMING" in acl2-fns.lisp.
 
-(defun generate-acl2-proclaims ()
   (let ((filename "acl2-proclaims.lisp"))
-    (cond ((and *suppress-compile-build-time*
-                *do-proclaims*)
+    (cond (*do-proclaims*
            (format t "Beginning load-acl2 and initialize-acl2 on behalf of ~
                       generate-acl2-proclaims.~%")
            (load-acl2 t)
@@ -1808,20 +2025,6 @@
                     "; No proclaims are generated here for this host Lisp.~%"))
            nil))))
 
-(defun acl2 nil
-  (let ((*readtable* *acl2-readtable*)
-        (extension (if *suppress-compile-build-time*
-                       *lisp-extension*
-                     *compiled-file-extension*)))
-    (dolist (name (remove "defpkgs" *acl2-files* :test #'equal))
-            (if (equal name "proof-checker-pkg")
-                (load "proof-checker-pkg.lisp")
-              (load-compiled (make-pathname :name name
-                                            :type extension))))
-    (load "defpkgs.lisp")
-    (in-package "ACL2")
-    "ACL2"))
-
 ; The following avoids core being dumped in certain circumstances
 ; resulting from very hard errors.
 
diff -Nru acl2-6.2/acl2.lisp acl2-6.3/acl2.lisp
--- acl2-6.2/acl2.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/acl2.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -142,11 +142,14 @@
 ;                               SAFETY AND PROCLAIMING
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-; The user is welcome to modify the following proclaim form.
-
 (proclaim `(optimize #+cltl2 (compilation-speed 0)
+
+; The user is welcome to modify this proclaim form.  Warning: Keep it in sync
+; with the settings in compile-acl2 under #+sbcl.
+
 ; The following may allow more tail recursion elimination (from "Lisp
 ; Knowledgebase" at lispworks.com); might consider for Allegro CL too.
+
                      #+(or lispworks ccl) (debug 0)
                      #+cmu (extensions:inhibit-warnings 3)
                      #+sbcl (sb-ext:inhibit-warnings 3)
@@ -481,6 +484,13 @@
 #+ccl
 (setq ccl::*record-source-file* nil)
 
+; Camm Maguire has suggested, on 9/22/2013, the following forms, which allowed
+; him to complete an ACL2 regresssion using 2.6.10pre.
+#+gcl
+(progn
+  (si::allocate 'contiguous 15000 t)
+  (si::allocate-sgc 'contiguous 15000 100000 10))
+
 ; The following avoids errors from extra right parentheses, but we leave it
 ; commented out since it doesn't seem important enough to merit messing around
 ; at this low level, and for just one Lisp.
@@ -491,7 +501,8 @@
 ; modifications, we made progress -- except there appears (as of Sept. 2011) to
 ; be no good way for us to save an executable image.  Specifically, it appears
 ; that c:build-program not will suffice for saving state (properties etc.) --
-; it's just for saving specified .o files.
+; it's just for saving specified .o files.  (This impression seems to be
+; confirmed at http://stackoverflow.com/questions/7686246/saving-lisp-state .)
 
 ; Here we document steps to take towards possibly porting to ECL in the future.
 
@@ -942,7 +953,7 @@
    (setq acl2::*copy-of-acl2-version*
 ;  Keep this in sync with the value of acl2-version in *initial-global-table*.
          (concatenate 'string
-                      "ACL2 Version 6.2"
+                      "ACL2 Version 6.3"
                       #+non-standard-analysis
                       "(r)"
                       #+(and mcl (not ccl))
@@ -971,6 +982,7 @@
          #-cltl2 'user::*acl2-compiler-enabled*))
     `(progn (dolist (pair *initial-global-table*)
               (f-put-global (car pair) (cdr pair) *the-live-state*))
+            (f-put-global 'acl2-sources-dir (our-pwd) *the-live-state*)
             (f-put-global 'iprint-ar
                           (compress1 'iprint-ar
                                      (f-get-global 'iprint-ar *the-live-state*))
@@ -1429,6 +1441,29 @@
 which is saved just in case it's needed later.")
 
 (defun set-new-dispatch-macro-character (char subchar fn)
+
+; This function currently causes an error when attempting to build ACL2(h) on
+; top of CLISP, where (get-dispatch-macro-character #\# #\Y) evaluates to
+; #<SYSTEM-FUNCTION SYSTEM::CLOSURE-READER>.  Here is a discussion of that
+; issue.
+
+; With some thought we might be able to avoid the special cases below for which
+; char is #\# and subchar is, for example, #\Y -- i.e., smashing (in that
+; example) which reader is invoked by #\Y.  We certainly have in mind our own
+; semantics for ACL2 source files, to be read using *acl2-readtable*, while the
+; host Lisp's semantics are expected for compiled files.  But consider files
+; like .cert and @expansion.lsp files, i.e., files that may be written by the
+; host Lisp (see the call of prin1 in print-object$-ser) but are read by ACL2.
+; Perhaps the issue goes away if we are using the serialize reader and writer,
+; as must be the case when we install a reader for #\Y.  We may think all this
+; through when there is sufficient reason to do so.  For now, the only problem
+; pertaining to our handling of dispatch macro characters is in the case of
+; CLISP and ACL2(h), since #\Y is already defined in CLISP -- this function
+; causes an error when attempting to build ACL2(h) on CLISP.  Since CLISP is
+; much slower than the other six host Lisps that we support, and since ACL2(h)
+; is optimized for CCL such that it is really only intended for CCL at this
+; point (June 2013), we can live without CLISP support for ACL2(h).
+
   (let ((old (get-dispatch-macro-character char subchar)))
     (cond ((or (null old)
                (eql fn old)
@@ -1858,16 +1893,31 @@
 ;                       COMPILING and LOADING, PART 2
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defun non-trivial-acl2-proclaims-file-p ()
+  (with-open-file (str "acl2-proclaims.lisp"
+                       :direction :input
+                       :if-does-not-exist nil)
+                  (and str
+                       (let* ((new-cons (cons nil nil))
+                              (val (read str nil new-cons)))
+                         (and (not (eq new-cons val))
+
+; We might not need the following, but just in case we decide always to print
+; an in-package form into the file, we require that the file have at least two
+; forms.
+
+                              (not (eq new-cons
+                                       (read str nil new-cons))))))))
+
 (defun compile-acl2 (&optional use-acl2-proclaims)
-  (declare (ignorable use-acl2-proclaims))
 
   (with-warnings-suppressed
 
    #+sbcl
    (declaim (optimize (safety 0) (space 0) (speed 3) (debug 0)))
 
-; Here is a natural place to put compiler options.  In fact, we put
-; them above, globally.
+; Here is a natural place to put compiler options.  In fact, we put them above,
+; globally.
 
 ; (declaim (optimize (safety 0) (space 0) (speed 3)))
 
@@ -1905,23 +1955,33 @@
 ;(12) once the bug is fixed, be sure to change the declaim
 ;     back to (safety 0) (speed 3) before recompiling.
 
-; Note on loading before compiling.  We load each ACL2 source file
-; before compiling it to make sure that the functions needed to
-; execute macros have been defun-ed before they are called.  Normal
-; Common Lisp compilation does not do this.  So we cause all forms to
-; be executed before we start the compilation.  This guarantees that
-; when macros run, the functions they call have been defined.
-
-; In general, and for the same reason, all ACL2 user checked files
-; are also be loaded before they are compiled.
-
-   #-acl2-mv-as-values
-   (when use-acl2-proclaims
-     (return-from compile-acl2 nil))
+; Note on loading before compiling.  We load each ACL2 source file before
+; compiling it to make sure that the functions needed to execute macros have
+; been defun-ed before they are called.  Normal Common Lisp compilation does
+; not do this.  So we cause all forms to be executed before we start the
+; compilation.  This guarantees that when macros run, the functions they call
+; have been defined.
+
+; In general, and for the same reason, all ACL2 user checked files are also
+; loaded before they are compiled.
 
 ; As of version 18a, cmulisp spews gc messages to the terminal even when
 ; standard and error output are redirected.  So we turn them off.
 
+   (when (and use-acl2-proclaims
+              (not (non-trivial-acl2-proclaims-file-p)))
+
+; Note that GNUmakefile provides special treatment for the value :REUSE of
+; environment/make variable USE_ACL2_PROCLAIMS.  With that treatment, we avoid
+; calling compile-acl2 with use-acl2-proclaims = t, and thus we don't get to
+; this point.
+
+     (error "Note: Skipping compilation that is intended to use generated ~
+             file \"acl2-proclaims.lisp\", because that file is missing or ~
+             has no forms in it."))
+   (when (and (not use-acl2-proclaims)
+              (probe-file "acl2-proclaims.lisp"))
+     (delete-file "acl2-proclaims.lisp"))
    (cond
     ((or (not (probe-file *acl2-status-file*))
          (with-open-file (str *acl2-status-file*
@@ -1940,7 +2000,7 @@
 
             (compiler:*suppress-compiler-notes* t))
         (when use-acl2-proclaims
-          (load "acl2-proclaims.lisp"))
+          (proclaim-files nil "acl2-proclaims.lisp" nil))
         (dolist (name *acl2-files*)
           (or (equal name "defpkgs")
               (let ((source (make-pathname :name name
@@ -1959,86 +2019,37 @@
                                       :type *compiled-file-extension*))))))))))
    (note-compile-ok)))
 
-(defun no-object-file-or-out-of-date-object-file (fl)
-  (or (null (probe-file
-             (make-pathname :name fl :type *compiled-file-extension*)))
-      (> (file-write-date
-          (make-pathname :name fl :type *lisp-extension*))
-         (file-write-date
-          (make-pathname :name fl :type *compiled-file-extension*)))))
-
-(defun quick-compile-acl2 (&optional very-fast use-acl2-proclaims)
-  (with-warnings-suppressed
-
-; Here is a natural place to put compiler options.
-
-; (declaim (optimize (safety 0) (space 0) (speed 3)))
-
-; As of version 18a, cmulisp spews gc messages to the terminal even when
-; standard and error output are redirected.  So we turn them off.
-
-   #+cmu
-   (setq extensions::*gc-verbose* nil)
-
-   (cond
-    ((or (not (probe-file (make-pathname :name "acl2-status"
-                                         :type "txt")))
-         (with-open-file (str (make-pathname :name "acl2-status"
-                                             :type "txt")
-                              :direction :input)
-                         (not (eq (read str nil)
-                                  :checked))))
-     (check-suitability-for-acl2)))
-   (our-with-compilation-unit
-    (let ((compile-rest-flg nil)
-          (*readtable* *acl2-readtable*)
-          #+akcl
-          (si:*notify-gbc* nil)
-          #+akcl
-
-; AKCL compiler note stuff.  We have so many tail recursive functions
-; that the notes about tail recursion optimization are just too much
-; to take.
-
-          (compiler:*suppress-compiler-notes* t)
-          (files (remove "defpkgs" *acl2-files* :test #'equal)))
-      (cond
-       ((some #'no-object-file-or-out-of-date-object-file files)
-        (when use-acl2-proclaims
-          (load "acl2-proclaims.lisp"))
-        (dolist
-          (fl files)
-          (let ((source (make-pathname :name fl :type *lisp-extension*))
-                (object (make-pathname :name fl :type *compiled-file-extension*)))
-            (cond
-             ((or *suppress-compile-build-time*
-                  (equal fl "proof-checker-pkg"))
-              (load source))
-             ((or compile-rest-flg (no-object-file-or-out-of-date-object-file fl))
-              (load source)
-              (proclaim-file source)
-              (when (not very-fast)
-                (setq compile-rest-flg t))
-              (compile-file source)
-              (load-compiled object))
-             (t (load-compiled object)
-                (proclaim-file source))))))
-       (t "Nothing to do."))))
-   (note-compile-ok)))
-
 #+gcl
 (defvar user::*fast-acl2-gcl-build* nil)
 
 (defun load-acl2 (&optional fast)
 
-  #-akcl (declare (ignore fast)) ; fast only avoids slow growth during gcl init
+; If fast is true, then we are welcome to avoid optimizations that might make
+; for a better saved image.  For example, we use fast = t when building simply
+; to write proclaim forms into acl2-proclaims.lisp.
+
+  (declare (ignorable fast))
 
   (our-with-compilation-unit ; only needed when *suppress-compile-build-time*
    (with-warnings-suppressed
 
-; If we are in the first pass of two passes because of acl2-mv-as-values, then
-; don't waste time doing the slow build for GCL (where we compile all *1*
-; functions as we go through initialization).
+    (when (and *suppress-compile-build-time*
+               (not fast))
+
+; When we rely on Lisp to compile on-the-fly, we want to proclaim before
+; loading.  This might actually be broken; we got an error when trying to do
+; proclaiming here for GCL, complaining that "The variable
+; *COMMON-LISP-SYMBOLS-FROM-MAIN-LISP-PACKAGE* is unbound."  If we ever decide
+; to proclaim when *suppress-compile-build-time* is true, we can deal with that
+; problem then, perhaps by using
+; *copy-of-common-lisp-symbols-from-main-lisp-package* instead (though we
+; haven't tried that).
+
+      (proclaim-files nil "acl2-proclaims.lisp" t))
+
+; If we are in the first pass of two passes, then don't waste time doing the
+; slow build for GCL (where we compile all *1* functions as we go through
+; initialization).
 
     #+(and gcl acl2-mv-as-values)
     (when fast
@@ -2075,11 +2086,9 @@
                                :direction :input)
                           (not (member (read str nil)
                                        '(:compiled :initialized)))))
-      (error "Please compile ACL2 using ~s or~%~
-            ~s, which will write the~%~
-            token :compiled to the file acl2-status.txt."
-             '(compile-acl2)
-             '(quick-compile-acl2 t))))
+      (error "Please compile ACL2 using ~s, which will write~%~
+              the token :COMPILED to the file acl2-status.txt."
+             '(compile-acl2))))
     (let ((*readtable* *acl2-readtable*)
           (extension (if *suppress-compile-build-time*
                          *lisp-extension*
@@ -2091,6 +2100,9 @@
               (load-compiled (make-pathname :name name
                                             :type extension)))))
       (load "defpkgs.lisp")
+      (when (and (not *suppress-compile-build-time*) ; other case is above
+                 (not fast))
+        (proclaim-files nil "acl2-proclaims.lisp" t))
       (in-package "ACL2")
 
 ; Do not make state special, as that can interfere with tail recursion removal.
@@ -2480,9 +2492,11 @@
           nil))
         (terpri *debug-io*)
         (break-current))))))
+#+(and gcl (not cltl2))
+(in-package "ACL2")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;                        Some hacks for CCL
+;                        Additional hacks for CCL
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ; Also see the acl2h-init code.
diff -Nru acl2-6.2/akcl-acl2-trace.lisp acl2-6.3/akcl-acl2-trace.lisp
--- acl2-6.2/akcl-acl2-trace.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/akcl-acl2-trace.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/allegro-acl2-trace.lisp acl2-6.3/allegro-acl2-trace.lisp
--- acl2-6.2/allegro-acl2-trace.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/allegro-acl2-trace.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/axioms.lisp acl2-6.3/axioms.lisp
--- acl2-6.2/axioms.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/axioms.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -1298,9 +1298,6 @@
 (defconstant *non-existent-stream*
   'acl2_invisible::|A Non-Existent Stream|)
 
-(defmacro live-state-p (x)
-  (list 'eq x '*the-live-state*))
-
 ; We get ready to handle errors in such a way that they return to the
 ; top level logic loop if we are under it.
 
@@ -1325,6 +1322,82 @@
         (error "ACL2 Halted"))))
    (t (error "ACL2 error:  ~a." args))))
 
+#-acl2-loop-only
+(declaim (inline
+
+; Here we take a suggestion from Jared Davis and inline built-in functions,
+; starting after Version_6.2, based on successful use of such inlining at
+; Centaur Technology for many months on their local copy of ACL2.  Indeed, the
+; original list below (added on June 16, 2013) comes directly from that copy,
+; except for inclusion of aref1 and aref2 (as noted below).  As Jared said in a
+; log message when he added inline declarations for 33 functions to a local
+; copy of ACL2 at Centaur:
+
+;   This should give us a useful speedup on CCL for many functions that recur
+;   with ZP at the end.  I measured a 12% speedup for a naive FIB function.
+
+; We are seeing perhaps 2% speedup on regressions, but we believe that this
+; inlining could provide much greater benefit in some cases.
+
+; Some of these functions could probably be inlined using the defun-inline
+; feature of ACL2, but we prefer not to fight with the likely resulting
+; boot-strapping problem during the ACL2 build.
+
+; We may modify this list from time to time, for example based on user request.
+; It surely is safe to add any function symbol to the list that is not defined
+; recursively in raw Lisp (and maybe even if it is).  But of course that could
+; interfere with tracing and redefinition, so care should be taken before
+; adding a function symbol that might be traced or redefined.
+
+; We endeavor to keep the list sorted alphabetically, simply to make it easy to
+; search visually.
+
+           acl2-numberp
+           add-to-set-eq-exec
+           aref1 ; already inlined in Version_6.2 and before
+           aref2 ; already inlined in Version_6.2 and before
+           booleanp
+           complex-rationalp
+           eqlablep
+           fix
+           fn-symb
+           iff
+           ifix
+           implies
+           integer-abs
+           integer-range-p
+           len
+           member-equal
+           natp
+           nfix
+           peek-char$
+           posp
+           quotep
+           random$
+           read-byte$
+           read-char$
+           realfix
+           rfix
+           signed-byte-p
+           strip-cars
+           strip-cdrs
+           symbol-<
+           unsigned-byte-p
+           xor
+           zip
+           zp
+           zpf
+           )
+
+; For ACL2 built on CMUCL 20D Unicode, an attempt failed on 9/12/2013 to
+; certify the community book books/models/jvm/m1/defsys.lisp.  During
+; debugging, we found a note that mentioned "*Inline-Expansion-Limit* (400)
+; exceeded".  The following declaim form, which may be quite harmless, solves
+; the problem.
+
+         #+cmu
+         (notinline len))
+
 ; We provide here ``raw'' implementations of basic functions that we
 ; ``wish'' were already in Common Lisp, to support primitives of the
 ; ACL2 logic.
@@ -1383,30 +1456,8 @@
 ; package can be redefined only if its imports list is identical to that in its
 ; old definition.
 
-; The following alist associates package names with Common Lisp packages, and
-; is used in function find-package-fast, which is used by princ$ in place of
-; find-package in order to save perhaps 15% of the print time.
-(defparameter *package-alist* nil)
-
-(defun-one-output find-package-fast (string)
-  (or (cdr (assoc-equal string *package-alist*))
-      (let ((pkg (find-package string)))
-        (push (cons string pkg) *package-alist*)
-        pkg)))
-
 (defvar **1*-symbol-key* (make-symbol "**1*-SYMBOL-KEY*"))
 
-(defvar *global-symbol-key* (make-symbol "*GLOBAL-SYMBOL-KEY*"))
-
-(defun global-symbol (x)
-  (or (get x *global-symbol-key*)
-      (setf (get x *global-symbol-key*)
-            (intern (symbol-name x)
-                    (find-package-fast
-                     (concatenate 'string
-                                  *global-package-prefix*
-                                  (symbol-package-name x)))))))
-
 (defun *1*-symbol (x)
 ; Keep this in sync with *1*-symbol?.
   (or (get x **1*-symbol-key*)
@@ -1857,10 +1908,12 @@
 
 (defmacro make-event (&whole event-form
                              form
-                             &key check-expansion on-behalf-of)
+                             &key
+                             expansion? check-expansion on-behalf-of)
   (declare (ignore form on-behalf-of))
   (cond ((consp check-expansion)
          check-expansion)
+        (expansion?)
         (t `(error ; not er; so certify-book and include-book fail
              "It is illegal to execute make-event in raw Lisp (including ~%~
               raw mode) unless :check-expansion is a cons, which represents ~%~
@@ -2883,7 +2936,7 @@
   To see the ACL2 definition of this function, ~pl[pf].~/"
 
   (declare (xargs :mode :logic
-                  :guard (or (consp x) (equal x nil))))
+                  :guard (or (consp x) (eq x nil))))
   (atom x))
 
 #+acl2-loop-only
@@ -5601,7 +5654,7 @@
   in raw Lisp.  That is, the call of ~c[fn] is made on its evaluated arguments
   as though this call is being made in the ACL2 top-level loop, rather than in
   raw Lisp.  In particular, the ~il[guard] of ~c[fn] is checked, at least by
-  default (~pl[set-guard-checking].~eq[]
+  default (~pl[set-guard-checking]).~eq[]
 
   Note that in the term (ec-call (fn term1 ... termk))~c[], only the indicated
   call of ~c[fn] is made in the logic; each ~c[termi] is evaluated in the
@@ -6039,19 +6092,29 @@
 
   identity function used to force a hypothesis~/
 
-  When a hypothesis of a conditional rule has the form ~c[(force hyp)] it
-  is logically equivalent to ~c[hyp] but has a pragmatic effect.  In
-  particular, when the rule is considered, the needed instance of the
-  hypothesis, ~c[hyp'], is assumed and a special case is generated,
-  requiring the system to prove that ~c[hyp'] is true in the current
-  context.  The proofs of all such ``forced assumptions'' are delayed
-  until the successful completion of the main goal.
-  ~l[forcing-round].
-
-  Forcing should only be used on hypotheses that are always expected to be
-  true, as is commonly the case for ~il[guard]s of functions.  All the power of
-  the theorem prover is brought to bear on a forced hypothesis and no
-  backtracking is possible.  Forced goals can be attacked immediately
+  ~c[Force] is the identity function: ~c[(force x)] is equal to ~c[x].
+  However, for rules of many classes (~pl[rule-classes]), a hypothesis of the
+  form ~c[(force term)] is given special treatment, as described below.  This
+  treatment takes place for rule classes ~c[:]~ilc[rewrite], ~c[:]~ilc[linear],
+  ~c[:]~ilc[type-prescription], ~c[:]~ilc[definition], ~c[:]~ilc[meta] (actually
+  in that case, the result of evaluating the hypothesis metafunction call), and
+  ~c[:]~ilc[forward-chaining].
+
+  When a hypothesis of a conditional rule (of one of the classes listed above)
+  has the form ~c[(force hyp)], it is logically equivalent to ~c[hyp] but has a
+  pragmatic effect.  In particular, when the rule is considered, the needed
+  instance of the hypothesis, ~c[hyp'], may be assumed if the usual process
+  fails to prove it or its negation.  In that situation, if the rule is
+  eventually applied, then a special case is generated, requiring the system to
+  prove that ~c[hyp'] is true in the current context.  The proofs of all such
+  ``forced assumptions'' are, by default, delayed until the successful
+  completion of the main goal.  ~l[forcing-round] and
+  ~pl[immediate-force-modep].
+
+  Forcing is generally used on hypotheses that are always expected to be true,
+  as is commonly the case for ~il[guard]s of functions.  All the power of the
+  theorem prover is brought to bear on a forced hypothesis and no backtracking
+  is possible.  Forced goals can be attacked immediately
   (~pl[immediate-force-modep]) or in a subsequent forcing round
   (~pl[forcing-round]).  Also ~pl[case-split] for a related utility.  If the
   ~c[:]~ilc[executable-counterpart] of the function ~c[force] is ~il[disable]d,
@@ -6227,14 +6290,22 @@
 
   like force but immediately splits the top-level goal on the hypothesis~/
 
-  When a hypothesis of a conditional rule has the form ~c[(case-split hyp)]
-  it is logically equivalent to ~c[hyp].  However it affects the
-  application of the rule generated as follows:  if ACL2
-  attempts to apply the rule but cannot establish that the required
-  instance of ~c[hyp] holds in the current context, it considers the
-  hypothesis true anyhow, but (assuming all hypotheses are seen to be true and
-  the rule is applied) creates a subgoal in which that instance of ~c[hyp] is
-  assumed false.  (There are exceptions, noted below.)~/
+  ~c[Case-split] is an variant of ~ilc[force], which has similar special
+  treatment in hypotheses of rules for the same ~il[rule-classes] as for
+  ~c[force] (~pl[force]).  This treatment takes place for rule classes
+  ~c[:]~ilc[rewrite], ~c[:]~ilc[linear], ~c[:]~ilc[type-prescription],
+  ~c[:]~ilc[definition], ~c[:]~ilc[meta] (actually in that case, the result of
+  evaluating the hypothesis metafunction call), and
+  ~c[:]~ilc[forward-chaining].
+
+  When a hypothesis of a conditional rule (of one of the classes listed above)
+  has the form ~c[(case-split hyp)] it is logically equivalent to ~c[hyp].
+  However it affects the application of the rule generated as follows: if ACL2
+  attempts to apply the rule but cannot establish that the required instance of
+  ~c[hyp] holds in the current context, it considers the hypothesis true
+  anyhow, but (assuming all hypotheses are seen to be true and the rule is
+  applied) creates a subgoal in which that instance of ~c[hyp] is assumed
+  false.  (There are exceptions, noted below.)~/
 
   For example, given the rule
   ~bv[]
@@ -6251,14 +6322,14 @@
   (IMPLIES (AND (NOT (P1 (CAR X))) (P3 X))
            (P2 (CAR X))).
   ~ev[]
-  Unlike ~ilc[force], ~c[case-split] does not delay the ``false case'' to
-  a forcing round but tackles it more or less immediately.
+  Unlike ~ilc[force], ~c[case-split] does not delay the ``false case'' to a
+  forcing round but tackles it more or less immediately.
 
   The special ``split'' treatment of ~c[case-split] can be disabled by
-  disabling forcing:  ~pl[force] for a discussion of disabling forcing, and
-  also ~pl[disable-forcing].  Finally, we should mention that the rewriter is
-  never willing to split when there is an ~ilc[if] term present in the goal
-  being simplified.  Since ~ilc[and] terms and ~ilc[or] terms are merely
+  disabling forcing: ~pl[force] for a discussion of disabling forcing, and also
+  ~pl[disable-forcing].  Finally, we should mention that the rewriter is never
+  willing to split when there is an ~ilc[if] term present in the goal being
+  simplified.  Since ~ilc[and] terms and ~ilc[or] terms are merely
   abbreviations for ~ilc[if] terms, they also prevent splitting.  Note that
   ~ilc[if] terms are ultimately eliminated using the ordinary flow of the proof
   (but ~pl[set-case-split-limitations]), so ~c[case-split] will ultimately
@@ -6415,11 +6486,17 @@
   (declare (xargs :guard t))
   ":Doc-Section Miscellaneous
 
-  attach a heuristic filter on a ~c[:]~ilc[rewrite], ~c[:]~ilc[meta], or ~c[:]~ilc[linear] rule~/
+  attach a heuristic filter on a rule~/
+
+  A calls of ~c[syntaxp] in the hypothesis of a ~c[:]~ilc[rewrite],
+  ~c[:]~ilc[definition], or ~c[:]~ilc[linear] rule is treated specially, as
+  described below.  Similar treatment is given to the evaluation of a
+  ~c[:]~ilc[meta] rule's hypothesis function call.
+
+  For example, consider the ~c[:]~ilc[rewrite] rule created from the following
+  formula.
   ~bv[]
   Example:
-  Consider the :REWRITE rule created from
-
   (IMPLIES (SYNTAXP (NOT (AND (CONSP X)
                               (EQ (CAR X) 'NORM))))
            (EQUAL (LXD X)
@@ -6455,12 +6532,12 @@
   display this internal representation.
 
   There are two types of ~c[syntaxp] hypotheses.  The simpler type may be a
-  hypothesis of a ~c[:]~ilc[rewrite] or ~c[:]~ilc[linear] rule provided
-  ~c[test] contains at least one variable but no free variables
-  (~pl[free-variables]).  In particular, ~c[test] may not use ~il[stobj]s; any
-  stobj name will be treated as an ordinary variable.  The case of
-  ~c[:]~ilc[meta] rules is similar to the above, except that it applies to the
-  result of applying the hypothesis metafunction.  (Later below we will
+  hypothesis of a ~c[:]~ilc[rewrite], ~c[:]~ilc[definition], or
+  ~c[:]~ilc[linear] rule provided ~c[test] contains at least one variable but
+  no free variables (~pl[free-variables]).  In particular, ~c[test] may not use
+  ~il[stobj]s; any stobj name will be treated as an ordinary variable.  The
+  case of ~c[:]~ilc[meta] rules is similar to the above, except that it applies
+  to the result of applying the hypothesis metafunction.  (Later below we will
   describe the second type, an ~em[extended] ~c[syntaxp] hypothesis, which may
   use ~ilc[state].)
 
@@ -6846,7 +6923,7 @@
                                   (not (member-eq nil vars))))))
   ":Doc-Section Miscellaneous
 
-  to bind free variables of a rewrite or linear rule~/
+  to bind free variables of a rewrite, definition, or linear rule~/
   ~bv[]
   Examples:
   (IMPLIES (AND (RATIONALP LHS)
@@ -6871,39 +6948,43 @@
   (BIND-FREE term t)
   (BIND-FREE term)
   ~ev[]
-  A rule which uses a ~c[bind-free] hypothesis has similarities to both a
-  rule which uses a ~ilc[syntaxp] hypothesis and to a ~c[:]~ilc[meta] rule.
-  ~c[Bind-free] is like ~ilc[syntaxp], in that it logically always
-  returns ~c[t] but may affect the application of a ~c[:]~ilc[rewrite]
-  or ~c[:]~ilc[linear] rule when it is called at the top-level of a
-  hypothesis.  It is like a ~c[:]~ilc[meta] rule, in that it allows the
-  user to perform transformations of terms under progammatic control.
+  A rule which uses a ~c[bind-free] hypothesis has similarities to both a rule
+  which uses a ~ilc[syntaxp] hypothesis and to a ~c[:]~ilc[meta] rule.
+  ~c[Bind-free] is like ~ilc[syntaxp], in that it logically always returns
+  ~c[t] but may affect the application of a ~c[:]~ilc[rewrite],
+  ~c[:]~ilc[definition], or ~c[:]~ilc[linear] rule when it is called at the
+  top-level of a hypothesis.  It is like a ~c[:]~ilc[meta] rule, in that it
+  allows the user to perform transformations of terms under progammatic
+  control.
 
   Note that a ~c[bind-free] hypothesis does not, in general, deal with the
-  meaning or semantics or values of the terms, but rather with their
-  syntactic forms.  Before attempting to write a rule which uses
-  ~c[bind-free], the user should be familiar with ~ilc[syntaxp] and the
-  internal form that ACL2 uses for terms.  This internal form is
-  similar to what the user sees, but there are subtle and important
-  differences.  ~ilc[Trans] can be used to view this internal form.
-
-  Just as for a ~ilc[syntaxp] hypothesis, there are two types of
-  ~c[bind-free] hypotheses.  The simpler type of ~c[bind-free]
-  hypothesis may be used as the nth hypothesis in a ~c[:]~ilc[rewrite]
+  meaning or semantics or values of the terms, but rather with their syntactic
+  forms.  Before attempting to write a rule which uses ~c[bind-free], the user
+  should be familiar with ~ilc[syntaxp] and the internal form that ACL2 uses
+  for terms.  This internal form is similar to what the user sees, but there
+  are subtle and important differences.  ~ilc[Trans] can be used to view this
+  internal form.
+
+  Just as for a ~ilc[syntaxp] hypothesis, there are two basic types of
+  ~c[bind-free] hypotheses.  The simpler type of ~c[bind-free] hypothesis may
+  be used as the nth hypothesis in a ~c[:]~ilc[rewrite], ~c[:]~ilc[definition],
   or ~c[:]~ilc[linear] rule whose ~c[:]~ilc[corollary] is
   ~c[(implies (and hyp1 ... hypn ... hypk) (equiv lhs rhs))] provided ~c[term]
   is a term, ~c[term] contains at least one variable, and every variable
   occuring freely in ~c[term] occurs freely in ~c[lhs] or in some ~c[hypi],
-  ~c[i<n].  In addition, ~c[term] must not use any stobjs.
-  (Later below we will describe the second type, an ~em[extended]
-  ~c[bind-free] hypothesis, which may use ~ilc[state].)
-
-  We begin our description of ~c[bind-free] by examining the
-  first example above in some detail.
-
-  We wish to write a rule which will cancel ``like'' addends from both
-  sides of an equality.  Clearly, one could write a series of rules such
-  as
+  ~c[i<n].  In addition, ~c[term] must not use any stobjs.  Later below we will
+  describe the second type, an ~em[extended] ~c[bind-free] hypothesis, which
+  may use ~ilc[state].  Whether simple or extended, a ~c[bind-free] hypothesis
+  may return an alist that binds free variables, as explained below, or it may
+  return a list of such alists.  We focus on the first of these cases: return
+  of a single binding alist.  We conclude our discussion with a section that
+  covers the other case: return of a list of alists.
+
+  We begin our description of ~c[bind-free] by examining the first example
+  above in some detail.
+
+  We wish to write a rule which will cancel ``like'' addends from both sides of
+  an equality.  Clearly, one could write a series of rules such as
   ~bv[]
   (DEFTHM THE-HARD-WAY-2-1
      (EQUAL (EQUAL (+ A X B)
@@ -6911,11 +6992,11 @@
             (EQUAL (+ A B)
                    (FIX C))))
   ~ev[]
-  with one rule for each combination of positions the matching addends
-  might be found in (if one knew before-hand the maximum number of
-  addends that would appear in a sum).  But there is a better way.
-  (In what follows, we assume the presence of an appropriate set of rules
-  for simplifying sums.)
+
+  with one rule for each combination of positions the matching addends might be
+  found in (if one knew before-hand the maximum number of addends that would
+  appear in a sum).  But there is a better way.  (In what follows, we assume
+  the presence of an appropriate set of rules for simplifying sums.)
 
   Consider the following definitions and theorem:
   ~bv[]
@@ -6956,39 +7037,37 @@
   (equal (+ 3 (expt a n) (foo a c))
          (+ (bar b) (expt a n)))
   ~ev[]
-  As mentioned above, the internal form of an ACL2 term is not always
-  what one sees printed out by ACL2.  In this case, by using ~c[:]~ilc[trans]
-  one can see that the term is stored internally as
+  As mentioned above, the internal form of an ACL2 term is not always what one
+  sees printed out by ACL2.  In this case, by using ~c[:]~ilc[trans] one can
+  see that the term is stored internally as
   ~bv[]
   (equal (binary-+ '3
                    (binary-+ (expt a n) (foo a c)))
          (binary-+ (bar b) (expt a n))).
   ~ev[]
 
-  When ACL2 attempts to apply ~c[cancel-matching-addends-equal] to the
-  term under discussion, it first forms a substitution that instantiates
-  the left-hand side of the conclusion so that it is identical to the
-  target term.  This substitution is kept track of by the substitution
-  alist:
+  When ACL2 attempts to apply ~c[cancel-matching-addends-equal] to the term
+  under discussion, it first forms a substitution that instantiates the
+  left-hand side of the conclusion so that it is identical to the target term.
+  This substitution is kept track of by the substitution alist:
   ~bv[]
   ((LHS . (binary-+ '3
                      (binary-+ (expt a n) (foo a c))))
    (RHS . (binary-+ (bar b) (expt a n)))).
   ~ev[]
   ACL2 then attempts to relieve the hypotheses in the order they were
-  given. Ordinarily this means that we instantiate each hypothesis
-  with our substitution and then attempt to rewrite the resulting
-  instance to true.  Thus, in order to relieve the first hypothesis,
-  we rewrite:
+  given.  Ordinarily this means that we instantiate each hypothesis with our
+  substitution and then attempt to rewrite the resulting instance to true.
+  Thus, in order to relieve the first hypothesis, we rewrite:
   ~bv[]
   (RATIONALP (binary-+ '3
                         (binary-+ (expt a n) (foo a c)))).
   ~ev[]
-  Let us assume that the first two hypotheses rewrite to ~c[t].  How
-  do we relieve the ~c[bind-free] hypothesis?  Just as for a ~ilc[syntaxp]
-  hypothesis, ACL2 evaluates ~c[(find-match-in-plus-nests lhs rhs)]
-  in an environment where ~c[lhs] and ~c[rhs] are instantiated as determined
-  by the substitution.  In this case we evaluate
+  Let us assume that the first two hypotheses rewrite to ~c[t].  How do we
+  relieve the ~c[bind-free] hypothesis?  Just as for a ~ilc[syntaxp]
+  hypothesis, ACL2 evaluates ~c[(find-match-in-plus-nests lhs rhs)] in an
+  environment where ~c[lhs] and ~c[rhs] are instantiated as determined by the
+  substitution.  In this case we evaluate
   ~bv[]
   (FIND-MATCH-IN-PLUS-NESTS '(binary-+ '3
                                         (binary-+ (expt a n) (foo a c)))
@@ -6997,16 +7076,16 @@
   Observe that, just as in the case of a ~ilc[syntaxp] hypothesis, we
   substitute the quotation of the variables bindings into the term to be
   evaluated.  ~l[syntaxp] for the reasons for this.  The result of this
-  evaluation, ~c[((X . (EXPT A N)))], is then used to extend the
-  substitution alist:
+  evaluation, ~c[((X . (EXPT A N)))], is then used to extend the substitution
+  alist:
   ~bv[]
   ((X . (EXPT A N))
    (LHS . (binary-+ '3
                      (binary-+ (expt a n) (foo a c))))
    (RHS . (binary-+ (bar b) (expt a n)))),
   ~ev[]
-  and this extended substitution determines
-  ~c[cancel-matching-addends-equal]'s result:
+  and this extended substitution determines ~c[cancel-matching-addends-equal]'s
+  result:
   ~bv[]
   (EQUAL (+ (- X) LHS) (+ (- X) RHS))
   ==>
@@ -7016,26 +7095,23 @@
   Question: What is the internal form of this result?~nl[]
   Hint: Use ~c[:]~ilc[trans].
 
-  When this rule fires, it adds the negation of a common term
-  to both sides of the equality by selecting a binding for the
-  otherwise-free variable ~c[x], under programmatic control.  Note
-  that other mechanisms such as the binding of ~il[free-variables]
-  may also extend the substitution alist.
-
-  Just as for a ~ilc[syntaxp] test, a ~c[bind-free] form signals
-  failure by returning ~c[nil].  However, while a ~ilc[syntaxp] test
-  signals success by returning true, a ~c[bind-free] form signals
-  success by returning an alist which is used to extend the current
-  substitution alist.  Because of this use of the alist, there are
-  several restrictions on it ~-[] in particular the alist must only
-  bind variables, these variables must not be already bound by the
-  substitution alist, and the variables must be bound to ACL2 terms.
-  If ~c[term] returns an alist and the alist meets these restrictions,
-  we append the alist to the substitution alist and use the result as
-  the new current substitution alist.  This new current
-  substitution alist is then used when we attempt to relieve the next
-  hypothesis or, if there are no more, instantiate the right hand side
-  of the rule.
+  When this rule fires, it adds the negation of a common term to both sides of
+  the equality by selecting a binding for the otherwise-free variable ~c[x],
+  under programmatic control.  Note that other mechanisms such as the binding
+  of ~il[free-variables] may also extend the substitution alist.
+
+  Just as for a ~ilc[syntaxp] test, a ~c[bind-free] form signals failure by
+  returning ~c[nil].  However, while a ~ilc[syntaxp] test signals success by
+  returning true, a ~c[bind-free] form signals success by returning an alist
+  which is used to extend the current substitution alist.  Because of this use
+  of the alist, there are several restrictions on it ~-[] in particular the
+  alist must only bind variables, these variables must not be already bound by
+  the substitution alist, and the variables must be bound to ACL2 terms.  If
+  ~c[term] returns an alist and the alist meets these restrictions, we append
+  the alist to the substitution alist and use the result as the new current
+  substitution alist.  This new current substitution alist is then used when we
+  attempt to relieve the next hypothesis or, if there are no more, instantiate
+  the right hand side of the rule.
 
   There is also a second, optional, ~c[var-list] argument to a ~c[bind-free]
   hypothesis.  If provided, it must be either ~c[t] or a list of variables.  If
@@ -7046,15 +7122,97 @@
   this list of variables, as it allows some consistency checks to be performed
   at the time of the rule's admittance which are not possible otherwise.
 
-  An extended ~c[bind-free] hypothesis is similar to the simple type
-  described above, but it uses two additional variables, ~c[mfc] and ~c[state],
-  which must not be bound by the left hand side or an earlier hypothesis
-  of the rule.  They must be the last two variables mentioned by ~c[term]:
-  first ~c[mfc], then ~c[state].  These two variables give access to
-  the functions ~c[mfc-]xxx; ~pl[extended-metafunctions].  As
-  described there, ~c[mfc] is bound to the so-called
-  metafunction-context and ~c[state] to ACL2's ~ilc[state].  ~l[bind-free-examples]
-  for examples of the use of these extended ~c[bind-free] hypotheses.~/"
+  An extended ~c[bind-free] hypothesis is similar to the simple type described
+  above, but it uses two additional variables, ~c[mfc] and ~c[state], which
+  must not be bound by the left hand side or an earlier hypothesis of the rule.
+  They must be the last two variables mentioned by ~c[term]: first ~c[mfc],
+  then ~c[state].  These two variables give access to the functions
+  ~c[mfc-]xxx; ~pl[extended-metafunctions].  As described there, ~c[mfc] is
+  bound to the so-called metafunction-context and ~c[state] to ACL2's
+  ~ilc[state].  ~l[bind-free-examples] for examples of the use of these
+  extended ~c[bind-free] hypotheses.
+
+  ~st[SECTION]: Returning a list of alists.
+
+  As promised above, we conclude with a discussion of the case that evaluation
+  of the ~c[bind-free] term produces a list of alists, ~c[x], rather than a
+  single alist.  In this case each member ~c[b] of ~c[x] is considered in turn,
+  starting with the first and proceeding through the list.  Each such ~c[b] is
+  handled exactly as discussed above, as though it were the result of
+  evaluating the ~c[bind-free] term.  Thus, each ~c[b] extends the current
+  variable binding alist, and all remaining hypotheses are then relieved, as
+  though ~c[b] had been the value obtained by evaluating the ~c[bind-free]
+  term.  As soon as one such ~c[b] leads to successful relieving of all
+  remaining hypotheses, the process of relieving hypotheses concludes, so no
+  further members of ~c[x] are considered.
+
+  We illustrate with a simple pedagogical example.  First introduce functions
+  ~c[p1] and ~c[p2] such that a rewrite rule specifies that ~c[p2] implies
+  ~c[p1], but with a free variable.
+  ~bv[]
+
+  (defstub p1 (x) t)
+  (defstub p2 (x y) t)
+
+  (defaxiom p2-implies-p1
+    (implies (p2 x y)
+             (p1 x)))
+
+  ~ev[]
+  If we add the following axiom, then ~c[(p1 x)] follows logically for all
+  ~c[x].
+  ~bv[]
+
+  (defaxiom p2-instance
+    (p2 v (cons v 4)))
+
+  ~ev[]
+  Unfortunately, evaluation of ~c[(thm (p1 a))] fails, because ACL2 fails to
+  bind the free variable ~c[y] in order to apply the rule ~c[p2-instance].
+
+  Let's define a function that produces a list of alists, each binding the
+  variable ~c[y].  Of course, we know that only the middle one below is
+  necessary in this simple example.  In more complex examples, one might use
+  heuristics to construct such a list of alists.
+  ~bv[]
+
+  (defun my-alists (x)
+    (list (list (cons 'y (fcons-term* 'cons x ''3)))
+          (list (cons 'y (fcons-term* 'cons x ''4)))
+          (list (cons 'y (fcons-term* 'cons x ''5)))))
+
+  ~ev[]
+  The following rewrite rule uses ~c[bind-free] to return a list of candidate
+  alists binding ~c[y].
+  ~bv[]
+
+  (defthm p2-implies-p1-better
+    (implies (and (bind-free (my-alists x)
+                             (y)) ; the second argument, (y), is optional
+                  (p2 x y))
+             (p1 x)))
+
+  ~ev[]
+  Now the proof succeeds for ~c[(thm (p1 a))].  Why?  When ACL2 applies the
+  ~c[rewrite] rule ~c[p2-implies-p1-better], it evaluates ~c[my-alists], as we
+  can see from the following ~il[trace], to bind ~c[y] in three different
+  alists.
+  ~bv[]
+
+  ACL2 !>(thm (p1 a))
+  1> (ACL2_*1*_ACL2::MY-ALISTS A)
+  <1 (ACL2_*1*_ACL2::MY-ALISTS (((Y CONS A '3))
+                                ((Y CONS A '4))
+                                ((Y CONS A '5))))
+
+  Q.E.D.
+
+  ~ev[]
+  The first alist, binding ~c[y] to ~c[(cons a '3)], fails to allow the
+  hypothesis ~c[(p2 x y)] to be proved.  But the next binding of ~c[y], to
+  ~c[(cons a '4)], succeeds: then the current binding alist is
+  ~c[((x . a) (y . (cons a '4)))], for which the hypothesis ~c[(p2 x y)]
+  rewrites to true using the rewrite rule ~c[p2-instance].~/"
 
   (if vars
       `(synp (quote ,vars) (quote (bind-free ,form ,vars)) (quote ,form))
@@ -7068,7 +7226,12 @@
   examples pertaining to ~ilc[bind-free] hypotheses~/
 
   ~l[bind-free] for a basic discussion of the use of ~c[bind-free] to control
-  rewriting.~/
+  rewriting.
+
+  Note that the examples below all illustrate the common case in which a
+  ~c[bind-free] hypothesis generates a binding alist.  ~l[bind-free], in
+  particular the final section, for a discussion of the case that instead a
+  list of binding alists is generated.~/
 
   We give examples of the use of ~ilc[bind-free] hypotheses from the
   perspective of a user interested in reasoning about arithmetic, but
@@ -7350,9 +7513,9 @@
   ~il[documentation] facilities do not permit us to use keywords below).
 
   ~/
-  See also ~ilc[force], ~il[case-split], ~ilc[syntaxp], and ~ilc[bind-free]
-  for ``pragmas'' one can wrap around individual hypotheses of ~c[linear] and
-  ~c[rewrite] rules to affect how the hypothesis is relieved.
+  See also ~ilc[force], ~il[case-split], ~ilc[syntaxp], and ~ilc[bind-free] for
+  ``pragmas'' one can wrap around individual hypotheses of certain classes of
+  rules to affect how the hypothesis is relieved.
 
   Before we get into the discussion of rule classes, let us return to an
   important point.  In spite of the large variety of rule classes available, at
@@ -11348,15 +11511,14 @@
   ~ilc[verify-guards]), some introduce exactly one (e.g., ~ilc[defmacro] and
   ~ilc[defthm]), and some may introduce many (e.g., ~ilc[encapsulate] ).
 
-  ACL2 typically completes processing of an event by printing a summary that
-  includes a breakdown of runtime (cpu time) used and, unless proofs are
-  skipped (~pl[ld-skip-proofsp]) or summary output is inhibited
-  (~pl[set-inhibit-output-lst]), information about the proof attempt
-  (if any) including a list of rules used, a summary of warnings, and the
-  number of ``prover steps'' (if any; ~pl[with-prover-step-limit]).  A detail:
-  The time is calculated using Common Lisp function ~c[get-internal-run-time],
-  which may ignore calls to external tools (~pl[sys-call] and
-  ~pl[clause-processor]).
+  ACL2 typically completes processing of an event by printing a summary.
+  Unless proofs are skipped (~pl[ld-skip-proofsp]) or summary output is
+  inhibited (~pl[set-inhibit-output-lst]), information about the proof attempt
+  (if any) is printed that includes a list of rules used, a summary of
+  warnings, and the number of ``prover steps'' (if any;
+  ~pl[with-prover-step-limit]).  A breakdown of the time used is also printed,
+  which by default is runtime (cpu time), but can be changed to realtime
+  (wall clock time); ~pl[get-internal-time].
 
   ~l[embedded-event-form] for a discussion of events permitted in
   ~il[books].~/")
@@ -11387,10 +11549,12 @@
   To view the documentation in a web browser, open a browser to file
   ~c[doc/HTML/acl2-doc.html] under your ACL2 source directory, or just go to
   the ACL2 home page at ~url[http://www.cs.utexas.edu/users/moore/acl2/].
-  Alternatively, follow a link on the ACL2 home page to the new ``xdoc''
-  version of the manual, which can be found locally after running a regression
-  by pointing your web browser at community books file
-  ~c[books/xdoc/manual/preview.html].
+
+  Alternatively, follow a link on the ACL2 home page to a manual, known as the
+  xdoc manual, which incorporates (but rearranges) the ACL2 documentation as
+  well as documentation from many ACL2 community books.  You can build a local
+  copy of that manual; see for example the section ``BUILDING THE XDOC MANUAL''
+  in the community books ~c[Makefile] for instructions.
 
   To use Emacs Info (inside Emacs), first load distributed file
   ~c[emacs/emacs-acl2.el] (perhaps inside your ~c[.emacs] file) and then
@@ -12221,11 +12385,11 @@
   ; Same effect as just above:
   (with-output
      :on summary
-     :summary :all ; equivalently, the value (a list) of *summary-types*
+     :summary nil
      :gag-mode :goals
      (defthm app-assoc (equal (app (app x y) z) (app x (app y z)))))
 
-  ; Same as just above, but turn off only the indicated parts of the summary.
+  ; Turn on only the indicated parts of the summary.
   (with-output
      :on summary
      :summary (time rules)
@@ -12252,31 +12416,31 @@
   (with-output :key1 val1 ... :keyk valk form)
   ~ev[]
   where each ~c[:keyi] is either ~c[:off], ~c[:on], ~c[:stack],
-  ~c[:summary], or ~c[:gag-mode], and ~c[vali] is as follows.  If ~c[:keyi]
-  is ~c[:off] or ~c[:on], then ~c[vali] can be ~c[:all], and otherwise is a
-  symbol or non-empty list of symbols representing output types that can be
-  inhibited; ~pl[set-inhibit-output-lst].  If ~c[:keyi] is ~c[:gag-mode], then
-  ~c[vali] is one of the legal values for ~c[:]~ilc[set-gag-mode].
-  If ~c[:keyi] is ~c[:summary], then ~c[vali] is either ~c[:all] or a true-list
-  of symbols each of which belongs to the list ~c[*summary-types*].  Otherwise
-  ~c[:keyi] is ~c[:stack], in which case ~c[:vali] is ~c[:push] or ~c[:pop];
-  for now assume that ~c[:stack] is not specified (we'll return to it below).
-  The result of evaluating the General Form above is to evaluate ~c[form], but
-  in an environment where output occurs as follows.  If ~c[:on :all] is
-  specified, then every output type is turned on except as inhibited by
-  ~c[:off]; else if ~c[:off :all] is specified, then every output type is
-  inhibited except as specified by ~c[:on]; and otherwise, the
-  currently-inhibited output types are reduced as specified by ~c[:on] and then
-  extended as specified by ~c[:off].  But if ~c[:gag-mode] is specified, then
-  before modifying how output is inhibited, ~ilc[gag-mode] is set for the
-  evaluation of ~c[form] as specified by the value of ~c[:gag-mode];
-  ~pl[set-gag-mode].  If ~c[summary] is among the output types that are turned
-  on (not inhibited), then if ~c[:summary] is specified, the only parts of the
-  summary to be printed will be those specified by the value of ~c[:summary].
-  The correspondence should be clear, except perhaps that ~c[header] refers to
-  the line containing only the word ~c[Summary], and ~c[value] refers to the
-  value of the form printed during evaluation of sequences of events as for
-  ~ilc[progn] and ~ilc[encapsulate].
+  ~c[:summary], or ~c[:gag-mode]; ~c[form] evaluates to an error triple
+  (~pl[error-triples]); and ~c[vali] is as follows.  If ~c[:keyi] is ~c[:off]
+  or ~c[:on], then ~c[vali] can be ~c[:all], and otherwise is a symbol or
+  non-empty list of symbols representing output types that can be inhibited;
+  ~pl[set-inhibit-output-lst].  If ~c[:keyi] is ~c[:gag-mode], then ~c[vali] is
+  one of the legal values for ~c[:]~ilc[set-gag-mode].  If ~c[:keyi] is
+  ~c[:summary], then ~c[vali] is either ~c[:all] or a true-list of symbols each
+  of which belongs to the list ~c[*summary-types*].  Otherwise ~c[:keyi] is
+  ~c[:stack], in which case ~c[:vali] is ~c[:push] or ~c[:pop]; for now assume
+  that ~c[:stack] is not specified (we'll return to it below).  The result of
+  evaluating the General Form above is to evaluate ~c[form], but in an
+  environment where output occurs as follows.  If ~c[:on :all] is specified,
+  then every output type is turned on except as inhibited by ~c[:off]; else if
+  ~c[:off :all] is specified, then every output type is inhibited except as
+  specified by ~c[:on]; and otherwise, the currently-inhibited output types are
+  reduced as specified by ~c[:on] and then extended as specified by ~c[:off].
+  But if ~c[:gag-mode] is specified, then before modifying how output is
+  inhibited, ~ilc[gag-mode] is set for the evaluation of ~c[form] as specified
+  by the value of ~c[:gag-mode]; ~pl[set-gag-mode].  If ~c[summary] is among
+  the output types that are turned on (not inhibited), then if ~c[:summary] is
+  specified, the only parts of the summary to be printed will be those
+  specified by the value of ~c[:summary].  The correspondence should be clear,
+  except perhaps that ~c[header] refers to the line containing only the word
+  ~c[Summary], and ~c[value] refers to the value of the form printed during
+  evaluation of sequences of events as for ~ilc[progn] and ~ilc[encapsulate].
 
   Note that the handling of the ~c[:stack] argument pays no attention to the
   ~c[:summary] argument.
@@ -12643,9 +12807,9 @@
   proof.  If an error message is produced by evaluating a call of the function
   on a list of arguments that includes ~c[state] or user-defined ~ilc[stobj]s,
   these arguments will be shown as symbols such as ~c[|<state>|] in the error
-  message.  In the case of a user-defined stobj bound by
-  ~ilc[with-local-stobj] or ~ilc[stobj-let], the symbol printed will include
-  the suffix ~c[{instance}], for example, ~c[|<st>{instance}|].
+  message.  In the case of a user-defined stobj bound by ~ilc[with-local-stobj]
+  or ~ilc[stobj-let], the symbol printed will include the suffix
+  ~c[{instance}], for example, ~c[|<st>{instance}|].
 
   It is harmless to include ~c[:non-executable t] in your own ~ilc[xargs]
   ~ilc[declare] form; ~c[defun-nx] will still lay down its own such
@@ -13359,15 +13523,129 @@
 
 (defmacro msg (str &rest args)
 
-; This macro returns a pair suitable giving to the fmt directive ~@.  Fmt is
-; defined much later.  But we need msg now because several of our macros
+; Fmt is defined much later.  But we need msg now because several of our macros
 ; generate calls of msg and thus msg must be a function when terms using those
 ; macros are translated.
 
-; In any case, suppose that #\0, say, is bound to the value of this function.
-; Then the fmt directive ~@0 will print out the string, str, above, in the
-; context of the alist in which the successive fmt variables #\0 through
-; possibly #\9 are bound to the successive elements of args.
+  ":Doc-Section ACL2::ACL2-built-ins
+
+  construct a ``message'' suitable for the ~c[~~@] directive of ~ilc[fmt]~/
+
+  ~l[fmt] for background on formatted printing with ACL2.
+
+  We document ~c[msg] precisely below, but first, we give an informal
+  introduction and illustrate with an example.  Suppose you are writing a
+  program that is to do some printing.  Typically, you will either pass the
+  ACL2 state around (~pl[programming-with-state]) and use formatted printing
+  functions that take the state as an argument (~pl[fmt])), or else you might
+  avoid using state by calling the utility, ~ilc[cw], to do you printing.
+  Alternatively, you might print error messages upon encountering illegal
+  situations; ~pl[er].  But there are times where instead of printing
+  immediately, you may prefer to pass messages around, for example to
+  accumulate them before printing a final message.  In such cases, it may be
+  desirable to construct ``message'' objects to pass around.
+
+  For example, consider the following pair of little programs.  The first
+  either performs a computation or prints an error, and the second calls the
+  first on two inputs.
+  ~bv[]
+
+  (defun invert1 (x)
+    (if (consp x)
+        (cons (cdr x) (car x))
+      (prog2$ (cw \"ERROR: ~~x0 expected a cons, but was given ~~x1.~~|\"
+                  'invert1 x)
+              nil)))
+
+  (defun invert2 (x1 x2)
+    (list (invert1 x1) (invert1 x2)))
+
+  ~ev[]
+  For example:
+  ~bv[]
+
+    ACL2 !>(invert1 '(3 . 4))
+    (4 . 3)
+    ACL2 !>(invert1 'a)
+    ERROR: INVERT1 expected a cons, but was given A.
+    NIL
+    ACL2 !>(invert2 '(3 . 4) '(5 . 6))
+    ((4 . 3) (6 . 5))
+    ACL2 !>(invert2 'a 'b)
+    ERROR: INVERT1 expected a cons, but was given A.
+    ERROR: INVERT1 expected a cons, but was given B.
+    (NIL NIL)
+    ACL2 !>
+
+  ~ev[]
+  Notice that when there are errors, there is no attempt to explain that these
+  are due to a call of ~c[invert2].  That could be fixed, of course, by
+  arranging for ~c[invert2] to print its own error; but for complicated
+  programs it can be awkward to coordinate printing from many sources.  So
+  let's try a different approach.  This time, the first function returns two
+  results.  The first result is an ``error indicator'' ~-[] either a message
+  object or ~c[nil] ~-[] while the second is the computed value (only of
+  interest when the first result is ~c[nil]).  Then the higher-level function
+  can print a single error message that includes the error message(s) from the
+  lower-level function, as shown below.
+  ~bv[]
+
+  (defun invert1a (x)
+    (if (consp x)
+        (mv nil
+            (cons (cdr x) (car x)))
+      (mv (msg \"ERROR: ~~x0 expected a cons, but was given ~~x1.~~|\"
+               'invert1a x)
+          nil)))
+
+  (defun invert2a (x1 x2)
+    (mv-let (erp1 y1)
+            (invert1a x1)
+            (mv-let (erp2 y2)
+                    (invert1a x2)
+                    (if erp1
+                        (if erp2
+                            (cw \"~~x0 failed with two errors:~~|  ~~@1  ~~@2\"
+                                'invert2a erp1 erp2)
+                          (cw \"~~x0 failed with one error:~~|  ~~@1\"
+                              'invert2a erp1))
+                      (if erp2
+                          (cw \"~~x0 failed with one error:~~|  ~~@1\"
+                              'invert2a erp2)
+                        (list y1 y2))))))
+  ~ev[]
+  For example:
+  ~bv[]
+    ACL2 !>(invert2a '(3 . 4) '(5 . 6))
+    ((4 . 3) (6 . 5))
+    ACL2 !>(invert2a '(3 . 4) 'b)
+    INVERT2A failed with one error:
+      ERROR: INVERT1A expected a cons, but was given B.
+    NIL
+    ACL2 !>(invert2a 'a 'b)
+    INVERT2A failed with two errors:
+      ERROR: INVERT1A expected a cons, but was given A.
+      ERROR: INVERT1A expected a cons, but was given B.
+    NIL
+    ACL2 !>
+  ~ev[]
+
+  If you study the example above, you might well understand ~c[msg].  But we
+  conclude with precise documentation.~/
+
+  ~bv[]
+  General Form:
+  (msg str arg1 ... argk)
+  ~ev[]
+  where ~c[str] is a string and ~c[k] is at most 9.
+
+  This macro returns a pair suitable for giving to the ~c[fmt] directive
+  ~c[~~@].  Thus, suppose that ~c[#\\c] is bound to the value of
+  ~c[(msg str arg1 ... argk)], where ~c[c] is a character and ~c[k] is at most
+  9.  Then the ~c[fmt] directive ~c[~~@c] will print out the string, ~c[str],
+  in the context of the alist in which the successive ~c[fmt] variables
+  ~c[#\\0], ~c[#\\1], ..., ~c[#\\k] are bound to the successive elements of
+  ~c[(arg1 ... argk)].~/"
 
   (declare (xargs :guard (<= (length args) 10)))
 
@@ -14160,7 +14438,7 @@
 
   Note that if you download community books as tarfiles, then you should be
   sure to download the `nonstd' books, from
-  ~url[http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz].  Then certify
+  ~url[http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz].  Then certify
   them from your acl2-sources directory, shown here as
   ~c[<DIR>]:
   ~bv[]
@@ -15788,9 +16066,6 @@
 (defparameter *acl2-unwind-protect-stack* nil)
 
 #-acl2-loop-only
-(defvar *lp-ever-entered-p* nil)
-
-#-acl2-loop-only
 (defmacro push-car (item place ctx)
   (let ((g (gensym)))
     `(let ((,g ,place))
@@ -16862,6 +17137,11 @@
   of guard verification is to ensure that during evaluation of an expression
   without free variables, no guard violation takes place.
 
+  Technical note: the first argument of ~c[verify-guards] must be a function
+  symbol or the name of a ~ilc[defthm] or ~ilc[defaxiom] event, not a
+  macro-alias for a function symbol (~pl[macro-aliases-table]).
+  ~l[verify-guards+] for a utility that does not have this restriction.
+
   Guard verification is intended to guarantee that for any call of a given
   function, if its ~il[guard] holds for that call then the ~il[guard] will hold
   for every function call in the body of that function.  Moreover, in order to
@@ -17157,6 +17437,84 @@
        (list 'quote doc)
        (list 'quote event-form)))
 
+(defmacro verify-guards+ (name &rest rest)
+
+; We considered renaming verify-guards as verify-guards-basic, and then
+; defining verify-guards on top of verify-guards-basic just as we now define
+; verify-guards+ on top of verify-guards.  But that could be complicated to
+; carry out during the boot-strap, and it could be challenging to present a
+; nice view to the user, simulataneously promoting the fiction that
+; verify-guards is a primitive while giving accurate feedback.  So we are
+; leaving verify-guards as the primitive, but improving it to point to
+; verify-guards+ when there is a macro alias.
+
+; The example in the documentation below doesn't immediately yield a proof of
+; nil, but perhaps mbe could be used for that (we haven't tried).  At any rate,
+; violation of the intent of guard verification is bad enough.
+
+  ":Doc-Section Events
+
+  verify the ~il[guard]s of a function~/
+
+  We assume familiarity with ~il[guard] verification; ~pl[verify-guards].
+  Unlike ~c[verify-guards], the macro call ~c[(verify-guards+ mac ...)] will
+  verify guards for a function, ~c[fn], such that the macro ~c[mac] is
+  associated with the function symbol ~c[fn] in ~ilc[macro-aliases-table]
+  (also ~pl[add-macro-alias]).  For example, if you define a macro ~c[app] and
+  list append function ~c[binary-app], and you associate macro ~c[app] with
+  function symbol ~c[binary-app] in ~ilc[macro-aliases-table], then evaluation
+  of the form ~c[(verify-guard+ app)] will have the effect of evaluating
+  ~c[(verify-guards fn)].  Note that in this setting, evaluation of
+  ~c[(verify-guard app)] would cause an error, because ~c[app] is a macro and
+  ~c[verify-guards], unlike ~c[verify-guards+], cannot handle macros.~/
+
+  The rest of this ~il[documentation] topic discusses why we do not simply
+  arrange that ~c[verify-guards] be permitted to take a macro alias.  The
+  following example shows a soundness issue in doing so.
+  ~bv[]
+  (encapsulate
+   ()
+   (defun f1 (x)
+     (declare (xargs :guard (consp x)
+                     :verify-guards nil))
+     (car x))
+   (defun f2 (x)
+     (declare (xargs :guard t
+                     :verify-guards nil))
+     (cdr x))
+   (defmacro mac (x)
+     x)
+   (add-macro-alias mac f2) ; silly macro alias ;
+   (local (add-macro-alias mac f1)) ; alternate silly macro alias ;
+   (verify-guards mac))
+  ~ev[]
+
+  If we were to allow macro aliases in ~ilc[verify-guards], this event would be
+  admitted, because on the first pass we are verifying guards of ~c[f1].  But
+  after the ~ilc[encapsulate] form completes evaluation, it would appear that
+  ~c[f2] is guard-verified.  That could of course cause a raw Lisp error.
+
+  The enhanced functionality provided by ~c[verify-guards+] does not have the
+  above problem, because it takes advantage of ~ilc[make-event] to avoid taking
+  advantage of the contradictory results produced by the two calls of
+  ~c[add-macro-alias].  ~l[make-event].  If the specific example above is
+  modified by replacing ~c[verify-guards] with ~c[verify-guards+], then the
+  first pass through the ~ilc[encapsulate] form will expand the form
+  ~c[(verify-guards+ mac)] to ~c[(verify-guards f1)].  That same expansion will
+  be used for the ~c[verify-guards+] call during the second pass through the
+  ~c[encapsulate] form, which is evaluated successfully and leaves us in a
+  ~il[world] where ~c[f1] is guard-verified and ~c[f2] is not.~/"
+
+  `(make-event
+    (let* ((name ',name)
+           (rest ',rest)
+           (fn (deref-macro-name name (macro-aliases (w state)))))
+      (pprogn (observation 'verify-guards+
+                           "Attempting to verify guards for ~x0."
+                           fn)
+              (value (list* 'verify-guards fn rest))))
+    :expansion? (verify-guards ,name ,@rest)))
+
 (defdoc defpun
 
   ":Doc-Section acl2::Events
@@ -17323,7 +17681,7 @@
   (defconst-fast *x* (expensive-fn ...))
   ~ev[]
   A more general utility may be found in community book
-  ~c[books/tools/defconsts.lisp].  Also ~il[using-tables-efficiently] for an
+  ~c[books/tools/defconsts.lisp].  Also ~pl[using-tables-efficiently] for an
   analogous issue with ~ilc[table] events.
 
   It may be of interest to note that ~c[defconst] is implemented at the
@@ -17964,20 +18322,20 @@
             :congruent-to old-stobj-name)
   ~ev[]
   where ~c[name] is a new symbol, each ~c[fieldi] is a symbol, each ~c[typei]
-  is either a ~ilc[type-spec] or ~c[(ARRAY] ~ilc[type-spec] ~c[(max))], each
-  ~c[vali] is an object satisfying ~c[typei], and each ~c[bi] is ~c[t] or
-  ~c[nil].  Each pair ~c[:initially vali] and ~c[:resizable bi] may be omitted;
-  more on this below.  The ~c[:renaming alist] argument is optional and allows
-  the user to override the default function names introduced by this event.
-  The ~ilc[doc-string] is also optional.  The ~c[:inline flg] Boolean argument
-  is also optional and declares to ACL2 that the generated access and update
-  functions for the stobj should be implemented as macros under the hood (which
-  has the effect of inlining the function calls).  The optional
-  ~c[:congruent-to old-stobj-name] argument specifies an existing stobj with
-  exactly the same structure, and is discussed below.  We describe further
-  restrictions on the ~c[fieldi], ~c[typei], ~c[vali], and on ~c[alist] below.
-  We recommend that you read about single-threaded objects (stobjs) in ACL2
-  before proceeding; ~pl[stobj].
+  is either a type-indicator (a ~ilc[type-spec] or ~il[stobj] name) or of the
+  form ~c[(ARRAY type-indicator max)], each ~c[vali] is an object satisfying
+  ~c[typei], and each ~c[bi] is ~c[t] or ~c[nil].  Each pair
+  ~c[:initially vali] and ~c[:resizable bi] may be omitted; more on this below.
+  The ~c[:renaming alist] argument is optional and allows the user to override
+  the default function names introduced by this event.  The ~ilc[doc-string] is
+  also optional.  The ~c[:inline flg] Boolean argument is also optional and
+  declares to ACL2 that the generated access and update functions for the stobj
+  should be implemented as macros under the hood (which has the effect of
+  inlining the function calls).  The optional ~c[:congruent-to old-stobj-name]
+  argument specifies an existing stobj with exactly the same structure, and is
+  discussed below.  We describe further restrictions on the ~c[fieldi],
+  ~c[typei], ~c[vali], and on ~c[alist] below.  We recommend that you read
+  about single-threaded objects (stobjs) in ACL2 before proceeding; ~pl[stobj].
 
   The effect of this event is to introduce a new single-threaded object (i.e.,
   a ``~il[stobj]''), named ~c[name], and the associated recognizers, creator,
@@ -18000,7 +18358,7 @@
   a type-spec; ~pl[type-spec].  However, ~c[type-indicator] can also be the
   name of a stobj that was previously introduced (by ~c[defstobj] or
   ~ilc[defabsstobj]).  We ignore this ``nested stobj'' case below;
-  ~pl[stobj-let] for a discussion of stobjs within stobjs.
+  ~pl[nested-stobjs] for a discussion of stobjs within stobjs.
 
   The keyword value ~c[:initially val] specifies the initial value of a field,
   except for the case of a ~c[:type] ~c[(ARRAY type-indicator (max))], in which
@@ -18027,10 +18385,10 @@
   are not evaluated.  If omitted, the type defaults to ~c[t] (unrestricted) and
   the initial value defaults to ~c[nil].
 
-  Each ~c[typei] must be either a ~ilc[type-spec] (with the exception noted
-  above for nested stobjs, discussed elsewhere; ~pl[stobj-let]) or else a list
-  of the form ~c[(ARRAY type-spec (max))].  The latter forms are said to be
-  ``array types.''  Examples of legal ~c[typei] are:
+  Each ~c[typei] must be either a ~ilc[type-spec] or else a list of the form
+  ~c[(ARRAY type-spec (max))].  (Again, we are ignoring the case of nested
+  stobjs, discussed elsewhere; ~pl[nested-stobjs].)  The latter forms are said
+  to be ``array types.''  Examples of legal ~c[typei] are:
   ~bv[]
   (INTEGER 0 31)
   (SIGNED-BYTE 31)
@@ -19077,7 +19435,8 @@
   the theorem ~c[foo-preserves-consp] is encountered in the second pass,
   ~c[foo] is a known function symbol with the indicated signature.
 
-  We turn now to more complete documentation.
+  We turn now to more complete documentation.  But discussion of redundancy for
+  ~c[encapsulate] events may be found elsewhere; ~pl[redundant-encapsulate].
 
   ~bv[]
   Other Examples:
@@ -19225,27 +19584,6 @@
   made to the ~il[world] by the superior ~c[encapsulate], to permit
   ~c[an-element] to be used as a function symbol in ~c[thm1].
 
-  The typical way for an ~c[encapsulate] event to be redundant is when a
-  syntactically identical ~c[encapsulate] has already been executed under the
-  same ~ilc[default-defun-mode], ~ilc[default-ruler-extenders], and
-  ~ilc[default-verify-guards-eagerness].  More generally, the ~c[encapsulate]
-  events need not be syntactically identical, but rather, need only to
-  correspond in the following sense: they contain the same signatures and the
-  same number of top-level events ~-[] let ~c[k] be that number ~-[] and for
-  each ~c[i < k], the ~c[i]th top-level events ~c[E1] and ~c[E2] from the
-  earlier and current ~c[encapsulate]s have one of the following properties.
-
-  o ~c[E1] and ~c[E2] are equal; or
-
-  o ~c[E1] is of the form ~c[(record-expansion E2 ...)]; or else
-
-  o ~c[E1] and ~c[E2] are equal after replacing each ~ilc[local] sub-event by
-  ~c[(local (value-triple :elided))], where a sub-event of an event ~c[E] is
-  either ~c[E] itself, or a sub-event of a constituent event of ~c[E] in the
-  case that ~c[E] is a call of ~ilc[with-output], ~ilc[with-prover-time-limit],
-  ~ilc[with-prover-step-limit], ~c[record-expansion], ~ilc[time$], ~ilc[progn],
-  ~ilc[progn!], or ~c[encapsulate] itself.
-
   Remark for ACL2(r) (~pl[real]).  For ACL2(r), ~ilc[encapsulate] can be used
   to introduce classical and non-classical functions, as determined by the
   signatures; ~pl[signature].  Those marked as classical (respectively
@@ -19261,6 +19599,99 @@
         'state
         (list 'quote event-form)))
 
+(defdoc redundant-encapsulate
+  ":Doc-Section encapsulate
+
+  redundancy of ~ilc[encapsulate] ~il[events]~/
+
+  For this ~il[documentation] topic we assume familiarity with ~c[encapsulate]
+  events and the notion of redundancy for ~il[events]; ~pl[encapsulate] and
+  ~pl[redundant-events].
+
+  The typical way for an ~c[encapsulate] event to be redundant is when a
+  syntactically identical ~c[encapsulate] has already been executed under the
+  same ~ilc[default-defun-mode], ~ilc[default-ruler-extenders], and
+  ~ilc[default-verify-guards-eagerness].  But more generally, the
+  ~c[encapsulate] events need not be syntactically identical; for example, it
+  suffices that they agree when the contents of ~ilc[local] sub-events are
+  ignored.  The precise criterion for redundancy is given below, but let us
+  first look at a consequence of the point just made about ignoring the
+  contents of ~ilc[local] sub-events.  Consider the following sequence of two
+  events.
+  ~bv[]
+  (encapsulate
+   ()
+   (defun f (x) x)
+   (local (defthm f-identity
+            (equal (f x) x))))
+
+  (encapsulate
+   ()
+   (defun f (x) x)
+   (local (defthm false-claim
+            (equal (f x) (not x)))))
+  ~ev[]
+  You might be surprised to learn that the second is actually redundant, even
+  though ~c[false-claim] is clearly not a theorem; indeed, its negation is a
+  theorem!  The following two points may soften the blow.  First, this behavior
+  is as specified above (and is specified more precisely below): the contents
+  of ~il[local] events are ignored when checking redundancy of
+  ~ilc[encapsulate] events.  Second, this behavior is sound, because the
+  logical meaning of an ~ilc[encapsulate] event is taken from the events that
+  it exports, which do not include events that are ~il[local] to the
+  ~c[encapsulate] event.
+
+  Some users, however, want to use ~ilc[encapsulate] events for testing in a
+  way that is thwarted by this ignoring of ~il[local] sub-events.  Consider
+  the following sort of example.
+  ~bv[]
+  (encapsulate ()
+               (local (defthm test1 ...)))
+
+  (encapsulate ()
+               (local (defthm test2 ...)))
+  ~ev[]
+  Since the contents of local events are ignored when checking redundancy of an
+  ~c[encapsulate] event, the second form just above is indeed redundant,
+  presumably not as expected by whomever wrote these two tests.  A solution is
+  to add distinct non-local forms, for example as follows.
+  ~bv[]
+  (encapsulate ()
+               (value-triple \"test1\")
+               (local (defthm test1 ...)))
+
+  (encapsulate ()
+               (value-triple \"test2\")
+               (local (defthm test2 ...)))
+  ~ev[]
+  A different solution is to use ~ilc[make-event] for testing, as follows.
+  ~bv[]
+  (make-event (er-progn (defthm test1 ...)
+                        (value '(value-triple nil))))
+  (make-event (er-progn (defthm test2 ...)
+                        (value '(value-triple nil))))
+  ~ev[]
+  Also see community books ~c[misc/eval.lisp], ~c[make-event/eval-check.lisp],
+  and ~c[make-event/eval-tests.lisp] for more ways to test in books.
+
+  The precise criterion for redundancy of ~ilc[encapsulate] ~il[events] is that
+  the existing and proposed ~c[encapsulate] events contain the same signatures
+  and the same number of top-level events ~-[] let ~c[k] be that number ~-[]
+  and for each ~c[i < k], the ~c[i]th top-level events ~c[E1] and ~c[E2] from
+  the earlier and current ~c[encapsulate]s have one of the following
+  properties.
+
+  o ~c[E1] and ~c[E2] are equal; or
+
+  o ~c[E1] is of the form ~c[(record-expansion E2 ...)]; or else
+
+  o ~c[E1] and ~c[E2] are equal after replacing each ~ilc[local] sub-event by
+  ~c[(local (value-triple :elided))], where a sub-event of an event ~c[E] is
+  either ~c[E] itself, or a sub-event of a constituent event of ~c[E] in the
+  case that ~c[E] is a call of ~ilc[with-output], ~ilc[with-prover-time-limit],
+  ~ilc[with-prover-step-limit], ~c[record-expansion], ~ilc[time$], ~ilc[progn],
+  ~ilc[progn!], or ~c[encapsulate] itself.~/~/")
+
 (defconst *load-compiled-file-values*
   '(t nil :warn :default :comp))
 
@@ -19422,11 +19853,10 @@
 
   At the beginning of execution of an ~c[include-book] form, even before
   executing ~il[portcullis] ~il[command]s, the value of
-  ~ilc[acl2-defaults-table] is restored to the value it had at startup, except
-  that the value of key ~c[:inhibit-warnings] is preserved.  After execution of
-  an ~c[include-book] form, the value of ~ilc[acl2-defaults-table] is restored
-  to what it was immediately before that ~c[include-book] form was executed.
-  ~l[acl2-defaults-table].
+  ~ilc[acl2-defaults-table] is restored to the value it had at startup.  After
+  execution of an ~c[include-book] form, the value of ~ilc[acl2-defaults-table]
+  is restored to what it was immediately before that ~c[include-book] form was
+  executed.  ~l[acl2-defaults-table].
 
   ~b[Books Directory.]  We refer to the ``books directory'' of an executable
   image as the full pathname string of the directory associated with
@@ -19471,7 +19901,8 @@
 #+acl2-loop-only
 (defmacro make-event (&whole event-form
                              form
-                             &key check-expansion on-behalf-of)
+                             &key
+                             expansion? check-expansion on-behalf-of)
 
 ; Essay on Make-event
 
@@ -19540,7 +19971,8 @@
   ~st[Detailed Documentation]~nl[]
   ~st[Error Reporting]~nl[]
   ~st[Restriction to Event Contexts]~nl[]
-  ~st[Examples illustrating how to access state]
+  ~st[Examples Illustrating How to Access State]~nl[]
+  ~st[Advanced Expansion Control]
 
   We begin with an informal introduction, which focuses on examples and
   introduces the key notion of ``expansion phase''.
@@ -19736,34 +20168,37 @@
   ; should return the same value as it did when the book was
   ; certified.
   (make-event (generate-form state)
-              :check-expansion t)
+              :CHECK-EXPANSION t)
 
-  ; As above (where the :check-expansion value can be included or
+  ; As above (where the :CHECK-EXPANSION value can be included or
   ; not), where if there is an error during expansion, then the error
   ; message will explain that expansion was on behalf of the indicated
   ; object, typically specified as the first argument.
   (make-event (generate-form state)
-              :on-behalf-of (generate-form state))
+              :ON-BEHALF-OF (generate-form state))
 
   General Form:
-  (make-event form :check-expansion chk :on-behalf-of obj)
+  (make-event form :CHECK-EXPANSION chk :ON-BEHALF-OF obj :EXPANSION? form)
   ~ev[]
   where ~c[chk] is ~c[nil] (the default), ~c[t], or the intended ``expansion
   result'' from the evaluation of ~c[form] (as explained below); and if
   supplied, ~c[obj] is an arbitrary ACL2 object, used only in reporting errors
-  in expansion, i.e., in the evaluation of form.
+  in expansion, i.e., in the evaluation of form.  The ~c[:EXPANSION?] keyword
+  is discussed in the final section, on Advanced Expansion Control.
 
   We strongly recommend that you browse some ~c[.lisp] files in the community
   books directory ~c[books/make-event/].  You may even find it helpful, in
   order to understand ~c[make-event], to do so before continuing to read this
-  documentation.  For example, ~c[eval.lisp] contains definitions of macros
+  documentation.  You may also find it useful to browse community book
+  ~c[books/misc/eval.lisp], which contains definitions of macros
   ~c[must-succeed] and ~c[must-fail] that are useful for testing and are used
-  in many other books in that directory, especially ~c[eval-tests.lisp].
-  Another example, ~c[defrule.lisp], shows how to use macros whose calls expand
-  to ~c[make-event] forms, which in turn can generate ~il[events].  For more
-  examples, see file ~c[Readme.lsp] in the above directory.  Other than the
-  examples, the explanations here should suffice for most users.  If you want
-  explanations of subtler details, ~pl[make-event-details].
+  in many books in the ~c[books/make-event/] directory, especially
+  ~c[eval-tests.lisp].  Another example, ~c[books/make-event/defrule.lisp],
+  shows how to use macros whose calls expand to ~c[make-event] forms, which in
+  turn can generate ~il[events].  For more examples, see file
+  ~c[books/make-event/Readme.lsp].  Other than the examples, the explanations
+  here should suffice for most users.  If you want explanations of subtler
+  details, ~pl[make-event-details].
 
   Note that ~c[make-event] may only be used at the ``top level'' or where an
   event is expected.  See the section ``Restriction to Event Contexts'', below.
@@ -19771,7 +20206,9 @@
   ~c[Make-event] is related to Lisp macroexpansion in the sense that its
   argument is evaluated to obtain an expansion result, which is evaluated
   again.  Let us elaborate on each of these notions in turn: ``is evaluated,''
-  ``expansion result'', and ``evaluated again.''~bq[]
+  ``expansion result'', and ``evaluated again.''  The final section, on
+  Advanced Expansion Control, will generalize these processes in a way that we
+  ignore for now.~bq[]
 
   ``is evaluated'' ~-[] The argument can be any expression, which is evaluated
   as would be any expression submitted to ACL2's top level loop.  Thus,
@@ -19784,34 +20221,31 @@
   ~ilc[state] global variables (~pl[assign]) are preserved).  So, for example,
   events might be evaluated during expansion, but they will disappear from the
   logical ~il[world] after expansion returns its result.  Moreover, proofs are
-  enabled by default at the start of expansion (~pl[ld-skip-proofsp]), because
-  an anticipated use of ~c[make-event] is to call the prover to decide which
-  event to generate, and that would presumably be necessary even if proofs had
-  been disabled.
+  enabled by default at the start of expansion (~pl[ld-skip-proofsp]) if
+  keyword ~c[:CHECK-EXPANSION] is supplied and has a non-~c[nil] value.
 
   ``expansion result'' ~-[] The above expansion may result in an ordinary
   (non-~ilc[state], non-~ilc[stobj]) value, which we call the ``expansion
   result.''  Or, expansion may result in a multiple value of the form
-  ~c[(mv erp val state stobj-1 ... stobj-k)], where ~c[k] may be 0; in fact the
-  most common case is probably ~c[(mv erp val state)].  In that case, if
-  ~c[erp] is not ~c[nil], then there is no expansion result, and the original
-  ~c[make-event] evaluates to a soft error.  If however ~c[erp] is ~c[nil],
-  then the resulting value is ~c[val].  Moreover, ~c[val] must be an embedded
-  event form (~pl[embedded-event-form]); otherwise, the original ~c[make-event]
-  evaluates to a soft error.  Note that error messages from expansion are
-  printed as described under ``Error Reporting'' below.
+  ~c[(mv erp val state)], or, more generally,
+  ~c[(mv erp val state stobj-1 ... stobj-k)] where each ~c[stobj-i] is a
+  ~il[stobj]; then the expansion result is ~c[val] unless ~c[erp] is not
+  ~c[nil], in which case there is no expansion result, and the original
+  ~c[make-event] evaluates to a soft error.  In either case (single or multiple
+  value), either ~c[val] is an embedded event form (~pl[embedded-event-form]),
+  or else the original ~c[make-event] evaluates to a soft error, printed as
+  described under ``Error Reporting'' below.
 
   ``evaluated again'' ~-[] the expansion result is evaluated in place of the
   original ~c[make-event].
 
-  ~eq[]Note that the result of expansion can be an ordinary event, but it can
-  instead be another call of ~c[make-event], or even of a call of a macro that
-  expands to a call of ~c[make-event].  Or, expansion itself can cause
-  subsidiary calls of ~c[make-event], for example if expansion uses ~ilc[ld] to
-  evaluate some ~c[make-event] forms.  The state global variable
-  ~c[make-event-debug] may be set to a non-~c[nil] value in order to see a
-  trace of the expansion process, where the level shown (as in ``~c[3>]'')
-  indicates the depth of expansions in progress.
+  ~eq[]The expansion process can invoke subsidiary calls of ~c[make-event], and
+  the expansion result can (perhaps after macroexpansion) be a call of
+  ~c[make-event].  It can be useful to track all these ~c[make-event] calls.
+  The ~il[state] global variable ~c[make-event-debug] may be set to a
+  non-~c[nil] value, for example ~c[(assign make-event-debug t)], in order to
+  see a trace of the expansion process, where a level is displayed (as in
+  ``~c[3>]'') to indicate the depth of subsidiary expansions.
 
   Expansion of a ~c[make-event] call will yield an event that replaces the
   original ~c[make-event] call.  In particular, if you put a ~c[make-event]
@@ -19819,52 +20253,57 @@
   created during the proof pass of the ~ilc[certify-book] process.  We now
   elaborate on this idea of keeping the original expansion.
 
-  By default, a ~c[make-event] call in a certified book is replaced (by a
-  process hidden from the user, in an ~c[:expansion-alist] field of the book's
-  ~il[certificate]) by the expansion result from evaluation of its first
-  argument.  Thus, although the book is not textually altered during
-  certification, one may imagine a ``book expansion'' corresponding to the
-  original book in which all of the events for which expansion took place
-  (during the proof phase of certification) have been replaced by their
-  expansions.  A subsequent ~ilc[include-book] will then include the book
-  expansion corresponding to the indicated book.  When a book is compiled
-  during ~ilc[certify-book], it is actually the corresponding book expansion,
-  stored as a temporary file, that is compiled instead.  That temporary file is
-  deleted after compilation unless one first evaluates the form
-  ~c[(assign keep-tmp-files t)].  Note however that all of the original forms
-  must still be legal ~il[events] (~pl[embedded-event-form]).  So for example,
-  if the first event in a book is ~c[(local (defmacro my-id (x) x))], followed
-  by ~c[(my-id (make-event ...))], the final ``~c[include-book]'' pass of
-  ~ilc[certify-book] will fail because ~c[my-id] is not defined when the
-  ~c[my-id] call is encountered.
-
-  The preceding paragraph begins with ``by default'' because if you specify
-  ~c[:check-expansion t], then subsequent evaluation of the same ~c[make-event]
-  call ~-[] during the second pass of an ~ilc[encapsulate] or during event
-  processing on behalf of ~ilc[include-book] ~-[] will do the expansion again
-  and check that the expansion result equals the original expansion result.  In
-  the unusual case that you know the expected expansion result, ~c[res], you
-  can specify ~c[:check-expansion res].  This will will cause a check that
-  every subsequent expansion result for the ~c[make-event] form is ~c[res],
-  including the original one.  IMPORTANT NOTE: That expansion check is only
-  done when processing events, not during a preliminary load of a book's
-  compiled file.  The following paragraph elaborates.
+  A ~c[make-event] call generates a ``~c[make-event] replacement'' that may be
+  stored by the system.  In the simplest case, this replacement is the
+  expansion result.  When a book is certified, these replacements are stored in
+  a book's certificate (technically, in the ~c[:EXPANSION-ALIST] field).  Thus,
+  although the book is not textually altered during certification, one may
+  imagine a ``book expansion'' corresponding to the original book, in which
+  events are substituted by replacements that were generated during the proof
+  phase of certification.  A subsequent ~ilc[include-book] will then include
+  the book expansion corresponding to the indicated book.  When a book is
+  compiled during ~ilc[certify-book], it is actually the corresponding book
+  expansion, stored as a temporary file, that is compiled instead.  That
+  temporary file is deleted after compilation unless one first evaluates the
+  form ~c[(assign keep-tmp-files t)].  Note however that all of the original
+  forms must still be legal ~il[events]; ~pl[embedded-event-form].  So for
+  example, if the first event in a book is ~c[(local (defmacro my-id (x) x))],
+  and is followed by ~c[(my-id (make-event ...))], the final
+  ``~c[include-book]'' pass of ~ilc[certify-book] will fail because ~c[my-id]
+  is not defined when the ~c[my-id] call is encountered.
+
+  A ~c[make-event] replacement might not be the expansion when either of the
+  keyword arguments ~c[:CHECK-EXPANSION] or ~c[:EXPANSION?] is supplied.  We
+  deal with the latter in the final section, on Advanced Expansion Control.  If
+  ~c[:CHECK-EXPANSION t] is supplied and the expansion is ~c[exp], then the
+  replacement is obtained from the original ~c[make-event] call, by
+  substituting ~c[exp] for ~c[t] as the value of keyword ~c[:CHECK-EXPANSION].
+  Such a ~c[make-event] call ~-[] during the second pass of an
+  ~ilc[encapsulate] or during event processing on behalf of ~ilc[include-book]
+  ~-[] will do the expansion again and check that the expansion result is equal
+  to the original expansion result, ~c[exp].  In the unusual case that you know
+  the expected expansion result, ~c[res], you can specify
+  ~c[:CHECK-EXPANSION res] in the first place, so that the check is also done
+  during the initial evaluation of the ~c[make-event] form.  IMPORTANT BUT
+  OBSCURE DETAIL: That expansion check is only done when processing events, not
+  during a preliminary load of a book's compiled file.  The following paragraph
+  elaborates.
 
   (Here are details on the point made just above, for those who use the
-  ~c[:check-expansion] argument to perform side-effects on the ~il[state].
+  ~c[:CHECK-EXPANSION] argument to perform side-effects on the ~il[state].
   When you include a book, ACL2 generally loads a compiled file before
   processing the events in the book; ~pl[book-compiled-file].  While it is true
-  that a non-~c[nil] ~c[:check-expansion] argument causes ~ilc[include-book] to
+  that a non-~c[nil] ~c[:CHECK-EXPANSION] argument causes ~ilc[include-book] to
   perform expansion of the ~c[make-event] form during event processing it does
   ~em[not] perform expansion when the compiled file (or expansion file; again,
   ~pl[book-compiled-file]) is loaded.)
 
-  ACL2 performs the following space-saving optimization for book certificates:
-  a ~ilc[local] event arising from ~c[make-event] expansion is replaced in that
-  expansion by ~c[(local (value-triple :ELIDED))].
+  ACL2 performs the following space-saving optimization: when the expansion
+  result is a ~ilc[local] event, then the ~c[make-event] replacement is
+  ~c[(local (value-triple :ELIDED))].
 
-  We note that ACL2 extends the notion of ``make-event expansion'' to the case
-  that a call of ~c[make-event] is found in the course of macroexpansion.  The
+  The notion of ``expansion'' and ``replacement'' extend to the case that a
+  call of ~c[make-event] is found in the course of macroexpansion.  The
   following example illustrates this point.
   ~bv[]
   (encapsulate
@@ -19875,7 +20314,7 @@
   :pe :here
   ~ev[]
   The above call of ~ilc[pe] shows that the form ~c[(my-mac)] has a
-  ~c[make-event] expansion of ~c[(DEFUN FOO (X) X)]:
+  ~c[make-event] expansion (and replacement) of ~c[(DEFUN FOO (X) X)]:
   ~bv[]
   (ENCAPSULATE NIL
                (DEFMACRO MY-MAC
@@ -19897,10 +20336,12 @@
 
   ~st[Restriction to Event Contexts]
 
-  A ~c[make-event] call must occur either at the top level or as an argument of
-  an event constructor, as explained in more detail below.  This restriction is
-  imposed to enable ACL2 to track expansions produced by ~c[make-event].  The
-  following examples illustrate this restriction.
+  A ~c[make-event] call must occur either at the top level, or during
+  ~c[make-event] expansion, or as an argument of an event constructor.  We
+  explain in more detail below.  This restriction is imposed to enable ACL2 to
+  track expansions produced by ~c[make-event].
+
+  The following examples illustrate this restriction.
   ~bv[]
   ; Legal:
   (progn (with-output
@@ -19913,10 +20354,12 @@
           (mv erp val state))
   ~ev[]
 
-  More precisely: after macroexpansion has taken place, a ~c[make-event] call
-  must be in an ``event context'', defined recursively as follows.  (All but
-  the first two cases below correspond to similar cases for constructing
-  events; ~pl[embedded-event-form].)
+  More precisely: a ~c[make-event] call that is not itself evaluated during
+  ~c[make-event] expansion is subject to the following requirement.  After
+  macroexpansion has taken place, such a ~c[make-event] call must be in an
+  ``event context'', defined recursively as follows.  (All but the first two
+  cases below correspond to similar cases for constructing events;
+  ~pl[embedded-event-form].)
   ~bq[]
 
   o A form submitted at the top level, or more generally, supplied to a call of
@@ -19938,17 +20381,17 @@
   ~c[(]~ilc[WITH-PROVER-TIME-LIMIT]~c[ ... x1)] is in an event context, then so
   is ~c[x1].
 
-  o Given a call of ~ilc[PROGN] or ~ilc[PROGN!] in an event context, each of its
-  arguments is in an event context.
+  o For any call of ~ilc[PROGN] or ~ilc[PROGN!], each of its arguments is in an
+  event context.
 
-  o Given a call of ~ilc[ENCAPSULATE] in an event context, each of its
-  arguments except the first (the signature list) is in an event context.
+  o For any call of ~ilc[ENCAPSULATE], each of its arguments except the
+  first (the signature list) is in an event context.
 
   o If ~c[(RECORD-EXPANSION x1 x2)] is in an event context, then ~c[x1] and
   ~c[x2] are in event contexts.  Note: ~c[record-expansion] is intended for use
   only by the implementation, which imposes the additional restriction that
   ~c[x1] and its subsidiary ~c[make-event] calls (if any) must specify a
-  ~c[:check-expansion] argument that is a ~il[consp].
+  ~c[:CHECK-EXPANSION] argument that is a ~il[consp].
   ~eq[]
 
   Low-level remark, for system implementors.  There is the one exception to
@@ -19959,11 +20402,11 @@
   ~ev[]
   However, the following form may be preferable (~pl[progn!]):
   ~bv[]
-  (progn! :state-global-bindings <bindings> (make-event ...))
+  (progn! :STATE-GLOBAL-BINDINGS <bindings> (make-event ...))
   ~ev[]
   Also ~pl[remove-untouchable] for an interesting use of this exception.
 
-  ~st[Examples illustrating how to access state]
+  ~st[Examples Illustrating How to Access State]
 
   You can modify the ACL2 ~il[state] by doing your state-changing computation
   during the expansion phase, before expansion returns the event that is
@@ -20011,7 +20454,7 @@
   ~bv[]
   (make-event
     (let ((world-len (length (w state))))
-      `(progn (table my-table :stored-world-length ,world-len)
+      `(progn (table my-table :STORED-WORLD-LENGTH ,world-len)
               (defun foo (x) (cons x ,world-len)))))
   ~ev[]
   Then:
@@ -20027,11 +20470,169 @@
 
   By the way, most built-in ~il[state] globals revert after expansion.  But
   your own global (like ~c[my-global] above) can be set during expansion, and
-  the new value will persist."
+  the new value will persist.
+
+  ~st[Advanced Expansion Control]
+
+  We conclude this ~il[documentation] section by discussing three kinds of
+  additional control over ~c[make-event] expansion.  These are all illustrated
+  in community book ~c[books/make-event/make-event-keywords-or-exp.lisp].
+  The discussion below is split into the following three parts.
+
+  (1) The value produced by expansion may have the form ~c[(:DO-PROOFS exp)],
+  which specifies ~c[exp] as the expansion result, to be evaluated without
+  skipping proofs even when including a book.
+
+  (2) The value produced by expansion may have the form
+  ~c[(:OR exp-1 ... exp-k)], which specifies that the first form ~c[exp-i] to
+  evaluate without error is the expansion result.
+
+  (3) The keyword argument ~c[:EXPANSION?] can serve to eliminate the storing
+  of ~c[make-event] replacements, as described above for the ``book expansion''
+  of a book.
+
+  We now elaborate on each of these.
+
+  (1) ~c[:DO-PROOFS] ``call'' produced by expansion.
+
+  We have discussed the expansion result produced by the expansion phase of
+  evaluating a ~c[make-event] call.  However, if the expansion phase produces
+  an expression of the form ~c[(:DO-PROOFS exp)], then the expansion result is
+  actually ~c[exp].  The ~c[:DO-PROOFS] wrapper indicates that even if proofs
+  are currently being skipped (~pl[ld-skip-proofsp]), then evaluation of
+  ~c[exp] should take place with proofs not skipped.  For example, proofs will
+  be performed when evaluating the ~c[make-event] expansion, namely the
+  indicated ~c[defthm] event, in the following example.
+  ~bv[]
+  (set-ld-skip-proofsp t state)
+  (make-event '(:DO-PROOFS
+                (defthm app-assoc (equal
+                                   (append (append x y) z)
+                                   (append x y z)))))
+  ~ev[]
+
+  Note that such use of ~c[:DO-PROOFS] causes proofs to be performed when
+  evaluating the expansion while including an uncertified book.  But when
+  including a certified book, then unless ~c[:CHECK-EXPANSION] is supplied a
+  non-~c[nil] value, the ~c[make-event] replacement will just be the expansion,
+  which does not include the ~c[:DO-PROOFS] wrapper and hence will be evaluated
+  with proofs skipped.
+
+  (2) ~c[:OR] ``call'' produced by expansion.
+
+  There may be times where you want to try different expansions.  For example,
+  the community book ~c[books/make-event/proof-by-arith.lisp] attempts to admit
+  a given event, which we'll denote ~c[EV], by trying events of the following
+  form as ~c[BOOK] varies over different community books.
+  ~bv[]
+  (encapsulate
+   ()
+   (local (include-book BOOK :DIR :SYSTEM))
+   EV)
+  ~ev[]
+  A naive implementation of this macro would evaluate all such
+  ~ilc[encapsulate] events until one succeeds, and then return that successful
+  event as the expansion.  Then that event would need to be evaluated again!
+  With some hacking one could avoid that re-evaluation by using
+  ~ilc[skip-proofs], but that won't work if you are trying to create a
+  certified book without skipped proofs.  Instead, the implementation creates
+  an expansion of the form ~c[(:OR ev-1 ev-2 ... ev-k)], where the list
+  ~c[(ev-1 ev-2 ... ev-k)] enumerates the generated encapsulate events.  In
+  general, for this ``disjunctive case'' of a result from expansion, each
+  ~c[ev-i] is evaluated in sequence, and the first that succeeds without error
+  is considered to be the expansion result ~-[] and a repeat evaluation is
+  avoided.  If evaluation of each ~c[ev-i] results in an error, then so does
+  the ~c[make-event] call.
+
+  This special use of ~c[:OR] in a value produced by expansion is only
+  supported at the top level.  That is, the result can be
+  ~c[(:OR ev-1 ev-2 ... ev-k)] but then each ~c[ev-i] must be a legal expansion
+  result, without such further use of ~c[:OR] ~-[] except, ~c[ev-i] may be
+  ~c[(:DO-PROOFS ev-i')], where ~c[ev-i'] then would serve as the expansion
+  rather than ~c[ev-i].
+
+  (3) The ~c[:EXPANSION?] keyword argument.
+
+  If keyword argument ~c[:EXPANSION?] has a non~c[nil] value, then the
+  ~c[:CHECK-EXPANSION] keyword must be omitted or have value ~c[nil] or ~c[t],
+  hence not a cons pair.
+
+  The idea of the ~c[:EXPANSION?] keyword is to give you a way to avoid storing
+  expansion results in a book's ~il[certificate].  Roughly speaking, when the
+  expansion result matches the value of ~c[:EXPANSION?], then no expansion
+  result is stored for the event by book certification; then when the book is
+  later included, the value of ~c[:EXPANSION?] is used as the expansion, thus
+  bypassing the expansion phase.  One could say that the event is its own
+  make-event replacement, but it is more accurate to say that there is no
+  make-event replacement at all, since nothing is stored in the certificate for
+  this event.  Below, we elaborate on make-event replacements when
+  ~c[:EXPANSION] is used and also discuss other properties of this keyword.
+
+  We modify the notion of ``expansion result'' for ~c[make-event] forms to
+  comprehend the use of the ~c[:EXPANSION?] keyword.  For that purpose, let's
+  consider a call of ~c[make-event] to be ``reducible'' if it has an
+  ~c[:EXPANSION?] keyword with non-~c[nil] value, ~c[exp], and its
+  ~c[:CHECK-EXPANSION] keyword is missing or has value ~c[nil], in which case
+  the ``reduction'' of this ~c[make-event] call is defined to be ~c[exp].  The
+  expansion result as originally defined is modified by the following
+  ``recursive reduction'' process: recur through the original expansion,
+  passing through calls of ~ilc[local], ~ilc[skip-proofs], ~ilc[with-output],
+  ~ilc[with-prover-step-limit], and ~ilc[with-prover-time-limit], and
+  replacing (recursively) any reducible call of ~c[make-event] by its
+  reduction.  Furthermore, we refer to two forms as ``reduction equivalent'' if
+  their recursive reductions are equal.  Note that the recursive reduction
+  process does not pass through ~ilc[progn] or ~ilc[encapsulate], but that
+  process is applied to the computation of expansions for their subsidiary
+  ~ilc[make-event] calls.
+
+  To explain further the effect of ~c[:EXPANSION? exp], we split into the
+  following two cases.
+
+  o Case 1: Evaluation is not taking place when including a book or evaluating
+  the second pass of an ~ilc[encapsulate] event; more precisely, the value of
+  ~c[(ld-skip-proofsp state)] is not the symbol ~c[INCLUDE-BOOK].  There are
+  two subcases.
+  ~bq[]
+
+  - Case 1a: The expansion result is not reduction-equivalent to ~c[exp].  Then
+  the ~c[make-event] call is processed as though the ~c[:EXPANSION?] keyword
+  had been omitted.
+
+  - Case 2a: The expansion result is reduction-equivalent to ~c[exp].  Then
+  there is no ~c[make-event] replacement for this call of ~c[make-event]; no
+  replacement will be put into the ~il[certificate] file for a book containing
+  this ~c[make-event] call.  When that book is subsequently included, the
+  original form will be evaluated in the manner described in the next
+  case.~eq[]
+
+  o Case 2: Evaluation is taking place when including a book or evaluating the
+  second pass of an ~ilc[encapsulate] event; more precisely, the value of
+  ~c[(ld-skip-proofsp state)] is the symbol ~c[INCLUDE-BOOK].  Then the
+  expansion is ~c[exp].  The expansion phase is skipped unless
+  ~c[:CHECK-EXPANSION] is ~c[t].
+
+  The ~c[:EXPANSION?] keyword can be particularly useful in concert with the
+  disjunctive (``~c[:OR]'') case (2) discussed above.  Suppose that expansion
+  produces a value as discussed in (2) above, ~c[(:OR exp-1 ... exp-k)].  If
+  one of these expressions ~c[exp-i] is more likely than the others to be the
+  expansion, then you may wish to specify ~c[:EXPANSION? exp-i], as this will
+  avoid storing a ~c[make-event] replacement in that common case.  This could
+  be useful if the expressions are large, to avoid enlarging the
+  ~il[certificate] file for a book containing the ~c[make-event] call.
+
+  It is legal to specify both ~c[:EXPANSION? exp] and ~c[:CHECK-EXPANSION t].
+  When either ~c[(ld-skip-proofsp state)] is the symbol ~c[INCLUDE-BOOK], or
+  evaluation is taking place in raw Lisp, then this combination is treated the
+  same as if ~c[:EXPANSION?] is omitted and the value of ~c[:CHECK-EXPANSION]
+  is ~c[exp].  Otherwise, this combination is treated the same as
+  ~c[:CHECK-EXPANSION t], modified to accommodate the effect of ~c[:EXPANSION?]
+  as discussed above: if the expansion is indeed the value of ~c[:EXPANSION?],
+  then no ~c[make-event] replacement is generated."
 
   (declare (xargs :guard t))
 ; Keep this in sync with the -acl2-loop-only definition.
   `(make-event-fn ',form
+                  ',expansion?
                   ',check-expansion
                   ',on-behalf-of
                   ',event-form
@@ -21402,10 +22003,10 @@
   Below we explain ~c[defattach] in some detail.  But it is important to keep
   in mind that evaluation with the attachment equations takes place in an
   extension of the logical theory of the session.  ACL2 guarantees that this
-  so-called ``evaluation theory'' remains consistent, assuming that the absence
-  of ~ilc[defaxiom] ~il[events] from the user.  This guarantee is a consequence
-  of a more general guarantee: an ACL2 logical ~il[world] exists in
-  which (loosely speaking) the attachment equation for ~c[(defattach f g)], as
+  so-called ``evaluation theory'' remains consistent, assuming the absence of
+  ~ilc[defaxiom] ~il[events] from the user.  This guarantee is a consequence of
+  a more general guarantee: an ACL2 logical ~il[world] exists in which (loosely
+  speaking) the attachment equation for ~c[(defattach f g)], as
   ~c[(defun f (...) (g ...))], takes the place of the original defining event
   for ~c[f], for each ~c[defattach] event.  This more general guarantee holds
   even if there are ~ilc[defaxiom] events, though as explained below, no
@@ -22330,7 +22931,7 @@
 
   ":Doc-Section ACL2::ACL2-built-ins
 
-  modify an association list by associating a value with a key~/
+  remove the first pair from an association list for a given key~/
   ~bv[]
   General Forms:
   (delete-assoc key alist)
@@ -23400,9 +24001,6 @@
 ; is a terrible performance penalty, so in #+ACL2-PAR, we do not use array
 ; caching.
 
-(declaim (inline aref1))
-(declaim (inline aref2))
-
 (defparameter *acl2-array-cache*
 
 ; This special is always the same cons, but its car and cdr may be
@@ -23579,6 +24177,7 @@
   :rule-classes (:type-prescription
                  (:forward-chaining :trigger-terms ((assoc-equal name l)))))
 
+#+acl2-loop-only
 (defmacro f-get-global (x st)
 
   ":Doc-Section ACL2::ACL2-built-ins
@@ -23609,29 +24208,6 @@
   structures even though you may undo back past where you computed and saved
   them.~/"
 
-  #-acl2-loop-only
-  (cond ((and (consp x)
-              (eq 'quote (car x))
-              (symbolp (cadr x))
-              (null (cddr x)))
-
-; The cmulisp compiler complains about unreachable code every (perhaps) time
-; that f-get-global is called in which st is *the-live-state*.  The following
-; optimization is included primarily in order to eliminate those warnings;
-; the extra efficiency is pretty minor, though a nice side effect.
-
-         (if (eq st '*the-live-state*)
-             `(let ()
-                (declare (special ,(global-symbol (cadr x))))
-                ,(global-symbol (cadr x)))
-           (let ((s (gensym)))
-             `(let ((,s ,st))
-                (declare (special ,(global-symbol (cadr x))))
-                (cond ((live-state-p ,s)
-                       ,(global-symbol (cadr x)))
-                      (t (get-global ,x ,s)))))))
-        (t `(get-global ,x ,st)))
-  #+acl2-loop-only
   (list 'get-global x st))
 
 #-acl2-loop-only
@@ -27254,7 +27830,7 @@
 
   ~sc[Timings]
 
-  For how to obtain the runtime elapsed since the start of the ACL2 session,
+  For how to obtain the time elapsed since the start of the ACL2 session,
   ~pl[read-run-time].
 
   For a utility for saving times into the ACL2 state and for printing those
@@ -27734,7 +28310,7 @@
     ev-fncall-w ; *the-live-state*
     ev-rec ; wormhole-eval
     setup-simplify-clause-pot-lst1 ; dmr-flush
-    save-exec ; save-exec-raw, etc.
+    save-exec-fn ; save-exec-raw, etc.
     cw-gstack-fn ; *deep-gstack*
     recompress-global-enabled-structure ; get-acl2-array-property
     ev-w ; *the-live-state*
@@ -27941,6 +28517,7 @@
     set-absstobj-debug-fn
     sys-call-status ; *last-sys-call-status*
     sys-call ; system-call
+    sys-call+ ; system-call+
 
     canonical-pathname ; under dependent clause-processor
 
@@ -27953,7 +28530,6 @@
     mfc-unify-subst ; *metafunction-context*
     mfc-world ; *metafunction-context*
     mfc-ap-fn ; under dependent clause-processor
-    mfc-ap-ttree ; under dependent clause-processor
     mfc-relieve-hyp-fn ; under dependent clause-processor
     mfc-relieve-hyp-ttree ; under dependent clause-processor
     mfc-rw+-fn ; under dependent clause-processor
@@ -28007,7 +28583,7 @@
     logic er deflabel mv-let program value-triple
     set-body comp set-bogus-defun-hints-ok
     dmr-stop defpkg set-measure-function
-    set-inhibit-warnings defthm mv
+    set-inhibit-warnings! defthm mv
     f-big-clock-negative-p reset-prehistory
     mutual-recursion set-rewrite-stack-limit set-prover-step-limit
     add-match-free-override
@@ -28070,6 +28646,7 @@
     catch-throw-to-local-top-level
     with-fast-alist-raw with-stolen-alist-raw fast-alist-free-on-exit-raw
     stobj-let
+    add-ld-keyword-alias! set-ld-keyword-aliases!
     ))
 
 (defmacro with-live-state (form)
@@ -28401,7 +28978,7 @@
   `((abbrev-evisc-tuple . :default)
     (accumulated-ttree . nil) ; just what succeeded; tracking the rest is hard
     (acl2-raw-mode-p . nil)
-
+    (acl2-sources-dir . nil) ; set by initialize-state-globals
     (acl2-version .
 
 ; Keep this value in sync with the value assigned to
@@ -28410,7 +28987,7 @@
 ; The reason MCL needs special treatment is that (char-code #\Newline) = 13 in
 ; MCL, not 10.  See also :DOC version.
 
-; ACL2 Version 6.2
+; ACL2 Version 6.3
 
 ; We put the version number on the line above just to remind ourselves to bump
 ; the value of state global 'acl2-version, which gets printed out with the
@@ -28436,7 +29013,7 @@
 ; reformatting :DOC comments.
 
                   ,(concatenate 'string
-                                "ACL2 Version 6.2"
+                                "ACL2 Version 6.3"
                                 #+non-standard-analysis
                                 "(r)"
                                 #+(and mcl (not ccl))
@@ -28486,6 +29063,7 @@
     (gag-mode-evisc-tuple . nil)
     (gag-state . nil)
     (gag-state-saved . nil) ; saved when gag-state is set to nil
+    (get-internal-time-as-realtime . nil) ; seems harmless to change
     (global-enabled-structure . nil) ; initialized in enter-boot-strap-mode
     (gstackp . nil)
     (guard-checking-on . t)
@@ -28507,6 +29085,7 @@
     (iprint-soft-bound . ,*iprint-soft-bound-default*)
     (keep-tmp-files . nil)
     (last-make-event-expansion . nil)
+    (last-prover-steps . nil)
     (last-step-limit . -1) ; any number should be OK
     (ld-level . 0)
     (ld-okp . :default) ; see :DOC calling-ld-in-bad-contexts
@@ -29291,17 +29870,17 @@
                         (global-table state-state))
                        state-state))
 
+#+acl2-loop-only
 (defun get-global (x state-state)
 
 ; Wart: We use state-state instead of state because of a bootstrap problem.
 
+; Keep this in sync with the #+acl2-loop-only definition of get-global (which
+; uses qfuncall).
+
   (declare (xargs :guard (and (symbolp x)
                               (state-p1 state-state)
                               (boundp-global1 x state-state))))
-  #-acl2-loop-only
-  (cond ((live-state-p state-state)
-         (return-from get-global
-                      (symbol-value (the symbol (global-symbol x))))))
   (cdr (assoc x (global-table state-state))))
 
 (defun put-global (key value state-state)
@@ -29418,7 +29997,6 @@
     (ld-skip-proofsp . nil)
     (ld-redefinition-action . nil)
     (ld-prompt . t)
-    (ld-keyword-aliases . nil)
     (ld-missing-input-ok . nil)
     (ld-pre-eval-filter . :all)
     (ld-pre-eval-print . nil)
@@ -29879,6 +30457,23 @@
 ; least as reasonable.
 
 (defun signed-byte-p (bits x)
+
+  ":Doc-Section ACL2::ACL2-built-ins
+
+  recognizer for signed integers that fit in a specified bit width~/
+
+  ~c[(Signed-byte-p bits x)] is ~c[T] when ~c[bits] is a positive integer and
+  ~c[x] is a signed integer whose 2's complement representation fits in a
+  bit-width of ~c[bits], i.e., ~c[-2^(bits-1) <= x < 2^(bits-1)].~/
+
+  Note that a ~il[type-spec] of ~c[(signed-byte i)] for a variable ~c[x] in a
+  function's ~ilc[declare] form translates to a ~il[guard] condition of
+  ~c[(signed-byte-p i x)].
+
+  The ~il[guard] for ~c[signed-byte-p] is ~c[T].
+
+  To see the ACL2 definition of this function, ~pl[pf].~/"
+
   (declare (xargs :guard t))
   (and (integerp bits)
        (< 0 bits)
@@ -29887,6 +30482,23 @@
                         x)))
 
 (defun unsigned-byte-p (bits x)
+
+  ":Doc-Section ACL2::ACL2-built-ins
+
+  recognizer for natural numbers that fit in a specified bit width~/
+
+  ~c[(Unsigned-byte-p bits x)] is ~c[T] when ~c[bits] is a positive integer and
+  ~c[x] is a nonnegative integer that fits into a bit-width of ~c[bits], i.e.,
+  ~c[0 <= x < 2^bits].~/
+
+  Note that a ~il[type-spec] of ~c[(unsigned-byte i)] for a variable ~c[x] in a
+  function's ~ilc[declare] form translates to a ~il[guard] condition of
+  ~c[(unsigned-byte-p i x)].
+
+  The ~il[guard] for ~c[unsigned-byte-p] is ~c[T].
+
+  To see the ACL2 definition of this function, ~pl[pf].~/"
+
   (declare (xargs :guard t))
   (and (integerp bits)
        (<= 0 bits)
@@ -32027,6 +32639,10 @@
   ":Doc-Section ACL2::ACL2-built-ins
 
   print an error message and ``cause an error''~/
+
+  ~l[fmt] for a general discussion of formatted printing in ACL2.  All calls of
+  ~c[er] print formatted strings, just as is done by ~ilc[fmt].
+
   ~bv[]
   Example Forms:
   (er hard  'top-level \"Illegal inputs, ~~x0 and ~~x1.\" a b)
@@ -34872,20 +35488,78 @@
             (t (car (idates state-state))))
       (update-idates (cdr (idates state-state)) state-state)))
 
+#-acl2-loop-only
+(defun get-internal-time ()
+  (if (f-get-global 'get-internal-time-as-realtime *the-live-state*)
+      (get-internal-real-time)
+    (get-internal-run-time)))
+
+(defdoc get-internal-time
+  ":Doc-Section Miscellaneous
+
+  runtime vs. realtime in ACL2 timings~/
+
+  The ACL2 system provides utilities that deal with elapsed time.  The most
+  visible of these is in the time summaries printed when completing evaluation
+  of ~il[events].  For others, ~pl[with-prover-time-limit], ~pl[read-run-time],
+  ~pl[time-tracker], ~pl[time-tracker-tau], and ~pl[pstack].
+
+  By default, these utilities all use an underlying notion of run time provided
+  by the host Common Lisp implementation: specifically, Common Lisp function
+  ~c[get-internal-run-time].  However, Common Lisp also provides function
+  ~c[get-internal-run-time], which returns the real time (wall clock time).
+  While the latter is specified to measure elapsed time, the former is left to
+  the implementation, which might well only measure time spent in the Lisp
+  process.  Consider the following example, which is a bit arcane but basically
+  sleeps for 2 seconds.
+  ~bv[]
+    (defttag t) ; to allow sys-call
+    (make-event
+     (prog2$ (sys-call \"sleep\" '(\"2\"))
+             (value '(value-triple nil))))
+  ~ev[]
+  A typical time summary might be as follows, drastically under-reporting the
+  elapsed time.
+  ~bv[]
+    Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
+  ~ev[]
+  However, you can instruct ACL2 to switch to using elapsed time (run time), in
+  summaries and elsewhere, by evaluating the following form.
+  ~bv[]
+    (assign get-internal-time-as-realtime t)
+  ~ev[]
+  To return to using runtime:
+  ~bv[]
+    (assign get-internal-time-as-realtime nil)
+  ~ev[]
+  While the above example is rather silly, the issue becomes significant in
+  time summaries for proofs that call out to external tools (~pl[sys-call] and
+  ~pl[clause-processor]).
+
+  Note that a function ~c[get-internal-time] is defined in raw Lisp but is not
+  available inside the ACL2 loop.  However, the expression
+  ~c[(read-run-time state)] provides an interface to this function that is
+  available inside the ACL2 loop; ~pl[read-run-time].
+
+  We are open to changing the default to elapsed wall-clock time (realtime),
+  and may do so in future ACL2 releases.~/~/")
+
 (defun read-run-time (state-state)
 
   ":Doc-Section ACL2::ACL2-built-ins
 
   read elapsed runtime~/
 
-  ~c[(Read-run-time state)] returns ~c[(mv runtime state)], where runtime is
-  the elapsed runtime in seconds since the start of the current ACL2 session
-  and ~c[state] is the resulting ACL2 ~il[state].~/
+  By default, ~c[(read-run-time state)] returns ~c[(mv runtime state)], where
+  runtime is the elapsed runtime in seconds since the start of the current ACL2
+  session and ~c[state] is the resulting ACL2 ~il[state].  But
+  ~c[read-run-time] can be made to return elapsed realtime (wall clock time)
+  instead; ~pl[get-internal-time].~/
 
   The logical definition probably won't concern many users, but for
   completeness, we say a word about it here.  That definition uses the function
-  ~c[read-acl2-oracle], which modifies state by popping the returned
-  ~c[runtime] value from its acl2-oracle field.~/"
+  ~c[read-acl2-oracle], which modifies state by popping the value to return
+  from its acl2-oracle field.~/"
 
   (declare (xargs :guard (state-p1 state-state)))
 
@@ -34901,7 +35575,7 @@
 ; read-run-time to work even when *wormholep* is non-nil.
 
          (return-from read-run-time
-                      (mv (/ (get-internal-run-time)
+                      (mv (/ (get-internal-time)
                              internal-time-units-per-second)
                           state-state))))
   (mv (cond ((or (null (acl2-oracle state-state))
@@ -35139,11 +35813,13 @@
           (sys-call-status state))
   ~ev[]
   The first argument of ~c[sys-call] is a command for the host operating
-  system, and the second argument is a list of strings that are the
-  arguments for that command.  In GCL and perhaps other lisps, you can put the
+  system, and the second argument is a list of strings that are the arguments
+  for that command.  In GCL and perhaps some other lisps, you can put the
   arguments with the command; but this is not the case, for example, in Allegro
   CL running on Linux.
 
+  For a related utility, ~pl[sys-call+].
+
   The use of ~ilc[prog2$] above is optional, but illustrates a typical sort
   of use when one wishes to get the return status.  ~l[sys-call-status].~/
   ~bv[]
@@ -35194,13 +35870,12 @@
   Finally, we make a comment about output redirection, which also applies to
   other related features that one may expect of a shell.  ~c[Sys-call] does not
   directly support output redirection.  If you want to run a program, ~c[P],
-  and redirect its output, we suggest that you create a wrapper script, ~c[W]
+  and redirect its output, one option is to create a wrapper script, ~c[W]
   to call instead.  Thus ~c[W] might be a shell script containing the line:
   ~bv[]
   P $* >& foo.out
   ~ev[]
-  If this sort of solution proves inadequate, please contact the ACL2
-  implementors and perhaps we can come up with a solution."
+  For a different, more direct solution, ~pl[sys-call+]."
 
   (declare (xargs :guard t))
   #+acl2-loop-only
@@ -35210,8 +35885,7 @@
     (progn (setq *last-sys-call-status* rslt)
            nil))
   #+acl2-loop-only
-  nil
-  )
+  nil)
 
 (defun sys-call-status (state)
 
@@ -35237,7 +35911,282 @@
                  (mv *last-sys-call-status* state)))
   (mv-let (erp val state)
           (read-acl2-oracle state)
-          (mv (and erp val) state)))
+          (declare (ignore erp))
+          (mv val state)))
+
+#-acl2-loop-only
+(defun read-file-by-lines (file &optional delete-after-reading)
+  (let ((acc nil)
+        (eof '(nil))
+        missing-newline-p)
+    (with-open-file
+     (s file :direction :input)
+     (loop (multiple-value-bind (line temp)
+               (read-line s nil eof)
+             (cond ((eq line eof)
+                    (return acc))
+                   (t
+                    (setq missing-newline-p temp)
+                    (setq acc
+                          (if acc
+                              (concatenate 'string acc (string #\Newline) line)
+                            line)))))))
+    (when delete-after-reading
+      (delete-file file))
+    (if missing-newline-p
+        acc
+      (concatenate 'string acc (string #\Newline)))))
+
+#-acl2-loop-only
+(defun system-call+ (string arguments)
+
+; Warning: Keep this in sync with system-call.
+
+  (let* (exit-code ; assigned below
+         #+(or gcl clisp)
+         (tmp-file (format nil
+                           "~a/tmp~s"
+                           (or (f-get-global 'tmp-dir *the-live-state*)
+                               "/tmp")
+                           (getpid$)))
+         no-error
+         (output-string
+          (our-ignore-errors
+           (prog1
+               #+gcl ; does wildcard expansion
+             (progn (setq exit-code
+                          (si::system
+                           (let ((result string))
+                             (dolist
+                               (x arguments)
+                               (setq result (concatenate 'string result " " x)))
+                             (concatenate 'string result " > " tmp-file))))
+                    (read-file-by-lines tmp-file t))
+             #+lispworks ; does wildcard expansion (see comment below)
+             (with-output-to-string
+               (s)
+               (setq exit-code
+                     (system::call-system-showing-output
+
+; It was tempting to use (cons string arguments).  This would cause the given
+; command, string, to be applied to the given arguments, without involving the
+; shell.  But then a command such as "ls" would not work; one would have to
+; provide a string such as "/bin/ls".  So instead of using a list here, we use
+; a string, which according to the LispWorks manual will invoke the shell,
+; which will find commands (presumably including built-ins and also using the
+; user's path).
+
+                      (let ((result string))
+                        (dolist
+                          (x arguments)
+                          (setq result (concatenate 'string result " " x)))
+                        result)
+                      :output-stream s
+                      :prefix ""
+                      :show-cmd nil
+                      :kill-process-on-abort t))
+               #+windows ; process is returned above, not exit code
+               (setq exit-code nil))
+             #+allegro ; does wildcard expansion
+             (multiple-value-bind
+                 (stdout-lines stderr-lines exit-status)
+                 (excl.osi::command-output
+                  (let ((result string))
+                    (dolist
+                      (x arguments)
+                      (setq result (concatenate 'string result " " x)))
+                    result))
+               (declare (ignore stderr-lines))
+               (setq exit-code exit-status)
+               (let ((acc nil))
+                 (loop for line in stdout-lines
+                       do
+                       (setq acc
+                             (if acc
+                                 (concatenate 'string
+                                              acc
+                                              (string #\Newline)
+                                              line)
+                               line)))
+                 acc))
+             #+cmu
+             (with-output-to-string
+               (s)
+               (setq exit-code
+                     (let (temp)
+                       (if (ignore-errors
+                             (progn
+                               (setq temp
+                                     (ext:process-exit-code
+                                      (common-lisp-user::run-program
+                                       string arguments
+                                       :output s)))
+                               1))
+                           temp
+                         1))))
+             #+sbcl
+             (with-output-to-string
+               (s)
+               (setq exit-code
+                     (let (temp)
+                       (if (ignore-errors
+                             (progn
+                               (setq temp
+                                     (sb-ext:process-exit-code
+                                      (sb-ext:run-program string arguments
+                                                          :output s
+                                                          :search t)))
+                               1))
+                           temp
+                         1))))
+             #+clisp
+             (progn (setq exit-code
+                          (or (ext:run-program string
+                                               :arguments arguments
+                                               :output tmp-file)
+                              0))
+                    (read-file-by-lines tmp-file t))
+             #+ccl
+             (with-output-to-string
+               (s)
+               (setq exit-code
+                     (let* ((proc
+                             (ccl::run-program string arguments
+                                               :output s
+                                               :wait t))
+                            (status (multiple-value-list
+                                     (ccl::external-process-status proc))))
+                       (if (not (and (consp status)
+                                     (eq (car status) :EXITED)
+                                     (consp (cdr status))
+                                     (integerp (cadr status))))
+                           1 ; just some non-zero exit code here
+                         (cadr status)))))
+             #-(or gcl lispworks allegro cmu sbcl clisp ccl)
+             (declare (ignore string arguments))
+             #-(or gcl lispworks allegro cmu sbcl clisp ccl)
+             (error "SYSTEM-CALL is not yet defined in this Lisp.")
+             (setq no-error t)))))
+    (values (cond ((integerp exit-code)
+                   exit-code)
+                  ((null exit-code)
+                   (if no-error 0 1))
+                  (t (format t
+                             "WARNING: System-call produced non-integer, ~
+                              non-nil exit code:~%~a~%"
+                             exit-code)
+                     0))
+            (if (stringp output-string)
+                output-string
+              ""))))
+
+(encapsulate
+ ()
+
+; Before Version_2.9.3, len-update-nth had the form of the local lemma below.
+; It turns out that an easy way to prove the improved version below,
+; contributed by Jared Davis, is to prove the old version first as a lemma:
+
+ (local
+  (defthm len-update-nth-lemma
+    (implies (< (nfix n) (len x))
+             (equal (len (update-nth n val x))
+                    (len x)))))
+
+ (defthm len-update-nth
+   (equal (len (update-nth n val x))
+          (max (1+ (nfix n))
+               (len x)))))
+
+(defthm update-acl2-oracle-preserves-state-p1
+  (implies (and (state-p1 state)
+                (true-listp x))
+           (state-p1 (update-acl2-oracle x state)))
+  :hints (("Goal" :in-theory (enable state-p1))))
+
+(in-theory (disable update-acl2-oracle))
+
+(defun sys-call+ (command-string args state)
+
+  ":Doc-Section ACL2::ACL2-built-ins
+
+  make a system call to the host OS, returning status and output~/
+  ~bv[]
+  Example Form:
+  ; The following returns (mv nil s state), where s is the standard output
+  ; from the command: ls -l ./
+  (sys-call+ \"ls\" '(\"-l\" \"./\") state)
+
+  General Form:
+  (sys-call+ cmd args state)
+  ~ev[]
+  where ~c[cmd] is a command to the host operating system and ~c[args] is a
+  list of strings.  Also ~pl[sys-call]; but there are two differences between
+  ~ilc[sys-call] and ~c[sys-call+].  First, the latter takes an extra argument,
+  ~c[state].  Second, while ~c[sys-call] returns ~c[nil], ~c[sys-call+] returns
+  three values: a so-called error triple (~pl[error-triples]),
+  ~c[(mv erp val state)].  While execution returns values as described just
+  below, further below we explain the logical return values.  In the following,
+  please keep in mind that the exact behavior depends on the platform; the
+  description is only a guide.  For example, on some platforms ~c[erp] might
+  always be ~c[nil], even if in the error case, and ~c[val] might or might not
+  include error output.  (For details, look at the ACL2 source code for
+  function ~c[system-call+], whose output is converted by replacing an ~c[erp]
+  of ~c[nil] by 0.)
+  ~bq[]
+
+  ~c[Erp] is either ~c[nil] or a non-zero integer.  Normally, ~c[nil] indicates
+  that the command ran without error, and otherwise ~c[erp] is the exit
+  status.
+
+  ~c[Val] is a string, typically the output generated by the call of ~c[cmd].
+
+  ~c[State] is an ACL2 ~il[state].~eq[]
+
+  While the description above pertains to the values returned by executing
+  ~c[sys-call+], the logical values are as follows.  For a discussion of the
+  ~c[acl2-oracle] field of an ACL2 state, ~pl[state].
+  ~bq[]
+
+  ~c[Erp] is the first element of the ~c[acl2-oracle] of the input state if
+  that element is a nonzero integer, and otherwise is ~c[nil].
+
+  ~c[Val] is the second element of the ~c[acl2-oracle] of the input state if it
+  is a string, else the empty string, ~c[\"\"].
+
+  ~c[State] is the result of popping the ~c[acl2-oracle] field twice from the
+  input state.~eq[]
+
+  Note that unlike ~ilc[sys-call], a call of ~ilc[sys-call+] has no effect on
+  subsequent calls of ~ilc[sys-call-status].
+
+  As is the case for ~c[sys-call], a trust tag is required to call
+  ~c[sys-call+].  For discussion of this and more, ~pl[sys-call].~/~/"
+
+  (declare (xargs :stobjs state))
+  #+acl2-loop-only
+  (declare (ignore command-string args))
+  #+acl2-loop-only
+  (mv-let (erp1 erp state)
+          (read-acl2-oracle state)
+          (declare (ignore erp1))
+          (mv-let (erp2 val state)
+                  (read-acl2-oracle state)
+                  (declare (ignore erp2))
+                  (mv (and (integerp erp)
+                           (not (eql 0 erp))
+                           erp)
+                      (if (stringp val) val "")
+                      state)))
+  #-acl2-loop-only
+  (multiple-value-bind
+      (status rslt)
+      (system-call+ command-string args)
+    (mv (if (eql status 0)
+            nil
+          status)
+        rslt
+        state)))
 
 ; End of system calls
 
@@ -35300,32 +36249,6 @@
 ; to two decimal places.  We just print the number, without leading or
 ; trailing spaces or even the word ``seconds''.
 
-(encapsulate
- ()
-
-; Before Version_2.9.3, len-update-nth had the form of the local lemma below.
-; It turns out that an easy way to prove the improved version below,
-; contributed by Jared Davis, is to prove the old version first as a lemma:
-
- (local
-  (defthm len-update-nth-lemma
-    (implies (< (nfix n) (len x))
-             (equal (len (update-nth n val x))
-                    (len x)))))
-
- (defthm len-update-nth
-   (equal (len (update-nth n val x))
-          (max (1+ (nfix n))
-               (len x)))))
-
-(defthm update-acl2-oracle-preserves-state-p1
-  (implies (and (state-p1 state)
-                (true-listp x))
-           (state-p1 (update-acl2-oracle x state)))
-  :hints (("Goal" :in-theory (enable state-p1))))
-
-(in-theory (disable update-acl2-oracle))
-
 (local
  (defthm rational-listp-cdr
    (implies (rational-listp x)
@@ -36218,6 +37141,10 @@
 ; in-local-flg.
 ;    in-local-flg
 
+;   Since in-prove-flg need not be untouchable (currently it is only used by
+;   break-on-error), we omit it from this list.  It is used by community book
+;   misc/bash.lisp.
+
     axiomsp
 
     current-acl2-world
@@ -36282,7 +37209,6 @@
     standard-co
     proofs-co
     ld-prompt
-    ld-keyword-aliases
     ld-missing-input-ok
     ld-pre-eval-filter
     ld-pre-eval-print
@@ -36343,6 +37269,8 @@
     deferred-ttag-notes-saved
     pc-assign
     illegal-to-certify-message
+    acl2-sources-dir
+    last-prover-steps ; being conservative here; perhaps could omit
     ))
 
 ; There are a variety of state global variables, 'ld-skip-proofsp among them,
@@ -37460,8 +38388,6 @@
          (member-eq val '(t nil :warn)))
         ((eq key :ignore-ok)
          (member-eq val '(t nil :warn)))
-        ((eq key :inhibit-warnings)
-         (string-listp val))
         ((eq key :bdd-constructors)
 
 ; We could insist that the symbols are function symbols by using
@@ -37644,21 +38570,6 @@
   or ~c[:warn] (which makes the check but merely warns when the check
   fails).  ~l[set-ignore-ok].
   ~bv[]
-  :inhibit-warnings
-  ~ev[]
-  ACL2 prints warnings that may, from time to time, seem excessive to
-  experienced users.  Each warning is ``labeled'' with a string
-  identifying the type of warning.  Consider for example
-  ~bv[]
-  ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
-  ~ev[]
-  Here, the label is \"Use\".  The value of the key
-  ~c[:inhibit-warnings] is a list of such labels, where case is
-  ignored.  Any warning whose label is a member of this list (where
-  again, case is ignored) is suppressed.
-  ~l[set-inhibit-warnings] and also
-  ~pl[set-inhibit-output-lst].
-  ~bv[]
   :bdd-constructors
   ~ev[]
   This key's value is a list of function symbols used to define the
@@ -37942,7 +38853,7 @@
   ~ev[]"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :enforce-redundancy ,x)
            (table acl2-defaults-table :enforce-redundancy))))
 
@@ -37992,7 +38903,7 @@
   ~ev[]"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :ignore-doc-string-error ,x)
            (table acl2-defaults-table :ignore-doc-string-error))))
 
@@ -38064,7 +38975,7 @@
   ~c[(default-verify-guards-eagerness (w state))]."
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :verify-guards-eagerness ,x)
            (table acl2-defaults-table :verify-guards-eagerness))))
 
@@ -38132,7 +39043,7 @@
   :cited-by Programming"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :compile-fns ,x)
             (table acl2-defaults-table :compile-fns))))
 
@@ -38208,7 +39119,7 @@
   ~ilc[acl2-count].~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :measure-function ',name)
             (table acl2-defaults-table :measure-function))))
 
@@ -38258,7 +39169,7 @@
   arguments decreases according to ~c[rel].~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :well-founded-relation ',rel)
             (table acl2-defaults-table :well-founded-relation))))
 
@@ -38360,7 +39271,7 @@
   ~l[embedded-event-form]."
 
   '(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'summary (@ inhibit-output-lst))))
     (er-progn (table acl2-defaults-table :defun-mode :logic)
               (value :invisible))))
 
@@ -38419,7 +39330,7 @@
   ~l[embedded-event-form]."
 
   '(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'summary (@ inhibit-output-lst))))
     (er-progn (table acl2-defaults-table :defun-mode :program)
               (value :invisible))))
 
@@ -38696,7 +39607,7 @@
   ~c[(set-bogus-defun-hints-ok :warn)].~/~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :bogus-defun-hints-ok ,x)
             (table acl2-defaults-table :bogus-defun-hints-ok))))
 
@@ -38751,7 +39662,7 @@
   :cited-by Programming"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :bogus-mutual-recursion-ok ,x)
             (table acl2-defaults-table :bogus-mutual-recursion-ok))))
 
@@ -39170,7 +40081,7 @@
 ; not available for the expression of that event.
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (er-progn
      (chk-ruler-extenders ,x soft 'set-ruler-extenders (w state))
      (progn
@@ -39223,7 +40134,7 @@
   :cited-by Programming"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :irrelevant-formals-ok ,x)
             (table acl2-defaults-table :irrelevant-formals-ok))))
 
@@ -39272,7 +40183,7 @@
   :cited-by Programming"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :ignore-ok ,x)
             (table acl2-defaults-table :ignore-ok))))
 
@@ -39282,11 +40193,34 @@
   nil)
 
 #-acl2-loop-only
-(defmacro set-inhibit-warnings (&rest x)
+(defmacro set-inhibit-warnings! (&rest x)
   (declare (ignore x))
   nil)
 
+(table inhibit-warnings-table nil nil
+       :guard
+       (stringp key))
+
 #+acl2-loop-only
+(defmacro set-inhibit-warnings! (&rest lst)
+
+  ":Doc-Section switches-parameters-and-modes
+
+  control warnings non-~ilc[local]ly~/
+
+  Please ~pl[set-inhibit-warnings], which is the same as
+  ~c[set-inhibit-warnings!]  except that the latter is not ~ilc[local] to the
+  ~ilc[encapsulate] or the book in which it occurs.  Probably
+  ~il[set-inhibit-warnings] is to be preferred unless you have a good reason
+  for wanting to export the effect of this event outside the enclosing
+  ~ilc[encapsulate] or book.~/~/"
+
+  (declare (xargs :guard (string-listp lst)))
+  `(state-global-let*
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
+    (progn (table inhibit-warnings-table nil ',(pairlis$ lst nil) :clear)
+           (value-triple ',lst))))
+
 (defmacro set-inhibit-warnings (&rest lst)
 
   ":Doc-Section switches-parameters-and-modes
@@ -39298,36 +40232,44 @@
   ~ev[]
   Note: This is an event!  It does not print the usual event summary
   but nevertheless changes the ACL2 logical ~il[world] and is so
-  recorded.  Moreover, its effect is to set the ~ilc[acl2-defaults-table], and
-  hence its effect is ~ilc[local] to the book or ~ilc[encapsulate] form
-  containing it; ~pl[acl2-defaults-table].~/
+  recorded.  It is ~ilc[local] to the book or ~ilc[encapsulate] form in which it
+  occurs; ~pl[set-inhibit-warnings!] for a corresponding non-~ilc[local]
+  event.  Indeed, ~c[(set-inhibit-warnings ...)] is equivalent to
+  ~c[(local (set-inhibit-warnings! ...))].~/
   ~bv[]
   General Form:
   (set-inhibit-warnings string1 string2 ...)
   ~ev[]
-  where each string is considered without regard to case.  This macro
-  is equivalent to ~c[(table acl2-defaults-table :inhibit-warnings lst)],
-  where ~c[lst] is the list of strings supplied.  This macro is an event
-  (~pl[table]), but no output results from a
-  ~c[set-inhibit-warnings] event.
-
-  The effect of this event is to suppress any warning whose label is a
-  member of this list (where again, case is ignored).  For example,
-  the warning
-  ~bv[]
-    ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
-  ~ev[]
-  will not be printed if ~c[\"use\"] (or ~c[\"USE\"], etc.) is a member
-  of the given list of strings.
-
-  Of course, if warnings are inhibited overall ~-[]
-  ~pl[set-inhibit-output-lst] ~-[] then the value of
-  ~c[:inhibit-warnings] is entirely irrelevant."
+  where each string is considered without regard to case.  This macro is
+  equivalent to ~c[(local (table inhibit-warnings-table nil 'lst :clear))],
+  where ~c[lst] is the list of strings supplied.  This macro is an
+  event (~pl[table]), but no output results from a ~c[set-inhibit-warnings]
+  event.
 
-  `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
-    (progn (table acl2-defaults-table :inhibit-warnings ',lst)
-           (table acl2-defaults-table :inhibit-warnings))))
+  ACL2 prints warnings that may, from time to time, seem excessive to
+  experienced users.  Each warning is ``labeled'' with a string identifying the
+  type of warning.  Consider for example
+  ~bv[]
+  ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
+  ~ev[]
+  Here, the label is \"Use\".  The argument list for ~c[set-inhibit-warnings]
+  is a list of such labels, each of which is a string.  Any warning is
+  suppressed if its label is a member of this list, where case is ignored, .
+  Thus, for example, the warning above will not be printed after a call of
+  ~c[set-inhibit-warnings] that contains the string, ~c[\"Use\"] (or any string
+  that is ~ilc[string-equal] to ~c[\"Use\"], such as ~c[\"use\"] or
+  ~c[\"USE\"]).  In summary: the effect of this event is to suppress any
+  warning whose label is a member of the given argument list, where case is
+  ignored.
+
+  The list of currently inhibited warnings is the list of keys in the
+  ~il[table] named ~c[inhibit-warnings-table].  (The values in the table are
+  irrelevant.)  One way to get that value is to get the result from evaluating
+  the following form: ~c[(table-alist 'inhibit-warnings-table (w state))].  Of
+  course, if warnings are inhibited overall ~-[] ~pl[set-inhibit-output-lst]
+  ~-[] then this value is entirely irrelevant."
+
+  `(local (set-inhibit-warnings! ,@lst)))
 
 (defmacro set-inhibit-output-lst (lst)
 
@@ -39520,7 +40462,7 @@
   "
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :state-ok ,x)
            (table acl2-defaults-table :state-ok))))
 
@@ -39576,7 +40518,7 @@
   Thus, the mode may be set locally in books."
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :let*-abstractionp ,x)
            (table acl2-defaults-table :let*-abstractionp))))
 
@@ -39656,7 +40598,7 @@
   The default limit is ~c[(nil nil)]."
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :backchain-limit
                   (let ((limit ,limit))
                     (if (atom limit)
@@ -39885,7 +40827,7 @@
   The initial default backchain-limit is ~c[nil]."
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :default-backchain-limit
                   (let ((limit ,limit))
                     (if (atom limit)
@@ -40015,7 +40957,9 @@
   limit on prover steps for a single event, rather than globally.  For a
   related utility based on time instead of prover steps,
   ~pl[with-prover-time-limit].  For examples of how step limits work, see the
-  community book ~c[books/misc/misc2/step-limits.lisp].
+  community book ~c[books/misc/misc2/step-limits.lisp].  For a utility that
+  returns an indicator of the number of prover steps most recently taken,
+  ~pl[last-prover-steps].
 
   Note: This is an event!  It does not print the usual event summary
   but nevertheless changes the ACL2 logical ~il[world] and is so
@@ -40052,6 +40996,11 @@
   the exception stated above: if the ``limit'' is ~c[nil] or is the value of
   ~c[*default-step-limit*], then no limit is imposed.
 
+  There is at best a loose connection between the counting of steps and
+  ~ilc[with-prover-time-limit].  In particular, for a call of ~c[mfc-rw] or any
+  ~c[mfc-] function (~pl[extended-metafunctions]), the steps taken during that
+  call are forgotten when returning from that call.
+
   The limit is relevant for every event, as well as for calls of ~ilc[thm] and
   ~ilc[certify-book] ~-[] and more generally, to any form that creates a
   ``summary context'' to print the usual event summary.  The limit is also put
@@ -40126,14 +41075,10 @@
   Prover steps counted:  41090
    NIL
   ACL2 !>
-  ~ev[]
-
-  Technical Remark.  For a call of ~c[mfc-rw] or any ~c[mfc-]
-  function (~pl[extended-metafunctions]), the steps taken during that call are
-  forgotten when returning from that call.~/"
+  ~ev[]~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (pprogn
      (let ((rec (f-get-global 'step-limit-record state))
            (limit (or ,limit *default-step-limit*)))
@@ -40156,7 +41101,8 @@
                                                 :strictp)))
                             state))
              (t state)))
-     (progn (table acl2-defaults-table :step-limit ,limit)
+     (progn (table acl2-defaults-table :step-limit
+                   (or ,limit *default-step-limit*))
             (table acl2-defaults-table :step-limit)))))
 
 #-acl2-loop-only
@@ -40257,7 +41203,7 @@
   (set-rewrite-stack-limit 30)                            ; set to small limit
   :set-rewrite-stack-limit 30                             ; same as above
   (set-rewrite-stack-limit *default-rewrite-stack-limit*) ; the default
-  :set-rewrite-stack-limit (1- (expt 2 28))               ; maximum legal limit
+  (set-rewrite-stack-limit (1- (expt 2 28)))              ; maximum legal limit
   :set-rewrite-stack-limit nil         ; same as above -- essentially, no limit
   ~ev[]
   This event sets the maximum stack depth for calls of certain functions that
@@ -40274,7 +41220,7 @@
   For a different but somewhat related concept, ~pl[backchain-limit]."
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :rewrite-stack-limit
                   ,(if (or (null limit) (equal limit (kwote nil)))
                        (1- (expt 2 28))
@@ -40381,7 +41327,7 @@
   nu-rewriter."
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :nu-rewriter-mode ,x)
            (table acl2-defaults-table :nu-rewriter-mode))))
 
@@ -40579,7 +41525,7 @@
   the standard proofs output.~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table :case-split-limitations
                   (let ((lst ,lst))
                     (cond ((eq lst nil)
@@ -40805,7 +41751,7 @@
 ; :cited-by free-variables add-match-free-override set-match-free-error
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :match-free-default ,x)
             (table acl2-defaults-table :match-free-default))))
 
@@ -40966,7 +41912,7 @@
 ; :cited-by free-variables set-match-free-default set-match-free-error
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     ,(cond
       ((eq flg :clear)
        (cond
@@ -41199,7 +42145,7 @@
   The initial value is ~c[nil]."
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :non-linearp ,toggle)
             (table acl2-defaults-table :non-linearp))))
 
@@ -41369,7 +42315,7 @@
   settings of those two flags."
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
      (progn (table acl2-defaults-table :tau-auto-modep ,toggle)
             (table acl2-defaults-table :tau-auto-modep))))
 
@@ -41636,7 +42582,7 @@
 
   (declare (xargs :guard (symbolp tag-name)))
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table acl2-defaults-table
                   :ttag
                   ',(and tag-name
@@ -42380,7 +43326,7 @@
   Note: This is an event!  It does not print the usual event summary
   but nevertheless changes the ACL2 logical ~il[world] and is so
   recorded.  It is ~ilc[local] to the book or ~ilc[encapsulate] form in which it
-  occurs (~pl[set-default-hints!] for a corresponding non-~ilc[local] event).~/
+  occurs; ~pl[set-default-hints!] for a corresponding non-~ilc[local] event.~/
   ~bv[]
   General Form:
   (set-default-hints lst)
@@ -42435,7 +43381,7 @@
   outside the enclosing ~ilc[encapsulate] or book.~/~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table default-hints-table t ,lst)
            (table default-hints-table t))))
 
@@ -42505,7 +43451,7 @@
   outside the enclosing ~ilc[encapsulate] or book.~/~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table default-hints-table t
                   (if ,at-end
                       (append (default-hints world) ,lst)
@@ -42569,7 +43515,7 @@
   outside the enclosing ~ilc[encapsulate] or book.~/~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table default-hints-table t
                   (set-difference-equal (default-hints world) ,lst))
            (table default-hints-table t))))
@@ -42582,7 +43528,7 @@
 #+acl2-loop-only
 (defmacro set-override-hints-macro (lst at-end ctx)
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'summary (@ inhibit-output-lst))))
     (set-override-hints-fn ,lst ,at-end ,ctx (w state) state)))
 
 #-acl2-loop-only
@@ -42998,7 +43944,7 @@
   in which it occurs.~/~/"
 
   `(state-global-let*
-    ((inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+    ((inhibit-output-lst (list* 'event 'summary (@ inhibit-output-lst))))
     (progn (table rw-cache-state-table t ,val)
            (table rw-cache-state-table t))))
 
@@ -44591,7 +45537,7 @@
 
   (let ((time-limit-var (gensym)))
     `(let* ((,time-limit-var ,time)
-            (temp (+ (get-internal-run-time)
+            (temp (+ (get-internal-time)
                      (* internal-time-units-per-second
                         (if (consp ,time-limit-var)
                             (car ,time-limit-var)
@@ -44638,7 +45584,7 @@
   where ~c[time] evaluates to a positive rational number or to a list
   containing such, and ~c[form] is arbitrary.  Logically,
   ~c[(with-prover-time-limit time form)] is equivalent to ~c[form].  However,
-  if the runtime for evaluation of ~c[form] exceeds the value specified by
+  if the time for evaluation of ~c[form] exceeds the value specified by
   ~c[time], and if ACL2 notices this fact during a proof, then that proof will
   abort, for example like this:
   ~bv[]
@@ -44649,6 +45595,9 @@
   allowed to push that time further into the future unless the inner time is
   specified as a list containing a rational, rather than as a rational.
 
+  Note that by default, the time used is runtime (cpu time); to switch to
+  realtime (elapsed time), ~pl[get-internal-time].
+
   For a related utility based on prover steps instead of time,
   ~pl[with-prover-step-limit]; also ~pl[set-prover-step-limit].  Those
   utilities have the advantage of having platform-independent behavior, unlike
@@ -44766,7 +45715,7 @@
 ; Where should we call this function?  We want to strike a balance between
 ; calling it often enough that we get reasonably tight results for
 ; with-prover-time-limit, yet calling it rarely enough so that we don't slow
-; down the prover, in particular from calls of (get-internal-run-time).
+; down the prover, in particular from calls of (get-internal-time).
 
 ; As of this writing we call this function in add-poly,
 ; quick-and-dirty-subsumption-replacement-step, subsumption-replacement-loop,
@@ -44795,7 +45744,7 @@
 ; rewrite not in the scope of catch-time-limit5.
 
              (member-eq 'time-limit5-tag *time-limit-tags*)
-             (< *acl2-time-limit* (get-internal-run-time)))
+             (< *acl2-time-limit* (get-internal-time)))
     (setq *next-acl2-oracle-value*
           (if (eql *acl2-time-limit* 0)
               "Aborting due to an interrupt."
@@ -46959,8 +47908,31 @@
                       tbl)))
           :clear))
 
+(defun splice-keyword-alist (key new-segment keyword-alist)
+  (declare (xargs :guard (and (keywordp key)
+                              (keyword-value-listp keyword-alist)
+                              (true-listp new-segment))))
+  (cond
+   ((endp keyword-alist) nil)
+   ((eq key (car keyword-alist))
+    (append new-segment (cddr keyword-alist)))
+   (t (cons (car keyword-alist)
+            (cons (cadr keyword-alist)
+                  (splice-keyword-alist key new-segment
+                                        (cddr keyword-alist)))))))
+
+(deflabel custom-keyword-hints
+  :doc
+  ":Doc-Section Miscellaneous
+
+  user-defined hints~/
+
+  ~l[add-custom-keyword-hint] for a discussion of how advanced users can define
+  their own hint keywords.  For examples, see the community books directory
+  ~c[books/hints/], in particular ~c[basic-tests.lisp].~/~/")
+
 (defmacro show-custom-keyword-hint-expansion (flg)
-  ":Doc-Section Events
+  ":Doc-Section custom-keyword-hints
 
    print out custom keyword hints when they are expanded~/
   ~bv[]
@@ -46986,29 +47958,6 @@
 
   `(f-put-global 'show-custom-keyword-hint-expansion ,flg state))
 
-(defun splice-keyword-alist (key new-segment keyword-alist)
-  (declare (xargs :guard (and (keywordp key)
-                              (keyword-value-listp keyword-alist)
-                              (true-listp new-segment))))
-  (cond
-   ((endp keyword-alist) nil)
-   ((eq key (car keyword-alist))
-    (append new-segment (cddr keyword-alist)))
-   (t (cons (car keyword-alist)
-            (cons (cadr keyword-alist)
-                  (splice-keyword-alist key new-segment
-                                        (cddr keyword-alist)))))))
-
-(deflabel custom-keyword-hints
-  :doc
-  ":Doc-Section Miscellaneous
-
-  user-defined hints~/
-
-  ~l[add-custom-keyword-hint] for a discussion of how advanced users can define
-  their own hint keywords.  For examples, see the community books directory
-  ~c[books/hints/], in particular ~c[basic-tests.lisp].~/~/")
-
 ; Start implementation of search.
 
 (defun search-fn-guard (seq1 seq2 from-end test start1 start2 end1 end2
@@ -48143,6 +49092,30 @@
          (break)))
   nil)
 
+#-acl2-loop-only
+(defvar *ccl-print-call-history-count*
+
+; This variable is only used by CCL, but we define it for all Lisps so that
+; this name is equally unavailable as a name for defconst in all host Lisps.
+
+; The user is welcome to change this in raw Lisp.  Perhaps we should advertise
+; it and use a state global.  We have attempted to choose a value sufficiently
+; large to get well into the stack, but not so large as to swamp the system.
+; Even with the default for CCL (as of mid-2013) of -Z 2M, the stack without
+; this restriction could be much larger.  For example, in the ACL2 loop we
+; made the definition
+
+;   (defun foo (x) (if (atom x) nil (cons (car x) (foo (cdr x)))))
+
+; and then ran (foo (make-list 1000000)), and after 65713 abbreviated stack
+; frames CCL just hung.  But with this restriction, it took less than 6 seconds
+; to evaluate the following in raw Lisp, including printing the stack to the
+; terminal (presumably it would be much faster to print to a file):
+
+;   (time$ (ignore-errors (ld '((foo (make-list 1000000))))))
+
+  10000)
+
 (defun print-call-history ()
 
 ; We welcome suggestions from users or Lisp-specific experts for how to improve
@@ -48161,7 +49134,8 @@
   #+(and ccl (not acl2-loop-only))
   (when (fboundp 'ccl::print-call-history)
 ; See CCL file lib/backtrace.lisp for more options
-    (eval '(ccl::print-call-history :detailed-p nil)))
+    (eval '(ccl::print-call-history :detailed-p nil
+                                    :count *ccl-print-call-history-count*)))
 
 ; It seems awkward to deal with GCL, both because of differences in debugger
 ; handling and because we haven't found documentation on how to get a
@@ -48362,13 +49336,21 @@
 (defun set-debugger-enable-fn (val state)
   (declare (xargs :guard (and (state-p state)
                               (member-eq val '(t nil :never :break :bt
-                                                 :break-bt :bt-break)))))
-  (f-put-global 'debugger-enable val state)
+                                                 :break-bt :bt-break)))
+                  :guard-hints (("Goal" :in-theory (enable state-p1)))))
   #+(and (not acl2-loop-only)
          (and gcl (not cltl2)))
   (when (live-state-p state)
-    (setq lisp::*break-enable* (debugger-enabledp state))
-    state))
+    (setq lisp::*break-enable* (debugger-enabledp state)))
+  (pprogn
+   (f-put-global 'debugger-enable val state)
+   (if (consp (f-get-global 'dmrp state))
+
+; Then user invoked this function, so avoid having a later stop-dmr change the
+; value of 'debugger-enable.
+
+       (f-put-global 'dmrp t state)
+     state)))
 
 ; See comment in true-listp-cadr-assoc-eq-for-open-channels-p.
 (in-theory (disable true-listp-cadr-assoc-eq-for-open-channels-p))
@@ -49178,13 +50160,16 @@
 
   display time spent during specified evaluation~/
 
-  The ~c[time-tracker] macro is a utility for displaying runtime (cpu time)
-  spent during specified evaluation.  In general, the user provides this
-  specification.  However, ACL2 itself uses this utility for tracking uses of
-  its ~il[tau-system] reasoning utility (~pl[time-tracker-tau]).  We discuss
-  that use as an example before discussing the general form for calls of
+  The ~c[time-tracker] macro is a utility for displaying time spent during
+  specified evaluation.  In general, the user provides this specification.
+  However, ACL2 itself uses this utility for tracking uses of its
+  ~il[tau-system] reasoning utility (~pl[time-tracker-tau]).  We discuss that
+  use as an example before discussing the general form for calls of
   ~c[time-tracker].
 
+  Note that by default, the time being tracked is runtime (cpu time); to switch
+  to realtime (elapsed time), ~pl[get-internal-time].
+
   Remark for ACL2(p) users (~pl[parallelism]): ~c[time-tracker] is merely a
   no-op in ACL2(p).
 
@@ -49214,7 +50199,8 @@
   ~c[time-tracker] are evaluated, the first argument is typically a keyword and
   the second is always a keyword, and such arguments evaluate to themselves.
 
-  An ACL2 function invoked at the start of a proof includes the following code.
+  An ACL2 function invoked at the start of a proof includes approximately the
+  following code.
   ~bv[]
   (progn$
    (time-tracker :tau :end)
@@ -49302,7 +50288,7 @@
   We conclude with a precise discussion of all arguments.  Note that all
   arguments are evaluated; thus when we refer to an argument, we are discussing
   the value of that argument.  All times discussed are runtimes, i.e., cpu
-  times.
+  times, unless that default is changed; ~pl[get-internal-time].
 
   ~bv[]
   General forms:
diff -Nru acl2-6.2/basis.lisp acl2-6.3/basis.lisp
--- acl2-6.2/basis.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/basis.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -647,7 +647,6 @@
                          (ld-skip-proofsp 'same ld-skip-proofspp)
                          (ld-redefinition-action 'save ld-redefinition-actionp)
                          (ld-prompt ''wormhole-prompt)
-                         (ld-keyword-aliases 'same ld-keyword-aliasesp)
                          (ld-missing-input-ok 'same ld-missing-input-okp)
                          (ld-pre-eval-filter 'same ld-pre-eval-filterp)
                          (ld-pre-eval-print 'same ld-pre-eval-printp)
@@ -683,7 +682,6 @@
     :ld-skip-proofsp    ...  ; nil, t or 'include-book
     :ld-redefinition-action  ; nil or '(:a . :b)
     :ld-prompt          ...  ; nil, t, or some prompt printer fn
-    :ld-keyword-aliases ...  ; an alist pairing keywords to parse info
     :ld-missing-input-ok ... ; nil, t, :warn, or warning message
     :ld-pre-eval-filter ...  ; :all, :query, or some new name
     :ld-pre-eval-print  ...  ; nil, t, or :never
@@ -1124,10 +1122,6 @@
                            ,ld-redefinition-action))
             nil)
           (list `(cons 'ld-prompt ,ld-prompt))
-          (if ld-keyword-aliasesp
-              (list `(cons 'ld-keyword-aliases
-                           ,ld-keyword-aliases))
-            nil)
           (if ld-missing-input-okp
               (list `(cons 'ld-missing-input-ok ,ld-missing-input-ok))
             nil)
@@ -8038,10 +8032,9 @@
 ; computation on behalf of disabled warnings.
 
   (or (and summary
-           (member-string-equal
+           (assoc-string-equal
             summary
-            (cdr (assoc-eq :inhibit-warnings
-                           (table-alist 'acl2-defaults-table wrld)))))
+            (table-alist 'inhibit-warnings-table wrld)))
 
 ; The above is sufficient to turn off (warning$ "string" ...).  But even when
 ; the above condition isn't met, we turn off all warnings -- with the exception
@@ -9619,10 +9612,10 @@
   (cond ((eq fn 'cons)
 ; We call this function on cons so often we optimize it.
          '(nil))
-        ((eq fn 'return-last)
+        ((member-eq fn '(if return-last))
          (er hard! 'stobjs-out
              "Implementation error: Attempted to find stobjs-out for ~x0."
-             'return-last))
+             fn))
         (t (getprop fn 'stobjs-out '(nil) 'current-acl2-world w))))
 
 ; With stobjs-out defined, we can define user-defined-functions-table.
@@ -12279,8 +12272,9 @@
 
 (defun sublis-var (alist form)
 
-; The two following comments come from the nqthm version of this
-; function and do not necessarily pertain to ACL2 (but see below).
+; Call this function with alist = nil to put form into quote-normal form so
+; that for example if form is (cons '1 '2) then '(1 . 2) is returned.  The
+; following two comments come from the nqthm version of this function.
 
 ;     In REWRITE-WITH-LEMMAS we use this function with the nil alist
 ;     to put form into quote normal form.  Do not optimize this
@@ -12291,9 +12285,8 @@
 ;     However, even this function requires that form be at least a
 ;     pseudo-termp.
 
-; Note however the comment from rewrite-with-lemma that says:
-;   The sublis-var below normalizes the explicit constant
-;   constructors in evaled-hyp, e.g., (cons '1 '2) becomes '(1 . 2).
+; We rely on quote-normal form for the return value, for example in calls of
+; sublis-var in rewrite-with-lemma and in apply-top-hints-clause1.
 
   (declare (xargs :guard (and (symbol-alistp alist)
                               (pseudo-term-listp (strip-cdrs alist))
@@ -13507,39 +13500,70 @@
 
 (defun ld-keyword-aliases (state)
 
-  ":Doc-Section Miscellaneous
+  ":Doc-Section switches-parameters-and-modes
 
-  allows the abbreviation of some keyword commands~/
+  abbreviation of some keyword commands~/
   ~bv[]
-  Example:
+  Examples:
   (set-ld-keyword-aliases '((:q 0 q-fn)
                             (:e 0 exit-acl2-macro))
                           state)
+  (ld-keyword-aliases state) ; current value of the ld-keyword-aliases table
   ~ev[]
-  ~c[Ld-keyword-aliases] is an ~ilc[ld] special (~pl[ld]).  The accessor
-  is ~c[(ld-keyword-aliases state)] and the updater is
-  ~c[(set-ld-keyword-aliases val state)].  ~c[Ld-keyword-aliases] must be an
-  alist, each element of which is of the form ~c[(:keyword n fn)], where
-  ~c[:keyword] is a keyword, ~c[n] is a nonnegative integer, and ~c[fn] is a
-  function symbol of arity ~c[n], a macro symbol, or a ~c[lambda] expression
-  of arity ~c[n].  When ~c[keyword] is typed as an ~ilc[ld] command, ~c[n] more forms
-  are read, ~c[x1, ..., xn], and the form ~c[(fn 'x1 ... 'xn)] is then
-  evaluated.  The initial value of ~c[ld-keyword-aliases] is ~c[nil].
+  ~c[Ld-keyword-aliases] is the name of a ACL2 table (~pl[table]) and also the
+  name of a function of ~c[state] that returns the value of this table.  That
+  value must be an alist, each element of which is of the form
+  ~c[(:keyword n fn)], where ~c[:keyword] is a keyword, ~c[n] is a nonnegative
+  integer, and ~c[fn] is a function symbol of arity ~c[n], a macro symbol, or a
+  ~c[lambda] expression of arity ~c[n].  When ~c[keyword] is typed as an
+  ~ilc[ld] command, ~c[n] more forms are read, ~c[x1, ..., xn], and the form
+  ~c[(fn 'x1 ... 'xn)] is then evaluated.  The initial value of the
+  ~c[ld-keyword-aliases] ~il[table] is ~c[nil].
 
-  In the example above, ~c[:]~ilc[q] has been redefined to have the effect of
-  executing ~c[(q-fn)], so for example if you define
+  ACL2 provides functions to modify the ~c[ld-keyword-aliases] table, as
+  follows.
+  ~bq[]
+
+  ~c[(Set-ld-keyword-aliases val state)]: sets the table to ~c[val], which must
+  be a legal alist as described above.  This is an event that may go into a
+  book (~pl[events]), but its effect will be ~il[local] to that book.
+
+  ~c[Set-ld-keyword-aliases!] is the same as ~c[set-ld-keyword-aliases], except
+  that its effect is not ~il[local].  Indeed, the form
+  ~c[(set-ld-keyword-aliases val state)] is equivalent to the form
+  ~c[(local (set-ld-keyword-aliases! val state)].
+
+  ~c[(Add-ld-keyword-alias key val state)]: modifies the table by binding the
+  keyword ~c[key] to ~c[val], which must be a legal value as described above.
+  This is an event that may go into a book (~pl[events]), but its effect will
+  be ~il[local] to that book.
+
+  ~c[Add-ld-keyword-alias!] is the same as ~c[add-ld-keyword-alias], except
+  that its effect is not ~il[local].  Indeed, the form
+  ~c[(add-ld-keyword-alias key val state)] is equivalent to the form
+  ~c[(local (add-ld-keyword-alias! key val state)].
+
+  ~eq[]
+  Consider the first example above:
+  ~bv[]
+  (set-ld-keyword-aliases '((:q 0 q-fn)
+                            (:e 0 exit-acl2-macro))
+                          state)
+  ~ev[]
+  With this event, ~c[:]~ilc[q] is redefined to have the effect of executing
+  ~c[(q-fn)], so for example if you have defined ~c[q-fn] with
   ~bv[]
   (defmacro q-fn ()
     '(er soft 'q \"You un-bound :q and now we have a soft error.\"))
   ~ev[]
-  then ~c[:]~ilc[q] will cause an error, and if you define
+  then ~c[:]~ilc[q] will cause an error, and if you have defined
   ~bv[]
   (defmacro exit-acl2-macro () '(exit-ld state))
   ~ev[]
   then ~c[:e] will cause the effect (it so happens) that ~c[:]~ilc[q] normally
-  has.  If you prefer ~c[:e] to ~c[:]~ilc[q] for exiting the ACL2 loop, you might
-  even want to put such definitions of ~c[q-fn] and ~c[exit-acl2-macro]
-  together with the ~c[set-ld-keyword-aliases] form above in your
+  has.  If you prefer ~c[:e] to ~c[:]~ilc[q] for exiting the ACL2 loop, you
+  might even want to put such definitions of ~c[q-fn] and ~c[exit-acl2-macro]
+  together with the ~c[set-ld-keyword-aliases] form above into your
   ~c[\"acl2-customization.lsp\"] file; ~pl[acl2-customization].~/
 
   The general-purpose ACL2 read-eval-print loop, ~ilc[ld], reads forms from
@@ -13547,51 +13571,73 @@
   However, there are various flags that control ~ilc[ld]'s behavior and
   ~c[ld-keyword-aliases] is one of them.  ~c[Ld-keyword-aliases] affects how
   keyword commands are parsed.  Generally speaking, ~ilc[ld]'s command
-  interpreter reads ``~c[:fn x1 ... xn]'' as ``~c[(fn 'x1 ... 'xn)]'' when ~c[:fn]
-  is a keyword and ~c[fn] is the name of an ~c[n]-ary function;
+  interpreter reads ``~c[:fn x1 ... xn]'' as ``~c[(fn 'x1 ... 'xn)]'' when
+  ~c[:fn] is a keyword and ~c[fn] is the name of an ~c[n]-ary function;
   ~pl[keyword-commands].  But this parse is overridden, as described above, for
-  the keywords bound in ~c[ld-keyword-aliases]."
+  the keywords bound in the ~c[ld-keyword-aliases] ~il[table]."
 
-  (f-get-global 'ld-keyword-aliases state))
+  (table-alist 'ld-keyword-aliases (w state)))
 
-(defun ld-keyword-aliasesp (x wrld)
-  (cond ((atom x) (null x))
-        ((and (true-listp (car x))
-              (= (length (car x)) 3))
-         (let ((key (car (car x)))
-               (n (cadr (car x)))
-               (fn (caddr (car x))))
-           (and (keywordp key)
-                (integerp n)
-                (>= n 0)
-                (cond
-                 ((and (symbolp fn)
-                       (function-symbolp fn wrld))
-                  (equal (arity fn wrld) n))
-                 ((and (symbolp fn)
-                       (getprop fn 'macro-body nil
-                                'current-acl2-world wrld))
-                  t)
-                 (t (and (true-listp fn)
-                         (>= (length fn) 3)
-                         (<= (length fn) 4)
-                         (eq (car fn) 'lambda)
-                         (arglistp (cadr fn))
-                         (int= (length (cadr fn)) n))))
-                (ld-keyword-aliasesp (cdr x) wrld))))
-        (t nil)))
+(defun ld-keyword-aliasesp (key val wrld)
+  (and (keywordp key)
+       (true-listp val)
+       (int= (length val) 2)
+       (let ((n (car val))
+             (fn (cadr val)))
+         (and (natp n)
+              (cond
+               ((and (symbolp fn)
+                     (function-symbolp fn wrld))
+                (equal (arity fn wrld) n))
+               ((and (symbolp fn)
+                     (getprop fn 'macro-body nil
+                              'current-acl2-world wrld))
+                t)
+               (t (and (true-listp fn)
+                       (>= (length fn) 3)
+                       (<= (length fn) 4)
+                       (eq (car fn) 'lambda)
+                       (arglistp (cadr fn))
+                       (int= (length (cadr fn)) n))))))))
 
-(defun chk-ld-keyword-aliases (val ctx state)
-  (cond ((ld-keyword-aliasesp val (w state))
-         (value nil))
-        (t (er soft ctx *ld-special-error* 'ld-keyword-aliases val))))
+(table ld-keyword-aliases nil nil
+       :guard
+       (ld-keyword-aliasesp key val world))
 
-(defun set-ld-keyword-aliases (val state)
-  (er-progn
-   (chk-ld-keyword-aliases val 'set-ld-keyword-aliases state)
-   (pprogn
-    (f-put-global 'ld-keyword-aliases val state)
-    (value val))))
+#+acl2-loop-only
+(defmacro add-ld-keyword-alias! (key val)
+  `(state-global-let*
+    ((inhibit-output-lst (list* 'summary 'event (@ inhibit-output-lst))))
+    (progn (table ld-keyword-aliases ,key ,val)
+           (table ld-keyword-aliases))))
+
+#-acl2-loop-only
+(defmacro add-ld-keyword-alias! (key val)
+  (declare (ignore key val))
+  nil)
+
+(defmacro add-ld-keyword-alias (key val)
+  `(local (add-ld-keyword-alias! ,key ,val)))
+
+#+acl2-loop-only
+(defmacro set-ld-keyword-aliases! (alist)
+  `(state-global-let*
+    ((inhibit-output-lst (list* 'summary 'event (@ inhibit-output-lst))))
+    (progn (table ld-keyword-aliases nil ',alist :clear)
+           (table ld-keyword-aliases))))
+
+#-acl2-loop-only
+(defmacro set-ld-keyword-aliases! (alist)
+  (declare (ignore alist))
+  nil)
+
+(defmacro set-ld-keyword-aliases (alist &optional state)
+
+; We add state (optionally) just for backwards compatibility through
+; Version_6.2.  We might eliminate it after Version_6.3.
+
+  (declare (ignore state))
+  `(local (set-ld-keyword-aliases! ,alist)))
 
 (defun ld-missing-input-ok (state)
 
@@ -14862,7 +14908,7 @@
                   (or (eq *verbose-pstk* t)
                       (not (member-eq ',(car form) *verbose-pstk*))))
          (setq *pstk-start-time-stack*
-               (cons (get-internal-run-time) *pstk-start-time-stack*))
+               (cons (get-internal-time) *pstk-start-time-stack*))
          (format t "~V@TCP~D> ~S~%"
                  (* 2 *pstk-level*)
                  *pstk-level*
@@ -14883,7 +14929,7 @@
                   (* 2 *pstk-level*)
                   *pstk-level*
                   ',(car form)
-                  (/ (- (get-internal-run-time)
+                  (/ (- (get-internal-time)
                         (pop *pstk-start-time-stack*))
                      (float internal-time-units-per-second))))
         (setq *pstk-stack* (cdr *pstk-stack*))
diff -Nru acl2-6.2/bdd.lisp acl2-6.3/bdd.lisp
--- acl2-6.2/bdd.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/bdd.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -117,12 +117,7 @@
 
       (cond ((< x ,(mx-id-bound))
              (1+f x))
-            (t (ifix
-
-; This use of ifix looks goofy, but the reason is that we want the compiler
-; to behave properly, and we have proclaimed (at least in GCL) that this
-; function returns a fixnum.
-
+            (t (the-fixnum ; the-fixnum call may help with proclaiming
                 (er-hard-val 0 'bdd
                     "Maximum id for bdds exceeded.  Current maximum id is ~x0."
                     x)))))))
diff -Nru acl2-6.2/books/Makefile acl2-6.3/books/Makefile
--- acl2-6.2/books/Makefile	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/Makefile	2013-09-30 17:53:32.000000000 +0000
@@ -77,6 +77,10 @@
 #    - <target> is optional and defaults to "all" when omitted,
 #        or names the target you want to build (see below).
 
+# Of course, the usual GNU make options are available.  In particular,
+# -k is useful for causing make to keep going when an error is
+# encountered (but return a non-zero error status at the end).
+
 # Major top-level targets:
 #   - `all' is the default
 #   - `everything' includes everything in `all' and also some slow books
@@ -100,6 +104,10 @@
 #   - ACL2_BOOK_DIRS
 #     Augments the targets with all targets that have a prefix among
 #     this list of strings.
+#   - USE_QUICKLISP
+#     Set this if you want to build Quicklisp (which is sort of like
+#     CPAN or RubyGems but for Lisp).  Required for certain books in
+#     oslib.
 
 # Jared Davis has summarized the improvements over the earlier
 # Makefile as follows.
@@ -155,10 +163,18 @@
 #       default to simply (certify-book "foo" ? t)
 #     These instructions specify arguments to certify-book, for example:
 #       ; cert-flags: ? t :ttags :all
-#   - Books that depend on ACL2(h), such as centaur/tutorial/alu16-book.lisp,
-#     contain this line (or, a cert_param directive can be in the
-#     .acl2 file that is consulted, as discussed above):
-#       ; cert_param: (hons-only)
+#   - In the following cases, books may be skipped in which case,
+#     recursively, so are books that include such books, books that
+#     include those parent books, and so on.  In each case, the
+#     indicated line may be placed either in the .lisp file or in the
+#     .acl2 file that is consulted, as discussed above.
+#       - Books that depend on ACL2(h), such as
+#         centaur/tutorial/alu16-book.lisp, contain this line:
+#           ; cert_param: (hons-only)
+#       - Books that require glucose (a SAT solver) contain this line:
+#           ; cert_param: (uses-glucose)
+#       - Books that require quicklisp contain this line:
+#           ; cert_param: (uses-quicklisp)
 #   - Two-pass certification is handled as follows, for example in
 #     books/make-event/stobj-test.acl2 (as indicated above, this can
 #     also go into the book instead of the relevant .acl2 file):
@@ -190,6 +206,18 @@
 # should be something like: if you give a certify-book command, we use it;
 # otherwise we generate one using the cert-flags.
 
+# BUILDING THE XDOC MANUAL
+
+# The xdoc manual is built in centaur/manual/, top page index.html, as
+# a byproduct of building centaur/doc.cert with ACL2(h) using
+# USE_QUICKLISP=1 on the `make' command line.  This has been tested
+# using CCL on Linux, but may work for other OS/Lisp combinations.
+# See also centaur/README.html.  ACL2(h) is required for that build of
+# the xdoc manual, because it is required for some of the books
+# included in centaur/doc.lisp.  You can create a manual for your own
+# books using ACL2 or ACL2(h); see topic SAVE (parent topic XDOC) in
+# the xdoc manual, either in centaur/manual/ or on the web at
+# http://fv.centtech.com/acl2/latest/doc/.
 
 # STATUS / TODO LIST / MISSING FEATURES / BOZOS:
 #
@@ -218,7 +246,7 @@
 ##############################
 
 ifneq ($(ACL2_JOBS), )
-$(error Error: variable ACL2_JOBS is obsolete (use -j instead); see :DOC book-makefiles)
+${error Error: variable ACL2_JOBS is obsolete -- use -j instead -- see :DOC book-makefiles }
 endif # ifneq ($(ACL2_JOBS), )
 
 ACL2 ?= acl2
@@ -236,6 +264,48 @@
 .PHONY: all everything
 all:
 
+QUICKLISP_DIR=centaur/quicklisp
+
+ifneq ($(USE_QUICKLISP), )
+
+$(QUICKLISP_DIR)/quicklisp.lisp:
+	@echo "Downloading Quicklisp"
+	@cd $(QUICKLISP_DIR); curl -O http://beta.quicklisp.org/quicklisp.lisp
+	@ls -l $(QUICKLISP_DIR)/quicklisp.lisp
+
+$(QUICKLISP_DIR)/setup.lisp: $(QUICKLISP_DIR)/quicklisp.lisp \
+                             $(QUICKLISP_DIR)/install.lsp
+	@echo "Setting up Quicklisp"
+	@cd $(QUICKLISP_DIR); $(STARTJOB) -c "$(ACL2) < install.lsp &> install.out"
+	@ls -l $(QUICKLISP_DIR)/setup.lisp
+
+$(QUICKLISP_DIR)/top.cert: $(QUICKLISP_DIR)/setup.lisp \
+                           $(QUICKLISP_DIR)/cert.acl2 \
+                           tools/include-raw.cert
+
+
+all: $(QUICKLISP_DIR)/top.cert
+
+endif # USE_QUICKLISP
+
+# [Jared]: I moved these out of the USE_QUICKLISP section so that "make clean"
+# will always remove the quicklisp files if you have ever built with
+# USE_QUICKLISP before.  The goal is to ensure that stale quicklisp files
+# aren't left around after a "make clean" by accident.
+
+.PHONY: quicklisp_clean
+
+quicklisp_clean:
+	@echo "Removing downloaded quicklisp files (if any)"
+	@cd $(QUICKLISP_DIR); rm -rf setup.lisp quicklisp.lisp asdf.lisp \
+          cache dists local-projects tmp install.out quicklisp Makefile-tmp
+
+clean: quicklisp_clean
+
+
+# Ensure that the following variable is simply expanded.
+ACL2_CUSTOM_TARGETS :=
+
 ##############################
 ### Section: Create auxiliary files (Makefile-xxx) and initial OK_CERTS
 ##############################
@@ -253,18 +323,26 @@
 
 ifndef NO_RESCAN
 
-# In the following, we exclude centaur/quicklisp explicitly rather
-# than using the usual cert_pl_exclude file, because centaur/quicklisp
-# uses cert.pl to certify books.  We exclude centaur/quicklisp
-# explicitly since when we do want to make it, it will use cert.pl and
-# hence we can't put a cert_pl_exclude file in that directory.  Some
-# others we exclude because there are subdirectories and it's simply
-# easiest to stop at the root.
+# We skip the scan for excluded prefixes.  This change was implemented
+# by Matt Kaufmann on 9/25/2013 as part of the process of fixing
+# ACL2(r) regressions.  (Note that nonstd/Makefile includes this
+# Makefile.)
+ifneq ($(EXCLUDED_PREFIXES), )
+space =  # just a space
+EGREP_EXTRA_EXCLUDE_STRING = |$(subst $(space) $(space),|,$(strip $(EXCLUDED_PREFIXES)))
+endif # ifneq ($(EXCLUDED_PREFIXES), )
+
+# We exclude centaur/quicklisp explicitly, instead of using a cert_pl_exclude
+# file, because when people actually install Quicklisp packages, it ends up
+# having subdirectories that we don't know about ahead of time.  We exclude
+# some other directories because there are subdirectories and it's just easiest
+# to stop at the root.
 $(info Scanning for books...)
 REBUILD_MAKEFILE_BOOKS := $(shell \
   rm -f Makefile-books; \
   time find . -name "*.lisp" \
-    | egrep -v '^(\./)?(interface|nonstd|centaur/quicklisp|clause-processors/SULFA|workshops/2003/kaufmann/support)' \
+    | egrep -v '^(\./)?(interface|nonstd|centaur/quicklisp|milawa|clause-processors/SULFA|workshops/2003/kaufmann/support|models/y86/$(EGREP_EXTRA_EXCLUDE_STRING))' \
+    | fgrep -v '.\#' \
   > Makefile-books; \
   ls -l Makefile-books)
 #$(info $(REBUILD_MAKEFILE_BOOKS))
@@ -297,6 +375,15 @@
      "$(ACL2) < cert_features.lsp &> Makefile-features.out" ;\
   ls -l Makefile-features)
 
+$(info Determining whether Glucose is installed)
+# If glucose doesn't exist, then the error message saying it can't be
+# found is redirected to /dev/null, resulting in an empty value for
+# GLUCOSE_EXISTS
+GLUCOSE_EXISTS := $(shell glucose --version 2>/dev/null)
+ifdef GLUCOSE_EXISTS
+  OS_HAS_GLUCOSE := 1
+endif # ifdef GLUCOSE_EXISTS
+
 # Only conditionally include Makefile-features, so that make clean works even
 # if ACL2 isn't built.
 -include Makefile-features
@@ -305,28 +392,102 @@
 $(info ACL2_HAS_REALS    := $(ACL2_HAS_REALS))
 $(info ACL2_COMP_EXT     := $(ACL2_COMP_EXT))
 $(info ACL2_HOST_LISP    := $(ACL2_HOST_LISP))
+$(info OS_HAS_GLUCOSE    := $(OS_HAS_GLUCOSE))
+$(info USE_QUICKLISP     := $(USE_QUICKLISP))
 $(info Done with features.)
 
+# Cause error for illegal certification attempts:
+
+ifeq ($(ACL2_HAS_HONS), )
+
+$(CERT_PL_HONS_ONLY):
+	$(MAKE) no_hons_error NO_RESCAN=1 CERT_PL_HONS_ONLY_BOOK=$@
+
+.PHONY: no_hons_error
+no_hons_error:
+	@echo "Error! Target $(CERT_PL_HONS_ONLY_BOOK) requires hons."
+	@exit 1
+
+endif
+
+# End of "Cause error for illegal certification attempts".
+
 OK_CERTS := $(CERT_PL_CERTS)
 
 ifeq ($(ACL2_HAS_HONS), )
 
-# $(info Excluding books that depend on ACL2(h))
+# We use "{...}" delimeters to avoid errors in version 3.80 of make.
+${info Excluding books that need ACL2(h) [...]}
 OK_CERTS := $(filter-out $(CERT_PL_HONS_ONLY), $(OK_CERTS))
 
 endif # ifeq ($(ACL2_HAS_HONS), )
 
-# SLOW_BOOKS are books that are too slow to include as part of an
-# ordinary regression.  There are currently comments in some of the
-# corresponding Makefiles that explain something about these books.
+ifeq ($(OS_HAS_GLUCOSE), )
 
-SLOW_BOOKS := \
+$(info Excluding books that need Glucose: [$(CERT_PL_USES_GLUCOSE)])
+OK_CERTS := $(filter-out $(CERT_PL_USES_GLUCOSE), $(OK_CERTS))
+
+endif # ifeq ($(OS_HAS_GLUCOSE), )
+
+ifeq ($(USE_QUICKLISP), )
+$(info Excluding books that depend on Quicklisp: [$(CERT_PL_USES_QUICKLISP)])
+OK_CERTS := $(filter-out $(CERT_PL_USES_QUICKLISP), $(OK_CERTS))
+endif
+
+# SLOW_BOOKS is a list of books that are too slow to include as part
+# of an ordinary regression.  There are currently comments in some of
+# the corresponding Makefiles that explain something about these
+# books.  WARNING: It is probably a bad idea to include targets here
+# that are in ACL2_CUSTOM_TARGETS: SLOW_BOOKS is removed from OK_CERTS
+# just below, but later, ACL2_CUSTOM_TARGETS adds its targets to
+# OK_CERTS.
+
+# Before defining SLOW_BOOKS, we define ADDED_BOOKS to be the books
+# that we want to add back in when using target "everything" instead
+# of the default target, "all".
+
+ADDED_BOOKS := \
   coi/termination/assuming/complex.cert \
   models/jvm/m5/apprentice.cert \
   parallel/proofs/ideal-speedup.cert \
   workshops/2009/sumners/support/examples.cert \
   workshops/2011/krug-et-al/support/MinVisor/va-to-pa-thm.cert \
-  workshops/2011/krug-et-al/support/MinVisor/setup-nested-page-tables.cert
+  workshops/2011/krug-et-al/support/MinVisor/setup-nested-page-tables.cert \
+  $(filter rtl/rel7/%, $(OK_CERTS))
+
+# The following has taken only a couple of minutes on a decent Linux
+# system in 2013.  However, ACL2 built on GCL 2.6.8 and Mac OS 10.6
+# cannot complete the certification without running exhausting STRING
+# storage, probably because it contains a large stobj.  So we certify
+# it only in "everything" regressions.
+
+ADDED_BOOKS += workshops/2013/hardin-hardin/support/APSP.cert
+
+# Now SLOW_BOOKS is defined as the list above, except that below, we
+# also include books that are too slow for both an ordinary regression
+# (target "all") and an "everything" regression.
+
+SLOW_BOOKS := $(ADDED_BOOKS)
+
+# Note that models/y86/ is already excluded in the setting of
+# REBUILD_MAKEFILE_BOOKS above, but these books are built if
+# models/y86-target.cert is included.  File models/y86-target.lisp is
+# already labeled as hons-only, but even with ACL2(h) we want to
+# exclude some host Lisps.  Certainly CCL can handle these books,
+# since it has significant optimizations for ACL2(h).  But in one ANSI
+# GCL ACL2(h) regression, certification runs were still proceeding
+# after more than 10 hours for each of four books under models/y86/
+# (y86-basic/common/x86-state, y86-two-level/common/x86-state,
+# y86-two-level-abs/common/x86-state-concrete, and
+# y86-basic/py86/popcount), probably because of the demands of
+# def-gl-thm.  Moreover, LispWorks has too small a value for
+# array-dimension-limit to support these certifications.
+
+ifeq ($(filter CCL ALLEGRO SBCL, $(ACL2_HOST_LISP)), )
+# When the Lisp is not one of those mentioned on the line above, we
+# skip the models/y86/ books.
+  SLOW_BOOKS += models/y86-target.cert
+endif
 
 OK_CERTS := $(filter-out $(SLOW_BOOKS), $(OK_CERTS))
 
@@ -339,7 +500,6 @@
 # script will remove things like .cert and .fasl files.
 
 CLEAN_FILES_EXPLICIT := \
-   xdoc-impl/bookdoc.dat \
    Makefile-comp \
    Makefile-comp-pre \
    Makefile-deps \
@@ -351,7 +511,6 @@
    nonstd/workshops/1999/calculus/book/tree.lisp
 
 MORECLEAN_FILES_EXPLICIT := \
-   xdoc-impl/manual \
    centaur/manual
 
 .PHONY: clean_books clean
@@ -362,13 +521,15 @@
 
 # We test that directory centaur/quicklisp exists because it probably
 # doesn't for nonstd/, and we include this makefile from that
-# directory.
+# directory.  Also, we clean models/y86 explicitly, since
+# models/Makefile (from custom target models/y86-target.cert) doesn't
+# exist.
 clean: clean_books
 	@echo "Removing extra, explicitly temporary files."
 	rm -rf $(CLEAN_FILES_EXPLICIT)
-	for dir in centaur/quicklisp $(dir $(ACL2_CUSTOM_TARGETS)) ; \
+	for dir in $(dir $(ACL2_CUSTOM_TARGETS)) models/y86 ; \
 	do \
-	if [ -d $$dir ] ; then \
+	if [ -f $$dir/Makefile ] ; then \
 	(cd $$dir ; $(MAKE) clean) ; \
 	fi ; \
 	done
@@ -383,20 +544,6 @@
 
 # Next, we deal with books that need special handling.
 
-# xdoc-impl is tricky because we have to generate bookdoc.dat.
-
-xdoc-impl/bookdoc.dat: \
-  xdoc-impl/acl2-customization.lsp \
-  xdoc-impl/bookdoc.lsp \
-  xdoc/package.lsp \
-  $(wildcard xdoc/*.lisp) \
-  $(wildcard xdoc-impl/*.lisp) \
-  xdoc-impl/extra-packages.cert
-	@echo "Making xdoc-impl/bookdoc.dat"
-	@cd xdoc-impl; \
-          $(STARTJOB) -c "$(ACL2) < bookdoc.lsp &> bookdoc.out"
-	@ls -l xdoc-impl/bookdoc.dat
-
 # We assume that ACL2_HAS_REALS indicates a regression being done in
 # nonstd/.
 ifeq ($(ACL2_HAS_REALS), )
@@ -474,16 +621,30 @@
 # cert_pl_exclude file or else be explicitly excluded in the egrep
 # command that is used to define REBUILD_MAKEFILE_BOOKS, above.
 # Otherwise we might make the same file twice, would could cause
-# conflicts if -j is other than 1.
+# conflicts if -j is other than 1.  Also: Do not include any targets,
+# such as models/y86-target.cert, that we don't always want built with
+# "all".
+
 ACL2_CUSTOM_TARGETS := \
   clause-processors/SULFA/target.cert \
   fix-cert/fix-cert.cert \
+  translators/l3-to-acl2/target.cert \
   workshops/1999/multiplier/proof.cert \
   workshops/2003/greve-wilding-vanfleet/support/firewallworks.cert \
   workshops/2003/kaufmann/support/input/defs-in.cert \
   workshops/2004/sumners-ray/support/success.txt \
   workshops/2011/verbeek-schmaltz/sources/correctness2.cert
 
+# Warning!  For each target below, if there is a cert_pl_exclude file
+# in the directory or it is exluded explicitly by
+# REBUILD_MAKEFILE_BOOKS, and a "deps" file is used, then that "deps"
+# file should be placed in a different directory (that is not
+# excluded).  For example, translators/l3-to-acl2/target.cert below
+# depends on translators/l3-to-acl2-deps.cert, for which dependencies
+# will be generated since there is no cert_pl_exclude file in
+# translators/ (even though there is a cert_pl_exclude in
+# translators/l3-to-acl2/).
+
 # We only make the books under SULFA if a documented test for an
 # installed SAT solver succeeds.
 clause-processors/SULFA/target.cert: \
@@ -499,6 +660,18 @@
 fix-cert/fix-cert.cert:
 	cd $(@D) ; $(STARTJOB) -c "$(MAKE)"
 
+# The following need not be made a custom target, since it's not in an
+# excluded directory.  Note that we use -j 1 because of the
+# potentially large memory requirements.
+ifneq ($(ACL2_HAS_HONS), )
+models/y86-target.cert:
+	cd $(@D)/y86 ; $(STARTJOB) -c "$(MAKE) -j 1"
+endif
+
+translators/l3-to-acl2/target.cert: \
+  translators/l3-to-acl2-deps.cert
+	cd $(@D) ; $(STARTJOB) -c "$(MAKE) -j 1"
+
 workshops/1999/multiplier/proof.cert: \
   workshops/1999/deps-multiplier.cert
 	cd $(@D) ; $(STARTJOB) -c "$(MAKE)"
@@ -581,7 +754,7 @@
 # its books.)
 $(info For building compiled (.$(ACL2_COMP_EXT)) files, excluding centaur books)
 OK_CERTS := $(filter-out centaur/%, \
-              $(filter-out models/y86/%, \
+              $(filter-out models/y86%, \
                 $(OK_CERTS)))
 
 ifndef NO_RESCAN
@@ -641,6 +814,9 @@
 # The .acl2 files specify no compilation:
 BOOKS_SKIP_COMP += $(patsubst %.cert, %.$(ACL2_COMP_EXT), $(wildcard workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/*.cert))
 
+# The .acl2 file specifies no compilation:
+BOOKS_SKIP_COMP += ccg/ccg.$(ACL2_COMP_EXT)
+
 # Some .acl2 files specify no compilation, including ed3.acl2, and
 # many books depend on ed3:
 BOOKS_SKIP_COMP += $(patsubst %.cert, %.$(ACL2_COMP_EXT), $(wildcard workshops/2006/cowles-gamboa-euclid/Euclid/*.cert))
@@ -715,6 +891,10 @@
 ### Section: Exclude EXCLUDED_PREFIXES
 ##############################
 
+# It might no longer be necessary to filter out EXCLUDED_PREFIXES from
+# OK_CERTS, now that EGREP_EXTRA_EXCLUDE_STRING contributes to the
+# exclusion process, but we go ahead and do so here, for robustness.
+
 OK_CERTS := $(filter-out $(addsuffix %, $(EXCLUDED_PREFIXES)), $(OK_CERTS))
 
 ##############################
@@ -746,57 +926,18 @@
 # accordingly.  Note that the pathnames in ACL2_BOOK_DIRS should be
 # relative to the top-level books directory, not absolute pathnames.
 
-# So  that ACL2_BOOK_CERTS is not recursive:
+# So that ACL2_BOOK_CERTS is not recursive (but don't set it to the
+# empty string, since it might be set on the command line!).
 ACL2_BOOK_CERTS := $(ACL2_BOOK_CERTS)
 ifneq ($(ACL2_BOOK_DIRS), )
 $(info ACL2_BOOK_DIRS = $(ACL2_BOOK_DIRS))
 ACL2_BOOK_DIRS_PATTERNS := $(addsuffix /%, $(ACL2_BOOK_DIRS))
-ACL2_BOOK_CERTS += $(ACL2_BOOK_CERTS) \
-                   $(filter $(ACL2_BOOK_DIRS_PATTERNS), $(OK_CERTS))
+ACL2_BOOK_CERTS += $(filter $(ACL2_BOOK_DIRS_PATTERNS), $(OK_CERTS))
 endif # ifneq ($(ACL2_BOOK_DIRS), )
 
 ifneq ($(ACL2_BOOK_CERTS), )
 $(info ACL2_BOOK_CERTS = $(ACL2_BOOK_CERTS))
 OK_CERTS := $(ACL2_BOOK_CERTS)
-else
-
-# Normal case, where neither ACL2_BOOK_DIRS nor ACL2_BOOK_CERTS is
-# defined:
-
-# We prefer not to certify books under the directories filtered out
-# just below, for the following reasons.
-# - rtl/rel7/: This directory isn't used anywhere else and it doesn't
-#   add much from a regression perspective, given the other rtl/
-#   subdirectories that are included in the regression.
-
-# However, we want cert.pl to scan within any such directory, to
-# support the "everything" target, so we avoid putting cert_pl_exclude
-# files in such a directory or excluding them from the egrep command
-# that is used to define REBUILD_MAKEFILE_BOOKS, above.  Instead, we
-# exclude them from the "all" target now.
-
-OK_CERTS_EXCLUSIONS := $(filter rtl/rel7/%, $(OK_CERTS))
-
-ifneq ($(ACL2_HAS_HONS), )
-ifeq ($(filter CCL ALLEGRO SBCL, $(ACL2_HOST_LISP)), )
-
-# We exclude models/y86/ for ACL2(h) except for CCL, which has
-# significant optimizations for ACL2(h), and except for other Lisps
-# that we have observed to perform acceptably on certifying these
-# books.  In an ANSI GCL ACL2(h) regression, certification runs were
-# still proceeding after more than 10 hours for each of four books
-# under models/y86/ (y86-basic/common/x86-state,
-# y86-two-level/common/x86-state,
-# y86-two-level-abs/common/x86-state-concrete, and
-# y86-basic/py86/popcount), probably because of the demands of
-# def-gl-thm.  Moreover, LispWorks has too small a value for
-# array-dimension-limit to support these certifications.
-
-OK_CERTS_EXCLUSIONS += $(filter models/y86/%, $(OK_CERTS))
-endif # ifeq ($(ACL2_HOST_LISP), GCL)
-endif # ifneq ($(ACL2_HAS_HONS), )
-
-OK_CERTS := $(filter-out $(OK_CERTS_EXCLUSIONS), $(OK_CERTS))
 
 endif # ifneq ($(ACL2_BOOK_CERTS), )
 
@@ -807,11 +948,14 @@
 
 all: $(OK_CERTS)
 
-# OK_CERTS_EXCLUSIONS is undefined if ACL2_BOOK_CERTS is defined, but
-# that's not a problem; after all, in that case OK_CERTS wasn't
-# filtered by OK_CERTS_EXCLUSIONS.  Besides, we don't intend to
-# support "everything" when ACL2_BOOK_CERTS is defined.
-everything: all $(OK_CERTS_EXCLUSIONS) $(SLOW_BOOKS)
+# It was tempting to handle the `everything' target as follows:
+#  everything: USE_QUICKLISP = 1
+#  everything: all $(ADDED_BOOKS)
+# But that didn't work, presumably because the value of OK_CERTS was
+# on a first pass through the Makefile without USE_QUICKLISP being
+# set.
+everything:
+	$(MAKE) all $(ADDED_BOOKS) USE_QUICKLISP=1
 
 # The critical path report will work only if you have set up certificate timing
 # BEFORE you build the books.  See ./critpath.pl --help for details.
@@ -838,6 +982,8 @@
 
 coi: $(filter coi/%, $(OK_CERTS))
 
+xdoc: $(filter xdoc/%, $(OK_CERTS))
+
 workshops: $(filter workshops/%, $(OK_CERTS))
 workshop1999: $(filter workshops/1999/%, $(OK_CERTS))
 workshop2000: $(filter workshops/2000/%, $(OK_CERTS))
@@ -967,3 +1113,25 @@
 # workshops/2003/greve-wilding-vanfleet/deps.cert
 # workshops/2003/kaufmann/deps.cert
 # workshops/2011/verbeek-schmaltz/deps.cert
+
+
+
+
+# VL Toolkit
+
+centaur/vl/bin/vl: centaur/vl/kit/top.cert
+	@echo "Making VL Verilog Toolkit executable"
+	@cd centaur/vl/kit; \
+         ACL2_CUSTOMIZATION=NONE $(STARTJOB) -c "$(ACL2) < save.lsp &> save.out"
+	@ls -la centaur/vl/bin/vl
+
+.PHONY: vl
+vl: centaur/vl/bin/vl
+
+.PHONY: clean_vl
+clean_vl:
+	@echo "Cleaning centaur/vl/bin directory"
+	@rm -f centaur/vl/bin/*
+
+clean: clean_vl
+
diff -Nru acl2-6.2/books/Makefile-big acl2-6.3/books/Makefile-big
--- acl2-6.2/books/Makefile-big	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/Makefile-big	1970-01-01 00:00:00.000000000 +0000
@@ -1,70 +0,0 @@
-
-
-######################################################################
-## NOTE.  This file is not part of the standard ACL2 books build
-## process; it is part of an experimental build system that is not yet
-## intended, for example, to be capable of running the whole
-## regression.  The ACL2 developers do not maintain this file.
-##
-## Please contact Jared Davis <jared@cs.utexas.edu> or Sol Swords
-## <sswords@cs.utexas.edu> with any questions/comments.
-######################################################################
-
-# Copyright 2008 by Jared Davis and Sol Swords.
-# Credit to Matt Kaufmann and J Strother Moore for code from Makefile-generic.
-
-
-# This makefile is designed to support file-level dependencies among
-# ACL2 books.  The make-all-deps.sh script produces a dependency file
-# called Makefile-alldeps reflecting the dependencies among all the
-# libraries that support this scheme.
-
-
-all:
-
-Makefile-alldeps:
-	@echo "Running make-all-deps.sh" ;\
-	bash make-all-deps.sh ;
-
-include Makefile-alldeps
-
-all: $(BOOKS)
-
-%.cert: %.lisp
-	@echo "Making `pwd`/$*.cert on `date`" ;\
-	DIR=`dirname $*` ;\
-	FILE=`basename $*` ;\
-        ACL2=`which $(ACL2)` ;\
-	cd $$DIR ;\
-	rm -f $$FILE.cert ;\
-	echo '(acl2::value :q)' > workxxx.$$FILE ;\
-	echo '(in-package "ACL2")' >> workxxx.$$FILE ;\
-	echo '(acl2::lp)' >> workxxx.$$FILE ;\
-	echo '$(INHIBIT)' >> workxxx.$$FILE ;\
-	if [ -f $$FILE.acl2 ] ;\
-	then \
-	  cat $$FILE.acl2 >> workxxx.$$FILE ;\
-	elif [ -f cert.acl2 ] ;\
-	then \
-	  cat cert.acl2 >> workxxx.$$FILE ;\
-	  echo "" >> workxxx.$$FILE ;\
-	  echo "(certify-book \"$$FILE\" ? t)" >> workxxx.$$FILE ;\
-	else \
-	  echo "" >> workxxx.$$FILE ;\
-	  echo "(certify-book! \"$$FILE\" 0 t)" >> workxxx.$$FILE ;\
-	fi ;\
-	echo "" >> workxxx.$$FILE ;\
-	echo '(acl2::value :q)' >> workxxx.$$FILE ;\
-	echo '(acl2::exit-lisp)' >> workxxx.$$FILE ;\
-	($$ACL2 < workxxx.$$FILE 2>&1) > $$FILE.out ;\
-	rm -f workxxx.$$FILE ;\
-	((test -f $$FILE.cert) && (ls -al $$FILE.cert)) || (echo "**CERTIFICATION FAILED** for `pwd`/$$FILE.lisp" ; exit 1)
-
-
-
-%.lisp:
-	@echo "Trying to generate $*.lisp" ;\
-	DIR=`dirname $*` ;\
-	FILE=`basename $*` ;\
-	cd $$DIR ;\
-	$(MAKE) $$FILE.lisp
diff -Nru acl2-6.2/books/Makefile-fast acl2-6.3/books/Makefile-fast
--- acl2-6.2/books/Makefile-fast	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/Makefile-fast	1970-01-01 00:00:00.000000000 +0000
@@ -1,80468 +0,0 @@
-
-# This makefile was generated by running:
-# cert.pl -s Makefile-fast --targets regression-targets -b .
-
-# Cert.pl is a build system for ACL2 books.  The cert.pl executable is
-# located under your ACL2_SYSTEM_BOOKS directory; run "cert.pl -h" for
-# usage options.
-
-
-ACL2_SYSTEM_BOOKS ?= .
-include $(ACL2_SYSTEM_BOOKS)/make_cert
-
-
-.PHONY: all-cert-pl-certs
-
-# Depends on all certificate files.
-all-cert-pl-certs:
-
-CERT_PL_CERTS := \
-     arithmetic-2/floor-mod/floor-mod-helper.cert \
-     arithmetic-2/floor-mod/floor-mod.cert \
-     arithmetic-2/meta/cancel-terms-helper.cert \
-     arithmetic-2/meta/cancel-terms-meta.cert \
-     arithmetic-2/meta/collect-terms-meta.cert \
-     arithmetic-2/meta/common-meta.cert \
-     arithmetic-2/meta/expt-helper.cert \
-     arithmetic-2/meta/expt.cert \
-     arithmetic-2/meta/integerp-meta.cert \
-     arithmetic-2/meta/integerp.cert \
-     arithmetic-2/meta/mini-theories.cert \
-     arithmetic-2/meta/non-linear.cert \
-     arithmetic-2/meta/numerator-and-denominator.cert \
-     arithmetic-2/meta/post.cert \
-     arithmetic-2/meta/pre.cert \
-     arithmetic-2/meta/top.cert \
-     arithmetic-2/pass1/basic-arithmetic-helper.cert \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/expt-helper.cert \
-     arithmetic-2/pass1/expt.cert \
-     arithmetic-2/pass1/inequalities.cert \
-     arithmetic-2/pass1/mini-theories.cert \
-     arithmetic-2/pass1/numerator-and-denominator-helper.cert \
-     arithmetic-2/pass1/numerator-and-denominator.cert \
-     arithmetic-2/pass1/prefer-times.cert \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-3/bind-free/arithmetic-theory.cert \
-     arithmetic-3/bind-free/banner.cert \
-     arithmetic-3/bind-free/basic-helper.cert \
-     arithmetic-3/bind-free/basic.cert \
-     arithmetic-3/bind-free/building-blocks.cert \
-     arithmetic-3/bind-free/collect.cert \
-     arithmetic-3/bind-free/common.cert \
-     arithmetic-3/bind-free/default-hint.cert \
-     arithmetic-3/bind-free/integerp-meta.cert \
-     arithmetic-3/bind-free/integerp.cert \
-     arithmetic-3/bind-free/mini-theories-helper.cert \
-     arithmetic-3/bind-free/mini-theories.cert \
-     arithmetic-3/bind-free/normalize.cert \
-     arithmetic-3/bind-free/numerator-and-denominator.cert \
-     arithmetic-3/bind-free/remove-weak-inequalities.cert \
-     arithmetic-3/bind-free/simplify-helper.cert \
-     arithmetic-3/bind-free/simplify.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/extra/ext.cert \
-     arithmetic-3/extra/top-ext.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic-3/floor-mod/mod-expt-fast.cert \
-     arithmetic-3/pass1/basic-arithmetic-helper.cert \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/expt-helper.cert \
-     arithmetic-3/pass1/expt.cert \
-     arithmetic-3/pass1/inequalities.cert \
-     arithmetic-3/pass1/mini-theories.cert \
-     arithmetic-3/pass1/non-linear.cert \
-     arithmetic-3/pass1/num-and-denom-helper.cert \
-     arithmetic-3/pass1/numerator-and-denominator.cert \
-     arithmetic-3/pass1/prefer-times.cert \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/top.cert \
-     arithmetic-5/lib/basic-ops/arithmetic-theory.cert \
-     arithmetic-5/lib/basic-ops/banner.cert \
-     arithmetic-5/lib/basic-ops/basic.cert \
-     arithmetic-5/lib/basic-ops/building-blocks-helper.cert \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/collect.cert \
-     arithmetic-5/lib/basic-ops/common.cert \
-     arithmetic-5/lib/basic-ops/default-hint.cert \
-     arithmetic-5/lib/basic-ops/distributivity.cert \
-     arithmetic-5/lib/basic-ops/dynamic-e-d.cert \
-     arithmetic-5/lib/basic-ops/elim-hint.cert \
-     arithmetic-5/lib/basic-ops/expt-helper.cert \
-     arithmetic-5/lib/basic-ops/expt.cert \
-     arithmetic-5/lib/basic-ops/forcing-types.cert \
-     arithmetic-5/lib/basic-ops/if-normalization.cert \
-     arithmetic-5/lib/basic-ops/integerp-helper.cert \
-     arithmetic-5/lib/basic-ops/integerp-meta.cert \
-     arithmetic-5/lib/basic-ops/integerp.cert \
-     arithmetic-5/lib/basic-ops/mini-theories.cert \
-     arithmetic-5/lib/basic-ops/natp-posp.cert \
-     arithmetic-5/lib/basic-ops/normalize.cert \
-     arithmetic-5/lib/basic-ops/numerator-and-denominator.cert \
-     arithmetic-5/lib/basic-ops/remove-weak-inequalities.cert \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.cert \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert \
-     arithmetic-5/lib/basic-ops/simplify-helper.cert \
-     arithmetic-5/lib/basic-ops/simplify.cert \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/basic-ops/types-helper.cert \
-     arithmetic-5/lib/basic-ops/types.cert \
-     arithmetic-5/lib/basic-ops/we-are-here.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic-helper.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-helper.cert \
-     arithmetic-5/lib/floor-mod/floor-mod.cert \
-     arithmetic-5/lib/floor-mod/forcing-types.cert \
-     arithmetic-5/lib/floor-mod/if-normalization.cert \
-     arithmetic-5/lib/floor-mod/logand-helper.cert \
-     arithmetic-5/lib/floor-mod/logand.cert \
-     arithmetic-5/lib/floor-mod/mod-expt-fast.cert \
-     arithmetic-5/lib/floor-mod/more-floor-mod.cert \
-     arithmetic-5/lib/floor-mod/top.cert \
-     arithmetic-5/lib/floor-mod/truncate-rem.cert \
-     arithmetic-5/support/basic-arithmetic-helper.cert \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/expt-helper.cert \
-     arithmetic-5/support/expt.cert \
-     arithmetic-5/support/inequalities.cert \
-     arithmetic-5/support/mini-theories.cert \
-     arithmetic-5/support/non-linear.cert \
-     arithmetic-5/support/num-and-denom-helper.cert \
-     arithmetic-5/support/numerator-and-denominator.cert \
-     arithmetic-5/support/prefer-times.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/top.cert \
-     arithmetic/abs.cert \
-     arithmetic/binomial.cert \
-     arithmetic/equalities.cert \
-     arithmetic/factorial.cert \
-     arithmetic/idiv.cert \
-     arithmetic/inequalities.cert \
-     arithmetic/mod-gcd.cert \
-     arithmetic/nat-listp.cert \
-     arithmetic/natp-posp.cert \
-     arithmetic/rational-listp.cert \
-     arithmetic/rationals.cert \
-     arithmetic/sumlist.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top.cert \
-     bdd/alu-proofs.cert \
-     bdd/alu.cert \
-     bdd/bdd-primitives.cert \
-     bdd/bool-ops.cert \
-     bdd/cbf.cert \
-     bdd/hamming.cert \
-     bdd/pg-theory.cert \
-     centaur/4v-sexpr/4v-logic.cert \
-     centaur/4v-sexpr/bitspecs.cert \
-     centaur/4v-sexpr/compose-sexpr.cert \
-     centaur/4v-sexpr/g-sexpr-eval.cert \
-     centaur/4v-sexpr/nsexprs.cert \
-     centaur/4v-sexpr/onehot-rewrite.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-3v.cert \
-     centaur/4v-sexpr/sexpr-advanced.cert \
-     centaur/4v-sexpr/sexpr-building.cert \
-     centaur/4v-sexpr/sexpr-equivs.cert \
-     centaur/4v-sexpr/sexpr-eval.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-correct.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-rewriting.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-spec.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-top.cert \
-     centaur/4v-sexpr/sexpr-fixpoint.cert \
-     centaur/4v-sexpr/sexpr-loop-debug.cert \
-     centaur/4v-sexpr/sexpr-rewrites.cert \
-     centaur/4v-sexpr/sexpr-to-faig.cert \
-     centaur/4v-sexpr/sexpr-vars-1pass.cert \
-     centaur/4v-sexpr/sexpr-vars.cert \
-     centaur/4v-sexpr/svarmap.cert \
-     centaur/4v-sexpr/top.cert \
-     centaur/aig/aig-equivs.cert \
-     centaur/aig/aig-vars-ext.cert \
-     centaur/aig/aig-vars.cert \
-     centaur/aig/aiger.cert \
-     centaur/aig/base.cert \
-     centaur/aig/bddify-correct.cert \
-     centaur/aig/bddify.cert \
-     centaur/aig/eval-restrict.cert \
-     centaur/aig/g-aig-eval.cert \
-     centaur/aig/induction.cert \
-     centaur/aig/misc.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/three-four.cert \
-     centaur/aig/vuaig.cert \
-     centaur/aig/witness.cert \
-     centaur/bitops/bits-between.cert \
-     centaur/bitops/bitsets-opt.cert \
-     centaur/bitops/bitsets.cert \
-     centaur/bitops/congruences.cert \
-     centaur/bitops/equal-by-logbitp.cert \
-     centaur/bitops/extra-defs.cert \
-     centaur/bitops/ihs-extensions.cert \
-     centaur/bitops/ihsext-basics.cert \
-     centaur/bitops/install-bit.cert \
-     centaur/bitops/integer-length.cert \
-     centaur/bitops/part-select.cert \
-     centaur/bitops/rotate.cert \
-     centaur/bitops/sbitsets.cert \
-     centaur/bitops/sign-extend.cert \
-     centaur/bitops/top.cert \
-     centaur/bridge/portcullis.cert \
-     centaur/bridge/to-json.cert \
-     centaur/bridge/top.cert \
-     centaur/defrstobj/array-lemmas.cert \
-     centaur/defrstobj/basic-tests.cert \
-     centaur/defrstobj/def-typed-record.cert \
-     centaur/defrstobj/defrstobj.cert \
-     centaur/defrstobj/fancy-worseguy.cert \
-     centaur/defrstobj/g-delete-keys.cert \
-     centaur/defrstobj/groundwork/array-rec.cert \
-     centaur/defrstobj/groundwork/demo1.cert \
-     centaur/defrstobj/groundwork/demo2.cert \
-     centaur/defrstobj/groundwork/demo3.cert \
-     centaur/defrstobj/groundwork/demo4.cert \
-     centaur/defrstobj/groundwork/demo5.cert \
-     centaur/defrstobj/groundwork/local.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/typed-record-tests.cert \
-     centaur/defrstobj/typed-records.cert \
-     centaur/esim/esim-paths.cert \
-     centaur/esim/esim-primitives.cert \
-     centaur/esim/esim-sexpr-correct.cert \
-     centaur/esim/esim-sexpr-support-thms.cert \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/esim/esim-sexpr.cert \
-     centaur/esim/esim-spec.cert \
-     centaur/esim/esim-vcd.cert \
-     centaur/esim/esim-vl.cert \
-     centaur/esim/follow-backwards.cert \
-     centaur/esim/local-theory.cert \
-     centaur/esim/plist.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/steps.cert \
-     centaur/esim/stv/stv-compile.cert \
-     centaur/esim/stv/stv-debug.cert \
-     centaur/esim/stv/stv-doc.cert \
-     centaur/esim/stv/stv-expand.cert \
-     centaur/esim/stv/stv-run.cert \
-     centaur/esim/stv/stv-sim.cert \
-     centaur/esim/stv/stv-top.cert \
-     centaur/esim/stv/stv-util.cert \
-     centaur/esim/stv/stv-widen.cert \
-     centaur/gl/always-equal-prep.cert \
-     centaur/gl/auto-bindings.cert \
-     centaur/gl/bfr-aig-bddify.cert \
-     centaur/gl/bfr-sat.cert \
-     centaur/gl/bfr.cert \
-     centaur/gl/bvec-ite.cert \
-     centaur/gl/bvecs.cert \
-     centaur/gl/def-gl-clause-proc.cert \
-     centaur/gl/defagg.cert \
-     centaur/gl/defapply.cert \
-     centaur/gl/eval-f-i-cp.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/factor-fns.cert \
-     centaur/gl/g-always-equal.cert \
-     centaur/gl/g-ash.cert \
-     centaur/gl/g-binary-+.cert \
-     centaur/gl/g-binary-mult.cert \
-     centaur/gl/g-code-char.cert \
-     centaur/gl/g-coerce.cert \
-     centaur/gl/g-cons.cert \
-     centaur/gl/g-equal.cert \
-     centaur/gl/g-floor.cert \
-     centaur/gl/g-gl-mbe.cert \
-     centaur/gl/g-hide.cert \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-integer-length.cert \
-     centaur/gl/g-intern.cert \
-     centaur/gl/g-lessthan.cert \
-     centaur/gl/g-logand.cert \
-     centaur/gl/g-logbitp.cert \
-     centaur/gl/g-logior.cert \
-     centaur/gl/g-lognot.cert \
-     centaur/gl/g-make-fast-alist.cert \
-     centaur/gl/g-mod.cert \
-     centaur/gl/g-predicates.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/g-rem.cert \
-     centaur/gl/g-truncate.cert \
-     centaur/gl/g-unary--.cert \
-     centaur/gl/g-unary-concrete.cert \
-     centaur/gl/general-object-thms.cert \
-     centaur/gl/general-objects.cert \
-     centaur/gl/generic-geval.cert \
-     centaur/gl/gify-clause-proc.cert \
-     centaur/gl/gify-thms.cert \
-     centaur/gl/gify.cert \
-     centaur/gl/gl-doc-string.cert \
-     centaur/gl/gl-generic-clause-proc.cert \
-     centaur/gl/gl-mbe.cert \
-     centaur/gl/gl-misc-defs.cert \
-     centaur/gl/gl-misc-doc.cert \
-     centaur/gl/gl-util.cert \
-     centaur/gl/gl.cert \
-     centaur/gl/glcp-templates.cert \
-     centaur/gl/gobject-type-thms.cert \
-     centaur/gl/gobject-types.cert \
-     centaur/gl/gobjectp-thms.cert \
-     centaur/gl/gobjectp.cert \
-     centaur/gl/gtests.cert \
-     centaur/gl/gtype-thms.cert \
-     centaur/gl/gtypes.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/hyp-fix.cert \
-     centaur/gl/ite-merge.cert \
-     centaur/gl/param.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/run-gified-cp.cert \
-     centaur/gl/rws.cert \
-     centaur/gl/shape-spec.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/misc/absstobjs.cert \
-     centaur/misc/alist-defs.cert \
-     centaur/misc/alist-equiv.cert \
-     centaur/misc/alist-witness.cert \
-     centaur/misc/ap.cert \
-     centaur/misc/arith-equivs.cert \
-     centaur/misc/context-rw.cert \
-     centaur/misc/defapply.cert \
-     centaur/misc/dfs-measure.cert \
-     centaur/misc/equal-by-nths.cert \
-     centaur/misc/equal-sets.cert \
-     centaur/misc/evaluator-metatheorems.cert \
-     centaur/misc/fal-graphs.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/misc/filter-alist.cert \
-     centaur/misc/hons-alphorder-merge.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/misc/hons-remove-dups.cert \
-     centaur/misc/hons-sets.cert \
-     centaur/misc/interp-function-lookup.cert \
-     centaur/misc/introduce-var.cert \
-     centaur/misc/lists.cert \
-     centaur/misc/load-stobj-tests.cert \
-     centaur/misc/load-stobj.cert \
-     centaur/misc/memory-mgmt-logic.cert \
-     centaur/misc/memory-mgmt-raw.cert \
-     centaur/misc/mfc-utils.cert \
-     centaur/misc/nat-list-duplicates.cert \
-     centaur/misc/numlist.cert \
-     centaur/misc/osets-witnessing.cert \
-     centaur/misc/patterns.cert \
-     centaur/misc/seed-random.cert \
-     centaur/misc/smm-impl.cert \
-     centaur/misc/smm.cert \
-     centaur/misc/sneaky-load.cert \
-     centaur/misc/suffixp.cert \
-     centaur/misc/tailrec.cert \
-     centaur/misc/top.cert \
-     centaur/misc/tshell.cert \
-     centaur/misc/tuplep.cert \
-     centaur/misc/u32-listp.cert \
-     centaur/misc/universal-equiv.cert \
-     centaur/misc/vecs-ints.cert \
-     centaur/misc/witness-cp.cert \
-     centaur/ubdds/core.cert \
-     centaur/ubdds/extra-operations.cert \
-     centaur/ubdds/lite.cert \
-     centaur/ubdds/param.cert \
-     centaur/ubdds/sanity-check-macros.cert \
-     centaur/ubdds/subset.cert \
-     centaur/ubdds/witness.cert \
-     centaur/vl/checkers/checkers.cert \
-     centaur/vl/checkers/condcheck.cert \
-     centaur/vl/checkers/dupeinst-check.cert \
-     centaur/vl/checkers/duperhs.cert \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/checkers/leftright.cert \
-     centaur/vl/checkers/multidrive-detect.cert \
-     centaur/vl/checkers/oddexpr.cert \
-     centaur/vl/checkers/portcheck.cert \
-     centaur/vl/checkers/qmarksize-check.cert \
-     centaur/vl/checkers/selfassigns.cert \
-     centaur/vl/checkers/skip-detect.cert \
-     centaur/vl/checkers/typo-detect.cert \
-     centaur/vl/checkers/use-set-report.cert \
-     centaur/vl/checkers/use-set-tool.cert \
-     centaur/vl/checkers/use-set.cert \
-     centaur/vl/lint/bit-use-set.cert \
-     centaur/vl/lint/check-case.cert \
-     centaur/vl/lint/check-namespace.cert \
-     centaur/vl/lint/disconnected.cert \
-     centaur/vl/lint/lint.cert \
-     centaur/vl/lint/use-set-ignore.cert \
-     centaur/vl/lint/xf-drop-missing-submodules.cert \
-     centaur/vl/lint/xf-drop-unresolved-submodules.cert \
-     centaur/vl/lint/xf-lint-stmt-rewrite.cert \
-     centaur/vl/lint/xf-remove-toohard.cert \
-     centaur/vl/lint/xf-suppress-warnings.cert \
-     centaur/vl/lint/xf-undefined-names.cert \
-     centaur/vl/loader/defines.cert \
-     centaur/vl/loader/filemap.cert \
-     centaur/vl/loader/find-file.cert \
-     centaur/vl/loader/inject-comments.cert \
-     centaur/vl/loader/lexer-tests.cert \
-     centaur/vl/loader/lexer-tokens.cert \
-     centaur/vl/loader/lexer-utils.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/loader/loader.cert \
-     centaur/vl/loader/make-implicit-wires.cert \
-     centaur/vl/loader/overrides.cert \
-     centaur/vl/loader/parse-blockitems.cert \
-     centaur/vl/loader/parse-delays.cert \
-     centaur/vl/loader/parse-error.cert \
-     centaur/vl/loader/parse-eventctrl.cert \
-     centaur/vl/loader/parse-expressions-def.cert \
-     centaur/vl/loader/parse-expressions-eof.cert \
-     centaur/vl/loader/parse-expressions-error.cert \
-     centaur/vl/loader/parse-expressions-progress.cert \
-     centaur/vl/loader/parse-expressions-result.cert \
-     centaur/vl/loader/parse-expressions-tokenlist.cert \
-     centaur/vl/loader/parse-expressions-warnings.cert \
-     centaur/vl/loader/parse-expressions.cert \
-     centaur/vl/loader/parse-functions.cert \
-     centaur/vl/loader/parse-gates.cert \
-     centaur/vl/loader/parse-insts.cert \
-     centaur/vl/loader/parse-lvalues.cert \
-     centaur/vl/loader/parse-modules.cert \
-     centaur/vl/loader/parse-nets.cert \
-     centaur/vl/loader/parse-ports.cert \
-     centaur/vl/loader/parse-ranges.cert \
-     centaur/vl/loader/parse-statements-def.cert \
-     centaur/vl/loader/parse-statements-error.cert \
-     centaur/vl/loader/parse-statements-progress.cert \
-     centaur/vl/loader/parse-statements-result.cert \
-     centaur/vl/loader/parse-statements-tokenlist.cert \
-     centaur/vl/loader/parse-statements-warninglist.cert \
-     centaur/vl/loader/parse-statements.cert \
-     centaur/vl/loader/parse-strengths.cert \
-     centaur/vl/loader/parse-utils.cert \
-     centaur/vl/loader/parser.cert \
-     centaur/vl/loader/preprocessor-tests.cert \
-     centaur/vl/loader/preprocessor.cert \
-     centaur/vl/loader/read-file.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/atts.cert \
-     centaur/vl/mlib/clean-concats.cert \
-     centaur/vl/mlib/comment-writer.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/ctxexprs.cert \
-     centaur/vl/mlib/delta.cert \
-     centaur/vl/mlib/expr-building.cert \
-     centaur/vl/mlib/expr-parse.cert \
-     centaur/vl/mlib/expr-slice.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/filter.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/mlib/fmt.cert \
-     centaur/vl/mlib/hid-tools.cert \
-     centaur/vl/mlib/hierarchy.cert \
-     centaur/vl/mlib/lvalues-mentioning.cert \
-     centaur/vl/mlib/lvalues.cert \
-     centaur/vl/mlib/modname-sets.cert \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/mlib/namemangle.cert \
-     centaur/vl/mlib/port-tools.cert \
-     centaur/vl/mlib/print-context.cert \
-     centaur/vl/mlib/print-warnings.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/relocate.cert \
-     centaur/vl/mlib/remove-bad.cert \
-     centaur/vl/mlib/rvalues.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/mlib/sub-counts.cert \
-     centaur/vl/mlib/warnings.cert \
-     centaur/vl/mlib/welltyped.cert \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/onehot.cert \
-     centaur/vl/parsetree.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/primitives.cert \
-     centaur/vl/toe/toe-add-res-modules.cert \
-     centaur/vl/toe/toe-add-zdrivers.cert \
-     centaur/vl/toe/toe-emodwire.cert \
-     centaur/vl/toe/toe-eocc-allnames.cert \
-     centaur/vl/toe/toe-preliminary.cert \
-     centaur/vl/toe/toe-top.cert \
-     centaur/vl/toe/toe-verilogify.cert \
-     centaur/vl/toe/toe-wirealist.cert \
-     centaur/vl/top.cert \
-     centaur/vl/transforms/always/conditions.cert \
-     centaur/vl/transforms/always/elimalways.cert \
-     centaur/vl/transforms/always/eliminitial.cert \
-     centaur/vl/transforms/always/elimnegedge.cert \
-     centaur/vl/transforms/always/flopcode-debug.cert \
-     centaur/vl/transforms/always/flopcode-prog.cert \
-     centaur/vl/transforms/always/flopcode-synth.cert \
-     centaur/vl/transforms/always/ifmerge.cert \
-     centaur/vl/transforms/always/latchcode.cert \
-     centaur/vl/transforms/always/make-flop.cert \
-     centaur/vl/transforms/always/make-latch.cert \
-     centaur/vl/transforms/always/stmtrewrite.cert \
-     centaur/vl/transforms/always/stmttemps.cert \
-     centaur/vl/transforms/always/synthalways.cert \
-     centaur/vl/transforms/always/top.cert \
-     centaur/vl/transforms/always/unelse.cert \
-     centaur/vl/transforms/always/util.cert \
-     centaur/vl/transforms/cn-hooks.cert \
-     centaur/vl/transforms/occform/add.cert \
-     centaur/vl/transforms/occform/compare.cert \
-     centaur/vl/transforms/occform/div.cert \
-     centaur/vl/transforms/occform/mul.cert \
-     centaur/vl/transforms/occform/select.cert \
-     centaur/vl/transforms/occform/shl.cert \
-     centaur/vl/transforms/occform/shr.cert \
-     centaur/vl/transforms/occform/simple.cert \
-     centaur/vl/transforms/occform/top.cert \
-     centaur/vl/transforms/occform/util.cert \
-     centaur/vl/transforms/occform/xdet.cert \
-     centaur/vl/transforms/xf-addinstnames.cert \
-     centaur/vl/transforms/xf-annotate-mods.cert \
-     centaur/vl/transforms/xf-argresolve.cert \
-     centaur/vl/transforms/xf-array-indexing.cert \
-     centaur/vl/transforms/xf-assign-trunc.cert \
-     centaur/vl/transforms/xf-blankargs.cert \
-     centaur/vl/transforms/xf-clean-params.cert \
-     centaur/vl/transforms/xf-clean-selects.cert \
-     centaur/vl/transforms/xf-delayredux.cert \
-     centaur/vl/transforms/xf-designregs.cert \
-     centaur/vl/transforms/xf-designwires.cert \
-     centaur/vl/transforms/xf-drop-blankports.cert \
-     centaur/vl/transforms/xf-elim-supply.cert \
-     centaur/vl/transforms/xf-expand-functions.cert \
-     centaur/vl/transforms/xf-expr-simp.cert \
-     centaur/vl/transforms/xf-expr-split.cert \
-     centaur/vl/transforms/xf-follow-hids.cert \
-     centaur/vl/transforms/xf-gate-elim.cert \
-     centaur/vl/transforms/xf-gateredux.cert \
-     centaur/vl/transforms/xf-gatesplit.cert \
-     centaur/vl/transforms/xf-hid-elim.cert \
-     centaur/vl/transforms/xf-inline.cert \
-     centaur/vl/transforms/xf-oprewrite.cert \
-     centaur/vl/transforms/xf-optimize-rw.cert \
-     centaur/vl/transforms/xf-orig.cert \
-     centaur/vl/transforms/xf-portdecl-sign.cert \
-     centaur/vl/transforms/xf-propagate.cert \
-     centaur/vl/transforms/xf-replicate-insts.cert \
-     centaur/vl/transforms/xf-resolve-ranges.cert \
-     centaur/vl/transforms/xf-sizing.cert \
-     centaur/vl/transforms/xf-subst.cert \
-     centaur/vl/transforms/xf-unparameterize.cert \
-     centaur/vl/transforms/xf-unused-reg.cert \
-     centaur/vl/transforms/xf-weirdint-elim.cert \
-     centaur/vl/translation.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/bits.cert \
-     centaur/vl/util/character-list-listp.cert \
-     centaur/vl/util/clean-alist.cert \
-     centaur/vl/util/commentmap.cert \
-     centaur/vl/util/cw-unformatted.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/defwellformed.cert \
-     centaur/vl/util/echars.cert \
-     centaur/vl/util/esim-lemmas.cert \
-     centaur/vl/util/gc.cert \
-     centaur/vl/util/intersectp-equal.cert \
-     centaur/vl/util/namedb.cert \
-     centaur/vl/util/nat-alists.cert \
-     centaur/vl/util/next-power-of-2.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/util/position.cert \
-     centaur/vl/util/prefix-hash.cert \
-     centaur/vl/util/prefixp.cert \
-     centaur/vl/util/print-htmlencode.cert \
-     centaur/vl/util/print-urlencode.cert \
-     centaur/vl/util/print.cert \
-     centaur/vl/util/string-alists.cert \
-     centaur/vl/util/subsetp-equal.cert \
-     centaur/vl/util/sum-nats.cert \
-     centaur/vl/util/toposort.cert \
-     centaur/vl/util/warnings.cert \
-     centaur/vl/wf-ranges-resolved-p.cert \
-     centaur/vl/wf-reasonable-p.cert \
-     centaur/vl/wf-widthsfixed-p.cert \
-     clause-processors/autohide.cert \
-     clause-processors/basic-examples.cert \
-     clause-processors/bv-add-common.cert \
-     clause-processors/bv-add-tests.cert \
-     clause-processors/bv-add.cert \
-     clause-processors/decomp-hint.cert \
-     clause-processors/equality.cert \
-     clause-processors/ev-find-rules.cert \
-     clause-processors/ev-theoremp.cert \
-     clause-processors/find-subterms.cert \
-     clause-processors/generalize.cert \
-     clause-processors/instantiate.cert \
-     clause-processors/join-thms.cert \
-     clause-processors/just-expand.cert \
-     clause-processors/meta-extract-simple-test.cert \
-     clause-processors/meta-extract-user.cert \
-     clause-processors/multi-env-trick.cert \
-     clause-processors/null-fail-hints.cert \
-     clause-processors/nvalues-thms.cert \
-     clause-processors/replace-defined-consts.cert \
-     clause-processors/replace-impl.cert \
-     clause-processors/stobj-preservation.cert \
-     clause-processors/sublis-var-meaning.cert \
-     clause-processors/term-patterns.cert \
-     clause-processors/unify-subst.cert \
-     clause-processors/use-by-hint.cert \
-     clause-processors/witness-cp.cert \
-     coi/adviser/adviser-pkg.cert \
-     coi/adviser/adviser.cert \
-     coi/adviser/test.cert \
-     coi/alists/alist-pkg.cert \
-     coi/alists/bindequiv.cert \
-     coi/alists/clearkey.cert \
-     coi/alists/deshadow.cert \
-     coi/alists/equiv.cert \
-     coi/alists/keyquiv.cert \
-     coi/alists/preimage.cert \
-     coi/alists/strip.cert \
-     coi/alists/subkeyquiv.cert \
-     coi/alists/top.cert \
-     coi/bags/basic.cert \
-     coi/bags/bind-free-rules.cert \
-     coi/bags/cons.cert \
-     coi/bags/eric-meta.cert \
-     coi/bags/extras.cert \
-     coi/bags/meta.cert \
-     coi/bags/neq.cert \
-     coi/bags/pick-a-point.cert \
-     coi/bags/top.cert \
-     coi/bags/two-level-meta.cert \
-     coi/bags/two-level.cert \
-     coi/defpun/ack.cert \
-     coi/defpun/defminterm.cert \
-     coi/defpun/defpun.cert \
-     coi/defpun/defxch.cert \
-     coi/defstructure/defstructure-pkg.cert \
-     coi/defstructure/defstructure.cert \
-     coi/dtrees/base.cert \
-     coi/dtrees/child.cert \
-     coi/dtrees/deps.cert \
-     coi/dtrees/equiv.cert \
-     coi/dtrees/erase.cert \
-     coi/dtrees/leafp.cert \
-     coi/dtrees/raw.cert \
-     coi/dtrees/royalp.cert \
-     coi/dtrees/set.cert \
-     coi/dtrees/top.cert \
-     coi/gacc/abstract-gacc.cert \
-     coi/gacc/addr-range.cert \
-     coi/gacc/bits.cert \
-     coi/gacc/block.cert \
-     coi/gacc/finite.cert \
-     coi/gacc/fr-path-connection.cert \
-     coi/gacc/gacc-exports.cert \
-     coi/gacc/gacc-pkg.cert \
-     coi/gacc/gacc.cert \
-     coi/gacc/gacc2.cert \
-     coi/gacc/gacc3.cert \
-     coi/gacc/gax.cert \
-     coi/gacc/list-ops-common.cert \
-     coi/gacc/list-ops-fast.cert \
-     coi/gacc/list-ops.cert \
-     coi/gacc/mem-fast.cert \
-     coi/gacc/mem.cert \
-     coi/gacc/ram.cert \
-     coi/gacc/ram0.cert \
-     coi/gacc/ram2.cert \
-     coi/gacc/ram2b.cert \
-     coi/gacc/ram3.cert \
-     coi/gacc/top.cert \
-     coi/gacc/tr-path-connection.cert \
-     coi/gacc/wrap.cert \
-     coi/generalize/generalize.cert \
-     coi/gensym/gensym-list.cert \
-     coi/gensym/gensym.cert \
-     coi/lists/acl2-count.cert \
-     coi/lists/basic.cert \
-     coi/lists/disjoint.cert \
-     coi/lists/find-index.cert \
-     coi/lists/list-top.cert \
-     coi/lists/listset-induction.cert \
-     coi/lists/map-cons.cert \
-     coi/lists/memberp.cert \
-     coi/lists/mixed.cert \
-     coi/lists/mv-nth.cert \
-     coi/lists/nth-and-update-nth.cert \
-     coi/lists/nth-meta.cert \
-     coi/lists/nth-meta2.cert \
-     coi/lists/remove-induction.cert \
-     coi/lists/remove.cert \
-     coi/lists/repeat.cert \
-     coi/lists/set.cert \
-     coi/lists/subsetp.cert \
-     coi/lists/update-nth-array.cert \
-     coi/maps/aliases.cert \
-     coi/maps/maps.cert \
-     coi/maps/typed-maps.cert \
-     coi/nary/example.cert \
-     coi/nary/nary.cert \
-     coi/nary/nth-rules.cert \
-     coi/nary/ordinal-order.cert \
-     coi/nary/rewrite-equal-hint.cert \
-     coi/osets/computed-hints.cert \
-     coi/osets/conversions.cert \
-     coi/osets/extras.cert \
-     coi/osets/fast.cert \
-     coi/osets/instance.cert \
-     coi/osets/listsets.cert \
-     coi/osets/map.cert \
-     coi/osets/membership.cert \
-     coi/osets/multiappend.cert \
-     coi/osets/multicons.cert \
-     coi/osets/outer.cert \
-     coi/osets/primitives.cert \
-     coi/osets/quantify.cert \
-     coi/osets/set-order.cert \
-     coi/osets/set-processor.cert \
-     coi/osets/sets.cert \
-     coi/osets/sort.cert \
-     coi/paths/compatibility.cert \
-     coi/paths/cp-set.cert \
-     coi/paths/defs.cert \
-     coi/paths/diverge.cert \
-     coi/paths/dominates.cert \
-     coi/paths/equiv.cert \
-     coi/paths/hints.cert \
-     coi/paths/list-path-connection.cert \
-     coi/paths/meta.cert \
-     coi/paths/path.cert \
-     coi/paths/pm.cert \
-     coi/quantification/quantification.cert \
-     coi/records/defarray.cert \
-     coi/records/defrecord-fast.cert \
-     coi/records/defrecord.cert \
-     coi/records/domain.cert \
-     coi/records/fixedpoint.cert \
-     coi/records/mem-domain.cert \
-     coi/records/memory.cert \
-     coi/records/record-exports.cert \
-     coi/records/records.cert \
-     coi/records/set-domain.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/ash.cert \
-     coi/super-ihs/basics.cert \
-     coi/super-ihs/bit-functions.cert \
-     coi/super-ihs/bit-twiddling-logops.cert \
-     coi/super-ihs/byte-p.cert \
-     coi/super-ihs/c-functions.cert \
-     coi/super-ihs/carry.cert \
-     coi/super-ihs/eric.cert \
-     coi/super-ihs/evenp.cert \
-     coi/super-ihs/fast.cert \
-     coi/super-ihs/from-rtl.cert \
-     coi/super-ihs/hacks.cert \
-     coi/super-ihs/inductions.cert \
-     coi/super-ihs/iter-sqrt.cert \
-     coi/super-ihs/logapp.cert \
-     coi/super-ihs/logbit.cert \
-     coi/super-ihs/logbitp.cert \
-     coi/super-ihs/logcar.cert \
-     coi/super-ihs/logcdr.cert \
-     coi/super-ihs/logcons.cert \
-     coi/super-ihs/logext.cert \
-     coi/super-ihs/loghead.cert \
-     coi/super-ihs/logical-logops.cert \
-     coi/super-ihs/logior-logapp-crock.cert \
-     coi/super-ihs/loglist.cert \
-     coi/super-ihs/logpair.cert \
-     coi/super-ihs/logtail.cert \
-     coi/super-ihs/lshu.cert \
-     coi/super-ihs/meta.cert \
-     coi/super-ihs/min-max.cert \
-     coi/super-ihs/plus-logapp-suck.cert \
-     coi/super-ihs/signed-byte-p-overflow.cert \
-     coi/super-ihs/super-ihs.cert \
-     coi/super-ihs/unsigned-byte-p.cert \
-     coi/symbol-fns/symbol-fns-exports.cert \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/syntax/auxilary.cert \
-     coi/syntax/defbinding.cert \
-     coi/syntax/defevaluator.cert \
-     coi/syntax/quine.cert \
-     coi/syntax/syn-pkg.cert \
-     coi/syntax/syntax-extensions.cert \
-     coi/syntax/syntax.cert \
-     coi/termination/assuming/compiler-proof.cert \
-     coi/termination/assuming/compiler.cert \
-     coi/termination/assuming/zero.cert \
-     coi/util/clause-processor.cert \
-     coi/util/debug.cert \
-     coi/util/defbinding.cert \
-     coi/util/defdoc.cert \
-     coi/util/deffix.cert \
-     coi/util/defsubtype.cert \
-     coi/util/defun-support.cert \
-     coi/util/defun.cert \
-     coi/util/extra-info-test.cert \
-     coi/util/extra-info.cert \
-     coi/util/fixequiv.cert \
-     coi/util/good-rewrite-order.cert \
-     coi/util/ifdef.cert \
-     coi/util/iff.cert \
-     coi/util/ifixequiv.cert \
-     coi/util/implies.cert \
-     coi/util/in-conclusion.cert \
-     coi/util/ith.cert \
-     coi/util/mv-nth.cert \
-     coi/util/nfixequiv.cert \
-     coi/util/ordinal-order.cert \
-     coi/util/pseudo-translate.cert \
-     coi/util/recursion-support.cert \
-     coi/util/rewrite-equiv.cert \
-     coi/util/rule-sets-documentation.cert \
-     coi/util/rule-sets-support.cert \
-     coi/util/rule-sets.cert \
-     coi/util/skip-rewrite.cert \
-     coi/util/syntaxp.cert \
-     coi/util/table.cert \
-     concurrent-programs/bakery/apply-total-order.cert \
-     concurrent-programs/bakery/fairenv.cert \
-     concurrent-programs/bakery/final-theorems.cert \
-     concurrent-programs/bakery/initial-state.cert \
-     concurrent-programs/bakery/inv-persists.cert \
-     concurrent-programs/bakery/inv-sufficient.cert \
-     concurrent-programs/bakery/labels.cert \
-     concurrent-programs/bakery/lexicographic-pos.cert \
-     concurrent-programs/bakery/lexicographic.cert \
-     concurrent-programs/bakery/measures.cert \
-     concurrent-programs/bakery/pos-temp.cert \
-     concurrent-programs/bakery/programs.cert \
-     concurrent-programs/bakery/properties-of-sets.cert \
-     concurrent-programs/bakery/properties.cert \
-     concurrent-programs/bakery/records.cert \
-     concurrent-programs/bakery/stutter1-match.cert \
-     concurrent-programs/bakery/stutter2.cert \
-     concurrent-programs/bakery/variables.cert \
-     concurrent-programs/german-protocol/german.cert \
-     countereg-gen/acl2s-parameter.cert \
-     countereg-gen/base.cert \
-     countereg-gen/basis.cert \
-     countereg-gen/data.cert \
-     countereg-gen/graph.cert \
-     countereg-gen/library-support.cert \
-     countereg-gen/main.cert \
-     countereg-gen/mv-proof.cert \
-     countereg-gen/num-list-fns.cert \
-     countereg-gen/num-list-thms.cert \
-     countereg-gen/random-state-basis1.cert \
-     countereg-gen/random-state.cert \
-     countereg-gen/random.cert \
-     countereg-gen/rem-and-floor.cert \
-     countereg-gen/simple-graph-array.cert \
-     countereg-gen/splitnat.cert \
-     countereg-gen/switchnat.cert \
-     countereg-gen/top.cert \
-     countereg-gen/type.cert \
-     countereg-gen/utilities.cert \
-     countereg-gen/with-timeout.cert \
-     cowles/acl2-agp.cert \
-     cowles/acl2-asg.cert \
-     cowles/acl2-crg.cert \
-     cutil/da-base.cert \
-     cutil/defaggregate-tests.cert \
-     cutil/defaggregate.cert \
-     cutil/defalist-tests.cert \
-     cutil/defalist.cert \
-     cutil/defenum.cert \
-     cutil/define-tests.cert \
-     cutil/define.cert \
-     cutil/deflist-aux.cert \
-     cutil/deflist-tests.cert \
-     cutil/deflist.cert \
-     cutil/defmapappend-tests.cert \
-     cutil/defmapappend.cert \
-     cutil/defmvtypes.cert \
-     cutil/defprojection-tests.cert \
-     cutil/defprojection.cert \
-     cutil/defsection.cert \
-     cutil/formals.cert \
-     cutil/look-up.cert \
-     cutil/maybe-defthm.cert \
-     cutil/portcullis.cert \
-     cutil/returnspecs.cert \
-     cutil/support.cert \
-     cutil/top.cert \
-     cutil/wizard.cert \
-     data-structures/alist-defthms.cert \
-     data-structures/alist-defuns.cert \
-     data-structures/alist-theory.cert \
-     data-structures/array1.cert \
-     data-structures/defalist.cert \
-     data-structures/deflist.cert \
-     data-structures/doc-section.cert \
-     data-structures/list-defthms.cert \
-     data-structures/list-defuns.cert \
-     data-structures/list-theory.cert \
-     data-structures/memories/log2.cert \
-     data-structures/memories/memory-impl.cert \
-     data-structures/memories/memory.cert \
-     data-structures/memories/memtree.cert \
-     data-structures/memories/private.cert \
-     data-structures/no-duplicates.cert \
-     data-structures/number-list-defthms.cert \
-     data-structures/number-list-defuns.cert \
-     data-structures/number-list-theory.cert \
-     data-structures/set-defthms.cert \
-     data-structures/set-defuns.cert \
-     data-structures/set-theory.cert \
-     data-structures/structures.cert \
-     data-structures/utilities.cert \
-     deduction/passmore/bewijs.cert \
-     deduction/passmore/general.cert \
-     deduction/passmore/paramod.cert \
-     deduction/passmore/prover.cert \
-     deduction/passmore/resolution.cert \
-     deduction/passmore/unification.cert \
-     deduction/passmore/weighting.cert \
-     defexec/dag-unification/basic.cert \
-     defexec/dag-unification/dag-unification-l.cert \
-     defexec/dag-unification/dag-unification-rules.cert \
-     defexec/dag-unification/dag-unification-st.cert \
-     defexec/dag-unification/dags.cert \
-     defexec/dag-unification/list-unification-rules.cert \
-     defexec/dag-unification/matching.cert \
-     defexec/dag-unification/subsumption-subst.cert \
-     defexec/dag-unification/subsumption.cert \
-     defexec/dag-unification/terms-as-dag.cert \
-     defexec/dag-unification/terms-dag-stobj.cert \
-     defexec/dag-unification/terms.cert \
-     defexec/defpun-exec/defpun-exec.cert \
-     defexec/find-path/fpst.cert \
-     defexec/find-path/graph/find-path1.cert \
-     defexec/find-path/graph/find-path2.cert \
-     defexec/find-path/graph/find-path3.cert \
-     defexec/find-path/graph/helpers.cert \
-     defexec/find-path/graph/linear-find-path.cert \
-     defexec/find-path/run-fpst.cert \
-     defexec/ordinals/supporting-ordinals.cert \
-     defexec/other-apps/misc/memos.cert \
-     defexec/other-apps/misc/stobjsim.cert \
-     defexec/other-apps/qsort/extraction.cert \
-     defexec/other-apps/qsort/final-theorem.cert \
-     defexec/other-apps/qsort/first-last.cert \
-     defexec/other-apps/qsort/intermediate-program.cert \
-     defexec/other-apps/qsort/intermediate-to-spec.cert \
-     defexec/other-apps/qsort/load-extract.cert \
-     defexec/other-apps/qsort/merge-intermediate.cert \
-     defexec/other-apps/qsort/nth-update-nth.cert \
-     defexec/other-apps/qsort/permutations.cert \
-     defexec/other-apps/qsort/programs.cert \
-     defexec/other-apps/qsort/sort-qs-properties.cert \
-     defexec/other-apps/qsort/spec-properties.cert \
-     defexec/other-apps/qsort/split-qs-properties.cert \
-     defexec/other-apps/qsort/total-order.cert \
-     defexec/other-apps/records/inline.cert \
-     defexec/other-apps/records/records-bsd.cert \
-     defexec/other-apps/records/records.cert \
-     defexec/other-apps/records/recordsim.cert \
-     defexec/reflexive/reflexive.cert \
-     defsort/defsort.cert \
-     defsort/duplicated-members.cert \
-     defsort/duplicity.cert \
-     defsort/examples.cert \
-     defsort/generic-impl.cert \
-     defsort/generic.cert \
-     defsort/remove-dups.cert \
-     defsort/uniquep.cert \
-     demos/list-theory.cert \
-     demos/modeling/memories.cert \
-     demos/modeling/network-state-basic.cert \
-     demos/modeling/network-state.cert \
-     demos/modeling/nondeterminism.cert \
-     finite-set-theory/osets/cardinality.cert \
-     finite-set-theory/osets/computed-hints.cert \
-     finite-set-theory/osets/delete.cert \
-     finite-set-theory/osets/difference.cert \
-     finite-set-theory/osets/instance.cert \
-     finite-set-theory/osets/intersect.cert \
-     finite-set-theory/osets/map-tests.cert \
-     finite-set-theory/osets/map.cert \
-     finite-set-theory/osets/membership.cert \
-     finite-set-theory/osets/outer.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/primitives.cert \
-     finite-set-theory/osets/quantify.cert \
-     finite-set-theory/osets/sets.cert \
-     finite-set-theory/osets/sort.cert \
-     finite-set-theory/osets/under-set-equiv.cert \
-     finite-set-theory/osets/union.cert \
-     finite-set-theory/set-theory.cert \
-     finite-set-theory/total-ordering.cert \
-     hacking/all.cert \
-     hacking/bridge.cert \
-     hacking/defcode.cert \
-     hacking/defstruct-parsing.cert \
-     hacking/doc-section.cert \
-     hacking/dynamic-make-event-test.cert \
-     hacking/dynamic-make-event.cert \
-     hacking/evalable-ld-printing.cert \
-     hacking/hacker.cert \
-     hacking/progn-bang-enh.cert \
-     hacking/raw.cert \
-     hacking/redefun.cert \
-     hacking/rewrite-code.cert \
-     hacking/subsumption.cert \
-     hacking/table-guard.cert \
-     hints/basic-tests.cert \
-     hints/consider-hint-tests.cert \
-     hints/consider-hint.cert \
-     hints/huet-lang-algorithm-tests.cert \
-     hints/huet-lang-algorithm.cert \
-     hints/merge-hint.cert \
-     ihs/@logops.cert \
-     ihs/basic-definitions.cert \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-doc-topic.cert \
-     ihs/ihs-init.cert \
-     ihs/ihs-lemmas.cert \
-     ihs/ihs-theories.cert \
-     ihs/logops-definitions.cert \
-     ihs/logops-lemmas.cert \
-     ihs/math-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     leftist-trees/leftist-tree-defthms.cert \
-     leftist-trees/leftist-tree-defuns.cert \
-     leftist-trees/leftist-tree-sort-equivalent.cert \
-     leftist-trees/leftist-tree-sort-equivalent2.cert \
-     leftist-trees/leftist-tree-sort-equivalent3.cert \
-     leftist-trees/leftist-tree-sort.cert \
-     leftist-trees/top.cert \
-     make-event/acl2x-help.cert \
-     make-event/assert-check-include-1.cert \
-     make-event/assert-check-include.cert \
-     make-event/assert-check.cert \
-     make-event/assert-include.cert \
-     make-event/assert.cert \
-     make-event/basic-check.cert \
-     make-event/basic-pkg-check.cert \
-     make-event/basic-pkg.cert \
-     make-event/basic.cert \
-     make-event/defconst-fast-examples.cert \
-     make-event/defconst-fast.cert \
-     make-event/defrefine.cert \
-     make-event/defrule.cert \
-     make-event/defspec.cert \
-     make-event/dotimes.cert \
-     make-event/embeddable-event-forms.cert \
-     make-event/eval-check-tests.cert \
-     make-event/eval-check.cert \
-     make-event/eval-tests.cert \
-     make-event/eval.cert \
-     make-event/gen-defthm-check.cert \
-     make-event/gen-defthm.cert \
-     make-event/gen-defun-check.cert \
-     make-event/gen-defun.cert \
-     make-event/inline-book.cert \
-     make-event/local-elided-include.cert \
-     make-event/local-elided.cert \
-     make-event/local-requires-skip-check-include.cert \
-     make-event/local-requires-skip-check.cert \
-     make-event/logical-tangent.cert \
-     make-event/macros-include.cert \
-     make-event/macros-skip-proofs-include.cert \
-     make-event/macros-skip-proofs.cert \
-     make-event/macros.cert \
-     make-event/make-redundant.cert \
-     make-event/nested-check.cert \
-     make-event/nested.cert \
-     make-event/portcullis-expansion-include.cert \
-     make-event/portcullis-expansion.cert \
-     make-event/proof-by-arith.cert \
-     make-event/read-from-file.cert \
-     make-event/require-book.cert \
-     make-event/test-case-check.cert \
-     make-event/test-case.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     meta/meta-times-equal.cert \
-     meta/meta.cert \
-     meta/pseudo-termp-lemmas.cert \
-     meta/term-defuns.cert \
-     meta/term-lemmas.cert \
-     misc/assert.cert \
-     misc/bash.cert \
-     misc/beta-reduce.cert \
-     misc/callers-and-ancestors.cert \
-     misc/character-encoding-test.cert \
-     misc/check-acl2-exports.cert \
-     misc/check-state.cert \
-     misc/computed-hint-rewrite.cert \
-     misc/computed-hint.cert \
-     misc/congruent-stobjs-test.cert \
-     misc/csort.cert \
-     misc/dead-events.cert \
-     misc/defabsstobj-example-1.cert \
-     misc/defabsstobj-example-2.cert \
-     misc/defabsstobj-example-3.cert \
-     misc/defabsstobj-example-4.cert \
-     misc/defattach-bang.cert \
-     misc/defattach-example.cert \
-     misc/definline.cert \
-     misc/defmac.cert \
-     misc/defopener.cert \
-     misc/defp.cert \
-     misc/defproxy-test.cert \
-     misc/defpun.cert \
-     misc/defun-plus.cert \
-     misc/dft-ex.cert \
-     misc/dft.cert \
-     misc/dijkstra-shortest-path.cert \
-     misc/disassemble.cert \
-     misc/doc-section.cert \
-     misc/dump-events.cert \
-     misc/equal-by-g-help.cert \
-     misc/equal-by-g.cert \
-     misc/eval.cert \
-     misc/evalable-printing.cert \
-     misc/expander.cert \
-     misc/fast-coerce.cert \
-     misc/fibonacci.cert \
-     misc/file-io.cert \
-     misc/find-lemmas.cert \
-     misc/gentle.cert \
-     misc/getprop.cert \
-     misc/goodstein.cert \
-     misc/grcd.cert \
-     misc/hanoi.cert \
-     misc/hons-help.cert \
-     misc/hons-help2.cert \
-     misc/hons-tests.cert \
-     misc/how-to-prove-thms.cert \
-     misc/int-division.cert \
-     misc/integer-type-set-test.cert \
-     misc/invariants.cert \
-     misc/meta-lemmas.cert \
-     misc/misc2/defpun-exec-domain-example.cert \
-     misc/misc2/misc.cert \
-     misc/misc2/reverse-by-separation.cert \
-     misc/misc2/ruler-extenders-tests.cert \
-     misc/misc2/step-limits.cert \
-     misc/mult.cert \
-     misc/oprof.cert \
-     misc/priorities.cert \
-     misc/problem13.cert \
-     misc/process-book-readme.cert \
-     misc/profiling.cert \
-     misc/qi-correct.cert \
-     misc/qi.cert \
-     misc/radix.cert \
-     misc/random.cert \
-     misc/records-bsd.cert \
-     misc/records.cert \
-     misc/records0.cert \
-     misc/redef-pkg.cert \
-     misc/rtl-untranslate.cert \
-     misc/save-time.cert \
-     misc/seq.cert \
-     misc/seqw.cert \
-     misc/simplify-defuns.cert \
-     misc/simplify-thm.cert \
-     misc/sin-cos.cert \
-     misc/sort-symbols.cert \
-     misc/sticky-disable.cert \
-     misc/symbol-btree.cert \
-     misc/total-order-bsd.cert \
-     misc/total-order.cert \
-     misc/trace-star.cert \
-     misc/transfinite.cert \
-     misc/untranslate-patterns.cert \
-     misc/wet.cert \
-     models/jvm/m1-original/m1-story.cert \
-     models/jvm/m1-original/problem-set-1-answers.cert \
-     models/jvm/m1/alternating-sum-variant.cert \
-     models/jvm/m1/alternating-sum.cert \
-     models/jvm/m1/bexpt.cert \
-     models/jvm/m1/defsys-utilities.cert \
-     models/jvm/m1/defsys.cert \
-     models/jvm/m1/div.cert \
-     models/jvm/m1/even-solution-1.cert \
-     models/jvm/m1/even-solution-2.cert \
-     models/jvm/m1/expt.cert \
-     models/jvm/m1/fact.cert \
-     models/jvm/m1/fib.cert \
-     models/jvm/m1/find-k!.cert \
-     models/jvm/m1/funny-fact.cert \
-     models/jvm/m1/implementation.cert \
-     models/jvm/m1/lessp.cert \
-     models/jvm/m1/low-seven.cert \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/magic.cert \
-     models/jvm/m1/power.cert \
-     models/jvm/m1/sign.cert \
-     models/jvm/m1/sum.cert \
-     models/jvm/m1/sumsq.cert \
-     models/jvm/m1/template.cert \
-     models/jvm/m1/theorems-a-and-b.cert \
-     models/jvm/m1/tmi-reductions.cert \
-     models/jvm/m1/wormhole-abstraction.cert \
-     models/jvm/m5/apprentice-state.cert \
-     models/jvm/m5/demo.cert \
-     models/jvm/m5/idemo.cert \
-     models/jvm/m5/infinite-fair-schedule.cert \
-     models/jvm/m5/isort.cert \
-     models/jvm/m5/jvm-fact-setup.cert \
-     models/jvm/m5/m5.cert \
-     models/jvm/m5/partial.cert \
-     models/jvm/m5/perm.cert \
-     models/jvm/m5/universal-never-returns.cert \
-     models/jvm/m5/universal.cert \
-     models/jvm/m5/utilities.cert \
-     ordinals/e0-ordinal.cert \
-     ordinals/lexicographic-book.cert \
-     ordinals/lexicographic-ordering-without-arithmetic.cert \
-     ordinals/lexicographic-ordering.cert \
-     ordinals/limits.cert \
-     ordinals/ordinal-addition.cert \
-     ordinals/ordinal-basic-thms.cert \
-     ordinals/ordinal-counter-examples.cert \
-     ordinals/ordinal-definitions.cert \
-     ordinals/ordinal-exponentiation.cert \
-     ordinals/ordinal-isomorphism.cert \
-     ordinals/ordinal-multiplication.cert \
-     ordinals/ordinal-total-order.cert \
-     ordinals/ordinals-without-arithmetic.cert \
-     ordinals/ordinals.cert \
-     ordinals/proof-of-well-foundedness.cert \
-     ordinals/top-with-meta.cert \
-     oslib/catpath.cert \
-     oslib/date.cert \
-     oslib/getpid.cert \
-     oslib/ls.cert \
-     oslib/portcullis.cert \
-     oslib/read-acl2-oracle.cert \
-     oslib/tempfile.cert \
-     oslib/top.cert \
-     paco/database.cert \
-     paco/elim-dest.cert \
-     paco/foundations.cert \
-     paco/induct.cert \
-     paco/output-module.cert \
-     paco/paco.cert \
-     paco/prove.cert \
-     paco/rewrite.cert \
-     paco/simplify.cert \
-     paco/type-set.cert \
-     paco/utilities.cert \
-     parallel/fibonacci.cert \
-     parallel/hint-tests.cert \
-     parallel/matrix-multiplication-parallel.cert \
-     parallel/matrix-multiplication-serial.cert \
-     parallel/matrix-multiplication-setup.cert \
-     parallel/spec-mv-let.cert \
-     parallel/stress-tests.cert \
-     parallel/syntax-tests.cert \
-     parallel/with-waterfall-parallelism.cert \
-     parallel/without-waterfall-parallelism.cert \
-     powerlists/algebra.cert \
-     powerlists/batcher-sort.cert \
-     powerlists/bitonic-sort.cert \
-     powerlists/cla-adder.cert \
-     powerlists/gray-code.cert \
-     powerlists/merge-sort.cert \
-     powerlists/prefix-sum.cert \
-     powerlists/simple.cert \
-     powerlists/sort.cert \
-     proofstyles/completeness/assertions-partial.cert \
-     proofstyles/completeness/assertions-total.cert \
-     proofstyles/completeness/clock-partial.cert \
-     proofstyles/completeness/clock-total.cert \
-     proofstyles/completeness/generic-partial.cert \
-     proofstyles/completeness/generic-total.cert \
-     proofstyles/completeness/stepwise-invariants-partial.cert \
-     proofstyles/completeness/stepwise-invariants-total.cert \
-     proofstyles/counterexamples/halt-flg.cert \
-     proofstyles/counterexamples/memory-clearing.cert \
-     proofstyles/counterexamples/realistic.cert \
-     proofstyles/invclock/c2i/c2i-partial.cert \
-     proofstyles/invclock/c2i/c2i-total.cert \
-     proofstyles/invclock/c2i/clock-to-inv.cert \
-     proofstyles/invclock/compose/compose-c-c-partial.cert \
-     proofstyles/invclock/compose/compose-c-c-total.cert \
-     proofstyles/invclock/i2c/i2c-partial.cert \
-     proofstyles/invclock/i2c/i2c-total.cert \
-     proofstyles/invclock/i2c/inv-to-clock.cert \
-     proofstyles/soundness/assertions-partial.cert \
-     proofstyles/soundness/assertions-total.cert \
-     proofstyles/soundness/clock-partial.cert \
-     proofstyles/soundness/clock-total.cert \
-     proofstyles/soundness/stepwise-invariants-partial.cert \
-     proofstyles/soundness/stepwise-invariants-total.cert \
-     quadratic-reciprocity/eisenstein.cert \
-     quadratic-reciprocity/euclid.cert \
-     quadratic-reciprocity/euler.cert \
-     quadratic-reciprocity/fermat.cert \
-     quadratic-reciprocity/gauss.cert \
-     quadratic-reciprocity/mersenne.cert \
-     regex/defset-encapsulates.cert \
-     regex/defset-macros.cert \
-     regex/equal-based-set.cert \
-     regex/grep-command-line.cert \
-     regex/input-list.cert \
-     regex/portcullis.cert \
-     regex/regex-chartrans.cert \
-     regex/regex-defs.cert \
-     regex/regex-exec.cert \
-     regex/regex-fileio.cert \
-     regex/regex-parse-brace.cert \
-     regex/regex-parse-bracket.cert \
-     regex/regex-parse.cert \
-     regex/regex-tests.cert \
-     regex/regex-ui.cert \
-     rtl/rel1/lib1/basic.cert \
-     rtl/rel1/lib1/bits.cert \
-     rtl/rel1/lib1/brat.cert \
-     rtl/rel1/lib1/float.cert \
-     rtl/rel1/lib1/reps.cert \
-     rtl/rel1/lib1/round.cert \
-     rtl/rel1/lib1/top.cert \
-     rtl/rel1/lib3/basic.cert \
-     rtl/rel1/lib3/bits.cert \
-     rtl/rel1/lib3/brat.cert \
-     rtl/rel1/lib3/fadd.cert \
-     rtl/rel1/lib3/float.cert \
-     rtl/rel1/lib3/reps.cert \
-     rtl/rel1/lib3/round.cert \
-     rtl/rel1/lib3/top.cert \
-     rtl/rel1/support/add.cert \
-     rtl/rel1/support/away.cert \
-     rtl/rel1/support/basic.cert \
-     rtl/rel1/support/divsqrt.cert \
-     rtl/rel1/support/fadd/add3.cert \
-     rtl/rel1/support/fadd/lop1.cert \
-     rtl/rel1/support/fadd/lop2.cert \
-     rtl/rel1/support/fadd/lop3.cert \
-     rtl/rel1/support/fadd/stick.cert \
-     rtl/rel1/support/fadd/top.cert \
-     rtl/rel1/support/float.cert \
-     rtl/rel1/support/floor.cert \
-     rtl/rel1/support/fp.cert \
-     rtl/rel1/support/logdefs.cert \
-     rtl/rel1/support/loglemmas.cert \
-     rtl/rel1/support/logxor-def.cert \
-     rtl/rel1/support/logxor-lemmas.cert \
-     rtl/rel1/support/merge.cert \
-     rtl/rel1/support/near.cert \
-     rtl/rel1/support/odd.cert \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/support/reps.cert \
-     rtl/rel1/support/rewrite-theory.cert \
-     rtl/rel1/support/rnd.cert \
-     rtl/rel1/support/sticky.cert \
-     rtl/rel1/support/trunc.cert \
-     rtl/rel1/support/x-2xx.cert \
-     rtl/rel4/arithmetic/arith.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/basic.cert \
-     rtl/rel4/arithmetic/cg.cert \
-     rtl/rel4/arithmetic/common-factor-defuns.cert \
-     rtl/rel4/arithmetic/common-factor.cert \
-     rtl/rel4/arithmetic/complex-rationalp.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/even-odd.cert \
-     rtl/rel4/arithmetic/even-odd2-proofs.cert \
-     rtl/rel4/arithmetic/even-odd2.cert \
-     rtl/rel4/arithmetic/expo-proofs.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/arithmetic/expt-proofs.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/extra-rules.cert \
-     rtl/rel4/arithmetic/fl-expt.cert \
-     rtl/rel4/arithmetic/fl-hacks.cert \
-     rtl/rel4/arithmetic/fl-proofs.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/floor-proofs.cert \
-     rtl/rel4/arithmetic/floor.cert \
-     rtl/rel4/arithmetic/fp.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/hacks.cert \
-     rtl/rel4/arithmetic/induct.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/inverted-factor.cert \
-     rtl/rel4/arithmetic/mod-expt.cert \
-     rtl/rel4/arithmetic/mod-proofs.cert \
-     rtl/rel4/arithmetic/mod.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/nniq.cert \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/product-proofs.cert \
-     rtl/rel4/arithmetic/product.cert \
-     rtl/rel4/arithmetic/rationalp.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/x-2xx.cert \
-     rtl/rel4/lib/arith.cert \
-     rtl/rel4/lib/basic.cert \
-     rtl/rel4/lib/bits.cert \
-     rtl/rel4/lib/bvecp-helpers.cert \
-     rtl/rel4/lib/bvecp-raw-helpers.cert \
-     rtl/rel4/lib/clocks.cert \
-     rtl/rel4/lib/fadd.cert \
-     rtl/rel4/lib/float.cert \
-     rtl/rel4/lib/openers.cert \
-     rtl/rel4/lib/package-defs.cert \
-     rtl/rel4/lib/reps.cert \
-     rtl/rel4/lib/rom-helpers.cert \
-     rtl/rel4/lib/round.cert \
-     rtl/rel4/lib/rtl.cert \
-     rtl/rel4/lib/rtlarr.cert \
-     rtl/rel4/lib/simple-loop-helpers.cert \
-     rtl/rel4/lib/simplify-model-helpers.cert \
-     rtl/rel4/lib/top.cert \
-     rtl/rel4/lib/util.cert \
-     rtl/rel4/support/add3-proofs.cert \
-     rtl/rel4/support/add3.cert \
-     rtl/rel4/support/all-ones.cert \
-     rtl/rel4/support/ash.cert \
-     rtl/rel4/support/away-proofs.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/badguys.cert \
-     rtl/rel4/support/bias-proofs.cert \
-     rtl/rel4/support/bias.cert \
-     rtl/rel4/support/bitn-proofs.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/bits-extra.cert \
-     rtl/rel4/support/bits-proofs.cert \
-     rtl/rel4/support/bits-trunc-proofs.cert \
-     rtl/rel4/support/bits-trunc.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bvecp-helpers.cert \
-     rtl/rel4/support/bvecp-lemmas.cert \
-     rtl/rel4/support/bvecp-proofs.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/cat-proofs.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/clocks.cert \
-     rtl/rel4/support/decode-proofs.cert \
-     rtl/rel4/support/decode.cert \
-     rtl/rel4/support/drnd.cert \
-     rtl/rel4/support/encode.cert \
-     rtl/rel4/support/ereps-proofs.cert \
-     rtl/rel4/support/ereps.cert \
-     rtl/rel4/support/fadd.cert \
-     rtl/rel4/support/fast-and.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/support/ireps.cert \
-     rtl/rel4/support/land-proofs.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lextra-proofs.cert \
-     rtl/rel4/support/lextra.cert \
-     rtl/rel4/support/lior-proofs.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lnot-proofs.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/support/log-equal.cert \
-     rtl/rel4/support/log-proofs.cert \
-     rtl/rel4/support/log.cert \
-     rtl/rel4/support/logand-proofs.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/logeqv.cert \
-     rtl/rel4/support/logior-proofs.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/logior1-proofs.cert \
-     rtl/rel4/support/logior1.cert \
-     rtl/rel4/support/lognot.cert \
-     rtl/rel4/support/logorc1.cert \
-     rtl/rel4/support/logs.cert \
-     rtl/rel4/support/logxor.cert \
-     rtl/rel4/support/lop1-proofs.cert \
-     rtl/rel4/support/lop1.cert \
-     rtl/rel4/support/lop2-proofs.cert \
-     rtl/rel4/support/lop2.cert \
-     rtl/rel4/support/lop3-proofs.cert \
-     rtl/rel4/support/lop3.cert \
-     rtl/rel4/support/lxor-proofs.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/merge2.cert \
-     rtl/rel4/support/mod4.cert \
-     rtl/rel4/support/model-helpers.cert \
-     rtl/rel4/support/mulcat-proofs.cert \
-     rtl/rel4/support/mulcat.cert \
-     rtl/rel4/support/near+-proofs.cert \
-     rtl/rel4/support/near+.cert \
-     rtl/rel4/support/near-proofs.cert \
-     rtl/rel4/support/near.cert \
-     rtl/rel4/support/ocat.cert \
-     rtl/rel4/support/oddr-proofs.cert \
-     rtl/rel4/support/oddr.cert \
-     rtl/rel4/support/openers.cert \
-     rtl/rel4/support/package-defs.cert \
-     rtl/rel4/support/rewrite-theory.cert \
-     rtl/rel4/support/rnd.cert \
-     rtl/rel4/support/rom-helpers.cert \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/rtlarr.cert \
-     rtl/rel4/support/setbitn-proofs.cert \
-     rtl/rel4/support/setbitn.cert \
-     rtl/rel4/support/setbits-proofs.cert \
-     rtl/rel4/support/setbits.cert \
-     rtl/rel4/support/sgn.cert \
-     rtl/rel4/support/shft.cert \
-     rtl/rel4/support/simple-loop-helpers.cert \
-     rtl/rel4/support/simplify-model-helpers.cert \
-     rtl/rel4/support/stick-proofs.cert \
-     rtl/rel4/support/stick.cert \
-     rtl/rel4/support/sticky-proofs.cert \
-     rtl/rel4/support/sticky.cert \
-     rtl/rel4/support/sumbits.cert \
-     rtl/rel4/support/top.cert \
-     rtl/rel4/support/top1.cert \
-     rtl/rel4/support/trunc-proofs.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/util.cert \
-     rtl/rel4/user/away.cert \
-     rtl/rel4/user/bias.cert \
-     rtl/rel4/user/bitn.cert \
-     rtl/rel4/user/bits-trunc.cert \
-     rtl/rel4/user/bits.cert \
-     rtl/rel4/user/brat.cert \
-     rtl/rel4/user/bvecp.cert \
-     rtl/rel4/user/cat.cert \
-     rtl/rel4/user/decode.cert \
-     rtl/rel4/user/ereps.cert \
-     rtl/rel4/user/land.cert \
-     rtl/rel4/user/lextra.cert \
-     rtl/rel4/user/lior.cert \
-     rtl/rel4/user/lnot.cert \
-     rtl/rel4/user/logior1.cert \
-     rtl/rel4/user/lxor.cert \
-     rtl/rel4/user/mulcat.cert \
-     rtl/rel4/user/near.cert \
-     rtl/rel4/user/setbitn.cert \
-     rtl/rel4/user/setbits.cert \
-     rtl/rel4/user/stick.cert \
-     rtl/rel4/user/sumbits.cert \
-     rtl/rel4/user/top.cert \
-     rtl/rel4/user/trunc.cert \
-     rtl/rel5/arithmetic/arith.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/basic.cert \
-     rtl/rel5/arithmetic/cg.cert \
-     rtl/rel5/arithmetic/common-factor-defuns.cert \
-     rtl/rel5/arithmetic/common-factor.cert \
-     rtl/rel5/arithmetic/complex-rationalp.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/even-odd.cert \
-     rtl/rel5/arithmetic/even-odd2-proofs.cert \
-     rtl/rel5/arithmetic/even-odd2.cert \
-     rtl/rel5/arithmetic/expo-proofs.cert \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/arithmetic/expt-proofs.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/extra-rules.cert \
-     rtl/rel5/arithmetic/fl-expt.cert \
-     rtl/rel5/arithmetic/fl-hacks.cert \
-     rtl/rel5/arithmetic/fl-proofs.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/floor-proofs.cert \
-     rtl/rel5/arithmetic/floor.cert \
-     rtl/rel5/arithmetic/fp.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/hacks.cert \
-     rtl/rel5/arithmetic/induct.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/inverted-factor.cert \
-     rtl/rel5/arithmetic/mod-expt.cert \
-     rtl/rel5/arithmetic/mod-proofs.cert \
-     rtl/rel5/arithmetic/mod.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/nniq.cert \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/product-proofs.cert \
-     rtl/rel5/arithmetic/product.cert \
-     rtl/rel5/arithmetic/rationalp.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/x-2xx.cert \
-     rtl/rel5/lib/add.cert \
-     rtl/rel5/lib/arith.cert \
-     rtl/rel5/lib/basic.cert \
-     rtl/rel5/lib/bits.cert \
-     rtl/rel5/lib/bvecp-helpers.cert \
-     rtl/rel5/lib/bvecp-raw-helpers.cert \
-     rtl/rel5/lib/clocks.cert \
-     rtl/rel5/lib/float.cert \
-     rtl/rel5/lib/log.cert \
-     rtl/rel5/lib/openers.cert \
-     rtl/rel5/lib/package-defs.cert \
-     rtl/rel5/lib/reps.cert \
-     rtl/rel5/lib/rom-helpers.cert \
-     rtl/rel5/lib/round.cert \
-     rtl/rel5/lib/rtl.cert \
-     rtl/rel5/lib/rtlarr.cert \
-     rtl/rel5/lib/simple-loop-helpers.cert \
-     rtl/rel5/lib/simplify-model-helpers.cert \
-     rtl/rel5/lib/top.cert \
-     rtl/rel5/lib/util.cert \
-     rtl/rel5/support/add3-proofs.cert \
-     rtl/rel5/support/add3.cert \
-     rtl/rel5/support/all-ones.cert \
-     rtl/rel5/support/ash.cert \
-     rtl/rel5/support/away-proofs.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/support/badguys.cert \
-     rtl/rel5/support/bias-proofs.cert \
-     rtl/rel5/support/bias.cert \
-     rtl/rel5/support/bitn-proofs.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/bits-proofs.cert \
-     rtl/rel5/support/bits-trunc-proofs.cert \
-     rtl/rel5/support/bits-trunc.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bvecp-helpers.cert \
-     rtl/rel5/support/bvecp-lemmas.cert \
-     rtl/rel5/support/bvecp-proofs.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/cat-proofs.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/clocks.cert \
-     rtl/rel5/support/decode-proofs.cert \
-     rtl/rel5/support/decode.cert \
-     rtl/rel5/support/drnd.cert \
-     rtl/rel5/support/encode.cert \
-     rtl/rel5/support/ereps-proofs.cert \
-     rtl/rel5/support/ereps.cert \
-     rtl/rel5/support/fadd-extra.cert \
-     rtl/rel5/support/fadd-extra0.cert \
-     rtl/rel5/support/fadd.cert \
-     rtl/rel5/support/fast-and.cert \
-     rtl/rel5/support/float-extra.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/support/ireps.cert \
-     rtl/rel5/support/land.cert \
-     rtl/rel5/support/land0-proofs.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lextra-proofs.cert \
-     rtl/rel5/support/lextra.cert \
-     rtl/rel5/support/lextra0.cert \
-     rtl/rel5/support/lior.cert \
-     rtl/rel5/support/lior0-proofs.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lnot-proofs.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/support/log-equal.cert \
-     rtl/rel5/support/log-proofs.cert \
-     rtl/rel5/support/log.cert \
-     rtl/rel5/support/logand-proofs.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/logeqv.cert \
-     rtl/rel5/support/logior-proofs.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/logior1-proofs.cert \
-     rtl/rel5/support/logior1.cert \
-     rtl/rel5/support/lognot.cert \
-     rtl/rel5/support/logorc1.cert \
-     rtl/rel5/support/logs.cert \
-     rtl/rel5/support/logxor.cert \
-     rtl/rel5/support/lop1-proofs.cert \
-     rtl/rel5/support/lop1.cert \
-     rtl/rel5/support/lop2-proofs.cert \
-     rtl/rel5/support/lop2.cert \
-     rtl/rel5/support/lop3-proofs.cert \
-     rtl/rel5/support/lop3.cert \
-     rtl/rel5/support/lxor.cert \
-     rtl/rel5/support/lxor0-proofs.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/merge2.cert \
-     rtl/rel5/support/mod4.cert \
-     rtl/rel5/support/model-helpers.cert \
-     rtl/rel5/support/mulcat-proofs.cert \
-     rtl/rel5/support/mulcat.cert \
-     rtl/rel5/support/near+-proofs.cert \
-     rtl/rel5/support/near+.cert \
-     rtl/rel5/support/near-proofs.cert \
-     rtl/rel5/support/near.cert \
-     rtl/rel5/support/ocat.cert \
-     rtl/rel5/support/oddr-proofs.cert \
-     rtl/rel5/support/oddr.cert \
-     rtl/rel5/support/openers.cert \
-     rtl/rel5/support/package-defs.cert \
-     rtl/rel5/support/rewrite-theory.cert \
-     rtl/rel5/support/rnd.cert \
-     rtl/rel5/support/rom-helpers.cert \
-     rtl/rel5/support/round-extra.cert \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/rtlarr.cert \
-     rtl/rel5/support/setbitn-proofs.cert \
-     rtl/rel5/support/setbitn.cert \
-     rtl/rel5/support/setbits-proofs.cert \
-     rtl/rel5/support/setbits.cert \
-     rtl/rel5/support/sgn.cert \
-     rtl/rel5/support/shft.cert \
-     rtl/rel5/support/simple-loop-helpers.cert \
-     rtl/rel5/support/simplify-model-helpers.cert \
-     rtl/rel5/support/stick-proofs.cert \
-     rtl/rel5/support/stick.cert \
-     rtl/rel5/support/sticky-proofs.cert \
-     rtl/rel5/support/sticky.cert \
-     rtl/rel5/support/sumbits.cert \
-     rtl/rel5/support/top.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/trunc-proofs.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/util.cert \
-     rtl/rel5/user/away.cert \
-     rtl/rel5/user/bias.cert \
-     rtl/rel5/user/bitn.cert \
-     rtl/rel5/user/bits-trunc.cert \
-     rtl/rel5/user/bits.cert \
-     rtl/rel5/user/brat.cert \
-     rtl/rel5/user/bvecp.cert \
-     rtl/rel5/user/cat.cert \
-     rtl/rel5/user/decode.cert \
-     rtl/rel5/user/ereps.cert \
-     rtl/rel5/user/land.cert \
-     rtl/rel5/user/lextra.cert \
-     rtl/rel5/user/lior.cert \
-     rtl/rel5/user/lnot.cert \
-     rtl/rel5/user/logior1.cert \
-     rtl/rel5/user/lxor.cert \
-     rtl/rel5/user/mulcat.cert \
-     rtl/rel5/user/near.cert \
-     rtl/rel5/user/setbitn.cert \
-     rtl/rel5/user/setbits.cert \
-     rtl/rel5/user/stick.cert \
-     rtl/rel5/user/sumbits.cert \
-     rtl/rel5/user/top.cert \
-     rtl/rel5/user/trunc.cert \
-     rtl/rel8/arithmetic/arith.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/arithmetic/cg.cert \
-     rtl/rel8/arithmetic/common-factor-defuns.cert \
-     rtl/rel8/arithmetic/common-factor.cert \
-     rtl/rel8/arithmetic/complex-rationalp.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/even-odd.cert \
-     rtl/rel8/arithmetic/even-odd2-proofs.cert \
-     rtl/rel8/arithmetic/even-odd2.cert \
-     rtl/rel8/arithmetic/expo-proofs.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/arithmetic/expt-proofs.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/extra-rules.cert \
-     rtl/rel8/arithmetic/fl-expt.cert \
-     rtl/rel8/arithmetic/fl-hacks.cert \
-     rtl/rel8/arithmetic/fl-proofs.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/floor-proofs.cert \
-     rtl/rel8/arithmetic/floor.cert \
-     rtl/rel8/arithmetic/fp.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/hacks.cert \
-     rtl/rel8/arithmetic/induct.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/inverted-factor.cert \
-     rtl/rel8/arithmetic/mod-expt.cert \
-     rtl/rel8/arithmetic/mod-proofs.cert \
-     rtl/rel8/arithmetic/mod.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/nniq.cert \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/product-proofs.cert \
-     rtl/rel8/arithmetic/product.cert \
-     rtl/rel8/arithmetic/rationalp.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/x-2xx.cert \
-     rtl/rel8/lib/add.cert \
-     rtl/rel8/lib/arith.cert \
-     rtl/rel8/lib/basic.cert \
-     rtl/rel8/lib/bits.cert \
-     rtl/rel8/lib/bvecp-helpers.cert \
-     rtl/rel8/lib/bvecp-raw-helpers.cert \
-     rtl/rel8/lib/clocks.cert \
-     rtl/rel8/lib/float.cert \
-     rtl/rel8/lib/log.cert \
-     rtl/rel8/lib/logn.cert \
-     rtl/rel8/lib/logn2log.cert \
-     rtl/rel8/lib/mult.cert \
-     rtl/rel8/lib/openers.cert \
-     rtl/rel8/lib/package-defs.cert \
-     rtl/rel8/lib/reps.cert \
-     rtl/rel8/lib/rom-helpers.cert \
-     rtl/rel8/lib/round.cert \
-     rtl/rel8/lib/rtl.cert \
-     rtl/rel8/lib/rtlarr.cert \
-     rtl/rel8/lib/simple-loop-helpers.cert \
-     rtl/rel8/lib/simplify-model-helpers.cert \
-     rtl/rel8/lib/top.cert \
-     rtl/rel8/lib/util.cert \
-     rtl/rel8/support/lib1.delta1/arith-extra.cert \
-     rtl/rel8/support/lib1.delta1/arith.cert \
-     rtl/rel8/support/lib1.delta1/basic-extra.cert \
-     rtl/rel8/support/lib1.delta1/basic.cert \
-     rtl/rel8/support/lib1.delta1/bits-extra.cert \
-     rtl/rel8/support/lib1.delta1/bits.cert \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.cert \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib1.delta1/float-extra2.cert \
-     rtl/rel8/support/lib1.delta1/float.cert \
-     rtl/rel8/support/lib1.delta1/mult-proofs.cert \
-     rtl/rel8/support/lib1.delta1/mult.cert \
-     rtl/rel8/support/lib1.delta1/round-extra2.cert \
-     rtl/rel8/support/lib1.delta1/round.cert \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.cert \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers.cert \
-     rtl/rel8/support/lib1.delta2/float-extra.cert \
-     rtl/rel8/support/lib1.delta2/float.cert \
-     rtl/rel8/support/lib1/add.cert \
-     rtl/rel8/support/lib1/arith.cert \
-     rtl/rel8/support/lib1/basic.cert \
-     rtl/rel8/support/lib1/bits.cert \
-     rtl/rel8/support/lib1/bvecp-helpers.cert \
-     rtl/rel8/support/lib1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib1/clocks.cert \
-     rtl/rel8/support/lib1/float.cert \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/lib1/openers.cert \
-     rtl/rel8/support/lib1/package-defs.cert \
-     rtl/rel8/support/lib1/reps.cert \
-     rtl/rel8/support/lib1/rom-helpers.cert \
-     rtl/rel8/support/lib1/round.cert \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/lib1/simple-loop-helpers.cert \
-     rtl/rel8/support/lib1/simplify-model-helpers.cert \
-     rtl/rel8/support/lib1/top.cert \
-     rtl/rel8/support/lib1/util.cert \
-     rtl/rel8/support/lib2.delta1/add-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/add-new.cert \
-     rtl/rel8/support/lib2.delta1/add-proofs.cert \
-     rtl/rel8/support/lib2.delta1/add.cert \
-     rtl/rel8/support/lib2.delta1/arith.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/support/lib2.delta1/bits-proofs.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-helpers.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib2.delta1/float-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/float-new.cert \
-     rtl/rel8/support/lib2.delta1/float-proofs.cert \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/log-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-support-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-support.cert \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/logn-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/logn-new.cert \
-     rtl/rel8/support/lib2.delta1/logn-proofs.cert \
-     rtl/rel8/support/lib2.delta1/logn.cert \
-     rtl/rel8/support/lib2.delta1/logn2log-proofs.cert \
-     rtl/rel8/support/lib2.delta1/logn2log.cert \
-     rtl/rel8/support/lib2.delta1/mult-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/mult-new.cert \
-     rtl/rel8/support/lib2.delta1/mult-proofs.cert \
-     rtl/rel8/support/lib2.delta1/mult.cert \
-     rtl/rel8/support/lib2.delta1/reps-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/reps-new.cert \
-     rtl/rel8/support/lib2.delta1/reps-proofs.cert \
-     rtl/rel8/support/lib2.delta1/reps.cert \
-     rtl/rel8/support/lib2.delta1/round-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/round-new.cert \
-     rtl/rel8/support/lib2.delta1/round-proofs.cert \
-     rtl/rel8/support/lib2.delta1/round.cert \
-     rtl/rel8/support/lib2.delta1/rtl-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/rtl-new.cert \
-     rtl/rel8/support/lib2.delta1/rtl-proofs.cert \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr-new.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.cert \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert \
-     rtl/rel8/support/lib2.delta1/top.cert \
-     rtl/rel8/support/lib2.delta1/util.cert \
-     rtl/rel8/support/lib2.delta2/add-lib.cert \
-     rtl/rel8/support/lib2.delta2/add.cert \
-     rtl/rel8/support/lib2.delta2/base.cert \
-     rtl/rel8/support/lib2.delta2/bits.cert \
-     rtl/rel8/support/lib2.delta2/log.cert \
-     rtl/rel8/support/lib2/add.cert \
-     rtl/rel8/support/lib2/arith.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2/bits.cert \
-     rtl/rel8/support/lib2/bvecp-helpers.cert \
-     rtl/rel8/support/lib2/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib2/clocks.cert \
-     rtl/rel8/support/lib2/float.cert \
-     rtl/rel8/support/lib2/log.cert \
-     rtl/rel8/support/lib2/mult.cert \
-     rtl/rel8/support/lib2/openers.cert \
-     rtl/rel8/support/lib2/package-defs.cert \
-     rtl/rel8/support/lib2/reps.cert \
-     rtl/rel8/support/lib2/rom-helpers.cert \
-     rtl/rel8/support/lib2/round.cert \
-     rtl/rel8/support/lib2/rtl.cert \
-     rtl/rel8/support/lib2/rtlarr.cert \
-     rtl/rel8/support/lib2/simple-loop-helpers.cert \
-     rtl/rel8/support/lib2/simplify-model-helpers.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2/util.cert \
-     rtl/rel8/support/support/add3-proofs.cert \
-     rtl/rel8/support/support/add3.cert \
-     rtl/rel8/support/support/all-ones.cert \
-     rtl/rel8/support/support/ash.cert \
-     rtl/rel8/support/support/away-proofs.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/support/support/badguys.cert \
-     rtl/rel8/support/support/bias-proofs.cert \
-     rtl/rel8/support/support/bias.cert \
-     rtl/rel8/support/support/bitn-proofs.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/bits-proofs.cert \
-     rtl/rel8/support/support/bits-trunc-proofs.cert \
-     rtl/rel8/support/support/bits-trunc.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bvecp-helpers.cert \
-     rtl/rel8/support/support/bvecp-lemmas.cert \
-     rtl/rel8/support/support/bvecp-proofs.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/cat-proofs.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/clocks.cert \
-     rtl/rel8/support/support/decode-proofs.cert \
-     rtl/rel8/support/support/decode.cert \
-     rtl/rel8/support/support/drnd-original.cert \
-     rtl/rel8/support/support/encode.cert \
-     rtl/rel8/support/support/ereps-proofs.cert \
-     rtl/rel8/support/support/ereps.cert \
-     rtl/rel8/support/support/fadd-extra.cert \
-     rtl/rel8/support/support/fadd-extra0.cert \
-     rtl/rel8/support/support/fadd.cert \
-     rtl/rel8/support/support/fast-and.cert \
-     rtl/rel8/support/support/float-extra.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/guards.cert \
-     rtl/rel8/support/support/ireps.cert \
-     rtl/rel8/support/support/land.cert \
-     rtl/rel8/support/support/land0-proofs.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lextra-proofs.cert \
-     rtl/rel8/support/support/lextra.cert \
-     rtl/rel8/support/support/lextra0.cert \
-     rtl/rel8/support/support/lior.cert \
-     rtl/rel8/support/support/lior0-proofs.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lnot-proofs.cert \
-     rtl/rel8/support/support/lnot.cert \
-     rtl/rel8/support/support/log-equal.cert \
-     rtl/rel8/support/support/log-proofs.cert \
-     rtl/rel8/support/support/log.cert \
-     rtl/rel8/support/support/logand-proofs.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logeqv.cert \
-     rtl/rel8/support/support/logior-proofs.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/logior1-proofs.cert \
-     rtl/rel8/support/support/logior1.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/support/support/logorc1.cert \
-     rtl/rel8/support/support/logs.cert \
-     rtl/rel8/support/support/logxor.cert \
-     rtl/rel8/support/support/lop1-proofs.cert \
-     rtl/rel8/support/support/lop1.cert \
-     rtl/rel8/support/support/lop2-proofs.cert \
-     rtl/rel8/support/support/lop2.cert \
-     rtl/rel8/support/support/lop3-proofs.cert \
-     rtl/rel8/support/support/lop3.cert \
-     rtl/rel8/support/support/lxor.cert \
-     rtl/rel8/support/support/lxor0-proofs.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/merge2.cert \
-     rtl/rel8/support/support/mod4.cert \
-     rtl/rel8/support/support/model-helpers.cert \
-     rtl/rel8/support/support/mulcat-proofs.cert \
-     rtl/rel8/support/support/mulcat.cert \
-     rtl/rel8/support/support/near+-proofs.cert \
-     rtl/rel8/support/support/near+.cert \
-     rtl/rel8/support/support/near-proofs.cert \
-     rtl/rel8/support/support/near.cert \
-     rtl/rel8/support/support/ocat.cert \
-     rtl/rel8/support/support/oddr-proofs.cert \
-     rtl/rel8/support/support/oddr.cert \
-     rtl/rel8/support/support/openers.cert \
-     rtl/rel8/support/support/package-defs.cert \
-     rtl/rel8/support/support/rewrite-theory.cert \
-     rtl/rel8/support/support/rnd.cert \
-     rtl/rel8/support/support/rom-helpers.cert \
-     rtl/rel8/support/support/round-extra.cert \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/rtlarr.cert \
-     rtl/rel8/support/support/setbitn-proofs.cert \
-     rtl/rel8/support/support/setbitn.cert \
-     rtl/rel8/support/support/setbits-proofs.cert \
-     rtl/rel8/support/support/setbits.cert \
-     rtl/rel8/support/support/sgn.cert \
-     rtl/rel8/support/support/shft.cert \
-     rtl/rel8/support/support/simple-loop-helpers.cert \
-     rtl/rel8/support/support/simplify-model-helpers.cert \
-     rtl/rel8/support/support/stick-proofs.cert \
-     rtl/rel8/support/support/stick.cert \
-     rtl/rel8/support/support/sticky-proofs.cert \
-     rtl/rel8/support/support/sticky.cert \
-     rtl/rel8/support/support/sumbits.cert \
-     rtl/rel8/support/support/top.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/trunc-proofs.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/util.cert \
-     rtl/rel8/support/top/top.cert \
-     security/jfkr/diffie-helman.cert \
-     security/jfkr/encryption.cert \
-     security/jfkr/jfkr.cert \
-     security/jfkr/random.cert \
-     security/suite-b/sha-2.cert \
-     security/util/byte-operations.cert \
-     serialize/serialize-tests.cert \
-     serialize/serialize-tests2.cert \
-     serialize/unsound-read.cert \
-     sorting/bsort.cert \
-     sorting/convert-perm-to-how-many.cert \
-     sorting/equisort.cert \
-     sorting/equisort2.cert \
-     sorting/equisort3.cert \
-     sorting/isort.cert \
-     sorting/msort.cert \
-     sorting/no-dups-qsort.cert \
-     sorting/ordered-perms.cert \
-     sorting/perm.cert \
-     sorting/qsort.cert \
-     sorting/sorts-equivalent.cert \
-     sorting/sorts-equivalent2.cert \
-     sorting/sorts-equivalent3.cert \
-     std/io/base.cert \
-     std/io/close-input-channel.cert \
-     std/io/combine.cert \
-     std/io/file-measure.cert \
-     std/io/nthcdr-bytes.cert \
-     std/io/open-input-channel.cert \
-     std/io/open-input-channels.cert \
-     std/io/peek-char.cert \
-     std/io/read-byte.cert \
-     std/io/read-char.cert \
-     std/io/read-file-bytes.cert \
-     std/io/read-file-characters-no-error.cert \
-     std/io/read-file-characters.cert \
-     std/io/read-file-lines.cert \
-     std/io/read-file-objects.cert \
-     std/io/read-ints.cert \
-     std/io/read-object.cert \
-     std/io/sign-byte.cert \
-     std/io/signed-byte-listp.cert \
-     std/io/take-bytes.cert \
-     std/io/unsigned-byte-listp.cert \
-     std/ks/base10-digit-charp.cert \
-     std/ks/explode-atom.cert \
-     std/ks/explode-nonnegative-integer.cert \
-     std/ks/intern-in-package-of-symbol.cert \
-     std/ks/string-append.cert \
-     std/ks/two-nats-measure.cert \
-     std/lists/app.cert \
-     std/lists/append.cert \
-     std/lists/coerce.cert \
-     std/lists/consless-listp.cert \
-     std/lists/equiv.cert \
-     std/lists/final-cdr.cert \
-     std/lists/flatten.cert \
-     std/lists/list-defuns.cert \
-     std/lists/list-fix.cert \
-     std/lists/make-character-list.cert \
-     std/lists/mfc-utils.cert \
-     std/lists/nat-listp.cert \
-     std/lists/nthcdr.cert \
-     std/lists/prefixp.cert \
-     std/lists/repeat.cert \
-     std/lists/rev.cert \
-     std/lists/revappend.cert \
-     std/lists/reverse.cert \
-     std/lists/sets.cert \
-     std/lists/take.cert \
-     str/abbrevs.cert \
-     str/arithmetic.cert \
-     str/case-conversion.cert \
-     str/cat.cert \
-     str/char-case.cert \
-     str/digitp.cert \
-     str/eqv.cert \
-     str/fast-cat.cert \
-     str/firstn-chars.cert \
-     str/hexify.cert \
-     str/html-encode.cert \
-     str/ieqv.cert \
-     str/iless.cert \
-     str/iprefixp.cert \
-     str/isort.cert \
-     str/istrpos.cert \
-     str/istrprefixp.cert \
-     str/isubstrp.cert \
-     str/natstr.cert \
-     str/pad.cert \
-     str/portcullis.cert \
-     str/prefix-lines.cert \
-     str/stringify.cert \
-     str/strline.cert \
-     str/strnatless.cert \
-     str/strpos.cert \
-     str/strprefixp.cert \
-     str/strrpos.cert \
-     str/strsplit.cert \
-     str/strsubst.cert \
-     str/strtok.cert \
-     str/strval.cert \
-     str/subseq.cert \
-     str/substrp.cert \
-     str/suffixp.cert \
-     str/top.cert \
-     symbolic/generic/assertions.cert \
-     symbolic/generic/defsimulate.cert \
-     symbolic/generic/factorial-jvm-correct.cert \
-     symbolic/generic/measures.cert \
-     symbolic/generic/partial-correctness.cert \
-     symbolic/generic/tiny-fib-correct.cert \
-     symbolic/generic/total-correctness.cert \
-     symbolic/m5/demo.cert \
-     symbolic/m5/utilities.cert \
-     symbolic/tiny-fib/defstobj+.cert \
-     symbolic/tiny-fib/fib-def.cert \
-     symbolic/tiny-fib/tiny-rewrites.cert \
-     symbolic/tiny-fib/tiny.cert \
-     symbolic/tiny-triangle/tiny-triangle-correct.cert \
-     symbolic/tiny-triangle/triangle-def.cert \
-     system/compare-out-files.cert \
-     system/convert-normalized-term-to-pairs.cert \
-     system/extend-pathname.cert \
-     system/f-put-global.cert \
-     system/gather-dcls.cert \
-     system/hl-addr-combine.cert \
-     system/io.cert \
-     system/legal-variablep.cert \
-     system/meta-extract.cert \
-     system/pseudo-good-worldp.cert \
-     system/pseudo-termp-lemmas.cert \
-     system/subcor-var.cert \
-     system/sublis-var.cert \
-     system/subst-expr.cert \
-     system/subst-var.cert \
-     system/too-many-ifs.cert \
-     system/top.cert \
-     system/update-state.cert \
-     system/verified-termination-and-guards.cert \
-     system/worldp-check.cert \
-     taspi/code/brlens/brlens.cert \
-     taspi/code/brlens/trees-with-brlens.cert \
-     taspi/code/build/build-term-guards.cert \
-     taspi/code/build/build-term.cert \
-     taspi/code/fringes/fringes-guards.cert \
-     taspi/code/fringes/fringes-props.cert \
-     taspi/code/fringes/fringes.cert \
-     taspi/code/gen-helper/bdd-functions.cert \
-     taspi/code/gen-helper/extra.cert \
-     taspi/code/gen-helper/fast-lists.cert \
-     taspi/code/gen-helper/sets.cert \
-     taspi/code/gen-helper/top.cert \
-     taspi/code/gen-trees/app-rev-lists.cert \
-     taspi/code/gen-trees/btrees-bdds-sets.cert \
-     taspi/code/gen-trees/btrees-bdds.cert \
-     taspi/code/gen-trees/btrees.cert \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/code/gen-trees/top.cert \
-     taspi/code/gen-trees/tree-predicates.cert \
-     taspi/code/replete/replete-guards.cert \
-     taspi/code/replete/replete-helper.cert \
-     taspi/code/replete/replete.cert \
-     taspi/code/sequences/align.cert \
-     taspi/code/sequences/p-inform.cert \
-     taspi/code/sequences/seqs.cert \
-     taspi/code/tree-manip/insertion-based-sort.cert \
-     taspi/code/tree-manip/merge-based-sort.cert \
-     taspi/code/tree-manip/mv-root.cert \
-     taspi/code/tree-manip/quicksort.cert \
-     taspi/code/tree-manip/sort-help.cert \
-     taspi/code/tree-manip/top.cert \
-     taspi/database/db-from-list.cert \
-     taspi/database/db.cert \
-     taspi/database/entry.cert \
-     taspi/database/filters.cert \
-     taspi/database/props.cert \
-     taspi/proofs/fringes-taspi.cert \
-     taspi/proofs/omerge-good-order.cert \
-     taspi/proofs/sets.cert \
-     taspi/sets-input/consensus.cert \
-     taspi/sets-input/greedy.cert \
-     taspi/sets-input/mast.cert \
-     taspi/sets-input/mct.cert \
-     taspi/sets-input/multipolar-loose.cert \
-     taspi/sets-input/top.cert \
-     taspi/sets-input/tree-compat.cert \
-     taspi/sets-input/tree-support-in-set.cert \
-     taspi/single-input/taxa-based.cert \
-     taspi/single-input/tree-stats.cert \
-     taspi/tree-distance/rf.cert \
-     taspi/tree-distance/symm-diff.cert \
-     taspi/tree-generation/branch-and-bound/bandb.cert \
-     taspi/tree-generation/distance-based/naive-quartet-method.cert \
-     taspi/tree-generation/heuristics/do-search.cert \
-     taspi/tree-generation/heuristics/spr.cert \
-     taspi/tree-generation/heuristics/tbr.cert \
-     taspi/tree-generation/tree-gen-helper/basics.cert \
-     taspi/tree-score/ambig-score.cert \
-     taspi/tree-score/circle-scoring.cert \
-     taspi/tree-score/costs.cert \
-     taspi/tree-score/efficient-pscores-help.cert \
-     taspi/tree-score/efficient-pscores.cert \
-     taspi/tree-score/fitch-scoring.cert \
-     taspi/tree-score/min-length.cert \
-     taspi/tree-score/opt-pairwise.cert \
-     taspi/tree-score/pscores.cert \
-     tau/bounders/elementary-bounders.cert \
-     tau/bounders/find-maximal-1d.cert \
-     tau/bounders/find-maximal-2d.cert \
-     tau/bounders/find-minimal-1d.cert \
-     tau/bounders/find-minimal-2d.cert \
-     textbook/chap10/ac-example.cert \
-     textbook/chap10/adder.cert \
-     textbook/chap10/compiler.cert \
-     textbook/chap10/fact.cert \
-     textbook/chap10/insertion-sort.cert \
-     textbook/chap10/tree.cert \
-     textbook/chap11/compress.cert \
-     textbook/chap11/encap.cert \
-     textbook/chap11/finite-sets.cert \
-     textbook/chap11/how-many-soln1.cert \
-     textbook/chap11/how-many-soln2.cert \
-     textbook/chap11/mergesort.cert \
-     textbook/chap11/perm-append.cert \
-     textbook/chap11/perm.cert \
-     textbook/chap11/qsort.cert \
-     textbook/chap11/starters.cert \
-     textbook/chap11/summations-book.cert \
-     textbook/chap11/summations.cert \
-     textbook/chap11/tautology.cert \
-     textbook/chap11/xtr.cert \
-     textbook/chap11/xtr2.cert \
-     textbook/chap3/programs.cert \
-     textbook/chap4/solutions-logic-mode.cert \
-     textbook/chap4/solutions-program-mode.cert \
-     textbook/chap5/solutions.cert \
-     textbook/chap6/selected-solutions.cert \
-     tools/bstar.cert \
-     tools/case-splitting-rules.cert \
-     tools/clone-stobj.cert \
-     tools/cws.cert \
-     tools/def-functional-instance.cert \
-     tools/defconsts.cert \
-     tools/defevaluator-fast.cert \
-     tools/define-keyed-function.cert \
-     tools/defined-const.cert \
-     tools/defmacfun.cert \
-     tools/defredundant.cert \
-     tools/defsum.cert \
-     tools/deftuple.cert \
-     tools/do-not.cert \
-     tools/easy-simplify.cert \
-     tools/fake-event.cert \
-     tools/flag.cert \
-     tools/in-raw-mode.cert \
-     tools/include-raw.cert \
-     tools/mv-nth.cert \
-     tools/oracle-eval-real.cert \
-     tools/oracle-eval.cert \
-     tools/pack.cert \
-     tools/pattern-match.cert \
-     tools/plev-ccl.cert \
-     tools/plev.cert \
-     tools/rulesets.cert \
-     tools/safe-case.cert \
-     tools/saved-errors.cert \
-     tools/stobj-frame.cert \
-     tools/stobj-help.cert \
-     tools/templates.cert \
-     tools/theory-tools.cert \
-     tools/time-dollar-with-gc.cert \
-     tools/types-misc.cert \
-     tools/with-arith5-help.cert \
-     tools/with-quoted-forms.cert \
-     tutorial-problems/introductory-challenge-problem-4-athena.cert \
-     tutorial-problems/introductory-challenge-problem-4.cert \
-     unicode/partition.cert \
-     unicode/read-utf8.cert \
-     unicode/sum-list.cert \
-     unicode/uchar.cert \
-     unicode/utf8-decode.cert \
-     unicode/utf8-encode.cert \
-     unicode/utf8-table35.cert \
-     unicode/utf8-table36.cert \
-     unicode/z-listp.cert \
-     workshops/1999/calculus/solutions/mesh-append.cert \
-     workshops/1999/calculus/solutions/mesh-make-partition.cert \
-     workshops/1999/calculus/solutions/partition-defuns.cert \
-     workshops/1999/calculus/solutions/partitionp-make-partition-rec.cert \
-     workshops/1999/calculus/solutions/partitionp-make-partition.cert \
-     workshops/1999/calculus/solutions/riemann-rcfn-helpers.cert \
-     workshops/1999/compiler/compiler.cert \
-     workshops/1999/compiler/evaluator.cert \
-     workshops/1999/compiler/exercises.cert \
-     workshops/1999/compiler/machine.cert \
-     workshops/1999/compiler/proof.cert \
-     workshops/1999/compiler/proof1.cert \
-     workshops/1999/de-hdl/arity.cert \
-     workshops/1999/de-hdl/de4.cert \
-     workshops/1999/de-hdl/examples.cert \
-     workshops/1999/de-hdl/help-defuns.cert \
-     workshops/1999/de-hdl/measure.cert \
-     workshops/1999/de-hdl/primitives.cert \
-     workshops/1999/de-hdl/sts-okp.cert \
-     workshops/1999/de-hdl/syntax.cert \
-     workshops/1999/de-hdl/thm-example.cert \
-     workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.cert \
-     workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.cert \
-     workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.cert \
-     workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.cert \
-     workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/CRT.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Generic.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Mapping.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.cert \
-     workshops/1999/graph/find-path1.cert \
-     workshops/1999/graph/find-path2.cert \
-     workshops/1999/graph/find-path3.cert \
-     workshops/1999/graph/helpers.cert \
-     workshops/1999/graph/linear-find-path.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/alls.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/cnf.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/flip.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/keval.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/modeler.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/nnf.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/paramod.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prover.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/resolve.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sets.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simplify.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/substitution.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sugar.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/variables.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/xeval.cert \
-     workshops/1999/knuth-91/aof.cert \
-     workshops/1999/knuth-91/exercise1.cert \
-     workshops/1999/knuth-91/exercise2.cert \
-     workshops/1999/knuth-91/exercise3.cert \
-     workshops/1999/knuth-91/exercise4a.cert \
-     workshops/1999/knuth-91/exercise4b.cert \
-     workshops/1999/knuth-91/exercise5.cert \
-     workshops/1999/knuth-91/exercise6a.cert \
-     workshops/1999/knuth-91/exercise6b.cert \
-     workshops/1999/knuth-91/exercise7a.cert \
-     workshops/1999/knuth-91/exercise7b.cert \
-     workshops/1999/knuth-91/knuth-arch.cert \
-     workshops/1999/mu-calculus/book/fast-sets.cert \
-     workshops/1999/mu-calculus/book/fixpoints.cert \
-     workshops/1999/mu-calculus/book/models.cert \
-     workshops/1999/mu-calculus/book/relations.cert \
-     workshops/1999/mu-calculus/book/semantics.cert \
-     workshops/1999/mu-calculus/book/sets.cert \
-     workshops/1999/mu-calculus/book/syntax.cert \
-     workshops/1999/mu-calculus/solutions/ctl.cert \
-     workshops/1999/mu-calculus/solutions/defung.cert \
-     workshops/1999/mu-calculus/solutions/fast-sets.cert \
-     workshops/1999/mu-calculus/solutions/fixpoints.cert \
-     workshops/1999/mu-calculus/solutions/meta.cert \
-     workshops/1999/mu-calculus/solutions/models.cert \
-     workshops/1999/mu-calculus/solutions/perm.cert \
-     workshops/1999/mu-calculus/solutions/relations.cert \
-     workshops/1999/mu-calculus/solutions/semantics.cert \
-     workshops/1999/mu-calculus/solutions/sets.cert \
-     workshops/1999/mu-calculus/solutions/syntax.cert \
-     workshops/1999/pipeline/b-ops-aux-def.cert \
-     workshops/1999/pipeline/b-ops-aux.cert \
-     workshops/1999/pipeline/basic-def.cert \
-     workshops/1999/pipeline/basic-lemmas.cert \
-     workshops/1999/pipeline/exercise.cert \
-     workshops/1999/pipeline/ihs.cert \
-     workshops/1999/pipeline/model.cert \
-     workshops/1999/pipeline/proof.cert \
-     workshops/1999/pipeline/table-def.cert \
-     workshops/1999/pipeline/trivia.cert \
-     workshops/1999/pipeline/utils.cert \
-     workshops/1999/simulator/exercises.cert \
-     workshops/1999/simulator/tiny.cert \
-     workshops/1999/ste/assertion.cert \
-     workshops/1999/ste/boolean.cert \
-     workshops/1999/ste/circuit.cert \
-     workshops/1999/ste/example.cert \
-     workshops/1999/ste/expression.cert \
-     workshops/1999/ste/fundamental.cert \
-     workshops/1999/ste/inference.cert \
-     workshops/1999/ste/lemma-4.cert \
-     workshops/1999/ste/run.cert \
-     workshops/1999/ste/state.cert \
-     workshops/1999/ste/trajectory.cert \
-     workshops/1999/ste/util.cert \
-     workshops/1999/vhdl/exercises.cert \
-     workshops/1999/vhdl/fact-proof.cert \
-     workshops/1999/vhdl/fact.cert \
-     workshops/1999/vhdl/vhdl.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/base.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/compile.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/cstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/expr.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/lstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/pstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/setup.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/simulator.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/util.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/ihs.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.cert \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux.cert \
-     workshops/2000/manolios/pipeline/trivial/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/basic-lemmas.cert \
-     workshops/2000/manolios/pipeline/trivial/ihs.cert \
-     workshops/2000/manolios/pipeline/trivial/model.cert \
-     workshops/2000/manolios/pipeline/trivial/proof.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/proof.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.cert \
-     workshops/2000/manolios/pipeline/trivial/table-def.cert \
-     workshops/2000/manolios/pipeline/trivial/trivia.cert \
-     workshops/2000/manolios/pipeline/trivial/utils.cert \
-     workshops/2000/medina/polynomials/addition.cert \
-     workshops/2000/medina/polynomials/congruences-1.cert \
-     workshops/2000/medina/polynomials/congruences-2.cert \
-     workshops/2000/medina/polynomials/examples.cert \
-     workshops/2000/medina/polynomials/lexicographical-ordering.cert \
-     workshops/2000/medina/polynomials/monomial.cert \
-     workshops/2000/medina/polynomials/multiplication.cert \
-     workshops/2000/medina/polynomials/negation.cert \
-     workshops/2000/medina/polynomials/normal-form.cert \
-     workshops/2000/medina/polynomials/polynomial.cert \
-     workshops/2000/medina/polynomials/term.cert \
-     workshops/2000/moore-manolios/partial-functions/defpun-original.cert \
-     workshops/2000/moore-manolios/partial-functions/defpun.cert \
-     workshops/2000/moore-manolios/partial-functions/examples.cert \
-     workshops/2000/moore-manolios/partial-functions/mod-1-property.cert \
-     workshops/2000/moore-manolios/partial-functions/report.cert \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.cert \
-     workshops/2000/moore-manolios/partial-functions/tjvm.cert \
-     workshops/2000/ruiz/multiset/defmul.cert \
-     workshops/2000/ruiz/multiset/examples/ackermann/ackermann.cert \
-     workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.cert \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert \
-     workshops/2000/ruiz/multiset/examples/newman/confluence-v0.cert \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.cert \
-     workshops/2000/ruiz/multiset/examples/newman/local-confluence.cert \
-     workshops/2000/ruiz/multiset/examples/newman/newman.cert \
-     workshops/2000/ruiz/multiset/multiset.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/main.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.cert \
-     workshops/2000/russinoff-short/crt.cert \
-     workshops/2000/russinoff-short/summary.cert \
-     workshops/2000/sumners1/cdeq/cdeq-defs.cert \
-     workshops/2000/sumners1/cdeq/cdeq-phase1.cert \
-     workshops/2000/sumners1/cdeq/cdeq-phase2.cert \
-     workshops/2000/sumners1/cdeq/cdeq-phase3.cert \
-     workshops/2000/sumners1/cdeq/cdeq-phase4.cert \
-     workshops/2000/sumners1/cdeq/records.cert \
-     workshops/2000/sumners2/bdds/bdd-mgr.cert \
-     workshops/2000/sumners2/bdds/bdd-prf.cert \
-     workshops/2000/sumners2/bdds/bdd-spec.cert \
-     workshops/2002/cowles-flat/support/flat-ackermann.cert \
-     workshops/2002/cowles-flat/support/flat-nested.cert \
-     workshops/2002/cowles-flat/support/flat-primitive.cert \
-     workshops/2002/cowles-flat/support/flat-reverse.cert \
-     workshops/2002/cowles-flat/support/flat-tail.cert \
-     workshops/2002/cowles-flat/support/flat-z.cert \
-     workshops/2002/cowles-flat/support/flat.cert \
-     workshops/2002/cowles-primrec/support/bad-def.cert \
-     workshops/2002/cowles-primrec/support/bad-def1.cert \
-     workshops/2002/cowles-primrec/support/defpr.cert \
-     workshops/2002/cowles-primrec/support/fix.cert \
-     workshops/2002/cowles-primrec/support/primitive.cert \
-     workshops/2002/cowles-primrec/support/tail.cert \
-     workshops/2002/georgelin-borrione-ostier/support/acl2-transl.cert \
-     workshops/2002/georgelin-borrione-ostier/support/generates-functions.cert \
-     workshops/2002/georgelin-borrione-ostier/support/generates-theorems.cert \
-     workshops/2002/georgelin-borrione-ostier/support/utils.cert \
-     workshops/2002/kaufmann-sumners/support/records.cert \
-     workshops/2002/kaufmann-sumners/support/records0.cert \
-     workshops/2002/kaufmann-sumners/support/sets.cert \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.cert \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.cert \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.cert \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.cert \
-     workshops/2002/manolios-kaufmann/support/records/records-original.cert \
-     workshops/2002/manolios-kaufmann/support/records/records.cert \
-     workshops/2002/manolios-kaufmann/support/records/total-order.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/perm-order.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/perm.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/quicksort.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/total-order.cert \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.cert \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.cert \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.cert \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.cert \
-     workshops/2002/martin-alonso-perez-sancho/support/Adleman.cert \
-     workshops/2002/medina-palomo-alonso/support/section-2/npol.cert \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-1.cert \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.cert \
-     workshops/2003/austel/support/abs-type.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.cert \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.cert \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.cert \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.cert \
-     workshops/2003/gamboa-cowles-van-baalen/support/linalg.cert \
-     workshops/2003/greve-wilding_defrecord/support/defrecord.cert \
-     workshops/2003/greve-wilding_mbe/support/fpst.cert \
-     workshops/2003/greve-wilding_mbe/support/run-fpst.cert \
-     workshops/2003/hbl/support/sol1.cert \
-     workshops/2003/hbl/support/sol2.cert \
-     workshops/2003/hendrix/support/madd.cert \
-     workshops/2003/hendrix/support/matrices.cert \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mdefuns.cert \
-     workshops/2003/hendrix/support/mentry.cert \
-     workshops/2003/hendrix/support/mid.cert \
-     workshops/2003/hendrix/support/mmult.cert \
-     workshops/2003/hendrix/support/mscal.cert \
-     workshops/2003/hendrix/support/msub.cert \
-     workshops/2003/hendrix/support/mtrans.cert \
-     workshops/2003/hendrix/support/mzero.cert \
-     workshops/2003/hendrix/support/vector.cert \
-     workshops/2003/matlin-mccune/support/simp.cert \
-     workshops/2003/moore_rockwell/support/memory-taggings.cert \
-     workshops/2003/moore_vcg/support/demo.cert \
-     workshops/2003/moore_vcg/support/m5.cert \
-     workshops/2003/moore_vcg/support/utilities.cert \
-     workshops/2003/moore_vcg/support/vcg-examples.cert \
-     workshops/2003/ray-matthews-tuttle/support/apply-total-order.cert \
-     workshops/2003/ray-matthews-tuttle/support/bisimilarity.cert \
-     workshops/2003/ray-matthews-tuttle/support/circuit-bisim.cert \
-     workshops/2003/ray-matthews-tuttle/support/circuits.cert \
-     workshops/2003/ray-matthews-tuttle/support/concrete-ltl.cert \
-     workshops/2003/ray-matthews-tuttle/support/cone-of-influence.cert \
-     workshops/2003/ray-matthews-tuttle/support/conjunction.cert \
-     workshops/2003/ray-matthews-tuttle/support/impl-hack.cert \
-     workshops/2003/ray-matthews-tuttle/support/ltl.cert \
-     workshops/2003/ray-matthews-tuttle/support/records.cert \
-     workshops/2003/ray-matthews-tuttle/support/reductions.cert \
-     workshops/2003/ray-matthews-tuttle/support/sets.cert \
-     workshops/2003/ray-matthews-tuttle/support/total-order.cert \
-     workshops/2003/schmaltz-al-sammane-et-al/support/consistency.cert \
-     workshops/2003/schmaltz-borrione/support/arbiter.cert \
-     workshops/2003/schmaltz-borrione/support/decoder.cert \
-     workshops/2003/schmaltz-borrione/support/inequalities.cert \
-     workshops/2003/schmaltz-borrione/support/predicates.cert \
-     workshops/2003/schmaltz-borrione/support/transfers.cert \
-     workshops/2003/sumners/support/cfair.cert \
-     workshops/2003/sumners/support/example1.cert \
-     workshops/2003/sumners/support/example2.cert \
-     workshops/2003/sumners/support/example3.cert \
-     workshops/2003/sumners/support/fair1.cert \
-     workshops/2003/sumners/support/fair2.cert \
-     workshops/2003/sumners/support/n2n.cert \
-     workshops/2003/sumners/support/simple.cert \
-     workshops/2003/sustik/support/dickson.cert \
-     workshops/2003/toma-borrione/support/bv-op-defthms.cert \
-     workshops/2003/toma-borrione/support/bv-op-defuns.cert \
-     workshops/2003/toma-borrione/support/misc.cert \
-     workshops/2003/toma-borrione/support/padding-1-256.cert \
-     workshops/2003/toma-borrione/support/padding-384-512.cert \
-     workshops/2003/toma-borrione/support/parsing.cert \
-     workshops/2003/toma-borrione/support/sha-1.cert \
-     workshops/2003/toma-borrione/support/sha-256.cert \
-     workshops/2003/toma-borrione/support/sha-384-512.cert \
-     workshops/2003/toma-borrione/support/sha-functions.cert \
-     workshops/2003/tsong/support/shim.cert \
-     workshops/2004/cowles-gamboa/support/WyoM1-correct.cert \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.cert \
-     workshops/2004/cowles-gamboa/support/WyoM1.cert \
-     workshops/2004/cowles-gamboa/support/knuth.cert \
-     workshops/2004/cowles-gamboa/support/tail-rec.cert \
-     workshops/2004/davis/support/computed-hints.cert \
-     workshops/2004/davis/support/fast.cert \
-     workshops/2004/davis/support/instance.cert \
-     workshops/2004/davis/support/map.cert \
-     workshops/2004/davis/support/membership.cert \
-     workshops/2004/davis/support/outer.cert \
-     workshops/2004/davis/support/primitives.cert \
-     workshops/2004/davis/support/quantify.cert \
-     workshops/2004/davis/support/set-order.cert \
-     workshops/2004/davis/support/sets.cert \
-     workshops/2004/davis/support/sort.cert \
-     workshops/2004/gameiro-manolios/support/interval.cert \
-     workshops/2004/gameiro-manolios/support/nth-thms.cert \
-     workshops/2004/gameiro-manolios/support/top-with-meta.cert \
-     workshops/2004/gameiro-manolios/support/transversality.cert \
-     workshops/2004/greve/support/defrecord.cert \
-     workshops/2004/greve/support/mark.cert \
-     workshops/2004/legato/support/generic-theories.cert \
-     workshops/2004/legato/support/generic-theory-alternative-induction-mult.cert \
-     workshops/2004/legato/support/generic-theory-alternative-induction-sum.cert \
-     workshops/2004/legato/support/generic-theory-loop-invariant-mult.cert \
-     workshops/2004/legato/support/generic-theory-loop-invariant-sum.cert \
-     workshops/2004/legato/support/generic-theory-tail-recursion-mult.cert \
-     workshops/2004/legato/support/generic-theory-tail-recursion-sum.cert \
-     workshops/2004/legato/support/proof-by-generalization-mult.cert \
-     workshops/2004/legato/support/proof-by-generalization-sum.cert \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.cert \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.cert \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/records.cert \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.cert \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.cert \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.cert \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.cert \
-     workshops/2004/ray/support/defcoerce.cert \
-     workshops/2004/ray/support/defpun-exec.cert \
-     workshops/2004/ray/support/generic.cert \
-     workshops/2004/roach-fraij/support/roach-fraij-script.cert \
-     workshops/2004/ruiz-et-al/support/basic.cert \
-     workshops/2004/ruiz-et-al/support/dag-unification-rules.cert \
-     workshops/2004/ruiz-et-al/support/dags.cert \
-     workshops/2004/ruiz-et-al/support/lists.cert \
-     workshops/2004/ruiz-et-al/support/matching.cert \
-     workshops/2004/ruiz-et-al/support/prefix-unification-rules.cert \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-rules.cert \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-st.cert \
-     workshops/2004/ruiz-et-al/support/q-dag-unification.cert \
-     workshops/2004/ruiz-et-al/support/subsumption-subst.cert \
-     workshops/2004/ruiz-et-al/support/subsumption.cert \
-     workshops/2004/ruiz-et-al/support/terms-as-dag.cert \
-     workshops/2004/ruiz-et-al/support/terms.cert \
-     workshops/2004/sawada/support/bv.cert \
-     workshops/2004/sawada/support/ihs.cert \
-     workshops/2004/schmaltz-borrione/support/collect_msg_book.cert \
-     workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.cert \
-     workshops/2004/schmaltz-borrione/support/intersect.cert \
-     workshops/2004/schmaltz-borrione/support/local_trip_book.cert \
-     workshops/2004/schmaltz-borrione/support/make_travel_list_book.cert \
-     workshops/2004/schmaltz-borrione/support/mod_lemmas.cert \
-     workshops/2004/schmaltz-borrione/support/node.cert \
-     workshops/2004/schmaltz-borrione/support/octagon_book.cert \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.cert \
-     workshops/2004/schmaltz-borrione/support/routing_defuns.cert \
-     workshops/2004/schmaltz-borrione/support/routing_local_lemmas.cert \
-     workshops/2004/schmaltz-borrione/support/routing_main.cert \
-     workshops/2004/schmaltz-borrione/support/scheduler_book.cert \
-     workshops/2004/schmaltz-borrione/support/switch.cert \
-     workshops/2004/schmaltz-borrione/support/trip_book.cert \
-     workshops/2004/schmaltz-borrione/support/trip_thms.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.cert \
-     workshops/2004/smith-et-al/support/bags/basic.cert \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.cert \
-     workshops/2004/smith-et-al/support/bags/cons.cert \
-     workshops/2004/smith-et-al/support/bags/eric-meta.cert \
-     workshops/2004/smith-et-al/support/bags/meta.cert \
-     workshops/2004/smith-et-al/support/bags/neq.cert \
-     workshops/2004/smith-et-al/support/bags/top.cert \
-     workshops/2004/smith-et-al/support/bags/two-level-meta.cert \
-     workshops/2004/smith-et-al/support/bags/two-level.cert \
-     workshops/2004/smith-et-al/support/lists/list-exports.cert \
-     workshops/2004/smith-et-al/support/lists/list-top.cert \
-     workshops/2004/smith-et-al/support/lists/lists.cert \
-     workshops/2004/smith-et-al/support/lists/mv-nth.cert \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.cert \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.cert \
-     workshops/2004/smith-et-al/support/syntax/auxilary.cert \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.cert \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.cert \
-     workshops/2004/smith-et-al/support/syntax/syntax.cert \
-     workshops/2004/sumners-ray/support/basis.cert \
-     workshops/2004/sumners-ray/support/crit.cert \
-     workshops/2004/sumners-ray/support/mesi.cert \
-     workshops/2004/sumners-ray/support/records.cert \
-     workshops/2004/sumners-ray/support/sets.cert \
-     workshops/2004/sumners-ray/support/total-order.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed1.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.cert \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.cert \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.cert \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.cert \
-     workshops/2006/greve/nary/example.cert \
-     workshops/2006/greve/nary/nary.cert \
-     workshops/2006/greve/nary/nth-rules.cert \
-     workshops/2006/hunt-reeber/support/acl2.cert \
-     workshops/2006/hunt-reeber/support/bdd.cert \
-     workshops/2006/hunt-reeber/support/sat.cert \
-     workshops/2006/kaufmann-moore/support/austel.cert \
-     workshops/2006/kaufmann-moore/support/greve1.cert \
-     workshops/2006/kaufmann-moore/support/greve2.cert \
-     workshops/2006/kaufmann-moore/support/greve3.cert \
-     workshops/2006/kaufmann-moore/support/mini-proveall-plus.cert \
-     workshops/2006/kaufmann-moore/support/mini-proveall.cert \
-     workshops/2006/kaufmann-moore/support/rhs1-iff.cert \
-     workshops/2006/kaufmann-moore/support/rhs1.cert \
-     workshops/2006/kaufmann-moore/support/rhs2.cert \
-     workshops/2006/kaufmann-moore/support/smith1.cert \
-     workshops/2006/kaufmann-moore/support/sumners1.cert \
-     workshops/2006/kaufmann-moore/support/warnings.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.cert \
-     workshops/2006/rager/support/ptest-fib.cert \
-     workshops/2006/rager/support/ptest-if-normalization.cert \
-     workshops/2006/rager/support/ptest-mergesort.cert \
-     workshops/2006/ray/tail/exists.cert \
-     workshops/2006/ray/tail/forall.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.cert \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.cert \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.cert \
-     workshops/2006/swords-cook/lcsoundness/defsum-thms.cert \
-     workshops/2006/swords-cook/lcsoundness/defsum.cert \
-     workshops/2006/swords-cook/lcsoundness/pattern-match.cert \
-     workshops/2007/cowles-et-al/support/cowles/while-loop.cert \
-     workshops/2007/cowles-et-al/support/greve/ack.cert \
-     workshops/2007/cowles-et-al/support/greve/defminterm.cert \
-     workshops/2007/cowles-et-al/support/greve/defpun.cert \
-     workshops/2007/cowles-et-al/support/greve/defxch.cert \
-     workshops/2007/cowles-et-al/support/greve/while.cert \
-     workshops/2007/cowles-et-al/support/ray/reflexive-macros.cert \
-     workshops/2007/cowles-et-al/support/ray/reflexive.cert \
-     workshops/2007/dillinger-et-al/code/all.cert \
-     workshops/2007/dillinger-et-al/code/bridge.cert \
-     workshops/2007/dillinger-et-al/code/defcode-macro.cert \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.cert \
-     workshops/2007/dillinger-et-al/code/hacker.cert \
-     workshops/2007/dillinger-et-al/code/raw.cert \
-     workshops/2007/dillinger-et-al/code/redefun.cert \
-     workshops/2007/dillinger-et-al/code/rewrite-code.cert \
-     workshops/2007/dillinger-et-al/code/subsumption.cert \
-     workshops/2007/dillinger-et-al/code/table-guard.cert \
-     workshops/2007/erickson/bprove/bash.cert \
-     workshops/2007/erickson/bprove/exdefs.cert \
-     workshops/2007/erickson/bprove/gen.cert \
-     workshops/2007/erickson/bprove/lemgen.cert \
-     workshops/2007/erickson/bprove/refute.cert \
-     workshops/2007/rimlinger/support/Rimlinger.cert \
-     workshops/2007/rubio/support/abstract-reductions/abstract-proofs.cert \
-     workshops/2007/rubio/support/abstract-reductions/confluence.cert \
-     workshops/2007/rubio/support/abstract-reductions/convergent.cert \
-     workshops/2007/rubio/support/abstract-reductions/newman.cert \
-     workshops/2007/rubio/support/multisets/defmul.cert \
-     workshops/2007/rubio/support/multisets/multiset.cert \
-     workshops/2007/rubio/support/simplicial-topology/generate-degenerate.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.cert \
-     workshops/2009/fraij-roach/support/functions.cert \
-     workshops/2009/fraij-roach/support/theorems.cert \
-     workshops/2009/hardin/deque-stobj/deque-stobj.cert \
-     workshops/2009/hardin/deque-stobj/deque-thms.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.cert \
-     workshops/2009/liu/support/error-analysis-tool3.cert \
-     workshops/2009/liu/support/mylet.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.cert \
-     workshops/2009/sumners/support/kas.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.cert \
-     workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.cert \
-     workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.cert \
-     workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.cert \
-     workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.cert \
-     wp-gen/mutrec/mutrec.cert \
-     wp-gen/shared.cert \
-     wp-gen/wp-gen.cert \
-     xdoc-impl/autolink.cert \
-     xdoc-impl/extra-packages.cert \
-     xdoc-impl/fmt-to-str.cert \
-     xdoc-impl/import-acl2doc.cert \
-     xdoc-impl/mkdir-raw.cert \
-     xdoc-impl/mkdir.cert \
-     xdoc-impl/parse-xml.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/preprocess.cert \
-     xdoc-impl/save.cert \
-     xdoc-impl/sort.cert \
-     xdoc-impl/topics.cert \
-     xdoc-impl/write-acl2-xdoc.cert \
-     xdoc/base.cert \
-     xdoc/book-thms.cert \
-     xdoc/defxdoc-raw.cert \
-     xdoc/names.cert \
-     xdoc/portcullis.cert \
-     xdoc/top.cert
-
-all-cert-pl-certs: $(CERT_PL_CERTS)
-
-CERT_PL_SOURCES := \
-     arithmetic-2/floor-mod/floor-mod-helper.lisp  \
-     arithmetic-2/floor-mod/floor-mod.lisp  \
-     arithmetic-2/meta/cancel-terms-helper.lisp  \
-     arithmetic-2/meta/cancel-terms-meta.lisp  \
-     arithmetic-2/meta/collect-terms-meta.lisp  \
-     arithmetic-2/meta/common-meta.lisp  \
-     arithmetic-2/meta/expt-helper.lisp  \
-     arithmetic-2/meta/expt.lisp  \
-     arithmetic-2/meta/integerp-meta.lisp  \
-     arithmetic-2/meta/integerp.lisp  \
-     arithmetic-2/meta/mini-theories.lisp  \
-     arithmetic-2/meta/non-linear.lisp  \
-     arithmetic-2/meta/numerator-and-denominator.lisp  \
-     arithmetic-2/meta/post.lisp  \
-     arithmetic-2/meta/pre.lisp  \
-     arithmetic-2/meta/top.lisp  \
-     arithmetic-2/pass1/basic-arithmetic-helper.lisp  \
-     arithmetic-2/pass1/basic-arithmetic.lisp  \
-     arithmetic-2/pass1/expt-helper.lisp  \
-     arithmetic-2/pass1/expt.lisp  \
-     arithmetic-2/pass1/inequalities.lisp  \
-     arithmetic-2/pass1/mini-theories.lisp  \
-     arithmetic-2/pass1/numerator-and-denominator-helper.lisp  \
-     arithmetic-2/pass1/numerator-and-denominator.lisp  \
-     arithmetic-2/pass1/prefer-times.lisp  \
-     arithmetic-2/pass1/top.lisp  \
-     arithmetic-3/bind-free/arithmetic-theory.lisp  \
-     arithmetic-3/bind-free/banner.lisp  \
-     arithmetic-3/bind-free/basic-helper.lisp  \
-     arithmetic-3/bind-free/basic.lisp  \
-     arithmetic-3/bind-free/building-blocks.lisp  \
-     arithmetic-3/bind-free/collect.lisp  \
-     arithmetic-3/bind-free/common.lisp  \
-     arithmetic-3/bind-free/default-hint.lisp  \
-     arithmetic-3/bind-free/integerp-meta.lisp  \
-     arithmetic-3/bind-free/integerp.lisp  \
-     arithmetic-3/bind-free/mini-theories-helper.lisp  \
-     arithmetic-3/bind-free/mini-theories.lisp  \
-     arithmetic-3/bind-free/normalize.lisp  \
-     arithmetic-3/bind-free/numerator-and-denominator.lisp  \
-     arithmetic-3/bind-free/remove-weak-inequalities.lisp  \
-     arithmetic-3/bind-free/simplify-helper.lisp  \
-     arithmetic-3/bind-free/simplify.lisp  \
-     arithmetic-3/bind-free/top.lisp  \
-     arithmetic-3/extra/ext.lisp  \
-     arithmetic-3/extra/top-ext.lisp  \
-     arithmetic-3/floor-mod/floor-mod.lisp  \
-     arithmetic-3/floor-mod/mod-expt-fast.lisp  \
-     arithmetic-3/pass1/basic-arithmetic-helper.lisp  \
-     arithmetic-3/pass1/basic-arithmetic.lisp  \
-     arithmetic-3/pass1/expt-helper.lisp  \
-     arithmetic-3/pass1/expt.lisp  \
-     arithmetic-3/pass1/inequalities.lisp  \
-     arithmetic-3/pass1/mini-theories.lisp  \
-     arithmetic-3/pass1/non-linear.lisp  \
-     arithmetic-3/pass1/num-and-denom-helper.lisp  \
-     arithmetic-3/pass1/numerator-and-denominator.lisp  \
-     arithmetic-3/pass1/prefer-times.lisp  \
-     arithmetic-3/pass1/top.lisp  \
-     arithmetic-3/top.lisp  \
-     arithmetic-5/lib/basic-ops/arithmetic-theory.lisp  \
-     arithmetic-5/lib/basic-ops/banner.lisp  \
-     arithmetic-5/lib/basic-ops/basic.lisp  \
-     arithmetic-5/lib/basic-ops/building-blocks-helper.lisp  \
-     arithmetic-5/lib/basic-ops/building-blocks.lisp  \
-     arithmetic-5/lib/basic-ops/collect.lisp  \
-     arithmetic-5/lib/basic-ops/common.lisp  \
-     arithmetic-5/lib/basic-ops/default-hint.lisp  \
-     arithmetic-5/lib/basic-ops/distributivity.lisp  \
-     arithmetic-5/lib/basic-ops/dynamic-e-d.lisp  \
-     arithmetic-5/lib/basic-ops/elim-hint.acl2  \
-     arithmetic-5/lib/basic-ops/elim-hint.lisp  \
-     arithmetic-5/lib/basic-ops/expt-helper.lisp  \
-     arithmetic-5/lib/basic-ops/expt.lisp  \
-     arithmetic-5/lib/basic-ops/forcing-types.lisp  \
-     arithmetic-5/lib/basic-ops/if-normalization.lisp  \
-     arithmetic-5/lib/basic-ops/integerp-helper.lisp  \
-     arithmetic-5/lib/basic-ops/integerp-meta.lisp  \
-     arithmetic-5/lib/basic-ops/integerp.lisp  \
-     arithmetic-5/lib/basic-ops/mini-theories.lisp  \
-     arithmetic-5/lib/basic-ops/natp-posp.lisp  \
-     arithmetic-5/lib/basic-ops/normalize.lisp  \
-     arithmetic-5/lib/basic-ops/numerator-and-denominator.lisp  \
-     arithmetic-5/lib/basic-ops/remove-weak-inequalities.lisp  \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.lisp  \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.lisp  \
-     arithmetic-5/lib/basic-ops/simplify-helper.lisp  \
-     arithmetic-5/lib/basic-ops/simplify.lisp  \
-     arithmetic-5/lib/basic-ops/top.lisp  \
-     arithmetic-5/lib/basic-ops/types-helper.lisp  \
-     arithmetic-5/lib/basic-ops/types.lisp  \
-     arithmetic-5/lib/basic-ops/we-are-here.lisp  \
-     arithmetic-5/lib/floor-mod/floor-mod-basic-helper.lisp  \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.lisp  \
-     arithmetic-5/lib/floor-mod/floor-mod-helper.lisp  \
-     arithmetic-5/lib/floor-mod/floor-mod.lisp  \
-     arithmetic-5/lib/floor-mod/forcing-types.lisp  \
-     arithmetic-5/lib/floor-mod/if-normalization.lisp  \
-     arithmetic-5/lib/floor-mod/logand-helper.lisp  \
-     arithmetic-5/lib/floor-mod/logand.lisp  \
-     arithmetic-5/lib/floor-mod/mod-expt-fast.lisp  \
-     arithmetic-5/lib/floor-mod/more-floor-mod.lisp  \
-     arithmetic-5/lib/floor-mod/top.lisp  \
-     arithmetic-5/lib/floor-mod/truncate-rem.lisp  \
-     arithmetic-5/support/basic-arithmetic-helper.lisp  \
-     arithmetic-5/support/basic-arithmetic.lisp  \
-     arithmetic-5/support/expt-helper.lisp  \
-     arithmetic-5/support/expt.lisp  \
-     arithmetic-5/support/inequalities.lisp  \
-     arithmetic-5/support/mini-theories.lisp  \
-     arithmetic-5/support/non-linear.lisp  \
-     arithmetic-5/support/num-and-denom-helper.lisp  \
-     arithmetic-5/support/numerator-and-denominator.lisp  \
-     arithmetic-5/support/prefer-times.lisp  \
-     arithmetic-5/support/top.lisp  \
-     arithmetic-5/top.lisp  \
-     arithmetic/abs.lisp  \
-     arithmetic/binomial.lisp  \
-     arithmetic/equalities.acl2  \
-     arithmetic/equalities.lisp  \
-     arithmetic/factorial.lisp  \
-     arithmetic/idiv.lisp  \
-     arithmetic/inequalities.lisp  \
-     arithmetic/mod-gcd.lisp  \
-     arithmetic/nat-listp.lisp  \
-     arithmetic/natp-posp.lisp  \
-     arithmetic/rational-listp.lisp  \
-     arithmetic/rationals.lisp  \
-     arithmetic/sumlist.lisp  \
-     arithmetic/top-with-meta.lisp  \
-     arithmetic/top.lisp  \
-     bdd/alu-proofs.lisp  \
-     bdd/alu.lisp  \
-     bdd/bdd-primitives.lisp  \
-     bdd/bool-ops.lisp  \
-     bdd/cbf.lisp  \
-     bdd/hamming.lisp  \
-     bdd/pg-theory.lisp  \
-     centaur/4v-sexpr/4v-logic.lisp  \
-     centaur/4v-sexpr/bitspecs.lisp  \
-     centaur/4v-sexpr/cert.acl2  \
-     centaur/4v-sexpr/compose-sexpr.lisp  \
-     centaur/4v-sexpr/g-sexpr-eval.acl2  \
-     centaur/4v-sexpr/g-sexpr-eval.lisp  \
-     centaur/4v-sexpr/nsexprs.lisp  \
-     centaur/4v-sexpr/onehot-rewrite.lisp  \
-     centaur/4v-sexpr/portcullis.acl2  \
-     centaur/4v-sexpr/portcullis.lisp  \
-     centaur/4v-sexpr/sexpr-3v.lisp  \
-     centaur/4v-sexpr/sexpr-advanced.lisp  \
-     centaur/4v-sexpr/sexpr-building.lisp  \
-     centaur/4v-sexpr/sexpr-equivs.lisp  \
-     centaur/4v-sexpr/sexpr-eval.lisp  \
-     centaur/4v-sexpr/sexpr-fixpoint-correct.lisp  \
-     centaur/4v-sexpr/sexpr-fixpoint-rewriting.lisp  \
-     centaur/4v-sexpr/sexpr-fixpoint-spec.lisp  \
-     centaur/4v-sexpr/sexpr-fixpoint-top.lisp  \
-     centaur/4v-sexpr/sexpr-fixpoint.lisp  \
-     centaur/4v-sexpr/sexpr-loop-debug.lisp  \
-     centaur/4v-sexpr/sexpr-rewrites.lisp  \
-     centaur/4v-sexpr/sexpr-to-faig.lisp  \
-     centaur/4v-sexpr/sexpr-vars-1pass.lisp  \
-     centaur/4v-sexpr/sexpr-vars.lisp  \
-     centaur/4v-sexpr/svarmap.lisp  \
-     centaur/4v-sexpr/top.lisp  \
-     centaur/aig/aig-equivs.lisp  \
-     centaur/aig/aig-vars-ext.lisp  \
-     centaur/aig/aig-vars.lisp  \
-     centaur/aig/aiger.lisp  \
-     centaur/aig/base.lisp  \
-     centaur/aig/bddify-correct.lisp  \
-     centaur/aig/bddify.lisp  \
-     centaur/aig/cert.acl2  \
-     centaur/aig/eval-restrict.lisp  \
-     centaur/aig/fsm-pkg.lsp  \
-     centaur/aig/g-aig-eval.acl2  \
-     centaur/aig/g-aig-eval.lisp  \
-     centaur/aig/induction.lisp  \
-     centaur/aig/misc.lisp  \
-     centaur/aig/portcullis.acl2  \
-     centaur/aig/portcullis.lisp  \
-     centaur/aig/three-four.lisp  \
-     centaur/aig/vuaig.lisp  \
-     centaur/aig/witness.acl2  \
-     centaur/aig/witness.lisp  \
-     centaur/aignet/package.lsp  \
-     centaur/bitops/bits-between.lisp  \
-     centaur/bitops/bitsets-opt.lisp  \
-     centaur/bitops/bitsets.lisp  \
-     centaur/bitops/cert.acl2  \
-     centaur/bitops/congruences.lisp  \
-     centaur/bitops/equal-by-logbitp.lisp  \
-     centaur/bitops/extra-defs.lisp  \
-     centaur/bitops/ihs-extensions.lisp  \
-     centaur/bitops/ihsext-basics.lisp  \
-     centaur/bitops/install-bit.lisp  \
-     centaur/bitops/integer-length.lisp  \
-     centaur/bitops/part-select.lisp  \
-     centaur/bitops/rotate.lisp  \
-     centaur/bitops/sbitsets.lisp  \
-     centaur/bitops/sign-extend.lisp  \
-     centaur/bitops/top.lisp  \
-     centaur/bridge/cert.acl2  \
-     centaur/bridge/package.lsp  \
-     centaur/bridge/portcullis.acl2  \
-     centaur/bridge/portcullis.lisp  \
-     centaur/bridge/to-json.lisp  \
-     centaur/bridge/top.lisp  \
-     centaur/defrstobj/array-lemmas.lisp  \
-     centaur/defrstobj/basic-tests.lisp  \
-     centaur/defrstobj/cert.acl2  \
-     centaur/defrstobj/def-typed-record.lisp  \
-     centaur/defrstobj/defrstobj.lisp  \
-     centaur/defrstobj/fancy-worseguy.lisp  \
-     centaur/defrstobj/g-delete-keys.lisp  \
-     centaur/defrstobj/groundwork/array-rec.lisp  \
-     centaur/defrstobj/groundwork/cert.acl2  \
-     centaur/defrstobj/groundwork/demo1.lisp  \
-     centaur/defrstobj/groundwork/demo2.lisp  \
-     centaur/defrstobj/groundwork/demo3.lisp  \
-     centaur/defrstobj/groundwork/demo4.lisp  \
-     centaur/defrstobj/groundwork/demo5.lisp  \
-     centaur/defrstobj/groundwork/local.lisp  \
-     centaur/defrstobj/package.lsp  \
-     centaur/defrstobj/portcullis.acl2  \
-     centaur/defrstobj/portcullis.lisp  \
-     centaur/defrstobj/typed-record-tests.lisp  \
-     centaur/defrstobj/typed-records.lisp  \
-     centaur/esim/cert.acl2  \
-     centaur/esim/esim-paths.lisp  \
-     centaur/esim/esim-primitives.lisp  \
-     centaur/esim/esim-sexpr-correct.lisp  \
-     centaur/esim/esim-sexpr-support-thms.lisp  \
-     centaur/esim/esim-sexpr-support.lisp  \
-     centaur/esim/esim-sexpr.lisp  \
-     centaur/esim/esim-spec.lisp  \
-     centaur/esim/esim-vcd.lisp  \
-     centaur/esim/esim-vl.lisp  \
-     centaur/esim/follow-backwards.lisp  \
-     centaur/esim/local-theory.lisp  \
-     centaur/esim/packages.lsp  \
-     centaur/esim/plist.lisp  \
-     centaur/esim/portcullis.acl2  \
-     centaur/esim/portcullis.lisp  \
-     centaur/esim/steps.lisp  \
-     centaur/esim/stv/cert.acl2  \
-     centaur/esim/stv/stv-compile.lisp  \
-     centaur/esim/stv/stv-debug.lisp  \
-     centaur/esim/stv/stv-doc.lisp  \
-     centaur/esim/stv/stv-expand.lisp  \
-     centaur/esim/stv/stv-run.lisp  \
-     centaur/esim/stv/stv-sim.lisp  \
-     centaur/esim/stv/stv-top.lisp  \
-     centaur/esim/stv/stv-util.lisp  \
-     centaur/esim/stv/stv-widen.lisp  \
-     centaur/gl/always-equal-prep.lisp  \
-     centaur/gl/auto-bindings.lisp  \
-     centaur/gl/bfr-aig-bddify.lisp  \
-     centaur/gl/bfr-sat.lisp  \
-     centaur/gl/bfr.lisp  \
-     centaur/gl/bvec-ite.lisp  \
-     centaur/gl/bvecs.lisp  \
-     centaur/gl/cert.acl2  \
-     centaur/gl/def-gl-clause-proc.lisp  \
-     centaur/gl/defagg.lisp  \
-     centaur/gl/defapply.lisp  \
-     centaur/gl/eval-f-i-cp.lisp  \
-     centaur/gl/eval-g-base-help.lisp  \
-     centaur/gl/eval-g-base.lisp  \
-     centaur/gl/factor-fns.lisp  \
-     centaur/gl/g-always-equal.lisp  \
-     centaur/gl/g-ash.lisp  \
-     centaur/gl/g-binary-+.lisp  \
-     centaur/gl/g-binary-mult.lisp  \
-     centaur/gl/g-code-char.lisp  \
-     centaur/gl/g-coerce.lisp  \
-     centaur/gl/g-cons.lisp  \
-     centaur/gl/g-equal.lisp  \
-     centaur/gl/g-floor.lisp  \
-     centaur/gl/g-gl-mbe.lisp  \
-     centaur/gl/g-hide.lisp  \
-     centaur/gl/g-if.lisp  \
-     centaur/gl/g-integer-length.lisp  \
-     centaur/gl/g-intern.lisp  \
-     centaur/gl/g-lessthan.lisp  \
-     centaur/gl/g-logand.lisp  \
-     centaur/gl/g-logbitp.lisp  \
-     centaur/gl/g-logior.lisp  \
-     centaur/gl/g-lognot.lisp  \
-     centaur/gl/g-make-fast-alist.lisp  \
-     centaur/gl/g-mod.lisp  \
-     centaur/gl/g-predicates.lisp  \
-     centaur/gl/g-primitives-help.lisp  \
-     centaur/gl/g-rem.lisp  \
-     centaur/gl/g-truncate.lisp  \
-     centaur/gl/g-unary--.lisp  \
-     centaur/gl/g-unary-concrete.lisp  \
-     centaur/gl/general-object-thms.lisp  \
-     centaur/gl/general-objects.lisp  \
-     centaur/gl/generic-geval.lisp  \
-     centaur/gl/gify-clause-proc.lisp  \
-     centaur/gl/gify-thms.lisp  \
-     centaur/gl/gify.lisp  \
-     centaur/gl/gl-doc-string.lisp  \
-     centaur/gl/gl-generic-clause-proc.lisp  \
-     centaur/gl/gl-mbe.lisp  \
-     centaur/gl/gl-misc-defs.lisp  \
-     centaur/gl/gl-misc-doc.lisp  \
-     centaur/gl/gl-util.lisp  \
-     centaur/gl/gl.lisp  \
-     centaur/gl/glcp-templates.lisp  \
-     centaur/gl/gobject-type-thms.lisp  \
-     centaur/gl/gobject-types.lisp  \
-     centaur/gl/gobjectp-thms.lisp  \
-     centaur/gl/gobjectp.lisp  \
-     centaur/gl/gtests.lisp  \
-     centaur/gl/gtype-thms.lisp  \
-     centaur/gl/gtypes.lisp  \
-     centaur/gl/hyp-fix-logic.lisp  \
-     centaur/gl/hyp-fix.lisp  \
-     centaur/gl/ite-merge.lisp  \
-     centaur/gl/package.lsp  \
-     centaur/gl/param.lisp  \
-     centaur/gl/portcullis.acl2  \
-     centaur/gl/portcullis.lisp  \
-     centaur/gl/run-gified-cp.lisp  \
-     centaur/gl/rws.lisp  \
-     centaur/gl/shape-spec.lisp  \
-     centaur/gl/symbolic-arithmetic-fns.lisp  \
-     centaur/gl/symbolic-arithmetic.lisp  \
-     centaur/misc/absstobjs.lisp  \
-     centaur/misc/alist-defs.lisp  \
-     centaur/misc/alist-equiv.lisp  \
-     centaur/misc/alist-witness.lisp  \
-     centaur/misc/ap.lisp  \
-     centaur/misc/arith-equivs.lisp  \
-     centaur/misc/context-rw.acl2  \
-     centaur/misc/context-rw.lisp  \
-     centaur/misc/defapply.lisp  \
-     centaur/misc/dfs-measure.lisp  \
-     centaur/misc/equal-by-nths.lisp  \
-     centaur/misc/equal-sets.acl2  \
-     centaur/misc/equal-sets.lisp  \
-     centaur/misc/evaluator-metatheorems.lisp  \
-     centaur/misc/fal-graphs.lisp  \
-     centaur/misc/fast-alists.lisp  \
-     centaur/misc/filter-alist.lisp  \
-     centaur/misc/hons-alphorder-merge.acl2  \
-     centaur/misc/hons-alphorder-merge.lisp  \
-     centaur/misc/hons-extra.lisp  \
-     centaur/misc/hons-remove-dups.lisp  \
-     centaur/misc/hons-sets.lisp  \
-     centaur/misc/interp-function-lookup.lisp  \
-     centaur/misc/introduce-var.acl2  \
-     centaur/misc/introduce-var.lisp  \
-     centaur/misc/lists.lisp  \
-     centaur/misc/load-stobj-tests.lisp  \
-     centaur/misc/load-stobj.lisp  \
-     centaur/misc/memory-mgmt-logic.lisp  \
-     centaur/misc/memory-mgmt-raw.lisp  \
-     centaur/misc/mfc-utils.lisp  \
-     centaur/misc/nat-list-duplicates.lisp  \
-     centaur/misc/numlist.lisp  \
-     centaur/misc/osets-witnessing.acl2  \
-     centaur/misc/osets-witnessing.lisp  \
-     centaur/misc/patterns.lisp  \
-     centaur/misc/seed-random.lisp  \
-     centaur/misc/smm-impl.lisp  \
-     centaur/misc/smm.lisp  \
-     centaur/misc/sneaky-load.lisp  \
-     centaur/misc/suffixp.lisp  \
-     centaur/misc/tailrec.acl2  \
-     centaur/misc/tailrec.lisp  \
-     centaur/misc/top.lisp  \
-     centaur/misc/tshell.lisp  \
-     centaur/misc/tuplep.lisp  \
-     centaur/misc/u32-listp.lisp  \
-     centaur/misc/universal-equiv.lisp  \
-     centaur/misc/vecs-ints.lisp  \
-     centaur/misc/witness-cp.lisp  \
-     centaur/satlink/package.lsp  \
-     centaur/ubdds/cert.acl2  \
-     centaur/ubdds/core.lisp  \
-     centaur/ubdds/extra-operations.lisp  \
-     centaur/ubdds/lite.lisp  \
-     centaur/ubdds/param.lisp  \
-     centaur/ubdds/sanity-check-macros.lisp  \
-     centaur/ubdds/subset.lisp  \
-     centaur/ubdds/witness.acl2  \
-     centaur/ubdds/witness.lisp  \
-     centaur/vl/cert.acl2  \
-     centaur/vl/checkers/cert.acl2  \
-     centaur/vl/checkers/checkers.lisp  \
-     centaur/vl/checkers/condcheck.lisp  \
-     centaur/vl/checkers/dupeinst-check.lisp  \
-     centaur/vl/checkers/duperhs.lisp  \
-     centaur/vl/checkers/duplicate-detect.lisp  \
-     centaur/vl/checkers/leftright.lisp  \
-     centaur/vl/checkers/multidrive-detect.lisp  \
-     centaur/vl/checkers/oddexpr.lisp  \
-     centaur/vl/checkers/portcheck.lisp  \
-     centaur/vl/checkers/qmarksize-check.lisp  \
-     centaur/vl/checkers/selfassigns.lisp  \
-     centaur/vl/checkers/skip-detect.lisp  \
-     centaur/vl/checkers/typo-detect.lisp  \
-     centaur/vl/checkers/use-set-report.lisp  \
-     centaur/vl/checkers/use-set-tool.lisp  \
-     centaur/vl/checkers/use-set.lisp  \
-     centaur/vl/lint/bit-use-set.lisp  \
-     centaur/vl/lint/cert.acl2  \
-     centaur/vl/lint/check-case.lisp  \
-     centaur/vl/lint/check-namespace.lisp  \
-     centaur/vl/lint/disconnected.lisp  \
-     centaur/vl/lint/lint.acl2  \
-     centaur/vl/lint/lint.lisp  \
-     centaur/vl/lint/use-set-ignore.lisp  \
-     centaur/vl/lint/xf-drop-missing-submodules.lisp  \
-     centaur/vl/lint/xf-drop-unresolved-submodules.lisp  \
-     centaur/vl/lint/xf-lint-stmt-rewrite.lisp  \
-     centaur/vl/lint/xf-remove-toohard.lisp  \
-     centaur/vl/lint/xf-suppress-warnings.lisp  \
-     centaur/vl/lint/xf-undefined-names.lisp  \
-     centaur/vl/loader/cert.acl2  \
-     centaur/vl/loader/defines.lisp  \
-     centaur/vl/loader/filemap.lisp  \
-     centaur/vl/loader/find-file.lisp  \
-     centaur/vl/loader/inject-comments.lisp  \
-     centaur/vl/loader/lexer-tests.lisp  \
-     centaur/vl/loader/lexer-tokens.lisp  \
-     centaur/vl/loader/lexer-utils.lisp  \
-     centaur/vl/loader/lexer.lisp  \
-     centaur/vl/loader/loader.lisp  \
-     centaur/vl/loader/make-implicit-wires.lisp  \
-     centaur/vl/loader/overrides.lisp  \
-     centaur/vl/loader/parse-blockitems.lisp  \
-     centaur/vl/loader/parse-delays.lisp  \
-     centaur/vl/loader/parse-error.lisp  \
-     centaur/vl/loader/parse-eventctrl.lisp  \
-     centaur/vl/loader/parse-expressions-def.lisp  \
-     centaur/vl/loader/parse-expressions-eof.lisp  \
-     centaur/vl/loader/parse-expressions-error.lisp  \
-     centaur/vl/loader/parse-expressions-progress.lisp  \
-     centaur/vl/loader/parse-expressions-result.lisp  \
-     centaur/vl/loader/parse-expressions-tokenlist.lisp  \
-     centaur/vl/loader/parse-expressions-warnings.lisp  \
-     centaur/vl/loader/parse-expressions.lisp  \
-     centaur/vl/loader/parse-functions.lisp  \
-     centaur/vl/loader/parse-gates.lisp  \
-     centaur/vl/loader/parse-insts.lisp  \
-     centaur/vl/loader/parse-lvalues.lisp  \
-     centaur/vl/loader/parse-modules.lisp  \
-     centaur/vl/loader/parse-nets.lisp  \
-     centaur/vl/loader/parse-ports.lisp  \
-     centaur/vl/loader/parse-ranges.lisp  \
-     centaur/vl/loader/parse-statements-def.lisp  \
-     centaur/vl/loader/parse-statements-error.lisp  \
-     centaur/vl/loader/parse-statements-progress.lisp  \
-     centaur/vl/loader/parse-statements-result.lisp  \
-     centaur/vl/loader/parse-statements-tokenlist.lisp  \
-     centaur/vl/loader/parse-statements-warninglist.lisp  \
-     centaur/vl/loader/parse-statements.lisp  \
-     centaur/vl/loader/parse-strengths.lisp  \
-     centaur/vl/loader/parse-utils.lisp  \
-     centaur/vl/loader/parser.lisp  \
-     centaur/vl/loader/preprocessor-tests.lisp  \
-     centaur/vl/loader/preprocessor.lisp  \
-     centaur/vl/loader/read-file.lisp  \
-     centaur/vl/mlib/allexprs.lisp  \
-     centaur/vl/mlib/atts.lisp  \
-     centaur/vl/mlib/cert.acl2  \
-     centaur/vl/mlib/clean-concats.lisp  \
-     centaur/vl/mlib/comment-writer.lisp  \
-     centaur/vl/mlib/context.lisp  \
-     centaur/vl/mlib/ctxexprs.lisp  \
-     centaur/vl/mlib/delta.lisp  \
-     centaur/vl/mlib/expr-building.lisp  \
-     centaur/vl/mlib/expr-parse.lisp  \
-     centaur/vl/mlib/expr-slice.lisp  \
-     centaur/vl/mlib/expr-tools.lisp  \
-     centaur/vl/mlib/filter.lisp  \
-     centaur/vl/mlib/find-item.lisp  \
-     centaur/vl/mlib/find-module.lisp  \
-     centaur/vl/mlib/fmt.lisp  \
-     centaur/vl/mlib/hid-tools.lisp  \
-     centaur/vl/mlib/hierarchy.lisp  \
-     centaur/vl/mlib/lvalues-mentioning.lisp  \
-     centaur/vl/mlib/lvalues.lisp  \
-     centaur/vl/mlib/modname-sets.lisp  \
-     centaur/vl/mlib/modnamespace.lisp  \
-     centaur/vl/mlib/namefactory.lisp  \
-     centaur/vl/mlib/namemangle.lisp  \
-     centaur/vl/mlib/port-tools.lisp  \
-     centaur/vl/mlib/print-context.lisp  \
-     centaur/vl/mlib/print-warnings.lisp  \
-     centaur/vl/mlib/range-tools.lisp  \
-     centaur/vl/mlib/relocate.lisp  \
-     centaur/vl/mlib/remove-bad.lisp  \
-     centaur/vl/mlib/rvalues.lisp  \
-     centaur/vl/mlib/stmt-tools.lisp  \
-     centaur/vl/mlib/sub-counts.lisp  \
-     centaur/vl/mlib/warnings.lisp  \
-     centaur/vl/mlib/welltyped.lisp  \
-     centaur/vl/mlib/writer.lisp  \
-     centaur/vl/onehot.lisp  \
-     centaur/vl/other-packages.lsp  \
-     centaur/vl/package.lsp  \
-     centaur/vl/parsetree.lisp  \
-     centaur/vl/portcullis.acl2  \
-     centaur/vl/portcullis.lisp  \
-     centaur/vl/primitives.lisp  \
-     centaur/vl/toe/cert.acl2  \
-     centaur/vl/toe/toe-add-res-modules.lisp  \
-     centaur/vl/toe/toe-add-zdrivers.lisp  \
-     centaur/vl/toe/toe-emodwire.lisp  \
-     centaur/vl/toe/toe-eocc-allnames.lisp  \
-     centaur/vl/toe/toe-preliminary.lisp  \
-     centaur/vl/toe/toe-top.lisp  \
-     centaur/vl/toe/toe-verilogify.lisp  \
-     centaur/vl/toe/toe-wirealist.lisp  \
-     centaur/vl/top.acl2  \
-     centaur/vl/top.lisp  \
-     centaur/vl/transforms/always/cert.acl2  \
-     centaur/vl/transforms/always/conditions.lisp  \
-     centaur/vl/transforms/always/elimalways.lisp  \
-     centaur/vl/transforms/always/eliminitial.lisp  \
-     centaur/vl/transforms/always/elimnegedge.lisp  \
-     centaur/vl/transforms/always/flopcode-debug.lisp  \
-     centaur/vl/transforms/always/flopcode-prog.lisp  \
-     centaur/vl/transforms/always/flopcode-synth.lisp  \
-     centaur/vl/transforms/always/ifmerge.lisp  \
-     centaur/vl/transforms/always/latchcode.lisp  \
-     centaur/vl/transforms/always/make-flop.lisp  \
-     centaur/vl/transforms/always/make-latch.lisp  \
-     centaur/vl/transforms/always/stmtrewrite.lisp  \
-     centaur/vl/transforms/always/stmttemps.lisp  \
-     centaur/vl/transforms/always/synthalways.lisp  \
-     centaur/vl/transforms/always/top.lisp  \
-     centaur/vl/transforms/always/unelse.lisp  \
-     centaur/vl/transforms/always/util.lisp  \
-     centaur/vl/transforms/cert.acl2  \
-     centaur/vl/transforms/cn-hooks.lisp  \
-     centaur/vl/transforms/occform/add.lisp  \
-     centaur/vl/transforms/occform/cert.acl2  \
-     centaur/vl/transforms/occform/compare.lisp  \
-     centaur/vl/transforms/occform/div.lisp  \
-     centaur/vl/transforms/occform/mul.lisp  \
-     centaur/vl/transforms/occform/select.lisp  \
-     centaur/vl/transforms/occform/shl.lisp  \
-     centaur/vl/transforms/occform/shr.lisp  \
-     centaur/vl/transforms/occform/simple.lisp  \
-     centaur/vl/transforms/occform/top.lisp  \
-     centaur/vl/transforms/occform/util.lisp  \
-     centaur/vl/transforms/occform/xdet.lisp  \
-     centaur/vl/transforms/xf-addinstnames.lisp  \
-     centaur/vl/transforms/xf-annotate-mods.lisp  \
-     centaur/vl/transforms/xf-argresolve.lisp  \
-     centaur/vl/transforms/xf-array-indexing.lisp  \
-     centaur/vl/transforms/xf-assign-trunc.lisp  \
-     centaur/vl/transforms/xf-blankargs.lisp  \
-     centaur/vl/transforms/xf-clean-params.lisp  \
-     centaur/vl/transforms/xf-clean-selects.lisp  \
-     centaur/vl/transforms/xf-delayredux.lisp  \
-     centaur/vl/transforms/xf-designregs.lisp  \
-     centaur/vl/transforms/xf-designwires.lisp  \
-     centaur/vl/transforms/xf-drop-blankports.lisp  \
-     centaur/vl/transforms/xf-elim-supply.lisp  \
-     centaur/vl/transforms/xf-expand-functions.lisp  \
-     centaur/vl/transforms/xf-expr-simp.lisp  \
-     centaur/vl/transforms/xf-expr-split.lisp  \
-     centaur/vl/transforms/xf-follow-hids.lisp  \
-     centaur/vl/transforms/xf-gate-elim.lisp  \
-     centaur/vl/transforms/xf-gateredux.lisp  \
-     centaur/vl/transforms/xf-gatesplit.lisp  \
-     centaur/vl/transforms/xf-hid-elim.lisp  \
-     centaur/vl/transforms/xf-inline.lisp  \
-     centaur/vl/transforms/xf-oprewrite.lisp  \
-     centaur/vl/transforms/xf-optimize-rw.lisp  \
-     centaur/vl/transforms/xf-orig.lisp  \
-     centaur/vl/transforms/xf-portdecl-sign.lisp  \
-     centaur/vl/transforms/xf-propagate.lisp  \
-     centaur/vl/transforms/xf-replicate-insts.lisp  \
-     centaur/vl/transforms/xf-resolve-ranges.lisp  \
-     centaur/vl/transforms/xf-sizing.lisp  \
-     centaur/vl/transforms/xf-subst.lisp  \
-     centaur/vl/transforms/xf-unparameterize.lisp  \
-     centaur/vl/transforms/xf-unused-reg.lisp  \
-     centaur/vl/transforms/xf-weirdint-elim.lisp  \
-     centaur/vl/translation.lisp  \
-     centaur/vl/util/arithmetic.lisp  \
-     centaur/vl/util/bits.lisp  \
-     centaur/vl/util/cert.acl2  \
-     centaur/vl/util/character-list-listp.lisp  \
-     centaur/vl/util/clean-alist.lisp  \
-     centaur/vl/util/commentmap.lisp  \
-     centaur/vl/util/cw-unformatted.lisp  \
-     centaur/vl/util/cwtime.lisp  \
-     centaur/vl/util/defs.lisp  \
-     centaur/vl/util/defwellformed.lisp  \
-     centaur/vl/util/echars.lisp  \
-     centaur/vl/util/esim-lemmas.lisp  \
-     centaur/vl/util/gc.lisp  \
-     centaur/vl/util/intersectp-equal.lisp  \
-     centaur/vl/util/namedb.lisp  \
-     centaur/vl/util/nat-alists.lisp  \
-     centaur/vl/util/next-power-of-2.lisp  \
-     centaur/vl/util/osets.lisp  \
-     centaur/vl/util/position.lisp  \
-     centaur/vl/util/prefix-hash.lisp  \
-     centaur/vl/util/prefixp.lisp  \
-     centaur/vl/util/print-htmlencode.lisp  \
-     centaur/vl/util/print-urlencode.lisp  \
-     centaur/vl/util/print.lisp  \
-     centaur/vl/util/string-alists.lisp  \
-     centaur/vl/util/subsetp-equal.lisp  \
-     centaur/vl/util/sum-nats.lisp  \
-     centaur/vl/util/toposort.lisp  \
-     centaur/vl/util/warnings.lisp  \
-     centaur/vl/wf-ranges-resolved-p.lisp  \
-     centaur/vl/wf-reasonable-p.lisp  \
-     centaur/vl/wf-widthsfixed-p.lisp  \
-     clause-processors/SULFA/books/sat/sat-package.acl2  \
-     clause-processors/autohide.acl2  \
-     clause-processors/autohide.lisp  \
-     clause-processors/basic-examples.acl2  \
-     clause-processors/basic-examples.lisp  \
-     clause-processors/bv-add-common.lisp  \
-     clause-processors/bv-add-tests.lisp  \
-     clause-processors/bv-add.lisp  \
-     clause-processors/decomp-hint.lisp  \
-     clause-processors/equality.acl2  \
-     clause-processors/equality.lisp  \
-     clause-processors/ev-find-rules.lisp  \
-     clause-processors/ev-theoremp.lisp  \
-     clause-processors/find-subterms.lisp  \
-     clause-processors/generalize.acl2  \
-     clause-processors/generalize.lisp  \
-     clause-processors/instantiate.lisp  \
-     clause-processors/join-thms.lisp  \
-     clause-processors/just-expand.lisp  \
-     clause-processors/meta-extract-simple-test.lisp  \
-     clause-processors/meta-extract-user.lisp  \
-     clause-processors/multi-env-trick.lisp  \
-     clause-processors/null-fail-hints.lisp  \
-     clause-processors/nvalues-thms.lisp  \
-     clause-processors/replace-defined-consts.acl2  \
-     clause-processors/replace-defined-consts.lisp  \
-     clause-processors/replace-impl.lisp  \
-     clause-processors/stobj-preservation.lisp  \
-     clause-processors/sublis-var-meaning.lisp  \
-     clause-processors/term-patterns.acl2  \
-     clause-processors/term-patterns.lisp  \
-     clause-processors/unify-subst.acl2  \
-     clause-processors/unify-subst.lisp  \
-     clause-processors/use-by-hint.lisp  \
-     clause-processors/witness-cp.acl2  \
-     clause-processors/witness-cp.lisp  \
-     coi/adviser/adviser-defpkg.lsp  \
-     coi/adviser/adviser-pkg.lisp  \
-     coi/adviser/adviser.lisp  \
-     coi/adviser/cert.acl2  \
-     coi/adviser/test.lisp  \
-     coi/alists/alist-defpkg.lsp  \
-     coi/alists/alist-pkg.lisp  \
-     coi/alists/bindequiv.lisp  \
-     coi/alists/cert.acl2  \
-     coi/alists/clearkey.lisp  \
-     coi/alists/deshadow.lisp  \
-     coi/alists/equiv.lisp  \
-     coi/alists/keyquiv.lisp  \
-     coi/alists/preimage.lisp  \
-     coi/alists/strip.lisp  \
-     coi/alists/subkeyquiv.lisp  \
-     coi/alists/top.lisp  \
-     coi/bags/bag-defpkg.lsp  \
-     coi/bags/bag-exports.lsp  \
-     coi/bags/basic.lisp  \
-     coi/bags/bind-free-rules.lisp  \
-     coi/bags/cert.acl2  \
-     coi/bags/cons.lisp  \
-     coi/bags/eric-meta.lisp  \
-     coi/bags/extras.lisp  \
-     coi/bags/meta.lisp  \
-     coi/bags/neq.lisp  \
-     coi/bags/pick-a-point.lisp  \
-     coi/bags/top.lisp  \
-     coi/bags/two-level-meta.lisp  \
-     coi/bags/two-level.lisp  \
-     coi/defpun/ack.lisp  \
-     coi/defpun/defminterm.lisp  \
-     coi/defpun/defpun.lisp  \
-     coi/defpun/defxch.lisp  \
-     coi/defstructure/cert.acl2  \
-     coi/defstructure/defstructure-pkg.lisp  \
-     coi/defstructure/defstructure.lisp  \
-     coi/defstructure/structures-defpkg.lsp  \
-     coi/dtrees/base.lisp  \
-     coi/dtrees/cert.acl2  \
-     coi/dtrees/child.lisp  \
-     coi/dtrees/deps.lisp  \
-     coi/dtrees/dtree-defpkg.lsp  \
-     coi/dtrees/equiv.lisp  \
-     coi/dtrees/erase.lisp  \
-     coi/dtrees/leafp.lisp  \
-     coi/dtrees/raw.lisp  \
-     coi/dtrees/royalp.lisp  \
-     coi/dtrees/set.lisp  \
-     coi/dtrees/top.lisp  \
-     coi/gacc/abstract-gacc.lisp  \
-     coi/gacc/addr-range.lisp  \
-     coi/gacc/bits.lisp  \
-     coi/gacc/block.lisp  \
-     coi/gacc/cert.acl2  \
-     coi/gacc/finite.acl2  \
-     coi/gacc/finite.lisp  \
-     coi/gacc/fr-path-connection.acl2  \
-     coi/gacc/fr-path-connection.lisp  \
-     coi/gacc/gacc-defpkg.lsp  \
-     coi/gacc/gacc-exports.lisp  \
-     coi/gacc/gacc-pkg.lisp  \
-     coi/gacc/gacc.acl2  \
-     coi/gacc/gacc.lisp  \
-     coi/gacc/gacc2.acl2  \
-     coi/gacc/gacc2.lisp  \
-     coi/gacc/gacc3.acl2  \
-     coi/gacc/gacc3.lisp  \
-     coi/gacc/gax.acl2  \
-     coi/gacc/gax.lisp  \
-     coi/gacc/list-ops-common.lisp  \
-     coi/gacc/list-ops-fast.acl2  \
-     coi/gacc/list-ops-fast.lisp  \
-     coi/gacc/list-ops.lisp  \
-     coi/gacc/mem-fast.acl2  \
-     coi/gacc/mem-fast.lisp  \
-     coi/gacc/mem.lisp  \
-     coi/gacc/ram.lisp  \
-     coi/gacc/ram0.lisp  \
-     coi/gacc/ram2.acl2  \
-     coi/gacc/ram2.lisp  \
-     coi/gacc/ram2b.acl2  \
-     coi/gacc/ram2b.lisp  \
-     coi/gacc/ram3.acl2  \
-     coi/gacc/ram3.lisp  \
-     coi/gacc/top.acl2  \
-     coi/gacc/top.lisp  \
-     coi/gacc/tr-path-connection.acl2  \
-     coi/gacc/tr-path-connection.lisp  \
-     coi/gacc/wrap.lisp  \
-     coi/generalize/cert.acl2  \
-     coi/generalize/generalize.lisp  \
-     coi/gensym/cert.acl2  \
-     coi/gensym/gensym-list.lisp  \
-     coi/gensym/gensym.lisp  \
-     coi/lists/acl2-count.lisp  \
-     coi/lists/basic.lisp  \
-     coi/lists/cert.acl2  \
-     coi/lists/disjoint.lisp  \
-     coi/lists/find-index.lisp  \
-     coi/lists/list-defpkg.lsp  \
-     coi/lists/list-exports.lsp  \
-     coi/lists/list-top.lisp  \
-     coi/lists/listset-induction.lisp  \
-     coi/lists/map-cons.lisp  \
-     coi/lists/memberp.lisp  \
-     coi/lists/mixed.lisp  \
-     coi/lists/mv-nth.lisp  \
-     coi/lists/nth-and-update-nth.lisp  \
-     coi/lists/nth-meta.lisp  \
-     coi/lists/nth-meta2.lisp  \
-     coi/lists/remove-induction.lisp  \
-     coi/lists/remove.lisp  \
-     coi/lists/repeat.lisp  \
-     coi/lists/set.lisp  \
-     coi/lists/subsetp.lisp  \
-     coi/lists/update-nth-array.lisp  \
-     coi/maps/aliases.lisp  \
-     coi/maps/cert.acl2  \
-     coi/maps/map-defpkg.lsp  \
-     coi/maps/map-exports.lsp  \
-     coi/maps/maps.lisp  \
-     coi/maps/typed-maps.lisp  \
-     coi/nary/cert.acl2  \
-     coi/nary/example.lisp  \
-     coi/nary/nary.lisp  \
-     coi/nary/nth-rules.lisp  \
-     coi/nary/ordinal-order.lisp  \
-     coi/nary/rewrite-equal-hint.lisp  \
-     coi/osets/cert.acl2  \
-     coi/osets/computed-hints-defpkg.lsp  \
-     coi/osets/computed-hints.lisp  \
-     coi/osets/conversions.lisp  \
-     coi/osets/extras.lisp  \
-     coi/osets/fast.lisp  \
-     coi/osets/instance-defpkg.lsp  \
-     coi/osets/instance.lisp  \
-     coi/osets/listsets.lisp  \
-     coi/osets/map.lisp  \
-     coi/osets/membership.lisp  \
-     coi/osets/multiappend.lisp  \
-     coi/osets/multicons.lisp  \
-     coi/osets/outer.lisp  \
-     coi/osets/primitives.lisp  \
-     coi/osets/quantify.lisp  \
-     coi/osets/set-defpkg.lsp  \
-     coi/osets/set-order.lisp  \
-     coi/osets/set-processor.lisp  \
-     coi/osets/sets.lisp  \
-     coi/osets/sort.lisp  \
-     coi/paths/cert.acl2  \
-     coi/paths/compatibility.lisp  \
-     coi/paths/cp-set.lisp  \
-     coi/paths/defs.lisp  \
-     coi/paths/diverge.lisp  \
-     coi/paths/dominates.lisp  \
-     coi/paths/equiv.lisp  \
-     coi/paths/hints.lisp  \
-     coi/paths/list-path-connection.lisp  \
-     coi/paths/meta.lisp  \
-     coi/paths/path-defpkg.lsp  \
-     coi/paths/path.lisp  \
-     coi/paths/pm.lisp  \
-     coi/quantification/cert.acl2  \
-     coi/quantification/quant-defpkg.lsp  \
-     coi/quantification/quantification.acl2  \
-     coi/quantification/quantification.lisp  \
-     coi/records/cert.acl2  \
-     coi/records/defarray.acl2  \
-     coi/records/defarray.lisp  \
-     coi/records/defrecord-fast.acl2  \
-     coi/records/defrecord-fast.lisp  \
-     coi/records/defrecord.lisp  \
-     coi/records/domain.acl2  \
-     coi/records/domain.lisp  \
-     coi/records/fixedpoint.acl2  \
-     coi/records/fixedpoint.lisp  \
-     coi/records/mem-domain.lisp  \
-     coi/records/memory.lisp  \
-     coi/records/rec-defpkg.lsp  \
-     coi/records/record-exports.lisp  \
-     coi/records/record-exports.lsp  \
-     coi/records/records.lisp  \
-     coi/records/set-domain.lisp  \
-     coi/super-ihs/arithmetic.lisp  \
-     coi/super-ihs/ash.lisp  \
-     coi/super-ihs/basics.lisp  \
-     coi/super-ihs/bit-functions.lisp  \
-     coi/super-ihs/bit-twiddling-logops.lisp  \
-     coi/super-ihs/byte-p.lisp  \
-     coi/super-ihs/c-functions.lisp  \
-     coi/super-ihs/carry.lisp  \
-     coi/super-ihs/cert.acl2  \
-     coi/super-ihs/eric.lisp  \
-     coi/super-ihs/evenp.lisp  \
-     coi/super-ihs/fast.lisp  \
-     coi/super-ihs/from-rtl.lisp  \
-     coi/super-ihs/hacks.lisp  \
-     coi/super-ihs/inductions.lisp  \
-     coi/super-ihs/iter-sqrt.lisp  \
-     coi/super-ihs/logapp.lisp  \
-     coi/super-ihs/logbit.lisp  \
-     coi/super-ihs/logbitp.lisp  \
-     coi/super-ihs/logcar.lisp  \
-     coi/super-ihs/logcdr.lisp  \
-     coi/super-ihs/logcons.lisp  \
-     coi/super-ihs/logext.lisp  \
-     coi/super-ihs/loghead.lisp  \
-     coi/super-ihs/logical-logops.lisp  \
-     coi/super-ihs/logior-logapp-crock.lisp  \
-     coi/super-ihs/loglist.lisp  \
-     coi/super-ihs/logpair.lisp  \
-     coi/super-ihs/logtail.lisp  \
-     coi/super-ihs/lshu.lisp  \
-     coi/super-ihs/meta.lisp  \
-     coi/super-ihs/min-max.lisp  \
-     coi/super-ihs/plus-logapp-suck.lisp  \
-     coi/super-ihs/signed-byte-p-overflow.lisp  \
-     coi/super-ihs/super-ihs.lisp  \
-     coi/super-ihs/symbols-defpkg.lsp  \
-     coi/super-ihs/symbols.lsp  \
-     coi/super-ihs/unsigned-byte-p.lisp  \
-     coi/symbol-fns/cert.acl2  \
-     coi/symbol-fns/symbol-fns-defpkg.lsp  \
-     coi/symbol-fns/symbol-fns-exports.lisp  \
-     coi/symbol-fns/symbol-fns-exports.lsp  \
-     coi/symbol-fns/symbol-fns.lisp  \
-     coi/syntax/auxilary.lisp  \
-     coi/syntax/cert.acl2  \
-     coi/syntax/defbinding.lisp  \
-     coi/syntax/defevaluator.lisp  \
-     coi/syntax/quine.lisp  \
-     coi/syntax/syn-defpkg.lsp  \
-     coi/syntax/syn-pkg.lisp  \
-     coi/syntax/syntax-extensions.lisp  \
-     coi/syntax/syntax.lisp  \
-     coi/termination/assuming/cert.acl2  \
-     coi/termination/assuming/compiler-proof.lisp  \
-     coi/termination/assuming/compiler.lisp  \
-     coi/termination/assuming/zero.lisp  \
-     coi/util/cert.acl2  \
-     coi/util/clause-processor.lisp  \
-     coi/util/debug-defpkg.lsp  \
-     coi/util/debug.acl2  \
-     coi/util/debug.lisp  \
-     coi/util/def-defpkg.lsp  \
-     coi/util/defbinding.acl2  \
-     coi/util/defbinding.lisp  \
-     coi/util/defdoc.acl2  \
-     coi/util/defdoc.lisp  \
-     coi/util/deffix.acl2  \
-     coi/util/deffix.lisp  \
-     coi/util/defsubtype.acl2  \
-     coi/util/defsubtype.lisp  \
-     coi/util/defun-defpkg.lsp  \
-     coi/util/defun-support.acl2  \
-     coi/util/defun-support.lisp  \
-     coi/util/defun.acl2  \
-     coi/util/defun.lisp  \
-     coi/util/extra-info-test.lisp  \
-     coi/util/extra-info.lisp  \
-     coi/util/fixequiv.lisp  \
-     coi/util/gensym-defpkg.lsp  \
-     coi/util/good-rewrite-order.lisp  \
-     coi/util/ifdef.acl2  \
-     coi/util/ifdef.lisp  \
-     coi/util/iff.lisp  \
-     coi/util/ifixequiv.lisp  \
-     coi/util/implies.lisp  \
-     coi/util/in-conclusion.lisp  \
-     coi/util/ith.lisp  \
-     coi/util/mv-nth.acl2  \
-     coi/util/mv-nth.lisp  \
-     coi/util/nfixequiv.lisp  \
-     coi/util/ordinal-order.lisp  \
-     coi/util/pseudo-translate.lisp  \
-     coi/util/recursion-support.acl2  \
-     coi/util/recursion-support.lisp  \
-     coi/util/rewrite-equiv.lisp  \
-     coi/util/rule-sets-defpkg.lsp  \
-     coi/util/rule-sets-documentation.acl2  \
-     coi/util/rule-sets-documentation.lisp  \
-     coi/util/rule-sets-support.acl2  \
-     coi/util/rule-sets-support.lisp  \
-     coi/util/rule-sets.acl2  \
-     coi/util/rule-sets.lisp  \
-     coi/util/skip-rewrite.lisp  \
-     coi/util/syntaxp.lisp  \
-     coi/util/table-defpkg.lsp  \
-     coi/util/table.acl2  \
-     coi/util/table.lisp  \
-     coi/util/util-exports.lsp  \
-     concurrent-programs/bakery/apply-total-order.lisp  \
-     concurrent-programs/bakery/fairenv.lisp  \
-     concurrent-programs/bakery/final-theorems.lisp  \
-     concurrent-programs/bakery/initial-state.lisp  \
-     concurrent-programs/bakery/inv-persists.lisp  \
-     concurrent-programs/bakery/inv-sufficient.lisp  \
-     concurrent-programs/bakery/labels.lisp  \
-     concurrent-programs/bakery/lexicographic-pos.lisp  \
-     concurrent-programs/bakery/lexicographic.lisp  \
-     concurrent-programs/bakery/measures.lisp  \
-     concurrent-programs/bakery/pos-temp.lisp  \
-     concurrent-programs/bakery/programs.lisp  \
-     concurrent-programs/bakery/properties-of-sets.lisp  \
-     concurrent-programs/bakery/properties.lisp  \
-     concurrent-programs/bakery/records.lisp  \
-     concurrent-programs/bakery/stutter1-match.lisp  \
-     concurrent-programs/bakery/stutter2.lisp  \
-     concurrent-programs/bakery/variables.lisp  \
-     concurrent-programs/german-protocol/german.lisp  \
-     countereg-gen/acl2s-parameter.lisp  \
-     countereg-gen/base.lisp  \
-     countereg-gen/basis.lisp  \
-     countereg-gen/cert.acl2  \
-     countereg-gen/data.lisp  \
-     countereg-gen/graph.lisp  \
-     countereg-gen/library-support.lisp  \
-     countereg-gen/main.lisp  \
-     countereg-gen/mv-proof.lisp  \
-     countereg-gen/num-list-fns.lisp  \
-     countereg-gen/num-list-thms.lisp  \
-     countereg-gen/package.lsp  \
-     countereg-gen/random-state-basis1.lisp  \
-     countereg-gen/random-state.lisp  \
-     countereg-gen/random.lisp  \
-     countereg-gen/rem-and-floor.lisp  \
-     countereg-gen/simple-graph-array.lisp  \
-     countereg-gen/splitnat.lisp  \
-     countereg-gen/switchnat.lisp  \
-     countereg-gen/top.lisp  \
-     countereg-gen/type.lisp  \
-     countereg-gen/utilities.lisp  \
-     countereg-gen/with-timeout.lisp  \
-     cowles/acl2-agp.lisp  \
-     cowles/acl2-asg.lisp  \
-     cowles/acl2-crg.lisp  \
-     cowles/cert.acl2  \
-     cowles/packages.lsp  \
-     cutil/cert.acl2  \
-     cutil/da-base.lisp  \
-     cutil/defaggregate-tests.lisp  \
-     cutil/defaggregate.lisp  \
-     cutil/defalist-tests.lisp  \
-     cutil/defalist.lisp  \
-     cutil/defenum.lisp  \
-     cutil/define-tests.acl2  \
-     cutil/define-tests.lisp  \
-     cutil/define.lisp  \
-     cutil/deflist-aux.lisp  \
-     cutil/deflist-tests.lisp  \
-     cutil/deflist.lisp  \
-     cutil/defmapappend-tests.lisp  \
-     cutil/defmapappend.lisp  \
-     cutil/defmvtypes.lisp  \
-     cutil/defprojection-tests.acl2  \
-     cutil/defprojection-tests.lisp  \
-     cutil/defprojection.lisp  \
-     cutil/defsection.lisp  \
-     cutil/formals.lisp  \
-     cutil/look-up.lisp  \
-     cutil/maybe-defthm.lisp  \
-     cutil/package.lsp  \
-     cutil/portcullis.acl2  \
-     cutil/portcullis.lisp  \
-     cutil/returnspecs.lisp  \
-     cutil/support.lisp  \
-     cutil/top.acl2  \
-     cutil/top.lisp  \
-     cutil/wizard.lisp  \
-     data-structures/alist-defthms.lisp  \
-     data-structures/alist-defuns.lisp  \
-     data-structures/alist-theory.lisp  \
-     data-structures/array1.lisp  \
-     data-structures/defalist.acl2  \
-     data-structures/defalist.lisp  \
-     data-structures/define-structures-package.lsp  \
-     data-structures/define-u-package.lsp  \
-     data-structures/deflist.acl2  \
-     data-structures/deflist.lisp  \
-     data-structures/doc-section.lisp  \
-     data-structures/list-defthms.lisp  \
-     data-structures/list-defuns.lisp  \
-     data-structures/list-theory.lisp  \
-     data-structures/memories/cert.acl2  \
-     data-structures/memories/log2.lisp  \
-     data-structures/memories/memory-impl.lisp  \
-     data-structures/memories/memory.lisp  \
-     data-structures/memories/memtree.lisp  \
-     data-structures/memories/package.lsp  \
-     data-structures/memories/private.lisp  \
-     data-structures/no-duplicates.lisp  \
-     data-structures/number-list-defthms.lisp  \
-     data-structures/number-list-defuns.lisp  \
-     data-structures/number-list-theory.lisp  \
-     data-structures/set-defthms.lisp  \
-     data-structures/set-defuns.lisp  \
-     data-structures/set-theory.lisp  \
-     data-structures/structures.acl2  \
-     data-structures/structures.lisp  \
-     data-structures/utilities.acl2  \
-     data-structures/utilities.lisp  \
-     deduction/passmore/bewijs.lisp  \
-     deduction/passmore/general.lisp  \
-     deduction/passmore/paramod.lisp  \
-     deduction/passmore/prover.lisp  \
-     deduction/passmore/resolution.lisp  \
-     deduction/passmore/unification.lisp  \
-     deduction/passmore/weighting.lisp  \
-     defexec/dag-unification/basic.lisp  \
-     defexec/dag-unification/dag-unification-l.lisp  \
-     defexec/dag-unification/dag-unification-rules.lisp  \
-     defexec/dag-unification/dag-unification-st.lisp  \
-     defexec/dag-unification/dags.lisp  \
-     defexec/dag-unification/list-unification-rules.lisp  \
-     defexec/dag-unification/matching.lisp  \
-     defexec/dag-unification/subsumption-subst.lisp  \
-     defexec/dag-unification/subsumption.lisp  \
-     defexec/dag-unification/terms-as-dag.lisp  \
-     defexec/dag-unification/terms-dag-stobj.lisp  \
-     defexec/dag-unification/terms.lisp  \
-     defexec/defpun-exec/defpun-exec.lisp  \
-     defexec/find-path/fpst.lisp  \
-     defexec/find-path/graph/find-path1.lisp  \
-     defexec/find-path/graph/find-path2.lisp  \
-     defexec/find-path/graph/find-path3.lisp  \
-     defexec/find-path/graph/helpers.lisp  \
-     defexec/find-path/graph/linear-find-path.lisp  \
-     defexec/find-path/run-fpst.lisp  \
-     defexec/ordinals/supporting-ordinals.lisp  \
-     defexec/other-apps/misc/memos.lisp  \
-     defexec/other-apps/misc/stobjsim.lisp  \
-     defexec/other-apps/qsort/extraction.lisp  \
-     defexec/other-apps/qsort/final-theorem.lisp  \
-     defexec/other-apps/qsort/first-last.lisp  \
-     defexec/other-apps/qsort/intermediate-program.lisp  \
-     defexec/other-apps/qsort/intermediate-to-spec.lisp  \
-     defexec/other-apps/qsort/load-extract.lisp  \
-     defexec/other-apps/qsort/merge-intermediate.lisp  \
-     defexec/other-apps/qsort/nth-update-nth.lisp  \
-     defexec/other-apps/qsort/permutations.lisp  \
-     defexec/other-apps/qsort/programs.lisp  \
-     defexec/other-apps/qsort/sort-qs-properties.lisp  \
-     defexec/other-apps/qsort/spec-properties.lisp  \
-     defexec/other-apps/qsort/split-qs-properties.lisp  \
-     defexec/other-apps/qsort/total-order.lisp  \
-     defexec/other-apps/records/inline.lisp  \
-     defexec/other-apps/records/records-bsd.lisp  \
-     defexec/other-apps/records/records.lisp  \
-     defexec/other-apps/records/recordsim.lisp  \
-     defexec/reflexive/reflexive.lisp  \
-     defsort/defsort.lisp  \
-     defsort/duplicated-members.lisp  \
-     defsort/duplicity.lisp  \
-     defsort/examples.lisp  \
-     defsort/generic-impl.lisp  \
-     defsort/generic.lisp  \
-     defsort/remove-dups.lisp  \
-     defsort/uniquep.lisp  \
-     demos/list-theory.lisp  \
-     demos/modeling/cert.acl2  \
-     demos/modeling/memories.lisp  \
-     demos/modeling/network-state-basic.lisp  \
-     demos/modeling/network-state.lisp  \
-     demos/modeling/nondeterminism.lisp  \
-     finite-set-theory/osets/cardinality.lisp  \
-     finite-set-theory/osets/cert.acl2  \
-     finite-set-theory/osets/computed-hints.lisp  \
-     finite-set-theory/osets/delete.lisp  \
-     finite-set-theory/osets/difference.lisp  \
-     finite-set-theory/osets/instance.lisp  \
-     finite-set-theory/osets/intersect.lisp  \
-     finite-set-theory/osets/map-tests.lisp  \
-     finite-set-theory/osets/map.lisp  \
-     finite-set-theory/osets/membership.lisp  \
-     finite-set-theory/osets/outer.lisp  \
-     finite-set-theory/osets/portcullis.acl2  \
-     finite-set-theory/osets/portcullis.lisp  \
-     finite-set-theory/osets/primitives.lisp  \
-     finite-set-theory/osets/quantify.lisp  \
-     finite-set-theory/osets/sets.defpkg  \
-     finite-set-theory/osets/sets.lisp  \
-     finite-set-theory/osets/sort.lisp  \
-     finite-set-theory/osets/under-set-equiv.lisp  \
-     finite-set-theory/osets/union.lisp  \
-     finite-set-theory/set-theory.acl2  \
-     finite-set-theory/set-theory.lisp  \
-     finite-set-theory/total-ordering.lisp  \
-     hacking/all.acl2  \
-     hacking/all.lisp  \
-     hacking/bridge.acl2  \
-     hacking/bridge.lisp  \
-     hacking/defcode.acl2  \
-     hacking/defcode.lisp  \
-     hacking/defstruct-parsing.acl2  \
-     hacking/defstruct-parsing.lisp  \
-     hacking/doc-section.lisp  \
-     hacking/dynamic-make-event-test.acl2  \
-     hacking/dynamic-make-event-test.lisp  \
-     hacking/dynamic-make-event.acl2  \
-     hacking/dynamic-make-event.lisp  \
-     hacking/evalable-ld-printing.acl2  \
-     hacking/evalable-ld-printing.lisp  \
-     hacking/hacker-pkg.lsp  \
-     hacking/hacker.acl2  \
-     hacking/hacker.lisp  \
-     hacking/progn-bang-enh.acl2  \
-     hacking/progn-bang-enh.lisp  \
-     hacking/raw.acl2  \
-     hacking/raw.lisp  \
-     hacking/redefun.acl2  \
-     hacking/redefun.lisp  \
-     hacking/rewrite-code-pkg.lsp  \
-     hacking/rewrite-code.acl2  \
-     hacking/rewrite-code.lisp  \
-     hacking/subsumption.acl2  \
-     hacking/subsumption.lisp  \
-     hacking/table-guard.acl2  \
-     hacking/table-guard.lisp  \
-     hints/basic-tests.acl2  \
-     hints/basic-tests.lisp  \
-     hints/consider-hint-tests.acl2  \
-     hints/consider-hint-tests.lisp  \
-     hints/consider-hint.lisp  \
-     hints/huet-lang-algorithm-tests.lisp  \
-     hints/huet-lang-algorithm.lisp  \
-     hints/merge-hint.lisp  \
-     ihs/@logops.lisp  \
-     ihs/basic-definitions.lisp  \
-     ihs/ihs-definitions.lisp  \
-     ihs/ihs-doc-topic.lisp  \
-     ihs/ihs-init.acl2  \
-     ihs/ihs-init.lisp  \
-     ihs/ihs-lemmas.lisp  \
-     ihs/ihs-theories.lisp  \
-     ihs/logops-definitions.lisp  \
-     ihs/logops-lemmas.lisp  \
-     ihs/math-lemmas.lisp  \
-     ihs/quotient-remainder-lemmas.lisp  \
-     leftist-trees/leftist-tree-defthms.lisp  \
-     leftist-trees/leftist-tree-defuns.lisp  \
-     leftist-trees/leftist-tree-sort-equivalent.lisp  \
-     leftist-trees/leftist-tree-sort-equivalent2.lisp  \
-     leftist-trees/leftist-tree-sort-equivalent3.lisp  \
-     leftist-trees/leftist-tree-sort.lisp  \
-     leftist-trees/top.lisp  \
-     make-event/acl2x-help.lisp  \
-     make-event/assert-check-include-1.acl2  \
-     make-event/assert-check-include-1.lisp  \
-     make-event/assert-check-include.lisp  \
-     make-event/assert-check.lisp  \
-     make-event/assert-include.acl2  \
-     make-event/assert-include.lisp  \
-     make-event/assert.lisp  \
-     make-event/basic-check.lisp  \
-     make-event/basic-pkg-check.acl2  \
-     make-event/basic-pkg-check.lisp  \
-     make-event/basic-pkg.acl2  \
-     make-event/basic-pkg.lisp  \
-     make-event/basic.lisp  \
-     make-event/defconst-fast-examples.lisp  \
-     make-event/defconst-fast.lisp  \
-     make-event/defrefine.lisp  \
-     make-event/defrule.lisp  \
-     make-event/defspec.lisp  \
-     make-event/dotimes.lisp  \
-     make-event/embeddable-event-forms.lisp  \
-     make-event/eval-check-tests.lisp  \
-     make-event/eval-check.lisp  \
-     make-event/eval-tests.lisp  \
-     make-event/eval.lisp  \
-     make-event/gen-defthm-check.lisp  \
-     make-event/gen-defthm.lisp  \
-     make-event/gen-defun-check.lisp  \
-     make-event/gen-defun.lisp  \
-     make-event/inline-book.lisp  \
-     make-event/local-elided-include.lisp  \
-     make-event/local-elided.lisp  \
-     make-event/local-requires-skip-check-include.lisp  \
-     make-event/local-requires-skip-check.lisp  \
-     make-event/logical-tangent.lisp  \
-     make-event/macros-include.lisp  \
-     make-event/macros-skip-proofs-include.acl2  \
-     make-event/macros-skip-proofs-include.lisp  \
-     make-event/macros-skip-proofs.acl2  \
-     make-event/macros-skip-proofs.lisp  \
-     make-event/macros.lisp  \
-     make-event/make-redundant.lisp  \
-     make-event/nested-check.lisp  \
-     make-event/nested.lisp  \
-     make-event/portcullis-expansion-include.acl2  \
-     make-event/portcullis-expansion-include.lisp  \
-     make-event/portcullis-expansion.acl2  \
-     make-event/portcullis-expansion.lisp  \
-     make-event/proof-by-arith.lisp  \
-     make-event/read-from-file.lisp  \
-     make-event/require-book.lisp  \
-     make-event/test-case-check.lisp  \
-     make-event/test-case.lisp  \
-     meta/meta-plus-equal.lisp  \
-     meta/meta-plus-lessp.lisp  \
-     meta/meta-times-equal.lisp  \
-     meta/meta.lisp  \
-     meta/pseudo-termp-lemmas.lisp  \
-     meta/term-defuns.lisp  \
-     meta/term-lemmas.lisp  \
-     misc/assert.lisp  \
-     misc/bash.lisp  \
-     misc/beta-reduce.lisp  \
-     misc/callers-and-ancestors.lisp  \
-     misc/character-encoding-test.lisp  \
-     misc/check-acl2-exports.lisp  \
-     misc/check-state.lisp  \
-     misc/computed-hint-rewrite.lisp  \
-     misc/computed-hint.lisp  \
-     misc/congruent-stobjs-test.lisp  \
-     misc/csort.lisp  \
-     misc/dead-events.lisp  \
-     misc/defabsstobj-example-1.lisp  \
-     misc/defabsstobj-example-2.lisp  \
-     misc/defabsstobj-example-3.lisp  \
-     misc/defabsstobj-example-4.acl2  \
-     misc/defabsstobj-example-4.lisp  \
-     misc/defattach-bang.lisp  \
-     misc/defattach-example.lisp  \
-     misc/definline.lisp  \
-     misc/defmac.lisp  \
-     misc/defopener.lisp  \
-     misc/defp.lisp  \
-     misc/defproxy-test.acl2  \
-     misc/defproxy-test.lisp  \
-     misc/defpun.lisp  \
-     misc/defun-plus.lisp  \
-     misc/dft-ex.acl2  \
-     misc/dft-ex.lisp  \
-     misc/dft.lisp  \
-     misc/dijkstra-shortest-path.lisp  \
-     misc/disassemble.acl2  \
-     misc/disassemble.lisp  \
-     misc/doc-section.lisp  \
-     misc/dump-events.lisp  \
-     misc/equal-by-g-help.lisp  \
-     misc/equal-by-g.lisp  \
-     misc/eval.lisp  \
-     misc/evalable-printing.lisp  \
-     misc/expander.lisp  \
-     misc/fast-coerce.lisp  \
-     misc/fibonacci.lisp  \
-     misc/file-io.lisp  \
-     misc/find-lemmas.lisp  \
-     misc/gentle.lisp  \
-     misc/getprop.lisp  \
-     misc/goodstein.lisp  \
-     misc/grcd.lisp  \
-     misc/hanoi.acl2  \
-     misc/hanoi.lisp  \
-     misc/hons-help.lisp  \
-     misc/hons-help2.lisp  \
-     misc/hons-tests.lisp  \
-     misc/how-to-prove-thms.lisp  \
-     misc/int-division.lisp  \
-     misc/integer-type-set-test.lisp  \
-     misc/invariants.lisp  \
-     misc/meta-lemmas.lisp  \
-     misc/misc2/defpun-exec-domain-example.lisp  \
-     misc/misc2/misc.lisp  \
-     misc/misc2/reverse-by-separation.acl2  \
-     misc/misc2/reverse-by-separation.lisp  \
-     misc/misc2/ruler-extenders-tests.acl2  \
-     misc/misc2/ruler-extenders-tests.lisp  \
-     misc/misc2/step-limits.lisp  \
-     misc/mult.lisp  \
-     misc/oprof.acl2  \
-     misc/oprof.lisp  \
-     misc/priorities.lisp  \
-     misc/problem13.lisp  \
-     misc/process-book-readme.lisp  \
-     misc/profiling.acl2  \
-     misc/profiling.lisp  \
-     misc/qi-correct.acl2  \
-     misc/qi-correct.lisp  \
-     misc/qi.acl2  \
-     misc/qi.lisp  \
-     misc/radix.acl2  \
-     misc/radix.lisp  \
-     misc/random.lisp  \
-     misc/records-bsd.lisp  \
-     misc/records.lisp  \
-     misc/records0.lisp  \
-     misc/redef-pkg.acl2  \
-     misc/redef-pkg.lisp  \
-     misc/rtl-untranslate.lisp  \
-     misc/save-time.lisp  \
-     misc/seq.lisp  \
-     misc/seqw.lisp  \
-     misc/simplify-defuns.lisp  \
-     misc/simplify-thm.lisp  \
-     misc/sin-cos.lisp  \
-     misc/sort-symbols.lisp  \
-     misc/sticky-disable.lisp  \
-     misc/symbol-btree.lisp  \
-     misc/total-order-bsd.lisp  \
-     misc/total-order.lisp  \
-     misc/trace-star.lisp  \
-     misc/transfinite.lisp  \
-     misc/untranslate-patterns.lisp  \
-     misc/wet.lisp  \
-     models/jvm/m1-original/m1-story.acl2  \
-     models/jvm/m1-original/m1-story.lisp  \
-     models/jvm/m1-original/problem-set-1-answers.acl2  \
-     models/jvm/m1-original/problem-set-1-answers.lisp  \
-     models/jvm/m1/alternating-sum-variant.lisp  \
-     models/jvm/m1/alternating-sum.lisp  \
-     models/jvm/m1/bexpt.lisp  \
-     models/jvm/m1/cert.acl2  \
-     models/jvm/m1/defsys-utilities.lisp  \
-     models/jvm/m1/defsys.acl2  \
-     models/jvm/m1/defsys.lisp  \
-     models/jvm/m1/div.lisp  \
-     models/jvm/m1/even-solution-1.lisp  \
-     models/jvm/m1/even-solution-2.lisp  \
-     models/jvm/m1/expt.lisp  \
-     models/jvm/m1/fact.lisp  \
-     models/jvm/m1/fib.lisp  \
-     models/jvm/m1/find-k!.acl2  \
-     models/jvm/m1/find-k!.lisp  \
-     models/jvm/m1/funny-fact.lisp  \
-     models/jvm/m1/implementation.acl2  \
-     models/jvm/m1/implementation.lisp  \
-     models/jvm/m1/lessp.lisp  \
-     models/jvm/m1/low-seven.acl2  \
-     models/jvm/m1/low-seven.lisp  \
-     models/jvm/m1/m1.acl2  \
-     models/jvm/m1/m1.lisp  \
-     models/jvm/m1/magic.lisp  \
-     models/jvm/m1/power.lisp  \
-     models/jvm/m1/sign.lisp  \
-     models/jvm/m1/sum.lisp  \
-     models/jvm/m1/sumsq.lisp  \
-     models/jvm/m1/template.lisp  \
-     models/jvm/m1/theorems-a-and-b.lisp  \
-     models/jvm/m1/tmi-reductions.lisp  \
-     models/jvm/m1/wormhole-abstraction.lisp  \
-     models/jvm/m5/apprentice-state.acl2  \
-     models/jvm/m5/apprentice-state.lisp  \
-     models/jvm/m5/demo.acl2  \
-     models/jvm/m5/demo.lisp  \
-     models/jvm/m5/idemo.acl2  \
-     models/jvm/m5/idemo.lisp  \
-     models/jvm/m5/infinite-fair-schedule.lisp  \
-     models/jvm/m5/isort.acl2  \
-     models/jvm/m5/isort.lisp  \
-     models/jvm/m5/jvm-fact-setup.acl2  \
-     models/jvm/m5/jvm-fact-setup.lisp  \
-     models/jvm/m5/m5.acl2  \
-     models/jvm/m5/m5.lisp  \
-     models/jvm/m5/partial.acl2  \
-     models/jvm/m5/partial.lisp  \
-     models/jvm/m5/perm.lisp  \
-     models/jvm/m5/universal-never-returns.acl2  \
-     models/jvm/m5/universal-never-returns.lisp  \
-     models/jvm/m5/universal.acl2  \
-     models/jvm/m5/universal.lisp  \
-     models/jvm/m5/utilities.acl2  \
-     models/jvm/m5/utilities.lisp  \
-     ordinals/e0-ordinal.lisp  \
-     ordinals/lexicographic-book.lisp  \
-     ordinals/lexicographic-ordering-without-arithmetic.lisp  \
-     ordinals/lexicographic-ordering.lisp  \
-     ordinals/limits.lisp  \
-     ordinals/ordinal-addition.lisp  \
-     ordinals/ordinal-basic-thms.lisp  \
-     ordinals/ordinal-counter-examples.lisp  \
-     ordinals/ordinal-definitions.lisp  \
-     ordinals/ordinal-exponentiation.lisp  \
-     ordinals/ordinal-isomorphism.lisp  \
-     ordinals/ordinal-multiplication.lisp  \
-     ordinals/ordinal-total-order.lisp  \
-     ordinals/ordinals-without-arithmetic.lisp  \
-     ordinals/ordinals.lisp  \
-     ordinals/proof-of-well-foundedness.acl2  \
-     ordinals/proof-of-well-foundedness.lisp  \
-     ordinals/top-with-meta.lisp  \
-     oslib/catpath.lisp  \
-     oslib/cert.acl2  \
-     oslib/date.lisp  \
-     oslib/getpid.lisp  \
-     oslib/ls.lisp  \
-     oslib/package.lsp  \
-     oslib/portcullis.acl2  \
-     oslib/portcullis.lisp  \
-     oslib/read-acl2-oracle.lisp  \
-     oslib/tempfile.lisp  \
-     oslib/top.lisp  \
-     paco/acl2-customization.lsp  \
-     paco/database.acl2  \
-     paco/database.lisp  \
-     paco/elim-dest.acl2  \
-     paco/elim-dest.lisp  \
-     paco/foundations.acl2  \
-     paco/foundations.lisp  \
-     paco/induct.acl2  \
-     paco/induct.lisp  \
-     paco/output-module.acl2  \
-     paco/output-module.lisp  \
-     paco/paco.acl2  \
-     paco/paco.lisp  \
-     paco/prove.acl2  \
-     paco/prove.lisp  \
-     paco/rewrite.acl2  \
-     paco/rewrite.lisp  \
-     paco/simplify.acl2  \
-     paco/simplify.lisp  \
-     paco/type-set.acl2  \
-     paco/type-set.lisp  \
-     paco/utilities.acl2  \
-     paco/utilities.lisp  \
-     parallel/fibonacci.lisp  \
-     parallel/hint-tests.acl2  \
-     parallel/hint-tests.lisp  \
-     parallel/matrix-multiplication-parallel.lisp  \
-     parallel/matrix-multiplication-serial.lisp  \
-     parallel/matrix-multiplication-setup.lisp  \
-     parallel/spec-mv-let.lisp  \
-     parallel/stress-tests.lisp  \
-     parallel/syntax-tests.lisp  \
-     parallel/with-waterfall-parallelism.lisp  \
-     parallel/without-waterfall-parallelism.lisp  \
-     powerlists/algebra.lisp  \
-     powerlists/batcher-sort.lisp  \
-     powerlists/bitonic-sort.lisp  \
-     powerlists/cert.acl2  \
-     powerlists/cla-adder.lisp  \
-     powerlists/defpkg.lsp  \
-     powerlists/gray-code.lisp  \
-     powerlists/merge-sort.lisp  \
-     powerlists/prefix-sum.lisp  \
-     powerlists/simple.lisp  \
-     powerlists/sort.lisp  \
-     proofstyles/completeness/assertions-partial.lisp  \
-     proofstyles/completeness/assertions-total.lisp  \
-     proofstyles/completeness/clock-partial.lisp  \
-     proofstyles/completeness/clock-total.lisp  \
-     proofstyles/completeness/generic-partial.lisp  \
-     proofstyles/completeness/generic-total.lisp  \
-     proofstyles/completeness/stepwise-invariants-partial.lisp  \
-     proofstyles/completeness/stepwise-invariants-total.lisp  \
-     proofstyles/counterexamples/halt-flg.lisp  \
-     proofstyles/counterexamples/memory-clearing.lisp  \
-     proofstyles/counterexamples/realistic.lisp  \
-     proofstyles/invclock/c2i/c2i-partial.lisp  \
-     proofstyles/invclock/c2i/c2i-total.lisp  \
-     proofstyles/invclock/c2i/clock-to-inv.lisp  \
-     proofstyles/invclock/compose/compose-c-c-partial.lisp  \
-     proofstyles/invclock/compose/compose-c-c-total.lisp  \
-     proofstyles/invclock/i2c/i2c-partial.lisp  \
-     proofstyles/invclock/i2c/i2c-total.lisp  \
-     proofstyles/invclock/i2c/inv-to-clock.lisp  \
-     proofstyles/soundness/assertions-partial.lisp  \
-     proofstyles/soundness/assertions-total.lisp  \
-     proofstyles/soundness/clock-partial.lisp  \
-     proofstyles/soundness/clock-total.lisp  \
-     proofstyles/soundness/stepwise-invariants-partial.lisp  \
-     proofstyles/soundness/stepwise-invariants-total.lisp  \
-     quadratic-reciprocity/eisenstein.lisp  \
-     quadratic-reciprocity/euclid.lisp  \
-     quadratic-reciprocity/euler.lisp  \
-     quadratic-reciprocity/fermat.lisp  \
-     quadratic-reciprocity/gauss.lisp  \
-     quadratic-reciprocity/mersenne.lisp  \
-     regex/cert.acl2  \
-     regex/defset-encapsulates.lisp  \
-     regex/defset-macros.lisp  \
-     regex/equal-based-set.lisp  \
-     regex/grep-command-line.lisp  \
-     regex/input-list.lisp  \
-     regex/portcullis.acl2  \
-     regex/portcullis.lisp  \
-     regex/regex-chartrans.lisp  \
-     regex/regex-defs.lisp  \
-     regex/regex-exec.lisp  \
-     regex/regex-fileio.lisp  \
-     regex/regex-parse-brace.lisp  \
-     regex/regex-parse-bracket.lisp  \
-     regex/regex-parse.lisp  \
-     regex/regex-tests.lisp  \
-     regex/regex-ui.lisp  \
-     rtl/rel1/lib1/basic.lisp  \
-     rtl/rel1/lib1/bits.lisp  \
-     rtl/rel1/lib1/brat.lisp  \
-     rtl/rel1/lib1/float.lisp  \
-     rtl/rel1/lib1/reps.lisp  \
-     rtl/rel1/lib1/round.lisp  \
-     rtl/rel1/lib1/top.lisp  \
-     rtl/rel1/lib3/basic.lisp  \
-     rtl/rel1/lib3/bits.lisp  \
-     rtl/rel1/lib3/brat.lisp  \
-     rtl/rel1/lib3/fadd.lisp  \
-     rtl/rel1/lib3/float.lisp  \
-     rtl/rel1/lib3/reps.lisp  \
-     rtl/rel1/lib3/round.lisp  \
-     rtl/rel1/lib3/top.lisp  \
-     rtl/rel1/support/add.lisp  \
-     rtl/rel1/support/away.lisp  \
-     rtl/rel1/support/basic.lisp  \
-     rtl/rel1/support/divsqrt.lisp  \
-     rtl/rel1/support/fadd/add3.lisp  \
-     rtl/rel1/support/fadd/lop1.lisp  \
-     rtl/rel1/support/fadd/lop2.lisp  \
-     rtl/rel1/support/fadd/lop3.lisp  \
-     rtl/rel1/support/fadd/stick.lisp  \
-     rtl/rel1/support/fadd/top.lisp  \
-     rtl/rel1/support/float.lisp  \
-     rtl/rel1/support/floor.lisp  \
-     rtl/rel1/support/fp.lisp  \
-     rtl/rel1/support/logdefs.lisp  \
-     rtl/rel1/support/loglemmas.lisp  \
-     rtl/rel1/support/logxor-def.lisp  \
-     rtl/rel1/support/logxor-lemmas.lisp  \
-     rtl/rel1/support/merge.lisp  \
-     rtl/rel1/support/near.lisp  \
-     rtl/rel1/support/odd.lisp  \
-     rtl/rel1/support/proofs.lisp  \
-     rtl/rel1/support/reps.lisp  \
-     rtl/rel1/support/rewrite-theory.lisp  \
-     rtl/rel1/support/rnd.lisp  \
-     rtl/rel1/support/sticky.lisp  \
-     rtl/rel1/support/trunc.lisp  \
-     rtl/rel1/support/x-2xx.lisp  \
-     rtl/rel4/arithmetic/arith.lisp  \
-     rtl/rel4/arithmetic/arith2.lisp  \
-     rtl/rel4/arithmetic/basic.lisp  \
-     rtl/rel4/arithmetic/cg.lisp  \
-     rtl/rel4/arithmetic/common-factor-defuns.lisp  \
-     rtl/rel4/arithmetic/common-factor.lisp  \
-     rtl/rel4/arithmetic/complex-rationalp.lisp  \
-     rtl/rel4/arithmetic/denominator.lisp  \
-     rtl/rel4/arithmetic/even-odd.lisp  \
-     rtl/rel4/arithmetic/even-odd2-proofs.lisp  \
-     rtl/rel4/arithmetic/even-odd2.lisp  \
-     rtl/rel4/arithmetic/expo-proofs.lisp  \
-     rtl/rel4/arithmetic/expo.lisp  \
-     rtl/rel4/arithmetic/expt-proofs.lisp  \
-     rtl/rel4/arithmetic/expt.lisp  \
-     rtl/rel4/arithmetic/extra-rules.lisp  \
-     rtl/rel4/arithmetic/fl-expt.lisp  \
-     rtl/rel4/arithmetic/fl-hacks.lisp  \
-     rtl/rel4/arithmetic/fl-proofs.lisp  \
-     rtl/rel4/arithmetic/fl.lisp  \
-     rtl/rel4/arithmetic/floor-proofs.lisp  \
-     rtl/rel4/arithmetic/floor.lisp  \
-     rtl/rel4/arithmetic/fp.lisp  \
-     rtl/rel4/arithmetic/fp2.lisp  \
-     rtl/rel4/arithmetic/ground-zero.lisp  \
-     rtl/rel4/arithmetic/hacks.lisp  \
-     rtl/rel4/arithmetic/induct.lisp  \
-     rtl/rel4/arithmetic/integerp.lisp  \
-     rtl/rel4/arithmetic/inverted-factor.lisp  \
-     rtl/rel4/arithmetic/mod-expt.lisp  \
-     rtl/rel4/arithmetic/mod-proofs.lisp  \
-     rtl/rel4/arithmetic/mod.lisp  \
-     rtl/rel4/arithmetic/negative-syntaxp.lisp  \
-     rtl/rel4/arithmetic/nniq.lisp  \
-     rtl/rel4/arithmetic/numerator.lisp  \
-     rtl/rel4/arithmetic/power2p.lisp  \
-     rtl/rel4/arithmetic/predicate.lisp  \
-     rtl/rel4/arithmetic/product-proofs.lisp  \
-     rtl/rel4/arithmetic/product.lisp  \
-     rtl/rel4/arithmetic/rationalp.lisp  \
-     rtl/rel4/arithmetic/top.lisp  \
-     rtl/rel4/arithmetic/unary-divide.lisp  \
-     rtl/rel4/arithmetic/x-2xx.lisp  \
-     rtl/rel4/lib/arith.lisp  \
-     rtl/rel4/lib/basic.lisp  \
-     rtl/rel4/lib/bits.lisp  \
-     rtl/rel4/lib/bvecp-helpers.lisp  \
-     rtl/rel4/lib/bvecp-raw-helpers.lisp  \
-     rtl/rel4/lib/clocks.lisp  \
-     rtl/rel4/lib/fadd.lisp  \
-     rtl/rel4/lib/float.lisp  \
-     rtl/rel4/lib/openers.lisp  \
-     rtl/rel4/lib/package-defs.lisp  \
-     rtl/rel4/lib/reps.lisp  \
-     rtl/rel4/lib/rom-helpers.lisp  \
-     rtl/rel4/lib/round.lisp  \
-     rtl/rel4/lib/rtl.lisp  \
-     rtl/rel4/lib/rtlarr.lisp  \
-     rtl/rel4/lib/simple-loop-helpers.lisp  \
-     rtl/rel4/lib/simplify-model-helpers.lisp  \
-     rtl/rel4/lib/top.lisp  \
-     rtl/rel4/lib/util.lisp  \
-     rtl/rel4/support/add3-proofs.lisp  \
-     rtl/rel4/support/add3.lisp  \
-     rtl/rel4/support/all-ones.lisp  \
-     rtl/rel4/support/ash.lisp  \
-     rtl/rel4/support/away-proofs.lisp  \
-     rtl/rel4/support/away.lisp  \
-     rtl/rel4/support/badguys.lisp  \
-     rtl/rel4/support/bias-proofs.lisp  \
-     rtl/rel4/support/bias.lisp  \
-     rtl/rel4/support/bitn-proofs.lisp  \
-     rtl/rel4/support/bitn.lisp  \
-     rtl/rel4/support/bits-extra.lisp  \
-     rtl/rel4/support/bits-proofs.lisp  \
-     rtl/rel4/support/bits-trunc-proofs.lisp  \
-     rtl/rel4/support/bits-trunc.lisp  \
-     rtl/rel4/support/bits.lisp  \
-     rtl/rel4/support/bvecp-helpers.lisp  \
-     rtl/rel4/support/bvecp-lemmas.lisp  \
-     rtl/rel4/support/bvecp-proofs.lisp  \
-     rtl/rel4/support/bvecp.lisp  \
-     rtl/rel4/support/cat-def.lisp  \
-     rtl/rel4/support/cat-proofs.lisp  \
-     rtl/rel4/support/cat.lisp  \
-     rtl/rel4/support/clocks.lisp  \
-     rtl/rel4/support/decode-proofs.lisp  \
-     rtl/rel4/support/decode.lisp  \
-     rtl/rel4/support/drnd.lisp  \
-     rtl/rel4/support/encode.lisp  \
-     rtl/rel4/support/ereps-proofs.lisp  \
-     rtl/rel4/support/ereps.lisp  \
-     rtl/rel4/support/fadd.lisp  \
-     rtl/rel4/support/fast-and.lisp  \
-     rtl/rel4/support/float.lisp  \
-     rtl/rel4/support/ground-zero.lisp  \
-     rtl/rel4/support/guards.lisp  \
-     rtl/rel4/support/ireps.lisp  \
-     rtl/rel4/support/land-proofs.lisp  \
-     rtl/rel4/support/land.lisp  \
-     rtl/rel4/support/lextra-proofs.lisp  \
-     rtl/rel4/support/lextra.lisp  \
-     rtl/rel4/support/lior-proofs.lisp  \
-     rtl/rel4/support/lior.lisp  \
-     rtl/rel4/support/lnot-proofs.lisp  \
-     rtl/rel4/support/lnot.lisp  \
-     rtl/rel4/support/log-equal.lisp  \
-     rtl/rel4/support/log-proofs.lisp  \
-     rtl/rel4/support/log.lisp  \
-     rtl/rel4/support/logand-proofs.lisp  \
-     rtl/rel4/support/logand.lisp  \
-     rtl/rel4/support/logeqv.lisp  \
-     rtl/rel4/support/logior-proofs.lisp  \
-     rtl/rel4/support/logior.lisp  \
-     rtl/rel4/support/logior1-proofs.lisp  \
-     rtl/rel4/support/logior1.lisp  \
-     rtl/rel4/support/lognot.lisp  \
-     rtl/rel4/support/logorc1.lisp  \
-     rtl/rel4/support/logs.lisp  \
-     rtl/rel4/support/logxor.lisp  \
-     rtl/rel4/support/lop1-proofs.lisp  \
-     rtl/rel4/support/lop1.lisp  \
-     rtl/rel4/support/lop2-proofs.lisp  \
-     rtl/rel4/support/lop2.lisp  \
-     rtl/rel4/support/lop3-proofs.lisp  \
-     rtl/rel4/support/lop3.lisp  \
-     rtl/rel4/support/lxor-proofs.lisp  \
-     rtl/rel4/support/lxor.lisp  \
-     rtl/rel4/support/merge.lisp  \
-     rtl/rel4/support/merge2.lisp  \
-     rtl/rel4/support/mod4.lisp  \
-     rtl/rel4/support/model-helpers.lisp  \
-     rtl/rel4/support/mulcat-proofs.lisp  \
-     rtl/rel4/support/mulcat.lisp  \
-     rtl/rel4/support/near+-proofs.lisp  \
-     rtl/rel4/support/near+.lisp  \
-     rtl/rel4/support/near-proofs.lisp  \
-     rtl/rel4/support/near.lisp  \
-     rtl/rel4/support/ocat.lisp  \
-     rtl/rel4/support/oddr-proofs.lisp  \
-     rtl/rel4/support/oddr.lisp  \
-     rtl/rel4/support/openers.lisp  \
-     rtl/rel4/support/package-defs.lisp  \
-     rtl/rel4/support/rewrite-theory.lisp  \
-     rtl/rel4/support/rnd.lisp  \
-     rtl/rel4/support/rom-helpers.lisp  \
-     rtl/rel4/support/rtl.lisp  \
-     rtl/rel4/support/rtlarr.lisp  \
-     rtl/rel4/support/setbitn-proofs.lisp  \
-     rtl/rel4/support/setbitn.lisp  \
-     rtl/rel4/support/setbits-proofs.lisp  \
-     rtl/rel4/support/setbits.lisp  \
-     rtl/rel4/support/sgn.lisp  \
-     rtl/rel4/support/shft.lisp  \
-     rtl/rel4/support/simple-loop-helpers.lisp  \
-     rtl/rel4/support/simplify-model-helpers.lisp  \
-     rtl/rel4/support/stick-proofs.lisp  \
-     rtl/rel4/support/stick.lisp  \
-     rtl/rel4/support/sticky-proofs.lisp  \
-     rtl/rel4/support/sticky.lisp  \
-     rtl/rel4/support/sumbits.lisp  \
-     rtl/rel4/support/top.lisp  \
-     rtl/rel4/support/top1.lisp  \
-     rtl/rel4/support/trunc-proofs.lisp  \
-     rtl/rel4/support/trunc.lisp  \
-     rtl/rel4/support/util.lisp  \
-     rtl/rel4/user/away.lisp  \
-     rtl/rel4/user/bias.lisp  \
-     rtl/rel4/user/bitn.lisp  \
-     rtl/rel4/user/bits-trunc.lisp  \
-     rtl/rel4/user/bits.lisp  \
-     rtl/rel4/user/brat.lisp  \
-     rtl/rel4/user/bvecp.lisp  \
-     rtl/rel4/user/cat.lisp  \
-     rtl/rel4/user/decode.lisp  \
-     rtl/rel4/user/ereps.lisp  \
-     rtl/rel4/user/land.lisp  \
-     rtl/rel4/user/lextra.lisp  \
-     rtl/rel4/user/lior.lisp  \
-     rtl/rel4/user/lnot.lisp  \
-     rtl/rel4/user/logior1.lisp  \
-     rtl/rel4/user/lxor.lisp  \
-     rtl/rel4/user/mulcat.lisp  \
-     rtl/rel4/user/near.lisp  \
-     rtl/rel4/user/setbitn.lisp  \
-     rtl/rel4/user/setbits.lisp  \
-     rtl/rel4/user/stick.lisp  \
-     rtl/rel4/user/sumbits.lisp  \
-     rtl/rel4/user/top.lisp  \
-     rtl/rel4/user/trunc.lisp  \
-     rtl/rel5/arithmetic/arith.lisp  \
-     rtl/rel5/arithmetic/arith2.lisp  \
-     rtl/rel5/arithmetic/basic.lisp  \
-     rtl/rel5/arithmetic/cg.lisp  \
-     rtl/rel5/arithmetic/common-factor-defuns.lisp  \
-     rtl/rel5/arithmetic/common-factor.lisp  \
-     rtl/rel5/arithmetic/complex-rationalp.lisp  \
-     rtl/rel5/arithmetic/denominator.lisp  \
-     rtl/rel5/arithmetic/even-odd.lisp  \
-     rtl/rel5/arithmetic/even-odd2-proofs.lisp  \
-     rtl/rel5/arithmetic/even-odd2.lisp  \
-     rtl/rel5/arithmetic/expo-proofs.lisp  \
-     rtl/rel5/arithmetic/expo.lisp  \
-     rtl/rel5/arithmetic/expt-proofs.lisp  \
-     rtl/rel5/arithmetic/expt.lisp  \
-     rtl/rel5/arithmetic/extra-rules.lisp  \
-     rtl/rel5/arithmetic/fl-expt.lisp  \
-     rtl/rel5/arithmetic/fl-hacks.lisp  \
-     rtl/rel5/arithmetic/fl-proofs.lisp  \
-     rtl/rel5/arithmetic/fl.lisp  \
-     rtl/rel5/arithmetic/floor-proofs.lisp  \
-     rtl/rel5/arithmetic/floor.lisp  \
-     rtl/rel5/arithmetic/fp.lisp  \
-     rtl/rel5/arithmetic/fp2.lisp  \
-     rtl/rel5/arithmetic/ground-zero.lisp  \
-     rtl/rel5/arithmetic/hacks.lisp  \
-     rtl/rel5/arithmetic/induct.lisp  \
-     rtl/rel5/arithmetic/integerp.lisp  \
-     rtl/rel5/arithmetic/inverted-factor.lisp  \
-     rtl/rel5/arithmetic/mod-expt.lisp  \
-     rtl/rel5/arithmetic/mod-proofs.lisp  \
-     rtl/rel5/arithmetic/mod.lisp  \
-     rtl/rel5/arithmetic/negative-syntaxp.lisp  \
-     rtl/rel5/arithmetic/nniq.lisp  \
-     rtl/rel5/arithmetic/numerator.lisp  \
-     rtl/rel5/arithmetic/power2p.lisp  \
-     rtl/rel5/arithmetic/predicate.lisp  \
-     rtl/rel5/arithmetic/product-proofs.lisp  \
-     rtl/rel5/arithmetic/product.lisp  \
-     rtl/rel5/arithmetic/rationalp.lisp  \
-     rtl/rel5/arithmetic/top.lisp  \
-     rtl/rel5/arithmetic/unary-divide.lisp  \
-     rtl/rel5/arithmetic/x-2xx.lisp  \
-     rtl/rel5/lib/add.lisp  \
-     rtl/rel5/lib/arith.lisp  \
-     rtl/rel5/lib/basic.lisp  \
-     rtl/rel5/lib/bits.lisp  \
-     rtl/rel5/lib/bvecp-helpers.lisp  \
-     rtl/rel5/lib/bvecp-raw-helpers.lisp  \
-     rtl/rel5/lib/clocks.lisp  \
-     rtl/rel5/lib/float.lisp  \
-     rtl/rel5/lib/log.lisp  \
-     rtl/rel5/lib/openers.lisp  \
-     rtl/rel5/lib/package-defs.lisp  \
-     rtl/rel5/lib/reps.lisp  \
-     rtl/rel5/lib/rom-helpers.lisp  \
-     rtl/rel5/lib/round.lisp  \
-     rtl/rel5/lib/rtl.lisp  \
-     rtl/rel5/lib/rtlarr.lisp  \
-     rtl/rel5/lib/simple-loop-helpers.lisp  \
-     rtl/rel5/lib/simplify-model-helpers.lisp  \
-     rtl/rel5/lib/top.lisp  \
-     rtl/rel5/lib/util.lisp  \
-     rtl/rel5/support/add3-proofs.lisp  \
-     rtl/rel5/support/add3.lisp  \
-     rtl/rel5/support/all-ones.lisp  \
-     rtl/rel5/support/ash.lisp  \
-     rtl/rel5/support/away-proofs.lisp  \
-     rtl/rel5/support/away.lisp  \
-     rtl/rel5/support/badguys.lisp  \
-     rtl/rel5/support/bias-proofs.lisp  \
-     rtl/rel5/support/bias.lisp  \
-     rtl/rel5/support/bitn-proofs.lisp  \
-     rtl/rel5/support/bitn.lisp  \
-     rtl/rel5/support/bits-proofs.lisp  \
-     rtl/rel5/support/bits-trunc-proofs.lisp  \
-     rtl/rel5/support/bits-trunc.lisp  \
-     rtl/rel5/support/bits.lisp  \
-     rtl/rel5/support/bvecp-helpers.lisp  \
-     rtl/rel5/support/bvecp-lemmas.lisp  \
-     rtl/rel5/support/bvecp-proofs.lisp  \
-     rtl/rel5/support/bvecp.lisp  \
-     rtl/rel5/support/cat-def.lisp  \
-     rtl/rel5/support/cat-proofs.lisp  \
-     rtl/rel5/support/cat.lisp  \
-     rtl/rel5/support/clocks.lisp  \
-     rtl/rel5/support/decode-proofs.lisp  \
-     rtl/rel5/support/decode.lisp  \
-     rtl/rel5/support/drnd.lisp  \
-     rtl/rel5/support/encode.lisp  \
-     rtl/rel5/support/ereps-proofs.lisp  \
-     rtl/rel5/support/ereps.lisp  \
-     rtl/rel5/support/fadd-extra.lisp  \
-     rtl/rel5/support/fadd-extra0.lisp  \
-     rtl/rel5/support/fadd.lisp  \
-     rtl/rel5/support/fast-and.lisp  \
-     rtl/rel5/support/float-extra.lisp  \
-     rtl/rel5/support/float.lisp  \
-     rtl/rel5/support/ground-zero.lisp  \
-     rtl/rel5/support/guards.lisp  \
-     rtl/rel5/support/ireps.lisp  \
-     rtl/rel5/support/land.lisp  \
-     rtl/rel5/support/land0-proofs.lisp  \
-     rtl/rel5/support/land0.lisp  \
-     rtl/rel5/support/lextra-proofs.lisp  \
-     rtl/rel5/support/lextra.lisp  \
-     rtl/rel5/support/lextra0.lisp  \
-     rtl/rel5/support/lior.lisp  \
-     rtl/rel5/support/lior0-proofs.lisp  \
-     rtl/rel5/support/lior0.lisp  \
-     rtl/rel5/support/lnot-proofs.lisp  \
-     rtl/rel5/support/lnot.lisp  \
-     rtl/rel5/support/log-equal.lisp  \
-     rtl/rel5/support/log-proofs.lisp  \
-     rtl/rel5/support/log.lisp  \
-     rtl/rel5/support/logand-proofs.lisp  \
-     rtl/rel5/support/logand.lisp  \
-     rtl/rel5/support/logeqv.lisp  \
-     rtl/rel5/support/logior-proofs.lisp  \
-     rtl/rel5/support/logior.lisp  \
-     rtl/rel5/support/logior1-proofs.lisp  \
-     rtl/rel5/support/logior1.lisp  \
-     rtl/rel5/support/lognot.lisp  \
-     rtl/rel5/support/logorc1.lisp  \
-     rtl/rel5/support/logs.lisp  \
-     rtl/rel5/support/logxor.lisp  \
-     rtl/rel5/support/lop1-proofs.lisp  \
-     rtl/rel5/support/lop1.lisp  \
-     rtl/rel5/support/lop2-proofs.lisp  \
-     rtl/rel5/support/lop2.lisp  \
-     rtl/rel5/support/lop3-proofs.lisp  \
-     rtl/rel5/support/lop3.lisp  \
-     rtl/rel5/support/lxor.lisp  \
-     rtl/rel5/support/lxor0-proofs.lisp  \
-     rtl/rel5/support/lxor0.lisp  \
-     rtl/rel5/support/merge.lisp  \
-     rtl/rel5/support/merge2.lisp  \
-     rtl/rel5/support/mod4.lisp  \
-     rtl/rel5/support/model-helpers.lisp  \
-     rtl/rel5/support/mulcat-proofs.lisp  \
-     rtl/rel5/support/mulcat.lisp  \
-     rtl/rel5/support/near+-proofs.lisp  \
-     rtl/rel5/support/near+.lisp  \
-     rtl/rel5/support/near-proofs.lisp  \
-     rtl/rel5/support/near.lisp  \
-     rtl/rel5/support/ocat.lisp  \
-     rtl/rel5/support/oddr-proofs.lisp  \
-     rtl/rel5/support/oddr.lisp  \
-     rtl/rel5/support/openers.lisp  \
-     rtl/rel5/support/package-defs.lisp  \
-     rtl/rel5/support/rewrite-theory.lisp  \
-     rtl/rel5/support/rnd.lisp  \
-     rtl/rel5/support/rom-helpers.lisp  \
-     rtl/rel5/support/round-extra.lisp  \
-     rtl/rel5/support/rtl.lisp  \
-     rtl/rel5/support/rtlarr.lisp  \
-     rtl/rel5/support/setbitn-proofs.lisp  \
-     rtl/rel5/support/setbitn.lisp  \
-     rtl/rel5/support/setbits-proofs.lisp  \
-     rtl/rel5/support/setbits.lisp  \
-     rtl/rel5/support/sgn.lisp  \
-     rtl/rel5/support/shft.lisp  \
-     rtl/rel5/support/simple-loop-helpers.lisp  \
-     rtl/rel5/support/simplify-model-helpers.lisp  \
-     rtl/rel5/support/stick-proofs.lisp  \
-     rtl/rel5/support/stick.lisp  \
-     rtl/rel5/support/sticky-proofs.lisp  \
-     rtl/rel5/support/sticky.lisp  \
-     rtl/rel5/support/sumbits.lisp  \
-     rtl/rel5/support/top.lisp  \
-     rtl/rel5/support/top1.lisp  \
-     rtl/rel5/support/trunc-proofs.lisp  \
-     rtl/rel5/support/trunc.lisp  \
-     rtl/rel5/support/util.lisp  \
-     rtl/rel5/user/away.lisp  \
-     rtl/rel5/user/bias.lisp  \
-     rtl/rel5/user/bitn.lisp  \
-     rtl/rel5/user/bits-trunc.lisp  \
-     rtl/rel5/user/bits.lisp  \
-     rtl/rel5/user/brat.lisp  \
-     rtl/rel5/user/bvecp.lisp  \
-     rtl/rel5/user/cat.lisp  \
-     rtl/rel5/user/decode.lisp  \
-     rtl/rel5/user/ereps.lisp  \
-     rtl/rel5/user/land.lisp  \
-     rtl/rel5/user/lextra.lisp  \
-     rtl/rel5/user/lior.lisp  \
-     rtl/rel5/user/lnot.lisp  \
-     rtl/rel5/user/logior1.lisp  \
-     rtl/rel5/user/lxor.lisp  \
-     rtl/rel5/user/mulcat.lisp  \
-     rtl/rel5/user/near.lisp  \
-     rtl/rel5/user/setbitn.lisp  \
-     rtl/rel5/user/setbits.lisp  \
-     rtl/rel5/user/stick.lisp  \
-     rtl/rel5/user/sumbits.lisp  \
-     rtl/rel5/user/top.lisp  \
-     rtl/rel5/user/trunc.lisp  \
-     rtl/rel8/arithmetic/arith.lisp  \
-     rtl/rel8/arithmetic/arith2.lisp  \
-     rtl/rel8/arithmetic/basic.lisp  \
-     rtl/rel8/arithmetic/cg.lisp  \
-     rtl/rel8/arithmetic/common-factor-defuns.lisp  \
-     rtl/rel8/arithmetic/common-factor.lisp  \
-     rtl/rel8/arithmetic/complex-rationalp.lisp  \
-     rtl/rel8/arithmetic/denominator.lisp  \
-     rtl/rel8/arithmetic/even-odd.lisp  \
-     rtl/rel8/arithmetic/even-odd2-proofs.lisp  \
-     rtl/rel8/arithmetic/even-odd2.lisp  \
-     rtl/rel8/arithmetic/expo-proofs.lisp  \
-     rtl/rel8/arithmetic/expo.lisp  \
-     rtl/rel8/arithmetic/expt-proofs.lisp  \
-     rtl/rel8/arithmetic/expt.lisp  \
-     rtl/rel8/arithmetic/extra-rules.lisp  \
-     rtl/rel8/arithmetic/fl-expt.lisp  \
-     rtl/rel8/arithmetic/fl-hacks.lisp  \
-     rtl/rel8/arithmetic/fl-proofs.lisp  \
-     rtl/rel8/arithmetic/fl.lisp  \
-     rtl/rel8/arithmetic/floor-proofs.lisp  \
-     rtl/rel8/arithmetic/floor.lisp  \
-     rtl/rel8/arithmetic/fp.lisp  \
-     rtl/rel8/arithmetic/fp2.lisp  \
-     rtl/rel8/arithmetic/ground-zero.lisp  \
-     rtl/rel8/arithmetic/hacks.lisp  \
-     rtl/rel8/arithmetic/induct.lisp  \
-     rtl/rel8/arithmetic/integerp.lisp  \
-     rtl/rel8/arithmetic/inverted-factor.lisp  \
-     rtl/rel8/arithmetic/mod-expt.lisp  \
-     rtl/rel8/arithmetic/mod-proofs.lisp  \
-     rtl/rel8/arithmetic/mod.lisp  \
-     rtl/rel8/arithmetic/negative-syntaxp.lisp  \
-     rtl/rel8/arithmetic/nniq.lisp  \
-     rtl/rel8/arithmetic/numerator.lisp  \
-     rtl/rel8/arithmetic/power2p.lisp  \
-     rtl/rel8/arithmetic/predicate.lisp  \
-     rtl/rel8/arithmetic/product-proofs.lisp  \
-     rtl/rel8/arithmetic/product.lisp  \
-     rtl/rel8/arithmetic/rationalp.lisp  \
-     rtl/rel8/arithmetic/top.lisp  \
-     rtl/rel8/arithmetic/unary-divide.lisp  \
-     rtl/rel8/arithmetic/x-2xx.lisp  \
-     rtl/rel8/lib/add.lisp  \
-     rtl/rel8/lib/arith.lisp  \
-     rtl/rel8/lib/basic.lisp  \
-     rtl/rel8/lib/bits.lisp  \
-     rtl/rel8/lib/bvecp-helpers.lisp  \
-     rtl/rel8/lib/bvecp-raw-helpers.lisp  \
-     rtl/rel8/lib/clocks.lisp  \
-     rtl/rel8/lib/float.lisp  \
-     rtl/rel8/lib/log.lisp  \
-     rtl/rel8/lib/logn.lisp  \
-     rtl/rel8/lib/logn2log.lisp  \
-     rtl/rel8/lib/mult.lisp  \
-     rtl/rel8/lib/openers.lisp  \
-     rtl/rel8/lib/package-defs.lisp  \
-     rtl/rel8/lib/reps.lisp  \
-     rtl/rel8/lib/rom-helpers.lisp  \
-     rtl/rel8/lib/round.lisp  \
-     rtl/rel8/lib/rtl.lisp  \
-     rtl/rel8/lib/rtlarr.lisp  \
-     rtl/rel8/lib/simple-loop-helpers.lisp  \
-     rtl/rel8/lib/simplify-model-helpers.lisp  \
-     rtl/rel8/lib/top.lisp  \
-     rtl/rel8/lib/util.lisp  \
-     rtl/rel8/support/lib1.delta1/arith-extra.lisp  \
-     rtl/rel8/support/lib1.delta1/arith.lisp  \
-     rtl/rel8/support/lib1.delta1/basic-extra.lisp  \
-     rtl/rel8/support/lib1.delta1/basic.lisp  \
-     rtl/rel8/support/lib1.delta1/bits-extra.lisp  \
-     rtl/rel8/support/lib1.delta1/bits.lisp  \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.lisp  \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.lisp  \
-     rtl/rel8/support/lib1.delta1/float-extra2.lisp  \
-     rtl/rel8/support/lib1.delta1/float.lisp  \
-     rtl/rel8/support/lib1.delta1/mult-proofs.acl2  \
-     rtl/rel8/support/lib1.delta1/mult-proofs.lisp  \
-     rtl/rel8/support/lib1.delta1/mult.lisp  \
-     rtl/rel8/support/lib1.delta1/round-extra2.lisp  \
-     rtl/rel8/support/lib1.delta1/round.lisp  \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.lisp  \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers.lisp  \
-     rtl/rel8/support/lib1.delta2/float-extra.lisp  \
-     rtl/rel8/support/lib1.delta2/float.lisp  \
-     rtl/rel8/support/lib1/add.lisp  \
-     rtl/rel8/support/lib1/arith.lisp  \
-     rtl/rel8/support/lib1/basic.lisp  \
-     rtl/rel8/support/lib1/bits.lisp  \
-     rtl/rel8/support/lib1/bvecp-helpers.lisp  \
-     rtl/rel8/support/lib1/bvecp-raw-helpers.lisp  \
-     rtl/rel8/support/lib1/clocks.lisp  \
-     rtl/rel8/support/lib1/float.lisp  \
-     rtl/rel8/support/lib1/log.lisp  \
-     rtl/rel8/support/lib1/openers.lisp  \
-     rtl/rel8/support/lib1/package-defs.lisp  \
-     rtl/rel8/support/lib1/reps.lisp  \
-     rtl/rel8/support/lib1/rom-helpers.lisp  \
-     rtl/rel8/support/lib1/round.lisp  \
-     rtl/rel8/support/lib1/rtl.lisp  \
-     rtl/rel8/support/lib1/rtlarr.lisp  \
-     rtl/rel8/support/lib1/simple-loop-helpers.lisp  \
-     rtl/rel8/support/lib1/simplify-model-helpers.lisp  \
-     rtl/rel8/support/lib1/top.lisp  \
-     rtl/rel8/support/lib1/util.lisp  \
-     rtl/rel8/support/lib2.delta1/add-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/add-new.lisp  \
-     rtl/rel8/support/lib2.delta1/add-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/add.lisp  \
-     rtl/rel8/support/lib2.delta1/arith.lisp  \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/bits-new.lisp  \
-     rtl/rel8/support/lib2.delta1/bits-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/bits.lisp  \
-     rtl/rel8/support/lib2.delta1/bvecp-helpers.lisp  \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.lisp  \
-     rtl/rel8/support/lib2.delta1/float-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/float-new.lisp  \
-     rtl/rel8/support/lib2.delta1/float-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/float.lisp  \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/log-new.lisp  \
-     rtl/rel8/support/lib2.delta1/log-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/log-support-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/log-support.lisp  \
-     rtl/rel8/support/lib2.delta1/log.lisp  \
-     rtl/rel8/support/lib2.delta1/logn-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/logn-new.lisp  \
-     rtl/rel8/support/lib2.delta1/logn-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/logn.lisp  \
-     rtl/rel8/support/lib2.delta1/logn2log-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/logn2log.lisp  \
-     rtl/rel8/support/lib2.delta1/mult-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/mult-new.lisp  \
-     rtl/rel8/support/lib2.delta1/mult-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/mult.lisp  \
-     rtl/rel8/support/lib2.delta1/reps-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/reps-new.lisp  \
-     rtl/rel8/support/lib2.delta1/reps-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/reps.lisp  \
-     rtl/rel8/support/lib2.delta1/round-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/round-new.lisp  \
-     rtl/rel8/support/lib2.delta1/round-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/round.lisp  \
-     rtl/rel8/support/lib2.delta1/rtl-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/rtl-new.lisp  \
-     rtl/rel8/support/lib2.delta1/rtl-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/rtl.lisp  \
-     rtl/rel8/support/lib2.delta1/rtlarr-new.lisp  \
-     rtl/rel8/support/lib2.delta1/rtlarr.lisp  \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers.lisp  \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.lisp  \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.lisp  \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers.lisp  \
-     rtl/rel8/support/lib2.delta1/top.lisp  \
-     rtl/rel8/support/lib2.delta1/util.lisp  \
-     rtl/rel8/support/lib2.delta2/add-lib.lisp  \
-     rtl/rel8/support/lib2.delta2/add.lisp  \
-     rtl/rel8/support/lib2.delta2/base.lisp  \
-     rtl/rel8/support/lib2.delta2/bits.lisp  \
-     rtl/rel8/support/lib2.delta2/log.lisp  \
-     rtl/rel8/support/lib2/add.lisp  \
-     rtl/rel8/support/lib2/arith.lisp  \
-     rtl/rel8/support/lib2/base.lisp  \
-     rtl/rel8/support/lib2/basic.lisp  \
-     rtl/rel8/support/lib2/bits.lisp  \
-     rtl/rel8/support/lib2/bvecp-helpers.lisp  \
-     rtl/rel8/support/lib2/bvecp-raw-helpers.lisp  \
-     rtl/rel8/support/lib2/clocks.lisp  \
-     rtl/rel8/support/lib2/float.lisp  \
-     rtl/rel8/support/lib2/log.lisp  \
-     rtl/rel8/support/lib2/mult.lisp  \
-     rtl/rel8/support/lib2/openers.lisp  \
-     rtl/rel8/support/lib2/package-defs.lisp  \
-     rtl/rel8/support/lib2/reps.lisp  \
-     rtl/rel8/support/lib2/rom-helpers.lisp  \
-     rtl/rel8/support/lib2/round.lisp  \
-     rtl/rel8/support/lib2/rtl.lisp  \
-     rtl/rel8/support/lib2/rtlarr.lisp  \
-     rtl/rel8/support/lib2/simple-loop-helpers.lisp  \
-     rtl/rel8/support/lib2/simplify-model-helpers.lisp  \
-     rtl/rel8/support/lib2/top.lisp  \
-     rtl/rel8/support/lib2/util.lisp  \
-     rtl/rel8/support/support/add3-proofs.lisp  \
-     rtl/rel8/support/support/add3.lisp  \
-     rtl/rel8/support/support/all-ones.lisp  \
-     rtl/rel8/support/support/ash.lisp  \
-     rtl/rel8/support/support/away-proofs.lisp  \
-     rtl/rel8/support/support/away.lisp  \
-     rtl/rel8/support/support/badguys.lisp  \
-     rtl/rel8/support/support/bias-proofs.lisp  \
-     rtl/rel8/support/support/bias.lisp  \
-     rtl/rel8/support/support/bitn-proofs.lisp  \
-     rtl/rel8/support/support/bitn.lisp  \
-     rtl/rel8/support/support/bits-proofs.lisp  \
-     rtl/rel8/support/support/bits-trunc-proofs.lisp  \
-     rtl/rel8/support/support/bits-trunc.lisp  \
-     rtl/rel8/support/support/bits.lisp  \
-     rtl/rel8/support/support/bvecp-helpers.lisp  \
-     rtl/rel8/support/support/bvecp-lemmas.lisp  \
-     rtl/rel8/support/support/bvecp-proofs.lisp  \
-     rtl/rel8/support/support/bvecp.lisp  \
-     rtl/rel8/support/support/cat-def.lisp  \
-     rtl/rel8/support/support/cat-proofs.lisp  \
-     rtl/rel8/support/support/cat.lisp  \
-     rtl/rel8/support/support/clocks.lisp  \
-     rtl/rel8/support/support/decode-proofs.lisp  \
-     rtl/rel8/support/support/decode.lisp  \
-     rtl/rel8/support/support/drnd-original.lisp  \
-     rtl/rel8/support/support/encode.lisp  \
-     rtl/rel8/support/support/ereps-proofs.lisp  \
-     rtl/rel8/support/support/ereps.lisp  \
-     rtl/rel8/support/support/fadd-extra.lisp  \
-     rtl/rel8/support/support/fadd-extra0.lisp  \
-     rtl/rel8/support/support/fadd.lisp  \
-     rtl/rel8/support/support/fast-and.lisp  \
-     rtl/rel8/support/support/float-extra.lisp  \
-     rtl/rel8/support/support/float.lisp  \
-     rtl/rel8/support/support/ground-zero.lisp  \
-     rtl/rel8/support/support/guards.lisp  \
-     rtl/rel8/support/support/ireps.lisp  \
-     rtl/rel8/support/support/land.lisp  \
-     rtl/rel8/support/support/land0-proofs.lisp  \
-     rtl/rel8/support/support/land0.lisp  \
-     rtl/rel8/support/support/lextra-proofs.lisp  \
-     rtl/rel8/support/support/lextra.lisp  \
-     rtl/rel8/support/support/lextra0.lisp  \
-     rtl/rel8/support/support/lior.lisp  \
-     rtl/rel8/support/support/lior0-proofs.lisp  \
-     rtl/rel8/support/support/lior0.lisp  \
-     rtl/rel8/support/support/lnot-proofs.lisp  \
-     rtl/rel8/support/support/lnot.lisp  \
-     rtl/rel8/support/support/log-equal.lisp  \
-     rtl/rel8/support/support/log-proofs.lisp  \
-     rtl/rel8/support/support/log.lisp  \
-     rtl/rel8/support/support/logand-proofs.lisp  \
-     rtl/rel8/support/support/logand.lisp  \
-     rtl/rel8/support/support/logeqv.lisp  \
-     rtl/rel8/support/support/logior-proofs.lisp  \
-     rtl/rel8/support/support/logior.lisp  \
-     rtl/rel8/support/support/logior1-proofs.lisp  \
-     rtl/rel8/support/support/logior1.lisp  \
-     rtl/rel8/support/support/lognot.lisp  \
-     rtl/rel8/support/support/logorc1.lisp  \
-     rtl/rel8/support/support/logs.lisp  \
-     rtl/rel8/support/support/logxor.lisp  \
-     rtl/rel8/support/support/lop1-proofs.lisp  \
-     rtl/rel8/support/support/lop1.lisp  \
-     rtl/rel8/support/support/lop2-proofs.lisp  \
-     rtl/rel8/support/support/lop2.lisp  \
-     rtl/rel8/support/support/lop3-proofs.lisp  \
-     rtl/rel8/support/support/lop3.lisp  \
-     rtl/rel8/support/support/lxor.lisp  \
-     rtl/rel8/support/support/lxor0-proofs.lisp  \
-     rtl/rel8/support/support/lxor0.lisp  \
-     rtl/rel8/support/support/merge.lisp  \
-     rtl/rel8/support/support/merge2.lisp  \
-     rtl/rel8/support/support/mod4.lisp  \
-     rtl/rel8/support/support/model-helpers.lisp  \
-     rtl/rel8/support/support/mulcat-proofs.lisp  \
-     rtl/rel8/support/support/mulcat.lisp  \
-     rtl/rel8/support/support/near+-proofs.lisp  \
-     rtl/rel8/support/support/near+.lisp  \
-     rtl/rel8/support/support/near-proofs.lisp  \
-     rtl/rel8/support/support/near.lisp  \
-     rtl/rel8/support/support/ocat.lisp  \
-     rtl/rel8/support/support/oddr-proofs.lisp  \
-     rtl/rel8/support/support/oddr.lisp  \
-     rtl/rel8/support/support/openers.lisp  \
-     rtl/rel8/support/support/package-defs.lisp  \
-     rtl/rel8/support/support/rewrite-theory.lisp  \
-     rtl/rel8/support/support/rnd.lisp  \
-     rtl/rel8/support/support/rom-helpers.lisp  \
-     rtl/rel8/support/support/round-extra.lisp  \
-     rtl/rel8/support/support/rtl.lisp  \
-     rtl/rel8/support/support/rtlarr.lisp  \
-     rtl/rel8/support/support/setbitn-proofs.lisp  \
-     rtl/rel8/support/support/setbitn.lisp  \
-     rtl/rel8/support/support/setbits-proofs.lisp  \
-     rtl/rel8/support/support/setbits.lisp  \
-     rtl/rel8/support/support/sgn.lisp  \
-     rtl/rel8/support/support/shft.lisp  \
-     rtl/rel8/support/support/simple-loop-helpers.lisp  \
-     rtl/rel8/support/support/simplify-model-helpers.lisp  \
-     rtl/rel8/support/support/stick-proofs.lisp  \
-     rtl/rel8/support/support/stick.lisp  \
-     rtl/rel8/support/support/sticky-proofs.lisp  \
-     rtl/rel8/support/support/sticky.lisp  \
-     rtl/rel8/support/support/sumbits.lisp  \
-     rtl/rel8/support/support/top.lisp  \
-     rtl/rel8/support/support/top1.lisp  \
-     rtl/rel8/support/support/trunc-proofs.lisp  \
-     rtl/rel8/support/support/trunc.lisp  \
-     rtl/rel8/support/support/util.lisp  \
-     rtl/rel8/support/top/top.lisp  \
-     security/jfkr/cert.acl2  \
-     security/jfkr/diffie-helman.lisp  \
-     security/jfkr/encryption.lisp  \
-     security/jfkr/jfkr.lisp  \
-     security/jfkr/package.lsp  \
-     security/jfkr/random.lisp  \
-     security/suite-b/sha-2.lisp  \
-     security/util/byte-operations.lisp  \
-     serialize/serialize-tests.acl2  \
-     serialize/serialize-tests.lisp  \
-     serialize/serialize-tests2.acl2  \
-     serialize/serialize-tests2.lisp  \
-     serialize/unsound-read.acl2  \
-     serialize/unsound-read.lisp  \
-     sorting/bsort.lisp  \
-     sorting/convert-perm-to-how-many.lisp  \
-     sorting/equisort.lisp  \
-     sorting/equisort2.lisp  \
-     sorting/equisort3.lisp  \
-     sorting/isort.lisp  \
-     sorting/msort.lisp  \
-     sorting/no-dups-qsort.lisp  \
-     sorting/ordered-perms.lisp  \
-     sorting/perm.lisp  \
-     sorting/qsort.lisp  \
-     sorting/sorts-equivalent.lisp  \
-     sorting/sorts-equivalent2.lisp  \
-     sorting/sorts-equivalent3.lisp  \
-     std/io/base.lisp  \
-     std/io/close-input-channel.lisp  \
-     std/io/combine.lisp  \
-     std/io/file-measure.lisp  \
-     std/io/nthcdr-bytes.lisp  \
-     std/io/open-input-channel.lisp  \
-     std/io/open-input-channels.lisp  \
-     std/io/peek-char.lisp  \
-     std/io/read-byte.lisp  \
-     std/io/read-char.lisp  \
-     std/io/read-file-bytes.lisp  \
-     std/io/read-file-characters-no-error.acl2  \
-     std/io/read-file-characters-no-error.lisp  \
-     std/io/read-file-characters.lisp  \
-     std/io/read-file-lines.lisp  \
-     std/io/read-file-objects.lisp  \
-     std/io/read-ints.lisp  \
-     std/io/read-object.lisp  \
-     std/io/sign-byte.lisp  \
-     std/io/signed-byte-listp.lisp  \
-     std/io/take-bytes.lisp  \
-     std/io/unsigned-byte-listp.lisp  \
-     std/ks/base10-digit-charp.lisp  \
-     std/ks/explode-atom.lisp  \
-     std/ks/explode-nonnegative-integer.lisp  \
-     std/ks/intern-in-package-of-symbol.lisp  \
-     std/ks/string-append.lisp  \
-     std/ks/two-nats-measure.lisp  \
-     std/lists/app.lisp  \
-     std/lists/append.lisp  \
-     std/lists/coerce.lisp  \
-     std/lists/consless-listp.lisp  \
-     std/lists/equiv.lisp  \
-     std/lists/final-cdr.lisp  \
-     std/lists/flatten.lisp  \
-     std/lists/list-defuns.lisp  \
-     std/lists/list-fix.lisp  \
-     std/lists/make-character-list.lisp  \
-     std/lists/mfc-utils.lisp  \
-     std/lists/nat-listp.lisp  \
-     std/lists/nthcdr.lisp  \
-     std/lists/prefixp.lisp  \
-     std/lists/repeat.lisp  \
-     std/lists/rev.lisp  \
-     std/lists/revappend.lisp  \
-     std/lists/reverse.lisp  \
-     std/lists/sets.lisp  \
-     std/lists/take.lisp  \
-     str/abbrevs.lisp  \
-     str/arithmetic.lisp  \
-     str/case-conversion.lisp  \
-     str/cat.lisp  \
-     str/cert.acl2  \
-     str/char-case.lisp  \
-     str/digitp.lisp  \
-     str/eqv.lisp  \
-     str/fast-cat.acl2  \
-     str/fast-cat.lisp  \
-     str/firstn-chars.lisp  \
-     str/hexify.lisp  \
-     str/html-encode.lisp  \
-     str/ieqv.lisp  \
-     str/iless.lisp  \
-     str/iprefixp.lisp  \
-     str/isort.lisp  \
-     str/istrpos.lisp  \
-     str/istrprefixp.lisp  \
-     str/isubstrp.lisp  \
-     str/natstr.lisp  \
-     str/package.lsp  \
-     str/pad.lisp  \
-     str/portcullis.acl2  \
-     str/portcullis.lisp  \
-     str/prefix-lines.lisp  \
-     str/stringify.lisp  \
-     str/strline.lisp  \
-     str/strnatless.lisp  \
-     str/strpos.lisp  \
-     str/strprefixp.lisp  \
-     str/strrpos.lisp  \
-     str/strsplit.lisp  \
-     str/strsubst.lisp  \
-     str/strtok.lisp  \
-     str/strval.lisp  \
-     str/subseq.lisp  \
-     str/substrp.lisp  \
-     str/suffixp.lisp  \
-     str/top.lisp  \
-     symbolic/generic/assertions.lisp  \
-     symbolic/generic/defsimulate.lisp  \
-     symbolic/generic/factorial-jvm-correct.acl2  \
-     symbolic/generic/factorial-jvm-correct.lisp  \
-     symbolic/generic/measures.lisp  \
-     symbolic/generic/partial-correctness.lisp  \
-     symbolic/generic/tiny-fib-correct.lisp  \
-     symbolic/generic/total-correctness.lisp  \
-     symbolic/m5/demo.acl2  \
-     symbolic/m5/demo.lisp  \
-     symbolic/m5/utilities.acl2  \
-     symbolic/m5/utilities.lisp  \
-     symbolic/tiny-fib/defstobj+.lisp  \
-     symbolic/tiny-fib/fib-def.lisp  \
-     symbolic/tiny-fib/tiny-rewrites.lisp  \
-     symbolic/tiny-fib/tiny.lisp  \
-     symbolic/tiny-triangle/tiny-triangle-correct.lisp  \
-     symbolic/tiny-triangle/triangle-def.lisp  \
-     system/compare-out-files.lisp  \
-     system/convert-normalized-term-to-pairs.lisp  \
-     system/extend-pathname.lisp  \
-     system/f-put-global.lisp  \
-     system/gather-dcls.lisp  \
-     system/hl-addr-combine.lisp  \
-     system/io.lisp  \
-     system/legal-variablep.lisp  \
-     system/meta-extract.lisp  \
-     system/pseudo-good-worldp.lisp  \
-     system/pseudo-termp-lemmas.lisp  \
-     system/subcor-var.lisp  \
-     system/sublis-var.lisp  \
-     system/subst-expr.lisp  \
-     system/subst-var.lisp  \
-     system/too-many-ifs.acl2  \
-     system/too-many-ifs.lisp  \
-     system/top.lisp  \
-     system/update-state.lisp  \
-     system/verified-termination-and-guards.lisp  \
-     system/worldp-check.acl2  \
-     system/worldp-check.lisp  \
-     taspi/code/brlens/brlens.lisp  \
-     taspi/code/brlens/trees-with-brlens.lisp  \
-     taspi/code/build/build-term-guards.lisp  \
-     taspi/code/build/build-term.lisp  \
-     taspi/code/fringes/fringes-guards.lisp  \
-     taspi/code/fringes/fringes-props.lisp  \
-     taspi/code/fringes/fringes.lisp  \
-     taspi/code/gen-helper/bdd-functions.lisp  \
-     taspi/code/gen-helper/extra.lisp  \
-     taspi/code/gen-helper/fast-lists.lisp  \
-     taspi/code/gen-helper/sets.lisp  \
-     taspi/code/gen-helper/top.lisp  \
-     taspi/code/gen-trees/app-rev-lists.lisp  \
-     taspi/code/gen-trees/btrees-bdds-sets.lisp  \
-     taspi/code/gen-trees/btrees-bdds.lisp  \
-     taspi/code/gen-trees/btrees.lisp  \
-     taspi/code/gen-trees/sets-lists-trees.lisp  \
-     taspi/code/gen-trees/top.lisp  \
-     taspi/code/gen-trees/tree-predicates.lisp  \
-     taspi/code/replete/replete-guards.lisp  \
-     taspi/code/replete/replete-helper.lisp  \
-     taspi/code/replete/replete.lisp  \
-     taspi/code/sequences/align.lisp  \
-     taspi/code/sequences/p-inform.lisp  \
-     taspi/code/sequences/seqs.lisp  \
-     taspi/code/tree-manip/insertion-based-sort.lisp  \
-     taspi/code/tree-manip/merge-based-sort.lisp  \
-     taspi/code/tree-manip/mv-root.lisp  \
-     taspi/code/tree-manip/quicksort.lisp  \
-     taspi/code/tree-manip/sort-help.lisp  \
-     taspi/code/tree-manip/top.lisp  \
-     taspi/database/db-from-list.lisp  \
-     taspi/database/db.lisp  \
-     taspi/database/entry.lisp  \
-     taspi/database/filters.lisp  \
-     taspi/database/props.lisp  \
-     taspi/proofs/fringes-taspi.acl2  \
-     taspi/proofs/fringes-taspi.lisp  \
-     taspi/proofs/omerge-good-order.acl2  \
-     taspi/proofs/omerge-good-order.lisp  \
-     taspi/proofs/sets.acl2  \
-     taspi/proofs/sets.lisp  \
-     taspi/sets-input/consensus.lisp  \
-     taspi/sets-input/greedy.lisp  \
-     taspi/sets-input/mast.lisp  \
-     taspi/sets-input/mct.lisp  \
-     taspi/sets-input/multipolar-loose.lisp  \
-     taspi/sets-input/top.lisp  \
-     taspi/sets-input/tree-compat.lisp  \
-     taspi/sets-input/tree-support-in-set.lisp  \
-     taspi/single-input/taxa-based.lisp  \
-     taspi/single-input/tree-stats.lisp  \
-     taspi/tree-distance/rf.lisp  \
-     taspi/tree-distance/symm-diff.lisp  \
-     taspi/tree-generation/branch-and-bound/bandb.lisp  \
-     taspi/tree-generation/distance-based/naive-quartet-method.lisp  \
-     taspi/tree-generation/heuristics/do-search.lisp  \
-     taspi/tree-generation/heuristics/spr.lisp  \
-     taspi/tree-generation/heuristics/tbr.lisp  \
-     taspi/tree-generation/tree-gen-helper/basics.lisp  \
-     taspi/tree-score/ambig-score.lisp  \
-     taspi/tree-score/circle-scoring.lisp  \
-     taspi/tree-score/costs.lisp  \
-     taspi/tree-score/efficient-pscores-help.lisp  \
-     taspi/tree-score/efficient-pscores.lisp  \
-     taspi/tree-score/fitch-scoring.lisp  \
-     taspi/tree-score/min-length.lisp  \
-     taspi/tree-score/opt-pairwise.lisp  \
-     taspi/tree-score/pscores.lisp  \
-     tau/bounders/elementary-bounders.lisp  \
-     tau/bounders/find-maximal-1d.lisp  \
-     tau/bounders/find-maximal-2d.lisp  \
-     tau/bounders/find-minimal-1d.lisp  \
-     tau/bounders/find-minimal-2d.lisp  \
-     textbook/chap10/ac-example.lisp  \
-     textbook/chap10/adder.lisp  \
-     textbook/chap10/compiler.acl2  \
-     textbook/chap10/compiler.lisp  \
-     textbook/chap10/fact.lisp  \
-     textbook/chap10/insertion-sort.lisp  \
-     textbook/chap10/tree.lisp  \
-     textbook/chap11/compress.lisp  \
-     textbook/chap11/encap.lisp  \
-     textbook/chap11/finite-sets.lisp  \
-     textbook/chap11/how-many-soln1.lisp  \
-     textbook/chap11/how-many-soln2.lisp  \
-     textbook/chap11/mergesort.lisp  \
-     textbook/chap11/perm-append.lisp  \
-     textbook/chap11/perm.lisp  \
-     textbook/chap11/qsort.lisp  \
-     textbook/chap11/starters.lisp  \
-     textbook/chap11/summations-book.lisp  \
-     textbook/chap11/summations.lisp  \
-     textbook/chap11/tautology.lisp  \
-     textbook/chap11/xtr.lisp  \
-     textbook/chap11/xtr2.lisp  \
-     textbook/chap3/programs.lisp  \
-     textbook/chap4/solutions-logic-mode.lisp  \
-     textbook/chap4/solutions-program-mode.lisp  \
-     textbook/chap5/solutions.lisp  \
-     textbook/chap6/selected-solutions.lisp  \
-     tools/bstar.lisp  \
-     tools/case-splitting-rules.lisp  \
-     tools/clone-stobj.lisp  \
-     tools/cws.lisp  \
-     tools/def-functional-instance.lisp  \
-     tools/defconsts.lisp  \
-     tools/defevaluator-fast.lisp  \
-     tools/define-keyed-function.lisp  \
-     tools/defined-const.lisp  \
-     tools/defmacfun.lisp  \
-     tools/defredundant.lisp  \
-     tools/defsum.lisp  \
-     tools/deftuple.lisp  \
-     tools/do-not.lisp  \
-     tools/easy-simplify.lisp  \
-     tools/fake-event.lisp  \
-     tools/flag-package.lsp  \
-     tools/flag.acl2  \
-     tools/flag.lisp  \
-     tools/in-raw-mode.acl2  \
-     tools/in-raw-mode.lisp  \
-     tools/include-raw.lisp  \
-     tools/mv-nth.lisp  \
-     tools/oracle-eval-real.acl2  \
-     tools/oracle-eval-real.lisp  \
-     tools/oracle-eval.lisp  \
-     tools/pack.lisp  \
-     tools/pattern-match.lisp  \
-     tools/plev-ccl.acl2  \
-     tools/plev-ccl.lisp  \
-     tools/plev.lisp  \
-     tools/rulesets.lisp  \
-     tools/safe-case.lisp  \
-     tools/saved-errors.lisp  \
-     tools/stobj-frame.lisp  \
-     tools/stobj-help.lisp  \
-     tools/templates.lisp  \
-     tools/theory-tools.lisp  \
-     tools/time-dollar-with-gc.acl2  \
-     tools/time-dollar-with-gc.lisp  \
-     tools/types-misc.lisp  \
-     tools/with-arith5-help.lisp  \
-     tools/with-quoted-forms.lisp  \
-     tutorial-problems/introductory-challenge-problem-4-athena.lisp  \
-     tutorial-problems/introductory-challenge-problem-4.lisp  \
-     unicode/partition.lisp  \
-     unicode/read-utf8.lisp  \
-     unicode/sum-list.lisp  \
-     unicode/uchar.lisp  \
-     unicode/utf8-decode.lisp  \
-     unicode/utf8-encode.lisp  \
-     unicode/utf8-table35.lisp  \
-     unicode/utf8-table36.lisp  \
-     unicode/z-listp.lisp  \
-     workshops/1999/calculus/solutions/mesh-append.lisp  \
-     workshops/1999/calculus/solutions/mesh-make-partition.lisp  \
-     workshops/1999/calculus/solutions/partition-defuns.lisp  \
-     workshops/1999/calculus/solutions/partitionp-make-partition-rec.lisp  \
-     workshops/1999/calculus/solutions/partitionp-make-partition.lisp  \
-     workshops/1999/calculus/solutions/riemann-rcfn-helpers.lisp  \
-     workshops/1999/compiler/compiler.lisp  \
-     workshops/1999/compiler/evaluator.lisp  \
-     workshops/1999/compiler/exercises.lisp  \
-     workshops/1999/compiler/machine.lisp  \
-     workshops/1999/compiler/proof.lisp  \
-     workshops/1999/compiler/proof1.lisp  \
-     workshops/1999/de-hdl/arity.lisp  \
-     workshops/1999/de-hdl/de4.lisp  \
-     workshops/1999/de-hdl/examples.lisp  \
-     workshops/1999/de-hdl/help-defuns.lisp  \
-     workshops/1999/de-hdl/measure.lisp  \
-     workshops/1999/de-hdl/primitives.lisp  \
-     workshops/1999/de-hdl/sts-okp.lisp  \
-     workshops/1999/de-hdl/syntax.lisp  \
-     workshops/1999/de-hdl/thm-example.lisp  \
-     workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.lisp  \
-     workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.lisp  \
-     workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.lisp  \
-     workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.lisp  \
-     workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/CRT.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/Generic.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/Mapping.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.lisp  \
-     workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.lisp  \
-     workshops/1999/graph/find-path1.lisp  \
-     workshops/1999/graph/find-path2.lisp  \
-     workshops/1999/graph/find-path3.lisp  \
-     workshops/1999/graph/helpers.lisp  \
-     workshops/1999/graph/linear-find-path.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/alls.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/cnf.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/flip.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/keval.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/modeler.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/nnf.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/paramod.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prover.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/resolve.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sets.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simplify.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/substitution.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sugar.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/top.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/variables.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.lisp  \
-     workshops/1999/ivy/ivy-v2/ivy-sources/xeval.lisp  \
-     workshops/1999/knuth-91/aof.acl2  \
-     workshops/1999/knuth-91/aof.lisp  \
-     workshops/1999/knuth-91/exercise1.acl2  \
-     workshops/1999/knuth-91/exercise1.lisp  \
-     workshops/1999/knuth-91/exercise2.lisp  \
-     workshops/1999/knuth-91/exercise3.lisp  \
-     workshops/1999/knuth-91/exercise4a.lisp  \
-     workshops/1999/knuth-91/exercise4b.lisp  \
-     workshops/1999/knuth-91/exercise5.lisp  \
-     workshops/1999/knuth-91/exercise6a.lisp  \
-     workshops/1999/knuth-91/exercise6b.lisp  \
-     workshops/1999/knuth-91/exercise7a.lisp  \
-     workshops/1999/knuth-91/exercise7b.lisp  \
-     workshops/1999/knuth-91/knuth-arch.lisp  \
-     workshops/1999/mu-calculus/book/fast-sets.acl2  \
-     workshops/1999/mu-calculus/book/fast-sets.lisp  \
-     workshops/1999/mu-calculus/book/fixpoints.acl2  \
-     workshops/1999/mu-calculus/book/fixpoints.lisp  \
-     workshops/1999/mu-calculus/book/models.acl2  \
-     workshops/1999/mu-calculus/book/models.lisp  \
-     workshops/1999/mu-calculus/book/relations.acl2  \
-     workshops/1999/mu-calculus/book/relations.lisp  \
-     workshops/1999/mu-calculus/book/semantics.acl2  \
-     workshops/1999/mu-calculus/book/semantics.lisp  \
-     workshops/1999/mu-calculus/book/sets.acl2  \
-     workshops/1999/mu-calculus/book/sets.lisp  \
-     workshops/1999/mu-calculus/book/syntax.acl2  \
-     workshops/1999/mu-calculus/book/syntax.lisp  \
-     workshops/1999/mu-calculus/solutions/ctl.acl2  \
-     workshops/1999/mu-calculus/solutions/ctl.lisp  \
-     workshops/1999/mu-calculus/solutions/defung.lisp  \
-     workshops/1999/mu-calculus/solutions/fast-sets.acl2  \
-     workshops/1999/mu-calculus/solutions/fast-sets.lisp  \
-     workshops/1999/mu-calculus/solutions/fixpoints.acl2  \
-     workshops/1999/mu-calculus/solutions/fixpoints.lisp  \
-     workshops/1999/mu-calculus/solutions/meta.lisp  \
-     workshops/1999/mu-calculus/solutions/models.acl2  \
-     workshops/1999/mu-calculus/solutions/models.lisp  \
-     workshops/1999/mu-calculus/solutions/perm.lisp  \
-     workshops/1999/mu-calculus/solutions/relations.acl2  \
-     workshops/1999/mu-calculus/solutions/relations.lisp  \
-     workshops/1999/mu-calculus/solutions/semantics.acl2  \
-     workshops/1999/mu-calculus/solutions/semantics.lisp  \
-     workshops/1999/mu-calculus/solutions/sets.acl2  \
-     workshops/1999/mu-calculus/solutions/sets.lisp  \
-     workshops/1999/mu-calculus/solutions/syntax.acl2  \
-     workshops/1999/mu-calculus/solutions/syntax.lisp  \
-     workshops/1999/pipeline/b-ops-aux-def.lisp  \
-     workshops/1999/pipeline/b-ops-aux.lisp  \
-     workshops/1999/pipeline/basic-def.acl2  \
-     workshops/1999/pipeline/basic-def.lisp  \
-     workshops/1999/pipeline/basic-lemmas.lisp  \
-     workshops/1999/pipeline/define-u-package.lsp  \
-     workshops/1999/pipeline/exercise.lisp  \
-     workshops/1999/pipeline/ihs.lisp  \
-     workshops/1999/pipeline/model.lisp  \
-     workshops/1999/pipeline/proof.lisp  \
-     workshops/1999/pipeline/table-def.lisp  \
-     workshops/1999/pipeline/trivia.lisp  \
-     workshops/1999/pipeline/utils.acl2  \
-     workshops/1999/pipeline/utils.lisp  \
-     workshops/1999/simulator/exercises.lisp  \
-     workshops/1999/simulator/tiny.lisp  \
-     workshops/1999/ste/assertion.lisp  \
-     workshops/1999/ste/boolean.lisp  \
-     workshops/1999/ste/circuit.lisp  \
-     workshops/1999/ste/example.lisp  \
-     workshops/1999/ste/expression.lisp  \
-     workshops/1999/ste/fundamental.lisp  \
-     workshops/1999/ste/inference.lisp  \
-     workshops/1999/ste/lemma-4.lisp  \
-     workshops/1999/ste/run.lisp  \
-     workshops/1999/ste/state.lisp  \
-     workshops/1999/ste/trajectory.lisp  \
-     workshops/1999/ste/util.lisp  \
-     workshops/1999/vhdl/exercises.lisp  \
-     workshops/1999/vhdl/fact-proof.lisp  \
-     workshops/1999/vhdl/fact.lisp  \
-     workshops/1999/vhdl/vhdl.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/base.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/compile.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/cstate.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/expr.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/lstate.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/pstate.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/setup.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/simulator.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.lisp  \
-     workshops/2000/lusk-mccune/lusk-mccune-final/util.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/top/ihs.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.lisp  \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.lisp  \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.lisp  \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux.lisp  \
-     workshops/2000/manolios/pipeline/trivial/basic-def.acl2  \
-     workshops/2000/manolios/pipeline/trivial/basic-def.lisp  \
-     workshops/2000/manolios/pipeline/trivial/basic-lemmas.lisp  \
-     workshops/2000/manolios/pipeline/trivial/define-u-package.lsp  \
-     workshops/2000/manolios/pipeline/trivial/ihs.lisp  \
-     workshops/2000/manolios/pipeline/trivial/model.lisp  \
-     workshops/2000/manolios/pipeline/trivial/proof.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.acl2  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/define-u-package.lsp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/proof.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.lisp  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.acl2  \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.lisp  \
-     workshops/2000/manolios/pipeline/trivial/table-def.lisp  \
-     workshops/2000/manolios/pipeline/trivial/trivia.lisp  \
-     workshops/2000/manolios/pipeline/trivial/utils.acl2  \
-     workshops/2000/manolios/pipeline/trivial/utils.lisp  \
-     workshops/2000/medina/polynomials/addition.acl2  \
-     workshops/2000/medina/polynomials/addition.lisp  \
-     workshops/2000/medina/polynomials/certification.acl2  \
-     workshops/2000/medina/polynomials/congruences-1.acl2  \
-     workshops/2000/medina/polynomials/congruences-1.lisp  \
-     workshops/2000/medina/polynomials/congruences-2.acl2  \
-     workshops/2000/medina/polynomials/congruences-2.lisp  \
-     workshops/2000/medina/polynomials/examples.acl2  \
-     workshops/2000/medina/polynomials/examples.lisp  \
-     workshops/2000/medina/polynomials/lexicographical-ordering.acl2  \
-     workshops/2000/medina/polynomials/lexicographical-ordering.lisp  \
-     workshops/2000/medina/polynomials/monomial.acl2  \
-     workshops/2000/medina/polynomials/monomial.lisp  \
-     workshops/2000/medina/polynomials/multiplication.acl2  \
-     workshops/2000/medina/polynomials/multiplication.lisp  \
-     workshops/2000/medina/polynomials/negation.acl2  \
-     workshops/2000/medina/polynomials/negation.lisp  \
-     workshops/2000/medina/polynomials/normal-form.acl2  \
-     workshops/2000/medina/polynomials/normal-form.lisp  \
-     workshops/2000/medina/polynomials/polynomial.acl2  \
-     workshops/2000/medina/polynomials/polynomial.lisp  \
-     workshops/2000/medina/polynomials/term.acl2  \
-     workshops/2000/medina/polynomials/term.lisp  \
-     workshops/2000/moore-manolios/partial-functions/defpun-original.lisp  \
-     workshops/2000/moore-manolios/partial-functions/defpun.lisp  \
-     workshops/2000/moore-manolios/partial-functions/examples.acl2  \
-     workshops/2000/moore-manolios/partial-functions/examples.lisp  \
-     workshops/2000/moore-manolios/partial-functions/mod-1-property.lisp  \
-     workshops/2000/moore-manolios/partial-functions/report.lisp  \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.acl2  \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.lisp  \
-     workshops/2000/moore-manolios/partial-functions/tjvm.acl2  \
-     workshops/2000/moore-manolios/partial-functions/tjvm.lisp  \
-     workshops/2000/ruiz/multiset/defmul.acl2  \
-     workshops/2000/ruiz/multiset/defmul.lisp  \
-     workshops/2000/ruiz/multiset/examples/ackermann/ackermann.lisp  \
-     workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.lisp  \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.lisp  \
-     workshops/2000/ruiz/multiset/examples/newman/confluence-v0.acl2  \
-     workshops/2000/ruiz/multiset/examples/newman/confluence-v0.lisp  \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.acl2  \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.lisp  \
-     workshops/2000/ruiz/multiset/examples/newman/local-confluence.acl2  \
-     workshops/2000/ruiz/multiset/examples/newman/local-confluence.lisp  \
-     workshops/2000/ruiz/multiset/examples/newman/newman.acl2  \
-     workshops/2000/ruiz/multiset/examples/newman/newman.lisp  \
-     workshops/2000/ruiz/multiset/multiset.acl2  \
-     workshops/2000/ruiz/multiset/multiset.lisp  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.acl2  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.lisp  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.acl2  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.lisp  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.acl2  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.lisp  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.acl2  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.lisp  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/main.acl2  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/main.lisp  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.acl2  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.lisp  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.acl2  \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.lisp  \
-     workshops/2000/russinoff-short/crt.lisp  \
-     workshops/2000/russinoff-short/summary.lisp  \
-     workshops/2000/sumners1/cdeq/cdeq-defs.lisp  \
-     workshops/2000/sumners1/cdeq/cdeq-phase1.lisp  \
-     workshops/2000/sumners1/cdeq/cdeq-phase2.lisp  \
-     workshops/2000/sumners1/cdeq/cdeq-phase3.lisp  \
-     workshops/2000/sumners1/cdeq/cdeq-phase4.lisp  \
-     workshops/2000/sumners1/cdeq/records.lisp  \
-     workshops/2000/sumners2/bdds/bdd-mgr.lisp  \
-     workshops/2000/sumners2/bdds/bdd-prf.lisp  \
-     workshops/2000/sumners2/bdds/bdd-spec.lisp  \
-     workshops/2002/cowles-flat/support/flat-ackermann.acl2  \
-     workshops/2002/cowles-flat/support/flat-ackermann.lisp  \
-     workshops/2002/cowles-flat/support/flat-nested.acl2  \
-     workshops/2002/cowles-flat/support/flat-nested.lisp  \
-     workshops/2002/cowles-flat/support/flat-primitive.acl2  \
-     workshops/2002/cowles-flat/support/flat-primitive.lisp  \
-     workshops/2002/cowles-flat/support/flat-reverse.acl2  \
-     workshops/2002/cowles-flat/support/flat-reverse.lisp  \
-     workshops/2002/cowles-flat/support/flat-tail.acl2  \
-     workshops/2002/cowles-flat/support/flat-tail.lisp  \
-     workshops/2002/cowles-flat/support/flat-z.acl2  \
-     workshops/2002/cowles-flat/support/flat-z.lisp  \
-     workshops/2002/cowles-flat/support/flat.acl2  \
-     workshops/2002/cowles-flat/support/flat.lisp  \
-     workshops/2002/cowles-primrec/support/bad-def.acl2  \
-     workshops/2002/cowles-primrec/support/bad-def.lisp  \
-     workshops/2002/cowles-primrec/support/bad-def1.acl2  \
-     workshops/2002/cowles-primrec/support/bad-def1.lisp  \
-     workshops/2002/cowles-primrec/support/defpr.lisp  \
-     workshops/2002/cowles-primrec/support/fix.lisp  \
-     workshops/2002/cowles-primrec/support/primitive.lisp  \
-     workshops/2002/cowles-primrec/support/tail.lisp  \
-     workshops/2002/georgelin-borrione-ostier/support/acl2-transl.lisp  \
-     workshops/2002/georgelin-borrione-ostier/support/generates-functions.lisp  \
-     workshops/2002/georgelin-borrione-ostier/support/generates-theorems.lisp  \
-     workshops/2002/georgelin-borrione-ostier/support/utils.lisp  \
-     workshops/2002/kaufmann-sumners/support/records.lisp  \
-     workshops/2002/kaufmann-sumners/support/records0.lisp  \
-     workshops/2002/kaufmann-sumners/support/sets.lisp  \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.acl2  \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.lisp  \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.acl2  \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.lisp  \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.lisp  \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.lisp  \
-     workshops/2002/manolios-kaufmann/support/records/records-original.lisp  \
-     workshops/2002/manolios-kaufmann/support/records/records.lisp  \
-     workshops/2002/manolios-kaufmann/support/records/total-order.lisp  \
-     workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.lisp  \
-     workshops/2002/manolios-kaufmann/support/sorting/perm-order.lisp  \
-     workshops/2002/manolios-kaufmann/support/sorting/perm.lisp  \
-     workshops/2002/manolios-kaufmann/support/sorting/quicksort.lisp  \
-     workshops/2002/manolios-kaufmann/support/sorting/total-order.lisp  \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.lisp  \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.lisp  \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.lisp  \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.lisp  \
-     workshops/2002/martin-alonso-perez-sancho/support/Adleman.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-2/npol.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-2/npol.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-1.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-1.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.lisp  \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.acl2  \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.lisp  \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.lisp  \
-     workshops/2003/austel/support/abs-type.lisp  \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.lisp  \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.lisp  \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.lisp  \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.lisp  \
-     workshops/2003/gamboa-cowles-van-baalen/support/defpkg.lsp  \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.acl2  \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.lisp  \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.acl2  \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.lisp  \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.acl2  \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.lisp  \
-     workshops/2003/gamboa-cowles-van-baalen/support/linalg.lisp  \
-     workshops/2003/greve-wilding_defrecord/support/defrecord.lisp  \
-     workshops/2003/greve-wilding_mbe/support/fpst.lisp  \
-     workshops/2003/greve-wilding_mbe/support/run-fpst.lisp  \
-     workshops/2003/hbl/support/sol1.lisp  \
-     workshops/2003/hbl/support/sol2.lisp  \
-     workshops/2003/hendrix/support/madd.lisp  \
-     workshops/2003/hendrix/support/matrices.lisp  \
-     workshops/2003/hendrix/support/mdefthms.lisp  \
-     workshops/2003/hendrix/support/mdefuns.lisp  \
-     workshops/2003/hendrix/support/mentry.lisp  \
-     workshops/2003/hendrix/support/mid.lisp  \
-     workshops/2003/hendrix/support/mmult.lisp  \
-     workshops/2003/hendrix/support/mscal.lisp  \
-     workshops/2003/hendrix/support/msub.lisp  \
-     workshops/2003/hendrix/support/mtrans.lisp  \
-     workshops/2003/hendrix/support/mzero.lisp  \
-     workshops/2003/hendrix/support/vector.lisp  \
-     workshops/2003/matlin-mccune/support/simp.lisp  \
-     workshops/2003/moore_rockwell/support/memory-taggings.lisp  \
-     workshops/2003/moore_vcg/support/demo.acl2  \
-     workshops/2003/moore_vcg/support/demo.lisp  \
-     workshops/2003/moore_vcg/support/m5.acl2  \
-     workshops/2003/moore_vcg/support/m5.lisp  \
-     workshops/2003/moore_vcg/support/utilities.acl2  \
-     workshops/2003/moore_vcg/support/utilities.lisp  \
-     workshops/2003/moore_vcg/support/vcg-examples.acl2  \
-     workshops/2003/moore_vcg/support/vcg-examples.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/apply-total-order.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/bisimilarity.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/circuit-bisim.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/circuits.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/concrete-ltl.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/cone-of-influence.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/conjunction.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/impl-hack.acl2  \
-     workshops/2003/ray-matthews-tuttle/support/impl-hack.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/ltl.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/records.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/reductions.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/sets.lisp  \
-     workshops/2003/ray-matthews-tuttle/support/total-order.lisp  \
-     workshops/2003/schmaltz-al-sammane-et-al/support/consistency.lisp  \
-     workshops/2003/schmaltz-borrione/support/arbiter.lisp  \
-     workshops/2003/schmaltz-borrione/support/decoder.lisp  \
-     workshops/2003/schmaltz-borrione/support/inequalities.lisp  \
-     workshops/2003/schmaltz-borrione/support/predicates.lisp  \
-     workshops/2003/schmaltz-borrione/support/transfers.lisp  \
-     workshops/2003/sumners/support/cfair.lisp  \
-     workshops/2003/sumners/support/example1.lisp  \
-     workshops/2003/sumners/support/example2.lisp  \
-     workshops/2003/sumners/support/example3.lisp  \
-     workshops/2003/sumners/support/fair1.lisp  \
-     workshops/2003/sumners/support/fair2.lisp  \
-     workshops/2003/sumners/support/n2n.lisp  \
-     workshops/2003/sumners/support/simple.lisp  \
-     workshops/2003/sustik/support/dickson.lisp  \
-     workshops/2003/toma-borrione/support/bv-op-defthms.lisp  \
-     workshops/2003/toma-borrione/support/bv-op-defuns.lisp  \
-     workshops/2003/toma-borrione/support/misc.lisp  \
-     workshops/2003/toma-borrione/support/padding-1-256.lisp  \
-     workshops/2003/toma-borrione/support/padding-384-512.lisp  \
-     workshops/2003/toma-borrione/support/parsing.lisp  \
-     workshops/2003/toma-borrione/support/sha-1.lisp  \
-     workshops/2003/toma-borrione/support/sha-256.lisp  \
-     workshops/2003/toma-borrione/support/sha-384-512.lisp  \
-     workshops/2003/toma-borrione/support/sha-functions.lisp  \
-     workshops/2003/tsong/support/shim.lisp  \
-     workshops/2004/cowles-gamboa/support/WyoM1-correct.acl2  \
-     workshops/2004/cowles-gamboa/support/WyoM1-correct.lisp  \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.acl2  \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.lisp  \
-     workshops/2004/cowles-gamboa/support/WyoM1.acl2  \
-     workshops/2004/cowles-gamboa/support/WyoM1.lisp  \
-     workshops/2004/cowles-gamboa/support/knuth.lisp  \
-     workshops/2004/cowles-gamboa/support/tail-rec.acl2  \
-     workshops/2004/cowles-gamboa/support/tail-rec.lisp  \
-     workshops/2004/davis/support/cert.acl2  \
-     workshops/2004/davis/support/computed-hints.lisp  \
-     workshops/2004/davis/support/fast.lisp  \
-     workshops/2004/davis/support/instance.lisp  \
-     workshops/2004/davis/support/map.lisp  \
-     workshops/2004/davis/support/membership.lisp  \
-     workshops/2004/davis/support/outer.lisp  \
-     workshops/2004/davis/support/package.lsp  \
-     workshops/2004/davis/support/primitives.lisp  \
-     workshops/2004/davis/support/quantify.lisp  \
-     workshops/2004/davis/support/set-order.lisp  \
-     workshops/2004/davis/support/sets.lisp  \
-     workshops/2004/davis/support/sort.lisp  \
-     workshops/2004/gameiro-manolios/support/interval.lisp  \
-     workshops/2004/gameiro-manolios/support/nth-thms.lisp  \
-     workshops/2004/gameiro-manolios/support/top-with-meta.lisp  \
-     workshops/2004/gameiro-manolios/support/transversality.lisp  \
-     workshops/2004/greve/support/defrecord.lisp  \
-     workshops/2004/greve/support/mark.lisp  \
-     workshops/2004/legato/support/generic-theories.lisp  \
-     workshops/2004/legato/support/generic-theory-alternative-induction-mult.lisp  \
-     workshops/2004/legato/support/generic-theory-alternative-induction-sum.lisp  \
-     workshops/2004/legato/support/generic-theory-loop-invariant-mult.lisp  \
-     workshops/2004/legato/support/generic-theory-loop-invariant-sum.lisp  \
-     workshops/2004/legato/support/generic-theory-tail-recursion-mult.lisp  \
-     workshops/2004/legato/support/generic-theory-tail-recursion-sum.lisp  \
-     workshops/2004/legato/support/proof-by-generalization-mult.lisp  \
-     workshops/2004/legato/support/proof-by-generalization-sum.lisp  \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.lisp  \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.lisp  \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/records.lisp  \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.lisp  \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.lisp  \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.lisp  \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.lisp  \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.lisp  \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.lisp  \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.lisp  \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.lisp  \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.lisp  \
-     workshops/2004/ray/support/defcoerce.lisp  \
-     workshops/2004/ray/support/defpun-exec.lisp  \
-     workshops/2004/ray/support/generic.lisp  \
-     workshops/2004/roach-fraij/support/roach-fraij-script.lisp  \
-     workshops/2004/ruiz-et-al/support/basic.lisp  \
-     workshops/2004/ruiz-et-al/support/dag-unification-rules.lisp  \
-     workshops/2004/ruiz-et-al/support/dags.lisp  \
-     workshops/2004/ruiz-et-al/support/lists.lisp  \
-     workshops/2004/ruiz-et-al/support/matching.lisp  \
-     workshops/2004/ruiz-et-al/support/prefix-unification-rules.lisp  \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-rules.lisp  \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-st.lisp  \
-     workshops/2004/ruiz-et-al/support/q-dag-unification.lisp  \
-     workshops/2004/ruiz-et-al/support/subsumption-subst.lisp  \
-     workshops/2004/ruiz-et-al/support/subsumption.lisp  \
-     workshops/2004/ruiz-et-al/support/terms-as-dag.lisp  \
-     workshops/2004/ruiz-et-al/support/terms.lisp  \
-     workshops/2004/sawada/support/bv.acl2  \
-     workshops/2004/sawada/support/bv.lisp  \
-     workshops/2004/sawada/support/defpkg.lsp  \
-     workshops/2004/sawada/support/ihs.lisp  \
-     workshops/2004/schmaltz-borrione/support/collect_msg_book.lisp  \
-     workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.lisp  \
-     workshops/2004/schmaltz-borrione/support/intersect.lisp  \
-     workshops/2004/schmaltz-borrione/support/local_trip_book.lisp  \
-     workshops/2004/schmaltz-borrione/support/make_travel_list_book.lisp  \
-     workshops/2004/schmaltz-borrione/support/mod_lemmas.lisp  \
-     workshops/2004/schmaltz-borrione/support/node.lisp  \
-     workshops/2004/schmaltz-borrione/support/octagon_book.lisp  \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.lisp  \
-     workshops/2004/schmaltz-borrione/support/routing_defuns.lisp  \
-     workshops/2004/schmaltz-borrione/support/routing_local_lemmas.lisp  \
-     workshops/2004/schmaltz-borrione/support/routing_main.lisp  \
-     workshops/2004/schmaltz-borrione/support/scheduler_book.lisp  \
-     workshops/2004/schmaltz-borrione/support/switch.lisp  \
-     workshops/2004/schmaltz-borrione/support/trip_book.lisp  \
-     workshops/2004/schmaltz-borrione/support/trip_thms.lisp  \
-     workshops/2004/smith-et-al/support/bags/bag-exports.acl2  \
-     workshops/2004/smith-et-al/support/bags/bag-exports.lisp  \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.acl2  \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.lisp  \
-     workshops/2004/smith-et-al/support/bags/basic.acl2  \
-     workshops/2004/smith-et-al/support/bags/basic.lisp  \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.acl2  \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.lisp  \
-     workshops/2004/smith-et-al/support/bags/cons.lisp  \
-     workshops/2004/smith-et-al/support/bags/eric-meta.acl2  \
-     workshops/2004/smith-et-al/support/bags/eric-meta.lisp  \
-     workshops/2004/smith-et-al/support/bags/meta.acl2  \
-     workshops/2004/smith-et-al/support/bags/meta.lisp  \
-     workshops/2004/smith-et-al/support/bags/neq.acl2  \
-     workshops/2004/smith-et-al/support/bags/neq.lisp  \
-     workshops/2004/smith-et-al/support/bags/top.acl2  \
-     workshops/2004/smith-et-al/support/bags/top.lisp  \
-     workshops/2004/smith-et-al/support/bags/two-level-meta.acl2  \
-     workshops/2004/smith-et-al/support/bags/two-level-meta.lisp  \
-     workshops/2004/smith-et-al/support/bags/two-level.acl2  \
-     workshops/2004/smith-et-al/support/bags/two-level.lisp  \
-     workshops/2004/smith-et-al/support/lists/cert.acl2  \
-     workshops/2004/smith-et-al/support/lists/list-exports.lisp  \
-     workshops/2004/smith-et-al/support/lists/list-top.acl2  \
-     workshops/2004/smith-et-al/support/lists/list-top.lisp  \
-     workshops/2004/smith-et-al/support/lists/lists.lisp  \
-     workshops/2004/smith-et-al/support/lists/mv-nth.lisp  \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.acl2  \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.lisp  \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.acl2  \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.lisp  \
-     workshops/2004/smith-et-al/support/syntax/auxilary.acl2  \
-     workshops/2004/smith-et-al/support/syntax/auxilary.lisp  \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.acl2  \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.lisp  \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.acl2  \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.lisp  \
-     workshops/2004/smith-et-al/support/syntax/syntax.acl2  \
-     workshops/2004/smith-et-al/support/syntax/syntax.lisp  \
-     workshops/2004/sumners-ray/support/basis.lisp  \
-     workshops/2004/sumners-ray/support/crit.lisp  \
-     workshops/2004/sumners-ray/support/mesi.lisp  \
-     workshops/2004/sumners-ray/support/records.lisp  \
-     workshops/2004/sumners-ray/support/sets.lisp  \
-     workshops/2004/sumners-ray/support/total-order.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed1.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed1.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.lisp  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.acl2  \
-     workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.lisp  \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.lisp  \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.lisp  \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.lisp  \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.lisp  \
-     workshops/2006/greve/nary/example.lisp  \
-     workshops/2006/greve/nary/nary.lisp  \
-     workshops/2006/greve/nary/nth-rules.lisp  \
-     workshops/2006/hunt-reeber/support/acl2.lisp  \
-     workshops/2006/hunt-reeber/support/bdd.lisp  \
-     workshops/2006/hunt-reeber/support/sat.lisp  \
-     workshops/2006/kaufmann-moore/support/austel.lisp  \
-     workshops/2006/kaufmann-moore/support/greve1.lisp  \
-     workshops/2006/kaufmann-moore/support/greve2.lisp  \
-     workshops/2006/kaufmann-moore/support/greve3.lisp  \
-     workshops/2006/kaufmann-moore/support/mini-proveall-plus.lisp  \
-     workshops/2006/kaufmann-moore/support/mini-proveall.lisp  \
-     workshops/2006/kaufmann-moore/support/rhs1-iff.acl2  \
-     workshops/2006/kaufmann-moore/support/rhs1-iff.lisp  \
-     workshops/2006/kaufmann-moore/support/rhs1.acl2  \
-     workshops/2006/kaufmann-moore/support/rhs1.lisp  \
-     workshops/2006/kaufmann-moore/support/rhs2.acl2  \
-     workshops/2006/kaufmann-moore/support/rhs2.lisp  \
-     workshops/2006/kaufmann-moore/support/smith1.lisp  \
-     workshops/2006/kaufmann-moore/support/sumners1.lisp  \
-     workshops/2006/kaufmann-moore/support/warnings.acl2  \
-     workshops/2006/kaufmann-moore/support/warnings.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/cert.acl2  \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/cert.acl2  \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/cert.acl2  \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/cert.acl2  \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/cert.acl2  \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.lisp  \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.lisp  \
-     workshops/2006/rager/support/ptest-fib.lisp  \
-     workshops/2006/rager/support/ptest-if-normalization.lisp  \
-     workshops/2006/rager/support/ptest-mergesort.acl2  \
-     workshops/2006/rager/support/ptest-mergesort.lisp  \
-     workshops/2006/ray/tail/exists.lisp  \
-     workshops/2006/ray/tail/forall.lisp  \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.lisp  \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.lisp  \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.lisp  \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.lisp  \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.lisp  \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.lisp  \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.lisp  \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.lisp  \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.lisp  \
-     workshops/2006/swords-cook/lcsoundness/defsum-thms.lisp  \
-     workshops/2006/swords-cook/lcsoundness/defsum.lisp  \
-     workshops/2006/swords-cook/lcsoundness/pattern-match.lisp  \
-     workshops/2007/cowles-et-al/support/cowles/while-loop.lisp  \
-     workshops/2007/cowles-et-al/support/greve/ack.lisp  \
-     workshops/2007/cowles-et-al/support/greve/defminterm.lisp  \
-     workshops/2007/cowles-et-al/support/greve/defpun.lisp  \
-     workshops/2007/cowles-et-al/support/greve/defxch.lisp  \
-     workshops/2007/cowles-et-al/support/greve/while.lisp  \
-     workshops/2007/cowles-et-al/support/ray/reflexive-macros.lisp  \
-     workshops/2007/cowles-et-al/support/ray/reflexive.lisp  \
-     workshops/2007/dillinger-et-al/code/all.acl2  \
-     workshops/2007/dillinger-et-al/code/all.lisp  \
-     workshops/2007/dillinger-et-al/code/bridge.acl2  \
-     workshops/2007/dillinger-et-al/code/bridge.lisp  \
-     workshops/2007/dillinger-et-al/code/defcode-macro.acl2  \
-     workshops/2007/dillinger-et-al/code/defcode-macro.lisp  \
-     workshops/2007/dillinger-et-al/code/defcode.acl2  \
-     workshops/2007/dillinger-et-al/code/defcode.lisp  \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.acl2  \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.lisp  \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp  \
-     workshops/2007/dillinger-et-al/code/hacker.acl2  \
-     workshops/2007/dillinger-et-al/code/hacker.lisp  \
-     workshops/2007/dillinger-et-al/code/raw.acl2  \
-     workshops/2007/dillinger-et-al/code/raw.lisp  \
-     workshops/2007/dillinger-et-al/code/redefun.acl2  \
-     workshops/2007/dillinger-et-al/code/redefun.lisp  \
-     workshops/2007/dillinger-et-al/code/rewrite-code.acl2  \
-     workshops/2007/dillinger-et-al/code/rewrite-code.lisp  \
-     workshops/2007/dillinger-et-al/code/subsumption.acl2  \
-     workshops/2007/dillinger-et-al/code/subsumption.lisp  \
-     workshops/2007/dillinger-et-al/code/table-guard.acl2  \
-     workshops/2007/dillinger-et-al/code/table-guard.lisp  \
-     workshops/2007/erickson/bprove/bash.lisp  \
-     workshops/2007/erickson/bprove/exdefs.lisp  \
-     workshops/2007/erickson/bprove/gen.lisp  \
-     workshops/2007/erickson/bprove/lemgen.lisp  \
-     workshops/2007/erickson/bprove/refute.lisp  \
-     workshops/2007/rimlinger/support/Rimlinger.lisp  \
-     workshops/2007/rubio/support/abstract-reductions/abstract-proofs.lisp  \
-     workshops/2007/rubio/support/abstract-reductions/confluence.acl2  \
-     workshops/2007/rubio/support/abstract-reductions/confluence.lisp  \
-     workshops/2007/rubio/support/abstract-reductions/convergent.acl2  \
-     workshops/2007/rubio/support/abstract-reductions/convergent.lisp  \
-     workshops/2007/rubio/support/abstract-reductions/newman.acl2  \
-     workshops/2007/rubio/support/abstract-reductions/newman.lisp  \
-     workshops/2007/rubio/support/multisets/defmul.acl2  \
-     workshops/2007/rubio/support/multisets/defmul.lisp  \
-     workshops/2007/rubio/support/multisets/multiset.acl2  \
-     workshops/2007/rubio/support/multisets/multiset.lisp  \
-     workshops/2007/rubio/support/simplicial-topology/generate-degenerate.acl2  \
-     workshops/2007/rubio/support/simplicial-topology/generate-degenerate.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.lisp  \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.lisp  \
-     workshops/2009/fraij-roach/support/functions.lisp  \
-     workshops/2009/fraij-roach/support/theorems.lisp  \
-     workshops/2009/hardin/deque-stobj/deque-stobj.lisp  \
-     workshops/2009/hardin/deque-stobj/deque-thms.lisp  \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.acl2  \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.lisp  \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.acl2  \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.lisp  \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.lisp  \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.lisp  \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.acl2  \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.lisp  \
-     workshops/2009/liu/support/error-analysis-tool3.lisp  \
-     workshops/2009/liu/support/mylet.lisp  \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.lisp  \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.lisp  \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.lisp  \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.lisp  \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.lisp  \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.lisp  \
-     workshops/2009/sumners/support/kas.acl2  \
-     workshops/2009/sumners/support/kas.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.lisp  \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.lisp  \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.lisp  \
-     workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.lisp  \
-     workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.lisp  \
-     workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.lisp  \
-     workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.acl2  \
-     workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.lisp  \
-     wp-gen/mutrec/mutrec.lisp  \
-     wp-gen/shared.lisp  \
-     wp-gen/wp-gen.acl2  \
-     wp-gen/wp-gen.lisp  \
-     xdoc-impl/autolink.lisp  \
-     xdoc-impl/cert.acl2  \
-     xdoc-impl/extra-packages.acl2  \
-     xdoc-impl/extra-packages.lisp  \
-     xdoc-impl/fmt-to-str.lisp  \
-     xdoc-impl/import-acl2doc.lisp  \
-     xdoc-impl/mkdir-raw.acl2  \
-     xdoc-impl/mkdir-raw.lisp  \
-     xdoc-impl/mkdir.lisp  \
-     xdoc-impl/parse-xml.lisp  \
-     xdoc-impl/portcullis.acl2  \
-     xdoc-impl/portcullis.lisp  \
-     xdoc-impl/preprocess.lisp  \
-     xdoc-impl/save.lisp  \
-     xdoc-impl/sort.lisp  \
-     xdoc-impl/topics.lisp  \
-     xdoc-impl/write-acl2-xdoc.lisp  \
-     xdoc/base.lisp  \
-     xdoc/book-thms.lisp  \
-     xdoc/cert.acl2  \
-     xdoc/defxdoc-raw.acl2  \
-     xdoc/defxdoc-raw.lisp  \
-     xdoc/names.lisp  \
-     xdoc/package.lsp  \
-     xdoc/portcullis.acl2  \
-     xdoc/portcullis.lisp  \
-     xdoc/top.lisp 
-
-arithmetic-2/floor-mod/floor-mod-helper.cert : acl2x = 0
-arithmetic-2/floor-mod/floor-mod-helper.cert : no_pcert = 0
-
-arithmetic-2/floor-mod/floor-mod-helper.cert : \
-     arithmetic-2/meta/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     arithmetic-2/floor-mod/floor-mod-helper.lisp
-
-
-arithmetic-2/floor-mod/floor-mod.cert : acl2x = 0
-arithmetic-2/floor-mod/floor-mod.cert : no_pcert = 0
-
-arithmetic-2/floor-mod/floor-mod.cert : \
-     arithmetic-2/floor-mod/floor-mod-helper.cert \
-     arithmetic-2/floor-mod/floor-mod.lisp
-
-
-arithmetic-2/meta/cancel-terms-helper.cert : acl2x = 0
-arithmetic-2/meta/cancel-terms-helper.cert : no_pcert = 0
-
-arithmetic-2/meta/cancel-terms-helper.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/cancel-terms-helper.lisp
-
-
-arithmetic-2/meta/cancel-terms-meta.cert : acl2x = 0
-arithmetic-2/meta/cancel-terms-meta.cert : no_pcert = 0
-
-arithmetic-2/meta/cancel-terms-meta.cert : \
-     arithmetic-2/meta/common-meta.cert \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/cancel-terms-helper.cert \
-     arithmetic-2/meta/cancel-terms-meta.lisp
-
-
-arithmetic-2/meta/collect-terms-meta.cert : acl2x = 0
-arithmetic-2/meta/collect-terms-meta.cert : no_pcert = 0
-
-arithmetic-2/meta/collect-terms-meta.cert : \
-     arithmetic-2/meta/common-meta.cert \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/collect-terms-meta.lisp
-
-
-arithmetic-2/meta/common-meta.cert : acl2x = 0
-arithmetic-2/meta/common-meta.cert : no_pcert = 0
-
-arithmetic-2/meta/common-meta.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/common-meta.lisp
-
-
-arithmetic-2/meta/expt-helper.cert : acl2x = 0
-arithmetic-2/meta/expt-helper.cert : no_pcert = 0
-
-arithmetic-2/meta/expt-helper.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/expt-helper.lisp
-
-
-arithmetic-2/meta/expt.cert : acl2x = 0
-arithmetic-2/meta/expt.cert : no_pcert = 0
-
-arithmetic-2/meta/expt.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/expt-helper.cert \
-     arithmetic-2/meta/expt.lisp
-
-
-arithmetic-2/meta/integerp-meta.cert : acl2x = 0
-arithmetic-2/meta/integerp-meta.cert : no_pcert = 0
-
-arithmetic-2/meta/integerp-meta.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/integerp-meta.lisp
-
-
-arithmetic-2/meta/integerp.cert : acl2x = 0
-arithmetic-2/meta/integerp.cert : no_pcert = 0
-
-arithmetic-2/meta/integerp.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/integerp.lisp
-
-
-arithmetic-2/meta/mini-theories.cert : acl2x = 0
-arithmetic-2/meta/mini-theories.cert : no_pcert = 0
-
-arithmetic-2/meta/mini-theories.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/mini-theories.lisp
-
-
-arithmetic-2/meta/non-linear.cert : acl2x = 0
-arithmetic-2/meta/non-linear.cert : no_pcert = 0
-
-arithmetic-2/meta/non-linear.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/cancel-terms-helper.cert \
-     arithmetic-2/meta/non-linear.lisp
-
-
-arithmetic-2/meta/numerator-and-denominator.cert : acl2x = 0
-arithmetic-2/meta/numerator-and-denominator.cert : no_pcert = 0
-
-arithmetic-2/meta/numerator-and-denominator.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/numerator-and-denominator.lisp
-
-
-arithmetic-2/meta/post.cert : acl2x = 0
-arithmetic-2/meta/post.cert : no_pcert = 0
-
-arithmetic-2/meta/post.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/post.lisp
-
-
-arithmetic-2/meta/pre.cert : acl2x = 0
-arithmetic-2/meta/pre.cert : no_pcert = 0
-
-arithmetic-2/meta/pre.cert : \
-     arithmetic-2/pass1/top.cert \
-     arithmetic-2/meta/pre.lisp
-
-
-arithmetic-2/meta/top.cert : acl2x = 0
-arithmetic-2/meta/top.cert : no_pcert = 0
-
-arithmetic-2/meta/top.cert : \
-     arithmetic-2/meta/pre.cert \
-     arithmetic-2/meta/integerp.cert \
-     arithmetic-2/meta/integerp-meta.cert \
-     arithmetic-2/meta/cancel-terms-meta.cert \
-     arithmetic-2/meta/collect-terms-meta.cert \
-     arithmetic-2/meta/numerator-and-denominator.cert \
-     arithmetic-2/meta/expt.cert \
-     arithmetic-2/meta/non-linear.cert \
-     arithmetic-2/meta/mini-theories.cert \
-     arithmetic-2/meta/post.cert \
-     arithmetic-2/meta/top.lisp
-
-
-arithmetic-2/pass1/basic-arithmetic-helper.cert : acl2x = 0
-arithmetic-2/pass1/basic-arithmetic-helper.cert : no_pcert = 0
-
-arithmetic-2/pass1/basic-arithmetic-helper.cert : \
-     arithmetic-2/pass1/basic-arithmetic-helper.lisp
-
-
-arithmetic-2/pass1/basic-arithmetic.cert : acl2x = 0
-arithmetic-2/pass1/basic-arithmetic.cert : no_pcert = 0
-
-arithmetic-2/pass1/basic-arithmetic.cert : \
-     arithmetic-2/pass1/basic-arithmetic-helper.cert \
-     arithmetic-2/pass1/basic-arithmetic.lisp
-
-
-arithmetic-2/pass1/expt-helper.cert : acl2x = 0
-arithmetic-2/pass1/expt-helper.cert : no_pcert = 0
-
-arithmetic-2/pass1/expt-helper.cert : \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/inequalities.cert \
-     arithmetic-2/pass1/prefer-times.cert \
-     arithmetic-2/pass1/expt-helper.lisp
-
-
-arithmetic-2/pass1/expt.cert : acl2x = 0
-arithmetic-2/pass1/expt.cert : no_pcert = 0
-
-arithmetic-2/pass1/expt.cert : \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/inequalities.cert \
-     arithmetic-2/pass1/prefer-times.cert \
-     arithmetic-2/pass1/expt-helper.cert \
-     arithmetic-2/pass1/expt.lisp
-
-
-arithmetic-2/pass1/inequalities.cert : acl2x = 0
-arithmetic-2/pass1/inequalities.cert : no_pcert = 0
-
-arithmetic-2/pass1/inequalities.cert : \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/inequalities.lisp
-
-
-arithmetic-2/pass1/mini-theories.cert : acl2x = 0
-arithmetic-2/pass1/mini-theories.cert : no_pcert = 0
-
-arithmetic-2/pass1/mini-theories.cert : \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/inequalities.cert \
-     arithmetic-2/pass1/prefer-times.cert \
-     arithmetic-2/pass1/expt.cert \
-     arithmetic-2/pass1/mini-theories.lisp
-
-
-arithmetic-2/pass1/numerator-and-denominator-helper.cert : acl2x = 0
-arithmetic-2/pass1/numerator-and-denominator-helper.cert : no_pcert = 0
-
-arithmetic-2/pass1/numerator-and-denominator-helper.cert : \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/inequalities.cert \
-     arithmetic-2/pass1/prefer-times.cert \
-     arithmetic-2/pass1/numerator-and-denominator-helper.lisp
-
-
-arithmetic-2/pass1/numerator-and-denominator.cert : acl2x = 0
-arithmetic-2/pass1/numerator-and-denominator.cert : no_pcert = 0
-
-arithmetic-2/pass1/numerator-and-denominator.cert : \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/inequalities.cert \
-     arithmetic-2/pass1/prefer-times.cert \
-     arithmetic-2/pass1/numerator-and-denominator-helper.cert \
-     arithmetic-2/pass1/numerator-and-denominator.lisp
-
-
-arithmetic-2/pass1/prefer-times.cert : acl2x = 0
-arithmetic-2/pass1/prefer-times.cert : no_pcert = 0
-
-arithmetic-2/pass1/prefer-times.cert : \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/inequalities.cert \
-     arithmetic-2/pass1/prefer-times.lisp
-
-
-arithmetic-2/pass1/top.cert : acl2x = 0
-arithmetic-2/pass1/top.cert : no_pcert = 0
-
-arithmetic-2/pass1/top.cert : \
-     arithmetic-2/pass1/basic-arithmetic.cert \
-     arithmetic-2/pass1/inequalities.cert \
-     arithmetic-2/pass1/expt.cert \
-     arithmetic-2/pass1/prefer-times.cert \
-     arithmetic-2/pass1/mini-theories.cert \
-     arithmetic-2/pass1/numerator-and-denominator.cert \
-     arithmetic-2/pass1/top.lisp
-
-
-arithmetic-3/bind-free/arithmetic-theory.cert : acl2x = 0
-arithmetic-3/bind-free/arithmetic-theory.cert : no_pcert = 0
-
-arithmetic-3/bind-free/arithmetic-theory.cert : \
-     arithmetic-3/bind-free/basic.cert \
-     arithmetic-3/bind-free/common.cert \
-     arithmetic-3/bind-free/building-blocks.cert \
-     arithmetic-3/bind-free/collect.cert \
-     arithmetic-3/bind-free/arithmetic-theory.lisp
-
-
-arithmetic-3/bind-free/banner.cert : acl2x = 0
-arithmetic-3/bind-free/banner.cert : no_pcert = 0
-
-arithmetic-3/bind-free/banner.cert : \
-     arithmetic-3/bind-free/banner.lisp
-
-
-arithmetic-3/bind-free/basic-helper.cert : acl2x = 0
-arithmetic-3/bind-free/basic-helper.cert : no_pcert = 0
-
-arithmetic-3/bind-free/basic-helper.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/default-hint.cert \
-     arithmetic-3/bind-free/basic-helper.lisp
-
-
-arithmetic-3/bind-free/basic.cert : acl2x = 0
-arithmetic-3/bind-free/basic.cert : no_pcert = 0
-
-arithmetic-3/bind-free/basic.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/basic-helper.cert \
-     arithmetic-3/bind-free/building-blocks.cert \
-     arithmetic-3/bind-free/basic.lisp
-
-
-arithmetic-3/bind-free/building-blocks.cert : acl2x = 0
-arithmetic-3/bind-free/building-blocks.cert : no_pcert = 0
-
-arithmetic-3/bind-free/building-blocks.cert : \
-     arithmetic-3/bind-free/building-blocks.lisp
-
-
-arithmetic-3/bind-free/collect.cert : acl2x = 0
-arithmetic-3/bind-free/collect.cert : no_pcert = 0
-
-arithmetic-3/bind-free/collect.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/basic-helper.cert \
-     arithmetic-3/bind-free/collect.lisp
-
-
-arithmetic-3/bind-free/common.cert : acl2x = 0
-arithmetic-3/bind-free/common.cert : no_pcert = 0
-
-arithmetic-3/bind-free/common.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/building-blocks.cert \
-     arithmetic-3/bind-free/common.lisp
-
-
-arithmetic-3/bind-free/default-hint.cert : acl2x = 0
-arithmetic-3/bind-free/default-hint.cert : no_pcert = 0
-
-arithmetic-3/bind-free/default-hint.cert : \
-     arithmetic-3/bind-free/default-hint.lisp
-
-
-arithmetic-3/bind-free/integerp-meta.cert : acl2x = 0
-arithmetic-3/bind-free/integerp-meta.cert : no_pcert = 0
-
-arithmetic-3/bind-free/integerp-meta.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/default-hint.cert \
-     arithmetic-3/bind-free/integerp-meta.lisp
-
-
-arithmetic-3/bind-free/integerp.cert : acl2x = 0
-arithmetic-3/bind-free/integerp.cert : no_pcert = 0
-
-arithmetic-3/bind-free/integerp.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/building-blocks.cert \
-     arithmetic-3/bind-free/default-hint.cert \
-     arithmetic-3/bind-free/integerp.lisp
-
-
-arithmetic-3/bind-free/mini-theories-helper.cert : acl2x = 0
-arithmetic-3/bind-free/mini-theories-helper.cert : no_pcert = 0
-
-arithmetic-3/bind-free/mini-theories-helper.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/default-hint.cert \
-     arithmetic-3/bind-free/mini-theories-helper.lisp
-
-
-arithmetic-3/bind-free/mini-theories.cert : acl2x = 0
-arithmetic-3/bind-free/mini-theories.cert : no_pcert = 0
-
-arithmetic-3/bind-free/mini-theories.cert : \
-     arithmetic-3/bind-free/mini-theories-helper.cert \
-     arithmetic-3/bind-free/mini-theories.lisp
-
-
-arithmetic-3/bind-free/normalize.cert : acl2x = 0
-arithmetic-3/bind-free/normalize.cert : no_pcert = 0
-
-arithmetic-3/bind-free/normalize.cert : \
-     arithmetic-3/bind-free/basic.cert \
-     arithmetic-3/bind-free/common.cert \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/normalize.lisp
-
-
-arithmetic-3/bind-free/numerator-and-denominator.cert : acl2x = 0
-arithmetic-3/bind-free/numerator-and-denominator.cert : no_pcert = 0
-
-arithmetic-3/bind-free/numerator-and-denominator.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/numerator-and-denominator.lisp
-
-
-arithmetic-3/bind-free/remove-weak-inequalities.cert : acl2x = 0
-arithmetic-3/bind-free/remove-weak-inequalities.cert : no_pcert = 0
-
-arithmetic-3/bind-free/remove-weak-inequalities.cert : \
-     arithmetic-3/bind-free/building-blocks.cert \
-     arithmetic-3/bind-free/remove-weak-inequalities.lisp
-
-
-arithmetic-3/bind-free/simplify-helper.cert : acl2x = 0
-arithmetic-3/bind-free/simplify-helper.cert : no_pcert = 0
-
-arithmetic-3/bind-free/simplify-helper.cert : \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/default-hint.cert \
-     arithmetic-3/bind-free/simplify-helper.lisp
-
-
-arithmetic-3/bind-free/simplify.cert : acl2x = 0
-arithmetic-3/bind-free/simplify.cert : no_pcert = 0
-
-arithmetic-3/bind-free/simplify.cert : \
-     arithmetic-3/bind-free/simplify-helper.cert \
-     arithmetic-3/bind-free/basic.cert \
-     arithmetic-3/bind-free/common.cert \
-     arithmetic-3/pass1/top.cert \
-     arithmetic-3/bind-free/simplify.lisp
-
-
-arithmetic-3/bind-free/top.cert : acl2x = 0
-arithmetic-3/bind-free/top.cert : no_pcert = 0
-
-arithmetic-3/bind-free/top.cert : \
-     arithmetic-3/bind-free/default-hint.cert \
-     arithmetic-3/bind-free/building-blocks.cert \
-     arithmetic-3/bind-free/mini-theories.cert \
-     arithmetic-3/bind-free/common.cert \
-     arithmetic-3/bind-free/normalize.cert \
-     arithmetic-3/bind-free/simplify.cert \
-     arithmetic-3/bind-free/numerator-and-denominator.cert \
-     arithmetic-3/bind-free/integerp.cert \
-     arithmetic-3/bind-free/integerp-meta.cert \
-     arithmetic-3/bind-free/basic.cert \
-     arithmetic-3/bind-free/collect.cert \
-     arithmetic-3/bind-free/remove-weak-inequalities.cert \
-     arithmetic-3/bind-free/arithmetic-theory.cert \
-     arithmetic-3/bind-free/banner.cert \
-     arithmetic-3/bind-free/top.lisp
-
-
-arithmetic-3/extra/ext.cert : acl2x = 0
-arithmetic-3/extra/ext.cert : no_pcert = 0
-
-arithmetic-3/extra/ext.cert : \
-     arithmetic/top-with-meta.cert \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/extra-rules.cert \
-     arithmetic-2/meta/expt.cert \
-     arithmetic-2/meta/integerp.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic-3/extra/ext.lisp
-
-
-arithmetic-3/extra/top-ext.cert : acl2x = 0
-arithmetic-3/extra/top-ext.cert : no_pcert = 0
-
-arithmetic-3/extra/top-ext.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic-3/extra/ext.cert \
-     arithmetic-3/extra/top-ext.lisp
-
-
-arithmetic-3/floor-mod/floor-mod.cert : acl2x = 0
-arithmetic-3/floor-mod/floor-mod.cert : no_pcert = 0
-
-arithmetic-3/floor-mod/floor-mod.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/bind-free/building-blocks.cert \
-     arithmetic-3/floor-mod/floor-mod.lisp
-
-
-arithmetic-3/floor-mod/mod-expt-fast.cert : acl2x = 0
-arithmetic-3/floor-mod/mod-expt-fast.cert : no_pcert = 0
-
-arithmetic-3/floor-mod/mod-expt-fast.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic-3/floor-mod/mod-expt-fast.lisp
-
-
-arithmetic-3/pass1/basic-arithmetic-helper.cert : acl2x = 0
-arithmetic-3/pass1/basic-arithmetic-helper.cert : no_pcert = 0
-
-arithmetic-3/pass1/basic-arithmetic-helper.cert : \
-     arithmetic-3/pass1/basic-arithmetic-helper.lisp
-
-
-arithmetic-3/pass1/basic-arithmetic.cert : acl2x = 0
-arithmetic-3/pass1/basic-arithmetic.cert : no_pcert = 0
-
-arithmetic-3/pass1/basic-arithmetic.cert : \
-     arithmetic-3/pass1/basic-arithmetic-helper.cert \
-     arithmetic-3/pass1/basic-arithmetic.lisp
-
-
-arithmetic-3/pass1/expt-helper.cert : acl2x = 0
-arithmetic-3/pass1/expt-helper.cert : no_pcert = 0
-
-arithmetic-3/pass1/expt-helper.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/inequalities.cert \
-     arithmetic-3/pass1/prefer-times.cert \
-     arithmetic-3/pass1/expt-helper.lisp
-
-
-arithmetic-3/pass1/expt.cert : acl2x = 0
-arithmetic-3/pass1/expt.cert : no_pcert = 0
-
-arithmetic-3/pass1/expt.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/inequalities.cert \
-     arithmetic-3/pass1/prefer-times.cert \
-     arithmetic-3/pass1/expt-helper.cert \
-     arithmetic-3/pass1/expt.lisp
-
-
-arithmetic-3/pass1/inequalities.cert : acl2x = 0
-arithmetic-3/pass1/inequalities.cert : no_pcert = 0
-
-arithmetic-3/pass1/inequalities.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/inequalities.lisp
-
-
-arithmetic-3/pass1/mini-theories.cert : acl2x = 0
-arithmetic-3/pass1/mini-theories.cert : no_pcert = 0
-
-arithmetic-3/pass1/mini-theories.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/inequalities.cert \
-     arithmetic-3/pass1/prefer-times.cert \
-     arithmetic-3/pass1/expt.cert \
-     arithmetic-3/pass1/mini-theories.lisp
-
-
-arithmetic-3/pass1/non-linear.cert : acl2x = 0
-arithmetic-3/pass1/non-linear.cert : no_pcert = 0
-
-arithmetic-3/pass1/non-linear.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/expt.cert \
-     arithmetic-3/pass1/non-linear.lisp
-
-
-arithmetic-3/pass1/num-and-denom-helper.cert : acl2x = 0
-arithmetic-3/pass1/num-and-denom-helper.cert : no_pcert = 0
-
-arithmetic-3/pass1/num-and-denom-helper.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/inequalities.cert \
-     arithmetic-3/pass1/prefer-times.cert \
-     arithmetic-3/pass1/non-linear.cert \
-     arithmetic-3/pass1/num-and-denom-helper.lisp
-
-
-arithmetic-3/pass1/numerator-and-denominator.cert : acl2x = 0
-arithmetic-3/pass1/numerator-and-denominator.cert : no_pcert = 0
-
-arithmetic-3/pass1/numerator-and-denominator.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/inequalities.cert \
-     arithmetic-3/pass1/prefer-times.cert \
-     arithmetic-3/pass1/non-linear.cert \
-     arithmetic-3/pass1/num-and-denom-helper.cert \
-     arithmetic-3/pass1/numerator-and-denominator.lisp
-
-
-arithmetic-3/pass1/prefer-times.cert : acl2x = 0
-arithmetic-3/pass1/prefer-times.cert : no_pcert = 0
-
-arithmetic-3/pass1/prefer-times.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/inequalities.cert \
-     arithmetic-3/pass1/prefer-times.lisp
-
-
-arithmetic-3/pass1/top.cert : acl2x = 0
-arithmetic-3/pass1/top.cert : no_pcert = 0
-
-arithmetic-3/pass1/top.cert : \
-     arithmetic-3/pass1/basic-arithmetic.cert \
-     arithmetic-3/pass1/inequalities.cert \
-     arithmetic-3/pass1/expt.cert \
-     arithmetic-3/pass1/prefer-times.cert \
-     arithmetic-3/pass1/mini-theories.cert \
-     arithmetic-3/pass1/numerator-and-denominator.cert \
-     arithmetic-3/pass1/non-linear.cert \
-     arithmetic-3/pass1/top.lisp
-
-
-arithmetic-3/top.cert : acl2x = 0
-arithmetic-3/top.cert : no_pcert = 0
-
-arithmetic-3/top.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic-3/floor-mod/mod-expt-fast.cert \
-     arithmetic-3/top.lisp
-
-
-arithmetic-5/lib/basic-ops/arithmetic-theory.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/arithmetic-theory.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/arithmetic-theory.cert : \
-     arithmetic-5/lib/basic-ops/common.cert \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/basic.cert \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert \
-     arithmetic-5/lib/basic-ops/expt.cert \
-     arithmetic-5/lib/basic-ops/collect.cert \
-     arithmetic-5/lib/basic-ops/arithmetic-theory.lisp
-
-
-arithmetic-5/lib/basic-ops/banner.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/banner.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/banner.cert : \
-     arithmetic-5/lib/basic-ops/banner.lisp
-
-
-arithmetic-5/lib/basic-ops/basic.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/basic.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/basic.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/basic.lisp
-
-
-arithmetic-5/lib/basic-ops/building-blocks-helper.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/building-blocks-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/building-blocks-helper.cert : \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/building-blocks-helper.lisp
-
-
-arithmetic-5/lib/basic-ops/building-blocks.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/building-blocks.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/building-blocks.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks-helper.cert \
-     arithmetic-5/lib/basic-ops/building-blocks.lisp
-
-
-arithmetic-5/lib/basic-ops/collect.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/collect.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/collect.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/expt-helper.cert \
-     arithmetic-5/lib/basic-ops/collect.lisp
-
-
-arithmetic-5/lib/basic-ops/common.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/common.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/common.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/common.lisp
-
-
-arithmetic-5/lib/basic-ops/default-hint.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/default-hint.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/default-hint.cert : \
-     arithmetic-5/lib/basic-ops/dynamic-e-d.cert \
-     arithmetic-5/lib/basic-ops/default-hint.lisp
-
-
-arithmetic-5/lib/basic-ops/distributivity.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/distributivity.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/distributivity.cert : \
-     arithmetic-5/lib/basic-ops/distributivity.lisp
-
-
-arithmetic-5/lib/basic-ops/dynamic-e-d.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/dynamic-e-d.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/dynamic-e-d.cert : \
-     arithmetic-5/lib/basic-ops/dynamic-e-d.lisp
-
-
-arithmetic-5/lib/basic-ops/elim-hint.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/elim-hint.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/elim-hint.cert : \
-     arithmetic-5/lib/basic-ops/default-hint.cert \
-     arithmetic-5/lib/basic-ops/elim-hint.lisp \
-     arithmetic-5/lib/basic-ops/elim-hint.acl2
-
-
-arithmetic-5/lib/basic-ops/expt-helper.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/expt-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/expt-helper.cert : \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/default-hint.cert \
-     arithmetic-5/lib/basic-ops/expt-helper.lisp
-
-
-arithmetic-5/lib/basic-ops/expt.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/expt.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/expt.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/expt-helper.cert \
-     arithmetic-5/lib/basic-ops/types.cert \
-     arithmetic-5/lib/basic-ops/expt.lisp
-
-
-arithmetic-5/lib/basic-ops/forcing-types.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/forcing-types.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/forcing-types.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/forcing-types.lisp
-
-
-arithmetic-5/lib/basic-ops/if-normalization.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/if-normalization.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/if-normalization.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/if-normalization.lisp
-
-
-arithmetic-5/lib/basic-ops/integerp-helper.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/integerp-helper.cert : \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/default-hint.cert \
-     arithmetic-5/lib/basic-ops/integerp-helper.lisp
-
-
-arithmetic-5/lib/basic-ops/integerp-meta.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp-meta.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/integerp-meta.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/default-hint.cert \
-     arithmetic-5/lib/basic-ops/integerp-meta.lisp
-
-
-arithmetic-5/lib/basic-ops/integerp.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/integerp.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/default-hint.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/integerp-helper.cert \
-     arithmetic-5/lib/basic-ops/common.cert \
-     arithmetic-5/lib/basic-ops/normalize.cert \
-     arithmetic-5/lib/basic-ops/simplify.cert \
-     arithmetic-5/lib/basic-ops/collect.cert \
-     arithmetic-5/lib/basic-ops/integerp.lisp
-
-
-arithmetic-5/lib/basic-ops/mini-theories.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/mini-theories.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/mini-theories.cert : \
-     arithmetic-5/lib/basic-ops/mini-theories.lisp
-
-
-arithmetic-5/lib/basic-ops/natp-posp.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/natp-posp.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/natp-posp.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/natp-posp.lisp
-
-
-arithmetic-5/lib/basic-ops/normalize.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/normalize.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/normalize.cert : \
-     arithmetic-5/lib/basic-ops/common.cert \
-     arithmetic-5/lib/basic-ops/basic.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/normalize.lisp
-
-
-arithmetic-5/lib/basic-ops/numerator-and-denominator.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/numerator-and-denominator.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/numerator-and-denominator.cert : \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/numerator-and-denominator.lisp
-
-
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/remove-weak-inequalities.lisp
-
-
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.cert : \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.lisp
-
-
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/simplify-helper.cert \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.cert \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.lisp
-
-
-arithmetic-5/lib/basic-ops/simplify-helper.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/simplify-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/simplify-helper.cert : \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/default-hint.cert \
-     arithmetic-5/lib/basic-ops/simplify-helper.lisp
-
-
-arithmetic-5/lib/basic-ops/simplify.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/simplify.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/simplify.cert : \
-     arithmetic-5/lib/basic-ops/common.cert \
-     arithmetic-5/lib/basic-ops/simplify-helper.cert \
-     arithmetic-5/lib/basic-ops/basic.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/simplify.lisp
-
-
-arithmetic-5/lib/basic-ops/top.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/top.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/top.cert : \
-     arithmetic-5/lib/basic-ops/we-are-here.cert \
-     arithmetic-5/lib/basic-ops/distributivity.cert \
-     arithmetic-5/lib/basic-ops/default-hint.cert \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/common.cert \
-     arithmetic-5/lib/basic-ops/normalize.cert \
-     arithmetic-5/lib/basic-ops/simplify.cert \
-     arithmetic-5/lib/basic-ops/mini-theories.cert \
-     arithmetic-5/lib/basic-ops/numerator-and-denominator.cert \
-     arithmetic-5/lib/basic-ops/natp-posp.cert \
-     arithmetic-5/lib/basic-ops/integerp-meta.cert \
-     arithmetic-5/lib/basic-ops/integerp.cert \
-     arithmetic-5/lib/basic-ops/basic.cert \
-     arithmetic-5/lib/basic-ops/expt.cert \
-     arithmetic-5/lib/basic-ops/collect.cert \
-     arithmetic-5/lib/basic-ops/remove-weak-inequalities.cert \
-     arithmetic-5/lib/basic-ops/arithmetic-theory.cert \
-     arithmetic-5/lib/basic-ops/types.cert \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert \
-     arithmetic-5/lib/basic-ops/if-normalization.cert \
-     arithmetic-5/lib/basic-ops/forcing-types.cert \
-     arithmetic-5/lib/basic-ops/banner.cert \
-     arithmetic-5/lib/basic-ops/top.lisp
-
-
-arithmetic-5/lib/basic-ops/types-helper.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/types-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/types-helper.cert : \
-     arithmetic-5/support/top.cert \
-     arithmetic-5/lib/basic-ops/types-helper.lisp
-
-
-arithmetic-5/lib/basic-ops/types.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/types.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/types.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/types-helper.cert \
-     arithmetic-5/lib/basic-ops/types.lisp
-
-
-arithmetic-5/lib/basic-ops/we-are-here.cert : acl2x = 0
-arithmetic-5/lib/basic-ops/we-are-here.cert : no_pcert = 0
-
-arithmetic-5/lib/basic-ops/we-are-here.cert : \
-     arithmetic-5/lib/basic-ops/we-are-here.lisp
-
-
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/floor-mod/forcing-types.cert \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic-helper.lisp
-
-
-arithmetic-5/lib/floor-mod/floor-mod-basic.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/floor-mod-basic.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/floor-mod/forcing-types.cert \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic-helper.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.lisp
-
-
-arithmetic-5/lib/floor-mod/floor-mod-helper.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/floor-mod-helper.cert : \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/floor-mod/forcing-types.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-helper.lisp
-
-
-arithmetic-5/lib/floor-mod/floor-mod.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/floor-mod.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/common.cert \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/floor-mod/forcing-types.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-helper.cert \
-     arithmetic-5/lib/floor-mod/floor-mod.lisp
-
-
-arithmetic-5/lib/floor-mod/forcing-types.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/forcing-types.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/forcing-types.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/floor-mod/forcing-types.lisp
-
-
-arithmetic-5/lib/floor-mod/if-normalization.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/if-normalization.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/if-normalization.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/floor-mod/if-normalization.lisp
-
-
-arithmetic-5/lib/floor-mod/logand-helper.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/logand-helper.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/logand-helper.cert : \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/more-floor-mod.cert \
-     arithmetic-5/lib/floor-mod/floor-mod.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/floor-mod/truncate-rem.cert \
-     arithmetic-5/lib/floor-mod/logand-helper.lisp
-
-
-arithmetic-5/lib/floor-mod/logand.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/logand.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/logand.cert : \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/more-floor-mod.cert \
-     arithmetic-5/lib/floor-mod/floor-mod.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/floor-mod/truncate-rem.cert \
-     arithmetic-5/lib/floor-mod/logand-helper.cert \
-     arithmetic-5/lib/floor-mod/logand.lisp
-
-
-arithmetic-5/lib/floor-mod/mod-expt-fast.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/mod-expt-fast.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/mod-expt-fast.cert : \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/floor-mod/floor-mod.cert \
-     arithmetic-5/lib/floor-mod/more-floor-mod.cert \
-     arithmetic-5/lib/floor-mod/truncate-rem.cert \
-     arithmetic-5/lib/floor-mod/mod-expt-fast.lisp
-
-
-arithmetic-5/lib/floor-mod/more-floor-mod.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/more-floor-mod.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/more-floor-mod.cert : \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/floor-mod.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/floor-mod/if-normalization.cert \
-     arithmetic-5/lib/floor-mod/forcing-types.cert \
-     arithmetic-5/lib/floor-mod/more-floor-mod.lisp
-
-
-arithmetic-5/lib/floor-mod/top.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/top.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/top.cert : \
-     arithmetic-5/lib/floor-mod/logand.cert \
-     arithmetic-5/lib/floor-mod/truncate-rem.cert \
-     arithmetic-5/lib/floor-mod/mod-expt-fast.cert \
-     arithmetic-5/lib/floor-mod/more-floor-mod.cert \
-     arithmetic-5/lib/floor-mod/floor-mod.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/floor-mod/if-normalization.cert \
-     arithmetic-5/lib/floor-mod/forcing-types.cert \
-     arithmetic-5/lib/floor-mod/top.lisp
-
-
-arithmetic-5/lib/floor-mod/truncate-rem.cert : acl2x = 0
-arithmetic-5/lib/floor-mod/truncate-rem.cert : no_pcert = 0
-
-arithmetic-5/lib/floor-mod/truncate-rem.cert : \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/floor-mod.cert \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.cert \
-     arithmetic-5/lib/basic-ops/building-blocks.cert \
-     arithmetic-5/lib/floor-mod/truncate-rem.lisp
-
-
-arithmetic-5/support/basic-arithmetic-helper.cert : acl2x = 0
-arithmetic-5/support/basic-arithmetic-helper.cert : no_pcert = 0
-
-arithmetic-5/support/basic-arithmetic-helper.cert : \
-     arithmetic-5/support/basic-arithmetic-helper.lisp
-
-
-arithmetic-5/support/basic-arithmetic.cert : acl2x = 0
-arithmetic-5/support/basic-arithmetic.cert : no_pcert = 0
-
-arithmetic-5/support/basic-arithmetic.cert : \
-     arithmetic-5/support/basic-arithmetic-helper.cert \
-     arithmetic-5/support/basic-arithmetic.lisp
-
-
-arithmetic-5/support/expt-helper.cert : acl2x = 0
-arithmetic-5/support/expt-helper.cert : no_pcert = 0
-
-arithmetic-5/support/expt-helper.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/inequalities.cert \
-     arithmetic-5/support/prefer-times.cert \
-     arithmetic-5/support/expt-helper.lisp
-
-
-arithmetic-5/support/expt.cert : acl2x = 0
-arithmetic-5/support/expt.cert : no_pcert = 0
-
-arithmetic-5/support/expt.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/inequalities.cert \
-     arithmetic-5/support/prefer-times.cert \
-     arithmetic-5/support/expt-helper.cert \
-     arithmetic-5/support/expt.lisp
-
-
-arithmetic-5/support/inequalities.cert : acl2x = 0
-arithmetic-5/support/inequalities.cert : no_pcert = 0
-
-arithmetic-5/support/inequalities.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/inequalities.lisp
-
-
-arithmetic-5/support/mini-theories.cert : acl2x = 0
-arithmetic-5/support/mini-theories.cert : no_pcert = 0
-
-arithmetic-5/support/mini-theories.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/inequalities.cert \
-     arithmetic-5/support/prefer-times.cert \
-     arithmetic-5/support/expt.cert \
-     arithmetic-5/support/mini-theories.lisp
-
-
-arithmetic-5/support/non-linear.cert : acl2x = 0
-arithmetic-5/support/non-linear.cert : no_pcert = 0
-
-arithmetic-5/support/non-linear.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/expt.cert \
-     arithmetic-5/support/non-linear.lisp
-
-
-arithmetic-5/support/num-and-denom-helper.cert : acl2x = 0
-arithmetic-5/support/num-and-denom-helper.cert : no_pcert = 0
-
-arithmetic-5/support/num-and-denom-helper.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/inequalities.cert \
-     arithmetic-5/support/prefer-times.cert \
-     arithmetic-5/support/non-linear.cert \
-     arithmetic-5/support/num-and-denom-helper.lisp
-
-
-arithmetic-5/support/numerator-and-denominator.cert : acl2x = 0
-arithmetic-5/support/numerator-and-denominator.cert : no_pcert = 0
-
-arithmetic-5/support/numerator-and-denominator.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/inequalities.cert \
-     arithmetic-5/support/prefer-times.cert \
-     arithmetic-5/support/non-linear.cert \
-     arithmetic-5/support/num-and-denom-helper.cert \
-     arithmetic-5/support/numerator-and-denominator.lisp
-
-
-arithmetic-5/support/prefer-times.cert : acl2x = 0
-arithmetic-5/support/prefer-times.cert : no_pcert = 0
-
-arithmetic-5/support/prefer-times.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/inequalities.cert \
-     arithmetic-5/support/prefer-times.lisp
-
-
-arithmetic-5/support/top.cert : acl2x = 0
-arithmetic-5/support/top.cert : no_pcert = 0
-
-arithmetic-5/support/top.cert : \
-     arithmetic-5/support/basic-arithmetic.cert \
-     arithmetic-5/support/inequalities.cert \
-     arithmetic-5/support/expt.cert \
-     arithmetic-5/support/prefer-times.cert \
-     arithmetic-5/support/mini-theories.cert \
-     arithmetic-5/support/numerator-and-denominator.cert \
-     arithmetic-5/support/non-linear.cert \
-     arithmetic-5/support/top.lisp
-
-
-arithmetic-5/top.cert : acl2x = 0
-arithmetic-5/top.cert : no_pcert = 0
-
-arithmetic-5/top.cert : \
-     arithmetic-5/lib/basic-ops/top.cert \
-     arithmetic-5/lib/floor-mod/top.cert \
-     arithmetic-5/top.lisp
-
-
-arithmetic/abs.cert : acl2x = 0
-arithmetic/abs.cert : no_pcert = 0
-
-arithmetic/abs.cert : \
-     arithmetic/top.cert \
-     arithmetic/abs.lisp
-
-
-arithmetic/binomial.cert : acl2x = 0
-arithmetic/binomial.cert : no_pcert = 0
-
-arithmetic/binomial.cert : \
-     arithmetic/top.cert \
-     arithmetic/factorial.cert \
-     arithmetic/sumlist.cert \
-     arithmetic/binomial.lisp
-
-
-arithmetic/equalities.cert : acl2x = 0
-arithmetic/equalities.cert : no_pcert = 0
-
-arithmetic/equalities.cert : \
-     cowles/acl2-crg.cert \
-     arithmetic/equalities.lisp \
-     arithmetic/equalities.acl2
-
-
-arithmetic/factorial.cert : acl2x = 0
-arithmetic/factorial.cert : no_pcert = 0
-
-arithmetic/factorial.cert : \
-     arithmetic/factorial.lisp
-
-
-arithmetic/idiv.cert : acl2x = 0
-arithmetic/idiv.cert : no_pcert = 0
-
-arithmetic/idiv.cert : \
-     arithmetic/top.cert \
-     arithmetic/idiv.lisp
-
-
-arithmetic/inequalities.cert : acl2x = 0
-arithmetic/inequalities.cert : no_pcert = 0
-
-arithmetic/inequalities.cert : \
-     arithmetic/equalities.cert \
-     arithmetic/inequalities.lisp
-
-
-arithmetic/mod-gcd.cert : acl2x = 0
-arithmetic/mod-gcd.cert : no_pcert = 0
-
-arithmetic/mod-gcd.cert : \
-     arithmetic/inequalities.cert \
-     arithmetic/mod-gcd.lisp
-
-
-arithmetic/nat-listp.cert : acl2x = 0
-arithmetic/nat-listp.cert : no_pcert = 0
-
-arithmetic/nat-listp.cert : \
-     arithmetic/nat-listp.lisp
-
-
-arithmetic/natp-posp.cert : acl2x = 0
-arithmetic/natp-posp.cert : no_pcert = 0
-
-arithmetic/natp-posp.cert : \
-     arithmetic/inequalities.cert \
-     arithmetic/natp-posp.lisp
-
-
-arithmetic/rational-listp.cert : acl2x = 0
-arithmetic/rational-listp.cert : no_pcert = 0
-
-arithmetic/rational-listp.cert : \
-     arithmetic/rational-listp.lisp
-
-
-arithmetic/rationals.cert : acl2x = 0
-arithmetic/rationals.cert : no_pcert = 0
-
-arithmetic/rationals.cert : \
-     arithmetic/inequalities.cert \
-     arithmetic/inequalities.cert \
-     arithmetic/mod-gcd.cert \
-     arithmetic/rationals.lisp
-
-
-arithmetic/sumlist.cert : acl2x = 0
-arithmetic/sumlist.cert : no_pcert = 0
-
-arithmetic/sumlist.cert : \
-     arithmetic/sumlist.lisp
-
-
-arithmetic/top-with-meta.cert : acl2x = 0
-arithmetic/top-with-meta.cert : no_pcert = 0
-
-arithmetic/top-with-meta.cert : \
-     arithmetic/top.cert \
-     meta/meta.cert \
-     arithmetic/top-with-meta.lisp
-
-
-arithmetic/top.cert : acl2x = 0
-arithmetic/top.cert : no_pcert = 0
-
-arithmetic/top.cert : \
-     arithmetic/equalities.cert \
-     arithmetic/rational-listp.cert \
-     arithmetic/nat-listp.cert \
-     arithmetic/inequalities.cert \
-     arithmetic/natp-posp.cert \
-     arithmetic/rationals.cert \
-     arithmetic/top.lisp
-
-
-bdd/alu-proofs.cert : acl2x = 0
-bdd/alu-proofs.cert : no_pcert = 0
-
-bdd/alu-proofs.cert : \
-     bdd/alu.cert \
-     bdd/alu-proofs.lisp
-
-
-bdd/alu.cert : acl2x = 0
-bdd/alu.cert : no_pcert = 0
-
-bdd/alu.cert : \
-     bdd/bdd-primitives.cert \
-     bdd/alu.lisp
-
-
-bdd/bdd-primitives.cert : acl2x = 0
-bdd/bdd-primitives.cert : no_pcert = 0
-
-bdd/bdd-primitives.cert : \
-     bdd/bdd-primitives.lisp
-
-
-bdd/bool-ops.cert : acl2x = 0
-bdd/bool-ops.cert : no_pcert = 0
-
-bdd/bool-ops.cert : \
-     bdd/bool-ops.lisp
-
-
-bdd/cbf.cert : acl2x = 0
-bdd/cbf.cert : no_pcert = 0
-
-bdd/cbf.cert : \
-     bdd/bool-ops.cert \
-     bdd/cbf.lisp
-
-
-bdd/hamming.cert : acl2x = 0
-bdd/hamming.cert : no_pcert = 0
-
-bdd/hamming.cert : \
-     bdd/bdd-primitives.cert \
-     bdd/hamming.lisp
-
-
-bdd/pg-theory.cert : acl2x = 0
-bdd/pg-theory.cert : no_pcert = 0
-
-bdd/pg-theory.cert : \
-     bdd/bdd-primitives.cert \
-     bdd/pg-theory.lisp
-
-
-centaur/4v-sexpr/4v-logic.cert : acl2x = 0
-centaur/4v-sexpr/4v-logic.cert : no_pcert = 0
-
-centaur/4v-sexpr/4v-logic.cert : \
-     centaur/misc/witness-cp.cert \
-     tools/rulesets.cert \
-     xdoc/top.cert \
-     misc/definline.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/4v-logic.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/bitspecs.cert : acl2x = 0
-centaur/4v-sexpr/bitspecs.cert : no_pcert = 0
-
-centaur/4v-sexpr/bitspecs.cert : \
-     centaur/4v-sexpr/4v-logic.cert \
-     centaur/4v-sexpr/sexpr-equivs.cert \
-     centaur/misc/vecs-ints.cert \
-     centaur/misc/hons-sets.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/misc/patterns.cert \
-     arithmetic/top-with-meta.cert \
-     ihs/logops-lemmas.cert \
-     data-structures/no-duplicates.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/bitspecs.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/compose-sexpr.cert : acl2x = 0
-centaur/4v-sexpr/compose-sexpr.cert : no_pcert = 0
-
-centaur/4v-sexpr/compose-sexpr.cert : \
-     centaur/4v-sexpr/bitspecs.cert \
-     centaur/4v-sexpr/sexpr-to-faig.cert \
-     centaur/4v-sexpr/sexpr-advanced.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/compose-sexpr.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/g-sexpr-eval.cert : acl2x = 0
-centaur/4v-sexpr/g-sexpr-eval.cert : no_pcert = 0
-
-centaur/4v-sexpr/g-sexpr-eval.cert : \
-     centaur/4v-sexpr/svarmap.cert \
-     centaur/4v-sexpr/sexpr-to-faig.cert \
-     centaur/4v-sexpr/sexpr-equivs.cert \
-     centaur/gl/gl-util.cert \
-     centaur/misc/numlist.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/misc/hons-sets.cert \
-     centaur/aig/eval-restrict.cert \
-     arithmetic/top-with-meta.cert \
-     std/lists/take.cert \
-     centaur/gl/portcullis.cert \
-     centaur/4v-sexpr/g-sexpr-eval.lisp \
-     centaur/4v-sexpr/g-sexpr-eval.acl2
-
-
-centaur/4v-sexpr/nsexprs.cert : acl2x = 0
-centaur/4v-sexpr/nsexprs.cert : no_pcert = 0
-
-centaur/4v-sexpr/nsexprs.cert : \
-     centaur/4v-sexpr/sexpr-vars.cert \
-     centaur/bitops/bitsets.cert \
-     centaur/bitops/sbitsets.cert \
-     arithmetic/nat-listp.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/nsexprs.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/onehot-rewrite.cert : acl2x = 0
-centaur/4v-sexpr/onehot-rewrite.cert : no_pcert = 0
-
-centaur/4v-sexpr/onehot-rewrite.cert : \
-     centaur/4v-sexpr/sexpr-rewrites.cert \
-     centaur/4v-sexpr/sexpr-building.cert \
-     cutil/defprojection.cert \
-     centaur/misc/filter-alist.cert \
-     data-structures/list-defthms.cert \
-     arithmetic/top.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/onehot-rewrite.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/portcullis.cert : acl2x = 0
-centaur/4v-sexpr/portcullis.cert : no_pcert = 0
-
-centaur/4v-sexpr/portcullis.cert : \
-     centaur/4v-sexpr/portcullis.lisp \
-     centaur/4v-sexpr/portcullis.acl2 \
-     tools/flag-package.lsp \
-     xdoc/package.lsp \
-     centaur/vl/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-
-
-centaur/4v-sexpr/sexpr-3v.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-3v.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-3v.cert : \
-     centaur/4v-sexpr/sexpr-eval.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-3v.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-advanced.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-advanced.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-advanced.cert : \
-     centaur/4v-sexpr/sexpr-vars.cert \
-     centaur/4v-sexpr/sexpr-equivs.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-advanced.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-building.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-building.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-building.cert : \
-     centaur/4v-sexpr/sexpr-eval.cert \
-     centaur/4v-sexpr/sexpr-vars.cert \
-     centaur/4v-sexpr/sexpr-3v.cert \
-     cutil/defprojection.cert \
-     misc/definline.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-building.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-equivs.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-equivs.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-equivs.cert : \
-     centaur/4v-sexpr/sexpr-eval.cert \
-     centaur/misc/universal-equiv.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-equivs.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-eval.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-eval.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-eval.cert : \
-     centaur/4v-sexpr/4v-logic.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-eval.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-fixpoint-correct.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-correct.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-fixpoint-correct.cert : \
-     centaur/4v-sexpr/sexpr-fixpoint-spec.cert \
-     centaur/misc/hons-sets.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-correct.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.cert : \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-rewriting.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-fixpoint-spec.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-spec.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-fixpoint-spec.cert : \
-     centaur/4v-sexpr/sexpr-fixpoint.cert \
-     centaur/4v-sexpr/sexpr-advanced.cert \
-     misc/bash.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-spec.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-fixpoint-top.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-top.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-fixpoint-top.cert : \
-     centaur/4v-sexpr/sexpr-fixpoint.cert \
-     centaur/4v-sexpr/sexpr-equivs.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-correct.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-top.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-fixpoint.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-fixpoint.cert : \
-     centaur/4v-sexpr/nsexprs.cert \
-     centaur/4v-sexpr/sexpr-rewrites.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/misc/sneaky-load.cert \
-     centaur/misc/nat-list-duplicates.cert \
-     centaur/misc/tuplep.cert \
-     centaur/misc/dfs-measure.cert \
-     std/ks/two-nats-measure.cert \
-     centaur/vl/util/cwtime.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-fixpoint.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-loop-debug.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-loop-debug.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-loop-debug.cert : \
-     centaur/4v-sexpr/sexpr-fixpoint.cert \
-     centaur/vl/toe/toe-emodwire.cert \
-     centaur/vl/util/cw-unformatted.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     arithmetic-3/top.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-loop-debug.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-rewrites.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-rewrites.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-rewrites.cert : \
-     centaur/aig/base.cert \
-     centaur/4v-sexpr/sexpr-advanced.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/4v-sexpr/sexpr-vars-1pass.cert \
-     std/ks/two-nats-measure.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-rewrites.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-to-faig.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-to-faig.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-to-faig.cert : \
-     centaur/4v-sexpr/sexpr-eval.cert \
-     centaur/4v-sexpr/sexpr-3v.cert \
-     centaur/aig/three-four.cert \
-     centaur/aig/aig-equivs.cert \
-     centaur/misc/tuplep.cert \
-     centaur/aig/eval-restrict.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-to-faig.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-vars-1pass.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-vars-1pass.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-vars-1pass.cert : \
-     centaur/4v-sexpr/sexpr-vars.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-vars-1pass.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/sexpr-vars.cert : acl2x = 0
-centaur/4v-sexpr/sexpr-vars.cert : no_pcert = 0
-
-centaur/4v-sexpr/sexpr-vars.cert : \
-     centaur/4v-sexpr/sexpr-eval.cert \
-     centaur/misc/hons-alphorder-merge.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/sexpr-vars.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/svarmap.cert : acl2x = 0
-centaur/4v-sexpr/svarmap.cert : no_pcert = 0
-
-centaur/4v-sexpr/svarmap.cert : \
-     centaur/aig/base.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/misc/hons-sets.cert \
-     data-structures/no-duplicates.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/svarmap.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/4v-sexpr/top.cert : acl2x = 0
-centaur/4v-sexpr/top.cert : no_pcert = 0
-
-centaur/4v-sexpr/top.cert : \
-     centaur/4v-sexpr/4v-logic.cert \
-     centaur/4v-sexpr/bitspecs.cert \
-     centaur/4v-sexpr/compose-sexpr.cert \
-     centaur/4v-sexpr/g-sexpr-eval.cert \
-     centaur/4v-sexpr/nsexprs.cert \
-     centaur/4v-sexpr/onehot-rewrite.cert \
-     centaur/4v-sexpr/sexpr-advanced.cert \
-     centaur/4v-sexpr/sexpr-building.cert \
-     centaur/4v-sexpr/sexpr-equivs.cert \
-     centaur/4v-sexpr/sexpr-eval.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-correct.cert \
-     centaur/4v-sexpr/sexpr-fixpoint.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-rewriting.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-spec.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-top.cert \
-     centaur/4v-sexpr/sexpr-loop-debug.cert \
-     centaur/4v-sexpr/sexpr-rewrites.cert \
-     centaur/4v-sexpr/sexpr-to-faig.cert \
-     centaur/4v-sexpr/sexpr-vars.cert \
-     centaur/4v-sexpr/svarmap.cert \
-     centaur/4v-sexpr/portcullis.cert \
-     centaur/4v-sexpr/top.lisp \
-     centaur/4v-sexpr/cert.acl2
-
-
-centaur/aig/aig-equivs.cert : acl2x = 0
-centaur/aig/aig-equivs.cert : no_pcert = 0
-
-centaur/aig/aig-equivs.cert : \
-     centaur/aig/base.cert \
-     centaur/misc/witness-cp.cert \
-     centaur/misc/universal-equiv.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/aig-equivs.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/aig-vars-ext.cert : acl2x = 0
-centaur/aig/aig-vars-ext.cert : no_pcert = 0
-
-centaur/aig/aig-vars-ext.cert : \
-     defsort/defsort.cert \
-     centaur/aig/base.cert \
-     tools/bstar.cert \
-     centaur/bitops/sbitsets.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/misc/alist-defs.cert \
-     centaur/misc/numlist.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/aig-vars-ext.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/aig-vars.cert : acl2x = 0
-centaur/aig/aig-vars.cert : no_pcert = 0
-
-centaur/aig/aig-vars.cert : \
-     centaur/aig/base.cert \
-     centaur/misc/equal-sets.cert \
-     centaur/misc/alist-equiv.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/aig-vars.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/aiger.cert : acl2x = 0
-centaur/aig/aiger.cert : no_pcert = 0
-
-centaur/aig/aiger.cert : \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     data-structures/list-defthms.cert \
-     centaur/aig/aig-vars-ext.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/misc/sneaky-load.cert \
-     centaur/misc/numlist.cert \
-     tools/defmacfun.cert \
-     misc/definline.cert \
-     system/io.cert \
-     arithmetic/nat-listp.cert \
-     clause-processors/instantiate.cert \
-     centaur/bitops/ihsext-basics.cert \
-     arithmetic/top-with-meta.cert \
-     cutil/defmvtypes.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/aiger.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/base.cert : acl2x = 0
-centaur/aig/base.cert : no_pcert = 0
-
-centaur/aig/base.cert : \
-     cutil/defsection.cert \
-     centaur/misc/hons-alphorder-merge.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/base.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/bddify-correct.cert : acl2x = 0
-centaur/aig/bddify-correct.cert : no_pcert = 0
-
-centaur/aig/bddify-correct.cert : \
-     centaur/aig/bddify.cert \
-     centaur/ubdds/param.cert \
-     centaur/ubdds/lite.cert \
-     centaur/misc/suffixp.cert \
-     tools/with-quoted-forms.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/bddify-correct.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/bddify.cert : acl2x = 0
-centaur/aig/bddify.cert : no_pcert = 0
-
-centaur/aig/bddify.cert : \
-     centaur/aig/base.cert \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     misc/hons-help2.cert \
-     centaur/ubdds/extra-operations.cert \
-     centaur/misc/memory-mgmt-logic.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/bddify.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/eval-restrict.cert : acl2x = 0
-centaur/aig/eval-restrict.cert : no_pcert = 0
-
-centaur/aig/eval-restrict.cert : \
-     centaur/aig/base.cert \
-     centaur/aig/aig-equivs.cert \
-     centaur/aig/three-four.cert \
-     centaur/aig/aig-vars.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/eval-restrict.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/g-aig-eval.cert : acl2x = 0
-centaur/aig/g-aig-eval.cert : no_pcert = 0
-
-centaur/aig/g-aig-eval.cert : \
-     centaur/aig/bddify-correct.cert \
-     centaur/gl/g-if.cert \
-     centaur/gl/gify.cert \
-     centaur/gl/gify-thms.cert \
-     centaur/gl/eval-f-i-cp.cert \
-     centaur/gl/bvecs.cert \
-     centaur/gl/gify-clause-proc.cert \
-     centaur/gl/general-object-thms.cert \
-     centaur/aig/eval-restrict.cert \
-     centaur/gl/portcullis.cert \
-     centaur/aig/g-aig-eval.lisp \
-     centaur/aig/g-aig-eval.acl2
-
-
-centaur/aig/induction.cert : acl2x = 0
-centaur/aig/induction.cert : no_pcert = 0
-
-centaur/aig/induction.cert : \
-     centaur/aig/eval-restrict.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/induction.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/misc.cert : acl2x = 0
-centaur/aig/misc.cert : no_pcert = 0
-
-centaur/aig/misc.cert : \
-     centaur/aig/base.cert \
-     centaur/misc/equal-sets.cert \
-     tools/mv-nth.cert \
-     misc/gentle.cert \
-     misc/hons-help.cert \
-     centaur/aig/eval-restrict.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/misc.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/portcullis.cert : acl2x = 0
-centaur/aig/portcullis.cert : no_pcert = 0
-
-centaur/aig/portcullis.cert : \
-     centaur/aig/portcullis.lisp \
-     centaur/aig/portcullis.acl2 \
-     centaur/vl/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     centaur/vl/other-packages.lsp \
-     data-structures/define-u-package.lsp \
-     tools/flag-package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     cowles/packages.lsp \
-     centaur/aig/fsm-pkg.lsp
-
-
-centaur/aig/three-four.cert : acl2x = 0
-centaur/aig/three-four.cert : no_pcert = 0
-
-centaur/aig/three-four.cert : \
-     centaur/aig/base.cert \
-     tools/bstar.cert \
-     tools/rulesets.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/three-four.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/vuaig.cert : acl2x = 0
-centaur/aig/vuaig.cert : no_pcert = 0
-
-centaur/aig/vuaig.cert : \
-     centaur/aig/three-four.cert \
-     centaur/aig/portcullis.cert \
-     centaur/aig/vuaig.lisp \
-     centaur/aig/cert.acl2
-
-
-centaur/aig/witness.cert : acl2x = 0
-centaur/aig/witness.cert : no_pcert = 0
-
-centaur/aig/witness.cert : \
-     misc/hons-help2.cert \
-     centaur/aig/base.cert \
-     clause-processors/term-patterns.cert \
-     clause-processors/join-thms.cert \
-     tools/flag.cert \
-     centaur/aig/witness.lisp \
-     centaur/aig/witness.acl2 \
-     tools/flag-package.lsp
-
-
-centaur/bitops/bits-between.cert : acl2x = 0
-centaur/bitops/bits-between.cert : no_pcert = 0
-
-centaur/bitops/bits-between.cert : \
-     cutil/defsection.cert \
-     tools/bstar.cert \
-     finite-set-theory/osets/sets.cert \
-     centaur/bitops/ihs-extensions.cert \
-     std/lists/rev.cert \
-     std/lists/append.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/bits-between.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/bitsets-opt.cert : acl2x = 0
-centaur/bitops/bitsets-opt.cert : no_pcert = 0
-
-centaur/bitops/bitsets-opt.cert : \
-     centaur/bitops/bitsets.cert \
-     tools/include-raw.cert \
-     make-event/assert.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/bitsets-opt.lisp \
-     centaur/bitops/cert.acl2 \
-     centaur/bitops/bitsets-opt-raw.lsp
-
-
-centaur/bitops/bitsets.cert : acl2x = 0
-centaur/bitops/bitsets.cert : no_pcert = 0
-
-centaur/bitops/bitsets.cert : \
-     centaur/bitops/bits-between.cert \
-     centaur/bitops/equal-by-logbitp.cert \
-     misc/definline.cert \
-     centaur/misc/witness-cp.cert \
-     centaur/bitops/ihs-extensions.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     arithmetic-3/bind-free/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/bitsets.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/congruences.cert : acl2x = 0
-centaur/bitops/congruences.cert : no_pcert = 0
-
-centaur/bitops/congruences.cert : \
-     tools/rulesets.cert \
-     centaur/misc/context-rw.cert \
-     ihs/basic-definitions.cert \
-     centaur/bitops/ihsext-basics.cert \
-     centaur/bitops/ihs-extensions.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/bitops/equal-by-logbitp.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/congruences.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/equal-by-logbitp.cert : acl2x = 0
-centaur/bitops/equal-by-logbitp.cert : no_pcert = 0
-
-centaur/bitops/equal-by-logbitp.cert : \
-     cutil/wizard.cert \
-     centaur/bitops/integer-length.cert \
-     centaur/bitops/ihsext-basics.cert \
-     arithmetic/top-with-meta.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/equal-by-logbitp.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/extra-defs.cert : acl2x = 0
-centaur/bitops/extra-defs.cert : no_pcert = 0
-
-centaur/bitops/extra-defs.cert : \
-     centaur/bitops/ihsext-basics.cert \
-     arithmetic/top.cert \
-     centaur/misc/arith-equivs.cert \
-     ihs/logops-definitions.cert \
-     xdoc/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/extra-defs.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/ihs-extensions.cert : acl2x = 0
-centaur/bitops/ihs-extensions.cert : no_pcert = 0
-
-centaur/bitops/ihs-extensions.cert : \
-     centaur/bitops/ihsext-basics.cert \
-     centaur/bitops/integer-length.cert \
-     centaur/bitops/equal-by-logbitp.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/ihs-extensions.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/ihsext-basics.cert : acl2x = 0
-centaur/bitops/ihsext-basics.cert : no_pcert = 0
-
-centaur/bitops/ihsext-basics.cert : \
-     centaur/misc/arith-equivs.cert \
-     xdoc/top.cert \
-     tools/defredundant.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     arithmetic/top-with-meta.cert \
-     ihs/logops-lemmas.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/ihsext-basics.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/install-bit.cert : acl2x = 0
-centaur/bitops/install-bit.cert : no_pcert = 0
-
-centaur/bitops/install-bit.cert : \
-     cutil/defsection.cert \
-     centaur/misc/arith-equivs.cert \
-     centaur/misc/mfc-utils.cert \
-     centaur/misc/introduce-var.cert \
-     centaur/bitops/equal-by-logbitp.cert \
-     centaur/bitops/ihsext-basics.cert \
-     arithmetic/top-with-meta.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/install-bit.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/integer-length.cert : acl2x = 0
-centaur/bitops/integer-length.cert : no_pcert = 0
-
-centaur/bitops/integer-length.cert : \
-     cutil/defsection.cert \
-     ihs/logops-definitions.cert \
-     ihs/logops-lemmas.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/bitops/ihsext-basics.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/integer-length.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/part-select.cert : acl2x = 0
-centaur/bitops/part-select.cert : no_pcert = 0
-
-centaur/bitops/part-select.cert : \
-     ihs/logops-definitions.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/bitops/ihsext-basics.cert \
-     misc/assert.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/part-select.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/rotate.cert : acl2x = 0
-centaur/bitops/rotate.cert : no_pcert = 0
-
-centaur/bitops/rotate.cert : \
-     xdoc/top.cert \
-     tools/bstar.cert \
-     ihs/logops-definitions.cert \
-     centaur/misc/arith-equivs.cert \
-     centaur/bitops/ihsext-basics.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/bitops/equal-by-logbitp.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/rotate.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/sbitsets.cert : acl2x = 0
-centaur/bitops/sbitsets.cert : no_pcert = 0
-
-centaur/bitops/sbitsets.cert : \
-     centaur/bitops/bits-between.cert \
-     misc/definline.cert \
-     centaur/bitops/equal-by-logbitp.cert \
-     centaur/bitops/ihs-extensions.cert \
-     centaur/misc/equal-sets.cert \
-     std/lists/revappend.cert \
-     std/lists/rev.cert \
-     std/lists/append.cert \
-     arithmetic-3/bind-free/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/sbitsets.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/sign-extend.cert : acl2x = 0
-centaur/bitops/sign-extend.cert : no_pcert = 0
-
-centaur/bitops/sign-extend.cert : \
-     xdoc/top.cert \
-     misc/definline.cert \
-     tools/bstar.cert \
-     ihs/logops-definitions.cert \
-     centaur/bitops/ihs-extensions.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/sign-extend.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bitops/top.cert : acl2x = 0
-centaur/bitops/top.cert : no_pcert = 0
-
-centaur/bitops/top.cert : \
-     centaur/bitops/bits-between.cert \
-     centaur/bitops/bitsets.cert \
-     centaur/bitops/bitsets-opt.cert \
-     centaur/bitops/equal-by-logbitp.cert \
-     centaur/bitops/ihs-extensions.cert \
-     centaur/bitops/integer-length.cert \
-     centaur/bitops/sbitsets.cert \
-     centaur/bitops/part-select.cert \
-     centaur/bitops/extra-defs.cert \
-     finite-set-theory/osets/portcullis.cert \
-     cutil/portcullis.cert \
-     centaur/bitops/top.lisp \
-     centaur/bitops/cert.acl2
-
-
-centaur/bridge/portcullis.cert : acl2x = 0
-centaur/bridge/portcullis.cert : no_pcert = 0
-
-centaur/bridge/portcullis.cert : \
-     str/portcullis.cert \
-     xdoc/portcullis.cert \
-     centaur/bridge/portcullis.lisp \
-     centaur/bridge/portcullis.acl2 \
-     centaur/bridge/package.lsp \
-     tools/flag-package.lsp
-
-
-centaur/bridge/to-json.cert : acl2x = 0
-centaur/bridge/to-json.cert : no_pcert = 0
-
-centaur/bridge/to-json.cert : \
-     misc/definline.cert \
-     str/cat.cert \
-     str/natstr.cert \
-     std/ks/two-nats-measure.cert \
-     std/ks/explode-atom.cert \
-     centaur/bitops/ihsext-basics.cert \
-     misc/assert.cert \
-     std/lists/nthcdr.cert \
-     arithmetic/top.cert \
-     str/strtok.cert \
-     tools/flag.cert \
-     centaur/bridge/portcullis.cert \
-     centaur/bridge/to-json.lisp \
-     centaur/bridge/cert.acl2
-
-
-centaur/bridge/top.cert : acl2x = 0
-centaur/bridge/top.cert : no_pcert = 0
-
-centaur/bridge/top.cert : \
-     xdoc/top.cert \
-     tools/include-raw.cert \
-     str/top.cert \
-     centaur/bridge/to-json.cert \
-     centaur/bridge/portcullis.cert \
-     centaur/bridge/top.lisp \
-     centaur/bridge/cert.acl2 \
-     centaur/bridge/bridge-raw.lsp
-
-
-centaur/defrstobj/array-lemmas.cert : acl2x = 0
-centaur/defrstobj/array-lemmas.cert : no_pcert = 0
-
-centaur/defrstobj/array-lemmas.cert : \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/array-lemmas.lisp \
-     centaur/defrstobj/cert.acl2
-
-
-centaur/defrstobj/basic-tests.cert : acl2x = 0
-centaur/defrstobj/basic-tests.cert : no_pcert = 0
-
-centaur/defrstobj/basic-tests.cert : \
-     centaur/defrstobj/defrstobj.cert \
-     centaur/defrstobj/typed-record-tests.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/basic-tests.lisp \
-     centaur/defrstobj/cert.acl2
-
-
-centaur/defrstobj/def-typed-record.cert : acl2x = 0
-centaur/defrstobj/def-typed-record.cert : no_pcert = 0
-
-centaur/defrstobj/def-typed-record.cert : \
-     centaur/defrstobj/typed-records.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/def-typed-record.lisp \
-     centaur/defrstobj/cert.acl2
-
-
-centaur/defrstobj/defrstobj.cert : acl2x = 0
-centaur/defrstobj/defrstobj.cert : no_pcert = 0
-
-centaur/defrstobj/defrstobj.cert : \
-     centaur/defrstobj/def-typed-record.cert \
-     centaur/defrstobj/g-delete-keys.cert \
-     centaur/defrstobj/fancy-worseguy.cert \
-     misc/definline.cert \
-     misc/records.cert \
-     tools/bstar.cert \
-     cutil/defsection.cert \
-     centaur/defrstobj/array-lemmas.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/defrstobj.lisp \
-     centaur/defrstobj/cert.acl2
-
-
-centaur/defrstobj/fancy-worseguy.cert : acl2x = 0
-centaur/defrstobj/fancy-worseguy.cert : no_pcert = 0
-
-centaur/defrstobj/fancy-worseguy.cert : \
-     centaur/defrstobj/g-delete-keys.cert \
-     misc/equal-by-g-help.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/fancy-worseguy.lisp \
-     centaur/defrstobj/cert.acl2
-
-
-centaur/defrstobj/g-delete-keys.cert : acl2x = 0
-centaur/defrstobj/g-delete-keys.cert : no_pcert = 0
-
-centaur/defrstobj/g-delete-keys.cert : \
-     misc/records.cert \
-     misc/equal-by-g.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/g-delete-keys.lisp \
-     centaur/defrstobj/cert.acl2
-
-
-centaur/defrstobj/groundwork/array-rec.cert : acl2x = 0
-centaur/defrstobj/groundwork/array-rec.cert : no_pcert = 0
-
-centaur/defrstobj/groundwork/array-rec.cert : \
-     cutil/defsection.cert \
-     misc/records.cert \
-     misc/equal-by-g.cert \
-     centaur/misc/equal-by-nths.cert \
-     centaur/defrstobj/groundwork/local.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/groundwork/array-rec.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-
-
-centaur/defrstobj/groundwork/demo1.cert : acl2x = 0
-centaur/defrstobj/groundwork/demo1.cert : no_pcert = 0
-
-centaur/defrstobj/groundwork/demo1.cert : \
-     misc/records.cert \
-     misc/definline.cert \
-     centaur/defrstobj/groundwork/local.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/groundwork/demo1.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-
-
-centaur/defrstobj/groundwork/demo2.cert : acl2x = 0
-centaur/defrstobj/groundwork/demo2.cert : no_pcert = 0
-
-centaur/defrstobj/groundwork/demo2.cert : \
-     misc/records.cert \
-     misc/definline.cert \
-     centaur/defrstobj/groundwork/local.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/groundwork/demo2.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-
-
-centaur/defrstobj/groundwork/demo3.cert : acl2x = 0
-centaur/defrstobj/groundwork/demo3.cert : no_pcert = 0
-
-centaur/defrstobj/groundwork/demo3.cert : \
-     cutil/defsection.cert \
-     misc/definline.cert \
-     misc/records.cert \
-     centaur/defrstobj/groundwork/local.cert \
-     centaur/defrstobj/groundwork/array-rec.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/groundwork/demo3.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-
-
-centaur/defrstobj/groundwork/demo4.cert : acl2x = 0
-centaur/defrstobj/groundwork/demo4.cert : no_pcert = 0
-
-centaur/defrstobj/groundwork/demo4.cert : \
-     cutil/defsection.cert \
-     misc/definline.cert \
-     misc/records.cert \
-     centaur/defrstobj/groundwork/array-rec.cert \
-     centaur/defrstobj/groundwork/local.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/groundwork/demo4.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-
-
-centaur/defrstobj/groundwork/demo5.cert : acl2x = 0
-centaur/defrstobj/groundwork/demo5.cert : no_pcert = 0
-
-centaur/defrstobj/groundwork/demo5.cert : \
-     cutil/defsection.cert \
-     misc/definline.cert \
-     misc/records.cert \
-     centaur/defrstobj/def-typed-record.cert \
-     centaur/defrstobj/array-lemmas.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/groundwork/demo5.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-
-
-centaur/defrstobj/groundwork/local.cert : acl2x = 0
-centaur/defrstobj/groundwork/local.cert : no_pcert = 0
-
-centaur/defrstobj/groundwork/local.cert : \
-     misc/records.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/groundwork/local.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-
-
-centaur/defrstobj/portcullis.cert : acl2x = 0
-centaur/defrstobj/portcullis.cert : no_pcert = 0
-
-centaur/defrstobj/portcullis.cert : \
-     centaur/defrstobj/portcullis.lisp \
-     centaur/defrstobj/portcullis.acl2 \
-     centaur/defrstobj/package.lsp
-
-
-centaur/defrstobj/typed-record-tests.cert : acl2x = 0
-centaur/defrstobj/typed-record-tests.cert : no_pcert = 0
-
-centaur/defrstobj/typed-record-tests.cert : \
-     centaur/defrstobj/def-typed-record.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/typed-record-tests.lisp \
-     centaur/defrstobj/cert.acl2
-
-
-centaur/defrstobj/typed-records.cert : acl2x = 0
-centaur/defrstobj/typed-records.cert : no_pcert = 0
-
-centaur/defrstobj/typed-records.cert : \
-     misc/total-order.cert \
-     centaur/misc/mfc-utils.cert \
-     centaur/misc/introduce-var.cert \
-     centaur/misc/equal-by-nths.cert \
-     centaur/defrstobj/array-lemmas.cert \
-     centaur/defrstobj/portcullis.cert \
-     centaur/defrstobj/typed-records.lisp \
-     centaur/defrstobj/cert.acl2
-
-
-centaur/esim/esim-paths.cert : acl2x = 0
-centaur/esim/esim-paths.cert : no_pcert = 0
-
-centaur/esim/esim-paths.cert : \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/esim/esim-sexpr-support-thms.cert \
-     cutil/deflist.cert \
-     cutil/defmvtypes.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-paths.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/esim-primitives.cert : acl2x = 0
-centaur/esim/esim-primitives.cert : no_pcert = 0
-
-centaur/esim/esim-primitives.cert : \
-     tools/bstar.cert \
-     xdoc/top.cert \
-     centaur/esim/plist.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-primitives.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/esim-sexpr-correct.cert : acl2x = 0
-centaur/esim/esim-sexpr-correct.cert : no_pcert = 0
-
-centaur/esim/esim-sexpr-correct.cert : \
-     centaur/esim/esim-sexpr.cert \
-     centaur/esim/esim-spec.cert \
-     centaur/esim/esim-sexpr-support-thms.cert \
-     centaur/4v-sexpr/sexpr-advanced.cert \
-     centaur/4v-sexpr/sexpr-fixpoint-top.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-sexpr-correct.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/esim-sexpr-support-thms.cert : acl2x = 0
-centaur/esim/esim-sexpr-support-thms.cert : no_pcert = 0
-
-centaur/esim/esim-sexpr-support-thms.cert : \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/esim/local-theory.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-sexpr-support-thms.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/esim-sexpr-support.cert : acl2x = 0
-centaur/esim/esim-sexpr-support.cert : no_pcert = 0
-
-centaur/esim/esim-sexpr-support.cert : \
-     centaur/esim/plist.cert \
-     centaur/misc/patterns.cert \
-     centaur/4v-sexpr/sexpr-vars.cert \
-     std/ks/explode-nonnegative-integer.cert \
-     std/ks/two-nats-measure.cert \
-     arithmetic/nat-listp.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-sexpr-support.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/esim-sexpr.cert : acl2x = 0
-centaur/esim/esim-sexpr.cert : no_pcert = 0
-
-centaur/esim/esim-sexpr.cert : \
-     centaur/esim/esim-paths.cert \
-     centaur/esim/esim-sexpr-support.cert \
-     str/strsubst.cert \
-     str/substrp.cert \
-     centaur/misc/ap.cert \
-     centaur/4v-sexpr/sexpr-fixpoint.cert \
-     centaur/4v-sexpr/sexpr-to-faig.cert \
-     centaur/4v-sexpr/sexpr-equivs.cert \
-     centaur/esim/esim-sexpr-support-thms.cert \
-     centaur/4v-sexpr/sexpr-advanced.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-sexpr.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/esim-spec.cert : acl2x = 0
-centaur/esim/esim-spec.cert : no_pcert = 0
-
-centaur/esim/esim-spec.cert : \
-     centaur/esim/esim-sexpr-support.cert \
-     std/ks/two-nats-measure.cert \
-     std/lists/rev.cert \
-     centaur/4v-sexpr/4v-logic.cert \
-     centaur/4v-sexpr/sexpr-equivs.cert \
-     centaur/misc/patterns.cert \
-     centaur/esim/esim-sexpr-support-thms.cert \
-     centaur/4v-sexpr/sexpr-advanced.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-spec.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/esim-vcd.cert : acl2x = 0
-centaur/esim/esim-vcd.cert : no_pcert = 0
-
-centaur/esim/esim-vcd.cert : \
-     centaur/esim/esim-vl.cert \
-     centaur/esim/esim-paths.cert \
-     centaur/misc/load-stobj.cert \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/util/string-alists.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-vcd.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/esim-vl.cert : acl2x = 0
-centaur/esim/esim-vl.cert : no_pcert = 0
-
-centaur/esim/esim-vl.cert : \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/vl/toe/toe-wirealist.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/esim-vl.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/follow-backwards.cert : acl2x = 0
-centaur/esim/follow-backwards.cert : no_pcert = 0
-
-centaur/esim/follow-backwards.cert : \
-     centaur/esim/esim-paths.cert \
-     centaur/esim/esim-sexpr-support-thms.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/follow-backwards.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/local-theory.cert : acl2x = 0
-centaur/esim/local-theory.cert : no_pcert = 0
-
-centaur/esim/local-theory.cert : \
-     std/lists/rev.cert \
-     data-structures/list-defthms.cert \
-     data-structures/no-duplicates.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/misc/equal-sets.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/local-theory.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/plist.cert : acl2x = 0
-centaur/esim/plist.cert : no_pcert = 0
-
-centaur/esim/plist.cert : \
-     centaur/esim/portcullis.cert \
-     centaur/esim/plist.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/portcullis.cert : acl2x = 0
-centaur/esim/portcullis.cert : no_pcert = 0
-
-centaur/esim/portcullis.cert : \
-     cutil/portcullis.cert \
-     str/portcullis.cert \
-     centaur/vl/portcullis.cert \
-     centaur/gl/portcullis.cert \
-     centaur/esim/portcullis.lisp \
-     centaur/esim/portcullis.acl2 \
-     centaur/esim/packages.lsp \
-     tools/flag-package.lsp
-
-
-centaur/esim/steps.cert : acl2x = 0
-centaur/esim/steps.cert : no_pcert = 0
-
-centaur/esim/steps.cert : \
-     centaur/esim/esim-sexpr.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/steps.lisp \
-     centaur/esim/cert.acl2
-
-
-centaur/esim/stv/stv-compile.cert : acl2x = 0
-centaur/esim/stv/stv-compile.cert : no_pcert = 0
-
-centaur/esim/stv/stv-compile.cert : \
-     centaur/esim/stv/stv-util.cert \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/esim/follow-backwards.cert \
-     centaur/misc/vecs-ints.cert \
-     centaur/misc/tuplep.cert \
-     cutil/defmvtypes.cert \
-     cutil/defprojection.cert \
-     str/natstr.cert \
-     std/lists/final-cdr.cert \
-     centaur/vl/util/defs.cert \
-     centaur/esim/esim-sexpr-support-thms.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-compile.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/esim/stv/stv-debug.cert : acl2x = 0
-centaur/esim/stv/stv-debug.cert : no_pcert = 0
-
-centaur/esim/stv/stv-debug.cert : \
-     centaur/esim/stv/stv-run.cert \
-     centaur/esim/stv/stv-sim.cert \
-     oslib/date.cert \
-     centaur/misc/tshell.cert \
-     centaur/esim/esim-vcd.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-debug.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/esim/stv/stv-doc.cert : acl2x = 0
-centaur/esim/stv/stv-doc.cert : no_pcert = 0
-
-centaur/esim/stv/stv-doc.cert : \
-     centaur/esim/stv/stv-util.cert \
-     centaur/esim/stv/stv-widen.cert \
-     str/stringify.cert \
-     centaur/vl/util/print-htmlencode.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-doc.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/esim/stv/stv-expand.cert : acl2x = 0
-centaur/esim/stv/stv-expand.cert : no_pcert = 0
-
-centaur/esim/stv/stv-expand.cert : \
-     centaur/esim/stv/stv-util.cert \
-     centaur/esim/esim-vl.cert \
-     centaur/esim/esim-paths.cert \
-     centaur/vl/mlib/hid-tools.cert \
-     centaur/vl/mlib/expr-parse.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-expand.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/esim/stv/stv-run.cert : acl2x = 0
-centaur/esim/stv/stv-run.cert : no_pcert = 0
-
-centaur/esim/stv/stv-run.cert : \
-     centaur/esim/stv/stv-util.cert \
-     str/hexify.cert \
-     centaur/misc/vecs-ints.cert \
-     centaur/vl/util/defs.cert \
-     centaur/4v-sexpr/bitspecs.cert \
-     centaur/4v-sexpr/sexpr-rewrites.cert \
-     centaur/gl/gl-util.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-run.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/esim/stv/stv-sim.cert : acl2x = 0
-centaur/esim/stv/stv-sim.cert : no_pcert = 0
-
-centaur/esim/stv/stv-sim.cert : \
-     centaur/esim/stv/stv-util.cert \
-     centaur/vl/util/defs.cert \
-     centaur/esim/steps.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-sim.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/esim/stv/stv-top.cert : acl2x = 0
-centaur/esim/stv/stv-top.cert : no_pcert = 0
-
-centaur/esim/stv/stv-top.cert : \
-     centaur/esim/stv/stv-sim.cert \
-     centaur/esim/stv/stv-compile.cert \
-     centaur/esim/stv/stv-expand.cert \
-     centaur/esim/stv/stv-widen.cert \
-     centaur/esim/stv/stv-doc.cert \
-     centaur/esim/stv/stv-run.cert \
-     centaur/gl/auto-bindings.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-top.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/esim/stv/stv-util.cert : acl2x = 0
-centaur/esim/stv/stv-util.cert : no_pcert = 0
-
-centaur/esim/stv/stv-util.cert : \
-     centaur/esim/esim-sexpr-support.cert \
-     cutil/defaggregate.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-util.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/esim/stv/stv-widen.cert : acl2x = 0
-centaur/esim/stv/stv-widen.cert : no_pcert = 0
-
-centaur/esim/stv/stv-widen.cert : \
-     centaur/esim/stv/stv-util.cert \
-     std/lists/repeat.cert \
-     std/lists/take.cert \
-     centaur/esim/portcullis.cert \
-     centaur/esim/stv/stv-widen.lisp \
-     centaur/esim/stv/cert.acl2
-
-
-centaur/gl/always-equal-prep.cert : acl2x = 0
-centaur/gl/always-equal-prep.cert : no_pcert = 0
-
-centaur/gl/always-equal-prep.cert : \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/g-if.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/eval-g-base.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/always-equal-prep.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/auto-bindings.cert : acl2x = 0
-centaur/gl/auto-bindings.cert : no_pcert = 0
-
-centaur/gl/auto-bindings.cert : \
-     centaur/gl/gl-doc-string.cert \
-     centaur/gl/gobject-types.cert \
-     centaur/misc/numlist.cert \
-     tools/bstar.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/auto-bindings.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/bfr-aig-bddify.cert : acl2x = 0
-centaur/gl/bfr-aig-bddify.cert : no_pcert = 0
-
-centaur/gl/bfr-aig-bddify.cert : \
-     centaur/gl/bfr-sat.cert \
-     centaur/gl/gl-doc-string.cert \
-     centaur/aig/bddify-correct.cert \
-     centaur/aig/eval-restrict.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/bfr-aig-bddify.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/bfr-sat.cert : acl2x = 0
-centaur/gl/bfr-sat.cert : no_pcert = 0
-
-centaur/gl/bfr-sat.cert : \
-     centaur/gl/bfr.cert \
-     centaur/gl/gl-doc-string.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/bfr-sat.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/bfr.cert : acl2x = 0
-centaur/gl/bfr.cert : no_pcert = 0
-
-centaur/gl/bfr.cert : \
-     centaur/ubdds/lite.cert \
-     centaur/aig/witness.cert \
-     clause-processors/term-patterns.cert \
-     clause-processors/join-thms.cert \
-     tools/flag.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/bfr.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/bvec-ite.cert : acl2x = 0
-centaur/gl/bvec-ite.cert : no_pcert = 0
-
-centaur/gl/bvec-ite.cert : \
-     centaur/gl/bvecs.cert \
-     tools/bstar.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/bvec-ite.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/bvecs.cert : acl2x = 0
-centaur/gl/bvecs.cert : no_pcert = 0
-
-centaur/gl/bvecs.cert : \
-     centaur/gl/bfr.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     ihs/math-lemmas.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/bvecs.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/def-gl-clause-proc.cert : acl2x = 0
-centaur/gl/def-gl-clause-proc.cert : no_pcert = 0
-
-centaur/gl/def-gl-clause-proc.cert : \
-     parallel/without-waterfall-parallelism.cert \
-     centaur/misc/defapply.cert \
-     centaur/gl/gify.cert \
-     centaur/gl/gify-thms.cert \
-     centaur/gl/run-gified-cp.cert \
-     centaur/gl/general-object-thms.cert \
-     centaur/gl/glcp-templates.cert \
-     centaur/gl/gl-doc-string.cert \
-     centaur/gl/generic-geval.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/def-gl-clause-proc.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/defagg.cert : acl2x = 0
-centaur/gl/defagg.cert : no_pcert = 0
-
-centaur/gl/defagg.cert : \
-     cutil/defaggregate.cert \
-     tools/flag.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/defagg.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/defapply.cert : acl2x = 0
-centaur/gl/defapply.cert : no_pcert = 0
-
-centaur/gl/defapply.cert : \
-     clause-processors/generalize.cert \
-     tools/mv-nth.cert \
-     tools/rulesets.cert \
-     centaur/gl/gl-util.cert \
-     misc/hons-help2.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/defapply.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/eval-f-i-cp.cert : acl2x = 0
-centaur/gl/eval-f-i-cp.cert : no_pcert = 0
-
-centaur/gl/eval-f-i-cp.cert : \
-     centaur/gl/gl-util.cert \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     misc/hons-help2.cert \
-     clause-processors/join-thms.cert \
-     centaur/misc/hons-sets.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/eval-f-i-cp.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/eval-g-base-help.cert : acl2x = 0
-centaur/gl/eval-g-base-help.cert : no_pcert = 0
-
-centaur/gl/eval-g-base-help.cert : \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/gify-clause-proc.cert \
-     centaur/gl/general-object-thms.cert \
-     tools/def-functional-instance.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/eval-g-base-help.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/eval-g-base.cert : acl2x = 0
-centaur/gl/eval-g-base.cert : no_pcert = 0
-
-centaur/gl/eval-g-base.cert : \
-     centaur/gl/defapply.cert \
-     centaur/gl/generic-geval.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/eval-g-base.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/factor-fns.cert : acl2x = 0
-centaur/gl/factor-fns.cert : no_pcert = 0
-
-centaur/gl/factor-fns.cert : \
-     tools/bstar.cert \
-     centaur/gl/rws.cert \
-     clause-processors/generalize.cert \
-     misc/hons-help.cert \
-     centaur/gl/gl-util.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/factor-fns.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-always-equal.cert : acl2x = 0
-centaur/gl/g-always-equal.cert : no_pcert = 0
-
-centaur/gl/g-always-equal.cert : \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/g-if.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/always-equal-prep.cert \
-     centaur/gl/g-equal.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-always-equal.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-ash.cert : acl2x = 0
-centaur/gl/g-ash.cert : no_pcert = 0
-
-centaur/gl/g-ash.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-ash.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-binary-+.cert : acl2x = 0
-centaur/gl/g-binary-+.cert : no_pcert = 0
-
-centaur/gl/g-binary-+.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-binary-+.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-binary-mult.cert : acl2x = 0
-centaur/gl/g-binary-mult.cert : no_pcert = 0
-
-centaur/gl/g-binary-mult.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-binary-mult.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-code-char.cert : acl2x = 0
-centaur/gl/g-code-char.cert : no_pcert = 0
-
-centaur/gl/g-code-char.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/g-lessthan.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-code-char.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-coerce.cert : acl2x = 0
-centaur/gl/g-coerce.cert : no_pcert = 0
-
-centaur/gl/g-coerce.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-coerce.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-cons.cert : acl2x = 0
-centaur/gl/g-cons.cert : no_pcert = 0
-
-centaur/gl/g-cons.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-cons.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-equal.cert : acl2x = 0
-centaur/gl/g-equal.cert : no_pcert = 0
-
-centaur/gl/g-equal.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-equal.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-floor.cert : acl2x = 0
-centaur/gl/g-floor.cert : no_pcert = 0
-
-centaur/gl/g-floor.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-floor.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-gl-mbe.cert : acl2x = 0
-centaur/gl/g-gl-mbe.cert : no_pcert = 0
-
-centaur/gl/g-gl-mbe.cert : \
-     centaur/gl/bfr-sat.cert \
-     centaur/gl/g-always-equal.cert \
-     centaur/gl/gl-mbe.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-gl-mbe.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-hide.cert : acl2x = 0
-centaur/gl/g-hide.cert : no_pcert = 0
-
-centaur/gl/g-hide.cert : \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/gobjectp-thms.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-hide.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-if.cert : acl2x = 0
-centaur/gl/g-if.cert : no_pcert = 0
-
-centaur/gl/g-if.cert : \
-     centaur/gl/ite-merge.cert \
-     centaur/gl/gtests.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-if.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-integer-length.cert : acl2x = 0
-centaur/gl/g-integer-length.cert : no_pcert = 0
-
-centaur/gl/g-integer-length.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-integer-length.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-intern.cert : acl2x = 0
-centaur/gl/g-intern.cert : no_pcert = 0
-
-centaur/gl/g-intern.cert : \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/g-if.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-intern.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-lessthan.cert : acl2x = 0
-centaur/gl/g-lessthan.cert : no_pcert = 0
-
-centaur/gl/g-lessthan.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-lessthan.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-logand.cert : acl2x = 0
-centaur/gl/g-logand.cert : no_pcert = 0
-
-centaur/gl/g-logand.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-logand.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-logbitp.cert : acl2x = 0
-centaur/gl/g-logbitp.cert : no_pcert = 0
-
-centaur/gl/g-logbitp.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-logbitp.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-logior.cert : acl2x = 0
-centaur/gl/g-logior.cert : no_pcert = 0
-
-centaur/gl/g-logior.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-logior.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-lognot.cert : acl2x = 0
-centaur/gl/g-lognot.cert : no_pcert = 0
-
-centaur/gl/g-lognot.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-lognot.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-make-fast-alist.cert : acl2x = 0
-centaur/gl/g-make-fast-alist.cert : no_pcert = 0
-
-centaur/gl/g-make-fast-alist.cert : \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/g-if.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-make-fast-alist.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-mod.cert : acl2x = 0
-centaur/gl/g-mod.cert : no_pcert = 0
-
-centaur/gl/g-mod.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-mod.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-predicates.cert : acl2x = 0
-centaur/gl/g-predicates.cert : no_pcert = 0
-
-centaur/gl/g-predicates.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-predicates.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-primitives-help.cert : acl2x = 0
-centaur/gl/g-primitives-help.cert : no_pcert = 0
-
-centaur/gl/g-primitives-help.cert : \
-     tools/flag.cert \
-     centaur/gl/gl-util.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-primitives-help.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-rem.cert : acl2x = 0
-centaur/gl/g-rem.cert : no_pcert = 0
-
-centaur/gl/g-rem.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-rem.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-truncate.cert : acl2x = 0
-centaur/gl/g-truncate.cert : no_pcert = 0
-
-centaur/gl/g-truncate.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-truncate.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-unary--.cert : acl2x = 0
-centaur/gl/g-unary--.cert : no_pcert = 0
-
-centaur/gl/g-unary--.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-unary--.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/g-unary-concrete.cert : acl2x = 0
-centaur/gl/g-unary-concrete.cert : no_pcert = 0
-
-centaur/gl/g-unary-concrete.cert : \
-     centaur/gl/g-if.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     centaur/gl/eval-g-base.cert \
-     centaur/gl/symbolic-arithmetic.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/g-unary-concrete.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/general-object-thms.cert : acl2x = 0
-centaur/gl/general-object-thms.cert : no_pcert = 0
-
-centaur/gl/general-object-thms.cert : \
-     centaur/gl/gtype-thms.cert \
-     centaur/gl/general-objects.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/general-object-thms.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/general-objects.cert : acl2x = 0
-centaur/gl/general-objects.cert : no_pcert = 0
-
-centaur/gl/general-objects.cert : \
-     centaur/gl/gtypes.cert \
-     centaur/gl/gobjectp-thms.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/general-objects.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/generic-geval.cert : acl2x = 0
-centaur/gl/generic-geval.cert : no_pcert = 0
-
-centaur/gl/generic-geval.cert : \
-     centaur/gl/gobjectp.cert \
-     centaur/gl/bvecs.cert \
-     tools/bstar.cert \
-     centaur/gl/gobjectp-thms.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/generic-geval.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gify-clause-proc.cert : acl2x = 0
-centaur/gl/gify-clause-proc.cert : no_pcert = 0
-
-centaur/gl/gify-clause-proc.cert : \
-     centaur/gl/g-if.cert \
-     clause-processors/unify-subst.cert \
-     tools/def-functional-instance.cert \
-     tools/defevaluator-fast.cert \
-     centaur/gl/gtype-thms.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gify-clause-proc.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gify-thms.cert : acl2x = 0
-centaur/gl/gify-thms.cert : no_pcert = 0
-
-centaur/gl/gify-thms.cert : \
-     centaur/gl/gify-clause-proc.cert \
-     centaur/gl/gtype-thms.cert \
-     centaur/gl/gobjectp-thms.cert \
-     centaur/gl/general-object-thms.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     std/ks/two-nats-measure.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gify-thms.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gify.cert : acl2x = 0
-centaur/gl/gify.cert : no_pcert = 0
-
-centaur/gl/gify.cert : \
-     tools/bstar.cert \
-     centaur/gl/defapply.cert \
-     misc/hons-help.cert \
-     centaur/gl/factor-fns.cert \
-     centaur/gl/g-primitives-help.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gify.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gl-doc-string.cert : acl2x = 0
-centaur/gl/gl-doc-string.cert : no_pcert = 0
-
-centaur/gl/gl-doc-string.cert : \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gl-doc-string.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gl-generic-clause-proc.cert : acl2x = 0
-centaur/gl/gl-generic-clause-proc.cert : no_pcert = 0
-
-centaur/gl/gl-generic-clause-proc.cert : \
-     centaur/gl/param.cert \
-     centaur/gl/g-if.cert \
-     centaur/gl/gify.cert \
-     centaur/gl/bfr-sat.cert \
-     centaur/gl/glcp-templates.cert \
-     misc/untranslate-patterns.cert \
-     data-structures/no-duplicates.cert \
-     clause-processors/use-by-hint.cert \
-     clause-processors/decomp-hint.cert \
-     centaur/misc/interp-function-lookup.cert \
-     centaur/gl/general-object-thms.cert \
-     centaur/misc/hons-sets.cert \
-     tools/with-quoted-forms.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     system/f-put-global.cert \
-     tools/def-functional-instance.cert \
-     centaur/misc/vecs-ints.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gl-generic-clause-proc.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gl-mbe.cert : acl2x = 0
-centaur/gl/gl-mbe.cert : no_pcert = 0
-
-centaur/gl/gl-mbe.cert : \
-     centaur/gl/gl-doc-string.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gl-mbe.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gl-misc-defs.cert : acl2x = 0
-centaur/gl/gl-misc-defs.cert : no_pcert = 0
-
-centaur/gl/gl-misc-defs.cert : \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     std/ks/two-nats-measure.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gl-misc-defs.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gl-misc-doc.cert : acl2x = 0
-centaur/gl/gl-misc-doc.cert : no_pcert = 0
-
-centaur/gl/gl-misc-doc.cert : \
-     centaur/gl/gl-doc-string.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gl-misc-doc.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gl-util.cert : acl2x = 0
-centaur/gl/gl-util.cert : no_pcert = 0
-
-centaur/gl/gl-util.cert : \
-     tools/flag.cert \
-     tools/bstar.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gl-util.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gl.cert : acl2x = 0
-centaur/gl/gl.cert : no_pcert = 0
-
-centaur/gl/gl.cert : \
-     centaur/gl/g-ash.cert \
-     centaur/gl/g-binary-+.cert \
-     centaur/gl/g-cons.cert \
-     centaur/gl/g-equal.cert \
-     centaur/gl/g-always-equal.cert \
-     centaur/gl/g-integer-length.cert \
-     centaur/gl/g-lessthan.cert \
-     centaur/gl/g-logand.cert \
-     centaur/gl/g-logior.cert \
-     centaur/gl/g-lognot.cert \
-     centaur/gl/g-logbitp.cert \
-     centaur/gl/g-unary--.cert \
-     centaur/gl/g-hide.cert \
-     centaur/gl/g-predicates.cert \
-     centaur/gl/g-binary-mult.cert \
-     centaur/gl/g-floor.cert \
-     centaur/gl/g-make-fast-alist.cert \
-     centaur/gl/g-mod.cert \
-     centaur/gl/g-truncate.cert \
-     centaur/gl/g-rem.cert \
-     centaur/gl/g-unary-concrete.cert \
-     centaur/gl/g-coerce.cert \
-     centaur/gl/g-code-char.cert \
-     centaur/gl/g-intern.cert \
-     centaur/gl/gl-misc-defs.cert \
-     centaur/gl/eval-f-i-cp.cert \
-     centaur/gl/gl-generic-clause-proc.cert \
-     centaur/gl/def-gl-clause-proc.cert \
-     centaur/gl/gify-thms.cert \
-     centaur/gl/gl-misc-doc.cert \
-     centaur/gl/auto-bindings.cert \
-     centaur/gl/g-gl-mbe.cert \
-     centaur/gl/general-object-thms.cert \
-     centaur/gl/eval-g-base-help.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gl.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/glcp-templates.cert : acl2x = 0
-centaur/gl/glcp-templates.cert : no_pcert = 0
-
-centaur/gl/glcp-templates.cert : \
-     tools/flag.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/glcp-templates.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gobject-type-thms.cert : acl2x = 0
-centaur/gl/gobject-type-thms.cert : no_pcert = 0
-
-centaur/gl/gobject-type-thms.cert : \
-     centaur/gl/defagg.cert \
-     tools/pattern-match.cert \
-     misc/untranslate-patterns.cert \
-     tools/rulesets.cert \
-     centaur/gl/gobject-types.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gobject-type-thms.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gobject-types.cert : acl2x = 0
-centaur/gl/gobject-types.cert : no_pcert = 0
-
-centaur/gl/gobject-types.cert : \
-     centaur/gl/defagg.cert \
-     tools/pattern-match.cert \
-     misc/untranslate-patterns.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gobject-types.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gobjectp-thms.cert : acl2x = 0
-centaur/gl/gobjectp-thms.cert : no_pcert = 0
-
-centaur/gl/gobjectp-thms.cert : \
-     centaur/gl/gobjectp.cert \
-     centaur/gl/gobject-type-thms.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gobjectp-thms.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gobjectp.cert : acl2x = 0
-centaur/gl/gobjectp.cert : no_pcert = 0
-
-centaur/gl/gobjectp.cert : \
-     centaur/gl/bfr.cert \
-     centaur/gl/defagg.cert \
-     tools/pattern-match.cert \
-     centaur/gl/bvecs.cert \
-     centaur/gl/gobject-types.cert \
-     centaur/gl/gobject-type-thms.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gobjectp.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gtests.cert : acl2x = 0
-centaur/gl/gtests.cert : no_pcert = 0
-
-centaur/gl/gtests.cert : \
-     centaur/gl/hyp-fix.cert \
-     centaur/gl/gtypes.cert \
-     centaur/gl/gtype-thms.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     tools/mv-nth.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gtests.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gtype-thms.cert : acl2x = 0
-centaur/gl/gtype-thms.cert : no_pcert = 0
-
-centaur/gl/gtype-thms.cert : \
-     centaur/gl/gtypes.cert \
-     centaur/gl/gobjectp-thms.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gtype-thms.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/gtypes.cert : acl2x = 0
-centaur/gl/gtypes.cert : no_pcert = 0
-
-centaur/gl/gtypes.cert : \
-     centaur/gl/gobjectp.cert \
-     centaur/gl/generic-geval.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/gtypes.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/hyp-fix-logic.cert : acl2x = 0
-centaur/gl/hyp-fix-logic.cert : no_pcert = 0
-
-centaur/gl/hyp-fix-logic.cert : \
-     centaur/gl/hyp-fix.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/hyp-fix-logic.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/hyp-fix.cert : acl2x = 0
-centaur/gl/hyp-fix.cert : no_pcert = 0
-
-centaur/gl/hyp-fix.cert : \
-     centaur/gl/bfr.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/hyp-fix.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/ite-merge.cert : acl2x = 0
-centaur/gl/ite-merge.cert : no_pcert = 0
-
-centaur/gl/ite-merge.cert : \
-     centaur/gl/general-objects.cert \
-     centaur/gl/general-object-thms.cert \
-     centaur/gl/hyp-fix-logic.cert \
-     centaur/gl/bvec-ite.cert \
-     centaur/gl/hyp-fix.cert \
-     std/ks/two-nats-measure.cert \
-     tools/mv-nth.cert \
-     misc/invariants.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/ite-merge.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/param.cert : acl2x = 0
-centaur/gl/param.cert : no_pcert = 0
-
-centaur/gl/param.cert : \
-     centaur/gl/shape-spec.cert \
-     centaur/gl/gtype-thms.cert \
-     data-structures/no-duplicates.cert \
-     tools/mv-nth.cert \
-     ihs/ihs-lemmas.cert \
-     centaur/ubdds/param.cert \
-     centaur/ubdds/lite.cert \
-     centaur/aig/misc.cert \
-     centaur/aig/eval-restrict.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/param.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/portcullis.cert : acl2x = 0
-centaur/gl/portcullis.cert : no_pcert = 0
-
-centaur/gl/portcullis.cert : \
-     cutil/portcullis.cert \
-     centaur/gl/portcullis.lisp \
-     centaur/gl/portcullis.acl2 \
-     centaur/gl/package.lsp \
-     centaur/vl/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     centaur/aignet/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     tools/flag-package.lsp \
-     centaur/satlink/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     tools/flag-package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     tools/flag-package.lsp
-
-
-centaur/gl/run-gified-cp.cert : acl2x = 0
-centaur/gl/run-gified-cp.cert : no_pcert = 0
-
-centaur/gl/run-gified-cp.cert : \
-     centaur/gl/bfr.cert \
-     centaur/gl/gobjectp.cert \
-     tools/mv-nth.cert \
-     tools/bstar.cert \
-     tools/defevaluator-fast.cert \
-     clause-processors/unify-subst.cert \
-     centaur/misc/evaluator-metatheorems.cert \
-     centaur/misc/interp-function-lookup.cert \
-     centaur/ubdds/witness.cert \
-     std/lists/take.cert \
-     centaur/gl/gobjectp-thms.cert \
-     tools/def-functional-instance.cert \
-     centaur/gl/gl-util.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/run-gified-cp.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/rws.cert : acl2x = 0
-centaur/gl/rws.cert : no_pcert = 0
-
-centaur/gl/rws.cert : \
-     clause-processors/use-by-hint.cert \
-     clause-processors/multi-env-trick.cert \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     tools/flag.cert \
-     tools/rulesets.cert \
-     centaur/misc/equal-sets.cert \
-     centaur/misc/alist-equiv.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/rws.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/shape-spec.cert : acl2x = 0
-centaur/gl/shape-spec.cert : no_pcert = 0
-
-centaur/gl/shape-spec.cert : \
-     centaur/gl/gtypes.cert \
-     centaur/gl/gl-doc-string.cert \
-     centaur/gl/gtype-thms.cert \
-     data-structures/no-duplicates.cert \
-     tools/mv-nth.cert \
-     ihs/ihs-lemmas.cert \
-     centaur/misc/fast-alists.cert \
-     ihs/ihs-lemmas.cert \
-     ihs/ihs-lemmas.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/shape-spec.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/symbolic-arithmetic-fns.cert : acl2x = 0
-centaur/gl/symbolic-arithmetic-fns.cert : no_pcert = 0
-
-centaur/gl/symbolic-arithmetic-fns.cert : \
-     centaur/gl/bvec-ite.cert \
-     tools/mv-nth.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/symbolic-arithmetic-fns.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/gl/symbolic-arithmetic.cert : acl2x = 0
-centaur/gl/symbolic-arithmetic.cert : no_pcert = 0
-
-centaur/gl/symbolic-arithmetic.cert : \
-     centaur/gl/symbolic-arithmetic-fns.cert \
-     arithmetic/top-with-meta.cert \
-     ihs/logops-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     centaur/gl/portcullis.cert \
-     centaur/gl/symbolic-arithmetic.lisp \
-     centaur/gl/cert.acl2
-
-
-centaur/misc/absstobjs.cert : acl2x = 0
-centaur/misc/absstobjs.cert : no_pcert = 0
-
-centaur/misc/absstobjs.cert : \
-     tools/bstar.cert \
-     centaur/misc/absstobjs.lisp
-
-
-centaur/misc/alist-defs.cert : acl2x = 0
-centaur/misc/alist-defs.cert : no_pcert = 0
-
-centaur/misc/alist-defs.cert : \
-     misc/hons-help.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/misc/alist-defs.lisp
-
-
-centaur/misc/alist-equiv.cert : acl2x = 0
-centaur/misc/alist-equiv.cert : no_pcert = 0
-
-centaur/misc/alist-equiv.cert : \
-     misc/hons-help2.cert \
-     cutil/defsection.cert \
-     centaur/misc/alist-defs.cert \
-     std/lists/sets.cert \
-     centaur/misc/alist-equiv.lisp
-
-
-centaur/misc/alist-witness.cert : acl2x = 0
-centaur/misc/alist-witness.cert : no_pcert = 0
-
-centaur/misc/alist-witness.cert : \
-     centaur/misc/alist-equiv.cert \
-     centaur/misc/witness-cp.cert \
-     centaur/misc/alist-witness.lisp
-
-
-centaur/misc/ap.cert : acl2x = 0
-centaur/misc/ap.cert : no_pcert = 0
-
-centaur/misc/ap.cert : \
-     centaur/misc/ap.lisp
-
-
-centaur/misc/arith-equivs.cert : acl2x = 0
-centaur/misc/arith-equivs.cert : no_pcert = 0
-
-centaur/misc/arith-equivs.cert : \
-     ihs/basic-definitions.cert \
-     tools/rulesets.cert \
-     std/lists/mfc-utils.cert \
-     centaur/misc/arith-equivs.lisp
-
-
-centaur/misc/context-rw.cert : acl2x = 0
-centaur/misc/context-rw.cert : no_pcert = 0
-
-centaur/misc/context-rw.cert : \
-     clause-processors/unify-subst.cert \
-     centaur/misc/alist-witness.cert \
-     clause-processors/meta-extract-user.cert \
-     centaur/misc/equal-sets.cert \
-     clause-processors/sublis-var-meaning.cert \
-     xdoc/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     centaur/misc/context-rw.lisp \
-     centaur/misc/context-rw.acl2
-
-
-centaur/misc/defapply.cert : acl2x = 0
-centaur/misc/defapply.cert : no_pcert = 0
-
-centaur/misc/defapply.cert : \
-     tools/bstar.cert \
-     clause-processors/generalize.cert \
-     tools/rulesets.cert \
-     clause-processors/use-by-hint.cert \
-     misc/untranslate-patterns.cert \
-     tools/defevaluator-fast.cert \
-     tools/mv-nth.cert \
-     centaur/misc/evaluator-metatheorems.cert \
-     centaur/misc/interp-function-lookup.cert \
-     tools/def-functional-instance.cert \
-     tools/with-quoted-forms.cert \
-     centaur/misc/defapply.lisp
-
-
-centaur/misc/dfs-measure.cert : acl2x = 0
-centaur/misc/dfs-measure.cert : no_pcert = 0
-
-centaur/misc/dfs-measure.cert : \
-     centaur/misc/suffixp.cert \
-     tools/rulesets.cert \
-     std/ks/two-nats-measure.cert \
-     misc/hons-help.cert \
-     tools/bstar.cert \
-     centaur/misc/dfs-measure.lisp
-
-
-centaur/misc/equal-by-nths.cert : acl2x = 0
-centaur/misc/equal-by-nths.cert : no_pcert = 0
-
-centaur/misc/equal-by-nths.cert : \
-     centaur/misc/equal-by-nths.lisp
-
-
-centaur/misc/equal-sets.cert : acl2x = 0
-centaur/misc/equal-sets.cert : no_pcert = 0
-
-centaur/misc/equal-sets.cert : \
-     finite-set-theory/osets/sets.cert \
-     std/lists/sets.cert \
-     centaur/misc/witness-cp.cert \
-     centaur/misc/equal-sets.lisp \
-     centaur/misc/equal-sets.acl2 \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-
-
-centaur/misc/evaluator-metatheorems.cert : acl2x = 0
-centaur/misc/evaluator-metatheorems.cert : no_pcert = 0
-
-centaur/misc/evaluator-metatheorems.cert : \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     clause-processors/use-by-hint.cert \
-     tools/rulesets.cert \
-     clause-processors/ev-theoremp.cert \
-     centaur/misc/evaluator-metatheorems.lisp
-
-
-centaur/misc/fal-graphs.cert : acl2x = 0
-centaur/misc/fal-graphs.cert : no_pcert = 0
-
-centaur/misc/fal-graphs.cert : \
-     tools/bstar.cert \
-     centaur/misc/fal-graphs.lisp
-
-
-centaur/misc/fast-alists.cert : acl2x = 0
-centaur/misc/fast-alists.cert : no_pcert = 0
-
-centaur/misc/fast-alists.cert : \
-     centaur/misc/alist-witness.cert \
-     centaur/misc/equal-sets.cert \
-     centaur/misc/universal-equiv.cert \
-     centaur/misc/fast-alists.lisp
-
-
-centaur/misc/filter-alist.cert : acl2x = 0
-centaur/misc/filter-alist.cert : no_pcert = 0
-
-centaur/misc/filter-alist.cert : \
-     centaur/misc/fast-alists.cert \
-     std/lists/rev.cert \
-     centaur/misc/filter-alist.lisp
-
-
-centaur/misc/hons-alphorder-merge.cert : acl2x = 0
-centaur/misc/hons-alphorder-merge.cert : no_pcert = 0
-
-centaur/misc/hons-alphorder-merge.cert : \
-     misc/total-order.cert \
-     centaur/misc/equal-sets.cert \
-     finite-set-theory/osets/portcullis.cert \
-     centaur/misc/hons-alphorder-merge.lisp \
-     centaur/misc/hons-alphorder-merge.acl2
-
-
-centaur/misc/hons-extra.cert : acl2x = 0
-centaur/misc/hons-extra.cert : no_pcert = 0
-
-centaur/misc/hons-extra.cert : \
-     tools/bstar.cert \
-     centaur/misc/hons-extra.lisp
-
-
-centaur/misc/hons-remove-dups.cert : acl2x = 0
-centaur/misc/hons-remove-dups.cert : no_pcert = 0
-
-centaur/misc/hons-remove-dups.cert : \
-     std/lists/rev.cert \
-     centaur/misc/alist-equiv.cert \
-     centaur/misc/hons-remove-dups.lisp
-
-
-centaur/misc/hons-sets.cert : acl2x = 0
-centaur/misc/hons-sets.cert : no_pcert = 0
-
-centaur/misc/hons-sets.cert : \
-     misc/hons-help2.cert \
-     centaur/misc/equal-sets.cert \
-     centaur/misc/alist-defs.cert \
-     centaur/misc/hons-sets.lisp
-
-
-centaur/misc/interp-function-lookup.cert : acl2x = 0
-centaur/misc/interp-function-lookup.cert : no_pcert = 0
-
-centaur/misc/interp-function-lookup.cert : \
-     centaur/misc/hons-sets.cert \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     clause-processors/use-by-hint.cert \
-     tools/rulesets.cert \
-     misc/untranslate-patterns.cert \
-     clause-processors/ev-theoremp.cert \
-     tools/def-functional-instance.cert \
-     centaur/misc/interp-function-lookup.lisp
-
-
-centaur/misc/introduce-var.cert : acl2x = 0
-centaur/misc/introduce-var.cert : no_pcert = 0
-
-centaur/misc/introduce-var.cert : \
-     clause-processors/generalize.cert \
-     centaur/vl/util/namedb.cert \
-     centaur/vl/portcullis.cert \
-     centaur/misc/introduce-var.lisp \
-     centaur/misc/introduce-var.acl2
-
-
-centaur/misc/lists.cert : acl2x = 0
-centaur/misc/lists.cert : no_pcert = 0
-
-centaur/misc/lists.cert : \
-     centaur/misc/arith-equivs.cert \
-     std/lists/equiv.cert \
-     data-structures/list-defthms.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/misc/lists.lisp
-
-
-centaur/misc/load-stobj-tests.cert : acl2x = 0
-centaur/misc/load-stobj-tests.cert : no_pcert = 0
-
-centaur/misc/load-stobj-tests.cert : \
-     centaur/misc/load-stobj.cert \
-     tools/defconsts.cert \
-     misc/assert.cert \
-     centaur/misc/load-stobj-tests.lisp
-
-
-centaur/misc/load-stobj.cert : acl2x = 0
-centaur/misc/load-stobj.cert : no_pcert = 0
-
-centaur/misc/load-stobj.cert : \
-     std/lists/list-fix.cert \
-     arithmetic/top.cert \
-     data-structures/list-defthms.cert \
-     centaur/misc/equal-by-nths.cert \
-     tools/do-not.cert \
-     centaur/misc/load-stobj.lisp
-
-
-centaur/misc/memory-mgmt-logic.cert : acl2x = 0
-centaur/misc/memory-mgmt-logic.cert : no_pcert = 0
-
-centaur/misc/memory-mgmt-logic.cert : \
-     centaur/misc/memory-mgmt-logic.lisp
-
-
-centaur/misc/memory-mgmt-raw.cert : acl2x = 0
-centaur/misc/memory-mgmt-raw.cert : no_pcert = 0
-
-centaur/misc/memory-mgmt-raw.cert : \
-     centaur/misc/memory-mgmt-logic.cert \
-     tools/include-raw.cert \
-     centaur/misc/memory-mgmt-raw.lisp \
-     centaur/misc/hons-analyze-memory-raw.lsp
-
-
-centaur/misc/mfc-utils.cert : acl2x = 0
-centaur/misc/mfc-utils.cert : no_pcert = 0
-
-centaur/misc/mfc-utils.cert : \
-     std/lists/mfc-utils.cert \
-     centaur/misc/mfc-utils.lisp
-
-
-centaur/misc/nat-list-duplicates.cert : acl2x = 0
-centaur/misc/nat-list-duplicates.cert : no_pcert = 0
-
-centaur/misc/nat-list-duplicates.cert : \
-     xdoc/top.cert \
-     misc/hons-help.cert \
-     tools/bstar.cert \
-     arithmetic/nat-listp.cert \
-     arithmetic/top-with-meta.cert \
-     tools/mv-nth.cert \
-     centaur/misc/alist-equiv.cert \
-     centaur/misc/nat-list-duplicates.lisp
-
-
-centaur/misc/numlist.cert : acl2x = 0
-centaur/misc/numlist.cert : no_pcert = 0
-
-centaur/misc/numlist.cert : \
-     centaur/misc/numlist.lisp
-
-
-centaur/misc/osets-witnessing.cert : acl2x = 0
-centaur/misc/osets-witnessing.cert : no_pcert = 0
-
-centaur/misc/osets-witnessing.cert : \
-     finite-set-theory/osets/sets.cert \
-     centaur/misc/witness-cp.cert \
-     tools/rulesets.cert \
-     finite-set-theory/osets/portcullis.cert \
-     centaur/misc/osets-witnessing.lisp \
-     centaur/misc/osets-witnessing.acl2
-
-
-centaur/misc/patterns.cert : acl2x = 0
-centaur/misc/patterns.cert : no_pcert = 0
-
-centaur/misc/patterns.cert : \
-     centaur/misc/alist-equiv.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/misc/patterns.lisp
-
-
-centaur/misc/seed-random.cert : acl2x = 0
-centaur/misc/seed-random.cert : no_pcert = 0
-
-centaur/misc/seed-random.cert : \
-     tools/defconsts.cert \
-     tools/bstar.cert \
-     misc/assert.cert \
-     centaur/misc/seed-random.lisp
-
-
-centaur/misc/smm-impl.cert : acl2x = 0
-centaur/misc/smm-impl.cert : no_pcert = 0
-
-centaur/misc/smm-impl.cert : \
-     tools/bstar.cert \
-     centaur/misc/u32-listp.cert \
-     xdoc/base.cert \
-     arithmetic/nat-listp.cert \
-     arithmetic/top-with-meta.cert \
-     centaur/misc/arith-equivs.cert \
-     centaur/misc/absstobjs.cert \
-     tools/mv-nth.cert \
-     centaur/misc/lists.cert \
-     misc/definline.cert \
-     centaur/misc/smm-impl.lisp
-
-
-centaur/misc/smm.cert : acl2x = 0
-centaur/misc/smm.cert : no_pcert = 0
-
-centaur/misc/smm.cert : \
-     centaur/misc/smm-impl.cert \
-     tools/bstar.cert \
-     xdoc/base.cert \
-     misc/definline.cert \
-     centaur/misc/arith-equivs.cert \
-     centaur/misc/u32-listp.cert \
-     centaur/misc/smm.lisp
-
-
-centaur/misc/sneaky-load.cert : acl2x = 0
-centaur/misc/sneaky-load.cert : no_pcert = 0
-
-centaur/misc/sneaky-load.cert : \
-     tools/bstar.cert \
-     centaur/misc/sneaky-load.lisp
-
-
-centaur/misc/suffixp.cert : acl2x = 0
-centaur/misc/suffixp.cert : no_pcert = 0
-
-centaur/misc/suffixp.cert : \
-     centaur/misc/suffixp.lisp
-
-
-centaur/misc/tailrec.cert : acl2x = 0
-centaur/misc/tailrec.cert : no_pcert = 0
-
-centaur/misc/tailrec.cert : \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     clause-processors/use-by-hint.cert \
-     clause-processors/generalize.cert \
-     std/lists/take.cert \
-     arithmetic/top.cert \
-     centaur/misc/tailrec.lisp \
-     centaur/misc/tailrec.acl2 \
-     tools/flag-package.lsp
-
-
-centaur/misc/top.cert : acl2x = 0
-centaur/misc/top.cert : no_pcert = 0
-
-centaur/misc/top.cert : \
-     centaur/misc/alist-defs.cert \
-     centaur/misc/alist-equiv.cert \
-     centaur/misc/ap.cert \
-     centaur/misc/defapply.cert \
-     centaur/misc/dfs-measure.cert \
-     centaur/misc/equal-by-nths.cert \
-     centaur/misc/equal-sets.cert \
-     centaur/misc/evaluator-metatheorems.cert \
-     centaur/misc/fal-graphs.cert \
-     centaur/misc/fast-alists.cert \
-     centaur/misc/filter-alist.cert \
-     centaur/misc/hons-alphorder-merge.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/misc/hons-remove-dups.cert \
-     centaur/misc/hons-sets.cert \
-     centaur/misc/interp-function-lookup.cert \
-     centaur/misc/memory-mgmt-logic.cert \
-     centaur/misc/memory-mgmt-raw.cert \
-     centaur/misc/nat-list-duplicates.cert \
-     centaur/misc/numlist.cert \
-     centaur/misc/patterns.cert \
-     centaur/misc/seed-random.cert \
-     centaur/misc/sneaky-load.cert \
-     centaur/misc/suffixp.cert \
-     centaur/misc/tuplep.cert \
-     centaur/misc/universal-equiv.cert \
-     centaur/misc/vecs-ints.cert \
-     centaur/misc/witness-cp.cert \
-     centaur/misc/top.lisp
-
-
-centaur/misc/tshell.cert : acl2x = 0
-centaur/misc/tshell.cert : no_pcert = 0
-
-centaur/misc/tshell.cert : \
-     tools/include-raw.cert \
-     str/strprefixp.cert \
-     centaur/misc/tshell.lisp \
-     centaur/misc/tshell-raw.lsp
-
-
-centaur/misc/tuplep.cert : acl2x = 0
-centaur/misc/tuplep.cert : no_pcert = 0
-
-centaur/misc/tuplep.cert : \
-     centaur/misc/tuplep.lisp
-
-
-centaur/misc/u32-listp.cert : acl2x = 0
-centaur/misc/u32-listp.cert : no_pcert = 0
-
-centaur/misc/u32-listp.cert : \
-     centaur/misc/u32-listp.lisp
-
-
-centaur/misc/universal-equiv.cert : acl2x = 0
-centaur/misc/universal-equiv.cert : no_pcert = 0
-
-centaur/misc/universal-equiv.cert : \
-     clause-processors/equality.cert \
-     centaur/misc/universal-equiv.lisp
-
-
-centaur/misc/vecs-ints.cert : acl2x = 0
-centaur/misc/vecs-ints.cert : no_pcert = 0
-
-centaur/misc/vecs-ints.cert : \
-     ihs/quotient-remainder-lemmas.cert \
-     ihs/math-lemmas.cert \
-     centaur/misc/vecs-ints.lisp
-
-
-centaur/misc/witness-cp.cert : acl2x = 0
-centaur/misc/witness-cp.cert : no_pcert = 0
-
-centaur/misc/witness-cp.cert : \
-     clause-processors/witness-cp.cert \
-     centaur/misc/witness-cp.lisp
-
-
-centaur/ubdds/core.cert : acl2x = 0
-centaur/ubdds/core.cert : no_pcert = 0
-
-centaur/ubdds/core.cert : \
-     misc/definline.cert \
-     centaur/misc/memory-mgmt-logic.cert \
-     misc/computed-hint-rewrite.cert \
-     tools/rulesets.cert \
-     xdoc/top.cert \
-     xdoc/portcullis.cert \
-     centaur/ubdds/core.lisp \
-     centaur/ubdds/cert.acl2
-
-
-centaur/ubdds/extra-operations.cert : acl2x = 0
-centaur/ubdds/extra-operations.cert : no_pcert = 0
-
-centaur/ubdds/extra-operations.cert : \
-     centaur/ubdds/core.cert \
-     xdoc/portcullis.cert \
-     centaur/ubdds/extra-operations.lisp \
-     centaur/ubdds/cert.acl2
-
-
-centaur/ubdds/lite.cert : acl2x = 0
-centaur/ubdds/lite.cert : no_pcert = 0
-
-centaur/ubdds/lite.cert : \
-     centaur/ubdds/witness.cert \
-     centaur/ubdds/subset.cert \
-     misc/untranslate-patterns.cert \
-     xdoc/portcullis.cert \
-     centaur/ubdds/lite.lisp \
-     centaur/ubdds/cert.acl2
-
-
-centaur/ubdds/param.cert : acl2x = 0
-centaur/ubdds/param.cert : no_pcert = 0
-
-centaur/ubdds/param.cert : \
-     centaur/ubdds/extra-operations.cert \
-     misc/hons-help2.cert \
-     tools/rulesets.cert \
-     std/lists/take.cert \
-     arithmetic/top.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top.cert \
-     arithmetic/top-with-meta.cert \
-     xdoc/portcullis.cert \
-     centaur/ubdds/param.lisp \
-     centaur/ubdds/cert.acl2
-
-
-centaur/ubdds/sanity-check-macros.cert : acl2x = 0
-centaur/ubdds/sanity-check-macros.cert : no_pcert = 0
-
-centaur/ubdds/sanity-check-macros.cert : \
-     centaur/ubdds/lite.cert \
-     xdoc/portcullis.cert \
-     centaur/ubdds/sanity-check-macros.lisp \
-     centaur/ubdds/cert.acl2
-
-
-centaur/ubdds/subset.cert : acl2x = 0
-centaur/ubdds/subset.cert : no_pcert = 0
-
-centaur/ubdds/subset.cert : \
-     centaur/ubdds/extra-operations.cert \
-     xdoc/portcullis.cert \
-     centaur/ubdds/subset.lisp \
-     centaur/ubdds/cert.acl2
-
-
-centaur/ubdds/witness.cert : acl2x = 0
-centaur/ubdds/witness.cert : no_pcert = 0
-
-centaur/ubdds/witness.cert : \
-     centaur/ubdds/extra-operations.cert \
-     misc/hons-help2.cert \
-     clause-processors/term-patterns.cert \
-     clause-processors/use-by-hint.cert \
-     tools/mv-nth.cert \
-     clause-processors/generalize.cert \
-     tools/flag.cert \
-     centaur/ubdds/witness.lisp \
-     centaur/ubdds/witness.acl2 \
-     tools/flag-package.lsp
-
-
-centaur/vl/checkers/checkers.cert : acl2x = 0
-centaur/vl/checkers/checkers.cert : no_pcert = 0
-
-centaur/vl/checkers/checkers.cert : \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/checkers.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/condcheck.cert : acl2x = 0
-centaur/vl/checkers/condcheck.cert : no_pcert = 0
-
-centaur/vl/checkers/condcheck.cert : \
-     centaur/vl/mlib/ctxexprs.cert \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/condcheck.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/dupeinst-check.cert : acl2x = 0
-centaur/vl/checkers/dupeinst-check.cert : no_pcert = 0
-
-centaur/vl/checkers/dupeinst-check.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/dupeinst-check.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/duperhs.cert : acl2x = 0
-centaur/vl/checkers/duperhs.cert : no_pcert = 0
-
-centaur/vl/checkers/duperhs.cert : \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/duperhs.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/duplicate-detect.cert : acl2x = 0
-centaur/vl/checkers/duplicate-detect.cert : no_pcert = 0
-
-centaur/vl/checkers/duplicate-detect.cert : \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/duplicate-detect.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/leftright.cert : acl2x = 0
-centaur/vl/checkers/leftright.cert : no_pcert = 0
-
-centaur/vl/checkers/leftright.cert : \
-     centaur/vl/mlib/ctxexprs.cert \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/leftright.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/multidrive-detect.cert : acl2x = 0
-centaur/vl/checkers/multidrive-detect.cert : no_pcert = 0
-
-centaur/vl/checkers/multidrive-detect.cert : \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/mlib/lvalues.cert \
-     centaur/vl/toe/toe-wirealist.cert \
-     centaur/vl/toe/toe-verilogify.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/misc/fal-graphs.cert \
-     centaur/misc/hons-extra.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/multidrive-detect.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/oddexpr.cert : acl2x = 0
-centaur/vl/checkers/oddexpr.cert : no_pcert = 0
-
-centaur/vl/checkers/oddexpr.cert : \
-     centaur/vl/mlib/ctxexprs.cert \
-     centaur/vl/transforms/xf-sizing.cert \
-     centaur/vl/mlib/fmt.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/oddexpr.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/portcheck.cert : acl2x = 0
-centaur/vl/checkers/portcheck.cert : no_pcert = 0
-
-centaur/vl/checkers/portcheck.cert : \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/portcheck.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/qmarksize-check.cert : acl2x = 0
-centaur/vl/checkers/qmarksize-check.cert : no_pcert = 0
-
-centaur/vl/checkers/qmarksize-check.cert : \
-     centaur/vl/mlib/ctxexprs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/qmarksize-check.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/selfassigns.cert : acl2x = 0
-centaur/vl/checkers/selfassigns.cert : no_pcert = 0
-
-centaur/vl/checkers/selfassigns.cert : \
-     centaur/vl/mlib/ctxexprs.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/selfassigns.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/skip-detect.cert : acl2x = 0
-centaur/vl/checkers/skip-detect.cert : no_pcert = 0
-
-centaur/vl/checkers/skip-detect.cert : \
-     centaur/vl/mlib/ctxexprs.cert \
-     centaur/vl/mlib/print-context.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/skip-detect.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/typo-detect.cert : acl2x = 0
-centaur/vl/checkers/typo-detect.cert : no_pcert = 0
-
-centaur/vl/checkers/typo-detect.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/string-alists.cert \
-     centaur/vl/util/character-list-listp.cert \
-     centaur/vl/loader/lexer-utils.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/typo-detect.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/use-set-report.cert : acl2x = 0
-centaur/vl/checkers/use-set-report.cert : no_pcert = 0
-
-centaur/vl/checkers/use-set-report.cert : \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/mlib/print-warnings.cert \
-     centaur/vl/util/string-alists.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/use-set-report.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/use-set-tool.cert : acl2x = 0
-centaur/vl/checkers/use-set-tool.cert : no_pcert = 0
-
-centaur/vl/checkers/use-set-tool.cert : \
-     centaur/vl/checkers/use-set.cert \
-     centaur/vl/loader/loader.cert \
-     centaur/vl/transforms/xf-argresolve.cert \
-     centaur/vl/transforms/xf-portdecl-sign.cert \
-     centaur/vl/transforms/cn-hooks.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/mlib/modname-sets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/use-set-tool.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/checkers/use-set.cert : acl2x = 0
-centaur/vl/checkers/use-set.cert : no_pcert = 0
-
-centaur/vl/checkers/use-set.cert : \
-     centaur/vl/checkers/typo-detect.cert \
-     centaur/vl/checkers/use-set-report.cert \
-     centaur/vl/mlib/warnings.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/checkers/use-set.lisp \
-     centaur/vl/checkers/cert.acl2
-
-
-centaur/vl/lint/bit-use-set.cert : acl2x = 0
-centaur/vl/lint/bit-use-set.cert : no_pcert = 0
-
-centaur/vl/lint/bit-use-set.cert : \
-     centaur/vl/toe/toe-preliminary.cert \
-     centaur/vl/wf-reasonable-p.cert \
-     centaur/vl/lint/disconnected.cert \
-     centaur/vl/mlib/hierarchy.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/lvalues.cert \
-     centaur/vl/mlib/warnings.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/lint/use-set-ignore.cert \
-     centaur/bitops/bitsets.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/bit-use-set.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/check-case.cert : acl2x = 0
-centaur/vl/lint/check-case.cert : no_pcert = 0
-
-centaur/vl/lint/check-case.cert : \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/check-case.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/check-namespace.cert : acl2x = 0
-centaur/vl/lint/check-namespace.cert : no_pcert = 0
-
-centaur/vl/lint/check-namespace.cert : \
-     centaur/vl/wf-reasonable-p.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/check-namespace.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/disconnected.cert : acl2x = 0
-centaur/vl/lint/disconnected.cert : no_pcert = 0
-
-centaur/vl/lint/disconnected.cert : \
-     centaur/vl/toe/toe-wirealist.cert \
-     centaur/vl/toe/toe-verilogify.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/fmt.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/disconnected.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/lint.cert : acl2x = 0
-centaur/vl/lint/lint.cert : no_pcert = 0
-
-centaur/vl/lint/lint.cert : \
-     centaur/vl/lint/bit-use-set.cert \
-     centaur/vl/lint/check-case.cert \
-     centaur/vl/lint/check-namespace.cert \
-     centaur/vl/lint/disconnected.cert \
-     centaur/vl/lint/xf-drop-missing-submodules.cert \
-     centaur/vl/lint/xf-lint-stmt-rewrite.cert \
-     centaur/vl/lint/xf-remove-toohard.cert \
-     centaur/vl/lint/xf-undefined-names.cert \
-     centaur/vl/lint/xf-suppress-warnings.cert \
-     centaur/vl/checkers/condcheck.cert \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/checkers/dupeinst-check.cert \
-     centaur/vl/checkers/duperhs.cert \
-     centaur/vl/checkers/leftright.cert \
-     centaur/vl/checkers/multidrive-detect.cert \
-     centaur/vl/checkers/oddexpr.cert \
-     centaur/vl/checkers/portcheck.cert \
-     centaur/vl/checkers/qmarksize-check.cert \
-     centaur/vl/checkers/selfassigns.cert \
-     centaur/vl/checkers/skip-detect.cert \
-     centaur/vl/loader/loader.cert \
-     centaur/vl/transforms/cn-hooks.cert \
-     centaur/vl/transforms/xf-argresolve.cert \
-     centaur/vl/transforms/xf-array-indexing.cert \
-     centaur/vl/transforms/xf-assign-trunc.cert \
-     centaur/vl/transforms/xf-blankargs.cert \
-     centaur/vl/transforms/xf-clean-params.cert \
-     centaur/vl/transforms/xf-drop-blankports.cert \
-     centaur/vl/transforms/xf-expr-split.cert \
-     centaur/vl/transforms/xf-expand-functions.cert \
-     centaur/vl/transforms/xf-follow-hids.cert \
-     centaur/vl/transforms/xf-hid-elim.cert \
-     centaur/vl/transforms/xf-orig.cert \
-     centaur/vl/transforms/xf-oprewrite.cert \
-     centaur/vl/transforms/xf-portdecl-sign.cert \
-     centaur/vl/transforms/xf-resolve-ranges.cert \
-     centaur/vl/transforms/xf-replicate-insts.cert \
-     centaur/vl/transforms/xf-sizing.cert \
-     centaur/vl/transforms/xf-unparameterize.cert \
-     centaur/vl/transforms/xf-unused-reg.cert \
-     centaur/vl/mlib/modname-sets.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/lint.lisp \
-     centaur/vl/lint/lint.acl2
-
-
-centaur/vl/lint/use-set-ignore.cert : acl2x = 0
-centaur/vl/lint/use-set-ignore.cert : no_pcert = 0
-
-centaur/vl/lint/use-set-ignore.cert : \
-     centaur/vl/loader/parse-lvalues.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/mlib/fmt.cert \
-     centaur/vl/checkers/oddexpr.cert \
-     centaur/vl/toe/toe-wirealist.cert \
-     centaur/vl/transforms/xf-sizing.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/use-set-ignore.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/xf-drop-missing-submodules.cert : acl2x = 0
-centaur/vl/lint/xf-drop-missing-submodules.cert : no_pcert = 0
-
-centaur/vl/lint/xf-drop-missing-submodules.cert : \
-     centaur/vl/mlib/filter.cert \
-     centaur/vl/mlib/hierarchy.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/xf-drop-missing-submodules.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/xf-drop-unresolved-submodules.cert : acl2x = 0
-centaur/vl/lint/xf-drop-unresolved-submodules.cert : no_pcert = 0
-
-centaur/vl/lint/xf-drop-unresolved-submodules.cert : \
-     centaur/vl/mlib/filter.cert \
-     centaur/vl/mlib/hierarchy.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/xf-drop-unresolved-submodules.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/xf-lint-stmt-rewrite.cert : acl2x = 0
-centaur/vl/lint/xf-lint-stmt-rewrite.cert : no_pcert = 0
-
-centaur/vl/lint/xf-lint-stmt-rewrite.cert : \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/xf-lint-stmt-rewrite.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/xf-remove-toohard.cert : acl2x = 0
-centaur/vl/lint/xf-remove-toohard.cert : no_pcert = 0
-
-centaur/vl/lint/xf-remove-toohard.cert : \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/xf-remove-toohard.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/xf-suppress-warnings.cert : acl2x = 0
-centaur/vl/lint/xf-suppress-warnings.cert : no_pcert = 0
-
-centaur/vl/lint/xf-suppress-warnings.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/xf-suppress-warnings.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/lint/xf-undefined-names.cert : acl2x = 0
-centaur/vl/lint/xf-undefined-names.cert : no_pcert = 0
-
-centaur/vl/lint/xf-undefined-names.cert : \
-     centaur/vl/portcullis.cert \
-     centaur/vl/lint/xf-undefined-names.lisp \
-     centaur/vl/lint/cert.acl2
-
-
-centaur/vl/loader/defines.cert : acl2x = 0
-centaur/vl/loader/defines.cert : no_pcert = 0
-
-centaur/vl/loader/defines.cert : \
-     centaur/vl/util/echars.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/defines.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/filemap.cert : acl2x = 0
-centaur/vl/loader/filemap.cert : no_pcert = 0
-
-centaur/vl/loader/filemap.cert : \
-     centaur/vl/util/echars.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/filemap.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/find-file.cert : acl2x = 0
-centaur/vl/loader/find-file.cert : no_pcert = 0
-
-centaur/vl/loader/find-file.cert : \
-     centaur/vl/util/warnings.cert \
-     std/io/open-input-channel.cert \
-     std/io/close-input-channel.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/find-file.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/inject-comments.cert : acl2x = 0
-centaur/vl/loader/inject-comments.cert : no_pcert = 0
-
-centaur/vl/loader/inject-comments.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/inject-comments.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/lexer-tests.cert : acl2x = 0
-centaur/vl/loader/lexer-tests.cert : no_pcert = 0
-
-centaur/vl/loader/lexer-tests.cert : \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/lexer-tests.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/lexer-tokens.cert : acl2x = 0
-centaur/vl/loader/lexer-tokens.cert : no_pcert = 0
-
-centaur/vl/loader/lexer-tokens.cert : \
-     centaur/vl/util/bits.cert \
-     centaur/vl/util/echars.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/lexer-tokens.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/lexer-utils.cert : acl2x = 0
-centaur/vl/loader/lexer-utils.cert : no_pcert = 0
-
-centaur/vl/loader/lexer-utils.cert : \
-     std/lists/prefixp.cert \
-     centaur/vl/util/echars.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/lexer-utils.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/lexer.cert : acl2x = 0
-centaur/vl/loader/lexer.cert : no_pcert = 0
-
-centaur/vl/loader/lexer.cert : \
-     centaur/vl/loader/lexer-tokens.cert \
-     centaur/vl/loader/lexer-utils.cert \
-     centaur/vl/util/warnings.cert \
-     centaur/vl/util/commentmap.cert \
-     centaur/vl/util/arithmetic.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/lexer.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/loader.cert : acl2x = 0
-centaur/vl/loader/loader.cert : no_pcert = 0
-
-centaur/vl/loader/loader.cert : \
-     centaur/vl/loader/read-file.cert \
-     centaur/vl/loader/find-file.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/loader/preprocessor.cert \
-     centaur/vl/loader/parser.cert \
-     centaur/vl/loader/filemap.cert \
-     centaur/vl/loader/inject-comments.cert \
-     centaur/vl/loader/overrides.cert \
-     centaur/vl/mlib/hierarchy.cert \
-     centaur/vl/mlib/print-warnings.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/util/gc.cert \
-     centaur/misc/hons-extra.cert \
-     defsort/duplicated-members.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/loader.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/make-implicit-wires.cert : acl2x = 0
-centaur/vl/loader/make-implicit-wires.cert : no_pcert = 0
-
-centaur/vl/loader/make-implicit-wires.cert : \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/make-implicit-wires.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/overrides.cert : acl2x = 0
-centaur/vl/loader/overrides.cert : no_pcert = 0
-
-centaur/vl/loader/overrides.cert : \
-     centaur/vl/loader/read-file.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/loader/preprocessor.cert \
-     centaur/vl/loader/parse-utils.cert \
-     centaur/vl/loader/parse-error.cert \
-     centaur/vl/loader/filemap.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/mlib/warnings.cert \
-     oslib/ls.cert \
-     str/top.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/overrides.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-blockitems.cert : acl2x = 0
-centaur/vl/loader/parse-blockitems.cert : no_pcert = 0
-
-centaur/vl/loader/parse-blockitems.cert : \
-     centaur/vl/loader/parse-ranges.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-blockitems.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-delays.cert : acl2x = 0
-centaur/vl/loader/parse-delays.cert : no_pcert = 0
-
-centaur/vl/loader/parse-delays.cert : \
-     centaur/vl/loader/parse-expressions.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-delays.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-error.cert : acl2x = 0
-centaur/vl/loader/parse-error.cert : no_pcert = 0
-
-centaur/vl/loader/parse-error.cert : \
-     centaur/vl/loader/lexer-tokens.cert \
-     centaur/vl/mlib/fmt.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-error.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-eventctrl.cert : acl2x = 0
-centaur/vl/loader/parse-eventctrl.cert : no_pcert = 0
-
-centaur/vl/loader/parse-eventctrl.cert : \
-     centaur/vl/loader/parse-delays.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-eventctrl.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-expressions-def.cert : acl2x = 0
-centaur/vl/loader/parse-expressions-def.cert : no_pcert = 0
-
-centaur/vl/loader/parse-expressions-def.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/loader/parse-utils.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-expressions-def.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-expressions-eof.cert : acl2x = 0
-centaur/vl/loader/parse-expressions-eof.cert : no_pcert = 0
-
-centaur/vl/loader/parse-expressions-eof.cert : \
-     centaur/vl/loader/parse-expressions-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-expressions-eof.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-expressions-error.cert : acl2x = 0
-centaur/vl/loader/parse-expressions-error.cert : no_pcert = 0
-
-centaur/vl/loader/parse-expressions-error.cert : \
-     centaur/vl/loader/parse-expressions-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-expressions-error.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-expressions-progress.cert : acl2x = 0
-centaur/vl/loader/parse-expressions-progress.cert : no_pcert = 0
-
-centaur/vl/loader/parse-expressions-progress.cert : \
-     centaur/vl/loader/parse-expressions-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-expressions-progress.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-expressions-result.cert : acl2x = 0
-centaur/vl/loader/parse-expressions-result.cert : no_pcert = 0
-
-centaur/vl/loader/parse-expressions-result.cert : \
-     centaur/vl/loader/parse-expressions-def.cert \
-     centaur/vl/loader/parse-expressions-tokenlist.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-expressions-result.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-expressions-tokenlist.cert : acl2x = 0
-centaur/vl/loader/parse-expressions-tokenlist.cert : no_pcert = 0
-
-centaur/vl/loader/parse-expressions-tokenlist.cert : \
-     centaur/vl/loader/parse-expressions-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-expressions-tokenlist.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-expressions-warnings.cert : acl2x = 0
-centaur/vl/loader/parse-expressions-warnings.cert : no_pcert = 0
-
-centaur/vl/loader/parse-expressions-warnings.cert : \
-     centaur/vl/loader/parse-expressions-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-expressions-warnings.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-expressions.cert : acl2x = 0
-centaur/vl/loader/parse-expressions.cert : no_pcert = 0
-
-centaur/vl/loader/parse-expressions.cert : \
-     centaur/vl/loader/parse-expressions-def.cert \
-     centaur/vl/loader/parse-expressions-error.cert \
-     centaur/vl/loader/parse-expressions-tokenlist.cert \
-     centaur/vl/loader/parse-expressions-warnings.cert \
-     centaur/vl/loader/parse-expressions-progress.cert \
-     centaur/vl/loader/parse-expressions-eof.cert \
-     centaur/vl/loader/parse-expressions-result.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-expressions.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-functions.cert : acl2x = 0
-centaur/vl/loader/parse-functions.cert : no_pcert = 0
-
-centaur/vl/loader/parse-functions.cert : \
-     centaur/vl/loader/parse-blockitems.cert \
-     centaur/vl/loader/parse-ports.cert \
-     centaur/vl/loader/parse-statements.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-functions.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-gates.cert : acl2x = 0
-centaur/vl/loader/parse-gates.cert : no_pcert = 0
-
-centaur/vl/loader/parse-gates.cert : \
-     centaur/vl/loader/parse-strengths.cert \
-     centaur/vl/loader/parse-delays.cert \
-     centaur/vl/loader/parse-ranges.cert \
-     centaur/vl/loader/parse-lvalues.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-gates.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-insts.cert : acl2x = 0
-centaur/vl/loader/parse-insts.cert : no_pcert = 0
-
-centaur/vl/loader/parse-insts.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/loader/parse-ranges.cert \
-     centaur/vl/loader/parse-lvalues.cert \
-     centaur/vl/loader/parse-delays.cert \
-     centaur/vl/loader/parse-strengths.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-insts.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-lvalues.cert : acl2x = 0
-centaur/vl/loader/parse-lvalues.cert : no_pcert = 0
-
-centaur/vl/loader/parse-lvalues.cert : \
-     centaur/vl/loader/parse-expressions.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-lvalues.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-modules.cert : acl2x = 0
-centaur/vl/loader/parse-modules.cert : no_pcert = 0
-
-centaur/vl/loader/parse-modules.cert : \
-     centaur/vl/loader/parse-statements.cert \
-     centaur/vl/loader/parse-ports.cert \
-     centaur/vl/loader/parse-nets.cert \
-     centaur/vl/loader/parse-blockitems.cert \
-     centaur/vl/loader/parse-insts.cert \
-     centaur/vl/loader/parse-gates.cert \
-     centaur/vl/loader/parse-functions.cert \
-     centaur/vl/loader/make-implicit-wires.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/port-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-modules.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-nets.cert : acl2x = 0
-centaur/vl/loader/parse-nets.cert : no_pcert = 0
-
-centaur/vl/loader/parse-nets.cert : \
-     centaur/vl/loader/parse-ranges.cert \
-     centaur/vl/loader/parse-lvalues.cert \
-     centaur/vl/loader/parse-delays.cert \
-     centaur/vl/loader/parse-strengths.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-nets.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-ports.cert : acl2x = 0
-centaur/vl/loader/parse-ports.cert : no_pcert = 0
-
-centaur/vl/loader/parse-ports.cert : \
-     centaur/vl/loader/parse-nets.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-ports.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-ranges.cert : acl2x = 0
-centaur/vl/loader/parse-ranges.cert : no_pcert = 0
-
-centaur/vl/loader/parse-ranges.cert : \
-     centaur/vl/loader/parse-expressions.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-ranges.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-statements-def.cert : acl2x = 0
-centaur/vl/loader/parse-statements-def.cert : no_pcert = 0
-
-centaur/vl/loader/parse-statements-def.cert : \
-     centaur/vl/loader/parse-eventctrl.cert \
-     centaur/vl/loader/parse-blockitems.cert \
-     centaur/vl/loader/parse-lvalues.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-statements-def.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-statements-error.cert : acl2x = 0
-centaur/vl/loader/parse-statements-error.cert : no_pcert = 0
-
-centaur/vl/loader/parse-statements-error.cert : \
-     centaur/vl/loader/parse-statements-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-statements-error.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-statements-progress.cert : acl2x = 0
-centaur/vl/loader/parse-statements-progress.cert : no_pcert = 0
-
-centaur/vl/loader/parse-statements-progress.cert : \
-     centaur/vl/loader/parse-statements-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-statements-progress.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-statements-result.cert : acl2x = 0
-centaur/vl/loader/parse-statements-result.cert : no_pcert = 0
-
-centaur/vl/loader/parse-statements-result.cert : \
-     centaur/vl/loader/parse-statements-def.cert \
-     centaur/vl/loader/parse-statements-tokenlist.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-statements-result.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-statements-tokenlist.cert : acl2x = 0
-centaur/vl/loader/parse-statements-tokenlist.cert : no_pcert = 0
-
-centaur/vl/loader/parse-statements-tokenlist.cert : \
-     centaur/vl/loader/parse-statements-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-statements-tokenlist.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-statements-warninglist.cert : acl2x = 0
-centaur/vl/loader/parse-statements-warninglist.cert : no_pcert = 0
-
-centaur/vl/loader/parse-statements-warninglist.cert : \
-     centaur/vl/loader/parse-statements-def.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-statements-warninglist.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-statements.cert : acl2x = 0
-centaur/vl/loader/parse-statements.cert : no_pcert = 0
-
-centaur/vl/loader/parse-statements.cert : \
-     centaur/vl/loader/parse-statements-def.cert \
-     centaur/vl/loader/parse-statements-error.cert \
-     centaur/vl/loader/parse-statements-progress.cert \
-     centaur/vl/loader/parse-statements-tokenlist.cert \
-     centaur/vl/loader/parse-statements-warninglist.cert \
-     centaur/vl/loader/parse-statements-result.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-statements.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-strengths.cert : acl2x = 0
-centaur/vl/loader/parse-strengths.cert : no_pcert = 0
-
-centaur/vl/loader/parse-strengths.cert : \
-     centaur/vl/loader/parse-utils.cert \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-strengths.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parse-utils.cert : acl2x = 0
-centaur/vl/loader/parse-utils.cert : no_pcert = 0
-
-centaur/vl/loader/parse-utils.cert : \
-     centaur/vl/loader/lexer-tokens.cert \
-     misc/seqw.cert \
-     misc/untranslate-patterns.cert \
-     tools/flag.cert \
-     centaur/vl/util/warnings.cert \
-     tools/rulesets.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parse-utils.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/parser.cert : acl2x = 0
-centaur/vl/loader/parser.cert : no_pcert = 0
-
-centaur/vl/loader/parser.cert : \
-     centaur/vl/loader/parse-modules.cert \
-     centaur/vl/loader/parse-error.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/parser.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/preprocessor-tests.cert : acl2x = 0
-centaur/vl/loader/preprocessor-tests.cert : no_pcert = 0
-
-centaur/vl/loader/preprocessor-tests.cert : \
-     centaur/vl/loader/preprocessor.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/preprocessor-tests.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/preprocessor.cert : acl2x = 0
-centaur/vl/loader/preprocessor.cert : no_pcert = 0
-
-centaur/vl/loader/preprocessor.cert : \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/loader/read-file.cert \
-     centaur/vl/loader/find-file.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/loader/defines.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/preprocessor.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/loader/read-file.cert : acl2x = 0
-centaur/vl/loader/read-file.cert : no_pcert = 0
-
-centaur/vl/loader/read-file.cert : \
-     centaur/vl/util/echars.cert \
-     std/io/file-measure.cert \
-     std/io/open-input-channel.cert \
-     std/io/read-byte.cert \
-     std/io/close-input-channel.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/loader/read-file.lisp \
-     centaur/vl/loader/cert.acl2
-
-
-centaur/vl/mlib/allexprs.cert : acl2x = 0
-centaur/vl/mlib/allexprs.cert : no_pcert = 0
-
-centaur/vl/mlib/allexprs.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/allexprs.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/atts.cert : acl2x = 0
-centaur/vl/mlib/atts.cert : no_pcert = 0
-
-centaur/vl/mlib/atts.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/atts.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/clean-concats.cert : acl2x = 0
-centaur/vl/mlib/clean-concats.cert : no_pcert = 0
-
-centaur/vl/mlib/clean-concats.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/clean-concats.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/comment-writer.cert : acl2x = 0
-centaur/vl/mlib/comment-writer.cert : no_pcert = 0
-
-centaur/vl/mlib/comment-writer.cert : \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/loader/inject-comments.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/comment-writer.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/context.cert : acl2x = 0
-centaur/vl/mlib/context.cert : no_pcert = 0
-
-centaur/vl/mlib/context.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/context.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/ctxexprs.cert : acl2x = 0
-centaur/vl/mlib/ctxexprs.cert : no_pcert = 0
-
-centaur/vl/mlib/ctxexprs.cert : \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/ctxexprs.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/delta.cert : acl2x = 0
-centaur/vl/mlib/delta.cert : no_pcert = 0
-
-centaur/vl/mlib/delta.cert : \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/delta.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/expr-building.cert : acl2x = 0
-centaur/vl/mlib/expr-building.cert : no_pcert = 0
-
-centaur/vl/mlib/expr-building.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/expr-building.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/expr-parse.cert : acl2x = 0
-centaur/vl/mlib/expr-parse.cert : no_pcert = 0
-
-centaur/vl/mlib/expr-parse.cert : \
-     centaur/vl/mlib/print-warnings.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/loader/parse-expressions.cert \
-     centaur/vl/loader/parse-error.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/expr-parse.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/expr-slice.cert : acl2x = 0
-centaur/vl/mlib/expr-slice.cert : no_pcert = 0
-
-centaur/vl/mlib/expr-slice.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/mlib/welltyped.cert \
-     centaur/vl/mlib/expr-building.cert \
-     centaur/vl/util/arithmetic.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/expr-slice.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/expr-tools.cert : acl2x = 0
-centaur/vl/mlib/expr-tools.cert : no_pcert = 0
-
-centaur/vl/mlib/expr-tools.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/expr-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/filter.cert : acl2x = 0
-centaur/vl/mlib/filter.cert : no_pcert = 0
-
-centaur/vl/mlib/filter.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/filter.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/find-item.cert : acl2x = 0
-centaur/vl/mlib/find-item.cert : no_pcert = 0
-
-centaur/vl/mlib/find-item.cert : \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/find-item.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/find-module.cert : acl2x = 0
-centaur/vl/mlib/find-module.cert : no_pcert = 0
-
-centaur/vl/mlib/find-module.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/find-module.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/fmt.cert : acl2x = 0
-centaur/vl/mlib/fmt.cert : no_pcert = 0
-
-centaur/vl/mlib/fmt.cert : \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/print-context.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/fmt.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/hid-tools.cert : acl2x = 0
-centaur/vl/mlib/hid-tools.cert : no_pcert = 0
-
-centaur/vl/mlib/hid-tools.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/hid-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/hierarchy.cert : acl2x = 0
-centaur/vl/mlib/hierarchy.cert : no_pcert = 0
-
-centaur/vl/mlib/hierarchy.cert : \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/mlib/filter.cert \
-     centaur/vl/util/string-alists.cert \
-     centaur/vl/util/defwellformed.cert \
-     centaur/vl/mlib/modname-sets.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/misc/osets-witnessing.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/hierarchy.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/lvalues-mentioning.cert : acl2x = 0
-centaur/vl/mlib/lvalues-mentioning.cert : no_pcert = 0
-
-centaur/vl/mlib/lvalues-mentioning.cert : \
-     centaur/vl/mlib/lvalues.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/lvalues-mentioning.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/lvalues.cert : acl2x = 0
-centaur/vl/mlib/lvalues.cert : no_pcert = 0
-
-centaur/vl/mlib/lvalues.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/hid-tools.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/lvalues.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/modname-sets.cert : acl2x = 0
-centaur/vl/mlib/modname-sets.cert : no_pcert = 0
-
-centaur/vl/mlib/modname-sets.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/modname-sets.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/modnamespace.cert : acl2x = 0
-centaur/vl/mlib/modnamespace.cert : no_pcert = 0
-
-centaur/vl/mlib/modnamespace.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/modnamespace.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/namefactory.cert : acl2x = 0
-centaur/vl/mlib/namefactory.cert : no_pcert = 0
-
-centaur/vl/mlib/namefactory.cert : \
-     centaur/vl/util/namedb.cert \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/namefactory.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/namemangle.cert : acl2x = 0
-centaur/vl/mlib/namemangle.cert : no_pcert = 0
-
-centaur/vl/mlib/namemangle.cert : \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/namemangle.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/port-tools.cert : acl2x = 0
-centaur/vl/mlib/port-tools.cert : no_pcert = 0
-
-centaur/vl/mlib/port-tools.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/port-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/print-context.cert : acl2x = 0
-centaur/vl/mlib/print-context.cert : no_pcert = 0
-
-centaur/vl/mlib/print-context.cert : \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/print-context.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/print-warnings.cert : acl2x = 0
-centaur/vl/mlib/print-warnings.cert : no_pcert = 0
-
-centaur/vl/mlib/print-warnings.cert : \
-     centaur/vl/mlib/warnings.cert \
-     centaur/vl/mlib/fmt.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/print-warnings.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/range-tools.cert : acl2x = 0
-centaur/vl/mlib/range-tools.cert : no_pcert = 0
-
-centaur/vl/mlib/range-tools.cert : \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/range-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/relocate.cert : acl2x = 0
-centaur/vl/mlib/relocate.cert : no_pcert = 0
-
-centaur/vl/mlib/relocate.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/relocate.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/remove-bad.cert : acl2x = 0
-centaur/vl/mlib/remove-bad.cert : no_pcert = 0
-
-centaur/vl/mlib/remove-bad.cert : \
-     centaur/vl/mlib/hierarchy.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/mlib/modname-sets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/remove-bad.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/rvalues.cert : acl2x = 0
-centaur/vl/mlib/rvalues.cert : no_pcert = 0
-
-centaur/vl/mlib/rvalues.cert : \
-     centaur/vl/mlib/hid-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/rvalues.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/stmt-tools.cert : acl2x = 0
-centaur/vl/mlib/stmt-tools.cert : no_pcert = 0
-
-centaur/vl/mlib/stmt-tools.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/stmt-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/sub-counts.cert : acl2x = 0
-centaur/vl/mlib/sub-counts.cert : no_pcert = 0
-
-centaur/vl/mlib/sub-counts.cert : \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/transforms/xf-resolve-ranges.cert \
-     centaur/vl/transforms/xf-subst.cert \
-     centaur/vl/transforms/xf-unparameterize.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/sub-counts.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/warnings.cert : acl2x = 0
-centaur/vl/mlib/warnings.cert : no_pcert = 0
-
-centaur/vl/mlib/warnings.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/warnings.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/welltyped.cert : acl2x = 0
-centaur/vl/mlib/welltyped.cert : no_pcert = 0
-
-centaur/vl/mlib/welltyped.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/sum-nats.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/welltyped.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/mlib/writer.cert : acl2x = 0
-centaur/vl/mlib/writer.cert : no_pcert = 0
-
-centaur/vl/mlib/writer.cert : \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/loader/lexer.cert \
-     centaur/vl/util/print.cert \
-     str/strrpos.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/mlib/writer.lisp \
-     centaur/vl/mlib/cert.acl2
-
-
-centaur/vl/onehot.cert : acl2x = 0
-centaur/vl/onehot.cert : no_pcert = 0
-
-centaur/vl/onehot.cert : \
-     centaur/vl/transforms/occform/simple.cert \
-     centaur/vl/util/arithmetic.cert \
-     arithmetic-5/top.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/onehot.lisp \
-     centaur/vl/cert.acl2
-
-
-centaur/vl/parsetree.cert : acl2x = 0
-centaur/vl/parsetree.cert : no_pcert = 0
-
-centaur/vl/parsetree.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/bits.cert \
-     centaur/vl/util/commentmap.cert \
-     centaur/vl/util/warnings.cert \
-     centaur/vl/util/echars.cert \
-     tools/flag.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/parsetree.lisp \
-     centaur/vl/cert.acl2
-
-
-centaur/vl/portcullis.cert : acl2x = 0
-centaur/vl/portcullis.cert : no_pcert = 0
-
-centaur/vl/portcullis.cert : \
-     tools/safe-case.cert \
-     xdoc/top.cert \
-     clause-processors/autohide.cert \
-     tools/rulesets.cert \
-     centaur/vl/portcullis.lisp \
-     centaur/vl/portcullis.acl2 \
-     centaur/vl/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     centaur/vl/other-packages.lsp \
-     data-structures/define-u-package.lsp \
-     tools/flag-package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     cowles/packages.lsp
-
-
-centaur/vl/primitives.cert : acl2x = 0
-centaur/vl/primitives.cert : no_pcert = 0
-
-centaur/vl/primitives.cert : \
-     centaur/vl/mlib/expr-building.cert \
-     centaur/esim/esim-primitives.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/primitives.lisp \
-     centaur/vl/cert.acl2
-
-
-centaur/vl/toe/toe-add-res-modules.cert : acl2x = 0
-centaur/vl/toe/toe-add-res-modules.cert : no_pcert = 0
-
-centaur/vl/toe/toe-add-res-modules.cert : \
-     centaur/vl/toe/toe-wirealist.cert \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/esim/esim-primitives.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/esim-lemmas.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/toe/toe-add-res-modules.lisp \
-     centaur/vl/toe/cert.acl2
-
-
-centaur/vl/toe/toe-add-zdrivers.cert : acl2x = 0
-centaur/vl/toe/toe-add-zdrivers.cert : no_pcert = 0
-
-centaur/vl/toe/toe-add-zdrivers.cert : \
-     centaur/vl/toe/toe-wirealist.cert \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/esim/esim-primitives.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/esim-lemmas.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/toe/toe-add-zdrivers.lisp \
-     centaur/vl/toe/cert.acl2
-
-
-centaur/vl/toe/toe-emodwire.cert : acl2x = 0
-centaur/vl/toe/toe-emodwire.cert : no_pcert = 0
-
-centaur/vl/toe/toe-emodwire.cert : \
-     centaur/vl/util/defs.cert \
-     misc/assert.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/position.cert \
-     std/ks/intern-in-package-of-symbol.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/toe/toe-emodwire.lisp \
-     centaur/vl/toe/cert.acl2
-
-
-centaur/vl/toe/toe-eocc-allnames.cert : acl2x = 0
-centaur/vl/toe/toe-eocc-allnames.cert : no_pcert = 0
-
-centaur/vl/toe/toe-eocc-allnames.cert : \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/vl/toe/toe-emodwire.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/esim-lemmas.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/toe/toe-eocc-allnames.lisp \
-     centaur/vl/toe/cert.acl2
-
-
-centaur/vl/toe/toe-preliminary.cert : acl2x = 0
-centaur/vl/toe/toe-preliminary.cert : no_pcert = 0
-
-centaur/vl/toe/toe-preliminary.cert : \
-     centaur/vl/toe/toe-wirealist.cert \
-     centaur/vl/toe/toe-verilogify.cert \
-     centaur/vl/mlib/find-module.cert \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/util/esim-lemmas.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/toe/toe-preliminary.lisp \
-     centaur/vl/toe/cert.acl2
-
-
-centaur/vl/toe/toe-top.cert : acl2x = 0
-centaur/vl/toe/toe-top.cert : no_pcert = 0
-
-centaur/vl/toe/toe-top.cert : \
-     centaur/vl/toe/toe-eocc-allnames.cert \
-     centaur/vl/toe/toe-preliminary.cert \
-     centaur/vl/toe/toe-add-res-modules.cert \
-     centaur/vl/toe/toe-add-zdrivers.cert \
-     centaur/vl/mlib/remove-bad.cert \
-     centaur/vl/mlib/atts.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/esim-lemmas.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/toe/toe-top.lisp \
-     centaur/vl/toe/cert.acl2
-
-
-centaur/vl/toe/toe-verilogify.cert : acl2x = 0
-centaur/vl/toe/toe-verilogify.cert : no_pcert = 0
-
-centaur/vl/toe/toe-verilogify.cert : \
-     centaur/vl/toe/toe-emodwire.cert \
-     misc/assert.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/toe/toe-verilogify.lisp \
-     centaur/vl/toe/cert.acl2
-
-
-centaur/vl/toe/toe-wirealist.cert : acl2x = 0
-centaur/vl/toe/toe-wirealist.cert : no_pcert = 0
-
-centaur/vl/toe/toe-wirealist.cert : \
-     centaur/vl/toe/toe-emodwire.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/intersectp-equal.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/toe/toe-wirealist.lisp \
-     centaur/vl/toe/cert.acl2
-
-
-centaur/vl/top.cert : acl2x = 0
-centaur/vl/top.cert : no_pcert = 0
-
-centaur/vl/top.cert : \
-     centaur/vl/checkers/checkers.cert \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/checkers/multidrive-detect.cert \
-     centaur/vl/checkers/portcheck.cert \
-     centaur/vl/checkers/use-set.cert \
-     centaur/vl/loader/loader.cert \
-     centaur/vl/mlib/comment-writer.cert \
-     centaur/vl/toe/toe-top.cert \
-     centaur/vl/transforms/cn-hooks.cert \
-     centaur/vl/transforms/always/top.cert \
-     centaur/vl/transforms/occform/top.cert \
-     centaur/vl/transforms/xf-addinstnames.cert \
-     centaur/vl/transforms/xf-argresolve.cert \
-     centaur/vl/transforms/xf-assign-trunc.cert \
-     centaur/vl/transforms/xf-blankargs.cert \
-     centaur/vl/transforms/xf-clean-params.cert \
-     centaur/vl/transforms/xf-designregs.cert \
-     centaur/vl/transforms/xf-designwires.cert \
-     centaur/vl/transforms/xf-delayredux.cert \
-     centaur/vl/transforms/xf-drop-blankports.cert \
-     centaur/vl/transforms/xf-elim-supply.cert \
-     centaur/vl/transforms/xf-expand-functions.cert \
-     centaur/vl/transforms/xf-expr-split.cert \
-     centaur/vl/transforms/xf-follow-hids.cert \
-     centaur/vl/transforms/xf-gateredux.cert \
-     centaur/vl/transforms/xf-gatesplit.cert \
-     centaur/vl/transforms/xf-gate-elim.cert \
-     centaur/vl/transforms/xf-hid-elim.cert \
-     centaur/vl/transforms/xf-oprewrite.cert \
-     centaur/vl/transforms/xf-optimize-rw.cert \
-     centaur/vl/transforms/xf-orig.cert \
-     centaur/vl/transforms/xf-portdecl-sign.cert \
-     centaur/vl/transforms/xf-replicate-insts.cert \
-     centaur/vl/transforms/xf-resolve-ranges.cert \
-     centaur/vl/transforms/xf-sizing.cert \
-     centaur/vl/transforms/xf-unparameterize.cert \
-     centaur/vl/transforms/xf-unused-reg.cert \
-     centaur/vl/transforms/xf-weirdint-elim.cert \
-     centaur/vl/transforms/xf-annotate-mods.cert \
-     centaur/vl/util/clean-alist.cert \
-     centaur/vl/translation.cert \
-     centaur/misc/sneaky-load.cert \
-     centaur/vl/mlib/modname-sets.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     system/f-put-global.cert \
-     centaur/vl/loader/lexer-tests.cert \
-     centaur/vl/loader/preprocessor-tests.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/top.lisp \
-     centaur/vl/top.acl2
-
-
-centaur/vl/transforms/always/conditions.cert : acl2x = 0
-centaur/vl/transforms/always/conditions.cert : no_pcert = 0
-
-centaur/vl/transforms/always/conditions.cert : \
-     centaur/vl/mlib/welltyped.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/conditions.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/elimalways.cert : acl2x = 0
-centaur/vl/transforms/always/elimalways.cert : no_pcert = 0
-
-centaur/vl/transforms/always/elimalways.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/elimalways.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/eliminitial.cert : acl2x = 0
-centaur/vl/transforms/always/eliminitial.cert : no_pcert = 0
-
-centaur/vl/transforms/always/eliminitial.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/eliminitial.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/elimnegedge.cert : acl2x = 0
-centaur/vl/transforms/always/elimnegedge.cert : no_pcert = 0
-
-centaur/vl/transforms/always/elimnegedge.cert : \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/mlib/delta.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/transforms/occform/util.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/elimnegedge.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/flopcode-debug.cert : acl2x = 0
-centaur/vl/transforms/always/flopcode-debug.cert : no_pcert = 0
-
-centaur/vl/transforms/always/flopcode-debug.cert : \
-     centaur/vl/transforms/always/flopcode-prog.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/flopcode-debug.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/flopcode-prog.cert : acl2x = 0
-centaur/vl/transforms/always/flopcode-prog.cert : no_pcert = 0
-
-centaur/vl/transforms/always/flopcode-prog.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/welltyped.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/flopcode-prog.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/flopcode-synth.cert : acl2x = 0
-centaur/vl/transforms/always/flopcode-synth.cert : no_pcert = 0
-
-centaur/vl/transforms/always/flopcode-synth.cert : \
-     centaur/vl/transforms/always/flopcode-prog.cert \
-     centaur/vl/transforms/always/flopcode-debug.cert \
-     centaur/vl/transforms/always/util.cert \
-     centaur/vl/transforms/always/make-flop.cert \
-     centaur/vl/mlib/delta.cert \
-     centaur/vl/mlib/filter.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/flopcode-synth.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/ifmerge.cert : acl2x = 0
-centaur/vl/transforms/always/ifmerge.cert : no_pcert = 0
-
-centaur/vl/transforms/always/ifmerge.cert : \
-     centaur/vl/transforms/always/conditions.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/ifmerge.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/latchcode.cert : acl2x = 0
-centaur/vl/transforms/always/latchcode.cert : no_pcert = 0
-
-centaur/vl/transforms/always/latchcode.cert : \
-     centaur/vl/transforms/always/util.cert \
-     centaur/vl/transforms/always/make-latch.cert \
-     centaur/vl/mlib/delta.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/latchcode.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/make-flop.cert : acl2x = 0
-centaur/vl/transforms/always/make-flop.cert : no_pcert = 0
-
-centaur/vl/transforms/always/make-flop.cert : \
-     centaur/vl/primitives.cert \
-     centaur/vl/transforms/occform/util.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/make-flop.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/make-latch.cert : acl2x = 0
-centaur/vl/transforms/always/make-latch.cert : no_pcert = 0
-
-centaur/vl/transforms/always/make-latch.cert : \
-     centaur/vl/primitives.cert \
-     centaur/vl/transforms/occform/util.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/make-latch.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/stmtrewrite.cert : acl2x = 0
-centaur/vl/transforms/always/stmtrewrite.cert : no_pcert = 0
-
-centaur/vl/transforms/always/stmtrewrite.cert : \
-     centaur/vl/transforms/xf-resolve-ranges.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/stmtrewrite.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/stmttemps.cert : acl2x = 0
-centaur/vl/transforms/always/stmttemps.cert : no_pcert = 0
-
-centaur/vl/transforms/always/stmttemps.cert : \
-     centaur/vl/transforms/always/util.cert \
-     centaur/vl/transforms/always/conditions.cert \
-     centaur/vl/transforms/occform/util.cert \
-     centaur/vl/mlib/expr-slice.cert \
-     centaur/vl/mlib/delta.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/stmttemps.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/synthalways.cert : acl2x = 0
-centaur/vl/transforms/always/synthalways.cert : no_pcert = 0
-
-centaur/vl/transforms/always/synthalways.cert : \
-     centaur/vl/transforms/always/flopcode-synth.cert \
-     centaur/vl/transforms/always/latchcode.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/synthalways.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/top.cert : acl2x = 0
-centaur/vl/transforms/always/top.cert : no_pcert = 0
-
-centaur/vl/transforms/always/top.cert : \
-     centaur/vl/transforms/always/elimalways.cert \
-     centaur/vl/transforms/always/eliminitial.cert \
-     centaur/vl/transforms/always/elimnegedge.cert \
-     centaur/vl/transforms/always/synthalways.cert \
-     centaur/vl/transforms/always/stmtrewrite.cert \
-     centaur/vl/transforms/always/stmttemps.cert \
-     centaur/vl/transforms/always/unelse.cert \
-     centaur/vl/transforms/always/ifmerge.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/top.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/unelse.cert : acl2x = 0
-centaur/vl/transforms/always/unelse.cert : no_pcert = 0
-
-centaur/vl/transforms/always/unelse.cert : \
-     centaur/vl/transforms/always/conditions.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/unelse.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/always/util.cert : acl2x = 0
-centaur/vl/transforms/always/util.cert : no_pcert = 0
-
-centaur/vl/transforms/always/util.cert : \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/lvalues.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/always/util.lisp \
-     centaur/vl/transforms/always/cert.acl2
-
-
-centaur/vl/transforms/cn-hooks.cert : acl2x = 0
-centaur/vl/transforms/cn-hooks.cert : no_pcert = 0
-
-centaur/vl/transforms/cn-hooks.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/cn-hooks.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/occform/add.cert : acl2x = 0
-centaur/vl/transforms/occform/add.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/add.cert : \
-     centaur/vl/transforms/occform/simple.cert \
-     centaur/vl/transforms/occform/xdet.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/add.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/compare.cert : acl2x = 0
-centaur/vl/transforms/occform/compare.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/compare.cert : \
-     centaur/vl/transforms/occform/add.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/compare.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/div.cert : acl2x = 0
-centaur/vl/transforms/occform/div.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/div.cert : \
-     centaur/vl/transforms/occform/add.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/div.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/mul.cert : acl2x = 0
-centaur/vl/transforms/occform/mul.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/mul.cert : \
-     centaur/vl/transforms/occform/add.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/mul.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/select.cert : acl2x = 0
-centaur/vl/transforms/occform/select.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/select.cert : \
-     centaur/vl/transforms/occform/simple.cert \
-     centaur/vl/util/next-power-of-2.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/select.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/shl.cert : acl2x = 0
-centaur/vl/transforms/occform/shl.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/shl.cert : \
-     centaur/vl/transforms/occform/simple.cert \
-     centaur/vl/transforms/occform/xdet.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/shl.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/shr.cert : acl2x = 0
-centaur/vl/transforms/occform/shr.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/shr.cert : \
-     centaur/vl/transforms/occform/shl.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/shr.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/simple.cert : acl2x = 0
-centaur/vl/transforms/occform/simple.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/simple.cert : \
-     centaur/vl/transforms/occform/util.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/simple.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/top.cert : acl2x = 0
-centaur/vl/transforms/occform/top.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/top.cert : \
-     centaur/vl/transforms/occform/add.cert \
-     centaur/vl/transforms/occform/compare.cert \
-     centaur/vl/transforms/occform/div.cert \
-     centaur/vl/transforms/occform/mul.cert \
-     centaur/vl/transforms/occform/select.cert \
-     centaur/vl/transforms/occform/shl.cert \
-     centaur/vl/transforms/occform/shr.cert \
-     centaur/vl/transforms/occform/simple.cert \
-     centaur/vl/transforms/occform/xdet.cert \
-     centaur/vl/mlib/expr-slice.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/top.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/util.cert : acl2x = 0
-centaur/vl/transforms/occform/util.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/util.cert : \
-     centaur/vl/primitives.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/expr-building.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/util.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/occform/xdet.cert : acl2x = 0
-centaur/vl/transforms/occform/xdet.cert : no_pcert = 0
-
-centaur/vl/transforms/occform/xdet.cert : \
-     centaur/vl/transforms/occform/simple.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/occform/xdet.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-
-
-centaur/vl/transforms/xf-addinstnames.cert : acl2x = 0
-centaur/vl/transforms/xf-addinstnames.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-addinstnames.cert : \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-addinstnames.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-annotate-mods.cert : acl2x = 0
-centaur/vl/transforms/xf-annotate-mods.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-annotate-mods.cert : \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/checkers/portcheck.cert \
-     centaur/vl/mlib/warnings.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/transforms/xf-designwires.cert \
-     centaur/vl/transforms/xf-portdecl-sign.cert \
-     centaur/vl/transforms/xf-argresolve.cert \
-     centaur/vl/transforms/xf-orig.cert \
-     centaur/vl/transforms/cn-hooks.cert \
-     centaur/vl/transforms/xf-follow-hids.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-annotate-mods.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-argresolve.cert : acl2x = 0
-centaur/vl/transforms/xf-argresolve.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-argresolve.cert : \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/mlib/port-tools.cert \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-argresolve.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-array-indexing.cert : acl2x = 0
-centaur/vl/transforms/xf-array-indexing.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-array-indexing.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-array-indexing.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-assign-trunc.cert : acl2x = 0
-centaur/vl/transforms/xf-assign-trunc.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-assign-trunc.cert : \
-     centaur/vl/wf-ranges-resolved-p.cert \
-     centaur/vl/wf-widthsfixed-p.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/mlib/welltyped.cert \
-     centaur/vl/mlib/delta.cert \
-     centaur/vl/util/arithmetic.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-assign-trunc.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-blankargs.cert : acl2x = 0
-centaur/vl/transforms/xf-blankargs.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-blankargs.cert : \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/port-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-blankargs.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-clean-params.cert : acl2x = 0
-centaur/vl/transforms/xf-clean-params.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-clean-params.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/mlib/filter.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-clean-params.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-clean-selects.cert : acl2x = 0
-centaur/vl/transforms/xf-clean-selects.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-clean-selects.cert : \
-     centaur/vl/mlib/clean-concats.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-clean-selects.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-delayredux.cert : acl2x = 0
-centaur/vl/transforms/xf-delayredux.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-delayredux.cert : \
-     centaur/vl/transforms/occform/util.cert \
-     centaur/vl/mlib/delta.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-delayredux.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-designregs.cert : acl2x = 0
-centaur/vl/transforms/xf-designregs.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-designregs.cert : \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/mlib/hid-tools.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/util/sum-nats.cert \
-     centaur/vl/util/cwtime.cert \
-     defsort/defsort.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/primitives.cert \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-designregs.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-designwires.cert : acl2x = 0
-centaur/vl/transforms/xf-designwires.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-designwires.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-designwires.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-drop-blankports.cert : acl2x = 0
-centaur/vl/transforms/xf-drop-blankports.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-drop-blankports.cert : \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-drop-blankports.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-elim-supply.cert : acl2x = 0
-centaur/vl/transforms/xf-elim-supply.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-elim-supply.cert : \
-     centaur/vl/transforms/xf-subst.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-elim-supply.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-expand-functions.cert : acl2x = 0
-centaur/vl/transforms/xf-expand-functions.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-expand-functions.cert : \
-     centaur/vl/transforms/always/stmtrewrite.cert \
-     centaur/vl/transforms/xf-subst.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/util/toposort.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-expand-functions.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-expr-simp.cert : acl2x = 0
-centaur/vl/transforms/xf-expr-simp.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-expr-simp.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/fmt.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-expr-simp.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-expr-split.cert : acl2x = 0
-centaur/vl/transforms/xf-expr-split.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-expr-split.cert : \
-     centaur/vl/mlib/expr-slice.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/delta.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-expr-split.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-follow-hids.cert : acl2x = 0
-centaur/vl/transforms/xf-follow-hids.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-follow-hids.cert : \
-     centaur/vl/transforms/xf-resolve-ranges.cert \
-     centaur/vl/mlib/hierarchy.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/hid-tools.cert \
-     centaur/vl/wf-ranges-resolved-p.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-follow-hids.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-gate-elim.cert : acl2x = 0
-centaur/vl/transforms/xf-gate-elim.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-gate-elim.cert : \
-     centaur/vl/primitives.cert \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-gate-elim.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-gateredux.cert : acl2x = 0
-centaur/vl/transforms/xf-gateredux.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-gateredux.cert : \
-     centaur/vl/transforms/occform/simple.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-gateredux.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-gatesplit.cert : acl2x = 0
-centaur/vl/transforms/xf-gatesplit.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-gatesplit.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-gatesplit.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-hid-elim.cert : acl2x = 0
-centaur/vl/transforms/xf-hid-elim.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-hid-elim.cert : \
-     centaur/vl/transforms/xf-resolve-ranges.cert \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/hid-tools.cert \
-     centaur/vl/wf-ranges-resolved-p.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-hid-elim.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-inline.cert : acl2x = 0
-centaur/vl/transforms/xf-inline.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-inline.cert : \
-     centaur/vl/transforms/xf-subst.cert \
-     centaur/vl/mlib/namemangle.cert \
-     centaur/vl/mlib/relocate.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/mlib/port-tools.cert \
-     centaur/vl/mlib/writer.cert \
-     centaur/vl/mlib/print-warnings.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-inline.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-oprewrite.cert : acl2x = 0
-centaur/vl/transforms/xf-oprewrite.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-oprewrite.cert : \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/checkers/duplicate-detect.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-oprewrite.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-optimize-rw.cert : acl2x = 0
-centaur/vl/transforms/xf-optimize-rw.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-optimize-rw.cert : \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-optimize-rw.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-orig.cert : acl2x = 0
-centaur/vl/transforms/xf-orig.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-orig.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-orig.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-portdecl-sign.cert : acl2x = 0
-centaur/vl/transforms/xf-portdecl-sign.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-portdecl-sign.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-portdecl-sign.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-propagate.cert : acl2x = 0
-centaur/vl/transforms/xf-propagate.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-propagate.cert : \
-     centaur/vl/transforms/xf-subst.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-propagate.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-replicate-insts.cert : acl2x = 0
-centaur/vl/transforms/xf-replicate-insts.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-replicate-insts.cert : \
-     centaur/vl/mlib/expr-slice.cert \
-     centaur/vl/mlib/namefactory.cert \
-     centaur/vl/mlib/find-module.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/util/arithmetic.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-replicate-insts.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-resolve-ranges.cert : acl2x = 0
-centaur/vl/transforms/xf-resolve-ranges.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-resolve-ranges.cert : \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-resolve-ranges.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-sizing.cert : acl2x = 0
-centaur/vl/transforms/xf-sizing.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-sizing.cert : \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/util/sum-nats.cert \
-     centaur/vl/mlib/context.cert \
-     centaur/vl/mlib/welltyped.cert \
-     centaur/vl/mlib/lvalues.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/bitops/ihs-extensions.cert \
-     arithmetic-3/bind-free/top.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-sizing.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-subst.cert : acl2x = 0
-centaur/vl/transforms/xf-subst.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-subst.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-subst.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-unparameterize.cert : acl2x = 0
-centaur/vl/transforms/xf-unparameterize.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-unparameterize.cert : \
-     centaur/vl/transforms/xf-subst.cert \
-     centaur/vl/mlib/remove-bad.cert \
-     centaur/vl/mlib/print-warnings.cert \
-     centaur/vl/wf-ranges-resolved-p.cert \
-     centaur/vl/onehot.cert \
-     centaur/vl/util/cwtime.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/mlib/modname-sets.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-unparameterize.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-unused-reg.cert : acl2x = 0
-centaur/vl/transforms/xf-unused-reg.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-unused-reg.cert : \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-unused-reg.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/transforms/xf-weirdint-elim.cert : acl2x = 0
-centaur/vl/transforms/xf-weirdint-elim.cert : no_pcert = 0
-
-centaur/vl/transforms/xf-weirdint-elim.cert : \
-     centaur/vl/transforms/occform/util.cert \
-     centaur/vl/mlib/allexprs.cert \
-     centaur/vl/mlib/stmt-tools.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/transforms/xf-weirdint-elim.lisp \
-     centaur/vl/transforms/cert.acl2
-
-
-centaur/vl/translation.cert : acl2x = 0
-centaur/vl/translation.cert : no_pcert = 0
-
-centaur/vl/translation.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/loader/filemap.cert \
-     centaur/vl/loader/defines.cert \
-     centaur/vl/checkers/use-set-report.cert \
-     centaur/vl/transforms/xf-designregs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/translation.lisp \
-     centaur/vl/cert.acl2
-
-
-centaur/vl/util/arithmetic.cert : acl2x = 0
-centaur/vl/util/arithmetic.cert : no_pcert = 0
-
-centaur/vl/util/arithmetic.cert : \
-     arithmetic/top-with-meta.cert \
-     centaur/bitops/integer-length.cert \
-     cutil/deflist.cert \
-     centaur/vl/util/subsetp-equal.cert \
-     data-structures/list-defthms.cert \
-     misc/hons-help.cert \
-     std/lists/list-defuns.cert \
-     std/lists/nthcdr.cert \
-     std/lists/take.cert \
-     std/lists/coerce.cert \
-     std/lists/list-fix.cert \
-     std/ks/explode-atom.cert \
-     std/lists/repeat.cert \
-     std/lists/rev.cert \
-     defsort/duplicity.cert \
-     tools/mv-nth.cert \
-     tools/bstar.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/arithmetic.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/bits.cert : acl2x = 0
-centaur/vl/util/bits.cert : no_pcert = 0
-
-centaur/vl/util/bits.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/bits.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/character-list-listp.cert : acl2x = 0
-centaur/vl/util/character-list-listp.cert : no_pcert = 0
-
-centaur/vl/util/character-list-listp.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/character-list-listp.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/clean-alist.cert : acl2x = 0
-centaur/vl/util/clean-alist.cert : no_pcert = 0
-
-centaur/vl/util/clean-alist.cert : \
-     centaur/vl/util/defs.cert \
-     misc/hons-help.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/clean-alist.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/commentmap.cert : acl2x = 0
-centaur/vl/util/commentmap.cert : no_pcert = 0
-
-centaur/vl/util/commentmap.cert : \
-     centaur/vl/util/echars.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/commentmap.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/cw-unformatted.cert : acl2x = 0
-centaur/vl/util/cw-unformatted.cert : no_pcert = 0
-
-centaur/vl/util/cw-unformatted.cert : \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/cw-unformatted.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/cwtime.cert : acl2x = 0
-centaur/vl/util/cwtime.cert : no_pcert = 0
-
-centaur/vl/util/cwtime.cert : \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/cwtime.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/defs.cert : acl2x = 0
-centaur/vl/util/defs.cert : no_pcert = 0
-
-centaur/vl/util/defs.cert : \
-     cutil/top.cert \
-     tools/defconsts.cert \
-     std/ks/two-nats-measure.cert \
-     std/lists/list-defuns.cert \
-     centaur/bitops/integer-length.cert \
-     centaur/misc/alist-equiv.cert \
-     centaur/misc/hons-extra.cert \
-     str/top.cert \
-     str/fast-cat.cert \
-     arithmetic/top-with-meta.cert \
-     data-structures/list-defthms.cert \
-     centaur/misc/equal-sets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/defs.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/defwellformed.cert : acl2x = 0
-centaur/vl/util/defwellformed.cert : no_pcert = 0
-
-centaur/vl/util/defwellformed.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/warnings.cert \
-     tools/flag.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/defwellformed.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/echars.cert : acl2x = 0
-centaur/vl/util/echars.cert : no_pcert = 0
-
-centaur/vl/util/echars.cert : \
-     centaur/vl/util/defs.cert \
-     misc/assert.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/echars.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/esim-lemmas.cert : acl2x = 0
-centaur/vl/util/esim-lemmas.cert : no_pcert = 0
-
-centaur/vl/util/esim-lemmas.cert : \
-     centaur/esim/esim-sexpr-support.cert \
-     centaur/esim/esim-sexpr-support-thms.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/esim-lemmas.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/gc.cert : acl2x = 0
-centaur/vl/util/gc.cert : no_pcert = 0
-
-centaur/vl/util/gc.cert : \
-     centaur/misc/memory-mgmt-raw.cert \
-     tools/include-raw.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/gc.lisp \
-     centaur/vl/util/cert.acl2 \
-     centaur/vl/util/gc-raw.lsp
-
-
-centaur/vl/util/intersectp-equal.cert : acl2x = 0
-centaur/vl/util/intersectp-equal.cert : no_pcert = 0
-
-centaur/vl/util/intersectp-equal.cert : \
-     std/lists/list-defuns.cert \
-     cutil/define.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/intersectp-equal.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/namedb.cert : acl2x = 0
-centaur/vl/util/namedb.cert : no_pcert = 0
-
-centaur/vl/util/namedb.cert : \
-     str/top.cert \
-     centaur/vl/util/string-alists.cert \
-     centaur/vl/util/nat-alists.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/namedb.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/nat-alists.cert : acl2x = 0
-centaur/vl/util/nat-alists.cert : no_pcert = 0
-
-centaur/vl/util/nat-alists.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/nat-alists.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/next-power-of-2.cert : acl2x = 0
-centaur/vl/util/next-power-of-2.cert : no_pcert = 0
-
-centaur/vl/util/next-power-of-2.cert : \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/next-power-of-2.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/osets.cert : acl2x = 0
-centaur/vl/util/osets.cert : no_pcert = 0
-
-centaur/vl/util/osets.cert : \
-     centaur/vl/util/subsetp-equal.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/osets.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/position.cert : acl2x = 0
-centaur/vl/util/position.cert : no_pcert = 0
-
-centaur/vl/util/position.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/position.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/prefix-hash.cert : acl2x = 0
-centaur/vl/util/prefix-hash.cert : no_pcert = 0
-
-centaur/vl/util/prefix-hash.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/prefix-hash.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/prefixp.cert : acl2x = 0
-centaur/vl/util/prefixp.cert : no_pcert = 0
-
-centaur/vl/util/prefixp.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/prefixp.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/print-htmlencode.cert : acl2x = 0
-centaur/vl/util/print-htmlencode.cert : no_pcert = 0
-
-centaur/vl/util/print-htmlencode.cert : \
-     tools/bstar.cert \
-     make-event/assert.cert \
-     centaur/vl/util/arithmetic.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/print-htmlencode.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/print-urlencode.cert : acl2x = 0
-centaur/vl/util/print-urlencode.cert : no_pcert = 0
-
-centaur/vl/util/print-urlencode.cert : \
-     xdoc/top.cert \
-     misc/definline.cert \
-     make-event/assert.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/print-urlencode.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/print.cert : acl2x = 0
-centaur/vl/util/print.cert : no_pcert = 0
-
-centaur/vl/util/print.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/print-urlencode.cert \
-     centaur/vl/util/print-htmlencode.cert \
-     centaur/vl/util/cw-unformatted.cert \
-     str/natstr.cert \
-     centaur/vl/util/arithmetic.cert \
-     make-event/assert.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/print.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/string-alists.cert : acl2x = 0
-centaur/vl/util/string-alists.cert : no_pcert = 0
-
-centaur/vl/util/string-alists.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/string-alists.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/subsetp-equal.cert : acl2x = 0
-centaur/vl/util/subsetp-equal.cert : no_pcert = 0
-
-centaur/vl/util/subsetp-equal.cert : \
-     centaur/misc/equal-sets.cert \
-     finite-set-theory/osets/sets.cert \
-     std/lists/list-fix.cert \
-     std/lists/take.cert \
-     defsort/duplicated-members.cert \
-     arithmetic/top.cert \
-     data-structures/list-defthms.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/subsetp-equal.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/sum-nats.cert : acl2x = 0
-centaur/vl/util/sum-nats.cert : no_pcert = 0
-
-centaur/vl/util/sum-nats.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/sum-nats.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/toposort.cert : acl2x = 0
-centaur/vl/util/toposort.cert : no_pcert = 0
-
-centaur/vl/util/toposort.cert : \
-     centaur/vl/util/defs.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     make-event/assert.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/toposort.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/util/warnings.cert : acl2x = 0
-centaur/vl/util/warnings.cert : no_pcert = 0
-
-centaur/vl/util/warnings.cert : \
-     centaur/vl/util/defs.cert \
-     defsort/remove-dups.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/util/warnings.lisp \
-     centaur/vl/util/cert.acl2
-
-
-centaur/vl/wf-ranges-resolved-p.cert : acl2x = 0
-centaur/vl/wf-ranges-resolved-p.cert : no_pcert = 0
-
-centaur/vl/wf-ranges-resolved-p.cert : \
-     centaur/vl/mlib/range-tools.cert \
-     centaur/vl/util/defwellformed.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/wf-ranges-resolved-p.lisp \
-     centaur/vl/cert.acl2
-
-
-centaur/vl/wf-reasonable-p.cert : acl2x = 0
-centaur/vl/wf-reasonable-p.cert : no_pcert = 0
-
-centaur/vl/wf-reasonable-p.cert : \
-     centaur/vl/mlib/modnamespace.cert \
-     centaur/vl/mlib/find-item.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/util/defwellformed.cert \
-     centaur/vl/util/warnings.cert \
-     defsort/duplicated-members.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/util/osets.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/wf-reasonable-p.lisp \
-     centaur/vl/cert.acl2
-
-
-centaur/vl/wf-widthsfixed-p.cert : acl2x = 0
-centaur/vl/wf-widthsfixed-p.cert : no_pcert = 0
-
-centaur/vl/wf-widthsfixed-p.cert : \
-     centaur/vl/parsetree.cert \
-     centaur/vl/mlib/expr-tools.cert \
-     centaur/vl/wf-reasonable-p.cert \
-     centaur/vl/util/arithmetic.cert \
-     centaur/vl/portcullis.cert \
-     centaur/vl/wf-widthsfixed-p.lisp \
-     centaur/vl/cert.acl2
-
-
-clause-processors/autohide.cert : acl2x = 0
-clause-processors/autohide.cert : no_pcert = 0
-
-clause-processors/autohide.cert : \
-     clause-processors/join-thms.cert \
-     tools/flag.cert \
-     tools/do-not.cert \
-     clause-processors/equality.cert \
-     clause-processors/autohide.lisp \
-     clause-processors/autohide.acl2 \
-     tools/flag-package.lsp
-
-
-clause-processors/basic-examples.cert : acl2x = 0
-clause-processors/basic-examples.cert : no_pcert = 0
-
-clause-processors/basic-examples.cert : \
-     misc/eval.cert \
-     arithmetic/top-with-meta.cert \
-     clause-processors/basic-examples.lisp \
-     clause-processors/basic-examples.acl2
-
-
-clause-processors/bv-add-common.cert : acl2x = 0
-clause-processors/bv-add-common.cert : no_pcert = 0
-
-clause-processors/bv-add-common.cert : \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     clause-processors/bv-add-common.lisp
-
-
-clause-processors/bv-add-tests.cert : acl2x = 0
-clause-processors/bv-add-tests.cert : no_pcert = 0
-
-clause-processors/bv-add-tests.cert : \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     clause-processors/bv-add-common.cert \
-     clause-processors/bv-add.cert \
-     clause-processors/bv-add-tests.lisp
-
-
-clause-processors/bv-add.cert : acl2x = 0
-clause-processors/bv-add.cert : no_pcert = 0
-
-clause-processors/bv-add.cert : \
-     textbook/chap11/perm-append.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     clause-processors/bv-add.lisp
-
-
-clause-processors/decomp-hint.cert : acl2x = 0
-clause-processors/decomp-hint.cert : no_pcert = 0
-
-clause-processors/decomp-hint.cert : \
-     clause-processors/join-thms.cert \
-     tools/bstar.cert \
-     clause-processors/decomp-hint.lisp
-
-
-clause-processors/equality.cert : acl2x = 0
-clause-processors/equality.cert : no_pcert = 0
-
-clause-processors/equality.cert : \
-     tools/flag.cert \
-     misc/eval.cert \
-     clause-processors/equality.lisp \
-     clause-processors/equality.acl2 \
-     tools/flag-package.lsp
-
-
-clause-processors/ev-find-rules.cert : acl2x = 0
-clause-processors/ev-find-rules.cert : no_pcert = 0
-
-clause-processors/ev-find-rules.cert : \
-     clause-processors/ev-find-rules.lisp
-
-
-clause-processors/ev-theoremp.cert : acl2x = 0
-clause-processors/ev-theoremp.cert : no_pcert = 0
-
-clause-processors/ev-theoremp.cert : \
-     clause-processors/join-thms.cert \
-     clause-processors/ev-theoremp.lisp
-
-
-clause-processors/find-subterms.cert : acl2x = 0
-clause-processors/find-subterms.cert : no_pcert = 0
-
-clause-processors/find-subterms.cert : \
-     clause-processors/find-subterms.lisp
-
-
-clause-processors/generalize.cert : acl2x = 0
-clause-processors/generalize.cert : no_pcert = 0
-
-clause-processors/generalize.cert : \
-     tools/flag.cert \
-     data-structures/list-theory.cert \
-     clause-processors/join-thms.cert \
-     arithmetic/top-with-meta.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     clause-processors/generalize.lisp \
-     clause-processors/generalize.acl2 \
-     tools/flag-package.lsp
-
-
-clause-processors/instantiate.cert : acl2x = 0
-clause-processors/instantiate.cert : no_pcert = 0
-
-clause-processors/instantiate.cert : \
-     clause-processors/unify-subst.cert \
-     tools/flag.cert \
-     tools/bstar.cert \
-     clause-processors/instantiate.lisp
-
-
-clause-processors/join-thms.cert : acl2x = 0
-clause-processors/join-thms.cert : no_pcert = 0
-
-clause-processors/join-thms.cert : \
-     clause-processors/ev-find-rules.cert \
-     clause-processors/join-thms.lisp
-
-
-clause-processors/just-expand.cert : acl2x = 0
-clause-processors/just-expand.cert : no_pcert = 0
-
-clause-processors/just-expand.cert : \
-     clause-processors/unify-subst.cert \
-     tools/bstar.cert \
-     clause-processors/ev-theoremp.cert \
-     clause-processors/use-by-hint.cert \
-     clause-processors/just-expand.lisp
-
-
-clause-processors/meta-extract-simple-test.cert : acl2x = 0
-clause-processors/meta-extract-simple-test.cert : no_pcert = 0
-
-clause-processors/meta-extract-simple-test.cert : \
-     system/meta-extract.cert \
-     arithmetic-5/top.cert \
-     arithmetic-5/top.cert \
-     arithmetic-5/top.cert \
-     clause-processors/meta-extract-simple-test.lisp
-
-
-clause-processors/meta-extract-user.cert : acl2x = 0
-clause-processors/meta-extract-user.cert : no_pcert = 0
-
-clause-processors/meta-extract-user.cert : \
-     tools/defevaluator-fast.cert \
-     clause-processors/ev-theoremp.cert \
-     tools/def-functional-instance.cert \
-     system/sublis-var.cert \
-     system/meta-extract.cert \
-     clause-processors/meta-extract-user.lisp
-
-
-clause-processors/multi-env-trick.cert : acl2x = 0
-clause-processors/multi-env-trick.cert : no_pcert = 0
-
-clause-processors/multi-env-trick.cert : \
-     clause-processors/join-thms.cert \
-     misc/untranslate-patterns.cert \
-     clause-processors/multi-env-trick.lisp
-
-
-clause-processors/null-fail-hints.cert : acl2x = 0
-clause-processors/null-fail-hints.cert : no_pcert = 0
-
-clause-processors/null-fail-hints.cert : \
-     clause-processors/join-thms.cert \
-     clause-processors/null-fail-hints.lisp
-
-
-clause-processors/nvalues-thms.cert : acl2x = 0
-clause-processors/nvalues-thms.cert : no_pcert = 0
-
-clause-processors/nvalues-thms.cert : \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     clause-processors/multi-env-trick.cert \
-     clause-processors/join-thms.cert \
-     tools/flag.cert \
-     arithmetic/top-with-meta.cert \
-     clause-processors/nvalues-thms.lisp
-
-
-clause-processors/replace-defined-consts.cert : acl2x = 0
-clause-processors/replace-defined-consts.cert : no_pcert = 0
-
-clause-processors/replace-defined-consts.cert : \
-     clause-processors/use-by-hint.cert \
-     clause-processors/multi-env-trick.cert \
-     tools/bstar.cert \
-     tools/flag.cert \
-     tools/mv-nth.cert \
-     clause-processors/replace-defined-consts.lisp \
-     clause-processors/replace-defined-consts.acl2 \
-     tools/flag-package.lsp
-
-
-clause-processors/replace-impl.cert : acl2x = 0
-clause-processors/replace-impl.cert : no_pcert = 0
-
-clause-processors/replace-impl.cert : \
-     clause-processors/replace-impl.lisp
-
-
-clause-processors/stobj-preservation.cert : acl2x = 0
-clause-processors/stobj-preservation.cert : no_pcert = 0
-
-clause-processors/stobj-preservation.cert : \
-     xdoc/top.cert \
-     clause-processors/just-expand.cert \
-     clause-processors/stobj-preservation.lisp
-
-
-clause-processors/sublis-var-meaning.cert : acl2x = 0
-clause-processors/sublis-var-meaning.cert : no_pcert = 0
-
-clause-processors/sublis-var-meaning.cert : \
-     system/sublis-var.cert \
-     tools/flag.cert \
-     tools/mv-nth.cert \
-     tools/defevaluator-fast.cert \
-     clause-processors/sublis-var-meaning.lisp
-
-
-clause-processors/term-patterns.cert : acl2x = 0
-clause-processors/term-patterns.cert : no_pcert = 0
-
-clause-processors/term-patterns.cert : \
-     tools/flag.cert \
-     tools/flag.cert \
-     clause-processors/term-patterns.lisp \
-     clause-processors/term-patterns.acl2
-
-
-clause-processors/unify-subst.cert : acl2x = 0
-clause-processors/unify-subst.cert : no_pcert = 0
-
-clause-processors/unify-subst.cert : \
-     tools/flag.cert \
-     tools/bstar.cert \
-     tools/mv-nth.cert \
-     tools/def-functional-instance.cert \
-     clause-processors/ev-find-rules.cert \
-     clause-processors/unify-subst.lisp \
-     clause-processors/unify-subst.acl2 \
-     tools/flag-package.lsp
-
-
-clause-processors/use-by-hint.cert : acl2x = 0
-clause-processors/use-by-hint.cert : no_pcert = 0
-
-clause-processors/use-by-hint.cert : \
-     clause-processors/join-thms.cert \
-     clause-processors/use-by-hint.lisp
-
-
-clause-processors/witness-cp.cert : acl2x = 0
-clause-processors/witness-cp.cert : no_pcert = 0
-
-clause-processors/witness-cp.cert : \
-     clause-processors/use-by-hint.cert \
-     clause-processors/generalize.cert \
-     clause-processors/unify-subst.cert \
-     tools/bstar.cert \
-     clause-processors/ev-theoremp.cert \
-     tools/def-functional-instance.cert \
-     tools/oracle-eval.cert \
-     data-structures/no-duplicates.cert \
-     clause-processors/witness-cp.lisp \
-     clause-processors/witness-cp.acl2 \
-     tools/flag-package.lsp
-
-
-coi/adviser/adviser-pkg.cert : acl2x = 0
-coi/adviser/adviser-pkg.cert : no_pcert = 0
-
-coi/adviser/adviser-pkg.cert : \
-     coi/adviser/adviser-pkg.lisp \
-     coi/adviser/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/adviser/adviser.cert : acl2x = 0
-coi/adviser/adviser.cert : no_pcert = 0
-
-coi/adviser/adviser.cert : \
-     misc/symbol-btree.cert \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/adviser/adviser.lisp \
-     coi/adviser/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/adviser/test.cert : acl2x = 0
-coi/adviser/test.cert : no_pcert = 0
-
-coi/adviser/test.cert : \
-     coi/adviser/adviser.cert \
-     coi/adviser/test.lisp \
-     coi/adviser/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/alist-pkg.cert : acl2x = 0
-coi/alists/alist-pkg.cert : no_pcert = 0
-
-coi/alists/alist-pkg.cert : \
-     coi/alists/alist-pkg.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/bindequiv.cert : acl2x = 0
-coi/alists/bindequiv.cert : no_pcert = 0
-
-coi/alists/bindequiv.cert : \
-     coi/util/mv-nth.cert \
-     coi/nary/nary.cert \
-     coi/util/good-rewrite-order.cert \
-     coi/alists/keyquiv.cert \
-     coi/bags/top.cert \
-     misc/total-order.cert \
-     coi/alists/bindequiv.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/clearkey.cert : acl2x = 0
-coi/alists/clearkey.cert : no_pcert = 0
-
-coi/alists/clearkey.cert : \
-     coi/alists/equiv.cert \
-     coi/bags/basic.cert \
-     coi/alists/clearkey.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/deshadow.cert : acl2x = 0
-coi/alists/deshadow.cert : no_pcert = 0
-
-coi/alists/deshadow.cert : \
-     coi/alists/strip.cert \
-     coi/alists/clearkey.cert \
-     coi/bags/basic.cert \
-     coi/util/iff.cert \
-     coi/bags/pick-a-point.cert \
-     coi/alists/deshadow.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/equiv.cert : acl2x = 0
-coi/alists/equiv.cert : no_pcert = 0
-
-coi/alists/equiv.cert : \
-     coi/lists/basic.cert \
-     coi/util/iff.cert \
-     coi/alists/equiv.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/keyquiv.cert : acl2x = 0
-coi/alists/keyquiv.cert : no_pcert = 0
-
-coi/alists/keyquiv.cert : \
-     coi/util/iff.cert \
-     coi/lists/basic.cert \
-     coi/lists/memberp.cert \
-     coi/lists/set.cert \
-     coi/util/good-rewrite-order.cert \
-     coi/alists/equiv.cert \
-     coi/util/iff.cert \
-     coi/lists/remove-induction.cert \
-     coi/lists/remove.cert \
-     coi/alists/keyquiv.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/preimage.cert : acl2x = 0
-coi/alists/preimage.cert : no_pcert = 0
-
-coi/alists/preimage.cert : \
-     coi/alists/deshadow.cert \
-     coi/alists/strip.cert \
-     coi/alists/preimage.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/strip.cert : acl2x = 0
-coi/alists/strip.cert : no_pcert = 0
-
-coi/alists/strip.cert : \
-     coi/alists/equiv.cert \
-     coi/lists/memberp.cert \
-     coi/util/iff.cert \
-     coi/alists/strip.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/subkeyquiv.cert : acl2x = 0
-coi/alists/subkeyquiv.cert : no_pcert = 0
-
-coi/alists/subkeyquiv.cert : \
-     coi/lists/set.cert \
-     coi/alists/keyquiv.cert \
-     coi/util/good-rewrite-order.cert \
-     coi/nary/nary.cert \
-     coi/alists/subkeyquiv.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/alists/top.cert : acl2x = 0
-coi/alists/top.cert : no_pcert = 0
-
-coi/alists/top.cert : \
-     coi/alists/equiv.cert \
-     coi/alists/strip.cert \
-     coi/alists/clearkey.cert \
-     coi/alists/deshadow.cert \
-     coi/alists/preimage.cert \
-     coi/alists/top.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/basic.cert : acl2x = 0
-coi/bags/basic.cert : no_pcert = 0
-
-coi/bags/basic.cert : \
-     coi/lists/basic.cert \
-     coi/lists/memberp.cert \
-     coi/lists/disjoint.cert \
-     coi/bags/basic.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/bind-free-rules.cert : acl2x = 0
-coi/bags/bind-free-rules.cert : no_pcert = 0
-
-coi/bags/bind-free-rules.cert : \
-     coi/bags/meta.cert \
-     coi/bags/bind-free-rules.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/cons.cert : acl2x = 0
-coi/bags/cons.cert : no_pcert = 0
-
-coi/bags/cons.cert : \
-     coi/syntax/syntax.cert \
-     coi/bags/cons.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/eric-meta.cert : acl2x = 0
-coi/bags/eric-meta.cert : no_pcert = 0
-
-coi/bags/eric-meta.cert : \
-     coi/bags/bind-free-rules.cert \
-     coi/util/iff.cert \
-     rtl/rel4/support/logand.cert \
-     coi/bags/eric-meta.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/extras.cert : acl2x = 0
-coi/bags/extras.cert : no_pcert = 0
-
-coi/bags/extras.cert : \
-     coi/bags/basic.cert \
-     coi/lists/find-index.cert \
-     coi/bags/extras.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/meta.cert : acl2x = 0
-coi/bags/meta.cert : no_pcert = 0
-
-coi/bags/meta.cert : \
-     coi/bags/basic.cert \
-     ordinals/e0-ordinal.cert \
-     coi/util/mv-nth.cert \
-     coi/util/iff.cert \
-     coi/syntax/syntax.cert \
-     arithmetic/top-with-meta.cert \
-     coi/bags/meta.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/neq.cert : acl2x = 0
-coi/bags/neq.cert : no_pcert = 0
-
-coi/bags/neq.cert : \
-     coi/bags/bind-free-rules.cert \
-     coi/bags/neq.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/pick-a-point.cert : acl2x = 0
-coi/bags/pick-a-point.cert : no_pcert = 0
-
-coi/bags/pick-a-point.cert : \
-     coi/bags/basic.cert \
-     coi/adviser/adviser.cert \
-     coi/bags/pick-a-point.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/top.cert : acl2x = 0
-coi/bags/top.cert : no_pcert = 0
-
-coi/bags/top.cert : \
-     coi/bags/bind-free-rules.cert \
-     coi/bags/cons.cert \
-     coi/bags/neq.cert \
-     coi/bags/eric-meta.cert \
-     coi/bags/top.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/two-level-meta.cert : acl2x = 0
-coi/bags/two-level-meta.cert : no_pcert = 0
-
-coi/bags/two-level-meta.cert : \
-     coi/bags/two-level.cert \
-     coi/bags/two-level-meta.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/bags/two-level.cert : acl2x = 0
-coi/bags/two-level.cert : no_pcert = 0
-
-coi/bags/two-level.cert : \
-     coi/bags/bind-free-rules.cert \
-     coi/bags/two-level.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/defpun/ack.cert : acl2x = 0
-coi/defpun/ack.cert : no_pcert = 0
-
-coi/defpun/ack.cert : \
-     coi/defpun/defminterm.cert \
-     coi/defpun/ack.lisp
-
-
-coi/defpun/defminterm.cert : acl2x = 0
-coi/defpun/defminterm.cert : no_pcert = 0
-
-coi/defpun/defminterm.cert : \
-     coi/defpun/defxch.cert \
-     coi/defpun/defpun.cert \
-     coi/defpun/defminterm.lisp
-
-
-coi/defpun/defpun.cert : acl2x = 0
-coi/defpun/defpun.cert : no_pcert = 0
-
-coi/defpun/defpun.cert : \
-     coi/defpun/defpun.lisp
-
-
-coi/defpun/defxch.cert : acl2x = 0
-coi/defpun/defxch.cert : no_pcert = 0
-
-coi/defpun/defxch.cert : \
-     arithmetic-2/meta/top.cert \
-     misc/defpun.cert \
-     coi/defpun/defxch.lisp
-
-
-coi/defstructure/defstructure-pkg.cert : acl2x = 0
-coi/defstructure/defstructure-pkg.cert : no_pcert = 0
-
-coi/defstructure/defstructure-pkg.cert : \
-     coi/defstructure/defstructure-pkg.lisp \
-     coi/defstructure/cert.acl2 \
-     coi/defstructure/structures-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/define-u-package.lsp
-
-
-coi/defstructure/defstructure.cert : acl2x = 0
-coi/defstructure/defstructure.cert : no_pcert = 0
-
-coi/defstructure/defstructure.cert : \
-     coi/paths/path.cert \
-     data-structures/utilities.cert \
-     coi/defstructure/defstructure.lisp \
-     coi/defstructure/cert.acl2 \
-     coi/defstructure/structures-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/define-u-package.lsp
-
-
-coi/dtrees/base.cert : acl2x = 0
-coi/dtrees/base.cert : no_pcert = 0
-
-coi/dtrees/base.cert : \
-     coi/util/iff.cert \
-     coi/maps/maps.cert \
-     coi/lists/basic.cert \
-     coi/osets/multicons.cert \
-     coi/maps/typed-maps.cert \
-     coi/dtrees/base.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/child.cert : acl2x = 0
-coi/dtrees/child.cert : no_pcert = 0
-
-coi/dtrees/child.cert : \
-     coi/dtrees/raw.cert \
-     coi/dtrees/set.cert \
-     coi/dtrees/erase.cert \
-     coi/dtrees/child.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/deps.cert : acl2x = 0
-coi/dtrees/deps.cert : no_pcert = 0
-
-coi/dtrees/deps.cert : \
-     coi/dtrees/base.cert \
-     coi/dtrees/deps.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/equiv.cert : acl2x = 0
-coi/dtrees/equiv.cert : no_pcert = 0
-
-coi/dtrees/equiv.cert : \
-     coi/dtrees/deps.cert \
-     coi/dtrees/equiv.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/erase.cert : acl2x = 0
-coi/dtrees/erase.cert : no_pcert = 0
-
-coi/dtrees/erase.cert : \
-     coi/dtrees/set.cert \
-     coi/paths/dominates.cert \
-     coi/paths/diverge.cert \
-     arithmetic/top-with-meta.cert \
-     coi/dtrees/erase.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/leafp.cert : acl2x = 0
-coi/dtrees/leafp.cert : no_pcert = 0
-
-coi/dtrees/leafp.cert : \
-     coi/dtrees/equiv.cert \
-     coi/paths/dominates.cert \
-     coi/paths/diverge.cert \
-     arithmetic/top-with-meta.cert \
-     coi/dtrees/leafp.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/raw.cert : acl2x = 0
-coi/dtrees/raw.cert : no_pcert = 0
-
-coi/dtrees/raw.cert : \
-     coi/dtrees/equiv.cert \
-     coi/dtrees/raw.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/royalp.cert : acl2x = 0
-coi/dtrees/royalp.cert : no_pcert = 0
-
-coi/dtrees/royalp.cert : \
-     coi/dtrees/equiv.cert \
-     coi/paths/dominates.cert \
-     coi/paths/diverge.cert \
-     arithmetic/top-with-meta.cert \
-     coi/dtrees/royalp.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/set.cert : acl2x = 0
-coi/dtrees/set.cert : no_pcert = 0
-
-coi/dtrees/set.cert : \
-     coi/dtrees/raw.cert \
-     coi/paths/dominates.cert \
-     coi/paths/diverge.cert \
-     arithmetic/top-with-meta.cert \
-     coi/dtrees/set.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/dtrees/top.cert : acl2x = 0
-coi/dtrees/top.cert : no_pcert = 0
-
-coi/dtrees/top.cert : \
-     coi/dtrees/base.cert \
-     coi/dtrees/deps.cert \
-     coi/dtrees/equiv.cert \
-     coi/dtrees/raw.cert \
-     coi/dtrees/set.cert \
-     coi/dtrees/erase.cert \
-     coi/dtrees/leafp.cert \
-     coi/dtrees/royalp.cert \
-     coi/dtrees/child.cert \
-     coi/dtrees/top.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/abstract-gacc.cert : acl2x = 0
-coi/gacc/abstract-gacc.cert : no_pcert = 0
-
-coi/gacc/abstract-gacc.cert : \
-     coi/records/defrecord.cert \
-     coi/gacc/abstract-gacc.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/addr-range.cert : acl2x = 0
-coi/gacc/addr-range.cert : no_pcert = 0
-
-coi/gacc/addr-range.cert : \
-     coi/bags/basic.cert \
-     coi/gacc/addr-range.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/bits.cert : acl2x = 0
-coi/gacc/bits.cert : no_pcert = 0
-
-coi/gacc/bits.cert : \
-     coi/super-ihs/super-ihs.cert \
-     coi/gacc/bits.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/block.cert : acl2x = 0
-coi/gacc/block.cert : no_pcert = 0
-
-coi/gacc/block.cert : \
-     coi/bags/basic.cert \
-     arithmetic/top-with-meta.cert \
-     coi/gacc/block.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/finite.cert : acl2x = 0
-coi/gacc/finite.cert : no_pcert = 0
-
-coi/gacc/finite.cert : \
-     coi/gacc/gax.cert \
-     coi/gacc/gax.cert \
-     coi/gacc/finite.lisp \
-     coi/gacc/finite.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/fr-path-connection.cert : acl2x = 0
-coi/gacc/fr-path-connection.cert : no_pcert = 0
-
-coi/gacc/fr-path-connection.cert : \
-     coi/gacc/mem-fast.cert \
-     coi/paths/path.cert \
-     coi/records/mem-domain.cert \
-     coi/osets/extras.cert \
-     coi/paths/path.cert \
-     coi/gacc/fr-path-connection.lisp \
-     coi/gacc/fr-path-connection.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/gacc-exports.cert : acl2x = 0
-coi/gacc/gacc-exports.cert : no_pcert = 0
-
-coi/gacc/gacc-exports.cert : \
-     coi/gacc/gacc-exports.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/gacc-pkg.cert : acl2x = 0
-coi/gacc/gacc-pkg.cert : no_pcert = 0
-
-coi/gacc/gacc-pkg.cert : \
-     coi/gacc/gacc-pkg.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/gacc.cert : acl2x = 0
-coi/gacc/gacc.cert : no_pcert = 0
-
-coi/gacc/gacc.cert : \
-     coi/gacc/ram.cert \
-     ordinals/e0-ordinal.cert \
-     coi/bags/top.cert \
-     coi/gacc/ram.cert \
-     ordinals/e0-ordinal.cert \
-     coi/gacc/gacc.lisp \
-     coi/gacc/gacc.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/gacc2.cert : acl2x = 0
-coi/gacc/gacc2.cert : no_pcert = 0
-
-coi/gacc/gacc2.cert : \
-     coi/defstructure/defstructure.cert \
-     coi/gacc/ram.cert \
-     coi/defstructure/defstructure.cert \
-     coi/gacc/ram.cert \
-     coi/gacc/gacc2.lisp \
-     coi/gacc/gacc2.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/gacc3.cert : acl2x = 0
-coi/gacc/gacc3.cert : no_pcert = 0
-
-coi/gacc/gacc3.cert : \
-     coi/gacc/finite.cert \
-     coi/gacc/finite.cert \
-     coi/gacc/gacc3.lisp \
-     coi/gacc/gacc3.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/gax.cert : acl2x = 0
-coi/gacc/gax.cert : no_pcert = 0
-
-coi/gacc/gax.cert : \
-     coi/gacc/gacc2.cert \
-     coi/gacc/gacc.cert \
-     coi/util/mv-nth.cert \
-     coi/gacc/gacc2.cert \
-     coi/gacc/gacc.cert \
-     coi/gacc/gax.lisp \
-     coi/gacc/gax.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/list-ops-common.cert : acl2x = 0
-coi/gacc/list-ops-common.cert : no_pcert = 0
-
-coi/gacc/list-ops-common.cert : \
-     coi/super-ihs/super-ihs.cert \
-     coi/lists/memberp.cert \
-     coi/lists/repeat.cert \
-     coi/bags/basic.cert \
-     coi/lists/find-index.cert \
-     coi/bags/pick-a-point.cert \
-     coi/gacc/list-ops-common.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/list-ops-fast.cert : acl2x = 0
-coi/gacc/list-ops-fast.cert : no_pcert = 0
-
-coi/gacc/list-ops-fast.cert : \
-     coi/gacc/mem-fast.cert \
-     coi/lists/memberp.cert \
-     coi/bags/extras.cert \
-     coi/super-ihs/super-ihs.cert \
-     coi/gacc/list-ops-common.cert \
-     coi/gacc/list-ops-fast.lisp \
-     coi/gacc/list-ops-fast.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/gacc/list-ops.cert : acl2x = 0
-coi/gacc/list-ops.cert : no_pcert = 0
-
-coi/gacc/list-ops.cert : \
-     coi/gacc/mem.cert \
-     coi/lists/memberp.cert \
-     coi/bags/basic.cert \
-     coi/gacc/list-ops-common.cert \
-     coi/super-ihs/super-ihs.cert \
-     coi/gacc/list-ops.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/mem-fast.cert : acl2x = 0
-coi/gacc/mem-fast.cert : no_pcert = 0
-
-coi/gacc/mem-fast.cert : \
-     coi/records/defrecord-fast.cert \
-     coi/super-ihs/loghead.cert \
-     coi/super-ihs/unsigned-byte-p.cert \
-     coi/util/syntaxp.cert \
-     coi/gacc/mem-fast.lisp \
-     coi/gacc/mem-fast.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/gacc/mem.cert : acl2x = 0
-coi/gacc/mem.cert : no_pcert = 0
-
-coi/gacc/mem.cert : \
-     coi/records/defrecord.cert \
-     coi/super-ihs/loghead.cert \
-     coi/super-ihs/unsigned-byte-p.cert \
-     coi/util/syntaxp.cert \
-     coi/gacc/mem.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/ram.cert : acl2x = 0
-coi/gacc/ram.cert : no_pcert = 0
-
-coi/gacc/ram.cert : \
-     coi/gacc/ram0.cert \
-     coi/gacc/block.cert \
-     coi/bags/two-level-meta.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     coi/super-ihs/super-ihs.cert \
-     coi/gacc/addr-range.cert \
-     coi/gacc/list-ops.cert \
-     coi/gacc/ram.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/ram0.cert : acl2x = 0
-coi/gacc/ram0.cert : no_pcert = 0
-
-coi/gacc/ram0.cert : \
-     coi/gacc/mem.cert \
-     coi/super-ihs/byte-p.cert \
-     coi/gacc/ram0.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/ram2.cert : acl2x = 0
-coi/gacc/ram2.cert : no_pcert = 0
-
-coi/gacc/ram2.cert : \
-     coi/gacc/list-ops-fast.cert \
-     coi/gacc/addr-range.cert \
-     coi/gacc/wrap.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     coi/super-ihs/super-ihs.cert \
-     coi/gacc/ram2.lisp \
-     coi/gacc/ram2.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/gacc/ram2b.cert : acl2x = 0
-coi/gacc/ram2b.cert : no_pcert = 0
-
-coi/gacc/ram2b.cert : \
-     coi/gacc/list-ops-fast.cert \
-     coi/gacc/addr-range.cert \
-     coi/gacc/ram3.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     coi/super-ihs/super-ihs.cert \
-     coi/gacc/ram2b.lisp \
-     coi/gacc/ram2b.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/gacc/ram3.cert : acl2x = 0
-coi/gacc/ram3.cert : no_pcert = 0
-
-coi/gacc/ram3.cert : \
-     coi/util/iff.cert \
-     coi/gacc/list-ops-fast.cert \
-     coi/gacc/wrap.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     coi/super-ihs/super-ihs.cert \
-     coi/super-ihs/fast.cert \
-     coi/lists/mixed.cert \
-     coi/bags/pick-a-point.cert \
-     coi/lists/repeat.cert \
-     coi/gacc/ram3.lisp \
-     coi/gacc/ram3.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/gacc/top.cert : acl2x = 0
-coi/gacc/top.cert : no_pcert = 0
-
-coi/gacc/top.cert : \
-     coi/gacc/gacc3.cert \
-     coi/gacc/gacc3.cert \
-     coi/gacc/top.lisp \
-     coi/gacc/top.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/tr-path-connection.cert : acl2x = 0
-coi/gacc/tr-path-connection.cert : no_pcert = 0
-
-coi/gacc/tr-path-connection.cert : \
-     coi/gacc/mem.cert \
-     coi/paths/path.cert \
-     coi/records/domain.cert \
-     coi/osets/conversions.cert \
-     coi/osets/quantify.cert \
-     coi/gacc/tr-path-connection.lisp \
-     coi/gacc/tr-path-connection.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/gacc/wrap.cert : acl2x = 0
-coi/gacc/wrap.cert : no_pcert = 0
-
-coi/gacc/wrap.cert : \
-     coi/bags/basic.cert \
-     coi/super-ihs/super-ihs.cert \
-     coi/gacc/addr-range.cert \
-     coi/lists/mixed.cert \
-     coi/lists/find-index.cert \
-     coi/util/syntaxp.cert \
-     coi/gacc/wrap.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-
-
-coi/generalize/generalize.cert : acl2x = 0
-coi/generalize/generalize.cert : no_pcert = 0
-
-coi/generalize/generalize.cert : \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/util/mv-nth.cert \
-     coi/gensym/gensym.cert \
-     coi/bags/top.cert \
-     coi/lists/set.cert \
-     coi/util/clause-processor.cert \
-     coi/generalize/generalize.lisp \
-     coi/generalize/cert.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/gensym/gensym-list.cert : acl2x = 0
-coi/gensym/gensym-list.cert : no_pcert = 0
-
-coi/gensym/gensym-list.cert : \
-     coi/gensym/gensym.cert \
-     coi/lists/disjoint.cert \
-     coi/bags/basic.cert \
-     coi/gensym/gensym-list.lisp \
-     coi/gensym/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/gensym/gensym.cert : acl2x = 0
-coi/gensym/gensym.cert : no_pcert = 0
-
-coi/gensym/gensym.cert : \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/util/ordinal-order.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     coi/bags/top.cert \
-     coi/lists/set.cert \
-     coi/lists/memberp.cert \
-     coi/gensym/gensym.lisp \
-     coi/gensym/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/lists/acl2-count.cert : acl2x = 0
-coi/lists/acl2-count.cert : no_pcert = 0
-
-coi/lists/acl2-count.cert : \
-     coi/lists/acl2-count.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/basic.cert : acl2x = 0
-coi/lists/basic.cert : no_pcert = 0
-
-coi/lists/basic.cert : \
-     arithmetic/top-with-meta.cert \
-     coi/util/debug.cert \
-     coi/lists/acl2-count.cert \
-     coi/util/iff.cert \
-     coi/adviser/adviser.cert \
-     coi/lists/basic.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/disjoint.cert : acl2x = 0
-coi/lists/disjoint.cert : no_pcert = 0
-
-coi/lists/disjoint.cert : \
-     coi/lists/memberp.cert \
-     coi/util/iff.cert \
-     coi/lists/remove.cert \
-     coi/lists/disjoint.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/find-index.cert : acl2x = 0
-coi/lists/find-index.cert : no_pcert = 0
-
-coi/lists/find-index.cert : \
-     coi/lists/nth-and-update-nth.cert \
-     coi/lists/memberp.cert \
-     coi/util/iff.cert \
-     coi/lists/find-index.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/list-top.cert : acl2x = 0
-coi/lists/list-top.cert : no_pcert = 0
-
-coi/lists/list-top.cert : \
-     coi/lists/basic.cert \
-     coi/lists/memberp.cert \
-     coi/lists/map-cons.cert \
-     coi/lists/repeat.cert \
-     coi/lists/nth-and-update-nth.cert \
-     coi/lists/update-nth-array.cert \
-     coi/lists/list-top.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/listset-induction.cert : acl2x = 0
-coi/lists/listset-induction.cert : no_pcert = 0
-
-coi/lists/listset-induction.cert : \
-     coi/lists/subsetp.cert \
-     coi/lists/remove.cert \
-     coi/lists/set.cert \
-     coi/lists/listset-induction.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/map-cons.cert : acl2x = 0
-coi/lists/map-cons.cert : no_pcert = 0
-
-coi/lists/map-cons.cert : \
-     coi/lists/basic.cert \
-     coi/lists/memberp.cert \
-     coi/util/iff.cert \
-     coi/lists/map-cons.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/memberp.cert : acl2x = 0
-coi/lists/memberp.cert : no_pcert = 0
-
-coi/lists/memberp.cert : \
-     coi/lists/basic.cert \
-     coi/lists/memberp.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/mixed.cert : acl2x = 0
-coi/lists/mixed.cert : no_pcert = 0
-
-coi/lists/mixed.cert : \
-     coi/lists/repeat.cert \
-     coi/lists/memberp.cert \
-     coi/lists/mixed.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/mv-nth.cert : acl2x = 0
-coi/lists/mv-nth.cert : no_pcert = 0
-
-coi/lists/mv-nth.cert : \
-     coi/lists/mv-nth.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/nth-and-update-nth.cert : acl2x = 0
-coi/lists/nth-and-update-nth.cert : no_pcert = 0
-
-coi/lists/nth-and-update-nth.cert : \
-     coi/lists/basic.cert \
-     coi/lists/repeat.cert \
-     arithmetic/top-with-meta.cert \
-     coi/lists/nth-and-update-nth.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/nth-meta.cert : acl2x = 0
-coi/lists/nth-meta.cert : no_pcert = 0
-
-coi/lists/nth-meta.cert : \
-     coi/lists/nth-meta.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/nth-meta2.cert : acl2x = 0
-coi/lists/nth-meta2.cert : no_pcert = 0
-
-coi/lists/nth-meta2.cert : \
-     coi/lists/nth-meta2.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/remove-induction.cert : acl2x = 0
-coi/lists/remove-induction.cert : no_pcert = 0
-
-coi/lists/remove-induction.cert : \
-     coi/lists/remove.cert \
-     coi/lists/remove-induction.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/remove.cert : acl2x = 0
-coi/lists/remove.cert : no_pcert = 0
-
-coi/lists/remove.cert : \
-     coi/lists/subsetp.cert \
-     coi/lists/remove.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/repeat.cert : acl2x = 0
-coi/lists/repeat.cert : no_pcert = 0
-
-coi/lists/repeat.cert : \
-     coi/lists/basic.cert \
-     coi/lists/repeat.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/set.cert : acl2x = 0
-coi/lists/set.cert : no_pcert = 0
-
-coi/lists/set.cert : \
-     coi/lists/remove.cert \
-     coi/lists/disjoint.cert \
-     coi/util/defbinding.cert \
-     coi/util/iff.cert \
-     coi/lists/remove-induction.cert \
-     coi/lists/remove-induction.cert \
-     coi/lists/set.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/subsetp.cert : acl2x = 0
-coi/lists/subsetp.cert : no_pcert = 0
-
-coi/lists/subsetp.cert : \
-     coi/adviser/adviser.cert \
-     coi/lists/memberp.cert \
-     coi/lists/subsetp.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/lists/update-nth-array.cert : acl2x = 0
-coi/lists/update-nth-array.cert : no_pcert = 0
-
-coi/lists/update-nth-array.cert : \
-     coi/lists/nth-and-update-nth.cert \
-     arithmetic/top-with-meta.cert \
-     coi/lists/update-nth-array.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/maps/aliases.cert : acl2x = 0
-coi/maps/aliases.cert : no_pcert = 0
-
-coi/maps/aliases.cert : \
-     coi/maps/maps.cert \
-     coi/maps/aliases.lisp \
-     coi/maps/cert.acl2 \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/maps/maps.cert : acl2x = 0
-coi/maps/maps.cert : no_pcert = 0
-
-coi/maps/maps.cert : \
-     coi/osets/sets.cert \
-     coi/adviser/adviser.cert \
-     misc/untranslate-patterns.cert \
-     coi/maps/maps.lisp \
-     coi/maps/cert.acl2 \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/maps/typed-maps.cert : acl2x = 0
-coi/maps/typed-maps.cert : no_pcert = 0
-
-coi/maps/typed-maps.cert : \
-     coi/maps/maps.cert \
-     coi/maps/typed-maps.lisp \
-     coi/maps/cert.acl2 \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/nary/example.cert : acl2x = 0
-coi/nary/example.cert : no_pcert = 0
-
-coi/nary/example.cert : \
-     coi/nary/nary.cert \
-     ihs/ihs-definitions.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     ihs/ihs-lemmas.cert \
-     ihs/ihs-lemmas.cert \
-     coi/nary/nth-rules.cert \
-     coi/nary/example.lisp \
-     coi/nary/cert.acl2
-
-
-coi/nary/nary.cert : acl2x = 0
-coi/nary/nary.cert : no_pcert = 0
-
-coi/nary/nary.cert : \
-     coi/util/in-conclusion.cert \
-     coi/util/implies.cert \
-     coi/nary/nary.lisp \
-     coi/nary/cert.acl2
-
-
-coi/nary/nth-rules.cert : acl2x = 0
-coi/nary/nth-rules.cert : no_pcert = 0
-
-coi/nary/nth-rules.cert : \
-     coi/nary/nth-rules.lisp \
-     coi/nary/cert.acl2
-
-
-coi/nary/ordinal-order.cert : acl2x = 0
-coi/nary/ordinal-order.cert : no_pcert = 0
-
-coi/nary/ordinal-order.cert : \
-     ordinals/lexicographic-ordering.cert \
-     coi/nary/ordinal-order.lisp \
-     coi/nary/cert.acl2
-
-
-coi/nary/rewrite-equal-hint.cert : acl2x = 0
-coi/nary/rewrite-equal-hint.cert : no_pcert = 0
-
-coi/nary/rewrite-equal-hint.cert : \
-     coi/nary/rewrite-equal-hint.lisp \
-     coi/nary/cert.acl2
-
-
-coi/osets/computed-hints.cert : acl2x = 0
-coi/osets/computed-hints.cert : no_pcert = 0
-
-coi/osets/computed-hints.cert : \
-     coi/osets/instance.cert \
-     coi/osets/computed-hints.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/conversions.cert : acl2x = 0
-coi/osets/conversions.cert : no_pcert = 0
-
-coi/osets/conversions.cert : \
-     coi/osets/sets.cert \
-     coi/lists/set.cert \
-     coi/osets/conversions.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/extras.cert : acl2x = 0
-coi/osets/extras.cert : no_pcert = 0
-
-coi/osets/extras.cert : \
-     coi/osets/sets.cert \
-     coi/osets/set-order.cert \
-     coi/osets/conversions.cert \
-     coi/util/iff.cert \
-     misc/total-order.cert \
-     coi/osets/extras.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/fast.cert : acl2x = 0
-coi/osets/fast.cert : no_pcert = 0
-
-coi/osets/fast.cert : \
-     coi/osets/membership.cert \
-     coi/osets/fast.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/instance.cert : acl2x = 0
-coi/osets/instance.cert : no_pcert = 0
-
-coi/osets/instance.cert : \
-     coi/osets/instance.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/listsets.cert : acl2x = 0
-coi/osets/listsets.cert : no_pcert = 0
-
-coi/osets/listsets.cert : \
-     misc/untranslate-patterns.cert \
-     coi/lists/basic.cert \
-     coi/lists/memberp.cert \
-     coi/osets/map.cert \
-     coi/osets/listsets.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/map.cert : acl2x = 0
-coi/osets/map.cert : no_pcert = 0
-
-coi/osets/map.cert : \
-     coi/osets/quantify.cert \
-     coi/osets/map.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/membership.cert : acl2x = 0
-coi/osets/membership.cert : no_pcert = 0
-
-coi/osets/membership.cert : \
-     coi/osets/primitives.cert \
-     coi/osets/computed-hints.cert \
-     coi/osets/membership.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/multiappend.cert : acl2x = 0
-coi/osets/multiappend.cert : no_pcert = 0
-
-coi/osets/multiappend.cert : \
-     coi/osets/multicons.cert \
-     coi/util/iff.cert \
-     arithmetic/top-with-meta.cert \
-     coi/osets/multiappend.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/multicons.cert : acl2x = 0
-coi/osets/multicons.cert : no_pcert = 0
-
-coi/osets/multicons.cert : \
-     coi/osets/sets.cert \
-     coi/osets/listsets.cert \
-     coi/osets/multicons.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/outer.cert : acl2x = 0
-coi/osets/outer.cert : no_pcert = 0
-
-coi/osets/outer.cert : \
-     coi/osets/fast.cert \
-     coi/osets/outer.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/primitives.cert : acl2x = 0
-coi/osets/primitives.cert : no_pcert = 0
-
-coi/osets/primitives.cert : \
-     misc/total-order.cert \
-     coi/osets/primitives.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/quantify.cert : acl2x = 0
-coi/osets/quantify.cert : no_pcert = 0
-
-coi/osets/quantify.cert : \
-     coi/osets/sets.cert \
-     coi/osets/quantify.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/set-order.cert : acl2x = 0
-coi/osets/set-order.cert : no_pcert = 0
-
-coi/osets/set-order.cert : \
-     coi/osets/primitives.cert \
-     coi/osets/membership.cert \
-     coi/osets/fast.cert \
-     coi/osets/sets.cert \
-     misc/total-order.cert \
-     coi/osets/set-order.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/set-processor.cert : acl2x = 0
-coi/osets/set-processor.cert : no_pcert = 0
-
-coi/osets/set-processor.cert : \
-     coi/osets/sets.cert \
-     coi/osets/set-processor.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/sets.cert : acl2x = 0
-coi/osets/sets.cert : no_pcert = 0
-
-coi/osets/sets.cert : \
-     coi/osets/computed-hints.cert \
-     coi/osets/primitives.cert \
-     coi/osets/membership.cert \
-     coi/osets/fast.cert \
-     coi/osets/outer.cert \
-     coi/osets/sort.cert \
-     misc/total-order.cert \
-     coi/osets/sets.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/osets/sort.cert : acl2x = 0
-coi/osets/sort.cert : no_pcert = 0
-
-coi/osets/sort.cert : \
-     coi/osets/outer.cert \
-     coi/osets/sort.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/paths/compatibility.cert : acl2x = 0
-coi/paths/compatibility.cert : no_pcert = 0
-
-coi/paths/compatibility.cert : \
-     coi/alists/top.cert \
-     coi/paths/compatibility.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/cp-set.cert : acl2x = 0
-coi/paths/cp-set.cert : no_pcert = 0
-
-coi/paths/cp-set.cert : \
-     coi/osets/multicons.cert \
-     coi/paths/hints.cert \
-     arithmetic/top-with-meta.cert \
-     coi/osets/multiappend.cert \
-     coi/paths/cp-set.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/defs.cert : acl2x = 0
-coi/paths/defs.cert : no_pcert = 0
-
-coi/paths/defs.cert : \
-     coi/lists/basic.cert \
-     coi/paths/defs.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/diverge.cert : acl2x = 0
-coi/paths/diverge.cert : no_pcert = 0
-
-coi/paths/diverge.cert : \
-     coi/paths/dominates.cert \
-     coi/bags/basic.cert \
-     coi/util/iff.cert \
-     coi/paths/diverge.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/dominates.cert : acl2x = 0
-coi/paths/dominates.cert : no_pcert = 0
-
-coi/paths/dominates.cert : \
-     coi/lists/basic.cert \
-     coi/lists/memberp.cert \
-     coi/bags/basic.cert \
-     coi/adviser/adviser.cert \
-     arithmetic/top-with-meta.cert \
-     coi/util/iff.cert \
-     coi/paths/dominates.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/equiv.cert : acl2x = 0
-coi/paths/equiv.cert : no_pcert = 0
-
-coi/paths/equiv.cert : \
-     coi/util/iff.cert \
-     coi/paths/path.cert \
-     coi/paths/equiv.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/hints.cert : acl2x = 0
-coi/paths/hints.cert : no_pcert = 0
-
-coi/paths/hints.cert : \
-     coi/paths/pm.cert \
-     coi/util/iff.cert \
-     coi/paths/hints.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/list-path-connection.cert : acl2x = 0
-coi/paths/list-path-connection.cert : no_pcert = 0
-
-coi/paths/list-path-connection.cert : \
-     coi/records/domain.cert \
-     coi/bags/extras.cert \
-     arithmetic/top-with-meta.cert \
-     coi/paths/path.cert \
-     coi/paths/list-path-connection.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/meta.cert : acl2x = 0
-coi/paths/meta.cert : no_pcert = 0
-
-coi/paths/meta.cert : \
-     coi/lists/basic.cert \
-     coi/lists/map-cons.cert \
-     coi/syntax/syntax.cert \
-     coi/util/mv-nth.cert \
-     coi/util/iff.cert \
-     coi/paths/path.cert \
-     coi/paths/meta.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/path.cert : acl2x = 0
-coi/paths/path.cert : no_pcert = 0
-
-coi/paths/path.cert : \
-     coi/lists/repeat.cert \
-     coi/bags/top.cert \
-     coi/alists/top.cert \
-     coi/records/records.cert \
-     coi/records/domain.cert \
-     coi/paths/compatibility.cert \
-     coi/paths/dominates.cert \
-     coi/paths/diverge.cert \
-     arithmetic/top-with-meta.cert \
-     coi/util/iff.cert \
-     coi/util/syntaxp.cert \
-     coi/paths/path.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/paths/pm.cert : acl2x = 0
-coi/paths/pm.cert : no_pcert = 0
-
-coi/paths/pm.cert : \
-     coi/paths/meta.cert \
-     arithmetic/top-with-meta.cert \
-     coi/paths/equiv.cert \
-     coi/paths/pm.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-
-
-coi/quantification/quantification.cert : acl2x = 0
-coi/quantification/quantification.cert : no_pcert = 0
-
-coi/quantification/quantification.cert : \
-     misc/records.cert \
-     misc/bash.cert \
-     coi/generalize/generalize.cert \
-     coi/util/mv-nth.cert \
-     coi/util/table.cert \
-     coi/util/skip-rewrite.cert \
-     coi/util/in-conclusion.cert \
-     coi/quantification/quantification.lisp \
-     coi/quantification/quantification.acl2 \
-     coi/quantification/cert.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/util/table-defpkg.lsp \
-     coi/quantification/quant-defpkg.lsp
-
-
-coi/records/defarray.cert : acl2x = 0
-coi/records/defarray.cert : no_pcert = 0
-
-coi/records/defarray.cert : \
-     coi/records/records.cert \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/records/defarray.lisp \
-     coi/records/defarray.acl2 \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-
-
-coi/records/defrecord-fast.cert : acl2x = 0
-coi/records/defrecord-fast.cert : no_pcert = 0
-
-coi/records/defrecord-fast.cert : \
-     coi/records/memory.cert \
-     coi/records/records.cert \
-     data-structures/memories/memory.cert \
-     coi/records/defrecord-fast.lisp \
-     coi/records/defrecord-fast.acl2 \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/records/defrecord.cert : acl2x = 0
-coi/records/defrecord.cert : no_pcert = 0
-
-coi/records/defrecord.cert : \
-     coi/records/records.cert \
-     coi/records/defrecord.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/records/domain.cert : acl2x = 0
-coi/records/domain.cert : no_pcert = 0
-
-coi/records/domain.cert : \
-     coi/alists/keyquiv.cert \
-     coi/records/records.cert \
-     coi/bags/basic.cert \
-     coi/bags/pick-a-point.cert \
-     coi/records/records.cert \
-     coi/records/domain.lisp \
-     coi/records/domain.acl2 \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-
-
-coi/records/fixedpoint.cert : acl2x = 0
-coi/records/fixedpoint.cert : no_pcert = 0
-
-coi/records/fixedpoint.cert : \
-     coi/records/domain.cert \
-     coi/util/rule-sets.cert \
-     coi/records/domain.cert \
-     coi/records/fixedpoint.lisp \
-     coi/records/fixedpoint.acl2 \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp
-
-
-coi/records/mem-domain.cert : acl2x = 0
-coi/records/mem-domain.cert : no_pcert = 0
-
-coi/records/mem-domain.cert : \
-     coi/records/memory.cert \
-     coi/records/domain.cert \
-     coi/osets/conversions.cert \
-     coi/osets/extras.cert \
-     coi/osets/map.cert \
-     coi/bags/basic.cert \
-     coi/util/iff.cert \
-     coi/osets/set-processor.cert \
-     data-structures/memories/log2.cert \
-     coi/records/set-domain.cert \
-     data-structures/memories/memory-impl.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/arithmetic/top.cert \
-     coi/records/mem-domain.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/records/memory.cert : acl2x = 0
-coi/records/memory.cert : no_pcert = 0
-
-coi/records/memory.cert : \
-     data-structures/memories/memory.cert \
-     coi/records/memory.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/records/record-exports.cert : acl2x = 0
-coi/records/record-exports.cert : no_pcert = 0
-
-coi/records/record-exports.cert : \
-     coi/records/record-exports.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/records/records.cert : acl2x = 0
-coi/records/records.cert : no_pcert = 0
-
-coi/records/records.cert : \
-     coi/lists/basic.cert \
-     misc/records.cert \
-     coi/records/records.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/records/set-domain.cert : acl2x = 0
-coi/records/set-domain.cert : no_pcert = 0
-
-coi/records/set-domain.cert : \
-     coi/records/domain.cert \
-     coi/osets/sets.cert \
-     coi/osets/extras.cert \
-     coi/records/records.cert \
-     coi/osets/sets.cert \
-     coi/osets/map.cert \
-     coi/osets/extras.cert \
-     coi/records/set-domain.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-
-
-coi/super-ihs/arithmetic.cert : acl2x = 0
-coi/super-ihs/arithmetic.cert : no_pcert = 0
-
-coi/super-ihs/arithmetic.cert : \
-     ihs/quotient-remainder-lemmas.cert \
-     ihs/math-lemmas.cert \
-     coi/super-ihs/eric.cert \
-     coi/super-ihs/from-rtl.cert \
-     rtl/rel4/arithmetic/floor.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     coi/super-ihs/arithmetic.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/ash.cert : acl2x = 0
-coi/super-ihs/ash.cert : no_pcert = 0
-
-coi/super-ihs/ash.cert : \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/evenp.cert \
-     coi/super-ihs/ash.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/basics.cert : acl2x = 0
-coi/super-ihs/basics.cert : no_pcert = 0
-
-coi/super-ihs/basics.cert : \
-     coi/super-ihs/inductions.cert \
-     coi/super-ihs/evenp.cert \
-     coi/super-ihs/bit-functions.cert \
-     coi/super-ihs/from-rtl.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/loghead.cert \
-     coi/super-ihs/logext.cert \
-     coi/super-ihs/logcar.cert \
-     coi/super-ihs/ash.cert \
-     coi/super-ihs/basics.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/bit-functions.cert : acl2x = 0
-coi/super-ihs/bit-functions.cert : no_pcert = 0
-
-coi/super-ihs/bit-functions.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/bit-functions.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/bit-twiddling-logops.cert : acl2x = 0
-coi/super-ihs/bit-twiddling-logops.cert : no_pcert = 0
-
-coi/super-ihs/bit-twiddling-logops.cert : \
-     coi/super-ihs/logical-logops.cert \
-     coi/super-ihs/bit-twiddling-logops.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/byte-p.cert : acl2x = 0
-coi/super-ihs/byte-p.cert : no_pcert = 0
-
-coi/super-ihs/byte-p.cert : \
-     coi/super-ihs/logpair.cert \
-     coi/super-ihs/byte-p.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/c-functions.cert : acl2x = 0
-coi/super-ihs/c-functions.cert : no_pcert = 0
-
-coi/super-ihs/c-functions.cert : \
-     coi/super-ihs/hacks.cert \
-     coi/super-ihs/c-functions.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/carry.cert : acl2x = 0
-coi/super-ihs/carry.cert : no_pcert = 0
-
-coi/super-ihs/carry.cert : \
-     coi/super-ihs/super-ihs.cert \
-     coi/super-ihs/carry.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/eric.cert : acl2x = 0
-coi/super-ihs/eric.cert : no_pcert = 0
-
-coi/super-ihs/eric.cert : \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/top.cert \
-     coi/super-ihs/eric.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/evenp.cert : acl2x = 0
-coi/super-ihs/evenp.cert : no_pcert = 0
-
-coi/super-ihs/evenp.cert : \
-     coi/super-ihs/arithmetic.cert \
-     rtl/rel4/arithmetic/even-odd.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     coi/super-ihs/evenp.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/fast.cert : acl2x = 0
-coi/super-ihs/fast.cert : no_pcert = 0
-
-coi/super-ihs/fast.cert : \
-     coi/super-ihs/super-ihs.cert \
-     coi/super-ihs/fast.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/from-rtl.cert : acl2x = 0
-coi/super-ihs/from-rtl.cert : no_pcert = 0
-
-coi/super-ihs/from-rtl.cert : \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/logxor.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/top.cert \
-     coi/super-ihs/from-rtl.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/hacks.cert : acl2x = 0
-coi/super-ihs/hacks.cert : no_pcert = 0
-
-coi/super-ihs/hacks.cert : \
-     coi/super-ihs/bit-twiddling-logops.cert \
-     coi/super-ihs/eric.cert \
-     coi/super-ihs/hacks.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/inductions.cert : acl2x = 0
-coi/super-ihs/inductions.cert : no_pcert = 0
-
-coi/super-ihs/inductions.cert : \
-     coi/super-ihs/arithmetic.cert \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/inductions.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/iter-sqrt.cert : acl2x = 0
-coi/super-ihs/iter-sqrt.cert : no_pcert = 0
-
-coi/super-ihs/iter-sqrt.cert : \
-     coi/super-ihs/arithmetic.cert \
-     arithmetic/top-with-meta.cert \
-     coi/super-ihs/iter-sqrt.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logapp.cert : acl2x = 0
-coi/super-ihs/logapp.cert : no_pcert = 0
-
-coi/super-ihs/logapp.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/logapp.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logbit.cert : acl2x = 0
-coi/super-ihs/logbit.cert : no_pcert = 0
-
-coi/super-ihs/logbit.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/logbit.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logbitp.cert : acl2x = 0
-coi/super-ihs/logbitp.cert : no_pcert = 0
-
-coi/super-ihs/logbitp.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/logbitp.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logcar.cert : acl2x = 0
-coi/super-ihs/logcar.cert : no_pcert = 0
-
-coi/super-ihs/logcar.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/evenp.cert \
-     coi/super-ihs/logcar.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logcdr.cert : acl2x = 0
-coi/super-ihs/logcdr.cert : no_pcert = 0
-
-coi/super-ihs/logcdr.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/evenp.cert \
-     coi/super-ihs/unsigned-byte-p.cert \
-     coi/super-ihs/ash.cert \
-     coi/super-ihs/logcdr.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logcons.cert : acl2x = 0
-coi/super-ihs/logcons.cert : no_pcert = 0
-
-coi/super-ihs/logcons.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/evenp.cert \
-     coi/super-ihs/logcons.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logext.cert : acl2x = 0
-coi/super-ihs/logext.cert : no_pcert = 0
-
-coi/super-ihs/logext.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/logbitp.cert \
-     coi/super-ihs/logapp.cert \
-     coi/super-ihs/loghead.cert \
-     coi/super-ihs/logext.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/loghead.cert : acl2x = 0
-coi/super-ihs/loghead.cert : no_pcert = 0
-
-coi/super-ihs/loghead.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/ash.cert \
-     coi/super-ihs/unsigned-byte-p.cert \
-     coi/super-ihs/logcar.cert \
-     coi/super-ihs/logcdr.cert \
-     coi/super-ihs/logcons.cert \
-     coi/super-ihs/inductions.cert \
-     coi/util/syntaxp.cert \
-     coi/super-ihs/loghead.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logical-logops.cert : acl2x = 0
-coi/super-ihs/logical-logops.cert : no_pcert = 0
-
-coi/super-ihs/logical-logops.cert : \
-     coi/super-ihs/loglist.cert \
-     coi/super-ihs/logext.cert \
-     coi/super-ihs/logical-logops.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logior-logapp-crock.cert : acl2x = 0
-coi/super-ihs/logior-logapp-crock.cert : no_pcert = 0
-
-coi/super-ihs/logior-logapp-crock.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     coi/super-ihs/logior-logapp-crock.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/loglist.cert : acl2x = 0
-coi/super-ihs/loglist.cert : no_pcert = 0
-
-coi/super-ihs/loglist.cert : \
-     coi/super-ihs/byte-p.cert \
-     coi/super-ihs/logapp.cert \
-     coi/super-ihs/loglist.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logpair.cert : acl2x = 0
-coi/super-ihs/logpair.cert : no_pcert = 0
-
-coi/super-ihs/logpair.cert : \
-     coi/super-ihs/basics.cert \
-     coi/super-ihs/loghead.cert \
-     coi/super-ihs/logtail.cert \
-     coi/super-ihs/logcons.cert \
-     coi/super-ihs/logcdr.cert \
-     coi/super-ihs/logtail.cert \
-     coi/super-ihs/logbitp.cert \
-     coi/super-ihs/logbit.cert \
-     coi/super-ihs/unsigned-byte-p.cert \
-     coi/super-ihs/logpair.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/logtail.cert : acl2x = 0
-coi/super-ihs/logtail.cert : no_pcert = 0
-
-coi/super-ihs/logtail.cert : \
-     coi/super-ihs/arithmetic.cert \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/ash.cert \
-     coi/super-ihs/logtail.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/lshu.cert : acl2x = 0
-coi/super-ihs/lshu.cert : no_pcert = 0
-
-coi/super-ihs/lshu.cert : \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/hacks.cert \
-     coi/super-ihs/lshu.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/meta.cert : acl2x = 0
-coi/super-ihs/meta.cert : no_pcert = 0
-
-coi/super-ihs/meta.cert : \
-     coi/super-ihs/loghead.cert \
-     coi/super-ihs/arithmetic.cert \
-     coi/super-ihs/meta.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/min-max.cert : acl2x = 0
-coi/super-ihs/min-max.cert : no_pcert = 0
-
-coi/super-ihs/min-max.cert : \
-     coi/super-ihs/min-max.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/plus-logapp-suck.cert : acl2x = 0
-coi/super-ihs/plus-logapp-suck.cert : no_pcert = 0
-
-coi/super-ihs/plus-logapp-suck.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/plus-logapp-suck.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/signed-byte-p-overflow.cert : acl2x = 0
-coi/super-ihs/signed-byte-p-overflow.cert : no_pcert = 0
-
-coi/super-ihs/signed-byte-p-overflow.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/signed-byte-p-overflow.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/super-ihs.cert : acl2x = 0
-coi/super-ihs/super-ihs.cert : no_pcert = 0
-
-coi/super-ihs/super-ihs.cert : \
-     coi/super-ihs/hacks.cert \
-     coi/super-ihs/eric.cert \
-     coi/super-ihs/c-functions.cert \
-     coi/super-ihs/lshu.cert \
-     coi/super-ihs/min-max.cert \
-     coi/super-ihs/meta.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     arithmetic/top-with-meta.cert \
-     coi/super-ihs/super-ihs.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/super-ihs/unsigned-byte-p.cert : acl2x = 0
-coi/super-ihs/unsigned-byte-p.cert : no_pcert = 0
-
-coi/super-ihs/unsigned-byte-p.cert : \
-     coi/super-ihs/arithmetic.cert \
-     ihs/ihs-lemmas.cert \
-     coi/super-ihs/eric.cert \
-     coi/super-ihs/unsigned-byte-p.lisp \
-     coi/super-ihs/cert.acl2
-
-
-coi/symbol-fns/symbol-fns-exports.cert : acl2x = 0
-coi/symbol-fns/symbol-fns-exports.cert : no_pcert = 0
-
-coi/symbol-fns/symbol-fns-exports.cert : \
-     coi/symbol-fns/symbol-fns-exports.lisp \
-     coi/symbol-fns/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/symbol-fns/symbol-fns.cert : acl2x = 0
-coi/symbol-fns/symbol-fns.cert : no_pcert = 0
-
-coi/symbol-fns/symbol-fns.cert : \
-     coi/symbol-fns/symbol-fns.lisp \
-     coi/symbol-fns/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/syntax/auxilary.cert : acl2x = 0
-coi/syntax/auxilary.cert : no_pcert = 0
-
-coi/syntax/auxilary.cert : \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/syntax/auxilary.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/syntax/defbinding.cert : acl2x = 0
-coi/syntax/defbinding.cert : no_pcert = 0
-
-coi/syntax/defbinding.cert : \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/syntax/defbinding.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/syntax/defevaluator.cert : acl2x = 0
-coi/syntax/defevaluator.cert : no_pcert = 0
-
-coi/syntax/defevaluator.cert : \
-     coi/syntax/defevaluator.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/syntax/quine.cert : acl2x = 0
-coi/syntax/quine.cert : no_pcert = 0
-
-coi/syntax/quine.cert : \
-     coi/syntax/syntax.cert \
-     coi/syntax/quine.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/syntax/syn-pkg.cert : acl2x = 0
-coi/syntax/syn-pkg.cert : no_pcert = 0
-
-coi/syntax/syn-pkg.cert : \
-     coi/syntax/syn-pkg.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/syntax/syntax-extensions.cert : acl2x = 0
-coi/syntax/syntax-extensions.cert : no_pcert = 0
-
-coi/syntax/syntax-extensions.cert : \
-     coi/syntax/auxilary.cert \
-     coi/util/mv-nth.cert \
-     coi/syntax/syntax-extensions.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/syntax/syntax.cert : acl2x = 0
-coi/syntax/syntax.cert : no_pcert = 0
-
-coi/syntax/syntax.cert : \
-     coi/syntax/syntax-extensions.cert \
-     coi/syntax/defevaluator.cert \
-     coi/syntax/syntax.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/termination/assuming/compiler-proof.cert : acl2x = 0
-coi/termination/assuming/compiler-proof.cert : no_pcert = 0
-
-coi/termination/assuming/compiler-proof.cert : \
-     coi/defpun/defminterm.cert \
-     coi/defpun/ack.cert \
-     coi/nary/nary.cert \
-     coi/util/mv-nth.cert \
-     coi/termination/assuming/compiler-proof.lisp \
-     coi/termination/assuming/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/util/def-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-
-
-coi/termination/assuming/compiler.cert : acl2x = 0
-coi/termination/assuming/compiler.cert : no_pcert = 0
-
-coi/termination/assuming/compiler.cert : \
-     coi/syntax/syntax.cert \
-     coi/util/mv-nth.cert \
-     coi/termination/assuming/compiler-proof.cert \
-     make-event/eval.cert \
-     coi/util/pseudo-translate.cert \
-     coi/util/recursion-support.cert \
-     arithmetic/top-with-meta.cert \
-     coi/termination/assuming/compiler.lisp \
-     coi/termination/assuming/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/util/def-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-
-
-coi/termination/assuming/zero.cert : acl2x = 0
-coi/termination/assuming/zero.cert : no_pcert = 0
-
-coi/termination/assuming/zero.cert : \
-     coi/termination/assuming/compiler.cert \
-     ordinals/lexicographic-ordering.cert \
-     coi/termination/assuming/zero.lisp \
-     coi/termination/assuming/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/util/def-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-
-
-coi/util/clause-processor.cert : acl2x = 0
-coi/util/clause-processor.cert : no_pcert = 0
-
-coi/util/clause-processor.cert : \
-     coi/util/clause-processor.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/debug.cert : acl2x = 0
-coi/util/debug.cert : no_pcert = 0
-
-coi/util/debug.cert : \
-     coi/util/defdoc.cert \
-     coi/util/debug.lisp \
-     coi/util/debug.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/util/debug-defpkg.lsp
-
-
-coi/util/defbinding.cert : acl2x = 0
-coi/util/defbinding.cert : no_pcert = 0
-
-coi/util/defbinding.cert : \
-     coi/util/defbinding.lisp \
-     coi/util/defbinding.acl2 \
-     coi/util/def-defpkg.lsp
-
-
-coi/util/defdoc.cert : acl2x = 0
-coi/util/defdoc.cert : no_pcert = 0
-
-coi/util/defdoc.cert : \
-     coi/util/defdoc.lisp \
-     coi/util/defdoc.acl2 \
-     coi/util/def-defpkg.lsp
-
-
-coi/util/deffix.cert : acl2x = 0
-coi/util/deffix.cert : no_pcert = 0
-
-coi/util/deffix.cert : \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/util/deffix.lisp \
-     coi/util/deffix.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/util/defsubtype.cert : acl2x = 0
-coi/util/defsubtype.cert : no_pcert = 0
-
-coi/util/defsubtype.cert : \
-     coi/util/rule-sets.cert \
-     coi/util/mv-nth.cert \
-     coi/util/defun-support.cert \
-     coi/util/rule-sets.cert \
-     coi/util/defsubtype.lisp \
-     coi/util/defsubtype.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-
-
-coi/util/defun-support.cert : acl2x = 0
-coi/util/defun-support.cert : no_pcert = 0
-
-coi/util/defun-support.cert : \
-     misc/beta-reduce.cert \
-     coi/util/debug.cert \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/util/mv-nth.cert \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/util/defun-support.lisp \
-     coi/util/defun-support.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/defun-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/util/defun.cert : acl2x = 0
-coi/util/defun.cert : no_pcert = 0
-
-coi/util/defun.cert : \
-     coi/util/recursion-support.cert \
-     coi/util/pseudo-translate.cert \
-     coi/util/mv-nth.cert \
-     coi/util/defun.lisp \
-     coi/util/defun.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/defun-defpkg.lsp \
-     coi/util/def-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-
-
-coi/util/extra-info-test.cert : acl2x = 0
-coi/util/extra-info-test.cert : no_pcert = 0
-
-coi/util/extra-info-test.cert : \
-     coi/util/extra-info.cert \
-     make-event/eval.cert \
-     coi/util/extra-info-test.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/extra-info.cert : acl2x = 0
-coi/util/extra-info.cert : no_pcert = 0
-
-coi/util/extra-info.cert : \
-     coi/util/in-conclusion.cert \
-     coi/util/extra-info.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/fixequiv.cert : acl2x = 0
-coi/util/fixequiv.cert : no_pcert = 0
-
-coi/util/fixequiv.cert : \
-     coi/util/fixequiv.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/good-rewrite-order.cert : acl2x = 0
-coi/util/good-rewrite-order.cert : no_pcert = 0
-
-coi/util/good-rewrite-order.cert : \
-     coi/util/syntaxp.cert \
-     misc/total-order.cert \
-     coi/util/good-rewrite-order.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/ifdef.cert : acl2x = 0
-coi/util/ifdef.cert : no_pcert = 0
-
-coi/util/ifdef.cert : \
-     coi/util/defdoc.cert \
-     coi/util/ifdef.lisp \
-     coi/util/ifdef.acl2 \
-     coi/util/def-defpkg.lsp
-
-
-coi/util/iff.cert : acl2x = 0
-coi/util/iff.cert : no_pcert = 0
-
-coi/util/iff.cert : \
-     coi/util/iff.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/ifixequiv.cert : acl2x = 0
-coi/util/ifixequiv.cert : no_pcert = 0
-
-coi/util/ifixequiv.cert : \
-     coi/util/fixequiv.cert \
-     coi/util/ifixequiv.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/implies.cert : acl2x = 0
-coi/util/implies.cert : no_pcert = 0
-
-coi/util/implies.cert : \
-     coi/util/in-conclusion.cert \
-     coi/util/implies.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/in-conclusion.cert : acl2x = 0
-coi/util/in-conclusion.cert : no_pcert = 0
-
-coi/util/in-conclusion.cert : \
-     coi/util/in-conclusion.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/ith.cert : acl2x = 0
-coi/util/ith.cert : no_pcert = 0
-
-coi/util/ith.cert : \
-     coi/util/ith.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/mv-nth.cert : acl2x = 0
-coi/util/mv-nth.cert : no_pcert = 0
-
-coi/util/mv-nth.cert : \
-     coi/util/mv-nth.lisp \
-     coi/util/mv-nth.acl2 \
-     coi/util/gensym-defpkg.lsp
-
-
-coi/util/nfixequiv.cert : acl2x = 0
-coi/util/nfixequiv.cert : no_pcert = 0
-
-coi/util/nfixequiv.cert : \
-     coi/util/ifixequiv.cert \
-     coi/util/nfixequiv.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/ordinal-order.cert : acl2x = 0
-coi/util/ordinal-order.cert : no_pcert = 0
-
-coi/util/ordinal-order.cert : \
-     ordinals/lexicographic-ordering.cert \
-     coi/util/ordinal-order.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/pseudo-translate.cert : acl2x = 0
-coi/util/pseudo-translate.cert : no_pcert = 0
-
-coi/util/pseudo-translate.cert : \
-     coi/util/pseudo-translate.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/recursion-support.cert : acl2x = 0
-coi/util/recursion-support.cert : no_pcert = 0
-
-coi/util/recursion-support.cert : \
-     coi/util/mv-nth.cert \
-     coi/util/defun-support.cert \
-     coi/symbol-fns/symbol-fns.cert \
-     coi/util/recursion-support.lisp \
-     coi/util/recursion-support.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-
-
-coi/util/rewrite-equiv.cert : acl2x = 0
-coi/util/rewrite-equiv.cert : no_pcert = 0
-
-coi/util/rewrite-equiv.cert : \
-     coi/util/good-rewrite-order.cert \
-     coi/util/clause-processor.cert \
-     coi/util/rewrite-equiv.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/rule-sets-documentation.cert : acl2x = 0
-coi/util/rule-sets-documentation.cert : no_pcert = 0
-
-coi/util/rule-sets-documentation.cert : \
-     coi/util/defdoc.cert \
-     coi/util/rule-sets-documentation.lisp \
-     coi/util/rule-sets-documentation.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/def-defpkg.lsp
-
-
-coi/util/rule-sets-support.cert : acl2x = 0
-coi/util/rule-sets-support.cert : no_pcert = 0
-
-coi/util/rule-sets-support.cert : \
-     coi/util/rule-sets-support.lisp \
-     coi/util/rule-sets-support.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/rule-sets-defpkg.lsp
-
-
-coi/util/rule-sets.cert : acl2x = 0
-coi/util/rule-sets.cert : no_pcert = 0
-
-coi/util/rule-sets.cert : \
-     coi/util/rule-sets-documentation.cert \
-     coi/util/rule-sets-support.cert \
-     coi/util/table.cert \
-     coi/util/rule-sets.lisp \
-     coi/util/rule-sets.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/rule-sets-defpkg.lsp \
-     coi/util/table-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-
-
-coi/util/skip-rewrite.cert : acl2x = 0
-coi/util/skip-rewrite.cert : no_pcert = 0
-
-coi/util/skip-rewrite.cert : \
-     misc/beta-reduce.cert \
-     coi/util/skip-rewrite.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/syntaxp.cert : acl2x = 0
-coi/util/syntaxp.cert : no_pcert = 0
-
-coi/util/syntaxp.cert : \
-     coi/util/syntaxp.lisp \
-     coi/util/cert.acl2
-
-
-coi/util/table.cert : acl2x = 0
-coi/util/table.cert : no_pcert = 0
-
-coi/util/table.cert : \
-     coi/util/table.lisp \
-     coi/util/table.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/table-defpkg.lsp
-
-
-concurrent-programs/bakery/apply-total-order.cert : acl2x = 0
-concurrent-programs/bakery/apply-total-order.cert : no_pcert = 0
-
-concurrent-programs/bakery/apply-total-order.cert : \
-     misc/total-order.cert \
-     concurrent-programs/bakery/apply-total-order.lisp
-
-
-concurrent-programs/bakery/fairenv.cert : acl2x = 0
-concurrent-programs/bakery/fairenv.cert : no_pcert = 0
-
-concurrent-programs/bakery/fairenv.cert : \
-     concurrent-programs/bakery/measures.cert \
-     concurrent-programs/bakery/records.cert \
-     concurrent-programs/bakery/fairenv.lisp
-
-
-concurrent-programs/bakery/final-theorems.cert : acl2x = 0
-concurrent-programs/bakery/final-theorems.cert : no_pcert = 0
-
-concurrent-programs/bakery/final-theorems.cert : \
-     concurrent-programs/bakery/labels.cert \
-     concurrent-programs/bakery/stutter1-match.cert \
-     concurrent-programs/bakery/stutter2.cert \
-     concurrent-programs/bakery/initial-state.cert \
-     concurrent-programs/bakery/inv-persists.cert \
-     concurrent-programs/bakery/inv-sufficient.cert \
-     concurrent-programs/bakery/final-theorems.lisp
-
-
-concurrent-programs/bakery/initial-state.cert : acl2x = 0
-concurrent-programs/bakery/initial-state.cert : no_pcert = 0
-
-concurrent-programs/bakery/initial-state.cert : \
-     concurrent-programs/bakery/programs.cert \
-     concurrent-programs/bakery/properties.cert \
-     concurrent-programs/bakery/initial-state.lisp
-
-
-concurrent-programs/bakery/inv-persists.cert : acl2x = 0
-concurrent-programs/bakery/inv-persists.cert : no_pcert = 0
-
-concurrent-programs/bakery/inv-persists.cert : \
-     concurrent-programs/bakery/programs.cert \
-     concurrent-programs/bakery/properties.cert \
-     concurrent-programs/bakery/lexicographic-pos.cert \
-     concurrent-programs/bakery/inv-persists.lisp
-
-
-concurrent-programs/bakery/inv-sufficient.cert : acl2x = 0
-concurrent-programs/bakery/inv-sufficient.cert : no_pcert = 0
-
-concurrent-programs/bakery/inv-sufficient.cert : \
-     concurrent-programs/bakery/programs.cert \
-     concurrent-programs/bakery/properties.cert \
-     concurrent-programs/bakery/lexicographic-pos.cert \
-     concurrent-programs/bakery/properties-of-sets.cert \
-     concurrent-programs/bakery/inv-sufficient.lisp
-
-
-concurrent-programs/bakery/labels.cert : acl2x = 0
-concurrent-programs/bakery/labels.cert : no_pcert = 0
-
-concurrent-programs/bakery/labels.cert : \
-     concurrent-programs/bakery/properties.cert \
-     concurrent-programs/bakery/labels.lisp
-
-
-concurrent-programs/bakery/lexicographic-pos.cert : acl2x = 0
-concurrent-programs/bakery/lexicographic-pos.cert : no_pcert = 0
-
-concurrent-programs/bakery/lexicographic-pos.cert : \
-     concurrent-programs/bakery/properties.cert \
-     concurrent-programs/bakery/pos-temp.cert \
-     concurrent-programs/bakery/lexicographic-pos.lisp
-
-
-concurrent-programs/bakery/lexicographic.cert : acl2x = 0
-concurrent-programs/bakery/lexicographic.cert : no_pcert = 0
-
-concurrent-programs/bakery/lexicographic.cert : \
-     misc/total-order.cert \
-     concurrent-programs/bakery/measures.cert \
-     concurrent-programs/bakery/lexicographic.lisp
-
-
-concurrent-programs/bakery/measures.cert : acl2x = 0
-concurrent-programs/bakery/measures.cert : no_pcert = 0
-
-concurrent-programs/bakery/measures.cert : \
-     ordinals/e0-ordinal.cert \
-     concurrent-programs/bakery/measures.lisp
-
-
-concurrent-programs/bakery/pos-temp.cert : acl2x = 0
-concurrent-programs/bakery/pos-temp.cert : no_pcert = 0
-
-concurrent-programs/bakery/pos-temp.cert : \
-     concurrent-programs/bakery/variables.cert \
-     concurrent-programs/bakery/properties.cert \
-     concurrent-programs/bakery/pos-temp.lisp
-
-
-concurrent-programs/bakery/programs.cert : acl2x = 0
-concurrent-programs/bakery/programs.cert : no_pcert = 0
-
-concurrent-programs/bakery/programs.cert : \
-     concurrent-programs/bakery/variables.cert \
-     concurrent-programs/bakery/lexicographic.cert \
-     concurrent-programs/bakery/fairenv.cert \
-     concurrent-programs/bakery/programs.lisp
-
-
-concurrent-programs/bakery/properties-of-sets.cert : acl2x = 0
-concurrent-programs/bakery/properties-of-sets.cert : no_pcert = 0
-
-concurrent-programs/bakery/properties-of-sets.cert : \
-     concurrent-programs/bakery/records.cert \
-     concurrent-programs/bakery/properties-of-sets.lisp
-
-
-concurrent-programs/bakery/properties.cert : acl2x = 0
-concurrent-programs/bakery/properties.cert : no_pcert = 0
-
-concurrent-programs/bakery/properties.cert : \
-     concurrent-programs/bakery/lexicographic.cert \
-     concurrent-programs/bakery/measures.cert \
-     concurrent-programs/bakery/properties-of-sets.cert \
-     concurrent-programs/bakery/variables.cert \
-     concurrent-programs/bakery/fairenv.cert \
-     concurrent-programs/bakery/properties.lisp
-
-
-concurrent-programs/bakery/records.cert : acl2x = 0
-concurrent-programs/bakery/records.cert : no_pcert = 0
-
-concurrent-programs/bakery/records.cert : \
-     concurrent-programs/bakery/apply-total-order.cert \
-     concurrent-programs/bakery/records.lisp
-
-
-concurrent-programs/bakery/stutter1-match.cert : acl2x = 0
-concurrent-programs/bakery/stutter1-match.cert : no_pcert = 0
-
-concurrent-programs/bakery/stutter1-match.cert : \
-     concurrent-programs/bakery/programs.cert \
-     concurrent-programs/bakery/properties.cert \
-     concurrent-programs/bakery/stutter1-match.lisp
-
-
-concurrent-programs/bakery/stutter2.cert : acl2x = 0
-concurrent-programs/bakery/stutter2.cert : no_pcert = 0
-
-concurrent-programs/bakery/stutter2.cert : \
-     concurrent-programs/bakery/programs.cert \
-     concurrent-programs/bakery/properties.cert \
-     arithmetic-2/meta/top.cert \
-     concurrent-programs/bakery/lexicographic-pos.cert \
-     concurrent-programs/bakery/stutter2.lisp
-
-
-concurrent-programs/bakery/variables.cert : acl2x = 0
-concurrent-programs/bakery/variables.cert : no_pcert = 0
-
-concurrent-programs/bakery/variables.cert : \
-     concurrent-programs/bakery/records.cert \
-     concurrent-programs/bakery/variables.lisp
-
-
-concurrent-programs/german-protocol/german.cert : acl2x = 0
-concurrent-programs/german-protocol/german.cert : no_pcert = 0
-
-concurrent-programs/german-protocol/german.cert : \
-     misc/records.cert \
-     concurrent-programs/german-protocol/german.lisp
-
-
-countereg-gen/acl2s-parameter.cert : acl2x = 0
-countereg-gen/acl2s-parameter.cert : no_pcert = 0
-
-countereg-gen/acl2s-parameter.cert : \
-     countereg-gen/utilities.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/acl2s-parameter.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/base.cert : acl2x = 0
-countereg-gen/base.cert : no_pcert = 0
-
-countereg-gen/base.cert : \
-     countereg-gen/data.cert \
-     countereg-gen/splitnat.cert \
-     countereg-gen/switchnat.cert \
-     countereg-gen/graph.cert \
-     countereg-gen/library-support.cert \
-     arithmetic-5/top.cert \
-     arithmetic-5/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/base.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/basis.cert : acl2x = 0
-countereg-gen/basis.cert : no_pcert = 0
-
-countereg-gen/basis.cert : \
-     tools/bstar.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/basis.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/data.cert : acl2x = 0
-countereg-gen/data.cert : no_pcert = 0
-
-countereg-gen/data.cert : \
-     countereg-gen/utilities.cert \
-     countereg-gen/basis.cert \
-     countereg-gen/acl2s-parameter.cert \
-     countereg-gen/splitnat.cert \
-     countereg-gen/switchnat.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/data.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/graph.cert : acl2x = 0
-countereg-gen/graph.cert : no_pcert = 0
-
-countereg-gen/graph.cert : \
-     countereg-gen/utilities.cert \
-     countereg-gen/data.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/graph.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/library-support.cert : acl2x = 0
-countereg-gen/library-support.cert : no_pcert = 0
-
-countereg-gen/library-support.cert : \
-     defexec/other-apps/records/records.cert \
-     finite-set-theory/osets/sets.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/library-support.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/main.cert : acl2x = 0
-countereg-gen/main.cert : no_pcert = 0
-
-countereg-gen/main.cert : \
-     tools/bstar.cert \
-     countereg-gen/basis.cert \
-     countereg-gen/with-timeout.cert \
-     countereg-gen/type.cert \
-     countereg-gen/acl2s-parameter.cert \
-     countereg-gen/simple-graph-array.cert \
-     countereg-gen/random-state.cert \
-     tools/easy-simplify.cert \
-     countereg-gen/data.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/main.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/mv-proof.cert : acl2x = 0
-countereg-gen/mv-proof.cert : no_pcert = 0
-
-countereg-gen/mv-proof.cert : \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/mv-proof.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/num-list-fns.cert : acl2x = 0
-countereg-gen/num-list-fns.cert : no_pcert = 0
-
-countereg-gen/num-list-fns.cert : \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/num-list-fns.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/num-list-thms.cert : acl2x = 0
-countereg-gen/num-list-thms.cert : no_pcert = 0
-
-countereg-gen/num-list-thms.cert : \
-     countereg-gen/num-list-fns.cert \
-     arithmetic-5/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/num-list-thms.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/random-state-basis1.cert : acl2x = 0
-countereg-gen/random-state-basis1.cert : no_pcert = 0
-
-countereg-gen/random-state-basis1.cert : \
-     tools/bstar.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/random-state-basis1.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/random-state.cert : acl2x = 0
-countereg-gen/random-state.cert : no_pcert = 0
-
-countereg-gen/random-state.cert : \
-     countereg-gen/random-state-basis1.cert \
-     arithmetic/rationals.cert \
-     arithmetic-3/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/random-state.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/random.cert : acl2x = 0
-countereg-gen/random.cert : no_pcert = 0
-
-countereg-gen/random.cert : \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic/rationals.cert \
-     arithmetic-3/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/random.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/rem-and-floor.cert : acl2x = 0
-countereg-gen/rem-and-floor.cert : no_pcert = 0
-
-countereg-gen/rem-and-floor.cert : \
-     arithmetic-5/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/rem-and-floor.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/simple-graph-array.cert : acl2x = 0
-countereg-gen/simple-graph-array.cert : no_pcert = 0
-
-countereg-gen/simple-graph-array.cert : \
-     countereg-gen/utilities.cert \
-     ordinals/lexicographic-ordering-without-arithmetic.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/simple-graph-array.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/splitnat.cert : acl2x = 0
-countereg-gen/splitnat.cert : no_pcert = 0
-
-countereg-gen/splitnat.cert : \
-     countereg-gen/num-list-fns.cert \
-     countereg-gen/num-list-thms.cert \
-     countereg-gen/rem-and-floor.cert \
-     arithmetic-5/top.cert \
-     arithmetic-5/top.cert \
-     arithmetic-5/top.cert \
-     arithmetic-3/top.cert \
-     arithmetic-5/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/splitnat.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/switchnat.cert : acl2x = 0
-countereg-gen/switchnat.cert : no_pcert = 0
-
-countereg-gen/switchnat.cert : \
-     countereg-gen/num-list-fns.cert \
-     countereg-gen/num-list-thms.cert \
-     countereg-gen/rem-and-floor.cert \
-     countereg-gen/mv-proof.cert \
-     arithmetic-5/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/switchnat.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/top.cert : acl2x = 0
-countereg-gen/top.cert : no_pcert = 0
-
-countereg-gen/top.cert : \
-     countereg-gen/acl2s-parameter.cert \
-     countereg-gen/main.cert \
-     countereg-gen/base.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/top.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/type.cert : acl2x = 0
-countereg-gen/type.cert : no_pcert = 0
-
-countereg-gen/type.cert : \
-     countereg-gen/graph.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/type.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/utilities.cert : acl2x = 0
-countereg-gen/utilities.cert : no_pcert = 0
-
-countereg-gen/utilities.cert : \
-     tools/bstar.cert \
-     misc/total-order.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/utilities.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-countereg-gen/with-timeout.cert : acl2x = 0
-countereg-gen/with-timeout.cert : no_pcert = 0
-
-countereg-gen/with-timeout.cert : \
-     xdoc/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     countereg-gen/with-timeout.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-
-
-cowles/acl2-agp.cert : acl2x = 0
-cowles/acl2-agp.cert : no_pcert = 0
-
-cowles/acl2-agp.cert : \
-     cowles/acl2-asg.cert \
-     cowles/acl2-agp.lisp \
-     cowles/cert.acl2 \
-     cowles/packages.lsp
-
-
-cowles/acl2-asg.cert : acl2x = 0
-cowles/acl2-asg.cert : no_pcert = 0
-
-cowles/acl2-asg.cert : \
-     cowles/acl2-asg.lisp \
-     cowles/cert.acl2 \
-     cowles/packages.lsp
-
-
-cowles/acl2-crg.cert : acl2x = 0
-cowles/acl2-crg.cert : no_pcert = 0
-
-cowles/acl2-crg.cert : \
-     cowles/acl2-agp.cert \
-     cowles/acl2-crg.lisp \
-     cowles/cert.acl2 \
-     cowles/packages.lsp
-
-
-cutil/da-base.cert : acl2x = 0
-cutil/da-base.cert : no_pcert = 0
-
-cutil/da-base.cert : \
-     cutil/support.cert \
-     tools/bstar.cert \
-     cutil/portcullis.cert \
-     cutil/da-base.lisp \
-     cutil/cert.acl2
-
-
-cutil/defaggregate-tests.cert : acl2x = 0
-cutil/defaggregate-tests.cert : no_pcert = 0
-
-cutil/defaggregate-tests.cert : \
-     cutil/defaggregate.cert \
-     cutil/deflist.cert \
-     cutil/portcullis.cert \
-     cutil/defaggregate-tests.lisp \
-     cutil/cert.acl2
-
-
-cutil/defaggregate.cert : acl2x = 0
-cutil/defaggregate.cert : no_pcert = 0
-
-cutil/defaggregate.cert : \
-     cutil/da-base.cert \
-     cutil/formals.cert \
-     xdoc-impl/fmt-to-str.cert \
-     tools/rulesets.cert \
-     xdoc/names.cert \
-     str/cat.cert \
-     cutil/portcullis.cert \
-     cutil/defaggregate.lisp \
-     cutil/cert.acl2
-
-
-cutil/defalist-tests.cert : acl2x = 0
-cutil/defalist-tests.cert : no_pcert = 0
-
-cutil/defalist-tests.cert : \
-     cutil/defalist.cert \
-     cutil/portcullis.cert \
-     cutil/defalist-tests.lisp \
-     cutil/cert.acl2
-
-
-cutil/defalist.cert : acl2x = 0
-cutil/defalist.cert : no_pcert = 0
-
-cutil/defalist.cert : \
-     cutil/deflist.cert \
-     misc/hons-help.cert \
-     cutil/portcullis.cert \
-     cutil/defalist.lisp \
-     cutil/cert.acl2
-
-
-cutil/defenum.cert : acl2x = 0
-cutil/defenum.cert : no_pcert = 0
-
-cutil/defenum.cert : \
-     cutil/deflist.cert \
-     cutil/portcullis.cert \
-     cutil/defenum.lisp \
-     cutil/cert.acl2
-
-
-cutil/define-tests.cert : acl2x = 0
-cutil/define-tests.cert : no_pcert = 0
-
-cutil/define-tests.cert : \
-     cutil/define.cert \
-     cutil/portcullis.cert \
-     cutil/define-tests.lisp \
-     cutil/define-tests.acl2
-
-
-cutil/define.cert : acl2x = 0
-cutil/define.cert : no_pcert = 0
-
-cutil/define.cert : \
-     cutil/formals.cert \
-     cutil/returnspecs.cert \
-     xdoc-impl/fmt-to-str.cert \
-     tools/mv-nth.cert \
-     str/cat.cert \
-     misc/assert.cert \
-     cutil/portcullis.cert \
-     cutil/define.lisp \
-     cutil/cert.acl2
-
-
-cutil/deflist-aux.cert : acl2x = 0
-cutil/deflist-aux.cert : no_pcert = 0
-
-cutil/deflist-aux.cert : \
-     finite-set-theory/osets/sets.cert \
-     cutil/portcullis.cert \
-     cutil/deflist-aux.lisp \
-     cutil/cert.acl2
-
-
-cutil/deflist-tests.cert : acl2x = 0
-cutil/deflist-tests.cert : no_pcert = 0
-
-cutil/deflist-tests.cert : \
-     cutil/deflist.cert \
-     str/top.cert \
-     misc/assert.cert \
-     cutil/portcullis.cert \
-     cutil/deflist-tests.lisp \
-     cutil/cert.acl2
-
-
-cutil/deflist.cert : acl2x = 0
-cutil/deflist.cert : no_pcert = 0
-
-cutil/deflist.cert : \
-     xdoc/top.cert \
-     tools/bstar.cert \
-     str/cat.cert \
-     finite-set-theory/osets/sets.cert \
-     defsort/duplicated-members.cert \
-     std/lists/sets.cert \
-     std/lists/list-fix.cert \
-     std/lists/take.cert \
-     std/lists/repeat.cert \
-     std/lists/rev.cert \
-     cutil/maybe-defthm.cert \
-     finite-set-theory/osets/under-set-equiv.cert \
-     arithmetic/top-with-meta.cert \
-     cutil/portcullis.cert \
-     cutil/deflist.lisp \
-     cutil/cert.acl2
-
-
-cutil/defmapappend-tests.cert : acl2x = 0
-cutil/defmapappend-tests.cert : no_pcert = 0
-
-cutil/defmapappend-tests.cert : \
-     cutil/defmapappend.cert \
-     cutil/portcullis.cert \
-     cutil/defmapappend-tests.lisp \
-     cutil/cert.acl2
-
-
-cutil/defmapappend.cert : acl2x = 0
-cutil/defmapappend.cert : no_pcert = 0
-
-cutil/defmapappend.cert : \
-     cutil/defprojection.cert \
-     cutil/portcullis.cert \
-     cutil/defmapappend.lisp \
-     cutil/cert.acl2
-
-
-cutil/defmvtypes.cert : acl2x = 0
-cutil/defmvtypes.cert : no_pcert = 0
-
-cutil/defmvtypes.cert : \
-     cutil/deflist.cert \
-     cutil/portcullis.cert \
-     cutil/defmvtypes.lisp \
-     cutil/cert.acl2
-
-
-cutil/defprojection-tests.cert : acl2x = 0
-cutil/defprojection-tests.cert : no_pcert = 0
-
-cutil/defprojection-tests.cert : \
-     cutil/defprojection.cert \
-     misc/assert.cert \
-     cutil/portcullis.cert \
-     cutil/defprojection-tests.lisp \
-     cutil/defprojection-tests.acl2
-
-
-cutil/defprojection.cert : acl2x = 0
-cutil/defprojection.cert : no_pcert = 0
-
-cutil/defprojection.cert : \
-     cutil/deflist.cert \
-     cutil/portcullis.cert \
-     cutil/defprojection.lisp \
-     cutil/cert.acl2
-
-
-cutil/defsection.cert : acl2x = 0
-cutil/defsection.cert : no_pcert = 0
-
-cutil/defsection.cert : \
-     xdoc/top.cert \
-     tools/bstar.cert \
-     cutil/portcullis.cert \
-     cutil/defsection.lisp \
-     cutil/cert.acl2
-
-
-cutil/formals.cert : acl2x = 0
-cutil/formals.cert : no_pcert = 0
-
-cutil/formals.cert : \
-     cutil/look-up.cert \
-     cutil/da-base.cert \
-     misc/assert.cert \
-     cutil/portcullis.cert \
-     cutil/formals.lisp \
-     cutil/cert.acl2
-
-
-cutil/look-up.cert : acl2x = 0
-cutil/look-up.cert : no_pcert = 0
-
-cutil/look-up.cert : \
-     cutil/support.cert \
-     tools/bstar.cert \
-     misc/assert.cert \
-     cutil/portcullis.cert \
-     cutil/look-up.lisp \
-     cutil/cert.acl2
-
-
-cutil/maybe-defthm.cert : acl2x = 0
-cutil/maybe-defthm.cert : no_pcert = 0
-
-cutil/maybe-defthm.cert : \
-     tools/bstar.cert \
-     misc/assert.cert \
-     cutil/portcullis.cert \
-     cutil/maybe-defthm.lisp \
-     cutil/cert.acl2
-
-
-cutil/portcullis.cert : acl2x = 0
-cutil/portcullis.cert : no_pcert = 0
-
-cutil/portcullis.cert : \
-     cutil/portcullis.lisp \
-     cutil/portcullis.acl2 \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-
-
-cutil/returnspecs.cert : acl2x = 0
-cutil/returnspecs.cert : no_pcert = 0
-
-cutil/returnspecs.cert : \
-     cutil/da-base.cert \
-     cutil/look-up.cert \
-     misc/assert.cert \
-     cutil/portcullis.cert \
-     cutil/returnspecs.lisp \
-     cutil/cert.acl2
-
-
-cutil/support.cert : acl2x = 0
-cutil/support.cert : no_pcert = 0
-
-cutil/support.cert : \
-     xdoc/top.cert \
-     misc/definline.cert \
-     tools/bstar.cert \
-     cutil/portcullis.cert \
-     cutil/support.lisp \
-     cutil/cert.acl2
-
-
-cutil/top.cert : acl2x = 0
-cutil/top.cert : no_pcert = 0
-
-cutil/top.cert : \
-     cutil/defaggregate.cert \
-     cutil/defalist.cert \
-     cutil/defenum.cert \
-     cutil/deflist.cert \
-     cutil/defmapappend.cert \
-     cutil/defmvtypes.cert \
-     cutil/defprojection.cert \
-     cutil/define.cert \
-     cutil/portcullis.cert \
-     cutil/top.lisp \
-     cutil/top.acl2
-
-
-cutil/wizard.cert : acl2x = 0
-cutil/wizard.cert : no_pcert = 0
-
-cutil/wizard.cert : \
-     cutil/defaggregate.cert \
-     cutil/deflist.cert \
-     clause-processors/unify-subst.cert \
-     cutil/portcullis.cert \
-     cutil/wizard.lisp \
-     cutil/cert.acl2
-
-
-data-structures/alist-defthms.cert : acl2x = 0
-data-structures/alist-defthms.cert : no_pcert = 0
-
-data-structures/alist-defthms.cert : \
-     data-structures/alist-defuns.cert \
-     data-structures/list-defuns.cert \
-     data-structures/set-defuns.cert \
-     arithmetic/equalities.cert \
-     data-structures/set-defthms.cert \
-     data-structures/alist-defthms.lisp
-
-
-data-structures/alist-defuns.cert : acl2x = 0
-data-structures/alist-defuns.cert : no_pcert = 0
-
-data-structures/alist-defuns.cert : \
-     data-structures/alist-defuns.lisp
-
-
-data-structures/alist-theory.cert : acl2x = 0
-data-structures/alist-theory.cert : no_pcert = 0
-
-data-structures/alist-theory.cert : \
-     data-structures/alist-defuns.cert \
-     data-structures/alist-defthms.cert \
-     data-structures/defalist.cert \
-     data-structures/alist-theory.lisp
-
-
-data-structures/array1.cert : acl2x = 0
-data-structures/array1.cert : no_pcert = 0
-
-data-structures/array1.cert : \
-     data-structures/doc-section.cert \
-     data-structures/array1.lisp
-
-
-data-structures/defalist.cert : acl2x = 0
-data-structures/defalist.cert : no_pcert = 0
-
-data-structures/defalist.cert : \
-     data-structures/alist-defuns.cert \
-     data-structures/list-defuns.cert \
-     data-structures/utilities.cert \
-     data-structures/defalist.lisp \
-     data-structures/defalist.acl2 \
-     data-structures/define-u-package.lsp
-
-
-data-structures/deflist.cert : acl2x = 0
-data-structures/deflist.cert : no_pcert = 0
-
-data-structures/deflist.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/utilities.cert \
-     data-structures/list-defthms.cert \
-     data-structures/deflist.lisp \
-     data-structures/deflist.acl2 \
-     data-structures/define-u-package.lsp
-
-
-data-structures/doc-section.cert : acl2x = 0
-data-structures/doc-section.cert : no_pcert = 0
-
-data-structures/doc-section.cert : \
-     data-structures/doc-section.lisp
-
-
-data-structures/list-defthms.cert : acl2x = 0
-data-structures/list-defthms.cert : no_pcert = 0
-
-data-structures/list-defthms.cert : \
-     data-structures/list-defuns.cert \
-     arithmetic/equalities.cert \
-     data-structures/list-defthms.lisp
-
-
-data-structures/list-defuns.cert : acl2x = 0
-data-structures/list-defuns.cert : no_pcert = 0
-
-data-structures/list-defuns.cert : \
-     data-structures/list-defuns.lisp
-
-
-data-structures/list-theory.cert : acl2x = 0
-data-structures/list-theory.cert : no_pcert = 0
-
-data-structures/list-theory.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     data-structures/deflist.cert \
-     data-structures/list-theory.lisp
-
-
-data-structures/memories/log2.cert : acl2x = 0
-data-structures/memories/log2.cert : no_pcert = 0
-
-data-structures/memories/log2.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     data-structures/memories/log2.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-
-
-data-structures/memories/memory-impl.cert : acl2x = 0
-data-structures/memories/memory-impl.cert : no_pcert = 0
-
-data-structures/memories/memory-impl.cert : \
-     data-structures/memories/log2.cert \
-     data-structures/memories/memtree.cert \
-     misc/records.cert \
-     data-structures/memories/memory-impl.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-
-
-data-structures/memories/memory.cert : acl2x = 0
-data-structures/memories/memory.cert : no_pcert = 0
-
-data-structures/memories/memory.cert : \
-     data-structures/memories/memory-impl.cert \
-     data-structures/doc-section.cert \
-     data-structures/memories/private.cert \
-     misc/records.cert \
-     data-structures/memories/memory.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-
-
-data-structures/memories/memtree.cert : acl2x = 0
-data-structures/memories/memtree.cert : no_pcert = 0
-
-data-structures/memories/memtree.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     data-structures/memories/memtree.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-
-
-data-structures/memories/private.cert : acl2x = 0
-data-structures/memories/private.cert : no_pcert = 0
-
-data-structures/memories/private.cert : \
-     data-structures/doc-section.cert \
-     data-structures/memories/private.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-
-
-data-structures/no-duplicates.cert : acl2x = 0
-data-structures/no-duplicates.cert : no_pcert = 0
-
-data-structures/no-duplicates.cert : \
-     data-structures/no-duplicates.lisp
-
-
-data-structures/number-list-defthms.cert : acl2x = 0
-data-structures/number-list-defthms.cert : no_pcert = 0
-
-data-structures/number-list-defthms.cert : \
-     data-structures/number-list-defuns.cert \
-     data-structures/deflist.cert \
-     data-structures/number-list-defthms.lisp
-
-
-data-structures/number-list-defuns.cert : acl2x = 0
-data-structures/number-list-defuns.cert : no_pcert = 0
-
-data-structures/number-list-defuns.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/number-list-defuns.lisp
-
-
-data-structures/number-list-theory.cert : acl2x = 0
-data-structures/number-list-theory.cert : no_pcert = 0
-
-data-structures/number-list-theory.cert : \
-     data-structures/number-list-defuns.cert \
-     data-structures/number-list-defthms.cert \
-     data-structures/number-list-theory.lisp
-
-
-data-structures/set-defthms.cert : acl2x = 0
-data-structures/set-defthms.cert : no_pcert = 0
-
-data-structures/set-defthms.cert : \
-     data-structures/set-defuns.cert \
-     data-structures/set-defthms.lisp
-
-
-data-structures/set-defuns.cert : acl2x = 0
-data-structures/set-defuns.cert : no_pcert = 0
-
-data-structures/set-defuns.cert : \
-     data-structures/set-defuns.lisp
-
-
-data-structures/set-theory.cert : acl2x = 0
-data-structures/set-theory.cert : no_pcert = 0
-
-data-structures/set-theory.cert : \
-     data-structures/set-defuns.cert \
-     data-structures/set-defthms.cert \
-     data-structures/set-theory.lisp
-
-
-data-structures/structures.cert : acl2x = 0
-data-structures/structures.cert : no_pcert = 0
-
-data-structures/structures.cert : \
-     data-structures/utilities.cert \
-     data-structures/structures.lisp \
-     data-structures/structures.acl2 \
-     data-structures/define-u-package.lsp \
-     data-structures/define-structures-package.lsp
-
-
-data-structures/utilities.cert : acl2x = 0
-data-structures/utilities.cert : no_pcert = 0
-
-data-structures/utilities.cert : \
-     data-structures/doc-section.cert \
-     data-structures/utilities.lisp \
-     data-structures/utilities.acl2 \
-     data-structures/define-u-package.lsp
-
-
-deduction/passmore/bewijs.cert : acl2x = 0
-deduction/passmore/bewijs.cert : no_pcert = 0
-
-deduction/passmore/bewijs.cert : \
-     deduction/passmore/bewijs.lisp
-
-
-deduction/passmore/general.cert : acl2x = 0
-deduction/passmore/general.cert : no_pcert = 0
-
-deduction/passmore/general.cert : \
-     deduction/passmore/general.lisp
-
-
-deduction/passmore/paramod.cert : acl2x = 0
-deduction/passmore/paramod.cert : no_pcert = 0
-
-deduction/passmore/paramod.cert : \
-     deduction/passmore/weighting.cert \
-     deduction/passmore/paramod.lisp
-
-
-deduction/passmore/prover.cert : acl2x = 0
-deduction/passmore/prover.cert : no_pcert = 0
-
-deduction/passmore/prover.cert : \
-     deduction/passmore/general.cert \
-     deduction/passmore/unification.cert \
-     deduction/passmore/weighting.cert \
-     deduction/passmore/resolution.cert \
-     deduction/passmore/paramod.cert \
-     deduction/passmore/bewijs.cert \
-     deduction/passmore/prover.lisp
-
-
-deduction/passmore/resolution.cert : acl2x = 0
-deduction/passmore/resolution.cert : no_pcert = 0
-
-deduction/passmore/resolution.cert : \
-     deduction/passmore/general.cert \
-     deduction/passmore/unification.cert \
-     deduction/passmore/weighting.cert \
-     deduction/passmore/resolution.lisp
-
-
-deduction/passmore/unification.cert : acl2x = 0
-deduction/passmore/unification.cert : no_pcert = 0
-
-deduction/passmore/unification.cert : \
-     deduction/passmore/general.cert \
-     deduction/passmore/unification.lisp
-
-
-deduction/passmore/weighting.cert : acl2x = 0
-deduction/passmore/weighting.cert : no_pcert = 0
-
-deduction/passmore/weighting.cert : \
-     deduction/passmore/unification.cert \
-     deduction/passmore/weighting.lisp
-
-
-defexec/dag-unification/basic.cert : acl2x = 0
-defexec/dag-unification/basic.cert : no_pcert = 0
-
-defexec/dag-unification/basic.cert : \
-     arithmetic/top-with-meta.cert \
-     defexec/dag-unification/basic.lisp
-
-
-defexec/dag-unification/dag-unification-l.cert : acl2x = 0
-defexec/dag-unification/dag-unification-l.cert : no_pcert = 0
-
-defexec/dag-unification/dag-unification-l.cert : \
-     defexec/dag-unification/dag-unification-rules.cert \
-     defexec/dag-unification/terms-as-dag.cert \
-     defexec/dag-unification/dag-unification-l.lisp
-
-
-defexec/dag-unification/dag-unification-rules.cert : acl2x = 0
-defexec/dag-unification/dag-unification-rules.cert : no_pcert = 0
-
-defexec/dag-unification/dag-unification-rules.cert : \
-     defexec/dag-unification/dags.cert \
-     defexec/dag-unification/list-unification-rules.cert \
-     defexec/dag-unification/dag-unification-rules.lisp
-
-
-defexec/dag-unification/dag-unification-st.cert : acl2x = 0
-defexec/dag-unification/dag-unification-st.cert : no_pcert = 0
-
-defexec/dag-unification/dag-unification-st.cert : \
-     defexec/dag-unification/dag-unification-l.cert \
-     defexec/dag-unification/terms-dag-stobj.cert \
-     defexec/dag-unification/dag-unification-st.lisp
-
-
-defexec/dag-unification/dags.cert : acl2x = 0
-defexec/dag-unification/dags.cert : no_pcert = 0
-
-defexec/dag-unification/dags.cert : \
-     defexec/dag-unification/basic.cert \
-     defexec/dag-unification/dags.lisp
-
-
-defexec/dag-unification/list-unification-rules.cert : acl2x = 0
-defexec/dag-unification/list-unification-rules.cert : no_pcert = 0
-
-defexec/dag-unification/list-unification-rules.cert : \
-     defexec/dag-unification/subsumption-subst.cert \
-     defexec/dag-unification/list-unification-rules.lisp
-
-
-defexec/dag-unification/matching.cert : acl2x = 0
-defexec/dag-unification/matching.cert : no_pcert = 0
-
-defexec/dag-unification/matching.cert : \
-     defexec/dag-unification/terms.cert \
-     defexec/dag-unification/matching.lisp
-
-
-defexec/dag-unification/subsumption-subst.cert : acl2x = 0
-defexec/dag-unification/subsumption-subst.cert : no_pcert = 0
-
-defexec/dag-unification/subsumption-subst.cert : \
-     defexec/dag-unification/subsumption.cert \
-     defexec/dag-unification/subsumption-subst.lisp
-
-
-defexec/dag-unification/subsumption.cert : acl2x = 0
-defexec/dag-unification/subsumption.cert : no_pcert = 0
-
-defexec/dag-unification/subsumption.cert : \
-     defexec/dag-unification/matching.cert \
-     defexec/dag-unification/terms.cert \
-     defexec/dag-unification/subsumption.lisp
-
-
-defexec/dag-unification/terms-as-dag.cert : acl2x = 0
-defexec/dag-unification/terms-as-dag.cert : no_pcert = 0
-
-defexec/dag-unification/terms-as-dag.cert : \
-     defexec/dag-unification/dag-unification-rules.cert \
-     defexec/dag-unification/terms-as-dag.lisp
-
-
-defexec/dag-unification/terms-dag-stobj.cert : acl2x = 0
-defexec/dag-unification/terms-dag-stobj.cert : no_pcert = 0
-
-defexec/dag-unification/terms-dag-stobj.cert : \
-     defexec/dag-unification/dag-unification-rules.cert \
-     defexec/dag-unification/terms-dag-stobj.lisp
-
-
-defexec/dag-unification/terms.cert : acl2x = 0
-defexec/dag-unification/terms.cert : no_pcert = 0
-
-defexec/dag-unification/terms.cert : \
-     defexec/dag-unification/basic.cert \
-     defexec/dag-unification/terms.lisp
-
-
-defexec/defpun-exec/defpun-exec.cert : acl2x = 0
-defexec/defpun-exec/defpun-exec.cert : no_pcert = 0
-
-defexec/defpun-exec/defpun-exec.cert : \
-     misc/defpun.cert \
-     defexec/defpun-exec/defpun-exec.lisp
-
-
-defexec/find-path/fpst.cert : acl2x = 0
-defexec/find-path/fpst.cert : no_pcert = 0
-
-defexec/find-path/fpst.cert : \
-     defexec/find-path/graph/linear-find-path.cert \
-     defexec/find-path/fpst.lisp
-
-
-defexec/find-path/graph/find-path1.cert : acl2x = 0
-defexec/find-path/graph/find-path1.cert : no_pcert = 0
-
-defexec/find-path/graph/find-path1.cert : \
-     arithmetic/top.cert \
-     ordinals/e0-ordinal.cert \
-     defexec/find-path/graph/find-path1.lisp
-
-
-defexec/find-path/graph/find-path2.cert : acl2x = 0
-defexec/find-path/graph/find-path2.cert : no_pcert = 0
-
-defexec/find-path/graph/find-path2.cert : \
-     arithmetic/top.cert \
-     defexec/find-path/graph/helpers.cert \
-     ordinals/e0-ordinal.cert \
-     defexec/find-path/graph/find-path2.lisp
-
-
-defexec/find-path/graph/find-path3.cert : acl2x = 0
-defexec/find-path/graph/find-path3.cert : no_pcert = 0
-
-defexec/find-path/graph/find-path3.cert : \
-     arithmetic/top.cert \
-     defexec/find-path/graph/helpers.cert \
-     ordinals/e0-ordinal.cert \
-     defexec/find-path/graph/find-path3.lisp
-
-
-defexec/find-path/graph/helpers.cert : acl2x = 0
-defexec/find-path/graph/helpers.cert : no_pcert = 0
-
-defexec/find-path/graph/helpers.cert : \
-     defexec/find-path/graph/helpers.lisp
-
-
-defexec/find-path/graph/linear-find-path.cert : acl2x = 0
-defexec/find-path/graph/linear-find-path.cert : no_pcert = 0
-
-defexec/find-path/graph/linear-find-path.cert : \
-     defexec/find-path/graph/find-path3.cert \
-     defexec/find-path/graph/linear-find-path.lisp
-
-
-defexec/find-path/run-fpst.cert : acl2x = 0
-defexec/find-path/run-fpst.cert : no_pcert = 0
-
-defexec/find-path/run-fpst.cert : \
-     defexec/find-path/fpst.cert \
-     defexec/find-path/run-fpst.lisp
-
-
-defexec/ordinals/supporting-ordinals.cert : acl2x = 0
-defexec/ordinals/supporting-ordinals.cert : no_pcert = 0
-
-defexec/ordinals/supporting-ordinals.cert : \
-     ordinals/ordinals.cert \
-     defexec/ordinals/supporting-ordinals.lisp
-
-
-defexec/other-apps/misc/memos.cert : acl2x = 0
-defexec/other-apps/misc/memos.cert : no_pcert = 0
-
-defexec/other-apps/misc/memos.cert : \
-     defexec/other-apps/misc/memos.lisp
-
-
-defexec/other-apps/misc/stobjsim.cert : acl2x = 0
-defexec/other-apps/misc/stobjsim.cert : no_pcert = 0
-
-defexec/other-apps/misc/stobjsim.cert : \
-     defexec/other-apps/misc/stobjsim.lisp
-
-
-defexec/other-apps/qsort/extraction.cert : acl2x = 0
-defexec/other-apps/qsort/extraction.cert : no_pcert = 0
-
-defexec/other-apps/qsort/extraction.cert : \
-     defexec/other-apps/qsort/programs.cert \
-     defexec/other-apps/qsort/intermediate-program.cert \
-     defexec/other-apps/qsort/first-last.cert \
-     defexec/other-apps/qsort/extraction.lisp
-
-
-defexec/other-apps/qsort/final-theorem.cert : acl2x = 0
-defexec/other-apps/qsort/final-theorem.cert : no_pcert = 0
-
-defexec/other-apps/qsort/final-theorem.cert : \
-     defexec/other-apps/qsort/sort-qs-properties.cert \
-     defexec/other-apps/qsort/load-extract.cert \
-     defexec/other-apps/qsort/final-theorem.lisp
-
-
-defexec/other-apps/qsort/first-last.cert : acl2x = 0
-defexec/other-apps/qsort/first-last.cert : no_pcert = 0
-
-defexec/other-apps/qsort/first-last.cert : \
-     defexec/other-apps/qsort/programs.cert \
-     defexec/other-apps/qsort/first-last.lisp
-
-
-defexec/other-apps/qsort/intermediate-program.cert : acl2x = 0
-defexec/other-apps/qsort/intermediate-program.cert : no_pcert = 0
-
-defexec/other-apps/qsort/intermediate-program.cert : \
-     defexec/other-apps/qsort/total-order.cert \
-     defexec/other-apps/qsort/permutations.cert \
-     defexec/other-apps/qsort/intermediate-program.lisp
-
-
-defexec/other-apps/qsort/intermediate-to-spec.cert : acl2x = 0
-defexec/other-apps/qsort/intermediate-to-spec.cert : no_pcert = 0
-
-defexec/other-apps/qsort/intermediate-to-spec.cert : \
-     defexec/other-apps/qsort/intermediate-program.cert \
-     defexec/other-apps/qsort/spec-properties.cert \
-     defexec/other-apps/qsort/intermediate-to-spec.lisp
-
-
-defexec/other-apps/qsort/load-extract.cert : acl2x = 0
-defexec/other-apps/qsort/load-extract.cert : no_pcert = 0
-
-defexec/other-apps/qsort/load-extract.cert : \
-     defexec/other-apps/qsort/programs.cert \
-     defexec/other-apps/qsort/first-last.cert \
-     defexec/other-apps/qsort/extraction.cert \
-     defexec/other-apps/qsort/load-extract.lisp
-
-
-defexec/other-apps/qsort/merge-intermediate.cert : acl2x = 0
-defexec/other-apps/qsort/merge-intermediate.cert : no_pcert = 0
-
-defexec/other-apps/qsort/merge-intermediate.cert : \
-     defexec/other-apps/qsort/programs.cert \
-     defexec/other-apps/qsort/intermediate-to-spec.cert \
-     defexec/other-apps/qsort/first-last.cert \
-     defexec/other-apps/qsort/merge-intermediate.lisp
-
-
-defexec/other-apps/qsort/nth-update-nth.cert : acl2x = 0
-defexec/other-apps/qsort/nth-update-nth.cert : no_pcert = 0
-
-defexec/other-apps/qsort/nth-update-nth.cert : \
-     defexec/other-apps/qsort/nth-update-nth.lisp
-
-
-defexec/other-apps/qsort/permutations.cert : acl2x = 0
-defexec/other-apps/qsort/permutations.cert : no_pcert = 0
-
-defexec/other-apps/qsort/permutations.cert : \
-     defexec/other-apps/qsort/permutations.lisp
-
-
-defexec/other-apps/qsort/programs.cert : acl2x = 0
-defexec/other-apps/qsort/programs.cert : no_pcert = 0
-
-defexec/other-apps/qsort/programs.cert : \
-     defexec/other-apps/qsort/total-order.cert \
-     defexec/other-apps/qsort/nth-update-nth.cert \
-     arithmetic/top-with-meta.cert \
-     defexec/other-apps/qsort/programs.lisp
-
-
-defexec/other-apps/qsort/sort-qs-properties.cert : acl2x = 0
-defexec/other-apps/qsort/sort-qs-properties.cert : no_pcert = 0
-
-defexec/other-apps/qsort/sort-qs-properties.cert : \
-     defexec/other-apps/qsort/split-qs-properties.cert \
-     arithmetic/top-with-meta.cert \
-     defexec/other-apps/qsort/load-extract.cert \
-     defexec/other-apps/qsort/sort-qs-properties.lisp
-
-
-defexec/other-apps/qsort/spec-properties.cert : acl2x = 0
-defexec/other-apps/qsort/spec-properties.cert : no_pcert = 0
-
-defexec/other-apps/qsort/spec-properties.cert : \
-     defexec/other-apps/qsort/programs.cert \
-     defexec/other-apps/qsort/permutations.cert \
-     defexec/other-apps/qsort/spec-properties.lisp
-
-
-defexec/other-apps/qsort/split-qs-properties.cert : acl2x = 0
-defexec/other-apps/qsort/split-qs-properties.cert : no_pcert = 0
-
-defexec/other-apps/qsort/split-qs-properties.cert : \
-     defexec/other-apps/qsort/programs.cert \
-     defexec/other-apps/qsort/merge-intermediate.cert \
-     defexec/other-apps/qsort/extraction.cert \
-     arithmetic/top-with-meta.cert \
-     defexec/other-apps/qsort/split-qs-properties.lisp
-
-
-defexec/other-apps/qsort/total-order.cert : acl2x = 0
-defexec/other-apps/qsort/total-order.cert : no_pcert = 0
-
-defexec/other-apps/qsort/total-order.cert : \
-     defexec/other-apps/qsort/total-order.lisp
-
-
-defexec/other-apps/records/inline.cert : acl2x = 0
-defexec/other-apps/records/inline.cert : no_pcert = 0
-
-defexec/other-apps/records/inline.cert : \
-     defexec/other-apps/records/inline.lisp
-
-
-defexec/other-apps/records/records-bsd.cert : acl2x = 0
-defexec/other-apps/records/records-bsd.cert : no_pcert = 0
-
-defexec/other-apps/records/records-bsd.cert : \
-     misc/total-order-bsd.cert \
-     defexec/other-apps/records/records-bsd.lisp
-
-
-defexec/other-apps/records/records.cert : acl2x = 0
-defexec/other-apps/records/records.cert : no_pcert = 0
-
-defexec/other-apps/records/records.cert : \
-     misc/total-order.cert \
-     defexec/other-apps/records/records.lisp
-
-
-defexec/other-apps/records/recordsim.cert : acl2x = 0
-defexec/other-apps/records/recordsim.cert : no_pcert = 0
-
-defexec/other-apps/records/recordsim.cert : \
-     defexec/other-apps/records/records.cert \
-     defexec/other-apps/records/inline.cert \
-     defexec/other-apps/records/recordsim.lisp
-
-
-defexec/reflexive/reflexive.cert : acl2x = 0
-defexec/reflexive/reflexive.cert : no_pcert = 0
-
-defexec/reflexive/reflexive.cert : \
-     misc/eval.cert \
-     defexec/reflexive/reflexive.lisp
-
-
-defsort/defsort.cert : acl2x = 0
-defsort/defsort.cert : no_pcert = 0
-
-defsort/defsort.cert : \
-     defsort/generic.cert \
-     defsort/defsort.lisp
-
-
-defsort/duplicated-members.cert : acl2x = 0
-defsort/duplicated-members.cert : no_pcert = 0
-
-defsort/duplicated-members.cert : \
-     defsort/uniquep.cert \
-     defsort/duplicity.cert \
-     defsort/duplicated-members.lisp
-
-
-defsort/duplicity.cert : acl2x = 0
-defsort/duplicity.cert : no_pcert = 0
-
-defsort/duplicity.cert : \
-     defsort/duplicity.lisp
-
-
-defsort/examples.cert : acl2x = 0
-defsort/examples.cert : no_pcert = 0
-
-defsort/examples.cert : \
-     defsort/defsort.cert \
-     misc/total-order.cert \
-     misc/assert.cert \
-     defsort/examples.lisp
-
-
-defsort/generic-impl.cert : acl2x = 0
-defsort/generic-impl.cert : no_pcert = 0
-
-defsort/generic-impl.cert : \
-     std/lists/take.cert \
-     std/lists/nthcdr.cert \
-     std/lists/list-fix.cert \
-     defsort/duplicity.cert \
-     ihs/ihs-lemmas.cert \
-     defsort/generic-impl.lisp
-
-
-defsort/generic.cert : acl2x = 0
-defsort/generic.cert : no_pcert = 0
-
-defsort/generic.cert : \
-     defsort/generic-impl.cert \
-     defsort/generic.lisp
-
-
-defsort/remove-dups.cert : acl2x = 0
-defsort/remove-dups.cert : no_pcert = 0
-
-defsort/remove-dups.cert : \
-     defsort/uniquep.cert \
-     misc/hons-help.cert \
-     defsort/remove-dups.lisp
-
-
-defsort/uniquep.cert : acl2x = 0
-defsort/uniquep.cert : no_pcert = 0
-
-defsort/uniquep.cert : \
-     defsort/defsort.cert \
-     misc/total-order.cert \
-     defsort/uniquep.lisp
-
-
-demos/list-theory.cert : acl2x = 0
-demos/list-theory.cert : no_pcert = 0
-
-demos/list-theory.cert : \
-     demos/list-theory.lisp
-
-
-demos/modeling/memories.cert : acl2x = 0
-demos/modeling/memories.cert : no_pcert = 0
-
-demos/modeling/memories.cert : \
-     defexec/other-apps/records/records.cert \
-     cutil/defalist.cert \
-     misc/defun-plus.cert \
-     cutil/portcullis.cert \
-     demos/modeling/memories.lisp \
-     demos/modeling/cert.acl2
-
-
-demos/modeling/network-state-basic.cert : acl2x = 0
-demos/modeling/network-state-basic.cert : no_pcert = 0
-
-demos/modeling/network-state-basic.cert : \
-     make-event/eval.cert \
-     cutil/portcullis.cert \
-     demos/modeling/network-state-basic.lisp \
-     demos/modeling/cert.acl2
-
-
-demos/modeling/network-state.cert : acl2x = 0
-demos/modeling/network-state.cert : no_pcert = 0
-
-demos/modeling/network-state.cert : \
-     make-event/eval.cert \
-     cutil/defaggregate.cert \
-     cutil/deflist.cert \
-     misc/defun-plus.cert \
-     tools/bstar.cert \
-     arithmetic/top.cert \
-     cutil/portcullis.cert \
-     demos/modeling/network-state.lisp \
-     demos/modeling/cert.acl2
-
-
-demos/modeling/nondeterminism.cert : acl2x = 0
-demos/modeling/nondeterminism.cert : no_pcert = 0
-
-demos/modeling/nondeterminism.cert : \
-     make-event/eval.cert \
-     cutil/portcullis.cert \
-     demos/modeling/nondeterminism.lisp \
-     demos/modeling/cert.acl2
-
-
-finite-set-theory/osets/cardinality.cert : acl2x = 0
-finite-set-theory/osets/cardinality.cert : no_pcert = 0
-
-finite-set-theory/osets/cardinality.cert : \
-     finite-set-theory/osets/delete.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/cardinality.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/computed-hints.cert : acl2x = 0
-finite-set-theory/osets/computed-hints.cert : no_pcert = 0
-
-finite-set-theory/osets/computed-hints.cert : \
-     finite-set-theory/osets/instance.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/computed-hints.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/delete.cert : acl2x = 0
-finite-set-theory/osets/delete.cert : no_pcert = 0
-
-finite-set-theory/osets/delete.cert : \
-     finite-set-theory/osets/membership.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/delete.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/difference.cert : acl2x = 0
-finite-set-theory/osets/difference.cert : no_pcert = 0
-
-finite-set-theory/osets/difference.cert : \
-     finite-set-theory/osets/membership.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/difference.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/instance.cert : acl2x = 0
-finite-set-theory/osets/instance.cert : no_pcert = 0
-
-finite-set-theory/osets/instance.cert : \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/instance.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/intersect.cert : acl2x = 0
-finite-set-theory/osets/intersect.cert : no_pcert = 0
-
-finite-set-theory/osets/intersect.cert : \
-     finite-set-theory/osets/membership.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/intersect.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/map-tests.cert : acl2x = 0
-finite-set-theory/osets/map-tests.cert : no_pcert = 0
-
-finite-set-theory/osets/map-tests.cert : \
-     finite-set-theory/osets/map.cert \
-     misc/assert.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/map-tests.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/map.cert : acl2x = 0
-finite-set-theory/osets/map.cert : no_pcert = 0
-
-finite-set-theory/osets/map.cert : \
-     finite-set-theory/osets/quantify.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/map.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/membership.cert : acl2x = 0
-finite-set-theory/osets/membership.cert : no_pcert = 0
-
-finite-set-theory/osets/membership.cert : \
-     finite-set-theory/osets/primitives.cert \
-     finite-set-theory/osets/computed-hints.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/membership.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/outer.cert : acl2x = 0
-finite-set-theory/osets/outer.cert : no_pcert = 0
-
-finite-set-theory/osets/outer.cert : \
-     finite-set-theory/osets/delete.cert \
-     finite-set-theory/osets/union.cert \
-     finite-set-theory/osets/intersect.cert \
-     finite-set-theory/osets/difference.cert \
-     finite-set-theory/osets/cardinality.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/outer.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/portcullis.cert : acl2x = 0
-finite-set-theory/osets/portcullis.cert : no_pcert = 0
-
-finite-set-theory/osets/portcullis.cert : \
-     finite-set-theory/osets/portcullis.lisp \
-     finite-set-theory/osets/portcullis.acl2 \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-
-
-finite-set-theory/osets/primitives.cert : acl2x = 0
-finite-set-theory/osets/primitives.cert : no_pcert = 0
-
-finite-set-theory/osets/primitives.cert : \
-     misc/total-order.cert \
-     tools/rulesets.cert \
-     xdoc/top.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/primitives.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/quantify.cert : acl2x = 0
-finite-set-theory/osets/quantify.cert : no_pcert = 0
-
-finite-set-theory/osets/quantify.cert : \
-     finite-set-theory/osets/sets.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/quantify.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/sets.cert : acl2x = 0
-finite-set-theory/osets/sets.cert : no_pcert = 0
-
-finite-set-theory/osets/sets.cert : \
-     misc/total-order.cert \
-     tools/rulesets.cert \
-     std/lists/list-defuns.cert \
-     finite-set-theory/osets/computed-hints.cert \
-     finite-set-theory/osets/primitives.cert \
-     finite-set-theory/osets/membership.cert \
-     finite-set-theory/osets/outer.cert \
-     finite-set-theory/osets/sort.cert \
-     finite-set-theory/osets/under-set-equiv.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/sets.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/sort.cert : acl2x = 0
-finite-set-theory/osets/sort.cert : no_pcert = 0
-
-finite-set-theory/osets/sort.cert : \
-     finite-set-theory/osets/union.cert \
-     std/lists/app.cert \
-     std/lists/rev.cert \
-     tools/mv-nth.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/sort.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/under-set-equiv.cert : acl2x = 0
-finite-set-theory/osets/under-set-equiv.cert : no_pcert = 0
-
-finite-set-theory/osets/under-set-equiv.cert : \
-     finite-set-theory/osets/outer.cert \
-     finite-set-theory/osets/sort.cert \
-     std/lists/sets.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/under-set-equiv.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/osets/union.cert : acl2x = 0
-finite-set-theory/osets/union.cert : no_pcert = 0
-
-finite-set-theory/osets/union.cert : \
-     finite-set-theory/osets/membership.cert \
-     finite-set-theory/osets/portcullis.cert \
-     finite-set-theory/osets/union.lisp \
-     finite-set-theory/osets/cert.acl2
-
-
-finite-set-theory/set-theory.cert : acl2x = 0
-finite-set-theory/set-theory.cert : no_pcert = 0
-
-finite-set-theory/set-theory.cert : \
-     finite-set-theory/total-ordering.cert \
-     ordinals/e0-ordinal.cert \
-     arithmetic/top-with-meta.cert \
-     finite-set-theory/set-theory.lisp \
-     finite-set-theory/set-theory.acl2
-
-
-finite-set-theory/total-ordering.cert : acl2x = 0
-finite-set-theory/total-ordering.cert : no_pcert = 0
-
-finite-set-theory/total-ordering.cert : \
-     finite-set-theory/total-ordering.lisp
-
-
-hacking/all.cert : acl2x = 0
-hacking/all.cert : no_pcert = 0
-
-hacking/all.cert : \
-     hacking/hacker.cert \
-     hacking/defstruct-parsing.cert \
-     hacking/rewrite-code.cert \
-     hacking/defcode.cert \
-     hacking/raw.cert \
-     hacking/redefun.cert \
-     hacking/bridge.cert \
-     hacking/subsumption.cert \
-     hacking/table-guard.cert \
-     hacking/all.lisp \
-     hacking/all.acl2 \
-     hacking/hacker-pkg.lsp \
-     hacking/rewrite-code-pkg.lsp
-
-
-hacking/bridge.cert : acl2x = 0
-hacking/bridge.cert : no_pcert = 0
-
-hacking/bridge.cert : \
-     hacking/doc-section.cert \
-     hacking/bridge.lisp \
-     hacking/bridge.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/defcode.cert : acl2x = 0
-hacking/defcode.cert : no_pcert = 0
-
-hacking/defcode.cert : \
-     hacking/hacker.cert \
-     hacking/progn-bang-enh.cert \
-     hacking/defcode.lisp \
-     hacking/defcode.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/defstruct-parsing.cert : acl2x = 0
-hacking/defstruct-parsing.cert : no_pcert = 0
-
-hacking/defstruct-parsing.cert : \
-     hacking/defstruct-parsing.lisp \
-     hacking/defstruct-parsing.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/doc-section.cert : acl2x = 0
-hacking/doc-section.cert : no_pcert = 0
-
-hacking/doc-section.cert : \
-     hacking/doc-section.lisp
-
-
-hacking/dynamic-make-event-test.cert : acl2x = 0
-hacking/dynamic-make-event-test.cert : no_pcert = 0
-
-hacking/dynamic-make-event-test.cert : \
-     hacking/defcode.cert \
-     hacking/rewrite-code.cert \
-     hacking/redefun.cert \
-     hacking/dynamic-make-event.cert \
-     hacking/rewrite-code.cert \
-     hacking/dynamic-make-event-test.lisp \
-     hacking/dynamic-make-event-test.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/dynamic-make-event.cert : acl2x = 0
-hacking/dynamic-make-event.cert : no_pcert = 0
-
-hacking/dynamic-make-event.cert : \
-     hacking/rewrite-code.cert \
-     hacking/dynamic-make-event.lisp \
-     hacking/dynamic-make-event.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/evalable-ld-printing.cert : acl2x = 0
-hacking/evalable-ld-printing.cert : no_pcert = 0
-
-hacking/evalable-ld-printing.cert : \
-     misc/evalable-printing.cert \
-     hacking/hacker.cert \
-     hacking/defcode.cert \
-     hacking/subsumption.cert \
-     hacking/raw.cert \
-     hacking/evalable-ld-printing.lisp \
-     hacking/evalable-ld-printing.acl2
-
-
-hacking/hacker.cert : acl2x = 0
-hacking/hacker.cert : no_pcert = 0
-
-hacking/hacker.cert : \
-     hacking/doc-section.cert \
-     hacking/hacker.lisp \
-     hacking/hacker.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/progn-bang-enh.cert : acl2x = 0
-hacking/progn-bang-enh.cert : no_pcert = 0
-
-hacking/progn-bang-enh.cert : \
-     hacking/progn-bang-enh.lisp \
-     hacking/progn-bang-enh.acl2
-
-
-hacking/raw.cert : acl2x = 0
-hacking/raw.cert : no_pcert = 0
-
-hacking/raw.cert : \
-     hacking/defstruct-parsing.cert \
-     hacking/raw.lisp \
-     hacking/raw.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/redefun.cert : acl2x = 0
-hacking/redefun.cert : no_pcert = 0
-
-hacking/redefun.cert : \
-     hacking/redefun.lisp \
-     hacking/redefun.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/rewrite-code.cert : acl2x = 0
-hacking/rewrite-code.cert : no_pcert = 0
-
-hacking/rewrite-code.cert : \
-     hacking/rewrite-code.lisp \
-     hacking/rewrite-code.acl2 \
-     hacking/rewrite-code-pkg.lsp
-
-
-hacking/subsumption.cert : acl2x = 0
-hacking/subsumption.cert : no_pcert = 0
-
-hacking/subsumption.cert : \
-     hacking/doc-section.cert \
-     hacking/subsumption.lisp \
-     hacking/subsumption.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hacking/table-guard.cert : acl2x = 0
-hacking/table-guard.cert : no_pcert = 0
-
-hacking/table-guard.cert : \
-     hacking/defcode.cert \
-     hacking/rewrite-code.cert \
-     hacking/redefun.cert \
-     hacking/rewrite-code.cert \
-     hacking/table-guard.lisp \
-     hacking/table-guard.acl2 \
-     hacking/hacker-pkg.lsp
-
-
-hints/basic-tests.cert : acl2x = 0
-hints/basic-tests.cert : no_pcert = 0
-
-hints/basic-tests.cert : \
-     misc/eval.cert \
-     hints/basic-tests.lisp \
-     hints/basic-tests.acl2
-
-
-hints/consider-hint-tests.cert : acl2x = 0
-hints/consider-hint-tests.cert : no_pcert = 0
-
-hints/consider-hint-tests.cert : \
-     hints/consider-hint.cert \
-     misc/eval.cert \
-     hints/consider-hint-tests.lisp \
-     hints/consider-hint-tests.acl2
-
-
-hints/consider-hint.cert : acl2x = 0
-hints/consider-hint.cert : no_pcert = 0
-
-hints/consider-hint.cert : \
-     hints/huet-lang-algorithm.cert \
-     hints/merge-hint.cert \
-     hints/consider-hint.lisp
-
-
-hints/huet-lang-algorithm-tests.cert : acl2x = 0
-hints/huet-lang-algorithm-tests.cert : no_pcert = 0
-
-hints/huet-lang-algorithm-tests.cert : \
-     hints/huet-lang-algorithm.cert \
-     misc/eval.cert \
-     hints/huet-lang-algorithm-tests.lisp
-
-
-hints/huet-lang-algorithm.cert : acl2x = 0
-hints/huet-lang-algorithm.cert : no_pcert = 0
-
-hints/huet-lang-algorithm.cert : \
-     hints/huet-lang-algorithm.lisp
-
-
-hints/merge-hint.cert : acl2x = 0
-hints/merge-hint.cert : no_pcert = 0
-
-hints/merge-hint.cert : \
-     misc/eval.cert \
-     hints/merge-hint.lisp
-
-
-ihs/@logops.cert : acl2x = 0
-ihs/@logops.cert : no_pcert = 0
-
-ihs/@logops.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     ihs/@logops.lisp
-
-
-ihs/basic-definitions.cert : acl2x = 0
-ihs/basic-definitions.cert : no_pcert = 0
-
-ihs/basic-definitions.cert : \
-     ihs/ihs-doc-topic.cert \
-     ihs/math-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     ihs/basic-definitions.lisp
-
-
-ihs/ihs-definitions.cert : acl2x = 0
-ihs/ihs-definitions.cert : no_pcert = 0
-
-ihs/ihs-definitions.cert : \
-     ihs/ihs-init.cert \
-     ihs/ihs-theories.cert \
-     ihs/logops-definitions.cert \
-     ihs/ihs-definitions.lisp
-
-
-ihs/ihs-doc-topic.cert : acl2x = 0
-ihs/ihs-doc-topic.cert : no_pcert = 0
-
-ihs/ihs-doc-topic.cert : \
-     ihs/ihs-doc-topic.lisp
-
-
-ihs/ihs-init.cert : acl2x = 0
-ihs/ihs-init.cert : no_pcert = 0
-
-ihs/ihs-init.cert : \
-     ihs/ihs-doc-topic.cert \
-     data-structures/utilities.cert \
-     ihs/ihs-init.lisp \
-     ihs/ihs-init.acl2 \
-     data-structures/define-u-package.lsp
-
-
-ihs/ihs-lemmas.cert : acl2x = 0
-ihs/ihs-lemmas.cert : no_pcert = 0
-
-ihs/ihs-lemmas.cert : \
-     ihs/math-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     ihs/logops-lemmas.cert \
-     ihs/ihs-lemmas.lisp
-
-
-ihs/ihs-theories.cert : acl2x = 0
-ihs/ihs-theories.cert : no_pcert = 0
-
-ihs/ihs-theories.cert : \
-     ihs/ihs-init.cert \
-     ihs/ihs-theories.lisp
-
-
-ihs/logops-definitions.cert : acl2x = 0
-ihs/logops-definitions.cert : no_pcert = 0
-
-ihs/logops-definitions.cert : \
-     ihs/ihs-init.cert \
-     ihs/ihs-theories.cert \
-     ihs/math-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     ihs/basic-definitions.cert \
-     ihs/logops-definitions.lisp
-
-
-ihs/logops-lemmas.cert : acl2x = 0
-ihs/logops-lemmas.cert : no_pcert = 0
-
-ihs/logops-lemmas.cert : \
-     ihs/ihs-init.cert \
-     ihs/ihs-theories.cert \
-     ihs/math-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     ihs/logops-definitions.cert \
-     ihs/logops-lemmas.lisp
-
-
-ihs/math-lemmas.cert : acl2x = 0
-ihs/math-lemmas.cert : no_pcert = 0
-
-ihs/math-lemmas.cert : \
-     arithmetic/top.cert \
-     ihs/ihs-init.cert \
-     ihs/math-lemmas.lisp
-
-
-ihs/quotient-remainder-lemmas.cert : acl2x = 0
-ihs/quotient-remainder-lemmas.cert : no_pcert = 0
-
-ihs/quotient-remainder-lemmas.cert : \
-     ihs/ihs-init.cert \
-     ihs/ihs-theories.cert \
-     ihs/math-lemmas.cert \
-     ihs/quotient-remainder-lemmas.lisp
-
-
-leftist-trees/leftist-tree-defthms.cert : acl2x = 0
-leftist-trees/leftist-tree-defthms.cert : no_pcert = 0
-
-leftist-trees/leftist-tree-defthms.cert : \
-     leftist-trees/leftist-tree-defuns.cert \
-     arithmetic-5/top.cert \
-     leftist-trees/leftist-tree-defthms.lisp
-
-
-leftist-trees/leftist-tree-defuns.cert : acl2x = 0
-leftist-trees/leftist-tree-defuns.cert : no_pcert = 0
-
-leftist-trees/leftist-tree-defuns.cert : \
-     leftist-trees/leftist-tree-defuns.lisp
-
-
-leftist-trees/leftist-tree-sort-equivalent.cert : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent.cert : no_pcert = 0
-
-leftist-trees/leftist-tree-sort-equivalent.cert : \
-     sorting/equisort.cert \
-     sorting/isort.cert \
-     leftist-trees/leftist-tree-sort.cert \
-     leftist-trees/leftist-tree-sort-equivalent.lisp
-
-
-leftist-trees/leftist-tree-sort-equivalent2.cert : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent2.cert : no_pcert = 0
-
-leftist-trees/leftist-tree-sort-equivalent2.cert : \
-     sorting/equisort2.cert \
-     sorting/isort.cert \
-     leftist-trees/leftist-tree-sort.cert \
-     leftist-trees/leftist-tree-sort-equivalent2.lisp
-
-
-leftist-trees/leftist-tree-sort-equivalent3.cert : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent3.cert : no_pcert = 0
-
-leftist-trees/leftist-tree-sort-equivalent3.cert : \
-     sorting/equisort3.cert \
-     sorting/isort.cert \
-     leftist-trees/leftist-tree-sort.cert \
-     leftist-trees/leftist-tree-sort-equivalent3.lisp
-
-
-leftist-trees/leftist-tree-sort.cert : acl2x = 0
-leftist-trees/leftist-tree-sort.cert : no_pcert = 0
-
-leftist-trees/leftist-tree-sort.cert : \
-     sorting/perm.cert \
-     sorting/ordered-perms.cert \
-     sorting/convert-perm-to-how-many.cert \
-     leftist-trees/leftist-tree-defuns.cert \
-     leftist-trees/leftist-tree-defthms.cert \
-     leftist-trees/leftist-tree-sort.lisp
-
-
-leftist-trees/top.cert : acl2x = 0
-leftist-trees/top.cert : no_pcert = 0
-
-leftist-trees/top.cert : \
-     leftist-trees/leftist-tree-defuns.cert \
-     leftist-trees/leftist-tree-defthms.cert \
-     leftist-trees/leftist-tree-sort.cert \
-     leftist-trees/top.lisp
-
-
-make-event/acl2x-help.cert : acl2x = 0
-make-event/acl2x-help.cert : no_pcert = 0
-
-make-event/acl2x-help.cert : \
-     misc/hons-help.cert \
-     make-event/acl2x-help.lisp
-
-
-make-event/assert-check-include-1.cert : acl2x = 0
-make-event/assert-check-include-1.cert : no_pcert = 0
-
-make-event/assert-check-include-1.cert : \
-     make-event/assert-check.cert \
-     make-event/eval.cert \
-     make-event/assert-check-include-1.lisp \
-     make-event/assert-check-include-1.acl2
-
-
-make-event/assert-check-include.cert : acl2x = 0
-make-event/assert-check-include.cert : no_pcert = 0
-
-make-event/assert-check-include.cert : \
-     make-event/assert-check.cert \
-     make-event/assert-check-include.lisp
-
-
-make-event/assert-check.cert : acl2x = 0
-make-event/assert-check.cert : no_pcert = 0
-
-make-event/assert-check.cert : \
-     make-event/eval-check.cert \
-     make-event/assert-check.lisp
-
-
-make-event/assert-include.cert : acl2x = 0
-make-event/assert-include.cert : no_pcert = 0
-
-make-event/assert-include.cert : \
-     make-event/assert.cert \
-     make-event/assert-include.lisp \
-     make-event/assert-include.acl2
-
-
-make-event/assert.cert : acl2x = 0
-make-event/assert.cert : no_pcert = 0
-
-make-event/assert.cert : \
-     misc/assert.cert \
-     make-event/assert.lisp
-
-
-make-event/basic-check.cert : acl2x = 0
-make-event/basic-check.cert : no_pcert = 0
-
-make-event/basic-check.cert : \
-     make-event/basic-check.lisp
-
-
-make-event/basic-pkg-check.cert : acl2x = 0
-make-event/basic-pkg-check.cert : no_pcert = 0
-
-make-event/basic-pkg-check.cert : \
-     make-event/basic-pkg-check.lisp \
-     make-event/basic-pkg-check.acl2
-
-
-make-event/basic-pkg.cert : acl2x = 0
-make-event/basic-pkg.cert : no_pcert = 0
-
-make-event/basic-pkg.cert : \
-     make-event/basic-pkg.lisp \
-     make-event/basic-pkg.acl2
-
-
-make-event/basic.cert : acl2x = 0
-make-event/basic.cert : no_pcert = 0
-
-make-event/basic.cert : \
-     make-event/basic.lisp
-
-
-make-event/defconst-fast-examples.cert : acl2x = 0
-make-event/defconst-fast-examples.cert : no_pcert = 0
-
-make-event/defconst-fast-examples.cert : \
-     make-event/defconst-fast.cert \
-     make-event/defconst-fast-examples.lisp
-
-
-make-event/defconst-fast.cert : acl2x = 0
-make-event/defconst-fast.cert : no_pcert = 0
-
-make-event/defconst-fast.cert : \
-     make-event/defconst-fast.lisp
-
-
-make-event/defrefine.cert : acl2x = 0
-make-event/defrefine.cert : no_pcert = 0
-
-make-event/defrefine.cert : \
-     make-event/eval.cert \
-     make-event/defrefine.lisp
-
-
-make-event/defrule.cert : acl2x = 0
-make-event/defrule.cert : no_pcert = 0
-
-make-event/defrule.cert : \
-     make-event/defrule.lisp
-
-
-make-event/defspec.cert : acl2x = 0
-make-event/defspec.cert : no_pcert = 0
-
-make-event/defspec.cert : \
-     make-event/eval.cert \
-     make-event/defspec.lisp
-
-
-make-event/dotimes.cert : acl2x = 0
-make-event/dotimes.cert : no_pcert = 0
-
-make-event/dotimes.cert : \
-     make-event/dotimes.lisp
-
-
-make-event/embeddable-event-forms.cert : acl2x = 0
-make-event/embeddable-event-forms.cert : no_pcert = 0
-
-make-event/embeddable-event-forms.cert : \
-     make-event/embeddable-event-forms.lisp
-
-
-make-event/eval-check-tests.cert : acl2x = 0
-make-event/eval-check-tests.cert : no_pcert = 0
-
-make-event/eval-check-tests.cert : \
-     make-event/eval-check.cert \
-     make-event/eval-check-tests.lisp
-
-
-make-event/eval-check.cert : acl2x = 0
-make-event/eval-check.cert : no_pcert = 0
-
-make-event/eval-check.cert : \
-     make-event/eval-check.lisp
-
-
-make-event/eval-tests.cert : acl2x = 0
-make-event/eval-tests.cert : no_pcert = 0
-
-make-event/eval-tests.cert : \
-     make-event/eval.cert \
-     make-event/eval-tests.lisp
-
-
-make-event/eval.cert : acl2x = 0
-make-event/eval.cert : no_pcert = 0
-
-make-event/eval.cert : \
-     misc/eval.cert \
-     make-event/eval.lisp
-
-
-make-event/gen-defthm-check.cert : acl2x = 0
-make-event/gen-defthm-check.cert : no_pcert = 0
-
-make-event/gen-defthm-check.cert : \
-     misc/expander.cert \
-     make-event/gen-defthm-check.lisp
-
-
-make-event/gen-defthm.cert : acl2x = 0
-make-event/gen-defthm.cert : no_pcert = 0
-
-make-event/gen-defthm.cert : \
-     misc/expander.cert \
-     make-event/gen-defthm.lisp
-
-
-make-event/gen-defun-check.cert : acl2x = 0
-make-event/gen-defun-check.cert : no_pcert = 0
-
-make-event/gen-defun-check.cert : \
-     make-event/gen-defun-check.lisp
-
-
-make-event/gen-defun.cert : acl2x = 0
-make-event/gen-defun.cert : no_pcert = 0
-
-make-event/gen-defun.cert : \
-     make-event/gen-defun.lisp
-
-
-make-event/inline-book.cert : acl2x = 0
-make-event/inline-book.cert : no_pcert = 0
-
-make-event/inline-book.cert : \
-     make-event/inline-book.lisp
-
-
-make-event/local-elided-include.cert : acl2x = 0
-make-event/local-elided-include.cert : no_pcert = 0
-
-make-event/local-elided-include.cert : \
-     make-event/local-elided.cert \
-     make-event/eval.cert \
-     misc/file-io.cert \
-     make-event/local-elided-include.lisp
-
-
-make-event/local-elided.cert : acl2x = 0
-make-event/local-elided.cert : no_pcert = 0
-
-make-event/local-elided.cert : \
-     make-event/eval.cert \
-     make-event/local-elided.lisp
-
-
-make-event/local-requires-skip-check-include.cert : acl2x = 0
-make-event/local-requires-skip-check-include.cert : no_pcert = 0
-
-make-event/local-requires-skip-check-include.cert : \
-     misc/file-io.cert \
-     make-event/local-requires-skip-check.cert \
-     make-event/eval.cert \
-     make-event/local-requires-skip-check-include.lisp
-
-
-make-event/local-requires-skip-check.cert : acl2x = 0
-make-event/local-requires-skip-check.cert : no_pcert = 0
-
-make-event/local-requires-skip-check.cert : \
-     make-event/eval.cert \
-     make-event/local-requires-skip-check.lisp
-
-
-make-event/logical-tangent.cert : acl2x = 0
-make-event/logical-tangent.cert : no_pcert = 0
-
-make-event/logical-tangent.cert : \
-     make-event/logical-tangent.lisp
-
-
-make-event/macros-include.cert : acl2x = 0
-make-event/macros-include.cert : no_pcert = 0
-
-make-event/macros-include.cert : \
-     make-event/macros.cert \
-     make-event/eval.cert \
-     misc/file-io.cert \
-     make-event/macros-include.lisp
-
-
-make-event/macros-skip-proofs-include.cert : acl2x = 0
-make-event/macros-skip-proofs-include.cert : no_pcert = 0
-
-make-event/macros-skip-proofs-include.cert : \
-     make-event/macros-skip-proofs.cert \
-     make-event/eval.cert \
-     misc/file-io.cert \
-     make-event/macros-skip-proofs-include.lisp \
-     make-event/macros-skip-proofs-include.acl2
-
-
-make-event/macros-skip-proofs.cert : acl2x = 0
-make-event/macros-skip-proofs.cert : no_pcert = 0
-
-make-event/macros-skip-proofs.cert : \
-     make-event/macros-skip-proofs.lisp \
-     make-event/macros-skip-proofs.acl2
-
-
-make-event/macros.cert : acl2x = 0
-make-event/macros.cert : no_pcert = 0
-
-make-event/macros.cert : \
-     make-event/eval.cert \
-     make-event/macros.lisp
-
-
-make-event/make-redundant.cert : acl2x = 0
-make-event/make-redundant.cert : no_pcert = 0
-
-make-event/make-redundant.cert : \
-     make-event/make-redundant.lisp
-
-
-make-event/nested-check.cert : acl2x = 0
-make-event/nested-check.cert : no_pcert = 0
-
-make-event/nested-check.cert : \
-     make-event/nested-check.lisp
-
-
-make-event/nested.cert : acl2x = 0
-make-event/nested.cert : no_pcert = 0
-
-make-event/nested.cert : \
-     make-event/nested.lisp
-
-
-make-event/portcullis-expansion-include.cert : acl2x = 0
-make-event/portcullis-expansion-include.cert : no_pcert = 0
-
-make-event/portcullis-expansion-include.cert : \
-     make-event/portcullis-expansion.cert \
-     make-event/portcullis-expansion.cert \
-     make-event/portcullis-expansion-include.lisp \
-     make-event/portcullis-expansion-include.acl2
-
-
-make-event/portcullis-expansion.cert : acl2x = 0
-make-event/portcullis-expansion.cert : no_pcert = 0
-
-make-event/portcullis-expansion.cert : \
-     make-event/eval.cert \
-     make-event/portcullis-expansion.lisp \
-     make-event/portcullis-expansion.acl2
-
-
-make-event/proof-by-arith.cert : acl2x = 0
-make-event/proof-by-arith.cert : no_pcert = 0
-
-make-event/proof-by-arith.cert : \
-     arithmetic/top-with-meta.cert \
-     arithmetic-3/top.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel5/arithmetic/top.cert \
-     arithmetic-5/top.cert \
-     make-event/proof-by-arith.lisp
-
-
-make-event/read-from-file.cert : acl2x = 0
-make-event/read-from-file.cert : no_pcert = 0
-
-make-event/read-from-file.cert : \
-     misc/file-io.cert \
-     misc/file-io.cert \
-     make-event/read-from-file.lisp
-
-
-make-event/require-book.cert : acl2x = 0
-make-event/require-book.cert : no_pcert = 0
-
-make-event/require-book.cert : \
-     make-event/require-book.lisp
-
-
-make-event/test-case-check.cert : acl2x = 0
-make-event/test-case-check.cert : no_pcert = 0
-
-make-event/test-case-check.cert : \
-     make-event/assert-check.cert \
-     make-event/test-case-check.lisp
-
-
-make-event/test-case.cert : acl2x = 0
-make-event/test-case.cert : no_pcert = 0
-
-make-event/test-case.cert : \
-     make-event/assert.cert \
-     make-event/test-case.lisp
-
-
-meta/meta-plus-equal.cert : acl2x = 0
-meta/meta-plus-equal.cert : no_pcert = 0
-
-meta/meta-plus-equal.cert : \
-     meta/term-defuns.cert \
-     meta/term-lemmas.cert \
-     meta/meta-plus-equal.lisp
-
-
-meta/meta-plus-lessp.cert : acl2x = 0
-meta/meta-plus-lessp.cert : no_pcert = 0
-
-meta/meta-plus-lessp.cert : \
-     meta/term-defuns.cert \
-     meta/term-lemmas.cert \
-     meta/meta-plus-lessp.lisp
-
-
-meta/meta-times-equal.cert : acl2x = 0
-meta/meta-times-equal.cert : no_pcert = 0
-
-meta/meta-times-equal.cert : \
-     meta/term-defuns.cert \
-     meta/term-lemmas.cert \
-     arithmetic/equalities.cert \
-     meta/meta-times-equal.lisp
-
-
-meta/meta.cert : acl2x = 0
-meta/meta.cert : no_pcert = 0
-
-meta/meta.cert : \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     meta/meta-times-equal.cert \
-     meta/meta.lisp
-
-
-meta/pseudo-termp-lemmas.cert : acl2x = 0
-meta/pseudo-termp-lemmas.cert : no_pcert = 0
-
-meta/pseudo-termp-lemmas.cert : \
-     meta/term-lemmas.cert \
-     meta/pseudo-termp-lemmas.lisp
-
-
-meta/term-defuns.cert : acl2x = 0
-meta/term-defuns.cert : no_pcert = 0
-
-meta/term-defuns.cert : \
-     meta/term-defuns.lisp
-
-
-meta/term-lemmas.cert : acl2x = 0
-meta/term-lemmas.cert : no_pcert = 0
-
-meta/term-lemmas.cert : \
-     meta/term-defuns.cert \
-     meta/term-lemmas.lisp
-
-
-misc/assert.cert : acl2x = 0
-misc/assert.cert : no_pcert = 0
-
-misc/assert.cert : \
-     misc/eval.cert \
-     misc/assert.lisp
-
-
-misc/bash.cert : acl2x = 0
-misc/bash.cert : no_pcert = 0
-
-misc/bash.cert : \
-     misc/bash.lisp
-
-
-misc/beta-reduce.cert : acl2x = 0
-misc/beta-reduce.cert : no_pcert = 0
-
-misc/beta-reduce.cert : \
-     misc/beta-reduce.lisp
-
-
-misc/callers-and-ancestors.cert : acl2x = 0
-misc/callers-and-ancestors.cert : no_pcert = 0
-
-misc/callers-and-ancestors.cert : \
-     misc/callers-and-ancestors.lisp
-
-
-misc/character-encoding-test.cert : acl2x = 0
-misc/character-encoding-test.cert : no_pcert = 0
-
-misc/character-encoding-test.cert : \
-     misc/character-encoding-test.lisp
-
-
-misc/check-acl2-exports.cert : acl2x = 0
-misc/check-acl2-exports.cert : no_pcert = 0
-
-misc/check-acl2-exports.cert : \
-     misc/check-acl2-exports.lisp
-
-
-misc/check-state.cert : acl2x = 0
-misc/check-state.cert : no_pcert = 0
-
-misc/check-state.cert : \
-     misc/check-state.lisp
-
-
-misc/computed-hint-rewrite.cert : acl2x = 0
-misc/computed-hint-rewrite.cert : no_pcert = 0
-
-misc/computed-hint-rewrite.cert : \
-     misc/computed-hint-rewrite.lisp
-
-
-misc/computed-hint.cert : acl2x = 0
-misc/computed-hint.cert : no_pcert = 0
-
-misc/computed-hint.cert : \
-     misc/computed-hint.lisp
-
-
-misc/congruent-stobjs-test.cert : acl2x = 0
-misc/congruent-stobjs-test.cert : no_pcert = 0
-
-misc/congruent-stobjs-test.cert : \
-     misc/eval.cert \
-     misc/congruent-stobjs-test.lisp
-
-
-misc/csort.cert : acl2x = 0
-misc/csort.cert : no_pcert = 0
-
-misc/csort.cert : \
-     misc/csort.lisp
-
-
-misc/dead-events.cert : acl2x = 0
-misc/dead-events.cert : no_pcert = 0
-
-misc/dead-events.cert : \
-     misc/dead-events.lisp
-
-
-misc/defabsstobj-example-1.cert : acl2x = 0
-misc/defabsstobj-example-1.cert : no_pcert = 0
-
-misc/defabsstobj-example-1.cert : \
-     misc/defabsstobj-example-1.lisp
-
-
-misc/defabsstobj-example-2.cert : acl2x = 0
-misc/defabsstobj-example-2.cert : no_pcert = 0
-
-misc/defabsstobj-example-2.cert : \
-     misc/defabsstobj-example-2.lisp
-
-
-misc/defabsstobj-example-3.cert : acl2x = 0
-misc/defabsstobj-example-3.cert : no_pcert = 0
-
-misc/defabsstobj-example-3.cert : \
-     misc/defabsstobj-example-3.lisp
-
-
-misc/defabsstobj-example-4.cert : acl2x = 0
-misc/defabsstobj-example-4.cert : no_pcert = 0
-
-misc/defabsstobj-example-4.cert : \
-     misc/defabsstobj-example-4.lisp \
-     misc/defabsstobj-example-4.acl2
-
-
-misc/defattach-bang.cert : acl2x = 0
-misc/defattach-bang.cert : no_pcert = 0
-
-misc/defattach-bang.cert : \
-     misc/defattach-bang.lisp
-
-
-misc/defattach-example.cert : acl2x = 0
-misc/defattach-example.cert : no_pcert = 0
-
-misc/defattach-example.cert : \
-     arithmetic/top.cert \
-     misc/defattach-example.lisp
-
-
-misc/definline.cert : acl2x = 0
-misc/definline.cert : no_pcert = 0
-
-misc/definline.cert : \
-     misc/doc-section.cert \
-     misc/definline.lisp
-
-
-misc/defmac.cert : acl2x = 0
-misc/defmac.cert : no_pcert = 0
-
-misc/defmac.cert : \
-     misc/doc-section.cert \
-     misc/defmac.lisp
-
-
-misc/defopener.cert : acl2x = 0
-misc/defopener.cert : no_pcert = 0
-
-misc/defopener.cert : \
-     misc/doc-section.cert \
-     misc/bash.cert \
-     misc/defopener.lisp
-
-
-misc/defp.cert : acl2x = 0
-misc/defp.cert : no_pcert = 0
-
-misc/defp.cert : \
-     misc/defpun.cert \
-     misc/defp.lisp
-
-
-misc/defproxy-test.cert : acl2x = 0
-misc/defproxy-test.cert : no_pcert = 0
-
-misc/defproxy-test.cert : \
-     misc/defproxy-test.lisp \
-     misc/defproxy-test.acl2
-
-
-misc/defpun.cert : acl2x = 0
-misc/defpun.cert : no_pcert = 0
-
-misc/defpun.cert : \
-     misc/defpun.lisp
-
-
-misc/defun-plus.cert : acl2x = 0
-misc/defun-plus.cert : no_pcert = 0
-
-misc/defun-plus.cert : \
-     misc/defun-plus.lisp
-
-
-misc/dft-ex.cert : acl2x = 0
-misc/dft-ex.cert : no_pcert = 0
-
-misc/dft-ex.cert : \
-     misc/dft.cert \
-     arithmetic/top-with-meta.cert \
-     misc/dft-ex.lisp \
-     misc/dft-ex.acl2
-
-
-misc/dft.cert : acl2x = 0
-misc/dft.cert : no_pcert = 0
-
-misc/dft.cert : \
-     misc/dft.lisp
-
-
-misc/dijkstra-shortest-path.cert : acl2x = 0
-misc/dijkstra-shortest-path.cert : no_pcert = 0
-
-misc/dijkstra-shortest-path.cert : \
-     misc/dijkstra-shortest-path.lisp
-
-
-misc/disassemble.cert : acl2x = 0
-misc/disassemble.cert : no_pcert = 0
-
-misc/disassemble.cert : \
-     misc/disassemble.lisp \
-     misc/disassemble.acl2
-
-
-misc/doc-section.cert : acl2x = 0
-misc/doc-section.cert : no_pcert = 0
-
-misc/doc-section.cert : \
-     misc/doc-section.lisp
-
-
-misc/dump-events.cert : acl2x = 0
-misc/dump-events.cert : no_pcert = 0
-
-misc/dump-events.cert : \
-     misc/doc-section.cert \
-     misc/dump-events.lisp
-
-
-misc/equal-by-g-help.cert : acl2x = 0
-misc/equal-by-g-help.cert : no_pcert = 0
-
-misc/equal-by-g-help.cert : \
-     misc/records.cert \
-     misc/equal-by-g-help.lisp
-
-
-misc/equal-by-g.cert : acl2x = 0
-misc/equal-by-g.cert : no_pcert = 0
-
-misc/equal-by-g.cert : \
-     misc/records.cert \
-     misc/equal-by-g-help.cert \
-     misc/equal-by-g.lisp
-
-
-misc/eval.cert : acl2x = 0
-misc/eval.cert : no_pcert = 0
-
-misc/eval.cert : \
-     misc/eval.lisp
-
-
-misc/evalable-printing.cert : acl2x = 0
-misc/evalable-printing.cert : no_pcert = 0
-
-misc/evalable-printing.cert : \
-     misc/evalable-printing.lisp
-
-
-misc/expander.cert : acl2x = 0
-misc/expander.cert : no_pcert = 0
-
-misc/expander.cert : \
-     misc/doc-section.cert \
-     misc/expander.lisp
-
-
-misc/fast-coerce.cert : acl2x = 0
-misc/fast-coerce.cert : no_pcert = 0
-
-misc/fast-coerce.cert : \
-     arithmetic/top-with-meta.cert \
-     data-structures/list-defthms.cert \
-     misc/fast-coerce.lisp
-
-
-misc/fibonacci.cert : acl2x = 0
-misc/fibonacci.cert : no_pcert = 0
-
-misc/fibonacci.cert : \
-     misc/int-division.cert \
-     misc/grcd.cert \
-     misc/fibonacci.lisp
-
-
-misc/file-io.cert : acl2x = 0
-misc/file-io.cert : no_pcert = 0
-
-misc/file-io.cert : \
-     misc/file-io.lisp
-
-
-misc/find-lemmas.cert : acl2x = 0
-misc/find-lemmas.cert : no_pcert = 0
-
-misc/find-lemmas.cert : \
-     misc/find-lemmas.lisp
-
-
-misc/gentle.cert : acl2x = 0
-misc/gentle.cert : no_pcert = 0
-
-misc/gentle.cert : \
-     misc/gentle.lisp
-
-
-misc/getprop.cert : acl2x = 0
-misc/getprop.cert : no_pcert = 0
-
-misc/getprop.cert : \
-     misc/getprop.lisp
-
-
-misc/goodstein.cert : acl2x = 0
-misc/goodstein.cert : no_pcert = 0
-
-misc/goodstein.cert : \
-     ordinals/e0-ordinal.cert \
-     misc/goodstein.lisp
-
-
-misc/grcd.cert : acl2x = 0
-misc/grcd.cert : no_pcert = 0
-
-misc/grcd.cert : \
-     misc/int-division.cert \
-     ordinals/e0-ordinal.cert \
-     misc/grcd.lisp
-
-
-misc/hanoi.cert : acl2x = 0
-misc/hanoi.cert : no_pcert = 0
-
-misc/hanoi.cert : \
-     misc/hanoi.lisp \
-     misc/hanoi.acl2
-
-
-misc/hons-help.cert : acl2x = 0
-misc/hons-help.cert : no_pcert = 0
-
-misc/hons-help.cert : \
-     misc/gentle.cert \
-     misc/hons-help.lisp
-
-
-misc/hons-help2.cert : acl2x = 0
-misc/hons-help2.cert : no_pcert = 0
-
-misc/hons-help2.cert : \
-     misc/hons-help.cert \
-     misc/hons-help2.lisp
-
-
-misc/hons-tests.cert : acl2x = 0
-misc/hons-tests.cert : no_pcert = 0
-
-misc/hons-tests.cert : \
-     misc/qi.cert \
-     misc/hons-tests.lisp
-
-
-misc/how-to-prove-thms.cert : acl2x = 0
-misc/how-to-prove-thms.cert : no_pcert = 0
-
-misc/how-to-prove-thms.cert : \
-     misc/how-to-prove-thms.lisp
-
-
-misc/int-division.cert : acl2x = 0
-misc/int-division.cert : no_pcert = 0
-
-misc/int-division.cert : \
-     arithmetic/equalities.cert \
-     arithmetic/inequalities.cert \
-     misc/int-division.lisp
-
-
-misc/integer-type-set-test.cert : acl2x = 0
-misc/integer-type-set-test.cert : no_pcert = 0
-
-misc/integer-type-set-test.cert : \
-     misc/integer-type-set-test.lisp
-
-
-misc/invariants.cert : acl2x = 0
-misc/invariants.cert : no_pcert = 0
-
-misc/invariants.cert : \
-     misc/bash.cert \
-     misc/invariants.lisp
-
-
-misc/meta-lemmas.cert : acl2x = 0
-misc/meta-lemmas.cert : no_pcert = 0
-
-misc/meta-lemmas.cert : \
-     misc/doc-section.cert \
-     misc/meta-lemmas.lisp
-
-
-misc/misc2/defpun-exec-domain-example.cert : acl2x = 0
-misc/misc2/defpun-exec-domain-example.cert : no_pcert = 0
-
-misc/misc2/defpun-exec-domain-example.cert : \
-     misc/defpun.cert \
-     misc/eval.cert \
-     misc/misc2/defpun-exec-domain-example.lisp
-
-
-misc/misc2/misc.cert : acl2x = 0
-misc/misc2/misc.cert : no_pcert = 0
-
-misc/misc2/misc.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     misc/misc2/misc.lisp
-
-
-misc/misc2/reverse-by-separation.cert : acl2x = 0
-misc/misc2/reverse-by-separation.cert : no_pcert = 0
-
-misc/misc2/reverse-by-separation.cert : \
-     arithmetic/top-with-meta.cert \
-     coi/bags/top.cert \
-     coi/bags/top.cert \
-     misc/misc2/reverse-by-separation.lisp \
-     misc/misc2/reverse-by-separation.acl2
-
-
-misc/misc2/ruler-extenders-tests.cert : acl2x = 0
-misc/misc2/ruler-extenders-tests.cert : no_pcert = 0
-
-misc/misc2/ruler-extenders-tests.cert : \
-     misc/eval.cert \
-     misc/misc2/ruler-extenders-tests.lisp \
-     misc/misc2/ruler-extenders-tests.acl2
-
-
-misc/misc2/step-limits.cert : acl2x = 0
-misc/misc2/step-limits.cert : no_pcert = 0
-
-misc/misc2/step-limits.cert : \
-     misc/eval.cert \
-     misc/misc2/step-limits.lisp
-
-
-misc/mult.cert : acl2x = 0
-misc/mult.cert : no_pcert = 0
-
-misc/mult.cert : \
-     arithmetic/top-with-meta.cert \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     data-structures/structures.cert \
-     data-structures/array1.cert \
-     ihs/@logops.cert \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     data-structures/deflist.cert \
-     data-structures/defalist.cert \
-     misc/meta-lemmas.cert \
-     misc/mult.lisp
-
-
-misc/oprof.cert : acl2x = 0
-misc/oprof.cert : no_pcert = 0
-
-misc/oprof.cert : \
-     misc/oprof.lisp \
-     misc/oprof.acl2
-
-
-misc/priorities.cert : acl2x = 0
-misc/priorities.cert : no_pcert = 0
-
-misc/priorities.cert : \
-     misc/priorities.lisp
-
-
-misc/problem13.cert : acl2x = 0
-misc/problem13.cert : no_pcert = 0
-
-misc/problem13.cert : \
-     arithmetic/equalities.cert \
-     arithmetic/inequalities.cert \
-     ordinals/e0-ordinal.cert \
-     misc/problem13.lisp
-
-
-misc/process-book-readme.cert : acl2x = 0
-misc/process-book-readme.cert : no_pcert = 0
-
-misc/process-book-readme.cert : \
-     misc/process-book-readme.lisp
-
-
-misc/profiling.cert : acl2x = 0
-misc/profiling.cert : no_pcert = 0
-
-misc/profiling.cert : \
-     misc/profiling.lisp \
-     misc/profiling.acl2
-
-
-misc/qi-correct.cert : acl2x = 0
-misc/qi-correct.cert : no_pcert = 0
-
-misc/qi-correct.cert : \
-     misc/qi.cert \
-     misc/qi-correct.lisp \
-     misc/qi-correct.acl2
-
-
-misc/qi.cert : acl2x = 0
-misc/qi.cert : no_pcert = 0
-
-misc/qi.cert : \
-     misc/hons-help2.cert \
-     misc/qi.lisp \
-     misc/qi.acl2
-
-
-misc/radix.cert : acl2x = 0
-misc/radix.cert : no_pcert = 0
-
-misc/radix.cert : \
-     arithmetic-2/meta/top.cert \
-     arithmetic-2/floor-mod/floor-mod.cert \
-     misc/radix.lisp \
-     misc/radix.acl2
-
-
-misc/random.cert : acl2x = 0
-misc/random.cert : no_pcert = 0
-
-misc/random.cert : \
-     arithmetic-2/floor-mod/floor-mod.cert \
-     misc/random.lisp
-
-
-misc/records-bsd.cert : acl2x = 0
-misc/records-bsd.cert : no_pcert = 0
-
-misc/records-bsd.cert : \
-     misc/total-order-bsd.cert \
-     misc/records-bsd.lisp
-
-
-misc/records.cert : acl2x = 0
-misc/records.cert : no_pcert = 0
-
-misc/records.cert : \
-     misc/total-order.cert \
-     misc/records.lisp
-
-
-misc/records0.cert : acl2x = 0
-misc/records0.cert : no_pcert = 0
-
-misc/records0.cert : \
-     misc/total-order.cert \
-     misc/records0.lisp
-
-
-misc/redef-pkg.cert : acl2x = 0
-misc/redef-pkg.cert : no_pcert = 0
-
-misc/redef-pkg.cert : \
-     misc/redef-pkg.lisp \
-     misc/redef-pkg.acl2
-
-
-misc/rtl-untranslate.cert : acl2x = 0
-misc/rtl-untranslate.cert : no_pcert = 0
-
-misc/rtl-untranslate.cert : \
-     misc/symbol-btree.cert \
-     misc/rtl-untranslate.lisp
-
-
-misc/save-time.cert : acl2x = 0
-misc/save-time.cert : no_pcert = 0
-
-misc/save-time.cert : \
-     misc/save-time.lisp
-
-
-misc/seq.cert : acl2x = 0
-misc/seq.cert : no_pcert = 0
-
-misc/seq.cert : \
-     misc/seq.lisp
-
-
-misc/seqw.cert : acl2x = 0
-misc/seqw.cert : no_pcert = 0
-
-misc/seqw.cert : \
-     misc/seq.cert \
-     misc/seqw.lisp
-
-
-misc/simplify-defuns.cert : acl2x = 0
-misc/simplify-defuns.cert : no_pcert = 0
-
-misc/simplify-defuns.cert : \
-     misc/file-io.cert \
-     misc/simplify-defuns.lisp
-
-
-misc/simplify-thm.cert : acl2x = 0
-misc/simplify-thm.cert : no_pcert = 0
-
-misc/simplify-thm.cert : \
-     misc/bash.cert \
-     misc/simplify-thm.lisp
-
-
-misc/sin-cos.cert : acl2x = 0
-misc/sin-cos.cert : no_pcert = 0
-
-misc/sin-cos.cert : \
-     misc/doc-section.cert \
-     misc/sin-cos.lisp
-
-
-misc/sort-symbols.cert : acl2x = 0
-misc/sort-symbols.cert : no_pcert = 0
-
-misc/sort-symbols.cert : \
-     misc/sort-symbols.lisp
-
-
-misc/sticky-disable.cert : acl2x = 0
-misc/sticky-disable.cert : no_pcert = 0
-
-misc/sticky-disable.cert : \
-     misc/sticky-disable.lisp
-
-
-misc/symbol-btree.cert : acl2x = 0
-misc/symbol-btree.cert : no_pcert = 0
-
-misc/symbol-btree.cert : \
-     ihs/quotient-remainder-lemmas.cert \
-     arithmetic/top.cert \
-     std/lists/take.cert \
-     arithmetic/top.cert \
-     arithmetic/top.cert \
-     misc/symbol-btree.lisp
-
-
-misc/total-order-bsd.cert : acl2x = 0
-misc/total-order-bsd.cert : no_pcert = 0
-
-misc/total-order-bsd.cert : \
-     misc/total-order-bsd.lisp
-
-
-misc/total-order.cert : acl2x = 0
-misc/total-order.cert : no_pcert = 0
-
-misc/total-order.cert : \
-     xdoc/top.cert \
-     misc/total-order-bsd.cert \
-     misc/total-order.lisp
-
-
-misc/trace-star.cert : acl2x = 0
-misc/trace-star.cert : no_pcert = 0
-
-misc/trace-star.cert : \
-     misc/evalable-printing.cert \
-     misc/trace-star.lisp
-
-
-misc/transfinite.cert : acl2x = 0
-misc/transfinite.cert : no_pcert = 0
-
-misc/transfinite.cert : \
-     misc/transfinite.lisp
-
-
-misc/untranslate-patterns.cert : acl2x = 0
-misc/untranslate-patterns.cert : no_pcert = 0
-
-misc/untranslate-patterns.cert : \
-     misc/symbol-btree.cert \
-     misc/untranslate-patterns.lisp
-
-
-misc/wet.cert : acl2x = 0
-misc/wet.cert : no_pcert = 0
-
-misc/wet.cert : \
-     misc/wet.lisp
-
-
-models/jvm/m1-original/m1-story.cert : acl2x = 0
-models/jvm/m1-original/m1-story.cert : no_pcert = 0
-
-models/jvm/m1-original/m1-story.cert : \
-     models/jvm/m1-original/problem-set-1-answers.cert \
-     arithmetic-3/extra/top-ext.cert \
-     models/jvm/m1-original/problem-set-1-answers.cert \
-     models/jvm/m1-original/m1-story.lisp \
-     models/jvm/m1-original/m1-story.acl2
-
-
-models/jvm/m1-original/problem-set-1-answers.cert : acl2x = 0
-models/jvm/m1-original/problem-set-1-answers.cert : no_pcert = 0
-
-models/jvm/m1-original/problem-set-1-answers.cert : \
-     models/jvm/m1-original/problem-set-1-answers.lisp \
-     models/jvm/m1-original/problem-set-1-answers.acl2
-
-
-models/jvm/m1/alternating-sum-variant.cert : acl2x = 0
-models/jvm/m1/alternating-sum-variant.cert : no_pcert = 0
-
-models/jvm/m1/alternating-sum-variant.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/alternating-sum-variant.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/alternating-sum.cert : acl2x = 0
-models/jvm/m1/alternating-sum.cert : no_pcert = 0
-
-models/jvm/m1/alternating-sum.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/alternating-sum.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/bexpt.cert : acl2x = 0
-models/jvm/m1/bexpt.cert : no_pcert = 0
-
-models/jvm/m1/bexpt.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/bexpt.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/defsys-utilities.cert : acl2x = 0
-models/jvm/m1/defsys-utilities.cert : no_pcert = 0
-
-models/jvm/m1/defsys-utilities.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/defsys-utilities.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/defsys.cert : acl2x = 0
-models/jvm/m1/defsys.cert : no_pcert = 0
-
-models/jvm/m1/defsys.cert : \
-     models/jvm/m1/defsys-utilities.cert \
-     models/jvm/m1/defsys.lisp \
-     models/jvm/m1/defsys.acl2
-
-
-models/jvm/m1/div.cert : acl2x = 0
-models/jvm/m1/div.cert : no_pcert = 0
-
-models/jvm/m1/div.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/div.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/even-solution-1.cert : acl2x = 0
-models/jvm/m1/even-solution-1.cert : no_pcert = 0
-
-models/jvm/m1/even-solution-1.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/even-solution-1.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/even-solution-2.cert : acl2x = 0
-models/jvm/m1/even-solution-2.cert : no_pcert = 0
-
-models/jvm/m1/even-solution-2.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/even-solution-2.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/expt.cert : acl2x = 0
-models/jvm/m1/expt.cert : no_pcert = 0
-
-models/jvm/m1/expt.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/expt.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/fact.cert : acl2x = 0
-models/jvm/m1/fact.cert : no_pcert = 0
-
-models/jvm/m1/fact.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/fact.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/fib.cert : acl2x = 0
-models/jvm/m1/fib.cert : no_pcert = 0
-
-models/jvm/m1/fib.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/fib.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/find-k!.cert : acl2x = 0
-models/jvm/m1/find-k!.cert : no_pcert = 0
-
-models/jvm/m1/find-k!.cert : \
-     models/jvm/m1/theorems-a-and-b.cert \
-     models/jvm/m1/find-k!.lisp \
-     models/jvm/m1/find-k!.acl2
-
-
-models/jvm/m1/funny-fact.cert : acl2x = 0
-models/jvm/m1/funny-fact.cert : no_pcert = 0
-
-models/jvm/m1/funny-fact.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/funny-fact.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/implementation.cert : acl2x = 0
-models/jvm/m1/implementation.cert : no_pcert = 0
-
-models/jvm/m1/implementation.cert : \
-     models/jvm/m1/defsys.cert \
-     models/jvm/m1/tmi-reductions.cert \
-     models/jvm/m1/implementation.lisp \
-     models/jvm/m1/implementation.acl2
-
-
-models/jvm/m1/lessp.cert : acl2x = 0
-models/jvm/m1/lessp.cert : no_pcert = 0
-
-models/jvm/m1/lessp.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/lessp.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/low-seven.cert : acl2x = 0
-models/jvm/m1/low-seven.cert : no_pcert = 0
-
-models/jvm/m1/low-seven.cert : \
-     models/jvm/m1/defsys.cert \
-     models/jvm/m1/low-seven.lisp \
-     models/jvm/m1/low-seven.acl2
-
-
-models/jvm/m1/m1.cert : acl2x = 0
-models/jvm/m1/m1.cert : no_pcert = 0
-
-models/jvm/m1/m1.cert : \
-     arithmetic-5/top.cert \
-     models/jvm/m1/m1.lisp \
-     models/jvm/m1/m1.acl2
-
-
-models/jvm/m1/magic.cert : acl2x = 0
-models/jvm/m1/magic.cert : no_pcert = 0
-
-models/jvm/m1/magic.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/magic.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/power.cert : acl2x = 0
-models/jvm/m1/power.cert : no_pcert = 0
-
-models/jvm/m1/power.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/power.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/sign.cert : acl2x = 0
-models/jvm/m1/sign.cert : no_pcert = 0
-
-models/jvm/m1/sign.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/sign.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/sum.cert : acl2x = 0
-models/jvm/m1/sum.cert : no_pcert = 0
-
-models/jvm/m1/sum.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/sum.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/sumsq.cert : acl2x = 0
-models/jvm/m1/sumsq.cert : no_pcert = 0
-
-models/jvm/m1/sumsq.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/sumsq.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/template.cert : acl2x = 0
-models/jvm/m1/template.cert : no_pcert = 0
-
-models/jvm/m1/template.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/template.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/theorems-a-and-b.cert : acl2x = 0
-models/jvm/m1/theorems-a-and-b.cert : no_pcert = 0
-
-models/jvm/m1/theorems-a-and-b.cert : \
-     models/jvm/m1/tmi-reductions.cert \
-     models/jvm/m1/implementation.cert \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/theorems-a-and-b.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/tmi-reductions.cert : acl2x = 0
-models/jvm/m1/tmi-reductions.cert : no_pcert = 0
-
-models/jvm/m1/tmi-reductions.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/tmi-reductions.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m1/wormhole-abstraction.cert : acl2x = 0
-models/jvm/m1/wormhole-abstraction.cert : no_pcert = 0
-
-models/jvm/m1/wormhole-abstraction.cert : \
-     models/jvm/m1/m1.cert \
-     models/jvm/m1/wormhole-abstraction.lisp \
-     models/jvm/m1/cert.acl2
-
-
-models/jvm/m5/apprentice-state.cert : acl2x = 0
-models/jvm/m5/apprentice-state.cert : no_pcert = 0
-
-models/jvm/m5/apprentice-state.cert : \
-     models/jvm/m5/m5.cert \
-     models/jvm/m5/m5.cert \
-     models/jvm/m5/apprentice-state.lisp \
-     models/jvm/m5/apprentice-state.acl2
-
-
-models/jvm/m5/demo.cert : acl2x = 0
-models/jvm/m5/demo.cert : no_pcert = 0
-
-models/jvm/m5/demo.cert : \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/demo.lisp \
-     models/jvm/m5/demo.acl2
-
-
-models/jvm/m5/idemo.cert : acl2x = 0
-models/jvm/m5/idemo.cert : no_pcert = 0
-
-models/jvm/m5/idemo.cert : \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/idemo.lisp \
-     models/jvm/m5/idemo.acl2
-
-
-models/jvm/m5/infinite-fair-schedule.cert : acl2x = 0
-models/jvm/m5/infinite-fair-schedule.cert : no_pcert = 0
-
-models/jvm/m5/infinite-fair-schedule.cert : \
-     arithmetic/top-with-meta.cert \
-     models/jvm/m5/infinite-fair-schedule.lisp
-
-
-models/jvm/m5/isort.cert : acl2x = 0
-models/jvm/m5/isort.cert : no_pcert = 0
-
-models/jvm/m5/isort.cert : \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/perm.cert \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/isort.lisp \
-     models/jvm/m5/isort.acl2
-
-
-models/jvm/m5/jvm-fact-setup.cert : acl2x = 0
-models/jvm/m5/jvm-fact-setup.cert : no_pcert = 0
-
-models/jvm/m5/jvm-fact-setup.cert : \
-     models/jvm/m5/utilities.cert \
-     misc/expander.cert \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/jvm-fact-setup.lisp \
-     models/jvm/m5/jvm-fact-setup.acl2
-
-
-models/jvm/m5/m5.cert : acl2x = 0
-models/jvm/m5/m5.cert : no_pcert = 0
-
-models/jvm/m5/m5.cert : \
-     ordinals/lexicographic-ordering.cert \
-     models/jvm/m5/m5.lisp \
-     models/jvm/m5/m5.acl2
-
-
-models/jvm/m5/partial.cert : acl2x = 0
-models/jvm/m5/partial.cert : no_pcert = 0
-
-models/jvm/m5/partial.cert : \
-     misc/defpun.cert \
-     models/jvm/m5/demo.cert \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/partial.lisp \
-     models/jvm/m5/partial.acl2
-
-
-models/jvm/m5/perm.cert : acl2x = 0
-models/jvm/m5/perm.cert : no_pcert = 0
-
-models/jvm/m5/perm.cert : \
-     models/jvm/m5/perm.lisp
-
-
-models/jvm/m5/universal-never-returns.cert : acl2x = 0
-models/jvm/m5/universal-never-returns.cert : no_pcert = 0
-
-models/jvm/m5/universal-never-returns.cert : \
-     models/jvm/m5/universal.cert \
-     models/jvm/m5/universal.cert \
-     models/jvm/m5/universal-never-returns.lisp \
-     models/jvm/m5/universal-never-returns.acl2
-
-
-models/jvm/m5/universal.cert : acl2x = 0
-models/jvm/m5/universal.cert : no_pcert = 0
-
-models/jvm/m5/universal.cert : \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/utilities.cert \
-     models/jvm/m5/universal.lisp \
-     models/jvm/m5/universal.acl2
-
-
-models/jvm/m5/utilities.cert : acl2x = 0
-models/jvm/m5/utilities.cert : no_pcert = 0
-
-models/jvm/m5/utilities.cert : \
-     models/jvm/m5/m5.cert \
-     arithmetic/top-with-meta.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     models/jvm/m5/m5.cert \
-     models/jvm/m5/utilities.lisp \
-     models/jvm/m5/utilities.acl2
-
-
-ordinals/e0-ordinal.cert : acl2x = 0
-ordinals/e0-ordinal.cert : no_pcert = 0
-
-ordinals/e0-ordinal.cert : \
-     ordinals/ordinal-definitions.cert \
-     ordinals/ordinal-isomorphism.cert \
-     ordinals/e0-ordinal.lisp
-
-
-ordinals/lexicographic-book.cert : acl2x = 0
-ordinals/lexicographic-book.cert : no_pcert = 0
-
-ordinals/lexicographic-book.cert : \
-     ordinals/ordinals-without-arithmetic.cert \
-     ordinals/top-with-meta.cert \
-     ordinals/lexicographic-book.lisp
-
-
-ordinals/lexicographic-ordering-without-arithmetic.cert : acl2x = 0
-ordinals/lexicographic-ordering-without-arithmetic.cert : no_pcert = 0
-
-ordinals/lexicographic-ordering-without-arithmetic.cert : \
-     ordinals/lexicographic-book.cert \
-     ordinals/lexicographic-ordering-without-arithmetic.lisp
-
-
-ordinals/lexicographic-ordering.cert : acl2x = 0
-ordinals/lexicographic-ordering.cert : no_pcert = 0
-
-ordinals/lexicographic-ordering.cert : \
-     ordinals/top-with-meta.cert \
-     ordinals/lexicographic-book.cert \
-     ordinals/lexicographic-ordering.lisp
-
-
-ordinals/limits.cert : acl2x = 0
-ordinals/limits.cert : no_pcert = 0
-
-ordinals/limits.cert : \
-     ordinals/ordinal-exponentiation.cert \
-     ordinals/top-with-meta.cert \
-     ordinals/limits.lisp
-
-
-ordinals/ordinal-addition.cert : acl2x = 0
-ordinals/ordinal-addition.cert : no_pcert = 0
-
-ordinals/ordinal-addition.cert : \
-     ordinals/ordinal-basic-thms.cert \
-     ordinals/top-with-meta.cert \
-     ordinals/ordinal-addition.lisp
-
-
-ordinals/ordinal-basic-thms.cert : acl2x = 0
-ordinals/ordinal-basic-thms.cert : no_pcert = 0
-
-ordinals/ordinal-basic-thms.cert : \
-     ordinals/ordinal-total-order.cert \
-     ordinals/top-with-meta.cert \
-     ordinals/ordinal-basic-thms.lisp
-
-
-ordinals/ordinal-counter-examples.cert : acl2x = 0
-ordinals/ordinal-counter-examples.cert : no_pcert = 0
-
-ordinals/ordinal-counter-examples.cert : \
-     ordinals/ordinal-definitions.cert \
-     ordinals/ordinal-counter-examples.lisp
-
-
-ordinals/ordinal-definitions.cert : acl2x = 0
-ordinals/ordinal-definitions.cert : no_pcert = 0
-
-ordinals/ordinal-definitions.cert : \
-     ordinals/ordinal-definitions.lisp
-
-
-ordinals/ordinal-exponentiation.cert : acl2x = 0
-ordinals/ordinal-exponentiation.cert : no_pcert = 0
-
-ordinals/ordinal-exponentiation.cert : \
-     ordinals/ordinal-multiplication.cert \
-     ordinals/top-with-meta.cert \
-     ordinals/ordinal-exponentiation.lisp
-
-
-ordinals/ordinal-isomorphism.cert : acl2x = 0
-ordinals/ordinal-isomorphism.cert : no_pcert = 0
-
-ordinals/ordinal-isomorphism.cert : \
-     ordinals/ordinal-addition.cert \
-     ordinals/top-with-meta.cert \
-     ordinals/ordinal-isomorphism.lisp
-
-
-ordinals/ordinal-multiplication.cert : acl2x = 0
-ordinals/ordinal-multiplication.cert : no_pcert = 0
-
-ordinals/ordinal-multiplication.cert : \
-     ordinals/ordinal-addition.cert \
-     ordinals/top-with-meta.cert \
-     ordinals/ordinal-multiplication.lisp
-
-
-ordinals/ordinal-total-order.cert : acl2x = 0
-ordinals/ordinal-total-order.cert : no_pcert = 0
-
-ordinals/ordinal-total-order.cert : \
-     ordinals/ordinal-definitions.cert \
-     ordinals/ordinal-total-order.lisp
-
-
-ordinals/ordinals-without-arithmetic.cert : acl2x = 0
-ordinals/ordinals-without-arithmetic.cert : no_pcert = 0
-
-ordinals/ordinals-without-arithmetic.cert : \
-     ordinals/limits.cert \
-     ordinals/ordinals-without-arithmetic.lisp
-
-
-ordinals/ordinals.cert : acl2x = 0
-ordinals/ordinals.cert : no_pcert = 0
-
-ordinals/ordinals.cert : \
-     ordinals/top-with-meta.cert \
-     ordinals/limits.cert \
-     ordinals/ordinals.lisp
-
-
-ordinals/proof-of-well-foundedness.cert : acl2x = 0
-ordinals/proof-of-well-foundedness.cert : no_pcert = 0
-
-ordinals/proof-of-well-foundedness.cert : \
-     ordinals/proof-of-well-foundedness.lisp \
-     ordinals/proof-of-well-foundedness.acl2
-
-
-ordinals/top-with-meta.cert : acl2x = 0
-ordinals/top-with-meta.cert : no_pcert = 0
-
-ordinals/top-with-meta.cert : \
-     arithmetic/top-with-meta.cert \
-     ordinals/top-with-meta.lisp
-
-
-oslib/catpath.cert : acl2x = 0
-oslib/catpath.cert : no_pcert = 0
-
-oslib/catpath.cert : \
-     cutil/define.cert \
-     misc/assert.cert \
-     oslib/portcullis.cert \
-     oslib/catpath.lisp \
-     oslib/cert.acl2
-
-
-oslib/date.cert : acl2x = 0
-oslib/date.cert : no_pcert = 0
-
-oslib/date.cert : \
-     oslib/read-acl2-oracle.cert \
-     cutil/define.cert \
-     tools/include-raw.cert \
-     str/cat.cert \
-     str/natstr.cert \
-     oslib/portcullis.cert \
-     oslib/date.lisp \
-     oslib/cert.acl2 \
-     oslib/date-raw.lsp
-
-
-oslib/getpid.cert : acl2x = 0
-oslib/getpid.cert : no_pcert = 0
-
-oslib/getpid.cert : \
-     oslib/read-acl2-oracle.cert \
-     cutil/define.cert \
-     tools/include-raw.cert \
-     oslib/portcullis.cert \
-     oslib/getpid.lisp \
-     oslib/cert.acl2 \
-     oslib/getpid-raw.lsp
-
-
-oslib/ls.cert : acl2x = 0
-oslib/ls.cert : no_pcert = 0
-
-oslib/ls.cert : \
-     oslib/read-acl2-oracle.cert \
-     cutil/define.cert \
-     tools/include-raw.cert \
-     oslib/portcullis.cert \
-     oslib/ls.lisp \
-     oslib/cert.acl2 \
-     oslib/ls-raw.lsp
-
-
-oslib/portcullis.cert : acl2x = 0
-oslib/portcullis.cert : no_pcert = 0
-
-oslib/portcullis.cert : \
-     oslib/portcullis.lisp \
-     oslib/portcullis.acl2 \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-
-
-oslib/read-acl2-oracle.cert : acl2x = 0
-oslib/read-acl2-oracle.cert : no_pcert = 0
-
-oslib/read-acl2-oracle.cert : \
-     oslib/portcullis.cert \
-     oslib/read-acl2-oracle.lisp \
-     oslib/cert.acl2
-
-
-oslib/tempfile.cert : acl2x = 0
-oslib/tempfile.cert : no_pcert = 0
-
-oslib/tempfile.cert : \
-     oslib/getpid.cert \
-     oslib/catpath.cert \
-     str/natstr.cert \
-     str/cat.cert \
-     oslib/portcullis.cert \
-     oslib/tempfile.lisp \
-     oslib/cert.acl2
-
-
-oslib/top.cert : acl2x = 0
-oslib/top.cert : no_pcert = 0
-
-oslib/top.cert : \
-     oslib/catpath.cert \
-     oslib/date.cert \
-     oslib/getpid.cert \
-     oslib/ls.cert \
-     oslib/tempfile.cert \
-     oslib/portcullis.cert \
-     oslib/top.lisp \
-     oslib/cert.acl2
-
-
-paco/database.cert : acl2x = 0
-paco/database.cert : no_pcert = 0
-
-paco/database.cert : \
-     paco/prove.cert \
-     paco/database.lisp \
-     paco/database.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/elim-dest.cert : acl2x = 0
-paco/elim-dest.cert : no_pcert = 0
-
-paco/elim-dest.cert : \
-     paco/simplify.cert \
-     paco/elim-dest.lisp \
-     paco/elim-dest.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/foundations.cert : acl2x = 0
-paco/foundations.cert : no_pcert = 0
-
-paco/foundations.cert : \
-     paco/output-module.cert \
-     paco/foundations.lisp \
-     paco/foundations.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/induct.cert : acl2x = 0
-paco/induct.cert : no_pcert = 0
-
-paco/induct.cert : \
-     paco/elim-dest.cert \
-     paco/induct.lisp \
-     paco/induct.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/output-module.cert : acl2x = 0
-paco/output-module.cert : no_pcert = 0
-
-paco/output-module.cert : \
-     paco/utilities.cert \
-     paco/output-module.lisp \
-     paco/output-module.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/paco.cert : acl2x = 0
-paco/paco.cert : no_pcert = 0
-
-paco/paco.cert : \
-     paco/utilities.cert \
-     paco/foundations.cert \
-     paco/type-set.cert \
-     paco/rewrite.cert \
-     paco/simplify.cert \
-     paco/induct.cert \
-     paco/prove.cert \
-     paco/database.cert \
-     paco/database.cert \
-     paco/paco.lisp \
-     paco/paco.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/prove.cert : acl2x = 0
-paco/prove.cert : no_pcert = 0
-
-paco/prove.cert : \
-     paco/induct.cert \
-     paco/prove.lisp \
-     paco/prove.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/rewrite.cert : acl2x = 0
-paco/rewrite.cert : no_pcert = 0
-
-paco/rewrite.cert : \
-     paco/type-set.cert \
-     paco/rewrite.lisp \
-     paco/rewrite.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/simplify.cert : acl2x = 0
-paco/simplify.cert : no_pcert = 0
-
-paco/simplify.cert : \
-     paco/rewrite.cert \
-     paco/simplify.lisp \
-     paco/simplify.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/type-set.cert : acl2x = 0
-paco/type-set.cert : no_pcert = 0
-
-paco/type-set.cert : \
-     ordinals/e0-ordinal.cert \
-     arithmetic/top-with-meta.cert \
-     paco/foundations.cert \
-     paco/type-set.lisp \
-     paco/type-set.acl2 \
-     paco/acl2-customization.lsp
-
-
-paco/utilities.cert : acl2x = 0
-paco/utilities.cert : no_pcert = 0
-
-paco/utilities.cert : \
-     ihs/ihs-lemmas.cert \
-     paco/utilities.lisp \
-     paco/utilities.acl2 \
-     paco/acl2-customization.lsp
-
-
-parallel/fibonacci.cert : acl2x = 0
-parallel/fibonacci.cert : no_pcert = 0
-
-parallel/fibonacci.cert : \
-     make-event/assert.cert \
-     parallel/fibonacci.lisp
-
-
-parallel/hint-tests.cert : acl2x = 0
-parallel/hint-tests.cert : no_pcert = 0
-
-parallel/hint-tests.cert : \
-     make-event/eval.cert \
-     parallel/hint-tests.lisp \
-     parallel/hint-tests.acl2
-
-
-parallel/matrix-multiplication-parallel.cert : acl2x = 0
-parallel/matrix-multiplication-parallel.cert : no_pcert = 0
-
-parallel/matrix-multiplication-parallel.cert : \
-     make-event/assert.cert \
-     make-event/embeddable-event-forms.cert \
-     parallel/matrix-multiplication-setup.cert \
-     parallel/matrix-multiplication-parallel.lisp
-
-
-parallel/matrix-multiplication-serial.cert : acl2x = 0
-parallel/matrix-multiplication-serial.cert : no_pcert = 0
-
-parallel/matrix-multiplication-serial.cert : \
-     make-event/assert.cert \
-     make-event/embeddable-event-forms.cert \
-     parallel/matrix-multiplication-setup.cert \
-     parallel/matrix-multiplication-serial.lisp
-
-
-parallel/matrix-multiplication-setup.cert : acl2x = 0
-parallel/matrix-multiplication-setup.cert : no_pcert = 0
-
-parallel/matrix-multiplication-setup.cert : \
-     parallel/matrix-multiplication-setup.lisp
-
-
-parallel/spec-mv-let.cert : acl2x = 0
-parallel/spec-mv-let.cert : no_pcert = 0
-
-parallel/spec-mv-let.cert : \
-     make-event/assert.cert \
-     make-event/eval.cert \
-     parallel/spec-mv-let.lisp
-
-
-parallel/stress-tests.cert : acl2x = 0
-parallel/stress-tests.cert : no_pcert = 0
-
-parallel/stress-tests.cert : \
-     make-event/assert.cert \
-     make-event/eval.cert \
-     parallel/stress-tests.lisp
-
-
-parallel/syntax-tests.cert : acl2x = 0
-parallel/syntax-tests.cert : no_pcert = 0
-
-parallel/syntax-tests.cert : \
-     make-event/assert.cert \
-     make-event/eval.cert \
-     parallel/syntax-tests.lisp
-
-
-parallel/with-waterfall-parallelism.cert : acl2x = 0
-parallel/with-waterfall-parallelism.cert : no_pcert = 0
-
-parallel/with-waterfall-parallelism.cert : \
-     parallel/with-waterfall-parallelism.lisp
-
-
-parallel/without-waterfall-parallelism.cert : acl2x = 0
-parallel/without-waterfall-parallelism.cert : no_pcert = 0
-
-parallel/without-waterfall-parallelism.cert : \
-     parallel/without-waterfall-parallelism.lisp
-
-
-powerlists/algebra.cert : acl2x = 0
-powerlists/algebra.cert : no_pcert = 0
-
-powerlists/algebra.cert : \
-     data-structures/structures.cert \
-     ordinals/e0-ordinal.cert \
-     powerlists/algebra.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-powerlists/batcher-sort.cert : acl2x = 0
-powerlists/batcher-sort.cert : no_pcert = 0
-
-powerlists/batcher-sort.cert : \
-     powerlists/merge-sort.cert \
-     arithmetic/top.cert \
-     powerlists/batcher-sort.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-powerlists/bitonic-sort.cert : acl2x = 0
-powerlists/bitonic-sort.cert : no_pcert = 0
-
-powerlists/bitonic-sort.cert : \
-     powerlists/algebra.cert \
-     powerlists/simple.cert \
-     powerlists/sort.cert \
-     powerlists/batcher-sort.cert \
-     arithmetic/top.cert \
-     powerlists/bitonic-sort.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-powerlists/cla-adder.cert : acl2x = 0
-powerlists/cla-adder.cert : no_pcert = 0
-
-powerlists/cla-adder.cert : \
-     powerlists/prefix-sum.cert \
-     powerlists/algebra.cert \
-     arithmetic/top.cert \
-     powerlists/cla-adder.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-powerlists/gray-code.cert : acl2x = 0
-powerlists/gray-code.cert : no_pcert = 0
-
-powerlists/gray-code.cert : \
-     powerlists/algebra.cert \
-     powerlists/simple.cert \
-     powerlists/gray-code.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-powerlists/merge-sort.cert : acl2x = 0
-powerlists/merge-sort.cert : no_pcert = 0
-
-powerlists/merge-sort.cert : \
-     powerlists/algebra.cert \
-     powerlists/sort.cert \
-     ordinals/e0-ordinal.cert \
-     powerlists/merge-sort.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-powerlists/prefix-sum.cert : acl2x = 0
-powerlists/prefix-sum.cert : no_pcert = 0
-
-powerlists/prefix-sum.cert : \
-     powerlists/algebra.cert \
-     powerlists/simple.cert \
-     arithmetic/top.cert \
-     powerlists/prefix-sum.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-powerlists/simple.cert : acl2x = 0
-powerlists/simple.cert : no_pcert = 0
-
-powerlists/simple.cert : \
-     powerlists/algebra.cert \
-     arithmetic/top.cert \
-     powerlists/simple.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-powerlists/sort.cert : acl2x = 0
-powerlists/sort.cert : no_pcert = 0
-
-powerlists/sort.cert : \
-     powerlists/algebra.cert \
-     powerlists/sort.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-
-
-proofstyles/completeness/assertions-partial.cert : acl2x = 0
-proofstyles/completeness/assertions-partial.cert : no_pcert = 0
-
-proofstyles/completeness/assertions-partial.cert : \
-     misc/defpun.cert \
-     ordinals/ordinals.cert \
-     proofstyles/completeness/stepwise-invariants-partial.cert \
-     proofstyles/completeness/assertions-partial.lisp
-
-
-proofstyles/completeness/assertions-total.cert : acl2x = 0
-proofstyles/completeness/assertions-total.cert : no_pcert = 0
-
-proofstyles/completeness/assertions-total.cert : \
-     misc/defpun.cert \
-     ordinals/ordinals.cert \
-     proofstyles/completeness/stepwise-invariants-total.cert \
-     proofstyles/completeness/assertions-total.lisp
-
-
-proofstyles/completeness/clock-partial.cert : acl2x = 0
-proofstyles/completeness/clock-partial.cert : no_pcert = 0
-
-proofstyles/completeness/clock-partial.cert : \
-     proofstyles/completeness/generic-partial.cert \
-     misc/defpun.cert \
-     arithmetic/top-with-meta.cert \
-     proofstyles/completeness/clock-partial.lisp
-
-
-proofstyles/completeness/clock-total.cert : acl2x = 0
-proofstyles/completeness/clock-total.cert : no_pcert = 0
-
-proofstyles/completeness/clock-total.cert : \
-     proofstyles/completeness/generic-total.cert \
-     misc/defpun.cert \
-     arithmetic/top-with-meta.cert \
-     proofstyles/completeness/clock-total.lisp
-
-
-proofstyles/completeness/generic-partial.cert : acl2x = 0
-proofstyles/completeness/generic-partial.cert : no_pcert = 0
-
-proofstyles/completeness/generic-partial.cert : \
-     proofstyles/completeness/generic-partial.lisp
-
-
-proofstyles/completeness/generic-total.cert : acl2x = 0
-proofstyles/completeness/generic-total.cert : no_pcert = 0
-
-proofstyles/completeness/generic-total.cert : \
-     proofstyles/completeness/generic-total.lisp
-
-
-proofstyles/completeness/stepwise-invariants-partial.cert : acl2x = 0
-proofstyles/completeness/stepwise-invariants-partial.cert : no_pcert = 0
-
-proofstyles/completeness/stepwise-invariants-partial.cert : \
-     proofstyles/completeness/clock-partial.cert \
-     arithmetic/top-with-meta.cert \
-     proofstyles/completeness/stepwise-invariants-partial.lisp
-
-
-proofstyles/completeness/stepwise-invariants-total.cert : acl2x = 0
-proofstyles/completeness/stepwise-invariants-total.cert : no_pcert = 0
-
-proofstyles/completeness/stepwise-invariants-total.cert : \
-     proofstyles/completeness/clock-total.cert \
-     arithmetic/top-with-meta.cert \
-     arithmetic/top-with-meta.cert \
-     proofstyles/completeness/stepwise-invariants-total.lisp
-
-
-proofstyles/counterexamples/halt-flg.cert : acl2x = 0
-proofstyles/counterexamples/halt-flg.cert : no_pcert = 0
-
-proofstyles/counterexamples/halt-flg.cert : \
-     misc/defpun.cert \
-     proofstyles/counterexamples/halt-flg.lisp
-
-
-proofstyles/counterexamples/memory-clearing.cert : acl2x = 0
-proofstyles/counterexamples/memory-clearing.cert : no_pcert = 0
-
-proofstyles/counterexamples/memory-clearing.cert : \
-     misc/defpun.cert \
-     proofstyles/counterexamples/memory-clearing.lisp
-
-
-proofstyles/counterexamples/realistic.cert : acl2x = 0
-proofstyles/counterexamples/realistic.cert : no_pcert = 0
-
-proofstyles/counterexamples/realistic.cert : \
-     misc/records.cert \
-     misc/defpun.cert \
-     proofstyles/counterexamples/realistic.lisp
-
-
-proofstyles/invclock/c2i/c2i-partial.cert : acl2x = 0
-proofstyles/invclock/c2i/c2i-partial.cert : no_pcert = 0
-
-proofstyles/invclock/c2i/c2i-partial.cert : \
-     arithmetic-2/meta/top.cert \
-     proofstyles/invclock/c2i/c2i-partial.lisp
-
-
-proofstyles/invclock/c2i/c2i-total.cert : acl2x = 0
-proofstyles/invclock/c2i/c2i-total.cert : no_pcert = 0
-
-proofstyles/invclock/c2i/c2i-total.cert : \
-     ordinals/e0-ordinal.cert \
-     arithmetic-2/meta/top.cert \
-     proofstyles/invclock/c2i/c2i-total.lisp
-
-
-proofstyles/invclock/c2i/clock-to-inv.cert : acl2x = 0
-proofstyles/invclock/c2i/clock-to-inv.cert : no_pcert = 0
-
-proofstyles/invclock/c2i/clock-to-inv.cert : \
-     ordinals/e0-ordinal.cert \
-     proofstyles/invclock/c2i/c2i-total.cert \
-     proofstyles/invclock/c2i/c2i-partial.cert \
-     proofstyles/invclock/c2i/clock-to-inv.lisp
-
-
-proofstyles/invclock/compose/compose-c-c-partial.cert : acl2x = 0
-proofstyles/invclock/compose/compose-c-c-partial.cert : no_pcert = 0
-
-proofstyles/invclock/compose/compose-c-c-partial.cert : \
-     ordinals/e0-ordinal.cert \
-     arithmetic-2/meta/top.cert \
-     proofstyles/invclock/compose/compose-c-c-partial.lisp
-
-
-proofstyles/invclock/compose/compose-c-c-total.cert : acl2x = 0
-proofstyles/invclock/compose/compose-c-c-total.cert : no_pcert = 0
-
-proofstyles/invclock/compose/compose-c-c-total.cert : \
-     ordinals/e0-ordinal.cert \
-     arithmetic-2/meta/top.cert \
-     proofstyles/invclock/compose/compose-c-c-total.lisp
-
-
-proofstyles/invclock/i2c/i2c-partial.cert : acl2x = 0
-proofstyles/invclock/i2c/i2c-partial.cert : no_pcert = 0
-
-proofstyles/invclock/i2c/i2c-partial.cert : \
-     arithmetic-2/meta/top.cert \
-     proofstyles/invclock/i2c/i2c-partial.lisp
-
-
-proofstyles/invclock/i2c/i2c-total.cert : acl2x = 0
-proofstyles/invclock/i2c/i2c-total.cert : no_pcert = 0
-
-proofstyles/invclock/i2c/i2c-total.cert : \
-     ordinals/e0-ordinal.cert \
-     arithmetic-2/meta/top.cert \
-     proofstyles/invclock/i2c/i2c-total.lisp
-
-
-proofstyles/invclock/i2c/inv-to-clock.cert : acl2x = 0
-proofstyles/invclock/i2c/inv-to-clock.cert : no_pcert = 0
-
-proofstyles/invclock/i2c/inv-to-clock.cert : \
-     ordinals/e0-ordinal.cert \
-     proofstyles/invclock/i2c/i2c-total.cert \
-     proofstyles/invclock/i2c/i2c-partial.cert \
-     proofstyles/invclock/i2c/inv-to-clock.lisp
-
-
-proofstyles/soundness/assertions-partial.cert : acl2x = 0
-proofstyles/soundness/assertions-partial.cert : no_pcert = 0
-
-proofstyles/soundness/assertions-partial.cert : \
-     misc/defpun.cert \
-     ordinals/ordinals.cert \
-     proofstyles/soundness/assertions-partial.lisp
-
-
-proofstyles/soundness/assertions-total.cert : acl2x = 0
-proofstyles/soundness/assertions-total.cert : no_pcert = 0
-
-proofstyles/soundness/assertions-total.cert : \
-     misc/defpun.cert \
-     ordinals/ordinals.cert \
-     proofstyles/soundness/assertions-total.lisp
-
-
-proofstyles/soundness/clock-partial.cert : acl2x = 0
-proofstyles/soundness/clock-partial.cert : no_pcert = 0
-
-proofstyles/soundness/clock-partial.cert : \
-     proofstyles/soundness/clock-partial.lisp
-
-
-proofstyles/soundness/clock-total.cert : acl2x = 0
-proofstyles/soundness/clock-total.cert : no_pcert = 0
-
-proofstyles/soundness/clock-total.cert : \
-     proofstyles/soundness/clock-total.lisp
-
-
-proofstyles/soundness/stepwise-invariants-partial.cert : acl2x = 0
-proofstyles/soundness/stepwise-invariants-partial.cert : no_pcert = 0
-
-proofstyles/soundness/stepwise-invariants-partial.cert : \
-     arithmetic/top-with-meta.cert \
-     proofstyles/soundness/stepwise-invariants-partial.lisp
-
-
-proofstyles/soundness/stepwise-invariants-total.cert : acl2x = 0
-proofstyles/soundness/stepwise-invariants-total.cert : no_pcert = 0
-
-proofstyles/soundness/stepwise-invariants-total.cert : \
-     ordinals/ordinals.cert \
-     proofstyles/soundness/stepwise-invariants-total.lisp
-
-
-quadratic-reciprocity/eisenstein.cert : acl2x = 0
-quadratic-reciprocity/eisenstein.cert : no_pcert = 0
-
-quadratic-reciprocity/eisenstein.cert : \
-     quadratic-reciprocity/gauss.cert \
-     quadratic-reciprocity/eisenstein.lisp
-
-
-quadratic-reciprocity/euclid.cert : acl2x = 0
-quadratic-reciprocity/euclid.cert : no_pcert = 0
-
-quadratic-reciprocity/euclid.cert : \
-     rtl/rel8/lib/arith.cert \
-     rtl/rel8/lib/basic.cert \
-     quadratic-reciprocity/euclid.lisp
-
-
-quadratic-reciprocity/euler.cert : acl2x = 0
-quadratic-reciprocity/euler.cert : no_pcert = 0
-
-quadratic-reciprocity/euler.cert : \
-     quadratic-reciprocity/fermat.cert \
-     quadratic-reciprocity/euler.lisp
-
-
-quadratic-reciprocity/fermat.cert : acl2x = 0
-quadratic-reciprocity/fermat.cert : no_pcert = 0
-
-quadratic-reciprocity/fermat.cert : \
-     quadratic-reciprocity/euclid.cert \
-     quadratic-reciprocity/fermat.lisp
-
-
-quadratic-reciprocity/gauss.cert : acl2x = 0
-quadratic-reciprocity/gauss.cert : no_pcert = 0
-
-quadratic-reciprocity/gauss.cert : \
-     quadratic-reciprocity/euler.cert \
-     quadratic-reciprocity/gauss.lisp
-
-
-quadratic-reciprocity/mersenne.cert : acl2x = 0
-quadratic-reciprocity/mersenne.cert : no_pcert = 0
-
-quadratic-reciprocity/mersenne.cert : \
-     quadratic-reciprocity/gauss.cert \
-     quadratic-reciprocity/mersenne.lisp
-
-
-regex/defset-encapsulates.cert : acl2x = 0
-regex/defset-encapsulates.cert : no_pcert = 0
-
-regex/defset-encapsulates.cert : \
-     regex/defset-macros.cert \
-     regex/portcullis.cert \
-     regex/defset-encapsulates.lisp \
-     regex/cert.acl2
-
-
-regex/defset-macros.cert : acl2x = 0
-regex/defset-macros.cert : no_pcert = 0
-
-regex/defset-macros.cert : \
-     regex/portcullis.cert \
-     regex/defset-macros.lisp \
-     regex/cert.acl2
-
-
-regex/equal-based-set.cert : acl2x = 0
-regex/equal-based-set.cert : no_pcert = 0
-
-regex/equal-based-set.cert : \
-     regex/defset-macros.cert \
-     regex/defset-encapsulates.cert \
-     regex/portcullis.cert \
-     regex/equal-based-set.lisp \
-     regex/cert.acl2
-
-
-regex/grep-command-line.cert : acl2x = 0
-regex/grep-command-line.cert : no_pcert = 0
-
-regex/grep-command-line.cert : \
-     tools/defsum.cert \
-     regex/regex-fileio.cert \
-     regex/regex-chartrans.cert \
-     regex/portcullis.cert \
-     regex/grep-command-line.lisp \
-     regex/cert.acl2
-
-
-regex/input-list.cert : acl2x = 0
-regex/input-list.cert : no_pcert = 0
-
-regex/input-list.cert : \
-     cutil/deflist.cert \
-     regex/portcullis.cert \
-     regex/input-list.lisp \
-     regex/cert.acl2
-
-
-regex/portcullis.cert : acl2x = 0
-regex/portcullis.cert : no_pcert = 0
-
-regex/portcullis.cert : \
-     xdoc/top.cert \
-     regex/portcullis.lisp \
-     regex/portcullis.acl2 \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     tools/flag-package.lsp
-
-
-regex/regex-chartrans.cert : acl2x = 0
-regex/regex-chartrans.cert : no_pcert = 0
-
-regex/regex-chartrans.cert : \
-     regex/portcullis.cert \
-     regex/regex-chartrans.lisp \
-     regex/cert.acl2
-
-
-regex/regex-defs.cert : acl2x = 0
-regex/regex-defs.cert : no_pcert = 0
-
-regex/regex-defs.cert : \
-     tools/defsum.cert \
-     arithmetic/top-with-meta.cert \
-     regex/portcullis.cert \
-     regex/regex-defs.lisp \
-     regex/cert.acl2
-
-
-regex/regex-exec.cert : acl2x = 0
-regex/regex-exec.cert : no_pcert = 0
-
-regex/regex-exec.cert : \
-     regex/regex-defs.cert \
-     regex/input-list.cert \
-     tools/flag.cert \
-     clause-processors/find-subterms.cert \
-     regex/portcullis.cert \
-     regex/regex-exec.lisp \
-     regex/cert.acl2
-
-
-regex/regex-fileio.cert : acl2x = 0
-regex/regex-fileio.cert : no_pcert = 0
-
-regex/regex-fileio.cert : \
-     regex/regex-exec.cert \
-     regex/regex-parse.cert \
-     regex/portcullis.cert \
-     regex/regex-fileio.lisp \
-     regex/cert.acl2
-
-
-regex/regex-parse-brace.cert : acl2x = 0
-regex/regex-parse-brace.cert : no_pcert = 0
-
-regex/regex-parse-brace.cert : \
-     regex/regex-defs.cert \
-     regex/input-list.cert \
-     regex/portcullis.cert \
-     regex/regex-parse-brace.lisp \
-     regex/cert.acl2
-
-
-regex/regex-parse-bracket.cert : acl2x = 0
-regex/regex-parse-bracket.cert : no_pcert = 0
-
-regex/regex-parse-bracket.cert : \
-     regex/regex-defs.cert \
-     regex/input-list.cert \
-     regex/portcullis.cert \
-     regex/regex-parse-bracket.lisp \
-     regex/cert.acl2
-
-
-regex/regex-parse.cert : acl2x = 0
-regex/regex-parse.cert : no_pcert = 0
-
-regex/regex-parse.cert : \
-     regex/regex-parse-bracket.cert \
-     regex/regex-parse-brace.cert \
-     regex/portcullis.cert \
-     regex/regex-parse.lisp \
-     regex/cert.acl2
-
-
-regex/regex-tests.cert : acl2x = 0
-regex/regex-tests.cert : no_pcert = 0
-
-regex/regex-tests.cert : \
-     regex/regex-parse.cert \
-     regex/regex-exec.cert \
-     regex/regex-chartrans.cert \
-     regex/portcullis.cert \
-     regex/regex-tests.lisp \
-     regex/cert.acl2
-
-
-regex/regex-ui.cert : acl2x = 0
-regex/regex-ui.cert : no_pcert = 0
-
-regex/regex-ui.cert : \
-     regex/regex-parse.cert \
-     regex/regex-exec.cert \
-     str/case-conversion.cert \
-     tools/mv-nth.cert \
-     misc/assert.cert \
-     regex/portcullis.cert \
-     regex/regex-ui.lisp \
-     regex/cert.acl2
-
-
-rtl/rel1/lib1/basic.cert : acl2x = 0
-rtl/rel1/lib1/basic.cert : no_pcert = 0
-
-rtl/rel1/lib1/basic.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/lib1/basic.lisp
-
-
-rtl/rel1/lib1/bits.cert : acl2x = 0
-rtl/rel1/lib1/bits.cert : no_pcert = 0
-
-rtl/rel1/lib1/bits.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/lib1/bits.lisp
-
-
-rtl/rel1/lib1/brat.cert : acl2x = 0
-rtl/rel1/lib1/brat.cert : no_pcert = 0
-
-rtl/rel1/lib1/brat.cert : \
-     rtl/rel1/support/fp.cert \
-     rtl/rel1/lib1/brat.lisp
-
-
-rtl/rel1/lib1/float.cert : acl2x = 0
-rtl/rel1/lib1/float.cert : no_pcert = 0
-
-rtl/rel1/lib1/float.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/lib1/float.lisp
-
-
-rtl/rel1/lib1/reps.cert : acl2x = 0
-rtl/rel1/lib1/reps.cert : no_pcert = 0
-
-rtl/rel1/lib1/reps.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/lib1/float.cert \
-     rtl/rel1/lib1/reps.lisp
-
-
-rtl/rel1/lib1/round.cert : acl2x = 0
-rtl/rel1/lib1/round.cert : no_pcert = 0
-
-rtl/rel1/lib1/round.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/lib1/float.cert \
-     rtl/rel1/lib1/round.lisp
-
-
-rtl/rel1/lib1/top.cert : acl2x = 0
-rtl/rel1/lib1/top.cert : no_pcert = 0
-
-rtl/rel1/lib1/top.cert : \
-     rtl/rel1/lib1/basic.cert \
-     rtl/rel1/lib1/bits.cert \
-     rtl/rel1/lib1/float.cert \
-     rtl/rel1/lib1/round.cert \
-     rtl/rel1/lib1/reps.cert \
-     rtl/rel1/lib1/brat.cert \
-     rtl/rel1/lib1/top.lisp
-
-
-rtl/rel1/lib3/basic.cert : acl2x = 0
-rtl/rel1/lib3/basic.cert : no_pcert = 0
-
-rtl/rel1/lib3/basic.cert : \
-     rtl/rel1/support/merge.cert \
-     rtl/rel1/support/rewrite-theory.cert \
-     rtl/rel1/lib3/basic.lisp
-
-
-rtl/rel1/lib3/bits.cert : acl2x = 0
-rtl/rel1/lib3/bits.cert : no_pcert = 0
-
-rtl/rel1/lib3/bits.cert : \
-     rtl/rel1/support/merge.cert \
-     rtl/rel1/support/rewrite-theory.cert \
-     rtl/rel1/lib3/bits.lisp
-
-
-rtl/rel1/lib3/brat.cert : acl2x = 0
-rtl/rel1/lib3/brat.cert : no_pcert = 0
-
-rtl/rel1/lib3/brat.cert : \
-     rtl/rel1/support/fp.cert \
-     rtl/rel1/lib3/brat.lisp
-
-
-rtl/rel1/lib3/fadd.cert : acl2x = 0
-rtl/rel1/lib3/fadd.cert : no_pcert = 0
-
-rtl/rel1/lib3/fadd.cert : \
-     rtl/rel1/support/fadd/add3.cert \
-     rtl/rel1/lib3/float.cert \
-     rtl/rel1/lib3/bits.cert \
-     rtl/rel1/lib3/fadd.lisp
-
-
-rtl/rel1/lib3/float.cert : acl2x = 0
-rtl/rel1/lib3/float.cert : no_pcert = 0
-
-rtl/rel1/lib3/float.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/lib3/float.lisp
-
-
-rtl/rel1/lib3/reps.cert : acl2x = 0
-rtl/rel1/lib3/reps.cert : no_pcert = 0
-
-rtl/rel1/lib3/reps.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/lib3/float.cert \
-     rtl/rel1/lib3/reps.lisp
-
-
-rtl/rel1/lib3/round.cert : acl2x = 0
-rtl/rel1/lib3/round.cert : no_pcert = 0
-
-rtl/rel1/lib3/round.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/lib3/float.cert \
-     rtl/rel1/lib3/round.lisp
-
-
-rtl/rel1/lib3/top.cert : acl2x = 0
-rtl/rel1/lib3/top.cert : no_pcert = 0
-
-rtl/rel1/lib3/top.cert : \
-     rtl/rel1/lib3/basic.cert \
-     rtl/rel1/lib3/bits.cert \
-     rtl/rel1/lib3/float.cert \
-     rtl/rel1/lib3/round.cert \
-     rtl/rel1/lib3/reps.cert \
-     rtl/rel1/lib3/fadd.cert \
-     rtl/rel1/support/fp.cert \
-     rtl/rel1/lib3/brat.cert \
-     rtl/rel1/lib3/top.lisp
-
-
-rtl/rel1/support/add.cert : acl2x = 0
-rtl/rel1/support/add.cert : no_pcert = 0
-
-rtl/rel1/support/add.cert : \
-     rtl/rel1/support/divsqrt.cert \
-     rtl/rel1/support/logxor-lemmas.cert \
-     rtl/rel1/support/rnd.cert \
-     rtl/rel1/support/add.lisp
-
-
-rtl/rel1/support/away.cert : acl2x = 0
-rtl/rel1/support/away.cert : no_pcert = 0
-
-rtl/rel1/support/away.cert : \
-     rtl/rel1/support/trunc.cert \
-     rtl/rel1/support/away.lisp
-
-
-rtl/rel1/support/basic.cert : acl2x = 0
-rtl/rel1/support/basic.cert : no_pcert = 0
-
-rtl/rel1/support/basic.cert : \
-     rtl/rel1/support/fp.cert \
-     rtl/rel1/support/basic.lisp
-
-
-rtl/rel1/support/divsqrt.cert : acl2x = 0
-rtl/rel1/support/divsqrt.cert : no_pcert = 0
-
-rtl/rel1/support/divsqrt.cert : \
-     rtl/rel1/support/odd.cert \
-     rtl/rel1/support/loglemmas.cert \
-     rtl/rel1/support/divsqrt.lisp
-
-
-rtl/rel1/support/fadd/add3.cert : acl2x = 0
-rtl/rel1/support/fadd/add3.cert : no_pcert = 0
-
-rtl/rel1/support/fadd/add3.cert : \
-     rtl/rel1/support/fadd/stick.cert \
-     rtl/rel1/support/fadd/add3.lisp
-
-
-rtl/rel1/support/fadd/lop1.cert : acl2x = 0
-rtl/rel1/support/fadd/lop1.cert : no_pcert = 0
-
-rtl/rel1/support/fadd/lop1.cert : \
-     rtl/rel1/lib1/top.cert \
-     rtl/rel1/support/fp.cert \
-     rtl/rel1/support/fadd/lop1.lisp
-
-
-rtl/rel1/support/fadd/lop2.cert : acl2x = 0
-rtl/rel1/support/fadd/lop2.cert : no_pcert = 0
-
-rtl/rel1/support/fadd/lop2.cert : \
-     rtl/rel1/support/fadd/lop1.cert \
-     rtl/rel1/support/fadd/lop2.lisp
-
-
-rtl/rel1/support/fadd/lop3.cert : acl2x = 0
-rtl/rel1/support/fadd/lop3.cert : no_pcert = 0
-
-rtl/rel1/support/fadd/lop3.cert : \
-     rtl/rel1/support/fadd/lop2.cert \
-     rtl/rel1/support/fadd/lop3.lisp
-
-
-rtl/rel1/support/fadd/stick.cert : acl2x = 0
-rtl/rel1/support/fadd/stick.cert : no_pcert = 0
-
-rtl/rel1/support/fadd/stick.cert : \
-     rtl/rel1/support/fadd/lop3.cert \
-     rtl/rel1/support/fadd/stick.lisp
-
-
-rtl/rel1/support/fadd/top.cert : acl2x = 0
-rtl/rel1/support/fadd/top.cert : no_pcert = 0
-
-rtl/rel1/support/fadd/top.cert : \
-     rtl/rel1/support/fadd/lop3.cert \
-     rtl/rel1/support/fadd/top.lisp
-
-
-rtl/rel1/support/float.cert : acl2x = 0
-rtl/rel1/support/float.cert : no_pcert = 0
-
-rtl/rel1/support/float.cert : \
-     rtl/rel1/support/basic.cert \
-     rtl/rel1/support/x-2xx.cert \
-     rtl/rel1/support/float.lisp
-
-
-rtl/rel1/support/floor.cert : acl2x = 0
-rtl/rel1/support/floor.cert : no_pcert = 0
-
-rtl/rel1/support/floor.cert : \
-     rtl/rel1/support/basic.cert \
-     rtl/rel1/support/floor.lisp
-
-
-rtl/rel1/support/fp.cert : acl2x = 0
-rtl/rel1/support/fp.cert : no_pcert = 0
-
-rtl/rel1/support/fp.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     rtl/rel1/support/fp.lisp
-
-
-rtl/rel1/support/logdefs.cert : acl2x = 0
-rtl/rel1/support/logdefs.cert : no_pcert = 0
-
-rtl/rel1/support/logdefs.cert : \
-     rtl/rel1/support/floor.cert \
-     rtl/rel1/support/logdefs.lisp
-
-
-rtl/rel1/support/loglemmas.cert : acl2x = 0
-rtl/rel1/support/loglemmas.cert : no_pcert = 0
-
-rtl/rel1/support/loglemmas.cert : \
-     rtl/rel1/support/logdefs.cert \
-     rtl/rel1/support/loglemmas.lisp
-
-
-rtl/rel1/support/logxor-def.cert : acl2x = 0
-rtl/rel1/support/logxor-def.cert : no_pcert = 0
-
-rtl/rel1/support/logxor-def.cert : \
-     rtl/rel1/support/floor.cert \
-     rtl/rel1/support/logxor-def.lisp
-
-
-rtl/rel1/support/logxor-lemmas.cert : acl2x = 0
-rtl/rel1/support/logxor-lemmas.cert : no_pcert = 0
-
-rtl/rel1/support/logxor-lemmas.cert : \
-     rtl/rel1/support/logxor-def.cert \
-     rtl/rel1/support/loglemmas.cert \
-     rtl/rel1/support/logxor-lemmas.lisp
-
-
-rtl/rel1/support/merge.cert : acl2x = 0
-rtl/rel1/support/merge.cert : no_pcert = 0
-
-rtl/rel1/support/merge.cert : \
-     rtl/rel1/support/proofs.cert \
-     rtl/rel1/support/merge.lisp
-
-
-rtl/rel1/support/near.cert : acl2x = 0
-rtl/rel1/support/near.cert : no_pcert = 0
-
-rtl/rel1/support/near.cert : \
-     rtl/rel1/support/away.cert \
-     rtl/rel1/support/near.lisp
-
-
-rtl/rel1/support/odd.cert : acl2x = 0
-rtl/rel1/support/odd.cert : no_pcert = 0
-
-rtl/rel1/support/odd.cert : \
-     rtl/rel1/support/near.cert \
-     rtl/rel1/support/odd.lisp
-
-
-rtl/rel1/support/proofs.cert : acl2x = 0
-rtl/rel1/support/proofs.cert : no_pcert = 0
-
-rtl/rel1/support/proofs.cert : \
-     rtl/rel1/support/basic.cert \
-     rtl/rel1/support/x-2xx.cert \
-     rtl/rel1/support/float.cert \
-     rtl/rel1/support/trunc.cert \
-     rtl/rel1/support/away.cert \
-     rtl/rel1/support/near.cert \
-     rtl/rel1/support/odd.cert \
-     rtl/rel1/support/floor.cert \
-     rtl/rel1/support/logdefs.cert \
-     rtl/rel1/support/loglemmas.cert \
-     rtl/rel1/support/divsqrt.cert \
-     rtl/rel1/support/logxor-def.cert \
-     rtl/rel1/support/logxor-lemmas.cert \
-     rtl/rel1/support/reps.cert \
-     rtl/rel1/support/sticky.cert \
-     rtl/rel1/support/rnd.cert \
-     rtl/rel1/support/add.cert \
-     rtl/rel1/support/proofs.lisp
-
-
-rtl/rel1/support/reps.cert : acl2x = 0
-rtl/rel1/support/reps.cert : no_pcert = 0
-
-rtl/rel1/support/reps.cert : \
-     rtl/rel1/support/logdefs.cert \
-     rtl/rel1/support/float.cert \
-     rtl/rel1/support/reps.lisp
-
-
-rtl/rel1/support/rewrite-theory.cert : acl2x = 0
-rtl/rel1/support/rewrite-theory.cert : no_pcert = 0
-
-rtl/rel1/support/rewrite-theory.cert : \
-     rtl/rel1/support/rewrite-theory.lisp
-
-
-rtl/rel1/support/rnd.cert : acl2x = 0
-rtl/rel1/support/rnd.cert : no_pcert = 0
-
-rtl/rel1/support/rnd.cert : \
-     rtl/rel1/support/sticky.cert \
-     rtl/rel1/support/rnd.lisp
-
-
-rtl/rel1/support/sticky.cert : acl2x = 0
-rtl/rel1/support/sticky.cert : no_pcert = 0
-
-rtl/rel1/support/sticky.cert : \
-     rtl/rel1/support/divsqrt.cert \
-     rtl/rel1/support/sticky.lisp
-
-
-rtl/rel1/support/trunc.cert : acl2x = 0
-rtl/rel1/support/trunc.cert : no_pcert = 0
-
-rtl/rel1/support/trunc.cert : \
-     rtl/rel1/support/float.cert \
-     rtl/rel1/support/trunc.lisp
-
-
-rtl/rel1/support/x-2xx.cert : acl2x = 0
-rtl/rel1/support/x-2xx.cert : no_pcert = 0
-
-rtl/rel1/support/x-2xx.cert : \
-     arithmetic/top.cert \
-     rtl/rel1/support/x-2xx.lisp
-
-
-rtl/rel4/arithmetic/arith.cert : acl2x = 0
-rtl/rel4/arithmetic/arith.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/arith.cert : \
-     rtl/rel4/arithmetic/arith2.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     meta/meta-times-equal.cert \
-     rtl/rel4/arithmetic/arith.lisp
-
-
-rtl/rel4/arithmetic/arith2.cert : acl2x = 0
-rtl/rel4/arithmetic/arith2.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/arith2.cert : \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/product.cert \
-     meta/meta-times-equal.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     meta/meta-times-equal.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel4/arithmetic/inverted-factor.cert \
-     rtl/rel4/arithmetic/arith2.lisp
-
-
-rtl/rel4/arithmetic/basic.cert : acl2x = 0
-rtl/rel4/arithmetic/basic.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/basic.cert : \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/even-odd.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/basic.lisp
-
-
-rtl/rel4/arithmetic/cg.cert : acl2x = 0
-rtl/rel4/arithmetic/cg.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/cg.cert : \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/common-factor.cert \
-     rtl/rel4/arithmetic/cg.lisp
-
-
-rtl/rel4/arithmetic/common-factor-defuns.cert : acl2x = 0
-rtl/rel4/arithmetic/common-factor-defuns.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/common-factor-defuns.cert : \
-     rtl/rel4/arithmetic/inverted-factor.cert \
-     rtl/rel4/arithmetic/common-factor-defuns.lisp
-
-
-rtl/rel4/arithmetic/common-factor.cert : acl2x = 0
-rtl/rel4/arithmetic/common-factor.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/common-factor.cert : \
-     meta/meta-times-equal.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel4/arithmetic/common-factor-defuns.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/product.cert \
-     rtl/rel4/arithmetic/common-factor.lisp
-
-
-rtl/rel4/arithmetic/complex-rationalp.cert : acl2x = 0
-rtl/rel4/arithmetic/complex-rationalp.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/complex-rationalp.cert : \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/complex-rationalp.lisp
-
-
-rtl/rel4/arithmetic/denominator.cert : acl2x = 0
-rtl/rel4/arithmetic/denominator.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/denominator.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     arithmetic/mod-gcd.cert \
-     rtl/rel4/arithmetic/denominator.lisp
-
-
-rtl/rel4/arithmetic/even-odd.cert : acl2x = 0
-rtl/rel4/arithmetic/even-odd.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/even-odd.cert : \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/even-odd.lisp
-
-
-rtl/rel4/arithmetic/even-odd2-proofs.cert : acl2x = 0
-rtl/rel4/arithmetic/even-odd2-proofs.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/even-odd2-proofs.cert : \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/arith.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/even-odd2-proofs.lisp
-
-
-rtl/rel4/arithmetic/even-odd2.cert : acl2x = 0
-rtl/rel4/arithmetic/even-odd2.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/even-odd2.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/even-odd2-proofs.cert \
-     rtl/rel4/arithmetic/even-odd2.lisp
-
-
-rtl/rel4/arithmetic/expo-proofs.cert : acl2x = 0
-rtl/rel4/arithmetic/expo-proofs.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/expo-proofs.cert : \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel4/arithmetic/common-factor-defuns.cert \
-     rtl/rel4/arithmetic/common-factor.cert \
-     rtl/rel4/arithmetic/expo-proofs.lisp
-
-
-rtl/rel4/arithmetic/expo.cert : acl2x = 0
-rtl/rel4/arithmetic/expo.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/expo.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/expo-proofs.cert \
-     rtl/rel4/arithmetic/common-factor-defuns.cert \
-     rtl/rel4/arithmetic/expo.lisp
-
-
-rtl/rel4/arithmetic/expt-proofs.cert : acl2x = 0
-rtl/rel4/arithmetic/expt-proofs.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/expt-proofs.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     arithmetic/top.cert \
-     rtl/rel4/arithmetic/even-odd.cert \
-     rtl/rel4/arithmetic/expt-proofs.lisp
-
-
-rtl/rel4/arithmetic/expt.cert : acl2x = 0
-rtl/rel4/arithmetic/expt.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/expt.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/expt-proofs.cert \
-     rtl/rel4/arithmetic/expt.lisp
-
-
-rtl/rel4/arithmetic/extra-rules.cert : acl2x = 0
-rtl/rel4/arithmetic/extra-rules.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/extra-rules.cert : \
-     rtl/rel4/arithmetic/basic.cert \
-     rtl/rel4/arithmetic/extra-rules.lisp
-
-
-rtl/rel4/arithmetic/fl-expt.cert : acl2x = 0
-rtl/rel4/arithmetic/fl-expt.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/fl-expt.cert : \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/nniq.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/floor.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/rationalp.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/fl-expt.lisp
-
-
-rtl/rel4/arithmetic/fl-hacks.cert : acl2x = 0
-rtl/rel4/arithmetic/fl-hacks.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/fl-hacks.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/inverted-factor.cert \
-     rtl/rel4/arithmetic/nniq.cert \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/product.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/rationalp.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/mod.cert \
-     rtl/rel4/arithmetic/even-odd.cert \
-     meta/meta-plus-equal.cert \
-     rtl/rel4/arithmetic/arith.cert \
-     rtl/rel4/arithmetic/fl-hacks.lisp
-
-
-rtl/rel4/arithmetic/fl-proofs.cert : acl2x = 0
-rtl/rel4/arithmetic/fl-proofs.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/fl-proofs.cert : \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/nniq.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/floor.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/rationalp.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/common-factor.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/fl-proofs.lisp
-
-
-rtl/rel4/arithmetic/fl.cert : acl2x = 0
-rtl/rel4/arithmetic/fl.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/fl.cert : \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/fl-proofs.cert \
-     rtl/rel4/arithmetic/fl.lisp
-
-
-rtl/rel4/arithmetic/floor-proofs.cert : acl2x = 0
-rtl/rel4/arithmetic/floor-proofs.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/floor-proofs.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/nniq.cert \
-     rtl/rel4/arithmetic/product.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/rationalp.cert \
-     rtl/rel4/arithmetic/inverted-factor.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel4/arithmetic/floor-proofs.lisp
-
-
-rtl/rel4/arithmetic/floor.cert : acl2x = 0
-rtl/rel4/arithmetic/floor.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/floor.cert : \
-     rtl/rel4/arithmetic/floor-proofs.cert \
-     rtl/rel4/arithmetic/floor.lisp
-
-
-rtl/rel4/arithmetic/fp.cert : acl2x = 0
-rtl/rel4/arithmetic/fp.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/fp.cert : \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/fp.lisp
-
-
-rtl/rel4/arithmetic/fp2.cert : acl2x = 0
-rtl/rel4/arithmetic/fp2.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/fp2.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     ihs/ihs-lemmas.cert \
-     arithmetic-2/meta/non-linear.cert \
-     rtl/rel4/arithmetic/inverted-factor.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel4/arithmetic/fp2.lisp
-
-
-rtl/rel4/arithmetic/ground-zero.cert : acl2x = 0
-rtl/rel4/arithmetic/ground-zero.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/ground-zero.cert : \
-     rtl/rel4/arithmetic/ground-zero.lisp
-
-
-rtl/rel4/arithmetic/hacks.cert : acl2x = 0
-rtl/rel4/arithmetic/hacks.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/hacks.cert : \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/hacks.lisp
-
-
-rtl/rel4/arithmetic/induct.cert : acl2x = 0
-rtl/rel4/arithmetic/induct.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/induct.cert : \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/induct.lisp
-
-
-rtl/rel4/arithmetic/integerp.cert : acl2x = 0
-rtl/rel4/arithmetic/integerp.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/integerp.cert : \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/integerp.lisp
-
-
-rtl/rel4/arithmetic/inverted-factor.cert : acl2x = 0
-rtl/rel4/arithmetic/inverted-factor.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/inverted-factor.cert : \
-     rtl/rel4/arithmetic/inverted-factor.lisp
-
-
-rtl/rel4/arithmetic/mod-expt.cert : acl2x = 0
-rtl/rel4/arithmetic/mod-expt.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/mod-expt.cert : \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/nniq.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/floor.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/rationalp.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/arithmetic/fl-expt.cert \
-     rtl/rel4/arithmetic/mod.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/mod-expt.lisp
-
-
-rtl/rel4/arithmetic/mod-proofs.cert : acl2x = 0
-rtl/rel4/arithmetic/mod-proofs.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/mod-proofs.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/floor.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/arith.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/product.cert \
-     rtl/rel4/arithmetic/complex-rationalp.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/rationalp.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/mod-proofs.lisp
-
-
-rtl/rel4/arithmetic/mod.cert : acl2x = 0
-rtl/rel4/arithmetic/mod.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/mod.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/mod-proofs.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/mod.lisp
-
-
-rtl/rel4/arithmetic/negative-syntaxp.cert : acl2x = 0
-rtl/rel4/arithmetic/negative-syntaxp.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/negative-syntaxp.cert : \
-     rtl/rel4/arithmetic/negative-syntaxp.lisp
-
-
-rtl/rel4/arithmetic/nniq.cert : acl2x = 0
-rtl/rel4/arithmetic/nniq.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/nniq.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/product.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/arith.cert \
-     arithmetic/rationals.cert \
-     arithmetic/idiv.cert \
-     arithmetic/idiv.cert \
-     arithmetic/top-with-meta.cert \
-     rtl/rel4/arithmetic/nniq.lisp
-
-
-rtl/rel4/arithmetic/numerator.cert : acl2x = 0
-rtl/rel4/arithmetic/numerator.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/numerator.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/numerator.lisp
-
-
-rtl/rel4/arithmetic/power2p.cert : acl2x = 0
-rtl/rel4/arithmetic/power2p.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/power2p.cert : \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel4/arithmetic/power2p.lisp
-
-
-rtl/rel4/arithmetic/predicate.cert : acl2x = 0
-rtl/rel4/arithmetic/predicate.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/predicate.cert : \
-     rtl/rel4/arithmetic/predicate.lisp
-
-
-rtl/rel4/arithmetic/product-proofs.cert : acl2x = 0
-rtl/rel4/arithmetic/product-proofs.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/product-proofs.cert : \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/product-proofs.lisp
-
-
-rtl/rel4/arithmetic/product.cert : acl2x = 0
-rtl/rel4/arithmetic/product.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/product.cert : \
-     rtl/rel4/arithmetic/product-proofs.cert \
-     rtl/rel4/arithmetic/product.lisp
-
-
-rtl/rel4/arithmetic/rationalp.cert : acl2x = 0
-rtl/rel4/arithmetic/rationalp.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/rationalp.cert : \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/rationalp.lisp
-
-
-rtl/rel4/arithmetic/top.cert : acl2x = 0
-rtl/rel4/arithmetic/top.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/top.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/arithmetic/induct.cert \
-     rtl/rel4/arithmetic/denominator.cert \
-     rtl/rel4/arithmetic/numerator.cert \
-     rtl/rel4/arithmetic/nniq.cert \
-     rtl/rel4/arithmetic/complex-rationalp.cert \
-     rtl/rel4/arithmetic/rationalp.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/arithmetic/arith.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/basic.cert \
-     rtl/rel4/arithmetic/unary-divide.cert \
-     rtl/rel4/arithmetic/product.cert \
-     rtl/rel4/arithmetic/inverted-factor.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/x-2xx.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/arithmetic/even-odd2.cert \
-     rtl/rel4/arithmetic/even-odd.cert \
-     rtl/rel4/arithmetic/floor.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/cg.cert \
-     rtl/rel4/arithmetic/mod.cert \
-     rtl/rel4/arithmetic/fl-expt.cert \
-     rtl/rel4/arithmetic/mod-expt.cert \
-     rtl/rel4/arithmetic/common-factor.cert \
-     rtl/rel4/arithmetic/top.lisp
-
-
-rtl/rel4/arithmetic/unary-divide.cert : acl2x = 0
-rtl/rel4/arithmetic/unary-divide.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/unary-divide.cert : \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/inverted-factor.cert \
-     rtl/rel4/arithmetic/unary-divide.lisp
-
-
-rtl/rel4/arithmetic/x-2xx.cert : acl2x = 0
-rtl/rel4/arithmetic/x-2xx.cert : no_pcert = 0
-
-rtl/rel4/arithmetic/x-2xx.cert : \
-     arithmetic/top.cert \
-     rtl/rel4/arithmetic/x-2xx.lisp
-
-
-rtl/rel4/lib/arith.cert : acl2x = 0
-rtl/rel4/lib/arith.cert : no_pcert = 0
-
-rtl/rel4/lib/arith.cert : \
-     rtl/rel4/arithmetic/fp.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel4/lib/arith.lisp
-
-
-rtl/rel4/lib/basic.cert : acl2x = 0
-rtl/rel4/lib/basic.cert : no_pcert = 0
-
-rtl/rel4/lib/basic.cert : \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/arithmetic/hacks.cert \
-     rtl/rel4/arithmetic/cg.cert \
-     rtl/rel4/support/ash.cert \
-     rtl/rel4/arithmetic/fl-hacks.cert \
-     rtl/rel4/arithmetic/mod.cert \
-     rtl/rel4/arithmetic/even-odd.cert \
-     rtl/rel4/arithmetic/extra-rules.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/lib/rtl.cert \
-     rtl/rel4/lib/rtlarr.cert \
-     rtl/rel4/lib/basic.lisp
-
-
-rtl/rel4/lib/bits.cert : acl2x = 0
-rtl/rel4/lib/bits.cert : no_pcert = 0
-
-rtl/rel4/lib/bits.cert : \
-     rtl/rel4/lib/basic.cert \
-     rtl/rel4/support/top.cert \
-     rtl/rel4/lib/bits.lisp
-
-
-rtl/rel4/lib/bvecp-helpers.cert : acl2x = 0
-rtl/rel4/lib/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel4/lib/bvecp-helpers.cert : \
-     rtl/rel4/lib/rtl.cert \
-     rtl/rel4/lib/rtlarr.cert \
-     rtl/rel4/support/bvecp-helpers.cert \
-     rtl/rel4/arithmetic/basic.cert \
-     rtl/rel4/lib/bvecp-helpers.lisp
-
-
-rtl/rel4/lib/bvecp-raw-helpers.cert : acl2x = 0
-rtl/rel4/lib/bvecp-raw-helpers.cert : no_pcert = 0
-
-rtl/rel4/lib/bvecp-raw-helpers.cert : \
-     rtl/rel4/lib/rtl.cert \
-     rtl/rel4/lib/rtlarr.cert \
-     rtl/rel4/support/bvecp-helpers.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/setbits.cert \
-     rtl/rel4/support/setbitn.cert \
-     rtl/rel4/support/logs.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/support/shft.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/mulcat.cert \
-     rtl/rel4/support/encode.cert \
-     rtl/rel4/support/decode.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/arithmetic/basic.cert \
-     rtl/rel4/lib/bvecp-raw-helpers.lisp
-
-
-rtl/rel4/lib/clocks.cert : acl2x = 0
-rtl/rel4/lib/clocks.cert : no_pcert = 0
-
-rtl/rel4/lib/clocks.cert : \
-     rtl/rel4/support/clocks.cert \
-     rtl/rel4/lib/clocks.lisp
-
-
-rtl/rel4/lib/fadd.cert : acl2x = 0
-rtl/rel4/lib/fadd.cert : no_pcert = 0
-
-rtl/rel4/lib/fadd.cert : \
-     rtl/rel4/support/fadd.cert \
-     rtl/rel4/support/bits-extra.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/lib/float.cert \
-     rtl/rel4/lib/fadd.lisp
-
-
-rtl/rel4/lib/float.cert : acl2x = 0
-rtl/rel4/lib/float.cert : no_pcert = 0
-
-rtl/rel4/lib/float.cert : \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/lib/bits.cert \
-     rtl/rel4/lib/float.lisp
-
-
-rtl/rel4/lib/openers.cert : acl2x = 0
-rtl/rel4/lib/openers.cert : no_pcert = 0
-
-rtl/rel4/lib/openers.cert : \
-     rtl/rel4/support/openers.cert \
-     rtl/rel4/lib/openers.lisp
-
-
-rtl/rel4/lib/package-defs.cert : acl2x = 0
-rtl/rel4/lib/package-defs.cert : no_pcert = 0
-
-rtl/rel4/lib/package-defs.cert : \
-     rtl/rel4/support/package-defs.cert \
-     rtl/rel4/lib/package-defs.lisp
-
-
-rtl/rel4/lib/reps.cert : acl2x = 0
-rtl/rel4/lib/reps.cert : no_pcert = 0
-
-rtl/rel4/lib/reps.cert : \
-     rtl/rel4/support/ereps.cert \
-     rtl/rel4/support/ireps.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/lib/float.cert \
-     rtl/rel4/lib/reps.lisp
-
-
-rtl/rel4/lib/rom-helpers.cert : acl2x = 0
-rtl/rel4/lib/rom-helpers.cert : no_pcert = 0
-
-rtl/rel4/lib/rom-helpers.cert : \
-     rtl/rel4/support/rom-helpers.cert \
-     rtl/rel4/lib/rom-helpers.lisp
-
-
-rtl/rel4/lib/round.cert : acl2x = 0
-rtl/rel4/lib/round.cert : no_pcert = 0
-
-rtl/rel4/lib/round.cert : \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/near.cert \
-     rtl/rel4/support/near+.cert \
-     rtl/rel4/support/oddr.cert \
-     rtl/rel4/support/rnd.cert \
-     rtl/rel4/support/drnd.cert \
-     rtl/rel4/support/bits-trunc.cert \
-     rtl/rel4/support/sticky.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/lib/reps.cert \
-     rtl/rel4/lib/round.lisp
-
-
-rtl/rel4/lib/rtl.cert : acl2x = 0
-rtl/rel4/lib/rtl.cert : no_pcert = 0
-
-rtl/rel4/lib/rtl.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/mulcat.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/lib/rtl.lisp
-
-
-rtl/rel4/lib/rtlarr.cert : acl2x = 0
-rtl/rel4/lib/rtlarr.cert : no_pcert = 0
-
-rtl/rel4/lib/rtlarr.cert : \
-     rtl/rel4/support/rtlarr.cert \
-     rtl/rel4/support/bvecp-helpers.cert \
-     rtl/rel4/support/guards.cert \
-     misc/total-order.cert \
-     rtl/rel4/lib/rtl.cert \
-     rtl/rel4/lib/rtlarr.lisp
-
-
-rtl/rel4/lib/simple-loop-helpers.cert : acl2x = 0
-rtl/rel4/lib/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel4/lib/simple-loop-helpers.cert : \
-     rtl/rel4/lib/rtl.cert \
-     rtl/rel4/lib/rtlarr.cert \
-     rtl/rel4/lib/arith.cert \
-     rtl/rel4/lib/bits.cert \
-     rtl/rel4/support/simple-loop-helpers.cert \
-     rtl/rel4/lib/simple-loop-helpers.lisp
-
-
-rtl/rel4/lib/simplify-model-helpers.cert : acl2x = 0
-rtl/rel4/lib/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel4/lib/simplify-model-helpers.cert : \
-     rtl/rel4/lib/rtl.cert \
-     rtl/rel4/lib/arith.cert \
-     rtl/rel4/lib/bits.cert \
-     rtl/rel4/support/simplify-model-helpers.cert \
-     rtl/rel4/lib/simplify-model-helpers.lisp
-
-
-rtl/rel4/lib/top.cert : acl2x = 0
-rtl/rel4/lib/top.cert : no_pcert = 0
-
-rtl/rel4/lib/top.cert : \
-     rtl/rel4/lib/rtl.cert \
-     rtl/rel4/lib/rtlarr.cert \
-     rtl/rel4/lib/basic.cert \
-     rtl/rel4/lib/bits.cert \
-     rtl/rel4/lib/float.cert \
-     rtl/rel4/lib/reps.cert \
-     rtl/rel4/lib/round.cert \
-     rtl/rel4/lib/fadd.cert \
-     rtl/rel4/lib/arith.cert \
-     rtl/rel4/lib/util.cert \
-     rtl/rel4/lib/top.lisp
-
-
-rtl/rel4/lib/util.cert : acl2x = 0
-rtl/rel4/lib/util.cert : no_pcert = 0
-
-rtl/rel4/lib/util.cert : \
-     rtl/rel4/support/util.cert \
-     rtl/rel4/lib/util.lisp
-
-
-rtl/rel4/support/add3-proofs.cert : acl2x = 0
-rtl/rel4/support/add3-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/add3-proofs.cert : \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/arithmetic/top.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/add3-proofs.lisp
-
-
-rtl/rel4/support/add3.cert : acl2x = 0
-rtl/rel4/support/add3.cert : no_pcert = 0
-
-rtl/rel4/support/add3.cert : \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/add3-proofs.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/add3.lisp
-
-
-rtl/rel4/support/all-ones.cert : acl2x = 0
-rtl/rel4/support/all-ones.cert : no_pcert = 0
-
-rtl/rel4/support/all-ones.cert : \
-     rtl/rel4/support/all-ones.lisp
-
-
-rtl/rel4/support/ash.cert : acl2x = 0
-rtl/rel4/support/ash.cert : no_pcert = 0
-
-rtl/rel4/support/ash.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/support/ash.lisp
-
-
-rtl/rel4/support/away-proofs.cert : acl2x = 0
-rtl/rel4/support/away-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/away-proofs.cert : \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/away-proofs.lisp
-
-
-rtl/rel4/support/away.cert : acl2x = 0
-rtl/rel4/support/away.cert : no_pcert = 0
-
-rtl/rel4/support/away.cert : \
-     rtl/rel4/support/away-proofs.cert \
-     rtl/rel4/support/away.lisp
-
-
-rtl/rel4/support/badguys.cert : acl2x = 0
-rtl/rel4/support/badguys.cert : no_pcert = 0
-
-rtl/rel4/support/badguys.cert : \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/badguys.lisp
-
-
-rtl/rel4/support/bias-proofs.cert : acl2x = 0
-rtl/rel4/support/bias-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/bias-proofs.cert : \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/support/bias-proofs.lisp
-
-
-rtl/rel4/support/bias.cert : acl2x = 0
-rtl/rel4/support/bias.cert : no_pcert = 0
-
-rtl/rel4/support/bias.cert : \
-     rtl/rel4/support/bias-proofs.cert \
-     rtl/rel4/support/bias.lisp
-
-
-rtl/rel4/support/bitn-proofs.cert : acl2x = 0
-rtl/rel4/support/bitn-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/bitn-proofs.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/bitn-proofs.lisp
-
-
-rtl/rel4/support/bitn.cert : acl2x = 0
-rtl/rel4/support/bitn.cert : no_pcert = 0
-
-rtl/rel4/support/bitn.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/support/bitn-proofs.cert \
-     rtl/rel4/support/bitn.lisp
-
-
-rtl/rel4/support/bits-extra.cert : acl2x = 0
-rtl/rel4/support/bits-extra.cert : no_pcert = 0
-
-rtl/rel4/support/bits-extra.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/fadd.cert \
-     rtl/rel4/support/top1.cert \
-     rtl/rel4/support/bits-extra.lisp
-
-
-rtl/rel4/support/bits-proofs.cert : acl2x = 0
-rtl/rel4/support/bits-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/bits-proofs.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/bits-proofs.lisp
-
-
-rtl/rel4/support/bits-trunc-proofs.cert : acl2x = 0
-rtl/rel4/support/bits-trunc-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/bits-trunc-proofs.cert : \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/log.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bits-trunc-proofs.lisp
-
-
-rtl/rel4/support/bits-trunc.cert : acl2x = 0
-rtl/rel4/support/bits-trunc.cert : no_pcert = 0
-
-rtl/rel4/support/bits-trunc.cert : \
-     rtl/rel4/support/log.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/bits-trunc-proofs.cert \
-     rtl/rel4/support/bits-trunc.lisp
-
-
-rtl/rel4/support/bits.cert : acl2x = 0
-rtl/rel4/support/bits.cert : no_pcert = 0
-
-rtl/rel4/support/bits.cert : \
-     rtl/rel4/support/bits-proofs.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/support/bits.lisp
-
-
-rtl/rel4/support/bvecp-helpers.cert : acl2x = 0
-rtl/rel4/support/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel4/support/bvecp-helpers.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/bvecp-lemmas.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bvecp-helpers.lisp
-
-
-rtl/rel4/support/bvecp-lemmas.cert : acl2x = 0
-rtl/rel4/support/bvecp-lemmas.cert : no_pcert = 0
-
-rtl/rel4/support/bvecp-lemmas.cert : \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/setbits.cert \
-     rtl/rel4/support/setbitn.cert \
-     rtl/rel4/support/encode.cert \
-     rtl/rel4/support/decode.cert \
-     rtl/rel4/support/logs.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/shft.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/mulcat.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/bvecp-lemmas.lisp
-
-
-rtl/rel4/support/bvecp-proofs.cert : acl2x = 0
-rtl/rel4/support/bvecp-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/bvecp-proofs.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bvecp-proofs.lisp
-
-
-rtl/rel4/support/bvecp.cert : acl2x = 0
-rtl/rel4/support/bvecp.cert : no_pcert = 0
-
-rtl/rel4/support/bvecp.cert : \
-     rtl/rel4/support/bvecp-proofs.cert \
-     rtl/rel4/support/bvecp.lisp
-
-
-rtl/rel4/support/cat-def.cert : acl2x = 0
-rtl/rel4/support/cat-def.cert : no_pcert = 0
-
-rtl/rel4/support/cat-def.cert : \
-     rtl/rel4/support/cat-def.lisp
-
-
-rtl/rel4/support/cat-proofs.cert : acl2x = 0
-rtl/rel4/support/cat-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/cat-proofs.cert : \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/cat-proofs.lisp
-
-
-rtl/rel4/support/cat.cert : acl2x = 0
-rtl/rel4/support/cat.cert : no_pcert = 0
-
-rtl/rel4/support/cat.cert : \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/cat-proofs.cert \
-     rtl/rel4/support/cat.lisp
-
-
-rtl/rel4/support/clocks.cert : acl2x = 0
-rtl/rel4/support/clocks.cert : no_pcert = 0
-
-rtl/rel4/support/clocks.cert : \
-     rtl/rel4/support/mod4.cert \
-     rtl/rel4/arithmetic/even-odd2.cert \
-     rtl/rel4/support/clocks.lisp
-
-
-rtl/rel4/support/decode-proofs.cert : acl2x = 0
-rtl/rel4/support/decode-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/decode-proofs.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/support/ash.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/decode-proofs.lisp
-
-
-rtl/rel4/support/decode.cert : acl2x = 0
-rtl/rel4/support/decode.cert : no_pcert = 0
-
-rtl/rel4/support/decode.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/decode-proofs.cert \
-     rtl/rel4/support/decode.lisp
-
-
-rtl/rel4/support/drnd.cert : acl2x = 0
-rtl/rel4/support/drnd.cert : no_pcert = 0
-
-rtl/rel4/support/drnd.cert : \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/ireps.cert \
-     rtl/rel4/support/rnd.cert \
-     rtl/rel4/support/bias.cert \
-     rtl/rel4/support/sgn.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/near.cert \
-     rtl/rel4/support/near+.cert \
-     rtl/rel4/support/sticky.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/drnd.lisp
-
-
-rtl/rel4/support/encode.cert : acl2x = 0
-rtl/rel4/support/encode.cert : no_pcert = 0
-
-rtl/rel4/support/encode.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/ash.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/encode.lisp
-
-
-rtl/rel4/support/ereps-proofs.cert : acl2x = 0
-rtl/rel4/support/ereps-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/ereps-proofs.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/bias.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/mulcat.cert \
-     rtl/rel4/support/ereps-proofs.lisp
-
-
-rtl/rel4/support/ereps.cert : acl2x = 0
-rtl/rel4/support/ereps.cert : no_pcert = 0
-
-rtl/rel4/support/ereps.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/ereps-proofs.cert \
-     rtl/rel4/support/ereps.lisp
-
-
-rtl/rel4/support/fadd.cert : acl2x = 0
-rtl/rel4/support/fadd.cert : no_pcert = 0
-
-rtl/rel4/support/fadd.cert : \
-     rtl/rel4/support/stick.cert \
-     rtl/rel4/support/lop3.cert \
-     rtl/rel4/support/add3.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/lextra.cert \
-     rtl/rel4/support/fadd.lisp
-
-
-rtl/rel4/support/fast-and.cert : acl2x = 0
-rtl/rel4/support/fast-and.cert : no_pcert = 0
-
-rtl/rel4/support/fast-and.cert : \
-     rtl/rel4/support/fast-and.lisp
-
-
-rtl/rel4/support/float.cert : acl2x = 0
-rtl/rel4/support/float.cert : no_pcert = 0
-
-rtl/rel4/support/float.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/basic.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/cg.cert \
-     rtl/rel4/support/float.lisp
-
-
-rtl/rel4/support/ground-zero.cert : acl2x = 0
-rtl/rel4/support/ground-zero.cert : no_pcert = 0
-
-rtl/rel4/support/ground-zero.cert : \
-     rtl/rel4/arithmetic/ground-zero.cert \
-     rtl/rel4/support/util.cert \
-     rtl/rel4/support/ground-zero.lisp
-
-
-rtl/rel4/support/guards.cert : acl2x = 0
-rtl/rel4/support/guards.cert : no_pcert = 0
-
-rtl/rel4/support/guards.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/top1.cert \
-     rtl/rel4/support/guards.lisp
-
-
-rtl/rel4/support/ireps.cert : acl2x = 0
-rtl/rel4/support/ireps.cert : no_pcert = 0
-
-rtl/rel4/support/ireps.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/bias.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/ireps.lisp
-
-
-rtl/rel4/support/land-proofs.cert : acl2x = 0
-rtl/rel4/support/land-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/land-proofs.cert : \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/all-ones.cert \
-     rtl/rel4/support/log.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/land-proofs.lisp
-
-
-rtl/rel4/support/land.cert : acl2x = 0
-rtl/rel4/support/land.cert : no_pcert = 0
-
-rtl/rel4/support/land.cert : \
-     rtl/rel4/support/land-proofs.cert \
-     rtl/rel4/support/land.lisp
-
-
-rtl/rel4/support/lextra-proofs.cert : acl2x = 0
-rtl/rel4/support/lextra-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/lextra-proofs.cert : \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/logxor.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/lextra-proofs.lisp
-
-
-rtl/rel4/support/lextra.cert : acl2x = 0
-rtl/rel4/support/lextra.cert : no_pcert = 0
-
-rtl/rel4/support/lextra.cert : \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/lextra-proofs.cert \
-     rtl/rel4/support/lextra.lisp
-
-
-rtl/rel4/support/lior-proofs.cert : acl2x = 0
-rtl/rel4/support/lior-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/lior-proofs.cert : \
-     rtl/rel4/support/all-ones.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/lior-proofs.lisp
-
-
-rtl/rel4/support/lior.cert : acl2x = 0
-rtl/rel4/support/lior.cert : no_pcert = 0
-
-rtl/rel4/support/lior.cert : \
-     rtl/rel4/support/lior-proofs.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/lior.lisp
-
-
-rtl/rel4/support/lnot-proofs.cert : acl2x = 0
-rtl/rel4/support/lnot-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/lnot-proofs.cert : \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/mod.cert \
-     rtl/rel4/arithmetic/mod.cert \
-     rtl/rel4/arithmetic/arith.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/lnot-proofs.lisp
-
-
-rtl/rel4/support/lnot.cert : acl2x = 0
-rtl/rel4/support/lnot.cert : no_pcert = 0
-
-rtl/rel4/support/lnot.cert : \
-     rtl/rel4/support/lnot-proofs.cert \
-     rtl/rel4/support/lnot.lisp
-
-
-rtl/rel4/support/log-equal.cert : acl2x = 0
-rtl/rel4/support/log-equal.cert : no_pcert = 0
-
-rtl/rel4/support/log-equal.cert : \
-     rtl/rel4/support/log-equal.lisp
-
-
-rtl/rel4/support/log-proofs.cert : acl2x = 0
-rtl/rel4/support/log-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/log-proofs.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/lognot.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/logxor.cert \
-     rtl/rel4/support/log-proofs.lisp
-
-
-rtl/rel4/support/log.cert : acl2x = 0
-rtl/rel4/support/log.cert : no_pcert = 0
-
-rtl/rel4/support/log.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/log-proofs.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/logxor.cert \
-     rtl/rel4/support/log.lisp
-
-
-rtl/rel4/support/logand-proofs.cert : acl2x = 0
-rtl/rel4/support/logand-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/logand-proofs.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/arithmetic/induct.cert \
-     rtl/rel4/support/lognot.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/logand-proofs.lisp
-
-
-rtl/rel4/support/logand.cert : acl2x = 0
-rtl/rel4/support/logand.cert : no_pcert = 0
-
-rtl/rel4/support/logand.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/logand-proofs.cert \
-     rtl/rel4/support/logand.lisp
-
-
-rtl/rel4/support/logeqv.cert : acl2x = 0
-rtl/rel4/support/logeqv.cert : no_pcert = 0
-
-rtl/rel4/support/logeqv.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/logorc1.cert \
-     rtl/rel4/support/lognot.cert \
-     rtl/rel4/support/logeqv.lisp
-
-
-rtl/rel4/support/logior-proofs.cert : acl2x = 0
-rtl/rel4/support/logior-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/logior-proofs.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/lognot.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/logior-proofs.lisp
-
-
-rtl/rel4/support/logior.cert : acl2x = 0
-rtl/rel4/support/logior.cert : no_pcert = 0
-
-rtl/rel4/support/logior.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/logior-proofs.cert \
-     rtl/rel4/support/logior.lisp
-
-
-rtl/rel4/support/logior1-proofs.cert : acl2x = 0
-rtl/rel4/support/logior1-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/logior1-proofs.cert : \
-     rtl/rel4/support/logior1-proofs.lisp
-
-
-rtl/rel4/support/logior1.cert : acl2x = 0
-rtl/rel4/support/logior1.cert : no_pcert = 0
-
-rtl/rel4/support/logior1.cert : \
-     rtl/rel4/support/logior1-proofs.cert \
-     rtl/rel4/support/logior1.lisp
-
-
-rtl/rel4/support/lognot.cert : acl2x = 0
-rtl/rel4/support/lognot.cert : no_pcert = 0
-
-rtl/rel4/support/lognot.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/lognot.lisp
-
-
-rtl/rel4/support/logorc1.cert : acl2x = 0
-rtl/rel4/support/logorc1.cert : no_pcert = 0
-
-rtl/rel4/support/logorc1.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/support/lognot.cert \
-     rtl/rel4/support/logorc1.lisp
-
-
-rtl/rel4/support/logs.cert : acl2x = 0
-rtl/rel4/support/logs.cert : no_pcert = 0
-
-rtl/rel4/support/logs.cert : \
-     rtl/rel4/support/logs.lisp
-
-
-rtl/rel4/support/logxor.cert : acl2x = 0
-rtl/rel4/support/logxor.cert : no_pcert = 0
-
-rtl/rel4/support/logxor.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/logeqv.cert \
-     rtl/rel4/support/logorc1.cert \
-     rtl/rel4/support/lognot.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/logxor.lisp
-
-
-rtl/rel4/support/lop1-proofs.cert : acl2x = 0
-rtl/rel4/support/lop1-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/lop1-proofs.cert : \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/lop1-proofs.lisp
-
-
-rtl/rel4/support/lop1.cert : acl2x = 0
-rtl/rel4/support/lop1.cert : no_pcert = 0
-
-rtl/rel4/support/lop1.cert : \
-     rtl/rel4/support/lop1-proofs.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/lop1.lisp
-
-
-rtl/rel4/support/lop2-proofs.cert : acl2x = 0
-rtl/rel4/support/lop2-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/lop2-proofs.cert : \
-     rtl/rel4/support/lop1.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/lop2-proofs.lisp
-
-
-rtl/rel4/support/lop2.cert : acl2x = 0
-rtl/rel4/support/lop2.cert : no_pcert = 0
-
-rtl/rel4/support/lop2.cert : \
-     rtl/rel4/support/lop1.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lop2-proofs.cert \
-     rtl/rel4/support/lop2.lisp
-
-
-rtl/rel4/support/lop3-proofs.cert : acl2x = 0
-rtl/rel4/support/lop3-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/lop3-proofs.cert : \
-     rtl/rel4/support/lop2.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/lop3-proofs.lisp
-
-
-rtl/rel4/support/lop3.cert : acl2x = 0
-rtl/rel4/support/lop3.cert : no_pcert = 0
-
-rtl/rel4/support/lop3.cert : \
-     rtl/rel4/support/lop2.cert \
-     rtl/rel4/support/lop3-proofs.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/lop3.lisp
-
-
-rtl/rel4/support/lxor-proofs.cert : acl2x = 0
-rtl/rel4/support/lxor-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/lxor-proofs.cert : \
-     rtl/rel4/support/all-ones.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/lxor-proofs.lisp
-
-
-rtl/rel4/support/lxor.cert : acl2x = 0
-rtl/rel4/support/lxor.cert : no_pcert = 0
-
-rtl/rel4/support/lxor.cert : \
-     rtl/rel4/support/lxor-proofs.cert \
-     rtl/rel4/support/lxor.lisp
-
-
-rtl/rel4/support/merge.cert : acl2x = 0
-rtl/rel4/support/merge.cert : no_pcert = 0
-
-rtl/rel4/support/merge.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/log.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/logxor.cert \
-     rtl/rel4/support/ocat.cert \
-     rtl/rel4/support/sumbits.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/merge.lisp
-
-
-rtl/rel4/support/merge2.cert : acl2x = 0
-rtl/rel4/support/merge2.cert : no_pcert = 0
-
-rtl/rel4/support/merge2.cert : \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/logs.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/merge2.lisp
-
-
-rtl/rel4/support/mod4.cert : acl2x = 0
-rtl/rel4/support/mod4.cert : no_pcert = 0
-
-rtl/rel4/support/mod4.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/mod4.lisp
-
-
-rtl/rel4/support/model-helpers.cert : acl2x = 0
-rtl/rel4/support/model-helpers.cert : no_pcert = 0
-
-rtl/rel4/support/model-helpers.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/model-helpers.lisp
-
-
-rtl/rel4/support/mulcat-proofs.cert : acl2x = 0
-rtl/rel4/support/mulcat-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/mulcat-proofs.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/mulcat-proofs.lisp
-
-
-rtl/rel4/support/mulcat.cert : acl2x = 0
-rtl/rel4/support/mulcat.cert : no_pcert = 0
-
-rtl/rel4/support/mulcat.cert : \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/mulcat-proofs.cert \
-     rtl/rel4/support/mulcat.lisp
-
-
-rtl/rel4/support/near+-proofs.cert : acl2x = 0
-rtl/rel4/support/near+-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/near+-proofs.cert : \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/arithmetic/predicate.cert \
-     rtl/rel4/arithmetic/cg.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/near+-proofs.lisp
-
-
-rtl/rel4/support/near+.cert : acl2x = 0
-rtl/rel4/support/near+.cert : no_pcert = 0
-
-rtl/rel4/support/near+.cert : \
-     rtl/rel4/support/near+-proofs.cert \
-     rtl/rel4/support/near+.lisp
-
-
-rtl/rel4/support/near-proofs.cert : acl2x = 0
-rtl/rel4/support/near-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/near-proofs.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/near-proofs.lisp
-
-
-rtl/rel4/support/near.cert : acl2x = 0
-rtl/rel4/support/near.cert : no_pcert = 0
-
-rtl/rel4/support/near.cert : \
-     rtl/rel4/support/near-proofs.cert \
-     rtl/rel4/support/near.lisp
-
-
-rtl/rel4/support/ocat.cert : acl2x = 0
-rtl/rel4/support/ocat.cert : no_pcert = 0
-
-rtl/rel4/support/ocat.cert : \
-     rtl/rel4/arithmetic/expt.cert \
-     rtl/rel4/arithmetic/expo.cert \
-     rtl/rel4/arithmetic/arith2.cert \
-     rtl/rel4/arithmetic/fp2.cert \
-     rtl/rel4/arithmetic/integerp.cert \
-     rtl/rel4/support/ocat.lisp
-
-
-rtl/rel4/support/oddr-proofs.cert : acl2x = 0
-rtl/rel4/support/oddr-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/oddr-proofs.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/near.cert \
-     rtl/rel4/support/oddr-proofs.lisp
-
-
-rtl/rel4/support/oddr.cert : acl2x = 0
-rtl/rel4/support/oddr.cert : no_pcert = 0
-
-rtl/rel4/support/oddr.cert : \
-     rtl/rel4/support/oddr-proofs.cert \
-     rtl/rel4/support/oddr.lisp
-
-
-rtl/rel4/support/openers.cert : acl2x = 0
-rtl/rel4/support/openers.cert : no_pcert = 0
-
-rtl/rel4/support/openers.cert : \
-     rtl/rel4/support/openers.lisp
-
-
-rtl/rel4/support/package-defs.cert : acl2x = 0
-rtl/rel4/support/package-defs.cert : no_pcert = 0
-
-rtl/rel4/support/package-defs.cert : \
-     rtl/rel4/support/package-defs.lisp
-
-
-rtl/rel4/support/rewrite-theory.cert : acl2x = 0
-rtl/rel4/support/rewrite-theory.cert : no_pcert = 0
-
-rtl/rel4/support/rewrite-theory.cert : \
-     rtl/rel4/support/rewrite-theory.lisp
-
-
-rtl/rel4/support/rnd.cert : acl2x = 0
-rtl/rel4/support/rnd.cert : no_pcert = 0
-
-rtl/rel4/support/rnd.cert : \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/near.cert \
-     rtl/rel4/support/near+.cert \
-     rtl/rel4/support/sticky.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bits-trunc.cert \
-     rtl/rel4/support/rnd.lisp
-
-
-rtl/rel4/support/rom-helpers.cert : acl2x = 0
-rtl/rel4/support/rom-helpers.cert : no_pcert = 0
-
-rtl/rel4/support/rom-helpers.cert : \
-     rtl/rel4/support/rom-helpers.lisp
-
-
-rtl/rel4/support/rtl.cert : acl2x = 0
-rtl/rel4/support/rtl.cert : no_pcert = 0
-
-rtl/rel4/support/rtl.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/rtlarr.cert \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/rtl.lisp
-
-
-rtl/rel4/support/rtlarr.cert : acl2x = 0
-rtl/rel4/support/rtlarr.cert : no_pcert = 0
-
-rtl/rel4/support/rtlarr.cert : \
-     misc/total-order.cert \
-     rtl/rel4/support/rtlarr.lisp
-
-
-rtl/rel4/support/setbitn-proofs.cert : acl2x = 0
-rtl/rel4/support/setbitn-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/setbitn-proofs.cert : \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/setbits.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/setbitn-proofs.lisp
-
-
-rtl/rel4/support/setbitn.cert : acl2x = 0
-rtl/rel4/support/setbitn.cert : no_pcert = 0
-
-rtl/rel4/support/setbitn.cert : \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/setbitn-proofs.cert \
-     rtl/rel4/support/setbitn.lisp
-
-
-rtl/rel4/support/setbits-proofs.cert : acl2x = 0
-rtl/rel4/support/setbits-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/setbits-proofs.cert : \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/setbits-proofs.lisp
-
-
-rtl/rel4/support/setbits.cert : acl2x = 0
-rtl/rel4/support/setbits.cert : no_pcert = 0
-
-rtl/rel4/support/setbits.cert : \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/setbits-proofs.cert \
-     rtl/rel4/support/setbits.lisp
-
-
-rtl/rel4/support/sgn.cert : acl2x = 0
-rtl/rel4/support/sgn.cert : no_pcert = 0
-
-rtl/rel4/support/sgn.cert : \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/sgn.lisp
-
-
-rtl/rel4/support/shft.cert : acl2x = 0
-rtl/rel4/support/shft.cert : no_pcert = 0
-
-rtl/rel4/support/shft.cert : \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/shft.lisp
-
-
-rtl/rel4/support/simple-loop-helpers.cert : acl2x = 0
-rtl/rel4/support/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel4/support/simple-loop-helpers.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/setbitn.cert \
-     rtl/rel4/support/simple-loop-helpers.lisp
-
-
-rtl/rel4/support/simplify-model-helpers.cert : acl2x = 0
-rtl/rel4/support/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel4/support/simplify-model-helpers.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/simplify-model-helpers.lisp
-
-
-rtl/rel4/support/stick-proofs.cert : acl2x = 0
-rtl/rel4/support/stick-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/stick-proofs.cert : \
-     rtl/rel4/support/merge.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/support/stick-proofs.lisp
-
-
-rtl/rel4/support/stick.cert : acl2x = 0
-rtl/rel4/support/stick.cert : no_pcert = 0
-
-rtl/rel4/support/stick.cert : \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/stick-proofs.cert \
-     rtl/rel4/support/stick.lisp
-
-
-rtl/rel4/support/sticky-proofs.cert : acl2x = 0
-rtl/rel4/support/sticky-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/sticky-proofs.cert : \
-     rtl/rel4/arithmetic/arith.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/near.cert \
-     rtl/rel4/support/near+.cert \
-     rtl/rel4/support/sticky-proofs.lisp
-
-
-rtl/rel4/support/sticky.cert : acl2x = 0
-rtl/rel4/support/sticky.cert : no_pcert = 0
-
-rtl/rel4/support/sticky.cert : \
-     rtl/rel4/support/sticky-proofs.cert \
-     rtl/rel4/support/sticky.lisp
-
-
-rtl/rel4/support/sumbits.cert : acl2x = 0
-rtl/rel4/support/sumbits.cert : no_pcert = 0
-
-rtl/rel4/support/sumbits.cert : \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/sumbits.lisp
-
-
-rtl/rel4/support/top.cert : acl2x = 0
-rtl/rel4/support/top.cert : no_pcert = 0
-
-rtl/rel4/support/top.cert : \
-     rtl/rel4/support/top1.cert \
-     rtl/rel4/support/bits-extra.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/support/top.lisp
-
-
-rtl/rel4/support/top1.cert : acl2x = 0
-rtl/rel4/support/top1.cert : no_pcert = 0
-
-rtl/rel4/support/top1.cert : \
-     rtl/rel4/support/util.cert \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/rewrite-theory.cert \
-     rtl/rel4/support/rtl.cert \
-     rtl/rel4/support/rtlarr.cert \
-     rtl/rel4/support/bvecp-lemmas.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/ocat.cert \
-     rtl/rel4/support/cat-def.cert \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/support/ash.cert \
-     rtl/rel4/support/decode.cert \
-     rtl/rel4/support/encode.cert \
-     rtl/rel4/support/mulcat.cert \
-     rtl/rel4/support/shft.cert \
-     rtl/rel4/support/all-ones.cert \
-     rtl/rel4/support/merge2.cert \
-     rtl/rel4/support/logior1.cert \
-     rtl/rel4/support/setbits.cert \
-     rtl/rel4/support/setbitn.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/support/bias.cert \
-     rtl/rel4/support/ereps.cert \
-     rtl/rel4/support/ireps.cert \
-     rtl/rel4/support/logeqv.cert \
-     rtl/rel4/support/logorc1.cert \
-     rtl/rel4/support/lognot.cert \
-     rtl/rel4/support/logand.cert \
-     rtl/rel4/support/logior.cert \
-     rtl/rel4/support/logxor.cert \
-     rtl/rel4/support/log.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/support/lextra.cert \
-     rtl/rel4/support/logs.cert \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/support/near.cert \
-     rtl/rel4/support/near+.cert \
-     rtl/rel4/support/oddr.cert \
-     rtl/rel4/support/sticky.cert \
-     rtl/rel4/support/rnd.cert \
-     rtl/rel4/support/drnd.cert \
-     rtl/rel4/support/bits-trunc.cert \
-     rtl/rel4/support/add3.cert \
-     rtl/rel4/support/lop1.cert \
-     rtl/rel4/support/lop2.cert \
-     rtl/rel4/support/lop3.cert \
-     rtl/rel4/support/stick.cert \
-     rtl/rel4/support/bvecp-helpers.cert \
-     rtl/rel4/support/model-helpers.cert \
-     rtl/rel4/support/rom-helpers.cert \
-     rtl/rel4/support/simple-loop-helpers.cert \
-     rtl/rel4/support/clocks.cert \
-     rtl/rel4/support/openers.cert \
-     rtl/rel4/support/package-defs.cert \
-     rtl/rel4/support/simplify-model-helpers.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/arithmetic/fp.cert \
-     rtl/rel4/support/fadd.cert \
-     rtl/rel4/support/top1.lisp
-
-
-rtl/rel4/support/trunc-proofs.cert : acl2x = 0
-rtl/rel4/support/trunc-proofs.cert : no_pcert = 0
-
-rtl/rel4/support/trunc-proofs.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/float.cert \
-     rtl/rel4/arithmetic/top.cert \
-     rtl/rel4/support/trunc-proofs.lisp
-
-
-rtl/rel4/support/trunc.cert : acl2x = 0
-rtl/rel4/support/trunc.cert : no_pcert = 0
-
-rtl/rel4/support/trunc.cert : \
-     rtl/rel4/support/ground-zero.cert \
-     rtl/rel4/support/trunc-proofs.cert \
-     rtl/rel4/support/trunc.lisp
-
-
-rtl/rel4/support/util.cert : acl2x = 0
-rtl/rel4/support/util.cert : no_pcert = 0
-
-rtl/rel4/support/util.cert : \
-     rtl/rel4/support/util.lisp
-
-
-rtl/rel4/user/away.cert : acl2x = 0
-rtl/rel4/user/away.cert : no_pcert = 0
-
-rtl/rel4/user/away.cert : \
-     rtl/rel4/user/trunc.cert \
-     rtl/rel4/support/away.cert \
-     rtl/rel4/user/away.lisp
-
-
-rtl/rel4/user/bias.cert : acl2x = 0
-rtl/rel4/user/bias.cert : no_pcert = 0
-
-rtl/rel4/user/bias.cert : \
-     rtl/rel4/support/bias.cert \
-     rtl/rel4/user/bias.lisp
-
-
-rtl/rel4/user/bitn.cert : acl2x = 0
-rtl/rel4/user/bitn.cert : no_pcert = 0
-
-rtl/rel4/user/bitn.cert : \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/support/bitn.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/bitn.lisp
-
-
-rtl/rel4/user/bits-trunc.cert : acl2x = 0
-rtl/rel4/user/bits-trunc.cert : no_pcert = 0
-
-rtl/rel4/user/bits-trunc.cert : \
-     rtl/rel4/user/land.cert \
-     rtl/rel4/support/bits-trunc.cert \
-     rtl/rel4/user/bits-trunc.lisp
-
-
-rtl/rel4/user/bits.cert : acl2x = 0
-rtl/rel4/user/bits.cert : no_pcert = 0
-
-rtl/rel4/user/bits.cert : \
-     rtl/rel4/arithmetic/negative-syntaxp.cert \
-     rtl/rel4/arithmetic/power2p.cert \
-     rtl/rel4/support/bits.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/bits.lisp
-
-
-rtl/rel4/user/brat.cert : acl2x = 0
-rtl/rel4/user/brat.cert : no_pcert = 0
-
-rtl/rel4/user/brat.cert : \
-     rtl/rel4/arithmetic/fl.cert \
-     rtl/rel4/user/brat.lisp
-
-
-rtl/rel4/user/bvecp.cert : acl2x = 0
-rtl/rel4/user/bvecp.cert : no_pcert = 0
-
-rtl/rel4/user/bvecp.cert : \
-     rtl/rel4/support/bvecp.cert \
-     rtl/rel4/user/bvecp.lisp
-
-
-rtl/rel4/user/cat.cert : acl2x = 0
-rtl/rel4/user/cat.cert : no_pcert = 0
-
-rtl/rel4/user/cat.cert : \
-     rtl/rel4/support/cat.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/cat.lisp
-
-
-rtl/rel4/user/decode.cert : acl2x = 0
-rtl/rel4/user/decode.cert : no_pcert = 0
-
-rtl/rel4/user/decode.cert : \
-     rtl/rel4/support/decode.cert \
-     rtl/rel4/user/decode.lisp
-
-
-rtl/rel4/user/ereps.cert : acl2x = 0
-rtl/rel4/user/ereps.cert : no_pcert = 0
-
-rtl/rel4/user/ereps.cert : \
-     rtl/rel4/support/ereps.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/ereps.lisp
-
-
-rtl/rel4/user/land.cert : acl2x = 0
-rtl/rel4/user/land.cert : no_pcert = 0
-
-rtl/rel4/user/land.cert : \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/support/land.cert \
-     rtl/rel4/user/land.lisp
-
-
-rtl/rel4/user/lextra.cert : acl2x = 0
-rtl/rel4/user/lextra.cert : no_pcert = 0
-
-rtl/rel4/user/lextra.cert : \
-     rtl/rel4/user/land.cert \
-     rtl/rel4/user/lior.cert \
-     rtl/rel4/user/lxor.cert \
-     rtl/rel4/support/lextra.cert \
-     rtl/rel4/user/lextra.lisp
-
-
-rtl/rel4/user/lior.cert : acl2x = 0
-rtl/rel4/user/lior.cert : no_pcert = 0
-
-rtl/rel4/user/lior.cert : \
-     rtl/rel4/support/lior.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/lior.lisp
-
-
-rtl/rel4/user/lnot.cert : acl2x = 0
-rtl/rel4/user/lnot.cert : no_pcert = 0
-
-rtl/rel4/user/lnot.cert : \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/support/lnot.cert \
-     rtl/rel4/user/lnot.lisp
-
-
-rtl/rel4/user/logior1.cert : acl2x = 0
-rtl/rel4/user/logior1.cert : no_pcert = 0
-
-rtl/rel4/user/logior1.cert : \
-     rtl/rel4/support/logior1.cert \
-     rtl/rel4/user/logior1.lisp
-
-
-rtl/rel4/user/lxor.cert : acl2x = 0
-rtl/rel4/user/lxor.cert : no_pcert = 0
-
-rtl/rel4/user/lxor.cert : \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/support/lxor.cert \
-     rtl/rel4/user/lxor.lisp
-
-
-rtl/rel4/user/mulcat.cert : acl2x = 0
-rtl/rel4/user/mulcat.cert : no_pcert = 0
-
-rtl/rel4/user/mulcat.cert : \
-     rtl/rel4/support/mulcat.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/mulcat.lisp
-
-
-rtl/rel4/user/near.cert : acl2x = 0
-rtl/rel4/user/near.cert : no_pcert = 0
-
-rtl/rel4/user/near.cert : \
-     rtl/rel4/support/near.cert \
-     rtl/rel4/user/near.lisp
-
-
-rtl/rel4/user/setbitn.cert : acl2x = 0
-rtl/rel4/user/setbitn.cert : no_pcert = 0
-
-rtl/rel4/user/setbitn.cert : \
-     rtl/rel4/support/setbitn.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/setbitn.lisp
-
-
-rtl/rel4/user/setbits.cert : acl2x = 0
-rtl/rel4/user/setbits.cert : no_pcert = 0
-
-rtl/rel4/user/setbits.cert : \
-     rtl/rel4/support/setbits.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/setbits.lisp
-
-
-rtl/rel4/user/stick.cert : acl2x = 0
-rtl/rel4/user/stick.cert : no_pcert = 0
-
-rtl/rel4/user/stick.cert : \
-     rtl/rel4/user/land.cert \
-     rtl/rel4/user/lior.cert \
-     rtl/rel4/user/lxor.cert \
-     rtl/rel4/user/lnot.cert \
-     rtl/rel4/support/stick.cert \
-     rtl/rel4/user/stick.lisp
-
-
-rtl/rel4/user/sumbits.cert : acl2x = 0
-rtl/rel4/user/sumbits.cert : no_pcert = 0
-
-rtl/rel4/user/sumbits.cert : \
-     rtl/rel4/support/sumbits.cert \
-     rtl/rel4/support/guards.cert \
-     rtl/rel4/user/sumbits.lisp
-
-
-rtl/rel4/user/top.cert : acl2x = 0
-rtl/rel4/user/top.cert : no_pcert = 0
-
-rtl/rel4/user/top.cert : \
-     rtl/rel4/user/bits.cert \
-     rtl/rel4/user/bitn.cert \
-     rtl/rel4/user/cat.cert \
-     rtl/rel4/user/bvecp.cert \
-     rtl/rel4/user/mulcat.cert \
-     rtl/rel4/user/logior1.cert \
-     rtl/rel4/user/setbits.cert \
-     rtl/rel4/user/setbitn.cert \
-     rtl/rel4/user/bias.cert \
-     rtl/rel4/user/ereps.cert \
-     rtl/rel4/user/lnot.cert \
-     rtl/rel4/user/land.cert \
-     rtl/rel4/user/lior.cert \
-     rtl/rel4/user/lxor.cert \
-     rtl/rel4/user/lextra.cert \
-     rtl/rel4/user/trunc.cert \
-     rtl/rel4/user/away.cert \
-     rtl/rel4/user/near.cert \
-     rtl/rel4/user/bits-trunc.cert \
-     rtl/rel4/user/stick.cert \
-     rtl/rel4/user/sumbits.cert \
-     rtl/rel4/user/top.lisp
-
-
-rtl/rel4/user/trunc.cert : acl2x = 0
-rtl/rel4/user/trunc.cert : no_pcert = 0
-
-rtl/rel4/user/trunc.cert : \
-     rtl/rel4/support/trunc.cert \
-     rtl/rel4/user/trunc.lisp
-
-
-rtl/rel5/arithmetic/arith.cert : acl2x = 0
-rtl/rel5/arithmetic/arith.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/arith.cert : \
-     rtl/rel5/arithmetic/arith2.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     meta/meta-times-equal.cert \
-     rtl/rel5/arithmetic/arith.lisp
-
-
-rtl/rel5/arithmetic/arith2.cert : acl2x = 0
-rtl/rel5/arithmetic/arith2.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/arith2.cert : \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/product.cert \
-     meta/meta-times-equal.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel5/arithmetic/inverted-factor.cert \
-     rtl/rel5/arithmetic/arith2.lisp
-
-
-rtl/rel5/arithmetic/basic.cert : acl2x = 0
-rtl/rel5/arithmetic/basic.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/basic.cert : \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/even-odd.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/basic.lisp
-
-
-rtl/rel5/arithmetic/cg.cert : acl2x = 0
-rtl/rel5/arithmetic/cg.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/cg.cert : \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/common-factor.cert \
-     rtl/rel5/arithmetic/cg.lisp
-
-
-rtl/rel5/arithmetic/common-factor-defuns.cert : acl2x = 0
-rtl/rel5/arithmetic/common-factor-defuns.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/common-factor-defuns.cert : \
-     rtl/rel5/arithmetic/inverted-factor.cert \
-     rtl/rel5/arithmetic/common-factor-defuns.lisp
-
-
-rtl/rel5/arithmetic/common-factor.cert : acl2x = 0
-rtl/rel5/arithmetic/common-factor.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/common-factor.cert : \
-     meta/meta-times-equal.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel5/arithmetic/common-factor-defuns.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/product.cert \
-     rtl/rel5/arithmetic/common-factor.lisp
-
-
-rtl/rel5/arithmetic/complex-rationalp.cert : acl2x = 0
-rtl/rel5/arithmetic/complex-rationalp.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/complex-rationalp.cert : \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/complex-rationalp.lisp
-
-
-rtl/rel5/arithmetic/denominator.cert : acl2x = 0
-rtl/rel5/arithmetic/denominator.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/denominator.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     arithmetic/mod-gcd.cert \
-     rtl/rel5/arithmetic/denominator.lisp
-
-
-rtl/rel5/arithmetic/even-odd.cert : acl2x = 0
-rtl/rel5/arithmetic/even-odd.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/even-odd.cert : \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/even-odd.lisp
-
-
-rtl/rel5/arithmetic/even-odd2-proofs.cert : acl2x = 0
-rtl/rel5/arithmetic/even-odd2-proofs.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/even-odd2-proofs.cert : \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/arith.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/even-odd2-proofs.lisp
-
-
-rtl/rel5/arithmetic/even-odd2.cert : acl2x = 0
-rtl/rel5/arithmetic/even-odd2.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/even-odd2.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/even-odd2-proofs.cert \
-     rtl/rel5/arithmetic/even-odd2.lisp
-
-
-rtl/rel5/arithmetic/expo-proofs.cert : acl2x = 0
-rtl/rel5/arithmetic/expo-proofs.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/expo-proofs.cert : \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel5/arithmetic/common-factor-defuns.cert \
-     rtl/rel5/arithmetic/common-factor.cert \
-     rtl/rel5/arithmetic/expo-proofs.lisp
-
-
-rtl/rel5/arithmetic/expo.cert : acl2x = 0
-rtl/rel5/arithmetic/expo.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/expo.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/expo-proofs.cert \
-     rtl/rel5/arithmetic/common-factor-defuns.cert \
-     rtl/rel5/arithmetic/expo.lisp
-
-
-rtl/rel5/arithmetic/expt-proofs.cert : acl2x = 0
-rtl/rel5/arithmetic/expt-proofs.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/expt-proofs.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     arithmetic/top.cert \
-     rtl/rel5/arithmetic/even-odd.cert \
-     rtl/rel5/arithmetic/expt-proofs.lisp
-
-
-rtl/rel5/arithmetic/expt.cert : acl2x = 0
-rtl/rel5/arithmetic/expt.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/expt.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/expt-proofs.cert \
-     rtl/rel5/arithmetic/expt.lisp
-
-
-rtl/rel5/arithmetic/extra-rules.cert : acl2x = 0
-rtl/rel5/arithmetic/extra-rules.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/extra-rules.cert : \
-     rtl/rel5/arithmetic/basic.cert \
-     rtl/rel5/arithmetic/extra-rules.lisp
-
-
-rtl/rel5/arithmetic/fl-expt.cert : acl2x = 0
-rtl/rel5/arithmetic/fl-expt.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/fl-expt.cert : \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/nniq.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/floor.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/rationalp.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/fl-expt.lisp
-
-
-rtl/rel5/arithmetic/fl-hacks.cert : acl2x = 0
-rtl/rel5/arithmetic/fl-hacks.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/fl-hacks.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/inverted-factor.cert \
-     rtl/rel5/arithmetic/nniq.cert \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/product.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/rationalp.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/mod.cert \
-     rtl/rel5/arithmetic/even-odd.cert \
-     meta/meta-plus-equal.cert \
-     rtl/rel5/arithmetic/arith.cert \
-     rtl/rel5/arithmetic/fl-hacks.lisp
-
-
-rtl/rel5/arithmetic/fl-proofs.cert : acl2x = 0
-rtl/rel5/arithmetic/fl-proofs.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/fl-proofs.cert : \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/nniq.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/floor.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/rationalp.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/common-factor.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/fl-proofs.lisp
-
-
-rtl/rel5/arithmetic/fl.cert : acl2x = 0
-rtl/rel5/arithmetic/fl.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/fl.cert : \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/fl-proofs.cert \
-     rtl/rel5/arithmetic/fl.lisp
-
-
-rtl/rel5/arithmetic/floor-proofs.cert : acl2x = 0
-rtl/rel5/arithmetic/floor-proofs.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/floor-proofs.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/nniq.cert \
-     rtl/rel5/arithmetic/product.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/rationalp.cert \
-     rtl/rel5/arithmetic/inverted-factor.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel5/arithmetic/floor-proofs.lisp
-
-
-rtl/rel5/arithmetic/floor.cert : acl2x = 0
-rtl/rel5/arithmetic/floor.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/floor.cert : \
-     rtl/rel5/arithmetic/floor-proofs.cert \
-     rtl/rel5/arithmetic/floor.lisp
-
-
-rtl/rel5/arithmetic/fp.cert : acl2x = 0
-rtl/rel5/arithmetic/fp.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/fp.cert : \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/fp.lisp
-
-
-rtl/rel5/arithmetic/fp2.cert : acl2x = 0
-rtl/rel5/arithmetic/fp2.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/fp2.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     ihs/ihs-lemmas.cert \
-     arithmetic-2/meta/non-linear.cert \
-     rtl/rel5/arithmetic/inverted-factor.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel5/arithmetic/fp2.lisp
-
-
-rtl/rel5/arithmetic/ground-zero.cert : acl2x = 0
-rtl/rel5/arithmetic/ground-zero.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/ground-zero.cert : \
-     rtl/rel5/arithmetic/ground-zero.lisp
-
-
-rtl/rel5/arithmetic/hacks.cert : acl2x = 0
-rtl/rel5/arithmetic/hacks.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/hacks.cert : \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/hacks.lisp
-
-
-rtl/rel5/arithmetic/induct.cert : acl2x = 0
-rtl/rel5/arithmetic/induct.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/induct.cert : \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/induct.lisp
-
-
-rtl/rel5/arithmetic/integerp.cert : acl2x = 0
-rtl/rel5/arithmetic/integerp.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/integerp.cert : \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/integerp.lisp
-
-
-rtl/rel5/arithmetic/inverted-factor.cert : acl2x = 0
-rtl/rel5/arithmetic/inverted-factor.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/inverted-factor.cert : \
-     rtl/rel5/arithmetic/inverted-factor.lisp
-
-
-rtl/rel5/arithmetic/mod-expt.cert : acl2x = 0
-rtl/rel5/arithmetic/mod-expt.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/mod-expt.cert : \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/nniq.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/floor.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/rationalp.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/arithmetic/fl-expt.cert \
-     rtl/rel5/arithmetic/mod.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/mod-expt.lisp
-
-
-rtl/rel5/arithmetic/mod-proofs.cert : acl2x = 0
-rtl/rel5/arithmetic/mod-proofs.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/mod-proofs.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/floor.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/arith.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/product.cert \
-     rtl/rel5/arithmetic/complex-rationalp.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/rationalp.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/mod-proofs.lisp
-
-
-rtl/rel5/arithmetic/mod.cert : acl2x = 0
-rtl/rel5/arithmetic/mod.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/mod.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/mod-proofs.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/mod.lisp
-
-
-rtl/rel5/arithmetic/negative-syntaxp.cert : acl2x = 0
-rtl/rel5/arithmetic/negative-syntaxp.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/negative-syntaxp.cert : \
-     rtl/rel5/arithmetic/negative-syntaxp.lisp
-
-
-rtl/rel5/arithmetic/nniq.cert : acl2x = 0
-rtl/rel5/arithmetic/nniq.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/nniq.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/product.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/arith.cert \
-     arithmetic/rationals.cert \
-     arithmetic/idiv.cert \
-     arithmetic/idiv.cert \
-     arithmetic/top-with-meta.cert \
-     rtl/rel5/arithmetic/nniq.lisp
-
-
-rtl/rel5/arithmetic/numerator.cert : acl2x = 0
-rtl/rel5/arithmetic/numerator.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/numerator.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/numerator.lisp
-
-
-rtl/rel5/arithmetic/power2p.cert : acl2x = 0
-rtl/rel5/arithmetic/power2p.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/power2p.cert : \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel5/arithmetic/power2p.lisp
-
-
-rtl/rel5/arithmetic/predicate.cert : acl2x = 0
-rtl/rel5/arithmetic/predicate.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/predicate.cert : \
-     rtl/rel5/arithmetic/predicate.lisp
-
-
-rtl/rel5/arithmetic/product-proofs.cert : acl2x = 0
-rtl/rel5/arithmetic/product-proofs.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/product-proofs.cert : \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/product-proofs.lisp
-
-
-rtl/rel5/arithmetic/product.cert : acl2x = 0
-rtl/rel5/arithmetic/product.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/product.cert : \
-     rtl/rel5/arithmetic/product-proofs.cert \
-     rtl/rel5/arithmetic/product.lisp
-
-
-rtl/rel5/arithmetic/rationalp.cert : acl2x = 0
-rtl/rel5/arithmetic/rationalp.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/rationalp.cert : \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/rationalp.lisp
-
-
-rtl/rel5/arithmetic/top.cert : acl2x = 0
-rtl/rel5/arithmetic/top.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/top.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/arithmetic/induct.cert \
-     rtl/rel5/arithmetic/denominator.cert \
-     rtl/rel5/arithmetic/numerator.cert \
-     rtl/rel5/arithmetic/nniq.cert \
-     rtl/rel5/arithmetic/complex-rationalp.cert \
-     rtl/rel5/arithmetic/rationalp.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/arithmetic/arith.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/basic.cert \
-     rtl/rel5/arithmetic/unary-divide.cert \
-     rtl/rel5/arithmetic/product.cert \
-     rtl/rel5/arithmetic/inverted-factor.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/x-2xx.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/arithmetic/fl-hacks.cert \
-     rtl/rel5/arithmetic/even-odd2.cert \
-     rtl/rel5/arithmetic/even-odd.cert \
-     rtl/rel5/arithmetic/floor.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/cg.cert \
-     rtl/rel5/arithmetic/mod.cert \
-     rtl/rel5/arithmetic/fl-expt.cert \
-     rtl/rel5/arithmetic/mod-expt.cert \
-     rtl/rel5/arithmetic/common-factor.cert \
-     rtl/rel5/arithmetic/top.lisp
-
-
-rtl/rel5/arithmetic/unary-divide.cert : acl2x = 0
-rtl/rel5/arithmetic/unary-divide.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/unary-divide.cert : \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/inverted-factor.cert \
-     rtl/rel5/arithmetic/unary-divide.lisp
-
-
-rtl/rel5/arithmetic/x-2xx.cert : acl2x = 0
-rtl/rel5/arithmetic/x-2xx.cert : no_pcert = 0
-
-rtl/rel5/arithmetic/x-2xx.cert : \
-     arithmetic/top-with-meta.cert \
-     arithmetic/mod-gcd.cert \
-     rtl/rel5/arithmetic/x-2xx.lisp
-
-
-rtl/rel5/lib/add.cert : acl2x = 0
-rtl/rel5/lib/add.cert : no_pcert = 0
-
-rtl/rel5/lib/add.cert : \
-     rtl/rel5/support/top.cert \
-     rtl/rel5/lib/round.cert \
-     rtl/rel5/lib/add.lisp
-
-
-rtl/rel5/lib/arith.cert : acl2x = 0
-rtl/rel5/lib/arith.cert : no_pcert = 0
-
-rtl/rel5/lib/arith.cert : \
-     rtl/rel5/arithmetic/fp.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/arithmetic/extra-rules.cert \
-     rtl/rel5/support/ash.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel5/lib/arith.lisp
-
-
-rtl/rel5/lib/basic.cert : acl2x = 0
-rtl/rel5/lib/basic.cert : no_pcert = 0
-
-rtl/rel5/lib/basic.cert : \
-     rtl/rel5/support/top.cert \
-     rtl/rel5/lib/basic.lisp
-
-
-rtl/rel5/lib/bits.cert : acl2x = 0
-rtl/rel5/lib/bits.cert : no_pcert = 0
-
-rtl/rel5/lib/bits.cert : \
-     rtl/rel5/lib/basic.cert \
-     rtl/rel5/support/top.cert \
-     rtl/rel5/lib/bits.lisp
-
-
-rtl/rel5/lib/bvecp-helpers.cert : acl2x = 0
-rtl/rel5/lib/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel5/lib/bvecp-helpers.cert : \
-     rtl/rel5/lib/rtl.cert \
-     rtl/rel5/lib/rtlarr.cert \
-     rtl/rel5/support/bvecp-helpers.cert \
-     rtl/rel5/arithmetic/basic.cert \
-     rtl/rel5/lib/bvecp-helpers.lisp
-
-
-rtl/rel5/lib/bvecp-raw-helpers.cert : acl2x = 0
-rtl/rel5/lib/bvecp-raw-helpers.cert : no_pcert = 0
-
-rtl/rel5/lib/bvecp-raw-helpers.cert : \
-     rtl/rel5/lib/rtl.cert \
-     rtl/rel5/lib/rtlarr.cert \
-     rtl/rel5/support/bvecp-helpers.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/setbits.cert \
-     rtl/rel5/support/setbitn.cert \
-     rtl/rel5/support/logs.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/support/shft.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/mulcat.cert \
-     rtl/rel5/support/encode.cert \
-     rtl/rel5/support/decode.cert \
-     rtl/rel5/support/land.cert \
-     rtl/rel5/support/lior.cert \
-     rtl/rel5/support/lxor.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/arithmetic/basic.cert \
-     rtl/rel5/lib/bvecp-raw-helpers.lisp
-
-
-rtl/rel5/lib/clocks.cert : acl2x = 0
-rtl/rel5/lib/clocks.cert : no_pcert = 0
-
-rtl/rel5/lib/clocks.cert : \
-     rtl/rel5/support/clocks.cert \
-     rtl/rel5/lib/clocks.lisp
-
-
-rtl/rel5/lib/float.cert : acl2x = 0
-rtl/rel5/lib/float.cert : no_pcert = 0
-
-rtl/rel5/lib/float.cert : \
-     rtl/rel5/support/top.cert \
-     rtl/rel5/lib/log.cert \
-     rtl/rel5/lib/float.lisp
-
-
-rtl/rel5/lib/log.cert : acl2x = 0
-rtl/rel5/lib/log.cert : no_pcert = 0
-
-rtl/rel5/lib/log.cert : \
-     rtl/rel5/lib/bits.cert \
-     rtl/rel5/support/top.cert \
-     rtl/rel5/lib/log.lisp
-
-
-rtl/rel5/lib/openers.cert : acl2x = 0
-rtl/rel5/lib/openers.cert : no_pcert = 0
-
-rtl/rel5/lib/openers.cert : \
-     rtl/rel5/support/openers.cert \
-     rtl/rel5/lib/openers.lisp
-
-
-rtl/rel5/lib/package-defs.cert : acl2x = 0
-rtl/rel5/lib/package-defs.cert : no_pcert = 0
-
-rtl/rel5/lib/package-defs.cert : \
-     rtl/rel5/support/package-defs.cert \
-     rtl/rel5/lib/package-defs.lisp
-
-
-rtl/rel5/lib/reps.cert : acl2x = 0
-rtl/rel5/lib/reps.cert : no_pcert = 0
-
-rtl/rel5/lib/reps.cert : \
-     rtl/rel5/support/ereps.cert \
-     rtl/rel5/support/ireps.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/lib/log.cert \
-     rtl/rel5/lib/float.cert \
-     rtl/rel5/lib/reps.lisp
-
-
-rtl/rel5/lib/rom-helpers.cert : acl2x = 0
-rtl/rel5/lib/rom-helpers.cert : no_pcert = 0
-
-rtl/rel5/lib/rom-helpers.cert : \
-     rtl/rel5/support/rom-helpers.cert \
-     rtl/rel5/lib/rom-helpers.lisp
-
-
-rtl/rel5/lib/round.cert : acl2x = 0
-rtl/rel5/lib/round.cert : no_pcert = 0
-
-rtl/rel5/lib/round.cert : \
-     rtl/rel5/support/top.cert \
-     rtl/rel5/lib/reps.cert \
-     rtl/rel5/lib/round.lisp
-
-
-rtl/rel5/lib/rtl.cert : acl2x = 0
-rtl/rel5/lib/rtl.cert : no_pcert = 0
-
-rtl/rel5/lib/rtl.cert : \
-     rtl/rel5/support/top.cert \
-     rtl/rel5/lib/rtl.lisp
-
-
-rtl/rel5/lib/rtlarr.cert : acl2x = 0
-rtl/rel5/lib/rtlarr.cert : no_pcert = 0
-
-rtl/rel5/lib/rtlarr.cert : \
-     rtl/rel5/support/rtlarr.cert \
-     rtl/rel5/support/bvecp-helpers.cert \
-     rtl/rel5/support/guards.cert \
-     misc/total-order.cert \
-     rtl/rel5/lib/rtl.cert \
-     rtl/rel5/lib/rtlarr.lisp
-
-
-rtl/rel5/lib/simple-loop-helpers.cert : acl2x = 0
-rtl/rel5/lib/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel5/lib/simple-loop-helpers.cert : \
-     rtl/rel5/lib/rtl.cert \
-     rtl/rel5/lib/rtlarr.cert \
-     rtl/rel5/lib/arith.cert \
-     rtl/rel5/lib/log.cert \
-     rtl/rel5/support/simple-loop-helpers.cert \
-     rtl/rel5/lib/simple-loop-helpers.lisp
-
-
-rtl/rel5/lib/simplify-model-helpers.cert : acl2x = 0
-rtl/rel5/lib/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel5/lib/simplify-model-helpers.cert : \
-     rtl/rel5/lib/rtl.cert \
-     rtl/rel5/lib/arith.cert \
-     rtl/rel5/lib/bits.cert \
-     rtl/rel5/support/simplify-model-helpers.cert \
-     rtl/rel5/lib/simplify-model-helpers.lisp
-
-
-rtl/rel5/lib/top.cert : acl2x = 0
-rtl/rel5/lib/top.cert : no_pcert = 0
-
-rtl/rel5/lib/top.cert : \
-     rtl/rel5/lib/rtl.cert \
-     rtl/rel5/lib/rtlarr.cert \
-     rtl/rel5/lib/basic.cert \
-     rtl/rel5/lib/bits.cert \
-     rtl/rel5/lib/log.cert \
-     rtl/rel5/lib/float.cert \
-     rtl/rel5/lib/reps.cert \
-     rtl/rel5/lib/round.cert \
-     rtl/rel5/lib/add.cert \
-     rtl/rel5/lib/arith.cert \
-     rtl/rel5/lib/util.cert \
-     rtl/rel5/lib/top.lisp
-
-
-rtl/rel5/lib/util.cert : acl2x = 0
-rtl/rel5/lib/util.cert : no_pcert = 0
-
-rtl/rel5/lib/util.cert : \
-     rtl/rel5/support/util.cert \
-     rtl/rel5/lib/util.lisp
-
-
-rtl/rel5/support/add3-proofs.cert : acl2x = 0
-rtl/rel5/support/add3-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/add3-proofs.cert : \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/arithmetic/top.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/add3-proofs.lisp
-
-
-rtl/rel5/support/add3.cert : acl2x = 0
-rtl/rel5/support/add3.cert : no_pcert = 0
-
-rtl/rel5/support/add3.cert : \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/add3-proofs.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/add3.lisp
-
-
-rtl/rel5/support/all-ones.cert : acl2x = 0
-rtl/rel5/support/all-ones.cert : no_pcert = 0
-
-rtl/rel5/support/all-ones.cert : \
-     rtl/rel5/support/all-ones.lisp
-
-
-rtl/rel5/support/ash.cert : acl2x = 0
-rtl/rel5/support/ash.cert : no_pcert = 0
-
-rtl/rel5/support/ash.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/support/ash.lisp
-
-
-rtl/rel5/support/away-proofs.cert : acl2x = 0
-rtl/rel5/support/away-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/away-proofs.cert : \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/away-proofs.lisp
-
-
-rtl/rel5/support/away.cert : acl2x = 0
-rtl/rel5/support/away.cert : no_pcert = 0
-
-rtl/rel5/support/away.cert : \
-     rtl/rel5/support/away-proofs.cert \
-     rtl/rel5/support/away.lisp
-
-
-rtl/rel5/support/badguys.cert : acl2x = 0
-rtl/rel5/support/badguys.cert : no_pcert = 0
-
-rtl/rel5/support/badguys.cert : \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/badguys.lisp
-
-
-rtl/rel5/support/bias-proofs.cert : acl2x = 0
-rtl/rel5/support/bias-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/bias-proofs.cert : \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/support/bias-proofs.lisp
-
-
-rtl/rel5/support/bias.cert : acl2x = 0
-rtl/rel5/support/bias.cert : no_pcert = 0
-
-rtl/rel5/support/bias.cert : \
-     rtl/rel5/support/bias-proofs.cert \
-     rtl/rel5/support/bias.lisp
-
-
-rtl/rel5/support/bitn-proofs.cert : acl2x = 0
-rtl/rel5/support/bitn-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/bitn-proofs.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/bitn-proofs.lisp
-
-
-rtl/rel5/support/bitn.cert : acl2x = 0
-rtl/rel5/support/bitn.cert : no_pcert = 0
-
-rtl/rel5/support/bitn.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/support/bitn-proofs.cert \
-     rtl/rel5/support/bitn.lisp
-
-
-rtl/rel5/support/bits-proofs.cert : acl2x = 0
-rtl/rel5/support/bits-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/bits-proofs.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/bits-proofs.lisp
-
-
-rtl/rel5/support/bits-trunc-proofs.cert : acl2x = 0
-rtl/rel5/support/bits-trunc-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/bits-trunc-proofs.cert : \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/log.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bits-trunc-proofs.lisp
-
-
-rtl/rel5/support/bits-trunc.cert : acl2x = 0
-rtl/rel5/support/bits-trunc.cert : no_pcert = 0
-
-rtl/rel5/support/bits-trunc.cert : \
-     rtl/rel5/support/log.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/bits-trunc-proofs.cert \
-     rtl/rel5/support/bits-trunc.lisp
-
-
-rtl/rel5/support/bits.cert : acl2x = 0
-rtl/rel5/support/bits.cert : no_pcert = 0
-
-rtl/rel5/support/bits.cert : \
-     rtl/rel5/support/bits-proofs.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/support/bits.lisp
-
-
-rtl/rel5/support/bvecp-helpers.cert : acl2x = 0
-rtl/rel5/support/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel5/support/bvecp-helpers.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/bvecp-lemmas.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bvecp-helpers.lisp
-
-
-rtl/rel5/support/bvecp-lemmas.cert : acl2x = 0
-rtl/rel5/support/bvecp-lemmas.cert : no_pcert = 0
-
-rtl/rel5/support/bvecp-lemmas.cert : \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/setbits.cert \
-     rtl/rel5/support/setbitn.cert \
-     rtl/rel5/support/encode.cert \
-     rtl/rel5/support/decode.cert \
-     rtl/rel5/support/logs.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/shft.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/mulcat.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/bvecp-lemmas.lisp
-
-
-rtl/rel5/support/bvecp-proofs.cert : acl2x = 0
-rtl/rel5/support/bvecp-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/bvecp-proofs.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bvecp-proofs.lisp
-
-
-rtl/rel5/support/bvecp.cert : acl2x = 0
-rtl/rel5/support/bvecp.cert : no_pcert = 0
-
-rtl/rel5/support/bvecp.cert : \
-     rtl/rel5/support/bvecp-proofs.cert \
-     rtl/rel5/support/bvecp.lisp
-
-
-rtl/rel5/support/cat-def.cert : acl2x = 0
-rtl/rel5/support/cat-def.cert : no_pcert = 0
-
-rtl/rel5/support/cat-def.cert : \
-     rtl/rel5/support/cat-def.lisp
-
-
-rtl/rel5/support/cat-proofs.cert : acl2x = 0
-rtl/rel5/support/cat-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/cat-proofs.cert : \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/cat-proofs.lisp
-
-
-rtl/rel5/support/cat.cert : acl2x = 0
-rtl/rel5/support/cat.cert : no_pcert = 0
-
-rtl/rel5/support/cat.cert : \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/cat-proofs.cert \
-     rtl/rel5/support/cat.lisp
-
-
-rtl/rel5/support/clocks.cert : acl2x = 0
-rtl/rel5/support/clocks.cert : no_pcert = 0
-
-rtl/rel5/support/clocks.cert : \
-     rtl/rel5/support/mod4.cert \
-     rtl/rel5/arithmetic/even-odd2.cert \
-     rtl/rel5/support/clocks.lisp
-
-
-rtl/rel5/support/decode-proofs.cert : acl2x = 0
-rtl/rel5/support/decode-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/decode-proofs.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/support/ash.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/decode-proofs.lisp
-
-
-rtl/rel5/support/decode.cert : acl2x = 0
-rtl/rel5/support/decode.cert : no_pcert = 0
-
-rtl/rel5/support/decode.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/decode-proofs.cert \
-     rtl/rel5/support/decode.lisp
-
-
-rtl/rel5/support/drnd.cert : acl2x = 0
-rtl/rel5/support/drnd.cert : no_pcert = 0
-
-rtl/rel5/support/drnd.cert : \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/ireps.cert \
-     rtl/rel5/support/rnd.cert \
-     rtl/rel5/support/bias.cert \
-     rtl/rel5/support/sgn.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/support/near.cert \
-     rtl/rel5/support/near+.cert \
-     rtl/rel5/support/sticky.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/drnd.lisp
-
-
-rtl/rel5/support/encode.cert : acl2x = 0
-rtl/rel5/support/encode.cert : no_pcert = 0
-
-rtl/rel5/support/encode.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/ash.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/encode.lisp
-
-
-rtl/rel5/support/ereps-proofs.cert : acl2x = 0
-rtl/rel5/support/ereps-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/ereps-proofs.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/bias.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/mulcat.cert \
-     rtl/rel5/support/ereps-proofs.lisp
-
-
-rtl/rel5/support/ereps.cert : acl2x = 0
-rtl/rel5/support/ereps.cert : no_pcert = 0
-
-rtl/rel5/support/ereps.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/ereps-proofs.cert \
-     rtl/rel5/support/ereps.lisp
-
-
-rtl/rel5/support/fadd-extra.cert : acl2x = 0
-rtl/rel5/support/fadd-extra.cert : no_pcert = 0
-
-rtl/rel5/support/fadd-extra.cert : \
-     rtl/rel5/support/fadd-extra0.cert \
-     rtl/rel5/support/land.cert \
-     rtl/rel5/support/lior.cert \
-     rtl/rel5/support/lxor.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/fadd-extra.lisp
-
-
-rtl/rel5/support/fadd-extra0.cert : acl2x = 0
-rtl/rel5/support/fadd-extra0.cert : no_pcert = 0
-
-rtl/rel5/support/fadd-extra0.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/fadd.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/fadd-extra0.lisp
-
-
-rtl/rel5/support/fadd.cert : acl2x = 0
-rtl/rel5/support/fadd.cert : no_pcert = 0
-
-rtl/rel5/support/fadd.cert : \
-     rtl/rel5/support/stick.cert \
-     rtl/rel5/support/lop3.cert \
-     rtl/rel5/support/add3.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/lextra0.cert \
-     rtl/rel5/support/fadd.lisp
-
-
-rtl/rel5/support/fast-and.cert : acl2x = 0
-rtl/rel5/support/fast-and.cert : no_pcert = 0
-
-rtl/rel5/support/fast-and.cert : \
-     rtl/rel5/support/fast-and.lisp
-
-
-rtl/rel5/support/float-extra.cert : acl2x = 0
-rtl/rel5/support/float-extra.cert : no_pcert = 0
-
-rtl/rel5/support/float-extra.cert : \
-     arithmetic/inequalities.cert \
-     rtl/rel5/support/sticky.cert \
-     rtl/rel5/support/util.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/float-extra.lisp
-
-
-rtl/rel5/support/float.cert : acl2x = 0
-rtl/rel5/support/float.cert : no_pcert = 0
-
-rtl/rel5/support/float.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/basic.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/cg.cert \
-     rtl/rel5/support/float.lisp
-
-
-rtl/rel5/support/ground-zero.cert : acl2x = 0
-rtl/rel5/support/ground-zero.cert : no_pcert = 0
-
-rtl/rel5/support/ground-zero.cert : \
-     rtl/rel5/arithmetic/ground-zero.cert \
-     rtl/rel5/support/util.cert \
-     rtl/rel5/support/ground-zero.lisp
-
-
-rtl/rel5/support/guards.cert : acl2x = 0
-rtl/rel5/support/guards.cert : no_pcert = 0
-
-rtl/rel5/support/guards.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/land.cert \
-     rtl/rel5/support/lior.cert \
-     rtl/rel5/support/lxor.cert \
-     rtl/rel5/support/guards.lisp
-
-
-rtl/rel5/support/ireps.cert : acl2x = 0
-rtl/rel5/support/ireps.cert : no_pcert = 0
-
-rtl/rel5/support/ireps.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/bias.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/ireps.lisp
-
-
-rtl/rel5/support/land.cert : acl2x = 0
-rtl/rel5/support/land.cert : no_pcert = 0
-
-rtl/rel5/support/land.cert : \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/land.lisp
-
-
-rtl/rel5/support/land0-proofs.cert : acl2x = 0
-rtl/rel5/support/land0-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/land0-proofs.cert : \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/all-ones.cert \
-     rtl/rel5/support/log.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/arithmetic/fl-hacks.cert \
-     rtl/rel5/support/land0-proofs.lisp
-
-
-rtl/rel5/support/land0.cert : acl2x = 0
-rtl/rel5/support/land0.cert : no_pcert = 0
-
-rtl/rel5/support/land0.cert : \
-     rtl/rel5/support/land0-proofs.cert \
-     rtl/rel5/support/land0.lisp
-
-
-rtl/rel5/support/lextra-proofs.cert : acl2x = 0
-rtl/rel5/support/lextra-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/lextra-proofs.cert : \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/logxor.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/lextra-proofs.lisp
-
-
-rtl/rel5/support/lextra.cert : acl2x = 0
-rtl/rel5/support/lextra.cert : no_pcert = 0
-
-rtl/rel5/support/lextra.cert : \
-     rtl/rel5/support/land.cert \
-     rtl/rel5/support/lior.cert \
-     rtl/rel5/support/lxor.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/lextra0.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/merge2.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bits-trunc.cert \
-     rtl/rel5/support/fadd.cert \
-     rtl/rel5/support/lextra.lisp
-
-
-rtl/rel5/support/lextra0.cert : acl2x = 0
-rtl/rel5/support/lextra0.cert : no_pcert = 0
-
-rtl/rel5/support/lextra0.cert : \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/lextra-proofs.cert \
-     rtl/rel5/support/lextra0.lisp
-
-
-rtl/rel5/support/lior.cert : acl2x = 0
-rtl/rel5/support/lior.cert : no_pcert = 0
-
-rtl/rel5/support/lior.cert : \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/lior.lisp
-
-
-rtl/rel5/support/lior0-proofs.cert : acl2x = 0
-rtl/rel5/support/lior0-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/lior0-proofs.cert : \
-     rtl/rel5/support/all-ones.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/lior0-proofs.lisp
-
-
-rtl/rel5/support/lior0.cert : acl2x = 0
-rtl/rel5/support/lior0.cert : no_pcert = 0
-
-rtl/rel5/support/lior0.cert : \
-     rtl/rel5/support/lior0-proofs.cert \
-     rtl/rel5/support/lior0.lisp
-
-
-rtl/rel5/support/lnot-proofs.cert : acl2x = 0
-rtl/rel5/support/lnot-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/lnot-proofs.cert : \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/mod.cert \
-     rtl/rel5/arithmetic/mod.cert \
-     rtl/rel5/arithmetic/arith.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/lnot-proofs.lisp
-
-
-rtl/rel5/support/lnot.cert : acl2x = 0
-rtl/rel5/support/lnot.cert : no_pcert = 0
-
-rtl/rel5/support/lnot.cert : \
-     rtl/rel5/support/lnot-proofs.cert \
-     rtl/rel5/support/lnot.lisp
-
-
-rtl/rel5/support/log-equal.cert : acl2x = 0
-rtl/rel5/support/log-equal.cert : no_pcert = 0
-
-rtl/rel5/support/log-equal.cert : \
-     rtl/rel5/support/log-equal.lisp
-
-
-rtl/rel5/support/log-proofs.cert : acl2x = 0
-rtl/rel5/support/log-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/log-proofs.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/lognot.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/logxor.cert \
-     rtl/rel5/support/log-proofs.lisp
-
-
-rtl/rel5/support/log.cert : acl2x = 0
-rtl/rel5/support/log.cert : no_pcert = 0
-
-rtl/rel5/support/log.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/log-proofs.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/logxor.cert \
-     rtl/rel5/support/log.lisp
-
-
-rtl/rel5/support/logand-proofs.cert : acl2x = 0
-rtl/rel5/support/logand-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/logand-proofs.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/arithmetic/induct.cert \
-     rtl/rel5/support/lognot.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/logand-proofs.lisp
-
-
-rtl/rel5/support/logand.cert : acl2x = 0
-rtl/rel5/support/logand.cert : no_pcert = 0
-
-rtl/rel5/support/logand.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/logand-proofs.cert \
-     rtl/rel5/support/logand.lisp
-
-
-rtl/rel5/support/logeqv.cert : acl2x = 0
-rtl/rel5/support/logeqv.cert : no_pcert = 0
-
-rtl/rel5/support/logeqv.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/logorc1.cert \
-     rtl/rel5/support/lognot.cert \
-     rtl/rel5/support/logeqv.lisp
-
-
-rtl/rel5/support/logior-proofs.cert : acl2x = 0
-rtl/rel5/support/logior-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/logior-proofs.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/lognot.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/logior-proofs.lisp
-
-
-rtl/rel5/support/logior.cert : acl2x = 0
-rtl/rel5/support/logior.cert : no_pcert = 0
-
-rtl/rel5/support/logior.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/logior-proofs.cert \
-     rtl/rel5/support/logior.lisp
-
-
-rtl/rel5/support/logior1-proofs.cert : acl2x = 0
-rtl/rel5/support/logior1-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/logior1-proofs.cert : \
-     rtl/rel5/support/logior1-proofs.lisp
-
-
-rtl/rel5/support/logior1.cert : acl2x = 0
-rtl/rel5/support/logior1.cert : no_pcert = 0
-
-rtl/rel5/support/logior1.cert : \
-     rtl/rel5/support/logior1-proofs.cert \
-     rtl/rel5/support/logior1.lisp
-
-
-rtl/rel5/support/lognot.cert : acl2x = 0
-rtl/rel5/support/lognot.cert : no_pcert = 0
-
-rtl/rel5/support/lognot.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/lognot.lisp
-
-
-rtl/rel5/support/logorc1.cert : acl2x = 0
-rtl/rel5/support/logorc1.cert : no_pcert = 0
-
-rtl/rel5/support/logorc1.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/support/lognot.cert \
-     rtl/rel5/support/logorc1.lisp
-
-
-rtl/rel5/support/logs.cert : acl2x = 0
-rtl/rel5/support/logs.cert : no_pcert = 0
-
-rtl/rel5/support/logs.cert : \
-     rtl/rel5/support/logs.lisp
-
-
-rtl/rel5/support/logxor.cert : acl2x = 0
-rtl/rel5/support/logxor.cert : no_pcert = 0
-
-rtl/rel5/support/logxor.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/logeqv.cert \
-     rtl/rel5/support/logorc1.cert \
-     rtl/rel5/support/lognot.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/logxor.lisp
-
-
-rtl/rel5/support/lop1-proofs.cert : acl2x = 0
-rtl/rel5/support/lop1-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/lop1-proofs.cert : \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/lop1-proofs.lisp
-
-
-rtl/rel5/support/lop1.cert : acl2x = 0
-rtl/rel5/support/lop1.cert : no_pcert = 0
-
-rtl/rel5/support/lop1.cert : \
-     rtl/rel5/support/lop1-proofs.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/lop1.lisp
-
-
-rtl/rel5/support/lop2-proofs.cert : acl2x = 0
-rtl/rel5/support/lop2-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/lop2-proofs.cert : \
-     rtl/rel5/support/lop1.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/lop2-proofs.lisp
-
-
-rtl/rel5/support/lop2.cert : acl2x = 0
-rtl/rel5/support/lop2.cert : no_pcert = 0
-
-rtl/rel5/support/lop2.cert : \
-     rtl/rel5/support/lop1.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lop2-proofs.cert \
-     rtl/rel5/support/lop2.lisp
-
-
-rtl/rel5/support/lop3-proofs.cert : acl2x = 0
-rtl/rel5/support/lop3-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/lop3-proofs.cert : \
-     rtl/rel5/support/lop2.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/lop3-proofs.lisp
-
-
-rtl/rel5/support/lop3.cert : acl2x = 0
-rtl/rel5/support/lop3.cert : no_pcert = 0
-
-rtl/rel5/support/lop3.cert : \
-     rtl/rel5/support/lop2.cert \
-     rtl/rel5/support/lop3-proofs.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/lop3.lisp
-
-
-rtl/rel5/support/lxor.cert : acl2x = 0
-rtl/rel5/support/lxor.cert : no_pcert = 0
-
-rtl/rel5/support/lxor.cert : \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/lxor.lisp
-
-
-rtl/rel5/support/lxor0-proofs.cert : acl2x = 0
-rtl/rel5/support/lxor0-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/lxor0-proofs.cert : \
-     rtl/rel5/support/all-ones.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/lxor0-proofs.lisp
-
-
-rtl/rel5/support/lxor0.cert : acl2x = 0
-rtl/rel5/support/lxor0.cert : no_pcert = 0
-
-rtl/rel5/support/lxor0.cert : \
-     rtl/rel5/support/lxor0-proofs.cert \
-     rtl/rel5/support/lxor0.lisp
-
-
-rtl/rel5/support/merge.cert : acl2x = 0
-rtl/rel5/support/merge.cert : no_pcert = 0
-
-rtl/rel5/support/merge.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/log.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/logxor.cert \
-     rtl/rel5/support/ocat.cert \
-     rtl/rel5/support/sumbits.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/merge.lisp
-
-
-rtl/rel5/support/merge2.cert : acl2x = 0
-rtl/rel5/support/merge2.cert : no_pcert = 0
-
-rtl/rel5/support/merge2.cert : \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/logs.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/merge2.lisp
-
-
-rtl/rel5/support/mod4.cert : acl2x = 0
-rtl/rel5/support/mod4.cert : no_pcert = 0
-
-rtl/rel5/support/mod4.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/mod4.lisp
-
-
-rtl/rel5/support/model-helpers.cert : acl2x = 0
-rtl/rel5/support/model-helpers.cert : no_pcert = 0
-
-rtl/rel5/support/model-helpers.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/model-helpers.lisp
-
-
-rtl/rel5/support/mulcat-proofs.cert : acl2x = 0
-rtl/rel5/support/mulcat-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/mulcat-proofs.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/mulcat-proofs.lisp
-
-
-rtl/rel5/support/mulcat.cert : acl2x = 0
-rtl/rel5/support/mulcat.cert : no_pcert = 0
-
-rtl/rel5/support/mulcat.cert : \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/mulcat-proofs.cert \
-     rtl/rel5/support/mulcat.lisp
-
-
-rtl/rel5/support/near+-proofs.cert : acl2x = 0
-rtl/rel5/support/near+-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/near+-proofs.cert : \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/arithmetic/predicate.cert \
-     rtl/rel5/arithmetic/cg.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/near+-proofs.lisp
-
-
-rtl/rel5/support/near+.cert : acl2x = 0
-rtl/rel5/support/near+.cert : no_pcert = 0
-
-rtl/rel5/support/near+.cert : \
-     rtl/rel5/support/near+-proofs.cert \
-     rtl/rel5/support/near+.lisp
-
-
-rtl/rel5/support/near-proofs.cert : acl2x = 0
-rtl/rel5/support/near-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/near-proofs.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/near-proofs.lisp
-
-
-rtl/rel5/support/near.cert : acl2x = 0
-rtl/rel5/support/near.cert : no_pcert = 0
-
-rtl/rel5/support/near.cert : \
-     rtl/rel5/support/near-proofs.cert \
-     rtl/rel5/support/near.lisp
-
-
-rtl/rel5/support/ocat.cert : acl2x = 0
-rtl/rel5/support/ocat.cert : no_pcert = 0
-
-rtl/rel5/support/ocat.cert : \
-     rtl/rel5/arithmetic/expt.cert \
-     rtl/rel5/arithmetic/expo.cert \
-     rtl/rel5/arithmetic/arith2.cert \
-     rtl/rel5/arithmetic/fp2.cert \
-     rtl/rel5/arithmetic/integerp.cert \
-     rtl/rel5/support/ocat.lisp
-
-
-rtl/rel5/support/oddr-proofs.cert : acl2x = 0
-rtl/rel5/support/oddr-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/oddr-proofs.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/support/near.cert \
-     rtl/rel5/support/oddr-proofs.lisp
-
-
-rtl/rel5/support/oddr.cert : acl2x = 0
-rtl/rel5/support/oddr.cert : no_pcert = 0
-
-rtl/rel5/support/oddr.cert : \
-     rtl/rel5/support/oddr-proofs.cert \
-     rtl/rel5/support/oddr.lisp
-
-
-rtl/rel5/support/openers.cert : acl2x = 0
-rtl/rel5/support/openers.cert : no_pcert = 0
-
-rtl/rel5/support/openers.cert : \
-     rtl/rel5/support/openers.lisp
-
-
-rtl/rel5/support/package-defs.cert : acl2x = 0
-rtl/rel5/support/package-defs.cert : no_pcert = 0
-
-rtl/rel5/support/package-defs.cert : \
-     rtl/rel5/support/package-defs.lisp
-
-
-rtl/rel5/support/rewrite-theory.cert : acl2x = 0
-rtl/rel5/support/rewrite-theory.cert : no_pcert = 0
-
-rtl/rel5/support/rewrite-theory.cert : \
-     rtl/rel5/support/rewrite-theory.lisp
-
-
-rtl/rel5/support/rnd.cert : acl2x = 0
-rtl/rel5/support/rnd.cert : no_pcert = 0
-
-rtl/rel5/support/rnd.cert : \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/support/near.cert \
-     rtl/rel5/support/near+.cert \
-     rtl/rel5/support/sticky.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bits-trunc.cert \
-     rtl/rel5/support/rnd.lisp
-
-
-rtl/rel5/support/rom-helpers.cert : acl2x = 0
-rtl/rel5/support/rom-helpers.cert : no_pcert = 0
-
-rtl/rel5/support/rom-helpers.cert : \
-     rtl/rel5/support/rom-helpers.lisp
-
-
-rtl/rel5/support/round-extra.cert : acl2x = 0
-rtl/rel5/support/round-extra.cert : no_pcert = 0
-
-rtl/rel5/support/round-extra.cert : \
-     rtl/rel5/support/sticky.cert \
-     rtl/rel5/support/util.cert \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/round-extra.lisp
-
-
-rtl/rel5/support/rtl.cert : acl2x = 0
-rtl/rel5/support/rtl.cert : no_pcert = 0
-
-rtl/rel5/support/rtl.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/rtlarr.cert \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/rtl.lisp
-
-
-rtl/rel5/support/rtlarr.cert : acl2x = 0
-rtl/rel5/support/rtlarr.cert : no_pcert = 0
-
-rtl/rel5/support/rtlarr.cert : \
-     misc/total-order.cert \
-     rtl/rel5/support/rtlarr.lisp
-
-
-rtl/rel5/support/setbitn-proofs.cert : acl2x = 0
-rtl/rel5/support/setbitn-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/setbitn-proofs.cert : \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/setbits.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/setbitn-proofs.lisp
-
-
-rtl/rel5/support/setbitn.cert : acl2x = 0
-rtl/rel5/support/setbitn.cert : no_pcert = 0
-
-rtl/rel5/support/setbitn.cert : \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/setbitn-proofs.cert \
-     rtl/rel5/support/setbitn.lisp
-
-
-rtl/rel5/support/setbits-proofs.cert : acl2x = 0
-rtl/rel5/support/setbits-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/setbits-proofs.cert : \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/setbits-proofs.lisp
-
-
-rtl/rel5/support/setbits.cert : acl2x = 0
-rtl/rel5/support/setbits.cert : no_pcert = 0
-
-rtl/rel5/support/setbits.cert : \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/setbits-proofs.cert \
-     rtl/rel5/support/setbits.lisp
-
-
-rtl/rel5/support/sgn.cert : acl2x = 0
-rtl/rel5/support/sgn.cert : no_pcert = 0
-
-rtl/rel5/support/sgn.cert : \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/sgn.lisp
-
-
-rtl/rel5/support/shft.cert : acl2x = 0
-rtl/rel5/support/shft.cert : no_pcert = 0
-
-rtl/rel5/support/shft.cert : \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/shft.lisp
-
-
-rtl/rel5/support/simple-loop-helpers.cert : acl2x = 0
-rtl/rel5/support/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel5/support/simple-loop-helpers.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/setbitn.cert \
-     rtl/rel5/support/simple-loop-helpers.lisp
-
-
-rtl/rel5/support/simplify-model-helpers.cert : acl2x = 0
-rtl/rel5/support/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel5/support/simplify-model-helpers.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/simplify-model-helpers.lisp
-
-
-rtl/rel5/support/stick-proofs.cert : acl2x = 0
-rtl/rel5/support/stick-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/stick-proofs.cert : \
-     rtl/rel5/support/merge.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/support/stick-proofs.lisp
-
-
-rtl/rel5/support/stick.cert : acl2x = 0
-rtl/rel5/support/stick.cert : no_pcert = 0
-
-rtl/rel5/support/stick.cert : \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/stick-proofs.cert \
-     rtl/rel5/support/stick.lisp
-
-
-rtl/rel5/support/sticky-proofs.cert : acl2x = 0
-rtl/rel5/support/sticky-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/sticky-proofs.cert : \
-     rtl/rel5/arithmetic/arith.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/support/near.cert \
-     rtl/rel5/support/near+.cert \
-     rtl/rel5/support/sticky-proofs.lisp
-
-
-rtl/rel5/support/sticky.cert : acl2x = 0
-rtl/rel5/support/sticky.cert : no_pcert = 0
-
-rtl/rel5/support/sticky.cert : \
-     rtl/rel5/support/sticky-proofs.cert \
-     rtl/rel5/support/sticky.lisp
-
-
-rtl/rel5/support/sumbits.cert : acl2x = 0
-rtl/rel5/support/sumbits.cert : no_pcert = 0
-
-rtl/rel5/support/sumbits.cert : \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/sumbits.lisp
-
-
-rtl/rel5/support/top.cert : acl2x = 0
-rtl/rel5/support/top.cert : no_pcert = 0
-
-rtl/rel5/support/top.cert : \
-     rtl/rel5/support/top1.cert \
-     rtl/rel5/support/lextra.cert \
-     rtl/rel5/support/fadd-extra.cert \
-     rtl/rel5/support/float-extra.cert \
-     rtl/rel5/support/round-extra.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/support/badguys.cert \
-     rtl/rel5/support/top.lisp
-
-
-rtl/rel5/support/top1.cert : acl2x = 0
-rtl/rel5/support/top1.cert : no_pcert = 0
-
-rtl/rel5/support/top1.cert : \
-     rtl/rel5/support/util.cert \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/rewrite-theory.cert \
-     rtl/rel5/support/rtl.cert \
-     rtl/rel5/support/rtlarr.cert \
-     rtl/rel5/support/bvecp-lemmas.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/ocat.cert \
-     rtl/rel5/support/cat-def.cert \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/support/ash.cert \
-     rtl/rel5/support/decode.cert \
-     rtl/rel5/support/encode.cert \
-     rtl/rel5/support/mulcat.cert \
-     rtl/rel5/support/shft.cert \
-     rtl/rel5/support/all-ones.cert \
-     rtl/rel5/support/merge2.cert \
-     rtl/rel5/support/logior1.cert \
-     rtl/rel5/support/setbits.cert \
-     rtl/rel5/support/setbitn.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/support/bias.cert \
-     rtl/rel5/support/ereps.cert \
-     rtl/rel5/support/ireps.cert \
-     rtl/rel5/support/logeqv.cert \
-     rtl/rel5/support/logorc1.cert \
-     rtl/rel5/support/lognot.cert \
-     rtl/rel5/support/logand.cert \
-     rtl/rel5/support/logior.cert \
-     rtl/rel5/support/logxor.cert \
-     rtl/rel5/support/log.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/support/lextra0.cert \
-     rtl/rel5/support/logs.cert \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/support/near.cert \
-     rtl/rel5/support/near+.cert \
-     rtl/rel5/support/oddr.cert \
-     rtl/rel5/support/sticky.cert \
-     rtl/rel5/support/rnd.cert \
-     rtl/rel5/support/drnd.cert \
-     rtl/rel5/support/bits-trunc.cert \
-     rtl/rel5/support/add3.cert \
-     rtl/rel5/support/lop1.cert \
-     rtl/rel5/support/lop2.cert \
-     rtl/rel5/support/lop3.cert \
-     rtl/rel5/support/stick.cert \
-     rtl/rel5/support/bvecp-helpers.cert \
-     rtl/rel5/support/model-helpers.cert \
-     rtl/rel5/support/rom-helpers.cert \
-     rtl/rel5/support/simple-loop-helpers.cert \
-     rtl/rel5/support/clocks.cert \
-     rtl/rel5/support/openers.cert \
-     rtl/rel5/support/package-defs.cert \
-     rtl/rel5/support/simplify-model-helpers.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/arithmetic/fp.cert \
-     rtl/rel5/support/fadd.cert \
-     rtl/rel5/support/top1.lisp
-
-
-rtl/rel5/support/trunc-proofs.cert : acl2x = 0
-rtl/rel5/support/trunc-proofs.cert : no_pcert = 0
-
-rtl/rel5/support/trunc-proofs.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/float.cert \
-     rtl/rel5/arithmetic/top.cert \
-     rtl/rel5/support/trunc-proofs.lisp
-
-
-rtl/rel5/support/trunc.cert : acl2x = 0
-rtl/rel5/support/trunc.cert : no_pcert = 0
-
-rtl/rel5/support/trunc.cert : \
-     rtl/rel5/support/ground-zero.cert \
-     rtl/rel5/support/trunc-proofs.cert \
-     rtl/rel5/support/trunc.lisp
-
-
-rtl/rel5/support/util.cert : acl2x = 0
-rtl/rel5/support/util.cert : no_pcert = 0
-
-rtl/rel5/support/util.cert : \
-     rtl/rel5/support/util.lisp
-
-
-rtl/rel5/user/away.cert : acl2x = 0
-rtl/rel5/user/away.cert : no_pcert = 0
-
-rtl/rel5/user/away.cert : \
-     rtl/rel5/user/trunc.cert \
-     rtl/rel5/support/away.cert \
-     rtl/rel5/user/away.lisp
-
-
-rtl/rel5/user/bias.cert : acl2x = 0
-rtl/rel5/user/bias.cert : no_pcert = 0
-
-rtl/rel5/user/bias.cert : \
-     rtl/rel5/support/bias.cert \
-     rtl/rel5/user/bias.lisp
-
-
-rtl/rel5/user/bitn.cert : acl2x = 0
-rtl/rel5/user/bitn.cert : no_pcert = 0
-
-rtl/rel5/user/bitn.cert : \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/support/bitn.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/bitn.lisp
-
-
-rtl/rel5/user/bits-trunc.cert : acl2x = 0
-rtl/rel5/user/bits-trunc.cert : no_pcert = 0
-
-rtl/rel5/user/bits-trunc.cert : \
-     rtl/rel5/user/land.cert \
-     rtl/rel5/support/bits-trunc.cert \
-     rtl/rel5/user/bits-trunc.lisp
-
-
-rtl/rel5/user/bits.cert : acl2x = 0
-rtl/rel5/user/bits.cert : no_pcert = 0
-
-rtl/rel5/user/bits.cert : \
-     rtl/rel5/arithmetic/negative-syntaxp.cert \
-     rtl/rel5/arithmetic/power2p.cert \
-     rtl/rel5/support/bits.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/bits.lisp
-
-
-rtl/rel5/user/brat.cert : acl2x = 0
-rtl/rel5/user/brat.cert : no_pcert = 0
-
-rtl/rel5/user/brat.cert : \
-     rtl/rel5/arithmetic/fl.cert \
-     rtl/rel5/user/brat.lisp
-
-
-rtl/rel5/user/bvecp.cert : acl2x = 0
-rtl/rel5/user/bvecp.cert : no_pcert = 0
-
-rtl/rel5/user/bvecp.cert : \
-     rtl/rel5/support/bvecp.cert \
-     rtl/rel5/user/bvecp.lisp
-
-
-rtl/rel5/user/cat.cert : acl2x = 0
-rtl/rel5/user/cat.cert : no_pcert = 0
-
-rtl/rel5/user/cat.cert : \
-     rtl/rel5/support/cat.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/cat.lisp
-
-
-rtl/rel5/user/decode.cert : acl2x = 0
-rtl/rel5/user/decode.cert : no_pcert = 0
-
-rtl/rel5/user/decode.cert : \
-     rtl/rel5/support/decode.cert \
-     rtl/rel5/user/decode.lisp
-
-
-rtl/rel5/user/ereps.cert : acl2x = 0
-rtl/rel5/user/ereps.cert : no_pcert = 0
-
-rtl/rel5/user/ereps.cert : \
-     rtl/rel5/support/ereps.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/ereps.lisp
-
-
-rtl/rel5/user/land.cert : acl2x = 0
-rtl/rel5/user/land.cert : no_pcert = 0
-
-rtl/rel5/user/land.cert : \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/support/land0.cert \
-     rtl/rel5/user/land.lisp
-
-
-rtl/rel5/user/lextra.cert : acl2x = 0
-rtl/rel5/user/lextra.cert : no_pcert = 0
-
-rtl/rel5/user/lextra.cert : \
-     rtl/rel5/user/land.cert \
-     rtl/rel5/user/lior.cert \
-     rtl/rel5/user/lxor.cert \
-     rtl/rel5/support/lextra0.cert \
-     rtl/rel5/user/lextra.lisp
-
-
-rtl/rel5/user/lior.cert : acl2x = 0
-rtl/rel5/user/lior.cert : no_pcert = 0
-
-rtl/rel5/user/lior.cert : \
-     rtl/rel5/support/lior0.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/lior.lisp
-
-
-rtl/rel5/user/lnot.cert : acl2x = 0
-rtl/rel5/user/lnot.cert : no_pcert = 0
-
-rtl/rel5/user/lnot.cert : \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/support/lnot.cert \
-     rtl/rel5/user/lnot.lisp
-
-
-rtl/rel5/user/logior1.cert : acl2x = 0
-rtl/rel5/user/logior1.cert : no_pcert = 0
-
-rtl/rel5/user/logior1.cert : \
-     rtl/rel5/support/logior1.cert \
-     rtl/rel5/user/logior1.lisp
-
-
-rtl/rel5/user/lxor.cert : acl2x = 0
-rtl/rel5/user/lxor.cert : no_pcert = 0
-
-rtl/rel5/user/lxor.cert : \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/support/lxor0.cert \
-     rtl/rel5/user/lxor.lisp
-
-
-rtl/rel5/user/mulcat.cert : acl2x = 0
-rtl/rel5/user/mulcat.cert : no_pcert = 0
-
-rtl/rel5/user/mulcat.cert : \
-     rtl/rel5/support/mulcat.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/mulcat.lisp
-
-
-rtl/rel5/user/near.cert : acl2x = 0
-rtl/rel5/user/near.cert : no_pcert = 0
-
-rtl/rel5/user/near.cert : \
-     rtl/rel5/support/near.cert \
-     rtl/rel5/user/near.lisp
-
-
-rtl/rel5/user/setbitn.cert : acl2x = 0
-rtl/rel5/user/setbitn.cert : no_pcert = 0
-
-rtl/rel5/user/setbitn.cert : \
-     rtl/rel5/support/setbitn.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/setbitn.lisp
-
-
-rtl/rel5/user/setbits.cert : acl2x = 0
-rtl/rel5/user/setbits.cert : no_pcert = 0
-
-rtl/rel5/user/setbits.cert : \
-     rtl/rel5/support/setbits.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/setbits.lisp
-
-
-rtl/rel5/user/stick.cert : acl2x = 0
-rtl/rel5/user/stick.cert : no_pcert = 0
-
-rtl/rel5/user/stick.cert : \
-     rtl/rel5/user/land.cert \
-     rtl/rel5/user/lior.cert \
-     rtl/rel5/user/lxor.cert \
-     rtl/rel5/user/lnot.cert \
-     rtl/rel5/support/stick.cert \
-     rtl/rel5/user/stick.lisp
-
-
-rtl/rel5/user/sumbits.cert : acl2x = 0
-rtl/rel5/user/sumbits.cert : no_pcert = 0
-
-rtl/rel5/user/sumbits.cert : \
-     rtl/rel5/support/sumbits.cert \
-     rtl/rel5/support/guards.cert \
-     rtl/rel5/user/sumbits.lisp
-
-
-rtl/rel5/user/top.cert : acl2x = 0
-rtl/rel5/user/top.cert : no_pcert = 0
-
-rtl/rel5/user/top.cert : \
-     rtl/rel5/user/bits.cert \
-     rtl/rel5/user/bitn.cert \
-     rtl/rel5/user/cat.cert \
-     rtl/rel5/user/bvecp.cert \
-     rtl/rel5/user/mulcat.cert \
-     rtl/rel5/user/logior1.cert \
-     rtl/rel5/user/setbits.cert \
-     rtl/rel5/user/setbitn.cert \
-     rtl/rel5/user/bias.cert \
-     rtl/rel5/user/ereps.cert \
-     rtl/rel5/user/lnot.cert \
-     rtl/rel5/user/land.cert \
-     rtl/rel5/user/lior.cert \
-     rtl/rel5/user/lxor.cert \
-     rtl/rel5/user/lextra.cert \
-     rtl/rel5/user/trunc.cert \
-     rtl/rel5/user/away.cert \
-     rtl/rel5/user/near.cert \
-     rtl/rel5/user/bits-trunc.cert \
-     rtl/rel5/user/stick.cert \
-     rtl/rel5/user/sumbits.cert \
-     rtl/rel5/user/top.lisp
-
-
-rtl/rel5/user/trunc.cert : acl2x = 0
-rtl/rel5/user/trunc.cert : no_pcert = 0
-
-rtl/rel5/user/trunc.cert : \
-     rtl/rel5/support/trunc.cert \
-     rtl/rel5/user/trunc.lisp
-
-
-rtl/rel8/arithmetic/arith.cert : acl2x = 0
-rtl/rel8/arithmetic/arith.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/arith.cert : \
-     rtl/rel8/arithmetic/arith2.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     meta/meta-times-equal.cert \
-     rtl/rel8/arithmetic/arith.lisp
-
-
-rtl/rel8/arithmetic/arith2.cert : acl2x = 0
-rtl/rel8/arithmetic/arith2.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/arith2.cert : \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/product.cert \
-     meta/meta-times-equal.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     meta/meta-times-equal.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel8/arithmetic/inverted-factor.cert \
-     rtl/rel8/arithmetic/arith2.lisp
-
-
-rtl/rel8/arithmetic/basic.cert : acl2x = 0
-rtl/rel8/arithmetic/basic.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/basic.cert : \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/even-odd.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/basic.lisp
-
-
-rtl/rel8/arithmetic/cg.cert : acl2x = 0
-rtl/rel8/arithmetic/cg.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/cg.cert : \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/common-factor.cert \
-     rtl/rel8/arithmetic/cg.lisp
-
-
-rtl/rel8/arithmetic/common-factor-defuns.cert : acl2x = 0
-rtl/rel8/arithmetic/common-factor-defuns.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/common-factor-defuns.cert : \
-     rtl/rel8/arithmetic/inverted-factor.cert \
-     rtl/rel8/arithmetic/common-factor-defuns.lisp
-
-
-rtl/rel8/arithmetic/common-factor.cert : acl2x = 0
-rtl/rel8/arithmetic/common-factor.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/common-factor.cert : \
-     meta/meta-times-equal.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel8/arithmetic/common-factor-defuns.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/product.cert \
-     rtl/rel8/arithmetic/common-factor.lisp
-
-
-rtl/rel8/arithmetic/complex-rationalp.cert : acl2x = 0
-rtl/rel8/arithmetic/complex-rationalp.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/complex-rationalp.cert : \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/complex-rationalp.lisp
-
-
-rtl/rel8/arithmetic/denominator.cert : acl2x = 0
-rtl/rel8/arithmetic/denominator.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/denominator.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     arithmetic/mod-gcd.cert \
-     rtl/rel8/arithmetic/denominator.lisp
-
-
-rtl/rel8/arithmetic/even-odd.cert : acl2x = 0
-rtl/rel8/arithmetic/even-odd.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/even-odd.cert : \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/even-odd.lisp
-
-
-rtl/rel8/arithmetic/even-odd2-proofs.cert : acl2x = 0
-rtl/rel8/arithmetic/even-odd2-proofs.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/even-odd2-proofs.cert : \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/arith.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/even-odd2-proofs.lisp
-
-
-rtl/rel8/arithmetic/even-odd2.cert : acl2x = 0
-rtl/rel8/arithmetic/even-odd2.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/even-odd2.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/even-odd2-proofs.cert \
-     rtl/rel8/arithmetic/even-odd2.lisp
-
-
-rtl/rel8/arithmetic/expo-proofs.cert : acl2x = 0
-rtl/rel8/arithmetic/expo-proofs.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/expo-proofs.cert : \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/arithmetic/common-factor-defuns.cert \
-     rtl/rel8/arithmetic/common-factor.cert \
-     rtl/rel8/arithmetic/expo-proofs.lisp
-
-
-rtl/rel8/arithmetic/expo.cert : acl2x = 0
-rtl/rel8/arithmetic/expo.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/expo.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/expo-proofs.cert \
-     rtl/rel8/arithmetic/common-factor-defuns.cert \
-     rtl/rel8/arithmetic/expo.lisp
-
-
-rtl/rel8/arithmetic/expt-proofs.cert : acl2x = 0
-rtl/rel8/arithmetic/expt-proofs.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/expt-proofs.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     arithmetic/top.cert \
-     rtl/rel8/arithmetic/even-odd.cert \
-     rtl/rel8/arithmetic/expt-proofs.lisp
-
-
-rtl/rel8/arithmetic/expt.cert : acl2x = 0
-rtl/rel8/arithmetic/expt.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/expt.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/expt-proofs.cert \
-     rtl/rel8/arithmetic/expt.lisp
-
-
-rtl/rel8/arithmetic/extra-rules.cert : acl2x = 0
-rtl/rel8/arithmetic/extra-rules.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/extra-rules.cert : \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/arithmetic/extra-rules.lisp
-
-
-rtl/rel8/arithmetic/fl-expt.cert : acl2x = 0
-rtl/rel8/arithmetic/fl-expt.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/fl-expt.cert : \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/nniq.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/floor.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/rationalp.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/fl-expt.lisp
-
-
-rtl/rel8/arithmetic/fl-hacks.cert : acl2x = 0
-rtl/rel8/arithmetic/fl-hacks.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/fl-hacks.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/inverted-factor.cert \
-     rtl/rel8/arithmetic/nniq.cert \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/product.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/rationalp.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/mod.cert \
-     rtl/rel8/arithmetic/even-odd.cert \
-     meta/meta-plus-equal.cert \
-     rtl/rel8/arithmetic/arith.cert \
-     rtl/rel8/arithmetic/fl-hacks.lisp
-
-
-rtl/rel8/arithmetic/fl-proofs.cert : acl2x = 0
-rtl/rel8/arithmetic/fl-proofs.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/fl-proofs.cert : \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/nniq.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/floor.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/rationalp.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/common-factor.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/fl-proofs.lisp
-
-
-rtl/rel8/arithmetic/fl.cert : acl2x = 0
-rtl/rel8/arithmetic/fl.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/fl.cert : \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/fl-proofs.cert \
-     rtl/rel8/arithmetic/fl.lisp
-
-
-rtl/rel8/arithmetic/floor-proofs.cert : acl2x = 0
-rtl/rel8/arithmetic/floor-proofs.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/floor-proofs.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/nniq.cert \
-     rtl/rel8/arithmetic/product.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/rationalp.cert \
-     rtl/rel8/arithmetic/inverted-factor.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel8/arithmetic/floor-proofs.lisp
-
-
-rtl/rel8/arithmetic/floor.cert : acl2x = 0
-rtl/rel8/arithmetic/floor.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/floor.cert : \
-     rtl/rel8/arithmetic/floor-proofs.cert \
-     rtl/rel8/arithmetic/floor.lisp
-
-
-rtl/rel8/arithmetic/fp.cert : acl2x = 0
-rtl/rel8/arithmetic/fp.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/fp.cert : \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/fp.lisp
-
-
-rtl/rel8/arithmetic/fp2.cert : acl2x = 0
-rtl/rel8/arithmetic/fp2.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/fp2.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     ihs/ihs-lemmas.cert \
-     arithmetic-2/meta/non-linear.cert \
-     rtl/rel8/arithmetic/inverted-factor.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/arithmetic/fp2.lisp
-
-
-rtl/rel8/arithmetic/ground-zero.cert : acl2x = 0
-rtl/rel8/arithmetic/ground-zero.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/ground-zero.cert : \
-     rtl/rel8/arithmetic/ground-zero.lisp
-
-
-rtl/rel8/arithmetic/hacks.cert : acl2x = 0
-rtl/rel8/arithmetic/hacks.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/hacks.cert : \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/hacks.lisp
-
-
-rtl/rel8/arithmetic/induct.cert : acl2x = 0
-rtl/rel8/arithmetic/induct.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/induct.cert : \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/induct.lisp
-
-
-rtl/rel8/arithmetic/integerp.cert : acl2x = 0
-rtl/rel8/arithmetic/integerp.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/integerp.cert : \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/integerp.lisp
-
-
-rtl/rel8/arithmetic/inverted-factor.cert : acl2x = 0
-rtl/rel8/arithmetic/inverted-factor.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/inverted-factor.cert : \
-     rtl/rel8/arithmetic/inverted-factor.lisp
-
-
-rtl/rel8/arithmetic/mod-expt.cert : acl2x = 0
-rtl/rel8/arithmetic/mod-expt.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/mod-expt.cert : \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/nniq.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/floor.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/rationalp.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/arithmetic/fl-expt.cert \
-     rtl/rel8/arithmetic/mod.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/mod-expt.lisp
-
-
-rtl/rel8/arithmetic/mod-proofs.cert : acl2x = 0
-rtl/rel8/arithmetic/mod-proofs.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/mod-proofs.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/floor.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/arith.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/product.cert \
-     rtl/rel8/arithmetic/complex-rationalp.cert \
-     meta/meta-plus-equal.cert \
-     meta/meta-plus-lessp.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/rationalp.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/mod-proofs.lisp
-
-
-rtl/rel8/arithmetic/mod.cert : acl2x = 0
-rtl/rel8/arithmetic/mod.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/mod.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/mod-proofs.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/mod.lisp
-
-
-rtl/rel8/arithmetic/negative-syntaxp.cert : acl2x = 0
-rtl/rel8/arithmetic/negative-syntaxp.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/negative-syntaxp.cert : \
-     rtl/rel8/arithmetic/negative-syntaxp.lisp
-
-
-rtl/rel8/arithmetic/nniq.cert : acl2x = 0
-rtl/rel8/arithmetic/nniq.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/nniq.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/product.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/arith.cert \
-     arithmetic/rationals.cert \
-     arithmetic/idiv.cert \
-     arithmetic/idiv.cert \
-     arithmetic/top-with-meta.cert \
-     rtl/rel8/arithmetic/nniq.lisp
-
-
-rtl/rel8/arithmetic/numerator.cert : acl2x = 0
-rtl/rel8/arithmetic/numerator.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/numerator.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/numerator.lisp
-
-
-rtl/rel8/arithmetic/power2p.cert : acl2x = 0
-rtl/rel8/arithmetic/power2p.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/power2p.cert : \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/arithmetic/power2p.lisp
-
-
-rtl/rel8/arithmetic/predicate.cert : acl2x = 0
-rtl/rel8/arithmetic/predicate.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/predicate.cert : \
-     rtl/rel8/arithmetic/predicate.lisp
-
-
-rtl/rel8/arithmetic/product-proofs.cert : acl2x = 0
-rtl/rel8/arithmetic/product-proofs.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/product-proofs.cert : \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/product-proofs.lisp
-
-
-rtl/rel8/arithmetic/product.cert : acl2x = 0
-rtl/rel8/arithmetic/product.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/product.cert : \
-     rtl/rel8/arithmetic/product-proofs.cert \
-     rtl/rel8/arithmetic/product.lisp
-
-
-rtl/rel8/arithmetic/rationalp.cert : acl2x = 0
-rtl/rel8/arithmetic/rationalp.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/rationalp.cert : \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/rationalp.lisp
-
-
-rtl/rel8/arithmetic/top.cert : acl2x = 0
-rtl/rel8/arithmetic/top.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/top.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/arithmetic/induct.cert \
-     rtl/rel8/arithmetic/denominator.cert \
-     rtl/rel8/arithmetic/numerator.cert \
-     rtl/rel8/arithmetic/nniq.cert \
-     rtl/rel8/arithmetic/complex-rationalp.cert \
-     rtl/rel8/arithmetic/rationalp.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/arith.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/arithmetic/unary-divide.cert \
-     rtl/rel8/arithmetic/product.cert \
-     rtl/rel8/arithmetic/inverted-factor.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/x-2xx.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/arithmetic/fl-hacks.cert \
-     rtl/rel8/arithmetic/even-odd2.cert \
-     rtl/rel8/arithmetic/even-odd.cert \
-     rtl/rel8/arithmetic/floor.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/cg.cert \
-     rtl/rel8/arithmetic/mod.cert \
-     rtl/rel8/arithmetic/fl-expt.cert \
-     rtl/rel8/arithmetic/mod-expt.cert \
-     rtl/rel8/arithmetic/common-factor.cert \
-     rtl/rel8/arithmetic/top.lisp
-
-
-rtl/rel8/arithmetic/unary-divide.cert : acl2x = 0
-rtl/rel8/arithmetic/unary-divide.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/unary-divide.cert : \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/inverted-factor.cert \
-     rtl/rel8/arithmetic/unary-divide.lisp
-
-
-rtl/rel8/arithmetic/x-2xx.cert : acl2x = 0
-rtl/rel8/arithmetic/x-2xx.cert : no_pcert = 0
-
-rtl/rel8/arithmetic/x-2xx.cert : \
-     arithmetic/top-with-meta.cert \
-     arithmetic/mod-gcd.cert \
-     rtl/rel8/arithmetic/x-2xx.lisp
-
-
-rtl/rel8/lib/add.cert : acl2x = 0
-rtl/rel8/lib/add.cert : no_pcert = 0
-
-rtl/rel8/lib/add.cert : \
-     rtl/rel8/lib/round.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/add.lisp
-
-
-rtl/rel8/lib/arith.cert : acl2x = 0
-rtl/rel8/lib/arith.cert : no_pcert = 0
-
-rtl/rel8/lib/arith.cert : \
-     rtl/rel8/support/top/top.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/lib/arith.lisp
-
-
-rtl/rel8/lib/basic.cert : acl2x = 0
-rtl/rel8/lib/basic.cert : no_pcert = 0
-
-rtl/rel8/lib/basic.cert : \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/basic.lisp
-
-
-rtl/rel8/lib/bits.cert : acl2x = 0
-rtl/rel8/lib/bits.cert : no_pcert = 0
-
-rtl/rel8/lib/bits.cert : \
-     rtl/rel8/lib/basic.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/bits.lisp
-
-
-rtl/rel8/lib/bvecp-helpers.cert : acl2x = 0
-rtl/rel8/lib/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel8/lib/bvecp-helpers.cert : \
-     rtl/rel8/lib/rtl.cert \
-     rtl/rel8/lib/rtlarr.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/bvecp-helpers.lisp
-
-
-rtl/rel8/lib/bvecp-raw-helpers.cert : acl2x = 0
-rtl/rel8/lib/bvecp-raw-helpers.cert : no_pcert = 0
-
-rtl/rel8/lib/bvecp-raw-helpers.cert : \
-     rtl/rel8/lib/rtl.cert \
-     rtl/rel8/lib/rtlarr.cert \
-     rtl/rel8/lib/bits.cert \
-     rtl/rel8/lib/float.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/bvecp-raw-helpers.lisp
-
-
-rtl/rel8/lib/clocks.cert : acl2x = 0
-rtl/rel8/lib/clocks.cert : no_pcert = 0
-
-rtl/rel8/lib/clocks.cert : \
-     rtl/rel8/support/support/clocks.cert \
-     rtl/rel8/lib/clocks.lisp
-
-
-rtl/rel8/lib/float.cert : acl2x = 0
-rtl/rel8/lib/float.cert : no_pcert = 0
-
-rtl/rel8/lib/float.cert : \
-     rtl/rel8/lib/log.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/float.lisp
-
-
-rtl/rel8/lib/log.cert : acl2x = 0
-rtl/rel8/lib/log.cert : no_pcert = 0
-
-rtl/rel8/lib/log.cert : \
-     rtl/rel8/lib/basic.cert \
-     rtl/rel8/lib/bits.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/log.lisp
-
-
-rtl/rel8/lib/logn.cert : acl2x = 0
-rtl/rel8/lib/logn.cert : no_pcert = 0
-
-rtl/rel8/lib/logn.cert : \
-     rtl/rel8/lib/bits.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/logn.lisp
-
-
-rtl/rel8/lib/logn2log.cert : acl2x = 0
-rtl/rel8/lib/logn2log.cert : no_pcert = 0
-
-rtl/rel8/lib/logn2log.cert : \
-     rtl/rel8/lib/log.cert \
-     rtl/rel8/lib/logn.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/logn2log.lisp
-
-
-rtl/rel8/lib/mult.cert : acl2x = 0
-rtl/rel8/lib/mult.cert : no_pcert = 0
-
-rtl/rel8/lib/mult.cert : \
-     rtl/rel8/lib/add.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/mult.lisp
-
-
-rtl/rel8/lib/openers.cert : acl2x = 0
-rtl/rel8/lib/openers.cert : no_pcert = 0
-
-rtl/rel8/lib/openers.cert : \
-     rtl/rel8/support/support/openers.cert \
-     rtl/rel8/lib/openers.lisp
-
-
-rtl/rel8/lib/package-defs.cert : acl2x = 0
-rtl/rel8/lib/package-defs.cert : no_pcert = 0
-
-rtl/rel8/lib/package-defs.cert : \
-     rtl/rel8/support/support/package-defs.cert \
-     rtl/rel8/lib/package-defs.lisp
-
-
-rtl/rel8/lib/reps.cert : acl2x = 0
-rtl/rel8/lib/reps.cert : no_pcert = 0
-
-rtl/rel8/lib/reps.cert : \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/log.cert \
-     rtl/rel8/lib/float.cert \
-     rtl/rel8/lib/reps.lisp
-
-
-rtl/rel8/lib/rom-helpers.cert : acl2x = 0
-rtl/rel8/lib/rom-helpers.cert : no_pcert = 0
-
-rtl/rel8/lib/rom-helpers.cert : \
-     rtl/rel8/support/support/rom-helpers.cert \
-     rtl/rel8/lib/rom-helpers.lisp
-
-
-rtl/rel8/lib/round.cert : acl2x = 0
-rtl/rel8/lib/round.cert : no_pcert = 0
-
-rtl/rel8/lib/round.cert : \
-     rtl/rel8/lib/float.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/round.lisp
-
-
-rtl/rel8/lib/rtl.cert : acl2x = 0
-rtl/rel8/lib/rtl.cert : no_pcert = 0
-
-rtl/rel8/lib/rtl.cert : \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/rtl.lisp
-
-
-rtl/rel8/lib/rtlarr.cert : acl2x = 0
-rtl/rel8/lib/rtlarr.cert : no_pcert = 0
-
-rtl/rel8/lib/rtlarr.cert : \
-     rtl/rel8/support/top/top.cert \
-     misc/total-order.cert \
-     rtl/rel8/lib/rtl.cert \
-     rtl/rel8/lib/rtlarr.lisp
-
-
-rtl/rel8/lib/simple-loop-helpers.cert : acl2x = 0
-rtl/rel8/lib/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel8/lib/simple-loop-helpers.cert : \
-     rtl/rel8/lib/rtl.cert \
-     rtl/rel8/lib/rtlarr.cert \
-     rtl/rel8/lib/log.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/simple-loop-helpers.lisp
-
-
-rtl/rel8/lib/simplify-model-helpers.cert : acl2x = 0
-rtl/rel8/lib/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel8/lib/simplify-model-helpers.cert : \
-     rtl/rel8/lib/rtl.cert \
-     rtl/rel8/lib/arith.cert \
-     rtl/rel8/lib/bits.cert \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/simplify-model-helpers.lisp
-
-
-rtl/rel8/lib/top.cert : acl2x = 0
-rtl/rel8/lib/top.cert : no_pcert = 0
-
-rtl/rel8/lib/top.cert : \
-     rtl/rel8/lib/rtl.cert \
-     rtl/rel8/lib/rtlarr.cert \
-     rtl/rel8/lib/basic.cert \
-     rtl/rel8/lib/bits.cert \
-     rtl/rel8/lib/log.cert \
-     rtl/rel8/lib/float.cert \
-     rtl/rel8/lib/reps.cert \
-     rtl/rel8/lib/round.cert \
-     rtl/rel8/lib/add.cert \
-     rtl/rel8/lib/mult.cert \
-     rtl/rel8/lib/arith.cert \
-     rtl/rel8/lib/util.cert \
-     rtl/rel8/lib/top.lisp
-
-
-rtl/rel8/lib/util.cert : acl2x = 0
-rtl/rel8/lib/util.cert : no_pcert = 0
-
-rtl/rel8/lib/util.cert : \
-     rtl/rel8/support/top/top.cert \
-     rtl/rel8/lib/util.lisp
-
-
-rtl/rel8/support/lib1.delta1/arith-extra.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/arith-extra.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/arith-extra.cert : \
-     rtl/rel8/support/lib1/arith.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib1.delta1/arith-extra.lisp
-
-
-rtl/rel8/support/lib1.delta1/arith.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/arith.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/arith.cert : \
-     rtl/rel8/support/lib1/arith.cert \
-     rtl/rel8/support/lib1.delta1/arith-extra.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/support/lib1.delta1/arith.lisp
-
-
-rtl/rel8/support/lib1.delta1/basic-extra.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/basic-extra.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/basic-extra.cert : \
-     rtl/rel8/support/lib1/basic.cert \
-     rtl/rel8/arithmetic/floor.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib1.delta1/basic-extra.lisp
-
-
-rtl/rel8/support/lib1.delta1/basic.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/basic.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/basic.cert : \
-     rtl/rel8/support/lib1/basic.cert \
-     rtl/rel8/support/lib1.delta1/basic-extra.cert \
-     rtl/rel8/support/lib1.delta1/basic.lisp
-
-
-rtl/rel8/support/lib1.delta1/bits-extra.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/bits-extra.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/bits-extra.cert : \
-     rtl/rel8/support/lib1/top.cert \
-     rtl/rel8/support/lib1.delta1/bits-extra.lisp
-
-
-rtl/rel8/support/lib1.delta1/bits.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/bits.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/bits.cert : \
-     rtl/rel8/support/lib1/bits.cert \
-     rtl/rel8/support/lib1.delta1/bits-extra.cert \
-     rtl/rel8/support/lib1.delta1/bits.lisp
-
-
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/bits.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.lisp
-
-
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/lib1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.lisp
-
-
-rtl/rel8/support/lib1.delta1/float-extra2.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/float-extra2.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/float-extra2.cert : \
-     rtl/rel8/support/lib1/top.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/support/lib1.delta1/float-extra2.lisp
-
-
-rtl/rel8/support/lib1.delta1/float.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/float.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/float.cert : \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/lib1/float.cert \
-     rtl/rel8/support/lib1.delta1/float-extra2.cert \
-     rtl/rel8/support/lib1.delta1/float.lisp
-
-
-rtl/rel8/support/lib1.delta1/mult-proofs.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/mult-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/mult-proofs.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/sumbits.cert \
-     rtl/rel8/support/support/util.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/lior.cert \
-     rtl/rel8/support/support/land.cert \
-     rtl/rel8/support/support/lxor.cert \
-     rtl/rel8/support/lib1.delta1/mult-proofs.lisp \
-     rtl/rel8/support/lib1.delta1/mult-proofs.acl2
-
-
-rtl/rel8/support/lib1.delta1/mult.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/mult.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/mult.cert : \
-     rtl/rel8/support/lib1/add.cert \
-     rtl/rel8/support/lib1.delta1/mult-proofs.cert \
-     rtl/rel8/support/lib1.delta1/mult.lisp
-
-
-rtl/rel8/support/lib1.delta1/round-extra2.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/round-extra2.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/round-extra2.cert : \
-     rtl/rel8/support/lib1/top.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/arithmetic/even-odd.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/support/lib1.delta1/float-extra2.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/support/lib1.delta1/round-extra2.lisp
-
-
-rtl/rel8/support/lib1.delta1/round.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/round.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/round.cert : \
-     rtl/rel8/support/lib1.delta1/float.cert \
-     rtl/rel8/support/lib1/round.cert \
-     rtl/rel8/support/lib1.delta1/round-extra2.cert \
-     rtl/rel8/support/lib1.delta1/round.lisp
-
-
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/lib1/bits.cert \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.lisp
-
-
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.cert : acl2x = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/lib1.delta1/arith.cert \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/lib1/simple-loop-helpers.cert \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.cert \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers.lisp
-
-
-rtl/rel8/support/lib1.delta2/float-extra.cert : acl2x = 0
-rtl/rel8/support/lib1.delta2/float-extra.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta2/float-extra.cert : \
-     rtl/rel8/support/lib1/top.cert \
-     rtl/rel8/support/lib1.delta2/float-extra.lisp
-
-
-rtl/rel8/support/lib1.delta2/float.cert : acl2x = 0
-rtl/rel8/support/lib1.delta2/float.cert : no_pcert = 0
-
-rtl/rel8/support/lib1.delta2/float.cert : \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/lib1.delta1/float.cert \
-     rtl/rel8/support/lib1.delta2/float-extra.cert \
-     rtl/rel8/support/lib1.delta2/float.lisp
-
-
-rtl/rel8/support/lib1/add.cert : acl2x = 0
-rtl/rel8/support/lib1/add.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/add.cert : \
-     rtl/rel8/support/lib1/round.cert \
-     rtl/rel8/support/support/top.cert \
-     rtl/rel8/support/lib1/add.lisp
-
-
-rtl/rel8/support/lib1/arith.cert : acl2x = 0
-rtl/rel8/support/lib1/arith.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/arith.cert : \
-     rtl/rel8/arithmetic/fp.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/arithmetic/extra-rules.cert \
-     rtl/rel8/support/support/ash.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/support/lib1/arith.lisp
-
-
-rtl/rel8/support/lib1/basic.cert : acl2x = 0
-rtl/rel8/support/lib1/basic.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/basic.cert : \
-     rtl/rel8/support/support/top.cert \
-     rtl/rel8/support/lib1/basic.lisp
-
-
-rtl/rel8/support/lib1/bits.cert : acl2x = 0
-rtl/rel8/support/lib1/bits.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/bits.cert : \
-     rtl/rel8/support/lib1/basic.cert \
-     rtl/rel8/support/support/top.cert \
-     rtl/rel8/support/lib1/bits.lisp
-
-
-rtl/rel8/support/lib1/bvecp-helpers.cert : acl2x = 0
-rtl/rel8/support/lib1/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/bvecp-helpers.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/support/bvecp-helpers.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/support/lib1/bvecp-helpers.lisp
-
-
-rtl/rel8/support/lib1/bvecp-raw-helpers.cert : acl2x = 0
-rtl/rel8/support/lib1/bvecp-raw-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/bvecp-raw-helpers.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/support/bvecp-helpers.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/setbits.cert \
-     rtl/rel8/support/support/setbitn.cert \
-     rtl/rel8/support/support/logs.cert \
-     rtl/rel8/support/support/lnot.cert \
-     rtl/rel8/support/support/shft.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/mulcat.cert \
-     rtl/rel8/support/support/encode.cert \
-     rtl/rel8/support/support/decode.cert \
-     rtl/rel8/support/support/land.cert \
-     rtl/rel8/support/support/lior.cert \
-     rtl/rel8/support/support/lxor.cert \
-     rtl/rel8/support/support/guards.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/support/lib1/bvecp-raw-helpers.lisp
-
-
-rtl/rel8/support/lib1/clocks.cert : acl2x = 0
-rtl/rel8/support/lib1/clocks.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/clocks.cert : \
-     rtl/rel8/support/support/clocks.cert \
-     rtl/rel8/support/lib1/clocks.lisp
-
-
-rtl/rel8/support/lib1/float.cert : acl2x = 0
-rtl/rel8/support/lib1/float.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/float.cert : \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/support/top.cert \
-     rtl/rel8/support/lib1/float.lisp
-
-
-rtl/rel8/support/lib1/log.cert : acl2x = 0
-rtl/rel8/support/lib1/log.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/log.cert : \
-     rtl/rel8/support/lib1/bits.cert \
-     rtl/rel8/support/support/top.cert \
-     rtl/rel8/support/lib1/log.lisp
-
-
-rtl/rel8/support/lib1/openers.cert : acl2x = 0
-rtl/rel8/support/lib1/openers.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/openers.cert : \
-     rtl/rel8/support/support/openers.cert \
-     rtl/rel8/support/lib1/openers.lisp
-
-
-rtl/rel8/support/lib1/package-defs.cert : acl2x = 0
-rtl/rel8/support/lib1/package-defs.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/package-defs.cert : \
-     rtl/rel8/support/support/package-defs.cert \
-     rtl/rel8/support/lib1/package-defs.lisp
-
-
-rtl/rel8/support/lib1/reps.cert : acl2x = 0
-rtl/rel8/support/lib1/reps.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/reps.cert : \
-     rtl/rel8/support/support/ereps.cert \
-     rtl/rel8/support/support/ireps.cert \
-     rtl/rel8/support/support/guards.cert \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/lib1/float.cert \
-     rtl/rel8/support/lib1/reps.lisp
-
-
-rtl/rel8/support/lib1/rom-helpers.cert : acl2x = 0
-rtl/rel8/support/lib1/rom-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/rom-helpers.cert : \
-     rtl/rel8/support/support/rom-helpers.cert \
-     rtl/rel8/support/lib1/rom-helpers.lisp
-
-
-rtl/rel8/support/lib1/round.cert : acl2x = 0
-rtl/rel8/support/lib1/round.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/round.cert : \
-     rtl/rel8/support/support/top.cert \
-     rtl/rel8/support/lib1/reps.cert \
-     rtl/rel8/support/lib1/round.lisp
-
-
-rtl/rel8/support/lib1/rtl.cert : acl2x = 0
-rtl/rel8/support/lib1/rtl.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/rtl.cert : \
-     rtl/rel8/support/support/top.cert \
-     rtl/rel8/support/lib1/rtl.lisp
-
-
-rtl/rel8/support/lib1/rtlarr.cert : acl2x = 0
-rtl/rel8/support/lib1/rtlarr.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/rtlarr.cert : \
-     rtl/rel8/support/support/rtlarr.cert \
-     rtl/rel8/support/support/bvecp-helpers.cert \
-     rtl/rel8/support/support/guards.cert \
-     misc/total-order.cert \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.lisp
-
-
-rtl/rel8/support/lib1/simple-loop-helpers.cert : acl2x = 0
-rtl/rel8/support/lib1/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/simple-loop-helpers.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/lib1/arith.cert \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/support/simple-loop-helpers.cert \
-     rtl/rel8/support/lib1/simple-loop-helpers.lisp
-
-
-rtl/rel8/support/lib1/simplify-model-helpers.cert : acl2x = 0
-rtl/rel8/support/lib1/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/simplify-model-helpers.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/arith.cert \
-     rtl/rel8/support/lib1/bits.cert \
-     rtl/rel8/support/support/simplify-model-helpers.cert \
-     rtl/rel8/support/lib1/simplify-model-helpers.lisp
-
-
-rtl/rel8/support/lib1/top.cert : acl2x = 0
-rtl/rel8/support/lib1/top.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/top.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/lib1/basic.cert \
-     rtl/rel8/support/lib1/bits.cert \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/lib1/float.cert \
-     rtl/rel8/support/lib1/reps.cert \
-     rtl/rel8/support/lib1/round.cert \
-     rtl/rel8/support/lib1/add.cert \
-     rtl/rel8/support/lib1/arith.cert \
-     rtl/rel8/support/lib1/util.cert \
-     rtl/rel8/support/lib1/top.lisp
-
-
-rtl/rel8/support/lib1/util.cert : acl2x = 0
-rtl/rel8/support/lib1/util.cert : no_pcert = 0
-
-rtl/rel8/support/lib1/util.cert : \
-     rtl/rel8/support/support/util.cert \
-     rtl/rel8/support/lib1/util.lisp
-
-
-rtl/rel8/support/lib2.delta1/add-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/add-new-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/round-new.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/add-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/add-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/add-new.cert : \
-     rtl/rel8/support/lib2.delta1/round-new.cert \
-     rtl/rel8/support/lib2.delta1/add-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/add-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/add-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/add-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/round.cert \
-     rtl/rel8/support/lib2.delta1/add-new.cert \
-     rtl/rel8/support/lib2.delta1/add-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/add.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/add.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/add.cert : \
-     rtl/rel8/support/lib2.delta1/round.cert \
-     rtl/rel8/support/lib2.delta1/add-proofs.cert \
-     rtl/rel8/support/lib2.delta1/add.lisp
-
-
-rtl/rel8/support/lib2.delta1/arith.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/arith.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/arith.cert : \
-     rtl/rel8/support/lib2/top.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/support/lib2.delta1/arith.lisp
-
-
-rtl/rel8/support/lib2.delta1/bits-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/bits-new-proofs.cert : \
-     rtl/rel8/support/lib2/bits.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/log.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/badguys.cert \
-     rtl/rel8/support/lib2/bits.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/bits-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/bits-new.cert : \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/bits-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/bits-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/bits-proofs.cert : \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/bits-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/bits.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/bits.cert : \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2.delta1/bits-proofs.cert \
-     rtl/rel8/support/lib2.delta1/bits.lisp
-
-
-rtl/rel8/support/lib2.delta1/bvecp-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/bvecp-helpers.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-helpers.lisp
-
-
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/logn.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/encode.cert \
-     rtl/rel8/support/support/decode.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.lisp
-
-
-rtl/rel8/support/lib2.delta1/float-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/float-new-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/float-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/float-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/float-new.cert : \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/float-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/float-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/float-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/float-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/float-new.cert \
-     rtl/rel8/support/lib2.delta1/float-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/float.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/float.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/float.cert : \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/float-proofs.cert \
-     rtl/rel8/support/lib2.delta1/float.lisp
-
-
-rtl/rel8/support/lib2.delta1/log-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/log-new-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/logxor.cert \
-     rtl/rel8/support/support/log.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/log-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/log-new.cert : \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/log-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/log-proofs.cert : \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/log-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/log-support-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-support-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/log-support-proofs.cert : \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/log-support-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/log-support.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-support.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/log-support.cert : \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/log-support-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-support.lisp
-
-
-rtl/rel8/support/lib2.delta1/log.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/log.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/log.cert : \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/log-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log.lisp
-
-
-rtl/rel8/support/lib2.delta1/logn-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/logn-new-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/support/lib2.delta1/rtl-new.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/logn-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/logn-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/logn-new.cert : \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/support/lib2.delta1/rtl-new.cert \
-     rtl/rel8/support/lib2.delta1/logn-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/logn-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/logn-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/logn-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/logn-new.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/logn-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/logn.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/logn.cert : \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/logn-proofs.cert \
-     rtl/rel8/support/lib2.delta1/logn.lisp
-
-
-rtl/rel8/support/lib2.delta1/logn2log-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn2log-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/logn2log-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/logn.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib2.delta1/logn2log-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/logn2log.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn2log.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/logn2log.cert : \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/logn.cert \
-     rtl/rel8/support/lib2.delta1/logn2log-proofs.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/logn2log.lisp
-
-
-rtl/rel8/support/lib2.delta1/mult-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/mult-new-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/add-new.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/log-support.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/mult-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/mult-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/mult-new.cert : \
-     rtl/rel8/support/lib2.delta1/add-new.cert \
-     rtl/rel8/support/lib2.delta1/mult-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/mult-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/mult-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/mult-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/add.cert \
-     rtl/rel8/support/lib2.delta1/mult-new.cert \
-     rtl/rel8/support/lib2.delta1/mult-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/mult.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/mult.cert : \
-     rtl/rel8/support/lib2.delta1/add.cert \
-     rtl/rel8/support/lib2.delta1/mult-proofs.cert \
-     rtl/rel8/support/lib2.delta1/mult.lisp
-
-
-rtl/rel8/support/lib2.delta1/reps-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/reps-new-proofs.cert : \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/float-new.cert \
-     rtl/rel8/support/lib2.delta1/log-support.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/reps-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/reps-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/reps-new.cert : \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2.delta1/float-new.cert \
-     rtl/rel8/support/lib2.delta1/reps-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/reps-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/reps-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/reps-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/reps-new.cert \
-     rtl/rel8/support/lib2.delta1/reps-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/reps.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/reps.cert : \
-     rtl/rel8/support/lib2.delta1/reps-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/reps.lisp
-
-
-rtl/rel8/support/lib2.delta1/round-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/round-new-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/float-new.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/support/land.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/round-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/round-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/round-new.cert : \
-     rtl/rel8/support/lib2.delta1/float-new.cert \
-     rtl/rel8/support/lib2.delta1/round-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/round-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/round-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/round-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/round-new.cert \
-     rtl/rel8/support/lib2.delta1/round-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/round.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/round.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/round.cert : \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/round-proofs.cert \
-     rtl/rel8/support/lib2.delta1/round.lisp
-
-
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/lib2.delta1/rtl-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/rtl-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/rtl-new.cert : \
-     rtl/rel8/support/lib2.delta1/rtl-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/rtl-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/rtl-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/rtl-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/rtl-new.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/support/lib2.delta1/log-new.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/rtl-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/rtl.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/rtl.cert : \
-     rtl/rel8/support/lib2.delta1/rtl-proofs.cert \
-     rtl/rel8/support/lib2.delta1/rtl.lisp
-
-
-rtl/rel8/support/lib2.delta1/rtlarr-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtlarr-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/rtlarr-new.cert : \
-     rtl/rel8/support/lib2/top.cert \
-     misc/total-order.cert \
-     rtl/rel8/support/lib2.delta1/rtl-new.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/rtlarr.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtlarr.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/rtlarr.cert : \
-     rtl/rel8/support/lib2.delta1/rtlarr-new.cert \
-     misc/total-order.cert \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.lisp
-
-
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2.delta1/logn.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.cert \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers.lisp
-
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/support/lib2.delta1/logn-new.cert \
-     rtl/rel8/support/lib2.delta1/arith.cert \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.cert \
-     rtl/rel8/support/lib2/simplify-model-helpers.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.cert : \
-     rtl/rel8/support/lib2.delta1/bits-new.cert \
-     rtl/rel8/support/lib2.delta1/logn-new.cert \
-     rtl/rel8/support/lib2.delta1/arith.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.lisp
-
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/logn.cert \
-     rtl/rel8/support/lib2.delta1/arith.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.lisp
-
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/arith.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers.lisp
-
-
-rtl/rel8/support/lib2.delta1/top.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/top.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/top.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/reps.cert \
-     rtl/rel8/support/lib2.delta1/round.cert \
-     rtl/rel8/support/lib2.delta1/add.cert \
-     rtl/rel8/support/lib2.delta1/mult.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert \
-     rtl/rel8/support/lib2.delta1/arith.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-helpers.cert \
-     rtl/rel8/support/lib2.delta1/logn.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert \
-     rtl/rel8/support/lib2.delta1/top.lisp
-
-
-rtl/rel8/support/lib2.delta1/util.cert : acl2x = 0
-rtl/rel8/support/lib2.delta1/util.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta1/util.cert : \
-     rtl/rel8/support/lib2/top.cert \
-     rtl/rel8/support/lib2.delta1/util.lisp
-
-
-rtl/rel8/support/lib2.delta2/add-lib.cert : acl2x = 0
-rtl/rel8/support/lib2.delta2/add-lib.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta2/add-lib.cert : \
-     rtl/rel8/support/lib2.delta2/base.cert \
-     rtl/rel8/support/lib2.delta1/arith.cert \
-     rtl/rel8/support/lib2.delta2/add-lib.lisp
-
-
-rtl/rel8/support/lib2.delta2/add.cert : acl2x = 0
-rtl/rel8/support/lib2.delta2/add.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta2/add.cert : \
-     rtl/rel8/support/lib2.delta2/base.cert \
-     rtl/rel8/support/lib2.delta2/add-lib.cert \
-     rtl/rel8/support/lib2.delta2/add.lisp
-
-
-rtl/rel8/support/lib2.delta2/base.cert : acl2x = 0
-rtl/rel8/support/lib2.delta2/base.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta2/base.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2.delta1/bits.cert \
-     rtl/rel8/support/lib2.delta1/log.cert \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/reps.cert \
-     rtl/rel8/support/lib2.delta1/round.cert \
-     rtl/rel8/support/lib2.delta1/add.cert \
-     rtl/rel8/support/lib2.delta1/mult.cert \
-     rtl/rel8/support/lib2.delta1/util.cert \
-     rtl/rel8/support/lib2.delta2/base.lisp
-
-
-rtl/rel8/support/lib2.delta2/bits.cert : acl2x = 0
-rtl/rel8/support/lib2.delta2/bits.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta2/bits.cert : \
-     rtl/rel8/support/lib2.delta2/base.cert \
-     rtl/rel8/support/lib2.delta2/add-lib.cert \
-     rtl/rel8/support/lib2.delta2/bits.lisp
-
-
-rtl/rel8/support/lib2.delta2/log.cert : acl2x = 0
-rtl/rel8/support/lib2.delta2/log.cert : no_pcert = 0
-
-rtl/rel8/support/lib2.delta2/log.cert : \
-     rtl/rel8/support/lib2.delta2/base.cert \
-     rtl/rel8/support/lib2.delta2/add-lib.cert \
-     rtl/rel8/support/lib2.delta2/log.lisp
-
-
-rtl/rel8/support/lib2/add.cert : acl2x = 0
-rtl/rel8/support/lib2/add.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/add.cert : \
-     rtl/rel8/support/lib2/round.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/add.lisp
-
-
-rtl/rel8/support/lib2/arith.cert : acl2x = 0
-rtl/rel8/support/lib2/arith.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/arith.cert : \
-     rtl/rel8/support/lib2/base.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/support/lib2/arith.lisp
-
-
-rtl/rel8/support/lib2/base.cert : acl2x = 0
-rtl/rel8/support/lib2/base.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/base.cert : \
-     rtl/rel8/support/lib1/rtl.cert \
-     rtl/rel8/support/lib1/rtlarr.cert \
-     rtl/rel8/support/lib1.delta1/basic.cert \
-     rtl/rel8/support/lib1.delta1/bits.cert \
-     rtl/rel8/support/lib1/log.cert \
-     rtl/rel8/support/lib1.delta2/float.cert \
-     rtl/rel8/support/lib1/reps.cert \
-     rtl/rel8/support/lib1.delta1/round.cert \
-     rtl/rel8/support/lib1/add.cert \
-     rtl/rel8/support/lib1.delta1/mult.cert \
-     rtl/rel8/support/lib1.delta1/arith.cert \
-     rtl/rel8/support/lib1/util.cert \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers.cert \
-     rtl/rel8/support/lib2/base.lisp
-
-
-rtl/rel8/support/lib2/basic.cert : acl2x = 0
-rtl/rel8/support/lib2/basic.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/basic.cert : \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/basic.lisp
-
-
-rtl/rel8/support/lib2/bits.cert : acl2x = 0
-rtl/rel8/support/lib2/bits.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/bits.cert : \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/bits.lisp
-
-
-rtl/rel8/support/lib2/bvecp-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/bvecp-helpers.cert : \
-     rtl/rel8/support/lib2/rtl.cert \
-     rtl/rel8/support/lib2/rtlarr.cert \
-     rtl/rel8/support/support/bvecp-helpers.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/support/lib2/bvecp-helpers.lisp
-
-
-rtl/rel8/support/lib2/bvecp-raw-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2/bvecp-raw-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/bvecp-raw-helpers.cert : \
-     rtl/rel8/support/lib2/rtl.cert \
-     rtl/rel8/support/lib2/rtlarr.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/bvecp-raw-helpers.lisp
-
-
-rtl/rel8/support/lib2/clocks.cert : acl2x = 0
-rtl/rel8/support/lib2/clocks.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/clocks.cert : \
-     rtl/rel8/support/support/clocks.cert \
-     rtl/rel8/support/lib2/clocks.lisp
-
-
-rtl/rel8/support/lib2/float.cert : acl2x = 0
-rtl/rel8/support/lib2/float.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/float.cert : \
-     rtl/rel8/support/lib2/log.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/float.lisp
-
-
-rtl/rel8/support/lib2/log.cert : acl2x = 0
-rtl/rel8/support/lib2/log.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/log.cert : \
-     rtl/rel8/support/lib2/bits.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/log.lisp
-
-
-rtl/rel8/support/lib2/mult.cert : acl2x = 0
-rtl/rel8/support/lib2/mult.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/mult.cert : \
-     rtl/rel8/support/lib2/add.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/mult.lisp
-
-
-rtl/rel8/support/lib2/openers.cert : acl2x = 0
-rtl/rel8/support/lib2/openers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/openers.cert : \
-     rtl/rel8/support/support/openers.cert \
-     rtl/rel8/support/lib2/openers.lisp
-
-
-rtl/rel8/support/lib2/package-defs.cert : acl2x = 0
-rtl/rel8/support/lib2/package-defs.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/package-defs.cert : \
-     rtl/rel8/support/support/package-defs.cert \
-     rtl/rel8/support/lib2/package-defs.lisp
-
-
-rtl/rel8/support/lib2/reps.cert : acl2x = 0
-rtl/rel8/support/lib2/reps.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/reps.cert : \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/log.cert \
-     rtl/rel8/support/lib2/float.cert \
-     rtl/rel8/support/lib2/reps.lisp
-
-
-rtl/rel8/support/lib2/rom-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2/rom-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/rom-helpers.cert : \
-     rtl/rel8/support/support/rom-helpers.cert \
-     rtl/rel8/support/lib2/rom-helpers.lisp
-
-
-rtl/rel8/support/lib2/round.cert : acl2x = 0
-rtl/rel8/support/lib2/round.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/round.cert : \
-     rtl/rel8/support/lib2/float.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/round.lisp
-
-
-rtl/rel8/support/lib2/rtl.cert : acl2x = 0
-rtl/rel8/support/lib2/rtl.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/rtl.cert : \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/rtl.lisp
-
-
-rtl/rel8/support/lib2/rtlarr.cert : acl2x = 0
-rtl/rel8/support/lib2/rtlarr.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/rtlarr.cert : \
-     rtl/rel8/support/lib2/base.cert \
-     misc/total-order.cert \
-     rtl/rel8/support/lib2/rtl.cert \
-     rtl/rel8/support/lib2/rtlarr.lisp
-
-
-rtl/rel8/support/lib2/simple-loop-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/simple-loop-helpers.cert : \
-     rtl/rel8/support/lib2/rtl.cert \
-     rtl/rel8/support/lib2/rtlarr.cert \
-     rtl/rel8/support/lib2/arith.cert \
-     rtl/rel8/support/lib2/log.cert \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/simple-loop-helpers.lisp
-
-
-rtl/rel8/support/lib2/simplify-model-helpers.cert : acl2x = 0
-rtl/rel8/support/lib2/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/simplify-model-helpers.cert : \
-     rtl/rel8/support/lib2/rtl.cert \
-     rtl/rel8/support/lib2/arith.cert \
-     rtl/rel8/support/lib2/bits.cert \
-     rtl/rel8/support/support/simplify-model-helpers.cert \
-     rtl/rel8/support/lib2/simplify-model-helpers.lisp
-
-
-rtl/rel8/support/lib2/top.cert : acl2x = 0
-rtl/rel8/support/lib2/top.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/top.cert : \
-     rtl/rel8/support/lib2/rtl.cert \
-     rtl/rel8/support/lib2/rtlarr.cert \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2/bits.cert \
-     rtl/rel8/support/lib2/log.cert \
-     rtl/rel8/support/lib2/float.cert \
-     rtl/rel8/support/lib2/reps.cert \
-     rtl/rel8/support/lib2/round.cert \
-     rtl/rel8/support/lib2/add.cert \
-     rtl/rel8/support/lib2/mult.cert \
-     rtl/rel8/support/lib2/arith.cert \
-     rtl/rel8/support/lib2/util.cert \
-     rtl/rel8/support/lib2/top.lisp
-
-
-rtl/rel8/support/lib2/util.cert : acl2x = 0
-rtl/rel8/support/lib2/util.cert : no_pcert = 0
-
-rtl/rel8/support/lib2/util.cert : \
-     rtl/rel8/support/lib2/base.cert \
-     rtl/rel8/support/lib2/util.lisp
-
-
-rtl/rel8/support/support/add3-proofs.cert : acl2x = 0
-rtl/rel8/support/support/add3-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/add3-proofs.cert : \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/arithmetic/top.cert \
-     ordinals/e0-ordinal.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/add3-proofs.lisp
-
-
-rtl/rel8/support/support/add3.cert : acl2x = 0
-rtl/rel8/support/support/add3.cert : no_pcert = 0
-
-rtl/rel8/support/support/add3.cert : \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/add3-proofs.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/add3.lisp
-
-
-rtl/rel8/support/support/all-ones.cert : acl2x = 0
-rtl/rel8/support/support/all-ones.cert : no_pcert = 0
-
-rtl/rel8/support/support/all-ones.cert : \
-     rtl/rel8/support/support/all-ones.lisp
-
-
-rtl/rel8/support/support/ash.cert : acl2x = 0
-rtl/rel8/support/support/ash.cert : no_pcert = 0
-
-rtl/rel8/support/support/ash.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/support/support/ash.lisp
-
-
-rtl/rel8/support/support/away-proofs.cert : acl2x = 0
-rtl/rel8/support/support/away-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/away-proofs.cert : \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/away-proofs.lisp
-
-
-rtl/rel8/support/support/away.cert : acl2x = 0
-rtl/rel8/support/support/away.cert : no_pcert = 0
-
-rtl/rel8/support/support/away.cert : \
-     rtl/rel8/support/support/away-proofs.cert \
-     rtl/rel8/support/support/away.lisp
-
-
-rtl/rel8/support/support/badguys.cert : acl2x = 0
-rtl/rel8/support/support/badguys.cert : no_pcert = 0
-
-rtl/rel8/support/support/badguys.cert : \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/badguys.lisp
-
-
-rtl/rel8/support/support/bias-proofs.cert : acl2x = 0
-rtl/rel8/support/support/bias-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/bias-proofs.cert : \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/support/support/bias-proofs.lisp
-
-
-rtl/rel8/support/support/bias.cert : acl2x = 0
-rtl/rel8/support/support/bias.cert : no_pcert = 0
-
-rtl/rel8/support/support/bias.cert : \
-     rtl/rel8/support/support/bias-proofs.cert \
-     rtl/rel8/support/support/bias.lisp
-
-
-rtl/rel8/support/support/bitn-proofs.cert : acl2x = 0
-rtl/rel8/support/support/bitn-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/bitn-proofs.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/bitn-proofs.lisp
-
-
-rtl/rel8/support/support/bitn.cert : acl2x = 0
-rtl/rel8/support/support/bitn.cert : no_pcert = 0
-
-rtl/rel8/support/support/bitn.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/support/support/bitn-proofs.cert \
-     rtl/rel8/support/support/bitn.lisp
-
-
-rtl/rel8/support/support/bits-proofs.cert : acl2x = 0
-rtl/rel8/support/support/bits-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/bits-proofs.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/bits-proofs.lisp
-
-
-rtl/rel8/support/support/bits-trunc-proofs.cert : acl2x = 0
-rtl/rel8/support/support/bits-trunc-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/bits-trunc-proofs.cert : \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/log.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bits-trunc-proofs.lisp
-
-
-rtl/rel8/support/support/bits-trunc.cert : acl2x = 0
-rtl/rel8/support/support/bits-trunc.cert : no_pcert = 0
-
-rtl/rel8/support/support/bits-trunc.cert : \
-     rtl/rel8/support/support/log.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/bits-trunc-proofs.cert \
-     rtl/rel8/support/support/bits-trunc.lisp
-
-
-rtl/rel8/support/support/bits.cert : acl2x = 0
-rtl/rel8/support/support/bits.cert : no_pcert = 0
-
-rtl/rel8/support/support/bits.cert : \
-     rtl/rel8/support/support/bits-proofs.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/support/support/bits.lisp
-
-
-rtl/rel8/support/support/bvecp-helpers.cert : acl2x = 0
-rtl/rel8/support/support/bvecp-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/support/bvecp-helpers.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/bvecp-lemmas.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bvecp-helpers.lisp
-
-
-rtl/rel8/support/support/bvecp-lemmas.cert : acl2x = 0
-rtl/rel8/support/support/bvecp-lemmas.cert : no_pcert = 0
-
-rtl/rel8/support/support/bvecp-lemmas.cert : \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/setbits.cert \
-     rtl/rel8/support/support/setbitn.cert \
-     rtl/rel8/support/support/encode.cert \
-     rtl/rel8/support/support/decode.cert \
-     rtl/rel8/support/support/logs.cert \
-     rtl/rel8/support/support/lnot.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/shft.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/mulcat.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/bvecp-lemmas.lisp
-
-
-rtl/rel8/support/support/bvecp-proofs.cert : acl2x = 0
-rtl/rel8/support/support/bvecp-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/bvecp-proofs.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bvecp-proofs.lisp
-
-
-rtl/rel8/support/support/bvecp.cert : acl2x = 0
-rtl/rel8/support/support/bvecp.cert : no_pcert = 0
-
-rtl/rel8/support/support/bvecp.cert : \
-     rtl/rel8/support/support/bvecp-proofs.cert \
-     rtl/rel8/support/support/bvecp.lisp
-
-
-rtl/rel8/support/support/cat-def.cert : acl2x = 0
-rtl/rel8/support/support/cat-def.cert : no_pcert = 0
-
-rtl/rel8/support/support/cat-def.cert : \
-     rtl/rel8/support/support/cat-def.lisp
-
-
-rtl/rel8/support/support/cat-proofs.cert : acl2x = 0
-rtl/rel8/support/support/cat-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/cat-proofs.cert : \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/cat-proofs.lisp
-
-
-rtl/rel8/support/support/cat.cert : acl2x = 0
-rtl/rel8/support/support/cat.cert : no_pcert = 0
-
-rtl/rel8/support/support/cat.cert : \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/cat-proofs.cert \
-     rtl/rel8/support/support/cat.lisp
-
-
-rtl/rel8/support/support/clocks.cert : acl2x = 0
-rtl/rel8/support/support/clocks.cert : no_pcert = 0
-
-rtl/rel8/support/support/clocks.cert : \
-     rtl/rel8/support/support/mod4.cert \
-     rtl/rel8/arithmetic/even-odd2.cert \
-     rtl/rel8/support/support/clocks.lisp
-
-
-rtl/rel8/support/support/decode-proofs.cert : acl2x = 0
-rtl/rel8/support/support/decode-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/decode-proofs.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/support/support/ash.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/decode-proofs.lisp
-
-
-rtl/rel8/support/support/decode.cert : acl2x = 0
-rtl/rel8/support/support/decode.cert : no_pcert = 0
-
-rtl/rel8/support/support/decode.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/decode-proofs.cert \
-     rtl/rel8/support/support/decode.lisp
-
-
-rtl/rel8/support/support/drnd-original.cert : acl2x = 0
-rtl/rel8/support/support/drnd-original.cert : no_pcert = 0
-
-rtl/rel8/support/support/drnd-original.cert : \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/ireps.cert \
-     rtl/rel8/support/support/rnd.cert \
-     rtl/rel8/support/support/bias.cert \
-     rtl/rel8/support/support/sgn.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/support/support/near.cert \
-     rtl/rel8/support/support/near+.cert \
-     rtl/rel8/support/support/sticky.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/drnd-original.lisp
-
-
-rtl/rel8/support/support/encode.cert : acl2x = 0
-rtl/rel8/support/support/encode.cert : no_pcert = 0
-
-rtl/rel8/support/support/encode.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/ash.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/encode.lisp
-
-
-rtl/rel8/support/support/ereps-proofs.cert : acl2x = 0
-rtl/rel8/support/support/ereps-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/ereps-proofs.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/bias.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/mulcat.cert \
-     rtl/rel8/support/support/ereps-proofs.lisp
-
-
-rtl/rel8/support/support/ereps.cert : acl2x = 0
-rtl/rel8/support/support/ereps.cert : no_pcert = 0
-
-rtl/rel8/support/support/ereps.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/ereps-proofs.cert \
-     rtl/rel8/support/support/ereps.lisp
-
-
-rtl/rel8/support/support/fadd-extra.cert : acl2x = 0
-rtl/rel8/support/support/fadd-extra.cert : no_pcert = 0
-
-rtl/rel8/support/support/fadd-extra.cert : \
-     rtl/rel8/support/support/fadd-extra0.cert \
-     rtl/rel8/support/support/land.cert \
-     rtl/rel8/support/support/lior.cert \
-     rtl/rel8/support/support/lxor.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/fadd-extra.lisp
-
-
-rtl/rel8/support/support/fadd-extra0.cert : acl2x = 0
-rtl/rel8/support/support/fadd-extra0.cert : no_pcert = 0
-
-rtl/rel8/support/support/fadd-extra0.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/fadd.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/fadd-extra0.lisp
-
-
-rtl/rel8/support/support/fadd.cert : acl2x = 0
-rtl/rel8/support/support/fadd.cert : no_pcert = 0
-
-rtl/rel8/support/support/fadd.cert : \
-     rtl/rel8/support/support/stick.cert \
-     rtl/rel8/support/support/lop3.cert \
-     rtl/rel8/support/support/add3.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/lextra0.cert \
-     rtl/rel8/support/support/fadd.lisp
-
-
-rtl/rel8/support/support/fast-and.cert : acl2x = 0
-rtl/rel8/support/support/fast-and.cert : no_pcert = 0
-
-rtl/rel8/support/support/fast-and.cert : \
-     rtl/rel8/support/support/fast-and.lisp
-
-
-rtl/rel8/support/support/float-extra.cert : acl2x = 0
-rtl/rel8/support/support/float-extra.cert : no_pcert = 0
-
-rtl/rel8/support/support/float-extra.cert : \
-     arithmetic/inequalities.cert \
-     rtl/rel8/support/support/sticky.cert \
-     rtl/rel8/support/support/util.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/float-extra.lisp
-
-
-rtl/rel8/support/support/float.cert : acl2x = 0
-rtl/rel8/support/support/float.cert : no_pcert = 0
-
-rtl/rel8/support/support/float.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/negative-syntaxp.cert \
-     rtl/rel8/arithmetic/basic.cert \
-     rtl/rel8/arithmetic/power2p.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/cg.cert \
-     rtl/rel8/support/support/float.lisp
-
-
-rtl/rel8/support/support/ground-zero.cert : acl2x = 0
-rtl/rel8/support/support/ground-zero.cert : no_pcert = 0
-
-rtl/rel8/support/support/ground-zero.cert : \
-     rtl/rel8/arithmetic/ground-zero.cert \
-     rtl/rel8/support/support/util.cert \
-     rtl/rel8/support/support/ground-zero.lisp
-
-
-rtl/rel8/support/support/guards.cert : acl2x = 0
-rtl/rel8/support/support/guards.cert : no_pcert = 0
-
-rtl/rel8/support/support/guards.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/land.cert \
-     rtl/rel8/support/support/lior.cert \
-     rtl/rel8/support/support/lxor.cert \
-     rtl/rel8/support/support/guards.lisp
-
-
-rtl/rel8/support/support/ireps.cert : acl2x = 0
-rtl/rel8/support/support/ireps.cert : no_pcert = 0
-
-rtl/rel8/support/support/ireps.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/bias.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/ireps.lisp
-
-
-rtl/rel8/support/support/land.cert : acl2x = 0
-rtl/rel8/support/support/land.cert : no_pcert = 0
-
-rtl/rel8/support/support/land.cert : \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/land.lisp
-
-
-rtl/rel8/support/support/land0-proofs.cert : acl2x = 0
-rtl/rel8/support/support/land0-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/land0-proofs.cert : \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/all-ones.cert \
-     rtl/rel8/support/support/log.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/fl-hacks.cert \
-     rtl/rel8/support/support/land0-proofs.lisp
-
-
-rtl/rel8/support/support/land0.cert : acl2x = 0
-rtl/rel8/support/support/land0.cert : no_pcert = 0
-
-rtl/rel8/support/support/land0.cert : \
-     rtl/rel8/support/support/land0-proofs.cert \
-     rtl/rel8/support/support/land0.lisp
-
-
-rtl/rel8/support/support/lextra-proofs.cert : acl2x = 0
-rtl/rel8/support/support/lextra-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/lextra-proofs.cert : \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/logxor.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/lextra-proofs.lisp
-
-
-rtl/rel8/support/support/lextra.cert : acl2x = 0
-rtl/rel8/support/support/lextra.cert : no_pcert = 0
-
-rtl/rel8/support/support/lextra.cert : \
-     rtl/rel8/support/support/land.cert \
-     rtl/rel8/support/support/lior.cert \
-     rtl/rel8/support/support/lxor.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/lextra0.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/merge2.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bits-trunc.cert \
-     rtl/rel8/support/support/fadd.cert \
-     rtl/rel8/support/support/lextra.lisp
-
-
-rtl/rel8/support/support/lextra0.cert : acl2x = 0
-rtl/rel8/support/support/lextra0.cert : no_pcert = 0
-
-rtl/rel8/support/support/lextra0.cert : \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/lextra-proofs.cert \
-     rtl/rel8/support/support/lextra0.lisp
-
-
-rtl/rel8/support/support/lior.cert : acl2x = 0
-rtl/rel8/support/support/lior.cert : no_pcert = 0
-
-rtl/rel8/support/support/lior.cert : \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/lior.lisp
-
-
-rtl/rel8/support/support/lior0-proofs.cert : acl2x = 0
-rtl/rel8/support/support/lior0-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/lior0-proofs.cert : \
-     rtl/rel8/support/support/all-ones.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/lior0-proofs.lisp
-
-
-rtl/rel8/support/support/lior0.cert : acl2x = 0
-rtl/rel8/support/support/lior0.cert : no_pcert = 0
-
-rtl/rel8/support/support/lior0.cert : \
-     rtl/rel8/support/support/lior0-proofs.cert \
-     rtl/rel8/support/support/lior0.lisp
-
-
-rtl/rel8/support/support/lnot-proofs.cert : acl2x = 0
-rtl/rel8/support/support/lnot-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/lnot-proofs.cert : \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/mod.cert \
-     rtl/rel8/arithmetic/mod.cert \
-     rtl/rel8/arithmetic/arith.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/lnot-proofs.lisp
-
-
-rtl/rel8/support/support/lnot.cert : acl2x = 0
-rtl/rel8/support/support/lnot.cert : no_pcert = 0
-
-rtl/rel8/support/support/lnot.cert : \
-     rtl/rel8/support/support/lnot-proofs.cert \
-     rtl/rel8/support/support/lnot.lisp
-
-
-rtl/rel8/support/support/log-equal.cert : acl2x = 0
-rtl/rel8/support/support/log-equal.cert : no_pcert = 0
-
-rtl/rel8/support/support/log-equal.cert : \
-     rtl/rel8/support/support/log-equal.lisp
-
-
-rtl/rel8/support/support/log-proofs.cert : acl2x = 0
-rtl/rel8/support/support/log-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/log-proofs.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/lnot.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logxor.cert \
-     rtl/rel8/support/support/log-proofs.lisp
-
-
-rtl/rel8/support/support/log.cert : acl2x = 0
-rtl/rel8/support/support/log.cert : no_pcert = 0
-
-rtl/rel8/support/support/log.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/log-proofs.cert \
-     rtl/rel8/support/support/lnot.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/logxor.cert \
-     rtl/rel8/support/support/log.lisp
-
-
-rtl/rel8/support/support/logand-proofs.cert : acl2x = 0
-rtl/rel8/support/support/logand-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/logand-proofs.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/induct.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/logand-proofs.lisp
-
-
-rtl/rel8/support/support/logand.cert : acl2x = 0
-rtl/rel8/support/support/logand.cert : no_pcert = 0
-
-rtl/rel8/support/support/logand.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/logand-proofs.cert \
-     rtl/rel8/support/support/logand.lisp
-
-
-rtl/rel8/support/support/logeqv.cert : acl2x = 0
-rtl/rel8/support/support/logeqv.cert : no_pcert = 0
-
-rtl/rel8/support/support/logeqv.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logorc1.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/support/support/logeqv.lisp
-
-
-rtl/rel8/support/support/logior-proofs.cert : acl2x = 0
-rtl/rel8/support/support/logior-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/logior-proofs.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/logior-proofs.lisp
-
-
-rtl/rel8/support/support/logior.cert : acl2x = 0
-rtl/rel8/support/support/logior.cert : no_pcert = 0
-
-rtl/rel8/support/support/logior.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/logior-proofs.cert \
-     rtl/rel8/support/support/logior.lisp
-
-
-rtl/rel8/support/support/logior1-proofs.cert : acl2x = 0
-rtl/rel8/support/support/logior1-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/logior1-proofs.cert : \
-     rtl/rel8/support/support/logior1-proofs.lisp
-
-
-rtl/rel8/support/support/logior1.cert : acl2x = 0
-rtl/rel8/support/support/logior1.cert : no_pcert = 0
-
-rtl/rel8/support/support/logior1.cert : \
-     rtl/rel8/support/support/logior1-proofs.cert \
-     rtl/rel8/support/support/logior1.lisp
-
-
-rtl/rel8/support/support/lognot.cert : acl2x = 0
-rtl/rel8/support/support/lognot.cert : no_pcert = 0
-
-rtl/rel8/support/support/lognot.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/lognot.lisp
-
-
-rtl/rel8/support/support/logorc1.cert : acl2x = 0
-rtl/rel8/support/support/logorc1.cert : no_pcert = 0
-
-rtl/rel8/support/support/logorc1.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/support/support/logorc1.lisp
-
-
-rtl/rel8/support/support/logs.cert : acl2x = 0
-rtl/rel8/support/support/logs.cert : no_pcert = 0
-
-rtl/rel8/support/support/logs.cert : \
-     rtl/rel8/support/support/logs.lisp
-
-
-rtl/rel8/support/support/logxor.cert : acl2x = 0
-rtl/rel8/support/support/logxor.cert : no_pcert = 0
-
-rtl/rel8/support/support/logxor.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/logeqv.cert \
-     rtl/rel8/support/support/logorc1.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/logxor.lisp
-
-
-rtl/rel8/support/support/lop1-proofs.cert : acl2x = 0
-rtl/rel8/support/support/lop1-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/lop1-proofs.cert : \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/lop1-proofs.lisp
-
-
-rtl/rel8/support/support/lop1.cert : acl2x = 0
-rtl/rel8/support/support/lop1.cert : no_pcert = 0
-
-rtl/rel8/support/support/lop1.cert : \
-     rtl/rel8/support/support/lop1-proofs.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/lop1.lisp
-
-
-rtl/rel8/support/support/lop2-proofs.cert : acl2x = 0
-rtl/rel8/support/support/lop2-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/lop2-proofs.cert : \
-     rtl/rel8/support/support/lop1.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/lop2-proofs.lisp
-
-
-rtl/rel8/support/support/lop2.cert : acl2x = 0
-rtl/rel8/support/support/lop2.cert : no_pcert = 0
-
-rtl/rel8/support/support/lop2.cert : \
-     rtl/rel8/support/support/lop1.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lop2-proofs.cert \
-     rtl/rel8/support/support/lop2.lisp
-
-
-rtl/rel8/support/support/lop3-proofs.cert : acl2x = 0
-rtl/rel8/support/support/lop3-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/lop3-proofs.cert : \
-     rtl/rel8/support/support/lop2.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/lop3-proofs.lisp
-
-
-rtl/rel8/support/support/lop3.cert : acl2x = 0
-rtl/rel8/support/support/lop3.cert : no_pcert = 0
-
-rtl/rel8/support/support/lop3.cert : \
-     rtl/rel8/support/support/lop2.cert \
-     rtl/rel8/support/support/lop3-proofs.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/lop3.lisp
-
-
-rtl/rel8/support/support/lxor.cert : acl2x = 0
-rtl/rel8/support/support/lxor.cert : no_pcert = 0
-
-rtl/rel8/support/support/lxor.cert : \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/lxor.lisp
-
-
-rtl/rel8/support/support/lxor0-proofs.cert : acl2x = 0
-rtl/rel8/support/support/lxor0-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/lxor0-proofs.cert : \
-     rtl/rel8/support/support/all-ones.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/lxor0-proofs.lisp
-
-
-rtl/rel8/support/support/lxor0.cert : acl2x = 0
-rtl/rel8/support/support/lxor0.cert : no_pcert = 0
-
-rtl/rel8/support/support/lxor0.cert : \
-     rtl/rel8/support/support/lxor0-proofs.cert \
-     rtl/rel8/support/support/lxor0.lisp
-
-
-rtl/rel8/support/support/merge.cert : acl2x = 0
-rtl/rel8/support/support/merge.cert : no_pcert = 0
-
-rtl/rel8/support/support/merge.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/log.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/lnot.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logxor.cert \
-     rtl/rel8/support/support/ocat.cert \
-     rtl/rel8/support/support/sumbits.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/merge.lisp
-
-
-rtl/rel8/support/support/merge2.cert : acl2x = 0
-rtl/rel8/support/support/merge2.cert : no_pcert = 0
-
-rtl/rel8/support/support/merge2.cert : \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/logs.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/merge2.lisp
-
-
-rtl/rel8/support/support/mod4.cert : acl2x = 0
-rtl/rel8/support/support/mod4.cert : no_pcert = 0
-
-rtl/rel8/support/support/mod4.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/mod4.lisp
-
-
-rtl/rel8/support/support/model-helpers.cert : acl2x = 0
-rtl/rel8/support/support/model-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/support/model-helpers.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/model-helpers.lisp
-
-
-rtl/rel8/support/support/mulcat-proofs.cert : acl2x = 0
-rtl/rel8/support/support/mulcat-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/mulcat-proofs.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/mulcat-proofs.lisp
-
-
-rtl/rel8/support/support/mulcat.cert : acl2x = 0
-rtl/rel8/support/support/mulcat.cert : no_pcert = 0
-
-rtl/rel8/support/support/mulcat.cert : \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/mulcat-proofs.cert \
-     rtl/rel8/support/support/mulcat.lisp
-
-
-rtl/rel8/support/support/near+-proofs.cert : acl2x = 0
-rtl/rel8/support/support/near+-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/near+-proofs.cert : \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/arithmetic/predicate.cert \
-     rtl/rel8/arithmetic/cg.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/fl.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/near+-proofs.lisp
-
-
-rtl/rel8/support/support/near+.cert : acl2x = 0
-rtl/rel8/support/support/near+.cert : no_pcert = 0
-
-rtl/rel8/support/support/near+.cert : \
-     rtl/rel8/support/support/near+-proofs.cert \
-     rtl/rel8/support/support/near+.lisp
-
-
-rtl/rel8/support/support/near-proofs.cert : acl2x = 0
-rtl/rel8/support/support/near-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/near-proofs.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/near-proofs.lisp
-
-
-rtl/rel8/support/support/near.cert : acl2x = 0
-rtl/rel8/support/support/near.cert : no_pcert = 0
-
-rtl/rel8/support/support/near.cert : \
-     rtl/rel8/support/support/near-proofs.cert \
-     rtl/rel8/support/support/near.lisp
-
-
-rtl/rel8/support/support/ocat.cert : acl2x = 0
-rtl/rel8/support/support/ocat.cert : no_pcert = 0
-
-rtl/rel8/support/support/ocat.cert : \
-     rtl/rel8/arithmetic/expt.cert \
-     rtl/rel8/arithmetic/expo.cert \
-     rtl/rel8/arithmetic/arith2.cert \
-     rtl/rel8/arithmetic/fp2.cert \
-     rtl/rel8/arithmetic/integerp.cert \
-     rtl/rel8/support/support/ocat.lisp
-
-
-rtl/rel8/support/support/oddr-proofs.cert : acl2x = 0
-rtl/rel8/support/support/oddr-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/oddr-proofs.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/support/support/near.cert \
-     rtl/rel8/support/support/oddr-proofs.lisp
-
-
-rtl/rel8/support/support/oddr.cert : acl2x = 0
-rtl/rel8/support/support/oddr.cert : no_pcert = 0
-
-rtl/rel8/support/support/oddr.cert : \
-     rtl/rel8/support/support/oddr-proofs.cert \
-     rtl/rel8/support/support/oddr.lisp
-
-
-rtl/rel8/support/support/openers.cert : acl2x = 0
-rtl/rel8/support/support/openers.cert : no_pcert = 0
-
-rtl/rel8/support/support/openers.cert : \
-     rtl/rel8/support/support/openers.lisp
-
-
-rtl/rel8/support/support/package-defs.cert : acl2x = 0
-rtl/rel8/support/support/package-defs.cert : no_pcert = 0
-
-rtl/rel8/support/support/package-defs.cert : \
-     rtl/rel8/support/support/package-defs.lisp
-
-
-rtl/rel8/support/support/rewrite-theory.cert : acl2x = 0
-rtl/rel8/support/support/rewrite-theory.cert : no_pcert = 0
-
-rtl/rel8/support/support/rewrite-theory.cert : \
-     rtl/rel8/support/support/rewrite-theory.lisp
-
-
-rtl/rel8/support/support/rnd.cert : acl2x = 0
-rtl/rel8/support/support/rnd.cert : no_pcert = 0
-
-rtl/rel8/support/support/rnd.cert : \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/support/support/near.cert \
-     rtl/rel8/support/support/near+.cert \
-     rtl/rel8/support/support/sticky.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bits-trunc.cert \
-     rtl/rel8/support/support/rnd.lisp
-
-
-rtl/rel8/support/support/rom-helpers.cert : acl2x = 0
-rtl/rel8/support/support/rom-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/support/rom-helpers.cert : \
-     rtl/rel8/support/support/rom-helpers.lisp
-
-
-rtl/rel8/support/support/round-extra.cert : acl2x = 0
-rtl/rel8/support/support/round-extra.cert : no_pcert = 0
-
-rtl/rel8/support/support/round-extra.cert : \
-     rtl/rel8/support/support/sticky.cert \
-     rtl/rel8/support/support/util.cert \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/round-extra.lisp
-
-
-rtl/rel8/support/support/rtl.cert : acl2x = 0
-rtl/rel8/support/support/rtl.cert : no_pcert = 0
-
-rtl/rel8/support/support/rtl.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/rtlarr.cert \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/rtl.lisp
-
-
-rtl/rel8/support/support/rtlarr.cert : acl2x = 0
-rtl/rel8/support/support/rtlarr.cert : no_pcert = 0
-
-rtl/rel8/support/support/rtlarr.cert : \
-     misc/total-order.cert \
-     rtl/rel8/support/support/rtlarr.lisp
-
-
-rtl/rel8/support/support/setbitn-proofs.cert : acl2x = 0
-rtl/rel8/support/support/setbitn-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/setbitn-proofs.cert : \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/setbits.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/setbitn-proofs.lisp
-
-
-rtl/rel8/support/support/setbitn.cert : acl2x = 0
-rtl/rel8/support/support/setbitn.cert : no_pcert = 0
-
-rtl/rel8/support/support/setbitn.cert : \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/setbitn-proofs.cert \
-     rtl/rel8/support/support/setbitn.lisp
-
-
-rtl/rel8/support/support/setbits-proofs.cert : acl2x = 0
-rtl/rel8/support/support/setbits-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/setbits-proofs.cert : \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/setbits-proofs.lisp
-
-
-rtl/rel8/support/support/setbits.cert : acl2x = 0
-rtl/rel8/support/support/setbits.cert : no_pcert = 0
-
-rtl/rel8/support/support/setbits.cert : \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/setbits-proofs.cert \
-     rtl/rel8/support/support/setbits.lisp
-
-
-rtl/rel8/support/support/sgn.cert : acl2x = 0
-rtl/rel8/support/support/sgn.cert : no_pcert = 0
-
-rtl/rel8/support/support/sgn.cert : \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/sgn.lisp
-
-
-rtl/rel8/support/support/shft.cert : acl2x = 0
-rtl/rel8/support/support/shft.cert : no_pcert = 0
-
-rtl/rel8/support/support/shft.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/shft.lisp
-
-
-rtl/rel8/support/support/simple-loop-helpers.cert : acl2x = 0
-rtl/rel8/support/support/simple-loop-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/support/simple-loop-helpers.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/setbitn.cert \
-     rtl/rel8/support/support/simple-loop-helpers.lisp
-
-
-rtl/rel8/support/support/simplify-model-helpers.cert : acl2x = 0
-rtl/rel8/support/support/simplify-model-helpers.cert : no_pcert = 0
-
-rtl/rel8/support/support/simplify-model-helpers.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/simplify-model-helpers.lisp
-
-
-rtl/rel8/support/support/stick-proofs.cert : acl2x = 0
-rtl/rel8/support/support/stick-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/stick-proofs.cert : \
-     rtl/rel8/support/support/merge.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/lnot.cert \
-     rtl/rel8/support/support/stick-proofs.lisp
-
-
-rtl/rel8/support/support/stick.cert : acl2x = 0
-rtl/rel8/support/support/stick.cert : no_pcert = 0
-
-rtl/rel8/support/support/stick.cert : \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/stick-proofs.cert \
-     rtl/rel8/support/support/stick.lisp
-
-
-rtl/rel8/support/support/sticky-proofs.cert : acl2x = 0
-rtl/rel8/support/support/sticky-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/sticky-proofs.cert : \
-     rtl/rel8/arithmetic/arith.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/support/support/near.cert \
-     rtl/rel8/support/support/near+.cert \
-     rtl/rel8/support/support/sticky-proofs.lisp
-
-
-rtl/rel8/support/support/sticky.cert : acl2x = 0
-rtl/rel8/support/support/sticky.cert : no_pcert = 0
-
-rtl/rel8/support/support/sticky.cert : \
-     rtl/rel8/support/support/sticky-proofs.cert \
-     rtl/rel8/support/support/sticky.lisp
-
-
-rtl/rel8/support/support/sumbits.cert : acl2x = 0
-rtl/rel8/support/support/sumbits.cert : no_pcert = 0
-
-rtl/rel8/support/support/sumbits.cert : \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/sumbits.lisp
-
-
-rtl/rel8/support/support/top.cert : acl2x = 0
-rtl/rel8/support/support/top.cert : no_pcert = 0
-
-rtl/rel8/support/support/top.cert : \
-     rtl/rel8/support/support/top1.cert \
-     rtl/rel8/support/support/lextra.cert \
-     rtl/rel8/support/support/fadd-extra.cert \
-     rtl/rel8/support/support/float-extra.cert \
-     rtl/rel8/support/support/round-extra.cert \
-     rtl/rel8/support/support/guards.cert \
-     rtl/rel8/support/support/badguys.cert \
-     rtl/rel8/support/support/top.lisp
-
-
-rtl/rel8/support/support/top1.cert : acl2x = 0
-rtl/rel8/support/support/top1.cert : no_pcert = 0
-
-rtl/rel8/support/support/top1.cert : \
-     rtl/rel8/support/support/util.cert \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/rewrite-theory.cert \
-     rtl/rel8/support/support/rtl.cert \
-     rtl/rel8/support/support/rtlarr.cert \
-     rtl/rel8/support/support/bvecp-lemmas.cert \
-     rtl/rel8/support/support/bits.cert \
-     rtl/rel8/support/support/bitn.cert \
-     rtl/rel8/support/support/ocat.cert \
-     rtl/rel8/support/support/cat-def.cert \
-     rtl/rel8/support/support/cat.cert \
-     rtl/rel8/support/support/bvecp.cert \
-     rtl/rel8/support/support/ash.cert \
-     rtl/rel8/support/support/decode.cert \
-     rtl/rel8/support/support/encode.cert \
-     rtl/rel8/support/support/mulcat.cert \
-     rtl/rel8/support/support/shft.cert \
-     rtl/rel8/support/support/all-ones.cert \
-     rtl/rel8/support/support/merge2.cert \
-     rtl/rel8/support/support/logior1.cert \
-     rtl/rel8/support/support/setbits.cert \
-     rtl/rel8/support/support/setbitn.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/support/support/bias.cert \
-     rtl/rel8/support/support/ereps.cert \
-     rtl/rel8/support/support/ireps.cert \
-     rtl/rel8/support/support/logeqv.cert \
-     rtl/rel8/support/support/logorc1.cert \
-     rtl/rel8/support/support/lognot.cert \
-     rtl/rel8/support/support/logand.cert \
-     rtl/rel8/support/support/logior.cert \
-     rtl/rel8/support/support/logxor.cert \
-     rtl/rel8/support/support/log.cert \
-     rtl/rel8/support/support/lnot.cert \
-     rtl/rel8/support/support/land0.cert \
-     rtl/rel8/support/support/lior0.cert \
-     rtl/rel8/support/support/lxor0.cert \
-     rtl/rel8/support/support/lextra0.cert \
-     rtl/rel8/support/support/logs.cert \
-     rtl/rel8/support/support/trunc.cert \
-     rtl/rel8/support/support/away.cert \
-     rtl/rel8/support/support/near.cert \
-     rtl/rel8/support/support/near+.cert \
-     rtl/rel8/support/support/oddr.cert \
-     rtl/rel8/support/support/sticky.cert \
-     rtl/rel8/support/support/rnd.cert \
-     rtl/rel8/support/support/drnd-original.cert \
-     rtl/rel8/support/support/bits-trunc.cert \
-     rtl/rel8/support/support/add3.cert \
-     rtl/rel8/support/support/lop1.cert \
-     rtl/rel8/support/support/lop2.cert \
-     rtl/rel8/support/support/lop3.cert \
-     rtl/rel8/support/support/stick.cert \
-     rtl/rel8/support/support/bvecp-helpers.cert \
-     rtl/rel8/support/support/model-helpers.cert \
-     rtl/rel8/support/support/rom-helpers.cert \
-     rtl/rel8/support/support/simple-loop-helpers.cert \
-     rtl/rel8/support/support/clocks.cert \
-     rtl/rel8/support/support/openers.cert \
-     rtl/rel8/support/support/package-defs.cert \
-     rtl/rel8/support/support/simplify-model-helpers.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/arithmetic/fp.cert \
-     rtl/rel8/support/support/fadd.cert \
-     rtl/rel8/support/support/top1.lisp
-
-
-rtl/rel8/support/support/trunc-proofs.cert : acl2x = 0
-rtl/rel8/support/support/trunc-proofs.cert : no_pcert = 0
-
-rtl/rel8/support/support/trunc-proofs.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/float.cert \
-     rtl/rel8/arithmetic/top.cert \
-     rtl/rel8/support/support/trunc-proofs.lisp
-
-
-rtl/rel8/support/support/trunc.cert : acl2x = 0
-rtl/rel8/support/support/trunc.cert : no_pcert = 0
-
-rtl/rel8/support/support/trunc.cert : \
-     rtl/rel8/support/support/ground-zero.cert \
-     rtl/rel8/support/support/trunc-proofs.cert \
-     rtl/rel8/support/support/trunc.lisp
-
-
-rtl/rel8/support/support/util.cert : acl2x = 0
-rtl/rel8/support/support/util.cert : no_pcert = 0
-
-rtl/rel8/support/support/util.cert : \
-     rtl/rel8/support/support/util.lisp
-
-
-rtl/rel8/support/top/top.cert : acl2x = 0
-rtl/rel8/support/top/top.cert : no_pcert = 0
-
-rtl/rel8/support/top/top.cert : \
-     rtl/rel8/support/lib2.delta1/rtl.cert \
-     rtl/rel8/support/lib2.delta1/rtlarr.cert \
-     rtl/rel8/support/lib2/basic.cert \
-     rtl/rel8/support/lib2.delta2/bits.cert \
-     rtl/rel8/support/lib2.delta2/log.cert \
-     rtl/rel8/support/lib2.delta1/float.cert \
-     rtl/rel8/support/lib2.delta1/reps.cert \
-     rtl/rel8/support/lib2.delta1/round.cert \
-     rtl/rel8/support/lib2.delta2/add.cert \
-     rtl/rel8/support/lib2.delta1/mult.cert \
-     rtl/rel8/support/lib2.delta1/arith.cert \
-     rtl/rel8/support/lib2.delta1/util.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert \
-     rtl/rel8/support/lib2/rom-helpers.cert \
-     rtl/rel8/support/lib2.delta1/bvecp-helpers.cert \
-     rtl/rel8/support/lib2.delta1/logn.cert \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert \
-     rtl/rel8/support/lib2.delta1/logn2log.cert \
-     rtl/rel8/support/top/top.lisp
-
-
-security/jfkr/diffie-helman.cert : acl2x = 0
-security/jfkr/diffie-helman.cert : no_pcert = 0
-
-security/jfkr/diffie-helman.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     security/jfkr/diffie-helman.lisp \
-     security/jfkr/cert.acl2 \
-     security/jfkr/package.lsp
-
-
-security/jfkr/encryption.cert : acl2x = 0
-security/jfkr/encryption.cert : no_pcert = 0
-
-security/jfkr/encryption.cert : \
-     security/jfkr/encryption.lisp \
-     security/jfkr/cert.acl2 \
-     security/jfkr/package.lsp
-
-
-security/jfkr/jfkr.cert : acl2x = 0
-security/jfkr/jfkr.cert : no_pcert = 0
-
-security/jfkr/jfkr.cert : \
-     security/jfkr/encryption.cert \
-     security/jfkr/diffie-helman.cert \
-     security/jfkr/random.cert \
-     misc/assert.cert \
-     misc/untranslate-patterns.cert \
-     security/jfkr/jfkr.lisp \
-     security/jfkr/cert.acl2 \
-     security/jfkr/package.lsp
-
-
-security/jfkr/random.cert : acl2x = 0
-security/jfkr/random.cert : no_pcert = 0
-
-security/jfkr/random.cert : \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     security/jfkr/random.lisp \
-     security/jfkr/cert.acl2 \
-     security/jfkr/package.lsp
-
-
-security/suite-b/sha-2.cert : acl2x = 0
-security/suite-b/sha-2.cert : no_pcert = 0
-
-security/suite-b/sha-2.cert : \
-     security/util/byte-operations.cert \
-     security/suite-b/sha-2.lisp
-
-
-security/util/byte-operations.cert : acl2x = 0
-security/util/byte-operations.cert : no_pcert = 0
-
-security/util/byte-operations.cert : \
-     arithmetic-5/top.cert \
-     security/util/byte-operations.lisp
-
-
-serialize/serialize-tests.cert : acl2x = 0
-serialize/serialize-tests.cert : no_pcert = 0
-
-serialize/serialize-tests.cert : \
-     serialize/unsound-read.cert \
-     tools/bstar.cert \
-     serialize/serialize-tests.lisp \
-     serialize/serialize-tests.acl2
-
-
-serialize/serialize-tests2.cert : acl2x = 0
-serialize/serialize-tests2.cert : no_pcert = 0
-
-serialize/serialize-tests2.cert : \
-     serialize/serialize-tests.cert \
-     serialize/serialize-tests2.lisp \
-     serialize/serialize-tests2.acl2
-
-
-serialize/unsound-read.cert : acl2x = 0
-serialize/unsound-read.cert : no_pcert = 0
-
-serialize/unsound-read.cert : \
-     tools/include-raw.cert \
-     serialize/unsound-read.lisp \
-     serialize/unsound-read.acl2 \
-     serialize/unsound-read-raw.lsp
-
-
-sorting/bsort.cert : acl2x = 0
-sorting/bsort.cert : no_pcert = 0
-
-sorting/bsort.cert : \
-     sorting/ordered-perms.cert \
-     sorting/convert-perm-to-how-many.cert \
-     sorting/bsort.lisp
-
-
-sorting/convert-perm-to-how-many.cert : acl2x = 0
-sorting/convert-perm-to-how-many.cert : no_pcert = 0
-
-sorting/convert-perm-to-how-many.cert : \
-     sorting/perm.cert \
-     sorting/convert-perm-to-how-many.lisp
-
-
-sorting/equisort.cert : acl2x = 0
-sorting/equisort.cert : no_pcert = 0
-
-sorting/equisort.cert : \
-     sorting/perm.cert \
-     sorting/ordered-perms.cert \
-     sorting/convert-perm-to-how-many.cert \
-     sorting/equisort.lisp
-
-
-sorting/equisort2.cert : acl2x = 0
-sorting/equisort2.cert : no_pcert = 0
-
-sorting/equisort2.cert : \
-     sorting/perm.cert \
-     sorting/ordered-perms.cert \
-     sorting/convert-perm-to-how-many.cert \
-     sorting/equisort2.lisp
-
-
-sorting/equisort3.cert : acl2x = 0
-sorting/equisort3.cert : no_pcert = 0
-
-sorting/equisort3.cert : \
-     sorting/perm.cert \
-     sorting/ordered-perms.cert \
-     sorting/convert-perm-to-how-many.cert \
-     sorting/equisort3.lisp
-
-
-sorting/isort.cert : acl2x = 0
-sorting/isort.cert : no_pcert = 0
-
-sorting/isort.cert : \
-     sorting/perm.cert \
-     sorting/ordered-perms.cert \
-     sorting/convert-perm-to-how-many.cert \
-     sorting/isort.lisp
-
-
-sorting/msort.cert : acl2x = 0
-sorting/msort.cert : no_pcert = 0
-
-sorting/msort.cert : \
-     sorting/perm.cert \
-     sorting/ordered-perms.cert \
-     sorting/convert-perm-to-how-many.cert \
-     sorting/msort.lisp
-
-
-sorting/no-dups-qsort.cert : acl2x = 0
-sorting/no-dups-qsort.cert : no_pcert = 0
-
-sorting/no-dups-qsort.cert : \
-     sorting/qsort.cert \
-     sorting/no-dups-qsort.lisp
-
-
-sorting/ordered-perms.cert : acl2x = 0
-sorting/ordered-perms.cert : no_pcert = 0
-
-sorting/ordered-perms.cert : \
-     sorting/perm.cert \
-     sorting/ordered-perms.lisp
-
-
-sorting/perm.cert : acl2x = 0
-sorting/perm.cert : no_pcert = 0
-
-sorting/perm.cert : \
-     sorting/perm.lisp
-
-
-sorting/qsort.cert : acl2x = 0
-sorting/qsort.cert : no_pcert = 0
-
-sorting/qsort.cert : \
-     sorting/perm.cert \
-     sorting/ordered-perms.cert \
-     sorting/convert-perm-to-how-many.cert \
-     arithmetic-3/extra/top-ext.cert \
-     sorting/qsort.lisp
-
-
-sorting/sorts-equivalent.cert : acl2x = 0
-sorting/sorts-equivalent.cert : no_pcert = 0
-
-sorting/sorts-equivalent.cert : \
-     sorting/equisort.cert \
-     sorting/isort.cert \
-     sorting/msort.cert \
-     sorting/qsort.cert \
-     sorting/bsort.cert \
-     sorting/sorts-equivalent.lisp
-
-
-sorting/sorts-equivalent2.cert : acl2x = 0
-sorting/sorts-equivalent2.cert : no_pcert = 0
-
-sorting/sorts-equivalent2.cert : \
-     sorting/equisort2.cert \
-     sorting/isort.cert \
-     sorting/msort.cert \
-     sorting/qsort.cert \
-     sorting/bsort.cert \
-     sorting/sorts-equivalent2.lisp
-
-
-sorting/sorts-equivalent3.cert : acl2x = 0
-sorting/sorts-equivalent3.cert : no_pcert = 0
-
-sorting/sorts-equivalent3.cert : \
-     sorting/equisort3.cert \
-     sorting/isort.cert \
-     sorting/msort.cert \
-     sorting/qsort.cert \
-     sorting/bsort.cert \
-     sorting/sorts-equivalent3.lisp
-
-
-std/io/base.cert : acl2x = 0
-std/io/base.cert : no_pcert = 0
-
-std/io/base.cert : \
-     xdoc/top.cert \
-     system/f-put-global.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     std/io/base.lisp
-
-
-std/io/close-input-channel.cert : acl2x = 0
-std/io/close-input-channel.cert : no_pcert = 0
-
-std/io/close-input-channel.cert : \
-     std/io/base.cert \
-     std/io/close-input-channel.lisp
-
-
-std/io/combine.cert : acl2x = 0
-std/io/combine.cert : no_pcert = 0
-
-std/io/combine.cert : \
-     std/io/sign-byte.cert \
-     std/io/unsigned-byte-listp.cert \
-     std/io/signed-byte-listp.cert \
-     std/io/combine.lisp
-
-
-std/io/file-measure.cert : acl2x = 0
-std/io/file-measure.cert : no_pcert = 0
-
-std/io/file-measure.cert : \
-     std/io/base.cert \
-     std/io/file-measure.lisp
-
-
-std/io/nthcdr-bytes.cert : acl2x = 0
-std/io/nthcdr-bytes.cert : no_pcert = 0
-
-std/io/nthcdr-bytes.cert : \
-     std/io/read-byte.cert \
-     std/io/read-file-bytes.cert \
-     tools/mv-nth.cert \
-     std/io/nthcdr-bytes.lisp
-
-
-std/io/open-input-channel.cert : acl2x = 0
-std/io/open-input-channel.cert : no_pcert = 0
-
-std/io/open-input-channel.cert : \
-     tools/mv-nth.cert \
-     system/update-state.cert \
-     std/io/open-input-channels.cert \
-     arithmetic/top.cert \
-     std/ks/explode-nonnegative-integer.cert \
-     std/ks/intern-in-package-of-symbol.cert \
-     std/lists/coerce.cert \
-     std/io/open-input-channel.lisp
-
-
-std/io/open-input-channels.cert : acl2x = 0
-std/io/open-input-channels.cert : no_pcert = 0
-
-std/io/open-input-channels.cert : \
-     std/io/open-input-channels.lisp
-
-
-std/io/peek-char.cert : acl2x = 0
-std/io/peek-char.cert : no_pcert = 0
-
-std/io/peek-char.cert : \
-     std/io/base.cert \
-     std/io/peek-char.lisp
-
-
-std/io/read-byte.cert : acl2x = 0
-std/io/read-byte.cert : no_pcert = 0
-
-std/io/read-byte.cert : \
-     std/io/base.cert \
-     std/io/read-byte.lisp
-
-
-std/io/read-char.cert : acl2x = 0
-std/io/read-char.cert : no_pcert = 0
-
-std/io/read-char.cert : \
-     std/io/base.cert \
-     std/io/read-char.lisp
-
-
-std/io/read-file-bytes.cert : acl2x = 0
-std/io/read-file-bytes.cert : no_pcert = 0
-
-std/io/read-file-bytes.cert : \
-     std/io/base.cert \
-     std/io/unsigned-byte-listp.cert \
-     tools/mv-nth.cert \
-     std/io/read-file-bytes.lisp
-
-
-std/io/read-file-characters-no-error.cert : acl2x = 0
-std/io/read-file-characters-no-error.cert : no_pcert = 0
-
-std/io/read-file-characters-no-error.cert : \
-     std/io/read-file-characters.cert \
-     tools/mv-nth.cert \
-     std/io/read-file-characters-no-error.lisp \
-     std/io/read-file-characters-no-error.acl2
-
-
-std/io/read-file-characters.cert : acl2x = 0
-std/io/read-file-characters.cert : no_pcert = 0
-
-std/io/read-file-characters.cert : \
-     std/io/base.cert \
-     std/lists/revappend.cert \
-     tools/mv-nth.cert \
-     std/lists/rev.cert \
-     std/io/read-file-characters.lisp
-
-
-std/io/read-file-lines.cert : acl2x = 0
-std/io/read-file-lines.cert : no_pcert = 0
-
-std/io/read-file-lines.cert : \
-     std/io/base.cert \
-     std/lists/revappend.cert \
-     std/lists/rev.cert \
-     tools/mv-nth.cert \
-     tools/bstar.cert \
-     std/io/read-file-lines.lisp
-
-
-std/io/read-file-objects.cert : acl2x = 0
-std/io/read-file-objects.cert : no_pcert = 0
-
-std/io/read-file-objects.cert : \
-     std/io/base.cert \
-     tools/mv-nth.cert \
-     std/io/read-file-objects.lisp
-
-
-std/io/read-ints.cert : acl2x = 0
-std/io/read-ints.cert : no_pcert = 0
-
-std/io/read-ints.cert : \
-     std/io/read-byte.cert \
-     std/io/unsigned-byte-listp.cert \
-     std/io/signed-byte-listp.cert \
-     std/io/sign-byte.cert \
-     std/io/combine.cert \
-     tools/mv-nth.cert \
-     arithmetic-3/bind-free/top.cert \
-     std/io/read-ints.lisp
-
-
-std/io/read-object.cert : acl2x = 0
-std/io/read-object.cert : no_pcert = 0
-
-std/io/read-object.cert : \
-     std/io/base.cert \
-     std/io/read-object.lisp
-
-
-std/io/sign-byte.cert : acl2x = 0
-std/io/sign-byte.cert : no_pcert = 0
-
-std/io/sign-byte.cert : \
-     std/io/sign-byte.lisp
-
-
-std/io/signed-byte-listp.cert : acl2x = 0
-std/io/signed-byte-listp.cert : no_pcert = 0
-
-std/io/signed-byte-listp.cert : \
-     ihs/logops-lemmas.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     std/io/unsigned-byte-listp.cert \
-     std/io/signed-byte-listp.lisp
-
-
-std/io/take-bytes.cert : acl2x = 0
-std/io/take-bytes.cert : no_pcert = 0
-
-std/io/take-bytes.cert : \
-     std/io/read-byte.cert \
-     std/io/read-file-bytes.cert \
-     std/io/nthcdr-bytes.cert \
-     std/io/take-bytes.lisp
-
-
-std/io/unsigned-byte-listp.cert : acl2x = 0
-std/io/unsigned-byte-listp.cert : no_pcert = 0
-
-std/io/unsigned-byte-listp.cert : \
-     std/lists/take.cert \
-     std/lists/nat-listp.cert \
-     std/lists/repeat.cert \
-     ihs/logops-lemmas.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     std/io/unsigned-byte-listp.lisp
-
-
-std/ks/base10-digit-charp.cert : acl2x = 0
-std/ks/base10-digit-charp.cert : no_pcert = 0
-
-std/ks/base10-digit-charp.cert : \
-     std/ks/base10-digit-charp.lisp
-
-
-std/ks/explode-atom.cert : acl2x = 0
-std/ks/explode-atom.cert : no_pcert = 0
-
-std/ks/explode-atom.cert : \
-     std/ks/base10-digit-charp.cert \
-     std/lists/append.cert \
-     std/ks/explode-nonnegative-integer.cert \
-     std/ks/explode-atom.lisp
-
-
-std/ks/explode-nonnegative-integer.cert : acl2x = 0
-std/ks/explode-nonnegative-integer.cert : no_pcert = 0
-
-std/ks/explode-nonnegative-integer.cert : \
-     ihs/quotient-remainder-lemmas.cert \
-     std/lists/revappend.cert \
-     std/ks/base10-digit-charp.cert \
-     std/lists/rev.cert \
-     std/ks/explode-nonnegative-integer.lisp
-
-
-std/ks/intern-in-package-of-symbol.cert : acl2x = 0
-std/ks/intern-in-package-of-symbol.cert : no_pcert = 0
-
-std/ks/intern-in-package-of-symbol.cert : \
-     std/ks/intern-in-package-of-symbol.lisp
-
-
-std/ks/string-append.cert : acl2x = 0
-std/ks/string-append.cert : no_pcert = 0
-
-std/ks/string-append.cert : \
-     std/lists/append.cert \
-     std/lists/coerce.cert \
-     std/ks/string-append.lisp
-
-
-std/ks/two-nats-measure.cert : acl2x = 0
-std/ks/two-nats-measure.cert : no_pcert = 0
-
-std/ks/two-nats-measure.cert : \
-     arithmetic/top-with-meta.cert \
-     std/ks/two-nats-measure.lisp
-
-
-std/lists/app.cert : acl2x = 0
-std/lists/app.cert : no_pcert = 0
-
-std/lists/app.cert : \
-     std/lists/list-fix.cert \
-     std/lists/take.cert \
-     std/lists/nthcdr.cert \
-     arithmetic/top.cert \
-     std/lists/app.lisp
-
-
-std/lists/append.cert : acl2x = 0
-std/lists/append.cert : no_pcert = 0
-
-std/lists/append.cert : \
-     std/lists/list-fix.cert \
-     arithmetic/top.cert \
-     std/lists/append.lisp
-
-
-std/lists/coerce.cert : acl2x = 0
-std/lists/coerce.cert : no_pcert = 0
-
-std/lists/coerce.cert : \
-     std/lists/make-character-list.cert \
-     std/lists/coerce.lisp
-
-
-std/lists/consless-listp.cert : acl2x = 0
-std/lists/consless-listp.cert : no_pcert = 0
-
-std/lists/consless-listp.cert : \
-     std/lists/app.cert \
-     std/lists/consless-listp.lisp
-
-
-std/lists/equiv.cert : acl2x = 0
-std/lists/equiv.cert : no_pcert = 0
-
-std/lists/equiv.cert : \
-     std/lists/list-fix.cert \
-     std/lists/take.cert \
-     arithmetic/top.cert \
-     std/lists/equiv.lisp
-
-
-std/lists/final-cdr.cert : acl2x = 0
-std/lists/final-cdr.cert : no_pcert = 0
-
-std/lists/final-cdr.cert : \
-     std/lists/nthcdr.cert \
-     std/lists/final-cdr.lisp
-
-
-std/lists/flatten.cert : acl2x = 0
-std/lists/flatten.cert : no_pcert = 0
-
-std/lists/flatten.cert : \
-     std/lists/app.cert \
-     std/lists/consless-listp.cert \
-     std/lists/flatten.lisp
-
-
-std/lists/list-defuns.cert : acl2x = 0
-std/lists/list-defuns.cert : no_pcert = 0
-
-std/lists/list-defuns.cert : \
-     std/lists/app.cert \
-     std/lists/append.cert \
-     std/lists/list-fix.cert \
-     std/lists/flatten.cert \
-     std/lists/final-cdr.cert \
-     std/lists/prefixp.cert \
-     std/lists/take.cert \
-     std/lists/repeat.cert \
-     std/lists/revappend.cert \
-     std/lists/rev.cert \
-     std/lists/equiv.cert \
-     std/lists/sets.cert \
-     std/lists/list-defuns.lisp
-
-
-std/lists/list-fix.cert : acl2x = 0
-std/lists/list-fix.cert : no_pcert = 0
-
-std/lists/list-fix.cert : \
-     std/lists/take.cert \
-     arithmetic/top.cert \
-     std/lists/list-fix.lisp
-
-
-std/lists/make-character-list.cert : acl2x = 0
-std/lists/make-character-list.cert : no_pcert = 0
-
-std/lists/make-character-list.cert : \
-     std/lists/make-character-list.lisp
-
-
-std/lists/mfc-utils.cert : acl2x = 0
-std/lists/mfc-utils.cert : no_pcert = 0
-
-std/lists/mfc-utils.cert : \
-     std/lists/mfc-utils.lisp
-
-
-std/lists/nat-listp.cert : acl2x = 0
-std/lists/nat-listp.cert : no_pcert = 0
-
-std/lists/nat-listp.cert : \
-     std/lists/app.cert \
-     arithmetic/nat-listp.cert \
-     std/lists/nat-listp.lisp
-
-
-std/lists/nthcdr.cert : acl2x = 0
-std/lists/nthcdr.cert : no_pcert = 0
-
-std/lists/nthcdr.cert : \
-     std/lists/nthcdr.lisp
-
-
-std/lists/prefixp.cert : acl2x = 0
-std/lists/prefixp.cert : no_pcert = 0
-
-std/lists/prefixp.cert : \
-     std/lists/list-fix.cert \
-     std/lists/take.cert \
-     arithmetic/top.cert \
-     std/lists/prefixp.lisp
-
-
-std/lists/repeat.cert : acl2x = 0
-std/lists/repeat.cert : no_pcert = 0
-
-std/lists/repeat.cert : \
-     std/lists/take.cert \
-     std/lists/append.cert \
-     std/lists/repeat.lisp
-
-
-std/lists/rev.cert : acl2x = 0
-std/lists/rev.cert : no_pcert = 0
-
-std/lists/rev.cert : \
-     std/lists/revappend.cert \
-     std/lists/reverse.cert \
-     std/lists/append.cert \
-     std/lists/make-character-list.cert \
-     std/lists/rev.lisp
-
-
-std/lists/revappend.cert : acl2x = 0
-std/lists/revappend.cert : no_pcert = 0
-
-std/lists/revappend.cert : \
-     arithmetic/top.cert \
-     std/lists/revappend.lisp
-
-
-std/lists/reverse.cert : acl2x = 0
-std/lists/reverse.cert : no_pcert = 0
-
-std/lists/reverse.cert : \
-     std/lists/revappend.cert \
-     std/lists/coerce.cert \
-     std/lists/reverse.lisp
-
-
-std/lists/sets.cert : acl2x = 0
-std/lists/sets.cert : no_pcert = 0
-
-std/lists/sets.cert : \
-     std/lists/equiv.cert \
-     std/lists/mfc-utils.cert \
-     std/lists/rev.cert \
-     std/lists/sets.lisp
-
-
-std/lists/take.cert : acl2x = 0
-std/lists/take.cert : no_pcert = 0
-
-std/lists/take.cert : \
-     arithmetic/top.cert \
-     std/lists/take.lisp
-
-
-str/abbrevs.cert : acl2x = 0
-str/abbrevs.cert : no_pcert = 0
-
-str/abbrevs.cert : \
-     str/top.cert \
-     str/portcullis.cert \
-     str/abbrevs.lisp \
-     str/cert.acl2
-
-
-str/arithmetic.cert : acl2x = 0
-str/arithmetic.cert : no_pcert = 0
-
-str/arithmetic.cert : \
-     arithmetic/top.cert \
-     std/lists/nthcdr.cert \
-     std/lists/append.cert \
-     std/lists/repeat.cert \
-     str/portcullis.cert \
-     str/arithmetic.lisp \
-     str/cert.acl2
-
-
-str/case-conversion.cert : acl2x = 0
-str/case-conversion.cert : no_pcert = 0
-
-str/case-conversion.cert : \
-     str/char-case.cert \
-     str/cat.cert \
-     str/arithmetic.cert \
-     std/lists/rev.cert \
-     std/lists/coerce.cert \
-     std/lists/take.cert \
-     std/lists/nthcdr.cert \
-     str/subseq.cert \
-     str/portcullis.cert \
-     str/case-conversion.lisp \
-     str/cert.acl2
-
-
-str/cat.cert : acl2x = 0
-str/cat.cert : no_pcert = 0
-
-str/cat.cert : \
-     xdoc/top.cert \
-     misc/definline.cert \
-     str/arithmetic.cert \
-     std/lists/take.cert \
-     str/portcullis.cert \
-     str/cat.lisp \
-     str/cert.acl2
-
-
-str/char-case.cert : acl2x = 0
-str/char-case.cert : no_pcert = 0
-
-str/char-case.cert : \
-     str/eqv.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/char-case.lisp \
-     str/cert.acl2
-
-
-str/digitp.cert : acl2x = 0
-str/digitp.cert : no_pcert = 0
-
-str/digitp.cert : \
-     str/eqv.cert \
-     std/lists/list-fix.cert \
-     std/lists/rev.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/digitp.lisp \
-     str/cert.acl2
-
-
-str/eqv.cert : acl2x = 0
-str/eqv.cert : no_pcert = 0
-
-str/eqv.cert : \
-     xdoc/top.cert \
-     std/lists/list-fix.cert \
-     misc/definline.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/eqv.lisp \
-     str/cert.acl2
-
-
-str/fast-cat.cert : acl2x = 0
-str/fast-cat.cert : no_pcert = 0
-
-str/fast-cat.cert : \
-     str/cat.cert \
-     str/portcullis.cert \
-     str/fast-cat.lisp \
-     str/fast-cat.acl2 \
-     str/cert.acl2
-
-
-str/firstn-chars.cert : acl2x = 0
-str/firstn-chars.cert : no_pcert = 0
-
-str/firstn-chars.cert : \
-     str/eqv.cert \
-     str/arithmetic.cert \
-     std/lists/take.cert \
-     str/portcullis.cert \
-     str/firstn-chars.lisp \
-     str/cert.acl2
-
-
-str/hexify.cert : acl2x = 0
-str/hexify.cert : no_pcert = 0
-
-str/hexify.cert : \
-     tools/bstar.cert \
-     std/ks/explode-atom.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/hexify.lisp \
-     str/cert.acl2
-
-
-str/html-encode.cert : acl2x = 0
-str/html-encode.cert : no_pcert = 0
-
-str/html-encode.cert : \
-     str/cat.cert \
-     tools/bstar.cert \
-     misc/assert.cert \
-     str/arithmetic.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     str/portcullis.cert \
-     str/html-encode.lisp \
-     str/cert.acl2
-
-
-str/ieqv.cert : acl2x = 0
-str/ieqv.cert : no_pcert = 0
-
-str/ieqv.cert : \
-     str/char-case.cert \
-     std/lists/nthcdr.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/ieqv.lisp \
-     str/cert.acl2
-
-
-str/iless.cert : acl2x = 0
-str/iless.cert : no_pcert = 0
-
-str/iless.cert : \
-     str/ieqv.cert \
-     std/lists/nthcdr.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/iless.lisp \
-     str/cert.acl2
-
-
-str/iprefixp.cert : acl2x = 0
-str/iprefixp.cert : no_pcert = 0
-
-str/iprefixp.cert : \
-     str/ieqv.cert \
-     std/lists/prefixp.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/iprefixp.lisp \
-     str/cert.acl2
-
-
-str/isort.cert : acl2x = 0
-str/isort.cert : no_pcert = 0
-
-str/isort.cert : \
-     str/iless.cert \
-     defsort/defsort.cert \
-     std/lists/list-fix.cert \
-     str/portcullis.cert \
-     str/isort.lisp \
-     str/cert.acl2
-
-
-str/istrpos.cert : acl2x = 0
-str/istrpos.cert : no_pcert = 0
-
-str/istrpos.cert : \
-     str/iprefixp.cert \
-     str/istrprefixp.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/istrpos.lisp \
-     str/cert.acl2
-
-
-str/istrprefixp.cert : acl2x = 0
-str/istrprefixp.cert : no_pcert = 0
-
-str/istrprefixp.cert : \
-     str/ieqv.cert \
-     str/iprefixp.cert \
-     std/lists/nthcdr.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/istrprefixp.lisp \
-     str/cert.acl2
-
-
-str/isubstrp.cert : acl2x = 0
-str/isubstrp.cert : no_pcert = 0
-
-str/isubstrp.cert : \
-     str/istrpos.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/isubstrp.lisp \
-     str/cert.acl2
-
-
-str/natstr.cert : acl2x = 0
-str/natstr.cert : no_pcert = 0
-
-str/natstr.cert : \
-     str/digitp.cert \
-     arithmetic/nat-listp.cert \
-     std/lists/revappend.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     std/lists/rev.cert \
-     std/lists/coerce.cert \
-     str/portcullis.cert \
-     str/natstr.lisp \
-     str/cert.acl2
-
-
-str/pad.cert : acl2x = 0
-str/pad.cert : no_pcert = 0
-
-str/pad.cert : \
-     str/cat.cert \
-     std/lists/take.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/pad.lisp \
-     str/cert.acl2
-
-
-str/portcullis.cert : acl2x = 0
-str/portcullis.cert : no_pcert = 0
-
-str/portcullis.cert : \
-     str/portcullis.lisp \
-     str/portcullis.acl2 \
-     str/package.lsp \
-     xdoc/package.lsp
-
-
-str/prefix-lines.cert : acl2x = 0
-str/prefix-lines.cert : no_pcert = 0
-
-str/prefix-lines.cert : \
-     str/cat.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/prefix-lines.lisp \
-     str/cert.acl2
-
-
-str/stringify.cert : acl2x = 0
-str/stringify.cert : no_pcert = 0
-
-str/stringify.cert : \
-     str/natstr.cert \
-     str/portcullis.cert \
-     str/stringify.lisp \
-     str/cert.acl2
-
-
-str/strline.cert : acl2x = 0
-str/strline.cert : no_pcert = 0
-
-str/strline.cert : \
-     xdoc/top.cert \
-     misc/assert.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/strline.lisp \
-     str/cert.acl2
-
-
-str/strnatless.cert : acl2x = 0
-str/strnatless.cert : no_pcert = 0
-
-str/strnatless.cert : \
-     str/digitp.cert \
-     tools/mv-nth.cert \
-     tools/bstar.cert \
-     str/arithmetic.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     str/portcullis.cert \
-     str/strnatless.lisp \
-     str/cert.acl2
-
-
-str/strpos.cert : acl2x = 0
-str/strpos.cert : no_pcert = 0
-
-str/strpos.cert : \
-     misc/definline.cert \
-     str/strprefixp.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/strpos.lisp \
-     str/cert.acl2
-
-
-str/strprefixp.cert : acl2x = 0
-str/strprefixp.cert : no_pcert = 0
-
-str/strprefixp.cert : \
-     misc/definline.cert \
-     xdoc/top.cert \
-     std/lists/prefixp.cert \
-     std/lists/nthcdr.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/strprefixp.lisp \
-     str/cert.acl2
-
-
-str/strrpos.cert : acl2x = 0
-str/strrpos.cert : no_pcert = 0
-
-str/strrpos.cert : \
-     str/strprefixp.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/strrpos.lisp \
-     str/cert.acl2
-
-
-str/strsplit.cert : acl2x = 0
-str/strsplit.cert : no_pcert = 0
-
-str/strsplit.cert : \
-     str/arithmetic.cert \
-     tools/mv-nth.cert \
-     misc/assert.cert \
-     str/portcullis.cert \
-     str/strsplit.lisp \
-     str/cert.acl2
-
-
-str/strsubst.cert : acl2x = 0
-str/strsubst.cert : no_pcert = 0
-
-str/strsubst.cert : \
-     str/cat.cert \
-     str/strprefixp.cert \
-     misc/assert.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/strsubst.lisp \
-     str/cert.acl2
-
-
-str/strtok.cert : acl2x = 0
-str/strtok.cert : no_pcert = 0
-
-str/strtok.cert : \
-     str/cat.cert \
-     misc/assert.cert \
-     str/arithmetic.cert \
-     std/lists/revappend.cert \
-     str/portcullis.cert \
-     str/strtok.lisp \
-     str/cert.acl2
-
-
-str/strval.cert : acl2x = 0
-str/strval.cert : no_pcert = 0
-
-str/strval.cert : \
-     str/strnatless.cert \
-     misc/definline.cert \
-     str/arithmetic.cert \
-     misc/assert.cert \
-     str/portcullis.cert \
-     str/strval.lisp \
-     str/cert.acl2
-
-
-str/subseq.cert : acl2x = 0
-str/subseq.cert : no_pcert = 0
-
-str/subseq.cert : \
-     str/arithmetic.cert \
-     std/lists/take.cert \
-     std/lists/nthcdr.cert \
-     std/lists/coerce.cert \
-     str/portcullis.cert \
-     str/subseq.lisp \
-     str/cert.acl2
-
-
-str/substrp.cert : acl2x = 0
-str/substrp.cert : no_pcert = 0
-
-str/substrp.cert : \
-     str/strpos.cert \
-     str/arithmetic.cert \
-     str/portcullis.cert \
-     str/substrp.lisp \
-     str/cert.acl2
-
-
-str/suffixp.cert : acl2x = 0
-str/suffixp.cert : no_pcert = 0
-
-str/suffixp.cert : \
-     str/strprefixp.cert \
-     misc/assert.cert \
-     str/portcullis.cert \
-     str/suffixp.lisp \
-     str/cert.acl2
-
-
-str/top.cert : acl2x = 0
-str/top.cert : no_pcert = 0
-
-str/top.cert : \
-     str/case-conversion.cert \
-     str/cat.cert \
-     str/digitp.cert \
-     str/eqv.cert \
-     str/firstn-chars.cert \
-     str/html-encode.cert \
-     str/ieqv.cert \
-     str/iprefixp.cert \
-     str/iless.cert \
-     str/isort.cert \
-     str/istrpos.cert \
-     str/istrprefixp.cert \
-     str/isubstrp.cert \
-     str/natstr.cert \
-     str/strline.cert \
-     str/pad.cert \
-     str/prefix-lines.cert \
-     str/strpos.cert \
-     str/strrpos.cert \
-     str/strprefixp.cert \
-     str/strnatless.cert \
-     str/strsplit.cert \
-     str/strsubst.cert \
-     str/strtok.cert \
-     str/strval.cert \
-     str/substrp.cert \
-     str/subseq.cert \
-     str/suffixp.cert \
-     str/portcullis.cert \
-     str/top.lisp \
-     str/cert.acl2
-
-
-symbolic/generic/assertions.cert : acl2x = 0
-symbolic/generic/assertions.cert : no_pcert = 0
-
-symbolic/generic/assertions.cert : \
-     ordinals/ordinals.cert \
-     misc/defpun.cert \
-     symbolic/generic/assertions.lisp
-
-
-symbolic/generic/defsimulate.cert : acl2x = 0
-symbolic/generic/defsimulate.cert : no_pcert = 0
-
-symbolic/generic/defsimulate.cert : \
-     symbolic/generic/assertions.cert \
-     symbolic/generic/measures.cert \
-     symbolic/generic/partial-correctness.cert \
-     symbolic/generic/total-correctness.cert \
-     ordinals/ordinals-without-arithmetic.cert \
-     misc/defpun.cert \
-     symbolic/generic/assertions.cert \
-     symbolic/generic/partial-correctness.cert \
-     symbolic/generic/assertions.cert \
-     symbolic/generic/measures.cert \
-     symbolic/generic/total-correctness.cert \
-     symbolic/generic/defsimulate.lisp
-
-
-symbolic/generic/factorial-jvm-correct.cert : acl2x = 0
-symbolic/generic/factorial-jvm-correct.cert : no_pcert = 0
-
-symbolic/generic/factorial-jvm-correct.cert : \
-     symbolic/m5/demo.cert \
-     ordinals/ordinals.cert \
-     symbolic/generic/defsimulate.cert \
-     symbolic/m5/utilities.cert \
-     symbolic/generic/factorial-jvm-correct.lisp \
-     symbolic/generic/factorial-jvm-correct.acl2
-
-
-symbolic/generic/measures.cert : acl2x = 0
-symbolic/generic/measures.cert : no_pcert = 0
-
-symbolic/generic/measures.cert : \
-     misc/defpun.cert \
-     ordinals/ordinals.cert \
-     arithmetic-2/meta/top.cert \
-     symbolic/generic/measures.lisp
-
-
-symbolic/generic/partial-correctness.cert : acl2x = 0
-symbolic/generic/partial-correctness.cert : no_pcert = 0
-
-symbolic/generic/partial-correctness.cert : \
-     misc/defpun.cert \
-     ordinals/ordinals.cert \
-     symbolic/generic/partial-correctness.lisp
-
-
-symbolic/generic/tiny-fib-correct.cert : acl2x = 0
-symbolic/generic/tiny-fib-correct.cert : no_pcert = 0
-
-symbolic/generic/tiny-fib-correct.cert : \
-     symbolic/tiny-fib/tiny-rewrites.cert \
-     symbolic/tiny-fib/fib-def.cert \
-     ordinals/ordinals.cert \
-     symbolic/generic/defsimulate.cert \
-     symbolic/generic/tiny-fib-correct.lisp
-
-
-symbolic/generic/total-correctness.cert : acl2x = 0
-symbolic/generic/total-correctness.cert : no_pcert = 0
-
-symbolic/generic/total-correctness.cert : \
-     misc/defpun.cert \
-     ordinals/ordinals-without-arithmetic.cert \
-     arithmetic/top-with-meta.cert \
-     symbolic/generic/total-correctness.lisp
-
-
-symbolic/m5/demo.cert : acl2x = 0
-symbolic/m5/demo.cert : no_pcert = 0
-
-symbolic/m5/demo.cert : \
-     symbolic/m5/utilities.cert \
-     symbolic/m5/utilities.cert \
-     symbolic/m5/demo.lisp \
-     symbolic/m5/demo.acl2
-
-
-symbolic/m5/utilities.cert : acl2x = 0
-symbolic/m5/utilities.cert : no_pcert = 0
-
-symbolic/m5/utilities.cert : \
-     models/jvm/m5/m5.cert \
-     arithmetic/top-with-meta.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     models/jvm/m5/m5.cert \
-     symbolic/m5/utilities.lisp \
-     symbolic/m5/utilities.acl2
-
-
-symbolic/tiny-fib/defstobj+.cert : acl2x = 0
-symbolic/tiny-fib/defstobj+.cert : no_pcert = 0
-
-symbolic/tiny-fib/defstobj+.cert : \
-     arithmetic-2/meta/top.cert \
-     symbolic/tiny-fib/defstobj+.lisp
-
-
-symbolic/tiny-fib/fib-def.cert : acl2x = 0
-symbolic/tiny-fib/fib-def.cert : no_pcert = 0
-
-symbolic/tiny-fib/fib-def.cert : \
-     symbolic/tiny-fib/tiny.cert \
-     symbolic/tiny-fib/fib-def.lisp
-
-
-symbolic/tiny-fib/tiny-rewrites.cert : acl2x = 0
-symbolic/tiny-fib/tiny-rewrites.cert : no_pcert = 0
-
-symbolic/tiny-fib/tiny-rewrites.cert : \
-     symbolic/tiny-fib/tiny.cert \
-     arithmetic/top-with-meta.cert \
-     symbolic/tiny-fib/tiny-rewrites.lisp
-
-
-symbolic/tiny-fib/tiny.cert : acl2x = 0
-symbolic/tiny-fib/tiny.cert : no_pcert = 0
-
-symbolic/tiny-fib/tiny.cert : \
-     symbolic/tiny-fib/defstobj+.cert \
-     arithmetic/top-with-meta.cert \
-     data-structures/list-defthms.cert \
-     ihs/logops-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     symbolic/tiny-fib/tiny.lisp
-
-
-symbolic/tiny-triangle/tiny-triangle-correct.cert : acl2x = 0
-symbolic/tiny-triangle/tiny-triangle-correct.cert : no_pcert = 0
-
-symbolic/tiny-triangle/tiny-triangle-correct.cert : \
-     symbolic/tiny-fib/tiny-rewrites.cert \
-     ordinals/ordinals.cert \
-     symbolic/tiny-triangle/triangle-def.cert \
-     symbolic/generic/defsimulate.cert \
-     symbolic/tiny-triangle/tiny-triangle-correct.lisp
-
-
-symbolic/tiny-triangle/triangle-def.cert : acl2x = 0
-symbolic/tiny-triangle/triangle-def.cert : no_pcert = 0
-
-symbolic/tiny-triangle/triangle-def.cert : \
-     symbolic/tiny-fib/tiny.cert \
-     symbolic/tiny-triangle/triangle-def.lisp
-
-
-system/compare-out-files.cert : acl2x = 0
-system/compare-out-files.cert : no_pcert = 0
-
-system/compare-out-files.cert : \
-     system/compare-out-files.lisp
-
-
-system/convert-normalized-term-to-pairs.cert : acl2x = 0
-system/convert-normalized-term-to-pairs.cert : no_pcert = 0
-
-system/convert-normalized-term-to-pairs.cert : \
-     system/convert-normalized-term-to-pairs.lisp
-
-
-system/extend-pathname.cert : acl2x = 0
-system/extend-pathname.cert : no_pcert = 0
-
-system/extend-pathname.cert : \
-     system/extend-pathname.lisp
-
-
-system/f-put-global.cert : acl2x = 0
-system/f-put-global.cert : no_pcert = 0
-
-system/f-put-global.cert : \
-     system/f-put-global.lisp
-
-
-system/gather-dcls.cert : acl2x = 0
-system/gather-dcls.cert : no_pcert = 0
-
-system/gather-dcls.cert : \
-     system/gather-dcls.lisp
-
-
-system/hl-addr-combine.cert : acl2x = 0
-system/hl-addr-combine.cert : no_pcert = 0
-
-system/hl-addr-combine.cert : \
-     arithmetic-5/top.cert \
-     system/hl-addr-combine.lisp
-
-
-system/io.cert : acl2x = 0
-system/io.cert : no_pcert = 0
-
-system/io.cert : \
-     std/io/base.cert \
-     system/io.lisp
-
-
-system/legal-variablep.cert : acl2x = 0
-system/legal-variablep.cert : no_pcert = 0
-
-system/legal-variablep.cert : \
-     system/legal-variablep.lisp
-
-
-system/meta-extract.cert : acl2x = 0
-system/meta-extract.cert : no_pcert = 0
-
-system/meta-extract.cert : \
-     system/sublis-var.cert \
-     system/meta-extract.lisp
-
-
-system/pseudo-good-worldp.cert : acl2x = 0
-system/pseudo-good-worldp.cert : no_pcert = 0
-
-system/pseudo-good-worldp.cert : \
-     system/pseudo-good-worldp.lisp
-
-
-system/pseudo-termp-lemmas.cert : acl2x = 0
-system/pseudo-termp-lemmas.cert : no_pcert = 0
-
-system/pseudo-termp-lemmas.cert : \
-     system/pseudo-termp-lemmas.lisp
-
-
-system/subcor-var.cert : acl2x = 0
-system/subcor-var.cert : no_pcert = 0
-
-system/subcor-var.cert : \
-     system/sublis-var.cert \
-     system/pseudo-termp-lemmas.cert \
-     system/subcor-var.lisp
-
-
-system/sublis-var.cert : acl2x = 0
-system/sublis-var.cert : no_pcert = 0
-
-system/sublis-var.cert : \
-     system/sublis-var.lisp
-
-
-system/subst-expr.cert : acl2x = 0
-system/subst-expr.cert : no_pcert = 0
-
-system/subst-expr.cert : \
-     system/sublis-var.cert \
-     system/pseudo-termp-lemmas.cert \
-     system/subst-var.cert \
-     system/subst-expr.lisp
-
-
-system/subst-var.cert : acl2x = 0
-system/subst-var.cert : no_pcert = 0
-
-system/subst-var.cert : \
-     system/sublis-var.cert \
-     system/pseudo-termp-lemmas.cert \
-     system/subst-var.lisp
-
-
-system/too-many-ifs.cert : acl2x = 0
-system/too-many-ifs.cert : no_pcert = 0
-
-system/too-many-ifs.cert : \
-     tools/flag.cert \
-     arithmetic/top-with-meta.cert \
-     tools/flag.cert \
-     system/too-many-ifs.lisp \
-     system/too-many-ifs.acl2
-
-
-system/top.cert : acl2x = 0
-system/top.cert : no_pcert = 0
-
-system/top.cert : \
-     system/hl-addr-combine.cert \
-     system/extend-pathname.cert \
-     system/too-many-ifs.cert \
-     system/verified-termination-and-guards.cert \
-     system/sublis-var.cert \
-     system/subcor-var.cert \
-     system/subst-expr.cert \
-     system/convert-normalized-term-to-pairs.cert \
-     system/gather-dcls.cert \
-     system/meta-extract.cert \
-     system/legal-variablep.cert \
-     system/top.lisp
-
-
-system/update-state.cert : acl2x = 0
-system/update-state.cert : no_pcert = 0
-
-system/update-state.cert : \
-     system/update-state.lisp
-
-
-system/verified-termination-and-guards.cert : acl2x = 0
-system/verified-termination-and-guards.cert : no_pcert = 0
-
-system/verified-termination-and-guards.cert : \
-     system/verified-termination-and-guards.lisp
-
-
-system/worldp-check.cert : acl2x = 0
-system/worldp-check.cert : no_pcert = 0
-
-system/worldp-check.cert : \
-     system/pseudo-good-worldp.cert \
-     system/worldp-check.lisp \
-     system/worldp-check.acl2
-
-
-taspi/code/brlens/brlens.cert : acl2x = 0
-taspi/code/brlens/brlens.cert : no_pcert = 0
-
-taspi/code/brlens/brlens.cert : \
-     taspi/code/gen-helper/extra.cert \
-     taspi/code/brlens/brlens.lisp
-
-
-taspi/code/brlens/trees-with-brlens.cert : acl2x = 0
-taspi/code/brlens/trees-with-brlens.cert : no_pcert = 0
-
-taspi/code/brlens/trees-with-brlens.cert : \
-     taspi/code/brlens/brlens.cert \
-     taspi/code/gen-trees/tree-predicates.cert \
-     taspi/code/brlens/trees-with-brlens.lisp
-
-
-taspi/code/build/build-term-guards.cert : acl2x = 0
-taspi/code/build/build-term-guards.cert : no_pcert = 0
-
-taspi/code/build/build-term-guards.cert : \
-     taspi/code/build/build-term.cert \
-     taspi/code/fringes/fringes-guards.cert \
-     taspi/code/build/build-term-guards.lisp
-
-
-taspi/code/build/build-term.cert : acl2x = 0
-taspi/code/build/build-term.cert : no_pcert = 0
-
-taspi/code/build/build-term.cert : \
-     taspi/code/fringes/fringes.cert \
-     taspi/code/build/build-term.lisp
-
-
-taspi/code/fringes/fringes-guards.cert : acl2x = 0
-taspi/code/fringes/fringes-guards.cert : no_pcert = 0
-
-taspi/code/fringes/fringes-guards.cert : \
-     taspi/code/fringes/fringes.cert \
-     taspi/code/replete/replete-guards.cert \
-     taspi/code/gen-trees/btrees-bdds-sets.cert \
-     taspi/code/gen-trees/app-rev-lists.cert \
-     taspi/code/fringes/fringes-guards.lisp
-
-
-taspi/code/fringes/fringes-props.cert : acl2x = 0
-taspi/code/fringes/fringes-props.cert : no_pcert = 0
-
-taspi/code/fringes/fringes-props.cert : \
-     taspi/code/fringes/fringes-guards.cert \
-     taspi/code/fringes/fringes-props.lisp
-
-
-taspi/code/fringes/fringes.cert : acl2x = 0
-taspi/code/fringes/fringes.cert : no_pcert = 0
-
-taspi/code/fringes/fringes.cert : \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/code/replete/replete.cert \
-     taspi/code/gen-trees/btrees-bdds.cert \
-     taspi/code/fringes/fringes.lisp
-
-
-taspi/code/gen-helper/bdd-functions.cert : acl2x = 0
-taspi/code/gen-helper/bdd-functions.cert : no_pcert = 0
-
-taspi/code/gen-helper/bdd-functions.cert : \
-     taspi/code/gen-helper/sets.cert \
-     taspi/code/gen-helper/bdd-functions.lisp
-
-
-taspi/code/gen-helper/extra.cert : acl2x = 0
-taspi/code/gen-helper/extra.cert : no_pcert = 0
-
-taspi/code/gen-helper/extra.cert : \
-     misc/hons-help2.cert \
-     taspi/code/gen-helper/extra.lisp
-
-
-taspi/code/gen-helper/fast-lists.cert : acl2x = 0
-taspi/code/gen-helper/fast-lists.cert : no_pcert = 0
-
-taspi/code/gen-helper/fast-lists.cert : \
-     taspi/code/gen-helper/extra.cert \
-     taspi/code/gen-helper/fast-lists.lisp
-
-
-taspi/code/gen-helper/sets.cert : acl2x = 0
-taspi/code/gen-helper/sets.cert : no_pcert = 0
-
-taspi/code/gen-helper/sets.cert : \
-     taspi/code/gen-helper/extra.cert \
-     taspi/code/gen-helper/sets.lisp
-
-
-taspi/code/gen-helper/top.cert : acl2x = 0
-taspi/code/gen-helper/top.cert : no_pcert = 0
-
-taspi/code/gen-helper/top.cert : \
-     taspi/code/gen-helper/sets.cert \
-     taspi/code/gen-helper/fast-lists.cert \
-     taspi/code/gen-helper/bdd-functions.cert \
-     taspi/code/gen-helper/top.lisp
-
-
-taspi/code/gen-trees/app-rev-lists.cert : acl2x = 0
-taspi/code/gen-trees/app-rev-lists.cert : no_pcert = 0
-
-taspi/code/gen-trees/app-rev-lists.cert : \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/code/gen-trees/app-rev-lists.lisp
-
-
-taspi/code/gen-trees/btrees-bdds-sets.cert : acl2x = 0
-taspi/code/gen-trees/btrees-bdds-sets.cert : no_pcert = 0
-
-taspi/code/gen-trees/btrees-bdds-sets.cert : \
-     taspi/code/gen-trees/btrees-bdds.cert \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/code/gen-trees/btrees-bdds-sets.lisp
-
-
-taspi/code/gen-trees/btrees-bdds.cert : acl2x = 0
-taspi/code/gen-trees/btrees-bdds.cert : no_pcert = 0
-
-taspi/code/gen-trees/btrees-bdds.cert : \
-     taspi/code/gen-helper/extra.cert \
-     taspi/code/gen-trees/btrees.cert \
-     taspi/code/gen-helper/bdd-functions.cert \
-     taspi/code/gen-trees/btrees-bdds.lisp
-
-
-taspi/code/gen-trees/btrees.cert : acl2x = 0
-taspi/code/gen-trees/btrees.cert : no_pcert = 0
-
-taspi/code/gen-trees/btrees.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     taspi/code/gen-helper/fast-lists.cert \
-     taspi/code/gen-trees/btrees.lisp
-
-
-taspi/code/gen-trees/sets-lists-trees.cert : acl2x = 0
-taspi/code/gen-trees/sets-lists-trees.cert : no_pcert = 0
-
-taspi/code/gen-trees/sets-lists-trees.cert : \
-     taspi/code/gen-helper/sets.cert \
-     taspi/code/gen-helper/fast-lists.cert \
-     taspi/code/gen-trees/tree-predicates.cert \
-     taspi/code/gen-trees/sets-lists-trees.lisp
-
-
-taspi/code/gen-trees/top.cert : acl2x = 0
-taspi/code/gen-trees/top.cert : no_pcert = 0
-
-taspi/code/gen-trees/top.cert : \
-     taspi/code/gen-trees/btrees-bdds-sets.cert \
-     taspi/code/gen-trees/app-rev-lists.cert \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/code/gen-trees/tree-predicates.cert \
-     taspi/code/gen-trees/top.lisp
-
-
-taspi/code/gen-trees/tree-predicates.cert : acl2x = 0
-taspi/code/gen-trees/tree-predicates.cert : no_pcert = 0
-
-taspi/code/gen-trees/tree-predicates.cert : \
-     arithmetic-3/bind-free/top.cert \
-     taspi/code/gen-helper/extra.cert \
-     taspi/code/gen-trees/tree-predicates.lisp
-
-
-taspi/code/replete/replete-guards.cert : acl2x = 0
-taspi/code/replete/replete-guards.cert : no_pcert = 0
-
-taspi/code/replete/replete-guards.cert : \
-     taspi/code/replete/replete.cert \
-     taspi/code/brlens/trees-with-brlens.cert \
-     taspi/code/replete/replete-guards.lisp
-
-
-taspi/code/replete/replete-helper.cert : acl2x = 0
-taspi/code/replete/replete-helper.cert : no_pcert = 0
-
-taspi/code/replete/replete-helper.cert : \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/code/replete/replete-helper.lisp
-
-
-taspi/code/replete/replete.cert : acl2x = 0
-taspi/code/replete/replete.cert : no_pcert = 0
-
-taspi/code/replete/replete.cert : \
-     taspi/code/replete/replete-helper.cert \
-     taspi/code/replete/replete.lisp
-
-
-taspi/code/sequences/align.cert : acl2x = 0
-taspi/code/sequences/align.cert : no_pcert = 0
-
-taspi/code/sequences/align.cert : \
-     taspi/code/gen-helper/extra.cert \
-     taspi/code/sequences/align.lisp
-
-
-taspi/code/sequences/p-inform.cert : acl2x = 0
-taspi/code/sequences/p-inform.cert : no_pcert = 0
-
-taspi/code/sequences/p-inform.cert : \
-     taspi/code/sequences/seqs.cert \
-     taspi/code/sequences/p-inform.lisp
-
-
-taspi/code/sequences/seqs.cert : acl2x = 0
-taspi/code/sequences/seqs.cert : no_pcert = 0
-
-taspi/code/sequences/seqs.cert : \
-     misc/hons-help2.cert \
-     taspi/code/gen-trees/top.cert \
-     taspi/code/sequences/seqs.lisp
-
-
-taspi/code/tree-manip/insertion-based-sort.cert : acl2x = 0
-taspi/code/tree-manip/insertion-based-sort.cert : no_pcert = 0
-
-taspi/code/tree-manip/insertion-based-sort.cert : \
-     taspi/code/tree-manip/sort-help.cert \
-     taspi/code/tree-manip/insertion-based-sort.lisp
-
-
-taspi/code/tree-manip/merge-based-sort.cert : acl2x = 0
-taspi/code/tree-manip/merge-based-sort.cert : no_pcert = 0
-
-taspi/code/tree-manip/merge-based-sort.cert : \
-     taspi/code/tree-manip/sort-help.cert \
-     taspi/code/tree-manip/merge-based-sort.lisp
-
-
-taspi/code/tree-manip/mv-root.cert : acl2x = 0
-taspi/code/tree-manip/mv-root.cert : no_pcert = 0
-
-taspi/code/tree-manip/mv-root.cert : \
-     taspi/code/build/build-term-guards.cert \
-     taspi/code/tree-manip/mv-root.lisp
-
-
-taspi/code/tree-manip/quicksort.cert : acl2x = 0
-taspi/code/tree-manip/quicksort.cert : no_pcert = 0
-
-taspi/code/tree-manip/quicksort.cert : \
-     taspi/code/tree-manip/quicksort.lisp
-
-
-taspi/code/tree-manip/sort-help.cert : acl2x = 0
-taspi/code/tree-manip/sort-help.cert : no_pcert = 0
-
-taspi/code/tree-manip/sort-help.cert : \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/code/tree-manip/sort-help.lisp
-
-
-taspi/code/tree-manip/top.cert : acl2x = 0
-taspi/code/tree-manip/top.cert : no_pcert = 0
-
-taspi/code/tree-manip/top.cert : \
-     taspi/code/tree-manip/mv-root.cert \
-     taspi/code/tree-manip/merge-based-sort.cert \
-     taspi/code/tree-manip/insertion-based-sort.cert \
-     taspi/code/tree-manip/top.lisp
-
-
-taspi/database/db-from-list.cert : acl2x = 0
-taspi/database/db-from-list.cert : no_pcert = 0
-
-taspi/database/db-from-list.cert : \
-     taspi/database/db-from-list.lisp
-
-
-taspi/database/db.cert : acl2x = 0
-taspi/database/db.cert : no_pcert = 0
-
-taspi/database/db.cert : \
-     taspi/database/entry.cert \
-     taspi/code/tree-manip/top.cert \
-     taspi/database/db.lisp
-
-
-taspi/database/entry.cert : acl2x = 0
-taspi/database/entry.cert : no_pcert = 0
-
-taspi/database/entry.cert : \
-     taspi/database/props.cert \
-     taspi/database/entry.lisp
-
-
-taspi/database/filters.cert : acl2x = 0
-taspi/database/filters.cert : no_pcert = 0
-
-taspi/database/filters.cert : \
-     taspi/database/db.cert \
-     taspi/database/filters.lisp
-
-
-taspi/database/props.cert : acl2x = 0
-taspi/database/props.cert : no_pcert = 0
-
-taspi/database/props.cert : \
-     misc/hons-help2.cert \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/code/gen-trees/app-rev-lists.cert \
-     taspi/code/tree-manip/sort-help.cert \
-     taspi/database/props.lisp
-
-
-taspi/proofs/fringes-taspi.cert : acl2x = 0
-taspi/proofs/fringes-taspi.cert : no_pcert = 0
-
-taspi/proofs/fringes-taspi.cert : \
-     taspi/proofs/omerge-good-order.cert \
-     taspi/proofs/fringes-taspi.lisp \
-     taspi/proofs/fringes-taspi.acl2
-
-
-taspi/proofs/omerge-good-order.cert : acl2x = 0
-taspi/proofs/omerge-good-order.cert : no_pcert = 0
-
-taspi/proofs/omerge-good-order.cert : \
-     taspi/proofs/sets.cert \
-     taspi/proofs/omerge-good-order.lisp \
-     taspi/proofs/omerge-good-order.acl2
-
-
-taspi/proofs/sets.cert : acl2x = 0
-taspi/proofs/sets.cert : no_pcert = 0
-
-taspi/proofs/sets.cert : \
-     taspi/proofs/sets.lisp \
-     taspi/proofs/sets.acl2
-
-
-taspi/sets-input/consensus.cert : acl2x = 0
-taspi/sets-input/consensus.cert : no_pcert = 0
-
-taspi/sets-input/consensus.cert : \
-     taspi/code/build/build-term-guards.cert \
-     taspi/code/gen-trees/btrees-bdds.cert \
-     taspi/sets-input/consensus.lisp
-
-
-taspi/sets-input/greedy.cert : acl2x = 0
-taspi/sets-input/greedy.cert : no_pcert = 0
-
-taspi/sets-input/greedy.cert : \
-     taspi/sets-input/consensus.cert \
-     taspi/sets-input/greedy.lisp
-
-
-taspi/sets-input/mast.cert : acl2x = 0
-taspi/sets-input/mast.cert : no_pcert = 0
-
-taspi/sets-input/mast.cert : \
-     taspi/single-input/taxa-based.cert \
-     taspi/sets-input/mast.lisp
-
-
-taspi/sets-input/mct.cert : acl2x = 0
-taspi/sets-input/mct.cert : no_pcert = 0
-
-taspi/sets-input/mct.cert : \
-     taspi/sets-input/mast.cert \
-     taspi/code/build/build-term-guards.cert \
-     taspi/sets-input/mct.lisp
-
-
-taspi/sets-input/multipolar-loose.cert : acl2x = 0
-taspi/sets-input/multipolar-loose.cert : no_pcert = 0
-
-taspi/sets-input/multipolar-loose.cert : \
-     taspi/sets-input/consensus.cert \
-     taspi/sets-input/multipolar-loose.lisp
-
-
-taspi/sets-input/top.cert : acl2x = 0
-taspi/sets-input/top.cert : no_pcert = 0
-
-taspi/sets-input/top.cert : \
-     taspi/sets-input/consensus.cert \
-     taspi/sets-input/tree-compat.cert \
-     taspi/sets-input/tree-support-in-set.cert \
-     taspi/sets-input/mast.cert \
-     taspi/sets-input/multipolar-loose.cert \
-     taspi/sets-input/greedy.cert \
-     taspi/sets-input/mct.cert \
-     taspi/sets-input/top.lisp
-
-
-taspi/sets-input/tree-compat.cert : acl2x = 0
-taspi/sets-input/tree-compat.cert : no_pcert = 0
-
-taspi/sets-input/tree-compat.cert : \
-     taspi/code/build/build-term-guards.cert \
-     taspi/code/gen-trees/btrees-bdds.cert \
-     taspi/code/fringes/fringes-props.cert \
-     taspi/sets-input/tree-compat.lisp
-
-
-taspi/sets-input/tree-support-in-set.cert : acl2x = 0
-taspi/sets-input/tree-support-in-set.cert : no_pcert = 0
-
-taspi/sets-input/tree-support-in-set.cert : \
-     taspi/code/build/build-term-guards.cert \
-     taspi/sets-input/tree-support-in-set.lisp
-
-
-taspi/single-input/taxa-based.cert : acl2x = 0
-taspi/single-input/taxa-based.cert : no_pcert = 0
-
-taspi/single-input/taxa-based.cert : \
-     taspi/code/fringes/fringes-guards.cert \
-     taspi/code/tree-manip/merge-based-sort.cert \
-     taspi/code/tree-manip/mv-root.cert \
-     taspi/single-input/taxa-based.lisp
-
-
-taspi/single-input/tree-stats.cert : acl2x = 0
-taspi/single-input/tree-stats.cert : no_pcert = 0
-
-taspi/single-input/tree-stats.cert : \
-     taspi/code/gen-trees/sets-lists-trees.cert \
-     taspi/single-input/taxa-based.cert \
-     taspi/single-input/tree-stats.lisp
-
-
-taspi/tree-distance/rf.cert : acl2x = 0
-taspi/tree-distance/rf.cert : no_pcert = 0
-
-taspi/tree-distance/rf.cert : \
-     taspi/code/fringes/fringes-guards.cert \
-     taspi/database/props.cert \
-     taspi/tree-distance/rf.lisp
-
-
-taspi/tree-distance/symm-diff.cert : acl2x = 0
-taspi/tree-distance/symm-diff.cert : no_pcert = 0
-
-taspi/tree-distance/symm-diff.cert : \
-     taspi/code/fringes/fringes-guards.cert \
-     taspi/database/props.cert \
-     taspi/tree-distance/symm-diff.lisp
-
-
-taspi/tree-generation/branch-and-bound/bandb.cert : acl2x = 0
-taspi/tree-generation/branch-and-bound/bandb.cert : no_pcert = 0
-
-taspi/tree-generation/branch-and-bound/bandb.cert : \
-     taspi/tree-generation/tree-gen-helper/basics.cert \
-     taspi/code/tree-manip/top.cert \
-     taspi/tree-generation/branch-and-bound/bandb.lisp
-
-
-taspi/tree-generation/distance-based/naive-quartet-method.cert : acl2x = 0
-taspi/tree-generation/distance-based/naive-quartet-method.cert : no_pcert = 0
-
-taspi/tree-generation/distance-based/naive-quartet-method.cert : \
-     taspi/tree-generation/distance-based/naive-quartet-method.lisp
-
-
-taspi/tree-generation/heuristics/do-search.cert : acl2x = 0
-taspi/tree-generation/heuristics/do-search.cert : no_pcert = 0
-
-taspi/tree-generation/heuristics/do-search.cert : \
-     taspi/tree-generation/heuristics/tbr.cert \
-     taspi/tree-generation/heuristics/do-search.lisp
-
-
-taspi/tree-generation/heuristics/spr.cert : acl2x = 0
-taspi/tree-generation/heuristics/spr.cert : no_pcert = 0
-
-taspi/tree-generation/heuristics/spr.cert : \
-     taspi/tree-generation/tree-gen-helper/basics.cert \
-     taspi/code/tree-manip/top.cert \
-     taspi/tree-generation/heuristics/spr.lisp
-
-
-taspi/tree-generation/heuristics/tbr.cert : acl2x = 0
-taspi/tree-generation/heuristics/tbr.cert : no_pcert = 0
-
-taspi/tree-generation/heuristics/tbr.cert : \
-     taspi/tree-generation/heuristics/spr.cert \
-     taspi/tree-generation/heuristics/tbr.lisp
-
-
-taspi/tree-generation/tree-gen-helper/basics.cert : acl2x = 0
-taspi/tree-generation/tree-gen-helper/basics.cert : no_pcert = 0
-
-taspi/tree-generation/tree-gen-helper/basics.cert : \
-     taspi/code/build/build-term-guards.cert \
-     taspi/tree-score/pscores.cert \
-     taspi/tree-generation/tree-gen-helper/basics.lisp
-
-
-taspi/tree-score/ambig-score.cert : acl2x = 0
-taspi/tree-score/ambig-score.cert : no_pcert = 0
-
-taspi/tree-score/ambig-score.cert : \
-     taspi/tree-score/min-length.cert \
-     taspi/tree-score/ambig-score.lisp
-
-
-taspi/tree-score/circle-scoring.cert : acl2x = 0
-taspi/tree-score/circle-scoring.cert : no_pcert = 0
-
-taspi/tree-score/circle-scoring.cert : \
-     taspi/tree-score/min-length.cert \
-     taspi/code/gen-trees/top.cert \
-     taspi/tree-score/circle-scoring.lisp
-
-
-taspi/tree-score/costs.cert : acl2x = 0
-taspi/tree-score/costs.cert : no_pcert = 0
-
-taspi/tree-score/costs.cert : \
-     taspi/code/sequences/seqs.cert \
-     taspi/tree-score/costs.lisp
-
-
-taspi/tree-score/efficient-pscores-help.cert : acl2x = 0
-taspi/tree-score/efficient-pscores-help.cert : no_pcert = 0
-
-taspi/tree-score/efficient-pscores-help.cert : \
-     taspi/tree-score/efficient-pscores-help.lisp
-
-
-taspi/tree-score/efficient-pscores.cert : acl2x = 0
-taspi/tree-score/efficient-pscores.cert : no_pcert = 0
-
-taspi/tree-score/efficient-pscores.cert : \
-     taspi/code/gen-helper/extra.cert \
-     taspi/tree-score/efficient-pscores-help.cert \
-     taspi/tree-score/efficient-pscores.lisp
-
-
-taspi/tree-score/fitch-scoring.cert : acl2x = 0
-taspi/tree-score/fitch-scoring.cert : no_pcert = 0
-
-taspi/tree-score/fitch-scoring.cert : \
-     taspi/tree-score/costs.cert \
-     taspi/tree-score/fitch-scoring.lisp
-
-
-taspi/tree-score/min-length.cert : acl2x = 0
-taspi/tree-score/min-length.cert : no_pcert = 0
-
-taspi/tree-score/min-length.cert : \
-     taspi/tree-score/efficient-pscores.cert \
-     taspi/code/gen-helper/sets.cert \
-     taspi/tree-score/min-length.lisp
-
-
-taspi/tree-score/opt-pairwise.cert : acl2x = 0
-taspi/tree-score/opt-pairwise.cert : no_pcert = 0
-
-taspi/tree-score/opt-pairwise.cert : \
-     taspi/code/sequences/align.cert \
-     taspi/code/gen-helper/extra.cert \
-     taspi/tree-score/opt-pairwise.lisp
-
-
-taspi/tree-score/pscores.cert : acl2x = 0
-taspi/tree-score/pscores.cert : no_pcert = 0
-
-taspi/tree-score/pscores.cert : \
-     taspi/tree-score/costs.cert \
-     taspi/tree-score/pscores.lisp
-
-
-tau/bounders/elementary-bounders.cert : acl2x = 0
-tau/bounders/elementary-bounders.cert : no_pcert = 0
-
-tau/bounders/elementary-bounders.cert : \
-     arithmetic-5/top.cert \
-     tau/bounders/find-minimal-2d.cert \
-     tau/bounders/find-maximal-2d.cert \
-     tau/bounders/elementary-bounders.lisp
-
-
-tau/bounders/find-maximal-1d.cert : acl2x = 0
-tau/bounders/find-maximal-1d.cert : no_pcert = 0
-
-tau/bounders/find-maximal-1d.cert : \
-     tau/bounders/find-maximal-1d.lisp
-
-
-tau/bounders/find-maximal-2d.cert : acl2x = 0
-tau/bounders/find-maximal-2d.cert : no_pcert = 0
-
-tau/bounders/find-maximal-2d.cert : \
-     tau/bounders/find-maximal-2d.lisp
-
-
-tau/bounders/find-minimal-1d.cert : acl2x = 0
-tau/bounders/find-minimal-1d.cert : no_pcert = 0
-
-tau/bounders/find-minimal-1d.cert : \
-     tau/bounders/find-minimal-1d.lisp
-
-
-tau/bounders/find-minimal-2d.cert : acl2x = 0
-tau/bounders/find-minimal-2d.cert : no_pcert = 0
-
-tau/bounders/find-minimal-2d.cert : \
-     tau/bounders/find-minimal-2d.lisp
-
-
-textbook/chap10/ac-example.cert : acl2x = 0
-textbook/chap10/ac-example.cert : no_pcert = 0
-
-textbook/chap10/ac-example.cert : \
-     textbook/chap10/ac-example.lisp
-
-
-textbook/chap10/adder.cert : acl2x = 0
-textbook/chap10/adder.cert : no_pcert = 0
-
-textbook/chap10/adder.cert : \
-     textbook/chap10/adder.lisp
-
-
-textbook/chap10/compiler.cert : acl2x = 0
-textbook/chap10/compiler.cert : no_pcert = 0
-
-textbook/chap10/compiler.cert : \
-     textbook/chap10/compiler.lisp \
-     textbook/chap10/compiler.acl2
-
-
-textbook/chap10/fact.cert : acl2x = 0
-textbook/chap10/fact.cert : no_pcert = 0
-
-textbook/chap10/fact.cert : \
-     textbook/chap10/fact.lisp
-
-
-textbook/chap10/insertion-sort.cert : acl2x = 0
-textbook/chap10/insertion-sort.cert : no_pcert = 0
-
-textbook/chap10/insertion-sort.cert : \
-     textbook/chap10/insertion-sort.lisp
-
-
-textbook/chap10/tree.cert : acl2x = 0
-textbook/chap10/tree.cert : no_pcert = 0
-
-textbook/chap10/tree.cert : \
-     textbook/chap10/tree.lisp
-
-
-textbook/chap11/compress.cert : acl2x = 0
-textbook/chap11/compress.cert : no_pcert = 0
-
-textbook/chap11/compress.cert : \
-     textbook/chap11/compress.lisp
-
-
-textbook/chap11/encap.cert : acl2x = 0
-textbook/chap11/encap.cert : no_pcert = 0
-
-textbook/chap11/encap.cert : \
-     textbook/chap10/ac-example.cert \
-     textbook/chap11/encap.lisp
-
-
-textbook/chap11/finite-sets.cert : acl2x = 0
-textbook/chap11/finite-sets.cert : no_pcert = 0
-
-textbook/chap11/finite-sets.cert : \
-     ordinals/e0-ordinal.cert \
-     textbook/chap11/finite-sets.lisp
-
-
-textbook/chap11/how-many-soln1.cert : acl2x = 0
-textbook/chap11/how-many-soln1.cert : no_pcert = 0
-
-textbook/chap11/how-many-soln1.cert : \
-     textbook/chap11/perm.cert \
-     arithmetic/top.cert \
-     textbook/chap11/how-many-soln1.lisp
-
-
-textbook/chap11/how-many-soln2.cert : acl2x = 0
-textbook/chap11/how-many-soln2.cert : no_pcert = 0
-
-textbook/chap11/how-many-soln2.cert : \
-     textbook/chap11/perm.cert \
-     textbook/chap11/how-many-soln2.lisp
-
-
-textbook/chap11/mergesort.cert : acl2x = 0
-textbook/chap11/mergesort.cert : no_pcert = 0
-
-textbook/chap11/mergesort.cert : \
-     textbook/chap11/perm.cert \
-     textbook/chap11/perm-append.cert \
-     textbook/chap11/mergesort.lisp
-
-
-textbook/chap11/perm-append.cert : acl2x = 0
-textbook/chap11/perm-append.cert : no_pcert = 0
-
-textbook/chap11/perm-append.cert : \
-     textbook/chap11/perm.cert \
-     textbook/chap11/perm-append.lisp
-
-
-textbook/chap11/perm.cert : acl2x = 0
-textbook/chap11/perm.cert : no_pcert = 0
-
-textbook/chap11/perm.cert : \
-     textbook/chap11/perm.lisp
-
-
-textbook/chap11/qsort.cert : acl2x = 0
-textbook/chap11/qsort.cert : no_pcert = 0
-
-textbook/chap11/qsort.cert : \
-     textbook/chap11/perm-append.cert \
-     textbook/chap11/qsort.lisp
-
-
-textbook/chap11/starters.cert : acl2x = 0
-textbook/chap11/starters.cert : no_pcert = 0
-
-textbook/chap11/starters.cert : \
-     ordinals/e0-ordinal.cert \
-     textbook/chap11/starters.lisp
-
-
-textbook/chap11/summations-book.cert : acl2x = 0
-textbook/chap11/summations-book.cert : no_pcert = 0
-
-textbook/chap11/summations-book.cert : \
-     arithmetic/top-with-meta.cert \
-     textbook/chap11/summations-book.lisp
-
-
-textbook/chap11/summations.cert : acl2x = 0
-textbook/chap11/summations.cert : no_pcert = 0
-
-textbook/chap11/summations.cert : \
-     textbook/chap10/ac-example.cert \
-     textbook/chap11/summations.lisp
-
-
-textbook/chap11/tautology.cert : acl2x = 0
-textbook/chap11/tautology.cert : no_pcert = 0
-
-textbook/chap11/tautology.cert : \
-     ordinals/e0-ordinal.cert \
-     arithmetic/top.cert \
-     textbook/chap11/tautology.lisp
-
-
-textbook/chap11/xtr.cert : acl2x = 0
-textbook/chap11/xtr.cert : no_pcert = 0
-
-textbook/chap11/xtr.cert : \
-     textbook/chap11/xtr.lisp
-
-
-textbook/chap11/xtr2.cert : acl2x = 0
-textbook/chap11/xtr2.cert : no_pcert = 0
-
-textbook/chap11/xtr2.cert : \
-     arithmetic/top-with-meta.cert \
-     textbook/chap11/xtr2.lisp
-
-
-textbook/chap3/programs.cert : acl2x = 0
-textbook/chap3/programs.cert : no_pcert = 0
-
-textbook/chap3/programs.cert : \
-     textbook/chap3/programs.lisp
-
-
-textbook/chap4/solutions-logic-mode.cert : acl2x = 0
-textbook/chap4/solutions-logic-mode.cert : no_pcert = 0
-
-textbook/chap4/solutions-logic-mode.cert : \
-     ihs/ihs-lemmas.cert \
-     textbook/chap4/solutions-logic-mode.lisp
-
-
-textbook/chap4/solutions-program-mode.cert : acl2x = 0
-textbook/chap4/solutions-program-mode.cert : no_pcert = 0
-
-textbook/chap4/solutions-program-mode.cert : \
-     textbook/chap4/solutions-program-mode.lisp
-
-
-textbook/chap5/solutions.cert : acl2x = 0
-textbook/chap5/solutions.cert : no_pcert = 0
-
-textbook/chap5/solutions.cert : \
-     textbook/chap5/solutions.lisp
-
-
-textbook/chap6/selected-solutions.cert : acl2x = 0
-textbook/chap6/selected-solutions.cert : no_pcert = 0
-
-textbook/chap6/selected-solutions.cert : \
-     ordinals/e0-ordinal.cert \
-     arithmetic/top-with-meta.cert \
-     textbook/chap6/selected-solutions.lisp
-
-
-tools/bstar.cert : acl2x = 0
-tools/bstar.cert : no_pcert = 0
-
-tools/bstar.cert : \
-     tools/pack.cert \
-     tools/bstar.lisp
-
-
-tools/case-splitting-rules.cert : acl2x = 0
-tools/case-splitting-rules.cert : no_pcert = 0
-
-tools/case-splitting-rules.cert : \
-     tools/bstar.cert \
-     tools/case-splitting-rules.lisp
-
-
-tools/clone-stobj.cert : acl2x = 0
-tools/clone-stobj.cert : no_pcert = 0
-
-tools/clone-stobj.cert : \
-     tools/bstar.cert \
-     tools/rulesets.cert \
-     tools/templates.cert \
-     xdoc/top.cert \
-     tools/clone-stobj.lisp
-
-
-tools/cws.cert : acl2x = 0
-tools/cws.cert : no_pcert = 0
-
-tools/cws.cert : \
-     tools/cws.lisp
-
-
-tools/def-functional-instance.cert : acl2x = 0
-tools/def-functional-instance.cert : no_pcert = 0
-
-tools/def-functional-instance.cert : \
-     tools/bstar.cert \
-     tools/def-functional-instance.lisp
-
-
-tools/defconsts.cert : acl2x = 0
-tools/defconsts.cert : no_pcert = 0
-
-tools/defconsts.cert : \
-     tools/bstar.cert \
-     tools/defconsts.lisp
-
-
-tools/defevaluator-fast.cert : acl2x = 0
-tools/defevaluator-fast.cert : no_pcert = 0
-
-tools/defevaluator-fast.cert : \
-     tools/defevaluator-fast.lisp
-
-
-tools/define-keyed-function.cert : acl2x = 0
-tools/define-keyed-function.cert : no_pcert = 0
-
-tools/define-keyed-function.cert : \
-     tools/define-keyed-function.lisp
-
-
-tools/defined-const.cert : acl2x = 0
-tools/defined-const.cert : no_pcert = 0
-
-tools/defined-const.cert : \
-     tools/defined-const.lisp
-
-
-tools/defmacfun.cert : acl2x = 0
-tools/defmacfun.cert : no_pcert = 0
-
-tools/defmacfun.cert : \
-     tools/defmacfun.lisp
-
-
-tools/defredundant.cert : acl2x = 0
-tools/defredundant.cert : no_pcert = 0
-
-tools/defredundant.cert : \
-     tools/bstar.cert \
-     tools/defredundant.lisp
-
-
-tools/defsum.cert : acl2x = 0
-tools/defsum.cert : no_pcert = 0
-
-tools/defsum.cert : \
-     tools/pattern-match.cert \
-     tools/types-misc.cert \
-     tools/defsum.lisp
-
-
-tools/deftuple.cert : acl2x = 0
-tools/deftuple.cert : no_pcert = 0
-
-tools/deftuple.cert : \
-     tools/types-misc.cert \
-     tools/bstar.cert \
-     tools/deftuple.lisp
-
-
-tools/do-not.cert : acl2x = 0
-tools/do-not.cert : no_pcert = 0
-
-tools/do-not.cert : \
-     tools/bstar.cert \
-     tools/do-not.lisp
-
-
-tools/easy-simplify.cert : acl2x = 0
-tools/easy-simplify.cert : no_pcert = 0
-
-tools/easy-simplify.cert : \
-     tools/bstar.cert \
-     tools/easy-simplify.lisp
-
-
-tools/fake-event.cert : acl2x = 0
-tools/fake-event.cert : no_pcert = 0
-
-tools/fake-event.cert : \
-     tools/fake-event.lisp
-
-
-tools/flag.cert : acl2x = 0
-tools/flag.cert : no_pcert = 0
-
-tools/flag.cert : \
-     xdoc/top.cert \
-     tools/flag.lisp \
-     tools/flag.acl2 \
-     tools/flag-package.lsp
-
-
-tools/in-raw-mode.cert : acl2x = 0
-tools/in-raw-mode.cert : no_pcert = 0
-
-tools/in-raw-mode.cert : \
-     tools/in-raw-mode.lisp \
-     tools/in-raw-mode.acl2
-
-
-tools/include-raw.cert : acl2x = 0
-tools/include-raw.cert : no_pcert = 0
-
-tools/include-raw.cert : \
-     xdoc/top.cert \
-     tools/include-raw.lisp
-
-
-tools/mv-nth.cert : acl2x = 0
-tools/mv-nth.cert : no_pcert = 0
-
-tools/mv-nth.cert : \
-     tools/mv-nth.lisp
-
-
-tools/oracle-eval-real.cert : acl2x = 0
-tools/oracle-eval-real.cert : no_pcert = 0
-
-tools/oracle-eval-real.cert : \
-     tools/oracle-eval-real.lisp \
-     tools/oracle-eval-real.acl2
-
-
-tools/oracle-eval.cert : acl2x = 0
-tools/oracle-eval.cert : no_pcert = 0
-
-tools/oracle-eval.cert : \
-     tools/oracle-eval-real.cert \
-     tools/oracle-eval.lisp
-
-
-tools/pack.cert : acl2x = 0
-tools/pack.cert : no_pcert = 0
-
-tools/pack.cert : \
-     tools/pack.lisp
-
-
-tools/pattern-match.cert : acl2x = 0
-tools/pattern-match.cert : no_pcert = 0
-
-tools/pattern-match.cert : \
-     tools/pattern-match.lisp
-
-
-tools/plev-ccl.cert : acl2x = 0
-tools/plev-ccl.cert : no_pcert = 0
-
-tools/plev-ccl.cert : \
-     tools/plev.cert \
-     tools/include-raw.cert \
-     tools/plev-ccl.lisp \
-     tools/plev-ccl.acl2
-
-
-tools/plev.cert : acl2x = 0
-tools/plev.cert : no_pcert = 0
-
-tools/plev.cert : \
-     tools/plev.lisp
-
-
-tools/rulesets.cert : acl2x = 0
-tools/rulesets.cert : no_pcert = 0
-
-tools/rulesets.cert : \
-     xdoc/top.cert \
-     tools/rulesets.lisp
-
-
-tools/safe-case.cert : acl2x = 0
-tools/safe-case.cert : no_pcert = 0
-
-tools/safe-case.cert : \
-     tools/safe-case.lisp
-
-
-tools/saved-errors.cert : acl2x = 0
-tools/saved-errors.cert : no_pcert = 0
-
-tools/saved-errors.cert : \
-     tools/saved-errors.lisp
-
-
-tools/stobj-frame.cert : acl2x = 0
-tools/stobj-frame.cert : no_pcert = 0
-
-tools/stobj-frame.cert : \
-     tools/rulesets.cert \
-     tools/bstar.cert \
-     data-structures/list-defthms.cert \
-     tools/stobj-frame.lisp
-
-
-tools/stobj-help.cert : acl2x = 0
-tools/stobj-help.cert : no_pcert = 0
-
-tools/stobj-help.cert : \
-     arithmetic-5/top.cert \
-     misc/simplify-thm.cert \
-     tools/stobj-help.lisp
-
-
-tools/templates.cert : acl2x = 0
-tools/templates.cert : no_pcert = 0
-
-tools/templates.cert : \
-     tools/bstar.cert \
-     tools/defmacfun.cert \
-     xdoc/top.cert \
-     tools/templates.lisp
-
-
-tools/theory-tools.cert : acl2x = 0
-tools/theory-tools.cert : no_pcert = 0
-
-tools/theory-tools.cert : \
-     tools/theory-tools.lisp
-
-
-tools/time-dollar-with-gc.cert : acl2x = 0
-tools/time-dollar-with-gc.cert : no_pcert = 0
-
-tools/time-dollar-with-gc.cert : \
-     tools/time-dollar-with-gc.lisp \
-     tools/time-dollar-with-gc.acl2
-
-
-tools/types-misc.cert : acl2x = 0
-tools/types-misc.cert : no_pcert = 0
-
-tools/types-misc.cert : \
-     tools/theory-tools.cert \
-     tools/types-misc.lisp
-
-
-tools/with-arith5-help.cert : acl2x = 0
-tools/with-arith5-help.cert : no_pcert = 0
-
-tools/with-arith5-help.cert : \
-     tools/rulesets.cert \
-     arithmetic-5/top.cert \
-     tools/with-arith5-help.lisp
-
-
-tools/with-quoted-forms.cert : acl2x = 0
-tools/with-quoted-forms.cert : no_pcert = 0
-
-tools/with-quoted-forms.cert : \
-     tools/bstar.cert \
-     tools/with-quoted-forms.lisp
-
-
-tutorial-problems/introductory-challenge-problem-4-athena.cert : acl2x = 0
-tutorial-problems/introductory-challenge-problem-4-athena.cert : no_pcert = 0
-
-tutorial-problems/introductory-challenge-problem-4-athena.cert : \
-     tutorial-problems/introductory-challenge-problem-4-athena.lisp
-
-
-tutorial-problems/introductory-challenge-problem-4.cert : acl2x = 0
-tutorial-problems/introductory-challenge-problem-4.cert : no_pcert = 0
-
-tutorial-problems/introductory-challenge-problem-4.cert : \
-     tutorial-problems/introductory-challenge-problem-4.lisp
-
-
-unicode/partition.cert : acl2x = 0
-unicode/partition.cert : no_pcert = 0
-
-unicode/partition.cert : \
-     std/lists/flatten.cert \
-     unicode/sum-list.cert \
-     std/lists/take.cert \
-     unicode/z-listp.cert \
-     arithmetic/top-with-meta.cert \
-     std/lists/nthcdr.cert \
-     unicode/partition.lisp
-
-
-unicode/read-utf8.cert : acl2x = 0
-unicode/read-utf8.cert : no_pcert = 0
-
-unicode/read-utf8.cert : \
-     unicode/utf8-decode.cert \
-     std/io/take-bytes.cert \
-     std/io/base.cert \
-     tools/mv-nth.cert \
-     std/io/signed-byte-listp.cert \
-     arithmetic-3/bind-free/top.cert \
-     unicode/read-utf8.lisp
-
-
-unicode/sum-list.cert : acl2x = 0
-unicode/sum-list.cert : no_pcert = 0
-
-unicode/sum-list.cert : \
-     std/lists/nat-listp.cert \
-     unicode/sum-list.lisp
-
-
-unicode/uchar.cert : acl2x = 0
-unicode/uchar.cert : no_pcert = 0
-
-unicode/uchar.cert : \
-     unicode/uchar.lisp
-
-
-unicode/utf8-decode.cert : acl2x = 0
-unicode/utf8-decode.cert : no_pcert = 0
-
-unicode/utf8-decode.cert : \
-     unicode/uchar.cert \
-     unicode/utf8-table35.cert \
-     unicode/utf8-table36.cert \
-     unicode/utf8-encode.cert \
-     unicode/partition.cert \
-     std/lists/nthcdr.cert \
-     std/io/signed-byte-listp.cert \
-     tools/mv-nth.cert \
-     arithmetic-3/bind-free/top.cert \
-     std/lists/revappend.cert \
-     unicode/utf8-decode.lisp
-
-
-unicode/utf8-encode.cert : acl2x = 0
-unicode/utf8-encode.cert : no_pcert = 0
-
-unicode/utf8-encode.cert : \
-     unicode/utf8-table35.cert \
-     unicode/utf8-table36.cert \
-     std/lists/append.cert \
-     std/io/signed-byte-listp.cert \
-     unicode/utf8-encode.lisp
-
-
-unicode/utf8-table35.cert : acl2x = 0
-unicode/utf8-table35.cert : no_pcert = 0
-
-unicode/utf8-table35.cert : \
-     unicode/uchar.cert \
-     std/io/unsigned-byte-listp.cert \
-     std/io/signed-byte-listp.cert \
-     unicode/utf8-table35.lisp
-
-
-unicode/utf8-table36.cert : acl2x = 0
-unicode/utf8-table36.cert : no_pcert = 0
-
-unicode/utf8-table36.cert : \
-     unicode/uchar.cert \
-     std/io/unsigned-byte-listp.cert \
-     std/io/signed-byte-listp.cert \
-     unicode/utf8-table36.lisp
-
-
-unicode/z-listp.cert : acl2x = 0
-unicode/z-listp.cert : no_pcert = 0
-
-unicode/z-listp.cert : \
-     std/lists/app.cert \
-     unicode/z-listp.lisp
-
-
-workshops/1999/calculus/solutions/mesh-append.cert : acl2x = 0
-workshops/1999/calculus/solutions/mesh-append.cert : no_pcert = 0
-
-workshops/1999/calculus/solutions/mesh-append.cert : \
-     workshops/1999/calculus/solutions/partition-defuns.cert \
-     workshops/1999/calculus/solutions/mesh-append.lisp
-
-
-workshops/1999/calculus/solutions/mesh-make-partition.cert : acl2x = 0
-workshops/1999/calculus/solutions/mesh-make-partition.cert : no_pcert = 0
-
-workshops/1999/calculus/solutions/mesh-make-partition.cert : \
-     workshops/1999/calculus/solutions/partition-defuns.cert \
-     workshops/1999/calculus/solutions/mesh-make-partition.lisp
-
-
-workshops/1999/calculus/solutions/partition-defuns.cert : acl2x = 0
-workshops/1999/calculus/solutions/partition-defuns.cert : no_pcert = 0
-
-workshops/1999/calculus/solutions/partition-defuns.cert : \
-     workshops/1999/calculus/solutions/partition-defuns.lisp
-
-
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.cert : acl2x = 0
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.cert : no_pcert = 0
-
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.cert : \
-     workshops/1999/calculus/solutions/partition-defuns.cert \
-     workshops/1999/calculus/solutions/partitionp-make-partition-rec.lisp
-
-
-workshops/1999/calculus/solutions/partitionp-make-partition.cert : acl2x = 0
-workshops/1999/calculus/solutions/partitionp-make-partition.cert : no_pcert = 0
-
-workshops/1999/calculus/solutions/partitionp-make-partition.cert : \
-     workshops/1999/calculus/solutions/partition-defuns.cert \
-     workshops/1999/calculus/solutions/partitionp-make-partition-rec.cert \
-     workshops/1999/calculus/solutions/partitionp-make-partition.lisp
-
-
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.cert : acl2x = 0
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.cert : no_pcert = 0
-
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.cert : \
-     workshops/1999/calculus/solutions/riemann-rcfn-helpers.lisp
-
-
-workshops/1999/compiler/compiler.cert : acl2x = 0
-workshops/1999/compiler/compiler.cert : no_pcert = 0
-
-workshops/1999/compiler/compiler.cert : \
-     workshops/1999/compiler/machine.cert \
-     workshops/1999/compiler/compiler.lisp
-
-
-workshops/1999/compiler/evaluator.cert : acl2x = 0
-workshops/1999/compiler/evaluator.cert : no_pcert = 0
-
-workshops/1999/compiler/evaluator.cert : \
-     workshops/1999/compiler/compiler.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/compiler/evaluator.lisp
-
-
-workshops/1999/compiler/exercises.cert : acl2x = 0
-workshops/1999/compiler/exercises.cert : no_pcert = 0
-
-workshops/1999/compiler/exercises.cert : \
-     workshops/1999/compiler/compiler.cert \
-     workshops/1999/compiler/exercises.lisp
-
-
-workshops/1999/compiler/machine.cert : acl2x = 0
-workshops/1999/compiler/machine.cert : no_pcert = 0
-
-workshops/1999/compiler/machine.cert : \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/compiler/machine.lisp
-
-
-workshops/1999/compiler/proof.cert : acl2x = 0
-workshops/1999/compiler/proof.cert : no_pcert = 0
-
-workshops/1999/compiler/proof.cert : \
-     workshops/1999/compiler/proof1.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/compiler/proof.lisp
-
-
-workshops/1999/compiler/proof1.cert : acl2x = 0
-workshops/1999/compiler/proof1.cert : no_pcert = 0
-
-workshops/1999/compiler/proof1.cert : \
-     workshops/1999/compiler/evaluator.cert \
-     arithmetic/equalities.cert \
-     workshops/1999/compiler/proof1.lisp
-
-
-workshops/1999/de-hdl/arity.cert : acl2x = 0
-workshops/1999/de-hdl/arity.cert : no_pcert = 0
-
-workshops/1999/de-hdl/arity.cert : \
-     workshops/1999/de-hdl/syntax.cert \
-     workshops/1999/de-hdl/arity.lisp
-
-
-workshops/1999/de-hdl/de4.cert : acl2x = 0
-workshops/1999/de-hdl/de4.cert : no_pcert = 0
-
-workshops/1999/de-hdl/de4.cert : \
-     workshops/1999/de-hdl/sts-okp.cert \
-     workshops/1999/de-hdl/de4.lisp
-
-
-workshops/1999/de-hdl/examples.cert : acl2x = 0
-workshops/1999/de-hdl/examples.cert : no_pcert = 0
-
-workshops/1999/de-hdl/examples.cert : \
-     workshops/1999/de-hdl/de4.cert \
-     workshops/1999/de-hdl/examples.lisp
-
-
-workshops/1999/de-hdl/help-defuns.cert : acl2x = 0
-workshops/1999/de-hdl/help-defuns.cert : no_pcert = 0
-
-workshops/1999/de-hdl/help-defuns.cert : \
-     workshops/1999/de-hdl/help-defuns.lisp
-
-
-workshops/1999/de-hdl/measure.cert : acl2x = 0
-workshops/1999/de-hdl/measure.cert : no_pcert = 0
-
-workshops/1999/de-hdl/measure.cert : \
-     workshops/1999/de-hdl/help-defuns.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/de-hdl/measure.lisp
-
-
-workshops/1999/de-hdl/primitives.cert : acl2x = 0
-workshops/1999/de-hdl/primitives.cert : no_pcert = 0
-
-workshops/1999/de-hdl/primitives.cert : \
-     workshops/1999/de-hdl/measure.cert \
-     workshops/1999/de-hdl/primitives.lisp
-
-
-workshops/1999/de-hdl/sts-okp.cert : acl2x = 0
-workshops/1999/de-hdl/sts-okp.cert : no_pcert = 0
-
-workshops/1999/de-hdl/sts-okp.cert : \
-     workshops/1999/de-hdl/arity.cert \
-     workshops/1999/de-hdl/sts-okp.lisp
-
-
-workshops/1999/de-hdl/syntax.cert : acl2x = 0
-workshops/1999/de-hdl/syntax.cert : no_pcert = 0
-
-workshops/1999/de-hdl/syntax.cert : \
-     workshops/1999/de-hdl/primitives.cert \
-     workshops/1999/de-hdl/syntax.lisp
-
-
-workshops/1999/de-hdl/thm-example.cert : acl2x = 0
-workshops/1999/de-hdl/thm-example.cert : no_pcert = 0
-
-workshops/1999/de-hdl/thm-example.cert : \
-     workshops/1999/de-hdl/de4.cert \
-     workshops/1999/de-hdl/thm-example.lisp
-
-
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.cert : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.cert : no_pcert = 0
-
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.cert : \
-     workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.lisp
-
-
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.cert : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.cert : no_pcert = 0
-
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.cert : \
-     arithmetic/mod-gcd.cert \
-     rtl/rel1/lib1/basic.cert \
-     rtl/rel1/support/fp.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.cert \
-     workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.lisp
-
-
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.cert : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.cert : no_pcert = 0
-
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.cert : \
-     workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.cert \
-     workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.lisp
-
-
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.cert : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.cert : no_pcert = 0
-
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.cert : \
-     ihs/ihs-init.cert \
-     ihs/ihs-theories.cert \
-     ihs/math-lemmas.cert \
-     workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.lisp
-
-
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.cert : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.cert : no_pcert = 0
-
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.cert : \
-     workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/CRT.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRT.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/CRT.cert : \
-     arithmetic/mod-gcd.cert \
-     rtl/rel1/lib1/basic.cert \
-     rtl/rel1/support/fp.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/CRT.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/CRT.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/Generic.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Generic.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/Generic.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/Generic.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/Generic.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Mapping.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.cert : \
-     workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Mapping.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.lisp
-
-
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.cert : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.cert : no_pcert = 0
-
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.cert : \
-     ihs/ihs-init.cert \
-     ihs/ihs-theories.cert \
-     ihs/math-lemmas.cert \
-     workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.lisp
-
-
-workshops/1999/graph/find-path1.cert : acl2x = 0
-workshops/1999/graph/find-path1.cert : no_pcert = 0
-
-workshops/1999/graph/find-path1.cert : \
-     arithmetic/top.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/graph/find-path1.lisp
-
-
-workshops/1999/graph/find-path2.cert : acl2x = 0
-workshops/1999/graph/find-path2.cert : no_pcert = 0
-
-workshops/1999/graph/find-path2.cert : \
-     arithmetic/top.cert \
-     workshops/1999/graph/helpers.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/graph/find-path2.lisp
-
-
-workshops/1999/graph/find-path3.cert : acl2x = 0
-workshops/1999/graph/find-path3.cert : no_pcert = 0
-
-workshops/1999/graph/find-path3.cert : \
-     arithmetic/top.cert \
-     workshops/1999/graph/helpers.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/graph/find-path3.lisp
-
-
-workshops/1999/graph/helpers.cert : acl2x = 0
-workshops/1999/graph/helpers.cert : no_pcert = 0
-
-workshops/1999/graph/helpers.cert : \
-     workshops/1999/graph/helpers.lisp
-
-
-workshops/1999/graph/linear-find-path.cert : acl2x = 0
-workshops/1999/graph/linear-find-path.cert : no_pcert = 0
-
-workshops/1999/graph/linear-find-path.cert : \
-     workshops/1999/graph/find-path3.cert \
-     workshops/1999/graph/linear-find-path.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/variables.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/alls.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert : \
-     arithmetic/top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/base.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/base.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/base.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sets.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/close.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/close.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/close.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/keval.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/cnf.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/substitution.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/resolve.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/paramod.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/flip.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/paramod.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/flip.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/keval.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/nnf.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/cnf.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/modeler.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/nnf.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/paramod.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sets.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/nnf.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/cnf.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simplify.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prover.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/xeval.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/resolve.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sets.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simplify.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/substitution.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/xeval.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/substitution.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sugar.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/top.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/top.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/top.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prover.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/modeler.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/top.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/variables.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/alls.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.lisp
-
-
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.cert : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.cert : no_pcert = 0
-
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.cert : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/ivy/ivy-v2/ivy-sources/xeval.lisp
-
-
-workshops/1999/knuth-91/aof.cert : acl2x = 0
-workshops/1999/knuth-91/aof.cert : no_pcert = 0
-
-workshops/1999/knuth-91/aof.cert : \
-     arithmetic/inequalities.cert \
-     workshops/1999/knuth-91/aof.lisp \
-     workshops/1999/knuth-91/aof.acl2
-
-
-workshops/1999/knuth-91/exercise1.cert : acl2x = 0
-workshops/1999/knuth-91/exercise1.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise1.cert : \
-     workshops/1999/knuth-91/exercise1.lisp \
-     workshops/1999/knuth-91/exercise1.acl2
-
-
-workshops/1999/knuth-91/exercise2.cert : acl2x = 0
-workshops/1999/knuth-91/exercise2.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise2.cert : \
-     workshops/1999/knuth-91/exercise2.lisp
-
-
-workshops/1999/knuth-91/exercise3.cert : acl2x = 0
-workshops/1999/knuth-91/exercise3.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise3.cert : \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/knuth-91/exercise3.lisp
-
-
-workshops/1999/knuth-91/exercise4a.cert : acl2x = 0
-workshops/1999/knuth-91/exercise4a.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise4a.cert : \
-     workshops/1999/knuth-91/exercise4a.lisp
-
-
-workshops/1999/knuth-91/exercise4b.cert : acl2x = 0
-workshops/1999/knuth-91/exercise4b.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise4b.cert : \
-     workshops/1999/knuth-91/exercise4b.lisp
-
-
-workshops/1999/knuth-91/exercise5.cert : acl2x = 0
-workshops/1999/knuth-91/exercise5.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise5.cert : \
-     workshops/1999/knuth-91/exercise5.lisp
-
-
-workshops/1999/knuth-91/exercise6a.cert : acl2x = 0
-workshops/1999/knuth-91/exercise6a.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise6a.cert : \
-     workshops/1999/knuth-91/exercise6a.lisp
-
-
-workshops/1999/knuth-91/exercise6b.cert : acl2x = 0
-workshops/1999/knuth-91/exercise6b.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise6b.cert : \
-     workshops/1999/knuth-91/exercise6b.lisp
-
-
-workshops/1999/knuth-91/exercise7a.cert : acl2x = 0
-workshops/1999/knuth-91/exercise7a.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise7a.cert : \
-     workshops/1999/knuth-91/exercise7a.lisp
-
-
-workshops/1999/knuth-91/exercise7b.cert : acl2x = 0
-workshops/1999/knuth-91/exercise7b.cert : no_pcert = 0
-
-workshops/1999/knuth-91/exercise7b.cert : \
-     workshops/1999/knuth-91/exercise7b.lisp
-
-
-workshops/1999/knuth-91/knuth-arch.cert : acl2x = 0
-workshops/1999/knuth-91/knuth-arch.cert : no_pcert = 0
-
-workshops/1999/knuth-91/knuth-arch.cert : \
-     arithmetic/top-with-meta.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/knuth-91/aof.cert \
-     workshops/1999/knuth-91/knuth-arch.lisp
-
-
-workshops/1999/mu-calculus/book/fast-sets.cert : acl2x = 0
-workshops/1999/mu-calculus/book/fast-sets.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/book/fast-sets.cert : \
-     workshops/1999/mu-calculus/book/sets.cert \
-     workshops/1999/mu-calculus/book/fast-sets.lisp \
-     workshops/1999/mu-calculus/book/fast-sets.acl2
-
-
-workshops/1999/mu-calculus/book/fixpoints.cert : acl2x = 0
-workshops/1999/mu-calculus/book/fixpoints.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/book/fixpoints.cert : \
-     workshops/1999/mu-calculus/book/sets.cert \
-     workshops/1999/mu-calculus/book/fixpoints.lisp \
-     workshops/1999/mu-calculus/book/fixpoints.acl2
-
-
-workshops/1999/mu-calculus/book/models.cert : acl2x = 0
-workshops/1999/mu-calculus/book/models.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/book/models.cert : \
-     workshops/1999/mu-calculus/book/relations.cert \
-     workshops/1999/mu-calculus/book/fixpoints.cert \
-     workshops/1999/mu-calculus/book/models.lisp \
-     workshops/1999/mu-calculus/book/models.acl2
-
-
-workshops/1999/mu-calculus/book/relations.cert : acl2x = 0
-workshops/1999/mu-calculus/book/relations.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/book/relations.cert : \
-     workshops/1999/mu-calculus/book/fast-sets.cert \
-     workshops/1999/mu-calculus/book/relations.lisp \
-     workshops/1999/mu-calculus/book/relations.acl2
-
-
-workshops/1999/mu-calculus/book/semantics.cert : acl2x = 0
-workshops/1999/mu-calculus/book/semantics.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/book/semantics.cert : \
-     workshops/1999/mu-calculus/book/syntax.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/mu-calculus/book/semantics.lisp \
-     workshops/1999/mu-calculus/book/semantics.acl2
-
-
-workshops/1999/mu-calculus/book/sets.cert : acl2x = 0
-workshops/1999/mu-calculus/book/sets.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/book/sets.cert : \
-     workshops/1999/mu-calculus/book/sets.lisp \
-     workshops/1999/mu-calculus/book/sets.acl2
-
-
-workshops/1999/mu-calculus/book/syntax.cert : acl2x = 0
-workshops/1999/mu-calculus/book/syntax.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/book/syntax.cert : \
-     workshops/1999/mu-calculus/book/models.cert \
-     workshops/1999/mu-calculus/book/syntax.lisp \
-     workshops/1999/mu-calculus/book/syntax.acl2
-
-
-workshops/1999/mu-calculus/solutions/ctl.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/ctl.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/ctl.cert : \
-     workshops/1999/mu-calculus/solutions/semantics.cert \
-     workshops/1999/mu-calculus/solutions/ctl.lisp \
-     workshops/1999/mu-calculus/solutions/ctl.acl2
-
-
-workshops/1999/mu-calculus/solutions/defung.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/defung.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/defung.cert : \
-     workshops/1999/mu-calculus/solutions/defung.lisp
-
-
-workshops/1999/mu-calculus/solutions/fast-sets.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/fast-sets.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/fast-sets.cert : \
-     workshops/1999/mu-calculus/solutions/sets.cert \
-     workshops/1999/mu-calculus/solutions/fast-sets.lisp \
-     workshops/1999/mu-calculus/solutions/fast-sets.acl2
-
-
-workshops/1999/mu-calculus/solutions/fixpoints.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/fixpoints.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/fixpoints.cert : \
-     workshops/1999/mu-calculus/solutions/sets.cert \
-     workshops/1999/mu-calculus/solutions/fixpoints.lisp \
-     workshops/1999/mu-calculus/solutions/fixpoints.acl2
-
-
-workshops/1999/mu-calculus/solutions/meta.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/meta.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/meta.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/1999/mu-calculus/solutions/meta.lisp
-
-
-workshops/1999/mu-calculus/solutions/models.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/models.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/models.cert : \
-     workshops/1999/mu-calculus/solutions/relations.cert \
-     workshops/1999/mu-calculus/solutions/models.lisp \
-     workshops/1999/mu-calculus/solutions/models.acl2
-
-
-workshops/1999/mu-calculus/solutions/perm.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/perm.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/perm.cert : \
-     workshops/1999/mu-calculus/solutions/defung.cert \
-     workshops/1999/mu-calculus/solutions/perm.lisp
-
-
-workshops/1999/mu-calculus/solutions/relations.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/relations.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/relations.cert : \
-     workshops/1999/mu-calculus/solutions/fast-sets.cert \
-     workshops/1999/mu-calculus/solutions/relations.lisp \
-     workshops/1999/mu-calculus/solutions/relations.acl2
-
-
-workshops/1999/mu-calculus/solutions/semantics.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/semantics.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/semantics.cert : \
-     workshops/1999/mu-calculus/solutions/syntax.cert \
-     workshops/1999/mu-calculus/solutions/fixpoints.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/1999/mu-calculus/solutions/semantics.lisp \
-     workshops/1999/mu-calculus/solutions/semantics.acl2
-
-
-workshops/1999/mu-calculus/solutions/sets.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/sets.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/sets.cert : \
-     workshops/1999/mu-calculus/solutions/defung.cert \
-     workshops/1999/mu-calculus/solutions/meta.cert \
-     workshops/1999/mu-calculus/solutions/perm.cert \
-     workshops/1999/mu-calculus/solutions/sets.lisp \
-     workshops/1999/mu-calculus/solutions/sets.acl2
-
-
-workshops/1999/mu-calculus/solutions/syntax.cert : acl2x = 0
-workshops/1999/mu-calculus/solutions/syntax.cert : no_pcert = 0
-
-workshops/1999/mu-calculus/solutions/syntax.cert : \
-     workshops/1999/mu-calculus/solutions/models.cert \
-     workshops/1999/mu-calculus/solutions/syntax.lisp \
-     workshops/1999/mu-calculus/solutions/syntax.acl2
-
-
-workshops/1999/pipeline/b-ops-aux-def.cert : acl2x = 0
-workshops/1999/pipeline/b-ops-aux-def.cert : no_pcert = 0
-
-workshops/1999/pipeline/b-ops-aux-def.cert : \
-     workshops/1999/pipeline/trivia.cert \
-     workshops/1999/pipeline/ihs.cert \
-     workshops/1999/pipeline/b-ops-aux-def.lisp
-
-
-workshops/1999/pipeline/b-ops-aux.cert : acl2x = 0
-workshops/1999/pipeline/b-ops-aux.cert : no_pcert = 0
-
-workshops/1999/pipeline/b-ops-aux.cert : \
-     workshops/1999/pipeline/b-ops-aux-def.cert \
-     workshops/1999/pipeline/b-ops-aux.lisp
-
-
-workshops/1999/pipeline/basic-def.cert : acl2x = 0
-workshops/1999/pipeline/basic-def.cert : no_pcert = 0
-
-workshops/1999/pipeline/basic-def.cert : \
-     data-structures/array1.cert \
-     data-structures/deflist.cert \
-     data-structures/list-defthms.cert \
-     data-structures/structures.cert \
-     workshops/1999/pipeline/ihs.cert \
-     workshops/1999/pipeline/trivia.cert \
-     workshops/1999/pipeline/b-ops-aux.cert \
-     workshops/1999/pipeline/basic-def.lisp \
-     workshops/1999/pipeline/basic-def.acl2 \
-     workshops/1999/pipeline/define-u-package.lsp
-
-
-workshops/1999/pipeline/basic-lemmas.cert : acl2x = 0
-workshops/1999/pipeline/basic-lemmas.cert : no_pcert = 0
-
-workshops/1999/pipeline/basic-lemmas.cert : \
-     workshops/1999/pipeline/basic-def.cert \
-     workshops/1999/pipeline/model.cert \
-     workshops/1999/pipeline/table-def.cert \
-     workshops/1999/pipeline/basic-lemmas.lisp
-
-
-workshops/1999/pipeline/exercise.cert : acl2x = 0
-workshops/1999/pipeline/exercise.cert : no_pcert = 0
-
-workshops/1999/pipeline/exercise.cert : \
-     workshops/1999/pipeline/exercise.lisp
-
-
-workshops/1999/pipeline/ihs.cert : acl2x = 0
-workshops/1999/pipeline/ihs.cert : no_pcert = 0
-
-workshops/1999/pipeline/ihs.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     workshops/1999/pipeline/ihs.lisp
-
-
-workshops/1999/pipeline/model.cert : acl2x = 0
-workshops/1999/pipeline/model.cert : no_pcert = 0
-
-workshops/1999/pipeline/model.cert : \
-     workshops/1999/pipeline/basic-def.cert \
-     workshops/1999/pipeline/model.lisp
-
-
-workshops/1999/pipeline/proof.cert : acl2x = 0
-workshops/1999/pipeline/proof.cert : no_pcert = 0
-
-workshops/1999/pipeline/proof.cert : \
-     workshops/1999/pipeline/basic-def.cert \
-     workshops/1999/pipeline/model.cert \
-     workshops/1999/pipeline/table-def.cert \
-     workshops/1999/pipeline/basic-lemmas.cert \
-     workshops/1999/pipeline/proof.lisp
-
-
-workshops/1999/pipeline/table-def.cert : acl2x = 0
-workshops/1999/pipeline/table-def.cert : no_pcert = 0
-
-workshops/1999/pipeline/table-def.cert : \
-     workshops/1999/pipeline/utils.cert \
-     workshops/1999/pipeline/basic-def.cert \
-     workshops/1999/pipeline/model.cert \
-     workshops/1999/pipeline/table-def.lisp
-
-
-workshops/1999/pipeline/trivia.cert : acl2x = 0
-workshops/1999/pipeline/trivia.cert : no_pcert = 0
-
-workshops/1999/pipeline/trivia.cert : \
-     data-structures/array1.cert \
-     arithmetic/top.cert \
-     workshops/1999/pipeline/trivia.lisp
-
-
-workshops/1999/pipeline/utils.cert : acl2x = 0
-workshops/1999/pipeline/utils.cert : no_pcert = 0
-
-workshops/1999/pipeline/utils.cert : \
-     data-structures/utilities.cert \
-     workshops/1999/pipeline/utils.lisp \
-     workshops/1999/pipeline/utils.acl2 \
-     workshops/1999/pipeline/define-u-package.lsp
-
-
-workshops/1999/simulator/exercises.cert : acl2x = 0
-workshops/1999/simulator/exercises.cert : no_pcert = 0
-
-workshops/1999/simulator/exercises.cert : \
-     workshops/1999/simulator/tiny.cert \
-     workshops/1999/simulator/exercises.lisp
-
-
-workshops/1999/simulator/tiny.cert : acl2x = 0
-workshops/1999/simulator/tiny.cert : no_pcert = 0
-
-workshops/1999/simulator/tiny.cert : \
-     arithmetic/top.cert \
-     data-structures/list-defthms.cert \
-     meta/meta.cert \
-     ihs/logops-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/1999/simulator/tiny.lisp
-
-
-workshops/1999/ste/assertion.cert : acl2x = 0
-workshops/1999/ste/assertion.cert : no_pcert = 0
-
-workshops/1999/ste/assertion.cert : \
-     workshops/1999/ste/trajectory.cert \
-     workshops/1999/ste/assertion.lisp
-
-
-workshops/1999/ste/boolean.cert : acl2x = 0
-workshops/1999/ste/boolean.cert : no_pcert = 0
-
-workshops/1999/ste/boolean.cert : \
-     workshops/1999/ste/util.cert \
-     workshops/1999/ste/boolean.lisp
-
-
-workshops/1999/ste/circuit.cert : acl2x = 0
-workshops/1999/ste/circuit.cert : no_pcert = 0
-
-workshops/1999/ste/circuit.cert : \
-     workshops/1999/ste/expression.cert \
-     workshops/1999/ste/circuit.lisp
-
-
-workshops/1999/ste/example.cert : acl2x = 0
-workshops/1999/ste/example.cert : no_pcert = 0
-
-workshops/1999/ste/example.cert : \
-     workshops/1999/ste/inference.cert \
-     workshops/1999/ste/example.lisp
-
-
-workshops/1999/ste/expression.cert : acl2x = 0
-workshops/1999/ste/expression.cert : no_pcert = 0
-
-workshops/1999/ste/expression.cert : \
-     workshops/1999/ste/run.cert \
-     workshops/1999/ste/expression.lisp
-
-
-workshops/1999/ste/fundamental.cert : acl2x = 0
-workshops/1999/ste/fundamental.cert : no_pcert = 0
-
-workshops/1999/ste/fundamental.cert : \
-     workshops/1999/ste/lemma-4.cert \
-     workshops/1999/ste/fundamental.lisp
-
-
-workshops/1999/ste/inference.cert : acl2x = 0
-workshops/1999/ste/inference.cert : no_pcert = 0
-
-workshops/1999/ste/inference.cert : \
-     workshops/1999/ste/fundamental.cert \
-     workshops/1999/ste/inference.lisp
-
-
-workshops/1999/ste/lemma-4.cert : acl2x = 0
-workshops/1999/ste/lemma-4.cert : no_pcert = 0
-
-workshops/1999/ste/lemma-4.cert : \
-     workshops/1999/ste/assertion.cert \
-     workshops/1999/ste/lemma-4.lisp
-
-
-workshops/1999/ste/run.cert : acl2x = 0
-workshops/1999/ste/run.cert : no_pcert = 0
-
-workshops/1999/ste/run.cert : \
-     workshops/1999/ste/state.cert \
-     workshops/1999/ste/run.lisp
-
-
-workshops/1999/ste/state.cert : acl2x = 0
-workshops/1999/ste/state.cert : no_pcert = 0
-
-workshops/1999/ste/state.cert : \
-     workshops/1999/ste/boolean.cert \
-     workshops/1999/ste/state.lisp
-
-
-workshops/1999/ste/trajectory.cert : acl2x = 0
-workshops/1999/ste/trajectory.cert : no_pcert = 0
-
-workshops/1999/ste/trajectory.cert : \
-     workshops/1999/ste/circuit.cert \
-     workshops/1999/ste/trajectory.lisp
-
-
-workshops/1999/ste/util.cert : acl2x = 0
-workshops/1999/ste/util.cert : no_pcert = 0
-
-workshops/1999/ste/util.cert : \
-     data-structures/utilities.cert \
-     data-structures/list-theory.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/1999/ste/util.lisp
-
-
-workshops/1999/vhdl/exercises.cert : acl2x = 0
-workshops/1999/vhdl/exercises.cert : no_pcert = 0
-
-workshops/1999/vhdl/exercises.cert : \
-     workshops/1999/vhdl/fact.cert \
-     workshops/1999/vhdl/exercises.lisp
-
-
-workshops/1999/vhdl/fact-proof.cert : acl2x = 0
-workshops/1999/vhdl/fact-proof.cert : no_pcert = 0
-
-workshops/1999/vhdl/fact-proof.cert : \
-     arithmetic/top.cert \
-     workshops/1999/vhdl/fact.cert \
-     workshops/1999/vhdl/fact-proof.lisp
-
-
-workshops/1999/vhdl/fact.cert : acl2x = 0
-workshops/1999/vhdl/fact.cert : no_pcert = 0
-
-workshops/1999/vhdl/fact.cert : \
-     workshops/1999/vhdl/vhdl.cert \
-     workshops/1999/vhdl/fact.lisp
-
-
-workshops/1999/vhdl/vhdl.cert : acl2x = 0
-workshops/1999/vhdl/vhdl.cert : no_pcert = 0
-
-workshops/1999/vhdl/vhdl.cert : \
-     workshops/1999/vhdl/vhdl.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/base.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/base.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/base.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/util.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/base.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/pstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/compile.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/expr.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/cstate.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/base.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/expr.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/base.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/cstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/lstate.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/cstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/pstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/lstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/expr.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/pstate.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/setup.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.cert \
-     arithmetic/mod-gcd.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/simulator.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/setup.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.cert \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.lisp
-
-
-workshops/2000/lusk-mccune/lusk-mccune-final/util.cert : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/util.cert : no_pcert = 0
-
-workshops/2000/lusk-mccune/lusk-mccune-final/util.cert : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/util.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/ihs.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.cert : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.cert : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.cert : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.cert : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.cert : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.cert : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/top/ihs.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/ihs.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/top/ihs.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/ihs.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/top/meta.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/meta.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/top/meta.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.lisp
-
-
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.cert : \
-     workshops/2000/manolios/pipeline/trivial/trivia.cert \
-     workshops/2000/manolios/pipeline/trivial/ihs.cert \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.cert : \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.cert \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/basic-def.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/basic-def.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/basic-def.cert : \
-     data-structures/array1.cert \
-     data-structures/deflist.cert \
-     data-structures/list-defthms.cert \
-     data-structures/structures.cert \
-     workshops/2000/manolios/pipeline/trivial/ihs.cert \
-     workshops/2000/manolios/pipeline/trivial/trivia.cert \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux.cert \
-     workshops/2000/manolios/pipeline/trivial/basic-def.lisp \
-     workshops/2000/manolios/pipeline/trivial/basic-def.acl2 \
-     workshops/2000/manolios/pipeline/trivial/define-u-package.lsp
-
-
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.cert : \
-     workshops/2000/manolios/pipeline/trivial/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/model.cert \
-     workshops/2000/manolios/pipeline/trivial/table-def.cert \
-     workshops/2000/manolios/pipeline/trivial/basic-lemmas.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/ihs.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/ihs.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/ihs.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     workshops/2000/manolios/pipeline/trivial/ihs.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/model.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/model.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/model.cert : \
-     workshops/2000/manolios/pipeline/trivial/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/model.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/proof.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/proof.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/proof.cert : \
-     workshops/2000/manolios/pipeline/trivial/model.cert \
-     workshops/2000/manolios/pipeline/trivial/proof.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.cert : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.cert : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert : \
-     data-structures/array1.cert \
-     data-structures/deflist.cert \
-     data-structures/list-defthms.cert \
-     data-structures/structures.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.lisp \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.acl2 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/define-u-package.lsp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.cert : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.cert : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/proof.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.cert : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.cert : \
-     data-structures/array1.cert \
-     arithmetic/top.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.cert : \
-     data-structures/utilities.cert \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.lisp \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.acl2 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/define-u-package.lsp
-
-
-workshops/2000/manolios/pipeline/trivial/table-def.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/table-def.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/table-def.cert : \
-     workshops/2000/manolios/pipeline/trivial/utils.cert \
-     workshops/2000/manolios/pipeline/trivial/basic-def.cert \
-     workshops/2000/manolios/pipeline/trivial/model.cert \
-     workshops/2000/manolios/pipeline/trivial/table-def.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/trivia.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/trivia.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/trivia.cert : \
-     data-structures/array1.cert \
-     arithmetic/top.cert \
-     workshops/2000/manolios/pipeline/trivial/trivia.lisp
-
-
-workshops/2000/manolios/pipeline/trivial/utils.cert : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/utils.cert : no_pcert = 0
-
-workshops/2000/manolios/pipeline/trivial/utils.cert : \
-     data-structures/utilities.cert \
-     workshops/2000/manolios/pipeline/trivial/utils.lisp \
-     workshops/2000/manolios/pipeline/trivial/utils.acl2 \
-     workshops/2000/manolios/pipeline/trivial/define-u-package.lsp
-
-
-workshops/2000/medina/polynomials/addition.cert : acl2x = 0
-workshops/2000/medina/polynomials/addition.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/addition.cert : \
-     workshops/2000/medina/polynomials/normal-form.cert \
-     workshops/2000/medina/polynomials/addition.lisp \
-     workshops/2000/medina/polynomials/addition.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/congruences-1.cert : acl2x = 0
-workshops/2000/medina/polynomials/congruences-1.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/congruences-1.cert : \
-     workshops/2000/medina/polynomials/negation.cert \
-     workshops/2000/medina/polynomials/congruences-1.lisp \
-     workshops/2000/medina/polynomials/congruences-1.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/congruences-2.cert : acl2x = 0
-workshops/2000/medina/polynomials/congruences-2.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/congruences-2.cert : \
-     workshops/2000/medina/polynomials/multiplication.cert \
-     workshops/2000/medina/polynomials/congruences-2.lisp \
-     workshops/2000/medina/polynomials/congruences-2.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/examples.cert : acl2x = 0
-workshops/2000/medina/polynomials/examples.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/examples.cert : \
-     workshops/2000/medina/polynomials/congruences-2.cert \
-     workshops/2000/medina/polynomials/examples.lisp \
-     workshops/2000/medina/polynomials/examples.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/lexicographical-ordering.cert : acl2x = 0
-workshops/2000/medina/polynomials/lexicographical-ordering.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/lexicographical-ordering.cert : \
-     workshops/2000/medina/polynomials/term.cert \
-     ordinals/ordinals-without-arithmetic.cert \
-     workshops/2000/medina/polynomials/lexicographical-ordering.lisp \
-     workshops/2000/medina/polynomials/lexicographical-ordering.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/monomial.cert : acl2x = 0
-workshops/2000/medina/polynomials/monomial.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/monomial.cert : \
-     workshops/2000/medina/polynomials/term.cert \
-     workshops/2000/medina/polynomials/monomial.lisp \
-     workshops/2000/medina/polynomials/monomial.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/multiplication.cert : acl2x = 0
-workshops/2000/medina/polynomials/multiplication.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/multiplication.cert : \
-     workshops/2000/medina/polynomials/congruences-1.cert \
-     workshops/2000/medina/polynomials/multiplication.lisp \
-     workshops/2000/medina/polynomials/multiplication.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/negation.cert : acl2x = 0
-workshops/2000/medina/polynomials/negation.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/negation.cert : \
-     workshops/2000/medina/polynomials/addition.cert \
-     workshops/2000/medina/polynomials/negation.lisp \
-     workshops/2000/medina/polynomials/negation.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/normal-form.cert : acl2x = 0
-workshops/2000/medina/polynomials/normal-form.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/normal-form.cert : \
-     workshops/2000/medina/polynomials/polynomial.cert \
-     workshops/2000/medina/polynomials/lexicographical-ordering.cert \
-     workshops/2000/medina/polynomials/normal-form.lisp \
-     workshops/2000/medina/polynomials/normal-form.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/polynomial.cert : acl2x = 0
-workshops/2000/medina/polynomials/polynomial.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/polynomial.cert : \
-     workshops/2000/medina/polynomials/monomial.cert \
-     workshops/2000/medina/polynomials/polynomial.lisp \
-     workshops/2000/medina/polynomials/polynomial.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/medina/polynomials/term.cert : acl2x = 0
-workshops/2000/medina/polynomials/term.cert : no_pcert = 0
-
-workshops/2000/medina/polynomials/term.cert : \
-     workshops/2000/medina/polynomials/term.lisp \
-     workshops/2000/medina/polynomials/term.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-
-
-workshops/2000/moore-manolios/partial-functions/defpun-original.cert : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/defpun-original.cert : no_pcert = 0
-
-workshops/2000/moore-manolios/partial-functions/defpun-original.cert : \
-     workshops/2000/moore-manolios/partial-functions/defpun-original.lisp
-
-
-workshops/2000/moore-manolios/partial-functions/defpun.cert : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/defpun.cert : no_pcert = 0
-
-workshops/2000/moore-manolios/partial-functions/defpun.cert : \
-     misc/defpun.cert \
-     workshops/2000/moore-manolios/partial-functions/defpun.lisp
-
-
-workshops/2000/moore-manolios/partial-functions/examples.cert : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/examples.cert : no_pcert = 0
-
-workshops/2000/moore-manolios/partial-functions/examples.cert : \
-     workshops/2000/moore-manolios/partial-functions/tjvm.cert \
-     workshops/2000/moore-manolios/partial-functions/tjvm.cert \
-     workshops/2000/moore-manolios/partial-functions/examples.lisp \
-     workshops/2000/moore-manolios/partial-functions/examples.acl2
-
-
-workshops/2000/moore-manolios/partial-functions/mod-1-property.cert : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/mod-1-property.cert : no_pcert = 0
-
-workshops/2000/moore-manolios/partial-functions/mod-1-property.cert : \
-     ihs/quotient-remainder-lemmas.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2000/moore-manolios/partial-functions/mod-1-property.lisp
-
-
-workshops/2000/moore-manolios/partial-functions/report.cert : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/report.cert : no_pcert = 0
-
-workshops/2000/moore-manolios/partial-functions/report.cert : \
-     workshops/2000/moore-manolios/partial-functions/defpun.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2000/moore-manolios/partial-functions/mod-1-property.cert \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.cert \
-     workshops/2000/moore-manolios/partial-functions/report.lisp
-
-
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.cert : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.cert : no_pcert = 0
-
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.cert : \
-     workshops/2000/moore-manolios/partial-functions/defpun.cert \
-     workshops/2000/moore-manolios/partial-functions/examples.cert \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.lisp \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.acl2
-
-
-workshops/2000/moore-manolios/partial-functions/tjvm.cert : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/tjvm.cert : no_pcert = 0
-
-workshops/2000/moore-manolios/partial-functions/tjvm.cert : \
-     workshops/2000/moore-manolios/partial-functions/tjvm.lisp \
-     workshops/2000/moore-manolios/partial-functions/tjvm.acl2
-
-
-workshops/2000/ruiz/multiset/defmul.cert : acl2x = 0
-workshops/2000/ruiz/multiset/defmul.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/defmul.cert : \
-     workshops/2000/ruiz/multiset/multiset.cert \
-     workshops/2000/ruiz/multiset/defmul.lisp \
-     workshops/2000/ruiz/multiset/defmul.acl2
-
-
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.cert : acl2x = 0
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.cert : \
-     workshops/2000/ruiz/multiset/defmul.cert \
-     workshops/2000/ruiz/multiset/examples/ackermann/ackermann.lisp
-
-
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.cert : acl2x = 0
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.cert : \
-     workshops/2000/ruiz/multiset/defmul.cert \
-     workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.lisp
-
-
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert : \
-     data-structures/structures.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.lisp
-
-
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.cert : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.cert : \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert \
-     workshops/2000/ruiz/multiset/examples/newman/confluence-v0.lisp \
-     workshops/2000/ruiz/multiset/examples/newman/confluence-v0.acl2
-
-
-workshops/2000/ruiz/multiset/examples/newman/confluence.cert : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/examples/newman/confluence.cert : \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.lisp \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.acl2
-
-
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.cert : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.cert : \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.cert \
-     workshops/2000/ruiz/multiset/examples/newman/newman.cert \
-     workshops/2000/ruiz/multiset/examples/newman/local-confluence.lisp \
-     workshops/2000/ruiz/multiset/examples/newman/local-confluence.acl2
-
-
-workshops/2000/ruiz/multiset/examples/newman/newman.cert : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/newman.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/examples/newman/newman.cert : \
-     workshops/2000/ruiz/multiset/defmul.cert \
-     ordinals/ordinals-without-arithmetic.cert \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert \
-     workshops/2000/ruiz/multiset/examples/newman/newman.lisp \
-     workshops/2000/ruiz/multiset/examples/newman/newman.acl2
-
-
-workshops/2000/ruiz/multiset/multiset.cert : acl2x = 0
-workshops/2000/ruiz/multiset/multiset.cert : no_pcert = 0
-
-workshops/2000/ruiz/multiset/multiset.cert : \
-     ordinals/e0-ordinal.cert \
-     workshops/2000/ruiz/multiset/multiset.lisp \
-     workshops/2000/ruiz/multiset/multiset.acl2
-
-
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.cert : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.cert : no_pcert = 0
-
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.cert : \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.cert \
-     rtl/rel1/lib3/top.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-
-
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.cert : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.cert : no_pcert = 0
-
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.cert : \
-     rtl/rel1/lib3/top.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-
-
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.cert : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.cert : no_pcert = 0
-
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.cert : \
-     rtl/rel1/lib3/top.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-
-
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.cert : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.cert : no_pcert = 0
-
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.cert : \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.cert \
-     rtl/rel1/lib3/top.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-
-
-workshops/2000/russinoff-kaufmann/supporting-materials/main.cert : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/main.cert : no_pcert = 0
-
-workshops/2000/russinoff-kaufmann/supporting-materials/main.cert : \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.cert \
-     rtl/rel1/lib3/top.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/main.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/main.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-
-
-workshops/2000/russinoff-kaufmann/supporting-materials/model.cert : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/model.cert : no_pcert = 0
-
-workshops/2000/russinoff-kaufmann/supporting-materials/model.cert : \
-     rtl/rel1/lib3/top.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-
-
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.cert : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.cert : no_pcert = 0
-
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.cert : \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.cert \
-     rtl/rel1/lib3/top.cert \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-
-
-workshops/2000/russinoff-short/crt.cert : acl2x = 0
-workshops/2000/russinoff-short/crt.cert : no_pcert = 0
-
-workshops/2000/russinoff-short/crt.cert : \
-     rtl/rel1/lib1/basic.cert \
-     rtl/rel1/support/fp.cert \
-     workshops/2000/russinoff-short/crt.lisp
-
-
-workshops/2000/russinoff-short/summary.cert : acl2x = 0
-workshops/2000/russinoff-short/summary.cert : no_pcert = 0
-
-workshops/2000/russinoff-short/summary.cert : \
-     workshops/2000/russinoff-short/crt.cert \
-     workshops/2000/russinoff-short/summary.lisp
-
-
-workshops/2000/sumners1/cdeq/cdeq-defs.cert : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-defs.cert : no_pcert = 0
-
-workshops/2000/sumners1/cdeq/cdeq-defs.cert : \
-     workshops/2000/sumners1/cdeq/records.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2000/sumners1/cdeq/cdeq-defs.lisp
-
-
-workshops/2000/sumners1/cdeq/cdeq-phase1.cert : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase1.cert : no_pcert = 0
-
-workshops/2000/sumners1/cdeq/cdeq-phase1.cert : \
-     workshops/2000/sumners1/cdeq/cdeq-defs.cert \
-     workshops/2000/sumners1/cdeq/cdeq-phase1.lisp
-
-
-workshops/2000/sumners1/cdeq/cdeq-phase2.cert : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase2.cert : no_pcert = 0
-
-workshops/2000/sumners1/cdeq/cdeq-phase2.cert : \
-     workshops/2000/sumners1/cdeq/cdeq-defs.cert \
-     workshops/2000/sumners1/cdeq/cdeq-phase2.lisp
-
-
-workshops/2000/sumners1/cdeq/cdeq-phase3.cert : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase3.cert : no_pcert = 0
-
-workshops/2000/sumners1/cdeq/cdeq-phase3.cert : \
-     workshops/2000/sumners1/cdeq/cdeq-defs.cert \
-     workshops/2000/sumners1/cdeq/cdeq-phase3.lisp
-
-
-workshops/2000/sumners1/cdeq/cdeq-phase4.cert : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase4.cert : no_pcert = 0
-
-workshops/2000/sumners1/cdeq/cdeq-phase4.cert : \
-     workshops/2000/sumners1/cdeq/cdeq-defs.cert \
-     workshops/2000/sumners1/cdeq/cdeq-phase4.lisp
-
-
-workshops/2000/sumners1/cdeq/records.cert : acl2x = 0
-workshops/2000/sumners1/cdeq/records.cert : no_pcert = 0
-
-workshops/2000/sumners1/cdeq/records.cert : \
-     misc/total-order.cert \
-     workshops/2000/sumners1/cdeq/records.lisp
-
-
-workshops/2000/sumners2/bdds/bdd-mgr.cert : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-mgr.cert : no_pcert = 0
-
-workshops/2000/sumners2/bdds/bdd-mgr.cert : \
-     workshops/2000/sumners2/bdds/bdd-mgr.lisp
-
-
-workshops/2000/sumners2/bdds/bdd-prf.cert : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-prf.cert : no_pcert = 0
-
-workshops/2000/sumners2/bdds/bdd-prf.cert : \
-     workshops/2000/sumners2/bdds/bdd-spec.cert \
-     workshops/2000/sumners2/bdds/bdd-prf.lisp
-
-
-workshops/2000/sumners2/bdds/bdd-spec.cert : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-spec.cert : no_pcert = 0
-
-workshops/2000/sumners2/bdds/bdd-spec.cert : \
-     workshops/2000/sumners2/bdds/bdd-mgr.cert \
-     workshops/2000/sumners2/bdds/bdd-spec.lisp
-
-
-workshops/2002/cowles-flat/support/flat-ackermann.cert : acl2x = 0
-workshops/2002/cowles-flat/support/flat-ackermann.cert : no_pcert = 0
-
-workshops/2002/cowles-flat/support/flat-ackermann.cert : \
-     workshops/2002/cowles-flat/support/flat.cert \
-     workshops/2002/cowles-flat/support/flat-ackermann.lisp \
-     workshops/2002/cowles-flat/support/flat-ackermann.acl2
-
-
-workshops/2002/cowles-flat/support/flat-nested.cert : acl2x = 0
-workshops/2002/cowles-flat/support/flat-nested.cert : no_pcert = 0
-
-workshops/2002/cowles-flat/support/flat-nested.cert : \
-     workshops/2002/cowles-flat/support/flat.cert \
-     workshops/2002/cowles-flat/support/flat-nested.lisp \
-     workshops/2002/cowles-flat/support/flat-nested.acl2
-
-
-workshops/2002/cowles-flat/support/flat-primitive.cert : acl2x = 0
-workshops/2002/cowles-flat/support/flat-primitive.cert : no_pcert = 0
-
-workshops/2002/cowles-flat/support/flat-primitive.cert : \
-     workshops/2002/cowles-flat/support/flat.cert \
-     workshops/2002/cowles-flat/support/flat-primitive.lisp \
-     workshops/2002/cowles-flat/support/flat-primitive.acl2
-
-
-workshops/2002/cowles-flat/support/flat-reverse.cert : acl2x = 0
-workshops/2002/cowles-flat/support/flat-reverse.cert : no_pcert = 0
-
-workshops/2002/cowles-flat/support/flat-reverse.cert : \
-     workshops/2002/cowles-flat/support/flat.cert \
-     workshops/2002/cowles-flat/support/flat-reverse.lisp \
-     workshops/2002/cowles-flat/support/flat-reverse.acl2
-
-
-workshops/2002/cowles-flat/support/flat-tail.cert : acl2x = 0
-workshops/2002/cowles-flat/support/flat-tail.cert : no_pcert = 0
-
-workshops/2002/cowles-flat/support/flat-tail.cert : \
-     workshops/2002/cowles-flat/support/flat.cert \
-     workshops/2002/cowles-flat/support/flat-tail.lisp \
-     workshops/2002/cowles-flat/support/flat-tail.acl2
-
-
-workshops/2002/cowles-flat/support/flat-z.cert : acl2x = 0
-workshops/2002/cowles-flat/support/flat-z.cert : no_pcert = 0
-
-workshops/2002/cowles-flat/support/flat-z.cert : \
-     workshops/2002/cowles-flat/support/flat.cert \
-     workshops/2002/cowles-flat/support/flat-z.lisp \
-     workshops/2002/cowles-flat/support/flat-z.acl2
-
-
-workshops/2002/cowles-flat/support/flat.cert : acl2x = 0
-workshops/2002/cowles-flat/support/flat.cert : no_pcert = 0
-
-workshops/2002/cowles-flat/support/flat.cert : \
-     workshops/2002/cowles-flat/support/flat.lisp \
-     workshops/2002/cowles-flat/support/flat.acl2
-
-
-workshops/2002/cowles-primrec/support/bad-def.cert : acl2x = 0
-workshops/2002/cowles-primrec/support/bad-def.cert : no_pcert = 0
-
-workshops/2002/cowles-primrec/support/bad-def.cert : \
-     workshops/2002/cowles-primrec/support/bad-def.lisp \
-     workshops/2002/cowles-primrec/support/bad-def.acl2
-
-
-workshops/2002/cowles-primrec/support/bad-def1.cert : acl2x = 0
-workshops/2002/cowles-primrec/support/bad-def1.cert : no_pcert = 0
-
-workshops/2002/cowles-primrec/support/bad-def1.cert : \
-     workshops/2002/cowles-primrec/support/bad-def1.lisp \
-     workshops/2002/cowles-primrec/support/bad-def1.acl2
-
-
-workshops/2002/cowles-primrec/support/defpr.cert : acl2x = 0
-workshops/2002/cowles-primrec/support/defpr.cert : no_pcert = 0
-
-workshops/2002/cowles-primrec/support/defpr.cert : \
-     workshops/2002/cowles-primrec/support/defpr.lisp
-
-
-workshops/2002/cowles-primrec/support/fix.cert : acl2x = 0
-workshops/2002/cowles-primrec/support/fix.cert : no_pcert = 0
-
-workshops/2002/cowles-primrec/support/fix.cert : \
-     workshops/2002/cowles-primrec/support/fix.lisp
-
-
-workshops/2002/cowles-primrec/support/primitive.cert : acl2x = 0
-workshops/2002/cowles-primrec/support/primitive.cert : no_pcert = 0
-
-workshops/2002/cowles-primrec/support/primitive.cert : \
-     workshops/2002/cowles-primrec/support/primitive.lisp
-
-
-workshops/2002/cowles-primrec/support/tail.cert : acl2x = 0
-workshops/2002/cowles-primrec/support/tail.cert : no_pcert = 0
-
-workshops/2002/cowles-primrec/support/tail.cert : \
-     workshops/2002/cowles-primrec/support/tail.lisp
-
-
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.cert : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.cert : no_pcert = 0
-
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.cert : \
-     workshops/2002/georgelin-borrione-ostier/support/utils.cert \
-     workshops/2002/georgelin-borrione-ostier/support/generates-functions.cert \
-     workshops/2002/georgelin-borrione-ostier/support/generates-theorems.cert \
-     workshops/2002/georgelin-borrione-ostier/support/acl2-transl.lisp
-
-
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.cert : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.cert : no_pcert = 0
-
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.cert : \
-     workshops/2002/georgelin-borrione-ostier/support/utils.cert \
-     workshops/2002/georgelin-borrione-ostier/support/generates-functions.lisp
-
-
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.cert : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.cert : no_pcert = 0
-
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.cert : \
-     workshops/2002/georgelin-borrione-ostier/support/utils.cert \
-     workshops/2002/georgelin-borrione-ostier/support/generates-theorems.lisp
-
-
-workshops/2002/georgelin-borrione-ostier/support/utils.cert : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/utils.cert : no_pcert = 0
-
-workshops/2002/georgelin-borrione-ostier/support/utils.cert : \
-     arithmetic/top.cert \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     misc/expander.cert \
-     workshops/2002/georgelin-borrione-ostier/support/utils.lisp
-
-
-workshops/2002/kaufmann-sumners/support/records.cert : acl2x = 0
-workshops/2002/kaufmann-sumners/support/records.cert : no_pcert = 0
-
-workshops/2002/kaufmann-sumners/support/records.cert : \
-     misc/total-order.cert \
-     workshops/2002/kaufmann-sumners/support/records.lisp
-
-
-workshops/2002/kaufmann-sumners/support/records0.cert : acl2x = 0
-workshops/2002/kaufmann-sumners/support/records0.cert : no_pcert = 0
-
-workshops/2002/kaufmann-sumners/support/records0.cert : \
-     misc/total-order.cert \
-     workshops/2002/kaufmann-sumners/support/records0.lisp
-
-
-workshops/2002/kaufmann-sumners/support/sets.cert : acl2x = 0
-workshops/2002/kaufmann-sumners/support/sets.cert : no_pcert = 0
-
-workshops/2002/kaufmann-sumners/support/sets.cert : \
-     misc/total-order.cert \
-     workshops/2002/kaufmann-sumners/support/sets.lisp
-
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.cert : \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.lisp \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.acl2
-
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.cert : \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.lisp \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.acl2
-
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.cert : \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.lisp
-
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.cert : \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.lisp
-
-
-workshops/2002/manolios-kaufmann/support/records/records-original.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/records-original.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/records/records-original.cert : \
-     workshops/2002/manolios-kaufmann/support/records/records-original.lisp
-
-
-workshops/2002/manolios-kaufmann/support/records/records.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/records.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/records/records.cert : \
-     workshops/2002/manolios-kaufmann/support/records/total-order.cert \
-     workshops/2002/manolios-kaufmann/support/records/records.lisp
-
-
-workshops/2002/manolios-kaufmann/support/records/total-order.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/total-order.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/records/total-order.cert : \
-     misc/total-order.cert \
-     workshops/2002/manolios-kaufmann/support/records/total-order.lisp
-
-
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.cert : \
-     workshops/2002/manolios-kaufmann/support/sorting/perm-order.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.lisp
-
-
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.cert : \
-     workshops/2002/manolios-kaufmann/support/sorting/perm.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/total-order.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/perm-order.lisp
-
-
-workshops/2002/manolios-kaufmann/support/sorting/perm.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/sorting/perm.cert : \
-     workshops/2002/manolios-kaufmann/support/sorting/perm.lisp
-
-
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.cert : \
-     workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/quicksort.lisp
-
-
-workshops/2002/manolios-kaufmann/support/sorting/total-order.cert : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/total-order.cert : no_pcert = 0
-
-workshops/2002/manolios-kaufmann/support/sorting/total-order.cert : \
-     misc/total-order.cert \
-     workshops/2002/manolios-kaufmann/support/sorting/total-order.lisp
-
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.cert : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.cert : no_pcert = 0
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.cert : \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.cert \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.lisp
-
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.cert : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.cert : no_pcert = 0
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.cert : \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.lisp
-
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.cert : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.cert : no_pcert = 0
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.cert : \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.cert \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.lisp
-
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.cert : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.cert : no_pcert = 0
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.cert : \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.cert \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.lisp
-
-
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.cert : acl2x = 0
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.cert : no_pcert = 0
-
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.cert : \
-     workshops/2002/martin-alonso-perez-sancho/support/Adleman.lisp
-
-
-workshops/2002/medina-palomo-alonso/support/section-2/npol.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/npol.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-2/npol.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.cert \
-     workshops/2002/medina-palomo-alonso/support/section-2/npol.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-2/npol.acl2
-
-
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-1.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-1.acl2
-
-
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.acl2
-
-
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.acl2
-
-
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.cert \
-     ordinals/ordinals-without-arithmetic.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.acl2
-
-
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.cert \
-     ordinals/ordinals-without-arithmetic.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.acl2
-
-
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.acl2
-
-
-workshops/2002/medina-palomo-alonso/support/section-3/term.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/term.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-3/term.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.acl2
-
-
-workshops/2002/medina-palomo-alonso/support/section-3/upol.cert : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/upol.cert : no_pcert = 0
-
-workshops/2002/medina-palomo-alonso/support/section-3/upol.cert : \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.cert \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.acl2
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert \
-     ordinals/ordinals-without-arithmetic.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.lisp
-
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.cert : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.cert : no_pcert = 0
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.cert : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.cert \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.lisp
-
-
-workshops/2003/austel/support/abs-type.cert : acl2x = 0
-workshops/2003/austel/support/abs-type.cert : no_pcert = 0
-
-workshops/2003/austel/support/abs-type.cert : \
-     workshops/2003/austel/support/abs-type.lisp
-
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.cert : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.cert : no_pcert = 0
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.cert : \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.lisp
-
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.cert : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.cert : no_pcert = 0
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.cert : \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.lisp
-
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.cert : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.cert : no_pcert = 0
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.cert : \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.lisp
-
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.cert : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.cert : no_pcert = 0
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.cert : \
-     arithmetic/top.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.lisp
-
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.cert : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.cert : no_pcert = 0
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.cert : \
-     workshops/2003/gamboa-cowles-van-baalen/support/linalg.cert \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.lisp \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.acl2 \
-     workshops/2003/gamboa-cowles-van-baalen/support/defpkg.lsp
-
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.cert : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.cert : no_pcert = 0
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.cert : \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.cert \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.lisp \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.acl2 \
-     workshops/2003/gamboa-cowles-van-baalen/support/defpkg.lsp
-
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.cert : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.cert : no_pcert = 0
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.cert : \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.cert \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.lisp \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.acl2 \
-     workshops/2003/gamboa-cowles-van-baalen/support/defpkg.lsp
-
-
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.cert : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.cert : no_pcert = 0
-
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.cert : \
-     arithmetic/top.cert \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.cert \
-     workshops/2003/gamboa-cowles-van-baalen/support/linalg.lisp
-
-
-workshops/2003/greve-wilding_defrecord/support/defrecord.cert : acl2x = 0
-workshops/2003/greve-wilding_defrecord/support/defrecord.cert : no_pcert = 0
-
-workshops/2003/greve-wilding_defrecord/support/defrecord.cert : \
-     misc/records.cert \
-     workshops/2003/greve-wilding_defrecord/support/defrecord.lisp
-
-
-workshops/2003/greve-wilding_mbe/support/fpst.cert : acl2x = 0
-workshops/2003/greve-wilding_mbe/support/fpst.cert : no_pcert = 0
-
-workshops/2003/greve-wilding_mbe/support/fpst.cert : \
-     workshops/1999/graph/linear-find-path.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/greve-wilding_mbe/support/fpst.lisp
-
-
-workshops/2003/greve-wilding_mbe/support/run-fpst.cert : acl2x = 0
-workshops/2003/greve-wilding_mbe/support/run-fpst.cert : no_pcert = 0
-
-workshops/2003/greve-wilding_mbe/support/run-fpst.cert : \
-     workshops/2003/greve-wilding_mbe/support/fpst.cert \
-     workshops/2003/greve-wilding_mbe/support/run-fpst.lisp
-
-
-workshops/2003/hbl/support/sol1.cert : acl2x = 0
-workshops/2003/hbl/support/sol1.cert : no_pcert = 0
-
-workshops/2003/hbl/support/sol1.cert : \
-     misc/records.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2003/hbl/support/sol1.lisp
-
-
-workshops/2003/hbl/support/sol2.cert : acl2x = 0
-workshops/2003/hbl/support/sol2.cert : no_pcert = 0
-
-workshops/2003/hbl/support/sol2.cert : \
-     misc/records.cert \
-     arithmetic/top-with-meta.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/hbl/support/sol2.lisp
-
-
-workshops/2003/hendrix/support/madd.cert : acl2x = 0
-workshops/2003/hendrix/support/madd.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/madd.cert : \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mzero.cert \
-     workshops/2003/hendrix/support/mentry.cert \
-     workshops/2003/hendrix/support/madd.lisp
-
-
-workshops/2003/hendrix/support/matrices.cert : acl2x = 0
-workshops/2003/hendrix/support/matrices.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/matrices.cert : \
-     workshops/2003/hendrix/support/vector.cert \
-     workshops/2003/hendrix/support/mdefuns.cert \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mentry.cert \
-     workshops/2003/hendrix/support/mzero.cert \
-     workshops/2003/hendrix/support/madd.cert \
-     workshops/2003/hendrix/support/mscal.cert \
-     workshops/2003/hendrix/support/msub.cert \
-     workshops/2003/hendrix/support/mid.cert \
-     workshops/2003/hendrix/support/mmult.cert \
-     workshops/2003/hendrix/support/mtrans.cert \
-     workshops/2003/hendrix/support/matrices.lisp
-
-
-workshops/2003/hendrix/support/mdefthms.cert : acl2x = 0
-workshops/2003/hendrix/support/mdefthms.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/mdefthms.cert : \
-     workshops/2003/hendrix/support/mdefuns.cert \
-     workshops/2003/hendrix/support/mdefthms.lisp
-
-
-workshops/2003/hendrix/support/mdefuns.cert : acl2x = 0
-workshops/2003/hendrix/support/mdefuns.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/mdefuns.cert : \
-     workshops/2003/hendrix/support/vector.cert \
-     workshops/2003/hendrix/support/mdefuns.lisp
-
-
-workshops/2003/hendrix/support/mentry.cert : acl2x = 0
-workshops/2003/hendrix/support/mentry.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/mentry.cert : \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mentry.lisp
-
-
-workshops/2003/hendrix/support/mid.cert : acl2x = 0
-workshops/2003/hendrix/support/mid.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/mid.cert : \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mid.lisp
-
-
-workshops/2003/hendrix/support/mmult.cert : acl2x = 0
-workshops/2003/hendrix/support/mmult.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/mmult.cert : \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mzero.cert \
-     workshops/2003/hendrix/support/madd.cert \
-     workshops/2003/hendrix/support/mscal.cert \
-     workshops/2003/hendrix/support/mid.cert \
-     workshops/2003/hendrix/support/mentry.cert \
-     workshops/2003/hendrix/support/mmult.lisp
-
-
-workshops/2003/hendrix/support/mscal.cert : acl2x = 0
-workshops/2003/hendrix/support/mscal.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/mscal.cert : \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mzero.cert \
-     workshops/2003/hendrix/support/madd.cert \
-     workshops/2003/hendrix/support/mentry.cert \
-     workshops/2003/hendrix/support/mscal.lisp
-
-
-workshops/2003/hendrix/support/msub.cert : acl2x = 0
-workshops/2003/hendrix/support/msub.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/msub.cert : \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/madd.cert \
-     workshops/2003/hendrix/support/mscal.cert \
-     workshops/2003/hendrix/support/msub.lisp
-
-
-workshops/2003/hendrix/support/mtrans.cert : acl2x = 0
-workshops/2003/hendrix/support/mtrans.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/mtrans.cert : \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mzero.cert \
-     workshops/2003/hendrix/support/madd.cert \
-     workshops/2003/hendrix/support/mid.cert \
-     workshops/2003/hendrix/support/mscal.cert \
-     workshops/2003/hendrix/support/mmult.cert \
-     workshops/2003/hendrix/support/mentry.cert \
-     workshops/2003/hendrix/support/mtrans.lisp
-
-
-workshops/2003/hendrix/support/mzero.cert : acl2x = 0
-workshops/2003/hendrix/support/mzero.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/mzero.cert : \
-     workshops/2003/hendrix/support/mdefthms.cert \
-     workshops/2003/hendrix/support/mzero.lisp
-
-
-workshops/2003/hendrix/support/vector.cert : acl2x = 0
-workshops/2003/hendrix/support/vector.cert : no_pcert = 0
-
-workshops/2003/hendrix/support/vector.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2003/hendrix/support/vector.lisp
-
-
-workshops/2003/matlin-mccune/support/simp.cert : acl2x = 0
-workshops/2003/matlin-mccune/support/simp.cert : no_pcert = 0
-
-workshops/2003/matlin-mccune/support/simp.cert : \
-     ordinals/e0-ordinal.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2003/matlin-mccune/support/simp.lisp
-
-
-workshops/2003/moore_rockwell/support/memory-taggings.cert : acl2x = 0
-workshops/2003/moore_rockwell/support/memory-taggings.cert : no_pcert = 0
-
-workshops/2003/moore_rockwell/support/memory-taggings.cert : \
-     misc/records.cert \
-     arithmetic/top-with-meta.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/moore_rockwell/support/memory-taggings.lisp
-
-
-workshops/2003/moore_vcg/support/demo.cert : acl2x = 0
-workshops/2003/moore_vcg/support/demo.cert : no_pcert = 0
-
-workshops/2003/moore_vcg/support/demo.cert : \
-     workshops/2003/moore_vcg/support/utilities.cert \
-     workshops/2003/moore_vcg/support/demo.lisp \
-     workshops/2003/moore_vcg/support/demo.acl2
-
-
-workshops/2003/moore_vcg/support/m5.cert : acl2x = 0
-workshops/2003/moore_vcg/support/m5.cert : no_pcert = 0
-
-workshops/2003/moore_vcg/support/m5.cert : \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/moore_vcg/support/m5.lisp \
-     workshops/2003/moore_vcg/support/m5.acl2
-
-
-workshops/2003/moore_vcg/support/utilities.cert : acl2x = 0
-workshops/2003/moore_vcg/support/utilities.cert : no_pcert = 0
-
-workshops/2003/moore_vcg/support/utilities.cert : \
-     arithmetic/top-with-meta.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2003/moore_vcg/support/m5.cert \
-     workshops/2003/moore_vcg/support/utilities.lisp \
-     workshops/2003/moore_vcg/support/utilities.acl2
-
-
-workshops/2003/moore_vcg/support/vcg-examples.cert : acl2x = 0
-workshops/2003/moore_vcg/support/vcg-examples.cert : no_pcert = 0
-
-workshops/2003/moore_vcg/support/vcg-examples.cert : \
-     misc/defpun.cert \
-     workshops/2003/moore_vcg/support/demo.cert \
-     workshops/2003/moore_vcg/support/utilities.cert \
-     workshops/2003/moore_vcg/support/vcg-examples.lisp \
-     workshops/2003/moore_vcg/support/vcg-examples.acl2
-
-
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.cert : \
-     workshops/2003/ray-matthews-tuttle/support/total-order.cert \
-     workshops/2003/ray-matthews-tuttle/support/apply-total-order.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.cert : \
-     workshops/2003/ray-matthews-tuttle/support/ltl.cert \
-     arithmetic-2/meta/top.cert \
-     workshops/2003/ray-matthews-tuttle/support/bisimilarity.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.cert : \
-     workshops/2003/ray-matthews-tuttle/support/ltl.cert \
-     workshops/2003/ray-matthews-tuttle/support/bisimilarity.cert \
-     workshops/2003/ray-matthews-tuttle/support/circuit-bisim.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/circuits.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/circuits.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/circuits.cert : \
-     workshops/2003/ray-matthews-tuttle/support/circuit-bisim.cert \
-     workshops/2003/ray-matthews-tuttle/support/circuits.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.cert : \
-     workshops/2003/ray-matthews-tuttle/support/ltl.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/ray-matthews-tuttle/support/concrete-ltl.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.cert : \
-     workshops/2003/ray-matthews-tuttle/support/circuits.cert \
-     arithmetic-2/meta/top.cert \
-     workshops/2003/ray-matthews-tuttle/support/cone-of-influence.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/conjunction.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/conjunction.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/conjunction.cert : \
-     workshops/2003/ray-matthews-tuttle/support/ltl.cert \
-     workshops/2003/ray-matthews-tuttle/support/conjunction.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/impl-hack.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/impl-hack.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/impl-hack.cert : \
-     workshops/2003/ray-matthews-tuttle/support/reductions.cert \
-     workshops/2003/ray-matthews-tuttle/support/impl-hack.lisp \
-     workshops/2003/ray-matthews-tuttle/support/impl-hack.acl2
-
-
-workshops/2003/ray-matthews-tuttle/support/ltl.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/ltl.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/ltl.cert : \
-     workshops/2003/ray-matthews-tuttle/support/sets.cert \
-     arithmetic-2/meta/top.cert \
-     workshops/2003/ray-matthews-tuttle/support/ltl.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/records.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/records.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/records.cert : \
-     workshops/2003/ray-matthews-tuttle/support/apply-total-order.cert \
-     workshops/2003/ray-matthews-tuttle/support/records.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/reductions.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/reductions.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/reductions.cert : \
-     workshops/2003/ray-matthews-tuttle/support/conjunction.cert \
-     workshops/2003/ray-matthews-tuttle/support/cone-of-influence.cert \
-     workshops/2003/ray-matthews-tuttle/support/reductions.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/sets.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/sets.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/sets.cert : \
-     workshops/2003/ray-matthews-tuttle/support/records.cert \
-     workshops/2003/ray-matthews-tuttle/support/sets.lisp
-
-
-workshops/2003/ray-matthews-tuttle/support/total-order.cert : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/total-order.cert : no_pcert = 0
-
-workshops/2003/ray-matthews-tuttle/support/total-order.cert : \
-     workshops/2003/ray-matthews-tuttle/support/total-order.lisp
-
-
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.cert : acl2x = 0
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.cert : no_pcert = 0
-
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.cert : \
-     misc/expander.cert \
-     workshops/2003/schmaltz-al-sammane-et-al/support/consistency.lisp
-
-
-workshops/2003/schmaltz-borrione/support/arbiter.cert : acl2x = 0
-workshops/2003/schmaltz-borrione/support/arbiter.cert : no_pcert = 0
-
-workshops/2003/schmaltz-borrione/support/arbiter.cert : \
-     workshops/2003/schmaltz-borrione/support/inequalities.cert \
-     workshops/2003/schmaltz-borrione/support/decoder.cert \
-     workshops/2003/schmaltz-borrione/support/predicates.cert \
-     workshops/2003/schmaltz-borrione/support/arbiter.lisp
-
-
-workshops/2003/schmaltz-borrione/support/decoder.cert : acl2x = 0
-workshops/2003/schmaltz-borrione/support/decoder.cert : no_pcert = 0
-
-workshops/2003/schmaltz-borrione/support/decoder.cert : \
-     arithmetic/top.cert \
-     arithmetic-2/floor-mod/floor-mod.cert \
-     workshops/2003/schmaltz-borrione/support/decoder.lisp
-
-
-workshops/2003/schmaltz-borrione/support/inequalities.cert : acl2x = 0
-workshops/2003/schmaltz-borrione/support/inequalities.cert : no_pcert = 0
-
-workshops/2003/schmaltz-borrione/support/inequalities.cert : \
-     arithmetic/top.cert \
-     workshops/2003/schmaltz-borrione/support/inequalities.lisp
-
-
-workshops/2003/schmaltz-borrione/support/predicates.cert : acl2x = 0
-workshops/2003/schmaltz-borrione/support/predicates.cert : no_pcert = 0
-
-workshops/2003/schmaltz-borrione/support/predicates.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2003/schmaltz-borrione/support/predicates.lisp
-
-
-workshops/2003/schmaltz-borrione/support/transfers.cert : acl2x = 0
-workshops/2003/schmaltz-borrione/support/transfers.cert : no_pcert = 0
-
-workshops/2003/schmaltz-borrione/support/transfers.cert : \
-     workshops/2003/schmaltz-borrione/support/decoder.cert \
-     workshops/2003/schmaltz-borrione/support/arbiter.cert \
-     workshops/2003/schmaltz-borrione/support/transfers.lisp
-
-
-workshops/2003/sumners/support/cfair.cert : acl2x = 0
-workshops/2003/sumners/support/cfair.cert : no_pcert = 0
-
-workshops/2003/sumners/support/cfair.cert : \
-     workshops/2003/sumners/support/n2n.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/sumners/support/cfair.lisp
-
-
-workshops/2003/sumners/support/example1.cert : acl2x = 0
-workshops/2003/sumners/support/example1.cert : no_pcert = 0
-
-workshops/2003/sumners/support/example1.cert : \
-     workshops/2003/sumners/support/fair1.cert \
-     workshops/2003/sumners/support/example1.lisp
-
-
-workshops/2003/sumners/support/example2.cert : acl2x = 0
-workshops/2003/sumners/support/example2.cert : no_pcert = 0
-
-workshops/2003/sumners/support/example2.cert : \
-     workshops/2003/sumners/support/fair2.cert \
-     workshops/2003/sumners/support/example2.lisp
-
-
-workshops/2003/sumners/support/example3.cert : acl2x = 0
-workshops/2003/sumners/support/example3.cert : no_pcert = 0
-
-workshops/2003/sumners/support/example3.cert : \
-     workshops/2003/sumners/support/fair2.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/sumners/support/example3.lisp
-
-
-workshops/2003/sumners/support/fair1.cert : acl2x = 0
-workshops/2003/sumners/support/fair1.cert : no_pcert = 0
-
-workshops/2003/sumners/support/fair1.cert : \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/sumners/support/fair1.lisp
-
-
-workshops/2003/sumners/support/fair2.cert : acl2x = 0
-workshops/2003/sumners/support/fair2.cert : no_pcert = 0
-
-workshops/2003/sumners/support/fair2.cert : \
-     ordinals/e0-ordinal.cert \
-     workshops/2003/sumners/support/n2n.cert \
-     workshops/2003/sumners/support/fair2.lisp
-
-
-workshops/2003/sumners/support/n2n.cert : acl2x = 0
-workshops/2003/sumners/support/n2n.cert : no_pcert = 0
-
-workshops/2003/sumners/support/n2n.cert : \
-     workshops/2003/sumners/support/n2n.lisp
-
-
-workshops/2003/sumners/support/simple.cert : acl2x = 0
-workshops/2003/sumners/support/simple.cert : no_pcert = 0
-
-workshops/2003/sumners/support/simple.cert : \
-     workshops/2003/sumners/support/simple.lisp
-
-
-workshops/2003/sustik/support/dickson.cert : acl2x = 0
-workshops/2003/sustik/support/dickson.cert : no_pcert = 0
-
-workshops/2003/sustik/support/dickson.cert : \
-     ordinals/ordinals.cert \
-     workshops/2003/sustik/support/dickson.lisp
-
-
-workshops/2003/toma-borrione/support/bv-op-defthms.cert : acl2x = 0
-workshops/2003/toma-borrione/support/bv-op-defthms.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/bv-op-defthms.cert : \
-     workshops/2003/toma-borrione/support/bv-op-defuns.cert \
-     workshops/2003/toma-borrione/support/bv-op-defthms.lisp
-
-
-workshops/2003/toma-borrione/support/bv-op-defuns.cert : acl2x = 0
-workshops/2003/toma-borrione/support/bv-op-defuns.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/bv-op-defuns.cert : \
-     workshops/2003/toma-borrione/support/misc.cert \
-     workshops/2003/toma-borrione/support/bv-op-defuns.lisp
-
-
-workshops/2003/toma-borrione/support/misc.cert : acl2x = 0
-workshops/2003/toma-borrione/support/misc.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/misc.cert : \
-     arithmetic/equalities.cert \
-     arithmetic/inequalities.cert \
-     arithmetic-2/floor-mod/floor-mod.cert \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2003/toma-borrione/support/misc.lisp
-
-
-workshops/2003/toma-borrione/support/padding-1-256.cert : acl2x = 0
-workshops/2003/toma-borrione/support/padding-1-256.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/padding-1-256.cert : \
-     workshops/2003/toma-borrione/support/bv-op-defthms.cert \
-     workshops/2003/toma-borrione/support/padding-1-256.lisp
-
-
-workshops/2003/toma-borrione/support/padding-384-512.cert : acl2x = 0
-workshops/2003/toma-borrione/support/padding-384-512.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/padding-384-512.cert : \
-     workshops/2003/toma-borrione/support/bv-op-defthms.cert \
-     workshops/2003/toma-borrione/support/padding-384-512.lisp
-
-
-workshops/2003/toma-borrione/support/parsing.cert : acl2x = 0
-workshops/2003/toma-borrione/support/parsing.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/parsing.cert : \
-     workshops/2003/toma-borrione/support/padding-1-256.cert \
-     workshops/2003/toma-borrione/support/padding-384-512.cert \
-     workshops/2003/toma-borrione/support/parsing.lisp
-
-
-workshops/2003/toma-borrione/support/sha-1.cert : acl2x = 0
-workshops/2003/toma-borrione/support/sha-1.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/sha-1.cert : \
-     workshops/2003/toma-borrione/support/parsing.cert \
-     workshops/2003/toma-borrione/support/sha-functions.cert \
-     workshops/2003/toma-borrione/support/sha-1.lisp
-
-
-workshops/2003/toma-borrione/support/sha-256.cert : acl2x = 0
-workshops/2003/toma-borrione/support/sha-256.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/sha-256.cert : \
-     workshops/2003/toma-borrione/support/parsing.cert \
-     workshops/2003/toma-borrione/support/sha-functions.cert \
-     workshops/2003/toma-borrione/support/sha-256.lisp
-
-
-workshops/2003/toma-borrione/support/sha-384-512.cert : acl2x = 0
-workshops/2003/toma-borrione/support/sha-384-512.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/sha-384-512.cert : \
-     workshops/2003/toma-borrione/support/parsing.cert \
-     workshops/2003/toma-borrione/support/sha-functions.cert \
-     workshops/2003/toma-borrione/support/sha-384-512.lisp
-
-
-workshops/2003/toma-borrione/support/sha-functions.cert : acl2x = 0
-workshops/2003/toma-borrione/support/sha-functions.cert : no_pcert = 0
-
-workshops/2003/toma-borrione/support/sha-functions.cert : \
-     workshops/2003/toma-borrione/support/bv-op-defthms.cert \
-     workshops/2003/toma-borrione/support/sha-functions.lisp
-
-
-workshops/2003/tsong/support/shim.cert : acl2x = 0
-workshops/2003/tsong/support/shim.cert : no_pcert = 0
-
-workshops/2003/tsong/support/shim.cert : \
-     data-structures/structures.cert \
-     workshops/2003/tsong/support/shim.lisp
-
-
-workshops/2004/cowles-gamboa/support/WyoM1-correct.cert : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1-correct.cert : no_pcert = 0
-
-workshops/2004/cowles-gamboa/support/WyoM1-correct.cert : \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.cert \
-     misc/defpun.cert \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.cert \
-     workshops/2004/cowles-gamboa/support/WyoM1-correct.lisp \
-     workshops/2004/cowles-gamboa/support/WyoM1-correct.acl2
-
-
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.cert : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.cert : no_pcert = 0
-
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.cert : \
-     workshops/2004/cowles-gamboa/support/WyoM1.cert \
-     arithmetic/top.cert \
-     workshops/2004/cowles-gamboa/support/WyoM1.cert \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.lisp \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.acl2
-
-
-workshops/2004/cowles-gamboa/support/WyoM1.cert : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1.cert : no_pcert = 0
-
-workshops/2004/cowles-gamboa/support/WyoM1.cert : \
-     workshops/2004/cowles-gamboa/support/WyoM1.lisp \
-     workshops/2004/cowles-gamboa/support/WyoM1.acl2
-
-
-workshops/2004/cowles-gamboa/support/knuth.cert : acl2x = 0
-workshops/2004/cowles-gamboa/support/knuth.cert : no_pcert = 0
-
-workshops/2004/cowles-gamboa/support/knuth.cert : \
-     arithmetic/top.cert \
-     workshops/2004/cowles-gamboa/support/knuth.lisp
-
-
-workshops/2004/cowles-gamboa/support/tail-rec.cert : acl2x = 0
-workshops/2004/cowles-gamboa/support/tail-rec.cert : no_pcert = 0
-
-workshops/2004/cowles-gamboa/support/tail-rec.cert : \
-     misc/defpun.cert \
-     workshops/2004/cowles-gamboa/support/tail-rec.lisp \
-     workshops/2004/cowles-gamboa/support/tail-rec.acl2
-
-
-workshops/2004/davis/support/computed-hints.cert : acl2x = 0
-workshops/2004/davis/support/computed-hints.cert : no_pcert = 0
-
-workshops/2004/davis/support/computed-hints.cert : \
-     workshops/2004/davis/support/instance.cert \
-     workshops/2004/davis/support/computed-hints.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/fast.cert : acl2x = 0
-workshops/2004/davis/support/fast.cert : no_pcert = 0
-
-workshops/2004/davis/support/fast.cert : \
-     workshops/2004/davis/support/membership.cert \
-     workshops/2004/davis/support/fast.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/instance.cert : acl2x = 0
-workshops/2004/davis/support/instance.cert : no_pcert = 0
-
-workshops/2004/davis/support/instance.cert : \
-     workshops/2004/davis/support/instance.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/map.cert : acl2x = 0
-workshops/2004/davis/support/map.cert : no_pcert = 0
-
-workshops/2004/davis/support/map.cert : \
-     workshops/2004/davis/support/quantify.cert \
-     workshops/2004/davis/support/map.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/membership.cert : acl2x = 0
-workshops/2004/davis/support/membership.cert : no_pcert = 0
-
-workshops/2004/davis/support/membership.cert : \
-     workshops/2004/davis/support/primitives.cert \
-     workshops/2004/davis/support/computed-hints.cert \
-     workshops/2004/davis/support/membership.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/outer.cert : acl2x = 0
-workshops/2004/davis/support/outer.cert : no_pcert = 0
-
-workshops/2004/davis/support/outer.cert : \
-     workshops/2004/davis/support/fast.cert \
-     workshops/2004/davis/support/outer.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/primitives.cert : acl2x = 0
-workshops/2004/davis/support/primitives.cert : no_pcert = 0
-
-workshops/2004/davis/support/primitives.cert : \
-     workshops/2004/davis/support/primitives.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/quantify.cert : acl2x = 0
-workshops/2004/davis/support/quantify.cert : no_pcert = 0
-
-workshops/2004/davis/support/quantify.cert : \
-     workshops/2004/davis/support/sets.cert \
-     workshops/2004/davis/support/sets.cert \
-     workshops/2004/davis/support/quantify.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/set-order.cert : acl2x = 0
-workshops/2004/davis/support/set-order.cert : no_pcert = 0
-
-workshops/2004/davis/support/set-order.cert : \
-     workshops/2004/davis/support/primitives.cert \
-     workshops/2004/davis/support/membership.cert \
-     workshops/2004/davis/support/fast.cert \
-     workshops/2004/davis/support/sets.cert \
-     workshops/2004/davis/support/set-order.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/sets.cert : acl2x = 0
-workshops/2004/davis/support/sets.cert : no_pcert = 0
-
-workshops/2004/davis/support/sets.cert : \
-     workshops/2004/davis/support/computed-hints.cert \
-     workshops/2004/davis/support/primitives.cert \
-     workshops/2004/davis/support/membership.cert \
-     workshops/2004/davis/support/fast.cert \
-     workshops/2004/davis/support/outer.cert \
-     workshops/2004/davis/support/sort.cert \
-     workshops/2004/davis/support/sets.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/davis/support/sort.cert : acl2x = 0
-workshops/2004/davis/support/sort.cert : no_pcert = 0
-
-workshops/2004/davis/support/sort.cert : \
-     workshops/2004/davis/support/outer.cert \
-     workshops/2004/davis/support/sort.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-
-
-workshops/2004/gameiro-manolios/support/interval.cert : acl2x = 0
-workshops/2004/gameiro-manolios/support/interval.cert : no_pcert = 0
-
-workshops/2004/gameiro-manolios/support/interval.cert : \
-     workshops/2004/gameiro-manolios/support/top-with-meta.cert \
-     workshops/2004/gameiro-manolios/support/nth-thms.cert \
-     workshops/2004/gameiro-manolios/support/interval.lisp
-
-
-workshops/2004/gameiro-manolios/support/nth-thms.cert : acl2x = 0
-workshops/2004/gameiro-manolios/support/nth-thms.cert : no_pcert = 0
-
-workshops/2004/gameiro-manolios/support/nth-thms.cert : \
-     workshops/2004/gameiro-manolios/support/nth-thms.lisp
-
-
-workshops/2004/gameiro-manolios/support/top-with-meta.cert : acl2x = 0
-workshops/2004/gameiro-manolios/support/top-with-meta.cert : no_pcert = 0
-
-workshops/2004/gameiro-manolios/support/top-with-meta.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2004/gameiro-manolios/support/top-with-meta.lisp
-
-
-workshops/2004/gameiro-manolios/support/transversality.cert : acl2x = 0
-workshops/2004/gameiro-manolios/support/transversality.cert : no_pcert = 0
-
-workshops/2004/gameiro-manolios/support/transversality.cert : \
-     workshops/2004/gameiro-manolios/support/interval.cert \
-     workshops/2004/gameiro-manolios/support/transversality.lisp
-
-
-workshops/2004/greve/support/defrecord.cert : acl2x = 0
-workshops/2004/greve/support/defrecord.cert : no_pcert = 0
-
-workshops/2004/greve/support/defrecord.cert : \
-     misc/records.cert \
-     workshops/2004/greve/support/defrecord.lisp
-
-
-workshops/2004/greve/support/mark.cert : acl2x = 0
-workshops/2004/greve/support/mark.cert : no_pcert = 0
-
-workshops/2004/greve/support/mark.cert : \
-     workshops/2004/greve/support/defrecord.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2004/greve/support/mark.lisp
-
-
-workshops/2004/legato/support/generic-theories.cert : acl2x = 0
-workshops/2004/legato/support/generic-theories.cert : no_pcert = 0
-
-workshops/2004/legato/support/generic-theories.cert : \
-     workshops/2004/legato/support/generic-theories.lisp
-
-
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.cert : acl2x = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.cert : no_pcert = 0
-
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/legato/support/generic-theories.cert \
-     workshops/2004/legato/support/generic-theory-alternative-induction-mult.lisp
-
-
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.cert : acl2x = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.cert : no_pcert = 0
-
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/legato/support/generic-theories.cert \
-     workshops/2004/legato/support/generic-theory-alternative-induction-sum.lisp
-
-
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.cert : acl2x = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.cert : no_pcert = 0
-
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/legato/support/generic-theories.cert \
-     workshops/2004/legato/support/generic-theory-loop-invariant-mult.lisp
-
-
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.cert : acl2x = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.cert : no_pcert = 0
-
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/legato/support/generic-theories.cert \
-     workshops/2004/legato/support/generic-theory-loop-invariant-sum.lisp
-
-
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.cert : acl2x = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.cert : no_pcert = 0
-
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/legato/support/generic-theories.cert \
-     workshops/2004/legato/support/generic-theory-tail-recursion-mult.lisp
-
-
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.cert : acl2x = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.cert : no_pcert = 0
-
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/legato/support/generic-theories.cert \
-     workshops/2004/legato/support/generic-theory-tail-recursion-sum.lisp
-
-
-workshops/2004/legato/support/proof-by-generalization-mult.cert : acl2x = 0
-workshops/2004/legato/support/proof-by-generalization-mult.cert : no_pcert = 0
-
-workshops/2004/legato/support/proof-by-generalization-mult.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/legato/support/proof-by-generalization-mult.lisp
-
-
-workshops/2004/legato/support/proof-by-generalization-sum.cert : acl2x = 0
-workshops/2004/legato/support/proof-by-generalization-sum.cert : no_pcert = 0
-
-workshops/2004/legato/support/proof-by-generalization-sum.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/legato/support/proof-by-generalization-sum.lisp
-
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.cert : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.cert : no_pcert = 0
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.cert : \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.lisp
-
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.cert : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.cert : no_pcert = 0
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.lisp
-
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.cert : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.cert : no_pcert = 0
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.cert : \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.cert \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/records.lisp
-
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.cert : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.cert : no_pcert = 0
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.cert : \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.lisp
-
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.cert : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.cert : no_pcert = 0
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.cert : \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.lisp
-
-
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.cert : acl2x = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.cert : no_pcert = 0
-
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.cert : \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.cert \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.lisp
-
-
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.cert : acl2x = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.cert : no_pcert = 0
-
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.cert : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.cert \
-     rtl/rel4/arithmetic/top.cert \
-     arithmetic/top-with-meta.cert \
-     misc/defpun.cert \
-     ordinals/ordinals.cert \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.lisp
-
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.cert : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.cert : no_pcert = 0
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.cert : \
-     arithmetic-2/meta/top.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.lisp
-
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.cert : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.cert : no_pcert = 0
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.cert : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.lisp
-
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.cert : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.cert : no_pcert = 0
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.cert : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.cert \
-     misc/defpun.cert \
-     ordinals/ordinals.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.lisp
-
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.cert : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.cert : no_pcert = 0
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.cert : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.lisp
-
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.cert : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.cert : no_pcert = 0
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.cert : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.cert \
-     arithmetic/top-with-meta.cert \
-     data-structures/list-defthms.cert \
-     ihs/logops-lemmas.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.lisp
-
-
-workshops/2004/ray/support/defcoerce.cert : acl2x = 0
-workshops/2004/ray/support/defcoerce.cert : no_pcert = 0
-
-workshops/2004/ray/support/defcoerce.cert : \
-     arithmetic-2/meta/top.cert \
-     workshops/2004/ray/support/generic.cert \
-     workshops/2004/ray/support/defcoerce.lisp
-
-
-workshops/2004/ray/support/defpun-exec.cert : acl2x = 0
-workshops/2004/ray/support/defpun-exec.cert : no_pcert = 0
-
-workshops/2004/ray/support/defpun-exec.cert : \
-     misc/defpun.cert \
-     workshops/2004/ray/support/defpun-exec.lisp
-
-
-workshops/2004/ray/support/generic.cert : acl2x = 0
-workshops/2004/ray/support/generic.cert : no_pcert = 0
-
-workshops/2004/ray/support/generic.cert : \
-     arithmetic-2/meta/top.cert \
-     workshops/2004/ray/support/generic.lisp
-
-
-workshops/2004/roach-fraij/support/roach-fraij-script.cert : acl2x = 0
-workshops/2004/roach-fraij/support/roach-fraij-script.cert : no_pcert = 0
-
-workshops/2004/roach-fraij/support/roach-fraij-script.cert : \
-     workshops/2004/roach-fraij/support/roach-fraij-script.lisp
-
-
-workshops/2004/ruiz-et-al/support/basic.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/basic.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/basic.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2004/ruiz-et-al/support/basic.lisp
-
-
-workshops/2004/ruiz-et-al/support/dag-unification-rules.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/dag-unification-rules.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/dag-unification-rules.cert : \
-     workshops/2004/ruiz-et-al/support/dags.cert \
-     workshops/2004/ruiz-et-al/support/prefix-unification-rules.cert \
-     workshops/2004/ruiz-et-al/support/dag-unification-rules.lisp
-
-
-workshops/2004/ruiz-et-al/support/dags.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/dags.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/dags.cert : \
-     workshops/2004/ruiz-et-al/support/basic.cert \
-     workshops/2004/ruiz-et-al/support/lists.cert \
-     workshops/2004/ruiz-et-al/support/dags.lisp
-
-
-workshops/2004/ruiz-et-al/support/lists.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/lists.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/lists.cert : \
-     workshops/2004/ruiz-et-al/support/lists.lisp
-
-
-workshops/2004/ruiz-et-al/support/matching.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/matching.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/matching.cert : \
-     workshops/2004/ruiz-et-al/support/terms.cert \
-     workshops/2004/ruiz-et-al/support/matching.lisp
-
-
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.cert : \
-     workshops/2004/ruiz-et-al/support/subsumption-subst.cert \
-     workshops/2004/ruiz-et-al/support/prefix-unification-rules.lisp
-
-
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.cert : \
-     workshops/2004/ruiz-et-al/support/dag-unification-rules.cert \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-rules.lisp
-
-
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.cert : \
-     workshops/2004/ruiz-et-al/support/q-dag-unification.cert \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-st.lisp
-
-
-workshops/2004/ruiz-et-al/support/q-dag-unification.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/q-dag-unification.cert : \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-rules.cert \
-     workshops/2004/ruiz-et-al/support/terms-as-dag.cert \
-     workshops/2004/ruiz-et-al/support/q-dag-unification.lisp
-
-
-workshops/2004/ruiz-et-al/support/subsumption-subst.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/subsumption-subst.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/subsumption-subst.cert : \
-     workshops/2004/ruiz-et-al/support/subsumption.cert \
-     workshops/2004/ruiz-et-al/support/subsumption-subst.lisp
-
-
-workshops/2004/ruiz-et-al/support/subsumption.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/subsumption.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/subsumption.cert : \
-     workshops/2004/ruiz-et-al/support/matching.cert \
-     workshops/2004/ruiz-et-al/support/terms.cert \
-     workshops/2004/ruiz-et-al/support/subsumption.lisp
-
-
-workshops/2004/ruiz-et-al/support/terms-as-dag.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/terms-as-dag.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/terms-as-dag.cert : \
-     workshops/2004/ruiz-et-al/support/dag-unification-rules.cert \
-     workshops/2004/ruiz-et-al/support/terms-as-dag.lisp
-
-
-workshops/2004/ruiz-et-al/support/terms.cert : acl2x = 0
-workshops/2004/ruiz-et-al/support/terms.cert : no_pcert = 0
-
-workshops/2004/ruiz-et-al/support/terms.cert : \
-     workshops/2004/ruiz-et-al/support/basic.cert \
-     workshops/2004/ruiz-et-al/support/terms.lisp
-
-
-workshops/2004/sawada/support/bv.cert : acl2x = 0
-workshops/2004/sawada/support/bv.cert : no_pcert = 0
-
-workshops/2004/sawada/support/bv.cert : \
-     workshops/2004/sawada/support/ihs.cert \
-     arithmetic-2/pass1/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2004/sawada/support/bv.lisp \
-     workshops/2004/sawada/support/bv.acl2 \
-     workshops/2004/sawada/support/defpkg.lsp
-
-
-workshops/2004/sawada/support/ihs.cert : acl2x = 0
-workshops/2004/sawada/support/ihs.cert : no_pcert = 0
-
-workshops/2004/sawada/support/ihs.cert : \
-     ihs/ihs-definitions.cert \
-     ihs/logops-lemmas.cert \
-     workshops/2004/sawada/support/ihs.lisp
-
-
-workshops/2004/schmaltz-borrione/support/collect_msg_book.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/collect_msg_book.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/collect_msg_book.cert : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.cert \
-     workshops/2004/schmaltz-borrione/support/node.cert \
-     workshops/2004/schmaltz-borrione/support/collect_msg_book.lisp
-
-
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.cert : \
-     workshops/2004/schmaltz-borrione/support/routing_defuns.cert \
-     workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.lisp
-
-
-workshops/2004/schmaltz-borrione/support/intersect.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/intersect.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/intersect.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.cert \
-     workshops/2004/schmaltz-borrione/support/intersect.lisp
-
-
-workshops/2004/schmaltz-borrione/support/local_trip_book.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/local_trip_book.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/local_trip_book.cert : \
-     workshops/2004/schmaltz-borrione/support/trip_book.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/schmaltz-borrione/support/local_trip_book.lisp
-
-
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.cert : \
-     workshops/2004/schmaltz-borrione/support/routing_main.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/schmaltz-borrione/support/make_travel_list_book.lisp
-
-
-workshops/2004/schmaltz-borrione/support/mod_lemmas.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/mod_lemmas.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/mod_lemmas.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/schmaltz-borrione/support/mod_lemmas.lisp
-
-
-workshops/2004/schmaltz-borrione/support/node.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/node.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/node.cert : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.cert \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2004/schmaltz-borrione/support/node.lisp
-
-
-workshops/2004/schmaltz-borrione/support/octagon_book.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/octagon_book.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/octagon_book.cert : \
-     workshops/2004/schmaltz-borrione/support/collect_msg_book.cert \
-     workshops/2004/schmaltz-borrione/support/make_travel_list_book.cert \
-     workshops/2004/schmaltz-borrione/support/scheduler_book.cert \
-     workshops/2004/schmaltz-borrione/support/trip_thms.cert \
-     workshops/2004/schmaltz-borrione/support/octagon_book.lisp
-
-
-workshops/2004/schmaltz-borrione/support/predicatesNCie.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/predicatesNCie.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/predicatesNCie.cert : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.lisp
-
-
-workshops/2004/schmaltz-borrione/support/routing_defuns.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_defuns.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/routing_defuns.cert : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.cert \
-     workshops/2004/schmaltz-borrione/support/mod_lemmas.cert \
-     workshops/2004/schmaltz-borrione/support/routing_defuns.lisp
-
-
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.cert : \
-     workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.cert \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2004/schmaltz-borrione/support/routing_local_lemmas.lisp
-
-
-workshops/2004/schmaltz-borrione/support/routing_main.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_main.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/routing_main.cert : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.cert \
-     workshops/2004/schmaltz-borrione/support/routing_local_lemmas.cert \
-     workshops/2004/schmaltz-borrione/support/routing_main.lisp
-
-
-workshops/2004/schmaltz-borrione/support/scheduler_book.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/scheduler_book.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/scheduler_book.cert : \
-     workshops/2004/schmaltz-borrione/support/intersect.cert \
-     workshops/2004/schmaltz-borrione/support/scheduler_book.lisp
-
-
-workshops/2004/schmaltz-borrione/support/switch.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/switch.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/switch.cert : \
-     workshops/2004/schmaltz-borrione/support/switch.lisp
-
-
-workshops/2004/schmaltz-borrione/support/trip_book.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/trip_book.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/trip_book.cert : \
-     workshops/2004/schmaltz-borrione/support/switch.cert \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.cert \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2004/schmaltz-borrione/support/trip_book.lisp
-
-
-workshops/2004/schmaltz-borrione/support/trip_thms.cert : acl2x = 0
-workshops/2004/schmaltz-borrione/support/trip_thms.cert : no_pcert = 0
-
-workshops/2004/schmaltz-borrione/support/trip_thms.cert : \
-     workshops/2004/schmaltz-borrione/support/local_trip_book.cert \
-     workshops/2004/schmaltz-borrione/support/trip_thms.lisp
-
-
-workshops/2004/smith-et-al/support/bags/bag-exports.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bag-exports.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/bag-exports.cert : \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.lisp \
-     workshops/2004/smith-et-al/support/bags/bag-exports.acl2
-
-
-workshops/2004/smith-et-al/support/bags/bag-pkg.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bag-pkg.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/bag-pkg.cert : \
-     workshops/2004/smith-et-al/support/lists/list-exports.cert \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.cert \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.lisp \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.acl2
-
-
-workshops/2004/smith-et-al/support/bags/basic.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/basic.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/basic.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2004/smith-et-al/support/lists/lists.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/bags/basic.lisp \
-     workshops/2004/smith-et-al/support/bags/basic.acl2
-
-
-workshops/2004/smith-et-al/support/bags/bind-free-rules.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bind-free-rules.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/bind-free-rules.cert : \
-     workshops/2004/smith-et-al/support/bags/meta.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.lisp \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.acl2
-
-
-workshops/2004/smith-et-al/support/bags/cons.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/cons.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/cons.cert : \
-     workshops/2004/smith-et-al/support/bags/cons.lisp
-
-
-workshops/2004/smith-et-al/support/bags/eric-meta.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/eric-meta.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/eric-meta.cert : \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.cert \
-     rtl/rel4/support/logand.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/bags/eric-meta.lisp \
-     workshops/2004/smith-et-al/support/bags/eric-meta.acl2
-
-
-workshops/2004/smith-et-al/support/bags/meta.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/meta.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/meta.cert : \
-     workshops/2004/smith-et-al/support/bags/basic.cert \
-     ordinals/e0-ordinal.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/lists/mv-nth.cert \
-     workshops/2004/smith-et-al/support/syntax/syntax.cert \
-     workshops/2004/smith-et-al/support/bags/meta.lisp \
-     workshops/2004/smith-et-al/support/bags/meta.acl2
-
-
-workshops/2004/smith-et-al/support/bags/neq.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/neq.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/neq.cert : \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/bags/neq.lisp \
-     workshops/2004/smith-et-al/support/bags/neq.acl2
-
-
-workshops/2004/smith-et-al/support/bags/top.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/top.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/top.cert : \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.cert \
-     workshops/2004/smith-et-al/support/bags/cons.cert \
-     workshops/2004/smith-et-al/support/bags/neq.cert \
-     workshops/2004/smith-et-al/support/bags/eric-meta.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/bags/top.lisp \
-     workshops/2004/smith-et-al/support/bags/top.acl2
-
-
-workshops/2004/smith-et-al/support/bags/two-level-meta.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/two-level-meta.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/two-level-meta.cert : \
-     workshops/2004/smith-et-al/support/bags/two-level.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/bags/two-level-meta.lisp \
-     workshops/2004/smith-et-al/support/bags/two-level-meta.acl2
-
-
-workshops/2004/smith-et-al/support/bags/two-level.cert : acl2x = 0
-workshops/2004/smith-et-al/support/bags/two-level.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/bags/two-level.cert : \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.cert \
-     workshops/2004/smith-et-al/support/bags/bag-exports.cert \
-     workshops/2004/smith-et-al/support/bags/two-level.lisp \
-     workshops/2004/smith-et-al/support/bags/two-level.acl2
-
-
-workshops/2004/smith-et-al/support/lists/list-exports.cert : acl2x = 0
-workshops/2004/smith-et-al/support/lists/list-exports.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/lists/list-exports.cert : \
-     workshops/2004/smith-et-al/support/lists/list-exports.lisp \
-     workshops/2004/smith-et-al/support/lists/cert.acl2
-
-
-workshops/2004/smith-et-al/support/lists/list-top.cert : acl2x = 0
-workshops/2004/smith-et-al/support/lists/list-top.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/lists/list-top.cert : \
-     workshops/2004/smith-et-al/support/lists/lists.cert \
-     workshops/2004/smith-et-al/support/lists/list-exports.cert \
-     workshops/2004/smith-et-al/support/lists/mv-nth.cert \
-     workshops/2004/smith-et-al/support/lists/list-top.lisp \
-     workshops/2004/smith-et-al/support/lists/list-top.acl2
-
-
-workshops/2004/smith-et-al/support/lists/lists.cert : acl2x = 0
-workshops/2004/smith-et-al/support/lists/lists.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/lists/lists.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2004/smith-et-al/support/lists/lists.lisp \
-     workshops/2004/smith-et-al/support/lists/cert.acl2
-
-
-workshops/2004/smith-et-al/support/lists/mv-nth.cert : acl2x = 0
-workshops/2004/smith-et-al/support/lists/mv-nth.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/lists/mv-nth.cert : \
-     workshops/2004/smith-et-al/support/lists/mv-nth.lisp \
-     workshops/2004/smith-et-al/support/lists/cert.acl2
-
-
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.cert : acl2x = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.cert : \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.lisp \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.acl2
-
-
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.cert : acl2x = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.cert : \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.cert \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.lisp \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.acl2
-
-
-workshops/2004/smith-et-al/support/syntax/auxilary.cert : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/auxilary.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/syntax/auxilary.cert : \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.cert \
-     workshops/2004/smith-et-al/support/syntax/auxilary.lisp \
-     workshops/2004/smith-et-al/support/syntax/auxilary.acl2
-
-
-workshops/2004/smith-et-al/support/syntax/syn-pkg.cert : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syn-pkg.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/syntax/syn-pkg.cert : \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.lisp \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.acl2
-
-
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.cert : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.cert : \
-     workshops/2004/smith-et-al/support/syntax/auxilary.cert \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.cert \
-     workshops/2004/smith-et-al/support/lists/list-top.cert \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.lisp \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.acl2
-
-
-workshops/2004/smith-et-al/support/syntax/syntax.cert : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syntax.cert : no_pcert = 0
-
-workshops/2004/smith-et-al/support/syntax/syntax.cert : \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.cert \
-     workshops/2004/smith-et-al/support/syntax/syntax.lisp \
-     workshops/2004/smith-et-al/support/syntax/syntax.acl2
-
-
-workshops/2004/sumners-ray/support/basis.cert : acl2x = 0
-workshops/2004/sumners-ray/support/basis.cert : no_pcert = 0
-
-workshops/2004/sumners-ray/support/basis.cert : \
-     workshops/2004/sumners-ray/support/basis.lisp
-
-
-workshops/2004/sumners-ray/support/crit.cert : acl2x = 0
-workshops/2004/sumners-ray/support/crit.cert : no_pcert = 0
-
-workshops/2004/sumners-ray/support/crit.cert : \
-     workshops/2004/sumners-ray/support/basis.cert \
-     workshops/2004/sumners-ray/support/crit.lisp
-
-
-workshops/2004/sumners-ray/support/mesi.cert : acl2x = 0
-workshops/2004/sumners-ray/support/mesi.cert : no_pcert = 0
-
-workshops/2004/sumners-ray/support/mesi.cert : \
-     workshops/2004/sumners-ray/support/basis.cert \
-     workshops/2004/sumners-ray/support/records.cert \
-     workshops/2004/sumners-ray/support/mesi.lisp
-
-
-workshops/2004/sumners-ray/support/records.cert : acl2x = 0
-workshops/2004/sumners-ray/support/records.cert : no_pcert = 0
-
-workshops/2004/sumners-ray/support/records.cert : \
-     workshops/2004/sumners-ray/support/sets.cert \
-     workshops/2004/sumners-ray/support/records.lisp
-
-
-workshops/2004/sumners-ray/support/sets.cert : acl2x = 0
-workshops/2004/sumners-ray/support/sets.cert : no_pcert = 0
-
-workshops/2004/sumners-ray/support/sets.cert : \
-     workshops/2004/sumners-ray/support/total-order.cert \
-     workshops/2004/sumners-ray/support/sets.lisp
-
-
-workshops/2004/sumners-ray/support/total-order.cert : acl2x = 0
-workshops/2004/sumners-ray/support/total-order.cert : no_pcert = 0
-
-workshops/2004/sumners-ray/support/total-order.cert : \
-     workshops/2004/sumners-ray/support/total-order.lisp
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.cert : \
-     arithmetic/top.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed1.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed1.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.cert : \
-     arithmetic/top.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.lisp
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.lisp
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert : \
-     arithmetic/top.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.cert : \
-     arithmetic/top.cert \
-     ihs/quotient-remainder-lemmas.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.cert : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.acl2
-
-
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.cert : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.cert : no_pcert = 0
-
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.cert : \
-     arithmetic/top-with-meta.cert \
-     arithmetic/mod-gcd.cert \
-     workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.acl2
-
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.cert : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.cert : no_pcert = 0
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.cert : \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.lisp
-
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert : no_pcert = 0
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert : \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.lisp
-
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.cert : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.cert : no_pcert = 0
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.cert : \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.lisp
-
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.cert : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.cert : no_pcert = 0
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.cert : \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.lisp
-
-
-workshops/2006/greve/nary/example.cert : acl2x = 0
-workshops/2006/greve/nary/example.cert : no_pcert = 0
-
-workshops/2006/greve/nary/example.cert : \
-     workshops/2006/greve/nary/nary.cert \
-     ihs/ihs-definitions.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     ihs/ihs-lemmas.cert \
-     ihs/ihs-lemmas.cert \
-     workshops/2006/greve/nary/nth-rules.cert \
-     workshops/2006/greve/nary/example.lisp
-
-
-workshops/2006/greve/nary/nary.cert : acl2x = 0
-workshops/2006/greve/nary/nary.cert : no_pcert = 0
-
-workshops/2006/greve/nary/nary.cert : \
-     workshops/2006/greve/nary/nary.lisp
-
-
-workshops/2006/greve/nary/nth-rules.cert : acl2x = 0
-workshops/2006/greve/nary/nth-rules.cert : no_pcert = 0
-
-workshops/2006/greve/nary/nth-rules.cert : \
-     workshops/2006/greve/nary/nth-rules.lisp
-
-
-workshops/2006/hunt-reeber/support/acl2.cert : acl2x = 0
-workshops/2006/hunt-reeber/support/acl2.cert : no_pcert = 0
-
-workshops/2006/hunt-reeber/support/acl2.cert : \
-     workshops/2006/hunt-reeber/support/acl2.lisp
-
-
-workshops/2006/hunt-reeber/support/bdd.cert : acl2x = 0
-workshops/2006/hunt-reeber/support/bdd.cert : no_pcert = 0
-
-workshops/2006/hunt-reeber/support/bdd.cert : \
-     workshops/2006/hunt-reeber/support/bdd.lisp
-
-
-workshops/2006/hunt-reeber/support/sat.cert : acl2x = 0
-workshops/2006/hunt-reeber/support/sat.cert : no_pcert = 0
-
-workshops/2006/hunt-reeber/support/sat.cert : \
-     workshops/2006/hunt-reeber/support/sat.lisp
-
-
-workshops/2006/kaufmann-moore/support/austel.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/austel.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/austel.cert : \
-     workshops/2006/kaufmann-moore/support/austel.lisp
-
-
-workshops/2006/kaufmann-moore/support/greve1.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve1.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/greve1.cert : \
-     workshops/2006/kaufmann-moore/support/greve1.lisp
-
-
-workshops/2006/kaufmann-moore/support/greve2.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve2.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/greve2.cert : \
-     workshops/2006/kaufmann-moore/support/greve2.lisp
-
-
-workshops/2006/kaufmann-moore/support/greve3.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve3.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/greve3.cert : \
-     workshops/2006/kaufmann-moore/support/greve3.lisp
-
-
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.cert : \
-     workshops/2006/kaufmann-moore/support/mini-proveall.cert \
-     workshops/2006/kaufmann-moore/support/mini-proveall-plus.lisp
-
-
-workshops/2006/kaufmann-moore/support/mini-proveall.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/mini-proveall.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/mini-proveall.cert : \
-     workshops/2006/kaufmann-moore/support/mini-proveall.lisp
-
-
-workshops/2006/kaufmann-moore/support/rhs1-iff.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs1-iff.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/rhs1-iff.cert : \
-     workshops/2006/kaufmann-moore/support/rhs1-iff.lisp \
-     workshops/2006/kaufmann-moore/support/rhs1-iff.acl2
-
-
-workshops/2006/kaufmann-moore/support/rhs1.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs1.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/rhs1.cert : \
-     workshops/2006/kaufmann-moore/support/rhs1.lisp \
-     workshops/2006/kaufmann-moore/support/rhs1.acl2
-
-
-workshops/2006/kaufmann-moore/support/rhs2.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs2.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/rhs2.cert : \
-     workshops/2006/kaufmann-moore/support/rhs2.lisp \
-     workshops/2006/kaufmann-moore/support/rhs2.acl2
-
-
-workshops/2006/kaufmann-moore/support/smith1.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/smith1.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/smith1.cert : \
-     workshops/2006/kaufmann-moore/support/smith1.lisp
-
-
-workshops/2006/kaufmann-moore/support/sumners1.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/sumners1.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/sumners1.cert : \
-     workshops/2006/kaufmann-moore/support/sumners1.lisp
-
-
-workshops/2006/kaufmann-moore/support/warnings.cert : acl2x = 0
-workshops/2006/kaufmann-moore/support/warnings.cert : no_pcert = 0
-
-workshops/2006/kaufmann-moore/support/warnings.cert : \
-     workshops/2006/kaufmann-moore/support/warnings.lisp \
-     workshops/2006/kaufmann-moore/support/warnings.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     misc/priorities.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     coi/super-ihs/super-ihs.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.cert : \
-     data-structures/list-defthms.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.cert \
-     data-structures/list-defthms.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     coi/super-ihs/super-ihs.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert : \
-     arithmetic/mod-gcd.cert \
-     ordinals/ordinals.cert \
-     ihs/ihs-definitions.cert \
-     ihs/ihs-lemmas.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.cert : \
-     data-structures/number-list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/cert.acl2
-
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.cert : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.cert : no_pcert = 0
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.cert : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.cert \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/cert.acl2
-
-
-workshops/2006/rager/support/ptest-fib.cert : acl2x = 0
-workshops/2006/rager/support/ptest-fib.cert : no_pcert = 0
-
-workshops/2006/rager/support/ptest-fib.cert : \
-     workshops/2006/rager/support/ptest-fib.lisp
-
-
-workshops/2006/rager/support/ptest-if-normalization.cert : acl2x = 0
-workshops/2006/rager/support/ptest-if-normalization.cert : no_pcert = 0
-
-workshops/2006/rager/support/ptest-if-normalization.cert : \
-     workshops/2006/rager/support/ptest-if-normalization.lisp
-
-
-workshops/2006/rager/support/ptest-mergesort.cert : acl2x = 0
-workshops/2006/rager/support/ptest-mergesort.cert : no_pcert = 0
-
-workshops/2006/rager/support/ptest-mergesort.cert : \
-     finite-set-theory/osets/sets.cert \
-     workshops/2006/rager/support/ptest-mergesort.lisp \
-     workshops/2006/rager/support/ptest-mergesort.acl2 \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-
-
-workshops/2006/ray/tail/exists.cert : acl2x = 0
-workshops/2006/ray/tail/exists.cert : no_pcert = 0
-
-workshops/2006/ray/tail/exists.cert : \
-     workshops/2006/ray/tail/exists.lisp
-
-
-workshops/2006/ray/tail/forall.cert : acl2x = 0
-workshops/2006/ray/tail/forall.cert : no_pcert = 0
-
-workshops/2006/ray/tail/forall.cert : \
-     workshops/2006/ray/tail/forall.lisp
-
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.cert : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.cert : no_pcert = 0
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.cert : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.lisp
-
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.cert : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.cert : no_pcert = 0
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.cert : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.lisp
-
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.cert : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.cert : no_pcert = 0
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.cert : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.lisp
-
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.cert : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.cert : no_pcert = 0
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.cert : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.lisp
-
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.cert : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.cert : no_pcert = 0
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.cert : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.lisp
-
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.cert : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.cert : no_pcert = 0
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     textbook/chap11/qsort.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.lisp
-
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.cert : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.cert : no_pcert = 0
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.cert : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.cert \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.lisp
-
-
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.cert : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.cert : no_pcert = 0
-
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.cert : \
-     data-structures/list-theory.cert \
-     workshops/2006/swords-cook/lcsoundness/defsum.cert \
-     workshops/2006/swords-cook/lcsoundness/defsum-thms.cert \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.lisp
-
-
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.cert : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.cert : no_pcert = 0
-
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.cert : \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.cert \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.lisp
-
-
-workshops/2006/swords-cook/lcsoundness/defsum-thms.cert : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/defsum-thms.cert : no_pcert = 0
-
-workshops/2006/swords-cook/lcsoundness/defsum-thms.cert : \
-     arithmetic-3/bind-free/top.cert \
-     workshops/2006/swords-cook/lcsoundness/defsum-thms.lisp
-
-
-workshops/2006/swords-cook/lcsoundness/defsum.cert : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/defsum.cert : no_pcert = 0
-
-workshops/2006/swords-cook/lcsoundness/defsum.cert : \
-     workshops/2006/swords-cook/lcsoundness/pattern-match.cert \
-     workshops/2006/swords-cook/lcsoundness/defsum.lisp
-
-
-workshops/2006/swords-cook/lcsoundness/pattern-match.cert : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/pattern-match.cert : no_pcert = 0
-
-workshops/2006/swords-cook/lcsoundness/pattern-match.cert : \
-     workshops/2006/swords-cook/lcsoundness/pattern-match.lisp
-
-
-workshops/2007/cowles-et-al/support/cowles/while-loop.cert : acl2x = 0
-workshops/2007/cowles-et-al/support/cowles/while-loop.cert : no_pcert = 0
-
-workshops/2007/cowles-et-al/support/cowles/while-loop.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2007/cowles-et-al/support/cowles/while-loop.lisp
-
-
-workshops/2007/cowles-et-al/support/greve/ack.cert : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/ack.cert : no_pcert = 0
-
-workshops/2007/cowles-et-al/support/greve/ack.cert : \
-     workshops/2007/cowles-et-al/support/greve/defminterm.cert \
-     workshops/2007/cowles-et-al/support/greve/ack.lisp
-
-
-workshops/2007/cowles-et-al/support/greve/defminterm.cert : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defminterm.cert : no_pcert = 0
-
-workshops/2007/cowles-et-al/support/greve/defminterm.cert : \
-     workshops/2007/cowles-et-al/support/greve/defxch.cert \
-     workshops/2007/cowles-et-al/support/greve/defpun.cert \
-     workshops/2007/cowles-et-al/support/greve/defminterm.lisp
-
-
-workshops/2007/cowles-et-al/support/greve/defpun.cert : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defpun.cert : no_pcert = 0
-
-workshops/2007/cowles-et-al/support/greve/defpun.cert : \
-     workshops/2007/cowles-et-al/support/greve/defpun.lisp
-
-
-workshops/2007/cowles-et-al/support/greve/defxch.cert : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defxch.cert : no_pcert = 0
-
-workshops/2007/cowles-et-al/support/greve/defxch.cert : \
-     arithmetic-2/meta/top.cert \
-     misc/defpun.cert \
-     workshops/2007/cowles-et-al/support/greve/defxch.lisp
-
-
-workshops/2007/cowles-et-al/support/greve/while.cert : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/while.cert : no_pcert = 0
-
-workshops/2007/cowles-et-al/support/greve/while.cert : \
-     workshops/2007/cowles-et-al/support/greve/defminterm.cert \
-     workshops/2007/cowles-et-al/support/greve/ack.cert \
-     workshops/2007/cowles-et-al/support/greve/while.lisp
-
-
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.cert : acl2x = 0
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.cert : no_pcert = 0
-
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.cert : \
-     workshops/2007/cowles-et-al/support/ray/reflexive.cert \
-     workshops/2007/cowles-et-al/support/ray/reflexive-macros.lisp
-
-
-workshops/2007/cowles-et-al/support/ray/reflexive.cert : acl2x = 0
-workshops/2007/cowles-et-al/support/ray/reflexive.cert : no_pcert = 0
-
-workshops/2007/cowles-et-al/support/ray/reflexive.cert : \
-     arithmetic/top-with-meta.cert \
-     workshops/2007/cowles-et-al/support/ray/reflexive.lisp
-
-
-workshops/2007/dillinger-et-al/code/all.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/all.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/all.cert : \
-     workshops/2007/dillinger-et-al/code/hacker.cert \
-     workshops/2007/dillinger-et-al/code/defcode-macro.cert \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.cert \
-     workshops/2007/dillinger-et-al/code/raw.cert \
-     workshops/2007/dillinger-et-al/code/rewrite-code.cert \
-     workshops/2007/dillinger-et-al/code/redefun.cert \
-     workshops/2007/dillinger-et-al/code/bridge.cert \
-     workshops/2007/dillinger-et-al/code/subsumption.cert \
-     workshops/2007/dillinger-et-al/code/table-guard.cert \
-     workshops/2007/dillinger-et-al/code/all.lisp \
-     workshops/2007/dillinger-et-al/code/all.acl2
-
-
-workshops/2007/dillinger-et-al/code/bridge.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/bridge.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/bridge.cert : \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/bridge.lisp \
-     workshops/2007/dillinger-et-al/code/bridge.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-
-
-workshops/2007/dillinger-et-al/code/defcode-macro.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/defcode-macro.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/defcode-macro.cert : \
-     workshops/2007/dillinger-et-al/code/hacker.cert \
-     workshops/2007/dillinger-et-al/code/hacker.cert \
-     workshops/2007/dillinger-et-al/code/defcode-macro.lisp \
-     workshops/2007/dillinger-et-al/code/defcode-macro.acl2
-
-
-workshops/2007/dillinger-et-al/code/defcode.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/defcode.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/defcode.cert : \
-     workshops/2007/dillinger-et-al/code/hacker.cert \
-     workshops/2007/dillinger-et-al/code/defcode-macro.cert \
-     workshops/2007/dillinger-et-al/code/hacker.cert \
-     workshops/2007/dillinger-et-al/code/defcode.lisp \
-     workshops/2007/dillinger-et-al/code/defcode.acl2
-
-
-workshops/2007/dillinger-et-al/code/defstruct-parsing.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/defstruct-parsing.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/defstruct-parsing.cert : \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.lisp \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-
-
-workshops/2007/dillinger-et-al/code/hacker.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/hacker.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/hacker.cert : \
-     workshops/2007/dillinger-et-al/code/hacker.lisp \
-     workshops/2007/dillinger-et-al/code/hacker.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-
-
-workshops/2007/dillinger-et-al/code/raw.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/raw.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/raw.cert : \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.cert \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/raw.lisp \
-     workshops/2007/dillinger-et-al/code/raw.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-
-
-workshops/2007/dillinger-et-al/code/redefun.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/redefun.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/redefun.cert : \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/rewrite-code.cert \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/redefun.lisp \
-     workshops/2007/dillinger-et-al/code/redefun.acl2
-
-
-workshops/2007/dillinger-et-al/code/rewrite-code.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/rewrite-code.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/rewrite-code.cert : \
-     workshops/2007/dillinger-et-al/code/rewrite-code.lisp \
-     workshops/2007/dillinger-et-al/code/rewrite-code.acl2
-
-
-workshops/2007/dillinger-et-al/code/subsumption.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/subsumption.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/subsumption.cert : \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/subsumption.lisp \
-     workshops/2007/dillinger-et-al/code/subsumption.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-
-
-workshops/2007/dillinger-et-al/code/table-guard.cert : acl2x = 0
-workshops/2007/dillinger-et-al/code/table-guard.cert : no_pcert = 0
-
-workshops/2007/dillinger-et-al/code/table-guard.cert : \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/redefun.cert \
-     workshops/2007/dillinger-et-al/code/defcode.cert \
-     workshops/2007/dillinger-et-al/code/redefun.cert \
-     workshops/2007/dillinger-et-al/code/table-guard.lisp \
-     workshops/2007/dillinger-et-al/code/table-guard.acl2
-
-
-workshops/2007/erickson/bprove/bash.cert : acl2x = 0
-workshops/2007/erickson/bprove/bash.cert : no_pcert = 0
-
-workshops/2007/erickson/bprove/bash.cert : \
-     workshops/2007/erickson/bprove/bash.lisp
-
-
-workshops/2007/erickson/bprove/exdefs.cert : acl2x = 0
-workshops/2007/erickson/bprove/exdefs.cert : no_pcert = 0
-
-workshops/2007/erickson/bprove/exdefs.cert : \
-     workshops/2007/erickson/bprove/lemgen.cert \
-     workshops/2007/erickson/bprove/exdefs.lisp
-
-
-workshops/2007/erickson/bprove/gen.cert : acl2x = 0
-workshops/2007/erickson/bprove/gen.cert : no_pcert = 0
-
-workshops/2007/erickson/bprove/gen.cert : \
-     workshops/2007/erickson/bprove/gen.lisp
-
-
-workshops/2007/erickson/bprove/lemgen.cert : acl2x = 0
-workshops/2007/erickson/bprove/lemgen.cert : no_pcert = 0
-
-workshops/2007/erickson/bprove/lemgen.cert : \
-     workshops/2007/erickson/bprove/refute.cert \
-     workshops/2007/erickson/bprove/gen.cert \
-     workshops/2007/erickson/bprove/lemgen.lisp
-
-
-workshops/2007/erickson/bprove/refute.cert : acl2x = 0
-workshops/2007/erickson/bprove/refute.cert : no_pcert = 0
-
-workshops/2007/erickson/bprove/refute.cert : \
-     workshops/2007/erickson/bprove/bash.cert \
-     workshops/2007/erickson/bprove/refute.lisp
-
-
-workshops/2007/rimlinger/support/Rimlinger.cert : acl2x = 0
-workshops/2007/rimlinger/support/Rimlinger.cert : no_pcert = 0
-
-workshops/2007/rimlinger/support/Rimlinger.cert : \
-     workshops/2007/rimlinger/support/Rimlinger.lisp
-
-
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.cert : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.cert : no_pcert = 0
-
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.cert : \
-     data-structures/structures.cert \
-     workshops/2007/rubio/support/abstract-reductions/abstract-proofs.lisp
-
-
-workshops/2007/rubio/support/abstract-reductions/confluence.cert : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/confluence.cert : no_pcert = 0
-
-workshops/2007/rubio/support/abstract-reductions/confluence.cert : \
-     workshops/2007/rubio/support/abstract-reductions/abstract-proofs.cert \
-     workshops/2007/rubio/support/abstract-reductions/confluence.lisp \
-     workshops/2007/rubio/support/abstract-reductions/confluence.acl2
-
-
-workshops/2007/rubio/support/abstract-reductions/convergent.cert : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/convergent.cert : no_pcert = 0
-
-workshops/2007/rubio/support/abstract-reductions/convergent.cert : \
-     workshops/2007/rubio/support/abstract-reductions/confluence.cert \
-     workshops/2007/rubio/support/abstract-reductions/newman.cert \
-     workshops/2007/rubio/support/abstract-reductions/convergent.lisp \
-     workshops/2007/rubio/support/abstract-reductions/convergent.acl2
-
-
-workshops/2007/rubio/support/abstract-reductions/newman.cert : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/newman.cert : no_pcert = 0
-
-workshops/2007/rubio/support/abstract-reductions/newman.cert : \
-     workshops/2007/rubio/support/multisets/defmul.cert \
-     workshops/2007/rubio/support/abstract-reductions/abstract-proofs.cert \
-     workshops/2007/rubio/support/abstract-reductions/newman.lisp \
-     workshops/2007/rubio/support/abstract-reductions/newman.acl2
-
-
-workshops/2007/rubio/support/multisets/defmul.cert : acl2x = 0
-workshops/2007/rubio/support/multisets/defmul.cert : no_pcert = 0
-
-workshops/2007/rubio/support/multisets/defmul.cert : \
-     workshops/2007/rubio/support/multisets/multiset.cert \
-     workshops/2007/rubio/support/multisets/defmul.lisp \
-     workshops/2007/rubio/support/multisets/defmul.acl2
-
-
-workshops/2007/rubio/support/multisets/multiset.cert : acl2x = 0
-workshops/2007/rubio/support/multisets/multiset.cert : no_pcert = 0
-
-workshops/2007/rubio/support/multisets/multiset.cert : \
-     ordinals/e0-ordinal.cert \
-     workshops/2007/rubio/support/multisets/multiset.lisp \
-     workshops/2007/rubio/support/multisets/multiset.acl2
-
-
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.cert : acl2x = 0
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.cert : no_pcert = 0
-
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.cert : \
-     workshops/2007/rubio/support/abstract-reductions/convergent.cert \
-     arithmetic/top-with-meta.cert \
-     workshops/2007/rubio/support/simplicial-topology/generate-degenerate.lisp \
-     workshops/2007/rubio/support/simplicial-topology/generate-degenerate.acl2
-
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     textbook/chap11/qsort.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     arithmetic-3/bind-free/top.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.cert : \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.cert \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.lisp
-
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.cert : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.cert : no_pcert = 0
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.cert : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.cert \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.lisp
-
-
-workshops/2009/fraij-roach/support/functions.cert : acl2x = 0
-workshops/2009/fraij-roach/support/functions.cert : no_pcert = 0
-
-workshops/2009/fraij-roach/support/functions.cert : \
-     ordinals/lexicographic-ordering.cert \
-     workshops/2009/fraij-roach/support/functions.lisp
-
-
-workshops/2009/fraij-roach/support/theorems.cert : acl2x = 0
-workshops/2009/fraij-roach/support/theorems.cert : no_pcert = 0
-
-workshops/2009/fraij-roach/support/theorems.cert : \
-     workshops/2009/fraij-roach/support/functions.cert \
-     workshops/2009/fraij-roach/support/theorems.lisp
-
-
-workshops/2009/hardin/deque-stobj/deque-stobj.cert : acl2x = 0
-workshops/2009/hardin/deque-stobj/deque-stobj.cert : no_pcert = 0
-
-workshops/2009/hardin/deque-stobj/deque-stobj.cert : \
-     workshops/2009/hardin/deque-stobj/deque-stobj.lisp
-
-
-workshops/2009/hardin/deque-stobj/deque-thms.cert : acl2x = 0
-workshops/2009/hardin/deque-stobj/deque-thms.cert : no_pcert = 0
-
-workshops/2009/hardin/deque-stobj/deque-thms.cert : \
-     workshops/2009/hardin/deque-stobj/deque-stobj.cert \
-     arithmetic-5/top.cert \
-     workshops/2009/hardin/deque-stobj/deque-thms.lisp
-
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.cert : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.cert : no_pcert = 0
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.cert : \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.lisp \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.acl2
-
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.cert : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.cert : no_pcert = 0
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.cert : \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.lisp \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.acl2
-
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.cert : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.cert : no_pcert = 0
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.cert : \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.lisp
-
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.cert : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.cert : no_pcert = 0
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.cert : \
-     defexec/other-apps/records/records.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.lisp
-
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.cert : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.cert : no_pcert = 0
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.cert : \
-     defexec/other-apps/records/records.cert \
-     defexec/other-apps/records/records.cert \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.lisp \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.acl2
-
-
-workshops/2009/liu/support/error-analysis-tool3.cert : acl2x = 0
-workshops/2009/liu/support/error-analysis-tool3.cert : no_pcert = 0
-
-workshops/2009/liu/support/error-analysis-tool3.cert : \
-     rtl/rel8/arithmetic/top.cert \
-     workshops/2009/liu/support/mylet.cert \
-     workshops/2009/liu/support/error-analysis-tool3.lisp
-
-
-workshops/2009/liu/support/mylet.cert : acl2x = 0
-workshops/2009/liu/support/mylet.cert : no_pcert = 0
-
-workshops/2009/liu/support/mylet.cert : \
-     workshops/2009/liu/support/mylet.lisp
-
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.cert : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.cert : no_pcert = 0
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.cert : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.lisp
-
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.cert : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.cert : no_pcert = 0
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.cert : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.lisp
-
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert : no_pcert = 0
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert : \
-     arithmetic-3/top.cert \
-     make-event/defspec.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.lisp
-
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.cert : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.cert : no_pcert = 0
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.cert : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.lisp
-
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.cert : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.cert : no_pcert = 0
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.cert : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.lisp
-
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.cert : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.cert : no_pcert = 0
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.cert : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.lisp
-
-
-workshops/2009/sumners/support/kas.cert : acl2x = 0
-workshops/2009/sumners/support/kas.cert : no_pcert = 0
-
-workshops/2009/sumners/support/kas.cert : \
-     workshops/2009/sumners/support/kas.lisp \
-     workshops/2009/sumners/support/kas.acl2
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.cert : \
-     make-event/defspec.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.cert : \
-     make-event/defspec.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert : \
-     make-event/defspec.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert : \
-     make-event/defspec.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert : \
-     make-event/defspec.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert : \
-     make-event/defspec.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.lisp
-
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.cert : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.cert : no_pcert = 0
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.cert : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.cert \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.cert : \
-     make-event/defspec.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert \
-     make-event/defspec.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert : \
-     make-event/defspec.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert \
-     make-event/defspec.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.cert : \
-     make-event/defspec.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.cert : \
-     ordinals/lexicographic-ordering.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.cert : \
-     make-event/defspec.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.cert : \
-     make-event/defspec.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.cert \
-     ordinals/lexicographic-ordering.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.cert : \
-     ordinals/lexicographic-ordering.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.cert \
-     arithmetic-3/bind-free/top.cert \
-     arithmetic-3/floor-mod/floor-mod.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.cert : \
-     data-structures/list-defuns.cert \
-     data-structures/list-defthms.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.lisp
-
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.cert : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.cert : no_pcert = 0
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.cert : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.cert \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.lisp
-
-
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.cert : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.cert : no_pcert = 0
-
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.cert : \
-     arithmetic-3/top.cert \
-     workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.lisp
-
-
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.cert : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.cert : no_pcert = 0
-
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.cert : \
-     arithmetic-3/top.cert \
-     workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.lisp
-
-
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.cert : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.cert : no_pcert = 0
-
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.cert : \
-     arithmetic-3/top.cert \
-     workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.lisp
-
-
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.cert : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.cert : no_pcert = 0
-
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.cert : \
-     arithmetic-3/top.cert \
-     data-structures/utilities.cert \
-     workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.lisp \
-     workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.acl2
-
-
-wp-gen/mutrec/mutrec.cert : acl2x = 0
-wp-gen/mutrec/mutrec.cert : no_pcert = 0
-
-wp-gen/mutrec/mutrec.cert : \
-     ordinals/lexicographic-ordering.cert \
-     wp-gen/mutrec/mutrec.lisp
-
-
-wp-gen/shared.cert : acl2x = 0
-wp-gen/shared.cert : no_pcert = 0
-
-wp-gen/shared.cert : \
-     wp-gen/shared.lisp
-
-
-wp-gen/wp-gen.cert : acl2x = 0
-wp-gen/wp-gen.cert : no_pcert = 0
-
-wp-gen/wp-gen.cert : \
-     wp-gen/shared.cert \
-     wp-gen/mutrec/mutrec.cert \
-     wp-gen/wp-gen.lisp \
-     wp-gen/wp-gen.acl2
-
-
-xdoc-impl/autolink.cert : acl2x = 0
-xdoc-impl/autolink.cert : no_pcert = 0
-
-xdoc-impl/autolink.cert : \
-     xdoc-impl/fmt-to-str.cert \
-     xdoc/names.cert \
-     misc/assert.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/autolink.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/extra-packages.cert : acl2x = 0
-xdoc-impl/extra-packages.cert : no_pcert = 0
-
-xdoc-impl/extra-packages.cert : \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/extra-packages.lisp \
-     xdoc-impl/extra-packages.acl2 \
-     xdoc-impl/cert.acl2 \
-     cowles/packages.lsp \
-     clause-processors/SULFA/books/sat/sat-package.acl2 \
-     data-structures/define-u-package.lsp \
-     data-structures/define-structures-package.lsp \
-     data-structures/memories/package.lsp \
-     hacking/hacker-pkg.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     tools/flag-package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-
-
-xdoc-impl/fmt-to-str.cert : acl2x = 0
-xdoc-impl/fmt-to-str.cert : no_pcert = 0
-
-xdoc-impl/fmt-to-str.cert : \
-     tools/bstar.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/fmt-to-str.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/import-acl2doc.cert : acl2x = 0
-xdoc-impl/import-acl2doc.cert : no_pcert = 0
-
-xdoc-impl/import-acl2doc.cert : \
-     xdoc-impl/write-acl2-xdoc.cert \
-     xdoc/base.cert \
-     tools/bstar.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/import-acl2doc.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/mkdir-raw.cert : acl2x = 0
-xdoc-impl/mkdir-raw.cert : no_pcert = 0
-
-xdoc-impl/mkdir-raw.cert : \
-     xdoc-impl/mkdir.cert \
-     tools/bstar.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/mkdir-raw.lisp \
-     xdoc-impl/mkdir-raw.acl2 \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/mkdir.cert : acl2x = 0
-xdoc-impl/mkdir.cert : no_pcert = 0
-
-xdoc-impl/mkdir.cert : \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/mkdir.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/parse-xml.cert : acl2x = 0
-xdoc-impl/parse-xml.cert : no_pcert = 0
-
-xdoc-impl/parse-xml.cert : \
-     xdoc-impl/preprocess.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/parse-xml.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/portcullis.cert : acl2x = 0
-xdoc-impl/portcullis.cert : no_pcert = 0
-
-xdoc-impl/portcullis.cert : \
-     xdoc-impl/portcullis.lisp \
-     xdoc-impl/portcullis.acl2 \
-     xdoc/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp
-
-
-xdoc-impl/preprocess.cert : acl2x = 0
-xdoc-impl/preprocess.cert : no_pcert = 0
-
-xdoc-impl/preprocess.cert : \
-     xdoc-impl/autolink.cert \
-     str/top.cert \
-     misc/assert.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/preprocess.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/save.cert : acl2x = 0
-xdoc-impl/save.cert : no_pcert = 0
-
-xdoc-impl/save.cert : \
-     xdoc-impl/mkdir.cert \
-     xdoc/base.cert \
-     xdoc-impl/preprocess.cert \
-     xdoc-impl/parse-xml.cert \
-     xdoc-impl/sort.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/save.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/sort.cert : acl2x = 0
-xdoc-impl/sort.cert : no_pcert = 0
-
-xdoc-impl/sort.cert : \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/sort.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/topics.cert : acl2x = 0
-xdoc-impl/topics.cert : no_pcert = 0
-
-xdoc-impl/topics.cert : \
-     xdoc-impl/import-acl2doc.cert \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/topics.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc-impl/write-acl2-xdoc.cert : acl2x = 0
-xdoc-impl/write-acl2-xdoc.cert : no_pcert = 0
-
-xdoc-impl/write-acl2-xdoc.cert : \
-     xdoc-impl/portcullis.cert \
-     xdoc-impl/write-acl2-xdoc.lisp \
-     xdoc-impl/cert.acl2
-
-
-xdoc/base.cert : acl2x = 0
-xdoc/base.cert : no_pcert = 0
-
-xdoc/base.cert : \
-     xdoc/portcullis.cert \
-     xdoc/base.lisp \
-     xdoc/cert.acl2
-
-
-xdoc/book-thms.cert : acl2x = 0
-xdoc/book-thms.cert : no_pcert = 0
-
-xdoc/book-thms.cert : \
-     xdoc/portcullis.cert \
-     xdoc/book-thms.lisp \
-     xdoc/cert.acl2
-
-
-xdoc/defxdoc-raw.cert : acl2x = 0
-xdoc/defxdoc-raw.cert : no_pcert = 0
-
-xdoc/defxdoc-raw.cert : \
-     xdoc/base.cert \
-     xdoc/portcullis.cert \
-     xdoc/defxdoc-raw.lisp \
-     xdoc/defxdoc-raw.acl2
-
-
-xdoc/names.cert : acl2x = 0
-xdoc/names.cert : no_pcert = 0
-
-xdoc/names.cert : \
-     xdoc/base.cert \
-     xdoc/portcullis.cert \
-     xdoc/names.lisp \
-     xdoc/cert.acl2
-
-
-xdoc/portcullis.cert : acl2x = 0
-xdoc/portcullis.cert : no_pcert = 0
-
-xdoc/portcullis.cert : \
-     xdoc/portcullis.lisp \
-     xdoc/portcullis.acl2 \
-     xdoc/package.lsp
-
-
-xdoc/top.cert : acl2x = 0
-xdoc/top.cert : no_pcert = 0
-
-xdoc/top.cert : \
-     xdoc/base.cert \
-     xdoc/book-thms.cert \
-     xdoc/portcullis.cert \
-     xdoc/top.lisp \
-     xdoc/cert.acl2
-
-
-ifneq ($(ACL2_PCERT),)
-
-arithmetic-2/floor-mod/floor-mod-helper.pcert0 : no_pcert = 0
-arithmetic-2/floor-mod/floor-mod-helper.pcert0 : acl2x = 0
-arithmetic-2/floor-mod/floor-mod-helper.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     arithmetic-2/floor-mod/floor-mod-helper.lisp
-arithmetic-2/floor-mod/floor-mod-helper.pcert1 : acl2x = 0
-arithmetic-2/floor-mod/floor-mod-helper.pcert1 : no_pcert = 0
-arithmetic-2/floor-mod/floor-mod-helper.pcert1 : arithmetic-2/floor-mod/floor-mod-helper.pcert0
-arithmetic-2/floor-mod/floor-mod-helper.cert : | arithmetic-2/floor-mod/floor-mod-helper.pcert1
-
-arithmetic-2/floor-mod/floor-mod.pcert0 : no_pcert = 0
-arithmetic-2/floor-mod/floor-mod.pcert0 : acl2x = 0
-arithmetic-2/floor-mod/floor-mod.pcert0 : \
-     arithmetic-2/floor-mod/floor-mod-helper.pcert0 \
-     arithmetic-2/floor-mod/floor-mod.lisp
-arithmetic-2/floor-mod/floor-mod.pcert1 : acl2x = 0
-arithmetic-2/floor-mod/floor-mod.pcert1 : no_pcert = 0
-arithmetic-2/floor-mod/floor-mod.pcert1 : arithmetic-2/floor-mod/floor-mod.pcert0
-arithmetic-2/floor-mod/floor-mod.cert : | arithmetic-2/floor-mod/floor-mod.pcert1
-
-arithmetic-2/meta/cancel-terms-helper.pcert0 : no_pcert = 0
-arithmetic-2/meta/cancel-terms-helper.pcert0 : acl2x = 0
-arithmetic-2/meta/cancel-terms-helper.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/cancel-terms-helper.lisp
-arithmetic-2/meta/cancel-terms-helper.pcert1 : acl2x = 0
-arithmetic-2/meta/cancel-terms-helper.pcert1 : no_pcert = 0
-arithmetic-2/meta/cancel-terms-helper.pcert1 : arithmetic-2/meta/cancel-terms-helper.pcert0
-arithmetic-2/meta/cancel-terms-helper.cert : | arithmetic-2/meta/cancel-terms-helper.pcert1
-
-arithmetic-2/meta/cancel-terms-meta.pcert0 : no_pcert = 0
-arithmetic-2/meta/cancel-terms-meta.pcert0 : acl2x = 0
-arithmetic-2/meta/cancel-terms-meta.pcert0 : \
-     arithmetic-2/meta/common-meta.pcert0 \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/cancel-terms-helper.pcert0 \
-     arithmetic-2/meta/cancel-terms-meta.lisp
-arithmetic-2/meta/cancel-terms-meta.pcert1 : acl2x = 0
-arithmetic-2/meta/cancel-terms-meta.pcert1 : no_pcert = 0
-arithmetic-2/meta/cancel-terms-meta.pcert1 : arithmetic-2/meta/cancel-terms-meta.pcert0
-arithmetic-2/meta/cancel-terms-meta.cert : | arithmetic-2/meta/cancel-terms-meta.pcert1
-
-arithmetic-2/meta/collect-terms-meta.pcert0 : no_pcert = 0
-arithmetic-2/meta/collect-terms-meta.pcert0 : acl2x = 0
-arithmetic-2/meta/collect-terms-meta.pcert0 : \
-     arithmetic-2/meta/common-meta.pcert0 \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/collect-terms-meta.lisp
-arithmetic-2/meta/collect-terms-meta.pcert1 : acl2x = 0
-arithmetic-2/meta/collect-terms-meta.pcert1 : no_pcert = 0
-arithmetic-2/meta/collect-terms-meta.pcert1 : arithmetic-2/meta/collect-terms-meta.pcert0
-arithmetic-2/meta/collect-terms-meta.cert : | arithmetic-2/meta/collect-terms-meta.pcert1
-
-arithmetic-2/meta/common-meta.pcert0 : no_pcert = 0
-arithmetic-2/meta/common-meta.pcert0 : acl2x = 0
-arithmetic-2/meta/common-meta.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/common-meta.lisp
-arithmetic-2/meta/common-meta.pcert1 : acl2x = 0
-arithmetic-2/meta/common-meta.pcert1 : no_pcert = 0
-arithmetic-2/meta/common-meta.pcert1 : arithmetic-2/meta/common-meta.pcert0
-arithmetic-2/meta/common-meta.cert : | arithmetic-2/meta/common-meta.pcert1
-
-arithmetic-2/meta/expt-helper.pcert0 : no_pcert = 0
-arithmetic-2/meta/expt-helper.pcert0 : acl2x = 0
-arithmetic-2/meta/expt-helper.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/expt-helper.lisp
-arithmetic-2/meta/expt-helper.pcert1 : acl2x = 0
-arithmetic-2/meta/expt-helper.pcert1 : no_pcert = 0
-arithmetic-2/meta/expt-helper.pcert1 : arithmetic-2/meta/expt-helper.pcert0
-arithmetic-2/meta/expt-helper.cert : | arithmetic-2/meta/expt-helper.pcert1
-
-arithmetic-2/meta/expt.pcert0 : no_pcert = 0
-arithmetic-2/meta/expt.pcert0 : acl2x = 0
-arithmetic-2/meta/expt.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/expt-helper.pcert0 \
-     arithmetic-2/meta/expt.lisp
-arithmetic-2/meta/expt.pcert1 : acl2x = 0
-arithmetic-2/meta/expt.pcert1 : no_pcert = 0
-arithmetic-2/meta/expt.pcert1 : arithmetic-2/meta/expt.pcert0
-arithmetic-2/meta/expt.cert : | arithmetic-2/meta/expt.pcert1
-
-arithmetic-2/meta/integerp-meta.pcert0 : no_pcert = 0
-arithmetic-2/meta/integerp-meta.pcert0 : acl2x = 0
-arithmetic-2/meta/integerp-meta.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/integerp-meta.lisp
-arithmetic-2/meta/integerp-meta.pcert1 : acl2x = 0
-arithmetic-2/meta/integerp-meta.pcert1 : no_pcert = 0
-arithmetic-2/meta/integerp-meta.pcert1 : arithmetic-2/meta/integerp-meta.pcert0
-arithmetic-2/meta/integerp-meta.cert : | arithmetic-2/meta/integerp-meta.pcert1
-
-arithmetic-2/meta/integerp.pcert0 : no_pcert = 0
-arithmetic-2/meta/integerp.pcert0 : acl2x = 0
-arithmetic-2/meta/integerp.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/integerp.lisp
-arithmetic-2/meta/integerp.pcert1 : acl2x = 0
-arithmetic-2/meta/integerp.pcert1 : no_pcert = 0
-arithmetic-2/meta/integerp.pcert1 : arithmetic-2/meta/integerp.pcert0
-arithmetic-2/meta/integerp.cert : | arithmetic-2/meta/integerp.pcert1
-
-arithmetic-2/meta/mini-theories.pcert0 : no_pcert = 0
-arithmetic-2/meta/mini-theories.pcert0 : acl2x = 0
-arithmetic-2/meta/mini-theories.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/mini-theories.lisp
-arithmetic-2/meta/mini-theories.pcert1 : acl2x = 0
-arithmetic-2/meta/mini-theories.pcert1 : no_pcert = 0
-arithmetic-2/meta/mini-theories.pcert1 : arithmetic-2/meta/mini-theories.pcert0
-arithmetic-2/meta/mini-theories.cert : | arithmetic-2/meta/mini-theories.pcert1
-
-arithmetic-2/meta/non-linear.pcert0 : no_pcert = 0
-arithmetic-2/meta/non-linear.pcert0 : acl2x = 0
-arithmetic-2/meta/non-linear.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/cancel-terms-helper.pcert0 \
-     arithmetic-2/meta/non-linear.lisp
-arithmetic-2/meta/non-linear.pcert1 : acl2x = 0
-arithmetic-2/meta/non-linear.pcert1 : no_pcert = 0
-arithmetic-2/meta/non-linear.pcert1 : arithmetic-2/meta/non-linear.pcert0
-arithmetic-2/meta/non-linear.cert : | arithmetic-2/meta/non-linear.pcert1
-
-arithmetic-2/meta/numerator-and-denominator.pcert0 : no_pcert = 0
-arithmetic-2/meta/numerator-and-denominator.pcert0 : acl2x = 0
-arithmetic-2/meta/numerator-and-denominator.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/numerator-and-denominator.lisp
-arithmetic-2/meta/numerator-and-denominator.pcert1 : acl2x = 0
-arithmetic-2/meta/numerator-and-denominator.pcert1 : no_pcert = 0
-arithmetic-2/meta/numerator-and-denominator.pcert1 : arithmetic-2/meta/numerator-and-denominator.pcert0
-arithmetic-2/meta/numerator-and-denominator.cert : | arithmetic-2/meta/numerator-and-denominator.pcert1
-
-arithmetic-2/meta/post.pcert0 : no_pcert = 0
-arithmetic-2/meta/post.pcert0 : acl2x = 0
-arithmetic-2/meta/post.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/post.lisp
-arithmetic-2/meta/post.pcert1 : acl2x = 0
-arithmetic-2/meta/post.pcert1 : no_pcert = 0
-arithmetic-2/meta/post.pcert1 : arithmetic-2/meta/post.pcert0
-arithmetic-2/meta/post.cert : | arithmetic-2/meta/post.pcert1
-
-arithmetic-2/meta/pre.pcert0 : no_pcert = 0
-arithmetic-2/meta/pre.pcert0 : acl2x = 0
-arithmetic-2/meta/pre.pcert0 : \
-     arithmetic-2/pass1/top.pcert0 \
-     arithmetic-2/meta/pre.lisp
-arithmetic-2/meta/pre.pcert1 : acl2x = 0
-arithmetic-2/meta/pre.pcert1 : no_pcert = 0
-arithmetic-2/meta/pre.pcert1 : arithmetic-2/meta/pre.pcert0
-arithmetic-2/meta/pre.cert : | arithmetic-2/meta/pre.pcert1
-
-arithmetic-2/meta/top.pcert0 : no_pcert = 0
-arithmetic-2/meta/top.pcert0 : acl2x = 0
-arithmetic-2/meta/top.pcert0 : \
-     arithmetic-2/meta/pre.pcert0 \
-     arithmetic-2/meta/integerp.pcert0 \
-     arithmetic-2/meta/integerp-meta.pcert0 \
-     arithmetic-2/meta/cancel-terms-meta.pcert0 \
-     arithmetic-2/meta/collect-terms-meta.pcert0 \
-     arithmetic-2/meta/numerator-and-denominator.pcert0 \
-     arithmetic-2/meta/expt.pcert0 \
-     arithmetic-2/meta/non-linear.pcert0 \
-     arithmetic-2/meta/mini-theories.pcert0 \
-     arithmetic-2/meta/post.pcert0 \
-     arithmetic-2/meta/top.lisp
-arithmetic-2/meta/top.pcert1 : acl2x = 0
-arithmetic-2/meta/top.pcert1 : no_pcert = 0
-arithmetic-2/meta/top.pcert1 : arithmetic-2/meta/top.pcert0
-arithmetic-2/meta/top.cert : | arithmetic-2/meta/top.pcert1
-
-arithmetic-2/pass1/basic-arithmetic-helper.pcert0 : no_pcert = 0
-arithmetic-2/pass1/basic-arithmetic-helper.pcert0 : acl2x = 0
-arithmetic-2/pass1/basic-arithmetic-helper.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic-helper.lisp
-arithmetic-2/pass1/basic-arithmetic-helper.pcert1 : acl2x = 0
-arithmetic-2/pass1/basic-arithmetic-helper.pcert1 : no_pcert = 0
-arithmetic-2/pass1/basic-arithmetic-helper.pcert1 : arithmetic-2/pass1/basic-arithmetic-helper.pcert0
-arithmetic-2/pass1/basic-arithmetic-helper.cert : | arithmetic-2/pass1/basic-arithmetic-helper.pcert1
-
-arithmetic-2/pass1/basic-arithmetic.pcert0 : no_pcert = 0
-arithmetic-2/pass1/basic-arithmetic.pcert0 : acl2x = 0
-arithmetic-2/pass1/basic-arithmetic.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic-helper.pcert0 \
-     arithmetic-2/pass1/basic-arithmetic.lisp
-arithmetic-2/pass1/basic-arithmetic.pcert1 : acl2x = 0
-arithmetic-2/pass1/basic-arithmetic.pcert1 : no_pcert = 0
-arithmetic-2/pass1/basic-arithmetic.pcert1 : arithmetic-2/pass1/basic-arithmetic.pcert0
-arithmetic-2/pass1/basic-arithmetic.cert : | arithmetic-2/pass1/basic-arithmetic.pcert1
-
-arithmetic-2/pass1/expt-helper.pcert0 : no_pcert = 0
-arithmetic-2/pass1/expt-helper.pcert0 : acl2x = 0
-arithmetic-2/pass1/expt-helper.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic.pcert0 \
-     arithmetic-2/pass1/inequalities.pcert0 \
-     arithmetic-2/pass1/prefer-times.pcert0 \
-     arithmetic-2/pass1/expt-helper.lisp
-arithmetic-2/pass1/expt-helper.pcert1 : acl2x = 0
-arithmetic-2/pass1/expt-helper.pcert1 : no_pcert = 0
-arithmetic-2/pass1/expt-helper.pcert1 : arithmetic-2/pass1/expt-helper.pcert0
-arithmetic-2/pass1/expt-helper.cert : | arithmetic-2/pass1/expt-helper.pcert1
-
-arithmetic-2/pass1/expt.pcert0 : no_pcert = 0
-arithmetic-2/pass1/expt.pcert0 : acl2x = 0
-arithmetic-2/pass1/expt.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic.pcert0 \
-     arithmetic-2/pass1/inequalities.pcert0 \
-     arithmetic-2/pass1/prefer-times.pcert0 \
-     arithmetic-2/pass1/expt-helper.pcert0 \
-     arithmetic-2/pass1/expt.lisp
-arithmetic-2/pass1/expt.pcert1 : acl2x = 0
-arithmetic-2/pass1/expt.pcert1 : no_pcert = 0
-arithmetic-2/pass1/expt.pcert1 : arithmetic-2/pass1/expt.pcert0
-arithmetic-2/pass1/expt.cert : | arithmetic-2/pass1/expt.pcert1
-
-arithmetic-2/pass1/inequalities.pcert0 : no_pcert = 0
-arithmetic-2/pass1/inequalities.pcert0 : acl2x = 0
-arithmetic-2/pass1/inequalities.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic.pcert0 \
-     arithmetic-2/pass1/inequalities.lisp
-arithmetic-2/pass1/inequalities.pcert1 : acl2x = 0
-arithmetic-2/pass1/inequalities.pcert1 : no_pcert = 0
-arithmetic-2/pass1/inequalities.pcert1 : arithmetic-2/pass1/inequalities.pcert0
-arithmetic-2/pass1/inequalities.cert : | arithmetic-2/pass1/inequalities.pcert1
-
-arithmetic-2/pass1/mini-theories.pcert0 : no_pcert = 0
-arithmetic-2/pass1/mini-theories.pcert0 : acl2x = 0
-arithmetic-2/pass1/mini-theories.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic.pcert0 \
-     arithmetic-2/pass1/inequalities.pcert0 \
-     arithmetic-2/pass1/prefer-times.pcert0 \
-     arithmetic-2/pass1/expt.pcert0 \
-     arithmetic-2/pass1/mini-theories.lisp
-arithmetic-2/pass1/mini-theories.pcert1 : acl2x = 0
-arithmetic-2/pass1/mini-theories.pcert1 : no_pcert = 0
-arithmetic-2/pass1/mini-theories.pcert1 : arithmetic-2/pass1/mini-theories.pcert0
-arithmetic-2/pass1/mini-theories.cert : | arithmetic-2/pass1/mini-theories.pcert1
-
-arithmetic-2/pass1/numerator-and-denominator-helper.pcert0 : no_pcert = 0
-arithmetic-2/pass1/numerator-and-denominator-helper.pcert0 : acl2x = 0
-arithmetic-2/pass1/numerator-and-denominator-helper.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic.pcert0 \
-     arithmetic-2/pass1/inequalities.pcert0 \
-     arithmetic-2/pass1/prefer-times.pcert0 \
-     arithmetic-2/pass1/numerator-and-denominator-helper.lisp
-arithmetic-2/pass1/numerator-and-denominator-helper.pcert1 : acl2x = 0
-arithmetic-2/pass1/numerator-and-denominator-helper.pcert1 : no_pcert = 0
-arithmetic-2/pass1/numerator-and-denominator-helper.pcert1 : arithmetic-2/pass1/numerator-and-denominator-helper.pcert0
-arithmetic-2/pass1/numerator-and-denominator-helper.cert : | arithmetic-2/pass1/numerator-and-denominator-helper.pcert1
-
-arithmetic-2/pass1/numerator-and-denominator.pcert0 : no_pcert = 0
-arithmetic-2/pass1/numerator-and-denominator.pcert0 : acl2x = 0
-arithmetic-2/pass1/numerator-and-denominator.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic.pcert0 \
-     arithmetic-2/pass1/inequalities.pcert0 \
-     arithmetic-2/pass1/prefer-times.pcert0 \
-     arithmetic-2/pass1/numerator-and-denominator-helper.pcert0 \
-     arithmetic-2/pass1/numerator-and-denominator.lisp
-arithmetic-2/pass1/numerator-and-denominator.pcert1 : acl2x = 0
-arithmetic-2/pass1/numerator-and-denominator.pcert1 : no_pcert = 0
-arithmetic-2/pass1/numerator-and-denominator.pcert1 : arithmetic-2/pass1/numerator-and-denominator.pcert0
-arithmetic-2/pass1/numerator-and-denominator.cert : | arithmetic-2/pass1/numerator-and-denominator.pcert1
-
-arithmetic-2/pass1/prefer-times.pcert0 : no_pcert = 0
-arithmetic-2/pass1/prefer-times.pcert0 : acl2x = 0
-arithmetic-2/pass1/prefer-times.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic.pcert0 \
-     arithmetic-2/pass1/inequalities.pcert0 \
-     arithmetic-2/pass1/prefer-times.lisp
-arithmetic-2/pass1/prefer-times.pcert1 : acl2x = 0
-arithmetic-2/pass1/prefer-times.pcert1 : no_pcert = 0
-arithmetic-2/pass1/prefer-times.pcert1 : arithmetic-2/pass1/prefer-times.pcert0
-arithmetic-2/pass1/prefer-times.cert : | arithmetic-2/pass1/prefer-times.pcert1
-
-arithmetic-2/pass1/top.pcert0 : no_pcert = 0
-arithmetic-2/pass1/top.pcert0 : acl2x = 0
-arithmetic-2/pass1/top.pcert0 : \
-     arithmetic-2/pass1/basic-arithmetic.pcert0 \
-     arithmetic-2/pass1/inequalities.pcert0 \
-     arithmetic-2/pass1/expt.pcert0 \
-     arithmetic-2/pass1/prefer-times.pcert0 \
-     arithmetic-2/pass1/mini-theories.pcert0 \
-     arithmetic-2/pass1/numerator-and-denominator.pcert0 \
-     arithmetic-2/pass1/top.lisp
-arithmetic-2/pass1/top.pcert1 : acl2x = 0
-arithmetic-2/pass1/top.pcert1 : no_pcert = 0
-arithmetic-2/pass1/top.pcert1 : arithmetic-2/pass1/top.pcert0
-arithmetic-2/pass1/top.cert : | arithmetic-2/pass1/top.pcert1
-
-arithmetic-3/bind-free/arithmetic-theory.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/arithmetic-theory.pcert0 : acl2x = 0
-arithmetic-3/bind-free/arithmetic-theory.pcert0 : \
-     arithmetic-3/bind-free/basic.pcert0 \
-     arithmetic-3/bind-free/common.pcert0 \
-     arithmetic-3/bind-free/building-blocks.pcert0 \
-     arithmetic-3/bind-free/collect.pcert0 \
-     arithmetic-3/bind-free/arithmetic-theory.lisp
-arithmetic-3/bind-free/arithmetic-theory.pcert1 : acl2x = 0
-arithmetic-3/bind-free/arithmetic-theory.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/arithmetic-theory.pcert1 : arithmetic-3/bind-free/arithmetic-theory.pcert0
-arithmetic-3/bind-free/arithmetic-theory.cert : | arithmetic-3/bind-free/arithmetic-theory.pcert1
-
-arithmetic-3/bind-free/banner.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/banner.pcert0 : acl2x = 0
-arithmetic-3/bind-free/banner.pcert0 : \
-     arithmetic-3/bind-free/banner.lisp
-arithmetic-3/bind-free/banner.pcert1 : acl2x = 0
-arithmetic-3/bind-free/banner.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/banner.pcert1 : arithmetic-3/bind-free/banner.pcert0
-arithmetic-3/bind-free/banner.cert : | arithmetic-3/bind-free/banner.pcert1
-
-arithmetic-3/bind-free/basic-helper.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/basic-helper.pcert0 : acl2x = 0
-arithmetic-3/bind-free/basic-helper.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/default-hint.pcert0 \
-     arithmetic-3/bind-free/basic-helper.lisp
-arithmetic-3/bind-free/basic-helper.pcert1 : acl2x = 0
-arithmetic-3/bind-free/basic-helper.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/basic-helper.pcert1 : arithmetic-3/bind-free/basic-helper.pcert0
-arithmetic-3/bind-free/basic-helper.cert : | arithmetic-3/bind-free/basic-helper.pcert1
-
-arithmetic-3/bind-free/basic.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/basic.pcert0 : acl2x = 0
-arithmetic-3/bind-free/basic.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/basic-helper.pcert0 \
-     arithmetic-3/bind-free/building-blocks.pcert0 \
-     arithmetic-3/bind-free/basic.lisp
-arithmetic-3/bind-free/basic.pcert1 : acl2x = 0
-arithmetic-3/bind-free/basic.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/basic.pcert1 : arithmetic-3/bind-free/basic.pcert0
-arithmetic-3/bind-free/basic.cert : | arithmetic-3/bind-free/basic.pcert1
-
-arithmetic-3/bind-free/building-blocks.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/building-blocks.pcert0 : acl2x = 0
-arithmetic-3/bind-free/building-blocks.pcert0 : \
-     arithmetic-3/bind-free/building-blocks.lisp
-arithmetic-3/bind-free/building-blocks.pcert1 : acl2x = 0
-arithmetic-3/bind-free/building-blocks.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/building-blocks.pcert1 : arithmetic-3/bind-free/building-blocks.pcert0
-arithmetic-3/bind-free/building-blocks.cert : | arithmetic-3/bind-free/building-blocks.pcert1
-
-arithmetic-3/bind-free/collect.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/collect.pcert0 : acl2x = 0
-arithmetic-3/bind-free/collect.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/basic-helper.pcert0 \
-     arithmetic-3/bind-free/collect.lisp
-arithmetic-3/bind-free/collect.pcert1 : acl2x = 0
-arithmetic-3/bind-free/collect.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/collect.pcert1 : arithmetic-3/bind-free/collect.pcert0
-arithmetic-3/bind-free/collect.cert : | arithmetic-3/bind-free/collect.pcert1
-
-arithmetic-3/bind-free/common.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/common.pcert0 : acl2x = 0
-arithmetic-3/bind-free/common.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/building-blocks.pcert0 \
-     arithmetic-3/bind-free/common.lisp
-arithmetic-3/bind-free/common.pcert1 : acl2x = 0
-arithmetic-3/bind-free/common.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/common.pcert1 : arithmetic-3/bind-free/common.pcert0
-arithmetic-3/bind-free/common.cert : | arithmetic-3/bind-free/common.pcert1
-
-arithmetic-3/bind-free/default-hint.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/default-hint.pcert0 : acl2x = 0
-arithmetic-3/bind-free/default-hint.pcert0 : \
-     arithmetic-3/bind-free/default-hint.lisp
-arithmetic-3/bind-free/default-hint.pcert1 : acl2x = 0
-arithmetic-3/bind-free/default-hint.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/default-hint.pcert1 : arithmetic-3/bind-free/default-hint.pcert0
-arithmetic-3/bind-free/default-hint.cert : | arithmetic-3/bind-free/default-hint.pcert1
-
-arithmetic-3/bind-free/integerp-meta.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/integerp-meta.pcert0 : acl2x = 0
-arithmetic-3/bind-free/integerp-meta.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/default-hint.pcert0 \
-     arithmetic-3/bind-free/integerp-meta.lisp
-arithmetic-3/bind-free/integerp-meta.pcert1 : acl2x = 0
-arithmetic-3/bind-free/integerp-meta.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/integerp-meta.pcert1 : arithmetic-3/bind-free/integerp-meta.pcert0
-arithmetic-3/bind-free/integerp-meta.cert : | arithmetic-3/bind-free/integerp-meta.pcert1
-
-arithmetic-3/bind-free/integerp.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/integerp.pcert0 : acl2x = 0
-arithmetic-3/bind-free/integerp.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/building-blocks.pcert0 \
-     arithmetic-3/bind-free/default-hint.pcert0 \
-     arithmetic-3/bind-free/integerp.lisp
-arithmetic-3/bind-free/integerp.pcert1 : acl2x = 0
-arithmetic-3/bind-free/integerp.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/integerp.pcert1 : arithmetic-3/bind-free/integerp.pcert0
-arithmetic-3/bind-free/integerp.cert : | arithmetic-3/bind-free/integerp.pcert1
-
-arithmetic-3/bind-free/mini-theories-helper.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/mini-theories-helper.pcert0 : acl2x = 0
-arithmetic-3/bind-free/mini-theories-helper.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/default-hint.pcert0 \
-     arithmetic-3/bind-free/mini-theories-helper.lisp
-arithmetic-3/bind-free/mini-theories-helper.pcert1 : acl2x = 0
-arithmetic-3/bind-free/mini-theories-helper.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/mini-theories-helper.pcert1 : arithmetic-3/bind-free/mini-theories-helper.pcert0
-arithmetic-3/bind-free/mini-theories-helper.cert : | arithmetic-3/bind-free/mini-theories-helper.pcert1
-
-arithmetic-3/bind-free/mini-theories.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/mini-theories.pcert0 : acl2x = 0
-arithmetic-3/bind-free/mini-theories.pcert0 : \
-     arithmetic-3/bind-free/mini-theories-helper.pcert0 \
-     arithmetic-3/bind-free/mini-theories.lisp
-arithmetic-3/bind-free/mini-theories.pcert1 : acl2x = 0
-arithmetic-3/bind-free/mini-theories.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/mini-theories.pcert1 : arithmetic-3/bind-free/mini-theories.pcert0
-arithmetic-3/bind-free/mini-theories.cert : | arithmetic-3/bind-free/mini-theories.pcert1
-
-arithmetic-3/bind-free/normalize.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/normalize.pcert0 : acl2x = 0
-arithmetic-3/bind-free/normalize.pcert0 : \
-     arithmetic-3/bind-free/basic.pcert0 \
-     arithmetic-3/bind-free/common.pcert0 \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/normalize.lisp
-arithmetic-3/bind-free/normalize.pcert1 : acl2x = 0
-arithmetic-3/bind-free/normalize.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/normalize.pcert1 : arithmetic-3/bind-free/normalize.pcert0
-arithmetic-3/bind-free/normalize.cert : | arithmetic-3/bind-free/normalize.pcert1
-
-arithmetic-3/bind-free/numerator-and-denominator.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/numerator-and-denominator.pcert0 : acl2x = 0
-arithmetic-3/bind-free/numerator-and-denominator.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/numerator-and-denominator.lisp
-arithmetic-3/bind-free/numerator-and-denominator.pcert1 : acl2x = 0
-arithmetic-3/bind-free/numerator-and-denominator.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/numerator-and-denominator.pcert1 : arithmetic-3/bind-free/numerator-and-denominator.pcert0
-arithmetic-3/bind-free/numerator-and-denominator.cert : | arithmetic-3/bind-free/numerator-and-denominator.pcert1
-
-arithmetic-3/bind-free/remove-weak-inequalities.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/remove-weak-inequalities.pcert0 : acl2x = 0
-arithmetic-3/bind-free/remove-weak-inequalities.pcert0 : \
-     arithmetic-3/bind-free/building-blocks.pcert0 \
-     arithmetic-3/bind-free/remove-weak-inequalities.lisp
-arithmetic-3/bind-free/remove-weak-inequalities.pcert1 : acl2x = 0
-arithmetic-3/bind-free/remove-weak-inequalities.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/remove-weak-inequalities.pcert1 : arithmetic-3/bind-free/remove-weak-inequalities.pcert0
-arithmetic-3/bind-free/remove-weak-inequalities.cert : | arithmetic-3/bind-free/remove-weak-inequalities.pcert1
-
-arithmetic-3/bind-free/simplify-helper.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/simplify-helper.pcert0 : acl2x = 0
-arithmetic-3/bind-free/simplify-helper.pcert0 : \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/default-hint.pcert0 \
-     arithmetic-3/bind-free/simplify-helper.lisp
-arithmetic-3/bind-free/simplify-helper.pcert1 : acl2x = 0
-arithmetic-3/bind-free/simplify-helper.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/simplify-helper.pcert1 : arithmetic-3/bind-free/simplify-helper.pcert0
-arithmetic-3/bind-free/simplify-helper.cert : | arithmetic-3/bind-free/simplify-helper.pcert1
-
-arithmetic-3/bind-free/simplify.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/simplify.pcert0 : acl2x = 0
-arithmetic-3/bind-free/simplify.pcert0 : \
-     arithmetic-3/bind-free/simplify-helper.pcert0 \
-     arithmetic-3/bind-free/basic.pcert0 \
-     arithmetic-3/bind-free/common.pcert0 \
-     arithmetic-3/pass1/top.pcert0 \
-     arithmetic-3/bind-free/simplify.lisp
-arithmetic-3/bind-free/simplify.pcert1 : acl2x = 0
-arithmetic-3/bind-free/simplify.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/simplify.pcert1 : arithmetic-3/bind-free/simplify.pcert0
-arithmetic-3/bind-free/simplify.cert : | arithmetic-3/bind-free/simplify.pcert1
-
-arithmetic-3/bind-free/top.pcert0 : no_pcert = 0
-arithmetic-3/bind-free/top.pcert0 : acl2x = 0
-arithmetic-3/bind-free/top.pcert0 : \
-     arithmetic-3/bind-free/default-hint.pcert0 \
-     arithmetic-3/bind-free/building-blocks.pcert0 \
-     arithmetic-3/bind-free/mini-theories.pcert0 \
-     arithmetic-3/bind-free/common.pcert0 \
-     arithmetic-3/bind-free/normalize.pcert0 \
-     arithmetic-3/bind-free/simplify.pcert0 \
-     arithmetic-3/bind-free/numerator-and-denominator.pcert0 \
-     arithmetic-3/bind-free/integerp.pcert0 \
-     arithmetic-3/bind-free/integerp-meta.pcert0 \
-     arithmetic-3/bind-free/basic.pcert0 \
-     arithmetic-3/bind-free/collect.pcert0 \
-     arithmetic-3/bind-free/remove-weak-inequalities.pcert0 \
-     arithmetic-3/bind-free/arithmetic-theory.pcert0 \
-     arithmetic-3/bind-free/banner.pcert0 \
-     arithmetic-3/bind-free/top.lisp
-arithmetic-3/bind-free/top.pcert1 : acl2x = 0
-arithmetic-3/bind-free/top.pcert1 : no_pcert = 0
-arithmetic-3/bind-free/top.pcert1 : arithmetic-3/bind-free/top.pcert0
-arithmetic-3/bind-free/top.cert : | arithmetic-3/bind-free/top.pcert1
-
-arithmetic-3/extra/ext.pcert0 : no_pcert = 0
-arithmetic-3/extra/ext.pcert0 : acl2x = 0
-arithmetic-3/extra/ext.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/extra-rules.pcert0 \
-     arithmetic-2/meta/expt.pcert0 \
-     arithmetic-2/meta/integerp.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     arithmetic-3/extra/ext.lisp
-arithmetic-3/extra/ext.pcert1 : acl2x = 0
-arithmetic-3/extra/ext.pcert1 : no_pcert = 0
-arithmetic-3/extra/ext.pcert1 : arithmetic-3/extra/ext.pcert0
-arithmetic-3/extra/ext.cert : | arithmetic-3/extra/ext.pcert1
-
-arithmetic-3/extra/top-ext.pcert0 : no_pcert = 0
-arithmetic-3/extra/top-ext.pcert0 : acl2x = 0
-arithmetic-3/extra/top-ext.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     arithmetic-3/extra/ext.pcert0 \
-     arithmetic-3/extra/top-ext.lisp
-arithmetic-3/extra/top-ext.pcert1 : acl2x = 0
-arithmetic-3/extra/top-ext.pcert1 : no_pcert = 0
-arithmetic-3/extra/top-ext.pcert1 : arithmetic-3/extra/top-ext.pcert0
-arithmetic-3/extra/top-ext.cert : | arithmetic-3/extra/top-ext.pcert1
-
-arithmetic-3/floor-mod/floor-mod.pcert0 : no_pcert = 0
-arithmetic-3/floor-mod/floor-mod.pcert0 : acl2x = 0
-arithmetic-3/floor-mod/floor-mod.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/bind-free/building-blocks.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.lisp
-arithmetic-3/floor-mod/floor-mod.pcert1 : acl2x = 0
-arithmetic-3/floor-mod/floor-mod.pcert1 : no_pcert = 0
-arithmetic-3/floor-mod/floor-mod.pcert1 : arithmetic-3/floor-mod/floor-mod.pcert0
-arithmetic-3/floor-mod/floor-mod.cert : | arithmetic-3/floor-mod/floor-mod.pcert1
-
-arithmetic-3/floor-mod/mod-expt-fast.pcert0 : no_pcert = 0
-arithmetic-3/floor-mod/mod-expt-fast.pcert0 : acl2x = 0
-arithmetic-3/floor-mod/mod-expt-fast.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     arithmetic-3/floor-mod/mod-expt-fast.lisp
-arithmetic-3/floor-mod/mod-expt-fast.pcert1 : acl2x = 0
-arithmetic-3/floor-mod/mod-expt-fast.pcert1 : no_pcert = 0
-arithmetic-3/floor-mod/mod-expt-fast.pcert1 : arithmetic-3/floor-mod/mod-expt-fast.pcert0
-arithmetic-3/floor-mod/mod-expt-fast.cert : | arithmetic-3/floor-mod/mod-expt-fast.pcert1
-
-arithmetic-3/pass1/basic-arithmetic-helper.pcert0 : no_pcert = 0
-arithmetic-3/pass1/basic-arithmetic-helper.pcert0 : acl2x = 0
-arithmetic-3/pass1/basic-arithmetic-helper.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic-helper.lisp
-arithmetic-3/pass1/basic-arithmetic-helper.pcert1 : acl2x = 0
-arithmetic-3/pass1/basic-arithmetic-helper.pcert1 : no_pcert = 0
-arithmetic-3/pass1/basic-arithmetic-helper.pcert1 : arithmetic-3/pass1/basic-arithmetic-helper.pcert0
-arithmetic-3/pass1/basic-arithmetic-helper.cert : | arithmetic-3/pass1/basic-arithmetic-helper.pcert1
-
-arithmetic-3/pass1/basic-arithmetic.pcert0 : no_pcert = 0
-arithmetic-3/pass1/basic-arithmetic.pcert0 : acl2x = 0
-arithmetic-3/pass1/basic-arithmetic.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic-helper.pcert0 \
-     arithmetic-3/pass1/basic-arithmetic.lisp
-arithmetic-3/pass1/basic-arithmetic.pcert1 : acl2x = 0
-arithmetic-3/pass1/basic-arithmetic.pcert1 : no_pcert = 0
-arithmetic-3/pass1/basic-arithmetic.pcert1 : arithmetic-3/pass1/basic-arithmetic.pcert0
-arithmetic-3/pass1/basic-arithmetic.cert : | arithmetic-3/pass1/basic-arithmetic.pcert1
-
-arithmetic-3/pass1/expt-helper.pcert0 : no_pcert = 0
-arithmetic-3/pass1/expt-helper.pcert0 : acl2x = 0
-arithmetic-3/pass1/expt-helper.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/inequalities.pcert0 \
-     arithmetic-3/pass1/prefer-times.pcert0 \
-     arithmetic-3/pass1/expt-helper.lisp
-arithmetic-3/pass1/expt-helper.pcert1 : acl2x = 0
-arithmetic-3/pass1/expt-helper.pcert1 : no_pcert = 0
-arithmetic-3/pass1/expt-helper.pcert1 : arithmetic-3/pass1/expt-helper.pcert0
-arithmetic-3/pass1/expt-helper.cert : | arithmetic-3/pass1/expt-helper.pcert1
-
-arithmetic-3/pass1/expt.pcert0 : no_pcert = 0
-arithmetic-3/pass1/expt.pcert0 : acl2x = 0
-arithmetic-3/pass1/expt.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/inequalities.pcert0 \
-     arithmetic-3/pass1/prefer-times.pcert0 \
-     arithmetic-3/pass1/expt-helper.pcert0 \
-     arithmetic-3/pass1/expt.lisp
-arithmetic-3/pass1/expt.pcert1 : acl2x = 0
-arithmetic-3/pass1/expt.pcert1 : no_pcert = 0
-arithmetic-3/pass1/expt.pcert1 : arithmetic-3/pass1/expt.pcert0
-arithmetic-3/pass1/expt.cert : | arithmetic-3/pass1/expt.pcert1
-
-arithmetic-3/pass1/inequalities.pcert0 : no_pcert = 0
-arithmetic-3/pass1/inequalities.pcert0 : acl2x = 0
-arithmetic-3/pass1/inequalities.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/inequalities.lisp
-arithmetic-3/pass1/inequalities.pcert1 : acl2x = 0
-arithmetic-3/pass1/inequalities.pcert1 : no_pcert = 0
-arithmetic-3/pass1/inequalities.pcert1 : arithmetic-3/pass1/inequalities.pcert0
-arithmetic-3/pass1/inequalities.cert : | arithmetic-3/pass1/inequalities.pcert1
-
-arithmetic-3/pass1/mini-theories.pcert0 : no_pcert = 0
-arithmetic-3/pass1/mini-theories.pcert0 : acl2x = 0
-arithmetic-3/pass1/mini-theories.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/inequalities.pcert0 \
-     arithmetic-3/pass1/prefer-times.pcert0 \
-     arithmetic-3/pass1/expt.pcert0 \
-     arithmetic-3/pass1/mini-theories.lisp
-arithmetic-3/pass1/mini-theories.pcert1 : acl2x = 0
-arithmetic-3/pass1/mini-theories.pcert1 : no_pcert = 0
-arithmetic-3/pass1/mini-theories.pcert1 : arithmetic-3/pass1/mini-theories.pcert0
-arithmetic-3/pass1/mini-theories.cert : | arithmetic-3/pass1/mini-theories.pcert1
-
-arithmetic-3/pass1/non-linear.pcert0 : no_pcert = 0
-arithmetic-3/pass1/non-linear.pcert0 : acl2x = 0
-arithmetic-3/pass1/non-linear.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/expt.pcert0 \
-     arithmetic-3/pass1/non-linear.lisp
-arithmetic-3/pass1/non-linear.pcert1 : acl2x = 0
-arithmetic-3/pass1/non-linear.pcert1 : no_pcert = 0
-arithmetic-3/pass1/non-linear.pcert1 : arithmetic-3/pass1/non-linear.pcert0
-arithmetic-3/pass1/non-linear.cert : | arithmetic-3/pass1/non-linear.pcert1
-
-arithmetic-3/pass1/num-and-denom-helper.pcert0 : no_pcert = 0
-arithmetic-3/pass1/num-and-denom-helper.pcert0 : acl2x = 0
-arithmetic-3/pass1/num-and-denom-helper.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/inequalities.pcert0 \
-     arithmetic-3/pass1/prefer-times.pcert0 \
-     arithmetic-3/pass1/non-linear.pcert0 \
-     arithmetic-3/pass1/num-and-denom-helper.lisp
-arithmetic-3/pass1/num-and-denom-helper.pcert1 : acl2x = 0
-arithmetic-3/pass1/num-and-denom-helper.pcert1 : no_pcert = 0
-arithmetic-3/pass1/num-and-denom-helper.pcert1 : arithmetic-3/pass1/num-and-denom-helper.pcert0
-arithmetic-3/pass1/num-and-denom-helper.cert : | arithmetic-3/pass1/num-and-denom-helper.pcert1
-
-arithmetic-3/pass1/numerator-and-denominator.pcert0 : no_pcert = 0
-arithmetic-3/pass1/numerator-and-denominator.pcert0 : acl2x = 0
-arithmetic-3/pass1/numerator-and-denominator.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/inequalities.pcert0 \
-     arithmetic-3/pass1/prefer-times.pcert0 \
-     arithmetic-3/pass1/non-linear.pcert0 \
-     arithmetic-3/pass1/num-and-denom-helper.pcert0 \
-     arithmetic-3/pass1/numerator-and-denominator.lisp
-arithmetic-3/pass1/numerator-and-denominator.pcert1 : acl2x = 0
-arithmetic-3/pass1/numerator-and-denominator.pcert1 : no_pcert = 0
-arithmetic-3/pass1/numerator-and-denominator.pcert1 : arithmetic-3/pass1/numerator-and-denominator.pcert0
-arithmetic-3/pass1/numerator-and-denominator.cert : | arithmetic-3/pass1/numerator-and-denominator.pcert1
-
-arithmetic-3/pass1/prefer-times.pcert0 : no_pcert = 0
-arithmetic-3/pass1/prefer-times.pcert0 : acl2x = 0
-arithmetic-3/pass1/prefer-times.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/inequalities.pcert0 \
-     arithmetic-3/pass1/prefer-times.lisp
-arithmetic-3/pass1/prefer-times.pcert1 : acl2x = 0
-arithmetic-3/pass1/prefer-times.pcert1 : no_pcert = 0
-arithmetic-3/pass1/prefer-times.pcert1 : arithmetic-3/pass1/prefer-times.pcert0
-arithmetic-3/pass1/prefer-times.cert : | arithmetic-3/pass1/prefer-times.pcert1
-
-arithmetic-3/pass1/top.pcert0 : no_pcert = 0
-arithmetic-3/pass1/top.pcert0 : acl2x = 0
-arithmetic-3/pass1/top.pcert0 : \
-     arithmetic-3/pass1/basic-arithmetic.pcert0 \
-     arithmetic-3/pass1/inequalities.pcert0 \
-     arithmetic-3/pass1/expt.pcert0 \
-     arithmetic-3/pass1/prefer-times.pcert0 \
-     arithmetic-3/pass1/mini-theories.pcert0 \
-     arithmetic-3/pass1/numerator-and-denominator.pcert0 \
-     arithmetic-3/pass1/non-linear.pcert0 \
-     arithmetic-3/pass1/top.lisp
-arithmetic-3/pass1/top.pcert1 : acl2x = 0
-arithmetic-3/pass1/top.pcert1 : no_pcert = 0
-arithmetic-3/pass1/top.pcert1 : arithmetic-3/pass1/top.pcert0
-arithmetic-3/pass1/top.cert : | arithmetic-3/pass1/top.pcert1
-
-arithmetic-3/top.pcert0 : no_pcert = 0
-arithmetic-3/top.pcert0 : acl2x = 0
-arithmetic-3/top.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     arithmetic-3/floor-mod/mod-expt-fast.pcert0 \
-     arithmetic-3/top.lisp
-arithmetic-3/top.pcert1 : acl2x = 0
-arithmetic-3/top.pcert1 : no_pcert = 0
-arithmetic-3/top.pcert1 : arithmetic-3/top.pcert0
-arithmetic-3/top.cert : | arithmetic-3/top.pcert1
-
-arithmetic-5/lib/basic-ops/arithmetic-theory.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/arithmetic-theory.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/arithmetic-theory.pcert0 : \
-     arithmetic-5/lib/basic-ops/common.pcert0 \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/basic.pcert0 \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert0 \
-     arithmetic-5/lib/basic-ops/expt.pcert0 \
-     arithmetic-5/lib/basic-ops/collect.pcert0 \
-     arithmetic-5/lib/basic-ops/arithmetic-theory.lisp
-arithmetic-5/lib/basic-ops/arithmetic-theory.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/arithmetic-theory.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/arithmetic-theory.pcert1 : arithmetic-5/lib/basic-ops/arithmetic-theory.pcert0
-arithmetic-5/lib/basic-ops/arithmetic-theory.cert : | arithmetic-5/lib/basic-ops/arithmetic-theory.pcert1
-
-arithmetic-5/lib/basic-ops/banner.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/banner.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/banner.pcert0 : \
-     arithmetic-5/lib/basic-ops/banner.lisp
-arithmetic-5/lib/basic-ops/banner.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/banner.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/banner.pcert1 : arithmetic-5/lib/basic-ops/banner.pcert0
-arithmetic-5/lib/basic-ops/banner.cert : | arithmetic-5/lib/basic-ops/banner.pcert1
-
-arithmetic-5/lib/basic-ops/basic.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/basic.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/basic.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/basic.lisp
-arithmetic-5/lib/basic-ops/basic.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/basic.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/basic.pcert1 : arithmetic-5/lib/basic-ops/basic.pcert0
-arithmetic-5/lib/basic-ops/basic.cert : | arithmetic-5/lib/basic-ops/basic.pcert1
-
-arithmetic-5/lib/basic-ops/building-blocks-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/building-blocks-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/building-blocks-helper.pcert0 : \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/building-blocks-helper.lisp
-arithmetic-5/lib/basic-ops/building-blocks-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/building-blocks-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/building-blocks-helper.pcert1 : arithmetic-5/lib/basic-ops/building-blocks-helper.pcert0
-arithmetic-5/lib/basic-ops/building-blocks-helper.cert : | arithmetic-5/lib/basic-ops/building-blocks-helper.pcert1
-
-arithmetic-5/lib/basic-ops/building-blocks.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/building-blocks.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/building-blocks.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks-helper.pcert0 \
-     arithmetic-5/lib/basic-ops/building-blocks.lisp
-arithmetic-5/lib/basic-ops/building-blocks.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/building-blocks.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/building-blocks.pcert1 : arithmetic-5/lib/basic-ops/building-blocks.pcert0
-arithmetic-5/lib/basic-ops/building-blocks.cert : | arithmetic-5/lib/basic-ops/building-blocks.pcert1
-
-arithmetic-5/lib/basic-ops/collect.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/collect.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/collect.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/expt-helper.pcert0 \
-     arithmetic-5/lib/basic-ops/collect.lisp
-arithmetic-5/lib/basic-ops/collect.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/collect.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/collect.pcert1 : arithmetic-5/lib/basic-ops/collect.pcert0
-arithmetic-5/lib/basic-ops/collect.cert : | arithmetic-5/lib/basic-ops/collect.pcert1
-
-arithmetic-5/lib/basic-ops/common.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/common.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/common.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/common.lisp
-arithmetic-5/lib/basic-ops/common.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/common.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/common.pcert1 : arithmetic-5/lib/basic-ops/common.pcert0
-arithmetic-5/lib/basic-ops/common.cert : | arithmetic-5/lib/basic-ops/common.pcert1
-
-arithmetic-5/lib/basic-ops/default-hint.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/default-hint.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/default-hint.pcert0 : \
-     arithmetic-5/lib/basic-ops/dynamic-e-d.pcert0 \
-     arithmetic-5/lib/basic-ops/default-hint.lisp
-arithmetic-5/lib/basic-ops/default-hint.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/default-hint.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/default-hint.pcert1 : arithmetic-5/lib/basic-ops/default-hint.pcert0
-arithmetic-5/lib/basic-ops/default-hint.cert : | arithmetic-5/lib/basic-ops/default-hint.pcert1
-
-arithmetic-5/lib/basic-ops/distributivity.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/distributivity.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/distributivity.pcert0 : \
-     arithmetic-5/lib/basic-ops/distributivity.lisp
-arithmetic-5/lib/basic-ops/distributivity.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/distributivity.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/distributivity.pcert1 : arithmetic-5/lib/basic-ops/distributivity.pcert0
-arithmetic-5/lib/basic-ops/distributivity.cert : | arithmetic-5/lib/basic-ops/distributivity.pcert1
-
-arithmetic-5/lib/basic-ops/dynamic-e-d.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/dynamic-e-d.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/dynamic-e-d.pcert0 : \
-     arithmetic-5/lib/basic-ops/dynamic-e-d.lisp
-arithmetic-5/lib/basic-ops/dynamic-e-d.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/dynamic-e-d.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/dynamic-e-d.pcert1 : arithmetic-5/lib/basic-ops/dynamic-e-d.pcert0
-arithmetic-5/lib/basic-ops/dynamic-e-d.cert : | arithmetic-5/lib/basic-ops/dynamic-e-d.pcert1
-
-arithmetic-5/lib/basic-ops/elim-hint.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/elim-hint.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/elim-hint.pcert0 : \
-     arithmetic-5/lib/basic-ops/default-hint.pcert0 \
-     arithmetic-5/lib/basic-ops/elim-hint.lisp \
-     arithmetic-5/lib/basic-ops/elim-hint.acl2
-arithmetic-5/lib/basic-ops/elim-hint.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/elim-hint.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/elim-hint.pcert1 : arithmetic-5/lib/basic-ops/elim-hint.pcert0
-arithmetic-5/lib/basic-ops/elim-hint.cert : | arithmetic-5/lib/basic-ops/elim-hint.pcert1
-
-arithmetic-5/lib/basic-ops/expt-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/expt-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/expt-helper.pcert0 : \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/default-hint.pcert0 \
-     arithmetic-5/lib/basic-ops/expt-helper.lisp
-arithmetic-5/lib/basic-ops/expt-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/expt-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/expt-helper.pcert1 : arithmetic-5/lib/basic-ops/expt-helper.pcert0
-arithmetic-5/lib/basic-ops/expt-helper.cert : | arithmetic-5/lib/basic-ops/expt-helper.pcert1
-
-arithmetic-5/lib/basic-ops/expt.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/expt.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/expt.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/expt-helper.pcert0 \
-     arithmetic-5/lib/basic-ops/types.pcert0 \
-     arithmetic-5/lib/basic-ops/expt.lisp
-arithmetic-5/lib/basic-ops/expt.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/expt.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/expt.pcert1 : arithmetic-5/lib/basic-ops/expt.pcert0
-arithmetic-5/lib/basic-ops/expt.cert : | arithmetic-5/lib/basic-ops/expt.pcert1
-
-arithmetic-5/lib/basic-ops/forcing-types.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/forcing-types.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/forcing-types.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/forcing-types.lisp
-arithmetic-5/lib/basic-ops/forcing-types.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/forcing-types.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/forcing-types.pcert1 : arithmetic-5/lib/basic-ops/forcing-types.pcert0
-arithmetic-5/lib/basic-ops/forcing-types.cert : | arithmetic-5/lib/basic-ops/forcing-types.pcert1
-
-arithmetic-5/lib/basic-ops/if-normalization.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/if-normalization.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/if-normalization.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/if-normalization.lisp
-arithmetic-5/lib/basic-ops/if-normalization.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/if-normalization.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/if-normalization.pcert1 : arithmetic-5/lib/basic-ops/if-normalization.pcert0
-arithmetic-5/lib/basic-ops/if-normalization.cert : | arithmetic-5/lib/basic-ops/if-normalization.pcert1
-
-arithmetic-5/lib/basic-ops/integerp-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/integerp-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp-helper.pcert0 : \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/default-hint.pcert0 \
-     arithmetic-5/lib/basic-ops/integerp-helper.lisp
-arithmetic-5/lib/basic-ops/integerp-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/integerp-helper.pcert1 : arithmetic-5/lib/basic-ops/integerp-helper.pcert0
-arithmetic-5/lib/basic-ops/integerp-helper.cert : | arithmetic-5/lib/basic-ops/integerp-helper.pcert1
-
-arithmetic-5/lib/basic-ops/integerp-meta.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/integerp-meta.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp-meta.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/default-hint.pcert0 \
-     arithmetic-5/lib/basic-ops/integerp-meta.lisp
-arithmetic-5/lib/basic-ops/integerp-meta.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp-meta.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/integerp-meta.pcert1 : arithmetic-5/lib/basic-ops/integerp-meta.pcert0
-arithmetic-5/lib/basic-ops/integerp-meta.cert : | arithmetic-5/lib/basic-ops/integerp-meta.pcert1
-
-arithmetic-5/lib/basic-ops/integerp.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/integerp.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/default-hint.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/integerp-helper.pcert0 \
-     arithmetic-5/lib/basic-ops/common.pcert0 \
-     arithmetic-5/lib/basic-ops/normalize.pcert0 \
-     arithmetic-5/lib/basic-ops/simplify.pcert0 \
-     arithmetic-5/lib/basic-ops/collect.pcert0 \
-     arithmetic-5/lib/basic-ops/integerp.lisp
-arithmetic-5/lib/basic-ops/integerp.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/integerp.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/integerp.pcert1 : arithmetic-5/lib/basic-ops/integerp.pcert0
-arithmetic-5/lib/basic-ops/integerp.cert : | arithmetic-5/lib/basic-ops/integerp.pcert1
-
-arithmetic-5/lib/basic-ops/mini-theories.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/mini-theories.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/mini-theories.pcert0 : \
-     arithmetic-5/lib/basic-ops/mini-theories.lisp
-arithmetic-5/lib/basic-ops/mini-theories.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/mini-theories.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/mini-theories.pcert1 : arithmetic-5/lib/basic-ops/mini-theories.pcert0
-arithmetic-5/lib/basic-ops/mini-theories.cert : | arithmetic-5/lib/basic-ops/mini-theories.pcert1
-
-arithmetic-5/lib/basic-ops/natp-posp.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/natp-posp.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/natp-posp.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/natp-posp.lisp
-arithmetic-5/lib/basic-ops/natp-posp.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/natp-posp.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/natp-posp.pcert1 : arithmetic-5/lib/basic-ops/natp-posp.pcert0
-arithmetic-5/lib/basic-ops/natp-posp.cert : | arithmetic-5/lib/basic-ops/natp-posp.pcert1
-
-arithmetic-5/lib/basic-ops/normalize.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/normalize.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/normalize.pcert0 : \
-     arithmetic-5/lib/basic-ops/common.pcert0 \
-     arithmetic-5/lib/basic-ops/basic.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/normalize.lisp
-arithmetic-5/lib/basic-ops/normalize.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/normalize.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/normalize.pcert1 : arithmetic-5/lib/basic-ops/normalize.pcert0
-arithmetic-5/lib/basic-ops/normalize.cert : | arithmetic-5/lib/basic-ops/normalize.pcert1
-
-arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert0 : \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/numerator-and-denominator.lisp
-arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert1 : arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert0
-arithmetic-5/lib/basic-ops/numerator-and-denominator.cert : | arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert1
-
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/remove-weak-inequalities.lisp
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert1 : arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert0
-arithmetic-5/lib/basic-ops/remove-weak-inequalities.cert : | arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert1
-
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert0 : \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.lisp
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert1 : arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.cert : | arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert1
-
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/simplify-helper.pcert0 \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.pcert0 \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.lisp
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert1 : arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert0
-arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert : | arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert1
-
-arithmetic-5/lib/basic-ops/simplify-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/simplify-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/simplify-helper.pcert0 : \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/default-hint.pcert0 \
-     arithmetic-5/lib/basic-ops/simplify-helper.lisp
-arithmetic-5/lib/basic-ops/simplify-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/simplify-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/simplify-helper.pcert1 : arithmetic-5/lib/basic-ops/simplify-helper.pcert0
-arithmetic-5/lib/basic-ops/simplify-helper.cert : | arithmetic-5/lib/basic-ops/simplify-helper.pcert1
-
-arithmetic-5/lib/basic-ops/simplify.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/simplify.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/simplify.pcert0 : \
-     arithmetic-5/lib/basic-ops/common.pcert0 \
-     arithmetic-5/lib/basic-ops/simplify-helper.pcert0 \
-     arithmetic-5/lib/basic-ops/basic.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/simplify.lisp
-arithmetic-5/lib/basic-ops/simplify.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/simplify.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/simplify.pcert1 : arithmetic-5/lib/basic-ops/simplify.pcert0
-arithmetic-5/lib/basic-ops/simplify.cert : | arithmetic-5/lib/basic-ops/simplify.pcert1
-
-arithmetic-5/lib/basic-ops/top.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/top.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/top.pcert0 : \
-     arithmetic-5/lib/basic-ops/we-are-here.pcert0 \
-     arithmetic-5/lib/basic-ops/distributivity.pcert0 \
-     arithmetic-5/lib/basic-ops/default-hint.pcert0 \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/common.pcert0 \
-     arithmetic-5/lib/basic-ops/normalize.pcert0 \
-     arithmetic-5/lib/basic-ops/simplify.pcert0 \
-     arithmetic-5/lib/basic-ops/mini-theories.pcert0 \
-     arithmetic-5/lib/basic-ops/numerator-and-denominator.pcert0 \
-     arithmetic-5/lib/basic-ops/natp-posp.pcert0 \
-     arithmetic-5/lib/basic-ops/integerp-meta.pcert0 \
-     arithmetic-5/lib/basic-ops/integerp.pcert0 \
-     arithmetic-5/lib/basic-ops/basic.pcert0 \
-     arithmetic-5/lib/basic-ops/expt.pcert0 \
-     arithmetic-5/lib/basic-ops/collect.pcert0 \
-     arithmetic-5/lib/basic-ops/remove-weak-inequalities.pcert0 \
-     arithmetic-5/lib/basic-ops/arithmetic-theory.pcert0 \
-     arithmetic-5/lib/basic-ops/types.pcert0 \
-     arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.pcert0 \
-     arithmetic-5/lib/basic-ops/if-normalization.pcert0 \
-     arithmetic-5/lib/basic-ops/forcing-types.pcert0 \
-     arithmetic-5/lib/basic-ops/banner.pcert0 \
-     arithmetic-5/lib/basic-ops/top.lisp
-arithmetic-5/lib/basic-ops/top.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/top.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/top.pcert1 : arithmetic-5/lib/basic-ops/top.pcert0
-arithmetic-5/lib/basic-ops/top.cert : | arithmetic-5/lib/basic-ops/top.pcert1
-
-arithmetic-5/lib/basic-ops/types-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/types-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/types-helper.pcert0 : \
-     arithmetic-5/support/top.pcert0 \
-     arithmetic-5/lib/basic-ops/types-helper.lisp
-arithmetic-5/lib/basic-ops/types-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/types-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/types-helper.pcert1 : arithmetic-5/lib/basic-ops/types-helper.pcert0
-arithmetic-5/lib/basic-ops/types-helper.cert : | arithmetic-5/lib/basic-ops/types-helper.pcert1
-
-arithmetic-5/lib/basic-ops/types.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/types.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/types.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/types-helper.pcert0 \
-     arithmetic-5/lib/basic-ops/types.lisp
-arithmetic-5/lib/basic-ops/types.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/types.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/types.pcert1 : arithmetic-5/lib/basic-ops/types.pcert0
-arithmetic-5/lib/basic-ops/types.cert : | arithmetic-5/lib/basic-ops/types.pcert1
-
-arithmetic-5/lib/basic-ops/we-are-here.pcert0 : no_pcert = 0
-arithmetic-5/lib/basic-ops/we-are-here.pcert0 : acl2x = 0
-arithmetic-5/lib/basic-ops/we-are-here.pcert0 : \
-     arithmetic-5/lib/basic-ops/we-are-here.lisp
-arithmetic-5/lib/basic-ops/we-are-here.pcert1 : acl2x = 0
-arithmetic-5/lib/basic-ops/we-are-here.pcert1 : no_pcert = 0
-arithmetic-5/lib/basic-ops/we-are-here.pcert1 : arithmetic-5/lib/basic-ops/we-are-here.pcert0
-arithmetic-5/lib/basic-ops/we-are-here.cert : | arithmetic-5/lib/basic-ops/we-are-here.pcert1
-
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/floor-mod/forcing-types.pcert0 \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic-helper.lisp
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert1 : arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert0
-arithmetic-5/lib/floor-mod/floor-mod-basic-helper.cert : | arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert1
-
-arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/floor-mod/forcing-types.pcert0 \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic-helper.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.lisp
-arithmetic-5/lib/floor-mod/floor-mod-basic.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/floor-mod-basic.pcert1 : arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0
-arithmetic-5/lib/floor-mod/floor-mod-basic.cert : | arithmetic-5/lib/floor-mod/floor-mod-basic.pcert1
-
-arithmetic-5/lib/floor-mod/floor-mod-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/floor-mod-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-helper.pcert0 : \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 \
-     arithmetic-5/lib/floor-mod/forcing-types.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-helper.lisp
-arithmetic-5/lib/floor-mod/floor-mod-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/floor-mod-helper.pcert1 : arithmetic-5/lib/floor-mod/floor-mod-helper.pcert0
-arithmetic-5/lib/floor-mod/floor-mod-helper.cert : | arithmetic-5/lib/floor-mod/floor-mod-helper.pcert1
-
-arithmetic-5/lib/floor-mod/floor-mod.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/floor-mod.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/common.pcert0 \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 \
-     arithmetic-5/lib/floor-mod/forcing-types.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-helper.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod.lisp
-arithmetic-5/lib/floor-mod/floor-mod.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/floor-mod.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/floor-mod.pcert1 : arithmetic-5/lib/floor-mod/floor-mod.pcert0
-arithmetic-5/lib/floor-mod/floor-mod.cert : | arithmetic-5/lib/floor-mod/floor-mod.pcert1
-
-arithmetic-5/lib/floor-mod/forcing-types.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/forcing-types.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/forcing-types.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/floor-mod/forcing-types.lisp
-arithmetic-5/lib/floor-mod/forcing-types.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/forcing-types.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/forcing-types.pcert1 : arithmetic-5/lib/floor-mod/forcing-types.pcert0
-arithmetic-5/lib/floor-mod/forcing-types.cert : | arithmetic-5/lib/floor-mod/forcing-types.pcert1
-
-arithmetic-5/lib/floor-mod/if-normalization.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/if-normalization.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/if-normalization.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/floor-mod/if-normalization.lisp
-arithmetic-5/lib/floor-mod/if-normalization.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/if-normalization.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/if-normalization.pcert1 : arithmetic-5/lib/floor-mod/if-normalization.pcert0
-arithmetic-5/lib/floor-mod/if-normalization.cert : | arithmetic-5/lib/floor-mod/if-normalization.pcert1
-
-arithmetic-5/lib/floor-mod/logand-helper.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/logand-helper.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/logand-helper.pcert0 : \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/more-floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 \
-     arithmetic-5/lib/floor-mod/truncate-rem.pcert0 \
-     arithmetic-5/lib/floor-mod/logand-helper.lisp
-arithmetic-5/lib/floor-mod/logand-helper.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/logand-helper.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/logand-helper.pcert1 : arithmetic-5/lib/floor-mod/logand-helper.pcert0
-arithmetic-5/lib/floor-mod/logand-helper.cert : | arithmetic-5/lib/floor-mod/logand-helper.pcert1
-
-arithmetic-5/lib/floor-mod/logand.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/logand.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/logand.pcert0 : \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/more-floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 \
-     arithmetic-5/lib/floor-mod/truncate-rem.pcert0 \
-     arithmetic-5/lib/floor-mod/logand-helper.pcert0 \
-     arithmetic-5/lib/floor-mod/logand.lisp
-arithmetic-5/lib/floor-mod/logand.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/logand.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/logand.pcert1 : arithmetic-5/lib/floor-mod/logand.pcert0
-arithmetic-5/lib/floor-mod/logand.cert : | arithmetic-5/lib/floor-mod/logand.pcert1
-
-arithmetic-5/lib/floor-mod/mod-expt-fast.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/mod-expt-fast.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/mod-expt-fast.pcert0 : \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/more-floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/truncate-rem.pcert0 \
-     arithmetic-5/lib/floor-mod/mod-expt-fast.lisp
-arithmetic-5/lib/floor-mod/mod-expt-fast.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/mod-expt-fast.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/mod-expt-fast.pcert1 : arithmetic-5/lib/floor-mod/mod-expt-fast.pcert0
-arithmetic-5/lib/floor-mod/mod-expt-fast.cert : | arithmetic-5/lib/floor-mod/mod-expt-fast.pcert1
-
-arithmetic-5/lib/floor-mod/more-floor-mod.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/more-floor-mod.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/more-floor-mod.pcert0 : \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 \
-     arithmetic-5/lib/floor-mod/if-normalization.pcert0 \
-     arithmetic-5/lib/floor-mod/forcing-types.pcert0 \
-     arithmetic-5/lib/floor-mod/more-floor-mod.lisp
-arithmetic-5/lib/floor-mod/more-floor-mod.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/more-floor-mod.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/more-floor-mod.pcert1 : arithmetic-5/lib/floor-mod/more-floor-mod.pcert0
-arithmetic-5/lib/floor-mod/more-floor-mod.cert : | arithmetic-5/lib/floor-mod/more-floor-mod.pcert1
-
-arithmetic-5/lib/floor-mod/top.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/top.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/top.pcert0 : \
-     arithmetic-5/lib/floor-mod/logand.pcert0 \
-     arithmetic-5/lib/floor-mod/truncate-rem.pcert0 \
-     arithmetic-5/lib/floor-mod/mod-expt-fast.pcert0 \
-     arithmetic-5/lib/floor-mod/more-floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 \
-     arithmetic-5/lib/floor-mod/if-normalization.pcert0 \
-     arithmetic-5/lib/floor-mod/forcing-types.pcert0 \
-     arithmetic-5/lib/floor-mod/top.lisp
-arithmetic-5/lib/floor-mod/top.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/top.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/top.pcert1 : arithmetic-5/lib/floor-mod/top.pcert0
-arithmetic-5/lib/floor-mod/top.cert : | arithmetic-5/lib/floor-mod/top.pcert1
-
-arithmetic-5/lib/floor-mod/truncate-rem.pcert0 : no_pcert = 0
-arithmetic-5/lib/floor-mod/truncate-rem.pcert0 : acl2x = 0
-arithmetic-5/lib/floor-mod/truncate-rem.pcert0 : \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod.pcert0 \
-     arithmetic-5/lib/floor-mod/floor-mod-basic.pcert0 \
-     arithmetic-5/lib/basic-ops/building-blocks.pcert0 \
-     arithmetic-5/lib/floor-mod/truncate-rem.lisp
-arithmetic-5/lib/floor-mod/truncate-rem.pcert1 : acl2x = 0
-arithmetic-5/lib/floor-mod/truncate-rem.pcert1 : no_pcert = 0
-arithmetic-5/lib/floor-mod/truncate-rem.pcert1 : arithmetic-5/lib/floor-mod/truncate-rem.pcert0
-arithmetic-5/lib/floor-mod/truncate-rem.cert : | arithmetic-5/lib/floor-mod/truncate-rem.pcert1
-
-arithmetic-5/support/basic-arithmetic-helper.pcert0 : no_pcert = 0
-arithmetic-5/support/basic-arithmetic-helper.pcert0 : acl2x = 0
-arithmetic-5/support/basic-arithmetic-helper.pcert0 : \
-     arithmetic-5/support/basic-arithmetic-helper.lisp
-arithmetic-5/support/basic-arithmetic-helper.pcert1 : acl2x = 0
-arithmetic-5/support/basic-arithmetic-helper.pcert1 : no_pcert = 0
-arithmetic-5/support/basic-arithmetic-helper.pcert1 : arithmetic-5/support/basic-arithmetic-helper.pcert0
-arithmetic-5/support/basic-arithmetic-helper.cert : | arithmetic-5/support/basic-arithmetic-helper.pcert1
-
-arithmetic-5/support/basic-arithmetic.pcert0 : no_pcert = 0
-arithmetic-5/support/basic-arithmetic.pcert0 : acl2x = 0
-arithmetic-5/support/basic-arithmetic.pcert0 : \
-     arithmetic-5/support/basic-arithmetic-helper.pcert0 \
-     arithmetic-5/support/basic-arithmetic.lisp
-arithmetic-5/support/basic-arithmetic.pcert1 : acl2x = 0
-arithmetic-5/support/basic-arithmetic.pcert1 : no_pcert = 0
-arithmetic-5/support/basic-arithmetic.pcert1 : arithmetic-5/support/basic-arithmetic.pcert0
-arithmetic-5/support/basic-arithmetic.cert : | arithmetic-5/support/basic-arithmetic.pcert1
-
-arithmetic-5/support/expt-helper.pcert0 : no_pcert = 0
-arithmetic-5/support/expt-helper.pcert0 : acl2x = 0
-arithmetic-5/support/expt-helper.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/inequalities.pcert0 \
-     arithmetic-5/support/prefer-times.pcert0 \
-     arithmetic-5/support/expt-helper.lisp
-arithmetic-5/support/expt-helper.pcert1 : acl2x = 0
-arithmetic-5/support/expt-helper.pcert1 : no_pcert = 0
-arithmetic-5/support/expt-helper.pcert1 : arithmetic-5/support/expt-helper.pcert0
-arithmetic-5/support/expt-helper.cert : | arithmetic-5/support/expt-helper.pcert1
-
-arithmetic-5/support/expt.pcert0 : no_pcert = 0
-arithmetic-5/support/expt.pcert0 : acl2x = 0
-arithmetic-5/support/expt.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/inequalities.pcert0 \
-     arithmetic-5/support/prefer-times.pcert0 \
-     arithmetic-5/support/expt-helper.pcert0 \
-     arithmetic-5/support/expt.lisp
-arithmetic-5/support/expt.pcert1 : acl2x = 0
-arithmetic-5/support/expt.pcert1 : no_pcert = 0
-arithmetic-5/support/expt.pcert1 : arithmetic-5/support/expt.pcert0
-arithmetic-5/support/expt.cert : | arithmetic-5/support/expt.pcert1
-
-arithmetic-5/support/inequalities.pcert0 : no_pcert = 0
-arithmetic-5/support/inequalities.pcert0 : acl2x = 0
-arithmetic-5/support/inequalities.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/inequalities.lisp
-arithmetic-5/support/inequalities.pcert1 : acl2x = 0
-arithmetic-5/support/inequalities.pcert1 : no_pcert = 0
-arithmetic-5/support/inequalities.pcert1 : arithmetic-5/support/inequalities.pcert0
-arithmetic-5/support/inequalities.cert : | arithmetic-5/support/inequalities.pcert1
-
-arithmetic-5/support/mini-theories.pcert0 : no_pcert = 0
-arithmetic-5/support/mini-theories.pcert0 : acl2x = 0
-arithmetic-5/support/mini-theories.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/inequalities.pcert0 \
-     arithmetic-5/support/prefer-times.pcert0 \
-     arithmetic-5/support/expt.pcert0 \
-     arithmetic-5/support/mini-theories.lisp
-arithmetic-5/support/mini-theories.pcert1 : acl2x = 0
-arithmetic-5/support/mini-theories.pcert1 : no_pcert = 0
-arithmetic-5/support/mini-theories.pcert1 : arithmetic-5/support/mini-theories.pcert0
-arithmetic-5/support/mini-theories.cert : | arithmetic-5/support/mini-theories.pcert1
-
-arithmetic-5/support/non-linear.pcert0 : no_pcert = 0
-arithmetic-5/support/non-linear.pcert0 : acl2x = 0
-arithmetic-5/support/non-linear.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/expt.pcert0 \
-     arithmetic-5/support/non-linear.lisp
-arithmetic-5/support/non-linear.pcert1 : acl2x = 0
-arithmetic-5/support/non-linear.pcert1 : no_pcert = 0
-arithmetic-5/support/non-linear.pcert1 : arithmetic-5/support/non-linear.pcert0
-arithmetic-5/support/non-linear.cert : | arithmetic-5/support/non-linear.pcert1
-
-arithmetic-5/support/num-and-denom-helper.pcert0 : no_pcert = 0
-arithmetic-5/support/num-and-denom-helper.pcert0 : acl2x = 0
-arithmetic-5/support/num-and-denom-helper.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/inequalities.pcert0 \
-     arithmetic-5/support/prefer-times.pcert0 \
-     arithmetic-5/support/non-linear.pcert0 \
-     arithmetic-5/support/num-and-denom-helper.lisp
-arithmetic-5/support/num-and-denom-helper.pcert1 : acl2x = 0
-arithmetic-5/support/num-and-denom-helper.pcert1 : no_pcert = 0
-arithmetic-5/support/num-and-denom-helper.pcert1 : arithmetic-5/support/num-and-denom-helper.pcert0
-arithmetic-5/support/num-and-denom-helper.cert : | arithmetic-5/support/num-and-denom-helper.pcert1
-
-arithmetic-5/support/numerator-and-denominator.pcert0 : no_pcert = 0
-arithmetic-5/support/numerator-and-denominator.pcert0 : acl2x = 0
-arithmetic-5/support/numerator-and-denominator.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/inequalities.pcert0 \
-     arithmetic-5/support/prefer-times.pcert0 \
-     arithmetic-5/support/non-linear.pcert0 \
-     arithmetic-5/support/num-and-denom-helper.pcert0 \
-     arithmetic-5/support/numerator-and-denominator.lisp
-arithmetic-5/support/numerator-and-denominator.pcert1 : acl2x = 0
-arithmetic-5/support/numerator-and-denominator.pcert1 : no_pcert = 0
-arithmetic-5/support/numerator-and-denominator.pcert1 : arithmetic-5/support/numerator-and-denominator.pcert0
-arithmetic-5/support/numerator-and-denominator.cert : | arithmetic-5/support/numerator-and-denominator.pcert1
-
-arithmetic-5/support/prefer-times.pcert0 : no_pcert = 0
-arithmetic-5/support/prefer-times.pcert0 : acl2x = 0
-arithmetic-5/support/prefer-times.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/inequalities.pcert0 \
-     arithmetic-5/support/prefer-times.lisp
-arithmetic-5/support/prefer-times.pcert1 : acl2x = 0
-arithmetic-5/support/prefer-times.pcert1 : no_pcert = 0
-arithmetic-5/support/prefer-times.pcert1 : arithmetic-5/support/prefer-times.pcert0
-arithmetic-5/support/prefer-times.cert : | arithmetic-5/support/prefer-times.pcert1
-
-arithmetic-5/support/top.pcert0 : no_pcert = 0
-arithmetic-5/support/top.pcert0 : acl2x = 0
-arithmetic-5/support/top.pcert0 : \
-     arithmetic-5/support/basic-arithmetic.pcert0 \
-     arithmetic-5/support/inequalities.pcert0 \
-     arithmetic-5/support/expt.pcert0 \
-     arithmetic-5/support/prefer-times.pcert0 \
-     arithmetic-5/support/mini-theories.pcert0 \
-     arithmetic-5/support/numerator-and-denominator.pcert0 \
-     arithmetic-5/support/non-linear.pcert0 \
-     arithmetic-5/support/top.lisp
-arithmetic-5/support/top.pcert1 : acl2x = 0
-arithmetic-5/support/top.pcert1 : no_pcert = 0
-arithmetic-5/support/top.pcert1 : arithmetic-5/support/top.pcert0
-arithmetic-5/support/top.cert : | arithmetic-5/support/top.pcert1
-
-arithmetic-5/top.pcert0 : no_pcert = 0
-arithmetic-5/top.pcert0 : acl2x = 0
-arithmetic-5/top.pcert0 : \
-     arithmetic-5/lib/basic-ops/top.pcert0 \
-     arithmetic-5/lib/floor-mod/top.pcert0 \
-     arithmetic-5/top.lisp
-arithmetic-5/top.pcert1 : acl2x = 0
-arithmetic-5/top.pcert1 : no_pcert = 0
-arithmetic-5/top.pcert1 : arithmetic-5/top.pcert0
-arithmetic-5/top.cert : | arithmetic-5/top.pcert1
-
-arithmetic/abs.pcert0 : no_pcert = 0
-arithmetic/abs.pcert0 : acl2x = 0
-arithmetic/abs.pcert0 : \
-     arithmetic/top.pcert0 \
-     arithmetic/abs.lisp
-arithmetic/abs.pcert1 : acl2x = 0
-arithmetic/abs.pcert1 : no_pcert = 0
-arithmetic/abs.pcert1 : arithmetic/abs.pcert0
-arithmetic/abs.cert : | arithmetic/abs.pcert1
-
-arithmetic/binomial.pcert0 : no_pcert = 0
-arithmetic/binomial.pcert0 : acl2x = 0
-arithmetic/binomial.pcert0 : \
-     arithmetic/top.pcert0 \
-     arithmetic/factorial.pcert0 \
-     arithmetic/sumlist.pcert0 \
-     arithmetic/binomial.lisp
-arithmetic/binomial.pcert1 : acl2x = 0
-arithmetic/binomial.pcert1 : no_pcert = 0
-arithmetic/binomial.pcert1 : arithmetic/binomial.pcert0
-arithmetic/binomial.cert : | arithmetic/binomial.pcert1
-
-arithmetic/equalities.pcert0 : no_pcert = 0
-arithmetic/equalities.pcert0 : acl2x = 0
-arithmetic/equalities.pcert0 : \
-     cowles/acl2-crg.pcert0 \
-     arithmetic/equalities.lisp \
-     arithmetic/equalities.acl2
-arithmetic/equalities.pcert1 : acl2x = 0
-arithmetic/equalities.pcert1 : no_pcert = 0
-arithmetic/equalities.pcert1 : arithmetic/equalities.pcert0
-arithmetic/equalities.cert : | arithmetic/equalities.pcert1
-
-arithmetic/factorial.pcert0 : no_pcert = 0
-arithmetic/factorial.pcert0 : acl2x = 0
-arithmetic/factorial.pcert0 : \
-     arithmetic/factorial.lisp
-arithmetic/factorial.pcert1 : acl2x = 0
-arithmetic/factorial.pcert1 : no_pcert = 0
-arithmetic/factorial.pcert1 : arithmetic/factorial.pcert0
-arithmetic/factorial.cert : | arithmetic/factorial.pcert1
-
-arithmetic/idiv.pcert0 : no_pcert = 0
-arithmetic/idiv.pcert0 : acl2x = 0
-arithmetic/idiv.pcert0 : \
-     arithmetic/top.pcert0 \
-     arithmetic/idiv.lisp
-arithmetic/idiv.pcert1 : acl2x = 0
-arithmetic/idiv.pcert1 : no_pcert = 0
-arithmetic/idiv.pcert1 : arithmetic/idiv.pcert0
-arithmetic/idiv.cert : | arithmetic/idiv.pcert1
-
-arithmetic/inequalities.pcert0 : no_pcert = 0
-arithmetic/inequalities.pcert0 : acl2x = 0
-arithmetic/inequalities.pcert0 : \
-     arithmetic/equalities.pcert0 \
-     arithmetic/inequalities.lisp
-arithmetic/inequalities.pcert1 : acl2x = 0
-arithmetic/inequalities.pcert1 : no_pcert = 0
-arithmetic/inequalities.pcert1 : arithmetic/inequalities.pcert0
-arithmetic/inequalities.cert : | arithmetic/inequalities.pcert1
-
-arithmetic/mod-gcd.pcert0 : no_pcert = 0
-arithmetic/mod-gcd.pcert0 : acl2x = 0
-arithmetic/mod-gcd.pcert0 : \
-     arithmetic/inequalities.pcert0 \
-     arithmetic/mod-gcd.lisp
-arithmetic/mod-gcd.pcert1 : acl2x = 0
-arithmetic/mod-gcd.pcert1 : no_pcert = 0
-arithmetic/mod-gcd.pcert1 : arithmetic/mod-gcd.pcert0
-arithmetic/mod-gcd.cert : | arithmetic/mod-gcd.pcert1
-
-arithmetic/nat-listp.pcert0 : no_pcert = 0
-arithmetic/nat-listp.pcert0 : acl2x = 0
-arithmetic/nat-listp.pcert0 : \
-     arithmetic/nat-listp.lisp
-arithmetic/nat-listp.pcert1 : acl2x = 0
-arithmetic/nat-listp.pcert1 : no_pcert = 0
-arithmetic/nat-listp.pcert1 : arithmetic/nat-listp.pcert0
-arithmetic/nat-listp.cert : | arithmetic/nat-listp.pcert1
-
-arithmetic/natp-posp.pcert0 : no_pcert = 0
-arithmetic/natp-posp.pcert0 : acl2x = 0
-arithmetic/natp-posp.pcert0 : \
-     arithmetic/inequalities.pcert0 \
-     arithmetic/natp-posp.lisp
-arithmetic/natp-posp.pcert1 : acl2x = 0
-arithmetic/natp-posp.pcert1 : no_pcert = 0
-arithmetic/natp-posp.pcert1 : arithmetic/natp-posp.pcert0
-arithmetic/natp-posp.cert : | arithmetic/natp-posp.pcert1
-
-arithmetic/rational-listp.pcert0 : no_pcert = 0
-arithmetic/rational-listp.pcert0 : acl2x = 0
-arithmetic/rational-listp.pcert0 : \
-     arithmetic/rational-listp.lisp
-arithmetic/rational-listp.pcert1 : acl2x = 0
-arithmetic/rational-listp.pcert1 : no_pcert = 0
-arithmetic/rational-listp.pcert1 : arithmetic/rational-listp.pcert0
-arithmetic/rational-listp.cert : | arithmetic/rational-listp.pcert1
-
-arithmetic/rationals.pcert0 : no_pcert = 0
-arithmetic/rationals.pcert0 : acl2x = 0
-arithmetic/rationals.pcert0 : \
-     arithmetic/inequalities.pcert0 \
-     arithmetic/inequalities.pcert0 \
-     arithmetic/mod-gcd.pcert0 \
-     arithmetic/rationals.lisp
-arithmetic/rationals.pcert1 : acl2x = 0
-arithmetic/rationals.pcert1 : no_pcert = 0
-arithmetic/rationals.pcert1 : arithmetic/rationals.pcert0
-arithmetic/rationals.cert : | arithmetic/rationals.pcert1
-
-arithmetic/sumlist.pcert0 : no_pcert = 0
-arithmetic/sumlist.pcert0 : acl2x = 0
-arithmetic/sumlist.pcert0 : \
-     arithmetic/sumlist.lisp
-arithmetic/sumlist.pcert1 : acl2x = 0
-arithmetic/sumlist.pcert1 : no_pcert = 0
-arithmetic/sumlist.pcert1 : arithmetic/sumlist.pcert0
-arithmetic/sumlist.cert : | arithmetic/sumlist.pcert1
-
-arithmetic/top-with-meta.pcert0 : no_pcert = 0
-arithmetic/top-with-meta.pcert0 : acl2x = 0
-arithmetic/top-with-meta.pcert0 : \
-     arithmetic/top.pcert0 \
-     meta/meta.pcert0 \
-     arithmetic/top-with-meta.lisp
-arithmetic/top-with-meta.pcert1 : acl2x = 0
-arithmetic/top-with-meta.pcert1 : no_pcert = 0
-arithmetic/top-with-meta.pcert1 : arithmetic/top-with-meta.pcert0
-arithmetic/top-with-meta.cert : | arithmetic/top-with-meta.pcert1
-
-arithmetic/top.pcert0 : no_pcert = 0
-arithmetic/top.pcert0 : acl2x = 0
-arithmetic/top.pcert0 : \
-     arithmetic/equalities.pcert0 \
-     arithmetic/rational-listp.pcert0 \
-     arithmetic/nat-listp.pcert0 \
-     arithmetic/inequalities.pcert0 \
-     arithmetic/natp-posp.pcert0 \
-     arithmetic/rationals.pcert0 \
-     arithmetic/top.lisp
-arithmetic/top.pcert1 : acl2x = 0
-arithmetic/top.pcert1 : no_pcert = 0
-arithmetic/top.pcert1 : arithmetic/top.pcert0
-arithmetic/top.cert : | arithmetic/top.pcert1
-
-bdd/alu-proofs.pcert0 : no_pcert = 0
-bdd/alu-proofs.pcert0 : acl2x = 0
-bdd/alu-proofs.pcert0 : \
-     bdd/alu.pcert0 \
-     bdd/alu-proofs.lisp
-bdd/alu-proofs.pcert1 : acl2x = 0
-bdd/alu-proofs.pcert1 : no_pcert = 0
-bdd/alu-proofs.pcert1 : bdd/alu-proofs.pcert0
-bdd/alu-proofs.cert : | bdd/alu-proofs.pcert1
-
-bdd/alu.pcert0 : no_pcert = 0
-bdd/alu.pcert0 : acl2x = 0
-bdd/alu.pcert0 : \
-     bdd/bdd-primitives.pcert0 \
-     bdd/alu.lisp
-bdd/alu.pcert1 : acl2x = 0
-bdd/alu.pcert1 : no_pcert = 0
-bdd/alu.pcert1 : bdd/alu.pcert0
-bdd/alu.cert : | bdd/alu.pcert1
-
-bdd/bdd-primitives.pcert0 : no_pcert = 0
-bdd/bdd-primitives.pcert0 : acl2x = 0
-bdd/bdd-primitives.pcert0 : \
-     bdd/bdd-primitives.lisp
-bdd/bdd-primitives.pcert1 : acl2x = 0
-bdd/bdd-primitives.pcert1 : no_pcert = 0
-bdd/bdd-primitives.pcert1 : bdd/bdd-primitives.pcert0
-bdd/bdd-primitives.cert : | bdd/bdd-primitives.pcert1
-
-bdd/bool-ops.pcert0 : no_pcert = 0
-bdd/bool-ops.pcert0 : acl2x = 0
-bdd/bool-ops.pcert0 : \
-     bdd/bool-ops.lisp
-bdd/bool-ops.pcert1 : acl2x = 0
-bdd/bool-ops.pcert1 : no_pcert = 0
-bdd/bool-ops.pcert1 : bdd/bool-ops.pcert0
-bdd/bool-ops.cert : | bdd/bool-ops.pcert1
-
-bdd/cbf.pcert0 : no_pcert = 0
-bdd/cbf.pcert0 : acl2x = 0
-bdd/cbf.pcert0 : \
-     bdd/bool-ops.pcert0 \
-     bdd/cbf.lisp
-bdd/cbf.pcert1 : acl2x = 0
-bdd/cbf.pcert1 : no_pcert = 0
-bdd/cbf.pcert1 : bdd/cbf.pcert0
-bdd/cbf.cert : | bdd/cbf.pcert1
-
-bdd/hamming.pcert0 : no_pcert = 0
-bdd/hamming.pcert0 : acl2x = 0
-bdd/hamming.pcert0 : \
-     bdd/bdd-primitives.pcert0 \
-     bdd/hamming.lisp
-bdd/hamming.pcert1 : acl2x = 0
-bdd/hamming.pcert1 : no_pcert = 0
-bdd/hamming.pcert1 : bdd/hamming.pcert0
-bdd/hamming.cert : | bdd/hamming.pcert1
-
-bdd/pg-theory.pcert0 : no_pcert = 0
-bdd/pg-theory.pcert0 : acl2x = 0
-bdd/pg-theory.pcert0 : \
-     bdd/bdd-primitives.pcert0 \
-     bdd/pg-theory.lisp
-bdd/pg-theory.pcert1 : acl2x = 0
-bdd/pg-theory.pcert1 : no_pcert = 0
-bdd/pg-theory.pcert1 : bdd/pg-theory.pcert0
-bdd/pg-theory.cert : | bdd/pg-theory.pcert1
-
-centaur/4v-sexpr/4v-logic.pcert0 : no_pcert = 0
-centaur/4v-sexpr/4v-logic.pcert0 : acl2x = 0
-centaur/4v-sexpr/4v-logic.pcert0 : \
-     centaur/misc/witness-cp.pcert0 \
-     tools/rulesets.pcert0 \
-     xdoc/top.pcert0 \
-     misc/definline.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/4v-logic.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/4v-logic.pcert1 : acl2x = 0
-centaur/4v-sexpr/4v-logic.pcert1 : no_pcert = 0
-centaur/4v-sexpr/4v-logic.pcert1 : centaur/4v-sexpr/4v-logic.pcert0
-centaur/4v-sexpr/4v-logic.cert : | centaur/4v-sexpr/4v-logic.pcert1
-
-centaur/4v-sexpr/bitspecs.pcert0 : no_pcert = 0
-centaur/4v-sexpr/bitspecs.pcert0 : acl2x = 0
-centaur/4v-sexpr/bitspecs.pcert0 : \
-     centaur/4v-sexpr/4v-logic.pcert0 \
-     centaur/4v-sexpr/sexpr-equivs.pcert0 \
-     centaur/misc/vecs-ints.pcert0 \
-     centaur/misc/hons-sets.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     centaur/misc/patterns.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     data-structures/no-duplicates.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/bitspecs.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/bitspecs.pcert1 : acl2x = 0
-centaur/4v-sexpr/bitspecs.pcert1 : no_pcert = 0
-centaur/4v-sexpr/bitspecs.pcert1 : centaur/4v-sexpr/bitspecs.pcert0
-centaur/4v-sexpr/bitspecs.cert : | centaur/4v-sexpr/bitspecs.pcert1
-
-centaur/4v-sexpr/compose-sexpr.pcert0 : no_pcert = 0
-centaur/4v-sexpr/compose-sexpr.pcert0 : acl2x = 0
-centaur/4v-sexpr/compose-sexpr.pcert0 : \
-     centaur/4v-sexpr/bitspecs.pcert0 \
-     centaur/4v-sexpr/sexpr-to-faig.pcert0 \
-     centaur/4v-sexpr/sexpr-advanced.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/compose-sexpr.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/compose-sexpr.pcert1 : acl2x = 0
-centaur/4v-sexpr/compose-sexpr.pcert1 : no_pcert = 0
-centaur/4v-sexpr/compose-sexpr.pcert1 : centaur/4v-sexpr/compose-sexpr.pcert0
-centaur/4v-sexpr/compose-sexpr.cert : | centaur/4v-sexpr/compose-sexpr.pcert1
-
-centaur/4v-sexpr/g-sexpr-eval.pcert0 : no_pcert = 0
-centaur/4v-sexpr/g-sexpr-eval.pcert0 : acl2x = 0
-centaur/4v-sexpr/g-sexpr-eval.pcert0 : \
-     centaur/4v-sexpr/svarmap.pcert0 \
-     centaur/4v-sexpr/sexpr-to-faig.pcert0 \
-     centaur/4v-sexpr/sexpr-equivs.pcert0 \
-     centaur/gl/gl-util.pcert0 \
-     centaur/misc/numlist.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/misc/hons-sets.pcert0 \
-     centaur/aig/eval-restrict.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     std/lists/take.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/4v-sexpr/g-sexpr-eval.lisp \
-     centaur/4v-sexpr/g-sexpr-eval.acl2
-centaur/4v-sexpr/g-sexpr-eval.pcert1 : acl2x = 0
-centaur/4v-sexpr/g-sexpr-eval.pcert1 : no_pcert = 0
-centaur/4v-sexpr/g-sexpr-eval.pcert1 : centaur/4v-sexpr/g-sexpr-eval.pcert0
-centaur/4v-sexpr/g-sexpr-eval.cert : | centaur/4v-sexpr/g-sexpr-eval.pcert1
-
-centaur/4v-sexpr/nsexprs.pcert0 : no_pcert = 0
-centaur/4v-sexpr/nsexprs.pcert0 : acl2x = 0
-centaur/4v-sexpr/nsexprs.pcert0 : \
-     centaur/4v-sexpr/sexpr-vars.pcert0 \
-     centaur/bitops/bitsets.pcert0 \
-     centaur/bitops/sbitsets.pcert0 \
-     arithmetic/nat-listp.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/nsexprs.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/nsexprs.pcert1 : acl2x = 0
-centaur/4v-sexpr/nsexprs.pcert1 : no_pcert = 0
-centaur/4v-sexpr/nsexprs.pcert1 : centaur/4v-sexpr/nsexprs.pcert0
-centaur/4v-sexpr/nsexprs.cert : | centaur/4v-sexpr/nsexprs.pcert1
-
-centaur/4v-sexpr/onehot-rewrite.pcert0 : no_pcert = 0
-centaur/4v-sexpr/onehot-rewrite.pcert0 : acl2x = 0
-centaur/4v-sexpr/onehot-rewrite.pcert0 : \
-     centaur/4v-sexpr/sexpr-rewrites.pcert0 \
-     centaur/4v-sexpr/sexpr-building.pcert0 \
-     cutil/defprojection.pcert0 \
-     centaur/misc/filter-alist.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     arithmetic/top.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/onehot-rewrite.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/onehot-rewrite.pcert1 : acl2x = 0
-centaur/4v-sexpr/onehot-rewrite.pcert1 : no_pcert = 0
-centaur/4v-sexpr/onehot-rewrite.pcert1 : centaur/4v-sexpr/onehot-rewrite.pcert0
-centaur/4v-sexpr/onehot-rewrite.cert : | centaur/4v-sexpr/onehot-rewrite.pcert1
-
-centaur/4v-sexpr/portcullis.pcert0 : no_pcert = 0
-centaur/4v-sexpr/portcullis.pcert0 : acl2x = 0
-centaur/4v-sexpr/portcullis.pcert0 : \
-     centaur/4v-sexpr/portcullis.lisp \
-     centaur/4v-sexpr/portcullis.acl2 \
-     tools/flag-package.lsp \
-     xdoc/package.lsp \
-     centaur/vl/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-centaur/4v-sexpr/portcullis.pcert1 : acl2x = 0
-centaur/4v-sexpr/portcullis.pcert1 : no_pcert = 0
-centaur/4v-sexpr/portcullis.pcert1 : centaur/4v-sexpr/portcullis.pcert0
-centaur/4v-sexpr/portcullis.cert : | centaur/4v-sexpr/portcullis.pcert1
-
-centaur/4v-sexpr/sexpr-3v.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-3v.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-3v.pcert0 : \
-     centaur/4v-sexpr/sexpr-eval.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-3v.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-3v.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-3v.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-3v.pcert1 : centaur/4v-sexpr/sexpr-3v.pcert0
-centaur/4v-sexpr/sexpr-3v.cert : | centaur/4v-sexpr/sexpr-3v.pcert1
-
-centaur/4v-sexpr/sexpr-advanced.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-advanced.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-advanced.pcert0 : \
-     centaur/4v-sexpr/sexpr-vars.pcert0 \
-     centaur/4v-sexpr/sexpr-equivs.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-advanced.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-advanced.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-advanced.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-advanced.pcert1 : centaur/4v-sexpr/sexpr-advanced.pcert0
-centaur/4v-sexpr/sexpr-advanced.cert : | centaur/4v-sexpr/sexpr-advanced.pcert1
-
-centaur/4v-sexpr/sexpr-building.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-building.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-building.pcert0 : \
-     centaur/4v-sexpr/sexpr-eval.pcert0 \
-     centaur/4v-sexpr/sexpr-vars.pcert0 \
-     centaur/4v-sexpr/sexpr-3v.pcert0 \
-     cutil/defprojection.pcert0 \
-     misc/definline.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-building.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-building.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-building.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-building.pcert1 : centaur/4v-sexpr/sexpr-building.pcert0
-centaur/4v-sexpr/sexpr-building.cert : | centaur/4v-sexpr/sexpr-building.pcert1
-
-centaur/4v-sexpr/sexpr-equivs.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-equivs.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-equivs.pcert0 : \
-     centaur/4v-sexpr/sexpr-eval.pcert0 \
-     centaur/misc/universal-equiv.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-equivs.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-equivs.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-equivs.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-equivs.pcert1 : centaur/4v-sexpr/sexpr-equivs.pcert0
-centaur/4v-sexpr/sexpr-equivs.cert : | centaur/4v-sexpr/sexpr-equivs.pcert1
-
-centaur/4v-sexpr/sexpr-eval.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-eval.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-eval.pcert0 : \
-     centaur/4v-sexpr/4v-logic.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-eval.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-eval.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-eval.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-eval.pcert1 : centaur/4v-sexpr/sexpr-eval.pcert0
-centaur/4v-sexpr/sexpr-eval.cert : | centaur/4v-sexpr/sexpr-eval.pcert1
-
-centaur/4v-sexpr/sexpr-fixpoint-correct.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint-correct.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-correct.pcert0 : \
-     centaur/4v-sexpr/sexpr-fixpoint-spec.pcert0 \
-     centaur/misc/hons-sets.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-correct.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-fixpoint-correct.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-correct.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint-correct.pcert1 : centaur/4v-sexpr/sexpr-fixpoint-correct.pcert0
-centaur/4v-sexpr/sexpr-fixpoint-correct.cert : | centaur/4v-sexpr/sexpr-fixpoint-correct.pcert1
-
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert0 : \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-rewriting.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert1 : centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert0
-centaur/4v-sexpr/sexpr-fixpoint-rewriting.cert : | centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert1
-
-centaur/4v-sexpr/sexpr-fixpoint-spec.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint-spec.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-spec.pcert0 : \
-     centaur/4v-sexpr/sexpr-fixpoint.pcert0 \
-     centaur/4v-sexpr/sexpr-advanced.pcert0 \
-     misc/bash.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-spec.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-fixpoint-spec.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-spec.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint-spec.pcert1 : centaur/4v-sexpr/sexpr-fixpoint-spec.pcert0
-centaur/4v-sexpr/sexpr-fixpoint-spec.cert : | centaur/4v-sexpr/sexpr-fixpoint-spec.pcert1
-
-centaur/4v-sexpr/sexpr-fixpoint-top.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint-top.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-top.pcert0 : \
-     centaur/4v-sexpr/sexpr-fixpoint.pcert0 \
-     centaur/4v-sexpr/sexpr-equivs.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-correct.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-top.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-fixpoint-top.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint-top.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint-top.pcert1 : centaur/4v-sexpr/sexpr-fixpoint-top.pcert0
-centaur/4v-sexpr/sexpr-fixpoint-top.cert : | centaur/4v-sexpr/sexpr-fixpoint-top.pcert1
-
-centaur/4v-sexpr/sexpr-fixpoint.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint.pcert0 : \
-     centaur/4v-sexpr/nsexprs.pcert0 \
-     centaur/4v-sexpr/sexpr-rewrites.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/misc/sneaky-load.pcert0 \
-     centaur/misc/nat-list-duplicates.pcert0 \
-     centaur/misc/tuplep.pcert0 \
-     centaur/misc/dfs-measure.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-fixpoint.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-fixpoint.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-fixpoint.pcert1 : centaur/4v-sexpr/sexpr-fixpoint.pcert0
-centaur/4v-sexpr/sexpr-fixpoint.cert : | centaur/4v-sexpr/sexpr-fixpoint.pcert1
-
-centaur/4v-sexpr/sexpr-loop-debug.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-loop-debug.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-loop-debug.pcert0 : \
-     centaur/4v-sexpr/sexpr-fixpoint.pcert0 \
-     centaur/vl/toe/toe-emodwire.pcert0 \
-     centaur/vl/util/cw-unformatted.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     arithmetic-3/top.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-loop-debug.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-loop-debug.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-loop-debug.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-loop-debug.pcert1 : centaur/4v-sexpr/sexpr-loop-debug.pcert0
-centaur/4v-sexpr/sexpr-loop-debug.cert : | centaur/4v-sexpr/sexpr-loop-debug.pcert1
-
-centaur/4v-sexpr/sexpr-rewrites.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-rewrites.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-rewrites.pcert0 : \
-     centaur/aig/base.pcert0 \
-     centaur/4v-sexpr/sexpr-advanced.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/4v-sexpr/sexpr-vars-1pass.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-rewrites.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-rewrites.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-rewrites.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-rewrites.pcert1 : centaur/4v-sexpr/sexpr-rewrites.pcert0
-centaur/4v-sexpr/sexpr-rewrites.cert : | centaur/4v-sexpr/sexpr-rewrites.pcert1
-
-centaur/4v-sexpr/sexpr-to-faig.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-to-faig.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-to-faig.pcert0 : \
-     centaur/4v-sexpr/sexpr-eval.pcert0 \
-     centaur/4v-sexpr/sexpr-3v.pcert0 \
-     centaur/aig/three-four.pcert0 \
-     centaur/aig/aig-equivs.pcert0 \
-     centaur/misc/tuplep.pcert0 \
-     centaur/aig/eval-restrict.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-to-faig.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-to-faig.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-to-faig.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-to-faig.pcert1 : centaur/4v-sexpr/sexpr-to-faig.pcert0
-centaur/4v-sexpr/sexpr-to-faig.cert : | centaur/4v-sexpr/sexpr-to-faig.pcert1
-
-centaur/4v-sexpr/sexpr-vars-1pass.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-vars-1pass.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-vars-1pass.pcert0 : \
-     centaur/4v-sexpr/sexpr-vars.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-vars-1pass.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-vars-1pass.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-vars-1pass.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-vars-1pass.pcert1 : centaur/4v-sexpr/sexpr-vars-1pass.pcert0
-centaur/4v-sexpr/sexpr-vars-1pass.cert : | centaur/4v-sexpr/sexpr-vars-1pass.pcert1
-
-centaur/4v-sexpr/sexpr-vars.pcert0 : no_pcert = 0
-centaur/4v-sexpr/sexpr-vars.pcert0 : acl2x = 0
-centaur/4v-sexpr/sexpr-vars.pcert0 : \
-     centaur/4v-sexpr/sexpr-eval.pcert0 \
-     centaur/misc/hons-alphorder-merge.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/sexpr-vars.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/sexpr-vars.pcert1 : acl2x = 0
-centaur/4v-sexpr/sexpr-vars.pcert1 : no_pcert = 0
-centaur/4v-sexpr/sexpr-vars.pcert1 : centaur/4v-sexpr/sexpr-vars.pcert0
-centaur/4v-sexpr/sexpr-vars.cert : | centaur/4v-sexpr/sexpr-vars.pcert1
-
-centaur/4v-sexpr/svarmap.pcert0 : no_pcert = 0
-centaur/4v-sexpr/svarmap.pcert0 : acl2x = 0
-centaur/4v-sexpr/svarmap.pcert0 : \
-     centaur/aig/base.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     centaur/misc/hons-sets.pcert0 \
-     data-structures/no-duplicates.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/svarmap.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/svarmap.pcert1 : acl2x = 0
-centaur/4v-sexpr/svarmap.pcert1 : no_pcert = 0
-centaur/4v-sexpr/svarmap.pcert1 : centaur/4v-sexpr/svarmap.pcert0
-centaur/4v-sexpr/svarmap.cert : | centaur/4v-sexpr/svarmap.pcert1
-
-centaur/4v-sexpr/top.pcert0 : no_pcert = 0
-centaur/4v-sexpr/top.pcert0 : acl2x = 0
-centaur/4v-sexpr/top.pcert0 : \
-     centaur/4v-sexpr/4v-logic.pcert0 \
-     centaur/4v-sexpr/bitspecs.pcert0 \
-     centaur/4v-sexpr/compose-sexpr.pcert0 \
-     centaur/4v-sexpr/g-sexpr-eval.pcert0 \
-     centaur/4v-sexpr/nsexprs.pcert0 \
-     centaur/4v-sexpr/onehot-rewrite.pcert0 \
-     centaur/4v-sexpr/sexpr-advanced.pcert0 \
-     centaur/4v-sexpr/sexpr-building.pcert0 \
-     centaur/4v-sexpr/sexpr-equivs.pcert0 \
-     centaur/4v-sexpr/sexpr-eval.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-correct.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-rewriting.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-spec.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-top.pcert0 \
-     centaur/4v-sexpr/sexpr-loop-debug.pcert0 \
-     centaur/4v-sexpr/sexpr-rewrites.pcert0 \
-     centaur/4v-sexpr/sexpr-to-faig.pcert0 \
-     centaur/4v-sexpr/sexpr-vars.pcert0 \
-     centaur/4v-sexpr/svarmap.pcert0 \
-     centaur/4v-sexpr/portcullis.pcert0 \
-     centaur/4v-sexpr/top.lisp \
-     centaur/4v-sexpr/cert.acl2
-centaur/4v-sexpr/top.pcert1 : acl2x = 0
-centaur/4v-sexpr/top.pcert1 : no_pcert = 0
-centaur/4v-sexpr/top.pcert1 : centaur/4v-sexpr/top.pcert0
-centaur/4v-sexpr/top.cert : | centaur/4v-sexpr/top.pcert1
-
-centaur/aig/aig-equivs.pcert0 : no_pcert = 0
-centaur/aig/aig-equivs.pcert0 : acl2x = 0
-centaur/aig/aig-equivs.pcert0 : \
-     centaur/aig/base.pcert0 \
-     centaur/misc/witness-cp.pcert0 \
-     centaur/misc/universal-equiv.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/aig-equivs.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/aig-equivs.pcert1 : acl2x = 0
-centaur/aig/aig-equivs.pcert1 : no_pcert = 0
-centaur/aig/aig-equivs.pcert1 : centaur/aig/aig-equivs.pcert0
-centaur/aig/aig-equivs.cert : | centaur/aig/aig-equivs.pcert1
-
-centaur/aig/aig-vars-ext.pcert0 : no_pcert = 0
-centaur/aig/aig-vars-ext.pcert0 : acl2x = 0
-centaur/aig/aig-vars-ext.pcert0 : \
-     defsort/defsort.pcert0 \
-     centaur/aig/base.pcert0 \
-     tools/bstar.pcert0 \
-     centaur/bitops/sbitsets.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/misc/alist-defs.pcert0 \
-     centaur/misc/numlist.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/aig-vars-ext.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/aig-vars-ext.pcert1 : acl2x = 0
-centaur/aig/aig-vars-ext.pcert1 : no_pcert = 0
-centaur/aig/aig-vars-ext.pcert1 : centaur/aig/aig-vars-ext.pcert0
-centaur/aig/aig-vars-ext.cert : | centaur/aig/aig-vars-ext.pcert1
-
-centaur/aig/aig-vars.pcert0 : no_pcert = 0
-centaur/aig/aig-vars.pcert0 : acl2x = 0
-centaur/aig/aig-vars.pcert0 : \
-     centaur/aig/base.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     centaur/misc/alist-equiv.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/aig-vars.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/aig-vars.pcert1 : acl2x = 0
-centaur/aig/aig-vars.pcert1 : no_pcert = 0
-centaur/aig/aig-vars.pcert1 : centaur/aig/aig-vars.pcert0
-centaur/aig/aig-vars.cert : | centaur/aig/aig-vars.pcert1
-
-centaur/aig/aiger.pcert0 : no_pcert = 0
-centaur/aig/aiger.pcert0 : acl2x = 0
-centaur/aig/aiger.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     centaur/aig/aig-vars-ext.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/misc/sneaky-load.pcert0 \
-     centaur/misc/numlist.pcert0 \
-     tools/defmacfun.pcert0 \
-     misc/definline.pcert0 \
-     system/io.pcert0 \
-     arithmetic/nat-listp.pcert0 \
-     clause-processors/instantiate.pcert0 \
-     centaur/bitops/ihsext-basics.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     cutil/defmvtypes.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/aiger.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/aiger.pcert1 : acl2x = 0
-centaur/aig/aiger.pcert1 : no_pcert = 0
-centaur/aig/aiger.pcert1 : centaur/aig/aiger.pcert0
-centaur/aig/aiger.cert : | centaur/aig/aiger.pcert1
-
-centaur/aig/base.pcert0 : no_pcert = 0
-centaur/aig/base.pcert0 : acl2x = 0
-centaur/aig/base.pcert0 : \
-     cutil/defsection.pcert0 \
-     centaur/misc/hons-alphorder-merge.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/base.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/base.pcert1 : acl2x = 0
-centaur/aig/base.pcert1 : no_pcert = 0
-centaur/aig/base.pcert1 : centaur/aig/base.pcert0
-centaur/aig/base.cert : | centaur/aig/base.pcert1
-
-centaur/aig/bddify-correct.pcert0 : no_pcert = 0
-centaur/aig/bddify-correct.pcert0 : acl2x = 0
-centaur/aig/bddify-correct.pcert0 : \
-     centaur/aig/bddify.pcert0 \
-     centaur/ubdds/param.pcert0 \
-     centaur/ubdds/lite.pcert0 \
-     centaur/misc/suffixp.pcert0 \
-     tools/with-quoted-forms.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/bddify-correct.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/bddify-correct.pcert1 : acl2x = 0
-centaur/aig/bddify-correct.pcert1 : no_pcert = 0
-centaur/aig/bddify-correct.pcert1 : centaur/aig/bddify-correct.pcert0
-centaur/aig/bddify-correct.cert : | centaur/aig/bddify-correct.pcert1
-
-centaur/aig/bddify.pcert0 : no_pcert = 0
-centaur/aig/bddify.pcert0 : acl2x = 0
-centaur/aig/bddify.pcert0 : \
-     centaur/aig/base.pcert0 \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     misc/hons-help2.pcert0 \
-     centaur/ubdds/extra-operations.pcert0 \
-     centaur/misc/memory-mgmt-logic.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/bddify.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/bddify.pcert1 : acl2x = 0
-centaur/aig/bddify.pcert1 : no_pcert = 0
-centaur/aig/bddify.pcert1 : centaur/aig/bddify.pcert0
-centaur/aig/bddify.cert : | centaur/aig/bddify.pcert1
-
-centaur/aig/eval-restrict.pcert0 : no_pcert = 0
-centaur/aig/eval-restrict.pcert0 : acl2x = 0
-centaur/aig/eval-restrict.pcert0 : \
-     centaur/aig/base.pcert0 \
-     centaur/aig/aig-equivs.pcert0 \
-     centaur/aig/three-four.pcert0 \
-     centaur/aig/aig-vars.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/eval-restrict.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/eval-restrict.pcert1 : acl2x = 0
-centaur/aig/eval-restrict.pcert1 : no_pcert = 0
-centaur/aig/eval-restrict.pcert1 : centaur/aig/eval-restrict.pcert0
-centaur/aig/eval-restrict.cert : | centaur/aig/eval-restrict.pcert1
-
-centaur/aig/g-aig-eval.pcert0 : no_pcert = 0
-centaur/aig/g-aig-eval.pcert0 : acl2x = 0
-centaur/aig/g-aig-eval.pcert0 : \
-     centaur/aig/bddify-correct.pcert0 \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/gify.pcert0 \
-     centaur/gl/gify-thms.pcert0 \
-     centaur/gl/eval-f-i-cp.pcert0 \
-     centaur/gl/bvecs.pcert0 \
-     centaur/gl/gify-clause-proc.pcert0 \
-     centaur/gl/general-object-thms.pcert0 \
-     centaur/aig/eval-restrict.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/aig/g-aig-eval.lisp \
-     centaur/aig/g-aig-eval.acl2
-centaur/aig/g-aig-eval.pcert1 : acl2x = 0
-centaur/aig/g-aig-eval.pcert1 : no_pcert = 0
-centaur/aig/g-aig-eval.pcert1 : centaur/aig/g-aig-eval.pcert0
-centaur/aig/g-aig-eval.cert : | centaur/aig/g-aig-eval.pcert1
-
-centaur/aig/induction.pcert0 : no_pcert = 0
-centaur/aig/induction.pcert0 : acl2x = 0
-centaur/aig/induction.pcert0 : \
-     centaur/aig/eval-restrict.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/induction.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/induction.pcert1 : acl2x = 0
-centaur/aig/induction.pcert1 : no_pcert = 0
-centaur/aig/induction.pcert1 : centaur/aig/induction.pcert0
-centaur/aig/induction.cert : | centaur/aig/induction.pcert1
-
-centaur/aig/misc.pcert0 : no_pcert = 0
-centaur/aig/misc.pcert0 : acl2x = 0
-centaur/aig/misc.pcert0 : \
-     centaur/aig/base.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     tools/mv-nth.pcert0 \
-     misc/gentle.pcert0 \
-     misc/hons-help.pcert0 \
-     centaur/aig/eval-restrict.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/misc.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/misc.pcert1 : acl2x = 0
-centaur/aig/misc.pcert1 : no_pcert = 0
-centaur/aig/misc.pcert1 : centaur/aig/misc.pcert0
-centaur/aig/misc.cert : | centaur/aig/misc.pcert1
-
-centaur/aig/portcullis.pcert0 : no_pcert = 0
-centaur/aig/portcullis.pcert0 : acl2x = 0
-centaur/aig/portcullis.pcert0 : \
-     centaur/aig/portcullis.lisp \
-     centaur/aig/portcullis.acl2 \
-     centaur/vl/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     centaur/vl/other-packages.lsp \
-     data-structures/define-u-package.lsp \
-     tools/flag-package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     cowles/packages.lsp \
-     centaur/aig/fsm-pkg.lsp
-centaur/aig/portcullis.pcert1 : acl2x = 0
-centaur/aig/portcullis.pcert1 : no_pcert = 0
-centaur/aig/portcullis.pcert1 : centaur/aig/portcullis.pcert0
-centaur/aig/portcullis.cert : | centaur/aig/portcullis.pcert1
-
-centaur/aig/three-four.pcert0 : no_pcert = 0
-centaur/aig/three-four.pcert0 : acl2x = 0
-centaur/aig/three-four.pcert0 : \
-     centaur/aig/base.pcert0 \
-     tools/bstar.pcert0 \
-     tools/rulesets.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/three-four.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/three-four.pcert1 : acl2x = 0
-centaur/aig/three-four.pcert1 : no_pcert = 0
-centaur/aig/three-four.pcert1 : centaur/aig/three-four.pcert0
-centaur/aig/three-four.cert : | centaur/aig/three-four.pcert1
-
-centaur/aig/vuaig.pcert0 : no_pcert = 0
-centaur/aig/vuaig.pcert0 : acl2x = 0
-centaur/aig/vuaig.pcert0 : \
-     centaur/aig/three-four.pcert0 \
-     centaur/aig/portcullis.pcert0 \
-     centaur/aig/vuaig.lisp \
-     centaur/aig/cert.acl2
-centaur/aig/vuaig.pcert1 : acl2x = 0
-centaur/aig/vuaig.pcert1 : no_pcert = 0
-centaur/aig/vuaig.pcert1 : centaur/aig/vuaig.pcert0
-centaur/aig/vuaig.cert : | centaur/aig/vuaig.pcert1
-
-centaur/aig/witness.pcert0 : no_pcert = 0
-centaur/aig/witness.pcert0 : acl2x = 0
-centaur/aig/witness.pcert0 : \
-     misc/hons-help2.pcert0 \
-     centaur/aig/base.pcert0 \
-     clause-processors/term-patterns.pcert0 \
-     clause-processors/join-thms.pcert0 \
-     tools/flag.pcert0 \
-     centaur/aig/witness.lisp \
-     centaur/aig/witness.acl2 \
-     tools/flag-package.lsp
-centaur/aig/witness.pcert1 : acl2x = 0
-centaur/aig/witness.pcert1 : no_pcert = 0
-centaur/aig/witness.pcert1 : centaur/aig/witness.pcert0
-centaur/aig/witness.cert : | centaur/aig/witness.pcert1
-
-centaur/bitops/bits-between.pcert0 : no_pcert = 0
-centaur/bitops/bits-between.pcert0 : acl2x = 0
-centaur/bitops/bits-between.pcert0 : \
-     cutil/defsection.pcert0 \
-     tools/bstar.pcert0 \
-     finite-set-theory/osets/sets.pcert0 \
-     centaur/bitops/ihs-extensions.pcert0 \
-     std/lists/rev.pcert0 \
-     std/lists/append.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/bits-between.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/bits-between.pcert1 : acl2x = 0
-centaur/bitops/bits-between.pcert1 : no_pcert = 0
-centaur/bitops/bits-between.pcert1 : centaur/bitops/bits-between.pcert0
-centaur/bitops/bits-between.cert : | centaur/bitops/bits-between.pcert1
-
-centaur/bitops/bitsets-opt.pcert0 : no_pcert = 0
-centaur/bitops/bitsets-opt.pcert0 : acl2x = 0
-centaur/bitops/bitsets-opt.pcert0 : \
-     centaur/bitops/bitsets.pcert0 \
-     tools/include-raw.pcert0 \
-     make-event/assert.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/bitsets-opt.lisp \
-     centaur/bitops/cert.acl2 \
-     centaur/bitops/bitsets-opt-raw.lsp
-centaur/bitops/bitsets-opt.pcert1 : acl2x = 0
-centaur/bitops/bitsets-opt.pcert1 : no_pcert = 0
-centaur/bitops/bitsets-opt.pcert1 : centaur/bitops/bitsets-opt.pcert0
-centaur/bitops/bitsets-opt.cert : | centaur/bitops/bitsets-opt.pcert1
-
-centaur/bitops/bitsets.pcert0 : no_pcert = 0
-centaur/bitops/bitsets.pcert0 : acl2x = 0
-centaur/bitops/bitsets.pcert0 : \
-     centaur/bitops/bits-between.pcert0 \
-     centaur/bitops/equal-by-logbitp.pcert0 \
-     misc/definline.pcert0 \
-     centaur/misc/witness-cp.pcert0 \
-     centaur/bitops/ihs-extensions.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/bitsets.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/bitsets.pcert1 : acl2x = 0
-centaur/bitops/bitsets.pcert1 : no_pcert = 0
-centaur/bitops/bitsets.pcert1 : centaur/bitops/bitsets.pcert0
-centaur/bitops/bitsets.cert : | centaur/bitops/bitsets.pcert1
-
-centaur/bitops/congruences.pcert0 : no_pcert = 0
-centaur/bitops/congruences.pcert0 : acl2x = 0
-centaur/bitops/congruences.pcert0 : \
-     tools/rulesets.pcert0 \
-     centaur/misc/context-rw.pcert0 \
-     ihs/basic-definitions.pcert0 \
-     centaur/bitops/ihsext-basics.pcert0 \
-     centaur/bitops/ihs-extensions.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/bitops/equal-by-logbitp.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/congruences.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/congruences.pcert1 : acl2x = 0
-centaur/bitops/congruences.pcert1 : no_pcert = 0
-centaur/bitops/congruences.pcert1 : centaur/bitops/congruences.pcert0
-centaur/bitops/congruences.cert : | centaur/bitops/congruences.pcert1
-
-centaur/bitops/equal-by-logbitp.pcert0 : no_pcert = 0
-centaur/bitops/equal-by-logbitp.pcert0 : acl2x = 0
-centaur/bitops/equal-by-logbitp.pcert0 : \
-     cutil/wizard.pcert0 \
-     centaur/bitops/integer-length.pcert0 \
-     centaur/bitops/ihsext-basics.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/equal-by-logbitp.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/equal-by-logbitp.pcert1 : acl2x = 0
-centaur/bitops/equal-by-logbitp.pcert1 : no_pcert = 0
-centaur/bitops/equal-by-logbitp.pcert1 : centaur/bitops/equal-by-logbitp.pcert0
-centaur/bitops/equal-by-logbitp.cert : | centaur/bitops/equal-by-logbitp.pcert1
-
-centaur/bitops/extra-defs.pcert0 : no_pcert = 0
-centaur/bitops/extra-defs.pcert0 : acl2x = 0
-centaur/bitops/extra-defs.pcert0 : \
-     centaur/bitops/ihsext-basics.pcert0 \
-     arithmetic/top.pcert0 \
-     centaur/misc/arith-equivs.pcert0 \
-     ihs/logops-definitions.pcert0 \
-     xdoc/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/extra-defs.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/extra-defs.pcert1 : acl2x = 0
-centaur/bitops/extra-defs.pcert1 : no_pcert = 0
-centaur/bitops/extra-defs.pcert1 : centaur/bitops/extra-defs.pcert0
-centaur/bitops/extra-defs.cert : | centaur/bitops/extra-defs.pcert1
-
-centaur/bitops/ihs-extensions.pcert0 : no_pcert = 0
-centaur/bitops/ihs-extensions.pcert0 : acl2x = 0
-centaur/bitops/ihs-extensions.pcert0 : \
-     centaur/bitops/ihsext-basics.pcert0 \
-     centaur/bitops/integer-length.pcert0 \
-     centaur/bitops/equal-by-logbitp.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/ihs-extensions.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/ihs-extensions.pcert1 : acl2x = 0
-centaur/bitops/ihs-extensions.pcert1 : no_pcert = 0
-centaur/bitops/ihs-extensions.pcert1 : centaur/bitops/ihs-extensions.pcert0
-centaur/bitops/ihs-extensions.cert : | centaur/bitops/ihs-extensions.pcert1
-
-centaur/bitops/ihsext-basics.pcert0 : no_pcert = 0
-centaur/bitops/ihsext-basics.pcert0 : acl2x = 0
-centaur/bitops/ihsext-basics.pcert0 : \
-     centaur/misc/arith-equivs.pcert0 \
-     xdoc/top.pcert0 \
-     tools/defredundant.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/ihsext-basics.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/ihsext-basics.pcert1 : acl2x = 0
-centaur/bitops/ihsext-basics.pcert1 : no_pcert = 0
-centaur/bitops/ihsext-basics.pcert1 : centaur/bitops/ihsext-basics.pcert0
-centaur/bitops/ihsext-basics.cert : | centaur/bitops/ihsext-basics.pcert1
-
-centaur/bitops/install-bit.pcert0 : no_pcert = 0
-centaur/bitops/install-bit.pcert0 : acl2x = 0
-centaur/bitops/install-bit.pcert0 : \
-     cutil/defsection.pcert0 \
-     centaur/misc/arith-equivs.pcert0 \
-     centaur/misc/mfc-utils.pcert0 \
-     centaur/misc/introduce-var.pcert0 \
-     centaur/bitops/equal-by-logbitp.pcert0 \
-     centaur/bitops/ihsext-basics.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/install-bit.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/install-bit.pcert1 : acl2x = 0
-centaur/bitops/install-bit.pcert1 : no_pcert = 0
-centaur/bitops/install-bit.pcert1 : centaur/bitops/install-bit.pcert0
-centaur/bitops/install-bit.cert : | centaur/bitops/install-bit.pcert1
-
-centaur/bitops/integer-length.pcert0 : no_pcert = 0
-centaur/bitops/integer-length.pcert0 : acl2x = 0
-centaur/bitops/integer-length.pcert0 : \
-     cutil/defsection.pcert0 \
-     ihs/logops-definitions.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/bitops/ihsext-basics.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/integer-length.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/integer-length.pcert1 : acl2x = 0
-centaur/bitops/integer-length.pcert1 : no_pcert = 0
-centaur/bitops/integer-length.pcert1 : centaur/bitops/integer-length.pcert0
-centaur/bitops/integer-length.cert : | centaur/bitops/integer-length.pcert1
-
-centaur/bitops/part-select.pcert0 : no_pcert = 0
-centaur/bitops/part-select.pcert0 : acl2x = 0
-centaur/bitops/part-select.pcert0 : \
-     ihs/logops-definitions.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/bitops/ihsext-basics.pcert0 \
-     misc/assert.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/part-select.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/part-select.pcert1 : acl2x = 0
-centaur/bitops/part-select.pcert1 : no_pcert = 0
-centaur/bitops/part-select.pcert1 : centaur/bitops/part-select.pcert0
-centaur/bitops/part-select.cert : | centaur/bitops/part-select.pcert1
-
-centaur/bitops/rotate.pcert0 : no_pcert = 0
-centaur/bitops/rotate.pcert0 : acl2x = 0
-centaur/bitops/rotate.pcert0 : \
-     xdoc/top.pcert0 \
-     tools/bstar.pcert0 \
-     ihs/logops-definitions.pcert0 \
-     centaur/misc/arith-equivs.pcert0 \
-     centaur/bitops/ihsext-basics.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/bitops/equal-by-logbitp.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/rotate.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/rotate.pcert1 : acl2x = 0
-centaur/bitops/rotate.pcert1 : no_pcert = 0
-centaur/bitops/rotate.pcert1 : centaur/bitops/rotate.pcert0
-centaur/bitops/rotate.cert : | centaur/bitops/rotate.pcert1
-
-centaur/bitops/sbitsets.pcert0 : no_pcert = 0
-centaur/bitops/sbitsets.pcert0 : acl2x = 0
-centaur/bitops/sbitsets.pcert0 : \
-     centaur/bitops/bits-between.pcert0 \
-     misc/definline.pcert0 \
-     centaur/bitops/equal-by-logbitp.pcert0 \
-     centaur/bitops/ihs-extensions.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     std/lists/revappend.pcert0 \
-     std/lists/rev.pcert0 \
-     std/lists/append.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/sbitsets.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/sbitsets.pcert1 : acl2x = 0
-centaur/bitops/sbitsets.pcert1 : no_pcert = 0
-centaur/bitops/sbitsets.pcert1 : centaur/bitops/sbitsets.pcert0
-centaur/bitops/sbitsets.cert : | centaur/bitops/sbitsets.pcert1
-
-centaur/bitops/sign-extend.pcert0 : no_pcert = 0
-centaur/bitops/sign-extend.pcert0 : acl2x = 0
-centaur/bitops/sign-extend.pcert0 : \
-     xdoc/top.pcert0 \
-     misc/definline.pcert0 \
-     tools/bstar.pcert0 \
-     ihs/logops-definitions.pcert0 \
-     centaur/bitops/ihs-extensions.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/sign-extend.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/sign-extend.pcert1 : acl2x = 0
-centaur/bitops/sign-extend.pcert1 : no_pcert = 0
-centaur/bitops/sign-extend.pcert1 : centaur/bitops/sign-extend.pcert0
-centaur/bitops/sign-extend.cert : | centaur/bitops/sign-extend.pcert1
-
-centaur/bitops/top.pcert0 : no_pcert = 0
-centaur/bitops/top.pcert0 : acl2x = 0
-centaur/bitops/top.pcert0 : \
-     centaur/bitops/bits-between.pcert0 \
-     centaur/bitops/bitsets.pcert0 \
-     centaur/bitops/bitsets-opt.pcert0 \
-     centaur/bitops/equal-by-logbitp.pcert0 \
-     centaur/bitops/ihs-extensions.pcert0 \
-     centaur/bitops/integer-length.pcert0 \
-     centaur/bitops/sbitsets.pcert0 \
-     centaur/bitops/part-select.pcert0 \
-     centaur/bitops/extra-defs.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     cutil/portcullis.pcert0 \
-     centaur/bitops/top.lisp \
-     centaur/bitops/cert.acl2
-centaur/bitops/top.pcert1 : acl2x = 0
-centaur/bitops/top.pcert1 : no_pcert = 0
-centaur/bitops/top.pcert1 : centaur/bitops/top.pcert0
-centaur/bitops/top.cert : | centaur/bitops/top.pcert1
-
-centaur/bridge/portcullis.pcert0 : no_pcert = 0
-centaur/bridge/portcullis.pcert0 : acl2x = 0
-centaur/bridge/portcullis.pcert0 : \
-     str/portcullis.pcert0 \
-     xdoc/portcullis.pcert0 \
-     centaur/bridge/portcullis.lisp \
-     centaur/bridge/portcullis.acl2 \
-     centaur/bridge/package.lsp \
-     tools/flag-package.lsp
-centaur/bridge/portcullis.pcert1 : acl2x = 0
-centaur/bridge/portcullis.pcert1 : no_pcert = 0
-centaur/bridge/portcullis.pcert1 : centaur/bridge/portcullis.pcert0
-centaur/bridge/portcullis.cert : | centaur/bridge/portcullis.pcert1
-
-centaur/bridge/to-json.pcert0 : no_pcert = 0
-centaur/bridge/to-json.pcert0 : acl2x = 0
-centaur/bridge/to-json.pcert0 : \
-     misc/definline.pcert0 \
-     str/cat.pcert0 \
-     str/natstr.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     std/ks/explode-atom.pcert0 \
-     centaur/bitops/ihsext-basics.pcert0 \
-     misc/assert.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     arithmetic/top.pcert0 \
-     str/strtok.pcert0 \
-     tools/flag.pcert0 \
-     centaur/bridge/portcullis.pcert0 \
-     centaur/bridge/to-json.lisp \
-     centaur/bridge/cert.acl2
-centaur/bridge/to-json.pcert1 : acl2x = 0
-centaur/bridge/to-json.pcert1 : no_pcert = 0
-centaur/bridge/to-json.pcert1 : centaur/bridge/to-json.pcert0
-centaur/bridge/to-json.cert : | centaur/bridge/to-json.pcert1
-
-centaur/bridge/top.pcert0 : no_pcert = 0
-centaur/bridge/top.pcert0 : acl2x = 0
-centaur/bridge/top.pcert0 : \
-     xdoc/top.pcert0 \
-     tools/include-raw.pcert0 \
-     str/top.pcert0 \
-     centaur/bridge/to-json.pcert0 \
-     centaur/bridge/portcullis.pcert0 \
-     centaur/bridge/top.lisp \
-     centaur/bridge/cert.acl2 \
-     centaur/bridge/bridge-raw.lsp
-centaur/bridge/top.pcert1 : acl2x = 0
-centaur/bridge/top.pcert1 : no_pcert = 0
-centaur/bridge/top.pcert1 : centaur/bridge/top.pcert0
-centaur/bridge/top.cert : | centaur/bridge/top.pcert1
-
-centaur/defrstobj/array-lemmas.pcert0 : no_pcert = 0
-centaur/defrstobj/array-lemmas.pcert0 : acl2x = 0
-centaur/defrstobj/array-lemmas.pcert0 : \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/array-lemmas.lisp \
-     centaur/defrstobj/cert.acl2
-centaur/defrstobj/array-lemmas.pcert1 : acl2x = 0
-centaur/defrstobj/array-lemmas.pcert1 : no_pcert = 0
-centaur/defrstobj/array-lemmas.pcert1 : centaur/defrstobj/array-lemmas.pcert0
-centaur/defrstobj/array-lemmas.cert : | centaur/defrstobj/array-lemmas.pcert1
-
-centaur/defrstobj/basic-tests.pcert0 : no_pcert = 0
-centaur/defrstobj/basic-tests.pcert0 : acl2x = 0
-centaur/defrstobj/basic-tests.pcert0 : \
-     centaur/defrstobj/defrstobj.pcert0 \
-     centaur/defrstobj/typed-record-tests.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/basic-tests.lisp \
-     centaur/defrstobj/cert.acl2
-centaur/defrstobj/basic-tests.pcert1 : acl2x = 0
-centaur/defrstobj/basic-tests.pcert1 : no_pcert = 0
-centaur/defrstobj/basic-tests.pcert1 : centaur/defrstobj/basic-tests.pcert0
-centaur/defrstobj/basic-tests.cert : | centaur/defrstobj/basic-tests.pcert1
-
-centaur/defrstobj/def-typed-record.pcert0 : no_pcert = 0
-centaur/defrstobj/def-typed-record.pcert0 : acl2x = 0
-centaur/defrstobj/def-typed-record.pcert0 : \
-     centaur/defrstobj/typed-records.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/def-typed-record.lisp \
-     centaur/defrstobj/cert.acl2
-centaur/defrstobj/def-typed-record.pcert1 : acl2x = 0
-centaur/defrstobj/def-typed-record.pcert1 : no_pcert = 0
-centaur/defrstobj/def-typed-record.pcert1 : centaur/defrstobj/def-typed-record.pcert0
-centaur/defrstobj/def-typed-record.cert : | centaur/defrstobj/def-typed-record.pcert1
-
-centaur/defrstobj/defrstobj.pcert0 : no_pcert = 0
-centaur/defrstobj/defrstobj.pcert0 : acl2x = 0
-centaur/defrstobj/defrstobj.pcert0 : \
-     centaur/defrstobj/def-typed-record.pcert0 \
-     centaur/defrstobj/g-delete-keys.pcert0 \
-     centaur/defrstobj/fancy-worseguy.pcert0 \
-     misc/definline.pcert0 \
-     misc/records.pcert0 \
-     tools/bstar.pcert0 \
-     cutil/defsection.pcert0 \
-     centaur/defrstobj/array-lemmas.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/defrstobj.lisp \
-     centaur/defrstobj/cert.acl2
-centaur/defrstobj/defrstobj.pcert1 : acl2x = 0
-centaur/defrstobj/defrstobj.pcert1 : no_pcert = 0
-centaur/defrstobj/defrstobj.pcert1 : centaur/defrstobj/defrstobj.pcert0
-centaur/defrstobj/defrstobj.cert : | centaur/defrstobj/defrstobj.pcert1
-
-centaur/defrstobj/fancy-worseguy.pcert0 : no_pcert = 0
-centaur/defrstobj/fancy-worseguy.pcert0 : acl2x = 0
-centaur/defrstobj/fancy-worseguy.pcert0 : \
-     centaur/defrstobj/g-delete-keys.pcert0 \
-     misc/equal-by-g-help.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/fancy-worseguy.lisp \
-     centaur/defrstobj/cert.acl2
-centaur/defrstobj/fancy-worseguy.pcert1 : acl2x = 0
-centaur/defrstobj/fancy-worseguy.pcert1 : no_pcert = 0
-centaur/defrstobj/fancy-worseguy.pcert1 : centaur/defrstobj/fancy-worseguy.pcert0
-centaur/defrstobj/fancy-worseguy.cert : | centaur/defrstobj/fancy-worseguy.pcert1
-
-centaur/defrstobj/g-delete-keys.pcert0 : no_pcert = 0
-centaur/defrstobj/g-delete-keys.pcert0 : acl2x = 0
-centaur/defrstobj/g-delete-keys.pcert0 : \
-     misc/records.pcert0 \
-     misc/equal-by-g.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/g-delete-keys.lisp \
-     centaur/defrstobj/cert.acl2
-centaur/defrstobj/g-delete-keys.pcert1 : acl2x = 0
-centaur/defrstobj/g-delete-keys.pcert1 : no_pcert = 0
-centaur/defrstobj/g-delete-keys.pcert1 : centaur/defrstobj/g-delete-keys.pcert0
-centaur/defrstobj/g-delete-keys.cert : | centaur/defrstobj/g-delete-keys.pcert1
-
-centaur/defrstobj/groundwork/array-rec.pcert0 : no_pcert = 0
-centaur/defrstobj/groundwork/array-rec.pcert0 : acl2x = 0
-centaur/defrstobj/groundwork/array-rec.pcert0 : \
-     cutil/defsection.pcert0 \
-     misc/records.pcert0 \
-     misc/equal-by-g.pcert0 \
-     centaur/misc/equal-by-nths.pcert0 \
-     centaur/defrstobj/groundwork/local.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/groundwork/array-rec.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-centaur/defrstobj/groundwork/array-rec.pcert1 : acl2x = 0
-centaur/defrstobj/groundwork/array-rec.pcert1 : no_pcert = 0
-centaur/defrstobj/groundwork/array-rec.pcert1 : centaur/defrstobj/groundwork/array-rec.pcert0
-centaur/defrstobj/groundwork/array-rec.cert : | centaur/defrstobj/groundwork/array-rec.pcert1
-
-centaur/defrstobj/groundwork/demo1.pcert0 : no_pcert = 0
-centaur/defrstobj/groundwork/demo1.pcert0 : acl2x = 0
-centaur/defrstobj/groundwork/demo1.pcert0 : \
-     misc/records.pcert0 \
-     misc/definline.pcert0 \
-     centaur/defrstobj/groundwork/local.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/groundwork/demo1.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-centaur/defrstobj/groundwork/demo1.pcert1 : acl2x = 0
-centaur/defrstobj/groundwork/demo1.pcert1 : no_pcert = 0
-centaur/defrstobj/groundwork/demo1.pcert1 : centaur/defrstobj/groundwork/demo1.pcert0
-centaur/defrstobj/groundwork/demo1.cert : | centaur/defrstobj/groundwork/demo1.pcert1
-
-centaur/defrstobj/groundwork/demo2.pcert0 : no_pcert = 0
-centaur/defrstobj/groundwork/demo2.pcert0 : acl2x = 0
-centaur/defrstobj/groundwork/demo2.pcert0 : \
-     misc/records.pcert0 \
-     misc/definline.pcert0 \
-     centaur/defrstobj/groundwork/local.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/groundwork/demo2.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-centaur/defrstobj/groundwork/demo2.pcert1 : acl2x = 0
-centaur/defrstobj/groundwork/demo2.pcert1 : no_pcert = 0
-centaur/defrstobj/groundwork/demo2.pcert1 : centaur/defrstobj/groundwork/demo2.pcert0
-centaur/defrstobj/groundwork/demo2.cert : | centaur/defrstobj/groundwork/demo2.pcert1
-
-centaur/defrstobj/groundwork/demo3.pcert0 : no_pcert = 0
-centaur/defrstobj/groundwork/demo3.pcert0 : acl2x = 0
-centaur/defrstobj/groundwork/demo3.pcert0 : \
-     cutil/defsection.pcert0 \
-     misc/definline.pcert0 \
-     misc/records.pcert0 \
-     centaur/defrstobj/groundwork/local.pcert0 \
-     centaur/defrstobj/groundwork/array-rec.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/groundwork/demo3.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-centaur/defrstobj/groundwork/demo3.pcert1 : acl2x = 0
-centaur/defrstobj/groundwork/demo3.pcert1 : no_pcert = 0
-centaur/defrstobj/groundwork/demo3.pcert1 : centaur/defrstobj/groundwork/demo3.pcert0
-centaur/defrstobj/groundwork/demo3.cert : | centaur/defrstobj/groundwork/demo3.pcert1
-
-centaur/defrstobj/groundwork/demo4.pcert0 : no_pcert = 0
-centaur/defrstobj/groundwork/demo4.pcert0 : acl2x = 0
-centaur/defrstobj/groundwork/demo4.pcert0 : \
-     cutil/defsection.pcert0 \
-     misc/definline.pcert0 \
-     misc/records.pcert0 \
-     centaur/defrstobj/groundwork/array-rec.pcert0 \
-     centaur/defrstobj/groundwork/local.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/groundwork/demo4.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-centaur/defrstobj/groundwork/demo4.pcert1 : acl2x = 0
-centaur/defrstobj/groundwork/demo4.pcert1 : no_pcert = 0
-centaur/defrstobj/groundwork/demo4.pcert1 : centaur/defrstobj/groundwork/demo4.pcert0
-centaur/defrstobj/groundwork/demo4.cert : | centaur/defrstobj/groundwork/demo4.pcert1
-
-centaur/defrstobj/groundwork/demo5.pcert0 : no_pcert = 0
-centaur/defrstobj/groundwork/demo5.pcert0 : acl2x = 0
-centaur/defrstobj/groundwork/demo5.pcert0 : \
-     cutil/defsection.pcert0 \
-     misc/definline.pcert0 \
-     misc/records.pcert0 \
-     centaur/defrstobj/def-typed-record.pcert0 \
-     centaur/defrstobj/array-lemmas.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/groundwork/demo5.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-centaur/defrstobj/groundwork/demo5.pcert1 : acl2x = 0
-centaur/defrstobj/groundwork/demo5.pcert1 : no_pcert = 0
-centaur/defrstobj/groundwork/demo5.pcert1 : centaur/defrstobj/groundwork/demo5.pcert0
-centaur/defrstobj/groundwork/demo5.cert : | centaur/defrstobj/groundwork/demo5.pcert1
-
-centaur/defrstobj/groundwork/local.pcert0 : no_pcert = 0
-centaur/defrstobj/groundwork/local.pcert0 : acl2x = 0
-centaur/defrstobj/groundwork/local.pcert0 : \
-     misc/records.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/groundwork/local.lisp \
-     centaur/defrstobj/groundwork/cert.acl2
-centaur/defrstobj/groundwork/local.pcert1 : acl2x = 0
-centaur/defrstobj/groundwork/local.pcert1 : no_pcert = 0
-centaur/defrstobj/groundwork/local.pcert1 : centaur/defrstobj/groundwork/local.pcert0
-centaur/defrstobj/groundwork/local.cert : | centaur/defrstobj/groundwork/local.pcert1
-
-centaur/defrstobj/portcullis.pcert0 : no_pcert = 0
-centaur/defrstobj/portcullis.pcert0 : acl2x = 0
-centaur/defrstobj/portcullis.pcert0 : \
-     centaur/defrstobj/portcullis.lisp \
-     centaur/defrstobj/portcullis.acl2 \
-     centaur/defrstobj/package.lsp
-centaur/defrstobj/portcullis.pcert1 : acl2x = 0
-centaur/defrstobj/portcullis.pcert1 : no_pcert = 0
-centaur/defrstobj/portcullis.pcert1 : centaur/defrstobj/portcullis.pcert0
-centaur/defrstobj/portcullis.cert : | centaur/defrstobj/portcullis.pcert1
-
-centaur/defrstobj/typed-record-tests.pcert0 : no_pcert = 0
-centaur/defrstobj/typed-record-tests.pcert0 : acl2x = 0
-centaur/defrstobj/typed-record-tests.pcert0 : \
-     centaur/defrstobj/def-typed-record.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/typed-record-tests.lisp \
-     centaur/defrstobj/cert.acl2
-centaur/defrstobj/typed-record-tests.pcert1 : acl2x = 0
-centaur/defrstobj/typed-record-tests.pcert1 : no_pcert = 0
-centaur/defrstobj/typed-record-tests.pcert1 : centaur/defrstobj/typed-record-tests.pcert0
-centaur/defrstobj/typed-record-tests.cert : | centaur/defrstobj/typed-record-tests.pcert1
-
-centaur/defrstobj/typed-records.pcert0 : no_pcert = 0
-centaur/defrstobj/typed-records.pcert0 : acl2x = 0
-centaur/defrstobj/typed-records.pcert0 : \
-     misc/total-order.pcert0 \
-     centaur/misc/mfc-utils.pcert0 \
-     centaur/misc/introduce-var.pcert0 \
-     centaur/misc/equal-by-nths.pcert0 \
-     centaur/defrstobj/array-lemmas.pcert0 \
-     centaur/defrstobj/portcullis.pcert0 \
-     centaur/defrstobj/typed-records.lisp \
-     centaur/defrstobj/cert.acl2
-centaur/defrstobj/typed-records.pcert1 : acl2x = 0
-centaur/defrstobj/typed-records.pcert1 : no_pcert = 0
-centaur/defrstobj/typed-records.pcert1 : centaur/defrstobj/typed-records.pcert0
-centaur/defrstobj/typed-records.cert : | centaur/defrstobj/typed-records.pcert1
-
-centaur/esim/esim-paths.pcert0 : no_pcert = 0
-centaur/esim/esim-paths.pcert0 : acl2x = 0
-centaur/esim/esim-paths.pcert0 : \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/esim/esim-sexpr-support-thms.pcert0 \
-     cutil/deflist.pcert0 \
-     cutil/defmvtypes.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-paths.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-paths.pcert1 : acl2x = 0
-centaur/esim/esim-paths.pcert1 : no_pcert = 0
-centaur/esim/esim-paths.pcert1 : centaur/esim/esim-paths.pcert0
-centaur/esim/esim-paths.cert : | centaur/esim/esim-paths.pcert1
-
-centaur/esim/esim-primitives.pcert0 : no_pcert = 0
-centaur/esim/esim-primitives.pcert0 : acl2x = 0
-centaur/esim/esim-primitives.pcert0 : \
-     tools/bstar.pcert0 \
-     xdoc/top.pcert0 \
-     centaur/esim/plist.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-primitives.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-primitives.pcert1 : acl2x = 0
-centaur/esim/esim-primitives.pcert1 : no_pcert = 0
-centaur/esim/esim-primitives.pcert1 : centaur/esim/esim-primitives.pcert0
-centaur/esim/esim-primitives.cert : | centaur/esim/esim-primitives.pcert1
-
-centaur/esim/esim-sexpr-correct.pcert0 : no_pcert = 0
-centaur/esim/esim-sexpr-correct.pcert0 : acl2x = 0
-centaur/esim/esim-sexpr-correct.pcert0 : \
-     centaur/esim/esim-sexpr.pcert0 \
-     centaur/esim/esim-spec.pcert0 \
-     centaur/esim/esim-sexpr-support-thms.pcert0 \
-     centaur/4v-sexpr/sexpr-advanced.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint-top.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-sexpr-correct.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-sexpr-correct.pcert1 : acl2x = 0
-centaur/esim/esim-sexpr-correct.pcert1 : no_pcert = 0
-centaur/esim/esim-sexpr-correct.pcert1 : centaur/esim/esim-sexpr-correct.pcert0
-centaur/esim/esim-sexpr-correct.cert : | centaur/esim/esim-sexpr-correct.pcert1
-
-centaur/esim/esim-sexpr-support-thms.pcert0 : no_pcert = 0
-centaur/esim/esim-sexpr-support-thms.pcert0 : acl2x = 0
-centaur/esim/esim-sexpr-support-thms.pcert0 : \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/esim/local-theory.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-sexpr-support-thms.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-sexpr-support-thms.pcert1 : acl2x = 0
-centaur/esim/esim-sexpr-support-thms.pcert1 : no_pcert = 0
-centaur/esim/esim-sexpr-support-thms.pcert1 : centaur/esim/esim-sexpr-support-thms.pcert0
-centaur/esim/esim-sexpr-support-thms.cert : | centaur/esim/esim-sexpr-support-thms.pcert1
-
-centaur/esim/esim-sexpr-support.pcert0 : no_pcert = 0
-centaur/esim/esim-sexpr-support.pcert0 : acl2x = 0
-centaur/esim/esim-sexpr-support.pcert0 : \
-     centaur/esim/plist.pcert0 \
-     centaur/misc/patterns.pcert0 \
-     centaur/4v-sexpr/sexpr-vars.pcert0 \
-     std/ks/explode-nonnegative-integer.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     arithmetic/nat-listp.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-sexpr-support.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-sexpr-support.pcert1 : acl2x = 0
-centaur/esim/esim-sexpr-support.pcert1 : no_pcert = 0
-centaur/esim/esim-sexpr-support.pcert1 : centaur/esim/esim-sexpr-support.pcert0
-centaur/esim/esim-sexpr-support.cert : | centaur/esim/esim-sexpr-support.pcert1
-
-centaur/esim/esim-sexpr.pcert0 : no_pcert = 0
-centaur/esim/esim-sexpr.pcert0 : acl2x = 0
-centaur/esim/esim-sexpr.pcert0 : \
-     centaur/esim/esim-paths.pcert0 \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     str/strsubst.pcert0 \
-     str/substrp.pcert0 \
-     centaur/misc/ap.pcert0 \
-     centaur/4v-sexpr/sexpr-fixpoint.pcert0 \
-     centaur/4v-sexpr/sexpr-to-faig.pcert0 \
-     centaur/4v-sexpr/sexpr-equivs.pcert0 \
-     centaur/esim/esim-sexpr-support-thms.pcert0 \
-     centaur/4v-sexpr/sexpr-advanced.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-sexpr.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-sexpr.pcert1 : acl2x = 0
-centaur/esim/esim-sexpr.pcert1 : no_pcert = 0
-centaur/esim/esim-sexpr.pcert1 : centaur/esim/esim-sexpr.pcert0
-centaur/esim/esim-sexpr.cert : | centaur/esim/esim-sexpr.pcert1
-
-centaur/esim/esim-spec.pcert0 : no_pcert = 0
-centaur/esim/esim-spec.pcert0 : acl2x = 0
-centaur/esim/esim-spec.pcert0 : \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     std/lists/rev.pcert0 \
-     centaur/4v-sexpr/4v-logic.pcert0 \
-     centaur/4v-sexpr/sexpr-equivs.pcert0 \
-     centaur/misc/patterns.pcert0 \
-     centaur/esim/esim-sexpr-support-thms.pcert0 \
-     centaur/4v-sexpr/sexpr-advanced.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-spec.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-spec.pcert1 : acl2x = 0
-centaur/esim/esim-spec.pcert1 : no_pcert = 0
-centaur/esim/esim-spec.pcert1 : centaur/esim/esim-spec.pcert0
-centaur/esim/esim-spec.cert : | centaur/esim/esim-spec.pcert1
-
-centaur/esim/esim-vcd.pcert0 : no_pcert = 0
-centaur/esim/esim-vcd.pcert0 : acl2x = 0
-centaur/esim/esim-vcd.pcert0 : \
-     centaur/esim/esim-vl.pcert0 \
-     centaur/esim/esim-paths.pcert0 \
-     centaur/misc/load-stobj.pcert0 \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/util/string-alists.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-vcd.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-vcd.pcert1 : acl2x = 0
-centaur/esim/esim-vcd.pcert1 : no_pcert = 0
-centaur/esim/esim-vcd.pcert1 : centaur/esim/esim-vcd.pcert0
-centaur/esim/esim-vcd.cert : | centaur/esim/esim-vcd.pcert1
-
-centaur/esim/esim-vl.pcert0 : no_pcert = 0
-centaur/esim/esim-vl.pcert0 : acl2x = 0
-centaur/esim/esim-vl.pcert0 : \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/vl/toe/toe-wirealist.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/esim-vl.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/esim-vl.pcert1 : acl2x = 0
-centaur/esim/esim-vl.pcert1 : no_pcert = 0
-centaur/esim/esim-vl.pcert1 : centaur/esim/esim-vl.pcert0
-centaur/esim/esim-vl.cert : | centaur/esim/esim-vl.pcert1
-
-centaur/esim/follow-backwards.pcert0 : no_pcert = 0
-centaur/esim/follow-backwards.pcert0 : acl2x = 0
-centaur/esim/follow-backwards.pcert0 : \
-     centaur/esim/esim-paths.pcert0 \
-     centaur/esim/esim-sexpr-support-thms.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/follow-backwards.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/follow-backwards.pcert1 : acl2x = 0
-centaur/esim/follow-backwards.pcert1 : no_pcert = 0
-centaur/esim/follow-backwards.pcert1 : centaur/esim/follow-backwards.pcert0
-centaur/esim/follow-backwards.cert : | centaur/esim/follow-backwards.pcert1
-
-centaur/esim/local-theory.pcert0 : no_pcert = 0
-centaur/esim/local-theory.pcert0 : acl2x = 0
-centaur/esim/local-theory.pcert0 : \
-     std/lists/rev.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     data-structures/no-duplicates.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/local-theory.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/local-theory.pcert1 : acl2x = 0
-centaur/esim/local-theory.pcert1 : no_pcert = 0
-centaur/esim/local-theory.pcert1 : centaur/esim/local-theory.pcert0
-centaur/esim/local-theory.cert : | centaur/esim/local-theory.pcert1
-
-centaur/esim/plist.pcert0 : no_pcert = 0
-centaur/esim/plist.pcert0 : acl2x = 0
-centaur/esim/plist.pcert0 : \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/plist.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/plist.pcert1 : acl2x = 0
-centaur/esim/plist.pcert1 : no_pcert = 0
-centaur/esim/plist.pcert1 : centaur/esim/plist.pcert0
-centaur/esim/plist.cert : | centaur/esim/plist.pcert1
-
-centaur/esim/portcullis.pcert0 : no_pcert = 0
-centaur/esim/portcullis.pcert0 : acl2x = 0
-centaur/esim/portcullis.pcert0 : \
-     cutil/portcullis.pcert0 \
-     str/portcullis.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/esim/portcullis.lisp \
-     centaur/esim/portcullis.acl2 \
-     centaur/esim/packages.lsp \
-     tools/flag-package.lsp
-centaur/esim/portcullis.pcert1 : acl2x = 0
-centaur/esim/portcullis.pcert1 : no_pcert = 0
-centaur/esim/portcullis.pcert1 : centaur/esim/portcullis.pcert0
-centaur/esim/portcullis.cert : | centaur/esim/portcullis.pcert1
-
-centaur/esim/steps.pcert0 : no_pcert = 0
-centaur/esim/steps.pcert0 : acl2x = 0
-centaur/esim/steps.pcert0 : \
-     centaur/esim/esim-sexpr.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/steps.lisp \
-     centaur/esim/cert.acl2
-centaur/esim/steps.pcert1 : acl2x = 0
-centaur/esim/steps.pcert1 : no_pcert = 0
-centaur/esim/steps.pcert1 : centaur/esim/steps.pcert0
-centaur/esim/steps.cert : | centaur/esim/steps.pcert1
-
-centaur/esim/stv/stv-compile.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-compile.pcert0 : acl2x = 0
-centaur/esim/stv/stv-compile.pcert0 : \
-     centaur/esim/stv/stv-util.pcert0 \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/esim/follow-backwards.pcert0 \
-     centaur/misc/vecs-ints.pcert0 \
-     centaur/misc/tuplep.pcert0 \
-     cutil/defmvtypes.pcert0 \
-     cutil/defprojection.pcert0 \
-     str/natstr.pcert0 \
-     std/lists/final-cdr.pcert0 \
-     centaur/vl/util/defs.pcert0 \
-     centaur/esim/esim-sexpr-support-thms.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-compile.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-compile.pcert1 : acl2x = 0
-centaur/esim/stv/stv-compile.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-compile.pcert1 : centaur/esim/stv/stv-compile.pcert0
-centaur/esim/stv/stv-compile.cert : | centaur/esim/stv/stv-compile.pcert1
-
-centaur/esim/stv/stv-debug.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-debug.pcert0 : acl2x = 0
-centaur/esim/stv/stv-debug.pcert0 : \
-     centaur/esim/stv/stv-run.pcert0 \
-     centaur/esim/stv/stv-sim.pcert0 \
-     oslib/date.pcert0 \
-     centaur/misc/tshell.pcert0 \
-     centaur/esim/esim-vcd.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-debug.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-debug.pcert1 : acl2x = 0
-centaur/esim/stv/stv-debug.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-debug.pcert1 : centaur/esim/stv/stv-debug.pcert0
-centaur/esim/stv/stv-debug.cert : | centaur/esim/stv/stv-debug.pcert1
-
-centaur/esim/stv/stv-doc.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-doc.pcert0 : acl2x = 0
-centaur/esim/stv/stv-doc.pcert0 : \
-     centaur/esim/stv/stv-util.pcert0 \
-     centaur/esim/stv/stv-widen.pcert0 \
-     str/stringify.pcert0 \
-     centaur/vl/util/print-htmlencode.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-doc.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-doc.pcert1 : acl2x = 0
-centaur/esim/stv/stv-doc.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-doc.pcert1 : centaur/esim/stv/stv-doc.pcert0
-centaur/esim/stv/stv-doc.cert : | centaur/esim/stv/stv-doc.pcert1
-
-centaur/esim/stv/stv-expand.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-expand.pcert0 : acl2x = 0
-centaur/esim/stv/stv-expand.pcert0 : \
-     centaur/esim/stv/stv-util.pcert0 \
-     centaur/esim/esim-vl.pcert0 \
-     centaur/esim/esim-paths.pcert0 \
-     centaur/vl/mlib/hid-tools.pcert0 \
-     centaur/vl/mlib/expr-parse.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-expand.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-expand.pcert1 : acl2x = 0
-centaur/esim/stv/stv-expand.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-expand.pcert1 : centaur/esim/stv/stv-expand.pcert0
-centaur/esim/stv/stv-expand.cert : | centaur/esim/stv/stv-expand.pcert1
-
-centaur/esim/stv/stv-run.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-run.pcert0 : acl2x = 0
-centaur/esim/stv/stv-run.pcert0 : \
-     centaur/esim/stv/stv-util.pcert0 \
-     str/hexify.pcert0 \
-     centaur/misc/vecs-ints.pcert0 \
-     centaur/vl/util/defs.pcert0 \
-     centaur/4v-sexpr/bitspecs.pcert0 \
-     centaur/4v-sexpr/sexpr-rewrites.pcert0 \
-     centaur/gl/gl-util.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-run.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-run.pcert1 : acl2x = 0
-centaur/esim/stv/stv-run.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-run.pcert1 : centaur/esim/stv/stv-run.pcert0
-centaur/esim/stv/stv-run.cert : | centaur/esim/stv/stv-run.pcert1
-
-centaur/esim/stv/stv-sim.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-sim.pcert0 : acl2x = 0
-centaur/esim/stv/stv-sim.pcert0 : \
-     centaur/esim/stv/stv-util.pcert0 \
-     centaur/vl/util/defs.pcert0 \
-     centaur/esim/steps.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-sim.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-sim.pcert1 : acl2x = 0
-centaur/esim/stv/stv-sim.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-sim.pcert1 : centaur/esim/stv/stv-sim.pcert0
-centaur/esim/stv/stv-sim.cert : | centaur/esim/stv/stv-sim.pcert1
-
-centaur/esim/stv/stv-top.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-top.pcert0 : acl2x = 0
-centaur/esim/stv/stv-top.pcert0 : \
-     centaur/esim/stv/stv-sim.pcert0 \
-     centaur/esim/stv/stv-compile.pcert0 \
-     centaur/esim/stv/stv-expand.pcert0 \
-     centaur/esim/stv/stv-widen.pcert0 \
-     centaur/esim/stv/stv-doc.pcert0 \
-     centaur/esim/stv/stv-run.pcert0 \
-     centaur/gl/auto-bindings.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-top.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-top.pcert1 : acl2x = 0
-centaur/esim/stv/stv-top.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-top.pcert1 : centaur/esim/stv/stv-top.pcert0
-centaur/esim/stv/stv-top.cert : | centaur/esim/stv/stv-top.pcert1
-
-centaur/esim/stv/stv-util.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-util.pcert0 : acl2x = 0
-centaur/esim/stv/stv-util.pcert0 : \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     cutil/defaggregate.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-util.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-util.pcert1 : acl2x = 0
-centaur/esim/stv/stv-util.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-util.pcert1 : centaur/esim/stv/stv-util.pcert0
-centaur/esim/stv/stv-util.cert : | centaur/esim/stv/stv-util.pcert1
-
-centaur/esim/stv/stv-widen.pcert0 : no_pcert = 0
-centaur/esim/stv/stv-widen.pcert0 : acl2x = 0
-centaur/esim/stv/stv-widen.pcert0 : \
-     centaur/esim/stv/stv-util.pcert0 \
-     std/lists/repeat.pcert0 \
-     std/lists/take.pcert0 \
-     centaur/esim/portcullis.pcert0 \
-     centaur/esim/stv/stv-widen.lisp \
-     centaur/esim/stv/cert.acl2
-centaur/esim/stv/stv-widen.pcert1 : acl2x = 0
-centaur/esim/stv/stv-widen.pcert1 : no_pcert = 0
-centaur/esim/stv/stv-widen.pcert1 : centaur/esim/stv/stv-widen.pcert0
-centaur/esim/stv/stv-widen.cert : | centaur/esim/stv/stv-widen.pcert1
-
-centaur/gl/always-equal-prep.pcert0 : no_pcert = 0
-centaur/gl/always-equal-prep.pcert0 : acl2x = 0
-centaur/gl/always-equal-prep.pcert0 : \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/always-equal-prep.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/always-equal-prep.pcert1 : acl2x = 0
-centaur/gl/always-equal-prep.pcert1 : no_pcert = 0
-centaur/gl/always-equal-prep.pcert1 : centaur/gl/always-equal-prep.pcert0
-centaur/gl/always-equal-prep.cert : | centaur/gl/always-equal-prep.pcert1
-
-centaur/gl/auto-bindings.pcert0 : no_pcert = 0
-centaur/gl/auto-bindings.pcert0 : acl2x = 0
-centaur/gl/auto-bindings.pcert0 : \
-     centaur/gl/gl-doc-string.pcert0 \
-     centaur/gl/gobject-types.pcert0 \
-     centaur/misc/numlist.pcert0 \
-     tools/bstar.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/auto-bindings.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/auto-bindings.pcert1 : acl2x = 0
-centaur/gl/auto-bindings.pcert1 : no_pcert = 0
-centaur/gl/auto-bindings.pcert1 : centaur/gl/auto-bindings.pcert0
-centaur/gl/auto-bindings.cert : | centaur/gl/auto-bindings.pcert1
-
-centaur/gl/bfr-aig-bddify.pcert0 : no_pcert = 0
-centaur/gl/bfr-aig-bddify.pcert0 : acl2x = 0
-centaur/gl/bfr-aig-bddify.pcert0 : \
-     centaur/gl/bfr-sat.pcert0 \
-     centaur/gl/gl-doc-string.pcert0 \
-     centaur/aig/bddify-correct.pcert0 \
-     centaur/aig/eval-restrict.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/bfr-aig-bddify.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/bfr-aig-bddify.pcert1 : acl2x = 0
-centaur/gl/bfr-aig-bddify.pcert1 : no_pcert = 0
-centaur/gl/bfr-aig-bddify.pcert1 : centaur/gl/bfr-aig-bddify.pcert0
-centaur/gl/bfr-aig-bddify.cert : | centaur/gl/bfr-aig-bddify.pcert1
-
-centaur/gl/bfr-sat.pcert0 : no_pcert = 0
-centaur/gl/bfr-sat.pcert0 : acl2x = 0
-centaur/gl/bfr-sat.pcert0 : \
-     centaur/gl/bfr.pcert0 \
-     centaur/gl/gl-doc-string.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/bfr-sat.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/bfr-sat.pcert1 : acl2x = 0
-centaur/gl/bfr-sat.pcert1 : no_pcert = 0
-centaur/gl/bfr-sat.pcert1 : centaur/gl/bfr-sat.pcert0
-centaur/gl/bfr-sat.cert : | centaur/gl/bfr-sat.pcert1
-
-centaur/gl/bfr.pcert0 : no_pcert = 0
-centaur/gl/bfr.pcert0 : acl2x = 0
-centaur/gl/bfr.pcert0 : \
-     centaur/ubdds/lite.pcert0 \
-     centaur/aig/witness.pcert0 \
-     clause-processors/term-patterns.pcert0 \
-     clause-processors/join-thms.pcert0 \
-     tools/flag.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/bfr.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/bfr.pcert1 : acl2x = 0
-centaur/gl/bfr.pcert1 : no_pcert = 0
-centaur/gl/bfr.pcert1 : centaur/gl/bfr.pcert0
-centaur/gl/bfr.cert : | centaur/gl/bfr.pcert1
-
-centaur/gl/bvec-ite.pcert0 : no_pcert = 0
-centaur/gl/bvec-ite.pcert0 : acl2x = 0
-centaur/gl/bvec-ite.pcert0 : \
-     centaur/gl/bvecs.pcert0 \
-     tools/bstar.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/bvec-ite.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/bvec-ite.pcert1 : acl2x = 0
-centaur/gl/bvec-ite.pcert1 : no_pcert = 0
-centaur/gl/bvec-ite.pcert1 : centaur/gl/bvec-ite.pcert0
-centaur/gl/bvec-ite.cert : | centaur/gl/bvec-ite.pcert1
-
-centaur/gl/bvecs.pcert0 : no_pcert = 0
-centaur/gl/bvecs.pcert0 : acl2x = 0
-centaur/gl/bvecs.pcert0 : \
-     centaur/gl/bfr.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/bvecs.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/bvecs.pcert1 : acl2x = 0
-centaur/gl/bvecs.pcert1 : no_pcert = 0
-centaur/gl/bvecs.pcert1 : centaur/gl/bvecs.pcert0
-centaur/gl/bvecs.cert : | centaur/gl/bvecs.pcert1
-
-centaur/gl/def-gl-clause-proc.pcert0 : no_pcert = 0
-centaur/gl/def-gl-clause-proc.pcert0 : acl2x = 0
-centaur/gl/def-gl-clause-proc.pcert0 : \
-     parallel/without-waterfall-parallelism.pcert0 \
-     centaur/misc/defapply.pcert0 \
-     centaur/gl/gify.pcert0 \
-     centaur/gl/gify-thms.pcert0 \
-     centaur/gl/run-gified-cp.pcert0 \
-     centaur/gl/general-object-thms.pcert0 \
-     centaur/gl/glcp-templates.pcert0 \
-     centaur/gl/gl-doc-string.pcert0 \
-     centaur/gl/generic-geval.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/def-gl-clause-proc.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/def-gl-clause-proc.pcert1 : acl2x = 0
-centaur/gl/def-gl-clause-proc.pcert1 : no_pcert = 0
-centaur/gl/def-gl-clause-proc.pcert1 : centaur/gl/def-gl-clause-proc.pcert0
-centaur/gl/def-gl-clause-proc.cert : | centaur/gl/def-gl-clause-proc.pcert1
-
-centaur/gl/defagg.pcert0 : no_pcert = 0
-centaur/gl/defagg.pcert0 : acl2x = 0
-centaur/gl/defagg.pcert0 : \
-     cutil/defaggregate.pcert0 \
-     tools/flag.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/defagg.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/defagg.pcert1 : acl2x = 0
-centaur/gl/defagg.pcert1 : no_pcert = 0
-centaur/gl/defagg.pcert1 : centaur/gl/defagg.pcert0
-centaur/gl/defagg.cert : | centaur/gl/defagg.pcert1
-
-centaur/gl/defapply.pcert0 : no_pcert = 0
-centaur/gl/defapply.pcert0 : acl2x = 0
-centaur/gl/defapply.pcert0 : \
-     clause-processors/generalize.pcert0 \
-     tools/mv-nth.pcert0 \
-     tools/rulesets.pcert0 \
-     centaur/gl/gl-util.pcert0 \
-     misc/hons-help2.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/defapply.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/defapply.pcert1 : acl2x = 0
-centaur/gl/defapply.pcert1 : no_pcert = 0
-centaur/gl/defapply.pcert1 : centaur/gl/defapply.pcert0
-centaur/gl/defapply.cert : | centaur/gl/defapply.pcert1
-
-centaur/gl/eval-f-i-cp.pcert0 : no_pcert = 0
-centaur/gl/eval-f-i-cp.pcert0 : acl2x = 0
-centaur/gl/eval-f-i-cp.pcert0 : \
-     centaur/gl/gl-util.pcert0 \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     misc/hons-help2.pcert0 \
-     clause-processors/join-thms.pcert0 \
-     centaur/misc/hons-sets.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/eval-f-i-cp.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/eval-f-i-cp.pcert1 : acl2x = 0
-centaur/gl/eval-f-i-cp.pcert1 : no_pcert = 0
-centaur/gl/eval-f-i-cp.pcert1 : centaur/gl/eval-f-i-cp.pcert0
-centaur/gl/eval-f-i-cp.cert : | centaur/gl/eval-f-i-cp.pcert1
-
-centaur/gl/eval-g-base-help.pcert0 : no_pcert = 0
-centaur/gl/eval-g-base-help.pcert0 : acl2x = 0
-centaur/gl/eval-g-base-help.pcert0 : \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/gify-clause-proc.pcert0 \
-     centaur/gl/general-object-thms.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/eval-g-base-help.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/eval-g-base-help.pcert1 : acl2x = 0
-centaur/gl/eval-g-base-help.pcert1 : no_pcert = 0
-centaur/gl/eval-g-base-help.pcert1 : centaur/gl/eval-g-base-help.pcert0
-centaur/gl/eval-g-base-help.cert : | centaur/gl/eval-g-base-help.pcert1
-
-centaur/gl/eval-g-base.pcert0 : no_pcert = 0
-centaur/gl/eval-g-base.pcert0 : acl2x = 0
-centaur/gl/eval-g-base.pcert0 : \
-     centaur/gl/defapply.pcert0 \
-     centaur/gl/generic-geval.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/eval-g-base.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/eval-g-base.pcert1 : acl2x = 0
-centaur/gl/eval-g-base.pcert1 : no_pcert = 0
-centaur/gl/eval-g-base.pcert1 : centaur/gl/eval-g-base.pcert0
-centaur/gl/eval-g-base.cert : | centaur/gl/eval-g-base.pcert1
-
-centaur/gl/factor-fns.pcert0 : no_pcert = 0
-centaur/gl/factor-fns.pcert0 : acl2x = 0
-centaur/gl/factor-fns.pcert0 : \
-     tools/bstar.pcert0 \
-     centaur/gl/rws.pcert0 \
-     clause-processors/generalize.pcert0 \
-     misc/hons-help.pcert0 \
-     centaur/gl/gl-util.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/factor-fns.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/factor-fns.pcert1 : acl2x = 0
-centaur/gl/factor-fns.pcert1 : no_pcert = 0
-centaur/gl/factor-fns.pcert1 : centaur/gl/factor-fns.pcert0
-centaur/gl/factor-fns.cert : | centaur/gl/factor-fns.pcert1
-
-centaur/gl/g-always-equal.pcert0 : no_pcert = 0
-centaur/gl/g-always-equal.pcert0 : acl2x = 0
-centaur/gl/g-always-equal.pcert0 : \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/always-equal-prep.pcert0 \
-     centaur/gl/g-equal.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-always-equal.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-always-equal.pcert1 : acl2x = 0
-centaur/gl/g-always-equal.pcert1 : no_pcert = 0
-centaur/gl/g-always-equal.pcert1 : centaur/gl/g-always-equal.pcert0
-centaur/gl/g-always-equal.cert : | centaur/gl/g-always-equal.pcert1
-
-centaur/gl/g-ash.pcert0 : no_pcert = 0
-centaur/gl/g-ash.pcert0 : acl2x = 0
-centaur/gl/g-ash.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-ash.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-ash.pcert1 : acl2x = 0
-centaur/gl/g-ash.pcert1 : no_pcert = 0
-centaur/gl/g-ash.pcert1 : centaur/gl/g-ash.pcert0
-centaur/gl/g-ash.cert : | centaur/gl/g-ash.pcert1
-
-centaur/gl/g-binary-+.pcert0 : no_pcert = 0
-centaur/gl/g-binary-+.pcert0 : acl2x = 0
-centaur/gl/g-binary-+.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-binary-+.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-binary-+.pcert1 : acl2x = 0
-centaur/gl/g-binary-+.pcert1 : no_pcert = 0
-centaur/gl/g-binary-+.pcert1 : centaur/gl/g-binary-+.pcert0
-centaur/gl/g-binary-+.cert : | centaur/gl/g-binary-+.pcert1
-
-centaur/gl/g-binary-mult.pcert0 : no_pcert = 0
-centaur/gl/g-binary-mult.pcert0 : acl2x = 0
-centaur/gl/g-binary-mult.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-binary-mult.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-binary-mult.pcert1 : acl2x = 0
-centaur/gl/g-binary-mult.pcert1 : no_pcert = 0
-centaur/gl/g-binary-mult.pcert1 : centaur/gl/g-binary-mult.pcert0
-centaur/gl/g-binary-mult.cert : | centaur/gl/g-binary-mult.pcert1
-
-centaur/gl/g-code-char.pcert0 : no_pcert = 0
-centaur/gl/g-code-char.pcert0 : acl2x = 0
-centaur/gl/g-code-char.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/g-lessthan.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-code-char.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-code-char.pcert1 : acl2x = 0
-centaur/gl/g-code-char.pcert1 : no_pcert = 0
-centaur/gl/g-code-char.pcert1 : centaur/gl/g-code-char.pcert0
-centaur/gl/g-code-char.cert : | centaur/gl/g-code-char.pcert1
-
-centaur/gl/g-coerce.pcert0 : no_pcert = 0
-centaur/gl/g-coerce.pcert0 : acl2x = 0
-centaur/gl/g-coerce.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-coerce.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-coerce.pcert1 : acl2x = 0
-centaur/gl/g-coerce.pcert1 : no_pcert = 0
-centaur/gl/g-coerce.pcert1 : centaur/gl/g-coerce.pcert0
-centaur/gl/g-coerce.cert : | centaur/gl/g-coerce.pcert1
-
-centaur/gl/g-cons.pcert0 : no_pcert = 0
-centaur/gl/g-cons.pcert0 : acl2x = 0
-centaur/gl/g-cons.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-cons.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-cons.pcert1 : acl2x = 0
-centaur/gl/g-cons.pcert1 : no_pcert = 0
-centaur/gl/g-cons.pcert1 : centaur/gl/g-cons.pcert0
-centaur/gl/g-cons.cert : | centaur/gl/g-cons.pcert1
-
-centaur/gl/g-equal.pcert0 : no_pcert = 0
-centaur/gl/g-equal.pcert0 : acl2x = 0
-centaur/gl/g-equal.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-equal.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-equal.pcert1 : acl2x = 0
-centaur/gl/g-equal.pcert1 : no_pcert = 0
-centaur/gl/g-equal.pcert1 : centaur/gl/g-equal.pcert0
-centaur/gl/g-equal.cert : | centaur/gl/g-equal.pcert1
-
-centaur/gl/g-floor.pcert0 : no_pcert = 0
-centaur/gl/g-floor.pcert0 : acl2x = 0
-centaur/gl/g-floor.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-floor.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-floor.pcert1 : acl2x = 0
-centaur/gl/g-floor.pcert1 : no_pcert = 0
-centaur/gl/g-floor.pcert1 : centaur/gl/g-floor.pcert0
-centaur/gl/g-floor.cert : | centaur/gl/g-floor.pcert1
-
-centaur/gl/g-gl-mbe.pcert0 : no_pcert = 0
-centaur/gl/g-gl-mbe.pcert0 : acl2x = 0
-centaur/gl/g-gl-mbe.pcert0 : \
-     centaur/gl/bfr-sat.pcert0 \
-     centaur/gl/g-always-equal.pcert0 \
-     centaur/gl/gl-mbe.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-gl-mbe.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-gl-mbe.pcert1 : acl2x = 0
-centaur/gl/g-gl-mbe.pcert1 : no_pcert = 0
-centaur/gl/g-gl-mbe.pcert1 : centaur/gl/g-gl-mbe.pcert0
-centaur/gl/g-gl-mbe.cert : | centaur/gl/g-gl-mbe.pcert1
-
-centaur/gl/g-hide.pcert0 : no_pcert = 0
-centaur/gl/g-hide.pcert0 : acl2x = 0
-centaur/gl/g-hide.pcert0 : \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/gobjectp-thms.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-hide.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-hide.pcert1 : acl2x = 0
-centaur/gl/g-hide.pcert1 : no_pcert = 0
-centaur/gl/g-hide.pcert1 : centaur/gl/g-hide.pcert0
-centaur/gl/g-hide.cert : | centaur/gl/g-hide.pcert1
-
-centaur/gl/g-if.pcert0 : no_pcert = 0
-centaur/gl/g-if.pcert0 : acl2x = 0
-centaur/gl/g-if.pcert0 : \
-     centaur/gl/ite-merge.pcert0 \
-     centaur/gl/gtests.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-if.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-if.pcert1 : acl2x = 0
-centaur/gl/g-if.pcert1 : no_pcert = 0
-centaur/gl/g-if.pcert1 : centaur/gl/g-if.pcert0
-centaur/gl/g-if.cert : | centaur/gl/g-if.pcert1
-
-centaur/gl/g-integer-length.pcert0 : no_pcert = 0
-centaur/gl/g-integer-length.pcert0 : acl2x = 0
-centaur/gl/g-integer-length.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-integer-length.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-integer-length.pcert1 : acl2x = 0
-centaur/gl/g-integer-length.pcert1 : no_pcert = 0
-centaur/gl/g-integer-length.pcert1 : centaur/gl/g-integer-length.pcert0
-centaur/gl/g-integer-length.cert : | centaur/gl/g-integer-length.pcert1
-
-centaur/gl/g-intern.pcert0 : no_pcert = 0
-centaur/gl/g-intern.pcert0 : acl2x = 0
-centaur/gl/g-intern.pcert0 : \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-intern.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-intern.pcert1 : acl2x = 0
-centaur/gl/g-intern.pcert1 : no_pcert = 0
-centaur/gl/g-intern.pcert1 : centaur/gl/g-intern.pcert0
-centaur/gl/g-intern.cert : | centaur/gl/g-intern.pcert1
-
-centaur/gl/g-lessthan.pcert0 : no_pcert = 0
-centaur/gl/g-lessthan.pcert0 : acl2x = 0
-centaur/gl/g-lessthan.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-lessthan.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-lessthan.pcert1 : acl2x = 0
-centaur/gl/g-lessthan.pcert1 : no_pcert = 0
-centaur/gl/g-lessthan.pcert1 : centaur/gl/g-lessthan.pcert0
-centaur/gl/g-lessthan.cert : | centaur/gl/g-lessthan.pcert1
-
-centaur/gl/g-logand.pcert0 : no_pcert = 0
-centaur/gl/g-logand.pcert0 : acl2x = 0
-centaur/gl/g-logand.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-logand.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-logand.pcert1 : acl2x = 0
-centaur/gl/g-logand.pcert1 : no_pcert = 0
-centaur/gl/g-logand.pcert1 : centaur/gl/g-logand.pcert0
-centaur/gl/g-logand.cert : | centaur/gl/g-logand.pcert1
-
-centaur/gl/g-logbitp.pcert0 : no_pcert = 0
-centaur/gl/g-logbitp.pcert0 : acl2x = 0
-centaur/gl/g-logbitp.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-logbitp.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-logbitp.pcert1 : acl2x = 0
-centaur/gl/g-logbitp.pcert1 : no_pcert = 0
-centaur/gl/g-logbitp.pcert1 : centaur/gl/g-logbitp.pcert0
-centaur/gl/g-logbitp.cert : | centaur/gl/g-logbitp.pcert1
-
-centaur/gl/g-logior.pcert0 : no_pcert = 0
-centaur/gl/g-logior.pcert0 : acl2x = 0
-centaur/gl/g-logior.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-logior.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-logior.pcert1 : acl2x = 0
-centaur/gl/g-logior.pcert1 : no_pcert = 0
-centaur/gl/g-logior.pcert1 : centaur/gl/g-logior.pcert0
-centaur/gl/g-logior.cert : | centaur/gl/g-logior.pcert1
-
-centaur/gl/g-lognot.pcert0 : no_pcert = 0
-centaur/gl/g-lognot.pcert0 : acl2x = 0
-centaur/gl/g-lognot.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-lognot.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-lognot.pcert1 : acl2x = 0
-centaur/gl/g-lognot.pcert1 : no_pcert = 0
-centaur/gl/g-lognot.pcert1 : centaur/gl/g-lognot.pcert0
-centaur/gl/g-lognot.cert : | centaur/gl/g-lognot.pcert1
-
-centaur/gl/g-make-fast-alist.pcert0 : no_pcert = 0
-centaur/gl/g-make-fast-alist.pcert0 : acl2x = 0
-centaur/gl/g-make-fast-alist.pcert0 : \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-make-fast-alist.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-make-fast-alist.pcert1 : acl2x = 0
-centaur/gl/g-make-fast-alist.pcert1 : no_pcert = 0
-centaur/gl/g-make-fast-alist.pcert1 : centaur/gl/g-make-fast-alist.pcert0
-centaur/gl/g-make-fast-alist.cert : | centaur/gl/g-make-fast-alist.pcert1
-
-centaur/gl/g-mod.pcert0 : no_pcert = 0
-centaur/gl/g-mod.pcert0 : acl2x = 0
-centaur/gl/g-mod.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-mod.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-mod.pcert1 : acl2x = 0
-centaur/gl/g-mod.pcert1 : no_pcert = 0
-centaur/gl/g-mod.pcert1 : centaur/gl/g-mod.pcert0
-centaur/gl/g-mod.cert : | centaur/gl/g-mod.pcert1
-
-centaur/gl/g-predicates.pcert0 : no_pcert = 0
-centaur/gl/g-predicates.pcert0 : acl2x = 0
-centaur/gl/g-predicates.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-predicates.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-predicates.pcert1 : acl2x = 0
-centaur/gl/g-predicates.pcert1 : no_pcert = 0
-centaur/gl/g-predicates.pcert1 : centaur/gl/g-predicates.pcert0
-centaur/gl/g-predicates.cert : | centaur/gl/g-predicates.pcert1
-
-centaur/gl/g-primitives-help.pcert0 : no_pcert = 0
-centaur/gl/g-primitives-help.pcert0 : acl2x = 0
-centaur/gl/g-primitives-help.pcert0 : \
-     tools/flag.pcert0 \
-     centaur/gl/gl-util.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-primitives-help.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-primitives-help.pcert1 : acl2x = 0
-centaur/gl/g-primitives-help.pcert1 : no_pcert = 0
-centaur/gl/g-primitives-help.pcert1 : centaur/gl/g-primitives-help.pcert0
-centaur/gl/g-primitives-help.cert : | centaur/gl/g-primitives-help.pcert1
-
-centaur/gl/g-rem.pcert0 : no_pcert = 0
-centaur/gl/g-rem.pcert0 : acl2x = 0
-centaur/gl/g-rem.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-rem.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-rem.pcert1 : acl2x = 0
-centaur/gl/g-rem.pcert1 : no_pcert = 0
-centaur/gl/g-rem.pcert1 : centaur/gl/g-rem.pcert0
-centaur/gl/g-rem.cert : | centaur/gl/g-rem.pcert1
-
-centaur/gl/g-truncate.pcert0 : no_pcert = 0
-centaur/gl/g-truncate.pcert0 : acl2x = 0
-centaur/gl/g-truncate.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-truncate.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-truncate.pcert1 : acl2x = 0
-centaur/gl/g-truncate.pcert1 : no_pcert = 0
-centaur/gl/g-truncate.pcert1 : centaur/gl/g-truncate.pcert0
-centaur/gl/g-truncate.cert : | centaur/gl/g-truncate.pcert1
-
-centaur/gl/g-unary--.pcert0 : no_pcert = 0
-centaur/gl/g-unary--.pcert0 : acl2x = 0
-centaur/gl/g-unary--.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-unary--.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-unary--.pcert1 : acl2x = 0
-centaur/gl/g-unary--.pcert1 : no_pcert = 0
-centaur/gl/g-unary--.pcert1 : centaur/gl/g-unary--.pcert0
-centaur/gl/g-unary--.cert : | centaur/gl/g-unary--.pcert1
-
-centaur/gl/g-unary-concrete.pcert0 : no_pcert = 0
-centaur/gl/g-unary-concrete.pcert0 : acl2x = 0
-centaur/gl/g-unary-concrete.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     centaur/gl/eval-g-base.pcert0 \
-     centaur/gl/symbolic-arithmetic.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/g-unary-concrete.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/g-unary-concrete.pcert1 : acl2x = 0
-centaur/gl/g-unary-concrete.pcert1 : no_pcert = 0
-centaur/gl/g-unary-concrete.pcert1 : centaur/gl/g-unary-concrete.pcert0
-centaur/gl/g-unary-concrete.cert : | centaur/gl/g-unary-concrete.pcert1
-
-centaur/gl/general-object-thms.pcert0 : no_pcert = 0
-centaur/gl/general-object-thms.pcert0 : acl2x = 0
-centaur/gl/general-object-thms.pcert0 : \
-     centaur/gl/gtype-thms.pcert0 \
-     centaur/gl/general-objects.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/general-object-thms.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/general-object-thms.pcert1 : acl2x = 0
-centaur/gl/general-object-thms.pcert1 : no_pcert = 0
-centaur/gl/general-object-thms.pcert1 : centaur/gl/general-object-thms.pcert0
-centaur/gl/general-object-thms.cert : | centaur/gl/general-object-thms.pcert1
-
-centaur/gl/general-objects.pcert0 : no_pcert = 0
-centaur/gl/general-objects.pcert0 : acl2x = 0
-centaur/gl/general-objects.pcert0 : \
-     centaur/gl/gtypes.pcert0 \
-     centaur/gl/gobjectp-thms.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/general-objects.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/general-objects.pcert1 : acl2x = 0
-centaur/gl/general-objects.pcert1 : no_pcert = 0
-centaur/gl/general-objects.pcert1 : centaur/gl/general-objects.pcert0
-centaur/gl/general-objects.cert : | centaur/gl/general-objects.pcert1
-
-centaur/gl/generic-geval.pcert0 : no_pcert = 0
-centaur/gl/generic-geval.pcert0 : acl2x = 0
-centaur/gl/generic-geval.pcert0 : \
-     centaur/gl/gobjectp.pcert0 \
-     centaur/gl/bvecs.pcert0 \
-     tools/bstar.pcert0 \
-     centaur/gl/gobjectp-thms.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/generic-geval.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/generic-geval.pcert1 : acl2x = 0
-centaur/gl/generic-geval.pcert1 : no_pcert = 0
-centaur/gl/generic-geval.pcert1 : centaur/gl/generic-geval.pcert0
-centaur/gl/generic-geval.cert : | centaur/gl/generic-geval.pcert1
-
-centaur/gl/gify-clause-proc.pcert0 : no_pcert = 0
-centaur/gl/gify-clause-proc.pcert0 : acl2x = 0
-centaur/gl/gify-clause-proc.pcert0 : \
-     centaur/gl/g-if.pcert0 \
-     clause-processors/unify-subst.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     tools/defevaluator-fast.pcert0 \
-     centaur/gl/gtype-thms.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gify-clause-proc.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gify-clause-proc.pcert1 : acl2x = 0
-centaur/gl/gify-clause-proc.pcert1 : no_pcert = 0
-centaur/gl/gify-clause-proc.pcert1 : centaur/gl/gify-clause-proc.pcert0
-centaur/gl/gify-clause-proc.cert : | centaur/gl/gify-clause-proc.pcert1
-
-centaur/gl/gify-thms.pcert0 : no_pcert = 0
-centaur/gl/gify-thms.pcert0 : acl2x = 0
-centaur/gl/gify-thms.pcert0 : \
-     centaur/gl/gify-clause-proc.pcert0 \
-     centaur/gl/gtype-thms.pcert0 \
-     centaur/gl/gobjectp-thms.pcert0 \
-     centaur/gl/general-object-thms.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gify-thms.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gify-thms.pcert1 : acl2x = 0
-centaur/gl/gify-thms.pcert1 : no_pcert = 0
-centaur/gl/gify-thms.pcert1 : centaur/gl/gify-thms.pcert0
-centaur/gl/gify-thms.cert : | centaur/gl/gify-thms.pcert1
-
-centaur/gl/gify.pcert0 : no_pcert = 0
-centaur/gl/gify.pcert0 : acl2x = 0
-centaur/gl/gify.pcert0 : \
-     tools/bstar.pcert0 \
-     centaur/gl/defapply.pcert0 \
-     misc/hons-help.pcert0 \
-     centaur/gl/factor-fns.pcert0 \
-     centaur/gl/g-primitives-help.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gify.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gify.pcert1 : acl2x = 0
-centaur/gl/gify.pcert1 : no_pcert = 0
-centaur/gl/gify.pcert1 : centaur/gl/gify.pcert0
-centaur/gl/gify.cert : | centaur/gl/gify.pcert1
-
-centaur/gl/gl-doc-string.pcert0 : no_pcert = 0
-centaur/gl/gl-doc-string.pcert0 : acl2x = 0
-centaur/gl/gl-doc-string.pcert0 : \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gl-doc-string.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gl-doc-string.pcert1 : acl2x = 0
-centaur/gl/gl-doc-string.pcert1 : no_pcert = 0
-centaur/gl/gl-doc-string.pcert1 : centaur/gl/gl-doc-string.pcert0
-centaur/gl/gl-doc-string.cert : | centaur/gl/gl-doc-string.pcert1
-
-centaur/gl/gl-generic-clause-proc.pcert0 : no_pcert = 0
-centaur/gl/gl-generic-clause-proc.pcert0 : acl2x = 0
-centaur/gl/gl-generic-clause-proc.pcert0 : \
-     centaur/gl/param.pcert0 \
-     centaur/gl/g-if.pcert0 \
-     centaur/gl/gify.pcert0 \
-     centaur/gl/bfr-sat.pcert0 \
-     centaur/gl/glcp-templates.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     data-structures/no-duplicates.pcert0 \
-     clause-processors/use-by-hint.pcert0 \
-     clause-processors/decomp-hint.pcert0 \
-     centaur/misc/interp-function-lookup.pcert0 \
-     centaur/gl/general-object-thms.pcert0 \
-     centaur/misc/hons-sets.pcert0 \
-     tools/with-quoted-forms.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     system/f-put-global.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     centaur/misc/vecs-ints.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gl-generic-clause-proc.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gl-generic-clause-proc.pcert1 : acl2x = 0
-centaur/gl/gl-generic-clause-proc.pcert1 : no_pcert = 0
-centaur/gl/gl-generic-clause-proc.pcert1 : centaur/gl/gl-generic-clause-proc.pcert0
-centaur/gl/gl-generic-clause-proc.cert : | centaur/gl/gl-generic-clause-proc.pcert1
-
-centaur/gl/gl-mbe.pcert0 : no_pcert = 0
-centaur/gl/gl-mbe.pcert0 : acl2x = 0
-centaur/gl/gl-mbe.pcert0 : \
-     centaur/gl/gl-doc-string.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gl-mbe.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gl-mbe.pcert1 : acl2x = 0
-centaur/gl/gl-mbe.pcert1 : no_pcert = 0
-centaur/gl/gl-mbe.pcert1 : centaur/gl/gl-mbe.pcert0
-centaur/gl/gl-mbe.cert : | centaur/gl/gl-mbe.pcert1
-
-centaur/gl/gl-misc-defs.pcert0 : no_pcert = 0
-centaur/gl/gl-misc-defs.pcert0 : acl2x = 0
-centaur/gl/gl-misc-defs.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gl-misc-defs.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gl-misc-defs.pcert1 : acl2x = 0
-centaur/gl/gl-misc-defs.pcert1 : no_pcert = 0
-centaur/gl/gl-misc-defs.pcert1 : centaur/gl/gl-misc-defs.pcert0
-centaur/gl/gl-misc-defs.cert : | centaur/gl/gl-misc-defs.pcert1
-
-centaur/gl/gl-misc-doc.pcert0 : no_pcert = 0
-centaur/gl/gl-misc-doc.pcert0 : acl2x = 0
-centaur/gl/gl-misc-doc.pcert0 : \
-     centaur/gl/gl-doc-string.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gl-misc-doc.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gl-misc-doc.pcert1 : acl2x = 0
-centaur/gl/gl-misc-doc.pcert1 : no_pcert = 0
-centaur/gl/gl-misc-doc.pcert1 : centaur/gl/gl-misc-doc.pcert0
-centaur/gl/gl-misc-doc.cert : | centaur/gl/gl-misc-doc.pcert1
-
-centaur/gl/gl-util.pcert0 : no_pcert = 0
-centaur/gl/gl-util.pcert0 : acl2x = 0
-centaur/gl/gl-util.pcert0 : \
-     tools/flag.pcert0 \
-     tools/bstar.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gl-util.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gl-util.pcert1 : acl2x = 0
-centaur/gl/gl-util.pcert1 : no_pcert = 0
-centaur/gl/gl-util.pcert1 : centaur/gl/gl-util.pcert0
-centaur/gl/gl-util.cert : | centaur/gl/gl-util.pcert1
-
-centaur/gl/gl.pcert0 : no_pcert = 0
-centaur/gl/gl.pcert0 : acl2x = 0
-centaur/gl/gl.pcert0 : \
-     centaur/gl/g-ash.pcert0 \
-     centaur/gl/g-binary-+.pcert0 \
-     centaur/gl/g-cons.pcert0 \
-     centaur/gl/g-equal.pcert0 \
-     centaur/gl/g-always-equal.pcert0 \
-     centaur/gl/g-integer-length.pcert0 \
-     centaur/gl/g-lessthan.pcert0 \
-     centaur/gl/g-logand.pcert0 \
-     centaur/gl/g-logior.pcert0 \
-     centaur/gl/g-lognot.pcert0 \
-     centaur/gl/g-logbitp.pcert0 \
-     centaur/gl/g-unary--.pcert0 \
-     centaur/gl/g-hide.pcert0 \
-     centaur/gl/g-predicates.pcert0 \
-     centaur/gl/g-binary-mult.pcert0 \
-     centaur/gl/g-floor.pcert0 \
-     centaur/gl/g-make-fast-alist.pcert0 \
-     centaur/gl/g-mod.pcert0 \
-     centaur/gl/g-truncate.pcert0 \
-     centaur/gl/g-rem.pcert0 \
-     centaur/gl/g-unary-concrete.pcert0 \
-     centaur/gl/g-coerce.pcert0 \
-     centaur/gl/g-code-char.pcert0 \
-     centaur/gl/g-intern.pcert0 \
-     centaur/gl/gl-misc-defs.pcert0 \
-     centaur/gl/eval-f-i-cp.pcert0 \
-     centaur/gl/gl-generic-clause-proc.pcert0 \
-     centaur/gl/def-gl-clause-proc.pcert0 \
-     centaur/gl/gify-thms.pcert0 \
-     centaur/gl/gl-misc-doc.pcert0 \
-     centaur/gl/auto-bindings.pcert0 \
-     centaur/gl/g-gl-mbe.pcert0 \
-     centaur/gl/general-object-thms.pcert0 \
-     centaur/gl/eval-g-base-help.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gl.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gl.pcert1 : acl2x = 0
-centaur/gl/gl.pcert1 : no_pcert = 0
-centaur/gl/gl.pcert1 : centaur/gl/gl.pcert0
-centaur/gl/gl.cert : | centaur/gl/gl.pcert1
-
-centaur/gl/glcp-templates.pcert0 : no_pcert = 0
-centaur/gl/glcp-templates.pcert0 : acl2x = 0
-centaur/gl/glcp-templates.pcert0 : \
-     tools/flag.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/glcp-templates.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/glcp-templates.pcert1 : acl2x = 0
-centaur/gl/glcp-templates.pcert1 : no_pcert = 0
-centaur/gl/glcp-templates.pcert1 : centaur/gl/glcp-templates.pcert0
-centaur/gl/glcp-templates.cert : | centaur/gl/glcp-templates.pcert1
-
-centaur/gl/gobject-type-thms.pcert0 : no_pcert = 0
-centaur/gl/gobject-type-thms.pcert0 : acl2x = 0
-centaur/gl/gobject-type-thms.pcert0 : \
-     centaur/gl/defagg.pcert0 \
-     tools/pattern-match.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     tools/rulesets.pcert0 \
-     centaur/gl/gobject-types.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gobject-type-thms.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gobject-type-thms.pcert1 : acl2x = 0
-centaur/gl/gobject-type-thms.pcert1 : no_pcert = 0
-centaur/gl/gobject-type-thms.pcert1 : centaur/gl/gobject-type-thms.pcert0
-centaur/gl/gobject-type-thms.cert : | centaur/gl/gobject-type-thms.pcert1
-
-centaur/gl/gobject-types.pcert0 : no_pcert = 0
-centaur/gl/gobject-types.pcert0 : acl2x = 0
-centaur/gl/gobject-types.pcert0 : \
-     centaur/gl/defagg.pcert0 \
-     tools/pattern-match.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gobject-types.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gobject-types.pcert1 : acl2x = 0
-centaur/gl/gobject-types.pcert1 : no_pcert = 0
-centaur/gl/gobject-types.pcert1 : centaur/gl/gobject-types.pcert0
-centaur/gl/gobject-types.cert : | centaur/gl/gobject-types.pcert1
-
-centaur/gl/gobjectp-thms.pcert0 : no_pcert = 0
-centaur/gl/gobjectp-thms.pcert0 : acl2x = 0
-centaur/gl/gobjectp-thms.pcert0 : \
-     centaur/gl/gobjectp.pcert0 \
-     centaur/gl/gobject-type-thms.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gobjectp-thms.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gobjectp-thms.pcert1 : acl2x = 0
-centaur/gl/gobjectp-thms.pcert1 : no_pcert = 0
-centaur/gl/gobjectp-thms.pcert1 : centaur/gl/gobjectp-thms.pcert0
-centaur/gl/gobjectp-thms.cert : | centaur/gl/gobjectp-thms.pcert1
-
-centaur/gl/gobjectp.pcert0 : no_pcert = 0
-centaur/gl/gobjectp.pcert0 : acl2x = 0
-centaur/gl/gobjectp.pcert0 : \
-     centaur/gl/bfr.pcert0 \
-     centaur/gl/defagg.pcert0 \
-     tools/pattern-match.pcert0 \
-     centaur/gl/bvecs.pcert0 \
-     centaur/gl/gobject-types.pcert0 \
-     centaur/gl/gobject-type-thms.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gobjectp.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gobjectp.pcert1 : acl2x = 0
-centaur/gl/gobjectp.pcert1 : no_pcert = 0
-centaur/gl/gobjectp.pcert1 : centaur/gl/gobjectp.pcert0
-centaur/gl/gobjectp.cert : | centaur/gl/gobjectp.pcert1
-
-centaur/gl/gtests.pcert0 : no_pcert = 0
-centaur/gl/gtests.pcert0 : acl2x = 0
-centaur/gl/gtests.pcert0 : \
-     centaur/gl/hyp-fix.pcert0 \
-     centaur/gl/gtypes.pcert0 \
-     centaur/gl/gtype-thms.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     tools/mv-nth.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gtests.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gtests.pcert1 : acl2x = 0
-centaur/gl/gtests.pcert1 : no_pcert = 0
-centaur/gl/gtests.pcert1 : centaur/gl/gtests.pcert0
-centaur/gl/gtests.cert : | centaur/gl/gtests.pcert1
-
-centaur/gl/gtype-thms.pcert0 : no_pcert = 0
-centaur/gl/gtype-thms.pcert0 : acl2x = 0
-centaur/gl/gtype-thms.pcert0 : \
-     centaur/gl/gtypes.pcert0 \
-     centaur/gl/gobjectp-thms.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gtype-thms.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gtype-thms.pcert1 : acl2x = 0
-centaur/gl/gtype-thms.pcert1 : no_pcert = 0
-centaur/gl/gtype-thms.pcert1 : centaur/gl/gtype-thms.pcert0
-centaur/gl/gtype-thms.cert : | centaur/gl/gtype-thms.pcert1
-
-centaur/gl/gtypes.pcert0 : no_pcert = 0
-centaur/gl/gtypes.pcert0 : acl2x = 0
-centaur/gl/gtypes.pcert0 : \
-     centaur/gl/gobjectp.pcert0 \
-     centaur/gl/generic-geval.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/gtypes.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/gtypes.pcert1 : acl2x = 0
-centaur/gl/gtypes.pcert1 : no_pcert = 0
-centaur/gl/gtypes.pcert1 : centaur/gl/gtypes.pcert0
-centaur/gl/gtypes.cert : | centaur/gl/gtypes.pcert1
-
-centaur/gl/hyp-fix-logic.pcert0 : no_pcert = 0
-centaur/gl/hyp-fix-logic.pcert0 : acl2x = 0
-centaur/gl/hyp-fix-logic.pcert0 : \
-     centaur/gl/hyp-fix.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/hyp-fix-logic.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/hyp-fix-logic.pcert1 : acl2x = 0
-centaur/gl/hyp-fix-logic.pcert1 : no_pcert = 0
-centaur/gl/hyp-fix-logic.pcert1 : centaur/gl/hyp-fix-logic.pcert0
-centaur/gl/hyp-fix-logic.cert : | centaur/gl/hyp-fix-logic.pcert1
-
-centaur/gl/hyp-fix.pcert0 : no_pcert = 0
-centaur/gl/hyp-fix.pcert0 : acl2x = 0
-centaur/gl/hyp-fix.pcert0 : \
-     centaur/gl/bfr.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/hyp-fix.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/hyp-fix.pcert1 : acl2x = 0
-centaur/gl/hyp-fix.pcert1 : no_pcert = 0
-centaur/gl/hyp-fix.pcert1 : centaur/gl/hyp-fix.pcert0
-centaur/gl/hyp-fix.cert : | centaur/gl/hyp-fix.pcert1
-
-centaur/gl/ite-merge.pcert0 : no_pcert = 0
-centaur/gl/ite-merge.pcert0 : acl2x = 0
-centaur/gl/ite-merge.pcert0 : \
-     centaur/gl/general-objects.pcert0 \
-     centaur/gl/general-object-thms.pcert0 \
-     centaur/gl/hyp-fix-logic.pcert0 \
-     centaur/gl/bvec-ite.pcert0 \
-     centaur/gl/hyp-fix.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     tools/mv-nth.pcert0 \
-     misc/invariants.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/ite-merge.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/ite-merge.pcert1 : acl2x = 0
-centaur/gl/ite-merge.pcert1 : no_pcert = 0
-centaur/gl/ite-merge.pcert1 : centaur/gl/ite-merge.pcert0
-centaur/gl/ite-merge.cert : | centaur/gl/ite-merge.pcert1
-
-centaur/gl/param.pcert0 : no_pcert = 0
-centaur/gl/param.pcert0 : acl2x = 0
-centaur/gl/param.pcert0 : \
-     centaur/gl/shape-spec.pcert0 \
-     centaur/gl/gtype-thms.pcert0 \
-     data-structures/no-duplicates.pcert0 \
-     tools/mv-nth.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     centaur/ubdds/param.pcert0 \
-     centaur/ubdds/lite.pcert0 \
-     centaur/aig/misc.pcert0 \
-     centaur/aig/eval-restrict.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/param.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/param.pcert1 : acl2x = 0
-centaur/gl/param.pcert1 : no_pcert = 0
-centaur/gl/param.pcert1 : centaur/gl/param.pcert0
-centaur/gl/param.cert : | centaur/gl/param.pcert1
-
-centaur/gl/portcullis.pcert0 : no_pcert = 0
-centaur/gl/portcullis.pcert0 : acl2x = 0
-centaur/gl/portcullis.pcert0 : \
-     cutil/portcullis.pcert0 \
-     centaur/gl/portcullis.lisp \
-     centaur/gl/portcullis.acl2 \
-     centaur/gl/package.lsp \
-     centaur/vl/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     centaur/aignet/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     tools/flag-package.lsp \
-     centaur/satlink/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     tools/flag-package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     tools/flag-package.lsp
-centaur/gl/portcullis.pcert1 : acl2x = 0
-centaur/gl/portcullis.pcert1 : no_pcert = 0
-centaur/gl/portcullis.pcert1 : centaur/gl/portcullis.pcert0
-centaur/gl/portcullis.cert : | centaur/gl/portcullis.pcert1
-
-centaur/gl/run-gified-cp.pcert0 : no_pcert = 0
-centaur/gl/run-gified-cp.pcert0 : acl2x = 0
-centaur/gl/run-gified-cp.pcert0 : \
-     centaur/gl/bfr.pcert0 \
-     centaur/gl/gobjectp.pcert0 \
-     tools/mv-nth.pcert0 \
-     tools/bstar.pcert0 \
-     tools/defevaluator-fast.pcert0 \
-     clause-processors/unify-subst.pcert0 \
-     centaur/misc/evaluator-metatheorems.pcert0 \
-     centaur/misc/interp-function-lookup.pcert0 \
-     centaur/ubdds/witness.pcert0 \
-     std/lists/take.pcert0 \
-     centaur/gl/gobjectp-thms.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     centaur/gl/gl-util.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/run-gified-cp.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/run-gified-cp.pcert1 : acl2x = 0
-centaur/gl/run-gified-cp.pcert1 : no_pcert = 0
-centaur/gl/run-gified-cp.pcert1 : centaur/gl/run-gified-cp.pcert0
-centaur/gl/run-gified-cp.cert : | centaur/gl/run-gified-cp.pcert1
-
-centaur/gl/rws.pcert0 : no_pcert = 0
-centaur/gl/rws.pcert0 : acl2x = 0
-centaur/gl/rws.pcert0 : \
-     clause-processors/use-by-hint.pcert0 \
-     clause-processors/multi-env-trick.pcert0 \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     tools/flag.pcert0 \
-     tools/rulesets.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     centaur/misc/alist-equiv.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/rws.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/rws.pcert1 : acl2x = 0
-centaur/gl/rws.pcert1 : no_pcert = 0
-centaur/gl/rws.pcert1 : centaur/gl/rws.pcert0
-centaur/gl/rws.cert : | centaur/gl/rws.pcert1
-
-centaur/gl/shape-spec.pcert0 : no_pcert = 0
-centaur/gl/shape-spec.pcert0 : acl2x = 0
-centaur/gl/shape-spec.pcert0 : \
-     centaur/gl/gtypes.pcert0 \
-     centaur/gl/gl-doc-string.pcert0 \
-     centaur/gl/gtype-thms.pcert0 \
-     data-structures/no-duplicates.pcert0 \
-     tools/mv-nth.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/shape-spec.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/shape-spec.pcert1 : acl2x = 0
-centaur/gl/shape-spec.pcert1 : no_pcert = 0
-centaur/gl/shape-spec.pcert1 : centaur/gl/shape-spec.pcert0
-centaur/gl/shape-spec.cert : | centaur/gl/shape-spec.pcert1
-
-centaur/gl/symbolic-arithmetic-fns.pcert0 : no_pcert = 0
-centaur/gl/symbolic-arithmetic-fns.pcert0 : acl2x = 0
-centaur/gl/symbolic-arithmetic-fns.pcert0 : \
-     centaur/gl/bvec-ite.pcert0 \
-     tools/mv-nth.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/symbolic-arithmetic-fns.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/symbolic-arithmetic-fns.pcert1 : acl2x = 0
-centaur/gl/symbolic-arithmetic-fns.pcert1 : no_pcert = 0
-centaur/gl/symbolic-arithmetic-fns.pcert1 : centaur/gl/symbolic-arithmetic-fns.pcert0
-centaur/gl/symbolic-arithmetic-fns.cert : | centaur/gl/symbolic-arithmetic-fns.pcert1
-
-centaur/gl/symbolic-arithmetic.pcert0 : no_pcert = 0
-centaur/gl/symbolic-arithmetic.pcert0 : acl2x = 0
-centaur/gl/symbolic-arithmetic.pcert0 : \
-     centaur/gl/symbolic-arithmetic-fns.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     centaur/gl/portcullis.pcert0 \
-     centaur/gl/symbolic-arithmetic.lisp \
-     centaur/gl/cert.acl2
-centaur/gl/symbolic-arithmetic.pcert1 : acl2x = 0
-centaur/gl/symbolic-arithmetic.pcert1 : no_pcert = 0
-centaur/gl/symbolic-arithmetic.pcert1 : centaur/gl/symbolic-arithmetic.pcert0
-centaur/gl/symbolic-arithmetic.cert : | centaur/gl/symbolic-arithmetic.pcert1
-
-centaur/misc/absstobjs.pcert0 : no_pcert = 0
-centaur/misc/absstobjs.pcert0 : acl2x = 0
-centaur/misc/absstobjs.pcert0 : \
-     tools/bstar.pcert0 \
-     centaur/misc/absstobjs.lisp
-centaur/misc/absstobjs.pcert1 : acl2x = 0
-centaur/misc/absstobjs.pcert1 : no_pcert = 0
-centaur/misc/absstobjs.pcert1 : centaur/misc/absstobjs.pcert0
-centaur/misc/absstobjs.cert : | centaur/misc/absstobjs.pcert1
-
-centaur/misc/alist-defs.pcert0 : no_pcert = 0
-centaur/misc/alist-defs.pcert0 : acl2x = 0
-centaur/misc/alist-defs.pcert0 : \
-     misc/hons-help.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/misc/alist-defs.lisp
-centaur/misc/alist-defs.pcert1 : acl2x = 0
-centaur/misc/alist-defs.pcert1 : no_pcert = 0
-centaur/misc/alist-defs.pcert1 : centaur/misc/alist-defs.pcert0
-centaur/misc/alist-defs.cert : | centaur/misc/alist-defs.pcert1
-
-centaur/misc/alist-equiv.pcert0 : no_pcert = 0
-centaur/misc/alist-equiv.pcert0 : acl2x = 0
-centaur/misc/alist-equiv.pcert0 : \
-     misc/hons-help2.pcert0 \
-     cutil/defsection.pcert0 \
-     centaur/misc/alist-defs.pcert0 \
-     std/lists/sets.pcert0 \
-     centaur/misc/alist-equiv.lisp
-centaur/misc/alist-equiv.pcert1 : acl2x = 0
-centaur/misc/alist-equiv.pcert1 : no_pcert = 0
-centaur/misc/alist-equiv.pcert1 : centaur/misc/alist-equiv.pcert0
-centaur/misc/alist-equiv.cert : | centaur/misc/alist-equiv.pcert1
-
-centaur/misc/alist-witness.pcert0 : no_pcert = 0
-centaur/misc/alist-witness.pcert0 : acl2x = 0
-centaur/misc/alist-witness.pcert0 : \
-     centaur/misc/alist-equiv.pcert0 \
-     centaur/misc/witness-cp.pcert0 \
-     centaur/misc/alist-witness.lisp
-centaur/misc/alist-witness.pcert1 : acl2x = 0
-centaur/misc/alist-witness.pcert1 : no_pcert = 0
-centaur/misc/alist-witness.pcert1 : centaur/misc/alist-witness.pcert0
-centaur/misc/alist-witness.cert : | centaur/misc/alist-witness.pcert1
-
-centaur/misc/ap.pcert0 : no_pcert = 0
-centaur/misc/ap.pcert0 : acl2x = 0
-centaur/misc/ap.pcert0 : \
-     centaur/misc/ap.lisp
-centaur/misc/ap.pcert1 : acl2x = 0
-centaur/misc/ap.pcert1 : no_pcert = 0
-centaur/misc/ap.pcert1 : centaur/misc/ap.pcert0
-centaur/misc/ap.cert : | centaur/misc/ap.pcert1
-
-centaur/misc/arith-equivs.pcert0 : no_pcert = 0
-centaur/misc/arith-equivs.pcert0 : acl2x = 0
-centaur/misc/arith-equivs.pcert0 : \
-     ihs/basic-definitions.pcert0 \
-     tools/rulesets.pcert0 \
-     std/lists/mfc-utils.pcert0 \
-     centaur/misc/arith-equivs.lisp
-centaur/misc/arith-equivs.pcert1 : acl2x = 0
-centaur/misc/arith-equivs.pcert1 : no_pcert = 0
-centaur/misc/arith-equivs.pcert1 : centaur/misc/arith-equivs.pcert0
-centaur/misc/arith-equivs.cert : | centaur/misc/arith-equivs.pcert1
-
-centaur/misc/context-rw.pcert0 : no_pcert = 0
-centaur/misc/context-rw.pcert0 : acl2x = 0
-centaur/misc/context-rw.pcert0 : \
-     clause-processors/unify-subst.pcert0 \
-     centaur/misc/alist-witness.pcert0 \
-     clause-processors/meta-extract-user.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     clause-processors/sublis-var-meaning.pcert0 \
-     xdoc/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     centaur/misc/context-rw.lisp \
-     centaur/misc/context-rw.acl2
-centaur/misc/context-rw.pcert1 : acl2x = 0
-centaur/misc/context-rw.pcert1 : no_pcert = 0
-centaur/misc/context-rw.pcert1 : centaur/misc/context-rw.pcert0
-centaur/misc/context-rw.cert : | centaur/misc/context-rw.pcert1
-
-centaur/misc/defapply.pcert0 : no_pcert = 0
-centaur/misc/defapply.pcert0 : acl2x = 0
-centaur/misc/defapply.pcert0 : \
-     tools/bstar.pcert0 \
-     clause-processors/generalize.pcert0 \
-     tools/rulesets.pcert0 \
-     clause-processors/use-by-hint.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     tools/defevaluator-fast.pcert0 \
-     tools/mv-nth.pcert0 \
-     centaur/misc/evaluator-metatheorems.pcert0 \
-     centaur/misc/interp-function-lookup.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     tools/with-quoted-forms.pcert0 \
-     centaur/misc/defapply.lisp
-centaur/misc/defapply.pcert1 : acl2x = 0
-centaur/misc/defapply.pcert1 : no_pcert = 0
-centaur/misc/defapply.pcert1 : centaur/misc/defapply.pcert0
-centaur/misc/defapply.cert : | centaur/misc/defapply.pcert1
-
-centaur/misc/dfs-measure.pcert0 : no_pcert = 0
-centaur/misc/dfs-measure.pcert0 : acl2x = 0
-centaur/misc/dfs-measure.pcert0 : \
-     centaur/misc/suffixp.pcert0 \
-     tools/rulesets.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     misc/hons-help.pcert0 \
-     tools/bstar.pcert0 \
-     centaur/misc/dfs-measure.lisp
-centaur/misc/dfs-measure.pcert1 : acl2x = 0
-centaur/misc/dfs-measure.pcert1 : no_pcert = 0
-centaur/misc/dfs-measure.pcert1 : centaur/misc/dfs-measure.pcert0
-centaur/misc/dfs-measure.cert : | centaur/misc/dfs-measure.pcert1
-
-centaur/misc/equal-by-nths.pcert0 : no_pcert = 0
-centaur/misc/equal-by-nths.pcert0 : acl2x = 0
-centaur/misc/equal-by-nths.pcert0 : \
-     centaur/misc/equal-by-nths.lisp
-centaur/misc/equal-by-nths.pcert1 : acl2x = 0
-centaur/misc/equal-by-nths.pcert1 : no_pcert = 0
-centaur/misc/equal-by-nths.pcert1 : centaur/misc/equal-by-nths.pcert0
-centaur/misc/equal-by-nths.cert : | centaur/misc/equal-by-nths.pcert1
-
-centaur/misc/equal-sets.pcert0 : no_pcert = 0
-centaur/misc/equal-sets.pcert0 : acl2x = 0
-centaur/misc/equal-sets.pcert0 : \
-     finite-set-theory/osets/sets.pcert0 \
-     std/lists/sets.pcert0 \
-     centaur/misc/witness-cp.pcert0 \
-     centaur/misc/equal-sets.lisp \
-     centaur/misc/equal-sets.acl2 \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-centaur/misc/equal-sets.pcert1 : acl2x = 0
-centaur/misc/equal-sets.pcert1 : no_pcert = 0
-centaur/misc/equal-sets.pcert1 : centaur/misc/equal-sets.pcert0
-centaur/misc/equal-sets.cert : | centaur/misc/equal-sets.pcert1
-
-centaur/misc/evaluator-metatheorems.pcert0 : no_pcert = 0
-centaur/misc/evaluator-metatheorems.pcert0 : acl2x = 0
-centaur/misc/evaluator-metatheorems.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     clause-processors/use-by-hint.pcert0 \
-     tools/rulesets.pcert0 \
-     clause-processors/ev-theoremp.pcert0 \
-     centaur/misc/evaluator-metatheorems.lisp
-centaur/misc/evaluator-metatheorems.pcert1 : acl2x = 0
-centaur/misc/evaluator-metatheorems.pcert1 : no_pcert = 0
-centaur/misc/evaluator-metatheorems.pcert1 : centaur/misc/evaluator-metatheorems.pcert0
-centaur/misc/evaluator-metatheorems.cert : | centaur/misc/evaluator-metatheorems.pcert1
-
-centaur/misc/fal-graphs.pcert0 : no_pcert = 0
-centaur/misc/fal-graphs.pcert0 : acl2x = 0
-centaur/misc/fal-graphs.pcert0 : \
-     tools/bstar.pcert0 \
-     centaur/misc/fal-graphs.lisp
-centaur/misc/fal-graphs.pcert1 : acl2x = 0
-centaur/misc/fal-graphs.pcert1 : no_pcert = 0
-centaur/misc/fal-graphs.pcert1 : centaur/misc/fal-graphs.pcert0
-centaur/misc/fal-graphs.cert : | centaur/misc/fal-graphs.pcert1
-
-centaur/misc/fast-alists.pcert0 : no_pcert = 0
-centaur/misc/fast-alists.pcert0 : acl2x = 0
-centaur/misc/fast-alists.pcert0 : \
-     centaur/misc/alist-witness.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     centaur/misc/universal-equiv.pcert0 \
-     centaur/misc/fast-alists.lisp
-centaur/misc/fast-alists.pcert1 : acl2x = 0
-centaur/misc/fast-alists.pcert1 : no_pcert = 0
-centaur/misc/fast-alists.pcert1 : centaur/misc/fast-alists.pcert0
-centaur/misc/fast-alists.cert : | centaur/misc/fast-alists.pcert1
-
-centaur/misc/filter-alist.pcert0 : no_pcert = 0
-centaur/misc/filter-alist.pcert0 : acl2x = 0
-centaur/misc/filter-alist.pcert0 : \
-     centaur/misc/fast-alists.pcert0 \
-     std/lists/rev.pcert0 \
-     centaur/misc/filter-alist.lisp
-centaur/misc/filter-alist.pcert1 : acl2x = 0
-centaur/misc/filter-alist.pcert1 : no_pcert = 0
-centaur/misc/filter-alist.pcert1 : centaur/misc/filter-alist.pcert0
-centaur/misc/filter-alist.cert : | centaur/misc/filter-alist.pcert1
-
-centaur/misc/hons-alphorder-merge.pcert0 : no_pcert = 0
-centaur/misc/hons-alphorder-merge.pcert0 : acl2x = 0
-centaur/misc/hons-alphorder-merge.pcert0 : \
-     misc/total-order.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     centaur/misc/hons-alphorder-merge.lisp \
-     centaur/misc/hons-alphorder-merge.acl2
-centaur/misc/hons-alphorder-merge.pcert1 : acl2x = 0
-centaur/misc/hons-alphorder-merge.pcert1 : no_pcert = 0
-centaur/misc/hons-alphorder-merge.pcert1 : centaur/misc/hons-alphorder-merge.pcert0
-centaur/misc/hons-alphorder-merge.cert : | centaur/misc/hons-alphorder-merge.pcert1
-
-centaur/misc/hons-extra.pcert0 : no_pcert = 0
-centaur/misc/hons-extra.pcert0 : acl2x = 0
-centaur/misc/hons-extra.pcert0 : \
-     tools/bstar.pcert0 \
-     centaur/misc/hons-extra.lisp
-centaur/misc/hons-extra.pcert1 : acl2x = 0
-centaur/misc/hons-extra.pcert1 : no_pcert = 0
-centaur/misc/hons-extra.pcert1 : centaur/misc/hons-extra.pcert0
-centaur/misc/hons-extra.cert : | centaur/misc/hons-extra.pcert1
-
-centaur/misc/hons-remove-dups.pcert0 : no_pcert = 0
-centaur/misc/hons-remove-dups.pcert0 : acl2x = 0
-centaur/misc/hons-remove-dups.pcert0 : \
-     std/lists/rev.pcert0 \
-     centaur/misc/alist-equiv.pcert0 \
-     centaur/misc/hons-remove-dups.lisp
-centaur/misc/hons-remove-dups.pcert1 : acl2x = 0
-centaur/misc/hons-remove-dups.pcert1 : no_pcert = 0
-centaur/misc/hons-remove-dups.pcert1 : centaur/misc/hons-remove-dups.pcert0
-centaur/misc/hons-remove-dups.cert : | centaur/misc/hons-remove-dups.pcert1
-
-centaur/misc/hons-sets.pcert0 : no_pcert = 0
-centaur/misc/hons-sets.pcert0 : acl2x = 0
-centaur/misc/hons-sets.pcert0 : \
-     misc/hons-help2.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     centaur/misc/alist-defs.pcert0 \
-     centaur/misc/hons-sets.lisp
-centaur/misc/hons-sets.pcert1 : acl2x = 0
-centaur/misc/hons-sets.pcert1 : no_pcert = 0
-centaur/misc/hons-sets.pcert1 : centaur/misc/hons-sets.pcert0
-centaur/misc/hons-sets.cert : | centaur/misc/hons-sets.pcert1
-
-centaur/misc/interp-function-lookup.pcert0 : no_pcert = 0
-centaur/misc/interp-function-lookup.pcert0 : acl2x = 0
-centaur/misc/interp-function-lookup.pcert0 : \
-     centaur/misc/hons-sets.pcert0 \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     clause-processors/use-by-hint.pcert0 \
-     tools/rulesets.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     clause-processors/ev-theoremp.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     centaur/misc/interp-function-lookup.lisp
-centaur/misc/interp-function-lookup.pcert1 : acl2x = 0
-centaur/misc/interp-function-lookup.pcert1 : no_pcert = 0
-centaur/misc/interp-function-lookup.pcert1 : centaur/misc/interp-function-lookup.pcert0
-centaur/misc/interp-function-lookup.cert : | centaur/misc/interp-function-lookup.pcert1
-
-centaur/misc/introduce-var.pcert0 : no_pcert = 0
-centaur/misc/introduce-var.pcert0 : acl2x = 0
-centaur/misc/introduce-var.pcert0 : \
-     clause-processors/generalize.pcert0 \
-     centaur/vl/util/namedb.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/misc/introduce-var.lisp \
-     centaur/misc/introduce-var.acl2
-centaur/misc/introduce-var.pcert1 : acl2x = 0
-centaur/misc/introduce-var.pcert1 : no_pcert = 0
-centaur/misc/introduce-var.pcert1 : centaur/misc/introduce-var.pcert0
-centaur/misc/introduce-var.cert : | centaur/misc/introduce-var.pcert1
-
-centaur/misc/lists.pcert0 : no_pcert = 0
-centaur/misc/lists.pcert0 : acl2x = 0
-centaur/misc/lists.pcert0 : \
-     centaur/misc/arith-equivs.pcert0 \
-     std/lists/equiv.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/misc/lists.lisp
-centaur/misc/lists.pcert1 : acl2x = 0
-centaur/misc/lists.pcert1 : no_pcert = 0
-centaur/misc/lists.pcert1 : centaur/misc/lists.pcert0
-centaur/misc/lists.cert : | centaur/misc/lists.pcert1
-
-centaur/misc/load-stobj-tests.pcert0 : no_pcert = 0
-centaur/misc/load-stobj-tests.pcert0 : acl2x = 0
-centaur/misc/load-stobj-tests.pcert0 : \
-     centaur/misc/load-stobj.pcert0 \
-     tools/defconsts.pcert0 \
-     misc/assert.pcert0 \
-     centaur/misc/load-stobj-tests.lisp
-centaur/misc/load-stobj-tests.pcert1 : acl2x = 0
-centaur/misc/load-stobj-tests.pcert1 : no_pcert = 0
-centaur/misc/load-stobj-tests.pcert1 : centaur/misc/load-stobj-tests.pcert0
-centaur/misc/load-stobj-tests.cert : | centaur/misc/load-stobj-tests.pcert1
-
-centaur/misc/load-stobj.pcert0 : no_pcert = 0
-centaur/misc/load-stobj.pcert0 : acl2x = 0
-centaur/misc/load-stobj.pcert0 : \
-     std/lists/list-fix.pcert0 \
-     arithmetic/top.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     centaur/misc/equal-by-nths.pcert0 \
-     tools/do-not.pcert0 \
-     centaur/misc/load-stobj.lisp
-centaur/misc/load-stobj.pcert1 : acl2x = 0
-centaur/misc/load-stobj.pcert1 : no_pcert = 0
-centaur/misc/load-stobj.pcert1 : centaur/misc/load-stobj.pcert0
-centaur/misc/load-stobj.cert : | centaur/misc/load-stobj.pcert1
-
-centaur/misc/memory-mgmt-logic.pcert0 : no_pcert = 0
-centaur/misc/memory-mgmt-logic.pcert0 : acl2x = 0
-centaur/misc/memory-mgmt-logic.pcert0 : \
-     centaur/misc/memory-mgmt-logic.lisp
-centaur/misc/memory-mgmt-logic.pcert1 : acl2x = 0
-centaur/misc/memory-mgmt-logic.pcert1 : no_pcert = 0
-centaur/misc/memory-mgmt-logic.pcert1 : centaur/misc/memory-mgmt-logic.pcert0
-centaur/misc/memory-mgmt-logic.cert : | centaur/misc/memory-mgmt-logic.pcert1
-
-centaur/misc/memory-mgmt-raw.pcert0 : no_pcert = 0
-centaur/misc/memory-mgmt-raw.pcert0 : acl2x = 0
-centaur/misc/memory-mgmt-raw.pcert0 : \
-     centaur/misc/memory-mgmt-logic.pcert0 \
-     tools/include-raw.pcert0 \
-     centaur/misc/memory-mgmt-raw.lisp \
-     centaur/misc/hons-analyze-memory-raw.lsp
-centaur/misc/memory-mgmt-raw.pcert1 : acl2x = 0
-centaur/misc/memory-mgmt-raw.pcert1 : no_pcert = 0
-centaur/misc/memory-mgmt-raw.pcert1 : centaur/misc/memory-mgmt-raw.pcert0
-centaur/misc/memory-mgmt-raw.cert : | centaur/misc/memory-mgmt-raw.pcert1
-
-centaur/misc/mfc-utils.pcert0 : no_pcert = 0
-centaur/misc/mfc-utils.pcert0 : acl2x = 0
-centaur/misc/mfc-utils.pcert0 : \
-     std/lists/mfc-utils.pcert0 \
-     centaur/misc/mfc-utils.lisp
-centaur/misc/mfc-utils.pcert1 : acl2x = 0
-centaur/misc/mfc-utils.pcert1 : no_pcert = 0
-centaur/misc/mfc-utils.pcert1 : centaur/misc/mfc-utils.pcert0
-centaur/misc/mfc-utils.cert : | centaur/misc/mfc-utils.pcert1
-
-centaur/misc/nat-list-duplicates.pcert0 : no_pcert = 0
-centaur/misc/nat-list-duplicates.pcert0 : acl2x = 0
-centaur/misc/nat-list-duplicates.pcert0 : \
-     xdoc/top.pcert0 \
-     misc/hons-help.pcert0 \
-     tools/bstar.pcert0 \
-     arithmetic/nat-listp.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     tools/mv-nth.pcert0 \
-     centaur/misc/alist-equiv.pcert0 \
-     centaur/misc/nat-list-duplicates.lisp
-centaur/misc/nat-list-duplicates.pcert1 : acl2x = 0
-centaur/misc/nat-list-duplicates.pcert1 : no_pcert = 0
-centaur/misc/nat-list-duplicates.pcert1 : centaur/misc/nat-list-duplicates.pcert0
-centaur/misc/nat-list-duplicates.cert : | centaur/misc/nat-list-duplicates.pcert1
-
-centaur/misc/numlist.pcert0 : no_pcert = 0
-centaur/misc/numlist.pcert0 : acl2x = 0
-centaur/misc/numlist.pcert0 : \
-     centaur/misc/numlist.lisp
-centaur/misc/numlist.pcert1 : acl2x = 0
-centaur/misc/numlist.pcert1 : no_pcert = 0
-centaur/misc/numlist.pcert1 : centaur/misc/numlist.pcert0
-centaur/misc/numlist.cert : | centaur/misc/numlist.pcert1
-
-centaur/misc/osets-witnessing.pcert0 : no_pcert = 0
-centaur/misc/osets-witnessing.pcert0 : acl2x = 0
-centaur/misc/osets-witnessing.pcert0 : \
-     finite-set-theory/osets/sets.pcert0 \
-     centaur/misc/witness-cp.pcert0 \
-     tools/rulesets.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     centaur/misc/osets-witnessing.lisp \
-     centaur/misc/osets-witnessing.acl2
-centaur/misc/osets-witnessing.pcert1 : acl2x = 0
-centaur/misc/osets-witnessing.pcert1 : no_pcert = 0
-centaur/misc/osets-witnessing.pcert1 : centaur/misc/osets-witnessing.pcert0
-centaur/misc/osets-witnessing.cert : | centaur/misc/osets-witnessing.pcert1
-
-centaur/misc/patterns.pcert0 : no_pcert = 0
-centaur/misc/patterns.pcert0 : acl2x = 0
-centaur/misc/patterns.pcert0 : \
-     centaur/misc/alist-equiv.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     centaur/misc/patterns.lisp
-centaur/misc/patterns.pcert1 : acl2x = 0
-centaur/misc/patterns.pcert1 : no_pcert = 0
-centaur/misc/patterns.pcert1 : centaur/misc/patterns.pcert0
-centaur/misc/patterns.cert : | centaur/misc/patterns.pcert1
-
-centaur/misc/seed-random.pcert0 : no_pcert = 0
-centaur/misc/seed-random.pcert0 : acl2x = 0
-centaur/misc/seed-random.pcert0 : \
-     tools/defconsts.pcert0 \
-     tools/bstar.pcert0 \
-     misc/assert.pcert0 \
-     centaur/misc/seed-random.lisp
-centaur/misc/seed-random.pcert1 : acl2x = 0
-centaur/misc/seed-random.pcert1 : no_pcert = 0
-centaur/misc/seed-random.pcert1 : centaur/misc/seed-random.pcert0
-centaur/misc/seed-random.cert : | centaur/misc/seed-random.pcert1
-
-centaur/misc/smm-impl.pcert0 : no_pcert = 0
-centaur/misc/smm-impl.pcert0 : acl2x = 0
-centaur/misc/smm-impl.pcert0 : \
-     tools/bstar.pcert0 \
-     centaur/misc/u32-listp.pcert0 \
-     xdoc/base.pcert0 \
-     arithmetic/nat-listp.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/misc/arith-equivs.pcert0 \
-     centaur/misc/absstobjs.pcert0 \
-     tools/mv-nth.pcert0 \
-     centaur/misc/lists.pcert0 \
-     misc/definline.pcert0 \
-     centaur/misc/smm-impl.lisp
-centaur/misc/smm-impl.pcert1 : acl2x = 0
-centaur/misc/smm-impl.pcert1 : no_pcert = 0
-centaur/misc/smm-impl.pcert1 : centaur/misc/smm-impl.pcert0
-centaur/misc/smm-impl.cert : | centaur/misc/smm-impl.pcert1
-
-centaur/misc/smm.pcert0 : no_pcert = 0
-centaur/misc/smm.pcert0 : acl2x = 0
-centaur/misc/smm.pcert0 : \
-     centaur/misc/smm-impl.pcert0 \
-     tools/bstar.pcert0 \
-     xdoc/base.pcert0 \
-     misc/definline.pcert0 \
-     centaur/misc/arith-equivs.pcert0 \
-     centaur/misc/u32-listp.pcert0 \
-     centaur/misc/smm.lisp
-centaur/misc/smm.pcert1 : acl2x = 0
-centaur/misc/smm.pcert1 : no_pcert = 0
-centaur/misc/smm.pcert1 : centaur/misc/smm.pcert0
-centaur/misc/smm.cert : | centaur/misc/smm.pcert1
-
-centaur/misc/sneaky-load.pcert0 : no_pcert = 0
-centaur/misc/sneaky-load.pcert0 : acl2x = 0
-centaur/misc/sneaky-load.pcert0 : \
-     tools/bstar.pcert0 \
-     centaur/misc/sneaky-load.lisp
-centaur/misc/sneaky-load.pcert1 : acl2x = 0
-centaur/misc/sneaky-load.pcert1 : no_pcert = 0
-centaur/misc/sneaky-load.pcert1 : centaur/misc/sneaky-load.pcert0
-centaur/misc/sneaky-load.cert : | centaur/misc/sneaky-load.pcert1
-
-centaur/misc/suffixp.pcert0 : no_pcert = 0
-centaur/misc/suffixp.pcert0 : acl2x = 0
-centaur/misc/suffixp.pcert0 : \
-     centaur/misc/suffixp.lisp
-centaur/misc/suffixp.pcert1 : acl2x = 0
-centaur/misc/suffixp.pcert1 : no_pcert = 0
-centaur/misc/suffixp.pcert1 : centaur/misc/suffixp.pcert0
-centaur/misc/suffixp.cert : | centaur/misc/suffixp.pcert1
-
-centaur/misc/tailrec.pcert0 : no_pcert = 0
-centaur/misc/tailrec.pcert0 : acl2x = 0
-centaur/misc/tailrec.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     clause-processors/use-by-hint.pcert0 \
-     clause-processors/generalize.pcert0 \
-     std/lists/take.pcert0 \
-     arithmetic/top.pcert0 \
-     centaur/misc/tailrec.lisp \
-     centaur/misc/tailrec.acl2 \
-     tools/flag-package.lsp
-centaur/misc/tailrec.pcert1 : acl2x = 0
-centaur/misc/tailrec.pcert1 : no_pcert = 0
-centaur/misc/tailrec.pcert1 : centaur/misc/tailrec.pcert0
-centaur/misc/tailrec.cert : | centaur/misc/tailrec.pcert1
-
-centaur/misc/top.pcert0 : no_pcert = 0
-centaur/misc/top.pcert0 : acl2x = 0
-centaur/misc/top.pcert0 : \
-     centaur/misc/alist-defs.pcert0 \
-     centaur/misc/alist-equiv.pcert0 \
-     centaur/misc/ap.pcert0 \
-     centaur/misc/defapply.pcert0 \
-     centaur/misc/dfs-measure.pcert0 \
-     centaur/misc/equal-by-nths.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     centaur/misc/evaluator-metatheorems.pcert0 \
-     centaur/misc/fal-graphs.pcert0 \
-     centaur/misc/fast-alists.pcert0 \
-     centaur/misc/filter-alist.pcert0 \
-     centaur/misc/hons-alphorder-merge.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/misc/hons-remove-dups.pcert0 \
-     centaur/misc/hons-sets.pcert0 \
-     centaur/misc/interp-function-lookup.pcert0 \
-     centaur/misc/memory-mgmt-logic.pcert0 \
-     centaur/misc/memory-mgmt-raw.pcert0 \
-     centaur/misc/nat-list-duplicates.pcert0 \
-     centaur/misc/numlist.pcert0 \
-     centaur/misc/patterns.pcert0 \
-     centaur/misc/seed-random.pcert0 \
-     centaur/misc/sneaky-load.pcert0 \
-     centaur/misc/suffixp.pcert0 \
-     centaur/misc/tuplep.pcert0 \
-     centaur/misc/universal-equiv.pcert0 \
-     centaur/misc/vecs-ints.pcert0 \
-     centaur/misc/witness-cp.pcert0 \
-     centaur/misc/top.lisp
-centaur/misc/top.pcert1 : acl2x = 0
-centaur/misc/top.pcert1 : no_pcert = 0
-centaur/misc/top.pcert1 : centaur/misc/top.pcert0
-centaur/misc/top.cert : | centaur/misc/top.pcert1
-
-centaur/misc/tshell.pcert0 : no_pcert = 0
-centaur/misc/tshell.pcert0 : acl2x = 0
-centaur/misc/tshell.pcert0 : \
-     tools/include-raw.pcert0 \
-     str/strprefixp.pcert0 \
-     centaur/misc/tshell.lisp \
-     centaur/misc/tshell-raw.lsp
-centaur/misc/tshell.pcert1 : acl2x = 0
-centaur/misc/tshell.pcert1 : no_pcert = 0
-centaur/misc/tshell.pcert1 : centaur/misc/tshell.pcert0
-centaur/misc/tshell.cert : | centaur/misc/tshell.pcert1
-
-centaur/misc/tuplep.pcert0 : no_pcert = 0
-centaur/misc/tuplep.pcert0 : acl2x = 0
-centaur/misc/tuplep.pcert0 : \
-     centaur/misc/tuplep.lisp
-centaur/misc/tuplep.pcert1 : acl2x = 0
-centaur/misc/tuplep.pcert1 : no_pcert = 0
-centaur/misc/tuplep.pcert1 : centaur/misc/tuplep.pcert0
-centaur/misc/tuplep.cert : | centaur/misc/tuplep.pcert1
-
-centaur/misc/u32-listp.pcert0 : no_pcert = 0
-centaur/misc/u32-listp.pcert0 : acl2x = 0
-centaur/misc/u32-listp.pcert0 : \
-     centaur/misc/u32-listp.lisp
-centaur/misc/u32-listp.pcert1 : acl2x = 0
-centaur/misc/u32-listp.pcert1 : no_pcert = 0
-centaur/misc/u32-listp.pcert1 : centaur/misc/u32-listp.pcert0
-centaur/misc/u32-listp.cert : | centaur/misc/u32-listp.pcert1
-
-centaur/misc/universal-equiv.pcert0 : no_pcert = 0
-centaur/misc/universal-equiv.pcert0 : acl2x = 0
-centaur/misc/universal-equiv.pcert0 : \
-     clause-processors/equality.pcert0 \
-     centaur/misc/universal-equiv.lisp
-centaur/misc/universal-equiv.pcert1 : acl2x = 0
-centaur/misc/universal-equiv.pcert1 : no_pcert = 0
-centaur/misc/universal-equiv.pcert1 : centaur/misc/universal-equiv.pcert0
-centaur/misc/universal-equiv.cert : | centaur/misc/universal-equiv.pcert1
-
-centaur/misc/vecs-ints.pcert0 : no_pcert = 0
-centaur/misc/vecs-ints.pcert0 : acl2x = 0
-centaur/misc/vecs-ints.pcert0 : \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     centaur/misc/vecs-ints.lisp
-centaur/misc/vecs-ints.pcert1 : acl2x = 0
-centaur/misc/vecs-ints.pcert1 : no_pcert = 0
-centaur/misc/vecs-ints.pcert1 : centaur/misc/vecs-ints.pcert0
-centaur/misc/vecs-ints.cert : | centaur/misc/vecs-ints.pcert1
-
-centaur/misc/witness-cp.pcert0 : no_pcert = 0
-centaur/misc/witness-cp.pcert0 : acl2x = 0
-centaur/misc/witness-cp.pcert0 : \
-     clause-processors/witness-cp.pcert0 \
-     centaur/misc/witness-cp.lisp
-centaur/misc/witness-cp.pcert1 : acl2x = 0
-centaur/misc/witness-cp.pcert1 : no_pcert = 0
-centaur/misc/witness-cp.pcert1 : centaur/misc/witness-cp.pcert0
-centaur/misc/witness-cp.cert : | centaur/misc/witness-cp.pcert1
-
-centaur/ubdds/core.pcert0 : no_pcert = 0
-centaur/ubdds/core.pcert0 : acl2x = 0
-centaur/ubdds/core.pcert0 : \
-     misc/definline.pcert0 \
-     centaur/misc/memory-mgmt-logic.pcert0 \
-     misc/computed-hint-rewrite.pcert0 \
-     tools/rulesets.pcert0 \
-     xdoc/top.pcert0 \
-     xdoc/portcullis.pcert0 \
-     centaur/ubdds/core.lisp \
-     centaur/ubdds/cert.acl2
-centaur/ubdds/core.pcert1 : acl2x = 0
-centaur/ubdds/core.pcert1 : no_pcert = 0
-centaur/ubdds/core.pcert1 : centaur/ubdds/core.pcert0
-centaur/ubdds/core.cert : | centaur/ubdds/core.pcert1
-
-centaur/ubdds/extra-operations.pcert0 : no_pcert = 0
-centaur/ubdds/extra-operations.pcert0 : acl2x = 0
-centaur/ubdds/extra-operations.pcert0 : \
-     centaur/ubdds/core.pcert0 \
-     xdoc/portcullis.pcert0 \
-     centaur/ubdds/extra-operations.lisp \
-     centaur/ubdds/cert.acl2
-centaur/ubdds/extra-operations.pcert1 : acl2x = 0
-centaur/ubdds/extra-operations.pcert1 : no_pcert = 0
-centaur/ubdds/extra-operations.pcert1 : centaur/ubdds/extra-operations.pcert0
-centaur/ubdds/extra-operations.cert : | centaur/ubdds/extra-operations.pcert1
-
-centaur/ubdds/lite.pcert0 : no_pcert = 0
-centaur/ubdds/lite.pcert0 : acl2x = 0
-centaur/ubdds/lite.pcert0 : \
-     centaur/ubdds/witness.pcert0 \
-     centaur/ubdds/subset.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     xdoc/portcullis.pcert0 \
-     centaur/ubdds/lite.lisp \
-     centaur/ubdds/cert.acl2
-centaur/ubdds/lite.pcert1 : acl2x = 0
-centaur/ubdds/lite.pcert1 : no_pcert = 0
-centaur/ubdds/lite.pcert1 : centaur/ubdds/lite.pcert0
-centaur/ubdds/lite.cert : | centaur/ubdds/lite.pcert1
-
-centaur/ubdds/param.pcert0 : no_pcert = 0
-centaur/ubdds/param.pcert0 : acl2x = 0
-centaur/ubdds/param.pcert0 : \
-     centaur/ubdds/extra-operations.pcert0 \
-     misc/hons-help2.pcert0 \
-     tools/rulesets.pcert0 \
-     std/lists/take.pcert0 \
-     arithmetic/top.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     xdoc/portcullis.pcert0 \
-     centaur/ubdds/param.lisp \
-     centaur/ubdds/cert.acl2
-centaur/ubdds/param.pcert1 : acl2x = 0
-centaur/ubdds/param.pcert1 : no_pcert = 0
-centaur/ubdds/param.pcert1 : centaur/ubdds/param.pcert0
-centaur/ubdds/param.cert : | centaur/ubdds/param.pcert1
-
-centaur/ubdds/sanity-check-macros.pcert0 : no_pcert = 0
-centaur/ubdds/sanity-check-macros.pcert0 : acl2x = 0
-centaur/ubdds/sanity-check-macros.pcert0 : \
-     centaur/ubdds/lite.pcert0 \
-     xdoc/portcullis.pcert0 \
-     centaur/ubdds/sanity-check-macros.lisp \
-     centaur/ubdds/cert.acl2
-centaur/ubdds/sanity-check-macros.pcert1 : acl2x = 0
-centaur/ubdds/sanity-check-macros.pcert1 : no_pcert = 0
-centaur/ubdds/sanity-check-macros.pcert1 : centaur/ubdds/sanity-check-macros.pcert0
-centaur/ubdds/sanity-check-macros.cert : | centaur/ubdds/sanity-check-macros.pcert1
-
-centaur/ubdds/subset.pcert0 : no_pcert = 0
-centaur/ubdds/subset.pcert0 : acl2x = 0
-centaur/ubdds/subset.pcert0 : \
-     centaur/ubdds/extra-operations.pcert0 \
-     xdoc/portcullis.pcert0 \
-     centaur/ubdds/subset.lisp \
-     centaur/ubdds/cert.acl2
-centaur/ubdds/subset.pcert1 : acl2x = 0
-centaur/ubdds/subset.pcert1 : no_pcert = 0
-centaur/ubdds/subset.pcert1 : centaur/ubdds/subset.pcert0
-centaur/ubdds/subset.cert : | centaur/ubdds/subset.pcert1
-
-centaur/ubdds/witness.pcert0 : no_pcert = 0
-centaur/ubdds/witness.pcert0 : acl2x = 0
-centaur/ubdds/witness.pcert0 : \
-     centaur/ubdds/extra-operations.pcert0 \
-     misc/hons-help2.pcert0 \
-     clause-processors/term-patterns.pcert0 \
-     clause-processors/use-by-hint.pcert0 \
-     tools/mv-nth.pcert0 \
-     clause-processors/generalize.pcert0 \
-     tools/flag.pcert0 \
-     centaur/ubdds/witness.lisp \
-     centaur/ubdds/witness.acl2 \
-     tools/flag-package.lsp
-centaur/ubdds/witness.pcert1 : acl2x = 0
-centaur/ubdds/witness.pcert1 : no_pcert = 0
-centaur/ubdds/witness.pcert1 : centaur/ubdds/witness.pcert0
-centaur/ubdds/witness.cert : | centaur/ubdds/witness.pcert1
-
-centaur/vl/checkers/checkers.pcert0 : no_pcert = 0
-centaur/vl/checkers/checkers.pcert0 : acl2x = 0
-centaur/vl/checkers/checkers.pcert0 : \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/checkers.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/checkers.pcert1 : acl2x = 0
-centaur/vl/checkers/checkers.pcert1 : no_pcert = 0
-centaur/vl/checkers/checkers.pcert1 : centaur/vl/checkers/checkers.pcert0
-centaur/vl/checkers/checkers.cert : | centaur/vl/checkers/checkers.pcert1
-
-centaur/vl/checkers/condcheck.pcert0 : no_pcert = 0
-centaur/vl/checkers/condcheck.pcert0 : acl2x = 0
-centaur/vl/checkers/condcheck.pcert0 : \
-     centaur/vl/mlib/ctxexprs.pcert0 \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/condcheck.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/condcheck.pcert1 : acl2x = 0
-centaur/vl/checkers/condcheck.pcert1 : no_pcert = 0
-centaur/vl/checkers/condcheck.pcert1 : centaur/vl/checkers/condcheck.pcert0
-centaur/vl/checkers/condcheck.cert : | centaur/vl/checkers/condcheck.pcert1
-
-centaur/vl/checkers/dupeinst-check.pcert0 : no_pcert = 0
-centaur/vl/checkers/dupeinst-check.pcert0 : acl2x = 0
-centaur/vl/checkers/dupeinst-check.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/dupeinst-check.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/dupeinst-check.pcert1 : acl2x = 0
-centaur/vl/checkers/dupeinst-check.pcert1 : no_pcert = 0
-centaur/vl/checkers/dupeinst-check.pcert1 : centaur/vl/checkers/dupeinst-check.pcert0
-centaur/vl/checkers/dupeinst-check.cert : | centaur/vl/checkers/dupeinst-check.pcert1
-
-centaur/vl/checkers/duperhs.pcert0 : no_pcert = 0
-centaur/vl/checkers/duperhs.pcert0 : acl2x = 0
-centaur/vl/checkers/duperhs.pcert0 : \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/duperhs.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/duperhs.pcert1 : acl2x = 0
-centaur/vl/checkers/duperhs.pcert1 : no_pcert = 0
-centaur/vl/checkers/duperhs.pcert1 : centaur/vl/checkers/duperhs.pcert0
-centaur/vl/checkers/duperhs.cert : | centaur/vl/checkers/duperhs.pcert1
-
-centaur/vl/checkers/duplicate-detect.pcert0 : no_pcert = 0
-centaur/vl/checkers/duplicate-detect.pcert0 : acl2x = 0
-centaur/vl/checkers/duplicate-detect.pcert0 : \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/duplicate-detect.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/duplicate-detect.pcert1 : acl2x = 0
-centaur/vl/checkers/duplicate-detect.pcert1 : no_pcert = 0
-centaur/vl/checkers/duplicate-detect.pcert1 : centaur/vl/checkers/duplicate-detect.pcert0
-centaur/vl/checkers/duplicate-detect.cert : | centaur/vl/checkers/duplicate-detect.pcert1
-
-centaur/vl/checkers/leftright.pcert0 : no_pcert = 0
-centaur/vl/checkers/leftright.pcert0 : acl2x = 0
-centaur/vl/checkers/leftright.pcert0 : \
-     centaur/vl/mlib/ctxexprs.pcert0 \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/leftright.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/leftright.pcert1 : acl2x = 0
-centaur/vl/checkers/leftright.pcert1 : no_pcert = 0
-centaur/vl/checkers/leftright.pcert1 : centaur/vl/checkers/leftright.pcert0
-centaur/vl/checkers/leftright.cert : | centaur/vl/checkers/leftright.pcert1
-
-centaur/vl/checkers/multidrive-detect.pcert0 : no_pcert = 0
-centaur/vl/checkers/multidrive-detect.pcert0 : acl2x = 0
-centaur/vl/checkers/multidrive-detect.pcert0 : \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/mlib/lvalues.pcert0 \
-     centaur/vl/toe/toe-wirealist.pcert0 \
-     centaur/vl/toe/toe-verilogify.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/misc/fal-graphs.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/multidrive-detect.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/multidrive-detect.pcert1 : acl2x = 0
-centaur/vl/checkers/multidrive-detect.pcert1 : no_pcert = 0
-centaur/vl/checkers/multidrive-detect.pcert1 : centaur/vl/checkers/multidrive-detect.pcert0
-centaur/vl/checkers/multidrive-detect.cert : | centaur/vl/checkers/multidrive-detect.pcert1
-
-centaur/vl/checkers/oddexpr.pcert0 : no_pcert = 0
-centaur/vl/checkers/oddexpr.pcert0 : acl2x = 0
-centaur/vl/checkers/oddexpr.pcert0 : \
-     centaur/vl/mlib/ctxexprs.pcert0 \
-     centaur/vl/transforms/xf-sizing.pcert0 \
-     centaur/vl/mlib/fmt.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/oddexpr.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/oddexpr.pcert1 : acl2x = 0
-centaur/vl/checkers/oddexpr.pcert1 : no_pcert = 0
-centaur/vl/checkers/oddexpr.pcert1 : centaur/vl/checkers/oddexpr.pcert0
-centaur/vl/checkers/oddexpr.cert : | centaur/vl/checkers/oddexpr.pcert1
-
-centaur/vl/checkers/portcheck.pcert0 : no_pcert = 0
-centaur/vl/checkers/portcheck.pcert0 : acl2x = 0
-centaur/vl/checkers/portcheck.pcert0 : \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/portcheck.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/portcheck.pcert1 : acl2x = 0
-centaur/vl/checkers/portcheck.pcert1 : no_pcert = 0
-centaur/vl/checkers/portcheck.pcert1 : centaur/vl/checkers/portcheck.pcert0
-centaur/vl/checkers/portcheck.cert : | centaur/vl/checkers/portcheck.pcert1
-
-centaur/vl/checkers/qmarksize-check.pcert0 : no_pcert = 0
-centaur/vl/checkers/qmarksize-check.pcert0 : acl2x = 0
-centaur/vl/checkers/qmarksize-check.pcert0 : \
-     centaur/vl/mlib/ctxexprs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/qmarksize-check.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/qmarksize-check.pcert1 : acl2x = 0
-centaur/vl/checkers/qmarksize-check.pcert1 : no_pcert = 0
-centaur/vl/checkers/qmarksize-check.pcert1 : centaur/vl/checkers/qmarksize-check.pcert0
-centaur/vl/checkers/qmarksize-check.cert : | centaur/vl/checkers/qmarksize-check.pcert1
-
-centaur/vl/checkers/selfassigns.pcert0 : no_pcert = 0
-centaur/vl/checkers/selfassigns.pcert0 : acl2x = 0
-centaur/vl/checkers/selfassigns.pcert0 : \
-     centaur/vl/mlib/ctxexprs.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/selfassigns.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/selfassigns.pcert1 : acl2x = 0
-centaur/vl/checkers/selfassigns.pcert1 : no_pcert = 0
-centaur/vl/checkers/selfassigns.pcert1 : centaur/vl/checkers/selfassigns.pcert0
-centaur/vl/checkers/selfassigns.cert : | centaur/vl/checkers/selfassigns.pcert1
-
-centaur/vl/checkers/skip-detect.pcert0 : no_pcert = 0
-centaur/vl/checkers/skip-detect.pcert0 : acl2x = 0
-centaur/vl/checkers/skip-detect.pcert0 : \
-     centaur/vl/mlib/ctxexprs.pcert0 \
-     centaur/vl/mlib/print-context.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/skip-detect.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/skip-detect.pcert1 : acl2x = 0
-centaur/vl/checkers/skip-detect.pcert1 : no_pcert = 0
-centaur/vl/checkers/skip-detect.pcert1 : centaur/vl/checkers/skip-detect.pcert0
-centaur/vl/checkers/skip-detect.cert : | centaur/vl/checkers/skip-detect.pcert1
-
-centaur/vl/checkers/typo-detect.pcert0 : no_pcert = 0
-centaur/vl/checkers/typo-detect.pcert0 : acl2x = 0
-centaur/vl/checkers/typo-detect.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/string-alists.pcert0 \
-     centaur/vl/util/character-list-listp.pcert0 \
-     centaur/vl/loader/lexer-utils.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/typo-detect.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/typo-detect.pcert1 : acl2x = 0
-centaur/vl/checkers/typo-detect.pcert1 : no_pcert = 0
-centaur/vl/checkers/typo-detect.pcert1 : centaur/vl/checkers/typo-detect.pcert0
-centaur/vl/checkers/typo-detect.cert : | centaur/vl/checkers/typo-detect.pcert1
-
-centaur/vl/checkers/use-set-report.pcert0 : no_pcert = 0
-centaur/vl/checkers/use-set-report.pcert0 : acl2x = 0
-centaur/vl/checkers/use-set-report.pcert0 : \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/mlib/print-warnings.pcert0 \
-     centaur/vl/util/string-alists.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/use-set-report.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/use-set-report.pcert1 : acl2x = 0
-centaur/vl/checkers/use-set-report.pcert1 : no_pcert = 0
-centaur/vl/checkers/use-set-report.pcert1 : centaur/vl/checkers/use-set-report.pcert0
-centaur/vl/checkers/use-set-report.cert : | centaur/vl/checkers/use-set-report.pcert1
-
-centaur/vl/checkers/use-set-tool.pcert0 : no_pcert = 0
-centaur/vl/checkers/use-set-tool.pcert0 : acl2x = 0
-centaur/vl/checkers/use-set-tool.pcert0 : \
-     centaur/vl/checkers/use-set.pcert0 \
-     centaur/vl/loader/loader.pcert0 \
-     centaur/vl/transforms/xf-argresolve.pcert0 \
-     centaur/vl/transforms/xf-portdecl-sign.pcert0 \
-     centaur/vl/transforms/cn-hooks.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/mlib/modname-sets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/use-set-tool.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/use-set-tool.pcert1 : acl2x = 0
-centaur/vl/checkers/use-set-tool.pcert1 : no_pcert = 0
-centaur/vl/checkers/use-set-tool.pcert1 : centaur/vl/checkers/use-set-tool.pcert0
-centaur/vl/checkers/use-set-tool.cert : | centaur/vl/checkers/use-set-tool.pcert1
-
-centaur/vl/checkers/use-set.pcert0 : no_pcert = 0
-centaur/vl/checkers/use-set.pcert0 : acl2x = 0
-centaur/vl/checkers/use-set.pcert0 : \
-     centaur/vl/checkers/typo-detect.pcert0 \
-     centaur/vl/checkers/use-set-report.pcert0 \
-     centaur/vl/mlib/warnings.pcert0 \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/checkers/use-set.lisp \
-     centaur/vl/checkers/cert.acl2
-centaur/vl/checkers/use-set.pcert1 : acl2x = 0
-centaur/vl/checkers/use-set.pcert1 : no_pcert = 0
-centaur/vl/checkers/use-set.pcert1 : centaur/vl/checkers/use-set.pcert0
-centaur/vl/checkers/use-set.cert : | centaur/vl/checkers/use-set.pcert1
-
-centaur/vl/lint/bit-use-set.pcert0 : no_pcert = 0
-centaur/vl/lint/bit-use-set.pcert0 : acl2x = 0
-centaur/vl/lint/bit-use-set.pcert0 : \
-     centaur/vl/toe/toe-preliminary.pcert0 \
-     centaur/vl/wf-reasonable-p.pcert0 \
-     centaur/vl/lint/disconnected.pcert0 \
-     centaur/vl/mlib/hierarchy.pcert0 \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/lvalues.pcert0 \
-     centaur/vl/mlib/warnings.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/lint/use-set-ignore.pcert0 \
-     centaur/bitops/bitsets.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/bit-use-set.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/bit-use-set.pcert1 : acl2x = 0
-centaur/vl/lint/bit-use-set.pcert1 : no_pcert = 0
-centaur/vl/lint/bit-use-set.pcert1 : centaur/vl/lint/bit-use-set.pcert0
-centaur/vl/lint/bit-use-set.cert : | centaur/vl/lint/bit-use-set.pcert1
-
-centaur/vl/lint/check-case.pcert0 : no_pcert = 0
-centaur/vl/lint/check-case.pcert0 : acl2x = 0
-centaur/vl/lint/check-case.pcert0 : \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/check-case.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/check-case.pcert1 : acl2x = 0
-centaur/vl/lint/check-case.pcert1 : no_pcert = 0
-centaur/vl/lint/check-case.pcert1 : centaur/vl/lint/check-case.pcert0
-centaur/vl/lint/check-case.cert : | centaur/vl/lint/check-case.pcert1
-
-centaur/vl/lint/check-namespace.pcert0 : no_pcert = 0
-centaur/vl/lint/check-namespace.pcert0 : acl2x = 0
-centaur/vl/lint/check-namespace.pcert0 : \
-     centaur/vl/wf-reasonable-p.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/check-namespace.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/check-namespace.pcert1 : acl2x = 0
-centaur/vl/lint/check-namespace.pcert1 : no_pcert = 0
-centaur/vl/lint/check-namespace.pcert1 : centaur/vl/lint/check-namespace.pcert0
-centaur/vl/lint/check-namespace.cert : | centaur/vl/lint/check-namespace.pcert1
-
-centaur/vl/lint/disconnected.pcert0 : no_pcert = 0
-centaur/vl/lint/disconnected.pcert0 : acl2x = 0
-centaur/vl/lint/disconnected.pcert0 : \
-     centaur/vl/toe/toe-wirealist.pcert0 \
-     centaur/vl/toe/toe-verilogify.pcert0 \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/fmt.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/disconnected.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/disconnected.pcert1 : acl2x = 0
-centaur/vl/lint/disconnected.pcert1 : no_pcert = 0
-centaur/vl/lint/disconnected.pcert1 : centaur/vl/lint/disconnected.pcert0
-centaur/vl/lint/disconnected.cert : | centaur/vl/lint/disconnected.pcert1
-
-centaur/vl/lint/lint.pcert0 : no_pcert = 0
-centaur/vl/lint/lint.pcert0 : acl2x = 0
-centaur/vl/lint/lint.pcert0 : \
-     centaur/vl/lint/bit-use-set.pcert0 \
-     centaur/vl/lint/check-case.pcert0 \
-     centaur/vl/lint/check-namespace.pcert0 \
-     centaur/vl/lint/disconnected.pcert0 \
-     centaur/vl/lint/xf-drop-missing-submodules.pcert0 \
-     centaur/vl/lint/xf-lint-stmt-rewrite.pcert0 \
-     centaur/vl/lint/xf-remove-toohard.pcert0 \
-     centaur/vl/lint/xf-undefined-names.pcert0 \
-     centaur/vl/lint/xf-suppress-warnings.pcert0 \
-     centaur/vl/checkers/condcheck.pcert0 \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/checkers/dupeinst-check.pcert0 \
-     centaur/vl/checkers/duperhs.pcert0 \
-     centaur/vl/checkers/leftright.pcert0 \
-     centaur/vl/checkers/multidrive-detect.pcert0 \
-     centaur/vl/checkers/oddexpr.pcert0 \
-     centaur/vl/checkers/portcheck.pcert0 \
-     centaur/vl/checkers/qmarksize-check.pcert0 \
-     centaur/vl/checkers/selfassigns.pcert0 \
-     centaur/vl/checkers/skip-detect.pcert0 \
-     centaur/vl/loader/loader.pcert0 \
-     centaur/vl/transforms/cn-hooks.pcert0 \
-     centaur/vl/transforms/xf-argresolve.pcert0 \
-     centaur/vl/transforms/xf-array-indexing.pcert0 \
-     centaur/vl/transforms/xf-assign-trunc.pcert0 \
-     centaur/vl/transforms/xf-blankargs.pcert0 \
-     centaur/vl/transforms/xf-clean-params.pcert0 \
-     centaur/vl/transforms/xf-drop-blankports.pcert0 \
-     centaur/vl/transforms/xf-expr-split.pcert0 \
-     centaur/vl/transforms/xf-expand-functions.pcert0 \
-     centaur/vl/transforms/xf-follow-hids.pcert0 \
-     centaur/vl/transforms/xf-hid-elim.pcert0 \
-     centaur/vl/transforms/xf-orig.pcert0 \
-     centaur/vl/transforms/xf-oprewrite.pcert0 \
-     centaur/vl/transforms/xf-portdecl-sign.pcert0 \
-     centaur/vl/transforms/xf-resolve-ranges.pcert0 \
-     centaur/vl/transforms/xf-replicate-insts.pcert0 \
-     centaur/vl/transforms/xf-sizing.pcert0 \
-     centaur/vl/transforms/xf-unparameterize.pcert0 \
-     centaur/vl/transforms/xf-unused-reg.pcert0 \
-     centaur/vl/mlib/modname-sets.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/lint.lisp \
-     centaur/vl/lint/lint.acl2
-centaur/vl/lint/lint.pcert1 : acl2x = 0
-centaur/vl/lint/lint.pcert1 : no_pcert = 0
-centaur/vl/lint/lint.pcert1 : centaur/vl/lint/lint.pcert0
-centaur/vl/lint/lint.cert : | centaur/vl/lint/lint.pcert1
-
-centaur/vl/lint/use-set-ignore.pcert0 : no_pcert = 0
-centaur/vl/lint/use-set-ignore.pcert0 : acl2x = 0
-centaur/vl/lint/use-set-ignore.pcert0 : \
-     centaur/vl/loader/parse-lvalues.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/mlib/fmt.pcert0 \
-     centaur/vl/checkers/oddexpr.pcert0 \
-     centaur/vl/toe/toe-wirealist.pcert0 \
-     centaur/vl/transforms/xf-sizing.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/use-set-ignore.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/use-set-ignore.pcert1 : acl2x = 0
-centaur/vl/lint/use-set-ignore.pcert1 : no_pcert = 0
-centaur/vl/lint/use-set-ignore.pcert1 : centaur/vl/lint/use-set-ignore.pcert0
-centaur/vl/lint/use-set-ignore.cert : | centaur/vl/lint/use-set-ignore.pcert1
-
-centaur/vl/lint/xf-drop-missing-submodules.pcert0 : no_pcert = 0
-centaur/vl/lint/xf-drop-missing-submodules.pcert0 : acl2x = 0
-centaur/vl/lint/xf-drop-missing-submodules.pcert0 : \
-     centaur/vl/mlib/filter.pcert0 \
-     centaur/vl/mlib/hierarchy.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/xf-drop-missing-submodules.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/xf-drop-missing-submodules.pcert1 : acl2x = 0
-centaur/vl/lint/xf-drop-missing-submodules.pcert1 : no_pcert = 0
-centaur/vl/lint/xf-drop-missing-submodules.pcert1 : centaur/vl/lint/xf-drop-missing-submodules.pcert0
-centaur/vl/lint/xf-drop-missing-submodules.cert : | centaur/vl/lint/xf-drop-missing-submodules.pcert1
-
-centaur/vl/lint/xf-drop-unresolved-submodules.pcert0 : no_pcert = 0
-centaur/vl/lint/xf-drop-unresolved-submodules.pcert0 : acl2x = 0
-centaur/vl/lint/xf-drop-unresolved-submodules.pcert0 : \
-     centaur/vl/mlib/filter.pcert0 \
-     centaur/vl/mlib/hierarchy.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/xf-drop-unresolved-submodules.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/xf-drop-unresolved-submodules.pcert1 : acl2x = 0
-centaur/vl/lint/xf-drop-unresolved-submodules.pcert1 : no_pcert = 0
-centaur/vl/lint/xf-drop-unresolved-submodules.pcert1 : centaur/vl/lint/xf-drop-unresolved-submodules.pcert0
-centaur/vl/lint/xf-drop-unresolved-submodules.cert : | centaur/vl/lint/xf-drop-unresolved-submodules.pcert1
-
-centaur/vl/lint/xf-lint-stmt-rewrite.pcert0 : no_pcert = 0
-centaur/vl/lint/xf-lint-stmt-rewrite.pcert0 : acl2x = 0
-centaur/vl/lint/xf-lint-stmt-rewrite.pcert0 : \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/xf-lint-stmt-rewrite.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/xf-lint-stmt-rewrite.pcert1 : acl2x = 0
-centaur/vl/lint/xf-lint-stmt-rewrite.pcert1 : no_pcert = 0
-centaur/vl/lint/xf-lint-stmt-rewrite.pcert1 : centaur/vl/lint/xf-lint-stmt-rewrite.pcert0
-centaur/vl/lint/xf-lint-stmt-rewrite.cert : | centaur/vl/lint/xf-lint-stmt-rewrite.pcert1
-
-centaur/vl/lint/xf-remove-toohard.pcert0 : no_pcert = 0
-centaur/vl/lint/xf-remove-toohard.pcert0 : acl2x = 0
-centaur/vl/lint/xf-remove-toohard.pcert0 : \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/xf-remove-toohard.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/xf-remove-toohard.pcert1 : acl2x = 0
-centaur/vl/lint/xf-remove-toohard.pcert1 : no_pcert = 0
-centaur/vl/lint/xf-remove-toohard.pcert1 : centaur/vl/lint/xf-remove-toohard.pcert0
-centaur/vl/lint/xf-remove-toohard.cert : | centaur/vl/lint/xf-remove-toohard.pcert1
-
-centaur/vl/lint/xf-suppress-warnings.pcert0 : no_pcert = 0
-centaur/vl/lint/xf-suppress-warnings.pcert0 : acl2x = 0
-centaur/vl/lint/xf-suppress-warnings.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/xf-suppress-warnings.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/xf-suppress-warnings.pcert1 : acl2x = 0
-centaur/vl/lint/xf-suppress-warnings.pcert1 : no_pcert = 0
-centaur/vl/lint/xf-suppress-warnings.pcert1 : centaur/vl/lint/xf-suppress-warnings.pcert0
-centaur/vl/lint/xf-suppress-warnings.cert : | centaur/vl/lint/xf-suppress-warnings.pcert1
-
-centaur/vl/lint/xf-undefined-names.pcert0 : no_pcert = 0
-centaur/vl/lint/xf-undefined-names.pcert0 : acl2x = 0
-centaur/vl/lint/xf-undefined-names.pcert0 : \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/lint/xf-undefined-names.lisp \
-     centaur/vl/lint/cert.acl2
-centaur/vl/lint/xf-undefined-names.pcert1 : acl2x = 0
-centaur/vl/lint/xf-undefined-names.pcert1 : no_pcert = 0
-centaur/vl/lint/xf-undefined-names.pcert1 : centaur/vl/lint/xf-undefined-names.pcert0
-centaur/vl/lint/xf-undefined-names.cert : | centaur/vl/lint/xf-undefined-names.pcert1
-
-centaur/vl/loader/defines.pcert0 : no_pcert = 0
-centaur/vl/loader/defines.pcert0 : acl2x = 0
-centaur/vl/loader/defines.pcert0 : \
-     centaur/vl/util/echars.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/defines.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/defines.pcert1 : acl2x = 0
-centaur/vl/loader/defines.pcert1 : no_pcert = 0
-centaur/vl/loader/defines.pcert1 : centaur/vl/loader/defines.pcert0
-centaur/vl/loader/defines.cert : | centaur/vl/loader/defines.pcert1
-
-centaur/vl/loader/filemap.pcert0 : no_pcert = 0
-centaur/vl/loader/filemap.pcert0 : acl2x = 0
-centaur/vl/loader/filemap.pcert0 : \
-     centaur/vl/util/echars.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/filemap.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/filemap.pcert1 : acl2x = 0
-centaur/vl/loader/filemap.pcert1 : no_pcert = 0
-centaur/vl/loader/filemap.pcert1 : centaur/vl/loader/filemap.pcert0
-centaur/vl/loader/filemap.cert : | centaur/vl/loader/filemap.pcert1
-
-centaur/vl/loader/find-file.pcert0 : no_pcert = 0
-centaur/vl/loader/find-file.pcert0 : acl2x = 0
-centaur/vl/loader/find-file.pcert0 : \
-     centaur/vl/util/warnings.pcert0 \
-     std/io/open-input-channel.pcert0 \
-     std/io/close-input-channel.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/find-file.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/find-file.pcert1 : acl2x = 0
-centaur/vl/loader/find-file.pcert1 : no_pcert = 0
-centaur/vl/loader/find-file.pcert1 : centaur/vl/loader/find-file.pcert0
-centaur/vl/loader/find-file.cert : | centaur/vl/loader/find-file.pcert1
-
-centaur/vl/loader/inject-comments.pcert0 : no_pcert = 0
-centaur/vl/loader/inject-comments.pcert0 : acl2x = 0
-centaur/vl/loader/inject-comments.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/inject-comments.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/inject-comments.pcert1 : acl2x = 0
-centaur/vl/loader/inject-comments.pcert1 : no_pcert = 0
-centaur/vl/loader/inject-comments.pcert1 : centaur/vl/loader/inject-comments.pcert0
-centaur/vl/loader/inject-comments.cert : | centaur/vl/loader/inject-comments.pcert1
-
-centaur/vl/loader/lexer-tests.pcert0 : no_pcert = 0
-centaur/vl/loader/lexer-tests.pcert0 : acl2x = 0
-centaur/vl/loader/lexer-tests.pcert0 : \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/lexer-tests.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/lexer-tests.pcert1 : acl2x = 0
-centaur/vl/loader/lexer-tests.pcert1 : no_pcert = 0
-centaur/vl/loader/lexer-tests.pcert1 : centaur/vl/loader/lexer-tests.pcert0
-centaur/vl/loader/lexer-tests.cert : | centaur/vl/loader/lexer-tests.pcert1
-
-centaur/vl/loader/lexer-tokens.pcert0 : no_pcert = 0
-centaur/vl/loader/lexer-tokens.pcert0 : acl2x = 0
-centaur/vl/loader/lexer-tokens.pcert0 : \
-     centaur/vl/util/bits.pcert0 \
-     centaur/vl/util/echars.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/lexer-tokens.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/lexer-tokens.pcert1 : acl2x = 0
-centaur/vl/loader/lexer-tokens.pcert1 : no_pcert = 0
-centaur/vl/loader/lexer-tokens.pcert1 : centaur/vl/loader/lexer-tokens.pcert0
-centaur/vl/loader/lexer-tokens.cert : | centaur/vl/loader/lexer-tokens.pcert1
-
-centaur/vl/loader/lexer-utils.pcert0 : no_pcert = 0
-centaur/vl/loader/lexer-utils.pcert0 : acl2x = 0
-centaur/vl/loader/lexer-utils.pcert0 : \
-     std/lists/prefixp.pcert0 \
-     centaur/vl/util/echars.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/lexer-utils.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/lexer-utils.pcert1 : acl2x = 0
-centaur/vl/loader/lexer-utils.pcert1 : no_pcert = 0
-centaur/vl/loader/lexer-utils.pcert1 : centaur/vl/loader/lexer-utils.pcert0
-centaur/vl/loader/lexer-utils.cert : | centaur/vl/loader/lexer-utils.pcert1
-
-centaur/vl/loader/lexer.pcert0 : no_pcert = 0
-centaur/vl/loader/lexer.pcert0 : acl2x = 0
-centaur/vl/loader/lexer.pcert0 : \
-     centaur/vl/loader/lexer-tokens.pcert0 \
-     centaur/vl/loader/lexer-utils.pcert0 \
-     centaur/vl/util/warnings.pcert0 \
-     centaur/vl/util/commentmap.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/lexer.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/lexer.pcert1 : acl2x = 0
-centaur/vl/loader/lexer.pcert1 : no_pcert = 0
-centaur/vl/loader/lexer.pcert1 : centaur/vl/loader/lexer.pcert0
-centaur/vl/loader/lexer.cert : | centaur/vl/loader/lexer.pcert1
-
-centaur/vl/loader/loader.pcert0 : no_pcert = 0
-centaur/vl/loader/loader.pcert0 : acl2x = 0
-centaur/vl/loader/loader.pcert0 : \
-     centaur/vl/loader/read-file.pcert0 \
-     centaur/vl/loader/find-file.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/loader/preprocessor.pcert0 \
-     centaur/vl/loader/parser.pcert0 \
-     centaur/vl/loader/filemap.pcert0 \
-     centaur/vl/loader/inject-comments.pcert0 \
-     centaur/vl/loader/overrides.pcert0 \
-     centaur/vl/mlib/hierarchy.pcert0 \
-     centaur/vl/mlib/print-warnings.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/util/gc.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     defsort/duplicated-members.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/loader.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/loader.pcert1 : acl2x = 0
-centaur/vl/loader/loader.pcert1 : no_pcert = 0
-centaur/vl/loader/loader.pcert1 : centaur/vl/loader/loader.pcert0
-centaur/vl/loader/loader.cert : | centaur/vl/loader/loader.pcert1
-
-centaur/vl/loader/make-implicit-wires.pcert0 : no_pcert = 0
-centaur/vl/loader/make-implicit-wires.pcert0 : acl2x = 0
-centaur/vl/loader/make-implicit-wires.pcert0 : \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/make-implicit-wires.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/make-implicit-wires.pcert1 : acl2x = 0
-centaur/vl/loader/make-implicit-wires.pcert1 : no_pcert = 0
-centaur/vl/loader/make-implicit-wires.pcert1 : centaur/vl/loader/make-implicit-wires.pcert0
-centaur/vl/loader/make-implicit-wires.cert : | centaur/vl/loader/make-implicit-wires.pcert1
-
-centaur/vl/loader/overrides.pcert0 : no_pcert = 0
-centaur/vl/loader/overrides.pcert0 : acl2x = 0
-centaur/vl/loader/overrides.pcert0 : \
-     centaur/vl/loader/read-file.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/loader/preprocessor.pcert0 \
-     centaur/vl/loader/parse-utils.pcert0 \
-     centaur/vl/loader/parse-error.pcert0 \
-     centaur/vl/loader/filemap.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/mlib/warnings.pcert0 \
-     oslib/ls.pcert0 \
-     str/top.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/overrides.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/overrides.pcert1 : acl2x = 0
-centaur/vl/loader/overrides.pcert1 : no_pcert = 0
-centaur/vl/loader/overrides.pcert1 : centaur/vl/loader/overrides.pcert0
-centaur/vl/loader/overrides.cert : | centaur/vl/loader/overrides.pcert1
-
-centaur/vl/loader/parse-blockitems.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-blockitems.pcert0 : acl2x = 0
-centaur/vl/loader/parse-blockitems.pcert0 : \
-     centaur/vl/loader/parse-ranges.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-blockitems.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-blockitems.pcert1 : acl2x = 0
-centaur/vl/loader/parse-blockitems.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-blockitems.pcert1 : centaur/vl/loader/parse-blockitems.pcert0
-centaur/vl/loader/parse-blockitems.cert : | centaur/vl/loader/parse-blockitems.pcert1
-
-centaur/vl/loader/parse-delays.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-delays.pcert0 : acl2x = 0
-centaur/vl/loader/parse-delays.pcert0 : \
-     centaur/vl/loader/parse-expressions.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-delays.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-delays.pcert1 : acl2x = 0
-centaur/vl/loader/parse-delays.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-delays.pcert1 : centaur/vl/loader/parse-delays.pcert0
-centaur/vl/loader/parse-delays.cert : | centaur/vl/loader/parse-delays.pcert1
-
-centaur/vl/loader/parse-error.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-error.pcert0 : acl2x = 0
-centaur/vl/loader/parse-error.pcert0 : \
-     centaur/vl/loader/lexer-tokens.pcert0 \
-     centaur/vl/mlib/fmt.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-error.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-error.pcert1 : acl2x = 0
-centaur/vl/loader/parse-error.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-error.pcert1 : centaur/vl/loader/parse-error.pcert0
-centaur/vl/loader/parse-error.cert : | centaur/vl/loader/parse-error.pcert1
-
-centaur/vl/loader/parse-eventctrl.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-eventctrl.pcert0 : acl2x = 0
-centaur/vl/loader/parse-eventctrl.pcert0 : \
-     centaur/vl/loader/parse-delays.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-eventctrl.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-eventctrl.pcert1 : acl2x = 0
-centaur/vl/loader/parse-eventctrl.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-eventctrl.pcert1 : centaur/vl/loader/parse-eventctrl.pcert0
-centaur/vl/loader/parse-eventctrl.cert : | centaur/vl/loader/parse-eventctrl.pcert1
-
-centaur/vl/loader/parse-expressions-def.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-expressions-def.pcert0 : acl2x = 0
-centaur/vl/loader/parse-expressions-def.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/loader/parse-utils.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-expressions-def.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-expressions-def.pcert1 : acl2x = 0
-centaur/vl/loader/parse-expressions-def.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-expressions-def.pcert1 : centaur/vl/loader/parse-expressions-def.pcert0
-centaur/vl/loader/parse-expressions-def.cert : | centaur/vl/loader/parse-expressions-def.pcert1
-
-centaur/vl/loader/parse-expressions-eof.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-expressions-eof.pcert0 : acl2x = 0
-centaur/vl/loader/parse-expressions-eof.pcert0 : \
-     centaur/vl/loader/parse-expressions-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-expressions-eof.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-expressions-eof.pcert1 : acl2x = 0
-centaur/vl/loader/parse-expressions-eof.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-expressions-eof.pcert1 : centaur/vl/loader/parse-expressions-eof.pcert0
-centaur/vl/loader/parse-expressions-eof.cert : | centaur/vl/loader/parse-expressions-eof.pcert1
-
-centaur/vl/loader/parse-expressions-error.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-expressions-error.pcert0 : acl2x = 0
-centaur/vl/loader/parse-expressions-error.pcert0 : \
-     centaur/vl/loader/parse-expressions-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-expressions-error.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-expressions-error.pcert1 : acl2x = 0
-centaur/vl/loader/parse-expressions-error.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-expressions-error.pcert1 : centaur/vl/loader/parse-expressions-error.pcert0
-centaur/vl/loader/parse-expressions-error.cert : | centaur/vl/loader/parse-expressions-error.pcert1
-
-centaur/vl/loader/parse-expressions-progress.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-expressions-progress.pcert0 : acl2x = 0
-centaur/vl/loader/parse-expressions-progress.pcert0 : \
-     centaur/vl/loader/parse-expressions-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-expressions-progress.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-expressions-progress.pcert1 : acl2x = 0
-centaur/vl/loader/parse-expressions-progress.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-expressions-progress.pcert1 : centaur/vl/loader/parse-expressions-progress.pcert0
-centaur/vl/loader/parse-expressions-progress.cert : | centaur/vl/loader/parse-expressions-progress.pcert1
-
-centaur/vl/loader/parse-expressions-result.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-expressions-result.pcert0 : acl2x = 0
-centaur/vl/loader/parse-expressions-result.pcert0 : \
-     centaur/vl/loader/parse-expressions-def.pcert0 \
-     centaur/vl/loader/parse-expressions-tokenlist.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-expressions-result.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-expressions-result.pcert1 : acl2x = 0
-centaur/vl/loader/parse-expressions-result.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-expressions-result.pcert1 : centaur/vl/loader/parse-expressions-result.pcert0
-centaur/vl/loader/parse-expressions-result.cert : | centaur/vl/loader/parse-expressions-result.pcert1
-
-centaur/vl/loader/parse-expressions-tokenlist.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-expressions-tokenlist.pcert0 : acl2x = 0
-centaur/vl/loader/parse-expressions-tokenlist.pcert0 : \
-     centaur/vl/loader/parse-expressions-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-expressions-tokenlist.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-expressions-tokenlist.pcert1 : acl2x = 0
-centaur/vl/loader/parse-expressions-tokenlist.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-expressions-tokenlist.pcert1 : centaur/vl/loader/parse-expressions-tokenlist.pcert0
-centaur/vl/loader/parse-expressions-tokenlist.cert : | centaur/vl/loader/parse-expressions-tokenlist.pcert1
-
-centaur/vl/loader/parse-expressions-warnings.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-expressions-warnings.pcert0 : acl2x = 0
-centaur/vl/loader/parse-expressions-warnings.pcert0 : \
-     centaur/vl/loader/parse-expressions-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-expressions-warnings.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-expressions-warnings.pcert1 : acl2x = 0
-centaur/vl/loader/parse-expressions-warnings.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-expressions-warnings.pcert1 : centaur/vl/loader/parse-expressions-warnings.pcert0
-centaur/vl/loader/parse-expressions-warnings.cert : | centaur/vl/loader/parse-expressions-warnings.pcert1
-
-centaur/vl/loader/parse-expressions.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-expressions.pcert0 : acl2x = 0
-centaur/vl/loader/parse-expressions.pcert0 : \
-     centaur/vl/loader/parse-expressions-def.pcert0 \
-     centaur/vl/loader/parse-expressions-error.pcert0 \
-     centaur/vl/loader/parse-expressions-tokenlist.pcert0 \
-     centaur/vl/loader/parse-expressions-warnings.pcert0 \
-     centaur/vl/loader/parse-expressions-progress.pcert0 \
-     centaur/vl/loader/parse-expressions-eof.pcert0 \
-     centaur/vl/loader/parse-expressions-result.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-expressions.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-expressions.pcert1 : acl2x = 0
-centaur/vl/loader/parse-expressions.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-expressions.pcert1 : centaur/vl/loader/parse-expressions.pcert0
-centaur/vl/loader/parse-expressions.cert : | centaur/vl/loader/parse-expressions.pcert1
-
-centaur/vl/loader/parse-functions.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-functions.pcert0 : acl2x = 0
-centaur/vl/loader/parse-functions.pcert0 : \
-     centaur/vl/loader/parse-blockitems.pcert0 \
-     centaur/vl/loader/parse-ports.pcert0 \
-     centaur/vl/loader/parse-statements.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-functions.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-functions.pcert1 : acl2x = 0
-centaur/vl/loader/parse-functions.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-functions.pcert1 : centaur/vl/loader/parse-functions.pcert0
-centaur/vl/loader/parse-functions.cert : | centaur/vl/loader/parse-functions.pcert1
-
-centaur/vl/loader/parse-gates.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-gates.pcert0 : acl2x = 0
-centaur/vl/loader/parse-gates.pcert0 : \
-     centaur/vl/loader/parse-strengths.pcert0 \
-     centaur/vl/loader/parse-delays.pcert0 \
-     centaur/vl/loader/parse-ranges.pcert0 \
-     centaur/vl/loader/parse-lvalues.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-gates.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-gates.pcert1 : acl2x = 0
-centaur/vl/loader/parse-gates.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-gates.pcert1 : centaur/vl/loader/parse-gates.pcert0
-centaur/vl/loader/parse-gates.cert : | centaur/vl/loader/parse-gates.pcert1
-
-centaur/vl/loader/parse-insts.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-insts.pcert0 : acl2x = 0
-centaur/vl/loader/parse-insts.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/loader/parse-ranges.pcert0 \
-     centaur/vl/loader/parse-lvalues.pcert0 \
-     centaur/vl/loader/parse-delays.pcert0 \
-     centaur/vl/loader/parse-strengths.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-insts.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-insts.pcert1 : acl2x = 0
-centaur/vl/loader/parse-insts.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-insts.pcert1 : centaur/vl/loader/parse-insts.pcert0
-centaur/vl/loader/parse-insts.cert : | centaur/vl/loader/parse-insts.pcert1
-
-centaur/vl/loader/parse-lvalues.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-lvalues.pcert0 : acl2x = 0
-centaur/vl/loader/parse-lvalues.pcert0 : \
-     centaur/vl/loader/parse-expressions.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-lvalues.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-lvalues.pcert1 : acl2x = 0
-centaur/vl/loader/parse-lvalues.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-lvalues.pcert1 : centaur/vl/loader/parse-lvalues.pcert0
-centaur/vl/loader/parse-lvalues.cert : | centaur/vl/loader/parse-lvalues.pcert1
-
-centaur/vl/loader/parse-modules.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-modules.pcert0 : acl2x = 0
-centaur/vl/loader/parse-modules.pcert0 : \
-     centaur/vl/loader/parse-statements.pcert0 \
-     centaur/vl/loader/parse-ports.pcert0 \
-     centaur/vl/loader/parse-nets.pcert0 \
-     centaur/vl/loader/parse-blockitems.pcert0 \
-     centaur/vl/loader/parse-insts.pcert0 \
-     centaur/vl/loader/parse-gates.pcert0 \
-     centaur/vl/loader/parse-functions.pcert0 \
-     centaur/vl/loader/make-implicit-wires.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/mlib/port-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-modules.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-modules.pcert1 : acl2x = 0
-centaur/vl/loader/parse-modules.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-modules.pcert1 : centaur/vl/loader/parse-modules.pcert0
-centaur/vl/loader/parse-modules.cert : | centaur/vl/loader/parse-modules.pcert1
-
-centaur/vl/loader/parse-nets.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-nets.pcert0 : acl2x = 0
-centaur/vl/loader/parse-nets.pcert0 : \
-     centaur/vl/loader/parse-ranges.pcert0 \
-     centaur/vl/loader/parse-lvalues.pcert0 \
-     centaur/vl/loader/parse-delays.pcert0 \
-     centaur/vl/loader/parse-strengths.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-nets.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-nets.pcert1 : acl2x = 0
-centaur/vl/loader/parse-nets.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-nets.pcert1 : centaur/vl/loader/parse-nets.pcert0
-centaur/vl/loader/parse-nets.cert : | centaur/vl/loader/parse-nets.pcert1
-
-centaur/vl/loader/parse-ports.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-ports.pcert0 : acl2x = 0
-centaur/vl/loader/parse-ports.pcert0 : \
-     centaur/vl/loader/parse-nets.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-ports.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-ports.pcert1 : acl2x = 0
-centaur/vl/loader/parse-ports.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-ports.pcert1 : centaur/vl/loader/parse-ports.pcert0
-centaur/vl/loader/parse-ports.cert : | centaur/vl/loader/parse-ports.pcert1
-
-centaur/vl/loader/parse-ranges.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-ranges.pcert0 : acl2x = 0
-centaur/vl/loader/parse-ranges.pcert0 : \
-     centaur/vl/loader/parse-expressions.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-ranges.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-ranges.pcert1 : acl2x = 0
-centaur/vl/loader/parse-ranges.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-ranges.pcert1 : centaur/vl/loader/parse-ranges.pcert0
-centaur/vl/loader/parse-ranges.cert : | centaur/vl/loader/parse-ranges.pcert1
-
-centaur/vl/loader/parse-statements-def.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-statements-def.pcert0 : acl2x = 0
-centaur/vl/loader/parse-statements-def.pcert0 : \
-     centaur/vl/loader/parse-eventctrl.pcert0 \
-     centaur/vl/loader/parse-blockitems.pcert0 \
-     centaur/vl/loader/parse-lvalues.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-statements-def.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-statements-def.pcert1 : acl2x = 0
-centaur/vl/loader/parse-statements-def.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-statements-def.pcert1 : centaur/vl/loader/parse-statements-def.pcert0
-centaur/vl/loader/parse-statements-def.cert : | centaur/vl/loader/parse-statements-def.pcert1
-
-centaur/vl/loader/parse-statements-error.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-statements-error.pcert0 : acl2x = 0
-centaur/vl/loader/parse-statements-error.pcert0 : \
-     centaur/vl/loader/parse-statements-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-statements-error.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-statements-error.pcert1 : acl2x = 0
-centaur/vl/loader/parse-statements-error.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-statements-error.pcert1 : centaur/vl/loader/parse-statements-error.pcert0
-centaur/vl/loader/parse-statements-error.cert : | centaur/vl/loader/parse-statements-error.pcert1
-
-centaur/vl/loader/parse-statements-progress.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-statements-progress.pcert0 : acl2x = 0
-centaur/vl/loader/parse-statements-progress.pcert0 : \
-     centaur/vl/loader/parse-statements-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-statements-progress.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-statements-progress.pcert1 : acl2x = 0
-centaur/vl/loader/parse-statements-progress.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-statements-progress.pcert1 : centaur/vl/loader/parse-statements-progress.pcert0
-centaur/vl/loader/parse-statements-progress.cert : | centaur/vl/loader/parse-statements-progress.pcert1
-
-centaur/vl/loader/parse-statements-result.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-statements-result.pcert0 : acl2x = 0
-centaur/vl/loader/parse-statements-result.pcert0 : \
-     centaur/vl/loader/parse-statements-def.pcert0 \
-     centaur/vl/loader/parse-statements-tokenlist.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-statements-result.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-statements-result.pcert1 : acl2x = 0
-centaur/vl/loader/parse-statements-result.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-statements-result.pcert1 : centaur/vl/loader/parse-statements-result.pcert0
-centaur/vl/loader/parse-statements-result.cert : | centaur/vl/loader/parse-statements-result.pcert1
-
-centaur/vl/loader/parse-statements-tokenlist.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-statements-tokenlist.pcert0 : acl2x = 0
-centaur/vl/loader/parse-statements-tokenlist.pcert0 : \
-     centaur/vl/loader/parse-statements-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-statements-tokenlist.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-statements-tokenlist.pcert1 : acl2x = 0
-centaur/vl/loader/parse-statements-tokenlist.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-statements-tokenlist.pcert1 : centaur/vl/loader/parse-statements-tokenlist.pcert0
-centaur/vl/loader/parse-statements-tokenlist.cert : | centaur/vl/loader/parse-statements-tokenlist.pcert1
-
-centaur/vl/loader/parse-statements-warninglist.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-statements-warninglist.pcert0 : acl2x = 0
-centaur/vl/loader/parse-statements-warninglist.pcert0 : \
-     centaur/vl/loader/parse-statements-def.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-statements-warninglist.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-statements-warninglist.pcert1 : acl2x = 0
-centaur/vl/loader/parse-statements-warninglist.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-statements-warninglist.pcert1 : centaur/vl/loader/parse-statements-warninglist.pcert0
-centaur/vl/loader/parse-statements-warninglist.cert : | centaur/vl/loader/parse-statements-warninglist.pcert1
-
-centaur/vl/loader/parse-statements.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-statements.pcert0 : acl2x = 0
-centaur/vl/loader/parse-statements.pcert0 : \
-     centaur/vl/loader/parse-statements-def.pcert0 \
-     centaur/vl/loader/parse-statements-error.pcert0 \
-     centaur/vl/loader/parse-statements-progress.pcert0 \
-     centaur/vl/loader/parse-statements-tokenlist.pcert0 \
-     centaur/vl/loader/parse-statements-warninglist.pcert0 \
-     centaur/vl/loader/parse-statements-result.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-statements.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-statements.pcert1 : acl2x = 0
-centaur/vl/loader/parse-statements.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-statements.pcert1 : centaur/vl/loader/parse-statements.pcert0
-centaur/vl/loader/parse-statements.cert : | centaur/vl/loader/parse-statements.pcert1
-
-centaur/vl/loader/parse-strengths.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-strengths.pcert0 : acl2x = 0
-centaur/vl/loader/parse-strengths.pcert0 : \
-     centaur/vl/loader/parse-utils.pcert0 \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-strengths.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-strengths.pcert1 : acl2x = 0
-centaur/vl/loader/parse-strengths.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-strengths.pcert1 : centaur/vl/loader/parse-strengths.pcert0
-centaur/vl/loader/parse-strengths.cert : | centaur/vl/loader/parse-strengths.pcert1
-
-centaur/vl/loader/parse-utils.pcert0 : no_pcert = 0
-centaur/vl/loader/parse-utils.pcert0 : acl2x = 0
-centaur/vl/loader/parse-utils.pcert0 : \
-     centaur/vl/loader/lexer-tokens.pcert0 \
-     misc/seqw.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     tools/flag.pcert0 \
-     centaur/vl/util/warnings.pcert0 \
-     tools/rulesets.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parse-utils.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parse-utils.pcert1 : acl2x = 0
-centaur/vl/loader/parse-utils.pcert1 : no_pcert = 0
-centaur/vl/loader/parse-utils.pcert1 : centaur/vl/loader/parse-utils.pcert0
-centaur/vl/loader/parse-utils.cert : | centaur/vl/loader/parse-utils.pcert1
-
-centaur/vl/loader/parser.pcert0 : no_pcert = 0
-centaur/vl/loader/parser.pcert0 : acl2x = 0
-centaur/vl/loader/parser.pcert0 : \
-     centaur/vl/loader/parse-modules.pcert0 \
-     centaur/vl/loader/parse-error.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/parser.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/parser.pcert1 : acl2x = 0
-centaur/vl/loader/parser.pcert1 : no_pcert = 0
-centaur/vl/loader/parser.pcert1 : centaur/vl/loader/parser.pcert0
-centaur/vl/loader/parser.cert : | centaur/vl/loader/parser.pcert1
-
-centaur/vl/loader/preprocessor-tests.pcert0 : no_pcert = 0
-centaur/vl/loader/preprocessor-tests.pcert0 : acl2x = 0
-centaur/vl/loader/preprocessor-tests.pcert0 : \
-     centaur/vl/loader/preprocessor.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/preprocessor-tests.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/preprocessor-tests.pcert1 : acl2x = 0
-centaur/vl/loader/preprocessor-tests.pcert1 : no_pcert = 0
-centaur/vl/loader/preprocessor-tests.pcert1 : centaur/vl/loader/preprocessor-tests.pcert0
-centaur/vl/loader/preprocessor-tests.cert : | centaur/vl/loader/preprocessor-tests.pcert1
-
-centaur/vl/loader/preprocessor.pcert0 : no_pcert = 0
-centaur/vl/loader/preprocessor.pcert0 : acl2x = 0
-centaur/vl/loader/preprocessor.pcert0 : \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/loader/read-file.pcert0 \
-     centaur/vl/loader/find-file.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/loader/defines.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/preprocessor.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/preprocessor.pcert1 : acl2x = 0
-centaur/vl/loader/preprocessor.pcert1 : no_pcert = 0
-centaur/vl/loader/preprocessor.pcert1 : centaur/vl/loader/preprocessor.pcert0
-centaur/vl/loader/preprocessor.cert : | centaur/vl/loader/preprocessor.pcert1
-
-centaur/vl/loader/read-file.pcert0 : no_pcert = 0
-centaur/vl/loader/read-file.pcert0 : acl2x = 0
-centaur/vl/loader/read-file.pcert0 : \
-     centaur/vl/util/echars.pcert0 \
-     std/io/file-measure.pcert0 \
-     std/io/open-input-channel.pcert0 \
-     std/io/read-byte.pcert0 \
-     std/io/close-input-channel.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/loader/read-file.lisp \
-     centaur/vl/loader/cert.acl2
-centaur/vl/loader/read-file.pcert1 : acl2x = 0
-centaur/vl/loader/read-file.pcert1 : no_pcert = 0
-centaur/vl/loader/read-file.pcert1 : centaur/vl/loader/read-file.pcert0
-centaur/vl/loader/read-file.cert : | centaur/vl/loader/read-file.pcert1
-
-centaur/vl/mlib/allexprs.pcert0 : no_pcert = 0
-centaur/vl/mlib/allexprs.pcert0 : acl2x = 0
-centaur/vl/mlib/allexprs.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/allexprs.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/allexprs.pcert1 : acl2x = 0
-centaur/vl/mlib/allexprs.pcert1 : no_pcert = 0
-centaur/vl/mlib/allexprs.pcert1 : centaur/vl/mlib/allexprs.pcert0
-centaur/vl/mlib/allexprs.cert : | centaur/vl/mlib/allexprs.pcert1
-
-centaur/vl/mlib/atts.pcert0 : no_pcert = 0
-centaur/vl/mlib/atts.pcert0 : acl2x = 0
-centaur/vl/mlib/atts.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/atts.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/atts.pcert1 : acl2x = 0
-centaur/vl/mlib/atts.pcert1 : no_pcert = 0
-centaur/vl/mlib/atts.pcert1 : centaur/vl/mlib/atts.pcert0
-centaur/vl/mlib/atts.cert : | centaur/vl/mlib/atts.pcert1
-
-centaur/vl/mlib/clean-concats.pcert0 : no_pcert = 0
-centaur/vl/mlib/clean-concats.pcert0 : acl2x = 0
-centaur/vl/mlib/clean-concats.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/clean-concats.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/clean-concats.pcert1 : acl2x = 0
-centaur/vl/mlib/clean-concats.pcert1 : no_pcert = 0
-centaur/vl/mlib/clean-concats.pcert1 : centaur/vl/mlib/clean-concats.pcert0
-centaur/vl/mlib/clean-concats.cert : | centaur/vl/mlib/clean-concats.pcert1
-
-centaur/vl/mlib/comment-writer.pcert0 : no_pcert = 0
-centaur/vl/mlib/comment-writer.pcert0 : acl2x = 0
-centaur/vl/mlib/comment-writer.pcert0 : \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/loader/inject-comments.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/comment-writer.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/comment-writer.pcert1 : acl2x = 0
-centaur/vl/mlib/comment-writer.pcert1 : no_pcert = 0
-centaur/vl/mlib/comment-writer.pcert1 : centaur/vl/mlib/comment-writer.pcert0
-centaur/vl/mlib/comment-writer.cert : | centaur/vl/mlib/comment-writer.pcert1
-
-centaur/vl/mlib/context.pcert0 : no_pcert = 0
-centaur/vl/mlib/context.pcert0 : acl2x = 0
-centaur/vl/mlib/context.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/context.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/context.pcert1 : acl2x = 0
-centaur/vl/mlib/context.pcert1 : no_pcert = 0
-centaur/vl/mlib/context.pcert1 : centaur/vl/mlib/context.pcert0
-centaur/vl/mlib/context.cert : | centaur/vl/mlib/context.pcert1
-
-centaur/vl/mlib/ctxexprs.pcert0 : no_pcert = 0
-centaur/vl/mlib/ctxexprs.pcert0 : acl2x = 0
-centaur/vl/mlib/ctxexprs.pcert0 : \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/ctxexprs.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/ctxexprs.pcert1 : acl2x = 0
-centaur/vl/mlib/ctxexprs.pcert1 : no_pcert = 0
-centaur/vl/mlib/ctxexprs.pcert1 : centaur/vl/mlib/ctxexprs.pcert0
-centaur/vl/mlib/ctxexprs.cert : | centaur/vl/mlib/ctxexprs.pcert1
-
-centaur/vl/mlib/delta.pcert0 : no_pcert = 0
-centaur/vl/mlib/delta.pcert0 : acl2x = 0
-centaur/vl/mlib/delta.pcert0 : \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/delta.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/delta.pcert1 : acl2x = 0
-centaur/vl/mlib/delta.pcert1 : no_pcert = 0
-centaur/vl/mlib/delta.pcert1 : centaur/vl/mlib/delta.pcert0
-centaur/vl/mlib/delta.cert : | centaur/vl/mlib/delta.pcert1
-
-centaur/vl/mlib/expr-building.pcert0 : no_pcert = 0
-centaur/vl/mlib/expr-building.pcert0 : acl2x = 0
-centaur/vl/mlib/expr-building.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/expr-building.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/expr-building.pcert1 : acl2x = 0
-centaur/vl/mlib/expr-building.pcert1 : no_pcert = 0
-centaur/vl/mlib/expr-building.pcert1 : centaur/vl/mlib/expr-building.pcert0
-centaur/vl/mlib/expr-building.cert : | centaur/vl/mlib/expr-building.pcert1
-
-centaur/vl/mlib/expr-parse.pcert0 : no_pcert = 0
-centaur/vl/mlib/expr-parse.pcert0 : acl2x = 0
-centaur/vl/mlib/expr-parse.pcert0 : \
-     centaur/vl/mlib/print-warnings.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/loader/parse-expressions.pcert0 \
-     centaur/vl/loader/parse-error.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/expr-parse.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/expr-parse.pcert1 : acl2x = 0
-centaur/vl/mlib/expr-parse.pcert1 : no_pcert = 0
-centaur/vl/mlib/expr-parse.pcert1 : centaur/vl/mlib/expr-parse.pcert0
-centaur/vl/mlib/expr-parse.cert : | centaur/vl/mlib/expr-parse.pcert1
-
-centaur/vl/mlib/expr-slice.pcert0 : no_pcert = 0
-centaur/vl/mlib/expr-slice.pcert0 : acl2x = 0
-centaur/vl/mlib/expr-slice.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/mlib/welltyped.pcert0 \
-     centaur/vl/mlib/expr-building.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/expr-slice.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/expr-slice.pcert1 : acl2x = 0
-centaur/vl/mlib/expr-slice.pcert1 : no_pcert = 0
-centaur/vl/mlib/expr-slice.pcert1 : centaur/vl/mlib/expr-slice.pcert0
-centaur/vl/mlib/expr-slice.cert : | centaur/vl/mlib/expr-slice.pcert1
-
-centaur/vl/mlib/expr-tools.pcert0 : no_pcert = 0
-centaur/vl/mlib/expr-tools.pcert0 : acl2x = 0
-centaur/vl/mlib/expr-tools.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/expr-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/expr-tools.pcert1 : acl2x = 0
-centaur/vl/mlib/expr-tools.pcert1 : no_pcert = 0
-centaur/vl/mlib/expr-tools.pcert1 : centaur/vl/mlib/expr-tools.pcert0
-centaur/vl/mlib/expr-tools.cert : | centaur/vl/mlib/expr-tools.pcert1
-
-centaur/vl/mlib/filter.pcert0 : no_pcert = 0
-centaur/vl/mlib/filter.pcert0 : acl2x = 0
-centaur/vl/mlib/filter.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/filter.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/filter.pcert1 : acl2x = 0
-centaur/vl/mlib/filter.pcert1 : no_pcert = 0
-centaur/vl/mlib/filter.pcert1 : centaur/vl/mlib/filter.pcert0
-centaur/vl/mlib/filter.cert : | centaur/vl/mlib/filter.pcert1
-
-centaur/vl/mlib/find-item.pcert0 : no_pcert = 0
-centaur/vl/mlib/find-item.pcert0 : acl2x = 0
-centaur/vl/mlib/find-item.pcert0 : \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/find-item.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/find-item.pcert1 : acl2x = 0
-centaur/vl/mlib/find-item.pcert1 : no_pcert = 0
-centaur/vl/mlib/find-item.pcert1 : centaur/vl/mlib/find-item.pcert0
-centaur/vl/mlib/find-item.cert : | centaur/vl/mlib/find-item.pcert1
-
-centaur/vl/mlib/find-module.pcert0 : no_pcert = 0
-centaur/vl/mlib/find-module.pcert0 : acl2x = 0
-centaur/vl/mlib/find-module.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/find-module.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/find-module.pcert1 : acl2x = 0
-centaur/vl/mlib/find-module.pcert1 : no_pcert = 0
-centaur/vl/mlib/find-module.pcert1 : centaur/vl/mlib/find-module.pcert0
-centaur/vl/mlib/find-module.cert : | centaur/vl/mlib/find-module.pcert1
-
-centaur/vl/mlib/fmt.pcert0 : no_pcert = 0
-centaur/vl/mlib/fmt.pcert0 : acl2x = 0
-centaur/vl/mlib/fmt.pcert0 : \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/mlib/print-context.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/fmt.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/fmt.pcert1 : acl2x = 0
-centaur/vl/mlib/fmt.pcert1 : no_pcert = 0
-centaur/vl/mlib/fmt.pcert1 : centaur/vl/mlib/fmt.pcert0
-centaur/vl/mlib/fmt.cert : | centaur/vl/mlib/fmt.pcert1
-
-centaur/vl/mlib/hid-tools.pcert0 : no_pcert = 0
-centaur/vl/mlib/hid-tools.pcert0 : acl2x = 0
-centaur/vl/mlib/hid-tools.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/hid-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/hid-tools.pcert1 : acl2x = 0
-centaur/vl/mlib/hid-tools.pcert1 : no_pcert = 0
-centaur/vl/mlib/hid-tools.pcert1 : centaur/vl/mlib/hid-tools.pcert0
-centaur/vl/mlib/hid-tools.cert : | centaur/vl/mlib/hid-tools.pcert1
-
-centaur/vl/mlib/hierarchy.pcert0 : no_pcert = 0
-centaur/vl/mlib/hierarchy.pcert0 : acl2x = 0
-centaur/vl/mlib/hierarchy.pcert0 : \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/mlib/filter.pcert0 \
-     centaur/vl/util/string-alists.pcert0 \
-     centaur/vl/util/defwellformed.pcert0 \
-     centaur/vl/mlib/modname-sets.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/misc/osets-witnessing.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/hierarchy.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/hierarchy.pcert1 : acl2x = 0
-centaur/vl/mlib/hierarchy.pcert1 : no_pcert = 0
-centaur/vl/mlib/hierarchy.pcert1 : centaur/vl/mlib/hierarchy.pcert0
-centaur/vl/mlib/hierarchy.cert : | centaur/vl/mlib/hierarchy.pcert1
-
-centaur/vl/mlib/lvalues-mentioning.pcert0 : no_pcert = 0
-centaur/vl/mlib/lvalues-mentioning.pcert0 : acl2x = 0
-centaur/vl/mlib/lvalues-mentioning.pcert0 : \
-     centaur/vl/mlib/lvalues.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/lvalues-mentioning.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/lvalues-mentioning.pcert1 : acl2x = 0
-centaur/vl/mlib/lvalues-mentioning.pcert1 : no_pcert = 0
-centaur/vl/mlib/lvalues-mentioning.pcert1 : centaur/vl/mlib/lvalues-mentioning.pcert0
-centaur/vl/mlib/lvalues-mentioning.cert : | centaur/vl/mlib/lvalues-mentioning.pcert1
-
-centaur/vl/mlib/lvalues.pcert0 : no_pcert = 0
-centaur/vl/mlib/lvalues.pcert0 : acl2x = 0
-centaur/vl/mlib/lvalues.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/hid-tools.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/lvalues.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/lvalues.pcert1 : acl2x = 0
-centaur/vl/mlib/lvalues.pcert1 : no_pcert = 0
-centaur/vl/mlib/lvalues.pcert1 : centaur/vl/mlib/lvalues.pcert0
-centaur/vl/mlib/lvalues.cert : | centaur/vl/mlib/lvalues.pcert1
-
-centaur/vl/mlib/modname-sets.pcert0 : no_pcert = 0
-centaur/vl/mlib/modname-sets.pcert0 : acl2x = 0
-centaur/vl/mlib/modname-sets.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/modname-sets.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/modname-sets.pcert1 : acl2x = 0
-centaur/vl/mlib/modname-sets.pcert1 : no_pcert = 0
-centaur/vl/mlib/modname-sets.pcert1 : centaur/vl/mlib/modname-sets.pcert0
-centaur/vl/mlib/modname-sets.cert : | centaur/vl/mlib/modname-sets.pcert1
-
-centaur/vl/mlib/modnamespace.pcert0 : no_pcert = 0
-centaur/vl/mlib/modnamespace.pcert0 : acl2x = 0
-centaur/vl/mlib/modnamespace.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/modnamespace.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/modnamespace.pcert1 : acl2x = 0
-centaur/vl/mlib/modnamespace.pcert1 : no_pcert = 0
-centaur/vl/mlib/modnamespace.pcert1 : centaur/vl/mlib/modnamespace.pcert0
-centaur/vl/mlib/modnamespace.cert : | centaur/vl/mlib/modnamespace.pcert1
-
-centaur/vl/mlib/namefactory.pcert0 : no_pcert = 0
-centaur/vl/mlib/namefactory.pcert0 : acl2x = 0
-centaur/vl/mlib/namefactory.pcert0 : \
-     centaur/vl/util/namedb.pcert0 \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/namefactory.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/namefactory.pcert1 : acl2x = 0
-centaur/vl/mlib/namefactory.pcert1 : no_pcert = 0
-centaur/vl/mlib/namefactory.pcert1 : centaur/vl/mlib/namefactory.pcert0
-centaur/vl/mlib/namefactory.cert : | centaur/vl/mlib/namefactory.pcert1
-
-centaur/vl/mlib/namemangle.pcert0 : no_pcert = 0
-centaur/vl/mlib/namemangle.pcert0 : acl2x = 0
-centaur/vl/mlib/namemangle.pcert0 : \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/namemangle.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/namemangle.pcert1 : acl2x = 0
-centaur/vl/mlib/namemangle.pcert1 : no_pcert = 0
-centaur/vl/mlib/namemangle.pcert1 : centaur/vl/mlib/namemangle.pcert0
-centaur/vl/mlib/namemangle.cert : | centaur/vl/mlib/namemangle.pcert1
-
-centaur/vl/mlib/port-tools.pcert0 : no_pcert = 0
-centaur/vl/mlib/port-tools.pcert0 : acl2x = 0
-centaur/vl/mlib/port-tools.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/port-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/port-tools.pcert1 : acl2x = 0
-centaur/vl/mlib/port-tools.pcert1 : no_pcert = 0
-centaur/vl/mlib/port-tools.pcert1 : centaur/vl/mlib/port-tools.pcert0
-centaur/vl/mlib/port-tools.cert : | centaur/vl/mlib/port-tools.pcert1
-
-centaur/vl/mlib/print-context.pcert0 : no_pcert = 0
-centaur/vl/mlib/print-context.pcert0 : acl2x = 0
-centaur/vl/mlib/print-context.pcert0 : \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/print-context.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/print-context.pcert1 : acl2x = 0
-centaur/vl/mlib/print-context.pcert1 : no_pcert = 0
-centaur/vl/mlib/print-context.pcert1 : centaur/vl/mlib/print-context.pcert0
-centaur/vl/mlib/print-context.cert : | centaur/vl/mlib/print-context.pcert1
-
-centaur/vl/mlib/print-warnings.pcert0 : no_pcert = 0
-centaur/vl/mlib/print-warnings.pcert0 : acl2x = 0
-centaur/vl/mlib/print-warnings.pcert0 : \
-     centaur/vl/mlib/warnings.pcert0 \
-     centaur/vl/mlib/fmt.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/print-warnings.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/print-warnings.pcert1 : acl2x = 0
-centaur/vl/mlib/print-warnings.pcert1 : no_pcert = 0
-centaur/vl/mlib/print-warnings.pcert1 : centaur/vl/mlib/print-warnings.pcert0
-centaur/vl/mlib/print-warnings.cert : | centaur/vl/mlib/print-warnings.pcert1
-
-centaur/vl/mlib/range-tools.pcert0 : no_pcert = 0
-centaur/vl/mlib/range-tools.pcert0 : acl2x = 0
-centaur/vl/mlib/range-tools.pcert0 : \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/range-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/range-tools.pcert1 : acl2x = 0
-centaur/vl/mlib/range-tools.pcert1 : no_pcert = 0
-centaur/vl/mlib/range-tools.pcert1 : centaur/vl/mlib/range-tools.pcert0
-centaur/vl/mlib/range-tools.cert : | centaur/vl/mlib/range-tools.pcert1
-
-centaur/vl/mlib/relocate.pcert0 : no_pcert = 0
-centaur/vl/mlib/relocate.pcert0 : acl2x = 0
-centaur/vl/mlib/relocate.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/relocate.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/relocate.pcert1 : acl2x = 0
-centaur/vl/mlib/relocate.pcert1 : no_pcert = 0
-centaur/vl/mlib/relocate.pcert1 : centaur/vl/mlib/relocate.pcert0
-centaur/vl/mlib/relocate.cert : | centaur/vl/mlib/relocate.pcert1
-
-centaur/vl/mlib/remove-bad.pcert0 : no_pcert = 0
-centaur/vl/mlib/remove-bad.pcert0 : acl2x = 0
-centaur/vl/mlib/remove-bad.pcert0 : \
-     centaur/vl/mlib/hierarchy.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/mlib/modname-sets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/remove-bad.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/remove-bad.pcert1 : acl2x = 0
-centaur/vl/mlib/remove-bad.pcert1 : no_pcert = 0
-centaur/vl/mlib/remove-bad.pcert1 : centaur/vl/mlib/remove-bad.pcert0
-centaur/vl/mlib/remove-bad.cert : | centaur/vl/mlib/remove-bad.pcert1
-
-centaur/vl/mlib/rvalues.pcert0 : no_pcert = 0
-centaur/vl/mlib/rvalues.pcert0 : acl2x = 0
-centaur/vl/mlib/rvalues.pcert0 : \
-     centaur/vl/mlib/hid-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/rvalues.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/rvalues.pcert1 : acl2x = 0
-centaur/vl/mlib/rvalues.pcert1 : no_pcert = 0
-centaur/vl/mlib/rvalues.pcert1 : centaur/vl/mlib/rvalues.pcert0
-centaur/vl/mlib/rvalues.cert : | centaur/vl/mlib/rvalues.pcert1
-
-centaur/vl/mlib/stmt-tools.pcert0 : no_pcert = 0
-centaur/vl/mlib/stmt-tools.pcert0 : acl2x = 0
-centaur/vl/mlib/stmt-tools.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/stmt-tools.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/stmt-tools.pcert1 : acl2x = 0
-centaur/vl/mlib/stmt-tools.pcert1 : no_pcert = 0
-centaur/vl/mlib/stmt-tools.pcert1 : centaur/vl/mlib/stmt-tools.pcert0
-centaur/vl/mlib/stmt-tools.cert : | centaur/vl/mlib/stmt-tools.pcert1
-
-centaur/vl/mlib/sub-counts.pcert0 : no_pcert = 0
-centaur/vl/mlib/sub-counts.pcert0 : acl2x = 0
-centaur/vl/mlib/sub-counts.pcert0 : \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/vl/transforms/xf-resolve-ranges.pcert0 \
-     centaur/vl/transforms/xf-subst.pcert0 \
-     centaur/vl/transforms/xf-unparameterize.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/sub-counts.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/sub-counts.pcert1 : acl2x = 0
-centaur/vl/mlib/sub-counts.pcert1 : no_pcert = 0
-centaur/vl/mlib/sub-counts.pcert1 : centaur/vl/mlib/sub-counts.pcert0
-centaur/vl/mlib/sub-counts.cert : | centaur/vl/mlib/sub-counts.pcert1
-
-centaur/vl/mlib/warnings.pcert0 : no_pcert = 0
-centaur/vl/mlib/warnings.pcert0 : acl2x = 0
-centaur/vl/mlib/warnings.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/warnings.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/warnings.pcert1 : acl2x = 0
-centaur/vl/mlib/warnings.pcert1 : no_pcert = 0
-centaur/vl/mlib/warnings.pcert1 : centaur/vl/mlib/warnings.pcert0
-centaur/vl/mlib/warnings.cert : | centaur/vl/mlib/warnings.pcert1
-
-centaur/vl/mlib/welltyped.pcert0 : no_pcert = 0
-centaur/vl/mlib/welltyped.pcert0 : acl2x = 0
-centaur/vl/mlib/welltyped.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/sum-nats.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/welltyped.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/welltyped.pcert1 : acl2x = 0
-centaur/vl/mlib/welltyped.pcert1 : no_pcert = 0
-centaur/vl/mlib/welltyped.pcert1 : centaur/vl/mlib/welltyped.pcert0
-centaur/vl/mlib/welltyped.cert : | centaur/vl/mlib/welltyped.pcert1
-
-centaur/vl/mlib/writer.pcert0 : no_pcert = 0
-centaur/vl/mlib/writer.pcert0 : acl2x = 0
-centaur/vl/mlib/writer.pcert0 : \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/loader/lexer.pcert0 \
-     centaur/vl/util/print.pcert0 \
-     str/strrpos.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/mlib/writer.lisp \
-     centaur/vl/mlib/cert.acl2
-centaur/vl/mlib/writer.pcert1 : acl2x = 0
-centaur/vl/mlib/writer.pcert1 : no_pcert = 0
-centaur/vl/mlib/writer.pcert1 : centaur/vl/mlib/writer.pcert0
-centaur/vl/mlib/writer.cert : | centaur/vl/mlib/writer.pcert1
-
-centaur/vl/onehot.pcert0 : no_pcert = 0
-centaur/vl/onehot.pcert0 : acl2x = 0
-centaur/vl/onehot.pcert0 : \
-     centaur/vl/transforms/occform/simple.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     arithmetic-5/top.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/onehot.lisp \
-     centaur/vl/cert.acl2
-centaur/vl/onehot.pcert1 : acl2x = 0
-centaur/vl/onehot.pcert1 : no_pcert = 0
-centaur/vl/onehot.pcert1 : centaur/vl/onehot.pcert0
-centaur/vl/onehot.cert : | centaur/vl/onehot.pcert1
-
-centaur/vl/parsetree.pcert0 : no_pcert = 0
-centaur/vl/parsetree.pcert0 : acl2x = 0
-centaur/vl/parsetree.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/bits.pcert0 \
-     centaur/vl/util/commentmap.pcert0 \
-     centaur/vl/util/warnings.pcert0 \
-     centaur/vl/util/echars.pcert0 \
-     tools/flag.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/parsetree.lisp \
-     centaur/vl/cert.acl2
-centaur/vl/parsetree.pcert1 : acl2x = 0
-centaur/vl/parsetree.pcert1 : no_pcert = 0
-centaur/vl/parsetree.pcert1 : centaur/vl/parsetree.pcert0
-centaur/vl/parsetree.cert : | centaur/vl/parsetree.pcert1
-
-centaur/vl/portcullis.pcert0 : no_pcert = 0
-centaur/vl/portcullis.pcert0 : acl2x = 0
-centaur/vl/portcullis.pcert0 : \
-     tools/safe-case.pcert0 \
-     xdoc/top.pcert0 \
-     clause-processors/autohide.pcert0 \
-     tools/rulesets.pcert0 \
-     centaur/vl/portcullis.lisp \
-     centaur/vl/portcullis.acl2 \
-     centaur/vl/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     centaur/vl/other-packages.lsp \
-     data-structures/define-u-package.lsp \
-     tools/flag-package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     cowles/packages.lsp
-centaur/vl/portcullis.pcert1 : acl2x = 0
-centaur/vl/portcullis.pcert1 : no_pcert = 0
-centaur/vl/portcullis.pcert1 : centaur/vl/portcullis.pcert0
-centaur/vl/portcullis.cert : | centaur/vl/portcullis.pcert1
-
-centaur/vl/primitives.pcert0 : no_pcert = 0
-centaur/vl/primitives.pcert0 : acl2x = 0
-centaur/vl/primitives.pcert0 : \
-     centaur/vl/mlib/expr-building.pcert0 \
-     centaur/esim/esim-primitives.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/primitives.lisp \
-     centaur/vl/cert.acl2
-centaur/vl/primitives.pcert1 : acl2x = 0
-centaur/vl/primitives.pcert1 : no_pcert = 0
-centaur/vl/primitives.pcert1 : centaur/vl/primitives.pcert0
-centaur/vl/primitives.cert : | centaur/vl/primitives.pcert1
-
-centaur/vl/toe/toe-add-res-modules.pcert0 : no_pcert = 0
-centaur/vl/toe/toe-add-res-modules.pcert0 : acl2x = 0
-centaur/vl/toe/toe-add-res-modules.pcert0 : \
-     centaur/vl/toe/toe-wirealist.pcert0 \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/esim/esim-primitives.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/esim-lemmas.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/toe/toe-add-res-modules.lisp \
-     centaur/vl/toe/cert.acl2
-centaur/vl/toe/toe-add-res-modules.pcert1 : acl2x = 0
-centaur/vl/toe/toe-add-res-modules.pcert1 : no_pcert = 0
-centaur/vl/toe/toe-add-res-modules.pcert1 : centaur/vl/toe/toe-add-res-modules.pcert0
-centaur/vl/toe/toe-add-res-modules.cert : | centaur/vl/toe/toe-add-res-modules.pcert1
-
-centaur/vl/toe/toe-add-zdrivers.pcert0 : no_pcert = 0
-centaur/vl/toe/toe-add-zdrivers.pcert0 : acl2x = 0
-centaur/vl/toe/toe-add-zdrivers.pcert0 : \
-     centaur/vl/toe/toe-wirealist.pcert0 \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/esim/esim-primitives.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/esim-lemmas.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/toe/toe-add-zdrivers.lisp \
-     centaur/vl/toe/cert.acl2
-centaur/vl/toe/toe-add-zdrivers.pcert1 : acl2x = 0
-centaur/vl/toe/toe-add-zdrivers.pcert1 : no_pcert = 0
-centaur/vl/toe/toe-add-zdrivers.pcert1 : centaur/vl/toe/toe-add-zdrivers.pcert0
-centaur/vl/toe/toe-add-zdrivers.cert : | centaur/vl/toe/toe-add-zdrivers.pcert1
-
-centaur/vl/toe/toe-emodwire.pcert0 : no_pcert = 0
-centaur/vl/toe/toe-emodwire.pcert0 : acl2x = 0
-centaur/vl/toe/toe-emodwire.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     misc/assert.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/position.pcert0 \
-     std/ks/intern-in-package-of-symbol.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/toe/toe-emodwire.lisp \
-     centaur/vl/toe/cert.acl2
-centaur/vl/toe/toe-emodwire.pcert1 : acl2x = 0
-centaur/vl/toe/toe-emodwire.pcert1 : no_pcert = 0
-centaur/vl/toe/toe-emodwire.pcert1 : centaur/vl/toe/toe-emodwire.pcert0
-centaur/vl/toe/toe-emodwire.cert : | centaur/vl/toe/toe-emodwire.pcert1
-
-centaur/vl/toe/toe-eocc-allnames.pcert0 : no_pcert = 0
-centaur/vl/toe/toe-eocc-allnames.pcert0 : acl2x = 0
-centaur/vl/toe/toe-eocc-allnames.pcert0 : \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/vl/toe/toe-emodwire.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/esim-lemmas.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/toe/toe-eocc-allnames.lisp \
-     centaur/vl/toe/cert.acl2
-centaur/vl/toe/toe-eocc-allnames.pcert1 : acl2x = 0
-centaur/vl/toe/toe-eocc-allnames.pcert1 : no_pcert = 0
-centaur/vl/toe/toe-eocc-allnames.pcert1 : centaur/vl/toe/toe-eocc-allnames.pcert0
-centaur/vl/toe/toe-eocc-allnames.cert : | centaur/vl/toe/toe-eocc-allnames.pcert1
-
-centaur/vl/toe/toe-preliminary.pcert0 : no_pcert = 0
-centaur/vl/toe/toe-preliminary.pcert0 : acl2x = 0
-centaur/vl/toe/toe-preliminary.pcert0 : \
-     centaur/vl/toe/toe-wirealist.pcert0 \
-     centaur/vl/toe/toe-verilogify.pcert0 \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/util/esim-lemmas.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/toe/toe-preliminary.lisp \
-     centaur/vl/toe/cert.acl2
-centaur/vl/toe/toe-preliminary.pcert1 : acl2x = 0
-centaur/vl/toe/toe-preliminary.pcert1 : no_pcert = 0
-centaur/vl/toe/toe-preliminary.pcert1 : centaur/vl/toe/toe-preliminary.pcert0
-centaur/vl/toe/toe-preliminary.cert : | centaur/vl/toe/toe-preliminary.pcert1
-
-centaur/vl/toe/toe-top.pcert0 : no_pcert = 0
-centaur/vl/toe/toe-top.pcert0 : acl2x = 0
-centaur/vl/toe/toe-top.pcert0 : \
-     centaur/vl/toe/toe-eocc-allnames.pcert0 \
-     centaur/vl/toe/toe-preliminary.pcert0 \
-     centaur/vl/toe/toe-add-res-modules.pcert0 \
-     centaur/vl/toe/toe-add-zdrivers.pcert0 \
-     centaur/vl/mlib/remove-bad.pcert0 \
-     centaur/vl/mlib/atts.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/esim-lemmas.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/toe/toe-top.lisp \
-     centaur/vl/toe/cert.acl2
-centaur/vl/toe/toe-top.pcert1 : acl2x = 0
-centaur/vl/toe/toe-top.pcert1 : no_pcert = 0
-centaur/vl/toe/toe-top.pcert1 : centaur/vl/toe/toe-top.pcert0
-centaur/vl/toe/toe-top.cert : | centaur/vl/toe/toe-top.pcert1
-
-centaur/vl/toe/toe-verilogify.pcert0 : no_pcert = 0
-centaur/vl/toe/toe-verilogify.pcert0 : acl2x = 0
-centaur/vl/toe/toe-verilogify.pcert0 : \
-     centaur/vl/toe/toe-emodwire.pcert0 \
-     misc/assert.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/toe/toe-verilogify.lisp \
-     centaur/vl/toe/cert.acl2
-centaur/vl/toe/toe-verilogify.pcert1 : acl2x = 0
-centaur/vl/toe/toe-verilogify.pcert1 : no_pcert = 0
-centaur/vl/toe/toe-verilogify.pcert1 : centaur/vl/toe/toe-verilogify.pcert0
-centaur/vl/toe/toe-verilogify.cert : | centaur/vl/toe/toe-verilogify.pcert1
-
-centaur/vl/toe/toe-wirealist.pcert0 : no_pcert = 0
-centaur/vl/toe/toe-wirealist.pcert0 : acl2x = 0
-centaur/vl/toe/toe-wirealist.pcert0 : \
-     centaur/vl/toe/toe-emodwire.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/intersectp-equal.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/toe/toe-wirealist.lisp \
-     centaur/vl/toe/cert.acl2
-centaur/vl/toe/toe-wirealist.pcert1 : acl2x = 0
-centaur/vl/toe/toe-wirealist.pcert1 : no_pcert = 0
-centaur/vl/toe/toe-wirealist.pcert1 : centaur/vl/toe/toe-wirealist.pcert0
-centaur/vl/toe/toe-wirealist.cert : | centaur/vl/toe/toe-wirealist.pcert1
-
-centaur/vl/top.pcert0 : no_pcert = 0
-centaur/vl/top.pcert0 : acl2x = 0
-centaur/vl/top.pcert0 : \
-     centaur/vl/checkers/checkers.pcert0 \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/checkers/multidrive-detect.pcert0 \
-     centaur/vl/checkers/portcheck.pcert0 \
-     centaur/vl/checkers/use-set.pcert0 \
-     centaur/vl/loader/loader.pcert0 \
-     centaur/vl/mlib/comment-writer.pcert0 \
-     centaur/vl/toe/toe-top.pcert0 \
-     centaur/vl/transforms/cn-hooks.pcert0 \
-     centaur/vl/transforms/always/top.pcert0 \
-     centaur/vl/transforms/occform/top.pcert0 \
-     centaur/vl/transforms/xf-addinstnames.pcert0 \
-     centaur/vl/transforms/xf-argresolve.pcert0 \
-     centaur/vl/transforms/xf-assign-trunc.pcert0 \
-     centaur/vl/transforms/xf-blankargs.pcert0 \
-     centaur/vl/transforms/xf-clean-params.pcert0 \
-     centaur/vl/transforms/xf-designregs.pcert0 \
-     centaur/vl/transforms/xf-designwires.pcert0 \
-     centaur/vl/transforms/xf-delayredux.pcert0 \
-     centaur/vl/transforms/xf-drop-blankports.pcert0 \
-     centaur/vl/transforms/xf-elim-supply.pcert0 \
-     centaur/vl/transforms/xf-expand-functions.pcert0 \
-     centaur/vl/transforms/xf-expr-split.pcert0 \
-     centaur/vl/transforms/xf-follow-hids.pcert0 \
-     centaur/vl/transforms/xf-gateredux.pcert0 \
-     centaur/vl/transforms/xf-gatesplit.pcert0 \
-     centaur/vl/transforms/xf-gate-elim.pcert0 \
-     centaur/vl/transforms/xf-hid-elim.pcert0 \
-     centaur/vl/transforms/xf-oprewrite.pcert0 \
-     centaur/vl/transforms/xf-optimize-rw.pcert0 \
-     centaur/vl/transforms/xf-orig.pcert0 \
-     centaur/vl/transforms/xf-portdecl-sign.pcert0 \
-     centaur/vl/transforms/xf-replicate-insts.pcert0 \
-     centaur/vl/transforms/xf-resolve-ranges.pcert0 \
-     centaur/vl/transforms/xf-sizing.pcert0 \
-     centaur/vl/transforms/xf-unparameterize.pcert0 \
-     centaur/vl/transforms/xf-unused-reg.pcert0 \
-     centaur/vl/transforms/xf-weirdint-elim.pcert0 \
-     centaur/vl/transforms/xf-annotate-mods.pcert0 \
-     centaur/vl/util/clean-alist.pcert0 \
-     centaur/vl/translation.pcert0 \
-     centaur/misc/sneaky-load.pcert0 \
-     centaur/vl/mlib/modname-sets.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     system/f-put-global.pcert0 \
-     centaur/vl/loader/lexer-tests.pcert0 \
-     centaur/vl/loader/preprocessor-tests.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/top.lisp \
-     centaur/vl/top.acl2
-centaur/vl/top.pcert1 : acl2x = 0
-centaur/vl/top.pcert1 : no_pcert = 0
-centaur/vl/top.pcert1 : centaur/vl/top.pcert0
-centaur/vl/top.cert : | centaur/vl/top.pcert1
-
-centaur/vl/transforms/always/conditions.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/conditions.pcert0 : acl2x = 0
-centaur/vl/transforms/always/conditions.pcert0 : \
-     centaur/vl/mlib/welltyped.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/conditions.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/conditions.pcert1 : acl2x = 0
-centaur/vl/transforms/always/conditions.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/conditions.pcert1 : centaur/vl/transforms/always/conditions.pcert0
-centaur/vl/transforms/always/conditions.cert : | centaur/vl/transforms/always/conditions.pcert1
-
-centaur/vl/transforms/always/elimalways.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/elimalways.pcert0 : acl2x = 0
-centaur/vl/transforms/always/elimalways.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/elimalways.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/elimalways.pcert1 : acl2x = 0
-centaur/vl/transforms/always/elimalways.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/elimalways.pcert1 : centaur/vl/transforms/always/elimalways.pcert0
-centaur/vl/transforms/always/elimalways.cert : | centaur/vl/transforms/always/elimalways.pcert1
-
-centaur/vl/transforms/always/eliminitial.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/eliminitial.pcert0 : acl2x = 0
-centaur/vl/transforms/always/eliminitial.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/eliminitial.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/eliminitial.pcert1 : acl2x = 0
-centaur/vl/transforms/always/eliminitial.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/eliminitial.pcert1 : centaur/vl/transforms/always/eliminitial.pcert0
-centaur/vl/transforms/always/eliminitial.cert : | centaur/vl/transforms/always/eliminitial.pcert1
-
-centaur/vl/transforms/always/elimnegedge.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/elimnegedge.pcert0 : acl2x = 0
-centaur/vl/transforms/always/elimnegedge.pcert0 : \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/mlib/delta.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/transforms/occform/util.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/elimnegedge.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/elimnegedge.pcert1 : acl2x = 0
-centaur/vl/transforms/always/elimnegedge.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/elimnegedge.pcert1 : centaur/vl/transforms/always/elimnegedge.pcert0
-centaur/vl/transforms/always/elimnegedge.cert : | centaur/vl/transforms/always/elimnegedge.pcert1
-
-centaur/vl/transforms/always/flopcode-debug.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/flopcode-debug.pcert0 : acl2x = 0
-centaur/vl/transforms/always/flopcode-debug.pcert0 : \
-     centaur/vl/transforms/always/flopcode-prog.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/flopcode-debug.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/flopcode-debug.pcert1 : acl2x = 0
-centaur/vl/transforms/always/flopcode-debug.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/flopcode-debug.pcert1 : centaur/vl/transforms/always/flopcode-debug.pcert0
-centaur/vl/transforms/always/flopcode-debug.cert : | centaur/vl/transforms/always/flopcode-debug.pcert1
-
-centaur/vl/transforms/always/flopcode-prog.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/flopcode-prog.pcert0 : acl2x = 0
-centaur/vl/transforms/always/flopcode-prog.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/welltyped.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/flopcode-prog.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/flopcode-prog.pcert1 : acl2x = 0
-centaur/vl/transforms/always/flopcode-prog.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/flopcode-prog.pcert1 : centaur/vl/transforms/always/flopcode-prog.pcert0
-centaur/vl/transforms/always/flopcode-prog.cert : | centaur/vl/transforms/always/flopcode-prog.pcert1
-
-centaur/vl/transforms/always/flopcode-synth.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/flopcode-synth.pcert0 : acl2x = 0
-centaur/vl/transforms/always/flopcode-synth.pcert0 : \
-     centaur/vl/transforms/always/flopcode-prog.pcert0 \
-     centaur/vl/transforms/always/flopcode-debug.pcert0 \
-     centaur/vl/transforms/always/util.pcert0 \
-     centaur/vl/transforms/always/make-flop.pcert0 \
-     centaur/vl/mlib/delta.pcert0 \
-     centaur/vl/mlib/filter.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/flopcode-synth.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/flopcode-synth.pcert1 : acl2x = 0
-centaur/vl/transforms/always/flopcode-synth.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/flopcode-synth.pcert1 : centaur/vl/transforms/always/flopcode-synth.pcert0
-centaur/vl/transforms/always/flopcode-synth.cert : | centaur/vl/transforms/always/flopcode-synth.pcert1
-
-centaur/vl/transforms/always/ifmerge.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/ifmerge.pcert0 : acl2x = 0
-centaur/vl/transforms/always/ifmerge.pcert0 : \
-     centaur/vl/transforms/always/conditions.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/ifmerge.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/ifmerge.pcert1 : acl2x = 0
-centaur/vl/transforms/always/ifmerge.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/ifmerge.pcert1 : centaur/vl/transforms/always/ifmerge.pcert0
-centaur/vl/transforms/always/ifmerge.cert : | centaur/vl/transforms/always/ifmerge.pcert1
-
-centaur/vl/transforms/always/latchcode.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/latchcode.pcert0 : acl2x = 0
-centaur/vl/transforms/always/latchcode.pcert0 : \
-     centaur/vl/transforms/always/util.pcert0 \
-     centaur/vl/transforms/always/make-latch.pcert0 \
-     centaur/vl/mlib/delta.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/latchcode.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/latchcode.pcert1 : acl2x = 0
-centaur/vl/transforms/always/latchcode.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/latchcode.pcert1 : centaur/vl/transforms/always/latchcode.pcert0
-centaur/vl/transforms/always/latchcode.cert : | centaur/vl/transforms/always/latchcode.pcert1
-
-centaur/vl/transforms/always/make-flop.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/make-flop.pcert0 : acl2x = 0
-centaur/vl/transforms/always/make-flop.pcert0 : \
-     centaur/vl/primitives.pcert0 \
-     centaur/vl/transforms/occform/util.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/make-flop.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/make-flop.pcert1 : acl2x = 0
-centaur/vl/transforms/always/make-flop.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/make-flop.pcert1 : centaur/vl/transforms/always/make-flop.pcert0
-centaur/vl/transforms/always/make-flop.cert : | centaur/vl/transforms/always/make-flop.pcert1
-
-centaur/vl/transforms/always/make-latch.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/make-latch.pcert0 : acl2x = 0
-centaur/vl/transforms/always/make-latch.pcert0 : \
-     centaur/vl/primitives.pcert0 \
-     centaur/vl/transforms/occform/util.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/make-latch.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/make-latch.pcert1 : acl2x = 0
-centaur/vl/transforms/always/make-latch.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/make-latch.pcert1 : centaur/vl/transforms/always/make-latch.pcert0
-centaur/vl/transforms/always/make-latch.cert : | centaur/vl/transforms/always/make-latch.pcert1
-
-centaur/vl/transforms/always/stmtrewrite.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/stmtrewrite.pcert0 : acl2x = 0
-centaur/vl/transforms/always/stmtrewrite.pcert0 : \
-     centaur/vl/transforms/xf-resolve-ranges.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/stmtrewrite.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/stmtrewrite.pcert1 : acl2x = 0
-centaur/vl/transforms/always/stmtrewrite.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/stmtrewrite.pcert1 : centaur/vl/transforms/always/stmtrewrite.pcert0
-centaur/vl/transforms/always/stmtrewrite.cert : | centaur/vl/transforms/always/stmtrewrite.pcert1
-
-centaur/vl/transforms/always/stmttemps.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/stmttemps.pcert0 : acl2x = 0
-centaur/vl/transforms/always/stmttemps.pcert0 : \
-     centaur/vl/transforms/always/util.pcert0 \
-     centaur/vl/transforms/always/conditions.pcert0 \
-     centaur/vl/transforms/occform/util.pcert0 \
-     centaur/vl/mlib/expr-slice.pcert0 \
-     centaur/vl/mlib/delta.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/stmttemps.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/stmttemps.pcert1 : acl2x = 0
-centaur/vl/transforms/always/stmttemps.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/stmttemps.pcert1 : centaur/vl/transforms/always/stmttemps.pcert0
-centaur/vl/transforms/always/stmttemps.cert : | centaur/vl/transforms/always/stmttemps.pcert1
-
-centaur/vl/transforms/always/synthalways.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/synthalways.pcert0 : acl2x = 0
-centaur/vl/transforms/always/synthalways.pcert0 : \
-     centaur/vl/transforms/always/flopcode-synth.pcert0 \
-     centaur/vl/transforms/always/latchcode.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/synthalways.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/synthalways.pcert1 : acl2x = 0
-centaur/vl/transforms/always/synthalways.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/synthalways.pcert1 : centaur/vl/transforms/always/synthalways.pcert0
-centaur/vl/transforms/always/synthalways.cert : | centaur/vl/transforms/always/synthalways.pcert1
-
-centaur/vl/transforms/always/top.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/top.pcert0 : acl2x = 0
-centaur/vl/transforms/always/top.pcert0 : \
-     centaur/vl/transforms/always/elimalways.pcert0 \
-     centaur/vl/transforms/always/eliminitial.pcert0 \
-     centaur/vl/transforms/always/elimnegedge.pcert0 \
-     centaur/vl/transforms/always/synthalways.pcert0 \
-     centaur/vl/transforms/always/stmtrewrite.pcert0 \
-     centaur/vl/transforms/always/stmttemps.pcert0 \
-     centaur/vl/transforms/always/unelse.pcert0 \
-     centaur/vl/transforms/always/ifmerge.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/top.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/top.pcert1 : acl2x = 0
-centaur/vl/transforms/always/top.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/top.pcert1 : centaur/vl/transforms/always/top.pcert0
-centaur/vl/transforms/always/top.cert : | centaur/vl/transforms/always/top.pcert1
-
-centaur/vl/transforms/always/unelse.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/unelse.pcert0 : acl2x = 0
-centaur/vl/transforms/always/unelse.pcert0 : \
-     centaur/vl/transforms/always/conditions.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/unelse.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/unelse.pcert1 : acl2x = 0
-centaur/vl/transforms/always/unelse.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/unelse.pcert1 : centaur/vl/transforms/always/unelse.pcert0
-centaur/vl/transforms/always/unelse.cert : | centaur/vl/transforms/always/unelse.pcert1
-
-centaur/vl/transforms/always/util.pcert0 : no_pcert = 0
-centaur/vl/transforms/always/util.pcert0 : acl2x = 0
-centaur/vl/transforms/always/util.pcert0 : \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/mlib/lvalues.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/always/util.lisp \
-     centaur/vl/transforms/always/cert.acl2
-centaur/vl/transforms/always/util.pcert1 : acl2x = 0
-centaur/vl/transforms/always/util.pcert1 : no_pcert = 0
-centaur/vl/transforms/always/util.pcert1 : centaur/vl/transforms/always/util.pcert0
-centaur/vl/transforms/always/util.cert : | centaur/vl/transforms/always/util.pcert1
-
-centaur/vl/transforms/cn-hooks.pcert0 : no_pcert = 0
-centaur/vl/transforms/cn-hooks.pcert0 : acl2x = 0
-centaur/vl/transforms/cn-hooks.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/cn-hooks.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/cn-hooks.pcert1 : acl2x = 0
-centaur/vl/transforms/cn-hooks.pcert1 : no_pcert = 0
-centaur/vl/transforms/cn-hooks.pcert1 : centaur/vl/transforms/cn-hooks.pcert0
-centaur/vl/transforms/cn-hooks.cert : | centaur/vl/transforms/cn-hooks.pcert1
-
-centaur/vl/transforms/occform/add.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/add.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/add.pcert0 : \
-     centaur/vl/transforms/occform/simple.pcert0 \
-     centaur/vl/transforms/occform/xdet.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/add.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/add.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/add.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/add.pcert1 : centaur/vl/transforms/occform/add.pcert0
-centaur/vl/transforms/occform/add.cert : | centaur/vl/transforms/occform/add.pcert1
-
-centaur/vl/transforms/occform/compare.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/compare.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/compare.pcert0 : \
-     centaur/vl/transforms/occform/add.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/compare.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/compare.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/compare.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/compare.pcert1 : centaur/vl/transforms/occform/compare.pcert0
-centaur/vl/transforms/occform/compare.cert : | centaur/vl/transforms/occform/compare.pcert1
-
-centaur/vl/transforms/occform/div.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/div.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/div.pcert0 : \
-     centaur/vl/transforms/occform/add.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/div.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/div.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/div.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/div.pcert1 : centaur/vl/transforms/occform/div.pcert0
-centaur/vl/transforms/occform/div.cert : | centaur/vl/transforms/occform/div.pcert1
-
-centaur/vl/transforms/occform/mul.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/mul.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/mul.pcert0 : \
-     centaur/vl/transforms/occform/add.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/mul.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/mul.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/mul.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/mul.pcert1 : centaur/vl/transforms/occform/mul.pcert0
-centaur/vl/transforms/occform/mul.cert : | centaur/vl/transforms/occform/mul.pcert1
-
-centaur/vl/transforms/occform/select.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/select.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/select.pcert0 : \
-     centaur/vl/transforms/occform/simple.pcert0 \
-     centaur/vl/util/next-power-of-2.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/select.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/select.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/select.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/select.pcert1 : centaur/vl/transforms/occform/select.pcert0
-centaur/vl/transforms/occform/select.cert : | centaur/vl/transforms/occform/select.pcert1
-
-centaur/vl/transforms/occform/shl.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/shl.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/shl.pcert0 : \
-     centaur/vl/transforms/occform/simple.pcert0 \
-     centaur/vl/transforms/occform/xdet.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/shl.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/shl.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/shl.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/shl.pcert1 : centaur/vl/transforms/occform/shl.pcert0
-centaur/vl/transforms/occform/shl.cert : | centaur/vl/transforms/occform/shl.pcert1
-
-centaur/vl/transforms/occform/shr.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/shr.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/shr.pcert0 : \
-     centaur/vl/transforms/occform/shl.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/shr.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/shr.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/shr.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/shr.pcert1 : centaur/vl/transforms/occform/shr.pcert0
-centaur/vl/transforms/occform/shr.cert : | centaur/vl/transforms/occform/shr.pcert1
-
-centaur/vl/transforms/occform/simple.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/simple.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/simple.pcert0 : \
-     centaur/vl/transforms/occform/util.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/simple.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/simple.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/simple.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/simple.pcert1 : centaur/vl/transforms/occform/simple.pcert0
-centaur/vl/transforms/occform/simple.cert : | centaur/vl/transforms/occform/simple.pcert1
-
-centaur/vl/transforms/occform/top.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/top.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/top.pcert0 : \
-     centaur/vl/transforms/occform/add.pcert0 \
-     centaur/vl/transforms/occform/compare.pcert0 \
-     centaur/vl/transforms/occform/div.pcert0 \
-     centaur/vl/transforms/occform/mul.pcert0 \
-     centaur/vl/transforms/occform/select.pcert0 \
-     centaur/vl/transforms/occform/shl.pcert0 \
-     centaur/vl/transforms/occform/shr.pcert0 \
-     centaur/vl/transforms/occform/simple.pcert0 \
-     centaur/vl/transforms/occform/xdet.pcert0 \
-     centaur/vl/mlib/expr-slice.pcert0 \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/top.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/top.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/top.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/top.pcert1 : centaur/vl/transforms/occform/top.pcert0
-centaur/vl/transforms/occform/top.cert : | centaur/vl/transforms/occform/top.pcert1
-
-centaur/vl/transforms/occform/util.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/util.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/util.pcert0 : \
-     centaur/vl/primitives.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/expr-building.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/util.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/util.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/util.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/util.pcert1 : centaur/vl/transforms/occform/util.pcert0
-centaur/vl/transforms/occform/util.cert : | centaur/vl/transforms/occform/util.pcert1
-
-centaur/vl/transforms/occform/xdet.pcert0 : no_pcert = 0
-centaur/vl/transforms/occform/xdet.pcert0 : acl2x = 0
-centaur/vl/transforms/occform/xdet.pcert0 : \
-     centaur/vl/transforms/occform/simple.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/occform/xdet.lisp \
-     centaur/vl/transforms/occform/cert.acl2
-centaur/vl/transforms/occform/xdet.pcert1 : acl2x = 0
-centaur/vl/transforms/occform/xdet.pcert1 : no_pcert = 0
-centaur/vl/transforms/occform/xdet.pcert1 : centaur/vl/transforms/occform/xdet.pcert0
-centaur/vl/transforms/occform/xdet.cert : | centaur/vl/transforms/occform/xdet.pcert1
-
-centaur/vl/transforms/xf-addinstnames.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-addinstnames.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-addinstnames.pcert0 : \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-addinstnames.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-addinstnames.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-addinstnames.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-addinstnames.pcert1 : centaur/vl/transforms/xf-addinstnames.pcert0
-centaur/vl/transforms/xf-addinstnames.cert : | centaur/vl/transforms/xf-addinstnames.pcert1
-
-centaur/vl/transforms/xf-annotate-mods.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-annotate-mods.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-annotate-mods.pcert0 : \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/checkers/portcheck.pcert0 \
-     centaur/vl/mlib/warnings.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/transforms/xf-designwires.pcert0 \
-     centaur/vl/transforms/xf-portdecl-sign.pcert0 \
-     centaur/vl/transforms/xf-argresolve.pcert0 \
-     centaur/vl/transforms/xf-orig.pcert0 \
-     centaur/vl/transforms/cn-hooks.pcert0 \
-     centaur/vl/transforms/xf-follow-hids.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-annotate-mods.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-annotate-mods.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-annotate-mods.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-annotate-mods.pcert1 : centaur/vl/transforms/xf-annotate-mods.pcert0
-centaur/vl/transforms/xf-annotate-mods.cert : | centaur/vl/transforms/xf-annotate-mods.pcert1
-
-centaur/vl/transforms/xf-argresolve.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-argresolve.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-argresolve.pcert0 : \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/mlib/port-tools.pcert0 \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-argresolve.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-argresolve.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-argresolve.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-argresolve.pcert1 : centaur/vl/transforms/xf-argresolve.pcert0
-centaur/vl/transforms/xf-argresolve.cert : | centaur/vl/transforms/xf-argresolve.pcert1
-
-centaur/vl/transforms/xf-array-indexing.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-array-indexing.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-array-indexing.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-array-indexing.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-array-indexing.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-array-indexing.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-array-indexing.pcert1 : centaur/vl/transforms/xf-array-indexing.pcert0
-centaur/vl/transforms/xf-array-indexing.cert : | centaur/vl/transforms/xf-array-indexing.pcert1
-
-centaur/vl/transforms/xf-assign-trunc.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-assign-trunc.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-assign-trunc.pcert0 : \
-     centaur/vl/wf-ranges-resolved-p.pcert0 \
-     centaur/vl/wf-widthsfixed-p.pcert0 \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/mlib/welltyped.pcert0 \
-     centaur/vl/mlib/delta.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-assign-trunc.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-assign-trunc.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-assign-trunc.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-assign-trunc.pcert1 : centaur/vl/transforms/xf-assign-trunc.pcert0
-centaur/vl/transforms/xf-assign-trunc.cert : | centaur/vl/transforms/xf-assign-trunc.pcert1
-
-centaur/vl/transforms/xf-blankargs.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-blankargs.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-blankargs.pcert0 : \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/mlib/port-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-blankargs.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-blankargs.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-blankargs.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-blankargs.pcert1 : centaur/vl/transforms/xf-blankargs.pcert0
-centaur/vl/transforms/xf-blankargs.cert : | centaur/vl/transforms/xf-blankargs.pcert1
-
-centaur/vl/transforms/xf-clean-params.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-clean-params.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-clean-params.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/mlib/filter.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-clean-params.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-clean-params.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-clean-params.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-clean-params.pcert1 : centaur/vl/transforms/xf-clean-params.pcert0
-centaur/vl/transforms/xf-clean-params.cert : | centaur/vl/transforms/xf-clean-params.pcert1
-
-centaur/vl/transforms/xf-clean-selects.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-clean-selects.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-clean-selects.pcert0 : \
-     centaur/vl/mlib/clean-concats.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-clean-selects.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-clean-selects.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-clean-selects.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-clean-selects.pcert1 : centaur/vl/transforms/xf-clean-selects.pcert0
-centaur/vl/transforms/xf-clean-selects.cert : | centaur/vl/transforms/xf-clean-selects.pcert1
-
-centaur/vl/transforms/xf-delayredux.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-delayredux.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-delayredux.pcert0 : \
-     centaur/vl/transforms/occform/util.pcert0 \
-     centaur/vl/mlib/delta.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-delayredux.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-delayredux.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-delayredux.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-delayredux.pcert1 : centaur/vl/transforms/xf-delayredux.pcert0
-centaur/vl/transforms/xf-delayredux.cert : | centaur/vl/transforms/xf-delayredux.pcert1
-
-centaur/vl/transforms/xf-designregs.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-designregs.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-designregs.pcert0 : \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/mlib/hid-tools.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/util/sum-nats.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     defsort/defsort.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/primitives.pcert0 \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-designregs.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-designregs.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-designregs.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-designregs.pcert1 : centaur/vl/transforms/xf-designregs.pcert0
-centaur/vl/transforms/xf-designregs.cert : | centaur/vl/transforms/xf-designregs.pcert1
-
-centaur/vl/transforms/xf-designwires.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-designwires.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-designwires.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-designwires.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-designwires.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-designwires.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-designwires.pcert1 : centaur/vl/transforms/xf-designwires.pcert0
-centaur/vl/transforms/xf-designwires.cert : | centaur/vl/transforms/xf-designwires.pcert1
-
-centaur/vl/transforms/xf-drop-blankports.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-drop-blankports.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-drop-blankports.pcert0 : \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-drop-blankports.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-drop-blankports.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-drop-blankports.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-drop-blankports.pcert1 : centaur/vl/transforms/xf-drop-blankports.pcert0
-centaur/vl/transforms/xf-drop-blankports.cert : | centaur/vl/transforms/xf-drop-blankports.pcert1
-
-centaur/vl/transforms/xf-elim-supply.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-elim-supply.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-elim-supply.pcert0 : \
-     centaur/vl/transforms/xf-subst.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-elim-supply.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-elim-supply.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-elim-supply.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-elim-supply.pcert1 : centaur/vl/transforms/xf-elim-supply.pcert0
-centaur/vl/transforms/xf-elim-supply.cert : | centaur/vl/transforms/xf-elim-supply.pcert1
-
-centaur/vl/transforms/xf-expand-functions.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-expand-functions.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-expand-functions.pcert0 : \
-     centaur/vl/transforms/always/stmtrewrite.pcert0 \
-     centaur/vl/transforms/xf-subst.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/util/toposort.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-expand-functions.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-expand-functions.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-expand-functions.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-expand-functions.pcert1 : centaur/vl/transforms/xf-expand-functions.pcert0
-centaur/vl/transforms/xf-expand-functions.cert : | centaur/vl/transforms/xf-expand-functions.pcert1
-
-centaur/vl/transforms/xf-expr-simp.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-expr-simp.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-expr-simp.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/fmt.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-expr-simp.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-expr-simp.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-expr-simp.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-expr-simp.pcert1 : centaur/vl/transforms/xf-expr-simp.pcert0
-centaur/vl/transforms/xf-expr-simp.cert : | centaur/vl/transforms/xf-expr-simp.pcert1
-
-centaur/vl/transforms/xf-expr-split.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-expr-split.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-expr-split.pcert0 : \
-     centaur/vl/mlib/expr-slice.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/mlib/delta.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-expr-split.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-expr-split.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-expr-split.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-expr-split.pcert1 : centaur/vl/transforms/xf-expr-split.pcert0
-centaur/vl/transforms/xf-expr-split.cert : | centaur/vl/transforms/xf-expr-split.pcert1
-
-centaur/vl/transforms/xf-follow-hids.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-follow-hids.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-follow-hids.pcert0 : \
-     centaur/vl/transforms/xf-resolve-ranges.pcert0 \
-     centaur/vl/mlib/hierarchy.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/hid-tools.pcert0 \
-     centaur/vl/wf-ranges-resolved-p.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-follow-hids.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-follow-hids.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-follow-hids.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-follow-hids.pcert1 : centaur/vl/transforms/xf-follow-hids.pcert0
-centaur/vl/transforms/xf-follow-hids.cert : | centaur/vl/transforms/xf-follow-hids.pcert1
-
-centaur/vl/transforms/xf-gate-elim.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-gate-elim.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-gate-elim.pcert0 : \
-     centaur/vl/primitives.pcert0 \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-gate-elim.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-gate-elim.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-gate-elim.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-gate-elim.pcert1 : centaur/vl/transforms/xf-gate-elim.pcert0
-centaur/vl/transforms/xf-gate-elim.cert : | centaur/vl/transforms/xf-gate-elim.pcert1
-
-centaur/vl/transforms/xf-gateredux.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-gateredux.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-gateredux.pcert0 : \
-     centaur/vl/transforms/occform/simple.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-gateredux.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-gateredux.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-gateredux.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-gateredux.pcert1 : centaur/vl/transforms/xf-gateredux.pcert0
-centaur/vl/transforms/xf-gateredux.cert : | centaur/vl/transforms/xf-gateredux.pcert1
-
-centaur/vl/transforms/xf-gatesplit.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-gatesplit.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-gatesplit.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-gatesplit.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-gatesplit.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-gatesplit.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-gatesplit.pcert1 : centaur/vl/transforms/xf-gatesplit.pcert0
-centaur/vl/transforms/xf-gatesplit.cert : | centaur/vl/transforms/xf-gatesplit.pcert1
-
-centaur/vl/transforms/xf-hid-elim.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-hid-elim.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-hid-elim.pcert0 : \
-     centaur/vl/transforms/xf-resolve-ranges.pcert0 \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/hid-tools.pcert0 \
-     centaur/vl/wf-ranges-resolved-p.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-hid-elim.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-hid-elim.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-hid-elim.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-hid-elim.pcert1 : centaur/vl/transforms/xf-hid-elim.pcert0
-centaur/vl/transforms/xf-hid-elim.cert : | centaur/vl/transforms/xf-hid-elim.pcert1
-
-centaur/vl/transforms/xf-inline.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-inline.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-inline.pcert0 : \
-     centaur/vl/transforms/xf-subst.pcert0 \
-     centaur/vl/mlib/namemangle.pcert0 \
-     centaur/vl/mlib/relocate.pcert0 \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/mlib/port-tools.pcert0 \
-     centaur/vl/mlib/writer.pcert0 \
-     centaur/vl/mlib/print-warnings.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-inline.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-inline.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-inline.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-inline.pcert1 : centaur/vl/transforms/xf-inline.pcert0
-centaur/vl/transforms/xf-inline.cert : | centaur/vl/transforms/xf-inline.pcert1
-
-centaur/vl/transforms/xf-oprewrite.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-oprewrite.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-oprewrite.pcert0 : \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/checkers/duplicate-detect.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-oprewrite.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-oprewrite.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-oprewrite.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-oprewrite.pcert1 : centaur/vl/transforms/xf-oprewrite.pcert0
-centaur/vl/transforms/xf-oprewrite.cert : | centaur/vl/transforms/xf-oprewrite.pcert1
-
-centaur/vl/transforms/xf-optimize-rw.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-optimize-rw.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-optimize-rw.pcert0 : \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-optimize-rw.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-optimize-rw.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-optimize-rw.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-optimize-rw.pcert1 : centaur/vl/transforms/xf-optimize-rw.pcert0
-centaur/vl/transforms/xf-optimize-rw.cert : | centaur/vl/transforms/xf-optimize-rw.pcert1
-
-centaur/vl/transforms/xf-orig.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-orig.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-orig.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-orig.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-orig.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-orig.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-orig.pcert1 : centaur/vl/transforms/xf-orig.pcert0
-centaur/vl/transforms/xf-orig.cert : | centaur/vl/transforms/xf-orig.pcert1
-
-centaur/vl/transforms/xf-portdecl-sign.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-portdecl-sign.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-portdecl-sign.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-portdecl-sign.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-portdecl-sign.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-portdecl-sign.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-portdecl-sign.pcert1 : centaur/vl/transforms/xf-portdecl-sign.pcert0
-centaur/vl/transforms/xf-portdecl-sign.cert : | centaur/vl/transforms/xf-portdecl-sign.pcert1
-
-centaur/vl/transforms/xf-propagate.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-propagate.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-propagate.pcert0 : \
-     centaur/vl/transforms/xf-subst.pcert0 \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-propagate.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-propagate.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-propagate.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-propagate.pcert1 : centaur/vl/transforms/xf-propagate.pcert0
-centaur/vl/transforms/xf-propagate.cert : | centaur/vl/transforms/xf-propagate.pcert1
-
-centaur/vl/transforms/xf-replicate-insts.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-replicate-insts.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-replicate-insts.pcert0 : \
-     centaur/vl/mlib/expr-slice.pcert0 \
-     centaur/vl/mlib/namefactory.pcert0 \
-     centaur/vl/mlib/find-module.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-replicate-insts.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-replicate-insts.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-replicate-insts.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-replicate-insts.pcert1 : centaur/vl/transforms/xf-replicate-insts.pcert0
-centaur/vl/transforms/xf-replicate-insts.cert : | centaur/vl/transforms/xf-replicate-insts.pcert1
-
-centaur/vl/transforms/xf-resolve-ranges.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-resolve-ranges.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-resolve-ranges.pcert0 : \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-resolve-ranges.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-resolve-ranges.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-resolve-ranges.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-resolve-ranges.pcert1 : centaur/vl/transforms/xf-resolve-ranges.pcert0
-centaur/vl/transforms/xf-resolve-ranges.cert : | centaur/vl/transforms/xf-resolve-ranges.pcert1
-
-centaur/vl/transforms/xf-sizing.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-sizing.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-sizing.pcert0 : \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/util/sum-nats.pcert0 \
-     centaur/vl/mlib/context.pcert0 \
-     centaur/vl/mlib/welltyped.pcert0 \
-     centaur/vl/mlib/lvalues.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/bitops/ihs-extensions.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-sizing.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-sizing.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-sizing.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-sizing.pcert1 : centaur/vl/transforms/xf-sizing.pcert0
-centaur/vl/transforms/xf-sizing.cert : | centaur/vl/transforms/xf-sizing.pcert1
-
-centaur/vl/transforms/xf-subst.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-subst.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-subst.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-subst.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-subst.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-subst.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-subst.pcert1 : centaur/vl/transforms/xf-subst.pcert0
-centaur/vl/transforms/xf-subst.cert : | centaur/vl/transforms/xf-subst.pcert1
-
-centaur/vl/transforms/xf-unparameterize.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-unparameterize.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-unparameterize.pcert0 : \
-     centaur/vl/transforms/xf-subst.pcert0 \
-     centaur/vl/mlib/remove-bad.pcert0 \
-     centaur/vl/mlib/print-warnings.pcert0 \
-     centaur/vl/wf-ranges-resolved-p.pcert0 \
-     centaur/vl/onehot.pcert0 \
-     centaur/vl/util/cwtime.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/mlib/modname-sets.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-unparameterize.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-unparameterize.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-unparameterize.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-unparameterize.pcert1 : centaur/vl/transforms/xf-unparameterize.pcert0
-centaur/vl/transforms/xf-unparameterize.cert : | centaur/vl/transforms/xf-unparameterize.pcert1
-
-centaur/vl/transforms/xf-unused-reg.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-unused-reg.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-unused-reg.pcert0 : \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-unused-reg.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-unused-reg.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-unused-reg.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-unused-reg.pcert1 : centaur/vl/transforms/xf-unused-reg.pcert0
-centaur/vl/transforms/xf-unused-reg.cert : | centaur/vl/transforms/xf-unused-reg.pcert1
-
-centaur/vl/transforms/xf-weirdint-elim.pcert0 : no_pcert = 0
-centaur/vl/transforms/xf-weirdint-elim.pcert0 : acl2x = 0
-centaur/vl/transforms/xf-weirdint-elim.pcert0 : \
-     centaur/vl/transforms/occform/util.pcert0 \
-     centaur/vl/mlib/allexprs.pcert0 \
-     centaur/vl/mlib/stmt-tools.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/transforms/xf-weirdint-elim.lisp \
-     centaur/vl/transforms/cert.acl2
-centaur/vl/transforms/xf-weirdint-elim.pcert1 : acl2x = 0
-centaur/vl/transforms/xf-weirdint-elim.pcert1 : no_pcert = 0
-centaur/vl/transforms/xf-weirdint-elim.pcert1 : centaur/vl/transforms/xf-weirdint-elim.pcert0
-centaur/vl/transforms/xf-weirdint-elim.cert : | centaur/vl/transforms/xf-weirdint-elim.pcert1
-
-centaur/vl/translation.pcert0 : no_pcert = 0
-centaur/vl/translation.pcert0 : acl2x = 0
-centaur/vl/translation.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/loader/filemap.pcert0 \
-     centaur/vl/loader/defines.pcert0 \
-     centaur/vl/checkers/use-set-report.pcert0 \
-     centaur/vl/transforms/xf-designregs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/translation.lisp \
-     centaur/vl/cert.acl2
-centaur/vl/translation.pcert1 : acl2x = 0
-centaur/vl/translation.pcert1 : no_pcert = 0
-centaur/vl/translation.pcert1 : centaur/vl/translation.pcert0
-centaur/vl/translation.cert : | centaur/vl/translation.pcert1
-
-centaur/vl/util/arithmetic.pcert0 : no_pcert = 0
-centaur/vl/util/arithmetic.pcert0 : acl2x = 0
-centaur/vl/util/arithmetic.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     centaur/bitops/integer-length.pcert0 \
-     cutil/deflist.pcert0 \
-     centaur/vl/util/subsetp-equal.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     misc/hons-help.pcert0 \
-     std/lists/list-defuns.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     std/lists/take.pcert0 \
-     std/lists/coerce.pcert0 \
-     std/lists/list-fix.pcert0 \
-     std/ks/explode-atom.pcert0 \
-     std/lists/repeat.pcert0 \
-     std/lists/rev.pcert0 \
-     defsort/duplicity.pcert0 \
-     tools/mv-nth.pcert0 \
-     tools/bstar.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/arithmetic.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/arithmetic.pcert1 : acl2x = 0
-centaur/vl/util/arithmetic.pcert1 : no_pcert = 0
-centaur/vl/util/arithmetic.pcert1 : centaur/vl/util/arithmetic.pcert0
-centaur/vl/util/arithmetic.cert : | centaur/vl/util/arithmetic.pcert1
-
-centaur/vl/util/bits.pcert0 : no_pcert = 0
-centaur/vl/util/bits.pcert0 : acl2x = 0
-centaur/vl/util/bits.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/bits.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/bits.pcert1 : acl2x = 0
-centaur/vl/util/bits.pcert1 : no_pcert = 0
-centaur/vl/util/bits.pcert1 : centaur/vl/util/bits.pcert0
-centaur/vl/util/bits.cert : | centaur/vl/util/bits.pcert1
-
-centaur/vl/util/character-list-listp.pcert0 : no_pcert = 0
-centaur/vl/util/character-list-listp.pcert0 : acl2x = 0
-centaur/vl/util/character-list-listp.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/character-list-listp.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/character-list-listp.pcert1 : acl2x = 0
-centaur/vl/util/character-list-listp.pcert1 : no_pcert = 0
-centaur/vl/util/character-list-listp.pcert1 : centaur/vl/util/character-list-listp.pcert0
-centaur/vl/util/character-list-listp.cert : | centaur/vl/util/character-list-listp.pcert1
-
-centaur/vl/util/clean-alist.pcert0 : no_pcert = 0
-centaur/vl/util/clean-alist.pcert0 : acl2x = 0
-centaur/vl/util/clean-alist.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     misc/hons-help.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/clean-alist.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/clean-alist.pcert1 : acl2x = 0
-centaur/vl/util/clean-alist.pcert1 : no_pcert = 0
-centaur/vl/util/clean-alist.pcert1 : centaur/vl/util/clean-alist.pcert0
-centaur/vl/util/clean-alist.cert : | centaur/vl/util/clean-alist.pcert1
-
-centaur/vl/util/commentmap.pcert0 : no_pcert = 0
-centaur/vl/util/commentmap.pcert0 : acl2x = 0
-centaur/vl/util/commentmap.pcert0 : \
-     centaur/vl/util/echars.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/commentmap.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/commentmap.pcert1 : acl2x = 0
-centaur/vl/util/commentmap.pcert1 : no_pcert = 0
-centaur/vl/util/commentmap.pcert1 : centaur/vl/util/commentmap.pcert0
-centaur/vl/util/commentmap.cert : | centaur/vl/util/commentmap.pcert1
-
-centaur/vl/util/cw-unformatted.pcert0 : no_pcert = 0
-centaur/vl/util/cw-unformatted.pcert0 : acl2x = 0
-centaur/vl/util/cw-unformatted.pcert0 : \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/cw-unformatted.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/cw-unformatted.pcert1 : acl2x = 0
-centaur/vl/util/cw-unformatted.pcert1 : no_pcert = 0
-centaur/vl/util/cw-unformatted.pcert1 : centaur/vl/util/cw-unformatted.pcert0
-centaur/vl/util/cw-unformatted.cert : | centaur/vl/util/cw-unformatted.pcert1
-
-centaur/vl/util/cwtime.pcert0 : no_pcert = 0
-centaur/vl/util/cwtime.pcert0 : acl2x = 0
-centaur/vl/util/cwtime.pcert0 : \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/cwtime.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/cwtime.pcert1 : acl2x = 0
-centaur/vl/util/cwtime.pcert1 : no_pcert = 0
-centaur/vl/util/cwtime.pcert1 : centaur/vl/util/cwtime.pcert0
-centaur/vl/util/cwtime.cert : | centaur/vl/util/cwtime.pcert1
-
-centaur/vl/util/defs.pcert0 : no_pcert = 0
-centaur/vl/util/defs.pcert0 : acl2x = 0
-centaur/vl/util/defs.pcert0 : \
-     cutil/top.pcert0 \
-     tools/defconsts.pcert0 \
-     std/ks/two-nats-measure.pcert0 \
-     std/lists/list-defuns.pcert0 \
-     centaur/bitops/integer-length.pcert0 \
-     centaur/misc/alist-equiv.pcert0 \
-     centaur/misc/hons-extra.pcert0 \
-     str/top.pcert0 \
-     str/fast-cat.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     centaur/misc/equal-sets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/defs.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/defs.pcert1 : acl2x = 0
-centaur/vl/util/defs.pcert1 : no_pcert = 0
-centaur/vl/util/defs.pcert1 : centaur/vl/util/defs.pcert0
-centaur/vl/util/defs.cert : | centaur/vl/util/defs.pcert1
-
-centaur/vl/util/defwellformed.pcert0 : no_pcert = 0
-centaur/vl/util/defwellformed.pcert0 : acl2x = 0
-centaur/vl/util/defwellformed.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/warnings.pcert0 \
-     tools/flag.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/defwellformed.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/defwellformed.pcert1 : acl2x = 0
-centaur/vl/util/defwellformed.pcert1 : no_pcert = 0
-centaur/vl/util/defwellformed.pcert1 : centaur/vl/util/defwellformed.pcert0
-centaur/vl/util/defwellformed.cert : | centaur/vl/util/defwellformed.pcert1
-
-centaur/vl/util/echars.pcert0 : no_pcert = 0
-centaur/vl/util/echars.pcert0 : acl2x = 0
-centaur/vl/util/echars.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     misc/assert.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/echars.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/echars.pcert1 : acl2x = 0
-centaur/vl/util/echars.pcert1 : no_pcert = 0
-centaur/vl/util/echars.pcert1 : centaur/vl/util/echars.pcert0
-centaur/vl/util/echars.cert : | centaur/vl/util/echars.pcert1
-
-centaur/vl/util/esim-lemmas.pcert0 : no_pcert = 0
-centaur/vl/util/esim-lemmas.pcert0 : acl2x = 0
-centaur/vl/util/esim-lemmas.pcert0 : \
-     centaur/esim/esim-sexpr-support.pcert0 \
-     centaur/esim/esim-sexpr-support-thms.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/esim-lemmas.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/esim-lemmas.pcert1 : acl2x = 0
-centaur/vl/util/esim-lemmas.pcert1 : no_pcert = 0
-centaur/vl/util/esim-lemmas.pcert1 : centaur/vl/util/esim-lemmas.pcert0
-centaur/vl/util/esim-lemmas.cert : | centaur/vl/util/esim-lemmas.pcert1
-
-centaur/vl/util/gc.pcert0 : no_pcert = 0
-centaur/vl/util/gc.pcert0 : acl2x = 0
-centaur/vl/util/gc.pcert0 : \
-     centaur/misc/memory-mgmt-raw.pcert0 \
-     tools/include-raw.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/gc.lisp \
-     centaur/vl/util/cert.acl2 \
-     centaur/vl/util/gc-raw.lsp
-centaur/vl/util/gc.pcert1 : acl2x = 0
-centaur/vl/util/gc.pcert1 : no_pcert = 0
-centaur/vl/util/gc.pcert1 : centaur/vl/util/gc.pcert0
-centaur/vl/util/gc.cert : | centaur/vl/util/gc.pcert1
-
-centaur/vl/util/intersectp-equal.pcert0 : no_pcert = 0
-centaur/vl/util/intersectp-equal.pcert0 : acl2x = 0
-centaur/vl/util/intersectp-equal.pcert0 : \
-     std/lists/list-defuns.pcert0 \
-     cutil/define.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/intersectp-equal.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/intersectp-equal.pcert1 : acl2x = 0
-centaur/vl/util/intersectp-equal.pcert1 : no_pcert = 0
-centaur/vl/util/intersectp-equal.pcert1 : centaur/vl/util/intersectp-equal.pcert0
-centaur/vl/util/intersectp-equal.cert : | centaur/vl/util/intersectp-equal.pcert1
-
-centaur/vl/util/namedb.pcert0 : no_pcert = 0
-centaur/vl/util/namedb.pcert0 : acl2x = 0
-centaur/vl/util/namedb.pcert0 : \
-     str/top.pcert0 \
-     centaur/vl/util/string-alists.pcert0 \
-     centaur/vl/util/nat-alists.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/namedb.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/namedb.pcert1 : acl2x = 0
-centaur/vl/util/namedb.pcert1 : no_pcert = 0
-centaur/vl/util/namedb.pcert1 : centaur/vl/util/namedb.pcert0
-centaur/vl/util/namedb.cert : | centaur/vl/util/namedb.pcert1
-
-centaur/vl/util/nat-alists.pcert0 : no_pcert = 0
-centaur/vl/util/nat-alists.pcert0 : acl2x = 0
-centaur/vl/util/nat-alists.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/nat-alists.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/nat-alists.pcert1 : acl2x = 0
-centaur/vl/util/nat-alists.pcert1 : no_pcert = 0
-centaur/vl/util/nat-alists.pcert1 : centaur/vl/util/nat-alists.pcert0
-centaur/vl/util/nat-alists.cert : | centaur/vl/util/nat-alists.pcert1
-
-centaur/vl/util/next-power-of-2.pcert0 : no_pcert = 0
-centaur/vl/util/next-power-of-2.pcert0 : acl2x = 0
-centaur/vl/util/next-power-of-2.pcert0 : \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/next-power-of-2.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/next-power-of-2.pcert1 : acl2x = 0
-centaur/vl/util/next-power-of-2.pcert1 : no_pcert = 0
-centaur/vl/util/next-power-of-2.pcert1 : centaur/vl/util/next-power-of-2.pcert0
-centaur/vl/util/next-power-of-2.cert : | centaur/vl/util/next-power-of-2.pcert1
-
-centaur/vl/util/osets.pcert0 : no_pcert = 0
-centaur/vl/util/osets.pcert0 : acl2x = 0
-centaur/vl/util/osets.pcert0 : \
-     centaur/vl/util/subsetp-equal.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/osets.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/osets.pcert1 : acl2x = 0
-centaur/vl/util/osets.pcert1 : no_pcert = 0
-centaur/vl/util/osets.pcert1 : centaur/vl/util/osets.pcert0
-centaur/vl/util/osets.cert : | centaur/vl/util/osets.pcert1
-
-centaur/vl/util/position.pcert0 : no_pcert = 0
-centaur/vl/util/position.pcert0 : acl2x = 0
-centaur/vl/util/position.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/position.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/position.pcert1 : acl2x = 0
-centaur/vl/util/position.pcert1 : no_pcert = 0
-centaur/vl/util/position.pcert1 : centaur/vl/util/position.pcert0
-centaur/vl/util/position.cert : | centaur/vl/util/position.pcert1
-
-centaur/vl/util/prefix-hash.pcert0 : no_pcert = 0
-centaur/vl/util/prefix-hash.pcert0 : acl2x = 0
-centaur/vl/util/prefix-hash.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/prefix-hash.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/prefix-hash.pcert1 : acl2x = 0
-centaur/vl/util/prefix-hash.pcert1 : no_pcert = 0
-centaur/vl/util/prefix-hash.pcert1 : centaur/vl/util/prefix-hash.pcert0
-centaur/vl/util/prefix-hash.cert : | centaur/vl/util/prefix-hash.pcert1
-
-centaur/vl/util/prefixp.pcert0 : no_pcert = 0
-centaur/vl/util/prefixp.pcert0 : acl2x = 0
-centaur/vl/util/prefixp.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/prefixp.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/prefixp.pcert1 : acl2x = 0
-centaur/vl/util/prefixp.pcert1 : no_pcert = 0
-centaur/vl/util/prefixp.pcert1 : centaur/vl/util/prefixp.pcert0
-centaur/vl/util/prefixp.cert : | centaur/vl/util/prefixp.pcert1
-
-centaur/vl/util/print-htmlencode.pcert0 : no_pcert = 0
-centaur/vl/util/print-htmlencode.pcert0 : acl2x = 0
-centaur/vl/util/print-htmlencode.pcert0 : \
-     tools/bstar.pcert0 \
-     make-event/assert.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/print-htmlencode.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/print-htmlencode.pcert1 : acl2x = 0
-centaur/vl/util/print-htmlencode.pcert1 : no_pcert = 0
-centaur/vl/util/print-htmlencode.pcert1 : centaur/vl/util/print-htmlencode.pcert0
-centaur/vl/util/print-htmlencode.cert : | centaur/vl/util/print-htmlencode.pcert1
-
-centaur/vl/util/print-urlencode.pcert0 : no_pcert = 0
-centaur/vl/util/print-urlencode.pcert0 : acl2x = 0
-centaur/vl/util/print-urlencode.pcert0 : \
-     xdoc/top.pcert0 \
-     misc/definline.pcert0 \
-     make-event/assert.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/print-urlencode.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/print-urlencode.pcert1 : acl2x = 0
-centaur/vl/util/print-urlencode.pcert1 : no_pcert = 0
-centaur/vl/util/print-urlencode.pcert1 : centaur/vl/util/print-urlencode.pcert0
-centaur/vl/util/print-urlencode.cert : | centaur/vl/util/print-urlencode.pcert1
-
-centaur/vl/util/print.pcert0 : no_pcert = 0
-centaur/vl/util/print.pcert0 : acl2x = 0
-centaur/vl/util/print.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/print-urlencode.pcert0 \
-     centaur/vl/util/print-htmlencode.pcert0 \
-     centaur/vl/util/cw-unformatted.pcert0 \
-     str/natstr.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     make-event/assert.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/print.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/print.pcert1 : acl2x = 0
-centaur/vl/util/print.pcert1 : no_pcert = 0
-centaur/vl/util/print.pcert1 : centaur/vl/util/print.pcert0
-centaur/vl/util/print.cert : | centaur/vl/util/print.pcert1
-
-centaur/vl/util/string-alists.pcert0 : no_pcert = 0
-centaur/vl/util/string-alists.pcert0 : acl2x = 0
-centaur/vl/util/string-alists.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/string-alists.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/string-alists.pcert1 : acl2x = 0
-centaur/vl/util/string-alists.pcert1 : no_pcert = 0
-centaur/vl/util/string-alists.pcert1 : centaur/vl/util/string-alists.pcert0
-centaur/vl/util/string-alists.cert : | centaur/vl/util/string-alists.pcert1
-
-centaur/vl/util/subsetp-equal.pcert0 : no_pcert = 0
-centaur/vl/util/subsetp-equal.pcert0 : acl2x = 0
-centaur/vl/util/subsetp-equal.pcert0 : \
-     centaur/misc/equal-sets.pcert0 \
-     finite-set-theory/osets/sets.pcert0 \
-     std/lists/list-fix.pcert0 \
-     std/lists/take.pcert0 \
-     defsort/duplicated-members.pcert0 \
-     arithmetic/top.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/subsetp-equal.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/subsetp-equal.pcert1 : acl2x = 0
-centaur/vl/util/subsetp-equal.pcert1 : no_pcert = 0
-centaur/vl/util/subsetp-equal.pcert1 : centaur/vl/util/subsetp-equal.pcert0
-centaur/vl/util/subsetp-equal.cert : | centaur/vl/util/subsetp-equal.pcert1
-
-centaur/vl/util/sum-nats.pcert0 : no_pcert = 0
-centaur/vl/util/sum-nats.pcert0 : acl2x = 0
-centaur/vl/util/sum-nats.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/sum-nats.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/sum-nats.pcert1 : acl2x = 0
-centaur/vl/util/sum-nats.pcert1 : no_pcert = 0
-centaur/vl/util/sum-nats.pcert1 : centaur/vl/util/sum-nats.pcert0
-centaur/vl/util/sum-nats.cert : | centaur/vl/util/sum-nats.pcert1
-
-centaur/vl/util/toposort.pcert0 : no_pcert = 0
-centaur/vl/util/toposort.pcert0 : acl2x = 0
-centaur/vl/util/toposort.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     make-event/assert.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/toposort.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/toposort.pcert1 : acl2x = 0
-centaur/vl/util/toposort.pcert1 : no_pcert = 0
-centaur/vl/util/toposort.pcert1 : centaur/vl/util/toposort.pcert0
-centaur/vl/util/toposort.cert : | centaur/vl/util/toposort.pcert1
-
-centaur/vl/util/warnings.pcert0 : no_pcert = 0
-centaur/vl/util/warnings.pcert0 : acl2x = 0
-centaur/vl/util/warnings.pcert0 : \
-     centaur/vl/util/defs.pcert0 \
-     defsort/remove-dups.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/util/warnings.lisp \
-     centaur/vl/util/cert.acl2
-centaur/vl/util/warnings.pcert1 : acl2x = 0
-centaur/vl/util/warnings.pcert1 : no_pcert = 0
-centaur/vl/util/warnings.pcert1 : centaur/vl/util/warnings.pcert0
-centaur/vl/util/warnings.cert : | centaur/vl/util/warnings.pcert1
-
-centaur/vl/wf-ranges-resolved-p.pcert0 : no_pcert = 0
-centaur/vl/wf-ranges-resolved-p.pcert0 : acl2x = 0
-centaur/vl/wf-ranges-resolved-p.pcert0 : \
-     centaur/vl/mlib/range-tools.pcert0 \
-     centaur/vl/util/defwellformed.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/wf-ranges-resolved-p.lisp \
-     centaur/vl/cert.acl2
-centaur/vl/wf-ranges-resolved-p.pcert1 : acl2x = 0
-centaur/vl/wf-ranges-resolved-p.pcert1 : no_pcert = 0
-centaur/vl/wf-ranges-resolved-p.pcert1 : centaur/vl/wf-ranges-resolved-p.pcert0
-centaur/vl/wf-ranges-resolved-p.cert : | centaur/vl/wf-ranges-resolved-p.pcert1
-
-centaur/vl/wf-reasonable-p.pcert0 : no_pcert = 0
-centaur/vl/wf-reasonable-p.pcert0 : acl2x = 0
-centaur/vl/wf-reasonable-p.pcert0 : \
-     centaur/vl/mlib/modnamespace.pcert0 \
-     centaur/vl/mlib/find-item.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/util/defwellformed.pcert0 \
-     centaur/vl/util/warnings.pcert0 \
-     defsort/duplicated-members.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/util/osets.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/wf-reasonable-p.lisp \
-     centaur/vl/cert.acl2
-centaur/vl/wf-reasonable-p.pcert1 : acl2x = 0
-centaur/vl/wf-reasonable-p.pcert1 : no_pcert = 0
-centaur/vl/wf-reasonable-p.pcert1 : centaur/vl/wf-reasonable-p.pcert0
-centaur/vl/wf-reasonable-p.cert : | centaur/vl/wf-reasonable-p.pcert1
-
-centaur/vl/wf-widthsfixed-p.pcert0 : no_pcert = 0
-centaur/vl/wf-widthsfixed-p.pcert0 : acl2x = 0
-centaur/vl/wf-widthsfixed-p.pcert0 : \
-     centaur/vl/parsetree.pcert0 \
-     centaur/vl/mlib/expr-tools.pcert0 \
-     centaur/vl/wf-reasonable-p.pcert0 \
-     centaur/vl/util/arithmetic.pcert0 \
-     centaur/vl/portcullis.pcert0 \
-     centaur/vl/wf-widthsfixed-p.lisp \
-     centaur/vl/cert.acl2
-centaur/vl/wf-widthsfixed-p.pcert1 : acl2x = 0
-centaur/vl/wf-widthsfixed-p.pcert1 : no_pcert = 0
-centaur/vl/wf-widthsfixed-p.pcert1 : centaur/vl/wf-widthsfixed-p.pcert0
-centaur/vl/wf-widthsfixed-p.cert : | centaur/vl/wf-widthsfixed-p.pcert1
-
-clause-processors/autohide.pcert0 : no_pcert = 0
-clause-processors/autohide.pcert0 : acl2x = 0
-clause-processors/autohide.pcert0 : \
-     clause-processors/join-thms.pcert0 \
-     tools/flag.pcert0 \
-     tools/do-not.pcert0 \
-     clause-processors/equality.pcert0 \
-     clause-processors/autohide.lisp \
-     clause-processors/autohide.acl2 \
-     tools/flag-package.lsp
-clause-processors/autohide.pcert1 : acl2x = 0
-clause-processors/autohide.pcert1 : no_pcert = 0
-clause-processors/autohide.pcert1 : clause-processors/autohide.pcert0
-clause-processors/autohide.cert : | clause-processors/autohide.pcert1
-
-clause-processors/basic-examples.pcert0 : no_pcert = 0
-clause-processors/basic-examples.pcert0 : acl2x = 0
-clause-processors/basic-examples.pcert0 : \
-     misc/eval.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     clause-processors/basic-examples.lisp \
-     clause-processors/basic-examples.acl2
-clause-processors/basic-examples.pcert1 : acl2x = 0
-clause-processors/basic-examples.pcert1 : no_pcert = 0
-clause-processors/basic-examples.pcert1 : clause-processors/basic-examples.pcert0
-clause-processors/basic-examples.cert : | clause-processors/basic-examples.pcert1
-
-clause-processors/bv-add-common.pcert0 : no_pcert = 0
-clause-processors/bv-add-common.pcert0 : acl2x = 0
-clause-processors/bv-add-common.pcert0 : \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     clause-processors/bv-add-common.lisp
-clause-processors/bv-add-common.pcert1 : acl2x = 0
-clause-processors/bv-add-common.pcert1 : no_pcert = 0
-clause-processors/bv-add-common.pcert1 : clause-processors/bv-add-common.pcert0
-clause-processors/bv-add-common.cert : | clause-processors/bv-add-common.pcert1
-
-clause-processors/bv-add-tests.pcert0 : no_pcert = 0
-clause-processors/bv-add-tests.pcert0 : acl2x = 0
-clause-processors/bv-add-tests.pcert0 : \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     clause-processors/bv-add-common.pcert0 \
-     clause-processors/bv-add.pcert0 \
-     clause-processors/bv-add-tests.lisp
-clause-processors/bv-add-tests.pcert1 : acl2x = 0
-clause-processors/bv-add-tests.pcert1 : no_pcert = 0
-clause-processors/bv-add-tests.pcert1 : clause-processors/bv-add-tests.pcert0
-clause-processors/bv-add-tests.cert : | clause-processors/bv-add-tests.pcert1
-
-clause-processors/bv-add.pcert0 : no_pcert = 0
-clause-processors/bv-add.pcert0 : acl2x = 0
-clause-processors/bv-add.pcert0 : \
-     textbook/chap11/perm-append.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     clause-processors/bv-add.lisp
-clause-processors/bv-add.pcert1 : acl2x = 0
-clause-processors/bv-add.pcert1 : no_pcert = 0
-clause-processors/bv-add.pcert1 : clause-processors/bv-add.pcert0
-clause-processors/bv-add.cert : | clause-processors/bv-add.pcert1
-
-clause-processors/decomp-hint.pcert0 : no_pcert = 0
-clause-processors/decomp-hint.pcert0 : acl2x = 0
-clause-processors/decomp-hint.pcert0 : \
-     clause-processors/join-thms.pcert0 \
-     tools/bstar.pcert0 \
-     clause-processors/decomp-hint.lisp
-clause-processors/decomp-hint.pcert1 : acl2x = 0
-clause-processors/decomp-hint.pcert1 : no_pcert = 0
-clause-processors/decomp-hint.pcert1 : clause-processors/decomp-hint.pcert0
-clause-processors/decomp-hint.cert : | clause-processors/decomp-hint.pcert1
-
-clause-processors/equality.pcert0 : no_pcert = 0
-clause-processors/equality.pcert0 : acl2x = 0
-clause-processors/equality.pcert0 : \
-     tools/flag.pcert0 \
-     misc/eval.pcert0 \
-     clause-processors/equality.lisp \
-     clause-processors/equality.acl2 \
-     tools/flag-package.lsp
-clause-processors/equality.pcert1 : acl2x = 0
-clause-processors/equality.pcert1 : no_pcert = 0
-clause-processors/equality.pcert1 : clause-processors/equality.pcert0
-clause-processors/equality.cert : | clause-processors/equality.pcert1
-
-clause-processors/ev-find-rules.pcert0 : no_pcert = 0
-clause-processors/ev-find-rules.pcert0 : acl2x = 0
-clause-processors/ev-find-rules.pcert0 : \
-     clause-processors/ev-find-rules.lisp
-clause-processors/ev-find-rules.pcert1 : acl2x = 0
-clause-processors/ev-find-rules.pcert1 : no_pcert = 0
-clause-processors/ev-find-rules.pcert1 : clause-processors/ev-find-rules.pcert0
-clause-processors/ev-find-rules.cert : | clause-processors/ev-find-rules.pcert1
-
-clause-processors/ev-theoremp.pcert0 : no_pcert = 0
-clause-processors/ev-theoremp.pcert0 : acl2x = 0
-clause-processors/ev-theoremp.pcert0 : \
-     clause-processors/join-thms.pcert0 \
-     clause-processors/ev-theoremp.lisp
-clause-processors/ev-theoremp.pcert1 : acl2x = 0
-clause-processors/ev-theoremp.pcert1 : no_pcert = 0
-clause-processors/ev-theoremp.pcert1 : clause-processors/ev-theoremp.pcert0
-clause-processors/ev-theoremp.cert : | clause-processors/ev-theoremp.pcert1
-
-clause-processors/find-subterms.pcert0 : no_pcert = 0
-clause-processors/find-subterms.pcert0 : acl2x = 0
-clause-processors/find-subterms.pcert0 : \
-     clause-processors/find-subterms.lisp
-clause-processors/find-subterms.pcert1 : acl2x = 0
-clause-processors/find-subterms.pcert1 : no_pcert = 0
-clause-processors/find-subterms.pcert1 : clause-processors/find-subterms.pcert0
-clause-processors/find-subterms.cert : | clause-processors/find-subterms.pcert1
-
-clause-processors/generalize.pcert0 : no_pcert = 0
-clause-processors/generalize.pcert0 : acl2x = 0
-clause-processors/generalize.pcert0 : \
-     tools/flag.pcert0 \
-     data-structures/list-theory.pcert0 \
-     clause-processors/join-thms.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     clause-processors/generalize.lisp \
-     clause-processors/generalize.acl2 \
-     tools/flag-package.lsp
-clause-processors/generalize.pcert1 : acl2x = 0
-clause-processors/generalize.pcert1 : no_pcert = 0
-clause-processors/generalize.pcert1 : clause-processors/generalize.pcert0
-clause-processors/generalize.cert : | clause-processors/generalize.pcert1
-
-clause-processors/instantiate.pcert0 : no_pcert = 0
-clause-processors/instantiate.pcert0 : acl2x = 0
-clause-processors/instantiate.pcert0 : \
-     clause-processors/unify-subst.pcert0 \
-     tools/flag.pcert0 \
-     tools/bstar.pcert0 \
-     clause-processors/instantiate.lisp
-clause-processors/instantiate.pcert1 : acl2x = 0
-clause-processors/instantiate.pcert1 : no_pcert = 0
-clause-processors/instantiate.pcert1 : clause-processors/instantiate.pcert0
-clause-processors/instantiate.cert : | clause-processors/instantiate.pcert1
-
-clause-processors/join-thms.pcert0 : no_pcert = 0
-clause-processors/join-thms.pcert0 : acl2x = 0
-clause-processors/join-thms.pcert0 : \
-     clause-processors/ev-find-rules.pcert0 \
-     clause-processors/join-thms.lisp
-clause-processors/join-thms.pcert1 : acl2x = 0
-clause-processors/join-thms.pcert1 : no_pcert = 0
-clause-processors/join-thms.pcert1 : clause-processors/join-thms.pcert0
-clause-processors/join-thms.cert : | clause-processors/join-thms.pcert1
-
-clause-processors/just-expand.pcert0 : no_pcert = 0
-clause-processors/just-expand.pcert0 : acl2x = 0
-clause-processors/just-expand.pcert0 : \
-     clause-processors/unify-subst.pcert0 \
-     tools/bstar.pcert0 \
-     clause-processors/ev-theoremp.pcert0 \
-     clause-processors/use-by-hint.pcert0 \
-     clause-processors/just-expand.lisp
-clause-processors/just-expand.pcert1 : acl2x = 0
-clause-processors/just-expand.pcert1 : no_pcert = 0
-clause-processors/just-expand.pcert1 : clause-processors/just-expand.pcert0
-clause-processors/just-expand.cert : | clause-processors/just-expand.pcert1
-
-clause-processors/meta-extract-simple-test.pcert0 : no_pcert = 0
-clause-processors/meta-extract-simple-test.pcert0 : acl2x = 0
-clause-processors/meta-extract-simple-test.pcert0 : \
-     system/meta-extract.pcert0 \
-     arithmetic-5/top.pcert0 \
-     arithmetic-5/top.pcert0 \
-     arithmetic-5/top.pcert0 \
-     clause-processors/meta-extract-simple-test.lisp
-clause-processors/meta-extract-simple-test.pcert1 : acl2x = 0
-clause-processors/meta-extract-simple-test.pcert1 : no_pcert = 0
-clause-processors/meta-extract-simple-test.pcert1 : clause-processors/meta-extract-simple-test.pcert0
-clause-processors/meta-extract-simple-test.cert : | clause-processors/meta-extract-simple-test.pcert1
-
-clause-processors/meta-extract-user.pcert0 : no_pcert = 0
-clause-processors/meta-extract-user.pcert0 : acl2x = 0
-clause-processors/meta-extract-user.pcert0 : \
-     tools/defevaluator-fast.pcert0 \
-     clause-processors/ev-theoremp.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     system/sublis-var.pcert0 \
-     system/meta-extract.pcert0 \
-     clause-processors/meta-extract-user.lisp
-clause-processors/meta-extract-user.pcert1 : acl2x = 0
-clause-processors/meta-extract-user.pcert1 : no_pcert = 0
-clause-processors/meta-extract-user.pcert1 : clause-processors/meta-extract-user.pcert0
-clause-processors/meta-extract-user.cert : | clause-processors/meta-extract-user.pcert1
-
-clause-processors/multi-env-trick.pcert0 : no_pcert = 0
-clause-processors/multi-env-trick.pcert0 : acl2x = 0
-clause-processors/multi-env-trick.pcert0 : \
-     clause-processors/join-thms.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     clause-processors/multi-env-trick.lisp
-clause-processors/multi-env-trick.pcert1 : acl2x = 0
-clause-processors/multi-env-trick.pcert1 : no_pcert = 0
-clause-processors/multi-env-trick.pcert1 : clause-processors/multi-env-trick.pcert0
-clause-processors/multi-env-trick.cert : | clause-processors/multi-env-trick.pcert1
-
-clause-processors/null-fail-hints.pcert0 : no_pcert = 0
-clause-processors/null-fail-hints.pcert0 : acl2x = 0
-clause-processors/null-fail-hints.pcert0 : \
-     clause-processors/join-thms.pcert0 \
-     clause-processors/null-fail-hints.lisp
-clause-processors/null-fail-hints.pcert1 : acl2x = 0
-clause-processors/null-fail-hints.pcert1 : no_pcert = 0
-clause-processors/null-fail-hints.pcert1 : clause-processors/null-fail-hints.pcert0
-clause-processors/null-fail-hints.cert : | clause-processors/null-fail-hints.pcert1
-
-clause-processors/nvalues-thms.pcert0 : no_pcert = 0
-clause-processors/nvalues-thms.pcert0 : acl2x = 0
-clause-processors/nvalues-thms.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     clause-processors/multi-env-trick.pcert0 \
-     clause-processors/join-thms.pcert0 \
-     tools/flag.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     clause-processors/nvalues-thms.lisp
-clause-processors/nvalues-thms.pcert1 : acl2x = 0
-clause-processors/nvalues-thms.pcert1 : no_pcert = 0
-clause-processors/nvalues-thms.pcert1 : clause-processors/nvalues-thms.pcert0
-clause-processors/nvalues-thms.cert : | clause-processors/nvalues-thms.pcert1
-
-clause-processors/replace-defined-consts.pcert0 : no_pcert = 0
-clause-processors/replace-defined-consts.pcert0 : acl2x = 0
-clause-processors/replace-defined-consts.pcert0 : \
-     clause-processors/use-by-hint.pcert0 \
-     clause-processors/multi-env-trick.pcert0 \
-     tools/bstar.pcert0 \
-     tools/flag.pcert0 \
-     tools/mv-nth.pcert0 \
-     clause-processors/replace-defined-consts.lisp \
-     clause-processors/replace-defined-consts.acl2 \
-     tools/flag-package.lsp
-clause-processors/replace-defined-consts.pcert1 : acl2x = 0
-clause-processors/replace-defined-consts.pcert1 : no_pcert = 0
-clause-processors/replace-defined-consts.pcert1 : clause-processors/replace-defined-consts.pcert0
-clause-processors/replace-defined-consts.cert : | clause-processors/replace-defined-consts.pcert1
-
-clause-processors/replace-impl.pcert0 : no_pcert = 0
-clause-processors/replace-impl.pcert0 : acl2x = 0
-clause-processors/replace-impl.pcert0 : \
-     clause-processors/replace-impl.lisp
-clause-processors/replace-impl.pcert1 : acl2x = 0
-clause-processors/replace-impl.pcert1 : no_pcert = 0
-clause-processors/replace-impl.pcert1 : clause-processors/replace-impl.pcert0
-clause-processors/replace-impl.cert : | clause-processors/replace-impl.pcert1
-
-clause-processors/stobj-preservation.pcert0 : no_pcert = 0
-clause-processors/stobj-preservation.pcert0 : acl2x = 0
-clause-processors/stobj-preservation.pcert0 : \
-     xdoc/top.pcert0 \
-     clause-processors/just-expand.pcert0 \
-     clause-processors/stobj-preservation.lisp
-clause-processors/stobj-preservation.pcert1 : acl2x = 0
-clause-processors/stobj-preservation.pcert1 : no_pcert = 0
-clause-processors/stobj-preservation.pcert1 : clause-processors/stobj-preservation.pcert0
-clause-processors/stobj-preservation.cert : | clause-processors/stobj-preservation.pcert1
-
-clause-processors/sublis-var-meaning.pcert0 : no_pcert = 0
-clause-processors/sublis-var-meaning.pcert0 : acl2x = 0
-clause-processors/sublis-var-meaning.pcert0 : \
-     system/sublis-var.pcert0 \
-     tools/flag.pcert0 \
-     tools/mv-nth.pcert0 \
-     tools/defevaluator-fast.pcert0 \
-     clause-processors/sublis-var-meaning.lisp
-clause-processors/sublis-var-meaning.pcert1 : acl2x = 0
-clause-processors/sublis-var-meaning.pcert1 : no_pcert = 0
-clause-processors/sublis-var-meaning.pcert1 : clause-processors/sublis-var-meaning.pcert0
-clause-processors/sublis-var-meaning.cert : | clause-processors/sublis-var-meaning.pcert1
-
-clause-processors/term-patterns.pcert0 : no_pcert = 0
-clause-processors/term-patterns.pcert0 : acl2x = 0
-clause-processors/term-patterns.pcert0 : \
-     tools/flag.pcert0 \
-     tools/flag.pcert0 \
-     clause-processors/term-patterns.lisp \
-     clause-processors/term-patterns.acl2
-clause-processors/term-patterns.pcert1 : acl2x = 0
-clause-processors/term-patterns.pcert1 : no_pcert = 0
-clause-processors/term-patterns.pcert1 : clause-processors/term-patterns.pcert0
-clause-processors/term-patterns.cert : | clause-processors/term-patterns.pcert1
-
-clause-processors/unify-subst.pcert0 : no_pcert = 0
-clause-processors/unify-subst.pcert0 : acl2x = 0
-clause-processors/unify-subst.pcert0 : \
-     tools/flag.pcert0 \
-     tools/bstar.pcert0 \
-     tools/mv-nth.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     clause-processors/ev-find-rules.pcert0 \
-     clause-processors/unify-subst.lisp \
-     clause-processors/unify-subst.acl2 \
-     tools/flag-package.lsp
-clause-processors/unify-subst.pcert1 : acl2x = 0
-clause-processors/unify-subst.pcert1 : no_pcert = 0
-clause-processors/unify-subst.pcert1 : clause-processors/unify-subst.pcert0
-clause-processors/unify-subst.cert : | clause-processors/unify-subst.pcert1
-
-clause-processors/use-by-hint.pcert0 : no_pcert = 0
-clause-processors/use-by-hint.pcert0 : acl2x = 0
-clause-processors/use-by-hint.pcert0 : \
-     clause-processors/join-thms.pcert0 \
-     clause-processors/use-by-hint.lisp
-clause-processors/use-by-hint.pcert1 : acl2x = 0
-clause-processors/use-by-hint.pcert1 : no_pcert = 0
-clause-processors/use-by-hint.pcert1 : clause-processors/use-by-hint.pcert0
-clause-processors/use-by-hint.cert : | clause-processors/use-by-hint.pcert1
-
-clause-processors/witness-cp.pcert0 : no_pcert = 0
-clause-processors/witness-cp.pcert0 : acl2x = 0
-clause-processors/witness-cp.pcert0 : \
-     clause-processors/use-by-hint.pcert0 \
-     clause-processors/generalize.pcert0 \
-     clause-processors/unify-subst.pcert0 \
-     tools/bstar.pcert0 \
-     clause-processors/ev-theoremp.pcert0 \
-     tools/def-functional-instance.pcert0 \
-     tools/oracle-eval.pcert0 \
-     data-structures/no-duplicates.pcert0 \
-     clause-processors/witness-cp.lisp \
-     clause-processors/witness-cp.acl2 \
-     tools/flag-package.lsp
-clause-processors/witness-cp.pcert1 : acl2x = 0
-clause-processors/witness-cp.pcert1 : no_pcert = 0
-clause-processors/witness-cp.pcert1 : clause-processors/witness-cp.pcert0
-clause-processors/witness-cp.cert : | clause-processors/witness-cp.pcert1
-
-coi/adviser/adviser-pkg.pcert0 : no_pcert = 0
-coi/adviser/adviser-pkg.pcert0 : acl2x = 0
-coi/adviser/adviser-pkg.pcert0 : \
-     coi/adviser/adviser-pkg.lisp \
-     coi/adviser/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/adviser/adviser-pkg.pcert1 : acl2x = 0
-coi/adviser/adviser-pkg.pcert1 : no_pcert = 0
-coi/adviser/adviser-pkg.pcert1 : coi/adviser/adviser-pkg.pcert0
-coi/adviser/adviser-pkg.cert : | coi/adviser/adviser-pkg.pcert1
-
-coi/adviser/adviser.pcert0 : no_pcert = 0
-coi/adviser/adviser.pcert0 : acl2x = 0
-coi/adviser/adviser.pcert0 : \
-     misc/symbol-btree.pcert0 \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/adviser/adviser.lisp \
-     coi/adviser/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/adviser/adviser.pcert1 : acl2x = 0
-coi/adviser/adviser.pcert1 : no_pcert = 0
-coi/adviser/adviser.pcert1 : coi/adviser/adviser.pcert0
-coi/adviser/adviser.cert : | coi/adviser/adviser.pcert1
-
-coi/adviser/test.pcert0 : no_pcert = 0
-coi/adviser/test.pcert0 : acl2x = 0
-coi/adviser/test.pcert0 : \
-     coi/adviser/adviser.pcert0 \
-     coi/adviser/test.lisp \
-     coi/adviser/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/adviser/test.pcert1 : acl2x = 0
-coi/adviser/test.pcert1 : no_pcert = 0
-coi/adviser/test.pcert1 : coi/adviser/test.pcert0
-coi/adviser/test.cert : | coi/adviser/test.pcert1
-
-coi/alists/alist-pkg.pcert0 : no_pcert = 0
-coi/alists/alist-pkg.pcert0 : acl2x = 0
-coi/alists/alist-pkg.pcert0 : \
-     coi/alists/alist-pkg.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/alist-pkg.pcert1 : acl2x = 0
-coi/alists/alist-pkg.pcert1 : no_pcert = 0
-coi/alists/alist-pkg.pcert1 : coi/alists/alist-pkg.pcert0
-coi/alists/alist-pkg.cert : | coi/alists/alist-pkg.pcert1
-
-coi/alists/bindequiv.pcert0 : no_pcert = 0
-coi/alists/bindequiv.pcert0 : acl2x = 0
-coi/alists/bindequiv.pcert0 : \
-     coi/util/mv-nth.pcert0 \
-     coi/nary/nary.pcert0 \
-     coi/util/good-rewrite-order.pcert0 \
-     coi/alists/keyquiv.pcert0 \
-     coi/bags/top.pcert0 \
-     misc/total-order.pcert0 \
-     coi/alists/bindequiv.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/bindequiv.pcert1 : acl2x = 0
-coi/alists/bindequiv.pcert1 : no_pcert = 0
-coi/alists/bindequiv.pcert1 : coi/alists/bindequiv.pcert0
-coi/alists/bindequiv.cert : | coi/alists/bindequiv.pcert1
-
-coi/alists/clearkey.pcert0 : no_pcert = 0
-coi/alists/clearkey.pcert0 : acl2x = 0
-coi/alists/clearkey.pcert0 : \
-     coi/alists/equiv.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/alists/clearkey.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/clearkey.pcert1 : acl2x = 0
-coi/alists/clearkey.pcert1 : no_pcert = 0
-coi/alists/clearkey.pcert1 : coi/alists/clearkey.pcert0
-coi/alists/clearkey.cert : | coi/alists/clearkey.pcert1
-
-coi/alists/deshadow.pcert0 : no_pcert = 0
-coi/alists/deshadow.pcert0 : acl2x = 0
-coi/alists/deshadow.pcert0 : \
-     coi/alists/strip.pcert0 \
-     coi/alists/clearkey.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/bags/pick-a-point.pcert0 \
-     coi/alists/deshadow.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/deshadow.pcert1 : acl2x = 0
-coi/alists/deshadow.pcert1 : no_pcert = 0
-coi/alists/deshadow.pcert1 : coi/alists/deshadow.pcert0
-coi/alists/deshadow.cert : | coi/alists/deshadow.pcert1
-
-coi/alists/equiv.pcert0 : no_pcert = 0
-coi/alists/equiv.pcert0 : acl2x = 0
-coi/alists/equiv.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/alists/equiv.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/equiv.pcert1 : acl2x = 0
-coi/alists/equiv.pcert1 : no_pcert = 0
-coi/alists/equiv.pcert1 : coi/alists/equiv.pcert0
-coi/alists/equiv.cert : | coi/alists/equiv.pcert1
-
-coi/alists/keyquiv.pcert0 : no_pcert = 0
-coi/alists/keyquiv.pcert0 : acl2x = 0
-coi/alists/keyquiv.pcert0 : \
-     coi/util/iff.pcert0 \
-     coi/lists/basic.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/lists/set.pcert0 \
-     coi/util/good-rewrite-order.pcert0 \
-     coi/alists/equiv.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/lists/remove-induction.pcert0 \
-     coi/lists/remove.pcert0 \
-     coi/alists/keyquiv.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/keyquiv.pcert1 : acl2x = 0
-coi/alists/keyquiv.pcert1 : no_pcert = 0
-coi/alists/keyquiv.pcert1 : coi/alists/keyquiv.pcert0
-coi/alists/keyquiv.cert : | coi/alists/keyquiv.pcert1
-
-coi/alists/preimage.pcert0 : no_pcert = 0
-coi/alists/preimage.pcert0 : acl2x = 0
-coi/alists/preimage.pcert0 : \
-     coi/alists/deshadow.pcert0 \
-     coi/alists/strip.pcert0 \
-     coi/alists/preimage.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/preimage.pcert1 : acl2x = 0
-coi/alists/preimage.pcert1 : no_pcert = 0
-coi/alists/preimage.pcert1 : coi/alists/preimage.pcert0
-coi/alists/preimage.cert : | coi/alists/preimage.pcert1
-
-coi/alists/strip.pcert0 : no_pcert = 0
-coi/alists/strip.pcert0 : acl2x = 0
-coi/alists/strip.pcert0 : \
-     coi/alists/equiv.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/alists/strip.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/strip.pcert1 : acl2x = 0
-coi/alists/strip.pcert1 : no_pcert = 0
-coi/alists/strip.pcert1 : coi/alists/strip.pcert0
-coi/alists/strip.cert : | coi/alists/strip.pcert1
-
-coi/alists/subkeyquiv.pcert0 : no_pcert = 0
-coi/alists/subkeyquiv.pcert0 : acl2x = 0
-coi/alists/subkeyquiv.pcert0 : \
-     coi/lists/set.pcert0 \
-     coi/alists/keyquiv.pcert0 \
-     coi/util/good-rewrite-order.pcert0 \
-     coi/nary/nary.pcert0 \
-     coi/alists/subkeyquiv.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/subkeyquiv.pcert1 : acl2x = 0
-coi/alists/subkeyquiv.pcert1 : no_pcert = 0
-coi/alists/subkeyquiv.pcert1 : coi/alists/subkeyquiv.pcert0
-coi/alists/subkeyquiv.cert : | coi/alists/subkeyquiv.pcert1
-
-coi/alists/top.pcert0 : no_pcert = 0
-coi/alists/top.pcert0 : acl2x = 0
-coi/alists/top.pcert0 : \
-     coi/alists/equiv.pcert0 \
-     coi/alists/strip.pcert0 \
-     coi/alists/clearkey.pcert0 \
-     coi/alists/deshadow.pcert0 \
-     coi/alists/preimage.pcert0 \
-     coi/alists/top.lisp \
-     coi/alists/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/alists/top.pcert1 : acl2x = 0
-coi/alists/top.pcert1 : no_pcert = 0
-coi/alists/top.pcert1 : coi/alists/top.pcert0
-coi/alists/top.cert : | coi/alists/top.pcert1
-
-coi/bags/basic.pcert0 : no_pcert = 0
-coi/bags/basic.pcert0 : acl2x = 0
-coi/bags/basic.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/lists/disjoint.pcert0 \
-     coi/bags/basic.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/basic.pcert1 : acl2x = 0
-coi/bags/basic.pcert1 : no_pcert = 0
-coi/bags/basic.pcert1 : coi/bags/basic.pcert0
-coi/bags/basic.cert : | coi/bags/basic.pcert1
-
-coi/bags/bind-free-rules.pcert0 : no_pcert = 0
-coi/bags/bind-free-rules.pcert0 : acl2x = 0
-coi/bags/bind-free-rules.pcert0 : \
-     coi/bags/meta.pcert0 \
-     coi/bags/bind-free-rules.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/bind-free-rules.pcert1 : acl2x = 0
-coi/bags/bind-free-rules.pcert1 : no_pcert = 0
-coi/bags/bind-free-rules.pcert1 : coi/bags/bind-free-rules.pcert0
-coi/bags/bind-free-rules.cert : | coi/bags/bind-free-rules.pcert1
-
-coi/bags/cons.pcert0 : no_pcert = 0
-coi/bags/cons.pcert0 : acl2x = 0
-coi/bags/cons.pcert0 : \
-     coi/syntax/syntax.pcert0 \
-     coi/bags/cons.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/cons.pcert1 : acl2x = 0
-coi/bags/cons.pcert1 : no_pcert = 0
-coi/bags/cons.pcert1 : coi/bags/cons.pcert0
-coi/bags/cons.cert : | coi/bags/cons.pcert1
-
-coi/bags/eric-meta.pcert0 : no_pcert = 0
-coi/bags/eric-meta.pcert0 : acl2x = 0
-coi/bags/eric-meta.pcert0 : \
-     coi/bags/bind-free-rules.pcert0 \
-     coi/util/iff.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     coi/bags/eric-meta.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/eric-meta.pcert1 : acl2x = 0
-coi/bags/eric-meta.pcert1 : no_pcert = 0
-coi/bags/eric-meta.pcert1 : coi/bags/eric-meta.pcert0
-coi/bags/eric-meta.cert : | coi/bags/eric-meta.pcert1
-
-coi/bags/extras.pcert0 : no_pcert = 0
-coi/bags/extras.pcert0 : acl2x = 0
-coi/bags/extras.pcert0 : \
-     coi/bags/basic.pcert0 \
-     coi/lists/find-index.pcert0 \
-     coi/bags/extras.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/extras.pcert1 : acl2x = 0
-coi/bags/extras.pcert1 : no_pcert = 0
-coi/bags/extras.pcert1 : coi/bags/extras.pcert0
-coi/bags/extras.cert : | coi/bags/extras.pcert1
-
-coi/bags/meta.pcert0 : no_pcert = 0
-coi/bags/meta.pcert0 : acl2x = 0
-coi/bags/meta.pcert0 : \
-     coi/bags/basic.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/syntax/syntax.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/bags/meta.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/meta.pcert1 : acl2x = 0
-coi/bags/meta.pcert1 : no_pcert = 0
-coi/bags/meta.pcert1 : coi/bags/meta.pcert0
-coi/bags/meta.cert : | coi/bags/meta.pcert1
-
-coi/bags/neq.pcert0 : no_pcert = 0
-coi/bags/neq.pcert0 : acl2x = 0
-coi/bags/neq.pcert0 : \
-     coi/bags/bind-free-rules.pcert0 \
-     coi/bags/neq.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/neq.pcert1 : acl2x = 0
-coi/bags/neq.pcert1 : no_pcert = 0
-coi/bags/neq.pcert1 : coi/bags/neq.pcert0
-coi/bags/neq.cert : | coi/bags/neq.pcert1
-
-coi/bags/pick-a-point.pcert0 : no_pcert = 0
-coi/bags/pick-a-point.pcert0 : acl2x = 0
-coi/bags/pick-a-point.pcert0 : \
-     coi/bags/basic.pcert0 \
-     coi/adviser/adviser.pcert0 \
-     coi/bags/pick-a-point.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/pick-a-point.pcert1 : acl2x = 0
-coi/bags/pick-a-point.pcert1 : no_pcert = 0
-coi/bags/pick-a-point.pcert1 : coi/bags/pick-a-point.pcert0
-coi/bags/pick-a-point.cert : | coi/bags/pick-a-point.pcert1
-
-coi/bags/top.pcert0 : no_pcert = 0
-coi/bags/top.pcert0 : acl2x = 0
-coi/bags/top.pcert0 : \
-     coi/bags/bind-free-rules.pcert0 \
-     coi/bags/cons.pcert0 \
-     coi/bags/neq.pcert0 \
-     coi/bags/eric-meta.pcert0 \
-     coi/bags/top.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/top.pcert1 : acl2x = 0
-coi/bags/top.pcert1 : no_pcert = 0
-coi/bags/top.pcert1 : coi/bags/top.pcert0
-coi/bags/top.cert : | coi/bags/top.pcert1
-
-coi/bags/two-level-meta.pcert0 : no_pcert = 0
-coi/bags/two-level-meta.pcert0 : acl2x = 0
-coi/bags/two-level-meta.pcert0 : \
-     coi/bags/two-level.pcert0 \
-     coi/bags/two-level-meta.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/two-level-meta.pcert1 : acl2x = 0
-coi/bags/two-level-meta.pcert1 : no_pcert = 0
-coi/bags/two-level-meta.pcert1 : coi/bags/two-level-meta.pcert0
-coi/bags/two-level-meta.cert : | coi/bags/two-level-meta.pcert1
-
-coi/bags/two-level.pcert0 : no_pcert = 0
-coi/bags/two-level.pcert0 : acl2x = 0
-coi/bags/two-level.pcert0 : \
-     coi/bags/bind-free-rules.pcert0 \
-     coi/bags/two-level.lisp \
-     coi/bags/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/bags/two-level.pcert1 : acl2x = 0
-coi/bags/two-level.pcert1 : no_pcert = 0
-coi/bags/two-level.pcert1 : coi/bags/two-level.pcert0
-coi/bags/two-level.cert : | coi/bags/two-level.pcert1
-
-coi/defpun/ack.pcert0 : no_pcert = 0
-coi/defpun/ack.pcert0 : acl2x = 0
-coi/defpun/ack.pcert0 : \
-     coi/defpun/defminterm.pcert0 \
-     coi/defpun/ack.lisp
-coi/defpun/ack.pcert1 : acl2x = 0
-coi/defpun/ack.pcert1 : no_pcert = 0
-coi/defpun/ack.pcert1 : coi/defpun/ack.pcert0
-coi/defpun/ack.cert : | coi/defpun/ack.pcert1
-
-coi/defpun/defminterm.pcert0 : no_pcert = 0
-coi/defpun/defminterm.pcert0 : acl2x = 0
-coi/defpun/defminterm.pcert0 : \
-     coi/defpun/defxch.pcert0 \
-     coi/defpun/defpun.pcert0 \
-     coi/defpun/defminterm.lisp
-coi/defpun/defminterm.pcert1 : acl2x = 0
-coi/defpun/defminterm.pcert1 : no_pcert = 0
-coi/defpun/defminterm.pcert1 : coi/defpun/defminterm.pcert0
-coi/defpun/defminterm.cert : | coi/defpun/defminterm.pcert1
-
-coi/defpun/defpun.pcert0 : no_pcert = 0
-coi/defpun/defpun.pcert0 : acl2x = 0
-coi/defpun/defpun.pcert0 : \
-     coi/defpun/defpun.lisp
-coi/defpun/defpun.pcert1 : acl2x = 0
-coi/defpun/defpun.pcert1 : no_pcert = 0
-coi/defpun/defpun.pcert1 : coi/defpun/defpun.pcert0
-coi/defpun/defpun.cert : | coi/defpun/defpun.pcert1
-
-coi/defpun/defxch.pcert0 : no_pcert = 0
-coi/defpun/defxch.pcert0 : acl2x = 0
-coi/defpun/defxch.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     misc/defpun.pcert0 \
-     coi/defpun/defxch.lisp
-coi/defpun/defxch.pcert1 : acl2x = 0
-coi/defpun/defxch.pcert1 : no_pcert = 0
-coi/defpun/defxch.pcert1 : coi/defpun/defxch.pcert0
-coi/defpun/defxch.cert : | coi/defpun/defxch.pcert1
-
-coi/defstructure/defstructure-pkg.pcert0 : no_pcert = 0
-coi/defstructure/defstructure-pkg.pcert0 : acl2x = 0
-coi/defstructure/defstructure-pkg.pcert0 : \
-     coi/defstructure/defstructure-pkg.lisp \
-     coi/defstructure/cert.acl2 \
-     coi/defstructure/structures-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/define-u-package.lsp
-coi/defstructure/defstructure-pkg.pcert1 : acl2x = 0
-coi/defstructure/defstructure-pkg.pcert1 : no_pcert = 0
-coi/defstructure/defstructure-pkg.pcert1 : coi/defstructure/defstructure-pkg.pcert0
-coi/defstructure/defstructure-pkg.cert : | coi/defstructure/defstructure-pkg.pcert1
-
-coi/defstructure/defstructure.pcert0 : no_pcert = 0
-coi/defstructure/defstructure.pcert0 : acl2x = 0
-coi/defstructure/defstructure.pcert0 : \
-     coi/paths/path.pcert0 \
-     data-structures/utilities.pcert0 \
-     coi/defstructure/defstructure.lisp \
-     coi/defstructure/cert.acl2 \
-     coi/defstructure/structures-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/define-u-package.lsp
-coi/defstructure/defstructure.pcert1 : acl2x = 0
-coi/defstructure/defstructure.pcert1 : no_pcert = 0
-coi/defstructure/defstructure.pcert1 : coi/defstructure/defstructure.pcert0
-coi/defstructure/defstructure.cert : | coi/defstructure/defstructure.pcert1
-
-coi/dtrees/base.pcert0 : no_pcert = 0
-coi/dtrees/base.pcert0 : acl2x = 0
-coi/dtrees/base.pcert0 : \
-     coi/util/iff.pcert0 \
-     coi/maps/maps.pcert0 \
-     coi/lists/basic.pcert0 \
-     coi/osets/multicons.pcert0 \
-     coi/maps/typed-maps.pcert0 \
-     coi/dtrees/base.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/base.pcert1 : acl2x = 0
-coi/dtrees/base.pcert1 : no_pcert = 0
-coi/dtrees/base.pcert1 : coi/dtrees/base.pcert0
-coi/dtrees/base.cert : | coi/dtrees/base.pcert1
-
-coi/dtrees/child.pcert0 : no_pcert = 0
-coi/dtrees/child.pcert0 : acl2x = 0
-coi/dtrees/child.pcert0 : \
-     coi/dtrees/raw.pcert0 \
-     coi/dtrees/set.pcert0 \
-     coi/dtrees/erase.pcert0 \
-     coi/dtrees/child.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/child.pcert1 : acl2x = 0
-coi/dtrees/child.pcert1 : no_pcert = 0
-coi/dtrees/child.pcert1 : coi/dtrees/child.pcert0
-coi/dtrees/child.cert : | coi/dtrees/child.pcert1
-
-coi/dtrees/deps.pcert0 : no_pcert = 0
-coi/dtrees/deps.pcert0 : acl2x = 0
-coi/dtrees/deps.pcert0 : \
-     coi/dtrees/base.pcert0 \
-     coi/dtrees/deps.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/deps.pcert1 : acl2x = 0
-coi/dtrees/deps.pcert1 : no_pcert = 0
-coi/dtrees/deps.pcert1 : coi/dtrees/deps.pcert0
-coi/dtrees/deps.cert : | coi/dtrees/deps.pcert1
-
-coi/dtrees/equiv.pcert0 : no_pcert = 0
-coi/dtrees/equiv.pcert0 : acl2x = 0
-coi/dtrees/equiv.pcert0 : \
-     coi/dtrees/deps.pcert0 \
-     coi/dtrees/equiv.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/equiv.pcert1 : acl2x = 0
-coi/dtrees/equiv.pcert1 : no_pcert = 0
-coi/dtrees/equiv.pcert1 : coi/dtrees/equiv.pcert0
-coi/dtrees/equiv.cert : | coi/dtrees/equiv.pcert1
-
-coi/dtrees/erase.pcert0 : no_pcert = 0
-coi/dtrees/erase.pcert0 : acl2x = 0
-coi/dtrees/erase.pcert0 : \
-     coi/dtrees/set.pcert0 \
-     coi/paths/dominates.pcert0 \
-     coi/paths/diverge.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/dtrees/erase.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/erase.pcert1 : acl2x = 0
-coi/dtrees/erase.pcert1 : no_pcert = 0
-coi/dtrees/erase.pcert1 : coi/dtrees/erase.pcert0
-coi/dtrees/erase.cert : | coi/dtrees/erase.pcert1
-
-coi/dtrees/leafp.pcert0 : no_pcert = 0
-coi/dtrees/leafp.pcert0 : acl2x = 0
-coi/dtrees/leafp.pcert0 : \
-     coi/dtrees/equiv.pcert0 \
-     coi/paths/dominates.pcert0 \
-     coi/paths/diverge.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/dtrees/leafp.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/leafp.pcert1 : acl2x = 0
-coi/dtrees/leafp.pcert1 : no_pcert = 0
-coi/dtrees/leafp.pcert1 : coi/dtrees/leafp.pcert0
-coi/dtrees/leafp.cert : | coi/dtrees/leafp.pcert1
-
-coi/dtrees/raw.pcert0 : no_pcert = 0
-coi/dtrees/raw.pcert0 : acl2x = 0
-coi/dtrees/raw.pcert0 : \
-     coi/dtrees/equiv.pcert0 \
-     coi/dtrees/raw.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/raw.pcert1 : acl2x = 0
-coi/dtrees/raw.pcert1 : no_pcert = 0
-coi/dtrees/raw.pcert1 : coi/dtrees/raw.pcert0
-coi/dtrees/raw.cert : | coi/dtrees/raw.pcert1
-
-coi/dtrees/royalp.pcert0 : no_pcert = 0
-coi/dtrees/royalp.pcert0 : acl2x = 0
-coi/dtrees/royalp.pcert0 : \
-     coi/dtrees/equiv.pcert0 \
-     coi/paths/dominates.pcert0 \
-     coi/paths/diverge.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/dtrees/royalp.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/royalp.pcert1 : acl2x = 0
-coi/dtrees/royalp.pcert1 : no_pcert = 0
-coi/dtrees/royalp.pcert1 : coi/dtrees/royalp.pcert0
-coi/dtrees/royalp.cert : | coi/dtrees/royalp.pcert1
-
-coi/dtrees/set.pcert0 : no_pcert = 0
-coi/dtrees/set.pcert0 : acl2x = 0
-coi/dtrees/set.pcert0 : \
-     coi/dtrees/raw.pcert0 \
-     coi/paths/dominates.pcert0 \
-     coi/paths/diverge.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/dtrees/set.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/set.pcert1 : acl2x = 0
-coi/dtrees/set.pcert1 : no_pcert = 0
-coi/dtrees/set.pcert1 : coi/dtrees/set.pcert0
-coi/dtrees/set.cert : | coi/dtrees/set.pcert1
-
-coi/dtrees/top.pcert0 : no_pcert = 0
-coi/dtrees/top.pcert0 : acl2x = 0
-coi/dtrees/top.pcert0 : \
-     coi/dtrees/base.pcert0 \
-     coi/dtrees/deps.pcert0 \
-     coi/dtrees/equiv.pcert0 \
-     coi/dtrees/raw.pcert0 \
-     coi/dtrees/set.pcert0 \
-     coi/dtrees/erase.pcert0 \
-     coi/dtrees/leafp.pcert0 \
-     coi/dtrees/royalp.pcert0 \
-     coi/dtrees/child.pcert0 \
-     coi/dtrees/top.lisp \
-     coi/dtrees/cert.acl2 \
-     coi/dtrees/dtree-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/maps/map-exports.lsp \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/dtrees/top.pcert1 : acl2x = 0
-coi/dtrees/top.pcert1 : no_pcert = 0
-coi/dtrees/top.pcert1 : coi/dtrees/top.pcert0
-coi/dtrees/top.cert : | coi/dtrees/top.pcert1
-
-coi/gacc/abstract-gacc.pcert0 : no_pcert = 0
-coi/gacc/abstract-gacc.pcert0 : acl2x = 0
-coi/gacc/abstract-gacc.pcert0 : \
-     coi/records/defrecord.pcert0 \
-     coi/gacc/abstract-gacc.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/abstract-gacc.pcert1 : acl2x = 0
-coi/gacc/abstract-gacc.pcert1 : no_pcert = 0
-coi/gacc/abstract-gacc.pcert1 : coi/gacc/abstract-gacc.pcert0
-coi/gacc/abstract-gacc.cert : | coi/gacc/abstract-gacc.pcert1
-
-coi/gacc/addr-range.pcert0 : no_pcert = 0
-coi/gacc/addr-range.pcert0 : acl2x = 0
-coi/gacc/addr-range.pcert0 : \
-     coi/bags/basic.pcert0 \
-     coi/gacc/addr-range.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/addr-range.pcert1 : acl2x = 0
-coi/gacc/addr-range.pcert1 : no_pcert = 0
-coi/gacc/addr-range.pcert1 : coi/gacc/addr-range.pcert0
-coi/gacc/addr-range.cert : | coi/gacc/addr-range.pcert1
-
-coi/gacc/bits.pcert0 : no_pcert = 0
-coi/gacc/bits.pcert0 : acl2x = 0
-coi/gacc/bits.pcert0 : \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/gacc/bits.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/bits.pcert1 : acl2x = 0
-coi/gacc/bits.pcert1 : no_pcert = 0
-coi/gacc/bits.pcert1 : coi/gacc/bits.pcert0
-coi/gacc/bits.cert : | coi/gacc/bits.pcert1
-
-coi/gacc/block.pcert0 : no_pcert = 0
-coi/gacc/block.pcert0 : acl2x = 0
-coi/gacc/block.pcert0 : \
-     coi/bags/basic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/gacc/block.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/block.pcert1 : acl2x = 0
-coi/gacc/block.pcert1 : no_pcert = 0
-coi/gacc/block.pcert1 : coi/gacc/block.pcert0
-coi/gacc/block.cert : | coi/gacc/block.pcert1
-
-coi/gacc/finite.pcert0 : no_pcert = 0
-coi/gacc/finite.pcert0 : acl2x = 0
-coi/gacc/finite.pcert0 : \
-     coi/gacc/gax.pcert0 \
-     coi/gacc/gax.pcert0 \
-     coi/gacc/finite.lisp \
-     coi/gacc/finite.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/finite.pcert1 : acl2x = 0
-coi/gacc/finite.pcert1 : no_pcert = 0
-coi/gacc/finite.pcert1 : coi/gacc/finite.pcert0
-coi/gacc/finite.cert : | coi/gacc/finite.pcert1
-
-coi/gacc/fr-path-connection.pcert0 : no_pcert = 0
-coi/gacc/fr-path-connection.pcert0 : acl2x = 0
-coi/gacc/fr-path-connection.pcert0 : \
-     coi/gacc/mem-fast.pcert0 \
-     coi/paths/path.pcert0 \
-     coi/records/mem-domain.pcert0 \
-     coi/osets/extras.pcert0 \
-     coi/paths/path.pcert0 \
-     coi/gacc/fr-path-connection.lisp \
-     coi/gacc/fr-path-connection.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/fr-path-connection.pcert1 : acl2x = 0
-coi/gacc/fr-path-connection.pcert1 : no_pcert = 0
-coi/gacc/fr-path-connection.pcert1 : coi/gacc/fr-path-connection.pcert0
-coi/gacc/fr-path-connection.cert : | coi/gacc/fr-path-connection.pcert1
-
-coi/gacc/gacc-exports.pcert0 : no_pcert = 0
-coi/gacc/gacc-exports.pcert0 : acl2x = 0
-coi/gacc/gacc-exports.pcert0 : \
-     coi/gacc/gacc-exports.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/gacc-exports.pcert1 : acl2x = 0
-coi/gacc/gacc-exports.pcert1 : no_pcert = 0
-coi/gacc/gacc-exports.pcert1 : coi/gacc/gacc-exports.pcert0
-coi/gacc/gacc-exports.cert : | coi/gacc/gacc-exports.pcert1
-
-coi/gacc/gacc-pkg.pcert0 : no_pcert = 0
-coi/gacc/gacc-pkg.pcert0 : acl2x = 0
-coi/gacc/gacc-pkg.pcert0 : \
-     coi/gacc/gacc-pkg.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/gacc-pkg.pcert1 : acl2x = 0
-coi/gacc/gacc-pkg.pcert1 : no_pcert = 0
-coi/gacc/gacc-pkg.pcert1 : coi/gacc/gacc-pkg.pcert0
-coi/gacc/gacc-pkg.cert : | coi/gacc/gacc-pkg.pcert1
-
-coi/gacc/gacc.pcert0 : no_pcert = 0
-coi/gacc/gacc.pcert0 : acl2x = 0
-coi/gacc/gacc.pcert0 : \
-     coi/gacc/ram.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     coi/bags/top.pcert0 \
-     coi/gacc/ram.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     coi/gacc/gacc.lisp \
-     coi/gacc/gacc.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/gacc.pcert1 : acl2x = 0
-coi/gacc/gacc.pcert1 : no_pcert = 0
-coi/gacc/gacc.pcert1 : coi/gacc/gacc.pcert0
-coi/gacc/gacc.cert : | coi/gacc/gacc.pcert1
-
-coi/gacc/gacc2.pcert0 : no_pcert = 0
-coi/gacc/gacc2.pcert0 : acl2x = 0
-coi/gacc/gacc2.pcert0 : \
-     coi/defstructure/defstructure.pcert0 \
-     coi/gacc/ram.pcert0 \
-     coi/defstructure/defstructure.pcert0 \
-     coi/gacc/ram.pcert0 \
-     coi/gacc/gacc2.lisp \
-     coi/gacc/gacc2.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/gacc2.pcert1 : acl2x = 0
-coi/gacc/gacc2.pcert1 : no_pcert = 0
-coi/gacc/gacc2.pcert1 : coi/gacc/gacc2.pcert0
-coi/gacc/gacc2.cert : | coi/gacc/gacc2.pcert1
-
-coi/gacc/gacc3.pcert0 : no_pcert = 0
-coi/gacc/gacc3.pcert0 : acl2x = 0
-coi/gacc/gacc3.pcert0 : \
-     coi/gacc/finite.pcert0 \
-     coi/gacc/finite.pcert0 \
-     coi/gacc/gacc3.lisp \
-     coi/gacc/gacc3.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/gacc3.pcert1 : acl2x = 0
-coi/gacc/gacc3.pcert1 : no_pcert = 0
-coi/gacc/gacc3.pcert1 : coi/gacc/gacc3.pcert0
-coi/gacc/gacc3.cert : | coi/gacc/gacc3.pcert1
-
-coi/gacc/gax.pcert0 : no_pcert = 0
-coi/gacc/gax.pcert0 : acl2x = 0
-coi/gacc/gax.pcert0 : \
-     coi/gacc/gacc2.pcert0 \
-     coi/gacc/gacc.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/gacc/gacc2.pcert0 \
-     coi/gacc/gacc.pcert0 \
-     coi/gacc/gax.lisp \
-     coi/gacc/gax.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/gax.pcert1 : acl2x = 0
-coi/gacc/gax.pcert1 : no_pcert = 0
-coi/gacc/gax.pcert1 : coi/gacc/gax.pcert0
-coi/gacc/gax.cert : | coi/gacc/gax.pcert1
-
-coi/gacc/list-ops-common.pcert0 : no_pcert = 0
-coi/gacc/list-ops-common.pcert0 : acl2x = 0
-coi/gacc/list-ops-common.pcert0 : \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/lists/repeat.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/lists/find-index.pcert0 \
-     coi/bags/pick-a-point.pcert0 \
-     coi/gacc/list-ops-common.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/list-ops-common.pcert1 : acl2x = 0
-coi/gacc/list-ops-common.pcert1 : no_pcert = 0
-coi/gacc/list-ops-common.pcert1 : coi/gacc/list-ops-common.pcert0
-coi/gacc/list-ops-common.cert : | coi/gacc/list-ops-common.pcert1
-
-coi/gacc/list-ops-fast.pcert0 : no_pcert = 0
-coi/gacc/list-ops-fast.pcert0 : acl2x = 0
-coi/gacc/list-ops-fast.pcert0 : \
-     coi/gacc/mem-fast.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/bags/extras.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/gacc/list-ops-common.pcert0 \
-     coi/gacc/list-ops-fast.lisp \
-     coi/gacc/list-ops-fast.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-coi/gacc/list-ops-fast.pcert1 : acl2x = 0
-coi/gacc/list-ops-fast.pcert1 : no_pcert = 0
-coi/gacc/list-ops-fast.pcert1 : coi/gacc/list-ops-fast.pcert0
-coi/gacc/list-ops-fast.cert : | coi/gacc/list-ops-fast.pcert1
-
-coi/gacc/list-ops.pcert0 : no_pcert = 0
-coi/gacc/list-ops.pcert0 : acl2x = 0
-coi/gacc/list-ops.pcert0 : \
-     coi/gacc/mem.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/gacc/list-ops-common.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/gacc/list-ops.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/list-ops.pcert1 : acl2x = 0
-coi/gacc/list-ops.pcert1 : no_pcert = 0
-coi/gacc/list-ops.pcert1 : coi/gacc/list-ops.pcert0
-coi/gacc/list-ops.cert : | coi/gacc/list-ops.pcert1
-
-coi/gacc/mem-fast.pcert0 : no_pcert = 0
-coi/gacc/mem-fast.pcert0 : acl2x = 0
-coi/gacc/mem-fast.pcert0 : \
-     coi/records/defrecord-fast.pcert0 \
-     coi/super-ihs/loghead.pcert0 \
-     coi/super-ihs/unsigned-byte-p.pcert0 \
-     coi/util/syntaxp.pcert0 \
-     coi/gacc/mem-fast.lisp \
-     coi/gacc/mem-fast.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-coi/gacc/mem-fast.pcert1 : acl2x = 0
-coi/gacc/mem-fast.pcert1 : no_pcert = 0
-coi/gacc/mem-fast.pcert1 : coi/gacc/mem-fast.pcert0
-coi/gacc/mem-fast.cert : | coi/gacc/mem-fast.pcert1
-
-coi/gacc/mem.pcert0 : no_pcert = 0
-coi/gacc/mem.pcert0 : acl2x = 0
-coi/gacc/mem.pcert0 : \
-     coi/records/defrecord.pcert0 \
-     coi/super-ihs/loghead.pcert0 \
-     coi/super-ihs/unsigned-byte-p.pcert0 \
-     coi/util/syntaxp.pcert0 \
-     coi/gacc/mem.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/mem.pcert1 : acl2x = 0
-coi/gacc/mem.pcert1 : no_pcert = 0
-coi/gacc/mem.pcert1 : coi/gacc/mem.pcert0
-coi/gacc/mem.cert : | coi/gacc/mem.pcert1
-
-coi/gacc/ram.pcert0 : no_pcert = 0
-coi/gacc/ram.pcert0 : acl2x = 0
-coi/gacc/ram.pcert0 : \
-     coi/gacc/ram0.pcert0 \
-     coi/gacc/block.pcert0 \
-     coi/bags/two-level-meta.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/gacc/addr-range.pcert0 \
-     coi/gacc/list-ops.pcert0 \
-     coi/gacc/ram.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/ram.pcert1 : acl2x = 0
-coi/gacc/ram.pcert1 : no_pcert = 0
-coi/gacc/ram.pcert1 : coi/gacc/ram.pcert0
-coi/gacc/ram.cert : | coi/gacc/ram.pcert1
-
-coi/gacc/ram0.pcert0 : no_pcert = 0
-coi/gacc/ram0.pcert0 : acl2x = 0
-coi/gacc/ram0.pcert0 : \
-     coi/gacc/mem.pcert0 \
-     coi/super-ihs/byte-p.pcert0 \
-     coi/gacc/ram0.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/ram0.pcert1 : acl2x = 0
-coi/gacc/ram0.pcert1 : no_pcert = 0
-coi/gacc/ram0.pcert1 : coi/gacc/ram0.pcert0
-coi/gacc/ram0.cert : | coi/gacc/ram0.pcert1
-
-coi/gacc/ram2.pcert0 : no_pcert = 0
-coi/gacc/ram2.pcert0 : acl2x = 0
-coi/gacc/ram2.pcert0 : \
-     coi/gacc/list-ops-fast.pcert0 \
-     coi/gacc/addr-range.pcert0 \
-     coi/gacc/wrap.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/gacc/ram2.lisp \
-     coi/gacc/ram2.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-coi/gacc/ram2.pcert1 : acl2x = 0
-coi/gacc/ram2.pcert1 : no_pcert = 0
-coi/gacc/ram2.pcert1 : coi/gacc/ram2.pcert0
-coi/gacc/ram2.cert : | coi/gacc/ram2.pcert1
-
-coi/gacc/ram2b.pcert0 : no_pcert = 0
-coi/gacc/ram2b.pcert0 : acl2x = 0
-coi/gacc/ram2b.pcert0 : \
-     coi/gacc/list-ops-fast.pcert0 \
-     coi/gacc/addr-range.pcert0 \
-     coi/gacc/ram3.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/gacc/ram2b.lisp \
-     coi/gacc/ram2b.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-coi/gacc/ram2b.pcert1 : acl2x = 0
-coi/gacc/ram2b.pcert1 : no_pcert = 0
-coi/gacc/ram2b.pcert1 : coi/gacc/ram2b.pcert0
-coi/gacc/ram2b.cert : | coi/gacc/ram2b.pcert1
-
-coi/gacc/ram3.pcert0 : no_pcert = 0
-coi/gacc/ram3.pcert0 : acl2x = 0
-coi/gacc/ram3.pcert0 : \
-     coi/util/iff.pcert0 \
-     coi/gacc/list-ops-fast.pcert0 \
-     coi/gacc/wrap.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/super-ihs/fast.pcert0 \
-     coi/lists/mixed.pcert0 \
-     coi/bags/pick-a-point.pcert0 \
-     coi/lists/repeat.pcert0 \
-     coi/gacc/ram3.lisp \
-     coi/gacc/ram3.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     data-structures/memories/package.lsp
-coi/gacc/ram3.pcert1 : acl2x = 0
-coi/gacc/ram3.pcert1 : no_pcert = 0
-coi/gacc/ram3.pcert1 : coi/gacc/ram3.pcert0
-coi/gacc/ram3.cert : | coi/gacc/ram3.pcert1
-
-coi/gacc/top.pcert0 : no_pcert = 0
-coi/gacc/top.pcert0 : acl2x = 0
-coi/gacc/top.pcert0 : \
-     coi/gacc/gacc3.pcert0 \
-     coi/gacc/gacc3.pcert0 \
-     coi/gacc/top.lisp \
-     coi/gacc/top.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/top.pcert1 : acl2x = 0
-coi/gacc/top.pcert1 : no_pcert = 0
-coi/gacc/top.pcert1 : coi/gacc/top.pcert0
-coi/gacc/top.cert : | coi/gacc/top.pcert1
-
-coi/gacc/tr-path-connection.pcert0 : no_pcert = 0
-coi/gacc/tr-path-connection.pcert0 : acl2x = 0
-coi/gacc/tr-path-connection.pcert0 : \
-     coi/gacc/mem.pcert0 \
-     coi/paths/path.pcert0 \
-     coi/records/domain.pcert0 \
-     coi/osets/conversions.pcert0 \
-     coi/osets/quantify.pcert0 \
-     coi/gacc/tr-path-connection.lisp \
-     coi/gacc/tr-path-connection.acl2 \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/tr-path-connection.pcert1 : acl2x = 0
-coi/gacc/tr-path-connection.pcert1 : no_pcert = 0
-coi/gacc/tr-path-connection.pcert1 : coi/gacc/tr-path-connection.pcert0
-coi/gacc/tr-path-connection.cert : | coi/gacc/tr-path-connection.pcert1
-
-coi/gacc/wrap.pcert0 : no_pcert = 0
-coi/gacc/wrap.pcert0 : acl2x = 0
-coi/gacc/wrap.pcert0 : \
-     coi/bags/basic.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/gacc/addr-range.pcert0 \
-     coi/lists/mixed.pcert0 \
-     coi/lists/find-index.pcert0 \
-     coi/util/syntaxp.pcert0 \
-     coi/gacc/wrap.lisp \
-     coi/gacc/cert.acl2 \
-     coi/gacc/gacc-defpkg.lsp \
-     coi/super-ihs/symbols.lsp \
-     coi/super-ihs/symbols-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/bags/bag-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp
-coi/gacc/wrap.pcert1 : acl2x = 0
-coi/gacc/wrap.pcert1 : no_pcert = 0
-coi/gacc/wrap.pcert1 : coi/gacc/wrap.pcert0
-coi/gacc/wrap.cert : | coi/gacc/wrap.pcert1
-
-coi/generalize/generalize.pcert0 : no_pcert = 0
-coi/generalize/generalize.pcert0 : acl2x = 0
-coi/generalize/generalize.pcert0 : \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/gensym/gensym.pcert0 \
-     coi/bags/top.pcert0 \
-     coi/lists/set.pcert0 \
-     coi/util/clause-processor.pcert0 \
-     coi/generalize/generalize.lisp \
-     coi/generalize/cert.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/generalize/generalize.pcert1 : acl2x = 0
-coi/generalize/generalize.pcert1 : no_pcert = 0
-coi/generalize/generalize.pcert1 : coi/generalize/generalize.pcert0
-coi/generalize/generalize.cert : | coi/generalize/generalize.pcert1
-
-coi/gensym/gensym-list.pcert0 : no_pcert = 0
-coi/gensym/gensym-list.pcert0 : acl2x = 0
-coi/gensym/gensym-list.pcert0 : \
-     coi/gensym/gensym.pcert0 \
-     coi/lists/disjoint.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/gensym/gensym-list.lisp \
-     coi/gensym/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/gensym/gensym-list.pcert1 : acl2x = 0
-coi/gensym/gensym-list.pcert1 : no_pcert = 0
-coi/gensym/gensym-list.pcert1 : coi/gensym/gensym-list.pcert0
-coi/gensym/gensym-list.cert : | coi/gensym/gensym-list.pcert1
-
-coi/gensym/gensym.pcert0 : no_pcert = 0
-coi/gensym/gensym.pcert0 : acl2x = 0
-coi/gensym/gensym.pcert0 : \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/util/ordinal-order.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     coi/bags/top.pcert0 \
-     coi/lists/set.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/gensym/gensym.lisp \
-     coi/gensym/cert.acl2 \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/gensym/gensym.pcert1 : acl2x = 0
-coi/gensym/gensym.pcert1 : no_pcert = 0
-coi/gensym/gensym.pcert1 : coi/gensym/gensym.pcert0
-coi/gensym/gensym.cert : | coi/gensym/gensym.pcert1
-
-coi/lists/acl2-count.pcert0 : no_pcert = 0
-coi/lists/acl2-count.pcert0 : acl2x = 0
-coi/lists/acl2-count.pcert0 : \
-     coi/lists/acl2-count.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/acl2-count.pcert1 : acl2x = 0
-coi/lists/acl2-count.pcert1 : no_pcert = 0
-coi/lists/acl2-count.pcert1 : coi/lists/acl2-count.pcert0
-coi/lists/acl2-count.cert : | coi/lists/acl2-count.pcert1
-
-coi/lists/basic.pcert0 : no_pcert = 0
-coi/lists/basic.pcert0 : acl2x = 0
-coi/lists/basic.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     coi/util/debug.pcert0 \
-     coi/lists/acl2-count.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/adviser/adviser.pcert0 \
-     coi/lists/basic.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/basic.pcert1 : acl2x = 0
-coi/lists/basic.pcert1 : no_pcert = 0
-coi/lists/basic.pcert1 : coi/lists/basic.pcert0
-coi/lists/basic.cert : | coi/lists/basic.pcert1
-
-coi/lists/disjoint.pcert0 : no_pcert = 0
-coi/lists/disjoint.pcert0 : acl2x = 0
-coi/lists/disjoint.pcert0 : \
-     coi/lists/memberp.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/lists/remove.pcert0 \
-     coi/lists/disjoint.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/disjoint.pcert1 : acl2x = 0
-coi/lists/disjoint.pcert1 : no_pcert = 0
-coi/lists/disjoint.pcert1 : coi/lists/disjoint.pcert0
-coi/lists/disjoint.cert : | coi/lists/disjoint.pcert1
-
-coi/lists/find-index.pcert0 : no_pcert = 0
-coi/lists/find-index.pcert0 : acl2x = 0
-coi/lists/find-index.pcert0 : \
-     coi/lists/nth-and-update-nth.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/lists/find-index.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/find-index.pcert1 : acl2x = 0
-coi/lists/find-index.pcert1 : no_pcert = 0
-coi/lists/find-index.pcert1 : coi/lists/find-index.pcert0
-coi/lists/find-index.cert : | coi/lists/find-index.pcert1
-
-coi/lists/list-top.pcert0 : no_pcert = 0
-coi/lists/list-top.pcert0 : acl2x = 0
-coi/lists/list-top.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/lists/map-cons.pcert0 \
-     coi/lists/repeat.pcert0 \
-     coi/lists/nth-and-update-nth.pcert0 \
-     coi/lists/update-nth-array.pcert0 \
-     coi/lists/list-top.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/list-top.pcert1 : acl2x = 0
-coi/lists/list-top.pcert1 : no_pcert = 0
-coi/lists/list-top.pcert1 : coi/lists/list-top.pcert0
-coi/lists/list-top.cert : | coi/lists/list-top.pcert1
-
-coi/lists/listset-induction.pcert0 : no_pcert = 0
-coi/lists/listset-induction.pcert0 : acl2x = 0
-coi/lists/listset-induction.pcert0 : \
-     coi/lists/subsetp.pcert0 \
-     coi/lists/remove.pcert0 \
-     coi/lists/set.pcert0 \
-     coi/lists/listset-induction.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/listset-induction.pcert1 : acl2x = 0
-coi/lists/listset-induction.pcert1 : no_pcert = 0
-coi/lists/listset-induction.pcert1 : coi/lists/listset-induction.pcert0
-coi/lists/listset-induction.cert : | coi/lists/listset-induction.pcert1
-
-coi/lists/map-cons.pcert0 : no_pcert = 0
-coi/lists/map-cons.pcert0 : acl2x = 0
-coi/lists/map-cons.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/lists/map-cons.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/map-cons.pcert1 : acl2x = 0
-coi/lists/map-cons.pcert1 : no_pcert = 0
-coi/lists/map-cons.pcert1 : coi/lists/map-cons.pcert0
-coi/lists/map-cons.cert : | coi/lists/map-cons.pcert1
-
-coi/lists/memberp.pcert0 : no_pcert = 0
-coi/lists/memberp.pcert0 : acl2x = 0
-coi/lists/memberp.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/lists/memberp.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/memberp.pcert1 : acl2x = 0
-coi/lists/memberp.pcert1 : no_pcert = 0
-coi/lists/memberp.pcert1 : coi/lists/memberp.pcert0
-coi/lists/memberp.cert : | coi/lists/memberp.pcert1
-
-coi/lists/mixed.pcert0 : no_pcert = 0
-coi/lists/mixed.pcert0 : acl2x = 0
-coi/lists/mixed.pcert0 : \
-     coi/lists/repeat.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/lists/mixed.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/mixed.pcert1 : acl2x = 0
-coi/lists/mixed.pcert1 : no_pcert = 0
-coi/lists/mixed.pcert1 : coi/lists/mixed.pcert0
-coi/lists/mixed.cert : | coi/lists/mixed.pcert1
-
-coi/lists/mv-nth.pcert0 : no_pcert = 0
-coi/lists/mv-nth.pcert0 : acl2x = 0
-coi/lists/mv-nth.pcert0 : \
-     coi/lists/mv-nth.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/mv-nth.pcert1 : acl2x = 0
-coi/lists/mv-nth.pcert1 : no_pcert = 0
-coi/lists/mv-nth.pcert1 : coi/lists/mv-nth.pcert0
-coi/lists/mv-nth.cert : | coi/lists/mv-nth.pcert1
-
-coi/lists/nth-and-update-nth.pcert0 : no_pcert = 0
-coi/lists/nth-and-update-nth.pcert0 : acl2x = 0
-coi/lists/nth-and-update-nth.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/lists/repeat.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/lists/nth-and-update-nth.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/nth-and-update-nth.pcert1 : acl2x = 0
-coi/lists/nth-and-update-nth.pcert1 : no_pcert = 0
-coi/lists/nth-and-update-nth.pcert1 : coi/lists/nth-and-update-nth.pcert0
-coi/lists/nth-and-update-nth.cert : | coi/lists/nth-and-update-nth.pcert1
-
-coi/lists/nth-meta.pcert0 : no_pcert = 0
-coi/lists/nth-meta.pcert0 : acl2x = 0
-coi/lists/nth-meta.pcert0 : \
-     coi/lists/nth-meta.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/nth-meta.pcert1 : acl2x = 0
-coi/lists/nth-meta.pcert1 : no_pcert = 0
-coi/lists/nth-meta.pcert1 : coi/lists/nth-meta.pcert0
-coi/lists/nth-meta.cert : | coi/lists/nth-meta.pcert1
-
-coi/lists/nth-meta2.pcert0 : no_pcert = 0
-coi/lists/nth-meta2.pcert0 : acl2x = 0
-coi/lists/nth-meta2.pcert0 : \
-     coi/lists/nth-meta2.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/nth-meta2.pcert1 : acl2x = 0
-coi/lists/nth-meta2.pcert1 : no_pcert = 0
-coi/lists/nth-meta2.pcert1 : coi/lists/nth-meta2.pcert0
-coi/lists/nth-meta2.cert : | coi/lists/nth-meta2.pcert1
-
-coi/lists/remove-induction.pcert0 : no_pcert = 0
-coi/lists/remove-induction.pcert0 : acl2x = 0
-coi/lists/remove-induction.pcert0 : \
-     coi/lists/remove.pcert0 \
-     coi/lists/remove-induction.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/remove-induction.pcert1 : acl2x = 0
-coi/lists/remove-induction.pcert1 : no_pcert = 0
-coi/lists/remove-induction.pcert1 : coi/lists/remove-induction.pcert0
-coi/lists/remove-induction.cert : | coi/lists/remove-induction.pcert1
-
-coi/lists/remove.pcert0 : no_pcert = 0
-coi/lists/remove.pcert0 : acl2x = 0
-coi/lists/remove.pcert0 : \
-     coi/lists/subsetp.pcert0 \
-     coi/lists/remove.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/remove.pcert1 : acl2x = 0
-coi/lists/remove.pcert1 : no_pcert = 0
-coi/lists/remove.pcert1 : coi/lists/remove.pcert0
-coi/lists/remove.cert : | coi/lists/remove.pcert1
-
-coi/lists/repeat.pcert0 : no_pcert = 0
-coi/lists/repeat.pcert0 : acl2x = 0
-coi/lists/repeat.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/lists/repeat.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/repeat.pcert1 : acl2x = 0
-coi/lists/repeat.pcert1 : no_pcert = 0
-coi/lists/repeat.pcert1 : coi/lists/repeat.pcert0
-coi/lists/repeat.cert : | coi/lists/repeat.pcert1
-
-coi/lists/set.pcert0 : no_pcert = 0
-coi/lists/set.pcert0 : acl2x = 0
-coi/lists/set.pcert0 : \
-     coi/lists/remove.pcert0 \
-     coi/lists/disjoint.pcert0 \
-     coi/util/defbinding.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/lists/remove-induction.pcert0 \
-     coi/lists/remove-induction.pcert0 \
-     coi/lists/set.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/set.pcert1 : acl2x = 0
-coi/lists/set.pcert1 : no_pcert = 0
-coi/lists/set.pcert1 : coi/lists/set.pcert0
-coi/lists/set.cert : | coi/lists/set.pcert1
-
-coi/lists/subsetp.pcert0 : no_pcert = 0
-coi/lists/subsetp.pcert0 : acl2x = 0
-coi/lists/subsetp.pcert0 : \
-     coi/adviser/adviser.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/lists/subsetp.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/subsetp.pcert1 : acl2x = 0
-coi/lists/subsetp.pcert1 : no_pcert = 0
-coi/lists/subsetp.pcert1 : coi/lists/subsetp.pcert0
-coi/lists/subsetp.cert : | coi/lists/subsetp.pcert1
-
-coi/lists/update-nth-array.pcert0 : no_pcert = 0
-coi/lists/update-nth-array.pcert0 : acl2x = 0
-coi/lists/update-nth-array.pcert0 : \
-     coi/lists/nth-and-update-nth.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/lists/update-nth-array.lisp \
-     coi/lists/cert.acl2 \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/lists/update-nth-array.pcert1 : acl2x = 0
-coi/lists/update-nth-array.pcert1 : no_pcert = 0
-coi/lists/update-nth-array.pcert1 : coi/lists/update-nth-array.pcert0
-coi/lists/update-nth-array.cert : | coi/lists/update-nth-array.pcert1
-
-coi/maps/aliases.pcert0 : no_pcert = 0
-coi/maps/aliases.pcert0 : acl2x = 0
-coi/maps/aliases.pcert0 : \
-     coi/maps/maps.pcert0 \
-     coi/maps/aliases.lisp \
-     coi/maps/cert.acl2 \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/maps/aliases.pcert1 : acl2x = 0
-coi/maps/aliases.pcert1 : no_pcert = 0
-coi/maps/aliases.pcert1 : coi/maps/aliases.pcert0
-coi/maps/aliases.cert : | coi/maps/aliases.pcert1
-
-coi/maps/maps.pcert0 : no_pcert = 0
-coi/maps/maps.pcert0 : acl2x = 0
-coi/maps/maps.pcert0 : \
-     coi/osets/sets.pcert0 \
-     coi/adviser/adviser.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     coi/maps/maps.lisp \
-     coi/maps/cert.acl2 \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/maps/maps.pcert1 : acl2x = 0
-coi/maps/maps.pcert1 : no_pcert = 0
-coi/maps/maps.pcert1 : coi/maps/maps.pcert0
-coi/maps/maps.cert : | coi/maps/maps.pcert1
-
-coi/maps/typed-maps.pcert0 : no_pcert = 0
-coi/maps/typed-maps.pcert0 : acl2x = 0
-coi/maps/typed-maps.pcert0 : \
-     coi/maps/maps.pcert0 \
-     coi/maps/typed-maps.lisp \
-     coi/maps/cert.acl2 \
-     coi/maps/map-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/maps/typed-maps.pcert1 : acl2x = 0
-coi/maps/typed-maps.pcert1 : no_pcert = 0
-coi/maps/typed-maps.pcert1 : coi/maps/typed-maps.pcert0
-coi/maps/typed-maps.cert : | coi/maps/typed-maps.pcert1
-
-coi/nary/example.pcert0 : no_pcert = 0
-coi/nary/example.pcert0 : acl2x = 0
-coi/nary/example.pcert0 : \
-     coi/nary/nary.pcert0 \
-     ihs/ihs-definitions.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     coi/nary/nth-rules.pcert0 \
-     coi/nary/example.lisp \
-     coi/nary/cert.acl2
-coi/nary/example.pcert1 : acl2x = 0
-coi/nary/example.pcert1 : no_pcert = 0
-coi/nary/example.pcert1 : coi/nary/example.pcert0
-coi/nary/example.cert : | coi/nary/example.pcert1
-
-coi/nary/nary.pcert0 : no_pcert = 0
-coi/nary/nary.pcert0 : acl2x = 0
-coi/nary/nary.pcert0 : \
-     coi/util/in-conclusion.pcert0 \
-     coi/util/implies.pcert0 \
-     coi/nary/nary.lisp \
-     coi/nary/cert.acl2
-coi/nary/nary.pcert1 : acl2x = 0
-coi/nary/nary.pcert1 : no_pcert = 0
-coi/nary/nary.pcert1 : coi/nary/nary.pcert0
-coi/nary/nary.cert : | coi/nary/nary.pcert1
-
-coi/nary/nth-rules.pcert0 : no_pcert = 0
-coi/nary/nth-rules.pcert0 : acl2x = 0
-coi/nary/nth-rules.pcert0 : \
-     coi/nary/nth-rules.lisp \
-     coi/nary/cert.acl2
-coi/nary/nth-rules.pcert1 : acl2x = 0
-coi/nary/nth-rules.pcert1 : no_pcert = 0
-coi/nary/nth-rules.pcert1 : coi/nary/nth-rules.pcert0
-coi/nary/nth-rules.cert : | coi/nary/nth-rules.pcert1
-
-coi/nary/ordinal-order.pcert0 : no_pcert = 0
-coi/nary/ordinal-order.pcert0 : acl2x = 0
-coi/nary/ordinal-order.pcert0 : \
-     ordinals/lexicographic-ordering.pcert0 \
-     coi/nary/ordinal-order.lisp \
-     coi/nary/cert.acl2
-coi/nary/ordinal-order.pcert1 : acl2x = 0
-coi/nary/ordinal-order.pcert1 : no_pcert = 0
-coi/nary/ordinal-order.pcert1 : coi/nary/ordinal-order.pcert0
-coi/nary/ordinal-order.cert : | coi/nary/ordinal-order.pcert1
-
-coi/nary/rewrite-equal-hint.pcert0 : no_pcert = 0
-coi/nary/rewrite-equal-hint.pcert0 : acl2x = 0
-coi/nary/rewrite-equal-hint.pcert0 : \
-     coi/nary/rewrite-equal-hint.lisp \
-     coi/nary/cert.acl2
-coi/nary/rewrite-equal-hint.pcert1 : acl2x = 0
-coi/nary/rewrite-equal-hint.pcert1 : no_pcert = 0
-coi/nary/rewrite-equal-hint.pcert1 : coi/nary/rewrite-equal-hint.pcert0
-coi/nary/rewrite-equal-hint.cert : | coi/nary/rewrite-equal-hint.pcert1
-
-coi/osets/computed-hints.pcert0 : no_pcert = 0
-coi/osets/computed-hints.pcert0 : acl2x = 0
-coi/osets/computed-hints.pcert0 : \
-     coi/osets/instance.pcert0 \
-     coi/osets/computed-hints.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/computed-hints.pcert1 : acl2x = 0
-coi/osets/computed-hints.pcert1 : no_pcert = 0
-coi/osets/computed-hints.pcert1 : coi/osets/computed-hints.pcert0
-coi/osets/computed-hints.cert : | coi/osets/computed-hints.pcert1
-
-coi/osets/conversions.pcert0 : no_pcert = 0
-coi/osets/conversions.pcert0 : acl2x = 0
-coi/osets/conversions.pcert0 : \
-     coi/osets/sets.pcert0 \
-     coi/lists/set.pcert0 \
-     coi/osets/conversions.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/conversions.pcert1 : acl2x = 0
-coi/osets/conversions.pcert1 : no_pcert = 0
-coi/osets/conversions.pcert1 : coi/osets/conversions.pcert0
-coi/osets/conversions.cert : | coi/osets/conversions.pcert1
-
-coi/osets/extras.pcert0 : no_pcert = 0
-coi/osets/extras.pcert0 : acl2x = 0
-coi/osets/extras.pcert0 : \
-     coi/osets/sets.pcert0 \
-     coi/osets/set-order.pcert0 \
-     coi/osets/conversions.pcert0 \
-     coi/util/iff.pcert0 \
-     misc/total-order.pcert0 \
-     coi/osets/extras.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/extras.pcert1 : acl2x = 0
-coi/osets/extras.pcert1 : no_pcert = 0
-coi/osets/extras.pcert1 : coi/osets/extras.pcert0
-coi/osets/extras.cert : | coi/osets/extras.pcert1
-
-coi/osets/fast.pcert0 : no_pcert = 0
-coi/osets/fast.pcert0 : acl2x = 0
-coi/osets/fast.pcert0 : \
-     coi/osets/membership.pcert0 \
-     coi/osets/fast.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/fast.pcert1 : acl2x = 0
-coi/osets/fast.pcert1 : no_pcert = 0
-coi/osets/fast.pcert1 : coi/osets/fast.pcert0
-coi/osets/fast.cert : | coi/osets/fast.pcert1
-
-coi/osets/instance.pcert0 : no_pcert = 0
-coi/osets/instance.pcert0 : acl2x = 0
-coi/osets/instance.pcert0 : \
-     coi/osets/instance.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/instance.pcert1 : acl2x = 0
-coi/osets/instance.pcert1 : no_pcert = 0
-coi/osets/instance.pcert1 : coi/osets/instance.pcert0
-coi/osets/instance.cert : | coi/osets/instance.pcert1
-
-coi/osets/listsets.pcert0 : no_pcert = 0
-coi/osets/listsets.pcert0 : acl2x = 0
-coi/osets/listsets.pcert0 : \
-     misc/untranslate-patterns.pcert0 \
-     coi/lists/basic.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/osets/map.pcert0 \
-     coi/osets/listsets.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/listsets.pcert1 : acl2x = 0
-coi/osets/listsets.pcert1 : no_pcert = 0
-coi/osets/listsets.pcert1 : coi/osets/listsets.pcert0
-coi/osets/listsets.cert : | coi/osets/listsets.pcert1
-
-coi/osets/map.pcert0 : no_pcert = 0
-coi/osets/map.pcert0 : acl2x = 0
-coi/osets/map.pcert0 : \
-     coi/osets/quantify.pcert0 \
-     coi/osets/map.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/map.pcert1 : acl2x = 0
-coi/osets/map.pcert1 : no_pcert = 0
-coi/osets/map.pcert1 : coi/osets/map.pcert0
-coi/osets/map.cert : | coi/osets/map.pcert1
-
-coi/osets/membership.pcert0 : no_pcert = 0
-coi/osets/membership.pcert0 : acl2x = 0
-coi/osets/membership.pcert0 : \
-     coi/osets/primitives.pcert0 \
-     coi/osets/computed-hints.pcert0 \
-     coi/osets/membership.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/membership.pcert1 : acl2x = 0
-coi/osets/membership.pcert1 : no_pcert = 0
-coi/osets/membership.pcert1 : coi/osets/membership.pcert0
-coi/osets/membership.cert : | coi/osets/membership.pcert1
-
-coi/osets/multiappend.pcert0 : no_pcert = 0
-coi/osets/multiappend.pcert0 : acl2x = 0
-coi/osets/multiappend.pcert0 : \
-     coi/osets/multicons.pcert0 \
-     coi/util/iff.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/osets/multiappend.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/multiappend.pcert1 : acl2x = 0
-coi/osets/multiappend.pcert1 : no_pcert = 0
-coi/osets/multiappend.pcert1 : coi/osets/multiappend.pcert0
-coi/osets/multiappend.cert : | coi/osets/multiappend.pcert1
-
-coi/osets/multicons.pcert0 : no_pcert = 0
-coi/osets/multicons.pcert0 : acl2x = 0
-coi/osets/multicons.pcert0 : \
-     coi/osets/sets.pcert0 \
-     coi/osets/listsets.pcert0 \
-     coi/osets/multicons.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/multicons.pcert1 : acl2x = 0
-coi/osets/multicons.pcert1 : no_pcert = 0
-coi/osets/multicons.pcert1 : coi/osets/multicons.pcert0
-coi/osets/multicons.cert : | coi/osets/multicons.pcert1
-
-coi/osets/outer.pcert0 : no_pcert = 0
-coi/osets/outer.pcert0 : acl2x = 0
-coi/osets/outer.pcert0 : \
-     coi/osets/fast.pcert0 \
-     coi/osets/outer.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/outer.pcert1 : acl2x = 0
-coi/osets/outer.pcert1 : no_pcert = 0
-coi/osets/outer.pcert1 : coi/osets/outer.pcert0
-coi/osets/outer.cert : | coi/osets/outer.pcert1
-
-coi/osets/primitives.pcert0 : no_pcert = 0
-coi/osets/primitives.pcert0 : acl2x = 0
-coi/osets/primitives.pcert0 : \
-     misc/total-order.pcert0 \
-     coi/osets/primitives.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/primitives.pcert1 : acl2x = 0
-coi/osets/primitives.pcert1 : no_pcert = 0
-coi/osets/primitives.pcert1 : coi/osets/primitives.pcert0
-coi/osets/primitives.cert : | coi/osets/primitives.pcert1
-
-coi/osets/quantify.pcert0 : no_pcert = 0
-coi/osets/quantify.pcert0 : acl2x = 0
-coi/osets/quantify.pcert0 : \
-     coi/osets/sets.pcert0 \
-     coi/osets/quantify.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/quantify.pcert1 : acl2x = 0
-coi/osets/quantify.pcert1 : no_pcert = 0
-coi/osets/quantify.pcert1 : coi/osets/quantify.pcert0
-coi/osets/quantify.cert : | coi/osets/quantify.pcert1
-
-coi/osets/set-order.pcert0 : no_pcert = 0
-coi/osets/set-order.pcert0 : acl2x = 0
-coi/osets/set-order.pcert0 : \
-     coi/osets/primitives.pcert0 \
-     coi/osets/membership.pcert0 \
-     coi/osets/fast.pcert0 \
-     coi/osets/sets.pcert0 \
-     misc/total-order.pcert0 \
-     coi/osets/set-order.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/set-order.pcert1 : acl2x = 0
-coi/osets/set-order.pcert1 : no_pcert = 0
-coi/osets/set-order.pcert1 : coi/osets/set-order.pcert0
-coi/osets/set-order.cert : | coi/osets/set-order.pcert1
-
-coi/osets/set-processor.pcert0 : no_pcert = 0
-coi/osets/set-processor.pcert0 : acl2x = 0
-coi/osets/set-processor.pcert0 : \
-     coi/osets/sets.pcert0 \
-     coi/osets/set-processor.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/set-processor.pcert1 : acl2x = 0
-coi/osets/set-processor.pcert1 : no_pcert = 0
-coi/osets/set-processor.pcert1 : coi/osets/set-processor.pcert0
-coi/osets/set-processor.cert : | coi/osets/set-processor.pcert1
-
-coi/osets/sets.pcert0 : no_pcert = 0
-coi/osets/sets.pcert0 : acl2x = 0
-coi/osets/sets.pcert0 : \
-     coi/osets/computed-hints.pcert0 \
-     coi/osets/primitives.pcert0 \
-     coi/osets/membership.pcert0 \
-     coi/osets/fast.pcert0 \
-     coi/osets/outer.pcert0 \
-     coi/osets/sort.pcert0 \
-     misc/total-order.pcert0 \
-     coi/osets/sets.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/sets.pcert1 : acl2x = 0
-coi/osets/sets.pcert1 : no_pcert = 0
-coi/osets/sets.pcert1 : coi/osets/sets.pcert0
-coi/osets/sets.cert : | coi/osets/sets.pcert1
-
-coi/osets/sort.pcert0 : no_pcert = 0
-coi/osets/sort.pcert0 : acl2x = 0
-coi/osets/sort.pcert0 : \
-     coi/osets/outer.pcert0 \
-     coi/osets/sort.lisp \
-     coi/osets/cert.acl2 \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/osets/sort.pcert1 : acl2x = 0
-coi/osets/sort.pcert1 : no_pcert = 0
-coi/osets/sort.pcert1 : coi/osets/sort.pcert0
-coi/osets/sort.cert : | coi/osets/sort.pcert1
-
-coi/paths/compatibility.pcert0 : no_pcert = 0
-coi/paths/compatibility.pcert0 : acl2x = 0
-coi/paths/compatibility.pcert0 : \
-     coi/alists/top.pcert0 \
-     coi/paths/compatibility.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/compatibility.pcert1 : acl2x = 0
-coi/paths/compatibility.pcert1 : no_pcert = 0
-coi/paths/compatibility.pcert1 : coi/paths/compatibility.pcert0
-coi/paths/compatibility.cert : | coi/paths/compatibility.pcert1
-
-coi/paths/cp-set.pcert0 : no_pcert = 0
-coi/paths/cp-set.pcert0 : acl2x = 0
-coi/paths/cp-set.pcert0 : \
-     coi/osets/multicons.pcert0 \
-     coi/paths/hints.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/osets/multiappend.pcert0 \
-     coi/paths/cp-set.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/cp-set.pcert1 : acl2x = 0
-coi/paths/cp-set.pcert1 : no_pcert = 0
-coi/paths/cp-set.pcert1 : coi/paths/cp-set.pcert0
-coi/paths/cp-set.cert : | coi/paths/cp-set.pcert1
-
-coi/paths/defs.pcert0 : no_pcert = 0
-coi/paths/defs.pcert0 : acl2x = 0
-coi/paths/defs.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/paths/defs.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/defs.pcert1 : acl2x = 0
-coi/paths/defs.pcert1 : no_pcert = 0
-coi/paths/defs.pcert1 : coi/paths/defs.pcert0
-coi/paths/defs.cert : | coi/paths/defs.pcert1
-
-coi/paths/diverge.pcert0 : no_pcert = 0
-coi/paths/diverge.pcert0 : acl2x = 0
-coi/paths/diverge.pcert0 : \
-     coi/paths/dominates.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/paths/diverge.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/diverge.pcert1 : acl2x = 0
-coi/paths/diverge.pcert1 : no_pcert = 0
-coi/paths/diverge.pcert1 : coi/paths/diverge.pcert0
-coi/paths/diverge.cert : | coi/paths/diverge.pcert1
-
-coi/paths/dominates.pcert0 : no_pcert = 0
-coi/paths/dominates.pcert0 : acl2x = 0
-coi/paths/dominates.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/lists/memberp.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/adviser/adviser.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/paths/dominates.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/dominates.pcert1 : acl2x = 0
-coi/paths/dominates.pcert1 : no_pcert = 0
-coi/paths/dominates.pcert1 : coi/paths/dominates.pcert0
-coi/paths/dominates.cert : | coi/paths/dominates.pcert1
-
-coi/paths/equiv.pcert0 : no_pcert = 0
-coi/paths/equiv.pcert0 : acl2x = 0
-coi/paths/equiv.pcert0 : \
-     coi/util/iff.pcert0 \
-     coi/paths/path.pcert0 \
-     coi/paths/equiv.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/equiv.pcert1 : acl2x = 0
-coi/paths/equiv.pcert1 : no_pcert = 0
-coi/paths/equiv.pcert1 : coi/paths/equiv.pcert0
-coi/paths/equiv.cert : | coi/paths/equiv.pcert1
-
-coi/paths/hints.pcert0 : no_pcert = 0
-coi/paths/hints.pcert0 : acl2x = 0
-coi/paths/hints.pcert0 : \
-     coi/paths/pm.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/paths/hints.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/hints.pcert1 : acl2x = 0
-coi/paths/hints.pcert1 : no_pcert = 0
-coi/paths/hints.pcert1 : coi/paths/hints.pcert0
-coi/paths/hints.cert : | coi/paths/hints.pcert1
-
-coi/paths/list-path-connection.pcert0 : no_pcert = 0
-coi/paths/list-path-connection.pcert0 : acl2x = 0
-coi/paths/list-path-connection.pcert0 : \
-     coi/records/domain.pcert0 \
-     coi/bags/extras.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/paths/path.pcert0 \
-     coi/paths/list-path-connection.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/list-path-connection.pcert1 : acl2x = 0
-coi/paths/list-path-connection.pcert1 : no_pcert = 0
-coi/paths/list-path-connection.pcert1 : coi/paths/list-path-connection.pcert0
-coi/paths/list-path-connection.cert : | coi/paths/list-path-connection.pcert1
-
-coi/paths/meta.pcert0 : no_pcert = 0
-coi/paths/meta.pcert0 : acl2x = 0
-coi/paths/meta.pcert0 : \
-     coi/lists/basic.pcert0 \
-     coi/lists/map-cons.pcert0 \
-     coi/syntax/syntax.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/paths/path.pcert0 \
-     coi/paths/meta.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/meta.pcert1 : acl2x = 0
-coi/paths/meta.pcert1 : no_pcert = 0
-coi/paths/meta.pcert1 : coi/paths/meta.pcert0
-coi/paths/meta.cert : | coi/paths/meta.pcert1
-
-coi/paths/path.pcert0 : no_pcert = 0
-coi/paths/path.pcert0 : acl2x = 0
-coi/paths/path.pcert0 : \
-     coi/lists/repeat.pcert0 \
-     coi/bags/top.pcert0 \
-     coi/alists/top.pcert0 \
-     coi/records/records.pcert0 \
-     coi/records/domain.pcert0 \
-     coi/paths/compatibility.pcert0 \
-     coi/paths/dominates.pcert0 \
-     coi/paths/diverge.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/util/syntaxp.pcert0 \
-     coi/paths/path.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/path.pcert1 : acl2x = 0
-coi/paths/path.pcert1 : no_pcert = 0
-coi/paths/path.pcert1 : coi/paths/path.pcert0
-coi/paths/path.cert : | coi/paths/path.pcert1
-
-coi/paths/pm.pcert0 : no_pcert = 0
-coi/paths/pm.pcert0 : acl2x = 0
-coi/paths/pm.pcert0 : \
-     coi/paths/meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/paths/equiv.pcert0 \
-     coi/paths/pm.lisp \
-     coi/paths/cert.acl2 \
-     coi/paths/path-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp
-coi/paths/pm.pcert1 : acl2x = 0
-coi/paths/pm.pcert1 : no_pcert = 0
-coi/paths/pm.pcert1 : coi/paths/pm.pcert0
-coi/paths/pm.cert : | coi/paths/pm.pcert1
-
-coi/quantification/quantification.pcert0 : no_pcert = 0
-coi/quantification/quantification.pcert0 : acl2x = 0
-coi/quantification/quantification.pcert0 : \
-     misc/records.pcert0 \
-     misc/bash.pcert0 \
-     coi/generalize/generalize.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/util/table.pcert0 \
-     coi/util/skip-rewrite.pcert0 \
-     coi/util/in-conclusion.pcert0 \
-     coi/quantification/quantification.lisp \
-     coi/quantification/quantification.acl2 \
-     coi/quantification/cert.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/util/table-defpkg.lsp \
-     coi/quantification/quant-defpkg.lsp
-coi/quantification/quantification.pcert1 : acl2x = 0
-coi/quantification/quantification.pcert1 : no_pcert = 0
-coi/quantification/quantification.pcert1 : coi/quantification/quantification.pcert0
-coi/quantification/quantification.cert : | coi/quantification/quantification.pcert1
-
-coi/records/defarray.pcert0 : no_pcert = 0
-coi/records/defarray.pcert0 : acl2x = 0
-coi/records/defarray.pcert0 : \
-     coi/records/records.pcert0 \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/records/defarray.lisp \
-     coi/records/defarray.acl2 \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp
-coi/records/defarray.pcert1 : acl2x = 0
-coi/records/defarray.pcert1 : no_pcert = 0
-coi/records/defarray.pcert1 : coi/records/defarray.pcert0
-coi/records/defarray.cert : | coi/records/defarray.pcert1
-
-coi/records/defrecord-fast.pcert0 : no_pcert = 0
-coi/records/defrecord-fast.pcert0 : acl2x = 0
-coi/records/defrecord-fast.pcert0 : \
-     coi/records/memory.pcert0 \
-     coi/records/records.pcert0 \
-     data-structures/memories/memory.pcert0 \
-     coi/records/defrecord-fast.lisp \
-     coi/records/defrecord-fast.acl2 \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp \
-     data-structures/memories/package.lsp
-coi/records/defrecord-fast.pcert1 : acl2x = 0
-coi/records/defrecord-fast.pcert1 : no_pcert = 0
-coi/records/defrecord-fast.pcert1 : coi/records/defrecord-fast.pcert0
-coi/records/defrecord-fast.cert : | coi/records/defrecord-fast.pcert1
-
-coi/records/defrecord.pcert0 : no_pcert = 0
-coi/records/defrecord.pcert0 : acl2x = 0
-coi/records/defrecord.pcert0 : \
-     coi/records/records.pcert0 \
-     coi/records/defrecord.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-coi/records/defrecord.pcert1 : acl2x = 0
-coi/records/defrecord.pcert1 : no_pcert = 0
-coi/records/defrecord.pcert1 : coi/records/defrecord.pcert0
-coi/records/defrecord.cert : | coi/records/defrecord.pcert1
-
-coi/records/domain.pcert0 : no_pcert = 0
-coi/records/domain.pcert0 : acl2x = 0
-coi/records/domain.pcert0 : \
-     coi/alists/keyquiv.pcert0 \
-     coi/records/records.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/bags/pick-a-point.pcert0 \
-     coi/records/records.pcert0 \
-     coi/records/domain.lisp \
-     coi/records/domain.acl2 \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/adviser/adviser-defpkg.lsp
-coi/records/domain.pcert1 : acl2x = 0
-coi/records/domain.pcert1 : no_pcert = 0
-coi/records/domain.pcert1 : coi/records/domain.pcert0
-coi/records/domain.cert : | coi/records/domain.pcert1
-
-coi/records/fixedpoint.pcert0 : no_pcert = 0
-coi/records/fixedpoint.pcert0 : acl2x = 0
-coi/records/fixedpoint.pcert0 : \
-     coi/records/domain.pcert0 \
-     coi/util/rule-sets.pcert0 \
-     coi/records/domain.pcert0 \
-     coi/records/fixedpoint.lisp \
-     coi/records/fixedpoint.acl2 \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp
-coi/records/fixedpoint.pcert1 : acl2x = 0
-coi/records/fixedpoint.pcert1 : no_pcert = 0
-coi/records/fixedpoint.pcert1 : coi/records/fixedpoint.pcert0
-coi/records/fixedpoint.cert : | coi/records/fixedpoint.pcert1
-
-coi/records/mem-domain.pcert0 : no_pcert = 0
-coi/records/mem-domain.pcert0 : acl2x = 0
-coi/records/mem-domain.pcert0 : \
-     coi/records/memory.pcert0 \
-     coi/records/domain.pcert0 \
-     coi/osets/conversions.pcert0 \
-     coi/osets/extras.pcert0 \
-     coi/osets/map.pcert0 \
-     coi/bags/basic.pcert0 \
-     coi/util/iff.pcert0 \
-     coi/osets/set-processor.pcert0 \
-     data-structures/memories/log2.pcert0 \
-     coi/records/set-domain.pcert0 \
-     data-structures/memories/memory-impl.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     coi/records/mem-domain.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-coi/records/mem-domain.pcert1 : acl2x = 0
-coi/records/mem-domain.pcert1 : no_pcert = 0
-coi/records/mem-domain.pcert1 : coi/records/mem-domain.pcert0
-coi/records/mem-domain.cert : | coi/records/mem-domain.pcert1
-
-coi/records/memory.pcert0 : no_pcert = 0
-coi/records/memory.pcert0 : acl2x = 0
-coi/records/memory.pcert0 : \
-     data-structures/memories/memory.pcert0 \
-     coi/records/memory.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-coi/records/memory.pcert1 : acl2x = 0
-coi/records/memory.pcert1 : no_pcert = 0
-coi/records/memory.pcert1 : coi/records/memory.pcert0
-coi/records/memory.cert : | coi/records/memory.pcert1
-
-coi/records/record-exports.pcert0 : no_pcert = 0
-coi/records/record-exports.pcert0 : acl2x = 0
-coi/records/record-exports.pcert0 : \
-     coi/records/record-exports.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-coi/records/record-exports.pcert1 : acl2x = 0
-coi/records/record-exports.pcert1 : no_pcert = 0
-coi/records/record-exports.pcert1 : coi/records/record-exports.pcert0
-coi/records/record-exports.cert : | coi/records/record-exports.pcert1
-
-coi/records/records.pcert0 : no_pcert = 0
-coi/records/records.pcert0 : acl2x = 0
-coi/records/records.pcert0 : \
-     coi/lists/basic.pcert0 \
-     misc/records.pcert0 \
-     coi/records/records.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-coi/records/records.pcert1 : acl2x = 0
-coi/records/records.pcert1 : no_pcert = 0
-coi/records/records.pcert1 : coi/records/records.pcert0
-coi/records/records.cert : | coi/records/records.pcert1
-
-coi/records/set-domain.pcert0 : no_pcert = 0
-coi/records/set-domain.pcert0 : acl2x = 0
-coi/records/set-domain.pcert0 : \
-     coi/records/domain.pcert0 \
-     coi/osets/sets.pcert0 \
-     coi/osets/extras.pcert0 \
-     coi/records/records.pcert0 \
-     coi/osets/sets.pcert0 \
-     coi/osets/map.pcert0 \
-     coi/osets/extras.pcert0 \
-     coi/records/set-domain.lisp \
-     coi/records/cert.acl2 \
-     coi/records/rec-defpkg.lsp \
-     coi/records/record-exports.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/osets/set-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/osets/computed-hints-defpkg.lsp \
-     coi/osets/instance-defpkg.lsp \
-     coi/bags/bag-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/util/util-exports.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/lists/list-defpkg.lsp \
-     data-structures/memories/package.lsp
-coi/records/set-domain.pcert1 : acl2x = 0
-coi/records/set-domain.pcert1 : no_pcert = 0
-coi/records/set-domain.pcert1 : coi/records/set-domain.pcert0
-coi/records/set-domain.cert : | coi/records/set-domain.pcert1
-
-coi/super-ihs/arithmetic.pcert0 : no_pcert = 0
-coi/super-ihs/arithmetic.pcert0 : acl2x = 0
-coi/super-ihs/arithmetic.pcert0 : \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     coi/super-ihs/eric.pcert0 \
-     coi/super-ihs/from-rtl.pcert0 \
-     rtl/rel4/arithmetic/floor.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     coi/super-ihs/arithmetic.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/arithmetic.pcert1 : acl2x = 0
-coi/super-ihs/arithmetic.pcert1 : no_pcert = 0
-coi/super-ihs/arithmetic.pcert1 : coi/super-ihs/arithmetic.pcert0
-coi/super-ihs/arithmetic.cert : | coi/super-ihs/arithmetic.pcert1
-
-coi/super-ihs/ash.pcert0 : no_pcert = 0
-coi/super-ihs/ash.pcert0 : acl2x = 0
-coi/super-ihs/ash.pcert0 : \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/evenp.pcert0 \
-     coi/super-ihs/ash.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/ash.pcert1 : acl2x = 0
-coi/super-ihs/ash.pcert1 : no_pcert = 0
-coi/super-ihs/ash.pcert1 : coi/super-ihs/ash.pcert0
-coi/super-ihs/ash.cert : | coi/super-ihs/ash.pcert1
-
-coi/super-ihs/basics.pcert0 : no_pcert = 0
-coi/super-ihs/basics.pcert0 : acl2x = 0
-coi/super-ihs/basics.pcert0 : \
-     coi/super-ihs/inductions.pcert0 \
-     coi/super-ihs/evenp.pcert0 \
-     coi/super-ihs/bit-functions.pcert0 \
-     coi/super-ihs/from-rtl.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/loghead.pcert0 \
-     coi/super-ihs/logext.pcert0 \
-     coi/super-ihs/logcar.pcert0 \
-     coi/super-ihs/ash.pcert0 \
-     coi/super-ihs/basics.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/basics.pcert1 : acl2x = 0
-coi/super-ihs/basics.pcert1 : no_pcert = 0
-coi/super-ihs/basics.pcert1 : coi/super-ihs/basics.pcert0
-coi/super-ihs/basics.cert : | coi/super-ihs/basics.pcert1
-
-coi/super-ihs/bit-functions.pcert0 : no_pcert = 0
-coi/super-ihs/bit-functions.pcert0 : acl2x = 0
-coi/super-ihs/bit-functions.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/bit-functions.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/bit-functions.pcert1 : acl2x = 0
-coi/super-ihs/bit-functions.pcert1 : no_pcert = 0
-coi/super-ihs/bit-functions.pcert1 : coi/super-ihs/bit-functions.pcert0
-coi/super-ihs/bit-functions.cert : | coi/super-ihs/bit-functions.pcert1
-
-coi/super-ihs/bit-twiddling-logops.pcert0 : no_pcert = 0
-coi/super-ihs/bit-twiddling-logops.pcert0 : acl2x = 0
-coi/super-ihs/bit-twiddling-logops.pcert0 : \
-     coi/super-ihs/logical-logops.pcert0 \
-     coi/super-ihs/bit-twiddling-logops.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/bit-twiddling-logops.pcert1 : acl2x = 0
-coi/super-ihs/bit-twiddling-logops.pcert1 : no_pcert = 0
-coi/super-ihs/bit-twiddling-logops.pcert1 : coi/super-ihs/bit-twiddling-logops.pcert0
-coi/super-ihs/bit-twiddling-logops.cert : | coi/super-ihs/bit-twiddling-logops.pcert1
-
-coi/super-ihs/byte-p.pcert0 : no_pcert = 0
-coi/super-ihs/byte-p.pcert0 : acl2x = 0
-coi/super-ihs/byte-p.pcert0 : \
-     coi/super-ihs/logpair.pcert0 \
-     coi/super-ihs/byte-p.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/byte-p.pcert1 : acl2x = 0
-coi/super-ihs/byte-p.pcert1 : no_pcert = 0
-coi/super-ihs/byte-p.pcert1 : coi/super-ihs/byte-p.pcert0
-coi/super-ihs/byte-p.cert : | coi/super-ihs/byte-p.pcert1
-
-coi/super-ihs/c-functions.pcert0 : no_pcert = 0
-coi/super-ihs/c-functions.pcert0 : acl2x = 0
-coi/super-ihs/c-functions.pcert0 : \
-     coi/super-ihs/hacks.pcert0 \
-     coi/super-ihs/c-functions.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/c-functions.pcert1 : acl2x = 0
-coi/super-ihs/c-functions.pcert1 : no_pcert = 0
-coi/super-ihs/c-functions.pcert1 : coi/super-ihs/c-functions.pcert0
-coi/super-ihs/c-functions.cert : | coi/super-ihs/c-functions.pcert1
-
-coi/super-ihs/carry.pcert0 : no_pcert = 0
-coi/super-ihs/carry.pcert0 : acl2x = 0
-coi/super-ihs/carry.pcert0 : \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/super-ihs/carry.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/carry.pcert1 : acl2x = 0
-coi/super-ihs/carry.pcert1 : no_pcert = 0
-coi/super-ihs/carry.pcert1 : coi/super-ihs/carry.pcert0
-coi/super-ihs/carry.cert : | coi/super-ihs/carry.pcert1
-
-coi/super-ihs/eric.pcert0 : no_pcert = 0
-coi/super-ihs/eric.pcert0 : acl2x = 0
-coi/super-ihs/eric.pcert0 : \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     coi/super-ihs/eric.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/eric.pcert1 : acl2x = 0
-coi/super-ihs/eric.pcert1 : no_pcert = 0
-coi/super-ihs/eric.pcert1 : coi/super-ihs/eric.pcert0
-coi/super-ihs/eric.cert : | coi/super-ihs/eric.pcert1
-
-coi/super-ihs/evenp.pcert0 : no_pcert = 0
-coi/super-ihs/evenp.pcert0 : acl2x = 0
-coi/super-ihs/evenp.pcert0 : \
-     coi/super-ihs/arithmetic.pcert0 \
-     rtl/rel4/arithmetic/even-odd.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     coi/super-ihs/evenp.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/evenp.pcert1 : acl2x = 0
-coi/super-ihs/evenp.pcert1 : no_pcert = 0
-coi/super-ihs/evenp.pcert1 : coi/super-ihs/evenp.pcert0
-coi/super-ihs/evenp.cert : | coi/super-ihs/evenp.pcert1
-
-coi/super-ihs/fast.pcert0 : no_pcert = 0
-coi/super-ihs/fast.pcert0 : acl2x = 0
-coi/super-ihs/fast.pcert0 : \
-     coi/super-ihs/super-ihs.pcert0 \
-     coi/super-ihs/fast.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/fast.pcert1 : acl2x = 0
-coi/super-ihs/fast.pcert1 : no_pcert = 0
-coi/super-ihs/fast.pcert1 : coi/super-ihs/fast.pcert0
-coi/super-ihs/fast.cert : | coi/super-ihs/fast.pcert1
-
-coi/super-ihs/from-rtl.pcert0 : no_pcert = 0
-coi/super-ihs/from-rtl.pcert0 : acl2x = 0
-coi/super-ihs/from-rtl.pcert0 : \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/logxor.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     coi/super-ihs/from-rtl.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/from-rtl.pcert1 : acl2x = 0
-coi/super-ihs/from-rtl.pcert1 : no_pcert = 0
-coi/super-ihs/from-rtl.pcert1 : coi/super-ihs/from-rtl.pcert0
-coi/super-ihs/from-rtl.cert : | coi/super-ihs/from-rtl.pcert1
-
-coi/super-ihs/hacks.pcert0 : no_pcert = 0
-coi/super-ihs/hacks.pcert0 : acl2x = 0
-coi/super-ihs/hacks.pcert0 : \
-     coi/super-ihs/bit-twiddling-logops.pcert0 \
-     coi/super-ihs/eric.pcert0 \
-     coi/super-ihs/hacks.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/hacks.pcert1 : acl2x = 0
-coi/super-ihs/hacks.pcert1 : no_pcert = 0
-coi/super-ihs/hacks.pcert1 : coi/super-ihs/hacks.pcert0
-coi/super-ihs/hacks.cert : | coi/super-ihs/hacks.pcert1
-
-coi/super-ihs/inductions.pcert0 : no_pcert = 0
-coi/super-ihs/inductions.pcert0 : acl2x = 0
-coi/super-ihs/inductions.pcert0 : \
-     coi/super-ihs/arithmetic.pcert0 \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/inductions.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/inductions.pcert1 : acl2x = 0
-coi/super-ihs/inductions.pcert1 : no_pcert = 0
-coi/super-ihs/inductions.pcert1 : coi/super-ihs/inductions.pcert0
-coi/super-ihs/inductions.cert : | coi/super-ihs/inductions.pcert1
-
-coi/super-ihs/iter-sqrt.pcert0 : no_pcert = 0
-coi/super-ihs/iter-sqrt.pcert0 : acl2x = 0
-coi/super-ihs/iter-sqrt.pcert0 : \
-     coi/super-ihs/arithmetic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/super-ihs/iter-sqrt.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/iter-sqrt.pcert1 : acl2x = 0
-coi/super-ihs/iter-sqrt.pcert1 : no_pcert = 0
-coi/super-ihs/iter-sqrt.pcert1 : coi/super-ihs/iter-sqrt.pcert0
-coi/super-ihs/iter-sqrt.cert : | coi/super-ihs/iter-sqrt.pcert1
-
-coi/super-ihs/logapp.pcert0 : no_pcert = 0
-coi/super-ihs/logapp.pcert0 : acl2x = 0
-coi/super-ihs/logapp.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/logapp.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logapp.pcert1 : acl2x = 0
-coi/super-ihs/logapp.pcert1 : no_pcert = 0
-coi/super-ihs/logapp.pcert1 : coi/super-ihs/logapp.pcert0
-coi/super-ihs/logapp.cert : | coi/super-ihs/logapp.pcert1
-
-coi/super-ihs/logbit.pcert0 : no_pcert = 0
-coi/super-ihs/logbit.pcert0 : acl2x = 0
-coi/super-ihs/logbit.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/logbit.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logbit.pcert1 : acl2x = 0
-coi/super-ihs/logbit.pcert1 : no_pcert = 0
-coi/super-ihs/logbit.pcert1 : coi/super-ihs/logbit.pcert0
-coi/super-ihs/logbit.cert : | coi/super-ihs/logbit.pcert1
-
-coi/super-ihs/logbitp.pcert0 : no_pcert = 0
-coi/super-ihs/logbitp.pcert0 : acl2x = 0
-coi/super-ihs/logbitp.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/logbitp.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logbitp.pcert1 : acl2x = 0
-coi/super-ihs/logbitp.pcert1 : no_pcert = 0
-coi/super-ihs/logbitp.pcert1 : coi/super-ihs/logbitp.pcert0
-coi/super-ihs/logbitp.cert : | coi/super-ihs/logbitp.pcert1
-
-coi/super-ihs/logcar.pcert0 : no_pcert = 0
-coi/super-ihs/logcar.pcert0 : acl2x = 0
-coi/super-ihs/logcar.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/evenp.pcert0 \
-     coi/super-ihs/logcar.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logcar.pcert1 : acl2x = 0
-coi/super-ihs/logcar.pcert1 : no_pcert = 0
-coi/super-ihs/logcar.pcert1 : coi/super-ihs/logcar.pcert0
-coi/super-ihs/logcar.cert : | coi/super-ihs/logcar.pcert1
-
-coi/super-ihs/logcdr.pcert0 : no_pcert = 0
-coi/super-ihs/logcdr.pcert0 : acl2x = 0
-coi/super-ihs/logcdr.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/evenp.pcert0 \
-     coi/super-ihs/unsigned-byte-p.pcert0 \
-     coi/super-ihs/ash.pcert0 \
-     coi/super-ihs/logcdr.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logcdr.pcert1 : acl2x = 0
-coi/super-ihs/logcdr.pcert1 : no_pcert = 0
-coi/super-ihs/logcdr.pcert1 : coi/super-ihs/logcdr.pcert0
-coi/super-ihs/logcdr.cert : | coi/super-ihs/logcdr.pcert1
-
-coi/super-ihs/logcons.pcert0 : no_pcert = 0
-coi/super-ihs/logcons.pcert0 : acl2x = 0
-coi/super-ihs/logcons.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/evenp.pcert0 \
-     coi/super-ihs/logcons.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logcons.pcert1 : acl2x = 0
-coi/super-ihs/logcons.pcert1 : no_pcert = 0
-coi/super-ihs/logcons.pcert1 : coi/super-ihs/logcons.pcert0
-coi/super-ihs/logcons.cert : | coi/super-ihs/logcons.pcert1
-
-coi/super-ihs/logext.pcert0 : no_pcert = 0
-coi/super-ihs/logext.pcert0 : acl2x = 0
-coi/super-ihs/logext.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/logbitp.pcert0 \
-     coi/super-ihs/logapp.pcert0 \
-     coi/super-ihs/loghead.pcert0 \
-     coi/super-ihs/logext.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logext.pcert1 : acl2x = 0
-coi/super-ihs/logext.pcert1 : no_pcert = 0
-coi/super-ihs/logext.pcert1 : coi/super-ihs/logext.pcert0
-coi/super-ihs/logext.cert : | coi/super-ihs/logext.pcert1
-
-coi/super-ihs/loghead.pcert0 : no_pcert = 0
-coi/super-ihs/loghead.pcert0 : acl2x = 0
-coi/super-ihs/loghead.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/ash.pcert0 \
-     coi/super-ihs/unsigned-byte-p.pcert0 \
-     coi/super-ihs/logcar.pcert0 \
-     coi/super-ihs/logcdr.pcert0 \
-     coi/super-ihs/logcons.pcert0 \
-     coi/super-ihs/inductions.pcert0 \
-     coi/util/syntaxp.pcert0 \
-     coi/super-ihs/loghead.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/loghead.pcert1 : acl2x = 0
-coi/super-ihs/loghead.pcert1 : no_pcert = 0
-coi/super-ihs/loghead.pcert1 : coi/super-ihs/loghead.pcert0
-coi/super-ihs/loghead.cert : | coi/super-ihs/loghead.pcert1
-
-coi/super-ihs/logical-logops.pcert0 : no_pcert = 0
-coi/super-ihs/logical-logops.pcert0 : acl2x = 0
-coi/super-ihs/logical-logops.pcert0 : \
-     coi/super-ihs/loglist.pcert0 \
-     coi/super-ihs/logext.pcert0 \
-     coi/super-ihs/logical-logops.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logical-logops.pcert1 : acl2x = 0
-coi/super-ihs/logical-logops.pcert1 : no_pcert = 0
-coi/super-ihs/logical-logops.pcert1 : coi/super-ihs/logical-logops.pcert0
-coi/super-ihs/logical-logops.cert : | coi/super-ihs/logical-logops.pcert1
-
-coi/super-ihs/logior-logapp-crock.pcert0 : no_pcert = 0
-coi/super-ihs/logior-logapp-crock.pcert0 : acl2x = 0
-coi/super-ihs/logior-logapp-crock.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     coi/super-ihs/logior-logapp-crock.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logior-logapp-crock.pcert1 : acl2x = 0
-coi/super-ihs/logior-logapp-crock.pcert1 : no_pcert = 0
-coi/super-ihs/logior-logapp-crock.pcert1 : coi/super-ihs/logior-logapp-crock.pcert0
-coi/super-ihs/logior-logapp-crock.cert : | coi/super-ihs/logior-logapp-crock.pcert1
-
-coi/super-ihs/loglist.pcert0 : no_pcert = 0
-coi/super-ihs/loglist.pcert0 : acl2x = 0
-coi/super-ihs/loglist.pcert0 : \
-     coi/super-ihs/byte-p.pcert0 \
-     coi/super-ihs/logapp.pcert0 \
-     coi/super-ihs/loglist.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/loglist.pcert1 : acl2x = 0
-coi/super-ihs/loglist.pcert1 : no_pcert = 0
-coi/super-ihs/loglist.pcert1 : coi/super-ihs/loglist.pcert0
-coi/super-ihs/loglist.cert : | coi/super-ihs/loglist.pcert1
-
-coi/super-ihs/logpair.pcert0 : no_pcert = 0
-coi/super-ihs/logpair.pcert0 : acl2x = 0
-coi/super-ihs/logpair.pcert0 : \
-     coi/super-ihs/basics.pcert0 \
-     coi/super-ihs/loghead.pcert0 \
-     coi/super-ihs/logtail.pcert0 \
-     coi/super-ihs/logcons.pcert0 \
-     coi/super-ihs/logcdr.pcert0 \
-     coi/super-ihs/logtail.pcert0 \
-     coi/super-ihs/logbitp.pcert0 \
-     coi/super-ihs/logbit.pcert0 \
-     coi/super-ihs/unsigned-byte-p.pcert0 \
-     coi/super-ihs/logpair.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logpair.pcert1 : acl2x = 0
-coi/super-ihs/logpair.pcert1 : no_pcert = 0
-coi/super-ihs/logpair.pcert1 : coi/super-ihs/logpair.pcert0
-coi/super-ihs/logpair.cert : | coi/super-ihs/logpair.pcert1
-
-coi/super-ihs/logtail.pcert0 : no_pcert = 0
-coi/super-ihs/logtail.pcert0 : acl2x = 0
-coi/super-ihs/logtail.pcert0 : \
-     coi/super-ihs/arithmetic.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/ash.pcert0 \
-     coi/super-ihs/logtail.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/logtail.pcert1 : acl2x = 0
-coi/super-ihs/logtail.pcert1 : no_pcert = 0
-coi/super-ihs/logtail.pcert1 : coi/super-ihs/logtail.pcert0
-coi/super-ihs/logtail.cert : | coi/super-ihs/logtail.pcert1
-
-coi/super-ihs/lshu.pcert0 : no_pcert = 0
-coi/super-ihs/lshu.pcert0 : acl2x = 0
-coi/super-ihs/lshu.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/hacks.pcert0 \
-     coi/super-ihs/lshu.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/lshu.pcert1 : acl2x = 0
-coi/super-ihs/lshu.pcert1 : no_pcert = 0
-coi/super-ihs/lshu.pcert1 : coi/super-ihs/lshu.pcert0
-coi/super-ihs/lshu.cert : | coi/super-ihs/lshu.pcert1
-
-coi/super-ihs/meta.pcert0 : no_pcert = 0
-coi/super-ihs/meta.pcert0 : acl2x = 0
-coi/super-ihs/meta.pcert0 : \
-     coi/super-ihs/loghead.pcert0 \
-     coi/super-ihs/arithmetic.pcert0 \
-     coi/super-ihs/meta.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/meta.pcert1 : acl2x = 0
-coi/super-ihs/meta.pcert1 : no_pcert = 0
-coi/super-ihs/meta.pcert1 : coi/super-ihs/meta.pcert0
-coi/super-ihs/meta.cert : | coi/super-ihs/meta.pcert1
-
-coi/super-ihs/min-max.pcert0 : no_pcert = 0
-coi/super-ihs/min-max.pcert0 : acl2x = 0
-coi/super-ihs/min-max.pcert0 : \
-     coi/super-ihs/min-max.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/min-max.pcert1 : acl2x = 0
-coi/super-ihs/min-max.pcert1 : no_pcert = 0
-coi/super-ihs/min-max.pcert1 : coi/super-ihs/min-max.pcert0
-coi/super-ihs/min-max.cert : | coi/super-ihs/min-max.pcert1
-
-coi/super-ihs/plus-logapp-suck.pcert0 : no_pcert = 0
-coi/super-ihs/plus-logapp-suck.pcert0 : acl2x = 0
-coi/super-ihs/plus-logapp-suck.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/plus-logapp-suck.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/plus-logapp-suck.pcert1 : acl2x = 0
-coi/super-ihs/plus-logapp-suck.pcert1 : no_pcert = 0
-coi/super-ihs/plus-logapp-suck.pcert1 : coi/super-ihs/plus-logapp-suck.pcert0
-coi/super-ihs/plus-logapp-suck.cert : | coi/super-ihs/plus-logapp-suck.pcert1
-
-coi/super-ihs/signed-byte-p-overflow.pcert0 : no_pcert = 0
-coi/super-ihs/signed-byte-p-overflow.pcert0 : acl2x = 0
-coi/super-ihs/signed-byte-p-overflow.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/signed-byte-p-overflow.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/signed-byte-p-overflow.pcert1 : acl2x = 0
-coi/super-ihs/signed-byte-p-overflow.pcert1 : no_pcert = 0
-coi/super-ihs/signed-byte-p-overflow.pcert1 : coi/super-ihs/signed-byte-p-overflow.pcert0
-coi/super-ihs/signed-byte-p-overflow.cert : | coi/super-ihs/signed-byte-p-overflow.pcert1
-
-coi/super-ihs/super-ihs.pcert0 : no_pcert = 0
-coi/super-ihs/super-ihs.pcert0 : acl2x = 0
-coi/super-ihs/super-ihs.pcert0 : \
-     coi/super-ihs/hacks.pcert0 \
-     coi/super-ihs/eric.pcert0 \
-     coi/super-ihs/c-functions.pcert0 \
-     coi/super-ihs/lshu.pcert0 \
-     coi/super-ihs/min-max.pcert0 \
-     coi/super-ihs/meta.pcert0 \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/super-ihs/super-ihs.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/super-ihs.pcert1 : acl2x = 0
-coi/super-ihs/super-ihs.pcert1 : no_pcert = 0
-coi/super-ihs/super-ihs.pcert1 : coi/super-ihs/super-ihs.pcert0
-coi/super-ihs/super-ihs.cert : | coi/super-ihs/super-ihs.pcert1
-
-coi/super-ihs/unsigned-byte-p.pcert0 : no_pcert = 0
-coi/super-ihs/unsigned-byte-p.pcert0 : acl2x = 0
-coi/super-ihs/unsigned-byte-p.pcert0 : \
-     coi/super-ihs/arithmetic.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     coi/super-ihs/eric.pcert0 \
-     coi/super-ihs/unsigned-byte-p.lisp \
-     coi/super-ihs/cert.acl2
-coi/super-ihs/unsigned-byte-p.pcert1 : acl2x = 0
-coi/super-ihs/unsigned-byte-p.pcert1 : no_pcert = 0
-coi/super-ihs/unsigned-byte-p.pcert1 : coi/super-ihs/unsigned-byte-p.pcert0
-coi/super-ihs/unsigned-byte-p.cert : | coi/super-ihs/unsigned-byte-p.pcert1
-
-coi/symbol-fns/symbol-fns-exports.pcert0 : no_pcert = 0
-coi/symbol-fns/symbol-fns-exports.pcert0 : acl2x = 0
-coi/symbol-fns/symbol-fns-exports.pcert0 : \
-     coi/symbol-fns/symbol-fns-exports.lisp \
-     coi/symbol-fns/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/symbol-fns/symbol-fns-exports.pcert1 : acl2x = 0
-coi/symbol-fns/symbol-fns-exports.pcert1 : no_pcert = 0
-coi/symbol-fns/symbol-fns-exports.pcert1 : coi/symbol-fns/symbol-fns-exports.pcert0
-coi/symbol-fns/symbol-fns-exports.cert : | coi/symbol-fns/symbol-fns-exports.pcert1
-
-coi/symbol-fns/symbol-fns.pcert0 : no_pcert = 0
-coi/symbol-fns/symbol-fns.pcert0 : acl2x = 0
-coi/symbol-fns/symbol-fns.pcert0 : \
-     coi/symbol-fns/symbol-fns.lisp \
-     coi/symbol-fns/cert.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/symbol-fns/symbol-fns.pcert1 : acl2x = 0
-coi/symbol-fns/symbol-fns.pcert1 : no_pcert = 0
-coi/symbol-fns/symbol-fns.pcert1 : coi/symbol-fns/symbol-fns.pcert0
-coi/symbol-fns/symbol-fns.cert : | coi/symbol-fns/symbol-fns.pcert1
-
-coi/syntax/auxilary.pcert0 : no_pcert = 0
-coi/syntax/auxilary.pcert0 : acl2x = 0
-coi/syntax/auxilary.pcert0 : \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/syntax/auxilary.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/syntax/auxilary.pcert1 : acl2x = 0
-coi/syntax/auxilary.pcert1 : no_pcert = 0
-coi/syntax/auxilary.pcert1 : coi/syntax/auxilary.pcert0
-coi/syntax/auxilary.cert : | coi/syntax/auxilary.pcert1
-
-coi/syntax/defbinding.pcert0 : no_pcert = 0
-coi/syntax/defbinding.pcert0 : acl2x = 0
-coi/syntax/defbinding.pcert0 : \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/syntax/defbinding.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/syntax/defbinding.pcert1 : acl2x = 0
-coi/syntax/defbinding.pcert1 : no_pcert = 0
-coi/syntax/defbinding.pcert1 : coi/syntax/defbinding.pcert0
-coi/syntax/defbinding.cert : | coi/syntax/defbinding.pcert1
-
-coi/syntax/defevaluator.pcert0 : no_pcert = 0
-coi/syntax/defevaluator.pcert0 : acl2x = 0
-coi/syntax/defevaluator.pcert0 : \
-     coi/syntax/defevaluator.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/syntax/defevaluator.pcert1 : acl2x = 0
-coi/syntax/defevaluator.pcert1 : no_pcert = 0
-coi/syntax/defevaluator.pcert1 : coi/syntax/defevaluator.pcert0
-coi/syntax/defevaluator.cert : | coi/syntax/defevaluator.pcert1
-
-coi/syntax/quine.pcert0 : no_pcert = 0
-coi/syntax/quine.pcert0 : acl2x = 0
-coi/syntax/quine.pcert0 : \
-     coi/syntax/syntax.pcert0 \
-     coi/syntax/quine.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/syntax/quine.pcert1 : acl2x = 0
-coi/syntax/quine.pcert1 : no_pcert = 0
-coi/syntax/quine.pcert1 : coi/syntax/quine.pcert0
-coi/syntax/quine.cert : | coi/syntax/quine.pcert1
-
-coi/syntax/syn-pkg.pcert0 : no_pcert = 0
-coi/syntax/syn-pkg.pcert0 : acl2x = 0
-coi/syntax/syn-pkg.pcert0 : \
-     coi/syntax/syn-pkg.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/syntax/syn-pkg.pcert1 : acl2x = 0
-coi/syntax/syn-pkg.pcert1 : no_pcert = 0
-coi/syntax/syn-pkg.pcert1 : coi/syntax/syn-pkg.pcert0
-coi/syntax/syn-pkg.cert : | coi/syntax/syn-pkg.pcert1
-
-coi/syntax/syntax-extensions.pcert0 : no_pcert = 0
-coi/syntax/syntax-extensions.pcert0 : acl2x = 0
-coi/syntax/syntax-extensions.pcert0 : \
-     coi/syntax/auxilary.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/syntax/syntax-extensions.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/syntax/syntax-extensions.pcert1 : acl2x = 0
-coi/syntax/syntax-extensions.pcert1 : no_pcert = 0
-coi/syntax/syntax-extensions.pcert1 : coi/syntax/syntax-extensions.pcert0
-coi/syntax/syntax-extensions.cert : | coi/syntax/syntax-extensions.pcert1
-
-coi/syntax/syntax.pcert0 : no_pcert = 0
-coi/syntax/syntax.pcert0 : acl2x = 0
-coi/syntax/syntax.pcert0 : \
-     coi/syntax/syntax-extensions.pcert0 \
-     coi/syntax/defevaluator.pcert0 \
-     coi/syntax/syntax.lisp \
-     coi/syntax/cert.acl2 \
-     coi/syntax/syn-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/syntax/syntax.pcert1 : acl2x = 0
-coi/syntax/syntax.pcert1 : no_pcert = 0
-coi/syntax/syntax.pcert1 : coi/syntax/syntax.pcert0
-coi/syntax/syntax.cert : | coi/syntax/syntax.pcert1
-
-coi/termination/assuming/compiler-proof.pcert0 : no_pcert = 0
-coi/termination/assuming/compiler-proof.pcert0 : acl2x = 0
-coi/termination/assuming/compiler-proof.pcert0 : \
-     coi/defpun/defminterm.pcert0 \
-     coi/defpun/ack.pcert0 \
-     coi/nary/nary.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/termination/assuming/compiler-proof.lisp \
-     coi/termination/assuming/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/util/def-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-coi/termination/assuming/compiler-proof.pcert1 : acl2x = 0
-coi/termination/assuming/compiler-proof.pcert1 : no_pcert = 0
-coi/termination/assuming/compiler-proof.pcert1 : coi/termination/assuming/compiler-proof.pcert0
-coi/termination/assuming/compiler-proof.cert : | coi/termination/assuming/compiler-proof.pcert1
-
-coi/termination/assuming/compiler.pcert0 : no_pcert = 0
-coi/termination/assuming/compiler.pcert0 : acl2x = 0
-coi/termination/assuming/compiler.pcert0 : \
-     coi/syntax/syntax.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/termination/assuming/compiler-proof.pcert0 \
-     make-event/eval.pcert0 \
-     coi/util/pseudo-translate.pcert0 \
-     coi/util/recursion-support.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     coi/termination/assuming/compiler.lisp \
-     coi/termination/assuming/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/util/def-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-coi/termination/assuming/compiler.pcert1 : acl2x = 0
-coi/termination/assuming/compiler.pcert1 : no_pcert = 0
-coi/termination/assuming/compiler.pcert1 : coi/termination/assuming/compiler.pcert0
-coi/termination/assuming/compiler.cert : | coi/termination/assuming/compiler.pcert1
-
-coi/termination/assuming/zero.pcert0 : no_pcert = 0
-coi/termination/assuming/zero.pcert0 : acl2x = 0
-coi/termination/assuming/zero.pcert0 : \
-     coi/termination/assuming/compiler.pcert0 \
-     ordinals/lexicographic-ordering.pcert0 \
-     coi/termination/assuming/zero.lisp \
-     coi/termination/assuming/cert.acl2 \
-     coi/alists/alist-defpkg.lsp \
-     coi/lists/list-exports.lsp \
-     coi/lists/list-defpkg.lsp \
-     coi/syntax/syn-defpkg.lsp \
-     coi/util/gensym-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/util/def-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-coi/termination/assuming/zero.pcert1 : acl2x = 0
-coi/termination/assuming/zero.pcert1 : no_pcert = 0
-coi/termination/assuming/zero.pcert1 : coi/termination/assuming/zero.pcert0
-coi/termination/assuming/zero.cert : | coi/termination/assuming/zero.pcert1
-
-coi/util/clause-processor.pcert0 : no_pcert = 0
-coi/util/clause-processor.pcert0 : acl2x = 0
-coi/util/clause-processor.pcert0 : \
-     coi/util/clause-processor.lisp \
-     coi/util/cert.acl2
-coi/util/clause-processor.pcert1 : acl2x = 0
-coi/util/clause-processor.pcert1 : no_pcert = 0
-coi/util/clause-processor.pcert1 : coi/util/clause-processor.pcert0
-coi/util/clause-processor.cert : | coi/util/clause-processor.pcert1
-
-coi/util/debug.pcert0 : no_pcert = 0
-coi/util/debug.pcert0 : acl2x = 0
-coi/util/debug.pcert0 : \
-     coi/util/defdoc.pcert0 \
-     coi/util/debug.lisp \
-     coi/util/debug.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/util/debug-defpkg.lsp
-coi/util/debug.pcert1 : acl2x = 0
-coi/util/debug.pcert1 : no_pcert = 0
-coi/util/debug.pcert1 : coi/util/debug.pcert0
-coi/util/debug.cert : | coi/util/debug.pcert1
-
-coi/util/defbinding.pcert0 : no_pcert = 0
-coi/util/defbinding.pcert0 : acl2x = 0
-coi/util/defbinding.pcert0 : \
-     coi/util/defbinding.lisp \
-     coi/util/defbinding.acl2 \
-     coi/util/def-defpkg.lsp
-coi/util/defbinding.pcert1 : acl2x = 0
-coi/util/defbinding.pcert1 : no_pcert = 0
-coi/util/defbinding.pcert1 : coi/util/defbinding.pcert0
-coi/util/defbinding.cert : | coi/util/defbinding.pcert1
-
-coi/util/defdoc.pcert0 : no_pcert = 0
-coi/util/defdoc.pcert0 : acl2x = 0
-coi/util/defdoc.pcert0 : \
-     coi/util/defdoc.lisp \
-     coi/util/defdoc.acl2 \
-     coi/util/def-defpkg.lsp
-coi/util/defdoc.pcert1 : acl2x = 0
-coi/util/defdoc.pcert1 : no_pcert = 0
-coi/util/defdoc.pcert1 : coi/util/defdoc.pcert0
-coi/util/defdoc.cert : | coi/util/defdoc.pcert1
-
-coi/util/deffix.pcert0 : no_pcert = 0
-coi/util/deffix.pcert0 : acl2x = 0
-coi/util/deffix.pcert0 : \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/util/deffix.lisp \
-     coi/util/deffix.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/util/deffix.pcert1 : acl2x = 0
-coi/util/deffix.pcert1 : no_pcert = 0
-coi/util/deffix.pcert1 : coi/util/deffix.pcert0
-coi/util/deffix.cert : | coi/util/deffix.pcert1
-
-coi/util/defsubtype.pcert0 : no_pcert = 0
-coi/util/defsubtype.pcert0 : acl2x = 0
-coi/util/defsubtype.pcert0 : \
-     coi/util/rule-sets.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/util/defun-support.pcert0 \
-     coi/util/rule-sets.pcert0 \
-     coi/util/defsubtype.lisp \
-     coi/util/defsubtype.acl2 \
-     coi/util/def-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-coi/util/defsubtype.pcert1 : acl2x = 0
-coi/util/defsubtype.pcert1 : no_pcert = 0
-coi/util/defsubtype.pcert1 : coi/util/defsubtype.pcert0
-coi/util/defsubtype.cert : | coi/util/defsubtype.pcert1
-
-coi/util/defun-support.pcert0 : no_pcert = 0
-coi/util/defun-support.pcert0 : acl2x = 0
-coi/util/defun-support.pcert0 : \
-     misc/beta-reduce.pcert0 \
-     coi/util/debug.pcert0 \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/util/defun-support.lisp \
-     coi/util/defun-support.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/defun-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/util/defun-support.pcert1 : acl2x = 0
-coi/util/defun-support.pcert1 : no_pcert = 0
-coi/util/defun-support.pcert1 : coi/util/defun-support.pcert0
-coi/util/defun-support.cert : | coi/util/defun-support.pcert1
-
-coi/util/defun.pcert0 : no_pcert = 0
-coi/util/defun.pcert0 : acl2x = 0
-coi/util/defun.pcert0 : \
-     coi/util/recursion-support.pcert0 \
-     coi/util/pseudo-translate.pcert0 \
-     coi/util/mv-nth.pcert0 \
-     coi/util/defun.lisp \
-     coi/util/defun.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/defun-defpkg.lsp \
-     coi/util/def-defpkg.lsp \
-     coi/util/debug-defpkg.lsp \
-     coi/symbol-fns/symbol-fns-defpkg.lsp
-coi/util/defun.pcert1 : acl2x = 0
-coi/util/defun.pcert1 : no_pcert = 0
-coi/util/defun.pcert1 : coi/util/defun.pcert0
-coi/util/defun.cert : | coi/util/defun.pcert1
-
-coi/util/extra-info-test.pcert0 : no_pcert = 0
-coi/util/extra-info-test.pcert0 : acl2x = 0
-coi/util/extra-info-test.pcert0 : \
-     coi/util/extra-info.pcert0 \
-     make-event/eval.pcert0 \
-     coi/util/extra-info-test.lisp \
-     coi/util/cert.acl2
-coi/util/extra-info-test.pcert1 : acl2x = 0
-coi/util/extra-info-test.pcert1 : no_pcert = 0
-coi/util/extra-info-test.pcert1 : coi/util/extra-info-test.pcert0
-coi/util/extra-info-test.cert : | coi/util/extra-info-test.pcert1
-
-coi/util/extra-info.pcert0 : no_pcert = 0
-coi/util/extra-info.pcert0 : acl2x = 0
-coi/util/extra-info.pcert0 : \
-     coi/util/in-conclusion.pcert0 \
-     coi/util/extra-info.lisp \
-     coi/util/cert.acl2
-coi/util/extra-info.pcert1 : acl2x = 0
-coi/util/extra-info.pcert1 : no_pcert = 0
-coi/util/extra-info.pcert1 : coi/util/extra-info.pcert0
-coi/util/extra-info.cert : | coi/util/extra-info.pcert1
-
-coi/util/fixequiv.pcert0 : no_pcert = 0
-coi/util/fixequiv.pcert0 : acl2x = 0
-coi/util/fixequiv.pcert0 : \
-     coi/util/fixequiv.lisp \
-     coi/util/cert.acl2
-coi/util/fixequiv.pcert1 : acl2x = 0
-coi/util/fixequiv.pcert1 : no_pcert = 0
-coi/util/fixequiv.pcert1 : coi/util/fixequiv.pcert0
-coi/util/fixequiv.cert : | coi/util/fixequiv.pcert1
-
-coi/util/good-rewrite-order.pcert0 : no_pcert = 0
-coi/util/good-rewrite-order.pcert0 : acl2x = 0
-coi/util/good-rewrite-order.pcert0 : \
-     coi/util/syntaxp.pcert0 \
-     misc/total-order.pcert0 \
-     coi/util/good-rewrite-order.lisp \
-     coi/util/cert.acl2
-coi/util/good-rewrite-order.pcert1 : acl2x = 0
-coi/util/good-rewrite-order.pcert1 : no_pcert = 0
-coi/util/good-rewrite-order.pcert1 : coi/util/good-rewrite-order.pcert0
-coi/util/good-rewrite-order.cert : | coi/util/good-rewrite-order.pcert1
-
-coi/util/ifdef.pcert0 : no_pcert = 0
-coi/util/ifdef.pcert0 : acl2x = 0
-coi/util/ifdef.pcert0 : \
-     coi/util/defdoc.pcert0 \
-     coi/util/ifdef.lisp \
-     coi/util/ifdef.acl2 \
-     coi/util/def-defpkg.lsp
-coi/util/ifdef.pcert1 : acl2x = 0
-coi/util/ifdef.pcert1 : no_pcert = 0
-coi/util/ifdef.pcert1 : coi/util/ifdef.pcert0
-coi/util/ifdef.cert : | coi/util/ifdef.pcert1
-
-coi/util/iff.pcert0 : no_pcert = 0
-coi/util/iff.pcert0 : acl2x = 0
-coi/util/iff.pcert0 : \
-     coi/util/iff.lisp \
-     coi/util/cert.acl2
-coi/util/iff.pcert1 : acl2x = 0
-coi/util/iff.pcert1 : no_pcert = 0
-coi/util/iff.pcert1 : coi/util/iff.pcert0
-coi/util/iff.cert : | coi/util/iff.pcert1
-
-coi/util/ifixequiv.pcert0 : no_pcert = 0
-coi/util/ifixequiv.pcert0 : acl2x = 0
-coi/util/ifixequiv.pcert0 : \
-     coi/util/fixequiv.pcert0 \
-     coi/util/ifixequiv.lisp \
-     coi/util/cert.acl2
-coi/util/ifixequiv.pcert1 : acl2x = 0
-coi/util/ifixequiv.pcert1 : no_pcert = 0
-coi/util/ifixequiv.pcert1 : coi/util/ifixequiv.pcert0
-coi/util/ifixequiv.cert : | coi/util/ifixequiv.pcert1
-
-coi/util/implies.pcert0 : no_pcert = 0
-coi/util/implies.pcert0 : acl2x = 0
-coi/util/implies.pcert0 : \
-     coi/util/in-conclusion.pcert0 \
-     coi/util/implies.lisp \
-     coi/util/cert.acl2
-coi/util/implies.pcert1 : acl2x = 0
-coi/util/implies.pcert1 : no_pcert = 0
-coi/util/implies.pcert1 : coi/util/implies.pcert0
-coi/util/implies.cert : | coi/util/implies.pcert1
-
-coi/util/in-conclusion.pcert0 : no_pcert = 0
-coi/util/in-conclusion.pcert0 : acl2x = 0
-coi/util/in-conclusion.pcert0 : \
-     coi/util/in-conclusion.lisp \
-     coi/util/cert.acl2
-coi/util/in-conclusion.pcert1 : acl2x = 0
-coi/util/in-conclusion.pcert1 : no_pcert = 0
-coi/util/in-conclusion.pcert1 : coi/util/in-conclusion.pcert0
-coi/util/in-conclusion.cert : | coi/util/in-conclusion.pcert1
-
-coi/util/ith.pcert0 : no_pcert = 0
-coi/util/ith.pcert0 : acl2x = 0
-coi/util/ith.pcert0 : \
-     coi/util/ith.lisp \
-     coi/util/cert.acl2
-coi/util/ith.pcert1 : acl2x = 0
-coi/util/ith.pcert1 : no_pcert = 0
-coi/util/ith.pcert1 : coi/util/ith.pcert0
-coi/util/ith.cert : | coi/util/ith.pcert1
-
-coi/util/mv-nth.pcert0 : no_pcert = 0
-coi/util/mv-nth.pcert0 : acl2x = 0
-coi/util/mv-nth.pcert0 : \
-     coi/util/mv-nth.lisp \
-     coi/util/mv-nth.acl2 \
-     coi/util/gensym-defpkg.lsp
-coi/util/mv-nth.pcert1 : acl2x = 0
-coi/util/mv-nth.pcert1 : no_pcert = 0
-coi/util/mv-nth.pcert1 : coi/util/mv-nth.pcert0
-coi/util/mv-nth.cert : | coi/util/mv-nth.pcert1
-
-coi/util/nfixequiv.pcert0 : no_pcert = 0
-coi/util/nfixequiv.pcert0 : acl2x = 0
-coi/util/nfixequiv.pcert0 : \
-     coi/util/ifixequiv.pcert0 \
-     coi/util/nfixequiv.lisp \
-     coi/util/cert.acl2
-coi/util/nfixequiv.pcert1 : acl2x = 0
-coi/util/nfixequiv.pcert1 : no_pcert = 0
-coi/util/nfixequiv.pcert1 : coi/util/nfixequiv.pcert0
-coi/util/nfixequiv.cert : | coi/util/nfixequiv.pcert1
-
-coi/util/ordinal-order.pcert0 : no_pcert = 0
-coi/util/ordinal-order.pcert0 : acl2x = 0
-coi/util/ordinal-order.pcert0 : \
-     ordinals/lexicographic-ordering.pcert0 \
-     coi/util/ordinal-order.lisp \
-     coi/util/cert.acl2
-coi/util/ordinal-order.pcert1 : acl2x = 0
-coi/util/ordinal-order.pcert1 : no_pcert = 0
-coi/util/ordinal-order.pcert1 : coi/util/ordinal-order.pcert0
-coi/util/ordinal-order.cert : | coi/util/ordinal-order.pcert1
-
-coi/util/pseudo-translate.pcert0 : no_pcert = 0
-coi/util/pseudo-translate.pcert0 : acl2x = 0
-coi/util/pseudo-translate.pcert0 : \
-     coi/util/pseudo-translate.lisp \
-     coi/util/cert.acl2
-coi/util/pseudo-translate.pcert1 : acl2x = 0
-coi/util/pseudo-translate.pcert1 : no_pcert = 0
-coi/util/pseudo-translate.pcert1 : coi/util/pseudo-translate.pcert0
-coi/util/pseudo-translate.cert : | coi/util/pseudo-translate.pcert1
-
-coi/util/recursion-support.pcert0 : no_pcert = 0
-coi/util/recursion-support.pcert0 : acl2x = 0
-coi/util/recursion-support.pcert0 : \
-     coi/util/mv-nth.pcert0 \
-     coi/util/defun-support.pcert0 \
-     coi/symbol-fns/symbol-fns.pcert0 \
-     coi/util/recursion-support.lisp \
-     coi/util/recursion-support.acl2 \
-     coi/symbol-fns/symbol-fns-defpkg.lsp \
-     coi/util/defun-defpkg.lsp
-coi/util/recursion-support.pcert1 : acl2x = 0
-coi/util/recursion-support.pcert1 : no_pcert = 0
-coi/util/recursion-support.pcert1 : coi/util/recursion-support.pcert0
-coi/util/recursion-support.cert : | coi/util/recursion-support.pcert1
-
-coi/util/rewrite-equiv.pcert0 : no_pcert = 0
-coi/util/rewrite-equiv.pcert0 : acl2x = 0
-coi/util/rewrite-equiv.pcert0 : \
-     coi/util/good-rewrite-order.pcert0 \
-     coi/util/clause-processor.pcert0 \
-     coi/util/rewrite-equiv.lisp \
-     coi/util/cert.acl2
-coi/util/rewrite-equiv.pcert1 : acl2x = 0
-coi/util/rewrite-equiv.pcert1 : no_pcert = 0
-coi/util/rewrite-equiv.pcert1 : coi/util/rewrite-equiv.pcert0
-coi/util/rewrite-equiv.cert : | coi/util/rewrite-equiv.pcert1
-
-coi/util/rule-sets-documentation.pcert0 : no_pcert = 0
-coi/util/rule-sets-documentation.pcert0 : acl2x = 0
-coi/util/rule-sets-documentation.pcert0 : \
-     coi/util/defdoc.pcert0 \
-     coi/util/rule-sets-documentation.lisp \
-     coi/util/rule-sets-documentation.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/def-defpkg.lsp
-coi/util/rule-sets-documentation.pcert1 : acl2x = 0
-coi/util/rule-sets-documentation.pcert1 : no_pcert = 0
-coi/util/rule-sets-documentation.pcert1 : coi/util/rule-sets-documentation.pcert0
-coi/util/rule-sets-documentation.cert : | coi/util/rule-sets-documentation.pcert1
-
-coi/util/rule-sets-support.pcert0 : no_pcert = 0
-coi/util/rule-sets-support.pcert0 : acl2x = 0
-coi/util/rule-sets-support.pcert0 : \
-     coi/util/rule-sets-support.lisp \
-     coi/util/rule-sets-support.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/rule-sets-defpkg.lsp
-coi/util/rule-sets-support.pcert1 : acl2x = 0
-coi/util/rule-sets-support.pcert1 : no_pcert = 0
-coi/util/rule-sets-support.pcert1 : coi/util/rule-sets-support.pcert0
-coi/util/rule-sets-support.cert : | coi/util/rule-sets-support.pcert1
-
-coi/util/rule-sets.pcert0 : no_pcert = 0
-coi/util/rule-sets.pcert0 : acl2x = 0
-coi/util/rule-sets.pcert0 : \
-     coi/util/rule-sets-documentation.pcert0 \
-     coi/util/rule-sets-support.pcert0 \
-     coi/util/table.pcert0 \
-     coi/util/rule-sets.lisp \
-     coi/util/rule-sets.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/rule-sets-defpkg.lsp \
-     coi/util/table-defpkg.lsp \
-     coi/util/def-defpkg.lsp
-coi/util/rule-sets.pcert1 : acl2x = 0
-coi/util/rule-sets.pcert1 : no_pcert = 0
-coi/util/rule-sets.pcert1 : coi/util/rule-sets.pcert0
-coi/util/rule-sets.cert : | coi/util/rule-sets.pcert1
-
-coi/util/skip-rewrite.pcert0 : no_pcert = 0
-coi/util/skip-rewrite.pcert0 : acl2x = 0
-coi/util/skip-rewrite.pcert0 : \
-     misc/beta-reduce.pcert0 \
-     coi/util/skip-rewrite.lisp \
-     coi/util/cert.acl2
-coi/util/skip-rewrite.pcert1 : acl2x = 0
-coi/util/skip-rewrite.pcert1 : no_pcert = 0
-coi/util/skip-rewrite.pcert1 : coi/util/skip-rewrite.pcert0
-coi/util/skip-rewrite.cert : | coi/util/skip-rewrite.pcert1
-
-coi/util/syntaxp.pcert0 : no_pcert = 0
-coi/util/syntaxp.pcert0 : acl2x = 0
-coi/util/syntaxp.pcert0 : \
-     coi/util/syntaxp.lisp \
-     coi/util/cert.acl2
-coi/util/syntaxp.pcert1 : acl2x = 0
-coi/util/syntaxp.pcert1 : no_pcert = 0
-coi/util/syntaxp.pcert1 : coi/util/syntaxp.pcert0
-coi/util/syntaxp.cert : | coi/util/syntaxp.pcert1
-
-coi/util/table.pcert0 : no_pcert = 0
-coi/util/table.pcert0 : acl2x = 0
-coi/util/table.pcert0 : \
-     coi/util/table.lisp \
-     coi/util/table.acl2 \
-     coi/util/cert.acl2 \
-     coi/util/table-defpkg.lsp
-coi/util/table.pcert1 : acl2x = 0
-coi/util/table.pcert1 : no_pcert = 0
-coi/util/table.pcert1 : coi/util/table.pcert0
-coi/util/table.cert : | coi/util/table.pcert1
-
-concurrent-programs/bakery/apply-total-order.pcert0 : no_pcert = 0
-concurrent-programs/bakery/apply-total-order.pcert0 : acl2x = 0
-concurrent-programs/bakery/apply-total-order.pcert0 : \
-     misc/total-order.pcert0 \
-     concurrent-programs/bakery/apply-total-order.lisp
-concurrent-programs/bakery/apply-total-order.pcert1 : acl2x = 0
-concurrent-programs/bakery/apply-total-order.pcert1 : no_pcert = 0
-concurrent-programs/bakery/apply-total-order.pcert1 : concurrent-programs/bakery/apply-total-order.pcert0
-concurrent-programs/bakery/apply-total-order.cert : | concurrent-programs/bakery/apply-total-order.pcert1
-
-concurrent-programs/bakery/fairenv.pcert0 : no_pcert = 0
-concurrent-programs/bakery/fairenv.pcert0 : acl2x = 0
-concurrent-programs/bakery/fairenv.pcert0 : \
-     concurrent-programs/bakery/measures.pcert0 \
-     concurrent-programs/bakery/records.pcert0 \
-     concurrent-programs/bakery/fairenv.lisp
-concurrent-programs/bakery/fairenv.pcert1 : acl2x = 0
-concurrent-programs/bakery/fairenv.pcert1 : no_pcert = 0
-concurrent-programs/bakery/fairenv.pcert1 : concurrent-programs/bakery/fairenv.pcert0
-concurrent-programs/bakery/fairenv.cert : | concurrent-programs/bakery/fairenv.pcert1
-
-concurrent-programs/bakery/final-theorems.pcert0 : no_pcert = 0
-concurrent-programs/bakery/final-theorems.pcert0 : acl2x = 0
-concurrent-programs/bakery/final-theorems.pcert0 : \
-     concurrent-programs/bakery/labels.pcert0 \
-     concurrent-programs/bakery/stutter1-match.pcert0 \
-     concurrent-programs/bakery/stutter2.pcert0 \
-     concurrent-programs/bakery/initial-state.pcert0 \
-     concurrent-programs/bakery/inv-persists.pcert0 \
-     concurrent-programs/bakery/inv-sufficient.pcert0 \
-     concurrent-programs/bakery/final-theorems.lisp
-concurrent-programs/bakery/final-theorems.pcert1 : acl2x = 0
-concurrent-programs/bakery/final-theorems.pcert1 : no_pcert = 0
-concurrent-programs/bakery/final-theorems.pcert1 : concurrent-programs/bakery/final-theorems.pcert0
-concurrent-programs/bakery/final-theorems.cert : | concurrent-programs/bakery/final-theorems.pcert1
-
-concurrent-programs/bakery/initial-state.pcert0 : no_pcert = 0
-concurrent-programs/bakery/initial-state.pcert0 : acl2x = 0
-concurrent-programs/bakery/initial-state.pcert0 : \
-     concurrent-programs/bakery/programs.pcert0 \
-     concurrent-programs/bakery/properties.pcert0 \
-     concurrent-programs/bakery/initial-state.lisp
-concurrent-programs/bakery/initial-state.pcert1 : acl2x = 0
-concurrent-programs/bakery/initial-state.pcert1 : no_pcert = 0
-concurrent-programs/bakery/initial-state.pcert1 : concurrent-programs/bakery/initial-state.pcert0
-concurrent-programs/bakery/initial-state.cert : | concurrent-programs/bakery/initial-state.pcert1
-
-concurrent-programs/bakery/inv-persists.pcert0 : no_pcert = 0
-concurrent-programs/bakery/inv-persists.pcert0 : acl2x = 0
-concurrent-programs/bakery/inv-persists.pcert0 : \
-     concurrent-programs/bakery/programs.pcert0 \
-     concurrent-programs/bakery/properties.pcert0 \
-     concurrent-programs/bakery/lexicographic-pos.pcert0 \
-     concurrent-programs/bakery/inv-persists.lisp
-concurrent-programs/bakery/inv-persists.pcert1 : acl2x = 0
-concurrent-programs/bakery/inv-persists.pcert1 : no_pcert = 0
-concurrent-programs/bakery/inv-persists.pcert1 : concurrent-programs/bakery/inv-persists.pcert0
-concurrent-programs/bakery/inv-persists.cert : | concurrent-programs/bakery/inv-persists.pcert1
-
-concurrent-programs/bakery/inv-sufficient.pcert0 : no_pcert = 0
-concurrent-programs/bakery/inv-sufficient.pcert0 : acl2x = 0
-concurrent-programs/bakery/inv-sufficient.pcert0 : \
-     concurrent-programs/bakery/programs.pcert0 \
-     concurrent-programs/bakery/properties.pcert0 \
-     concurrent-programs/bakery/lexicographic-pos.pcert0 \
-     concurrent-programs/bakery/properties-of-sets.pcert0 \
-     concurrent-programs/bakery/inv-sufficient.lisp
-concurrent-programs/bakery/inv-sufficient.pcert1 : acl2x = 0
-concurrent-programs/bakery/inv-sufficient.pcert1 : no_pcert = 0
-concurrent-programs/bakery/inv-sufficient.pcert1 : concurrent-programs/bakery/inv-sufficient.pcert0
-concurrent-programs/bakery/inv-sufficient.cert : | concurrent-programs/bakery/inv-sufficient.pcert1
-
-concurrent-programs/bakery/labels.pcert0 : no_pcert = 0
-concurrent-programs/bakery/labels.pcert0 : acl2x = 0
-concurrent-programs/bakery/labels.pcert0 : \
-     concurrent-programs/bakery/properties.pcert0 \
-     concurrent-programs/bakery/labels.lisp
-concurrent-programs/bakery/labels.pcert1 : acl2x = 0
-concurrent-programs/bakery/labels.pcert1 : no_pcert = 0
-concurrent-programs/bakery/labels.pcert1 : concurrent-programs/bakery/labels.pcert0
-concurrent-programs/bakery/labels.cert : | concurrent-programs/bakery/labels.pcert1
-
-concurrent-programs/bakery/lexicographic-pos.pcert0 : no_pcert = 0
-concurrent-programs/bakery/lexicographic-pos.pcert0 : acl2x = 0
-concurrent-programs/bakery/lexicographic-pos.pcert0 : \
-     concurrent-programs/bakery/properties.pcert0 \
-     concurrent-programs/bakery/pos-temp.pcert0 \
-     concurrent-programs/bakery/lexicographic-pos.lisp
-concurrent-programs/bakery/lexicographic-pos.pcert1 : acl2x = 0
-concurrent-programs/bakery/lexicographic-pos.pcert1 : no_pcert = 0
-concurrent-programs/bakery/lexicographic-pos.pcert1 : concurrent-programs/bakery/lexicographic-pos.pcert0
-concurrent-programs/bakery/lexicographic-pos.cert : | concurrent-programs/bakery/lexicographic-pos.pcert1
-
-concurrent-programs/bakery/lexicographic.pcert0 : no_pcert = 0
-concurrent-programs/bakery/lexicographic.pcert0 : acl2x = 0
-concurrent-programs/bakery/lexicographic.pcert0 : \
-     misc/total-order.pcert0 \
-     concurrent-programs/bakery/measures.pcert0 \
-     concurrent-programs/bakery/lexicographic.lisp
-concurrent-programs/bakery/lexicographic.pcert1 : acl2x = 0
-concurrent-programs/bakery/lexicographic.pcert1 : no_pcert = 0
-concurrent-programs/bakery/lexicographic.pcert1 : concurrent-programs/bakery/lexicographic.pcert0
-concurrent-programs/bakery/lexicographic.cert : | concurrent-programs/bakery/lexicographic.pcert1
-
-concurrent-programs/bakery/measures.pcert0 : no_pcert = 0
-concurrent-programs/bakery/measures.pcert0 : acl2x = 0
-concurrent-programs/bakery/measures.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     concurrent-programs/bakery/measures.lisp
-concurrent-programs/bakery/measures.pcert1 : acl2x = 0
-concurrent-programs/bakery/measures.pcert1 : no_pcert = 0
-concurrent-programs/bakery/measures.pcert1 : concurrent-programs/bakery/measures.pcert0
-concurrent-programs/bakery/measures.cert : | concurrent-programs/bakery/measures.pcert1
-
-concurrent-programs/bakery/pos-temp.pcert0 : no_pcert = 0
-concurrent-programs/bakery/pos-temp.pcert0 : acl2x = 0
-concurrent-programs/bakery/pos-temp.pcert0 : \
-     concurrent-programs/bakery/variables.pcert0 \
-     concurrent-programs/bakery/properties.pcert0 \
-     concurrent-programs/bakery/pos-temp.lisp
-concurrent-programs/bakery/pos-temp.pcert1 : acl2x = 0
-concurrent-programs/bakery/pos-temp.pcert1 : no_pcert = 0
-concurrent-programs/bakery/pos-temp.pcert1 : concurrent-programs/bakery/pos-temp.pcert0
-concurrent-programs/bakery/pos-temp.cert : | concurrent-programs/bakery/pos-temp.pcert1
-
-concurrent-programs/bakery/programs.pcert0 : no_pcert = 0
-concurrent-programs/bakery/programs.pcert0 : acl2x = 0
-concurrent-programs/bakery/programs.pcert0 : \
-     concurrent-programs/bakery/variables.pcert0 \
-     concurrent-programs/bakery/lexicographic.pcert0 \
-     concurrent-programs/bakery/fairenv.pcert0 \
-     concurrent-programs/bakery/programs.lisp
-concurrent-programs/bakery/programs.pcert1 : acl2x = 0
-concurrent-programs/bakery/programs.pcert1 : no_pcert = 0
-concurrent-programs/bakery/programs.pcert1 : concurrent-programs/bakery/programs.pcert0
-concurrent-programs/bakery/programs.cert : | concurrent-programs/bakery/programs.pcert1
-
-concurrent-programs/bakery/properties-of-sets.pcert0 : no_pcert = 0
-concurrent-programs/bakery/properties-of-sets.pcert0 : acl2x = 0
-concurrent-programs/bakery/properties-of-sets.pcert0 : \
-     concurrent-programs/bakery/records.pcert0 \
-     concurrent-programs/bakery/properties-of-sets.lisp
-concurrent-programs/bakery/properties-of-sets.pcert1 : acl2x = 0
-concurrent-programs/bakery/properties-of-sets.pcert1 : no_pcert = 0
-concurrent-programs/bakery/properties-of-sets.pcert1 : concurrent-programs/bakery/properties-of-sets.pcert0
-concurrent-programs/bakery/properties-of-sets.cert : | concurrent-programs/bakery/properties-of-sets.pcert1
-
-concurrent-programs/bakery/properties.pcert0 : no_pcert = 0
-concurrent-programs/bakery/properties.pcert0 : acl2x = 0
-concurrent-programs/bakery/properties.pcert0 : \
-     concurrent-programs/bakery/lexicographic.pcert0 \
-     concurrent-programs/bakery/measures.pcert0 \
-     concurrent-programs/bakery/properties-of-sets.pcert0 \
-     concurrent-programs/bakery/variables.pcert0 \
-     concurrent-programs/bakery/fairenv.pcert0 \
-     concurrent-programs/bakery/properties.lisp
-concurrent-programs/bakery/properties.pcert1 : acl2x = 0
-concurrent-programs/bakery/properties.pcert1 : no_pcert = 0
-concurrent-programs/bakery/properties.pcert1 : concurrent-programs/bakery/properties.pcert0
-concurrent-programs/bakery/properties.cert : | concurrent-programs/bakery/properties.pcert1
-
-concurrent-programs/bakery/records.pcert0 : no_pcert = 0
-concurrent-programs/bakery/records.pcert0 : acl2x = 0
-concurrent-programs/bakery/records.pcert0 : \
-     concurrent-programs/bakery/apply-total-order.pcert0 \
-     concurrent-programs/bakery/records.lisp
-concurrent-programs/bakery/records.pcert1 : acl2x = 0
-concurrent-programs/bakery/records.pcert1 : no_pcert = 0
-concurrent-programs/bakery/records.pcert1 : concurrent-programs/bakery/records.pcert0
-concurrent-programs/bakery/records.cert : | concurrent-programs/bakery/records.pcert1
-
-concurrent-programs/bakery/stutter1-match.pcert0 : no_pcert = 0
-concurrent-programs/bakery/stutter1-match.pcert0 : acl2x = 0
-concurrent-programs/bakery/stutter1-match.pcert0 : \
-     concurrent-programs/bakery/programs.pcert0 \
-     concurrent-programs/bakery/properties.pcert0 \
-     concurrent-programs/bakery/stutter1-match.lisp
-concurrent-programs/bakery/stutter1-match.pcert1 : acl2x = 0
-concurrent-programs/bakery/stutter1-match.pcert1 : no_pcert = 0
-concurrent-programs/bakery/stutter1-match.pcert1 : concurrent-programs/bakery/stutter1-match.pcert0
-concurrent-programs/bakery/stutter1-match.cert : | concurrent-programs/bakery/stutter1-match.pcert1
-
-concurrent-programs/bakery/stutter2.pcert0 : no_pcert = 0
-concurrent-programs/bakery/stutter2.pcert0 : acl2x = 0
-concurrent-programs/bakery/stutter2.pcert0 : \
-     concurrent-programs/bakery/programs.pcert0 \
-     concurrent-programs/bakery/properties.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     concurrent-programs/bakery/lexicographic-pos.pcert0 \
-     concurrent-programs/bakery/stutter2.lisp
-concurrent-programs/bakery/stutter2.pcert1 : acl2x = 0
-concurrent-programs/bakery/stutter2.pcert1 : no_pcert = 0
-concurrent-programs/bakery/stutter2.pcert1 : concurrent-programs/bakery/stutter2.pcert0
-concurrent-programs/bakery/stutter2.cert : | concurrent-programs/bakery/stutter2.pcert1
-
-concurrent-programs/bakery/variables.pcert0 : no_pcert = 0
-concurrent-programs/bakery/variables.pcert0 : acl2x = 0
-concurrent-programs/bakery/variables.pcert0 : \
-     concurrent-programs/bakery/records.pcert0 \
-     concurrent-programs/bakery/variables.lisp
-concurrent-programs/bakery/variables.pcert1 : acl2x = 0
-concurrent-programs/bakery/variables.pcert1 : no_pcert = 0
-concurrent-programs/bakery/variables.pcert1 : concurrent-programs/bakery/variables.pcert0
-concurrent-programs/bakery/variables.cert : | concurrent-programs/bakery/variables.pcert1
-
-concurrent-programs/german-protocol/german.pcert0 : no_pcert = 0
-concurrent-programs/german-protocol/german.pcert0 : acl2x = 0
-concurrent-programs/german-protocol/german.pcert0 : \
-     misc/records.pcert0 \
-     concurrent-programs/german-protocol/german.lisp
-concurrent-programs/german-protocol/german.pcert1 : acl2x = 0
-concurrent-programs/german-protocol/german.pcert1 : no_pcert = 0
-concurrent-programs/german-protocol/german.pcert1 : concurrent-programs/german-protocol/german.pcert0
-concurrent-programs/german-protocol/german.cert : | concurrent-programs/german-protocol/german.pcert1
-
-countereg-gen/acl2s-parameter.pcert0 : no_pcert = 0
-countereg-gen/acl2s-parameter.pcert0 : acl2x = 0
-countereg-gen/acl2s-parameter.pcert0 : \
-     countereg-gen/utilities.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/acl2s-parameter.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/acl2s-parameter.pcert1 : acl2x = 0
-countereg-gen/acl2s-parameter.pcert1 : no_pcert = 0
-countereg-gen/acl2s-parameter.pcert1 : countereg-gen/acl2s-parameter.pcert0
-countereg-gen/acl2s-parameter.cert : | countereg-gen/acl2s-parameter.pcert1
-
-countereg-gen/base.pcert0 : no_pcert = 0
-countereg-gen/base.pcert0 : acl2x = 0
-countereg-gen/base.pcert0 : \
-     countereg-gen/data.pcert0 \
-     countereg-gen/splitnat.pcert0 \
-     countereg-gen/switchnat.pcert0 \
-     countereg-gen/graph.pcert0 \
-     countereg-gen/library-support.pcert0 \
-     arithmetic-5/top.pcert0 \
-     arithmetic-5/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/base.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/base.pcert1 : acl2x = 0
-countereg-gen/base.pcert1 : no_pcert = 0
-countereg-gen/base.pcert1 : countereg-gen/base.pcert0
-countereg-gen/base.cert : | countereg-gen/base.pcert1
-
-countereg-gen/basis.pcert0 : no_pcert = 0
-countereg-gen/basis.pcert0 : acl2x = 0
-countereg-gen/basis.pcert0 : \
-     tools/bstar.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/basis.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/basis.pcert1 : acl2x = 0
-countereg-gen/basis.pcert1 : no_pcert = 0
-countereg-gen/basis.pcert1 : countereg-gen/basis.pcert0
-countereg-gen/basis.cert : | countereg-gen/basis.pcert1
-
-countereg-gen/data.pcert0 : no_pcert = 0
-countereg-gen/data.pcert0 : acl2x = 0
-countereg-gen/data.pcert0 : \
-     countereg-gen/utilities.pcert0 \
-     countereg-gen/basis.pcert0 \
-     countereg-gen/acl2s-parameter.pcert0 \
-     countereg-gen/splitnat.pcert0 \
-     countereg-gen/switchnat.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/data.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/data.pcert1 : acl2x = 0
-countereg-gen/data.pcert1 : no_pcert = 0
-countereg-gen/data.pcert1 : countereg-gen/data.pcert0
-countereg-gen/data.cert : | countereg-gen/data.pcert1
-
-countereg-gen/graph.pcert0 : no_pcert = 0
-countereg-gen/graph.pcert0 : acl2x = 0
-countereg-gen/graph.pcert0 : \
-     countereg-gen/utilities.pcert0 \
-     countereg-gen/data.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/graph.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/graph.pcert1 : acl2x = 0
-countereg-gen/graph.pcert1 : no_pcert = 0
-countereg-gen/graph.pcert1 : countereg-gen/graph.pcert0
-countereg-gen/graph.cert : | countereg-gen/graph.pcert1
-
-countereg-gen/library-support.pcert0 : no_pcert = 0
-countereg-gen/library-support.pcert0 : acl2x = 0
-countereg-gen/library-support.pcert0 : \
-     defexec/other-apps/records/records.pcert0 \
-     finite-set-theory/osets/sets.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/library-support.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/library-support.pcert1 : acl2x = 0
-countereg-gen/library-support.pcert1 : no_pcert = 0
-countereg-gen/library-support.pcert1 : countereg-gen/library-support.pcert0
-countereg-gen/library-support.cert : | countereg-gen/library-support.pcert1
-
-countereg-gen/main.pcert0 : no_pcert = 0
-countereg-gen/main.pcert0 : acl2x = 0
-countereg-gen/main.pcert0 : \
-     tools/bstar.pcert0 \
-     countereg-gen/basis.pcert0 \
-     countereg-gen/with-timeout.pcert0 \
-     countereg-gen/type.pcert0 \
-     countereg-gen/acl2s-parameter.pcert0 \
-     countereg-gen/simple-graph-array.pcert0 \
-     countereg-gen/random-state.pcert0 \
-     tools/easy-simplify.pcert0 \
-     countereg-gen/data.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/main.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/main.pcert1 : acl2x = 0
-countereg-gen/main.pcert1 : no_pcert = 0
-countereg-gen/main.pcert1 : countereg-gen/main.pcert0
-countereg-gen/main.cert : | countereg-gen/main.pcert1
-
-countereg-gen/mv-proof.pcert0 : no_pcert = 0
-countereg-gen/mv-proof.pcert0 : acl2x = 0
-countereg-gen/mv-proof.pcert0 : \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/mv-proof.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/mv-proof.pcert1 : acl2x = 0
-countereg-gen/mv-proof.pcert1 : no_pcert = 0
-countereg-gen/mv-proof.pcert1 : countereg-gen/mv-proof.pcert0
-countereg-gen/mv-proof.cert : | countereg-gen/mv-proof.pcert1
-
-countereg-gen/num-list-fns.pcert0 : no_pcert = 0
-countereg-gen/num-list-fns.pcert0 : acl2x = 0
-countereg-gen/num-list-fns.pcert0 : \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/num-list-fns.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/num-list-fns.pcert1 : acl2x = 0
-countereg-gen/num-list-fns.pcert1 : no_pcert = 0
-countereg-gen/num-list-fns.pcert1 : countereg-gen/num-list-fns.pcert0
-countereg-gen/num-list-fns.cert : | countereg-gen/num-list-fns.pcert1
-
-countereg-gen/num-list-thms.pcert0 : no_pcert = 0
-countereg-gen/num-list-thms.pcert0 : acl2x = 0
-countereg-gen/num-list-thms.pcert0 : \
-     countereg-gen/num-list-fns.pcert0 \
-     arithmetic-5/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/num-list-thms.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/num-list-thms.pcert1 : acl2x = 0
-countereg-gen/num-list-thms.pcert1 : no_pcert = 0
-countereg-gen/num-list-thms.pcert1 : countereg-gen/num-list-thms.pcert0
-countereg-gen/num-list-thms.cert : | countereg-gen/num-list-thms.pcert1
-
-countereg-gen/random-state-basis1.pcert0 : no_pcert = 0
-countereg-gen/random-state-basis1.pcert0 : acl2x = 0
-countereg-gen/random-state-basis1.pcert0 : \
-     tools/bstar.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/random-state-basis1.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/random-state-basis1.pcert1 : acl2x = 0
-countereg-gen/random-state-basis1.pcert1 : no_pcert = 0
-countereg-gen/random-state-basis1.pcert1 : countereg-gen/random-state-basis1.pcert0
-countereg-gen/random-state-basis1.cert : | countereg-gen/random-state-basis1.pcert1
-
-countereg-gen/random-state.pcert0 : no_pcert = 0
-countereg-gen/random-state.pcert0 : acl2x = 0
-countereg-gen/random-state.pcert0 : \
-     countereg-gen/random-state-basis1.pcert0 \
-     arithmetic/rationals.pcert0 \
-     arithmetic-3/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/random-state.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/random-state.pcert1 : acl2x = 0
-countereg-gen/random-state.pcert1 : no_pcert = 0
-countereg-gen/random-state.pcert1 : countereg-gen/random-state.pcert0
-countereg-gen/random-state.cert : | countereg-gen/random-state.pcert1
-
-countereg-gen/random.pcert0 : no_pcert = 0
-countereg-gen/random.pcert0 : acl2x = 0
-countereg-gen/random.pcert0 : \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     arithmetic/rationals.pcert0 \
-     arithmetic-3/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/random.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/random.pcert1 : acl2x = 0
-countereg-gen/random.pcert1 : no_pcert = 0
-countereg-gen/random.pcert1 : countereg-gen/random.pcert0
-countereg-gen/random.cert : | countereg-gen/random.pcert1
-
-countereg-gen/rem-and-floor.pcert0 : no_pcert = 0
-countereg-gen/rem-and-floor.pcert0 : acl2x = 0
-countereg-gen/rem-and-floor.pcert0 : \
-     arithmetic-5/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/rem-and-floor.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/rem-and-floor.pcert1 : acl2x = 0
-countereg-gen/rem-and-floor.pcert1 : no_pcert = 0
-countereg-gen/rem-and-floor.pcert1 : countereg-gen/rem-and-floor.pcert0
-countereg-gen/rem-and-floor.cert : | countereg-gen/rem-and-floor.pcert1
-
-countereg-gen/simple-graph-array.pcert0 : no_pcert = 0
-countereg-gen/simple-graph-array.pcert0 : acl2x = 0
-countereg-gen/simple-graph-array.pcert0 : \
-     countereg-gen/utilities.pcert0 \
-     ordinals/lexicographic-ordering-without-arithmetic.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/simple-graph-array.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/simple-graph-array.pcert1 : acl2x = 0
-countereg-gen/simple-graph-array.pcert1 : no_pcert = 0
-countereg-gen/simple-graph-array.pcert1 : countereg-gen/simple-graph-array.pcert0
-countereg-gen/simple-graph-array.cert : | countereg-gen/simple-graph-array.pcert1
-
-countereg-gen/splitnat.pcert0 : no_pcert = 0
-countereg-gen/splitnat.pcert0 : acl2x = 0
-countereg-gen/splitnat.pcert0 : \
-     countereg-gen/num-list-fns.pcert0 \
-     countereg-gen/num-list-thms.pcert0 \
-     countereg-gen/rem-and-floor.pcert0 \
-     arithmetic-5/top.pcert0 \
-     arithmetic-5/top.pcert0 \
-     arithmetic-5/top.pcert0 \
-     arithmetic-3/top.pcert0 \
-     arithmetic-5/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/splitnat.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/splitnat.pcert1 : acl2x = 0
-countereg-gen/splitnat.pcert1 : no_pcert = 0
-countereg-gen/splitnat.pcert1 : countereg-gen/splitnat.pcert0
-countereg-gen/splitnat.cert : | countereg-gen/splitnat.pcert1
-
-countereg-gen/switchnat.pcert0 : no_pcert = 0
-countereg-gen/switchnat.pcert0 : acl2x = 0
-countereg-gen/switchnat.pcert0 : \
-     countereg-gen/num-list-fns.pcert0 \
-     countereg-gen/num-list-thms.pcert0 \
-     countereg-gen/rem-and-floor.pcert0 \
-     countereg-gen/mv-proof.pcert0 \
-     arithmetic-5/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/switchnat.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/switchnat.pcert1 : acl2x = 0
-countereg-gen/switchnat.pcert1 : no_pcert = 0
-countereg-gen/switchnat.pcert1 : countereg-gen/switchnat.pcert0
-countereg-gen/switchnat.cert : | countereg-gen/switchnat.pcert1
-
-countereg-gen/top.pcert0 : no_pcert = 0
-countereg-gen/top.pcert0 : acl2x = 0
-countereg-gen/top.pcert0 : \
-     countereg-gen/acl2s-parameter.pcert0 \
-     countereg-gen/main.pcert0 \
-     countereg-gen/base.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/top.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/top.pcert1 : acl2x = 0
-countereg-gen/top.pcert1 : no_pcert = 0
-countereg-gen/top.pcert1 : countereg-gen/top.pcert0
-countereg-gen/top.cert : | countereg-gen/top.pcert1
-
-countereg-gen/type.pcert0 : no_pcert = 0
-countereg-gen/type.pcert0 : acl2x = 0
-countereg-gen/type.pcert0 : \
-     countereg-gen/graph.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/type.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/type.pcert1 : acl2x = 0
-countereg-gen/type.pcert1 : no_pcert = 0
-countereg-gen/type.pcert1 : countereg-gen/type.pcert0
-countereg-gen/type.cert : | countereg-gen/type.pcert1
-
-countereg-gen/utilities.pcert0 : no_pcert = 0
-countereg-gen/utilities.pcert0 : acl2x = 0
-countereg-gen/utilities.pcert0 : \
-     tools/bstar.pcert0 \
-     misc/total-order.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/utilities.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/utilities.pcert1 : acl2x = 0
-countereg-gen/utilities.pcert1 : no_pcert = 0
-countereg-gen/utilities.pcert1 : countereg-gen/utilities.pcert0
-countereg-gen/utilities.cert : | countereg-gen/utilities.pcert1
-
-countereg-gen/with-timeout.pcert0 : no_pcert = 0
-countereg-gen/with-timeout.pcert0 : acl2x = 0
-countereg-gen/with-timeout.pcert0 : \
-     xdoc/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     countereg-gen/with-timeout.lisp \
-     countereg-gen/cert.acl2 \
-     countereg-gen/package.lsp
-countereg-gen/with-timeout.pcert1 : acl2x = 0
-countereg-gen/with-timeout.pcert1 : no_pcert = 0
-countereg-gen/with-timeout.pcert1 : countereg-gen/with-timeout.pcert0
-countereg-gen/with-timeout.cert : | countereg-gen/with-timeout.pcert1
-
-cowles/acl2-agp.pcert0 : no_pcert = 0
-cowles/acl2-agp.pcert0 : acl2x = 0
-cowles/acl2-agp.pcert0 : \
-     cowles/acl2-asg.pcert0 \
-     cowles/acl2-agp.lisp \
-     cowles/cert.acl2 \
-     cowles/packages.lsp
-cowles/acl2-agp.pcert1 : acl2x = 0
-cowles/acl2-agp.pcert1 : no_pcert = 0
-cowles/acl2-agp.pcert1 : cowles/acl2-agp.pcert0
-cowles/acl2-agp.cert : | cowles/acl2-agp.pcert1
-
-cowles/acl2-asg.pcert0 : no_pcert = 0
-cowles/acl2-asg.pcert0 : acl2x = 0
-cowles/acl2-asg.pcert0 : \
-     cowles/acl2-asg.lisp \
-     cowles/cert.acl2 \
-     cowles/packages.lsp
-cowles/acl2-asg.pcert1 : acl2x = 0
-cowles/acl2-asg.pcert1 : no_pcert = 0
-cowles/acl2-asg.pcert1 : cowles/acl2-asg.pcert0
-cowles/acl2-asg.cert : | cowles/acl2-asg.pcert1
-
-cowles/acl2-crg.pcert0 : no_pcert = 0
-cowles/acl2-crg.pcert0 : acl2x = 0
-cowles/acl2-crg.pcert0 : \
-     cowles/acl2-agp.pcert0 \
-     cowles/acl2-crg.lisp \
-     cowles/cert.acl2 \
-     cowles/packages.lsp
-cowles/acl2-crg.pcert1 : acl2x = 0
-cowles/acl2-crg.pcert1 : no_pcert = 0
-cowles/acl2-crg.pcert1 : cowles/acl2-crg.pcert0
-cowles/acl2-crg.cert : | cowles/acl2-crg.pcert1
-
-cutil/da-base.pcert0 : no_pcert = 0
-cutil/da-base.pcert0 : acl2x = 0
-cutil/da-base.pcert0 : \
-     cutil/support.pcert0 \
-     tools/bstar.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/da-base.lisp \
-     cutil/cert.acl2
-cutil/da-base.pcert1 : acl2x = 0
-cutil/da-base.pcert1 : no_pcert = 0
-cutil/da-base.pcert1 : cutil/da-base.pcert0
-cutil/da-base.cert : | cutil/da-base.pcert1
-
-cutil/defaggregate-tests.pcert0 : no_pcert = 0
-cutil/defaggregate-tests.pcert0 : acl2x = 0
-cutil/defaggregate-tests.pcert0 : \
-     cutil/defaggregate.pcert0 \
-     cutil/deflist.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defaggregate-tests.lisp \
-     cutil/cert.acl2
-cutil/defaggregate-tests.pcert1 : acl2x = 0
-cutil/defaggregate-tests.pcert1 : no_pcert = 0
-cutil/defaggregate-tests.pcert1 : cutil/defaggregate-tests.pcert0
-cutil/defaggregate-tests.cert : | cutil/defaggregate-tests.pcert1
-
-cutil/defaggregate.pcert0 : no_pcert = 0
-cutil/defaggregate.pcert0 : acl2x = 0
-cutil/defaggregate.pcert0 : \
-     cutil/da-base.pcert0 \
-     cutil/formals.pcert0 \
-     xdoc-impl/fmt-to-str.pcert0 \
-     tools/rulesets.pcert0 \
-     xdoc/names.pcert0 \
-     str/cat.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defaggregate.lisp \
-     cutil/cert.acl2
-cutil/defaggregate.pcert1 : acl2x = 0
-cutil/defaggregate.pcert1 : no_pcert = 0
-cutil/defaggregate.pcert1 : cutil/defaggregate.pcert0
-cutil/defaggregate.cert : | cutil/defaggregate.pcert1
-
-cutil/defalist-tests.pcert0 : no_pcert = 0
-cutil/defalist-tests.pcert0 : acl2x = 0
-cutil/defalist-tests.pcert0 : \
-     cutil/defalist.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defalist-tests.lisp \
-     cutil/cert.acl2
-cutil/defalist-tests.pcert1 : acl2x = 0
-cutil/defalist-tests.pcert1 : no_pcert = 0
-cutil/defalist-tests.pcert1 : cutil/defalist-tests.pcert0
-cutil/defalist-tests.cert : | cutil/defalist-tests.pcert1
-
-cutil/defalist.pcert0 : no_pcert = 0
-cutil/defalist.pcert0 : acl2x = 0
-cutil/defalist.pcert0 : \
-     cutil/deflist.pcert0 \
-     misc/hons-help.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defalist.lisp \
-     cutil/cert.acl2
-cutil/defalist.pcert1 : acl2x = 0
-cutil/defalist.pcert1 : no_pcert = 0
-cutil/defalist.pcert1 : cutil/defalist.pcert0
-cutil/defalist.cert : | cutil/defalist.pcert1
-
-cutil/defenum.pcert0 : no_pcert = 0
-cutil/defenum.pcert0 : acl2x = 0
-cutil/defenum.pcert0 : \
-     cutil/deflist.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defenum.lisp \
-     cutil/cert.acl2
-cutil/defenum.pcert1 : acl2x = 0
-cutil/defenum.pcert1 : no_pcert = 0
-cutil/defenum.pcert1 : cutil/defenum.pcert0
-cutil/defenum.cert : | cutil/defenum.pcert1
-
-cutil/define-tests.pcert0 : no_pcert = 0
-cutil/define-tests.pcert0 : acl2x = 0
-cutil/define-tests.pcert0 : \
-     cutil/define.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/define-tests.lisp \
-     cutil/define-tests.acl2
-cutil/define-tests.pcert1 : acl2x = 0
-cutil/define-tests.pcert1 : no_pcert = 0
-cutil/define-tests.pcert1 : cutil/define-tests.pcert0
-cutil/define-tests.cert : | cutil/define-tests.pcert1
-
-cutil/define.pcert0 : no_pcert = 0
-cutil/define.pcert0 : acl2x = 0
-cutil/define.pcert0 : \
-     cutil/formals.pcert0 \
-     cutil/returnspecs.pcert0 \
-     xdoc-impl/fmt-to-str.pcert0 \
-     tools/mv-nth.pcert0 \
-     str/cat.pcert0 \
-     misc/assert.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/define.lisp \
-     cutil/cert.acl2
-cutil/define.pcert1 : acl2x = 0
-cutil/define.pcert1 : no_pcert = 0
-cutil/define.pcert1 : cutil/define.pcert0
-cutil/define.cert : | cutil/define.pcert1
-
-cutil/deflist-aux.pcert0 : no_pcert = 0
-cutil/deflist-aux.pcert0 : acl2x = 0
-cutil/deflist-aux.pcert0 : \
-     finite-set-theory/osets/sets.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/deflist-aux.lisp \
-     cutil/cert.acl2
-cutil/deflist-aux.pcert1 : acl2x = 0
-cutil/deflist-aux.pcert1 : no_pcert = 0
-cutil/deflist-aux.pcert1 : cutil/deflist-aux.pcert0
-cutil/deflist-aux.cert : | cutil/deflist-aux.pcert1
-
-cutil/deflist-tests.pcert0 : no_pcert = 0
-cutil/deflist-tests.pcert0 : acl2x = 0
-cutil/deflist-tests.pcert0 : \
-     cutil/deflist.pcert0 \
-     str/top.pcert0 \
-     misc/assert.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/deflist-tests.lisp \
-     cutil/cert.acl2
-cutil/deflist-tests.pcert1 : acl2x = 0
-cutil/deflist-tests.pcert1 : no_pcert = 0
-cutil/deflist-tests.pcert1 : cutil/deflist-tests.pcert0
-cutil/deflist-tests.cert : | cutil/deflist-tests.pcert1
-
-cutil/deflist.pcert0 : no_pcert = 0
-cutil/deflist.pcert0 : acl2x = 0
-cutil/deflist.pcert0 : \
-     xdoc/top.pcert0 \
-     tools/bstar.pcert0 \
-     str/cat.pcert0 \
-     finite-set-theory/osets/sets.pcert0 \
-     defsort/duplicated-members.pcert0 \
-     std/lists/sets.pcert0 \
-     std/lists/list-fix.pcert0 \
-     std/lists/take.pcert0 \
-     std/lists/repeat.pcert0 \
-     std/lists/rev.pcert0 \
-     cutil/maybe-defthm.pcert0 \
-     finite-set-theory/osets/under-set-equiv.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/deflist.lisp \
-     cutil/cert.acl2
-cutil/deflist.pcert1 : acl2x = 0
-cutil/deflist.pcert1 : no_pcert = 0
-cutil/deflist.pcert1 : cutil/deflist.pcert0
-cutil/deflist.cert : | cutil/deflist.pcert1
-
-cutil/defmapappend-tests.pcert0 : no_pcert = 0
-cutil/defmapappend-tests.pcert0 : acl2x = 0
-cutil/defmapappend-tests.pcert0 : \
-     cutil/defmapappend.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defmapappend-tests.lisp \
-     cutil/cert.acl2
-cutil/defmapappend-tests.pcert1 : acl2x = 0
-cutil/defmapappend-tests.pcert1 : no_pcert = 0
-cutil/defmapappend-tests.pcert1 : cutil/defmapappend-tests.pcert0
-cutil/defmapappend-tests.cert : | cutil/defmapappend-tests.pcert1
-
-cutil/defmapappend.pcert0 : no_pcert = 0
-cutil/defmapappend.pcert0 : acl2x = 0
-cutil/defmapappend.pcert0 : \
-     cutil/defprojection.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defmapappend.lisp \
-     cutil/cert.acl2
-cutil/defmapappend.pcert1 : acl2x = 0
-cutil/defmapappend.pcert1 : no_pcert = 0
-cutil/defmapappend.pcert1 : cutil/defmapappend.pcert0
-cutil/defmapappend.cert : | cutil/defmapappend.pcert1
-
-cutil/defmvtypes.pcert0 : no_pcert = 0
-cutil/defmvtypes.pcert0 : acl2x = 0
-cutil/defmvtypes.pcert0 : \
-     cutil/deflist.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defmvtypes.lisp \
-     cutil/cert.acl2
-cutil/defmvtypes.pcert1 : acl2x = 0
-cutil/defmvtypes.pcert1 : no_pcert = 0
-cutil/defmvtypes.pcert1 : cutil/defmvtypes.pcert0
-cutil/defmvtypes.cert : | cutil/defmvtypes.pcert1
-
-cutil/defprojection-tests.pcert0 : no_pcert = 0
-cutil/defprojection-tests.pcert0 : acl2x = 0
-cutil/defprojection-tests.pcert0 : \
-     cutil/defprojection.pcert0 \
-     misc/assert.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defprojection-tests.lisp \
-     cutil/defprojection-tests.acl2
-cutil/defprojection-tests.pcert1 : acl2x = 0
-cutil/defprojection-tests.pcert1 : no_pcert = 0
-cutil/defprojection-tests.pcert1 : cutil/defprojection-tests.pcert0
-cutil/defprojection-tests.cert : | cutil/defprojection-tests.pcert1
-
-cutil/defprojection.pcert0 : no_pcert = 0
-cutil/defprojection.pcert0 : acl2x = 0
-cutil/defprojection.pcert0 : \
-     cutil/deflist.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defprojection.lisp \
-     cutil/cert.acl2
-cutil/defprojection.pcert1 : acl2x = 0
-cutil/defprojection.pcert1 : no_pcert = 0
-cutil/defprojection.pcert1 : cutil/defprojection.pcert0
-cutil/defprojection.cert : | cutil/defprojection.pcert1
-
-cutil/defsection.pcert0 : no_pcert = 0
-cutil/defsection.pcert0 : acl2x = 0
-cutil/defsection.pcert0 : \
-     xdoc/top.pcert0 \
-     tools/bstar.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/defsection.lisp \
-     cutil/cert.acl2
-cutil/defsection.pcert1 : acl2x = 0
-cutil/defsection.pcert1 : no_pcert = 0
-cutil/defsection.pcert1 : cutil/defsection.pcert0
-cutil/defsection.cert : | cutil/defsection.pcert1
-
-cutil/formals.pcert0 : no_pcert = 0
-cutil/formals.pcert0 : acl2x = 0
-cutil/formals.pcert0 : \
-     cutil/look-up.pcert0 \
-     cutil/da-base.pcert0 \
-     misc/assert.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/formals.lisp \
-     cutil/cert.acl2
-cutil/formals.pcert1 : acl2x = 0
-cutil/formals.pcert1 : no_pcert = 0
-cutil/formals.pcert1 : cutil/formals.pcert0
-cutil/formals.cert : | cutil/formals.pcert1
-
-cutil/look-up.pcert0 : no_pcert = 0
-cutil/look-up.pcert0 : acl2x = 0
-cutil/look-up.pcert0 : \
-     cutil/support.pcert0 \
-     tools/bstar.pcert0 \
-     misc/assert.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/look-up.lisp \
-     cutil/cert.acl2
-cutil/look-up.pcert1 : acl2x = 0
-cutil/look-up.pcert1 : no_pcert = 0
-cutil/look-up.pcert1 : cutil/look-up.pcert0
-cutil/look-up.cert : | cutil/look-up.pcert1
-
-cutil/maybe-defthm.pcert0 : no_pcert = 0
-cutil/maybe-defthm.pcert0 : acl2x = 0
-cutil/maybe-defthm.pcert0 : \
-     tools/bstar.pcert0 \
-     misc/assert.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/maybe-defthm.lisp \
-     cutil/cert.acl2
-cutil/maybe-defthm.pcert1 : acl2x = 0
-cutil/maybe-defthm.pcert1 : no_pcert = 0
-cutil/maybe-defthm.pcert1 : cutil/maybe-defthm.pcert0
-cutil/maybe-defthm.cert : | cutil/maybe-defthm.pcert1
-
-cutil/portcullis.pcert0 : no_pcert = 0
-cutil/portcullis.pcert0 : acl2x = 0
-cutil/portcullis.pcert0 : \
-     cutil/portcullis.lisp \
-     cutil/portcullis.acl2 \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-cutil/portcullis.pcert1 : acl2x = 0
-cutil/portcullis.pcert1 : no_pcert = 0
-cutil/portcullis.pcert1 : cutil/portcullis.pcert0
-cutil/portcullis.cert : | cutil/portcullis.pcert1
-
-cutil/returnspecs.pcert0 : no_pcert = 0
-cutil/returnspecs.pcert0 : acl2x = 0
-cutil/returnspecs.pcert0 : \
-     cutil/da-base.pcert0 \
-     cutil/look-up.pcert0 \
-     misc/assert.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/returnspecs.lisp \
-     cutil/cert.acl2
-cutil/returnspecs.pcert1 : acl2x = 0
-cutil/returnspecs.pcert1 : no_pcert = 0
-cutil/returnspecs.pcert1 : cutil/returnspecs.pcert0
-cutil/returnspecs.cert : | cutil/returnspecs.pcert1
-
-cutil/support.pcert0 : no_pcert = 0
-cutil/support.pcert0 : acl2x = 0
-cutil/support.pcert0 : \
-     xdoc/top.pcert0 \
-     misc/definline.pcert0 \
-     tools/bstar.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/support.lisp \
-     cutil/cert.acl2
-cutil/support.pcert1 : acl2x = 0
-cutil/support.pcert1 : no_pcert = 0
-cutil/support.pcert1 : cutil/support.pcert0
-cutil/support.cert : | cutil/support.pcert1
-
-cutil/top.pcert0 : no_pcert = 0
-cutil/top.pcert0 : acl2x = 0
-cutil/top.pcert0 : \
-     cutil/defaggregate.pcert0 \
-     cutil/defalist.pcert0 \
-     cutil/defenum.pcert0 \
-     cutil/deflist.pcert0 \
-     cutil/defmapappend.pcert0 \
-     cutil/defmvtypes.pcert0 \
-     cutil/defprojection.pcert0 \
-     cutil/define.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/top.lisp \
-     cutil/top.acl2
-cutil/top.pcert1 : acl2x = 0
-cutil/top.pcert1 : no_pcert = 0
-cutil/top.pcert1 : cutil/top.pcert0
-cutil/top.cert : | cutil/top.pcert1
-
-cutil/wizard.pcert0 : no_pcert = 0
-cutil/wizard.pcert0 : acl2x = 0
-cutil/wizard.pcert0 : \
-     cutil/defaggregate.pcert0 \
-     cutil/deflist.pcert0 \
-     clause-processors/unify-subst.pcert0 \
-     cutil/portcullis.pcert0 \
-     cutil/wizard.lisp \
-     cutil/cert.acl2
-cutil/wizard.pcert1 : acl2x = 0
-cutil/wizard.pcert1 : no_pcert = 0
-cutil/wizard.pcert1 : cutil/wizard.pcert0
-cutil/wizard.cert : | cutil/wizard.pcert1
-
-data-structures/alist-defthms.pcert0 : no_pcert = 0
-data-structures/alist-defthms.pcert0 : acl2x = 0
-data-structures/alist-defthms.pcert0 : \
-     data-structures/alist-defuns.pcert0 \
-     data-structures/list-defuns.pcert0 \
-     data-structures/set-defuns.pcert0 \
-     arithmetic/equalities.pcert0 \
-     data-structures/set-defthms.pcert0 \
-     data-structures/alist-defthms.lisp
-data-structures/alist-defthms.pcert1 : acl2x = 0
-data-structures/alist-defthms.pcert1 : no_pcert = 0
-data-structures/alist-defthms.pcert1 : data-structures/alist-defthms.pcert0
-data-structures/alist-defthms.cert : | data-structures/alist-defthms.pcert1
-
-data-structures/alist-defuns.pcert0 : no_pcert = 0
-data-structures/alist-defuns.pcert0 : acl2x = 0
-data-structures/alist-defuns.pcert0 : \
-     data-structures/alist-defuns.lisp
-data-structures/alist-defuns.pcert1 : acl2x = 0
-data-structures/alist-defuns.pcert1 : no_pcert = 0
-data-structures/alist-defuns.pcert1 : data-structures/alist-defuns.pcert0
-data-structures/alist-defuns.cert : | data-structures/alist-defuns.pcert1
-
-data-structures/alist-theory.pcert0 : no_pcert = 0
-data-structures/alist-theory.pcert0 : acl2x = 0
-data-structures/alist-theory.pcert0 : \
-     data-structures/alist-defuns.pcert0 \
-     data-structures/alist-defthms.pcert0 \
-     data-structures/defalist.pcert0 \
-     data-structures/alist-theory.lisp
-data-structures/alist-theory.pcert1 : acl2x = 0
-data-structures/alist-theory.pcert1 : no_pcert = 0
-data-structures/alist-theory.pcert1 : data-structures/alist-theory.pcert0
-data-structures/alist-theory.cert : | data-structures/alist-theory.pcert1
-
-data-structures/array1.pcert0 : no_pcert = 0
-data-structures/array1.pcert0 : acl2x = 0
-data-structures/array1.pcert0 : \
-     data-structures/doc-section.pcert0 \
-     data-structures/array1.lisp
-data-structures/array1.pcert1 : acl2x = 0
-data-structures/array1.pcert1 : no_pcert = 0
-data-structures/array1.pcert1 : data-structures/array1.pcert0
-data-structures/array1.cert : | data-structures/array1.pcert1
-
-data-structures/defalist.pcert0 : no_pcert = 0
-data-structures/defalist.pcert0 : acl2x = 0
-data-structures/defalist.pcert0 : \
-     data-structures/alist-defuns.pcert0 \
-     data-structures/list-defuns.pcert0 \
-     data-structures/utilities.pcert0 \
-     data-structures/defalist.lisp \
-     data-structures/defalist.acl2 \
-     data-structures/define-u-package.lsp
-data-structures/defalist.pcert1 : acl2x = 0
-data-structures/defalist.pcert1 : no_pcert = 0
-data-structures/defalist.pcert1 : data-structures/defalist.pcert0
-data-structures/defalist.cert : | data-structures/defalist.pcert1
-
-data-structures/deflist.pcert0 : no_pcert = 0
-data-structures/deflist.pcert0 : acl2x = 0
-data-structures/deflist.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/utilities.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     data-structures/deflist.lisp \
-     data-structures/deflist.acl2 \
-     data-structures/define-u-package.lsp
-data-structures/deflist.pcert1 : acl2x = 0
-data-structures/deflist.pcert1 : no_pcert = 0
-data-structures/deflist.pcert1 : data-structures/deflist.pcert0
-data-structures/deflist.cert : | data-structures/deflist.pcert1
-
-data-structures/doc-section.pcert0 : no_pcert = 0
-data-structures/doc-section.pcert0 : acl2x = 0
-data-structures/doc-section.pcert0 : \
-     data-structures/doc-section.lisp
-data-structures/doc-section.pcert1 : acl2x = 0
-data-structures/doc-section.pcert1 : no_pcert = 0
-data-structures/doc-section.pcert1 : data-structures/doc-section.pcert0
-data-structures/doc-section.cert : | data-structures/doc-section.pcert1
-
-data-structures/list-defthms.pcert0 : no_pcert = 0
-data-structures/list-defthms.pcert0 : acl2x = 0
-data-structures/list-defthms.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     arithmetic/equalities.pcert0 \
-     data-structures/list-defthms.lisp
-data-structures/list-defthms.pcert1 : acl2x = 0
-data-structures/list-defthms.pcert1 : no_pcert = 0
-data-structures/list-defthms.pcert1 : data-structures/list-defthms.pcert0
-data-structures/list-defthms.cert : | data-structures/list-defthms.pcert1
-
-data-structures/list-defuns.pcert0 : no_pcert = 0
-data-structures/list-defuns.pcert0 : acl2x = 0
-data-structures/list-defuns.pcert0 : \
-     data-structures/list-defuns.lisp
-data-structures/list-defuns.pcert1 : acl2x = 0
-data-structures/list-defuns.pcert1 : no_pcert = 0
-data-structures/list-defuns.pcert1 : data-structures/list-defuns.pcert0
-data-structures/list-defuns.cert : | data-structures/list-defuns.pcert1
-
-data-structures/list-theory.pcert0 : no_pcert = 0
-data-structures/list-theory.pcert0 : acl2x = 0
-data-structures/list-theory.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     data-structures/deflist.pcert0 \
-     data-structures/list-theory.lisp
-data-structures/list-theory.pcert1 : acl2x = 0
-data-structures/list-theory.pcert1 : no_pcert = 0
-data-structures/list-theory.pcert1 : data-structures/list-theory.pcert0
-data-structures/list-theory.cert : | data-structures/list-theory.pcert1
-
-data-structures/memories/log2.pcert0 : no_pcert = 0
-data-structures/memories/log2.pcert0 : acl2x = 0
-data-structures/memories/log2.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     data-structures/memories/log2.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-data-structures/memories/log2.pcert1 : acl2x = 0
-data-structures/memories/log2.pcert1 : no_pcert = 0
-data-structures/memories/log2.pcert1 : data-structures/memories/log2.pcert0
-data-structures/memories/log2.cert : | data-structures/memories/log2.pcert1
-
-data-structures/memories/memory-impl.pcert0 : no_pcert = 0
-data-structures/memories/memory-impl.pcert0 : acl2x = 0
-data-structures/memories/memory-impl.pcert0 : \
-     data-structures/memories/log2.pcert0 \
-     data-structures/memories/memtree.pcert0 \
-     misc/records.pcert0 \
-     data-structures/memories/memory-impl.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-data-structures/memories/memory-impl.pcert1 : acl2x = 0
-data-structures/memories/memory-impl.pcert1 : no_pcert = 0
-data-structures/memories/memory-impl.pcert1 : data-structures/memories/memory-impl.pcert0
-data-structures/memories/memory-impl.cert : | data-structures/memories/memory-impl.pcert1
-
-data-structures/memories/memory.pcert0 : no_pcert = 0
-data-structures/memories/memory.pcert0 : acl2x = 0
-data-structures/memories/memory.pcert0 : \
-     data-structures/memories/memory-impl.pcert0 \
-     data-structures/doc-section.pcert0 \
-     data-structures/memories/private.pcert0 \
-     misc/records.pcert0 \
-     data-structures/memories/memory.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-data-structures/memories/memory.pcert1 : acl2x = 0
-data-structures/memories/memory.pcert1 : no_pcert = 0
-data-structures/memories/memory.pcert1 : data-structures/memories/memory.pcert0
-data-structures/memories/memory.cert : | data-structures/memories/memory.pcert1
-
-data-structures/memories/memtree.pcert0 : no_pcert = 0
-data-structures/memories/memtree.pcert0 : acl2x = 0
-data-structures/memories/memtree.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     data-structures/memories/memtree.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-data-structures/memories/memtree.pcert1 : acl2x = 0
-data-structures/memories/memtree.pcert1 : no_pcert = 0
-data-structures/memories/memtree.pcert1 : data-structures/memories/memtree.pcert0
-data-structures/memories/memtree.cert : | data-structures/memories/memtree.pcert1
-
-data-structures/memories/private.pcert0 : no_pcert = 0
-data-structures/memories/private.pcert0 : acl2x = 0
-data-structures/memories/private.pcert0 : \
-     data-structures/doc-section.pcert0 \
-     data-structures/memories/private.lisp \
-     data-structures/memories/cert.acl2 \
-     data-structures/memories/package.lsp
-data-structures/memories/private.pcert1 : acl2x = 0
-data-structures/memories/private.pcert1 : no_pcert = 0
-data-structures/memories/private.pcert1 : data-structures/memories/private.pcert0
-data-structures/memories/private.cert : | data-structures/memories/private.pcert1
-
-data-structures/no-duplicates.pcert0 : no_pcert = 0
-data-structures/no-duplicates.pcert0 : acl2x = 0
-data-structures/no-duplicates.pcert0 : \
-     data-structures/no-duplicates.lisp
-data-structures/no-duplicates.pcert1 : acl2x = 0
-data-structures/no-duplicates.pcert1 : no_pcert = 0
-data-structures/no-duplicates.pcert1 : data-structures/no-duplicates.pcert0
-data-structures/no-duplicates.cert : | data-structures/no-duplicates.pcert1
-
-data-structures/number-list-defthms.pcert0 : no_pcert = 0
-data-structures/number-list-defthms.pcert0 : acl2x = 0
-data-structures/number-list-defthms.pcert0 : \
-     data-structures/number-list-defuns.pcert0 \
-     data-structures/deflist.pcert0 \
-     data-structures/number-list-defthms.lisp
-data-structures/number-list-defthms.pcert1 : acl2x = 0
-data-structures/number-list-defthms.pcert1 : no_pcert = 0
-data-structures/number-list-defthms.pcert1 : data-structures/number-list-defthms.pcert0
-data-structures/number-list-defthms.cert : | data-structures/number-list-defthms.pcert1
-
-data-structures/number-list-defuns.pcert0 : no_pcert = 0
-data-structures/number-list-defuns.pcert0 : acl2x = 0
-data-structures/number-list-defuns.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/number-list-defuns.lisp
-data-structures/number-list-defuns.pcert1 : acl2x = 0
-data-structures/number-list-defuns.pcert1 : no_pcert = 0
-data-structures/number-list-defuns.pcert1 : data-structures/number-list-defuns.pcert0
-data-structures/number-list-defuns.cert : | data-structures/number-list-defuns.pcert1
-
-data-structures/number-list-theory.pcert0 : no_pcert = 0
-data-structures/number-list-theory.pcert0 : acl2x = 0
-data-structures/number-list-theory.pcert0 : \
-     data-structures/number-list-defuns.pcert0 \
-     data-structures/number-list-defthms.pcert0 \
-     data-structures/number-list-theory.lisp
-data-structures/number-list-theory.pcert1 : acl2x = 0
-data-structures/number-list-theory.pcert1 : no_pcert = 0
-data-structures/number-list-theory.pcert1 : data-structures/number-list-theory.pcert0
-data-structures/number-list-theory.cert : | data-structures/number-list-theory.pcert1
-
-data-structures/set-defthms.pcert0 : no_pcert = 0
-data-structures/set-defthms.pcert0 : acl2x = 0
-data-structures/set-defthms.pcert0 : \
-     data-structures/set-defuns.pcert0 \
-     data-structures/set-defthms.lisp
-data-structures/set-defthms.pcert1 : acl2x = 0
-data-structures/set-defthms.pcert1 : no_pcert = 0
-data-structures/set-defthms.pcert1 : data-structures/set-defthms.pcert0
-data-structures/set-defthms.cert : | data-structures/set-defthms.pcert1
-
-data-structures/set-defuns.pcert0 : no_pcert = 0
-data-structures/set-defuns.pcert0 : acl2x = 0
-data-structures/set-defuns.pcert0 : \
-     data-structures/set-defuns.lisp
-data-structures/set-defuns.pcert1 : acl2x = 0
-data-structures/set-defuns.pcert1 : no_pcert = 0
-data-structures/set-defuns.pcert1 : data-structures/set-defuns.pcert0
-data-structures/set-defuns.cert : | data-structures/set-defuns.pcert1
-
-data-structures/set-theory.pcert0 : no_pcert = 0
-data-structures/set-theory.pcert0 : acl2x = 0
-data-structures/set-theory.pcert0 : \
-     data-structures/set-defuns.pcert0 \
-     data-structures/set-defthms.pcert0 \
-     data-structures/set-theory.lisp
-data-structures/set-theory.pcert1 : acl2x = 0
-data-structures/set-theory.pcert1 : no_pcert = 0
-data-structures/set-theory.pcert1 : data-structures/set-theory.pcert0
-data-structures/set-theory.cert : | data-structures/set-theory.pcert1
-
-data-structures/structures.pcert0 : no_pcert = 0
-data-structures/structures.pcert0 : acl2x = 0
-data-structures/structures.pcert0 : \
-     data-structures/utilities.pcert0 \
-     data-structures/structures.lisp \
-     data-structures/structures.acl2 \
-     data-structures/define-u-package.lsp \
-     data-structures/define-structures-package.lsp
-data-structures/structures.pcert1 : acl2x = 0
-data-structures/structures.pcert1 : no_pcert = 0
-data-structures/structures.pcert1 : data-structures/structures.pcert0
-data-structures/structures.cert : | data-structures/structures.pcert1
-
-data-structures/utilities.pcert0 : no_pcert = 0
-data-structures/utilities.pcert0 : acl2x = 0
-data-structures/utilities.pcert0 : \
-     data-structures/doc-section.pcert0 \
-     data-structures/utilities.lisp \
-     data-structures/utilities.acl2 \
-     data-structures/define-u-package.lsp
-data-structures/utilities.pcert1 : acl2x = 0
-data-structures/utilities.pcert1 : no_pcert = 0
-data-structures/utilities.pcert1 : data-structures/utilities.pcert0
-data-structures/utilities.cert : | data-structures/utilities.pcert1
-
-deduction/passmore/bewijs.pcert0 : no_pcert = 0
-deduction/passmore/bewijs.pcert0 : acl2x = 0
-deduction/passmore/bewijs.pcert0 : \
-     deduction/passmore/bewijs.lisp
-deduction/passmore/bewijs.pcert1 : acl2x = 0
-deduction/passmore/bewijs.pcert1 : no_pcert = 0
-deduction/passmore/bewijs.pcert1 : deduction/passmore/bewijs.pcert0
-deduction/passmore/bewijs.cert : | deduction/passmore/bewijs.pcert1
-
-deduction/passmore/general.pcert0 : no_pcert = 0
-deduction/passmore/general.pcert0 : acl2x = 0
-deduction/passmore/general.pcert0 : \
-     deduction/passmore/general.lisp
-deduction/passmore/general.pcert1 : acl2x = 0
-deduction/passmore/general.pcert1 : no_pcert = 0
-deduction/passmore/general.pcert1 : deduction/passmore/general.pcert0
-deduction/passmore/general.cert : | deduction/passmore/general.pcert1
-
-deduction/passmore/paramod.pcert0 : no_pcert = 0
-deduction/passmore/paramod.pcert0 : acl2x = 0
-deduction/passmore/paramod.pcert0 : \
-     deduction/passmore/weighting.pcert0 \
-     deduction/passmore/paramod.lisp
-deduction/passmore/paramod.pcert1 : acl2x = 0
-deduction/passmore/paramod.pcert1 : no_pcert = 0
-deduction/passmore/paramod.pcert1 : deduction/passmore/paramod.pcert0
-deduction/passmore/paramod.cert : | deduction/passmore/paramod.pcert1
-
-deduction/passmore/prover.pcert0 : no_pcert = 0
-deduction/passmore/prover.pcert0 : acl2x = 0
-deduction/passmore/prover.pcert0 : \
-     deduction/passmore/general.pcert0 \
-     deduction/passmore/unification.pcert0 \
-     deduction/passmore/weighting.pcert0 \
-     deduction/passmore/resolution.pcert0 \
-     deduction/passmore/paramod.pcert0 \
-     deduction/passmore/bewijs.pcert0 \
-     deduction/passmore/prover.lisp
-deduction/passmore/prover.pcert1 : acl2x = 0
-deduction/passmore/prover.pcert1 : no_pcert = 0
-deduction/passmore/prover.pcert1 : deduction/passmore/prover.pcert0
-deduction/passmore/prover.cert : | deduction/passmore/prover.pcert1
-
-deduction/passmore/resolution.pcert0 : no_pcert = 0
-deduction/passmore/resolution.pcert0 : acl2x = 0
-deduction/passmore/resolution.pcert0 : \
-     deduction/passmore/general.pcert0 \
-     deduction/passmore/unification.pcert0 \
-     deduction/passmore/weighting.pcert0 \
-     deduction/passmore/resolution.lisp
-deduction/passmore/resolution.pcert1 : acl2x = 0
-deduction/passmore/resolution.pcert1 : no_pcert = 0
-deduction/passmore/resolution.pcert1 : deduction/passmore/resolution.pcert0
-deduction/passmore/resolution.cert : | deduction/passmore/resolution.pcert1
-
-deduction/passmore/unification.pcert0 : no_pcert = 0
-deduction/passmore/unification.pcert0 : acl2x = 0
-deduction/passmore/unification.pcert0 : \
-     deduction/passmore/general.pcert0 \
-     deduction/passmore/unification.lisp
-deduction/passmore/unification.pcert1 : acl2x = 0
-deduction/passmore/unification.pcert1 : no_pcert = 0
-deduction/passmore/unification.pcert1 : deduction/passmore/unification.pcert0
-deduction/passmore/unification.cert : | deduction/passmore/unification.pcert1
-
-deduction/passmore/weighting.pcert0 : no_pcert = 0
-deduction/passmore/weighting.pcert0 : acl2x = 0
-deduction/passmore/weighting.pcert0 : \
-     deduction/passmore/unification.pcert0 \
-     deduction/passmore/weighting.lisp
-deduction/passmore/weighting.pcert1 : acl2x = 0
-deduction/passmore/weighting.pcert1 : no_pcert = 0
-deduction/passmore/weighting.pcert1 : deduction/passmore/weighting.pcert0
-deduction/passmore/weighting.cert : | deduction/passmore/weighting.pcert1
-
-defexec/dag-unification/basic.pcert0 : no_pcert = 0
-defexec/dag-unification/basic.pcert0 : acl2x = 0
-defexec/dag-unification/basic.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     defexec/dag-unification/basic.lisp
-defexec/dag-unification/basic.pcert1 : acl2x = 0
-defexec/dag-unification/basic.pcert1 : no_pcert = 0
-defexec/dag-unification/basic.pcert1 : defexec/dag-unification/basic.pcert0
-defexec/dag-unification/basic.cert : | defexec/dag-unification/basic.pcert1
-
-defexec/dag-unification/dag-unification-l.pcert0 : no_pcert = 0
-defexec/dag-unification/dag-unification-l.pcert0 : acl2x = 0
-defexec/dag-unification/dag-unification-l.pcert0 : \
-     defexec/dag-unification/dag-unification-rules.pcert0 \
-     defexec/dag-unification/terms-as-dag.pcert0 \
-     defexec/dag-unification/dag-unification-l.lisp
-defexec/dag-unification/dag-unification-l.pcert1 : acl2x = 0
-defexec/dag-unification/dag-unification-l.pcert1 : no_pcert = 0
-defexec/dag-unification/dag-unification-l.pcert1 : defexec/dag-unification/dag-unification-l.pcert0
-defexec/dag-unification/dag-unification-l.cert : | defexec/dag-unification/dag-unification-l.pcert1
-
-defexec/dag-unification/dag-unification-rules.pcert0 : no_pcert = 0
-defexec/dag-unification/dag-unification-rules.pcert0 : acl2x = 0
-defexec/dag-unification/dag-unification-rules.pcert0 : \
-     defexec/dag-unification/dags.pcert0 \
-     defexec/dag-unification/list-unification-rules.pcert0 \
-     defexec/dag-unification/dag-unification-rules.lisp
-defexec/dag-unification/dag-unification-rules.pcert1 : acl2x = 0
-defexec/dag-unification/dag-unification-rules.pcert1 : no_pcert = 0
-defexec/dag-unification/dag-unification-rules.pcert1 : defexec/dag-unification/dag-unification-rules.pcert0
-defexec/dag-unification/dag-unification-rules.cert : | defexec/dag-unification/dag-unification-rules.pcert1
-
-defexec/dag-unification/dag-unification-st.pcert0 : no_pcert = 0
-defexec/dag-unification/dag-unification-st.pcert0 : acl2x = 0
-defexec/dag-unification/dag-unification-st.pcert0 : \
-     defexec/dag-unification/dag-unification-l.pcert0 \
-     defexec/dag-unification/terms-dag-stobj.pcert0 \
-     defexec/dag-unification/dag-unification-st.lisp
-defexec/dag-unification/dag-unification-st.pcert1 : acl2x = 0
-defexec/dag-unification/dag-unification-st.pcert1 : no_pcert = 0
-defexec/dag-unification/dag-unification-st.pcert1 : defexec/dag-unification/dag-unification-st.pcert0
-defexec/dag-unification/dag-unification-st.cert : | defexec/dag-unification/dag-unification-st.pcert1
-
-defexec/dag-unification/dags.pcert0 : no_pcert = 0
-defexec/dag-unification/dags.pcert0 : acl2x = 0
-defexec/dag-unification/dags.pcert0 : \
-     defexec/dag-unification/basic.pcert0 \
-     defexec/dag-unification/dags.lisp
-defexec/dag-unification/dags.pcert1 : acl2x = 0
-defexec/dag-unification/dags.pcert1 : no_pcert = 0
-defexec/dag-unification/dags.pcert1 : defexec/dag-unification/dags.pcert0
-defexec/dag-unification/dags.cert : | defexec/dag-unification/dags.pcert1
-
-defexec/dag-unification/list-unification-rules.pcert0 : no_pcert = 0
-defexec/dag-unification/list-unification-rules.pcert0 : acl2x = 0
-defexec/dag-unification/list-unification-rules.pcert0 : \
-     defexec/dag-unification/subsumption-subst.pcert0 \
-     defexec/dag-unification/list-unification-rules.lisp
-defexec/dag-unification/list-unification-rules.pcert1 : acl2x = 0
-defexec/dag-unification/list-unification-rules.pcert1 : no_pcert = 0
-defexec/dag-unification/list-unification-rules.pcert1 : defexec/dag-unification/list-unification-rules.pcert0
-defexec/dag-unification/list-unification-rules.cert : | defexec/dag-unification/list-unification-rules.pcert1
-
-defexec/dag-unification/matching.pcert0 : no_pcert = 0
-defexec/dag-unification/matching.pcert0 : acl2x = 0
-defexec/dag-unification/matching.pcert0 : \
-     defexec/dag-unification/terms.pcert0 \
-     defexec/dag-unification/matching.lisp
-defexec/dag-unification/matching.pcert1 : acl2x = 0
-defexec/dag-unification/matching.pcert1 : no_pcert = 0
-defexec/dag-unification/matching.pcert1 : defexec/dag-unification/matching.pcert0
-defexec/dag-unification/matching.cert : | defexec/dag-unification/matching.pcert1
-
-defexec/dag-unification/subsumption-subst.pcert0 : no_pcert = 0
-defexec/dag-unification/subsumption-subst.pcert0 : acl2x = 0
-defexec/dag-unification/subsumption-subst.pcert0 : \
-     defexec/dag-unification/subsumption.pcert0 \
-     defexec/dag-unification/subsumption-subst.lisp
-defexec/dag-unification/subsumption-subst.pcert1 : acl2x = 0
-defexec/dag-unification/subsumption-subst.pcert1 : no_pcert = 0
-defexec/dag-unification/subsumption-subst.pcert1 : defexec/dag-unification/subsumption-subst.pcert0
-defexec/dag-unification/subsumption-subst.cert : | defexec/dag-unification/subsumption-subst.pcert1
-
-defexec/dag-unification/subsumption.pcert0 : no_pcert = 0
-defexec/dag-unification/subsumption.pcert0 : acl2x = 0
-defexec/dag-unification/subsumption.pcert0 : \
-     defexec/dag-unification/matching.pcert0 \
-     defexec/dag-unification/terms.pcert0 \
-     defexec/dag-unification/subsumption.lisp
-defexec/dag-unification/subsumption.pcert1 : acl2x = 0
-defexec/dag-unification/subsumption.pcert1 : no_pcert = 0
-defexec/dag-unification/subsumption.pcert1 : defexec/dag-unification/subsumption.pcert0
-defexec/dag-unification/subsumption.cert : | defexec/dag-unification/subsumption.pcert1
-
-defexec/dag-unification/terms-as-dag.pcert0 : no_pcert = 0
-defexec/dag-unification/terms-as-dag.pcert0 : acl2x = 0
-defexec/dag-unification/terms-as-dag.pcert0 : \
-     defexec/dag-unification/dag-unification-rules.pcert0 \
-     defexec/dag-unification/terms-as-dag.lisp
-defexec/dag-unification/terms-as-dag.pcert1 : acl2x = 0
-defexec/dag-unification/terms-as-dag.pcert1 : no_pcert = 0
-defexec/dag-unification/terms-as-dag.pcert1 : defexec/dag-unification/terms-as-dag.pcert0
-defexec/dag-unification/terms-as-dag.cert : | defexec/dag-unification/terms-as-dag.pcert1
-
-defexec/dag-unification/terms-dag-stobj.pcert0 : no_pcert = 0
-defexec/dag-unification/terms-dag-stobj.pcert0 : acl2x = 0
-defexec/dag-unification/terms-dag-stobj.pcert0 : \
-     defexec/dag-unification/dag-unification-rules.pcert0 \
-     defexec/dag-unification/terms-dag-stobj.lisp
-defexec/dag-unification/terms-dag-stobj.pcert1 : acl2x = 0
-defexec/dag-unification/terms-dag-stobj.pcert1 : no_pcert = 0
-defexec/dag-unification/terms-dag-stobj.pcert1 : defexec/dag-unification/terms-dag-stobj.pcert0
-defexec/dag-unification/terms-dag-stobj.cert : | defexec/dag-unification/terms-dag-stobj.pcert1
-
-defexec/dag-unification/terms.pcert0 : no_pcert = 0
-defexec/dag-unification/terms.pcert0 : acl2x = 0
-defexec/dag-unification/terms.pcert0 : \
-     defexec/dag-unification/basic.pcert0 \
-     defexec/dag-unification/terms.lisp
-defexec/dag-unification/terms.pcert1 : acl2x = 0
-defexec/dag-unification/terms.pcert1 : no_pcert = 0
-defexec/dag-unification/terms.pcert1 : defexec/dag-unification/terms.pcert0
-defexec/dag-unification/terms.cert : | defexec/dag-unification/terms.pcert1
-
-defexec/defpun-exec/defpun-exec.pcert0 : no_pcert = 0
-defexec/defpun-exec/defpun-exec.pcert0 : acl2x = 0
-defexec/defpun-exec/defpun-exec.pcert0 : \
-     misc/defpun.pcert0 \
-     defexec/defpun-exec/defpun-exec.lisp
-defexec/defpun-exec/defpun-exec.pcert1 : acl2x = 0
-defexec/defpun-exec/defpun-exec.pcert1 : no_pcert = 0
-defexec/defpun-exec/defpun-exec.pcert1 : defexec/defpun-exec/defpun-exec.pcert0
-defexec/defpun-exec/defpun-exec.cert : | defexec/defpun-exec/defpun-exec.pcert1
-
-defexec/find-path/fpst.pcert0 : no_pcert = 0
-defexec/find-path/fpst.pcert0 : acl2x = 0
-defexec/find-path/fpst.pcert0 : \
-     defexec/find-path/graph/linear-find-path.pcert0 \
-     defexec/find-path/fpst.lisp
-defexec/find-path/fpst.pcert1 : acl2x = 0
-defexec/find-path/fpst.pcert1 : no_pcert = 0
-defexec/find-path/fpst.pcert1 : defexec/find-path/fpst.pcert0
-defexec/find-path/fpst.cert : | defexec/find-path/fpst.pcert1
-
-defexec/find-path/graph/find-path1.pcert0 : no_pcert = 0
-defexec/find-path/graph/find-path1.pcert0 : acl2x = 0
-defexec/find-path/graph/find-path1.pcert0 : \
-     arithmetic/top.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     defexec/find-path/graph/find-path1.lisp
-defexec/find-path/graph/find-path1.pcert1 : acl2x = 0
-defexec/find-path/graph/find-path1.pcert1 : no_pcert = 0
-defexec/find-path/graph/find-path1.pcert1 : defexec/find-path/graph/find-path1.pcert0
-defexec/find-path/graph/find-path1.cert : | defexec/find-path/graph/find-path1.pcert1
-
-defexec/find-path/graph/find-path2.pcert0 : no_pcert = 0
-defexec/find-path/graph/find-path2.pcert0 : acl2x = 0
-defexec/find-path/graph/find-path2.pcert0 : \
-     arithmetic/top.pcert0 \
-     defexec/find-path/graph/helpers.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     defexec/find-path/graph/find-path2.lisp
-defexec/find-path/graph/find-path2.pcert1 : acl2x = 0
-defexec/find-path/graph/find-path2.pcert1 : no_pcert = 0
-defexec/find-path/graph/find-path2.pcert1 : defexec/find-path/graph/find-path2.pcert0
-defexec/find-path/graph/find-path2.cert : | defexec/find-path/graph/find-path2.pcert1
-
-defexec/find-path/graph/find-path3.pcert0 : no_pcert = 0
-defexec/find-path/graph/find-path3.pcert0 : acl2x = 0
-defexec/find-path/graph/find-path3.pcert0 : \
-     arithmetic/top.pcert0 \
-     defexec/find-path/graph/helpers.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     defexec/find-path/graph/find-path3.lisp
-defexec/find-path/graph/find-path3.pcert1 : acl2x = 0
-defexec/find-path/graph/find-path3.pcert1 : no_pcert = 0
-defexec/find-path/graph/find-path3.pcert1 : defexec/find-path/graph/find-path3.pcert0
-defexec/find-path/graph/find-path3.cert : | defexec/find-path/graph/find-path3.pcert1
-
-defexec/find-path/graph/helpers.pcert0 : no_pcert = 0
-defexec/find-path/graph/helpers.pcert0 : acl2x = 0
-defexec/find-path/graph/helpers.pcert0 : \
-     defexec/find-path/graph/helpers.lisp
-defexec/find-path/graph/helpers.pcert1 : acl2x = 0
-defexec/find-path/graph/helpers.pcert1 : no_pcert = 0
-defexec/find-path/graph/helpers.pcert1 : defexec/find-path/graph/helpers.pcert0
-defexec/find-path/graph/helpers.cert : | defexec/find-path/graph/helpers.pcert1
-
-defexec/find-path/graph/linear-find-path.pcert0 : no_pcert = 0
-defexec/find-path/graph/linear-find-path.pcert0 : acl2x = 0
-defexec/find-path/graph/linear-find-path.pcert0 : \
-     defexec/find-path/graph/find-path3.pcert0 \
-     defexec/find-path/graph/linear-find-path.lisp
-defexec/find-path/graph/linear-find-path.pcert1 : acl2x = 0
-defexec/find-path/graph/linear-find-path.pcert1 : no_pcert = 0
-defexec/find-path/graph/linear-find-path.pcert1 : defexec/find-path/graph/linear-find-path.pcert0
-defexec/find-path/graph/linear-find-path.cert : | defexec/find-path/graph/linear-find-path.pcert1
-
-defexec/find-path/run-fpst.pcert0 : no_pcert = 0
-defexec/find-path/run-fpst.pcert0 : acl2x = 0
-defexec/find-path/run-fpst.pcert0 : \
-     defexec/find-path/fpst.pcert0 \
-     defexec/find-path/run-fpst.lisp
-defexec/find-path/run-fpst.pcert1 : acl2x = 0
-defexec/find-path/run-fpst.pcert1 : no_pcert = 0
-defexec/find-path/run-fpst.pcert1 : defexec/find-path/run-fpst.pcert0
-defexec/find-path/run-fpst.cert : | defexec/find-path/run-fpst.pcert1
-
-defexec/ordinals/supporting-ordinals.pcert0 : no_pcert = 0
-defexec/ordinals/supporting-ordinals.pcert0 : acl2x = 0
-defexec/ordinals/supporting-ordinals.pcert0 : \
-     ordinals/ordinals.pcert0 \
-     defexec/ordinals/supporting-ordinals.lisp
-defexec/ordinals/supporting-ordinals.pcert1 : acl2x = 0
-defexec/ordinals/supporting-ordinals.pcert1 : no_pcert = 0
-defexec/ordinals/supporting-ordinals.pcert1 : defexec/ordinals/supporting-ordinals.pcert0
-defexec/ordinals/supporting-ordinals.cert : | defexec/ordinals/supporting-ordinals.pcert1
-
-defexec/other-apps/misc/memos.pcert0 : no_pcert = 0
-defexec/other-apps/misc/memos.pcert0 : acl2x = 0
-defexec/other-apps/misc/memos.pcert0 : \
-     defexec/other-apps/misc/memos.lisp
-defexec/other-apps/misc/memos.pcert1 : acl2x = 0
-defexec/other-apps/misc/memos.pcert1 : no_pcert = 0
-defexec/other-apps/misc/memos.pcert1 : defexec/other-apps/misc/memos.pcert0
-defexec/other-apps/misc/memos.cert : | defexec/other-apps/misc/memos.pcert1
-
-defexec/other-apps/misc/stobjsim.pcert0 : no_pcert = 0
-defexec/other-apps/misc/stobjsim.pcert0 : acl2x = 0
-defexec/other-apps/misc/stobjsim.pcert0 : \
-     defexec/other-apps/misc/stobjsim.lisp
-defexec/other-apps/misc/stobjsim.pcert1 : acl2x = 0
-defexec/other-apps/misc/stobjsim.pcert1 : no_pcert = 0
-defexec/other-apps/misc/stobjsim.pcert1 : defexec/other-apps/misc/stobjsim.pcert0
-defexec/other-apps/misc/stobjsim.cert : | defexec/other-apps/misc/stobjsim.pcert1
-
-defexec/other-apps/qsort/extraction.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/extraction.pcert0 : acl2x = 0
-defexec/other-apps/qsort/extraction.pcert0 : \
-     defexec/other-apps/qsort/programs.pcert0 \
-     defexec/other-apps/qsort/intermediate-program.pcert0 \
-     defexec/other-apps/qsort/first-last.pcert0 \
-     defexec/other-apps/qsort/extraction.lisp
-defexec/other-apps/qsort/extraction.pcert1 : acl2x = 0
-defexec/other-apps/qsort/extraction.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/extraction.pcert1 : defexec/other-apps/qsort/extraction.pcert0
-defexec/other-apps/qsort/extraction.cert : | defexec/other-apps/qsort/extraction.pcert1
-
-defexec/other-apps/qsort/final-theorem.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/final-theorem.pcert0 : acl2x = 0
-defexec/other-apps/qsort/final-theorem.pcert0 : \
-     defexec/other-apps/qsort/sort-qs-properties.pcert0 \
-     defexec/other-apps/qsort/load-extract.pcert0 \
-     defexec/other-apps/qsort/final-theorem.lisp
-defexec/other-apps/qsort/final-theorem.pcert1 : acl2x = 0
-defexec/other-apps/qsort/final-theorem.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/final-theorem.pcert1 : defexec/other-apps/qsort/final-theorem.pcert0
-defexec/other-apps/qsort/final-theorem.cert : | defexec/other-apps/qsort/final-theorem.pcert1
-
-defexec/other-apps/qsort/first-last.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/first-last.pcert0 : acl2x = 0
-defexec/other-apps/qsort/first-last.pcert0 : \
-     defexec/other-apps/qsort/programs.pcert0 \
-     defexec/other-apps/qsort/first-last.lisp
-defexec/other-apps/qsort/first-last.pcert1 : acl2x = 0
-defexec/other-apps/qsort/first-last.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/first-last.pcert1 : defexec/other-apps/qsort/first-last.pcert0
-defexec/other-apps/qsort/first-last.cert : | defexec/other-apps/qsort/first-last.pcert1
-
-defexec/other-apps/qsort/intermediate-program.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/intermediate-program.pcert0 : acl2x = 0
-defexec/other-apps/qsort/intermediate-program.pcert0 : \
-     defexec/other-apps/qsort/total-order.pcert0 \
-     defexec/other-apps/qsort/permutations.pcert0 \
-     defexec/other-apps/qsort/intermediate-program.lisp
-defexec/other-apps/qsort/intermediate-program.pcert1 : acl2x = 0
-defexec/other-apps/qsort/intermediate-program.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/intermediate-program.pcert1 : defexec/other-apps/qsort/intermediate-program.pcert0
-defexec/other-apps/qsort/intermediate-program.cert : | defexec/other-apps/qsort/intermediate-program.pcert1
-
-defexec/other-apps/qsort/intermediate-to-spec.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/intermediate-to-spec.pcert0 : acl2x = 0
-defexec/other-apps/qsort/intermediate-to-spec.pcert0 : \
-     defexec/other-apps/qsort/intermediate-program.pcert0 \
-     defexec/other-apps/qsort/spec-properties.pcert0 \
-     defexec/other-apps/qsort/intermediate-to-spec.lisp
-defexec/other-apps/qsort/intermediate-to-spec.pcert1 : acl2x = 0
-defexec/other-apps/qsort/intermediate-to-spec.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/intermediate-to-spec.pcert1 : defexec/other-apps/qsort/intermediate-to-spec.pcert0
-defexec/other-apps/qsort/intermediate-to-spec.cert : | defexec/other-apps/qsort/intermediate-to-spec.pcert1
-
-defexec/other-apps/qsort/load-extract.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/load-extract.pcert0 : acl2x = 0
-defexec/other-apps/qsort/load-extract.pcert0 : \
-     defexec/other-apps/qsort/programs.pcert0 \
-     defexec/other-apps/qsort/first-last.pcert0 \
-     defexec/other-apps/qsort/extraction.pcert0 \
-     defexec/other-apps/qsort/load-extract.lisp
-defexec/other-apps/qsort/load-extract.pcert1 : acl2x = 0
-defexec/other-apps/qsort/load-extract.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/load-extract.pcert1 : defexec/other-apps/qsort/load-extract.pcert0
-defexec/other-apps/qsort/load-extract.cert : | defexec/other-apps/qsort/load-extract.pcert1
-
-defexec/other-apps/qsort/merge-intermediate.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/merge-intermediate.pcert0 : acl2x = 0
-defexec/other-apps/qsort/merge-intermediate.pcert0 : \
-     defexec/other-apps/qsort/programs.pcert0 \
-     defexec/other-apps/qsort/intermediate-to-spec.pcert0 \
-     defexec/other-apps/qsort/first-last.pcert0 \
-     defexec/other-apps/qsort/merge-intermediate.lisp
-defexec/other-apps/qsort/merge-intermediate.pcert1 : acl2x = 0
-defexec/other-apps/qsort/merge-intermediate.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/merge-intermediate.pcert1 : defexec/other-apps/qsort/merge-intermediate.pcert0
-defexec/other-apps/qsort/merge-intermediate.cert : | defexec/other-apps/qsort/merge-intermediate.pcert1
-
-defexec/other-apps/qsort/nth-update-nth.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/nth-update-nth.pcert0 : acl2x = 0
-defexec/other-apps/qsort/nth-update-nth.pcert0 : \
-     defexec/other-apps/qsort/nth-update-nth.lisp
-defexec/other-apps/qsort/nth-update-nth.pcert1 : acl2x = 0
-defexec/other-apps/qsort/nth-update-nth.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/nth-update-nth.pcert1 : defexec/other-apps/qsort/nth-update-nth.pcert0
-defexec/other-apps/qsort/nth-update-nth.cert : | defexec/other-apps/qsort/nth-update-nth.pcert1
-
-defexec/other-apps/qsort/permutations.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/permutations.pcert0 : acl2x = 0
-defexec/other-apps/qsort/permutations.pcert0 : \
-     defexec/other-apps/qsort/permutations.lisp
-defexec/other-apps/qsort/permutations.pcert1 : acl2x = 0
-defexec/other-apps/qsort/permutations.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/permutations.pcert1 : defexec/other-apps/qsort/permutations.pcert0
-defexec/other-apps/qsort/permutations.cert : | defexec/other-apps/qsort/permutations.pcert1
-
-defexec/other-apps/qsort/programs.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/programs.pcert0 : acl2x = 0
-defexec/other-apps/qsort/programs.pcert0 : \
-     defexec/other-apps/qsort/total-order.pcert0 \
-     defexec/other-apps/qsort/nth-update-nth.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     defexec/other-apps/qsort/programs.lisp
-defexec/other-apps/qsort/programs.pcert1 : acl2x = 0
-defexec/other-apps/qsort/programs.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/programs.pcert1 : defexec/other-apps/qsort/programs.pcert0
-defexec/other-apps/qsort/programs.cert : | defexec/other-apps/qsort/programs.pcert1
-
-defexec/other-apps/qsort/sort-qs-properties.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/sort-qs-properties.pcert0 : acl2x = 0
-defexec/other-apps/qsort/sort-qs-properties.pcert0 : \
-     defexec/other-apps/qsort/split-qs-properties.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     defexec/other-apps/qsort/load-extract.pcert0 \
-     defexec/other-apps/qsort/sort-qs-properties.lisp
-defexec/other-apps/qsort/sort-qs-properties.pcert1 : acl2x = 0
-defexec/other-apps/qsort/sort-qs-properties.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/sort-qs-properties.pcert1 : defexec/other-apps/qsort/sort-qs-properties.pcert0
-defexec/other-apps/qsort/sort-qs-properties.cert : | defexec/other-apps/qsort/sort-qs-properties.pcert1
-
-defexec/other-apps/qsort/spec-properties.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/spec-properties.pcert0 : acl2x = 0
-defexec/other-apps/qsort/spec-properties.pcert0 : \
-     defexec/other-apps/qsort/programs.pcert0 \
-     defexec/other-apps/qsort/permutations.pcert0 \
-     defexec/other-apps/qsort/spec-properties.lisp
-defexec/other-apps/qsort/spec-properties.pcert1 : acl2x = 0
-defexec/other-apps/qsort/spec-properties.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/spec-properties.pcert1 : defexec/other-apps/qsort/spec-properties.pcert0
-defexec/other-apps/qsort/spec-properties.cert : | defexec/other-apps/qsort/spec-properties.pcert1
-
-defexec/other-apps/qsort/split-qs-properties.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/split-qs-properties.pcert0 : acl2x = 0
-defexec/other-apps/qsort/split-qs-properties.pcert0 : \
-     defexec/other-apps/qsort/programs.pcert0 \
-     defexec/other-apps/qsort/merge-intermediate.pcert0 \
-     defexec/other-apps/qsort/extraction.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     defexec/other-apps/qsort/split-qs-properties.lisp
-defexec/other-apps/qsort/split-qs-properties.pcert1 : acl2x = 0
-defexec/other-apps/qsort/split-qs-properties.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/split-qs-properties.pcert1 : defexec/other-apps/qsort/split-qs-properties.pcert0
-defexec/other-apps/qsort/split-qs-properties.cert : | defexec/other-apps/qsort/split-qs-properties.pcert1
-
-defexec/other-apps/qsort/total-order.pcert0 : no_pcert = 0
-defexec/other-apps/qsort/total-order.pcert0 : acl2x = 0
-defexec/other-apps/qsort/total-order.pcert0 : \
-     defexec/other-apps/qsort/total-order.lisp
-defexec/other-apps/qsort/total-order.pcert1 : acl2x = 0
-defexec/other-apps/qsort/total-order.pcert1 : no_pcert = 0
-defexec/other-apps/qsort/total-order.pcert1 : defexec/other-apps/qsort/total-order.pcert0
-defexec/other-apps/qsort/total-order.cert : | defexec/other-apps/qsort/total-order.pcert1
-
-defexec/other-apps/records/inline.pcert0 : no_pcert = 0
-defexec/other-apps/records/inline.pcert0 : acl2x = 0
-defexec/other-apps/records/inline.pcert0 : \
-     defexec/other-apps/records/inline.lisp
-defexec/other-apps/records/inline.pcert1 : acl2x = 0
-defexec/other-apps/records/inline.pcert1 : no_pcert = 0
-defexec/other-apps/records/inline.pcert1 : defexec/other-apps/records/inline.pcert0
-defexec/other-apps/records/inline.cert : | defexec/other-apps/records/inline.pcert1
-
-defexec/other-apps/records/records-bsd.pcert0 : no_pcert = 0
-defexec/other-apps/records/records-bsd.pcert0 : acl2x = 0
-defexec/other-apps/records/records-bsd.pcert0 : \
-     misc/total-order-bsd.pcert0 \
-     defexec/other-apps/records/records-bsd.lisp
-defexec/other-apps/records/records-bsd.pcert1 : acl2x = 0
-defexec/other-apps/records/records-bsd.pcert1 : no_pcert = 0
-defexec/other-apps/records/records-bsd.pcert1 : defexec/other-apps/records/records-bsd.pcert0
-defexec/other-apps/records/records-bsd.cert : | defexec/other-apps/records/records-bsd.pcert1
-
-defexec/other-apps/records/records.pcert0 : no_pcert = 0
-defexec/other-apps/records/records.pcert0 : acl2x = 0
-defexec/other-apps/records/records.pcert0 : \
-     misc/total-order.pcert0 \
-     defexec/other-apps/records/records.lisp
-defexec/other-apps/records/records.pcert1 : acl2x = 0
-defexec/other-apps/records/records.pcert1 : no_pcert = 0
-defexec/other-apps/records/records.pcert1 : defexec/other-apps/records/records.pcert0
-defexec/other-apps/records/records.cert : | defexec/other-apps/records/records.pcert1
-
-defexec/other-apps/records/recordsim.pcert0 : no_pcert = 0
-defexec/other-apps/records/recordsim.pcert0 : acl2x = 0
-defexec/other-apps/records/recordsim.pcert0 : \
-     defexec/other-apps/records/records.pcert0 \
-     defexec/other-apps/records/inline.pcert0 \
-     defexec/other-apps/records/recordsim.lisp
-defexec/other-apps/records/recordsim.pcert1 : acl2x = 0
-defexec/other-apps/records/recordsim.pcert1 : no_pcert = 0
-defexec/other-apps/records/recordsim.pcert1 : defexec/other-apps/records/recordsim.pcert0
-defexec/other-apps/records/recordsim.cert : | defexec/other-apps/records/recordsim.pcert1
-
-defexec/reflexive/reflexive.pcert0 : no_pcert = 0
-defexec/reflexive/reflexive.pcert0 : acl2x = 0
-defexec/reflexive/reflexive.pcert0 : \
-     misc/eval.pcert0 \
-     defexec/reflexive/reflexive.lisp
-defexec/reflexive/reflexive.pcert1 : acl2x = 0
-defexec/reflexive/reflexive.pcert1 : no_pcert = 0
-defexec/reflexive/reflexive.pcert1 : defexec/reflexive/reflexive.pcert0
-defexec/reflexive/reflexive.cert : | defexec/reflexive/reflexive.pcert1
-
-defsort/defsort.pcert0 : no_pcert = 0
-defsort/defsort.pcert0 : acl2x = 0
-defsort/defsort.pcert0 : \
-     defsort/generic.pcert0 \
-     defsort/defsort.lisp
-defsort/defsort.pcert1 : acl2x = 0
-defsort/defsort.pcert1 : no_pcert = 0
-defsort/defsort.pcert1 : defsort/defsort.pcert0
-defsort/defsort.cert : | defsort/defsort.pcert1
-
-defsort/duplicated-members.pcert0 : no_pcert = 0
-defsort/duplicated-members.pcert0 : acl2x = 0
-defsort/duplicated-members.pcert0 : \
-     defsort/uniquep.pcert0 \
-     defsort/duplicity.pcert0 \
-     defsort/duplicated-members.lisp
-defsort/duplicated-members.pcert1 : acl2x = 0
-defsort/duplicated-members.pcert1 : no_pcert = 0
-defsort/duplicated-members.pcert1 : defsort/duplicated-members.pcert0
-defsort/duplicated-members.cert : | defsort/duplicated-members.pcert1
-
-defsort/duplicity.pcert0 : no_pcert = 0
-defsort/duplicity.pcert0 : acl2x = 0
-defsort/duplicity.pcert0 : \
-     defsort/duplicity.lisp
-defsort/duplicity.pcert1 : acl2x = 0
-defsort/duplicity.pcert1 : no_pcert = 0
-defsort/duplicity.pcert1 : defsort/duplicity.pcert0
-defsort/duplicity.cert : | defsort/duplicity.pcert1
-
-defsort/examples.pcert0 : no_pcert = 0
-defsort/examples.pcert0 : acl2x = 0
-defsort/examples.pcert0 : \
-     defsort/defsort.pcert0 \
-     misc/total-order.pcert0 \
-     misc/assert.pcert0 \
-     defsort/examples.lisp
-defsort/examples.pcert1 : acl2x = 0
-defsort/examples.pcert1 : no_pcert = 0
-defsort/examples.pcert1 : defsort/examples.pcert0
-defsort/examples.cert : | defsort/examples.pcert1
-
-defsort/generic-impl.pcert0 : no_pcert = 0
-defsort/generic-impl.pcert0 : acl2x = 0
-defsort/generic-impl.pcert0 : \
-     std/lists/take.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     std/lists/list-fix.pcert0 \
-     defsort/duplicity.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     defsort/generic-impl.lisp
-defsort/generic-impl.pcert1 : acl2x = 0
-defsort/generic-impl.pcert1 : no_pcert = 0
-defsort/generic-impl.pcert1 : defsort/generic-impl.pcert0
-defsort/generic-impl.cert : | defsort/generic-impl.pcert1
-
-defsort/generic.pcert0 : no_pcert = 0
-defsort/generic.pcert0 : acl2x = 0
-defsort/generic.pcert0 : \
-     defsort/generic-impl.pcert0 \
-     defsort/generic.lisp
-defsort/generic.pcert1 : acl2x = 0
-defsort/generic.pcert1 : no_pcert = 0
-defsort/generic.pcert1 : defsort/generic.pcert0
-defsort/generic.cert : | defsort/generic.pcert1
-
-defsort/remove-dups.pcert0 : no_pcert = 0
-defsort/remove-dups.pcert0 : acl2x = 0
-defsort/remove-dups.pcert0 : \
-     defsort/uniquep.pcert0 \
-     misc/hons-help.pcert0 \
-     defsort/remove-dups.lisp
-defsort/remove-dups.pcert1 : acl2x = 0
-defsort/remove-dups.pcert1 : no_pcert = 0
-defsort/remove-dups.pcert1 : defsort/remove-dups.pcert0
-defsort/remove-dups.cert : | defsort/remove-dups.pcert1
-
-defsort/uniquep.pcert0 : no_pcert = 0
-defsort/uniquep.pcert0 : acl2x = 0
-defsort/uniquep.pcert0 : \
-     defsort/defsort.pcert0 \
-     misc/total-order.pcert0 \
-     defsort/uniquep.lisp
-defsort/uniquep.pcert1 : acl2x = 0
-defsort/uniquep.pcert1 : no_pcert = 0
-defsort/uniquep.pcert1 : defsort/uniquep.pcert0
-defsort/uniquep.cert : | defsort/uniquep.pcert1
-
-demos/list-theory.pcert0 : no_pcert = 0
-demos/list-theory.pcert0 : acl2x = 0
-demos/list-theory.pcert0 : \
-     demos/list-theory.lisp
-demos/list-theory.pcert1 : acl2x = 0
-demos/list-theory.pcert1 : no_pcert = 0
-demos/list-theory.pcert1 : demos/list-theory.pcert0
-demos/list-theory.cert : | demos/list-theory.pcert1
-
-demos/modeling/memories.pcert0 : no_pcert = 0
-demos/modeling/memories.pcert0 : acl2x = 0
-demos/modeling/memories.pcert0 : \
-     defexec/other-apps/records/records.pcert0 \
-     cutil/defalist.pcert0 \
-     misc/defun-plus.pcert0 \
-     cutil/portcullis.pcert0 \
-     demos/modeling/memories.lisp \
-     demos/modeling/cert.acl2
-demos/modeling/memories.pcert1 : acl2x = 0
-demos/modeling/memories.pcert1 : no_pcert = 0
-demos/modeling/memories.pcert1 : demos/modeling/memories.pcert0
-demos/modeling/memories.cert : | demos/modeling/memories.pcert1
-
-demos/modeling/network-state-basic.pcert0 : no_pcert = 0
-demos/modeling/network-state-basic.pcert0 : acl2x = 0
-demos/modeling/network-state-basic.pcert0 : \
-     make-event/eval.pcert0 \
-     cutil/portcullis.pcert0 \
-     demos/modeling/network-state-basic.lisp \
-     demos/modeling/cert.acl2
-demos/modeling/network-state-basic.pcert1 : acl2x = 0
-demos/modeling/network-state-basic.pcert1 : no_pcert = 0
-demos/modeling/network-state-basic.pcert1 : demos/modeling/network-state-basic.pcert0
-demos/modeling/network-state-basic.cert : | demos/modeling/network-state-basic.pcert1
-
-demos/modeling/network-state.pcert0 : no_pcert = 0
-demos/modeling/network-state.pcert0 : acl2x = 0
-demos/modeling/network-state.pcert0 : \
-     make-event/eval.pcert0 \
-     cutil/defaggregate.pcert0 \
-     cutil/deflist.pcert0 \
-     misc/defun-plus.pcert0 \
-     tools/bstar.pcert0 \
-     arithmetic/top.pcert0 \
-     cutil/portcullis.pcert0 \
-     demos/modeling/network-state.lisp \
-     demos/modeling/cert.acl2
-demos/modeling/network-state.pcert1 : acl2x = 0
-demos/modeling/network-state.pcert1 : no_pcert = 0
-demos/modeling/network-state.pcert1 : demos/modeling/network-state.pcert0
-demos/modeling/network-state.cert : | demos/modeling/network-state.pcert1
-
-demos/modeling/nondeterminism.pcert0 : no_pcert = 0
-demos/modeling/nondeterminism.pcert0 : acl2x = 0
-demos/modeling/nondeterminism.pcert0 : \
-     make-event/eval.pcert0 \
-     cutil/portcullis.pcert0 \
-     demos/modeling/nondeterminism.lisp \
-     demos/modeling/cert.acl2
-demos/modeling/nondeterminism.pcert1 : acl2x = 0
-demos/modeling/nondeterminism.pcert1 : no_pcert = 0
-demos/modeling/nondeterminism.pcert1 : demos/modeling/nondeterminism.pcert0
-demos/modeling/nondeterminism.cert : | demos/modeling/nondeterminism.pcert1
-
-finite-set-theory/osets/cardinality.pcert0 : no_pcert = 0
-finite-set-theory/osets/cardinality.pcert0 : acl2x = 0
-finite-set-theory/osets/cardinality.pcert0 : \
-     finite-set-theory/osets/delete.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/cardinality.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/cardinality.pcert1 : acl2x = 0
-finite-set-theory/osets/cardinality.pcert1 : no_pcert = 0
-finite-set-theory/osets/cardinality.pcert1 : finite-set-theory/osets/cardinality.pcert0
-finite-set-theory/osets/cardinality.cert : | finite-set-theory/osets/cardinality.pcert1
-
-finite-set-theory/osets/computed-hints.pcert0 : no_pcert = 0
-finite-set-theory/osets/computed-hints.pcert0 : acl2x = 0
-finite-set-theory/osets/computed-hints.pcert0 : \
-     finite-set-theory/osets/instance.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/computed-hints.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/computed-hints.pcert1 : acl2x = 0
-finite-set-theory/osets/computed-hints.pcert1 : no_pcert = 0
-finite-set-theory/osets/computed-hints.pcert1 : finite-set-theory/osets/computed-hints.pcert0
-finite-set-theory/osets/computed-hints.cert : | finite-set-theory/osets/computed-hints.pcert1
-
-finite-set-theory/osets/delete.pcert0 : no_pcert = 0
-finite-set-theory/osets/delete.pcert0 : acl2x = 0
-finite-set-theory/osets/delete.pcert0 : \
-     finite-set-theory/osets/membership.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/delete.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/delete.pcert1 : acl2x = 0
-finite-set-theory/osets/delete.pcert1 : no_pcert = 0
-finite-set-theory/osets/delete.pcert1 : finite-set-theory/osets/delete.pcert0
-finite-set-theory/osets/delete.cert : | finite-set-theory/osets/delete.pcert1
-
-finite-set-theory/osets/difference.pcert0 : no_pcert = 0
-finite-set-theory/osets/difference.pcert0 : acl2x = 0
-finite-set-theory/osets/difference.pcert0 : \
-     finite-set-theory/osets/membership.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/difference.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/difference.pcert1 : acl2x = 0
-finite-set-theory/osets/difference.pcert1 : no_pcert = 0
-finite-set-theory/osets/difference.pcert1 : finite-set-theory/osets/difference.pcert0
-finite-set-theory/osets/difference.cert : | finite-set-theory/osets/difference.pcert1
-
-finite-set-theory/osets/instance.pcert0 : no_pcert = 0
-finite-set-theory/osets/instance.pcert0 : acl2x = 0
-finite-set-theory/osets/instance.pcert0 : \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/instance.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/instance.pcert1 : acl2x = 0
-finite-set-theory/osets/instance.pcert1 : no_pcert = 0
-finite-set-theory/osets/instance.pcert1 : finite-set-theory/osets/instance.pcert0
-finite-set-theory/osets/instance.cert : | finite-set-theory/osets/instance.pcert1
-
-finite-set-theory/osets/intersect.pcert0 : no_pcert = 0
-finite-set-theory/osets/intersect.pcert0 : acl2x = 0
-finite-set-theory/osets/intersect.pcert0 : \
-     finite-set-theory/osets/membership.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/intersect.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/intersect.pcert1 : acl2x = 0
-finite-set-theory/osets/intersect.pcert1 : no_pcert = 0
-finite-set-theory/osets/intersect.pcert1 : finite-set-theory/osets/intersect.pcert0
-finite-set-theory/osets/intersect.cert : | finite-set-theory/osets/intersect.pcert1
-
-finite-set-theory/osets/map-tests.pcert0 : no_pcert = 0
-finite-set-theory/osets/map-tests.pcert0 : acl2x = 0
-finite-set-theory/osets/map-tests.pcert0 : \
-     finite-set-theory/osets/map.pcert0 \
-     misc/assert.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/map-tests.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/map-tests.pcert1 : acl2x = 0
-finite-set-theory/osets/map-tests.pcert1 : no_pcert = 0
-finite-set-theory/osets/map-tests.pcert1 : finite-set-theory/osets/map-tests.pcert0
-finite-set-theory/osets/map-tests.cert : | finite-set-theory/osets/map-tests.pcert1
-
-finite-set-theory/osets/map.pcert0 : no_pcert = 0
-finite-set-theory/osets/map.pcert0 : acl2x = 0
-finite-set-theory/osets/map.pcert0 : \
-     finite-set-theory/osets/quantify.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/map.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/map.pcert1 : acl2x = 0
-finite-set-theory/osets/map.pcert1 : no_pcert = 0
-finite-set-theory/osets/map.pcert1 : finite-set-theory/osets/map.pcert0
-finite-set-theory/osets/map.cert : | finite-set-theory/osets/map.pcert1
-
-finite-set-theory/osets/membership.pcert0 : no_pcert = 0
-finite-set-theory/osets/membership.pcert0 : acl2x = 0
-finite-set-theory/osets/membership.pcert0 : \
-     finite-set-theory/osets/primitives.pcert0 \
-     finite-set-theory/osets/computed-hints.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/membership.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/membership.pcert1 : acl2x = 0
-finite-set-theory/osets/membership.pcert1 : no_pcert = 0
-finite-set-theory/osets/membership.pcert1 : finite-set-theory/osets/membership.pcert0
-finite-set-theory/osets/membership.cert : | finite-set-theory/osets/membership.pcert1
-
-finite-set-theory/osets/outer.pcert0 : no_pcert = 0
-finite-set-theory/osets/outer.pcert0 : acl2x = 0
-finite-set-theory/osets/outer.pcert0 : \
-     finite-set-theory/osets/delete.pcert0 \
-     finite-set-theory/osets/union.pcert0 \
-     finite-set-theory/osets/intersect.pcert0 \
-     finite-set-theory/osets/difference.pcert0 \
-     finite-set-theory/osets/cardinality.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/outer.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/outer.pcert1 : acl2x = 0
-finite-set-theory/osets/outer.pcert1 : no_pcert = 0
-finite-set-theory/osets/outer.pcert1 : finite-set-theory/osets/outer.pcert0
-finite-set-theory/osets/outer.cert : | finite-set-theory/osets/outer.pcert1
-
-finite-set-theory/osets/portcullis.pcert0 : no_pcert = 0
-finite-set-theory/osets/portcullis.pcert0 : acl2x = 0
-finite-set-theory/osets/portcullis.pcert0 : \
-     finite-set-theory/osets/portcullis.lisp \
-     finite-set-theory/osets/portcullis.acl2 \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-finite-set-theory/osets/portcullis.pcert1 : acl2x = 0
-finite-set-theory/osets/portcullis.pcert1 : no_pcert = 0
-finite-set-theory/osets/portcullis.pcert1 : finite-set-theory/osets/portcullis.pcert0
-finite-set-theory/osets/portcullis.cert : | finite-set-theory/osets/portcullis.pcert1
-
-finite-set-theory/osets/primitives.pcert0 : no_pcert = 0
-finite-set-theory/osets/primitives.pcert0 : acl2x = 0
-finite-set-theory/osets/primitives.pcert0 : \
-     misc/total-order.pcert0 \
-     tools/rulesets.pcert0 \
-     xdoc/top.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/primitives.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/primitives.pcert1 : acl2x = 0
-finite-set-theory/osets/primitives.pcert1 : no_pcert = 0
-finite-set-theory/osets/primitives.pcert1 : finite-set-theory/osets/primitives.pcert0
-finite-set-theory/osets/primitives.cert : | finite-set-theory/osets/primitives.pcert1
-
-finite-set-theory/osets/quantify.pcert0 : no_pcert = 0
-finite-set-theory/osets/quantify.pcert0 : acl2x = 0
-finite-set-theory/osets/quantify.pcert0 : \
-     finite-set-theory/osets/sets.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/quantify.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/quantify.pcert1 : acl2x = 0
-finite-set-theory/osets/quantify.pcert1 : no_pcert = 0
-finite-set-theory/osets/quantify.pcert1 : finite-set-theory/osets/quantify.pcert0
-finite-set-theory/osets/quantify.cert : | finite-set-theory/osets/quantify.pcert1
-
-finite-set-theory/osets/sets.pcert0 : no_pcert = 0
-finite-set-theory/osets/sets.pcert0 : acl2x = 0
-finite-set-theory/osets/sets.pcert0 : \
-     misc/total-order.pcert0 \
-     tools/rulesets.pcert0 \
-     std/lists/list-defuns.pcert0 \
-     finite-set-theory/osets/computed-hints.pcert0 \
-     finite-set-theory/osets/primitives.pcert0 \
-     finite-set-theory/osets/membership.pcert0 \
-     finite-set-theory/osets/outer.pcert0 \
-     finite-set-theory/osets/sort.pcert0 \
-     finite-set-theory/osets/under-set-equiv.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/sets.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/sets.pcert1 : acl2x = 0
-finite-set-theory/osets/sets.pcert1 : no_pcert = 0
-finite-set-theory/osets/sets.pcert1 : finite-set-theory/osets/sets.pcert0
-finite-set-theory/osets/sets.cert : | finite-set-theory/osets/sets.pcert1
-
-finite-set-theory/osets/sort.pcert0 : no_pcert = 0
-finite-set-theory/osets/sort.pcert0 : acl2x = 0
-finite-set-theory/osets/sort.pcert0 : \
-     finite-set-theory/osets/union.pcert0 \
-     std/lists/app.pcert0 \
-     std/lists/rev.pcert0 \
-     tools/mv-nth.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/sort.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/sort.pcert1 : acl2x = 0
-finite-set-theory/osets/sort.pcert1 : no_pcert = 0
-finite-set-theory/osets/sort.pcert1 : finite-set-theory/osets/sort.pcert0
-finite-set-theory/osets/sort.cert : | finite-set-theory/osets/sort.pcert1
-
-finite-set-theory/osets/under-set-equiv.pcert0 : no_pcert = 0
-finite-set-theory/osets/under-set-equiv.pcert0 : acl2x = 0
-finite-set-theory/osets/under-set-equiv.pcert0 : \
-     finite-set-theory/osets/outer.pcert0 \
-     finite-set-theory/osets/sort.pcert0 \
-     std/lists/sets.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/under-set-equiv.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/under-set-equiv.pcert1 : acl2x = 0
-finite-set-theory/osets/under-set-equiv.pcert1 : no_pcert = 0
-finite-set-theory/osets/under-set-equiv.pcert1 : finite-set-theory/osets/under-set-equiv.pcert0
-finite-set-theory/osets/under-set-equiv.cert : | finite-set-theory/osets/under-set-equiv.pcert1
-
-finite-set-theory/osets/union.pcert0 : no_pcert = 0
-finite-set-theory/osets/union.pcert0 : acl2x = 0
-finite-set-theory/osets/union.pcert0 : \
-     finite-set-theory/osets/membership.pcert0 \
-     finite-set-theory/osets/portcullis.pcert0 \
-     finite-set-theory/osets/union.lisp \
-     finite-set-theory/osets/cert.acl2
-finite-set-theory/osets/union.pcert1 : acl2x = 0
-finite-set-theory/osets/union.pcert1 : no_pcert = 0
-finite-set-theory/osets/union.pcert1 : finite-set-theory/osets/union.pcert0
-finite-set-theory/osets/union.cert : | finite-set-theory/osets/union.pcert1
-
-finite-set-theory/set-theory.pcert0 : no_pcert = 0
-finite-set-theory/set-theory.pcert0 : acl2x = 0
-finite-set-theory/set-theory.pcert0 : \
-     finite-set-theory/total-ordering.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     finite-set-theory/set-theory.lisp \
-     finite-set-theory/set-theory.acl2
-finite-set-theory/set-theory.pcert1 : acl2x = 0
-finite-set-theory/set-theory.pcert1 : no_pcert = 0
-finite-set-theory/set-theory.pcert1 : finite-set-theory/set-theory.pcert0
-finite-set-theory/set-theory.cert : | finite-set-theory/set-theory.pcert1
-
-finite-set-theory/total-ordering.pcert0 : no_pcert = 0
-finite-set-theory/total-ordering.pcert0 : acl2x = 0
-finite-set-theory/total-ordering.pcert0 : \
-     finite-set-theory/total-ordering.lisp
-finite-set-theory/total-ordering.pcert1 : acl2x = 0
-finite-set-theory/total-ordering.pcert1 : no_pcert = 0
-finite-set-theory/total-ordering.pcert1 : finite-set-theory/total-ordering.pcert0
-finite-set-theory/total-ordering.cert : | finite-set-theory/total-ordering.pcert1
-
-hacking/all.pcert0 : no_pcert = 0
-hacking/all.pcert0 : acl2x = 0
-hacking/all.pcert0 : \
-     hacking/hacker.pcert0 \
-     hacking/defstruct-parsing.pcert0 \
-     hacking/rewrite-code.pcert0 \
-     hacking/defcode.pcert0 \
-     hacking/raw.pcert0 \
-     hacking/redefun.pcert0 \
-     hacking/bridge.pcert0 \
-     hacking/subsumption.pcert0 \
-     hacking/table-guard.pcert0 \
-     hacking/all.lisp \
-     hacking/all.acl2 \
-     hacking/hacker-pkg.lsp \
-     hacking/rewrite-code-pkg.lsp
-hacking/all.pcert1 : acl2x = 0
-hacking/all.pcert1 : no_pcert = 0
-hacking/all.pcert1 : hacking/all.pcert0
-hacking/all.cert : | hacking/all.pcert1
-
-hacking/bridge.pcert0 : no_pcert = 0
-hacking/bridge.pcert0 : acl2x = 0
-hacking/bridge.pcert0 : \
-     hacking/doc-section.pcert0 \
-     hacking/bridge.lisp \
-     hacking/bridge.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/bridge.pcert1 : acl2x = 0
-hacking/bridge.pcert1 : no_pcert = 0
-hacking/bridge.pcert1 : hacking/bridge.pcert0
-hacking/bridge.cert : | hacking/bridge.pcert1
-
-hacking/defcode.pcert0 : no_pcert = 0
-hacking/defcode.pcert0 : acl2x = 0
-hacking/defcode.pcert0 : \
-     hacking/hacker.pcert0 \
-     hacking/progn-bang-enh.pcert0 \
-     hacking/defcode.lisp \
-     hacking/defcode.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/defcode.pcert1 : acl2x = 0
-hacking/defcode.pcert1 : no_pcert = 0
-hacking/defcode.pcert1 : hacking/defcode.pcert0
-hacking/defcode.cert : | hacking/defcode.pcert1
-
-hacking/defstruct-parsing.pcert0 : no_pcert = 0
-hacking/defstruct-parsing.pcert0 : acl2x = 0
-hacking/defstruct-parsing.pcert0 : \
-     hacking/defstruct-parsing.lisp \
-     hacking/defstruct-parsing.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/defstruct-parsing.pcert1 : acl2x = 0
-hacking/defstruct-parsing.pcert1 : no_pcert = 0
-hacking/defstruct-parsing.pcert1 : hacking/defstruct-parsing.pcert0
-hacking/defstruct-parsing.cert : | hacking/defstruct-parsing.pcert1
-
-hacking/doc-section.pcert0 : no_pcert = 0
-hacking/doc-section.pcert0 : acl2x = 0
-hacking/doc-section.pcert0 : \
-     hacking/doc-section.lisp
-hacking/doc-section.pcert1 : acl2x = 0
-hacking/doc-section.pcert1 : no_pcert = 0
-hacking/doc-section.pcert1 : hacking/doc-section.pcert0
-hacking/doc-section.cert : | hacking/doc-section.pcert1
-
-hacking/dynamic-make-event-test.pcert0 : no_pcert = 0
-hacking/dynamic-make-event-test.pcert0 : acl2x = 0
-hacking/dynamic-make-event-test.pcert0 : \
-     hacking/defcode.pcert0 \
-     hacking/rewrite-code.pcert0 \
-     hacking/redefun.pcert0 \
-     hacking/dynamic-make-event.pcert0 \
-     hacking/rewrite-code.pcert0 \
-     hacking/dynamic-make-event-test.lisp \
-     hacking/dynamic-make-event-test.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/dynamic-make-event-test.pcert1 : acl2x = 0
-hacking/dynamic-make-event-test.pcert1 : no_pcert = 0
-hacking/dynamic-make-event-test.pcert1 : hacking/dynamic-make-event-test.pcert0
-hacking/dynamic-make-event-test.cert : | hacking/dynamic-make-event-test.pcert1
-
-hacking/dynamic-make-event.pcert0 : no_pcert = 0
-hacking/dynamic-make-event.pcert0 : acl2x = 0
-hacking/dynamic-make-event.pcert0 : \
-     hacking/rewrite-code.pcert0 \
-     hacking/dynamic-make-event.lisp \
-     hacking/dynamic-make-event.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/dynamic-make-event.pcert1 : acl2x = 0
-hacking/dynamic-make-event.pcert1 : no_pcert = 0
-hacking/dynamic-make-event.pcert1 : hacking/dynamic-make-event.pcert0
-hacking/dynamic-make-event.cert : | hacking/dynamic-make-event.pcert1
-
-hacking/evalable-ld-printing.pcert0 : no_pcert = 0
-hacking/evalable-ld-printing.pcert0 : acl2x = 0
-hacking/evalable-ld-printing.pcert0 : \
-     misc/evalable-printing.pcert0 \
-     hacking/hacker.pcert0 \
-     hacking/defcode.pcert0 \
-     hacking/subsumption.pcert0 \
-     hacking/raw.pcert0 \
-     hacking/evalable-ld-printing.lisp \
-     hacking/evalable-ld-printing.acl2
-hacking/evalable-ld-printing.pcert1 : acl2x = 0
-hacking/evalable-ld-printing.pcert1 : no_pcert = 0
-hacking/evalable-ld-printing.pcert1 : hacking/evalable-ld-printing.pcert0
-hacking/evalable-ld-printing.cert : | hacking/evalable-ld-printing.pcert1
-
-hacking/hacker.pcert0 : no_pcert = 0
-hacking/hacker.pcert0 : acl2x = 0
-hacking/hacker.pcert0 : \
-     hacking/doc-section.pcert0 \
-     hacking/hacker.lisp \
-     hacking/hacker.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/hacker.pcert1 : acl2x = 0
-hacking/hacker.pcert1 : no_pcert = 0
-hacking/hacker.pcert1 : hacking/hacker.pcert0
-hacking/hacker.cert : | hacking/hacker.pcert1
-
-hacking/progn-bang-enh.pcert0 : no_pcert = 0
-hacking/progn-bang-enh.pcert0 : acl2x = 0
-hacking/progn-bang-enh.pcert0 : \
-     hacking/progn-bang-enh.lisp \
-     hacking/progn-bang-enh.acl2
-hacking/progn-bang-enh.pcert1 : acl2x = 0
-hacking/progn-bang-enh.pcert1 : no_pcert = 0
-hacking/progn-bang-enh.pcert1 : hacking/progn-bang-enh.pcert0
-hacking/progn-bang-enh.cert : | hacking/progn-bang-enh.pcert1
-
-hacking/raw.pcert0 : no_pcert = 0
-hacking/raw.pcert0 : acl2x = 0
-hacking/raw.pcert0 : \
-     hacking/defstruct-parsing.pcert0 \
-     hacking/raw.lisp \
-     hacking/raw.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/raw.pcert1 : acl2x = 0
-hacking/raw.pcert1 : no_pcert = 0
-hacking/raw.pcert1 : hacking/raw.pcert0
-hacking/raw.cert : | hacking/raw.pcert1
-
-hacking/redefun.pcert0 : no_pcert = 0
-hacking/redefun.pcert0 : acl2x = 0
-hacking/redefun.pcert0 : \
-     hacking/redefun.lisp \
-     hacking/redefun.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/redefun.pcert1 : acl2x = 0
-hacking/redefun.pcert1 : no_pcert = 0
-hacking/redefun.pcert1 : hacking/redefun.pcert0
-hacking/redefun.cert : | hacking/redefun.pcert1
-
-hacking/rewrite-code.pcert0 : no_pcert = 0
-hacking/rewrite-code.pcert0 : acl2x = 0
-hacking/rewrite-code.pcert0 : \
-     hacking/rewrite-code.lisp \
-     hacking/rewrite-code.acl2 \
-     hacking/rewrite-code-pkg.lsp
-hacking/rewrite-code.pcert1 : acl2x = 0
-hacking/rewrite-code.pcert1 : no_pcert = 0
-hacking/rewrite-code.pcert1 : hacking/rewrite-code.pcert0
-hacking/rewrite-code.cert : | hacking/rewrite-code.pcert1
-
-hacking/subsumption.pcert0 : no_pcert = 0
-hacking/subsumption.pcert0 : acl2x = 0
-hacking/subsumption.pcert0 : \
-     hacking/doc-section.pcert0 \
-     hacking/subsumption.lisp \
-     hacking/subsumption.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/subsumption.pcert1 : acl2x = 0
-hacking/subsumption.pcert1 : no_pcert = 0
-hacking/subsumption.pcert1 : hacking/subsumption.pcert0
-hacking/subsumption.cert : | hacking/subsumption.pcert1
-
-hacking/table-guard.pcert0 : no_pcert = 0
-hacking/table-guard.pcert0 : acl2x = 0
-hacking/table-guard.pcert0 : \
-     hacking/defcode.pcert0 \
-     hacking/rewrite-code.pcert0 \
-     hacking/redefun.pcert0 \
-     hacking/rewrite-code.pcert0 \
-     hacking/table-guard.lisp \
-     hacking/table-guard.acl2 \
-     hacking/hacker-pkg.lsp
-hacking/table-guard.pcert1 : acl2x = 0
-hacking/table-guard.pcert1 : no_pcert = 0
-hacking/table-guard.pcert1 : hacking/table-guard.pcert0
-hacking/table-guard.cert : | hacking/table-guard.pcert1
-
-hints/basic-tests.pcert0 : no_pcert = 0
-hints/basic-tests.pcert0 : acl2x = 0
-hints/basic-tests.pcert0 : \
-     misc/eval.pcert0 \
-     hints/basic-tests.lisp \
-     hints/basic-tests.acl2
-hints/basic-tests.pcert1 : acl2x = 0
-hints/basic-tests.pcert1 : no_pcert = 0
-hints/basic-tests.pcert1 : hints/basic-tests.pcert0
-hints/basic-tests.cert : | hints/basic-tests.pcert1
-
-hints/consider-hint-tests.pcert0 : no_pcert = 0
-hints/consider-hint-tests.pcert0 : acl2x = 0
-hints/consider-hint-tests.pcert0 : \
-     hints/consider-hint.pcert0 \
-     misc/eval.pcert0 \
-     hints/consider-hint-tests.lisp \
-     hints/consider-hint-tests.acl2
-hints/consider-hint-tests.pcert1 : acl2x = 0
-hints/consider-hint-tests.pcert1 : no_pcert = 0
-hints/consider-hint-tests.pcert1 : hints/consider-hint-tests.pcert0
-hints/consider-hint-tests.cert : | hints/consider-hint-tests.pcert1
-
-hints/consider-hint.pcert0 : no_pcert = 0
-hints/consider-hint.pcert0 : acl2x = 0
-hints/consider-hint.pcert0 : \
-     hints/huet-lang-algorithm.pcert0 \
-     hints/merge-hint.pcert0 \
-     hints/consider-hint.lisp
-hints/consider-hint.pcert1 : acl2x = 0
-hints/consider-hint.pcert1 : no_pcert = 0
-hints/consider-hint.pcert1 : hints/consider-hint.pcert0
-hints/consider-hint.cert : | hints/consider-hint.pcert1
-
-hints/huet-lang-algorithm-tests.pcert0 : no_pcert = 0
-hints/huet-lang-algorithm-tests.pcert0 : acl2x = 0
-hints/huet-lang-algorithm-tests.pcert0 : \
-     hints/huet-lang-algorithm.pcert0 \
-     misc/eval.pcert0 \
-     hints/huet-lang-algorithm-tests.lisp
-hints/huet-lang-algorithm-tests.pcert1 : acl2x = 0
-hints/huet-lang-algorithm-tests.pcert1 : no_pcert = 0
-hints/huet-lang-algorithm-tests.pcert1 : hints/huet-lang-algorithm-tests.pcert0
-hints/huet-lang-algorithm-tests.cert : | hints/huet-lang-algorithm-tests.pcert1
-
-hints/huet-lang-algorithm.pcert0 : no_pcert = 0
-hints/huet-lang-algorithm.pcert0 : acl2x = 0
-hints/huet-lang-algorithm.pcert0 : \
-     hints/huet-lang-algorithm.lisp
-hints/huet-lang-algorithm.pcert1 : acl2x = 0
-hints/huet-lang-algorithm.pcert1 : no_pcert = 0
-hints/huet-lang-algorithm.pcert1 : hints/huet-lang-algorithm.pcert0
-hints/huet-lang-algorithm.cert : | hints/huet-lang-algorithm.pcert1
-
-hints/merge-hint.pcert0 : no_pcert = 0
-hints/merge-hint.pcert0 : acl2x = 0
-hints/merge-hint.pcert0 : \
-     misc/eval.pcert0 \
-     hints/merge-hint.lisp
-hints/merge-hint.pcert1 : acl2x = 0
-hints/merge-hint.pcert1 : no_pcert = 0
-hints/merge-hint.pcert1 : hints/merge-hint.pcert0
-hints/merge-hint.cert : | hints/merge-hint.pcert1
-
-ihs/@logops.pcert0 : no_pcert = 0
-ihs/@logops.pcert0 : acl2x = 0
-ihs/@logops.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     ihs/@logops.lisp
-ihs/@logops.pcert1 : acl2x = 0
-ihs/@logops.pcert1 : no_pcert = 0
-ihs/@logops.pcert1 : ihs/@logops.pcert0
-ihs/@logops.cert : | ihs/@logops.pcert1
-
-ihs/basic-definitions.pcert0 : no_pcert = 0
-ihs/basic-definitions.pcert0 : acl2x = 0
-ihs/basic-definitions.pcert0 : \
-     ihs/ihs-doc-topic.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     ihs/basic-definitions.lisp
-ihs/basic-definitions.pcert1 : acl2x = 0
-ihs/basic-definitions.pcert1 : no_pcert = 0
-ihs/basic-definitions.pcert1 : ihs/basic-definitions.pcert0
-ihs/basic-definitions.cert : | ihs/basic-definitions.pcert1
-
-ihs/ihs-definitions.pcert0 : no_pcert = 0
-ihs/ihs-definitions.pcert0 : acl2x = 0
-ihs/ihs-definitions.pcert0 : \
-     ihs/ihs-init.pcert0 \
-     ihs/ihs-theories.pcert0 \
-     ihs/logops-definitions.pcert0 \
-     ihs/ihs-definitions.lisp
-ihs/ihs-definitions.pcert1 : acl2x = 0
-ihs/ihs-definitions.pcert1 : no_pcert = 0
-ihs/ihs-definitions.pcert1 : ihs/ihs-definitions.pcert0
-ihs/ihs-definitions.cert : | ihs/ihs-definitions.pcert1
-
-ihs/ihs-doc-topic.pcert0 : no_pcert = 0
-ihs/ihs-doc-topic.pcert0 : acl2x = 0
-ihs/ihs-doc-topic.pcert0 : \
-     ihs/ihs-doc-topic.lisp
-ihs/ihs-doc-topic.pcert1 : acl2x = 0
-ihs/ihs-doc-topic.pcert1 : no_pcert = 0
-ihs/ihs-doc-topic.pcert1 : ihs/ihs-doc-topic.pcert0
-ihs/ihs-doc-topic.cert : | ihs/ihs-doc-topic.pcert1
-
-ihs/ihs-init.pcert0 : no_pcert = 0
-ihs/ihs-init.pcert0 : acl2x = 0
-ihs/ihs-init.pcert0 : \
-     ihs/ihs-doc-topic.pcert0 \
-     data-structures/utilities.pcert0 \
-     ihs/ihs-init.lisp \
-     ihs/ihs-init.acl2 \
-     data-structures/define-u-package.lsp
-ihs/ihs-init.pcert1 : acl2x = 0
-ihs/ihs-init.pcert1 : no_pcert = 0
-ihs/ihs-init.pcert1 : ihs/ihs-init.pcert0
-ihs/ihs-init.cert : | ihs/ihs-init.pcert1
-
-ihs/ihs-lemmas.pcert0 : no_pcert = 0
-ihs/ihs-lemmas.pcert0 : acl2x = 0
-ihs/ihs-lemmas.pcert0 : \
-     ihs/math-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     ihs/ihs-lemmas.lisp
-ihs/ihs-lemmas.pcert1 : acl2x = 0
-ihs/ihs-lemmas.pcert1 : no_pcert = 0
-ihs/ihs-lemmas.pcert1 : ihs/ihs-lemmas.pcert0
-ihs/ihs-lemmas.cert : | ihs/ihs-lemmas.pcert1
-
-ihs/ihs-theories.pcert0 : no_pcert = 0
-ihs/ihs-theories.pcert0 : acl2x = 0
-ihs/ihs-theories.pcert0 : \
-     ihs/ihs-init.pcert0 \
-     ihs/ihs-theories.lisp
-ihs/ihs-theories.pcert1 : acl2x = 0
-ihs/ihs-theories.pcert1 : no_pcert = 0
-ihs/ihs-theories.pcert1 : ihs/ihs-theories.pcert0
-ihs/ihs-theories.cert : | ihs/ihs-theories.pcert1
-
-ihs/logops-definitions.pcert0 : no_pcert = 0
-ihs/logops-definitions.pcert0 : acl2x = 0
-ihs/logops-definitions.pcert0 : \
-     ihs/ihs-init.pcert0 \
-     ihs/ihs-theories.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     ihs/basic-definitions.pcert0 \
-     ihs/logops-definitions.lisp
-ihs/logops-definitions.pcert1 : acl2x = 0
-ihs/logops-definitions.pcert1 : no_pcert = 0
-ihs/logops-definitions.pcert1 : ihs/logops-definitions.pcert0
-ihs/logops-definitions.cert : | ihs/logops-definitions.pcert1
-
-ihs/logops-lemmas.pcert0 : no_pcert = 0
-ihs/logops-lemmas.pcert0 : acl2x = 0
-ihs/logops-lemmas.pcert0 : \
-     ihs/ihs-init.pcert0 \
-     ihs/ihs-theories.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     ihs/logops-definitions.pcert0 \
-     ihs/logops-lemmas.lisp
-ihs/logops-lemmas.pcert1 : acl2x = 0
-ihs/logops-lemmas.pcert1 : no_pcert = 0
-ihs/logops-lemmas.pcert1 : ihs/logops-lemmas.pcert0
-ihs/logops-lemmas.cert : | ihs/logops-lemmas.pcert1
-
-ihs/math-lemmas.pcert0 : no_pcert = 0
-ihs/math-lemmas.pcert0 : acl2x = 0
-ihs/math-lemmas.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/ihs-init.pcert0 \
-     ihs/math-lemmas.lisp
-ihs/math-lemmas.pcert1 : acl2x = 0
-ihs/math-lemmas.pcert1 : no_pcert = 0
-ihs/math-lemmas.pcert1 : ihs/math-lemmas.pcert0
-ihs/math-lemmas.cert : | ihs/math-lemmas.pcert1
-
-ihs/quotient-remainder-lemmas.pcert0 : no_pcert = 0
-ihs/quotient-remainder-lemmas.pcert0 : acl2x = 0
-ihs/quotient-remainder-lemmas.pcert0 : \
-     ihs/ihs-init.pcert0 \
-     ihs/ihs-theories.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.lisp
-ihs/quotient-remainder-lemmas.pcert1 : acl2x = 0
-ihs/quotient-remainder-lemmas.pcert1 : no_pcert = 0
-ihs/quotient-remainder-lemmas.pcert1 : ihs/quotient-remainder-lemmas.pcert0
-ihs/quotient-remainder-lemmas.cert : | ihs/quotient-remainder-lemmas.pcert1
-
-leftist-trees/leftist-tree-defthms.pcert0 : no_pcert = 0
-leftist-trees/leftist-tree-defthms.pcert0 : acl2x = 0
-leftist-trees/leftist-tree-defthms.pcert0 : \
-     leftist-trees/leftist-tree-defuns.pcert0 \
-     arithmetic-5/top.pcert0 \
-     leftist-trees/leftist-tree-defthms.lisp
-leftist-trees/leftist-tree-defthms.pcert1 : acl2x = 0
-leftist-trees/leftist-tree-defthms.pcert1 : no_pcert = 0
-leftist-trees/leftist-tree-defthms.pcert1 : leftist-trees/leftist-tree-defthms.pcert0
-leftist-trees/leftist-tree-defthms.cert : | leftist-trees/leftist-tree-defthms.pcert1
-
-leftist-trees/leftist-tree-defuns.pcert0 : no_pcert = 0
-leftist-trees/leftist-tree-defuns.pcert0 : acl2x = 0
-leftist-trees/leftist-tree-defuns.pcert0 : \
-     leftist-trees/leftist-tree-defuns.lisp
-leftist-trees/leftist-tree-defuns.pcert1 : acl2x = 0
-leftist-trees/leftist-tree-defuns.pcert1 : no_pcert = 0
-leftist-trees/leftist-tree-defuns.pcert1 : leftist-trees/leftist-tree-defuns.pcert0
-leftist-trees/leftist-tree-defuns.cert : | leftist-trees/leftist-tree-defuns.pcert1
-
-leftist-trees/leftist-tree-sort-equivalent.pcert0 : no_pcert = 0
-leftist-trees/leftist-tree-sort-equivalent.pcert0 : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent.pcert0 : \
-     sorting/equisort.pcert0 \
-     sorting/isort.pcert0 \
-     leftist-trees/leftist-tree-sort.pcert0 \
-     leftist-trees/leftist-tree-sort-equivalent.lisp
-leftist-trees/leftist-tree-sort-equivalent.pcert1 : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent.pcert1 : no_pcert = 0
-leftist-trees/leftist-tree-sort-equivalent.pcert1 : leftist-trees/leftist-tree-sort-equivalent.pcert0
-leftist-trees/leftist-tree-sort-equivalent.cert : | leftist-trees/leftist-tree-sort-equivalent.pcert1
-
-leftist-trees/leftist-tree-sort-equivalent2.pcert0 : no_pcert = 0
-leftist-trees/leftist-tree-sort-equivalent2.pcert0 : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent2.pcert0 : \
-     sorting/equisort2.pcert0 \
-     sorting/isort.pcert0 \
-     leftist-trees/leftist-tree-sort.pcert0 \
-     leftist-trees/leftist-tree-sort-equivalent2.lisp
-leftist-trees/leftist-tree-sort-equivalent2.pcert1 : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent2.pcert1 : no_pcert = 0
-leftist-trees/leftist-tree-sort-equivalent2.pcert1 : leftist-trees/leftist-tree-sort-equivalent2.pcert0
-leftist-trees/leftist-tree-sort-equivalent2.cert : | leftist-trees/leftist-tree-sort-equivalent2.pcert1
-
-leftist-trees/leftist-tree-sort-equivalent3.pcert0 : no_pcert = 0
-leftist-trees/leftist-tree-sort-equivalent3.pcert0 : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent3.pcert0 : \
-     sorting/equisort3.pcert0 \
-     sorting/isort.pcert0 \
-     leftist-trees/leftist-tree-sort.pcert0 \
-     leftist-trees/leftist-tree-sort-equivalent3.lisp
-leftist-trees/leftist-tree-sort-equivalent3.pcert1 : acl2x = 0
-leftist-trees/leftist-tree-sort-equivalent3.pcert1 : no_pcert = 0
-leftist-trees/leftist-tree-sort-equivalent3.pcert1 : leftist-trees/leftist-tree-sort-equivalent3.pcert0
-leftist-trees/leftist-tree-sort-equivalent3.cert : | leftist-trees/leftist-tree-sort-equivalent3.pcert1
-
-leftist-trees/leftist-tree-sort.pcert0 : no_pcert = 0
-leftist-trees/leftist-tree-sort.pcert0 : acl2x = 0
-leftist-trees/leftist-tree-sort.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/ordered-perms.pcert0 \
-     sorting/convert-perm-to-how-many.pcert0 \
-     leftist-trees/leftist-tree-defuns.pcert0 \
-     leftist-trees/leftist-tree-defthms.pcert0 \
-     leftist-trees/leftist-tree-sort.lisp
-leftist-trees/leftist-tree-sort.pcert1 : acl2x = 0
-leftist-trees/leftist-tree-sort.pcert1 : no_pcert = 0
-leftist-trees/leftist-tree-sort.pcert1 : leftist-trees/leftist-tree-sort.pcert0
-leftist-trees/leftist-tree-sort.cert : | leftist-trees/leftist-tree-sort.pcert1
-
-leftist-trees/top.pcert0 : no_pcert = 0
-leftist-trees/top.pcert0 : acl2x = 0
-leftist-trees/top.pcert0 : \
-     leftist-trees/leftist-tree-defuns.pcert0 \
-     leftist-trees/leftist-tree-defthms.pcert0 \
-     leftist-trees/leftist-tree-sort.pcert0 \
-     leftist-trees/top.lisp
-leftist-trees/top.pcert1 : acl2x = 0
-leftist-trees/top.pcert1 : no_pcert = 0
-leftist-trees/top.pcert1 : leftist-trees/top.pcert0
-leftist-trees/top.cert : | leftist-trees/top.pcert1
-
-make-event/acl2x-help.pcert0 : no_pcert = 0
-make-event/acl2x-help.pcert0 : acl2x = 0
-make-event/acl2x-help.pcert0 : \
-     misc/hons-help.pcert0 \
-     make-event/acl2x-help.lisp
-make-event/acl2x-help.pcert1 : acl2x = 0
-make-event/acl2x-help.pcert1 : no_pcert = 0
-make-event/acl2x-help.pcert1 : make-event/acl2x-help.pcert0
-make-event/acl2x-help.cert : | make-event/acl2x-help.pcert1
-
-make-event/assert-check-include-1.pcert0 : no_pcert = 0
-make-event/assert-check-include-1.pcert0 : acl2x = 0
-make-event/assert-check-include-1.pcert0 : \
-     make-event/assert-check.pcert0 \
-     make-event/eval.pcert0 \
-     make-event/assert-check-include-1.lisp \
-     make-event/assert-check-include-1.acl2
-make-event/assert-check-include-1.pcert1 : acl2x = 0
-make-event/assert-check-include-1.pcert1 : no_pcert = 0
-make-event/assert-check-include-1.pcert1 : make-event/assert-check-include-1.pcert0
-make-event/assert-check-include-1.cert : | make-event/assert-check-include-1.pcert1
-
-make-event/assert-check-include.pcert0 : no_pcert = 0
-make-event/assert-check-include.pcert0 : acl2x = 0
-make-event/assert-check-include.pcert0 : \
-     make-event/assert-check.pcert0 \
-     make-event/assert-check-include.lisp
-make-event/assert-check-include.pcert1 : acl2x = 0
-make-event/assert-check-include.pcert1 : no_pcert = 0
-make-event/assert-check-include.pcert1 : make-event/assert-check-include.pcert0
-make-event/assert-check-include.cert : | make-event/assert-check-include.pcert1
-
-make-event/assert-check.pcert0 : no_pcert = 0
-make-event/assert-check.pcert0 : acl2x = 0
-make-event/assert-check.pcert0 : \
-     make-event/eval-check.pcert0 \
-     make-event/assert-check.lisp
-make-event/assert-check.pcert1 : acl2x = 0
-make-event/assert-check.pcert1 : no_pcert = 0
-make-event/assert-check.pcert1 : make-event/assert-check.pcert0
-make-event/assert-check.cert : | make-event/assert-check.pcert1
-
-make-event/assert-include.pcert0 : no_pcert = 0
-make-event/assert-include.pcert0 : acl2x = 0
-make-event/assert-include.pcert0 : \
-     make-event/assert.pcert0 \
-     make-event/assert-include.lisp \
-     make-event/assert-include.acl2
-make-event/assert-include.pcert1 : acl2x = 0
-make-event/assert-include.pcert1 : no_pcert = 0
-make-event/assert-include.pcert1 : make-event/assert-include.pcert0
-make-event/assert-include.cert : | make-event/assert-include.pcert1
-
-make-event/assert.pcert0 : no_pcert = 0
-make-event/assert.pcert0 : acl2x = 0
-make-event/assert.pcert0 : \
-     misc/assert.pcert0 \
-     make-event/assert.lisp
-make-event/assert.pcert1 : acl2x = 0
-make-event/assert.pcert1 : no_pcert = 0
-make-event/assert.pcert1 : make-event/assert.pcert0
-make-event/assert.cert : | make-event/assert.pcert1
-
-make-event/basic-check.pcert0 : no_pcert = 0
-make-event/basic-check.pcert0 : acl2x = 0
-make-event/basic-check.pcert0 : \
-     make-event/basic-check.lisp
-make-event/basic-check.pcert1 : acl2x = 0
-make-event/basic-check.pcert1 : no_pcert = 0
-make-event/basic-check.pcert1 : make-event/basic-check.pcert0
-make-event/basic-check.cert : | make-event/basic-check.pcert1
-
-make-event/basic-pkg-check.pcert0 : no_pcert = 0
-make-event/basic-pkg-check.pcert0 : acl2x = 0
-make-event/basic-pkg-check.pcert0 : \
-     make-event/basic-pkg-check.lisp \
-     make-event/basic-pkg-check.acl2
-make-event/basic-pkg-check.pcert1 : acl2x = 0
-make-event/basic-pkg-check.pcert1 : no_pcert = 0
-make-event/basic-pkg-check.pcert1 : make-event/basic-pkg-check.pcert0
-make-event/basic-pkg-check.cert : | make-event/basic-pkg-check.pcert1
-
-make-event/basic-pkg.pcert0 : no_pcert = 0
-make-event/basic-pkg.pcert0 : acl2x = 0
-make-event/basic-pkg.pcert0 : \
-     make-event/basic-pkg.lisp \
-     make-event/basic-pkg.acl2
-make-event/basic-pkg.pcert1 : acl2x = 0
-make-event/basic-pkg.pcert1 : no_pcert = 0
-make-event/basic-pkg.pcert1 : make-event/basic-pkg.pcert0
-make-event/basic-pkg.cert : | make-event/basic-pkg.pcert1
-
-make-event/basic.pcert0 : no_pcert = 0
-make-event/basic.pcert0 : acl2x = 0
-make-event/basic.pcert0 : \
-     make-event/basic.lisp
-make-event/basic.pcert1 : acl2x = 0
-make-event/basic.pcert1 : no_pcert = 0
-make-event/basic.pcert1 : make-event/basic.pcert0
-make-event/basic.cert : | make-event/basic.pcert1
-
-make-event/defconst-fast-examples.pcert0 : no_pcert = 0
-make-event/defconst-fast-examples.pcert0 : acl2x = 0
-make-event/defconst-fast-examples.pcert0 : \
-     make-event/defconst-fast.pcert0 \
-     make-event/defconst-fast-examples.lisp
-make-event/defconst-fast-examples.pcert1 : acl2x = 0
-make-event/defconst-fast-examples.pcert1 : no_pcert = 0
-make-event/defconst-fast-examples.pcert1 : make-event/defconst-fast-examples.pcert0
-make-event/defconst-fast-examples.cert : | make-event/defconst-fast-examples.pcert1
-
-make-event/defconst-fast.pcert0 : no_pcert = 0
-make-event/defconst-fast.pcert0 : acl2x = 0
-make-event/defconst-fast.pcert0 : \
-     make-event/defconst-fast.lisp
-make-event/defconst-fast.pcert1 : acl2x = 0
-make-event/defconst-fast.pcert1 : no_pcert = 0
-make-event/defconst-fast.pcert1 : make-event/defconst-fast.pcert0
-make-event/defconst-fast.cert : | make-event/defconst-fast.pcert1
-
-make-event/defrefine.pcert0 : no_pcert = 0
-make-event/defrefine.pcert0 : acl2x = 0
-make-event/defrefine.pcert0 : \
-     make-event/eval.pcert0 \
-     make-event/defrefine.lisp
-make-event/defrefine.pcert1 : acl2x = 0
-make-event/defrefine.pcert1 : no_pcert = 0
-make-event/defrefine.pcert1 : make-event/defrefine.pcert0
-make-event/defrefine.cert : | make-event/defrefine.pcert1
-
-make-event/defrule.pcert0 : no_pcert = 0
-make-event/defrule.pcert0 : acl2x = 0
-make-event/defrule.pcert0 : \
-     make-event/defrule.lisp
-make-event/defrule.pcert1 : acl2x = 0
-make-event/defrule.pcert1 : no_pcert = 0
-make-event/defrule.pcert1 : make-event/defrule.pcert0
-make-event/defrule.cert : | make-event/defrule.pcert1
-
-make-event/defspec.pcert0 : no_pcert = 0
-make-event/defspec.pcert0 : acl2x = 0
-make-event/defspec.pcert0 : \
-     make-event/eval.pcert0 \
-     make-event/defspec.lisp
-make-event/defspec.pcert1 : acl2x = 0
-make-event/defspec.pcert1 : no_pcert = 0
-make-event/defspec.pcert1 : make-event/defspec.pcert0
-make-event/defspec.cert : | make-event/defspec.pcert1
-
-make-event/dotimes.pcert0 : no_pcert = 0
-make-event/dotimes.pcert0 : acl2x = 0
-make-event/dotimes.pcert0 : \
-     make-event/dotimes.lisp
-make-event/dotimes.pcert1 : acl2x = 0
-make-event/dotimes.pcert1 : no_pcert = 0
-make-event/dotimes.pcert1 : make-event/dotimes.pcert0
-make-event/dotimes.cert : | make-event/dotimes.pcert1
-
-make-event/embeddable-event-forms.pcert0 : no_pcert = 0
-make-event/embeddable-event-forms.pcert0 : acl2x = 0
-make-event/embeddable-event-forms.pcert0 : \
-     make-event/embeddable-event-forms.lisp
-make-event/embeddable-event-forms.pcert1 : acl2x = 0
-make-event/embeddable-event-forms.pcert1 : no_pcert = 0
-make-event/embeddable-event-forms.pcert1 : make-event/embeddable-event-forms.pcert0
-make-event/embeddable-event-forms.cert : | make-event/embeddable-event-forms.pcert1
-
-make-event/eval-check-tests.pcert0 : no_pcert = 0
-make-event/eval-check-tests.pcert0 : acl2x = 0
-make-event/eval-check-tests.pcert0 : \
-     make-event/eval-check.pcert0 \
-     make-event/eval-check-tests.lisp
-make-event/eval-check-tests.pcert1 : acl2x = 0
-make-event/eval-check-tests.pcert1 : no_pcert = 0
-make-event/eval-check-tests.pcert1 : make-event/eval-check-tests.pcert0
-make-event/eval-check-tests.cert : | make-event/eval-check-tests.pcert1
-
-make-event/eval-check.pcert0 : no_pcert = 0
-make-event/eval-check.pcert0 : acl2x = 0
-make-event/eval-check.pcert0 : \
-     make-event/eval-check.lisp
-make-event/eval-check.pcert1 : acl2x = 0
-make-event/eval-check.pcert1 : no_pcert = 0
-make-event/eval-check.pcert1 : make-event/eval-check.pcert0
-make-event/eval-check.cert : | make-event/eval-check.pcert1
-
-make-event/eval-tests.pcert0 : no_pcert = 0
-make-event/eval-tests.pcert0 : acl2x = 0
-make-event/eval-tests.pcert0 : \
-     make-event/eval.pcert0 \
-     make-event/eval-tests.lisp
-make-event/eval-tests.pcert1 : acl2x = 0
-make-event/eval-tests.pcert1 : no_pcert = 0
-make-event/eval-tests.pcert1 : make-event/eval-tests.pcert0
-make-event/eval-tests.cert : | make-event/eval-tests.pcert1
-
-make-event/eval.pcert0 : no_pcert = 0
-make-event/eval.pcert0 : acl2x = 0
-make-event/eval.pcert0 : \
-     misc/eval.pcert0 \
-     make-event/eval.lisp
-make-event/eval.pcert1 : acl2x = 0
-make-event/eval.pcert1 : no_pcert = 0
-make-event/eval.pcert1 : make-event/eval.pcert0
-make-event/eval.cert : | make-event/eval.pcert1
-
-make-event/gen-defthm-check.pcert0 : no_pcert = 0
-make-event/gen-defthm-check.pcert0 : acl2x = 0
-make-event/gen-defthm-check.pcert0 : \
-     misc/expander.pcert0 \
-     make-event/gen-defthm-check.lisp
-make-event/gen-defthm-check.pcert1 : acl2x = 0
-make-event/gen-defthm-check.pcert1 : no_pcert = 0
-make-event/gen-defthm-check.pcert1 : make-event/gen-defthm-check.pcert0
-make-event/gen-defthm-check.cert : | make-event/gen-defthm-check.pcert1
-
-make-event/gen-defthm.pcert0 : no_pcert = 0
-make-event/gen-defthm.pcert0 : acl2x = 0
-make-event/gen-defthm.pcert0 : \
-     misc/expander.pcert0 \
-     make-event/gen-defthm.lisp
-make-event/gen-defthm.pcert1 : acl2x = 0
-make-event/gen-defthm.pcert1 : no_pcert = 0
-make-event/gen-defthm.pcert1 : make-event/gen-defthm.pcert0
-make-event/gen-defthm.cert : | make-event/gen-defthm.pcert1
-
-make-event/gen-defun-check.pcert0 : no_pcert = 0
-make-event/gen-defun-check.pcert0 : acl2x = 0
-make-event/gen-defun-check.pcert0 : \
-     make-event/gen-defun-check.lisp
-make-event/gen-defun-check.pcert1 : acl2x = 0
-make-event/gen-defun-check.pcert1 : no_pcert = 0
-make-event/gen-defun-check.pcert1 : make-event/gen-defun-check.pcert0
-make-event/gen-defun-check.cert : | make-event/gen-defun-check.pcert1
-
-make-event/gen-defun.pcert0 : no_pcert = 0
-make-event/gen-defun.pcert0 : acl2x = 0
-make-event/gen-defun.pcert0 : \
-     make-event/gen-defun.lisp
-make-event/gen-defun.pcert1 : acl2x = 0
-make-event/gen-defun.pcert1 : no_pcert = 0
-make-event/gen-defun.pcert1 : make-event/gen-defun.pcert0
-make-event/gen-defun.cert : | make-event/gen-defun.pcert1
-
-make-event/inline-book.pcert0 : no_pcert = 0
-make-event/inline-book.pcert0 : acl2x = 0
-make-event/inline-book.pcert0 : \
-     make-event/inline-book.lisp
-make-event/inline-book.pcert1 : acl2x = 0
-make-event/inline-book.pcert1 : no_pcert = 0
-make-event/inline-book.pcert1 : make-event/inline-book.pcert0
-make-event/inline-book.cert : | make-event/inline-book.pcert1
-
-make-event/local-elided-include.pcert0 : no_pcert = 0
-make-event/local-elided-include.pcert0 : acl2x = 0
-make-event/local-elided-include.pcert0 : \
-     make-event/local-elided.pcert0 \
-     make-event/eval.pcert0 \
-     misc/file-io.pcert0 \
-     make-event/local-elided-include.lisp
-make-event/local-elided-include.pcert1 : acl2x = 0
-make-event/local-elided-include.pcert1 : no_pcert = 0
-make-event/local-elided-include.pcert1 : make-event/local-elided-include.pcert0
-make-event/local-elided-include.cert : | make-event/local-elided-include.pcert1
-
-make-event/local-elided.pcert0 : no_pcert = 0
-make-event/local-elided.pcert0 : acl2x = 0
-make-event/local-elided.pcert0 : \
-     make-event/eval.pcert0 \
-     make-event/local-elided.lisp
-make-event/local-elided.pcert1 : acl2x = 0
-make-event/local-elided.pcert1 : no_pcert = 0
-make-event/local-elided.pcert1 : make-event/local-elided.pcert0
-make-event/local-elided.cert : | make-event/local-elided.pcert1
-
-make-event/local-requires-skip-check-include.pcert0 : no_pcert = 0
-make-event/local-requires-skip-check-include.pcert0 : acl2x = 0
-make-event/local-requires-skip-check-include.pcert0 : \
-     misc/file-io.pcert0 \
-     make-event/local-requires-skip-check.pcert0 \
-     make-event/eval.pcert0 \
-     make-event/local-requires-skip-check-include.lisp
-make-event/local-requires-skip-check-include.pcert1 : acl2x = 0
-make-event/local-requires-skip-check-include.pcert1 : no_pcert = 0
-make-event/local-requires-skip-check-include.pcert1 : make-event/local-requires-skip-check-include.pcert0
-make-event/local-requires-skip-check-include.cert : | make-event/local-requires-skip-check-include.pcert1
-
-make-event/local-requires-skip-check.pcert0 : no_pcert = 0
-make-event/local-requires-skip-check.pcert0 : acl2x = 0
-make-event/local-requires-skip-check.pcert0 : \
-     make-event/eval.pcert0 \
-     make-event/local-requires-skip-check.lisp
-make-event/local-requires-skip-check.pcert1 : acl2x = 0
-make-event/local-requires-skip-check.pcert1 : no_pcert = 0
-make-event/local-requires-skip-check.pcert1 : make-event/local-requires-skip-check.pcert0
-make-event/local-requires-skip-check.cert : | make-event/local-requires-skip-check.pcert1
-
-make-event/logical-tangent.pcert0 : no_pcert = 0
-make-event/logical-tangent.pcert0 : acl2x = 0
-make-event/logical-tangent.pcert0 : \
-     make-event/logical-tangent.lisp
-make-event/logical-tangent.pcert1 : acl2x = 0
-make-event/logical-tangent.pcert1 : no_pcert = 0
-make-event/logical-tangent.pcert1 : make-event/logical-tangent.pcert0
-make-event/logical-tangent.cert : | make-event/logical-tangent.pcert1
-
-make-event/macros-include.pcert0 : no_pcert = 0
-make-event/macros-include.pcert0 : acl2x = 0
-make-event/macros-include.pcert0 : \
-     make-event/macros.pcert0 \
-     make-event/eval.pcert0 \
-     misc/file-io.pcert0 \
-     make-event/macros-include.lisp
-make-event/macros-include.pcert1 : acl2x = 0
-make-event/macros-include.pcert1 : no_pcert = 0
-make-event/macros-include.pcert1 : make-event/macros-include.pcert0
-make-event/macros-include.cert : | make-event/macros-include.pcert1
-
-make-event/macros-skip-proofs-include.pcert0 : no_pcert = 0
-make-event/macros-skip-proofs-include.pcert0 : acl2x = 0
-make-event/macros-skip-proofs-include.pcert0 : \
-     make-event/macros-skip-proofs.pcert0 \
-     make-event/eval.pcert0 \
-     misc/file-io.pcert0 \
-     make-event/macros-skip-proofs-include.lisp \
-     make-event/macros-skip-proofs-include.acl2
-make-event/macros-skip-proofs-include.pcert1 : acl2x = 0
-make-event/macros-skip-proofs-include.pcert1 : no_pcert = 0
-make-event/macros-skip-proofs-include.pcert1 : make-event/macros-skip-proofs-include.pcert0
-make-event/macros-skip-proofs-include.cert : | make-event/macros-skip-proofs-include.pcert1
-
-make-event/macros-skip-proofs.pcert0 : no_pcert = 0
-make-event/macros-skip-proofs.pcert0 : acl2x = 0
-make-event/macros-skip-proofs.pcert0 : \
-     make-event/macros-skip-proofs.lisp \
-     make-event/macros-skip-proofs.acl2
-make-event/macros-skip-proofs.pcert1 : acl2x = 0
-make-event/macros-skip-proofs.pcert1 : no_pcert = 0
-make-event/macros-skip-proofs.pcert1 : make-event/macros-skip-proofs.pcert0
-make-event/macros-skip-proofs.cert : | make-event/macros-skip-proofs.pcert1
-
-make-event/macros.pcert0 : no_pcert = 0
-make-event/macros.pcert0 : acl2x = 0
-make-event/macros.pcert0 : \
-     make-event/eval.pcert0 \
-     make-event/macros.lisp
-make-event/macros.pcert1 : acl2x = 0
-make-event/macros.pcert1 : no_pcert = 0
-make-event/macros.pcert1 : make-event/macros.pcert0
-make-event/macros.cert : | make-event/macros.pcert1
-
-make-event/make-redundant.pcert0 : no_pcert = 0
-make-event/make-redundant.pcert0 : acl2x = 0
-make-event/make-redundant.pcert0 : \
-     make-event/make-redundant.lisp
-make-event/make-redundant.pcert1 : acl2x = 0
-make-event/make-redundant.pcert1 : no_pcert = 0
-make-event/make-redundant.pcert1 : make-event/make-redundant.pcert0
-make-event/make-redundant.cert : | make-event/make-redundant.pcert1
-
-make-event/nested-check.pcert0 : no_pcert = 0
-make-event/nested-check.pcert0 : acl2x = 0
-make-event/nested-check.pcert0 : \
-     make-event/nested-check.lisp
-make-event/nested-check.pcert1 : acl2x = 0
-make-event/nested-check.pcert1 : no_pcert = 0
-make-event/nested-check.pcert1 : make-event/nested-check.pcert0
-make-event/nested-check.cert : | make-event/nested-check.pcert1
-
-make-event/nested.pcert0 : no_pcert = 0
-make-event/nested.pcert0 : acl2x = 0
-make-event/nested.pcert0 : \
-     make-event/nested.lisp
-make-event/nested.pcert1 : acl2x = 0
-make-event/nested.pcert1 : no_pcert = 0
-make-event/nested.pcert1 : make-event/nested.pcert0
-make-event/nested.cert : | make-event/nested.pcert1
-
-make-event/portcullis-expansion-include.pcert0 : no_pcert = 0
-make-event/portcullis-expansion-include.pcert0 : acl2x = 0
-make-event/portcullis-expansion-include.pcert0 : \
-     make-event/portcullis-expansion.pcert0 \
-     make-event/portcullis-expansion.pcert0 \
-     make-event/portcullis-expansion-include.lisp \
-     make-event/portcullis-expansion-include.acl2
-make-event/portcullis-expansion-include.pcert1 : acl2x = 0
-make-event/portcullis-expansion-include.pcert1 : no_pcert = 0
-make-event/portcullis-expansion-include.pcert1 : make-event/portcullis-expansion-include.pcert0
-make-event/portcullis-expansion-include.cert : | make-event/portcullis-expansion-include.pcert1
-
-make-event/portcullis-expansion.pcert0 : no_pcert = 0
-make-event/portcullis-expansion.pcert0 : acl2x = 0
-make-event/portcullis-expansion.pcert0 : \
-     make-event/eval.pcert0 \
-     make-event/portcullis-expansion.lisp \
-     make-event/portcullis-expansion.acl2
-make-event/portcullis-expansion.pcert1 : acl2x = 0
-make-event/portcullis-expansion.pcert1 : no_pcert = 0
-make-event/portcullis-expansion.pcert1 : make-event/portcullis-expansion.pcert0
-make-event/portcullis-expansion.cert : | make-event/portcullis-expansion.pcert1
-
-make-event/proof-by-arith.pcert0 : no_pcert = 0
-make-event/proof-by-arith.pcert0 : acl2x = 0
-make-event/proof-by-arith.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic-3/top.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     arithmetic-5/top.pcert0 \
-     make-event/proof-by-arith.lisp
-make-event/proof-by-arith.pcert1 : acl2x = 0
-make-event/proof-by-arith.pcert1 : no_pcert = 0
-make-event/proof-by-arith.pcert1 : make-event/proof-by-arith.pcert0
-make-event/proof-by-arith.cert : | make-event/proof-by-arith.pcert1
-
-make-event/read-from-file.pcert0 : no_pcert = 0
-make-event/read-from-file.pcert0 : acl2x = 0
-make-event/read-from-file.pcert0 : \
-     misc/file-io.pcert0 \
-     misc/file-io.pcert0 \
-     make-event/read-from-file.lisp
-make-event/read-from-file.pcert1 : acl2x = 0
-make-event/read-from-file.pcert1 : no_pcert = 0
-make-event/read-from-file.pcert1 : make-event/read-from-file.pcert0
-make-event/read-from-file.cert : | make-event/read-from-file.pcert1
-
-make-event/require-book.pcert0 : no_pcert = 0
-make-event/require-book.pcert0 : acl2x = 0
-make-event/require-book.pcert0 : \
-     make-event/require-book.lisp
-make-event/require-book.pcert1 : acl2x = 0
-make-event/require-book.pcert1 : no_pcert = 0
-make-event/require-book.pcert1 : make-event/require-book.pcert0
-make-event/require-book.cert : | make-event/require-book.pcert1
-
-make-event/test-case-check.pcert0 : no_pcert = 0
-make-event/test-case-check.pcert0 : acl2x = 0
-make-event/test-case-check.pcert0 : \
-     make-event/assert-check.pcert0 \
-     make-event/test-case-check.lisp
-make-event/test-case-check.pcert1 : acl2x = 0
-make-event/test-case-check.pcert1 : no_pcert = 0
-make-event/test-case-check.pcert1 : make-event/test-case-check.pcert0
-make-event/test-case-check.cert : | make-event/test-case-check.pcert1
-
-make-event/test-case.pcert0 : no_pcert = 0
-make-event/test-case.pcert0 : acl2x = 0
-make-event/test-case.pcert0 : \
-     make-event/assert.pcert0 \
-     make-event/test-case.lisp
-make-event/test-case.pcert1 : acl2x = 0
-make-event/test-case.pcert1 : no_pcert = 0
-make-event/test-case.pcert1 : make-event/test-case.pcert0
-make-event/test-case.cert : | make-event/test-case.pcert1
-
-meta/meta-plus-equal.pcert0 : no_pcert = 0
-meta/meta-plus-equal.pcert0 : acl2x = 0
-meta/meta-plus-equal.pcert0 : \
-     meta/term-defuns.pcert0 \
-     meta/term-lemmas.pcert0 \
-     meta/meta-plus-equal.lisp
-meta/meta-plus-equal.pcert1 : acl2x = 0
-meta/meta-plus-equal.pcert1 : no_pcert = 0
-meta/meta-plus-equal.pcert1 : meta/meta-plus-equal.pcert0
-meta/meta-plus-equal.cert : | meta/meta-plus-equal.pcert1
-
-meta/meta-plus-lessp.pcert0 : no_pcert = 0
-meta/meta-plus-lessp.pcert0 : acl2x = 0
-meta/meta-plus-lessp.pcert0 : \
-     meta/term-defuns.pcert0 \
-     meta/term-lemmas.pcert0 \
-     meta/meta-plus-lessp.lisp
-meta/meta-plus-lessp.pcert1 : acl2x = 0
-meta/meta-plus-lessp.pcert1 : no_pcert = 0
-meta/meta-plus-lessp.pcert1 : meta/meta-plus-lessp.pcert0
-meta/meta-plus-lessp.cert : | meta/meta-plus-lessp.pcert1
-
-meta/meta-times-equal.pcert0 : no_pcert = 0
-meta/meta-times-equal.pcert0 : acl2x = 0
-meta/meta-times-equal.pcert0 : \
-     meta/term-defuns.pcert0 \
-     meta/term-lemmas.pcert0 \
-     arithmetic/equalities.pcert0 \
-     meta/meta-times-equal.lisp
-meta/meta-times-equal.pcert1 : acl2x = 0
-meta/meta-times-equal.pcert1 : no_pcert = 0
-meta/meta-times-equal.pcert1 : meta/meta-times-equal.pcert0
-meta/meta-times-equal.cert : | meta/meta-times-equal.pcert1
-
-meta/meta.pcert0 : no_pcert = 0
-meta/meta.pcert0 : acl2x = 0
-meta/meta.pcert0 : \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     meta/meta.lisp
-meta/meta.pcert1 : acl2x = 0
-meta/meta.pcert1 : no_pcert = 0
-meta/meta.pcert1 : meta/meta.pcert0
-meta/meta.cert : | meta/meta.pcert1
-
-meta/pseudo-termp-lemmas.pcert0 : no_pcert = 0
-meta/pseudo-termp-lemmas.pcert0 : acl2x = 0
-meta/pseudo-termp-lemmas.pcert0 : \
-     meta/term-lemmas.pcert0 \
-     meta/pseudo-termp-lemmas.lisp
-meta/pseudo-termp-lemmas.pcert1 : acl2x = 0
-meta/pseudo-termp-lemmas.pcert1 : no_pcert = 0
-meta/pseudo-termp-lemmas.pcert1 : meta/pseudo-termp-lemmas.pcert0
-meta/pseudo-termp-lemmas.cert : | meta/pseudo-termp-lemmas.pcert1
-
-meta/term-defuns.pcert0 : no_pcert = 0
-meta/term-defuns.pcert0 : acl2x = 0
-meta/term-defuns.pcert0 : \
-     meta/term-defuns.lisp
-meta/term-defuns.pcert1 : acl2x = 0
-meta/term-defuns.pcert1 : no_pcert = 0
-meta/term-defuns.pcert1 : meta/term-defuns.pcert0
-meta/term-defuns.cert : | meta/term-defuns.pcert1
-
-meta/term-lemmas.pcert0 : no_pcert = 0
-meta/term-lemmas.pcert0 : acl2x = 0
-meta/term-lemmas.pcert0 : \
-     meta/term-defuns.pcert0 \
-     meta/term-lemmas.lisp
-meta/term-lemmas.pcert1 : acl2x = 0
-meta/term-lemmas.pcert1 : no_pcert = 0
-meta/term-lemmas.pcert1 : meta/term-lemmas.pcert0
-meta/term-lemmas.cert : | meta/term-lemmas.pcert1
-
-misc/assert.pcert0 : no_pcert = 0
-misc/assert.pcert0 : acl2x = 0
-misc/assert.pcert0 : \
-     misc/eval.pcert0 \
-     misc/assert.lisp
-misc/assert.pcert1 : acl2x = 0
-misc/assert.pcert1 : no_pcert = 0
-misc/assert.pcert1 : misc/assert.pcert0
-misc/assert.cert : | misc/assert.pcert1
-
-misc/bash.pcert0 : no_pcert = 0
-misc/bash.pcert0 : acl2x = 0
-misc/bash.pcert0 : \
-     misc/bash.lisp
-misc/bash.pcert1 : acl2x = 0
-misc/bash.pcert1 : no_pcert = 0
-misc/bash.pcert1 : misc/bash.pcert0
-misc/bash.cert : | misc/bash.pcert1
-
-misc/beta-reduce.pcert0 : no_pcert = 0
-misc/beta-reduce.pcert0 : acl2x = 0
-misc/beta-reduce.pcert0 : \
-     misc/beta-reduce.lisp
-misc/beta-reduce.pcert1 : acl2x = 0
-misc/beta-reduce.pcert1 : no_pcert = 0
-misc/beta-reduce.pcert1 : misc/beta-reduce.pcert0
-misc/beta-reduce.cert : | misc/beta-reduce.pcert1
-
-misc/callers-and-ancestors.pcert0 : no_pcert = 0
-misc/callers-and-ancestors.pcert0 : acl2x = 0
-misc/callers-and-ancestors.pcert0 : \
-     misc/callers-and-ancestors.lisp
-misc/callers-and-ancestors.pcert1 : acl2x = 0
-misc/callers-and-ancestors.pcert1 : no_pcert = 0
-misc/callers-and-ancestors.pcert1 : misc/callers-and-ancestors.pcert0
-misc/callers-and-ancestors.cert : | misc/callers-and-ancestors.pcert1
-
-misc/character-encoding-test.pcert0 : no_pcert = 0
-misc/character-encoding-test.pcert0 : acl2x = 0
-misc/character-encoding-test.pcert0 : \
-     misc/character-encoding-test.lisp
-misc/character-encoding-test.pcert1 : acl2x = 0
-misc/character-encoding-test.pcert1 : no_pcert = 0
-misc/character-encoding-test.pcert1 : misc/character-encoding-test.pcert0
-misc/character-encoding-test.cert : | misc/character-encoding-test.pcert1
-
-misc/check-acl2-exports.pcert0 : no_pcert = 0
-misc/check-acl2-exports.pcert0 : acl2x = 0
-misc/check-acl2-exports.pcert0 : \
-     misc/check-acl2-exports.lisp
-misc/check-acl2-exports.pcert1 : acl2x = 0
-misc/check-acl2-exports.pcert1 : no_pcert = 0
-misc/check-acl2-exports.pcert1 : misc/check-acl2-exports.pcert0
-misc/check-acl2-exports.cert : | misc/check-acl2-exports.pcert1
-
-misc/check-state.pcert0 : no_pcert = 0
-misc/check-state.pcert0 : acl2x = 0
-misc/check-state.pcert0 : \
-     misc/check-state.lisp
-misc/check-state.pcert1 : acl2x = 0
-misc/check-state.pcert1 : no_pcert = 0
-misc/check-state.pcert1 : misc/check-state.pcert0
-misc/check-state.cert : | misc/check-state.pcert1
-
-misc/computed-hint-rewrite.pcert0 : no_pcert = 0
-misc/computed-hint-rewrite.pcert0 : acl2x = 0
-misc/computed-hint-rewrite.pcert0 : \
-     misc/computed-hint-rewrite.lisp
-misc/computed-hint-rewrite.pcert1 : acl2x = 0
-misc/computed-hint-rewrite.pcert1 : no_pcert = 0
-misc/computed-hint-rewrite.pcert1 : misc/computed-hint-rewrite.pcert0
-misc/computed-hint-rewrite.cert : | misc/computed-hint-rewrite.pcert1
-
-misc/computed-hint.pcert0 : no_pcert = 0
-misc/computed-hint.pcert0 : acl2x = 0
-misc/computed-hint.pcert0 : \
-     misc/computed-hint.lisp
-misc/computed-hint.pcert1 : acl2x = 0
-misc/computed-hint.pcert1 : no_pcert = 0
-misc/computed-hint.pcert1 : misc/computed-hint.pcert0
-misc/computed-hint.cert : | misc/computed-hint.pcert1
-
-misc/congruent-stobjs-test.pcert0 : no_pcert = 0
-misc/congruent-stobjs-test.pcert0 : acl2x = 0
-misc/congruent-stobjs-test.pcert0 : \
-     misc/eval.pcert0 \
-     misc/congruent-stobjs-test.lisp
-misc/congruent-stobjs-test.pcert1 : acl2x = 0
-misc/congruent-stobjs-test.pcert1 : no_pcert = 0
-misc/congruent-stobjs-test.pcert1 : misc/congruent-stobjs-test.pcert0
-misc/congruent-stobjs-test.cert : | misc/congruent-stobjs-test.pcert1
-
-misc/csort.pcert0 : no_pcert = 0
-misc/csort.pcert0 : acl2x = 0
-misc/csort.pcert0 : \
-     misc/csort.lisp
-misc/csort.pcert1 : acl2x = 0
-misc/csort.pcert1 : no_pcert = 0
-misc/csort.pcert1 : misc/csort.pcert0
-misc/csort.cert : | misc/csort.pcert1
-
-misc/dead-events.pcert0 : no_pcert = 0
-misc/dead-events.pcert0 : acl2x = 0
-misc/dead-events.pcert0 : \
-     misc/dead-events.lisp
-misc/dead-events.pcert1 : acl2x = 0
-misc/dead-events.pcert1 : no_pcert = 0
-misc/dead-events.pcert1 : misc/dead-events.pcert0
-misc/dead-events.cert : | misc/dead-events.pcert1
-
-misc/defabsstobj-example-1.pcert0 : no_pcert = 0
-misc/defabsstobj-example-1.pcert0 : acl2x = 0
-misc/defabsstobj-example-1.pcert0 : \
-     misc/defabsstobj-example-1.lisp
-misc/defabsstobj-example-1.pcert1 : acl2x = 0
-misc/defabsstobj-example-1.pcert1 : no_pcert = 0
-misc/defabsstobj-example-1.pcert1 : misc/defabsstobj-example-1.pcert0
-misc/defabsstobj-example-1.cert : | misc/defabsstobj-example-1.pcert1
-
-misc/defabsstobj-example-2.pcert0 : no_pcert = 0
-misc/defabsstobj-example-2.pcert0 : acl2x = 0
-misc/defabsstobj-example-2.pcert0 : \
-     misc/defabsstobj-example-2.lisp
-misc/defabsstobj-example-2.pcert1 : acl2x = 0
-misc/defabsstobj-example-2.pcert1 : no_pcert = 0
-misc/defabsstobj-example-2.pcert1 : misc/defabsstobj-example-2.pcert0
-misc/defabsstobj-example-2.cert : | misc/defabsstobj-example-2.pcert1
-
-misc/defabsstobj-example-3.pcert0 : no_pcert = 0
-misc/defabsstobj-example-3.pcert0 : acl2x = 0
-misc/defabsstobj-example-3.pcert0 : \
-     misc/defabsstobj-example-3.lisp
-misc/defabsstobj-example-3.pcert1 : acl2x = 0
-misc/defabsstobj-example-3.pcert1 : no_pcert = 0
-misc/defabsstobj-example-3.pcert1 : misc/defabsstobj-example-3.pcert0
-misc/defabsstobj-example-3.cert : | misc/defabsstobj-example-3.pcert1
-
-misc/defabsstobj-example-4.pcert0 : no_pcert = 0
-misc/defabsstobj-example-4.pcert0 : acl2x = 0
-misc/defabsstobj-example-4.pcert0 : \
-     misc/defabsstobj-example-4.lisp \
-     misc/defabsstobj-example-4.acl2
-misc/defabsstobj-example-4.pcert1 : acl2x = 0
-misc/defabsstobj-example-4.pcert1 : no_pcert = 0
-misc/defabsstobj-example-4.pcert1 : misc/defabsstobj-example-4.pcert0
-misc/defabsstobj-example-4.cert : | misc/defabsstobj-example-4.pcert1
-
-misc/defattach-bang.pcert0 : no_pcert = 0
-misc/defattach-bang.pcert0 : acl2x = 0
-misc/defattach-bang.pcert0 : \
-     misc/defattach-bang.lisp
-misc/defattach-bang.pcert1 : acl2x = 0
-misc/defattach-bang.pcert1 : no_pcert = 0
-misc/defattach-bang.pcert1 : misc/defattach-bang.pcert0
-misc/defattach-bang.cert : | misc/defattach-bang.pcert1
-
-misc/defattach-example.pcert0 : no_pcert = 0
-misc/defattach-example.pcert0 : acl2x = 0
-misc/defattach-example.pcert0 : \
-     arithmetic/top.pcert0 \
-     misc/defattach-example.lisp
-misc/defattach-example.pcert1 : acl2x = 0
-misc/defattach-example.pcert1 : no_pcert = 0
-misc/defattach-example.pcert1 : misc/defattach-example.pcert0
-misc/defattach-example.cert : | misc/defattach-example.pcert1
-
-misc/definline.pcert0 : no_pcert = 0
-misc/definline.pcert0 : acl2x = 0
-misc/definline.pcert0 : \
-     misc/doc-section.pcert0 \
-     misc/definline.lisp
-misc/definline.pcert1 : acl2x = 0
-misc/definline.pcert1 : no_pcert = 0
-misc/definline.pcert1 : misc/definline.pcert0
-misc/definline.cert : | misc/definline.pcert1
-
-misc/defmac.pcert0 : no_pcert = 0
-misc/defmac.pcert0 : acl2x = 0
-misc/defmac.pcert0 : \
-     misc/doc-section.pcert0 \
-     misc/defmac.lisp
-misc/defmac.pcert1 : acl2x = 0
-misc/defmac.pcert1 : no_pcert = 0
-misc/defmac.pcert1 : misc/defmac.pcert0
-misc/defmac.cert : | misc/defmac.pcert1
-
-misc/defopener.pcert0 : no_pcert = 0
-misc/defopener.pcert0 : acl2x = 0
-misc/defopener.pcert0 : \
-     misc/doc-section.pcert0 \
-     misc/bash.pcert0 \
-     misc/defopener.lisp
-misc/defopener.pcert1 : acl2x = 0
-misc/defopener.pcert1 : no_pcert = 0
-misc/defopener.pcert1 : misc/defopener.pcert0
-misc/defopener.cert : | misc/defopener.pcert1
-
-misc/defp.pcert0 : no_pcert = 0
-misc/defp.pcert0 : acl2x = 0
-misc/defp.pcert0 : \
-     misc/defpun.pcert0 \
-     misc/defp.lisp
-misc/defp.pcert1 : acl2x = 0
-misc/defp.pcert1 : no_pcert = 0
-misc/defp.pcert1 : misc/defp.pcert0
-misc/defp.cert : | misc/defp.pcert1
-
-misc/defproxy-test.pcert0 : no_pcert = 0
-misc/defproxy-test.pcert0 : acl2x = 0
-misc/defproxy-test.pcert0 : \
-     misc/defproxy-test.lisp \
-     misc/defproxy-test.acl2
-misc/defproxy-test.pcert1 : acl2x = 0
-misc/defproxy-test.pcert1 : no_pcert = 0
-misc/defproxy-test.pcert1 : misc/defproxy-test.pcert0
-misc/defproxy-test.cert : | misc/defproxy-test.pcert1
-
-misc/defpun.pcert0 : no_pcert = 0
-misc/defpun.pcert0 : acl2x = 0
-misc/defpun.pcert0 : \
-     misc/defpun.lisp
-misc/defpun.pcert1 : acl2x = 0
-misc/defpun.pcert1 : no_pcert = 0
-misc/defpun.pcert1 : misc/defpun.pcert0
-misc/defpun.cert : | misc/defpun.pcert1
-
-misc/defun-plus.pcert0 : no_pcert = 0
-misc/defun-plus.pcert0 : acl2x = 0
-misc/defun-plus.pcert0 : \
-     misc/defun-plus.lisp
-misc/defun-plus.pcert1 : acl2x = 0
-misc/defun-plus.pcert1 : no_pcert = 0
-misc/defun-plus.pcert1 : misc/defun-plus.pcert0
-misc/defun-plus.cert : | misc/defun-plus.pcert1
-
-misc/dft-ex.pcert0 : no_pcert = 0
-misc/dft-ex.pcert0 : acl2x = 0
-misc/dft-ex.pcert0 : \
-     misc/dft.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     misc/dft-ex.lisp \
-     misc/dft-ex.acl2
-misc/dft-ex.pcert1 : acl2x = 0
-misc/dft-ex.pcert1 : no_pcert = 0
-misc/dft-ex.pcert1 : misc/dft-ex.pcert0
-misc/dft-ex.cert : | misc/dft-ex.pcert1
-
-misc/dft.pcert0 : no_pcert = 0
-misc/dft.pcert0 : acl2x = 0
-misc/dft.pcert0 : \
-     misc/dft.lisp
-misc/dft.pcert1 : acl2x = 0
-misc/dft.pcert1 : no_pcert = 0
-misc/dft.pcert1 : misc/dft.pcert0
-misc/dft.cert : | misc/dft.pcert1
-
-misc/dijkstra-shortest-path.pcert0 : no_pcert = 0
-misc/dijkstra-shortest-path.pcert0 : acl2x = 0
-misc/dijkstra-shortest-path.pcert0 : \
-     misc/dijkstra-shortest-path.lisp
-misc/dijkstra-shortest-path.pcert1 : acl2x = 0
-misc/dijkstra-shortest-path.pcert1 : no_pcert = 0
-misc/dijkstra-shortest-path.pcert1 : misc/dijkstra-shortest-path.pcert0
-misc/dijkstra-shortest-path.cert : | misc/dijkstra-shortest-path.pcert1
-
-misc/disassemble.pcert0 : no_pcert = 0
-misc/disassemble.pcert0 : acl2x = 0
-misc/disassemble.pcert0 : \
-     misc/disassemble.lisp \
-     misc/disassemble.acl2
-misc/disassemble.pcert1 : acl2x = 0
-misc/disassemble.pcert1 : no_pcert = 0
-misc/disassemble.pcert1 : misc/disassemble.pcert0
-misc/disassemble.cert : | misc/disassemble.pcert1
-
-misc/doc-section.pcert0 : no_pcert = 0
-misc/doc-section.pcert0 : acl2x = 0
-misc/doc-section.pcert0 : \
-     misc/doc-section.lisp
-misc/doc-section.pcert1 : acl2x = 0
-misc/doc-section.pcert1 : no_pcert = 0
-misc/doc-section.pcert1 : misc/doc-section.pcert0
-misc/doc-section.cert : | misc/doc-section.pcert1
-
-misc/dump-events.pcert0 : no_pcert = 0
-misc/dump-events.pcert0 : acl2x = 0
-misc/dump-events.pcert0 : \
-     misc/doc-section.pcert0 \
-     misc/dump-events.lisp
-misc/dump-events.pcert1 : acl2x = 0
-misc/dump-events.pcert1 : no_pcert = 0
-misc/dump-events.pcert1 : misc/dump-events.pcert0
-misc/dump-events.cert : | misc/dump-events.pcert1
-
-misc/equal-by-g-help.pcert0 : no_pcert = 0
-misc/equal-by-g-help.pcert0 : acl2x = 0
-misc/equal-by-g-help.pcert0 : \
-     misc/records.pcert0 \
-     misc/equal-by-g-help.lisp
-misc/equal-by-g-help.pcert1 : acl2x = 0
-misc/equal-by-g-help.pcert1 : no_pcert = 0
-misc/equal-by-g-help.pcert1 : misc/equal-by-g-help.pcert0
-misc/equal-by-g-help.cert : | misc/equal-by-g-help.pcert1
-
-misc/equal-by-g.pcert0 : no_pcert = 0
-misc/equal-by-g.pcert0 : acl2x = 0
-misc/equal-by-g.pcert0 : \
-     misc/records.pcert0 \
-     misc/equal-by-g-help.pcert0 \
-     misc/equal-by-g.lisp
-misc/equal-by-g.pcert1 : acl2x = 0
-misc/equal-by-g.pcert1 : no_pcert = 0
-misc/equal-by-g.pcert1 : misc/equal-by-g.pcert0
-misc/equal-by-g.cert : | misc/equal-by-g.pcert1
-
-misc/eval.pcert0 : no_pcert = 0
-misc/eval.pcert0 : acl2x = 0
-misc/eval.pcert0 : \
-     misc/eval.lisp
-misc/eval.pcert1 : acl2x = 0
-misc/eval.pcert1 : no_pcert = 0
-misc/eval.pcert1 : misc/eval.pcert0
-misc/eval.cert : | misc/eval.pcert1
-
-misc/evalable-printing.pcert0 : no_pcert = 0
-misc/evalable-printing.pcert0 : acl2x = 0
-misc/evalable-printing.pcert0 : \
-     misc/evalable-printing.lisp
-misc/evalable-printing.pcert1 : acl2x = 0
-misc/evalable-printing.pcert1 : no_pcert = 0
-misc/evalable-printing.pcert1 : misc/evalable-printing.pcert0
-misc/evalable-printing.cert : | misc/evalable-printing.pcert1
-
-misc/expander.pcert0 : no_pcert = 0
-misc/expander.pcert0 : acl2x = 0
-misc/expander.pcert0 : \
-     misc/doc-section.pcert0 \
-     misc/expander.lisp
-misc/expander.pcert1 : acl2x = 0
-misc/expander.pcert1 : no_pcert = 0
-misc/expander.pcert1 : misc/expander.pcert0
-misc/expander.cert : | misc/expander.pcert1
-
-misc/fast-coerce.pcert0 : no_pcert = 0
-misc/fast-coerce.pcert0 : acl2x = 0
-misc/fast-coerce.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     misc/fast-coerce.lisp
-misc/fast-coerce.pcert1 : acl2x = 0
-misc/fast-coerce.pcert1 : no_pcert = 0
-misc/fast-coerce.pcert1 : misc/fast-coerce.pcert0
-misc/fast-coerce.cert : | misc/fast-coerce.pcert1
-
-misc/fibonacci.pcert0 : no_pcert = 0
-misc/fibonacci.pcert0 : acl2x = 0
-misc/fibonacci.pcert0 : \
-     misc/int-division.pcert0 \
-     misc/grcd.pcert0 \
-     misc/fibonacci.lisp
-misc/fibonacci.pcert1 : acl2x = 0
-misc/fibonacci.pcert1 : no_pcert = 0
-misc/fibonacci.pcert1 : misc/fibonacci.pcert0
-misc/fibonacci.cert : | misc/fibonacci.pcert1
-
-misc/file-io.pcert0 : no_pcert = 0
-misc/file-io.pcert0 : acl2x = 0
-misc/file-io.pcert0 : \
-     misc/file-io.lisp
-misc/file-io.pcert1 : acl2x = 0
-misc/file-io.pcert1 : no_pcert = 0
-misc/file-io.pcert1 : misc/file-io.pcert0
-misc/file-io.cert : | misc/file-io.pcert1
-
-misc/find-lemmas.pcert0 : no_pcert = 0
-misc/find-lemmas.pcert0 : acl2x = 0
-misc/find-lemmas.pcert0 : \
-     misc/find-lemmas.lisp
-misc/find-lemmas.pcert1 : acl2x = 0
-misc/find-lemmas.pcert1 : no_pcert = 0
-misc/find-lemmas.pcert1 : misc/find-lemmas.pcert0
-misc/find-lemmas.cert : | misc/find-lemmas.pcert1
-
-misc/gentle.pcert0 : no_pcert = 0
-misc/gentle.pcert0 : acl2x = 0
-misc/gentle.pcert0 : \
-     misc/gentle.lisp
-misc/gentle.pcert1 : acl2x = 0
-misc/gentle.pcert1 : no_pcert = 0
-misc/gentle.pcert1 : misc/gentle.pcert0
-misc/gentle.cert : | misc/gentle.pcert1
-
-misc/getprop.pcert0 : no_pcert = 0
-misc/getprop.pcert0 : acl2x = 0
-misc/getprop.pcert0 : \
-     misc/getprop.lisp
-misc/getprop.pcert1 : acl2x = 0
-misc/getprop.pcert1 : no_pcert = 0
-misc/getprop.pcert1 : misc/getprop.pcert0
-misc/getprop.cert : | misc/getprop.pcert1
-
-misc/goodstein.pcert0 : no_pcert = 0
-misc/goodstein.pcert0 : acl2x = 0
-misc/goodstein.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     misc/goodstein.lisp
-misc/goodstein.pcert1 : acl2x = 0
-misc/goodstein.pcert1 : no_pcert = 0
-misc/goodstein.pcert1 : misc/goodstein.pcert0
-misc/goodstein.cert : | misc/goodstein.pcert1
-
-misc/grcd.pcert0 : no_pcert = 0
-misc/grcd.pcert0 : acl2x = 0
-misc/grcd.pcert0 : \
-     misc/int-division.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     misc/grcd.lisp
-misc/grcd.pcert1 : acl2x = 0
-misc/grcd.pcert1 : no_pcert = 0
-misc/grcd.pcert1 : misc/grcd.pcert0
-misc/grcd.cert : | misc/grcd.pcert1
-
-misc/hanoi.pcert0 : no_pcert = 0
-misc/hanoi.pcert0 : acl2x = 0
-misc/hanoi.pcert0 : \
-     misc/hanoi.lisp \
-     misc/hanoi.acl2
-misc/hanoi.pcert1 : acl2x = 0
-misc/hanoi.pcert1 : no_pcert = 0
-misc/hanoi.pcert1 : misc/hanoi.pcert0
-misc/hanoi.cert : | misc/hanoi.pcert1
-
-misc/hons-help.pcert0 : no_pcert = 0
-misc/hons-help.pcert0 : acl2x = 0
-misc/hons-help.pcert0 : \
-     misc/gentle.pcert0 \
-     misc/hons-help.lisp
-misc/hons-help.pcert1 : acl2x = 0
-misc/hons-help.pcert1 : no_pcert = 0
-misc/hons-help.pcert1 : misc/hons-help.pcert0
-misc/hons-help.cert : | misc/hons-help.pcert1
-
-misc/hons-help2.pcert0 : no_pcert = 0
-misc/hons-help2.pcert0 : acl2x = 0
-misc/hons-help2.pcert0 : \
-     misc/hons-help.pcert0 \
-     misc/hons-help2.lisp
-misc/hons-help2.pcert1 : acl2x = 0
-misc/hons-help2.pcert1 : no_pcert = 0
-misc/hons-help2.pcert1 : misc/hons-help2.pcert0
-misc/hons-help2.cert : | misc/hons-help2.pcert1
-
-misc/hons-tests.pcert0 : no_pcert = 0
-misc/hons-tests.pcert0 : acl2x = 0
-misc/hons-tests.pcert0 : \
-     misc/qi.pcert0 \
-     misc/hons-tests.lisp
-misc/hons-tests.pcert1 : acl2x = 0
-misc/hons-tests.pcert1 : no_pcert = 0
-misc/hons-tests.pcert1 : misc/hons-tests.pcert0
-misc/hons-tests.cert : | misc/hons-tests.pcert1
-
-misc/how-to-prove-thms.pcert0 : no_pcert = 0
-misc/how-to-prove-thms.pcert0 : acl2x = 0
-misc/how-to-prove-thms.pcert0 : \
-     misc/how-to-prove-thms.lisp
-misc/how-to-prove-thms.pcert1 : acl2x = 0
-misc/how-to-prove-thms.pcert1 : no_pcert = 0
-misc/how-to-prove-thms.pcert1 : misc/how-to-prove-thms.pcert0
-misc/how-to-prove-thms.cert : | misc/how-to-prove-thms.pcert1
-
-misc/int-division.pcert0 : no_pcert = 0
-misc/int-division.pcert0 : acl2x = 0
-misc/int-division.pcert0 : \
-     arithmetic/equalities.pcert0 \
-     arithmetic/inequalities.pcert0 \
-     misc/int-division.lisp
-misc/int-division.pcert1 : acl2x = 0
-misc/int-division.pcert1 : no_pcert = 0
-misc/int-division.pcert1 : misc/int-division.pcert0
-misc/int-division.cert : | misc/int-division.pcert1
-
-misc/integer-type-set-test.pcert0 : no_pcert = 0
-misc/integer-type-set-test.pcert0 : acl2x = 0
-misc/integer-type-set-test.pcert0 : \
-     misc/integer-type-set-test.lisp
-misc/integer-type-set-test.pcert1 : acl2x = 0
-misc/integer-type-set-test.pcert1 : no_pcert = 0
-misc/integer-type-set-test.pcert1 : misc/integer-type-set-test.pcert0
-misc/integer-type-set-test.cert : | misc/integer-type-set-test.pcert1
-
-misc/invariants.pcert0 : no_pcert = 0
-misc/invariants.pcert0 : acl2x = 0
-misc/invariants.pcert0 : \
-     misc/bash.pcert0 \
-     misc/invariants.lisp
-misc/invariants.pcert1 : acl2x = 0
-misc/invariants.pcert1 : no_pcert = 0
-misc/invariants.pcert1 : misc/invariants.pcert0
-misc/invariants.cert : | misc/invariants.pcert1
-
-misc/meta-lemmas.pcert0 : no_pcert = 0
-misc/meta-lemmas.pcert0 : acl2x = 0
-misc/meta-lemmas.pcert0 : \
-     misc/doc-section.pcert0 \
-     misc/meta-lemmas.lisp
-misc/meta-lemmas.pcert1 : acl2x = 0
-misc/meta-lemmas.pcert1 : no_pcert = 0
-misc/meta-lemmas.pcert1 : misc/meta-lemmas.pcert0
-misc/meta-lemmas.cert : | misc/meta-lemmas.pcert1
-
-misc/misc2/defpun-exec-domain-example.pcert0 : no_pcert = 0
-misc/misc2/defpun-exec-domain-example.pcert0 : acl2x = 0
-misc/misc2/defpun-exec-domain-example.pcert0 : \
-     misc/defpun.pcert0 \
-     misc/eval.pcert0 \
-     misc/misc2/defpun-exec-domain-example.lisp
-misc/misc2/defpun-exec-domain-example.pcert1 : acl2x = 0
-misc/misc2/defpun-exec-domain-example.pcert1 : no_pcert = 0
-misc/misc2/defpun-exec-domain-example.pcert1 : misc/misc2/defpun-exec-domain-example.pcert0
-misc/misc2/defpun-exec-domain-example.cert : | misc/misc2/defpun-exec-domain-example.pcert1
-
-misc/misc2/misc.pcert0 : no_pcert = 0
-misc/misc2/misc.pcert0 : acl2x = 0
-misc/misc2/misc.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     misc/misc2/misc.lisp
-misc/misc2/misc.pcert1 : acl2x = 0
-misc/misc2/misc.pcert1 : no_pcert = 0
-misc/misc2/misc.pcert1 : misc/misc2/misc.pcert0
-misc/misc2/misc.cert : | misc/misc2/misc.pcert1
-
-misc/misc2/reverse-by-separation.pcert0 : no_pcert = 0
-misc/misc2/reverse-by-separation.pcert0 : acl2x = 0
-misc/misc2/reverse-by-separation.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     coi/bags/top.pcert0 \
-     coi/bags/top.pcert0 \
-     misc/misc2/reverse-by-separation.lisp \
-     misc/misc2/reverse-by-separation.acl2
-misc/misc2/reverse-by-separation.pcert1 : acl2x = 0
-misc/misc2/reverse-by-separation.pcert1 : no_pcert = 0
-misc/misc2/reverse-by-separation.pcert1 : misc/misc2/reverse-by-separation.pcert0
-misc/misc2/reverse-by-separation.cert : | misc/misc2/reverse-by-separation.pcert1
-
-misc/misc2/ruler-extenders-tests.pcert0 : no_pcert = 0
-misc/misc2/ruler-extenders-tests.pcert0 : acl2x = 0
-misc/misc2/ruler-extenders-tests.pcert0 : \
-     misc/eval.pcert0 \
-     misc/misc2/ruler-extenders-tests.lisp \
-     misc/misc2/ruler-extenders-tests.acl2
-misc/misc2/ruler-extenders-tests.pcert1 : acl2x = 0
-misc/misc2/ruler-extenders-tests.pcert1 : no_pcert = 0
-misc/misc2/ruler-extenders-tests.pcert1 : misc/misc2/ruler-extenders-tests.pcert0
-misc/misc2/ruler-extenders-tests.cert : | misc/misc2/ruler-extenders-tests.pcert1
-
-misc/misc2/step-limits.pcert0 : no_pcert = 0
-misc/misc2/step-limits.pcert0 : acl2x = 0
-misc/misc2/step-limits.pcert0 : \
-     misc/eval.pcert0 \
-     misc/misc2/step-limits.lisp
-misc/misc2/step-limits.pcert1 : acl2x = 0
-misc/misc2/step-limits.pcert1 : no_pcert = 0
-misc/misc2/step-limits.pcert1 : misc/misc2/step-limits.pcert0
-misc/misc2/step-limits.cert : | misc/misc2/step-limits.pcert1
-
-misc/mult.pcert0 : no_pcert = 0
-misc/mult.pcert0 : acl2x = 0
-misc/mult.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     data-structures/structures.pcert0 \
-     data-structures/array1.pcert0 \
-     ihs/@logops.pcert0 \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     data-structures/deflist.pcert0 \
-     data-structures/defalist.pcert0 \
-     misc/meta-lemmas.pcert0 \
-     misc/mult.lisp
-misc/mult.pcert1 : acl2x = 0
-misc/mult.pcert1 : no_pcert = 0
-misc/mult.pcert1 : misc/mult.pcert0
-misc/mult.cert : | misc/mult.pcert1
-
-misc/oprof.pcert0 : no_pcert = 0
-misc/oprof.pcert0 : acl2x = 0
-misc/oprof.pcert0 : \
-     misc/oprof.lisp \
-     misc/oprof.acl2
-misc/oprof.pcert1 : acl2x = 0
-misc/oprof.pcert1 : no_pcert = 0
-misc/oprof.pcert1 : misc/oprof.pcert0
-misc/oprof.cert : | misc/oprof.pcert1
-
-misc/priorities.pcert0 : no_pcert = 0
-misc/priorities.pcert0 : acl2x = 0
-misc/priorities.pcert0 : \
-     misc/priorities.lisp
-misc/priorities.pcert1 : acl2x = 0
-misc/priorities.pcert1 : no_pcert = 0
-misc/priorities.pcert1 : misc/priorities.pcert0
-misc/priorities.cert : | misc/priorities.pcert1
-
-misc/problem13.pcert0 : no_pcert = 0
-misc/problem13.pcert0 : acl2x = 0
-misc/problem13.pcert0 : \
-     arithmetic/equalities.pcert0 \
-     arithmetic/inequalities.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     misc/problem13.lisp
-misc/problem13.pcert1 : acl2x = 0
-misc/problem13.pcert1 : no_pcert = 0
-misc/problem13.pcert1 : misc/problem13.pcert0
-misc/problem13.cert : | misc/problem13.pcert1
-
-misc/process-book-readme.pcert0 : no_pcert = 0
-misc/process-book-readme.pcert0 : acl2x = 0
-misc/process-book-readme.pcert0 : \
-     misc/process-book-readme.lisp
-misc/process-book-readme.pcert1 : acl2x = 0
-misc/process-book-readme.pcert1 : no_pcert = 0
-misc/process-book-readme.pcert1 : misc/process-book-readme.pcert0
-misc/process-book-readme.cert : | misc/process-book-readme.pcert1
-
-misc/profiling.pcert0 : no_pcert = 0
-misc/profiling.pcert0 : acl2x = 0
-misc/profiling.pcert0 : \
-     misc/profiling.lisp \
-     misc/profiling.acl2
-misc/profiling.pcert1 : acl2x = 0
-misc/profiling.pcert1 : no_pcert = 0
-misc/profiling.pcert1 : misc/profiling.pcert0
-misc/profiling.cert : | misc/profiling.pcert1
-
-misc/qi-correct.pcert0 : no_pcert = 0
-misc/qi-correct.pcert0 : acl2x = 0
-misc/qi-correct.pcert0 : \
-     misc/qi.pcert0 \
-     misc/qi-correct.lisp \
-     misc/qi-correct.acl2
-misc/qi-correct.pcert1 : acl2x = 0
-misc/qi-correct.pcert1 : no_pcert = 0
-misc/qi-correct.pcert1 : misc/qi-correct.pcert0
-misc/qi-correct.cert : | misc/qi-correct.pcert1
-
-misc/qi.pcert0 : no_pcert = 0
-misc/qi.pcert0 : acl2x = 0
-misc/qi.pcert0 : \
-     misc/hons-help2.pcert0 \
-     misc/qi.lisp \
-     misc/qi.acl2
-misc/qi.pcert1 : acl2x = 0
-misc/qi.pcert1 : no_pcert = 0
-misc/qi.pcert1 : misc/qi.pcert0
-misc/qi.cert : | misc/qi.pcert1
-
-misc/radix.pcert0 : no_pcert = 0
-misc/radix.pcert0 : acl2x = 0
-misc/radix.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     arithmetic-2/floor-mod/floor-mod.pcert0 \
-     misc/radix.lisp \
-     misc/radix.acl2
-misc/radix.pcert1 : acl2x = 0
-misc/radix.pcert1 : no_pcert = 0
-misc/radix.pcert1 : misc/radix.pcert0
-misc/radix.cert : | misc/radix.pcert1
-
-misc/random.pcert0 : no_pcert = 0
-misc/random.pcert0 : acl2x = 0
-misc/random.pcert0 : \
-     arithmetic-2/floor-mod/floor-mod.pcert0 \
-     misc/random.lisp
-misc/random.pcert1 : acl2x = 0
-misc/random.pcert1 : no_pcert = 0
-misc/random.pcert1 : misc/random.pcert0
-misc/random.cert : | misc/random.pcert1
-
-misc/records-bsd.pcert0 : no_pcert = 0
-misc/records-bsd.pcert0 : acl2x = 0
-misc/records-bsd.pcert0 : \
-     misc/total-order-bsd.pcert0 \
-     misc/records-bsd.lisp
-misc/records-bsd.pcert1 : acl2x = 0
-misc/records-bsd.pcert1 : no_pcert = 0
-misc/records-bsd.pcert1 : misc/records-bsd.pcert0
-misc/records-bsd.cert : | misc/records-bsd.pcert1
-
-misc/records.pcert0 : no_pcert = 0
-misc/records.pcert0 : acl2x = 0
-misc/records.pcert0 : \
-     misc/total-order.pcert0 \
-     misc/records.lisp
-misc/records.pcert1 : acl2x = 0
-misc/records.pcert1 : no_pcert = 0
-misc/records.pcert1 : misc/records.pcert0
-misc/records.cert : | misc/records.pcert1
-
-misc/records0.pcert0 : no_pcert = 0
-misc/records0.pcert0 : acl2x = 0
-misc/records0.pcert0 : \
-     misc/total-order.pcert0 \
-     misc/records0.lisp
-misc/records0.pcert1 : acl2x = 0
-misc/records0.pcert1 : no_pcert = 0
-misc/records0.pcert1 : misc/records0.pcert0
-misc/records0.cert : | misc/records0.pcert1
-
-misc/redef-pkg.pcert0 : no_pcert = 0
-misc/redef-pkg.pcert0 : acl2x = 0
-misc/redef-pkg.pcert0 : \
-     misc/redef-pkg.lisp \
-     misc/redef-pkg.acl2
-misc/redef-pkg.pcert1 : acl2x = 0
-misc/redef-pkg.pcert1 : no_pcert = 0
-misc/redef-pkg.pcert1 : misc/redef-pkg.pcert0
-misc/redef-pkg.cert : | misc/redef-pkg.pcert1
-
-misc/rtl-untranslate.pcert0 : no_pcert = 0
-misc/rtl-untranslate.pcert0 : acl2x = 0
-misc/rtl-untranslate.pcert0 : \
-     misc/symbol-btree.pcert0 \
-     misc/rtl-untranslate.lisp
-misc/rtl-untranslate.pcert1 : acl2x = 0
-misc/rtl-untranslate.pcert1 : no_pcert = 0
-misc/rtl-untranslate.pcert1 : misc/rtl-untranslate.pcert0
-misc/rtl-untranslate.cert : | misc/rtl-untranslate.pcert1
-
-misc/save-time.pcert0 : no_pcert = 0
-misc/save-time.pcert0 : acl2x = 0
-misc/save-time.pcert0 : \
-     misc/save-time.lisp
-misc/save-time.pcert1 : acl2x = 0
-misc/save-time.pcert1 : no_pcert = 0
-misc/save-time.pcert1 : misc/save-time.pcert0
-misc/save-time.cert : | misc/save-time.pcert1
-
-misc/seq.pcert0 : no_pcert = 0
-misc/seq.pcert0 : acl2x = 0
-misc/seq.pcert0 : \
-     misc/seq.lisp
-misc/seq.pcert1 : acl2x = 0
-misc/seq.pcert1 : no_pcert = 0
-misc/seq.pcert1 : misc/seq.pcert0
-misc/seq.cert : | misc/seq.pcert1
-
-misc/seqw.pcert0 : no_pcert = 0
-misc/seqw.pcert0 : acl2x = 0
-misc/seqw.pcert0 : \
-     misc/seq.pcert0 \
-     misc/seqw.lisp
-misc/seqw.pcert1 : acl2x = 0
-misc/seqw.pcert1 : no_pcert = 0
-misc/seqw.pcert1 : misc/seqw.pcert0
-misc/seqw.cert : | misc/seqw.pcert1
-
-misc/simplify-defuns.pcert0 : no_pcert = 0
-misc/simplify-defuns.pcert0 : acl2x = 0
-misc/simplify-defuns.pcert0 : \
-     misc/file-io.pcert0 \
-     misc/simplify-defuns.lisp
-misc/simplify-defuns.pcert1 : acl2x = 0
-misc/simplify-defuns.pcert1 : no_pcert = 0
-misc/simplify-defuns.pcert1 : misc/simplify-defuns.pcert0
-misc/simplify-defuns.cert : | misc/simplify-defuns.pcert1
-
-misc/simplify-thm.pcert0 : no_pcert = 0
-misc/simplify-thm.pcert0 : acl2x = 0
-misc/simplify-thm.pcert0 : \
-     misc/bash.pcert0 \
-     misc/simplify-thm.lisp
-misc/simplify-thm.pcert1 : acl2x = 0
-misc/simplify-thm.pcert1 : no_pcert = 0
-misc/simplify-thm.pcert1 : misc/simplify-thm.pcert0
-misc/simplify-thm.cert : | misc/simplify-thm.pcert1
-
-misc/sin-cos.pcert0 : no_pcert = 0
-misc/sin-cos.pcert0 : acl2x = 0
-misc/sin-cos.pcert0 : \
-     misc/doc-section.pcert0 \
-     misc/sin-cos.lisp
-misc/sin-cos.pcert1 : acl2x = 0
-misc/sin-cos.pcert1 : no_pcert = 0
-misc/sin-cos.pcert1 : misc/sin-cos.pcert0
-misc/sin-cos.cert : | misc/sin-cos.pcert1
-
-misc/sort-symbols.pcert0 : no_pcert = 0
-misc/sort-symbols.pcert0 : acl2x = 0
-misc/sort-symbols.pcert0 : \
-     misc/sort-symbols.lisp
-misc/sort-symbols.pcert1 : acl2x = 0
-misc/sort-symbols.pcert1 : no_pcert = 0
-misc/sort-symbols.pcert1 : misc/sort-symbols.pcert0
-misc/sort-symbols.cert : | misc/sort-symbols.pcert1
-
-misc/sticky-disable.pcert0 : no_pcert = 0
-misc/sticky-disable.pcert0 : acl2x = 0
-misc/sticky-disable.pcert0 : \
-     misc/sticky-disable.lisp
-misc/sticky-disable.pcert1 : acl2x = 0
-misc/sticky-disable.pcert1 : no_pcert = 0
-misc/sticky-disable.pcert1 : misc/sticky-disable.pcert0
-misc/sticky-disable.cert : | misc/sticky-disable.pcert1
-
-misc/symbol-btree.pcert0 : no_pcert = 0
-misc/symbol-btree.pcert0 : acl2x = 0
-misc/symbol-btree.pcert0 : \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     arithmetic/top.pcert0 \
-     std/lists/take.pcert0 \
-     arithmetic/top.pcert0 \
-     arithmetic/top.pcert0 \
-     misc/symbol-btree.lisp
-misc/symbol-btree.pcert1 : acl2x = 0
-misc/symbol-btree.pcert1 : no_pcert = 0
-misc/symbol-btree.pcert1 : misc/symbol-btree.pcert0
-misc/symbol-btree.cert : | misc/symbol-btree.pcert1
-
-misc/total-order-bsd.pcert0 : no_pcert = 0
-misc/total-order-bsd.pcert0 : acl2x = 0
-misc/total-order-bsd.pcert0 : \
-     misc/total-order-bsd.lisp
-misc/total-order-bsd.pcert1 : acl2x = 0
-misc/total-order-bsd.pcert1 : no_pcert = 0
-misc/total-order-bsd.pcert1 : misc/total-order-bsd.pcert0
-misc/total-order-bsd.cert : | misc/total-order-bsd.pcert1
-
-misc/total-order.pcert0 : no_pcert = 0
-misc/total-order.pcert0 : acl2x = 0
-misc/total-order.pcert0 : \
-     xdoc/top.pcert0 \
-     misc/total-order-bsd.pcert0 \
-     misc/total-order.lisp
-misc/total-order.pcert1 : acl2x = 0
-misc/total-order.pcert1 : no_pcert = 0
-misc/total-order.pcert1 : misc/total-order.pcert0
-misc/total-order.cert : | misc/total-order.pcert1
-
-misc/trace-star.pcert0 : no_pcert = 0
-misc/trace-star.pcert0 : acl2x = 0
-misc/trace-star.pcert0 : \
-     misc/evalable-printing.pcert0 \
-     misc/trace-star.lisp
-misc/trace-star.pcert1 : acl2x = 0
-misc/trace-star.pcert1 : no_pcert = 0
-misc/trace-star.pcert1 : misc/trace-star.pcert0
-misc/trace-star.cert : | misc/trace-star.pcert1
-
-misc/transfinite.pcert0 : no_pcert = 0
-misc/transfinite.pcert0 : acl2x = 0
-misc/transfinite.pcert0 : \
-     misc/transfinite.lisp
-misc/transfinite.pcert1 : acl2x = 0
-misc/transfinite.pcert1 : no_pcert = 0
-misc/transfinite.pcert1 : misc/transfinite.pcert0
-misc/transfinite.cert : | misc/transfinite.pcert1
-
-misc/untranslate-patterns.pcert0 : no_pcert = 0
-misc/untranslate-patterns.pcert0 : acl2x = 0
-misc/untranslate-patterns.pcert0 : \
-     misc/symbol-btree.pcert0 \
-     misc/untranslate-patterns.lisp
-misc/untranslate-patterns.pcert1 : acl2x = 0
-misc/untranslate-patterns.pcert1 : no_pcert = 0
-misc/untranslate-patterns.pcert1 : misc/untranslate-patterns.pcert0
-misc/untranslate-patterns.cert : | misc/untranslate-patterns.pcert1
-
-misc/wet.pcert0 : no_pcert = 0
-misc/wet.pcert0 : acl2x = 0
-misc/wet.pcert0 : \
-     misc/wet.lisp
-misc/wet.pcert1 : acl2x = 0
-misc/wet.pcert1 : no_pcert = 0
-misc/wet.pcert1 : misc/wet.pcert0
-misc/wet.cert : | misc/wet.pcert1
-
-models/jvm/m1-original/m1-story.pcert0 : no_pcert = 0
-models/jvm/m1-original/m1-story.pcert0 : acl2x = 0
-models/jvm/m1-original/m1-story.pcert0 : \
-     models/jvm/m1-original/problem-set-1-answers.pcert0 \
-     arithmetic-3/extra/top-ext.pcert0 \
-     models/jvm/m1-original/problem-set-1-answers.pcert0 \
-     models/jvm/m1-original/m1-story.lisp \
-     models/jvm/m1-original/m1-story.acl2
-models/jvm/m1-original/m1-story.pcert1 : acl2x = 0
-models/jvm/m1-original/m1-story.pcert1 : no_pcert = 0
-models/jvm/m1-original/m1-story.pcert1 : models/jvm/m1-original/m1-story.pcert0
-models/jvm/m1-original/m1-story.cert : | models/jvm/m1-original/m1-story.pcert1
-
-models/jvm/m1-original/problem-set-1-answers.pcert0 : no_pcert = 0
-models/jvm/m1-original/problem-set-1-answers.pcert0 : acl2x = 0
-models/jvm/m1-original/problem-set-1-answers.pcert0 : \
-     models/jvm/m1-original/problem-set-1-answers.lisp \
-     models/jvm/m1-original/problem-set-1-answers.acl2
-models/jvm/m1-original/problem-set-1-answers.pcert1 : acl2x = 0
-models/jvm/m1-original/problem-set-1-answers.pcert1 : no_pcert = 0
-models/jvm/m1-original/problem-set-1-answers.pcert1 : models/jvm/m1-original/problem-set-1-answers.pcert0
-models/jvm/m1-original/problem-set-1-answers.cert : | models/jvm/m1-original/problem-set-1-answers.pcert1
-
-models/jvm/m1/alternating-sum-variant.pcert0 : no_pcert = 0
-models/jvm/m1/alternating-sum-variant.pcert0 : acl2x = 0
-models/jvm/m1/alternating-sum-variant.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/alternating-sum-variant.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/alternating-sum-variant.pcert1 : acl2x = 0
-models/jvm/m1/alternating-sum-variant.pcert1 : no_pcert = 0
-models/jvm/m1/alternating-sum-variant.pcert1 : models/jvm/m1/alternating-sum-variant.pcert0
-models/jvm/m1/alternating-sum-variant.cert : | models/jvm/m1/alternating-sum-variant.pcert1
-
-models/jvm/m1/alternating-sum.pcert0 : no_pcert = 0
-models/jvm/m1/alternating-sum.pcert0 : acl2x = 0
-models/jvm/m1/alternating-sum.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/alternating-sum.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/alternating-sum.pcert1 : acl2x = 0
-models/jvm/m1/alternating-sum.pcert1 : no_pcert = 0
-models/jvm/m1/alternating-sum.pcert1 : models/jvm/m1/alternating-sum.pcert0
-models/jvm/m1/alternating-sum.cert : | models/jvm/m1/alternating-sum.pcert1
-
-models/jvm/m1/bexpt.pcert0 : no_pcert = 0
-models/jvm/m1/bexpt.pcert0 : acl2x = 0
-models/jvm/m1/bexpt.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/bexpt.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/bexpt.pcert1 : acl2x = 0
-models/jvm/m1/bexpt.pcert1 : no_pcert = 0
-models/jvm/m1/bexpt.pcert1 : models/jvm/m1/bexpt.pcert0
-models/jvm/m1/bexpt.cert : | models/jvm/m1/bexpt.pcert1
-
-models/jvm/m1/defsys-utilities.pcert0 : no_pcert = 0
-models/jvm/m1/defsys-utilities.pcert0 : acl2x = 0
-models/jvm/m1/defsys-utilities.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/defsys-utilities.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/defsys-utilities.pcert1 : acl2x = 0
-models/jvm/m1/defsys-utilities.pcert1 : no_pcert = 0
-models/jvm/m1/defsys-utilities.pcert1 : models/jvm/m1/defsys-utilities.pcert0
-models/jvm/m1/defsys-utilities.cert : | models/jvm/m1/defsys-utilities.pcert1
-
-models/jvm/m1/defsys.pcert0 : no_pcert = 0
-models/jvm/m1/defsys.pcert0 : acl2x = 0
-models/jvm/m1/defsys.pcert0 : \
-     models/jvm/m1/defsys-utilities.pcert0 \
-     models/jvm/m1/defsys.lisp \
-     models/jvm/m1/defsys.acl2
-models/jvm/m1/defsys.pcert1 : acl2x = 0
-models/jvm/m1/defsys.pcert1 : no_pcert = 0
-models/jvm/m1/defsys.pcert1 : models/jvm/m1/defsys.pcert0
-models/jvm/m1/defsys.cert : | models/jvm/m1/defsys.pcert1
-
-models/jvm/m1/div.pcert0 : no_pcert = 0
-models/jvm/m1/div.pcert0 : acl2x = 0
-models/jvm/m1/div.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/div.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/div.pcert1 : acl2x = 0
-models/jvm/m1/div.pcert1 : no_pcert = 0
-models/jvm/m1/div.pcert1 : models/jvm/m1/div.pcert0
-models/jvm/m1/div.cert : | models/jvm/m1/div.pcert1
-
-models/jvm/m1/even-solution-1.pcert0 : no_pcert = 0
-models/jvm/m1/even-solution-1.pcert0 : acl2x = 0
-models/jvm/m1/even-solution-1.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/even-solution-1.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/even-solution-1.pcert1 : acl2x = 0
-models/jvm/m1/even-solution-1.pcert1 : no_pcert = 0
-models/jvm/m1/even-solution-1.pcert1 : models/jvm/m1/even-solution-1.pcert0
-models/jvm/m1/even-solution-1.cert : | models/jvm/m1/even-solution-1.pcert1
-
-models/jvm/m1/even-solution-2.pcert0 : no_pcert = 0
-models/jvm/m1/even-solution-2.pcert0 : acl2x = 0
-models/jvm/m1/even-solution-2.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/even-solution-2.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/even-solution-2.pcert1 : acl2x = 0
-models/jvm/m1/even-solution-2.pcert1 : no_pcert = 0
-models/jvm/m1/even-solution-2.pcert1 : models/jvm/m1/even-solution-2.pcert0
-models/jvm/m1/even-solution-2.cert : | models/jvm/m1/even-solution-2.pcert1
-
-models/jvm/m1/expt.pcert0 : no_pcert = 0
-models/jvm/m1/expt.pcert0 : acl2x = 0
-models/jvm/m1/expt.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/expt.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/expt.pcert1 : acl2x = 0
-models/jvm/m1/expt.pcert1 : no_pcert = 0
-models/jvm/m1/expt.pcert1 : models/jvm/m1/expt.pcert0
-models/jvm/m1/expt.cert : | models/jvm/m1/expt.pcert1
-
-models/jvm/m1/fact.pcert0 : no_pcert = 0
-models/jvm/m1/fact.pcert0 : acl2x = 0
-models/jvm/m1/fact.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/fact.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/fact.pcert1 : acl2x = 0
-models/jvm/m1/fact.pcert1 : no_pcert = 0
-models/jvm/m1/fact.pcert1 : models/jvm/m1/fact.pcert0
-models/jvm/m1/fact.cert : | models/jvm/m1/fact.pcert1
-
-models/jvm/m1/fib.pcert0 : no_pcert = 0
-models/jvm/m1/fib.pcert0 : acl2x = 0
-models/jvm/m1/fib.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/fib.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/fib.pcert1 : acl2x = 0
-models/jvm/m1/fib.pcert1 : no_pcert = 0
-models/jvm/m1/fib.pcert1 : models/jvm/m1/fib.pcert0
-models/jvm/m1/fib.cert : | models/jvm/m1/fib.pcert1
-
-models/jvm/m1/find-k!.pcert0 : no_pcert = 0
-models/jvm/m1/find-k!.pcert0 : acl2x = 0
-models/jvm/m1/find-k!.pcert0 : \
-     models/jvm/m1/theorems-a-and-b.pcert0 \
-     models/jvm/m1/find-k!.lisp \
-     models/jvm/m1/find-k!.acl2
-models/jvm/m1/find-k!.pcert1 : acl2x = 0
-models/jvm/m1/find-k!.pcert1 : no_pcert = 0
-models/jvm/m1/find-k!.pcert1 : models/jvm/m1/find-k!.pcert0
-models/jvm/m1/find-k!.cert : | models/jvm/m1/find-k!.pcert1
-
-models/jvm/m1/funny-fact.pcert0 : no_pcert = 0
-models/jvm/m1/funny-fact.pcert0 : acl2x = 0
-models/jvm/m1/funny-fact.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/funny-fact.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/funny-fact.pcert1 : acl2x = 0
-models/jvm/m1/funny-fact.pcert1 : no_pcert = 0
-models/jvm/m1/funny-fact.pcert1 : models/jvm/m1/funny-fact.pcert0
-models/jvm/m1/funny-fact.cert : | models/jvm/m1/funny-fact.pcert1
-
-models/jvm/m1/implementation.pcert0 : no_pcert = 0
-models/jvm/m1/implementation.pcert0 : acl2x = 0
-models/jvm/m1/implementation.pcert0 : \
-     models/jvm/m1/defsys.pcert0 \
-     models/jvm/m1/tmi-reductions.pcert0 \
-     models/jvm/m1/implementation.lisp \
-     models/jvm/m1/implementation.acl2
-models/jvm/m1/implementation.pcert1 : acl2x = 0
-models/jvm/m1/implementation.pcert1 : no_pcert = 0
-models/jvm/m1/implementation.pcert1 : models/jvm/m1/implementation.pcert0
-models/jvm/m1/implementation.cert : | models/jvm/m1/implementation.pcert1
-
-models/jvm/m1/lessp.pcert0 : no_pcert = 0
-models/jvm/m1/lessp.pcert0 : acl2x = 0
-models/jvm/m1/lessp.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/lessp.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/lessp.pcert1 : acl2x = 0
-models/jvm/m1/lessp.pcert1 : no_pcert = 0
-models/jvm/m1/lessp.pcert1 : models/jvm/m1/lessp.pcert0
-models/jvm/m1/lessp.cert : | models/jvm/m1/lessp.pcert1
-
-models/jvm/m1/low-seven.pcert0 : no_pcert = 0
-models/jvm/m1/low-seven.pcert0 : acl2x = 0
-models/jvm/m1/low-seven.pcert0 : \
-     models/jvm/m1/defsys.pcert0 \
-     models/jvm/m1/low-seven.lisp \
-     models/jvm/m1/low-seven.acl2
-models/jvm/m1/low-seven.pcert1 : acl2x = 0
-models/jvm/m1/low-seven.pcert1 : no_pcert = 0
-models/jvm/m1/low-seven.pcert1 : models/jvm/m1/low-seven.pcert0
-models/jvm/m1/low-seven.cert : | models/jvm/m1/low-seven.pcert1
-
-models/jvm/m1/m1.pcert0 : no_pcert = 0
-models/jvm/m1/m1.pcert0 : acl2x = 0
-models/jvm/m1/m1.pcert0 : \
-     arithmetic-5/top.pcert0 \
-     models/jvm/m1/m1.lisp \
-     models/jvm/m1/m1.acl2
-models/jvm/m1/m1.pcert1 : acl2x = 0
-models/jvm/m1/m1.pcert1 : no_pcert = 0
-models/jvm/m1/m1.pcert1 : models/jvm/m1/m1.pcert0
-models/jvm/m1/m1.cert : | models/jvm/m1/m1.pcert1
-
-models/jvm/m1/magic.pcert0 : no_pcert = 0
-models/jvm/m1/magic.pcert0 : acl2x = 0
-models/jvm/m1/magic.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/magic.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/magic.pcert1 : acl2x = 0
-models/jvm/m1/magic.pcert1 : no_pcert = 0
-models/jvm/m1/magic.pcert1 : models/jvm/m1/magic.pcert0
-models/jvm/m1/magic.cert : | models/jvm/m1/magic.pcert1
-
-models/jvm/m1/power.pcert0 : no_pcert = 0
-models/jvm/m1/power.pcert0 : acl2x = 0
-models/jvm/m1/power.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/power.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/power.pcert1 : acl2x = 0
-models/jvm/m1/power.pcert1 : no_pcert = 0
-models/jvm/m1/power.pcert1 : models/jvm/m1/power.pcert0
-models/jvm/m1/power.cert : | models/jvm/m1/power.pcert1
-
-models/jvm/m1/sign.pcert0 : no_pcert = 0
-models/jvm/m1/sign.pcert0 : acl2x = 0
-models/jvm/m1/sign.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/sign.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/sign.pcert1 : acl2x = 0
-models/jvm/m1/sign.pcert1 : no_pcert = 0
-models/jvm/m1/sign.pcert1 : models/jvm/m1/sign.pcert0
-models/jvm/m1/sign.cert : | models/jvm/m1/sign.pcert1
-
-models/jvm/m1/sum.pcert0 : no_pcert = 0
-models/jvm/m1/sum.pcert0 : acl2x = 0
-models/jvm/m1/sum.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/sum.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/sum.pcert1 : acl2x = 0
-models/jvm/m1/sum.pcert1 : no_pcert = 0
-models/jvm/m1/sum.pcert1 : models/jvm/m1/sum.pcert0
-models/jvm/m1/sum.cert : | models/jvm/m1/sum.pcert1
-
-models/jvm/m1/sumsq.pcert0 : no_pcert = 0
-models/jvm/m1/sumsq.pcert0 : acl2x = 0
-models/jvm/m1/sumsq.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/sumsq.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/sumsq.pcert1 : acl2x = 0
-models/jvm/m1/sumsq.pcert1 : no_pcert = 0
-models/jvm/m1/sumsq.pcert1 : models/jvm/m1/sumsq.pcert0
-models/jvm/m1/sumsq.cert : | models/jvm/m1/sumsq.pcert1
-
-models/jvm/m1/template.pcert0 : no_pcert = 0
-models/jvm/m1/template.pcert0 : acl2x = 0
-models/jvm/m1/template.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/template.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/template.pcert1 : acl2x = 0
-models/jvm/m1/template.pcert1 : no_pcert = 0
-models/jvm/m1/template.pcert1 : models/jvm/m1/template.pcert0
-models/jvm/m1/template.cert : | models/jvm/m1/template.pcert1
-
-models/jvm/m1/theorems-a-and-b.pcert0 : no_pcert = 0
-models/jvm/m1/theorems-a-and-b.pcert0 : acl2x = 0
-models/jvm/m1/theorems-a-and-b.pcert0 : \
-     models/jvm/m1/tmi-reductions.pcert0 \
-     models/jvm/m1/implementation.pcert0 \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/theorems-a-and-b.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/theorems-a-and-b.pcert1 : acl2x = 0
-models/jvm/m1/theorems-a-and-b.pcert1 : no_pcert = 0
-models/jvm/m1/theorems-a-and-b.pcert1 : models/jvm/m1/theorems-a-and-b.pcert0
-models/jvm/m1/theorems-a-and-b.cert : | models/jvm/m1/theorems-a-and-b.pcert1
-
-models/jvm/m1/tmi-reductions.pcert0 : no_pcert = 0
-models/jvm/m1/tmi-reductions.pcert0 : acl2x = 0
-models/jvm/m1/tmi-reductions.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/tmi-reductions.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/tmi-reductions.pcert1 : acl2x = 0
-models/jvm/m1/tmi-reductions.pcert1 : no_pcert = 0
-models/jvm/m1/tmi-reductions.pcert1 : models/jvm/m1/tmi-reductions.pcert0
-models/jvm/m1/tmi-reductions.cert : | models/jvm/m1/tmi-reductions.pcert1
-
-models/jvm/m1/wormhole-abstraction.pcert0 : no_pcert = 0
-models/jvm/m1/wormhole-abstraction.pcert0 : acl2x = 0
-models/jvm/m1/wormhole-abstraction.pcert0 : \
-     models/jvm/m1/m1.pcert0 \
-     models/jvm/m1/wormhole-abstraction.lisp \
-     models/jvm/m1/cert.acl2
-models/jvm/m1/wormhole-abstraction.pcert1 : acl2x = 0
-models/jvm/m1/wormhole-abstraction.pcert1 : no_pcert = 0
-models/jvm/m1/wormhole-abstraction.pcert1 : models/jvm/m1/wormhole-abstraction.pcert0
-models/jvm/m1/wormhole-abstraction.cert : | models/jvm/m1/wormhole-abstraction.pcert1
-
-models/jvm/m5/apprentice-state.pcert0 : no_pcert = 0
-models/jvm/m5/apprentice-state.pcert0 : acl2x = 0
-models/jvm/m5/apprentice-state.pcert0 : \
-     models/jvm/m5/m5.pcert0 \
-     models/jvm/m5/m5.pcert0 \
-     models/jvm/m5/apprentice-state.lisp \
-     models/jvm/m5/apprentice-state.acl2
-models/jvm/m5/apprentice-state.pcert1 : acl2x = 0
-models/jvm/m5/apprentice-state.pcert1 : no_pcert = 0
-models/jvm/m5/apprentice-state.pcert1 : models/jvm/m5/apprentice-state.pcert0
-models/jvm/m5/apprentice-state.cert : | models/jvm/m5/apprentice-state.pcert1
-
-models/jvm/m5/demo.pcert0 : no_pcert = 0
-models/jvm/m5/demo.pcert0 : acl2x = 0
-models/jvm/m5/demo.pcert0 : \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/demo.lisp \
-     models/jvm/m5/demo.acl2
-models/jvm/m5/demo.pcert1 : acl2x = 0
-models/jvm/m5/demo.pcert1 : no_pcert = 0
-models/jvm/m5/demo.pcert1 : models/jvm/m5/demo.pcert0
-models/jvm/m5/demo.cert : | models/jvm/m5/demo.pcert1
-
-models/jvm/m5/idemo.pcert0 : no_pcert = 0
-models/jvm/m5/idemo.pcert0 : acl2x = 0
-models/jvm/m5/idemo.pcert0 : \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/idemo.lisp \
-     models/jvm/m5/idemo.acl2
-models/jvm/m5/idemo.pcert1 : acl2x = 0
-models/jvm/m5/idemo.pcert1 : no_pcert = 0
-models/jvm/m5/idemo.pcert1 : models/jvm/m5/idemo.pcert0
-models/jvm/m5/idemo.cert : | models/jvm/m5/idemo.pcert1
-
-models/jvm/m5/infinite-fair-schedule.pcert0 : no_pcert = 0
-models/jvm/m5/infinite-fair-schedule.pcert0 : acl2x = 0
-models/jvm/m5/infinite-fair-schedule.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     models/jvm/m5/infinite-fair-schedule.lisp
-models/jvm/m5/infinite-fair-schedule.pcert1 : acl2x = 0
-models/jvm/m5/infinite-fair-schedule.pcert1 : no_pcert = 0
-models/jvm/m5/infinite-fair-schedule.pcert1 : models/jvm/m5/infinite-fair-schedule.pcert0
-models/jvm/m5/infinite-fair-schedule.cert : | models/jvm/m5/infinite-fair-schedule.pcert1
-
-models/jvm/m5/isort.pcert0 : no_pcert = 0
-models/jvm/m5/isort.pcert0 : acl2x = 0
-models/jvm/m5/isort.pcert0 : \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/perm.pcert0 \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/isort.lisp \
-     models/jvm/m5/isort.acl2
-models/jvm/m5/isort.pcert1 : acl2x = 0
-models/jvm/m5/isort.pcert1 : no_pcert = 0
-models/jvm/m5/isort.pcert1 : models/jvm/m5/isort.pcert0
-models/jvm/m5/isort.cert : | models/jvm/m5/isort.pcert1
-
-models/jvm/m5/jvm-fact-setup.pcert0 : no_pcert = 0
-models/jvm/m5/jvm-fact-setup.pcert0 : acl2x = 0
-models/jvm/m5/jvm-fact-setup.pcert0 : \
-     models/jvm/m5/utilities.pcert0 \
-     misc/expander.pcert0 \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/jvm-fact-setup.lisp \
-     models/jvm/m5/jvm-fact-setup.acl2
-models/jvm/m5/jvm-fact-setup.pcert1 : acl2x = 0
-models/jvm/m5/jvm-fact-setup.pcert1 : no_pcert = 0
-models/jvm/m5/jvm-fact-setup.pcert1 : models/jvm/m5/jvm-fact-setup.pcert0
-models/jvm/m5/jvm-fact-setup.cert : | models/jvm/m5/jvm-fact-setup.pcert1
-
-models/jvm/m5/m5.pcert0 : no_pcert = 0
-models/jvm/m5/m5.pcert0 : acl2x = 0
-models/jvm/m5/m5.pcert0 : \
-     ordinals/lexicographic-ordering.pcert0 \
-     models/jvm/m5/m5.lisp \
-     models/jvm/m5/m5.acl2
-models/jvm/m5/m5.pcert1 : acl2x = 0
-models/jvm/m5/m5.pcert1 : no_pcert = 0
-models/jvm/m5/m5.pcert1 : models/jvm/m5/m5.pcert0
-models/jvm/m5/m5.cert : | models/jvm/m5/m5.pcert1
-
-models/jvm/m5/partial.pcert0 : no_pcert = 0
-models/jvm/m5/partial.pcert0 : acl2x = 0
-models/jvm/m5/partial.pcert0 : \
-     misc/defpun.pcert0 \
-     models/jvm/m5/demo.pcert0 \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/partial.lisp \
-     models/jvm/m5/partial.acl2
-models/jvm/m5/partial.pcert1 : acl2x = 0
-models/jvm/m5/partial.pcert1 : no_pcert = 0
-models/jvm/m5/partial.pcert1 : models/jvm/m5/partial.pcert0
-models/jvm/m5/partial.cert : | models/jvm/m5/partial.pcert1
-
-models/jvm/m5/perm.pcert0 : no_pcert = 0
-models/jvm/m5/perm.pcert0 : acl2x = 0
-models/jvm/m5/perm.pcert0 : \
-     models/jvm/m5/perm.lisp
-models/jvm/m5/perm.pcert1 : acl2x = 0
-models/jvm/m5/perm.pcert1 : no_pcert = 0
-models/jvm/m5/perm.pcert1 : models/jvm/m5/perm.pcert0
-models/jvm/m5/perm.cert : | models/jvm/m5/perm.pcert1
-
-models/jvm/m5/universal-never-returns.pcert0 : no_pcert = 0
-models/jvm/m5/universal-never-returns.pcert0 : acl2x = 0
-models/jvm/m5/universal-never-returns.pcert0 : \
-     models/jvm/m5/universal.pcert0 \
-     models/jvm/m5/universal.pcert0 \
-     models/jvm/m5/universal-never-returns.lisp \
-     models/jvm/m5/universal-never-returns.acl2
-models/jvm/m5/universal-never-returns.pcert1 : acl2x = 0
-models/jvm/m5/universal-never-returns.pcert1 : no_pcert = 0
-models/jvm/m5/universal-never-returns.pcert1 : models/jvm/m5/universal-never-returns.pcert0
-models/jvm/m5/universal-never-returns.cert : | models/jvm/m5/universal-never-returns.pcert1
-
-models/jvm/m5/universal.pcert0 : no_pcert = 0
-models/jvm/m5/universal.pcert0 : acl2x = 0
-models/jvm/m5/universal.pcert0 : \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/utilities.pcert0 \
-     models/jvm/m5/universal.lisp \
-     models/jvm/m5/universal.acl2
-models/jvm/m5/universal.pcert1 : acl2x = 0
-models/jvm/m5/universal.pcert1 : no_pcert = 0
-models/jvm/m5/universal.pcert1 : models/jvm/m5/universal.pcert0
-models/jvm/m5/universal.cert : | models/jvm/m5/universal.pcert1
-
-models/jvm/m5/utilities.pcert0 : no_pcert = 0
-models/jvm/m5/utilities.pcert0 : acl2x = 0
-models/jvm/m5/utilities.pcert0 : \
-     models/jvm/m5/m5.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     models/jvm/m5/m5.pcert0 \
-     models/jvm/m5/utilities.lisp \
-     models/jvm/m5/utilities.acl2
-models/jvm/m5/utilities.pcert1 : acl2x = 0
-models/jvm/m5/utilities.pcert1 : no_pcert = 0
-models/jvm/m5/utilities.pcert1 : models/jvm/m5/utilities.pcert0
-models/jvm/m5/utilities.cert : | models/jvm/m5/utilities.pcert1
-
-ordinals/e0-ordinal.pcert0 : no_pcert = 0
-ordinals/e0-ordinal.pcert0 : acl2x = 0
-ordinals/e0-ordinal.pcert0 : \
-     ordinals/ordinal-definitions.pcert0 \
-     ordinals/ordinal-isomorphism.pcert0 \
-     ordinals/e0-ordinal.lisp
-ordinals/e0-ordinal.pcert1 : acl2x = 0
-ordinals/e0-ordinal.pcert1 : no_pcert = 0
-ordinals/e0-ordinal.pcert1 : ordinals/e0-ordinal.pcert0
-ordinals/e0-ordinal.cert : | ordinals/e0-ordinal.pcert1
-
-ordinals/lexicographic-book.pcert0 : no_pcert = 0
-ordinals/lexicographic-book.pcert0 : acl2x = 0
-ordinals/lexicographic-book.pcert0 : \
-     ordinals/ordinals-without-arithmetic.pcert0 \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/lexicographic-book.lisp
-ordinals/lexicographic-book.pcert1 : acl2x = 0
-ordinals/lexicographic-book.pcert1 : no_pcert = 0
-ordinals/lexicographic-book.pcert1 : ordinals/lexicographic-book.pcert0
-ordinals/lexicographic-book.cert : | ordinals/lexicographic-book.pcert1
-
-ordinals/lexicographic-ordering-without-arithmetic.pcert0 : no_pcert = 0
-ordinals/lexicographic-ordering-without-arithmetic.pcert0 : acl2x = 0
-ordinals/lexicographic-ordering-without-arithmetic.pcert0 : \
-     ordinals/lexicographic-book.pcert0 \
-     ordinals/lexicographic-ordering-without-arithmetic.lisp
-ordinals/lexicographic-ordering-without-arithmetic.pcert1 : acl2x = 0
-ordinals/lexicographic-ordering-without-arithmetic.pcert1 : no_pcert = 0
-ordinals/lexicographic-ordering-without-arithmetic.pcert1 : ordinals/lexicographic-ordering-without-arithmetic.pcert0
-ordinals/lexicographic-ordering-without-arithmetic.cert : | ordinals/lexicographic-ordering-without-arithmetic.pcert1
-
-ordinals/lexicographic-ordering.pcert0 : no_pcert = 0
-ordinals/lexicographic-ordering.pcert0 : acl2x = 0
-ordinals/lexicographic-ordering.pcert0 : \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/lexicographic-book.pcert0 \
-     ordinals/lexicographic-ordering.lisp
-ordinals/lexicographic-ordering.pcert1 : acl2x = 0
-ordinals/lexicographic-ordering.pcert1 : no_pcert = 0
-ordinals/lexicographic-ordering.pcert1 : ordinals/lexicographic-ordering.pcert0
-ordinals/lexicographic-ordering.cert : | ordinals/lexicographic-ordering.pcert1
-
-ordinals/limits.pcert0 : no_pcert = 0
-ordinals/limits.pcert0 : acl2x = 0
-ordinals/limits.pcert0 : \
-     ordinals/ordinal-exponentiation.pcert0 \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/limits.lisp
-ordinals/limits.pcert1 : acl2x = 0
-ordinals/limits.pcert1 : no_pcert = 0
-ordinals/limits.pcert1 : ordinals/limits.pcert0
-ordinals/limits.cert : | ordinals/limits.pcert1
-
-ordinals/ordinal-addition.pcert0 : no_pcert = 0
-ordinals/ordinal-addition.pcert0 : acl2x = 0
-ordinals/ordinal-addition.pcert0 : \
-     ordinals/ordinal-basic-thms.pcert0 \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/ordinal-addition.lisp
-ordinals/ordinal-addition.pcert1 : acl2x = 0
-ordinals/ordinal-addition.pcert1 : no_pcert = 0
-ordinals/ordinal-addition.pcert1 : ordinals/ordinal-addition.pcert0
-ordinals/ordinal-addition.cert : | ordinals/ordinal-addition.pcert1
-
-ordinals/ordinal-basic-thms.pcert0 : no_pcert = 0
-ordinals/ordinal-basic-thms.pcert0 : acl2x = 0
-ordinals/ordinal-basic-thms.pcert0 : \
-     ordinals/ordinal-total-order.pcert0 \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/ordinal-basic-thms.lisp
-ordinals/ordinal-basic-thms.pcert1 : acl2x = 0
-ordinals/ordinal-basic-thms.pcert1 : no_pcert = 0
-ordinals/ordinal-basic-thms.pcert1 : ordinals/ordinal-basic-thms.pcert0
-ordinals/ordinal-basic-thms.cert : | ordinals/ordinal-basic-thms.pcert1
-
-ordinals/ordinal-counter-examples.pcert0 : no_pcert = 0
-ordinals/ordinal-counter-examples.pcert0 : acl2x = 0
-ordinals/ordinal-counter-examples.pcert0 : \
-     ordinals/ordinal-definitions.pcert0 \
-     ordinals/ordinal-counter-examples.lisp
-ordinals/ordinal-counter-examples.pcert1 : acl2x = 0
-ordinals/ordinal-counter-examples.pcert1 : no_pcert = 0
-ordinals/ordinal-counter-examples.pcert1 : ordinals/ordinal-counter-examples.pcert0
-ordinals/ordinal-counter-examples.cert : | ordinals/ordinal-counter-examples.pcert1
-
-ordinals/ordinal-definitions.pcert0 : no_pcert = 0
-ordinals/ordinal-definitions.pcert0 : acl2x = 0
-ordinals/ordinal-definitions.pcert0 : \
-     ordinals/ordinal-definitions.lisp
-ordinals/ordinal-definitions.pcert1 : acl2x = 0
-ordinals/ordinal-definitions.pcert1 : no_pcert = 0
-ordinals/ordinal-definitions.pcert1 : ordinals/ordinal-definitions.pcert0
-ordinals/ordinal-definitions.cert : | ordinals/ordinal-definitions.pcert1
-
-ordinals/ordinal-exponentiation.pcert0 : no_pcert = 0
-ordinals/ordinal-exponentiation.pcert0 : acl2x = 0
-ordinals/ordinal-exponentiation.pcert0 : \
-     ordinals/ordinal-multiplication.pcert0 \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/ordinal-exponentiation.lisp
-ordinals/ordinal-exponentiation.pcert1 : acl2x = 0
-ordinals/ordinal-exponentiation.pcert1 : no_pcert = 0
-ordinals/ordinal-exponentiation.pcert1 : ordinals/ordinal-exponentiation.pcert0
-ordinals/ordinal-exponentiation.cert : | ordinals/ordinal-exponentiation.pcert1
-
-ordinals/ordinal-isomorphism.pcert0 : no_pcert = 0
-ordinals/ordinal-isomorphism.pcert0 : acl2x = 0
-ordinals/ordinal-isomorphism.pcert0 : \
-     ordinals/ordinal-addition.pcert0 \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/ordinal-isomorphism.lisp
-ordinals/ordinal-isomorphism.pcert1 : acl2x = 0
-ordinals/ordinal-isomorphism.pcert1 : no_pcert = 0
-ordinals/ordinal-isomorphism.pcert1 : ordinals/ordinal-isomorphism.pcert0
-ordinals/ordinal-isomorphism.cert : | ordinals/ordinal-isomorphism.pcert1
-
-ordinals/ordinal-multiplication.pcert0 : no_pcert = 0
-ordinals/ordinal-multiplication.pcert0 : acl2x = 0
-ordinals/ordinal-multiplication.pcert0 : \
-     ordinals/ordinal-addition.pcert0 \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/ordinal-multiplication.lisp
-ordinals/ordinal-multiplication.pcert1 : acl2x = 0
-ordinals/ordinal-multiplication.pcert1 : no_pcert = 0
-ordinals/ordinal-multiplication.pcert1 : ordinals/ordinal-multiplication.pcert0
-ordinals/ordinal-multiplication.cert : | ordinals/ordinal-multiplication.pcert1
-
-ordinals/ordinal-total-order.pcert0 : no_pcert = 0
-ordinals/ordinal-total-order.pcert0 : acl2x = 0
-ordinals/ordinal-total-order.pcert0 : \
-     ordinals/ordinal-definitions.pcert0 \
-     ordinals/ordinal-total-order.lisp
-ordinals/ordinal-total-order.pcert1 : acl2x = 0
-ordinals/ordinal-total-order.pcert1 : no_pcert = 0
-ordinals/ordinal-total-order.pcert1 : ordinals/ordinal-total-order.pcert0
-ordinals/ordinal-total-order.cert : | ordinals/ordinal-total-order.pcert1
-
-ordinals/ordinals-without-arithmetic.pcert0 : no_pcert = 0
-ordinals/ordinals-without-arithmetic.pcert0 : acl2x = 0
-ordinals/ordinals-without-arithmetic.pcert0 : \
-     ordinals/limits.pcert0 \
-     ordinals/ordinals-without-arithmetic.lisp
-ordinals/ordinals-without-arithmetic.pcert1 : acl2x = 0
-ordinals/ordinals-without-arithmetic.pcert1 : no_pcert = 0
-ordinals/ordinals-without-arithmetic.pcert1 : ordinals/ordinals-without-arithmetic.pcert0
-ordinals/ordinals-without-arithmetic.cert : | ordinals/ordinals-without-arithmetic.pcert1
-
-ordinals/ordinals.pcert0 : no_pcert = 0
-ordinals/ordinals.pcert0 : acl2x = 0
-ordinals/ordinals.pcert0 : \
-     ordinals/top-with-meta.pcert0 \
-     ordinals/limits.pcert0 \
-     ordinals/ordinals.lisp
-ordinals/ordinals.pcert1 : acl2x = 0
-ordinals/ordinals.pcert1 : no_pcert = 0
-ordinals/ordinals.pcert1 : ordinals/ordinals.pcert0
-ordinals/ordinals.cert : | ordinals/ordinals.pcert1
-
-ordinals/proof-of-well-foundedness.pcert0 : no_pcert = 0
-ordinals/proof-of-well-foundedness.pcert0 : acl2x = 0
-ordinals/proof-of-well-foundedness.pcert0 : \
-     ordinals/proof-of-well-foundedness.lisp \
-     ordinals/proof-of-well-foundedness.acl2
-ordinals/proof-of-well-foundedness.pcert1 : acl2x = 0
-ordinals/proof-of-well-foundedness.pcert1 : no_pcert = 0
-ordinals/proof-of-well-foundedness.pcert1 : ordinals/proof-of-well-foundedness.pcert0
-ordinals/proof-of-well-foundedness.cert : | ordinals/proof-of-well-foundedness.pcert1
-
-ordinals/top-with-meta.pcert0 : no_pcert = 0
-ordinals/top-with-meta.pcert0 : acl2x = 0
-ordinals/top-with-meta.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     ordinals/top-with-meta.lisp
-ordinals/top-with-meta.pcert1 : acl2x = 0
-ordinals/top-with-meta.pcert1 : no_pcert = 0
-ordinals/top-with-meta.pcert1 : ordinals/top-with-meta.pcert0
-ordinals/top-with-meta.cert : | ordinals/top-with-meta.pcert1
-
-oslib/catpath.pcert0 : no_pcert = 0
-oslib/catpath.pcert0 : acl2x = 0
-oslib/catpath.pcert0 : \
-     cutil/define.pcert0 \
-     misc/assert.pcert0 \
-     oslib/portcullis.pcert0 \
-     oslib/catpath.lisp \
-     oslib/cert.acl2
-oslib/catpath.pcert1 : acl2x = 0
-oslib/catpath.pcert1 : no_pcert = 0
-oslib/catpath.pcert1 : oslib/catpath.pcert0
-oslib/catpath.cert : | oslib/catpath.pcert1
-
-oslib/date.pcert0 : no_pcert = 0
-oslib/date.pcert0 : acl2x = 0
-oslib/date.pcert0 : \
-     oslib/read-acl2-oracle.pcert0 \
-     cutil/define.pcert0 \
-     tools/include-raw.pcert0 \
-     str/cat.pcert0 \
-     str/natstr.pcert0 \
-     oslib/portcullis.pcert0 \
-     oslib/date.lisp \
-     oslib/cert.acl2 \
-     oslib/date-raw.lsp
-oslib/date.pcert1 : acl2x = 0
-oslib/date.pcert1 : no_pcert = 0
-oslib/date.pcert1 : oslib/date.pcert0
-oslib/date.cert : | oslib/date.pcert1
-
-oslib/getpid.pcert0 : no_pcert = 0
-oslib/getpid.pcert0 : acl2x = 0
-oslib/getpid.pcert0 : \
-     oslib/read-acl2-oracle.pcert0 \
-     cutil/define.pcert0 \
-     tools/include-raw.pcert0 \
-     oslib/portcullis.pcert0 \
-     oslib/getpid.lisp \
-     oslib/cert.acl2 \
-     oslib/getpid-raw.lsp
-oslib/getpid.pcert1 : acl2x = 0
-oslib/getpid.pcert1 : no_pcert = 0
-oslib/getpid.pcert1 : oslib/getpid.pcert0
-oslib/getpid.cert : | oslib/getpid.pcert1
-
-oslib/ls.pcert0 : no_pcert = 0
-oslib/ls.pcert0 : acl2x = 0
-oslib/ls.pcert0 : \
-     oslib/read-acl2-oracle.pcert0 \
-     cutil/define.pcert0 \
-     tools/include-raw.pcert0 \
-     oslib/portcullis.pcert0 \
-     oslib/ls.lisp \
-     oslib/cert.acl2 \
-     oslib/ls-raw.lsp
-oslib/ls.pcert1 : acl2x = 0
-oslib/ls.pcert1 : no_pcert = 0
-oslib/ls.pcert1 : oslib/ls.pcert0
-oslib/ls.cert : | oslib/ls.pcert1
-
-oslib/portcullis.pcert0 : no_pcert = 0
-oslib/portcullis.pcert0 : acl2x = 0
-oslib/portcullis.pcert0 : \
-     oslib/portcullis.lisp \
-     oslib/portcullis.acl2 \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-oslib/portcullis.pcert1 : acl2x = 0
-oslib/portcullis.pcert1 : no_pcert = 0
-oslib/portcullis.pcert1 : oslib/portcullis.pcert0
-oslib/portcullis.cert : | oslib/portcullis.pcert1
-
-oslib/read-acl2-oracle.pcert0 : no_pcert = 0
-oslib/read-acl2-oracle.pcert0 : acl2x = 0
-oslib/read-acl2-oracle.pcert0 : \
-     oslib/portcullis.pcert0 \
-     oslib/read-acl2-oracle.lisp \
-     oslib/cert.acl2
-oslib/read-acl2-oracle.pcert1 : acl2x = 0
-oslib/read-acl2-oracle.pcert1 : no_pcert = 0
-oslib/read-acl2-oracle.pcert1 : oslib/read-acl2-oracle.pcert0
-oslib/read-acl2-oracle.cert : | oslib/read-acl2-oracle.pcert1
-
-oslib/tempfile.pcert0 : no_pcert = 0
-oslib/tempfile.pcert0 : acl2x = 0
-oslib/tempfile.pcert0 : \
-     oslib/getpid.pcert0 \
-     oslib/catpath.pcert0 \
-     str/natstr.pcert0 \
-     str/cat.pcert0 \
-     oslib/portcullis.pcert0 \
-     oslib/tempfile.lisp \
-     oslib/cert.acl2
-oslib/tempfile.pcert1 : acl2x = 0
-oslib/tempfile.pcert1 : no_pcert = 0
-oslib/tempfile.pcert1 : oslib/tempfile.pcert0
-oslib/tempfile.cert : | oslib/tempfile.pcert1
-
-oslib/top.pcert0 : no_pcert = 0
-oslib/top.pcert0 : acl2x = 0
-oslib/top.pcert0 : \
-     oslib/catpath.pcert0 \
-     oslib/date.pcert0 \
-     oslib/getpid.pcert0 \
-     oslib/ls.pcert0 \
-     oslib/tempfile.pcert0 \
-     oslib/portcullis.pcert0 \
-     oslib/top.lisp \
-     oslib/cert.acl2
-oslib/top.pcert1 : acl2x = 0
-oslib/top.pcert1 : no_pcert = 0
-oslib/top.pcert1 : oslib/top.pcert0
-oslib/top.cert : | oslib/top.pcert1
-
-paco/database.pcert0 : no_pcert = 0
-paco/database.pcert0 : acl2x = 0
-paco/database.pcert0 : \
-     paco/prove.pcert0 \
-     paco/database.lisp \
-     paco/database.acl2 \
-     paco/acl2-customization.lsp
-paco/database.pcert1 : acl2x = 0
-paco/database.pcert1 : no_pcert = 0
-paco/database.pcert1 : paco/database.pcert0
-paco/database.cert : | paco/database.pcert1
-
-paco/elim-dest.pcert0 : no_pcert = 0
-paco/elim-dest.pcert0 : acl2x = 0
-paco/elim-dest.pcert0 : \
-     paco/simplify.pcert0 \
-     paco/elim-dest.lisp \
-     paco/elim-dest.acl2 \
-     paco/acl2-customization.lsp
-paco/elim-dest.pcert1 : acl2x = 0
-paco/elim-dest.pcert1 : no_pcert = 0
-paco/elim-dest.pcert1 : paco/elim-dest.pcert0
-paco/elim-dest.cert : | paco/elim-dest.pcert1
-
-paco/foundations.pcert0 : no_pcert = 0
-paco/foundations.pcert0 : acl2x = 0
-paco/foundations.pcert0 : \
-     paco/output-module.pcert0 \
-     paco/foundations.lisp \
-     paco/foundations.acl2 \
-     paco/acl2-customization.lsp
-paco/foundations.pcert1 : acl2x = 0
-paco/foundations.pcert1 : no_pcert = 0
-paco/foundations.pcert1 : paco/foundations.pcert0
-paco/foundations.cert : | paco/foundations.pcert1
-
-paco/induct.pcert0 : no_pcert = 0
-paco/induct.pcert0 : acl2x = 0
-paco/induct.pcert0 : \
-     paco/elim-dest.pcert0 \
-     paco/induct.lisp \
-     paco/induct.acl2 \
-     paco/acl2-customization.lsp
-paco/induct.pcert1 : acl2x = 0
-paco/induct.pcert1 : no_pcert = 0
-paco/induct.pcert1 : paco/induct.pcert0
-paco/induct.cert : | paco/induct.pcert1
-
-paco/output-module.pcert0 : no_pcert = 0
-paco/output-module.pcert0 : acl2x = 0
-paco/output-module.pcert0 : \
-     paco/utilities.pcert0 \
-     paco/output-module.lisp \
-     paco/output-module.acl2 \
-     paco/acl2-customization.lsp
-paco/output-module.pcert1 : acl2x = 0
-paco/output-module.pcert1 : no_pcert = 0
-paco/output-module.pcert1 : paco/output-module.pcert0
-paco/output-module.cert : | paco/output-module.pcert1
-
-paco/paco.pcert0 : no_pcert = 0
-paco/paco.pcert0 : acl2x = 0
-paco/paco.pcert0 : \
-     paco/utilities.pcert0 \
-     paco/foundations.pcert0 \
-     paco/type-set.pcert0 \
-     paco/rewrite.pcert0 \
-     paco/simplify.pcert0 \
-     paco/induct.pcert0 \
-     paco/prove.pcert0 \
-     paco/database.pcert0 \
-     paco/database.pcert0 \
-     paco/paco.lisp \
-     paco/paco.acl2 \
-     paco/acl2-customization.lsp
-paco/paco.pcert1 : acl2x = 0
-paco/paco.pcert1 : no_pcert = 0
-paco/paco.pcert1 : paco/paco.pcert0
-paco/paco.cert : | paco/paco.pcert1
-
-paco/prove.pcert0 : no_pcert = 0
-paco/prove.pcert0 : acl2x = 0
-paco/prove.pcert0 : \
-     paco/induct.pcert0 \
-     paco/prove.lisp \
-     paco/prove.acl2 \
-     paco/acl2-customization.lsp
-paco/prove.pcert1 : acl2x = 0
-paco/prove.pcert1 : no_pcert = 0
-paco/prove.pcert1 : paco/prove.pcert0
-paco/prove.cert : | paco/prove.pcert1
-
-paco/rewrite.pcert0 : no_pcert = 0
-paco/rewrite.pcert0 : acl2x = 0
-paco/rewrite.pcert0 : \
-     paco/type-set.pcert0 \
-     paco/rewrite.lisp \
-     paco/rewrite.acl2 \
-     paco/acl2-customization.lsp
-paco/rewrite.pcert1 : acl2x = 0
-paco/rewrite.pcert1 : no_pcert = 0
-paco/rewrite.pcert1 : paco/rewrite.pcert0
-paco/rewrite.cert : | paco/rewrite.pcert1
-
-paco/simplify.pcert0 : no_pcert = 0
-paco/simplify.pcert0 : acl2x = 0
-paco/simplify.pcert0 : \
-     paco/rewrite.pcert0 \
-     paco/simplify.lisp \
-     paco/simplify.acl2 \
-     paco/acl2-customization.lsp
-paco/simplify.pcert1 : acl2x = 0
-paco/simplify.pcert1 : no_pcert = 0
-paco/simplify.pcert1 : paco/simplify.pcert0
-paco/simplify.cert : | paco/simplify.pcert1
-
-paco/type-set.pcert0 : no_pcert = 0
-paco/type-set.pcert0 : acl2x = 0
-paco/type-set.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     paco/foundations.pcert0 \
-     paco/type-set.lisp \
-     paco/type-set.acl2 \
-     paco/acl2-customization.lsp
-paco/type-set.pcert1 : acl2x = 0
-paco/type-set.pcert1 : no_pcert = 0
-paco/type-set.pcert1 : paco/type-set.pcert0
-paco/type-set.cert : | paco/type-set.pcert1
-
-paco/utilities.pcert0 : no_pcert = 0
-paco/utilities.pcert0 : acl2x = 0
-paco/utilities.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     paco/utilities.lisp \
-     paco/utilities.acl2 \
-     paco/acl2-customization.lsp
-paco/utilities.pcert1 : acl2x = 0
-paco/utilities.pcert1 : no_pcert = 0
-paco/utilities.pcert1 : paco/utilities.pcert0
-paco/utilities.cert : | paco/utilities.pcert1
-
-parallel/fibonacci.pcert0 : no_pcert = 0
-parallel/fibonacci.pcert0 : acl2x = 0
-parallel/fibonacci.pcert0 : \
-     make-event/assert.pcert0 \
-     parallel/fibonacci.lisp
-parallel/fibonacci.pcert1 : acl2x = 0
-parallel/fibonacci.pcert1 : no_pcert = 0
-parallel/fibonacci.pcert1 : parallel/fibonacci.pcert0
-parallel/fibonacci.cert : | parallel/fibonacci.pcert1
-
-parallel/hint-tests.pcert0 : no_pcert = 0
-parallel/hint-tests.pcert0 : acl2x = 0
-parallel/hint-tests.pcert0 : \
-     make-event/eval.pcert0 \
-     parallel/hint-tests.lisp \
-     parallel/hint-tests.acl2
-parallel/hint-tests.pcert1 : acl2x = 0
-parallel/hint-tests.pcert1 : no_pcert = 0
-parallel/hint-tests.pcert1 : parallel/hint-tests.pcert0
-parallel/hint-tests.cert : | parallel/hint-tests.pcert1
-
-parallel/matrix-multiplication-parallel.pcert0 : no_pcert = 0
-parallel/matrix-multiplication-parallel.pcert0 : acl2x = 0
-parallel/matrix-multiplication-parallel.pcert0 : \
-     make-event/assert.pcert0 \
-     make-event/embeddable-event-forms.pcert0 \
-     parallel/matrix-multiplication-setup.pcert0 \
-     parallel/matrix-multiplication-parallel.lisp
-parallel/matrix-multiplication-parallel.pcert1 : acl2x = 0
-parallel/matrix-multiplication-parallel.pcert1 : no_pcert = 0
-parallel/matrix-multiplication-parallel.pcert1 : parallel/matrix-multiplication-parallel.pcert0
-parallel/matrix-multiplication-parallel.cert : | parallel/matrix-multiplication-parallel.pcert1
-
-parallel/matrix-multiplication-serial.pcert0 : no_pcert = 0
-parallel/matrix-multiplication-serial.pcert0 : acl2x = 0
-parallel/matrix-multiplication-serial.pcert0 : \
-     make-event/assert.pcert0 \
-     make-event/embeddable-event-forms.pcert0 \
-     parallel/matrix-multiplication-setup.pcert0 \
-     parallel/matrix-multiplication-serial.lisp
-parallel/matrix-multiplication-serial.pcert1 : acl2x = 0
-parallel/matrix-multiplication-serial.pcert1 : no_pcert = 0
-parallel/matrix-multiplication-serial.pcert1 : parallel/matrix-multiplication-serial.pcert0
-parallel/matrix-multiplication-serial.cert : | parallel/matrix-multiplication-serial.pcert1
-
-parallel/matrix-multiplication-setup.pcert0 : no_pcert = 0
-parallel/matrix-multiplication-setup.pcert0 : acl2x = 0
-parallel/matrix-multiplication-setup.pcert0 : \
-     parallel/matrix-multiplication-setup.lisp
-parallel/matrix-multiplication-setup.pcert1 : acl2x = 0
-parallel/matrix-multiplication-setup.pcert1 : no_pcert = 0
-parallel/matrix-multiplication-setup.pcert1 : parallel/matrix-multiplication-setup.pcert0
-parallel/matrix-multiplication-setup.cert : | parallel/matrix-multiplication-setup.pcert1
-
-parallel/spec-mv-let.pcert0 : no_pcert = 0
-parallel/spec-mv-let.pcert0 : acl2x = 0
-parallel/spec-mv-let.pcert0 : \
-     make-event/assert.pcert0 \
-     make-event/eval.pcert0 \
-     parallel/spec-mv-let.lisp
-parallel/spec-mv-let.pcert1 : acl2x = 0
-parallel/spec-mv-let.pcert1 : no_pcert = 0
-parallel/spec-mv-let.pcert1 : parallel/spec-mv-let.pcert0
-parallel/spec-mv-let.cert : | parallel/spec-mv-let.pcert1
-
-parallel/stress-tests.pcert0 : no_pcert = 0
-parallel/stress-tests.pcert0 : acl2x = 0
-parallel/stress-tests.pcert0 : \
-     make-event/assert.pcert0 \
-     make-event/eval.pcert0 \
-     parallel/stress-tests.lisp
-parallel/stress-tests.pcert1 : acl2x = 0
-parallel/stress-tests.pcert1 : no_pcert = 0
-parallel/stress-tests.pcert1 : parallel/stress-tests.pcert0
-parallel/stress-tests.cert : | parallel/stress-tests.pcert1
-
-parallel/syntax-tests.pcert0 : no_pcert = 0
-parallel/syntax-tests.pcert0 : acl2x = 0
-parallel/syntax-tests.pcert0 : \
-     make-event/assert.pcert0 \
-     make-event/eval.pcert0 \
-     parallel/syntax-tests.lisp
-parallel/syntax-tests.pcert1 : acl2x = 0
-parallel/syntax-tests.pcert1 : no_pcert = 0
-parallel/syntax-tests.pcert1 : parallel/syntax-tests.pcert0
-parallel/syntax-tests.cert : | parallel/syntax-tests.pcert1
-
-parallel/with-waterfall-parallelism.pcert0 : no_pcert = 0
-parallel/with-waterfall-parallelism.pcert0 : acl2x = 0
-parallel/with-waterfall-parallelism.pcert0 : \
-     parallel/with-waterfall-parallelism.lisp
-parallel/with-waterfall-parallelism.pcert1 : acl2x = 0
-parallel/with-waterfall-parallelism.pcert1 : no_pcert = 0
-parallel/with-waterfall-parallelism.pcert1 : parallel/with-waterfall-parallelism.pcert0
-parallel/with-waterfall-parallelism.cert : | parallel/with-waterfall-parallelism.pcert1
-
-parallel/without-waterfall-parallelism.pcert0 : no_pcert = 0
-parallel/without-waterfall-parallelism.pcert0 : acl2x = 0
-parallel/without-waterfall-parallelism.pcert0 : \
-     parallel/without-waterfall-parallelism.lisp
-parallel/without-waterfall-parallelism.pcert1 : acl2x = 0
-parallel/without-waterfall-parallelism.pcert1 : no_pcert = 0
-parallel/without-waterfall-parallelism.pcert1 : parallel/without-waterfall-parallelism.pcert0
-parallel/without-waterfall-parallelism.cert : | parallel/without-waterfall-parallelism.pcert1
-
-powerlists/algebra.pcert0 : no_pcert = 0
-powerlists/algebra.pcert0 : acl2x = 0
-powerlists/algebra.pcert0 : \
-     data-structures/structures.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     powerlists/algebra.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/algebra.pcert1 : acl2x = 0
-powerlists/algebra.pcert1 : no_pcert = 0
-powerlists/algebra.pcert1 : powerlists/algebra.pcert0
-powerlists/algebra.cert : | powerlists/algebra.pcert1
-
-powerlists/batcher-sort.pcert0 : no_pcert = 0
-powerlists/batcher-sort.pcert0 : acl2x = 0
-powerlists/batcher-sort.pcert0 : \
-     powerlists/merge-sort.pcert0 \
-     arithmetic/top.pcert0 \
-     powerlists/batcher-sort.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/batcher-sort.pcert1 : acl2x = 0
-powerlists/batcher-sort.pcert1 : no_pcert = 0
-powerlists/batcher-sort.pcert1 : powerlists/batcher-sort.pcert0
-powerlists/batcher-sort.cert : | powerlists/batcher-sort.pcert1
-
-powerlists/bitonic-sort.pcert0 : no_pcert = 0
-powerlists/bitonic-sort.pcert0 : acl2x = 0
-powerlists/bitonic-sort.pcert0 : \
-     powerlists/algebra.pcert0 \
-     powerlists/simple.pcert0 \
-     powerlists/sort.pcert0 \
-     powerlists/batcher-sort.pcert0 \
-     arithmetic/top.pcert0 \
-     powerlists/bitonic-sort.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/bitonic-sort.pcert1 : acl2x = 0
-powerlists/bitonic-sort.pcert1 : no_pcert = 0
-powerlists/bitonic-sort.pcert1 : powerlists/bitonic-sort.pcert0
-powerlists/bitonic-sort.cert : | powerlists/bitonic-sort.pcert1
-
-powerlists/cla-adder.pcert0 : no_pcert = 0
-powerlists/cla-adder.pcert0 : acl2x = 0
-powerlists/cla-adder.pcert0 : \
-     powerlists/prefix-sum.pcert0 \
-     powerlists/algebra.pcert0 \
-     arithmetic/top.pcert0 \
-     powerlists/cla-adder.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/cla-adder.pcert1 : acl2x = 0
-powerlists/cla-adder.pcert1 : no_pcert = 0
-powerlists/cla-adder.pcert1 : powerlists/cla-adder.pcert0
-powerlists/cla-adder.cert : | powerlists/cla-adder.pcert1
-
-powerlists/gray-code.pcert0 : no_pcert = 0
-powerlists/gray-code.pcert0 : acl2x = 0
-powerlists/gray-code.pcert0 : \
-     powerlists/algebra.pcert0 \
-     powerlists/simple.pcert0 \
-     powerlists/gray-code.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/gray-code.pcert1 : acl2x = 0
-powerlists/gray-code.pcert1 : no_pcert = 0
-powerlists/gray-code.pcert1 : powerlists/gray-code.pcert0
-powerlists/gray-code.cert : | powerlists/gray-code.pcert1
-
-powerlists/merge-sort.pcert0 : no_pcert = 0
-powerlists/merge-sort.pcert0 : acl2x = 0
-powerlists/merge-sort.pcert0 : \
-     powerlists/algebra.pcert0 \
-     powerlists/sort.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     powerlists/merge-sort.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/merge-sort.pcert1 : acl2x = 0
-powerlists/merge-sort.pcert1 : no_pcert = 0
-powerlists/merge-sort.pcert1 : powerlists/merge-sort.pcert0
-powerlists/merge-sort.cert : | powerlists/merge-sort.pcert1
-
-powerlists/prefix-sum.pcert0 : no_pcert = 0
-powerlists/prefix-sum.pcert0 : acl2x = 0
-powerlists/prefix-sum.pcert0 : \
-     powerlists/algebra.pcert0 \
-     powerlists/simple.pcert0 \
-     arithmetic/top.pcert0 \
-     powerlists/prefix-sum.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/prefix-sum.pcert1 : acl2x = 0
-powerlists/prefix-sum.pcert1 : no_pcert = 0
-powerlists/prefix-sum.pcert1 : powerlists/prefix-sum.pcert0
-powerlists/prefix-sum.cert : | powerlists/prefix-sum.pcert1
-
-powerlists/simple.pcert0 : no_pcert = 0
-powerlists/simple.pcert0 : acl2x = 0
-powerlists/simple.pcert0 : \
-     powerlists/algebra.pcert0 \
-     arithmetic/top.pcert0 \
-     powerlists/simple.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/simple.pcert1 : acl2x = 0
-powerlists/simple.pcert1 : no_pcert = 0
-powerlists/simple.pcert1 : powerlists/simple.pcert0
-powerlists/simple.cert : | powerlists/simple.pcert1
-
-powerlists/sort.pcert0 : no_pcert = 0
-powerlists/sort.pcert0 : acl2x = 0
-powerlists/sort.pcert0 : \
-     powerlists/algebra.pcert0 \
-     powerlists/sort.lisp \
-     powerlists/cert.acl2 \
-     powerlists/defpkg.lsp
-powerlists/sort.pcert1 : acl2x = 0
-powerlists/sort.pcert1 : no_pcert = 0
-powerlists/sort.pcert1 : powerlists/sort.pcert0
-powerlists/sort.cert : | powerlists/sort.pcert1
-
-proofstyles/completeness/assertions-partial.pcert0 : no_pcert = 0
-proofstyles/completeness/assertions-partial.pcert0 : acl2x = 0
-proofstyles/completeness/assertions-partial.pcert0 : \
-     misc/defpun.pcert0 \
-     ordinals/ordinals.pcert0 \
-     proofstyles/completeness/stepwise-invariants-partial.pcert0 \
-     proofstyles/completeness/assertions-partial.lisp
-proofstyles/completeness/assertions-partial.pcert1 : acl2x = 0
-proofstyles/completeness/assertions-partial.pcert1 : no_pcert = 0
-proofstyles/completeness/assertions-partial.pcert1 : proofstyles/completeness/assertions-partial.pcert0
-proofstyles/completeness/assertions-partial.cert : | proofstyles/completeness/assertions-partial.pcert1
-
-proofstyles/completeness/assertions-total.pcert0 : no_pcert = 0
-proofstyles/completeness/assertions-total.pcert0 : acl2x = 0
-proofstyles/completeness/assertions-total.pcert0 : \
-     misc/defpun.pcert0 \
-     ordinals/ordinals.pcert0 \
-     proofstyles/completeness/stepwise-invariants-total.pcert0 \
-     proofstyles/completeness/assertions-total.lisp
-proofstyles/completeness/assertions-total.pcert1 : acl2x = 0
-proofstyles/completeness/assertions-total.pcert1 : no_pcert = 0
-proofstyles/completeness/assertions-total.pcert1 : proofstyles/completeness/assertions-total.pcert0
-proofstyles/completeness/assertions-total.cert : | proofstyles/completeness/assertions-total.pcert1
-
-proofstyles/completeness/clock-partial.pcert0 : no_pcert = 0
-proofstyles/completeness/clock-partial.pcert0 : acl2x = 0
-proofstyles/completeness/clock-partial.pcert0 : \
-     proofstyles/completeness/generic-partial.pcert0 \
-     misc/defpun.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     proofstyles/completeness/clock-partial.lisp
-proofstyles/completeness/clock-partial.pcert1 : acl2x = 0
-proofstyles/completeness/clock-partial.pcert1 : no_pcert = 0
-proofstyles/completeness/clock-partial.pcert1 : proofstyles/completeness/clock-partial.pcert0
-proofstyles/completeness/clock-partial.cert : | proofstyles/completeness/clock-partial.pcert1
-
-proofstyles/completeness/clock-total.pcert0 : no_pcert = 0
-proofstyles/completeness/clock-total.pcert0 : acl2x = 0
-proofstyles/completeness/clock-total.pcert0 : \
-     proofstyles/completeness/generic-total.pcert0 \
-     misc/defpun.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     proofstyles/completeness/clock-total.lisp
-proofstyles/completeness/clock-total.pcert1 : acl2x = 0
-proofstyles/completeness/clock-total.pcert1 : no_pcert = 0
-proofstyles/completeness/clock-total.pcert1 : proofstyles/completeness/clock-total.pcert0
-proofstyles/completeness/clock-total.cert : | proofstyles/completeness/clock-total.pcert1
-
-proofstyles/completeness/generic-partial.pcert0 : no_pcert = 0
-proofstyles/completeness/generic-partial.pcert0 : acl2x = 0
-proofstyles/completeness/generic-partial.pcert0 : \
-     proofstyles/completeness/generic-partial.lisp
-proofstyles/completeness/generic-partial.pcert1 : acl2x = 0
-proofstyles/completeness/generic-partial.pcert1 : no_pcert = 0
-proofstyles/completeness/generic-partial.pcert1 : proofstyles/completeness/generic-partial.pcert0
-proofstyles/completeness/generic-partial.cert : | proofstyles/completeness/generic-partial.pcert1
-
-proofstyles/completeness/generic-total.pcert0 : no_pcert = 0
-proofstyles/completeness/generic-total.pcert0 : acl2x = 0
-proofstyles/completeness/generic-total.pcert0 : \
-     proofstyles/completeness/generic-total.lisp
-proofstyles/completeness/generic-total.pcert1 : acl2x = 0
-proofstyles/completeness/generic-total.pcert1 : no_pcert = 0
-proofstyles/completeness/generic-total.pcert1 : proofstyles/completeness/generic-total.pcert0
-proofstyles/completeness/generic-total.cert : | proofstyles/completeness/generic-total.pcert1
-
-proofstyles/completeness/stepwise-invariants-partial.pcert0 : no_pcert = 0
-proofstyles/completeness/stepwise-invariants-partial.pcert0 : acl2x = 0
-proofstyles/completeness/stepwise-invariants-partial.pcert0 : \
-     proofstyles/completeness/clock-partial.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     proofstyles/completeness/stepwise-invariants-partial.lisp
-proofstyles/completeness/stepwise-invariants-partial.pcert1 : acl2x = 0
-proofstyles/completeness/stepwise-invariants-partial.pcert1 : no_pcert = 0
-proofstyles/completeness/stepwise-invariants-partial.pcert1 : proofstyles/completeness/stepwise-invariants-partial.pcert0
-proofstyles/completeness/stepwise-invariants-partial.cert : | proofstyles/completeness/stepwise-invariants-partial.pcert1
-
-proofstyles/completeness/stepwise-invariants-total.pcert0 : no_pcert = 0
-proofstyles/completeness/stepwise-invariants-total.pcert0 : acl2x = 0
-proofstyles/completeness/stepwise-invariants-total.pcert0 : \
-     proofstyles/completeness/clock-total.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     proofstyles/completeness/stepwise-invariants-total.lisp
-proofstyles/completeness/stepwise-invariants-total.pcert1 : acl2x = 0
-proofstyles/completeness/stepwise-invariants-total.pcert1 : no_pcert = 0
-proofstyles/completeness/stepwise-invariants-total.pcert1 : proofstyles/completeness/stepwise-invariants-total.pcert0
-proofstyles/completeness/stepwise-invariants-total.cert : | proofstyles/completeness/stepwise-invariants-total.pcert1
-
-proofstyles/counterexamples/halt-flg.pcert0 : no_pcert = 0
-proofstyles/counterexamples/halt-flg.pcert0 : acl2x = 0
-proofstyles/counterexamples/halt-flg.pcert0 : \
-     misc/defpun.pcert0 \
-     proofstyles/counterexamples/halt-flg.lisp
-proofstyles/counterexamples/halt-flg.pcert1 : acl2x = 0
-proofstyles/counterexamples/halt-flg.pcert1 : no_pcert = 0
-proofstyles/counterexamples/halt-flg.pcert1 : proofstyles/counterexamples/halt-flg.pcert0
-proofstyles/counterexamples/halt-flg.cert : | proofstyles/counterexamples/halt-flg.pcert1
-
-proofstyles/counterexamples/memory-clearing.pcert0 : no_pcert = 0
-proofstyles/counterexamples/memory-clearing.pcert0 : acl2x = 0
-proofstyles/counterexamples/memory-clearing.pcert0 : \
-     misc/defpun.pcert0 \
-     proofstyles/counterexamples/memory-clearing.lisp
-proofstyles/counterexamples/memory-clearing.pcert1 : acl2x = 0
-proofstyles/counterexamples/memory-clearing.pcert1 : no_pcert = 0
-proofstyles/counterexamples/memory-clearing.pcert1 : proofstyles/counterexamples/memory-clearing.pcert0
-proofstyles/counterexamples/memory-clearing.cert : | proofstyles/counterexamples/memory-clearing.pcert1
-
-proofstyles/counterexamples/realistic.pcert0 : no_pcert = 0
-proofstyles/counterexamples/realistic.pcert0 : acl2x = 0
-proofstyles/counterexamples/realistic.pcert0 : \
-     misc/records.pcert0 \
-     misc/defpun.pcert0 \
-     proofstyles/counterexamples/realistic.lisp
-proofstyles/counterexamples/realistic.pcert1 : acl2x = 0
-proofstyles/counterexamples/realistic.pcert1 : no_pcert = 0
-proofstyles/counterexamples/realistic.pcert1 : proofstyles/counterexamples/realistic.pcert0
-proofstyles/counterexamples/realistic.cert : | proofstyles/counterexamples/realistic.pcert1
-
-proofstyles/invclock/c2i/c2i-partial.pcert0 : no_pcert = 0
-proofstyles/invclock/c2i/c2i-partial.pcert0 : acl2x = 0
-proofstyles/invclock/c2i/c2i-partial.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     proofstyles/invclock/c2i/c2i-partial.lisp
-proofstyles/invclock/c2i/c2i-partial.pcert1 : acl2x = 0
-proofstyles/invclock/c2i/c2i-partial.pcert1 : no_pcert = 0
-proofstyles/invclock/c2i/c2i-partial.pcert1 : proofstyles/invclock/c2i/c2i-partial.pcert0
-proofstyles/invclock/c2i/c2i-partial.cert : | proofstyles/invclock/c2i/c2i-partial.pcert1
-
-proofstyles/invclock/c2i/c2i-total.pcert0 : no_pcert = 0
-proofstyles/invclock/c2i/c2i-total.pcert0 : acl2x = 0
-proofstyles/invclock/c2i/c2i-total.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     proofstyles/invclock/c2i/c2i-total.lisp
-proofstyles/invclock/c2i/c2i-total.pcert1 : acl2x = 0
-proofstyles/invclock/c2i/c2i-total.pcert1 : no_pcert = 0
-proofstyles/invclock/c2i/c2i-total.pcert1 : proofstyles/invclock/c2i/c2i-total.pcert0
-proofstyles/invclock/c2i/c2i-total.cert : | proofstyles/invclock/c2i/c2i-total.pcert1
-
-proofstyles/invclock/c2i/clock-to-inv.pcert0 : no_pcert = 0
-proofstyles/invclock/c2i/clock-to-inv.pcert0 : acl2x = 0
-proofstyles/invclock/c2i/clock-to-inv.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     proofstyles/invclock/c2i/c2i-total.pcert0 \
-     proofstyles/invclock/c2i/c2i-partial.pcert0 \
-     proofstyles/invclock/c2i/clock-to-inv.lisp
-proofstyles/invclock/c2i/clock-to-inv.pcert1 : acl2x = 0
-proofstyles/invclock/c2i/clock-to-inv.pcert1 : no_pcert = 0
-proofstyles/invclock/c2i/clock-to-inv.pcert1 : proofstyles/invclock/c2i/clock-to-inv.pcert0
-proofstyles/invclock/c2i/clock-to-inv.cert : | proofstyles/invclock/c2i/clock-to-inv.pcert1
-
-proofstyles/invclock/compose/compose-c-c-partial.pcert0 : no_pcert = 0
-proofstyles/invclock/compose/compose-c-c-partial.pcert0 : acl2x = 0
-proofstyles/invclock/compose/compose-c-c-partial.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     proofstyles/invclock/compose/compose-c-c-partial.lisp
-proofstyles/invclock/compose/compose-c-c-partial.pcert1 : acl2x = 0
-proofstyles/invclock/compose/compose-c-c-partial.pcert1 : no_pcert = 0
-proofstyles/invclock/compose/compose-c-c-partial.pcert1 : proofstyles/invclock/compose/compose-c-c-partial.pcert0
-proofstyles/invclock/compose/compose-c-c-partial.cert : | proofstyles/invclock/compose/compose-c-c-partial.pcert1
-
-proofstyles/invclock/compose/compose-c-c-total.pcert0 : no_pcert = 0
-proofstyles/invclock/compose/compose-c-c-total.pcert0 : acl2x = 0
-proofstyles/invclock/compose/compose-c-c-total.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     proofstyles/invclock/compose/compose-c-c-total.lisp
-proofstyles/invclock/compose/compose-c-c-total.pcert1 : acl2x = 0
-proofstyles/invclock/compose/compose-c-c-total.pcert1 : no_pcert = 0
-proofstyles/invclock/compose/compose-c-c-total.pcert1 : proofstyles/invclock/compose/compose-c-c-total.pcert0
-proofstyles/invclock/compose/compose-c-c-total.cert : | proofstyles/invclock/compose/compose-c-c-total.pcert1
-
-proofstyles/invclock/i2c/i2c-partial.pcert0 : no_pcert = 0
-proofstyles/invclock/i2c/i2c-partial.pcert0 : acl2x = 0
-proofstyles/invclock/i2c/i2c-partial.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     proofstyles/invclock/i2c/i2c-partial.lisp
-proofstyles/invclock/i2c/i2c-partial.pcert1 : acl2x = 0
-proofstyles/invclock/i2c/i2c-partial.pcert1 : no_pcert = 0
-proofstyles/invclock/i2c/i2c-partial.pcert1 : proofstyles/invclock/i2c/i2c-partial.pcert0
-proofstyles/invclock/i2c/i2c-partial.cert : | proofstyles/invclock/i2c/i2c-partial.pcert1
-
-proofstyles/invclock/i2c/i2c-total.pcert0 : no_pcert = 0
-proofstyles/invclock/i2c/i2c-total.pcert0 : acl2x = 0
-proofstyles/invclock/i2c/i2c-total.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     proofstyles/invclock/i2c/i2c-total.lisp
-proofstyles/invclock/i2c/i2c-total.pcert1 : acl2x = 0
-proofstyles/invclock/i2c/i2c-total.pcert1 : no_pcert = 0
-proofstyles/invclock/i2c/i2c-total.pcert1 : proofstyles/invclock/i2c/i2c-total.pcert0
-proofstyles/invclock/i2c/i2c-total.cert : | proofstyles/invclock/i2c/i2c-total.pcert1
-
-proofstyles/invclock/i2c/inv-to-clock.pcert0 : no_pcert = 0
-proofstyles/invclock/i2c/inv-to-clock.pcert0 : acl2x = 0
-proofstyles/invclock/i2c/inv-to-clock.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     proofstyles/invclock/i2c/i2c-total.pcert0 \
-     proofstyles/invclock/i2c/i2c-partial.pcert0 \
-     proofstyles/invclock/i2c/inv-to-clock.lisp
-proofstyles/invclock/i2c/inv-to-clock.pcert1 : acl2x = 0
-proofstyles/invclock/i2c/inv-to-clock.pcert1 : no_pcert = 0
-proofstyles/invclock/i2c/inv-to-clock.pcert1 : proofstyles/invclock/i2c/inv-to-clock.pcert0
-proofstyles/invclock/i2c/inv-to-clock.cert : | proofstyles/invclock/i2c/inv-to-clock.pcert1
-
-proofstyles/soundness/assertions-partial.pcert0 : no_pcert = 0
-proofstyles/soundness/assertions-partial.pcert0 : acl2x = 0
-proofstyles/soundness/assertions-partial.pcert0 : \
-     misc/defpun.pcert0 \
-     ordinals/ordinals.pcert0 \
-     proofstyles/soundness/assertions-partial.lisp
-proofstyles/soundness/assertions-partial.pcert1 : acl2x = 0
-proofstyles/soundness/assertions-partial.pcert1 : no_pcert = 0
-proofstyles/soundness/assertions-partial.pcert1 : proofstyles/soundness/assertions-partial.pcert0
-proofstyles/soundness/assertions-partial.cert : | proofstyles/soundness/assertions-partial.pcert1
-
-proofstyles/soundness/assertions-total.pcert0 : no_pcert = 0
-proofstyles/soundness/assertions-total.pcert0 : acl2x = 0
-proofstyles/soundness/assertions-total.pcert0 : \
-     misc/defpun.pcert0 \
-     ordinals/ordinals.pcert0 \
-     proofstyles/soundness/assertions-total.lisp
-proofstyles/soundness/assertions-total.pcert1 : acl2x = 0
-proofstyles/soundness/assertions-total.pcert1 : no_pcert = 0
-proofstyles/soundness/assertions-total.pcert1 : proofstyles/soundness/assertions-total.pcert0
-proofstyles/soundness/assertions-total.cert : | proofstyles/soundness/assertions-total.pcert1
-
-proofstyles/soundness/clock-partial.pcert0 : no_pcert = 0
-proofstyles/soundness/clock-partial.pcert0 : acl2x = 0
-proofstyles/soundness/clock-partial.pcert0 : \
-     proofstyles/soundness/clock-partial.lisp
-proofstyles/soundness/clock-partial.pcert1 : acl2x = 0
-proofstyles/soundness/clock-partial.pcert1 : no_pcert = 0
-proofstyles/soundness/clock-partial.pcert1 : proofstyles/soundness/clock-partial.pcert0
-proofstyles/soundness/clock-partial.cert : | proofstyles/soundness/clock-partial.pcert1
-
-proofstyles/soundness/clock-total.pcert0 : no_pcert = 0
-proofstyles/soundness/clock-total.pcert0 : acl2x = 0
-proofstyles/soundness/clock-total.pcert0 : \
-     proofstyles/soundness/clock-total.lisp
-proofstyles/soundness/clock-total.pcert1 : acl2x = 0
-proofstyles/soundness/clock-total.pcert1 : no_pcert = 0
-proofstyles/soundness/clock-total.pcert1 : proofstyles/soundness/clock-total.pcert0
-proofstyles/soundness/clock-total.cert : | proofstyles/soundness/clock-total.pcert1
-
-proofstyles/soundness/stepwise-invariants-partial.pcert0 : no_pcert = 0
-proofstyles/soundness/stepwise-invariants-partial.pcert0 : acl2x = 0
-proofstyles/soundness/stepwise-invariants-partial.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     proofstyles/soundness/stepwise-invariants-partial.lisp
-proofstyles/soundness/stepwise-invariants-partial.pcert1 : acl2x = 0
-proofstyles/soundness/stepwise-invariants-partial.pcert1 : no_pcert = 0
-proofstyles/soundness/stepwise-invariants-partial.pcert1 : proofstyles/soundness/stepwise-invariants-partial.pcert0
-proofstyles/soundness/stepwise-invariants-partial.cert : | proofstyles/soundness/stepwise-invariants-partial.pcert1
-
-proofstyles/soundness/stepwise-invariants-total.pcert0 : no_pcert = 0
-proofstyles/soundness/stepwise-invariants-total.pcert0 : acl2x = 0
-proofstyles/soundness/stepwise-invariants-total.pcert0 : \
-     ordinals/ordinals.pcert0 \
-     proofstyles/soundness/stepwise-invariants-total.lisp
-proofstyles/soundness/stepwise-invariants-total.pcert1 : acl2x = 0
-proofstyles/soundness/stepwise-invariants-total.pcert1 : no_pcert = 0
-proofstyles/soundness/stepwise-invariants-total.pcert1 : proofstyles/soundness/stepwise-invariants-total.pcert0
-proofstyles/soundness/stepwise-invariants-total.cert : | proofstyles/soundness/stepwise-invariants-total.pcert1
-
-quadratic-reciprocity/eisenstein.pcert0 : no_pcert = 0
-quadratic-reciprocity/eisenstein.pcert0 : acl2x = 0
-quadratic-reciprocity/eisenstein.pcert0 : \
-     quadratic-reciprocity/gauss.pcert0 \
-     quadratic-reciprocity/eisenstein.lisp
-quadratic-reciprocity/eisenstein.pcert1 : acl2x = 0
-quadratic-reciprocity/eisenstein.pcert1 : no_pcert = 0
-quadratic-reciprocity/eisenstein.pcert1 : quadratic-reciprocity/eisenstein.pcert0
-quadratic-reciprocity/eisenstein.cert : | quadratic-reciprocity/eisenstein.pcert1
-
-quadratic-reciprocity/euclid.pcert0 : no_pcert = 0
-quadratic-reciprocity/euclid.pcert0 : acl2x = 0
-quadratic-reciprocity/euclid.pcert0 : \
-     rtl/rel8/lib/arith.pcert0 \
-     rtl/rel8/lib/basic.pcert0 \
-     quadratic-reciprocity/euclid.lisp
-quadratic-reciprocity/euclid.pcert1 : acl2x = 0
-quadratic-reciprocity/euclid.pcert1 : no_pcert = 0
-quadratic-reciprocity/euclid.pcert1 : quadratic-reciprocity/euclid.pcert0
-quadratic-reciprocity/euclid.cert : | quadratic-reciprocity/euclid.pcert1
-
-quadratic-reciprocity/euler.pcert0 : no_pcert = 0
-quadratic-reciprocity/euler.pcert0 : acl2x = 0
-quadratic-reciprocity/euler.pcert0 : \
-     quadratic-reciprocity/fermat.pcert0 \
-     quadratic-reciprocity/euler.lisp
-quadratic-reciprocity/euler.pcert1 : acl2x = 0
-quadratic-reciprocity/euler.pcert1 : no_pcert = 0
-quadratic-reciprocity/euler.pcert1 : quadratic-reciprocity/euler.pcert0
-quadratic-reciprocity/euler.cert : | quadratic-reciprocity/euler.pcert1
-
-quadratic-reciprocity/fermat.pcert0 : no_pcert = 0
-quadratic-reciprocity/fermat.pcert0 : acl2x = 0
-quadratic-reciprocity/fermat.pcert0 : \
-     quadratic-reciprocity/euclid.pcert0 \
-     quadratic-reciprocity/fermat.lisp
-quadratic-reciprocity/fermat.pcert1 : acl2x = 0
-quadratic-reciprocity/fermat.pcert1 : no_pcert = 0
-quadratic-reciprocity/fermat.pcert1 : quadratic-reciprocity/fermat.pcert0
-quadratic-reciprocity/fermat.cert : | quadratic-reciprocity/fermat.pcert1
-
-quadratic-reciprocity/gauss.pcert0 : no_pcert = 0
-quadratic-reciprocity/gauss.pcert0 : acl2x = 0
-quadratic-reciprocity/gauss.pcert0 : \
-     quadratic-reciprocity/euler.pcert0 \
-     quadratic-reciprocity/gauss.lisp
-quadratic-reciprocity/gauss.pcert1 : acl2x = 0
-quadratic-reciprocity/gauss.pcert1 : no_pcert = 0
-quadratic-reciprocity/gauss.pcert1 : quadratic-reciprocity/gauss.pcert0
-quadratic-reciprocity/gauss.cert : | quadratic-reciprocity/gauss.pcert1
-
-quadratic-reciprocity/mersenne.pcert0 : no_pcert = 0
-quadratic-reciprocity/mersenne.pcert0 : acl2x = 0
-quadratic-reciprocity/mersenne.pcert0 : \
-     quadratic-reciprocity/gauss.pcert0 \
-     quadratic-reciprocity/mersenne.lisp
-quadratic-reciprocity/mersenne.pcert1 : acl2x = 0
-quadratic-reciprocity/mersenne.pcert1 : no_pcert = 0
-quadratic-reciprocity/mersenne.pcert1 : quadratic-reciprocity/mersenne.pcert0
-quadratic-reciprocity/mersenne.cert : | quadratic-reciprocity/mersenne.pcert1
-
-regex/defset-encapsulates.pcert0 : no_pcert = 0
-regex/defset-encapsulates.pcert0 : acl2x = 0
-regex/defset-encapsulates.pcert0 : \
-     regex/defset-macros.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/defset-encapsulates.lisp \
-     regex/cert.acl2
-regex/defset-encapsulates.pcert1 : acl2x = 0
-regex/defset-encapsulates.pcert1 : no_pcert = 0
-regex/defset-encapsulates.pcert1 : regex/defset-encapsulates.pcert0
-regex/defset-encapsulates.cert : | regex/defset-encapsulates.pcert1
-
-regex/defset-macros.pcert0 : no_pcert = 0
-regex/defset-macros.pcert0 : acl2x = 0
-regex/defset-macros.pcert0 : \
-     regex/portcullis.pcert0 \
-     regex/defset-macros.lisp \
-     regex/cert.acl2
-regex/defset-macros.pcert1 : acl2x = 0
-regex/defset-macros.pcert1 : no_pcert = 0
-regex/defset-macros.pcert1 : regex/defset-macros.pcert0
-regex/defset-macros.cert : | regex/defset-macros.pcert1
-
-regex/equal-based-set.pcert0 : no_pcert = 0
-regex/equal-based-set.pcert0 : acl2x = 0
-regex/equal-based-set.pcert0 : \
-     regex/defset-macros.pcert0 \
-     regex/defset-encapsulates.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/equal-based-set.lisp \
-     regex/cert.acl2
-regex/equal-based-set.pcert1 : acl2x = 0
-regex/equal-based-set.pcert1 : no_pcert = 0
-regex/equal-based-set.pcert1 : regex/equal-based-set.pcert0
-regex/equal-based-set.cert : | regex/equal-based-set.pcert1
-
-regex/grep-command-line.pcert0 : no_pcert = 0
-regex/grep-command-line.pcert0 : acl2x = 0
-regex/grep-command-line.pcert0 : \
-     tools/defsum.pcert0 \
-     regex/regex-fileio.pcert0 \
-     regex/regex-chartrans.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/grep-command-line.lisp \
-     regex/cert.acl2
-regex/grep-command-line.pcert1 : acl2x = 0
-regex/grep-command-line.pcert1 : no_pcert = 0
-regex/grep-command-line.pcert1 : regex/grep-command-line.pcert0
-regex/grep-command-line.cert : | regex/grep-command-line.pcert1
-
-regex/input-list.pcert0 : no_pcert = 0
-regex/input-list.pcert0 : acl2x = 0
-regex/input-list.pcert0 : \
-     cutil/deflist.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/input-list.lisp \
-     regex/cert.acl2
-regex/input-list.pcert1 : acl2x = 0
-regex/input-list.pcert1 : no_pcert = 0
-regex/input-list.pcert1 : regex/input-list.pcert0
-regex/input-list.cert : | regex/input-list.pcert1
-
-regex/portcullis.pcert0 : no_pcert = 0
-regex/portcullis.pcert0 : acl2x = 0
-regex/portcullis.pcert0 : \
-     xdoc/top.pcert0 \
-     regex/portcullis.lisp \
-     regex/portcullis.acl2 \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     tools/flag-package.lsp
-regex/portcullis.pcert1 : acl2x = 0
-regex/portcullis.pcert1 : no_pcert = 0
-regex/portcullis.pcert1 : regex/portcullis.pcert0
-regex/portcullis.cert : | regex/portcullis.pcert1
-
-regex/regex-chartrans.pcert0 : no_pcert = 0
-regex/regex-chartrans.pcert0 : acl2x = 0
-regex/regex-chartrans.pcert0 : \
-     regex/portcullis.pcert0 \
-     regex/regex-chartrans.lisp \
-     regex/cert.acl2
-regex/regex-chartrans.pcert1 : acl2x = 0
-regex/regex-chartrans.pcert1 : no_pcert = 0
-regex/regex-chartrans.pcert1 : regex/regex-chartrans.pcert0
-regex/regex-chartrans.cert : | regex/regex-chartrans.pcert1
-
-regex/regex-defs.pcert0 : no_pcert = 0
-regex/regex-defs.pcert0 : acl2x = 0
-regex/regex-defs.pcert0 : \
-     tools/defsum.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/regex-defs.lisp \
-     regex/cert.acl2
-regex/regex-defs.pcert1 : acl2x = 0
-regex/regex-defs.pcert1 : no_pcert = 0
-regex/regex-defs.pcert1 : regex/regex-defs.pcert0
-regex/regex-defs.cert : | regex/regex-defs.pcert1
-
-regex/regex-exec.pcert0 : no_pcert = 0
-regex/regex-exec.pcert0 : acl2x = 0
-regex/regex-exec.pcert0 : \
-     regex/regex-defs.pcert0 \
-     regex/input-list.pcert0 \
-     tools/flag.pcert0 \
-     clause-processors/find-subterms.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/regex-exec.lisp \
-     regex/cert.acl2
-regex/regex-exec.pcert1 : acl2x = 0
-regex/regex-exec.pcert1 : no_pcert = 0
-regex/regex-exec.pcert1 : regex/regex-exec.pcert0
-regex/regex-exec.cert : | regex/regex-exec.pcert1
-
-regex/regex-fileio.pcert0 : no_pcert = 0
-regex/regex-fileio.pcert0 : acl2x = 0
-regex/regex-fileio.pcert0 : \
-     regex/regex-exec.pcert0 \
-     regex/regex-parse.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/regex-fileio.lisp \
-     regex/cert.acl2
-regex/regex-fileio.pcert1 : acl2x = 0
-regex/regex-fileio.pcert1 : no_pcert = 0
-regex/regex-fileio.pcert1 : regex/regex-fileio.pcert0
-regex/regex-fileio.cert : | regex/regex-fileio.pcert1
-
-regex/regex-parse-brace.pcert0 : no_pcert = 0
-regex/regex-parse-brace.pcert0 : acl2x = 0
-regex/regex-parse-brace.pcert0 : \
-     regex/regex-defs.pcert0 \
-     regex/input-list.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/regex-parse-brace.lisp \
-     regex/cert.acl2
-regex/regex-parse-brace.pcert1 : acl2x = 0
-regex/regex-parse-brace.pcert1 : no_pcert = 0
-regex/regex-parse-brace.pcert1 : regex/regex-parse-brace.pcert0
-regex/regex-parse-brace.cert : | regex/regex-parse-brace.pcert1
-
-regex/regex-parse-bracket.pcert0 : no_pcert = 0
-regex/regex-parse-bracket.pcert0 : acl2x = 0
-regex/regex-parse-bracket.pcert0 : \
-     regex/regex-defs.pcert0 \
-     regex/input-list.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/regex-parse-bracket.lisp \
-     regex/cert.acl2
-regex/regex-parse-bracket.pcert1 : acl2x = 0
-regex/regex-parse-bracket.pcert1 : no_pcert = 0
-regex/regex-parse-bracket.pcert1 : regex/regex-parse-bracket.pcert0
-regex/regex-parse-bracket.cert : | regex/regex-parse-bracket.pcert1
-
-regex/regex-parse.pcert0 : no_pcert = 0
-regex/regex-parse.pcert0 : acl2x = 0
-regex/regex-parse.pcert0 : \
-     regex/regex-parse-bracket.pcert0 \
-     regex/regex-parse-brace.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/regex-parse.lisp \
-     regex/cert.acl2
-regex/regex-parse.pcert1 : acl2x = 0
-regex/regex-parse.pcert1 : no_pcert = 0
-regex/regex-parse.pcert1 : regex/regex-parse.pcert0
-regex/regex-parse.cert : | regex/regex-parse.pcert1
-
-regex/regex-tests.pcert0 : no_pcert = 0
-regex/regex-tests.pcert0 : acl2x = 0
-regex/regex-tests.pcert0 : \
-     regex/regex-parse.pcert0 \
-     regex/regex-exec.pcert0 \
-     regex/regex-chartrans.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/regex-tests.lisp \
-     regex/cert.acl2
-regex/regex-tests.pcert1 : acl2x = 0
-regex/regex-tests.pcert1 : no_pcert = 0
-regex/regex-tests.pcert1 : regex/regex-tests.pcert0
-regex/regex-tests.cert : | regex/regex-tests.pcert1
-
-regex/regex-ui.pcert0 : no_pcert = 0
-regex/regex-ui.pcert0 : acl2x = 0
-regex/regex-ui.pcert0 : \
-     regex/regex-parse.pcert0 \
-     regex/regex-exec.pcert0 \
-     str/case-conversion.pcert0 \
-     tools/mv-nth.pcert0 \
-     misc/assert.pcert0 \
-     regex/portcullis.pcert0 \
-     regex/regex-ui.lisp \
-     regex/cert.acl2
-regex/regex-ui.pcert1 : acl2x = 0
-regex/regex-ui.pcert1 : no_pcert = 0
-regex/regex-ui.pcert1 : regex/regex-ui.pcert0
-regex/regex-ui.cert : | regex/regex-ui.pcert1
-
-rtl/rel1/lib1/basic.pcert0 : no_pcert = 0
-rtl/rel1/lib1/basic.pcert0 : acl2x = 0
-rtl/rel1/lib1/basic.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/lib1/basic.lisp
-rtl/rel1/lib1/basic.pcert1 : acl2x = 0
-rtl/rel1/lib1/basic.pcert1 : no_pcert = 0
-rtl/rel1/lib1/basic.pcert1 : rtl/rel1/lib1/basic.pcert0
-rtl/rel1/lib1/basic.cert : | rtl/rel1/lib1/basic.pcert1
-
-rtl/rel1/lib1/bits.pcert0 : no_pcert = 0
-rtl/rel1/lib1/bits.pcert0 : acl2x = 0
-rtl/rel1/lib1/bits.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/lib1/bits.lisp
-rtl/rel1/lib1/bits.pcert1 : acl2x = 0
-rtl/rel1/lib1/bits.pcert1 : no_pcert = 0
-rtl/rel1/lib1/bits.pcert1 : rtl/rel1/lib1/bits.pcert0
-rtl/rel1/lib1/bits.cert : | rtl/rel1/lib1/bits.pcert1
-
-rtl/rel1/lib1/brat.pcert0 : no_pcert = 0
-rtl/rel1/lib1/brat.pcert0 : acl2x = 0
-rtl/rel1/lib1/brat.pcert0 : \
-     rtl/rel1/support/fp.pcert0 \
-     rtl/rel1/lib1/brat.lisp
-rtl/rel1/lib1/brat.pcert1 : acl2x = 0
-rtl/rel1/lib1/brat.pcert1 : no_pcert = 0
-rtl/rel1/lib1/brat.pcert1 : rtl/rel1/lib1/brat.pcert0
-rtl/rel1/lib1/brat.cert : | rtl/rel1/lib1/brat.pcert1
-
-rtl/rel1/lib1/float.pcert0 : no_pcert = 0
-rtl/rel1/lib1/float.pcert0 : acl2x = 0
-rtl/rel1/lib1/float.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/lib1/float.lisp
-rtl/rel1/lib1/float.pcert1 : acl2x = 0
-rtl/rel1/lib1/float.pcert1 : no_pcert = 0
-rtl/rel1/lib1/float.pcert1 : rtl/rel1/lib1/float.pcert0
-rtl/rel1/lib1/float.cert : | rtl/rel1/lib1/float.pcert1
-
-rtl/rel1/lib1/reps.pcert0 : no_pcert = 0
-rtl/rel1/lib1/reps.pcert0 : acl2x = 0
-rtl/rel1/lib1/reps.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/lib1/float.pcert0 \
-     rtl/rel1/lib1/reps.lisp
-rtl/rel1/lib1/reps.pcert1 : acl2x = 0
-rtl/rel1/lib1/reps.pcert1 : no_pcert = 0
-rtl/rel1/lib1/reps.pcert1 : rtl/rel1/lib1/reps.pcert0
-rtl/rel1/lib1/reps.cert : | rtl/rel1/lib1/reps.pcert1
-
-rtl/rel1/lib1/round.pcert0 : no_pcert = 0
-rtl/rel1/lib1/round.pcert0 : acl2x = 0
-rtl/rel1/lib1/round.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/lib1/float.pcert0 \
-     rtl/rel1/lib1/round.lisp
-rtl/rel1/lib1/round.pcert1 : acl2x = 0
-rtl/rel1/lib1/round.pcert1 : no_pcert = 0
-rtl/rel1/lib1/round.pcert1 : rtl/rel1/lib1/round.pcert0
-rtl/rel1/lib1/round.cert : | rtl/rel1/lib1/round.pcert1
-
-rtl/rel1/lib1/top.pcert0 : no_pcert = 0
-rtl/rel1/lib1/top.pcert0 : acl2x = 0
-rtl/rel1/lib1/top.pcert0 : \
-     rtl/rel1/lib1/basic.pcert0 \
-     rtl/rel1/lib1/bits.pcert0 \
-     rtl/rel1/lib1/float.pcert0 \
-     rtl/rel1/lib1/round.pcert0 \
-     rtl/rel1/lib1/reps.pcert0 \
-     rtl/rel1/lib1/brat.pcert0 \
-     rtl/rel1/lib1/top.lisp
-rtl/rel1/lib1/top.pcert1 : acl2x = 0
-rtl/rel1/lib1/top.pcert1 : no_pcert = 0
-rtl/rel1/lib1/top.pcert1 : rtl/rel1/lib1/top.pcert0
-rtl/rel1/lib1/top.cert : | rtl/rel1/lib1/top.pcert1
-
-rtl/rel1/lib3/basic.pcert0 : no_pcert = 0
-rtl/rel1/lib3/basic.pcert0 : acl2x = 0
-rtl/rel1/lib3/basic.pcert0 : \
-     rtl/rel1/support/merge.pcert0 \
-     rtl/rel1/support/rewrite-theory.pcert0 \
-     rtl/rel1/lib3/basic.lisp
-rtl/rel1/lib3/basic.pcert1 : acl2x = 0
-rtl/rel1/lib3/basic.pcert1 : no_pcert = 0
-rtl/rel1/lib3/basic.pcert1 : rtl/rel1/lib3/basic.pcert0
-rtl/rel1/lib3/basic.cert : | rtl/rel1/lib3/basic.pcert1
-
-rtl/rel1/lib3/bits.pcert0 : no_pcert = 0
-rtl/rel1/lib3/bits.pcert0 : acl2x = 0
-rtl/rel1/lib3/bits.pcert0 : \
-     rtl/rel1/support/merge.pcert0 \
-     rtl/rel1/support/rewrite-theory.pcert0 \
-     rtl/rel1/lib3/bits.lisp
-rtl/rel1/lib3/bits.pcert1 : acl2x = 0
-rtl/rel1/lib3/bits.pcert1 : no_pcert = 0
-rtl/rel1/lib3/bits.pcert1 : rtl/rel1/lib3/bits.pcert0
-rtl/rel1/lib3/bits.cert : | rtl/rel1/lib3/bits.pcert1
-
-rtl/rel1/lib3/brat.pcert0 : no_pcert = 0
-rtl/rel1/lib3/brat.pcert0 : acl2x = 0
-rtl/rel1/lib3/brat.pcert0 : \
-     rtl/rel1/support/fp.pcert0 \
-     rtl/rel1/lib3/brat.lisp
-rtl/rel1/lib3/brat.pcert1 : acl2x = 0
-rtl/rel1/lib3/brat.pcert1 : no_pcert = 0
-rtl/rel1/lib3/brat.pcert1 : rtl/rel1/lib3/brat.pcert0
-rtl/rel1/lib3/brat.cert : | rtl/rel1/lib3/brat.pcert1
-
-rtl/rel1/lib3/fadd.pcert0 : no_pcert = 0
-rtl/rel1/lib3/fadd.pcert0 : acl2x = 0
-rtl/rel1/lib3/fadd.pcert0 : \
-     rtl/rel1/support/fadd/add3.pcert0 \
-     rtl/rel1/lib3/float.pcert0 \
-     rtl/rel1/lib3/bits.pcert0 \
-     rtl/rel1/lib3/fadd.lisp
-rtl/rel1/lib3/fadd.pcert1 : acl2x = 0
-rtl/rel1/lib3/fadd.pcert1 : no_pcert = 0
-rtl/rel1/lib3/fadd.pcert1 : rtl/rel1/lib3/fadd.pcert0
-rtl/rel1/lib3/fadd.cert : | rtl/rel1/lib3/fadd.pcert1
-
-rtl/rel1/lib3/float.pcert0 : no_pcert = 0
-rtl/rel1/lib3/float.pcert0 : acl2x = 0
-rtl/rel1/lib3/float.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/lib3/float.lisp
-rtl/rel1/lib3/float.pcert1 : acl2x = 0
-rtl/rel1/lib3/float.pcert1 : no_pcert = 0
-rtl/rel1/lib3/float.pcert1 : rtl/rel1/lib3/float.pcert0
-rtl/rel1/lib3/float.cert : | rtl/rel1/lib3/float.pcert1
-
-rtl/rel1/lib3/reps.pcert0 : no_pcert = 0
-rtl/rel1/lib3/reps.pcert0 : acl2x = 0
-rtl/rel1/lib3/reps.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/lib3/float.pcert0 \
-     rtl/rel1/lib3/reps.lisp
-rtl/rel1/lib3/reps.pcert1 : acl2x = 0
-rtl/rel1/lib3/reps.pcert1 : no_pcert = 0
-rtl/rel1/lib3/reps.pcert1 : rtl/rel1/lib3/reps.pcert0
-rtl/rel1/lib3/reps.cert : | rtl/rel1/lib3/reps.pcert1
-
-rtl/rel1/lib3/round.pcert0 : no_pcert = 0
-rtl/rel1/lib3/round.pcert0 : acl2x = 0
-rtl/rel1/lib3/round.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/lib3/float.pcert0 \
-     rtl/rel1/lib3/round.lisp
-rtl/rel1/lib3/round.pcert1 : acl2x = 0
-rtl/rel1/lib3/round.pcert1 : no_pcert = 0
-rtl/rel1/lib3/round.pcert1 : rtl/rel1/lib3/round.pcert0
-rtl/rel1/lib3/round.cert : | rtl/rel1/lib3/round.pcert1
-
-rtl/rel1/lib3/top.pcert0 : no_pcert = 0
-rtl/rel1/lib3/top.pcert0 : acl2x = 0
-rtl/rel1/lib3/top.pcert0 : \
-     rtl/rel1/lib3/basic.pcert0 \
-     rtl/rel1/lib3/bits.pcert0 \
-     rtl/rel1/lib3/float.pcert0 \
-     rtl/rel1/lib3/round.pcert0 \
-     rtl/rel1/lib3/reps.pcert0 \
-     rtl/rel1/lib3/fadd.pcert0 \
-     rtl/rel1/support/fp.pcert0 \
-     rtl/rel1/lib3/brat.pcert0 \
-     rtl/rel1/lib3/top.lisp
-rtl/rel1/lib3/top.pcert1 : acl2x = 0
-rtl/rel1/lib3/top.pcert1 : no_pcert = 0
-rtl/rel1/lib3/top.pcert1 : rtl/rel1/lib3/top.pcert0
-rtl/rel1/lib3/top.cert : | rtl/rel1/lib3/top.pcert1
-
-rtl/rel1/support/add.pcert0 : no_pcert = 0
-rtl/rel1/support/add.pcert0 : acl2x = 0
-rtl/rel1/support/add.pcert0 : \
-     rtl/rel1/support/divsqrt.pcert0 \
-     rtl/rel1/support/logxor-lemmas.pcert0 \
-     rtl/rel1/support/rnd.pcert0 \
-     rtl/rel1/support/add.lisp
-rtl/rel1/support/add.pcert1 : acl2x = 0
-rtl/rel1/support/add.pcert1 : no_pcert = 0
-rtl/rel1/support/add.pcert1 : rtl/rel1/support/add.pcert0
-rtl/rel1/support/add.cert : | rtl/rel1/support/add.pcert1
-
-rtl/rel1/support/away.pcert0 : no_pcert = 0
-rtl/rel1/support/away.pcert0 : acl2x = 0
-rtl/rel1/support/away.pcert0 : \
-     rtl/rel1/support/trunc.pcert0 \
-     rtl/rel1/support/away.lisp
-rtl/rel1/support/away.pcert1 : acl2x = 0
-rtl/rel1/support/away.pcert1 : no_pcert = 0
-rtl/rel1/support/away.pcert1 : rtl/rel1/support/away.pcert0
-rtl/rel1/support/away.cert : | rtl/rel1/support/away.pcert1
-
-rtl/rel1/support/basic.pcert0 : no_pcert = 0
-rtl/rel1/support/basic.pcert0 : acl2x = 0
-rtl/rel1/support/basic.pcert0 : \
-     rtl/rel1/support/fp.pcert0 \
-     rtl/rel1/support/basic.lisp
-rtl/rel1/support/basic.pcert1 : acl2x = 0
-rtl/rel1/support/basic.pcert1 : no_pcert = 0
-rtl/rel1/support/basic.pcert1 : rtl/rel1/support/basic.pcert0
-rtl/rel1/support/basic.cert : | rtl/rel1/support/basic.pcert1
-
-rtl/rel1/support/divsqrt.pcert0 : no_pcert = 0
-rtl/rel1/support/divsqrt.pcert0 : acl2x = 0
-rtl/rel1/support/divsqrt.pcert0 : \
-     rtl/rel1/support/odd.pcert0 \
-     rtl/rel1/support/loglemmas.pcert0 \
-     rtl/rel1/support/divsqrt.lisp
-rtl/rel1/support/divsqrt.pcert1 : acl2x = 0
-rtl/rel1/support/divsqrt.pcert1 : no_pcert = 0
-rtl/rel1/support/divsqrt.pcert1 : rtl/rel1/support/divsqrt.pcert0
-rtl/rel1/support/divsqrt.cert : | rtl/rel1/support/divsqrt.pcert1
-
-rtl/rel1/support/fadd/add3.pcert0 : no_pcert = 0
-rtl/rel1/support/fadd/add3.pcert0 : acl2x = 0
-rtl/rel1/support/fadd/add3.pcert0 : \
-     rtl/rel1/support/fadd/stick.pcert0 \
-     rtl/rel1/support/fadd/add3.lisp
-rtl/rel1/support/fadd/add3.pcert1 : acl2x = 0
-rtl/rel1/support/fadd/add3.pcert1 : no_pcert = 0
-rtl/rel1/support/fadd/add3.pcert1 : rtl/rel1/support/fadd/add3.pcert0
-rtl/rel1/support/fadd/add3.cert : | rtl/rel1/support/fadd/add3.pcert1
-
-rtl/rel1/support/fadd/lop1.pcert0 : no_pcert = 0
-rtl/rel1/support/fadd/lop1.pcert0 : acl2x = 0
-rtl/rel1/support/fadd/lop1.pcert0 : \
-     rtl/rel1/lib1/top.pcert0 \
-     rtl/rel1/support/fp.pcert0 \
-     rtl/rel1/support/fadd/lop1.lisp
-rtl/rel1/support/fadd/lop1.pcert1 : acl2x = 0
-rtl/rel1/support/fadd/lop1.pcert1 : no_pcert = 0
-rtl/rel1/support/fadd/lop1.pcert1 : rtl/rel1/support/fadd/lop1.pcert0
-rtl/rel1/support/fadd/lop1.cert : | rtl/rel1/support/fadd/lop1.pcert1
-
-rtl/rel1/support/fadd/lop2.pcert0 : no_pcert = 0
-rtl/rel1/support/fadd/lop2.pcert0 : acl2x = 0
-rtl/rel1/support/fadd/lop2.pcert0 : \
-     rtl/rel1/support/fadd/lop1.pcert0 \
-     rtl/rel1/support/fadd/lop2.lisp
-rtl/rel1/support/fadd/lop2.pcert1 : acl2x = 0
-rtl/rel1/support/fadd/lop2.pcert1 : no_pcert = 0
-rtl/rel1/support/fadd/lop2.pcert1 : rtl/rel1/support/fadd/lop2.pcert0
-rtl/rel1/support/fadd/lop2.cert : | rtl/rel1/support/fadd/lop2.pcert1
-
-rtl/rel1/support/fadd/lop3.pcert0 : no_pcert = 0
-rtl/rel1/support/fadd/lop3.pcert0 : acl2x = 0
-rtl/rel1/support/fadd/lop3.pcert0 : \
-     rtl/rel1/support/fadd/lop2.pcert0 \
-     rtl/rel1/support/fadd/lop3.lisp
-rtl/rel1/support/fadd/lop3.pcert1 : acl2x = 0
-rtl/rel1/support/fadd/lop3.pcert1 : no_pcert = 0
-rtl/rel1/support/fadd/lop3.pcert1 : rtl/rel1/support/fadd/lop3.pcert0
-rtl/rel1/support/fadd/lop3.cert : | rtl/rel1/support/fadd/lop3.pcert1
-
-rtl/rel1/support/fadd/stick.pcert0 : no_pcert = 0
-rtl/rel1/support/fadd/stick.pcert0 : acl2x = 0
-rtl/rel1/support/fadd/stick.pcert0 : \
-     rtl/rel1/support/fadd/lop3.pcert0 \
-     rtl/rel1/support/fadd/stick.lisp
-rtl/rel1/support/fadd/stick.pcert1 : acl2x = 0
-rtl/rel1/support/fadd/stick.pcert1 : no_pcert = 0
-rtl/rel1/support/fadd/stick.pcert1 : rtl/rel1/support/fadd/stick.pcert0
-rtl/rel1/support/fadd/stick.cert : | rtl/rel1/support/fadd/stick.pcert1
-
-rtl/rel1/support/fadd/top.pcert0 : no_pcert = 0
-rtl/rel1/support/fadd/top.pcert0 : acl2x = 0
-rtl/rel1/support/fadd/top.pcert0 : \
-     rtl/rel1/support/fadd/lop3.pcert0 \
-     rtl/rel1/support/fadd/top.lisp
-rtl/rel1/support/fadd/top.pcert1 : acl2x = 0
-rtl/rel1/support/fadd/top.pcert1 : no_pcert = 0
-rtl/rel1/support/fadd/top.pcert1 : rtl/rel1/support/fadd/top.pcert0
-rtl/rel1/support/fadd/top.cert : | rtl/rel1/support/fadd/top.pcert1
-
-rtl/rel1/support/float.pcert0 : no_pcert = 0
-rtl/rel1/support/float.pcert0 : acl2x = 0
-rtl/rel1/support/float.pcert0 : \
-     rtl/rel1/support/basic.pcert0 \
-     rtl/rel1/support/x-2xx.pcert0 \
-     rtl/rel1/support/float.lisp
-rtl/rel1/support/float.pcert1 : acl2x = 0
-rtl/rel1/support/float.pcert1 : no_pcert = 0
-rtl/rel1/support/float.pcert1 : rtl/rel1/support/float.pcert0
-rtl/rel1/support/float.cert : | rtl/rel1/support/float.pcert1
-
-rtl/rel1/support/floor.pcert0 : no_pcert = 0
-rtl/rel1/support/floor.pcert0 : acl2x = 0
-rtl/rel1/support/floor.pcert0 : \
-     rtl/rel1/support/basic.pcert0 \
-     rtl/rel1/support/floor.lisp
-rtl/rel1/support/floor.pcert1 : acl2x = 0
-rtl/rel1/support/floor.pcert1 : no_pcert = 0
-rtl/rel1/support/floor.pcert1 : rtl/rel1/support/floor.pcert0
-rtl/rel1/support/floor.cert : | rtl/rel1/support/floor.pcert1
-
-rtl/rel1/support/fp.pcert0 : no_pcert = 0
-rtl/rel1/support/fp.pcert0 : acl2x = 0
-rtl/rel1/support/fp.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     rtl/rel1/support/fp.lisp
-rtl/rel1/support/fp.pcert1 : acl2x = 0
-rtl/rel1/support/fp.pcert1 : no_pcert = 0
-rtl/rel1/support/fp.pcert1 : rtl/rel1/support/fp.pcert0
-rtl/rel1/support/fp.cert : | rtl/rel1/support/fp.pcert1
-
-rtl/rel1/support/logdefs.pcert0 : no_pcert = 0
-rtl/rel1/support/logdefs.pcert0 : acl2x = 0
-rtl/rel1/support/logdefs.pcert0 : \
-     rtl/rel1/support/floor.pcert0 \
-     rtl/rel1/support/logdefs.lisp
-rtl/rel1/support/logdefs.pcert1 : acl2x = 0
-rtl/rel1/support/logdefs.pcert1 : no_pcert = 0
-rtl/rel1/support/logdefs.pcert1 : rtl/rel1/support/logdefs.pcert0
-rtl/rel1/support/logdefs.cert : | rtl/rel1/support/logdefs.pcert1
-
-rtl/rel1/support/loglemmas.pcert0 : no_pcert = 0
-rtl/rel1/support/loglemmas.pcert0 : acl2x = 0
-rtl/rel1/support/loglemmas.pcert0 : \
-     rtl/rel1/support/logdefs.pcert0 \
-     rtl/rel1/support/loglemmas.lisp
-rtl/rel1/support/loglemmas.pcert1 : acl2x = 0
-rtl/rel1/support/loglemmas.pcert1 : no_pcert = 0
-rtl/rel1/support/loglemmas.pcert1 : rtl/rel1/support/loglemmas.pcert0
-rtl/rel1/support/loglemmas.cert : | rtl/rel1/support/loglemmas.pcert1
-
-rtl/rel1/support/logxor-def.pcert0 : no_pcert = 0
-rtl/rel1/support/logxor-def.pcert0 : acl2x = 0
-rtl/rel1/support/logxor-def.pcert0 : \
-     rtl/rel1/support/floor.pcert0 \
-     rtl/rel1/support/logxor-def.lisp
-rtl/rel1/support/logxor-def.pcert1 : acl2x = 0
-rtl/rel1/support/logxor-def.pcert1 : no_pcert = 0
-rtl/rel1/support/logxor-def.pcert1 : rtl/rel1/support/logxor-def.pcert0
-rtl/rel1/support/logxor-def.cert : | rtl/rel1/support/logxor-def.pcert1
-
-rtl/rel1/support/logxor-lemmas.pcert0 : no_pcert = 0
-rtl/rel1/support/logxor-lemmas.pcert0 : acl2x = 0
-rtl/rel1/support/logxor-lemmas.pcert0 : \
-     rtl/rel1/support/logxor-def.pcert0 \
-     rtl/rel1/support/loglemmas.pcert0 \
-     rtl/rel1/support/logxor-lemmas.lisp
-rtl/rel1/support/logxor-lemmas.pcert1 : acl2x = 0
-rtl/rel1/support/logxor-lemmas.pcert1 : no_pcert = 0
-rtl/rel1/support/logxor-lemmas.pcert1 : rtl/rel1/support/logxor-lemmas.pcert0
-rtl/rel1/support/logxor-lemmas.cert : | rtl/rel1/support/logxor-lemmas.pcert1
-
-rtl/rel1/support/merge.pcert0 : no_pcert = 0
-rtl/rel1/support/merge.pcert0 : acl2x = 0
-rtl/rel1/support/merge.pcert0 : \
-     rtl/rel1/support/proofs.pcert0 \
-     rtl/rel1/support/merge.lisp
-rtl/rel1/support/merge.pcert1 : acl2x = 0
-rtl/rel1/support/merge.pcert1 : no_pcert = 0
-rtl/rel1/support/merge.pcert1 : rtl/rel1/support/merge.pcert0
-rtl/rel1/support/merge.cert : | rtl/rel1/support/merge.pcert1
-
-rtl/rel1/support/near.pcert0 : no_pcert = 0
-rtl/rel1/support/near.pcert0 : acl2x = 0
-rtl/rel1/support/near.pcert0 : \
-     rtl/rel1/support/away.pcert0 \
-     rtl/rel1/support/near.lisp
-rtl/rel1/support/near.pcert1 : acl2x = 0
-rtl/rel1/support/near.pcert1 : no_pcert = 0
-rtl/rel1/support/near.pcert1 : rtl/rel1/support/near.pcert0
-rtl/rel1/support/near.cert : | rtl/rel1/support/near.pcert1
-
-rtl/rel1/support/odd.pcert0 : no_pcert = 0
-rtl/rel1/support/odd.pcert0 : acl2x = 0
-rtl/rel1/support/odd.pcert0 : \
-     rtl/rel1/support/near.pcert0 \
-     rtl/rel1/support/odd.lisp
-rtl/rel1/support/odd.pcert1 : acl2x = 0
-rtl/rel1/support/odd.pcert1 : no_pcert = 0
-rtl/rel1/support/odd.pcert1 : rtl/rel1/support/odd.pcert0
-rtl/rel1/support/odd.cert : | rtl/rel1/support/odd.pcert1
-
-rtl/rel1/support/proofs.pcert0 : no_pcert = 0
-rtl/rel1/support/proofs.pcert0 : acl2x = 0
-rtl/rel1/support/proofs.pcert0 : \
-     rtl/rel1/support/basic.pcert0 \
-     rtl/rel1/support/x-2xx.pcert0 \
-     rtl/rel1/support/float.pcert0 \
-     rtl/rel1/support/trunc.pcert0 \
-     rtl/rel1/support/away.pcert0 \
-     rtl/rel1/support/near.pcert0 \
-     rtl/rel1/support/odd.pcert0 \
-     rtl/rel1/support/floor.pcert0 \
-     rtl/rel1/support/logdefs.pcert0 \
-     rtl/rel1/support/loglemmas.pcert0 \
-     rtl/rel1/support/divsqrt.pcert0 \
-     rtl/rel1/support/logxor-def.pcert0 \
-     rtl/rel1/support/logxor-lemmas.pcert0 \
-     rtl/rel1/support/reps.pcert0 \
-     rtl/rel1/support/sticky.pcert0 \
-     rtl/rel1/support/rnd.pcert0 \
-     rtl/rel1/support/add.pcert0 \
-     rtl/rel1/support/proofs.lisp
-rtl/rel1/support/proofs.pcert1 : acl2x = 0
-rtl/rel1/support/proofs.pcert1 : no_pcert = 0
-rtl/rel1/support/proofs.pcert1 : rtl/rel1/support/proofs.pcert0
-rtl/rel1/support/proofs.cert : | rtl/rel1/support/proofs.pcert1
-
-rtl/rel1/support/reps.pcert0 : no_pcert = 0
-rtl/rel1/support/reps.pcert0 : acl2x = 0
-rtl/rel1/support/reps.pcert0 : \
-     rtl/rel1/support/logdefs.pcert0 \
-     rtl/rel1/support/float.pcert0 \
-     rtl/rel1/support/reps.lisp
-rtl/rel1/support/reps.pcert1 : acl2x = 0
-rtl/rel1/support/reps.pcert1 : no_pcert = 0
-rtl/rel1/support/reps.pcert1 : rtl/rel1/support/reps.pcert0
-rtl/rel1/support/reps.cert : | rtl/rel1/support/reps.pcert1
-
-rtl/rel1/support/rewrite-theory.pcert0 : no_pcert = 0
-rtl/rel1/support/rewrite-theory.pcert0 : acl2x = 0
-rtl/rel1/support/rewrite-theory.pcert0 : \
-     rtl/rel1/support/rewrite-theory.lisp
-rtl/rel1/support/rewrite-theory.pcert1 : acl2x = 0
-rtl/rel1/support/rewrite-theory.pcert1 : no_pcert = 0
-rtl/rel1/support/rewrite-theory.pcert1 : rtl/rel1/support/rewrite-theory.pcert0
-rtl/rel1/support/rewrite-theory.cert : | rtl/rel1/support/rewrite-theory.pcert1
-
-rtl/rel1/support/rnd.pcert0 : no_pcert = 0
-rtl/rel1/support/rnd.pcert0 : acl2x = 0
-rtl/rel1/support/rnd.pcert0 : \
-     rtl/rel1/support/sticky.pcert0 \
-     rtl/rel1/support/rnd.lisp
-rtl/rel1/support/rnd.pcert1 : acl2x = 0
-rtl/rel1/support/rnd.pcert1 : no_pcert = 0
-rtl/rel1/support/rnd.pcert1 : rtl/rel1/support/rnd.pcert0
-rtl/rel1/support/rnd.cert : | rtl/rel1/support/rnd.pcert1
-
-rtl/rel1/support/sticky.pcert0 : no_pcert = 0
-rtl/rel1/support/sticky.pcert0 : acl2x = 0
-rtl/rel1/support/sticky.pcert0 : \
-     rtl/rel1/support/divsqrt.pcert0 \
-     rtl/rel1/support/sticky.lisp
-rtl/rel1/support/sticky.pcert1 : acl2x = 0
-rtl/rel1/support/sticky.pcert1 : no_pcert = 0
-rtl/rel1/support/sticky.pcert1 : rtl/rel1/support/sticky.pcert0
-rtl/rel1/support/sticky.cert : | rtl/rel1/support/sticky.pcert1
-
-rtl/rel1/support/trunc.pcert0 : no_pcert = 0
-rtl/rel1/support/trunc.pcert0 : acl2x = 0
-rtl/rel1/support/trunc.pcert0 : \
-     rtl/rel1/support/float.pcert0 \
-     rtl/rel1/support/trunc.lisp
-rtl/rel1/support/trunc.pcert1 : acl2x = 0
-rtl/rel1/support/trunc.pcert1 : no_pcert = 0
-rtl/rel1/support/trunc.pcert1 : rtl/rel1/support/trunc.pcert0
-rtl/rel1/support/trunc.cert : | rtl/rel1/support/trunc.pcert1
-
-rtl/rel1/support/x-2xx.pcert0 : no_pcert = 0
-rtl/rel1/support/x-2xx.pcert0 : acl2x = 0
-rtl/rel1/support/x-2xx.pcert0 : \
-     arithmetic/top.pcert0 \
-     rtl/rel1/support/x-2xx.lisp
-rtl/rel1/support/x-2xx.pcert1 : acl2x = 0
-rtl/rel1/support/x-2xx.pcert1 : no_pcert = 0
-rtl/rel1/support/x-2xx.pcert1 : rtl/rel1/support/x-2xx.pcert0
-rtl/rel1/support/x-2xx.cert : | rtl/rel1/support/x-2xx.pcert1
-
-rtl/rel4/arithmetic/arith.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/arith.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/arith.pcert0 : \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     rtl/rel4/arithmetic/arith.lisp
-rtl/rel4/arithmetic/arith.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/arith.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/arith.pcert1 : rtl/rel4/arithmetic/arith.pcert0
-rtl/rel4/arithmetic/arith.cert : | rtl/rel4/arithmetic/arith.pcert1
-
-rtl/rel4/arithmetic/arith2.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/arith2.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/arith2.pcert0 : \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/product.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel4/arithmetic/inverted-factor.pcert0 \
-     rtl/rel4/arithmetic/arith2.lisp
-rtl/rel4/arithmetic/arith2.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/arith2.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/arith2.pcert1 : rtl/rel4/arithmetic/arith2.pcert0
-rtl/rel4/arithmetic/arith2.cert : | rtl/rel4/arithmetic/arith2.pcert1
-
-rtl/rel4/arithmetic/basic.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/basic.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/basic.pcert0 : \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/even-odd.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/basic.lisp
-rtl/rel4/arithmetic/basic.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/basic.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/basic.pcert1 : rtl/rel4/arithmetic/basic.pcert0
-rtl/rel4/arithmetic/basic.cert : | rtl/rel4/arithmetic/basic.pcert1
-
-rtl/rel4/arithmetic/cg.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/cg.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/cg.pcert0 : \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/common-factor.pcert0 \
-     rtl/rel4/arithmetic/cg.lisp
-rtl/rel4/arithmetic/cg.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/cg.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/cg.pcert1 : rtl/rel4/arithmetic/cg.pcert0
-rtl/rel4/arithmetic/cg.cert : | rtl/rel4/arithmetic/cg.pcert1
-
-rtl/rel4/arithmetic/common-factor-defuns.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/common-factor-defuns.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/common-factor-defuns.pcert0 : \
-     rtl/rel4/arithmetic/inverted-factor.pcert0 \
-     rtl/rel4/arithmetic/common-factor-defuns.lisp
-rtl/rel4/arithmetic/common-factor-defuns.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/common-factor-defuns.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/common-factor-defuns.pcert1 : rtl/rel4/arithmetic/common-factor-defuns.pcert0
-rtl/rel4/arithmetic/common-factor-defuns.cert : | rtl/rel4/arithmetic/common-factor-defuns.pcert1
-
-rtl/rel4/arithmetic/common-factor.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/common-factor.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/common-factor.pcert0 : \
-     meta/meta-times-equal.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel4/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/product.pcert0 \
-     rtl/rel4/arithmetic/common-factor.lisp
-rtl/rel4/arithmetic/common-factor.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/common-factor.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/common-factor.pcert1 : rtl/rel4/arithmetic/common-factor.pcert0
-rtl/rel4/arithmetic/common-factor.cert : | rtl/rel4/arithmetic/common-factor.pcert1
-
-rtl/rel4/arithmetic/complex-rationalp.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/complex-rationalp.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/complex-rationalp.pcert0 : \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/complex-rationalp.lisp
-rtl/rel4/arithmetic/complex-rationalp.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/complex-rationalp.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/complex-rationalp.pcert1 : rtl/rel4/arithmetic/complex-rationalp.pcert0
-rtl/rel4/arithmetic/complex-rationalp.cert : | rtl/rel4/arithmetic/complex-rationalp.pcert1
-
-rtl/rel4/arithmetic/denominator.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/denominator.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/denominator.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     arithmetic/mod-gcd.pcert0 \
-     rtl/rel4/arithmetic/denominator.lisp
-rtl/rel4/arithmetic/denominator.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/denominator.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/denominator.pcert1 : rtl/rel4/arithmetic/denominator.pcert0
-rtl/rel4/arithmetic/denominator.cert : | rtl/rel4/arithmetic/denominator.pcert1
-
-rtl/rel4/arithmetic/even-odd.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/even-odd.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/even-odd.pcert0 : \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/even-odd.lisp
-rtl/rel4/arithmetic/even-odd.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/even-odd.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/even-odd.pcert1 : rtl/rel4/arithmetic/even-odd.pcert0
-rtl/rel4/arithmetic/even-odd.cert : | rtl/rel4/arithmetic/even-odd.pcert1
-
-rtl/rel4/arithmetic/even-odd2-proofs.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/even-odd2-proofs.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/even-odd2-proofs.pcert0 : \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/arith.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/even-odd2-proofs.lisp
-rtl/rel4/arithmetic/even-odd2-proofs.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/even-odd2-proofs.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/even-odd2-proofs.pcert1 : rtl/rel4/arithmetic/even-odd2-proofs.pcert0
-rtl/rel4/arithmetic/even-odd2-proofs.cert : | rtl/rel4/arithmetic/even-odd2-proofs.pcert1
-
-rtl/rel4/arithmetic/even-odd2.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/even-odd2.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/even-odd2.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/even-odd2-proofs.pcert0 \
-     rtl/rel4/arithmetic/even-odd2.lisp
-rtl/rel4/arithmetic/even-odd2.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/even-odd2.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/even-odd2.pcert1 : rtl/rel4/arithmetic/even-odd2.pcert0
-rtl/rel4/arithmetic/even-odd2.cert : | rtl/rel4/arithmetic/even-odd2.pcert1
-
-rtl/rel4/arithmetic/expo-proofs.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/expo-proofs.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/expo-proofs.pcert0 : \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel4/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel4/arithmetic/common-factor.pcert0 \
-     rtl/rel4/arithmetic/expo-proofs.lisp
-rtl/rel4/arithmetic/expo-proofs.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/expo-proofs.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/expo-proofs.pcert1 : rtl/rel4/arithmetic/expo-proofs.pcert0
-rtl/rel4/arithmetic/expo-proofs.cert : | rtl/rel4/arithmetic/expo-proofs.pcert1
-
-rtl/rel4/arithmetic/expo.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/expo.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/expo.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/expo-proofs.pcert0 \
-     rtl/rel4/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel4/arithmetic/expo.lisp
-rtl/rel4/arithmetic/expo.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/expo.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/expo.pcert1 : rtl/rel4/arithmetic/expo.pcert0
-rtl/rel4/arithmetic/expo.cert : | rtl/rel4/arithmetic/expo.pcert1
-
-rtl/rel4/arithmetic/expt-proofs.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/expt-proofs.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/expt-proofs.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/numerator.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     arithmetic/top.pcert0 \
-     rtl/rel4/arithmetic/even-odd.pcert0 \
-     rtl/rel4/arithmetic/expt-proofs.lisp
-rtl/rel4/arithmetic/expt-proofs.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/expt-proofs.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/expt-proofs.pcert1 : rtl/rel4/arithmetic/expt-proofs.pcert0
-rtl/rel4/arithmetic/expt-proofs.cert : | rtl/rel4/arithmetic/expt-proofs.pcert1
-
-rtl/rel4/arithmetic/expt.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/expt.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/expt.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/expt-proofs.pcert0 \
-     rtl/rel4/arithmetic/expt.lisp
-rtl/rel4/arithmetic/expt.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/expt.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/expt.pcert1 : rtl/rel4/arithmetic/expt.pcert0
-rtl/rel4/arithmetic/expt.cert : | rtl/rel4/arithmetic/expt.pcert1
-
-rtl/rel4/arithmetic/extra-rules.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/extra-rules.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/extra-rules.pcert0 : \
-     rtl/rel4/arithmetic/basic.pcert0 \
-     rtl/rel4/arithmetic/extra-rules.lisp
-rtl/rel4/arithmetic/extra-rules.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/extra-rules.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/extra-rules.pcert1 : rtl/rel4/arithmetic/extra-rules.pcert0
-rtl/rel4/arithmetic/extra-rules.cert : | rtl/rel4/arithmetic/extra-rules.pcert1
-
-rtl/rel4/arithmetic/fl-expt.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/fl-expt.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/fl-expt.pcert0 : \
-     rtl/rel4/arithmetic/numerator.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/nniq.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/floor.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/rationalp.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/fl-expt.lisp
-rtl/rel4/arithmetic/fl-expt.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/fl-expt.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/fl-expt.pcert1 : rtl/rel4/arithmetic/fl-expt.pcert0
-rtl/rel4/arithmetic/fl-expt.cert : | rtl/rel4/arithmetic/fl-expt.pcert1
-
-rtl/rel4/arithmetic/fl-hacks.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/fl-hacks.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/fl-hacks.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/inverted-factor.pcert0 \
-     rtl/rel4/arithmetic/nniq.pcert0 \
-     rtl/rel4/arithmetic/numerator.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/product.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     rtl/rel4/arithmetic/rationalp.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/mod.pcert0 \
-     rtl/rel4/arithmetic/even-odd.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     rtl/rel4/arithmetic/arith.pcert0 \
-     rtl/rel4/arithmetic/fl-hacks.lisp
-rtl/rel4/arithmetic/fl-hacks.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/fl-hacks.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/fl-hacks.pcert1 : rtl/rel4/arithmetic/fl-hacks.pcert0
-rtl/rel4/arithmetic/fl-hacks.cert : | rtl/rel4/arithmetic/fl-hacks.pcert1
-
-rtl/rel4/arithmetic/fl-proofs.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/fl-proofs.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/fl-proofs.pcert0 : \
-     rtl/rel4/arithmetic/numerator.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/nniq.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/floor.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/rationalp.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     rtl/rel4/arithmetic/common-factor.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/fl-proofs.lisp
-rtl/rel4/arithmetic/fl-proofs.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/fl-proofs.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/fl-proofs.pcert1 : rtl/rel4/arithmetic/fl-proofs.pcert0
-rtl/rel4/arithmetic/fl-proofs.cert : | rtl/rel4/arithmetic/fl-proofs.pcert1
-
-rtl/rel4/arithmetic/fl.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/fl.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/fl.pcert0 : \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/fl-proofs.pcert0 \
-     rtl/rel4/arithmetic/fl.lisp
-rtl/rel4/arithmetic/fl.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/fl.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/fl.pcert1 : rtl/rel4/arithmetic/fl.pcert0
-rtl/rel4/arithmetic/fl.cert : | rtl/rel4/arithmetic/fl.pcert1
-
-rtl/rel4/arithmetic/floor-proofs.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/floor-proofs.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/floor-proofs.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/numerator.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/nniq.pcert0 \
-     rtl/rel4/arithmetic/product.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     rtl/rel4/arithmetic/rationalp.pcert0 \
-     rtl/rel4/arithmetic/inverted-factor.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel4/arithmetic/floor-proofs.lisp
-rtl/rel4/arithmetic/floor-proofs.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/floor-proofs.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/floor-proofs.pcert1 : rtl/rel4/arithmetic/floor-proofs.pcert0
-rtl/rel4/arithmetic/floor-proofs.cert : | rtl/rel4/arithmetic/floor-proofs.pcert1
-
-rtl/rel4/arithmetic/floor.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/floor.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/floor.pcert0 : \
-     rtl/rel4/arithmetic/floor-proofs.pcert0 \
-     rtl/rel4/arithmetic/floor.lisp
-rtl/rel4/arithmetic/floor.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/floor.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/floor.pcert1 : rtl/rel4/arithmetic/floor.pcert0
-rtl/rel4/arithmetic/floor.cert : | rtl/rel4/arithmetic/floor.pcert1
-
-rtl/rel4/arithmetic/fp.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/fp.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/fp.pcert0 : \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/fp.lisp
-rtl/rel4/arithmetic/fp.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/fp.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/fp.pcert1 : rtl/rel4/arithmetic/fp.pcert0
-rtl/rel4/arithmetic/fp.cert : | rtl/rel4/arithmetic/fp.pcert1
-
-rtl/rel4/arithmetic/fp2.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/fp2.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/fp2.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     arithmetic-2/meta/non-linear.pcert0 \
-     rtl/rel4/arithmetic/inverted-factor.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel4/arithmetic/fp2.lisp
-rtl/rel4/arithmetic/fp2.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/fp2.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/fp2.pcert1 : rtl/rel4/arithmetic/fp2.pcert0
-rtl/rel4/arithmetic/fp2.cert : | rtl/rel4/arithmetic/fp2.pcert1
-
-rtl/rel4/arithmetic/ground-zero.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/ground-zero.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/ground-zero.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.lisp
-rtl/rel4/arithmetic/ground-zero.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/ground-zero.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/ground-zero.pcert1 : rtl/rel4/arithmetic/ground-zero.pcert0
-rtl/rel4/arithmetic/ground-zero.cert : | rtl/rel4/arithmetic/ground-zero.pcert1
-
-rtl/rel4/arithmetic/hacks.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/hacks.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/hacks.pcert0 : \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/hacks.lisp
-rtl/rel4/arithmetic/hacks.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/hacks.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/hacks.pcert1 : rtl/rel4/arithmetic/hacks.pcert0
-rtl/rel4/arithmetic/hacks.cert : | rtl/rel4/arithmetic/hacks.pcert1
-
-rtl/rel4/arithmetic/induct.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/induct.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/induct.pcert0 : \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/induct.lisp
-rtl/rel4/arithmetic/induct.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/induct.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/induct.pcert1 : rtl/rel4/arithmetic/induct.pcert0
-rtl/rel4/arithmetic/induct.cert : | rtl/rel4/arithmetic/induct.pcert1
-
-rtl/rel4/arithmetic/integerp.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/integerp.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/integerp.pcert0 : \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/integerp.lisp
-rtl/rel4/arithmetic/integerp.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/integerp.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/integerp.pcert1 : rtl/rel4/arithmetic/integerp.pcert0
-rtl/rel4/arithmetic/integerp.cert : | rtl/rel4/arithmetic/integerp.pcert1
-
-rtl/rel4/arithmetic/inverted-factor.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/inverted-factor.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/inverted-factor.pcert0 : \
-     rtl/rel4/arithmetic/inverted-factor.lisp
-rtl/rel4/arithmetic/inverted-factor.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/inverted-factor.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/inverted-factor.pcert1 : rtl/rel4/arithmetic/inverted-factor.pcert0
-rtl/rel4/arithmetic/inverted-factor.cert : | rtl/rel4/arithmetic/inverted-factor.pcert1
-
-rtl/rel4/arithmetic/mod-expt.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/mod-expt.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/mod-expt.pcert0 : \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/numerator.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/nniq.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/floor.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/rationalp.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     rtl/rel4/arithmetic/fl-expt.pcert0 \
-     rtl/rel4/arithmetic/mod.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/mod-expt.lisp
-rtl/rel4/arithmetic/mod-expt.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/mod-expt.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/mod-expt.pcert1 : rtl/rel4/arithmetic/mod-expt.pcert0
-rtl/rel4/arithmetic/mod-expt.cert : | rtl/rel4/arithmetic/mod-expt.pcert1
-
-rtl/rel4/arithmetic/mod-proofs.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/mod-proofs.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/mod-proofs.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/floor.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/arith.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/product.pcert0 \
-     rtl/rel4/arithmetic/complex-rationalp.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/rationalp.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/mod-proofs.lisp
-rtl/rel4/arithmetic/mod-proofs.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/mod-proofs.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/mod-proofs.pcert1 : rtl/rel4/arithmetic/mod-proofs.pcert0
-rtl/rel4/arithmetic/mod-proofs.cert : | rtl/rel4/arithmetic/mod-proofs.pcert1
-
-rtl/rel4/arithmetic/mod.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/mod.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/mod.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/mod-proofs.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/mod.lisp
-rtl/rel4/arithmetic/mod.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/mod.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/mod.pcert1 : rtl/rel4/arithmetic/mod.pcert0
-rtl/rel4/arithmetic/mod.cert : | rtl/rel4/arithmetic/mod.pcert1
-
-rtl/rel4/arithmetic/negative-syntaxp.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/negative-syntaxp.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/negative-syntaxp.pcert0 : \
-     rtl/rel4/arithmetic/negative-syntaxp.lisp
-rtl/rel4/arithmetic/negative-syntaxp.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/negative-syntaxp.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/negative-syntaxp.pcert1 : rtl/rel4/arithmetic/negative-syntaxp.pcert0
-rtl/rel4/arithmetic/negative-syntaxp.cert : | rtl/rel4/arithmetic/negative-syntaxp.pcert1
-
-rtl/rel4/arithmetic/nniq.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/nniq.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/nniq.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/numerator.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     rtl/rel4/arithmetic/product.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/arith.pcert0 \
-     arithmetic/rationals.pcert0 \
-     arithmetic/idiv.pcert0 \
-     arithmetic/idiv.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     rtl/rel4/arithmetic/nniq.lisp
-rtl/rel4/arithmetic/nniq.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/nniq.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/nniq.pcert1 : rtl/rel4/arithmetic/nniq.pcert0
-rtl/rel4/arithmetic/nniq.cert : | rtl/rel4/arithmetic/nniq.pcert1
-
-rtl/rel4/arithmetic/numerator.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/numerator.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/numerator.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/numerator.lisp
-rtl/rel4/arithmetic/numerator.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/numerator.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/numerator.pcert1 : rtl/rel4/arithmetic/numerator.pcert0
-rtl/rel4/arithmetic/numerator.cert : | rtl/rel4/arithmetic/numerator.pcert1
-
-rtl/rel4/arithmetic/power2p.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/power2p.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/power2p.pcert0 : \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel4/arithmetic/power2p.lisp
-rtl/rel4/arithmetic/power2p.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/power2p.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/power2p.pcert1 : rtl/rel4/arithmetic/power2p.pcert0
-rtl/rel4/arithmetic/power2p.cert : | rtl/rel4/arithmetic/power2p.pcert1
-
-rtl/rel4/arithmetic/predicate.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/predicate.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/predicate.pcert0 : \
-     rtl/rel4/arithmetic/predicate.lisp
-rtl/rel4/arithmetic/predicate.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/predicate.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/predicate.pcert1 : rtl/rel4/arithmetic/predicate.pcert0
-rtl/rel4/arithmetic/predicate.cert : | rtl/rel4/arithmetic/predicate.pcert1
-
-rtl/rel4/arithmetic/product-proofs.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/product-proofs.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/product-proofs.pcert0 : \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/product-proofs.lisp
-rtl/rel4/arithmetic/product-proofs.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/product-proofs.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/product-proofs.pcert1 : rtl/rel4/arithmetic/product-proofs.pcert0
-rtl/rel4/arithmetic/product-proofs.cert : | rtl/rel4/arithmetic/product-proofs.pcert1
-
-rtl/rel4/arithmetic/product.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/product.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/product.pcert0 : \
-     rtl/rel4/arithmetic/product-proofs.pcert0 \
-     rtl/rel4/arithmetic/product.lisp
-rtl/rel4/arithmetic/product.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/product.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/product.pcert1 : rtl/rel4/arithmetic/product.pcert0
-rtl/rel4/arithmetic/product.cert : | rtl/rel4/arithmetic/product.pcert1
-
-rtl/rel4/arithmetic/rationalp.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/rationalp.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/rationalp.pcert0 : \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/rationalp.lisp
-rtl/rel4/arithmetic/rationalp.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/rationalp.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/rationalp.pcert1 : rtl/rel4/arithmetic/rationalp.pcert0
-rtl/rel4/arithmetic/rationalp.cert : | rtl/rel4/arithmetic/rationalp.pcert1
-
-rtl/rel4/arithmetic/top.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/top.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/top.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/induct.pcert0 \
-     rtl/rel4/arithmetic/denominator.pcert0 \
-     rtl/rel4/arithmetic/numerator.pcert0 \
-     rtl/rel4/arithmetic/nniq.pcert0 \
-     rtl/rel4/arithmetic/complex-rationalp.pcert0 \
-     rtl/rel4/arithmetic/rationalp.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/arithmetic/arith.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/basic.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.pcert0 \
-     rtl/rel4/arithmetic/product.pcert0 \
-     rtl/rel4/arithmetic/inverted-factor.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/x-2xx.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     rtl/rel4/arithmetic/even-odd2.pcert0 \
-     rtl/rel4/arithmetic/even-odd.pcert0 \
-     rtl/rel4/arithmetic/floor.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/cg.pcert0 \
-     rtl/rel4/arithmetic/mod.pcert0 \
-     rtl/rel4/arithmetic/fl-expt.pcert0 \
-     rtl/rel4/arithmetic/mod-expt.pcert0 \
-     rtl/rel4/arithmetic/common-factor.pcert0 \
-     rtl/rel4/arithmetic/top.lisp
-rtl/rel4/arithmetic/top.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/top.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/top.pcert1 : rtl/rel4/arithmetic/top.pcert0
-rtl/rel4/arithmetic/top.cert : | rtl/rel4/arithmetic/top.pcert1
-
-rtl/rel4/arithmetic/unary-divide.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/unary-divide.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/unary-divide.pcert0 : \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/inverted-factor.pcert0 \
-     rtl/rel4/arithmetic/unary-divide.lisp
-rtl/rel4/arithmetic/unary-divide.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/unary-divide.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/unary-divide.pcert1 : rtl/rel4/arithmetic/unary-divide.pcert0
-rtl/rel4/arithmetic/unary-divide.cert : | rtl/rel4/arithmetic/unary-divide.pcert1
-
-rtl/rel4/arithmetic/x-2xx.pcert0 : no_pcert = 0
-rtl/rel4/arithmetic/x-2xx.pcert0 : acl2x = 0
-rtl/rel4/arithmetic/x-2xx.pcert0 : \
-     arithmetic/top.pcert0 \
-     rtl/rel4/arithmetic/x-2xx.lisp
-rtl/rel4/arithmetic/x-2xx.pcert1 : acl2x = 0
-rtl/rel4/arithmetic/x-2xx.pcert1 : no_pcert = 0
-rtl/rel4/arithmetic/x-2xx.pcert1 : rtl/rel4/arithmetic/x-2xx.pcert0
-rtl/rel4/arithmetic/x-2xx.cert : | rtl/rel4/arithmetic/x-2xx.pcert1
-
-rtl/rel4/lib/arith.pcert0 : no_pcert = 0
-rtl/rel4/lib/arith.pcert0 : acl2x = 0
-rtl/rel4/lib/arith.pcert0 : \
-     rtl/rel4/arithmetic/fp.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel4/lib/arith.lisp
-rtl/rel4/lib/arith.pcert1 : acl2x = 0
-rtl/rel4/lib/arith.pcert1 : no_pcert = 0
-rtl/rel4/lib/arith.pcert1 : rtl/rel4/lib/arith.pcert0
-rtl/rel4/lib/arith.cert : | rtl/rel4/lib/arith.pcert1
-
-rtl/rel4/lib/basic.pcert0 : no_pcert = 0
-rtl/rel4/lib/basic.pcert0 : acl2x = 0
-rtl/rel4/lib/basic.pcert0 : \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/arithmetic/hacks.pcert0 \
-     rtl/rel4/arithmetic/cg.pcert0 \
-     rtl/rel4/support/ash.pcert0 \
-     rtl/rel4/arithmetic/fl-hacks.pcert0 \
-     rtl/rel4/arithmetic/mod.pcert0 \
-     rtl/rel4/arithmetic/even-odd.pcert0 \
-     rtl/rel4/arithmetic/extra-rules.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/lib/rtl.pcert0 \
-     rtl/rel4/lib/rtlarr.pcert0 \
-     rtl/rel4/lib/basic.lisp
-rtl/rel4/lib/basic.pcert1 : acl2x = 0
-rtl/rel4/lib/basic.pcert1 : no_pcert = 0
-rtl/rel4/lib/basic.pcert1 : rtl/rel4/lib/basic.pcert0
-rtl/rel4/lib/basic.cert : | rtl/rel4/lib/basic.pcert1
-
-rtl/rel4/lib/bits.pcert0 : no_pcert = 0
-rtl/rel4/lib/bits.pcert0 : acl2x = 0
-rtl/rel4/lib/bits.pcert0 : \
-     rtl/rel4/lib/basic.pcert0 \
-     rtl/rel4/support/top.pcert0 \
-     rtl/rel4/lib/bits.lisp
-rtl/rel4/lib/bits.pcert1 : acl2x = 0
-rtl/rel4/lib/bits.pcert1 : no_pcert = 0
-rtl/rel4/lib/bits.pcert1 : rtl/rel4/lib/bits.pcert0
-rtl/rel4/lib/bits.cert : | rtl/rel4/lib/bits.pcert1
-
-rtl/rel4/lib/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel4/lib/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel4/lib/bvecp-helpers.pcert0 : \
-     rtl/rel4/lib/rtl.pcert0 \
-     rtl/rel4/lib/rtlarr.pcert0 \
-     rtl/rel4/support/bvecp-helpers.pcert0 \
-     rtl/rel4/arithmetic/basic.pcert0 \
-     rtl/rel4/lib/bvecp-helpers.lisp
-rtl/rel4/lib/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel4/lib/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel4/lib/bvecp-helpers.pcert1 : rtl/rel4/lib/bvecp-helpers.pcert0
-rtl/rel4/lib/bvecp-helpers.cert : | rtl/rel4/lib/bvecp-helpers.pcert1
-
-rtl/rel4/lib/bvecp-raw-helpers.pcert0 : no_pcert = 0
-rtl/rel4/lib/bvecp-raw-helpers.pcert0 : acl2x = 0
-rtl/rel4/lib/bvecp-raw-helpers.pcert0 : \
-     rtl/rel4/lib/rtl.pcert0 \
-     rtl/rel4/lib/rtlarr.pcert0 \
-     rtl/rel4/support/bvecp-helpers.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/setbits.pcert0 \
-     rtl/rel4/support/setbitn.pcert0 \
-     rtl/rel4/support/logs.pcert0 \
-     rtl/rel4/support/lnot.pcert0 \
-     rtl/rel4/support/shft.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/mulcat.pcert0 \
-     rtl/rel4/support/encode.pcert0 \
-     rtl/rel4/support/decode.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     rtl/rel4/arithmetic/basic.pcert0 \
-     rtl/rel4/lib/bvecp-raw-helpers.lisp
-rtl/rel4/lib/bvecp-raw-helpers.pcert1 : acl2x = 0
-rtl/rel4/lib/bvecp-raw-helpers.pcert1 : no_pcert = 0
-rtl/rel4/lib/bvecp-raw-helpers.pcert1 : rtl/rel4/lib/bvecp-raw-helpers.pcert0
-rtl/rel4/lib/bvecp-raw-helpers.cert : | rtl/rel4/lib/bvecp-raw-helpers.pcert1
-
-rtl/rel4/lib/clocks.pcert0 : no_pcert = 0
-rtl/rel4/lib/clocks.pcert0 : acl2x = 0
-rtl/rel4/lib/clocks.pcert0 : \
-     rtl/rel4/support/clocks.pcert0 \
-     rtl/rel4/lib/clocks.lisp
-rtl/rel4/lib/clocks.pcert1 : acl2x = 0
-rtl/rel4/lib/clocks.pcert1 : no_pcert = 0
-rtl/rel4/lib/clocks.pcert1 : rtl/rel4/lib/clocks.pcert0
-rtl/rel4/lib/clocks.cert : | rtl/rel4/lib/clocks.pcert1
-
-rtl/rel4/lib/fadd.pcert0 : no_pcert = 0
-rtl/rel4/lib/fadd.pcert0 : acl2x = 0
-rtl/rel4/lib/fadd.pcert0 : \
-     rtl/rel4/support/fadd.pcert0 \
-     rtl/rel4/support/bits-extra.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/lib/float.pcert0 \
-     rtl/rel4/lib/fadd.lisp
-rtl/rel4/lib/fadd.pcert1 : acl2x = 0
-rtl/rel4/lib/fadd.pcert1 : no_pcert = 0
-rtl/rel4/lib/fadd.pcert1 : rtl/rel4/lib/fadd.pcert0
-rtl/rel4/lib/fadd.cert : | rtl/rel4/lib/fadd.pcert1
-
-rtl/rel4/lib/float.pcert0 : no_pcert = 0
-rtl/rel4/lib/float.pcert0 : acl2x = 0
-rtl/rel4/lib/float.pcert0 : \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/lib/bits.pcert0 \
-     rtl/rel4/lib/float.lisp
-rtl/rel4/lib/float.pcert1 : acl2x = 0
-rtl/rel4/lib/float.pcert1 : no_pcert = 0
-rtl/rel4/lib/float.pcert1 : rtl/rel4/lib/float.pcert0
-rtl/rel4/lib/float.cert : | rtl/rel4/lib/float.pcert1
-
-rtl/rel4/lib/openers.pcert0 : no_pcert = 0
-rtl/rel4/lib/openers.pcert0 : acl2x = 0
-rtl/rel4/lib/openers.pcert0 : \
-     rtl/rel4/support/openers.pcert0 \
-     rtl/rel4/lib/openers.lisp
-rtl/rel4/lib/openers.pcert1 : acl2x = 0
-rtl/rel4/lib/openers.pcert1 : no_pcert = 0
-rtl/rel4/lib/openers.pcert1 : rtl/rel4/lib/openers.pcert0
-rtl/rel4/lib/openers.cert : | rtl/rel4/lib/openers.pcert1
-
-rtl/rel4/lib/package-defs.pcert0 : no_pcert = 0
-rtl/rel4/lib/package-defs.pcert0 : acl2x = 0
-rtl/rel4/lib/package-defs.pcert0 : \
-     rtl/rel4/support/package-defs.pcert0 \
-     rtl/rel4/lib/package-defs.lisp
-rtl/rel4/lib/package-defs.pcert1 : acl2x = 0
-rtl/rel4/lib/package-defs.pcert1 : no_pcert = 0
-rtl/rel4/lib/package-defs.pcert1 : rtl/rel4/lib/package-defs.pcert0
-rtl/rel4/lib/package-defs.cert : | rtl/rel4/lib/package-defs.pcert1
-
-rtl/rel4/lib/reps.pcert0 : no_pcert = 0
-rtl/rel4/lib/reps.pcert0 : acl2x = 0
-rtl/rel4/lib/reps.pcert0 : \
-     rtl/rel4/support/ereps.pcert0 \
-     rtl/rel4/support/ireps.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/lib/float.pcert0 \
-     rtl/rel4/lib/reps.lisp
-rtl/rel4/lib/reps.pcert1 : acl2x = 0
-rtl/rel4/lib/reps.pcert1 : no_pcert = 0
-rtl/rel4/lib/reps.pcert1 : rtl/rel4/lib/reps.pcert0
-rtl/rel4/lib/reps.cert : | rtl/rel4/lib/reps.pcert1
-
-rtl/rel4/lib/rom-helpers.pcert0 : no_pcert = 0
-rtl/rel4/lib/rom-helpers.pcert0 : acl2x = 0
-rtl/rel4/lib/rom-helpers.pcert0 : \
-     rtl/rel4/support/rom-helpers.pcert0 \
-     rtl/rel4/lib/rom-helpers.lisp
-rtl/rel4/lib/rom-helpers.pcert1 : acl2x = 0
-rtl/rel4/lib/rom-helpers.pcert1 : no_pcert = 0
-rtl/rel4/lib/rom-helpers.pcert1 : rtl/rel4/lib/rom-helpers.pcert0
-rtl/rel4/lib/rom-helpers.cert : | rtl/rel4/lib/rom-helpers.pcert1
-
-rtl/rel4/lib/round.pcert0 : no_pcert = 0
-rtl/rel4/lib/round.pcert0 : acl2x = 0
-rtl/rel4/lib/round.pcert0 : \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/support/near.pcert0 \
-     rtl/rel4/support/near+.pcert0 \
-     rtl/rel4/support/oddr.pcert0 \
-     rtl/rel4/support/rnd.pcert0 \
-     rtl/rel4/support/drnd.pcert0 \
-     rtl/rel4/support/bits-trunc.pcert0 \
-     rtl/rel4/support/sticky.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/lib/reps.pcert0 \
-     rtl/rel4/lib/round.lisp
-rtl/rel4/lib/round.pcert1 : acl2x = 0
-rtl/rel4/lib/round.pcert1 : no_pcert = 0
-rtl/rel4/lib/round.pcert1 : rtl/rel4/lib/round.pcert0
-rtl/rel4/lib/round.cert : | rtl/rel4/lib/round.pcert1
-
-rtl/rel4/lib/rtl.pcert0 : no_pcert = 0
-rtl/rel4/lib/rtl.pcert0 : acl2x = 0
-rtl/rel4/lib/rtl.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/mulcat.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/lib/rtl.lisp
-rtl/rel4/lib/rtl.pcert1 : acl2x = 0
-rtl/rel4/lib/rtl.pcert1 : no_pcert = 0
-rtl/rel4/lib/rtl.pcert1 : rtl/rel4/lib/rtl.pcert0
-rtl/rel4/lib/rtl.cert : | rtl/rel4/lib/rtl.pcert1
-
-rtl/rel4/lib/rtlarr.pcert0 : no_pcert = 0
-rtl/rel4/lib/rtlarr.pcert0 : acl2x = 0
-rtl/rel4/lib/rtlarr.pcert0 : \
-     rtl/rel4/support/rtlarr.pcert0 \
-     rtl/rel4/support/bvecp-helpers.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     misc/total-order.pcert0 \
-     rtl/rel4/lib/rtl.pcert0 \
-     rtl/rel4/lib/rtlarr.lisp
-rtl/rel4/lib/rtlarr.pcert1 : acl2x = 0
-rtl/rel4/lib/rtlarr.pcert1 : no_pcert = 0
-rtl/rel4/lib/rtlarr.pcert1 : rtl/rel4/lib/rtlarr.pcert0
-rtl/rel4/lib/rtlarr.cert : | rtl/rel4/lib/rtlarr.pcert1
-
-rtl/rel4/lib/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel4/lib/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel4/lib/simple-loop-helpers.pcert0 : \
-     rtl/rel4/lib/rtl.pcert0 \
-     rtl/rel4/lib/rtlarr.pcert0 \
-     rtl/rel4/lib/arith.pcert0 \
-     rtl/rel4/lib/bits.pcert0 \
-     rtl/rel4/support/simple-loop-helpers.pcert0 \
-     rtl/rel4/lib/simple-loop-helpers.lisp
-rtl/rel4/lib/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel4/lib/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel4/lib/simple-loop-helpers.pcert1 : rtl/rel4/lib/simple-loop-helpers.pcert0
-rtl/rel4/lib/simple-loop-helpers.cert : | rtl/rel4/lib/simple-loop-helpers.pcert1
-
-rtl/rel4/lib/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel4/lib/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel4/lib/simplify-model-helpers.pcert0 : \
-     rtl/rel4/lib/rtl.pcert0 \
-     rtl/rel4/lib/arith.pcert0 \
-     rtl/rel4/lib/bits.pcert0 \
-     rtl/rel4/support/simplify-model-helpers.pcert0 \
-     rtl/rel4/lib/simplify-model-helpers.lisp
-rtl/rel4/lib/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel4/lib/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel4/lib/simplify-model-helpers.pcert1 : rtl/rel4/lib/simplify-model-helpers.pcert0
-rtl/rel4/lib/simplify-model-helpers.cert : | rtl/rel4/lib/simplify-model-helpers.pcert1
-
-rtl/rel4/lib/top.pcert0 : no_pcert = 0
-rtl/rel4/lib/top.pcert0 : acl2x = 0
-rtl/rel4/lib/top.pcert0 : \
-     rtl/rel4/lib/rtl.pcert0 \
-     rtl/rel4/lib/rtlarr.pcert0 \
-     rtl/rel4/lib/basic.pcert0 \
-     rtl/rel4/lib/bits.pcert0 \
-     rtl/rel4/lib/float.pcert0 \
-     rtl/rel4/lib/reps.pcert0 \
-     rtl/rel4/lib/round.pcert0 \
-     rtl/rel4/lib/fadd.pcert0 \
-     rtl/rel4/lib/arith.pcert0 \
-     rtl/rel4/lib/util.pcert0 \
-     rtl/rel4/lib/top.lisp
-rtl/rel4/lib/top.pcert1 : acl2x = 0
-rtl/rel4/lib/top.pcert1 : no_pcert = 0
-rtl/rel4/lib/top.pcert1 : rtl/rel4/lib/top.pcert0
-rtl/rel4/lib/top.cert : | rtl/rel4/lib/top.pcert1
-
-rtl/rel4/lib/util.pcert0 : no_pcert = 0
-rtl/rel4/lib/util.pcert0 : acl2x = 0
-rtl/rel4/lib/util.pcert0 : \
-     rtl/rel4/support/util.pcert0 \
-     rtl/rel4/lib/util.lisp
-rtl/rel4/lib/util.pcert1 : acl2x = 0
-rtl/rel4/lib/util.pcert1 : no_pcert = 0
-rtl/rel4/lib/util.pcert1 : rtl/rel4/lib/util.pcert0
-rtl/rel4/lib/util.cert : | rtl/rel4/lib/util.pcert1
-
-rtl/rel4/support/add3-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/add3-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/add3-proofs.pcert0 : \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/support/add3-proofs.lisp
-rtl/rel4/support/add3-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/add3-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/add3-proofs.pcert1 : rtl/rel4/support/add3-proofs.pcert0
-rtl/rel4/support/add3-proofs.cert : | rtl/rel4/support/add3-proofs.pcert1
-
-rtl/rel4/support/add3.pcert0 : no_pcert = 0
-rtl/rel4/support/add3.pcert0 : acl2x = 0
-rtl/rel4/support/add3.pcert0 : \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/add3-proofs.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/support/add3.lisp
-rtl/rel4/support/add3.pcert1 : acl2x = 0
-rtl/rel4/support/add3.pcert1 : no_pcert = 0
-rtl/rel4/support/add3.pcert1 : rtl/rel4/support/add3.pcert0
-rtl/rel4/support/add3.cert : | rtl/rel4/support/add3.pcert1
-
-rtl/rel4/support/all-ones.pcert0 : no_pcert = 0
-rtl/rel4/support/all-ones.pcert0 : acl2x = 0
-rtl/rel4/support/all-ones.pcert0 : \
-     rtl/rel4/support/all-ones.lisp
-rtl/rel4/support/all-ones.pcert1 : acl2x = 0
-rtl/rel4/support/all-ones.pcert1 : no_pcert = 0
-rtl/rel4/support/all-ones.pcert1 : rtl/rel4/support/all-ones.pcert0
-rtl/rel4/support/all-ones.cert : | rtl/rel4/support/all-ones.pcert1
-
-rtl/rel4/support/ash.pcert0 : no_pcert = 0
-rtl/rel4/support/ash.pcert0 : acl2x = 0
-rtl/rel4/support/ash.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     rtl/rel4/support/ash.lisp
-rtl/rel4/support/ash.pcert1 : acl2x = 0
-rtl/rel4/support/ash.pcert1 : no_pcert = 0
-rtl/rel4/support/ash.pcert1 : rtl/rel4/support/ash.pcert0
-rtl/rel4/support/ash.cert : | rtl/rel4/support/ash.pcert1
-
-rtl/rel4/support/away-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/away-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/away-proofs.pcert0 : \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/away-proofs.lisp
-rtl/rel4/support/away-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/away-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/away-proofs.pcert1 : rtl/rel4/support/away-proofs.pcert0
-rtl/rel4/support/away-proofs.cert : | rtl/rel4/support/away-proofs.pcert1
-
-rtl/rel4/support/away.pcert0 : no_pcert = 0
-rtl/rel4/support/away.pcert0 : acl2x = 0
-rtl/rel4/support/away.pcert0 : \
-     rtl/rel4/support/away-proofs.pcert0 \
-     rtl/rel4/support/away.lisp
-rtl/rel4/support/away.pcert1 : acl2x = 0
-rtl/rel4/support/away.pcert1 : no_pcert = 0
-rtl/rel4/support/away.pcert1 : rtl/rel4/support/away.pcert0
-rtl/rel4/support/away.cert : | rtl/rel4/support/away.pcert1
-
-rtl/rel4/support/badguys.pcert0 : no_pcert = 0
-rtl/rel4/support/badguys.pcert0 : acl2x = 0
-rtl/rel4/support/badguys.pcert0 : \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/badguys.lisp
-rtl/rel4/support/badguys.pcert1 : acl2x = 0
-rtl/rel4/support/badguys.pcert1 : no_pcert = 0
-rtl/rel4/support/badguys.pcert1 : rtl/rel4/support/badguys.pcert0
-rtl/rel4/support/badguys.cert : | rtl/rel4/support/badguys.pcert1
-
-rtl/rel4/support/bias-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/bias-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/bias-proofs.pcert0 : \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/support/bias-proofs.lisp
-rtl/rel4/support/bias-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/bias-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/bias-proofs.pcert1 : rtl/rel4/support/bias-proofs.pcert0
-rtl/rel4/support/bias-proofs.cert : | rtl/rel4/support/bias-proofs.pcert1
-
-rtl/rel4/support/bias.pcert0 : no_pcert = 0
-rtl/rel4/support/bias.pcert0 : acl2x = 0
-rtl/rel4/support/bias.pcert0 : \
-     rtl/rel4/support/bias-proofs.pcert0 \
-     rtl/rel4/support/bias.lisp
-rtl/rel4/support/bias.pcert1 : acl2x = 0
-rtl/rel4/support/bias.pcert1 : no_pcert = 0
-rtl/rel4/support/bias.pcert1 : rtl/rel4/support/bias.pcert0
-rtl/rel4/support/bias.cert : | rtl/rel4/support/bias.pcert1
-
-rtl/rel4/support/bitn-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/bitn-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/bitn-proofs.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/bitn-proofs.lisp
-rtl/rel4/support/bitn-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/bitn-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/bitn-proofs.pcert1 : rtl/rel4/support/bitn-proofs.pcert0
-rtl/rel4/support/bitn-proofs.cert : | rtl/rel4/support/bitn-proofs.pcert1
-
-rtl/rel4/support/bitn.pcert0 : no_pcert = 0
-rtl/rel4/support/bitn.pcert0 : acl2x = 0
-rtl/rel4/support/bitn.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/support/bitn-proofs.pcert0 \
-     rtl/rel4/support/bitn.lisp
-rtl/rel4/support/bitn.pcert1 : acl2x = 0
-rtl/rel4/support/bitn.pcert1 : no_pcert = 0
-rtl/rel4/support/bitn.pcert1 : rtl/rel4/support/bitn.pcert0
-rtl/rel4/support/bitn.cert : | rtl/rel4/support/bitn.pcert1
-
-rtl/rel4/support/bits-extra.pcert0 : no_pcert = 0
-rtl/rel4/support/bits-extra.pcert0 : acl2x = 0
-rtl/rel4/support/bits-extra.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/fadd.pcert0 \
-     rtl/rel4/support/top1.pcert0 \
-     rtl/rel4/support/bits-extra.lisp
-rtl/rel4/support/bits-extra.pcert1 : acl2x = 0
-rtl/rel4/support/bits-extra.pcert1 : no_pcert = 0
-rtl/rel4/support/bits-extra.pcert1 : rtl/rel4/support/bits-extra.pcert0
-rtl/rel4/support/bits-extra.cert : | rtl/rel4/support/bits-extra.pcert1
-
-rtl/rel4/support/bits-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/bits-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/bits-proofs.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/bits-proofs.lisp
-rtl/rel4/support/bits-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/bits-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/bits-proofs.pcert1 : rtl/rel4/support/bits-proofs.pcert0
-rtl/rel4/support/bits-proofs.cert : | rtl/rel4/support/bits-proofs.pcert1
-
-rtl/rel4/support/bits-trunc-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/bits-trunc-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/bits-trunc-proofs.pcert0 : \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/log.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bits-trunc-proofs.lisp
-rtl/rel4/support/bits-trunc-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/bits-trunc-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/bits-trunc-proofs.pcert1 : rtl/rel4/support/bits-trunc-proofs.pcert0
-rtl/rel4/support/bits-trunc-proofs.cert : | rtl/rel4/support/bits-trunc-proofs.pcert1
-
-rtl/rel4/support/bits-trunc.pcert0 : no_pcert = 0
-rtl/rel4/support/bits-trunc.pcert0 : acl2x = 0
-rtl/rel4/support/bits-trunc.pcert0 : \
-     rtl/rel4/support/log.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/bits-trunc-proofs.pcert0 \
-     rtl/rel4/support/bits-trunc.lisp
-rtl/rel4/support/bits-trunc.pcert1 : acl2x = 0
-rtl/rel4/support/bits-trunc.pcert1 : no_pcert = 0
-rtl/rel4/support/bits-trunc.pcert1 : rtl/rel4/support/bits-trunc.pcert0
-rtl/rel4/support/bits-trunc.cert : | rtl/rel4/support/bits-trunc.pcert1
-
-rtl/rel4/support/bits.pcert0 : no_pcert = 0
-rtl/rel4/support/bits.pcert0 : acl2x = 0
-rtl/rel4/support/bits.pcert0 : \
-     rtl/rel4/support/bits-proofs.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/support/bits.lisp
-rtl/rel4/support/bits.pcert1 : acl2x = 0
-rtl/rel4/support/bits.pcert1 : no_pcert = 0
-rtl/rel4/support/bits.pcert1 : rtl/rel4/support/bits.pcert0
-rtl/rel4/support/bits.cert : | rtl/rel4/support/bits.pcert1
-
-rtl/rel4/support/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel4/support/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel4/support/bvecp-helpers.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/bvecp-lemmas.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bvecp-helpers.lisp
-rtl/rel4/support/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel4/support/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel4/support/bvecp-helpers.pcert1 : rtl/rel4/support/bvecp-helpers.pcert0
-rtl/rel4/support/bvecp-helpers.cert : | rtl/rel4/support/bvecp-helpers.pcert1
-
-rtl/rel4/support/bvecp-lemmas.pcert0 : no_pcert = 0
-rtl/rel4/support/bvecp-lemmas.pcert0 : acl2x = 0
-rtl/rel4/support/bvecp-lemmas.pcert0 : \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/setbits.pcert0 \
-     rtl/rel4/support/setbitn.pcert0 \
-     rtl/rel4/support/encode.pcert0 \
-     rtl/rel4/support/decode.pcert0 \
-     rtl/rel4/support/logs.pcert0 \
-     rtl/rel4/support/lnot.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/shft.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/mulcat.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/bvecp-lemmas.lisp
-rtl/rel4/support/bvecp-lemmas.pcert1 : acl2x = 0
-rtl/rel4/support/bvecp-lemmas.pcert1 : no_pcert = 0
-rtl/rel4/support/bvecp-lemmas.pcert1 : rtl/rel4/support/bvecp-lemmas.pcert0
-rtl/rel4/support/bvecp-lemmas.cert : | rtl/rel4/support/bvecp-lemmas.pcert1
-
-rtl/rel4/support/bvecp-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/bvecp-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/bvecp-proofs.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bvecp-proofs.lisp
-rtl/rel4/support/bvecp-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/bvecp-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/bvecp-proofs.pcert1 : rtl/rel4/support/bvecp-proofs.pcert0
-rtl/rel4/support/bvecp-proofs.cert : | rtl/rel4/support/bvecp-proofs.pcert1
-
-rtl/rel4/support/bvecp.pcert0 : no_pcert = 0
-rtl/rel4/support/bvecp.pcert0 : acl2x = 0
-rtl/rel4/support/bvecp.pcert0 : \
-     rtl/rel4/support/bvecp-proofs.pcert0 \
-     rtl/rel4/support/bvecp.lisp
-rtl/rel4/support/bvecp.pcert1 : acl2x = 0
-rtl/rel4/support/bvecp.pcert1 : no_pcert = 0
-rtl/rel4/support/bvecp.pcert1 : rtl/rel4/support/bvecp.pcert0
-rtl/rel4/support/bvecp.cert : | rtl/rel4/support/bvecp.pcert1
-
-rtl/rel4/support/cat-def.pcert0 : no_pcert = 0
-rtl/rel4/support/cat-def.pcert0 : acl2x = 0
-rtl/rel4/support/cat-def.pcert0 : \
-     rtl/rel4/support/cat-def.lisp
-rtl/rel4/support/cat-def.pcert1 : acl2x = 0
-rtl/rel4/support/cat-def.pcert1 : no_pcert = 0
-rtl/rel4/support/cat-def.pcert1 : rtl/rel4/support/cat-def.pcert0
-rtl/rel4/support/cat-def.cert : | rtl/rel4/support/cat-def.pcert1
-
-rtl/rel4/support/cat-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/cat-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/cat-proofs.pcert0 : \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/cat-proofs.lisp
-rtl/rel4/support/cat-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/cat-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/cat-proofs.pcert1 : rtl/rel4/support/cat-proofs.pcert0
-rtl/rel4/support/cat-proofs.cert : | rtl/rel4/support/cat-proofs.pcert1
-
-rtl/rel4/support/cat.pcert0 : no_pcert = 0
-rtl/rel4/support/cat.pcert0 : acl2x = 0
-rtl/rel4/support/cat.pcert0 : \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/support/cat-proofs.pcert0 \
-     rtl/rel4/support/cat.lisp
-rtl/rel4/support/cat.pcert1 : acl2x = 0
-rtl/rel4/support/cat.pcert1 : no_pcert = 0
-rtl/rel4/support/cat.pcert1 : rtl/rel4/support/cat.pcert0
-rtl/rel4/support/cat.cert : | rtl/rel4/support/cat.pcert1
-
-rtl/rel4/support/clocks.pcert0 : no_pcert = 0
-rtl/rel4/support/clocks.pcert0 : acl2x = 0
-rtl/rel4/support/clocks.pcert0 : \
-     rtl/rel4/support/mod4.pcert0 \
-     rtl/rel4/arithmetic/even-odd2.pcert0 \
-     rtl/rel4/support/clocks.lisp
-rtl/rel4/support/clocks.pcert1 : acl2x = 0
-rtl/rel4/support/clocks.pcert1 : no_pcert = 0
-rtl/rel4/support/clocks.pcert1 : rtl/rel4/support/clocks.pcert0
-rtl/rel4/support/clocks.cert : | rtl/rel4/support/clocks.pcert1
-
-rtl/rel4/support/decode-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/decode-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/decode-proofs.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/support/ash.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/decode-proofs.lisp
-rtl/rel4/support/decode-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/decode-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/decode-proofs.pcert1 : rtl/rel4/support/decode-proofs.pcert0
-rtl/rel4/support/decode-proofs.cert : | rtl/rel4/support/decode-proofs.pcert1
-
-rtl/rel4/support/decode.pcert0 : no_pcert = 0
-rtl/rel4/support/decode.pcert0 : acl2x = 0
-rtl/rel4/support/decode.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/decode-proofs.pcert0 \
-     rtl/rel4/support/decode.lisp
-rtl/rel4/support/decode.pcert1 : acl2x = 0
-rtl/rel4/support/decode.pcert1 : no_pcert = 0
-rtl/rel4/support/decode.pcert1 : rtl/rel4/support/decode.pcert0
-rtl/rel4/support/decode.cert : | rtl/rel4/support/decode.pcert1
-
-rtl/rel4/support/drnd.pcert0 : no_pcert = 0
-rtl/rel4/support/drnd.pcert0 : acl2x = 0
-rtl/rel4/support/drnd.pcert0 : \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/ireps.pcert0 \
-     rtl/rel4/support/rnd.pcert0 \
-     rtl/rel4/support/bias.pcert0 \
-     rtl/rel4/support/sgn.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/support/near.pcert0 \
-     rtl/rel4/support/near+.pcert0 \
-     rtl/rel4/support/sticky.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/drnd.lisp
-rtl/rel4/support/drnd.pcert1 : acl2x = 0
-rtl/rel4/support/drnd.pcert1 : no_pcert = 0
-rtl/rel4/support/drnd.pcert1 : rtl/rel4/support/drnd.pcert0
-rtl/rel4/support/drnd.cert : | rtl/rel4/support/drnd.pcert1
-
-rtl/rel4/support/encode.pcert0 : no_pcert = 0
-rtl/rel4/support/encode.pcert0 : acl2x = 0
-rtl/rel4/support/encode.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/ash.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/encode.lisp
-rtl/rel4/support/encode.pcert1 : acl2x = 0
-rtl/rel4/support/encode.pcert1 : no_pcert = 0
-rtl/rel4/support/encode.pcert1 : rtl/rel4/support/encode.pcert0
-rtl/rel4/support/encode.cert : | rtl/rel4/support/encode.pcert1
-
-rtl/rel4/support/ereps-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/ereps-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/ereps-proofs.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/bias.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/mulcat.pcert0 \
-     rtl/rel4/support/ereps-proofs.lisp
-rtl/rel4/support/ereps-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/ereps-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/ereps-proofs.pcert1 : rtl/rel4/support/ereps-proofs.pcert0
-rtl/rel4/support/ereps-proofs.cert : | rtl/rel4/support/ereps-proofs.pcert1
-
-rtl/rel4/support/ereps.pcert0 : no_pcert = 0
-rtl/rel4/support/ereps.pcert0 : acl2x = 0
-rtl/rel4/support/ereps.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/ereps-proofs.pcert0 \
-     rtl/rel4/support/ereps.lisp
-rtl/rel4/support/ereps.pcert1 : acl2x = 0
-rtl/rel4/support/ereps.pcert1 : no_pcert = 0
-rtl/rel4/support/ereps.pcert1 : rtl/rel4/support/ereps.pcert0
-rtl/rel4/support/ereps.cert : | rtl/rel4/support/ereps.pcert1
-
-rtl/rel4/support/fadd.pcert0 : no_pcert = 0
-rtl/rel4/support/fadd.pcert0 : acl2x = 0
-rtl/rel4/support/fadd.pcert0 : \
-     rtl/rel4/support/stick.pcert0 \
-     rtl/rel4/support/lop3.pcert0 \
-     rtl/rel4/support/add3.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/lextra.pcert0 \
-     rtl/rel4/support/fadd.lisp
-rtl/rel4/support/fadd.pcert1 : acl2x = 0
-rtl/rel4/support/fadd.pcert1 : no_pcert = 0
-rtl/rel4/support/fadd.pcert1 : rtl/rel4/support/fadd.pcert0
-rtl/rel4/support/fadd.cert : | rtl/rel4/support/fadd.pcert1
-
-rtl/rel4/support/fast-and.pcert0 : no_pcert = 0
-rtl/rel4/support/fast-and.pcert0 : acl2x = 0
-rtl/rel4/support/fast-and.pcert0 : \
-     rtl/rel4/support/fast-and.lisp
-rtl/rel4/support/fast-and.pcert1 : acl2x = 0
-rtl/rel4/support/fast-and.pcert1 : no_pcert = 0
-rtl/rel4/support/fast-and.pcert1 : rtl/rel4/support/fast-and.pcert0
-rtl/rel4/support/fast-and.cert : | rtl/rel4/support/fast-and.pcert1
-
-rtl/rel4/support/float.pcert0 : no_pcert = 0
-rtl/rel4/support/float.pcert0 : acl2x = 0
-rtl/rel4/support/float.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/basic.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/cg.pcert0 \
-     rtl/rel4/support/float.lisp
-rtl/rel4/support/float.pcert1 : acl2x = 0
-rtl/rel4/support/float.pcert1 : no_pcert = 0
-rtl/rel4/support/float.pcert1 : rtl/rel4/support/float.pcert0
-rtl/rel4/support/float.cert : | rtl/rel4/support/float.pcert1
-
-rtl/rel4/support/ground-zero.pcert0 : no_pcert = 0
-rtl/rel4/support/ground-zero.pcert0 : acl2x = 0
-rtl/rel4/support/ground-zero.pcert0 : \
-     rtl/rel4/arithmetic/ground-zero.pcert0 \
-     rtl/rel4/support/util.pcert0 \
-     rtl/rel4/support/ground-zero.lisp
-rtl/rel4/support/ground-zero.pcert1 : acl2x = 0
-rtl/rel4/support/ground-zero.pcert1 : no_pcert = 0
-rtl/rel4/support/ground-zero.pcert1 : rtl/rel4/support/ground-zero.pcert0
-rtl/rel4/support/ground-zero.cert : | rtl/rel4/support/ground-zero.pcert1
-
-rtl/rel4/support/guards.pcert0 : no_pcert = 0
-rtl/rel4/support/guards.pcert0 : acl2x = 0
-rtl/rel4/support/guards.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/top1.pcert0 \
-     rtl/rel4/support/guards.lisp
-rtl/rel4/support/guards.pcert1 : acl2x = 0
-rtl/rel4/support/guards.pcert1 : no_pcert = 0
-rtl/rel4/support/guards.pcert1 : rtl/rel4/support/guards.pcert0
-rtl/rel4/support/guards.cert : | rtl/rel4/support/guards.pcert1
-
-rtl/rel4/support/ireps.pcert0 : no_pcert = 0
-rtl/rel4/support/ireps.pcert0 : acl2x = 0
-rtl/rel4/support/ireps.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/bias.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/ireps.lisp
-rtl/rel4/support/ireps.pcert1 : acl2x = 0
-rtl/rel4/support/ireps.pcert1 : no_pcert = 0
-rtl/rel4/support/ireps.pcert1 : rtl/rel4/support/ireps.pcert0
-rtl/rel4/support/ireps.cert : | rtl/rel4/support/ireps.pcert1
-
-rtl/rel4/support/land-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/land-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/land-proofs.pcert0 : \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/all-ones.pcert0 \
-     rtl/rel4/support/log.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/land-proofs.lisp
-rtl/rel4/support/land-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/land-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/land-proofs.pcert1 : rtl/rel4/support/land-proofs.pcert0
-rtl/rel4/support/land-proofs.cert : | rtl/rel4/support/land-proofs.pcert1
-
-rtl/rel4/support/land.pcert0 : no_pcert = 0
-rtl/rel4/support/land.pcert0 : acl2x = 0
-rtl/rel4/support/land.pcert0 : \
-     rtl/rel4/support/land-proofs.pcert0 \
-     rtl/rel4/support/land.lisp
-rtl/rel4/support/land.pcert1 : acl2x = 0
-rtl/rel4/support/land.pcert1 : no_pcert = 0
-rtl/rel4/support/land.pcert1 : rtl/rel4/support/land.pcert0
-rtl/rel4/support/land.cert : | rtl/rel4/support/land.pcert1
-
-rtl/rel4/support/lextra-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/lextra-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/lextra-proofs.pcert0 : \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/support/logxor.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/lextra-proofs.lisp
-rtl/rel4/support/lextra-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/lextra-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/lextra-proofs.pcert1 : rtl/rel4/support/lextra-proofs.pcert0
-rtl/rel4/support/lextra-proofs.cert : | rtl/rel4/support/lextra-proofs.pcert1
-
-rtl/rel4/support/lextra.pcert0 : no_pcert = 0
-rtl/rel4/support/lextra.pcert0 : acl2x = 0
-rtl/rel4/support/lextra.pcert0 : \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/support/lextra-proofs.pcert0 \
-     rtl/rel4/support/lextra.lisp
-rtl/rel4/support/lextra.pcert1 : acl2x = 0
-rtl/rel4/support/lextra.pcert1 : no_pcert = 0
-rtl/rel4/support/lextra.pcert1 : rtl/rel4/support/lextra.pcert0
-rtl/rel4/support/lextra.cert : | rtl/rel4/support/lextra.pcert1
-
-rtl/rel4/support/lior-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/lior-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/lior-proofs.pcert0 : \
-     rtl/rel4/support/all-ones.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/lior-proofs.lisp
-rtl/rel4/support/lior-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/lior-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/lior-proofs.pcert1 : rtl/rel4/support/lior-proofs.pcert0
-rtl/rel4/support/lior-proofs.cert : | rtl/rel4/support/lior-proofs.pcert1
-
-rtl/rel4/support/lior.pcert0 : no_pcert = 0
-rtl/rel4/support/lior.pcert0 : acl2x = 0
-rtl/rel4/support/lior.pcert0 : \
-     rtl/rel4/support/lior-proofs.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/lior.lisp
-rtl/rel4/support/lior.pcert1 : acl2x = 0
-rtl/rel4/support/lior.pcert1 : no_pcert = 0
-rtl/rel4/support/lior.pcert1 : rtl/rel4/support/lior.pcert0
-rtl/rel4/support/lior.cert : | rtl/rel4/support/lior.pcert1
-
-rtl/rel4/support/lnot-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/lnot-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/lnot-proofs.pcert0 : \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/mod.pcert0 \
-     rtl/rel4/arithmetic/mod.pcert0 \
-     rtl/rel4/arithmetic/arith.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/lnot-proofs.lisp
-rtl/rel4/support/lnot-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/lnot-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/lnot-proofs.pcert1 : rtl/rel4/support/lnot-proofs.pcert0
-rtl/rel4/support/lnot-proofs.cert : | rtl/rel4/support/lnot-proofs.pcert1
-
-rtl/rel4/support/lnot.pcert0 : no_pcert = 0
-rtl/rel4/support/lnot.pcert0 : acl2x = 0
-rtl/rel4/support/lnot.pcert0 : \
-     rtl/rel4/support/lnot-proofs.pcert0 \
-     rtl/rel4/support/lnot.lisp
-rtl/rel4/support/lnot.pcert1 : acl2x = 0
-rtl/rel4/support/lnot.pcert1 : no_pcert = 0
-rtl/rel4/support/lnot.pcert1 : rtl/rel4/support/lnot.pcert0
-rtl/rel4/support/lnot.cert : | rtl/rel4/support/lnot.pcert1
-
-rtl/rel4/support/log-equal.pcert0 : no_pcert = 0
-rtl/rel4/support/log-equal.pcert0 : acl2x = 0
-rtl/rel4/support/log-equal.pcert0 : \
-     rtl/rel4/support/log-equal.lisp
-rtl/rel4/support/log-equal.pcert1 : acl2x = 0
-rtl/rel4/support/log-equal.pcert1 : no_pcert = 0
-rtl/rel4/support/log-equal.pcert1 : rtl/rel4/support/log-equal.pcert0
-rtl/rel4/support/log-equal.cert : | rtl/rel4/support/log-equal.pcert1
-
-rtl/rel4/support/log-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/log-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/log-proofs.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/lognot.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/lnot.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/logxor.pcert0 \
-     rtl/rel4/support/log-proofs.lisp
-rtl/rel4/support/log-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/log-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/log-proofs.pcert1 : rtl/rel4/support/log-proofs.pcert0
-rtl/rel4/support/log-proofs.cert : | rtl/rel4/support/log-proofs.pcert1
-
-rtl/rel4/support/log.pcert0 : no_pcert = 0
-rtl/rel4/support/log.pcert0 : acl2x = 0
-rtl/rel4/support/log.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/log-proofs.pcert0 \
-     rtl/rel4/support/lnot.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/support/logxor.pcert0 \
-     rtl/rel4/support/log.lisp
-rtl/rel4/support/log.pcert1 : acl2x = 0
-rtl/rel4/support/log.pcert1 : no_pcert = 0
-rtl/rel4/support/log.pcert1 : rtl/rel4/support/log.pcert0
-rtl/rel4/support/log.cert : | rtl/rel4/support/log.pcert1
-
-rtl/rel4/support/logand-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/logand-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/logand-proofs.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/arithmetic/induct.pcert0 \
-     rtl/rel4/support/lognot.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/logand-proofs.lisp
-rtl/rel4/support/logand-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/logand-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/logand-proofs.pcert1 : rtl/rel4/support/logand-proofs.pcert0
-rtl/rel4/support/logand-proofs.cert : | rtl/rel4/support/logand-proofs.pcert1
-
-rtl/rel4/support/logand.pcert0 : no_pcert = 0
-rtl/rel4/support/logand.pcert0 : acl2x = 0
-rtl/rel4/support/logand.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/logand-proofs.pcert0 \
-     rtl/rel4/support/logand.lisp
-rtl/rel4/support/logand.pcert1 : acl2x = 0
-rtl/rel4/support/logand.pcert1 : no_pcert = 0
-rtl/rel4/support/logand.pcert1 : rtl/rel4/support/logand.pcert0
-rtl/rel4/support/logand.cert : | rtl/rel4/support/logand.pcert1
-
-rtl/rel4/support/logeqv.pcert0 : no_pcert = 0
-rtl/rel4/support/logeqv.pcert0 : acl2x = 0
-rtl/rel4/support/logeqv.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/logorc1.pcert0 \
-     rtl/rel4/support/lognot.pcert0 \
-     rtl/rel4/support/logeqv.lisp
-rtl/rel4/support/logeqv.pcert1 : acl2x = 0
-rtl/rel4/support/logeqv.pcert1 : no_pcert = 0
-rtl/rel4/support/logeqv.pcert1 : rtl/rel4/support/logeqv.pcert0
-rtl/rel4/support/logeqv.cert : | rtl/rel4/support/logeqv.pcert1
-
-rtl/rel4/support/logior-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/logior-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/logior-proofs.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/lognot.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/logior-proofs.lisp
-rtl/rel4/support/logior-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/logior-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/logior-proofs.pcert1 : rtl/rel4/support/logior-proofs.pcert0
-rtl/rel4/support/logior-proofs.cert : | rtl/rel4/support/logior-proofs.pcert1
-
-rtl/rel4/support/logior.pcert0 : no_pcert = 0
-rtl/rel4/support/logior.pcert0 : acl2x = 0
-rtl/rel4/support/logior.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/logior-proofs.pcert0 \
-     rtl/rel4/support/logior.lisp
-rtl/rel4/support/logior.pcert1 : acl2x = 0
-rtl/rel4/support/logior.pcert1 : no_pcert = 0
-rtl/rel4/support/logior.pcert1 : rtl/rel4/support/logior.pcert0
-rtl/rel4/support/logior.cert : | rtl/rel4/support/logior.pcert1
-
-rtl/rel4/support/logior1-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/logior1-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/logior1-proofs.pcert0 : \
-     rtl/rel4/support/logior1-proofs.lisp
-rtl/rel4/support/logior1-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/logior1-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/logior1-proofs.pcert1 : rtl/rel4/support/logior1-proofs.pcert0
-rtl/rel4/support/logior1-proofs.cert : | rtl/rel4/support/logior1-proofs.pcert1
-
-rtl/rel4/support/logior1.pcert0 : no_pcert = 0
-rtl/rel4/support/logior1.pcert0 : acl2x = 0
-rtl/rel4/support/logior1.pcert0 : \
-     rtl/rel4/support/logior1-proofs.pcert0 \
-     rtl/rel4/support/logior1.lisp
-rtl/rel4/support/logior1.pcert1 : acl2x = 0
-rtl/rel4/support/logior1.pcert1 : no_pcert = 0
-rtl/rel4/support/logior1.pcert1 : rtl/rel4/support/logior1.pcert0
-rtl/rel4/support/logior1.cert : | rtl/rel4/support/logior1.pcert1
-
-rtl/rel4/support/lognot.pcert0 : no_pcert = 0
-rtl/rel4/support/lognot.pcert0 : acl2x = 0
-rtl/rel4/support/lognot.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/lognot.lisp
-rtl/rel4/support/lognot.pcert1 : acl2x = 0
-rtl/rel4/support/lognot.pcert1 : no_pcert = 0
-rtl/rel4/support/lognot.pcert1 : rtl/rel4/support/lognot.pcert0
-rtl/rel4/support/lognot.cert : | rtl/rel4/support/lognot.pcert1
-
-rtl/rel4/support/logorc1.pcert0 : no_pcert = 0
-rtl/rel4/support/logorc1.pcert0 : acl2x = 0
-rtl/rel4/support/logorc1.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/support/lognot.pcert0 \
-     rtl/rel4/support/logorc1.lisp
-rtl/rel4/support/logorc1.pcert1 : acl2x = 0
-rtl/rel4/support/logorc1.pcert1 : no_pcert = 0
-rtl/rel4/support/logorc1.pcert1 : rtl/rel4/support/logorc1.pcert0
-rtl/rel4/support/logorc1.cert : | rtl/rel4/support/logorc1.pcert1
-
-rtl/rel4/support/logs.pcert0 : no_pcert = 0
-rtl/rel4/support/logs.pcert0 : acl2x = 0
-rtl/rel4/support/logs.pcert0 : \
-     rtl/rel4/support/logs.lisp
-rtl/rel4/support/logs.pcert1 : acl2x = 0
-rtl/rel4/support/logs.pcert1 : no_pcert = 0
-rtl/rel4/support/logs.pcert1 : rtl/rel4/support/logs.pcert0
-rtl/rel4/support/logs.cert : | rtl/rel4/support/logs.pcert1
-
-rtl/rel4/support/logxor.pcert0 : no_pcert = 0
-rtl/rel4/support/logxor.pcert0 : acl2x = 0
-rtl/rel4/support/logxor.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/logeqv.pcert0 \
-     rtl/rel4/support/logorc1.pcert0 \
-     rtl/rel4/support/lognot.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/logxor.lisp
-rtl/rel4/support/logxor.pcert1 : acl2x = 0
-rtl/rel4/support/logxor.pcert1 : no_pcert = 0
-rtl/rel4/support/logxor.pcert1 : rtl/rel4/support/logxor.pcert0
-rtl/rel4/support/logxor.cert : | rtl/rel4/support/logxor.pcert1
-
-rtl/rel4/support/lop1-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/lop1-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/lop1-proofs.pcert0 : \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/lop1-proofs.lisp
-rtl/rel4/support/lop1-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/lop1-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/lop1-proofs.pcert1 : rtl/rel4/support/lop1-proofs.pcert0
-rtl/rel4/support/lop1-proofs.cert : | rtl/rel4/support/lop1-proofs.pcert1
-
-rtl/rel4/support/lop1.pcert0 : no_pcert = 0
-rtl/rel4/support/lop1.pcert0 : acl2x = 0
-rtl/rel4/support/lop1.pcert0 : \
-     rtl/rel4/support/lop1-proofs.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/lop1.lisp
-rtl/rel4/support/lop1.pcert1 : acl2x = 0
-rtl/rel4/support/lop1.pcert1 : no_pcert = 0
-rtl/rel4/support/lop1.pcert1 : rtl/rel4/support/lop1.pcert0
-rtl/rel4/support/lop1.cert : | rtl/rel4/support/lop1.pcert1
-
-rtl/rel4/support/lop2-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/lop2-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/lop2-proofs.pcert0 : \
-     rtl/rel4/support/lop1.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/support/lop2-proofs.lisp
-rtl/rel4/support/lop2-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/lop2-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/lop2-proofs.pcert1 : rtl/rel4/support/lop2-proofs.pcert0
-rtl/rel4/support/lop2-proofs.cert : | rtl/rel4/support/lop2-proofs.pcert1
-
-rtl/rel4/support/lop2.pcert0 : no_pcert = 0
-rtl/rel4/support/lop2.pcert0 : acl2x = 0
-rtl/rel4/support/lop2.pcert0 : \
-     rtl/rel4/support/lop1.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lop2-proofs.pcert0 \
-     rtl/rel4/support/lop2.lisp
-rtl/rel4/support/lop2.pcert1 : acl2x = 0
-rtl/rel4/support/lop2.pcert1 : no_pcert = 0
-rtl/rel4/support/lop2.pcert1 : rtl/rel4/support/lop2.pcert0
-rtl/rel4/support/lop2.cert : | rtl/rel4/support/lop2.pcert1
-
-rtl/rel4/support/lop3-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/lop3-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/lop3-proofs.pcert0 : \
-     rtl/rel4/support/lop2.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/support/lop3-proofs.lisp
-rtl/rel4/support/lop3-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/lop3-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/lop3-proofs.pcert1 : rtl/rel4/support/lop3-proofs.pcert0
-rtl/rel4/support/lop3-proofs.cert : | rtl/rel4/support/lop3-proofs.pcert1
-
-rtl/rel4/support/lop3.pcert0 : no_pcert = 0
-rtl/rel4/support/lop3.pcert0 : acl2x = 0
-rtl/rel4/support/lop3.pcert0 : \
-     rtl/rel4/support/lop2.pcert0 \
-     rtl/rel4/support/lop3-proofs.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/support/lop3.lisp
-rtl/rel4/support/lop3.pcert1 : acl2x = 0
-rtl/rel4/support/lop3.pcert1 : no_pcert = 0
-rtl/rel4/support/lop3.pcert1 : rtl/rel4/support/lop3.pcert0
-rtl/rel4/support/lop3.cert : | rtl/rel4/support/lop3.pcert1
-
-rtl/rel4/support/lxor-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/lxor-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/lxor-proofs.pcert0 : \
-     rtl/rel4/support/all-ones.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/lxor-proofs.lisp
-rtl/rel4/support/lxor-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/lxor-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/lxor-proofs.pcert1 : rtl/rel4/support/lxor-proofs.pcert0
-rtl/rel4/support/lxor-proofs.cert : | rtl/rel4/support/lxor-proofs.pcert1
-
-rtl/rel4/support/lxor.pcert0 : no_pcert = 0
-rtl/rel4/support/lxor.pcert0 : acl2x = 0
-rtl/rel4/support/lxor.pcert0 : \
-     rtl/rel4/support/lxor-proofs.pcert0 \
-     rtl/rel4/support/lxor.lisp
-rtl/rel4/support/lxor.pcert1 : acl2x = 0
-rtl/rel4/support/lxor.pcert1 : no_pcert = 0
-rtl/rel4/support/lxor.pcert1 : rtl/rel4/support/lxor.pcert0
-rtl/rel4/support/lxor.cert : | rtl/rel4/support/lxor.pcert1
-
-rtl/rel4/support/merge.pcert0 : no_pcert = 0
-rtl/rel4/support/merge.pcert0 : acl2x = 0
-rtl/rel4/support/merge.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/log.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/lnot.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/logxor.pcert0 \
-     rtl/rel4/support/ocat.pcert0 \
-     rtl/rel4/support/sumbits.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/merge.lisp
-rtl/rel4/support/merge.pcert1 : acl2x = 0
-rtl/rel4/support/merge.pcert1 : no_pcert = 0
-rtl/rel4/support/merge.pcert1 : rtl/rel4/support/merge.pcert0
-rtl/rel4/support/merge.cert : | rtl/rel4/support/merge.pcert1
-
-rtl/rel4/support/merge2.pcert0 : no_pcert = 0
-rtl/rel4/support/merge2.pcert0 : acl2x = 0
-rtl/rel4/support/merge2.pcert0 : \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/logs.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/merge2.lisp
-rtl/rel4/support/merge2.pcert1 : acl2x = 0
-rtl/rel4/support/merge2.pcert1 : no_pcert = 0
-rtl/rel4/support/merge2.pcert1 : rtl/rel4/support/merge2.pcert0
-rtl/rel4/support/merge2.cert : | rtl/rel4/support/merge2.pcert1
-
-rtl/rel4/support/mod4.pcert0 : no_pcert = 0
-rtl/rel4/support/mod4.pcert0 : acl2x = 0
-rtl/rel4/support/mod4.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/mod4.lisp
-rtl/rel4/support/mod4.pcert1 : acl2x = 0
-rtl/rel4/support/mod4.pcert1 : no_pcert = 0
-rtl/rel4/support/mod4.pcert1 : rtl/rel4/support/mod4.pcert0
-rtl/rel4/support/mod4.cert : | rtl/rel4/support/mod4.pcert1
-
-rtl/rel4/support/model-helpers.pcert0 : no_pcert = 0
-rtl/rel4/support/model-helpers.pcert0 : acl2x = 0
-rtl/rel4/support/model-helpers.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/model-helpers.lisp
-rtl/rel4/support/model-helpers.pcert1 : acl2x = 0
-rtl/rel4/support/model-helpers.pcert1 : no_pcert = 0
-rtl/rel4/support/model-helpers.pcert1 : rtl/rel4/support/model-helpers.pcert0
-rtl/rel4/support/model-helpers.cert : | rtl/rel4/support/model-helpers.pcert1
-
-rtl/rel4/support/mulcat-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/mulcat-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/mulcat-proofs.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/mulcat-proofs.lisp
-rtl/rel4/support/mulcat-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/mulcat-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/mulcat-proofs.pcert1 : rtl/rel4/support/mulcat-proofs.pcert0
-rtl/rel4/support/mulcat-proofs.cert : | rtl/rel4/support/mulcat-proofs.pcert1
-
-rtl/rel4/support/mulcat.pcert0 : no_pcert = 0
-rtl/rel4/support/mulcat.pcert0 : acl2x = 0
-rtl/rel4/support/mulcat.pcert0 : \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/support/mulcat-proofs.pcert0 \
-     rtl/rel4/support/mulcat.lisp
-rtl/rel4/support/mulcat.pcert1 : acl2x = 0
-rtl/rel4/support/mulcat.pcert1 : no_pcert = 0
-rtl/rel4/support/mulcat.pcert1 : rtl/rel4/support/mulcat.pcert0
-rtl/rel4/support/mulcat.cert : | rtl/rel4/support/mulcat.pcert1
-
-rtl/rel4/support/near+-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/near+-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/near+-proofs.pcert0 : \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/arithmetic/predicate.pcert0 \
-     rtl/rel4/arithmetic/cg.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/near+-proofs.lisp
-rtl/rel4/support/near+-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/near+-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/near+-proofs.pcert1 : rtl/rel4/support/near+-proofs.pcert0
-rtl/rel4/support/near+-proofs.cert : | rtl/rel4/support/near+-proofs.pcert1
-
-rtl/rel4/support/near+.pcert0 : no_pcert = 0
-rtl/rel4/support/near+.pcert0 : acl2x = 0
-rtl/rel4/support/near+.pcert0 : \
-     rtl/rel4/support/near+-proofs.pcert0 \
-     rtl/rel4/support/near+.lisp
-rtl/rel4/support/near+.pcert1 : acl2x = 0
-rtl/rel4/support/near+.pcert1 : no_pcert = 0
-rtl/rel4/support/near+.pcert1 : rtl/rel4/support/near+.pcert0
-rtl/rel4/support/near+.cert : | rtl/rel4/support/near+.pcert1
-
-rtl/rel4/support/near-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/near-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/near-proofs.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/near-proofs.lisp
-rtl/rel4/support/near-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/near-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/near-proofs.pcert1 : rtl/rel4/support/near-proofs.pcert0
-rtl/rel4/support/near-proofs.cert : | rtl/rel4/support/near-proofs.pcert1
-
-rtl/rel4/support/near.pcert0 : no_pcert = 0
-rtl/rel4/support/near.pcert0 : acl2x = 0
-rtl/rel4/support/near.pcert0 : \
-     rtl/rel4/support/near-proofs.pcert0 \
-     rtl/rel4/support/near.lisp
-rtl/rel4/support/near.pcert1 : acl2x = 0
-rtl/rel4/support/near.pcert1 : no_pcert = 0
-rtl/rel4/support/near.pcert1 : rtl/rel4/support/near.pcert0
-rtl/rel4/support/near.cert : | rtl/rel4/support/near.pcert1
-
-rtl/rel4/support/ocat.pcert0 : no_pcert = 0
-rtl/rel4/support/ocat.pcert0 : acl2x = 0
-rtl/rel4/support/ocat.pcert0 : \
-     rtl/rel4/arithmetic/expt.pcert0 \
-     rtl/rel4/arithmetic/expo.pcert0 \
-     rtl/rel4/arithmetic/arith2.pcert0 \
-     rtl/rel4/arithmetic/fp2.pcert0 \
-     rtl/rel4/arithmetic/integerp.pcert0 \
-     rtl/rel4/support/ocat.lisp
-rtl/rel4/support/ocat.pcert1 : acl2x = 0
-rtl/rel4/support/ocat.pcert1 : no_pcert = 0
-rtl/rel4/support/ocat.pcert1 : rtl/rel4/support/ocat.pcert0
-rtl/rel4/support/ocat.cert : | rtl/rel4/support/ocat.pcert1
-
-rtl/rel4/support/oddr-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/oddr-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/oddr-proofs.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/support/near.pcert0 \
-     rtl/rel4/support/oddr-proofs.lisp
-rtl/rel4/support/oddr-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/oddr-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/oddr-proofs.pcert1 : rtl/rel4/support/oddr-proofs.pcert0
-rtl/rel4/support/oddr-proofs.cert : | rtl/rel4/support/oddr-proofs.pcert1
-
-rtl/rel4/support/oddr.pcert0 : no_pcert = 0
-rtl/rel4/support/oddr.pcert0 : acl2x = 0
-rtl/rel4/support/oddr.pcert0 : \
-     rtl/rel4/support/oddr-proofs.pcert0 \
-     rtl/rel4/support/oddr.lisp
-rtl/rel4/support/oddr.pcert1 : acl2x = 0
-rtl/rel4/support/oddr.pcert1 : no_pcert = 0
-rtl/rel4/support/oddr.pcert1 : rtl/rel4/support/oddr.pcert0
-rtl/rel4/support/oddr.cert : | rtl/rel4/support/oddr.pcert1
-
-rtl/rel4/support/openers.pcert0 : no_pcert = 0
-rtl/rel4/support/openers.pcert0 : acl2x = 0
-rtl/rel4/support/openers.pcert0 : \
-     rtl/rel4/support/openers.lisp
-rtl/rel4/support/openers.pcert1 : acl2x = 0
-rtl/rel4/support/openers.pcert1 : no_pcert = 0
-rtl/rel4/support/openers.pcert1 : rtl/rel4/support/openers.pcert0
-rtl/rel4/support/openers.cert : | rtl/rel4/support/openers.pcert1
-
-rtl/rel4/support/package-defs.pcert0 : no_pcert = 0
-rtl/rel4/support/package-defs.pcert0 : acl2x = 0
-rtl/rel4/support/package-defs.pcert0 : \
-     rtl/rel4/support/package-defs.lisp
-rtl/rel4/support/package-defs.pcert1 : acl2x = 0
-rtl/rel4/support/package-defs.pcert1 : no_pcert = 0
-rtl/rel4/support/package-defs.pcert1 : rtl/rel4/support/package-defs.pcert0
-rtl/rel4/support/package-defs.cert : | rtl/rel4/support/package-defs.pcert1
-
-rtl/rel4/support/rewrite-theory.pcert0 : no_pcert = 0
-rtl/rel4/support/rewrite-theory.pcert0 : acl2x = 0
-rtl/rel4/support/rewrite-theory.pcert0 : \
-     rtl/rel4/support/rewrite-theory.lisp
-rtl/rel4/support/rewrite-theory.pcert1 : acl2x = 0
-rtl/rel4/support/rewrite-theory.pcert1 : no_pcert = 0
-rtl/rel4/support/rewrite-theory.pcert1 : rtl/rel4/support/rewrite-theory.pcert0
-rtl/rel4/support/rewrite-theory.cert : | rtl/rel4/support/rewrite-theory.pcert1
-
-rtl/rel4/support/rnd.pcert0 : no_pcert = 0
-rtl/rel4/support/rnd.pcert0 : acl2x = 0
-rtl/rel4/support/rnd.pcert0 : \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/support/near.pcert0 \
-     rtl/rel4/support/near+.pcert0 \
-     rtl/rel4/support/sticky.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bits-trunc.pcert0 \
-     rtl/rel4/support/rnd.lisp
-rtl/rel4/support/rnd.pcert1 : acl2x = 0
-rtl/rel4/support/rnd.pcert1 : no_pcert = 0
-rtl/rel4/support/rnd.pcert1 : rtl/rel4/support/rnd.pcert0
-rtl/rel4/support/rnd.cert : | rtl/rel4/support/rnd.pcert1
-
-rtl/rel4/support/rom-helpers.pcert0 : no_pcert = 0
-rtl/rel4/support/rom-helpers.pcert0 : acl2x = 0
-rtl/rel4/support/rom-helpers.pcert0 : \
-     rtl/rel4/support/rom-helpers.lisp
-rtl/rel4/support/rom-helpers.pcert1 : acl2x = 0
-rtl/rel4/support/rom-helpers.pcert1 : no_pcert = 0
-rtl/rel4/support/rom-helpers.pcert1 : rtl/rel4/support/rom-helpers.pcert0
-rtl/rel4/support/rom-helpers.cert : | rtl/rel4/support/rom-helpers.pcert1
-
-rtl/rel4/support/rtl.pcert0 : no_pcert = 0
-rtl/rel4/support/rtl.pcert0 : acl2x = 0
-rtl/rel4/support/rtl.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/rtlarr.pcert0 \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/support/rtl.lisp
-rtl/rel4/support/rtl.pcert1 : acl2x = 0
-rtl/rel4/support/rtl.pcert1 : no_pcert = 0
-rtl/rel4/support/rtl.pcert1 : rtl/rel4/support/rtl.pcert0
-rtl/rel4/support/rtl.cert : | rtl/rel4/support/rtl.pcert1
-
-rtl/rel4/support/rtlarr.pcert0 : no_pcert = 0
-rtl/rel4/support/rtlarr.pcert0 : acl2x = 0
-rtl/rel4/support/rtlarr.pcert0 : \
-     misc/total-order.pcert0 \
-     rtl/rel4/support/rtlarr.lisp
-rtl/rel4/support/rtlarr.pcert1 : acl2x = 0
-rtl/rel4/support/rtlarr.pcert1 : no_pcert = 0
-rtl/rel4/support/rtlarr.pcert1 : rtl/rel4/support/rtlarr.pcert0
-rtl/rel4/support/rtlarr.cert : | rtl/rel4/support/rtlarr.pcert1
-
-rtl/rel4/support/setbitn-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/setbitn-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/setbitn-proofs.pcert0 : \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/support/setbits.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/setbitn-proofs.lisp
-rtl/rel4/support/setbitn-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/setbitn-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/setbitn-proofs.pcert1 : rtl/rel4/support/setbitn-proofs.pcert0
-rtl/rel4/support/setbitn-proofs.cert : | rtl/rel4/support/setbitn-proofs.pcert1
-
-rtl/rel4/support/setbitn.pcert0 : no_pcert = 0
-rtl/rel4/support/setbitn.pcert0 : acl2x = 0
-rtl/rel4/support/setbitn.pcert0 : \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/support/setbitn-proofs.pcert0 \
-     rtl/rel4/support/setbitn.lisp
-rtl/rel4/support/setbitn.pcert1 : acl2x = 0
-rtl/rel4/support/setbitn.pcert1 : no_pcert = 0
-rtl/rel4/support/setbitn.pcert1 : rtl/rel4/support/setbitn.pcert0
-rtl/rel4/support/setbitn.cert : | rtl/rel4/support/setbitn.pcert1
-
-rtl/rel4/support/setbits-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/setbits-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/setbits-proofs.pcert0 : \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/setbits-proofs.lisp
-rtl/rel4/support/setbits-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/setbits-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/setbits-proofs.pcert1 : rtl/rel4/support/setbits-proofs.pcert0
-rtl/rel4/support/setbits-proofs.cert : | rtl/rel4/support/setbits-proofs.pcert1
-
-rtl/rel4/support/setbits.pcert0 : no_pcert = 0
-rtl/rel4/support/setbits.pcert0 : acl2x = 0
-rtl/rel4/support/setbits.pcert0 : \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/support/setbits-proofs.pcert0 \
-     rtl/rel4/support/setbits.lisp
-rtl/rel4/support/setbits.pcert1 : acl2x = 0
-rtl/rel4/support/setbits.pcert1 : no_pcert = 0
-rtl/rel4/support/setbits.pcert1 : rtl/rel4/support/setbits.pcert0
-rtl/rel4/support/setbits.cert : | rtl/rel4/support/setbits.pcert1
-
-rtl/rel4/support/sgn.pcert0 : no_pcert = 0
-rtl/rel4/support/sgn.pcert0 : acl2x = 0
-rtl/rel4/support/sgn.pcert0 : \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/sgn.lisp
-rtl/rel4/support/sgn.pcert1 : acl2x = 0
-rtl/rel4/support/sgn.pcert1 : no_pcert = 0
-rtl/rel4/support/sgn.pcert1 : rtl/rel4/support/sgn.pcert0
-rtl/rel4/support/sgn.cert : | rtl/rel4/support/sgn.pcert1
-
-rtl/rel4/support/shft.pcert0 : no_pcert = 0
-rtl/rel4/support/shft.pcert0 : acl2x = 0
-rtl/rel4/support/shft.pcert0 : \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/shft.lisp
-rtl/rel4/support/shft.pcert1 : acl2x = 0
-rtl/rel4/support/shft.pcert1 : no_pcert = 0
-rtl/rel4/support/shft.pcert1 : rtl/rel4/support/shft.pcert0
-rtl/rel4/support/shft.cert : | rtl/rel4/support/shft.pcert1
-
-rtl/rel4/support/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel4/support/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel4/support/simple-loop-helpers.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/setbitn.pcert0 \
-     rtl/rel4/support/simple-loop-helpers.lisp
-rtl/rel4/support/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel4/support/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel4/support/simple-loop-helpers.pcert1 : rtl/rel4/support/simple-loop-helpers.pcert0
-rtl/rel4/support/simple-loop-helpers.cert : | rtl/rel4/support/simple-loop-helpers.pcert1
-
-rtl/rel4/support/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel4/support/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel4/support/simplify-model-helpers.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/simplify-model-helpers.lisp
-rtl/rel4/support/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel4/support/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel4/support/simplify-model-helpers.pcert1 : rtl/rel4/support/simplify-model-helpers.pcert0
-rtl/rel4/support/simplify-model-helpers.cert : | rtl/rel4/support/simplify-model-helpers.pcert1
-
-rtl/rel4/support/stick-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/stick-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/stick-proofs.pcert0 : \
-     rtl/rel4/support/merge.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/lnot.pcert0 \
-     rtl/rel4/support/stick-proofs.lisp
-rtl/rel4/support/stick-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/stick-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/stick-proofs.pcert1 : rtl/rel4/support/stick-proofs.pcert0
-rtl/rel4/support/stick-proofs.cert : | rtl/rel4/support/stick-proofs.pcert1
-
-rtl/rel4/support/stick.pcert0 : no_pcert = 0
-rtl/rel4/support/stick.pcert0 : acl2x = 0
-rtl/rel4/support/stick.pcert0 : \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/stick-proofs.pcert0 \
-     rtl/rel4/support/stick.lisp
-rtl/rel4/support/stick.pcert1 : acl2x = 0
-rtl/rel4/support/stick.pcert1 : no_pcert = 0
-rtl/rel4/support/stick.pcert1 : rtl/rel4/support/stick.pcert0
-rtl/rel4/support/stick.cert : | rtl/rel4/support/stick.pcert1
-
-rtl/rel4/support/sticky-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/sticky-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/sticky-proofs.pcert0 : \
-     rtl/rel4/arithmetic/arith.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/support/near.pcert0 \
-     rtl/rel4/support/near+.pcert0 \
-     rtl/rel4/support/sticky-proofs.lisp
-rtl/rel4/support/sticky-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/sticky-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/sticky-proofs.pcert1 : rtl/rel4/support/sticky-proofs.pcert0
-rtl/rel4/support/sticky-proofs.cert : | rtl/rel4/support/sticky-proofs.pcert1
-
-rtl/rel4/support/sticky.pcert0 : no_pcert = 0
-rtl/rel4/support/sticky.pcert0 : acl2x = 0
-rtl/rel4/support/sticky.pcert0 : \
-     rtl/rel4/support/sticky-proofs.pcert0 \
-     rtl/rel4/support/sticky.lisp
-rtl/rel4/support/sticky.pcert1 : acl2x = 0
-rtl/rel4/support/sticky.pcert1 : no_pcert = 0
-rtl/rel4/support/sticky.pcert1 : rtl/rel4/support/sticky.pcert0
-rtl/rel4/support/sticky.cert : | rtl/rel4/support/sticky.pcert1
-
-rtl/rel4/support/sumbits.pcert0 : no_pcert = 0
-rtl/rel4/support/sumbits.pcert0 : acl2x = 0
-rtl/rel4/support/sumbits.pcert0 : \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/sumbits.lisp
-rtl/rel4/support/sumbits.pcert1 : acl2x = 0
-rtl/rel4/support/sumbits.pcert1 : no_pcert = 0
-rtl/rel4/support/sumbits.pcert1 : rtl/rel4/support/sumbits.pcert0
-rtl/rel4/support/sumbits.cert : | rtl/rel4/support/sumbits.pcert1
-
-rtl/rel4/support/top.pcert0 : no_pcert = 0
-rtl/rel4/support/top.pcert0 : acl2x = 0
-rtl/rel4/support/top.pcert0 : \
-     rtl/rel4/support/top1.pcert0 \
-     rtl/rel4/support/bits-extra.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/support/top.lisp
-rtl/rel4/support/top.pcert1 : acl2x = 0
-rtl/rel4/support/top.pcert1 : no_pcert = 0
-rtl/rel4/support/top.pcert1 : rtl/rel4/support/top.pcert0
-rtl/rel4/support/top.cert : | rtl/rel4/support/top.pcert1
-
-rtl/rel4/support/top1.pcert0 : no_pcert = 0
-rtl/rel4/support/top1.pcert0 : acl2x = 0
-rtl/rel4/support/top1.pcert0 : \
-     rtl/rel4/support/util.pcert0 \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/rewrite-theory.pcert0 \
-     rtl/rel4/support/rtl.pcert0 \
-     rtl/rel4/support/rtlarr.pcert0 \
-     rtl/rel4/support/bvecp-lemmas.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/ocat.pcert0 \
-     rtl/rel4/support/cat-def.pcert0 \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/support/ash.pcert0 \
-     rtl/rel4/support/decode.pcert0 \
-     rtl/rel4/support/encode.pcert0 \
-     rtl/rel4/support/mulcat.pcert0 \
-     rtl/rel4/support/shft.pcert0 \
-     rtl/rel4/support/all-ones.pcert0 \
-     rtl/rel4/support/merge2.pcert0 \
-     rtl/rel4/support/logior1.pcert0 \
-     rtl/rel4/support/setbits.pcert0 \
-     rtl/rel4/support/setbitn.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/support/bias.pcert0 \
-     rtl/rel4/support/ereps.pcert0 \
-     rtl/rel4/support/ireps.pcert0 \
-     rtl/rel4/support/logeqv.pcert0 \
-     rtl/rel4/support/logorc1.pcert0 \
-     rtl/rel4/support/lognot.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     rtl/rel4/support/logior.pcert0 \
-     rtl/rel4/support/logxor.pcert0 \
-     rtl/rel4/support/log.pcert0 \
-     rtl/rel4/support/lnot.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/support/lextra.pcert0 \
-     rtl/rel4/support/logs.pcert0 \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/support/near.pcert0 \
-     rtl/rel4/support/near+.pcert0 \
-     rtl/rel4/support/oddr.pcert0 \
-     rtl/rel4/support/sticky.pcert0 \
-     rtl/rel4/support/rnd.pcert0 \
-     rtl/rel4/support/drnd.pcert0 \
-     rtl/rel4/support/bits-trunc.pcert0 \
-     rtl/rel4/support/add3.pcert0 \
-     rtl/rel4/support/lop1.pcert0 \
-     rtl/rel4/support/lop2.pcert0 \
-     rtl/rel4/support/lop3.pcert0 \
-     rtl/rel4/support/stick.pcert0 \
-     rtl/rel4/support/bvecp-helpers.pcert0 \
-     rtl/rel4/support/model-helpers.pcert0 \
-     rtl/rel4/support/rom-helpers.pcert0 \
-     rtl/rel4/support/simple-loop-helpers.pcert0 \
-     rtl/rel4/support/clocks.pcert0 \
-     rtl/rel4/support/openers.pcert0 \
-     rtl/rel4/support/package-defs.pcert0 \
-     rtl/rel4/support/simplify-model-helpers.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/arithmetic/fp.pcert0 \
-     rtl/rel4/support/fadd.pcert0 \
-     rtl/rel4/support/top1.lisp
-rtl/rel4/support/top1.pcert1 : acl2x = 0
-rtl/rel4/support/top1.pcert1 : no_pcert = 0
-rtl/rel4/support/top1.pcert1 : rtl/rel4/support/top1.pcert0
-rtl/rel4/support/top1.cert : | rtl/rel4/support/top1.pcert1
-
-rtl/rel4/support/trunc-proofs.pcert0 : no_pcert = 0
-rtl/rel4/support/trunc-proofs.pcert0 : acl2x = 0
-rtl/rel4/support/trunc-proofs.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/float.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     rtl/rel4/support/trunc-proofs.lisp
-rtl/rel4/support/trunc-proofs.pcert1 : acl2x = 0
-rtl/rel4/support/trunc-proofs.pcert1 : no_pcert = 0
-rtl/rel4/support/trunc-proofs.pcert1 : rtl/rel4/support/trunc-proofs.pcert0
-rtl/rel4/support/trunc-proofs.cert : | rtl/rel4/support/trunc-proofs.pcert1
-
-rtl/rel4/support/trunc.pcert0 : no_pcert = 0
-rtl/rel4/support/trunc.pcert0 : acl2x = 0
-rtl/rel4/support/trunc.pcert0 : \
-     rtl/rel4/support/ground-zero.pcert0 \
-     rtl/rel4/support/trunc-proofs.pcert0 \
-     rtl/rel4/support/trunc.lisp
-rtl/rel4/support/trunc.pcert1 : acl2x = 0
-rtl/rel4/support/trunc.pcert1 : no_pcert = 0
-rtl/rel4/support/trunc.pcert1 : rtl/rel4/support/trunc.pcert0
-rtl/rel4/support/trunc.cert : | rtl/rel4/support/trunc.pcert1
-
-rtl/rel4/support/util.pcert0 : no_pcert = 0
-rtl/rel4/support/util.pcert0 : acl2x = 0
-rtl/rel4/support/util.pcert0 : \
-     rtl/rel4/support/util.lisp
-rtl/rel4/support/util.pcert1 : acl2x = 0
-rtl/rel4/support/util.pcert1 : no_pcert = 0
-rtl/rel4/support/util.pcert1 : rtl/rel4/support/util.pcert0
-rtl/rel4/support/util.cert : | rtl/rel4/support/util.pcert1
-
-rtl/rel4/user/away.pcert0 : no_pcert = 0
-rtl/rel4/user/away.pcert0 : acl2x = 0
-rtl/rel4/user/away.pcert0 : \
-     rtl/rel4/user/trunc.pcert0 \
-     rtl/rel4/support/away.pcert0 \
-     rtl/rel4/user/away.lisp
-rtl/rel4/user/away.pcert1 : acl2x = 0
-rtl/rel4/user/away.pcert1 : no_pcert = 0
-rtl/rel4/user/away.pcert1 : rtl/rel4/user/away.pcert0
-rtl/rel4/user/away.cert : | rtl/rel4/user/away.pcert1
-
-rtl/rel4/user/bias.pcert0 : no_pcert = 0
-rtl/rel4/user/bias.pcert0 : acl2x = 0
-rtl/rel4/user/bias.pcert0 : \
-     rtl/rel4/support/bias.pcert0 \
-     rtl/rel4/user/bias.lisp
-rtl/rel4/user/bias.pcert1 : acl2x = 0
-rtl/rel4/user/bias.pcert1 : no_pcert = 0
-rtl/rel4/user/bias.pcert1 : rtl/rel4/user/bias.pcert0
-rtl/rel4/user/bias.cert : | rtl/rel4/user/bias.pcert1
-
-rtl/rel4/user/bitn.pcert0 : no_pcert = 0
-rtl/rel4/user/bitn.pcert0 : acl2x = 0
-rtl/rel4/user/bitn.pcert0 : \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/support/bitn.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/bitn.lisp
-rtl/rel4/user/bitn.pcert1 : acl2x = 0
-rtl/rel4/user/bitn.pcert1 : no_pcert = 0
-rtl/rel4/user/bitn.pcert1 : rtl/rel4/user/bitn.pcert0
-rtl/rel4/user/bitn.cert : | rtl/rel4/user/bitn.pcert1
-
-rtl/rel4/user/bits-trunc.pcert0 : no_pcert = 0
-rtl/rel4/user/bits-trunc.pcert0 : acl2x = 0
-rtl/rel4/user/bits-trunc.pcert0 : \
-     rtl/rel4/user/land.pcert0 \
-     rtl/rel4/support/bits-trunc.pcert0 \
-     rtl/rel4/user/bits-trunc.lisp
-rtl/rel4/user/bits-trunc.pcert1 : acl2x = 0
-rtl/rel4/user/bits-trunc.pcert1 : no_pcert = 0
-rtl/rel4/user/bits-trunc.pcert1 : rtl/rel4/user/bits-trunc.pcert0
-rtl/rel4/user/bits-trunc.cert : | rtl/rel4/user/bits-trunc.pcert1
-
-rtl/rel4/user/bits.pcert0 : no_pcert = 0
-rtl/rel4/user/bits.pcert0 : acl2x = 0
-rtl/rel4/user/bits.pcert0 : \
-     rtl/rel4/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel4/arithmetic/power2p.pcert0 \
-     rtl/rel4/support/bits.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/bits.lisp
-rtl/rel4/user/bits.pcert1 : acl2x = 0
-rtl/rel4/user/bits.pcert1 : no_pcert = 0
-rtl/rel4/user/bits.pcert1 : rtl/rel4/user/bits.pcert0
-rtl/rel4/user/bits.cert : | rtl/rel4/user/bits.pcert1
-
-rtl/rel4/user/brat.pcert0 : no_pcert = 0
-rtl/rel4/user/brat.pcert0 : acl2x = 0
-rtl/rel4/user/brat.pcert0 : \
-     rtl/rel4/arithmetic/fl.pcert0 \
-     rtl/rel4/user/brat.lisp
-rtl/rel4/user/brat.pcert1 : acl2x = 0
-rtl/rel4/user/brat.pcert1 : no_pcert = 0
-rtl/rel4/user/brat.pcert1 : rtl/rel4/user/brat.pcert0
-rtl/rel4/user/brat.cert : | rtl/rel4/user/brat.pcert1
-
-rtl/rel4/user/bvecp.pcert0 : no_pcert = 0
-rtl/rel4/user/bvecp.pcert0 : acl2x = 0
-rtl/rel4/user/bvecp.pcert0 : \
-     rtl/rel4/support/bvecp.pcert0 \
-     rtl/rel4/user/bvecp.lisp
-rtl/rel4/user/bvecp.pcert1 : acl2x = 0
-rtl/rel4/user/bvecp.pcert1 : no_pcert = 0
-rtl/rel4/user/bvecp.pcert1 : rtl/rel4/user/bvecp.pcert0
-rtl/rel4/user/bvecp.cert : | rtl/rel4/user/bvecp.pcert1
-
-rtl/rel4/user/cat.pcert0 : no_pcert = 0
-rtl/rel4/user/cat.pcert0 : acl2x = 0
-rtl/rel4/user/cat.pcert0 : \
-     rtl/rel4/support/cat.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/cat.lisp
-rtl/rel4/user/cat.pcert1 : acl2x = 0
-rtl/rel4/user/cat.pcert1 : no_pcert = 0
-rtl/rel4/user/cat.pcert1 : rtl/rel4/user/cat.pcert0
-rtl/rel4/user/cat.cert : | rtl/rel4/user/cat.pcert1
-
-rtl/rel4/user/decode.pcert0 : no_pcert = 0
-rtl/rel4/user/decode.pcert0 : acl2x = 0
-rtl/rel4/user/decode.pcert0 : \
-     rtl/rel4/support/decode.pcert0 \
-     rtl/rel4/user/decode.lisp
-rtl/rel4/user/decode.pcert1 : acl2x = 0
-rtl/rel4/user/decode.pcert1 : no_pcert = 0
-rtl/rel4/user/decode.pcert1 : rtl/rel4/user/decode.pcert0
-rtl/rel4/user/decode.cert : | rtl/rel4/user/decode.pcert1
-
-rtl/rel4/user/ereps.pcert0 : no_pcert = 0
-rtl/rel4/user/ereps.pcert0 : acl2x = 0
-rtl/rel4/user/ereps.pcert0 : \
-     rtl/rel4/support/ereps.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/ereps.lisp
-rtl/rel4/user/ereps.pcert1 : acl2x = 0
-rtl/rel4/user/ereps.pcert1 : no_pcert = 0
-rtl/rel4/user/ereps.pcert1 : rtl/rel4/user/ereps.pcert0
-rtl/rel4/user/ereps.cert : | rtl/rel4/user/ereps.pcert1
-
-rtl/rel4/user/land.pcert0 : no_pcert = 0
-rtl/rel4/user/land.pcert0 : acl2x = 0
-rtl/rel4/user/land.pcert0 : \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/support/land.pcert0 \
-     rtl/rel4/user/land.lisp
-rtl/rel4/user/land.pcert1 : acl2x = 0
-rtl/rel4/user/land.pcert1 : no_pcert = 0
-rtl/rel4/user/land.pcert1 : rtl/rel4/user/land.pcert0
-rtl/rel4/user/land.cert : | rtl/rel4/user/land.pcert1
-
-rtl/rel4/user/lextra.pcert0 : no_pcert = 0
-rtl/rel4/user/lextra.pcert0 : acl2x = 0
-rtl/rel4/user/lextra.pcert0 : \
-     rtl/rel4/user/land.pcert0 \
-     rtl/rel4/user/lior.pcert0 \
-     rtl/rel4/user/lxor.pcert0 \
-     rtl/rel4/support/lextra.pcert0 \
-     rtl/rel4/user/lextra.lisp
-rtl/rel4/user/lextra.pcert1 : acl2x = 0
-rtl/rel4/user/lextra.pcert1 : no_pcert = 0
-rtl/rel4/user/lextra.pcert1 : rtl/rel4/user/lextra.pcert0
-rtl/rel4/user/lextra.cert : | rtl/rel4/user/lextra.pcert1
-
-rtl/rel4/user/lior.pcert0 : no_pcert = 0
-rtl/rel4/user/lior.pcert0 : acl2x = 0
-rtl/rel4/user/lior.pcert0 : \
-     rtl/rel4/support/lior.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/lior.lisp
-rtl/rel4/user/lior.pcert1 : acl2x = 0
-rtl/rel4/user/lior.pcert1 : no_pcert = 0
-rtl/rel4/user/lior.pcert1 : rtl/rel4/user/lior.pcert0
-rtl/rel4/user/lior.cert : | rtl/rel4/user/lior.pcert1
-
-rtl/rel4/user/lnot.pcert0 : no_pcert = 0
-rtl/rel4/user/lnot.pcert0 : acl2x = 0
-rtl/rel4/user/lnot.pcert0 : \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/support/lnot.pcert0 \
-     rtl/rel4/user/lnot.lisp
-rtl/rel4/user/lnot.pcert1 : acl2x = 0
-rtl/rel4/user/lnot.pcert1 : no_pcert = 0
-rtl/rel4/user/lnot.pcert1 : rtl/rel4/user/lnot.pcert0
-rtl/rel4/user/lnot.cert : | rtl/rel4/user/lnot.pcert1
-
-rtl/rel4/user/logior1.pcert0 : no_pcert = 0
-rtl/rel4/user/logior1.pcert0 : acl2x = 0
-rtl/rel4/user/logior1.pcert0 : \
-     rtl/rel4/support/logior1.pcert0 \
-     rtl/rel4/user/logior1.lisp
-rtl/rel4/user/logior1.pcert1 : acl2x = 0
-rtl/rel4/user/logior1.pcert1 : no_pcert = 0
-rtl/rel4/user/logior1.pcert1 : rtl/rel4/user/logior1.pcert0
-rtl/rel4/user/logior1.cert : | rtl/rel4/user/logior1.pcert1
-
-rtl/rel4/user/lxor.pcert0 : no_pcert = 0
-rtl/rel4/user/lxor.pcert0 : acl2x = 0
-rtl/rel4/user/lxor.pcert0 : \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/support/lxor.pcert0 \
-     rtl/rel4/user/lxor.lisp
-rtl/rel4/user/lxor.pcert1 : acl2x = 0
-rtl/rel4/user/lxor.pcert1 : no_pcert = 0
-rtl/rel4/user/lxor.pcert1 : rtl/rel4/user/lxor.pcert0
-rtl/rel4/user/lxor.cert : | rtl/rel4/user/lxor.pcert1
-
-rtl/rel4/user/mulcat.pcert0 : no_pcert = 0
-rtl/rel4/user/mulcat.pcert0 : acl2x = 0
-rtl/rel4/user/mulcat.pcert0 : \
-     rtl/rel4/support/mulcat.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/mulcat.lisp
-rtl/rel4/user/mulcat.pcert1 : acl2x = 0
-rtl/rel4/user/mulcat.pcert1 : no_pcert = 0
-rtl/rel4/user/mulcat.pcert1 : rtl/rel4/user/mulcat.pcert0
-rtl/rel4/user/mulcat.cert : | rtl/rel4/user/mulcat.pcert1
-
-rtl/rel4/user/near.pcert0 : no_pcert = 0
-rtl/rel4/user/near.pcert0 : acl2x = 0
-rtl/rel4/user/near.pcert0 : \
-     rtl/rel4/support/near.pcert0 \
-     rtl/rel4/user/near.lisp
-rtl/rel4/user/near.pcert1 : acl2x = 0
-rtl/rel4/user/near.pcert1 : no_pcert = 0
-rtl/rel4/user/near.pcert1 : rtl/rel4/user/near.pcert0
-rtl/rel4/user/near.cert : | rtl/rel4/user/near.pcert1
-
-rtl/rel4/user/setbitn.pcert0 : no_pcert = 0
-rtl/rel4/user/setbitn.pcert0 : acl2x = 0
-rtl/rel4/user/setbitn.pcert0 : \
-     rtl/rel4/support/setbitn.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/setbitn.lisp
-rtl/rel4/user/setbitn.pcert1 : acl2x = 0
-rtl/rel4/user/setbitn.pcert1 : no_pcert = 0
-rtl/rel4/user/setbitn.pcert1 : rtl/rel4/user/setbitn.pcert0
-rtl/rel4/user/setbitn.cert : | rtl/rel4/user/setbitn.pcert1
-
-rtl/rel4/user/setbits.pcert0 : no_pcert = 0
-rtl/rel4/user/setbits.pcert0 : acl2x = 0
-rtl/rel4/user/setbits.pcert0 : \
-     rtl/rel4/support/setbits.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/setbits.lisp
-rtl/rel4/user/setbits.pcert1 : acl2x = 0
-rtl/rel4/user/setbits.pcert1 : no_pcert = 0
-rtl/rel4/user/setbits.pcert1 : rtl/rel4/user/setbits.pcert0
-rtl/rel4/user/setbits.cert : | rtl/rel4/user/setbits.pcert1
-
-rtl/rel4/user/stick.pcert0 : no_pcert = 0
-rtl/rel4/user/stick.pcert0 : acl2x = 0
-rtl/rel4/user/stick.pcert0 : \
-     rtl/rel4/user/land.pcert0 \
-     rtl/rel4/user/lior.pcert0 \
-     rtl/rel4/user/lxor.pcert0 \
-     rtl/rel4/user/lnot.pcert0 \
-     rtl/rel4/support/stick.pcert0 \
-     rtl/rel4/user/stick.lisp
-rtl/rel4/user/stick.pcert1 : acl2x = 0
-rtl/rel4/user/stick.pcert1 : no_pcert = 0
-rtl/rel4/user/stick.pcert1 : rtl/rel4/user/stick.pcert0
-rtl/rel4/user/stick.cert : | rtl/rel4/user/stick.pcert1
-
-rtl/rel4/user/sumbits.pcert0 : no_pcert = 0
-rtl/rel4/user/sumbits.pcert0 : acl2x = 0
-rtl/rel4/user/sumbits.pcert0 : \
-     rtl/rel4/support/sumbits.pcert0 \
-     rtl/rel4/support/guards.pcert0 \
-     rtl/rel4/user/sumbits.lisp
-rtl/rel4/user/sumbits.pcert1 : acl2x = 0
-rtl/rel4/user/sumbits.pcert1 : no_pcert = 0
-rtl/rel4/user/sumbits.pcert1 : rtl/rel4/user/sumbits.pcert0
-rtl/rel4/user/sumbits.cert : | rtl/rel4/user/sumbits.pcert1
-
-rtl/rel4/user/top.pcert0 : no_pcert = 0
-rtl/rel4/user/top.pcert0 : acl2x = 0
-rtl/rel4/user/top.pcert0 : \
-     rtl/rel4/user/bits.pcert0 \
-     rtl/rel4/user/bitn.pcert0 \
-     rtl/rel4/user/cat.pcert0 \
-     rtl/rel4/user/bvecp.pcert0 \
-     rtl/rel4/user/mulcat.pcert0 \
-     rtl/rel4/user/logior1.pcert0 \
-     rtl/rel4/user/setbits.pcert0 \
-     rtl/rel4/user/setbitn.pcert0 \
-     rtl/rel4/user/bias.pcert0 \
-     rtl/rel4/user/ereps.pcert0 \
-     rtl/rel4/user/lnot.pcert0 \
-     rtl/rel4/user/land.pcert0 \
-     rtl/rel4/user/lior.pcert0 \
-     rtl/rel4/user/lxor.pcert0 \
-     rtl/rel4/user/lextra.pcert0 \
-     rtl/rel4/user/trunc.pcert0 \
-     rtl/rel4/user/away.pcert0 \
-     rtl/rel4/user/near.pcert0 \
-     rtl/rel4/user/bits-trunc.pcert0 \
-     rtl/rel4/user/stick.pcert0 \
-     rtl/rel4/user/sumbits.pcert0 \
-     rtl/rel4/user/top.lisp
-rtl/rel4/user/top.pcert1 : acl2x = 0
-rtl/rel4/user/top.pcert1 : no_pcert = 0
-rtl/rel4/user/top.pcert1 : rtl/rel4/user/top.pcert0
-rtl/rel4/user/top.cert : | rtl/rel4/user/top.pcert1
-
-rtl/rel4/user/trunc.pcert0 : no_pcert = 0
-rtl/rel4/user/trunc.pcert0 : acl2x = 0
-rtl/rel4/user/trunc.pcert0 : \
-     rtl/rel4/support/trunc.pcert0 \
-     rtl/rel4/user/trunc.lisp
-rtl/rel4/user/trunc.pcert1 : acl2x = 0
-rtl/rel4/user/trunc.pcert1 : no_pcert = 0
-rtl/rel4/user/trunc.pcert1 : rtl/rel4/user/trunc.pcert0
-rtl/rel4/user/trunc.cert : | rtl/rel4/user/trunc.pcert1
-
-rtl/rel5/arithmetic/arith.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/arith.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/arith.pcert0 : \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     rtl/rel5/arithmetic/arith.lisp
-rtl/rel5/arithmetic/arith.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/arith.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/arith.pcert1 : rtl/rel5/arithmetic/arith.pcert0
-rtl/rel5/arithmetic/arith.cert : | rtl/rel5/arithmetic/arith.pcert1
-
-rtl/rel5/arithmetic/arith2.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/arith2.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/arith2.pcert0 : \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/product.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel5/arithmetic/inverted-factor.pcert0 \
-     rtl/rel5/arithmetic/arith2.lisp
-rtl/rel5/arithmetic/arith2.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/arith2.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/arith2.pcert1 : rtl/rel5/arithmetic/arith2.pcert0
-rtl/rel5/arithmetic/arith2.cert : | rtl/rel5/arithmetic/arith2.pcert1
-
-rtl/rel5/arithmetic/basic.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/basic.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/basic.pcert0 : \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/even-odd.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/arithmetic/basic.lisp
-rtl/rel5/arithmetic/basic.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/basic.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/basic.pcert1 : rtl/rel5/arithmetic/basic.pcert0
-rtl/rel5/arithmetic/basic.cert : | rtl/rel5/arithmetic/basic.pcert1
-
-rtl/rel5/arithmetic/cg.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/cg.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/cg.pcert0 : \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/common-factor.pcert0 \
-     rtl/rel5/arithmetic/cg.lisp
-rtl/rel5/arithmetic/cg.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/cg.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/cg.pcert1 : rtl/rel5/arithmetic/cg.pcert0
-rtl/rel5/arithmetic/cg.cert : | rtl/rel5/arithmetic/cg.pcert1
-
-rtl/rel5/arithmetic/common-factor-defuns.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/common-factor-defuns.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/common-factor-defuns.pcert0 : \
-     rtl/rel5/arithmetic/inverted-factor.pcert0 \
-     rtl/rel5/arithmetic/common-factor-defuns.lisp
-rtl/rel5/arithmetic/common-factor-defuns.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/common-factor-defuns.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/common-factor-defuns.pcert1 : rtl/rel5/arithmetic/common-factor-defuns.pcert0
-rtl/rel5/arithmetic/common-factor-defuns.cert : | rtl/rel5/arithmetic/common-factor-defuns.pcert1
-
-rtl/rel5/arithmetic/common-factor.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/common-factor.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/common-factor.pcert0 : \
-     meta/meta-times-equal.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel5/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/product.pcert0 \
-     rtl/rel5/arithmetic/common-factor.lisp
-rtl/rel5/arithmetic/common-factor.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/common-factor.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/common-factor.pcert1 : rtl/rel5/arithmetic/common-factor.pcert0
-rtl/rel5/arithmetic/common-factor.cert : | rtl/rel5/arithmetic/common-factor.pcert1
-
-rtl/rel5/arithmetic/complex-rationalp.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/complex-rationalp.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/complex-rationalp.pcert0 : \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/complex-rationalp.lisp
-rtl/rel5/arithmetic/complex-rationalp.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/complex-rationalp.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/complex-rationalp.pcert1 : rtl/rel5/arithmetic/complex-rationalp.pcert0
-rtl/rel5/arithmetic/complex-rationalp.cert : | rtl/rel5/arithmetic/complex-rationalp.pcert1
-
-rtl/rel5/arithmetic/denominator.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/denominator.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/denominator.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     arithmetic/mod-gcd.pcert0 \
-     rtl/rel5/arithmetic/denominator.lisp
-rtl/rel5/arithmetic/denominator.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/denominator.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/denominator.pcert1 : rtl/rel5/arithmetic/denominator.pcert0
-rtl/rel5/arithmetic/denominator.cert : | rtl/rel5/arithmetic/denominator.pcert1
-
-rtl/rel5/arithmetic/even-odd.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/even-odd.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/even-odd.pcert0 : \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/even-odd.lisp
-rtl/rel5/arithmetic/even-odd.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/even-odd.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/even-odd.pcert1 : rtl/rel5/arithmetic/even-odd.pcert0
-rtl/rel5/arithmetic/even-odd.cert : | rtl/rel5/arithmetic/even-odd.pcert1
-
-rtl/rel5/arithmetic/even-odd2-proofs.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/even-odd2-proofs.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/even-odd2-proofs.pcert0 : \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/arith.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/even-odd2-proofs.lisp
-rtl/rel5/arithmetic/even-odd2-proofs.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/even-odd2-proofs.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/even-odd2-proofs.pcert1 : rtl/rel5/arithmetic/even-odd2-proofs.pcert0
-rtl/rel5/arithmetic/even-odd2-proofs.cert : | rtl/rel5/arithmetic/even-odd2-proofs.pcert1
-
-rtl/rel5/arithmetic/even-odd2.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/even-odd2.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/even-odd2.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/even-odd2-proofs.pcert0 \
-     rtl/rel5/arithmetic/even-odd2.lisp
-rtl/rel5/arithmetic/even-odd2.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/even-odd2.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/even-odd2.pcert1 : rtl/rel5/arithmetic/even-odd2.pcert0
-rtl/rel5/arithmetic/even-odd2.cert : | rtl/rel5/arithmetic/even-odd2.pcert1
-
-rtl/rel5/arithmetic/expo-proofs.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/expo-proofs.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/expo-proofs.pcert0 : \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel5/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel5/arithmetic/common-factor.pcert0 \
-     rtl/rel5/arithmetic/expo-proofs.lisp
-rtl/rel5/arithmetic/expo-proofs.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/expo-proofs.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/expo-proofs.pcert1 : rtl/rel5/arithmetic/expo-proofs.pcert0
-rtl/rel5/arithmetic/expo-proofs.cert : | rtl/rel5/arithmetic/expo-proofs.pcert1
-
-rtl/rel5/arithmetic/expo.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/expo.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/expo.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/expo-proofs.pcert0 \
-     rtl/rel5/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel5/arithmetic/expo.lisp
-rtl/rel5/arithmetic/expo.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/expo.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/expo.pcert1 : rtl/rel5/arithmetic/expo.pcert0
-rtl/rel5/arithmetic/expo.cert : | rtl/rel5/arithmetic/expo.pcert1
-
-rtl/rel5/arithmetic/expt-proofs.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/expt-proofs.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/expt-proofs.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/numerator.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     arithmetic/top.pcert0 \
-     rtl/rel5/arithmetic/even-odd.pcert0 \
-     rtl/rel5/arithmetic/expt-proofs.lisp
-rtl/rel5/arithmetic/expt-proofs.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/expt-proofs.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/expt-proofs.pcert1 : rtl/rel5/arithmetic/expt-proofs.pcert0
-rtl/rel5/arithmetic/expt-proofs.cert : | rtl/rel5/arithmetic/expt-proofs.pcert1
-
-rtl/rel5/arithmetic/expt.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/expt.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/expt.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/expt-proofs.pcert0 \
-     rtl/rel5/arithmetic/expt.lisp
-rtl/rel5/arithmetic/expt.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/expt.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/expt.pcert1 : rtl/rel5/arithmetic/expt.pcert0
-rtl/rel5/arithmetic/expt.cert : | rtl/rel5/arithmetic/expt.pcert1
-
-rtl/rel5/arithmetic/extra-rules.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/extra-rules.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/extra-rules.pcert0 : \
-     rtl/rel5/arithmetic/basic.pcert0 \
-     rtl/rel5/arithmetic/extra-rules.lisp
-rtl/rel5/arithmetic/extra-rules.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/extra-rules.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/extra-rules.pcert1 : rtl/rel5/arithmetic/extra-rules.pcert0
-rtl/rel5/arithmetic/extra-rules.cert : | rtl/rel5/arithmetic/extra-rules.pcert1
-
-rtl/rel5/arithmetic/fl-expt.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/fl-expt.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/fl-expt.pcert0 : \
-     rtl/rel5/arithmetic/numerator.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/nniq.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/floor.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/rationalp.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/arithmetic/expo.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/fl-expt.lisp
-rtl/rel5/arithmetic/fl-expt.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/fl-expt.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/fl-expt.pcert1 : rtl/rel5/arithmetic/fl-expt.pcert0
-rtl/rel5/arithmetic/fl-expt.cert : | rtl/rel5/arithmetic/fl-expt.pcert1
-
-rtl/rel5/arithmetic/fl-hacks.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/fl-hacks.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/fl-hacks.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/inverted-factor.pcert0 \
-     rtl/rel5/arithmetic/nniq.pcert0 \
-     rtl/rel5/arithmetic/numerator.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/product.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     rtl/rel5/arithmetic/rationalp.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/mod.pcert0 \
-     rtl/rel5/arithmetic/even-odd.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     rtl/rel5/arithmetic/arith.pcert0 \
-     rtl/rel5/arithmetic/fl-hacks.lisp
-rtl/rel5/arithmetic/fl-hacks.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/fl-hacks.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/fl-hacks.pcert1 : rtl/rel5/arithmetic/fl-hacks.pcert0
-rtl/rel5/arithmetic/fl-hacks.cert : | rtl/rel5/arithmetic/fl-hacks.pcert1
-
-rtl/rel5/arithmetic/fl-proofs.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/fl-proofs.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/fl-proofs.pcert0 : \
-     rtl/rel5/arithmetic/numerator.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/nniq.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/floor.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/rationalp.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     rtl/rel5/arithmetic/common-factor.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/fl-proofs.lisp
-rtl/rel5/arithmetic/fl-proofs.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/fl-proofs.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/fl-proofs.pcert1 : rtl/rel5/arithmetic/fl-proofs.pcert0
-rtl/rel5/arithmetic/fl-proofs.cert : | rtl/rel5/arithmetic/fl-proofs.pcert1
-
-rtl/rel5/arithmetic/fl.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/fl.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/fl.pcert0 : \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/fl-proofs.pcert0 \
-     rtl/rel5/arithmetic/fl.lisp
-rtl/rel5/arithmetic/fl.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/fl.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/fl.pcert1 : rtl/rel5/arithmetic/fl.pcert0
-rtl/rel5/arithmetic/fl.cert : | rtl/rel5/arithmetic/fl.pcert1
-
-rtl/rel5/arithmetic/floor-proofs.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/floor-proofs.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/floor-proofs.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/numerator.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/nniq.pcert0 \
-     rtl/rel5/arithmetic/product.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     rtl/rel5/arithmetic/rationalp.pcert0 \
-     rtl/rel5/arithmetic/inverted-factor.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel5/arithmetic/floor-proofs.lisp
-rtl/rel5/arithmetic/floor-proofs.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/floor-proofs.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/floor-proofs.pcert1 : rtl/rel5/arithmetic/floor-proofs.pcert0
-rtl/rel5/arithmetic/floor-proofs.cert : | rtl/rel5/arithmetic/floor-proofs.pcert1
-
-rtl/rel5/arithmetic/floor.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/floor.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/floor.pcert0 : \
-     rtl/rel5/arithmetic/floor-proofs.pcert0 \
-     rtl/rel5/arithmetic/floor.lisp
-rtl/rel5/arithmetic/floor.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/floor.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/floor.pcert1 : rtl/rel5/arithmetic/floor.pcert0
-rtl/rel5/arithmetic/floor.cert : | rtl/rel5/arithmetic/floor.pcert1
-
-rtl/rel5/arithmetic/fp.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/fp.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/fp.pcert0 : \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/fp.lisp
-rtl/rel5/arithmetic/fp.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/fp.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/fp.pcert1 : rtl/rel5/arithmetic/fp.pcert0
-rtl/rel5/arithmetic/fp.cert : | rtl/rel5/arithmetic/fp.pcert1
-
-rtl/rel5/arithmetic/fp2.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/fp2.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/fp2.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     arithmetic-2/meta/non-linear.pcert0 \
-     rtl/rel5/arithmetic/inverted-factor.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel5/arithmetic/fp2.lisp
-rtl/rel5/arithmetic/fp2.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/fp2.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/fp2.pcert1 : rtl/rel5/arithmetic/fp2.pcert0
-rtl/rel5/arithmetic/fp2.cert : | rtl/rel5/arithmetic/fp2.pcert1
-
-rtl/rel5/arithmetic/ground-zero.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/ground-zero.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/ground-zero.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.lisp
-rtl/rel5/arithmetic/ground-zero.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/ground-zero.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/ground-zero.pcert1 : rtl/rel5/arithmetic/ground-zero.pcert0
-rtl/rel5/arithmetic/ground-zero.cert : | rtl/rel5/arithmetic/ground-zero.pcert1
-
-rtl/rel5/arithmetic/hacks.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/hacks.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/hacks.pcert0 : \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/hacks.lisp
-rtl/rel5/arithmetic/hacks.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/hacks.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/hacks.pcert1 : rtl/rel5/arithmetic/hacks.pcert0
-rtl/rel5/arithmetic/hacks.cert : | rtl/rel5/arithmetic/hacks.pcert1
-
-rtl/rel5/arithmetic/induct.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/induct.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/induct.pcert0 : \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/induct.lisp
-rtl/rel5/arithmetic/induct.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/induct.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/induct.pcert1 : rtl/rel5/arithmetic/induct.pcert0
-rtl/rel5/arithmetic/induct.cert : | rtl/rel5/arithmetic/induct.pcert1
-
-rtl/rel5/arithmetic/integerp.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/integerp.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/integerp.pcert0 : \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/integerp.lisp
-rtl/rel5/arithmetic/integerp.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/integerp.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/integerp.pcert1 : rtl/rel5/arithmetic/integerp.pcert0
-rtl/rel5/arithmetic/integerp.cert : | rtl/rel5/arithmetic/integerp.pcert1
-
-rtl/rel5/arithmetic/inverted-factor.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/inverted-factor.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/inverted-factor.pcert0 : \
-     rtl/rel5/arithmetic/inverted-factor.lisp
-rtl/rel5/arithmetic/inverted-factor.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/inverted-factor.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/inverted-factor.pcert1 : rtl/rel5/arithmetic/inverted-factor.pcert0
-rtl/rel5/arithmetic/inverted-factor.cert : | rtl/rel5/arithmetic/inverted-factor.pcert1
-
-rtl/rel5/arithmetic/mod-expt.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/mod-expt.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/mod-expt.pcert0 : \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/numerator.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/nniq.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/floor.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/rationalp.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/arithmetic/expo.pcert0 \
-     rtl/rel5/arithmetic/fl-expt.pcert0 \
-     rtl/rel5/arithmetic/mod.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/mod-expt.lisp
-rtl/rel5/arithmetic/mod-expt.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/mod-expt.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/mod-expt.pcert1 : rtl/rel5/arithmetic/mod-expt.pcert0
-rtl/rel5/arithmetic/mod-expt.cert : | rtl/rel5/arithmetic/mod-expt.pcert1
-
-rtl/rel5/arithmetic/mod-proofs.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/mod-proofs.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/mod-proofs.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/floor.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/arith.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/product.pcert0 \
-     rtl/rel5/arithmetic/complex-rationalp.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/rationalp.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/mod-proofs.lisp
-rtl/rel5/arithmetic/mod-proofs.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/mod-proofs.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/mod-proofs.pcert1 : rtl/rel5/arithmetic/mod-proofs.pcert0
-rtl/rel5/arithmetic/mod-proofs.cert : | rtl/rel5/arithmetic/mod-proofs.pcert1
-
-rtl/rel5/arithmetic/mod.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/mod.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/mod.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/mod-proofs.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/mod.lisp
-rtl/rel5/arithmetic/mod.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/mod.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/mod.pcert1 : rtl/rel5/arithmetic/mod.pcert0
-rtl/rel5/arithmetic/mod.cert : | rtl/rel5/arithmetic/mod.pcert1
-
-rtl/rel5/arithmetic/negative-syntaxp.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/negative-syntaxp.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/negative-syntaxp.pcert0 : \
-     rtl/rel5/arithmetic/negative-syntaxp.lisp
-rtl/rel5/arithmetic/negative-syntaxp.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/negative-syntaxp.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/negative-syntaxp.pcert1 : rtl/rel5/arithmetic/negative-syntaxp.pcert0
-rtl/rel5/arithmetic/negative-syntaxp.cert : | rtl/rel5/arithmetic/negative-syntaxp.pcert1
-
-rtl/rel5/arithmetic/nniq.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/nniq.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/nniq.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/numerator.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     rtl/rel5/arithmetic/product.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/arith.pcert0 \
-     arithmetic/rationals.pcert0 \
-     arithmetic/idiv.pcert0 \
-     arithmetic/idiv.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     rtl/rel5/arithmetic/nniq.lisp
-rtl/rel5/arithmetic/nniq.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/nniq.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/nniq.pcert1 : rtl/rel5/arithmetic/nniq.pcert0
-rtl/rel5/arithmetic/nniq.cert : | rtl/rel5/arithmetic/nniq.pcert1
-
-rtl/rel5/arithmetic/numerator.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/numerator.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/numerator.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/numerator.lisp
-rtl/rel5/arithmetic/numerator.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/numerator.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/numerator.pcert1 : rtl/rel5/arithmetic/numerator.pcert0
-rtl/rel5/arithmetic/numerator.cert : | rtl/rel5/arithmetic/numerator.pcert1
-
-rtl/rel5/arithmetic/power2p.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/power2p.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/power2p.pcert0 : \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel5/arithmetic/power2p.lisp
-rtl/rel5/arithmetic/power2p.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/power2p.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/power2p.pcert1 : rtl/rel5/arithmetic/power2p.pcert0
-rtl/rel5/arithmetic/power2p.cert : | rtl/rel5/arithmetic/power2p.pcert1
-
-rtl/rel5/arithmetic/predicate.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/predicate.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/predicate.pcert0 : \
-     rtl/rel5/arithmetic/predicate.lisp
-rtl/rel5/arithmetic/predicate.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/predicate.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/predicate.pcert1 : rtl/rel5/arithmetic/predicate.pcert0
-rtl/rel5/arithmetic/predicate.cert : | rtl/rel5/arithmetic/predicate.pcert1
-
-rtl/rel5/arithmetic/product-proofs.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/product-proofs.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/product-proofs.pcert0 : \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/product-proofs.lisp
-rtl/rel5/arithmetic/product-proofs.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/product-proofs.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/product-proofs.pcert1 : rtl/rel5/arithmetic/product-proofs.pcert0
-rtl/rel5/arithmetic/product-proofs.cert : | rtl/rel5/arithmetic/product-proofs.pcert1
-
-rtl/rel5/arithmetic/product.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/product.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/product.pcert0 : \
-     rtl/rel5/arithmetic/product-proofs.pcert0 \
-     rtl/rel5/arithmetic/product.lisp
-rtl/rel5/arithmetic/product.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/product.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/product.pcert1 : rtl/rel5/arithmetic/product.pcert0
-rtl/rel5/arithmetic/product.cert : | rtl/rel5/arithmetic/product.pcert1
-
-rtl/rel5/arithmetic/rationalp.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/rationalp.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/rationalp.pcert0 : \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/rationalp.lisp
-rtl/rel5/arithmetic/rationalp.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/rationalp.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/rationalp.pcert1 : rtl/rel5/arithmetic/rationalp.pcert0
-rtl/rel5/arithmetic/rationalp.cert : | rtl/rel5/arithmetic/rationalp.pcert1
-
-rtl/rel5/arithmetic/top.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/top.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/top.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/induct.pcert0 \
-     rtl/rel5/arithmetic/denominator.pcert0 \
-     rtl/rel5/arithmetic/numerator.pcert0 \
-     rtl/rel5/arithmetic/nniq.pcert0 \
-     rtl/rel5/arithmetic/complex-rationalp.pcert0 \
-     rtl/rel5/arithmetic/rationalp.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/arithmetic/arith.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/basic.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.pcert0 \
-     rtl/rel5/arithmetic/product.pcert0 \
-     rtl/rel5/arithmetic/inverted-factor.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/x-2xx.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/arithmetic/expo.pcert0 \
-     rtl/rel5/arithmetic/fl-hacks.pcert0 \
-     rtl/rel5/arithmetic/even-odd2.pcert0 \
-     rtl/rel5/arithmetic/even-odd.pcert0 \
-     rtl/rel5/arithmetic/floor.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/cg.pcert0 \
-     rtl/rel5/arithmetic/mod.pcert0 \
-     rtl/rel5/arithmetic/fl-expt.pcert0 \
-     rtl/rel5/arithmetic/mod-expt.pcert0 \
-     rtl/rel5/arithmetic/common-factor.pcert0 \
-     rtl/rel5/arithmetic/top.lisp
-rtl/rel5/arithmetic/top.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/top.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/top.pcert1 : rtl/rel5/arithmetic/top.pcert0
-rtl/rel5/arithmetic/top.cert : | rtl/rel5/arithmetic/top.pcert1
-
-rtl/rel5/arithmetic/unary-divide.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/unary-divide.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/unary-divide.pcert0 : \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/inverted-factor.pcert0 \
-     rtl/rel5/arithmetic/unary-divide.lisp
-rtl/rel5/arithmetic/unary-divide.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/unary-divide.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/unary-divide.pcert1 : rtl/rel5/arithmetic/unary-divide.pcert0
-rtl/rel5/arithmetic/unary-divide.cert : | rtl/rel5/arithmetic/unary-divide.pcert1
-
-rtl/rel5/arithmetic/x-2xx.pcert0 : no_pcert = 0
-rtl/rel5/arithmetic/x-2xx.pcert0 : acl2x = 0
-rtl/rel5/arithmetic/x-2xx.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/mod-gcd.pcert0 \
-     rtl/rel5/arithmetic/x-2xx.lisp
-rtl/rel5/arithmetic/x-2xx.pcert1 : acl2x = 0
-rtl/rel5/arithmetic/x-2xx.pcert1 : no_pcert = 0
-rtl/rel5/arithmetic/x-2xx.pcert1 : rtl/rel5/arithmetic/x-2xx.pcert0
-rtl/rel5/arithmetic/x-2xx.cert : | rtl/rel5/arithmetic/x-2xx.pcert1
-
-rtl/rel5/lib/add.pcert0 : no_pcert = 0
-rtl/rel5/lib/add.pcert0 : acl2x = 0
-rtl/rel5/lib/add.pcert0 : \
-     rtl/rel5/support/top.pcert0 \
-     rtl/rel5/lib/round.pcert0 \
-     rtl/rel5/lib/add.lisp
-rtl/rel5/lib/add.pcert1 : acl2x = 0
-rtl/rel5/lib/add.pcert1 : no_pcert = 0
-rtl/rel5/lib/add.pcert1 : rtl/rel5/lib/add.pcert0
-rtl/rel5/lib/add.cert : | rtl/rel5/lib/add.pcert1
-
-rtl/rel5/lib/arith.pcert0 : no_pcert = 0
-rtl/rel5/lib/arith.pcert0 : acl2x = 0
-rtl/rel5/lib/arith.pcert0 : \
-     rtl/rel5/arithmetic/fp.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/arithmetic/expo.pcert0 \
-     rtl/rel5/arithmetic/extra-rules.pcert0 \
-     rtl/rel5/support/ash.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel5/lib/arith.lisp
-rtl/rel5/lib/arith.pcert1 : acl2x = 0
-rtl/rel5/lib/arith.pcert1 : no_pcert = 0
-rtl/rel5/lib/arith.pcert1 : rtl/rel5/lib/arith.pcert0
-rtl/rel5/lib/arith.cert : | rtl/rel5/lib/arith.pcert1
-
-rtl/rel5/lib/basic.pcert0 : no_pcert = 0
-rtl/rel5/lib/basic.pcert0 : acl2x = 0
-rtl/rel5/lib/basic.pcert0 : \
-     rtl/rel5/support/top.pcert0 \
-     rtl/rel5/lib/basic.lisp
-rtl/rel5/lib/basic.pcert1 : acl2x = 0
-rtl/rel5/lib/basic.pcert1 : no_pcert = 0
-rtl/rel5/lib/basic.pcert1 : rtl/rel5/lib/basic.pcert0
-rtl/rel5/lib/basic.cert : | rtl/rel5/lib/basic.pcert1
-
-rtl/rel5/lib/bits.pcert0 : no_pcert = 0
-rtl/rel5/lib/bits.pcert0 : acl2x = 0
-rtl/rel5/lib/bits.pcert0 : \
-     rtl/rel5/lib/basic.pcert0 \
-     rtl/rel5/support/top.pcert0 \
-     rtl/rel5/lib/bits.lisp
-rtl/rel5/lib/bits.pcert1 : acl2x = 0
-rtl/rel5/lib/bits.pcert1 : no_pcert = 0
-rtl/rel5/lib/bits.pcert1 : rtl/rel5/lib/bits.pcert0
-rtl/rel5/lib/bits.cert : | rtl/rel5/lib/bits.pcert1
-
-rtl/rel5/lib/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel5/lib/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel5/lib/bvecp-helpers.pcert0 : \
-     rtl/rel5/lib/rtl.pcert0 \
-     rtl/rel5/lib/rtlarr.pcert0 \
-     rtl/rel5/support/bvecp-helpers.pcert0 \
-     rtl/rel5/arithmetic/basic.pcert0 \
-     rtl/rel5/lib/bvecp-helpers.lisp
-rtl/rel5/lib/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel5/lib/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel5/lib/bvecp-helpers.pcert1 : rtl/rel5/lib/bvecp-helpers.pcert0
-rtl/rel5/lib/bvecp-helpers.cert : | rtl/rel5/lib/bvecp-helpers.pcert1
-
-rtl/rel5/lib/bvecp-raw-helpers.pcert0 : no_pcert = 0
-rtl/rel5/lib/bvecp-raw-helpers.pcert0 : acl2x = 0
-rtl/rel5/lib/bvecp-raw-helpers.pcert0 : \
-     rtl/rel5/lib/rtl.pcert0 \
-     rtl/rel5/lib/rtlarr.pcert0 \
-     rtl/rel5/support/bvecp-helpers.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/setbits.pcert0 \
-     rtl/rel5/support/setbitn.pcert0 \
-     rtl/rel5/support/logs.pcert0 \
-     rtl/rel5/support/lnot.pcert0 \
-     rtl/rel5/support/shft.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/mulcat.pcert0 \
-     rtl/rel5/support/encode.pcert0 \
-     rtl/rel5/support/decode.pcert0 \
-     rtl/rel5/support/land.pcert0 \
-     rtl/rel5/support/lior.pcert0 \
-     rtl/rel5/support/lxor.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/arithmetic/expo.pcert0 \
-     rtl/rel5/arithmetic/basic.pcert0 \
-     rtl/rel5/lib/bvecp-raw-helpers.lisp
-rtl/rel5/lib/bvecp-raw-helpers.pcert1 : acl2x = 0
-rtl/rel5/lib/bvecp-raw-helpers.pcert1 : no_pcert = 0
-rtl/rel5/lib/bvecp-raw-helpers.pcert1 : rtl/rel5/lib/bvecp-raw-helpers.pcert0
-rtl/rel5/lib/bvecp-raw-helpers.cert : | rtl/rel5/lib/bvecp-raw-helpers.pcert1
-
-rtl/rel5/lib/clocks.pcert0 : no_pcert = 0
-rtl/rel5/lib/clocks.pcert0 : acl2x = 0
-rtl/rel5/lib/clocks.pcert0 : \
-     rtl/rel5/support/clocks.pcert0 \
-     rtl/rel5/lib/clocks.lisp
-rtl/rel5/lib/clocks.pcert1 : acl2x = 0
-rtl/rel5/lib/clocks.pcert1 : no_pcert = 0
-rtl/rel5/lib/clocks.pcert1 : rtl/rel5/lib/clocks.pcert0
-rtl/rel5/lib/clocks.cert : | rtl/rel5/lib/clocks.pcert1
-
-rtl/rel5/lib/float.pcert0 : no_pcert = 0
-rtl/rel5/lib/float.pcert0 : acl2x = 0
-rtl/rel5/lib/float.pcert0 : \
-     rtl/rel5/support/top.pcert0 \
-     rtl/rel5/lib/log.pcert0 \
-     rtl/rel5/lib/float.lisp
-rtl/rel5/lib/float.pcert1 : acl2x = 0
-rtl/rel5/lib/float.pcert1 : no_pcert = 0
-rtl/rel5/lib/float.pcert1 : rtl/rel5/lib/float.pcert0
-rtl/rel5/lib/float.cert : | rtl/rel5/lib/float.pcert1
-
-rtl/rel5/lib/log.pcert0 : no_pcert = 0
-rtl/rel5/lib/log.pcert0 : acl2x = 0
-rtl/rel5/lib/log.pcert0 : \
-     rtl/rel5/lib/bits.pcert0 \
-     rtl/rel5/support/top.pcert0 \
-     rtl/rel5/lib/log.lisp
-rtl/rel5/lib/log.pcert1 : acl2x = 0
-rtl/rel5/lib/log.pcert1 : no_pcert = 0
-rtl/rel5/lib/log.pcert1 : rtl/rel5/lib/log.pcert0
-rtl/rel5/lib/log.cert : | rtl/rel5/lib/log.pcert1
-
-rtl/rel5/lib/openers.pcert0 : no_pcert = 0
-rtl/rel5/lib/openers.pcert0 : acl2x = 0
-rtl/rel5/lib/openers.pcert0 : \
-     rtl/rel5/support/openers.pcert0 \
-     rtl/rel5/lib/openers.lisp
-rtl/rel5/lib/openers.pcert1 : acl2x = 0
-rtl/rel5/lib/openers.pcert1 : no_pcert = 0
-rtl/rel5/lib/openers.pcert1 : rtl/rel5/lib/openers.pcert0
-rtl/rel5/lib/openers.cert : | rtl/rel5/lib/openers.pcert1
-
-rtl/rel5/lib/package-defs.pcert0 : no_pcert = 0
-rtl/rel5/lib/package-defs.pcert0 : acl2x = 0
-rtl/rel5/lib/package-defs.pcert0 : \
-     rtl/rel5/support/package-defs.pcert0 \
-     rtl/rel5/lib/package-defs.lisp
-rtl/rel5/lib/package-defs.pcert1 : acl2x = 0
-rtl/rel5/lib/package-defs.pcert1 : no_pcert = 0
-rtl/rel5/lib/package-defs.pcert1 : rtl/rel5/lib/package-defs.pcert0
-rtl/rel5/lib/package-defs.cert : | rtl/rel5/lib/package-defs.pcert1
-
-rtl/rel5/lib/reps.pcert0 : no_pcert = 0
-rtl/rel5/lib/reps.pcert0 : acl2x = 0
-rtl/rel5/lib/reps.pcert0 : \
-     rtl/rel5/support/ereps.pcert0 \
-     rtl/rel5/support/ireps.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/lib/log.pcert0 \
-     rtl/rel5/lib/float.pcert0 \
-     rtl/rel5/lib/reps.lisp
-rtl/rel5/lib/reps.pcert1 : acl2x = 0
-rtl/rel5/lib/reps.pcert1 : no_pcert = 0
-rtl/rel5/lib/reps.pcert1 : rtl/rel5/lib/reps.pcert0
-rtl/rel5/lib/reps.cert : | rtl/rel5/lib/reps.pcert1
-
-rtl/rel5/lib/rom-helpers.pcert0 : no_pcert = 0
-rtl/rel5/lib/rom-helpers.pcert0 : acl2x = 0
-rtl/rel5/lib/rom-helpers.pcert0 : \
-     rtl/rel5/support/rom-helpers.pcert0 \
-     rtl/rel5/lib/rom-helpers.lisp
-rtl/rel5/lib/rom-helpers.pcert1 : acl2x = 0
-rtl/rel5/lib/rom-helpers.pcert1 : no_pcert = 0
-rtl/rel5/lib/rom-helpers.pcert1 : rtl/rel5/lib/rom-helpers.pcert0
-rtl/rel5/lib/rom-helpers.cert : | rtl/rel5/lib/rom-helpers.pcert1
-
-rtl/rel5/lib/round.pcert0 : no_pcert = 0
-rtl/rel5/lib/round.pcert0 : acl2x = 0
-rtl/rel5/lib/round.pcert0 : \
-     rtl/rel5/support/top.pcert0 \
-     rtl/rel5/lib/reps.pcert0 \
-     rtl/rel5/lib/round.lisp
-rtl/rel5/lib/round.pcert1 : acl2x = 0
-rtl/rel5/lib/round.pcert1 : no_pcert = 0
-rtl/rel5/lib/round.pcert1 : rtl/rel5/lib/round.pcert0
-rtl/rel5/lib/round.cert : | rtl/rel5/lib/round.pcert1
-
-rtl/rel5/lib/rtl.pcert0 : no_pcert = 0
-rtl/rel5/lib/rtl.pcert0 : acl2x = 0
-rtl/rel5/lib/rtl.pcert0 : \
-     rtl/rel5/support/top.pcert0 \
-     rtl/rel5/lib/rtl.lisp
-rtl/rel5/lib/rtl.pcert1 : acl2x = 0
-rtl/rel5/lib/rtl.pcert1 : no_pcert = 0
-rtl/rel5/lib/rtl.pcert1 : rtl/rel5/lib/rtl.pcert0
-rtl/rel5/lib/rtl.cert : | rtl/rel5/lib/rtl.pcert1
-
-rtl/rel5/lib/rtlarr.pcert0 : no_pcert = 0
-rtl/rel5/lib/rtlarr.pcert0 : acl2x = 0
-rtl/rel5/lib/rtlarr.pcert0 : \
-     rtl/rel5/support/rtlarr.pcert0 \
-     rtl/rel5/support/bvecp-helpers.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     misc/total-order.pcert0 \
-     rtl/rel5/lib/rtl.pcert0 \
-     rtl/rel5/lib/rtlarr.lisp
-rtl/rel5/lib/rtlarr.pcert1 : acl2x = 0
-rtl/rel5/lib/rtlarr.pcert1 : no_pcert = 0
-rtl/rel5/lib/rtlarr.pcert1 : rtl/rel5/lib/rtlarr.pcert0
-rtl/rel5/lib/rtlarr.cert : | rtl/rel5/lib/rtlarr.pcert1
-
-rtl/rel5/lib/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel5/lib/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel5/lib/simple-loop-helpers.pcert0 : \
-     rtl/rel5/lib/rtl.pcert0 \
-     rtl/rel5/lib/rtlarr.pcert0 \
-     rtl/rel5/lib/arith.pcert0 \
-     rtl/rel5/lib/log.pcert0 \
-     rtl/rel5/support/simple-loop-helpers.pcert0 \
-     rtl/rel5/lib/simple-loop-helpers.lisp
-rtl/rel5/lib/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel5/lib/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel5/lib/simple-loop-helpers.pcert1 : rtl/rel5/lib/simple-loop-helpers.pcert0
-rtl/rel5/lib/simple-loop-helpers.cert : | rtl/rel5/lib/simple-loop-helpers.pcert1
-
-rtl/rel5/lib/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel5/lib/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel5/lib/simplify-model-helpers.pcert0 : \
-     rtl/rel5/lib/rtl.pcert0 \
-     rtl/rel5/lib/arith.pcert0 \
-     rtl/rel5/lib/bits.pcert0 \
-     rtl/rel5/support/simplify-model-helpers.pcert0 \
-     rtl/rel5/lib/simplify-model-helpers.lisp
-rtl/rel5/lib/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel5/lib/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel5/lib/simplify-model-helpers.pcert1 : rtl/rel5/lib/simplify-model-helpers.pcert0
-rtl/rel5/lib/simplify-model-helpers.cert : | rtl/rel5/lib/simplify-model-helpers.pcert1
-
-rtl/rel5/lib/top.pcert0 : no_pcert = 0
-rtl/rel5/lib/top.pcert0 : acl2x = 0
-rtl/rel5/lib/top.pcert0 : \
-     rtl/rel5/lib/rtl.pcert0 \
-     rtl/rel5/lib/rtlarr.pcert0 \
-     rtl/rel5/lib/basic.pcert0 \
-     rtl/rel5/lib/bits.pcert0 \
-     rtl/rel5/lib/log.pcert0 \
-     rtl/rel5/lib/float.pcert0 \
-     rtl/rel5/lib/reps.pcert0 \
-     rtl/rel5/lib/round.pcert0 \
-     rtl/rel5/lib/add.pcert0 \
-     rtl/rel5/lib/arith.pcert0 \
-     rtl/rel5/lib/util.pcert0 \
-     rtl/rel5/lib/top.lisp
-rtl/rel5/lib/top.pcert1 : acl2x = 0
-rtl/rel5/lib/top.pcert1 : no_pcert = 0
-rtl/rel5/lib/top.pcert1 : rtl/rel5/lib/top.pcert0
-rtl/rel5/lib/top.cert : | rtl/rel5/lib/top.pcert1
-
-rtl/rel5/lib/util.pcert0 : no_pcert = 0
-rtl/rel5/lib/util.pcert0 : acl2x = 0
-rtl/rel5/lib/util.pcert0 : \
-     rtl/rel5/support/util.pcert0 \
-     rtl/rel5/lib/util.lisp
-rtl/rel5/lib/util.pcert1 : acl2x = 0
-rtl/rel5/lib/util.pcert1 : no_pcert = 0
-rtl/rel5/lib/util.pcert1 : rtl/rel5/lib/util.pcert0
-rtl/rel5/lib/util.cert : | rtl/rel5/lib/util.pcert1
-
-rtl/rel5/support/add3-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/add3-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/add3-proofs.pcert0 : \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/add3-proofs.lisp
-rtl/rel5/support/add3-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/add3-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/add3-proofs.pcert1 : rtl/rel5/support/add3-proofs.pcert0
-rtl/rel5/support/add3-proofs.cert : | rtl/rel5/support/add3-proofs.pcert1
-
-rtl/rel5/support/add3.pcert0 : no_pcert = 0
-rtl/rel5/support/add3.pcert0 : acl2x = 0
-rtl/rel5/support/add3.pcert0 : \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/add3-proofs.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/add3.lisp
-rtl/rel5/support/add3.pcert1 : acl2x = 0
-rtl/rel5/support/add3.pcert1 : no_pcert = 0
-rtl/rel5/support/add3.pcert1 : rtl/rel5/support/add3.pcert0
-rtl/rel5/support/add3.cert : | rtl/rel5/support/add3.pcert1
-
-rtl/rel5/support/all-ones.pcert0 : no_pcert = 0
-rtl/rel5/support/all-ones.pcert0 : acl2x = 0
-rtl/rel5/support/all-ones.pcert0 : \
-     rtl/rel5/support/all-ones.lisp
-rtl/rel5/support/all-ones.pcert1 : acl2x = 0
-rtl/rel5/support/all-ones.pcert1 : no_pcert = 0
-rtl/rel5/support/all-ones.pcert1 : rtl/rel5/support/all-ones.pcert0
-rtl/rel5/support/all-ones.cert : | rtl/rel5/support/all-ones.pcert1
-
-rtl/rel5/support/ash.pcert0 : no_pcert = 0
-rtl/rel5/support/ash.pcert0 : acl2x = 0
-rtl/rel5/support/ash.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/arithmetic/expo.pcert0 \
-     rtl/rel5/support/ash.lisp
-rtl/rel5/support/ash.pcert1 : acl2x = 0
-rtl/rel5/support/ash.pcert1 : no_pcert = 0
-rtl/rel5/support/ash.pcert1 : rtl/rel5/support/ash.pcert0
-rtl/rel5/support/ash.cert : | rtl/rel5/support/ash.pcert1
-
-rtl/rel5/support/away-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/away-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/away-proofs.pcert0 : \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/away-proofs.lisp
-rtl/rel5/support/away-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/away-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/away-proofs.pcert1 : rtl/rel5/support/away-proofs.pcert0
-rtl/rel5/support/away-proofs.cert : | rtl/rel5/support/away-proofs.pcert1
-
-rtl/rel5/support/away.pcert0 : no_pcert = 0
-rtl/rel5/support/away.pcert0 : acl2x = 0
-rtl/rel5/support/away.pcert0 : \
-     rtl/rel5/support/away-proofs.pcert0 \
-     rtl/rel5/support/away.lisp
-rtl/rel5/support/away.pcert1 : acl2x = 0
-rtl/rel5/support/away.pcert1 : no_pcert = 0
-rtl/rel5/support/away.pcert1 : rtl/rel5/support/away.pcert0
-rtl/rel5/support/away.cert : | rtl/rel5/support/away.pcert1
-
-rtl/rel5/support/badguys.pcert0 : no_pcert = 0
-rtl/rel5/support/badguys.pcert0 : acl2x = 0
-rtl/rel5/support/badguys.pcert0 : \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/badguys.lisp
-rtl/rel5/support/badguys.pcert1 : acl2x = 0
-rtl/rel5/support/badguys.pcert1 : no_pcert = 0
-rtl/rel5/support/badguys.pcert1 : rtl/rel5/support/badguys.pcert0
-rtl/rel5/support/badguys.cert : | rtl/rel5/support/badguys.pcert1
-
-rtl/rel5/support/bias-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/bias-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/bias-proofs.pcert0 : \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/support/bias-proofs.lisp
-rtl/rel5/support/bias-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/bias-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/bias-proofs.pcert1 : rtl/rel5/support/bias-proofs.pcert0
-rtl/rel5/support/bias-proofs.cert : | rtl/rel5/support/bias-proofs.pcert1
-
-rtl/rel5/support/bias.pcert0 : no_pcert = 0
-rtl/rel5/support/bias.pcert0 : acl2x = 0
-rtl/rel5/support/bias.pcert0 : \
-     rtl/rel5/support/bias-proofs.pcert0 \
-     rtl/rel5/support/bias.lisp
-rtl/rel5/support/bias.pcert1 : acl2x = 0
-rtl/rel5/support/bias.pcert1 : no_pcert = 0
-rtl/rel5/support/bias.pcert1 : rtl/rel5/support/bias.pcert0
-rtl/rel5/support/bias.cert : | rtl/rel5/support/bias.pcert1
-
-rtl/rel5/support/bitn-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/bitn-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/bitn-proofs.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/bitn-proofs.lisp
-rtl/rel5/support/bitn-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/bitn-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/bitn-proofs.pcert1 : rtl/rel5/support/bitn-proofs.pcert0
-rtl/rel5/support/bitn-proofs.cert : | rtl/rel5/support/bitn-proofs.pcert1
-
-rtl/rel5/support/bitn.pcert0 : no_pcert = 0
-rtl/rel5/support/bitn.pcert0 : acl2x = 0
-rtl/rel5/support/bitn.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/support/bitn-proofs.pcert0 \
-     rtl/rel5/support/bitn.lisp
-rtl/rel5/support/bitn.pcert1 : acl2x = 0
-rtl/rel5/support/bitn.pcert1 : no_pcert = 0
-rtl/rel5/support/bitn.pcert1 : rtl/rel5/support/bitn.pcert0
-rtl/rel5/support/bitn.cert : | rtl/rel5/support/bitn.pcert1
-
-rtl/rel5/support/bits-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/bits-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/bits-proofs.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/bits-proofs.lisp
-rtl/rel5/support/bits-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/bits-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/bits-proofs.pcert1 : rtl/rel5/support/bits-proofs.pcert0
-rtl/rel5/support/bits-proofs.cert : | rtl/rel5/support/bits-proofs.pcert1
-
-rtl/rel5/support/bits-trunc-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/bits-trunc-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/bits-trunc-proofs.pcert0 : \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/log.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bits-trunc-proofs.lisp
-rtl/rel5/support/bits-trunc-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/bits-trunc-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/bits-trunc-proofs.pcert1 : rtl/rel5/support/bits-trunc-proofs.pcert0
-rtl/rel5/support/bits-trunc-proofs.cert : | rtl/rel5/support/bits-trunc-proofs.pcert1
-
-rtl/rel5/support/bits-trunc.pcert0 : no_pcert = 0
-rtl/rel5/support/bits-trunc.pcert0 : acl2x = 0
-rtl/rel5/support/bits-trunc.pcert0 : \
-     rtl/rel5/support/log.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/bits-trunc-proofs.pcert0 \
-     rtl/rel5/support/bits-trunc.lisp
-rtl/rel5/support/bits-trunc.pcert1 : acl2x = 0
-rtl/rel5/support/bits-trunc.pcert1 : no_pcert = 0
-rtl/rel5/support/bits-trunc.pcert1 : rtl/rel5/support/bits-trunc.pcert0
-rtl/rel5/support/bits-trunc.cert : | rtl/rel5/support/bits-trunc.pcert1
-
-rtl/rel5/support/bits.pcert0 : no_pcert = 0
-rtl/rel5/support/bits.pcert0 : acl2x = 0
-rtl/rel5/support/bits.pcert0 : \
-     rtl/rel5/support/bits-proofs.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/support/bits.lisp
-rtl/rel5/support/bits.pcert1 : acl2x = 0
-rtl/rel5/support/bits.pcert1 : no_pcert = 0
-rtl/rel5/support/bits.pcert1 : rtl/rel5/support/bits.pcert0
-rtl/rel5/support/bits.cert : | rtl/rel5/support/bits.pcert1
-
-rtl/rel5/support/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel5/support/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel5/support/bvecp-helpers.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/bvecp-lemmas.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bvecp-helpers.lisp
-rtl/rel5/support/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel5/support/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel5/support/bvecp-helpers.pcert1 : rtl/rel5/support/bvecp-helpers.pcert0
-rtl/rel5/support/bvecp-helpers.cert : | rtl/rel5/support/bvecp-helpers.pcert1
-
-rtl/rel5/support/bvecp-lemmas.pcert0 : no_pcert = 0
-rtl/rel5/support/bvecp-lemmas.pcert0 : acl2x = 0
-rtl/rel5/support/bvecp-lemmas.pcert0 : \
-     rtl/rel5/arithmetic/expo.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/setbits.pcert0 \
-     rtl/rel5/support/setbitn.pcert0 \
-     rtl/rel5/support/encode.pcert0 \
-     rtl/rel5/support/decode.pcert0 \
-     rtl/rel5/support/logs.pcert0 \
-     rtl/rel5/support/lnot.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/shft.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/mulcat.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/bvecp-lemmas.lisp
-rtl/rel5/support/bvecp-lemmas.pcert1 : acl2x = 0
-rtl/rel5/support/bvecp-lemmas.pcert1 : no_pcert = 0
-rtl/rel5/support/bvecp-lemmas.pcert1 : rtl/rel5/support/bvecp-lemmas.pcert0
-rtl/rel5/support/bvecp-lemmas.cert : | rtl/rel5/support/bvecp-lemmas.pcert1
-
-rtl/rel5/support/bvecp-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/bvecp-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/bvecp-proofs.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bvecp-proofs.lisp
-rtl/rel5/support/bvecp-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/bvecp-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/bvecp-proofs.pcert1 : rtl/rel5/support/bvecp-proofs.pcert0
-rtl/rel5/support/bvecp-proofs.cert : | rtl/rel5/support/bvecp-proofs.pcert1
-
-rtl/rel5/support/bvecp.pcert0 : no_pcert = 0
-rtl/rel5/support/bvecp.pcert0 : acl2x = 0
-rtl/rel5/support/bvecp.pcert0 : \
-     rtl/rel5/support/bvecp-proofs.pcert0 \
-     rtl/rel5/support/bvecp.lisp
-rtl/rel5/support/bvecp.pcert1 : acl2x = 0
-rtl/rel5/support/bvecp.pcert1 : no_pcert = 0
-rtl/rel5/support/bvecp.pcert1 : rtl/rel5/support/bvecp.pcert0
-rtl/rel5/support/bvecp.cert : | rtl/rel5/support/bvecp.pcert1
-
-rtl/rel5/support/cat-def.pcert0 : no_pcert = 0
-rtl/rel5/support/cat-def.pcert0 : acl2x = 0
-rtl/rel5/support/cat-def.pcert0 : \
-     rtl/rel5/support/cat-def.lisp
-rtl/rel5/support/cat-def.pcert1 : acl2x = 0
-rtl/rel5/support/cat-def.pcert1 : no_pcert = 0
-rtl/rel5/support/cat-def.pcert1 : rtl/rel5/support/cat-def.pcert0
-rtl/rel5/support/cat-def.cert : | rtl/rel5/support/cat-def.pcert1
-
-rtl/rel5/support/cat-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/cat-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/cat-proofs.pcert0 : \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/cat-proofs.lisp
-rtl/rel5/support/cat-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/cat-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/cat-proofs.pcert1 : rtl/rel5/support/cat-proofs.pcert0
-rtl/rel5/support/cat-proofs.cert : | rtl/rel5/support/cat-proofs.pcert1
-
-rtl/rel5/support/cat.pcert0 : no_pcert = 0
-rtl/rel5/support/cat.pcert0 : acl2x = 0
-rtl/rel5/support/cat.pcert0 : \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/support/cat-proofs.pcert0 \
-     rtl/rel5/support/cat.lisp
-rtl/rel5/support/cat.pcert1 : acl2x = 0
-rtl/rel5/support/cat.pcert1 : no_pcert = 0
-rtl/rel5/support/cat.pcert1 : rtl/rel5/support/cat.pcert0
-rtl/rel5/support/cat.cert : | rtl/rel5/support/cat.pcert1
-
-rtl/rel5/support/clocks.pcert0 : no_pcert = 0
-rtl/rel5/support/clocks.pcert0 : acl2x = 0
-rtl/rel5/support/clocks.pcert0 : \
-     rtl/rel5/support/mod4.pcert0 \
-     rtl/rel5/arithmetic/even-odd2.pcert0 \
-     rtl/rel5/support/clocks.lisp
-rtl/rel5/support/clocks.pcert1 : acl2x = 0
-rtl/rel5/support/clocks.pcert1 : no_pcert = 0
-rtl/rel5/support/clocks.pcert1 : rtl/rel5/support/clocks.pcert0
-rtl/rel5/support/clocks.cert : | rtl/rel5/support/clocks.pcert1
-
-rtl/rel5/support/decode-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/decode-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/decode-proofs.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/support/ash.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/decode-proofs.lisp
-rtl/rel5/support/decode-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/decode-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/decode-proofs.pcert1 : rtl/rel5/support/decode-proofs.pcert0
-rtl/rel5/support/decode-proofs.cert : | rtl/rel5/support/decode-proofs.pcert1
-
-rtl/rel5/support/decode.pcert0 : no_pcert = 0
-rtl/rel5/support/decode.pcert0 : acl2x = 0
-rtl/rel5/support/decode.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/decode-proofs.pcert0 \
-     rtl/rel5/support/decode.lisp
-rtl/rel5/support/decode.pcert1 : acl2x = 0
-rtl/rel5/support/decode.pcert1 : no_pcert = 0
-rtl/rel5/support/decode.pcert1 : rtl/rel5/support/decode.pcert0
-rtl/rel5/support/decode.cert : | rtl/rel5/support/decode.pcert1
-
-rtl/rel5/support/drnd.pcert0 : no_pcert = 0
-rtl/rel5/support/drnd.pcert0 : acl2x = 0
-rtl/rel5/support/drnd.pcert0 : \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/ireps.pcert0 \
-     rtl/rel5/support/rnd.pcert0 \
-     rtl/rel5/support/bias.pcert0 \
-     rtl/rel5/support/sgn.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/away.pcert0 \
-     rtl/rel5/support/near.pcert0 \
-     rtl/rel5/support/near+.pcert0 \
-     rtl/rel5/support/sticky.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/drnd.lisp
-rtl/rel5/support/drnd.pcert1 : acl2x = 0
-rtl/rel5/support/drnd.pcert1 : no_pcert = 0
-rtl/rel5/support/drnd.pcert1 : rtl/rel5/support/drnd.pcert0
-rtl/rel5/support/drnd.cert : | rtl/rel5/support/drnd.pcert1
-
-rtl/rel5/support/encode.pcert0 : no_pcert = 0
-rtl/rel5/support/encode.pcert0 : acl2x = 0
-rtl/rel5/support/encode.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/ash.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/encode.lisp
-rtl/rel5/support/encode.pcert1 : acl2x = 0
-rtl/rel5/support/encode.pcert1 : no_pcert = 0
-rtl/rel5/support/encode.pcert1 : rtl/rel5/support/encode.pcert0
-rtl/rel5/support/encode.cert : | rtl/rel5/support/encode.pcert1
-
-rtl/rel5/support/ereps-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/ereps-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/ereps-proofs.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/bias.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/mulcat.pcert0 \
-     rtl/rel5/support/ereps-proofs.lisp
-rtl/rel5/support/ereps-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/ereps-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/ereps-proofs.pcert1 : rtl/rel5/support/ereps-proofs.pcert0
-rtl/rel5/support/ereps-proofs.cert : | rtl/rel5/support/ereps-proofs.pcert1
-
-rtl/rel5/support/ereps.pcert0 : no_pcert = 0
-rtl/rel5/support/ereps.pcert0 : acl2x = 0
-rtl/rel5/support/ereps.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/ereps-proofs.pcert0 \
-     rtl/rel5/support/ereps.lisp
-rtl/rel5/support/ereps.pcert1 : acl2x = 0
-rtl/rel5/support/ereps.pcert1 : no_pcert = 0
-rtl/rel5/support/ereps.pcert1 : rtl/rel5/support/ereps.pcert0
-rtl/rel5/support/ereps.cert : | rtl/rel5/support/ereps.pcert1
-
-rtl/rel5/support/fadd-extra.pcert0 : no_pcert = 0
-rtl/rel5/support/fadd-extra.pcert0 : acl2x = 0
-rtl/rel5/support/fadd-extra.pcert0 : \
-     rtl/rel5/support/fadd-extra0.pcert0 \
-     rtl/rel5/support/land.pcert0 \
-     rtl/rel5/support/lior.pcert0 \
-     rtl/rel5/support/lxor.pcert0 \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/fadd-extra.lisp
-rtl/rel5/support/fadd-extra.pcert1 : acl2x = 0
-rtl/rel5/support/fadd-extra.pcert1 : no_pcert = 0
-rtl/rel5/support/fadd-extra.pcert1 : rtl/rel5/support/fadd-extra.pcert0
-rtl/rel5/support/fadd-extra.cert : | rtl/rel5/support/fadd-extra.pcert1
-
-rtl/rel5/support/fadd-extra0.pcert0 : no_pcert = 0
-rtl/rel5/support/fadd-extra0.pcert0 : acl2x = 0
-rtl/rel5/support/fadd-extra0.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/fadd.pcert0 \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/fadd-extra0.lisp
-rtl/rel5/support/fadd-extra0.pcert1 : acl2x = 0
-rtl/rel5/support/fadd-extra0.pcert1 : no_pcert = 0
-rtl/rel5/support/fadd-extra0.pcert1 : rtl/rel5/support/fadd-extra0.pcert0
-rtl/rel5/support/fadd-extra0.cert : | rtl/rel5/support/fadd-extra0.pcert1
-
-rtl/rel5/support/fadd.pcert0 : no_pcert = 0
-rtl/rel5/support/fadd.pcert0 : acl2x = 0
-rtl/rel5/support/fadd.pcert0 : \
-     rtl/rel5/support/stick.pcert0 \
-     rtl/rel5/support/lop3.pcert0 \
-     rtl/rel5/support/add3.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/lextra0.pcert0 \
-     rtl/rel5/support/fadd.lisp
-rtl/rel5/support/fadd.pcert1 : acl2x = 0
-rtl/rel5/support/fadd.pcert1 : no_pcert = 0
-rtl/rel5/support/fadd.pcert1 : rtl/rel5/support/fadd.pcert0
-rtl/rel5/support/fadd.cert : | rtl/rel5/support/fadd.pcert1
-
-rtl/rel5/support/fast-and.pcert0 : no_pcert = 0
-rtl/rel5/support/fast-and.pcert0 : acl2x = 0
-rtl/rel5/support/fast-and.pcert0 : \
-     rtl/rel5/support/fast-and.lisp
-rtl/rel5/support/fast-and.pcert1 : acl2x = 0
-rtl/rel5/support/fast-and.pcert1 : no_pcert = 0
-rtl/rel5/support/fast-and.pcert1 : rtl/rel5/support/fast-and.pcert0
-rtl/rel5/support/fast-and.cert : | rtl/rel5/support/fast-and.pcert1
-
-rtl/rel5/support/float-extra.pcert0 : no_pcert = 0
-rtl/rel5/support/float-extra.pcert0 : acl2x = 0
-rtl/rel5/support/float-extra.pcert0 : \
-     arithmetic/inequalities.pcert0 \
-     rtl/rel5/support/sticky.pcert0 \
-     rtl/rel5/support/util.pcert0 \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/float-extra.lisp
-rtl/rel5/support/float-extra.pcert1 : acl2x = 0
-rtl/rel5/support/float-extra.pcert1 : no_pcert = 0
-rtl/rel5/support/float-extra.pcert1 : rtl/rel5/support/float-extra.pcert0
-rtl/rel5/support/float-extra.cert : | rtl/rel5/support/float-extra.pcert1
-
-rtl/rel5/support/float.pcert0 : no_pcert = 0
-rtl/rel5/support/float.pcert0 : acl2x = 0
-rtl/rel5/support/float.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/basic.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/cg.pcert0 \
-     rtl/rel5/support/float.lisp
-rtl/rel5/support/float.pcert1 : acl2x = 0
-rtl/rel5/support/float.pcert1 : no_pcert = 0
-rtl/rel5/support/float.pcert1 : rtl/rel5/support/float.pcert0
-rtl/rel5/support/float.cert : | rtl/rel5/support/float.pcert1
-
-rtl/rel5/support/ground-zero.pcert0 : no_pcert = 0
-rtl/rel5/support/ground-zero.pcert0 : acl2x = 0
-rtl/rel5/support/ground-zero.pcert0 : \
-     rtl/rel5/arithmetic/ground-zero.pcert0 \
-     rtl/rel5/support/util.pcert0 \
-     rtl/rel5/support/ground-zero.lisp
-rtl/rel5/support/ground-zero.pcert1 : acl2x = 0
-rtl/rel5/support/ground-zero.pcert1 : no_pcert = 0
-rtl/rel5/support/ground-zero.pcert1 : rtl/rel5/support/ground-zero.pcert0
-rtl/rel5/support/ground-zero.cert : | rtl/rel5/support/ground-zero.pcert1
-
-rtl/rel5/support/guards.pcert0 : no_pcert = 0
-rtl/rel5/support/guards.pcert0 : acl2x = 0
-rtl/rel5/support/guards.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/land.pcert0 \
-     rtl/rel5/support/lior.pcert0 \
-     rtl/rel5/support/lxor.pcert0 \
-     rtl/rel5/support/guards.lisp
-rtl/rel5/support/guards.pcert1 : acl2x = 0
-rtl/rel5/support/guards.pcert1 : no_pcert = 0
-rtl/rel5/support/guards.pcert1 : rtl/rel5/support/guards.pcert0
-rtl/rel5/support/guards.cert : | rtl/rel5/support/guards.pcert1
-
-rtl/rel5/support/ireps.pcert0 : no_pcert = 0
-rtl/rel5/support/ireps.pcert0 : acl2x = 0
-rtl/rel5/support/ireps.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/bias.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/ireps.lisp
-rtl/rel5/support/ireps.pcert1 : acl2x = 0
-rtl/rel5/support/ireps.pcert1 : no_pcert = 0
-rtl/rel5/support/ireps.pcert1 : rtl/rel5/support/ireps.pcert0
-rtl/rel5/support/ireps.cert : | rtl/rel5/support/ireps.pcert1
-
-rtl/rel5/support/land.pcert0 : no_pcert = 0
-rtl/rel5/support/land.pcert0 : acl2x = 0
-rtl/rel5/support/land.pcert0 : \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/land.lisp
-rtl/rel5/support/land.pcert1 : acl2x = 0
-rtl/rel5/support/land.pcert1 : no_pcert = 0
-rtl/rel5/support/land.pcert1 : rtl/rel5/support/land.pcert0
-rtl/rel5/support/land.cert : | rtl/rel5/support/land.pcert1
-
-rtl/rel5/support/land0-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/land0-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/land0-proofs.pcert0 : \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/all-ones.pcert0 \
-     rtl/rel5/support/log.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/arithmetic/fl-hacks.pcert0 \
-     rtl/rel5/support/land0-proofs.lisp
-rtl/rel5/support/land0-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/land0-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/land0-proofs.pcert1 : rtl/rel5/support/land0-proofs.pcert0
-rtl/rel5/support/land0-proofs.cert : | rtl/rel5/support/land0-proofs.pcert1
-
-rtl/rel5/support/land0.pcert0 : no_pcert = 0
-rtl/rel5/support/land0.pcert0 : acl2x = 0
-rtl/rel5/support/land0.pcert0 : \
-     rtl/rel5/support/land0-proofs.pcert0 \
-     rtl/rel5/support/land0.lisp
-rtl/rel5/support/land0.pcert1 : acl2x = 0
-rtl/rel5/support/land0.pcert1 : no_pcert = 0
-rtl/rel5/support/land0.pcert1 : rtl/rel5/support/land0.pcert0
-rtl/rel5/support/land0.cert : | rtl/rel5/support/land0.pcert1
-
-rtl/rel5/support/lextra-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/lextra-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/lextra-proofs.pcert0 : \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/support/logxor.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/lextra-proofs.lisp
-rtl/rel5/support/lextra-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/lextra-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/lextra-proofs.pcert1 : rtl/rel5/support/lextra-proofs.pcert0
-rtl/rel5/support/lextra-proofs.cert : | rtl/rel5/support/lextra-proofs.pcert1
-
-rtl/rel5/support/lextra.pcert0 : no_pcert = 0
-rtl/rel5/support/lextra.pcert0 : acl2x = 0
-rtl/rel5/support/lextra.pcert0 : \
-     rtl/rel5/support/land.pcert0 \
-     rtl/rel5/support/lior.pcert0 \
-     rtl/rel5/support/lxor.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/lextra0.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/merge2.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bits-trunc.pcert0 \
-     rtl/rel5/support/fadd.pcert0 \
-     rtl/rel5/support/lextra.lisp
-rtl/rel5/support/lextra.pcert1 : acl2x = 0
-rtl/rel5/support/lextra.pcert1 : no_pcert = 0
-rtl/rel5/support/lextra.pcert1 : rtl/rel5/support/lextra.pcert0
-rtl/rel5/support/lextra.cert : | rtl/rel5/support/lextra.pcert1
-
-rtl/rel5/support/lextra0.pcert0 : no_pcert = 0
-rtl/rel5/support/lextra0.pcert0 : acl2x = 0
-rtl/rel5/support/lextra0.pcert0 : \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/lextra-proofs.pcert0 \
-     rtl/rel5/support/lextra0.lisp
-rtl/rel5/support/lextra0.pcert1 : acl2x = 0
-rtl/rel5/support/lextra0.pcert1 : no_pcert = 0
-rtl/rel5/support/lextra0.pcert1 : rtl/rel5/support/lextra0.pcert0
-rtl/rel5/support/lextra0.cert : | rtl/rel5/support/lextra0.pcert1
-
-rtl/rel5/support/lior.pcert0 : no_pcert = 0
-rtl/rel5/support/lior.pcert0 : acl2x = 0
-rtl/rel5/support/lior.pcert0 : \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/lior.lisp
-rtl/rel5/support/lior.pcert1 : acl2x = 0
-rtl/rel5/support/lior.pcert1 : no_pcert = 0
-rtl/rel5/support/lior.pcert1 : rtl/rel5/support/lior.pcert0
-rtl/rel5/support/lior.cert : | rtl/rel5/support/lior.pcert1
-
-rtl/rel5/support/lior0-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/lior0-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/lior0-proofs.pcert0 : \
-     rtl/rel5/support/all-ones.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/lior0-proofs.lisp
-rtl/rel5/support/lior0-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/lior0-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/lior0-proofs.pcert1 : rtl/rel5/support/lior0-proofs.pcert0
-rtl/rel5/support/lior0-proofs.cert : | rtl/rel5/support/lior0-proofs.pcert1
-
-rtl/rel5/support/lior0.pcert0 : no_pcert = 0
-rtl/rel5/support/lior0.pcert0 : acl2x = 0
-rtl/rel5/support/lior0.pcert0 : \
-     rtl/rel5/support/lior0-proofs.pcert0 \
-     rtl/rel5/support/lior0.lisp
-rtl/rel5/support/lior0.pcert1 : acl2x = 0
-rtl/rel5/support/lior0.pcert1 : no_pcert = 0
-rtl/rel5/support/lior0.pcert1 : rtl/rel5/support/lior0.pcert0
-rtl/rel5/support/lior0.cert : | rtl/rel5/support/lior0.pcert1
-
-rtl/rel5/support/lnot-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/lnot-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/lnot-proofs.pcert0 : \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/arithmetic/mod.pcert0 \
-     rtl/rel5/arithmetic/mod.pcert0 \
-     rtl/rel5/arithmetic/arith.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/lnot-proofs.lisp
-rtl/rel5/support/lnot-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/lnot-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/lnot-proofs.pcert1 : rtl/rel5/support/lnot-proofs.pcert0
-rtl/rel5/support/lnot-proofs.cert : | rtl/rel5/support/lnot-proofs.pcert1
-
-rtl/rel5/support/lnot.pcert0 : no_pcert = 0
-rtl/rel5/support/lnot.pcert0 : acl2x = 0
-rtl/rel5/support/lnot.pcert0 : \
-     rtl/rel5/support/lnot-proofs.pcert0 \
-     rtl/rel5/support/lnot.lisp
-rtl/rel5/support/lnot.pcert1 : acl2x = 0
-rtl/rel5/support/lnot.pcert1 : no_pcert = 0
-rtl/rel5/support/lnot.pcert1 : rtl/rel5/support/lnot.pcert0
-rtl/rel5/support/lnot.cert : | rtl/rel5/support/lnot.pcert1
-
-rtl/rel5/support/log-equal.pcert0 : no_pcert = 0
-rtl/rel5/support/log-equal.pcert0 : acl2x = 0
-rtl/rel5/support/log-equal.pcert0 : \
-     rtl/rel5/support/log-equal.lisp
-rtl/rel5/support/log-equal.pcert1 : acl2x = 0
-rtl/rel5/support/log-equal.pcert1 : no_pcert = 0
-rtl/rel5/support/log-equal.pcert1 : rtl/rel5/support/log-equal.pcert0
-rtl/rel5/support/log-equal.cert : | rtl/rel5/support/log-equal.pcert1
-
-rtl/rel5/support/log-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/log-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/log-proofs.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/lognot.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/lnot.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/logxor.pcert0 \
-     rtl/rel5/support/log-proofs.lisp
-rtl/rel5/support/log-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/log-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/log-proofs.pcert1 : rtl/rel5/support/log-proofs.pcert0
-rtl/rel5/support/log-proofs.cert : | rtl/rel5/support/log-proofs.pcert1
-
-rtl/rel5/support/log.pcert0 : no_pcert = 0
-rtl/rel5/support/log.pcert0 : acl2x = 0
-rtl/rel5/support/log.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/log-proofs.pcert0 \
-     rtl/rel5/support/lnot.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/support/logxor.pcert0 \
-     rtl/rel5/support/log.lisp
-rtl/rel5/support/log.pcert1 : acl2x = 0
-rtl/rel5/support/log.pcert1 : no_pcert = 0
-rtl/rel5/support/log.pcert1 : rtl/rel5/support/log.pcert0
-rtl/rel5/support/log.cert : | rtl/rel5/support/log.pcert1
-
-rtl/rel5/support/logand-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/logand-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/logand-proofs.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/arithmetic/induct.pcert0 \
-     rtl/rel5/support/lognot.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/logand-proofs.lisp
-rtl/rel5/support/logand-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/logand-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/logand-proofs.pcert1 : rtl/rel5/support/logand-proofs.pcert0
-rtl/rel5/support/logand-proofs.cert : | rtl/rel5/support/logand-proofs.pcert1
-
-rtl/rel5/support/logand.pcert0 : no_pcert = 0
-rtl/rel5/support/logand.pcert0 : acl2x = 0
-rtl/rel5/support/logand.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/logand-proofs.pcert0 \
-     rtl/rel5/support/logand.lisp
-rtl/rel5/support/logand.pcert1 : acl2x = 0
-rtl/rel5/support/logand.pcert1 : no_pcert = 0
-rtl/rel5/support/logand.pcert1 : rtl/rel5/support/logand.pcert0
-rtl/rel5/support/logand.cert : | rtl/rel5/support/logand.pcert1
-
-rtl/rel5/support/logeqv.pcert0 : no_pcert = 0
-rtl/rel5/support/logeqv.pcert0 : acl2x = 0
-rtl/rel5/support/logeqv.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/logorc1.pcert0 \
-     rtl/rel5/support/lognot.pcert0 \
-     rtl/rel5/support/logeqv.lisp
-rtl/rel5/support/logeqv.pcert1 : acl2x = 0
-rtl/rel5/support/logeqv.pcert1 : no_pcert = 0
-rtl/rel5/support/logeqv.pcert1 : rtl/rel5/support/logeqv.pcert0
-rtl/rel5/support/logeqv.cert : | rtl/rel5/support/logeqv.pcert1
-
-rtl/rel5/support/logior-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/logior-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/logior-proofs.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/lognot.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/logior-proofs.lisp
-rtl/rel5/support/logior-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/logior-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/logior-proofs.pcert1 : rtl/rel5/support/logior-proofs.pcert0
-rtl/rel5/support/logior-proofs.cert : | rtl/rel5/support/logior-proofs.pcert1
-
-rtl/rel5/support/logior.pcert0 : no_pcert = 0
-rtl/rel5/support/logior.pcert0 : acl2x = 0
-rtl/rel5/support/logior.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/logior-proofs.pcert0 \
-     rtl/rel5/support/logior.lisp
-rtl/rel5/support/logior.pcert1 : acl2x = 0
-rtl/rel5/support/logior.pcert1 : no_pcert = 0
-rtl/rel5/support/logior.pcert1 : rtl/rel5/support/logior.pcert0
-rtl/rel5/support/logior.cert : | rtl/rel5/support/logior.pcert1
-
-rtl/rel5/support/logior1-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/logior1-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/logior1-proofs.pcert0 : \
-     rtl/rel5/support/logior1-proofs.lisp
-rtl/rel5/support/logior1-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/logior1-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/logior1-proofs.pcert1 : rtl/rel5/support/logior1-proofs.pcert0
-rtl/rel5/support/logior1-proofs.cert : | rtl/rel5/support/logior1-proofs.pcert1
-
-rtl/rel5/support/logior1.pcert0 : no_pcert = 0
-rtl/rel5/support/logior1.pcert0 : acl2x = 0
-rtl/rel5/support/logior1.pcert0 : \
-     rtl/rel5/support/logior1-proofs.pcert0 \
-     rtl/rel5/support/logior1.lisp
-rtl/rel5/support/logior1.pcert1 : acl2x = 0
-rtl/rel5/support/logior1.pcert1 : no_pcert = 0
-rtl/rel5/support/logior1.pcert1 : rtl/rel5/support/logior1.pcert0
-rtl/rel5/support/logior1.cert : | rtl/rel5/support/logior1.pcert1
-
-rtl/rel5/support/lognot.pcert0 : no_pcert = 0
-rtl/rel5/support/lognot.pcert0 : acl2x = 0
-rtl/rel5/support/lognot.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/lognot.lisp
-rtl/rel5/support/lognot.pcert1 : acl2x = 0
-rtl/rel5/support/lognot.pcert1 : no_pcert = 0
-rtl/rel5/support/lognot.pcert1 : rtl/rel5/support/lognot.pcert0
-rtl/rel5/support/lognot.cert : | rtl/rel5/support/lognot.pcert1
-
-rtl/rel5/support/logorc1.pcert0 : no_pcert = 0
-rtl/rel5/support/logorc1.pcert0 : acl2x = 0
-rtl/rel5/support/logorc1.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/support/lognot.pcert0 \
-     rtl/rel5/support/logorc1.lisp
-rtl/rel5/support/logorc1.pcert1 : acl2x = 0
-rtl/rel5/support/logorc1.pcert1 : no_pcert = 0
-rtl/rel5/support/logorc1.pcert1 : rtl/rel5/support/logorc1.pcert0
-rtl/rel5/support/logorc1.cert : | rtl/rel5/support/logorc1.pcert1
-
-rtl/rel5/support/logs.pcert0 : no_pcert = 0
-rtl/rel5/support/logs.pcert0 : acl2x = 0
-rtl/rel5/support/logs.pcert0 : \
-     rtl/rel5/support/logs.lisp
-rtl/rel5/support/logs.pcert1 : acl2x = 0
-rtl/rel5/support/logs.pcert1 : no_pcert = 0
-rtl/rel5/support/logs.pcert1 : rtl/rel5/support/logs.pcert0
-rtl/rel5/support/logs.cert : | rtl/rel5/support/logs.pcert1
-
-rtl/rel5/support/logxor.pcert0 : no_pcert = 0
-rtl/rel5/support/logxor.pcert0 : acl2x = 0
-rtl/rel5/support/logxor.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/logeqv.pcert0 \
-     rtl/rel5/support/logorc1.pcert0 \
-     rtl/rel5/support/lognot.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/logxor.lisp
-rtl/rel5/support/logxor.pcert1 : acl2x = 0
-rtl/rel5/support/logxor.pcert1 : no_pcert = 0
-rtl/rel5/support/logxor.pcert1 : rtl/rel5/support/logxor.pcert0
-rtl/rel5/support/logxor.cert : | rtl/rel5/support/logxor.pcert1
-
-rtl/rel5/support/lop1-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/lop1-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/lop1-proofs.pcert0 : \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/lop1-proofs.lisp
-rtl/rel5/support/lop1-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/lop1-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/lop1-proofs.pcert1 : rtl/rel5/support/lop1-proofs.pcert0
-rtl/rel5/support/lop1-proofs.cert : | rtl/rel5/support/lop1-proofs.pcert1
-
-rtl/rel5/support/lop1.pcert0 : no_pcert = 0
-rtl/rel5/support/lop1.pcert0 : acl2x = 0
-rtl/rel5/support/lop1.pcert0 : \
-     rtl/rel5/support/lop1-proofs.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/lop1.lisp
-rtl/rel5/support/lop1.pcert1 : acl2x = 0
-rtl/rel5/support/lop1.pcert1 : no_pcert = 0
-rtl/rel5/support/lop1.pcert1 : rtl/rel5/support/lop1.pcert0
-rtl/rel5/support/lop1.cert : | rtl/rel5/support/lop1.pcert1
-
-rtl/rel5/support/lop2-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/lop2-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/lop2-proofs.pcert0 : \
-     rtl/rel5/support/lop1.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/support/lop2-proofs.lisp
-rtl/rel5/support/lop2-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/lop2-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/lop2-proofs.pcert1 : rtl/rel5/support/lop2-proofs.pcert0
-rtl/rel5/support/lop2-proofs.cert : | rtl/rel5/support/lop2-proofs.pcert1
-
-rtl/rel5/support/lop2.pcert0 : no_pcert = 0
-rtl/rel5/support/lop2.pcert0 : acl2x = 0
-rtl/rel5/support/lop2.pcert0 : \
-     rtl/rel5/support/lop1.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lop2-proofs.pcert0 \
-     rtl/rel5/support/lop2.lisp
-rtl/rel5/support/lop2.pcert1 : acl2x = 0
-rtl/rel5/support/lop2.pcert1 : no_pcert = 0
-rtl/rel5/support/lop2.pcert1 : rtl/rel5/support/lop2.pcert0
-rtl/rel5/support/lop2.cert : | rtl/rel5/support/lop2.pcert1
-
-rtl/rel5/support/lop3-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/lop3-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/lop3-proofs.pcert0 : \
-     rtl/rel5/support/lop2.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/lop3-proofs.lisp
-rtl/rel5/support/lop3-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/lop3-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/lop3-proofs.pcert1 : rtl/rel5/support/lop3-proofs.pcert0
-rtl/rel5/support/lop3-proofs.cert : | rtl/rel5/support/lop3-proofs.pcert1
-
-rtl/rel5/support/lop3.pcert0 : no_pcert = 0
-rtl/rel5/support/lop3.pcert0 : acl2x = 0
-rtl/rel5/support/lop3.pcert0 : \
-     rtl/rel5/support/lop2.pcert0 \
-     rtl/rel5/support/lop3-proofs.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/lop3.lisp
-rtl/rel5/support/lop3.pcert1 : acl2x = 0
-rtl/rel5/support/lop3.pcert1 : no_pcert = 0
-rtl/rel5/support/lop3.pcert1 : rtl/rel5/support/lop3.pcert0
-rtl/rel5/support/lop3.cert : | rtl/rel5/support/lop3.pcert1
-
-rtl/rel5/support/lxor.pcert0 : no_pcert = 0
-rtl/rel5/support/lxor.pcert0 : acl2x = 0
-rtl/rel5/support/lxor.pcert0 : \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/lxor.lisp
-rtl/rel5/support/lxor.pcert1 : acl2x = 0
-rtl/rel5/support/lxor.pcert1 : no_pcert = 0
-rtl/rel5/support/lxor.pcert1 : rtl/rel5/support/lxor.pcert0
-rtl/rel5/support/lxor.cert : | rtl/rel5/support/lxor.pcert1
-
-rtl/rel5/support/lxor0-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/lxor0-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/lxor0-proofs.pcert0 : \
-     rtl/rel5/support/all-ones.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/lxor0-proofs.lisp
-rtl/rel5/support/lxor0-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/lxor0-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/lxor0-proofs.pcert1 : rtl/rel5/support/lxor0-proofs.pcert0
-rtl/rel5/support/lxor0-proofs.cert : | rtl/rel5/support/lxor0-proofs.pcert1
-
-rtl/rel5/support/lxor0.pcert0 : no_pcert = 0
-rtl/rel5/support/lxor0.pcert0 : acl2x = 0
-rtl/rel5/support/lxor0.pcert0 : \
-     rtl/rel5/support/lxor0-proofs.pcert0 \
-     rtl/rel5/support/lxor0.lisp
-rtl/rel5/support/lxor0.pcert1 : acl2x = 0
-rtl/rel5/support/lxor0.pcert1 : no_pcert = 0
-rtl/rel5/support/lxor0.pcert1 : rtl/rel5/support/lxor0.pcert0
-rtl/rel5/support/lxor0.cert : | rtl/rel5/support/lxor0.pcert1
-
-rtl/rel5/support/merge.pcert0 : no_pcert = 0
-rtl/rel5/support/merge.pcert0 : acl2x = 0
-rtl/rel5/support/merge.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/log.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/lnot.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/logxor.pcert0 \
-     rtl/rel5/support/ocat.pcert0 \
-     rtl/rel5/support/sumbits.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/merge.lisp
-rtl/rel5/support/merge.pcert1 : acl2x = 0
-rtl/rel5/support/merge.pcert1 : no_pcert = 0
-rtl/rel5/support/merge.pcert1 : rtl/rel5/support/merge.pcert0
-rtl/rel5/support/merge.cert : | rtl/rel5/support/merge.pcert1
-
-rtl/rel5/support/merge2.pcert0 : no_pcert = 0
-rtl/rel5/support/merge2.pcert0 : acl2x = 0
-rtl/rel5/support/merge2.pcert0 : \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/logs.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/merge2.lisp
-rtl/rel5/support/merge2.pcert1 : acl2x = 0
-rtl/rel5/support/merge2.pcert1 : no_pcert = 0
-rtl/rel5/support/merge2.pcert1 : rtl/rel5/support/merge2.pcert0
-rtl/rel5/support/merge2.cert : | rtl/rel5/support/merge2.pcert1
-
-rtl/rel5/support/mod4.pcert0 : no_pcert = 0
-rtl/rel5/support/mod4.pcert0 : acl2x = 0
-rtl/rel5/support/mod4.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/mod4.lisp
-rtl/rel5/support/mod4.pcert1 : acl2x = 0
-rtl/rel5/support/mod4.pcert1 : no_pcert = 0
-rtl/rel5/support/mod4.pcert1 : rtl/rel5/support/mod4.pcert0
-rtl/rel5/support/mod4.cert : | rtl/rel5/support/mod4.pcert1
-
-rtl/rel5/support/model-helpers.pcert0 : no_pcert = 0
-rtl/rel5/support/model-helpers.pcert0 : acl2x = 0
-rtl/rel5/support/model-helpers.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/model-helpers.lisp
-rtl/rel5/support/model-helpers.pcert1 : acl2x = 0
-rtl/rel5/support/model-helpers.pcert1 : no_pcert = 0
-rtl/rel5/support/model-helpers.pcert1 : rtl/rel5/support/model-helpers.pcert0
-rtl/rel5/support/model-helpers.cert : | rtl/rel5/support/model-helpers.pcert1
-
-rtl/rel5/support/mulcat-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/mulcat-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/mulcat-proofs.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/mulcat-proofs.lisp
-rtl/rel5/support/mulcat-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/mulcat-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/mulcat-proofs.pcert1 : rtl/rel5/support/mulcat-proofs.pcert0
-rtl/rel5/support/mulcat-proofs.cert : | rtl/rel5/support/mulcat-proofs.pcert1
-
-rtl/rel5/support/mulcat.pcert0 : no_pcert = 0
-rtl/rel5/support/mulcat.pcert0 : acl2x = 0
-rtl/rel5/support/mulcat.pcert0 : \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/support/mulcat-proofs.pcert0 \
-     rtl/rel5/support/mulcat.lisp
-rtl/rel5/support/mulcat.pcert1 : acl2x = 0
-rtl/rel5/support/mulcat.pcert1 : no_pcert = 0
-rtl/rel5/support/mulcat.pcert1 : rtl/rel5/support/mulcat.pcert0
-rtl/rel5/support/mulcat.cert : | rtl/rel5/support/mulcat.pcert1
-
-rtl/rel5/support/near+-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/near+-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/near+-proofs.pcert0 : \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/away.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/arithmetic/predicate.pcert0 \
-     rtl/rel5/arithmetic/cg.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/near+-proofs.lisp
-rtl/rel5/support/near+-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/near+-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/near+-proofs.pcert1 : rtl/rel5/support/near+-proofs.pcert0
-rtl/rel5/support/near+-proofs.cert : | rtl/rel5/support/near+-proofs.pcert1
-
-rtl/rel5/support/near+.pcert0 : no_pcert = 0
-rtl/rel5/support/near+.pcert0 : acl2x = 0
-rtl/rel5/support/near+.pcert0 : \
-     rtl/rel5/support/near+-proofs.pcert0 \
-     rtl/rel5/support/near+.lisp
-rtl/rel5/support/near+.pcert1 : acl2x = 0
-rtl/rel5/support/near+.pcert1 : no_pcert = 0
-rtl/rel5/support/near+.pcert1 : rtl/rel5/support/near+.pcert0
-rtl/rel5/support/near+.cert : | rtl/rel5/support/near+.pcert1
-
-rtl/rel5/support/near-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/near-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/near-proofs.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/away.pcert0 \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/near-proofs.lisp
-rtl/rel5/support/near-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/near-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/near-proofs.pcert1 : rtl/rel5/support/near-proofs.pcert0
-rtl/rel5/support/near-proofs.cert : | rtl/rel5/support/near-proofs.pcert1
-
-rtl/rel5/support/near.pcert0 : no_pcert = 0
-rtl/rel5/support/near.pcert0 : acl2x = 0
-rtl/rel5/support/near.pcert0 : \
-     rtl/rel5/support/near-proofs.pcert0 \
-     rtl/rel5/support/near.lisp
-rtl/rel5/support/near.pcert1 : acl2x = 0
-rtl/rel5/support/near.pcert1 : no_pcert = 0
-rtl/rel5/support/near.pcert1 : rtl/rel5/support/near.pcert0
-rtl/rel5/support/near.cert : | rtl/rel5/support/near.pcert1
-
-rtl/rel5/support/ocat.pcert0 : no_pcert = 0
-rtl/rel5/support/ocat.pcert0 : acl2x = 0
-rtl/rel5/support/ocat.pcert0 : \
-     rtl/rel5/arithmetic/expt.pcert0 \
-     rtl/rel5/arithmetic/expo.pcert0 \
-     rtl/rel5/arithmetic/arith2.pcert0 \
-     rtl/rel5/arithmetic/fp2.pcert0 \
-     rtl/rel5/arithmetic/integerp.pcert0 \
-     rtl/rel5/support/ocat.lisp
-rtl/rel5/support/ocat.pcert1 : acl2x = 0
-rtl/rel5/support/ocat.pcert1 : no_pcert = 0
-rtl/rel5/support/ocat.pcert1 : rtl/rel5/support/ocat.pcert0
-rtl/rel5/support/ocat.cert : | rtl/rel5/support/ocat.pcert1
-
-rtl/rel5/support/oddr-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/oddr-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/oddr-proofs.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/away.pcert0 \
-     rtl/rel5/support/near.pcert0 \
-     rtl/rel5/support/oddr-proofs.lisp
-rtl/rel5/support/oddr-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/oddr-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/oddr-proofs.pcert1 : rtl/rel5/support/oddr-proofs.pcert0
-rtl/rel5/support/oddr-proofs.cert : | rtl/rel5/support/oddr-proofs.pcert1
-
-rtl/rel5/support/oddr.pcert0 : no_pcert = 0
-rtl/rel5/support/oddr.pcert0 : acl2x = 0
-rtl/rel5/support/oddr.pcert0 : \
-     rtl/rel5/support/oddr-proofs.pcert0 \
-     rtl/rel5/support/oddr.lisp
-rtl/rel5/support/oddr.pcert1 : acl2x = 0
-rtl/rel5/support/oddr.pcert1 : no_pcert = 0
-rtl/rel5/support/oddr.pcert1 : rtl/rel5/support/oddr.pcert0
-rtl/rel5/support/oddr.cert : | rtl/rel5/support/oddr.pcert1
-
-rtl/rel5/support/openers.pcert0 : no_pcert = 0
-rtl/rel5/support/openers.pcert0 : acl2x = 0
-rtl/rel5/support/openers.pcert0 : \
-     rtl/rel5/support/openers.lisp
-rtl/rel5/support/openers.pcert1 : acl2x = 0
-rtl/rel5/support/openers.pcert1 : no_pcert = 0
-rtl/rel5/support/openers.pcert1 : rtl/rel5/support/openers.pcert0
-rtl/rel5/support/openers.cert : | rtl/rel5/support/openers.pcert1
-
-rtl/rel5/support/package-defs.pcert0 : no_pcert = 0
-rtl/rel5/support/package-defs.pcert0 : acl2x = 0
-rtl/rel5/support/package-defs.pcert0 : \
-     rtl/rel5/support/package-defs.lisp
-rtl/rel5/support/package-defs.pcert1 : acl2x = 0
-rtl/rel5/support/package-defs.pcert1 : no_pcert = 0
-rtl/rel5/support/package-defs.pcert1 : rtl/rel5/support/package-defs.pcert0
-rtl/rel5/support/package-defs.cert : | rtl/rel5/support/package-defs.pcert1
-
-rtl/rel5/support/rewrite-theory.pcert0 : no_pcert = 0
-rtl/rel5/support/rewrite-theory.pcert0 : acl2x = 0
-rtl/rel5/support/rewrite-theory.pcert0 : \
-     rtl/rel5/support/rewrite-theory.lisp
-rtl/rel5/support/rewrite-theory.pcert1 : acl2x = 0
-rtl/rel5/support/rewrite-theory.pcert1 : no_pcert = 0
-rtl/rel5/support/rewrite-theory.pcert1 : rtl/rel5/support/rewrite-theory.pcert0
-rtl/rel5/support/rewrite-theory.cert : | rtl/rel5/support/rewrite-theory.pcert1
-
-rtl/rel5/support/rnd.pcert0 : no_pcert = 0
-rtl/rel5/support/rnd.pcert0 : acl2x = 0
-rtl/rel5/support/rnd.pcert0 : \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/away.pcert0 \
-     rtl/rel5/support/near.pcert0 \
-     rtl/rel5/support/near+.pcert0 \
-     rtl/rel5/support/sticky.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bits-trunc.pcert0 \
-     rtl/rel5/support/rnd.lisp
-rtl/rel5/support/rnd.pcert1 : acl2x = 0
-rtl/rel5/support/rnd.pcert1 : no_pcert = 0
-rtl/rel5/support/rnd.pcert1 : rtl/rel5/support/rnd.pcert0
-rtl/rel5/support/rnd.cert : | rtl/rel5/support/rnd.pcert1
-
-rtl/rel5/support/rom-helpers.pcert0 : no_pcert = 0
-rtl/rel5/support/rom-helpers.pcert0 : acl2x = 0
-rtl/rel5/support/rom-helpers.pcert0 : \
-     rtl/rel5/support/rom-helpers.lisp
-rtl/rel5/support/rom-helpers.pcert1 : acl2x = 0
-rtl/rel5/support/rom-helpers.pcert1 : no_pcert = 0
-rtl/rel5/support/rom-helpers.pcert1 : rtl/rel5/support/rom-helpers.pcert0
-rtl/rel5/support/rom-helpers.cert : | rtl/rel5/support/rom-helpers.pcert1
-
-rtl/rel5/support/round-extra.pcert0 : no_pcert = 0
-rtl/rel5/support/round-extra.pcert0 : acl2x = 0
-rtl/rel5/support/round-extra.pcert0 : \
-     rtl/rel5/support/sticky.pcert0 \
-     rtl/rel5/support/util.pcert0 \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/round-extra.lisp
-rtl/rel5/support/round-extra.pcert1 : acl2x = 0
-rtl/rel5/support/round-extra.pcert1 : no_pcert = 0
-rtl/rel5/support/round-extra.pcert1 : rtl/rel5/support/round-extra.pcert0
-rtl/rel5/support/round-extra.cert : | rtl/rel5/support/round-extra.pcert1
-
-rtl/rel5/support/rtl.pcert0 : no_pcert = 0
-rtl/rel5/support/rtl.pcert0 : acl2x = 0
-rtl/rel5/support/rtl.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/rtlarr.pcert0 \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/support/rtl.lisp
-rtl/rel5/support/rtl.pcert1 : acl2x = 0
-rtl/rel5/support/rtl.pcert1 : no_pcert = 0
-rtl/rel5/support/rtl.pcert1 : rtl/rel5/support/rtl.pcert0
-rtl/rel5/support/rtl.cert : | rtl/rel5/support/rtl.pcert1
-
-rtl/rel5/support/rtlarr.pcert0 : no_pcert = 0
-rtl/rel5/support/rtlarr.pcert0 : acl2x = 0
-rtl/rel5/support/rtlarr.pcert0 : \
-     misc/total-order.pcert0 \
-     rtl/rel5/support/rtlarr.lisp
-rtl/rel5/support/rtlarr.pcert1 : acl2x = 0
-rtl/rel5/support/rtlarr.pcert1 : no_pcert = 0
-rtl/rel5/support/rtlarr.pcert1 : rtl/rel5/support/rtlarr.pcert0
-rtl/rel5/support/rtlarr.cert : | rtl/rel5/support/rtlarr.pcert1
-
-rtl/rel5/support/setbitn-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/setbitn-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/setbitn-proofs.pcert0 : \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/support/setbits.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/setbitn-proofs.lisp
-rtl/rel5/support/setbitn-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/setbitn-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/setbitn-proofs.pcert1 : rtl/rel5/support/setbitn-proofs.pcert0
-rtl/rel5/support/setbitn-proofs.cert : | rtl/rel5/support/setbitn-proofs.pcert1
-
-rtl/rel5/support/setbitn.pcert0 : no_pcert = 0
-rtl/rel5/support/setbitn.pcert0 : acl2x = 0
-rtl/rel5/support/setbitn.pcert0 : \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/support/setbitn-proofs.pcert0 \
-     rtl/rel5/support/setbitn.lisp
-rtl/rel5/support/setbitn.pcert1 : acl2x = 0
-rtl/rel5/support/setbitn.pcert1 : no_pcert = 0
-rtl/rel5/support/setbitn.pcert1 : rtl/rel5/support/setbitn.pcert0
-rtl/rel5/support/setbitn.cert : | rtl/rel5/support/setbitn.pcert1
-
-rtl/rel5/support/setbits-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/setbits-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/setbits-proofs.pcert0 : \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/setbits-proofs.lisp
-rtl/rel5/support/setbits-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/setbits-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/setbits-proofs.pcert1 : rtl/rel5/support/setbits-proofs.pcert0
-rtl/rel5/support/setbits-proofs.cert : | rtl/rel5/support/setbits-proofs.pcert1
-
-rtl/rel5/support/setbits.pcert0 : no_pcert = 0
-rtl/rel5/support/setbits.pcert0 : acl2x = 0
-rtl/rel5/support/setbits.pcert0 : \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/support/setbits-proofs.pcert0 \
-     rtl/rel5/support/setbits.lisp
-rtl/rel5/support/setbits.pcert1 : acl2x = 0
-rtl/rel5/support/setbits.pcert1 : no_pcert = 0
-rtl/rel5/support/setbits.pcert1 : rtl/rel5/support/setbits.pcert0
-rtl/rel5/support/setbits.cert : | rtl/rel5/support/setbits.pcert1
-
-rtl/rel5/support/sgn.pcert0 : no_pcert = 0
-rtl/rel5/support/sgn.pcert0 : acl2x = 0
-rtl/rel5/support/sgn.pcert0 : \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/sgn.lisp
-rtl/rel5/support/sgn.pcert1 : acl2x = 0
-rtl/rel5/support/sgn.pcert1 : no_pcert = 0
-rtl/rel5/support/sgn.pcert1 : rtl/rel5/support/sgn.pcert0
-rtl/rel5/support/sgn.cert : | rtl/rel5/support/sgn.pcert1
-
-rtl/rel5/support/shft.pcert0 : no_pcert = 0
-rtl/rel5/support/shft.pcert0 : acl2x = 0
-rtl/rel5/support/shft.pcert0 : \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/shft.lisp
-rtl/rel5/support/shft.pcert1 : acl2x = 0
-rtl/rel5/support/shft.pcert1 : no_pcert = 0
-rtl/rel5/support/shft.pcert1 : rtl/rel5/support/shft.pcert0
-rtl/rel5/support/shft.cert : | rtl/rel5/support/shft.pcert1
-
-rtl/rel5/support/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel5/support/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel5/support/simple-loop-helpers.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/setbitn.pcert0 \
-     rtl/rel5/support/simple-loop-helpers.lisp
-rtl/rel5/support/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel5/support/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel5/support/simple-loop-helpers.pcert1 : rtl/rel5/support/simple-loop-helpers.pcert0
-rtl/rel5/support/simple-loop-helpers.cert : | rtl/rel5/support/simple-loop-helpers.pcert1
-
-rtl/rel5/support/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel5/support/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel5/support/simplify-model-helpers.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/simplify-model-helpers.lisp
-rtl/rel5/support/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel5/support/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel5/support/simplify-model-helpers.pcert1 : rtl/rel5/support/simplify-model-helpers.pcert0
-rtl/rel5/support/simplify-model-helpers.cert : | rtl/rel5/support/simplify-model-helpers.pcert1
-
-rtl/rel5/support/stick-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/stick-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/stick-proofs.pcert0 : \
-     rtl/rel5/support/merge.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/lnot.pcert0 \
-     rtl/rel5/support/stick-proofs.lisp
-rtl/rel5/support/stick-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/stick-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/stick-proofs.pcert1 : rtl/rel5/support/stick-proofs.pcert0
-rtl/rel5/support/stick-proofs.cert : | rtl/rel5/support/stick-proofs.pcert1
-
-rtl/rel5/support/stick.pcert0 : no_pcert = 0
-rtl/rel5/support/stick.pcert0 : acl2x = 0
-rtl/rel5/support/stick.pcert0 : \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/stick-proofs.pcert0 \
-     rtl/rel5/support/stick.lisp
-rtl/rel5/support/stick.pcert1 : acl2x = 0
-rtl/rel5/support/stick.pcert1 : no_pcert = 0
-rtl/rel5/support/stick.pcert1 : rtl/rel5/support/stick.pcert0
-rtl/rel5/support/stick.cert : | rtl/rel5/support/stick.pcert1
-
-rtl/rel5/support/sticky-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/sticky-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/sticky-proofs.pcert0 : \
-     rtl/rel5/arithmetic/arith.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/away.pcert0 \
-     rtl/rel5/support/near.pcert0 \
-     rtl/rel5/support/near+.pcert0 \
-     rtl/rel5/support/sticky-proofs.lisp
-rtl/rel5/support/sticky-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/sticky-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/sticky-proofs.pcert1 : rtl/rel5/support/sticky-proofs.pcert0
-rtl/rel5/support/sticky-proofs.cert : | rtl/rel5/support/sticky-proofs.pcert1
-
-rtl/rel5/support/sticky.pcert0 : no_pcert = 0
-rtl/rel5/support/sticky.pcert0 : acl2x = 0
-rtl/rel5/support/sticky.pcert0 : \
-     rtl/rel5/support/sticky-proofs.pcert0 \
-     rtl/rel5/support/sticky.lisp
-rtl/rel5/support/sticky.pcert1 : acl2x = 0
-rtl/rel5/support/sticky.pcert1 : no_pcert = 0
-rtl/rel5/support/sticky.pcert1 : rtl/rel5/support/sticky.pcert0
-rtl/rel5/support/sticky.cert : | rtl/rel5/support/sticky.pcert1
-
-rtl/rel5/support/sumbits.pcert0 : no_pcert = 0
-rtl/rel5/support/sumbits.pcert0 : acl2x = 0
-rtl/rel5/support/sumbits.pcert0 : \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/sumbits.lisp
-rtl/rel5/support/sumbits.pcert1 : acl2x = 0
-rtl/rel5/support/sumbits.pcert1 : no_pcert = 0
-rtl/rel5/support/sumbits.pcert1 : rtl/rel5/support/sumbits.pcert0
-rtl/rel5/support/sumbits.cert : | rtl/rel5/support/sumbits.pcert1
-
-rtl/rel5/support/top.pcert0 : no_pcert = 0
-rtl/rel5/support/top.pcert0 : acl2x = 0
-rtl/rel5/support/top.pcert0 : \
-     rtl/rel5/support/top1.pcert0 \
-     rtl/rel5/support/lextra.pcert0 \
-     rtl/rel5/support/fadd-extra.pcert0 \
-     rtl/rel5/support/float-extra.pcert0 \
-     rtl/rel5/support/round-extra.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/support/badguys.pcert0 \
-     rtl/rel5/support/top.lisp
-rtl/rel5/support/top.pcert1 : acl2x = 0
-rtl/rel5/support/top.pcert1 : no_pcert = 0
-rtl/rel5/support/top.pcert1 : rtl/rel5/support/top.pcert0
-rtl/rel5/support/top.cert : | rtl/rel5/support/top.pcert1
-
-rtl/rel5/support/top1.pcert0 : no_pcert = 0
-rtl/rel5/support/top1.pcert0 : acl2x = 0
-rtl/rel5/support/top1.pcert0 : \
-     rtl/rel5/support/util.pcert0 \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/rewrite-theory.pcert0 \
-     rtl/rel5/support/rtl.pcert0 \
-     rtl/rel5/support/rtlarr.pcert0 \
-     rtl/rel5/support/bvecp-lemmas.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/ocat.pcert0 \
-     rtl/rel5/support/cat-def.pcert0 \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/support/ash.pcert0 \
-     rtl/rel5/support/decode.pcert0 \
-     rtl/rel5/support/encode.pcert0 \
-     rtl/rel5/support/mulcat.pcert0 \
-     rtl/rel5/support/shft.pcert0 \
-     rtl/rel5/support/all-ones.pcert0 \
-     rtl/rel5/support/merge2.pcert0 \
-     rtl/rel5/support/logior1.pcert0 \
-     rtl/rel5/support/setbits.pcert0 \
-     rtl/rel5/support/setbitn.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/support/bias.pcert0 \
-     rtl/rel5/support/ereps.pcert0 \
-     rtl/rel5/support/ireps.pcert0 \
-     rtl/rel5/support/logeqv.pcert0 \
-     rtl/rel5/support/logorc1.pcert0 \
-     rtl/rel5/support/lognot.pcert0 \
-     rtl/rel5/support/logand.pcert0 \
-     rtl/rel5/support/logior.pcert0 \
-     rtl/rel5/support/logxor.pcert0 \
-     rtl/rel5/support/log.pcert0 \
-     rtl/rel5/support/lnot.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/support/lextra0.pcert0 \
-     rtl/rel5/support/logs.pcert0 \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/support/away.pcert0 \
-     rtl/rel5/support/near.pcert0 \
-     rtl/rel5/support/near+.pcert0 \
-     rtl/rel5/support/oddr.pcert0 \
-     rtl/rel5/support/sticky.pcert0 \
-     rtl/rel5/support/rnd.pcert0 \
-     rtl/rel5/support/drnd.pcert0 \
-     rtl/rel5/support/bits-trunc.pcert0 \
-     rtl/rel5/support/add3.pcert0 \
-     rtl/rel5/support/lop1.pcert0 \
-     rtl/rel5/support/lop2.pcert0 \
-     rtl/rel5/support/lop3.pcert0 \
-     rtl/rel5/support/stick.pcert0 \
-     rtl/rel5/support/bvecp-helpers.pcert0 \
-     rtl/rel5/support/model-helpers.pcert0 \
-     rtl/rel5/support/rom-helpers.pcert0 \
-     rtl/rel5/support/simple-loop-helpers.pcert0 \
-     rtl/rel5/support/clocks.pcert0 \
-     rtl/rel5/support/openers.pcert0 \
-     rtl/rel5/support/package-defs.pcert0 \
-     rtl/rel5/support/simplify-model-helpers.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/arithmetic/fp.pcert0 \
-     rtl/rel5/support/fadd.pcert0 \
-     rtl/rel5/support/top1.lisp
-rtl/rel5/support/top1.pcert1 : acl2x = 0
-rtl/rel5/support/top1.pcert1 : no_pcert = 0
-rtl/rel5/support/top1.pcert1 : rtl/rel5/support/top1.pcert0
-rtl/rel5/support/top1.cert : | rtl/rel5/support/top1.pcert1
-
-rtl/rel5/support/trunc-proofs.pcert0 : no_pcert = 0
-rtl/rel5/support/trunc-proofs.pcert0 : acl2x = 0
-rtl/rel5/support/trunc-proofs.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/float.pcert0 \
-     rtl/rel5/arithmetic/top.pcert0 \
-     rtl/rel5/support/trunc-proofs.lisp
-rtl/rel5/support/trunc-proofs.pcert1 : acl2x = 0
-rtl/rel5/support/trunc-proofs.pcert1 : no_pcert = 0
-rtl/rel5/support/trunc-proofs.pcert1 : rtl/rel5/support/trunc-proofs.pcert0
-rtl/rel5/support/trunc-proofs.cert : | rtl/rel5/support/trunc-proofs.pcert1
-
-rtl/rel5/support/trunc.pcert0 : no_pcert = 0
-rtl/rel5/support/trunc.pcert0 : acl2x = 0
-rtl/rel5/support/trunc.pcert0 : \
-     rtl/rel5/support/ground-zero.pcert0 \
-     rtl/rel5/support/trunc-proofs.pcert0 \
-     rtl/rel5/support/trunc.lisp
-rtl/rel5/support/trunc.pcert1 : acl2x = 0
-rtl/rel5/support/trunc.pcert1 : no_pcert = 0
-rtl/rel5/support/trunc.pcert1 : rtl/rel5/support/trunc.pcert0
-rtl/rel5/support/trunc.cert : | rtl/rel5/support/trunc.pcert1
-
-rtl/rel5/support/util.pcert0 : no_pcert = 0
-rtl/rel5/support/util.pcert0 : acl2x = 0
-rtl/rel5/support/util.pcert0 : \
-     rtl/rel5/support/util.lisp
-rtl/rel5/support/util.pcert1 : acl2x = 0
-rtl/rel5/support/util.pcert1 : no_pcert = 0
-rtl/rel5/support/util.pcert1 : rtl/rel5/support/util.pcert0
-rtl/rel5/support/util.cert : | rtl/rel5/support/util.pcert1
-
-rtl/rel5/user/away.pcert0 : no_pcert = 0
-rtl/rel5/user/away.pcert0 : acl2x = 0
-rtl/rel5/user/away.pcert0 : \
-     rtl/rel5/user/trunc.pcert0 \
-     rtl/rel5/support/away.pcert0 \
-     rtl/rel5/user/away.lisp
-rtl/rel5/user/away.pcert1 : acl2x = 0
-rtl/rel5/user/away.pcert1 : no_pcert = 0
-rtl/rel5/user/away.pcert1 : rtl/rel5/user/away.pcert0
-rtl/rel5/user/away.cert : | rtl/rel5/user/away.pcert1
-
-rtl/rel5/user/bias.pcert0 : no_pcert = 0
-rtl/rel5/user/bias.pcert0 : acl2x = 0
-rtl/rel5/user/bias.pcert0 : \
-     rtl/rel5/support/bias.pcert0 \
-     rtl/rel5/user/bias.lisp
-rtl/rel5/user/bias.pcert1 : acl2x = 0
-rtl/rel5/user/bias.pcert1 : no_pcert = 0
-rtl/rel5/user/bias.pcert1 : rtl/rel5/user/bias.pcert0
-rtl/rel5/user/bias.cert : | rtl/rel5/user/bias.pcert1
-
-rtl/rel5/user/bitn.pcert0 : no_pcert = 0
-rtl/rel5/user/bitn.pcert0 : acl2x = 0
-rtl/rel5/user/bitn.pcert0 : \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/support/bitn.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/bitn.lisp
-rtl/rel5/user/bitn.pcert1 : acl2x = 0
-rtl/rel5/user/bitn.pcert1 : no_pcert = 0
-rtl/rel5/user/bitn.pcert1 : rtl/rel5/user/bitn.pcert0
-rtl/rel5/user/bitn.cert : | rtl/rel5/user/bitn.pcert1
-
-rtl/rel5/user/bits-trunc.pcert0 : no_pcert = 0
-rtl/rel5/user/bits-trunc.pcert0 : acl2x = 0
-rtl/rel5/user/bits-trunc.pcert0 : \
-     rtl/rel5/user/land.pcert0 \
-     rtl/rel5/support/bits-trunc.pcert0 \
-     rtl/rel5/user/bits-trunc.lisp
-rtl/rel5/user/bits-trunc.pcert1 : acl2x = 0
-rtl/rel5/user/bits-trunc.pcert1 : no_pcert = 0
-rtl/rel5/user/bits-trunc.pcert1 : rtl/rel5/user/bits-trunc.pcert0
-rtl/rel5/user/bits-trunc.cert : | rtl/rel5/user/bits-trunc.pcert1
-
-rtl/rel5/user/bits.pcert0 : no_pcert = 0
-rtl/rel5/user/bits.pcert0 : acl2x = 0
-rtl/rel5/user/bits.pcert0 : \
-     rtl/rel5/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel5/arithmetic/power2p.pcert0 \
-     rtl/rel5/support/bits.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/bits.lisp
-rtl/rel5/user/bits.pcert1 : acl2x = 0
-rtl/rel5/user/bits.pcert1 : no_pcert = 0
-rtl/rel5/user/bits.pcert1 : rtl/rel5/user/bits.pcert0
-rtl/rel5/user/bits.cert : | rtl/rel5/user/bits.pcert1
-
-rtl/rel5/user/brat.pcert0 : no_pcert = 0
-rtl/rel5/user/brat.pcert0 : acl2x = 0
-rtl/rel5/user/brat.pcert0 : \
-     rtl/rel5/arithmetic/fl.pcert0 \
-     rtl/rel5/user/brat.lisp
-rtl/rel5/user/brat.pcert1 : acl2x = 0
-rtl/rel5/user/brat.pcert1 : no_pcert = 0
-rtl/rel5/user/brat.pcert1 : rtl/rel5/user/brat.pcert0
-rtl/rel5/user/brat.cert : | rtl/rel5/user/brat.pcert1
-
-rtl/rel5/user/bvecp.pcert0 : no_pcert = 0
-rtl/rel5/user/bvecp.pcert0 : acl2x = 0
-rtl/rel5/user/bvecp.pcert0 : \
-     rtl/rel5/support/bvecp.pcert0 \
-     rtl/rel5/user/bvecp.lisp
-rtl/rel5/user/bvecp.pcert1 : acl2x = 0
-rtl/rel5/user/bvecp.pcert1 : no_pcert = 0
-rtl/rel5/user/bvecp.pcert1 : rtl/rel5/user/bvecp.pcert0
-rtl/rel5/user/bvecp.cert : | rtl/rel5/user/bvecp.pcert1
-
-rtl/rel5/user/cat.pcert0 : no_pcert = 0
-rtl/rel5/user/cat.pcert0 : acl2x = 0
-rtl/rel5/user/cat.pcert0 : \
-     rtl/rel5/support/cat.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/cat.lisp
-rtl/rel5/user/cat.pcert1 : acl2x = 0
-rtl/rel5/user/cat.pcert1 : no_pcert = 0
-rtl/rel5/user/cat.pcert1 : rtl/rel5/user/cat.pcert0
-rtl/rel5/user/cat.cert : | rtl/rel5/user/cat.pcert1
-
-rtl/rel5/user/decode.pcert0 : no_pcert = 0
-rtl/rel5/user/decode.pcert0 : acl2x = 0
-rtl/rel5/user/decode.pcert0 : \
-     rtl/rel5/support/decode.pcert0 \
-     rtl/rel5/user/decode.lisp
-rtl/rel5/user/decode.pcert1 : acl2x = 0
-rtl/rel5/user/decode.pcert1 : no_pcert = 0
-rtl/rel5/user/decode.pcert1 : rtl/rel5/user/decode.pcert0
-rtl/rel5/user/decode.cert : | rtl/rel5/user/decode.pcert1
-
-rtl/rel5/user/ereps.pcert0 : no_pcert = 0
-rtl/rel5/user/ereps.pcert0 : acl2x = 0
-rtl/rel5/user/ereps.pcert0 : \
-     rtl/rel5/support/ereps.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/ereps.lisp
-rtl/rel5/user/ereps.pcert1 : acl2x = 0
-rtl/rel5/user/ereps.pcert1 : no_pcert = 0
-rtl/rel5/user/ereps.pcert1 : rtl/rel5/user/ereps.pcert0
-rtl/rel5/user/ereps.cert : | rtl/rel5/user/ereps.pcert1
-
-rtl/rel5/user/land.pcert0 : no_pcert = 0
-rtl/rel5/user/land.pcert0 : acl2x = 0
-rtl/rel5/user/land.pcert0 : \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/support/land0.pcert0 \
-     rtl/rel5/user/land.lisp
-rtl/rel5/user/land.pcert1 : acl2x = 0
-rtl/rel5/user/land.pcert1 : no_pcert = 0
-rtl/rel5/user/land.pcert1 : rtl/rel5/user/land.pcert0
-rtl/rel5/user/land.cert : | rtl/rel5/user/land.pcert1
-
-rtl/rel5/user/lextra.pcert0 : no_pcert = 0
-rtl/rel5/user/lextra.pcert0 : acl2x = 0
-rtl/rel5/user/lextra.pcert0 : \
-     rtl/rel5/user/land.pcert0 \
-     rtl/rel5/user/lior.pcert0 \
-     rtl/rel5/user/lxor.pcert0 \
-     rtl/rel5/support/lextra0.pcert0 \
-     rtl/rel5/user/lextra.lisp
-rtl/rel5/user/lextra.pcert1 : acl2x = 0
-rtl/rel5/user/lextra.pcert1 : no_pcert = 0
-rtl/rel5/user/lextra.pcert1 : rtl/rel5/user/lextra.pcert0
-rtl/rel5/user/lextra.cert : | rtl/rel5/user/lextra.pcert1
-
-rtl/rel5/user/lior.pcert0 : no_pcert = 0
-rtl/rel5/user/lior.pcert0 : acl2x = 0
-rtl/rel5/user/lior.pcert0 : \
-     rtl/rel5/support/lior0.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/lior.lisp
-rtl/rel5/user/lior.pcert1 : acl2x = 0
-rtl/rel5/user/lior.pcert1 : no_pcert = 0
-rtl/rel5/user/lior.pcert1 : rtl/rel5/user/lior.pcert0
-rtl/rel5/user/lior.cert : | rtl/rel5/user/lior.pcert1
-
-rtl/rel5/user/lnot.pcert0 : no_pcert = 0
-rtl/rel5/user/lnot.pcert0 : acl2x = 0
-rtl/rel5/user/lnot.pcert0 : \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/support/lnot.pcert0 \
-     rtl/rel5/user/lnot.lisp
-rtl/rel5/user/lnot.pcert1 : acl2x = 0
-rtl/rel5/user/lnot.pcert1 : no_pcert = 0
-rtl/rel5/user/lnot.pcert1 : rtl/rel5/user/lnot.pcert0
-rtl/rel5/user/lnot.cert : | rtl/rel5/user/lnot.pcert1
-
-rtl/rel5/user/logior1.pcert0 : no_pcert = 0
-rtl/rel5/user/logior1.pcert0 : acl2x = 0
-rtl/rel5/user/logior1.pcert0 : \
-     rtl/rel5/support/logior1.pcert0 \
-     rtl/rel5/user/logior1.lisp
-rtl/rel5/user/logior1.pcert1 : acl2x = 0
-rtl/rel5/user/logior1.pcert1 : no_pcert = 0
-rtl/rel5/user/logior1.pcert1 : rtl/rel5/user/logior1.pcert0
-rtl/rel5/user/logior1.cert : | rtl/rel5/user/logior1.pcert1
-
-rtl/rel5/user/lxor.pcert0 : no_pcert = 0
-rtl/rel5/user/lxor.pcert0 : acl2x = 0
-rtl/rel5/user/lxor.pcert0 : \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/support/lxor0.pcert0 \
-     rtl/rel5/user/lxor.lisp
-rtl/rel5/user/lxor.pcert1 : acl2x = 0
-rtl/rel5/user/lxor.pcert1 : no_pcert = 0
-rtl/rel5/user/lxor.pcert1 : rtl/rel5/user/lxor.pcert0
-rtl/rel5/user/lxor.cert : | rtl/rel5/user/lxor.pcert1
-
-rtl/rel5/user/mulcat.pcert0 : no_pcert = 0
-rtl/rel5/user/mulcat.pcert0 : acl2x = 0
-rtl/rel5/user/mulcat.pcert0 : \
-     rtl/rel5/support/mulcat.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/mulcat.lisp
-rtl/rel5/user/mulcat.pcert1 : acl2x = 0
-rtl/rel5/user/mulcat.pcert1 : no_pcert = 0
-rtl/rel5/user/mulcat.pcert1 : rtl/rel5/user/mulcat.pcert0
-rtl/rel5/user/mulcat.cert : | rtl/rel5/user/mulcat.pcert1
-
-rtl/rel5/user/near.pcert0 : no_pcert = 0
-rtl/rel5/user/near.pcert0 : acl2x = 0
-rtl/rel5/user/near.pcert0 : \
-     rtl/rel5/support/near.pcert0 \
-     rtl/rel5/user/near.lisp
-rtl/rel5/user/near.pcert1 : acl2x = 0
-rtl/rel5/user/near.pcert1 : no_pcert = 0
-rtl/rel5/user/near.pcert1 : rtl/rel5/user/near.pcert0
-rtl/rel5/user/near.cert : | rtl/rel5/user/near.pcert1
-
-rtl/rel5/user/setbitn.pcert0 : no_pcert = 0
-rtl/rel5/user/setbitn.pcert0 : acl2x = 0
-rtl/rel5/user/setbitn.pcert0 : \
-     rtl/rel5/support/setbitn.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/setbitn.lisp
-rtl/rel5/user/setbitn.pcert1 : acl2x = 0
-rtl/rel5/user/setbitn.pcert1 : no_pcert = 0
-rtl/rel5/user/setbitn.pcert1 : rtl/rel5/user/setbitn.pcert0
-rtl/rel5/user/setbitn.cert : | rtl/rel5/user/setbitn.pcert1
-
-rtl/rel5/user/setbits.pcert0 : no_pcert = 0
-rtl/rel5/user/setbits.pcert0 : acl2x = 0
-rtl/rel5/user/setbits.pcert0 : \
-     rtl/rel5/support/setbits.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/setbits.lisp
-rtl/rel5/user/setbits.pcert1 : acl2x = 0
-rtl/rel5/user/setbits.pcert1 : no_pcert = 0
-rtl/rel5/user/setbits.pcert1 : rtl/rel5/user/setbits.pcert0
-rtl/rel5/user/setbits.cert : | rtl/rel5/user/setbits.pcert1
-
-rtl/rel5/user/stick.pcert0 : no_pcert = 0
-rtl/rel5/user/stick.pcert0 : acl2x = 0
-rtl/rel5/user/stick.pcert0 : \
-     rtl/rel5/user/land.pcert0 \
-     rtl/rel5/user/lior.pcert0 \
-     rtl/rel5/user/lxor.pcert0 \
-     rtl/rel5/user/lnot.pcert0 \
-     rtl/rel5/support/stick.pcert0 \
-     rtl/rel5/user/stick.lisp
-rtl/rel5/user/stick.pcert1 : acl2x = 0
-rtl/rel5/user/stick.pcert1 : no_pcert = 0
-rtl/rel5/user/stick.pcert1 : rtl/rel5/user/stick.pcert0
-rtl/rel5/user/stick.cert : | rtl/rel5/user/stick.pcert1
-
-rtl/rel5/user/sumbits.pcert0 : no_pcert = 0
-rtl/rel5/user/sumbits.pcert0 : acl2x = 0
-rtl/rel5/user/sumbits.pcert0 : \
-     rtl/rel5/support/sumbits.pcert0 \
-     rtl/rel5/support/guards.pcert0 \
-     rtl/rel5/user/sumbits.lisp
-rtl/rel5/user/sumbits.pcert1 : acl2x = 0
-rtl/rel5/user/sumbits.pcert1 : no_pcert = 0
-rtl/rel5/user/sumbits.pcert1 : rtl/rel5/user/sumbits.pcert0
-rtl/rel5/user/sumbits.cert : | rtl/rel5/user/sumbits.pcert1
-
-rtl/rel5/user/top.pcert0 : no_pcert = 0
-rtl/rel5/user/top.pcert0 : acl2x = 0
-rtl/rel5/user/top.pcert0 : \
-     rtl/rel5/user/bits.pcert0 \
-     rtl/rel5/user/bitn.pcert0 \
-     rtl/rel5/user/cat.pcert0 \
-     rtl/rel5/user/bvecp.pcert0 \
-     rtl/rel5/user/mulcat.pcert0 \
-     rtl/rel5/user/logior1.pcert0 \
-     rtl/rel5/user/setbits.pcert0 \
-     rtl/rel5/user/setbitn.pcert0 \
-     rtl/rel5/user/bias.pcert0 \
-     rtl/rel5/user/ereps.pcert0 \
-     rtl/rel5/user/lnot.pcert0 \
-     rtl/rel5/user/land.pcert0 \
-     rtl/rel5/user/lior.pcert0 \
-     rtl/rel5/user/lxor.pcert0 \
-     rtl/rel5/user/lextra.pcert0 \
-     rtl/rel5/user/trunc.pcert0 \
-     rtl/rel5/user/away.pcert0 \
-     rtl/rel5/user/near.pcert0 \
-     rtl/rel5/user/bits-trunc.pcert0 \
-     rtl/rel5/user/stick.pcert0 \
-     rtl/rel5/user/sumbits.pcert0 \
-     rtl/rel5/user/top.lisp
-rtl/rel5/user/top.pcert1 : acl2x = 0
-rtl/rel5/user/top.pcert1 : no_pcert = 0
-rtl/rel5/user/top.pcert1 : rtl/rel5/user/top.pcert0
-rtl/rel5/user/top.cert : | rtl/rel5/user/top.pcert1
-
-rtl/rel5/user/trunc.pcert0 : no_pcert = 0
-rtl/rel5/user/trunc.pcert0 : acl2x = 0
-rtl/rel5/user/trunc.pcert0 : \
-     rtl/rel5/support/trunc.pcert0 \
-     rtl/rel5/user/trunc.lisp
-rtl/rel5/user/trunc.pcert1 : acl2x = 0
-rtl/rel5/user/trunc.pcert1 : no_pcert = 0
-rtl/rel5/user/trunc.pcert1 : rtl/rel5/user/trunc.pcert0
-rtl/rel5/user/trunc.cert : | rtl/rel5/user/trunc.pcert1
-
-rtl/rel8/arithmetic/arith.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/arith.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/arith.pcert0 : \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     rtl/rel8/arithmetic/arith.lisp
-rtl/rel8/arithmetic/arith.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/arith.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/arith.pcert1 : rtl/rel8/arithmetic/arith.pcert0
-rtl/rel8/arithmetic/arith.cert : | rtl/rel8/arithmetic/arith.pcert1
-
-rtl/rel8/arithmetic/arith2.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/arith2.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/arith2.pcert0 : \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/product.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     meta/meta-times-equal.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel8/arithmetic/inverted-factor.pcert0 \
-     rtl/rel8/arithmetic/arith2.lisp
-rtl/rel8/arithmetic/arith2.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/arith2.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/arith2.pcert1 : rtl/rel8/arithmetic/arith2.pcert0
-rtl/rel8/arithmetic/arith2.cert : | rtl/rel8/arithmetic/arith2.pcert1
-
-rtl/rel8/arithmetic/basic.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/basic.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/basic.pcert0 : \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/even-odd.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/basic.lisp
-rtl/rel8/arithmetic/basic.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/basic.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/basic.pcert1 : rtl/rel8/arithmetic/basic.pcert0
-rtl/rel8/arithmetic/basic.cert : | rtl/rel8/arithmetic/basic.pcert1
-
-rtl/rel8/arithmetic/cg.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/cg.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/cg.pcert0 : \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/common-factor.pcert0 \
-     rtl/rel8/arithmetic/cg.lisp
-rtl/rel8/arithmetic/cg.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/cg.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/cg.pcert1 : rtl/rel8/arithmetic/cg.pcert0
-rtl/rel8/arithmetic/cg.cert : | rtl/rel8/arithmetic/cg.pcert1
-
-rtl/rel8/arithmetic/common-factor-defuns.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/common-factor-defuns.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/common-factor-defuns.pcert0 : \
-     rtl/rel8/arithmetic/inverted-factor.pcert0 \
-     rtl/rel8/arithmetic/common-factor-defuns.lisp
-rtl/rel8/arithmetic/common-factor-defuns.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/common-factor-defuns.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/common-factor-defuns.pcert1 : rtl/rel8/arithmetic/common-factor-defuns.pcert0
-rtl/rel8/arithmetic/common-factor-defuns.cert : | rtl/rel8/arithmetic/common-factor-defuns.pcert1
-
-rtl/rel8/arithmetic/common-factor.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/common-factor.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/common-factor.pcert0 : \
-     meta/meta-times-equal.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel8/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/product.pcert0 \
-     rtl/rel8/arithmetic/common-factor.lisp
-rtl/rel8/arithmetic/common-factor.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/common-factor.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/common-factor.pcert1 : rtl/rel8/arithmetic/common-factor.pcert0
-rtl/rel8/arithmetic/common-factor.cert : | rtl/rel8/arithmetic/common-factor.pcert1
-
-rtl/rel8/arithmetic/complex-rationalp.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/complex-rationalp.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/complex-rationalp.pcert0 : \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/complex-rationalp.lisp
-rtl/rel8/arithmetic/complex-rationalp.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/complex-rationalp.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/complex-rationalp.pcert1 : rtl/rel8/arithmetic/complex-rationalp.pcert0
-rtl/rel8/arithmetic/complex-rationalp.cert : | rtl/rel8/arithmetic/complex-rationalp.pcert1
-
-rtl/rel8/arithmetic/denominator.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/denominator.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/denominator.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     arithmetic/mod-gcd.pcert0 \
-     rtl/rel8/arithmetic/denominator.lisp
-rtl/rel8/arithmetic/denominator.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/denominator.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/denominator.pcert1 : rtl/rel8/arithmetic/denominator.pcert0
-rtl/rel8/arithmetic/denominator.cert : | rtl/rel8/arithmetic/denominator.pcert1
-
-rtl/rel8/arithmetic/even-odd.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/even-odd.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/even-odd.pcert0 : \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/even-odd.lisp
-rtl/rel8/arithmetic/even-odd.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/even-odd.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/even-odd.pcert1 : rtl/rel8/arithmetic/even-odd.pcert0
-rtl/rel8/arithmetic/even-odd.cert : | rtl/rel8/arithmetic/even-odd.pcert1
-
-rtl/rel8/arithmetic/even-odd2-proofs.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/even-odd2-proofs.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/even-odd2-proofs.pcert0 : \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/arith.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/even-odd2-proofs.lisp
-rtl/rel8/arithmetic/even-odd2-proofs.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/even-odd2-proofs.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/even-odd2-proofs.pcert1 : rtl/rel8/arithmetic/even-odd2-proofs.pcert0
-rtl/rel8/arithmetic/even-odd2-proofs.cert : | rtl/rel8/arithmetic/even-odd2-proofs.pcert1
-
-rtl/rel8/arithmetic/even-odd2.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/even-odd2.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/even-odd2.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/even-odd2-proofs.pcert0 \
-     rtl/rel8/arithmetic/even-odd2.lisp
-rtl/rel8/arithmetic/even-odd2.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/even-odd2.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/even-odd2.pcert1 : rtl/rel8/arithmetic/even-odd2.pcert0
-rtl/rel8/arithmetic/even-odd2.cert : | rtl/rel8/arithmetic/even-odd2.pcert1
-
-rtl/rel8/arithmetic/expo-proofs.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/expo-proofs.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/expo-proofs.pcert0 : \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel8/arithmetic/common-factor.pcert0 \
-     rtl/rel8/arithmetic/expo-proofs.lisp
-rtl/rel8/arithmetic/expo-proofs.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/expo-proofs.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/expo-proofs.pcert1 : rtl/rel8/arithmetic/expo-proofs.pcert0
-rtl/rel8/arithmetic/expo-proofs.cert : | rtl/rel8/arithmetic/expo-proofs.pcert1
-
-rtl/rel8/arithmetic/expo.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/expo.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/expo.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/expo-proofs.pcert0 \
-     rtl/rel8/arithmetic/common-factor-defuns.pcert0 \
-     rtl/rel8/arithmetic/expo.lisp
-rtl/rel8/arithmetic/expo.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/expo.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/expo.pcert1 : rtl/rel8/arithmetic/expo.pcert0
-rtl/rel8/arithmetic/expo.cert : | rtl/rel8/arithmetic/expo.pcert1
-
-rtl/rel8/arithmetic/expt-proofs.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/expt-proofs.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/expt-proofs.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/numerator.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/even-odd.pcert0 \
-     rtl/rel8/arithmetic/expt-proofs.lisp
-rtl/rel8/arithmetic/expt-proofs.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/expt-proofs.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/expt-proofs.pcert1 : rtl/rel8/arithmetic/expt-proofs.pcert0
-rtl/rel8/arithmetic/expt-proofs.cert : | rtl/rel8/arithmetic/expt-proofs.pcert1
-
-rtl/rel8/arithmetic/expt.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/expt.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/expt.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/expt-proofs.pcert0 \
-     rtl/rel8/arithmetic/expt.lisp
-rtl/rel8/arithmetic/expt.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/expt.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/expt.pcert1 : rtl/rel8/arithmetic/expt.pcert0
-rtl/rel8/arithmetic/expt.cert : | rtl/rel8/arithmetic/expt.pcert1
-
-rtl/rel8/arithmetic/extra-rules.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/extra-rules.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/extra-rules.pcert0 : \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/arithmetic/extra-rules.lisp
-rtl/rel8/arithmetic/extra-rules.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/extra-rules.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/extra-rules.pcert1 : rtl/rel8/arithmetic/extra-rules.pcert0
-rtl/rel8/arithmetic/extra-rules.cert : | rtl/rel8/arithmetic/extra-rules.pcert1
-
-rtl/rel8/arithmetic/fl-expt.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/fl-expt.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/fl-expt.pcert0 : \
-     rtl/rel8/arithmetic/numerator.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/nniq.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/floor.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/rationalp.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/fl-expt.lisp
-rtl/rel8/arithmetic/fl-expt.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/fl-expt.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/fl-expt.pcert1 : rtl/rel8/arithmetic/fl-expt.pcert0
-rtl/rel8/arithmetic/fl-expt.cert : | rtl/rel8/arithmetic/fl-expt.pcert1
-
-rtl/rel8/arithmetic/fl-hacks.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/fl-hacks.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/fl-hacks.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/inverted-factor.pcert0 \
-     rtl/rel8/arithmetic/nniq.pcert0 \
-     rtl/rel8/arithmetic/numerator.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/product.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     rtl/rel8/arithmetic/rationalp.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/mod.pcert0 \
-     rtl/rel8/arithmetic/even-odd.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     rtl/rel8/arithmetic/arith.pcert0 \
-     rtl/rel8/arithmetic/fl-hacks.lisp
-rtl/rel8/arithmetic/fl-hacks.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/fl-hacks.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/fl-hacks.pcert1 : rtl/rel8/arithmetic/fl-hacks.pcert0
-rtl/rel8/arithmetic/fl-hacks.cert : | rtl/rel8/arithmetic/fl-hacks.pcert1
-
-rtl/rel8/arithmetic/fl-proofs.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/fl-proofs.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/fl-proofs.pcert0 : \
-     rtl/rel8/arithmetic/numerator.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/nniq.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/floor.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/rationalp.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     rtl/rel8/arithmetic/common-factor.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/fl-proofs.lisp
-rtl/rel8/arithmetic/fl-proofs.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/fl-proofs.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/fl-proofs.pcert1 : rtl/rel8/arithmetic/fl-proofs.pcert0
-rtl/rel8/arithmetic/fl-proofs.cert : | rtl/rel8/arithmetic/fl-proofs.pcert1
-
-rtl/rel8/arithmetic/fl.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/fl.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/fl.pcert0 : \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/fl-proofs.pcert0 \
-     rtl/rel8/arithmetic/fl.lisp
-rtl/rel8/arithmetic/fl.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/fl.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/fl.pcert1 : rtl/rel8/arithmetic/fl.pcert0
-rtl/rel8/arithmetic/fl.cert : | rtl/rel8/arithmetic/fl.pcert1
-
-rtl/rel8/arithmetic/floor-proofs.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/floor-proofs.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/floor-proofs.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/numerator.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/nniq.pcert0 \
-     rtl/rel8/arithmetic/product.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     rtl/rel8/arithmetic/rationalp.pcert0 \
-     rtl/rel8/arithmetic/inverted-factor.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel8/arithmetic/floor-proofs.lisp
-rtl/rel8/arithmetic/floor-proofs.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/floor-proofs.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/floor-proofs.pcert1 : rtl/rel8/arithmetic/floor-proofs.pcert0
-rtl/rel8/arithmetic/floor-proofs.cert : | rtl/rel8/arithmetic/floor-proofs.pcert1
-
-rtl/rel8/arithmetic/floor.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/floor.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/floor.pcert0 : \
-     rtl/rel8/arithmetic/floor-proofs.pcert0 \
-     rtl/rel8/arithmetic/floor.lisp
-rtl/rel8/arithmetic/floor.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/floor.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/floor.pcert1 : rtl/rel8/arithmetic/floor.pcert0
-rtl/rel8/arithmetic/floor.cert : | rtl/rel8/arithmetic/floor.pcert1
-
-rtl/rel8/arithmetic/fp.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/fp.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/fp.pcert0 : \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/fp.lisp
-rtl/rel8/arithmetic/fp.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/fp.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/fp.pcert1 : rtl/rel8/arithmetic/fp.pcert0
-rtl/rel8/arithmetic/fp.cert : | rtl/rel8/arithmetic/fp.pcert1
-
-rtl/rel8/arithmetic/fp2.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/fp2.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/fp2.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     arithmetic-2/meta/non-linear.pcert0 \
-     rtl/rel8/arithmetic/inverted-factor.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/arithmetic/fp2.lisp
-rtl/rel8/arithmetic/fp2.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/fp2.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/fp2.pcert1 : rtl/rel8/arithmetic/fp2.pcert0
-rtl/rel8/arithmetic/fp2.cert : | rtl/rel8/arithmetic/fp2.pcert1
-
-rtl/rel8/arithmetic/ground-zero.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/ground-zero.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/ground-zero.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.lisp
-rtl/rel8/arithmetic/ground-zero.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/ground-zero.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/ground-zero.pcert1 : rtl/rel8/arithmetic/ground-zero.pcert0
-rtl/rel8/arithmetic/ground-zero.cert : | rtl/rel8/arithmetic/ground-zero.pcert1
-
-rtl/rel8/arithmetic/hacks.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/hacks.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/hacks.pcert0 : \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/hacks.lisp
-rtl/rel8/arithmetic/hacks.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/hacks.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/hacks.pcert1 : rtl/rel8/arithmetic/hacks.pcert0
-rtl/rel8/arithmetic/hacks.cert : | rtl/rel8/arithmetic/hacks.pcert1
-
-rtl/rel8/arithmetic/induct.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/induct.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/induct.pcert0 : \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/induct.lisp
-rtl/rel8/arithmetic/induct.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/induct.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/induct.pcert1 : rtl/rel8/arithmetic/induct.pcert0
-rtl/rel8/arithmetic/induct.cert : | rtl/rel8/arithmetic/induct.pcert1
-
-rtl/rel8/arithmetic/integerp.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/integerp.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/integerp.pcert0 : \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/integerp.lisp
-rtl/rel8/arithmetic/integerp.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/integerp.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/integerp.pcert1 : rtl/rel8/arithmetic/integerp.pcert0
-rtl/rel8/arithmetic/integerp.cert : | rtl/rel8/arithmetic/integerp.pcert1
-
-rtl/rel8/arithmetic/inverted-factor.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/inverted-factor.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/inverted-factor.pcert0 : \
-     rtl/rel8/arithmetic/inverted-factor.lisp
-rtl/rel8/arithmetic/inverted-factor.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/inverted-factor.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/inverted-factor.pcert1 : rtl/rel8/arithmetic/inverted-factor.pcert0
-rtl/rel8/arithmetic/inverted-factor.cert : | rtl/rel8/arithmetic/inverted-factor.pcert1
-
-rtl/rel8/arithmetic/mod-expt.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/mod-expt.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/mod-expt.pcert0 : \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/numerator.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/nniq.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/floor.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/rationalp.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/arithmetic/fl-expt.pcert0 \
-     rtl/rel8/arithmetic/mod.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/mod-expt.lisp
-rtl/rel8/arithmetic/mod-expt.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/mod-expt.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/mod-expt.pcert1 : rtl/rel8/arithmetic/mod-expt.pcert0
-rtl/rel8/arithmetic/mod-expt.cert : | rtl/rel8/arithmetic/mod-expt.pcert1
-
-rtl/rel8/arithmetic/mod-proofs.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/mod-proofs.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/mod-proofs.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/floor.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/arith.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/product.pcert0 \
-     rtl/rel8/arithmetic/complex-rationalp.pcert0 \
-     meta/meta-plus-equal.pcert0 \
-     meta/meta-plus-lessp.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/rationalp.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/mod-proofs.lisp
-rtl/rel8/arithmetic/mod-proofs.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/mod-proofs.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/mod-proofs.pcert1 : rtl/rel8/arithmetic/mod-proofs.pcert0
-rtl/rel8/arithmetic/mod-proofs.cert : | rtl/rel8/arithmetic/mod-proofs.pcert1
-
-rtl/rel8/arithmetic/mod.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/mod.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/mod.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/mod-proofs.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/mod.lisp
-rtl/rel8/arithmetic/mod.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/mod.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/mod.pcert1 : rtl/rel8/arithmetic/mod.pcert0
-rtl/rel8/arithmetic/mod.cert : | rtl/rel8/arithmetic/mod.pcert1
-
-rtl/rel8/arithmetic/negative-syntaxp.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/negative-syntaxp.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/negative-syntaxp.pcert0 : \
-     rtl/rel8/arithmetic/negative-syntaxp.lisp
-rtl/rel8/arithmetic/negative-syntaxp.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/negative-syntaxp.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/negative-syntaxp.pcert1 : rtl/rel8/arithmetic/negative-syntaxp.pcert0
-rtl/rel8/arithmetic/negative-syntaxp.cert : | rtl/rel8/arithmetic/negative-syntaxp.pcert1
-
-rtl/rel8/arithmetic/nniq.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/nniq.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/nniq.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/numerator.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     rtl/rel8/arithmetic/product.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/arith.pcert0 \
-     arithmetic/rationals.pcert0 \
-     arithmetic/idiv.pcert0 \
-     arithmetic/idiv.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     rtl/rel8/arithmetic/nniq.lisp
-rtl/rel8/arithmetic/nniq.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/nniq.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/nniq.pcert1 : rtl/rel8/arithmetic/nniq.pcert0
-rtl/rel8/arithmetic/nniq.cert : | rtl/rel8/arithmetic/nniq.pcert1
-
-rtl/rel8/arithmetic/numerator.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/numerator.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/numerator.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/numerator.lisp
-rtl/rel8/arithmetic/numerator.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/numerator.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/numerator.pcert1 : rtl/rel8/arithmetic/numerator.pcert0
-rtl/rel8/arithmetic/numerator.cert : | rtl/rel8/arithmetic/numerator.pcert1
-
-rtl/rel8/arithmetic/power2p.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/power2p.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/power2p.pcert0 : \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/arithmetic/power2p.lisp
-rtl/rel8/arithmetic/power2p.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/power2p.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/power2p.pcert1 : rtl/rel8/arithmetic/power2p.pcert0
-rtl/rel8/arithmetic/power2p.cert : | rtl/rel8/arithmetic/power2p.pcert1
-
-rtl/rel8/arithmetic/predicate.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/predicate.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/predicate.pcert0 : \
-     rtl/rel8/arithmetic/predicate.lisp
-rtl/rel8/arithmetic/predicate.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/predicate.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/predicate.pcert1 : rtl/rel8/arithmetic/predicate.pcert0
-rtl/rel8/arithmetic/predicate.cert : | rtl/rel8/arithmetic/predicate.pcert1
-
-rtl/rel8/arithmetic/product-proofs.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/product-proofs.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/product-proofs.pcert0 : \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/product-proofs.lisp
-rtl/rel8/arithmetic/product-proofs.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/product-proofs.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/product-proofs.pcert1 : rtl/rel8/arithmetic/product-proofs.pcert0
-rtl/rel8/arithmetic/product-proofs.cert : | rtl/rel8/arithmetic/product-proofs.pcert1
-
-rtl/rel8/arithmetic/product.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/product.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/product.pcert0 : \
-     rtl/rel8/arithmetic/product-proofs.pcert0 \
-     rtl/rel8/arithmetic/product.lisp
-rtl/rel8/arithmetic/product.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/product.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/product.pcert1 : rtl/rel8/arithmetic/product.pcert0
-rtl/rel8/arithmetic/product.cert : | rtl/rel8/arithmetic/product.pcert1
-
-rtl/rel8/arithmetic/rationalp.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/rationalp.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/rationalp.pcert0 : \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/rationalp.lisp
-rtl/rel8/arithmetic/rationalp.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/rationalp.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/rationalp.pcert1 : rtl/rel8/arithmetic/rationalp.pcert0
-rtl/rel8/arithmetic/rationalp.cert : | rtl/rel8/arithmetic/rationalp.pcert1
-
-rtl/rel8/arithmetic/top.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/top.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/top.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/induct.pcert0 \
-     rtl/rel8/arithmetic/denominator.pcert0 \
-     rtl/rel8/arithmetic/numerator.pcert0 \
-     rtl/rel8/arithmetic/nniq.pcert0 \
-     rtl/rel8/arithmetic/complex-rationalp.pcert0 \
-     rtl/rel8/arithmetic/rationalp.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/arith.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.pcert0 \
-     rtl/rel8/arithmetic/product.pcert0 \
-     rtl/rel8/arithmetic/inverted-factor.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/x-2xx.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/arithmetic/fl-hacks.pcert0 \
-     rtl/rel8/arithmetic/even-odd2.pcert0 \
-     rtl/rel8/arithmetic/even-odd.pcert0 \
-     rtl/rel8/arithmetic/floor.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/cg.pcert0 \
-     rtl/rel8/arithmetic/mod.pcert0 \
-     rtl/rel8/arithmetic/fl-expt.pcert0 \
-     rtl/rel8/arithmetic/mod-expt.pcert0 \
-     rtl/rel8/arithmetic/common-factor.pcert0 \
-     rtl/rel8/arithmetic/top.lisp
-rtl/rel8/arithmetic/top.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/top.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/top.pcert1 : rtl/rel8/arithmetic/top.pcert0
-rtl/rel8/arithmetic/top.cert : | rtl/rel8/arithmetic/top.pcert1
-
-rtl/rel8/arithmetic/unary-divide.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/unary-divide.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/unary-divide.pcert0 : \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/inverted-factor.pcert0 \
-     rtl/rel8/arithmetic/unary-divide.lisp
-rtl/rel8/arithmetic/unary-divide.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/unary-divide.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/unary-divide.pcert1 : rtl/rel8/arithmetic/unary-divide.pcert0
-rtl/rel8/arithmetic/unary-divide.cert : | rtl/rel8/arithmetic/unary-divide.pcert1
-
-rtl/rel8/arithmetic/x-2xx.pcert0 : no_pcert = 0
-rtl/rel8/arithmetic/x-2xx.pcert0 : acl2x = 0
-rtl/rel8/arithmetic/x-2xx.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/mod-gcd.pcert0 \
-     rtl/rel8/arithmetic/x-2xx.lisp
-rtl/rel8/arithmetic/x-2xx.pcert1 : acl2x = 0
-rtl/rel8/arithmetic/x-2xx.pcert1 : no_pcert = 0
-rtl/rel8/arithmetic/x-2xx.pcert1 : rtl/rel8/arithmetic/x-2xx.pcert0
-rtl/rel8/arithmetic/x-2xx.cert : | rtl/rel8/arithmetic/x-2xx.pcert1
-
-rtl/rel8/lib/add.pcert0 : no_pcert = 0
-rtl/rel8/lib/add.pcert0 : acl2x = 0
-rtl/rel8/lib/add.pcert0 : \
-     rtl/rel8/lib/round.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/add.lisp
-rtl/rel8/lib/add.pcert1 : acl2x = 0
-rtl/rel8/lib/add.pcert1 : no_pcert = 0
-rtl/rel8/lib/add.pcert1 : rtl/rel8/lib/add.pcert0
-rtl/rel8/lib/add.cert : | rtl/rel8/lib/add.pcert1
-
-rtl/rel8/lib/arith.pcert0 : no_pcert = 0
-rtl/rel8/lib/arith.pcert0 : acl2x = 0
-rtl/rel8/lib/arith.pcert0 : \
-     rtl/rel8/support/top/top.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/lib/arith.lisp
-rtl/rel8/lib/arith.pcert1 : acl2x = 0
-rtl/rel8/lib/arith.pcert1 : no_pcert = 0
-rtl/rel8/lib/arith.pcert1 : rtl/rel8/lib/arith.pcert0
-rtl/rel8/lib/arith.cert : | rtl/rel8/lib/arith.pcert1
-
-rtl/rel8/lib/basic.pcert0 : no_pcert = 0
-rtl/rel8/lib/basic.pcert0 : acl2x = 0
-rtl/rel8/lib/basic.pcert0 : \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/basic.lisp
-rtl/rel8/lib/basic.pcert1 : acl2x = 0
-rtl/rel8/lib/basic.pcert1 : no_pcert = 0
-rtl/rel8/lib/basic.pcert1 : rtl/rel8/lib/basic.pcert0
-rtl/rel8/lib/basic.cert : | rtl/rel8/lib/basic.pcert1
-
-rtl/rel8/lib/bits.pcert0 : no_pcert = 0
-rtl/rel8/lib/bits.pcert0 : acl2x = 0
-rtl/rel8/lib/bits.pcert0 : \
-     rtl/rel8/lib/basic.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/bits.lisp
-rtl/rel8/lib/bits.pcert1 : acl2x = 0
-rtl/rel8/lib/bits.pcert1 : no_pcert = 0
-rtl/rel8/lib/bits.pcert1 : rtl/rel8/lib/bits.pcert0
-rtl/rel8/lib/bits.cert : | rtl/rel8/lib/bits.pcert1
-
-rtl/rel8/lib/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel8/lib/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel8/lib/bvecp-helpers.pcert0 : \
-     rtl/rel8/lib/rtl.pcert0 \
-     rtl/rel8/lib/rtlarr.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/bvecp-helpers.lisp
-rtl/rel8/lib/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel8/lib/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel8/lib/bvecp-helpers.pcert1 : rtl/rel8/lib/bvecp-helpers.pcert0
-rtl/rel8/lib/bvecp-helpers.cert : | rtl/rel8/lib/bvecp-helpers.pcert1
-
-rtl/rel8/lib/bvecp-raw-helpers.pcert0 : no_pcert = 0
-rtl/rel8/lib/bvecp-raw-helpers.pcert0 : acl2x = 0
-rtl/rel8/lib/bvecp-raw-helpers.pcert0 : \
-     rtl/rel8/lib/rtl.pcert0 \
-     rtl/rel8/lib/rtlarr.pcert0 \
-     rtl/rel8/lib/bits.pcert0 \
-     rtl/rel8/lib/float.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/bvecp-raw-helpers.lisp
-rtl/rel8/lib/bvecp-raw-helpers.pcert1 : acl2x = 0
-rtl/rel8/lib/bvecp-raw-helpers.pcert1 : no_pcert = 0
-rtl/rel8/lib/bvecp-raw-helpers.pcert1 : rtl/rel8/lib/bvecp-raw-helpers.pcert0
-rtl/rel8/lib/bvecp-raw-helpers.cert : | rtl/rel8/lib/bvecp-raw-helpers.pcert1
-
-rtl/rel8/lib/clocks.pcert0 : no_pcert = 0
-rtl/rel8/lib/clocks.pcert0 : acl2x = 0
-rtl/rel8/lib/clocks.pcert0 : \
-     rtl/rel8/support/support/clocks.pcert0 \
-     rtl/rel8/lib/clocks.lisp
-rtl/rel8/lib/clocks.pcert1 : acl2x = 0
-rtl/rel8/lib/clocks.pcert1 : no_pcert = 0
-rtl/rel8/lib/clocks.pcert1 : rtl/rel8/lib/clocks.pcert0
-rtl/rel8/lib/clocks.cert : | rtl/rel8/lib/clocks.pcert1
-
-rtl/rel8/lib/float.pcert0 : no_pcert = 0
-rtl/rel8/lib/float.pcert0 : acl2x = 0
-rtl/rel8/lib/float.pcert0 : \
-     rtl/rel8/lib/log.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/float.lisp
-rtl/rel8/lib/float.pcert1 : acl2x = 0
-rtl/rel8/lib/float.pcert1 : no_pcert = 0
-rtl/rel8/lib/float.pcert1 : rtl/rel8/lib/float.pcert0
-rtl/rel8/lib/float.cert : | rtl/rel8/lib/float.pcert1
-
-rtl/rel8/lib/log.pcert0 : no_pcert = 0
-rtl/rel8/lib/log.pcert0 : acl2x = 0
-rtl/rel8/lib/log.pcert0 : \
-     rtl/rel8/lib/basic.pcert0 \
-     rtl/rel8/lib/bits.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/log.lisp
-rtl/rel8/lib/log.pcert1 : acl2x = 0
-rtl/rel8/lib/log.pcert1 : no_pcert = 0
-rtl/rel8/lib/log.pcert1 : rtl/rel8/lib/log.pcert0
-rtl/rel8/lib/log.cert : | rtl/rel8/lib/log.pcert1
-
-rtl/rel8/lib/logn.pcert0 : no_pcert = 0
-rtl/rel8/lib/logn.pcert0 : acl2x = 0
-rtl/rel8/lib/logn.pcert0 : \
-     rtl/rel8/lib/bits.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/logn.lisp
-rtl/rel8/lib/logn.pcert1 : acl2x = 0
-rtl/rel8/lib/logn.pcert1 : no_pcert = 0
-rtl/rel8/lib/logn.pcert1 : rtl/rel8/lib/logn.pcert0
-rtl/rel8/lib/logn.cert : | rtl/rel8/lib/logn.pcert1
-
-rtl/rel8/lib/logn2log.pcert0 : no_pcert = 0
-rtl/rel8/lib/logn2log.pcert0 : acl2x = 0
-rtl/rel8/lib/logn2log.pcert0 : \
-     rtl/rel8/lib/log.pcert0 \
-     rtl/rel8/lib/logn.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/logn2log.lisp
-rtl/rel8/lib/logn2log.pcert1 : acl2x = 0
-rtl/rel8/lib/logn2log.pcert1 : no_pcert = 0
-rtl/rel8/lib/logn2log.pcert1 : rtl/rel8/lib/logn2log.pcert0
-rtl/rel8/lib/logn2log.cert : | rtl/rel8/lib/logn2log.pcert1
-
-rtl/rel8/lib/mult.pcert0 : no_pcert = 0
-rtl/rel8/lib/mult.pcert0 : acl2x = 0
-rtl/rel8/lib/mult.pcert0 : \
-     rtl/rel8/lib/add.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/mult.lisp
-rtl/rel8/lib/mult.pcert1 : acl2x = 0
-rtl/rel8/lib/mult.pcert1 : no_pcert = 0
-rtl/rel8/lib/mult.pcert1 : rtl/rel8/lib/mult.pcert0
-rtl/rel8/lib/mult.cert : | rtl/rel8/lib/mult.pcert1
-
-rtl/rel8/lib/openers.pcert0 : no_pcert = 0
-rtl/rel8/lib/openers.pcert0 : acl2x = 0
-rtl/rel8/lib/openers.pcert0 : \
-     rtl/rel8/support/support/openers.pcert0 \
-     rtl/rel8/lib/openers.lisp
-rtl/rel8/lib/openers.pcert1 : acl2x = 0
-rtl/rel8/lib/openers.pcert1 : no_pcert = 0
-rtl/rel8/lib/openers.pcert1 : rtl/rel8/lib/openers.pcert0
-rtl/rel8/lib/openers.cert : | rtl/rel8/lib/openers.pcert1
-
-rtl/rel8/lib/package-defs.pcert0 : no_pcert = 0
-rtl/rel8/lib/package-defs.pcert0 : acl2x = 0
-rtl/rel8/lib/package-defs.pcert0 : \
-     rtl/rel8/support/support/package-defs.pcert0 \
-     rtl/rel8/lib/package-defs.lisp
-rtl/rel8/lib/package-defs.pcert1 : acl2x = 0
-rtl/rel8/lib/package-defs.pcert1 : no_pcert = 0
-rtl/rel8/lib/package-defs.pcert1 : rtl/rel8/lib/package-defs.pcert0
-rtl/rel8/lib/package-defs.cert : | rtl/rel8/lib/package-defs.pcert1
-
-rtl/rel8/lib/reps.pcert0 : no_pcert = 0
-rtl/rel8/lib/reps.pcert0 : acl2x = 0
-rtl/rel8/lib/reps.pcert0 : \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/log.pcert0 \
-     rtl/rel8/lib/float.pcert0 \
-     rtl/rel8/lib/reps.lisp
-rtl/rel8/lib/reps.pcert1 : acl2x = 0
-rtl/rel8/lib/reps.pcert1 : no_pcert = 0
-rtl/rel8/lib/reps.pcert1 : rtl/rel8/lib/reps.pcert0
-rtl/rel8/lib/reps.cert : | rtl/rel8/lib/reps.pcert1
-
-rtl/rel8/lib/rom-helpers.pcert0 : no_pcert = 0
-rtl/rel8/lib/rom-helpers.pcert0 : acl2x = 0
-rtl/rel8/lib/rom-helpers.pcert0 : \
-     rtl/rel8/support/support/rom-helpers.pcert0 \
-     rtl/rel8/lib/rom-helpers.lisp
-rtl/rel8/lib/rom-helpers.pcert1 : acl2x = 0
-rtl/rel8/lib/rom-helpers.pcert1 : no_pcert = 0
-rtl/rel8/lib/rom-helpers.pcert1 : rtl/rel8/lib/rom-helpers.pcert0
-rtl/rel8/lib/rom-helpers.cert : | rtl/rel8/lib/rom-helpers.pcert1
-
-rtl/rel8/lib/round.pcert0 : no_pcert = 0
-rtl/rel8/lib/round.pcert0 : acl2x = 0
-rtl/rel8/lib/round.pcert0 : \
-     rtl/rel8/lib/float.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/round.lisp
-rtl/rel8/lib/round.pcert1 : acl2x = 0
-rtl/rel8/lib/round.pcert1 : no_pcert = 0
-rtl/rel8/lib/round.pcert1 : rtl/rel8/lib/round.pcert0
-rtl/rel8/lib/round.cert : | rtl/rel8/lib/round.pcert1
-
-rtl/rel8/lib/rtl.pcert0 : no_pcert = 0
-rtl/rel8/lib/rtl.pcert0 : acl2x = 0
-rtl/rel8/lib/rtl.pcert0 : \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/rtl.lisp
-rtl/rel8/lib/rtl.pcert1 : acl2x = 0
-rtl/rel8/lib/rtl.pcert1 : no_pcert = 0
-rtl/rel8/lib/rtl.pcert1 : rtl/rel8/lib/rtl.pcert0
-rtl/rel8/lib/rtl.cert : | rtl/rel8/lib/rtl.pcert1
-
-rtl/rel8/lib/rtlarr.pcert0 : no_pcert = 0
-rtl/rel8/lib/rtlarr.pcert0 : acl2x = 0
-rtl/rel8/lib/rtlarr.pcert0 : \
-     rtl/rel8/support/top/top.pcert0 \
-     misc/total-order.pcert0 \
-     rtl/rel8/lib/rtl.pcert0 \
-     rtl/rel8/lib/rtlarr.lisp
-rtl/rel8/lib/rtlarr.pcert1 : acl2x = 0
-rtl/rel8/lib/rtlarr.pcert1 : no_pcert = 0
-rtl/rel8/lib/rtlarr.pcert1 : rtl/rel8/lib/rtlarr.pcert0
-rtl/rel8/lib/rtlarr.cert : | rtl/rel8/lib/rtlarr.pcert1
-
-rtl/rel8/lib/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel8/lib/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel8/lib/simple-loop-helpers.pcert0 : \
-     rtl/rel8/lib/rtl.pcert0 \
-     rtl/rel8/lib/rtlarr.pcert0 \
-     rtl/rel8/lib/log.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/simple-loop-helpers.lisp
-rtl/rel8/lib/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel8/lib/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel8/lib/simple-loop-helpers.pcert1 : rtl/rel8/lib/simple-loop-helpers.pcert0
-rtl/rel8/lib/simple-loop-helpers.cert : | rtl/rel8/lib/simple-loop-helpers.pcert1
-
-rtl/rel8/lib/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel8/lib/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel8/lib/simplify-model-helpers.pcert0 : \
-     rtl/rel8/lib/rtl.pcert0 \
-     rtl/rel8/lib/arith.pcert0 \
-     rtl/rel8/lib/bits.pcert0 \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/simplify-model-helpers.lisp
-rtl/rel8/lib/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel8/lib/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel8/lib/simplify-model-helpers.pcert1 : rtl/rel8/lib/simplify-model-helpers.pcert0
-rtl/rel8/lib/simplify-model-helpers.cert : | rtl/rel8/lib/simplify-model-helpers.pcert1
-
-rtl/rel8/lib/top.pcert0 : no_pcert = 0
-rtl/rel8/lib/top.pcert0 : acl2x = 0
-rtl/rel8/lib/top.pcert0 : \
-     rtl/rel8/lib/rtl.pcert0 \
-     rtl/rel8/lib/rtlarr.pcert0 \
-     rtl/rel8/lib/basic.pcert0 \
-     rtl/rel8/lib/bits.pcert0 \
-     rtl/rel8/lib/log.pcert0 \
-     rtl/rel8/lib/float.pcert0 \
-     rtl/rel8/lib/reps.pcert0 \
-     rtl/rel8/lib/round.pcert0 \
-     rtl/rel8/lib/add.pcert0 \
-     rtl/rel8/lib/mult.pcert0 \
-     rtl/rel8/lib/arith.pcert0 \
-     rtl/rel8/lib/util.pcert0 \
-     rtl/rel8/lib/top.lisp
-rtl/rel8/lib/top.pcert1 : acl2x = 0
-rtl/rel8/lib/top.pcert1 : no_pcert = 0
-rtl/rel8/lib/top.pcert1 : rtl/rel8/lib/top.pcert0
-rtl/rel8/lib/top.cert : | rtl/rel8/lib/top.pcert1
-
-rtl/rel8/lib/util.pcert0 : no_pcert = 0
-rtl/rel8/lib/util.pcert0 : acl2x = 0
-rtl/rel8/lib/util.pcert0 : \
-     rtl/rel8/support/top/top.pcert0 \
-     rtl/rel8/lib/util.lisp
-rtl/rel8/lib/util.pcert1 : acl2x = 0
-rtl/rel8/lib/util.pcert1 : no_pcert = 0
-rtl/rel8/lib/util.pcert1 : rtl/rel8/lib/util.pcert0
-rtl/rel8/lib/util.cert : | rtl/rel8/lib/util.pcert1
-
-rtl/rel8/support/lib1.delta1/arith-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/arith-extra.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/arith-extra.pcert0 : \
-     rtl/rel8/support/lib1/arith.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib1.delta1/arith-extra.lisp
-rtl/rel8/support/lib1.delta1/arith-extra.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/arith-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/arith-extra.pcert1 : rtl/rel8/support/lib1.delta1/arith-extra.pcert0
-rtl/rel8/support/lib1.delta1/arith-extra.cert : | rtl/rel8/support/lib1.delta1/arith-extra.pcert1
-
-rtl/rel8/support/lib1.delta1/arith.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/arith.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/arith.pcert0 : \
-     rtl/rel8/support/lib1/arith.pcert0 \
-     rtl/rel8/support/lib1.delta1/arith-extra.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/support/lib1.delta1/arith.lisp
-rtl/rel8/support/lib1.delta1/arith.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/arith.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/arith.pcert1 : rtl/rel8/support/lib1.delta1/arith.pcert0
-rtl/rel8/support/lib1.delta1/arith.cert : | rtl/rel8/support/lib1.delta1/arith.pcert1
-
-rtl/rel8/support/lib1.delta1/basic-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/basic-extra.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/basic-extra.pcert0 : \
-     rtl/rel8/support/lib1/basic.pcert0 \
-     rtl/rel8/arithmetic/floor.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib1.delta1/basic-extra.lisp
-rtl/rel8/support/lib1.delta1/basic-extra.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/basic-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/basic-extra.pcert1 : rtl/rel8/support/lib1.delta1/basic-extra.pcert0
-rtl/rel8/support/lib1.delta1/basic-extra.cert : | rtl/rel8/support/lib1.delta1/basic-extra.pcert1
-
-rtl/rel8/support/lib1.delta1/basic.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/basic.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/basic.pcert0 : \
-     rtl/rel8/support/lib1/basic.pcert0 \
-     rtl/rel8/support/lib1.delta1/basic-extra.pcert0 \
-     rtl/rel8/support/lib1.delta1/basic.lisp
-rtl/rel8/support/lib1.delta1/basic.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/basic.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/basic.pcert1 : rtl/rel8/support/lib1.delta1/basic.pcert0
-rtl/rel8/support/lib1.delta1/basic.cert : | rtl/rel8/support/lib1.delta1/basic.pcert1
-
-rtl/rel8/support/lib1.delta1/bits-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/bits-extra.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/bits-extra.pcert0 : \
-     rtl/rel8/support/lib1/top.pcert0 \
-     rtl/rel8/support/lib1.delta1/bits-extra.lisp
-rtl/rel8/support/lib1.delta1/bits-extra.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/bits-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/bits-extra.pcert1 : rtl/rel8/support/lib1.delta1/bits-extra.pcert0
-rtl/rel8/support/lib1.delta1/bits-extra.cert : | rtl/rel8/support/lib1.delta1/bits-extra.pcert1
-
-rtl/rel8/support/lib1.delta1/bits.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/bits.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/bits.pcert0 : \
-     rtl/rel8/support/lib1/bits.pcert0 \
-     rtl/rel8/support/lib1.delta1/bits-extra.pcert0 \
-     rtl/rel8/support/lib1.delta1/bits.lisp
-rtl/rel8/support/lib1.delta1/bits.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/bits.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/bits.pcert1 : rtl/rel8/support/lib1.delta1/bits.pcert0
-rtl/rel8/support/lib1.delta1/bits.cert : | rtl/rel8/support/lib1.delta1/bits.pcert1
-
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/bits.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.lisp
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert1 : rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.cert : | rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert1
-
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.pcert0 \
-     rtl/rel8/support/lib1/bvecp-raw-helpers.pcert0 \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.pcert0 \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.lisp
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert1 : rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert0
-rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.cert : | rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert1
-
-rtl/rel8/support/lib1.delta1/float-extra2.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/float-extra2.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/float-extra2.pcert0 : \
-     rtl/rel8/support/lib1/top.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/support/lib1.delta1/float-extra2.lisp
-rtl/rel8/support/lib1.delta1/float-extra2.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/float-extra2.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/float-extra2.pcert1 : rtl/rel8/support/lib1.delta1/float-extra2.pcert0
-rtl/rel8/support/lib1.delta1/float-extra2.cert : | rtl/rel8/support/lib1.delta1/float-extra2.pcert1
-
-rtl/rel8/support/lib1.delta1/float.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/float.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/float.pcert0 : \
-     rtl/rel8/support/lib1/log.pcert0 \
-     rtl/rel8/support/lib1/float.pcert0 \
-     rtl/rel8/support/lib1.delta1/float-extra2.pcert0 \
-     rtl/rel8/support/lib1.delta1/float.lisp
-rtl/rel8/support/lib1.delta1/float.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/float.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/float.pcert1 : rtl/rel8/support/lib1.delta1/float.pcert0
-rtl/rel8/support/lib1.delta1/float.cert : | rtl/rel8/support/lib1.delta1/float.pcert1
-
-rtl/rel8/support/lib1.delta1/mult-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/mult-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/mult-proofs.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/sumbits.pcert0 \
-     rtl/rel8/support/support/util.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/lior.pcert0 \
-     rtl/rel8/support/support/land.pcert0 \
-     rtl/rel8/support/support/lxor.pcert0 \
-     rtl/rel8/support/lib1.delta1/mult-proofs.lisp \
-     rtl/rel8/support/lib1.delta1/mult-proofs.acl2
-rtl/rel8/support/lib1.delta1/mult-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/mult-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/mult-proofs.pcert1 : rtl/rel8/support/lib1.delta1/mult-proofs.pcert0
-rtl/rel8/support/lib1.delta1/mult-proofs.cert : | rtl/rel8/support/lib1.delta1/mult-proofs.pcert1
-
-rtl/rel8/support/lib1.delta1/mult.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/mult.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/mult.pcert0 : \
-     rtl/rel8/support/lib1/add.pcert0 \
-     rtl/rel8/support/lib1.delta1/mult-proofs.pcert0 \
-     rtl/rel8/support/lib1.delta1/mult.lisp
-rtl/rel8/support/lib1.delta1/mult.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/mult.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/mult.pcert1 : rtl/rel8/support/lib1.delta1/mult.pcert0
-rtl/rel8/support/lib1.delta1/mult.cert : | rtl/rel8/support/lib1.delta1/mult.pcert1
-
-rtl/rel8/support/lib1.delta1/round-extra2.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/round-extra2.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/round-extra2.pcert0 : \
-     rtl/rel8/support/lib1/top.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/arithmetic/even-odd.pcert0 \
-     rtl/rel8/support/support/away.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/support/lib1.delta1/float-extra2.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/support/lib1.delta1/round-extra2.lisp
-rtl/rel8/support/lib1.delta1/round-extra2.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/round-extra2.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/round-extra2.pcert1 : rtl/rel8/support/lib1.delta1/round-extra2.pcert0
-rtl/rel8/support/lib1.delta1/round-extra2.cert : | rtl/rel8/support/lib1.delta1/round-extra2.pcert1
-
-rtl/rel8/support/lib1.delta1/round.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/round.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/round.pcert0 : \
-     rtl/rel8/support/lib1.delta1/float.pcert0 \
-     rtl/rel8/support/lib1/round.pcert0 \
-     rtl/rel8/support/lib1.delta1/round-extra2.pcert0 \
-     rtl/rel8/support/lib1.delta1/round.lisp
-rtl/rel8/support/lib1.delta1/round.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/round.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/round.pcert1 : rtl/rel8/support/lib1.delta1/round.pcert0
-rtl/rel8/support/lib1.delta1/round.cert : | rtl/rel8/support/lib1.delta1/round.pcert1
-
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.pcert0 \
-     rtl/rel8/support/lib1/bits.pcert0 \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.lisp
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert1 : rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.cert : | rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert1
-
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.pcert0 \
-     rtl/rel8/support/lib1.delta1/arith.pcert0 \
-     rtl/rel8/support/lib1/log.pcert0 \
-     rtl/rel8/support/lib1/simple-loop-helpers.pcert0 \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.pcert0 \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers.lisp
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert1 : rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert0
-rtl/rel8/support/lib1.delta1/simple-loop-helpers.cert : | rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert1
-
-rtl/rel8/support/lib1.delta2/float-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta2/float-extra.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta2/float-extra.pcert0 : \
-     rtl/rel8/support/lib1/top.pcert0 \
-     rtl/rel8/support/lib1.delta2/float-extra.lisp
-rtl/rel8/support/lib1.delta2/float-extra.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta2/float-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta2/float-extra.pcert1 : rtl/rel8/support/lib1.delta2/float-extra.pcert0
-rtl/rel8/support/lib1.delta2/float-extra.cert : | rtl/rel8/support/lib1.delta2/float-extra.pcert1
-
-rtl/rel8/support/lib1.delta2/float.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1.delta2/float.pcert0 : acl2x = 0
-rtl/rel8/support/lib1.delta2/float.pcert0 : \
-     rtl/rel8/support/lib1/log.pcert0 \
-     rtl/rel8/support/lib1.delta1/float.pcert0 \
-     rtl/rel8/support/lib1.delta2/float-extra.pcert0 \
-     rtl/rel8/support/lib1.delta2/float.lisp
-rtl/rel8/support/lib1.delta2/float.pcert1 : acl2x = 0
-rtl/rel8/support/lib1.delta2/float.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1.delta2/float.pcert1 : rtl/rel8/support/lib1.delta2/float.pcert0
-rtl/rel8/support/lib1.delta2/float.cert : | rtl/rel8/support/lib1.delta2/float.pcert1
-
-rtl/rel8/support/lib1/add.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/add.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/add.pcert0 : \
-     rtl/rel8/support/lib1/round.pcert0 \
-     rtl/rel8/support/support/top.pcert0 \
-     rtl/rel8/support/lib1/add.lisp
-rtl/rel8/support/lib1/add.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/add.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/add.pcert1 : rtl/rel8/support/lib1/add.pcert0
-rtl/rel8/support/lib1/add.cert : | rtl/rel8/support/lib1/add.pcert1
-
-rtl/rel8/support/lib1/arith.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/arith.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/arith.pcert0 : \
-     rtl/rel8/arithmetic/fp.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/arithmetic/extra-rules.pcert0 \
-     rtl/rel8/support/support/ash.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/support/lib1/arith.lisp
-rtl/rel8/support/lib1/arith.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/arith.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/arith.pcert1 : rtl/rel8/support/lib1/arith.pcert0
-rtl/rel8/support/lib1/arith.cert : | rtl/rel8/support/lib1/arith.pcert1
-
-rtl/rel8/support/lib1/basic.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/basic.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/basic.pcert0 : \
-     rtl/rel8/support/support/top.pcert0 \
-     rtl/rel8/support/lib1/basic.lisp
-rtl/rel8/support/lib1/basic.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/basic.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/basic.pcert1 : rtl/rel8/support/lib1/basic.pcert0
-rtl/rel8/support/lib1/basic.cert : | rtl/rel8/support/lib1/basic.pcert1
-
-rtl/rel8/support/lib1/bits.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/bits.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/bits.pcert0 : \
-     rtl/rel8/support/lib1/basic.pcert0 \
-     rtl/rel8/support/support/top.pcert0 \
-     rtl/rel8/support/lib1/bits.lisp
-rtl/rel8/support/lib1/bits.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/bits.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/bits.pcert1 : rtl/rel8/support/lib1/bits.pcert0
-rtl/rel8/support/lib1/bits.cert : | rtl/rel8/support/lib1/bits.pcert1
-
-rtl/rel8/support/lib1/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/bvecp-helpers.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.pcert0 \
-     rtl/rel8/support/support/bvecp-helpers.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/support/lib1/bvecp-helpers.lisp
-rtl/rel8/support/lib1/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/bvecp-helpers.pcert1 : rtl/rel8/support/lib1/bvecp-helpers.pcert0
-rtl/rel8/support/lib1/bvecp-helpers.cert : | rtl/rel8/support/lib1/bvecp-helpers.pcert1
-
-rtl/rel8/support/lib1/bvecp-raw-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/bvecp-raw-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/bvecp-raw-helpers.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.pcert0 \
-     rtl/rel8/support/support/bvecp-helpers.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/setbits.pcert0 \
-     rtl/rel8/support/support/setbitn.pcert0 \
-     rtl/rel8/support/support/logs.pcert0 \
-     rtl/rel8/support/support/lnot.pcert0 \
-     rtl/rel8/support/support/shft.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/mulcat.pcert0 \
-     rtl/rel8/support/support/encode.pcert0 \
-     rtl/rel8/support/support/decode.pcert0 \
-     rtl/rel8/support/support/land.pcert0 \
-     rtl/rel8/support/support/lior.pcert0 \
-     rtl/rel8/support/support/lxor.pcert0 \
-     rtl/rel8/support/support/guards.pcert0 \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/support/lib1/bvecp-raw-helpers.lisp
-rtl/rel8/support/lib1/bvecp-raw-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/bvecp-raw-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/bvecp-raw-helpers.pcert1 : rtl/rel8/support/lib1/bvecp-raw-helpers.pcert0
-rtl/rel8/support/lib1/bvecp-raw-helpers.cert : | rtl/rel8/support/lib1/bvecp-raw-helpers.pcert1
-
-rtl/rel8/support/lib1/clocks.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/clocks.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/clocks.pcert0 : \
-     rtl/rel8/support/support/clocks.pcert0 \
-     rtl/rel8/support/lib1/clocks.lisp
-rtl/rel8/support/lib1/clocks.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/clocks.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/clocks.pcert1 : rtl/rel8/support/lib1/clocks.pcert0
-rtl/rel8/support/lib1/clocks.cert : | rtl/rel8/support/lib1/clocks.pcert1
-
-rtl/rel8/support/lib1/float.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/float.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/float.pcert0 : \
-     rtl/rel8/support/lib1/log.pcert0 \
-     rtl/rel8/support/support/top.pcert0 \
-     rtl/rel8/support/lib1/float.lisp
-rtl/rel8/support/lib1/float.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/float.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/float.pcert1 : rtl/rel8/support/lib1/float.pcert0
-rtl/rel8/support/lib1/float.cert : | rtl/rel8/support/lib1/float.pcert1
-
-rtl/rel8/support/lib1/log.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/log.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/log.pcert0 : \
-     rtl/rel8/support/lib1/bits.pcert0 \
-     rtl/rel8/support/support/top.pcert0 \
-     rtl/rel8/support/lib1/log.lisp
-rtl/rel8/support/lib1/log.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/log.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/log.pcert1 : rtl/rel8/support/lib1/log.pcert0
-rtl/rel8/support/lib1/log.cert : | rtl/rel8/support/lib1/log.pcert1
-
-rtl/rel8/support/lib1/openers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/openers.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/openers.pcert0 : \
-     rtl/rel8/support/support/openers.pcert0 \
-     rtl/rel8/support/lib1/openers.lisp
-rtl/rel8/support/lib1/openers.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/openers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/openers.pcert1 : rtl/rel8/support/lib1/openers.pcert0
-rtl/rel8/support/lib1/openers.cert : | rtl/rel8/support/lib1/openers.pcert1
-
-rtl/rel8/support/lib1/package-defs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/package-defs.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/package-defs.pcert0 : \
-     rtl/rel8/support/support/package-defs.pcert0 \
-     rtl/rel8/support/lib1/package-defs.lisp
-rtl/rel8/support/lib1/package-defs.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/package-defs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/package-defs.pcert1 : rtl/rel8/support/lib1/package-defs.pcert0
-rtl/rel8/support/lib1/package-defs.cert : | rtl/rel8/support/lib1/package-defs.pcert1
-
-rtl/rel8/support/lib1/reps.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/reps.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/reps.pcert0 : \
-     rtl/rel8/support/support/ereps.pcert0 \
-     rtl/rel8/support/support/ireps.pcert0 \
-     rtl/rel8/support/support/guards.pcert0 \
-     rtl/rel8/support/lib1/log.pcert0 \
-     rtl/rel8/support/lib1/float.pcert0 \
-     rtl/rel8/support/lib1/reps.lisp
-rtl/rel8/support/lib1/reps.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/reps.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/reps.pcert1 : rtl/rel8/support/lib1/reps.pcert0
-rtl/rel8/support/lib1/reps.cert : | rtl/rel8/support/lib1/reps.pcert1
-
-rtl/rel8/support/lib1/rom-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/rom-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/rom-helpers.pcert0 : \
-     rtl/rel8/support/support/rom-helpers.pcert0 \
-     rtl/rel8/support/lib1/rom-helpers.lisp
-rtl/rel8/support/lib1/rom-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/rom-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/rom-helpers.pcert1 : rtl/rel8/support/lib1/rom-helpers.pcert0
-rtl/rel8/support/lib1/rom-helpers.cert : | rtl/rel8/support/lib1/rom-helpers.pcert1
-
-rtl/rel8/support/lib1/round.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/round.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/round.pcert0 : \
-     rtl/rel8/support/support/top.pcert0 \
-     rtl/rel8/support/lib1/reps.pcert0 \
-     rtl/rel8/support/lib1/round.lisp
-rtl/rel8/support/lib1/round.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/round.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/round.pcert1 : rtl/rel8/support/lib1/round.pcert0
-rtl/rel8/support/lib1/round.cert : | rtl/rel8/support/lib1/round.pcert1
-
-rtl/rel8/support/lib1/rtl.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/rtl.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/rtl.pcert0 : \
-     rtl/rel8/support/support/top.pcert0 \
-     rtl/rel8/support/lib1/rtl.lisp
-rtl/rel8/support/lib1/rtl.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/rtl.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/rtl.pcert1 : rtl/rel8/support/lib1/rtl.pcert0
-rtl/rel8/support/lib1/rtl.cert : | rtl/rel8/support/lib1/rtl.pcert1
-
-rtl/rel8/support/lib1/rtlarr.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/rtlarr.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/rtlarr.pcert0 : \
-     rtl/rel8/support/support/rtlarr.pcert0 \
-     rtl/rel8/support/support/bvecp-helpers.pcert0 \
-     rtl/rel8/support/support/guards.pcert0 \
-     misc/total-order.pcert0 \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.lisp
-rtl/rel8/support/lib1/rtlarr.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/rtlarr.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/rtlarr.pcert1 : rtl/rel8/support/lib1/rtlarr.pcert0
-rtl/rel8/support/lib1/rtlarr.cert : | rtl/rel8/support/lib1/rtlarr.pcert1
-
-rtl/rel8/support/lib1/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/simple-loop-helpers.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.pcert0 \
-     rtl/rel8/support/lib1/arith.pcert0 \
-     rtl/rel8/support/lib1/log.pcert0 \
-     rtl/rel8/support/support/simple-loop-helpers.pcert0 \
-     rtl/rel8/support/lib1/simple-loop-helpers.lisp
-rtl/rel8/support/lib1/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/simple-loop-helpers.pcert1 : rtl/rel8/support/lib1/simple-loop-helpers.pcert0
-rtl/rel8/support/lib1/simple-loop-helpers.cert : | rtl/rel8/support/lib1/simple-loop-helpers.pcert1
-
-rtl/rel8/support/lib1/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/simplify-model-helpers.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/arith.pcert0 \
-     rtl/rel8/support/lib1/bits.pcert0 \
-     rtl/rel8/support/support/simplify-model-helpers.pcert0 \
-     rtl/rel8/support/lib1/simplify-model-helpers.lisp
-rtl/rel8/support/lib1/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/simplify-model-helpers.pcert1 : rtl/rel8/support/lib1/simplify-model-helpers.pcert0
-rtl/rel8/support/lib1/simplify-model-helpers.cert : | rtl/rel8/support/lib1/simplify-model-helpers.pcert1
-
-rtl/rel8/support/lib1/top.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/top.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/top.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.pcert0 \
-     rtl/rel8/support/lib1/basic.pcert0 \
-     rtl/rel8/support/lib1/bits.pcert0 \
-     rtl/rel8/support/lib1/log.pcert0 \
-     rtl/rel8/support/lib1/float.pcert0 \
-     rtl/rel8/support/lib1/reps.pcert0 \
-     rtl/rel8/support/lib1/round.pcert0 \
-     rtl/rel8/support/lib1/add.pcert0 \
-     rtl/rel8/support/lib1/arith.pcert0 \
-     rtl/rel8/support/lib1/util.pcert0 \
-     rtl/rel8/support/lib1/top.lisp
-rtl/rel8/support/lib1/top.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/top.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/top.pcert1 : rtl/rel8/support/lib1/top.pcert0
-rtl/rel8/support/lib1/top.cert : | rtl/rel8/support/lib1/top.pcert1
-
-rtl/rel8/support/lib1/util.pcert0 : no_pcert = 0
-rtl/rel8/support/lib1/util.pcert0 : acl2x = 0
-rtl/rel8/support/lib1/util.pcert0 : \
-     rtl/rel8/support/support/util.pcert0 \
-     rtl/rel8/support/lib1/util.lisp
-rtl/rel8/support/lib1/util.pcert1 : acl2x = 0
-rtl/rel8/support/lib1/util.pcert1 : no_pcert = 0
-rtl/rel8/support/lib1/util.pcert1 : rtl/rel8/support/lib1/util.pcert0
-rtl/rel8/support/lib1/util.cert : | rtl/rel8/support/lib1/util.pcert1
-
-rtl/rel8/support/lib2.delta1/add-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/add-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/round-new.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/add-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/add-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/add-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/add-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/add-new-proofs.cert : | rtl/rel8/support/lib2.delta1/add-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/add-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/add-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/round-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/add-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/add-new.lisp
-rtl/rel8/support/lib2.delta1/add-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/add-new.pcert1 : rtl/rel8/support/lib2.delta1/add-new.pcert0
-rtl/rel8/support/lib2.delta1/add-new.cert : | rtl/rel8/support/lib2.delta1/add-new.pcert1
-
-rtl/rel8/support/lib2.delta1/add-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/add-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/round.pcert0 \
-     rtl/rel8/support/lib2.delta1/add-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/add-proofs.lisp
-rtl/rel8/support/lib2.delta1/add-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/add-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/add-proofs.pcert1 : rtl/rel8/support/lib2.delta1/add-proofs.pcert0
-rtl/rel8/support/lib2.delta1/add-proofs.cert : | rtl/rel8/support/lib2.delta1/add-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/add.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/add.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/add.pcert0 : \
-     rtl/rel8/support/lib2.delta1/round.pcert0 \
-     rtl/rel8/support/lib2.delta1/add-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/add.lisp
-rtl/rel8/support/lib2.delta1/add.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/add.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/add.pcert1 : rtl/rel8/support/lib2.delta1/add.pcert0
-rtl/rel8/support/lib2.delta1/add.cert : | rtl/rel8/support/lib2.delta1/add.pcert1
-
-rtl/rel8/support/lib2.delta1/arith.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/arith.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/arith.pcert0 : \
-     rtl/rel8/support/lib2/top.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/support/lib2.delta1/arith.lisp
-rtl/rel8/support/lib2.delta1/arith.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/arith.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/arith.pcert1 : rtl/rel8/support/lib2.delta1/arith.pcert0
-rtl/rel8/support/lib2.delta1/arith.cert : | rtl/rel8/support/lib2.delta1/arith.pcert1
-
-rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2/bits.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/log.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/badguys.pcert0 \
-     rtl/rel8/support/lib2/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/bits-new-proofs.cert : | rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/bits-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bits-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-new.pcert0 : \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new.lisp
-rtl/rel8/support/lib2.delta1/bits-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bits-new.pcert1 : rtl/rel8/support/lib2.delta1/bits-new.pcert0
-rtl/rel8/support/lib2.delta1/bits-new.cert : | rtl/rel8/support/lib2.delta1/bits-new.pcert1
-
-rtl/rel8/support/lib2.delta1/bits-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bits-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-proofs.pcert0 : \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-proofs.lisp
-rtl/rel8/support/lib2.delta1/bits-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bits-proofs.pcert1 : rtl/rel8/support/lib2.delta1/bits-proofs.pcert0
-rtl/rel8/support/lib2.delta1/bits-proofs.cert : | rtl/rel8/support/lib2.delta1/bits-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/bits.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bits.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits.pcert0 : \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.lisp
-rtl/rel8/support/lib2.delta1/bits.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bits.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bits.pcert1 : rtl/rel8/support/lib2.delta1/bits.pcert0
-rtl/rel8/support/lib2.delta1/bits.cert : | rtl/rel8/support/lib2.delta1/bits.pcert1
-
-rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-helpers.lisp
-rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert1 : rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert0
-rtl/rel8/support/lib2.delta1/bvecp-helpers.cert : | rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert1
-
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/encode.pcert0 \
-     rtl/rel8/support/support/decode.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.lisp
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert1 : rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.cert : | rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.lisp
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert1 : rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert0
-rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert : | rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert1
-
-rtl/rel8/support/lib2.delta1/float-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/float-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/float-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/float-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/float-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/float-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/float-new-proofs.cert : | rtl/rel8/support/lib2.delta1/float-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/float-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/float-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/float-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/float-new.lisp
-rtl/rel8/support/lib2.delta1/float-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/float-new.pcert1 : rtl/rel8/support/lib2.delta1/float-new.pcert0
-rtl/rel8/support/lib2.delta1/float-new.cert : | rtl/rel8/support/lib2.delta1/float-new.pcert1
-
-rtl/rel8/support/lib2.delta1/float-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/float-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/float-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/float-proofs.lisp
-rtl/rel8/support/lib2.delta1/float-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/float-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/float-proofs.pcert1 : rtl/rel8/support/lib2.delta1/float-proofs.pcert0
-rtl/rel8/support/lib2.delta1/float-proofs.cert : | rtl/rel8/support/lib2.delta1/float-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/float.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/float.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/float.pcert0 : \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/float-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/float.lisp
-rtl/rel8/support/lib2.delta1/float.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/float.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/float.pcert1 : rtl/rel8/support/lib2.delta1/float.pcert0
-rtl/rel8/support/lib2.delta1/float.cert : | rtl/rel8/support/lib2.delta1/float.pcert1
-
-rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/logxor.pcert0 \
-     rtl/rel8/support/support/log.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/log-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/log-new-proofs.cert : | rtl/rel8/support/lib2.delta1/log-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/log-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.lisp
-rtl/rel8/support/lib2.delta1/log-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-new.pcert1 : rtl/rel8/support/lib2.delta1/log-new.pcert0
-rtl/rel8/support/lib2.delta1/log-new.cert : | rtl/rel8/support/lib2.delta1/log-new.pcert1
-
-rtl/rel8/support/lib2.delta1/log-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-proofs.pcert0 : \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-proofs.lisp
-rtl/rel8/support/lib2.delta1/log-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-proofs.pcert1 : rtl/rel8/support/lib2.delta1/log-proofs.pcert0
-rtl/rel8/support/lib2.delta1/log-proofs.cert : | rtl/rel8/support/lib2.delta1/log-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/log-support-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-support-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-support-proofs.pcert0 : \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-support-proofs.lisp
-rtl/rel8/support/lib2.delta1/log-support-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-support-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-support-proofs.pcert1 : rtl/rel8/support/lib2.delta1/log-support-proofs.pcert0
-rtl/rel8/support/lib2.delta1/log-support-proofs.cert : | rtl/rel8/support/lib2.delta1/log-support-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/log-support.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-support.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-support.pcert0 : \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-support-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-support.lisp
-rtl/rel8/support/lib2.delta1/log-support.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log-support.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log-support.pcert1 : rtl/rel8/support/lib2.delta1/log-support.pcert0
-rtl/rel8/support/lib2.delta1/log-support.cert : | rtl/rel8/support/lib2.delta1/log-support.pcert1
-
-rtl/rel8/support/lib2.delta1/log.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log.pcert0 : \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log.lisp
-rtl/rel8/support/lib2.delta1/log.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/log.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/log.pcert1 : rtl/rel8/support/lib2.delta1/log.pcert0
-rtl/rel8/support/lib2.delta1/log.cert : | rtl/rel8/support/lib2.delta1/log.pcert1
-
-rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl-new.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/logn-new-proofs.cert : | rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/logn-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn-new.lisp
-rtl/rel8/support/lib2.delta1/logn-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn-new.pcert1 : rtl/rel8/support/lib2.delta1/logn-new.pcert0
-rtl/rel8/support/lib2.delta1/logn-new.cert : | rtl/rel8/support/lib2.delta1/logn-new.pcert1
-
-rtl/rel8/support/lib2.delta1/logn-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn-proofs.lisp
-rtl/rel8/support/lib2.delta1/logn-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn-proofs.pcert1 : rtl/rel8/support/lib2.delta1/logn-proofs.pcert0
-rtl/rel8/support/lib2.delta1/logn-proofs.cert : | rtl/rel8/support/lib2.delta1/logn-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/logn.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn.lisp
-rtl/rel8/support/lib2.delta1/logn.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn.pcert1 : rtl/rel8/support/lib2.delta1/logn.pcert0
-rtl/rel8/support/lib2.delta1/logn.cert : | rtl/rel8/support/lib2.delta1/logn.pcert1
-
-rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn2log-proofs.lisp
-rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert1 : rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert0
-rtl/rel8/support/lib2.delta1/logn2log-proofs.cert : | rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/logn2log.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn2log.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn2log.pcert0 : \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn2log-proofs.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn2log.lisp
-rtl/rel8/support/lib2.delta1/logn2log.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/logn2log.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/logn2log.pcert1 : rtl/rel8/support/lib2.delta1/logn2log.pcert0
-rtl/rel8/support/lib2.delta1/logn2log.cert : | rtl/rel8/support/lib2.delta1/logn2log.pcert1
-
-rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/add-new.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-support.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/mult-new-proofs.cert : | rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/mult-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/mult-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/add-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult-new.lisp
-rtl/rel8/support/lib2.delta1/mult-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/mult-new.pcert1 : rtl/rel8/support/lib2.delta1/mult-new.pcert0
-rtl/rel8/support/lib2.delta1/mult-new.cert : | rtl/rel8/support/lib2.delta1/mult-new.pcert1
-
-rtl/rel8/support/lib2.delta1/mult-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/mult-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/add.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult-proofs.lisp
-rtl/rel8/support/lib2.delta1/mult-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/mult-proofs.pcert1 : rtl/rel8/support/lib2.delta1/mult-proofs.pcert0
-rtl/rel8/support/lib2.delta1/mult-proofs.cert : | rtl/rel8/support/lib2.delta1/mult-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/mult.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/mult.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult.pcert0 : \
-     rtl/rel8/support/lib2.delta1/add.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult.lisp
-rtl/rel8/support/lib2.delta1/mult.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/mult.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/mult.pcert1 : rtl/rel8/support/lib2.delta1/mult.pcert0
-rtl/rel8/support/lib2.delta1/mult.cert : | rtl/rel8/support/lib2.delta1/mult.pcert1
-
-rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/float-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-support.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/reps-new-proofs.cert : | rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/reps-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/reps-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/float-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps-new.lisp
-rtl/rel8/support/lib2.delta1/reps-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/reps-new.pcert1 : rtl/rel8/support/lib2.delta1/reps-new.pcert0
-rtl/rel8/support/lib2.delta1/reps-new.cert : | rtl/rel8/support/lib2.delta1/reps-new.pcert1
-
-rtl/rel8/support/lib2.delta1/reps-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/reps-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps-proofs.lisp
-rtl/rel8/support/lib2.delta1/reps-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/reps-proofs.pcert1 : rtl/rel8/support/lib2.delta1/reps-proofs.pcert0
-rtl/rel8/support/lib2.delta1/reps-proofs.cert : | rtl/rel8/support/lib2.delta1/reps-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/reps.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/reps.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps.pcert0 : \
-     rtl/rel8/support/lib2.delta1/reps-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps.lisp
-rtl/rel8/support/lib2.delta1/reps.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/reps.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/reps.pcert1 : rtl/rel8/support/lib2.delta1/reps.pcert0
-rtl/rel8/support/lib2.delta1/reps.cert : | rtl/rel8/support/lib2.delta1/reps.pcert1
-
-rtl/rel8/support/lib2.delta1/round-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/round-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/float-new.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/support/land.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/round-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/round-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/round-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/round-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/round-new-proofs.cert : | rtl/rel8/support/lib2.delta1/round-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/round-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/round-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/float-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/round-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/round-new.lisp
-rtl/rel8/support/lib2.delta1/round-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/round-new.pcert1 : rtl/rel8/support/lib2.delta1/round-new.pcert0
-rtl/rel8/support/lib2.delta1/round-new.cert : | rtl/rel8/support/lib2.delta1/round-new.pcert1
-
-rtl/rel8/support/lib2.delta1/round-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/round-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/round-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/round-proofs.lisp
-rtl/rel8/support/lib2.delta1/round-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/round-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/round-proofs.pcert1 : rtl/rel8/support/lib2.delta1/round-proofs.pcert0
-rtl/rel8/support/lib2.delta1/round-proofs.cert : | rtl/rel8/support/lib2.delta1/round-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/round.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/round.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/round.pcert0 : \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/round-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/round.lisp
-rtl/rel8/support/lib2.delta1/round.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/round.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/round.pcert1 : rtl/rel8/support/lib2.delta1/round.pcert0
-rtl/rel8/support/lib2.delta1/round.cert : | rtl/rel8/support/lib2.delta1/round.pcert1
-
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/rtl-new-proofs.cert : | rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/rtl-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtl-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl-new.lisp
-rtl/rel8/support/lib2.delta1/rtl-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtl-new.pcert1 : rtl/rel8/support/lib2.delta1/rtl-new.pcert0
-rtl/rel8/support/lib2.delta1/rtl-new.cert : | rtl/rel8/support/lib2.delta1/rtl-new.pcert1
-
-rtl/rel8/support/lib2.delta1/rtl-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtl-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/log-new.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl-proofs.lisp
-rtl/rel8/support/lib2.delta1/rtl-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtl-proofs.pcert1 : rtl/rel8/support/lib2.delta1/rtl-proofs.pcert0
-rtl/rel8/support/lib2.delta1/rtl-proofs.cert : | rtl/rel8/support/lib2.delta1/rtl-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/rtl.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtl.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl.lisp
-rtl/rel8/support/lib2.delta1/rtl.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtl.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtl.pcert1 : rtl/rel8/support/lib2.delta1/rtl.pcert0
-rtl/rel8/support/lib2.delta1/rtl.cert : | rtl/rel8/support/lib2.delta1/rtl.pcert1
-
-rtl/rel8/support/lib2.delta1/rtlarr-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtlarr-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtlarr-new.pcert0 : \
-     rtl/rel8/support/lib2/top.pcert0 \
-     misc/total-order.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr-new.lisp
-rtl/rel8/support/lib2.delta1/rtlarr-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtlarr-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtlarr-new.pcert1 : rtl/rel8/support/lib2.delta1/rtlarr-new.pcert0
-rtl/rel8/support/lib2.delta1/rtlarr-new.cert : | rtl/rel8/support/lib2.delta1/rtlarr-new.pcert1
-
-rtl/rel8/support/lib2.delta1/rtlarr.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtlarr.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtlarr.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtlarr-new.pcert0 \
-     misc/total-order.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.lisp
-rtl/rel8/support/lib2.delta1/rtlarr.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/rtlarr.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/rtlarr.pcert1 : rtl/rel8/support/lib2.delta1/rtlarr.pcert0
-rtl/rel8/support/lib2.delta1/rtlarr.cert : | rtl/rel8/support/lib2.delta1/rtlarr.pcert1
-
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.lisp
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert1 : rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.cert : | rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.pcert0 \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers.lisp
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert1 : rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert0
-rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert : | rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert1
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/arith.pcert0 \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits-new-proofs.pcert0 \
-     rtl/rel8/support/lib2/simplify-model-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.lisp
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert1 : rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.cert : | rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert0 : \
-     rtl/rel8/support/lib2.delta1/bits-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/arith.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.lisp
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert1 : rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.cert : | rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert1
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn.pcert0 \
-     rtl/rel8/support/lib2.delta1/arith.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.lisp
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert1 : rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.cert : | rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert1
-
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/arith.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers.lisp
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert1 : rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert0
-rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert : | rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert1
-
-rtl/rel8/support/lib2.delta1/top.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/top.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/top.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps.pcert0 \
-     rtl/rel8/support/lib2.delta1/round.pcert0 \
-     rtl/rel8/support/lib2.delta1/add.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/arith.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/top.lisp
-rtl/rel8/support/lib2.delta1/top.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/top.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/top.pcert1 : rtl/rel8/support/lib2.delta1/top.pcert0
-rtl/rel8/support/lib2.delta1/top.cert : | rtl/rel8/support/lib2.delta1/top.pcert1
-
-rtl/rel8/support/lib2.delta1/util.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/util.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta1/util.pcert0 : \
-     rtl/rel8/support/lib2/top.pcert0 \
-     rtl/rel8/support/lib2.delta1/util.lisp
-rtl/rel8/support/lib2.delta1/util.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta1/util.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta1/util.pcert1 : rtl/rel8/support/lib2.delta1/util.pcert0
-rtl/rel8/support/lib2.delta1/util.cert : | rtl/rel8/support/lib2.delta1/util.pcert1
-
-rtl/rel8/support/lib2.delta2/add-lib.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/add-lib.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta2/add-lib.pcert0 : \
-     rtl/rel8/support/lib2.delta2/base.pcert0 \
-     rtl/rel8/support/lib2.delta1/arith.pcert0 \
-     rtl/rel8/support/lib2.delta2/add-lib.lisp
-rtl/rel8/support/lib2.delta2/add-lib.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta2/add-lib.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/add-lib.pcert1 : rtl/rel8/support/lib2.delta2/add-lib.pcert0
-rtl/rel8/support/lib2.delta2/add-lib.cert : | rtl/rel8/support/lib2.delta2/add-lib.pcert1
-
-rtl/rel8/support/lib2.delta2/add.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/add.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta2/add.pcert0 : \
-     rtl/rel8/support/lib2.delta2/base.pcert0 \
-     rtl/rel8/support/lib2.delta2/add-lib.pcert0 \
-     rtl/rel8/support/lib2.delta2/add.lisp
-rtl/rel8/support/lib2.delta2/add.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta2/add.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/add.pcert1 : rtl/rel8/support/lib2.delta2/add.pcert0
-rtl/rel8/support/lib2.delta2/add.cert : | rtl/rel8/support/lib2.delta2/add.pcert1
-
-rtl/rel8/support/lib2.delta2/base.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/base.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta2/base.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.pcert0 \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2.delta1/bits.pcert0 \
-     rtl/rel8/support/lib2.delta1/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps.pcert0 \
-     rtl/rel8/support/lib2.delta1/round.pcert0 \
-     rtl/rel8/support/lib2.delta1/add.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult.pcert0 \
-     rtl/rel8/support/lib2.delta1/util.pcert0 \
-     rtl/rel8/support/lib2.delta2/base.lisp
-rtl/rel8/support/lib2.delta2/base.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta2/base.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/base.pcert1 : rtl/rel8/support/lib2.delta2/base.pcert0
-rtl/rel8/support/lib2.delta2/base.cert : | rtl/rel8/support/lib2.delta2/base.pcert1
-
-rtl/rel8/support/lib2.delta2/bits.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/bits.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta2/bits.pcert0 : \
-     rtl/rel8/support/lib2.delta2/base.pcert0 \
-     rtl/rel8/support/lib2.delta2/add-lib.pcert0 \
-     rtl/rel8/support/lib2.delta2/bits.lisp
-rtl/rel8/support/lib2.delta2/bits.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta2/bits.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/bits.pcert1 : rtl/rel8/support/lib2.delta2/bits.pcert0
-rtl/rel8/support/lib2.delta2/bits.cert : | rtl/rel8/support/lib2.delta2/bits.pcert1
-
-rtl/rel8/support/lib2.delta2/log.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/log.pcert0 : acl2x = 0
-rtl/rel8/support/lib2.delta2/log.pcert0 : \
-     rtl/rel8/support/lib2.delta2/base.pcert0 \
-     rtl/rel8/support/lib2.delta2/add-lib.pcert0 \
-     rtl/rel8/support/lib2.delta2/log.lisp
-rtl/rel8/support/lib2.delta2/log.pcert1 : acl2x = 0
-rtl/rel8/support/lib2.delta2/log.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2.delta2/log.pcert1 : rtl/rel8/support/lib2.delta2/log.pcert0
-rtl/rel8/support/lib2.delta2/log.cert : | rtl/rel8/support/lib2.delta2/log.pcert1
-
-rtl/rel8/support/lib2/add.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/add.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/add.pcert0 : \
-     rtl/rel8/support/lib2/round.pcert0 \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/add.lisp
-rtl/rel8/support/lib2/add.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/add.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/add.pcert1 : rtl/rel8/support/lib2/add.pcert0
-rtl/rel8/support/lib2/add.cert : | rtl/rel8/support/lib2/add.pcert1
-
-rtl/rel8/support/lib2/arith.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/arith.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/arith.pcert0 : \
-     rtl/rel8/support/lib2/base.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/support/lib2/arith.lisp
-rtl/rel8/support/lib2/arith.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/arith.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/arith.pcert1 : rtl/rel8/support/lib2/arith.pcert0
-rtl/rel8/support/lib2/arith.cert : | rtl/rel8/support/lib2/arith.pcert1
-
-rtl/rel8/support/lib2/base.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/base.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/base.pcert0 : \
-     rtl/rel8/support/lib1/rtl.pcert0 \
-     rtl/rel8/support/lib1/rtlarr.pcert0 \
-     rtl/rel8/support/lib1.delta1/basic.pcert0 \
-     rtl/rel8/support/lib1.delta1/bits.pcert0 \
-     rtl/rel8/support/lib1/log.pcert0 \
-     rtl/rel8/support/lib1.delta2/float.pcert0 \
-     rtl/rel8/support/lib1/reps.pcert0 \
-     rtl/rel8/support/lib1.delta1/round.pcert0 \
-     rtl/rel8/support/lib1/add.pcert0 \
-     rtl/rel8/support/lib1.delta1/mult.pcert0 \
-     rtl/rel8/support/lib1.delta1/arith.pcert0 \
-     rtl/rel8/support/lib1/util.pcert0 \
-     rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.pcert0 \
-     rtl/rel8/support/lib1.delta1/simple-loop-helpers.pcert0 \
-     rtl/rel8/support/lib2/base.lisp
-rtl/rel8/support/lib2/base.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/base.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/base.pcert1 : rtl/rel8/support/lib2/base.pcert0
-rtl/rel8/support/lib2/base.cert : | rtl/rel8/support/lib2/base.pcert1
-
-rtl/rel8/support/lib2/basic.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/basic.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/basic.pcert0 : \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/basic.lisp
-rtl/rel8/support/lib2/basic.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/basic.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/basic.pcert1 : rtl/rel8/support/lib2/basic.pcert0
-rtl/rel8/support/lib2/basic.cert : | rtl/rel8/support/lib2/basic.pcert1
-
-rtl/rel8/support/lib2/bits.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/bits.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/bits.pcert0 : \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/bits.lisp
-rtl/rel8/support/lib2/bits.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/bits.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/bits.pcert1 : rtl/rel8/support/lib2/bits.pcert0
-rtl/rel8/support/lib2/bits.cert : | rtl/rel8/support/lib2/bits.pcert1
-
-rtl/rel8/support/lib2/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/bvecp-helpers.pcert0 : \
-     rtl/rel8/support/lib2/rtl.pcert0 \
-     rtl/rel8/support/lib2/rtlarr.pcert0 \
-     rtl/rel8/support/support/bvecp-helpers.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/support/lib2/bvecp-helpers.lisp
-rtl/rel8/support/lib2/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/bvecp-helpers.pcert1 : rtl/rel8/support/lib2/bvecp-helpers.pcert0
-rtl/rel8/support/lib2/bvecp-helpers.cert : | rtl/rel8/support/lib2/bvecp-helpers.pcert1
-
-rtl/rel8/support/lib2/bvecp-raw-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/bvecp-raw-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/bvecp-raw-helpers.pcert0 : \
-     rtl/rel8/support/lib2/rtl.pcert0 \
-     rtl/rel8/support/lib2/rtlarr.pcert0 \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/bvecp-raw-helpers.lisp
-rtl/rel8/support/lib2/bvecp-raw-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/bvecp-raw-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/bvecp-raw-helpers.pcert1 : rtl/rel8/support/lib2/bvecp-raw-helpers.pcert0
-rtl/rel8/support/lib2/bvecp-raw-helpers.cert : | rtl/rel8/support/lib2/bvecp-raw-helpers.pcert1
-
-rtl/rel8/support/lib2/clocks.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/clocks.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/clocks.pcert0 : \
-     rtl/rel8/support/support/clocks.pcert0 \
-     rtl/rel8/support/lib2/clocks.lisp
-rtl/rel8/support/lib2/clocks.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/clocks.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/clocks.pcert1 : rtl/rel8/support/lib2/clocks.pcert0
-rtl/rel8/support/lib2/clocks.cert : | rtl/rel8/support/lib2/clocks.pcert1
-
-rtl/rel8/support/lib2/float.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/float.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/float.pcert0 : \
-     rtl/rel8/support/lib2/log.pcert0 \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/float.lisp
-rtl/rel8/support/lib2/float.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/float.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/float.pcert1 : rtl/rel8/support/lib2/float.pcert0
-rtl/rel8/support/lib2/float.cert : | rtl/rel8/support/lib2/float.pcert1
-
-rtl/rel8/support/lib2/log.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/log.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/log.pcert0 : \
-     rtl/rel8/support/lib2/bits.pcert0 \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/log.lisp
-rtl/rel8/support/lib2/log.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/log.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/log.pcert1 : rtl/rel8/support/lib2/log.pcert0
-rtl/rel8/support/lib2/log.cert : | rtl/rel8/support/lib2/log.pcert1
-
-rtl/rel8/support/lib2/mult.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/mult.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/mult.pcert0 : \
-     rtl/rel8/support/lib2/add.pcert0 \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/mult.lisp
-rtl/rel8/support/lib2/mult.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/mult.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/mult.pcert1 : rtl/rel8/support/lib2/mult.pcert0
-rtl/rel8/support/lib2/mult.cert : | rtl/rel8/support/lib2/mult.pcert1
-
-rtl/rel8/support/lib2/openers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/openers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/openers.pcert0 : \
-     rtl/rel8/support/support/openers.pcert0 \
-     rtl/rel8/support/lib2/openers.lisp
-rtl/rel8/support/lib2/openers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/openers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/openers.pcert1 : rtl/rel8/support/lib2/openers.pcert0
-rtl/rel8/support/lib2/openers.cert : | rtl/rel8/support/lib2/openers.pcert1
-
-rtl/rel8/support/lib2/package-defs.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/package-defs.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/package-defs.pcert0 : \
-     rtl/rel8/support/support/package-defs.pcert0 \
-     rtl/rel8/support/lib2/package-defs.lisp
-rtl/rel8/support/lib2/package-defs.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/package-defs.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/package-defs.pcert1 : rtl/rel8/support/lib2/package-defs.pcert0
-rtl/rel8/support/lib2/package-defs.cert : | rtl/rel8/support/lib2/package-defs.pcert1
-
-rtl/rel8/support/lib2/reps.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/reps.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/reps.pcert0 : \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/log.pcert0 \
-     rtl/rel8/support/lib2/float.pcert0 \
-     rtl/rel8/support/lib2/reps.lisp
-rtl/rel8/support/lib2/reps.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/reps.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/reps.pcert1 : rtl/rel8/support/lib2/reps.pcert0
-rtl/rel8/support/lib2/reps.cert : | rtl/rel8/support/lib2/reps.pcert1
-
-rtl/rel8/support/lib2/rom-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/rom-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/rom-helpers.pcert0 : \
-     rtl/rel8/support/support/rom-helpers.pcert0 \
-     rtl/rel8/support/lib2/rom-helpers.lisp
-rtl/rel8/support/lib2/rom-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/rom-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/rom-helpers.pcert1 : rtl/rel8/support/lib2/rom-helpers.pcert0
-rtl/rel8/support/lib2/rom-helpers.cert : | rtl/rel8/support/lib2/rom-helpers.pcert1
-
-rtl/rel8/support/lib2/round.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/round.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/round.pcert0 : \
-     rtl/rel8/support/lib2/float.pcert0 \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/round.lisp
-rtl/rel8/support/lib2/round.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/round.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/round.pcert1 : rtl/rel8/support/lib2/round.pcert0
-rtl/rel8/support/lib2/round.cert : | rtl/rel8/support/lib2/round.pcert1
-
-rtl/rel8/support/lib2/rtl.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/rtl.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/rtl.pcert0 : \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/rtl.lisp
-rtl/rel8/support/lib2/rtl.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/rtl.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/rtl.pcert1 : rtl/rel8/support/lib2/rtl.pcert0
-rtl/rel8/support/lib2/rtl.cert : | rtl/rel8/support/lib2/rtl.pcert1
-
-rtl/rel8/support/lib2/rtlarr.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/rtlarr.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/rtlarr.pcert0 : \
-     rtl/rel8/support/lib2/base.pcert0 \
-     misc/total-order.pcert0 \
-     rtl/rel8/support/lib2/rtl.pcert0 \
-     rtl/rel8/support/lib2/rtlarr.lisp
-rtl/rel8/support/lib2/rtlarr.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/rtlarr.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/rtlarr.pcert1 : rtl/rel8/support/lib2/rtlarr.pcert0
-rtl/rel8/support/lib2/rtlarr.cert : | rtl/rel8/support/lib2/rtlarr.pcert1
-
-rtl/rel8/support/lib2/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/simple-loop-helpers.pcert0 : \
-     rtl/rel8/support/lib2/rtl.pcert0 \
-     rtl/rel8/support/lib2/rtlarr.pcert0 \
-     rtl/rel8/support/lib2/arith.pcert0 \
-     rtl/rel8/support/lib2/log.pcert0 \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/simple-loop-helpers.lisp
-rtl/rel8/support/lib2/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/simple-loop-helpers.pcert1 : rtl/rel8/support/lib2/simple-loop-helpers.pcert0
-rtl/rel8/support/lib2/simple-loop-helpers.cert : | rtl/rel8/support/lib2/simple-loop-helpers.pcert1
-
-rtl/rel8/support/lib2/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/simplify-model-helpers.pcert0 : \
-     rtl/rel8/support/lib2/rtl.pcert0 \
-     rtl/rel8/support/lib2/arith.pcert0 \
-     rtl/rel8/support/lib2/bits.pcert0 \
-     rtl/rel8/support/support/simplify-model-helpers.pcert0 \
-     rtl/rel8/support/lib2/simplify-model-helpers.lisp
-rtl/rel8/support/lib2/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/simplify-model-helpers.pcert1 : rtl/rel8/support/lib2/simplify-model-helpers.pcert0
-rtl/rel8/support/lib2/simplify-model-helpers.cert : | rtl/rel8/support/lib2/simplify-model-helpers.pcert1
-
-rtl/rel8/support/lib2/top.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/top.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/top.pcert0 : \
-     rtl/rel8/support/lib2/rtl.pcert0 \
-     rtl/rel8/support/lib2/rtlarr.pcert0 \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2/bits.pcert0 \
-     rtl/rel8/support/lib2/log.pcert0 \
-     rtl/rel8/support/lib2/float.pcert0 \
-     rtl/rel8/support/lib2/reps.pcert0 \
-     rtl/rel8/support/lib2/round.pcert0 \
-     rtl/rel8/support/lib2/add.pcert0 \
-     rtl/rel8/support/lib2/mult.pcert0 \
-     rtl/rel8/support/lib2/arith.pcert0 \
-     rtl/rel8/support/lib2/util.pcert0 \
-     rtl/rel8/support/lib2/top.lisp
-rtl/rel8/support/lib2/top.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/top.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/top.pcert1 : rtl/rel8/support/lib2/top.pcert0
-rtl/rel8/support/lib2/top.cert : | rtl/rel8/support/lib2/top.pcert1
-
-rtl/rel8/support/lib2/util.pcert0 : no_pcert = 0
-rtl/rel8/support/lib2/util.pcert0 : acl2x = 0
-rtl/rel8/support/lib2/util.pcert0 : \
-     rtl/rel8/support/lib2/base.pcert0 \
-     rtl/rel8/support/lib2/util.lisp
-rtl/rel8/support/lib2/util.pcert1 : acl2x = 0
-rtl/rel8/support/lib2/util.pcert1 : no_pcert = 0
-rtl/rel8/support/lib2/util.pcert1 : rtl/rel8/support/lib2/util.pcert0
-rtl/rel8/support/lib2/util.cert : | rtl/rel8/support/lib2/util.pcert1
-
-rtl/rel8/support/support/add3-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/add3-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/add3-proofs.pcert0 : \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/add3-proofs.lisp
-rtl/rel8/support/support/add3-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/add3-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/add3-proofs.pcert1 : rtl/rel8/support/support/add3-proofs.pcert0
-rtl/rel8/support/support/add3-proofs.cert : | rtl/rel8/support/support/add3-proofs.pcert1
-
-rtl/rel8/support/support/add3.pcert0 : no_pcert = 0
-rtl/rel8/support/support/add3.pcert0 : acl2x = 0
-rtl/rel8/support/support/add3.pcert0 : \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/add3-proofs.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/add3.lisp
-rtl/rel8/support/support/add3.pcert1 : acl2x = 0
-rtl/rel8/support/support/add3.pcert1 : no_pcert = 0
-rtl/rel8/support/support/add3.pcert1 : rtl/rel8/support/support/add3.pcert0
-rtl/rel8/support/support/add3.cert : | rtl/rel8/support/support/add3.pcert1
-
-rtl/rel8/support/support/all-ones.pcert0 : no_pcert = 0
-rtl/rel8/support/support/all-ones.pcert0 : acl2x = 0
-rtl/rel8/support/support/all-ones.pcert0 : \
-     rtl/rel8/support/support/all-ones.lisp
-rtl/rel8/support/support/all-ones.pcert1 : acl2x = 0
-rtl/rel8/support/support/all-ones.pcert1 : no_pcert = 0
-rtl/rel8/support/support/all-ones.pcert1 : rtl/rel8/support/support/all-ones.pcert0
-rtl/rel8/support/support/all-ones.cert : | rtl/rel8/support/support/all-ones.pcert1
-
-rtl/rel8/support/support/ash.pcert0 : no_pcert = 0
-rtl/rel8/support/support/ash.pcert0 : acl2x = 0
-rtl/rel8/support/support/ash.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/support/support/ash.lisp
-rtl/rel8/support/support/ash.pcert1 : acl2x = 0
-rtl/rel8/support/support/ash.pcert1 : no_pcert = 0
-rtl/rel8/support/support/ash.pcert1 : rtl/rel8/support/support/ash.pcert0
-rtl/rel8/support/support/ash.cert : | rtl/rel8/support/support/ash.pcert1
-
-rtl/rel8/support/support/away-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/away-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/away-proofs.pcert0 : \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/away-proofs.lisp
-rtl/rel8/support/support/away-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/away-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/away-proofs.pcert1 : rtl/rel8/support/support/away-proofs.pcert0
-rtl/rel8/support/support/away-proofs.cert : | rtl/rel8/support/support/away-proofs.pcert1
-
-rtl/rel8/support/support/away.pcert0 : no_pcert = 0
-rtl/rel8/support/support/away.pcert0 : acl2x = 0
-rtl/rel8/support/support/away.pcert0 : \
-     rtl/rel8/support/support/away-proofs.pcert0 \
-     rtl/rel8/support/support/away.lisp
-rtl/rel8/support/support/away.pcert1 : acl2x = 0
-rtl/rel8/support/support/away.pcert1 : no_pcert = 0
-rtl/rel8/support/support/away.pcert1 : rtl/rel8/support/support/away.pcert0
-rtl/rel8/support/support/away.cert : | rtl/rel8/support/support/away.pcert1
-
-rtl/rel8/support/support/badguys.pcert0 : no_pcert = 0
-rtl/rel8/support/support/badguys.pcert0 : acl2x = 0
-rtl/rel8/support/support/badguys.pcert0 : \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/badguys.lisp
-rtl/rel8/support/support/badguys.pcert1 : acl2x = 0
-rtl/rel8/support/support/badguys.pcert1 : no_pcert = 0
-rtl/rel8/support/support/badguys.pcert1 : rtl/rel8/support/support/badguys.pcert0
-rtl/rel8/support/support/badguys.cert : | rtl/rel8/support/support/badguys.pcert1
-
-rtl/rel8/support/support/bias-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bias-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/bias-proofs.pcert0 : \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/support/support/bias-proofs.lisp
-rtl/rel8/support/support/bias-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/bias-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bias-proofs.pcert1 : rtl/rel8/support/support/bias-proofs.pcert0
-rtl/rel8/support/support/bias-proofs.cert : | rtl/rel8/support/support/bias-proofs.pcert1
-
-rtl/rel8/support/support/bias.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bias.pcert0 : acl2x = 0
-rtl/rel8/support/support/bias.pcert0 : \
-     rtl/rel8/support/support/bias-proofs.pcert0 \
-     rtl/rel8/support/support/bias.lisp
-rtl/rel8/support/support/bias.pcert1 : acl2x = 0
-rtl/rel8/support/support/bias.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bias.pcert1 : rtl/rel8/support/support/bias.pcert0
-rtl/rel8/support/support/bias.cert : | rtl/rel8/support/support/bias.pcert1
-
-rtl/rel8/support/support/bitn-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bitn-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/bitn-proofs.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/bitn-proofs.lisp
-rtl/rel8/support/support/bitn-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/bitn-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bitn-proofs.pcert1 : rtl/rel8/support/support/bitn-proofs.pcert0
-rtl/rel8/support/support/bitn-proofs.cert : | rtl/rel8/support/support/bitn-proofs.pcert1
-
-rtl/rel8/support/support/bitn.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bitn.pcert0 : acl2x = 0
-rtl/rel8/support/support/bitn.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/support/support/bitn-proofs.pcert0 \
-     rtl/rel8/support/support/bitn.lisp
-rtl/rel8/support/support/bitn.pcert1 : acl2x = 0
-rtl/rel8/support/support/bitn.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bitn.pcert1 : rtl/rel8/support/support/bitn.pcert0
-rtl/rel8/support/support/bitn.cert : | rtl/rel8/support/support/bitn.pcert1
-
-rtl/rel8/support/support/bits-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bits-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/bits-proofs.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/bits-proofs.lisp
-rtl/rel8/support/support/bits-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/bits-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bits-proofs.pcert1 : rtl/rel8/support/support/bits-proofs.pcert0
-rtl/rel8/support/support/bits-proofs.cert : | rtl/rel8/support/support/bits-proofs.pcert1
-
-rtl/rel8/support/support/bits-trunc-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bits-trunc-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/bits-trunc-proofs.pcert0 : \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/log.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bits-trunc-proofs.lisp
-rtl/rel8/support/support/bits-trunc-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/bits-trunc-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bits-trunc-proofs.pcert1 : rtl/rel8/support/support/bits-trunc-proofs.pcert0
-rtl/rel8/support/support/bits-trunc-proofs.cert : | rtl/rel8/support/support/bits-trunc-proofs.pcert1
-
-rtl/rel8/support/support/bits-trunc.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bits-trunc.pcert0 : acl2x = 0
-rtl/rel8/support/support/bits-trunc.pcert0 : \
-     rtl/rel8/support/support/log.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/bits-trunc-proofs.pcert0 \
-     rtl/rel8/support/support/bits-trunc.lisp
-rtl/rel8/support/support/bits-trunc.pcert1 : acl2x = 0
-rtl/rel8/support/support/bits-trunc.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bits-trunc.pcert1 : rtl/rel8/support/support/bits-trunc.pcert0
-rtl/rel8/support/support/bits-trunc.cert : | rtl/rel8/support/support/bits-trunc.pcert1
-
-rtl/rel8/support/support/bits.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bits.pcert0 : acl2x = 0
-rtl/rel8/support/support/bits.pcert0 : \
-     rtl/rel8/support/support/bits-proofs.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/support/support/bits.lisp
-rtl/rel8/support/support/bits.pcert1 : acl2x = 0
-rtl/rel8/support/support/bits.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bits.pcert1 : rtl/rel8/support/support/bits.pcert0
-rtl/rel8/support/support/bits.cert : | rtl/rel8/support/support/bits.pcert1
-
-rtl/rel8/support/support/bvecp-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bvecp-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/support/bvecp-helpers.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/bvecp-lemmas.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bvecp-helpers.lisp
-rtl/rel8/support/support/bvecp-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/support/bvecp-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bvecp-helpers.pcert1 : rtl/rel8/support/support/bvecp-helpers.pcert0
-rtl/rel8/support/support/bvecp-helpers.cert : | rtl/rel8/support/support/bvecp-helpers.pcert1
-
-rtl/rel8/support/support/bvecp-lemmas.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bvecp-lemmas.pcert0 : acl2x = 0
-rtl/rel8/support/support/bvecp-lemmas.pcert0 : \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/setbits.pcert0 \
-     rtl/rel8/support/support/setbitn.pcert0 \
-     rtl/rel8/support/support/encode.pcert0 \
-     rtl/rel8/support/support/decode.pcert0 \
-     rtl/rel8/support/support/logs.pcert0 \
-     rtl/rel8/support/support/lnot.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/shft.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/mulcat.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/bvecp-lemmas.lisp
-rtl/rel8/support/support/bvecp-lemmas.pcert1 : acl2x = 0
-rtl/rel8/support/support/bvecp-lemmas.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bvecp-lemmas.pcert1 : rtl/rel8/support/support/bvecp-lemmas.pcert0
-rtl/rel8/support/support/bvecp-lemmas.cert : | rtl/rel8/support/support/bvecp-lemmas.pcert1
-
-rtl/rel8/support/support/bvecp-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bvecp-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/bvecp-proofs.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bvecp-proofs.lisp
-rtl/rel8/support/support/bvecp-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/bvecp-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bvecp-proofs.pcert1 : rtl/rel8/support/support/bvecp-proofs.pcert0
-rtl/rel8/support/support/bvecp-proofs.cert : | rtl/rel8/support/support/bvecp-proofs.pcert1
-
-rtl/rel8/support/support/bvecp.pcert0 : no_pcert = 0
-rtl/rel8/support/support/bvecp.pcert0 : acl2x = 0
-rtl/rel8/support/support/bvecp.pcert0 : \
-     rtl/rel8/support/support/bvecp-proofs.pcert0 \
-     rtl/rel8/support/support/bvecp.lisp
-rtl/rel8/support/support/bvecp.pcert1 : acl2x = 0
-rtl/rel8/support/support/bvecp.pcert1 : no_pcert = 0
-rtl/rel8/support/support/bvecp.pcert1 : rtl/rel8/support/support/bvecp.pcert0
-rtl/rel8/support/support/bvecp.cert : | rtl/rel8/support/support/bvecp.pcert1
-
-rtl/rel8/support/support/cat-def.pcert0 : no_pcert = 0
-rtl/rel8/support/support/cat-def.pcert0 : acl2x = 0
-rtl/rel8/support/support/cat-def.pcert0 : \
-     rtl/rel8/support/support/cat-def.lisp
-rtl/rel8/support/support/cat-def.pcert1 : acl2x = 0
-rtl/rel8/support/support/cat-def.pcert1 : no_pcert = 0
-rtl/rel8/support/support/cat-def.pcert1 : rtl/rel8/support/support/cat-def.pcert0
-rtl/rel8/support/support/cat-def.cert : | rtl/rel8/support/support/cat-def.pcert1
-
-rtl/rel8/support/support/cat-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/cat-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/cat-proofs.pcert0 : \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/cat-proofs.lisp
-rtl/rel8/support/support/cat-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/cat-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/cat-proofs.pcert1 : rtl/rel8/support/support/cat-proofs.pcert0
-rtl/rel8/support/support/cat-proofs.cert : | rtl/rel8/support/support/cat-proofs.pcert1
-
-rtl/rel8/support/support/cat.pcert0 : no_pcert = 0
-rtl/rel8/support/support/cat.pcert0 : acl2x = 0
-rtl/rel8/support/support/cat.pcert0 : \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/support/support/cat-proofs.pcert0 \
-     rtl/rel8/support/support/cat.lisp
-rtl/rel8/support/support/cat.pcert1 : acl2x = 0
-rtl/rel8/support/support/cat.pcert1 : no_pcert = 0
-rtl/rel8/support/support/cat.pcert1 : rtl/rel8/support/support/cat.pcert0
-rtl/rel8/support/support/cat.cert : | rtl/rel8/support/support/cat.pcert1
-
-rtl/rel8/support/support/clocks.pcert0 : no_pcert = 0
-rtl/rel8/support/support/clocks.pcert0 : acl2x = 0
-rtl/rel8/support/support/clocks.pcert0 : \
-     rtl/rel8/support/support/mod4.pcert0 \
-     rtl/rel8/arithmetic/even-odd2.pcert0 \
-     rtl/rel8/support/support/clocks.lisp
-rtl/rel8/support/support/clocks.pcert1 : acl2x = 0
-rtl/rel8/support/support/clocks.pcert1 : no_pcert = 0
-rtl/rel8/support/support/clocks.pcert1 : rtl/rel8/support/support/clocks.pcert0
-rtl/rel8/support/support/clocks.cert : | rtl/rel8/support/support/clocks.pcert1
-
-rtl/rel8/support/support/decode-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/decode-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/decode-proofs.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/support/support/ash.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/decode-proofs.lisp
-rtl/rel8/support/support/decode-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/decode-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/decode-proofs.pcert1 : rtl/rel8/support/support/decode-proofs.pcert0
-rtl/rel8/support/support/decode-proofs.cert : | rtl/rel8/support/support/decode-proofs.pcert1
-
-rtl/rel8/support/support/decode.pcert0 : no_pcert = 0
-rtl/rel8/support/support/decode.pcert0 : acl2x = 0
-rtl/rel8/support/support/decode.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/decode-proofs.pcert0 \
-     rtl/rel8/support/support/decode.lisp
-rtl/rel8/support/support/decode.pcert1 : acl2x = 0
-rtl/rel8/support/support/decode.pcert1 : no_pcert = 0
-rtl/rel8/support/support/decode.pcert1 : rtl/rel8/support/support/decode.pcert0
-rtl/rel8/support/support/decode.cert : | rtl/rel8/support/support/decode.pcert1
-
-rtl/rel8/support/support/drnd-original.pcert0 : no_pcert = 0
-rtl/rel8/support/support/drnd-original.pcert0 : acl2x = 0
-rtl/rel8/support/support/drnd-original.pcert0 : \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/ireps.pcert0 \
-     rtl/rel8/support/support/rnd.pcert0 \
-     rtl/rel8/support/support/bias.pcert0 \
-     rtl/rel8/support/support/sgn.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/away.pcert0 \
-     rtl/rel8/support/support/near.pcert0 \
-     rtl/rel8/support/support/near+.pcert0 \
-     rtl/rel8/support/support/sticky.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/drnd-original.lisp
-rtl/rel8/support/support/drnd-original.pcert1 : acl2x = 0
-rtl/rel8/support/support/drnd-original.pcert1 : no_pcert = 0
-rtl/rel8/support/support/drnd-original.pcert1 : rtl/rel8/support/support/drnd-original.pcert0
-rtl/rel8/support/support/drnd-original.cert : | rtl/rel8/support/support/drnd-original.pcert1
-
-rtl/rel8/support/support/encode.pcert0 : no_pcert = 0
-rtl/rel8/support/support/encode.pcert0 : acl2x = 0
-rtl/rel8/support/support/encode.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/ash.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/encode.lisp
-rtl/rel8/support/support/encode.pcert1 : acl2x = 0
-rtl/rel8/support/support/encode.pcert1 : no_pcert = 0
-rtl/rel8/support/support/encode.pcert1 : rtl/rel8/support/support/encode.pcert0
-rtl/rel8/support/support/encode.cert : | rtl/rel8/support/support/encode.pcert1
-
-rtl/rel8/support/support/ereps-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/ereps-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/ereps-proofs.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/bias.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/mulcat.pcert0 \
-     rtl/rel8/support/support/ereps-proofs.lisp
-rtl/rel8/support/support/ereps-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/ereps-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/ereps-proofs.pcert1 : rtl/rel8/support/support/ereps-proofs.pcert0
-rtl/rel8/support/support/ereps-proofs.cert : | rtl/rel8/support/support/ereps-proofs.pcert1
-
-rtl/rel8/support/support/ereps.pcert0 : no_pcert = 0
-rtl/rel8/support/support/ereps.pcert0 : acl2x = 0
-rtl/rel8/support/support/ereps.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/ereps-proofs.pcert0 \
-     rtl/rel8/support/support/ereps.lisp
-rtl/rel8/support/support/ereps.pcert1 : acl2x = 0
-rtl/rel8/support/support/ereps.pcert1 : no_pcert = 0
-rtl/rel8/support/support/ereps.pcert1 : rtl/rel8/support/support/ereps.pcert0
-rtl/rel8/support/support/ereps.cert : | rtl/rel8/support/support/ereps.pcert1
-
-rtl/rel8/support/support/fadd-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/support/fadd-extra.pcert0 : acl2x = 0
-rtl/rel8/support/support/fadd-extra.pcert0 : \
-     rtl/rel8/support/support/fadd-extra0.pcert0 \
-     rtl/rel8/support/support/land.pcert0 \
-     rtl/rel8/support/support/lior.pcert0 \
-     rtl/rel8/support/support/lxor.pcert0 \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/fadd-extra.lisp
-rtl/rel8/support/support/fadd-extra.pcert1 : acl2x = 0
-rtl/rel8/support/support/fadd-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/support/fadd-extra.pcert1 : rtl/rel8/support/support/fadd-extra.pcert0
-rtl/rel8/support/support/fadd-extra.cert : | rtl/rel8/support/support/fadd-extra.pcert1
-
-rtl/rel8/support/support/fadd-extra0.pcert0 : no_pcert = 0
-rtl/rel8/support/support/fadd-extra0.pcert0 : acl2x = 0
-rtl/rel8/support/support/fadd-extra0.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/fadd.pcert0 \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/fadd-extra0.lisp
-rtl/rel8/support/support/fadd-extra0.pcert1 : acl2x = 0
-rtl/rel8/support/support/fadd-extra0.pcert1 : no_pcert = 0
-rtl/rel8/support/support/fadd-extra0.pcert1 : rtl/rel8/support/support/fadd-extra0.pcert0
-rtl/rel8/support/support/fadd-extra0.cert : | rtl/rel8/support/support/fadd-extra0.pcert1
-
-rtl/rel8/support/support/fadd.pcert0 : no_pcert = 0
-rtl/rel8/support/support/fadd.pcert0 : acl2x = 0
-rtl/rel8/support/support/fadd.pcert0 : \
-     rtl/rel8/support/support/stick.pcert0 \
-     rtl/rel8/support/support/lop3.pcert0 \
-     rtl/rel8/support/support/add3.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/lextra0.pcert0 \
-     rtl/rel8/support/support/fadd.lisp
-rtl/rel8/support/support/fadd.pcert1 : acl2x = 0
-rtl/rel8/support/support/fadd.pcert1 : no_pcert = 0
-rtl/rel8/support/support/fadd.pcert1 : rtl/rel8/support/support/fadd.pcert0
-rtl/rel8/support/support/fadd.cert : | rtl/rel8/support/support/fadd.pcert1
-
-rtl/rel8/support/support/fast-and.pcert0 : no_pcert = 0
-rtl/rel8/support/support/fast-and.pcert0 : acl2x = 0
-rtl/rel8/support/support/fast-and.pcert0 : \
-     rtl/rel8/support/support/fast-and.lisp
-rtl/rel8/support/support/fast-and.pcert1 : acl2x = 0
-rtl/rel8/support/support/fast-and.pcert1 : no_pcert = 0
-rtl/rel8/support/support/fast-and.pcert1 : rtl/rel8/support/support/fast-and.pcert0
-rtl/rel8/support/support/fast-and.cert : | rtl/rel8/support/support/fast-and.pcert1
-
-rtl/rel8/support/support/float-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/support/float-extra.pcert0 : acl2x = 0
-rtl/rel8/support/support/float-extra.pcert0 : \
-     arithmetic/inequalities.pcert0 \
-     rtl/rel8/support/support/sticky.pcert0 \
-     rtl/rel8/support/support/util.pcert0 \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/float-extra.lisp
-rtl/rel8/support/support/float-extra.pcert1 : acl2x = 0
-rtl/rel8/support/support/float-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/support/float-extra.pcert1 : rtl/rel8/support/support/float-extra.pcert0
-rtl/rel8/support/support/float-extra.cert : | rtl/rel8/support/support/float-extra.pcert1
-
-rtl/rel8/support/support/float.pcert0 : no_pcert = 0
-rtl/rel8/support/support/float.pcert0 : acl2x = 0
-rtl/rel8/support/support/float.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/negative-syntaxp.pcert0 \
-     rtl/rel8/arithmetic/basic.pcert0 \
-     rtl/rel8/arithmetic/power2p.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/cg.pcert0 \
-     rtl/rel8/support/support/float.lisp
-rtl/rel8/support/support/float.pcert1 : acl2x = 0
-rtl/rel8/support/support/float.pcert1 : no_pcert = 0
-rtl/rel8/support/support/float.pcert1 : rtl/rel8/support/support/float.pcert0
-rtl/rel8/support/support/float.cert : | rtl/rel8/support/support/float.pcert1
-
-rtl/rel8/support/support/ground-zero.pcert0 : no_pcert = 0
-rtl/rel8/support/support/ground-zero.pcert0 : acl2x = 0
-rtl/rel8/support/support/ground-zero.pcert0 : \
-     rtl/rel8/arithmetic/ground-zero.pcert0 \
-     rtl/rel8/support/support/util.pcert0 \
-     rtl/rel8/support/support/ground-zero.lisp
-rtl/rel8/support/support/ground-zero.pcert1 : acl2x = 0
-rtl/rel8/support/support/ground-zero.pcert1 : no_pcert = 0
-rtl/rel8/support/support/ground-zero.pcert1 : rtl/rel8/support/support/ground-zero.pcert0
-rtl/rel8/support/support/ground-zero.cert : | rtl/rel8/support/support/ground-zero.pcert1
-
-rtl/rel8/support/support/guards.pcert0 : no_pcert = 0
-rtl/rel8/support/support/guards.pcert0 : acl2x = 0
-rtl/rel8/support/support/guards.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/land.pcert0 \
-     rtl/rel8/support/support/lior.pcert0 \
-     rtl/rel8/support/support/lxor.pcert0 \
-     rtl/rel8/support/support/guards.lisp
-rtl/rel8/support/support/guards.pcert1 : acl2x = 0
-rtl/rel8/support/support/guards.pcert1 : no_pcert = 0
-rtl/rel8/support/support/guards.pcert1 : rtl/rel8/support/support/guards.pcert0
-rtl/rel8/support/support/guards.cert : | rtl/rel8/support/support/guards.pcert1
-
-rtl/rel8/support/support/ireps.pcert0 : no_pcert = 0
-rtl/rel8/support/support/ireps.pcert0 : acl2x = 0
-rtl/rel8/support/support/ireps.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/bias.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/ireps.lisp
-rtl/rel8/support/support/ireps.pcert1 : acl2x = 0
-rtl/rel8/support/support/ireps.pcert1 : no_pcert = 0
-rtl/rel8/support/support/ireps.pcert1 : rtl/rel8/support/support/ireps.pcert0
-rtl/rel8/support/support/ireps.cert : | rtl/rel8/support/support/ireps.pcert1
-
-rtl/rel8/support/support/land.pcert0 : no_pcert = 0
-rtl/rel8/support/support/land.pcert0 : acl2x = 0
-rtl/rel8/support/support/land.pcert0 : \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/land.lisp
-rtl/rel8/support/support/land.pcert1 : acl2x = 0
-rtl/rel8/support/support/land.pcert1 : no_pcert = 0
-rtl/rel8/support/support/land.pcert1 : rtl/rel8/support/support/land.pcert0
-rtl/rel8/support/support/land.cert : | rtl/rel8/support/support/land.pcert1
-
-rtl/rel8/support/support/land0-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/land0-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/land0-proofs.pcert0 : \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/all-ones.pcert0 \
-     rtl/rel8/support/support/log.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/fl-hacks.pcert0 \
-     rtl/rel8/support/support/land0-proofs.lisp
-rtl/rel8/support/support/land0-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/land0-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/land0-proofs.pcert1 : rtl/rel8/support/support/land0-proofs.pcert0
-rtl/rel8/support/support/land0-proofs.cert : | rtl/rel8/support/support/land0-proofs.pcert1
-
-rtl/rel8/support/support/land0.pcert0 : no_pcert = 0
-rtl/rel8/support/support/land0.pcert0 : acl2x = 0
-rtl/rel8/support/support/land0.pcert0 : \
-     rtl/rel8/support/support/land0-proofs.pcert0 \
-     rtl/rel8/support/support/land0.lisp
-rtl/rel8/support/support/land0.pcert1 : acl2x = 0
-rtl/rel8/support/support/land0.pcert1 : no_pcert = 0
-rtl/rel8/support/support/land0.pcert1 : rtl/rel8/support/support/land0.pcert0
-rtl/rel8/support/support/land0.cert : | rtl/rel8/support/support/land0.pcert1
-
-rtl/rel8/support/support/lextra-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lextra-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/lextra-proofs.pcert0 : \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/logxor.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/lextra-proofs.lisp
-rtl/rel8/support/support/lextra-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/lextra-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lextra-proofs.pcert1 : rtl/rel8/support/support/lextra-proofs.pcert0
-rtl/rel8/support/support/lextra-proofs.cert : | rtl/rel8/support/support/lextra-proofs.pcert1
-
-rtl/rel8/support/support/lextra.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lextra.pcert0 : acl2x = 0
-rtl/rel8/support/support/lextra.pcert0 : \
-     rtl/rel8/support/support/land.pcert0 \
-     rtl/rel8/support/support/lior.pcert0 \
-     rtl/rel8/support/support/lxor.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/lextra0.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/merge2.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bits-trunc.pcert0 \
-     rtl/rel8/support/support/fadd.pcert0 \
-     rtl/rel8/support/support/lextra.lisp
-rtl/rel8/support/support/lextra.pcert1 : acl2x = 0
-rtl/rel8/support/support/lextra.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lextra.pcert1 : rtl/rel8/support/support/lextra.pcert0
-rtl/rel8/support/support/lextra.cert : | rtl/rel8/support/support/lextra.pcert1
-
-rtl/rel8/support/support/lextra0.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lextra0.pcert0 : acl2x = 0
-rtl/rel8/support/support/lextra0.pcert0 : \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/lextra-proofs.pcert0 \
-     rtl/rel8/support/support/lextra0.lisp
-rtl/rel8/support/support/lextra0.pcert1 : acl2x = 0
-rtl/rel8/support/support/lextra0.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lextra0.pcert1 : rtl/rel8/support/support/lextra0.pcert0
-rtl/rel8/support/support/lextra0.cert : | rtl/rel8/support/support/lextra0.pcert1
-
-rtl/rel8/support/support/lior.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lior.pcert0 : acl2x = 0
-rtl/rel8/support/support/lior.pcert0 : \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/lior.lisp
-rtl/rel8/support/support/lior.pcert1 : acl2x = 0
-rtl/rel8/support/support/lior.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lior.pcert1 : rtl/rel8/support/support/lior.pcert0
-rtl/rel8/support/support/lior.cert : | rtl/rel8/support/support/lior.pcert1
-
-rtl/rel8/support/support/lior0-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lior0-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/lior0-proofs.pcert0 : \
-     rtl/rel8/support/support/all-ones.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/lior0-proofs.lisp
-rtl/rel8/support/support/lior0-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/lior0-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lior0-proofs.pcert1 : rtl/rel8/support/support/lior0-proofs.pcert0
-rtl/rel8/support/support/lior0-proofs.cert : | rtl/rel8/support/support/lior0-proofs.pcert1
-
-rtl/rel8/support/support/lior0.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lior0.pcert0 : acl2x = 0
-rtl/rel8/support/support/lior0.pcert0 : \
-     rtl/rel8/support/support/lior0-proofs.pcert0 \
-     rtl/rel8/support/support/lior0.lisp
-rtl/rel8/support/support/lior0.pcert1 : acl2x = 0
-rtl/rel8/support/support/lior0.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lior0.pcert1 : rtl/rel8/support/support/lior0.pcert0
-rtl/rel8/support/support/lior0.cert : | rtl/rel8/support/support/lior0.pcert1
-
-rtl/rel8/support/support/lnot-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lnot-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/lnot-proofs.pcert0 : \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/mod.pcert0 \
-     rtl/rel8/arithmetic/mod.pcert0 \
-     rtl/rel8/arithmetic/arith.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/lnot-proofs.lisp
-rtl/rel8/support/support/lnot-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/lnot-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lnot-proofs.pcert1 : rtl/rel8/support/support/lnot-proofs.pcert0
-rtl/rel8/support/support/lnot-proofs.cert : | rtl/rel8/support/support/lnot-proofs.pcert1
-
-rtl/rel8/support/support/lnot.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lnot.pcert0 : acl2x = 0
-rtl/rel8/support/support/lnot.pcert0 : \
-     rtl/rel8/support/support/lnot-proofs.pcert0 \
-     rtl/rel8/support/support/lnot.lisp
-rtl/rel8/support/support/lnot.pcert1 : acl2x = 0
-rtl/rel8/support/support/lnot.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lnot.pcert1 : rtl/rel8/support/support/lnot.pcert0
-rtl/rel8/support/support/lnot.cert : | rtl/rel8/support/support/lnot.pcert1
-
-rtl/rel8/support/support/log-equal.pcert0 : no_pcert = 0
-rtl/rel8/support/support/log-equal.pcert0 : acl2x = 0
-rtl/rel8/support/support/log-equal.pcert0 : \
-     rtl/rel8/support/support/log-equal.lisp
-rtl/rel8/support/support/log-equal.pcert1 : acl2x = 0
-rtl/rel8/support/support/log-equal.pcert1 : no_pcert = 0
-rtl/rel8/support/support/log-equal.pcert1 : rtl/rel8/support/support/log-equal.pcert0
-rtl/rel8/support/support/log-equal.cert : | rtl/rel8/support/support/log-equal.pcert1
-
-rtl/rel8/support/support/log-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/log-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/log-proofs.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/lnot.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/logxor.pcert0 \
-     rtl/rel8/support/support/log-proofs.lisp
-rtl/rel8/support/support/log-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/log-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/log-proofs.pcert1 : rtl/rel8/support/support/log-proofs.pcert0
-rtl/rel8/support/support/log-proofs.cert : | rtl/rel8/support/support/log-proofs.pcert1
-
-rtl/rel8/support/support/log.pcert0 : no_pcert = 0
-rtl/rel8/support/support/log.pcert0 : acl2x = 0
-rtl/rel8/support/support/log.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/log-proofs.pcert0 \
-     rtl/rel8/support/support/lnot.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/logxor.pcert0 \
-     rtl/rel8/support/support/log.lisp
-rtl/rel8/support/support/log.pcert1 : acl2x = 0
-rtl/rel8/support/support/log.pcert1 : no_pcert = 0
-rtl/rel8/support/support/log.pcert1 : rtl/rel8/support/support/log.pcert0
-rtl/rel8/support/support/log.cert : | rtl/rel8/support/support/log.pcert1
-
-rtl/rel8/support/support/logand-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logand-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/logand-proofs.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/induct.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/logand-proofs.lisp
-rtl/rel8/support/support/logand-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/logand-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logand-proofs.pcert1 : rtl/rel8/support/support/logand-proofs.pcert0
-rtl/rel8/support/support/logand-proofs.cert : | rtl/rel8/support/support/logand-proofs.pcert1
-
-rtl/rel8/support/support/logand.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logand.pcert0 : acl2x = 0
-rtl/rel8/support/support/logand.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/logand-proofs.pcert0 \
-     rtl/rel8/support/support/logand.lisp
-rtl/rel8/support/support/logand.pcert1 : acl2x = 0
-rtl/rel8/support/support/logand.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logand.pcert1 : rtl/rel8/support/support/logand.pcert0
-rtl/rel8/support/support/logand.cert : | rtl/rel8/support/support/logand.pcert1
-
-rtl/rel8/support/support/logeqv.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logeqv.pcert0 : acl2x = 0
-rtl/rel8/support/support/logeqv.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/logorc1.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/support/support/logeqv.lisp
-rtl/rel8/support/support/logeqv.pcert1 : acl2x = 0
-rtl/rel8/support/support/logeqv.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logeqv.pcert1 : rtl/rel8/support/support/logeqv.pcert0
-rtl/rel8/support/support/logeqv.cert : | rtl/rel8/support/support/logeqv.pcert1
-
-rtl/rel8/support/support/logior-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logior-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/logior-proofs.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/logior-proofs.lisp
-rtl/rel8/support/support/logior-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/logior-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logior-proofs.pcert1 : rtl/rel8/support/support/logior-proofs.pcert0
-rtl/rel8/support/support/logior-proofs.cert : | rtl/rel8/support/support/logior-proofs.pcert1
-
-rtl/rel8/support/support/logior.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logior.pcert0 : acl2x = 0
-rtl/rel8/support/support/logior.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/logior-proofs.pcert0 \
-     rtl/rel8/support/support/logior.lisp
-rtl/rel8/support/support/logior.pcert1 : acl2x = 0
-rtl/rel8/support/support/logior.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logior.pcert1 : rtl/rel8/support/support/logior.pcert0
-rtl/rel8/support/support/logior.cert : | rtl/rel8/support/support/logior.pcert1
-
-rtl/rel8/support/support/logior1-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logior1-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/logior1-proofs.pcert0 : \
-     rtl/rel8/support/support/logior1-proofs.lisp
-rtl/rel8/support/support/logior1-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/logior1-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logior1-proofs.pcert1 : rtl/rel8/support/support/logior1-proofs.pcert0
-rtl/rel8/support/support/logior1-proofs.cert : | rtl/rel8/support/support/logior1-proofs.pcert1
-
-rtl/rel8/support/support/logior1.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logior1.pcert0 : acl2x = 0
-rtl/rel8/support/support/logior1.pcert0 : \
-     rtl/rel8/support/support/logior1-proofs.pcert0 \
-     rtl/rel8/support/support/logior1.lisp
-rtl/rel8/support/support/logior1.pcert1 : acl2x = 0
-rtl/rel8/support/support/logior1.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logior1.pcert1 : rtl/rel8/support/support/logior1.pcert0
-rtl/rel8/support/support/logior1.cert : | rtl/rel8/support/support/logior1.pcert1
-
-rtl/rel8/support/support/lognot.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lognot.pcert0 : acl2x = 0
-rtl/rel8/support/support/lognot.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/lognot.lisp
-rtl/rel8/support/support/lognot.pcert1 : acl2x = 0
-rtl/rel8/support/support/lognot.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lognot.pcert1 : rtl/rel8/support/support/lognot.pcert0
-rtl/rel8/support/support/lognot.cert : | rtl/rel8/support/support/lognot.pcert1
-
-rtl/rel8/support/support/logorc1.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logorc1.pcert0 : acl2x = 0
-rtl/rel8/support/support/logorc1.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/support/support/logorc1.lisp
-rtl/rel8/support/support/logorc1.pcert1 : acl2x = 0
-rtl/rel8/support/support/logorc1.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logorc1.pcert1 : rtl/rel8/support/support/logorc1.pcert0
-rtl/rel8/support/support/logorc1.cert : | rtl/rel8/support/support/logorc1.pcert1
-
-rtl/rel8/support/support/logs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logs.pcert0 : acl2x = 0
-rtl/rel8/support/support/logs.pcert0 : \
-     rtl/rel8/support/support/logs.lisp
-rtl/rel8/support/support/logs.pcert1 : acl2x = 0
-rtl/rel8/support/support/logs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logs.pcert1 : rtl/rel8/support/support/logs.pcert0
-rtl/rel8/support/support/logs.cert : | rtl/rel8/support/support/logs.pcert1
-
-rtl/rel8/support/support/logxor.pcert0 : no_pcert = 0
-rtl/rel8/support/support/logxor.pcert0 : acl2x = 0
-rtl/rel8/support/support/logxor.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/logeqv.pcert0 \
-     rtl/rel8/support/support/logorc1.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/logxor.lisp
-rtl/rel8/support/support/logxor.pcert1 : acl2x = 0
-rtl/rel8/support/support/logxor.pcert1 : no_pcert = 0
-rtl/rel8/support/support/logxor.pcert1 : rtl/rel8/support/support/logxor.pcert0
-rtl/rel8/support/support/logxor.cert : | rtl/rel8/support/support/logxor.pcert1
-
-rtl/rel8/support/support/lop1-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lop1-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/lop1-proofs.pcert0 : \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/lop1-proofs.lisp
-rtl/rel8/support/support/lop1-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/lop1-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lop1-proofs.pcert1 : rtl/rel8/support/support/lop1-proofs.pcert0
-rtl/rel8/support/support/lop1-proofs.cert : | rtl/rel8/support/support/lop1-proofs.pcert1
-
-rtl/rel8/support/support/lop1.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lop1.pcert0 : acl2x = 0
-rtl/rel8/support/support/lop1.pcert0 : \
-     rtl/rel8/support/support/lop1-proofs.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/lop1.lisp
-rtl/rel8/support/support/lop1.pcert1 : acl2x = 0
-rtl/rel8/support/support/lop1.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lop1.pcert1 : rtl/rel8/support/support/lop1.pcert0
-rtl/rel8/support/support/lop1.cert : | rtl/rel8/support/support/lop1.pcert1
-
-rtl/rel8/support/support/lop2-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lop2-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/lop2-proofs.pcert0 : \
-     rtl/rel8/support/support/lop1.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/lop2-proofs.lisp
-rtl/rel8/support/support/lop2-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/lop2-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lop2-proofs.pcert1 : rtl/rel8/support/support/lop2-proofs.pcert0
-rtl/rel8/support/support/lop2-proofs.cert : | rtl/rel8/support/support/lop2-proofs.pcert1
-
-rtl/rel8/support/support/lop2.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lop2.pcert0 : acl2x = 0
-rtl/rel8/support/support/lop2.pcert0 : \
-     rtl/rel8/support/support/lop1.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lop2-proofs.pcert0 \
-     rtl/rel8/support/support/lop2.lisp
-rtl/rel8/support/support/lop2.pcert1 : acl2x = 0
-rtl/rel8/support/support/lop2.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lop2.pcert1 : rtl/rel8/support/support/lop2.pcert0
-rtl/rel8/support/support/lop2.cert : | rtl/rel8/support/support/lop2.pcert1
-
-rtl/rel8/support/support/lop3-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lop3-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/lop3-proofs.pcert0 : \
-     rtl/rel8/support/support/lop2.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/lop3-proofs.lisp
-rtl/rel8/support/support/lop3-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/lop3-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lop3-proofs.pcert1 : rtl/rel8/support/support/lop3-proofs.pcert0
-rtl/rel8/support/support/lop3-proofs.cert : | rtl/rel8/support/support/lop3-proofs.pcert1
-
-rtl/rel8/support/support/lop3.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lop3.pcert0 : acl2x = 0
-rtl/rel8/support/support/lop3.pcert0 : \
-     rtl/rel8/support/support/lop2.pcert0 \
-     rtl/rel8/support/support/lop3-proofs.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/lop3.lisp
-rtl/rel8/support/support/lop3.pcert1 : acl2x = 0
-rtl/rel8/support/support/lop3.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lop3.pcert1 : rtl/rel8/support/support/lop3.pcert0
-rtl/rel8/support/support/lop3.cert : | rtl/rel8/support/support/lop3.pcert1
-
-rtl/rel8/support/support/lxor.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lxor.pcert0 : acl2x = 0
-rtl/rel8/support/support/lxor.pcert0 : \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/lxor.lisp
-rtl/rel8/support/support/lxor.pcert1 : acl2x = 0
-rtl/rel8/support/support/lxor.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lxor.pcert1 : rtl/rel8/support/support/lxor.pcert0
-rtl/rel8/support/support/lxor.cert : | rtl/rel8/support/support/lxor.pcert1
-
-rtl/rel8/support/support/lxor0-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lxor0-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/lxor0-proofs.pcert0 : \
-     rtl/rel8/support/support/all-ones.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/lxor0-proofs.lisp
-rtl/rel8/support/support/lxor0-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/lxor0-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lxor0-proofs.pcert1 : rtl/rel8/support/support/lxor0-proofs.pcert0
-rtl/rel8/support/support/lxor0-proofs.cert : | rtl/rel8/support/support/lxor0-proofs.pcert1
-
-rtl/rel8/support/support/lxor0.pcert0 : no_pcert = 0
-rtl/rel8/support/support/lxor0.pcert0 : acl2x = 0
-rtl/rel8/support/support/lxor0.pcert0 : \
-     rtl/rel8/support/support/lxor0-proofs.pcert0 \
-     rtl/rel8/support/support/lxor0.lisp
-rtl/rel8/support/support/lxor0.pcert1 : acl2x = 0
-rtl/rel8/support/support/lxor0.pcert1 : no_pcert = 0
-rtl/rel8/support/support/lxor0.pcert1 : rtl/rel8/support/support/lxor0.pcert0
-rtl/rel8/support/support/lxor0.cert : | rtl/rel8/support/support/lxor0.pcert1
-
-rtl/rel8/support/support/merge.pcert0 : no_pcert = 0
-rtl/rel8/support/support/merge.pcert0 : acl2x = 0
-rtl/rel8/support/support/merge.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/log.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/lnot.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/logxor.pcert0 \
-     rtl/rel8/support/support/ocat.pcert0 \
-     rtl/rel8/support/support/sumbits.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/merge.lisp
-rtl/rel8/support/support/merge.pcert1 : acl2x = 0
-rtl/rel8/support/support/merge.pcert1 : no_pcert = 0
-rtl/rel8/support/support/merge.pcert1 : rtl/rel8/support/support/merge.pcert0
-rtl/rel8/support/support/merge.cert : | rtl/rel8/support/support/merge.pcert1
-
-rtl/rel8/support/support/merge2.pcert0 : no_pcert = 0
-rtl/rel8/support/support/merge2.pcert0 : acl2x = 0
-rtl/rel8/support/support/merge2.pcert0 : \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/logs.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/merge2.lisp
-rtl/rel8/support/support/merge2.pcert1 : acl2x = 0
-rtl/rel8/support/support/merge2.pcert1 : no_pcert = 0
-rtl/rel8/support/support/merge2.pcert1 : rtl/rel8/support/support/merge2.pcert0
-rtl/rel8/support/support/merge2.cert : | rtl/rel8/support/support/merge2.pcert1
-
-rtl/rel8/support/support/mod4.pcert0 : no_pcert = 0
-rtl/rel8/support/support/mod4.pcert0 : acl2x = 0
-rtl/rel8/support/support/mod4.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/mod4.lisp
-rtl/rel8/support/support/mod4.pcert1 : acl2x = 0
-rtl/rel8/support/support/mod4.pcert1 : no_pcert = 0
-rtl/rel8/support/support/mod4.pcert1 : rtl/rel8/support/support/mod4.pcert0
-rtl/rel8/support/support/mod4.cert : | rtl/rel8/support/support/mod4.pcert1
-
-rtl/rel8/support/support/model-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/support/model-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/support/model-helpers.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/model-helpers.lisp
-rtl/rel8/support/support/model-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/support/model-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/support/model-helpers.pcert1 : rtl/rel8/support/support/model-helpers.pcert0
-rtl/rel8/support/support/model-helpers.cert : | rtl/rel8/support/support/model-helpers.pcert1
-
-rtl/rel8/support/support/mulcat-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/mulcat-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/mulcat-proofs.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/mulcat-proofs.lisp
-rtl/rel8/support/support/mulcat-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/mulcat-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/mulcat-proofs.pcert1 : rtl/rel8/support/support/mulcat-proofs.pcert0
-rtl/rel8/support/support/mulcat-proofs.cert : | rtl/rel8/support/support/mulcat-proofs.pcert1
-
-rtl/rel8/support/support/mulcat.pcert0 : no_pcert = 0
-rtl/rel8/support/support/mulcat.pcert0 : acl2x = 0
-rtl/rel8/support/support/mulcat.pcert0 : \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/support/support/mulcat-proofs.pcert0 \
-     rtl/rel8/support/support/mulcat.lisp
-rtl/rel8/support/support/mulcat.pcert1 : acl2x = 0
-rtl/rel8/support/support/mulcat.pcert1 : no_pcert = 0
-rtl/rel8/support/support/mulcat.pcert1 : rtl/rel8/support/support/mulcat.pcert0
-rtl/rel8/support/support/mulcat.cert : | rtl/rel8/support/support/mulcat.pcert1
-
-rtl/rel8/support/support/near+-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/near+-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/near+-proofs.pcert0 : \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/away.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/arithmetic/predicate.pcert0 \
-     rtl/rel8/arithmetic/cg.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/fl.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/near+-proofs.lisp
-rtl/rel8/support/support/near+-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/near+-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/near+-proofs.pcert1 : rtl/rel8/support/support/near+-proofs.pcert0
-rtl/rel8/support/support/near+-proofs.cert : | rtl/rel8/support/support/near+-proofs.pcert1
-
-rtl/rel8/support/support/near+.pcert0 : no_pcert = 0
-rtl/rel8/support/support/near+.pcert0 : acl2x = 0
-rtl/rel8/support/support/near+.pcert0 : \
-     rtl/rel8/support/support/near+-proofs.pcert0 \
-     rtl/rel8/support/support/near+.lisp
-rtl/rel8/support/support/near+.pcert1 : acl2x = 0
-rtl/rel8/support/support/near+.pcert1 : no_pcert = 0
-rtl/rel8/support/support/near+.pcert1 : rtl/rel8/support/support/near+.pcert0
-rtl/rel8/support/support/near+.cert : | rtl/rel8/support/support/near+.pcert1
-
-rtl/rel8/support/support/near-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/near-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/near-proofs.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/away.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/near-proofs.lisp
-rtl/rel8/support/support/near-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/near-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/near-proofs.pcert1 : rtl/rel8/support/support/near-proofs.pcert0
-rtl/rel8/support/support/near-proofs.cert : | rtl/rel8/support/support/near-proofs.pcert1
-
-rtl/rel8/support/support/near.pcert0 : no_pcert = 0
-rtl/rel8/support/support/near.pcert0 : acl2x = 0
-rtl/rel8/support/support/near.pcert0 : \
-     rtl/rel8/support/support/near-proofs.pcert0 \
-     rtl/rel8/support/support/near.lisp
-rtl/rel8/support/support/near.pcert1 : acl2x = 0
-rtl/rel8/support/support/near.pcert1 : no_pcert = 0
-rtl/rel8/support/support/near.pcert1 : rtl/rel8/support/support/near.pcert0
-rtl/rel8/support/support/near.cert : | rtl/rel8/support/support/near.pcert1
-
-rtl/rel8/support/support/ocat.pcert0 : no_pcert = 0
-rtl/rel8/support/support/ocat.pcert0 : acl2x = 0
-rtl/rel8/support/support/ocat.pcert0 : \
-     rtl/rel8/arithmetic/expt.pcert0 \
-     rtl/rel8/arithmetic/expo.pcert0 \
-     rtl/rel8/arithmetic/arith2.pcert0 \
-     rtl/rel8/arithmetic/fp2.pcert0 \
-     rtl/rel8/arithmetic/integerp.pcert0 \
-     rtl/rel8/support/support/ocat.lisp
-rtl/rel8/support/support/ocat.pcert1 : acl2x = 0
-rtl/rel8/support/support/ocat.pcert1 : no_pcert = 0
-rtl/rel8/support/support/ocat.pcert1 : rtl/rel8/support/support/ocat.pcert0
-rtl/rel8/support/support/ocat.cert : | rtl/rel8/support/support/ocat.pcert1
-
-rtl/rel8/support/support/oddr-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/oddr-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/oddr-proofs.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/away.pcert0 \
-     rtl/rel8/support/support/near.pcert0 \
-     rtl/rel8/support/support/oddr-proofs.lisp
-rtl/rel8/support/support/oddr-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/oddr-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/oddr-proofs.pcert1 : rtl/rel8/support/support/oddr-proofs.pcert0
-rtl/rel8/support/support/oddr-proofs.cert : | rtl/rel8/support/support/oddr-proofs.pcert1
-
-rtl/rel8/support/support/oddr.pcert0 : no_pcert = 0
-rtl/rel8/support/support/oddr.pcert0 : acl2x = 0
-rtl/rel8/support/support/oddr.pcert0 : \
-     rtl/rel8/support/support/oddr-proofs.pcert0 \
-     rtl/rel8/support/support/oddr.lisp
-rtl/rel8/support/support/oddr.pcert1 : acl2x = 0
-rtl/rel8/support/support/oddr.pcert1 : no_pcert = 0
-rtl/rel8/support/support/oddr.pcert1 : rtl/rel8/support/support/oddr.pcert0
-rtl/rel8/support/support/oddr.cert : | rtl/rel8/support/support/oddr.pcert1
-
-rtl/rel8/support/support/openers.pcert0 : no_pcert = 0
-rtl/rel8/support/support/openers.pcert0 : acl2x = 0
-rtl/rel8/support/support/openers.pcert0 : \
-     rtl/rel8/support/support/openers.lisp
-rtl/rel8/support/support/openers.pcert1 : acl2x = 0
-rtl/rel8/support/support/openers.pcert1 : no_pcert = 0
-rtl/rel8/support/support/openers.pcert1 : rtl/rel8/support/support/openers.pcert0
-rtl/rel8/support/support/openers.cert : | rtl/rel8/support/support/openers.pcert1
-
-rtl/rel8/support/support/package-defs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/package-defs.pcert0 : acl2x = 0
-rtl/rel8/support/support/package-defs.pcert0 : \
-     rtl/rel8/support/support/package-defs.lisp
-rtl/rel8/support/support/package-defs.pcert1 : acl2x = 0
-rtl/rel8/support/support/package-defs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/package-defs.pcert1 : rtl/rel8/support/support/package-defs.pcert0
-rtl/rel8/support/support/package-defs.cert : | rtl/rel8/support/support/package-defs.pcert1
-
-rtl/rel8/support/support/rewrite-theory.pcert0 : no_pcert = 0
-rtl/rel8/support/support/rewrite-theory.pcert0 : acl2x = 0
-rtl/rel8/support/support/rewrite-theory.pcert0 : \
-     rtl/rel8/support/support/rewrite-theory.lisp
-rtl/rel8/support/support/rewrite-theory.pcert1 : acl2x = 0
-rtl/rel8/support/support/rewrite-theory.pcert1 : no_pcert = 0
-rtl/rel8/support/support/rewrite-theory.pcert1 : rtl/rel8/support/support/rewrite-theory.pcert0
-rtl/rel8/support/support/rewrite-theory.cert : | rtl/rel8/support/support/rewrite-theory.pcert1
-
-rtl/rel8/support/support/rnd.pcert0 : no_pcert = 0
-rtl/rel8/support/support/rnd.pcert0 : acl2x = 0
-rtl/rel8/support/support/rnd.pcert0 : \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/away.pcert0 \
-     rtl/rel8/support/support/near.pcert0 \
-     rtl/rel8/support/support/near+.pcert0 \
-     rtl/rel8/support/support/sticky.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bits-trunc.pcert0 \
-     rtl/rel8/support/support/rnd.lisp
-rtl/rel8/support/support/rnd.pcert1 : acl2x = 0
-rtl/rel8/support/support/rnd.pcert1 : no_pcert = 0
-rtl/rel8/support/support/rnd.pcert1 : rtl/rel8/support/support/rnd.pcert0
-rtl/rel8/support/support/rnd.cert : | rtl/rel8/support/support/rnd.pcert1
-
-rtl/rel8/support/support/rom-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/support/rom-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/support/rom-helpers.pcert0 : \
-     rtl/rel8/support/support/rom-helpers.lisp
-rtl/rel8/support/support/rom-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/support/rom-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/support/rom-helpers.pcert1 : rtl/rel8/support/support/rom-helpers.pcert0
-rtl/rel8/support/support/rom-helpers.cert : | rtl/rel8/support/support/rom-helpers.pcert1
-
-rtl/rel8/support/support/round-extra.pcert0 : no_pcert = 0
-rtl/rel8/support/support/round-extra.pcert0 : acl2x = 0
-rtl/rel8/support/support/round-extra.pcert0 : \
-     rtl/rel8/support/support/sticky.pcert0 \
-     rtl/rel8/support/support/util.pcert0 \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/round-extra.lisp
-rtl/rel8/support/support/round-extra.pcert1 : acl2x = 0
-rtl/rel8/support/support/round-extra.pcert1 : no_pcert = 0
-rtl/rel8/support/support/round-extra.pcert1 : rtl/rel8/support/support/round-extra.pcert0
-rtl/rel8/support/support/round-extra.cert : | rtl/rel8/support/support/round-extra.pcert1
-
-rtl/rel8/support/support/rtl.pcert0 : no_pcert = 0
-rtl/rel8/support/support/rtl.pcert0 : acl2x = 0
-rtl/rel8/support/support/rtl.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/rtlarr.pcert0 \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/support/support/rtl.lisp
-rtl/rel8/support/support/rtl.pcert1 : acl2x = 0
-rtl/rel8/support/support/rtl.pcert1 : no_pcert = 0
-rtl/rel8/support/support/rtl.pcert1 : rtl/rel8/support/support/rtl.pcert0
-rtl/rel8/support/support/rtl.cert : | rtl/rel8/support/support/rtl.pcert1
-
-rtl/rel8/support/support/rtlarr.pcert0 : no_pcert = 0
-rtl/rel8/support/support/rtlarr.pcert0 : acl2x = 0
-rtl/rel8/support/support/rtlarr.pcert0 : \
-     misc/total-order.pcert0 \
-     rtl/rel8/support/support/rtlarr.lisp
-rtl/rel8/support/support/rtlarr.pcert1 : acl2x = 0
-rtl/rel8/support/support/rtlarr.pcert1 : no_pcert = 0
-rtl/rel8/support/support/rtlarr.pcert1 : rtl/rel8/support/support/rtlarr.pcert0
-rtl/rel8/support/support/rtlarr.cert : | rtl/rel8/support/support/rtlarr.pcert1
-
-rtl/rel8/support/support/setbitn-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/setbitn-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/setbitn-proofs.pcert0 : \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/support/support/setbits.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/setbitn-proofs.lisp
-rtl/rel8/support/support/setbitn-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/setbitn-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/setbitn-proofs.pcert1 : rtl/rel8/support/support/setbitn-proofs.pcert0
-rtl/rel8/support/support/setbitn-proofs.cert : | rtl/rel8/support/support/setbitn-proofs.pcert1
-
-rtl/rel8/support/support/setbitn.pcert0 : no_pcert = 0
-rtl/rel8/support/support/setbitn.pcert0 : acl2x = 0
-rtl/rel8/support/support/setbitn.pcert0 : \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/support/support/setbitn-proofs.pcert0 \
-     rtl/rel8/support/support/setbitn.lisp
-rtl/rel8/support/support/setbitn.pcert1 : acl2x = 0
-rtl/rel8/support/support/setbitn.pcert1 : no_pcert = 0
-rtl/rel8/support/support/setbitn.pcert1 : rtl/rel8/support/support/setbitn.pcert0
-rtl/rel8/support/support/setbitn.cert : | rtl/rel8/support/support/setbitn.pcert1
-
-rtl/rel8/support/support/setbits-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/setbits-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/setbits-proofs.pcert0 : \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/setbits-proofs.lisp
-rtl/rel8/support/support/setbits-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/setbits-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/setbits-proofs.pcert1 : rtl/rel8/support/support/setbits-proofs.pcert0
-rtl/rel8/support/support/setbits-proofs.cert : | rtl/rel8/support/support/setbits-proofs.pcert1
-
-rtl/rel8/support/support/setbits.pcert0 : no_pcert = 0
-rtl/rel8/support/support/setbits.pcert0 : acl2x = 0
-rtl/rel8/support/support/setbits.pcert0 : \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/support/support/setbits-proofs.pcert0 \
-     rtl/rel8/support/support/setbits.lisp
-rtl/rel8/support/support/setbits.pcert1 : acl2x = 0
-rtl/rel8/support/support/setbits.pcert1 : no_pcert = 0
-rtl/rel8/support/support/setbits.pcert1 : rtl/rel8/support/support/setbits.pcert0
-rtl/rel8/support/support/setbits.cert : | rtl/rel8/support/support/setbits.pcert1
-
-rtl/rel8/support/support/sgn.pcert0 : no_pcert = 0
-rtl/rel8/support/support/sgn.pcert0 : acl2x = 0
-rtl/rel8/support/support/sgn.pcert0 : \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/sgn.lisp
-rtl/rel8/support/support/sgn.pcert1 : acl2x = 0
-rtl/rel8/support/support/sgn.pcert1 : no_pcert = 0
-rtl/rel8/support/support/sgn.pcert1 : rtl/rel8/support/support/sgn.pcert0
-rtl/rel8/support/support/sgn.cert : | rtl/rel8/support/support/sgn.pcert1
-
-rtl/rel8/support/support/shft.pcert0 : no_pcert = 0
-rtl/rel8/support/support/shft.pcert0 : acl2x = 0
-rtl/rel8/support/support/shft.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/shft.lisp
-rtl/rel8/support/support/shft.pcert1 : acl2x = 0
-rtl/rel8/support/support/shft.pcert1 : no_pcert = 0
-rtl/rel8/support/support/shft.pcert1 : rtl/rel8/support/support/shft.pcert0
-rtl/rel8/support/support/shft.cert : | rtl/rel8/support/support/shft.pcert1
-
-rtl/rel8/support/support/simple-loop-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/support/simple-loop-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/support/simple-loop-helpers.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/setbitn.pcert0 \
-     rtl/rel8/support/support/simple-loop-helpers.lisp
-rtl/rel8/support/support/simple-loop-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/support/simple-loop-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/support/simple-loop-helpers.pcert1 : rtl/rel8/support/support/simple-loop-helpers.pcert0
-rtl/rel8/support/support/simple-loop-helpers.cert : | rtl/rel8/support/support/simple-loop-helpers.pcert1
-
-rtl/rel8/support/support/simplify-model-helpers.pcert0 : no_pcert = 0
-rtl/rel8/support/support/simplify-model-helpers.pcert0 : acl2x = 0
-rtl/rel8/support/support/simplify-model-helpers.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/simplify-model-helpers.lisp
-rtl/rel8/support/support/simplify-model-helpers.pcert1 : acl2x = 0
-rtl/rel8/support/support/simplify-model-helpers.pcert1 : no_pcert = 0
-rtl/rel8/support/support/simplify-model-helpers.pcert1 : rtl/rel8/support/support/simplify-model-helpers.pcert0
-rtl/rel8/support/support/simplify-model-helpers.cert : | rtl/rel8/support/support/simplify-model-helpers.pcert1
-
-rtl/rel8/support/support/stick-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/stick-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/stick-proofs.pcert0 : \
-     rtl/rel8/support/support/merge.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/lnot.pcert0 \
-     rtl/rel8/support/support/stick-proofs.lisp
-rtl/rel8/support/support/stick-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/stick-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/stick-proofs.pcert1 : rtl/rel8/support/support/stick-proofs.pcert0
-rtl/rel8/support/support/stick-proofs.cert : | rtl/rel8/support/support/stick-proofs.pcert1
-
-rtl/rel8/support/support/stick.pcert0 : no_pcert = 0
-rtl/rel8/support/support/stick.pcert0 : acl2x = 0
-rtl/rel8/support/support/stick.pcert0 : \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/stick-proofs.pcert0 \
-     rtl/rel8/support/support/stick.lisp
-rtl/rel8/support/support/stick.pcert1 : acl2x = 0
-rtl/rel8/support/support/stick.pcert1 : no_pcert = 0
-rtl/rel8/support/support/stick.pcert1 : rtl/rel8/support/support/stick.pcert0
-rtl/rel8/support/support/stick.cert : | rtl/rel8/support/support/stick.pcert1
-
-rtl/rel8/support/support/sticky-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/sticky-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/sticky-proofs.pcert0 : \
-     rtl/rel8/arithmetic/arith.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/away.pcert0 \
-     rtl/rel8/support/support/near.pcert0 \
-     rtl/rel8/support/support/near+.pcert0 \
-     rtl/rel8/support/support/sticky-proofs.lisp
-rtl/rel8/support/support/sticky-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/sticky-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/sticky-proofs.pcert1 : rtl/rel8/support/support/sticky-proofs.pcert0
-rtl/rel8/support/support/sticky-proofs.cert : | rtl/rel8/support/support/sticky-proofs.pcert1
-
-rtl/rel8/support/support/sticky.pcert0 : no_pcert = 0
-rtl/rel8/support/support/sticky.pcert0 : acl2x = 0
-rtl/rel8/support/support/sticky.pcert0 : \
-     rtl/rel8/support/support/sticky-proofs.pcert0 \
-     rtl/rel8/support/support/sticky.lisp
-rtl/rel8/support/support/sticky.pcert1 : acl2x = 0
-rtl/rel8/support/support/sticky.pcert1 : no_pcert = 0
-rtl/rel8/support/support/sticky.pcert1 : rtl/rel8/support/support/sticky.pcert0
-rtl/rel8/support/support/sticky.cert : | rtl/rel8/support/support/sticky.pcert1
-
-rtl/rel8/support/support/sumbits.pcert0 : no_pcert = 0
-rtl/rel8/support/support/sumbits.pcert0 : acl2x = 0
-rtl/rel8/support/support/sumbits.pcert0 : \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/sumbits.lisp
-rtl/rel8/support/support/sumbits.pcert1 : acl2x = 0
-rtl/rel8/support/support/sumbits.pcert1 : no_pcert = 0
-rtl/rel8/support/support/sumbits.pcert1 : rtl/rel8/support/support/sumbits.pcert0
-rtl/rel8/support/support/sumbits.cert : | rtl/rel8/support/support/sumbits.pcert1
-
-rtl/rel8/support/support/top.pcert0 : no_pcert = 0
-rtl/rel8/support/support/top.pcert0 : acl2x = 0
-rtl/rel8/support/support/top.pcert0 : \
-     rtl/rel8/support/support/top1.pcert0 \
-     rtl/rel8/support/support/lextra.pcert0 \
-     rtl/rel8/support/support/fadd-extra.pcert0 \
-     rtl/rel8/support/support/float-extra.pcert0 \
-     rtl/rel8/support/support/round-extra.pcert0 \
-     rtl/rel8/support/support/guards.pcert0 \
-     rtl/rel8/support/support/badguys.pcert0 \
-     rtl/rel8/support/support/top.lisp
-rtl/rel8/support/support/top.pcert1 : acl2x = 0
-rtl/rel8/support/support/top.pcert1 : no_pcert = 0
-rtl/rel8/support/support/top.pcert1 : rtl/rel8/support/support/top.pcert0
-rtl/rel8/support/support/top.cert : | rtl/rel8/support/support/top.pcert1
-
-rtl/rel8/support/support/top1.pcert0 : no_pcert = 0
-rtl/rel8/support/support/top1.pcert0 : acl2x = 0
-rtl/rel8/support/support/top1.pcert0 : \
-     rtl/rel8/support/support/util.pcert0 \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/rewrite-theory.pcert0 \
-     rtl/rel8/support/support/rtl.pcert0 \
-     rtl/rel8/support/support/rtlarr.pcert0 \
-     rtl/rel8/support/support/bvecp-lemmas.pcert0 \
-     rtl/rel8/support/support/bits.pcert0 \
-     rtl/rel8/support/support/bitn.pcert0 \
-     rtl/rel8/support/support/ocat.pcert0 \
-     rtl/rel8/support/support/cat-def.pcert0 \
-     rtl/rel8/support/support/cat.pcert0 \
-     rtl/rel8/support/support/bvecp.pcert0 \
-     rtl/rel8/support/support/ash.pcert0 \
-     rtl/rel8/support/support/decode.pcert0 \
-     rtl/rel8/support/support/encode.pcert0 \
-     rtl/rel8/support/support/mulcat.pcert0 \
-     rtl/rel8/support/support/shft.pcert0 \
-     rtl/rel8/support/support/all-ones.pcert0 \
-     rtl/rel8/support/support/merge2.pcert0 \
-     rtl/rel8/support/support/logior1.pcert0 \
-     rtl/rel8/support/support/setbits.pcert0 \
-     rtl/rel8/support/support/setbitn.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/support/support/bias.pcert0 \
-     rtl/rel8/support/support/ereps.pcert0 \
-     rtl/rel8/support/support/ireps.pcert0 \
-     rtl/rel8/support/support/logeqv.pcert0 \
-     rtl/rel8/support/support/logorc1.pcert0 \
-     rtl/rel8/support/support/lognot.pcert0 \
-     rtl/rel8/support/support/logand.pcert0 \
-     rtl/rel8/support/support/logior.pcert0 \
-     rtl/rel8/support/support/logxor.pcert0 \
-     rtl/rel8/support/support/log.pcert0 \
-     rtl/rel8/support/support/lnot.pcert0 \
-     rtl/rel8/support/support/land0.pcert0 \
-     rtl/rel8/support/support/lior0.pcert0 \
-     rtl/rel8/support/support/lxor0.pcert0 \
-     rtl/rel8/support/support/lextra0.pcert0 \
-     rtl/rel8/support/support/logs.pcert0 \
-     rtl/rel8/support/support/trunc.pcert0 \
-     rtl/rel8/support/support/away.pcert0 \
-     rtl/rel8/support/support/near.pcert0 \
-     rtl/rel8/support/support/near+.pcert0 \
-     rtl/rel8/support/support/oddr.pcert0 \
-     rtl/rel8/support/support/sticky.pcert0 \
-     rtl/rel8/support/support/rnd.pcert0 \
-     rtl/rel8/support/support/drnd-original.pcert0 \
-     rtl/rel8/support/support/bits-trunc.pcert0 \
-     rtl/rel8/support/support/add3.pcert0 \
-     rtl/rel8/support/support/lop1.pcert0 \
-     rtl/rel8/support/support/lop2.pcert0 \
-     rtl/rel8/support/support/lop3.pcert0 \
-     rtl/rel8/support/support/stick.pcert0 \
-     rtl/rel8/support/support/bvecp-helpers.pcert0 \
-     rtl/rel8/support/support/model-helpers.pcert0 \
-     rtl/rel8/support/support/rom-helpers.pcert0 \
-     rtl/rel8/support/support/simple-loop-helpers.pcert0 \
-     rtl/rel8/support/support/clocks.pcert0 \
-     rtl/rel8/support/support/openers.pcert0 \
-     rtl/rel8/support/support/package-defs.pcert0 \
-     rtl/rel8/support/support/simplify-model-helpers.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/arithmetic/fp.pcert0 \
-     rtl/rel8/support/support/fadd.pcert0 \
-     rtl/rel8/support/support/top1.lisp
-rtl/rel8/support/support/top1.pcert1 : acl2x = 0
-rtl/rel8/support/support/top1.pcert1 : no_pcert = 0
-rtl/rel8/support/support/top1.pcert1 : rtl/rel8/support/support/top1.pcert0
-rtl/rel8/support/support/top1.cert : | rtl/rel8/support/support/top1.pcert1
-
-rtl/rel8/support/support/trunc-proofs.pcert0 : no_pcert = 0
-rtl/rel8/support/support/trunc-proofs.pcert0 : acl2x = 0
-rtl/rel8/support/support/trunc-proofs.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/float.pcert0 \
-     rtl/rel8/arithmetic/top.pcert0 \
-     rtl/rel8/support/support/trunc-proofs.lisp
-rtl/rel8/support/support/trunc-proofs.pcert1 : acl2x = 0
-rtl/rel8/support/support/trunc-proofs.pcert1 : no_pcert = 0
-rtl/rel8/support/support/trunc-proofs.pcert1 : rtl/rel8/support/support/trunc-proofs.pcert0
-rtl/rel8/support/support/trunc-proofs.cert : | rtl/rel8/support/support/trunc-proofs.pcert1
-
-rtl/rel8/support/support/trunc.pcert0 : no_pcert = 0
-rtl/rel8/support/support/trunc.pcert0 : acl2x = 0
-rtl/rel8/support/support/trunc.pcert0 : \
-     rtl/rel8/support/support/ground-zero.pcert0 \
-     rtl/rel8/support/support/trunc-proofs.pcert0 \
-     rtl/rel8/support/support/trunc.lisp
-rtl/rel8/support/support/trunc.pcert1 : acl2x = 0
-rtl/rel8/support/support/trunc.pcert1 : no_pcert = 0
-rtl/rel8/support/support/trunc.pcert1 : rtl/rel8/support/support/trunc.pcert0
-rtl/rel8/support/support/trunc.cert : | rtl/rel8/support/support/trunc.pcert1
-
-rtl/rel8/support/support/util.pcert0 : no_pcert = 0
-rtl/rel8/support/support/util.pcert0 : acl2x = 0
-rtl/rel8/support/support/util.pcert0 : \
-     rtl/rel8/support/support/util.lisp
-rtl/rel8/support/support/util.pcert1 : acl2x = 0
-rtl/rel8/support/support/util.pcert1 : no_pcert = 0
-rtl/rel8/support/support/util.pcert1 : rtl/rel8/support/support/util.pcert0
-rtl/rel8/support/support/util.cert : | rtl/rel8/support/support/util.pcert1
-
-rtl/rel8/support/top/top.pcert0 : no_pcert = 0
-rtl/rel8/support/top/top.pcert0 : acl2x = 0
-rtl/rel8/support/top/top.pcert0 : \
-     rtl/rel8/support/lib2.delta1/rtl.pcert0 \
-     rtl/rel8/support/lib2.delta1/rtlarr.pcert0 \
-     rtl/rel8/support/lib2/basic.pcert0 \
-     rtl/rel8/support/lib2.delta2/bits.pcert0 \
-     rtl/rel8/support/lib2.delta2/log.pcert0 \
-     rtl/rel8/support/lib2.delta1/float.pcert0 \
-     rtl/rel8/support/lib2.delta1/reps.pcert0 \
-     rtl/rel8/support/lib2.delta1/round.pcert0 \
-     rtl/rel8/support/lib2.delta2/add.pcert0 \
-     rtl/rel8/support/lib2.delta1/mult.pcert0 \
-     rtl/rel8/support/lib2.delta1/arith.pcert0 \
-     rtl/rel8/support/lib2.delta1/util.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/simple-loop-helpers.pcert0 \
-     rtl/rel8/support/lib2/rom-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/bvecp-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn.pcert0 \
-     rtl/rel8/support/lib2.delta1/simplify-model-helpers.pcert0 \
-     rtl/rel8/support/lib2.delta1/logn2log.pcert0 \
-     rtl/rel8/support/top/top.lisp
-rtl/rel8/support/top/top.pcert1 : acl2x = 0
-rtl/rel8/support/top/top.pcert1 : no_pcert = 0
-rtl/rel8/support/top/top.pcert1 : rtl/rel8/support/top/top.pcert0
-rtl/rel8/support/top/top.cert : | rtl/rel8/support/top/top.pcert1
-
-security/jfkr/diffie-helman.pcert0 : no_pcert = 0
-security/jfkr/diffie-helman.pcert0 : acl2x = 0
-security/jfkr/diffie-helman.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     security/jfkr/diffie-helman.lisp \
-     security/jfkr/cert.acl2 \
-     security/jfkr/package.lsp
-security/jfkr/diffie-helman.pcert1 : acl2x = 0
-security/jfkr/diffie-helman.pcert1 : no_pcert = 0
-security/jfkr/diffie-helman.pcert1 : security/jfkr/diffie-helman.pcert0
-security/jfkr/diffie-helman.cert : | security/jfkr/diffie-helman.pcert1
-
-security/jfkr/encryption.pcert0 : no_pcert = 0
-security/jfkr/encryption.pcert0 : acl2x = 0
-security/jfkr/encryption.pcert0 : \
-     security/jfkr/encryption.lisp \
-     security/jfkr/cert.acl2 \
-     security/jfkr/package.lsp
-security/jfkr/encryption.pcert1 : acl2x = 0
-security/jfkr/encryption.pcert1 : no_pcert = 0
-security/jfkr/encryption.pcert1 : security/jfkr/encryption.pcert0
-security/jfkr/encryption.cert : | security/jfkr/encryption.pcert1
-
-security/jfkr/jfkr.pcert0 : no_pcert = 0
-security/jfkr/jfkr.pcert0 : acl2x = 0
-security/jfkr/jfkr.pcert0 : \
-     security/jfkr/encryption.pcert0 \
-     security/jfkr/diffie-helman.pcert0 \
-     security/jfkr/random.pcert0 \
-     misc/assert.pcert0 \
-     misc/untranslate-patterns.pcert0 \
-     security/jfkr/jfkr.lisp \
-     security/jfkr/cert.acl2 \
-     security/jfkr/package.lsp
-security/jfkr/jfkr.pcert1 : acl2x = 0
-security/jfkr/jfkr.pcert1 : no_pcert = 0
-security/jfkr/jfkr.pcert1 : security/jfkr/jfkr.pcert0
-security/jfkr/jfkr.cert : | security/jfkr/jfkr.pcert1
-
-security/jfkr/random.pcert0 : no_pcert = 0
-security/jfkr/random.pcert0 : acl2x = 0
-security/jfkr/random.pcert0 : \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     security/jfkr/random.lisp \
-     security/jfkr/cert.acl2 \
-     security/jfkr/package.lsp
-security/jfkr/random.pcert1 : acl2x = 0
-security/jfkr/random.pcert1 : no_pcert = 0
-security/jfkr/random.pcert1 : security/jfkr/random.pcert0
-security/jfkr/random.cert : | security/jfkr/random.pcert1
-
-security/suite-b/sha-2.pcert0 : no_pcert = 0
-security/suite-b/sha-2.pcert0 : acl2x = 0
-security/suite-b/sha-2.pcert0 : \
-     security/util/byte-operations.pcert0 \
-     security/suite-b/sha-2.lisp
-security/suite-b/sha-2.pcert1 : acl2x = 0
-security/suite-b/sha-2.pcert1 : no_pcert = 0
-security/suite-b/sha-2.pcert1 : security/suite-b/sha-2.pcert0
-security/suite-b/sha-2.cert : | security/suite-b/sha-2.pcert1
-
-security/util/byte-operations.pcert0 : no_pcert = 0
-security/util/byte-operations.pcert0 : acl2x = 0
-security/util/byte-operations.pcert0 : \
-     arithmetic-5/top.pcert0 \
-     security/util/byte-operations.lisp
-security/util/byte-operations.pcert1 : acl2x = 0
-security/util/byte-operations.pcert1 : no_pcert = 0
-security/util/byte-operations.pcert1 : security/util/byte-operations.pcert0
-security/util/byte-operations.cert : | security/util/byte-operations.pcert1
-
-serialize/serialize-tests.pcert0 : no_pcert = 0
-serialize/serialize-tests.pcert0 : acl2x = 0
-serialize/serialize-tests.pcert0 : \
-     serialize/unsound-read.pcert0 \
-     tools/bstar.pcert0 \
-     serialize/serialize-tests.lisp \
-     serialize/serialize-tests.acl2
-serialize/serialize-tests.pcert1 : acl2x = 0
-serialize/serialize-tests.pcert1 : no_pcert = 0
-serialize/serialize-tests.pcert1 : serialize/serialize-tests.pcert0
-serialize/serialize-tests.cert : | serialize/serialize-tests.pcert1
-
-serialize/serialize-tests2.pcert0 : no_pcert = 0
-serialize/serialize-tests2.pcert0 : acl2x = 0
-serialize/serialize-tests2.pcert0 : \
-     serialize/serialize-tests.pcert0 \
-     serialize/serialize-tests2.lisp \
-     serialize/serialize-tests2.acl2
-serialize/serialize-tests2.pcert1 : acl2x = 0
-serialize/serialize-tests2.pcert1 : no_pcert = 0
-serialize/serialize-tests2.pcert1 : serialize/serialize-tests2.pcert0
-serialize/serialize-tests2.cert : | serialize/serialize-tests2.pcert1
-
-serialize/unsound-read.pcert0 : no_pcert = 0
-serialize/unsound-read.pcert0 : acl2x = 0
-serialize/unsound-read.pcert0 : \
-     tools/include-raw.pcert0 \
-     serialize/unsound-read.lisp \
-     serialize/unsound-read.acl2 \
-     serialize/unsound-read-raw.lsp
-serialize/unsound-read.pcert1 : acl2x = 0
-serialize/unsound-read.pcert1 : no_pcert = 0
-serialize/unsound-read.pcert1 : serialize/unsound-read.pcert0
-serialize/unsound-read.cert : | serialize/unsound-read.pcert1
-
-sorting/bsort.pcert0 : no_pcert = 0
-sorting/bsort.pcert0 : acl2x = 0
-sorting/bsort.pcert0 : \
-     sorting/ordered-perms.pcert0 \
-     sorting/convert-perm-to-how-many.pcert0 \
-     sorting/bsort.lisp
-sorting/bsort.pcert1 : acl2x = 0
-sorting/bsort.pcert1 : no_pcert = 0
-sorting/bsort.pcert1 : sorting/bsort.pcert0
-sorting/bsort.cert : | sorting/bsort.pcert1
-
-sorting/convert-perm-to-how-many.pcert0 : no_pcert = 0
-sorting/convert-perm-to-how-many.pcert0 : acl2x = 0
-sorting/convert-perm-to-how-many.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/convert-perm-to-how-many.lisp
-sorting/convert-perm-to-how-many.pcert1 : acl2x = 0
-sorting/convert-perm-to-how-many.pcert1 : no_pcert = 0
-sorting/convert-perm-to-how-many.pcert1 : sorting/convert-perm-to-how-many.pcert0
-sorting/convert-perm-to-how-many.cert : | sorting/convert-perm-to-how-many.pcert1
-
-sorting/equisort.pcert0 : no_pcert = 0
-sorting/equisort.pcert0 : acl2x = 0
-sorting/equisort.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/ordered-perms.pcert0 \
-     sorting/convert-perm-to-how-many.pcert0 \
-     sorting/equisort.lisp
-sorting/equisort.pcert1 : acl2x = 0
-sorting/equisort.pcert1 : no_pcert = 0
-sorting/equisort.pcert1 : sorting/equisort.pcert0
-sorting/equisort.cert : | sorting/equisort.pcert1
-
-sorting/equisort2.pcert0 : no_pcert = 0
-sorting/equisort2.pcert0 : acl2x = 0
-sorting/equisort2.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/ordered-perms.pcert0 \
-     sorting/convert-perm-to-how-many.pcert0 \
-     sorting/equisort2.lisp
-sorting/equisort2.pcert1 : acl2x = 0
-sorting/equisort2.pcert1 : no_pcert = 0
-sorting/equisort2.pcert1 : sorting/equisort2.pcert0
-sorting/equisort2.cert : | sorting/equisort2.pcert1
-
-sorting/equisort3.pcert0 : no_pcert = 0
-sorting/equisort3.pcert0 : acl2x = 0
-sorting/equisort3.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/ordered-perms.pcert0 \
-     sorting/convert-perm-to-how-many.pcert0 \
-     sorting/equisort3.lisp
-sorting/equisort3.pcert1 : acl2x = 0
-sorting/equisort3.pcert1 : no_pcert = 0
-sorting/equisort3.pcert1 : sorting/equisort3.pcert0
-sorting/equisort3.cert : | sorting/equisort3.pcert1
-
-sorting/isort.pcert0 : no_pcert = 0
-sorting/isort.pcert0 : acl2x = 0
-sorting/isort.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/ordered-perms.pcert0 \
-     sorting/convert-perm-to-how-many.pcert0 \
-     sorting/isort.lisp
-sorting/isort.pcert1 : acl2x = 0
-sorting/isort.pcert1 : no_pcert = 0
-sorting/isort.pcert1 : sorting/isort.pcert0
-sorting/isort.cert : | sorting/isort.pcert1
-
-sorting/msort.pcert0 : no_pcert = 0
-sorting/msort.pcert0 : acl2x = 0
-sorting/msort.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/ordered-perms.pcert0 \
-     sorting/convert-perm-to-how-many.pcert0 \
-     sorting/msort.lisp
-sorting/msort.pcert1 : acl2x = 0
-sorting/msort.pcert1 : no_pcert = 0
-sorting/msort.pcert1 : sorting/msort.pcert0
-sorting/msort.cert : | sorting/msort.pcert1
-
-sorting/no-dups-qsort.pcert0 : no_pcert = 0
-sorting/no-dups-qsort.pcert0 : acl2x = 0
-sorting/no-dups-qsort.pcert0 : \
-     sorting/qsort.pcert0 \
-     sorting/no-dups-qsort.lisp
-sorting/no-dups-qsort.pcert1 : acl2x = 0
-sorting/no-dups-qsort.pcert1 : no_pcert = 0
-sorting/no-dups-qsort.pcert1 : sorting/no-dups-qsort.pcert0
-sorting/no-dups-qsort.cert : | sorting/no-dups-qsort.pcert1
-
-sorting/ordered-perms.pcert0 : no_pcert = 0
-sorting/ordered-perms.pcert0 : acl2x = 0
-sorting/ordered-perms.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/ordered-perms.lisp
-sorting/ordered-perms.pcert1 : acl2x = 0
-sorting/ordered-perms.pcert1 : no_pcert = 0
-sorting/ordered-perms.pcert1 : sorting/ordered-perms.pcert0
-sorting/ordered-perms.cert : | sorting/ordered-perms.pcert1
-
-sorting/perm.pcert0 : no_pcert = 0
-sorting/perm.pcert0 : acl2x = 0
-sorting/perm.pcert0 : \
-     sorting/perm.lisp
-sorting/perm.pcert1 : acl2x = 0
-sorting/perm.pcert1 : no_pcert = 0
-sorting/perm.pcert1 : sorting/perm.pcert0
-sorting/perm.cert : | sorting/perm.pcert1
-
-sorting/qsort.pcert0 : no_pcert = 0
-sorting/qsort.pcert0 : acl2x = 0
-sorting/qsort.pcert0 : \
-     sorting/perm.pcert0 \
-     sorting/ordered-perms.pcert0 \
-     sorting/convert-perm-to-how-many.pcert0 \
-     arithmetic-3/extra/top-ext.pcert0 \
-     sorting/qsort.lisp
-sorting/qsort.pcert1 : acl2x = 0
-sorting/qsort.pcert1 : no_pcert = 0
-sorting/qsort.pcert1 : sorting/qsort.pcert0
-sorting/qsort.cert : | sorting/qsort.pcert1
-
-sorting/sorts-equivalent.pcert0 : no_pcert = 0
-sorting/sorts-equivalent.pcert0 : acl2x = 0
-sorting/sorts-equivalent.pcert0 : \
-     sorting/equisort.pcert0 \
-     sorting/isort.pcert0 \
-     sorting/msort.pcert0 \
-     sorting/qsort.pcert0 \
-     sorting/bsort.pcert0 \
-     sorting/sorts-equivalent.lisp
-sorting/sorts-equivalent.pcert1 : acl2x = 0
-sorting/sorts-equivalent.pcert1 : no_pcert = 0
-sorting/sorts-equivalent.pcert1 : sorting/sorts-equivalent.pcert0
-sorting/sorts-equivalent.cert : | sorting/sorts-equivalent.pcert1
-
-sorting/sorts-equivalent2.pcert0 : no_pcert = 0
-sorting/sorts-equivalent2.pcert0 : acl2x = 0
-sorting/sorts-equivalent2.pcert0 : \
-     sorting/equisort2.pcert0 \
-     sorting/isort.pcert0 \
-     sorting/msort.pcert0 \
-     sorting/qsort.pcert0 \
-     sorting/bsort.pcert0 \
-     sorting/sorts-equivalent2.lisp
-sorting/sorts-equivalent2.pcert1 : acl2x = 0
-sorting/sorts-equivalent2.pcert1 : no_pcert = 0
-sorting/sorts-equivalent2.pcert1 : sorting/sorts-equivalent2.pcert0
-sorting/sorts-equivalent2.cert : | sorting/sorts-equivalent2.pcert1
-
-sorting/sorts-equivalent3.pcert0 : no_pcert = 0
-sorting/sorts-equivalent3.pcert0 : acl2x = 0
-sorting/sorts-equivalent3.pcert0 : \
-     sorting/equisort3.pcert0 \
-     sorting/isort.pcert0 \
-     sorting/msort.pcert0 \
-     sorting/qsort.pcert0 \
-     sorting/bsort.pcert0 \
-     sorting/sorts-equivalent3.lisp
-sorting/sorts-equivalent3.pcert1 : acl2x = 0
-sorting/sorts-equivalent3.pcert1 : no_pcert = 0
-sorting/sorts-equivalent3.pcert1 : sorting/sorts-equivalent3.pcert0
-sorting/sorts-equivalent3.cert : | sorting/sorts-equivalent3.pcert1
-
-std/io/base.pcert0 : no_pcert = 0
-std/io/base.pcert0 : acl2x = 0
-std/io/base.pcert0 : \
-     xdoc/top.pcert0 \
-     system/f-put-global.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     std/io/base.lisp
-std/io/base.pcert1 : acl2x = 0
-std/io/base.pcert1 : no_pcert = 0
-std/io/base.pcert1 : std/io/base.pcert0
-std/io/base.cert : | std/io/base.pcert1
-
-std/io/close-input-channel.pcert0 : no_pcert = 0
-std/io/close-input-channel.pcert0 : acl2x = 0
-std/io/close-input-channel.pcert0 : \
-     std/io/base.pcert0 \
-     std/io/close-input-channel.lisp
-std/io/close-input-channel.pcert1 : acl2x = 0
-std/io/close-input-channel.pcert1 : no_pcert = 0
-std/io/close-input-channel.pcert1 : std/io/close-input-channel.pcert0
-std/io/close-input-channel.cert : | std/io/close-input-channel.pcert1
-
-std/io/combine.pcert0 : no_pcert = 0
-std/io/combine.pcert0 : acl2x = 0
-std/io/combine.pcert0 : \
-     std/io/sign-byte.pcert0 \
-     std/io/unsigned-byte-listp.pcert0 \
-     std/io/signed-byte-listp.pcert0 \
-     std/io/combine.lisp
-std/io/combine.pcert1 : acl2x = 0
-std/io/combine.pcert1 : no_pcert = 0
-std/io/combine.pcert1 : std/io/combine.pcert0
-std/io/combine.cert : | std/io/combine.pcert1
-
-std/io/file-measure.pcert0 : no_pcert = 0
-std/io/file-measure.pcert0 : acl2x = 0
-std/io/file-measure.pcert0 : \
-     std/io/base.pcert0 \
-     std/io/file-measure.lisp
-std/io/file-measure.pcert1 : acl2x = 0
-std/io/file-measure.pcert1 : no_pcert = 0
-std/io/file-measure.pcert1 : std/io/file-measure.pcert0
-std/io/file-measure.cert : | std/io/file-measure.pcert1
-
-std/io/nthcdr-bytes.pcert0 : no_pcert = 0
-std/io/nthcdr-bytes.pcert0 : acl2x = 0
-std/io/nthcdr-bytes.pcert0 : \
-     std/io/read-byte.pcert0 \
-     std/io/read-file-bytes.pcert0 \
-     tools/mv-nth.pcert0 \
-     std/io/nthcdr-bytes.lisp
-std/io/nthcdr-bytes.pcert1 : acl2x = 0
-std/io/nthcdr-bytes.pcert1 : no_pcert = 0
-std/io/nthcdr-bytes.pcert1 : std/io/nthcdr-bytes.pcert0
-std/io/nthcdr-bytes.cert : | std/io/nthcdr-bytes.pcert1
-
-std/io/open-input-channel.pcert0 : no_pcert = 0
-std/io/open-input-channel.pcert0 : acl2x = 0
-std/io/open-input-channel.pcert0 : \
-     tools/mv-nth.pcert0 \
-     system/update-state.pcert0 \
-     std/io/open-input-channels.pcert0 \
-     arithmetic/top.pcert0 \
-     std/ks/explode-nonnegative-integer.pcert0 \
-     std/ks/intern-in-package-of-symbol.pcert0 \
-     std/lists/coerce.pcert0 \
-     std/io/open-input-channel.lisp
-std/io/open-input-channel.pcert1 : acl2x = 0
-std/io/open-input-channel.pcert1 : no_pcert = 0
-std/io/open-input-channel.pcert1 : std/io/open-input-channel.pcert0
-std/io/open-input-channel.cert : | std/io/open-input-channel.pcert1
-
-std/io/open-input-channels.pcert0 : no_pcert = 0
-std/io/open-input-channels.pcert0 : acl2x = 0
-std/io/open-input-channels.pcert0 : \
-     std/io/open-input-channels.lisp
-std/io/open-input-channels.pcert1 : acl2x = 0
-std/io/open-input-channels.pcert1 : no_pcert = 0
-std/io/open-input-channels.pcert1 : std/io/open-input-channels.pcert0
-std/io/open-input-channels.cert : | std/io/open-input-channels.pcert1
-
-std/io/peek-char.pcert0 : no_pcert = 0
-std/io/peek-char.pcert0 : acl2x = 0
-std/io/peek-char.pcert0 : \
-     std/io/base.pcert0 \
-     std/io/peek-char.lisp
-std/io/peek-char.pcert1 : acl2x = 0
-std/io/peek-char.pcert1 : no_pcert = 0
-std/io/peek-char.pcert1 : std/io/peek-char.pcert0
-std/io/peek-char.cert : | std/io/peek-char.pcert1
-
-std/io/read-byte.pcert0 : no_pcert = 0
-std/io/read-byte.pcert0 : acl2x = 0
-std/io/read-byte.pcert0 : \
-     std/io/base.pcert0 \
-     std/io/read-byte.lisp
-std/io/read-byte.pcert1 : acl2x = 0
-std/io/read-byte.pcert1 : no_pcert = 0
-std/io/read-byte.pcert1 : std/io/read-byte.pcert0
-std/io/read-byte.cert : | std/io/read-byte.pcert1
-
-std/io/read-char.pcert0 : no_pcert = 0
-std/io/read-char.pcert0 : acl2x = 0
-std/io/read-char.pcert0 : \
-     std/io/base.pcert0 \
-     std/io/read-char.lisp
-std/io/read-char.pcert1 : acl2x = 0
-std/io/read-char.pcert1 : no_pcert = 0
-std/io/read-char.pcert1 : std/io/read-char.pcert0
-std/io/read-char.cert : | std/io/read-char.pcert1
-
-std/io/read-file-bytes.pcert0 : no_pcert = 0
-std/io/read-file-bytes.pcert0 : acl2x = 0
-std/io/read-file-bytes.pcert0 : \
-     std/io/base.pcert0 \
-     std/io/unsigned-byte-listp.pcert0 \
-     tools/mv-nth.pcert0 \
-     std/io/read-file-bytes.lisp
-std/io/read-file-bytes.pcert1 : acl2x = 0
-std/io/read-file-bytes.pcert1 : no_pcert = 0
-std/io/read-file-bytes.pcert1 : std/io/read-file-bytes.pcert0
-std/io/read-file-bytes.cert : | std/io/read-file-bytes.pcert1
-
-std/io/read-file-characters-no-error.pcert0 : no_pcert = 0
-std/io/read-file-characters-no-error.pcert0 : acl2x = 0
-std/io/read-file-characters-no-error.pcert0 : \
-     std/io/read-file-characters.pcert0 \
-     tools/mv-nth.pcert0 \
-     std/io/read-file-characters-no-error.lisp \
-     std/io/read-file-characters-no-error.acl2
-std/io/read-file-characters-no-error.pcert1 : acl2x = 0
-std/io/read-file-characters-no-error.pcert1 : no_pcert = 0
-std/io/read-file-characters-no-error.pcert1 : std/io/read-file-characters-no-error.pcert0
-std/io/read-file-characters-no-error.cert : | std/io/read-file-characters-no-error.pcert1
-
-std/io/read-file-characters.pcert0 : no_pcert = 0
-std/io/read-file-characters.pcert0 : acl2x = 0
-std/io/read-file-characters.pcert0 : \
-     std/io/base.pcert0 \
-     std/lists/revappend.pcert0 \
-     tools/mv-nth.pcert0 \
-     std/lists/rev.pcert0 \
-     std/io/read-file-characters.lisp
-std/io/read-file-characters.pcert1 : acl2x = 0
-std/io/read-file-characters.pcert1 : no_pcert = 0
-std/io/read-file-characters.pcert1 : std/io/read-file-characters.pcert0
-std/io/read-file-characters.cert : | std/io/read-file-characters.pcert1
-
-std/io/read-file-lines.pcert0 : no_pcert = 0
-std/io/read-file-lines.pcert0 : acl2x = 0
-std/io/read-file-lines.pcert0 : \
-     std/io/base.pcert0 \
-     std/lists/revappend.pcert0 \
-     std/lists/rev.pcert0 \
-     tools/mv-nth.pcert0 \
-     tools/bstar.pcert0 \
-     std/io/read-file-lines.lisp
-std/io/read-file-lines.pcert1 : acl2x = 0
-std/io/read-file-lines.pcert1 : no_pcert = 0
-std/io/read-file-lines.pcert1 : std/io/read-file-lines.pcert0
-std/io/read-file-lines.cert : | std/io/read-file-lines.pcert1
-
-std/io/read-file-objects.pcert0 : no_pcert = 0
-std/io/read-file-objects.pcert0 : acl2x = 0
-std/io/read-file-objects.pcert0 : \
-     std/io/base.pcert0 \
-     tools/mv-nth.pcert0 \
-     std/io/read-file-objects.lisp
-std/io/read-file-objects.pcert1 : acl2x = 0
-std/io/read-file-objects.pcert1 : no_pcert = 0
-std/io/read-file-objects.pcert1 : std/io/read-file-objects.pcert0
-std/io/read-file-objects.cert : | std/io/read-file-objects.pcert1
-
-std/io/read-ints.pcert0 : no_pcert = 0
-std/io/read-ints.pcert0 : acl2x = 0
-std/io/read-ints.pcert0 : \
-     std/io/read-byte.pcert0 \
-     std/io/unsigned-byte-listp.pcert0 \
-     std/io/signed-byte-listp.pcert0 \
-     std/io/sign-byte.pcert0 \
-     std/io/combine.pcert0 \
-     tools/mv-nth.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     std/io/read-ints.lisp
-std/io/read-ints.pcert1 : acl2x = 0
-std/io/read-ints.pcert1 : no_pcert = 0
-std/io/read-ints.pcert1 : std/io/read-ints.pcert0
-std/io/read-ints.cert : | std/io/read-ints.pcert1
-
-std/io/read-object.pcert0 : no_pcert = 0
-std/io/read-object.pcert0 : acl2x = 0
-std/io/read-object.pcert0 : \
-     std/io/base.pcert0 \
-     std/io/read-object.lisp
-std/io/read-object.pcert1 : acl2x = 0
-std/io/read-object.pcert1 : no_pcert = 0
-std/io/read-object.pcert1 : std/io/read-object.pcert0
-std/io/read-object.cert : | std/io/read-object.pcert1
-
-std/io/sign-byte.pcert0 : no_pcert = 0
-std/io/sign-byte.pcert0 : acl2x = 0
-std/io/sign-byte.pcert0 : \
-     std/io/sign-byte.lisp
-std/io/sign-byte.pcert1 : acl2x = 0
-std/io/sign-byte.pcert1 : no_pcert = 0
-std/io/sign-byte.pcert1 : std/io/sign-byte.pcert0
-std/io/sign-byte.cert : | std/io/sign-byte.pcert1
-
-std/io/signed-byte-listp.pcert0 : no_pcert = 0
-std/io/signed-byte-listp.pcert0 : acl2x = 0
-std/io/signed-byte-listp.pcert0 : \
-     ihs/logops-lemmas.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     std/io/unsigned-byte-listp.pcert0 \
-     std/io/signed-byte-listp.lisp
-std/io/signed-byte-listp.pcert1 : acl2x = 0
-std/io/signed-byte-listp.pcert1 : no_pcert = 0
-std/io/signed-byte-listp.pcert1 : std/io/signed-byte-listp.pcert0
-std/io/signed-byte-listp.cert : | std/io/signed-byte-listp.pcert1
-
-std/io/take-bytes.pcert0 : no_pcert = 0
-std/io/take-bytes.pcert0 : acl2x = 0
-std/io/take-bytes.pcert0 : \
-     std/io/read-byte.pcert0 \
-     std/io/read-file-bytes.pcert0 \
-     std/io/nthcdr-bytes.pcert0 \
-     std/io/take-bytes.lisp
-std/io/take-bytes.pcert1 : acl2x = 0
-std/io/take-bytes.pcert1 : no_pcert = 0
-std/io/take-bytes.pcert1 : std/io/take-bytes.pcert0
-std/io/take-bytes.cert : | std/io/take-bytes.pcert1
-
-std/io/unsigned-byte-listp.pcert0 : no_pcert = 0
-std/io/unsigned-byte-listp.pcert0 : acl2x = 0
-std/io/unsigned-byte-listp.pcert0 : \
-     std/lists/take.pcert0 \
-     std/lists/nat-listp.pcert0 \
-     std/lists/repeat.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     std/io/unsigned-byte-listp.lisp
-std/io/unsigned-byte-listp.pcert1 : acl2x = 0
-std/io/unsigned-byte-listp.pcert1 : no_pcert = 0
-std/io/unsigned-byte-listp.pcert1 : std/io/unsigned-byte-listp.pcert0
-std/io/unsigned-byte-listp.cert : | std/io/unsigned-byte-listp.pcert1
-
-std/ks/base10-digit-charp.pcert0 : no_pcert = 0
-std/ks/base10-digit-charp.pcert0 : acl2x = 0
-std/ks/base10-digit-charp.pcert0 : \
-     std/ks/base10-digit-charp.lisp
-std/ks/base10-digit-charp.pcert1 : acl2x = 0
-std/ks/base10-digit-charp.pcert1 : no_pcert = 0
-std/ks/base10-digit-charp.pcert1 : std/ks/base10-digit-charp.pcert0
-std/ks/base10-digit-charp.cert : | std/ks/base10-digit-charp.pcert1
-
-std/ks/explode-atom.pcert0 : no_pcert = 0
-std/ks/explode-atom.pcert0 : acl2x = 0
-std/ks/explode-atom.pcert0 : \
-     std/ks/base10-digit-charp.pcert0 \
-     std/lists/append.pcert0 \
-     std/ks/explode-nonnegative-integer.pcert0 \
-     std/ks/explode-atom.lisp
-std/ks/explode-atom.pcert1 : acl2x = 0
-std/ks/explode-atom.pcert1 : no_pcert = 0
-std/ks/explode-atom.pcert1 : std/ks/explode-atom.pcert0
-std/ks/explode-atom.cert : | std/ks/explode-atom.pcert1
-
-std/ks/explode-nonnegative-integer.pcert0 : no_pcert = 0
-std/ks/explode-nonnegative-integer.pcert0 : acl2x = 0
-std/ks/explode-nonnegative-integer.pcert0 : \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     std/lists/revappend.pcert0 \
-     std/ks/base10-digit-charp.pcert0 \
-     std/lists/rev.pcert0 \
-     std/ks/explode-nonnegative-integer.lisp
-std/ks/explode-nonnegative-integer.pcert1 : acl2x = 0
-std/ks/explode-nonnegative-integer.pcert1 : no_pcert = 0
-std/ks/explode-nonnegative-integer.pcert1 : std/ks/explode-nonnegative-integer.pcert0
-std/ks/explode-nonnegative-integer.cert : | std/ks/explode-nonnegative-integer.pcert1
-
-std/ks/intern-in-package-of-symbol.pcert0 : no_pcert = 0
-std/ks/intern-in-package-of-symbol.pcert0 : acl2x = 0
-std/ks/intern-in-package-of-symbol.pcert0 : \
-     std/ks/intern-in-package-of-symbol.lisp
-std/ks/intern-in-package-of-symbol.pcert1 : acl2x = 0
-std/ks/intern-in-package-of-symbol.pcert1 : no_pcert = 0
-std/ks/intern-in-package-of-symbol.pcert1 : std/ks/intern-in-package-of-symbol.pcert0
-std/ks/intern-in-package-of-symbol.cert : | std/ks/intern-in-package-of-symbol.pcert1
-
-std/ks/string-append.pcert0 : no_pcert = 0
-std/ks/string-append.pcert0 : acl2x = 0
-std/ks/string-append.pcert0 : \
-     std/lists/append.pcert0 \
-     std/lists/coerce.pcert0 \
-     std/ks/string-append.lisp
-std/ks/string-append.pcert1 : acl2x = 0
-std/ks/string-append.pcert1 : no_pcert = 0
-std/ks/string-append.pcert1 : std/ks/string-append.pcert0
-std/ks/string-append.cert : | std/ks/string-append.pcert1
-
-std/ks/two-nats-measure.pcert0 : no_pcert = 0
-std/ks/two-nats-measure.pcert0 : acl2x = 0
-std/ks/two-nats-measure.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     std/ks/two-nats-measure.lisp
-std/ks/two-nats-measure.pcert1 : acl2x = 0
-std/ks/two-nats-measure.pcert1 : no_pcert = 0
-std/ks/two-nats-measure.pcert1 : std/ks/two-nats-measure.pcert0
-std/ks/two-nats-measure.cert : | std/ks/two-nats-measure.pcert1
-
-std/lists/app.pcert0 : no_pcert = 0
-std/lists/app.pcert0 : acl2x = 0
-std/lists/app.pcert0 : \
-     std/lists/list-fix.pcert0 \
-     std/lists/take.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     arithmetic/top.pcert0 \
-     std/lists/app.lisp
-std/lists/app.pcert1 : acl2x = 0
-std/lists/app.pcert1 : no_pcert = 0
-std/lists/app.pcert1 : std/lists/app.pcert0
-std/lists/app.cert : | std/lists/app.pcert1
-
-std/lists/append.pcert0 : no_pcert = 0
-std/lists/append.pcert0 : acl2x = 0
-std/lists/append.pcert0 : \
-     std/lists/list-fix.pcert0 \
-     arithmetic/top.pcert0 \
-     std/lists/append.lisp
-std/lists/append.pcert1 : acl2x = 0
-std/lists/append.pcert1 : no_pcert = 0
-std/lists/append.pcert1 : std/lists/append.pcert0
-std/lists/append.cert : | std/lists/append.pcert1
-
-std/lists/coerce.pcert0 : no_pcert = 0
-std/lists/coerce.pcert0 : acl2x = 0
-std/lists/coerce.pcert0 : \
-     std/lists/make-character-list.pcert0 \
-     std/lists/coerce.lisp
-std/lists/coerce.pcert1 : acl2x = 0
-std/lists/coerce.pcert1 : no_pcert = 0
-std/lists/coerce.pcert1 : std/lists/coerce.pcert0
-std/lists/coerce.cert : | std/lists/coerce.pcert1
-
-std/lists/consless-listp.pcert0 : no_pcert = 0
-std/lists/consless-listp.pcert0 : acl2x = 0
-std/lists/consless-listp.pcert0 : \
-     std/lists/app.pcert0 \
-     std/lists/consless-listp.lisp
-std/lists/consless-listp.pcert1 : acl2x = 0
-std/lists/consless-listp.pcert1 : no_pcert = 0
-std/lists/consless-listp.pcert1 : std/lists/consless-listp.pcert0
-std/lists/consless-listp.cert : | std/lists/consless-listp.pcert1
-
-std/lists/equiv.pcert0 : no_pcert = 0
-std/lists/equiv.pcert0 : acl2x = 0
-std/lists/equiv.pcert0 : \
-     std/lists/list-fix.pcert0 \
-     std/lists/take.pcert0 \
-     arithmetic/top.pcert0 \
-     std/lists/equiv.lisp
-std/lists/equiv.pcert1 : acl2x = 0
-std/lists/equiv.pcert1 : no_pcert = 0
-std/lists/equiv.pcert1 : std/lists/equiv.pcert0
-std/lists/equiv.cert : | std/lists/equiv.pcert1
-
-std/lists/final-cdr.pcert0 : no_pcert = 0
-std/lists/final-cdr.pcert0 : acl2x = 0
-std/lists/final-cdr.pcert0 : \
-     std/lists/nthcdr.pcert0 \
-     std/lists/final-cdr.lisp
-std/lists/final-cdr.pcert1 : acl2x = 0
-std/lists/final-cdr.pcert1 : no_pcert = 0
-std/lists/final-cdr.pcert1 : std/lists/final-cdr.pcert0
-std/lists/final-cdr.cert : | std/lists/final-cdr.pcert1
-
-std/lists/flatten.pcert0 : no_pcert = 0
-std/lists/flatten.pcert0 : acl2x = 0
-std/lists/flatten.pcert0 : \
-     std/lists/app.pcert0 \
-     std/lists/consless-listp.pcert0 \
-     std/lists/flatten.lisp
-std/lists/flatten.pcert1 : acl2x = 0
-std/lists/flatten.pcert1 : no_pcert = 0
-std/lists/flatten.pcert1 : std/lists/flatten.pcert0
-std/lists/flatten.cert : | std/lists/flatten.pcert1
-
-std/lists/list-defuns.pcert0 : no_pcert = 0
-std/lists/list-defuns.pcert0 : acl2x = 0
-std/lists/list-defuns.pcert0 : \
-     std/lists/app.pcert0 \
-     std/lists/append.pcert0 \
-     std/lists/list-fix.pcert0 \
-     std/lists/flatten.pcert0 \
-     std/lists/final-cdr.pcert0 \
-     std/lists/prefixp.pcert0 \
-     std/lists/take.pcert0 \
-     std/lists/repeat.pcert0 \
-     std/lists/revappend.pcert0 \
-     std/lists/rev.pcert0 \
-     std/lists/equiv.pcert0 \
-     std/lists/sets.pcert0 \
-     std/lists/list-defuns.lisp
-std/lists/list-defuns.pcert1 : acl2x = 0
-std/lists/list-defuns.pcert1 : no_pcert = 0
-std/lists/list-defuns.pcert1 : std/lists/list-defuns.pcert0
-std/lists/list-defuns.cert : | std/lists/list-defuns.pcert1
-
-std/lists/list-fix.pcert0 : no_pcert = 0
-std/lists/list-fix.pcert0 : acl2x = 0
-std/lists/list-fix.pcert0 : \
-     std/lists/take.pcert0 \
-     arithmetic/top.pcert0 \
-     std/lists/list-fix.lisp
-std/lists/list-fix.pcert1 : acl2x = 0
-std/lists/list-fix.pcert1 : no_pcert = 0
-std/lists/list-fix.pcert1 : std/lists/list-fix.pcert0
-std/lists/list-fix.cert : | std/lists/list-fix.pcert1
-
-std/lists/make-character-list.pcert0 : no_pcert = 0
-std/lists/make-character-list.pcert0 : acl2x = 0
-std/lists/make-character-list.pcert0 : \
-     std/lists/make-character-list.lisp
-std/lists/make-character-list.pcert1 : acl2x = 0
-std/lists/make-character-list.pcert1 : no_pcert = 0
-std/lists/make-character-list.pcert1 : std/lists/make-character-list.pcert0
-std/lists/make-character-list.cert : | std/lists/make-character-list.pcert1
-
-std/lists/mfc-utils.pcert0 : no_pcert = 0
-std/lists/mfc-utils.pcert0 : acl2x = 0
-std/lists/mfc-utils.pcert0 : \
-     std/lists/mfc-utils.lisp
-std/lists/mfc-utils.pcert1 : acl2x = 0
-std/lists/mfc-utils.pcert1 : no_pcert = 0
-std/lists/mfc-utils.pcert1 : std/lists/mfc-utils.pcert0
-std/lists/mfc-utils.cert : | std/lists/mfc-utils.pcert1
-
-std/lists/nat-listp.pcert0 : no_pcert = 0
-std/lists/nat-listp.pcert0 : acl2x = 0
-std/lists/nat-listp.pcert0 : \
-     std/lists/app.pcert0 \
-     arithmetic/nat-listp.pcert0 \
-     std/lists/nat-listp.lisp
-std/lists/nat-listp.pcert1 : acl2x = 0
-std/lists/nat-listp.pcert1 : no_pcert = 0
-std/lists/nat-listp.pcert1 : std/lists/nat-listp.pcert0
-std/lists/nat-listp.cert : | std/lists/nat-listp.pcert1
-
-std/lists/nthcdr.pcert0 : no_pcert = 0
-std/lists/nthcdr.pcert0 : acl2x = 0
-std/lists/nthcdr.pcert0 : \
-     std/lists/nthcdr.lisp
-std/lists/nthcdr.pcert1 : acl2x = 0
-std/lists/nthcdr.pcert1 : no_pcert = 0
-std/lists/nthcdr.pcert1 : std/lists/nthcdr.pcert0
-std/lists/nthcdr.cert : | std/lists/nthcdr.pcert1
-
-std/lists/prefixp.pcert0 : no_pcert = 0
-std/lists/prefixp.pcert0 : acl2x = 0
-std/lists/prefixp.pcert0 : \
-     std/lists/list-fix.pcert0 \
-     std/lists/take.pcert0 \
-     arithmetic/top.pcert0 \
-     std/lists/prefixp.lisp
-std/lists/prefixp.pcert1 : acl2x = 0
-std/lists/prefixp.pcert1 : no_pcert = 0
-std/lists/prefixp.pcert1 : std/lists/prefixp.pcert0
-std/lists/prefixp.cert : | std/lists/prefixp.pcert1
-
-std/lists/repeat.pcert0 : no_pcert = 0
-std/lists/repeat.pcert0 : acl2x = 0
-std/lists/repeat.pcert0 : \
-     std/lists/take.pcert0 \
-     std/lists/append.pcert0 \
-     std/lists/repeat.lisp
-std/lists/repeat.pcert1 : acl2x = 0
-std/lists/repeat.pcert1 : no_pcert = 0
-std/lists/repeat.pcert1 : std/lists/repeat.pcert0
-std/lists/repeat.cert : | std/lists/repeat.pcert1
-
-std/lists/rev.pcert0 : no_pcert = 0
-std/lists/rev.pcert0 : acl2x = 0
-std/lists/rev.pcert0 : \
-     std/lists/revappend.pcert0 \
-     std/lists/reverse.pcert0 \
-     std/lists/append.pcert0 \
-     std/lists/make-character-list.pcert0 \
-     std/lists/rev.lisp
-std/lists/rev.pcert1 : acl2x = 0
-std/lists/rev.pcert1 : no_pcert = 0
-std/lists/rev.pcert1 : std/lists/rev.pcert0
-std/lists/rev.cert : | std/lists/rev.pcert1
-
-std/lists/revappend.pcert0 : no_pcert = 0
-std/lists/revappend.pcert0 : acl2x = 0
-std/lists/revappend.pcert0 : \
-     arithmetic/top.pcert0 \
-     std/lists/revappend.lisp
-std/lists/revappend.pcert1 : acl2x = 0
-std/lists/revappend.pcert1 : no_pcert = 0
-std/lists/revappend.pcert1 : std/lists/revappend.pcert0
-std/lists/revappend.cert : | std/lists/revappend.pcert1
-
-std/lists/reverse.pcert0 : no_pcert = 0
-std/lists/reverse.pcert0 : acl2x = 0
-std/lists/reverse.pcert0 : \
-     std/lists/revappend.pcert0 \
-     std/lists/coerce.pcert0 \
-     std/lists/reverse.lisp
-std/lists/reverse.pcert1 : acl2x = 0
-std/lists/reverse.pcert1 : no_pcert = 0
-std/lists/reverse.pcert1 : std/lists/reverse.pcert0
-std/lists/reverse.cert : | std/lists/reverse.pcert1
-
-std/lists/sets.pcert0 : no_pcert = 0
-std/lists/sets.pcert0 : acl2x = 0
-std/lists/sets.pcert0 : \
-     std/lists/equiv.pcert0 \
-     std/lists/mfc-utils.pcert0 \
-     std/lists/rev.pcert0 \
-     std/lists/sets.lisp
-std/lists/sets.pcert1 : acl2x = 0
-std/lists/sets.pcert1 : no_pcert = 0
-std/lists/sets.pcert1 : std/lists/sets.pcert0
-std/lists/sets.cert : | std/lists/sets.pcert1
-
-std/lists/take.pcert0 : no_pcert = 0
-std/lists/take.pcert0 : acl2x = 0
-std/lists/take.pcert0 : \
-     arithmetic/top.pcert0 \
-     std/lists/take.lisp
-std/lists/take.pcert1 : acl2x = 0
-std/lists/take.pcert1 : no_pcert = 0
-std/lists/take.pcert1 : std/lists/take.pcert0
-std/lists/take.cert : | std/lists/take.pcert1
-
-str/abbrevs.pcert0 : no_pcert = 0
-str/abbrevs.pcert0 : acl2x = 0
-str/abbrevs.pcert0 : \
-     str/top.pcert0 \
-     str/portcullis.pcert0 \
-     str/abbrevs.lisp \
-     str/cert.acl2
-str/abbrevs.pcert1 : acl2x = 0
-str/abbrevs.pcert1 : no_pcert = 0
-str/abbrevs.pcert1 : str/abbrevs.pcert0
-str/abbrevs.cert : | str/abbrevs.pcert1
-
-str/arithmetic.pcert0 : no_pcert = 0
-str/arithmetic.pcert0 : acl2x = 0
-str/arithmetic.pcert0 : \
-     arithmetic/top.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     std/lists/append.pcert0 \
-     std/lists/repeat.pcert0 \
-     str/portcullis.pcert0 \
-     str/arithmetic.lisp \
-     str/cert.acl2
-str/arithmetic.pcert1 : acl2x = 0
-str/arithmetic.pcert1 : no_pcert = 0
-str/arithmetic.pcert1 : str/arithmetic.pcert0
-str/arithmetic.cert : | str/arithmetic.pcert1
-
-str/case-conversion.pcert0 : no_pcert = 0
-str/case-conversion.pcert0 : acl2x = 0
-str/case-conversion.pcert0 : \
-     str/char-case.pcert0 \
-     str/cat.pcert0 \
-     str/arithmetic.pcert0 \
-     std/lists/rev.pcert0 \
-     std/lists/coerce.pcert0 \
-     std/lists/take.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     str/subseq.pcert0 \
-     str/portcullis.pcert0 \
-     str/case-conversion.lisp \
-     str/cert.acl2
-str/case-conversion.pcert1 : acl2x = 0
-str/case-conversion.pcert1 : no_pcert = 0
-str/case-conversion.pcert1 : str/case-conversion.pcert0
-str/case-conversion.cert : | str/case-conversion.pcert1
-
-str/cat.pcert0 : no_pcert = 0
-str/cat.pcert0 : acl2x = 0
-str/cat.pcert0 : \
-     xdoc/top.pcert0 \
-     misc/definline.pcert0 \
-     str/arithmetic.pcert0 \
-     std/lists/take.pcert0 \
-     str/portcullis.pcert0 \
-     str/cat.lisp \
-     str/cert.acl2
-str/cat.pcert1 : acl2x = 0
-str/cat.pcert1 : no_pcert = 0
-str/cat.pcert1 : str/cat.pcert0
-str/cat.cert : | str/cat.pcert1
-
-str/char-case.pcert0 : no_pcert = 0
-str/char-case.pcert0 : acl2x = 0
-str/char-case.pcert0 : \
-     str/eqv.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/char-case.lisp \
-     str/cert.acl2
-str/char-case.pcert1 : acl2x = 0
-str/char-case.pcert1 : no_pcert = 0
-str/char-case.pcert1 : str/char-case.pcert0
-str/char-case.cert : | str/char-case.pcert1
-
-str/digitp.pcert0 : no_pcert = 0
-str/digitp.pcert0 : acl2x = 0
-str/digitp.pcert0 : \
-     str/eqv.pcert0 \
-     std/lists/list-fix.pcert0 \
-     std/lists/rev.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/digitp.lisp \
-     str/cert.acl2
-str/digitp.pcert1 : acl2x = 0
-str/digitp.pcert1 : no_pcert = 0
-str/digitp.pcert1 : str/digitp.pcert0
-str/digitp.cert : | str/digitp.pcert1
-
-str/eqv.pcert0 : no_pcert = 0
-str/eqv.pcert0 : acl2x = 0
-str/eqv.pcert0 : \
-     xdoc/top.pcert0 \
-     std/lists/list-fix.pcert0 \
-     misc/definline.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/eqv.lisp \
-     str/cert.acl2
-str/eqv.pcert1 : acl2x = 0
-str/eqv.pcert1 : no_pcert = 0
-str/eqv.pcert1 : str/eqv.pcert0
-str/eqv.cert : | str/eqv.pcert1
-
-str/fast-cat.pcert0 : no_pcert = 0
-str/fast-cat.pcert0 : acl2x = 0
-str/fast-cat.pcert0 : \
-     str/cat.pcert0 \
-     str/portcullis.pcert0 \
-     str/fast-cat.lisp \
-     str/fast-cat.acl2 \
-     str/cert.acl2
-str/fast-cat.pcert1 : acl2x = 0
-str/fast-cat.pcert1 : no_pcert = 0
-str/fast-cat.pcert1 : str/fast-cat.pcert0
-str/fast-cat.cert : | str/fast-cat.pcert1
-
-str/firstn-chars.pcert0 : no_pcert = 0
-str/firstn-chars.pcert0 : acl2x = 0
-str/firstn-chars.pcert0 : \
-     str/eqv.pcert0 \
-     str/arithmetic.pcert0 \
-     std/lists/take.pcert0 \
-     str/portcullis.pcert0 \
-     str/firstn-chars.lisp \
-     str/cert.acl2
-str/firstn-chars.pcert1 : acl2x = 0
-str/firstn-chars.pcert1 : no_pcert = 0
-str/firstn-chars.pcert1 : str/firstn-chars.pcert0
-str/firstn-chars.cert : | str/firstn-chars.pcert1
-
-str/hexify.pcert0 : no_pcert = 0
-str/hexify.pcert0 : acl2x = 0
-str/hexify.pcert0 : \
-     tools/bstar.pcert0 \
-     std/ks/explode-atom.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/hexify.lisp \
-     str/cert.acl2
-str/hexify.pcert1 : acl2x = 0
-str/hexify.pcert1 : no_pcert = 0
-str/hexify.pcert1 : str/hexify.pcert0
-str/hexify.cert : | str/hexify.pcert1
-
-str/html-encode.pcert0 : no_pcert = 0
-str/html-encode.pcert0 : acl2x = 0
-str/html-encode.pcert0 : \
-     str/cat.pcert0 \
-     tools/bstar.pcert0 \
-     misc/assert.pcert0 \
-     str/arithmetic.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     str/portcullis.pcert0 \
-     str/html-encode.lisp \
-     str/cert.acl2
-str/html-encode.pcert1 : acl2x = 0
-str/html-encode.pcert1 : no_pcert = 0
-str/html-encode.pcert1 : str/html-encode.pcert0
-str/html-encode.cert : | str/html-encode.pcert1
-
-str/ieqv.pcert0 : no_pcert = 0
-str/ieqv.pcert0 : acl2x = 0
-str/ieqv.pcert0 : \
-     str/char-case.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/ieqv.lisp \
-     str/cert.acl2
-str/ieqv.pcert1 : acl2x = 0
-str/ieqv.pcert1 : no_pcert = 0
-str/ieqv.pcert1 : str/ieqv.pcert0
-str/ieqv.cert : | str/ieqv.pcert1
-
-str/iless.pcert0 : no_pcert = 0
-str/iless.pcert0 : acl2x = 0
-str/iless.pcert0 : \
-     str/ieqv.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/iless.lisp \
-     str/cert.acl2
-str/iless.pcert1 : acl2x = 0
-str/iless.pcert1 : no_pcert = 0
-str/iless.pcert1 : str/iless.pcert0
-str/iless.cert : | str/iless.pcert1
-
-str/iprefixp.pcert0 : no_pcert = 0
-str/iprefixp.pcert0 : acl2x = 0
-str/iprefixp.pcert0 : \
-     str/ieqv.pcert0 \
-     std/lists/prefixp.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/iprefixp.lisp \
-     str/cert.acl2
-str/iprefixp.pcert1 : acl2x = 0
-str/iprefixp.pcert1 : no_pcert = 0
-str/iprefixp.pcert1 : str/iprefixp.pcert0
-str/iprefixp.cert : | str/iprefixp.pcert1
-
-str/isort.pcert0 : no_pcert = 0
-str/isort.pcert0 : acl2x = 0
-str/isort.pcert0 : \
-     str/iless.pcert0 \
-     defsort/defsort.pcert0 \
-     std/lists/list-fix.pcert0 \
-     str/portcullis.pcert0 \
-     str/isort.lisp \
-     str/cert.acl2
-str/isort.pcert1 : acl2x = 0
-str/isort.pcert1 : no_pcert = 0
-str/isort.pcert1 : str/isort.pcert0
-str/isort.cert : | str/isort.pcert1
-
-str/istrpos.pcert0 : no_pcert = 0
-str/istrpos.pcert0 : acl2x = 0
-str/istrpos.pcert0 : \
-     str/iprefixp.pcert0 \
-     str/istrprefixp.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/istrpos.lisp \
-     str/cert.acl2
-str/istrpos.pcert1 : acl2x = 0
-str/istrpos.pcert1 : no_pcert = 0
-str/istrpos.pcert1 : str/istrpos.pcert0
-str/istrpos.cert : | str/istrpos.pcert1
-
-str/istrprefixp.pcert0 : no_pcert = 0
-str/istrprefixp.pcert0 : acl2x = 0
-str/istrprefixp.pcert0 : \
-     str/ieqv.pcert0 \
-     str/iprefixp.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/istrprefixp.lisp \
-     str/cert.acl2
-str/istrprefixp.pcert1 : acl2x = 0
-str/istrprefixp.pcert1 : no_pcert = 0
-str/istrprefixp.pcert1 : str/istrprefixp.pcert0
-str/istrprefixp.cert : | str/istrprefixp.pcert1
-
-str/isubstrp.pcert0 : no_pcert = 0
-str/isubstrp.pcert0 : acl2x = 0
-str/isubstrp.pcert0 : \
-     str/istrpos.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/isubstrp.lisp \
-     str/cert.acl2
-str/isubstrp.pcert1 : acl2x = 0
-str/isubstrp.pcert1 : no_pcert = 0
-str/isubstrp.pcert1 : str/isubstrp.pcert0
-str/isubstrp.cert : | str/isubstrp.pcert1
-
-str/natstr.pcert0 : no_pcert = 0
-str/natstr.pcert0 : acl2x = 0
-str/natstr.pcert0 : \
-     str/digitp.pcert0 \
-     arithmetic/nat-listp.pcert0 \
-     std/lists/revappend.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     std/lists/rev.pcert0 \
-     std/lists/coerce.pcert0 \
-     str/portcullis.pcert0 \
-     str/natstr.lisp \
-     str/cert.acl2
-str/natstr.pcert1 : acl2x = 0
-str/natstr.pcert1 : no_pcert = 0
-str/natstr.pcert1 : str/natstr.pcert0
-str/natstr.cert : | str/natstr.pcert1
-
-str/pad.pcert0 : no_pcert = 0
-str/pad.pcert0 : acl2x = 0
-str/pad.pcert0 : \
-     str/cat.pcert0 \
-     std/lists/take.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/pad.lisp \
-     str/cert.acl2
-str/pad.pcert1 : acl2x = 0
-str/pad.pcert1 : no_pcert = 0
-str/pad.pcert1 : str/pad.pcert0
-str/pad.cert : | str/pad.pcert1
-
-str/portcullis.pcert0 : no_pcert = 0
-str/portcullis.pcert0 : acl2x = 0
-str/portcullis.pcert0 : \
-     str/portcullis.lisp \
-     str/portcullis.acl2 \
-     str/package.lsp \
-     xdoc/package.lsp
-str/portcullis.pcert1 : acl2x = 0
-str/portcullis.pcert1 : no_pcert = 0
-str/portcullis.pcert1 : str/portcullis.pcert0
-str/portcullis.cert : | str/portcullis.pcert1
-
-str/prefix-lines.pcert0 : no_pcert = 0
-str/prefix-lines.pcert0 : acl2x = 0
-str/prefix-lines.pcert0 : \
-     str/cat.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/prefix-lines.lisp \
-     str/cert.acl2
-str/prefix-lines.pcert1 : acl2x = 0
-str/prefix-lines.pcert1 : no_pcert = 0
-str/prefix-lines.pcert1 : str/prefix-lines.pcert0
-str/prefix-lines.cert : | str/prefix-lines.pcert1
-
-str/stringify.pcert0 : no_pcert = 0
-str/stringify.pcert0 : acl2x = 0
-str/stringify.pcert0 : \
-     str/natstr.pcert0 \
-     str/portcullis.pcert0 \
-     str/stringify.lisp \
-     str/cert.acl2
-str/stringify.pcert1 : acl2x = 0
-str/stringify.pcert1 : no_pcert = 0
-str/stringify.pcert1 : str/stringify.pcert0
-str/stringify.cert : | str/stringify.pcert1
-
-str/strline.pcert0 : no_pcert = 0
-str/strline.pcert0 : acl2x = 0
-str/strline.pcert0 : \
-     xdoc/top.pcert0 \
-     misc/assert.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/strline.lisp \
-     str/cert.acl2
-str/strline.pcert1 : acl2x = 0
-str/strline.pcert1 : no_pcert = 0
-str/strline.pcert1 : str/strline.pcert0
-str/strline.cert : | str/strline.pcert1
-
-str/strnatless.pcert0 : no_pcert = 0
-str/strnatless.pcert0 : acl2x = 0
-str/strnatless.pcert0 : \
-     str/digitp.pcert0 \
-     tools/mv-nth.pcert0 \
-     tools/bstar.pcert0 \
-     str/arithmetic.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     str/portcullis.pcert0 \
-     str/strnatless.lisp \
-     str/cert.acl2
-str/strnatless.pcert1 : acl2x = 0
-str/strnatless.pcert1 : no_pcert = 0
-str/strnatless.pcert1 : str/strnatless.pcert0
-str/strnatless.cert : | str/strnatless.pcert1
-
-str/strpos.pcert0 : no_pcert = 0
-str/strpos.pcert0 : acl2x = 0
-str/strpos.pcert0 : \
-     misc/definline.pcert0 \
-     str/strprefixp.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/strpos.lisp \
-     str/cert.acl2
-str/strpos.pcert1 : acl2x = 0
-str/strpos.pcert1 : no_pcert = 0
-str/strpos.pcert1 : str/strpos.pcert0
-str/strpos.cert : | str/strpos.pcert1
-
-str/strprefixp.pcert0 : no_pcert = 0
-str/strprefixp.pcert0 : acl2x = 0
-str/strprefixp.pcert0 : \
-     misc/definline.pcert0 \
-     xdoc/top.pcert0 \
-     std/lists/prefixp.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/strprefixp.lisp \
-     str/cert.acl2
-str/strprefixp.pcert1 : acl2x = 0
-str/strprefixp.pcert1 : no_pcert = 0
-str/strprefixp.pcert1 : str/strprefixp.pcert0
-str/strprefixp.cert : | str/strprefixp.pcert1
-
-str/strrpos.pcert0 : no_pcert = 0
-str/strrpos.pcert0 : acl2x = 0
-str/strrpos.pcert0 : \
-     str/strprefixp.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/strrpos.lisp \
-     str/cert.acl2
-str/strrpos.pcert1 : acl2x = 0
-str/strrpos.pcert1 : no_pcert = 0
-str/strrpos.pcert1 : str/strrpos.pcert0
-str/strrpos.cert : | str/strrpos.pcert1
-
-str/strsplit.pcert0 : no_pcert = 0
-str/strsplit.pcert0 : acl2x = 0
-str/strsplit.pcert0 : \
-     str/arithmetic.pcert0 \
-     tools/mv-nth.pcert0 \
-     misc/assert.pcert0 \
-     str/portcullis.pcert0 \
-     str/strsplit.lisp \
-     str/cert.acl2
-str/strsplit.pcert1 : acl2x = 0
-str/strsplit.pcert1 : no_pcert = 0
-str/strsplit.pcert1 : str/strsplit.pcert0
-str/strsplit.cert : | str/strsplit.pcert1
-
-str/strsubst.pcert0 : no_pcert = 0
-str/strsubst.pcert0 : acl2x = 0
-str/strsubst.pcert0 : \
-     str/cat.pcert0 \
-     str/strprefixp.pcert0 \
-     misc/assert.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/strsubst.lisp \
-     str/cert.acl2
-str/strsubst.pcert1 : acl2x = 0
-str/strsubst.pcert1 : no_pcert = 0
-str/strsubst.pcert1 : str/strsubst.pcert0
-str/strsubst.cert : | str/strsubst.pcert1
-
-str/strtok.pcert0 : no_pcert = 0
-str/strtok.pcert0 : acl2x = 0
-str/strtok.pcert0 : \
-     str/cat.pcert0 \
-     misc/assert.pcert0 \
-     str/arithmetic.pcert0 \
-     std/lists/revappend.pcert0 \
-     str/portcullis.pcert0 \
-     str/strtok.lisp \
-     str/cert.acl2
-str/strtok.pcert1 : acl2x = 0
-str/strtok.pcert1 : no_pcert = 0
-str/strtok.pcert1 : str/strtok.pcert0
-str/strtok.cert : | str/strtok.pcert1
-
-str/strval.pcert0 : no_pcert = 0
-str/strval.pcert0 : acl2x = 0
-str/strval.pcert0 : \
-     str/strnatless.pcert0 \
-     misc/definline.pcert0 \
-     str/arithmetic.pcert0 \
-     misc/assert.pcert0 \
-     str/portcullis.pcert0 \
-     str/strval.lisp \
-     str/cert.acl2
-str/strval.pcert1 : acl2x = 0
-str/strval.pcert1 : no_pcert = 0
-str/strval.pcert1 : str/strval.pcert0
-str/strval.cert : | str/strval.pcert1
-
-str/subseq.pcert0 : no_pcert = 0
-str/subseq.pcert0 : acl2x = 0
-str/subseq.pcert0 : \
-     str/arithmetic.pcert0 \
-     std/lists/take.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     std/lists/coerce.pcert0 \
-     str/portcullis.pcert0 \
-     str/subseq.lisp \
-     str/cert.acl2
-str/subseq.pcert1 : acl2x = 0
-str/subseq.pcert1 : no_pcert = 0
-str/subseq.pcert1 : str/subseq.pcert0
-str/subseq.cert : | str/subseq.pcert1
-
-str/substrp.pcert0 : no_pcert = 0
-str/substrp.pcert0 : acl2x = 0
-str/substrp.pcert0 : \
-     str/strpos.pcert0 \
-     str/arithmetic.pcert0 \
-     str/portcullis.pcert0 \
-     str/substrp.lisp \
-     str/cert.acl2
-str/substrp.pcert1 : acl2x = 0
-str/substrp.pcert1 : no_pcert = 0
-str/substrp.pcert1 : str/substrp.pcert0
-str/substrp.cert : | str/substrp.pcert1
-
-str/suffixp.pcert0 : no_pcert = 0
-str/suffixp.pcert0 : acl2x = 0
-str/suffixp.pcert0 : \
-     str/strprefixp.pcert0 \
-     misc/assert.pcert0 \
-     str/portcullis.pcert0 \
-     str/suffixp.lisp \
-     str/cert.acl2
-str/suffixp.pcert1 : acl2x = 0
-str/suffixp.pcert1 : no_pcert = 0
-str/suffixp.pcert1 : str/suffixp.pcert0
-str/suffixp.cert : | str/suffixp.pcert1
-
-str/top.pcert0 : no_pcert = 0
-str/top.pcert0 : acl2x = 0
-str/top.pcert0 : \
-     str/case-conversion.pcert0 \
-     str/cat.pcert0 \
-     str/digitp.pcert0 \
-     str/eqv.pcert0 \
-     str/firstn-chars.pcert0 \
-     str/html-encode.pcert0 \
-     str/ieqv.pcert0 \
-     str/iprefixp.pcert0 \
-     str/iless.pcert0 \
-     str/isort.pcert0 \
-     str/istrpos.pcert0 \
-     str/istrprefixp.pcert0 \
-     str/isubstrp.pcert0 \
-     str/natstr.pcert0 \
-     str/strline.pcert0 \
-     str/pad.pcert0 \
-     str/prefix-lines.pcert0 \
-     str/strpos.pcert0 \
-     str/strrpos.pcert0 \
-     str/strprefixp.pcert0 \
-     str/strnatless.pcert0 \
-     str/strsplit.pcert0 \
-     str/strsubst.pcert0 \
-     str/strtok.pcert0 \
-     str/strval.pcert0 \
-     str/substrp.pcert0 \
-     str/subseq.pcert0 \
-     str/suffixp.pcert0 \
-     str/portcullis.pcert0 \
-     str/top.lisp \
-     str/cert.acl2
-str/top.pcert1 : acl2x = 0
-str/top.pcert1 : no_pcert = 0
-str/top.pcert1 : str/top.pcert0
-str/top.cert : | str/top.pcert1
-
-symbolic/generic/assertions.pcert0 : no_pcert = 0
-symbolic/generic/assertions.pcert0 : acl2x = 0
-symbolic/generic/assertions.pcert0 : \
-     ordinals/ordinals.pcert0 \
-     misc/defpun.pcert0 \
-     symbolic/generic/assertions.lisp
-symbolic/generic/assertions.pcert1 : acl2x = 0
-symbolic/generic/assertions.pcert1 : no_pcert = 0
-symbolic/generic/assertions.pcert1 : symbolic/generic/assertions.pcert0
-symbolic/generic/assertions.cert : | symbolic/generic/assertions.pcert1
-
-symbolic/generic/defsimulate.pcert0 : no_pcert = 0
-symbolic/generic/defsimulate.pcert0 : acl2x = 0
-symbolic/generic/defsimulate.pcert0 : \
-     symbolic/generic/assertions.pcert0 \
-     symbolic/generic/measures.pcert0 \
-     symbolic/generic/partial-correctness.pcert0 \
-     symbolic/generic/total-correctness.pcert0 \
-     ordinals/ordinals-without-arithmetic.pcert0 \
-     misc/defpun.pcert0 \
-     symbolic/generic/assertions.pcert0 \
-     symbolic/generic/partial-correctness.pcert0 \
-     symbolic/generic/assertions.pcert0 \
-     symbolic/generic/measures.pcert0 \
-     symbolic/generic/total-correctness.pcert0 \
-     symbolic/generic/defsimulate.lisp
-symbolic/generic/defsimulate.pcert1 : acl2x = 0
-symbolic/generic/defsimulate.pcert1 : no_pcert = 0
-symbolic/generic/defsimulate.pcert1 : symbolic/generic/defsimulate.pcert0
-symbolic/generic/defsimulate.cert : | symbolic/generic/defsimulate.pcert1
-
-symbolic/generic/factorial-jvm-correct.pcert0 : no_pcert = 0
-symbolic/generic/factorial-jvm-correct.pcert0 : acl2x = 0
-symbolic/generic/factorial-jvm-correct.pcert0 : \
-     symbolic/m5/demo.pcert0 \
-     ordinals/ordinals.pcert0 \
-     symbolic/generic/defsimulate.pcert0 \
-     symbolic/m5/utilities.pcert0 \
-     symbolic/generic/factorial-jvm-correct.lisp \
-     symbolic/generic/factorial-jvm-correct.acl2
-symbolic/generic/factorial-jvm-correct.pcert1 : acl2x = 0
-symbolic/generic/factorial-jvm-correct.pcert1 : no_pcert = 0
-symbolic/generic/factorial-jvm-correct.pcert1 : symbolic/generic/factorial-jvm-correct.pcert0
-symbolic/generic/factorial-jvm-correct.cert : | symbolic/generic/factorial-jvm-correct.pcert1
-
-symbolic/generic/measures.pcert0 : no_pcert = 0
-symbolic/generic/measures.pcert0 : acl2x = 0
-symbolic/generic/measures.pcert0 : \
-     misc/defpun.pcert0 \
-     ordinals/ordinals.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     symbolic/generic/measures.lisp
-symbolic/generic/measures.pcert1 : acl2x = 0
-symbolic/generic/measures.pcert1 : no_pcert = 0
-symbolic/generic/measures.pcert1 : symbolic/generic/measures.pcert0
-symbolic/generic/measures.cert : | symbolic/generic/measures.pcert1
-
-symbolic/generic/partial-correctness.pcert0 : no_pcert = 0
-symbolic/generic/partial-correctness.pcert0 : acl2x = 0
-symbolic/generic/partial-correctness.pcert0 : \
-     misc/defpun.pcert0 \
-     ordinals/ordinals.pcert0 \
-     symbolic/generic/partial-correctness.lisp
-symbolic/generic/partial-correctness.pcert1 : acl2x = 0
-symbolic/generic/partial-correctness.pcert1 : no_pcert = 0
-symbolic/generic/partial-correctness.pcert1 : symbolic/generic/partial-correctness.pcert0
-symbolic/generic/partial-correctness.cert : | symbolic/generic/partial-correctness.pcert1
-
-symbolic/generic/tiny-fib-correct.pcert0 : no_pcert = 0
-symbolic/generic/tiny-fib-correct.pcert0 : acl2x = 0
-symbolic/generic/tiny-fib-correct.pcert0 : \
-     symbolic/tiny-fib/tiny-rewrites.pcert0 \
-     symbolic/tiny-fib/fib-def.pcert0 \
-     ordinals/ordinals.pcert0 \
-     symbolic/generic/defsimulate.pcert0 \
-     symbolic/generic/tiny-fib-correct.lisp
-symbolic/generic/tiny-fib-correct.pcert1 : acl2x = 0
-symbolic/generic/tiny-fib-correct.pcert1 : no_pcert = 0
-symbolic/generic/tiny-fib-correct.pcert1 : symbolic/generic/tiny-fib-correct.pcert0
-symbolic/generic/tiny-fib-correct.cert : | symbolic/generic/tiny-fib-correct.pcert1
-
-symbolic/generic/total-correctness.pcert0 : no_pcert = 0
-symbolic/generic/total-correctness.pcert0 : acl2x = 0
-symbolic/generic/total-correctness.pcert0 : \
-     misc/defpun.pcert0 \
-     ordinals/ordinals-without-arithmetic.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     symbolic/generic/total-correctness.lisp
-symbolic/generic/total-correctness.pcert1 : acl2x = 0
-symbolic/generic/total-correctness.pcert1 : no_pcert = 0
-symbolic/generic/total-correctness.pcert1 : symbolic/generic/total-correctness.pcert0
-symbolic/generic/total-correctness.cert : | symbolic/generic/total-correctness.pcert1
-
-symbolic/m5/demo.pcert0 : no_pcert = 0
-symbolic/m5/demo.pcert0 : acl2x = 0
-symbolic/m5/demo.pcert0 : \
-     symbolic/m5/utilities.pcert0 \
-     symbolic/m5/utilities.pcert0 \
-     symbolic/m5/demo.lisp \
-     symbolic/m5/demo.acl2
-symbolic/m5/demo.pcert1 : acl2x = 0
-symbolic/m5/demo.pcert1 : no_pcert = 0
-symbolic/m5/demo.pcert1 : symbolic/m5/demo.pcert0
-symbolic/m5/demo.cert : | symbolic/m5/demo.pcert1
-
-symbolic/m5/utilities.pcert0 : no_pcert = 0
-symbolic/m5/utilities.pcert0 : acl2x = 0
-symbolic/m5/utilities.pcert0 : \
-     models/jvm/m5/m5.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     models/jvm/m5/m5.pcert0 \
-     symbolic/m5/utilities.lisp \
-     symbolic/m5/utilities.acl2
-symbolic/m5/utilities.pcert1 : acl2x = 0
-symbolic/m5/utilities.pcert1 : no_pcert = 0
-symbolic/m5/utilities.pcert1 : symbolic/m5/utilities.pcert0
-symbolic/m5/utilities.cert : | symbolic/m5/utilities.pcert1
-
-symbolic/tiny-fib/defstobj+.pcert0 : no_pcert = 0
-symbolic/tiny-fib/defstobj+.pcert0 : acl2x = 0
-symbolic/tiny-fib/defstobj+.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     symbolic/tiny-fib/defstobj+.lisp
-symbolic/tiny-fib/defstobj+.pcert1 : acl2x = 0
-symbolic/tiny-fib/defstobj+.pcert1 : no_pcert = 0
-symbolic/tiny-fib/defstobj+.pcert1 : symbolic/tiny-fib/defstobj+.pcert0
-symbolic/tiny-fib/defstobj+.cert : | symbolic/tiny-fib/defstobj+.pcert1
-
-symbolic/tiny-fib/fib-def.pcert0 : no_pcert = 0
-symbolic/tiny-fib/fib-def.pcert0 : acl2x = 0
-symbolic/tiny-fib/fib-def.pcert0 : \
-     symbolic/tiny-fib/tiny.pcert0 \
-     symbolic/tiny-fib/fib-def.lisp
-symbolic/tiny-fib/fib-def.pcert1 : acl2x = 0
-symbolic/tiny-fib/fib-def.pcert1 : no_pcert = 0
-symbolic/tiny-fib/fib-def.pcert1 : symbolic/tiny-fib/fib-def.pcert0
-symbolic/tiny-fib/fib-def.cert : | symbolic/tiny-fib/fib-def.pcert1
-
-symbolic/tiny-fib/tiny-rewrites.pcert0 : no_pcert = 0
-symbolic/tiny-fib/tiny-rewrites.pcert0 : acl2x = 0
-symbolic/tiny-fib/tiny-rewrites.pcert0 : \
-     symbolic/tiny-fib/tiny.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     symbolic/tiny-fib/tiny-rewrites.lisp
-symbolic/tiny-fib/tiny-rewrites.pcert1 : acl2x = 0
-symbolic/tiny-fib/tiny-rewrites.pcert1 : no_pcert = 0
-symbolic/tiny-fib/tiny-rewrites.pcert1 : symbolic/tiny-fib/tiny-rewrites.pcert0
-symbolic/tiny-fib/tiny-rewrites.cert : | symbolic/tiny-fib/tiny-rewrites.pcert1
-
-symbolic/tiny-fib/tiny.pcert0 : no_pcert = 0
-symbolic/tiny-fib/tiny.pcert0 : acl2x = 0
-symbolic/tiny-fib/tiny.pcert0 : \
-     symbolic/tiny-fib/defstobj+.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     symbolic/tiny-fib/tiny.lisp
-symbolic/tiny-fib/tiny.pcert1 : acl2x = 0
-symbolic/tiny-fib/tiny.pcert1 : no_pcert = 0
-symbolic/tiny-fib/tiny.pcert1 : symbolic/tiny-fib/tiny.pcert0
-symbolic/tiny-fib/tiny.cert : | symbolic/tiny-fib/tiny.pcert1
-
-symbolic/tiny-triangle/tiny-triangle-correct.pcert0 : no_pcert = 0
-symbolic/tiny-triangle/tiny-triangle-correct.pcert0 : acl2x = 0
-symbolic/tiny-triangle/tiny-triangle-correct.pcert0 : \
-     symbolic/tiny-fib/tiny-rewrites.pcert0 \
-     ordinals/ordinals.pcert0 \
-     symbolic/tiny-triangle/triangle-def.pcert0 \
-     symbolic/generic/defsimulate.pcert0 \
-     symbolic/tiny-triangle/tiny-triangle-correct.lisp
-symbolic/tiny-triangle/tiny-triangle-correct.pcert1 : acl2x = 0
-symbolic/tiny-triangle/tiny-triangle-correct.pcert1 : no_pcert = 0
-symbolic/tiny-triangle/tiny-triangle-correct.pcert1 : symbolic/tiny-triangle/tiny-triangle-correct.pcert0
-symbolic/tiny-triangle/tiny-triangle-correct.cert : | symbolic/tiny-triangle/tiny-triangle-correct.pcert1
-
-symbolic/tiny-triangle/triangle-def.pcert0 : no_pcert = 0
-symbolic/tiny-triangle/triangle-def.pcert0 : acl2x = 0
-symbolic/tiny-triangle/triangle-def.pcert0 : \
-     symbolic/tiny-fib/tiny.pcert0 \
-     symbolic/tiny-triangle/triangle-def.lisp
-symbolic/tiny-triangle/triangle-def.pcert1 : acl2x = 0
-symbolic/tiny-triangle/triangle-def.pcert1 : no_pcert = 0
-symbolic/tiny-triangle/triangle-def.pcert1 : symbolic/tiny-triangle/triangle-def.pcert0
-symbolic/tiny-triangle/triangle-def.cert : | symbolic/tiny-triangle/triangle-def.pcert1
-
-system/compare-out-files.pcert0 : no_pcert = 0
-system/compare-out-files.pcert0 : acl2x = 0
-system/compare-out-files.pcert0 : \
-     system/compare-out-files.lisp
-system/compare-out-files.pcert1 : acl2x = 0
-system/compare-out-files.pcert1 : no_pcert = 0
-system/compare-out-files.pcert1 : system/compare-out-files.pcert0
-system/compare-out-files.cert : | system/compare-out-files.pcert1
-
-system/convert-normalized-term-to-pairs.pcert0 : no_pcert = 0
-system/convert-normalized-term-to-pairs.pcert0 : acl2x = 0
-system/convert-normalized-term-to-pairs.pcert0 : \
-     system/convert-normalized-term-to-pairs.lisp
-system/convert-normalized-term-to-pairs.pcert1 : acl2x = 0
-system/convert-normalized-term-to-pairs.pcert1 : no_pcert = 0
-system/convert-normalized-term-to-pairs.pcert1 : system/convert-normalized-term-to-pairs.pcert0
-system/convert-normalized-term-to-pairs.cert : | system/convert-normalized-term-to-pairs.pcert1
-
-system/extend-pathname.pcert0 : no_pcert = 0
-system/extend-pathname.pcert0 : acl2x = 0
-system/extend-pathname.pcert0 : \
-     system/extend-pathname.lisp
-system/extend-pathname.pcert1 : acl2x = 0
-system/extend-pathname.pcert1 : no_pcert = 0
-system/extend-pathname.pcert1 : system/extend-pathname.pcert0
-system/extend-pathname.cert : | system/extend-pathname.pcert1
-
-system/f-put-global.pcert0 : no_pcert = 0
-system/f-put-global.pcert0 : acl2x = 0
-system/f-put-global.pcert0 : \
-     system/f-put-global.lisp
-system/f-put-global.pcert1 : acl2x = 0
-system/f-put-global.pcert1 : no_pcert = 0
-system/f-put-global.pcert1 : system/f-put-global.pcert0
-system/f-put-global.cert : | system/f-put-global.pcert1
-
-system/gather-dcls.pcert0 : no_pcert = 0
-system/gather-dcls.pcert0 : acl2x = 0
-system/gather-dcls.pcert0 : \
-     system/gather-dcls.lisp
-system/gather-dcls.pcert1 : acl2x = 0
-system/gather-dcls.pcert1 : no_pcert = 0
-system/gather-dcls.pcert1 : system/gather-dcls.pcert0
-system/gather-dcls.cert : | system/gather-dcls.pcert1
-
-system/hl-addr-combine.pcert0 : no_pcert = 0
-system/hl-addr-combine.pcert0 : acl2x = 0
-system/hl-addr-combine.pcert0 : \
-     arithmetic-5/top.pcert0 \
-     system/hl-addr-combine.lisp
-system/hl-addr-combine.pcert1 : acl2x = 0
-system/hl-addr-combine.pcert1 : no_pcert = 0
-system/hl-addr-combine.pcert1 : system/hl-addr-combine.pcert0
-system/hl-addr-combine.cert : | system/hl-addr-combine.pcert1
-
-system/io.pcert0 : no_pcert = 0
-system/io.pcert0 : acl2x = 0
-system/io.pcert0 : \
-     std/io/base.pcert0 \
-     system/io.lisp
-system/io.pcert1 : acl2x = 0
-system/io.pcert1 : no_pcert = 0
-system/io.pcert1 : system/io.pcert0
-system/io.cert : | system/io.pcert1
-
-system/legal-variablep.pcert0 : no_pcert = 0
-system/legal-variablep.pcert0 : acl2x = 0
-system/legal-variablep.pcert0 : \
-     system/legal-variablep.lisp
-system/legal-variablep.pcert1 : acl2x = 0
-system/legal-variablep.pcert1 : no_pcert = 0
-system/legal-variablep.pcert1 : system/legal-variablep.pcert0
-system/legal-variablep.cert : | system/legal-variablep.pcert1
-
-system/meta-extract.pcert0 : no_pcert = 0
-system/meta-extract.pcert0 : acl2x = 0
-system/meta-extract.pcert0 : \
-     system/sublis-var.pcert0 \
-     system/meta-extract.lisp
-system/meta-extract.pcert1 : acl2x = 0
-system/meta-extract.pcert1 : no_pcert = 0
-system/meta-extract.pcert1 : system/meta-extract.pcert0
-system/meta-extract.cert : | system/meta-extract.pcert1
-
-system/pseudo-good-worldp.pcert0 : no_pcert = 0
-system/pseudo-good-worldp.pcert0 : acl2x = 0
-system/pseudo-good-worldp.pcert0 : \
-     system/pseudo-good-worldp.lisp
-system/pseudo-good-worldp.pcert1 : acl2x = 0
-system/pseudo-good-worldp.pcert1 : no_pcert = 0
-system/pseudo-good-worldp.pcert1 : system/pseudo-good-worldp.pcert0
-system/pseudo-good-worldp.cert : | system/pseudo-good-worldp.pcert1
-
-system/pseudo-termp-lemmas.pcert0 : no_pcert = 0
-system/pseudo-termp-lemmas.pcert0 : acl2x = 0
-system/pseudo-termp-lemmas.pcert0 : \
-     system/pseudo-termp-lemmas.lisp
-system/pseudo-termp-lemmas.pcert1 : acl2x = 0
-system/pseudo-termp-lemmas.pcert1 : no_pcert = 0
-system/pseudo-termp-lemmas.pcert1 : system/pseudo-termp-lemmas.pcert0
-system/pseudo-termp-lemmas.cert : | system/pseudo-termp-lemmas.pcert1
-
-system/subcor-var.pcert0 : no_pcert = 0
-system/subcor-var.pcert0 : acl2x = 0
-system/subcor-var.pcert0 : \
-     system/sublis-var.pcert0 \
-     system/pseudo-termp-lemmas.pcert0 \
-     system/subcor-var.lisp
-system/subcor-var.pcert1 : acl2x = 0
-system/subcor-var.pcert1 : no_pcert = 0
-system/subcor-var.pcert1 : system/subcor-var.pcert0
-system/subcor-var.cert : | system/subcor-var.pcert1
-
-system/sublis-var.pcert0 : no_pcert = 0
-system/sublis-var.pcert0 : acl2x = 0
-system/sublis-var.pcert0 : \
-     system/sublis-var.lisp
-system/sublis-var.pcert1 : acl2x = 0
-system/sublis-var.pcert1 : no_pcert = 0
-system/sublis-var.pcert1 : system/sublis-var.pcert0
-system/sublis-var.cert : | system/sublis-var.pcert1
-
-system/subst-expr.pcert0 : no_pcert = 0
-system/subst-expr.pcert0 : acl2x = 0
-system/subst-expr.pcert0 : \
-     system/sublis-var.pcert0 \
-     system/pseudo-termp-lemmas.pcert0 \
-     system/subst-var.pcert0 \
-     system/subst-expr.lisp
-system/subst-expr.pcert1 : acl2x = 0
-system/subst-expr.pcert1 : no_pcert = 0
-system/subst-expr.pcert1 : system/subst-expr.pcert0
-system/subst-expr.cert : | system/subst-expr.pcert1
-
-system/subst-var.pcert0 : no_pcert = 0
-system/subst-var.pcert0 : acl2x = 0
-system/subst-var.pcert0 : \
-     system/sublis-var.pcert0 \
-     system/pseudo-termp-lemmas.pcert0 \
-     system/subst-var.lisp
-system/subst-var.pcert1 : acl2x = 0
-system/subst-var.pcert1 : no_pcert = 0
-system/subst-var.pcert1 : system/subst-var.pcert0
-system/subst-var.cert : | system/subst-var.pcert1
-
-system/too-many-ifs.pcert0 : no_pcert = 0
-system/too-many-ifs.pcert0 : acl2x = 0
-system/too-many-ifs.pcert0 : \
-     tools/flag.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     tools/flag.pcert0 \
-     system/too-many-ifs.lisp \
-     system/too-many-ifs.acl2
-system/too-many-ifs.pcert1 : acl2x = 0
-system/too-many-ifs.pcert1 : no_pcert = 0
-system/too-many-ifs.pcert1 : system/too-many-ifs.pcert0
-system/too-many-ifs.cert : | system/too-many-ifs.pcert1
-
-system/top.pcert0 : no_pcert = 0
-system/top.pcert0 : acl2x = 0
-system/top.pcert0 : \
-     system/hl-addr-combine.pcert0 \
-     system/extend-pathname.pcert0 \
-     system/too-many-ifs.pcert0 \
-     system/verified-termination-and-guards.pcert0 \
-     system/sublis-var.pcert0 \
-     system/subcor-var.pcert0 \
-     system/subst-expr.pcert0 \
-     system/convert-normalized-term-to-pairs.pcert0 \
-     system/gather-dcls.pcert0 \
-     system/meta-extract.pcert0 \
-     system/legal-variablep.pcert0 \
-     system/top.lisp
-system/top.pcert1 : acl2x = 0
-system/top.pcert1 : no_pcert = 0
-system/top.pcert1 : system/top.pcert0
-system/top.cert : | system/top.pcert1
-
-system/update-state.pcert0 : no_pcert = 0
-system/update-state.pcert0 : acl2x = 0
-system/update-state.pcert0 : \
-     system/update-state.lisp
-system/update-state.pcert1 : acl2x = 0
-system/update-state.pcert1 : no_pcert = 0
-system/update-state.pcert1 : system/update-state.pcert0
-system/update-state.cert : | system/update-state.pcert1
-
-system/verified-termination-and-guards.pcert0 : no_pcert = 0
-system/verified-termination-and-guards.pcert0 : acl2x = 0
-system/verified-termination-and-guards.pcert0 : \
-     system/verified-termination-and-guards.lisp
-system/verified-termination-and-guards.pcert1 : acl2x = 0
-system/verified-termination-and-guards.pcert1 : no_pcert = 0
-system/verified-termination-and-guards.pcert1 : system/verified-termination-and-guards.pcert0
-system/verified-termination-and-guards.cert : | system/verified-termination-and-guards.pcert1
-
-system/worldp-check.pcert0 : no_pcert = 0
-system/worldp-check.pcert0 : acl2x = 0
-system/worldp-check.pcert0 : \
-     system/pseudo-good-worldp.pcert0 \
-     system/worldp-check.lisp \
-     system/worldp-check.acl2
-system/worldp-check.pcert1 : acl2x = 0
-system/worldp-check.pcert1 : no_pcert = 0
-system/worldp-check.pcert1 : system/worldp-check.pcert0
-system/worldp-check.cert : | system/worldp-check.pcert1
-
-taspi/code/brlens/brlens.pcert0 : no_pcert = 0
-taspi/code/brlens/brlens.pcert0 : acl2x = 0
-taspi/code/brlens/brlens.pcert0 : \
-     taspi/code/gen-helper/extra.pcert0 \
-     taspi/code/brlens/brlens.lisp
-taspi/code/brlens/brlens.pcert1 : acl2x = 0
-taspi/code/brlens/brlens.pcert1 : no_pcert = 0
-taspi/code/brlens/brlens.pcert1 : taspi/code/brlens/brlens.pcert0
-taspi/code/brlens/brlens.cert : | taspi/code/brlens/brlens.pcert1
-
-taspi/code/brlens/trees-with-brlens.pcert0 : no_pcert = 0
-taspi/code/brlens/trees-with-brlens.pcert0 : acl2x = 0
-taspi/code/brlens/trees-with-brlens.pcert0 : \
-     taspi/code/brlens/brlens.pcert0 \
-     taspi/code/gen-trees/tree-predicates.pcert0 \
-     taspi/code/brlens/trees-with-brlens.lisp
-taspi/code/brlens/trees-with-brlens.pcert1 : acl2x = 0
-taspi/code/brlens/trees-with-brlens.pcert1 : no_pcert = 0
-taspi/code/brlens/trees-with-brlens.pcert1 : taspi/code/brlens/trees-with-brlens.pcert0
-taspi/code/brlens/trees-with-brlens.cert : | taspi/code/brlens/trees-with-brlens.pcert1
-
-taspi/code/build/build-term-guards.pcert0 : no_pcert = 0
-taspi/code/build/build-term-guards.pcert0 : acl2x = 0
-taspi/code/build/build-term-guards.pcert0 : \
-     taspi/code/build/build-term.pcert0 \
-     taspi/code/fringes/fringes-guards.pcert0 \
-     taspi/code/build/build-term-guards.lisp
-taspi/code/build/build-term-guards.pcert1 : acl2x = 0
-taspi/code/build/build-term-guards.pcert1 : no_pcert = 0
-taspi/code/build/build-term-guards.pcert1 : taspi/code/build/build-term-guards.pcert0
-taspi/code/build/build-term-guards.cert : | taspi/code/build/build-term-guards.pcert1
-
-taspi/code/build/build-term.pcert0 : no_pcert = 0
-taspi/code/build/build-term.pcert0 : acl2x = 0
-taspi/code/build/build-term.pcert0 : \
-     taspi/code/fringes/fringes.pcert0 \
-     taspi/code/build/build-term.lisp
-taspi/code/build/build-term.pcert1 : acl2x = 0
-taspi/code/build/build-term.pcert1 : no_pcert = 0
-taspi/code/build/build-term.pcert1 : taspi/code/build/build-term.pcert0
-taspi/code/build/build-term.cert : | taspi/code/build/build-term.pcert1
-
-taspi/code/fringes/fringes-guards.pcert0 : no_pcert = 0
-taspi/code/fringes/fringes-guards.pcert0 : acl2x = 0
-taspi/code/fringes/fringes-guards.pcert0 : \
-     taspi/code/fringes/fringes.pcert0 \
-     taspi/code/replete/replete-guards.pcert0 \
-     taspi/code/gen-trees/btrees-bdds-sets.pcert0 \
-     taspi/code/gen-trees/app-rev-lists.pcert0 \
-     taspi/code/fringes/fringes-guards.lisp
-taspi/code/fringes/fringes-guards.pcert1 : acl2x = 0
-taspi/code/fringes/fringes-guards.pcert1 : no_pcert = 0
-taspi/code/fringes/fringes-guards.pcert1 : taspi/code/fringes/fringes-guards.pcert0
-taspi/code/fringes/fringes-guards.cert : | taspi/code/fringes/fringes-guards.pcert1
-
-taspi/code/fringes/fringes-props.pcert0 : no_pcert = 0
-taspi/code/fringes/fringes-props.pcert0 : acl2x = 0
-taspi/code/fringes/fringes-props.pcert0 : \
-     taspi/code/fringes/fringes-guards.pcert0 \
-     taspi/code/fringes/fringes-props.lisp
-taspi/code/fringes/fringes-props.pcert1 : acl2x = 0
-taspi/code/fringes/fringes-props.pcert1 : no_pcert = 0
-taspi/code/fringes/fringes-props.pcert1 : taspi/code/fringes/fringes-props.pcert0
-taspi/code/fringes/fringes-props.cert : | taspi/code/fringes/fringes-props.pcert1
-
-taspi/code/fringes/fringes.pcert0 : no_pcert = 0
-taspi/code/fringes/fringes.pcert0 : acl2x = 0
-taspi/code/fringes/fringes.pcert0 : \
-     taspi/code/gen-trees/sets-lists-trees.pcert0 \
-     taspi/code/replete/replete.pcert0 \
-     taspi/code/gen-trees/btrees-bdds.pcert0 \
-     taspi/code/fringes/fringes.lisp
-taspi/code/fringes/fringes.pcert1 : acl2x = 0
-taspi/code/fringes/fringes.pcert1 : no_pcert = 0
-taspi/code/fringes/fringes.pcert1 : taspi/code/fringes/fringes.pcert0
-taspi/code/fringes/fringes.cert : | taspi/code/fringes/fringes.pcert1
-
-taspi/code/gen-helper/bdd-functions.pcert0 : no_pcert = 0
-taspi/code/gen-helper/bdd-functions.pcert0 : acl2x = 0
-taspi/code/gen-helper/bdd-functions.pcert0 : \
-     taspi/code/gen-helper/sets.pcert0 \
-     taspi/code/gen-helper/bdd-functions.lisp
-taspi/code/gen-helper/bdd-functions.pcert1 : acl2x = 0
-taspi/code/gen-helper/bdd-functions.pcert1 : no_pcert = 0
-taspi/code/gen-helper/bdd-functions.pcert1 : taspi/code/gen-helper/bdd-functions.pcert0
-taspi/code/gen-helper/bdd-functions.cert : | taspi/code/gen-helper/bdd-functions.pcert1
-
-taspi/code/gen-helper/extra.pcert0 : no_pcert = 0
-taspi/code/gen-helper/extra.pcert0 : acl2x = 0
-taspi/code/gen-helper/extra.pcert0 : \
-     misc/hons-help2.pcert0 \
-     taspi/code/gen-helper/extra.lisp
-taspi/code/gen-helper/extra.pcert1 : acl2x = 0
-taspi/code/gen-helper/extra.pcert1 : no_pcert = 0
-taspi/code/gen-helper/extra.pcert1 : taspi/code/gen-helper/extra.pcert0
-taspi/code/gen-helper/extra.cert : | taspi/code/gen-helper/extra.pcert1
-
-taspi/code/gen-helper/fast-lists.pcert0 : no_pcert = 0
-taspi/code/gen-helper/fast-lists.pcert0 : acl2x = 0
-taspi/code/gen-helper/fast-lists.pcert0 : \
-     taspi/code/gen-helper/extra.pcert0 \
-     taspi/code/gen-helper/fast-lists.lisp
-taspi/code/gen-helper/fast-lists.pcert1 : acl2x = 0
-taspi/code/gen-helper/fast-lists.pcert1 : no_pcert = 0
-taspi/code/gen-helper/fast-lists.pcert1 : taspi/code/gen-helper/fast-lists.pcert0
-taspi/code/gen-helper/fast-lists.cert : | taspi/code/gen-helper/fast-lists.pcert1
-
-taspi/code/gen-helper/sets.pcert0 : no_pcert = 0
-taspi/code/gen-helper/sets.pcert0 : acl2x = 0
-taspi/code/gen-helper/sets.pcert0 : \
-     taspi/code/gen-helper/extra.pcert0 \
-     taspi/code/gen-helper/sets.lisp
-taspi/code/gen-helper/sets.pcert1 : acl2x = 0
-taspi/code/gen-helper/sets.pcert1 : no_pcert = 0
-taspi/code/gen-helper/sets.pcert1 : taspi/code/gen-helper/sets.pcert0
-taspi/code/gen-helper/sets.cert : | taspi/code/gen-helper/sets.pcert1
-
-taspi/code/gen-helper/top.pcert0 : no_pcert = 0
-taspi/code/gen-helper/top.pcert0 : acl2x = 0
-taspi/code/gen-helper/top.pcert0 : \
-     taspi/code/gen-helper/sets.pcert0 \
-     taspi/code/gen-helper/fast-lists.pcert0 \
-     taspi/code/gen-helper/bdd-functions.pcert0 \
-     taspi/code/gen-helper/top.lisp
-taspi/code/gen-helper/top.pcert1 : acl2x = 0
-taspi/code/gen-helper/top.pcert1 : no_pcert = 0
-taspi/code/gen-helper/top.pcert1 : taspi/code/gen-helper/top.pcert0
-taspi/code/gen-helper/top.cert : | taspi/code/gen-helper/top.pcert1
-
-taspi/code/gen-trees/app-rev-lists.pcert0 : no_pcert = 0
-taspi/code/gen-trees/app-rev-lists.pcert0 : acl2x = 0
-taspi/code/gen-trees/app-rev-lists.pcert0 : \
-     taspi/code/gen-trees/sets-lists-trees.pcert0 \
-     taspi/code/gen-trees/app-rev-lists.lisp
-taspi/code/gen-trees/app-rev-lists.pcert1 : acl2x = 0
-taspi/code/gen-trees/app-rev-lists.pcert1 : no_pcert = 0
-taspi/code/gen-trees/app-rev-lists.pcert1 : taspi/code/gen-trees/app-rev-lists.pcert0
-taspi/code/gen-trees/app-rev-lists.cert : | taspi/code/gen-trees/app-rev-lists.pcert1
-
-taspi/code/gen-trees/btrees-bdds-sets.pcert0 : no_pcert = 0
-taspi/code/gen-trees/btrees-bdds-sets.pcert0 : acl2x = 0
-taspi/code/gen-trees/btrees-bdds-sets.pcert0 : \
-     taspi/code/gen-trees/btrees-bdds.pcert0 \
-     taspi/code/gen-trees/sets-lists-trees.pcert0 \
-     taspi/code/gen-trees/btrees-bdds-sets.lisp
-taspi/code/gen-trees/btrees-bdds-sets.pcert1 : acl2x = 0
-taspi/code/gen-trees/btrees-bdds-sets.pcert1 : no_pcert = 0
-taspi/code/gen-trees/btrees-bdds-sets.pcert1 : taspi/code/gen-trees/btrees-bdds-sets.pcert0
-taspi/code/gen-trees/btrees-bdds-sets.cert : | taspi/code/gen-trees/btrees-bdds-sets.pcert1
-
-taspi/code/gen-trees/btrees-bdds.pcert0 : no_pcert = 0
-taspi/code/gen-trees/btrees-bdds.pcert0 : acl2x = 0
-taspi/code/gen-trees/btrees-bdds.pcert0 : \
-     taspi/code/gen-helper/extra.pcert0 \
-     taspi/code/gen-trees/btrees.pcert0 \
-     taspi/code/gen-helper/bdd-functions.pcert0 \
-     taspi/code/gen-trees/btrees-bdds.lisp
-taspi/code/gen-trees/btrees-bdds.pcert1 : acl2x = 0
-taspi/code/gen-trees/btrees-bdds.pcert1 : no_pcert = 0
-taspi/code/gen-trees/btrees-bdds.pcert1 : taspi/code/gen-trees/btrees-bdds.pcert0
-taspi/code/gen-trees/btrees-bdds.cert : | taspi/code/gen-trees/btrees-bdds.pcert1
-
-taspi/code/gen-trees/btrees.pcert0 : no_pcert = 0
-taspi/code/gen-trees/btrees.pcert0 : acl2x = 0
-taspi/code/gen-trees/btrees.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     taspi/code/gen-helper/fast-lists.pcert0 \
-     taspi/code/gen-trees/btrees.lisp
-taspi/code/gen-trees/btrees.pcert1 : acl2x = 0
-taspi/code/gen-trees/btrees.pcert1 : no_pcert = 0
-taspi/code/gen-trees/btrees.pcert1 : taspi/code/gen-trees/btrees.pcert0
-taspi/code/gen-trees/btrees.cert : | taspi/code/gen-trees/btrees.pcert1
-
-taspi/code/gen-trees/sets-lists-trees.pcert0 : no_pcert = 0
-taspi/code/gen-trees/sets-lists-trees.pcert0 : acl2x = 0
-taspi/code/gen-trees/sets-lists-trees.pcert0 : \
-     taspi/code/gen-helper/sets.pcert0 \
-     taspi/code/gen-helper/fast-lists.pcert0 \
-     taspi/code/gen-trees/tree-predicates.pcert0 \
-     taspi/code/gen-trees/sets-lists-trees.lisp
-taspi/code/gen-trees/sets-lists-trees.pcert1 : acl2x = 0
-taspi/code/gen-trees/sets-lists-trees.pcert1 : no_pcert = 0
-taspi/code/gen-trees/sets-lists-trees.pcert1 : taspi/code/gen-trees/sets-lists-trees.pcert0
-taspi/code/gen-trees/sets-lists-trees.cert : | taspi/code/gen-trees/sets-lists-trees.pcert1
-
-taspi/code/gen-trees/top.pcert0 : no_pcert = 0
-taspi/code/gen-trees/top.pcert0 : acl2x = 0
-taspi/code/gen-trees/top.pcert0 : \
-     taspi/code/gen-trees/btrees-bdds-sets.pcert0 \
-     taspi/code/gen-trees/app-rev-lists.pcert0 \
-     taspi/code/gen-trees/sets-lists-trees.pcert0 \
-     taspi/code/gen-trees/tree-predicates.pcert0 \
-     taspi/code/gen-trees/top.lisp
-taspi/code/gen-trees/top.pcert1 : acl2x = 0
-taspi/code/gen-trees/top.pcert1 : no_pcert = 0
-taspi/code/gen-trees/top.pcert1 : taspi/code/gen-trees/top.pcert0
-taspi/code/gen-trees/top.cert : | taspi/code/gen-trees/top.pcert1
-
-taspi/code/gen-trees/tree-predicates.pcert0 : no_pcert = 0
-taspi/code/gen-trees/tree-predicates.pcert0 : acl2x = 0
-taspi/code/gen-trees/tree-predicates.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     taspi/code/gen-helper/extra.pcert0 \
-     taspi/code/gen-trees/tree-predicates.lisp
-taspi/code/gen-trees/tree-predicates.pcert1 : acl2x = 0
-taspi/code/gen-trees/tree-predicates.pcert1 : no_pcert = 0
-taspi/code/gen-trees/tree-predicates.pcert1 : taspi/code/gen-trees/tree-predicates.pcert0
-taspi/code/gen-trees/tree-predicates.cert : | taspi/code/gen-trees/tree-predicates.pcert1
-
-taspi/code/replete/replete-guards.pcert0 : no_pcert = 0
-taspi/code/replete/replete-guards.pcert0 : acl2x = 0
-taspi/code/replete/replete-guards.pcert0 : \
-     taspi/code/replete/replete.pcert0 \
-     taspi/code/brlens/trees-with-brlens.pcert0 \
-     taspi/code/replete/replete-guards.lisp
-taspi/code/replete/replete-guards.pcert1 : acl2x = 0
-taspi/code/replete/replete-guards.pcert1 : no_pcert = 0
-taspi/code/replete/replete-guards.pcert1 : taspi/code/replete/replete-guards.pcert0
-taspi/code/replete/replete-guards.cert : | taspi/code/replete/replete-guards.pcert1
-
-taspi/code/replete/replete-helper.pcert0 : no_pcert = 0
-taspi/code/replete/replete-helper.pcert0 : acl2x = 0
-taspi/code/replete/replete-helper.pcert0 : \
-     taspi/code/gen-trees/sets-lists-trees.pcert0 \
-     taspi/code/replete/replete-helper.lisp
-taspi/code/replete/replete-helper.pcert1 : acl2x = 0
-taspi/code/replete/replete-helper.pcert1 : no_pcert = 0
-taspi/code/replete/replete-helper.pcert1 : taspi/code/replete/replete-helper.pcert0
-taspi/code/replete/replete-helper.cert : | taspi/code/replete/replete-helper.pcert1
-
-taspi/code/replete/replete.pcert0 : no_pcert = 0
-taspi/code/replete/replete.pcert0 : acl2x = 0
-taspi/code/replete/replete.pcert0 : \
-     taspi/code/replete/replete-helper.pcert0 \
-     taspi/code/replete/replete.lisp
-taspi/code/replete/replete.pcert1 : acl2x = 0
-taspi/code/replete/replete.pcert1 : no_pcert = 0
-taspi/code/replete/replete.pcert1 : taspi/code/replete/replete.pcert0
-taspi/code/replete/replete.cert : | taspi/code/replete/replete.pcert1
-
-taspi/code/sequences/align.pcert0 : no_pcert = 0
-taspi/code/sequences/align.pcert0 : acl2x = 0
-taspi/code/sequences/align.pcert0 : \
-     taspi/code/gen-helper/extra.pcert0 \
-     taspi/code/sequences/align.lisp
-taspi/code/sequences/align.pcert1 : acl2x = 0
-taspi/code/sequences/align.pcert1 : no_pcert = 0
-taspi/code/sequences/align.pcert1 : taspi/code/sequences/align.pcert0
-taspi/code/sequences/align.cert : | taspi/code/sequences/align.pcert1
-
-taspi/code/sequences/p-inform.pcert0 : no_pcert = 0
-taspi/code/sequences/p-inform.pcert0 : acl2x = 0
-taspi/code/sequences/p-inform.pcert0 : \
-     taspi/code/sequences/seqs.pcert0 \
-     taspi/code/sequences/p-inform.lisp
-taspi/code/sequences/p-inform.pcert1 : acl2x = 0
-taspi/code/sequences/p-inform.pcert1 : no_pcert = 0
-taspi/code/sequences/p-inform.pcert1 : taspi/code/sequences/p-inform.pcert0
-taspi/code/sequences/p-inform.cert : | taspi/code/sequences/p-inform.pcert1
-
-taspi/code/sequences/seqs.pcert0 : no_pcert = 0
-taspi/code/sequences/seqs.pcert0 : acl2x = 0
-taspi/code/sequences/seqs.pcert0 : \
-     misc/hons-help2.pcert0 \
-     taspi/code/gen-trees/top.pcert0 \
-     taspi/code/sequences/seqs.lisp
-taspi/code/sequences/seqs.pcert1 : acl2x = 0
-taspi/code/sequences/seqs.pcert1 : no_pcert = 0
-taspi/code/sequences/seqs.pcert1 : taspi/code/sequences/seqs.pcert0
-taspi/code/sequences/seqs.cert : | taspi/code/sequences/seqs.pcert1
-
-taspi/code/tree-manip/insertion-based-sort.pcert0 : no_pcert = 0
-taspi/code/tree-manip/insertion-based-sort.pcert0 : acl2x = 0
-taspi/code/tree-manip/insertion-based-sort.pcert0 : \
-     taspi/code/tree-manip/sort-help.pcert0 \
-     taspi/code/tree-manip/insertion-based-sort.lisp
-taspi/code/tree-manip/insertion-based-sort.pcert1 : acl2x = 0
-taspi/code/tree-manip/insertion-based-sort.pcert1 : no_pcert = 0
-taspi/code/tree-manip/insertion-based-sort.pcert1 : taspi/code/tree-manip/insertion-based-sort.pcert0
-taspi/code/tree-manip/insertion-based-sort.cert : | taspi/code/tree-manip/insertion-based-sort.pcert1
-
-taspi/code/tree-manip/merge-based-sort.pcert0 : no_pcert = 0
-taspi/code/tree-manip/merge-based-sort.pcert0 : acl2x = 0
-taspi/code/tree-manip/merge-based-sort.pcert0 : \
-     taspi/code/tree-manip/sort-help.pcert0 \
-     taspi/code/tree-manip/merge-based-sort.lisp
-taspi/code/tree-manip/merge-based-sort.pcert1 : acl2x = 0
-taspi/code/tree-manip/merge-based-sort.pcert1 : no_pcert = 0
-taspi/code/tree-manip/merge-based-sort.pcert1 : taspi/code/tree-manip/merge-based-sort.pcert0
-taspi/code/tree-manip/merge-based-sort.cert : | taspi/code/tree-manip/merge-based-sort.pcert1
-
-taspi/code/tree-manip/mv-root.pcert0 : no_pcert = 0
-taspi/code/tree-manip/mv-root.pcert0 : acl2x = 0
-taspi/code/tree-manip/mv-root.pcert0 : \
-     taspi/code/build/build-term-guards.pcert0 \
-     taspi/code/tree-manip/mv-root.lisp
-taspi/code/tree-manip/mv-root.pcert1 : acl2x = 0
-taspi/code/tree-manip/mv-root.pcert1 : no_pcert = 0
-taspi/code/tree-manip/mv-root.pcert1 : taspi/code/tree-manip/mv-root.pcert0
-taspi/code/tree-manip/mv-root.cert : | taspi/code/tree-manip/mv-root.pcert1
-
-taspi/code/tree-manip/quicksort.pcert0 : no_pcert = 0
-taspi/code/tree-manip/quicksort.pcert0 : acl2x = 0
-taspi/code/tree-manip/quicksort.pcert0 : \
-     taspi/code/tree-manip/quicksort.lisp
-taspi/code/tree-manip/quicksort.pcert1 : acl2x = 0
-taspi/code/tree-manip/quicksort.pcert1 : no_pcert = 0
-taspi/code/tree-manip/quicksort.pcert1 : taspi/code/tree-manip/quicksort.pcert0
-taspi/code/tree-manip/quicksort.cert : | taspi/code/tree-manip/quicksort.pcert1
-
-taspi/code/tree-manip/sort-help.pcert0 : no_pcert = 0
-taspi/code/tree-manip/sort-help.pcert0 : acl2x = 0
-taspi/code/tree-manip/sort-help.pcert0 : \
-     taspi/code/gen-trees/sets-lists-trees.pcert0 \
-     taspi/code/tree-manip/sort-help.lisp
-taspi/code/tree-manip/sort-help.pcert1 : acl2x = 0
-taspi/code/tree-manip/sort-help.pcert1 : no_pcert = 0
-taspi/code/tree-manip/sort-help.pcert1 : taspi/code/tree-manip/sort-help.pcert0
-taspi/code/tree-manip/sort-help.cert : | taspi/code/tree-manip/sort-help.pcert1
-
-taspi/code/tree-manip/top.pcert0 : no_pcert = 0
-taspi/code/tree-manip/top.pcert0 : acl2x = 0
-taspi/code/tree-manip/top.pcert0 : \
-     taspi/code/tree-manip/mv-root.pcert0 \
-     taspi/code/tree-manip/merge-based-sort.pcert0 \
-     taspi/code/tree-manip/insertion-based-sort.pcert0 \
-     taspi/code/tree-manip/top.lisp
-taspi/code/tree-manip/top.pcert1 : acl2x = 0
-taspi/code/tree-manip/top.pcert1 : no_pcert = 0
-taspi/code/tree-manip/top.pcert1 : taspi/code/tree-manip/top.pcert0
-taspi/code/tree-manip/top.cert : | taspi/code/tree-manip/top.pcert1
-
-taspi/database/db-from-list.pcert0 : no_pcert = 0
-taspi/database/db-from-list.pcert0 : acl2x = 0
-taspi/database/db-from-list.pcert0 : \
-     taspi/database/db-from-list.lisp
-taspi/database/db-from-list.pcert1 : acl2x = 0
-taspi/database/db-from-list.pcert1 : no_pcert = 0
-taspi/database/db-from-list.pcert1 : taspi/database/db-from-list.pcert0
-taspi/database/db-from-list.cert : | taspi/database/db-from-list.pcert1
-
-taspi/database/db.pcert0 : no_pcert = 0
-taspi/database/db.pcert0 : acl2x = 0
-taspi/database/db.pcert0 : \
-     taspi/database/entry.pcert0 \
-     taspi/code/tree-manip/top.pcert0 \
-     taspi/database/db.lisp
-taspi/database/db.pcert1 : acl2x = 0
-taspi/database/db.pcert1 : no_pcert = 0
-taspi/database/db.pcert1 : taspi/database/db.pcert0
-taspi/database/db.cert : | taspi/database/db.pcert1
-
-taspi/database/entry.pcert0 : no_pcert = 0
-taspi/database/entry.pcert0 : acl2x = 0
-taspi/database/entry.pcert0 : \
-     taspi/database/props.pcert0 \
-     taspi/database/entry.lisp
-taspi/database/entry.pcert1 : acl2x = 0
-taspi/database/entry.pcert1 : no_pcert = 0
-taspi/database/entry.pcert1 : taspi/database/entry.pcert0
-taspi/database/entry.cert : | taspi/database/entry.pcert1
-
-taspi/database/filters.pcert0 : no_pcert = 0
-taspi/database/filters.pcert0 : acl2x = 0
-taspi/database/filters.pcert0 : \
-     taspi/database/db.pcert0 \
-     taspi/database/filters.lisp
-taspi/database/filters.pcert1 : acl2x = 0
-taspi/database/filters.pcert1 : no_pcert = 0
-taspi/database/filters.pcert1 : taspi/database/filters.pcert0
-taspi/database/filters.cert : | taspi/database/filters.pcert1
-
-taspi/database/props.pcert0 : no_pcert = 0
-taspi/database/props.pcert0 : acl2x = 0
-taspi/database/props.pcert0 : \
-     misc/hons-help2.pcert0 \
-     taspi/code/gen-trees/sets-lists-trees.pcert0 \
-     taspi/code/gen-trees/app-rev-lists.pcert0 \
-     taspi/code/tree-manip/sort-help.pcert0 \
-     taspi/database/props.lisp
-taspi/database/props.pcert1 : acl2x = 0
-taspi/database/props.pcert1 : no_pcert = 0
-taspi/database/props.pcert1 : taspi/database/props.pcert0
-taspi/database/props.cert : | taspi/database/props.pcert1
-
-taspi/proofs/fringes-taspi.pcert0 : no_pcert = 0
-taspi/proofs/fringes-taspi.pcert0 : acl2x = 0
-taspi/proofs/fringes-taspi.pcert0 : \
-     taspi/proofs/omerge-good-order.pcert0 \
-     taspi/proofs/fringes-taspi.lisp \
-     taspi/proofs/fringes-taspi.acl2
-taspi/proofs/fringes-taspi.pcert1 : acl2x = 0
-taspi/proofs/fringes-taspi.pcert1 : no_pcert = 0
-taspi/proofs/fringes-taspi.pcert1 : taspi/proofs/fringes-taspi.pcert0
-taspi/proofs/fringes-taspi.cert : | taspi/proofs/fringes-taspi.pcert1
-
-taspi/proofs/omerge-good-order.pcert0 : no_pcert = 0
-taspi/proofs/omerge-good-order.pcert0 : acl2x = 0
-taspi/proofs/omerge-good-order.pcert0 : \
-     taspi/proofs/sets.pcert0 \
-     taspi/proofs/omerge-good-order.lisp \
-     taspi/proofs/omerge-good-order.acl2
-taspi/proofs/omerge-good-order.pcert1 : acl2x = 0
-taspi/proofs/omerge-good-order.pcert1 : no_pcert = 0
-taspi/proofs/omerge-good-order.pcert1 : taspi/proofs/omerge-good-order.pcert0
-taspi/proofs/omerge-good-order.cert : | taspi/proofs/omerge-good-order.pcert1
-
-taspi/proofs/sets.pcert0 : no_pcert = 0
-taspi/proofs/sets.pcert0 : acl2x = 0
-taspi/proofs/sets.pcert0 : \
-     taspi/proofs/sets.lisp \
-     taspi/proofs/sets.acl2
-taspi/proofs/sets.pcert1 : acl2x = 0
-taspi/proofs/sets.pcert1 : no_pcert = 0
-taspi/proofs/sets.pcert1 : taspi/proofs/sets.pcert0
-taspi/proofs/sets.cert : | taspi/proofs/sets.pcert1
-
-taspi/sets-input/consensus.pcert0 : no_pcert = 0
-taspi/sets-input/consensus.pcert0 : acl2x = 0
-taspi/sets-input/consensus.pcert0 : \
-     taspi/code/build/build-term-guards.pcert0 \
-     taspi/code/gen-trees/btrees-bdds.pcert0 \
-     taspi/sets-input/consensus.lisp
-taspi/sets-input/consensus.pcert1 : acl2x = 0
-taspi/sets-input/consensus.pcert1 : no_pcert = 0
-taspi/sets-input/consensus.pcert1 : taspi/sets-input/consensus.pcert0
-taspi/sets-input/consensus.cert : | taspi/sets-input/consensus.pcert1
-
-taspi/sets-input/greedy.pcert0 : no_pcert = 0
-taspi/sets-input/greedy.pcert0 : acl2x = 0
-taspi/sets-input/greedy.pcert0 : \
-     taspi/sets-input/consensus.pcert0 \
-     taspi/sets-input/greedy.lisp
-taspi/sets-input/greedy.pcert1 : acl2x = 0
-taspi/sets-input/greedy.pcert1 : no_pcert = 0
-taspi/sets-input/greedy.pcert1 : taspi/sets-input/greedy.pcert0
-taspi/sets-input/greedy.cert : | taspi/sets-input/greedy.pcert1
-
-taspi/sets-input/mast.pcert0 : no_pcert = 0
-taspi/sets-input/mast.pcert0 : acl2x = 0
-taspi/sets-input/mast.pcert0 : \
-     taspi/single-input/taxa-based.pcert0 \
-     taspi/sets-input/mast.lisp
-taspi/sets-input/mast.pcert1 : acl2x = 0
-taspi/sets-input/mast.pcert1 : no_pcert = 0
-taspi/sets-input/mast.pcert1 : taspi/sets-input/mast.pcert0
-taspi/sets-input/mast.cert : | taspi/sets-input/mast.pcert1
-
-taspi/sets-input/mct.pcert0 : no_pcert = 0
-taspi/sets-input/mct.pcert0 : acl2x = 0
-taspi/sets-input/mct.pcert0 : \
-     taspi/sets-input/mast.pcert0 \
-     taspi/code/build/build-term-guards.pcert0 \
-     taspi/sets-input/mct.lisp
-taspi/sets-input/mct.pcert1 : acl2x = 0
-taspi/sets-input/mct.pcert1 : no_pcert = 0
-taspi/sets-input/mct.pcert1 : taspi/sets-input/mct.pcert0
-taspi/sets-input/mct.cert : | taspi/sets-input/mct.pcert1
-
-taspi/sets-input/multipolar-loose.pcert0 : no_pcert = 0
-taspi/sets-input/multipolar-loose.pcert0 : acl2x = 0
-taspi/sets-input/multipolar-loose.pcert0 : \
-     taspi/sets-input/consensus.pcert0 \
-     taspi/sets-input/multipolar-loose.lisp
-taspi/sets-input/multipolar-loose.pcert1 : acl2x = 0
-taspi/sets-input/multipolar-loose.pcert1 : no_pcert = 0
-taspi/sets-input/multipolar-loose.pcert1 : taspi/sets-input/multipolar-loose.pcert0
-taspi/sets-input/multipolar-loose.cert : | taspi/sets-input/multipolar-loose.pcert1
-
-taspi/sets-input/top.pcert0 : no_pcert = 0
-taspi/sets-input/top.pcert0 : acl2x = 0
-taspi/sets-input/top.pcert0 : \
-     taspi/sets-input/consensus.pcert0 \
-     taspi/sets-input/tree-compat.pcert0 \
-     taspi/sets-input/tree-support-in-set.pcert0 \
-     taspi/sets-input/mast.pcert0 \
-     taspi/sets-input/multipolar-loose.pcert0 \
-     taspi/sets-input/greedy.pcert0 \
-     taspi/sets-input/mct.pcert0 \
-     taspi/sets-input/top.lisp
-taspi/sets-input/top.pcert1 : acl2x = 0
-taspi/sets-input/top.pcert1 : no_pcert = 0
-taspi/sets-input/top.pcert1 : taspi/sets-input/top.pcert0
-taspi/sets-input/top.cert : | taspi/sets-input/top.pcert1
-
-taspi/sets-input/tree-compat.pcert0 : no_pcert = 0
-taspi/sets-input/tree-compat.pcert0 : acl2x = 0
-taspi/sets-input/tree-compat.pcert0 : \
-     taspi/code/build/build-term-guards.pcert0 \
-     taspi/code/gen-trees/btrees-bdds.pcert0 \
-     taspi/code/fringes/fringes-props.pcert0 \
-     taspi/sets-input/tree-compat.lisp
-taspi/sets-input/tree-compat.pcert1 : acl2x = 0
-taspi/sets-input/tree-compat.pcert1 : no_pcert = 0
-taspi/sets-input/tree-compat.pcert1 : taspi/sets-input/tree-compat.pcert0
-taspi/sets-input/tree-compat.cert : | taspi/sets-input/tree-compat.pcert1
-
-taspi/sets-input/tree-support-in-set.pcert0 : no_pcert = 0
-taspi/sets-input/tree-support-in-set.pcert0 : acl2x = 0
-taspi/sets-input/tree-support-in-set.pcert0 : \
-     taspi/code/build/build-term-guards.pcert0 \
-     taspi/sets-input/tree-support-in-set.lisp
-taspi/sets-input/tree-support-in-set.pcert1 : acl2x = 0
-taspi/sets-input/tree-support-in-set.pcert1 : no_pcert = 0
-taspi/sets-input/tree-support-in-set.pcert1 : taspi/sets-input/tree-support-in-set.pcert0
-taspi/sets-input/tree-support-in-set.cert : | taspi/sets-input/tree-support-in-set.pcert1
-
-taspi/single-input/taxa-based.pcert0 : no_pcert = 0
-taspi/single-input/taxa-based.pcert0 : acl2x = 0
-taspi/single-input/taxa-based.pcert0 : \
-     taspi/code/fringes/fringes-guards.pcert0 \
-     taspi/code/tree-manip/merge-based-sort.pcert0 \
-     taspi/code/tree-manip/mv-root.pcert0 \
-     taspi/single-input/taxa-based.lisp
-taspi/single-input/taxa-based.pcert1 : acl2x = 0
-taspi/single-input/taxa-based.pcert1 : no_pcert = 0
-taspi/single-input/taxa-based.pcert1 : taspi/single-input/taxa-based.pcert0
-taspi/single-input/taxa-based.cert : | taspi/single-input/taxa-based.pcert1
-
-taspi/single-input/tree-stats.pcert0 : no_pcert = 0
-taspi/single-input/tree-stats.pcert0 : acl2x = 0
-taspi/single-input/tree-stats.pcert0 : \
-     taspi/code/gen-trees/sets-lists-trees.pcert0 \
-     taspi/single-input/taxa-based.pcert0 \
-     taspi/single-input/tree-stats.lisp
-taspi/single-input/tree-stats.pcert1 : acl2x = 0
-taspi/single-input/tree-stats.pcert1 : no_pcert = 0
-taspi/single-input/tree-stats.pcert1 : taspi/single-input/tree-stats.pcert0
-taspi/single-input/tree-stats.cert : | taspi/single-input/tree-stats.pcert1
-
-taspi/tree-distance/rf.pcert0 : no_pcert = 0
-taspi/tree-distance/rf.pcert0 : acl2x = 0
-taspi/tree-distance/rf.pcert0 : \
-     taspi/code/fringes/fringes-guards.pcert0 \
-     taspi/database/props.pcert0 \
-     taspi/tree-distance/rf.lisp
-taspi/tree-distance/rf.pcert1 : acl2x = 0
-taspi/tree-distance/rf.pcert1 : no_pcert = 0
-taspi/tree-distance/rf.pcert1 : taspi/tree-distance/rf.pcert0
-taspi/tree-distance/rf.cert : | taspi/tree-distance/rf.pcert1
-
-taspi/tree-distance/symm-diff.pcert0 : no_pcert = 0
-taspi/tree-distance/symm-diff.pcert0 : acl2x = 0
-taspi/tree-distance/symm-diff.pcert0 : \
-     taspi/code/fringes/fringes-guards.pcert0 \
-     taspi/database/props.pcert0 \
-     taspi/tree-distance/symm-diff.lisp
-taspi/tree-distance/symm-diff.pcert1 : acl2x = 0
-taspi/tree-distance/symm-diff.pcert1 : no_pcert = 0
-taspi/tree-distance/symm-diff.pcert1 : taspi/tree-distance/symm-diff.pcert0
-taspi/tree-distance/symm-diff.cert : | taspi/tree-distance/symm-diff.pcert1
-
-taspi/tree-generation/branch-and-bound/bandb.pcert0 : no_pcert = 0
-taspi/tree-generation/branch-and-bound/bandb.pcert0 : acl2x = 0
-taspi/tree-generation/branch-and-bound/bandb.pcert0 : \
-     taspi/tree-generation/tree-gen-helper/basics.pcert0 \
-     taspi/code/tree-manip/top.pcert0 \
-     taspi/tree-generation/branch-and-bound/bandb.lisp
-taspi/tree-generation/branch-and-bound/bandb.pcert1 : acl2x = 0
-taspi/tree-generation/branch-and-bound/bandb.pcert1 : no_pcert = 0
-taspi/tree-generation/branch-and-bound/bandb.pcert1 : taspi/tree-generation/branch-and-bound/bandb.pcert0
-taspi/tree-generation/branch-and-bound/bandb.cert : | taspi/tree-generation/branch-and-bound/bandb.pcert1
-
-taspi/tree-generation/distance-based/naive-quartet-method.pcert0 : no_pcert = 0
-taspi/tree-generation/distance-based/naive-quartet-method.pcert0 : acl2x = 0
-taspi/tree-generation/distance-based/naive-quartet-method.pcert0 : \
-     taspi/tree-generation/distance-based/naive-quartet-method.lisp
-taspi/tree-generation/distance-based/naive-quartet-method.pcert1 : acl2x = 0
-taspi/tree-generation/distance-based/naive-quartet-method.pcert1 : no_pcert = 0
-taspi/tree-generation/distance-based/naive-quartet-method.pcert1 : taspi/tree-generation/distance-based/naive-quartet-method.pcert0
-taspi/tree-generation/distance-based/naive-quartet-method.cert : | taspi/tree-generation/distance-based/naive-quartet-method.pcert1
-
-taspi/tree-generation/heuristics/do-search.pcert0 : no_pcert = 0
-taspi/tree-generation/heuristics/do-search.pcert0 : acl2x = 0
-taspi/tree-generation/heuristics/do-search.pcert0 : \
-     taspi/tree-generation/heuristics/tbr.pcert0 \
-     taspi/tree-generation/heuristics/do-search.lisp
-taspi/tree-generation/heuristics/do-search.pcert1 : acl2x = 0
-taspi/tree-generation/heuristics/do-search.pcert1 : no_pcert = 0
-taspi/tree-generation/heuristics/do-search.pcert1 : taspi/tree-generation/heuristics/do-search.pcert0
-taspi/tree-generation/heuristics/do-search.cert : | taspi/tree-generation/heuristics/do-search.pcert1
-
-taspi/tree-generation/heuristics/spr.pcert0 : no_pcert = 0
-taspi/tree-generation/heuristics/spr.pcert0 : acl2x = 0
-taspi/tree-generation/heuristics/spr.pcert0 : \
-     taspi/tree-generation/tree-gen-helper/basics.pcert0 \
-     taspi/code/tree-manip/top.pcert0 \
-     taspi/tree-generation/heuristics/spr.lisp
-taspi/tree-generation/heuristics/spr.pcert1 : acl2x = 0
-taspi/tree-generation/heuristics/spr.pcert1 : no_pcert = 0
-taspi/tree-generation/heuristics/spr.pcert1 : taspi/tree-generation/heuristics/spr.pcert0
-taspi/tree-generation/heuristics/spr.cert : | taspi/tree-generation/heuristics/spr.pcert1
-
-taspi/tree-generation/heuristics/tbr.pcert0 : no_pcert = 0
-taspi/tree-generation/heuristics/tbr.pcert0 : acl2x = 0
-taspi/tree-generation/heuristics/tbr.pcert0 : \
-     taspi/tree-generation/heuristics/spr.pcert0 \
-     taspi/tree-generation/heuristics/tbr.lisp
-taspi/tree-generation/heuristics/tbr.pcert1 : acl2x = 0
-taspi/tree-generation/heuristics/tbr.pcert1 : no_pcert = 0
-taspi/tree-generation/heuristics/tbr.pcert1 : taspi/tree-generation/heuristics/tbr.pcert0
-taspi/tree-generation/heuristics/tbr.cert : | taspi/tree-generation/heuristics/tbr.pcert1
-
-taspi/tree-generation/tree-gen-helper/basics.pcert0 : no_pcert = 0
-taspi/tree-generation/tree-gen-helper/basics.pcert0 : acl2x = 0
-taspi/tree-generation/tree-gen-helper/basics.pcert0 : \
-     taspi/code/build/build-term-guards.pcert0 \
-     taspi/tree-score/pscores.pcert0 \
-     taspi/tree-generation/tree-gen-helper/basics.lisp
-taspi/tree-generation/tree-gen-helper/basics.pcert1 : acl2x = 0
-taspi/tree-generation/tree-gen-helper/basics.pcert1 : no_pcert = 0
-taspi/tree-generation/tree-gen-helper/basics.pcert1 : taspi/tree-generation/tree-gen-helper/basics.pcert0
-taspi/tree-generation/tree-gen-helper/basics.cert : | taspi/tree-generation/tree-gen-helper/basics.pcert1
-
-taspi/tree-score/ambig-score.pcert0 : no_pcert = 0
-taspi/tree-score/ambig-score.pcert0 : acl2x = 0
-taspi/tree-score/ambig-score.pcert0 : \
-     taspi/tree-score/min-length.pcert0 \
-     taspi/tree-score/ambig-score.lisp
-taspi/tree-score/ambig-score.pcert1 : acl2x = 0
-taspi/tree-score/ambig-score.pcert1 : no_pcert = 0
-taspi/tree-score/ambig-score.pcert1 : taspi/tree-score/ambig-score.pcert0
-taspi/tree-score/ambig-score.cert : | taspi/tree-score/ambig-score.pcert1
-
-taspi/tree-score/circle-scoring.pcert0 : no_pcert = 0
-taspi/tree-score/circle-scoring.pcert0 : acl2x = 0
-taspi/tree-score/circle-scoring.pcert0 : \
-     taspi/tree-score/min-length.pcert0 \
-     taspi/code/gen-trees/top.pcert0 \
-     taspi/tree-score/circle-scoring.lisp
-taspi/tree-score/circle-scoring.pcert1 : acl2x = 0
-taspi/tree-score/circle-scoring.pcert1 : no_pcert = 0
-taspi/tree-score/circle-scoring.pcert1 : taspi/tree-score/circle-scoring.pcert0
-taspi/tree-score/circle-scoring.cert : | taspi/tree-score/circle-scoring.pcert1
-
-taspi/tree-score/costs.pcert0 : no_pcert = 0
-taspi/tree-score/costs.pcert0 : acl2x = 0
-taspi/tree-score/costs.pcert0 : \
-     taspi/code/sequences/seqs.pcert0 \
-     taspi/tree-score/costs.lisp
-taspi/tree-score/costs.pcert1 : acl2x = 0
-taspi/tree-score/costs.pcert1 : no_pcert = 0
-taspi/tree-score/costs.pcert1 : taspi/tree-score/costs.pcert0
-taspi/tree-score/costs.cert : | taspi/tree-score/costs.pcert1
-
-taspi/tree-score/efficient-pscores-help.pcert0 : no_pcert = 0
-taspi/tree-score/efficient-pscores-help.pcert0 : acl2x = 0
-taspi/tree-score/efficient-pscores-help.pcert0 : \
-     taspi/tree-score/efficient-pscores-help.lisp
-taspi/tree-score/efficient-pscores-help.pcert1 : acl2x = 0
-taspi/tree-score/efficient-pscores-help.pcert1 : no_pcert = 0
-taspi/tree-score/efficient-pscores-help.pcert1 : taspi/tree-score/efficient-pscores-help.pcert0
-taspi/tree-score/efficient-pscores-help.cert : | taspi/tree-score/efficient-pscores-help.pcert1
-
-taspi/tree-score/efficient-pscores.pcert0 : no_pcert = 0
-taspi/tree-score/efficient-pscores.pcert0 : acl2x = 0
-taspi/tree-score/efficient-pscores.pcert0 : \
-     taspi/code/gen-helper/extra.pcert0 \
-     taspi/tree-score/efficient-pscores-help.pcert0 \
-     taspi/tree-score/efficient-pscores.lisp
-taspi/tree-score/efficient-pscores.pcert1 : acl2x = 0
-taspi/tree-score/efficient-pscores.pcert1 : no_pcert = 0
-taspi/tree-score/efficient-pscores.pcert1 : taspi/tree-score/efficient-pscores.pcert0
-taspi/tree-score/efficient-pscores.cert : | taspi/tree-score/efficient-pscores.pcert1
-
-taspi/tree-score/fitch-scoring.pcert0 : no_pcert = 0
-taspi/tree-score/fitch-scoring.pcert0 : acl2x = 0
-taspi/tree-score/fitch-scoring.pcert0 : \
-     taspi/tree-score/costs.pcert0 \
-     taspi/tree-score/fitch-scoring.lisp
-taspi/tree-score/fitch-scoring.pcert1 : acl2x = 0
-taspi/tree-score/fitch-scoring.pcert1 : no_pcert = 0
-taspi/tree-score/fitch-scoring.pcert1 : taspi/tree-score/fitch-scoring.pcert0
-taspi/tree-score/fitch-scoring.cert : | taspi/tree-score/fitch-scoring.pcert1
-
-taspi/tree-score/min-length.pcert0 : no_pcert = 0
-taspi/tree-score/min-length.pcert0 : acl2x = 0
-taspi/tree-score/min-length.pcert0 : \
-     taspi/tree-score/efficient-pscores.pcert0 \
-     taspi/code/gen-helper/sets.pcert0 \
-     taspi/tree-score/min-length.lisp
-taspi/tree-score/min-length.pcert1 : acl2x = 0
-taspi/tree-score/min-length.pcert1 : no_pcert = 0
-taspi/tree-score/min-length.pcert1 : taspi/tree-score/min-length.pcert0
-taspi/tree-score/min-length.cert : | taspi/tree-score/min-length.pcert1
-
-taspi/tree-score/opt-pairwise.pcert0 : no_pcert = 0
-taspi/tree-score/opt-pairwise.pcert0 : acl2x = 0
-taspi/tree-score/opt-pairwise.pcert0 : \
-     taspi/code/sequences/align.pcert0 \
-     taspi/code/gen-helper/extra.pcert0 \
-     taspi/tree-score/opt-pairwise.lisp
-taspi/tree-score/opt-pairwise.pcert1 : acl2x = 0
-taspi/tree-score/opt-pairwise.pcert1 : no_pcert = 0
-taspi/tree-score/opt-pairwise.pcert1 : taspi/tree-score/opt-pairwise.pcert0
-taspi/tree-score/opt-pairwise.cert : | taspi/tree-score/opt-pairwise.pcert1
-
-taspi/tree-score/pscores.pcert0 : no_pcert = 0
-taspi/tree-score/pscores.pcert0 : acl2x = 0
-taspi/tree-score/pscores.pcert0 : \
-     taspi/tree-score/costs.pcert0 \
-     taspi/tree-score/pscores.lisp
-taspi/tree-score/pscores.pcert1 : acl2x = 0
-taspi/tree-score/pscores.pcert1 : no_pcert = 0
-taspi/tree-score/pscores.pcert1 : taspi/tree-score/pscores.pcert0
-taspi/tree-score/pscores.cert : | taspi/tree-score/pscores.pcert1
-
-tau/bounders/elementary-bounders.pcert0 : no_pcert = 0
-tau/bounders/elementary-bounders.pcert0 : acl2x = 0
-tau/bounders/elementary-bounders.pcert0 : \
-     arithmetic-5/top.pcert0 \
-     tau/bounders/find-minimal-2d.pcert0 \
-     tau/bounders/find-maximal-2d.pcert0 \
-     tau/bounders/elementary-bounders.lisp
-tau/bounders/elementary-bounders.pcert1 : acl2x = 0
-tau/bounders/elementary-bounders.pcert1 : no_pcert = 0
-tau/bounders/elementary-bounders.pcert1 : tau/bounders/elementary-bounders.pcert0
-tau/bounders/elementary-bounders.cert : | tau/bounders/elementary-bounders.pcert1
-
-tau/bounders/find-maximal-1d.pcert0 : no_pcert = 0
-tau/bounders/find-maximal-1d.pcert0 : acl2x = 0
-tau/bounders/find-maximal-1d.pcert0 : \
-     tau/bounders/find-maximal-1d.lisp
-tau/bounders/find-maximal-1d.pcert1 : acl2x = 0
-tau/bounders/find-maximal-1d.pcert1 : no_pcert = 0
-tau/bounders/find-maximal-1d.pcert1 : tau/bounders/find-maximal-1d.pcert0
-tau/bounders/find-maximal-1d.cert : | tau/bounders/find-maximal-1d.pcert1
-
-tau/bounders/find-maximal-2d.pcert0 : no_pcert = 0
-tau/bounders/find-maximal-2d.pcert0 : acl2x = 0
-tau/bounders/find-maximal-2d.pcert0 : \
-     tau/bounders/find-maximal-2d.lisp
-tau/bounders/find-maximal-2d.pcert1 : acl2x = 0
-tau/bounders/find-maximal-2d.pcert1 : no_pcert = 0
-tau/bounders/find-maximal-2d.pcert1 : tau/bounders/find-maximal-2d.pcert0
-tau/bounders/find-maximal-2d.cert : | tau/bounders/find-maximal-2d.pcert1
-
-tau/bounders/find-minimal-1d.pcert0 : no_pcert = 0
-tau/bounders/find-minimal-1d.pcert0 : acl2x = 0
-tau/bounders/find-minimal-1d.pcert0 : \
-     tau/bounders/find-minimal-1d.lisp
-tau/bounders/find-minimal-1d.pcert1 : acl2x = 0
-tau/bounders/find-minimal-1d.pcert1 : no_pcert = 0
-tau/bounders/find-minimal-1d.pcert1 : tau/bounders/find-minimal-1d.pcert0
-tau/bounders/find-minimal-1d.cert : | tau/bounders/find-minimal-1d.pcert1
-
-tau/bounders/find-minimal-2d.pcert0 : no_pcert = 0
-tau/bounders/find-minimal-2d.pcert0 : acl2x = 0
-tau/bounders/find-minimal-2d.pcert0 : \
-     tau/bounders/find-minimal-2d.lisp
-tau/bounders/find-minimal-2d.pcert1 : acl2x = 0
-tau/bounders/find-minimal-2d.pcert1 : no_pcert = 0
-tau/bounders/find-minimal-2d.pcert1 : tau/bounders/find-minimal-2d.pcert0
-tau/bounders/find-minimal-2d.cert : | tau/bounders/find-minimal-2d.pcert1
-
-textbook/chap10/ac-example.pcert0 : no_pcert = 0
-textbook/chap10/ac-example.pcert0 : acl2x = 0
-textbook/chap10/ac-example.pcert0 : \
-     textbook/chap10/ac-example.lisp
-textbook/chap10/ac-example.pcert1 : acl2x = 0
-textbook/chap10/ac-example.pcert1 : no_pcert = 0
-textbook/chap10/ac-example.pcert1 : textbook/chap10/ac-example.pcert0
-textbook/chap10/ac-example.cert : | textbook/chap10/ac-example.pcert1
-
-textbook/chap10/adder.pcert0 : no_pcert = 0
-textbook/chap10/adder.pcert0 : acl2x = 0
-textbook/chap10/adder.pcert0 : \
-     textbook/chap10/adder.lisp
-textbook/chap10/adder.pcert1 : acl2x = 0
-textbook/chap10/adder.pcert1 : no_pcert = 0
-textbook/chap10/adder.pcert1 : textbook/chap10/adder.pcert0
-textbook/chap10/adder.cert : | textbook/chap10/adder.pcert1
-
-textbook/chap10/compiler.pcert0 : no_pcert = 0
-textbook/chap10/compiler.pcert0 : acl2x = 0
-textbook/chap10/compiler.pcert0 : \
-     textbook/chap10/compiler.lisp \
-     textbook/chap10/compiler.acl2
-textbook/chap10/compiler.pcert1 : acl2x = 0
-textbook/chap10/compiler.pcert1 : no_pcert = 0
-textbook/chap10/compiler.pcert1 : textbook/chap10/compiler.pcert0
-textbook/chap10/compiler.cert : | textbook/chap10/compiler.pcert1
-
-textbook/chap10/fact.pcert0 : no_pcert = 0
-textbook/chap10/fact.pcert0 : acl2x = 0
-textbook/chap10/fact.pcert0 : \
-     textbook/chap10/fact.lisp
-textbook/chap10/fact.pcert1 : acl2x = 0
-textbook/chap10/fact.pcert1 : no_pcert = 0
-textbook/chap10/fact.pcert1 : textbook/chap10/fact.pcert0
-textbook/chap10/fact.cert : | textbook/chap10/fact.pcert1
-
-textbook/chap10/insertion-sort.pcert0 : no_pcert = 0
-textbook/chap10/insertion-sort.pcert0 : acl2x = 0
-textbook/chap10/insertion-sort.pcert0 : \
-     textbook/chap10/insertion-sort.lisp
-textbook/chap10/insertion-sort.pcert1 : acl2x = 0
-textbook/chap10/insertion-sort.pcert1 : no_pcert = 0
-textbook/chap10/insertion-sort.pcert1 : textbook/chap10/insertion-sort.pcert0
-textbook/chap10/insertion-sort.cert : | textbook/chap10/insertion-sort.pcert1
-
-textbook/chap10/tree.pcert0 : no_pcert = 0
-textbook/chap10/tree.pcert0 : acl2x = 0
-textbook/chap10/tree.pcert0 : \
-     textbook/chap10/tree.lisp
-textbook/chap10/tree.pcert1 : acl2x = 0
-textbook/chap10/tree.pcert1 : no_pcert = 0
-textbook/chap10/tree.pcert1 : textbook/chap10/tree.pcert0
-textbook/chap10/tree.cert : | textbook/chap10/tree.pcert1
-
-textbook/chap11/compress.pcert0 : no_pcert = 0
-textbook/chap11/compress.pcert0 : acl2x = 0
-textbook/chap11/compress.pcert0 : \
-     textbook/chap11/compress.lisp
-textbook/chap11/compress.pcert1 : acl2x = 0
-textbook/chap11/compress.pcert1 : no_pcert = 0
-textbook/chap11/compress.pcert1 : textbook/chap11/compress.pcert0
-textbook/chap11/compress.cert : | textbook/chap11/compress.pcert1
-
-textbook/chap11/encap.pcert0 : no_pcert = 0
-textbook/chap11/encap.pcert0 : acl2x = 0
-textbook/chap11/encap.pcert0 : \
-     textbook/chap10/ac-example.pcert0 \
-     textbook/chap11/encap.lisp
-textbook/chap11/encap.pcert1 : acl2x = 0
-textbook/chap11/encap.pcert1 : no_pcert = 0
-textbook/chap11/encap.pcert1 : textbook/chap11/encap.pcert0
-textbook/chap11/encap.cert : | textbook/chap11/encap.pcert1
-
-textbook/chap11/finite-sets.pcert0 : no_pcert = 0
-textbook/chap11/finite-sets.pcert0 : acl2x = 0
-textbook/chap11/finite-sets.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     textbook/chap11/finite-sets.lisp
-textbook/chap11/finite-sets.pcert1 : acl2x = 0
-textbook/chap11/finite-sets.pcert1 : no_pcert = 0
-textbook/chap11/finite-sets.pcert1 : textbook/chap11/finite-sets.pcert0
-textbook/chap11/finite-sets.cert : | textbook/chap11/finite-sets.pcert1
-
-textbook/chap11/how-many-soln1.pcert0 : no_pcert = 0
-textbook/chap11/how-many-soln1.pcert0 : acl2x = 0
-textbook/chap11/how-many-soln1.pcert0 : \
-     textbook/chap11/perm.pcert0 \
-     arithmetic/top.pcert0 \
-     textbook/chap11/how-many-soln1.lisp
-textbook/chap11/how-many-soln1.pcert1 : acl2x = 0
-textbook/chap11/how-many-soln1.pcert1 : no_pcert = 0
-textbook/chap11/how-many-soln1.pcert1 : textbook/chap11/how-many-soln1.pcert0
-textbook/chap11/how-many-soln1.cert : | textbook/chap11/how-many-soln1.pcert1
-
-textbook/chap11/how-many-soln2.pcert0 : no_pcert = 0
-textbook/chap11/how-many-soln2.pcert0 : acl2x = 0
-textbook/chap11/how-many-soln2.pcert0 : \
-     textbook/chap11/perm.pcert0 \
-     textbook/chap11/how-many-soln2.lisp
-textbook/chap11/how-many-soln2.pcert1 : acl2x = 0
-textbook/chap11/how-many-soln2.pcert1 : no_pcert = 0
-textbook/chap11/how-many-soln2.pcert1 : textbook/chap11/how-many-soln2.pcert0
-textbook/chap11/how-many-soln2.cert : | textbook/chap11/how-many-soln2.pcert1
-
-textbook/chap11/mergesort.pcert0 : no_pcert = 0
-textbook/chap11/mergesort.pcert0 : acl2x = 0
-textbook/chap11/mergesort.pcert0 : \
-     textbook/chap11/perm.pcert0 \
-     textbook/chap11/perm-append.pcert0 \
-     textbook/chap11/mergesort.lisp
-textbook/chap11/mergesort.pcert1 : acl2x = 0
-textbook/chap11/mergesort.pcert1 : no_pcert = 0
-textbook/chap11/mergesort.pcert1 : textbook/chap11/mergesort.pcert0
-textbook/chap11/mergesort.cert : | textbook/chap11/mergesort.pcert1
-
-textbook/chap11/perm-append.pcert0 : no_pcert = 0
-textbook/chap11/perm-append.pcert0 : acl2x = 0
-textbook/chap11/perm-append.pcert0 : \
-     textbook/chap11/perm.pcert0 \
-     textbook/chap11/perm-append.lisp
-textbook/chap11/perm-append.pcert1 : acl2x = 0
-textbook/chap11/perm-append.pcert1 : no_pcert = 0
-textbook/chap11/perm-append.pcert1 : textbook/chap11/perm-append.pcert0
-textbook/chap11/perm-append.cert : | textbook/chap11/perm-append.pcert1
-
-textbook/chap11/perm.pcert0 : no_pcert = 0
-textbook/chap11/perm.pcert0 : acl2x = 0
-textbook/chap11/perm.pcert0 : \
-     textbook/chap11/perm.lisp
-textbook/chap11/perm.pcert1 : acl2x = 0
-textbook/chap11/perm.pcert1 : no_pcert = 0
-textbook/chap11/perm.pcert1 : textbook/chap11/perm.pcert0
-textbook/chap11/perm.cert : | textbook/chap11/perm.pcert1
-
-textbook/chap11/qsort.pcert0 : no_pcert = 0
-textbook/chap11/qsort.pcert0 : acl2x = 0
-textbook/chap11/qsort.pcert0 : \
-     textbook/chap11/perm-append.pcert0 \
-     textbook/chap11/qsort.lisp
-textbook/chap11/qsort.pcert1 : acl2x = 0
-textbook/chap11/qsort.pcert1 : no_pcert = 0
-textbook/chap11/qsort.pcert1 : textbook/chap11/qsort.pcert0
-textbook/chap11/qsort.cert : | textbook/chap11/qsort.pcert1
-
-textbook/chap11/starters.pcert0 : no_pcert = 0
-textbook/chap11/starters.pcert0 : acl2x = 0
-textbook/chap11/starters.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     textbook/chap11/starters.lisp
-textbook/chap11/starters.pcert1 : acl2x = 0
-textbook/chap11/starters.pcert1 : no_pcert = 0
-textbook/chap11/starters.pcert1 : textbook/chap11/starters.pcert0
-textbook/chap11/starters.cert : | textbook/chap11/starters.pcert1
-
-textbook/chap11/summations-book.pcert0 : no_pcert = 0
-textbook/chap11/summations-book.pcert0 : acl2x = 0
-textbook/chap11/summations-book.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     textbook/chap11/summations-book.lisp
-textbook/chap11/summations-book.pcert1 : acl2x = 0
-textbook/chap11/summations-book.pcert1 : no_pcert = 0
-textbook/chap11/summations-book.pcert1 : textbook/chap11/summations-book.pcert0
-textbook/chap11/summations-book.cert : | textbook/chap11/summations-book.pcert1
-
-textbook/chap11/summations.pcert0 : no_pcert = 0
-textbook/chap11/summations.pcert0 : acl2x = 0
-textbook/chap11/summations.pcert0 : \
-     textbook/chap10/ac-example.pcert0 \
-     textbook/chap11/summations.lisp
-textbook/chap11/summations.pcert1 : acl2x = 0
-textbook/chap11/summations.pcert1 : no_pcert = 0
-textbook/chap11/summations.pcert1 : textbook/chap11/summations.pcert0
-textbook/chap11/summations.cert : | textbook/chap11/summations.pcert1
-
-textbook/chap11/tautology.pcert0 : no_pcert = 0
-textbook/chap11/tautology.pcert0 : acl2x = 0
-textbook/chap11/tautology.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic/top.pcert0 \
-     textbook/chap11/tautology.lisp
-textbook/chap11/tautology.pcert1 : acl2x = 0
-textbook/chap11/tautology.pcert1 : no_pcert = 0
-textbook/chap11/tautology.pcert1 : textbook/chap11/tautology.pcert0
-textbook/chap11/tautology.cert : | textbook/chap11/tautology.pcert1
-
-textbook/chap11/xtr.pcert0 : no_pcert = 0
-textbook/chap11/xtr.pcert0 : acl2x = 0
-textbook/chap11/xtr.pcert0 : \
-     textbook/chap11/xtr.lisp
-textbook/chap11/xtr.pcert1 : acl2x = 0
-textbook/chap11/xtr.pcert1 : no_pcert = 0
-textbook/chap11/xtr.pcert1 : textbook/chap11/xtr.pcert0
-textbook/chap11/xtr.cert : | textbook/chap11/xtr.pcert1
-
-textbook/chap11/xtr2.pcert0 : no_pcert = 0
-textbook/chap11/xtr2.pcert0 : acl2x = 0
-textbook/chap11/xtr2.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     textbook/chap11/xtr2.lisp
-textbook/chap11/xtr2.pcert1 : acl2x = 0
-textbook/chap11/xtr2.pcert1 : no_pcert = 0
-textbook/chap11/xtr2.pcert1 : textbook/chap11/xtr2.pcert0
-textbook/chap11/xtr2.cert : | textbook/chap11/xtr2.pcert1
-
-textbook/chap3/programs.pcert0 : no_pcert = 0
-textbook/chap3/programs.pcert0 : acl2x = 0
-textbook/chap3/programs.pcert0 : \
-     textbook/chap3/programs.lisp
-textbook/chap3/programs.pcert1 : acl2x = 0
-textbook/chap3/programs.pcert1 : no_pcert = 0
-textbook/chap3/programs.pcert1 : textbook/chap3/programs.pcert0
-textbook/chap3/programs.cert : | textbook/chap3/programs.pcert1
-
-textbook/chap4/solutions-logic-mode.pcert0 : no_pcert = 0
-textbook/chap4/solutions-logic-mode.pcert0 : acl2x = 0
-textbook/chap4/solutions-logic-mode.pcert0 : \
-     ihs/ihs-lemmas.pcert0 \
-     textbook/chap4/solutions-logic-mode.lisp
-textbook/chap4/solutions-logic-mode.pcert1 : acl2x = 0
-textbook/chap4/solutions-logic-mode.pcert1 : no_pcert = 0
-textbook/chap4/solutions-logic-mode.pcert1 : textbook/chap4/solutions-logic-mode.pcert0
-textbook/chap4/solutions-logic-mode.cert : | textbook/chap4/solutions-logic-mode.pcert1
-
-textbook/chap4/solutions-program-mode.pcert0 : no_pcert = 0
-textbook/chap4/solutions-program-mode.pcert0 : acl2x = 0
-textbook/chap4/solutions-program-mode.pcert0 : \
-     textbook/chap4/solutions-program-mode.lisp
-textbook/chap4/solutions-program-mode.pcert1 : acl2x = 0
-textbook/chap4/solutions-program-mode.pcert1 : no_pcert = 0
-textbook/chap4/solutions-program-mode.pcert1 : textbook/chap4/solutions-program-mode.pcert0
-textbook/chap4/solutions-program-mode.cert : | textbook/chap4/solutions-program-mode.pcert1
-
-textbook/chap5/solutions.pcert0 : no_pcert = 0
-textbook/chap5/solutions.pcert0 : acl2x = 0
-textbook/chap5/solutions.pcert0 : \
-     textbook/chap5/solutions.lisp
-textbook/chap5/solutions.pcert1 : acl2x = 0
-textbook/chap5/solutions.pcert1 : no_pcert = 0
-textbook/chap5/solutions.pcert1 : textbook/chap5/solutions.pcert0
-textbook/chap5/solutions.cert : | textbook/chap5/solutions.pcert1
-
-textbook/chap6/selected-solutions.pcert0 : no_pcert = 0
-textbook/chap6/selected-solutions.pcert0 : acl2x = 0
-textbook/chap6/selected-solutions.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     textbook/chap6/selected-solutions.lisp
-textbook/chap6/selected-solutions.pcert1 : acl2x = 0
-textbook/chap6/selected-solutions.pcert1 : no_pcert = 0
-textbook/chap6/selected-solutions.pcert1 : textbook/chap6/selected-solutions.pcert0
-textbook/chap6/selected-solutions.cert : | textbook/chap6/selected-solutions.pcert1
-
-tools/bstar.pcert0 : no_pcert = 0
-tools/bstar.pcert0 : acl2x = 0
-tools/bstar.pcert0 : \
-     tools/pack.pcert0 \
-     tools/bstar.lisp
-tools/bstar.pcert1 : acl2x = 0
-tools/bstar.pcert1 : no_pcert = 0
-tools/bstar.pcert1 : tools/bstar.pcert0
-tools/bstar.cert : | tools/bstar.pcert1
-
-tools/case-splitting-rules.pcert0 : no_pcert = 0
-tools/case-splitting-rules.pcert0 : acl2x = 0
-tools/case-splitting-rules.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/case-splitting-rules.lisp
-tools/case-splitting-rules.pcert1 : acl2x = 0
-tools/case-splitting-rules.pcert1 : no_pcert = 0
-tools/case-splitting-rules.pcert1 : tools/case-splitting-rules.pcert0
-tools/case-splitting-rules.cert : | tools/case-splitting-rules.pcert1
-
-tools/clone-stobj.pcert0 : no_pcert = 0
-tools/clone-stobj.pcert0 : acl2x = 0
-tools/clone-stobj.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/rulesets.pcert0 \
-     tools/templates.pcert0 \
-     xdoc/top.pcert0 \
-     tools/clone-stobj.lisp
-tools/clone-stobj.pcert1 : acl2x = 0
-tools/clone-stobj.pcert1 : no_pcert = 0
-tools/clone-stobj.pcert1 : tools/clone-stobj.pcert0
-tools/clone-stobj.cert : | tools/clone-stobj.pcert1
-
-tools/cws.pcert0 : no_pcert = 0
-tools/cws.pcert0 : acl2x = 0
-tools/cws.pcert0 : \
-     tools/cws.lisp
-tools/cws.pcert1 : acl2x = 0
-tools/cws.pcert1 : no_pcert = 0
-tools/cws.pcert1 : tools/cws.pcert0
-tools/cws.cert : | tools/cws.pcert1
-
-tools/def-functional-instance.pcert0 : no_pcert = 0
-tools/def-functional-instance.pcert0 : acl2x = 0
-tools/def-functional-instance.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/def-functional-instance.lisp
-tools/def-functional-instance.pcert1 : acl2x = 0
-tools/def-functional-instance.pcert1 : no_pcert = 0
-tools/def-functional-instance.pcert1 : tools/def-functional-instance.pcert0
-tools/def-functional-instance.cert : | tools/def-functional-instance.pcert1
-
-tools/defconsts.pcert0 : no_pcert = 0
-tools/defconsts.pcert0 : acl2x = 0
-tools/defconsts.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/defconsts.lisp
-tools/defconsts.pcert1 : acl2x = 0
-tools/defconsts.pcert1 : no_pcert = 0
-tools/defconsts.pcert1 : tools/defconsts.pcert0
-tools/defconsts.cert : | tools/defconsts.pcert1
-
-tools/defevaluator-fast.pcert0 : no_pcert = 0
-tools/defevaluator-fast.pcert0 : acl2x = 0
-tools/defevaluator-fast.pcert0 : \
-     tools/defevaluator-fast.lisp
-tools/defevaluator-fast.pcert1 : acl2x = 0
-tools/defevaluator-fast.pcert1 : no_pcert = 0
-tools/defevaluator-fast.pcert1 : tools/defevaluator-fast.pcert0
-tools/defevaluator-fast.cert : | tools/defevaluator-fast.pcert1
-
-tools/define-keyed-function.pcert0 : no_pcert = 0
-tools/define-keyed-function.pcert0 : acl2x = 0
-tools/define-keyed-function.pcert0 : \
-     tools/define-keyed-function.lisp
-tools/define-keyed-function.pcert1 : acl2x = 0
-tools/define-keyed-function.pcert1 : no_pcert = 0
-tools/define-keyed-function.pcert1 : tools/define-keyed-function.pcert0
-tools/define-keyed-function.cert : | tools/define-keyed-function.pcert1
-
-tools/defined-const.pcert0 : no_pcert = 0
-tools/defined-const.pcert0 : acl2x = 0
-tools/defined-const.pcert0 : \
-     tools/defined-const.lisp
-tools/defined-const.pcert1 : acl2x = 0
-tools/defined-const.pcert1 : no_pcert = 0
-tools/defined-const.pcert1 : tools/defined-const.pcert0
-tools/defined-const.cert : | tools/defined-const.pcert1
-
-tools/defmacfun.pcert0 : no_pcert = 0
-tools/defmacfun.pcert0 : acl2x = 0
-tools/defmacfun.pcert0 : \
-     tools/defmacfun.lisp
-tools/defmacfun.pcert1 : acl2x = 0
-tools/defmacfun.pcert1 : no_pcert = 0
-tools/defmacfun.pcert1 : tools/defmacfun.pcert0
-tools/defmacfun.cert : | tools/defmacfun.pcert1
-
-tools/defredundant.pcert0 : no_pcert = 0
-tools/defredundant.pcert0 : acl2x = 0
-tools/defredundant.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/defredundant.lisp
-tools/defredundant.pcert1 : acl2x = 0
-tools/defredundant.pcert1 : no_pcert = 0
-tools/defredundant.pcert1 : tools/defredundant.pcert0
-tools/defredundant.cert : | tools/defredundant.pcert1
-
-tools/defsum.pcert0 : no_pcert = 0
-tools/defsum.pcert0 : acl2x = 0
-tools/defsum.pcert0 : \
-     tools/pattern-match.pcert0 \
-     tools/types-misc.pcert0 \
-     tools/defsum.lisp
-tools/defsum.pcert1 : acl2x = 0
-tools/defsum.pcert1 : no_pcert = 0
-tools/defsum.pcert1 : tools/defsum.pcert0
-tools/defsum.cert : | tools/defsum.pcert1
-
-tools/deftuple.pcert0 : no_pcert = 0
-tools/deftuple.pcert0 : acl2x = 0
-tools/deftuple.pcert0 : \
-     tools/types-misc.pcert0 \
-     tools/bstar.pcert0 \
-     tools/deftuple.lisp
-tools/deftuple.pcert1 : acl2x = 0
-tools/deftuple.pcert1 : no_pcert = 0
-tools/deftuple.pcert1 : tools/deftuple.pcert0
-tools/deftuple.cert : | tools/deftuple.pcert1
-
-tools/do-not.pcert0 : no_pcert = 0
-tools/do-not.pcert0 : acl2x = 0
-tools/do-not.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/do-not.lisp
-tools/do-not.pcert1 : acl2x = 0
-tools/do-not.pcert1 : no_pcert = 0
-tools/do-not.pcert1 : tools/do-not.pcert0
-tools/do-not.cert : | tools/do-not.pcert1
-
-tools/easy-simplify.pcert0 : no_pcert = 0
-tools/easy-simplify.pcert0 : acl2x = 0
-tools/easy-simplify.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/easy-simplify.lisp
-tools/easy-simplify.pcert1 : acl2x = 0
-tools/easy-simplify.pcert1 : no_pcert = 0
-tools/easy-simplify.pcert1 : tools/easy-simplify.pcert0
-tools/easy-simplify.cert : | tools/easy-simplify.pcert1
-
-tools/fake-event.pcert0 : no_pcert = 0
-tools/fake-event.pcert0 : acl2x = 0
-tools/fake-event.pcert0 : \
-     tools/fake-event.lisp
-tools/fake-event.pcert1 : acl2x = 0
-tools/fake-event.pcert1 : no_pcert = 0
-tools/fake-event.pcert1 : tools/fake-event.pcert0
-tools/fake-event.cert : | tools/fake-event.pcert1
-
-tools/flag.pcert0 : no_pcert = 0
-tools/flag.pcert0 : acl2x = 0
-tools/flag.pcert0 : \
-     xdoc/top.pcert0 \
-     tools/flag.lisp \
-     tools/flag.acl2 \
-     tools/flag-package.lsp
-tools/flag.pcert1 : acl2x = 0
-tools/flag.pcert1 : no_pcert = 0
-tools/flag.pcert1 : tools/flag.pcert0
-tools/flag.cert : | tools/flag.pcert1
-
-tools/in-raw-mode.pcert0 : no_pcert = 0
-tools/in-raw-mode.pcert0 : acl2x = 0
-tools/in-raw-mode.pcert0 : \
-     tools/in-raw-mode.lisp \
-     tools/in-raw-mode.acl2
-tools/in-raw-mode.pcert1 : acl2x = 0
-tools/in-raw-mode.pcert1 : no_pcert = 0
-tools/in-raw-mode.pcert1 : tools/in-raw-mode.pcert0
-tools/in-raw-mode.cert : | tools/in-raw-mode.pcert1
-
-tools/include-raw.pcert0 : no_pcert = 0
-tools/include-raw.pcert0 : acl2x = 0
-tools/include-raw.pcert0 : \
-     xdoc/top.pcert0 \
-     tools/include-raw.lisp
-tools/include-raw.pcert1 : acl2x = 0
-tools/include-raw.pcert1 : no_pcert = 0
-tools/include-raw.pcert1 : tools/include-raw.pcert0
-tools/include-raw.cert : | tools/include-raw.pcert1
-
-tools/mv-nth.pcert0 : no_pcert = 0
-tools/mv-nth.pcert0 : acl2x = 0
-tools/mv-nth.pcert0 : \
-     tools/mv-nth.lisp
-tools/mv-nth.pcert1 : acl2x = 0
-tools/mv-nth.pcert1 : no_pcert = 0
-tools/mv-nth.pcert1 : tools/mv-nth.pcert0
-tools/mv-nth.cert : | tools/mv-nth.pcert1
-
-tools/oracle-eval-real.pcert0 : no_pcert = 0
-tools/oracle-eval-real.pcert0 : acl2x = 0
-tools/oracle-eval-real.pcert0 : \
-     tools/oracle-eval-real.lisp \
-     tools/oracle-eval-real.acl2
-tools/oracle-eval-real.pcert1 : acl2x = 0
-tools/oracle-eval-real.pcert1 : no_pcert = 0
-tools/oracle-eval-real.pcert1 : tools/oracle-eval-real.pcert0
-tools/oracle-eval-real.cert : | tools/oracle-eval-real.pcert1
-
-tools/oracle-eval.pcert0 : no_pcert = 0
-tools/oracle-eval.pcert0 : acl2x = 0
-tools/oracle-eval.pcert0 : \
-     tools/oracle-eval-real.pcert0 \
-     tools/oracle-eval.lisp
-tools/oracle-eval.pcert1 : acl2x = 0
-tools/oracle-eval.pcert1 : no_pcert = 0
-tools/oracle-eval.pcert1 : tools/oracle-eval.pcert0
-tools/oracle-eval.cert : | tools/oracle-eval.pcert1
-
-tools/pack.pcert0 : no_pcert = 0
-tools/pack.pcert0 : acl2x = 0
-tools/pack.pcert0 : \
-     tools/pack.lisp
-tools/pack.pcert1 : acl2x = 0
-tools/pack.pcert1 : no_pcert = 0
-tools/pack.pcert1 : tools/pack.pcert0
-tools/pack.cert : | tools/pack.pcert1
-
-tools/pattern-match.pcert0 : no_pcert = 0
-tools/pattern-match.pcert0 : acl2x = 0
-tools/pattern-match.pcert0 : \
-     tools/pattern-match.lisp
-tools/pattern-match.pcert1 : acl2x = 0
-tools/pattern-match.pcert1 : no_pcert = 0
-tools/pattern-match.pcert1 : tools/pattern-match.pcert0
-tools/pattern-match.cert : | tools/pattern-match.pcert1
-
-tools/plev-ccl.pcert0 : no_pcert = 0
-tools/plev-ccl.pcert0 : acl2x = 0
-tools/plev-ccl.pcert0 : \
-     tools/plev.pcert0 \
-     tools/include-raw.pcert0 \
-     tools/plev-ccl.lisp \
-     tools/plev-ccl.acl2
-tools/plev-ccl.pcert1 : acl2x = 0
-tools/plev-ccl.pcert1 : no_pcert = 0
-tools/plev-ccl.pcert1 : tools/plev-ccl.pcert0
-tools/plev-ccl.cert : | tools/plev-ccl.pcert1
-
-tools/plev.pcert0 : no_pcert = 0
-tools/plev.pcert0 : acl2x = 0
-tools/plev.pcert0 : \
-     tools/plev.lisp
-tools/plev.pcert1 : acl2x = 0
-tools/plev.pcert1 : no_pcert = 0
-tools/plev.pcert1 : tools/plev.pcert0
-tools/plev.cert : | tools/plev.pcert1
-
-tools/rulesets.pcert0 : no_pcert = 0
-tools/rulesets.pcert0 : acl2x = 0
-tools/rulesets.pcert0 : \
-     xdoc/top.pcert0 \
-     tools/rulesets.lisp
-tools/rulesets.pcert1 : acl2x = 0
-tools/rulesets.pcert1 : no_pcert = 0
-tools/rulesets.pcert1 : tools/rulesets.pcert0
-tools/rulesets.cert : | tools/rulesets.pcert1
-
-tools/safe-case.pcert0 : no_pcert = 0
-tools/safe-case.pcert0 : acl2x = 0
-tools/safe-case.pcert0 : \
-     tools/safe-case.lisp
-tools/safe-case.pcert1 : acl2x = 0
-tools/safe-case.pcert1 : no_pcert = 0
-tools/safe-case.pcert1 : tools/safe-case.pcert0
-tools/safe-case.cert : | tools/safe-case.pcert1
-
-tools/saved-errors.pcert0 : no_pcert = 0
-tools/saved-errors.pcert0 : acl2x = 0
-tools/saved-errors.pcert0 : \
-     tools/saved-errors.lisp
-tools/saved-errors.pcert1 : acl2x = 0
-tools/saved-errors.pcert1 : no_pcert = 0
-tools/saved-errors.pcert1 : tools/saved-errors.pcert0
-tools/saved-errors.cert : | tools/saved-errors.pcert1
-
-tools/stobj-frame.pcert0 : no_pcert = 0
-tools/stobj-frame.pcert0 : acl2x = 0
-tools/stobj-frame.pcert0 : \
-     tools/rulesets.pcert0 \
-     tools/bstar.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     tools/stobj-frame.lisp
-tools/stobj-frame.pcert1 : acl2x = 0
-tools/stobj-frame.pcert1 : no_pcert = 0
-tools/stobj-frame.pcert1 : tools/stobj-frame.pcert0
-tools/stobj-frame.cert : | tools/stobj-frame.pcert1
-
-tools/stobj-help.pcert0 : no_pcert = 0
-tools/stobj-help.pcert0 : acl2x = 0
-tools/stobj-help.pcert0 : \
-     arithmetic-5/top.pcert0 \
-     misc/simplify-thm.pcert0 \
-     tools/stobj-help.lisp
-tools/stobj-help.pcert1 : acl2x = 0
-tools/stobj-help.pcert1 : no_pcert = 0
-tools/stobj-help.pcert1 : tools/stobj-help.pcert0
-tools/stobj-help.cert : | tools/stobj-help.pcert1
-
-tools/templates.pcert0 : no_pcert = 0
-tools/templates.pcert0 : acl2x = 0
-tools/templates.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/defmacfun.pcert0 \
-     xdoc/top.pcert0 \
-     tools/templates.lisp
-tools/templates.pcert1 : acl2x = 0
-tools/templates.pcert1 : no_pcert = 0
-tools/templates.pcert1 : tools/templates.pcert0
-tools/templates.cert : | tools/templates.pcert1
-
-tools/theory-tools.pcert0 : no_pcert = 0
-tools/theory-tools.pcert0 : acl2x = 0
-tools/theory-tools.pcert0 : \
-     tools/theory-tools.lisp
-tools/theory-tools.pcert1 : acl2x = 0
-tools/theory-tools.pcert1 : no_pcert = 0
-tools/theory-tools.pcert1 : tools/theory-tools.pcert0
-tools/theory-tools.cert : | tools/theory-tools.pcert1
-
-tools/time-dollar-with-gc.pcert0 : no_pcert = 0
-tools/time-dollar-with-gc.pcert0 : acl2x = 0
-tools/time-dollar-with-gc.pcert0 : \
-     tools/time-dollar-with-gc.lisp \
-     tools/time-dollar-with-gc.acl2
-tools/time-dollar-with-gc.pcert1 : acl2x = 0
-tools/time-dollar-with-gc.pcert1 : no_pcert = 0
-tools/time-dollar-with-gc.pcert1 : tools/time-dollar-with-gc.pcert0
-tools/time-dollar-with-gc.cert : | tools/time-dollar-with-gc.pcert1
-
-tools/types-misc.pcert0 : no_pcert = 0
-tools/types-misc.pcert0 : acl2x = 0
-tools/types-misc.pcert0 : \
-     tools/theory-tools.pcert0 \
-     tools/types-misc.lisp
-tools/types-misc.pcert1 : acl2x = 0
-tools/types-misc.pcert1 : no_pcert = 0
-tools/types-misc.pcert1 : tools/types-misc.pcert0
-tools/types-misc.cert : | tools/types-misc.pcert1
-
-tools/with-arith5-help.pcert0 : no_pcert = 0
-tools/with-arith5-help.pcert0 : acl2x = 0
-tools/with-arith5-help.pcert0 : \
-     tools/rulesets.pcert0 \
-     arithmetic-5/top.pcert0 \
-     tools/with-arith5-help.lisp
-tools/with-arith5-help.pcert1 : acl2x = 0
-tools/with-arith5-help.pcert1 : no_pcert = 0
-tools/with-arith5-help.pcert1 : tools/with-arith5-help.pcert0
-tools/with-arith5-help.cert : | tools/with-arith5-help.pcert1
-
-tools/with-quoted-forms.pcert0 : no_pcert = 0
-tools/with-quoted-forms.pcert0 : acl2x = 0
-tools/with-quoted-forms.pcert0 : \
-     tools/bstar.pcert0 \
-     tools/with-quoted-forms.lisp
-tools/with-quoted-forms.pcert1 : acl2x = 0
-tools/with-quoted-forms.pcert1 : no_pcert = 0
-tools/with-quoted-forms.pcert1 : tools/with-quoted-forms.pcert0
-tools/with-quoted-forms.cert : | tools/with-quoted-forms.pcert1
-
-tutorial-problems/introductory-challenge-problem-4-athena.pcert0 : no_pcert = 0
-tutorial-problems/introductory-challenge-problem-4-athena.pcert0 : acl2x = 0
-tutorial-problems/introductory-challenge-problem-4-athena.pcert0 : \
-     tutorial-problems/introductory-challenge-problem-4-athena.lisp
-tutorial-problems/introductory-challenge-problem-4-athena.pcert1 : acl2x = 0
-tutorial-problems/introductory-challenge-problem-4-athena.pcert1 : no_pcert = 0
-tutorial-problems/introductory-challenge-problem-4-athena.pcert1 : tutorial-problems/introductory-challenge-problem-4-athena.pcert0
-tutorial-problems/introductory-challenge-problem-4-athena.cert : | tutorial-problems/introductory-challenge-problem-4-athena.pcert1
-
-tutorial-problems/introductory-challenge-problem-4.pcert0 : no_pcert = 0
-tutorial-problems/introductory-challenge-problem-4.pcert0 : acl2x = 0
-tutorial-problems/introductory-challenge-problem-4.pcert0 : \
-     tutorial-problems/introductory-challenge-problem-4.lisp
-tutorial-problems/introductory-challenge-problem-4.pcert1 : acl2x = 0
-tutorial-problems/introductory-challenge-problem-4.pcert1 : no_pcert = 0
-tutorial-problems/introductory-challenge-problem-4.pcert1 : tutorial-problems/introductory-challenge-problem-4.pcert0
-tutorial-problems/introductory-challenge-problem-4.cert : | tutorial-problems/introductory-challenge-problem-4.pcert1
-
-unicode/partition.pcert0 : no_pcert = 0
-unicode/partition.pcert0 : acl2x = 0
-unicode/partition.pcert0 : \
-     std/lists/flatten.pcert0 \
-     unicode/sum-list.pcert0 \
-     std/lists/take.pcert0 \
-     unicode/z-listp.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     unicode/partition.lisp
-unicode/partition.pcert1 : acl2x = 0
-unicode/partition.pcert1 : no_pcert = 0
-unicode/partition.pcert1 : unicode/partition.pcert0
-unicode/partition.cert : | unicode/partition.pcert1
-
-unicode/read-utf8.pcert0 : no_pcert = 0
-unicode/read-utf8.pcert0 : acl2x = 0
-unicode/read-utf8.pcert0 : \
-     unicode/utf8-decode.pcert0 \
-     std/io/take-bytes.pcert0 \
-     std/io/base.pcert0 \
-     tools/mv-nth.pcert0 \
-     std/io/signed-byte-listp.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     unicode/read-utf8.lisp
-unicode/read-utf8.pcert1 : acl2x = 0
-unicode/read-utf8.pcert1 : no_pcert = 0
-unicode/read-utf8.pcert1 : unicode/read-utf8.pcert0
-unicode/read-utf8.cert : | unicode/read-utf8.pcert1
-
-unicode/sum-list.pcert0 : no_pcert = 0
-unicode/sum-list.pcert0 : acl2x = 0
-unicode/sum-list.pcert0 : \
-     std/lists/nat-listp.pcert0 \
-     unicode/sum-list.lisp
-unicode/sum-list.pcert1 : acl2x = 0
-unicode/sum-list.pcert1 : no_pcert = 0
-unicode/sum-list.pcert1 : unicode/sum-list.pcert0
-unicode/sum-list.cert : | unicode/sum-list.pcert1
-
-unicode/uchar.pcert0 : no_pcert = 0
-unicode/uchar.pcert0 : acl2x = 0
-unicode/uchar.pcert0 : \
-     unicode/uchar.lisp
-unicode/uchar.pcert1 : acl2x = 0
-unicode/uchar.pcert1 : no_pcert = 0
-unicode/uchar.pcert1 : unicode/uchar.pcert0
-unicode/uchar.cert : | unicode/uchar.pcert1
-
-unicode/utf8-decode.pcert0 : no_pcert = 0
-unicode/utf8-decode.pcert0 : acl2x = 0
-unicode/utf8-decode.pcert0 : \
-     unicode/uchar.pcert0 \
-     unicode/utf8-table35.pcert0 \
-     unicode/utf8-table36.pcert0 \
-     unicode/utf8-encode.pcert0 \
-     unicode/partition.pcert0 \
-     std/lists/nthcdr.pcert0 \
-     std/io/signed-byte-listp.pcert0 \
-     tools/mv-nth.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     std/lists/revappend.pcert0 \
-     unicode/utf8-decode.lisp
-unicode/utf8-decode.pcert1 : acl2x = 0
-unicode/utf8-decode.pcert1 : no_pcert = 0
-unicode/utf8-decode.pcert1 : unicode/utf8-decode.pcert0
-unicode/utf8-decode.cert : | unicode/utf8-decode.pcert1
-
-unicode/utf8-encode.pcert0 : no_pcert = 0
-unicode/utf8-encode.pcert0 : acl2x = 0
-unicode/utf8-encode.pcert0 : \
-     unicode/utf8-table35.pcert0 \
-     unicode/utf8-table36.pcert0 \
-     std/lists/append.pcert0 \
-     std/io/signed-byte-listp.pcert0 \
-     unicode/utf8-encode.lisp
-unicode/utf8-encode.pcert1 : acl2x = 0
-unicode/utf8-encode.pcert1 : no_pcert = 0
-unicode/utf8-encode.pcert1 : unicode/utf8-encode.pcert0
-unicode/utf8-encode.cert : | unicode/utf8-encode.pcert1
-
-unicode/utf8-table35.pcert0 : no_pcert = 0
-unicode/utf8-table35.pcert0 : acl2x = 0
-unicode/utf8-table35.pcert0 : \
-     unicode/uchar.pcert0 \
-     std/io/unsigned-byte-listp.pcert0 \
-     std/io/signed-byte-listp.pcert0 \
-     unicode/utf8-table35.lisp
-unicode/utf8-table35.pcert1 : acl2x = 0
-unicode/utf8-table35.pcert1 : no_pcert = 0
-unicode/utf8-table35.pcert1 : unicode/utf8-table35.pcert0
-unicode/utf8-table35.cert : | unicode/utf8-table35.pcert1
-
-unicode/utf8-table36.pcert0 : no_pcert = 0
-unicode/utf8-table36.pcert0 : acl2x = 0
-unicode/utf8-table36.pcert0 : \
-     unicode/uchar.pcert0 \
-     std/io/unsigned-byte-listp.pcert0 \
-     std/io/signed-byte-listp.pcert0 \
-     unicode/utf8-table36.lisp
-unicode/utf8-table36.pcert1 : acl2x = 0
-unicode/utf8-table36.pcert1 : no_pcert = 0
-unicode/utf8-table36.pcert1 : unicode/utf8-table36.pcert0
-unicode/utf8-table36.cert : | unicode/utf8-table36.pcert1
-
-unicode/z-listp.pcert0 : no_pcert = 0
-unicode/z-listp.pcert0 : acl2x = 0
-unicode/z-listp.pcert0 : \
-     std/lists/app.pcert0 \
-     unicode/z-listp.lisp
-unicode/z-listp.pcert1 : acl2x = 0
-unicode/z-listp.pcert1 : no_pcert = 0
-unicode/z-listp.pcert1 : unicode/z-listp.pcert0
-unicode/z-listp.cert : | unicode/z-listp.pcert1
-
-workshops/1999/calculus/solutions/mesh-append.pcert0 : no_pcert = 0
-workshops/1999/calculus/solutions/mesh-append.pcert0 : acl2x = 0
-workshops/1999/calculus/solutions/mesh-append.pcert0 : \
-     workshops/1999/calculus/solutions/partition-defuns.pcert0 \
-     workshops/1999/calculus/solutions/mesh-append.lisp
-workshops/1999/calculus/solutions/mesh-append.pcert1 : acl2x = 0
-workshops/1999/calculus/solutions/mesh-append.pcert1 : no_pcert = 0
-workshops/1999/calculus/solutions/mesh-append.pcert1 : workshops/1999/calculus/solutions/mesh-append.pcert0
-workshops/1999/calculus/solutions/mesh-append.cert : | workshops/1999/calculus/solutions/mesh-append.pcert1
-
-workshops/1999/calculus/solutions/mesh-make-partition.pcert0 : no_pcert = 0
-workshops/1999/calculus/solutions/mesh-make-partition.pcert0 : acl2x = 0
-workshops/1999/calculus/solutions/mesh-make-partition.pcert0 : \
-     workshops/1999/calculus/solutions/partition-defuns.pcert0 \
-     workshops/1999/calculus/solutions/mesh-make-partition.lisp
-workshops/1999/calculus/solutions/mesh-make-partition.pcert1 : acl2x = 0
-workshops/1999/calculus/solutions/mesh-make-partition.pcert1 : no_pcert = 0
-workshops/1999/calculus/solutions/mesh-make-partition.pcert1 : workshops/1999/calculus/solutions/mesh-make-partition.pcert0
-workshops/1999/calculus/solutions/mesh-make-partition.cert : | workshops/1999/calculus/solutions/mesh-make-partition.pcert1
-
-workshops/1999/calculus/solutions/partition-defuns.pcert0 : no_pcert = 0
-workshops/1999/calculus/solutions/partition-defuns.pcert0 : acl2x = 0
-workshops/1999/calculus/solutions/partition-defuns.pcert0 : \
-     workshops/1999/calculus/solutions/partition-defuns.lisp
-workshops/1999/calculus/solutions/partition-defuns.pcert1 : acl2x = 0
-workshops/1999/calculus/solutions/partition-defuns.pcert1 : no_pcert = 0
-workshops/1999/calculus/solutions/partition-defuns.pcert1 : workshops/1999/calculus/solutions/partition-defuns.pcert0
-workshops/1999/calculus/solutions/partition-defuns.cert : | workshops/1999/calculus/solutions/partition-defuns.pcert1
-
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert0 : no_pcert = 0
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert0 : acl2x = 0
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert0 : \
-     workshops/1999/calculus/solutions/partition-defuns.pcert0 \
-     workshops/1999/calculus/solutions/partitionp-make-partition-rec.lisp
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert1 : acl2x = 0
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert1 : no_pcert = 0
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert1 : workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert0
-workshops/1999/calculus/solutions/partitionp-make-partition-rec.cert : | workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert1
-
-workshops/1999/calculus/solutions/partitionp-make-partition.pcert0 : no_pcert = 0
-workshops/1999/calculus/solutions/partitionp-make-partition.pcert0 : acl2x = 0
-workshops/1999/calculus/solutions/partitionp-make-partition.pcert0 : \
-     workshops/1999/calculus/solutions/partition-defuns.pcert0 \
-     workshops/1999/calculus/solutions/partitionp-make-partition-rec.pcert0 \
-     workshops/1999/calculus/solutions/partitionp-make-partition.lisp
-workshops/1999/calculus/solutions/partitionp-make-partition.pcert1 : acl2x = 0
-workshops/1999/calculus/solutions/partitionp-make-partition.pcert1 : no_pcert = 0
-workshops/1999/calculus/solutions/partitionp-make-partition.pcert1 : workshops/1999/calculus/solutions/partitionp-make-partition.pcert0
-workshops/1999/calculus/solutions/partitionp-make-partition.cert : | workshops/1999/calculus/solutions/partitionp-make-partition.pcert1
-
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.pcert0 : no_pcert = 0
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.pcert0 : acl2x = 0
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.pcert0 : \
-     workshops/1999/calculus/solutions/riemann-rcfn-helpers.lisp
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.pcert1 : acl2x = 0
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.pcert1 : no_pcert = 0
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.pcert1 : workshops/1999/calculus/solutions/riemann-rcfn-helpers.pcert0
-workshops/1999/calculus/solutions/riemann-rcfn-helpers.cert : | workshops/1999/calculus/solutions/riemann-rcfn-helpers.pcert1
-
-workshops/1999/compiler/compiler.pcert0 : no_pcert = 0
-workshops/1999/compiler/compiler.pcert0 : acl2x = 0
-workshops/1999/compiler/compiler.pcert0 : \
-     workshops/1999/compiler/machine.pcert0 \
-     workshops/1999/compiler/compiler.lisp
-workshops/1999/compiler/compiler.pcert1 : acl2x = 0
-workshops/1999/compiler/compiler.pcert1 : no_pcert = 0
-workshops/1999/compiler/compiler.pcert1 : workshops/1999/compiler/compiler.pcert0
-workshops/1999/compiler/compiler.cert : | workshops/1999/compiler/compiler.pcert1
-
-workshops/1999/compiler/evaluator.pcert0 : no_pcert = 0
-workshops/1999/compiler/evaluator.pcert0 : acl2x = 0
-workshops/1999/compiler/evaluator.pcert0 : \
-     workshops/1999/compiler/compiler.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/compiler/evaluator.lisp
-workshops/1999/compiler/evaluator.pcert1 : acl2x = 0
-workshops/1999/compiler/evaluator.pcert1 : no_pcert = 0
-workshops/1999/compiler/evaluator.pcert1 : workshops/1999/compiler/evaluator.pcert0
-workshops/1999/compiler/evaluator.cert : | workshops/1999/compiler/evaluator.pcert1
-
-workshops/1999/compiler/exercises.pcert0 : no_pcert = 0
-workshops/1999/compiler/exercises.pcert0 : acl2x = 0
-workshops/1999/compiler/exercises.pcert0 : \
-     workshops/1999/compiler/compiler.pcert0 \
-     workshops/1999/compiler/exercises.lisp
-workshops/1999/compiler/exercises.pcert1 : acl2x = 0
-workshops/1999/compiler/exercises.pcert1 : no_pcert = 0
-workshops/1999/compiler/exercises.pcert1 : workshops/1999/compiler/exercises.pcert0
-workshops/1999/compiler/exercises.cert : | workshops/1999/compiler/exercises.pcert1
-
-workshops/1999/compiler/machine.pcert0 : no_pcert = 0
-workshops/1999/compiler/machine.pcert0 : acl2x = 0
-workshops/1999/compiler/machine.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/compiler/machine.lisp
-workshops/1999/compiler/machine.pcert1 : acl2x = 0
-workshops/1999/compiler/machine.pcert1 : no_pcert = 0
-workshops/1999/compiler/machine.pcert1 : workshops/1999/compiler/machine.pcert0
-workshops/1999/compiler/machine.cert : | workshops/1999/compiler/machine.pcert1
-
-workshops/1999/compiler/proof.pcert0 : no_pcert = 0
-workshops/1999/compiler/proof.pcert0 : acl2x = 0
-workshops/1999/compiler/proof.pcert0 : \
-     workshops/1999/compiler/proof1.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/compiler/proof.lisp
-workshops/1999/compiler/proof.pcert1 : acl2x = 0
-workshops/1999/compiler/proof.pcert1 : no_pcert = 0
-workshops/1999/compiler/proof.pcert1 : workshops/1999/compiler/proof.pcert0
-workshops/1999/compiler/proof.cert : | workshops/1999/compiler/proof.pcert1
-
-workshops/1999/compiler/proof1.pcert0 : no_pcert = 0
-workshops/1999/compiler/proof1.pcert0 : acl2x = 0
-workshops/1999/compiler/proof1.pcert0 : \
-     workshops/1999/compiler/evaluator.pcert0 \
-     arithmetic/equalities.pcert0 \
-     workshops/1999/compiler/proof1.lisp
-workshops/1999/compiler/proof1.pcert1 : acl2x = 0
-workshops/1999/compiler/proof1.pcert1 : no_pcert = 0
-workshops/1999/compiler/proof1.pcert1 : workshops/1999/compiler/proof1.pcert0
-workshops/1999/compiler/proof1.cert : | workshops/1999/compiler/proof1.pcert1
-
-workshops/1999/de-hdl/arity.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/arity.pcert0 : acl2x = 0
-workshops/1999/de-hdl/arity.pcert0 : \
-     workshops/1999/de-hdl/syntax.pcert0 \
-     workshops/1999/de-hdl/arity.lisp
-workshops/1999/de-hdl/arity.pcert1 : acl2x = 0
-workshops/1999/de-hdl/arity.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/arity.pcert1 : workshops/1999/de-hdl/arity.pcert0
-workshops/1999/de-hdl/arity.cert : | workshops/1999/de-hdl/arity.pcert1
-
-workshops/1999/de-hdl/de4.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/de4.pcert0 : acl2x = 0
-workshops/1999/de-hdl/de4.pcert0 : \
-     workshops/1999/de-hdl/sts-okp.pcert0 \
-     workshops/1999/de-hdl/de4.lisp
-workshops/1999/de-hdl/de4.pcert1 : acl2x = 0
-workshops/1999/de-hdl/de4.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/de4.pcert1 : workshops/1999/de-hdl/de4.pcert0
-workshops/1999/de-hdl/de4.cert : | workshops/1999/de-hdl/de4.pcert1
-
-workshops/1999/de-hdl/examples.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/examples.pcert0 : acl2x = 0
-workshops/1999/de-hdl/examples.pcert0 : \
-     workshops/1999/de-hdl/de4.pcert0 \
-     workshops/1999/de-hdl/examples.lisp
-workshops/1999/de-hdl/examples.pcert1 : acl2x = 0
-workshops/1999/de-hdl/examples.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/examples.pcert1 : workshops/1999/de-hdl/examples.pcert0
-workshops/1999/de-hdl/examples.cert : | workshops/1999/de-hdl/examples.pcert1
-
-workshops/1999/de-hdl/help-defuns.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/help-defuns.pcert0 : acl2x = 0
-workshops/1999/de-hdl/help-defuns.pcert0 : \
-     workshops/1999/de-hdl/help-defuns.lisp
-workshops/1999/de-hdl/help-defuns.pcert1 : acl2x = 0
-workshops/1999/de-hdl/help-defuns.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/help-defuns.pcert1 : workshops/1999/de-hdl/help-defuns.pcert0
-workshops/1999/de-hdl/help-defuns.cert : | workshops/1999/de-hdl/help-defuns.pcert1
-
-workshops/1999/de-hdl/measure.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/measure.pcert0 : acl2x = 0
-workshops/1999/de-hdl/measure.pcert0 : \
-     workshops/1999/de-hdl/help-defuns.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/de-hdl/measure.lisp
-workshops/1999/de-hdl/measure.pcert1 : acl2x = 0
-workshops/1999/de-hdl/measure.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/measure.pcert1 : workshops/1999/de-hdl/measure.pcert0
-workshops/1999/de-hdl/measure.cert : | workshops/1999/de-hdl/measure.pcert1
-
-workshops/1999/de-hdl/primitives.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/primitives.pcert0 : acl2x = 0
-workshops/1999/de-hdl/primitives.pcert0 : \
-     workshops/1999/de-hdl/measure.pcert0 \
-     workshops/1999/de-hdl/primitives.lisp
-workshops/1999/de-hdl/primitives.pcert1 : acl2x = 0
-workshops/1999/de-hdl/primitives.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/primitives.pcert1 : workshops/1999/de-hdl/primitives.pcert0
-workshops/1999/de-hdl/primitives.cert : | workshops/1999/de-hdl/primitives.pcert1
-
-workshops/1999/de-hdl/sts-okp.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/sts-okp.pcert0 : acl2x = 0
-workshops/1999/de-hdl/sts-okp.pcert0 : \
-     workshops/1999/de-hdl/arity.pcert0 \
-     workshops/1999/de-hdl/sts-okp.lisp
-workshops/1999/de-hdl/sts-okp.pcert1 : acl2x = 0
-workshops/1999/de-hdl/sts-okp.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/sts-okp.pcert1 : workshops/1999/de-hdl/sts-okp.pcert0
-workshops/1999/de-hdl/sts-okp.cert : | workshops/1999/de-hdl/sts-okp.pcert1
-
-workshops/1999/de-hdl/syntax.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/syntax.pcert0 : acl2x = 0
-workshops/1999/de-hdl/syntax.pcert0 : \
-     workshops/1999/de-hdl/primitives.pcert0 \
-     workshops/1999/de-hdl/syntax.lisp
-workshops/1999/de-hdl/syntax.pcert1 : acl2x = 0
-workshops/1999/de-hdl/syntax.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/syntax.pcert1 : workshops/1999/de-hdl/syntax.pcert0
-workshops/1999/de-hdl/syntax.cert : | workshops/1999/de-hdl/syntax.pcert1
-
-workshops/1999/de-hdl/thm-example.pcert0 : no_pcert = 0
-workshops/1999/de-hdl/thm-example.pcert0 : acl2x = 0
-workshops/1999/de-hdl/thm-example.pcert0 : \
-     workshops/1999/de-hdl/de4.pcert0 \
-     workshops/1999/de-hdl/thm-example.lisp
-workshops/1999/de-hdl/thm-example.pcert1 : acl2x = 0
-workshops/1999/de-hdl/thm-example.pcert1 : no_pcert = 0
-workshops/1999/de-hdl/thm-example.pcert1 : workshops/1999/de-hdl/thm-example.pcert0
-workshops/1999/de-hdl/thm-example.cert : | workshops/1999/de-hdl/thm-example.pcert1
-
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.pcert0 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.pcert0 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.pcert0 : \
-     workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.lisp
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.pcert1 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.pcert1 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.pcert1 : workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.pcert0
-workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.cert : | workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.pcert1
-
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.pcert0 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.pcert0 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.pcert0 : \
-     arithmetic/mod-gcd.pcert0 \
-     rtl/rel1/lib1/basic.pcert0 \
-     rtl/rel1/support/fp.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert0 \
-     workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.lisp
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.pcert1 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.pcert1 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.pcert1 : workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.pcert0
-workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.cert : | workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.pcert1
-
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert0 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert0 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert0 : \
-     workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert0 \
-     workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.lisp
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert1 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert1 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert1 : workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert0
-workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.cert : | workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.pcert1
-
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert0 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert0 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert0 : \
-     ihs/ihs-init.pcert0 \
-     ihs/ihs-theories.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.lisp
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert1 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert1 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert1 : workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert0
-workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.cert : | workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.pcert1
-
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.pcert0 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.pcert0 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.pcert0 : \
-     workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.lisp
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.pcert1 : acl2x = 0
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.pcert1 : no_pcert = 0
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.pcert1 : workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.pcert0
-workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.cert : | workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert0 : \
-     arithmetic/mod-gcd.pcert0 \
-     rtl/rel1/lib1/basic.pcert0 \
-     rtl/rel1/support/fp.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/CRT.lisp
-workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/CRT.cert : | workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/CRT.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.lisp
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.cert : | workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.lisp
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.cert : | workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/Generic.lisp
-workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/Generic.cert : | workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/Generic.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Mapping.lisp
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/Mapping.cert : | workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.lisp
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.cert : | workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.lisp
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.cert : | workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.lisp
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.cert : | workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.lisp
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.cert : | workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert0 : \
-     workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Mapping.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.lisp
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.cert : | workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.pcert1
-
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert0 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert0 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert0 : \
-     ihs/ihs-init.pcert0 \
-     ihs/ihs-theories.pcert0 \
-     ihs/math-lemmas.pcert0 \
-     workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.lisp
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert1 : acl2x = 0
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert1 : no_pcert = 0
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert1 : workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert0
-workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.cert : | workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.pcert1
-
-workshops/1999/graph/find-path1.pcert0 : no_pcert = 0
-workshops/1999/graph/find-path1.pcert0 : acl2x = 0
-workshops/1999/graph/find-path1.pcert0 : \
-     arithmetic/top.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/graph/find-path1.lisp
-workshops/1999/graph/find-path1.pcert1 : acl2x = 0
-workshops/1999/graph/find-path1.pcert1 : no_pcert = 0
-workshops/1999/graph/find-path1.pcert1 : workshops/1999/graph/find-path1.pcert0
-workshops/1999/graph/find-path1.cert : | workshops/1999/graph/find-path1.pcert1
-
-workshops/1999/graph/find-path2.pcert0 : no_pcert = 0
-workshops/1999/graph/find-path2.pcert0 : acl2x = 0
-workshops/1999/graph/find-path2.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/1999/graph/helpers.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/graph/find-path2.lisp
-workshops/1999/graph/find-path2.pcert1 : acl2x = 0
-workshops/1999/graph/find-path2.pcert1 : no_pcert = 0
-workshops/1999/graph/find-path2.pcert1 : workshops/1999/graph/find-path2.pcert0
-workshops/1999/graph/find-path2.cert : | workshops/1999/graph/find-path2.pcert1
-
-workshops/1999/graph/find-path3.pcert0 : no_pcert = 0
-workshops/1999/graph/find-path3.pcert0 : acl2x = 0
-workshops/1999/graph/find-path3.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/1999/graph/helpers.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/graph/find-path3.lisp
-workshops/1999/graph/find-path3.pcert1 : acl2x = 0
-workshops/1999/graph/find-path3.pcert1 : no_pcert = 0
-workshops/1999/graph/find-path3.pcert1 : workshops/1999/graph/find-path3.pcert0
-workshops/1999/graph/find-path3.cert : | workshops/1999/graph/find-path3.pcert1
-
-workshops/1999/graph/helpers.pcert0 : no_pcert = 0
-workshops/1999/graph/helpers.pcert0 : acl2x = 0
-workshops/1999/graph/helpers.pcert0 : \
-     workshops/1999/graph/helpers.lisp
-workshops/1999/graph/helpers.pcert1 : acl2x = 0
-workshops/1999/graph/helpers.pcert1 : no_pcert = 0
-workshops/1999/graph/helpers.pcert1 : workshops/1999/graph/helpers.pcert0
-workshops/1999/graph/helpers.cert : | workshops/1999/graph/helpers.pcert1
-
-workshops/1999/graph/linear-find-path.pcert0 : no_pcert = 0
-workshops/1999/graph/linear-find-path.pcert0 : acl2x = 0
-workshops/1999/graph/linear-find-path.pcert0 : \
-     workshops/1999/graph/find-path3.pcert0 \
-     workshops/1999/graph/linear-find-path.lisp
-workshops/1999/graph/linear-find-path.pcert1 : acl2x = 0
-workshops/1999/graph/linear-find-path.pcert1 : no_pcert = 0
-workshops/1999/graph/linear-find-path.pcert1 : workshops/1999/graph/linear-find-path.pcert0
-workshops/1999/graph/linear-find-path.cert : | workshops/1999/graph/linear-find-path.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/alls.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/alls.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/base.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/close.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/cnf.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/cnf.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/flip.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/flip.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/flip.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/instance.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/keval.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/keval.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/keval.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/modeler.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/modeler.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/nnf.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/nnf.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/paramod.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/paramod.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/paramod.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/nnf.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/cnf.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prover.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/prover.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/pull.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/pull.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/rename.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/rename.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/resolve.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/resolve.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/resolve.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sets.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/sets.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/sets.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/derive.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simplify.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/simplify.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/simplify.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/permutations.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/substitution.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/substitution.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/substitution.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/sugar.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/sugar.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/sugar.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/sugar.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/top.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/top.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/top.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/prover.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/modeler.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/top.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/top.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/top.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/top.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/top.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/top.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/top.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/stage.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/close.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/variables.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/variables.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/variables.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/alls.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.pcert1
-
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert0 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert0 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert0 : \
-     workshops/1999/ivy/ivy-v2/ivy-sources/base.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/ivy/ivy-v2/ivy-sources/xeval.lisp
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert1 : acl2x = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert1 : no_pcert = 0
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert1 : workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert0
-workshops/1999/ivy/ivy-v2/ivy-sources/xeval.cert : | workshops/1999/ivy/ivy-v2/ivy-sources/xeval.pcert1
-
-workshops/1999/knuth-91/aof.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/aof.pcert0 : acl2x = 0
-workshops/1999/knuth-91/aof.pcert0 : \
-     arithmetic/inequalities.pcert0 \
-     workshops/1999/knuth-91/aof.lisp \
-     workshops/1999/knuth-91/aof.acl2
-workshops/1999/knuth-91/aof.pcert1 : acl2x = 0
-workshops/1999/knuth-91/aof.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/aof.pcert1 : workshops/1999/knuth-91/aof.pcert0
-workshops/1999/knuth-91/aof.cert : | workshops/1999/knuth-91/aof.pcert1
-
-workshops/1999/knuth-91/exercise1.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise1.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise1.pcert0 : \
-     workshops/1999/knuth-91/exercise1.lisp \
-     workshops/1999/knuth-91/exercise1.acl2
-workshops/1999/knuth-91/exercise1.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise1.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise1.pcert1 : workshops/1999/knuth-91/exercise1.pcert0
-workshops/1999/knuth-91/exercise1.cert : | workshops/1999/knuth-91/exercise1.pcert1
-
-workshops/1999/knuth-91/exercise2.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise2.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise2.pcert0 : \
-     workshops/1999/knuth-91/exercise2.lisp
-workshops/1999/knuth-91/exercise2.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise2.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise2.pcert1 : workshops/1999/knuth-91/exercise2.pcert0
-workshops/1999/knuth-91/exercise2.cert : | workshops/1999/knuth-91/exercise2.pcert1
-
-workshops/1999/knuth-91/exercise3.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise3.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise3.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/knuth-91/exercise3.lisp
-workshops/1999/knuth-91/exercise3.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise3.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise3.pcert1 : workshops/1999/knuth-91/exercise3.pcert0
-workshops/1999/knuth-91/exercise3.cert : | workshops/1999/knuth-91/exercise3.pcert1
-
-workshops/1999/knuth-91/exercise4a.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise4a.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise4a.pcert0 : \
-     workshops/1999/knuth-91/exercise4a.lisp
-workshops/1999/knuth-91/exercise4a.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise4a.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise4a.pcert1 : workshops/1999/knuth-91/exercise4a.pcert0
-workshops/1999/knuth-91/exercise4a.cert : | workshops/1999/knuth-91/exercise4a.pcert1
-
-workshops/1999/knuth-91/exercise4b.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise4b.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise4b.pcert0 : \
-     workshops/1999/knuth-91/exercise4b.lisp
-workshops/1999/knuth-91/exercise4b.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise4b.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise4b.pcert1 : workshops/1999/knuth-91/exercise4b.pcert0
-workshops/1999/knuth-91/exercise4b.cert : | workshops/1999/knuth-91/exercise4b.pcert1
-
-workshops/1999/knuth-91/exercise5.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise5.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise5.pcert0 : \
-     workshops/1999/knuth-91/exercise5.lisp
-workshops/1999/knuth-91/exercise5.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise5.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise5.pcert1 : workshops/1999/knuth-91/exercise5.pcert0
-workshops/1999/knuth-91/exercise5.cert : | workshops/1999/knuth-91/exercise5.pcert1
-
-workshops/1999/knuth-91/exercise6a.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise6a.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise6a.pcert0 : \
-     workshops/1999/knuth-91/exercise6a.lisp
-workshops/1999/knuth-91/exercise6a.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise6a.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise6a.pcert1 : workshops/1999/knuth-91/exercise6a.pcert0
-workshops/1999/knuth-91/exercise6a.cert : | workshops/1999/knuth-91/exercise6a.pcert1
-
-workshops/1999/knuth-91/exercise6b.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise6b.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise6b.pcert0 : \
-     workshops/1999/knuth-91/exercise6b.lisp
-workshops/1999/knuth-91/exercise6b.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise6b.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise6b.pcert1 : workshops/1999/knuth-91/exercise6b.pcert0
-workshops/1999/knuth-91/exercise6b.cert : | workshops/1999/knuth-91/exercise6b.pcert1
-
-workshops/1999/knuth-91/exercise7a.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise7a.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise7a.pcert0 : \
-     workshops/1999/knuth-91/exercise7a.lisp
-workshops/1999/knuth-91/exercise7a.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise7a.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise7a.pcert1 : workshops/1999/knuth-91/exercise7a.pcert0
-workshops/1999/knuth-91/exercise7a.cert : | workshops/1999/knuth-91/exercise7a.pcert1
-
-workshops/1999/knuth-91/exercise7b.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/exercise7b.pcert0 : acl2x = 0
-workshops/1999/knuth-91/exercise7b.pcert0 : \
-     workshops/1999/knuth-91/exercise7b.lisp
-workshops/1999/knuth-91/exercise7b.pcert1 : acl2x = 0
-workshops/1999/knuth-91/exercise7b.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/exercise7b.pcert1 : workshops/1999/knuth-91/exercise7b.pcert0
-workshops/1999/knuth-91/exercise7b.cert : | workshops/1999/knuth-91/exercise7b.pcert1
-
-workshops/1999/knuth-91/knuth-arch.pcert0 : no_pcert = 0
-workshops/1999/knuth-91/knuth-arch.pcert0 : acl2x = 0
-workshops/1999/knuth-91/knuth-arch.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/knuth-91/aof.pcert0 \
-     workshops/1999/knuth-91/knuth-arch.lisp
-workshops/1999/knuth-91/knuth-arch.pcert1 : acl2x = 0
-workshops/1999/knuth-91/knuth-arch.pcert1 : no_pcert = 0
-workshops/1999/knuth-91/knuth-arch.pcert1 : workshops/1999/knuth-91/knuth-arch.pcert0
-workshops/1999/knuth-91/knuth-arch.cert : | workshops/1999/knuth-91/knuth-arch.pcert1
-
-workshops/1999/mu-calculus/book/fast-sets.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/book/fast-sets.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/book/fast-sets.pcert0 : \
-     workshops/1999/mu-calculus/book/sets.pcert0 \
-     workshops/1999/mu-calculus/book/fast-sets.lisp \
-     workshops/1999/mu-calculus/book/fast-sets.acl2
-workshops/1999/mu-calculus/book/fast-sets.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/book/fast-sets.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/book/fast-sets.pcert1 : workshops/1999/mu-calculus/book/fast-sets.pcert0
-workshops/1999/mu-calculus/book/fast-sets.cert : | workshops/1999/mu-calculus/book/fast-sets.pcert1
-
-workshops/1999/mu-calculus/book/fixpoints.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/book/fixpoints.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/book/fixpoints.pcert0 : \
-     workshops/1999/mu-calculus/book/sets.pcert0 \
-     workshops/1999/mu-calculus/book/fixpoints.lisp \
-     workshops/1999/mu-calculus/book/fixpoints.acl2
-workshops/1999/mu-calculus/book/fixpoints.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/book/fixpoints.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/book/fixpoints.pcert1 : workshops/1999/mu-calculus/book/fixpoints.pcert0
-workshops/1999/mu-calculus/book/fixpoints.cert : | workshops/1999/mu-calculus/book/fixpoints.pcert1
-
-workshops/1999/mu-calculus/book/models.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/book/models.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/book/models.pcert0 : \
-     workshops/1999/mu-calculus/book/relations.pcert0 \
-     workshops/1999/mu-calculus/book/fixpoints.pcert0 \
-     workshops/1999/mu-calculus/book/models.lisp \
-     workshops/1999/mu-calculus/book/models.acl2
-workshops/1999/mu-calculus/book/models.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/book/models.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/book/models.pcert1 : workshops/1999/mu-calculus/book/models.pcert0
-workshops/1999/mu-calculus/book/models.cert : | workshops/1999/mu-calculus/book/models.pcert1
-
-workshops/1999/mu-calculus/book/relations.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/book/relations.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/book/relations.pcert0 : \
-     workshops/1999/mu-calculus/book/fast-sets.pcert0 \
-     workshops/1999/mu-calculus/book/relations.lisp \
-     workshops/1999/mu-calculus/book/relations.acl2
-workshops/1999/mu-calculus/book/relations.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/book/relations.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/book/relations.pcert1 : workshops/1999/mu-calculus/book/relations.pcert0
-workshops/1999/mu-calculus/book/relations.cert : | workshops/1999/mu-calculus/book/relations.pcert1
-
-workshops/1999/mu-calculus/book/semantics.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/book/semantics.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/book/semantics.pcert0 : \
-     workshops/1999/mu-calculus/book/syntax.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/mu-calculus/book/semantics.lisp \
-     workshops/1999/mu-calculus/book/semantics.acl2
-workshops/1999/mu-calculus/book/semantics.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/book/semantics.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/book/semantics.pcert1 : workshops/1999/mu-calculus/book/semantics.pcert0
-workshops/1999/mu-calculus/book/semantics.cert : | workshops/1999/mu-calculus/book/semantics.pcert1
-
-workshops/1999/mu-calculus/book/sets.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/book/sets.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/book/sets.pcert0 : \
-     workshops/1999/mu-calculus/book/sets.lisp \
-     workshops/1999/mu-calculus/book/sets.acl2
-workshops/1999/mu-calculus/book/sets.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/book/sets.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/book/sets.pcert1 : workshops/1999/mu-calculus/book/sets.pcert0
-workshops/1999/mu-calculus/book/sets.cert : | workshops/1999/mu-calculus/book/sets.pcert1
-
-workshops/1999/mu-calculus/book/syntax.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/book/syntax.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/book/syntax.pcert0 : \
-     workshops/1999/mu-calculus/book/models.pcert0 \
-     workshops/1999/mu-calculus/book/syntax.lisp \
-     workshops/1999/mu-calculus/book/syntax.acl2
-workshops/1999/mu-calculus/book/syntax.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/book/syntax.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/book/syntax.pcert1 : workshops/1999/mu-calculus/book/syntax.pcert0
-workshops/1999/mu-calculus/book/syntax.cert : | workshops/1999/mu-calculus/book/syntax.pcert1
-
-workshops/1999/mu-calculus/solutions/ctl.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/ctl.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/ctl.pcert0 : \
-     workshops/1999/mu-calculus/solutions/semantics.pcert0 \
-     workshops/1999/mu-calculus/solutions/ctl.lisp \
-     workshops/1999/mu-calculus/solutions/ctl.acl2
-workshops/1999/mu-calculus/solutions/ctl.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/ctl.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/ctl.pcert1 : workshops/1999/mu-calculus/solutions/ctl.pcert0
-workshops/1999/mu-calculus/solutions/ctl.cert : | workshops/1999/mu-calculus/solutions/ctl.pcert1
-
-workshops/1999/mu-calculus/solutions/defung.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/defung.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/defung.pcert0 : \
-     workshops/1999/mu-calculus/solutions/defung.lisp
-workshops/1999/mu-calculus/solutions/defung.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/defung.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/defung.pcert1 : workshops/1999/mu-calculus/solutions/defung.pcert0
-workshops/1999/mu-calculus/solutions/defung.cert : | workshops/1999/mu-calculus/solutions/defung.pcert1
-
-workshops/1999/mu-calculus/solutions/fast-sets.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/fast-sets.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/fast-sets.pcert0 : \
-     workshops/1999/mu-calculus/solutions/sets.pcert0 \
-     workshops/1999/mu-calculus/solutions/fast-sets.lisp \
-     workshops/1999/mu-calculus/solutions/fast-sets.acl2
-workshops/1999/mu-calculus/solutions/fast-sets.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/fast-sets.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/fast-sets.pcert1 : workshops/1999/mu-calculus/solutions/fast-sets.pcert0
-workshops/1999/mu-calculus/solutions/fast-sets.cert : | workshops/1999/mu-calculus/solutions/fast-sets.pcert1
-
-workshops/1999/mu-calculus/solutions/fixpoints.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/fixpoints.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/fixpoints.pcert0 : \
-     workshops/1999/mu-calculus/solutions/sets.pcert0 \
-     workshops/1999/mu-calculus/solutions/fixpoints.lisp \
-     workshops/1999/mu-calculus/solutions/fixpoints.acl2
-workshops/1999/mu-calculus/solutions/fixpoints.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/fixpoints.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/fixpoints.pcert1 : workshops/1999/mu-calculus/solutions/fixpoints.pcert0
-workshops/1999/mu-calculus/solutions/fixpoints.cert : | workshops/1999/mu-calculus/solutions/fixpoints.pcert1
-
-workshops/1999/mu-calculus/solutions/meta.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/meta.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/meta.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/1999/mu-calculus/solutions/meta.lisp
-workshops/1999/mu-calculus/solutions/meta.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/meta.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/meta.pcert1 : workshops/1999/mu-calculus/solutions/meta.pcert0
-workshops/1999/mu-calculus/solutions/meta.cert : | workshops/1999/mu-calculus/solutions/meta.pcert1
-
-workshops/1999/mu-calculus/solutions/models.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/models.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/models.pcert0 : \
-     workshops/1999/mu-calculus/solutions/relations.pcert0 \
-     workshops/1999/mu-calculus/solutions/models.lisp \
-     workshops/1999/mu-calculus/solutions/models.acl2
-workshops/1999/mu-calculus/solutions/models.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/models.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/models.pcert1 : workshops/1999/mu-calculus/solutions/models.pcert0
-workshops/1999/mu-calculus/solutions/models.cert : | workshops/1999/mu-calculus/solutions/models.pcert1
-
-workshops/1999/mu-calculus/solutions/perm.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/perm.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/perm.pcert0 : \
-     workshops/1999/mu-calculus/solutions/defung.pcert0 \
-     workshops/1999/mu-calculus/solutions/perm.lisp
-workshops/1999/mu-calculus/solutions/perm.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/perm.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/perm.pcert1 : workshops/1999/mu-calculus/solutions/perm.pcert0
-workshops/1999/mu-calculus/solutions/perm.cert : | workshops/1999/mu-calculus/solutions/perm.pcert1
-
-workshops/1999/mu-calculus/solutions/relations.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/relations.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/relations.pcert0 : \
-     workshops/1999/mu-calculus/solutions/fast-sets.pcert0 \
-     workshops/1999/mu-calculus/solutions/relations.lisp \
-     workshops/1999/mu-calculus/solutions/relations.acl2
-workshops/1999/mu-calculus/solutions/relations.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/relations.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/relations.pcert1 : workshops/1999/mu-calculus/solutions/relations.pcert0
-workshops/1999/mu-calculus/solutions/relations.cert : | workshops/1999/mu-calculus/solutions/relations.pcert1
-
-workshops/1999/mu-calculus/solutions/semantics.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/semantics.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/semantics.pcert0 : \
-     workshops/1999/mu-calculus/solutions/syntax.pcert0 \
-     workshops/1999/mu-calculus/solutions/fixpoints.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/1999/mu-calculus/solutions/semantics.lisp \
-     workshops/1999/mu-calculus/solutions/semantics.acl2
-workshops/1999/mu-calculus/solutions/semantics.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/semantics.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/semantics.pcert1 : workshops/1999/mu-calculus/solutions/semantics.pcert0
-workshops/1999/mu-calculus/solutions/semantics.cert : | workshops/1999/mu-calculus/solutions/semantics.pcert1
-
-workshops/1999/mu-calculus/solutions/sets.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/sets.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/sets.pcert0 : \
-     workshops/1999/mu-calculus/solutions/defung.pcert0 \
-     workshops/1999/mu-calculus/solutions/meta.pcert0 \
-     workshops/1999/mu-calculus/solutions/perm.pcert0 \
-     workshops/1999/mu-calculus/solutions/sets.lisp \
-     workshops/1999/mu-calculus/solutions/sets.acl2
-workshops/1999/mu-calculus/solutions/sets.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/sets.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/sets.pcert1 : workshops/1999/mu-calculus/solutions/sets.pcert0
-workshops/1999/mu-calculus/solutions/sets.cert : | workshops/1999/mu-calculus/solutions/sets.pcert1
-
-workshops/1999/mu-calculus/solutions/syntax.pcert0 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/syntax.pcert0 : acl2x = 0
-workshops/1999/mu-calculus/solutions/syntax.pcert0 : \
-     workshops/1999/mu-calculus/solutions/models.pcert0 \
-     workshops/1999/mu-calculus/solutions/syntax.lisp \
-     workshops/1999/mu-calculus/solutions/syntax.acl2
-workshops/1999/mu-calculus/solutions/syntax.pcert1 : acl2x = 0
-workshops/1999/mu-calculus/solutions/syntax.pcert1 : no_pcert = 0
-workshops/1999/mu-calculus/solutions/syntax.pcert1 : workshops/1999/mu-calculus/solutions/syntax.pcert0
-workshops/1999/mu-calculus/solutions/syntax.cert : | workshops/1999/mu-calculus/solutions/syntax.pcert1
-
-workshops/1999/pipeline/b-ops-aux-def.pcert0 : no_pcert = 0
-workshops/1999/pipeline/b-ops-aux-def.pcert0 : acl2x = 0
-workshops/1999/pipeline/b-ops-aux-def.pcert0 : \
-     workshops/1999/pipeline/trivia.pcert0 \
-     workshops/1999/pipeline/ihs.pcert0 \
-     workshops/1999/pipeline/b-ops-aux-def.lisp
-workshops/1999/pipeline/b-ops-aux-def.pcert1 : acl2x = 0
-workshops/1999/pipeline/b-ops-aux-def.pcert1 : no_pcert = 0
-workshops/1999/pipeline/b-ops-aux-def.pcert1 : workshops/1999/pipeline/b-ops-aux-def.pcert0
-workshops/1999/pipeline/b-ops-aux-def.cert : | workshops/1999/pipeline/b-ops-aux-def.pcert1
-
-workshops/1999/pipeline/b-ops-aux.pcert0 : no_pcert = 0
-workshops/1999/pipeline/b-ops-aux.pcert0 : acl2x = 0
-workshops/1999/pipeline/b-ops-aux.pcert0 : \
-     workshops/1999/pipeline/b-ops-aux-def.pcert0 \
-     workshops/1999/pipeline/b-ops-aux.lisp
-workshops/1999/pipeline/b-ops-aux.pcert1 : acl2x = 0
-workshops/1999/pipeline/b-ops-aux.pcert1 : no_pcert = 0
-workshops/1999/pipeline/b-ops-aux.pcert1 : workshops/1999/pipeline/b-ops-aux.pcert0
-workshops/1999/pipeline/b-ops-aux.cert : | workshops/1999/pipeline/b-ops-aux.pcert1
-
-workshops/1999/pipeline/basic-def.pcert0 : no_pcert = 0
-workshops/1999/pipeline/basic-def.pcert0 : acl2x = 0
-workshops/1999/pipeline/basic-def.pcert0 : \
-     data-structures/array1.pcert0 \
-     data-structures/deflist.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     data-structures/structures.pcert0 \
-     workshops/1999/pipeline/ihs.pcert0 \
-     workshops/1999/pipeline/trivia.pcert0 \
-     workshops/1999/pipeline/b-ops-aux.pcert0 \
-     workshops/1999/pipeline/basic-def.lisp \
-     workshops/1999/pipeline/basic-def.acl2 \
-     workshops/1999/pipeline/define-u-package.lsp
-workshops/1999/pipeline/basic-def.pcert1 : acl2x = 0
-workshops/1999/pipeline/basic-def.pcert1 : no_pcert = 0
-workshops/1999/pipeline/basic-def.pcert1 : workshops/1999/pipeline/basic-def.pcert0
-workshops/1999/pipeline/basic-def.cert : | workshops/1999/pipeline/basic-def.pcert1
-
-workshops/1999/pipeline/basic-lemmas.pcert0 : no_pcert = 0
-workshops/1999/pipeline/basic-lemmas.pcert0 : acl2x = 0
-workshops/1999/pipeline/basic-lemmas.pcert0 : \
-     workshops/1999/pipeline/basic-def.pcert0 \
-     workshops/1999/pipeline/model.pcert0 \
-     workshops/1999/pipeline/table-def.pcert0 \
-     workshops/1999/pipeline/basic-lemmas.lisp
-workshops/1999/pipeline/basic-lemmas.pcert1 : acl2x = 0
-workshops/1999/pipeline/basic-lemmas.pcert1 : no_pcert = 0
-workshops/1999/pipeline/basic-lemmas.pcert1 : workshops/1999/pipeline/basic-lemmas.pcert0
-workshops/1999/pipeline/basic-lemmas.cert : | workshops/1999/pipeline/basic-lemmas.pcert1
-
-workshops/1999/pipeline/exercise.pcert0 : no_pcert = 0
-workshops/1999/pipeline/exercise.pcert0 : acl2x = 0
-workshops/1999/pipeline/exercise.pcert0 : \
-     workshops/1999/pipeline/exercise.lisp
-workshops/1999/pipeline/exercise.pcert1 : acl2x = 0
-workshops/1999/pipeline/exercise.pcert1 : no_pcert = 0
-workshops/1999/pipeline/exercise.pcert1 : workshops/1999/pipeline/exercise.pcert0
-workshops/1999/pipeline/exercise.cert : | workshops/1999/pipeline/exercise.pcert1
-
-workshops/1999/pipeline/ihs.pcert0 : no_pcert = 0
-workshops/1999/pipeline/ihs.pcert0 : acl2x = 0
-workshops/1999/pipeline/ihs.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     workshops/1999/pipeline/ihs.lisp
-workshops/1999/pipeline/ihs.pcert1 : acl2x = 0
-workshops/1999/pipeline/ihs.pcert1 : no_pcert = 0
-workshops/1999/pipeline/ihs.pcert1 : workshops/1999/pipeline/ihs.pcert0
-workshops/1999/pipeline/ihs.cert : | workshops/1999/pipeline/ihs.pcert1
-
-workshops/1999/pipeline/model.pcert0 : no_pcert = 0
-workshops/1999/pipeline/model.pcert0 : acl2x = 0
-workshops/1999/pipeline/model.pcert0 : \
-     workshops/1999/pipeline/basic-def.pcert0 \
-     workshops/1999/pipeline/model.lisp
-workshops/1999/pipeline/model.pcert1 : acl2x = 0
-workshops/1999/pipeline/model.pcert1 : no_pcert = 0
-workshops/1999/pipeline/model.pcert1 : workshops/1999/pipeline/model.pcert0
-workshops/1999/pipeline/model.cert : | workshops/1999/pipeline/model.pcert1
-
-workshops/1999/pipeline/proof.pcert0 : no_pcert = 0
-workshops/1999/pipeline/proof.pcert0 : acl2x = 0
-workshops/1999/pipeline/proof.pcert0 : \
-     workshops/1999/pipeline/basic-def.pcert0 \
-     workshops/1999/pipeline/model.pcert0 \
-     workshops/1999/pipeline/table-def.pcert0 \
-     workshops/1999/pipeline/basic-lemmas.pcert0 \
-     workshops/1999/pipeline/proof.lisp
-workshops/1999/pipeline/proof.pcert1 : acl2x = 0
-workshops/1999/pipeline/proof.pcert1 : no_pcert = 0
-workshops/1999/pipeline/proof.pcert1 : workshops/1999/pipeline/proof.pcert0
-workshops/1999/pipeline/proof.cert : | workshops/1999/pipeline/proof.pcert1
-
-workshops/1999/pipeline/table-def.pcert0 : no_pcert = 0
-workshops/1999/pipeline/table-def.pcert0 : acl2x = 0
-workshops/1999/pipeline/table-def.pcert0 : \
-     workshops/1999/pipeline/utils.pcert0 \
-     workshops/1999/pipeline/basic-def.pcert0 \
-     workshops/1999/pipeline/model.pcert0 \
-     workshops/1999/pipeline/table-def.lisp
-workshops/1999/pipeline/table-def.pcert1 : acl2x = 0
-workshops/1999/pipeline/table-def.pcert1 : no_pcert = 0
-workshops/1999/pipeline/table-def.pcert1 : workshops/1999/pipeline/table-def.pcert0
-workshops/1999/pipeline/table-def.cert : | workshops/1999/pipeline/table-def.pcert1
-
-workshops/1999/pipeline/trivia.pcert0 : no_pcert = 0
-workshops/1999/pipeline/trivia.pcert0 : acl2x = 0
-workshops/1999/pipeline/trivia.pcert0 : \
-     data-structures/array1.pcert0 \
-     arithmetic/top.pcert0 \
-     workshops/1999/pipeline/trivia.lisp
-workshops/1999/pipeline/trivia.pcert1 : acl2x = 0
-workshops/1999/pipeline/trivia.pcert1 : no_pcert = 0
-workshops/1999/pipeline/trivia.pcert1 : workshops/1999/pipeline/trivia.pcert0
-workshops/1999/pipeline/trivia.cert : | workshops/1999/pipeline/trivia.pcert1
-
-workshops/1999/pipeline/utils.pcert0 : no_pcert = 0
-workshops/1999/pipeline/utils.pcert0 : acl2x = 0
-workshops/1999/pipeline/utils.pcert0 : \
-     data-structures/utilities.pcert0 \
-     workshops/1999/pipeline/utils.lisp \
-     workshops/1999/pipeline/utils.acl2 \
-     workshops/1999/pipeline/define-u-package.lsp
-workshops/1999/pipeline/utils.pcert1 : acl2x = 0
-workshops/1999/pipeline/utils.pcert1 : no_pcert = 0
-workshops/1999/pipeline/utils.pcert1 : workshops/1999/pipeline/utils.pcert0
-workshops/1999/pipeline/utils.cert : | workshops/1999/pipeline/utils.pcert1
-
-workshops/1999/simulator/exercises.pcert0 : no_pcert = 0
-workshops/1999/simulator/exercises.pcert0 : acl2x = 0
-workshops/1999/simulator/exercises.pcert0 : \
-     workshops/1999/simulator/tiny.pcert0 \
-     workshops/1999/simulator/exercises.lisp
-workshops/1999/simulator/exercises.pcert1 : acl2x = 0
-workshops/1999/simulator/exercises.pcert1 : no_pcert = 0
-workshops/1999/simulator/exercises.pcert1 : workshops/1999/simulator/exercises.pcert0
-workshops/1999/simulator/exercises.cert : | workshops/1999/simulator/exercises.pcert1
-
-workshops/1999/simulator/tiny.pcert0 : no_pcert = 0
-workshops/1999/simulator/tiny.pcert0 : acl2x = 0
-workshops/1999/simulator/tiny.pcert0 : \
-     arithmetic/top.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     meta/meta.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/1999/simulator/tiny.lisp
-workshops/1999/simulator/tiny.pcert1 : acl2x = 0
-workshops/1999/simulator/tiny.pcert1 : no_pcert = 0
-workshops/1999/simulator/tiny.pcert1 : workshops/1999/simulator/tiny.pcert0
-workshops/1999/simulator/tiny.cert : | workshops/1999/simulator/tiny.pcert1
-
-workshops/1999/ste/assertion.pcert0 : no_pcert = 0
-workshops/1999/ste/assertion.pcert0 : acl2x = 0
-workshops/1999/ste/assertion.pcert0 : \
-     workshops/1999/ste/trajectory.pcert0 \
-     workshops/1999/ste/assertion.lisp
-workshops/1999/ste/assertion.pcert1 : acl2x = 0
-workshops/1999/ste/assertion.pcert1 : no_pcert = 0
-workshops/1999/ste/assertion.pcert1 : workshops/1999/ste/assertion.pcert0
-workshops/1999/ste/assertion.cert : | workshops/1999/ste/assertion.pcert1
-
-workshops/1999/ste/boolean.pcert0 : no_pcert = 0
-workshops/1999/ste/boolean.pcert0 : acl2x = 0
-workshops/1999/ste/boolean.pcert0 : \
-     workshops/1999/ste/util.pcert0 \
-     workshops/1999/ste/boolean.lisp
-workshops/1999/ste/boolean.pcert1 : acl2x = 0
-workshops/1999/ste/boolean.pcert1 : no_pcert = 0
-workshops/1999/ste/boolean.pcert1 : workshops/1999/ste/boolean.pcert0
-workshops/1999/ste/boolean.cert : | workshops/1999/ste/boolean.pcert1
-
-workshops/1999/ste/circuit.pcert0 : no_pcert = 0
-workshops/1999/ste/circuit.pcert0 : acl2x = 0
-workshops/1999/ste/circuit.pcert0 : \
-     workshops/1999/ste/expression.pcert0 \
-     workshops/1999/ste/circuit.lisp
-workshops/1999/ste/circuit.pcert1 : acl2x = 0
-workshops/1999/ste/circuit.pcert1 : no_pcert = 0
-workshops/1999/ste/circuit.pcert1 : workshops/1999/ste/circuit.pcert0
-workshops/1999/ste/circuit.cert : | workshops/1999/ste/circuit.pcert1
-
-workshops/1999/ste/example.pcert0 : no_pcert = 0
-workshops/1999/ste/example.pcert0 : acl2x = 0
-workshops/1999/ste/example.pcert0 : \
-     workshops/1999/ste/inference.pcert0 \
-     workshops/1999/ste/example.lisp
-workshops/1999/ste/example.pcert1 : acl2x = 0
-workshops/1999/ste/example.pcert1 : no_pcert = 0
-workshops/1999/ste/example.pcert1 : workshops/1999/ste/example.pcert0
-workshops/1999/ste/example.cert : | workshops/1999/ste/example.pcert1
-
-workshops/1999/ste/expression.pcert0 : no_pcert = 0
-workshops/1999/ste/expression.pcert0 : acl2x = 0
-workshops/1999/ste/expression.pcert0 : \
-     workshops/1999/ste/run.pcert0 \
-     workshops/1999/ste/expression.lisp
-workshops/1999/ste/expression.pcert1 : acl2x = 0
-workshops/1999/ste/expression.pcert1 : no_pcert = 0
-workshops/1999/ste/expression.pcert1 : workshops/1999/ste/expression.pcert0
-workshops/1999/ste/expression.cert : | workshops/1999/ste/expression.pcert1
-
-workshops/1999/ste/fundamental.pcert0 : no_pcert = 0
-workshops/1999/ste/fundamental.pcert0 : acl2x = 0
-workshops/1999/ste/fundamental.pcert0 : \
-     workshops/1999/ste/lemma-4.pcert0 \
-     workshops/1999/ste/fundamental.lisp
-workshops/1999/ste/fundamental.pcert1 : acl2x = 0
-workshops/1999/ste/fundamental.pcert1 : no_pcert = 0
-workshops/1999/ste/fundamental.pcert1 : workshops/1999/ste/fundamental.pcert0
-workshops/1999/ste/fundamental.cert : | workshops/1999/ste/fundamental.pcert1
-
-workshops/1999/ste/inference.pcert0 : no_pcert = 0
-workshops/1999/ste/inference.pcert0 : acl2x = 0
-workshops/1999/ste/inference.pcert0 : \
-     workshops/1999/ste/fundamental.pcert0 \
-     workshops/1999/ste/inference.lisp
-workshops/1999/ste/inference.pcert1 : acl2x = 0
-workshops/1999/ste/inference.pcert1 : no_pcert = 0
-workshops/1999/ste/inference.pcert1 : workshops/1999/ste/inference.pcert0
-workshops/1999/ste/inference.cert : | workshops/1999/ste/inference.pcert1
-
-workshops/1999/ste/lemma-4.pcert0 : no_pcert = 0
-workshops/1999/ste/lemma-4.pcert0 : acl2x = 0
-workshops/1999/ste/lemma-4.pcert0 : \
-     workshops/1999/ste/assertion.pcert0 \
-     workshops/1999/ste/lemma-4.lisp
-workshops/1999/ste/lemma-4.pcert1 : acl2x = 0
-workshops/1999/ste/lemma-4.pcert1 : no_pcert = 0
-workshops/1999/ste/lemma-4.pcert1 : workshops/1999/ste/lemma-4.pcert0
-workshops/1999/ste/lemma-4.cert : | workshops/1999/ste/lemma-4.pcert1
-
-workshops/1999/ste/run.pcert0 : no_pcert = 0
-workshops/1999/ste/run.pcert0 : acl2x = 0
-workshops/1999/ste/run.pcert0 : \
-     workshops/1999/ste/state.pcert0 \
-     workshops/1999/ste/run.lisp
-workshops/1999/ste/run.pcert1 : acl2x = 0
-workshops/1999/ste/run.pcert1 : no_pcert = 0
-workshops/1999/ste/run.pcert1 : workshops/1999/ste/run.pcert0
-workshops/1999/ste/run.cert : | workshops/1999/ste/run.pcert1
-
-workshops/1999/ste/state.pcert0 : no_pcert = 0
-workshops/1999/ste/state.pcert0 : acl2x = 0
-workshops/1999/ste/state.pcert0 : \
-     workshops/1999/ste/boolean.pcert0 \
-     workshops/1999/ste/state.lisp
-workshops/1999/ste/state.pcert1 : acl2x = 0
-workshops/1999/ste/state.pcert1 : no_pcert = 0
-workshops/1999/ste/state.pcert1 : workshops/1999/ste/state.pcert0
-workshops/1999/ste/state.cert : | workshops/1999/ste/state.pcert1
-
-workshops/1999/ste/trajectory.pcert0 : no_pcert = 0
-workshops/1999/ste/trajectory.pcert0 : acl2x = 0
-workshops/1999/ste/trajectory.pcert0 : \
-     workshops/1999/ste/circuit.pcert0 \
-     workshops/1999/ste/trajectory.lisp
-workshops/1999/ste/trajectory.pcert1 : acl2x = 0
-workshops/1999/ste/trajectory.pcert1 : no_pcert = 0
-workshops/1999/ste/trajectory.pcert1 : workshops/1999/ste/trajectory.pcert0
-workshops/1999/ste/trajectory.cert : | workshops/1999/ste/trajectory.pcert1
-
-workshops/1999/ste/util.pcert0 : no_pcert = 0
-workshops/1999/ste/util.pcert0 : acl2x = 0
-workshops/1999/ste/util.pcert0 : \
-     data-structures/utilities.pcert0 \
-     data-structures/list-theory.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/1999/ste/util.lisp
-workshops/1999/ste/util.pcert1 : acl2x = 0
-workshops/1999/ste/util.pcert1 : no_pcert = 0
-workshops/1999/ste/util.pcert1 : workshops/1999/ste/util.pcert0
-workshops/1999/ste/util.cert : | workshops/1999/ste/util.pcert1
-
-workshops/1999/vhdl/exercises.pcert0 : no_pcert = 0
-workshops/1999/vhdl/exercises.pcert0 : acl2x = 0
-workshops/1999/vhdl/exercises.pcert0 : \
-     workshops/1999/vhdl/fact.pcert0 \
-     workshops/1999/vhdl/exercises.lisp
-workshops/1999/vhdl/exercises.pcert1 : acl2x = 0
-workshops/1999/vhdl/exercises.pcert1 : no_pcert = 0
-workshops/1999/vhdl/exercises.pcert1 : workshops/1999/vhdl/exercises.pcert0
-workshops/1999/vhdl/exercises.cert : | workshops/1999/vhdl/exercises.pcert1
-
-workshops/1999/vhdl/fact-proof.pcert0 : no_pcert = 0
-workshops/1999/vhdl/fact-proof.pcert0 : acl2x = 0
-workshops/1999/vhdl/fact-proof.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/1999/vhdl/fact.pcert0 \
-     workshops/1999/vhdl/fact-proof.lisp
-workshops/1999/vhdl/fact-proof.pcert1 : acl2x = 0
-workshops/1999/vhdl/fact-proof.pcert1 : no_pcert = 0
-workshops/1999/vhdl/fact-proof.pcert1 : workshops/1999/vhdl/fact-proof.pcert0
-workshops/1999/vhdl/fact-proof.cert : | workshops/1999/vhdl/fact-proof.pcert1
-
-workshops/1999/vhdl/fact.pcert0 : no_pcert = 0
-workshops/1999/vhdl/fact.pcert0 : acl2x = 0
-workshops/1999/vhdl/fact.pcert0 : \
-     workshops/1999/vhdl/vhdl.pcert0 \
-     workshops/1999/vhdl/fact.lisp
-workshops/1999/vhdl/fact.pcert1 : acl2x = 0
-workshops/1999/vhdl/fact.pcert1 : no_pcert = 0
-workshops/1999/vhdl/fact.pcert1 : workshops/1999/vhdl/fact.pcert0
-workshops/1999/vhdl/fact.cert : | workshops/1999/vhdl/fact.pcert1
-
-workshops/1999/vhdl/vhdl.pcert0 : no_pcert = 0
-workshops/1999/vhdl/vhdl.pcert0 : acl2x = 0
-workshops/1999/vhdl/vhdl.pcert0 : \
-     workshops/1999/vhdl/vhdl.lisp
-workshops/1999/vhdl/vhdl.pcert1 : acl2x = 0
-workshops/1999/vhdl/vhdl.pcert1 : no_pcert = 0
-workshops/1999/vhdl/vhdl.pcert1 : workshops/1999/vhdl/vhdl.pcert0
-workshops/1999/vhdl/vhdl.cert : | workshops/1999/vhdl/vhdl.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/base.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/base.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/compile.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/compile.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/compile.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/compile.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/cstate.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/cstate.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/expr.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/expr.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/base.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/lstate.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/lstate.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/cstate.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/lstate.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/expr.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/pstate.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/pstate.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/pstate.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/setup.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/setup.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert0 \
-     arithmetic/mod-gcd.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/simulator.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/simulator.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/simulator.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/simulator.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/mstate.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/setup.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.pcert0 \
-     workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.pcert1
-
-workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert0 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert0 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert0 : \
-     workshops/2000/lusk-mccune/lusk-mccune-final/util.lisp
-workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert1 : acl2x = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert1 : no_pcert = 0
-workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert1 : workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert0
-workshops/2000/lusk-mccune/lusk-mccune-final/util.cert : | workshops/2000/lusk-mccune/lusk-mccune-final/util.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.lisp
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert1 : workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert0
-workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert : | workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.lisp
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert1 : workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert0
-workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert : | workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/alist-thms.lisp
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert1 : workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert0
-workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert : | workshops/2000/manolios/pipeline/pipeline/top/alist-thms.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.lisp
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert1 : workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert0
-workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert : | workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/ihs.lisp
-workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert1 : workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert0
-workshops/2000/manolios/pipeline/pipeline/top/ihs.cert : | workshops/2000/manolios/pipeline/pipeline/top/ihs.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2000/manolios/pipeline/pipeline/top/meta.lisp
-workshops/2000/manolios/pipeline/pipeline/top/meta.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/meta.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/meta.pcert1 : workshops/2000/manolios/pipeline/pipeline/top/meta.pcert0
-workshops/2000/manolios/pipeline/pipeline/top/meta.cert : | workshops/2000/manolios/pipeline/pipeline/top/meta.pcert1
-
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0 : \
-     workshops/2000/manolios/pipeline/pipeline/top/nth-thms.lisp
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert1 : workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert0
-workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert : | workshops/2000/manolios/pipeline/pipeline/top/nth-thms.pcert1
-
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/trivia.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/ihs.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.lisp
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert1 : workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.cert : | workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert1
-
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux.lisp
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert1 : workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert0
-workshops/2000/manolios/pipeline/trivial/b-ops-aux.cert : | workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert1
-
-workshops/2000/manolios/pipeline/trivial/basic-def.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/basic-def.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/basic-def.pcert0 : \
-     data-structures/array1.pcert0 \
-     data-structures/deflist.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     data-structures/structures.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/ihs.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/trivia.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/b-ops-aux.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/basic-def.lisp \
-     workshops/2000/manolios/pipeline/trivial/basic-def.acl2 \
-     workshops/2000/manolios/pipeline/trivial/define-u-package.lsp
-workshops/2000/manolios/pipeline/trivial/basic-def.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/basic-def.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/basic-def.pcert1 : workshops/2000/manolios/pipeline/trivial/basic-def.pcert0
-workshops/2000/manolios/pipeline/trivial/basic-def.cert : | workshops/2000/manolios/pipeline/trivial/basic-def.pcert1
-
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/basic-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/model.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/table-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/basic-lemmas.lisp
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.pcert1 : workshops/2000/manolios/pipeline/trivial/basic-lemmas.pcert0
-workshops/2000/manolios/pipeline/trivial/basic-lemmas.cert : | workshops/2000/manolios/pipeline/trivial/basic-lemmas.pcert1
-
-workshops/2000/manolios/pipeline/trivial/ihs.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/ihs.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/ihs.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/ihs.lisp
-workshops/2000/manolios/pipeline/trivial/ihs.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/ihs.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/ihs.pcert1 : workshops/2000/manolios/pipeline/trivial/ihs.pcert0
-workshops/2000/manolios/pipeline/trivial/ihs.cert : | workshops/2000/manolios/pipeline/trivial/ihs.pcert1
-
-workshops/2000/manolios/pipeline/trivial/model.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/model.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/model.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/basic-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/model.lisp
-workshops/2000/manolios/pipeline/trivial/model.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/model.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/model.pcert1 : workshops/2000/manolios/pipeline/trivial/model.pcert0
-workshops/2000/manolios/pipeline/trivial/model.cert : | workshops/2000/manolios/pipeline/trivial/model.pcert1
-
-workshops/2000/manolios/pipeline/trivial/proof.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/proof.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/proof.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/model.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/proof.lisp
-workshops/2000/manolios/pipeline/trivial/proof.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/proof.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/proof.pcert1 : workshops/2000/manolios/pipeline/trivial/proof.pcert0
-workshops/2000/manolios/pipeline/trivial/proof.cert : | workshops/2000/manolios/pipeline/trivial/proof.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.lisp
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.lisp
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert0 : \
-     data-structures/array1.pcert0 \
-     data-structures/deflist.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     data-structures/structures.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.lisp \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.acl2 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/define-u-package.lsp
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.lisp
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.lisp
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.lisp
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/proof.lisp
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/proof.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/proof.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/proof.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/model.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.lisp
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert0 : \
-     data-structures/array1.pcert0 \
-     arithmetic/top.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.lisp
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.pcert1
-
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert0 : \
-     data-structures/utilities.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.lisp \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/utils.acl2 \
-     workshops/2000/manolios/pipeline/trivial/sawada-model/define-u-package.lsp
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert1 : workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert0
-workshops/2000/manolios/pipeline/trivial/sawada-model/utils.cert : | workshops/2000/manolios/pipeline/trivial/sawada-model/utils.pcert1
-
-workshops/2000/manolios/pipeline/trivial/table-def.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/table-def.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/table-def.pcert0 : \
-     workshops/2000/manolios/pipeline/trivial/utils.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/basic-def.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/model.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/table-def.lisp
-workshops/2000/manolios/pipeline/trivial/table-def.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/table-def.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/table-def.pcert1 : workshops/2000/manolios/pipeline/trivial/table-def.pcert0
-workshops/2000/manolios/pipeline/trivial/table-def.cert : | workshops/2000/manolios/pipeline/trivial/table-def.pcert1
-
-workshops/2000/manolios/pipeline/trivial/trivia.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/trivia.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/trivia.pcert0 : \
-     data-structures/array1.pcert0 \
-     arithmetic/top.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/trivia.lisp
-workshops/2000/manolios/pipeline/trivial/trivia.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/trivia.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/trivia.pcert1 : workshops/2000/manolios/pipeline/trivial/trivia.pcert0
-workshops/2000/manolios/pipeline/trivial/trivia.cert : | workshops/2000/manolios/pipeline/trivial/trivia.pcert1
-
-workshops/2000/manolios/pipeline/trivial/utils.pcert0 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/utils.pcert0 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/utils.pcert0 : \
-     data-structures/utilities.pcert0 \
-     workshops/2000/manolios/pipeline/trivial/utils.lisp \
-     workshops/2000/manolios/pipeline/trivial/utils.acl2 \
-     workshops/2000/manolios/pipeline/trivial/define-u-package.lsp
-workshops/2000/manolios/pipeline/trivial/utils.pcert1 : acl2x = 0
-workshops/2000/manolios/pipeline/trivial/utils.pcert1 : no_pcert = 0
-workshops/2000/manolios/pipeline/trivial/utils.pcert1 : workshops/2000/manolios/pipeline/trivial/utils.pcert0
-workshops/2000/manolios/pipeline/trivial/utils.cert : | workshops/2000/manolios/pipeline/trivial/utils.pcert1
-
-workshops/2000/medina/polynomials/addition.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/addition.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/addition.pcert0 : \
-     workshops/2000/medina/polynomials/normal-form.pcert0 \
-     workshops/2000/medina/polynomials/addition.lisp \
-     workshops/2000/medina/polynomials/addition.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/addition.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/addition.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/addition.pcert1 : workshops/2000/medina/polynomials/addition.pcert0
-workshops/2000/medina/polynomials/addition.cert : | workshops/2000/medina/polynomials/addition.pcert1
-
-workshops/2000/medina/polynomials/congruences-1.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/congruences-1.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/congruences-1.pcert0 : \
-     workshops/2000/medina/polynomials/negation.pcert0 \
-     workshops/2000/medina/polynomials/congruences-1.lisp \
-     workshops/2000/medina/polynomials/congruences-1.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/congruences-1.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/congruences-1.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/congruences-1.pcert1 : workshops/2000/medina/polynomials/congruences-1.pcert0
-workshops/2000/medina/polynomials/congruences-1.cert : | workshops/2000/medina/polynomials/congruences-1.pcert1
-
-workshops/2000/medina/polynomials/congruences-2.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/congruences-2.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/congruences-2.pcert0 : \
-     workshops/2000/medina/polynomials/multiplication.pcert0 \
-     workshops/2000/medina/polynomials/congruences-2.lisp \
-     workshops/2000/medina/polynomials/congruences-2.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/congruences-2.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/congruences-2.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/congruences-2.pcert1 : workshops/2000/medina/polynomials/congruences-2.pcert0
-workshops/2000/medina/polynomials/congruences-2.cert : | workshops/2000/medina/polynomials/congruences-2.pcert1
-
-workshops/2000/medina/polynomials/examples.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/examples.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/examples.pcert0 : \
-     workshops/2000/medina/polynomials/congruences-2.pcert0 \
-     workshops/2000/medina/polynomials/examples.lisp \
-     workshops/2000/medina/polynomials/examples.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/examples.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/examples.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/examples.pcert1 : workshops/2000/medina/polynomials/examples.pcert0
-workshops/2000/medina/polynomials/examples.cert : | workshops/2000/medina/polynomials/examples.pcert1
-
-workshops/2000/medina/polynomials/lexicographical-ordering.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/lexicographical-ordering.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/lexicographical-ordering.pcert0 : \
-     workshops/2000/medina/polynomials/term.pcert0 \
-     ordinals/ordinals-without-arithmetic.pcert0 \
-     workshops/2000/medina/polynomials/lexicographical-ordering.lisp \
-     workshops/2000/medina/polynomials/lexicographical-ordering.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/lexicographical-ordering.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/lexicographical-ordering.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/lexicographical-ordering.pcert1 : workshops/2000/medina/polynomials/lexicographical-ordering.pcert0
-workshops/2000/medina/polynomials/lexicographical-ordering.cert : | workshops/2000/medina/polynomials/lexicographical-ordering.pcert1
-
-workshops/2000/medina/polynomials/monomial.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/monomial.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/monomial.pcert0 : \
-     workshops/2000/medina/polynomials/term.pcert0 \
-     workshops/2000/medina/polynomials/monomial.lisp \
-     workshops/2000/medina/polynomials/monomial.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/monomial.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/monomial.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/monomial.pcert1 : workshops/2000/medina/polynomials/monomial.pcert0
-workshops/2000/medina/polynomials/monomial.cert : | workshops/2000/medina/polynomials/monomial.pcert1
-
-workshops/2000/medina/polynomials/multiplication.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/multiplication.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/multiplication.pcert0 : \
-     workshops/2000/medina/polynomials/congruences-1.pcert0 \
-     workshops/2000/medina/polynomials/multiplication.lisp \
-     workshops/2000/medina/polynomials/multiplication.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/multiplication.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/multiplication.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/multiplication.pcert1 : workshops/2000/medina/polynomials/multiplication.pcert0
-workshops/2000/medina/polynomials/multiplication.cert : | workshops/2000/medina/polynomials/multiplication.pcert1
-
-workshops/2000/medina/polynomials/negation.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/negation.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/negation.pcert0 : \
-     workshops/2000/medina/polynomials/addition.pcert0 \
-     workshops/2000/medina/polynomials/negation.lisp \
-     workshops/2000/medina/polynomials/negation.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/negation.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/negation.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/negation.pcert1 : workshops/2000/medina/polynomials/negation.pcert0
-workshops/2000/medina/polynomials/negation.cert : | workshops/2000/medina/polynomials/negation.pcert1
-
-workshops/2000/medina/polynomials/normal-form.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/normal-form.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/normal-form.pcert0 : \
-     workshops/2000/medina/polynomials/polynomial.pcert0 \
-     workshops/2000/medina/polynomials/lexicographical-ordering.pcert0 \
-     workshops/2000/medina/polynomials/normal-form.lisp \
-     workshops/2000/medina/polynomials/normal-form.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/normal-form.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/normal-form.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/normal-form.pcert1 : workshops/2000/medina/polynomials/normal-form.pcert0
-workshops/2000/medina/polynomials/normal-form.cert : | workshops/2000/medina/polynomials/normal-form.pcert1
-
-workshops/2000/medina/polynomials/polynomial.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/polynomial.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/polynomial.pcert0 : \
-     workshops/2000/medina/polynomials/monomial.pcert0 \
-     workshops/2000/medina/polynomials/polynomial.lisp \
-     workshops/2000/medina/polynomials/polynomial.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/polynomial.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/polynomial.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/polynomial.pcert1 : workshops/2000/medina/polynomials/polynomial.pcert0
-workshops/2000/medina/polynomials/polynomial.cert : | workshops/2000/medina/polynomials/polynomial.pcert1
-
-workshops/2000/medina/polynomials/term.pcert0 : no_pcert = 0
-workshops/2000/medina/polynomials/term.pcert0 : acl2x = 0
-workshops/2000/medina/polynomials/term.pcert0 : \
-     workshops/2000/medina/polynomials/term.lisp \
-     workshops/2000/medina/polynomials/term.acl2 \
-     workshops/2000/medina/polynomials/certification.acl2
-workshops/2000/medina/polynomials/term.pcert1 : acl2x = 0
-workshops/2000/medina/polynomials/term.pcert1 : no_pcert = 0
-workshops/2000/medina/polynomials/term.pcert1 : workshops/2000/medina/polynomials/term.pcert0
-workshops/2000/medina/polynomials/term.cert : | workshops/2000/medina/polynomials/term.pcert1
-
-workshops/2000/moore-manolios/partial-functions/defpun-original.pcert0 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/defpun-original.pcert0 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/defpun-original.pcert0 : \
-     workshops/2000/moore-manolios/partial-functions/defpun-original.lisp
-workshops/2000/moore-manolios/partial-functions/defpun-original.pcert1 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/defpun-original.pcert1 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/defpun-original.pcert1 : workshops/2000/moore-manolios/partial-functions/defpun-original.pcert0
-workshops/2000/moore-manolios/partial-functions/defpun-original.cert : | workshops/2000/moore-manolios/partial-functions/defpun-original.pcert1
-
-workshops/2000/moore-manolios/partial-functions/defpun.pcert0 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/defpun.pcert0 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/defpun.pcert0 : \
-     misc/defpun.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/defpun.lisp
-workshops/2000/moore-manolios/partial-functions/defpun.pcert1 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/defpun.pcert1 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/defpun.pcert1 : workshops/2000/moore-manolios/partial-functions/defpun.pcert0
-workshops/2000/moore-manolios/partial-functions/defpun.cert : | workshops/2000/moore-manolios/partial-functions/defpun.pcert1
-
-workshops/2000/moore-manolios/partial-functions/examples.pcert0 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/examples.pcert0 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/examples.pcert0 : \
-     workshops/2000/moore-manolios/partial-functions/tjvm.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/tjvm.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/examples.lisp \
-     workshops/2000/moore-manolios/partial-functions/examples.acl2
-workshops/2000/moore-manolios/partial-functions/examples.pcert1 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/examples.pcert1 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/examples.pcert1 : workshops/2000/moore-manolios/partial-functions/examples.pcert0
-workshops/2000/moore-manolios/partial-functions/examples.cert : | workshops/2000/moore-manolios/partial-functions/examples.pcert1
-
-workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert0 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert0 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert0 : \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/mod-1-property.lisp
-workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert1 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert1 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert1 : workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert0
-workshops/2000/moore-manolios/partial-functions/mod-1-property.cert : | workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert1
-
-workshops/2000/moore-manolios/partial-functions/report.pcert0 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/report.pcert0 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/report.pcert0 : \
-     workshops/2000/moore-manolios/partial-functions/defpun.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/mod-1-property.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/report.lisp
-workshops/2000/moore-manolios/partial-functions/report.pcert1 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/report.pcert1 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/report.pcert1 : workshops/2000/moore-manolios/partial-functions/report.pcert0
-workshops/2000/moore-manolios/partial-functions/report.cert : | workshops/2000/moore-manolios/partial-functions/report.pcert1
-
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert0 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert0 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert0 : \
-     workshops/2000/moore-manolios/partial-functions/defpun.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/examples.pcert0 \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.lisp \
-     workshops/2000/moore-manolios/partial-functions/tjvm-examples.acl2
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert1 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert1 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert1 : workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert0
-workshops/2000/moore-manolios/partial-functions/tjvm-examples.cert : | workshops/2000/moore-manolios/partial-functions/tjvm-examples.pcert1
-
-workshops/2000/moore-manolios/partial-functions/tjvm.pcert0 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/tjvm.pcert0 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/tjvm.pcert0 : \
-     workshops/2000/moore-manolios/partial-functions/tjvm.lisp \
-     workshops/2000/moore-manolios/partial-functions/tjvm.acl2
-workshops/2000/moore-manolios/partial-functions/tjvm.pcert1 : acl2x = 0
-workshops/2000/moore-manolios/partial-functions/tjvm.pcert1 : no_pcert = 0
-workshops/2000/moore-manolios/partial-functions/tjvm.pcert1 : workshops/2000/moore-manolios/partial-functions/tjvm.pcert0
-workshops/2000/moore-manolios/partial-functions/tjvm.cert : | workshops/2000/moore-manolios/partial-functions/tjvm.pcert1
-
-workshops/2000/ruiz/multiset/defmul.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/defmul.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/defmul.pcert0 : \
-     workshops/2000/ruiz/multiset/multiset.pcert0 \
-     workshops/2000/ruiz/multiset/defmul.lisp \
-     workshops/2000/ruiz/multiset/defmul.acl2
-workshops/2000/ruiz/multiset/defmul.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/defmul.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/defmul.pcert1 : workshops/2000/ruiz/multiset/defmul.pcert0
-workshops/2000/ruiz/multiset/defmul.cert : | workshops/2000/ruiz/multiset/defmul.pcert1
-
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.pcert0 : \
-     workshops/2000/ruiz/multiset/defmul.pcert0 \
-     workshops/2000/ruiz/multiset/examples/ackermann/ackermann.lisp
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.pcert1 : workshops/2000/ruiz/multiset/examples/ackermann/ackermann.pcert0
-workshops/2000/ruiz/multiset/examples/ackermann/ackermann.cert : | workshops/2000/ruiz/multiset/examples/ackermann/ackermann.pcert1
-
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.pcert0 : \
-     workshops/2000/ruiz/multiset/defmul.pcert0 \
-     workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.lisp
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.pcert1 : workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.pcert0
-workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.cert : | workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.pcert1
-
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert0 : \
-     data-structures/structures.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.lisp
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert1 : workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert0
-workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert : | workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert1
-
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.pcert0 : \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert0 \
-     workshops/2000/ruiz/multiset/examples/newman/confluence-v0.lisp \
-     workshops/2000/ruiz/multiset/examples/newman/confluence-v0.acl2
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.pcert1 : workshops/2000/ruiz/multiset/examples/newman/confluence-v0.pcert0
-workshops/2000/ruiz/multiset/examples/newman/confluence-v0.cert : | workshops/2000/ruiz/multiset/examples/newman/confluence-v0.pcert1
-
-workshops/2000/ruiz/multiset/examples/newman/confluence.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence.pcert0 : \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert0 \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.lisp \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.acl2
-workshops/2000/ruiz/multiset/examples/newman/confluence.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/confluence.pcert1 : workshops/2000/ruiz/multiset/examples/newman/confluence.pcert0
-workshops/2000/ruiz/multiset/examples/newman/confluence.cert : | workshops/2000/ruiz/multiset/examples/newman/confluence.pcert1
-
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.pcert0 : \
-     workshops/2000/ruiz/multiset/examples/newman/confluence.pcert0 \
-     workshops/2000/ruiz/multiset/examples/newman/newman.pcert0 \
-     workshops/2000/ruiz/multiset/examples/newman/local-confluence.lisp \
-     workshops/2000/ruiz/multiset/examples/newman/local-confluence.acl2
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.pcert1 : workshops/2000/ruiz/multiset/examples/newman/local-confluence.pcert0
-workshops/2000/ruiz/multiset/examples/newman/local-confluence.cert : | workshops/2000/ruiz/multiset/examples/newman/local-confluence.pcert1
-
-workshops/2000/ruiz/multiset/examples/newman/newman.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/newman.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/newman.pcert0 : \
-     workshops/2000/ruiz/multiset/defmul.pcert0 \
-     ordinals/ordinals-without-arithmetic.pcert0 \
-     workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.pcert0 \
-     workshops/2000/ruiz/multiset/examples/newman/newman.lisp \
-     workshops/2000/ruiz/multiset/examples/newman/newman.acl2
-workshops/2000/ruiz/multiset/examples/newman/newman.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/examples/newman/newman.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/examples/newman/newman.pcert1 : workshops/2000/ruiz/multiset/examples/newman/newman.pcert0
-workshops/2000/ruiz/multiset/examples/newman/newman.cert : | workshops/2000/ruiz/multiset/examples/newman/newman.pcert1
-
-workshops/2000/ruiz/multiset/multiset.pcert0 : no_pcert = 0
-workshops/2000/ruiz/multiset/multiset.pcert0 : acl2x = 0
-workshops/2000/ruiz/multiset/multiset.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2000/ruiz/multiset/multiset.lisp \
-     workshops/2000/ruiz/multiset/multiset.acl2
-workshops/2000/ruiz/multiset/multiset.pcert1 : acl2x = 0
-workshops/2000/ruiz/multiset/multiset.pcert1 : no_pcert = 0
-workshops/2000/ruiz/multiset/multiset.pcert1 : workshops/2000/ruiz/multiset/multiset.pcert0
-workshops/2000/ruiz/multiset/multiset.cert : | workshops/2000/ruiz/multiset/multiset.pcert1
-
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert0 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert0 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert0 : \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert0 \
-     rtl/rel1/lib3/top.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert1 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert1 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert1 : workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert0
-workshops/2000/russinoff-kaufmann/supporting-materials/constants.cert : | workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert1
-
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert0 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert0 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert0 : \
-     rtl/rel1/lib3/top.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/declarations.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert1 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert1 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert1 : workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert0
-workshops/2000/russinoff-kaufmann/supporting-materials/declarations.cert : | workshops/2000/russinoff-kaufmann/supporting-materials/declarations.pcert1
-
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert0 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert0 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert0 : \
-     rtl/rel1/lib3/top.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/exec.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert1 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert1 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert1 : workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert0
-workshops/2000/russinoff-kaufmann/supporting-materials/exec.cert : | workshops/2000/russinoff-kaufmann/supporting-materials/exec.pcert1
-
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert0 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert0 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert0 : \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert0 \
-     rtl/rel1/lib3/top.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert1 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert1 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert1 : workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert0
-workshops/2000/russinoff-kaufmann/supporting-materials/inputs.cert : | workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert1
-
-workshops/2000/russinoff-kaufmann/supporting-materials/main.pcert0 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/main.pcert0 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/main.pcert0 : \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert0 \
-     rtl/rel1/lib3/top.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/main.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/main.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-workshops/2000/russinoff-kaufmann/supporting-materials/main.pcert1 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/main.pcert1 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/main.pcert1 : workshops/2000/russinoff-kaufmann/supporting-materials/main.pcert0
-workshops/2000/russinoff-kaufmann/supporting-materials/main.cert : | workshops/2000/russinoff-kaufmann/supporting-materials/main.pcert1
-
-workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert0 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert0 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert0 : \
-     rtl/rel1/lib3/top.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert1 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert1 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert1 : workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert0
-workshops/2000/russinoff-kaufmann/supporting-materials/model.cert : | workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert1
-
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert0 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert0 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert0 : \
-     workshops/2000/russinoff-kaufmann/supporting-materials/model.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/constants.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/inputs.pcert0 \
-     rtl/rel1/lib3/top.pcert0 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.lisp \
-     workshops/2000/russinoff-kaufmann/supporting-materials/pipe.acl2 \
-     workshops/2000/russinoff-kaufmann/supporting-materials/packages.lsp
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert1 : acl2x = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert1 : no_pcert = 0
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert1 : workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert0
-workshops/2000/russinoff-kaufmann/supporting-materials/pipe.cert : | workshops/2000/russinoff-kaufmann/supporting-materials/pipe.pcert1
-
-workshops/2000/russinoff-short/crt.pcert0 : no_pcert = 0
-workshops/2000/russinoff-short/crt.pcert0 : acl2x = 0
-workshops/2000/russinoff-short/crt.pcert0 : \
-     rtl/rel1/lib1/basic.pcert0 \
-     rtl/rel1/support/fp.pcert0 \
-     workshops/2000/russinoff-short/crt.lisp
-workshops/2000/russinoff-short/crt.pcert1 : acl2x = 0
-workshops/2000/russinoff-short/crt.pcert1 : no_pcert = 0
-workshops/2000/russinoff-short/crt.pcert1 : workshops/2000/russinoff-short/crt.pcert0
-workshops/2000/russinoff-short/crt.cert : | workshops/2000/russinoff-short/crt.pcert1
-
-workshops/2000/russinoff-short/summary.pcert0 : no_pcert = 0
-workshops/2000/russinoff-short/summary.pcert0 : acl2x = 0
-workshops/2000/russinoff-short/summary.pcert0 : \
-     workshops/2000/russinoff-short/crt.pcert0 \
-     workshops/2000/russinoff-short/summary.lisp
-workshops/2000/russinoff-short/summary.pcert1 : acl2x = 0
-workshops/2000/russinoff-short/summary.pcert1 : no_pcert = 0
-workshops/2000/russinoff-short/summary.pcert1 : workshops/2000/russinoff-short/summary.pcert0
-workshops/2000/russinoff-short/summary.cert : | workshops/2000/russinoff-short/summary.pcert1
-
-workshops/2000/sumners1/cdeq/cdeq-defs.pcert0 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-defs.pcert0 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-defs.pcert0 : \
-     workshops/2000/sumners1/cdeq/records.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2000/sumners1/cdeq/cdeq-defs.lisp
-workshops/2000/sumners1/cdeq/cdeq-defs.pcert1 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-defs.pcert1 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-defs.pcert1 : workshops/2000/sumners1/cdeq/cdeq-defs.pcert0
-workshops/2000/sumners1/cdeq/cdeq-defs.cert : | workshops/2000/sumners1/cdeq/cdeq-defs.pcert1
-
-workshops/2000/sumners1/cdeq/cdeq-phase1.pcert0 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-phase1.pcert0 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase1.pcert0 : \
-     workshops/2000/sumners1/cdeq/cdeq-defs.pcert0 \
-     workshops/2000/sumners1/cdeq/cdeq-phase1.lisp
-workshops/2000/sumners1/cdeq/cdeq-phase1.pcert1 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase1.pcert1 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-phase1.pcert1 : workshops/2000/sumners1/cdeq/cdeq-phase1.pcert0
-workshops/2000/sumners1/cdeq/cdeq-phase1.cert : | workshops/2000/sumners1/cdeq/cdeq-phase1.pcert1
-
-workshops/2000/sumners1/cdeq/cdeq-phase2.pcert0 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-phase2.pcert0 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase2.pcert0 : \
-     workshops/2000/sumners1/cdeq/cdeq-defs.pcert0 \
-     workshops/2000/sumners1/cdeq/cdeq-phase2.lisp
-workshops/2000/sumners1/cdeq/cdeq-phase2.pcert1 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase2.pcert1 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-phase2.pcert1 : workshops/2000/sumners1/cdeq/cdeq-phase2.pcert0
-workshops/2000/sumners1/cdeq/cdeq-phase2.cert : | workshops/2000/sumners1/cdeq/cdeq-phase2.pcert1
-
-workshops/2000/sumners1/cdeq/cdeq-phase3.pcert0 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-phase3.pcert0 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase3.pcert0 : \
-     workshops/2000/sumners1/cdeq/cdeq-defs.pcert0 \
-     workshops/2000/sumners1/cdeq/cdeq-phase3.lisp
-workshops/2000/sumners1/cdeq/cdeq-phase3.pcert1 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase3.pcert1 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-phase3.pcert1 : workshops/2000/sumners1/cdeq/cdeq-phase3.pcert0
-workshops/2000/sumners1/cdeq/cdeq-phase3.cert : | workshops/2000/sumners1/cdeq/cdeq-phase3.pcert1
-
-workshops/2000/sumners1/cdeq/cdeq-phase4.pcert0 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-phase4.pcert0 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase4.pcert0 : \
-     workshops/2000/sumners1/cdeq/cdeq-defs.pcert0 \
-     workshops/2000/sumners1/cdeq/cdeq-phase4.lisp
-workshops/2000/sumners1/cdeq/cdeq-phase4.pcert1 : acl2x = 0
-workshops/2000/sumners1/cdeq/cdeq-phase4.pcert1 : no_pcert = 0
-workshops/2000/sumners1/cdeq/cdeq-phase4.pcert1 : workshops/2000/sumners1/cdeq/cdeq-phase4.pcert0
-workshops/2000/sumners1/cdeq/cdeq-phase4.cert : | workshops/2000/sumners1/cdeq/cdeq-phase4.pcert1
-
-workshops/2000/sumners1/cdeq/records.pcert0 : no_pcert = 0
-workshops/2000/sumners1/cdeq/records.pcert0 : acl2x = 0
-workshops/2000/sumners1/cdeq/records.pcert0 : \
-     misc/total-order.pcert0 \
-     workshops/2000/sumners1/cdeq/records.lisp
-workshops/2000/sumners1/cdeq/records.pcert1 : acl2x = 0
-workshops/2000/sumners1/cdeq/records.pcert1 : no_pcert = 0
-workshops/2000/sumners1/cdeq/records.pcert1 : workshops/2000/sumners1/cdeq/records.pcert0
-workshops/2000/sumners1/cdeq/records.cert : | workshops/2000/sumners1/cdeq/records.pcert1
-
-workshops/2000/sumners2/bdds/bdd-mgr.pcert0 : no_pcert = 0
-workshops/2000/sumners2/bdds/bdd-mgr.pcert0 : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-mgr.pcert0 : \
-     workshops/2000/sumners2/bdds/bdd-mgr.lisp
-workshops/2000/sumners2/bdds/bdd-mgr.pcert1 : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-mgr.pcert1 : no_pcert = 0
-workshops/2000/sumners2/bdds/bdd-mgr.pcert1 : workshops/2000/sumners2/bdds/bdd-mgr.pcert0
-workshops/2000/sumners2/bdds/bdd-mgr.cert : | workshops/2000/sumners2/bdds/bdd-mgr.pcert1
-
-workshops/2000/sumners2/bdds/bdd-prf.pcert0 : no_pcert = 0
-workshops/2000/sumners2/bdds/bdd-prf.pcert0 : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-prf.pcert0 : \
-     workshops/2000/sumners2/bdds/bdd-spec.pcert0 \
-     workshops/2000/sumners2/bdds/bdd-prf.lisp
-workshops/2000/sumners2/bdds/bdd-prf.pcert1 : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-prf.pcert1 : no_pcert = 0
-workshops/2000/sumners2/bdds/bdd-prf.pcert1 : workshops/2000/sumners2/bdds/bdd-prf.pcert0
-workshops/2000/sumners2/bdds/bdd-prf.cert : | workshops/2000/sumners2/bdds/bdd-prf.pcert1
-
-workshops/2000/sumners2/bdds/bdd-spec.pcert0 : no_pcert = 0
-workshops/2000/sumners2/bdds/bdd-spec.pcert0 : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-spec.pcert0 : \
-     workshops/2000/sumners2/bdds/bdd-mgr.pcert0 \
-     workshops/2000/sumners2/bdds/bdd-spec.lisp
-workshops/2000/sumners2/bdds/bdd-spec.pcert1 : acl2x = 0
-workshops/2000/sumners2/bdds/bdd-spec.pcert1 : no_pcert = 0
-workshops/2000/sumners2/bdds/bdd-spec.pcert1 : workshops/2000/sumners2/bdds/bdd-spec.pcert0
-workshops/2000/sumners2/bdds/bdd-spec.cert : | workshops/2000/sumners2/bdds/bdd-spec.pcert1
-
-workshops/2002/cowles-flat/support/flat-ackermann.pcert0 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-ackermann.pcert0 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-ackermann.pcert0 : \
-     workshops/2002/cowles-flat/support/flat.pcert0 \
-     workshops/2002/cowles-flat/support/flat-ackermann.lisp \
-     workshops/2002/cowles-flat/support/flat-ackermann.acl2
-workshops/2002/cowles-flat/support/flat-ackermann.pcert1 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-ackermann.pcert1 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-ackermann.pcert1 : workshops/2002/cowles-flat/support/flat-ackermann.pcert0
-workshops/2002/cowles-flat/support/flat-ackermann.cert : | workshops/2002/cowles-flat/support/flat-ackermann.pcert1
-
-workshops/2002/cowles-flat/support/flat-nested.pcert0 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-nested.pcert0 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-nested.pcert0 : \
-     workshops/2002/cowles-flat/support/flat.pcert0 \
-     workshops/2002/cowles-flat/support/flat-nested.lisp \
-     workshops/2002/cowles-flat/support/flat-nested.acl2
-workshops/2002/cowles-flat/support/flat-nested.pcert1 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-nested.pcert1 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-nested.pcert1 : workshops/2002/cowles-flat/support/flat-nested.pcert0
-workshops/2002/cowles-flat/support/flat-nested.cert : | workshops/2002/cowles-flat/support/flat-nested.pcert1
-
-workshops/2002/cowles-flat/support/flat-primitive.pcert0 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-primitive.pcert0 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-primitive.pcert0 : \
-     workshops/2002/cowles-flat/support/flat.pcert0 \
-     workshops/2002/cowles-flat/support/flat-primitive.lisp \
-     workshops/2002/cowles-flat/support/flat-primitive.acl2
-workshops/2002/cowles-flat/support/flat-primitive.pcert1 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-primitive.pcert1 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-primitive.pcert1 : workshops/2002/cowles-flat/support/flat-primitive.pcert0
-workshops/2002/cowles-flat/support/flat-primitive.cert : | workshops/2002/cowles-flat/support/flat-primitive.pcert1
-
-workshops/2002/cowles-flat/support/flat-reverse.pcert0 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-reverse.pcert0 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-reverse.pcert0 : \
-     workshops/2002/cowles-flat/support/flat.pcert0 \
-     workshops/2002/cowles-flat/support/flat-reverse.lisp \
-     workshops/2002/cowles-flat/support/flat-reverse.acl2
-workshops/2002/cowles-flat/support/flat-reverse.pcert1 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-reverse.pcert1 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-reverse.pcert1 : workshops/2002/cowles-flat/support/flat-reverse.pcert0
-workshops/2002/cowles-flat/support/flat-reverse.cert : | workshops/2002/cowles-flat/support/flat-reverse.pcert1
-
-workshops/2002/cowles-flat/support/flat-tail.pcert0 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-tail.pcert0 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-tail.pcert0 : \
-     workshops/2002/cowles-flat/support/flat.pcert0 \
-     workshops/2002/cowles-flat/support/flat-tail.lisp \
-     workshops/2002/cowles-flat/support/flat-tail.acl2
-workshops/2002/cowles-flat/support/flat-tail.pcert1 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-tail.pcert1 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-tail.pcert1 : workshops/2002/cowles-flat/support/flat-tail.pcert0
-workshops/2002/cowles-flat/support/flat-tail.cert : | workshops/2002/cowles-flat/support/flat-tail.pcert1
-
-workshops/2002/cowles-flat/support/flat-z.pcert0 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-z.pcert0 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-z.pcert0 : \
-     workshops/2002/cowles-flat/support/flat.pcert0 \
-     workshops/2002/cowles-flat/support/flat-z.lisp \
-     workshops/2002/cowles-flat/support/flat-z.acl2
-workshops/2002/cowles-flat/support/flat-z.pcert1 : acl2x = 0
-workshops/2002/cowles-flat/support/flat-z.pcert1 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat-z.pcert1 : workshops/2002/cowles-flat/support/flat-z.pcert0
-workshops/2002/cowles-flat/support/flat-z.cert : | workshops/2002/cowles-flat/support/flat-z.pcert1
-
-workshops/2002/cowles-flat/support/flat.pcert0 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat.pcert0 : acl2x = 0
-workshops/2002/cowles-flat/support/flat.pcert0 : \
-     workshops/2002/cowles-flat/support/flat.lisp \
-     workshops/2002/cowles-flat/support/flat.acl2
-workshops/2002/cowles-flat/support/flat.pcert1 : acl2x = 0
-workshops/2002/cowles-flat/support/flat.pcert1 : no_pcert = 0
-workshops/2002/cowles-flat/support/flat.pcert1 : workshops/2002/cowles-flat/support/flat.pcert0
-workshops/2002/cowles-flat/support/flat.cert : | workshops/2002/cowles-flat/support/flat.pcert1
-
-workshops/2002/cowles-primrec/support/bad-def.pcert0 : no_pcert = 0
-workshops/2002/cowles-primrec/support/bad-def.pcert0 : acl2x = 0
-workshops/2002/cowles-primrec/support/bad-def.pcert0 : \
-     workshops/2002/cowles-primrec/support/bad-def.lisp \
-     workshops/2002/cowles-primrec/support/bad-def.acl2
-workshops/2002/cowles-primrec/support/bad-def.pcert1 : acl2x = 0
-workshops/2002/cowles-primrec/support/bad-def.pcert1 : no_pcert = 0
-workshops/2002/cowles-primrec/support/bad-def.pcert1 : workshops/2002/cowles-primrec/support/bad-def.pcert0
-workshops/2002/cowles-primrec/support/bad-def.cert : | workshops/2002/cowles-primrec/support/bad-def.pcert1
-
-workshops/2002/cowles-primrec/support/bad-def1.pcert0 : no_pcert = 0
-workshops/2002/cowles-primrec/support/bad-def1.pcert0 : acl2x = 0
-workshops/2002/cowles-primrec/support/bad-def1.pcert0 : \
-     workshops/2002/cowles-primrec/support/bad-def1.lisp \
-     workshops/2002/cowles-primrec/support/bad-def1.acl2
-workshops/2002/cowles-primrec/support/bad-def1.pcert1 : acl2x = 0
-workshops/2002/cowles-primrec/support/bad-def1.pcert1 : no_pcert = 0
-workshops/2002/cowles-primrec/support/bad-def1.pcert1 : workshops/2002/cowles-primrec/support/bad-def1.pcert0
-workshops/2002/cowles-primrec/support/bad-def1.cert : | workshops/2002/cowles-primrec/support/bad-def1.pcert1
-
-workshops/2002/cowles-primrec/support/defpr.pcert0 : no_pcert = 0
-workshops/2002/cowles-primrec/support/defpr.pcert0 : acl2x = 0
-workshops/2002/cowles-primrec/support/defpr.pcert0 : \
-     workshops/2002/cowles-primrec/support/defpr.lisp
-workshops/2002/cowles-primrec/support/defpr.pcert1 : acl2x = 0
-workshops/2002/cowles-primrec/support/defpr.pcert1 : no_pcert = 0
-workshops/2002/cowles-primrec/support/defpr.pcert1 : workshops/2002/cowles-primrec/support/defpr.pcert0
-workshops/2002/cowles-primrec/support/defpr.cert : | workshops/2002/cowles-primrec/support/defpr.pcert1
-
-workshops/2002/cowles-primrec/support/fix.pcert0 : no_pcert = 0
-workshops/2002/cowles-primrec/support/fix.pcert0 : acl2x = 0
-workshops/2002/cowles-primrec/support/fix.pcert0 : \
-     workshops/2002/cowles-primrec/support/fix.lisp
-workshops/2002/cowles-primrec/support/fix.pcert1 : acl2x = 0
-workshops/2002/cowles-primrec/support/fix.pcert1 : no_pcert = 0
-workshops/2002/cowles-primrec/support/fix.pcert1 : workshops/2002/cowles-primrec/support/fix.pcert0
-workshops/2002/cowles-primrec/support/fix.cert : | workshops/2002/cowles-primrec/support/fix.pcert1
-
-workshops/2002/cowles-primrec/support/primitive.pcert0 : no_pcert = 0
-workshops/2002/cowles-primrec/support/primitive.pcert0 : acl2x = 0
-workshops/2002/cowles-primrec/support/primitive.pcert0 : \
-     workshops/2002/cowles-primrec/support/primitive.lisp
-workshops/2002/cowles-primrec/support/primitive.pcert1 : acl2x = 0
-workshops/2002/cowles-primrec/support/primitive.pcert1 : no_pcert = 0
-workshops/2002/cowles-primrec/support/primitive.pcert1 : workshops/2002/cowles-primrec/support/primitive.pcert0
-workshops/2002/cowles-primrec/support/primitive.cert : | workshops/2002/cowles-primrec/support/primitive.pcert1
-
-workshops/2002/cowles-primrec/support/tail.pcert0 : no_pcert = 0
-workshops/2002/cowles-primrec/support/tail.pcert0 : acl2x = 0
-workshops/2002/cowles-primrec/support/tail.pcert0 : \
-     workshops/2002/cowles-primrec/support/tail.lisp
-workshops/2002/cowles-primrec/support/tail.pcert1 : acl2x = 0
-workshops/2002/cowles-primrec/support/tail.pcert1 : no_pcert = 0
-workshops/2002/cowles-primrec/support/tail.pcert1 : workshops/2002/cowles-primrec/support/tail.pcert0
-workshops/2002/cowles-primrec/support/tail.cert : | workshops/2002/cowles-primrec/support/tail.pcert1
-
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.pcert0 : no_pcert = 0
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.pcert0 : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.pcert0 : \
-     workshops/2002/georgelin-borrione-ostier/support/utils.pcert0 \
-     workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert0 \
-     workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert0 \
-     workshops/2002/georgelin-borrione-ostier/support/acl2-transl.lisp
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.pcert1 : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.pcert1 : no_pcert = 0
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.pcert1 : workshops/2002/georgelin-borrione-ostier/support/acl2-transl.pcert0
-workshops/2002/georgelin-borrione-ostier/support/acl2-transl.cert : | workshops/2002/georgelin-borrione-ostier/support/acl2-transl.pcert1
-
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert0 : no_pcert = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert0 : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert0 : \
-     workshops/2002/georgelin-borrione-ostier/support/utils.pcert0 \
-     workshops/2002/georgelin-borrione-ostier/support/generates-functions.lisp
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert1 : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert1 : no_pcert = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert1 : workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert0
-workshops/2002/georgelin-borrione-ostier/support/generates-functions.cert : | workshops/2002/georgelin-borrione-ostier/support/generates-functions.pcert1
-
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert0 : no_pcert = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert0 : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert0 : \
-     workshops/2002/georgelin-borrione-ostier/support/utils.pcert0 \
-     workshops/2002/georgelin-borrione-ostier/support/generates-theorems.lisp
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert1 : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert1 : no_pcert = 0
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert1 : workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert0
-workshops/2002/georgelin-borrione-ostier/support/generates-theorems.cert : | workshops/2002/georgelin-borrione-ostier/support/generates-theorems.pcert1
-
-workshops/2002/georgelin-borrione-ostier/support/utils.pcert0 : no_pcert = 0
-workshops/2002/georgelin-borrione-ostier/support/utils.pcert0 : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/utils.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     misc/expander.pcert0 \
-     workshops/2002/georgelin-borrione-ostier/support/utils.lisp
-workshops/2002/georgelin-borrione-ostier/support/utils.pcert1 : acl2x = 0
-workshops/2002/georgelin-borrione-ostier/support/utils.pcert1 : no_pcert = 0
-workshops/2002/georgelin-borrione-ostier/support/utils.pcert1 : workshops/2002/georgelin-borrione-ostier/support/utils.pcert0
-workshops/2002/georgelin-borrione-ostier/support/utils.cert : | workshops/2002/georgelin-borrione-ostier/support/utils.pcert1
-
-workshops/2002/kaufmann-sumners/support/records.pcert0 : no_pcert = 0
-workshops/2002/kaufmann-sumners/support/records.pcert0 : acl2x = 0
-workshops/2002/kaufmann-sumners/support/records.pcert0 : \
-     misc/total-order.pcert0 \
-     workshops/2002/kaufmann-sumners/support/records.lisp
-workshops/2002/kaufmann-sumners/support/records.pcert1 : acl2x = 0
-workshops/2002/kaufmann-sumners/support/records.pcert1 : no_pcert = 0
-workshops/2002/kaufmann-sumners/support/records.pcert1 : workshops/2002/kaufmann-sumners/support/records.pcert0
-workshops/2002/kaufmann-sumners/support/records.cert : | workshops/2002/kaufmann-sumners/support/records.pcert1
-
-workshops/2002/kaufmann-sumners/support/records0.pcert0 : no_pcert = 0
-workshops/2002/kaufmann-sumners/support/records0.pcert0 : acl2x = 0
-workshops/2002/kaufmann-sumners/support/records0.pcert0 : \
-     misc/total-order.pcert0 \
-     workshops/2002/kaufmann-sumners/support/records0.lisp
-workshops/2002/kaufmann-sumners/support/records0.pcert1 : acl2x = 0
-workshops/2002/kaufmann-sumners/support/records0.pcert1 : no_pcert = 0
-workshops/2002/kaufmann-sumners/support/records0.pcert1 : workshops/2002/kaufmann-sumners/support/records0.pcert0
-workshops/2002/kaufmann-sumners/support/records0.cert : | workshops/2002/kaufmann-sumners/support/records0.pcert1
-
-workshops/2002/kaufmann-sumners/support/sets.pcert0 : no_pcert = 0
-workshops/2002/kaufmann-sumners/support/sets.pcert0 : acl2x = 0
-workshops/2002/kaufmann-sumners/support/sets.pcert0 : \
-     misc/total-order.pcert0 \
-     workshops/2002/kaufmann-sumners/support/sets.lisp
-workshops/2002/kaufmann-sumners/support/sets.pcert1 : acl2x = 0
-workshops/2002/kaufmann-sumners/support/sets.pcert1 : no_pcert = 0
-workshops/2002/kaufmann-sumners/support/sets.pcert1 : workshops/2002/kaufmann-sumners/support/sets.pcert0
-workshops/2002/kaufmann-sumners/support/sets.cert : | workshops/2002/kaufmann-sumners/support/sets.pcert1
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.lisp \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.acl2
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.pcert1 : workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.pcert0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.cert : | workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.pcert1
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.lisp \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.acl2
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.pcert1 : workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.pcert0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.cert : | workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.pcert1
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.lisp
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert1 : workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.cert : | workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.pcert1
-
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.lisp
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert1 : workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert0
-workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.cert : | workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.pcert1
-
-workshops/2002/manolios-kaufmann/support/records/records-original.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/records/records-original.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/records-original.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/records/records-original.lisp
-workshops/2002/manolios-kaufmann/support/records/records-original.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/records-original.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/records/records-original.pcert1 : workshops/2002/manolios-kaufmann/support/records/records-original.pcert0
-workshops/2002/manolios-kaufmann/support/records/records-original.cert : | workshops/2002/manolios-kaufmann/support/records/records-original.pcert1
-
-workshops/2002/manolios-kaufmann/support/records/records.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/records/records.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/records.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/records/total-order.pcert0 \
-     workshops/2002/manolios-kaufmann/support/records/records.lisp
-workshops/2002/manolios-kaufmann/support/records/records.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/records.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/records/records.pcert1 : workshops/2002/manolios-kaufmann/support/records/records.pcert0
-workshops/2002/manolios-kaufmann/support/records/records.cert : | workshops/2002/manolios-kaufmann/support/records/records.pcert1
-
-workshops/2002/manolios-kaufmann/support/records/total-order.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/records/total-order.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/total-order.pcert0 : \
-     misc/total-order.pcert0 \
-     workshops/2002/manolios-kaufmann/support/records/total-order.lisp
-workshops/2002/manolios-kaufmann/support/records/total-order.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/records/total-order.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/records/total-order.pcert1 : workshops/2002/manolios-kaufmann/support/records/total-order.pcert0
-workshops/2002/manolios-kaufmann/support/records/total-order.cert : | workshops/2002/manolios-kaufmann/support/records/total-order.pcert1
-
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert0 \
-     workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.lisp
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert1 : workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert0
-workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.cert : | workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert1
-
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/sorting/perm.pcert0 \
-     workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert0 \
-     workshops/2002/manolios-kaufmann/support/sorting/perm-order.lisp
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert1 : workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert0
-workshops/2002/manolios-kaufmann/support/sorting/perm-order.cert : | workshops/2002/manolios-kaufmann/support/sorting/perm-order.pcert1
-
-workshops/2002/manolios-kaufmann/support/sorting/perm.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/sorting/perm.lisp
-workshops/2002/manolios-kaufmann/support/sorting/perm.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/perm.pcert1 : workshops/2002/manolios-kaufmann/support/sorting/perm.pcert0
-workshops/2002/manolios-kaufmann/support/sorting/perm.cert : | workshops/2002/manolios-kaufmann/support/sorting/perm.pcert1
-
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.pcert0 : \
-     workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.pcert0 \
-     workshops/2002/manolios-kaufmann/support/sorting/quicksort.lisp
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.pcert1 : workshops/2002/manolios-kaufmann/support/sorting/quicksort.pcert0
-workshops/2002/manolios-kaufmann/support/sorting/quicksort.cert : | workshops/2002/manolios-kaufmann/support/sorting/quicksort.pcert1
-
-workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert0 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert0 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert0 : \
-     misc/total-order.pcert0 \
-     workshops/2002/manolios-kaufmann/support/sorting/total-order.lisp
-workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert1 : acl2x = 0
-workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert1 : no_pcert = 0
-workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert1 : workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert0
-workshops/2002/manolios-kaufmann/support/sorting/total-order.cert : | workshops/2002/manolios-kaufmann/support/sorting/total-order.pcert1
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert0 : no_pcert = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert0 : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert0 : \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert0 \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.lisp
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert1 : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert1 : no_pcert = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert1 : workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.cert : | workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert1
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert0 : no_pcert = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert0 : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert0 : \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.lisp
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert1 : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert1 : no_pcert = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert1 : workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.cert : | workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.pcert1
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.pcert0 : no_pcert = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.pcert0 : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.pcert0 : \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert0 \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.lisp
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.pcert1 : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.pcert1 : no_pcert = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.pcert1 : workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.pcert0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.cert : | workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.pcert1
-
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.pcert0 : no_pcert = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.pcert0 : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.pcert0 : \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.pcert0 \
-     workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.lisp
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.pcert1 : acl2x = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.pcert1 : no_pcert = 0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.pcert1 : workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.pcert0
-workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.cert : | workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.pcert1
-
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.pcert0 : no_pcert = 0
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.pcert0 : acl2x = 0
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.pcert0 : \
-     workshops/2002/martin-alonso-perez-sancho/support/Adleman.lisp
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.pcert1 : acl2x = 0
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.pcert1 : no_pcert = 0
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.pcert1 : workshops/2002/martin-alonso-perez-sancho/support/Adleman.pcert0
-workshops/2002/martin-alonso-perez-sancho/support/Adleman.cert : | workshops/2002/martin-alonso-perez-sancho/support/Adleman.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-2/npol.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-2/npol.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/npol.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert0 \
-     workshops/2002/medina-palomo-alonso/support/section-2/npol.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-2/npol.acl2
-workshops/2002/medina-palomo-alonso/support/section-2/npol.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/npol.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-2/npol.pcert1 : workshops/2002/medina-palomo-alonso/support/section-2/npol.pcert0
-workshops/2002/medina-palomo-alonso/support/section-2/npol.cert : | workshops/2002/medina-palomo-alonso/support/section-2/npol.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-1.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-1.acl2
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.pcert1 : workshops/2002/medina-palomo-alonso/support/section-2/upol-1.pcert0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-1.cert : | workshops/2002/medina-palomo-alonso/support/section-2/upol-1.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-2/upol-2.acl2
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert1 : workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert0
-workshops/2002/medina-palomo-alonso/support/section-2/upol-2.cert : | workshops/2002/medina-palomo-alonso/support/section-2/upol-2.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.pcert0 \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.acl2
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert1 : workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert0
-workshops/2002/medina-palomo-alonso/support/section-3/monomial.cert : | workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert0 \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert0 \
-     ordinals/ordinals-without-arithmetic.pcert0 \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.acl2
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.pcert1 : workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.pcert0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.cert : | workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert0 \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert0 \
-     ordinals/ordinals-without-arithmetic.pcert0 \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.acl2
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.pcert1 : workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.pcert0
-workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.cert : | workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.acl2
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert1 : workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert0
-workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.cert : | workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-3/term.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/term.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/term.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/term.acl2
-workshops/2002/medina-palomo-alonso/support/section-3/term.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/term.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/term.pcert1 : workshops/2002/medina-palomo-alonso/support/section-3/term.pcert0
-workshops/2002/medina-palomo-alonso/support/section-3/term.cert : | workshops/2002/medina-palomo-alonso/support/section-3/term.pcert1
-
-workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert0 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert0 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert0 : \
-     workshops/2002/medina-palomo-alonso/support/section-3/monomial.pcert0 \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.lisp \
-     workshops/2002/medina-palomo-alonso/support/section-3/upol.acl2
-workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert1 : acl2x = 0
-workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert1 : no_pcert = 0
-workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert1 : workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert0
-workshops/2002/medina-palomo-alonso/support/section-3/upol.cert : | workshops/2002/medina-palomo-alonso/support/section-3/upol.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert0 \
-     ordinals/ordinals-without-arithmetic.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert1
-
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert0 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert0 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert0 : \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.pcert0 \
-     workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.lisp
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert1 : acl2x = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert1 : no_pcert = 0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert1 : workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert0
-workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.cert : | workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.pcert1
-
-workshops/2003/austel/support/abs-type.pcert0 : no_pcert = 0
-workshops/2003/austel/support/abs-type.pcert0 : acl2x = 0
-workshops/2003/austel/support/abs-type.pcert0 : \
-     workshops/2003/austel/support/abs-type.lisp
-workshops/2003/austel/support/abs-type.pcert1 : acl2x = 0
-workshops/2003/austel/support/abs-type.pcert1 : no_pcert = 0
-workshops/2003/austel/support/abs-type.pcert1 : workshops/2003/austel/support/abs-type.pcert0
-workshops/2003/austel/support/abs-type.cert : | workshops/2003/austel/support/abs-type.pcert1
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert0 : no_pcert = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert0 : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert0 : \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.lisp
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert1 : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert1 : no_pcert = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert1 : workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.cert : | workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert1
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert0 : no_pcert = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert0 : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert0 : \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.lisp
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert1 : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert1 : no_pcert = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert1 : workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.cert : | workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert1
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert0 : no_pcert = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert0 : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert0 : \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert0 \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert0 \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.lisp
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert1 : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert1 : no_pcert = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert1 : workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.cert : | workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert1
-
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert0 : no_pcert = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert0 : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.pcert0 \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.pcert0 \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.lisp
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert1 : acl2x = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert1 : no_pcert = 0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert1 : workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert0
-workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.cert : | workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.pcert1
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert0 : no_pcert = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert0 : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert0 : \
-     workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert0 \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.lisp \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.acl2 \
-     workshops/2003/gamboa-cowles-van-baalen/support/defpkg.lsp
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert1 : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert1 : no_pcert = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert1 : workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.cert : | workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert1
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.pcert0 : no_pcert = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.pcert0 : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.pcert0 : \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert0 \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.lisp \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.acl2 \
-     workshops/2003/gamboa-cowles-van-baalen/support/defpkg.lsp
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.pcert1 : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.pcert1 : no_pcert = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.pcert1 : workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.pcert0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.cert : | workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.pcert1
-
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert0 : no_pcert = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert0 : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert0 : \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.pcert0 \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.lisp \
-     workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.acl2 \
-     workshops/2003/gamboa-cowles-van-baalen/support/defpkg.lsp
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert1 : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert1 : no_pcert = 0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert1 : workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert0
-workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.cert : | workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.pcert1
-
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert0 : no_pcert = 0
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert0 : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.pcert0 \
-     workshops/2003/gamboa-cowles-van-baalen/support/linalg.lisp
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert1 : acl2x = 0
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert1 : no_pcert = 0
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert1 : workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert0
-workshops/2003/gamboa-cowles-van-baalen/support/linalg.cert : | workshops/2003/gamboa-cowles-van-baalen/support/linalg.pcert1
-
-workshops/2003/greve-wilding_defrecord/support/defrecord.pcert0 : no_pcert = 0
-workshops/2003/greve-wilding_defrecord/support/defrecord.pcert0 : acl2x = 0
-workshops/2003/greve-wilding_defrecord/support/defrecord.pcert0 : \
-     misc/records.pcert0 \
-     workshops/2003/greve-wilding_defrecord/support/defrecord.lisp
-workshops/2003/greve-wilding_defrecord/support/defrecord.pcert1 : acl2x = 0
-workshops/2003/greve-wilding_defrecord/support/defrecord.pcert1 : no_pcert = 0
-workshops/2003/greve-wilding_defrecord/support/defrecord.pcert1 : workshops/2003/greve-wilding_defrecord/support/defrecord.pcert0
-workshops/2003/greve-wilding_defrecord/support/defrecord.cert : | workshops/2003/greve-wilding_defrecord/support/defrecord.pcert1
-
-workshops/2003/greve-wilding_mbe/support/fpst.pcert0 : no_pcert = 0
-workshops/2003/greve-wilding_mbe/support/fpst.pcert0 : acl2x = 0
-workshops/2003/greve-wilding_mbe/support/fpst.pcert0 : \
-     workshops/1999/graph/linear-find-path.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/greve-wilding_mbe/support/fpst.lisp
-workshops/2003/greve-wilding_mbe/support/fpst.pcert1 : acl2x = 0
-workshops/2003/greve-wilding_mbe/support/fpst.pcert1 : no_pcert = 0
-workshops/2003/greve-wilding_mbe/support/fpst.pcert1 : workshops/2003/greve-wilding_mbe/support/fpst.pcert0
-workshops/2003/greve-wilding_mbe/support/fpst.cert : | workshops/2003/greve-wilding_mbe/support/fpst.pcert1
-
-workshops/2003/greve-wilding_mbe/support/run-fpst.pcert0 : no_pcert = 0
-workshops/2003/greve-wilding_mbe/support/run-fpst.pcert0 : acl2x = 0
-workshops/2003/greve-wilding_mbe/support/run-fpst.pcert0 : \
-     workshops/2003/greve-wilding_mbe/support/fpst.pcert0 \
-     workshops/2003/greve-wilding_mbe/support/run-fpst.lisp
-workshops/2003/greve-wilding_mbe/support/run-fpst.pcert1 : acl2x = 0
-workshops/2003/greve-wilding_mbe/support/run-fpst.pcert1 : no_pcert = 0
-workshops/2003/greve-wilding_mbe/support/run-fpst.pcert1 : workshops/2003/greve-wilding_mbe/support/run-fpst.pcert0
-workshops/2003/greve-wilding_mbe/support/run-fpst.cert : | workshops/2003/greve-wilding_mbe/support/run-fpst.pcert1
-
-workshops/2003/hbl/support/sol1.pcert0 : no_pcert = 0
-workshops/2003/hbl/support/sol1.pcert0 : acl2x = 0
-workshops/2003/hbl/support/sol1.pcert0 : \
-     misc/records.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2003/hbl/support/sol1.lisp
-workshops/2003/hbl/support/sol1.pcert1 : acl2x = 0
-workshops/2003/hbl/support/sol1.pcert1 : no_pcert = 0
-workshops/2003/hbl/support/sol1.pcert1 : workshops/2003/hbl/support/sol1.pcert0
-workshops/2003/hbl/support/sol1.cert : | workshops/2003/hbl/support/sol1.pcert1
-
-workshops/2003/hbl/support/sol2.pcert0 : no_pcert = 0
-workshops/2003/hbl/support/sol2.pcert0 : acl2x = 0
-workshops/2003/hbl/support/sol2.pcert0 : \
-     misc/records.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/hbl/support/sol2.lisp
-workshops/2003/hbl/support/sol2.pcert1 : acl2x = 0
-workshops/2003/hbl/support/sol2.pcert1 : no_pcert = 0
-workshops/2003/hbl/support/sol2.pcert1 : workshops/2003/hbl/support/sol2.pcert0
-workshops/2003/hbl/support/sol2.cert : | workshops/2003/hbl/support/sol2.pcert1
-
-workshops/2003/hendrix/support/madd.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/madd.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/madd.pcert0 : \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/mzero.pcert0 \
-     workshops/2003/hendrix/support/mentry.pcert0 \
-     workshops/2003/hendrix/support/madd.lisp
-workshops/2003/hendrix/support/madd.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/madd.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/madd.pcert1 : workshops/2003/hendrix/support/madd.pcert0
-workshops/2003/hendrix/support/madd.cert : | workshops/2003/hendrix/support/madd.pcert1
-
-workshops/2003/hendrix/support/matrices.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/matrices.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/matrices.pcert0 : \
-     workshops/2003/hendrix/support/vector.pcert0 \
-     workshops/2003/hendrix/support/mdefuns.pcert0 \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/mentry.pcert0 \
-     workshops/2003/hendrix/support/mzero.pcert0 \
-     workshops/2003/hendrix/support/madd.pcert0 \
-     workshops/2003/hendrix/support/mscal.pcert0 \
-     workshops/2003/hendrix/support/msub.pcert0 \
-     workshops/2003/hendrix/support/mid.pcert0 \
-     workshops/2003/hendrix/support/mmult.pcert0 \
-     workshops/2003/hendrix/support/mtrans.pcert0 \
-     workshops/2003/hendrix/support/matrices.lisp
-workshops/2003/hendrix/support/matrices.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/matrices.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/matrices.pcert1 : workshops/2003/hendrix/support/matrices.pcert0
-workshops/2003/hendrix/support/matrices.cert : | workshops/2003/hendrix/support/matrices.pcert1
-
-workshops/2003/hendrix/support/mdefthms.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/mdefthms.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/mdefthms.pcert0 : \
-     workshops/2003/hendrix/support/mdefuns.pcert0 \
-     workshops/2003/hendrix/support/mdefthms.lisp
-workshops/2003/hendrix/support/mdefthms.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/mdefthms.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/mdefthms.pcert1 : workshops/2003/hendrix/support/mdefthms.pcert0
-workshops/2003/hendrix/support/mdefthms.cert : | workshops/2003/hendrix/support/mdefthms.pcert1
-
-workshops/2003/hendrix/support/mdefuns.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/mdefuns.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/mdefuns.pcert0 : \
-     workshops/2003/hendrix/support/vector.pcert0 \
-     workshops/2003/hendrix/support/mdefuns.lisp
-workshops/2003/hendrix/support/mdefuns.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/mdefuns.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/mdefuns.pcert1 : workshops/2003/hendrix/support/mdefuns.pcert0
-workshops/2003/hendrix/support/mdefuns.cert : | workshops/2003/hendrix/support/mdefuns.pcert1
-
-workshops/2003/hendrix/support/mentry.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/mentry.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/mentry.pcert0 : \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/mentry.lisp
-workshops/2003/hendrix/support/mentry.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/mentry.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/mentry.pcert1 : workshops/2003/hendrix/support/mentry.pcert0
-workshops/2003/hendrix/support/mentry.cert : | workshops/2003/hendrix/support/mentry.pcert1
-
-workshops/2003/hendrix/support/mid.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/mid.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/mid.pcert0 : \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/mid.lisp
-workshops/2003/hendrix/support/mid.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/mid.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/mid.pcert1 : workshops/2003/hendrix/support/mid.pcert0
-workshops/2003/hendrix/support/mid.cert : | workshops/2003/hendrix/support/mid.pcert1
-
-workshops/2003/hendrix/support/mmult.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/mmult.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/mmult.pcert0 : \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/mzero.pcert0 \
-     workshops/2003/hendrix/support/madd.pcert0 \
-     workshops/2003/hendrix/support/mscal.pcert0 \
-     workshops/2003/hendrix/support/mid.pcert0 \
-     workshops/2003/hendrix/support/mentry.pcert0 \
-     workshops/2003/hendrix/support/mmult.lisp
-workshops/2003/hendrix/support/mmult.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/mmult.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/mmult.pcert1 : workshops/2003/hendrix/support/mmult.pcert0
-workshops/2003/hendrix/support/mmult.cert : | workshops/2003/hendrix/support/mmult.pcert1
-
-workshops/2003/hendrix/support/mscal.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/mscal.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/mscal.pcert0 : \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/mzero.pcert0 \
-     workshops/2003/hendrix/support/madd.pcert0 \
-     workshops/2003/hendrix/support/mentry.pcert0 \
-     workshops/2003/hendrix/support/mscal.lisp
-workshops/2003/hendrix/support/mscal.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/mscal.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/mscal.pcert1 : workshops/2003/hendrix/support/mscal.pcert0
-workshops/2003/hendrix/support/mscal.cert : | workshops/2003/hendrix/support/mscal.pcert1
-
-workshops/2003/hendrix/support/msub.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/msub.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/msub.pcert0 : \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/madd.pcert0 \
-     workshops/2003/hendrix/support/mscal.pcert0 \
-     workshops/2003/hendrix/support/msub.lisp
-workshops/2003/hendrix/support/msub.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/msub.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/msub.pcert1 : workshops/2003/hendrix/support/msub.pcert0
-workshops/2003/hendrix/support/msub.cert : | workshops/2003/hendrix/support/msub.pcert1
-
-workshops/2003/hendrix/support/mtrans.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/mtrans.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/mtrans.pcert0 : \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/mzero.pcert0 \
-     workshops/2003/hendrix/support/madd.pcert0 \
-     workshops/2003/hendrix/support/mid.pcert0 \
-     workshops/2003/hendrix/support/mscal.pcert0 \
-     workshops/2003/hendrix/support/mmult.pcert0 \
-     workshops/2003/hendrix/support/mentry.pcert0 \
-     workshops/2003/hendrix/support/mtrans.lisp
-workshops/2003/hendrix/support/mtrans.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/mtrans.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/mtrans.pcert1 : workshops/2003/hendrix/support/mtrans.pcert0
-workshops/2003/hendrix/support/mtrans.cert : | workshops/2003/hendrix/support/mtrans.pcert1
-
-workshops/2003/hendrix/support/mzero.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/mzero.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/mzero.pcert0 : \
-     workshops/2003/hendrix/support/mdefthms.pcert0 \
-     workshops/2003/hendrix/support/mzero.lisp
-workshops/2003/hendrix/support/mzero.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/mzero.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/mzero.pcert1 : workshops/2003/hendrix/support/mzero.pcert0
-workshops/2003/hendrix/support/mzero.cert : | workshops/2003/hendrix/support/mzero.pcert1
-
-workshops/2003/hendrix/support/vector.pcert0 : no_pcert = 0
-workshops/2003/hendrix/support/vector.pcert0 : acl2x = 0
-workshops/2003/hendrix/support/vector.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2003/hendrix/support/vector.lisp
-workshops/2003/hendrix/support/vector.pcert1 : acl2x = 0
-workshops/2003/hendrix/support/vector.pcert1 : no_pcert = 0
-workshops/2003/hendrix/support/vector.pcert1 : workshops/2003/hendrix/support/vector.pcert0
-workshops/2003/hendrix/support/vector.cert : | workshops/2003/hendrix/support/vector.pcert1
-
-workshops/2003/matlin-mccune/support/simp.pcert0 : no_pcert = 0
-workshops/2003/matlin-mccune/support/simp.pcert0 : acl2x = 0
-workshops/2003/matlin-mccune/support/simp.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2003/matlin-mccune/support/simp.lisp
-workshops/2003/matlin-mccune/support/simp.pcert1 : acl2x = 0
-workshops/2003/matlin-mccune/support/simp.pcert1 : no_pcert = 0
-workshops/2003/matlin-mccune/support/simp.pcert1 : workshops/2003/matlin-mccune/support/simp.pcert0
-workshops/2003/matlin-mccune/support/simp.cert : | workshops/2003/matlin-mccune/support/simp.pcert1
-
-workshops/2003/moore_rockwell/support/memory-taggings.pcert0 : no_pcert = 0
-workshops/2003/moore_rockwell/support/memory-taggings.pcert0 : acl2x = 0
-workshops/2003/moore_rockwell/support/memory-taggings.pcert0 : \
-     misc/records.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/moore_rockwell/support/memory-taggings.lisp
-workshops/2003/moore_rockwell/support/memory-taggings.pcert1 : acl2x = 0
-workshops/2003/moore_rockwell/support/memory-taggings.pcert1 : no_pcert = 0
-workshops/2003/moore_rockwell/support/memory-taggings.pcert1 : workshops/2003/moore_rockwell/support/memory-taggings.pcert0
-workshops/2003/moore_rockwell/support/memory-taggings.cert : | workshops/2003/moore_rockwell/support/memory-taggings.pcert1
-
-workshops/2003/moore_vcg/support/demo.pcert0 : no_pcert = 0
-workshops/2003/moore_vcg/support/demo.pcert0 : acl2x = 0
-workshops/2003/moore_vcg/support/demo.pcert0 : \
-     workshops/2003/moore_vcg/support/utilities.pcert0 \
-     workshops/2003/moore_vcg/support/demo.lisp \
-     workshops/2003/moore_vcg/support/demo.acl2
-workshops/2003/moore_vcg/support/demo.pcert1 : acl2x = 0
-workshops/2003/moore_vcg/support/demo.pcert1 : no_pcert = 0
-workshops/2003/moore_vcg/support/demo.pcert1 : workshops/2003/moore_vcg/support/demo.pcert0
-workshops/2003/moore_vcg/support/demo.cert : | workshops/2003/moore_vcg/support/demo.pcert1
-
-workshops/2003/moore_vcg/support/m5.pcert0 : no_pcert = 0
-workshops/2003/moore_vcg/support/m5.pcert0 : acl2x = 0
-workshops/2003/moore_vcg/support/m5.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/moore_vcg/support/m5.lisp \
-     workshops/2003/moore_vcg/support/m5.acl2
-workshops/2003/moore_vcg/support/m5.pcert1 : acl2x = 0
-workshops/2003/moore_vcg/support/m5.pcert1 : no_pcert = 0
-workshops/2003/moore_vcg/support/m5.pcert1 : workshops/2003/moore_vcg/support/m5.pcert0
-workshops/2003/moore_vcg/support/m5.cert : | workshops/2003/moore_vcg/support/m5.pcert1
-
-workshops/2003/moore_vcg/support/utilities.pcert0 : no_pcert = 0
-workshops/2003/moore_vcg/support/utilities.pcert0 : acl2x = 0
-workshops/2003/moore_vcg/support/utilities.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2003/moore_vcg/support/m5.pcert0 \
-     workshops/2003/moore_vcg/support/utilities.lisp \
-     workshops/2003/moore_vcg/support/utilities.acl2
-workshops/2003/moore_vcg/support/utilities.pcert1 : acl2x = 0
-workshops/2003/moore_vcg/support/utilities.pcert1 : no_pcert = 0
-workshops/2003/moore_vcg/support/utilities.pcert1 : workshops/2003/moore_vcg/support/utilities.pcert0
-workshops/2003/moore_vcg/support/utilities.cert : | workshops/2003/moore_vcg/support/utilities.pcert1
-
-workshops/2003/moore_vcg/support/vcg-examples.pcert0 : no_pcert = 0
-workshops/2003/moore_vcg/support/vcg-examples.pcert0 : acl2x = 0
-workshops/2003/moore_vcg/support/vcg-examples.pcert0 : \
-     misc/defpun.pcert0 \
-     workshops/2003/moore_vcg/support/demo.pcert0 \
-     workshops/2003/moore_vcg/support/utilities.pcert0 \
-     workshops/2003/moore_vcg/support/vcg-examples.lisp \
-     workshops/2003/moore_vcg/support/vcg-examples.acl2
-workshops/2003/moore_vcg/support/vcg-examples.pcert1 : acl2x = 0
-workshops/2003/moore_vcg/support/vcg-examples.pcert1 : no_pcert = 0
-workshops/2003/moore_vcg/support/vcg-examples.pcert1 : workshops/2003/moore_vcg/support/vcg-examples.pcert0
-workshops/2003/moore_vcg/support/vcg-examples.cert : | workshops/2003/moore_vcg/support/vcg-examples.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/total-order.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/apply-total-order.lisp
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert1 : workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert0
-workshops/2003/ray-matthews-tuttle/support/apply-total-order.cert : | workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/ltl.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/bisimilarity.lisp
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert1 : workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert0
-workshops/2003/ray-matthews-tuttle/support/bisimilarity.cert : | workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/ltl.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/bisimilarity.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/circuit-bisim.lisp
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert1 : workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert0
-workshops/2003/ray-matthews-tuttle/support/circuit-bisim.cert : | workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/circuits.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/circuits.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/circuits.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/circuit-bisim.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/circuits.lisp
-workshops/2003/ray-matthews-tuttle/support/circuits.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/circuits.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/circuits.pcert1 : workshops/2003/ray-matthews-tuttle/support/circuits.pcert0
-workshops/2003/ray-matthews-tuttle/support/circuits.cert : | workshops/2003/ray-matthews-tuttle/support/circuits.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/ltl.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/concrete-ltl.lisp
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.pcert1 : workshops/2003/ray-matthews-tuttle/support/concrete-ltl.pcert0
-workshops/2003/ray-matthews-tuttle/support/concrete-ltl.cert : | workshops/2003/ray-matthews-tuttle/support/concrete-ltl.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/circuits.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/cone-of-influence.lisp
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert1 : workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert0
-workshops/2003/ray-matthews-tuttle/support/cone-of-influence.cert : | workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/conjunction.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/conjunction.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/conjunction.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/ltl.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/conjunction.lisp
-workshops/2003/ray-matthews-tuttle/support/conjunction.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/conjunction.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/conjunction.pcert1 : workshops/2003/ray-matthews-tuttle/support/conjunction.pcert0
-workshops/2003/ray-matthews-tuttle/support/conjunction.cert : | workshops/2003/ray-matthews-tuttle/support/conjunction.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/impl-hack.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/impl-hack.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/impl-hack.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/reductions.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/impl-hack.lisp \
-     workshops/2003/ray-matthews-tuttle/support/impl-hack.acl2
-workshops/2003/ray-matthews-tuttle/support/impl-hack.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/impl-hack.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/impl-hack.pcert1 : workshops/2003/ray-matthews-tuttle/support/impl-hack.pcert0
-workshops/2003/ray-matthews-tuttle/support/impl-hack.cert : | workshops/2003/ray-matthews-tuttle/support/impl-hack.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/ltl.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/ltl.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/ltl.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/sets.pcert0 \
-     arithmetic-2/meta/top.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/ltl.lisp
-workshops/2003/ray-matthews-tuttle/support/ltl.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/ltl.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/ltl.pcert1 : workshops/2003/ray-matthews-tuttle/support/ltl.pcert0
-workshops/2003/ray-matthews-tuttle/support/ltl.cert : | workshops/2003/ray-matthews-tuttle/support/ltl.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/records.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/records.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/records.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/apply-total-order.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/records.lisp
-workshops/2003/ray-matthews-tuttle/support/records.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/records.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/records.pcert1 : workshops/2003/ray-matthews-tuttle/support/records.pcert0
-workshops/2003/ray-matthews-tuttle/support/records.cert : | workshops/2003/ray-matthews-tuttle/support/records.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/reductions.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/reductions.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/reductions.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/conjunction.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/cone-of-influence.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/reductions.lisp
-workshops/2003/ray-matthews-tuttle/support/reductions.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/reductions.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/reductions.pcert1 : workshops/2003/ray-matthews-tuttle/support/reductions.pcert0
-workshops/2003/ray-matthews-tuttle/support/reductions.cert : | workshops/2003/ray-matthews-tuttle/support/reductions.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/sets.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/sets.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/sets.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/records.pcert0 \
-     workshops/2003/ray-matthews-tuttle/support/sets.lisp
-workshops/2003/ray-matthews-tuttle/support/sets.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/sets.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/sets.pcert1 : workshops/2003/ray-matthews-tuttle/support/sets.pcert0
-workshops/2003/ray-matthews-tuttle/support/sets.cert : | workshops/2003/ray-matthews-tuttle/support/sets.pcert1
-
-workshops/2003/ray-matthews-tuttle/support/total-order.pcert0 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/total-order.pcert0 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/total-order.pcert0 : \
-     workshops/2003/ray-matthews-tuttle/support/total-order.lisp
-workshops/2003/ray-matthews-tuttle/support/total-order.pcert1 : acl2x = 0
-workshops/2003/ray-matthews-tuttle/support/total-order.pcert1 : no_pcert = 0
-workshops/2003/ray-matthews-tuttle/support/total-order.pcert1 : workshops/2003/ray-matthews-tuttle/support/total-order.pcert0
-workshops/2003/ray-matthews-tuttle/support/total-order.cert : | workshops/2003/ray-matthews-tuttle/support/total-order.pcert1
-
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.pcert0 : no_pcert = 0
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.pcert0 : acl2x = 0
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.pcert0 : \
-     misc/expander.pcert0 \
-     workshops/2003/schmaltz-al-sammane-et-al/support/consistency.lisp
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.pcert1 : acl2x = 0
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.pcert1 : no_pcert = 0
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.pcert1 : workshops/2003/schmaltz-al-sammane-et-al/support/consistency.pcert0
-workshops/2003/schmaltz-al-sammane-et-al/support/consistency.cert : | workshops/2003/schmaltz-al-sammane-et-al/support/consistency.pcert1
-
-workshops/2003/schmaltz-borrione/support/arbiter.pcert0 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/arbiter.pcert0 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/arbiter.pcert0 : \
-     workshops/2003/schmaltz-borrione/support/inequalities.pcert0 \
-     workshops/2003/schmaltz-borrione/support/decoder.pcert0 \
-     workshops/2003/schmaltz-borrione/support/predicates.pcert0 \
-     workshops/2003/schmaltz-borrione/support/arbiter.lisp
-workshops/2003/schmaltz-borrione/support/arbiter.pcert1 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/arbiter.pcert1 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/arbiter.pcert1 : workshops/2003/schmaltz-borrione/support/arbiter.pcert0
-workshops/2003/schmaltz-borrione/support/arbiter.cert : | workshops/2003/schmaltz-borrione/support/arbiter.pcert1
-
-workshops/2003/schmaltz-borrione/support/decoder.pcert0 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/decoder.pcert0 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/decoder.pcert0 : \
-     arithmetic/top.pcert0 \
-     arithmetic-2/floor-mod/floor-mod.pcert0 \
-     workshops/2003/schmaltz-borrione/support/decoder.lisp
-workshops/2003/schmaltz-borrione/support/decoder.pcert1 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/decoder.pcert1 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/decoder.pcert1 : workshops/2003/schmaltz-borrione/support/decoder.pcert0
-workshops/2003/schmaltz-borrione/support/decoder.cert : | workshops/2003/schmaltz-borrione/support/decoder.pcert1
-
-workshops/2003/schmaltz-borrione/support/inequalities.pcert0 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/inequalities.pcert0 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/inequalities.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/2003/schmaltz-borrione/support/inequalities.lisp
-workshops/2003/schmaltz-borrione/support/inequalities.pcert1 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/inequalities.pcert1 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/inequalities.pcert1 : workshops/2003/schmaltz-borrione/support/inequalities.pcert0
-workshops/2003/schmaltz-borrione/support/inequalities.cert : | workshops/2003/schmaltz-borrione/support/inequalities.pcert1
-
-workshops/2003/schmaltz-borrione/support/predicates.pcert0 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/predicates.pcert0 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/predicates.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2003/schmaltz-borrione/support/predicates.lisp
-workshops/2003/schmaltz-borrione/support/predicates.pcert1 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/predicates.pcert1 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/predicates.pcert1 : workshops/2003/schmaltz-borrione/support/predicates.pcert0
-workshops/2003/schmaltz-borrione/support/predicates.cert : | workshops/2003/schmaltz-borrione/support/predicates.pcert1
-
-workshops/2003/schmaltz-borrione/support/transfers.pcert0 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/transfers.pcert0 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/transfers.pcert0 : \
-     workshops/2003/schmaltz-borrione/support/decoder.pcert0 \
-     workshops/2003/schmaltz-borrione/support/arbiter.pcert0 \
-     workshops/2003/schmaltz-borrione/support/transfers.lisp
-workshops/2003/schmaltz-borrione/support/transfers.pcert1 : acl2x = 0
-workshops/2003/schmaltz-borrione/support/transfers.pcert1 : no_pcert = 0
-workshops/2003/schmaltz-borrione/support/transfers.pcert1 : workshops/2003/schmaltz-borrione/support/transfers.pcert0
-workshops/2003/schmaltz-borrione/support/transfers.cert : | workshops/2003/schmaltz-borrione/support/transfers.pcert1
-
-workshops/2003/sumners/support/cfair.pcert0 : no_pcert = 0
-workshops/2003/sumners/support/cfair.pcert0 : acl2x = 0
-workshops/2003/sumners/support/cfair.pcert0 : \
-     workshops/2003/sumners/support/n2n.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/sumners/support/cfair.lisp
-workshops/2003/sumners/support/cfair.pcert1 : acl2x = 0
-workshops/2003/sumners/support/cfair.pcert1 : no_pcert = 0
-workshops/2003/sumners/support/cfair.pcert1 : workshops/2003/sumners/support/cfair.pcert0
-workshops/2003/sumners/support/cfair.cert : | workshops/2003/sumners/support/cfair.pcert1
-
-workshops/2003/sumners/support/example1.pcert0 : no_pcert = 0
-workshops/2003/sumners/support/example1.pcert0 : acl2x = 0
-workshops/2003/sumners/support/example1.pcert0 : \
-     workshops/2003/sumners/support/fair1.pcert0 \
-     workshops/2003/sumners/support/example1.lisp
-workshops/2003/sumners/support/example1.pcert1 : acl2x = 0
-workshops/2003/sumners/support/example1.pcert1 : no_pcert = 0
-workshops/2003/sumners/support/example1.pcert1 : workshops/2003/sumners/support/example1.pcert0
-workshops/2003/sumners/support/example1.cert : | workshops/2003/sumners/support/example1.pcert1
-
-workshops/2003/sumners/support/example2.pcert0 : no_pcert = 0
-workshops/2003/sumners/support/example2.pcert0 : acl2x = 0
-workshops/2003/sumners/support/example2.pcert0 : \
-     workshops/2003/sumners/support/fair2.pcert0 \
-     workshops/2003/sumners/support/example2.lisp
-workshops/2003/sumners/support/example2.pcert1 : acl2x = 0
-workshops/2003/sumners/support/example2.pcert1 : no_pcert = 0
-workshops/2003/sumners/support/example2.pcert1 : workshops/2003/sumners/support/example2.pcert0
-workshops/2003/sumners/support/example2.cert : | workshops/2003/sumners/support/example2.pcert1
-
-workshops/2003/sumners/support/example3.pcert0 : no_pcert = 0
-workshops/2003/sumners/support/example3.pcert0 : acl2x = 0
-workshops/2003/sumners/support/example3.pcert0 : \
-     workshops/2003/sumners/support/fair2.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/sumners/support/example3.lisp
-workshops/2003/sumners/support/example3.pcert1 : acl2x = 0
-workshops/2003/sumners/support/example3.pcert1 : no_pcert = 0
-workshops/2003/sumners/support/example3.pcert1 : workshops/2003/sumners/support/example3.pcert0
-workshops/2003/sumners/support/example3.cert : | workshops/2003/sumners/support/example3.pcert1
-
-workshops/2003/sumners/support/fair1.pcert0 : no_pcert = 0
-workshops/2003/sumners/support/fair1.pcert0 : acl2x = 0
-workshops/2003/sumners/support/fair1.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/sumners/support/fair1.lisp
-workshops/2003/sumners/support/fair1.pcert1 : acl2x = 0
-workshops/2003/sumners/support/fair1.pcert1 : no_pcert = 0
-workshops/2003/sumners/support/fair1.pcert1 : workshops/2003/sumners/support/fair1.pcert0
-workshops/2003/sumners/support/fair1.cert : | workshops/2003/sumners/support/fair1.pcert1
-
-workshops/2003/sumners/support/fair2.pcert0 : no_pcert = 0
-workshops/2003/sumners/support/fair2.pcert0 : acl2x = 0
-workshops/2003/sumners/support/fair2.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2003/sumners/support/n2n.pcert0 \
-     workshops/2003/sumners/support/fair2.lisp
-workshops/2003/sumners/support/fair2.pcert1 : acl2x = 0
-workshops/2003/sumners/support/fair2.pcert1 : no_pcert = 0
-workshops/2003/sumners/support/fair2.pcert1 : workshops/2003/sumners/support/fair2.pcert0
-workshops/2003/sumners/support/fair2.cert : | workshops/2003/sumners/support/fair2.pcert1
-
-workshops/2003/sumners/support/n2n.pcert0 : no_pcert = 0
-workshops/2003/sumners/support/n2n.pcert0 : acl2x = 0
-workshops/2003/sumners/support/n2n.pcert0 : \
-     workshops/2003/sumners/support/n2n.lisp
-workshops/2003/sumners/support/n2n.pcert1 : acl2x = 0
-workshops/2003/sumners/support/n2n.pcert1 : no_pcert = 0
-workshops/2003/sumners/support/n2n.pcert1 : workshops/2003/sumners/support/n2n.pcert0
-workshops/2003/sumners/support/n2n.cert : | workshops/2003/sumners/support/n2n.pcert1
-
-workshops/2003/sumners/support/simple.pcert0 : no_pcert = 0
-workshops/2003/sumners/support/simple.pcert0 : acl2x = 0
-workshops/2003/sumners/support/simple.pcert0 : \
-     workshops/2003/sumners/support/simple.lisp
-workshops/2003/sumners/support/simple.pcert1 : acl2x = 0
-workshops/2003/sumners/support/simple.pcert1 : no_pcert = 0
-workshops/2003/sumners/support/simple.pcert1 : workshops/2003/sumners/support/simple.pcert0
-workshops/2003/sumners/support/simple.cert : | workshops/2003/sumners/support/simple.pcert1
-
-workshops/2003/sustik/support/dickson.pcert0 : no_pcert = 0
-workshops/2003/sustik/support/dickson.pcert0 : acl2x = 0
-workshops/2003/sustik/support/dickson.pcert0 : \
-     ordinals/ordinals.pcert0 \
-     workshops/2003/sustik/support/dickson.lisp
-workshops/2003/sustik/support/dickson.pcert1 : acl2x = 0
-workshops/2003/sustik/support/dickson.pcert1 : no_pcert = 0
-workshops/2003/sustik/support/dickson.pcert1 : workshops/2003/sustik/support/dickson.pcert0
-workshops/2003/sustik/support/dickson.cert : | workshops/2003/sustik/support/dickson.pcert1
-
-workshops/2003/toma-borrione/support/bv-op-defthms.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/bv-op-defthms.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/bv-op-defthms.pcert0 : \
-     workshops/2003/toma-borrione/support/bv-op-defuns.pcert0 \
-     workshops/2003/toma-borrione/support/bv-op-defthms.lisp
-workshops/2003/toma-borrione/support/bv-op-defthms.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/bv-op-defthms.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/bv-op-defthms.pcert1 : workshops/2003/toma-borrione/support/bv-op-defthms.pcert0
-workshops/2003/toma-borrione/support/bv-op-defthms.cert : | workshops/2003/toma-borrione/support/bv-op-defthms.pcert1
-
-workshops/2003/toma-borrione/support/bv-op-defuns.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/bv-op-defuns.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/bv-op-defuns.pcert0 : \
-     workshops/2003/toma-borrione/support/misc.pcert0 \
-     workshops/2003/toma-borrione/support/bv-op-defuns.lisp
-workshops/2003/toma-borrione/support/bv-op-defuns.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/bv-op-defuns.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/bv-op-defuns.pcert1 : workshops/2003/toma-borrione/support/bv-op-defuns.pcert0
-workshops/2003/toma-borrione/support/bv-op-defuns.cert : | workshops/2003/toma-borrione/support/bv-op-defuns.pcert1
-
-workshops/2003/toma-borrione/support/misc.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/misc.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/misc.pcert0 : \
-     arithmetic/equalities.pcert0 \
-     arithmetic/inequalities.pcert0 \
-     arithmetic-2/floor-mod/floor-mod.pcert0 \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2003/toma-borrione/support/misc.lisp
-workshops/2003/toma-borrione/support/misc.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/misc.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/misc.pcert1 : workshops/2003/toma-borrione/support/misc.pcert0
-workshops/2003/toma-borrione/support/misc.cert : | workshops/2003/toma-borrione/support/misc.pcert1
-
-workshops/2003/toma-borrione/support/padding-1-256.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/padding-1-256.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/padding-1-256.pcert0 : \
-     workshops/2003/toma-borrione/support/bv-op-defthms.pcert0 \
-     workshops/2003/toma-borrione/support/padding-1-256.lisp
-workshops/2003/toma-borrione/support/padding-1-256.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/padding-1-256.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/padding-1-256.pcert1 : workshops/2003/toma-borrione/support/padding-1-256.pcert0
-workshops/2003/toma-borrione/support/padding-1-256.cert : | workshops/2003/toma-borrione/support/padding-1-256.pcert1
-
-workshops/2003/toma-borrione/support/padding-384-512.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/padding-384-512.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/padding-384-512.pcert0 : \
-     workshops/2003/toma-borrione/support/bv-op-defthms.pcert0 \
-     workshops/2003/toma-borrione/support/padding-384-512.lisp
-workshops/2003/toma-borrione/support/padding-384-512.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/padding-384-512.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/padding-384-512.pcert1 : workshops/2003/toma-borrione/support/padding-384-512.pcert0
-workshops/2003/toma-borrione/support/padding-384-512.cert : | workshops/2003/toma-borrione/support/padding-384-512.pcert1
-
-workshops/2003/toma-borrione/support/parsing.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/parsing.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/parsing.pcert0 : \
-     workshops/2003/toma-borrione/support/padding-1-256.pcert0 \
-     workshops/2003/toma-borrione/support/padding-384-512.pcert0 \
-     workshops/2003/toma-borrione/support/parsing.lisp
-workshops/2003/toma-borrione/support/parsing.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/parsing.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/parsing.pcert1 : workshops/2003/toma-borrione/support/parsing.pcert0
-workshops/2003/toma-borrione/support/parsing.cert : | workshops/2003/toma-borrione/support/parsing.pcert1
-
-workshops/2003/toma-borrione/support/sha-1.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/sha-1.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/sha-1.pcert0 : \
-     workshops/2003/toma-borrione/support/parsing.pcert0 \
-     workshops/2003/toma-borrione/support/sha-functions.pcert0 \
-     workshops/2003/toma-borrione/support/sha-1.lisp
-workshops/2003/toma-borrione/support/sha-1.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/sha-1.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/sha-1.pcert1 : workshops/2003/toma-borrione/support/sha-1.pcert0
-workshops/2003/toma-borrione/support/sha-1.cert : | workshops/2003/toma-borrione/support/sha-1.pcert1
-
-workshops/2003/toma-borrione/support/sha-256.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/sha-256.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/sha-256.pcert0 : \
-     workshops/2003/toma-borrione/support/parsing.pcert0 \
-     workshops/2003/toma-borrione/support/sha-functions.pcert0 \
-     workshops/2003/toma-borrione/support/sha-256.lisp
-workshops/2003/toma-borrione/support/sha-256.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/sha-256.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/sha-256.pcert1 : workshops/2003/toma-borrione/support/sha-256.pcert0
-workshops/2003/toma-borrione/support/sha-256.cert : | workshops/2003/toma-borrione/support/sha-256.pcert1
-
-workshops/2003/toma-borrione/support/sha-384-512.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/sha-384-512.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/sha-384-512.pcert0 : \
-     workshops/2003/toma-borrione/support/parsing.pcert0 \
-     workshops/2003/toma-borrione/support/sha-functions.pcert0 \
-     workshops/2003/toma-borrione/support/sha-384-512.lisp
-workshops/2003/toma-borrione/support/sha-384-512.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/sha-384-512.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/sha-384-512.pcert1 : workshops/2003/toma-borrione/support/sha-384-512.pcert0
-workshops/2003/toma-borrione/support/sha-384-512.cert : | workshops/2003/toma-borrione/support/sha-384-512.pcert1
-
-workshops/2003/toma-borrione/support/sha-functions.pcert0 : no_pcert = 0
-workshops/2003/toma-borrione/support/sha-functions.pcert0 : acl2x = 0
-workshops/2003/toma-borrione/support/sha-functions.pcert0 : \
-     workshops/2003/toma-borrione/support/bv-op-defthms.pcert0 \
-     workshops/2003/toma-borrione/support/sha-functions.lisp
-workshops/2003/toma-borrione/support/sha-functions.pcert1 : acl2x = 0
-workshops/2003/toma-borrione/support/sha-functions.pcert1 : no_pcert = 0
-workshops/2003/toma-borrione/support/sha-functions.pcert1 : workshops/2003/toma-borrione/support/sha-functions.pcert0
-workshops/2003/toma-borrione/support/sha-functions.cert : | workshops/2003/toma-borrione/support/sha-functions.pcert1
-
-workshops/2003/tsong/support/shim.pcert0 : no_pcert = 0
-workshops/2003/tsong/support/shim.pcert0 : acl2x = 0
-workshops/2003/tsong/support/shim.pcert0 : \
-     data-structures/structures.pcert0 \
-     workshops/2003/tsong/support/shim.lisp
-workshops/2003/tsong/support/shim.pcert1 : acl2x = 0
-workshops/2003/tsong/support/shim.pcert1 : no_pcert = 0
-workshops/2003/tsong/support/shim.pcert1 : workshops/2003/tsong/support/shim.pcert0
-workshops/2003/tsong/support/shim.cert : | workshops/2003/tsong/support/shim.pcert1
-
-workshops/2004/cowles-gamboa/support/WyoM1-correct.pcert0 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/WyoM1-correct.pcert0 : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1-correct.pcert0 : \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert0 \
-     misc/defpun.pcert0 \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert0 \
-     workshops/2004/cowles-gamboa/support/WyoM1-correct.lisp \
-     workshops/2004/cowles-gamboa/support/WyoM1-correct.acl2
-workshops/2004/cowles-gamboa/support/WyoM1-correct.pcert1 : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1-correct.pcert1 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/WyoM1-correct.pcert1 : workshops/2004/cowles-gamboa/support/WyoM1-correct.pcert0
-workshops/2004/cowles-gamboa/support/WyoM1-correct.cert : | workshops/2004/cowles-gamboa/support/WyoM1-correct.pcert1
-
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert0 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert0 : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert0 : \
-     workshops/2004/cowles-gamboa/support/WyoM1.pcert0 \
-     arithmetic/top.pcert0 \
-     workshops/2004/cowles-gamboa/support/WyoM1.pcert0 \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.lisp \
-     workshops/2004/cowles-gamboa/support/WyoM1-utilities.acl2
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert1 : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert1 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert1 : workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert0
-workshops/2004/cowles-gamboa/support/WyoM1-utilities.cert : | workshops/2004/cowles-gamboa/support/WyoM1-utilities.pcert1
-
-workshops/2004/cowles-gamboa/support/WyoM1.pcert0 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/WyoM1.pcert0 : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1.pcert0 : \
-     workshops/2004/cowles-gamboa/support/WyoM1.lisp \
-     workshops/2004/cowles-gamboa/support/WyoM1.acl2
-workshops/2004/cowles-gamboa/support/WyoM1.pcert1 : acl2x = 0
-workshops/2004/cowles-gamboa/support/WyoM1.pcert1 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/WyoM1.pcert1 : workshops/2004/cowles-gamboa/support/WyoM1.pcert0
-workshops/2004/cowles-gamboa/support/WyoM1.cert : | workshops/2004/cowles-gamboa/support/WyoM1.pcert1
-
-workshops/2004/cowles-gamboa/support/knuth.pcert0 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/knuth.pcert0 : acl2x = 0
-workshops/2004/cowles-gamboa/support/knuth.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/2004/cowles-gamboa/support/knuth.lisp
-workshops/2004/cowles-gamboa/support/knuth.pcert1 : acl2x = 0
-workshops/2004/cowles-gamboa/support/knuth.pcert1 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/knuth.pcert1 : workshops/2004/cowles-gamboa/support/knuth.pcert0
-workshops/2004/cowles-gamboa/support/knuth.cert : | workshops/2004/cowles-gamboa/support/knuth.pcert1
-
-workshops/2004/cowles-gamboa/support/tail-rec.pcert0 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/tail-rec.pcert0 : acl2x = 0
-workshops/2004/cowles-gamboa/support/tail-rec.pcert0 : \
-     misc/defpun.pcert0 \
-     workshops/2004/cowles-gamboa/support/tail-rec.lisp \
-     workshops/2004/cowles-gamboa/support/tail-rec.acl2
-workshops/2004/cowles-gamboa/support/tail-rec.pcert1 : acl2x = 0
-workshops/2004/cowles-gamboa/support/tail-rec.pcert1 : no_pcert = 0
-workshops/2004/cowles-gamboa/support/tail-rec.pcert1 : workshops/2004/cowles-gamboa/support/tail-rec.pcert0
-workshops/2004/cowles-gamboa/support/tail-rec.cert : | workshops/2004/cowles-gamboa/support/tail-rec.pcert1
-
-workshops/2004/davis/support/computed-hints.pcert0 : no_pcert = 0
-workshops/2004/davis/support/computed-hints.pcert0 : acl2x = 0
-workshops/2004/davis/support/computed-hints.pcert0 : \
-     workshops/2004/davis/support/instance.pcert0 \
-     workshops/2004/davis/support/computed-hints.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/computed-hints.pcert1 : acl2x = 0
-workshops/2004/davis/support/computed-hints.pcert1 : no_pcert = 0
-workshops/2004/davis/support/computed-hints.pcert1 : workshops/2004/davis/support/computed-hints.pcert0
-workshops/2004/davis/support/computed-hints.cert : | workshops/2004/davis/support/computed-hints.pcert1
-
-workshops/2004/davis/support/fast.pcert0 : no_pcert = 0
-workshops/2004/davis/support/fast.pcert0 : acl2x = 0
-workshops/2004/davis/support/fast.pcert0 : \
-     workshops/2004/davis/support/membership.pcert0 \
-     workshops/2004/davis/support/fast.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/fast.pcert1 : acl2x = 0
-workshops/2004/davis/support/fast.pcert1 : no_pcert = 0
-workshops/2004/davis/support/fast.pcert1 : workshops/2004/davis/support/fast.pcert0
-workshops/2004/davis/support/fast.cert : | workshops/2004/davis/support/fast.pcert1
-
-workshops/2004/davis/support/instance.pcert0 : no_pcert = 0
-workshops/2004/davis/support/instance.pcert0 : acl2x = 0
-workshops/2004/davis/support/instance.pcert0 : \
-     workshops/2004/davis/support/instance.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/instance.pcert1 : acl2x = 0
-workshops/2004/davis/support/instance.pcert1 : no_pcert = 0
-workshops/2004/davis/support/instance.pcert1 : workshops/2004/davis/support/instance.pcert0
-workshops/2004/davis/support/instance.cert : | workshops/2004/davis/support/instance.pcert1
-
-workshops/2004/davis/support/map.pcert0 : no_pcert = 0
-workshops/2004/davis/support/map.pcert0 : acl2x = 0
-workshops/2004/davis/support/map.pcert0 : \
-     workshops/2004/davis/support/quantify.pcert0 \
-     workshops/2004/davis/support/map.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/map.pcert1 : acl2x = 0
-workshops/2004/davis/support/map.pcert1 : no_pcert = 0
-workshops/2004/davis/support/map.pcert1 : workshops/2004/davis/support/map.pcert0
-workshops/2004/davis/support/map.cert : | workshops/2004/davis/support/map.pcert1
-
-workshops/2004/davis/support/membership.pcert0 : no_pcert = 0
-workshops/2004/davis/support/membership.pcert0 : acl2x = 0
-workshops/2004/davis/support/membership.pcert0 : \
-     workshops/2004/davis/support/primitives.pcert0 \
-     workshops/2004/davis/support/computed-hints.pcert0 \
-     workshops/2004/davis/support/membership.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/membership.pcert1 : acl2x = 0
-workshops/2004/davis/support/membership.pcert1 : no_pcert = 0
-workshops/2004/davis/support/membership.pcert1 : workshops/2004/davis/support/membership.pcert0
-workshops/2004/davis/support/membership.cert : | workshops/2004/davis/support/membership.pcert1
-
-workshops/2004/davis/support/outer.pcert0 : no_pcert = 0
-workshops/2004/davis/support/outer.pcert0 : acl2x = 0
-workshops/2004/davis/support/outer.pcert0 : \
-     workshops/2004/davis/support/fast.pcert0 \
-     workshops/2004/davis/support/outer.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/outer.pcert1 : acl2x = 0
-workshops/2004/davis/support/outer.pcert1 : no_pcert = 0
-workshops/2004/davis/support/outer.pcert1 : workshops/2004/davis/support/outer.pcert0
-workshops/2004/davis/support/outer.cert : | workshops/2004/davis/support/outer.pcert1
-
-workshops/2004/davis/support/primitives.pcert0 : no_pcert = 0
-workshops/2004/davis/support/primitives.pcert0 : acl2x = 0
-workshops/2004/davis/support/primitives.pcert0 : \
-     workshops/2004/davis/support/primitives.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/primitives.pcert1 : acl2x = 0
-workshops/2004/davis/support/primitives.pcert1 : no_pcert = 0
-workshops/2004/davis/support/primitives.pcert1 : workshops/2004/davis/support/primitives.pcert0
-workshops/2004/davis/support/primitives.cert : | workshops/2004/davis/support/primitives.pcert1
-
-workshops/2004/davis/support/quantify.pcert0 : no_pcert = 0
-workshops/2004/davis/support/quantify.pcert0 : acl2x = 0
-workshops/2004/davis/support/quantify.pcert0 : \
-     workshops/2004/davis/support/sets.pcert0 \
-     workshops/2004/davis/support/sets.pcert0 \
-     workshops/2004/davis/support/quantify.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/quantify.pcert1 : acl2x = 0
-workshops/2004/davis/support/quantify.pcert1 : no_pcert = 0
-workshops/2004/davis/support/quantify.pcert1 : workshops/2004/davis/support/quantify.pcert0
-workshops/2004/davis/support/quantify.cert : | workshops/2004/davis/support/quantify.pcert1
-
-workshops/2004/davis/support/set-order.pcert0 : no_pcert = 0
-workshops/2004/davis/support/set-order.pcert0 : acl2x = 0
-workshops/2004/davis/support/set-order.pcert0 : \
-     workshops/2004/davis/support/primitives.pcert0 \
-     workshops/2004/davis/support/membership.pcert0 \
-     workshops/2004/davis/support/fast.pcert0 \
-     workshops/2004/davis/support/sets.pcert0 \
-     workshops/2004/davis/support/set-order.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/set-order.pcert1 : acl2x = 0
-workshops/2004/davis/support/set-order.pcert1 : no_pcert = 0
-workshops/2004/davis/support/set-order.pcert1 : workshops/2004/davis/support/set-order.pcert0
-workshops/2004/davis/support/set-order.cert : | workshops/2004/davis/support/set-order.pcert1
-
-workshops/2004/davis/support/sets.pcert0 : no_pcert = 0
-workshops/2004/davis/support/sets.pcert0 : acl2x = 0
-workshops/2004/davis/support/sets.pcert0 : \
-     workshops/2004/davis/support/computed-hints.pcert0 \
-     workshops/2004/davis/support/primitives.pcert0 \
-     workshops/2004/davis/support/membership.pcert0 \
-     workshops/2004/davis/support/fast.pcert0 \
-     workshops/2004/davis/support/outer.pcert0 \
-     workshops/2004/davis/support/sort.pcert0 \
-     workshops/2004/davis/support/sets.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/sets.pcert1 : acl2x = 0
-workshops/2004/davis/support/sets.pcert1 : no_pcert = 0
-workshops/2004/davis/support/sets.pcert1 : workshops/2004/davis/support/sets.pcert0
-workshops/2004/davis/support/sets.cert : | workshops/2004/davis/support/sets.pcert1
-
-workshops/2004/davis/support/sort.pcert0 : no_pcert = 0
-workshops/2004/davis/support/sort.pcert0 : acl2x = 0
-workshops/2004/davis/support/sort.pcert0 : \
-     workshops/2004/davis/support/outer.pcert0 \
-     workshops/2004/davis/support/sort.lisp \
-     workshops/2004/davis/support/cert.acl2 \
-     workshops/2004/davis/support/package.lsp
-workshops/2004/davis/support/sort.pcert1 : acl2x = 0
-workshops/2004/davis/support/sort.pcert1 : no_pcert = 0
-workshops/2004/davis/support/sort.pcert1 : workshops/2004/davis/support/sort.pcert0
-workshops/2004/davis/support/sort.cert : | workshops/2004/davis/support/sort.pcert1
-
-workshops/2004/gameiro-manolios/support/interval.pcert0 : no_pcert = 0
-workshops/2004/gameiro-manolios/support/interval.pcert0 : acl2x = 0
-workshops/2004/gameiro-manolios/support/interval.pcert0 : \
-     workshops/2004/gameiro-manolios/support/top-with-meta.pcert0 \
-     workshops/2004/gameiro-manolios/support/nth-thms.pcert0 \
-     workshops/2004/gameiro-manolios/support/interval.lisp
-workshops/2004/gameiro-manolios/support/interval.pcert1 : acl2x = 0
-workshops/2004/gameiro-manolios/support/interval.pcert1 : no_pcert = 0
-workshops/2004/gameiro-manolios/support/interval.pcert1 : workshops/2004/gameiro-manolios/support/interval.pcert0
-workshops/2004/gameiro-manolios/support/interval.cert : | workshops/2004/gameiro-manolios/support/interval.pcert1
-
-workshops/2004/gameiro-manolios/support/nth-thms.pcert0 : no_pcert = 0
-workshops/2004/gameiro-manolios/support/nth-thms.pcert0 : acl2x = 0
-workshops/2004/gameiro-manolios/support/nth-thms.pcert0 : \
-     workshops/2004/gameiro-manolios/support/nth-thms.lisp
-workshops/2004/gameiro-manolios/support/nth-thms.pcert1 : acl2x = 0
-workshops/2004/gameiro-manolios/support/nth-thms.pcert1 : no_pcert = 0
-workshops/2004/gameiro-manolios/support/nth-thms.pcert1 : workshops/2004/gameiro-manolios/support/nth-thms.pcert0
-workshops/2004/gameiro-manolios/support/nth-thms.cert : | workshops/2004/gameiro-manolios/support/nth-thms.pcert1
-
-workshops/2004/gameiro-manolios/support/top-with-meta.pcert0 : no_pcert = 0
-workshops/2004/gameiro-manolios/support/top-with-meta.pcert0 : acl2x = 0
-workshops/2004/gameiro-manolios/support/top-with-meta.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2004/gameiro-manolios/support/top-with-meta.lisp
-workshops/2004/gameiro-manolios/support/top-with-meta.pcert1 : acl2x = 0
-workshops/2004/gameiro-manolios/support/top-with-meta.pcert1 : no_pcert = 0
-workshops/2004/gameiro-manolios/support/top-with-meta.pcert1 : workshops/2004/gameiro-manolios/support/top-with-meta.pcert0
-workshops/2004/gameiro-manolios/support/top-with-meta.cert : | workshops/2004/gameiro-manolios/support/top-with-meta.pcert1
-
-workshops/2004/gameiro-manolios/support/transversality.pcert0 : no_pcert = 0
-workshops/2004/gameiro-manolios/support/transversality.pcert0 : acl2x = 0
-workshops/2004/gameiro-manolios/support/transversality.pcert0 : \
-     workshops/2004/gameiro-manolios/support/interval.pcert0 \
-     workshops/2004/gameiro-manolios/support/transversality.lisp
-workshops/2004/gameiro-manolios/support/transversality.pcert1 : acl2x = 0
-workshops/2004/gameiro-manolios/support/transversality.pcert1 : no_pcert = 0
-workshops/2004/gameiro-manolios/support/transversality.pcert1 : workshops/2004/gameiro-manolios/support/transversality.pcert0
-workshops/2004/gameiro-manolios/support/transversality.cert : | workshops/2004/gameiro-manolios/support/transversality.pcert1
-
-workshops/2004/greve/support/defrecord.pcert0 : no_pcert = 0
-workshops/2004/greve/support/defrecord.pcert0 : acl2x = 0
-workshops/2004/greve/support/defrecord.pcert0 : \
-     misc/records.pcert0 \
-     workshops/2004/greve/support/defrecord.lisp
-workshops/2004/greve/support/defrecord.pcert1 : acl2x = 0
-workshops/2004/greve/support/defrecord.pcert1 : no_pcert = 0
-workshops/2004/greve/support/defrecord.pcert1 : workshops/2004/greve/support/defrecord.pcert0
-workshops/2004/greve/support/defrecord.cert : | workshops/2004/greve/support/defrecord.pcert1
-
-workshops/2004/greve/support/mark.pcert0 : no_pcert = 0
-workshops/2004/greve/support/mark.pcert0 : acl2x = 0
-workshops/2004/greve/support/mark.pcert0 : \
-     workshops/2004/greve/support/defrecord.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2004/greve/support/mark.lisp
-workshops/2004/greve/support/mark.pcert1 : acl2x = 0
-workshops/2004/greve/support/mark.pcert1 : no_pcert = 0
-workshops/2004/greve/support/mark.pcert1 : workshops/2004/greve/support/mark.pcert0
-workshops/2004/greve/support/mark.cert : | workshops/2004/greve/support/mark.pcert1
-
-workshops/2004/legato/support/generic-theories.pcert0 : no_pcert = 0
-workshops/2004/legato/support/generic-theories.pcert0 : acl2x = 0
-workshops/2004/legato/support/generic-theories.pcert0 : \
-     workshops/2004/legato/support/generic-theories.lisp
-workshops/2004/legato/support/generic-theories.pcert1 : acl2x = 0
-workshops/2004/legato/support/generic-theories.pcert1 : no_pcert = 0
-workshops/2004/legato/support/generic-theories.pcert1 : workshops/2004/legato/support/generic-theories.pcert0
-workshops/2004/legato/support/generic-theories.cert : | workshops/2004/legato/support/generic-theories.pcert1
-
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.pcert0 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.pcert0 : acl2x = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/legato/support/generic-theories.pcert0 \
-     workshops/2004/legato/support/generic-theory-alternative-induction-mult.lisp
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.pcert1 : acl2x = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.pcert1 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.pcert1 : workshops/2004/legato/support/generic-theory-alternative-induction-mult.pcert0
-workshops/2004/legato/support/generic-theory-alternative-induction-mult.cert : | workshops/2004/legato/support/generic-theory-alternative-induction-mult.pcert1
-
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.pcert0 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.pcert0 : acl2x = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/legato/support/generic-theories.pcert0 \
-     workshops/2004/legato/support/generic-theory-alternative-induction-sum.lisp
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.pcert1 : acl2x = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.pcert1 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.pcert1 : workshops/2004/legato/support/generic-theory-alternative-induction-sum.pcert0
-workshops/2004/legato/support/generic-theory-alternative-induction-sum.cert : | workshops/2004/legato/support/generic-theory-alternative-induction-sum.pcert1
-
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.pcert0 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.pcert0 : acl2x = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/legato/support/generic-theories.pcert0 \
-     workshops/2004/legato/support/generic-theory-loop-invariant-mult.lisp
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.pcert1 : acl2x = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.pcert1 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.pcert1 : workshops/2004/legato/support/generic-theory-loop-invariant-mult.pcert0
-workshops/2004/legato/support/generic-theory-loop-invariant-mult.cert : | workshops/2004/legato/support/generic-theory-loop-invariant-mult.pcert1
-
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.pcert0 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.pcert0 : acl2x = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/legato/support/generic-theories.pcert0 \
-     workshops/2004/legato/support/generic-theory-loop-invariant-sum.lisp
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.pcert1 : acl2x = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.pcert1 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.pcert1 : workshops/2004/legato/support/generic-theory-loop-invariant-sum.pcert0
-workshops/2004/legato/support/generic-theory-loop-invariant-sum.cert : | workshops/2004/legato/support/generic-theory-loop-invariant-sum.pcert1
-
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.pcert0 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.pcert0 : acl2x = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/legato/support/generic-theories.pcert0 \
-     workshops/2004/legato/support/generic-theory-tail-recursion-mult.lisp
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.pcert1 : acl2x = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.pcert1 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.pcert1 : workshops/2004/legato/support/generic-theory-tail-recursion-mult.pcert0
-workshops/2004/legato/support/generic-theory-tail-recursion-mult.cert : | workshops/2004/legato/support/generic-theory-tail-recursion-mult.pcert1
-
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.pcert0 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.pcert0 : acl2x = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/legato/support/generic-theories.pcert0 \
-     workshops/2004/legato/support/generic-theory-tail-recursion-sum.lisp
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.pcert1 : acl2x = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.pcert1 : no_pcert = 0
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.pcert1 : workshops/2004/legato/support/generic-theory-tail-recursion-sum.pcert0
-workshops/2004/legato/support/generic-theory-tail-recursion-sum.cert : | workshops/2004/legato/support/generic-theory-tail-recursion-sum.pcert1
-
-workshops/2004/legato/support/proof-by-generalization-mult.pcert0 : no_pcert = 0
-workshops/2004/legato/support/proof-by-generalization-mult.pcert0 : acl2x = 0
-workshops/2004/legato/support/proof-by-generalization-mult.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/legato/support/proof-by-generalization-mult.lisp
-workshops/2004/legato/support/proof-by-generalization-mult.pcert1 : acl2x = 0
-workshops/2004/legato/support/proof-by-generalization-mult.pcert1 : no_pcert = 0
-workshops/2004/legato/support/proof-by-generalization-mult.pcert1 : workshops/2004/legato/support/proof-by-generalization-mult.pcert0
-workshops/2004/legato/support/proof-by-generalization-mult.cert : | workshops/2004/legato/support/proof-by-generalization-mult.pcert1
-
-workshops/2004/legato/support/proof-by-generalization-sum.pcert0 : no_pcert = 0
-workshops/2004/legato/support/proof-by-generalization-sum.pcert0 : acl2x = 0
-workshops/2004/legato/support/proof-by-generalization-sum.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/legato/support/proof-by-generalization-sum.lisp
-workshops/2004/legato/support/proof-by-generalization-sum.pcert1 : acl2x = 0
-workshops/2004/legato/support/proof-by-generalization-sum.pcert1 : no_pcert = 0
-workshops/2004/legato/support/proof-by-generalization-sum.pcert1 : workshops/2004/legato/support/proof-by-generalization-sum.pcert0
-workshops/2004/legato/support/proof-by-generalization-sum.cert : | workshops/2004/legato/support/proof-by-generalization-sum.pcert1
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.pcert0 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.pcert0 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.pcert0 : \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.lisp
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.pcert1 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.pcert1 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.pcert1 : workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.pcert0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.cert : | workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.pcert1
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.pcert0 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.pcert0 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.lisp
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.pcert1 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.pcert1 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.pcert1 : workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.pcert0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.cert : | workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.pcert1
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.pcert0 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.pcert0 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.pcert0 : \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert0 \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/records.lisp
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.pcert1 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.pcert1 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.pcert1 : workshops/2004/manolios-srinivasan/support/Supporting-Books/records.pcert0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/records.cert : | workshops/2004/manolios-srinivasan/support/Supporting-Books/records.pcert1
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.pcert0 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.pcert0 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.pcert0 : \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.lisp
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.pcert1 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.pcert1 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.pcert1 : workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.pcert0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.cert : | workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.pcert1
-
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert0 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert0 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert0 : \
-     workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.lisp
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert1 : acl2x = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert1 : no_pcert = 0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert1 : workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert0
-workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.cert : | workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.pcert1
-
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.pcert0 : no_pcert = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.pcert0 : acl2x = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.pcert0 : \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert0 \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.lisp
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.pcert1 : acl2x = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.pcert1 : no_pcert = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.pcert1 : workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.pcert0
-workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.cert : | workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.pcert1
-
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert0 : no_pcert = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert0 : acl2x = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert0 : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert0 \
-     rtl/rel4/arithmetic/top.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     misc/defpun.pcert0 \
-     ordinals/ordinals.pcert0 \
-     workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.lisp
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert1 : acl2x = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert1 : no_pcert = 0
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert1 : workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert0
-workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.cert : | workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.pcert1
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert0 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert0 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.lisp
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert1 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert1 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert1 : workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert0
-workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.cert : | workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert1
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert0 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert0 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert0 : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert0 \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.lisp
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert1 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert1 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert1 : workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert0
-workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.cert : | workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert1
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.pcert0 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.pcert0 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.pcert0 : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert0 \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.pcert0 \
-     misc/defpun.pcert0 \
-     ordinals/ordinals.pcert0 \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.lisp
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.pcert1 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.pcert1 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.pcert1 : workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.pcert0
-workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.cert : | workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.pcert1
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert0 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert0 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert0 : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.lisp
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert1 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert1 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert1 : workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.cert : | workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.pcert1
-
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert0 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert0 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert0 : \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.lisp
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert1 : acl2x = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert1 : no_pcert = 0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert1 : workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert0
-workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.cert : | workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.pcert1
-
-workshops/2004/ray/support/defcoerce.pcert0 : no_pcert = 0
-workshops/2004/ray/support/defcoerce.pcert0 : acl2x = 0
-workshops/2004/ray/support/defcoerce.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     workshops/2004/ray/support/generic.pcert0 \
-     workshops/2004/ray/support/defcoerce.lisp
-workshops/2004/ray/support/defcoerce.pcert1 : acl2x = 0
-workshops/2004/ray/support/defcoerce.pcert1 : no_pcert = 0
-workshops/2004/ray/support/defcoerce.pcert1 : workshops/2004/ray/support/defcoerce.pcert0
-workshops/2004/ray/support/defcoerce.cert : | workshops/2004/ray/support/defcoerce.pcert1
-
-workshops/2004/ray/support/defpun-exec.pcert0 : no_pcert = 0
-workshops/2004/ray/support/defpun-exec.pcert0 : acl2x = 0
-workshops/2004/ray/support/defpun-exec.pcert0 : \
-     misc/defpun.pcert0 \
-     workshops/2004/ray/support/defpun-exec.lisp
-workshops/2004/ray/support/defpun-exec.pcert1 : acl2x = 0
-workshops/2004/ray/support/defpun-exec.pcert1 : no_pcert = 0
-workshops/2004/ray/support/defpun-exec.pcert1 : workshops/2004/ray/support/defpun-exec.pcert0
-workshops/2004/ray/support/defpun-exec.cert : | workshops/2004/ray/support/defpun-exec.pcert1
-
-workshops/2004/ray/support/generic.pcert0 : no_pcert = 0
-workshops/2004/ray/support/generic.pcert0 : acl2x = 0
-workshops/2004/ray/support/generic.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     workshops/2004/ray/support/generic.lisp
-workshops/2004/ray/support/generic.pcert1 : acl2x = 0
-workshops/2004/ray/support/generic.pcert1 : no_pcert = 0
-workshops/2004/ray/support/generic.pcert1 : workshops/2004/ray/support/generic.pcert0
-workshops/2004/ray/support/generic.cert : | workshops/2004/ray/support/generic.pcert1
-
-workshops/2004/roach-fraij/support/roach-fraij-script.pcert0 : no_pcert = 0
-workshops/2004/roach-fraij/support/roach-fraij-script.pcert0 : acl2x = 0
-workshops/2004/roach-fraij/support/roach-fraij-script.pcert0 : \
-     workshops/2004/roach-fraij/support/roach-fraij-script.lisp
-workshops/2004/roach-fraij/support/roach-fraij-script.pcert1 : acl2x = 0
-workshops/2004/roach-fraij/support/roach-fraij-script.pcert1 : no_pcert = 0
-workshops/2004/roach-fraij/support/roach-fraij-script.pcert1 : workshops/2004/roach-fraij/support/roach-fraij-script.pcert0
-workshops/2004/roach-fraij/support/roach-fraij-script.cert : | workshops/2004/roach-fraij/support/roach-fraij-script.pcert1
-
-workshops/2004/ruiz-et-al/support/basic.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/basic.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/basic.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2004/ruiz-et-al/support/basic.lisp
-workshops/2004/ruiz-et-al/support/basic.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/basic.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/basic.pcert1 : workshops/2004/ruiz-et-al/support/basic.pcert0
-workshops/2004/ruiz-et-al/support/basic.cert : | workshops/2004/ruiz-et-al/support/basic.pcert1
-
-workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert0 : \
-     workshops/2004/ruiz-et-al/support/dags.pcert0 \
-     workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert0 \
-     workshops/2004/ruiz-et-al/support/dag-unification-rules.lisp
-workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert1 : workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert0
-workshops/2004/ruiz-et-al/support/dag-unification-rules.cert : | workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert1
-
-workshops/2004/ruiz-et-al/support/dags.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/dags.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/dags.pcert0 : \
-     workshops/2004/ruiz-et-al/support/basic.pcert0 \
-     workshops/2004/ruiz-et-al/support/lists.pcert0 \
-     workshops/2004/ruiz-et-al/support/dags.lisp
-workshops/2004/ruiz-et-al/support/dags.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/dags.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/dags.pcert1 : workshops/2004/ruiz-et-al/support/dags.pcert0
-workshops/2004/ruiz-et-al/support/dags.cert : | workshops/2004/ruiz-et-al/support/dags.pcert1
-
-workshops/2004/ruiz-et-al/support/lists.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/lists.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/lists.pcert0 : \
-     workshops/2004/ruiz-et-al/support/lists.lisp
-workshops/2004/ruiz-et-al/support/lists.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/lists.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/lists.pcert1 : workshops/2004/ruiz-et-al/support/lists.pcert0
-workshops/2004/ruiz-et-al/support/lists.cert : | workshops/2004/ruiz-et-al/support/lists.pcert1
-
-workshops/2004/ruiz-et-al/support/matching.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/matching.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/matching.pcert0 : \
-     workshops/2004/ruiz-et-al/support/terms.pcert0 \
-     workshops/2004/ruiz-et-al/support/matching.lisp
-workshops/2004/ruiz-et-al/support/matching.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/matching.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/matching.pcert1 : workshops/2004/ruiz-et-al/support/matching.pcert0
-workshops/2004/ruiz-et-al/support/matching.cert : | workshops/2004/ruiz-et-al/support/matching.pcert1
-
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert0 : \
-     workshops/2004/ruiz-et-al/support/subsumption-subst.pcert0 \
-     workshops/2004/ruiz-et-al/support/prefix-unification-rules.lisp
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert1 : workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert0
-workshops/2004/ruiz-et-al/support/prefix-unification-rules.cert : | workshops/2004/ruiz-et-al/support/prefix-unification-rules.pcert1
-
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert0 : \
-     workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert0 \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-rules.lisp
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert1 : workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert0
-workshops/2004/ruiz-et-al/support/q-dag-unification-rules.cert : | workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert1
-
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.pcert0 : \
-     workshops/2004/ruiz-et-al/support/q-dag-unification.pcert0 \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-st.lisp
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.pcert1 : workshops/2004/ruiz-et-al/support/q-dag-unification-st.pcert0
-workshops/2004/ruiz-et-al/support/q-dag-unification-st.cert : | workshops/2004/ruiz-et-al/support/q-dag-unification-st.pcert1
-
-workshops/2004/ruiz-et-al/support/q-dag-unification.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification.pcert0 : \
-     workshops/2004/ruiz-et-al/support/q-dag-unification-rules.pcert0 \
-     workshops/2004/ruiz-et-al/support/terms-as-dag.pcert0 \
-     workshops/2004/ruiz-et-al/support/q-dag-unification.lisp
-workshops/2004/ruiz-et-al/support/q-dag-unification.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/q-dag-unification.pcert1 : workshops/2004/ruiz-et-al/support/q-dag-unification.pcert0
-workshops/2004/ruiz-et-al/support/q-dag-unification.cert : | workshops/2004/ruiz-et-al/support/q-dag-unification.pcert1
-
-workshops/2004/ruiz-et-al/support/subsumption-subst.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/subsumption-subst.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/subsumption-subst.pcert0 : \
-     workshops/2004/ruiz-et-al/support/subsumption.pcert0 \
-     workshops/2004/ruiz-et-al/support/subsumption-subst.lisp
-workshops/2004/ruiz-et-al/support/subsumption-subst.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/subsumption-subst.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/subsumption-subst.pcert1 : workshops/2004/ruiz-et-al/support/subsumption-subst.pcert0
-workshops/2004/ruiz-et-al/support/subsumption-subst.cert : | workshops/2004/ruiz-et-al/support/subsumption-subst.pcert1
-
-workshops/2004/ruiz-et-al/support/subsumption.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/subsumption.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/subsumption.pcert0 : \
-     workshops/2004/ruiz-et-al/support/matching.pcert0 \
-     workshops/2004/ruiz-et-al/support/terms.pcert0 \
-     workshops/2004/ruiz-et-al/support/subsumption.lisp
-workshops/2004/ruiz-et-al/support/subsumption.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/subsumption.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/subsumption.pcert1 : workshops/2004/ruiz-et-al/support/subsumption.pcert0
-workshops/2004/ruiz-et-al/support/subsumption.cert : | workshops/2004/ruiz-et-al/support/subsumption.pcert1
-
-workshops/2004/ruiz-et-al/support/terms-as-dag.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/terms-as-dag.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/terms-as-dag.pcert0 : \
-     workshops/2004/ruiz-et-al/support/dag-unification-rules.pcert0 \
-     workshops/2004/ruiz-et-al/support/terms-as-dag.lisp
-workshops/2004/ruiz-et-al/support/terms-as-dag.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/terms-as-dag.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/terms-as-dag.pcert1 : workshops/2004/ruiz-et-al/support/terms-as-dag.pcert0
-workshops/2004/ruiz-et-al/support/terms-as-dag.cert : | workshops/2004/ruiz-et-al/support/terms-as-dag.pcert1
-
-workshops/2004/ruiz-et-al/support/terms.pcert0 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/terms.pcert0 : acl2x = 0
-workshops/2004/ruiz-et-al/support/terms.pcert0 : \
-     workshops/2004/ruiz-et-al/support/basic.pcert0 \
-     workshops/2004/ruiz-et-al/support/terms.lisp
-workshops/2004/ruiz-et-al/support/terms.pcert1 : acl2x = 0
-workshops/2004/ruiz-et-al/support/terms.pcert1 : no_pcert = 0
-workshops/2004/ruiz-et-al/support/terms.pcert1 : workshops/2004/ruiz-et-al/support/terms.pcert0
-workshops/2004/ruiz-et-al/support/terms.cert : | workshops/2004/ruiz-et-al/support/terms.pcert1
-
-workshops/2004/sawada/support/bv.pcert0 : no_pcert = 0
-workshops/2004/sawada/support/bv.pcert0 : acl2x = 0
-workshops/2004/sawada/support/bv.pcert0 : \
-     workshops/2004/sawada/support/ihs.pcert0 \
-     arithmetic-2/pass1/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2004/sawada/support/bv.lisp \
-     workshops/2004/sawada/support/bv.acl2 \
-     workshops/2004/sawada/support/defpkg.lsp
-workshops/2004/sawada/support/bv.pcert1 : acl2x = 0
-workshops/2004/sawada/support/bv.pcert1 : no_pcert = 0
-workshops/2004/sawada/support/bv.pcert1 : workshops/2004/sawada/support/bv.pcert0
-workshops/2004/sawada/support/bv.cert : | workshops/2004/sawada/support/bv.pcert1
-
-workshops/2004/sawada/support/ihs.pcert0 : no_pcert = 0
-workshops/2004/sawada/support/ihs.pcert0 : acl2x = 0
-workshops/2004/sawada/support/ihs.pcert0 : \
-     ihs/ihs-definitions.pcert0 \
-     ihs/logops-lemmas.pcert0 \
-     workshops/2004/sawada/support/ihs.lisp
-workshops/2004/sawada/support/ihs.pcert1 : acl2x = 0
-workshops/2004/sawada/support/ihs.pcert1 : no_pcert = 0
-workshops/2004/sawada/support/ihs.pcert1 : workshops/2004/sawada/support/ihs.pcert0
-workshops/2004/sawada/support/ihs.cert : | workshops/2004/sawada/support/ihs.pcert1
-
-workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 \
-     workshops/2004/schmaltz-borrione/support/node.pcert0 \
-     workshops/2004/schmaltz-borrione/support/collect_msg_book.lisp
-workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert1 : workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert0
-workshops/2004/schmaltz-borrione/support/collect_msg_book.cert : | workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert1
-
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/routing_defuns.pcert0 \
-     workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.lisp
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert1 : workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert0
-workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.cert : | workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert1
-
-workshops/2004/schmaltz-borrione/support/intersect.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/intersect.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/intersect.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 \
-     workshops/2004/schmaltz-borrione/support/intersect.lisp
-workshops/2004/schmaltz-borrione/support/intersect.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/intersect.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/intersect.pcert1 : workshops/2004/schmaltz-borrione/support/intersect.pcert0
-workshops/2004/schmaltz-borrione/support/intersect.cert : | workshops/2004/schmaltz-borrione/support/intersect.pcert1
-
-workshops/2004/schmaltz-borrione/support/local_trip_book.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/local_trip_book.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/local_trip_book.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/trip_book.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/schmaltz-borrione/support/local_trip_book.lisp
-workshops/2004/schmaltz-borrione/support/local_trip_book.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/local_trip_book.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/local_trip_book.pcert1 : workshops/2004/schmaltz-borrione/support/local_trip_book.pcert0
-workshops/2004/schmaltz-borrione/support/local_trip_book.cert : | workshops/2004/schmaltz-borrione/support/local_trip_book.pcert1
-
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/routing_main.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/schmaltz-borrione/support/make_travel_list_book.lisp
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert1 : workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert0
-workshops/2004/schmaltz-borrione/support/make_travel_list_book.cert : | workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert1
-
-workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/schmaltz-borrione/support/mod_lemmas.lisp
-workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert1 : workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert0
-workshops/2004/schmaltz-borrione/support/mod_lemmas.cert : | workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert1
-
-workshops/2004/schmaltz-borrione/support/node.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/node.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/node.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2004/schmaltz-borrione/support/node.lisp
-workshops/2004/schmaltz-borrione/support/node.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/node.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/node.pcert1 : workshops/2004/schmaltz-borrione/support/node.pcert0
-workshops/2004/schmaltz-borrione/support/node.cert : | workshops/2004/schmaltz-borrione/support/node.pcert1
-
-workshops/2004/schmaltz-borrione/support/octagon_book.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/octagon_book.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/octagon_book.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/collect_msg_book.pcert0 \
-     workshops/2004/schmaltz-borrione/support/make_travel_list_book.pcert0 \
-     workshops/2004/schmaltz-borrione/support/scheduler_book.pcert0 \
-     workshops/2004/schmaltz-borrione/support/trip_thms.pcert0 \
-     workshops/2004/schmaltz-borrione/support/octagon_book.lisp
-workshops/2004/schmaltz-borrione/support/octagon_book.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/octagon_book.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/octagon_book.pcert1 : workshops/2004/schmaltz-borrione/support/octagon_book.pcert0
-workshops/2004/schmaltz-borrione/support/octagon_book.cert : | workshops/2004/schmaltz-borrione/support/octagon_book.pcert1
-
-workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.lisp
-workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert1 : workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0
-workshops/2004/schmaltz-borrione/support/predicatesNCie.cert : | workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert1
-
-workshops/2004/schmaltz-borrione/support/routing_defuns.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/routing_defuns.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_defuns.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 \
-     workshops/2004/schmaltz-borrione/support/mod_lemmas.pcert0 \
-     workshops/2004/schmaltz-borrione/support/routing_defuns.lisp
-workshops/2004/schmaltz-borrione/support/routing_defuns.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_defuns.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/routing_defuns.pcert1 : workshops/2004/schmaltz-borrione/support/routing_defuns.pcert0
-workshops/2004/schmaltz-borrione/support/routing_defuns.cert : | workshops/2004/schmaltz-borrione/support/routing_defuns.pcert1
-
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.pcert0 \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2004/schmaltz-borrione/support/routing_local_lemmas.lisp
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert1 : workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert0
-workshops/2004/schmaltz-borrione/support/routing_local_lemmas.cert : | workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert1
-
-workshops/2004/schmaltz-borrione/support/routing_main.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/routing_main.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_main.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 \
-     workshops/2004/schmaltz-borrione/support/routing_local_lemmas.pcert0 \
-     workshops/2004/schmaltz-borrione/support/routing_main.lisp
-workshops/2004/schmaltz-borrione/support/routing_main.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/routing_main.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/routing_main.pcert1 : workshops/2004/schmaltz-borrione/support/routing_main.pcert0
-workshops/2004/schmaltz-borrione/support/routing_main.cert : | workshops/2004/schmaltz-borrione/support/routing_main.pcert1
-
-workshops/2004/schmaltz-borrione/support/scheduler_book.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/scheduler_book.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/scheduler_book.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/intersect.pcert0 \
-     workshops/2004/schmaltz-borrione/support/scheduler_book.lisp
-workshops/2004/schmaltz-borrione/support/scheduler_book.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/scheduler_book.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/scheduler_book.pcert1 : workshops/2004/schmaltz-borrione/support/scheduler_book.pcert0
-workshops/2004/schmaltz-borrione/support/scheduler_book.cert : | workshops/2004/schmaltz-borrione/support/scheduler_book.pcert1
-
-workshops/2004/schmaltz-borrione/support/switch.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/switch.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/switch.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/switch.lisp
-workshops/2004/schmaltz-borrione/support/switch.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/switch.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/switch.pcert1 : workshops/2004/schmaltz-borrione/support/switch.pcert0
-workshops/2004/schmaltz-borrione/support/switch.cert : | workshops/2004/schmaltz-borrione/support/switch.pcert1
-
-workshops/2004/schmaltz-borrione/support/trip_book.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/trip_book.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/trip_book.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/switch.pcert0 \
-     workshops/2004/schmaltz-borrione/support/predicatesNCie.pcert0 \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2004/schmaltz-borrione/support/trip_book.lisp
-workshops/2004/schmaltz-borrione/support/trip_book.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/trip_book.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/trip_book.pcert1 : workshops/2004/schmaltz-borrione/support/trip_book.pcert0
-workshops/2004/schmaltz-borrione/support/trip_book.cert : | workshops/2004/schmaltz-borrione/support/trip_book.pcert1
-
-workshops/2004/schmaltz-borrione/support/trip_thms.pcert0 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/trip_thms.pcert0 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/trip_thms.pcert0 : \
-     workshops/2004/schmaltz-borrione/support/local_trip_book.pcert0 \
-     workshops/2004/schmaltz-borrione/support/trip_thms.lisp
-workshops/2004/schmaltz-borrione/support/trip_thms.pcert1 : acl2x = 0
-workshops/2004/schmaltz-borrione/support/trip_thms.pcert1 : no_pcert = 0
-workshops/2004/schmaltz-borrione/support/trip_thms.pcert1 : workshops/2004/schmaltz-borrione/support/trip_thms.pcert0
-workshops/2004/schmaltz-borrione/support/trip_thms.cert : | workshops/2004/schmaltz-borrione/support/trip_thms.pcert1
-
-workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.lisp \
-     workshops/2004/smith-et-al/support/bags/bag-exports.acl2
-workshops/2004/smith-et-al/support/bags/bag-exports.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bag-exports.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/bag-exports.pcert1 : workshops/2004/smith-et-al/support/bags/bag-exports.pcert0
-workshops/2004/smith-et-al/support/bags/bag-exports.cert : | workshops/2004/smith-et-al/support/bags/bag-exports.pcert1
-
-workshops/2004/smith-et-al/support/bags/bag-pkg.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/bag-pkg.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bag-pkg.pcert0 : \
-     workshops/2004/smith-et-al/support/lists/list-exports.pcert0 \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.lisp \
-     workshops/2004/smith-et-al/support/bags/bag-pkg.acl2
-workshops/2004/smith-et-al/support/bags/bag-pkg.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bag-pkg.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/bag-pkg.pcert1 : workshops/2004/smith-et-al/support/bags/bag-pkg.pcert0
-workshops/2004/smith-et-al/support/bags/bag-pkg.cert : | workshops/2004/smith-et-al/support/bags/bag-pkg.pcert1
-
-workshops/2004/smith-et-al/support/bags/basic.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/basic.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/basic.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2004/smith-et-al/support/lists/lists.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 \
-     workshops/2004/smith-et-al/support/bags/basic.lisp \
-     workshops/2004/smith-et-al/support/bags/basic.acl2
-workshops/2004/smith-et-al/support/bags/basic.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/basic.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/basic.pcert1 : workshops/2004/smith-et-al/support/bags/basic.pcert0
-workshops/2004/smith-et-al/support/bags/basic.cert : | workshops/2004/smith-et-al/support/bags/basic.pcert1
-
-workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/meta.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.lisp \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.acl2
-workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert1 : workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert0
-workshops/2004/smith-et-al/support/bags/bind-free-rules.cert : | workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert1
-
-workshops/2004/smith-et-al/support/bags/cons.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/cons.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/cons.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/cons.lisp
-workshops/2004/smith-et-al/support/bags/cons.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/cons.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/cons.pcert1 : workshops/2004/smith-et-al/support/bags/cons.pcert0
-workshops/2004/smith-et-al/support/bags/cons.cert : | workshops/2004/smith-et-al/support/bags/cons.pcert1
-
-workshops/2004/smith-et-al/support/bags/eric-meta.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/eric-meta.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/eric-meta.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert0 \
-     rtl/rel4/support/logand.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 \
-     workshops/2004/smith-et-al/support/bags/eric-meta.lisp \
-     workshops/2004/smith-et-al/support/bags/eric-meta.acl2
-workshops/2004/smith-et-al/support/bags/eric-meta.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/eric-meta.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/eric-meta.pcert1 : workshops/2004/smith-et-al/support/bags/eric-meta.pcert0
-workshops/2004/smith-et-al/support/bags/eric-meta.cert : | workshops/2004/smith-et-al/support/bags/eric-meta.pcert1
-
-workshops/2004/smith-et-al/support/bags/meta.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/meta.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/meta.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/basic.pcert0 \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 \
-     workshops/2004/smith-et-al/support/lists/mv-nth.pcert0 \
-     workshops/2004/smith-et-al/support/syntax/syntax.pcert0 \
-     workshops/2004/smith-et-al/support/bags/meta.lisp \
-     workshops/2004/smith-et-al/support/bags/meta.acl2
-workshops/2004/smith-et-al/support/bags/meta.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/meta.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/meta.pcert1 : workshops/2004/smith-et-al/support/bags/meta.pcert0
-workshops/2004/smith-et-al/support/bags/meta.cert : | workshops/2004/smith-et-al/support/bags/meta.pcert1
-
-workshops/2004/smith-et-al/support/bags/neq.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/neq.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/neq.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 \
-     workshops/2004/smith-et-al/support/bags/neq.lisp \
-     workshops/2004/smith-et-al/support/bags/neq.acl2
-workshops/2004/smith-et-al/support/bags/neq.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/neq.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/neq.pcert1 : workshops/2004/smith-et-al/support/bags/neq.pcert0
-workshops/2004/smith-et-al/support/bags/neq.cert : | workshops/2004/smith-et-al/support/bags/neq.pcert1
-
-workshops/2004/smith-et-al/support/bags/top.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/top.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/top.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert0 \
-     workshops/2004/smith-et-al/support/bags/cons.pcert0 \
-     workshops/2004/smith-et-al/support/bags/neq.pcert0 \
-     workshops/2004/smith-et-al/support/bags/eric-meta.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 \
-     workshops/2004/smith-et-al/support/bags/top.lisp \
-     workshops/2004/smith-et-al/support/bags/top.acl2
-workshops/2004/smith-et-al/support/bags/top.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/top.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/top.pcert1 : workshops/2004/smith-et-al/support/bags/top.pcert0
-workshops/2004/smith-et-al/support/bags/top.cert : | workshops/2004/smith-et-al/support/bags/top.pcert1
-
-workshops/2004/smith-et-al/support/bags/two-level-meta.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/two-level-meta.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/two-level-meta.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/two-level.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 \
-     workshops/2004/smith-et-al/support/bags/two-level-meta.lisp \
-     workshops/2004/smith-et-al/support/bags/two-level-meta.acl2
-workshops/2004/smith-et-al/support/bags/two-level-meta.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/two-level-meta.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/two-level-meta.pcert1 : workshops/2004/smith-et-al/support/bags/two-level-meta.pcert0
-workshops/2004/smith-et-al/support/bags/two-level-meta.cert : | workshops/2004/smith-et-al/support/bags/two-level-meta.pcert1
-
-workshops/2004/smith-et-al/support/bags/two-level.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/two-level.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/two-level.pcert0 : \
-     workshops/2004/smith-et-al/support/bags/bind-free-rules.pcert0 \
-     workshops/2004/smith-et-al/support/bags/bag-exports.pcert0 \
-     workshops/2004/smith-et-al/support/bags/two-level.lisp \
-     workshops/2004/smith-et-al/support/bags/two-level.acl2
-workshops/2004/smith-et-al/support/bags/two-level.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/bags/two-level.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/bags/two-level.pcert1 : workshops/2004/smith-et-al/support/bags/two-level.pcert0
-workshops/2004/smith-et-al/support/bags/two-level.cert : | workshops/2004/smith-et-al/support/bags/two-level.pcert1
-
-workshops/2004/smith-et-al/support/lists/list-exports.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/lists/list-exports.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/lists/list-exports.pcert0 : \
-     workshops/2004/smith-et-al/support/lists/list-exports.lisp \
-     workshops/2004/smith-et-al/support/lists/cert.acl2
-workshops/2004/smith-et-al/support/lists/list-exports.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/lists/list-exports.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/lists/list-exports.pcert1 : workshops/2004/smith-et-al/support/lists/list-exports.pcert0
-workshops/2004/smith-et-al/support/lists/list-exports.cert : | workshops/2004/smith-et-al/support/lists/list-exports.pcert1
-
-workshops/2004/smith-et-al/support/lists/list-top.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/lists/list-top.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/lists/list-top.pcert0 : \
-     workshops/2004/smith-et-al/support/lists/lists.pcert0 \
-     workshops/2004/smith-et-al/support/lists/list-exports.pcert0 \
-     workshops/2004/smith-et-al/support/lists/mv-nth.pcert0 \
-     workshops/2004/smith-et-al/support/lists/list-top.lisp \
-     workshops/2004/smith-et-al/support/lists/list-top.acl2
-workshops/2004/smith-et-al/support/lists/list-top.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/lists/list-top.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/lists/list-top.pcert1 : workshops/2004/smith-et-al/support/lists/list-top.pcert0
-workshops/2004/smith-et-al/support/lists/list-top.cert : | workshops/2004/smith-et-al/support/lists/list-top.pcert1
-
-workshops/2004/smith-et-al/support/lists/lists.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/lists/lists.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/lists/lists.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2004/smith-et-al/support/lists/lists.lisp \
-     workshops/2004/smith-et-al/support/lists/cert.acl2
-workshops/2004/smith-et-al/support/lists/lists.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/lists/lists.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/lists/lists.pcert1 : workshops/2004/smith-et-al/support/lists/lists.pcert0
-workshops/2004/smith-et-al/support/lists/lists.cert : | workshops/2004/smith-et-al/support/lists/lists.pcert1
-
-workshops/2004/smith-et-al/support/lists/mv-nth.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/lists/mv-nth.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/lists/mv-nth.pcert0 : \
-     workshops/2004/smith-et-al/support/lists/mv-nth.lisp \
-     workshops/2004/smith-et-al/support/lists/cert.acl2
-workshops/2004/smith-et-al/support/lists/mv-nth.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/lists/mv-nth.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/lists/mv-nth.pcert1 : workshops/2004/smith-et-al/support/lists/mv-nth.pcert0
-workshops/2004/smith-et-al/support/lists/mv-nth.cert : | workshops/2004/smith-et-al/support/lists/mv-nth.pcert1
-
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert0 : \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.lisp \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.acl2
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert1 : workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.cert : | workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert1
-
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert0 : \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.pcert0 \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.lisp \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.acl2
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert1 : workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert0
-workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.cert : | workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert1
-
-workshops/2004/smith-et-al/support/syntax/auxilary.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/syntax/auxilary.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/auxilary.pcert0 : \
-     workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.pcert0 \
-     workshops/2004/smith-et-al/support/syntax/auxilary.lisp \
-     workshops/2004/smith-et-al/support/syntax/auxilary.acl2
-workshops/2004/smith-et-al/support/syntax/auxilary.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/auxilary.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/syntax/auxilary.pcert1 : workshops/2004/smith-et-al/support/syntax/auxilary.pcert0
-workshops/2004/smith-et-al/support/syntax/auxilary.cert : | workshops/2004/smith-et-al/support/syntax/auxilary.pcert1
-
-workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert0 : \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.lisp \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.acl2
-workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert1 : workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert0
-workshops/2004/smith-et-al/support/syntax/syn-pkg.cert : | workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert1
-
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert0 : \
-     workshops/2004/smith-et-al/support/syntax/auxilary.pcert0 \
-     workshops/2004/smith-et-al/support/syntax/syn-pkg.pcert0 \
-     workshops/2004/smith-et-al/support/lists/list-top.pcert0 \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.lisp \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.acl2
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert1 : workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert0
-workshops/2004/smith-et-al/support/syntax/syntax-extensions.cert : | workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert1
-
-workshops/2004/smith-et-al/support/syntax/syntax.pcert0 : no_pcert = 0
-workshops/2004/smith-et-al/support/syntax/syntax.pcert0 : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syntax.pcert0 : \
-     workshops/2004/smith-et-al/support/syntax/syntax-extensions.pcert0 \
-     workshops/2004/smith-et-al/support/syntax/syntax.lisp \
-     workshops/2004/smith-et-al/support/syntax/syntax.acl2
-workshops/2004/smith-et-al/support/syntax/syntax.pcert1 : acl2x = 0
-workshops/2004/smith-et-al/support/syntax/syntax.pcert1 : no_pcert = 0
-workshops/2004/smith-et-al/support/syntax/syntax.pcert1 : workshops/2004/smith-et-al/support/syntax/syntax.pcert0
-workshops/2004/smith-et-al/support/syntax/syntax.cert : | workshops/2004/smith-et-al/support/syntax/syntax.pcert1
-
-workshops/2004/sumners-ray/support/basis.pcert0 : no_pcert = 0
-workshops/2004/sumners-ray/support/basis.pcert0 : acl2x = 0
-workshops/2004/sumners-ray/support/basis.pcert0 : \
-     workshops/2004/sumners-ray/support/basis.lisp
-workshops/2004/sumners-ray/support/basis.pcert1 : acl2x = 0
-workshops/2004/sumners-ray/support/basis.pcert1 : no_pcert = 0
-workshops/2004/sumners-ray/support/basis.pcert1 : workshops/2004/sumners-ray/support/basis.pcert0
-workshops/2004/sumners-ray/support/basis.cert : | workshops/2004/sumners-ray/support/basis.pcert1
-
-workshops/2004/sumners-ray/support/crit.pcert0 : no_pcert = 0
-workshops/2004/sumners-ray/support/crit.pcert0 : acl2x = 0
-workshops/2004/sumners-ray/support/crit.pcert0 : \
-     workshops/2004/sumners-ray/support/basis.pcert0 \
-     workshops/2004/sumners-ray/support/crit.lisp
-workshops/2004/sumners-ray/support/crit.pcert1 : acl2x = 0
-workshops/2004/sumners-ray/support/crit.pcert1 : no_pcert = 0
-workshops/2004/sumners-ray/support/crit.pcert1 : workshops/2004/sumners-ray/support/crit.pcert0
-workshops/2004/sumners-ray/support/crit.cert : | workshops/2004/sumners-ray/support/crit.pcert1
-
-workshops/2004/sumners-ray/support/mesi.pcert0 : no_pcert = 0
-workshops/2004/sumners-ray/support/mesi.pcert0 : acl2x = 0
-workshops/2004/sumners-ray/support/mesi.pcert0 : \
-     workshops/2004/sumners-ray/support/basis.pcert0 \
-     workshops/2004/sumners-ray/support/records.pcert0 \
-     workshops/2004/sumners-ray/support/mesi.lisp
-workshops/2004/sumners-ray/support/mesi.pcert1 : acl2x = 0
-workshops/2004/sumners-ray/support/mesi.pcert1 : no_pcert = 0
-workshops/2004/sumners-ray/support/mesi.pcert1 : workshops/2004/sumners-ray/support/mesi.pcert0
-workshops/2004/sumners-ray/support/mesi.cert : | workshops/2004/sumners-ray/support/mesi.pcert1
-
-workshops/2004/sumners-ray/support/records.pcert0 : no_pcert = 0
-workshops/2004/sumners-ray/support/records.pcert0 : acl2x = 0
-workshops/2004/sumners-ray/support/records.pcert0 : \
-     workshops/2004/sumners-ray/support/sets.pcert0 \
-     workshops/2004/sumners-ray/support/records.lisp
-workshops/2004/sumners-ray/support/records.pcert1 : acl2x = 0
-workshops/2004/sumners-ray/support/records.pcert1 : no_pcert = 0
-workshops/2004/sumners-ray/support/records.pcert1 : workshops/2004/sumners-ray/support/records.pcert0
-workshops/2004/sumners-ray/support/records.cert : | workshops/2004/sumners-ray/support/records.pcert1
-
-workshops/2004/sumners-ray/support/sets.pcert0 : no_pcert = 0
-workshops/2004/sumners-ray/support/sets.pcert0 : acl2x = 0
-workshops/2004/sumners-ray/support/sets.pcert0 : \
-     workshops/2004/sumners-ray/support/total-order.pcert0 \
-     workshops/2004/sumners-ray/support/sets.lisp
-workshops/2004/sumners-ray/support/sets.pcert1 : acl2x = 0
-workshops/2004/sumners-ray/support/sets.pcert1 : no_pcert = 0
-workshops/2004/sumners-ray/support/sets.pcert1 : workshops/2004/sumners-ray/support/sets.pcert0
-workshops/2004/sumners-ray/support/sets.cert : | workshops/2004/sumners-ray/support/sets.pcert1
-
-workshops/2004/sumners-ray/support/total-order.pcert0 : no_pcert = 0
-workshops/2004/sumners-ray/support/total-order.pcert0 : acl2x = 0
-workshops/2004/sumners-ray/support/total-order.pcert0 : \
-     workshops/2004/sumners-ray/support/total-order.lisp
-workshops/2004/sumners-ray/support/total-order.pcert1 : acl2x = 0
-workshops/2004/sumners-ray/support/total-order.pcert1 : no_pcert = 0
-workshops/2004/sumners-ray/support/total-order.pcert1 : workshops/2004/sumners-ray/support/total-order.pcert0
-workshops/2004/sumners-ray/support/total-order.cert : | workshops/2004/sumners-ray/support/total-order.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed1.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed1.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed1.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed1.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed1.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.lisp
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.lisp
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 : \
-     arithmetic/top.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.pcert0 : \
-     arithmetic/top.pcert0 \
-     ihs/quotient-remainder-lemmas.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed3.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert0 : \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.pcert1
-
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.pcert0 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.pcert0 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     arithmetic/mod-gcd.pcert0 \
-     workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.lisp \
-     workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.acl2
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.pcert1 : acl2x = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.pcert1 : no_pcert = 0
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.pcert1 : workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.pcert0
-workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.cert : | workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.pcert1
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.pcert0 : no_pcert = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.pcert0 : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.pcert0 : \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert0 \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.lisp
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.pcert1 : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.pcert1 : no_pcert = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.pcert1 : workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.pcert0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.cert : | workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.pcert1
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert0 : no_pcert = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert0 : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert0 : \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.lisp
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert1 : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert1 : no_pcert = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert1 : workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert : | workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert1
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.pcert0 : no_pcert = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.pcert0 : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.pcert0 : \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert0 \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.lisp
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.pcert1 : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.pcert1 : no_pcert = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.pcert1 : workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.pcert0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.cert : | workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.pcert1
-
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.pcert0 : no_pcert = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.pcert0 : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.pcert0 : \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.pcert0 \
-     workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.lisp
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.pcert1 : acl2x = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.pcert1 : no_pcert = 0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.pcert1 : workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.pcert0
-workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.cert : | workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.pcert1
-
-workshops/2006/greve/nary/example.pcert0 : no_pcert = 0
-workshops/2006/greve/nary/example.pcert0 : acl2x = 0
-workshops/2006/greve/nary/example.pcert0 : \
-     workshops/2006/greve/nary/nary.pcert0 \
-     ihs/ihs-definitions.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     workshops/2006/greve/nary/nth-rules.pcert0 \
-     workshops/2006/greve/nary/example.lisp
-workshops/2006/greve/nary/example.pcert1 : acl2x = 0
-workshops/2006/greve/nary/example.pcert1 : no_pcert = 0
-workshops/2006/greve/nary/example.pcert1 : workshops/2006/greve/nary/example.pcert0
-workshops/2006/greve/nary/example.cert : | workshops/2006/greve/nary/example.pcert1
-
-workshops/2006/greve/nary/nary.pcert0 : no_pcert = 0
-workshops/2006/greve/nary/nary.pcert0 : acl2x = 0
-workshops/2006/greve/nary/nary.pcert0 : \
-     workshops/2006/greve/nary/nary.lisp
-workshops/2006/greve/nary/nary.pcert1 : acl2x = 0
-workshops/2006/greve/nary/nary.pcert1 : no_pcert = 0
-workshops/2006/greve/nary/nary.pcert1 : workshops/2006/greve/nary/nary.pcert0
-workshops/2006/greve/nary/nary.cert : | workshops/2006/greve/nary/nary.pcert1
-
-workshops/2006/greve/nary/nth-rules.pcert0 : no_pcert = 0
-workshops/2006/greve/nary/nth-rules.pcert0 : acl2x = 0
-workshops/2006/greve/nary/nth-rules.pcert0 : \
-     workshops/2006/greve/nary/nth-rules.lisp
-workshops/2006/greve/nary/nth-rules.pcert1 : acl2x = 0
-workshops/2006/greve/nary/nth-rules.pcert1 : no_pcert = 0
-workshops/2006/greve/nary/nth-rules.pcert1 : workshops/2006/greve/nary/nth-rules.pcert0
-workshops/2006/greve/nary/nth-rules.cert : | workshops/2006/greve/nary/nth-rules.pcert1
-
-workshops/2006/hunt-reeber/support/acl2.pcert0 : no_pcert = 0
-workshops/2006/hunt-reeber/support/acl2.pcert0 : acl2x = 0
-workshops/2006/hunt-reeber/support/acl2.pcert0 : \
-     workshops/2006/hunt-reeber/support/acl2.lisp
-workshops/2006/hunt-reeber/support/acl2.pcert1 : acl2x = 0
-workshops/2006/hunt-reeber/support/acl2.pcert1 : no_pcert = 0
-workshops/2006/hunt-reeber/support/acl2.pcert1 : workshops/2006/hunt-reeber/support/acl2.pcert0
-workshops/2006/hunt-reeber/support/acl2.cert : | workshops/2006/hunt-reeber/support/acl2.pcert1
-
-workshops/2006/hunt-reeber/support/bdd.pcert0 : no_pcert = 0
-workshops/2006/hunt-reeber/support/bdd.pcert0 : acl2x = 0
-workshops/2006/hunt-reeber/support/bdd.pcert0 : \
-     workshops/2006/hunt-reeber/support/bdd.lisp
-workshops/2006/hunt-reeber/support/bdd.pcert1 : acl2x = 0
-workshops/2006/hunt-reeber/support/bdd.pcert1 : no_pcert = 0
-workshops/2006/hunt-reeber/support/bdd.pcert1 : workshops/2006/hunt-reeber/support/bdd.pcert0
-workshops/2006/hunt-reeber/support/bdd.cert : | workshops/2006/hunt-reeber/support/bdd.pcert1
-
-workshops/2006/hunt-reeber/support/sat.pcert0 : no_pcert = 0
-workshops/2006/hunt-reeber/support/sat.pcert0 : acl2x = 0
-workshops/2006/hunt-reeber/support/sat.pcert0 : \
-     workshops/2006/hunt-reeber/support/sat.lisp
-workshops/2006/hunt-reeber/support/sat.pcert1 : acl2x = 0
-workshops/2006/hunt-reeber/support/sat.pcert1 : no_pcert = 0
-workshops/2006/hunt-reeber/support/sat.pcert1 : workshops/2006/hunt-reeber/support/sat.pcert0
-workshops/2006/hunt-reeber/support/sat.cert : | workshops/2006/hunt-reeber/support/sat.pcert1
-
-workshops/2006/kaufmann-moore/support/austel.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/austel.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/austel.pcert0 : \
-     workshops/2006/kaufmann-moore/support/austel.lisp
-workshops/2006/kaufmann-moore/support/austel.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/austel.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/austel.pcert1 : workshops/2006/kaufmann-moore/support/austel.pcert0
-workshops/2006/kaufmann-moore/support/austel.cert : | workshops/2006/kaufmann-moore/support/austel.pcert1
-
-workshops/2006/kaufmann-moore/support/greve1.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/greve1.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve1.pcert0 : \
-     workshops/2006/kaufmann-moore/support/greve1.lisp
-workshops/2006/kaufmann-moore/support/greve1.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve1.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/greve1.pcert1 : workshops/2006/kaufmann-moore/support/greve1.pcert0
-workshops/2006/kaufmann-moore/support/greve1.cert : | workshops/2006/kaufmann-moore/support/greve1.pcert1
-
-workshops/2006/kaufmann-moore/support/greve2.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/greve2.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve2.pcert0 : \
-     workshops/2006/kaufmann-moore/support/greve2.lisp
-workshops/2006/kaufmann-moore/support/greve2.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve2.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/greve2.pcert1 : workshops/2006/kaufmann-moore/support/greve2.pcert0
-workshops/2006/kaufmann-moore/support/greve2.cert : | workshops/2006/kaufmann-moore/support/greve2.pcert1
-
-workshops/2006/kaufmann-moore/support/greve3.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/greve3.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve3.pcert0 : \
-     workshops/2006/kaufmann-moore/support/greve3.lisp
-workshops/2006/kaufmann-moore/support/greve3.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/greve3.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/greve3.pcert1 : workshops/2006/kaufmann-moore/support/greve3.pcert0
-workshops/2006/kaufmann-moore/support/greve3.cert : | workshops/2006/kaufmann-moore/support/greve3.pcert1
-
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.pcert0 : \
-     workshops/2006/kaufmann-moore/support/mini-proveall.pcert0 \
-     workshops/2006/kaufmann-moore/support/mini-proveall-plus.lisp
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.pcert1 : workshops/2006/kaufmann-moore/support/mini-proveall-plus.pcert0
-workshops/2006/kaufmann-moore/support/mini-proveall-plus.cert : | workshops/2006/kaufmann-moore/support/mini-proveall-plus.pcert1
-
-workshops/2006/kaufmann-moore/support/mini-proveall.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/mini-proveall.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/mini-proveall.pcert0 : \
-     workshops/2006/kaufmann-moore/support/mini-proveall.lisp
-workshops/2006/kaufmann-moore/support/mini-proveall.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/mini-proveall.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/mini-proveall.pcert1 : workshops/2006/kaufmann-moore/support/mini-proveall.pcert0
-workshops/2006/kaufmann-moore/support/mini-proveall.cert : | workshops/2006/kaufmann-moore/support/mini-proveall.pcert1
-
-workshops/2006/kaufmann-moore/support/rhs1-iff.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/rhs1-iff.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs1-iff.pcert0 : \
-     workshops/2006/kaufmann-moore/support/rhs1-iff.lisp \
-     workshops/2006/kaufmann-moore/support/rhs1-iff.acl2
-workshops/2006/kaufmann-moore/support/rhs1-iff.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs1-iff.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/rhs1-iff.pcert1 : workshops/2006/kaufmann-moore/support/rhs1-iff.pcert0
-workshops/2006/kaufmann-moore/support/rhs1-iff.cert : | workshops/2006/kaufmann-moore/support/rhs1-iff.pcert1
-
-workshops/2006/kaufmann-moore/support/rhs1.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/rhs1.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs1.pcert0 : \
-     workshops/2006/kaufmann-moore/support/rhs1.lisp \
-     workshops/2006/kaufmann-moore/support/rhs1.acl2
-workshops/2006/kaufmann-moore/support/rhs1.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs1.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/rhs1.pcert1 : workshops/2006/kaufmann-moore/support/rhs1.pcert0
-workshops/2006/kaufmann-moore/support/rhs1.cert : | workshops/2006/kaufmann-moore/support/rhs1.pcert1
-
-workshops/2006/kaufmann-moore/support/rhs2.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/rhs2.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs2.pcert0 : \
-     workshops/2006/kaufmann-moore/support/rhs2.lisp \
-     workshops/2006/kaufmann-moore/support/rhs2.acl2
-workshops/2006/kaufmann-moore/support/rhs2.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/rhs2.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/rhs2.pcert1 : workshops/2006/kaufmann-moore/support/rhs2.pcert0
-workshops/2006/kaufmann-moore/support/rhs2.cert : | workshops/2006/kaufmann-moore/support/rhs2.pcert1
-
-workshops/2006/kaufmann-moore/support/smith1.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/smith1.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/smith1.pcert0 : \
-     workshops/2006/kaufmann-moore/support/smith1.lisp
-workshops/2006/kaufmann-moore/support/smith1.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/smith1.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/smith1.pcert1 : workshops/2006/kaufmann-moore/support/smith1.pcert0
-workshops/2006/kaufmann-moore/support/smith1.cert : | workshops/2006/kaufmann-moore/support/smith1.pcert1
-
-workshops/2006/kaufmann-moore/support/sumners1.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/sumners1.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/sumners1.pcert0 : \
-     workshops/2006/kaufmann-moore/support/sumners1.lisp
-workshops/2006/kaufmann-moore/support/sumners1.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/sumners1.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/sumners1.pcert1 : workshops/2006/kaufmann-moore/support/sumners1.pcert0
-workshops/2006/kaufmann-moore/support/sumners1.cert : | workshops/2006/kaufmann-moore/support/sumners1.pcert1
-
-workshops/2006/kaufmann-moore/support/warnings.pcert0 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/warnings.pcert0 : acl2x = 0
-workshops/2006/kaufmann-moore/support/warnings.pcert0 : \
-     workshops/2006/kaufmann-moore/support/warnings.lisp \
-     workshops/2006/kaufmann-moore/support/warnings.acl2
-workshops/2006/kaufmann-moore/support/warnings.pcert1 : acl2x = 0
-workshops/2006/kaufmann-moore/support/warnings.pcert1 : no_pcert = 0
-workshops/2006/kaufmann-moore/support/warnings.pcert1 : workshops/2006/kaufmann-moore/support/warnings.pcert0
-workshops/2006/kaufmann-moore/support/warnings.cert : | workshops/2006/kaufmann-moore/support/warnings.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.cert : | workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.cert : | workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/AES/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.cert : | workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.cert : | workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.cert : | workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.cert : | workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.cert : | workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.cert : | workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/RC6/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.cert : | workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.cert : | workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.cert : | workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/TEA/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.cert : | workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.cert : | workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     misc/priorities.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert : | workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.cert : | workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert0 : \
-     data-structures/list-defthms.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.cert : | workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     coi/super-ihs/super-ihs.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert : | workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 : \
-     arithmetic/mod-gcd.pcert0 \
-     ordinals/ordinals.pcert0 \
-     ihs/ihs-definitions.pcert0 \
-     ihs/ihs-lemmas.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert : | workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.cert : | workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert0 : \
-     data-structures/number-list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/books/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.cert : | workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.cert : | workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.cert : | workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert1
-
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.pcert0 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.pcert0 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.pcert0 : \
-     workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.pcert0 \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.lisp \
-     workshops/2006/pike-shields-matthews/core_verifier/factorial/cert.acl2
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.pcert1 : acl2x = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.pcert1 : no_pcert = 0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.pcert1 : workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.pcert0
-workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.cert : | workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.pcert1
-
-workshops/2006/rager/support/ptest-fib.pcert0 : no_pcert = 0
-workshops/2006/rager/support/ptest-fib.pcert0 : acl2x = 0
-workshops/2006/rager/support/ptest-fib.pcert0 : \
-     workshops/2006/rager/support/ptest-fib.lisp
-workshops/2006/rager/support/ptest-fib.pcert1 : acl2x = 0
-workshops/2006/rager/support/ptest-fib.pcert1 : no_pcert = 0
-workshops/2006/rager/support/ptest-fib.pcert1 : workshops/2006/rager/support/ptest-fib.pcert0
-workshops/2006/rager/support/ptest-fib.cert : | workshops/2006/rager/support/ptest-fib.pcert1
-
-workshops/2006/rager/support/ptest-if-normalization.pcert0 : no_pcert = 0
-workshops/2006/rager/support/ptest-if-normalization.pcert0 : acl2x = 0
-workshops/2006/rager/support/ptest-if-normalization.pcert0 : \
-     workshops/2006/rager/support/ptest-if-normalization.lisp
-workshops/2006/rager/support/ptest-if-normalization.pcert1 : acl2x = 0
-workshops/2006/rager/support/ptest-if-normalization.pcert1 : no_pcert = 0
-workshops/2006/rager/support/ptest-if-normalization.pcert1 : workshops/2006/rager/support/ptest-if-normalization.pcert0
-workshops/2006/rager/support/ptest-if-normalization.cert : | workshops/2006/rager/support/ptest-if-normalization.pcert1
-
-workshops/2006/rager/support/ptest-mergesort.pcert0 : no_pcert = 0
-workshops/2006/rager/support/ptest-mergesort.pcert0 : acl2x = 0
-workshops/2006/rager/support/ptest-mergesort.pcert0 : \
-     finite-set-theory/osets/sets.pcert0 \
-     workshops/2006/rager/support/ptest-mergesort.lisp \
-     workshops/2006/rager/support/ptest-mergesort.acl2 \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-workshops/2006/rager/support/ptest-mergesort.pcert1 : acl2x = 0
-workshops/2006/rager/support/ptest-mergesort.pcert1 : no_pcert = 0
-workshops/2006/rager/support/ptest-mergesort.pcert1 : workshops/2006/rager/support/ptest-mergesort.pcert0
-workshops/2006/rager/support/ptest-mergesort.cert : | workshops/2006/rager/support/ptest-mergesort.pcert1
-
-workshops/2006/ray/tail/exists.pcert0 : no_pcert = 0
-workshops/2006/ray/tail/exists.pcert0 : acl2x = 0
-workshops/2006/ray/tail/exists.pcert0 : \
-     workshops/2006/ray/tail/exists.lisp
-workshops/2006/ray/tail/exists.pcert1 : acl2x = 0
-workshops/2006/ray/tail/exists.pcert1 : no_pcert = 0
-workshops/2006/ray/tail/exists.pcert1 : workshops/2006/ray/tail/exists.pcert0
-workshops/2006/ray/tail/exists.cert : | workshops/2006/ray/tail/exists.pcert1
-
-workshops/2006/ray/tail/forall.pcert0 : no_pcert = 0
-workshops/2006/ray/tail/forall.pcert0 : acl2x = 0
-workshops/2006/ray/tail/forall.pcert0 : \
-     workshops/2006/ray/tail/forall.lisp
-workshops/2006/ray/tail/forall.pcert1 : acl2x = 0
-workshops/2006/ray/tail/forall.pcert1 : no_pcert = 0
-workshops/2006/ray/tail/forall.pcert1 : workshops/2006/ray/tail/forall.pcert0
-workshops/2006/ray/tail/forall.cert : | workshops/2006/ray/tail/forall.pcert1
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert0 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert0 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert0 : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.lisp
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert1 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert1 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert1 : workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.cert : | workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert1
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert0 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert0 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert0 : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.lisp
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert1 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert1 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert1 : workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.cert : | workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert1
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert0 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert0 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert0 : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.lisp
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert1 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert1 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert1 : workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.cert : | workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert1
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert0 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert0 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert0 : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.lisp
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert1 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert1 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert1 : workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.cert : | workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert1
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert0 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert0 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert0 : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.lisp
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert1 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert1 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert1 : workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.cert : | workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert1
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert0 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert0 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     textbook/chap11/qsort.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.lisp
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert1 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert1 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert1 : workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.cert : | workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.pcert1
-
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.pcert0 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.pcert0 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.pcert0 : \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.pcert0 \
-     workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.lisp
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.pcert1 : acl2x = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.pcert1 : no_pcert = 0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.pcert1 : workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.pcert0
-workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.cert : | workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.pcert1
-
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert0 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert0 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert0 : \
-     data-structures/list-theory.pcert0 \
-     workshops/2006/swords-cook/lcsoundness/defsum.pcert0 \
-     workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert0 \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.lisp
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert1 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert1 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert1 : workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.cert : | workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert1
-
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.pcert0 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.pcert0 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.pcert0 : \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.pcert0 \
-     workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.lisp
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.pcert1 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.pcert1 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.pcert1 : workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.pcert0
-workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.cert : | workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.pcert1
-
-workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert0 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert0 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     workshops/2006/swords-cook/lcsoundness/defsum-thms.lisp
-workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert1 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert1 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert1 : workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert0
-workshops/2006/swords-cook/lcsoundness/defsum-thms.cert : | workshops/2006/swords-cook/lcsoundness/defsum-thms.pcert1
-
-workshops/2006/swords-cook/lcsoundness/defsum.pcert0 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/defsum.pcert0 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/defsum.pcert0 : \
-     workshops/2006/swords-cook/lcsoundness/pattern-match.pcert0 \
-     workshops/2006/swords-cook/lcsoundness/defsum.lisp
-workshops/2006/swords-cook/lcsoundness/defsum.pcert1 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/defsum.pcert1 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/defsum.pcert1 : workshops/2006/swords-cook/lcsoundness/defsum.pcert0
-workshops/2006/swords-cook/lcsoundness/defsum.cert : | workshops/2006/swords-cook/lcsoundness/defsum.pcert1
-
-workshops/2006/swords-cook/lcsoundness/pattern-match.pcert0 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/pattern-match.pcert0 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/pattern-match.pcert0 : \
-     workshops/2006/swords-cook/lcsoundness/pattern-match.lisp
-workshops/2006/swords-cook/lcsoundness/pattern-match.pcert1 : acl2x = 0
-workshops/2006/swords-cook/lcsoundness/pattern-match.pcert1 : no_pcert = 0
-workshops/2006/swords-cook/lcsoundness/pattern-match.pcert1 : workshops/2006/swords-cook/lcsoundness/pattern-match.pcert0
-workshops/2006/swords-cook/lcsoundness/pattern-match.cert : | workshops/2006/swords-cook/lcsoundness/pattern-match.pcert1
-
-workshops/2007/cowles-et-al/support/cowles/while-loop.pcert0 : no_pcert = 0
-workshops/2007/cowles-et-al/support/cowles/while-loop.pcert0 : acl2x = 0
-workshops/2007/cowles-et-al/support/cowles/while-loop.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2007/cowles-et-al/support/cowles/while-loop.lisp
-workshops/2007/cowles-et-al/support/cowles/while-loop.pcert1 : acl2x = 0
-workshops/2007/cowles-et-al/support/cowles/while-loop.pcert1 : no_pcert = 0
-workshops/2007/cowles-et-al/support/cowles/while-loop.pcert1 : workshops/2007/cowles-et-al/support/cowles/while-loop.pcert0
-workshops/2007/cowles-et-al/support/cowles/while-loop.cert : | workshops/2007/cowles-et-al/support/cowles/while-loop.pcert1
-
-workshops/2007/cowles-et-al/support/greve/ack.pcert0 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/ack.pcert0 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/ack.pcert0 : \
-     workshops/2007/cowles-et-al/support/greve/defminterm.pcert0 \
-     workshops/2007/cowles-et-al/support/greve/ack.lisp
-workshops/2007/cowles-et-al/support/greve/ack.pcert1 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/ack.pcert1 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/ack.pcert1 : workshops/2007/cowles-et-al/support/greve/ack.pcert0
-workshops/2007/cowles-et-al/support/greve/ack.cert : | workshops/2007/cowles-et-al/support/greve/ack.pcert1
-
-workshops/2007/cowles-et-al/support/greve/defminterm.pcert0 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/defminterm.pcert0 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defminterm.pcert0 : \
-     workshops/2007/cowles-et-al/support/greve/defxch.pcert0 \
-     workshops/2007/cowles-et-al/support/greve/defpun.pcert0 \
-     workshops/2007/cowles-et-al/support/greve/defminterm.lisp
-workshops/2007/cowles-et-al/support/greve/defminterm.pcert1 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defminterm.pcert1 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/defminterm.pcert1 : workshops/2007/cowles-et-al/support/greve/defminterm.pcert0
-workshops/2007/cowles-et-al/support/greve/defminterm.cert : | workshops/2007/cowles-et-al/support/greve/defminterm.pcert1
-
-workshops/2007/cowles-et-al/support/greve/defpun.pcert0 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/defpun.pcert0 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defpun.pcert0 : \
-     workshops/2007/cowles-et-al/support/greve/defpun.lisp
-workshops/2007/cowles-et-al/support/greve/defpun.pcert1 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defpun.pcert1 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/defpun.pcert1 : workshops/2007/cowles-et-al/support/greve/defpun.pcert0
-workshops/2007/cowles-et-al/support/greve/defpun.cert : | workshops/2007/cowles-et-al/support/greve/defpun.pcert1
-
-workshops/2007/cowles-et-al/support/greve/defxch.pcert0 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/defxch.pcert0 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defxch.pcert0 : \
-     arithmetic-2/meta/top.pcert0 \
-     misc/defpun.pcert0 \
-     workshops/2007/cowles-et-al/support/greve/defxch.lisp
-workshops/2007/cowles-et-al/support/greve/defxch.pcert1 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/defxch.pcert1 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/defxch.pcert1 : workshops/2007/cowles-et-al/support/greve/defxch.pcert0
-workshops/2007/cowles-et-al/support/greve/defxch.cert : | workshops/2007/cowles-et-al/support/greve/defxch.pcert1
-
-workshops/2007/cowles-et-al/support/greve/while.pcert0 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/while.pcert0 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/while.pcert0 : \
-     workshops/2007/cowles-et-al/support/greve/defminterm.pcert0 \
-     workshops/2007/cowles-et-al/support/greve/ack.pcert0 \
-     workshops/2007/cowles-et-al/support/greve/while.lisp
-workshops/2007/cowles-et-al/support/greve/while.pcert1 : acl2x = 0
-workshops/2007/cowles-et-al/support/greve/while.pcert1 : no_pcert = 0
-workshops/2007/cowles-et-al/support/greve/while.pcert1 : workshops/2007/cowles-et-al/support/greve/while.pcert0
-workshops/2007/cowles-et-al/support/greve/while.cert : | workshops/2007/cowles-et-al/support/greve/while.pcert1
-
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.pcert0 : no_pcert = 0
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.pcert0 : acl2x = 0
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.pcert0 : \
-     workshops/2007/cowles-et-al/support/ray/reflexive.pcert0 \
-     workshops/2007/cowles-et-al/support/ray/reflexive-macros.lisp
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.pcert1 : acl2x = 0
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.pcert1 : no_pcert = 0
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.pcert1 : workshops/2007/cowles-et-al/support/ray/reflexive-macros.pcert0
-workshops/2007/cowles-et-al/support/ray/reflexive-macros.cert : | workshops/2007/cowles-et-al/support/ray/reflexive-macros.pcert1
-
-workshops/2007/cowles-et-al/support/ray/reflexive.pcert0 : no_pcert = 0
-workshops/2007/cowles-et-al/support/ray/reflexive.pcert0 : acl2x = 0
-workshops/2007/cowles-et-al/support/ray/reflexive.pcert0 : \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2007/cowles-et-al/support/ray/reflexive.lisp
-workshops/2007/cowles-et-al/support/ray/reflexive.pcert1 : acl2x = 0
-workshops/2007/cowles-et-al/support/ray/reflexive.pcert1 : no_pcert = 0
-workshops/2007/cowles-et-al/support/ray/reflexive.pcert1 : workshops/2007/cowles-et-al/support/ray/reflexive.pcert0
-workshops/2007/cowles-et-al/support/ray/reflexive.cert : | workshops/2007/cowles-et-al/support/ray/reflexive.pcert1
-
-workshops/2007/dillinger-et-al/code/all.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/all.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/all.pcert0 : \
-     workshops/2007/dillinger-et-al/code/hacker.pcert0 \
-     workshops/2007/dillinger-et-al/code/defcode-macro.pcert0 \
-     workshops/2007/dillinger-et-al/code/defcode.pcert0 \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert0 \
-     workshops/2007/dillinger-et-al/code/raw.pcert0 \
-     workshops/2007/dillinger-et-al/code/rewrite-code.pcert0 \
-     workshops/2007/dillinger-et-al/code/redefun.pcert0 \
-     workshops/2007/dillinger-et-al/code/bridge.pcert0 \
-     workshops/2007/dillinger-et-al/code/subsumption.pcert0 \
-     workshops/2007/dillinger-et-al/code/table-guard.pcert0 \
-     workshops/2007/dillinger-et-al/code/all.lisp \
-     workshops/2007/dillinger-et-al/code/all.acl2
-workshops/2007/dillinger-et-al/code/all.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/all.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/all.pcert1 : workshops/2007/dillinger-et-al/code/all.pcert0
-workshops/2007/dillinger-et-al/code/all.cert : | workshops/2007/dillinger-et-al/code/all.pcert1
-
-workshops/2007/dillinger-et-al/code/bridge.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/bridge.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/bridge.pcert0 : \
-     workshops/2007/dillinger-et-al/code/defcode.pcert0 \
-     workshops/2007/dillinger-et-al/code/bridge.lisp \
-     workshops/2007/dillinger-et-al/code/bridge.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-workshops/2007/dillinger-et-al/code/bridge.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/bridge.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/bridge.pcert1 : workshops/2007/dillinger-et-al/code/bridge.pcert0
-workshops/2007/dillinger-et-al/code/bridge.cert : | workshops/2007/dillinger-et-al/code/bridge.pcert1
-
-workshops/2007/dillinger-et-al/code/defcode-macro.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/defcode-macro.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/defcode-macro.pcert0 : \
-     workshops/2007/dillinger-et-al/code/hacker.pcert0 \
-     workshops/2007/dillinger-et-al/code/hacker.pcert0 \
-     workshops/2007/dillinger-et-al/code/defcode-macro.lisp \
-     workshops/2007/dillinger-et-al/code/defcode-macro.acl2
-workshops/2007/dillinger-et-al/code/defcode-macro.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/defcode-macro.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/defcode-macro.pcert1 : workshops/2007/dillinger-et-al/code/defcode-macro.pcert0
-workshops/2007/dillinger-et-al/code/defcode-macro.cert : | workshops/2007/dillinger-et-al/code/defcode-macro.pcert1
-
-workshops/2007/dillinger-et-al/code/defcode.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/defcode.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/defcode.pcert0 : \
-     workshops/2007/dillinger-et-al/code/hacker.pcert0 \
-     workshops/2007/dillinger-et-al/code/defcode-macro.pcert0 \
-     workshops/2007/dillinger-et-al/code/hacker.pcert0 \
-     workshops/2007/dillinger-et-al/code/defcode.lisp \
-     workshops/2007/dillinger-et-al/code/defcode.acl2
-workshops/2007/dillinger-et-al/code/defcode.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/defcode.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/defcode.pcert1 : workshops/2007/dillinger-et-al/code/defcode.pcert0
-workshops/2007/dillinger-et-al/code/defcode.cert : | workshops/2007/dillinger-et-al/code/defcode.pcert1
-
-workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert0 : \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.lisp \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert1 : workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert0
-workshops/2007/dillinger-et-al/code/defstruct-parsing.cert : | workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert1
-
-workshops/2007/dillinger-et-al/code/hacker.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/hacker.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/hacker.pcert0 : \
-     workshops/2007/dillinger-et-al/code/hacker.lisp \
-     workshops/2007/dillinger-et-al/code/hacker.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-workshops/2007/dillinger-et-al/code/hacker.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/hacker.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/hacker.pcert1 : workshops/2007/dillinger-et-al/code/hacker.pcert0
-workshops/2007/dillinger-et-al/code/hacker.cert : | workshops/2007/dillinger-et-al/code/hacker.pcert1
-
-workshops/2007/dillinger-et-al/code/raw.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/raw.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/raw.pcert0 : \
-     workshops/2007/dillinger-et-al/code/defstruct-parsing.pcert0 \
-     workshops/2007/dillinger-et-al/code/defcode.pcert0 \
-     workshops/2007/dillinger-et-al/code/raw.lisp \
-     workshops/2007/dillinger-et-al/code/raw.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-workshops/2007/dillinger-et-al/code/raw.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/raw.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/raw.pcert1 : workshops/2007/dillinger-et-al/code/raw.pcert0
-workshops/2007/dillinger-et-al/code/raw.cert : | workshops/2007/dillinger-et-al/code/raw.pcert1
-
-workshops/2007/dillinger-et-al/code/redefun.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/redefun.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/redefun.pcert0 : \
-     workshops/2007/dillinger-et-al/code/defcode.pcert0 \
-     workshops/2007/dillinger-et-al/code/rewrite-code.pcert0 \
-     workshops/2007/dillinger-et-al/code/defcode.pcert0 \
-     workshops/2007/dillinger-et-al/code/redefun.lisp \
-     workshops/2007/dillinger-et-al/code/redefun.acl2
-workshops/2007/dillinger-et-al/code/redefun.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/redefun.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/redefun.pcert1 : workshops/2007/dillinger-et-al/code/redefun.pcert0
-workshops/2007/dillinger-et-al/code/redefun.cert : | workshops/2007/dillinger-et-al/code/redefun.pcert1
-
-workshops/2007/dillinger-et-al/code/rewrite-code.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/rewrite-code.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/rewrite-code.pcert0 : \
-     workshops/2007/dillinger-et-al/code/rewrite-code.lisp \
-     workshops/2007/dillinger-et-al/code/rewrite-code.acl2
-workshops/2007/dillinger-et-al/code/rewrite-code.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/rewrite-code.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/rewrite-code.pcert1 : workshops/2007/dillinger-et-al/code/rewrite-code.pcert0
-workshops/2007/dillinger-et-al/code/rewrite-code.cert : | workshops/2007/dillinger-et-al/code/rewrite-code.pcert1
-
-workshops/2007/dillinger-et-al/code/subsumption.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/subsumption.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/subsumption.pcert0 : \
-     workshops/2007/dillinger-et-al/code/defcode.pcert0 \
-     workshops/2007/dillinger-et-al/code/subsumption.lisp \
-     workshops/2007/dillinger-et-al/code/subsumption.acl2 \
-     workshops/2007/dillinger-et-al/code/hacker-pkg.lsp
-workshops/2007/dillinger-et-al/code/subsumption.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/subsumption.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/subsumption.pcert1 : workshops/2007/dillinger-et-al/code/subsumption.pcert0
-workshops/2007/dillinger-et-al/code/subsumption.cert : | workshops/2007/dillinger-et-al/code/subsumption.pcert1
-
-workshops/2007/dillinger-et-al/code/table-guard.pcert0 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/table-guard.pcert0 : acl2x = 0
-workshops/2007/dillinger-et-al/code/table-guard.pcert0 : \
-     workshops/2007/dillinger-et-al/code/defcode.pcert0 \
-     workshops/2007/dillinger-et-al/code/redefun.pcert0 \
-     workshops/2007/dillinger-et-al/code/defcode.pcert0 \
-     workshops/2007/dillinger-et-al/code/redefun.pcert0 \
-     workshops/2007/dillinger-et-al/code/table-guard.lisp \
-     workshops/2007/dillinger-et-al/code/table-guard.acl2
-workshops/2007/dillinger-et-al/code/table-guard.pcert1 : acl2x = 0
-workshops/2007/dillinger-et-al/code/table-guard.pcert1 : no_pcert = 0
-workshops/2007/dillinger-et-al/code/table-guard.pcert1 : workshops/2007/dillinger-et-al/code/table-guard.pcert0
-workshops/2007/dillinger-et-al/code/table-guard.cert : | workshops/2007/dillinger-et-al/code/table-guard.pcert1
-
-workshops/2007/erickson/bprove/bash.pcert0 : no_pcert = 0
-workshops/2007/erickson/bprove/bash.pcert0 : acl2x = 0
-workshops/2007/erickson/bprove/bash.pcert0 : \
-     workshops/2007/erickson/bprove/bash.lisp
-workshops/2007/erickson/bprove/bash.pcert1 : acl2x = 0
-workshops/2007/erickson/bprove/bash.pcert1 : no_pcert = 0
-workshops/2007/erickson/bprove/bash.pcert1 : workshops/2007/erickson/bprove/bash.pcert0
-workshops/2007/erickson/bprove/bash.cert : | workshops/2007/erickson/bprove/bash.pcert1
-
-workshops/2007/erickson/bprove/exdefs.pcert0 : no_pcert = 0
-workshops/2007/erickson/bprove/exdefs.pcert0 : acl2x = 0
-workshops/2007/erickson/bprove/exdefs.pcert0 : \
-     workshops/2007/erickson/bprove/lemgen.pcert0 \
-     workshops/2007/erickson/bprove/exdefs.lisp
-workshops/2007/erickson/bprove/exdefs.pcert1 : acl2x = 0
-workshops/2007/erickson/bprove/exdefs.pcert1 : no_pcert = 0
-workshops/2007/erickson/bprove/exdefs.pcert1 : workshops/2007/erickson/bprove/exdefs.pcert0
-workshops/2007/erickson/bprove/exdefs.cert : | workshops/2007/erickson/bprove/exdefs.pcert1
-
-workshops/2007/erickson/bprove/gen.pcert0 : no_pcert = 0
-workshops/2007/erickson/bprove/gen.pcert0 : acl2x = 0
-workshops/2007/erickson/bprove/gen.pcert0 : \
-     workshops/2007/erickson/bprove/gen.lisp
-workshops/2007/erickson/bprove/gen.pcert1 : acl2x = 0
-workshops/2007/erickson/bprove/gen.pcert1 : no_pcert = 0
-workshops/2007/erickson/bprove/gen.pcert1 : workshops/2007/erickson/bprove/gen.pcert0
-workshops/2007/erickson/bprove/gen.cert : | workshops/2007/erickson/bprove/gen.pcert1
-
-workshops/2007/erickson/bprove/lemgen.pcert0 : no_pcert = 0
-workshops/2007/erickson/bprove/lemgen.pcert0 : acl2x = 0
-workshops/2007/erickson/bprove/lemgen.pcert0 : \
-     workshops/2007/erickson/bprove/refute.pcert0 \
-     workshops/2007/erickson/bprove/gen.pcert0 \
-     workshops/2007/erickson/bprove/lemgen.lisp
-workshops/2007/erickson/bprove/lemgen.pcert1 : acl2x = 0
-workshops/2007/erickson/bprove/lemgen.pcert1 : no_pcert = 0
-workshops/2007/erickson/bprove/lemgen.pcert1 : workshops/2007/erickson/bprove/lemgen.pcert0
-workshops/2007/erickson/bprove/lemgen.cert : | workshops/2007/erickson/bprove/lemgen.pcert1
-
-workshops/2007/erickson/bprove/refute.pcert0 : no_pcert = 0
-workshops/2007/erickson/bprove/refute.pcert0 : acl2x = 0
-workshops/2007/erickson/bprove/refute.pcert0 : \
-     workshops/2007/erickson/bprove/bash.pcert0 \
-     workshops/2007/erickson/bprove/refute.lisp
-workshops/2007/erickson/bprove/refute.pcert1 : acl2x = 0
-workshops/2007/erickson/bprove/refute.pcert1 : no_pcert = 0
-workshops/2007/erickson/bprove/refute.pcert1 : workshops/2007/erickson/bprove/refute.pcert0
-workshops/2007/erickson/bprove/refute.cert : | workshops/2007/erickson/bprove/refute.pcert1
-
-workshops/2007/rimlinger/support/Rimlinger.pcert0 : no_pcert = 0
-workshops/2007/rimlinger/support/Rimlinger.pcert0 : acl2x = 0
-workshops/2007/rimlinger/support/Rimlinger.pcert0 : \
-     workshops/2007/rimlinger/support/Rimlinger.lisp
-workshops/2007/rimlinger/support/Rimlinger.pcert1 : acl2x = 0
-workshops/2007/rimlinger/support/Rimlinger.pcert1 : no_pcert = 0
-workshops/2007/rimlinger/support/Rimlinger.pcert1 : workshops/2007/rimlinger/support/Rimlinger.pcert0
-workshops/2007/rimlinger/support/Rimlinger.cert : | workshops/2007/rimlinger/support/Rimlinger.pcert1
-
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert0 : no_pcert = 0
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert0 : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert0 : \
-     data-structures/structures.pcert0 \
-     workshops/2007/rubio/support/abstract-reductions/abstract-proofs.lisp
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert1 : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert1 : no_pcert = 0
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert1 : workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert0
-workshops/2007/rubio/support/abstract-reductions/abstract-proofs.cert : | workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert1
-
-workshops/2007/rubio/support/abstract-reductions/confluence.pcert0 : no_pcert = 0
-workshops/2007/rubio/support/abstract-reductions/confluence.pcert0 : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/confluence.pcert0 : \
-     workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert0 \
-     workshops/2007/rubio/support/abstract-reductions/confluence.lisp \
-     workshops/2007/rubio/support/abstract-reductions/confluence.acl2
-workshops/2007/rubio/support/abstract-reductions/confluence.pcert1 : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/confluence.pcert1 : no_pcert = 0
-workshops/2007/rubio/support/abstract-reductions/confluence.pcert1 : workshops/2007/rubio/support/abstract-reductions/confluence.pcert0
-workshops/2007/rubio/support/abstract-reductions/confluence.cert : | workshops/2007/rubio/support/abstract-reductions/confluence.pcert1
-
-workshops/2007/rubio/support/abstract-reductions/convergent.pcert0 : no_pcert = 0
-workshops/2007/rubio/support/abstract-reductions/convergent.pcert0 : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/convergent.pcert0 : \
-     workshops/2007/rubio/support/abstract-reductions/confluence.pcert0 \
-     workshops/2007/rubio/support/abstract-reductions/newman.pcert0 \
-     workshops/2007/rubio/support/abstract-reductions/convergent.lisp \
-     workshops/2007/rubio/support/abstract-reductions/convergent.acl2
-workshops/2007/rubio/support/abstract-reductions/convergent.pcert1 : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/convergent.pcert1 : no_pcert = 0
-workshops/2007/rubio/support/abstract-reductions/convergent.pcert1 : workshops/2007/rubio/support/abstract-reductions/convergent.pcert0
-workshops/2007/rubio/support/abstract-reductions/convergent.cert : | workshops/2007/rubio/support/abstract-reductions/convergent.pcert1
-
-workshops/2007/rubio/support/abstract-reductions/newman.pcert0 : no_pcert = 0
-workshops/2007/rubio/support/abstract-reductions/newman.pcert0 : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/newman.pcert0 : \
-     workshops/2007/rubio/support/multisets/defmul.pcert0 \
-     workshops/2007/rubio/support/abstract-reductions/abstract-proofs.pcert0 \
-     workshops/2007/rubio/support/abstract-reductions/newman.lisp \
-     workshops/2007/rubio/support/abstract-reductions/newman.acl2
-workshops/2007/rubio/support/abstract-reductions/newman.pcert1 : acl2x = 0
-workshops/2007/rubio/support/abstract-reductions/newman.pcert1 : no_pcert = 0
-workshops/2007/rubio/support/abstract-reductions/newman.pcert1 : workshops/2007/rubio/support/abstract-reductions/newman.pcert0
-workshops/2007/rubio/support/abstract-reductions/newman.cert : | workshops/2007/rubio/support/abstract-reductions/newman.pcert1
-
-workshops/2007/rubio/support/multisets/defmul.pcert0 : no_pcert = 0
-workshops/2007/rubio/support/multisets/defmul.pcert0 : acl2x = 0
-workshops/2007/rubio/support/multisets/defmul.pcert0 : \
-     workshops/2007/rubio/support/multisets/multiset.pcert0 \
-     workshops/2007/rubio/support/multisets/defmul.lisp \
-     workshops/2007/rubio/support/multisets/defmul.acl2
-workshops/2007/rubio/support/multisets/defmul.pcert1 : acl2x = 0
-workshops/2007/rubio/support/multisets/defmul.pcert1 : no_pcert = 0
-workshops/2007/rubio/support/multisets/defmul.pcert1 : workshops/2007/rubio/support/multisets/defmul.pcert0
-workshops/2007/rubio/support/multisets/defmul.cert : | workshops/2007/rubio/support/multisets/defmul.pcert1
-
-workshops/2007/rubio/support/multisets/multiset.pcert0 : no_pcert = 0
-workshops/2007/rubio/support/multisets/multiset.pcert0 : acl2x = 0
-workshops/2007/rubio/support/multisets/multiset.pcert0 : \
-     ordinals/e0-ordinal.pcert0 \
-     workshops/2007/rubio/support/multisets/multiset.lisp \
-     workshops/2007/rubio/support/multisets/multiset.acl2
-workshops/2007/rubio/support/multisets/multiset.pcert1 : acl2x = 0
-workshops/2007/rubio/support/multisets/multiset.pcert1 : no_pcert = 0
-workshops/2007/rubio/support/multisets/multiset.pcert1 : workshops/2007/rubio/support/multisets/multiset.pcert0
-workshops/2007/rubio/support/multisets/multiset.cert : | workshops/2007/rubio/support/multisets/multiset.pcert1
-
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.pcert0 : no_pcert = 0
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.pcert0 : acl2x = 0
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.pcert0 : \
-     workshops/2007/rubio/support/abstract-reductions/convergent.pcert0 \
-     arithmetic/top-with-meta.pcert0 \
-     workshops/2007/rubio/support/simplicial-topology/generate-degenerate.lisp \
-     workshops/2007/rubio/support/simplicial-topology/generate-degenerate.acl2
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.pcert1 : acl2x = 0
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.pcert1 : no_pcert = 0
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.pcert1 : workshops/2007/rubio/support/simplicial-topology/generate-degenerate.pcert0
-workshops/2007/rubio/support/simplicial-topology/generate-degenerate.cert : | workshops/2007/rubio/support/simplicial-topology/generate-degenerate.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.lisp
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert1 : workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.cert : | workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.lisp
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert1 : workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.cert : | workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.lisp
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert1 : workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert : | workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.lisp
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert1 : workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert : | workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.lisp
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert1 : workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert : | workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     textbook/chap11/qsort.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.lisp
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert1 : workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.cert : | workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.lisp
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.pcert1 : workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.pcert0
-workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.cert : | workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert0 : \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert1
-
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.pcert0 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.pcert0 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.pcert0 : \
-     workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.pcert0 \
-     workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.lisp
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.pcert1 : acl2x = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.pcert1 : no_pcert = 0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.pcert1 : workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.pcert0
-workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.cert : | workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.pcert1
-
-workshops/2009/fraij-roach/support/functions.pcert0 : no_pcert = 0
-workshops/2009/fraij-roach/support/functions.pcert0 : acl2x = 0
-workshops/2009/fraij-roach/support/functions.pcert0 : \
-     ordinals/lexicographic-ordering.pcert0 \
-     workshops/2009/fraij-roach/support/functions.lisp
-workshops/2009/fraij-roach/support/functions.pcert1 : acl2x = 0
-workshops/2009/fraij-roach/support/functions.pcert1 : no_pcert = 0
-workshops/2009/fraij-roach/support/functions.pcert1 : workshops/2009/fraij-roach/support/functions.pcert0
-workshops/2009/fraij-roach/support/functions.cert : | workshops/2009/fraij-roach/support/functions.pcert1
-
-workshops/2009/fraij-roach/support/theorems.pcert0 : no_pcert = 0
-workshops/2009/fraij-roach/support/theorems.pcert0 : acl2x = 0
-workshops/2009/fraij-roach/support/theorems.pcert0 : \
-     workshops/2009/fraij-roach/support/functions.pcert0 \
-     workshops/2009/fraij-roach/support/theorems.lisp
-workshops/2009/fraij-roach/support/theorems.pcert1 : acl2x = 0
-workshops/2009/fraij-roach/support/theorems.pcert1 : no_pcert = 0
-workshops/2009/fraij-roach/support/theorems.pcert1 : workshops/2009/fraij-roach/support/theorems.pcert0
-workshops/2009/fraij-roach/support/theorems.cert : | workshops/2009/fraij-roach/support/theorems.pcert1
-
-workshops/2009/hardin/deque-stobj/deque-stobj.pcert0 : no_pcert = 0
-workshops/2009/hardin/deque-stobj/deque-stobj.pcert0 : acl2x = 0
-workshops/2009/hardin/deque-stobj/deque-stobj.pcert0 : \
-     workshops/2009/hardin/deque-stobj/deque-stobj.lisp
-workshops/2009/hardin/deque-stobj/deque-stobj.pcert1 : acl2x = 0
-workshops/2009/hardin/deque-stobj/deque-stobj.pcert1 : no_pcert = 0
-workshops/2009/hardin/deque-stobj/deque-stobj.pcert1 : workshops/2009/hardin/deque-stobj/deque-stobj.pcert0
-workshops/2009/hardin/deque-stobj/deque-stobj.cert : | workshops/2009/hardin/deque-stobj/deque-stobj.pcert1
-
-workshops/2009/hardin/deque-stobj/deque-thms.pcert0 : no_pcert = 0
-workshops/2009/hardin/deque-stobj/deque-thms.pcert0 : acl2x = 0
-workshops/2009/hardin/deque-stobj/deque-thms.pcert0 : \
-     workshops/2009/hardin/deque-stobj/deque-stobj.pcert0 \
-     arithmetic-5/top.pcert0 \
-     workshops/2009/hardin/deque-stobj/deque-thms.lisp
-workshops/2009/hardin/deque-stobj/deque-thms.pcert1 : acl2x = 0
-workshops/2009/hardin/deque-stobj/deque-thms.pcert1 : no_pcert = 0
-workshops/2009/hardin/deque-stobj/deque-thms.pcert1 : workshops/2009/hardin/deque-stobj/deque-thms.pcert0
-workshops/2009/hardin/deque-stobj/deque-thms.cert : | workshops/2009/hardin/deque-stobj/deque-thms.pcert1
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert0 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert0 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert0 : \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert0 \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.lisp \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.acl2
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert1 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert1 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert1 : workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.cert : | workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert1
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert0 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert0 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert0 : \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert0 \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert0 \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.lisp \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.acl2
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert1 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert1 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert1 : workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.cert : | workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert1
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.pcert0 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.pcert0 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.pcert0 : \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.pcert0 \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.pcert0 \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.lisp
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.pcert1 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.pcert1 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.pcert1 : workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.pcert0
-workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.cert : | workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.pcert1
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert0 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert0 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert0 : \
-     defexec/other-apps/records/records.pcert0 \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.lisp
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert1 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert1 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert1 : workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert0
-workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.cert : | workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.pcert1
-
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert0 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert0 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert0 : \
-     defexec/other-apps/records/records.pcert0 \
-     defexec/other-apps/records/records.pcert0 \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.lisp \
-     workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.acl2
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert1 : acl2x = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert1 : no_pcert = 0
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert1 : workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert0
-workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.cert : | workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.pcert1
-
-workshops/2009/liu/support/error-analysis-tool3.pcert0 : no_pcert = 0
-workshops/2009/liu/support/error-analysis-tool3.pcert0 : acl2x = 0
-workshops/2009/liu/support/error-analysis-tool3.pcert0 : \
-     rtl/rel8/arithmetic/top.pcert0 \
-     workshops/2009/liu/support/mylet.pcert0 \
-     workshops/2009/liu/support/error-analysis-tool3.lisp
-workshops/2009/liu/support/error-analysis-tool3.pcert1 : acl2x = 0
-workshops/2009/liu/support/error-analysis-tool3.pcert1 : no_pcert = 0
-workshops/2009/liu/support/error-analysis-tool3.pcert1 : workshops/2009/liu/support/error-analysis-tool3.pcert0
-workshops/2009/liu/support/error-analysis-tool3.cert : | workshops/2009/liu/support/error-analysis-tool3.pcert1
-
-workshops/2009/liu/support/mylet.pcert0 : no_pcert = 0
-workshops/2009/liu/support/mylet.pcert0 : acl2x = 0
-workshops/2009/liu/support/mylet.pcert0 : \
-     workshops/2009/liu/support/mylet.lisp
-workshops/2009/liu/support/mylet.pcert1 : acl2x = 0
-workshops/2009/liu/support/mylet.pcert1 : no_pcert = 0
-workshops/2009/liu/support/mylet.pcert1 : workshops/2009/liu/support/mylet.pcert0
-workshops/2009/liu/support/mylet.cert : | workshops/2009/liu/support/mylet.pcert1
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.pcert0 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.pcert0 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.pcert0 : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert0 \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.lisp
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.pcert1 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.pcert1 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.pcert1 : workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.pcert0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.cert : | workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.pcert1
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.pcert0 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.pcert0 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.pcert0 : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert0 \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.lisp
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.pcert1 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.pcert1 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.pcert1 : workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.pcert0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.cert : | workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.pcert1
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert0 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert0 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert0 : \
-     arithmetic-3/top.pcert0 \
-     make-event/defspec.pcert0 \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.lisp
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert1 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert1 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert1 : workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert : | workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert1
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert0 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert0 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert0 : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert0 \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.lisp
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert1 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert1 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert1 : workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.cert : | workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.pcert1
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert0 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert0 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert0 : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert0 \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.lisp
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert1 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert1 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert1 : workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.cert : | workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.pcert1
-
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.pcert0 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.pcert0 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.pcert0 : \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.pcert0 \
-     workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.lisp
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.pcert1 : acl2x = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.pcert1 : no_pcert = 0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.pcert1 : workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.pcert0
-workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.cert : | workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.pcert1
-
-workshops/2009/sumners/support/kas.pcert0 : no_pcert = 0
-workshops/2009/sumners/support/kas.pcert0 : acl2x = 0
-workshops/2009/sumners/support/kas.pcert0 : \
-     workshops/2009/sumners/support/kas.lisp \
-     workshops/2009/sumners/support/kas.acl2
-workshops/2009/sumners/support/kas.pcert1 : acl2x = 0
-workshops/2009/sumners/support/kas.pcert1 : no_pcert = 0
-workshops/2009/sumners/support/kas.pcert1 : workshops/2009/sumners/support/kas.pcert0
-workshops/2009/sumners/support/kas.cert : | workshops/2009/sumners/support/kas.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.pcert1
-
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert0 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert0 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert0 : \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.pcert0 \
-     workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.lisp
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert1 : acl2x = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert1 : no_pcert = 0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert1 : workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert0
-workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.cert : | workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert0 \
-     make-event/defspec.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert0 \
-     make-event/defspec.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert0 : \
-     ordinals/lexicographic-ordering.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.lisp
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.cert : | workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.pcert0 : \
-     make-event/defspec.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert0 \
-     ordinals/lexicographic-ordering.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert0 : \
-     ordinals/lexicographic-ordering.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.pcert0 \
-     arithmetic-3/bind-free/top.pcert0 \
-     arithmetic-3/floor-mod/floor-mod.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert0 : \
-     data-structures/list-defuns.pcert0 \
-     data-structures/list-defthms.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.pcert1
-
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert0 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert0 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert0 : \
-     workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.pcert0 \
-     workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.lisp
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert1 : acl2x = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert1 : no_pcert = 0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert1 : workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert0
-workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.cert : | workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.pcert1
-
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.pcert0 : no_pcert = 0
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.pcert0 : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.pcert0 : \
-     arithmetic-3/top.pcert0 \
-     workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.lisp
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.pcert1 : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.pcert1 : no_pcert = 0
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.pcert1 : workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.pcert0
-workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.cert : | workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.pcert1
-
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.pcert0 : no_pcert = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.pcert0 : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.pcert0 : \
-     arithmetic-3/top.pcert0 \
-     workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.lisp
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.pcert1 : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.pcert1 : no_pcert = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.pcert1 : workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.pcert0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.cert : | workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.pcert1
-
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.pcert0 : no_pcert = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.pcert0 : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.pcert0 : \
-     arithmetic-3/top.pcert0 \
-     workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.lisp
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.pcert1 : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.pcert1 : no_pcert = 0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.pcert1 : workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.pcert0
-workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.cert : | workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.pcert1
-
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.pcert0 : no_pcert = 0
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.pcert0 : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.pcert0 : \
-     arithmetic-3/top.pcert0 \
-     data-structures/utilities.pcert0 \
-     workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.lisp \
-     workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.acl2
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.pcert1 : acl2x = 0
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.pcert1 : no_pcert = 0
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.pcert1 : workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.pcert0
-workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.cert : | workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.pcert1
-
-wp-gen/mutrec/mutrec.pcert0 : no_pcert = 0
-wp-gen/mutrec/mutrec.pcert0 : acl2x = 0
-wp-gen/mutrec/mutrec.pcert0 : \
-     ordinals/lexicographic-ordering.pcert0 \
-     wp-gen/mutrec/mutrec.lisp
-wp-gen/mutrec/mutrec.pcert1 : acl2x = 0
-wp-gen/mutrec/mutrec.pcert1 : no_pcert = 0
-wp-gen/mutrec/mutrec.pcert1 : wp-gen/mutrec/mutrec.pcert0
-wp-gen/mutrec/mutrec.cert : | wp-gen/mutrec/mutrec.pcert1
-
-wp-gen/shared.pcert0 : no_pcert = 0
-wp-gen/shared.pcert0 : acl2x = 0
-wp-gen/shared.pcert0 : \
-     wp-gen/shared.lisp
-wp-gen/shared.pcert1 : acl2x = 0
-wp-gen/shared.pcert1 : no_pcert = 0
-wp-gen/shared.pcert1 : wp-gen/shared.pcert0
-wp-gen/shared.cert : | wp-gen/shared.pcert1
-
-wp-gen/wp-gen.pcert0 : no_pcert = 0
-wp-gen/wp-gen.pcert0 : acl2x = 0
-wp-gen/wp-gen.pcert0 : \
-     wp-gen/shared.pcert0 \
-     wp-gen/mutrec/mutrec.pcert0 \
-     wp-gen/wp-gen.lisp \
-     wp-gen/wp-gen.acl2
-wp-gen/wp-gen.pcert1 : acl2x = 0
-wp-gen/wp-gen.pcert1 : no_pcert = 0
-wp-gen/wp-gen.pcert1 : wp-gen/wp-gen.pcert0
-wp-gen/wp-gen.cert : | wp-gen/wp-gen.pcert1
-
-xdoc-impl/autolink.pcert0 : no_pcert = 0
-xdoc-impl/autolink.pcert0 : acl2x = 0
-xdoc-impl/autolink.pcert0 : \
-     xdoc-impl/fmt-to-str.pcert0 \
-     xdoc/names.pcert0 \
-     misc/assert.pcert0 \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/autolink.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/autolink.pcert1 : acl2x = 0
-xdoc-impl/autolink.pcert1 : no_pcert = 0
-xdoc-impl/autolink.pcert1 : xdoc-impl/autolink.pcert0
-xdoc-impl/autolink.cert : | xdoc-impl/autolink.pcert1
-
-xdoc-impl/extra-packages.pcert0 : no_pcert = 0
-xdoc-impl/extra-packages.pcert0 : acl2x = 0
-xdoc-impl/extra-packages.pcert0 : \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/extra-packages.lisp \
-     xdoc-impl/extra-packages.acl2 \
-     xdoc-impl/cert.acl2 \
-     cowles/packages.lsp \
-     clause-processors/SULFA/books/sat/sat-package.acl2 \
-     data-structures/define-u-package.lsp \
-     data-structures/define-structures-package.lsp \
-     data-structures/memories/package.lsp \
-     hacking/hacker-pkg.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     tools/flag-package.lsp \
-     oslib/package.lsp \
-     cutil/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp \
-     xdoc/package.lsp \
-     finite-set-theory/osets/sets.defpkg \
-     xdoc/package.lsp
-xdoc-impl/extra-packages.pcert1 : acl2x = 0
-xdoc-impl/extra-packages.pcert1 : no_pcert = 0
-xdoc-impl/extra-packages.pcert1 : xdoc-impl/extra-packages.pcert0
-xdoc-impl/extra-packages.cert : | xdoc-impl/extra-packages.pcert1
-
-xdoc-impl/fmt-to-str.pcert0 : no_pcert = 0
-xdoc-impl/fmt-to-str.pcert0 : acl2x = 0
-xdoc-impl/fmt-to-str.pcert0 : \
-     tools/bstar.pcert0 \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/fmt-to-str.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/fmt-to-str.pcert1 : acl2x = 0
-xdoc-impl/fmt-to-str.pcert1 : no_pcert = 0
-xdoc-impl/fmt-to-str.pcert1 : xdoc-impl/fmt-to-str.pcert0
-xdoc-impl/fmt-to-str.cert : | xdoc-impl/fmt-to-str.pcert1
-
-xdoc-impl/import-acl2doc.pcert0 : no_pcert = 0
-xdoc-impl/import-acl2doc.pcert0 : acl2x = 0
-xdoc-impl/import-acl2doc.pcert0 : \
-     xdoc-impl/write-acl2-xdoc.pcert0 \
-     xdoc/base.pcert0 \
-     tools/bstar.pcert0 \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/import-acl2doc.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/import-acl2doc.pcert1 : acl2x = 0
-xdoc-impl/import-acl2doc.pcert1 : no_pcert = 0
-xdoc-impl/import-acl2doc.pcert1 : xdoc-impl/import-acl2doc.pcert0
-xdoc-impl/import-acl2doc.cert : | xdoc-impl/import-acl2doc.pcert1
-
-xdoc-impl/mkdir-raw.pcert0 : no_pcert = 0
-xdoc-impl/mkdir-raw.pcert0 : acl2x = 0
-xdoc-impl/mkdir-raw.pcert0 : \
-     xdoc-impl/mkdir.pcert0 \
-     tools/bstar.pcert0 \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/mkdir-raw.lisp \
-     xdoc-impl/mkdir-raw.acl2 \
-     xdoc-impl/cert.acl2
-xdoc-impl/mkdir-raw.pcert1 : acl2x = 0
-xdoc-impl/mkdir-raw.pcert1 : no_pcert = 0
-xdoc-impl/mkdir-raw.pcert1 : xdoc-impl/mkdir-raw.pcert0
-xdoc-impl/mkdir-raw.cert : | xdoc-impl/mkdir-raw.pcert1
-
-xdoc-impl/mkdir.pcert0 : no_pcert = 0
-xdoc-impl/mkdir.pcert0 : acl2x = 0
-xdoc-impl/mkdir.pcert0 : \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/mkdir.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/mkdir.pcert1 : acl2x = 0
-xdoc-impl/mkdir.pcert1 : no_pcert = 0
-xdoc-impl/mkdir.pcert1 : xdoc-impl/mkdir.pcert0
-xdoc-impl/mkdir.cert : | xdoc-impl/mkdir.pcert1
-
-xdoc-impl/parse-xml.pcert0 : no_pcert = 0
-xdoc-impl/parse-xml.pcert0 : acl2x = 0
-xdoc-impl/parse-xml.pcert0 : \
-     xdoc-impl/preprocess.pcert0 \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/parse-xml.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/parse-xml.pcert1 : acl2x = 0
-xdoc-impl/parse-xml.pcert1 : no_pcert = 0
-xdoc-impl/parse-xml.pcert1 : xdoc-impl/parse-xml.pcert0
-xdoc-impl/parse-xml.cert : | xdoc-impl/parse-xml.pcert1
-
-xdoc-impl/portcullis.pcert0 : no_pcert = 0
-xdoc-impl/portcullis.pcert0 : acl2x = 0
-xdoc-impl/portcullis.pcert0 : \
-     xdoc-impl/portcullis.lisp \
-     xdoc-impl/portcullis.acl2 \
-     xdoc/package.lsp \
-     str/package.lsp \
-     xdoc/package.lsp
-xdoc-impl/portcullis.pcert1 : acl2x = 0
-xdoc-impl/portcullis.pcert1 : no_pcert = 0
-xdoc-impl/portcullis.pcert1 : xdoc-impl/portcullis.pcert0
-xdoc-impl/portcullis.cert : | xdoc-impl/portcullis.pcert1
-
-xdoc-impl/preprocess.pcert0 : no_pcert = 0
-xdoc-impl/preprocess.pcert0 : acl2x = 0
-xdoc-impl/preprocess.pcert0 : \
-     xdoc-impl/autolink.pcert0 \
-     str/top.pcert0 \
-     misc/assert.pcert0 \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/preprocess.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/preprocess.pcert1 : acl2x = 0
-xdoc-impl/preprocess.pcert1 : no_pcert = 0
-xdoc-impl/preprocess.pcert1 : xdoc-impl/preprocess.pcert0
-xdoc-impl/preprocess.cert : | xdoc-impl/preprocess.pcert1
-
-xdoc-impl/save.pcert0 : no_pcert = 0
-xdoc-impl/save.pcert0 : acl2x = 0
-xdoc-impl/save.pcert0 : \
-     xdoc-impl/mkdir.pcert0 \
-     xdoc/base.pcert0 \
-     xdoc-impl/preprocess.pcert0 \
-     xdoc-impl/parse-xml.pcert0 \
-     xdoc-impl/sort.pcert0 \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/save.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/save.pcert1 : acl2x = 0
-xdoc-impl/save.pcert1 : no_pcert = 0
-xdoc-impl/save.pcert1 : xdoc-impl/save.pcert0
-xdoc-impl/save.cert : | xdoc-impl/save.pcert1
-
-xdoc-impl/sort.pcert0 : no_pcert = 0
-xdoc-impl/sort.pcert0 : acl2x = 0
-xdoc-impl/sort.pcert0 : \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/sort.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/sort.pcert1 : acl2x = 0
-xdoc-impl/sort.pcert1 : no_pcert = 0
-xdoc-impl/sort.pcert1 : xdoc-impl/sort.pcert0
-xdoc-impl/sort.cert : | xdoc-impl/sort.pcert1
-
-xdoc-impl/topics.pcert0 : no_pcert = 0
-xdoc-impl/topics.pcert0 : acl2x = 0
-xdoc-impl/topics.pcert0 : \
-     xdoc-impl/import-acl2doc.pcert0 \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/topics.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/topics.pcert1 : acl2x = 0
-xdoc-impl/topics.pcert1 : no_pcert = 0
-xdoc-impl/topics.pcert1 : xdoc-impl/topics.pcert0
-xdoc-impl/topics.cert : | xdoc-impl/topics.pcert1
-
-xdoc-impl/write-acl2-xdoc.pcert0 : no_pcert = 0
-xdoc-impl/write-acl2-xdoc.pcert0 : acl2x = 0
-xdoc-impl/write-acl2-xdoc.pcert0 : \
-     xdoc-impl/portcullis.pcert0 \
-     xdoc-impl/write-acl2-xdoc.lisp \
-     xdoc-impl/cert.acl2
-xdoc-impl/write-acl2-xdoc.pcert1 : acl2x = 0
-xdoc-impl/write-acl2-xdoc.pcert1 : no_pcert = 0
-xdoc-impl/write-acl2-xdoc.pcert1 : xdoc-impl/write-acl2-xdoc.pcert0
-xdoc-impl/write-acl2-xdoc.cert : | xdoc-impl/write-acl2-xdoc.pcert1
-
-xdoc/base.pcert0 : no_pcert = 0
-xdoc/base.pcert0 : acl2x = 0
-xdoc/base.pcert0 : \
-     xdoc/portcullis.pcert0 \
-     xdoc/base.lisp \
-     xdoc/cert.acl2
-xdoc/base.pcert1 : acl2x = 0
-xdoc/base.pcert1 : no_pcert = 0
-xdoc/base.pcert1 : xdoc/base.pcert0
-xdoc/base.cert : | xdoc/base.pcert1
-
-xdoc/book-thms.pcert0 : no_pcert = 0
-xdoc/book-thms.pcert0 : acl2x = 0
-xdoc/book-thms.pcert0 : \
-     xdoc/portcullis.pcert0 \
-     xdoc/book-thms.lisp \
-     xdoc/cert.acl2
-xdoc/book-thms.pcert1 : acl2x = 0
-xdoc/book-thms.pcert1 : no_pcert = 0
-xdoc/book-thms.pcert1 : xdoc/book-thms.pcert0
-xdoc/book-thms.cert : | xdoc/book-thms.pcert1
-
-xdoc/defxdoc-raw.pcert0 : no_pcert = 0
-xdoc/defxdoc-raw.pcert0 : acl2x = 0
-xdoc/defxdoc-raw.pcert0 : \
-     xdoc/base.pcert0 \
-     xdoc/portcullis.pcert0 \
-     xdoc/defxdoc-raw.lisp \
-     xdoc/defxdoc-raw.acl2
-xdoc/defxdoc-raw.pcert1 : acl2x = 0
-xdoc/defxdoc-raw.pcert1 : no_pcert = 0
-xdoc/defxdoc-raw.pcert1 : xdoc/defxdoc-raw.pcert0
-xdoc/defxdoc-raw.cert : | xdoc/defxdoc-raw.pcert1
-
-xdoc/names.pcert0 : no_pcert = 0
-xdoc/names.pcert0 : acl2x = 0
-xdoc/names.pcert0 : \
-     xdoc/base.pcert0 \
-     xdoc/portcullis.pcert0 \
-     xdoc/names.lisp \
-     xdoc/cert.acl2
-xdoc/names.pcert1 : acl2x = 0
-xdoc/names.pcert1 : no_pcert = 0
-xdoc/names.pcert1 : xdoc/names.pcert0
-xdoc/names.cert : | xdoc/names.pcert1
-
-xdoc/portcullis.pcert0 : no_pcert = 0
-xdoc/portcullis.pcert0 : acl2x = 0
-xdoc/portcullis.pcert0 : \
-     xdoc/portcullis.lisp \
-     xdoc/portcullis.acl2 \
-     xdoc/package.lsp
-xdoc/portcullis.pcert1 : acl2x = 0
-xdoc/portcullis.pcert1 : no_pcert = 0
-xdoc/portcullis.pcert1 : xdoc/portcullis.pcert0
-xdoc/portcullis.cert : | xdoc/portcullis.pcert1
-
-xdoc/top.pcert0 : no_pcert = 0
-xdoc/top.pcert0 : acl2x = 0
-xdoc/top.pcert0 : \
-     xdoc/base.pcert0 \
-     xdoc/book-thms.pcert0 \
-     xdoc/portcullis.pcert0 \
-     xdoc/top.lisp \
-     xdoc/cert.acl2
-xdoc/top.pcert1 : acl2x = 0
-xdoc/top.pcert1 : no_pcert = 0
-xdoc/top.pcert1 : xdoc/top.pcert0
-xdoc/top.cert : | xdoc/top.pcert1
-
-
-endif
-
diff -Nru acl2-6.2/books/Makefile-generic acl2-6.3/books/Makefile-generic
--- acl2-6.2/books/Makefile-generic	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/Makefile-generic	2013-09-30 17:53:32.000000000 +0000
@@ -1,4 +1,4 @@
-#; Support for Community Books to Go with ACL2 Version 6.2
+#; Support for ACL2 Community Books
 #; Copyright (C) 2013, Regents of the University of Texas
 
 #; This program is free software; you can redistribute it and/or
@@ -153,6 +153,7 @@
 BOOKS_DX64FSL = $(patsubst %, %.dx64fsl, $(BOOKS_COMP))
 BOOKS_LX64FSL = $(patsubst %, %.lx64fsl, $(BOOKS_COMP))
 BOOKS_LX32FSL = $(patsubst %, %.lx32fsl, $(BOOKS_COMP))
+BOOKS_SSE2F   = $(patsubst %, %.sse2f,   $(BOOKS_COMP))
 BOOKS_X86F    = $(patsubst %, %.x86f,    $(BOOKS_COMP))
 BOOKS_O       = $(patsubst %, %.o,       $(BOOKS_COMP))
 
@@ -439,6 +440,15 @@
 	@echo "Making $$PWD/$@"
 	echo '(acl2::value :q) (acl2::lp) (ld `((include-book "$(patsubst %.lx32fsl,%,$(@))" :load-compiled-file :comp :ttags :all))) (acl2::value :q) (acl2::exit-lisp)' | $(ACL2)
 
+.PHONY: sse2f
+sse2f:
+	@echo 'Using ACL2=$(ACL2)'
+	$(MAKE) -s -f $(ACL2_BOOKS_MAKEFILE) $(BOOKS_SSE2F) INHIBIT='$(INHIBIT)' ACL2='$(ACL2)'
+
+%.sse2f: %.cert
+	@echo "Making $$PWD/$@"
+	echo '(acl2::value :q) (acl2::lp) (ld `((include-book "$(patsubst %.sse2f,%,$(@))" :load-compiled-file :comp :ttags :all))) (acl2::value :q) (acl2::exit-lisp)' | $(ACL2)
+
 .PHONY: nothing
 nothing:
 	@echo "There\'s a good reason to do this here."
diff -Nru acl2-6.2/books/Makefile-psubdirs acl2-6.3/books/Makefile-psubdirs
--- acl2-6.2/books/Makefile-psubdirs	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/Makefile-psubdirs	2013-09-30 17:53:32.000000000 +0000
@@ -1,4 +1,4 @@
-#; Support for Community Books to Go with ACL2 Version 6.2
+#; Support for ACL2 Community Books
 #; Copyright (C) 2013, Regents of the University of Texas
 
 #; This program is free software; you can redistribute it and/or
diff -Nru acl2-6.2/books/Makefile-subdirs acl2-6.3/books/Makefile-subdirs
--- acl2-6.2/books/Makefile-subdirs	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/Makefile-subdirs	2013-09-30 17:53:32.000000000 +0000
@@ -1,4 +1,4 @@
-#; Support for Community Books to Go with ACL2 Version 6.2
+#; Support for ACL2 Community Books
 #; Copyright (C) 2013, Regents of the University of Texas
 
 #; This program is free software; you can redistribute it and/or
diff -Nru acl2-6.2/books/Makefile.legacy acl2-6.3/books/Makefile.legacy
--- acl2-6.2/books/Makefile.legacy	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/Makefile.legacy	1970-01-01 00:00:00.000000000 +0000
@@ -1,1010 +0,0 @@
-#; Support for Community Books to Go with ACL2 Version 6.2
-#; Copyright (C) 2013, Regents of the University of Texas
-
-#; This program is free software; you can redistribute it and/or
-#; modify it under the terms of Version 2 of the GNU General Public
-#; License as published by the Free Software Foundation.
-
-#; This program is distributed in the hope that it will be useful,
-#; but WITHOUT ANY WARRANTY; without even the implied warranty of
-#; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-#; GNU General Public License for more details.
-
-#; You should have received a copy of the GNU General Public License
-#; along with this program; if not, write to the Free Software
-#; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-#; Written by:  Matt Kaufmann               and J Strother Moore
-#; email:       Kaufmann@cs.utexas.edu      and Moore@cs.utexas.edu
-#; Department of Computer Sciences
-#; University of Texas at Austin
-#; Austin, TX 78712-1188 U.S.A.
-
-# This file certifies books by directing appropriate subdirectories to
-# certify their books.  The subsidiary Makefiles take advantage of a
-# makefile, Makefile-generic, in this directory, which is derived from
-# one written by Bishop Brock.
-
-# For example, to clean and time book certification (including workshops):
-# make clean all-plus
-
-# To see how one can certify the books in the regression suite using
-# waterfall parallelism (requires the experimental extension ACL2(p)
-# of ACL2), see file acl2-sources/acl2-customization-files/README.
-
-# We do not set variable ACL2 here, because the value here would be
-# overriden anyhow by the values in the subsidiary Makefiles, which get their
-# value from file Makefile-generic.  However, ACL2 can be set on the command
-# line, e.g.:
-# make ACL2=acl2
-# make ACL2=/usr/local/bin/acl2 TIME=/usr/bin/time
-# make ACL2=/u/acl2/v2-9/acl2-sources/saved_acl2
-
-TIME = time
-
-# Avoid loading customization file unless environment variable is already set.
-# (This is also done in Makefile-generic, but we do it here in support of the
-# hons target.)
-export ACL2_CUSTOMIZATION ?= NONE
-
-# Directories go here; first those before certifying arithmetic/top-with-meta,
-# then those afterwards.
-
-# NOTE!  This does *not* touch directory nonstd.
-
-# Note: arithmetic-4 could be added in analogy to arithmetic-5.
-
-DIRS1 = cowles arithmetic meta xdoc
-DIRS2_EXCEPT_WK_COI = ordinals data-structures bdd ihs arithmetic-2 arithmetic-3 arithmetic-5 \
-	misc models/jvm/m1-original models/jvm/m1 models/jvm/m5 \
-	proofstyles rtl arithmetic-3/extra sorting make-event parallel hints \
-	fix-cert finite-set-theory finite-set-theory/osets powerlists textbook \
-	defexec symbolic \
-	data-structures/memories unicode str concurrent-programs/bakery \
-	concurrent-programs/german-protocol deduction/passmore clause-processors \
-	quadratic-reciprocity tools paco hacking security regex \
-	defsort serialize wp-gen xdoc-impl system tutorial-problems \
-	cutil cutil/tools countereg-gen demos leftist-trees taspi \
-	std std/ks std/lists std/io std/alists std/typed-lists std/misc \
-	oslib tau add-ons
-# Add directories other than centaur that depend on hons, say, for performance:
-HONS_ONLY_DIRS = models/y86 security/des
-ifdef ACL2_HONS_REGRESSION
-DIRS2_EXCEPT_WK_COI += $(HONS_ONLY_DIRS)
-endif
-DIRS2_EXCEPT_WK = $(DIRS2_EXCEPT_WK_COI) coi misc/misc2
-DIRS2 = $(DIRS2_EXCEPT_WK) workshops
-SHORTDIRS2 = ordinals data-structures bdd
-
-# If ACL2_CENTAUR is already set then we leave it alone.  Otherwise
-# we set ACL2_CENTAUR to `before' to obtain extra parallelism via the
-# centaur/ books unless specific directories are specified, in which
-# case we set ACL2_CENTAUR to `skip' to avoid certifying the centaur
-# books needlessly.  (If a books directory depends on the centaur
-# books, then its dependency should be recorded among the long list of
-# dependencies below.)
-ifdef ACL2_BOOK_DIRS
-ifndef ACL2_CENTAUR
-ACL2_CENTAUR ?= skip
-endif
-else
-ACL2_CENTAUR ?= before
-# The following can be any subset of DIRS2, and can be set by the user
-# on the command line, e.g., from the ACL2 sources directory:
-#   make -j 8 regression ACL2_BOOK_DIRS='symbolic paco'
-# The directory dependencies (below) should guarantee that all
-# necessary supporting directories are made before the ones specified
-# explicitly in ACL2_BOOK_DIRS.
-ACL2_BOOK_DIRS := $(DIRS2)
-endif
-
-ALL_PLUS_DIRS = $(DIRS1) $(ACL2_BOOK_DIRS)
-
-ifdef ACL2
-	ACL2_FOR_HONS ?= $(ACL2)
-	ACL2_FOR_CENTAUR ?= $(ACL2)
-else
-	ACL2_FOR_HONS ?= $(shell cd .. ; pwd)/saved_acl2h
-	ACL2_FOR_CENTAUR ?= $(shell cd .. ; pwd)/saved_acl2
-ifdef ACL2_HONS_REGRESSION
-# and ACL2 not defined
-	export ACL2 = $(shell cd .. ; pwd)/saved_acl2h
-endif
-endif
-
-# Since we have specified that ACL2_BOOK_DIRS is to be a subset of
-# DIRS2, we don't need to add it explicitly on the next line.
-.PHONY: $(DIRS1) $(DIRS2)
-
-# Same as all-plus below, using DIRS2_EXCEPT_WK instead of DIRS2.  Much faster!  Omits
-# books less likely to be needed, in particular, under workshops/.
-all:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-aux
-
-
-# Next, specify all of the directory dependencies.  At this point we do this
-# manually by inspecting the Makefiles.
-
-arithmetic: cowles
-data-structures: arithmetic
-meta: arithmetic
-ordinals: top-with-meta-cert
-ihs: arithmetic data-structures
-misc: data-structures top-with-meta-cert ordinals arithmetic ihs arithmetic-2 arithmetic-3 std/lists
-make-event: misc arithmetic-3 arithmetic rtl
-arithmetic-2: ihs
-rtl: arithmetic meta top-with-meta-cert ordinals ihs misc arithmetic-2
-# arithmetic-3 has no dependencies (but see arithmetic-3/extra)
-arithmetic-3/extra: arithmetic-3 ihs rtl arithmetic-2 arithmetic-3
-# arithmetic-5 has no dependencies
-finite-set-theory: arithmetic ordinals
-finite-set-theory/osets: unicode tools
-powerlists: arithmetic ordinals data-structures
-textbook: arithmetic top-with-meta-cert ordinals ihs
-defexec: arithmetic misc ordinals
-symbolic: arithmetic arithmetic-2 data-structures ihs misc ordinals models/jvm/m5
-data-structures/memories: arithmetic-3 misc
-unicode: arithmetic arithmetic-3 ihs ordinals tools misc system std/io std/lists std/ks
-proofstyles: arithmetic-2 ordinals misc top-with-meta-cert
-concurrent-programs/bakery: misc ordinals
-concurrent-programs/german-protocol: misc
-deduction/passmore: 
-serialize: tools
-clause-processors: top-with-meta-cert arithmetic-3 textbook arithmetic \
-	misc tools data-structures arithmetic-5 system parallel system
-quadratic-reciprocity: rtl
-misc/misc2: rtl coi top-with-meta-cert
-hints: misc
-models/jvm/m1-original: arithmetic-3/extra
-models/jvm/m1: arithmetic-5
-models/jvm/m5: top-with-meta-cert ordinals misc ihs
-# models/jvm/m5 is needed for paco/books, not paco
-models/X86: tools arithmetic-5 arithmetic misc rtl defexec
-paco: ihs ordinals top-with-meta-cert
-hacking: misc
-parallel: make-event tools
-security: misc arithmetic-3 arithmetic-5
-security/des: security misc centaur
-sorting: arithmetic-3/extra
-tools: arithmetic-5 misc xdoc
-regex: tools cutil str misc
-defsort: misc tools std/lists
-str: arithmetic defsort tools xdoc misc std/ks
-coi: arithmetic arithmetic-2 arithmetic-3 data-structures ihs make-event \
-	misc ordinals rtl
-wp-gen: ordinals
-# xdoc has no dependencies
-xdoc-impl: xdoc str tools finite-set-theory/osets
-system: tools arithmetic arithmetic-5 misc
-std/lists: arithmetic top-with-meta-cert xdoc
-std/alists: std/lists tools
-std/typed-lists: std/lists cutil arithmetic
-std/ks: std/lists ihs arithmetic xdoc std/misc
-std/io: tools xdoc system std/lists std/ks arithmetic ihs arithmetic-3
-std/misc: std/lists ihs top-with-meta-cert xdoc
-cutil: xdoc xdoc-impl tools str misc finite-set-theory/osets \
-       defsort unicode clause-processors system top-with-meta-cert
-cutil/tools: cutil tools
-countereg-gen: xdoc arithmetic-5 tools defexec finite-set-theory/osets \
-	arithmetic-3 arithmetic ordinals
-leftist-trees: arithmetic-5 sorting
-demos: make-event cutil misc tools arithmetic
-taspi: misc arithmetic-3
-models/y86: tools centaur misc arithmetic-5 rtl arithmetic defexec
-oslib: cutil str tools misc
-tau: arithmetic-5
-add-ons: arithmetic misc hacking
-
-# Let us wait for everything else before workshops.  Starting after
-# Version_4.3 we include the coi books, because of
-# workshops/2006/pike-shields-matthews/.
-workshops: $(DIRS1) $(DIRS2_EXCEPT_WK)
-
-$(DIRS1):
-	@if [ -f $@/Makefile ]; then cd $@ ; $(MAKE) ; fi
-
-$(DIRS2): top-with-meta-cert
-	@if [ -f $@/Makefile ]; then cd $@ ; $(MAKE) ; fi
-
-.PHONY: all-aux
-all-aux: $(DIRS1) $(DIRS2_EXCEPT_WK)
-
-# Certify all books that need certification.  If you want to get a
-# total time for certifying all books, then first do "make clean".  By
-# default we do the centaur books first, because one of them might
-# support a non-centaur book.  This is quite a commitment: henceforth,
-# the regression could in theory fail if we remove the centaur books
-# (say, because someone has a problem with Perl).  We'll face that
-# problem if it occurs; for example, we could remove the "offending"
-# directory from DIRS2_EXCEPT_WK_COI, or we could use
-# ACL2_CENTAUR=skip on the command line.
-
-.PHONY: all-plus centaur
-
-ifeq ($(ACL2_CENTAUR),before)
-all-plus: $(ALL_PLUS_DIRS)
-$(ALL_PLUS_DIRS): centaur
-else
-ifeq ($(ACL2_CENTAUR),after)
-all-plus: centaur
-centaur: $(ALL_PLUS_DIRS)
-else
-all-plus: $(ALL_PLUS_DIRS)
-endif
-endif
-
-.PHONY: hons clean-hons
-# For a parallel "make hons", use e.g.:
-#   make hons ACL2_HONS_OPT="-j4"
-# In general, ACL2_HONS_OPT is passed to the cert.pl command in centaur/.
-# Note that this variable is set automatically in ../GNUmakefile using
-# ACL2_JOBS.
-hons:
-	./cert.pl --targets regression-hons-targets \
-	  $(ACL2_HONS_OPT) \
-	  --acl2-books "`pwd`" \
-	  --acl2 $(ACL2_FOR_HONS)
-
-# WARNING: clean-hons will clean everywhere relevant to books/centaur/ under
-# the books/ directory, not merely under books/centaur/.
-clean-hons:
-	rm -rf centaur/manual
-	./cert.pl -c centaur/doc.lisp \
-	  $(ACL2_HONS_OPT) \
-	  --acl2-books "`pwd`" \
-	  -q
-	cd taspi/ ; make clean
-
-# Clean all books, not only the "basic" ones.
-.PHONY: clean
-clean:
-	@for dir in $(DIRS1) $(DIRS2) $(HONS_ONLY_DIRS) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) FAST_DEPS_FOR_CLEAN=1 clean ; \
-	cd ..) ; \
-	fi \
-	done
-
-# See instructions for hons above -- except we expect to use the
-# centaur target with vanilla ACL2, as opposed to ACL2(h).
-centaur:
-	./cert.pl --targets regression-centaur-targets \
-	  $(ACL2_HONS_OPT) \
-	  --acl2-books "`pwd`" \
-	  --acl2 $(ACL2_FOR_CENTAUR)
-
-# WARNING: clean-centaur will clean everywhere relevant to books/centaur/ under
-# the books/ directory, not merely under books/centaur/.
-.PHONY: clean-centaur
-ifeq ($(ACL2_CENTAUR),skip)
-clean-centaur:
-	@echo "Skipping actions for clean-centaur."
-else
-clean-centaur:
-	rm -rf centaur/manual
-	./cert.pl -c centaur/doc.lisp \
-	  $(ACL2_HONS_OPT) \
-	  --acl2-books "`pwd`" \
-	  -q
-endif
-
-.PHONY: clean
-clean: clean-centaur
-
-# Tar up books and support, not including workshops or nonstd stuff.
-.PHONY: tar
-tar:
-	tar cvf books.tar Makefile Makefile-generic Makefile-subdirs README README.html certify-numbers.lsp $(DIRS1) $(DIRS2_EXCEPT_WK)
-
-# The following "short" targets allow for a relatively short test, in response
-# to a request from GCL maintainer Camm Maguire.
-
-.PHONY: short-clean
-short-clean:
-	@rm -f short-test.log
-	@for dir in $(DIRS1) $(SHORTDIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) clean ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: short-test-aux
-short-test-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) all ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-cert
-	@for dir in $(SHORTDIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) all ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: short-test
-short-test:
-	@rm -f short-test.log
-	$(MAKE) -f Makefile.legacy short-clean
-	$(MAKE) -f Makefile.legacy short-test-aux > short-test.log 2> short-test.log
-	@if [ ! -f short-test.log ] || (fgrep '**' short-test.log > /dev/null) ; then \
-	(echo 'Short test failed!' ; exit 1) ; else \
-	echo 'Short test passed.' ; fi
-
-# The following target is primarily for developers to be able to check
-# well-formedness of the ACL2 world after including each book.
-# WARNING: Be sure to run "make regression" first!
-# The explicit make of top-with-meta.cert is there in order to avoid
-# removing that file after the .bkchk.out file is made (which
-# otherwise happens, somehow!).
-
-.PHONY: chk-include-book-worlds-top
-chk-include-book-worlds-top:
-	@(cd system ; $(MAKE) ; cd ..)
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) chk-include-book-worlds ; \
-	cd ..) ; \
-	fi \
-	done
-	@(cd arithmetic/ ; $(MAKE) -f ../Makefile-generic top-with-meta.cert ; cd ..)
-	@(cd arithmetic/ ; $(MAKE) -f ../Makefile-generic top-with-meta.bkchk.out ; cd ..)
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) chk-include-book-worlds ; \
-	cd ..) ; \
-	fi \
-	done
-
-# The targets below create compiled files for books that may have
-# already been certified in another lisp (.fasl files for all-fasl,
-# etc.).  Of course, the underlying lisp of the ACL2 that is run
-# should agree with the desired compiled file extension.
-# IMPORTANT: In order to use the targets below, you will first need to
-# have certified saving expansion files, e.g. with the following 'make'
-# argument.
-#   ACL2_SAVE_EXPANSION=t
-
-.PHONY: fasl
-fasl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy fasl-aux ; date
-
-.PHONY: fasl-aux
-fasl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) fasl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-fasl
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) fasl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: fas
-fas:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy fas-aux ; date
-
-.PHONY: fas-aux
-fas-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) fas ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-fas
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) fas ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: sparcf
-sparcf:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy sparcf-aux ; date
-
-.PHONY: sparcf-aux
-sparcf-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) sparcf ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-sparcf
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) sparcf ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: ufsl
-ufsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy ufsl-aux ; date
-
-.PHONY: ufsl-aux
-ufsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) ufsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-ufsl
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) ufsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: 64ufasl
-64ufasl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy 64ufasl-aux ; date
-
-.PHONY: 64ufasl-aux
-64ufasl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) 64ufasl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-64ufasl
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) 64ufasl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: x86f
-x86f:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy x86f-aux ; date
-
-.PHONY: x86f-aux
-x86f-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) x86f ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-x86f
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) x86f ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: o
-o:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy o-aux ; date
-
-.PHONY: o-aux
-o-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) o ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-o
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) o ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: dfsl
-dfsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy dfsl-aux ; date
-
-.PHONY: dfsl-aux
-dfsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) dfsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-dfsl
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) dfsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: d64fsl
-d64fsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy d64fsl-aux ; date
-
-.PHONY: d64fsl-aux
-d64fsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) d64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-d64fsl
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) d64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: dx64fsl
-dx64fsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy dx64fsl-aux ; date
-
-.PHONY: dx64fsl-aux
-dx64fsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) dx64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-dx64fsl
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) dx64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: lx64fsl
-lx64fsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy lx64fsl-aux ; date
-
-.PHONY: lx64fsl-aux
-lx64fsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) lx64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-lx64fsl
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) lx64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: lx32fsl
-lx32fsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy lx32fsl-aux ; date
-
-.PHONY: lx32fsl-aux
-lx32fsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) lx32fsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-lx32fsl
-	@for dir in $(DIRS2_EXCEPT_WK) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) lx32fsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-fasl
-all-fasl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-fasl-aux ; date
-
-.PHONY: all-fasl-aux
-all-fasl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) fasl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-fasl
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) fasl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-fas
-all-fas:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-fas-aux ; date
-
-.PHONY: all-fas-aux
-all-fas-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) fas ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-fas
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) fas ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-sparcf
-all-sparcf:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-sparcf-aux ; date
-
-.PHONY: all-sparcf-aux
-all-sparcf-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) sparcf ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-sparcf
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) sparcf ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-ufsl
-all-ufsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-ufsl-aux ; date
-
-.PHONY: all-ufsl-aux
-all-ufsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) ufsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-ufsl
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) ufsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-64ufasl
-all-64ufasl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-64ufasl-aux ; date
-
-.PHONY: all-64ufasl-aux
-all-64ufasl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) 64ufasl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-64ufasl
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) 64ufasl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-x86f
-all-x86f:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-x86f-aux ; date
-
-.PHONY: all-x86f-aux
-all-x86f-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) x86f ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-x86f
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) x86f ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-dfsl
-all-dfsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-dfsl-aux ; date
-
-.PHONY: all-dfsl-aux
-all-dfsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) dfsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-dfsl
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) dfsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-d64fsl
-all-d64fsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-d64fsl-aux ; date
-
-.PHONY: all-d64fsl-aux
-all-d64fsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) d64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-d64fsl
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) d64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-dx64fsl
-all-dx64fsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-dx64fsl-aux ; date
-
-.PHONY: all-dx64fsl-aux
-all-dx64fsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) dx64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-dx64fsl
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) dx64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-lx64fsl
-all-lx64fsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-lx64fsl-aux ; date
-
-.PHONY: all-lx64fsl-aux
-all-lx64fsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) lx64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-lx64fsl
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) lx64fsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-lx32fsl
-all-lx32fsl:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-lx32fsl-aux ; date
-
-.PHONY: all-lx32fsl-aux
-all-lx32fsl-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) lx32fsl ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-lx32fsl
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) lx32fsl ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: all-o
-all-o:
-	@date ; $(TIME) $(MAKE) -f Makefile.legacy all-o-aux ; date
-
-.PHONY: all-o-aux
-all-o-aux:
-	@for dir in $(DIRS1) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) o ; \
-	cd ..) ; \
-	fi \
-	done
-	@$(MAKE) -f Makefile.legacy top-with-meta-o
-	@for dir in $(DIRS2) ; \
-	do \
-	if [ -f $$dir/Makefile ]; then \
-	(cd $$dir ; \
-	$(MAKE) o ; \
-	cd ..) ; \
-	fi \
-	done
-
-.PHONY: top-with-meta-cert
-top-with-meta-cert: $(DIRS1)
-	@echo "Using ACL2=$(ACL2)"
-	cd arithmetic ; $(MAKE) top-with-meta.cert
-
-.PHONY: top-with-meta-o
-top-with-meta-o:
-	cd arithmetic ; $(MAKE) top-with-meta.o
-
-.PHONY: top-with-meta-fasl
-top-with-meta-fasl:
-	cd arithmetic ; $(MAKE) top-with-meta.fasl
-
-.PHONY: top-with-meta-fas
-top-with-meta-fas:
-	cd arithmetic ; $(MAKE) top-with-meta.fas
-
-.PHONY: top-with-meta-sparcf
-top-with-meta-sparcf:
-	cd arithmetic ; $(MAKE) top-with-meta.sparcf
-
-.PHONY: top-with-meta-ufsl
-top-with-meta-ufsl:
-	cd arithmetic ; $(MAKE) top-with-meta.ufsl
-
-.PHONY: top-with-meta-64ufasl
-top-with-meta-64ufasl:
-	cd arithmetic ; $(MAKE) top-with-meta.64ufasl
-
-.PHONY: top-with-meta-x86f
-top-with-meta-x86f:
-	cd arithmetic ; $(MAKE) top-with-meta.x86f
-
-.PHONY: top-with-meta-dfsl
-top-with-meta-dfsl:
-	cd arithmetic ; $(MAKE) top-with-meta.dfsl
-
-.PHONY: top-with-meta-d64fsl
-top-with-meta-d64fsl:
-	cd arithmetic ; $(MAKE) top-with-meta.d64fsl
-
-.PHONY: top-with-meta-dx64fsl
-top-with-meta-dx64fsl:
-	cd arithmetic ; $(MAKE) top-with-meta.dx64fsl
-
-.PHONY: top-with-meta-lx64fsl
-top-with-meta-lx64fsl:
-	cd arithmetic ; $(MAKE) top-with-meta.lx64fsl
-
-.PHONY: top-with-meta-lx32fsl
-top-with-meta-lx32fsl:
-	cd arithmetic ; $(MAKE) top-with-meta.lx32fsl
diff -Nru acl2-6.2/books/README acl2-6.3/books/README
--- acl2-6.2/books/README	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/README	2013-09-30 17:53:32.000000000 +0000
@@ -1 +1,2 @@
 Please point your browser at Readme.html in this directory.
+
diff -Nru acl2-6.2/books/README-svn acl2-6.3/books/README-svn
--- acl2-6.2/books/README-svn	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/README-svn	2013-09-30 17:53:32.000000000 +0000
@@ -91,9 +91,9 @@
 
 To create a branch from the trunk:
 
-svn copy -m 'Make initial release branch for Version 6.2.' \
+svn copy -m 'Make initial release branch for Version 6.3.' \
         https://acl2-books.googlecode.com/svn/trunk \
-        https://acl2-books.googlecode.com/svn/branches/6.2
+        https://acl2-books.googlecode.com/svn/branches/6.3
 
 To create a tag is the same operation (note from Matt K.: Not sure we
 ever need to create a tag); the only difference is the convention that
@@ -101,35 +101,35 @@
 directories under tags are treated as write-once "markers" for a
 certain revision.
 
-svn copy -m 'Release branch corresponding to actual ACL2 6.2 release.' \
-        https://acl2-books.googlecode.com/svn/branches/6.2 \
-        https://acl2-books.googlecode.com/svn/tags/6.2
+svn copy -m 'Release branch corresponding to actual ACL2 6.3 release.' \
+        https://acl2-books.googlecode.com/svn/branches/6.3 \
+        https://acl2-books.googlecode.com/svn/tags/6.3
 
 If ever you want to make a branch/tag from a specific revision (i.e.
 not the latest), you can do something like (note the @660):
 
-svn copy  -m 'Release branch corresponding to actual ACL2 6.2 release.' \
-        https://acl2-books.googlecode.com/svn/branches/6.2@660 \
-        https://acl2-books.googlecode.com/svn/tags/6.2
+svn copy  -m 'Release branch corresponding to actual ACL2 6.3 release.' \
+        https://acl2-books.googlecode.com/svn/branches/6.3@660 \
+        https://acl2-books.googlecode.com/svn/tags/6.3
 
 
 For an ACL2 developer, the next step is to remember the current
 version number for the books -- below, we assume it is 663.
 
 cd /projects/acl2/devel/books/
-svn switch https://acl2-books.googlecode.com/svn/branches/6.2
+svn switch https://acl2-books.googlecode.com/svn/branches/6.3
 
 Now switch back to the trunk AFTER the release is complete,
 substituting "663" below by the number saved above (where "663" is
 mentioned):
 
 cd /projects/acl2/devel/books/
-# While still in 6.2:
-svn commit -m "Updates made for release committed to 6.2 branch"
+# While still in 6.3:
+svn commit -m "Updates made for release committed to 6.3 branch"
 # Now switch over to trunk
 svn switch https://acl2-books.googlecode.com/svn/trunk
 svn update
-svn merge -r 663:HEAD https://acl2-books.googlecode.com/svn/branches/6.2 .
+svn merge -r 663:HEAD https://acl2-books.googlecode.com/svn/branches/6.3 .
 svn commit -m "Updates made for release committed to trunk"
 
 Then resolve any conflicts.
@@ -161,9 +161,9 @@
   working copy directory, run the following command, with appropriately
   chosen revision numbers:
 
-  svn merge -r 663:HEAD https://acl2-books.googlecode.com/svn/branches/6.2 .
+  svn merge -r 663:HEAD https://acl2-books.googlecode.com/svn/branches/6.3 .
 
-  This takes the diff between revisions 663 and HEAD of the 6.2 branch
+  This takes the diff between revisions 663 and HEAD of the 6.3 branch
   and applies it to your current working copy (no change is committed to
   the repository yet.)  Again, it will notify you of conflicts if it
   encounters any.  Note to ACL2 developers: Resolve those, if any, and
@@ -174,6 +174,6 @@
 Note that if desired, you can check out a working copy of the branch
 in the usual way:
 
-svn checkout https://acl2-books.googlecode.com/svn/branches/6.2 my-new-books-dir
+svn checkout https://acl2-books.googlecode.com/svn/branches/6.3 my-new-books-dir
 
 ============================================================
diff -Nru acl2-6.2/books/Readme.html acl2-6.3/books/Readme.html
--- acl2-6.2/books/Readme.html	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/Readme.html	2013-09-30 17:53:32.000000000 +0000
@@ -57,6 +57,7 @@
 <A HREF="arithmetic-3">arithmetic-3</A>.</LI>
 <LI><A HREF="bdd">bdd</A>: books that exercise ACL2's BDD mechanism.
 </LI>
+<LI><A HREF="ccg">ccg</A>: automated termination analyisis.</LI>
 <LI><A HREF="centaur">centaur</A>: books contributed by Centaur formal
   verification folks;
   see <CODE><A HREF="centaur/README">centaur/README</A></CODE>
@@ -65,6 +66,7 @@
 certify the <CODE>cowles</CODE> and <CODE>arithmetic</CODE> books when
 not using make, e.g., for example, when using a Macintosh.
 </LI>
+<LI><A HREF="cgen">cgen</A>: support for counterexample generation</LI>
 <LI><A HREF="clause-processors">clause-processors</A>: examples of the use of
 clause processors (e.g., external tools)</LI>
 <LI><A HREF="coi">coi</A>:  The coi books comprise a "shelf" of ACL2
@@ -73,7 +75,6 @@
 </LI>
 <LI><A HREF="concurrent-programs">concurrent-programs</A>: contributions by
 Sandip Ray (see </code>Readme.lsp</code> files in subdirectories)</LI>
-<LI><A HREF="countereg-gen">countereg-gen</A>: support for counterexample generation</LI>
 <LI><A HREF="cowles">cowles</A>: support for arithmetic books</LI>
 <LI><A HREF="cutil">cutil</A>: Centaur Basic Utilities
 <LI><A HREF="data-structures">data-structures</A>: books for common data
@@ -89,10 +90,6 @@
 trust tags to modify or extend core ACL2 behavior</LI>
 <LI><A HREF="hints">hints</A>: tests of hints, especially <code>:or</code> and
 <code>:custom</code> hints</LI>
-<LI><A HREF="hons-archive">hons-archive</A>: Implements Hons Archives
-(HARs), which are a way to write ACL2 objects to disk so they can be
-loaded in other ACL2 sessions.
-</LI>
 <LI><A HREF="ihs">ihs</A>: ``integer hardware specification'', integer
 arithmetic appropriate for hardware modeling</LI>
 <LI><A HREF="interface">interface</A>: utilities providing Emacs support for
@@ -102,6 +99,8 @@
 <code>make-event</code>, which implements the idea of macros that can take state</LI>
 <LI><A HREF="memoize">memoize</A>: a descendant of the memoization scheme developed by Bob Boyer and Warren A. Hunt, Jr., which was incorporated into ACL2(h)</LI>
 <LI><A HREF="meta">meta</A>: metafunctions for arithmetic</LI>
+<LI><A HREF="milawa">milawa</A>:  a "self-verifying" theorem prover for an ACL2-like logic, developed
+by Jared Davis for his Ph.D. dissertation.</LI>
 <LI><A HREF="misc">misc</A>:  a grab-bag of useful books and
 utilities</LI>
 <LI><A HREF="models">models</A>:  models, especially of digital systems, with associated proofs</LI>
@@ -117,6 +116,7 @@
 pedagogical use.</LI>
 <LI><A HREF="parallel">parallel</A>: example use of primitives for
   parallelism (with speed-up only in experimental extension that supports parallel evaluation)</LI>
+<LI><A HREF="parsers">parsers</A>: parsers</LI>
 <LI><A HREF="powerlists">powerlists</A>: a data-structure suited to the analysis of recursive,
 data-parallel algorithms.</LI>
 <LI><A HREF="proofstyles">proofstyles</A>: Soundness and completeness of
@@ -149,6 +149,7 @@
 HREF="http://www.cs.utexas.edu/users/moore/publications/acl2-books/car/index.html">Computer-Aided
 Reasoning: An Approach</A></I></LI>
 <LI><A HREF="tools">tools</A>: macros and tools designed to make common constructs easier and less verbose to write</LI>
+<LI><A HREF="translators">translators</A>: translators to and from ACL2</LI>
 <LI><A HREF="tutorial-problems">tutorial-problems</A>: solutions to
 exercises of a tutorial nature</LI>
 <LI><A HREF="unicode">unicode</A>: help for reading input from files</LI>
@@ -189,24 +190,14 @@
 
 <H2><A NAME="CertificationInstructions">Certification Instructions</A></H2>
 
-The instructions below assume that you are standing in subdirectory
-<CODE>books</CODE> of the ACL2 distribution.
+Instructions for certifying the ACL2 community books may be found in
+the folllowing ACL2 documentation topic: <a href="http://www.cs.utexas.edu/users/moore/acl2/current/BOOKS-CERTIFICATION.html">BOOKS-CERTIFICATION</a>.
 
-<P>
+<p>
 
-To certify the ACL2 community books, execute a command such as one of
-the following.  In the first case, we assume that if environment
-variable named "<code>ACL2</code>" is defined then it specifies your
-ACL2 executable, and otherwise the command "<code>acl2</code>" invokes
-your ACL2 executable.  In the second and third cases, we define such
-an environment variable on the command line, where in the second case
-we assume that <code>my_acl2</code> is on your path.
-<PRE>
-make
-make ACL2=my_acl2
-make ACL2=/u/smith/bin/my_acl2
-</PRE>
-To certify more books,
+If you obtained your books from a gzipped tarfile (typically
+named <code>books-*.tar.gz</code>), as opposed to svn, then you don't
+yet have the workshops books.  If you want them, simply
 <a href="http://code.google.com/p/acl2-books/downloads/">download
 workshops.tar.gz</a> to your acl2-sources/books/ directory</a>, and
 then gunzip and extract it there.
diff -Nru acl2-6.2/books/april-fools.txt acl2-6.3/books/april-fools.txt
--- acl2-6.2/books/april-fools.txt	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/april-fools.txt	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-5
diff -Nru acl2-6.2/books/arithmetic/nat-listp.lisp acl2-6.3/books/arithmetic/nat-listp.lisp
--- acl2-6.2/books/arithmetic/nat-listp.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic/nat-listp.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -20,51 +20,55 @@
 ;; symbol-listp, etc, in that it implies true-listp.
 
 (in-package "ACL2")
+(include-book "xdoc/top" :dir :system)
 
+(in-theory (disable nat-listp))
 
-(defund nat-listp (l)
-  (declare (xargs :guard t))
-  (cond ((atom l)
-         (eq l nil))
-        (t (and (natp (car l))
-                (nat-listp (cdr l))))))
-
-(local (in-theory (enable nat-listp)))
-
-(defthm nat-listp-implies-true-listp
-  (implies (nat-listp x)
-           (true-listp x))
-  :rule-classes (:rewrite :compound-recognizer))
-
-(in-theory (disable (:rewrite nat-listp-implies-true-listp)))
-
-(defthm nat-listp-when-not-consp
-  (implies (not (consp x))
-           (equal (nat-listp x)
-                  (not x)))
-  :hints(("Goal" :in-theory (enable nat-listp))))
-
-(defthm nat-listp-of-cons
-  (equal (nat-listp (cons a x))
-         (and (natp a)
-              (nat-listp x)))
-  :hints(("Goal" :in-theory (enable nat-listp))))
-
-(defthm nat-listp-of-append-weak
-  ;; [Jared] added "weak" in support of std/typed-lists/nat-listp
-  (implies (true-listp x)
-           (equal (nat-listp (append x y))
-                  (and (nat-listp x)
-                       (nat-listp y)))))
-
-(defthm car-nat-listp
-  (implies (and (nat-listp x)
-                x)
-           (natp (car x)))
-  :rule-classes :forward-chaining)
-
-(defthm nat-listp-of-cdr-when-nat-listp
-  ;; [Jared] added double-rewrite in support of std/typed-lists/nat-listp
-  (implies (nat-listp (double-rewrite x))
-           (equal (nat-listp (cdr x))
-                  t)))
+(defsection arithmetic/nat-listp
+  :parents (nat-listp)
+  :short "Lemmas about @(see nat-listp) available in the @('arithmetic/nat-listp')
+book."
+
+  :long "<p>BOZO additional lemmas about @('nat-listp') are available in the
+book @(see std/typed-list/nat-listp), which subsumes this one.  Should we get
+rid of this book?</p>"
+
+  (local (in-theory (enable nat-listp)))
+
+  (defthm nat-listp-implies-true-listp
+    (implies (nat-listp x)
+             (true-listp x))
+    :rule-classes (:rewrite :compound-recognizer))
+
+  (in-theory (disable (:rewrite nat-listp-implies-true-listp)))
+
+  (defthm nat-listp-when-not-consp
+    (implies (not (consp x))
+             (equal (nat-listp x)
+                    (not x)))
+    :hints(("Goal" :in-theory (enable nat-listp))))
+
+  (defthm nat-listp-of-cons
+    (equal (nat-listp (cons a x))
+           (and (natp a)
+                (nat-listp x)))
+    :hints(("Goal" :in-theory (enable nat-listp))))
+
+  (defthm nat-listp-of-append-weak
+    ;; [Jared] added "weak" in support of std/typed-lists/nat-listp
+    (implies (true-listp x)
+             (equal (nat-listp (append x y))
+                    (and (nat-listp x)
+                         (nat-listp y)))))
+
+  (defthm car-nat-listp
+    (implies (and (nat-listp x)
+                  x)
+             (natp (car x)))
+    :rule-classes :forward-chaining)
+
+  (defthm nat-listp-of-cdr-when-nat-listp
+    ;; [Jared] added double-rewrite in support of std/typed-lists/nat-listp
+    (implies (nat-listp (double-rewrite x))
+             (equal (nat-listp (cdr x))
+                    t))))
diff -Nru acl2-6.2/books/arithmetic-3/bind-free/collect.lisp acl2-6.3/books/arithmetic-3/bind-free/collect.lisp
--- acl2-6.2/books/arithmetic-3/bind-free/collect.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-3/bind-free/collect.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -320,12 +320,24 @@
                           (t
                            (- (expt x (- m n))))))))
 
-(defthm |(* (expt c n) (expt d n))|
-    (implies (and (integerp n)
-                  (syntaxp (quotep c))
-                  (syntaxp (quotep d)))
-             (equal (collect-* (expt c n) (expt d n))
-                    (expt (* c d) n))))
+
+
+;; [Jared]: removing this rule:
+;;
+;; (defthm |(* (expt c n) (expt d n))|
+;;     (implies (and (integerp n)
+;;                   (syntaxp (quotep c))
+;;                   (syntaxp (quotep d)))
+;;              (equal (collect-* (expt c n) (expt d n))
+;;                     (expt (* c d) n))))
+;;
+;; Because above we have the same thing without syntaxp hyps, except with
+;; slightly different names:
+;;  
+;; (defthm |(* (expt x n) (expt y n))|
+;;   (implies (integerp n)
+;;            (equal (collect-* (expt x n) (expt y n))
+;;                   (expt (* x y) n))))
 
 (defthm |(collect-* y x)|
     (equal (collect-* y x)
diff -Nru acl2-6.2/books/arithmetic-3/bind-free/normalize.lisp acl2-6.3/books/arithmetic-3/bind-free/normalize.lisp
--- acl2-6.2/books/arithmetic-3/bind-free/normalize.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-3/bind-free/normalize.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -186,37 +186,43 @@
         (t
          nil)))
 
-(defthm test381
-  (implies (and (true-list-listp x)
-                (true-list-listp y))
-           (true-list-listp (revappend x y))))
-
-(defthm test382
-  (implies (true-listp x)
-           (true-listp (append a x))))
-
-(defthm test392
-  (implies (and (pseudo-termp denominator)
-                (true-listp factors)
-                (true-list-listp to-be-found))
-           (true-list-listp (to-be-found denominator 
-                                         saved-denominator 
-                                         factors
-                                         to-be-found))))
-
-(defthm test-302
-  (implies (and (not (equal (car denominator) 'quote))
-                (consp denominator)
-                (pseudo-termp denominator))
-           (pseudo-termp (cadr denominator)))
-  :hints (("goal" :expand (pseudo-termp denominator))))
-
-(defthm test-303
-  (implies (and (not (equal (car denominator) 'quote))
-                (consp denominator)
-                (pseudo-termp denominator))
-           (pseudo-termp (caddr denominator)))
-  :hints (("goal" :expand (pseudo-termp denominator))))
+
+;; [Jared]  localizing since this seems like it should be local
+(local (defthm test381
+         (implies (and (true-list-listp x)
+                       (true-list-listp y))
+                  (true-list-listp (revappend x y)))))
+
+;; [Jared]  localizing since this seems like it should be local
+(local (defthm test382
+         (implies (true-listp x)
+                  (true-listp (append a x)))))
+
+;; [Jared]  localizing since this seems like it should be local
+(local (defthm test392
+         (implies (and (pseudo-termp denominator)
+                       (true-listp factors)
+                       (true-list-listp to-be-found))
+                  (true-list-listp (to-be-found denominator 
+                                                saved-denominator 
+                                                factors
+                                                to-be-found)))))
+
+;; [Jared]  localizing since this seems like it should be local
+(local (defthm test-302
+         (implies (and (not (equal (car denominator) 'quote))
+                       (consp denominator)
+                       (pseudo-termp denominator))
+                  (pseudo-termp (cadr denominator)))
+         :hints (("goal" :expand (pseudo-termp denominator)))))
+
+;; [Jared]  localizing since this seems like it should be local
+(local (defthm test-303
+         (implies (and (not (equal (car denominator) 'quote))
+                       (consp denominator)
+                       (pseudo-termp denominator))
+                  (pseudo-termp (caddr denominator)))
+         :hints (("goal" :expand (pseudo-termp denominator)))))
 
 (defun denominatorp (denominator)
   (declare (xargs :guard t))
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/arithmetic-theory.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/arithmetic-theory.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/arithmetic-theory.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/arithmetic-theory.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/banner.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/banner.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/banner.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/banner.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/basic.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/basic.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/basic.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/basic.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/building-blocks-helper.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/building-blocks-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/building-blocks-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/building-blocks-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/building-blocks.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/building-blocks.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/building-blocks.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/building-blocks.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/collect.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/collect.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/collect.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/collect.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/common.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/common.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/common.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/common.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/default-hint.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/default-hint.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/default-hint.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/default-hint.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/distributivity.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/distributivity.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/distributivity.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/distributivity.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/dynamic-e-d.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/dynamic-e-d.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/dynamic-e-d.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/dynamic-e-d.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/elim-hint.acl2 acl2-6.3/books/arithmetic-5/lib/basic-ops/elim-hint.acl2
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/elim-hint.acl2	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/elim-hint.acl2	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 (in-package "ACL2")
 ; cert-flags: ? t :ttags (the-ultimate-clause-processor-ttag)
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/elim-hint.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/elim-hint.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/elim-hint.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/elim-hint.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/expt-helper.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/expt-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/expt-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/expt-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/expt.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/expt.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/expt.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/expt.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/forcing-types.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/forcing-types.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/forcing-types.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/forcing-types.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/if-normalization.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/if-normalization.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/if-normalization.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/if-normalization.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/integerp-helper.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/integerp-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/integerp-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/integerp-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/integerp-meta.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/integerp-meta.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/integerp-meta.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/integerp-meta.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/integerp.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/integerp.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/integerp.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/integerp.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/mini-theories.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/mini-theories.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/mini-theories.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/mini-theories.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/natp-posp.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/natp-posp.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/natp-posp.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/natp-posp.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/normalize.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/normalize.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/normalize.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/normalize.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/numerator-and-denominator.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/numerator-and-denominator.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/numerator-and-denominator.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/numerator-and-denominator.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/remove-weak-inequalities.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/remove-weak-inequalities.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/remove-weak-inequalities.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/remove-weak-inequalities.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/simplify-helper.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/simplify-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/simplify-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/simplify-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/simplify.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/simplify.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/simplify.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/simplify.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/top.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/top.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/top.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/top.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/types-helper.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/types-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/types-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/types-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/types.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/types.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/types.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/types.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/basic-ops/we-are-here.lisp acl2-6.3/books/arithmetic-5/lib/basic-ops/we-are-here.lisp
--- acl2-6.2/books/arithmetic-5/lib/basic-ops/we-are-here.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/basic-ops/we-are-here.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/floor-mod-basic-helper.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/floor-mod-basic-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/floor-mod-basic-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/floor-mod-basic-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/floor-mod-basic.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/floor-mod-basic.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/floor-mod-basic.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/floor-mod-basic.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/floor-mod-helper.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/floor-mod-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/floor-mod-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/floor-mod-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/floor-mod.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/floor-mod.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/floor-mod.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/floor-mod.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/forcing-types.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/forcing-types.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/forcing-types.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/forcing-types.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/if-normalization.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/if-normalization.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/if-normalization.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/if-normalization.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/logand-helper.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/logand-helper.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/logand-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/logand-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/logand.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/logand.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/logand.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/logand.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/mod-expt-fast.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/mod-expt-fast.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/mod-expt-fast.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/mod-expt-fast.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/more-floor-mod.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/more-floor-mod.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/more-floor-mod.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/more-floor-mod.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/top.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/top.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/top.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/top.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/lib/floor-mod/truncate-rem.lisp acl2-6.3/books/arithmetic-5/lib/floor-mod/truncate-rem.lisp
--- acl2-6.2/books/arithmetic-5/lib/floor-mod/truncate-rem.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/lib/floor-mod/truncate-rem.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/arithmetic-5/support/basic-arithmetic-helper.lisp acl2-6.3/books/arithmetic-5/support/basic-arithmetic-helper.lisp
--- acl2-6.2/books/arithmetic-5/support/basic-arithmetic-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/basic-arithmetic-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; basic-arithmetic-helper.lisp
@@ -21,6 +9,9 @@
 
 ;; RK 3/15/99 The following is copied from the books of Cowles
 ;; and adapted to the needs at hand.
+;; (Note from Matt Kaufmann: While this appears to be fair use,
+;; John Cowles has granted explicit permission for this in an
+;; email to me on 8/5/2013.)
 
 (in-package "ACL2")
 
diff -Nru acl2-6.2/books/arithmetic-5/support/basic-arithmetic.lisp acl2-6.3/books/arithmetic-5/support/basic-arithmetic.lisp
--- acl2-6.2/books/arithmetic-5/support/basic-arithmetic.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/basic-arithmetic.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; basic-arithmetic.lisp
diff -Nru acl2-6.2/books/arithmetic-5/support/expt-helper.lisp acl2-6.3/books/arithmetic-5/support/expt-helper.lisp
--- acl2-6.2/books/arithmetic-5/support/expt-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/expt-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; expt-helper.lisp
diff -Nru acl2-6.2/books/arithmetic-5/support/expt.lisp acl2-6.3/books/arithmetic-5/support/expt.lisp
--- acl2-6.2/books/arithmetic-5/support/expt.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/expt.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; expt.lisp
@@ -32,6 +20,9 @@
 
 ; Much of this is adapted from John Cowles's acl2-exp.lisp book.
 ; There are various modifications, however.
+; (Note from Matt Kaufmann: While this appears to be fair use,
+; John Cowles has granted explicit permission for this in an
+; email to me on 8/5/2013.)
 
 (defthm expt-type-prescription-rationalp
   (implies (real/rationalp r)
diff -Nru acl2-6.2/books/arithmetic-5/support/inequalities.lisp acl2-6.3/books/arithmetic-5/support/inequalities.lisp
--- acl2-6.2/books/arithmetic-5/support/inequalities.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/inequalities.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,20 +1,7 @@
-
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; inequalities.lisp
diff -Nru acl2-6.2/books/arithmetic-5/support/mini-theories.lisp acl2-6.3/books/arithmetic-5/support/mini-theories.lisp
--- acl2-6.2/books/arithmetic-5/support/mini-theories.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/mini-theories.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; mini-theories.lisp
diff -Nru acl2-6.2/books/arithmetic-5/support/non-linear.lisp acl2-6.3/books/arithmetic-5/support/non-linear.lisp
--- acl2-6.2/books/arithmetic-5/support/non-linear.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/non-linear.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
diff -Nru acl2-6.2/books/arithmetic-5/support/num-and-denom-helper.lisp acl2-6.3/books/arithmetic-5/support/num-and-denom-helper.lisp
--- acl2-6.2/books/arithmetic-5/support/num-and-denom-helper.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/num-and-denom-helper.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,13 @@
-; ACL2 Arithmetic Nonnegative Integer Mod and Gcd book.
-; Copyright (C) 1998  John R. Cowles, University of Wyoming
+; Arithmetic-5 Library, Robert Krug
+; This file Copyright (C) 1998  John R. Cowles, University of Wyoming
+; License:
+; As described in the LICENSE file at the top level of the arithmetic-5
+; library.
+; (Note from Matt Kaufmann:
+; John Cowles has granted explicit permission for this license in an
+; email to me on 8/5/2013.)
 
-; This book is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation; either version 2 of the License, or
-; (at your option) any later version.
-
-; This book is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this book; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+; ACL2 Arithmetic Nonnegative Integer Mod and Gcd book.
 
 ; Written by:
 ; John Cowles
diff -Nru acl2-6.2/books/arithmetic-5/support/numerator-and-denominator.lisp acl2-6.3/books/arithmetic-5/support/numerator-and-denominator.lisp
--- acl2-6.2/books/arithmetic-5/support/numerator-and-denominator.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/numerator-and-denominator.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; numerator-and-denominator.lisp
diff -Nru acl2-6.2/books/arithmetic-5/support/prefer-times.lisp acl2-6.3/books/arithmetic-5/support/prefer-times.lisp
--- acl2-6.2/books/arithmetic-5/support/prefer-times.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/prefer-times.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; prefer-times.lisp
diff -Nru acl2-6.2/books/arithmetic-5/support/top.lisp acl2-6.3/books/arithmetic-5/support/top.lisp
--- acl2-6.2/books/arithmetic-5/support/top.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/support/top.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;
 ;; top.lisp
diff -Nru acl2-6.2/books/arithmetic-5/top.lisp acl2-6.3/books/arithmetic-5/top.lisp
--- acl2-6.2/books/arithmetic-5/top.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/arithmetic-5/top.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,7 @@
 ; Arithmetic-5 Library
-; Copyright (C) 2009 Robert Krug <rkrug@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.
-;
-; This program is distributed in the hope that it will be useful but WITHOUT
-; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
-; details.
-;
-; You should have received a copy of the GNU General Public License along with
-; this program; if not, write to the Free Software Foundation, Inc., 51
-; Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+; Written by Robert Krug
+; Copyright/License:
+; See the LICENSE file at the top level of the arithmetic-5 library.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
diff -Nru acl2-6.2/books/ccg/Makefile acl2-6.3/books/ccg/Makefile
--- acl2-6.2/books/ccg/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/ccg/Makefile	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,2 @@
+include ../Makefile-generic
+-include Makefile-deps
diff -Nru acl2-6.2/books/ccg/README acl2-6.3/books/ccg/README
--- acl2-6.2/books/ccg/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/ccg/README	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,16 @@
+Book: CCG - Automated termination analysis
+Author: Daron Vroon
+
+To certify the books use the standard procedure i.e. make
+or use ../cert.pl ccg.cert ccg-settings-dependencies.cert
+
+To get CCG to do termination proofs, use the following two commands.
+
+(include-book "ccg" :ttags ((:ccg)) :load-compiled-file nil)
+(ld "ccg-settings.lsp")
+
+Documentation - :doc ccg 
+
+See Readme.lsp for licensing and other information.
+
+
diff -Nru acl2-6.2/books/ccg/Readme.lsp acl2-6.3/books/ccg/Readme.lsp
--- acl2-6.2/books/ccg/Readme.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/ccg/Readme.lsp	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,53 @@
+((:FILES "
+.:
+ccg.lisp
+"
+)
+ (:TITLE    "CCG Termination Analysis")
+ (:AUTHOR/S "Daron Vroon and Pete Manolios")
+ (:KEYWORDS ; non-empty list of keywords, case-insensitive
+   "book contributions" "contributed books"
+   "termination" "termination analysis"
+   "automated termination proofs"
+   )
+ (:ABSTRACT
+"Automated termination analysis based on Calling Context Graphs,
+developed as part of ACL2 Sedan. 
+
+To use this book, use the event form shown at the bottom.
+CCG is configured by calling set-termination-method with a single
+parameter, which must be one of these:
+
+    :ccg - CCG analysis only (no measure-based proof attempt)
+    :measure - no CCG analysis (measure-based proofs only) 
+
+Regardless of this or other settings, ACL2's built-in method will be
+used if an explicit measure is specified.
+
+Of course, any termination analysis is necessarily incomplete and
+eventually users may come across terminating functions that CCG
+analysis cannot prove terminating. When that happens, CCG analysis
+will construct a function that is as simple as possible, includes a
+subset of the looping behavior of the submitted function, and which
+CCG analysis cannot prove terminating. This function, along with
+several suggestions of how to help CCG analysis prove termination,
+will be presented to the user.
+
+Our CCG termination analysis is highly customizable and includes many
+features not mentioned here. For detailed documentation please refer
+to :doc ccg from inside a session.
+
+")
+ (:PERMISSION ; author/s permission for distribution and copying:
+"Copyright (C) 2010 Daron Vroon, Pete Manolios.
+License: A 3-clause BSD license.  
+See the LICENSE file distributed with ACL2.
+"))
+
+#|
+(duplicated here from README)
+To enable CCG termination analysis:
+(include-book "ccg"  :ttags ((:ccg)) :load-compiled-file nil)
+(ld "ccg-settings.lsp")
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/ccg/ccg-settings-dependencies.lisp acl2-6.3/books/ccg/ccg-settings-dependencies.lisp
--- acl2-6.2/books/ccg/ccg-settings-dependencies.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/ccg/ccg-settings-dependencies.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,7 @@
+
+(in-package "ACL2")
+
+(include-book "ordinals/lexicographic-ordering-without-arithmetic" :dir :system)
+
+
+
diff -Nru acl2-6.2/books/ccg/ccg-settings.lsp acl2-6.3/books/ccg/ccg-settings.lsp
--- acl2-6.2/books/ccg/ccg-settings.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/ccg/ccg-settings.lsp	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,26 @@
+
+
+;; Common events (found in ACL2s session modes)
+(include-book "ordinals/lexicographic-ordering-without-arithmetic" :dir :system)
+(set-well-founded-relation l<)
+(make-event ; use ruler-extenders if available
+ (if (member-eq 'ruler-extenders-lst
+                (getprop 'put-induction-info 'formals nil
+                         'current-acl2-world (w state)))
+     (value '(set-ruler-extenders :all))
+   (value '(value-triple :invisible))))
+
+
+;; CCG settings
+
+; dont be too verbose
+ (set-ccg-print-proofs nil)     
+ (set-ccg-inhibit-output-lst
+  '(QUERY BASICS PERFORMANCE BUILD/REFINE SIZE-CHANGE))
+;remove any time limit on ccg termination proofs
+ (set-ccg-time-limit nil)
+
+
+
+; Use CCG to do termination proofs.
+(set-termination-method :ccg)
diff -Nru acl2-6.2/books/ccg/ccg.acl2 acl2-6.3/books/ccg/ccg.acl2
--- acl2-6.2/books/ccg/ccg.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/ccg/ccg.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,24 @@
+; cert-flags: ? nil :ttags (:ccg)
+
+; Here is a low-level explanation of the change by Matt Kaufmann, 8/4/2013, of
+; the third argument of certify-book (below) from t to nil:
+
+; We avoid compiling this book in order to avoid certification errors in some
+; Lisps (in particular, we have seen one in an ACL2(h) regression with
+; Lispworks), and to avoid errors when attempting to include this book in
+; perhaps every Lisp.  It appears that the problem is with the use of
+; defmacro-raw, which calls assert-unbound to cause an error when such a
+; macro's definition is attempted while the macro is already defined.  If you
+; save the expansion file (ccg@expansion.lsp) when attempting to certify this
+; book, using (assign save-expansion-file t), then you'll see that the macro
+; context-fn, defined by defmacro-raw, isn't mentioned in *hcomp-macro-alist*,
+; and hence isn't made undefined after an early load of the compiled file.
+; Indeed, if we look at the definition of defmacro-raw in hacking/raw.lisp,
+; we'll see that while there is some attempt to maintain the undo-stack
+; appropriately, there appears to be nothing that addresses the problem
+; mentioned above of failing to unbind the definition after early load of the
+; compiled file.  I'm not sufficiently familiar with the hacking/ stuff to know
+; how best to fix this, but since trust tags are used, that's the
+; responsibility of whomever is maintaining these books.
+
+(certify-book "ccg" ? nil :ttags (:ccg))
diff -Nru acl2-6.2/books/ccg/ccg.lisp acl2-6.3/books/ccg/ccg.lisp
--- acl2-6.2/books/ccg/ccg.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/ccg/ccg.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,7670 @@
+#|$ACL2s-Preamble$;
+
+(begin-book t :ttags ((:ccg)));$ACL2s-Preamble$|#
+
+(in-package "ACL2")
+
+(defttag :ccg)
+
+; load in the expander book.
+
+(include-book "misc/expander" :dir :system)
+
+
+; load in Peter's hacker stuff.  we use at least three things from this:
+; - add several keys to the acl2-defaults-table
+; - make raw Lisp definitions from an acl2 book, i.e. defstruct-raw,
+;   defmacro-raw, and defun-raw
+; - bridge raw lisp and ACL2 so that we can access the raw Lisp code
+;
+(include-book "hacking/hacker" :dir :system)
+(progn+all-ttags-allowed
+ (include-book "hacking/all" :dir :system :ttags :all))
+(subsume-ttags-since-defttag)
+
+
+(defdoc CCG
+  ":Doc-Section CCG
+   
+   a powerful automated termination prover for ACL2~/~/
+
+   In order to see how the CCG analysis works, consider the following
+   definition of Ackermann's function from exercise 6.15 in the ACL2 textbook:
+   ~bv[]
+   (defun ack (x y)
+      (if (zp x) 
+          1
+        (if (zp y) 
+            (if (equal x 1) 2 (+ x 2))
+          (ack (ack (1- x) y) (1- y))))) 
+    ~ev[] 
+    ACL2 cannot automatically prove the termination of ~c[ack] using its
+    measure-based termination proof. In order to admit the function, the user
+    must supply a measure. An example measure is 
+    ~c[(make-ord 1 (1+ (acl2-count y)) (acl2-count x))], which is equivalent to the ordinal 
+    ~c[w * (1+ (acl2-count y)) + (acl2-count x)], where ~c[w] is the first infinite
+    ordinal.
+
+   The CCG analysis, on the other hand, automatically proves termination as
+   follows. Note that there are two recursive calls. These calls, along with
+   their rulers (i.e. the conditions under which the recursive call is reached)
+   are called ~em[calling contexts], or sometimes just ~em[contexts] (for more
+   on rulers, see ~il[ruler-extenders]). For
+   ~c[ack], these are:
+   ~bv[]
+   1. (ack (1- x) y) with ruler ((not (zp x)) (not (zp y))).
+   2. (ack (ack (1- x) y) (1- y)) with ruler ((not (zp x)) (not (zp y))). 
+   ~ev[]
+   These calling contexts are used to build a ~em[calling context graph (CCG)],
+   from which our analysis derives its name. This graph has an edge from
+   context ~c[c1] to context ~c[c2] when it is possible that execution can move
+   from context ~c[c1] to context ~c[c2] in one ``step'' (i.e. without visiting
+   any other contexts). For our example, we get the complete graph, with edges
+   from each context to both contexts.
+
+   The analysis next attempts to guess ~em[calling context measures (CCMs)], or
+   just ~em[measures], for each function. These are similar to ACL2 measures,
+   in that they are ACL2 terms that must provably be able to evaluate to an
+   ordinal value (unlike ACL2 measures, CCG currently ignores the current
+   well-founded relation setting). However, functions may have multiple CCMs,
+   instead of one, like ACL2, and the CCG analysis has some more sophisticated
+   heuristics for guessing appropriate measures. However, there is a mechanism
+   for supplying measures to the CCG analysis if you need to ~pl[CCG-XARGS]. In
+   our example, the CCG analysis will guess the measures ~c[(acl2-count x)],
+   ~c[(acl2-count y)], and ~c[(+ (acl2-count x) (acl2-count y))]. This last one
+   turns out to be unimportant for the termination proof. However, note that
+   the first two of these measures are components of the ordinal measure that
+   we gave ACL2 to prove termination earlier. As one might guess, these are
+   important for the success of our CCG analysis.
+
+   Like ACL2's measure analysis, we are concerned with what happens to these
+   values when a recursive call is made. However, we are concerned not just
+   with decreasing measures, but also non-increasing measures. Thus, we
+   construct ~em[Calling Context Measure Functions (CCMFs)], which tell us how
+   one measure compares to another across recursive calls.
+
+   In our example, note that when the recursive call of the context 1 is made,
+   the new value of ~c[(acl2-count x)] is less than the original value of
+   ~c[(acl2-count x)]. More formally, we can prove the following:
+   ~bv[]
+   (implies (and (not (zp x))
+                 (not (zp y)))
+            (o< (acl2-count (1- x))
+                (acl2-count x)))
+   ~ev[]
+   For those of you that are familiar with measure-based termination proofs in
+   ACL2, this should look familiar, as it has the same structure as such a
+   termination proof. However, we also note the following trivial observation:
+   ~bv[]
+   (implies (and (not (zp x))
+                 (not (zp y)))
+            (o<= (acl2-count y)
+                 (acl2-count y)))
+   ~ev[]
+   That is, ~c[y] stays the same across this recursive call. For the other
+   context, we similarly note that ~c[(acl2-count y)] is decreasing. However,
+   we can say nothing about the value of ~c[(acl2-count x)]. The CCG algorithm
+   does this analysis using queries to the theorem prover that are carefully
+   restricted to limit prover time.
+
+   Finally, the CCG analysis uses this local information to do a global
+   analysis of what happens to values. This analysis asks the question, for
+   every infinite path through our CCG, ~c[c_1], ~c[c_2], ~c[c_3], ..., is
+   there a natural number ~c[N] such that there is an infinite sequence of
+   measures ~c[m_N], ~c[m_(N+1)], ~c[m_(N+2)], ... such that each ~c[m_i] is a
+   measure for the context ~c[c_i] (i.e. a measure for the function containing
+   ~c[ci]), we have proven that the ~c[m_(i+1)] is never larger than ~c[m_i],
+   and for infinitely many ~c[i], it is the case that we have proven that
+   ~c[m_i] is always larger than ~c[m_(i+)]. That's a bit of a mouthful, but
+   what we are essentially saying is that, for every possible infinite sequence
+   of recursions it is the case that after some finite number of steps, we can
+   start picking out measures such that they never increase and infinitely
+   often they decrease. Since these measures return ordinal values, we then
+   know that there can be no infinite recursions, and we are done.
+
+   For our example, consider two kinds of infinite paths through our CCG: those
+   that visit context 2 infinitely often, and those that don't. In the first
+   case, we know that ~c[(acl2-count y)] is never increasing, since a visit to
+   context 1 does not change the value of ~c[y], and a visit to context 2
+   decreases the value of ~c[(acl2-count y)]. Furthermore, since we visit
+   context 2 infinitely often, we know that ~c[(acl2-count y)] is infinitely
+   decreasing along this path. Therefore, we have met the criteria for proving
+   no such path is a valid computation. In the case in which we do not visit
+   context 2 infinitely often, there must be a value ~c[N] such that we do not
+   visit context 2 any more after the ~c[N]th context in the path. After this,
+   we must only visit context 1, which always decreases the value of
+   ~c[(acl2-count x)]. Therefore, no such path can be a valid
+   computation. Since all infinite paths through our CCG either visit context 2
+   infinitely often or not, we have proven termination. This analysis of the
+   local data in the global context is done automatically by a decision
+   procedure.
+
+   That is a brief overview of the CCG analysis. Note that, can it prove many
+   functions terminating that ACL2 cannot. It also does so using simpler
+   measures. In the ~c[ack] example, we did not require any infinite ordinal
+   measures to prove termination using CCG. Intuitively, CCG is in a way
+   putting together the measures for you so you don't have to think about the
+   ordinal structure. Thus, even when the CCG analysis to prove termination, it
+   is often easier to give it multiple simple measures and allow it to put
+   together the global termination argument than to give ACL2 the entire
+   measure so it can prove that it decreases every single step.
+
+   To find out more about interacting and controlling the CCG analysis, see the
+   topics included in this section.")
+
+; BEGIN public configuration interface
+
+; add :termination-method key to acl2-defaults-table
+;
+; add-acl2-defaults-table-key is provided by my hacker stuff. -Peter
+
+(add-acl2-defaults-table-key :termination-method
+                             (member-eq val '(:measure :ccg)))
+
+(defdoc set-termination-method
+  ":Doc-Section CCG
+
+  Set the default means of proving termination.~/
+  ~bv[]
+  Examples:
+  (set-termination-method :ccg)
+  (set-termination-method :measure)
+  ~ev[]
+
+  Introduced by the CCG analysis book, this macro sets the default
+  means by which ACL2 will prove termination. Note: This is an event!
+  It does not print the usual event summary but nevertheless changes
+  the ACL2 logical ~il[world] and is so recorded.~/
+
+  ~bv[] General Form:
+  (set-termination-method tm)
+  ~ev[]
+
+  where ~c[tm] is ~c[:CCG] or ~c[:MEASURE]. The default is ~c[:MEASURE] (chosen
+  to assure compatibility with books created without CCG). The recommended
+  setting is ~c[:CCG]. This macro is equivalent to 
+  ~c[(table acl2-defaults-table :termination-method 'tm)], and hence is ~ilc[local] to
+  any ~il[books] and ~ilc[encapsulate] ~il[events] in which it occurs;
+  ~pl[acl2-defaults-table].
+
+  When the termination-method is set to ~c[:CCG], a termination proof is
+  attempted using the the hierarchical CCG algorithm ~url[CCG-hierarchy].
+
+  When the termination-method is set to ~c[:MEASURE], ACL2 attempts to
+  prove termination using its default measure-based method. Thus, in
+  this setting, ACL2's behavior is identical to that when the CCG book
+  is not included at all.
+
+  To see what the current termination method setting is, use
+  ~ilc[get-termination-method].~/")
+
+(defun get-termination-method (wrld)
+  ":Doc-Section CCG
+
+  Returns the current default termination method.~/
+
+  ~bv[]
+  Examples:
+  (get-termination-method (w state))
+  ~ev[]
+
+  This will return the termination-method as specified by the current world. ~/
+  
+  ~bv[]
+  General Form:
+  (get-termination-method wrld)
+  ~ev[]
+
+  where ~c[wrld] is a ~il[world]. For information on the settings and
+  their meaning, ~pl[set-termination-method].~/"
+
+  (declare (xargs :guard (and (plist-worldp wrld)
+                              (alistp (table-alist 'acl2-defaults-table wrld)))))
+  (let ((entry (assoc :termination-method (table-alist 'acl2-defaults-table wrld))))
+    (or (and entry (cdr entry)) :measure)))
+
+(verify-guards get-termination-method)
+
+(defmacro hlevel-proof-technique (hlevel)
+  `(car ,hlevel))
+
+(defmacro hlevel-ccm-comparison-scheme (hlevel)
+  `(cadr ,hlevel))
+
+(defmacro hlevel-ccmfs-per-nodep (hlevel)
+  `(caddr ,hlevel))
+
+(defmacro make-hlevel (pt ccm-cs cpn)
+  `(list ,pt ,ccm-cs ,cpn))
+
+(defun proof-techniquep (pt)
+
+; checks whether pt is a valid "proof technique" as described in the
+; documentation for the set-ccg-hierarchy. That is, this function returns true
+; if pt is :built-in-clauses or of the form (:induction-depth n) for some
+; natural number n.
+
+  (declare (xargs :guard t))
+  (or (and (keywordp pt)
+           (eq pt :built-in-clauses))
+      (and (consp pt)
+           (keywordp (car pt))
+           (eq (car pt) :induction-depth)
+           (consp (cdr pt))
+           (natp (cadr pt))
+           (null (cddr pt)))))
+
+(defun hlevelp (hlevel)
+  (declare (xargs :guard t))
+
+; returns non-nil if hlevel is a valid level of a CCG hierarchy. That is,
+; the result is non-nil if it is of the form (:measure pt) or (pt ccm-cs cpn)
+; where pt satisfies proof-techniquep, ccm-cs is one of :EQUAL, :ALL, :SOME, or
+; :NONE, and cpn is a boolean.
+
+  (and (consp hlevel)
+       (or (and (keywordp (car hlevel))
+                (eq (car hlevel) :measure)
+                (consp (cdr hlevel))
+                (proof-techniquep (cadr hlevel))
+                (null (cddr hlevel)))
+           (and (proof-techniquep (car hlevel))
+                (consp (cdr hlevel))
+                (member-eq (cadr hlevel) '(:EQUAL :ALL :SOME :NONE))
+                (consp (cddr hlevel))
+                (booleanp (caddr hlevel))
+                (null (cdddr hlevel))))))
+
+(defun hlevel-listp (lst)
+  (declare (xargs :guard t))
+
+; returns non-nil iff lst is a true-list of elements satisfying hlevelp.
+
+  (if (consp lst)
+      (and (hlevelp (car lst))
+           (hlevel-listp (cdr lst)))
+    (null lst)))
+
+(defun non-empty-hlevel-listp (lst)
+  (declare (xargs :guard t))
+  (and (consp lst)
+       (hlevel-listp lst)))
+
+(defun hlevel< (hlevel0 hlevel1)
+
+; a non-transitive comparison function for arguments that are non-measure
+; levels of a CCG hierarchy. The definition is designed to return t if the CCG
+; analysis, using the techniques described in hlevel1 could possibly further
+; refine an annotated CCG that had already been refined using the techniques
+; described in hlevel0. That is, hlevel< returns t if hlevel0 does *not*
+; subsume hlevel1.
+
+  (declare (xargs :guard (and (hlevelp hlevel0)
+                              (not (equal (car hlevel0)
+                                          :measure))
+                              (hlevelp hlevel1)
+                              (not (equal (car hlevel1)
+                                          :measure)))))
+  (let ((pt0 (hlevel-proof-technique hlevel0))
+        (ccm-cs0 (hlevel-ccm-comparison-scheme hlevel0))
+        (cpn0 (hlevel-ccmfs-per-nodep hlevel0))
+        (pt1 (hlevel-proof-technique hlevel1))
+        (ccm-cs1 (hlevel-ccm-comparison-scheme hlevel1))
+        (cpn1 (hlevel-ccmfs-per-nodep hlevel1)))
+
+; if cpn0 is t and cpn1 is nil (hlevel0 calculates CCMFs on a per-node basis,
+; and hlevel1 on a per-edge basis), then we return t.
+
+    (or (and cpn0 (not cpn1))
+
+; if hlevel1 has a stronger proof technique than hlevel0, then return t.
+
+        (and (not (equal pt1 :built-in-clauses))
+             (or (equal pt0 :built-in-clauses)
+                 (< (cadr pt0) (cadr pt1))))
+        
+; if hlevel1 has a more comprehensive CCM comparison scheme, then return t.
+
+        (let ((ccm-cs-vals '((:EQUAL . 0)
+                             (:ALL . 1)
+                             (:SOME . 2)
+                             (:NONE . 3))))
+          (< (cdr (assoc ccm-cs0 ccm-cs-vals))
+             (cdr (assoc ccm-cs1 ccm-cs-vals)))))))
+
+(rewrite-table-guard
+ acl2-defaults-table
+ (:carpat %body%
+  :vars %body%
+  :repl (if (eq key :ccg-hierarchy)
+            (non-empty-hlevel-listp val)
+          %body%)))
+
+
+(defun fix-ccg-hierarchy (hierarchy)
+  (declare (xargs :guard (or (consp hierarchy)
+                             (and (symbolp hierarchy)
+                                  (member-eq hierarchy
+                                             '(:CCG-ONLY
+                                               :CCG-ONLY-CPN
+                                               :HYBRID
+                                               :HYBRID-CPN))))))
+
+  
+; if hierarchy is a symbol designating one of the pre-defined hierarchies,
+; return the hierarchy that it represents. Otherwise, return hierarchy.
+
+  (if (consp hierarchy)
+      hierarchy
+    (case hierarchy
+      (:CCG-ONLY
+       '((:built-in-clauses :equal t)
+         ((:induction-depth 0) :EQUAL t)
+         ((:induction-depth 1) :EQUAL t)
+         ((:induction-depth 1) :ALL   t)
+         ((:induction-depth 1) :SOME  t)
+         ((:induction-depth 1) :NONE  t)
+         ((:induction-depth 1) :EQUAL nil)
+         ((:induction-depth 1) :ALL   nil)
+         ((:induction-depth 1) :SOME  nil)
+         ((:induction-depth 1) :NONE  nil)))
+        (:CCG-ONLY-CPN
+         '((:built-in-clauses :equal t)
+           ((:induction-depth 0) :EQUAL t)
+           ((:induction-depth 1) :EQUAL t)
+           ((:induction-depth 1) :ALL   t)
+           ((:induction-depth 1) :SOME  t)
+           ((:induction-depth 1) :NONE  t)))
+        (:HYBRID
+         '((:built-in-clauses :equal t)
+           (:measure (:induction-depth 1))
+           ((:induction-depth 0) :EQUAL t)
+           ((:induction-depth 1) :EQUAL t)
+           ((:induction-depth 1) :ALL   t)
+           ((:induction-depth 1) :SOME  t)
+           ((:induction-depth 1) :NONE  t)
+           ((:induction-depth 1) :EQUAL nil)
+           ((:induction-depth 1) :ALL   nil)
+           ((:induction-depth 1) :SOME  nil)
+           ((:induction-depth 1) :NONE  nil)))
+        (:HYBRID-CPN
+         '((:built-in-clauses :equal t)
+           (:measure (:induction-depth 1))
+           ((:induction-depth 0) :EQUAL t)
+           ((:induction-depth 1) :EQUAL t)
+           ((:induction-depth 1) :ALL   t)
+           ((:induction-depth 1) :SOME  t)
+           ((:induction-depth 1) :NONE  t)))
+        (otherwise
+         nil))))
+
+(defun get-ccg-hierarchy (wrld)
+  (declare (xargs :guard (and (plist-worldp wrld)
+                              (alistp (table-alist 'acl2-defaults-table
+                                                   wrld)))))
+  
+; gets the default ccg hierarchy from the acl2-defaults-table. the default is
+; :CCG-ONLY.
+
+  (let ((entry (assoc :ccg-hierarchy (table-alist 'acl2-defaults-table wrld))))
+    (if (null entry)
+        (fix-ccg-hierarchy :CCG-ONLY)
+      (cdr entry))))
+
+(set-state-ok t)
+(program)
+
+(defun chk-ccg-hierarchy1 (hierarchy cpn ctx state)
+
+; checks the given hierarchy to assure that it conforms to the proper form.
+; if cpn is nil, all levels of the hierarchy must have a cpn of nil. Otherwise,
+; this function checks that there are no levels of the hierarchy with cpn t
+; that come after levels with a cpn of nil (once you switch from CCMFs per-node
+; to CCMFs per-edge, you cannot go back). The ctx and state are there to enable
+; error reporting. This function returns an error triple whose value is nil if
+; everything checks out.
+
+  (cond ((endp hierarchy)
+         (value nil))
+        ((not (hlevelp (car hierarchy)))
+         (er soft ctx
+             "Each element of a CCG-HIERARCHY must either have the form (PT ~
+              CCM-CS CPN) or (:MEASURE PT), where PT is either ~
+              :BUILT-IN-CLAUSES or (:INDUCTION-DEPTH N) for some natural ~
+              number, N, CCM-CS is one of :EQUAL, :ALL, :SOME, :NONE, and CPN ~
+              is either T or NIL. ~x0 does not match this form."
+             (car hierarchy)))
+        ((and (not cpn)
+              (not (equal (caar hierarchy) :MEASURE))
+              (hlevel-ccmfs-per-nodep (car hierarchy)))
+         (er soft ctx 
+             "It is not permitted that a level of a CCG-HIERARCHY have a ~
+              CCCMFs-per-nodep of T when a previous level had a ~
+              CCMFs-per-nodep of NIL. But this is the case with level ~x0."
+             (car hierarchy)))
+        (t
+         (chk-ccg-hierarchy1 (cdr hierarchy) 
+                             (if (equal (caar hierarchy) :measure)
+                                 cpn
+                               (hlevel-ccmfs-per-nodep (car hierarchy)))
+                             ctx state))))
+
+(defun chk-measure-hlevel<-all (hlevel0 hierarchy ctx state)
+
+; ensures that none of the measure levels of hierarchy are subsumed by hlevel0.
+
+  (cond ((endp hierarchy)
+         (value nil))
+        ((or (not (equal (caar hierarchy) :measure))
+             (and (consp (cadar hierarchy))
+                  (or (atom (cadr hlevel0))
+                      (< (cadadr hlevel0) (cadadr (car hierarchy))))))
+         (chk-measure-hlevel<-all hlevel0 (cdr hierarchy) ctx state))
+        (t
+         (er soft ctx
+             "Each :MEASURE level of a CCG-HIERARCHY should use strictly more ~
+              powerful proof techniques than all those that come before it. ~
+              However, the ~x0 level is subsumed by the earlier level, ~x1."
+             (car hierarchy)
+             hlevel0))))
+
+(defun chk-hlevel<-all (hlevel0 hierarchy ctx state)
+
+; insures that none of the CCG levels of the hierarchy are subsumed by
+; hlevel0.
+
+  (cond ((endp hierarchy)
+         (value nil))
+        ((or (equal (caar hierarchy) :MEASURE)
+             (hlevel< hlevel0 (car hierarchy)))
+         (chk-hlevel<-all hlevel0 (cdr hierarchy) ctx state))
+        (t
+         (er soft ctx
+             "Each level of a CCG-HIERARCHY should be strictly more powerful ~
+              than all the previous levels. That is, it should always be ~
+              possible to refine the CCG or CCMF information at each step in ~
+              the hierarchy. However, the ~x0 level is subsumed by the ~
+              earlier level, ~x1."
+             (car hierarchy)
+             hlevel0))))
+
+(defun chk-hierarchy-strictly-increasing (hierarchy ctx state)
+
+; ensures that no level of hierarchy is subsumed by a later level.
+
+  (if (endp hierarchy)
+      (value nil)
+    (er-progn
+     (cond ((equal (caar hierarchy) :MEASURE)
+            (chk-measure-hlevel<-all (car hierarchy) (cdr hierarchy)
+                                     ctx state))
+           (t
+            (chk-hlevel<-all (car hierarchy) (cdr hierarchy)
+                             ctx state)))
+     (chk-hierarchy-strictly-increasing (cdr hierarchy) ctx state))))
+        
+(defun chk-ccg-hierarchy (hierarchy ctx state)
+
+; checks a proposed CCG hierarchy.
+
+  (cond ((and (symbolp hierarchy)
+              (member-eq hierarchy '(:CCG-ONLY
+                                     :CCG-ONLY-CPN
+                                     :HYBRID
+                                     :HYBRID-CPN)))
+         (value nil))
+        ((and (consp hierarchy)
+              (true-listp hierarchy))
+         (er-progn
+          (chk-ccg-hierarchy1 hierarchy t ctx state)
+          (chk-hierarchy-strictly-increasing hierarchy ctx state)))
+        (t
+         (er soft ctx
+             "A CCG-HIERARCHY must be :CCG-ONLY, :CCG-ONLY-CPN, :HYBRID, ~
+              :HYBRID-CPN, or a non-empty true-list. ~x0 does not have ~
+              this form."
+             hierarchy))))
+         
+(defmacro set-ccg-hierarchy (v)
+    ":Doc-Section CCG
+   
+     Set the default hierarchy of techniques for CCG-based termination
+     analysis. ~/
+     ~bv[]
+     (set-ccg-hierarchy ((:built-in-clauses :equal t)
+                         (:measure (:induction-depth 1))
+                         ((:induction-depth 0) :EQUAL t)
+                         ((:induction-depth 1) :EQUAL t)
+                         ((:induction-depth 1) :ALL   t)
+                         ((:induction-depth 1) :SOME  t)
+                         ((:induction-depth 1) :NONE  t)
+                         ((:induction-depth 1) :EQUAL nil)
+                         ((:induction-depth 1) :ALL   nil)
+                         ((:induction-depth 1) :SOME  nil)
+                         ((:induction-depth 1) :NONE  nil)))
+     :set-ccg-hierarchy ((:built-in-clauses :equal t)
+                         ((:induction-depth 0) :EQUAL t)
+                         ((:induction-depth 1) :EQUAL t)
+                         ((:induction-depth 1) :ALL   t)
+                         ((:induction-depth 1) :SOME  t)
+                         ((:induction-depth 1) :NONE  t))~/
+
+     General Form:
+     (set-ccg-hierarchy v)
+     ~ev[]
+     where ~c[v] is ~c[:CCG-ONLY], ~c[:CCG-ONLY-CPN], ~c[:HYBRID],
+     ~c[:HYBRID-CPN], or a non-empty list of hierarchy levels, which either
+     have the form ~c[(pt ccm-cs cpn)] or the form ~c[(:measure pt)], where
+     ~c[pt] is either ~c[:built-in-clauses] or ~c[(:induction-depth n)] for
+     some natural number ~c[n], ~c[ccm-cs] is one of ~c[:EQUAL], ~c[:ALL],
+     ~c[:SOME], or ~c[:NONE], and ~c[cpn] is ~c[t] or ~c[nil].
+
+     Each level of the hierarchy describes techniques used to prove
+     termination. Termination proofs performed after admitting this event will
+     use the specified techniques in the order in which they are listed.
+
+     Basically, the CCG analysis as described and illustrated at a high level
+     in the documentation for ~il[CCG] can potentially be very expensive. In
+     order to make the analysis as efficient as possible, we use less expensive
+     (and less powerful) techniques first, and resort to more powerful and
+     expensive techniques only when these fail.
+
+     There are three ways of varying the CCG analysis, which are represented by
+     each of the three elements in a hierarchy level (levels of the form
+     ~c[(:measure pt)] will be explained later).
+
+     ~c[Pt] tells the CCG analysis how to limit proof attempts. The idea behind
+     this is that ACL2 is designed to prove statements that the user thinks are
+     true. It therefore does everything it can to prove the conjecture. As ACL2
+     useres already know, this can lead to very long, or even non-terminating
+     proof attempts. The CCG analysis, on the other hand, sends multiple
+     queries to the theorem prover that may or may not be true, in order to
+     improve the accuracy of the analysis. It is therefore necessary to reign
+     in ACL2's proof attempts to keep them from taking too long. Of course, the
+     trade-off is that, the more we limit ACL2's prover, the less powerful it
+     becomes.
+
+     ~c[Pt] can be ~c[:built-in-clauses], which tells ACL2 to use only
+     ~il[built-in-clauses] analysis. This is a very fast, and surprisingly
+     powerful proof technique. For example, the definition of Ackermann's
+     function given in the documentation for ~il[CCG] is solved using only this
+     proof technique.
+
+     ~c[Pt] can also be of the form ~c[(:induction-depth n)], where ~c[n] is a
+     natural number. This uses the full theorem prover, but limits it in two
+     ways. First, it stops proof attempts if ACL2 has been working on a subgoal
+     with no case splitting or induction for 20 steps (that is, at a goal of
+     the form 1.5'20'). It also limits the ~em[induction depth], which
+     describes how many times we allow induction goals to lead to further
+     induction goals. For example, ~c[(:induction-depth 0)] allows no
+     induction, while ~c[(:induction-depth 1)] allows goals of the form ~c[*1]
+     or ~c[*2], but stops if it creates a goal such as ~c[*1.1] or ~c[*2.1].
+
+     ~c[Ccm-cs] limits which CCMs are compared using the theorem
+     prover. Consider again the ~c[ack] example in the documentation for
+     ~il[CCG]. All we needed was to compare the value of ~c[(acl2-count x)]
+     before and after the recursive call and the value of ~c[(acl2-count y)]
+     before and after the recursive call. We would learn nothing, and waste
+     time with the theorem prover if we compared ~c[(acl2-count x)] to
+     ~c[(acl2-count y)]. However, other times, it is important to compare CCMs
+     with each other, for example, when arguments are permuted, or we are
+     dealing with a mutual recursion.
+
+     ~c[Ccm-cs] can be one of ~c[:EQUAL], ~c[:ALL], ~c[:SOME], or
+     ~c[:NONE]. These limit which CCMs we compare based on the variables they
+     mention. Let ~c[c] be a recursive call in the body of function ~c[f] that
+     calls function ~c[g]. Let ~c[m1] be a CCM for ~c[f] and ~c[m2] be a CCM
+     for ~c[g]. Let ~c[v1] be the formals mentioned in ~c[m1] and ~c[v2] be the
+     formals mentioned in ~c[m2'] where ~c[m2'] is derived from ~c[m2] by
+     substituting the formals of ~c[g] with the actuals of ~c[c]. For example,
+     consider following function:
+     ~bv[]
+     (defun f (x)
+       (if (endp x)
+           0
+         (1+ (f (cdr x)))))
+     ~ev[]
+     Now consider the case where ~c[m1] and ~c[m2] are both the measure
+     ~c[(acl2-count x)]. Then if we look at the recursive call ~c[(f (cdr x))]
+     in the body of ~c[f], then ~c[m2'] is the result of replacing ~c[x] with
+     ~c[(cdr x)] in ~c[m2], i.e., ~c[(acl2-count (cdr x))].
+
+     If ~c[ccm-cs] is ~c[:EQUAL] we will compare ~c[m1] to
+     ~c[m2] if ~c[v1] and ~c[v2] are equal. If ~c[value] is ~c[:ALL] we will
+     compare ~c[m1] to ~c[m2'] if ~c[v2] is a subset of ~c[v1]. If ~c[value] is
+     ~c[:SOME] we will compare ~c[m1] to ~c[m2'] if ~c[v1] and ~c[v2]
+     intersect. If ~c[value] is ~c[:NONE] we will compare ~c[m1] to ~c[m2] no
+     matter what.
+
+     There is one caveat to what was just said: if ~c[m1] and ~c[m2] are
+     syntactically equal, then regardless of the value of ~c[ccm-cs] we will
+     construct a CCMF that will indicate that ~c[(o>= m1 m2)].
+
+     
+     ~c[Cpn] tells us how much ruler information we will use to compare CCMs.
+     Unlike ACL2's measure-based termination analysis, CCG has the ability to
+     use the rulers from both the current recursive call the next recursive
+     call when constructing the CCMFs. That is, instead of asking ``What
+     happens when I make recursive call A?'', we can ask, ``What happens when
+     execution moves from recursive call A to recursive call B?''. Using this
+     information potentially strengthens the termination analysis. For a brief
+     example, consider the following code:
+     ~bv[]
+     (defun half (x)
+        (if (zp x)
+            0
+          (1+ (half (- x 2)))))
+     ~ev[]
+
+     Clearly this is terminating. If we choose a measure of ~c[(nfix x)] we
+     know that if ~c[x] is a positive integer, ~c[(nfix (- x 2))] is less than
+     ~c[(nfix x)]. But consider the measure ~c[(acl2-count x)]. The strange
+     thing here is that if ~c[x] is 1, then ~c[(acl2-count (- x 2))] is
+     ~c[(acl2-count -1)], which is 1, i.e. the ~c[acl2-count] of ~c[x]. So, the
+     fact that we know that ~c[x] is a positive integer is not enough to show
+     that this measure decreases. But notice that if ~c[x] is 1, we will recur
+     just one more time. So, if we consider what happens when we move from the
+     recursive call back to itself. In this case we know 
+    ~c[(and (not (zp x)) (not (zp (- x 2))))]. 
+     Under these conditions, it is trivial for ACL2 to prove that
+     ~c[(acl2-count (- x 2))] is always less than ~c[(acl2-count x)].
+ 
+     However, this can make the CCG analysis much more expensive, since
+     information about how values change from step to step are done on a
+     per-edge, rather than a per-node basis in the CCG (where the nodes are the
+     recursive calls and the edges indicate that execution can move from one
+     call to another in one step). Thus, calculating CCMFs (how values change
+     across recursive calls) on a per-edge basis rather than a per-node basis
+     can require n^2 instead of n prover queries.
+
+     If ~c[cpn] is ~c[t], we will use only the ruler of the current recursive
+     call to compute our CCMFs. If it is ~c[nil], we will use the much more
+     expensive technique of using the rulers of the current and next call.
+
+     Levels of the hierarchy of the form ~c[(:measure pt)] specify that the CCG
+     analysis is to be set aside for a step, and the traditional measure-based
+     termination proof is to be attempted. Here, ~c[pt] has the same meaning as
+     it does in a CCG hierarchy level. That is, it limits the measure proof in
+     order to avoid prohibitively long termination analyses.
+
+     The user may specify their own hierarchy in the form given above. The main
+     restriction is that no level may be subsumed by an earlier level. That is,
+     it should be the case at each level of the hierarchy, that it is possible
+     to discover new information about the CCG that could help lead to a
+     termination proof.
+
+     In addition to constructing his or her own CCG hierarchy, the user may use
+     several preset hierarchies:
+
+     ~bv[]
+     :CCG-ONLY
+     ((:built-in-clauses :equal t)
+      ((:induction-depth 0) :EQUAL t)
+      ((:induction-depth 1) :EQUAL t)
+      ((:induction-depth 1) :ALL   t)
+      ((:induction-depth 1) :SOME  t)
+      ((:induction-depth 1) :NONE  t)
+      ((:induction-depth 1) :EQUAL nil)
+      ((:induction-depth 1) :ALL   nil)
+      ((:induction-depth 1) :SOME  nil)
+      ((:induction-depth 1) :NONE  nil))
+
+     :CCG-ONLY-CPN
+     ((:built-in-clauses :equal t)
+      ((:induction-depth 0) :EQUAL t)
+      ((:induction-depth 1) :EQUAL t)
+      ((:induction-depth 1) :ALL   t)
+      ((:induction-depth 1) :SOME  t)
+      ((:induction-depth 1) :NONE  t))
+
+     :HYBRID
+     ((:built-in-clauses :equal t)
+      (:measure (:induction-depth 1))
+      ((:induction-depth 0) :EQUAL t)
+      ((:induction-depth 1) :EQUAL t)
+      ((:induction-depth 1) :ALL   t)
+      ((:induction-depth 1) :SOME  t)
+      ((:induction-depth 1) :NONE  t)
+      ((:induction-depth 1) :EQUAL nil)
+      ((:induction-depth 1) :ALL   nil)
+      ((:induction-depth 1) :SOME  nil)
+      ((:induction-depth 1) :NONE  nil))
+
+     :HYBRID-CPN
+     ((:built-in-clauses :equal t)
+      (:measure (:induction-depth 1))
+      ((:induction-depth 0) :EQUAL t)
+      ((:induction-depth 1) :EQUAL t)
+      ((:induction-depth 1) :ALL   t)
+      ((:induction-depth 1) :SOME  t)
+      ((:induction-depth 1) :NONE  t))
+     ~ev[]
+
+     The default hierarchy for CCG termination analysis is :CCG-ONLY.~/"
+
+  `(er-progn
+    (chk-ccg-hierarchy ',v "SET-CCG-HIERARCHY" state)
+    (with-output :off summary
+     (progn (table acl2-defaults-table ':ccg-hierarchy ',(fix-ccg-hierarchy v))
+            (table acl2-defaults-table ':ccg-hierarchy)))))
+
+;; adds :ccg-time-limit to the acl2-global-table.
+
+(add-acl2-defaults-table-key :ccg-time-limit
+                             (or (null val)
+                                 (and (rationalp val)
+                                      (< 0 val))))
+
+(logic)
+(set-state-ok nil)
+
+(defdoc set-ccg-time-limit
+  ":Doc-Section CCG
+
+  Set a global time limit for CCG-based termination proofs.~/
+  ~bv[]
+  Examples:
+  (set-ccg-time-limit 120)  ; limits termination proofs to 120 seconds.
+  (set-ccg-time-limit 53/2) ; limits termination proofs to 53/2 seconds.
+  (set-ccg-time-limit nil)  ; removes any time limit for termination proofs.
+  ~ev[]
+
+  Introduced by the CCG analysis book, this macro sets a global time limit for
+  the completion of the CCG analysis. The time limit is given as a rational
+  number, signifying the number of seconds to which the CCG analysis should be
+  limited, or nil, signifying that there should be no such time limit. If CCG
+  has not completed its attempt to prove termination in the number of seconds
+  specified, it will immediately throw an error and the definition attempt will
+  fail. Note: This is an event!  It does not print the usual event summary but
+  nevertheless changes the ACL2 logical ~il[world] and is so recorded.~/
+
+  ~bv[] General Form:
+  (set-ccg-time-limit tl)
+  ~ev[]
+  where ~c[tl] is a positive rational number or nil. The default is nil. If the
+  time limit is nil, the CCG analysis will work as long as it needs to in order
+  to complete the analysis. If the ~c[tl] is a positive rational number,
+  all CCG analyses will be limited to ~c[tl] seconds.
+
+  To see what the current time limit is, see
+  ~ilc[get-ccg-time-limit].~/")
+
+(defun get-ccg-time-limit (wrld)
+  ":Doc-Section CCG
+
+  Returns the current default ccg-time-limit setting.~/
+
+  ~bv[]
+  Examples:
+  (get-ccg-time-limit (w state))
+  ~ev[]
+
+  This will return the time-limit as specified by the current world. ~/
+  
+  ~bv[]
+  General Form:
+  (get-time-limit wrld)
+  ~ev[]
+
+  where ~c[wrld] is a ~il[world]. For information on the settings and
+  their meaning, ~pl[set-termination-method].~/"
+
+  (declare (xargs :guard (and (plist-worldp wrld)
+                              (alistp (table-alist 'acl2-defaults-table wrld)))))
+  (let ((entry (assoc :ccg-time-limit (table-alist 'acl2-defaults-table wrld))))
+    (or (and entry (cdr entry)) nil)))
+
+(verify-guards get-ccg-time-limit)
+
+(defmacro set-ccg-print-proofs (v)
+  ":Doc-Section CCG
+
+   controls whether proof attempts are printed during CCG analysis~/
+
+   ~bv[]
+   Examples:
+   (set-ccg-print-proofs t)
+   (set-ccg-print-proofs nil)
+   :set-ccg-print-proofs t~/
+
+   General Form:
+   (set-ccg-print-proofs v)
+   ~ev[]
+   If ~c[v] is ~c[nil], no proof attempts will be printed during CCG
+   analysis. This is the default. If ~c[v] is anything but ~c[nil], proofs will
+   be displayed. Fair warning: there is potentially a large amount of prover
+   output that might be displayed. It is probably better to use
+   ~l[set-ccg-inhibit-output-lst] to un-inhibit ~c['query] output to figure out
+   what lemmas might be needed to get a given query to go through."
+
+ `(assign ccg-print-proofs ,v))
+
+(defmacro get-ccg-print-proofs ()
+  ":Doc-Section CCG
+  
+  returns the setting that controls whether proof attempts are printed during
+  CCG analysis~/
+
+  ~bv[]
+  Examples:
+  (get-ccg-print-proofs)
+  :get-ccg-print-proofs
+  ~ev[]~/
+
+  See ~l[set-ccg-print-proofs] for details."
+ '(and (f-boundp-global 'ccg-print-proofs state)
+       (f-get-global 'ccg-print-proofs state)))
+
+;; The following code is used to implement a parallel to io? as defined in
+;; basis.lisp. Make sure this all stays in sync with the parallel definitions
+;; in that file. To find out more, see the "Essay on Inhibited Output and the
+;; Illusion of Windows" in the comments of basis.lisp.
+
+;; *ccg-window-descriptions* parallels *window-descriptions* as defined in
+;; basis.lisp. See the comments there for details.
+
+(defconst *ccg-window-descriptions*
+;                    str clr top pop
+  '((query           "4" nil nil nil)
+    (basics          "4" nil nil nil)
+    (performance     "4" nil nil nil)
+    (build/refine    "4" nil nil nil)
+    (size-change     "4" nil nil nil)
+    (counter-example "4" nil nil nil)))
+
+;; The following mirrors *valid-output-names* as defined in axioms.lisp. This
+;; is the list of valid io "kinds" that can be inhibited.
+
+(defconst *ccg-valid-output-names*
+  '(query basics performance build/refine size-change counter-example))
+
+(defmacro set-ccg-inhibit-output-lst (lst)
+ ":Doc-Section CCG
+
+  control output during CCG termination analysis~/
+  ~bv[]
+  Examples:
+  (set-ccg-inhibit-output-lst '(query))
+  (set-ccg-inhibit-output-lst '(build/refine size-change))
+  (set-ccg-inhibit-output-lst *ccg-valid-output-names*) ; inhibit all ccg output
+  :set-ccg-inhibit-output-lst (build/refine size-change)~/
+
+  General Form:
+  (set-ccg-inhibit-output-lst lst)
+  ~ev[]
+  where ~c[lst] is a form (which may mention ~ilc[state]) that evaluates
+  to a list of names, each of which is the name of one of the
+  following ``kinds'' of output produced by the CCG termination analysis.
+  ~bv[]
+    query            prints the goal, restrictions, and results of each prover
+                     query (for a discussion on displaying actual proofs,
+                     see ~c[set-ccg-display-proofs](yet to be documented).
+    basics           the basic CCG output, enough to follow along, but concise
+                     enough to keep from drowning in output
+    performance      performance information for the size change analysis
+    build/refine     the details of CCG construction and refinement
+    size-change      the details of size change analysis
+    counter-example  prints out a counter-example that can be useful for
+                     debugging failed termination proof attempts.
+  ~ev[]
+  It is possible to inhibit each kind of output by putting the corresponding
+  name into ~c[lst].  For example, if ~c['query] is included in (the value of)
+  ~c[lst], then no information about individual queries is printed during CCG
+  analysis.
+
+  The default setting is ~c['(query performance build/refine size-change)].
+  That is, by default only the basic CCG information and counter-example (in
+  the case of a failed proof attempt) are printed. This should hopefully be
+  adequate for most users."
+  
+  `(let ((lst ,lst))
+     (cond ((not (true-listp lst))
+            (er soft 'set-ccg-inhibit-output-lst
+                "The argument to set-ccg-inhibit-output-lst must evaluate to a ~
+                 true-listp, unlike ~x0."
+                lst))
+           ((not (subsetp-eq lst *ccg-valid-output-names*))
+            (er soft 'set-ccg-inhibit-output-lst
+                "The argument to set-ccg-inhibit-output-lst must evalutate to a ~
+                 subset of the list ~X01, but ~x2 contains ~&3."
+                *ccg-valid-output-names*
+                nil
+                ',lst
+                (set-difference-eq lst *ccg-valid-output-names*)))
+           (t (pprogn
+               (f-put-global 'ccg-inhibit-output-lst lst state)
+               (value lst))))))
+
+(defmacro get-ccg-inhibit-output-lst ()
+  ":Doc-Section CCG
+
+  returns the list of ``kinds'' of output that will be inhibited during CCG
+  analysis~/
+
+
+  ~bv[]
+  Examples:
+  (get-ccg-inhibit-output-lst)
+  :get-ccg-inhibit-output-lst
+  ~bv[]~/
+
+  See ~l[set-ccg-inhibit-output-lst]."
+  '(if (f-boundp-global 'ccg-inhibit-output-lst state)
+       (f-get-global 'ccg-inhibit-output-lst state)
+     '(query performance build/refine size-change)))
+
+(program)
+(set-state-ok t)
+
+(defmacro ccg-io? (token commentp shape vars body
+                     &key
+                     (clear 'nil clear-argp)
+                     (cursor-at-top 'nil cursor-at-top-argp)
+                     (pop-up 'nil pop-up-argp)
+                     (default-bindings 'nil)
+                     (chk-translatable 't))
+
+; NOTE: Keep this in sync with io? as defined in basis.lisp. This definition is
+; almost identical to that one, except we use *ccg-window-descriptions* and
+; *ccg-valid-output-names* instead of *window-descriptions* and
+; *valid-output-names*, and we store our inhibited-lst in the global table
+; under the symbol 'ccg-inhibit-output-lst instead of 'inhibit-output-lst. The
+; remaining comments in this definition are from the original io? definition:
+
+; Typical use (io? error nil (mv col state) (x y) (fmt ...)), meaning execute
+; the fmt statement unless 'error is on 'inhibit-output-lst.  The mv expression
+; is the shape of the output produced by the fmt expression, and the list (x y)
+; for vars indicates the variables other than state that occur free in that
+; expression.  See the comment above, and see the Essay on Saved-output for a
+; comment that gives a convenient macro for obtaining the free variables other
+; than state that occur free in body.
+
+; Default-bindings is a list of doublets (symbol value).  It is used in order
+; to supply a non-nil return value for other than state when io is suppressed.
+; For example, fmt returns col and state, as suggested by the third (shape)
+; argument below.  Without the :default-bindings, this form would evaluate to
+; (mv nil state) if event IO is inhibited.  But there are fixnum declarations
+; that require the first return value of fmt to be an integer, and we can
+; specify the result in the inhibited case to be (mv 0 state) with the
+; following :default-bindings:
+
+; (io? event nil (mv col state) nil (fmt ...) :default-bindings ((col 0)))
+
+; The values in :default-bindings are evaluated, so it would be equivalent to
+; replace 0 with (- 4 4), for example.
+
+    (declare (xargs :guard (and (symbolp token)
+                              (symbol-listp vars)
+                              (no-duplicatesp vars)
+                              (not (member-eq 'state vars))
+                              (assoc-eq token *ccg-window-descriptions*))))
+  (let* ((associated-window (assoc-eq token *ccg-window-descriptions*))
+         (expansion
+          `(let* ((io?-output-inhibitedp
+                   (member-eq ',token
+                              (get-ccg-inhibit-output-lst)))
+                  (io?-alist
+                   (and (not io?-output-inhibitedp)
+                        (list
+                         (cons #\w ,(cadr associated-window))
+                         (cons #\c ,(if clear-argp
+                                        clear
+                                      (caddr associated-window)))
+                         (cons #\t ,(if cursor-at-top-argp
+                                        cursor-at-top
+                                      (cadddr associated-window)))
+                         (cons #\p ,(if pop-up-argp
+                                        pop-up
+                                      (car (cddddr associated-window))))
+
+; Peter Dillinger requested the following binding, so that he could specify a
+; window prelude string that distinguishes between, for example, "prove",
+; "event", and "summary" output, which with the default string would all just
+; show up as window 4.
+
+                         (cons #\k ,(symbol-name token))))))
+             (pprogn
+              (if (or io?-output-inhibitedp
+                      (null (f-get-global 'window-interfacep state)))
+                  state
+                (mv-let (io?-col state)
+                        (fmt1! (f-get-global 'window-interface-prelude state)
+                               io?-alist 0 *standard-co* state nil)
+                        (declare (ignore io?-col))
+                        state))
+              ,(let ((body
+                      `(check-vars-not-free
+                        (io?-output-inhibitedp io?-alist)
+                        (check-exact-free-vars io? (state ,@vars) ,body)))
+                     (nil-output (if (eq shape 'state)
+                                     'state
+                                   (cons 'mv (io?-nil-output (cdr shape)
+                                                             default-bindings))))
+                     (postlude
+                      `(mv-let
+                        (io?-col state)
+                        (if (or io?-output-inhibitedp
+                                (null (f-get-global 'window-interfacep state)))
+                            (mv 0 state)
+                          (fmt1! (f-get-global 'window-interface-postlude state)
+                                 io?-alist 0 *standard-co* state nil))
+                        (declare (ignore io?-col))
+                        (check-vars-not-free
+                         (io?-output-inhibitedp io?-alist io?-col)
+                         ,shape))))
+                 (let ((body (if commentp
+                                 `(let ,(io?-wormhole-bindings 0 vars)
+                                    ,body)
+                               body)))
+                   (cond
+                    ((eq shape 'state)
+                     `(pprogn
+                       (if io?-output-inhibitedp state ,body)
+                       ,postlude))
+                    (t `(mv-let ,(cdr shape)
+                                (if io?-output-inhibitedp
+                                    ,nil-output
+                                  ,body)
+                                ,postlude)))))))))
+    (cond
+     (commentp
+      (let ((form
+             (cond
+              ((eq shape 'state)
+               `(pprogn ,expansion (value :q)))
+              (t
+               `(mv-let ,(cdr shape)
+                        ,expansion
+                        (declare
+                         (ignore ,@(remove1-eq 'state (cdr shape))))
+                        (value :q))))))
+        `(prog2$
+          ,(if chk-translatable
+               `(chk-translatable ,body ,shape)
+             nil)
+          (wormhole 'comment-window-io
+                    '(lambda (whs)
+                       (set-wormhole-entry-code whs :ENTER))
+                    (list ,@vars)
+                    ',form
+                    :ld-error-action :return!
+                    :ld-verbose nil
+                    :ld-pre-eval-print nil
+                    :ld-prompt nil))))
+     (t `(pprogn
+          (cond ((saved-output-token-p ',token state)
+                 (push-io-record nil ; io-marker
+                                 (list 'let
+                                       (list ,@(formal-bindings vars))
+                                       ',expansion)
+                                 state))
+                (t state))
+          ,expansion)))))
+
+
+; END public configuration interface
+
+; BEGIN mostly raw definitions for the CCG analysis
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; STRUCT DEFINITIONS                                            ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defstruct-raw funct
+
+  ;; The funct defstruct represents the relevant information about the function
+  ;; definitions provided by the user. 
+  ;;
+  ;;  * fn: the function name
+
+  (fn nil :type symbol)
+  
+  ;;  * formals: the formals of the function
+
+  (formals nil :type list)
+
+  ;;  * ccms: the ccms associated with the function. This will be a vector of
+  ;;    terms, whose value will always be natural numbers.
+
+  (ccms nil :type sequence))
+
+(defstruct-raw context
+
+;; The context defstruct is used to represent a calling context. The
+;; individual fields are as follows:
+;;
+;; * ruler: the ruler of the context.
+
+  (ruler nil)
+
+;; * call: the actual recursive call of the context.
+
+  (call nil)
+
+;; * parent-funct: the funct representing the function containing the context.
+
+  (parent-funct (make-funct) :type funct)
+
+;; * call-funct: the funct representing the function called by the call of the
+;;   context. 
+
+  (call-funct (make-funct) :type funct)
+
+;; * num: a unique ID number assigned to each context. Also indicates
+;;   its index in the context-array.
+
+  num)
+
+;; The following macros make it easy to get and set the fields of the functs of
+;; a given context.
+
+(defmacro-raw context-fn (c)
+  `(funct-fn (context-parent-funct ,c)))
+
+(defmacro-raw context-formals (c)
+  `(funct-formals (context-parent-funct ,c)))
+
+(defmacro-raw context-callfn (c)
+  `(funct-fn (context-call-funct ,c)))
+
+(defmacro-raw context-callformals (c)
+  `(funct-formals (context-call-funct ,c)))
+
+(defmacro-raw context-ccms (c)
+  `(funct-ccms (context-parent-funct ,c)))
+
+(defstruct-raw ccmf-node
+
+  ;; The ccmf-node struct represents nodes in the graph representation
+  ;; of a CCMF (see the comments for the struct ccmf). It contains two
+  ;; lists of edges: >-edges is a list of the indices of the CCMs that
+  ;; are always < the current one, and likewise >=-edges is a list of
+  ;; the indeces of the CCMs that are always <= the current one.
+
+  (>-edges nil :type list)
+  (>=-edges nil :type list))
+
+(defstruct-raw ccmf
+
+  ;; The ccmf struct represents CCMFs as a graph with edges labeled by
+  ;; > or >=. The fields are as follows:
+  ;;
+  ;; * firstsite: the index of the "tail" context of the CCMF.
+
+  (firstsite 0 :type fixnum)
+
+  ;; * lastsite: the index of the "head" context of the CCMF.
+
+  (lastsite 0 :type fixnum)
+
+  ;; * fc-num: the original index of the "tail" context. This is needed
+  ;;   because CCGs get separated into SCCs, so the index of the head
+  ;;   and tail contexts in the current SCC (firstsite and lastsite)
+  ;;   and the context in the original context array may be
+  ;;   different. Also, this item is actually a list of indices because
+  ;;   of the possibility of context merging. The list keeps track of
+  ;;   the original indices of all the contexts that were merged to
+  ;;   make the current head or tail context. Currently, absorption and
+  ;;   merging are not used, so we tend to just refer to the first item
+  ;;   in the list.
+
+  (fc-num (list 0) :type (cons fixnum list))
+
+  ;; * lc-num: the original index of the "head" context (see note for
+  ;;   fc-num).
+
+  (lc-num (list 0) :type (cons fixnum list))
+
+  ;; * graph: the graph representing the CCMF. This is an array of
+  ;;   ccmf-nodes.
+
+  (graph nil :type (array ccmf-node))
+
+  ;; * in-sizes: the number of CCMFs for the "tail" context.
+
+  (in-sizes 0 :type fixnum)
+
+  ;; * out-sizes: the number of CCMFs for the "head" context.
+
+  (out-sizes 0 :type fixnum)
+
+  ;; * steps: the number of steps in the CCG represented by the
+  ;;   CCMF. This is used in the sct algorithm.
+
+  (steps 1 :type fixnum))
+
+
+(defstruct-raw accg-edge
+  ;; The accg-edge struct represents edges in the annotated CCG (ACCG).
+
+  ;; * tail: the index of the tail ACCG node of the edge.
+  
+  (tail -1 :type fixnum)
+  
+  ;; * head: the index of the head ACCG node of the edge.
+
+  (head -1 :type fixnum)
+
+  ;; * ccmf: the CCMF associated with the edge in the ACCG.
+
+  (ccmf nil :type (or null ccmf)))
+
+
+(defstruct-raw accg-node
+;; The accg-node struct represents nodes in the ACCG. An ACCG is an
+;; array of these.
+
+  ;; * context: the context associated with the node.
+  
+  (context (make-context) :type context)
+  
+  ;; * fwd-edges: edges for which the current node is the tail.
+
+  (fwd-edges nil :type list)
+  
+  ;; * bwd-edges: edges for which the current node is the head.
+  
+  (bwd-edges nil :type list)
+  
+  ;; * num: the index of the node in the array of nodes of the ACCG.
+  
+  (num 0 :type fixnum))
+
+
+;; The following macros are self-explanitory. They allow us to refer
+;; to fields of a substruct of a given struct as if it were a field in
+;; the struct.
+
+(defmacro-raw accg-node-ruler (accg)
+  `(context-ruler (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-call (accg)
+  `(context-call (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-parent-funct (accg)
+  `(context-parent-funct (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-call-funct (accg)
+  `(context-call-funct (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-fn (accg)
+  `(context-fn (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-formals (accg)
+  `(context-formals (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-callformals (accg)
+  `(context-callformals (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-callfn (accg)
+  `(context-callfn (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-context-num (accg)
+  `(context-num (accg-node-context ,accg)))
+
+(defmacro-raw accg-node-ccms (accg)
+  `(context-ccms (accg-node-context ,accg)))
+
+;;; The following two structs are used to represent an SRG. See the
+;;; paper on the polynomial approximation of SCT (a.k.a. SCP) for a
+;;; full explanation. Briefly: an SRG has CCMs for nodes and edges
+;;; labeled with > or >= between them as the corresponding CCMF
+;;; dictates. In other words, the graph connects all the CCMF graphs
+;;; into one graph.
+
+(defstruct-raw srg-edge
+  ;; The srg-edge represents an edge in an SRG.
+
+  ;; * tail: the tail CCM of the edge.
+  
+  (tail  0 :type fixnum)
+  
+  ;; * head: the head CCM of the edge.
+
+  (head  0 :type fixnum)
+  
+  ;; * ccmf: the CCMF from which this edge was derived.
+
+  (ccmf (make-ccmf) :type ccmf)
+  
+;; * label: generally > or >=, indicating the label of the CCMF edge
+;;   from which this edge is derived.
+
+  (label 'none :type symbol))
+
+(defstruct-raw srg-node
+  ;; The srg-node struct represents a node of the SRG
+
+  ;; * node: the index of the ACCG node associated with this SRG node.
+
+  (node 0 :type fixnum)
+
+  ;; * ccm: the index of the CCM in the array of CCMs assigned to the
+  ;;   corresponding ACCG node.
+
+  (ccm 0 :type fixnum)
+
+  ;; * fwd-edges: the list of srg-edges of which this srg-node is the
+  ;;   tail.
+
+  (fwd-edges nil :type list)
+
+  ;; * bwd-edges: the list of srg-edges of which this srg-node is the
+  ;;   head.
+
+  (bwd-edges nil :type list))
+
+;;; the memoization struct contains the information that we use for
+;;; memoization. The fields are as follows:
+;;;
+;;; * proved: the list of proved conjectures.
+;;; * unproved0: the list of conjectures that we could not prove with 0 inductions.
+;;; * unproved1: the list of conjectures that we could not prove with 1 induction.
+
+(defstruct-raw memoization
+  (proved nil :type list)
+  (unproved (make-array 0 :initial-element nil :element-type 'list)
+            :type (vector list)))
+
+(defun-raw create-memoization (max-ind)
+  (make-memoization :unproved (make-array (1+ max-ind)
+                                          :initial-element nil
+                                          :element-type 'list)))
+
+;;; ccg-simplify-hyps-no-split takes a list of expressions, hyps,
+;;; representing a conjunction of predicates and quickly simplifies
+;;; them in such a way that does not cause a case split. It returns
+;;; the list of simplified expressions.
+(defun-raw ccg-simplify-hyps-no-split (hyps ctx ens wrld state)
+  (declare (ignore ctx))
+  (mv-let (nhyps ttree)
+          (normalize-lst hyps t nil ens wrld nil)
+          (er-progn
+           (accumulate-ttree-and-step-limit-into-state ttree :skip state)
+           (value (flatten-ands-in-lit-lst nhyps)))))
+
+(defrec query-spec-var
+  ((wrld . ens)
+   (ctx . otf-flg)
+   (stop-time . mem))
+  t)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Printing Functions                                               ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw print-funct-ccms (functs wrld state)
+  (if (endp functs)
+      state
+    (pprogn
+     (fms "The CCM~#1~[~/s~] for ~x0 ~#1~[is~/are~] ~&1.~|"
+          `((#\0 . ,(funct-fn (car functs)))
+            (#\1 . ,(untranslate-lst
+                     (mapcar #'de-propagate
+                             (coerce (funct-ccms (car functs))
+                                     'list))
+                     nil
+                     wrld)))
+          *standard-co*
+          state
+          nil)
+     (print-funct-ccms (cdr functs) wrld state))))
+      
+;; The following definitions culminate in print-counter-example.
+
+(defun-raw prettify-ccms (ccm-array vars vals wrld)
+  (let ((fn (if vars
+                #'(lambda (x)
+                    (untranslate (subcor-var vars vals 
+                                             (de-propagate x))
+                                 nil wrld))
+              #'(lambda (x)
+                  (untranslate (de-propagate x)
+                               nil wrld)))))
+    (map 'vector fn ccm-array)))             
+
+(defmacro-raw ce-defun-fn (defun)
+  `(cadr ,defun))
+
+(defmacro-raw ce-defun-formals (defun)
+  `(caddr ,defun))
+
+(defmacro-raw ce-defun-body (defun)
+  `(cadddr ,defun))
+
+(defmacro-raw ce-defun-test (defun)
+  `(let ((body (ce-defun-body ,defun)))
+     (if (eq (fn-symb body) 'if)
+         (cadr body)
+       T)))
+
+(defmacro-raw ce-defun-call (defun)
+  `(let ((body (ce-defun-body ,defun)))
+     (if (eq (fn-symb body) 'if)
+         (caddr body)
+       body)))
+
+(defun-raw ccmf-graph-no-edges? (ccmf-graph)
+  (loop for node across ccmf-graph
+        when (or (consp (ccmf-node->-edges node))
+                 (consp (ccmf-node->=-edges node)))
+          return nil
+        finally (return t)))
+
+(defun-raw ccmf-graph-term (i graph ccms0 ccms1 acc)
+  (if (< i 0)
+      (cond ((endp acc) acc)
+            ((endp (cdr acc)) (car acc))
+            (t (cons 'and acc)))
+    (let* ((node (aref graph i))
+           (>=-edges (ccmf-node->=-edges node))
+           (>-edges  (ccmf-node->-edges node))
+           (ccm (de-propagate (aref ccms0 i))))
+      (ccmf-graph-term (1- i)
+                       graph
+                       ccms0
+                       ccms1
+                       (append (mapcar #'(lambda (x)
+                                           `(> ,ccm 
+                                               ,(de-propagate
+                                                 (aref ccms1 x))))
+                                       >-edges)
+                               (mapcar #'(lambda (x)
+                                           `(>= ,ccm
+                                                ,(de-propagate
+                                                  (aref ccms1 x))))
+                                       >=-edges)
+                               acc)))))
+
+(defun-raw print-ccmfs1 (defuns defun0 defun1 ccmfs flst funct0 col wrld state)
+  (if (endp defuns)
+      state
+    (let* ((graph (ccmf-graph (car ccmfs)))
+           (ne? (ccmf-graph-no-edges? graph))
+           (f0 (car defuns))
+           (f1 (if (consp (cdr defuns))
+                   (cadr defuns)
+                 defun0))
+           (f2 (cond ((endp (cdr defuns))
+                      defun1)
+                     ((endp (cddr defuns))
+                      defun0)
+                     (t (caddr defuns))))
+           (fn0 (ce-defun-fn f0))
+           (fn1 (ce-defun-fn f1))
+           (fn2 (ce-defun-fn f2))
+           (formals (ce-defun-formals f1))
+           (actuals (fargs (ce-defun-call f0)))
+           (ccms0 (prettify-ccms (funct-ccms (car flst)) nil nil wrld))
+           (ccms0-lst (coerce ccms0 'list))
+           (ccms1 (prettify-ccms (funct-ccms (if (endp (cdr flst))
+                                                 funct0
+                                               (cadr flst)))
+                                 formals actuals wrld))
+           (ccms1-lst (coerce ccms1 'list)))
+      (pprogn
+       (fms "When execution moves from the recursive call in ~x0 of ~x1 to ~
+             ~#2~[itself~/the recursive call in ~x1 of ~x3~], we need to know ~
+             how the measures of ~x0 compare with the result of substituting ~
+             the formals of ~x1 with the actuals of the call to ~x1 in the ~
+             measures of ~x1. The measure~#4~[~/s~] for ~x0 ~
+             ~#4~[is~/are~]:~|~%~*6~%The result~#5~[~/s~] of applying the ~
+             substitution to the measures of ~x1 ~#5~[is~/are~]:~|~%~*7~%We ~
+             know ~#8~[nothing about how the values of these CCMs ~
+             relate.~/the following about these CCMs:~%~%~Y9A~]~|~%If you can ~
+             show that any of the terms in the first list is always either ~
+             strictly greater than, or greater than or equal to some term in ~
+             the second list, this could be helpful for proving termination.~|"
+            (list (cons #\0 fn0)
+                  (cons #\1 fn1)
+                  (cons #\2 (if (eq fn0 fn1) 0 1))
+                  (cons #\3 fn2)
+                  (cons #\4 ccms0-lst)
+                  (cons #\5 ccms1-lst)
+                  (cons #\6 `("" "~x*.~|" "~x*~|" "~x*~|"
+                              ,ccms0-lst))
+                  (cons #\7 `("" "~x*.~|" "~x*~|" "~x*~|"
+                              ,ccms1-lst))
+                  (cons #\8 (if ne? 0 1))
+                  (cons #\9 (ccmf-graph-term
+                              (1- (array-dimension graph 0))
+                              graph
+                              ccms0
+                              ccms1
+                              nil))
+                  (cons #\A (term-evisc-tuple nil state)))
+            *standard-co* state nil)
+       (print-ccmfs1 (cdr defuns)
+                     defun0
+                     defun1
+                     (cdr ccmfs)
+                     (cdr flst)
+                     funct0
+                     col wrld state)))))
+
+(defun-raw print-ccmfs (defuns ccmfs flst col wrld state)
+  (if (endp defuns)
+      state
+    (print-ccmfs1 defuns
+                   (car defuns)
+                   (if (endp (cdr defuns))
+                       (car defuns)
+                     (cadr defuns))
+                   ccmfs
+                   flst
+                   (car flst)
+                   col
+                   wrld
+                   state)))
+          
+(defun-raw print-ccms (defuns functs col wrld state)
+  ;; (format t "defuns: ~A functs: ~A col: ~A state: ~A~%" defuns functs col state)
+  (if (endp defuns)
+      (mv-let (col state)
+              (fmt1 "~|" nil col *standard-co* state nil)
+              (declare (ignore col))
+              state)
+    (mv-let
+     (col state)
+     (fmt1 "The CCM~#1~[~/s~] for ~x0 ~#1~[is~/are~] ~&1. "
+           (list (cons #\0 (cadar defuns))
+                 (cons #\1 (untranslate-lst
+                            (mapcar #'de-propagate
+                                    (coerce (funct-ccms (car functs))
+                                            'list))
+                            nil
+                            wrld)))
+           col
+           *standard-co*
+           state nil)
+     (print-ccms (cdr defuns) (cdr functs) col wrld state))))
+
+(defun-raw produce-counter-example1 (ccmfs context-array alist wrld)
+  (if (endp ccmfs)
+      (mv nil nil nil)
+    (let* ((context (aref context-array (car (ccmf-fc-num (car ccmfs)))))
+           (funct (context-parent-funct context))
+           (fn (funct-fn funct)))
+      
+      (mv-let
+       (name i)
+       (ccg-counter-example-fn-name fn (assoc-eq-value fn 0 alist) wrld)
+       (mv-let
+        (contexts functs names)
+        (produce-counter-example1 (cdr ccmfs) context-array 
+                                  (assoc-set-eq fn (1+ i) alist) wrld)
+        (mv (cons context contexts)
+            (cons funct functs)
+            (cons name names)))))))
+ 
+(defun-raw produce-counter-example2 (contexts names name0 ctx ens wrld state)
+  (if (endp contexts)
+      (value nil)
+    (let* ((context (car contexts))
+           (funct (context-parent-funct context))
+           (call (cons (if (endp (cdr names))
+                           name0
+                         (cadr names))
+                       (fargs (context-call context)))))
+      (er-let*
+       ((ruler (state-global-let*
+                ((inhibit-output-lst
+                  ;; no output here.
+                  *valid-output-names*))
+                ;; remove any redundant or subsumed hyps.
+                (simp-hyps0 (context-ruler context)
+                            ctx ens wrld state nil t nil :term-order)))
+        (body (value (if (endp ruler)
+                         call
+                       `(if ,(if (endp (cdr ruler))
+                                 (car ruler)
+                               `(and ,@ruler))
+                            ,call
+                          (list ,@(funct-formals funct))))))
+        (rst (produce-counter-example2 (cdr contexts)
+                                       (cdr names)
+                                       name0
+                                       ctx ens wrld state)))
+       (value (cons `(defun ,(car names) ,(funct-formals funct) ,body)
+                    rst))))))  
+
+(defun-raw accg-find-ccmf (accg i j)
+  (loop for edge in (accg-node-fwd-edges (aref accg i))
+        when (= j (accg-edge-head edge))
+          return (accg-edge-ccmf edge)))
+
+(defun-raw produce-counter-example (path accg context-array ctx ens wrld state)
+  (let* ((ccmfs (loop for p on path
+                      when (and (consp p) (consp (cdr p)))
+                        collect (accg-find-ccmf accg (car p) (cadr p)))))
+    (pprogn
+     (fms "Producing counter-example, including simplifying rulers in order to ~
+           maximize the reabability of the counter-example."
+          nil
+          *standard-co*
+          state nil)
+     (mv-let
+      (contexts functs names)
+      (produce-counter-example1 ccmfs context-array nil wrld)
+      (er-let* ((defuns (produce-counter-example2 contexts names (car names)
+                                                  ctx ens wrld state)))
+               (value (list* ccmfs functs defuns)))))))
+
+(defun-raw print-counter-example (accg ce contexts ctx ens wrld state)
+  (er-let*
+   ((triple (produce-counter-example (cdr ce)
+                                     accg
+                                     contexts
+                                     ctx ens wrld state))
+    (ccmfs (value (car triple)))
+    (functs (value (cadr triple)))
+    (defuns (value (cddr triple))))
+   (pprogn
+    (fms "The following function definitions correspond to an actual loop in ~
+          your function definitions for which the CCG analysis was unable to ~
+          prove termination in all cases: ~%~%~Y01~%"
+         (list (cons #\0 (untranslate (if (endp (cdr defuns))
+                                          (car defuns)
+                                        (cons 'mutual-recursion defuns))
+                                      nil wrld))
+               (cons #\1 (term-evisc-tuple nil state)))
+         *standard-co*
+         state nil)
+    ;; (print-ccms defuns functs 0 wrld state)
+    (print-ccmfs defuns ccmfs functs 0 wrld state)
+    (let* ((loop-graph (car ce))
+           (ne? (ccmf-graph-no-edges? loop-graph))
+           (ccms (funct-ccms (car functs))))
+      (fms "As it stands, we do not have enough information to show that this ~
+            loop terminates. ~#0~[When we put it all together, we find that ~
+            when we loop from ~x1 to itself, we know ~#2~[nothing about how ~
+            the values of the CCMs change. ~/the following about how values ~
+            change from one iteration to the loop to the next (measures are ~
+            presented without substitution):~%~%~Y34~]~/~]~|~%Note that under ~
+            this abstraction, the loop is idempotent (i.e. going through the ~
+            loop again will result in the same information about ~
+            non-increasing and decreasing values as we have just stated), and ~
+            that there is no CCM that decreases to itself across the loop. ~
+            There are therefore three possibilities: ~|~%(1) We did not guess ~
+            the CCMs needed for proving termination. If this is the case, you ~
+            could provide them for us using a :CONSIDER-CCMS or ~
+            :CONSIDER-ONLY-CCMS hint (see :DOC CCG-XARGS). If you are truly ~
+            desperate, you can resort to proving termination using ACL2's ~
+            measure-based termination method (do this globally by using ~
+            SET-TERMINATION-METHOD or just once by using the ~
+            :TERMINATION-METHOD xarg; see :DOC CCG-XARGS).~|~%(2) We guessed ~
+            the proper CCMs, but were unable to prove some necessary ~
+            theorem(s) about how these values change from step to step in the ~
+            loop. In this case, we suggest that you look at the ~
+            counter-example we generated and use it to determine what ~
+            additional lemmas are needed for CCG analysis to successfully ~
+            prove termination.~|~%(3) The loop really is non-terminating for ~
+            some inputs. In this case, you should alter the definition of the ~
+            function so that it will terminate on all inputs.~%~%"
+           (list (cons #\0 (if (consp (cdr defuns)) 0 1))
+                 (cons #\1 (cadar defuns))
+                 (cons #\2 (if ne? 0 1))
+                 (cons #\3 (untranslate
+                            (ccmf-graph-term
+                             (1- (array-dimension loop-graph 0))
+                             loop-graph
+                             ccms
+                             ccms
+                             nil)
+                            nil
+                            wrld))
+                 (cons #\4 (term-evisc-tuple nil state)))
+           *standard-co*
+           state nil)))))
+
+(defun-raw print-ccmf-changes (col changes state)
+  (if (endp changes)
+      state
+    (let ((change (car changes)))
+      (mv-let
+       (col state)
+       (fmt1 "When execution moves ~@0, the following ~
+             always holds:~|~%~x1.~|~%"
+             `((#\0 . ,(if (consp (car change))
+                           `("from context ~x0 to context ~x1"
+                             (#\0 . ,(caar change))
+                             (#\1 . ,(cdar change)))
+                         `("across context ~x0"
+                           (#\0 . ,(car change)))))
+               (#\1 . ,(cdr change)))
+             col
+             *standard-co*
+             state
+             nil)
+       (print-ccmf-changes col (cdr changes) state)))))
+
+(defun-raw p< (p1 p2)
+  (or (< (car p1) (car p2))
+      (and (= (car p1) (car p2))
+           (< (cdr p1) (cdr p2)))))
+
+(defun-raw construct-accg-changes-printout (changes)
+  (if (endp changes)
+      nil
+    (cons `("the edge from context ~x0 to context ~x1"
+            (#\0 . ,(caar changes))
+            (#\1 . ,(cdar changes)))
+          (construct-accg-changes-printout (cdr changes)))))
+
+(defun-raw print-accg-changes (changes state)
+  (if (endp changes)
+      (fms "~|" nil *standard-co* state nil)
+    (pprogn
+     (fms "~x0 -> ~x1"
+          `((#\0 . ,(caar changes))
+            (#\1 . ,(cdar changes)))
+          *standard-co*
+          state
+          nil)
+     (print-accg-changes (cdr changes) state))))
+
+(defun-raw print-changes (col changes state)
+  (if (and (endp (car changes))
+           (endp (cdr changes)))
+      (mv-let
+       (col state)
+       (fmt1 "We discovered nothing new about the CCG.~|"
+             nil
+             col
+             *standard-co*
+             state
+             nil)
+       (declare (ignore col))
+       state)
+    (mv-let
+     (col state)
+     (fmt1 "We discovered the following about the CCG.~|~%"
+           nil
+           col
+           *standard-co*
+           state
+           nil)
+     (mv-let
+      (col state)
+      (if (endp (car changes))
+          (mv col state)
+        (mv-let
+         (col state)
+         (fmt1 "We can safely omit the following edges from the CCG:~|"
+               nil
+               col
+               *standard-co*
+               state
+               nil)
+         (declare (ignore col))
+         (mv 0 (print-accg-changes (car changes) state))))
+     (print-ccmf-changes col
+                         (sort (copy-list (cdr changes))
+                               (if (consp (caadr changes))
+                                   #'p<
+                                 #'<)
+                               :key #'car)
+                         state)))))
+
+
+(defun-raw print-context-array1 (i names context-array state)
+  (if (>= i (array-dimension context-array 0))
+      state
+    (pprogn
+     (let ((context (aref context-array i)))
+       (fms "CALLING CONTEXT ~x0~#1~[~/ in the body of ~x2~]:~|rulers: ~
+             ~x3~|call: ~x4~|"
+            `((#\0 . ,i)
+              (#\1 . ,names)
+              (#\2 . ,(context-fn context))
+              (#\3 . ,(context-ruler context))
+              (#\4 . ,(context-call context)))
+            *standard-co*
+            state
+            nil))
+     (print-context-array1 (1+ i) names context-array state))))
+
+(defun-raw print-context-array (names context-array state)
+  (pprogn
+   (fms "The calling contexts for ~#0~[this definition~/these definitions~] ~
+         are:~|"
+        `((#\0 . ,names))
+        *standard-co*
+        state
+        nil)
+  (print-context-array1 0 names context-array state)))
+
+(defun-raw print-accg-edges3 (edges accg state)
+  (if (endp edges)
+      state
+    (pprogn
+     (let ((pair (accg-edge-context-pair (car edges) accg)))
+       (fms "~x0 -> ~x1"
+            `((#\0 . ,(car pair))
+              (#\1 . ,(cdr pair)))
+            *standard-co*
+            state
+            nil))
+     (print-accg-edges3 (cdr edges) accg state))))
+
+(defun-raw print-accg-edges2 (i n accg state)
+  (if (>= i n)
+      state
+    (pprogn
+     (print-accg-edges3 (accg-node-fwd-edges (aref accg i)) accg state)
+     (print-accg-edges2 (1+ i) n accg state))))
+
+(defun-raw print-accg-edges1 (accgs state)
+  (if (endp accgs)
+      (fms "~|" nil *standard-co* state nil)
+    (pprogn
+     (print-accg-edges2 0
+                        (array-dimension (car accgs) 0)
+                        (car accgs)
+                        state)
+     (print-accg-edges1 (cdr accgs) state))))
+
+(defun-raw print-accg-edges (col accgs state)
+  (if (endp accgs)
+      state
+    (mv-let
+     (col state)
+     (fmt1 "The Calling Context Graph has the following edges:~|"
+          nil col *standard-co* state nil)
+     (declare (ignore col))
+     (print-accg-edges1 accgs state))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; the following code is for building a CCG
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; limit-induction-hint-fn limits the amount of time spent on a proof
+;;; attempt by limiting the amount of induction and subgoals that may
+;;; be considered before the prover gives up. This is done with
+;;; computed hintus.
+(defun limit-induction-hint-fn (i)
+  ;; this computed hint has two pieces. the first limits induction,
+  ;; the second limits subgoals in order to avoid infinite loops.
+  `(or (and (length-exceedsp (car id) ,i) ;;if we are i inductions deep
+            (endp (cdadr id))             ;;and we are not in a subgoal of an induction
+            (eq (cddr id) 0)              ;;and we haven't done anything with the current subgoal yet,
+            '(:computed-hint-replacement t :do-not-induct :otf-flg-override));; do not induct any further.
+       (and (> (cddr id) 20) ;; if we have been working on the same subgoal for 20 steps with no induction or case splitting,
+            '(:computed-hint-replacement t
+                                         :do-not '(eliminate-destructors
+                                                   eliminate-irrelevance
+                                                   generalize fertilize) ;; turn off all proof methods
+                                         ;; Pete: put a quote in front of (eliminate ...) above since that generated an error 
+                                         :in-theory (theory 'minimal-theory))))) ;; and use minimal theory
+
+(defun translated-limit-induction-hint (i)
+  `((eval-and-translate-hint-expression
+     "CCG Query" nil
+     (cons
+      'nil
+      (cons
+       ((lambda
+          (i id)
+          (if
+              (if
+                  (length-exceedsp (car id) i)
+                  (if
+                      (endp (cdr (car (cdr id))))
+                      (if (eq (cdr (cdr id)) '0)
+                          '(:computed-hint-replacement t
+                                                       :do-not-induct :otf-flg-override)
+                        'nil)
+                    'nil)
+                'nil)
+              (if
+                  (length-exceedsp (car id) i)
+                  (if
+                      (endp (cdr (car (cdr id))))
+                      (if (eq (cdr (cdr id)) '0)
+                          '(:computed-hint-replacement t
+                                                       :do-not-induct :otf-flg-override)
+                        'nil)
+                    'nil)
+                'nil)
+            (if (< '20 (cdr (cdr id)))
+                '(:computed-hint-replacement
+                  t
+                  :do-not '(eliminate-destructors eliminate-irrelevance
+                                                  generalize fertilize)
+                  :in-theory (theory 'minimal-theory))
+              'nil)))
+        ',i
+        id)
+       (cons state 'nil))))))
+
+;;;ccg-simplify-contexts;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw ccg-negate (exp)
+  ;; returns expression corresponding to the negation of expression exp.
+  (if (and (consp exp)
+           (eq (first exp) 'not))
+      (second exp)
+    `(not ,exp)))
+
+(defun-raw ccg-addlist (lst)
+  ;; creates a macro-expanded expression corresponding to the sum of a
+  ;; list of expressions.
+  (cond ((endp lst) 0)
+        ((endp (cdr lst)) (car lst))
+        (t `(binary-+ ,(car lst) ,(ccg-addlist (cdr lst))))))
+
+
+(defun-raw ccg-count-contexts (tms)
+  ;; given a list of lists of items, returns the total number of items.
+  (let ((i 0))
+    (dolist (tm tms i)
+      (setf i (+ i (len tm))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; helper functions                                           ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; The following code implements memoization. Currently this works as
+;;; follows. At the beginning of termination analysis, we create a
+;;; memoization struct with the default values for each list. At each
+;;; prover query that is not built-in-clauses only, we check the prove
+;;; list to see if any previously proved query subsumes our current
+;;; goal. If so, we know our goal is true. Otherwise, we check our
+;;; current goal against those previously unproven using 1 induction
+;;; and, if our current restrictions indicate that we should only use
+;;; 0 inductions, those previously unproven using 0 inductions. Here
+;;; we check for equality (modulo alpha renaming) rather than
+;;; subsumption, due to the fact that ACL2 is not a decision
+;;; procedure, but relies on heuristics to guide proofs. Hence, ACL2
+;;; might fail to prove a given theorem but succeed in proving a more
+;;; general version.  Therefore, unless we find the same query (modulo
+;;; alpha renaming) in our unproved lists, we try the proof anyway.
+;;;
+;;; When a ACL2 is done with a query, we add it to proved, unproved0,
+;;; or unproved1 depending on whether the proof attempt was successful
+;;; (and if it was not successful, how many inductions were tried).
+;;;
+;;; Possible improvements:
+;;;
+;;; * instead of proving queries on the fly, perhaps we could collect
+;;;   all the queries and sort them from most to least general. That
+;;;   way, if we prove a query, we get for free all the queries that
+;;;   it generalizes.
+;;;
+;;; * can we do some preprocessing on the queries before we compare
+;;;   them for subsumption? The current subsumption checks are simple
+;;;   syntactic comparisons.
+;;;
+;;; * we can use random testing to discover queries that are provably
+;;;   false. We can then have another list, false-queries that we can
+;;;   check against. When doing so, we can safely check subsumption
+;;;   rather than equality, making it much more powerful than the
+;;;   current unproved checks.
+
+(defun-raw subsumed-by-proved-clause (cl proved)
+  (and (consp proved)
+       (or (eq t (subsumes *init-subsumes-count* (car proved) cl nil))
+           (subsumed-by-proved-clause cl (cdr proved)))))
+
+(defun-raw eliminate-subsumed-tail (cl cl-set acc)
+  (if (endp cl-set)
+      acc
+    (eliminate-subsumed-tail cl (cdr cl-set)
+                             (if (subsumes *init-subsumes-count*
+                                           cl (car cl-set) nil)
+                                 acc
+                               (cons (car cl-set) acc)))))
+
+(defun-raw add-proved-clause (cl proved)
+  (cons cl (eliminate-subsumed-tail cl proved nil)))
+
+(defun-raw equals-unproved-clause1 (cl unproved)
+  ;; note, it is logically sufficient to check that cl subsumes some
+  ;; unproved clause to say that if the unproved clause is unproveable
+  ;; in the current theory, that cl will also be unproveable. However,
+  ;; we are talking about clauses that ACL2 was unable to prove under
+  ;; a set of restrictions. Given ACL2's heuristics and proving
+  ;; algorithm, it is possible that adding hypotheses might lead ACL2
+  ;; astray. Therefore, we want to attempt the proof unless we were
+  ;; unsuccessful proving the exact same query.
+  (and (consp unproved)
+       (or (let ((cl-unproved (car unproved)))
+             (and (eq t (subsumes *init-subsumes-count* cl cl-unproved nil)) 
+                  (eq t (subsumes *init-subsumes-count* cl-unproved cl nil))))
+           (equals-unproved-clause1 cl (cdr unproved)))))
+
+(defun-raw equals-unproved-clause (cl unproved i)
+  ;; checks if we already failed to prove cl using an induction depth of i or
+  ;; higher. 
+  (and (< i (array-dimension unproved 0))
+       (or (equals-unproved-clause1 cl (aref unproved i))
+           (equals-unproved-clause cl unproved (1+ i)))))
+
+;;; time-limit check
+(defmacro-raw time-er (ctx)
+  `(er soft ,ctx "CCG analysis has exceeded the specified time ~
+        limit. If you did not expect a time-limit, check the global ~
+         time-limit setting (see :DOC set-ccg-time-limit and the ~
+         discussion of the :time-limit flag in :DOC CCG) to find out ~
+         more. At this point you have several options:~|~% ~
+         * Set the :don't-guess-ccms flag to t. Sometimes CCG analysis ~
+           guesses too many CCMs which leads to excessive prover ~
+           queries. This will eliminate *all* CCMs other than the ~
+           acl2-count of each formal.~|~%~
+         * Do you see a variable that you don't think is relevant to the ~
+           termination proof? In that case, us the :ignore-formals flag ~
+           to tell the CCG analysis to throw out CCMs that contain that ~
+           formal. This may also cut down on CCMs and therefore prover ~
+           queries.~|~%~
+         * Finally, if you are willing to wait some more, you ~
+           could try increasing the time limit, or eliminating it by ~
+           setting it to nil."))
+
+
+(defun-raw time-left (stop-time ctx state)
+  (let ((now (get-internal-run-time)))
+    (if (< now stop-time)
+        (value (/ (- stop-time now)
+                  (coerce internal-time-units-per-second 'float)))
+      (time-er ctx))))
+
+(defun-raw time-check (stop-time ctx state)
+  (if (and (posp stop-time)
+           (<= stop-time (get-internal-run-time)))
+      (time-er ctx)
+    (value nil)))
+
+(defmacro-raw maybe-prover-before-stop-time (stop-time ctx state body)
+  `(let ((stop-time ,stop-time))
+     (if (null stop-time)
+         ,body
+       (er-let* ((time-limit (time-left stop-time ,ctx ,state)))
+                (with-prover-time-limit time-limit
+                                        ,body)))))
+
+(defun prove-no-er (term pspv hints ens wrld ctx state)
+  ;; calls prover, catching any error that occurred. Returns the error
+  ;; triple whose value is the cons of the negation of the error value
+  ;; returned by prove (i.e. whether prove successfully proved the
+  ;; query or not) and either nil (if unsuccessful) or the resulting
+  ;; ttree (if successful).
+  (mv-let (er ttree state)
+          (prove term pspv hints ens wrld ctx state)
+          (if er
+              (value (cons nil nil))
+            (value (cons t ttree)))))
+
+;; query is the work-horse of our algorithm. It calls the prover
+;; with the appropriate restrictions to ensure that it does not
+;; attempt to prove termination forever. This function returns an
+;; error triple whose value is the ttree generated by the proof. If
+;; the proof fails, the triple indicates an error.
+
+(defun-raw query (hyps concl pt qspv state)
+  (let* ((stop-time (access query-spec-var qspv :stop-time))
+         (mem (access query-spec-var qspv :mem))
+         (otf-flg (access query-spec-var qspv :otf-flg))
+         (ens (access query-spec-var qspv :ens))
+         (ctx (access query-spec-var qspv :ctx))
+         (wrld (access query-spec-var qspv :wrld))
+         (clause (add-literal concl (dumb-negate-lit-lst hyps) t))
+         (bic-onlyp (equal pt :built-in-clauses))
+         (ind-limit (if bic-onlyp -1 (cadr pt)))
+         (displayed-goal (prettyify-clause-set (list clause)
+                                               (let*-abstractionp state)
+                                               wrld)))
+    (pprogn (ccg-io? query nil state
+                     (bic-onlyp ind-limit clause wrld)
+                     (fms "We now make the following query, using ~
+                           proof-technique ~x0 (see :DOC ~
+                           CCG-hierarchy)~#1~[~/ and with the otf-flg set to ~
+                           ~x2~]:~|~%GOAL~%~Y34."
+                          `((#\0 . ,pt)
+                            (#\1 . ,(if bic-onlyp 0 1))
+                            (#\2 . ,otf-flg)
+                            (#\3 . ,displayed-goal)
+                            (#\4 . ,(term-evisc-tuple nil state)))
+                          (proofs-co state)
+                          state
+                          nil))
+            (er-let*
+             ((pair
+               (cond (bic-onlyp
+                      ;; if the proof-technique tells us to only use built-in-clauses, we call built-in-clause-p
+                      (mv-let (built-in-clausep ttree)
+                              (built-in-clausep 'query clause ens (match-free-override wrld) wrld state)
+                              (value (if built-in-clausep
+                                         (cons t ttree)
+                                       (cons nil nil)))))
+                     ;; have we already proved a more general query?
+                     ((subsumed-by-proved-clause clause (memoization-proved mem))
+                      (pprogn
+                       (ccg-io? query nil state
+                                ()
+                                (fms "But we see that this query is already ~
+                                      subsumed by another query that was ~
+                                      previously proven.~%~%"
+                                     nil
+                                     (proofs-co state)
+                                     state
+                                     nil))
+                       (value (cons t nil))))
+                     ;; have we already failed to prove this query using the same proof techniques?
+                     ((equals-unproved-clause clause 
+                                              (memoization-unproved mem)
+                                              ind-limit)
+                      (pprogn
+                       (ccg-io? query nil state
+                                ()
+                                (fms "But we see that we already tried and ~
+                                      failed to prove an equivalent query ~
+                                      using the same restrictions on the ~
+                                      theorem prover.~%~%"
+                                     nil
+                                     (proofs-co state)
+                                     state
+                                     nil))
+                       (value (cons nil nil))))
+                     (t
+                      ;; otherwise, we we need to call prove.
+                      (er-let*
+                       ((pair
+                         (let ((hints (translated-limit-induction-hint ind-limit)))
+                           (maybe-prover-before-stop-time
+                            stop-time ctx state
+                            (prove-no-er (termify-clause-set (list clause))
+                                         (make-pspv ens wrld
+                                                    :displayed-goal displayed-goal
+                                                    :otf-flg otf-flg)
+                                         hints ens wrld ctx state)))))
+                       (progn
+                         ;; update the memoization
+                         (if (car pair)
+                             (setf (memoization-proved mem)
+                                   (add-proved-clause clause
+                                                      (memoization-proved mem)))
+                           (setf (aref (memoization-unproved mem)
+                                       ind-limit)
+                                 (cons clause
+                                       (aref (memoization-unproved mem)
+                                             ind-limit))))
+                         (value pair)))))))
+             (pprogn
+              (ccg-io? query nil state
+                       ()
+                       (fms "ACL2 has ~#0~[SUCCEEDED in proving this ~
+                             query~/FAILED to prove this query~].~|"
+                            (list (cons #\0 (if (car pair) 0 1)))
+                            (proofs-co state)
+                            state
+                            nil))
+              (er-progn
+               (time-check stop-time ctx state)
+               (if (car pair)
+                   (accumulate-ttree-and-step-limit-into-state 
+                    (cdr pair) 
+                    :skip;(initial-step-limit wrld state)
+                    state)
+                 (pprogn
+                  (erase-gag-state state)
+                  (value nil)))
+               (value (car pair))))))))
+
+;; the following two functions, ccg-generic-dfs-visit and
+;; ccg-generic-dfs perform a depth-first search of a "generic"
+;; directed graph. That is, a graph that is represented as an array of
+;; nodes with some way to get a list of adjacent nodes
+;; (node-fwd-edges) and some way, given an edge to get the index of
+;; the node that it points to (edge-head). The algorithm itself is
+;; taken directly out of the CLRS algorithms book.
+
+(defun-raw ccg-generic-dfs-visit (u graph f color time node-fwd-edges edge-head)
+  (setf (aref color u) 'grey)
+  (dolist (vn (funcall node-fwd-edges (aref graph u)))
+    (let ((v (funcall edge-head vn)))
+      (when (eq (aref color v) 'white)
+        (setf time (ccg-generic-dfs-visit v graph f color time node-fwd-edges edge-head)))))
+  (setf (aref color u) 'black)
+  (setf (aref f time) u)
+  (incf time))
+
+(defun-raw ccg-generic-dfs (graph node-fwd-edges edge-head)
+  ;; this is the main generic DFS function. See the comment before the
+  ;; previous function for a description of the arguments. This
+  ;; function returns an array of indices indicating the order that
+  ;; the nodes of the graph were visited. That is, the ith element of
+  ;; the return value is the index of the ith node visited.
+  (let* ((size (array-total-size graph))
+         (f (make-array size :element-type 'fixnum))
+         (time 0)
+         (color (make-array size
+                            :element-type '(member white grey black)
+                            :initial-element 'white)))
+    (dotimes (i size f)
+      (when (eq (aref color i) 'white)
+        (setf time (ccg-generic-dfs-visit i graph f color time node-fwd-edges edge-head))))))
+
+;;; The next two functions, like the previous two, operate on a
+;;; "generic" graph that is represented as an array of
+;;; nodes. Together, they implement an SCC analysis. The algorithm
+;;; used here is straight from the CLRS algorithm book.
+
+(defun-raw ccg-generic-scc-aux (u graph scc scc-array scc-num color node-bwd-edges edge-tail)
+  ;; this is the helper function for ccg-generic-scc. u is the index
+  ;; of the current node. graph is the array of nodes in the
+  ;; graph. scc is the list of nodes in the scc that we are building.
+  (let ((scc scc))
+    (setf (aref color u) 'grey)
+    (dolist (vn (funcall node-bwd-edges (aref graph u)))
+      (let ((v (funcall edge-tail vn)))
+        (when (eq (aref color v) 'white)
+          (setf scc
+                (ccg-generic-scc-aux v graph scc scc-array scc-num color
+                                     node-bwd-edges edge-tail)))))
+    (setf (aref color u) 'black)
+    (setf (aref scc-array u) scc-num)
+    (cons u scc)))
+
+(defun-raw ccg-generic-scc (graph node-fwd-edges node-bwd-edges edge-tail edge-head)
+  ;; this is the main scc algorithm. graph is the array of nodes
+  ;; representing the graph to be analyzed. node-fwd-edges is a
+  ;; function that takes a node from the graph and returns the list of
+  ;; the edges for which the given node is the tail. node-bwd-edges
+  ;; takes a node from the graph and returns the list of edges for
+  ;; which the given node is the head. edge-tail takes an edge and
+  ;; returns the index in graph that corresponds to the tail of the
+  ;; edge. edge-head takes an edge nad returns the index in graph that
+  ;; corresponds to the head of the edge. the function returns a list
+  ;; of lists of the nodes such that each list lists all the nodes in
+  ;; one scc, as well as an array indicating which scc each node
+  ;; belongs to.
+  (let ((scc-num -1))
+    (loop
+     with f = (ccg-generic-dfs graph node-fwd-edges edge-head)
+     with size = (array-dimension graph 0)
+     with color = (make-array size
+                              :element-type '(member black grey white)
+                              :initial-element 'white)
+     with scc-array = (make-array size
+                                  :element-type 'fixnum
+                                  :initial-element 0)
+     for i from (1- size) downto 0
+     for u = (aref f i)
+     when (eq (aref color u) 'white)
+     collect (ccg-generic-scc-aux u graph nil scc-array (incf scc-num) color
+                                  node-bwd-edges edge-tail)
+     into sccs
+     finally (return (values sccs scc-array)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; building an accg          ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw accg-can-omit-edge? (node1 node2 hlevel qspv state)
+  ;; given two ACCG nodes, node1 and node2, such that the function called by
+  ;; the call of node1 is equal to the fn of node2, as well as a
+  ;; ccg-restrict struct, and proof-related stuff (ens, wrld, ctx,
+  ;; state), this function attempts to prove that it is impossible to
+  ;; end up at node2 directly after visiting node1. We do this by
+  ;; attempting to prove that the ruler of node1 implies the negation of
+  ;; the ruler of node2 after the formals of the fn of node2 have been
+  ;; replaced by the actuals of the call of node1. if this can be
+  ;; proven, we return nil, otherwise, we return t.  
+  (if (hlevel-ccmfs-per-nodep hlevel)
+      (value nil)
+    (query (append (accg-node-ruler node1)
+                   (subcor-var-lst (accg-node-formals node2)
+                                   (fargs (accg-node-call node1))
+                                   (accg-node-ruler node2)))
+           nil
+           (hlevel-proof-technique hlevel) qspv state)))
+
+(defun-raw accg-fill-in-edges (accg name-node-alist)
+  (loop for i from 0 below (array-dimension accg 0)
+        for node1 = (aref accg i)
+        for successors = (cdr (assoc (accg-node-callfn node1)
+                                     name-node-alist))
+        do (setf (accg-node-fwd-edges node1)
+                 (loop for node2 in successors
+                       for j = (accg-node-num node2)
+                       for edge = (make-accg-edge :tail i :head j)
+                       do (setf (accg-node-bwd-edges node2)
+                                (cons edge (accg-node-bwd-edges node2)))
+                       collect edge))))
+                       
+(defun-raw context-to-accg-node-lst (contexts total)
+  (if (endp contexts)
+      (mv nil total)
+    (mv-let
+     (nodes ntotal)
+     (context-to-accg-node-lst (cdr contexts) total)
+     (let ((node (make-accg-node :context (car contexts))))
+       (mv (cons node nodes) (cons node ntotal))))))
+
+(defun-raw ccg-build-accg0 (names contexts)
+  (if (endp names)
+      (mv nil nil)
+    (let ((name (car names))
+          (context-list (car contexts)))
+      (mv-let
+       (alist total)
+       (ccg-build-accg0 (cdr names) (cdr contexts))
+       (mv-let
+        (nodes ntotal)
+        (context-to-accg-node-lst context-list total)
+        (mv (acons name nodes alist)
+            ntotal))))))
+
+(defun-raw ccg-build-accg (names contexts)
+  ;; given the names of the functions being analyzed, the contexts
+  ;; organized as a list of lists of contexts such that the ith list
+  ;; in contexts corresponds to the list of contexts in the ith
+  ;; function in names, the ccg-restrict struct restrict, and the
+  ;; other proof-related stuff, we build an ACCG.
+  (mv-let
+   (name-node-alist accg-node-lst)
+   (ccg-build-accg0 names contexts)
+   (let ((accg (coerce accg-node-lst 'vector)))
+     (progn
+       (loop for i from 0 below (array-dimension accg 0)
+           do (setf (accg-node-num (aref accg i)) i))
+       (accg-fill-in-edges accg name-node-alist)
+       accg))))
+
+(defun-raw simplify-contexts1 (context-lst ens wrld ctx state)
+  (if (endp context-lst)
+      state
+    (mv-let
+     (erp value state)
+     (ccg-simplify-hyps-no-split (context-ruler (car context-lst))
+                                 ctx ens wrld state)
+     (progn
+       (unless erp (setf (context-ruler (car context-lst)) value))
+       (simplify-contexts1 (cdr context-lst) ens wrld ctx state)))))
+
+(defun-raw simplify-contexts (contexts ens wrld ctx state)
+  (if (endp contexts)
+      state
+    (pprogn
+     (simplify-contexts1 (car contexts) ens wrld ctx state)
+     (simplify-contexts (cdr contexts) ens wrld ctx state))))                           
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; annotating accgs (ccmfs)                                   ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; choosing ccms (see CAV paper)        ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun de-propagate (term)
+  (if (eq (fn-symb term) 'ccg-propagate)
+      (fargn term 2)
+    term))
+
+(defun-raw ccg-formal-sizes (formals)
+  ;; given a list of formals, this function returns a list of
+  ;; expressions to calculate the acl2-count of each formal.
+  (loop for x in formals
+        collect `(acl2-count ,x)))
+
+(defun-raw ccg-add-zp-ccm (r formals ccms)
+  ;; if an expression, r -- which will generally correspond to one of
+  ;; the expressions in a ruler -- is (not (zp e)) for some expression
+  ;; e that is not in the list of formals, then we add e to our list
+  ;; of ccms.
+  (cond ((atom r) ccms)
+        ((and (eq (ffn-symb r) 'not)
+              (consp (fargn r 1))
+              (eq (ffn-symb (fargn r 1)) 'zp)
+              ;; NOTE: We could remove th
+              (not (member-eq (fargn (fargn r 1) 1) formals)))
+         (cons (fargn (fargn r 1) 1) ccms))
+        (t ccms)))
+
+
+(defun-raw ccg-add-<-ccm (r formals ccms)
+  ;; if an expression, r -- which will generally correspond to one of
+  ;; the expressions in a ruler -- is one of the following forms, we
+  ;; add the corresponding expression to the ccms:
+  ;;
+  ;; * (< 0 e2) --> (acl2-count e2)
+  ;; * (< e1 e2) --> (acl2-count (- e2 e1))
+  ;; * (not (< e1 0)) --> (1+ (acl2-count e1))
+  ;; * (not (< e1 e2)) --> (1+ (acl2-count (- e1 e2)))
+  (declare (ignore formals))
+  (cond ((atom r) ccms)
+        ((or (eq (car r) '<)
+             (and (eq (car r) 'not)
+                  (consp (second r))
+                  (eq (car (second r)) '<)))
+         (let* ((r0 (if (eq (car r) '<) r (second r)))
+                (p (term-order (second r0) (third r0)))
+                (arg1 (if p (second r0) (third r0)))
+                (arg2 (if p (third r0) (second r0))))
+           (cond ((and (quotep arg1) (quotep arg2))
+                  ccms)
+                 ((not (or (quotep arg1) (quotep arg2)))
+                  (cons `(acl2-count (binary-+ '1
+                                               (binary-+ ,arg2
+                                                         (unary-- ,arg1))))
+                        ccms))
+                 ((and (quotep arg1) (acl2-numberp (unquote arg1)))
+                  (if (and (or (eql (unquote arg1) 0)
+                               (eql (unquote arg1) 1))
+                           (variablep arg2))
+                      ccms
+                    (cons `(acl2-count (binary-+ (quote ,(- 1 (unquote arg1))) ,arg2))
+                          ccms)))
+                 ((and (quotep arg2) (acl2-numberp (unquote arg2)))
+                  (if (and (or (eql (unquote arg2) 0) 
+                               (eql (unquote arg2) 1))
+                           (variablep arg1))
+                      ccms
+                    (cons `(acl2-count (binary-+ (quote ,(- 1 (unquote arg2))) ,arg1))
+                          ccms)))
+                 (t
+                  ccms))))
+        (t ccms)))
+
+(defun-raw ccg-add-dec-ccm (arg ccms)
+  ;; a rule for adding a ccm that is not very helpful in general, but
+  ;; illustrates how it might be useful, in the future, to allow users
+  ;; to define their own rules for adding ccms. given an expression
+  ;; that should correspond to an argument of the call of a context,
+  ;; adds arg to the list of ccms if it is of the form (dec e).
+  (if (and (consp arg)
+           (eq (car arg) 'dec))
+      (cons arg ccms)
+    ccms))
+
+(defun-raw accg-guess-ccms-for-node (node)
+  ;; given a node, guesses ccms beyond the basic acl2-count of the
+  ;; formals.
+  (let ((ccms nil)
+        (rulers (accg-node-ruler node))
+        (formals (accg-node-formals node)))
+    (dolist (r rulers ccms)
+      (setf ccms (ccg-add-<-ccm r formals ccms))
+      (setf ccms (ccg-add-zp-ccm r formals ccms)))
+;;     (dolist (a (fargs (accg-node-call node)) ccms)
+;;       (setf ccms (ccg-add-dec-ccm a ccms)))
+    ))
+
+(defun-raw ccg-remove-duplicate-ccms-in-functs (functs)
+  ;; a function for removing any duplicate ccms in an array of lists of ccms.
+  (dolist (funct functs functs)
+    (setf (funct-ccms funct)
+          (remove-duplicates (funct-ccms funct)
+                             :test #'equal
+                             :key #'de-propagate))))
+
+(defun-raw ccg-remove-duplicate-ccms (ccms)
+  ;; a function for removing any duplicate ccms in an array of lists of ccms.
+  (let ((n (array-dimension ccms 0)))
+    (dotimes (i n ccms)
+      (setf (aref ccms i) (remove-duplicates (aref ccms i)
+                                             :test #'equal
+                                             :key #'de-propagate)))))
+
+;; when we guess ccms beyond the basic acl2-count of the formals of a
+;; function, we need to propagate the ccms throughout the accg. for
+;; example, suppose we have two functions, f and g, such that f
+;; contains the call (g x y) when (not (zp (- y x))) and g always
+;; calls (f (1+ x) y). then f will get assigned the ccm (- y x), but g
+;; will only have (acl2-count x) and (acl2-count y). in this
+;; situation, there will be no way to tell that (- y x) decreases each
+;; time through the loop. we need some sort of "place-holder" to keep
+;; track of the value of (- y x) when we are in the function g. the
+;; next few functions do this by walking backwards through the graph,
+;; visiting each node just once, and adding the ccm resulting in
+;; substituting actuals for formals in the non-trivial ccms from the
+;; next node. in our example, g would get the ccm (- y (1+ x)).
+
+ 
+
+(defun-raw accg-propagate-ccm (ccm accg n consider-onlyp)
+  ;; propagates a single ccm through the accg. here ccm is the ccm
+  ;; expression, accg is the accg, n is the index of the node to which
+  ;; the ccm is assigned, and consider-onlyp is an array of booleans
+  ;; that tells us whether the user supplied the ccms using a
+  ;; :CONSIDER-ONLY-CCMS hint or not for each node. this is done in a
+  ;; breadth-first order to ensure the shortest propagation paths and
+  ;; therefore simpler ccms in general.
+  (let* ((size (array-dimension accg 0))
+         ;; queued tells us if node i has been added to the queue for
+         ;; each 0 <= i < size.
+         (queued (make-array size :element-type 'boolean :initial-element nil))
+         ;; successor tells us the index of the successor of node i
+         ;; from which we propagate the ccm.
+         (successor (make-array size :element-type 'integer :initial-element 0))
+         ;; ccms is an array assigning each node index, i, to the ccm
+         ;; for that node.
+         (ccms (make-array size :initial-element nil))
+         ;; queue is the queue into which we put the indices of the
+         ;; nodes we are to visit in the order in which we are to
+         ;; visit them. the initial element is -1 so we know when we
+         ;; reach the end of the queue.
+         (queue (make-array size :element-type 'integer :initial-element -1))
+         (c (accg-node-context-num (aref accg n)))
+         ;; i is the index of the queue where the next enqueue
+         ;; operation should put the next node index.
+         (i 0)
+         ;; queue-preds is a small function that puts all the unqueued
+         ;; predecessors of node m into the queue.
+         (queue-preds (lambda (m)
+                        (loop for edge in (accg-node-bwd-edges (aref accg m))
+                              for pred = (accg-edge-tail edge)
+                              unless (or (aref queued pred)
+                                         (aref consider-onlyp pred))
+                                do (setf (aref queued pred) t)
+                                and do (setf (aref queue (incf i)) pred)
+                                and do (setf (aref successor pred) m)))))
+    (let ((node (aref accg n)))
+      (setf (accg-node-ccms node)
+            (cons ccm (accg-node-ccms node)))
+      (setf (aref ccms n) ccm))
+    (setf (aref queued n) t)
+    (funcall queue-preds n)
+    (loop for j from 1 below size
+          for k = (aref queue j)
+          when (= k -1) ;; if we get a -1, we have reached the end of the queue.
+            return nil
+          do (let* ((succ (aref successor k))
+                    (node (aref accg k))
+                    ;; we substitute actuals for formals in the ccm of the
+                    ;; successor to get the new ccm.
+                    (nccm (subcor-var (accg-node-callformals node)
+                                      (fargs (accg-node-call node))
+                                      (aref ccms succ))))
+               (setf (aref ccms k) nccm))
+          do (funcall queue-preds k))
+    (loop for j from 1 below size
+          for k = (aref queue j)
+          when (= k -1)
+            return nil
+          do (let ((node (aref accg k)))
+               (setf (accg-node-ccms node)
+                     (cons `(ccg-propagate ,c ,(aref ccms k))
+                           (accg-node-ccms node)))))))
+
+(defun-raw accg-propagate-ccms (ccms accg consider-onlyp)
+  ;; (print ccms) accg-propagate-ccms propagates all the ccms in ccms
+  ;; throughout the accg. here, ccms is an array of lists of ccms
+  ;; corresponding to the ccms assigned to each node in the
+  ;; accg. consider-onlyp is an array of booleans telling us whether
+  ;; or not the user supplied the ccms using a :CONSIDER-ONLY-CCMS
+  ;; xarg for each node. we return nccms which holds the new list of
+  ;; ccms for each node.
+  (loop with size = (array-dimension ccms 0)
+        for i from 0 below size
+        do (loop for ccm in (aref ccms i)
+                 do (accg-propagate-ccm ccm accg i consider-onlyp))))
+
+(defun-raw accg-partition-ccms-by-function (ccms nodes)
+  ;; in order to compute ccmfs by node instead of by edge, ccms need
+  ;; to be assigned by function, not by accg node. this function takes
+  ;; the ccms assigned to the nodes of a accg and unions all the ccms
+  ;; of the contexts of each function. the result is an alist that
+  ;; maps function names to the ccms for that function.
+  (loop for i from 0 below (array-dimension ccms 0)
+        for funct = (accg-node-parent-funct (aref nodes i))
+        do (setf (funct-ccms funct)
+                 (append (aref ccms i) (funct-ccms funct)))))
+
+(defun-raw accg-guess-ccms (accg functs ccm-hints-alist)
+  ;; accg-guess-ccms puts all the ccm-guessing together. it takes an
+  ;; accg and an alist mapping function names to ccms that is
+  ;; presumably provided by the user. the ccms are computed and then
+  ;; the accg is annotated by setting the accg-node-ccms field of each
+  ;; node in the accg to the appropriate list of ccms.
+  (let* ((size (array-dimension accg 0))
+         (ccms (make-array size :element-type 'list :initial-element nil))
+         (consider-onlyp (make-array size :element-type 'boolean :initial-element nil)))
+    ;; first we fill in the correct values for consider-onlyp for each
+    ;; node depending on whether the user provided ccms using
+    ;; :CONSIDER-ONLY-CCMs for the function containing the node. at
+    ;; the same time, we set the ccms for any node for which the user
+    ;; did supply ccms.
+    (loop for i from 0 below size
+          for entry = (assoc (accg-node-fn (aref accg i))
+                             ccm-hints-alist)
+          do (setf (aref consider-onlyp i) (cadr entry))
+          unless (eq (cddr entry) *0*) ;; no value supplied is represented as *0*.
+            do (setf (aref ccms i) (cddr entry)))
+    ;; guess the non-trivial ccms for each node.
+    (loop for i from 0 below size
+          for node = (aref accg i)
+          unless (or (aref consider-onlyp i)
+                     ;; don't guess ccms for dead-ends.
+                     (endp (accg-node-fwd-edges (aref accg i))))
+            do (setf (aref ccms i)
+                     (append (accg-guess-ccms-for-node node)
+                             (aref ccms i))))
+    ;; next, we propagate the ccms and then partition them by
+    ;; function. finally, we set the ccm list of each node to be the
+    ;; non-trivial ccms for the function plus the acl2-count of each
+    ;; formal of the parent function and the sum of all the formal
+    ;; acl2-counts (if there is more than one formal).
+     (accg-propagate-ccms
+      (ccg-remove-duplicate-ccms ccms)
+      accg
+      consider-onlyp)
+    (ccg-remove-duplicate-ccms-in-functs functs)
+    (loop for funct in functs
+          for fn-sccms in ccm-hints-alist
+          for fsizes = (ccg-formal-sizes (funct-formals funct))
+;;; I've commented out the next line to avoid a compiler warning.
+;         for ccms = (funct-ccms funct)
+          unless (cadr fn-sccms)
+            do (setf (funct-ccms funct)
+                     (append fsizes
+                             (if (length-exceedsp fsizes 1)
+                                 (cons (ccg-addlist fsizes)
+                                       (funct-ccms funct))
+                               (funct-ccms funct))))
+          finally (ccg-remove-duplicate-ccms-in-functs functs))
+    ;; finally, we coerce the ccms for each function from lists into vectors
+    (loop for funct in functs
+          do (setf (funct-ccms funct)
+                   (coerce (funct-ccms funct) 'vector)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; accg annotation (ccmfs)        ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw ccmf->-value? (ruler e1 e2 pt qspv state)
+  ;; returns true if we can prove that, under the ruler conditions, e2
+  ;; will always be o< e1.
+  (query ruler `(o< ,(de-propagate e2) ,(de-propagate e1))
+         pt qspv state))
+
+(defun-raw ccmf->=-value? (ruler e1 e2 pt qspv state)
+  ;; returns true if we can prove that, under the ruler conditions, e1
+  ;; will never be o< e2.
+  (query ruler `(not (o< ,(de-propagate e1) ,(de-propagate e2)))
+         pt qspv state))
+
+(defun-raw ccmf-skip-edge (f1 n1 c1 e1 f2 n2 e2 hlevel)
+  ;; returns whether, based on the restrictions indicated by the
+  ;; ccg-restrict struct, restrict, we should skip creating a ccmf
+  ;; edge for the ccms e1 and e2. this is mostly based on the
+  ;; ccg-restrict-measure-vars field.
+
+
+  ;; (format t "ccmf-skip-edge: ~A ~A~%~%" e1 e2)
+  (or (null hlevel)
+      (eq (fn-symb e1) 'ccg-propagated)
+      (and (eq (fn-symb e2) 'ccg-propagated)
+           (not (equal (fargn e2 1) c1)))
+      ;; NOTE: we used to think that built-in-clauses are so fast, we don't
+      ;; need to skip any. However, we came across some very expensive analyses
+      ;; (see one-way-unify1 in the foundations book in the paco directory of
+      ;; the regression suite).
+      (and ;;(not (ccg-restrict-bic-onlyp restrict))
+           (let ((v1 (all-vars e1)) ;; v1 is all the variables in e1
+                 (v2 (all-vars e2))) ;; v2 is all the variables in e2
+             (and (not (and (eq f1 f2)
+                            (= n1 n2)))
+                  (case (hlevel-ccm-comparison-scheme hlevel)
+                    ;; (:across
+                    ;;  (not (and (subsetp v1 v2)
+                    ;;            (subsetp v2 v1))))
+                    ;; ;; if :equal, we skip if the variable sets are not equal.
+                    (:equal
+                     (not (and (subsetp v1 v2)
+                               (subsetp v2 v1))))
+                    ;; if :all, we skip if v1 is not a proper subset of v2.
+                    (:all
+                     (or (subsetp v2 v1)
+                         (not (subsetp v1 v2))))
+                    ;; if :some, we skip if v1 a subset of v2 or v1 and v2 do
+                    ;; not intersect.
+                    (:some
+                     (or (subsetp v1 v2)
+                         (not (intersectp-eq v1 v2))))
+                    ;; if :none, we skip if v1 and v2 intersect.
+                    (:none
+                     (intersectp-eq v1 v2))))))))
+
+(defun-raw accg-copy-ccmf-graph (graph &key (size nil))
+  ;; creates a copy of a ccmf graph
+  (let* ((n (array-dimension graph 0))
+         (ngraph (make-array (if size (max n size) n)
+                             :element-type 'ccmf-node
+                             :initial-element (make-ccmf-node))))
+    (loop for i from 0 below n
+          for node = (aref graph i)
+          do (setf (aref ngraph i)
+                   (make-ccmf-node :>-edges (copy-list (ccmf-node->-edges node))
+                                   :>=-edges (copy-list (ccmf-node->=-edges node)))))
+    ngraph))
+
+(defun-raw accg-add-ccmfs (accg)
+  (loop for node1 across accg
+        for in-sizes = (array-dimension (accg-node-ccms node1) 0)
+        do (loop for edge in (accg-node-fwd-edges node1)
+                 for head = (accg-edge-head edge)
+                 for node2 = (aref accg head)
+                 for graph = (make-array in-sizes)
+                 do (loop for i from 0 below in-sizes
+                          do (setf (aref graph i)
+                                   (make-ccmf-node)))
+                 do (setf (accg-edge-ccmf edge)
+                          (make-ccmf :firstsite (accg-edge-tail edge)
+                                     :lastsite  head
+                                     :fc-num    (accg-node-context-num node1)
+                                     :lc-num    (accg-node-context-num node2)
+                                     :in-sizes  in-sizes
+                                     :out-sizes (array-dimension (accg-node-ccms
+                                                                  node2)
+                                                                 0)
+                                     :graph graph)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+;;; accg sccs        ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw accg-scc (graph)
+  (ccg-generic-scc graph
+                   #'accg-node-fwd-edges #'accg-node-bwd-edges
+                   #'accg-edge-tail #'accg-edge-head))
+
+(defun-raw accg-edge-context-pair (edge accg)
+  (cons (car
+         (accg-node-context-num
+          (aref accg
+                (accg-edge-tail
+                 edge))))
+        (car
+         (accg-node-context-num
+          (aref accg
+                (accg-edge-head
+                 edge))))))
+
+(defun-raw accg-delete-non-scc-edges1 (edges accg scc scc-array)
+  (if (endp edges)
+      (mv nil nil)
+    (mv-let
+     (changes nedges)
+     (accg-delete-non-scc-edges1 (cdr edges) accg scc scc-array)
+     (if (= scc (aref scc-array (accg-edge-head (car edges))))
+         (mv changes (cons (car edges) nedges))
+       (mv (cons (accg-edge-context-pair (car edges) accg)
+                 changes)
+           nedges)))))
+
+(defun-raw accg-delete-non-scc-edges (accg scc-array)
+  (loop with changes = nil
+        for i from 0 below (array-dimension accg 0)
+        for nodei = (aref accg i)
+        for scci = (aref scc-array i)
+        do (mv-let
+            (nchanges nedges)
+            (accg-delete-non-scc-edges1 (accg-node-fwd-edges nodei) accg scci scc-array)
+            (progn
+              (setf (accg-node-fwd-edges nodei) nedges)
+              (setf changes (append nchanges changes))))
+        do (setf (accg-node-bwd-edges nodei)
+                 (delete-if-not #'(lambda (x)
+                                    (= scci
+                                       (aref scc-array
+                                             (accg-edge-tail x))))
+                  (accg-node-bwd-edges nodei)))
+        finally (return changes)))
+
+(defun-raw accg-separate-sccs0 (accg sccs scc-array &key (ccmfp nil))
+  (if (endp (cdr sccs))
+      (mv nil (list accg))
+    (let* ((m (array-dimension accg 0)) ;; the number of nodes in the current accg
+           (n (len sccs))               ;; the number of sccs
+           (count (make-array n ;; an array keeping track of the size of each scc.
+                              :element-type 'fixnum
+                              :initial-element 0))
+           (mapping (make-array m ;; a mapping from the old index of each node to its new index.
+                                :element-type 'fixnum
+                                :initial-element 0))
+           (changes nil))
+      ;; next, we calculate the values of count and the mapping.
+      (loop for i from 0 below m
+            for j = (aref scc-array i)
+            do (setf (aref mapping i) (aref count j))
+            do (incf (aref count j)))
+      ;; naccgs is an array of the new accgs.
+      (let ((naccgs (make-array n)))
+        ;; we set each accg in naccg to be an array of nodes.
+        (loop for i from 0 below n
+              do (setf (aref naccgs i)
+                       (make-array (aref count i))))
+        ;; we now populate naccgs with nodes, setting the
+        ;; accg-node-num and resetting the accg-node-bwd-edges
+        (loop for i from 0 below m
+              for sccn = (aref scc-array i)
+              for noden = (aref mapping i)
+              for node = (aref accg i)
+              do (setf (aref (aref naccgs sccn) noden)
+                       node)
+              do (setf (accg-node-num node) noden)
+              do (setf (accg-node-bwd-edges node) nil))
+        ;; now we fix the edges
+        (loop for i from 0 below n
+              for naccg = (aref naccgs i)
+              do (loop for j from 0 below (aref count i)
+                       for node = (aref naccg j)
+                       ;; we recalculate the accg-node-fwd-edges of node as follows
+                       do (setf (accg-node-fwd-edges node)
+                                (loop for e in (accg-node-fwd-edges node)
+                                      for head = (accg-edge-head e)
+                                      for nhead = (aref mapping head)
+                                      for ccmf = (accg-edge-ccmf e)
+                                      ;; if the edge traverses two
+                                      ;; edges in the same scc,
+                                      if (= (aref scc-array head) i)
+                                      ;; set the head and tail of the edge
+                                      do (setf (accg-edge-head e) nhead)
+                                      and do (setf (accg-edge-tail e) j)
+                                      ;; add the edge to the
+                                      ;; appropriate bwd-edges list
+                                      and do (let ((hnode (aref naccg nhead)))
+                                               (setf (accg-node-bwd-edges hnode)
+                                                     (cons e
+                                                           (accg-node-bwd-edges hnode))))
+                                      ;; collect e into our new list of fwd-edges
+                                      and collect e
+                                      ;; when we need to worry about
+                                      ;; ccmfs, fix this edge's
+                                      ;; ccmf.
+                                      and when ccmfp
+                                      do (setf (ccmf-firstsite ccmf) j)
+                                      and do (setf (ccmf-lastsite ccmf)
+                                                   nhead)
+                                      else do (setf changes
+                                                    (cons 
+                                                     (accg-edge-context-pair e accg)
+                                                     changes))))))
+        ;; finally, we collect all the non-trivial sccs into a list and return it.
+        (mv changes
+            (loop for i from 0 below n
+                  for naccg = (aref naccgs i)
+                  unless (and (= (aref count i) 1)
+                              (not (accg-node-fwd-edges (aref naccg 0))))
+                  collect naccg))))))
+
+(defun-raw accg-separate-sccs (accg &key (ccmfp nil))
+  ;; separates an accg into its sccs. ccmfp indicates whether or not
+  ;; the accg has already been annotated with ccmfs. this function is
+  ;; destructive.
+
+  ;; we start by doing the scc analysis:
+  (multiple-value-bind
+      (sccs scc-array)
+      (accg-scc accg)
+     (accg-separate-sccs0 accg sccs scc-array :ccmfp ccmfp)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; putting it all together ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw build-and-annotate-accgs (names functs contexts ccm-hints-alist)
+  ;; build-and-annotate-accgs does exactly what it says. names is the
+  ;; names of the functions, contexts is a list of lists of contexts
+  ;; such that the ith list in contexts is the list of contexts in the
+  ;; ith function in names. restrict is the current ccg-restrict
+  ;; struct, and ccms-alist is the alist mapping function names to the
+  ;; ccms provided for the user for that function.
+  (let ((accg (ccg-build-accg names contexts)))
+    (multiple-value-bind
+        (sccs scc-array)
+        (accg-scc accg)
+      (progn
+        (accg-delete-non-scc-edges accg scc-array)
+        (accg-guess-ccms accg functs ccm-hints-alist)
+        (accg-add-ccmfs accg)
+        (mv-let
+         (changes0 naccgs)
+         (accg-separate-sccs0 accg sccs scc-array :ccmfp t)
+         (declare (ignore changes0))
+         naccgs)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; refining accgs          ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defun-raw weaker-proof-techniquesp (h1 h2)
+  ;; given two levels in the hierarchy, this function tells us whether the
+  ;; proof-techniques of the first are weaker than the proof-techniques of the
+  ;; second, i.e. that it might be possible to prove something using the proof
+  ;; techniques of h2 that would not be proven using the techniques in h1.
+  
+  
+  (or ;; h1 is nil in our first round of refinement, when their is no
+      ;; previous level to the hierarchy
+   (null h1)
+   (not (null h2)) ;; this should never happen
+   (let ((pt1 (car h1))
+         (pt2 (car h2)))
+     ;; the proof techniques of h1 are weaker if it limited to built-in-clauses
+     ;; while h2 is not:
+     (if (equal pt1 :built-in-clauses)
+         (not (equal pt2 :built-in-clauses))
+       ;; the proof techniques of h1 are weaker if it is of the form
+       ;; (:induction-depth n1), h2 is of the form (:induction-depth n2) and
+       ;; (< n1 n2).
+       (and (consp pt2)
+            (< (cadr pt1)
+               (cadr pt2)))))))
+
+(defun-raw accg-ccmf-adj-matrix (ccmf)
+  ;; given a ccmf, this function builds an adjacency matrix where
+  ;; element i,j is >, >=, or nil if there is a >-edge, >=-edge, or no
+  ;; edge from ccm i of the first context to ccm j of the second index
+  ;; in the ccmf, respectively.
+  (loop with n1 = (ccmf-in-sizes ccmf)
+        with n2 = (ccmf-out-sizes ccmf)
+        with graph = (ccmf-graph ccmf)
+        with matrix = (make-array `(,n1 ,n2)
+                                  :initial-element nil
+                                  :element-type '(member nil '>= '>))
+        for i from 0 below n1
+        for node = (aref graph i)
+        do (loop for j in (ccmf-node->-edges node)
+                 do (setf (aref matrix i j) '>))
+        do (loop for j in (ccmf-node->=-edges node)
+                 do (setf (aref matrix i j) '>=))
+        finally (return matrix)))
+           
+;; currently destructive
+
+(defun-raw accg-refine-ccmf2 (i j matrix node e1 hyps f1 c1 f2 ccms2 cformals args redop
+                                changes old-hlevel hlevel qspv state)
+  (let ((wrld (access query-spec-var qspv :wrld)))
+    (if (< j 0)
+        (value changes)
+      (let* ((o2 (aref ccms2 j))
+             (e2 (subcor-var cformals args o2))
+             (u1 (untranslate e1 nil wrld))
+             (u2 (untranslate o2 nil wrld))
+             (skipp (or (ccmf-skip-edge f1 i c1 e1 f2 j e2 hlevel)
+                        (not (or redop ;; if circumstances tell us to redo the > proof,
+                                 (ccmf-skip-edge f1 i c1 e1 f2 j e2 old-hlevel)))))
+             (label (aref matrix i j))
+             (pt (hlevel-proof-technique hlevel)))
+        (er-let*
+         ((nlabel
+           (cond (skipp (value label))
+                 ((eq label '>) (value '>))
+                 ((equal (de-propagate e1) (de-propagate e2)) (value '>=))
+                 (t
+                  (er-let*
+                   ((result 
+                     (pprogn
+                      (increment-timer 'other-time state)
+                      (ccg-io? build/refine nil state
+                               (u1 u2)
+                               (fms "We attempt to prove that, under the given ~
+                                   conditions, it is the case that the ~
+                                   context measure ~x0 is always greater than ~
+                                   ~x1.~|"
+                                    `((#\0 . ,u1)
+                                      (#\1 . ,u2))
+                                    *standard-co*
+                                    state
+                                    nil))
+                      (increment-timer 'print-time state)
+                      (ccmf->-value? hyps e1 e2 pt qspv state))))
+                   (cond (result (value '>))
+                         ((eq label '>=) (value '>=))
+                         (t
+                          (er-let*
+                           ((result 
+                             (pprogn
+                              (increment-timer 'other-time state)
+                              (ccg-io? build/refine nil state
+                                       (u1 u2)
+                                       (fms "Since the previous query failed, ~
+                                           we attempt to prove that, under ~
+                                           the given conditions,  it is the ~
+                                           case that the context measure ~x0 ~
+                                           is never less than ~x1.~|"
+                                            `((#\0 . ,u1)
+                                              (#\1 . ,u2))
+                                            *standard-co*
+                                            state
+                                            nil))
+                              (increment-timer 'print-time state)
+                              (ccmf->=-value? hyps e1 e2 pt qspv state))))
+                           (value (if result '>= nil))))))))))
+         (progn 
+           ;;(format t "~&e1: ~A e2: ~A label: ~A~%" e1 e2 nlabel)
+           (case nlabel
+             (> (setf (ccmf-node->-edges node)
+                      (cons j (ccmf-node->-edges node))))
+             (>= (setf (ccmf-node->=-edges node)
+                       (cons j (ccmf-node->=-edges node)))))
+           (accg-refine-ccmf2 i (1- j) matrix node e1
+                              hyps f1 c1 f2 ccms2 cformals args redop
+                              (if (eq nlabel label)
+                                  changes
+                                (cons `(,nlabel ,u1 ,u2) changes))
+                              old-hlevel hlevel qspv state)))))))
+
+(defun-raw accg-refine-ccmf1 (i matrix ccmf
+                               hyps f1 ccms1 c1 f2 ccms2 cformals args redop
+                               changes old-hlevel hlevel
+                               qspv state)
+  ;; this function destructively refines a ccmf. note that its
+  ;; signature looks just like that of accg-construct-ccmf-graph,
+  ;; except we have the added arguments redop and old-hlevel, which
+  ;; help us to know when we need to redo proofs we have already done.
+  
+  (if (< i 0)
+      (value (cond ((endp changes) changes)
+                   ((endp (cdr changes)) (car changes))
+                   (t (cons 'and changes))))
+    (er-let*
+     ((changes0 (accg-refine-ccmf2 i (1- (ccmf-out-sizes ccmf)) matrix (aref (ccmf-graph ccmf) i)
+                                   (aref ccms1 i) hyps f1 c1 f2 ccms2 cformals args redop
+                                   changes old-hlevel hlevel qspv state)))
+     (accg-refine-ccmf1 (1- i) matrix ccmf
+                        hyps f1 ccms1 c1 f2 ccms2 cformals args redop
+                        changes0 old-hlevel hlevel qspv state))))
+
+(defun-raw accg-refine-ccmf (ccmf hyps f1 ccms1 c1 f2 ccms2 cformals args redop
+                               old-hlevel hlevel qspv state)
+  (let ((matrix (accg-ccmf-adj-matrix ccmf)))
+    (loop for node across (ccmf-graph ccmf)
+          do (setf (ccmf-node->-edges node) nil)
+          do (setf (ccmf-node->=-edges node) nil))
+    (accg-refine-ccmf1 (1- (ccmf-in-sizes ccmf)) matrix
+                       ccmf hyps f1 ccms1 c1 f2 ccms2 cformals args redop
+                       nil old-hlevel hlevel qspv state)))
+
+(defun-raw accg-node-refine-ccmfs-per-edge
+  (edges node1 accg ccms1 c1 ruler1 cformals args
+         stronger-proofsp changes old-hlevel hlevel
+         qspv state)
+  (if (endp edges)
+      (value changes)
+    (let* ((edge (car edges))
+           (node2 (aref accg (accg-edge-head edge)))
+           (ccms2 (accg-node-ccms node2))
+           (ruler2 (subcor-var-lst cformals args (accg-node-ruler node2)))
+           (wrld (access query-spec-var qspv :wrld)))
+      (pprogn
+       (increment-timer 'other-time state)
+       (ccg-io? build/refine nil state
+                (node1 ruler1 wrld node2)
+                (fms "We use theorem prover queries to discen how the context ~
+                      measures change when execution moves from call ~x0 in ~
+                      function ~x1 under the ruler ~x2 to call ~x3 in ~
+                      function ~x4 under the ruler ~x5.~|"
+                     `((#\0 . ,(accg-node-call node1))
+                       (#\1 . ,(accg-node-fn node1))
+                       (#\2 . ,(untranslate-lst ruler1 nil wrld))
+                       (#\3 . ,(accg-node-call node2))
+                       (#\4 . ,(accg-node-fn node2))
+                       (#\5 . ,(untranslate-lst (accg-node-ruler node2) nil wrld)))
+                     *standard-co*
+                     state
+                     nil))
+       (increment-timer 'print-time state)
+       (er-let*
+        ((nchanges (accg-refine-ccmf (accg-edge-ccmf edge)
+                                     (append ruler1 ruler2)
+                                     (accg-node-fn node1)
+                                     ccms1
+                                     c1
+                                     (accg-node-fn node2)
+                                     ccms2
+                                     cformals args
+                                     stronger-proofsp
+                                     old-hlevel hlevel
+                                     qspv state)))
+        (accg-node-refine-ccmfs-per-edge
+         (cdr edges) node1 accg ccms1 c1 ruler1
+         cformals args 
+         stronger-proofsp
+         (if (null nchanges)
+             changes
+           (acons (cons (car (accg-node-context-num node1))
+                        (car (accg-node-context-num node2)))
+                  nchanges
+                  changes))
+         old-hlevel hlevel
+         qspv state))))))
+
+(defun-raw accg-refine-ccmfs1 (i accg stronger-proofsp changes
+                                 old-hlevel hlevel qspv state)
+  ;; refines all the ccmfs in an accg.
+  (if (< i 0)
+      (value changes)
+    (let* ((node1 (aref accg i))
+           (ccms1 (accg-node-ccms node1))
+           (c1 (accg-node-context-num node1))
+           (ruler1 (accg-node-ruler node1))
+           (cformals (accg-node-callformals node1))
+           (args (fargs (accg-node-call node1)))
+           (wrld (access query-spec-var qspv :wrld)))
+      (er-let*
+       ((changes0
+         (if (hlevel-ccmfs-per-nodep hlevel)
+             ;; if we are creating/refining ccmfs on a per-node basis
+             ;; (rather than per-edge), we refine one ccmf for the node and
+             ;; propagate its graph to the ccmf of every edge.
+             (pprogn
+              (ccg-io? build/refine nil state
+                       (c1 ruler1 wrld)
+                       (fms "We use theorem prover queries to discern how our ~
+                             context mesaures change when execution moves ~
+                             across call ~x0 in function ~x1 under the ruler ~
+                             ~x2.~|"
+                            `((#\0 . ,(accg-node-call node1))
+                              (#\1 . ,(accg-node-fn node1))
+                              (#\2 . ,(untranslate-lst ruler1 nil wrld)))
+                            *standard-co*
+                            state
+                            nil))
+              (er-let*
+               ((edge1 (value (car (accg-node-fwd-edges node1))))
+                (node2 (value (aref accg (accg-edge-head edge1))))
+                (ccmf (value (accg-edge-ccmf (car (accg-node-fwd-edges node1)))))
+                (nchanges (accg-refine-ccmf ccmf
+                                            ruler1
+                                            (accg-node-fn node1)
+                                            ccms1
+                                            c1
+                                            (accg-node-fn node2)
+                                            (accg-node-ccms node2)
+                                            cformals args
+                                            stronger-proofsp
+                                            old-hlevel hlevel
+                                            qspv state))
+                (ngraph (value (ccmf-graph ccmf))))
+               (loop for edge in (cdr (accg-node-fwd-edges node1))
+                     for occmf = (accg-edge-ccmf edge)
+                     do (setf (ccmf-graph occmf)
+                              (accg-copy-ccmf-graph ngraph))
+                     finally (return (value (if (null nchanges)
+                                                changes
+                                              (acons (car (accg-node-context-num
+                                                           node1))
+                                                     nchanges
+                                                     changes)))))))
+           ;; if we are creating/refining ccmfs on a per-edge basis, we
+           ;; refine the ccmf of each edge seperately.
+           (accg-node-refine-ccmfs-per-edge (accg-node-fwd-edges node1)
+                                            node1 accg ccms1 c1 ruler1 cformals args
+                                            stronger-proofsp changes old-hlevel hlevel
+                                            qspv state))))
+       (accg-refine-ccmfs1 (1- i) accg stronger-proofsp changes0 old-hlevel hlevel
+                           qspv state)))))
+      
+(defun-raw accg-refine-ccmfs (accg stronger-proofsp old-hlevel hlevel
+                                   qspv state)
+  (accg-refine-ccmfs1 (1- (array-dimension accg 0)) accg stronger-proofsp nil
+                      old-hlevel hlevel
+                      qspv state))
+
+(defun-raw accg-refine-ccmfs-lst1 (accgs caccgs uaccgs changes stronger-proofsp
+                                         old-hlevel hlevel qspv state)
+  (if (endp accgs)
+      (value (list* changes caccgs uaccgs))
+    (er-let*
+     ((accg (value (car accgs)))
+      (nchanges (accg-refine-ccmfs accg stronger-proofsp old-hlevel hlevel
+                                   qspv state)))
+     (accg-refine-ccmfs-lst1 (cdr accgs)
+                             (if (consp nchanges)
+                                 (cons accg caccgs)
+                               caccgs)
+                             (if (consp nchanges)
+                                 uaccgs
+                               (cons accg uaccgs))
+                             (append nchanges changes) 
+                             stronger-proofsp
+                             old-hlevel hlevel
+                             qspv state))))
+
+(defun-raw accg-refine-ccmfs-lst (accgs stronger-proofsp old-hlevel hlevel
+                                        qspv state)
+  ;; refines the ccmfs of a list of accgs.
+  ;;
+  ;;
+  ;;
+  ;; OUTPUT: an error triple whose value is (list* d c u) where d ... c is the
+  ;; list of accgs that were changed during refinement, and u is the list of
+  ;; accgs that were unchanged during refinement.
+
+  (accg-refine-ccmfs-lst1 accgs nil nil nil stronger-proofsp old-hlevel hlevel
+                          qspv state))
+  
+(defun-raw prune-accg-node (node1 edges accg changes hlevel qspv state)
+  (if (endp edges)
+      (value changes)
+    (let* ((edge (car edges))
+           (node2 (aref accg (accg-edge-head edge))))
+      (er-let*
+       ((result 
+         (pprogn
+          (increment-timer 'other-time state)
+          (ccg-io? build/refine nil state
+                   (node1 node2)
+                   (fms "We attempt to prove that it is not possible for ~
+                         execution to move from context ~x0 to context ~x1.~|"
+                        `((#\0 . ,(car (accg-node-context-num node1)))
+                          (#\1 . ,(car (accg-node-context-num node2))))
+                        *standard-co*
+                        state
+                        nil))
+          (increment-timer 'print-time state)
+          (accg-can-omit-edge? node1 node2 hlevel qspv state))))
+       (progn
+         (unless result
+           (setf (accg-node-fwd-edges node1)
+                 (cons edge (accg-node-fwd-edges node1)))
+           (setf (accg-node-bwd-edges node2)
+                 (cons edge (accg-node-bwd-edges node2))))
+         (prune-accg-node node1 (cdr edges) accg 
+                          (if result
+                              (acons (car (accg-node-context-num node1))
+                                     (car (accg-node-context-num node2))
+                                     changes)
+                            changes)
+                          hlevel qspv state))))))
+
+(defun-raw prune-accg1 (i accg changes hlevel qspv state)
+  (if (< i 0)
+      (value changes)
+    (let* ((node (aref accg i))
+           (edges (accg-node-fwd-edges node)))
+      (setf (accg-node-fwd-edges node) nil)
+      (er-let* ((nchanges (prune-accg-node node edges accg changes
+                                           hlevel qspv state)))
+               (prune-accg1 (1- i) accg nchanges hlevel qspv state)))))
+
+(defun-raw prune-accg (accg hlevel qspv state)
+  ;; reset all the bwd-edges
+  (loop for node across accg
+        do (setf (accg-node-bwd-edges node) nil))
+  (pprogn
+   (ccg-io? build/refine nil state
+            ()
+            (fms "We attempt to prune the CCG by using theorem prover queries ~
+                  to determine if the rulers of adjacent calling contexts are ~
+                  incompatible.~|"
+                 nil
+                 *standard-co*
+                 state
+                 nil))
+   ;; prune!
+   (prune-accg1 (1- (array-dimension accg 0)) accg nil hlevel qspv state)))
+               
+(defun-raw accg-refine-accg (accg stronger-proofsp old-hlevel hlevel
+                                  qspv state)
+  ;; this function refines an accg based on whether we have stronger
+  ;; proof techniques available (stronger-proofsp), or some other
+  ;; weaker set of restrictions (comparing restrict to
+  ;; old-restrict). The result is a list of new accgs that have been
+  ;; separated into sccs.
+  (er-let*
+   ((accg-changes0
+     (if (and stronger-proofsp
+              (not (hlevel-ccmfs-per-nodep hlevel)))
+         ;; if we are using stronger proof techniques
+         ;; and we are not doing ccmfs on a per-node
+         ;; basis (in which case we avoid pruning to
+         ;; allow for simpler justifications in the end)
+         (prune-accg accg hlevel qspv state)
+       (value nil))))
+   (if (consp accg-changes0)
+       (mv-let
+        (accg-changes1 naccgs)
+        (accg-separate-sccs accg :ccmfp t)
+        (er-let*
+         ((triple (accg-refine-ccmfs-lst naccgs stronger-proofsp
+                                         old-hlevel hlevel
+                                         qspv state)))
+         (value (cons (cons (append accg-changes0 accg-changes1)
+                            (car triple))
+                      naccgs))))
+     (er-let*
+      ((changes0 (accg-refine-ccmfs accg stronger-proofsp
+                                    old-hlevel hlevel
+                                    qspv state)))
+      (value (cons (cons nil changes0) (list accg)))))))
+
+(defun-raw accg-refine-accgs1 (accgs ces changes caccgs uaccgs uces
+                                     stronger-proofsp old-hlevel new-hlevel
+                                     qspv state)
+  (if (endp accgs)
+      (value (list* changes caccgs uaccgs uces))
+    (er-let*
+     ((pair (accg-refine-accg (car accgs) stronger-proofsp
+                              old-hlevel new-hlevel qspv state)))
+     (if (or (consp (caar pair)) (consp (cdar pair)))
+         (accg-refine-accgs1 (cdr accgs)
+                             (cdr ces)
+                             (cons (append (caar pair) (car changes))
+                                   (append (cdar pair) (cdr changes)))
+                             (append (cdr pair) caccgs)
+                             uaccgs
+                             uces
+                             stronger-proofsp old-hlevel new-hlevel
+                             qspv state)
+       (accg-refine-accgs1 (cdr accgs)
+                           (cdr ces)
+                           changes
+                           caccgs
+                           ;; if there are no changes, (cdr pair) is a
+                           ;; singleton list.
+                           (append (cdr pair) uaccgs)
+                           (cons (car ces) uces)
+                           stronger-proofsp old-hlevel new-hlevel
+                           qspv state)))))
+
+(defun-raw accg-refine-accgs (accgs ces old-hlevel new-hlevel qspv state)
+  ;; refines a list of accgs by calling accg-refine-accg repeatedly. Returns an
+  ;; error triple whose value is (cons c u) where c is a list of the accgs that were
+  ;; changed by refinement, and u is a list of the accgs that were not changed
+  ;; by refinement.
+  (pprogn
+   (ccg-io? basics nil state
+            (new-hlevel accgs)
+            (fms "We now move to the ~x0 level of the hierarchy ~
+                  (see :DOC CCG-hierarchy) in order to refine the remaining ~
+                  SCC~#1~[~/s~] of our anotated CCG.~|"
+                 `((#\0 . ,new-hlevel)
+                   (#\1 . ,accgs))
+                 *standard-co*
+                 state
+                 nil))
+   (er-let*
+    ((tuple (accg-refine-accgs1 accgs ces nil nil nil nil
+                                 (weaker-proof-techniquesp old-hlevel
+                                                           new-hlevel)
+                                 old-hlevel new-hlevel
+                                 qspv state))
+     (changes (value (car tuple)))
+     (caccgs (value (cadr tuple)))
+     (uaccgs (value (caddr tuple)))
+     (uces (value (cdddr tuple))))
+    (pprogn
+     (ccg-io? basics nil state
+              (changes state)
+              (mv-let
+               (col state)
+               (fmt "We have completed CCG refinement. "
+                    nil
+                    *standard-co*
+                    state
+                    nil)
+               (print-changes col changes state)))
+     (value (list* caccgs uaccgs uces))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; the following code is used to clean up CCGs (see the SCP
+;;; paper). the code culminates in the cln function.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw srg-scc (graph)
+  ;; srg-scc is the instantiation of ccg-generic-scc for srgs.
+  (ccg-generic-scc graph
+                   #'srg-node-fwd-edges #'srg-node-bwd-edges
+                   #'srg-edge-tail #'srg-edge-head))
+
+
+(defun-raw srg-scc-has->-edgep (scc scc-array srg)
+  ;; srg-scc-has->-edgep tells us whether an scc of an srg contains an
+  ;; edge labeled with a >. here scc is a list of indices of nodes in
+  ;; the same scc, and scc-array maps srg indices to a unique scc
+  ;; identifier (as in the second value returned by srg-scc).
+  (let ((scc-num (aref scc-array (car scc)))) 
+    (dolist (p scc nil)
+      (let ((x (aref srg p)))
+        (when (dolist (e (srg-node-fwd-edges x) nil)
+                (when (and (eq (srg-edge-label e) '>)
+                           (= scc-num (aref scc-array
+                                            (srg-edge-head e))))
+                  (return t)))
+          (return t))))))
+
+(defun-raw ccmf-remove-ccms (ccmf first-del-array last-del-array)
+  ;; virtually and destructively removes ccms from a ccmf by removing
+  ;; all edges involving those ccms. This is sufficient for our
+  ;; purposes and easier than rebuilding the ccmf without the
+  ;; ccms. here, ccmf is a ccmf struct, first-del-array and
+  ;; last-del-array are arrays of booleans for which a value of t in
+  ;; slot i indicates that the ith ccm should be removed from the ith
+  ;; source or sink ccm, respectively. returns the ccmf or nil if all
+  ;; the edges have been removed from the ccmf, in which case,
+  ;; termination cannot be proven.
+  (loop with graph = (ccmf-graph ccmf)
+        for i from 0 below (ccmf-in-sizes ccmf) ;; we loop through the graph array.
+        for node = (aref graph i)
+        for f = (lambda (x) (aref last-del-array x))
+        if (aref first-del-array i) ;; if we are supposed to delete this source node,
+          do (setf (aref graph i) (make-ccmf-node)) ;; we set the node to a blank node
+        else ;; otherwise, we remove all the > and >= edges that lead
+             ;; to a deleted sink node:
+          do (setf (aref graph i)
+                   (make-ccmf-node :>-edges (delete-if f (ccmf-node->-edges node))
+                                   :>=-edges (delete-if f (ccmf-node->=-edges node))))))
+
+(defun-raw ccmf-remove-ccms-list (ccmfs deletep-array)
+  ;; given a list of ccmfs and an array of arrays of booleans
+  ;; indicating which ccms to delete for each context, calls
+  ;; ccmf-remove-ccms on each ccmf in ccmfs with the appropriate
+  ;; deletion arrays. this function is destructively updates each
+  ;; ccmf.
+  (dolist (ccmf ccmfs nil)
+    (ccmf-remove-ccms ccmf
+                      (aref deletep-array
+                            (ccmf-firstsite ccmf))
+                      (aref deletep-array
+                            (ccmf-lastsite ccmf)))))
+
+(defun-raw srg-restrict (srg ccms)
+  ;; restricts the given srg to only the ccms indexed by the natural
+  ;; numbers in the list ccms. this function is *not* destructive.
+  (let* ((n (length ccms))
+         (rsrg (make-array n)) ;; the restricted srg.
+         (a (make-array (array-dimension srg 0) ;; maps the srg nodes
+                        :element-type 'fixnum   ;; to their new index
+                        :initial-element -1)))  ;; if they are in rsrg.
+    ;; create a new node for each slot in rsrg with the node and ccm
+    ;; of the appropriate node in the original srg. we also update the
+    ;; map as we go mapping old node indices to new ones.
+    (loop
+     for p in ccms
+     for i from 0
+     for node = (aref srg p)
+     do (setf (aref a p) i)
+     do (setf (aref rsrg i)
+              (make-srg-node :node (srg-node-node node)
+                             :ccm  (srg-node-ccm  node))))
+    (loop
+     for p in ccms
+     for i from 0
+     for node = (aref srg p)
+     for nnode = (aref rsrg i)
+     do (loop for e in (srg-node-fwd-edges node)
+              unless (= (aref a (srg-edge-head e)) -1)
+              do (let* ((head (aref a (srg-edge-head e)))
+                        (hnode (aref rsrg head))
+                        (ne (make-srg-edge :head head
+                                           :tail i
+                                           :ccmf (srg-edge-ccmf e)
+                                           :label (srg-edge-label e))))
+                   (setf (srg-node-fwd-edges nnode)
+                         (cons ne (srg-node-fwd-edges nnode)))
+                   (setf (srg-node-bwd-edges hnode)
+                         (cons ne (srg-node-bwd-edges hnode))))))
+    rsrg))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; the following code implements the SCP analysis.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ 
+(defun-raw srg-scc-for-node-aux (srg nn visited node-fwd-edges edge-head)
+  ;; this is the helper function for srg-scc-for-node
+  (setf (aref visited nn) t)
+  (loop for edge in (funcall node-fwd-edges (aref srg nn))
+        for head = (funcall edge-head edge)
+        unless (aref visited head)
+        do (srg-scc-for-node-aux srg head visited node-fwd-edges edge-head)))
+
+(defun-raw srg-scc-for-node (srg nn)
+  ;; given an srg and the index of a node in that srg (nn), returns an
+  ;; array of booleans of the same size as srg which indicates for
+  ;; each i whether the node of the srg at index i is in the same srg
+  ;; as the node at index nn. it does so by traversing the srg from
+  ;; node nn forwards and backwards and taking the intersection of the
+  ;; nodes reached.
+  (let* ((n (array-dimension srg 0))
+         (in-scc-array (make-array n :element-type '(member t nil :ignore) :initial-element nil)))
+    (let* ((n (array-dimension in-scc-array 0)))
+      ;; traverse the graph forwards, using in-scc-array to keep track
+      ;; of the visited nodes.
+      (srg-scc-for-node-aux srg nn in-scc-array #'srg-node-fwd-edges #'srg-edge-head)
+      ;; for our backwards traversal, we only want to visit nodes that
+      ;; we already visited on our forward traversal. therefore, we
+      ;; set the index of visited nodes to nil and the index of
+      ;; unvisited nodes to the non-nil value :ignore.
+      (loop for i from 0 below n
+            if (aref in-scc-array i)
+              do (setf (aref in-scc-array i) nil)
+            else
+              do (setf (aref in-scc-array i) :ignore))
+      ;; now traverse the graph backwards.
+      (srg-scc-for-node-aux srg nn in-scc-array #'srg-node-bwd-edges #'srg-edge-tail)
+      ;; finally, reset any :ignore indices to nil, since they are not in the scc.
+      (loop for i from 0 below n
+            when (eq (aref in-scc-array i) :ignore)
+              do (setf (aref in-scc-array i) nil))
+      in-scc-array)))
+
+(defun-raw srg-add-scc-for-node (srg nn in-scc-array)
+  ;; takes the per-index disjunction of the boolean array in-scc-array
+  ;; and the result of calling srg-scc-for-node on srg and nn. In
+  ;; other words, given an array indicating which nodes are in a
+  ;; collection of sccs, this function adds the scc containing node nn
+  ;; to the array.
+  (if (aref in-scc-array nn)
+      in-scc-array
+    (let ((new-in-scc-array (srg-scc-for-node srg nn)))
+      (loop for i from 0 below (length in-scc-array)
+            when (and (not (aref in-scc-array i))
+                      (aref new-in-scc-array i))
+            do (setf (aref in-scc-array i) t))
+      in-scc-array)))
+
+(defun-raw mtp (srg ccmfs num-contexts fwd-edges bwd-edges edge-head edge-tail)
+  ;; generic function for finding a maximal thread presever (mtp) as
+  ;; described in the scp paper. However, our algorithm is slightly
+  ;; different than that described in the scp paper. this is because
+  ;; we have a ccmf for every edge rather than every node. because of
+  ;; this, we cannot keep one count value for each ccm in the srg,
+  ;; since the are potentially multiple edges from the context
+  ;; containing the ccm, and if the ccm is not non-increasing or
+  ;; decreasing along any one of those edges, it is not part of the
+  ;; mtp. therefore, for each ccm, we maintain several counts, one for
+  ;; each outgoing edge.
+
+  ;; the srg is an srg, the ccmfs is a list of ccmfs that should be
+  ;; the ccmfs of the srg. num-contexts is the number of contexts
+  ;; represented by the srg. fwd-edges, bwd-edges, edge-head, and
+  ;; edge-tail are functions that tell us how to get around the
+  ;; graph. these are here to allow us to quickly find mtps in a graph
+  ;; and its inverse.
+  (let* ((n (array-dimension srg 0))
+         ;; we make the count array a matrix. for each ccm, we
+         ;; maintain num-context counts. unless the accg is not
+         ;; complete, some of these counts will always be 0. however,
+         ;; this slight inefficiency in space allows us to maintain
+         ;; simpler and more efficient code.
+         (count (make-array `(,n ,num-contexts)
+                            :element-type 'fixnum :initial-element 0))
+         ;; the accg matrix is an adjacency matrix representation of
+         ;; the accg implied by the ccmfs.
+         (accg-matrix (make-array `(,num-contexts ,num-contexts)
+                                   :element-type 'boolean
+                                   :initial-element nil))
+         ;; marked keeps track of which ccms are marked as not being
+         ;; part of the mtp.
+         (marked (make-array n :element-type 'boolean :initial-element nil))
+         ;; the worklist keeps track of the ccms to visit.
+         (worklist nil))
+    ;; first, we construct the accg-matrix
+    (dolist (ccmf ccmfs)
+      (setf (aref accg-matrix (ccmf-firstsite ccmf) (ccmf-lastsite ccmf)) t))
+    ;; next, we initiate the counts.
+    (dotimes (i n)
+      (let ((node (aref srg i)))
+        ;; for each edge from node i, we increment the counter
+        ;; corresponding to the index of the context for which the
+        ;; head of e is a ccm:
+        (dolist (e (funcall fwd-edges node)) 
+          (incf (aref count i (srg-node-node (aref srg (funcall edge-head e))))))
+        ;; for every successor of the context of node that has count 0
+        ;; gets added to the worklist and is marked.
+        (dotimes (j num-contexts)
+          (when (and (aref accg-matrix (srg-node-node node) j)
+                     (= (aref count i j) 0))
+            (setf worklist (cons i worklist))
+            (setf (aref marked i) t)))))
+    ;; finally, we enter the meat of the algorithm, working through the worklist.
+    (loop while (consp worklist)
+          for cw = (car worklist)
+          for j = (srg-node-node (aref srg cw))
+          do (setf worklist (cdr worklist))
+          ;; every node in the worklist is out of the mtp, so we
+          ;; decrement the appropriate count of all its
+          ;; predecessors. any of them whose count reaches 0 gets
+          ;; added to the worklist and is marked.
+          do (dolist (e (funcall bwd-edges (aref srg cw)))
+               (let ((i (funcall edge-tail e)))
+                 (unless (aref marked i)
+                   (decf (aref count i j))
+                   (when (= (aref count i j) 0)
+                     (setf (aref marked i) t)
+                     (setf worklist (cons i worklist))))))
+          ;; finally, we return all the unmarked ccms.
+          finally (return (loop for i from 0 below n
+                                unless (aref marked i) collect i)))))
+
+(defun-raw mtp-fwd (srg ccmfs num-contexts)
+  ;; instantiation of mtp for analysis of the original srg/accg
+  (mtp srg ccmfs num-contexts
+       #'srg-node-fwd-edges #'srg-node-bwd-edges
+       #'srg-edge-head #'srg-edge-tail))
+
+
+(defun-raw mtp-bwd (srg ccmfs num-contexts)
+  ;; instantiation of mtp for analysis of the transposition of the
+  ;; srg/accg
+  (mtp srg ccmfs num-contexts
+       #'srg-node-bwd-edges #'srg-node-fwd-edges
+       #'srg-edge-tail #'srg-edge-head))
+    
+
+(defun-raw fan-free (srg edge-list other-node num-contexts)
+  ;; generic function for determining if there is no fanning in the
+  ;; srg. edge-list is a function for retrieving the list of
+  ;; incoming/outgoing edges of a node. other-node tells us how to get
+  ;; the other node adjacent to an edge. num-contexts is the number of
+  ;; contexts that the srg represents. in our context fanning is when
+  ;; a ccm has multiple incoming/outgoing edges from ccms of the same
+  ;; context.
+  (loop
+   with n = (array-dimension srg 0)
+   ;; seen is an array keeping track of which contexts we have seen ccms from.
+   with seen = (make-array num-contexts :element-type 'boolean :initial-element nil)
+   for i from 0 below n
+   ;; loop through the edges of srg ccm i, keeping track of the
+   ;; contexts to which the adjacent ccms belong. if we see a context
+   ;; twice, we have fanning and return nil.
+   unless (loop for e in (funcall edge-list (aref srg i))
+                for j = (funcall other-node e)
+                for context = (srg-node-node (aref srg j))
+                if (aref seen context) return nil
+                else do (setf (aref seen context) t)
+                finally (return t))
+     return nil
+   ;; reset the seen array. this is cheaper than creating a new array
+   ;; for each iteration of the outer loop.
+   do (loop for i from 0 below num-contexts
+            do (setf (aref seen i) nil))
+   finally (return t)))
+
+(defun-raw fan-in-free (srg num-contexts)
+  ;; instantiation of fan-free to check for fan-in
+  (fan-free srg #'srg-node-bwd-edges #'srg-edge-tail num-contexts))
+
+
+(defun-raw fan-out-free (srg num-contexts)
+  ;; instantiation of fan-free to check for fan-out
+  (fan-free srg #'srg-node-fwd-edges #'srg-edge-head num-contexts))
+
+(defun-raw mtp-to-anchor (srg ahash)
+  ;; given an srg that has been restricted to some mtp and a set of
+  ;; ccmfs represented by a hash table, we add to ahash the anchor
+  ;; implied by srg. that is, we add all ccmfs containing a > edge in
+  ;; the restricted srg.
+  (loop for i from 0 below (array-dimension srg 0)
+        do (loop for e in (srg-node-fwd-edges (aref srg i))
+                 when (and (eq (srg-edge-label e) '>)
+                           (not (gethash (srg-edge-ccmf e) ahash)))
+                   do (setf (gethash (srg-edge-ccmf e) ahash) t))
+        finally (return ahash)))
+
+(defun-raw simple-anchors (srg ahash ccmfs num-contexts)
+  ;; simple anchors, also called type 1 anchors in other papers by the
+  ;; scp authors, are anchors based on mtps.
+  (let ((srgp (srg-restrict srg (mtp-fwd srg ccmfs num-contexts))))
+    (if (fan-in-free srgp num-contexts)
+        (mtp-to-anchor srgp ahash)
+      (let ((srgq (srg-restrict srg (mtp-bwd srg ccmfs num-contexts))))
+        (if (fan-out-free srgq num-contexts)
+            (mtp-to-anchor srgq ahash)    
+          nil)))))
+
+(defun-raw srg-restrict-edges (srg pred)
+  ;; this function non-destructively constructs a new srg that is
+  ;; identical to srg except it excludes edges that fail the
+  ;; predicate, pred.
+  (loop
+   with n = (array-dimension srg 0)
+   with rsrg = (make-array n)
+   for i from 0 below n
+   for node = (aref srg i)
+   do (setf (aref rsrg i)
+            (make-srg-node :node (srg-node-node node)
+                           :ccm (srg-node-ccm node)
+                           :fwd-edges (remove-if-not pred (srg-node-fwd-edges node))
+                           :bwd-edges (remove-if-not pred (srg-node-bwd-edges node))))
+   finally (return rsrg)))
+
+(defun-raw ndg (srg)
+  ;; constructs the no-descent graph, a subgraph of the srg consisting
+  ;; of only nonstrict edges.
+  (srg-restrict-edges srg (lambda (e) (eq (srg-edge-label e) '>=))))
+
+
+(defun-raw srg-interior (srg)
+  ;; constructs the interior of an srg, that is, the subgraph of the
+  ;; srg consisting of the edges of the srg that are interior to an
+  ;; scc of the srg.
+  (multiple-value-bind
+      (scc scc-array)
+      (srg-scc srg)
+    (declare (ignore scc))
+    (srg-restrict-edges srg
+                        (lambda (e)
+                          (eq (aref scc-array (srg-edge-tail e))
+                              (aref scc-array (srg-edge-head e)))))))
+
+
+(defun-raw srg-to-matrix (srg)
+  ;; straight-forward function for making an adjacency matrix of srg.
+  (loop with n = (array-dimension srg 0)
+        with matrix = (make-array (list n n)
+                                  :element-type 'boolean
+                                  :initial-element nil)
+        for i from 0 below n
+        do (loop for e in (srg-node-fwd-edges (aref srg i))
+                 do (setf (aref matrix i (srg-edge-head e)) t))
+        finally (return matrix)))
+        
+;;   (let* ((n (array-dimension srg 0))
+;;          (matrix (make-array (list n n) :element-type 'boolean :initial-element nil)))
+;;     (dotimes (i n matrix)
+;;       (dolist (e (srg-node-fwd-edges (aref srg i)))
+;;         (setf (aref matrix i (srg-edge-head e)) t)))))
+
+
+(defun-raw ccmf-to-ccmfdown-in-srg (srg ccmf ndgi-matrix)
+  ;; by ccmfdown, here, we mean the original ccmf minus any arcs
+  ;; belonging to the interior of ndg of srg. for ccmf, G, this is
+  ;; represented in the scp paper as G with a small down arrow to its
+  ;; right. hence the name. we return a copy of the srg restricted to
+  ;; not include edges in ccmfdown.
+  (srg-restrict-edges srg
+                      (lambda (e)
+                        (not (and (eq (srg-node-node (aref srg (srg-edge-tail e)))
+                                      (ccmf-firstsite ccmf))
+                                  (eq (srg-node-node (aref srg (srg-edge-head e)))
+                                      (ccmf-lastsite ccmf))
+                                  (aref ndgi-matrix (srg-edge-tail e) (srg-edge-head e)))))))
+
+(defun-raw anchor-find (srg ccmfs num-contexts)
+  ;; the anchor finding algorithm, as given in the scp paper. 
+  (let ((ahash (make-hash-table :rehash-size 2 :rehash-threshold (float 3/4))))
+    (multiple-value-bind
+        (sccs scc-array)
+        (srg-scc srg)
+      (declare (ignore scc-array))
+      ;; for every scc of the srg, look for simple anchors.
+      (dolist (scc sccs)
+        (simple-anchors (srg-restrict srg scc) ahash ccmfs num-contexts))
+      ;; convert the set of anchors to a list.
+      (let ((anchors (loop for k being the hash-keys of ahash using (hash-value v)
+                           when v collect k)))
+        ;;(format t "simple anchors: ~A~%" anchors)
+        ;; if we have found anchors, return them.
+        (if anchors
+            anchors
+          ;; otherwise, we attempt to find "type 2" anchors, as they
+          ;; are called in the scp paper.
+          (loop with ndgi-matrix = (srg-to-matrix (srg-interior (ndg srg)))
+                for ccmf in ccmfs
+                for h = (ccmf-to-ccmfdown-in-srg srg ccmf ndgi-matrix)
+                when (or (mtp-fwd h ccmfs num-contexts)
+                         (mtp-bwd h ccmfs num-contexts))
+                  return (list ccmf)))))))
+
+(defun-raw copy-a-ccmf (ccmf)
+  (make-ccmf :firstsite (ccmf-firstsite ccmf)
+             :lastsite (ccmf-lastsite ccmf)
+             :fc-num (ccmf-fc-num ccmf)
+             :lc-num (ccmf-lc-num ccmf)
+             :graph (accg-copy-ccmf-graph (ccmf-graph ccmf))
+             :in-sizes (ccmf-in-sizes ccmf)
+             :out-sizes (ccmf-out-sizes ccmf)
+             :steps (ccmf-steps ccmf)))
+
+(defun-raw copy-ccmfs (ccmfs)
+  ;; just like it says, this function copies a list of ccmfs.
+  (loop for ccmf in ccmfs
+    collect (copy-a-ccmf ccmf)))
+
+(defun-raw copy-accg (accg)
+  (let* ((n (array-dimension accg 0))
+         (naccg (make-array n)))
+    (loop for i from 0 below n
+          for node = (aref accg i)
+          do (setf (aref naccg i)
+                   (make-accg-node :context (accg-node-context node)
+                                   :num i)))
+    (loop
+     for node across accg
+     for nnode across naccg
+     do (setf (accg-node-fwd-edges nnode)
+              (loop
+               for edge in (accg-node-fwd-edges node)
+               for head = (accg-edge-head edge)
+               for hnode = (aref naccg head)
+               for nedge = (make-accg-edge
+                            :tail (accg-edge-tail edge)
+                            :head head
+                            :ccmf (copy-a-ccmf (accg-edge-ccmf edge)))
+               do (setf (accg-node-bwd-edges hnode)
+                        (cons nedge (accg-node-bwd-edges hnode)))
+               collect nedge)))
+    naccg))
+
+(defun-raw accg-ccmfs (accg)
+  ;; returns all the ccmfs used to annotate accg
+  (loop for node across accg
+        append (mapcar #'accg-edge-ccmf
+                       (accg-node-fwd-edges node))))
+;;   (let ((ccmfs nil))
+;;     (dotimes (i (array-dimension accg 0) ccmfs)
+;;       (dolist (e (accg-node-fwd-edges (aref accg i)))
+;;         (setf ccmfs (cons (accg-edge-ccmf e) ccmfs))))))
+
+(defun-raw accg-contexts (accg)
+  ;; returns the contexts of the accg.
+  (map 'vector (lambda (x) (accg-node-context x)) accg))
+
+(defun-raw accg-srg-add-edge (tailnode headnode tailnum headnum ccmf label)
+  ;; adds an adge to the tailnode and headnode of an srg.
+  (let ((edge (make-srg-edge :tail tailnum
+                             :head headnum
+                             :ccmf ccmf
+                             :label label)))
+    (setf (srg-node-fwd-edges tailnode)
+          (cons edge (srg-node-fwd-edges tailnode)))
+    (setf (srg-node-bwd-edges headnode)
+          (cons edge (srg-node-bwd-edges headnode)))
+    nil))
+
+(defun-raw accg-remove-edges-corresponding-to-ccmfs (accg ccmfs)
+  ;; destructively removes edges corresponding to the list of ccmfs from the
+  ;; accg. The ccmfs must be pointer-equal (eq) to the ones you want removed
+  ;; from the accg.
+  
+  ;; first, we set the firstsite field of the ccmfs we want to remove
+  ;; to -1.
+  (loop for ccmf in ccmfs do (setf (ccmf-firstsite ccmf) -1))
+  ;; next, we loop through all the accg-nodes, deleting any
+  ;; incoming/outgoing edges whose firstsite is -1.
+  (loop with pred = (lambda (edge)
+                      (= (ccmf-firstsite (accg-edge-ccmf edge)) -1))
+        for node across accg
+        do (setf (accg-node-fwd-edges node)
+                 (delete-if pred (accg-node-fwd-edges node)))
+        do (setf (accg-node-bwd-edges node)
+                 (delete-if pred (accg-node-bwd-edges node))))
+  accg)
+
+(defun-raw accg-construct-srg (accg)
+  ;; constructs an srg from a accg. to do this, we "flatten" out the
+  ;; ccms of each accg-node, laying all the ccms from all the
+  ;; accg-nodes next to each other and creating an srg-node for each
+  ;; ccm.
+  (let* ((n (array-dimension accg 0))
+         ;; we need an offset array to tell us what index in the srg
+         ;; corresponds to the first ccm in each accg-node.
+         (node-offset (make-array n
+                                  :element-type 'fixnum
+                                  :initial-element 0))
+         (c 0))
+    ;; compute the offsets:
+    (dotimes (i n)
+      (setf (aref node-offset i) c)
+      (incf c (array-dimension (accg-node-ccms (aref accg i)) 0)))
+    ;; at this point c = the number of nodes in the srg.
+    (let ((srg (make-array c
+                           :element-type 'srg-node
+                           :initial-element (make-srg-node))))
+      ;; make all the new nodes.
+      (loop for i from 1 below c
+            do (setf (aref srg i) (make-srg-node)))
+      ;; now we add all the edges.
+      (loop ;; we loop through the accg
+       for i from 0 below n
+       do (loop ;; we loop through the fwd-ccmfs of node i
+           for edge in (accg-node-fwd-edges (aref accg i))
+           for ccmf = (accg-edge-ccmf edge)
+           for offset1 = (aref node-offset i)
+           for offset2 = (aref node-offset (accg-edge-head edge))
+           for cg = (ccmf-graph ccmf)
+           do (loop ;; we loop through the ccmf.
+               for j from 0 below (array-dimension cg 0)
+               for a from offset1
+               for nodea = (aref srg a)
+               do (setf (srg-node-node nodea) i)
+               do (setf (srg-node-ccm nodea) j)
+               do (loop ;; we loop through the >-edges and add them to the srg.
+                   for x in (ccmf-node->-edges (aref cg j))
+                   for b = (+ offset2 x)
+                   do (accg-srg-add-edge nodea (aref srg b) a b ccmf '>))
+               do (loop ;; we loop through the >=-edges and add them to the srg.
+                   for x in (ccmf-node->=-edges (aref cg j))
+                   for b = (+ offset2 x)
+                   do (accg-srg-add-edge nodea (aref srg b) a b ccmf '>=))))
+       finally (return srg)))))
+
+(defun-raw cln-accg (accg)
+  ;; this function cleans a accg by removing any ccmf edge that is
+  ;; not internal to an scc in the corresponding srg that contains a >
+  ;; edge.
+  (let* ((srg (accg-construct-srg accg)) ;; the srg for the accg.
+         (n (array-dimension accg 0))
+         (deletep-array (make-array n))) ;; tells us which ccms to delete.
+    ;; initiate the deletep-array
+    (dotimes (i n)
+      (setf (aref deletep-array i)
+            (make-array (array-dimension
+                         (accg-node-ccms (aref accg i))
+                         0)
+                        :element-type 'boolean
+                        :initial-element nil)))
+    ;; analyze the sccs of the srg.
+    (multiple-value-bind
+        (sccs scc-array)
+        (srg-scc srg)
+      ;; for each scc, add the nodes of the scc to the deletep array
+      ;; unless it contains a > edge.
+      (loop for scc in sccs
+            unless (srg-scc-has->-edgep scc scc-array srg)
+            do (loop for v in scc
+                     for node = (aref srg v)
+                     for context = (srg-node-node node)
+                     for ccm = (srg-node-ccm node)
+                     do (setf (aref (aref deletep-array context) ccm) t))))
+    ;; destructively remove the unwanted ccms.
+    (progn
+      (ccmf-remove-ccms-list (accg-ccmfs accg)
+                             deletep-array)
+      accg)))
+
+(defun-raw scp (accg)
+  ;; the main scp algorithm. it takes an accg and recursively removes
+  ;; anchors and analyzes the sccs of the remainder of the graph until
+  ;; either there is no graph left, or we can't find any more
+  ;; anchors. see the scp paper.
+  (when accg
+    (let* ((n (array-dimension accg 0))
+           (anchors (anchor-find (accg-construct-srg accg)
+                                 (accg-ccmfs accg)
+                                 n)))
+      (when anchors
+        (mv-let
+         (changes sccs)
+         (accg-separate-sccs
+                     (accg-remove-edges-corresponding-to-ccmfs accg anchors))
+         (declare (ignore changes))
+         (loop for scc in sccs
+               unless (scp (cln-accg scc))
+               return nil
+               finally (return t)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; the following code implements the SCT analysis
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defstruct-raw scg-path
+  ;; the first num in the path
+  (start 0 :type fixnum)
+  ;; the second num in the path
+  (end 0 :type fixnum)
+  ;; the total length of the path
+  (length 0 :type fixnum)
+  ;; the interior of the path (everything except the start and end). We
+  ;; represent this as a tree so that we don't have to append every time we
+  ;; compose SCGs. We do this in such a way that a depth-first car-to-cdr
+  ;; seorch of the tree returns the path.
+  (interior nil :type (or null fixnum cons)))
+
+(defun-raw new-scg-path (start end)
+  (make-scg-path :start start
+                 :end end
+                 :length 2
+                 :interior nil))
+
+(defun-raw compose-scg-paths (p1 p2)
+  (make-scg-path :start (scg-path-start p1)
+                 :end (scg-path-end p2)
+                 :length (1- (+ (scg-path-length p1)
+                                (scg-path-length p2)))
+                 :interior (let ((x (if (null (scg-path-interior p2))
+                                        (scg-path-start p2)
+                                      (cons (scg-path-start p2)
+                                            (scg-path-interior p2)))))
+                             (if (null (scg-path-interior p1))
+                                 x
+                               (cons (scg-path-interior p1) x)))))
+
+(defun-raw flatten-scg-interior (interior acc)
+  (cond ((null interior)
+         acc)
+        ((atom interior)
+         (cons interior acc))
+        (t
+         (flatten-scg-interior (car interior)
+                               (flatten-scg-interior (cdr interior)
+                                                     acc)))))
+
+(defun-raw flatten-scg-path (path)
+  (cons (scg-path-start path)
+        (flatten-scg-interior (scg-path-interior path)
+                              (list (scg-path-end path)))))
+  
+
+;; for the purposes of this algorithm, we only need to know the starts and ends
+;; of paths. We only need the interior to construct the paths later. Therefore,
+;; we define functions for equality and ordering paths accordingly.
+(defun-raw scg-path-equal (p1 p2)
+  (and (= (scg-path-start p1)
+          (scg-path-start p2))
+       (= (scg-path-end p1)
+          (scg-path-end p2))))
+
+(defun-raw path< (p1 p2)
+  (or (< (scg-path-start p1)
+         (scg-path-start p2))
+      (and (= (scg-path-start p1)
+              (scg-path-start p2))
+           (< (scg-path-end p1)
+              (scg-path-end p2)))))
+
+
+;; since we keep the interior of a path aronud for constructing
+;; counter-examples, we want to keep around the shortest path. Therefore, when
+;; given two paths with identical start and end points, we pick the one with
+;; the shortest path.
+(defun-raw shortest-scg-path (p1 p2)
+  (if (<= (scg-path-length p1)
+          (scg-path-length p2))
+      p1
+    p2))
+
+(defstruct-raw scg
+  (paths nil :type list)
+  (newest-paths nil :type list)
+  (new-newest-paths nil :type list)
+  (num 0 :type fixnum)
+  (graph nil))
+
+(defun-raw sorted-set-union1 (lst1 lst2 key1 key2 predicate combine key test)
+  ;; lst1 and lst2 should be sorted, non-empty lists.
+  ;; key1 should be equal to (funcall key (car lst1))
+  ;; key2 should be equal to (funcall key (car lst2))
+  ;; key should be a unary function that returns an equal-able value.
+  (cond ((funcall test key1 key2)
+         (cons (car lst1)
+               (sorted-set-union (cdr lst1) (cdr lst2)
+                                 predicate
+                                 :key key
+                                 :combine combine
+                                 :test test)))
+        ((funcall predicate key1 key2)
+         (cons (car lst1)
+               (if (endp (cdr lst1))
+                   lst2
+                 (sorted-set-union1 (cdr lst1) lst2
+                                    (funcall key (cadr lst1))
+                                    key2
+                                    predicate
+                                    combine
+                                    key
+                                    test))))
+        (t
+         (cons (car lst2)
+               (if (endp (cdr lst2))
+                   lst1
+                 (sorted-set-union1 lst1 (cdr lst2)
+                                    key1
+                                    (funcall key (cadr lst2))
+                                    predicate
+                                    combine
+                                    key
+                                    test))))))
+
+(defun-raw sorted-set-union (lst1 lst2 predicate
+                                  &key (key #'identity)
+                                  (combine #'(lambda (x y)
+                                               (declare (ignore y))
+                                               x))
+                                  (test #'equal))
+  (cond ((endp lst1) lst2)
+        ((endp lst2) lst1)
+        (t
+         (sorted-set-union1 lst1 lst2
+                            (funcall key (car lst1))
+                            (funcall key (car lst2))
+                            predicate
+                            combine
+                            key
+                            test))))
+
+(defun-raw sorted-set-difference1 (lst1 lst2 key1 key2 predicate key test)
+  ;; lst1 and lst2 should be sorted, non-empty lists.
+  ;; key1 should be equal to (funcall key (car lst1))
+  ;; key2 should be equal to (funcall key (car lst2))
+  ;; key should be a unary function that returns an equal-able value.
+  (cond ((funcall test key1 key2)
+         (sorted-set-difference (cdr lst1) (cdr lst2)
+                                predicate
+                                :key key
+                                :test test))
+        ((funcall predicate key1 key2)
+         (cons (car lst1)
+               (if (endp (cdr lst1))
+                   nil
+                 (sorted-set-difference1 (cdr lst1) lst2
+                                         (funcall key (cadr lst1))
+                                         key2
+                                         predicate
+                                         key
+                                         test))))
+        (t
+         (if (endp (cdr lst2))
+             lst1
+           (sorted-set-difference1 lst1 (cdr lst2)
+                                   key1
+                                   (funcall key (cadr lst2))
+                                   predicate
+                                   key
+                                   test)))))
+
+(defun-raw sorted-set-difference (lst1 lst2 predicate
+                                       &key (key #'identity)
+                                       (test #'equal))
+  (cond ((endp lst1) nil)
+        ((endp lst2) lst1)
+        (t
+         (sorted-set-difference1 lst1 lst2
+                                (funcall key (car lst1))
+                                (funcall key (car lst2))
+                                predicate
+                                key
+                                test))))
+
+(defun-raw sorted-union/difference1 (lst1 lst2 key1 key2 predicate combine key test)
+  ;; lst1 and lst2 should be sorted, non-empty lists.
+  ;; key1 should be equal to (funcall key (car lst1))
+  ;; key2 should be equal to (funcall key (car lst2))
+  ;; key should be a unary function that returns an equal-able value.
+  (cond ((funcall test key1 key2)
+         (mv-let (union difference)
+                 (sorted-union/difference (cdr lst1) (cdr lst2)
+                                          predicate
+                                          :combine combine
+                                          :key key
+                                          :test test)
+                 (mv (cons (funcall combine (car lst1) (car lst2))
+                           union)
+                     difference)))
+        ((funcall predicate key1 key2)
+         (mv-let (union difference)
+                 (if (endp (cdr lst1))
+                     (mv lst2 nil)
+                   (sorted-union/difference1 (cdr lst1) lst2
+                                             (funcall key (cadr lst1))
+                                             key2
+                                             predicate
+                                             combine
+                                             key
+                                             test))
+                 (mv (cons (car lst1) union)
+                     (cons (car lst1) difference))))
+        (t
+         (mv-let (union difference)
+                 (if (endp (cdr lst2))
+                     (mv lst1 lst1)
+                   (sorted-union/difference1 lst1 (cdr lst2)
+                                             key1
+                                             (funcall key (cadr lst2))
+                                             predicate
+                                             combine
+                                             key
+                                             test))
+                 (mv (cons (car lst2) union)
+                     difference)))))
+
+(defun-raw sorted-union/difference (lst1 lst2 predicate
+                                         &key (key #'identity)
+                                         (combine #'(lambda (x y)
+                                                      (declare (ignore y))
+                                                      x))
+                                         (test #'equal))
+  (cond ((endp lst1) (mv lst2 nil))
+        ((endp lst2) (mv lst1 lst1))
+        (t
+         (sorted-union/difference1 lst1 lst2
+                                   (funcall key (car lst1))
+                                   (funcall key (car lst2))
+                                   predicate
+                                   combine
+                                   key
+                                   test))))
+
+(defun-raw sorted-adjoin (element set predicate
+                                  &key (key #'identity)
+                                  (combine #'(lambda (x y)
+                                                      (declare (ignore y))
+                                                      x))
+                                  (test #'equal))
+  (sorted-set-union (list element) set predicate
+                    :key key :combine combine :test test))
+
+(defun-raw sorted-remove-duplicates1 (lst carkey key combine test)
+  (if (endp (cdr lst))
+      lst
+    (let ((cadrkey (funcall key (cadr lst))))
+      (if (funcall test carkey cadrkey)
+          (let ((comb (funcall combine (car lst) (cadr lst))))
+            (sorted-remove-duplicates1  (cons comb (cddr lst))
+                                        (funcall key comb)
+                                        key
+                                        combine
+                                        test))
+        (cons (car lst)
+              (sorted-remove-duplicates1 (cdr lst)
+                                        cadrkey
+                                        key
+                                        combine
+                                        test))))))
+
+(defun-raw sorted-remove-duplicates (lst &key (key #'identity)
+                                         (combine #'(lambda (x y)
+                                                      (declare (ignore y))
+                                                      x))
+                                         (test #'equal))
+  (cond ((endp lst) nil)
+        ((endp (cdr lst)) lst)
+        (t
+         (sorted-remove-duplicates1 lst
+                                    (funcall key (car lst))
+                                    key
+                                    combine
+                                    test))))
+         
+
+(defun-raw list-to-sorted-set (lst predicate
+                                   &key (key #'identity)
+                                   (combine #'(lambda (x y)
+                                                      (declare (ignore y))
+                                                      x))
+                                   (test #'equal))
+  ;; WARNING: THIS FUNCTION IS DESTRUCTIVE TO LST.
+  (sorted-remove-duplicates (sort lst predicate :key key)
+                            :key key
+                            :combine combine
+                            :test test))
+
+(defun-raw scg-graph-key (graph)
+  #-gcl
+  graph
+  #+gcl
+  (loop for node across graph
+        for >-edges = (ccmf-node->-edges node)
+        for >=-edges = (ccmf-node->=-edges node)
+        collect (cons (length >-edges) (length >=-edges)) into lens
+        collect (cons >-edges >=-edges) into lst
+        finally (list* (array-dimension graph 0) lens lst)))
+
+(defun-raw update-scg-paths (graph paths i graph-hash)
+  ;; graph is a ccmf-graph
+  ;; paths is a sorted set of paths to be added for graph
+  ;; i is our scg counter, used for giving each scg a unique numerical id.
+  ;; graph-hash is an equalp hash-table (an equal hash-table in GCL)
+  ;;
+  ;; OUTPUT: 4 values: 
+  ;; 1. the new value of i.
+  ;; 2. whether this is the first update to the new-newest-paths of the scg.
+  ;; 3. the new paths added.
+  ;; 4. the scg that was updated.
+  ;; (format t "~&Calling: ~A~%" `(update-scg-paths ,graph ,paths ,i ,graph-hash))
+  (let* ((key (scg-graph-key graph))
+         (scg (gethash key graph-hash)))
+    (if scg
+        (let* ((new-newest-paths (scg-new-newest-paths scg))
+               (npaths (sorted-set-difference
+                        (sorted-set-difference paths
+                                               (scg-paths scg)
+                                               #'path<
+                                               :test #'scg-path-equal)
+                        (scg-newest-paths scg)
+                        #'path<
+                        :test #'scg-path-equal)))
+          (mv-let (union difference)
+                  (sorted-union/difference npaths new-newest-paths #'path<
+                                           :test #'scg-path-equal
+                                           :combine #'shortest-scg-path)
+                  (progn
+                    (setf (scg-new-newest-paths scg) union)
+                    (mv i (endp new-newest-paths) difference scg))))
+      (let ((nscg (make-scg :graph graph
+                            :num i
+                            :new-newest-paths paths)))
+        (setf (gethash key graph-hash) nscg)
+        ;; (format t "Returning: ~A~%"
+        ;;                       `(update-scg-paths ,(1+ i)
+        ;;                                          t
+        ;;                                          ,paths
+        ;;                                          ,nscg))
+        (mv (1+ i) t paths nscg)))))
+
+(defun-raw age-scgs (lst)
+  ;; lst is a list of scgs
+  ;;
+  ;; SIDE-EFFECT: the scgs are "aged", i.e. their newest-paths are unioned with
+  ;; their paths, the new-newest-paths are moved to the newest-paths, and their
+  ;; new-newest-paths slot is set to nil.
+  ;;
+  ;; OUTPUT: lst
+  (loop for scg in lst
+        do (setf (scg-paths scg)
+                 (sorted-set-union (scg-paths scg)
+                                   (scg-newest-paths scg)
+                                   #'path<
+                                   :combine #'shortest-scg-path
+                                   :test #'scg-path-equal))
+        do (setf (scg-newest-paths scg)
+                 (scg-new-newest-paths scg))
+        do (setf (scg-new-newest-paths scg)
+                 nil)
+        finally (return lst)))
+
+(defun-raw ccmfs-to-scgs1 (ccmfs graph-hash i acc)
+  (if (endp ccmfs)
+      (mv i (sort acc #'< :key #'scg-num))
+    (let ((ccmf (car ccmfs)))
+      (mv-let (ni new? diff scg)
+              (update-scg-paths (ccmf-graph ccmf)
+                                (list (new-scg-path (ccmf-firstsite ccmf)
+                                                    (ccmf-lastsite ccmf)))
+                                i
+                                graph-hash)
+              (ccmfs-to-scgs1 (cdr ccmfs) graph-hash ni
+                              (if (and new? (consp diff))
+                                  (cons scg acc)
+                                acc))))))
+
+(defun-raw ccmfs-to-scgs (ccmfs graph-hash)
+  (ccmfs-to-scgs1 ccmfs graph-hash 0 nil))
+
+(defun-raw compose-scg-graphs (g h)
+  (loop with n = (array-dimension g 0)
+        with gh = (make-array (array-dimension g 0)
+                              :element-type 'ccmf-node
+                              :initial-element (make-ccmf-node))
+        for i below n
+        for nodei = (aref g i)
+        for >-edges = nil
+        for >=-edges = nil
+        do (loop for j in (ccmf-node->-edges nodei)
+                 for nodej = (aref h j)
+                 do (loop for k in (ccmf-node->-edges nodej)
+                          do (setf >-edges (cons k >-edges)))
+                 do (loop for k in (ccmf-node->=-edges nodej)
+                          do (setf >-edges (cons k >-edges))))
+        do (loop for j in (ccmf-node->=-edges nodei)
+                 for nodej = (aref h j)
+                 do (loop for k in (ccmf-node->-edges nodej)
+                          do (setf >-edges (cons k >-edges)))
+                 do (loop for k in (ccmf-node->=-edges nodej)
+                          do (setf >=-edges (cons k >=-edges))))
+        do (let* ((sorted->-edges (list-to-sorted-set >-edges #'<)))
+             (setf (aref gh i)
+                   (make-ccmf-node
+                    :>-edges sorted->-edges
+                    :>=-edges (sorted-set-difference
+                               (list-to-sorted-set >=-edges #'<)
+                               sorted->-edges
+                               #'<))))
+        finally (return gh)))
+
+(defun-raw compose-scg-path-lsts1 (gpath hpaths acc)
+  (if (or (endp hpaths)
+          (not (= (scg-path-start (car hpaths))
+                  (scg-path-end gpath))))
+    acc
+    (compose-scg-path-lsts1 gpath (cdr hpaths)
+                            (cons (compose-scg-paths gpath (car hpaths))
+                                  acc))))
+
+(defun-raw compose-scg-path-lsts (gpaths hpaths acc)
+  ;; gpaths should be a list of paths sorted in increasing order by their cdrs.
+  ;; hpaths should be a list of paths sorted in increasing order by their cars.
+  ;; acc is the accumulator
+  ;; returns a sorted-set of paths (sorted by path<).
+  (cond ((or (endp gpaths) (endp hpaths))
+         (list-to-sorted-set acc #'path<
+                             :test #'scg-path-equal
+                             :combine #'shortest-scg-path))
+        ((< (scg-path-end (car gpaths))
+            (scg-path-start (car hpaths)))
+         (compose-scg-path-lsts (cdr gpaths) hpaths acc))
+        ((> (scg-path-end (car gpaths))
+            (scg-path-start (car hpaths)))
+         (compose-scg-path-lsts gpaths (cdr hpaths) acc))
+        (t
+         (compose-scg-path-lsts (cdr gpaths)
+                                hpaths
+                                (compose-scg-path-lsts1 (car gpaths)
+                                                        hpaths
+                                                        acc)))))
+
+(defun-raw scg-counter-example? (scg diff)
+  (and ;;there is a new self loop:
+   (loop for path in diff
+         when (= (scg-path-start path)
+                 (scg-path-end path))
+           return t
+         finally (return nil))
+   ;;there is no old self loop (in which case, we have already checked it out).
+   (loop for path in (append (scg-paths scg)
+                             (scg-newest-paths scg)
+                             (sorted-set-difference (scg-new-newest-paths scg)
+                                                    diff
+                                                    #'path<
+                                                    :test #'scg-path-equal))
+         when (= (scg-path-start path)
+                 (scg-path-end path))
+           return nil
+         finally (return t))
+   ;; there is no >-edge from a CCM to itself:
+   (loop with graph = (scg-graph scg)
+         for i from 0 below (array-dimension graph 0)
+         when (member i (ccmf-node->-edges (aref graph i)))
+           return nil
+         finally (return t))
+   ;; the graph is idempotent
+   (let ((graph (scg-graph scg)))
+     (equalp (compose-scg-graphs graph graph)
+             graph))))
+
+(defun-raw shortest-self-loop (paths path)
+  (cond ((endp paths) path)
+        ((= (scg-path-start (car paths))
+            (scg-path-end (car paths)))
+         (shortest-self-loop (cdr paths)
+                             (if (or (null path)
+                                     (< (scg-path-length (car paths))
+                                        (scg-path-length path)))
+                                 (car paths)
+                               path)))
+        (t
+         (shortest-self-loop (cdr paths) path))))
+
+(defun-raw compose-scgs (g h i graph-hash)
+  (let ((ghgraph (compose-scg-graphs (scg-graph g) (scg-graph h)))
+        (ghpaths (compose-scg-path-lsts (sort (copy-list (scg-newest-paths g))
+                                              #'< :key #'scg-path-end)
+                                        (scg-newest-paths h)
+                                        nil)))
+    (mv-let (ni new? diff gh)
+            (update-scg-paths ghgraph ghpaths i graph-hash)
+            (if (scg-counter-example? gh diff)
+                (mv t ni (cons (scg-graph gh)
+                               (flatten-scg-path (shortest-self-loop diff nil))))
+              (mv nil ni (if (and new? (consp diff)) gh nil))))))
+
+(defun-raw scg-predecessors (scg)
+  (sorted-remove-duplicates (mapcar #'scg-path-start (scg-newest-paths scg))))
+
+(defun-raw scg-successors (scg)
+  (list-to-sorted-set (mapcar #'scg-path-end (scg-newest-paths scg))
+                      #'<))    
+
+(defun-raw organize-scgs-by-preds1 (scgs array)
+  (if (endp scgs)
+      nil
+    (let ((scg (car scgs)))
+      ;; to maintain the sortedness of the slots in the array, we loop through
+      ;; and build our lists on the way back.
+      (organize-scgs-by-preds1 (cdr scgs) array)
+      (loop for i in (scg-predecessors scg)
+            do (setf (aref array i)
+                     (cons scg (aref array i)))))))
+
+(defun-raw organize-scgs-by-preds (scgs numsites)
+  (let ((array (make-array numsites :initial-element nil :element-type 'list)))
+    (organize-scgs-by-preds1 scgs array)
+    array))
+
+(defun-raw union-scgs (scg-array indices)
+  (loop for i in indices
+        append (aref scg-array i) into union
+        finally (return (list-to-sorted-set union #'< :key #'scg-num))))
+        
+(defun-raw copy-scgs (scgs)
+  (loop for scg in scgs
+        collect (make-scg :graph (scg-graph scg)
+                          :num (scg-num scg)
+                          :paths (scg-paths scg)
+                          :newest-paths (scg-newest-paths scg)
+                          :new-newest-paths (scg-new-newest-paths scg))))
+
+(defun print-sct-loop-report (iteration comps state)
+  (ccg-io? performance nil state
+           (iteration comps)
+           (fms "Iteration: ~x0 Compositions: ~x1."
+                (list (cons #\0 iteration)
+                      (cons #\1 comps))
+                *standard-co*
+                state
+                nil)))
+
+(defun-raw print-sct-total-report (success? comps graph-hash start-time state)
+  (mv-let
+   (col state)
+   (ccg-io? size-change nil (mv col state)
+            (success?)
+            (fmt "~%SCT has found ~#0~[no~/a~] counter-example to ~
+                  termination. "
+                 (list (cons #\0 (if success? 0 1)))
+                 *standard-co*
+                 state
+                 nil)
+            :default-bindings ((col 0)))
+   (mv-let
+    (col state)
+    (ccg-io? performance nil (mv col state)
+             (comps graph-hash start-time internal-time-units-per-second)
+             (fmt1 "In the process, ~x0 total ~#1~[compositions ~
+                    were~/composition was~] performed and ~x2 unique ~
+                    ~#3~[graphs were~/graph was~] created. Total time taken ~
+                    was ~x4 seconds.~|"
+                   (list (cons #\0 comps)
+                         (cons #\1 (if (= comps 1) 1 0))
+                         (cons #\2 (hash-table-count graph-hash))
+                         (cons #\3 (if (= (hash-table-count graph-hash) 1)
+                                       1 0))
+                         (cons #\4 (/ (- (get-internal-run-time) start-time)
+                                      ;;internal-time-units-per-second
+                                      (coerce internal-time-units-per-second 'float))))
+                   col
+                   *standard-co*
+                   state
+                   nil)
+             :default-bindings ((col 0)))
+    (mv-let
+     (col state)
+     (ccg-io? size-change nil (mv col state)
+              ()
+              (fmt1 "~|" nil col *standard-co* state nil))
+     (declare (ignore col))
+     state))))
+
+(defun-raw sct (ccmfs numsites state)
+  ;; ccmfs: a list of CCMFs to be analyzed
+  ;; numsites: the number of contexts over which the CCMFs range.
+  ;; state: the state
+  ;; 
+  ;; OUTPUT: an error triple whose value is a counter-example of the form (cons
+  ;; g p) where g is a ccmf-graph and p is the shortest self-looping path
+  ;; associated with g.
+
+  ;; the basic algorithm for sct is fairly simple:
+  ;; * let S be the set of SCGs
+  ;; * repeat the following
+  ;;   * if there is a maximal ccmf without a > edge from some ccm to
+  ;;     itself, return the counter-example associated with that ccmf.
+  ;;   * let S' be S unioned with the result of composing every pair
+  ;;     <s,s'> in SxS such that the lastsite of s is the firstsite of s'.
+  ;;   * if S' = S, return nil
+  ;;   * set S <- S'
+  ;;
+  ;; however, this is inefficient, due to duplicate SCGs and the associativity
+  ;; of composition. Therefore, we do the following.
+
+  (let ((graph-hash (make-hash-table :test #-gcl 'equalp #+gcl 'equal))
+        (start-time (get-internal-run-time)))
+    ;; first, we create the scgs, putting them in the graph-hash
+    (mv-let
+     (i newest)
+     (ccmfs-to-scgs ccmfs graph-hash)
+     (progn
+       ;;(format t "~&i: ~A~%newest: ~A~%" i newest)
+       ;; we check if any of the new scgs are counter-examples to termination.
+       (loop
+        for scg in newest
+        for nnp = (scg-new-newest-paths scg)
+        when (scg-counter-example? scg nnp)
+        do (return-from sct (value (cons (scg-graph scg)
+                                         (flatten-scg-path
+                                          (shortest-self-loop nnp nil))))))
+       ;; we age the scgs.
+       (age-scgs newest)
+       ;; the main loop:
+       (loop
+        with total-comps = 0
+        with generators = (organize-scgs-by-preds (copy-scgs newest) numsites)
+        until (endp newest)
+        for iteration from 0
+        for new-newest = nil
+        for comps = 0
+        ;;do (print iteration)
+        ;; for every scg, g, to be processed
+        do (loop
+            for g in newest
+            ;; all the ends of the pathst associated with g:
+            for gsucc = (scg-successors g)
+            do (loop
+                ;; for each generator that starts at a context where g ends,
+                for h in (union-scgs generators gsucc)
+                ;; compose them together, checking for counter-examples along
+                ;; the way
+                do (mv-let (counter-example? ni gh)
+                           (compose-scgs g h i graph-hash)
+                           (progn
+                             (incf comps)
+                             (incf total-comps)
+                             (setf i ni)
+                             ;; if we've found it, print out the report and
+                             ;; return the counter-example.
+                             (cond (counter-example?
+                                    (pprogn
+                                     (increment-timer 'other-time state)
+                                     (print-sct-loop-report iteration comps
+                                                            state)
+                                     (print-sct-total-report nil
+                                                             total-comps
+                                                             graph-hash
+                                                             start-time
+                                                             state)
+                                     (increment-timer 'print-time state)
+                                     (return-from sct (value gh))))
+                                   ;; otherwise, if gh is new and different, we
+                                   ;; add it to our new-newest set.
+                                   (gh
+                                    (setf new-newest
+                                          (cons gh new-newest))))))))
+        ;; we age all of our SCGs.
+        do (age-scgs (list-to-sorted-set (append newest
+                                                 (copy-list new-newest))
+                                         #'< :key #'scg-num))
+        ;; new-newest is the new newest (hence the name).
+        do (setf newest new-newest)
+        ;; print the loop report.
+        do (pprogn
+            (increment-timer 'other-time state)
+            (print-sct-loop-report iteration comps state)
+            (increment-timer 'print-time state))
+        ;; if we never find a counter-example, print out the report and return
+        ;; nil.
+        finally (pprogn
+                 (increment-timer 'other-time state)
+                 (print-sct-total-report t total-comps graph-hash start-time state)
+                 (increment-timer 'print-time state)
+                 (return (value nil))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; the rest of the code connects our termination analysis with ACL2's ;;;
+;;; function admission process.                                        ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw find-funct (fn functs)
+  (cond ((endp functs)
+         (make-funct :fn fn))
+        ((eq fn (funct-fn (car functs)))
+         (car functs))
+        (t
+         (find-funct fn (cdr functs)))))
+
+(defun-raw t-machine-to-contexts (t-machine parent-funct functs)
+  (if (endp t-machine)
+      nil
+    (let* ((tac (car t-machine))
+           (call (access tests-and-call tac :call)))
+      (cons (make-context :ruler (access tests-and-call tac :tests)
+                          :call call
+                          :parent-funct parent-funct
+                          :call-funct (find-funct (ffn-symb call) functs))
+            (t-machine-to-contexts (cdr t-machine) parent-funct functs)))))
+
+(defun-raw t-machines-to-contexts1 (t-machines functs all-functs)
+  (if (endp t-machines)
+      nil
+    (cons (t-machine-to-contexts (car t-machines)
+                                 (car functs)
+                                 all-functs)
+          (t-machines-to-contexts1 (cdr t-machines)
+                                   (cdr functs)
+                                   all-functs))))
+
+(defun-raw t-machines-to-contexts (t-machines functs)
+  (t-machines-to-contexts1 t-machines functs functs))
+
+(defun-raw make-funct-structs (names arglists)
+  (if (endp names)
+      nil
+    (cons (make-funct :fn (car names)
+                      :formals (car arglists))
+          (make-funct-structs (cdr names) (cdr arglists)))))
+
+(defun ccg-measures-declared (measures)
+  ;;; tells us whether the user declared any measures
+  (and (consp measures)
+       (or (not (equal (car measures) *0*))
+       (ccg-measures-declared (cdr measures)))))
+
+(defun-raw context-array (contexts)
+  ;; turns a list of lists of contexts into an array and fixes the
+  ;; context-num field of each context to be its index in the array.
+  (let ((carray (coerce (loop for cs in contexts
+                              append cs)
+                        'vector)))
+    (loop for i from 0 below (length carray)
+          do (setf (context-num (aref carray i))
+                   (list i)))
+    carray))
+
+(defun-raw accg-scp-list (lst proved unproved)
+  ;; given a list of accgs, lst, performs scp on a cleaned version of the accg,
+  ;; putting the cleaned accg into proved if scp determines the accg is
+  ;; terminating or the original accg into unproved if it is not proven
+  ;; terminating.
+  (if (endp lst)
+      (mv proved unproved)
+    (let* ((accg (cln-accg (copy-accg (car lst)))))
+      (cond ((scp (copy-accg accg))
+             (accg-scp-list (cdr lst)
+                            (cons accg proved)
+                            unproved))
+            (t
+             (accg-scp-list (cdr lst) proved (cons (car lst) unproved)))))))
+ 
+(defun-raw accg-sct-list1 (lst i n proved unproved ces state)
+  ;; given a list of accgs, lst, performs sct on a cleaned version of each
+  ;; accg, putting the cleaned into proved if sct determines the accg is
+  ;; terminating or the original accg into unproved if it is not proven
+  ;; terminating.
+  (if (endp lst)
+      (pprogn
+       (let ((plen (len proved)))
+         (ccg-io? basics nil state
+                  (plen unproved)
+                  (fms "Size-change analysis has proven ~x0 out of ~x1 SCCs of ~
+                       the CCG terminating.~|"
+                       `((#\0 . ,plen)
+                         (#\1 . ,(+ plen (len unproved))))
+                       *standard-co*
+                       state
+                       nil)))
+       (value (list* proved unproved ces)))
+    (pprogn
+     (increment-timer 'other-time state)
+     (ccg-io? size-change nil state
+              ()
+              (fms "We now begin size change analysis on the ~n0 SCC out of ~
+                    ~n1."
+                   (list (cons #\0 `(,i))
+                         (cons #\1 n))
+                   *standard-co*
+                   state
+                   nil))
+     (increment-timer 'print-time state)
+     (let* ((accg (cln-accg (copy-accg (car lst)))))
+       (if (null accg)
+           ;; this should no longer happen because cln-accg no
+           ;; longer returns nil if there are empty ccmfs.
+           (pprogn
+            (increment-timer 'other-time state)
+            (ccg-io? size-change nil state
+                     ()
+                     (fms "A trivial analysis has revealed that this SCC is ~
+                           potentially non-terminating. We will set it aside ~
+                           for further refinement.~|" 
+                          nil *standard-co* state nil))
+            (increment-timer 'print-time state)
+            (accg-sct-list1 (cdr lst) (1+ i) n proved (cons (car lst) unproved)
+                            (cons nil ces) state))
+         (er-let*
+          ((ce (sct (accg-ccmfs accg) (array-dimension accg 0) state)))
+          (if (null ce)
+              (pprogn
+               (increment-timer 'other-time state)
+               (ccg-io? size-change nil state
+                        ()
+                        (fms "We have shown this SCC to be terminating, so we ~
+                              do not need to refine it any further.~|"
+                             nil *standard-co* state nil))
+               (increment-timer 'print-time state)
+               (accg-sct-list1 (cdr lst)
+                               (1+ i)
+                               n
+                               (cons accg proved)
+                               unproved
+                               ces
+                               state))
+            (pprogn
+             (increment-timer 'other-time state)
+             (ccg-io? size-change nil state
+                      ()
+                      (fms "This SCC is potentially non-terminating. We will ~
+                            set it aside for further refinement.~|"
+                           nil *standard-co* state nil))
+             (increment-timer 'print-time state)
+             (accg-sct-list1 (cdr lst)
+                             (1+ i)
+                             n
+                             proved
+                             (cons (car lst) unproved)
+                             (cons ce ces)
+                             state)))))))))
+
+(defun-raw accg-sct-list (lst proved unproved ces state)
+  (accg-sct-list1 lst 1 (len lst) proved unproved ces state))
+
+(defun ccg-counter-example-fn-name1 (char-lst pkg i wrld)
+  (declare (xargs :guard (and (standard-char-listp char-lst)
+                              (stringp pkg)
+                              (natp i)
+                              (plist-worldp wrld))))
+  (let ((name (intern$ (coerce (append char-lst
+                                       `(#\_)
+                                       (explode-nonnegative-integer i 10 nil))
+                               'string)
+                       pkg)))
+    (cond ((new-namep name wrld) (mv name i))
+          (t (ccg-counter-example-fn-name1 char-lst pkg (1+ i) wrld)))))
+
+(defun ccg-counter-example-fn-name (root i wrld)
+  (declare (xargs :guard (and (symbolp root)
+                              (plist-worldp wrld)
+                              (natp i))))
+  (ccg-counter-example-fn-name1 (coerce (symbol-name root) 'list)
+                                (symbol-package-name root)
+                                i
+                                wrld))
+
+(defun assoc-set-eq (key value alist)
+  (declare (xargs :guard (and (symbolp key)
+                              (alistp alist))))
+  (cond ((endp alist)
+         (acons key value alist))
+        ((eq key (caar alist))
+         (acons key value (cdr alist)))
+        (t
+         (assoc-set-eq key value (cdr alist)))))
+
+(defun assoc-eq-value (key default alist)
+  (declare (xargs :guard (and (symbolp key)
+                              (alistp alist))))
+  (let ((pair (assoc-eq key alist)))
+    (if (consp pair)
+        (cdr pair)
+      default)))
+
+(defun-raw aref-lst (array lst)
+  (mapcar #'(lambda (x) (aref array x)) lst))
+
+(defun-raw alist-add-eq (alist key val)
+  ;; given an alist whose values are lists, returns the alist
+  ;; resulting from adding val to the list that is the value
+  ;; corresponding to the key key.
+  (cond ((endp alist)
+         (acons key (list val) nil))
+        ((eq (caar alist) key)
+         (acons key (cons val (cdar alist)) (cdr alist)))
+        (t
+         (cons (car alist) (alist-add-eq (cdr alist) key val)))))
+
+(defun-raw order-names-arglists (names arglists rv-alist)
+  ;; when determining the minimal set of formals necessary to prove
+  ;; termination, we do a simple search of all the subsets of
+  ;; variables. to speed this up, we create a list indicating the
+  ;; order that we add the variables. this list is ordered by number
+  ;; of formals first, formal order second, and by function last. so,
+  ;; if we have function f with formals (x y) and function g with
+  ;; formals (a b), then the order would be ((f x) (g a) (f y) (g
+  ;; b)). So, the sets we would try, in the order we try them, are as
+  ;; follows:
+  ;;
+  ;; 1. {(f x)}
+  ;; 2. {(g a)}
+  ;; 3. {(f y)}
+  ;; 4. {(g b)}
+  ;; 5. {(f x) (g a)}
+  ;; 6. {(f x) (f y)}
+  ;; 7. {(f x) (g b)}
+  ;; 8. {(g a) (f y)}
+  ;; 9. {(g a) (g b)}
+  ;; 10. {(f y) (g b)}
+  ;; 11. {(f x) (g a) (f y)}
+  ;; 12. {(f x) (g a) (g b)}
+  ;; 13. {(f x) (f y) (g b)}
+  ;; 14. {(g a) (f y) (g b)}
+  ;; 15. {(f x) (g a) (f y) (g b)}
+  ;;
+  ;; the idea is that most functions require only a small subset of
+  ;; the actuals to prove termination.
+
+  (let* ((na-arrays (coerce (mapcar (lambda (x y) (coerce (cons x y) 'vector))
+                                    names arglists)
+                            'vector))
+         (maxsize (loop for v across na-arrays maximize (array-dimension v 0))))
+    (loop for i from 1 below maxsize
+          append (loop for array across na-arrays
+                       when (and (< i (array-dimension array 0))
+                                 (not (member-eq (aref array i)
+                                                 (cdr (assoc (aref array 0) rv-alist)))))
+                         collect (cons (aref array 0)
+                                       (aref array i))))))
+
+(defmacro-raw ccmf-tail-fn (ccmf contexts)
+  `(context-fn (aref ,contexts
+                     (car (ccmf-fc-num ,ccmf)))))
+
+(defmacro-raw ccmf-head-fn (ccmf contexts)
+  `(context-fn (aref ,contexts
+                     (car (ccmf-lc-num ,ccmf)))))
+
+(defun-raw restrict-ccmf (ccmf ccmr1 ccmr2)
+  ;; the dual to ccmf-remove-ccms, in that it only retains the ccms
+  ;; indicated by ccmr1 and ccmr2, but is not destructive.
+  (let* ((graph (ccmf-graph ccmf))
+         (n (array-dimension graph 0))
+         (ngraph (make-array n
+                             :element-type 'ccmf-node
+                             :initial-element (make-ccmf-node)))
+         (nccmf (make-ccmf :firstsite (ccmf-firstsite ccmf)
+                           :lastsite (ccmf-lastsite ccmf)
+                           :fc-num (ccmf-fc-num ccmf)
+                           :lc-num (ccmf-lc-num ccmf)
+                           :in-sizes (ccmf-in-sizes ccmf)
+                           :out-sizes (ccmf-out-sizes ccmf)
+                           :graph ngraph))
+         (f (lambda (x) (aref ccmr2 x))))
+    (loop for i from 0 below n
+          for node = (aref graph i)
+          if (aref ccmr1 i)
+            do (setf (aref ngraph i)
+                     (make-ccmf-node
+                      :>-edges (remove-if-not f (ccmf-node->-edges node))
+                      :>=-edges (remove-if-not f (ccmf-node->=-edges node))))
+          else
+            do (setf (aref ngraph i) (make-ccmf-node)))
+    (loop for node across ngraph
+          when (or (consp (ccmf-node->-edges node))
+                   (consp (ccmf-node->=-edges node)))
+            return nccmf
+          finally (return nil))))
+
+(defun-raw can-solve-restricted-accgs? (accgs ccmrs scp? state)
+  ;; this is the workhorse of our controller-alist search. given ccm
+  ;; restrictions (see create-ccm-restrictions), ccmrs, and a flag to
+  ;; indicate whether the original accg was solved using scp or sct,
+  ;; we restrict the accg and attempt to reprove termination.
+  (loop for accg in accgs
+        for n = (array-dimension accg 0)
+        for naccg = (make-array n)
+        ;; first, initiate the naccg nodes
+        do (loop for i from 0 below n
+                 for node = (aref accg i)
+                 do (setf (aref naccg i)
+                          (make-accg-node 
+                           :context (accg-node-context node)
+                           :num i)))
+        ;; next, set the ccmfs for those nodes to be the restricted
+        ;; version of the ccmfs of the original accg node.
+        do (loop
+            for i from 0 below n
+            for node = (aref accg i)
+            for nnode1 = (aref naccg i)
+            for ccmr1 = (aref ccmrs (car (accg-node-context-num node)))
+            do (loop
+                for edge in (accg-node-fwd-edges node)
+                for ccmf = (accg-edge-ccmf edge)
+                for ccmr2 = (aref ccmrs (accg-edge-head edge))
+                for nnode2 = (aref naccg (accg-edge-head edge))
+                for nccmf = (restrict-ccmf ccmf ccmr1 ccmr2)
+                if nccmf
+                  do (let ((nedge (make-accg-edge :head (accg-edge-head edge)
+                                                  :tail (accg-edge-tail edge)
+                                                  :ccmf nccmf)))
+                       (setf (accg-node-fwd-edges nnode1)
+                             (cons nedge (accg-node-fwd-edges nnode1)))
+                       (setf (accg-node-bwd-edges nnode2)
+                             (cons nedge (accg-node-bwd-edges nnode2))))
+                else do (return-from can-solve-restricted-accgs? (value nil))))
+        ;; finally, run scp or sct as indicated. if we fail, then we
+        ;; immediately return nil.
+         do (if scp?
+                (unless (scp (cln-accg naccg)) (return (value nil)))
+              (er-let*
+               ((caccg (value (cln-accg naccg)))
+                (ce (if (null caccg)
+                        (value t)
+                      (sct (accg-ccmfs caccg) n state))))
+               (unless (null ce) (return (value nil)))))
+        finally (return (value t))))
+                 
+(defun-raw create-ccm-restrictions (contexts av-alist)
+  ;; creates "ccm restrictions", which is an array of boolean arrays
+  ;; such that element i j is t iff we want to keep ccm j from context
+  ;; i. which ccms to keep is determined by av-alist, which tells us
+  ;; which variables from each function we are using for the current
+  ;; restriction. 
+  (loop with n = (array-dimension contexts 0)
+        with ccmrs = (make-array n)
+        for i from 0 below n
+        for context = (aref contexts i)
+        for ccms = (context-ccms context)
+        ;; vars are the variables we are allowed to use for this context.
+        for vars = (cdr (assoc (context-fn context) av-alist))
+        for m = (array-dimension ccms 0)
+        for ccmri = (make-array m
+                                :element-type 'boolean
+                                :initial-element nil)
+        do (setf (aref ccmrs i) ccmri)
+        do (loop for j from 0 below m
+                 do (setf (aref ccmri j)
+                          (subsetp (all-vars (aref ccms j))
+                                   vars)))
+        finally (return ccmrs)))
+
+(defun-raw ruler-vars (names contexts)
+  ;; returns an alist mapping fucntion names to the variables used in
+  ;; the rulers of the contexts of that function.
+  (loop with rv-alist = (pairlis$ names nil)
+        for context across contexts
+        for fn = (context-fn context)
+        for vars = (all-vars1-lst (context-ruler context) nil)
+        for pair = (assoc fn rv-alist)
+        do (setf (cdr pair) (union-eq vars (cdr pair)))
+        finally (return rv-alist)))
+
+(defun-raw cgma-aux (nalist proved-scp proved-sct contexts av-alist i state)
+  ;; helper function for ccg-generate-measure-alist. nalist is the
+  ;; list of function-formal pairs as generated by
+  ;; order-names-arglists. proved-scp is a list of accgs proved
+  ;; terminating by the scp algorithm, and proved-sct is a list of
+  ;; accgs proved terminating by the sct algorithm. contexts is the
+  ;; array of contexts. av-alist is an alist mapping each function
+  ;; name to the formals that we want enabled, and i is the number of
+  ;; formals we want to enable. returns the first av-alist
+  ;; for which we can prove termination, or nil if we cannot
+  ;; prove termination.
+  (cond ((zp i) ;; if we don't want to add any more variables, try to
+                ;; prove termination of the restricted accgs.
+         (let ((ccmrs (create-ccm-restrictions contexts av-alist)))
+           (er-let*
+            ((p1 (can-solve-restricted-accgs? proved-scp ccmrs t state))
+             (p2 (if p1
+                     (can-solve-restricted-accgs? proved-sct ccmrs nil state)
+                   (value nil))))
+            (if p2
+                (value av-alist)
+              (value nil)))))
+        ((endp nalist) ;; if we reach the end of the list before i
+                       ;; reaches 0, just return nil.
+         (value nil))
+        (t ;; otherwise, we proceed in two different ways:
+         (er-let*
+          ;; first, we enable the first formal in nalist and
+          ;; proceed to enable i-1 of the rest of the formals.
+          ((nav-alist (cgma-aux (cdr nalist) proved-scp proved-sct contexts
+                                (alist-add-eq av-alist
+                                              (caar nalist)
+                                              (cdar nalist))
+                                (1- i)
+                                state)))
+          ;; if we were successful, report our success.
+          (if nav-alist
+              (value nav-alist)
+            ;; otherwise, try leaving the current variable out
+            ;; and enable i of the remaining variables.
+            (cgma-aux (cdr nalist) proved-scp proved-sct
+                      contexts av-alist i state))))))
+
+(defun-raw ccg-generate-measure-alist1 (i nalist proved-scp proved-sct
+                                          contexts rv-alist state)
+  (er-let* ((av-alist (cgma-aux nalist proved-scp proved-sct
+                                contexts rv-alist i state)))
+           (if av-alist
+               (value (mapcar (lambda (x) (cons (car x) (cons :? (cdr x))))
+                              av-alist))
+             (ccg-generate-measure-alist1 (1+ i) nalist
+                                          proved-scp proved-sct
+                                          contexts rv-alist state))))
+
+(defun-raw ccg-generate-measure-alist (proved-scp proved-sct names arglists
+                                                  contexts cpn state)
+  ;; generates a measure-alist designed to minimize the resulting
+  ;; controller-alist. we return the restricted set of the ccms
+  ;; necessary for proving termination with :CCG consed onto the
+  ;; front. the result is a "pseudo-measure" from which ACL2 can
+  ;; compute a safe controller alist. proved-scp and proved-sct are
+  ;; the accgs proved terminating using the scp or sct algorithm,
+  ;; respectively. names is the list of names of the functions, and
+  ;; arglists is the list of the arglists for each function. contexts
+  ;; is the array of contexts. cpn tells us whether or not we proved
+  ;; termination constructing contexts by node rather than by
+  ;; edge. This is important because, in order to construct a sound
+  ;; controller-alist we need to include all the variables in the
+  ;; context rulers if we could not prove termination using per-node
+  ;; contexts.
+  
+  ;; first, we construct an alist of the initially enabled formals
+  ;; based on cpn, and use it to make an ordered list of name-formal
+  ;; pairs.
+
+  (let* ((rv-alist (if cpn (pairlis$ names nil) (ruler-vars names contexts)))
+         (nalist (order-names-arglists names arglists rv-alist)))
+    (ccg-generate-measure-alist1 0 nalist proved-scp proved-sct
+                                             contexts rv-alist state)))
+
+
+;;;;; ALL TERMINATION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun-raw name-var-pairs1 (name arglist rst)
+  ;; name: the name of a function
+  ;; arglist: the arglist of the function whose name is name
+  ;; rst: the list to which to append the result
+  ;;
+  ;; OUTPUT: ((name . x) | x in arglist) appended to rst.
+
+  (if (endp arglist)
+      rst
+    (acons name (car arglist)
+           (name-var-pairs1 name (cdr arglist) rst))))
+
+(defun-raw name-var-pairs (functs rv-alist)
+  ;; functs: a list of structs of type funct.
+  ;; rv-alist: an alist mapping the names of the functions in functs
+  ;; to subsets of their formals. The idea is that these are
+  ;; restricted variables. That is, in the measured-subset analysis,
+  ;; all subsets must be supersets of the variables specified in
+  ;; rv-alist.
+  ;;
+  ;; OUTPUT: two lists of the form ((fn . x) ...) where fn is the name
+  ;; of a function in funct and x is a formal of that function. The
+  ;; first list is of these pairs that we may consider removing from
+  ;; the measured subset, and the second is a list of these pairs that
+  ;; we may *not* consider removing from the measured subset (as
+  ;; specified by rv-alist).
+  (if (endp functs)
+      (mv nil nil)
+    (mv-let
+     (free fixed)
+     (name-var-pairs (cdr functs) rv-alist)
+     (let* ((funct (car functs))
+            (fn (funct-fn funct))
+            (rv (cdr (assoc fn rv-alist))))
+       (mv (name-var-pairs1 fn
+                            (set-difference-eq (funct-formals funct) rv)
+                            free)
+           (name-var-pairs1 fn rv fixed))))))
+
+(defun-raw get-ccm-vars1 (i ccms ccm-vars)
+  ;; i: integer such that 0 <= i < |ccms|.
+  ;; ccms: an array of calling context measures.
+  ;; ccm-vars: accumulator array such that ccm-vars[j] contains a list
+  ;; of all the variables in the expression ccms[j].
+  ;;
+  ;; OUTPUT: completed ccm-vars.
+  (cond ((< i 0)
+         ccm-vars)
+        (t
+         (setf (aref ccm-vars i)
+               (all-vars (aref ccms i)))
+         (get-ccm-vars1 (1- i) ccms ccm-vars))))
+
+(defun-raw get-ccm-vars (ccms)
+  ;; ccms: an array of ccms.
+  ;;
+  ;; OUTPUT: an array, ccm-vars, such that ccm-vars[i] contains the
+  ;; list of variables in expression ccms[i] for all 0 <= i < |ccms|
+  (let ((len (array-dimension ccms 0)))
+    (get-ccm-vars1 (1- len) ccms (make-array len
+                                             :element-type 'list
+                                             :initial-element nil))))
+                    
+(defun-raw fn-ccm-vars-alist (functs)
+  (if (endp functs)
+      nil
+    (let ((funct (car functs)))
+      (acons (funct-fn funct) (get-ccm-vars (funct-ccms funct))
+             (fn-ccm-vars-alist (cdr functs))))))
+   
+(defun-raw gather-relevant-ccms1 (i var ccm-vars indices)
+  ;; i: an integer such that 0 <= i < |ccm-vars|. Should initially be |ccm-vars|-1.
+  ;; ccm-vars: an array of lists of integers.
+  ;; var: a variable
+  ;; indices: the accumulator; it is { k | i < k < |ccm-vars|
+  ;;   s.t. ccm-vars[k] contains var }. Should initially be nil.
+  ;;
+  ;; OUTPUT: { k | 0 <= k < |ccm-vars| s.t. ccm-vars[k] contains var }
+  (if (< i 0)
+      indices
+    (gather-relevant-ccms1 (1- i) var ccm-vars
+                           (if (member-eq var (aref ccm-vars i))
+                               (cons i indices)
+                             indices))))
+      
+(defun-raw gather-relevant-ccms (var ccm-vars)
+  ;; ccm-vars: an array of lists of variables
+  ;; var: a variable
+  ;;
+  ;; OUTPUT: the list of the indices of the slots of ccm-vars that
+  ;; contain var.
+  (gather-relevant-ccms1 (1- (array-dimension ccm-vars 0)) var ccm-vars nil))
+
+(defun-raw gather-all-relevant-ccms1 (avars alist)
+  ;; functs: a list of structures of type funct
+  ;;
+  ;; OUTPUT: a mapping of sorts from formals to the ccms containing
+  ;; those formals. See the note on the output of
+  ;; gather-all-relevant-ccms-for-funct.
+  (if (endp avars)
+      nil
+    (let* ((avar (car avars))
+           (fn (car avar))
+           (var (cdr avar)))
+    (cons (gather-relevant-ccms var (cdr (assoc fn alist)))
+          (gather-all-relevant-ccms1 (cdr avars) alist)))))
+
+(defun-raw gather-all-relevant-ccms (avars functs)
+  (gather-all-relevant-ccms1 avars (fn-ccm-vars-alist functs)))
+
+(defun set-difference-and-intersection (set1 set2)
+  (declare (xargs :guard (and (eqlable-listp set1)
+                              (eqlable-listp set2))))
+  ;; set1: an eqlable-listp.
+  ;; set2: an eqlable-listp
+  ;;
+  ;; OUTPUT: two lists. The first is the difference of set1 and set2,
+  ;; and the second is the intersection of set1 and set2.
+  (if (endp set1)
+      (mv nil nil)
+    (mv-let (difference intersection)
+            (set-difference-and-intersection (cdr set1) set2)
+            (if (member (car set1) set2)
+                (mv difference (cons (car set1) intersection))
+              (mv (cons (car set1) difference) intersection)))))
+
+(defun-raw ccmf-remove-relevant-edges1 (i graph relevant-ccms1 relevant-ccms2
+                                          edges-alist)
+  ;; i: integer such that 0 <= i < |graph|.
+  ;; graph: a ccmf-graph.
+  ;; relevant-ccms1: an increasing list of integers, j, such that 0 <=
+  ;; j < |graph|. These are the ccms we are to virtually remove from
+  ;; the graph by removing all its outgoing edges.
+  ;; ASSUMPTION: relevant-ccms1 is in increasing order.
+  ;; relevant-ccms2: a list of natural numbers. These are the ccms we
+  ;; are to virtually remove from the target context of the graph by
+  ;; removing all of its incoming edges.
+  ;; edges-alist: the accumulator alist that maps each 0 <= j <
+  ;; |graph| to a cons of the >-edges and >=-edges removed from the
+  ;; graph, so we can put them back later.
+  ;;
+  ;; SIDE EFFECT: all edges to and from relevant ccms in the graph are
+  ;; removed.
+  ;;
+  ;; OUTPUT: the completed edges-alist.
+
+  (cond ((<= (array-dimension graph 0) i)
+         edges-alist)
+        ((and (consp relevant-ccms1)
+              (= i (car relevant-ccms1)))
+         ;; if i is a member of relevant-ccms1, it is the first
+         ;; element because of our assumption that relevant-ccms1 is
+         ;; increasing. In this case we remove all the outgoing edges
+         ;; from graph[i].
+         (let* ((node (aref graph i))
+                (>-edges-i (ccmf-node->-edges node)) ;;get the >-edges
+                (>=-edges-i (ccmf-node->=-edges node))) ;; get the >=-edges
+           (setf (ccmf-node->-edges node) nil) ;; set the >-edges to nil
+           (setf (ccmf-node->=-edges node) nil) ;; set the >=-edges to nil
+           (ccmf-remove-relevant-edges1 (1+ i) graph
+                                        (cdr relevant-ccms1) relevant-ccms2
+                                        ;; add the removed edges (if
+                                        ;; any) to the accumulator:
+                                        (if (and (endp >-edges-i) (endp >=-edges-i))
+                                            edges-alist
+                                          (acons i (cons >-edges-i >=-edges-i) 
+                                                 edges-alist)))))
+        ((consp relevant-ccms2)
+         ;; if a non-nil relevant-ccms2 was supplied, we remove all
+         ;; the edges pointing from graph[i] to ccms specified by
+         ;; relevant-ccms2.
+         (let* ((node (aref graph i))
+                (>-edges-i (ccmf-node->-edges node))
+                (>=-edges-i (ccmf-node->=-edges node)))
+           (mv-let (>-diff >-intersect)
+                   (set-difference-and-intersection >-edges-i relevant-ccms2)
+                   (mv-let (>=-diff >=-intersect)
+                           (set-difference-and-intersection >=-edges-i relevant-ccms2)
+                           (progn
+                             ;; if we removed any edges, set the new
+                             ;; edge lists.
+                             (when (consp >-intersect)
+                               (setf (ccmf-node->-edges node) >-diff))
+                             (when (consp >=-intersect)
+                               (setf (ccmf-node->=-edges node) >=-diff))
+                             (ccmf-remove-relevant-edges1
+                              (1+ i) graph
+                              relevant-ccms1 relevant-ccms2
+                              ;; add the removed edges (if any) to the accumulator.
+                              (if (and (endp >-intersect) (endp >=-intersect))
+                                  edges-alist
+                                (acons i (cons >-intersect >=-intersect)
+                                       edges-alist))))))))
+        (t
+         ;; if the current index is not in relevant-ccms1 and
+         ;; relevant-ccms2 is empty, there is nothing to do, so we
+         ;; move on to the next index.
+         (ccmf-remove-relevant-edges1 (1+ i)
+                                      graph
+                                      relevant-ccms1
+                                      relevant-ccms2
+                                      edges-alist))))
+
+(defun-raw ccmf-remove-relevant-edges (ccmf relevant-ccms1 relevant-ccms2)
+  ;; ccmf: a struct of type ccmf.
+  ;; relevant-ccms1: an increasing list of integers, j, such that 0 <=
+  ;; j < |graph|. These are the ccms we are to virtually remove from
+  ;; the graph by removing all its outgoing edges.
+  ;; ASSUMPTION: relevant-ccms1 is in increasing order.
+  ;; relevant-ccms2: a list of natural numbers. These are the ccms we
+  ;; are to virtually remove from the target context of the graph by
+  ;; removing all of its incoming edges.
+  ;;
+  ;; SIDE EFFECT: all edges to and from relevant ccms in the ccmf are
+  ;; removed.
+  ;;
+  ;; OUTPUT: the ccmf consed to an alist that maps each 0 <= j <
+  ;; |graph| to a cons of the >-edges and >=-edges removed from the
+  ;; graph, so we can put them back later.
+
+  (let ((graph (ccmf-graph ccmf)))
+    (cons ccmf
+          (ccmf-remove-relevant-edges1 0
+                                       graph
+                                       relevant-ccms1 relevant-ccms2
+                                       nil))))
+
+(defun-raw ccmf-remove-relevant-edges-lst (ccmfs contexts fn relevant-ccms acc)
+  ;; ccmfs: a list of structs of type ccmf which should be the ccmfs for fn.
+  ;; contexts: an array of contexts.
+  ;; fn: a function name
+  ;; relevant-ccms: a list of indices of the ccms of fn. Indicates
+  ;; which ccms to remove.
+  ;; acc: the accumulator. This accumulates the removed edge
+  ;; information so we can restore the ccmfs when we are done.
+  ;;
+  ;; SIDE EFFECT: all edges to and from relevant ccms in the ccmfs of
+  ;; are removed.
+  ;;
+  ;; OUTPUT: the completed accumulator. It is an alist mapping the
+  ;; ccmfs to an alist mapping the indicices of the source ccms of the
+  ;; ccmf to a cons of the >-edges and >=-edges that were removed.
+
+  (if (endp ccmfs)
+      acc
+    (let* ((ccmf (car ccmfs))
+           (tcontext (aref contexts (car (ccmf-fc-num ccmf))))
+           (relevant-ccms1 (if (eq (context-fn tcontext) fn) relevant-ccms nil))
+           (hcontext (aref contexts (car (ccmf-lc-num ccmf))))
+           (relevant-ccms2 (if (eq (context-fn hcontext) fn) relevant-ccms nil)))
+      (ccmf-remove-relevant-edges-lst
+       (cdr ccmfs)
+       contexts
+       fn
+       relevant-ccms
+       (cons (ccmf-remove-relevant-edges ccmf relevant-ccms1 relevant-ccms2)
+             acc)))))
+
+(defun-raw accg-remove-relevant-ccmf-edges1 (i accg contexts fn relevant-ccms acc)
+  ;; i: natural number such that 0 <= i < |accg|.
+  ;; accg: an array of structs of type accg-node.
+  ;; contexts: an array of contexts.
+  ;; fn: a function name.
+  ;; relevant-ccms: the ccms to remove from all ccmfs corresponding to fn.
+  ;; acc: the accumulator. 
+  ;; 
+  ;; SIDE EFFECT: all edges to and from relevant ccms in the ccmfs of
+  ;; the accg are removed.
+  ;;
+  ;; OUTPUT: an alist mapping the ccmfs to an alist mapping the
+  ;; indicices of the source ccms of the ccmf to a cons of the >-edges
+  ;; and >=-edges that were removed.
+  (if (< i 0)
+      acc
+    (let* ((node (aref accg i)))
+      (accg-remove-relevant-ccmf-edges1
+       (1- i)
+       accg
+       contexts
+       fn
+       relevant-ccms
+       (if (eq (accg-node-fn node) fn)
+           (let ((pred (lambda (edge)
+                         (equal (accg-node-fn (aref accg (accg-edge-tail edge)))
+                                fn))))
+             (ccmf-remove-relevant-edges-lst
+              (append (mapcar #'accg-edge-ccmf
+                              (accg-node-fwd-edges node))
+                      ;; remove all edges from contexts of fn to avoid
+                      ;; redundant work.
+                      (mapcar #'accg-edge-ccmf
+                              (remove-if pred 
+                                         (accg-node-bwd-edges node))))
+              contexts
+              fn
+              relevant-ccms
+              acc))
+         acc)))))
+
+(defun-raw accg-remove-relevant-ccmf-edges (accg contexts fn relevant-ccms)
+  
+  ;; accg: an array of structs of type accg-node.
+  ;; contexts: an array of contexts.
+  ;; fn: a function name.
+  ;; relevant-ccms: the ccms to remove from all ccmfs corresponding to fn.
+  ;; 
+  ;; SIDE EFFECT: all edges to and from relevant ccms in the ccmfs of
+  ;; the accg are removed.
+  ;;
+  ;; OUTPUT: an alist mapping the ccmfs to an alist mapping the
+  ;; indicices of the source ccms of the ccmf to a cons of the >-edges
+  ;; and >=-edges that were removed.
+  
+  (accg-remove-relevant-ccmf-edges1 (1- (array-dimension accg 0))
+                                    accg
+                                    contexts
+                                    fn
+                                    relevant-ccms
+                                    nil))
+
+(defun-raw accg-remove-relevant-ccmf-edges-lst-tail (accgs contexts fn relevant-ccms acc)
+  ;; tail recursive implementation of accg-remove-relevant-ccmf-edges-lst
+
+  (if (endp accgs)
+      acc
+    (accg-remove-relevant-ccmf-edges-lst-tail
+     (cdr accgs)
+     contexts
+     fn
+     relevant-ccms
+     (accg-remove-relevant-ccmf-edges1
+      (1- (array-dimension (car accgs) 0))
+      (car accgs)
+      contexts
+      fn
+      relevant-ccms
+      acc))))
+
+(defun-raw accg-remove-relevant-ccmf-edges-lst (accgs contexts fn relevant-ccms)
+  ;; accgs: a list of accgs.
+  ;; contexts: an array of contexts
+  ;; fn: function name
+  ;; relevant-ccms: the ccms of fn to "remove" (ccms are kept, but all
+  ;; incoming and outgoing edges are removed).
+  ;;
+  ;; SIDE-EFFECT: all the incoming and outgoing edges of the indicated
+  ;; ccms of fn in the ccmfs of the accgs are removed.
+  ;;
+  ;; OUTPUT: an alist mapping the ccmfs to an alist mapping the
+  ;; indicices of the source ccms of the ccmf to a cons of the >-edges
+  ;; and >=-edges that were removed.
+  (accg-remove-relevant-ccmf-edges-lst-tail accgs contexts fn relevant-ccms nil))
+
+(defun-raw restore-edges1 (ccmf alist)
+  ;; ccmf: a struct of type ccmf.
+  ;; alist: maps indices of the ccmf to the cons of the >-edges and
+  ;; >=-edges that should be added back to the ccmf.
+  ;; 
+  ;; SIDE-EFFECT: the edges indicated by the alist are added back to the ccmf.
+  ;;
+  ;; OUTPUT: nil.
+  (if (endp alist)
+      nil
+    (let* ((entry (car alist))
+           (i (car entry))
+           (>-edges (cadr entry))
+           (>=-edges (cddr entry))
+           (node (aref (ccmf-graph ccmf) i)))
+      (setf (ccmf-node->-edges node)
+            (merge 'list
+                   >-edges
+                   (ccmf-node->-edges node)
+                   #'<))
+      (setf (ccmf-node->=-edges node)
+            (merge 'list
+                   >=-edges
+                   (ccmf-node->=-edges node)
+                   #'<))
+      (restore-edges1 ccmf (cdr alist)))))
+
+(defun-raw restore-edges (alist)
+  ;; alist: maps ccmfs to alists mapping indices of the ccmf to the
+  ;; cons of the >-edges and >=-edges that should be added back to the
+  ;; ccmf.
+  ;; 
+  ;; SIDE-EFFECT: the edges indicated by the alist are added back to
+  ;; their respective ccmfs.
+  ;;
+  ;; OUTPUT: nil.
+
+  (if (endp alist)
+      nil
+    (progn
+      (restore-edges1 (caar alist) (cdar alist))
+      (restore-edges (cdr alist)))))
+  
+(defun-raw can-scp-lstp (accgs)
+  ;; accgs: a list of accgs.
+  ;;
+  ;; OUTPUT: returns non-nil iff scp succeeds for all the accgs.
+  (or (endp accgs)
+      (and (scp (cln-accg (copy-accg (car accgs))))
+           (can-scp-lstp (cdr accgs)))))
+
+(defun-raw can-sct-lstp (accgs state) 
+  ;; accgs: a list of accgs
+  ;; state: the state
+  ;;
+  ;; OUTPUT: returns non-nil iff sct succeeds for the ccmfs of all the accgs.
+  (if (endp accgs)
+      (value t)
+    (let ((naccg (cln-accg (copy-accg (car accgs)))))
+      (if (null naccg)
+          (value nil)
+        (er-let*
+         ((ce (sct (accg-ccmfs naccg)
+                   (array-dimension naccg 0)
+                   state)))
+         (if (null ce)
+             (can-sct-lstp (cdr accgs) state)
+           (value nil)))))))
+
+(defun remove-covered-subsets-tail (avar subsets acc)
+  ;;tail recursive implementation of remove-covered-subsets
+  (cond ((endp subsets) acc)
+        ((equal avar (caar subsets))
+         (remove-covered-subsets-tail avar (cdr subsets) acc))
+        (t
+         (remove-covered-subsets-tail avar
+                                      (cdr subsets)
+                                      (cons (car subsets) acc)))))
+
+(defun remove-covered-subsets (avar subsets)
+  ;; avar: an element.
+  ;; subsets: a list of lists.
+  ;;
+  ;; OUTPUT: the subset of subsets which do not have avar as its first element.
+  (remove-covered-subsets-tail avar subsets nil))
+
+(defun remove-avar-from-subsets-tail (avar subsets acc)
+  ;; a tail-recursive implementation of remove-avar-from-subsets.
+  (if (endp subsets)
+      acc
+    (remove-avar-from-subsets-tail avar (cdr subsets)
+                                   (cons (if (equal avar (caar subsets))
+                                             (cdar subsets)
+                                           (car subsets))
+                                         acc))))
+
+(defun remove-avar-from-subsets (avar subsets)
+  ;; avar: an element
+  ;; subsets: a list of lists
+  ;;
+  ;; OUTPUT: the result of removing avar from all the lists in subsets
+  ;; for which avar is the first element.
+  (remove-avar-from-subsets-tail avar subsets nil))
+
+(defun add-avar-to-subsets-tail (avar subsets acc)
+  ;; a tail-recursive implementation of add-avar-to-subsets.
+  (if (endp subsets)
+      acc
+    (add-avar-to-subsets-tail avar (cdr subsets)
+                              (acons avar (car subsets) acc))))
+
+(defun add-avar-to-subsets (avar subsets)
+  ;; avar: an element.
+  ;; subsets: a list of lists.
+  ;;
+  ;; OUTPUT: the result of consing avar to every element of subsets.
+  (add-avar-to-subsets-tail avar subsets nil))
+         
+(defun-raw all-termination1 (proved-scp proved-sct contexts avars
+                                        relevant-edges subsets state)
+  ;; proved-scp: a list of accgs for which scp succeeds.
+  ;; proved-sct: a list of accgs for which sct succeeds.
+  ;; contexts: an array of contexts.
+  ;; avars: a list of pairs of the form (fn. x) where fn is a function
+  ;; name, and x is a formal of that function.
+  ;; relevant-edges: a list of lists of indices such that the ith
+  ;; element of avars appears exactly in the ccms of the corresponding
+  ;; function indicated by the indices of the ith member of relevant-edges.
+
+  ;; subsets: a list of lists of the elements of avars. This helps us
+  ;; avoid finding supersets of already discovered measured-subsets by
+  ;; telling us what subsets to avoid (because they would result in a
+  ;; superset of an already calculated measured-subset).
+  ;;
+  ;; OUTPUT: a list of lists of the elements of avars coresponding to
+  ;; minimal variables needed to still successfully run scp on the
+  ;; elements of proved-scp and run sct on the elements of proved-sct.
+  (cond ((member-equal '() subsets)
+         ;; if '() is in subsets, that means that we have recreated an
+         ;; already calculated measured-subset, so we stop and return
+         (value '()))
+        ((endp avars)
+         ;; since we prune as we go, we know that if we make it to the
+         ;; end of the avars, we have a solution. So, we return the
+         ;; set containing the empty set, which will be populated on
+         ;; our way back up the search tree.
+         (value '(())))
+        (t
+         (let* ((avar (car avars)) ;; take the first avar.
+                (fn (car avar))   ;; the formal name
+                
+                ;; we begin by removing all the ccm edges that are
+                ;; relevant to var from all the accgs in both
+                ;; proved-sct and proved scp.
+                
+                (re-info (accg-remove-relevant-ccmf-edges-lst-tail
+                          proved-sct
+                          contexts
+                          fn
+                          (car relevant-edges)
+                          (accg-remove-relevant-ccmf-edges-lst
+                           proved-scp
+                           contexts
+                           fn
+                           (car relevant-edges)))))
+
+           ;; if we can still prove termination without var, we
+           ;; continue our search down the subtree in which var
+           ;; is disabled. otherwise, we set nsubsets to be the
+           ;; empty set.
+           (er-let*
+            ((p (can-sct-lstp proved-sct state))
+             (nsubsets (if (and p
+                                (can-scp-lstp proved-scp))
+                           (all-termination1 proved-scp proved-sct
+                                             contexts
+                                             (cdr avars) (cdr relevant-edges)
+                                             (remove-covered-subsets avar subsets)
+                                             state)
+                         (value '()))))
+            (progn
+              ;; next we restore the edges we removed.
+              (restore-edges re-info)
+              ;; finally, we search the branch of the search tree in
+              ;; which var is enabled.
+              (er-let*
+               ((nnsubsets (all-termination1
+                            proved-scp proved-sct
+                            contexts
+                            (cdr avars) (cdr relevant-edges)
+                            (append nsubsets
+                                    (remove-avar-from-subsets avar subsets))
+                            state)))
+               ;; our solution is all the minimal measured subsets we
+               ;; discovered with var disabled along with var added to
+               ;; all the minimal measured subsets we discovered with
+               ;; var enabled.
+               (value (append nsubsets
+                              (add-avar-to-subsets avar nnsubsets))))))))))
+                
+(defun-raw funct-fns-lst (functs)
+  ;; given a list of functs, returns a corresponding list of all their funct-fns.
+  (if (endp functs)
+      nil
+    (cons (funct-fn (car functs)) (cdr functs))))
+
+(defun append-to-all (list list-of-lists)
+  (if (endp list-of-lists)
+      nil
+    (cons (append list (car list-of-lists))
+          (append-to-all list (cdr list-of-lists)))))
+
+(defun-raw all-termination (proved-scp proved-sct contexts functs cpn state)
+  ;; proved-scp: a list of accgs for which scp succeeds.
+  ;; proved-sct: a list of accgs for which sct succeeds.
+  ;; contexts: an array of contexts.
+  ;; functs: a list of structures of type funct.
+  ;; cpn: a boolean telling us if we proved termination using ccmfs
+  ;; per node (as opposed to per edge).
+  ;;
+  ;; OUTPUT: the minimal measured subsets of functs using the accgs
+  ;; that were used to prove termination.
+  
+  ;; we need this strange case in the beginning.
+  (if (and (endp proved-scp)
+           (endp proved-sct))
+      (value '(()))
+
+    (let ((names (funct-fns-lst functs)))
+      (mv-let
+       (free fixed)
+       ;; if we proved termination with ccmfs per node, then by
+       ;; Vroon's dissertation, there is a measure involving only
+       ;; those variables that are needed to show termination in
+       ;; proved-scp and proved-sct. That is, all variables are
+       ;; candidates for removal from the measured-subset. If we
+       ;; used ccmfs per edge, then the dissertation tells us
+       ;; that we need to keep all variables that appear in the
+       ;; ruler. So these are off-limits for removal from the
+       ;; measured subset.
+       (name-var-pairs functs
+                       (if cpn
+                           (pairlis$ names nil)
+                         (ruler-vars names contexts)))
+       ;; we append all the required variables to the calculated
+       ;; measured subset.
+       (let ((relevant-ccms (gather-all-relevant-ccms free functs)))
+         (er-let* ((at1 (all-termination1 proved-scp proved-sct
+                                          contexts free relevant-ccms nil state)))
+                  (value (append-to-all fixed at1))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ACL2 integration                       ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun get-ccms1 (m edcls key ctx state)
+  
+  ;; this function is based on get-measures1 in the ACL2 sources.
+
+  ;; A typical edcls is given above, in the comment for get-guards.  Note
+  ;; that the :CCMs entry is found in an XARGS declaration.  By the check
+  ;; in chk-dcl-lst we know there is at most one :CCMs entry in each XARGS
+  ;; declaration.  But there may be more than one declaration.  If more than
+  ;; one measure is specified by this edcls, we'll cause an error.  Otherwise,
+  ;; we return the measure or the term *0*, which is taken as a signal that
+  ;; no measure was specified.
+  
+  ;; Our first argument, m, is the list of ccms term found so far, or
+  ;; *0* if none has been found.  We map down edcls and ensure that
+  ;; each XARGS either says nothing about :CCMs or specifies m.
+
+  (cond ((null edcls) (value m))
+        ((eq (caar edcls) 'xargs)
+         (let ((temp (assoc-keyword key (cdar edcls))))
+           (cond ((null temp)
+                  (get-ccms1 m (cdr edcls) key ctx state))
+                 ((equal m *0*)
+                  (get-ccms1 (cadr temp) (cdr edcls) key ctx state))
+                 ((and (subsetp-equal m (cadr temp))
+                       (subsetp-equal (cadr temp) m))
+                  (get-ccms1 m (cdr edcls) key ctx state))
+                 (t (er soft ctx
+                        "It is illegal to declare two different ~
+                         sets values for the key ~x0 for the admission ~
+                         of a single function. But you have specified ~
+                         ~x0 ~x1 and ~x1 ~x2."
+                        key m (cadr temp))))))
+        (t (get-ccms1 m (cdr edcls) key ctx state))))
+
+(defun get-ccms2 (lst key ctx state)
+  ;; this function is based on get-measures2 in the acl2-sources
+  (cond ((null lst) (value nil))
+        (t (er-let* ((m (get-ccms1 *0* (fourth (car lst)) key ctx state))
+                     (rst (get-ccms2 (cdr lst) key ctx state)))
+                    (value (cons m rst))))))
+
+(defun get-ccms (symbol-class lst key ctx state)
+
+  ;; based on get-measures in the ACL2 sources
+
+  ;; This function returns a list in 1:1 correspondence with lst containing
+  ;; the user's specified :CCMs (or *0* if no measure is specified).  We
+  ;; cause an error if more than one :CCMs is specified within the edcls of
+  ;; a given element of lst.
+
+  ;; If symbol-class is program, we ignore the contents of lst and simply return
+  ;; all *no-measure*s.  See the comment in chk-acceptable-defuns where get-ccms is
+  ;; called.
+
+  (cond
+   ((eq symbol-class :program)
+    (value (make-list (length lst) :initial-element *0*)))
+   (t (get-ccms2 lst key ctx state))))
+
+(defun translate-ccms-list (ccms-list ctx wrld state)
+  ;; translates a list of ccm lists using translate measures.
+  (cond ((endp ccms-list) (value nil))
+        (t (er-let* ((tccms (if (eq (car ccms-list) *0*)
+                                (value *0*)
+                              (translate-measures (car ccms-list)
+                                                  ctx wrld state)))
+                     (rst (translate-ccms-list (cdr ccms-list)
+                                               ctx wrld state)))
+                    (value (cons tccms rst))))))
+
+(defun chk-no-overlap (consider consider-only)
+  ;; makes sure that, for each function, there is not both a consider
+  ;; and consider-only hint.
+  (cond ((endp consider)
+         nil)
+        ((not (or (eq (car consider) *0*)
+                  (eq (car consider-only) *0*)))
+         (cons consider consider-only))
+        (t
+         (chk-no-overlap (cdr consider) (cdr consider-only)))))
+
+(defun combine-ccm-hints (consider consider-only uc uco ctx state)
+
+  ;; combines the :CONSIDER-CCMS and :CONSIDER-ONLY-CCMS hints into one list of
+  ;; CCMs. We do not allow both of these to be specified for the same function,
+  ;; so we check that one or the other is *0*. The value returned is a list of
+  ;; pairs. The car of each pair is nil iff the given CCM is from a
+  ;; :CONSIDER-CCMS hint and non-nil if it is from a :CONSIDER-ONLY-CCMS
+  ;; hint. The cdr of each pair is the hint itself. If neither xarg is given
+  ;; (i.e. if they are both *0*) for a given function, the car of the pair is
+  ;; nil, and the cdr is *0*.
+
+  (cond ((endp consider)
+         (value nil))
+        ((eq (car consider-only) *0*)
+         (er-let* ((rst (combine-ccm-hints (cdr consider) (cdr consider-only)
+                                           (cdr uc) (cdr uco)
+                                           ctx state)))
+                  (value (acons nil (car consider) rst))))
+        ((eq (car consider) *0*)
+         (er-let* ((rst (combine-ccm-hints (cdr consider) (cdr consider-only)
+                                           (cdr uc) (cdr uco)
+                                           ctx state)))
+                  (value (acons t (car consider-only) rst))))
+        (t
+         (er soft ctx
+             "It is illegal to provide both a :CONSIDER and ~
+              a :CONSIDER-ONLY hint for the same function. But ~
+              you have specified :CONSIDER ~x0 and :CONSIDER-ONLY ~x1."
+             (car uc) (car uco)))))
+
+(defconst *ccg-xargs-keywords*
+  '(:CONSIDER-CCMS :CONSIDER-ONLY-CCMS :TERMINATION-METHOD
+                   :CCG-PRINT-PROOFS :TIME-LIMIT
+                   :CCG-HIERARCHY))
+                            
+(defun get-unambiguous-xargs-val1/edcls (key v edcls ctx state)
+
+; V is the value specified so far for key in the XARSGs of this or previous
+; edcls, or else the consp '(unspecified) if no value has been specified yet.
+; We cause an error if a value different from that specified so far is
+; specified.  We return either the consp '(unspecified) or the uniformly agreed
+; upon value.
+
+  (cond
+   ((null edcls) (value v))
+   ((eq (caar edcls) 'xargs)
+    (let ((temp (assoc-keyword key (cdar edcls))))
+      (cond ((null temp)
+             (get-unambiguous-xargs-val1/edcls key v (cdr edcls) ctx state))
+            ((or (consp v)
+                 (equal v (cadr temp)))
+             (get-unambiguous-xargs-val1/edcls key (cadr temp) (cdr edcls)
+                                              ctx state))
+            (t
+             (er soft ctx
+                 "It is illegal to specify ~x0 ~x1 in one place and ~
+                  ~x2 in another within the same definition.  The ~
+                  functionality controlled by that flag operates on ~
+                  the entire event or not at all."
+                 key v (cadr temp))))))
+   (t (get-unambiguous-xargs-val1/edcls key v (cdr edcls) ctx state))))
+
+(defun get-unambiguous-xargs-val1 (key lst ctx state)
+
+; We scan the edcls of lst and either extract a single uniformly agreed
+; upon value for key among the XARGS and return that value, or else no
+; value is specified and we return the consp '(unspecified) or else two or
+; more values are specified and we cause an error.  We also cause an error
+; if any edcls specifies a non-symbol for the value of key.  Thus, if we
+; return a symbol it is the uniformly agreed upon value and if we return
+; a consp there was no value specified.
+
+  (cond ((null lst) (value '(unspecified)))
+        (t (er-let*
+            ((v (get-unambiguous-xargs-val1 key (cdr lst) ctx state))
+             (ans (get-unambiguous-xargs-val1/edcls key v (fourth (car lst))
+                                                    ctx state)))
+            (value ans)))))
+
+(defun get-unambiguous-xargs-val (key lst default ctx state)
+
+; Lst is a list of mutually recursive defun tuples of the form (name args doc
+; edcls body).  We scan the edcls for the settings of the XARGS keyword key.
+; If at least one entry specifies a setting, x, and all entries that specify a
+; setting specify x, we return x.  If no entry specifies a setting, we return
+; default.  If two or more entries specify different settings, we cause an
+; error.
+
+; We assume every legal value of key is a symbol.  If you supply a consp
+; default and the default is returned, then no value was specified for key.
+
+; Just to be concrete, suppose key is :mode and default is :logic.  The
+; user has the opportunity to specify :mode in each element of lst, i.e., he
+; may say to make the first fn :logic and the second fn :program.  But
+; that is nonsense.  We have to process the whole clique or none at all.
+; Therefore, we have to meld all of his various :mode specs together to come
+; up with a setting for the DEFUNS event.  This function explores lst and
+; either comes up with an unambiguous :mode or else causes an error.
+
+  (er-let* ((x (get-unambiguous-xargs-val1 key lst ctx state)))
+           (cond ((equal x '(unspecified)) (value default))
+                 (t (value x)))))
+
+(defdoc CCG-XARGS
+  ":Doc-Section CCG
+
+  giving hints to CCG analysis via ~l[xargs]~/
+
+  In addition to the ~ilc[xargs] provided by ACL2 for passing ~il[hints] to
+  function definitions, the CCG analysis enables several others for guiding the
+  CCG termination analysis for a given function definition. The following
+  example is nonsensical but illustrates all of these xargs:
+  ~bv[]
+  (declare (xargs :termination-method :ccg
+                  :consider-ccms ((foo x) (bar y z))
+                  :consider-only-ccms ((foo x) (bar y z))
+                  :ccg-print-proofs nil
+                  :time-limit 120
+                  :ccg-hierarchy *ccg-hierarchy-hybrid*))~/
+
+  General Form:
+  (xargs :key1 val1 ... :keyn valn)
+  ~ev[]
+
+  Where the keywords and their respective values are as shown below.
+
+  Note that the :TERMINATION-METHOD ~c[xarg] is always valid, but the other
+  ~c[xargs] listed above are only valid if the termination method being used
+  for the given function is :CCG.
+
+  ~c[:TERMINATION-METHOD value]~nl[]
+  ~c[Value] here is either ~c[:CCG] or ~c[:MEASURE]. For details on the meaning
+  of these settings, see the documentation for ~ilc[set-termination-method]. If
+  this ~c[xarg] is given, it overrides the global setting for the current
+  definition. If the current definition is part of a ~ilc[mutual-recursion],
+  and a ~c[:termination-method] is provided, it must match that provided by all
+  other functions in the ~c[mutual-recursion].
+
+  ~c[:CONSIDER-CCMS value] or ~c[:CONSIDER-ONLY-CCMS value]~nl[] 
+  ~c[Value] is a list of terms involving only the formals of the function being
+  defined. Both suggest measures for the current function to the CCG
+  analysis. ACL2 must be able to prove that each of these terms always evaluate
+  to an ordinal ~pl[ordinals]. ACL2 will attempt to prove this before beginning
+  the CCG analysis. The difference between ~c[:consider-ccms] and
+  ~c[:consider-only-ccms] is that if ~c[:consider-ccms] is used, the CCG
+  analysis will attempt to guess additional measures that it thinks might be
+  useful for proving termination, whereas if ~c[:consider-only-ccms] is used,
+  only the measures given will be used for the given function in the CCG
+  analysis. These two ~c[xargs] may not be used together, and attempting to do
+  so will result in an error.
+
+  ~c[:CCG-PRINT-PROOFS value]~nl[]
+  ~c[Value] is either ~c[t] or ~c[nil]. This is a local override of the
+  ~ilc[set-ccg-print-proofs] setting. See this documentation topic for details.
+
+  ~c[:TIME-LIMIT value]~nl[]
+  ~c[Value] is either a positive rational number or nil. This is a local
+  override of the ~ilc[set-ccg-time-limit] setting. See this documentation
+  topic for details.
+
+  ~c[:CCG-HIERARCHY value]~nl[]
+  ~c[Value] is a CCG hierarchy. This is a local override of the
+  ~ilc[set-ccg-hierarchy] setting. See this documentation topic for details.~/")
+                
+(defun chk-acceptable-ccg-xargs (fives symbol-class ctx wrld state)
+  (er-let* ((untranslated-consider (get-ccms symbol-class
+                                             fives
+                                             :CONSIDER-CCMs
+                                             ctx state))
+            (consider (translate-ccms-list untranslated-consider ctx wrld state))
+            (untranslated-consider-only (get-ccms symbol-class
+                                                  fives
+                                                  :CONSIDER-ONLY-CCMs
+                                                  ctx state))
+            (consider-only (translate-ccms-list untranslated-consider-only
+                                                ctx wrld state))
+            (ccms (combine-ccm-hints consider consider-only 
+                                     untranslated-consider
+                                     untranslated-consider-only
+                                     ctx state))
+            (verbose (get-unambiguous-xargs-flg
+                      :CCG-PRINT-PROOFS
+                      fives
+                      (get-ccg-print-proofs) ;; default is global setting
+                      ctx state))
+            (time-limit (get-unambiguous-xargs-val
+                         :TIME-LIMIT
+                         fives
+                         ;; the default time-limit is that specified in the
+                         ;; world
+                         (get-ccg-time-limit wrld) 
+                         ctx state)))
+           (cond ((not (booleanp verbose))
+                  (er soft ctx
+                      "The :CCG-PRINT-PROOFS specified by XARGS must either ~
+                       be NIL or T. ~x0 is neither."
+                      verbose))
+                 ((not (or (null time-limit)
+                           (rationalp time-limit)))
+                  (er soft ctx
+                      "The :TIME-LIMIT specified by XARGS must either be NIL ~
+                       or a rational number. ~x0 is neither."
+                      time-limit))
+                 (t 
+                  (value (list ccms
+                               verbose
+                               time-limit))))))
+
+(defun ?-ccm-lstp (lst)
+  (or (endp lst)
+      (let ((ccm (car lst)))
+        (and (true-listp ccm)
+             (eq (car ccm) :?)
+             (arglistp (cdr ccm))
+             (?-ccm-lstp (cdr lst))))))
+     
+(defun ccg-redundant-measure-for-defunp (def justification wrld)
+  (let ((name (car def))
+        (measure0 (if justification
+                      (access justification
+                              justification
+                              :measure)
+                    nil))
+        (measures (fetch-dcl-field :measure
+                                   (butlast (cddr def)
+                                            1))))
+    (cond ((and (consp measure0)
+                (eq (car measure0) :?))
+           (if (and (consp measures)
+                    (null (cdr measures))
+                    (eq (caar measures) :?)
+                    (set-equalp-eq (cdar measures)
+                                   (cdr measure0)))
+               'redundant
+             (msg "the existing measure for ~x0 is ~x1, possibly indicating ~
+                   it was previously proven terminating using the CCG ~
+                   analysis. The new measure must therefore be explicitly ~
+                   declared to be a call of :? on the measured subset; for ~
+                   example, ~x1 will serve as the new :measure."
+                  name
+                  measure0)))
+          (t
+           (let* ((wrld1 (decode-logical-name name wrld))
+                  (val (scan-to-cltl-command (cdr wrld1)))
+                  (old-def (assoc-eq name (cdddr val))))
+             (or (non-identical-defp-chk-measures
+                  name
+                  measures
+                  (fetch-dcl-field :measure
+                                   (butlast (cddr old-def)
+                                            1))
+                  justification)
+                 'redundant))))))
+
+(defun ccg-redundant-subset-for-defunp (chk-measurep chk-ccmsp def wrld)
+  (let* ((name (car def))
+         (justification (getprop name
+                                 'justification
+                                 'nil
+                                 'current-acl2-world
+                                 wrld))
+         (mok (if chk-measurep
+                  (ccg-redundant-measure-for-defunp def justification wrld)
+                'redundant)))
+    (cond ((consp mok) ; a message
+           mok)
+          ((and chk-ccmsp justification)
+           (let ((subset (access justification justification :subset))
+                 (ccms-lst (fetch-dcl-field :consider-only-ccms
+                                            (butlast (cddr def) 1))))
+             (if (and (consp ccms-lst)
+                      (null (cdr ccms-lst))
+                      (?-ccm-lstp (car ccms-lst))
+                      (set-equalp-eq (all-vars1-lst (car ccms-lst) nil)
+                                     subset))
+                 'redundant
+               (msg "A redundant definition using CCG termination must use ~
+                     the xarg :consider-only-ccms to declare a list of CCMs ~
+                     of the form (:? ...) whose arguments are equal to the ~
+                     measured subset of the previous definition. The ~
+                     definition of ~x0 does not do this. The previously ~
+                     defined version of this function has measured subset ~
+                     ~x1. Thus, an appropriate list of CCMs to declare would ~
+                     be ~x2."
+                    name
+                    subset
+                    `((:? ,@subset))))))
+          (t
+           'redundant))))
+
+(defun ccg-redundant-subset-for-defunsp1 (chk-measurep chk-ccmsp def-lst wrld ans)
+  (if (endp def-lst)
+      ans
+    (let ((ans0 (ccg-redundant-subset-for-defunp chk-measurep
+                                                 chk-ccmsp
+                                                 (car def-lst)
+                                                 wrld)))
+      (cond ((consp ans0) ans0) ; a message
+            ((eq ans ans0)
+             (ccg-redundant-subset-for-defunsp1 chk-measurep
+                                                chk-ccmsp
+                                                (cdr def-lst)
+                                                wrld
+                                                ans))
+            (t nil)))))
+         
+(defun ccg-redundant-subset-for-defunsp (chk-measurep chk-ccmsp def-lst wrld)
+  (if (null def-lst)
+      'redundant
+    (let ((ans (ccg-redundant-subset-for-defunp chk-measurep
+                                                chk-ccmsp
+                                                (car def-lst)
+                                                wrld)))
+      (if (consp ans)
+          ans ;; a message
+        (ccg-redundant-subset-for-defunsp1 chk-measurep
+                                           chk-ccmsp
+                                           (cdr def-lst)
+                                           wrld
+                                           ans)))))
+
+; Should this be in sync with redundant-or-reclassifying-defunsp ? --harshrc
+(defun ccg-redundant-or-reclassifying-defunsp (chk-measurep
+                                               chk-ccmsp
+                                               defun-mode
+                                               symbol-class
+                                               ld-skip-proofsp
+                                               def-lst
+                                               wrld)
+  (let ((ans (redundant-or-reclassifying-defunsp0 defun-mode
+                                                  symbol-class
+                                                  ld-skip-proofsp
+                                                  nil
+                                                  def-lst
+                                                  wrld)))
+    (cond ((or (consp ans) ;; a message
+               (not (eq ans 'redundant))
+
+; the following 2 are a negation of the conditions for checking measures in
+; redundant-or-reclassifying-defunsp. We skip the check that each old
+; definition also has defun-mode of :logic, because if
+; redundant-or-reclassifying-defunsp0 returns 'redundant, and defun-mode is
+; :logic, we know that the old definitions must also all be logic (otherwise
+; there would have been an error or the new definitions would be
+; reclassifications). Keep this in sync with the conditions for checking
+; measures in redundant-or-reclassifying-defunsp.
+ 
+               (not (eq defun-mode :logic))
+               ld-skip-proofsp)
+           ans)
+          (t
+           (ccg-redundant-subset-for-defunsp chk-measurep
+                                             chk-ccmsp
+                                             def-lst
+                                             wrld)))))
+
+(defun get-and-chk-ccg-hierarchy (fives ctx wrld state)
+  (er-let*
+   ((hierarchy (get-unambiguous-xargs-val
+                :CCG-HIERARCHY
+                fives
+                *0*
+                ctx state)))
+    (if (equal hierarchy *0*)
+        (value (get-ccg-hierarchy wrld))
+      (er-progn
+       (chk-ccg-hierarchy hierarchy ctx state)
+       (value (fix-ccg-hierarchy hierarchy))))))
+
+(defun ccg-hierarchy-kinds-of-levels (hierarchy has-ccgp has-measurep)
+  (declare (xargs :guard (and (hlevel-listp hierarchy)
+                              (booleanp has-ccgp)
+                              (booleanp has-measurep))))
+  (cond ((and has-ccgp has-measurep)
+         (mv t t))
+        ((endp hierarchy)
+         (mv has-ccgp has-measurep))
+        (t
+         (let ((is-measurep (equal (caar hierarchy) :measure)))
+           (ccg-hierarchy-kinds-of-levels (cdr hierarchy)
+                                          (or has-ccgp (not is-measurep))
+                                          (or has-measurep is-measurep))))))
+
+
+; ccg version of chk-acceptable-defuns (see defuns.lisp). Should be synced? --harshrc
+; annotated portions which differ by "ccg rewrite" comment --harshrc
+(defun ccg-chk-acceptable-defuns (lst ctx wrld state #+:non-standard-analysis std-p)
+
+; WARNING: This function installs a world, hence should only be called when
+; protected by a revert-world-on-error.
+
+; Rockwell Addition:  We now also return the non-executable flag.
+
+; This function does all of the syntactic checking associated with defuns.  It
+; causes an error if it doesn't like what it sees.  It returns the traditional
+; 3 values of an error-producing, output-producing function.  However, the
+; "real" value of the function is a list of items extracted from lst during the
+; checking.  These items are:
+
+;    names     - the names of the fns in the clique
+;    arglists  - their formals
+;    docs      - their documentation strings
+;    pairs     - the (section-symbol . citations) pairs parsed from docs
+;    guards    - their translated guards
+;    measures  - their translated measure terms
+;    ruler-extenders-lst
+;              - their ruler-extenders
+;    mp        - the domain predicate (e.g., o-p) for well-foundedness
+;    rel       - the well-founded relation (e.g., o<)
+;    hints     - their translated hints, to be used during the proofs of
+;                the measure conjectures, all flattened into a single list
+;                of hints of the form ((cl-id . settings) ...).
+;    guard-hints
+;              - like hints but to be used for the guard conjectures and
+;                untranslated
+;    std-hints (always returned, but only of interest when
+;               #+:non-standard-analysis)
+;              - like hints but to be used for the std-p conjectures
+;    otf-flg   - t or nil, used as "Onward Thru the Fog" arg for prove
+;    bodies    - their translated bodies
+;    symbol-class
+;              - :program, :ideal, or :common-lisp-compliant
+;    normalizeps
+;              - list of Booleans, used to determine for each fn in the clique
+;                whether its body is to be normalized
+;    reclassifyingp
+;              - t or nil, t if this is a reclassifying from :program
+;                with identical defs.
+;    wrld      - a modified wrld in which the following properties
+;                may have been stored for each fn in names:
+;                  'formals, 'stobjs-in and 'stobjs-out
+;    non-executablep - t or nil according to whether these defuns are to
+;                  non-executable.  Non-executable defuns may violate the
+;                  translate conventions on stobjs.
+;    guard-debug
+;              - t or nil, used to add calls of EXTRA-INFO to guard conjectures
+;    split-types-terms
+;              - list of translated terms, each corresponding to type
+;                declarations made for a definition with XARGS keyword
+;                :SPLIT-TYPES T
+
+  (er-let*
+   ((fives (chk-defuns-tuples lst nil ctx wrld state))   
+
+; Fives is a list in 1:1 correspondence with lst.  Each element of
+; fives is a 5-tuple of the form (name args doc edcls body).  Consider the
+; element of fives that corresponds to
+
+;   (name args (DECLARE ...) "Doc" (DECLARE ...) body)
+
+; in lst.  Then that element of fives is (name args "Doc" (...) body),
+; where the ... is the cdrs of the DECLARE forms appended together.
+; No translation has yet been applied to them.  The newness of name
+; has not been checked yet either, though we know it is all but new,
+; i.e., is a symbol in the right package.  We do know that the args
+; are all legal.
+
+    (tm (get-unambiguous-xargs-flg :TERMINATION-METHOD
+                                   fives
+                                   (get-termination-method wrld)
+                                   ctx state)) ;ccg rewrite
+    (term-method (if (or (eq tm :ccg)
+                         (eq tm :measure))
+                     (value tm)
+                   (er soft ctx
+                       "The :TERMINATION-METHOD flag must be :CCG or ~
+                        :MEASURE, but ~x0 is none of these."
+                       tm))) ;ccg rewrite
+
+    (names (value (strip-cars fives))))
+   (er-progn
+    (chk-no-duplicate-defuns names ctx state)
+    (chk-xargs-keywords fives ;ccg rewrite
+                        (if (eq term-method :ccg)
+                            (append *ccg-xargs-keywords*
+                                    *xargs-keywords*)
+                          (cons :termination-method
+                                *xargs-keywords*))
+                        ctx state)
+    (er-let*
+     ((tuple (chk-acceptable-defuns0 fives ctx wrld state))
+      (hierarchy (if (eq term-method :ccg)
+                     (get-and-chk-ccg-hierarchy fives ctx wrld state)
+                   (value nil)))) ;ccg rewrite
+     (let* ((stobjs-in-lst (car tuple))
+            (defun-mode (cadr tuple))
+            (non-executablep (caddr tuple))
+            (symbol-class (cdddr tuple)))
+       (mv-let ;ccg rewrite
+        (has-ccgp has-measurep)
+        (if (eq term-method :measure)
+          (mv nil t)
+        (ccg-hierarchy-kinds-of-levels hierarchy nil nil))
+        (let ((rc (ccg-redundant-or-reclassifying-defunsp
+                   has-measurep has-ccgp
+                   defun-mode symbol-class
+                   (ld-skip-proofsp state) lst wrld))) ;ccg rewrite - CHECK - harshrc
+          (cond
+           ((eq rc 'redundant)
+            (chk-acceptable-defuns-redundancy names ctx wrld state))
+           ((eq rc 'verify-guards)
+
+; We avoid needless complication by simply causing a polite error in this
+; case.  If that proves to be too inconvenient for users, we could look into
+; arranging for a call of verify-guards here.
+
+            (chk-acceptable-defuns-verify-guards-er names ctx wrld state))
+
+; Synced with latest version of chk-acceptable-defuns svn version 1020
+; Added below cond clause for hons.
+; june 16 2013 - harshrc
+           #+hons
+           ((and (eq rc 'reclassifying)
+              (conditionally-memoized-fns names
+                                          (table-alist 'memoize-table wrld)))
+
+; We no longer recall exactly why we have this restriction.  However, after
+; discussing this with Sol Swords we think it's because we tolerate all sorts
+; of guard violations when dealing with :program mode functions, but we expect
+; guards to be handled properly with :logic mode functions, including the
+; condition function.  If we verify termination and guards for the memoized
+; function but not the condition, that could present a problem.  Quite possibly
+; we can relax this check somewhat after thinking things through -- e.g., if
+; the condition function is a guard-verified :logic mode function -- if there
+; is demand for such an enhancement.
+
+         (er soft ctx
+             "It is illegal to verify termination (i.e., convert from ~
+              :program to :logic mode) for function~#0~[~/s~] ~&0, because ~
+              ~#0~[it is~/they are~] currently memoized with conditions; you ~
+              need to unmemoize ~#0~[it~/them~] first.  See :DOC memoize."
+             (conditionally-memoized-fns names
+                                         (table-alist 'memoize-table wrld))))
+           (t
+            (er-let*
+             ((tuple1 (chk-acceptable-defuns1 names fives
+                                              stobjs-in-lst defun-mode symbol-class rc
+                                              non-executablep ctx wrld state
+                                              #+:non-standard-analysis std-p))
+              (tuplec (if (eq term-method :measure)
+                          (value (list nil nil nil)) ;ccg rewrite
+                        (chk-acceptable-ccg-xargs fives symbol-class
+                                                  ctx wrld state))))
+             (value (append (list 'chk-acceptable-defuns term-method)
+                         (cdr tuple1)
+                         tuplec
+                         `(,hierarchy))))))))))))) ;ccg rewrite
+
+;; (defun ccg-chk-acceptable-defuns (fives lst ctx wrld state #+:non-standard-analysis std-p)
+
+;; ; Rockwell Addition:  We now also return the non-executable flag.
+
+;; ; This function does all of the syntactic checking associated with defuns.  It
+;; ; causes an error if it doesn't like what it sees.  It returns the traditional
+;; ; 3 values of an error-producing, output-producing function.  However, the
+;; ; "real" value of the function is a list of items extracted from lst during the
+;; ; checking.  These items are:
+
+;; ;    names     - the names of the fns in the clique
+;; ;    arglists  - their formals
+;; ;    docs      - their documentation strings
+;; ;    pairs     - the (section-symbol . citations) pairs parsed from docs
+;; ;    guards    - their translated guards
+;; ;    measures  - their translated measure terms
+;; ;    ruler-extenders-lst
+;; ;              - their ruler-extenders
+;; ;    mp        - the domain predicate (e.g., o-p) for well-foundedness
+;; ;    rel       - the well-founded relation (e.g., o<)
+;; ;    hints     - their translated hints, to be used during the proofs of
+;; ;                the measure conjectures, all flattened into a single list
+;; ;                of hints of the form ((cl-id . settings) ...).
+;; ;    guard-hints
+;; ;              - like hints but to be used for the guard conjectures and
+;; ;                untranslated
+;; ;    std-hints (always returned, but only of interest when
+;; ;               #+:non-standard-analysis)
+;; ;              - like hints but to be used for the std-p conjectures
+;; ;    otf-flg   - t or nil, used as "Onward Thru the Fog" arg for prove
+;; ;    bodies    - their translated bodies
+;; ;    symbol-class
+;; ;              - :program, :ideal, or :common-lisp-compliant
+;; ;    normalizeps
+;; ;              - list of Booleans, used to determine for each fn in the clique
+;; ;                whether its body is to be normalized
+;; ;    reclassifyingp
+;; ;              - t or nil, t if this is a reclassifying from :program
+;; ;                with identical defs.
+;; ;    wrld      - a modified wrld in which the following properties
+;; ;                may have been stored for each fn in names:
+;; ;                  'formals, 'stobjs-in and 'stobjs-out
+;; ;    non-executablep - t or nil according to whether these defuns are to
+;; ;                  non-executable.  Non-executable defuns may violate the
+;; ;                  translate conventions on stobjs.
+;; ;    guard-debug
+;; ;              - t or nil, used to add calls of EXTRA-INFO to guard conjectures
+
+;;   (er-let*
+;;    ((tm (get-unambiguous-xargs-flg :TERMINATION-METHOD
+;;                                    fives
+;;                                    (get-termination-method wrld)
+;;                                    ctx state))
+;;     (term-method (if (or (eq tm :ccg)
+;;                          (eq tm :measure))
+;;                      (value tm)
+;;                    (er soft ctx
+;;                        "The :TERMINATION-METHOD flag must be :CCG or ~
+;;                         :MEASURE, but ~x0 is none of these."
+;;                        tm)))
+;;     (names (value (strip-cars fives))))
+;;    (er-progn
+;;     (chk-no-duplicate-defuns names ctx state)
+;;     (chk-xargs-keywords fives
+;;                         (if (eq term-method :ccg)
+;;                             (append *ccg-xargs-keywords*
+;;                                     *xargs-keywords*)
+;;                           (cons :termination-method
+;;                                 *xargs-keywords*))
+;;                         ctx state)
+;;     (er-let*
+;;      ((tuple0 (chk-acceptable-defuns0 fives ctx wrld state))
+;;       (stobjs-in-lst (value (car tuple0)))
+;;       (defun-mode (value (cadr tuple0)))
+;;       (verify-guards (value (caddr tuple0)))
+;;       (symbol-class (value (cdddr tuple0)))
+;;       (hierarchy (if (eq term-method :ccg)
+;;                      (get-and-chk-ccg-hierarchy fives ctx wrld state)
+;;                    (value nil))))
+;;      (mv-let
+;;       (has-ccgp has-measurep)
+;;       (if (eq term-method :measure)
+;;           (mv nil t)
+;;         (ccg-hierarchy-kinds-of-levels hierarchy nil nil))
+;;       (er-let*
+;;        ((rc (value (ccg-redundant-or-reclassifying-defunsp
+;;                     has-measurep has-ccgp
+;;                     defun-mode symbol-class
+;;                     (ld-skip-proofsp state) lst wrld))))
+;;        (cond
+;;         ((eq rc 'redundant)
+;;          (chk-acceptable-defuns-redundancy names ctx wrld state))
+;;         ((eq rc 'verify-guards)
+;;          (chk-acceptable-defuns-verify-guards names ctx wrld state))
+;;         (t
+;;          (er-let*
+;;           ((tuple1 (chk-acceptable-defuns1 names fives stobjs-in-lst
+;;                                            defun-mode symbol-class rc ctx
+;;                                            wrld state
+;;                                            #+:non-standard-analysis
+;;                                            std-p))
+;;            (tuplec (if (eq term-method :measure)
+;;                        (value (list nil nil nil))
+;;                      (chk-acceptable-ccg-xargs fives symbol-class
+;;                                                ctx wrld state))))
+;;           (value (append (list 'chk-acceptable-defuns term-method)
+;;                          (cdr tuple1)
+;;                          tuplec
+;;                          `(,hierarchy))))))))))))
+
+(defun find-?-ccm1 (ccm-list)
+  (and (consp ccm-list)
+       (let ((ccm (car ccm-list)))
+         (or (and (consp ccm)
+                  (eq (car ccm) :?)
+                  ccm)
+             (find-?-ccm1 (cdr ccm-list))))))
+
+(defun find-?-ccm (names ccms)
+  ;; looks for CCMS with :? as the function.
+  (if (endp ccms)
+      nil
+    (let ((bad-ccm (find-?-ccm1 (car ccms))))
+      (if bad-ccm
+          (cons (car names) bad-ccm)
+        (find-?-ccm (cdr names) (cdr ccms))))))
+
+(defun fns-without-consider-only-ccms-hints (names ccms)
+  ;; checks if all the CCMs have been declared using :CONSIDER-ONLY-CCMS. Any
+  ;; functions for which this is not the case are collected into a list.
+  ;; Ccms should of the form returned by combine-ccm-hints.
+  (if (endp ccms)
+      nil
+    (let ((rst (fns-without-consider-only-ccms-hints (cdr names)
+                                                     (cdr ccms))))
+      (if (and (consp (car ccms))
+               (caar ccms))
+          rst
+        (cons (car names)
+              rst)))))
+ 
+(defun-raw ccm-o-p-clauses2 (contexts term clauses)
+  (if (endp contexts)
+      clauses
+    (ccm-o-p-clauses2
+     (cdr contexts)
+     term
+     (conjoin-clause-to-clause-set
+      (add-literal term
+                   (dumb-negate-lit-lst (context-ruler (car contexts)))
+                   t)
+      clauses))))
+
+(defun-raw ccm-o-p-clauses1 (contexts ccm-list clauses)
+  (if (endp ccm-list)
+      clauses
+    (ccm-o-p-clauses1 contexts (cdr ccm-list)
+                       (ccm-o-p-clauses2 contexts
+                                          (mcons-term* 'o-p (car ccm-list))
+                                          clauses))))
+        
+(defun-raw ccm-o-p-clauses0 (contexts ccm-list clauses)
+  (cond ((endp contexts)
+         clauses)
+        ((eq (car ccm-list) *0*)
+         (ccm-o-p-clauses0 (cdr contexts)
+                            (cdr ccm-list)
+                            clauses))
+        (t
+         (ccm-o-p-clauses0 (cdr contexts)
+                            (cdr ccm-list)
+                            (ccm-o-p-clauses1 (car contexts)
+                                               (car ccm-list)
+                                               clauses)))))
+
+(defun-raw ccm-o-p-clauses (contexts ccm-list)
+  ;; builds the clauses to prove that the CCMs in ccm-list all
+  ;; evaluate to natural numbers.
+  (ccm-o-p-clauses0 contexts ccm-list nil))
+
+(defun-raw ccg-intermediate-step (accgs ces new-hlevel old-hlevel proved qspv state)
+   (er-let*
+    ((triple (accg-refine-accgs accgs ces old-hlevel new-hlevel qspv state))
+     (caccgs (value (car triple)))
+     (uaccgs (value (cadr triple)))
+     (uces (value (cddr triple))))
+    (cond ((endp caccgs)
+           (pprogn
+            ;;(progn (print uaccgs) state)
+            (ccg-io? basics nil state
+                     ()
+                     (fms "Since we have no new information, we skip size ~
+                           change analysis and attempt to further refine the ~
+                           SCCs.~|"
+                          nil
+                          *standard-co*
+                          state
+                          nil))
+            (value (list* proved uaccgs uces))))
+           (t
+            (pprogn
+             (let ((clen (len caccgs)))
+               (ccg-io? basics nil state
+                        (uaccgs clen caccgs)
+                        (fms "~@0 of the CCG ~#\3~[was~/were~] altered. We ~
+                              analyze ~#\3~[it~/each of these~] with the size ~
+                              change termination analysis.~@4~|"
+                             `((#\0 . ,(if (consp uaccgs)
+                                           "~N1 of the ~n2 SCCs"
+                                         "~#\3~[The sole SCC~/All the SCCs~]"))
+                               (#\1 . ,clen)
+                               (#\2 . ,(+ clen (len uaccgs)))
+                               (#\3 . ,caccgs)
+                               (#\4 . ,(if (endp uaccgs)
+                                           ""
+                                         " The others will be set aside ~
+                                               for further refinement.")))
+                             *standard-co*
+                             state
+                             nil)))
+             (accg-sct-list caccgs proved uaccgs uces state))))))
+
+(defun-raw ccg-measure-step (hlevel names t-machines measure-alist mp rel
+                                    bodies verbose qspv state)
+  (if (consp measure-alist)
+      (let ((ctx (access query-spec-var qspv :ctx))
+            (wrld (access query-spec-var qspv :wrld)) 
+            (ens (access query-spec-var qspv :ens))
+            (stop-time (access query-spec-var qspv :stop-time))
+            (otf-flg (access query-spec-var qspv :otf-flg))
+            (pt (cadr hlevel)))
+     (pprogn
+       (ccg-io? basics nil state
+                (hlevel)
+                (fms "The current level of the CCG hierarchy is ~x0. We ~
+                      therefore attempt a measure proof.~|"
+                     `((#\0 . hlevel))
+                     *standard-co*
+                     state
+                     nil))
+       (mv-let
+        (erp pair state)
+        (er-let*
+         ((hints (if (equal pt :built-in-clauses)
+                     (translate-hints
+                      "Measure Built-in-clauses Hint"
+                      '(("goal"
+                         :do-not '(eliminate-destructors
+                                   eliminate-irrelevance
+                                   generalize
+                                   fertilize)
+                         :in-theory (theory 'minimal-theory)
+                         :do-not-induct :otf-flg-override))
+                      ctx wrld state)
+                   (value (translated-limit-induction-hint (cadr pt))))))
+         (state-global-let*
+          ((inhibit-output-lst (if verbose
+                                   (@ inhibit-output-lst)
+                                 (list* 'event 'error (@ inhibit-output-lst)))))
+          (maybe-prover-before-stop-time
+           stop-time ctx state
+           (prove-termination names t-machines measure-alist mp rel
+                              hints otf-flg bodies
+                              ctx ens wrld state
+                              (f-get-global
+                               'accumulated-ttree
+                               state)))))
+        (if erp
+            (er-progn
+             (time-check stop-time ctx state)
+             (pprogn
+              (ccg-io? basics nil state
+                       ()
+                       (fms "Since ACL2 has failed to prove the measure ~
+                             conjecture, we continue with the hierarchical ~
+                             analysis.~|"
+                            nil
+                            *standard-co*
+                            state
+                            nil))
+              (value nil)))
+          (pprogn
+           (ccg-io? basics nil state
+                    ()
+                    (fms "ACL2 has succeeded in proving the measure ~
+                          conjecture, thereby proving termination."
+                         nil
+                         *standard-co*
+                         state
+                         nil))
+           (value (list* :measure
+                         (car pair)
+                         measure-alist
+                         (cdr pair))))))))
+    (pprogn
+     (ccg-io? basics nil state
+              (hlevel)
+              (fms "Skipping level ~x0 of the hierarchy due to previously ~
+                    mentioned error when guessing measures."
+                   `((#\0 . hlevel))
+                   *standard-co*
+                   state
+                   nil))
+     (value nil))))
+
+(defun-raw ccg (accgs ces last-ccg-hlevel hierarchy proved context-array
+                      names arglists t-machines measure-alist mp rel bodies
+                      verbose qspv state)
+  (cond ((endp accgs)
+         (pprogn
+          (increment-timer 'other-time state)
+          (ccg-io? basics nil state
+                   ()
+                   (fms "We have successfully proven termination! We now weed ~
+                         out irrelevant CCMs so that we can minimize the ~
+                         measured-subset. This may require running the size ~
+                         change analysis several more times.~|"
+                        nil
+                        *standard-co*
+                        state
+                        nil))
+          (increment-timer 'print-time state)
+          (er-let*
+           ((ms (ccg-generate-measure-alist
+                 nil proved
+                 names arglists
+                 context-array
+                 ;; the following is overly-cautious. It could be the case that
+                 ;; some SCCs were proven terminating with ccmfs-per-node
+                 ;; and others with ccmfs-per-edge, in which case we would
+                 ;; be assuming here that we proved all of the SCCs terminating
+                 ;; with ccmfs-per-edge.
+                 (hlevel-ccmfs-per-nodep last-ccg-hlevel)
+                 state)))
+           (pprogn
+            (mv-let
+             (col state)
+             (io? event nil (mv col state)
+                  (names ms)
+                  (fmt "CCG analysis has succeeded in proving termination of ~
+                        ~&0 using CCMs over the following variables~#0~[~/, ~
+                        respectively~]: ~&1. Thus, we admit ~#0~[this ~
+                        function~/these ~ functions~] under the principle of ~
+                        definition."
+                       (list (cons #\0 names)
+                             (cons #\1 (strip-cddrs ms)))
+                       *standard-co*
+                       state
+                       nil)
+                  :default-bindings ((col 0)))
+             (value (list* :ccg
+                           col
+                           ms
+                           (f-get-global
+                            'accumulated-ttree
+                            state))))))))
+        ((endp hierarchy)
+         (pprogn
+          (ccg-io? basics nil state
+                   ()
+                   (fms "We have completed all levels of the hierarchy, but ~
+                         have failed to prove termination."
+                        ()
+                        *standard-co*
+                        state
+                        nil))
+          (if (null (car ces))
+              state
+            (ccg-io? counter-example nil state
+                     ()
+                     (print-counter-example
+                      (car accgs) (car ces)
+                      context-array
+                      (access query-spec-var qspv :ctx)
+                      (access query-spec-var qspv :ens)
+                      (access query-spec-var qspv :wrld)
+                      state)))
+          (mv t nil state)))
+        ((eq (caar hierarchy) :MEASURE)
+         (er-let*
+          ((tuple (ccg-measure-step (car hierarchy)
+                                    names
+                                    t-machines
+                                    measure-alist
+                                    mp
+                                    rel
+                                    bodies
+                                    verbose
+                                    qspv
+                                    state)))
+          (if tuple
+              (value tuple)
+            (ccg accgs ces last-ccg-hlevel (cdr hierarchy) proved context-array
+                 names arglists t-machines measure-alist mp rel bodies
+                 verbose qspv state))))
+        (t
+         (er-let*
+          ((tuple
+            (state-global-let*
+             ((inhibit-output-lst
+               (if verbose
+                   (@ inhibit-output-lst)
+                 (list* 'prove 'proof-tree (@ inhibit-output-lst)))))
+             (ccg-intermediate-step accgs
+                                    ces
+                                    (car hierarchy)
+                                    last-ccg-hlevel
+                                    proved
+                                    qspv
+                                    state)))
+           (nproved (value (car tuple)))
+           (naccgs (value (cadr tuple)))
+           (nces (value (cddr tuple))))
+          (ccg naccgs nces (car hierarchy) (cdr hierarchy) nproved
+               context-array
+               names arglists t-machines measure-alist mp rel bodies
+               verbose qspv state)))))
+
+(defun-raw build-accgs (names contexts functs ccm-hints wrld state)
+  (let* ((context-array (context-array contexts))
+         ;; (num-contexts (array-dimension context-array 0))
+         (accgs (build-and-annotate-accgs names
+                                          functs
+                                          contexts
+                                          (pairlis$ names ccm-hints))))
+    ;; first we build the accgs using the first restriction
+    (pprogn
+     (increment-timer 'other-time state)
+     (ccg-io? basics nil state
+              (names context-array accgs)
+              (pprogn
+               (fms "We begin with the Calling Context Graph (CCG), ~
+                     containing the following contexts (if the output doesn't ~
+                     make sense, see :DOC CCG and also the paper referenced ~
+                     above):~|"
+                    nil
+                    *standard-co*
+                    state
+                    nil)
+               (print-context-array1 0 names context-array state)
+               (fms "and the following edges:~|"
+                    nil *standard-co* state nil)
+               (print-accg-edges1 accgs state)
+               (fms "We have annotated the CCG with the following calling ~
+                     context measures (CCMs):~|"
+                    nil *standard-co* state nil)
+               (print-funct-ccms functs wrld state)))
+     (increment-timer 'print-time state)
+     (pprogn
+      (ccg-io? basics nil state
+               ()
+               (fms "Before we begin the hierarchical analysis, we run our ~
+                     size-change analysis so we have a baseline for refinement."
+                    nil
+                    *standard-co*
+                    state
+                    nil))
+      (er-let*
+       ((tuple (accg-sct-list accgs nil nil nil state)))
+       (value (cons context-array tuple)))))))
+
+(defun max-induction-depth1 (hierarchy max)
+  (declare (xargs :guard (and (hlevel-listp hierarchy)
+                              (integerp max)
+                              (<= -1 max))))
+  (if (endp hierarchy)
+      max
+    (max-induction-depth1
+     (cdr hierarchy)
+     (cond ((or (equal (caar hierarchy) :measure)
+                (equal (hlevel-proof-technique (car hierarchy))
+                       :built-in-clauses))
+            max)
+           (t
+            (max max (cadr (hlevel-proof-technique (car hierarchy)))))))))
+
+(defun max-induction-depth (hierarchy)
+  (max-induction-depth1 hierarchy -1))
+
+(defun ruler-extender-printout1 (names ruler-extenders-lst)
+  (if (endp names)
+      nil
+    (cons `("function ~x0 has ruler extenders ~x1"
+            (#\0 . ,(car names))
+            (#\1 . ,(car ruler-extenders-lst)))
+          (ruler-extender-printout1 (cdr names)
+                                    (cdr ruler-extenders-lst)))))
+
+(defun ruler-extender-printout (names ruler-extenders-lst)
+  `("" "~@*." "~@*, and " "~@*, "
+    ,(ruler-extender-printout1 names ruler-extenders-lst)))
+
+(defun-raw prove-termination-with-ccg (names functs contexts
+                                             ruler-extenders-lst ccm-hints
+                                             hierarchy verbose time-limit 
+                                             arglists measures t-machines mp
+                                             rel otf-flg bodies
+                                             ctx ens wrld state ttree)
+
+  ;; based on prove-termination in the ACL2 sources, this function
+  ;; attempts to prove the termination of the given functions. names
+  ;; is the list of names of the the functions, term-method is the
+  ;; termination method to be used (:hybrid or :ccg), contexts are the
+  ;; contexts for the functions, ccm-hints is a list of pairs as defined by
+  ;; combine-ccm-hints, cpn, verbose, time-limit, and ccm-comparison-scheme are the
+  ;; user-specified CCG options, arglists is the list of lists of
+  ;; formals for the functions, measures are the user-specified
+  ;; measures, t-machines are the termination machines of the
+  ;; functions, mp and rel are the domain and relation for proving
+  ;; termination with a measure and otf-flg is the on-through-the-fog
+  ;; flag.
+
+  ;; If we succeed, we return 4 values, consed together as "the" value
+  ;; in this error/value/state producing function. The first value is
+  ;; the proof method that ultimately proved termination (:ccg or
+  ;; :measure). The second value is the "justification" alist. For a
+  ;; measure-based proof, this is the measure-alist, and for a
+  ;; CCG-based proof, this is the result of
+  ;; ccg-generate-measure-alist. The last two values are the column
+  ;; and ttree. Currently, we simply return 0 for the column and nil
+  ;; for the ttree. I believe the column value is correct, but the
+  ;; ttree should eventually be the accumulation of all the ttrees
+  ;; associated with all the proofs done in the termination analysis.
+  
+ 
+  ;; This function is specially coded so that if contexts is nil then
+  ;; it is a signal that there is only one element of names and it is
+  ;; a non-recursive function.  In that case, we short-circuit all of
+  ;; the proof machinery and simply do the associated output.  We
+  ;; coded it this way to preserve the invariant that
+  ;; prove-termination is THE place the defun output is initiated.
+
+  ;; This function increments timers.  Upon entry, any accumulated time
+  ;; is charged to 'other-time.  The printing done herein is charged
+  ;; to 'print-time and the proving is charged to 'prove-time.
+
+  (let* ((ccms (mapcar #'cdr ccm-hints))
+         (entry (find-?-ccm names ccms))
+         ;;(time-limit (get-ccg-time-limit wrld))
+         (stop-time (if time-limit (+ (get-internal-run-time) 
+                                      (* internal-time-units-per-second
+                                         time-limit))
+                      nil))
+         (qspv (make query-spec-var
+                            :stop-time stop-time
+                            :mem (create-memoization
+                                  (max-induction-depth hierarchy))
+                            :otf-flg otf-flg
+                            :ens ens
+                            :ctx ctx
+                            :wrld wrld)))
+    (cond
+     ((and entry
+           (not (ld-skip-proofsp state)))
+      (let ((fn (car entry))
+            (ccm (cdr entry)))
+        (er soft ctx
+            "A CCM of the form (:? v1 ... vk) is only legal when the defun is ~
+             redundant (see :DOC redundant-events) or when skipping proofs ~
+             (see :DOC ld-skip-proofsp).  The CCM ~x0 supplied for function ~
+             symbol ~x1 is thus illegal."
+            ccm fn)))
+     ((null contexts)
+      (mv-let (col state)
+              (io? event nil (mv col state)
+                   (names)
+                   (fmt "Since ~&0 is non-recursive, its admission is trivial.  "
+                        (list (cons #\0 names))
+                        (proofs-co state)
+                        state
+                        nil)
+                   :default-bindings ((col 0)))
+              (value (list* :ccg (or col 0) nil nil))))
+     ((ld-skip-proofsp state)
+      (let ((fns (fns-without-consider-only-ccms-hints names ccms)))
+        (if (consp fns)
+            (er soft ctx
+                "Proofs cannot be skipped on a CCG termination proof unless ~
+                 CCMs are defined for every function. You did not supply CCMs ~
+                 for function~#0~[~/s~] ~&0. Therefore, proofs cannot be skipped."
+                fns)
+          (value (list* :ccg
+                        0
+                        (pairlis$ names
+                                  (mapcar (lambda (x)
+                                            `(:? ,@(all-vars1-lst (cdr x) nil)))
+                                          ccms))
+                        nil
+                        nil)))))
+     (t
+      (pprogn
+       (ccg-io?
+        basics nil state
+        (names ruler-extenders-lst)
+        (fms "Attempting to prove termination using Calling Context Graph ~
+              (CCG) analysis. There are various ways in which users can ~
+              control CCG analysis. See the :DOC CCG for details. This ~
+              analysis is described in a 2006 CAV paper by Manolios and ~
+              Vroon.~|~%The ruler-extenders for each function are as follows: ~
+              ~*0~|"
+             `((#\0 .
+                ,(ruler-extender-printout names
+                                          ruler-extenders-lst)))
+             *standard-co*
+             state
+             nil))
+       (simplify-contexts contexts ens wrld ctx state)
+       (mv-let
+        (o-p-clauses ttree)
+        (clean-up-clause-set (ccm-o-p-clauses contexts ccms)
+                             ens wrld ttree state)
+        (er-let*
+            ((ttree (accumulate-ttree-and-step-limit-into-state
+                      ttree :skip state)))
+        (pprogn
+         (increment-timer 'other-time state)
+         (er-let*
+          ((displayed-goal (value
+                            (prettyify-clause-set o-p-clauses
+                                                  (let*-abstractionp state)
+                                                  wrld)))
+           (simp-phrase (value (tilde-*-simp-phrase ttree)))
+           (ttree1
+            (if o-p-clauses
+                (pprogn
+                 (io? event nil state
+                      (ttree displayed-goal simp-phrase)
+                      (fms "You have told us to consider CCMs that are not ~
+                             trivially proved to be ordinals. ~
+                             Therefore, the conjecture that we must prove ~
+                             before we can continue with the CCG ~
+                             analysis~#0~[~/, given ~*1,~] is ~
+                             ~@2~%~%Goal~%~Q34."
+                           `((#\0 . ,(if (nth 4 simp-phrase) 1 0))
+                             (#\1 . ,simp-phrase)
+                             (#\2 . ,(if (tagged-objectsp 'sr-limit ttree)
+                                         " as follows (where the ~
+                                           subsumption/replacement limit ~
+                                           affected this analysis; see :DOC ~
+                                           case-split-limitations)."
+                                       ""))
+                             (#\3 . ,displayed-goal)
+                             (#\4 . ,(term-evisc-tuple nil state)))
+                           (proofs-co state)
+                           state
+                           nil))
+                 (increment-timer 'print-time state)
+                 (prove (termify-clause-set o-p-clauses)
+                        (make-pspv
+                         ens wrld
+                         :displayed-goal displayed-goal
+                         :otf-flg otf-flg)
+                        nil ens wrld ctx state))
+              (value ttree))))
+          (mv-let
+           (has-ccgp has-measurep)
+           (ccg-hierarchy-kinds-of-levels hierarchy nil nil)
+           (er-let*
+            ((ba-tuple
+              (if has-ccgp
+                  (build-accgs names contexts functs ccm-hints wrld state)
+                (list* (make-array 0
+                                   :initial-element (make-context)
+                                   :element-type 'context)
+                       `(,(make-array 0
+                                      :initial-element (make-accg-node)
+                                      :element-type 'accg-node))
+                       `(,(make-array 0
+                                      :initial-element (make-accg-node)
+                                      :element-type 'accg-node))
+                       `(nil))))
+             (context-array (value (car ba-tuple)))
+             (proved-accgs (value (cadr ba-tuple)))
+             (accgs (value (caddr ba-tuple)))
+             (ces (value (cdddr ba-tuple)))
+             (measure-alist
+              (if (not has-measurep)
+                  (value nil)
+                (mv-let
+                 (erp ma state)
+                 (guess-measure-alist names arglists
+                                      measures
+                                      t-machines
+                                      ctx wrld state)
+                 (if (not erp)
+                     (value ma)
+                   (pprogn
+                    (ccg-io? basics nil state
+                             (names)
+                             (fms "Since there was an error guessing the ~
+                                   measure~#0~[~/s~], we will skip all levels ~
+                                   of the hierarchy of the form (:MEASURE ~
+                                   PT).~|"
+                                  `((#\0 . ,names))
+                                  *standard-co*
+                                  state
+                                  nil))
+                    (value nil)))))))
+            (er-let* ((quadruple
+                       (ccg accgs ces nil hierarchy proved-accgs context-array
+                            names arglists t-machines measure-alist mp rel bodies
+                            verbose qspv state)))
+              (let* ((term-method (car quadruple))
+                     (col (cadr quadruple))
+                     (measure-alist (caddr quadruple))
+                     (ttree-new (cdddr quadruple)))
+                (prog2$
+                 nil;dummy --harshrc
+                 ;(cw "~|**DEBUG**:: old ttree=~x0 ~ new ttree is ~x1 ~ and ttree1 is ~x2~|" ttree ttree-new ttree1)
+                 (value (list* term-method
+                               col
+                               measure-alist
+                               (cons-tag-trees ttree-new ttree1))))))
+                               
+              )))))))))))
+
+(defun-raw ccg-prove-termination-recursive
+  (names arglists measures ccm-hints
+         ruler-extenders-lst t-machines mp rel
+         verbose time-limit hierarchy
+         otf-flg bodies ctx ens wrld state)
+  
+; Next we get the measures for each function.  That may cause an error
+; if we couldn't guess one for some function.
+  
+  (let ((functs (make-funct-structs names arglists)))
+    (prove-termination-with-ccg
+     names functs (t-machines-to-contexts t-machines functs)
+     ruler-extenders-lst
+     ccm-hints hierarchy verbose time-limit arglists measures t-machines
+     mp rel otf-flg bodies ctx ens wrld state nil)))
+
+(defun-raw ccg-put-induction-info
+  (names arglists term-method measures ccms ruler-extenders-lst bodies
+         mp rel verbose time-limit hierarchy
+         hints otf-flg big-mutrec ctx ens wrld state)
+
+; WARNING: This function installs a world.  That is safe at the time of this
+; writing because this function is only called by defuns-fn0, which is only
+; called by defuns-fn, where that call is protected by a revert-world-on-error.
+
+; We are processing a clique of mutually recursive functions with the names,
+; arglists, measures, ruler-extenders-lst, and bodies given.  All of the above
+; lists are in 1:1 correspondence.  The hints is the result of appending
+; together all of the hints provided.  Mp and rel are the domain predicate and
+; well-founded relation to be used.  We attempt to prove the admissibility of
+; the recursions.  We cause an error if any proof fails.  We put a lot of
+; properties under the function symbols, namely:
+
+;    recursivep                     all fns in names
+;    justification                  all recursive fns in names
+;    induction-machine              the singly recursive fn in name*
+;    quick-block-info               the singly recursive fn in name*
+;    symbol-class :ideal            all fns in names
+
+; *If names consists of exactly one recursive fn, we store its
+; induction-machine and its quick-block-info, otherwise we do not.
+
+; If no error occurs, we return a triple consisting of the column the printer
+; is in, the final value of wrld and a tag tree documenting the proofs we did.
+
+; Note: The function could be declared to return 5 values, but we would rather
+; use the standard state and error primitives and so it returns 3 and lists
+; together the three "real" answers.
+
+ (let ((wrld1 (putprop-recursivep-lst names bodies wrld)))
+
+; The put above stores a note on each function symbol as to whether it is
+; recursive or not.  An important question arises: have we inadventently
+; assumed something axiomatically about inadmissible functions?  We say no.
+; None of the functions in question have bodies yet, so the simplifier doesn't
+; care about properties such as 'recursivep.  However, we make use of this
+; property below to decide if we need to prove termination.
+
+    (cond ((and (null (cdr names))
+                (null (getprop (car names) 'recursivep nil
+                               'current-acl2-world wrld1)))
+
+; If only one function is being defined and it is non-recursive, we can quit.
+; But we have to store the symbol-class and we have to print out the admission
+; message with prove-termination so the rest of our processing is uniform.
+           
+           (er-let*
+            ((tuple (prove-termination-non-recursive names bodies mp rel hints otf-flg big-mutrec
+                                                     ctx ens wrld1 state)))
+            (value (cons nil tuple))))
+          (t
+           (let ((t-machines (termination-machines names bodies ruler-extenders-lst)))
+             (er-let*
+              ((wrld1 (update-w
+                               
+; Sol Swords sent an example in which a clause-processor failed during a
+; termination proof.  That problem goes away if we install the world, which we
+; do by making the following binding.
+
+                       t ; formerly big-mutrec
+                       wrld1))
+              (quadruple
+               (if (eq term-method :measure)
+                   (er-let* ((triple (prove-termination-recursive
+                                      names arglists
+                                      measures
+                                      t-machines
+                                      mp rel hints otf-flg bodies
+                                      ctx ens wrld1 state)))
+                     (value (cons :measure triple)))
+                 (ccg-prove-termination-recursive names arglists
+                                                  measures
+                                                  ccms
+                                                  ruler-extenders-lst
+                                                  t-machines
+                                                  mp rel 
+                                                  verbose
+                                                  time-limit
+                                                  hierarchy
+                                                  otf-flg bodies
+                                                  ctx ens wrld1 state))))
+                ;;(progn
+                  ;;(print quadruple)
+               (let* ((term-method (car quadruple))
+                      (col (cadr quadruple))
+                      (measure-alist (caddr quadruple))
+                      (ttree (cdddr quadruple)))
+                 (er-let*
+                     ((tuple (put-induction-info-recursive names arglists
+                                                           col ttree
+                                                           measure-alist t-machines
+                                                           ruler-extenders-lst
+                                                           bodies mp rel wrld1
+                                                           state)))
+                   (value (cons term-method tuple))))))))))
+
+(defun defun-redundant-get-ccms (fives wrld)
+  ;; gets the CCMs installed into the world for a given set of function definitions.
+  (if (endp fives)
+      nil
+    (let ((subset (access justification
+                          (getprop (first (car fives))
+                                   'justification
+                                   (make justification :subset '())
+                                   'current-acl2-world
+                                   wrld)
+                          :subset)))
+      (cons `((:? ,@subset))
+            (defun-redundant-get-ccms (cdr fives) wrld)))))
+
+
+(defun defun-redundant-get-measures (fives wrld)
+  ;; gets the CCMs installed into the world for a given set of function definitions.
+  (if (endp fives)
+      nil
+    (let ((subset (access justification
+                          (getprop (first (car fives))
+                                   'justification
+                                   (make justification :subset '())
+                                   'current-acl2-world
+                                   wrld)
+                          :subset)))
+      (cons `(:? ,@subset)
+            (defun-redundant-get-measures (cdr fives) wrld)))))
+
+(defun remove-keywords (keys lst)
+  (cond ((endp lst)
+         nil)
+        ((member-eq (car lst) keys)
+         (remove-keywords keys (cddr lst)))
+        (t
+         (list* (car lst) (cadr lst) (remove-keywords keys (cddr lst))))))
+    
+(defun remove-dcls0 (edcls keys)
+  (cond ((endp edcls) nil) ;; if we don't have any xargs, we don't need to do anything.
+        ((eq (caar edcls) 'xargs)
+         (let ((newlst (remove-keywords keys (cdar edcls))))
+           (if (endp newlst)
+               (remove-dcls0 (cdr edcls) keys)
+             (acons 'xargs 
+                    newlst
+                    (remove-dcls0 (cdr edcls) keys)))))
+        (t (cons (car edcls)
+                 (remove-dcls0 (cdr edcls) keys)))))
+
+(defun remove-dcls (fives keys)
+  ;; we alter the definitions given in fives to remove xarg
+  ;; declarations corresponding to the given keys
+  (cond ((endp fives)
+         nil)
+        ((endp (nth 3 (car fives))) ;; if there are no declarations, there is nothing to do.
+         (cons (car fives)
+               (remove-dcls (cdr fives) keys)))
+        (t
+         (cons (update-nth 3 (remove-dcls0 (nth 3 (car fives)) keys) (car fives))
+               (remove-dcls (cdr fives) keys)))))
+
+(defun update-keyword (key val lst)
+  (cond ((endp lst)
+         (list key val))
+        ((eq (car lst) key)
+         (cons key (cons val (remove-keywords `(,key) (cddr lst)))))
+        (t
+         (cons (car lst)
+               (cons (cadr lst) 
+                     (update-keyword key val (cddr lst)))))))
+
+(defun unambiguously-fix-dcls0 (edcls key val)
+  (cond ((endp edcls)
+         (list (cons 'xargs (list key val))))
+        ((eq (caar edcls) 'xargs)
+         (acons 'xargs (update-keyword key val (cdar edcls))
+                (remove-dcls0 (cdr edcls) `(,key))))
+        (t
+         (cons (car edcls)
+               (unambiguously-fix-dcls0 (cdr edcls) key val)))))
+
+(defun unambiguously-fix-dcls (fives key vals)
+  ;; we alter the definitions given in fives to declare key to be of
+  ;; vals, such that the ith definition in fives has key set to the
+  ;; ith value of vals.
+  (cond ((endp fives)
+         nil)
+        (t
+         (cons (update-nth 3 (unambiguously-fix-dcls0 (nth 3 (car fives)) key (car vals))
+                           (car fives))
+               (unambiguously-fix-dcls (cdr fives) key (cdr vals))))))
+
+(defun app-lst (lst)
+  ;; appends all the elements of lst together.
+  (if (endp lst)
+      nil
+    (append (car lst) (app-lst (cdr lst)))))
+   
+(defun fives-to-defuns0 (fives)
+  (if (endp fives)
+      nil
+    (let* ((five (car fives))
+           (name (first five))
+           (args (second five))
+           (doc (third five))
+           (dcls (fourth five))
+           (body (fifth five))
+           (d1 (list body))
+           (d2 (if doc (cons doc d1) d1))
+           (d3 (if dcls (acons 'declare dcls d2) d2)))
+      (cons `(defun ,name ,args ,@d3)
+            (fives-to-defuns0 (cdr fives))))))
+
+(defun fives-to-defuns (fives)
+  ;; turns a list of "fives" into defuns from which such "fives" would
+  ;; be derived.
+  `(with-output
+    :off (summary event)
+    ,(if (endp (cdr fives))
+         (car (fives-to-defuns0 fives))
+       (cons 'mutual-recursion
+             (fives-to-defuns0 fives)))))
+
+
+;; END raw definitions for CCG analysis
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; These support optional make-event expansion by events other than make-event.
+; -Peter Dillinger
+
+(defun dynamic-make-event-fn (body event-form state)
+;;  (declare (xargs :mode :program))
+  (make-event-fn `',body
+                 nil
+                 nil
+                 nil
+                 event-form
+                 state))
+
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun defun-make-event (names fives symbol-class term-method wrld event-form state)
+  (if (or (eq symbol-class :program)
+          (and (null (cdr names))
+               (null (getprop (car names) 'recursivep nil
+                              'current-acl2-world wrld))))
+      (value (cond ((null (cdr names)) (car names))
+                   (t names)))
+    (let* ((fives0 (remove-dcls fives 
+                                (if (eq term-method :measure)
+                                    *ccg-xargs-keywords*
+                                  (list* :HINTS
+                                         :MEASURE
+                                         :WELL-FOUNDED-RELATION
+                                         *ccg-xargs-keywords*))))
+           (fives1 (unambiguously-fix-dcls fives0 :termination-method
+                                           (make-list (length fives)
+                                                      :initial-element :measure)))
+           (fives2 (if (eq term-method :measure)
+                       fives1
+                     (unambiguously-fix-dcls
+                      fives1
+                      :MEASURE
+                      (defun-redundant-get-measures fives wrld)))))
+      (er-progn
+       (state-global-let* ((accumulated-ttree nil)
+                           (inhibit-output-lst (cons 'summary (@ inhibit-output-lst))))
+                          (dynamic-make-event-fn (fives-to-defuns fives2)
+                                                 event-form
+                                                 state))
+       (value (cond ((null (cdr names)) (car names))
+                    (t names)))))))
+
+; defines a function to bridge ACL2 and raw lisp.  if you ask ACL2 what its
+; definition is, it will say "(value nil)," but if you run it, you get the
+; behavior of the raw body.  there are no soundness issues with that because
+; the function is flagged as permanently :program-mode only.
+;
+; defun-bridge is provided by my hacker stuff. -Peter
+
+; June 16 2013 - ccg.lisp certification breaks with ACL2 6.2
+; Keep this function and defuns-fn1 call in sync in ACL2 sources - harshrc
+
+(defun-raw ccg-defuns-fn0
+
+; WARNING: This function installs a world.  That is safe at the time of this
+; writing because this function is only called by defuns-fn, where that call is
+; protected by a revert-world-on-error.
+
+  (names arglists docs pairs guards term-method measures 
+         ccms ;ccg
+         ruler-extenders-lst mp rel
+         verbose time-limit hierarchy ;ccg
+         hints guard-hints std-hints 
+         otf-flg guard-debug bodies symbol-class normalizeps 
+         split-types-terms non-executablep 
+         #+:non-standard-analysis std-p 
+         ctx wrld state)
+  (cond
+   ((eq symbol-class :program)
+    (defuns-fn-short-cut names docs pairs guards split-types-terms bodies
+      non-executablep ; not sure about this, but seems plausible
+      wrld state))
+   (t
+    (let ((ens (ens state))
+          (big-mutrec (big-mutrec names)))
+      (er-let*
+       ((tuple (ccg-put-induction-info names arglists
+                                       term-method ;ccg specific
+                                       measures
+                                       ccms ;ccg
+                                       ruler-extenders-lst
+                                       bodies
+                                       mp rel
+                                       verbose ;ccg
+                                       time-limit ;ccg
+                                       hierarchy ;ccg
+                                       hints
+                                       otf-flg
+                                       big-mutrec
+                                       ctx ens wrld state)))
+       (defuns-fn1
+         (cdr tuple) ;(car tuple) is term-method
+         ens
+         big-mutrec
+         names
+         arglists
+         docs
+         pairs
+         guards
+         guard-hints
+         std-hints
+         otf-flg
+         guard-debug
+         bodies
+         symbol-class
+         normalizeps
+         split-types-terms
+         non-executablep
+         #+:non-standard-analysis std-p
+         ctx
+         state))))))
+
+(defun-bridge ccg-defuns-fn (def-lst state event-form #+:non-standard-analysis std-p)
+
+; Important Note:  Don't change the formals of this function without
+; reading the *initial-event-defmacros* discussion in axioms.lisp.
+
+; On Guards
+
+; When a function symbol fn is defund the user supplies a guard, g, and a
+; body b.  Logically speaking, the axiom introduced for fn is
+
+;    (fn x1...xn) = b.  
+
+; After admitting fn, the guard-related properties are set as follows:
+
+; prop                after defun
+
+; body                   b*
+; guard                  g
+; unnormalized-body      b
+; type-prescription      computed from b
+; symbol-class           :ideal
+
+; * We actually normalize the above.  During normalization we may expand some
+; boot-strap non-rec fns.
+
+; In addition, we magically set the symbol-function of fn
+
+; symbol-function        b
+
+; and the symbol-function of *1*fn as a program which computes the logical
+; value of (fn x).  However, *1*fn is quite fancy because it uses the raw body
+; in the symbol-function of fn if fn is :common-lisp-compliant, and may signal
+; a guard error if 'guard-checking-on is set to other than nil or :none.  See
+; oneify-cltl-code for the details.
+
+; Observe that the symbol-function after defun may be a form that
+; violates the guards on primitives.  Until the guards in fn are
+; checked, we cannot let raw Common Lisp evaluate fn.
+
+; Intuitively, we think of the Common Lisp programmer intending to defun (fn
+; x1...xn) to be b, and is declaring that the raw fn can be called only on
+; arguments satisfying g.  The need for guards stems from the fact that there
+; are many Common Lisp primitives, such as car and cdr and + and *, whose
+; behavior outside of their guarded domains is unspecified.  To use these
+; functions in the body of fn one must "guard" fn so that it is never called in
+; a way that would lead to the violation of the primitive guards.  Thus, we
+; make a formal precondition on the use of the Common Lisp program fn that the
+; guard g, along with the tests along the various paths through body b, imply
+; each of the guards for every subroutine in b.  We also require that each of
+; the guards in g be satisfied.  This is what we mean when we say fn is
+; :common-lisp-compliant.
+
+; It is, however, often impossible to check the guards at defun time.  For
+; example, if fn calls itself recursively and then gives the result to +, we
+; would have to prove that the guard on + is satisfied by fn's recursive
+; result, before we admit fn.  In general, induction may be necessary to
+; establish that the recursive calls satisfy the guards of their masters;
+; hence, it is probably also necessary for the user to formulate general lemmas
+; about fn to establish those conditions.  Furthermore, guard checking is no
+; longer logically necessary and hence automatically doing it at defun time may
+; be a waste of time.
+
+  :program (value nil)
+  :raw
+  (with-ctx-summarized
+   (defun-ctx def-lst state event-form #+:non-standard-analysis std-p)
+   (let ((wrld (w state)) 
+         (def-lst0
+           #+:non-standard-analysis
+           (if std-p
+               (non-std-def-lst def-lst)
+             def-lst)
+           #-:non-standard-analysis
+           def-lst)
+         (event-form (or event-form (list 'defuns def-lst))))
+     (revert-world-on-error
+      (er-let*
+       ((tuple (ccg-chk-acceptable-defuns def-lst ctx wrld state
+                                          #+:non-standard-analysis std-p)))
+
+; Chk-acceptable-defuns puts the 'formals, 'stobjs-in and 'stobjs-out
+; properties (which are necessary for the translation of the bodies).
+; All other properties are put by the defuns-fn0 call below.
+
+       (cond
+        ((eq tuple 'redundant)
+         (stop-redundant-event ctx state))
+        (t
+         (enforce-redundancy
+          event-form ctx wrld
+          (let ((term-method (nth 1 tuple))
+                (names (nth 2 tuple))
+                (arglists (nth 3 tuple))
+                (docs (nth 4 tuple))
+                (pairs (nth 5 tuple))
+                (guards (nth 6 tuple))
+                (measures (nth 7 tuple))
+                (ruler-extenders-lst (nth 8 tuple))
+                (mp (nth 9 tuple))
+                (rel (nth 10 tuple))
+                (hints (nth 11 tuple))
+                (guard-hints (nth 12 tuple))
+                (std-hints (nth 13 tuple))
+                (otf-flg (nth 14 tuple))
+                (bodies (nth 15 tuple))
+                (symbol-class (nth 16 tuple))
+                (normalizeps (nth 17 tuple))
+                (reclassifyingp (nth 18 tuple))
+                (wrld (nth 19 tuple))
+                (non-executablep (nth 20 tuple))
+                (guard-debug (nth 21 tuple))
+                (split-types-terms (nth 22 tuple))
+                (ccms (nth 23 tuple))
+                (verbose (nth 24 tuple))
+                (time-limit (nth 25 tuple))
+                (hierarchy (nth 26 tuple)))
+            (er-let*
+             ((pair (ccg-defuns-fn0
+                     names
+                     arglists
+                     docs
+                     pairs
+                     guards
+                     term-method
+                     measures
+                     ccms
+                     ruler-extenders-lst
+                     mp
+                     rel
+                     verbose
+                     time-limit
+                     hierarchy
+                     hints
+                     guard-hints
+                     std-hints
+                     otf-flg
+                     guard-debug
+                     bodies
+                     symbol-class
+                     normalizeps
+                     split-types-terms
+                     non-executablep
+                     #+:non-standard-analysis std-p
+                     ctx
+                     wrld
+                     state)))
+
+; Triple is of the form (term-method wrld . ttree), where term-method is the
+; actual termination method used to prove termination.
+; Pair is of the form (wrld . ttree).
+
+             ;;--harshrc: As Daron says (where?), I changed code, to force checking a nil ttree
+             ;;but ideally we shud accumulate all successful ttrees.
+
+             (er-progn
+              (chk-assumption-free-ttree nil;(cdr pair)
+                                         ctx state)
+
+              (install-event-defuns names event-form def-lst0 symbol-class
+                                    reclassifyingp non-executablep pair ctx wrld
+                                    state)
+              (if (or (eq symbol-class :program)
+                      (ld-skip-proofsp state)
+                      (and (null (cdr names))
+                           (null (getprop (car names)
+                                          'recursivep
+                                          nil
+                                          'current-acl2-world
+                                          wrld))))
+                  (value (cond ((null (cdr names)) (car names))
+                               (t names)))
+                (er-let* ((fives (chk-defuns-tuples def-lst nil ctx wrld state)))
+                  (defun-make-event
+                    names fives symbol-class term-method
+                    (car pair) event-form state))))))))))))))
+
+; redefine defuns-fn to "be" (call) ccg-defuns-fn.
+;
+; redefun is provided by my hacker stuff. -Peter
+
+(redefun defuns-fn (def-lst state event-form #+:non-standard-analysis std-p)
+         (ccg-defuns-fn def-lst state event-form #+:non-standard-analysis std-p))
+
+(progn+touchable
+ :all
+ (redefun+rewrite
+  defstobj-fn
+  (:carpat (process-embedded-events %1%
+                                    %2%
+                                    %3%
+                                    %4%
+                                    %5%
+                                    (append
+                                     . %app-cdr%)
+                                    . %pee-cdr%)
+           :repl (process-embedded-events %1%
+                                          %2%
+                                          %3%
+                                          %4%
+                                          %5%
+                                          (append
+                                           '((set-termination-method :measure))
+                                           . %app-cdr%)
+                                          . %pee-cdr%)
+           :vars (%1% %2% %3% %4% %5% %app-cdr% %pee-cdr%)
+           :mult 1)))
+
diff -Nru acl2-6.2/books/centaur/4v-sexpr/4v-logic.lisp acl2-6.3/books/centaur/4v-sexpr/4v-logic.lisp
--- acl2-6.2/books/centaur/4v-sexpr/4v-logic.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/4v-logic.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -142,7 +142,16 @@
   :parents (4v)
   :short "Primitive operations in our four-valued logic."
 
-  :long "<p>Note that all of these operations are <see topic='@(url
+  :long "<p>This is a collection of operations on @(see 4vp)s that are
+generally meant to model the behavior of particular, primitive kinds of
+circuits.  For instance, in the @(see esim) hardware simulator, the @(see
+esim-primitives) are generally based on these operations.</p>
+
+<p>The operations here apply to four-valued constants and produce new
+four-valued constants as results.  If you are looking for operations that
+construct new @(see 4v-sexprs), see instead the @(see 4vs-constructors).</p>
+
+<p>Note that all of these operations are <see topic='@(url
 4v-monotonicity)'>monotonic</see>.</p>")
 
 
@@ -553,6 +562,29 @@
                (t
                 (4vx))))))
 
+(defsection 4v-zif
+  :parents (4v-operations)
+  :short "Unusual semantics for a multiplexor, used mainly to implement composition
+features in @(see esim) "
+
+  :long "<p>A ZIF module is in some ways similar to a pass-gate based
+multiplexor, but is probably not the sort of thing you would actually want to
+use to model a mux.  It is very similar to an @(see 4v-ite*) but does not @(see
+4v-unfloat) its inputs.  We include this mainly as a way to implement
+experimental composition features in @(see esim).</p>"
+
+  (defun 4v-zif (c a b)
+    (declare (xargs :guard t))
+    (mbe :logic
+         (4vcases c
+           (t (4v-fix a))
+           (f (4v-fix b))
+           (& (4vx)))
+         :exec
+         (cond ((eq c (4vt)) (4v-fix a))
+               ((eq c (4vf)) (4v-fix b))
+               (t
+                (4vx))))))
 
 
 (defsection 4v-tristate
@@ -889,7 +921,7 @@
 
 
 (def-ruleset 4v-op-defs '(4v-fix 4v-unfloat 4v-not 4v-and 4v-or 4v-xor 4v-iff
-                                 4v-res 4v-ite 4v-ite* 4v-tristate 4v-pullup
+                                 4v-res 4v-ite 4v-ite* 4v-zif 4v-tristate 4v-pullup
                                  4v-wand 4v-wor))
 
 (def-ruleset 4v-op-execs '((4v-fix$inline)
@@ -902,6 +934,7 @@
                            (4v-res)
                            (4v-ite)
                            (4v-ite*)
+                           (4v-zif)
                            (4v-tristate)
                            (4v-pullup)
                            (4v-wand)
@@ -1042,6 +1075,7 @@
   (prove-4v-monotonic 4v-res (a b))
   (prove-4v-monotonic 4v-ite (c a b))
   (prove-4v-monotonic 4v-ite* (c a b))
+  (prove-4v-monotonic 4v-zif (c a b))
   (prove-4v-monotonic 4v-tristate (c a))
   (prove-4v-monotonic 4v-pullup (a))
   (prove-4v-monotonic 4v-wand (a b))
@@ -1217,3 +1251,21 @@
                                       (y b)
                                       (k k0)))))))))
 
+
+
+(defun bool-to-4v (x)
+  (declare (xargs :guard t))
+  (if x *4vt* *4vf*))
+
+(defun 4v-to-nat (a)
+  (declare (xargs :guard t))
+  (if (atom a)
+      0
+    (let ((rest (4v-to-nat (cdr a))))
+      (if (integerp rest)
+          (case (car a)
+            ((t) (+ 1 (* 2 rest)))
+            ((f) (* 2 rest))
+            (t 'x))
+        rest))))
+
diff -Nru acl2-6.2/books/centaur/4v-sexpr/bitspecs.lisp acl2-6.3/books/centaur/4v-sexpr/bitspecs.lisp
--- acl2-6.2/books/centaur/4v-sexpr/bitspecs.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/bitspecs.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -1132,13 +1132,14 @@
                            (x x) (y (car spec)) (spec (cdr spec)))))))
 
 
-(defthm true-listp-and-subset-and-no-intersect-impl-nil
-  (implies (and (true-listp x)
-                (subsetp-equal x y)
-                (not (intersectp-equal x y)))
-           (Equal x nil))
-  :hints ((set-reasoning))
-  :rule-classes nil)
+(local (defthm true-listp-and-subset-and-no-intersect-impl-nil
+         (implies (and (true-listp x)
+                       (subsetp-equal x y)
+                       (not (intersectp-equal x y)))
+                  (Equal x nil))
+         :hints (("Goal" :in-theory (enable intersectp-equal))
+                 (set-reasoning))
+         :rule-classes nil))
 
 (defthm true-listp-4v-bitspec-entry-vars
   (implies (4v-bitspec-entryp x)
@@ -1150,9 +1151,10 @@
            (iff (intersectp-equal (4v-bitspec-entry-vars x)
                                        (4v-bitspec-vars spec))
                 (not (equal (4v-bitspec-entry-vars x) nil))))
-  :hints (("goal" :use ((:instance true-listp-and-subset-and-no-intersect-impl-nil
-                                   (x (4v-bitspec-entry-vars x))
-                                   (y (4v-bitspec-vars spec))))
+  :hints (("goal"
+           :use ((:instance true-listp-and-subset-and-no-intersect-impl-nil
+                            (x (4v-bitspec-entry-vars x))
+                            (y (4v-bitspec-vars spec))))
            :in-theory (disable 4v-bitspec-entry-vars))))
 
 (defthm param-for-4v-bitspec-entryp-when-no-vars
diff -Nru acl2-6.2/books/centaur/4v-sexpr/compose-sexpr.lisp acl2-6.3/books/centaur/4v-sexpr/compose-sexpr.lisp
--- acl2-6.2/books/centaur/4v-sexpr/compose-sexpr.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/compose-sexpr.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -543,7 +543,6 @@
                      intersectp-equal-non-cons
                      4v-sexpr-vars-list
                      4v-sexpr-restrict-alist
-                     alist-equiv-append-atom
                      alist-vals-when-atom
                      alist-keys-when-atom
                      4v-alist-to-params-append-when-first-does-not-intersect-vars
diff -Nru acl2-6.2/books/centaur/4v-sexpr/g-sexpr-eval.lisp acl2-6.3/books/centaur/4v-sexpr/g-sexpr-eval.lisp
--- acl2-6.2/books/centaur/4v-sexpr/g-sexpr-eval.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/g-sexpr-eval.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -29,7 +29,7 @@
 (local (include-book "centaur/misc/hons-sets" :dir :system))
 (local (include-book "centaur/aig/eval-restrict" :dir :system))
 (local (include-book "arithmetic/top-with-meta" :dir :system))
-
+(local (in-theory (disable nth-when-zp)))
 
 
 (defun num-varmap (keys n)
@@ -156,9 +156,15 @@
      (implies (acl2-numberp idx)
               (good-svarmap (num-varmap keys idx))))
 
-
    (in-theory (disable num-varmap))))
 
+(defthm good-svarmap-num-varmap
+  ;; [Jared]: Adding this non-locally so that I can use it in simple
+  ;; sexpr->faig conversion.
+  (implies (acl2-numberp idx)
+           (good-svarmap (num-varmap keys idx))))
+
+
 
 (defun 4v-sexpr-eval-by-faig (x al)
   (let* ((vars (alist-keys al))
@@ -389,6 +395,18 @@
                   '(:in-theory (enable 4v-fix))))
      :otf-flg t)))
 
+(defthm 4v-alist-equiv-faig-const-alist->4v-alist-lemma
+  ;; [Jared]: Adding this non-locally so that I can use it in simple
+  ;; sexpr->faig conversion.
+  (4v-env-equiv
+   (FAIG-CONST-ALIST->4V-ALIST
+    (FAIG-EVAL-ALIST
+     (num-varmap (alist-keys al) 0)
+     (SIG-AL-TO-sVAR-AL
+      (4V-ALIST->FAIG-CONST-ALIST AL)
+      (num-varmap (alist-keys al) 0))))
+   al))
+
 (defthm 4v-sexpr-eval-by-faig-is-4v-sexpr-eval
   (equal (4v-sexpr-eval-by-faig x al)
          (4v-sexpr-eval x al))
@@ -523,3 +541,79 @@
                                 alist-keys
                                 good-svarmap
                                 4v-sexpr-to-faig-opt))
+
+
+(include-book "centaur/gl/def-gl-rewrite" :dir :system)
+
+(gl::gl-set-uninterpreted bool-to-4v)
+(gl::gl-set-uninterpreted faig-const->4v)
+(gl::def-gl-rewrite 4v->faig-const-of-bool-to-4v-gl
+                    (equal (4v->faig-const (bool-to-4v x))
+                           (cons (not (not x)) (not x))))
+(gl::def-gl-rewrite faig-const->4v-equal-x-gl
+                    (equal (equal (faig-const->4v a) 'x)
+                           (not (or (equal a (faig-t))
+                                    (equal a (faig-f))
+                                    (equal a (faig-z))))))
+
+(gl::def-gl-rewrite 4v->faig-const-of-faig-const->4v-gl
+                    (equal (4v->faig-const (faig-const->4v x))
+                           (if (and (consp x)
+                                    (booleanp (car x))
+                                    (booleanp (cdr x)))
+                               x
+                             '(t . t))))
+
+(gl::def-gl-rewrite 4vp-of-faig-const->4v-rewrite
+                    (equal (4vp (faig-const->4v x)) t))
+
+;; the following 4 theorems are not needed in STV proofs but end up being
+;; useful in non-STV ones
+(gl::def-gl-rewrite equal-of-bool-to-4v-1
+                    (equal (equal (bool-to-4v x) y)
+                           (or (and x (equal y (4vt)))
+                               (and (equal x nil) (equal y (4vf))))))
+
+(gl::def-gl-rewrite equal-of-bool-to-4v-2
+                    (equal (equal y (bool-to-4v x))
+                           (or (and x (equal y (4vt)))
+                               (and (equal x nil) (equal y (4vf))))))
+
+(gl::def-gl-rewrite equal-of-faig-const->4v-1
+                    (equal (equal (faig-const->4v x) y)
+                           (or (and (equal x (faig-t)) (equal y (4vt)))
+                               (and (equal x (faig-f)) (equal y (4vf)))
+                               (and (equal x (faig-z)) (equal y (4vz)))
+                               (and (not (equal x (faig-t)))
+                                    (not (equal x (faig-f)))
+                                    (not (equal x (faig-z)))
+                                    (equal y (4vx))))))
+
+(gl::def-gl-rewrite equal-of-faig-const->4v-2
+                    (equal (equal y (faig-const->4v x))
+                           (or (and (equal x (faig-t)) (equal y (4vt)))
+                               (and (equal x (faig-f)) (equal y (4vf)))
+                               (and (equal x (faig-z)) (equal y (4vz)))
+                               (and (not (equal x (faig-t)))
+                                    (not (equal x (faig-f)))
+                                    (not (equal x (faig-z)))
+                                    (equal y (4vx))))))
+
+
+;; this is used in STVs
+(defun 4v-to-nat-cons (car rest)
+  (b* (((unless (integerp rest)) rest)
+       (a (4v->faig-const car))
+       ((unless (or (equal a (faig-t))
+                    (equal a (faig-f))))
+        'x))
+    (+ (if (equal a (faig-t)) 1 0) (* 2 rest))))
+
+(defthmd 4v-to-nat-redef
+  (equal (4v-to-nat x)
+         (b* (((when (atom x)) 0)
+              (rest (4v-to-nat (cdr x))))
+           (4v-to-nat-cons (car x) rest)))
+  :rule-classes ((:definition :install-body nil)))
+           
+(gl::set-preferred-def 4v-to-nat 4v-to-nat-redef)
diff -Nru acl2-6.2/books/centaur/4v-sexpr/onehot-rewrite.lisp acl2-6.3/books/centaur/4v-sexpr/onehot-rewrite.lisp
--- acl2-6.2/books/centaur/4v-sexpr/onehot-rewrite.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/onehot-rewrite.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -136,7 +136,8 @@
 
    (defthm member-equal-of-list-fix
      (equal (member-equal a (list-fix x))
-            (list-fix (member-equal a x))))
+            (list-fix (member-equal a x)))
+     :hints(("Goal" :in-theory (enable member-equal))))
 
    (defthm list-fix-under-set-equiv
      (set-equiv (list-fix x)
@@ -265,7 +266,8 @@
      (local (defthm l0
               (implies (and (member-equal a x)
                             (member-equal k (4v-sexpr-vars a)))
-                       (member-equal k (4v-sexpr-vars-list x)))))
+                       (member-equal k (4v-sexpr-vars-list x)))
+              :hints(("Goal" :in-theory (enable member-equal)))))
 
      (defthm member-of-4v-sexpr-vars-list-when-subsetp
        (implies (and (subsetp-equal a b)
@@ -598,7 +600,7 @@
 
   :long "<p>How is this reduction accomplished?  Well, in the implementation of
 @(see 4v-shannon-expansion), reduced expressions are formed by using @(see
-sexpr-restrict) to assume that the variable being is first true, and then
+4v-sexpr-restrict) to assume that the variable being is first true, and then
 false.  Our approach is basically similar, and our new sexpr is essentially the
 following:</p>
 
@@ -771,7 +773,8 @@
               (implies (and (all-equalp *4vf* (4v-sexpr-eval-list x env))
                             (member-equal a x))
                        (equal (4v-sexpr-eval a env)
-                              *4vf*))))
+                              *4vf*))
+              :hints(("Goal" :in-theory (enable member-equal)))))
 
      (local (defthm h3
               (implies (and (4v-onehot-list-p (4v-sexpr-eval-list sexprs env))
@@ -1039,8 +1042,8 @@
          (false-bindings  (hons-acons var (4vs-f) bindings)))
 
       (4vs-ite*-list-dumb (car vars)
-                     sexprs/bindings
-                     (4v-onehot-sexpr-list-prime-exec (cdr vars) false-bindings sexprs))))
+                          sexprs/bindings
+                          (4v-onehot-sexpr-list-prime-exec (cdr vars) false-bindings sexprs))))
 
   (local (in-theory (enable 4v-onehot-sexpr-list-prime-exec)))
 
@@ -1072,6 +1075,11 @@
            (implies (atom sexprs)
                     (not (4v-onehot-sexpr-list-prime-exec vars false-bindings sexprs)))))
 
+  (local (defthm l1a
+           (iff (4vs-ite*-list-dumb c as bs)
+                (consp as))
+           :hints(("Goal" :in-theory (enable 4vs-ite*-list-dumb)))))
+
   (local (defthm l1
            (equal (consp (4v-onehot-sexpr-list-prime-exec vars false-bindings sexprs))
                   (consp sexprs))))
diff -Nru acl2-6.2/books/centaur/4v-sexpr/portcullis.acl2 acl2-6.3/books/centaur/4v-sexpr/portcullis.acl2
--- acl2-6.2/books/centaur/4v-sexpr/portcullis.acl2	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/portcullis.acl2	2013-09-30 17:53:10.000000000 +0000
@@ -20,7 +20,7 @@
 
 (in-package "ACL2")
 (ld "tools/flag-package.lsp" :dir :system)
-(ld "xdoc/package.lsp" :dir :system)
-(ld "centaur/vl/package.lsp" :dir :system)
+(include-book "xdoc/portcullis" :dir :system)
+(include-book "centaur/vl/portcullis" :dir :system)
 ; cert-flags: ? t :ttags :all
 (certify-book "portcullis" ? t :ttags :all)
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-3v.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-3v.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-3v.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-3v.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -32,6 +32,7 @@
            (not (or (eq fn (4vz))
                     (eq fn 'id)
                     (eq fn 'res)
+                    (eq fn 'zif)
                     (eq fn 'tristate))))))
 
   (local (in-theory (enable* 3v-syntax-sexprp
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-building.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-building.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-building.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-building.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -24,9 +24,9 @@
 (in-package "ACL2")
 (include-book "sexpr-eval")
 (include-book "sexpr-vars")
-(include-book "sexpr-3v")
 (include-book "cutil/defprojection" :dir :system)
 (include-book "misc/definline" :dir :system)
+(local (include-book "sexpr-3v"))
 ;(local (include-book "sexpr-to-faig")) ;; for 3v-opt stuff
 (set-inhibit-warnings "theory" "non-rec")
 
@@ -40,7 +40,7 @@
 
 <p>These functions carry out a few trivial rewrites (constant folding, double
 negation elimination).  An open question: how much rewriting should they do?
-Right now I don't try to optimize very aggressively, e.g., @(see sexpr-and)
+Right now I don't try to optimize very aggressively, e.g., @(see 4vs-and)
 doesn't eat bufs.  It's not clear how much of the code from @(see
 sexpr-rewrite) should be duplicated here.</p>")
 
@@ -469,6 +469,32 @@
 
 
 
+(defsection 4vs-zif-dumb
+  :parents (4vs-constructors)
+  :short "@(call 4vs-zif-dumb) constructs @('(ZIF C A B)'), i.e., the
+s-expression for an pass-gate style multiplexor."
+
+  (definlined 4vs-zif-dumb (c a b)
+    (declare (xargs :guard t))
+    (hons-list 'zif c a b))
+
+  (local (in-theory (enable 4vs-zif-dumb)))
+
+  (defthm 4v-sexpr-eval-of-4vs-zif-dumb
+    (equal (4v-sexpr-eval (4vs-zif-dumb c a b) env)
+           (4v-zif (4v-sexpr-eval c env)
+                   (4v-sexpr-eval a env)
+                   (4v-sexpr-eval b env)))
+    :hints(("Goal" :in-theory (enable 4vs-zif-dumb))))
+
+  (defthm 4v-sexpr-vars-of-4vs-zif-dumb
+    (equal (4v-sexpr-vars (4vs-zif-dumb c a b))
+           (hons-alphorder-merge (4v-sexpr-vars c)
+                                 (hons-alphorder-merge (4v-sexpr-vars a)
+                                                       (4v-sexpr-vars b))))
+    :hints(("Goal" :in-theory (enable 4vs-zif-dumb)))))
+
+
 
 
 (defsection 4vs-or
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-equivs.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-equivs.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-equivs.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-equivs.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -32,8 +32,8 @@
 
 (def-universal-equiv 4v-equiv
   ;; X === Y for in the sense of four-valued objects if they fix to the same
-  ;; four-vauled constant.  That is, besides *4f*, *4z*, and *4t*, all objects
-  ;; are equivalent to *4x* under this relationship.
+  ;; four-vauled constant.  That is, besides *4vf*, *4vz*, and *4vt*, all
+  ;; objects are equivalent to *4vx* under this relationship.
   :equiv-terms ((equal (4v-fix x))))
 
 (in-theory (enable 4v-equiv))
@@ -59,6 +59,7 @@
 (prove-4v-equiv-cong 4v-res (a b))
 (prove-4v-equiv-cong 4v-ite (c a b))
 (prove-4v-equiv-cong 4v-ite* (c a b))
+(prove-4v-equiv-cong 4v-zif (c a b))
 (prove-4v-equiv-cong 4v-tristate (c a))
 (prove-4v-equiv-cong 4v-pullup (a))
 
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-eval.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-eval.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-eval.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-eval.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -1,4 +1,4 @@
-; S-Expressions for 4-Valued Logic
+ ; S-Expressions for 4-Valued Logic
 ; Copyright (C) 2010-2012 Centaur Technology
 ;
 ; Contact:
@@ -130,6 +130,7 @@
 counterpart.</p>")
 
   (defun 4v-sexpr-apply (fn args)
+    (declare (xargs :guard (true-listp args)))
     (b* (((when (or (eq fn (4vt))
                     (eq fn (4vf))
                     (eq fn (4vx))
@@ -145,6 +146,7 @@
         (iff       (4v-iff      arg1 arg2))
         (or        (4v-or       arg1 arg2))
         (ite*      (4v-ite*     arg1 arg2 arg3))
+        (zif       (4v-zif      arg1 arg2 arg3))
         (buf       (4v-unfloat  arg1))
         (res       (4v-res      arg1 arg2))
         (tristate  (4v-tristate arg1 arg2))
@@ -154,8 +156,7 @@
         ;; (wand     (4v-wand  arg1 arg2))
         ;; (wor      (4v-wor   arg1 arg2))
         (otherwise (4vx)))))
-         
-         
+
 
 ; [Jared] I was tempted to make a 4v-sexpr-eval1 function in the style of
 ; 4v-sexpr-eval-alist1, but this seems troublesome because it would mean
@@ -190,6 +191,7 @@
           (iff       (4v-iff      arg1 arg2))
           (or        (4v-or       arg1 arg2))
           (ite*      (4v-ite*     arg1 arg2 arg3))
+          (zif       (4v-zif      arg1 arg2 arg3))
           (buf       (4v-unfloat  arg1))
           (res       (4v-res      arg1 arg2))
           (tristate  (4v-tristate arg1 arg2))
@@ -257,7 +259,7 @@
       :flag sexpr-list)
     :hints (("goal"
              :in-theory (disable* (:ruleset 4v-op-defs) 4v-<= 4v-lookup
-                                  default-car default-cdr nth-add1 nth))
+                                  default-car default-cdr nth-when-zp nth-add1 nth))
             (and stable-under-simplificationp
                  '(:use ((:instance 4v-alist-<=-necc
                                     (k x)
@@ -534,8 +536,8 @@
 <p>We construct a new sexpr by copying @('x'), except that we
 <b>unconditionally</b> replace every variable in @('x') with its binding in
 @('al'), regardless of whether such a binding actually exists.  Any unbound
-variables are just replaced by NIL, which in our @(see 4v-sexpr) format always
-evaluates to X.</p>
+variables are just replaced by NIL, which in our semantics always evaluates to
+X.</p>
 
 <p>We @(see memoize) this function, but this only helps when you are composing
 with the same alist.  We don't use @(':forget t') because you frequently want
@@ -643,7 +645,7 @@
 
 (defsection 4v-sexpr-alist-extract
   :parents (4v-sexprs)
-  :short "Extract a portion of a @(see 4v-sexpr) alist."
+  :short "Extract a portion of a <see topic='@(url 4v-sexprs)'>4v-sexpr</see> alist."
   :long "<p>@(call 4v-sexpr-alist-extract) is given:</p>
 
 <ul> <li>@('keys'), a list of names, and</li> <li>@('al'), a fast alist binding
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-fixpoint-spec.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-fixpoint-spec.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-fixpoint-spec.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-fixpoint-spec.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -79,16 +79,13 @@
               (set-equiv (remove b a) (remove b c))))
   :hints(("Goal" :use ((:instance set-equiv-breakdown-cons)))))
 
-(defthm remove-remove
-  (equal (remove k (remove k x))
-         (remove k x))
-  :hints (("goal" :induct t)))
 
 (defthm remove-when-not-member
   (implies (not (member-equal k x))
            (equal (remove k x)
                   (append x nil)))
-  :hints(("Goal" :induct t)))
+  :hints(("Goal" :induct t
+          :in-theory (enable remove))))
 
 
 
@@ -175,7 +172,8 @@
                 (and (4v-sexpr-<= v (cdr (hons-assoc-equal k al2)))
                      (4v-sexpr-alist-<= al1 al2))))
   :hints (("Goal" :do-not-induct t)
-          (witness) (witness)))
+          (witness :ruleset (4v-sexpr-alist-<=-hons-assoc-equal-example
+                             4v-sexpr-alist-<=-witnessing))))
 
 (defthm 4v-sexpr-<=-restrict
   (implies (and (4v-sexpr-alist-<= a b)
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-fixpoint.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-fixpoint.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-fixpoint.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-fixpoint.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -250,7 +250,8 @@
   (local (defthm natp-when-nat-listp-member
            (implies (and (member a x)
                          (nat-listp x))
-                    (natp a))))
+                    (natp a))
+           :hints(("Goal" :in-theory (enable nat-listp)))))
 
   (local (defthm nat-listp-when-subsetp
            (implies (and (subsetp-equal x y)
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-rewrites.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-rewrites.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-rewrites.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-rewrites.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -19,7 +19,7 @@
 ; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
-(include-book "centaur/aig/base" :dir :system) ;; BOZO for alphorder-sort
+(include-book "centaur/aig/aig-base" :dir :system) ;; BOZO for alphorder-sort
 (include-book "sexpr-advanced")
 (include-book "centaur/misc/hons-extra" :dir :system)
 (include-book "sexpr-vars-1pass")
@@ -884,6 +884,7 @@
              ((buf (buf a))         . (buf a))
              ((buf (ite a b c))     . (ite a b c))
              ((buf (ite* a b c))    . (ite* a b c))
+             ((buf (zif a b c))     . (ite* a b c))
              ((buf (and a b))       . (and a b))
              ((buf (or a b))        . (or a b))
              ((buf (not a))         . (not a))
@@ -991,6 +992,14 @@
              ((ite* a b (not b))     . (not (xor a b)))
              ((ite* a (not b) b)     . (xor a b))
 
+             ;; ZIF constant propagation
+             ((zif (t) a b)         . a)
+             ((zif (f) a b)         . b)
+             ;; ZIF remove NOT on condition
+             ((zif (not c) a b)     . (zif c b a))
+             ;; ZIF select is buffered
+             ((zif (buf c) a b)     . (zif c a b))
+
              ;; ??? Normalize IFF to NOT of XOR.
              ;; If we decide not to do this normalization, maybe move IFF up in the
              ;; order.
@@ -1921,6 +1930,7 @@
     (iff a b)
     (or a b)
     (ite* a b c)
+    (zif a b c)
     (buf a)
     (res a a)
     (ite a b c)
@@ -2223,6 +2233,12 @@
                     (equal (4v-sexpr-eval y env)
                            (4v-sexpr-eval x (4v-sexpr-eval-alist al env))))))
 
+  (local (in-theory (disable sexpr-booleanp-by-rule
+                             sexpr-booleanp-by-rules
+                             sexpr-booleanp
+                             intersection$-of-cons-left
+                             sexpr-booleanp-list)))
+
   (defthm-flag-sexpr-booleanp
     (defthm 4v-boolp-when-sexpr-booleanp-by-rule
       (implies (and (sexpr-booleanp-by-rule rule x all-rules)
@@ -2230,7 +2246,8 @@
                     (4v-sexpr-boolean-rulesp all-rules)
                     (4v-alist-boolp (4v-sexpr-vars x) alist))
                (4v-boolp (4v-sexpr-eval x alist)))
-      :hints ((and stable-under-simplificationp
+      :hints ('(:expand ((sexpr-booleanp-by-rule rule x all-rules)))
+              (and stable-under-simplificationp
                    '(:use ((:instance sexpr-unify-4v-sexpr-compose
                             (pat rule) (term x) (alist nil)))
                      :in-theory (e/d (4v-sexpr-eval-4v-sexpr-compose-strong)
@@ -2242,13 +2259,16 @@
                     (4v-sexpr-boolean-rulesp all-rules)
                     (4v-alist-boolp (4v-sexpr-vars x) alist))
                (4v-boolp (4v-sexpr-eval x alist)))
+      :hints ('(:expand ((sexpr-booleanp-by-rules rules x all-rules))))
       :flag rules)
     (defthm 4v-boolp-when-sexpr-booleanp
       (implies (and (sexpr-booleanp x all-rules)
                     (4v-sexpr-boolean-rulesp all-rules)
                     (4v-alist-boolp (4v-sexpr-vars x) alist))
                (4v-boolp (4v-sexpr-eval x alist)))
-      :hints ((and stable-under-simplificationp
+      :hints ('(:expand ((sexpr-booleanp x all-rules)
+                         (sexpr-booleanp nil all-rules)))
+              (and stable-under-simplificationp
                    '(:expand ((:free (x) (4v-alist-boolp (list x) alist))))))
       :flag sexpr)
     (defthm 4v-boolp-when-sexpr-booleanp-list
@@ -2256,6 +2276,7 @@
                     (4v-sexpr-boolean-rulesp all-rules)
                     (4v-alist-boolp (4v-sexpr-vars-list x) alist))
                (4v-bool-listp (4v-sexpr-eval-list x alist)))
+      :hints ('(:expand ((sexpr-booleanp-list x all-rules))))
       :flag list))
    
 
@@ -2281,7 +2302,10 @@
   ;; need not be known Boolean.)
   '(((xor a a)        . (f))
     ((xor a (not a))  . (t))
-    ((ite* a x x)     . (buf x))))
+    ((ite* a x x)     . (buf x))
+    ((zif  a x x)     . x)
+    ((zif  x a b)     . (ite* x a b))
+    ((buf a)          . a)))
            
 (defsection 4v-sexpr-boolean-rewritep
 
@@ -2389,8 +2413,8 @@
                    (sexpr-brules->boolp-rules brules)))
           (mv nil nil))
          (new-x (4v-sexpr-compose-nofal rhs subst)))
-      (mv (sexpr-rewrite new-x (sexpr-brules->rewrites brules))
-          t)))
+        (mv (sexpr-rewrite new-x (sexpr-brules->rewrites brules))
+            t)))
 
   (local (in-theory (enable sexpr-boolean-rw-apply-rule)))
 
@@ -2405,7 +2429,7 @@
                                           env))
                     (4v-sexpr-eval x env)))
     :hints (("goal" :use ((:instance sexpr-unify-4v-sexpr-compose
-                           (term x)))
+                                     (term x)))
              :in-theory (disable sexpr-unify-4v-sexpr-compose))))
 
   (defthm sexpr-booleanp-keys-implies-4v-key-bool-alistp-of-eval
@@ -2425,16 +2449,18 @@
 
   (defthm 4v-sexpr-eval-of-sexpr-boolean-rw-apply-rule
     (mv-let (new-x ok)
-      (sexpr-boolean-rw-apply-rule x rule brules)
-      (implies (and ok
-                    (4v-sexpr-brules-p brules)
-                    (4v-sexpr-boolean-rewritep (car rule) (cdr rule))
-                    (subsetp-equal (4v-sexpr-vars (cdr rule))
-                                   (4v-sexpr-vars (car rule)))
-                    (4v-alist-boolp (4v-sexpr-vars x) alist))
-               (equal (4v-sexpr-eval new-x alist)
-                      (4v-sexpr-eval x alist))))
-    :hints(("Goal" :in-theory (enable 4v-sexpr-brules-p)
+            (sexpr-boolean-rw-apply-rule x rule brules)
+            (implies (and ok
+                          (4v-sexpr-brules-p brules)
+                          (4v-sexpr-boolean-rewritep (car rule) (cdr rule))
+                          (subsetp-equal (4v-sexpr-vars (cdr rule))
+                                         (4v-sexpr-vars (car rule)))
+                          (4v-alist-boolp (4v-sexpr-vars x) alist))
+                     (equal (4v-sexpr-eval new-x alist)
+                            (4v-sexpr-eval x alist))))
+    :hints(("Goal" :in-theory (e/d (4v-sexpr-brules-p)
+                                   (intersection$-of-cons-left
+                                    intersection$-when-atom-left))
             :use ((:instance
                    sexpr-booleanp-keys-implies-4v-key-bool-alistp-of-eval
                    (keys (sexpr-bool-special-vars))
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-to-faig.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-to-faig.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-to-faig.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-to-faig.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -21,7 +21,9 @@
 (in-package "ACL2")
 (include-book "sexpr-eval")
 (include-book "sexpr-3v")
-(include-book "centaur/aig/three-four" :dir :system)
+(include-book "centaur/aig/faig-base" :dir :system)
+(include-book "centaur/aig/faig-constructors" :dir :system)
+(include-book "centaur/aig/faig-equivs" :dir :system)
 (include-book "centaur/aig/aig-equivs" :dir :system)
 (include-book "centaur/misc/tuplep" :dir :system)
 (local (include-book "centaur/aig/eval-restrict" :dir :system))
@@ -94,22 +96,22 @@
 
 (defthm faig-eval-of-constants
   ;; BOZO find me a home
-  (and (equal (faig-eval *4t* env) *4t*)
-       (equal (faig-eval *4f* env) *4f*)
-       (equal (faig-eval *4z* env) *4z*)
-       (equal (faig-eval *4x* env) *4x*)
-       (equal (faig-eval nil env)  *4x*))
+  (and (equal (faig-eval (faig-t) env) (faig-t))
+       (equal (faig-eval (faig-f) env) (faig-f))
+       (equal (faig-eval (faig-z) env) (faig-z))
+       (equal (faig-eval (faig-x) env) (faig-x))
+       (equal (faig-eval nil env)  (faig-x)))
   :hints(("Goal" :in-theory (enable faig-eval))))
 
 (local (defthm faig-equiv-nil-x
          ;; BOZO find me a home?
-         (equal (faig-equiv nil *4x*) t)
+         (equal (faig-equiv nil (faig-x)) t)
          :hints (("goal" :in-theory (enable faig-equiv)))))
 
 (local (defthm faig-eval-when-atom
          (implies (atom x)
                   (equal (faig-eval x env)
-                         *4x*))
+                         (faig-x)))
          :hints(("Goal" :in-theory (enable faig-eval)))))
 
 
@@ -141,7 +143,7 @@
     (declare (xargs :guard t))
     (if (faig-const-p x)
         x
-      *4x*))
+      (faig-x)))
 
   (defthm faig-const-fix-of-faig-eval
     (equal (faig-const-fix (faig-eval x env))
@@ -160,7 +162,7 @@
     (let ((x (faig-const-fix x))
           (y (faig-const-fix y)))
       (or (equal x y)
-          (equal x *4x*)))))
+          (equal x (faig-x))))))
 
 
 
@@ -172,9 +174,9 @@
 
   (defun faig-const->4v (x)
     (declare (xargs :guard t))
-    (cond ((equal x *4t*) (4vt))
-          ((equal x *4f*) (4vf))
-          ((equal x *4z*) (4vz))
+    (cond ((equal x (faig-t)) (4vt))
+          ((equal x (faig-f)) (4vf))
+          ((equal x (faig-z)) (4vz))
           (t              (4vx)))))
 
 (defsection faig-const-list->4v-list
@@ -220,10 +222,10 @@
   (defun 4v->faig-const (x)
     "4V constant --> FAIG constant"
     (declare (xargs :guard t))
-    (cond ((eq x (4vt)) *4t*)
-          ((eq x (4vf)) *4f*)
-          ((eq x (4vz)) *4z*)
-          (t            *4x*)))
+    (cond ((eq x (4vt)) (faig-t))
+          ((eq x (4vf)) (faig-f))
+          ((eq x (4vz)) (faig-z))
+          (t            (faig-x))))
 
   (local (in-theory (enable 4v-fix)))
 
@@ -306,7 +308,7 @@
               (,fvfn . ,(apply-to-args '4v->faig-const args)))))
 
   (fv-4v-commute 4v-fix      faig-const-fix (a))
-  (fv-4v-commute 4v-unfloat  t-aig-fix      (a))
+  (fv-4v-commute 4v-unfloat  f-aig-unfloat      (a))
   (fv-4v-commute 4v-not      f-aig-not      (a))
   (fv-4v-commute 4v-and      f-aig-and      (a b))
   (fv-4v-commute 4v-or       f-aig-or       (a b))
@@ -314,7 +316,8 @@
   (fv-4v-commute 4v-iff      f-aig-iff      (a b))
   (fv-4v-commute 4v-ite      f-aig-ite      (a b c))
   (fv-4v-commute 4v-ite*     f-aig-ite*     (a b c))
-  (fv-4v-commute 4v-tristate t-aig-buf      (c a))
+  (fv-4v-commute 4v-zif      f-aig-zif      (a b c))
+  (fv-4v-commute 4v-tristate t-aig-tristate      (c a))
   (fv-4v-commute 4v-pullup   f-aig-pullup   (a))
   (fv-4v-commute 4v-res      f-aig-res      (a b)))
 
@@ -337,13 +340,13 @@
                (let ((look (hons-get x onoff)))
                  (if (consp (cdr look))
                      (cdr look)
-                   *4x*))
-             *4x*))
+                   (faig-x)))
+             (faig-x)))
           (fn (car x))
-          ((when (eq fn (4vt))) *4t*)
-          ((when (eq fn (4vf))) *4f*)
-          ((when (eq fn (4vz))) *4z*)
-          ((when (eq fn (4vx))) *4x*)
+          ((when (eq fn (4vt))) (faig-t))
+          ((when (eq fn (4vf))) (faig-f))
+          ((when (eq fn (4vz))) (faig-z))
+          ((when (eq fn (4vx))) (faig-x))
           (args (4v-sexpr-to-faig-plain-list (cdr x) onoff))
           (arg1 (4v-first  args))
           (arg2 (4v-second args))
@@ -355,13 +358,14 @@
          (iff       (f-aig-iff    arg1 arg2))
          (or        (f-aig-or     arg1 arg2))
          (ite*      (f-aig-ite*   arg1 arg2 arg3))
-         (buf       (t-aig-fix    arg1))
+         (zif       (f-aig-zif    arg1 arg2 arg3))
+         (buf       (f-aig-unfloat    arg1))
          (res       (f-aig-res    arg1 arg2))
-         (tristate  (t-aig-buf    arg1 arg2))
+         (tristate  (t-aig-tristate    arg1 arg2))
          (ite       (f-aig-ite    arg1 arg2 arg3))
          (pullup    (f-aig-pullup arg1))
          (id        (faig-fix     arg1))
-         (otherwise *4x*))))
+         (otherwise (faig-x)))))
 
    (defun 4v-sexpr-to-faig-plain-list (x onoff)
      (declare (xargs :guard t))
@@ -416,6 +420,7 @@
             (e/d* ()
                   (4v->faig-const
                    nth
+                   nth-when-zp
                    faig-const-fix
                    faig-const-alist->4v-alist
                    faig-const->4v
@@ -432,32 +437,36 @@
    (local (in-theory (enable* (:ruleset f-aig-defs)
                               (:ruleset t-aig-defs))))
 
-   (defthm t-aig-not-of-t-aig-fix
-     (equal (t-aig-not (t-aig-fix x))
+   (defthm t-aig-not-of-f-aig-unfloat
+     (equal (t-aig-not (f-aig-unfloat x))
             (f-aig-not x)))
 
-   (defthm t-aig-and-t-aig-fix
-     (equal (t-aig-and (t-aig-fix x) (t-aig-fix y))
+   (defthm t-aig-and-f-aig-unfloat
+     (equal (t-aig-and (f-aig-unfloat x) (f-aig-unfloat y))
             (f-aig-and x y)))
 
-   (defthm t-aig-or-t-aig-fix
-     (equal (t-aig-or (t-aig-fix x) (t-aig-fix y))
+   (defthm t-aig-or-f-aig-unfloat
+     (equal (t-aig-or (f-aig-unfloat x) (f-aig-unfloat y))
             (f-aig-or x y)))
 
-   (defthm t-aig-xor-t-aig-fix
-     (equal (t-aig-xor (t-aig-fix x) (t-aig-fix y))
+   (defthm t-aig-xor-f-aig-unfloat
+     (equal (t-aig-xor (f-aig-unfloat x) (f-aig-unfloat y))
             (f-aig-xor x y)))
 
-   (defthm t-aig-iff-t-aig-fix
-     (equal (t-aig-iff (t-aig-fix x) (t-aig-fix y))
+   (defthm t-aig-iff-f-aig-unfloat
+     (equal (t-aig-iff (f-aig-unfloat x) (f-aig-unfloat y))
             (f-aig-iff x y)))
 
-   (defthm t-aig-ite-t-aig-fix
-     (equal (t-aig-ite (t-aig-fix c) (t-aig-fix x) (t-aig-fix y))
+   (defthm t-aig-ite-f-aig-unfloat
+     (equal (t-aig-ite (f-aig-unfloat c) (f-aig-unfloat x) (f-aig-unfloat y))
             (f-aig-ite c x y)))
 
-   (defthm t-aig-ite*-t-aig-fix
-     (equal (t-aig-ite* (t-aig-fix c) (t-aig-fix x) (t-aig-fix y))
+   (defthm t-aig-ite*-unfloat-is-f-aig-zif-unfloat
+     (equal (t-aig-ite* (f-aig-unfloat c) x y)
+            (f-aig-zif c x y)))
+
+   (defthm t-aig-ite*-f-aig-unfloat
+     (equal (f-aig-zif c (f-aig-unfloat x) (f-aig-unfloat y))
             (f-aig-ite* c x y)))))
 
 
@@ -469,48 +478,48 @@
 
 
 
-(defsection maybe-t-aig-fix
+(defsection maybe-f-aig-unfloat
 
-  (defund maybe-t-aig-fix (sexpr faig)
+  (defund maybe-f-aig-unfloat (sexpr faig)
     (declare (xargs :guard t))
     (if (3v-syntax-sexprp sexpr)
         faig
-      (t-aig-fix faig)))
+      (f-aig-unfloat faig)))
 
-  (local (in-theory (enable maybe-t-aig-fix)))
+  (local (in-theory (enable maybe-f-aig-unfloat)))
 
-  (defthm faig-eval-maybe-t-aig-fix
+  (defthm faig-eval-maybe-f-aig-unfloat
     (implies (equal (faig-eval x fenv)
                     (4v->faig-const (4v-sexpr-eval sexpr senv)))
-             (equal (faig-eval (maybe-t-aig-fix sexpr x) fenv)
-                    (faig-eval (t-aig-fix x) fenv)))))
+             (equal (faig-eval (maybe-f-aig-unfloat sexpr x) fenv)
+                    (faig-eval (f-aig-unfloat x) fenv)))))
 
 
 
-(defsection maybe-t-aig-fix-list
+(defsection maybe-f-aig-unfloat-list
 
-  (defun maybe-t-aig-fix-list (sexprs faigs)
+  (defun maybe-f-aig-unfloat-list (sexprs faigs)
     (declare (xargs :guard (equal (len sexprs) (len faigs))))
     (if (atom sexprs)
         nil
-      (cons (maybe-t-aig-fix (car sexprs) (car faigs))
-            (maybe-t-aig-fix-list (cdr sexprs) (cdr faigs)))))
+      (cons (maybe-f-aig-unfloat (car sexprs) (car faigs))
+            (maybe-f-aig-unfloat-list (cdr sexprs) (cdr faigs)))))
 
-  (defthm nth-maybe-t-aig-fix-list
+  (defthm nth-maybe-f-aig-unfloat-list
     (implies (equal (len x) (len sexprs))
-             (equal (faig-fix (nth n (maybe-t-aig-fix-list sexprs x)))
-                    (faig-fix (maybe-t-aig-fix (nth n sexprs) (nth n x)))))
+             (equal (faig-fix (nth n (maybe-f-aig-unfloat-list sexprs x)))
+                    (faig-fix (maybe-f-aig-unfloat (nth n sexprs) (nth n x)))))
     :hints(("Goal"
             :induct (nth-both-ind n sexprs x)
-            :expand ((maybe-t-aig-fix-list sexprs x)))))
+            :expand ((maybe-f-aig-unfloat-list sexprs x)))))
 
-  (defthm nth-maybe-t-aig-fix-list-faig-equiv
+  (defthm nth-maybe-f-aig-unfloat-list-faig-equiv
     (implies (equal (len x) (len sexprs))
-             (faig-equiv (nth n (maybe-t-aig-fix-list sexprs x))
-                         (maybe-t-aig-fix (nth n sexprs) (nth n x))))
+             (faig-equiv (nth n (maybe-f-aig-unfloat-list sexprs x))
+                         (maybe-f-aig-unfloat (nth n sexprs) (nth n x))))
     :hints(("Goal"
             :induct (nth-both-ind n sexprs x)
-            :expand ((maybe-t-aig-fix-list sexprs x))))))
+            :expand ((maybe-f-aig-unfloat-list sexprs x))))))
 
 
 
@@ -528,23 +537,30 @@
                (let ((look (hons-get x onoff)))
                  (if (consp (cdr look))
                      (cdr look)
-                   *4x*))
-             *4x*))
+                   (faig-x)))
+             (faig-x)))
           (fn (car x))
-          ((when (eq fn (4vt))) *4t*)
-          ((when (eq fn (4vf))) *4f*)
-          ((when (eq fn (4vz))) *4z*)
-          ((when (eq fn (4vx))) *4x*)
+          ((when (eq fn (4vt))) (faig-t))
+          ((when (eq fn (4vf))) (faig-f))
+          ((when (eq fn (4vz))) (faig-z))
+          ((when (eq fn (4vx))) (faig-x))
           (sargs (cdr x))
           (args (4v-sexpr-to-faig-opt-list sargs onoff))
           ;; There are a few functions where we don't really get any benefit from
           ;; knowing the args are three-valued:
           ((when (eq fn 'id))       (faig-fix (4v-first args))) ;; bozo why??
           ((when (eq fn 'res))      (f-aig-res (4v-first args) (4v-second args)))
-          ((when (eq fn 'tristate)) (t-aig-buf (4v-first args) (4v-second args)))
+          ((when (eq fn 'tristate)) (t-aig-tristate (4v-first args) (4v-second args)))
           ((when (eq fn 'pullup))   (f-aig-pullup (4v-first args)))
+          ((when (eq fn 'zif))
+           (t-aig-ite* (maybe-f-aig-unfloat
+                        (mbe :logic (first sargs)
+                             :exec (and (consp sargs) (car sargs)))
+                        (4v-first args))
+                       (4v-second args)
+                       (4v-third args)))
           ;; Otherwise, fixup only those subexpressions that might produce Zs
-          (args (maybe-t-aig-fix-list (cdr x) args))
+          (args (maybe-f-aig-unfloat-list sargs args))
           (arg1 (4v-first args))
           (arg2 (4v-second args))
           (arg3 (4v-third args)))
@@ -557,7 +573,7 @@
          (or        (t-aig-or   arg1 arg2))
          (buf       (faig-fix   arg1))
          (ite       (t-aig-ite  arg1 arg2 arg3))
-         (otherwise *4x*))))
+         (otherwise (faig-x)))))
    (defun 4v-sexpr-to-faig-opt-list (x onoff)
      (declare (xargs :guard t))
      (if (atom x)
@@ -605,36 +621,36 @@
 
 
 
-  (local (defthm faig-eval-maybe-t-aig-fix-rw
+  (local (defthm faig-eval-maybe-f-aig-unfloat-rw
            (let ((4v-env (faig-const-alist->4v-alist (faig-eval-alist al fenv))))
              (implies (and (bind-free '((al . al)) (al))
                            (equal (faig-eval x fenv)
                                   (4v->faig-const (4v-sexpr-eval sexpr 4v-env))))
-                      (equal (faig-eval (maybe-t-aig-fix sexpr x) fenv)
-                             (faig-eval (t-aig-fix x) fenv))))
-           :hints(("Goal" :in-theory (enable maybe-t-aig-fix)))))
+                      (equal (faig-eval (maybe-f-aig-unfloat sexpr x) fenv)
+                             (faig-eval (f-aig-unfloat x) fenv))))
+           :hints(("Goal" :in-theory (enable maybe-f-aig-unfloat)))))
 
-  (local (defthm faig-eval-maybe-t-aig-fix-rw1
+  (local (defthm faig-eval-maybe-f-aig-unfloat-rw1
            (let ((4v-env (faig-const-alist->4v-alist (faig-eval-alist al fenv))))
              (implies
               (and (bind-free '((al . al)) (al))
                    (equal (faig-eval-list x fenv)
                           (4v-list->faig-const-list (4v-sexpr-eval-list sexprs 4v-env))))
-              (equal (faig-eval (maybe-t-aig-fix (nth n sexprs) (nth n x)) fenv)
-                     (faig-eval (t-aig-fix (nth n x)) fenv))))
+              (equal (faig-eval (maybe-f-aig-unfloat (nth n sexprs) (nth n x)) fenv)
+                     (faig-eval (f-aig-unfloat (nth n x)) fenv))))
            :hints(("Goal"
-                   :in-theory (disable* maybe-t-aig-fix)
+                   :in-theory (disable* maybe-f-aig-unfloat)
                    :expand ((faig-eval-list x fenv)
                             (:free (a) (4v-sexpr-eval-list sexprs a))
                             (:free (a b) (4v-list->faig-const-list (cons a b))))
                    :induct (nth-both-ind n sexprs x)))))
 
-  (local (defthm faig-eval-nth-maybe-t-aig-fix-list
+  (local (defthm faig-eval-nth-maybe-f-aig-unfloat-list
            (implies (and (equal (faig-eval (nth n x) fenv)
                                 (4v->faig-const (4v-sexpr-eval (nth n sexprs) senv)))
                          (equal (len x) (len sexprs)))
-                    (equal (faig-eval (nth n (maybe-t-aig-fix-list sexprs x)) fenv)
-                           (faig-eval (t-aig-fix (nth n x)) fenv)))
+                    (equal (faig-eval (nth n (maybe-f-aig-unfloat-list sexprs x)) fenv)
+                           (faig-eval (f-aig-unfloat (nth n x)) fenv)))
            :hints(("Goal" :in-theory (disable* 4v->faig-const)))))
 
   (defthm-4v-sexpr-flag
@@ -654,7 +670,7 @@
                                   faig-const-fix
                                   faig-const-alist->4v-alist
                                   faig-const->4v
-                                  maybe-t-aig-fix
+                                  maybe-f-aig-unfloat
                                   )))
            (and stable-under-simplificationp
                 '(:expand ((4v-sexpr-to-faig-opt-list (cdr x) al)))))))
diff -Nru acl2-6.2/books/centaur/4v-sexpr/sexpr-vars-1pass.lisp acl2-6.3/books/centaur/4v-sexpr/sexpr-vars-1pass.lisp
--- acl2-6.2/books/centaur/4v-sexpr/sexpr-vars-1pass.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/sexpr-vars-1pass.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -25,6 +25,7 @@
 
 (in-package "ACL2")
 (include-book "sexpr-vars")
+(local (include-book "std/lists/sets" :dir :system))
 
 (defsection 4v-sexpr-vars-1pass
   :parents (4v-sexpr-vars)
@@ -102,33 +103,31 @@
                         :flag-mapping ((4v-sexpr-vars-1pass-exec . sexpr)
                                        (4v-sexpr-vars-1pass-list-exec . list))))
 
-(local (defthm hons-assoc-equal-under-iff
-         (iff (hons-assoc-equal k al)
-              (member k (alist-keys al)))))
-
-(local (in-theory (disable alist-keys-member-hons-assoc-equal)))
-
-(local (defthm member-by-subset
-           (and (implies (and (subsetp-equal x y)
-                              (member-equal a x))
-                         (member-equal a y))
-                (implies (and (member-equal a x)
-                              (subsetp-equal x y))
-                         (member-equal a y)))))
-
-(local (defthm subset-transitive
-           (and (implies (and (subsetp-equal x y)
-                              (subsetp-equal y z))
-                         (subsetp-equal x z))
-                (implies (and (subsetp-equal y z)
-                              (subsetp-equal x y))
-                         (subsetp-equal x z)))))
+(local (in-theory (e/d (hons-assoc-equal-iff-member-alist-keys)
+                       (alist-keys-member-hons-assoc-equal))))
+
+;; (local (defthm member-by-subset
+;;            (and (implies (and (subsetp-equal x y)
+;;                               (member-equal a x))
+;;                          (member-equal a y))
+;;                 (implies (and (member-equal a x)
+;;                               (subsetp-equal x y))
+;;                          (member-equal a y)))))
+
+;; (local (defthm subset-transitive
+;;            (and (implies (and (subsetp-equal x y)
+;;                               (subsetp-equal y z))
+;;                          (subsetp-equal x z))
+;;                 (implies (and (subsetp-equal y z)
+;;                               (subsetp-equal x y))
+;;                          (subsetp-equal x z)))))
 
 (local (defthm helper-1
            ;; this works out because if x is an atom, then its sexpr-vars are just itself
            (implies (and (member-equal x (alist-keys seen))
                          (not (consp x))
-                         x)
+                         x
+                         )
                     (member-equal x (4v-sexpr-vars-list (alist-keys seen))))
            :hints(("goal" :induct (len seen)))))
 
@@ -143,6 +142,12 @@
                                    (4v-sexpr-vars-list (alist-keys seen))))
            :hints(("goal" :induct (len seen)))))
 
+(local (defthm helper-4
+         (implies (member-equal a x)
+                  (subsetp-equal (4v-sexpr-vars a)
+                                 (4v-sexpr-vars-list x)))
+         :hints(("Goal" :in-theory (enable member-equal)))))
+
 (local (defthm-flag-4v-sexpr-vars-1pass-exec
          (defthm seen-has-correct-vars-sexpr
            (b* (((mv new-seen &) (4v-sexpr-vars-1pass-exec x seen vars)))
diff -Nru acl2-6.2/books/centaur/4v-sexpr/svarmap.lisp acl2-6.3/books/centaur/4v-sexpr/svarmap.lisp
--- acl2-6.2/books/centaur/4v-sexpr/svarmap.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/svarmap.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -26,7 +26,8 @@
 ; [Jared] After consideration, we think this is the right book to use; the FAIG
 ; monotonicity stuff was just too hard and should eventually be scrapped.
 
-(include-book "centaur/aig/base" :dir :system)
+(include-book "centaur/aig/aig-base" :dir :system)
+(include-book "centaur/aig/faig-base" :dir :system)
 (include-book "centaur/misc/fast-alists" :dir :system)
 (include-book "centaur/misc/hons-sets" :dir :system)
 (local (include-book "data-structures/no-duplicates" :dir :system))
diff -Nru acl2-6.2/books/centaur/4v-sexpr/top.lisp acl2-6.3/books/centaur/4v-sexpr/top.lisp
--- acl2-6.2/books/centaur/4v-sexpr/top.lisp	2013-06-06 17:11:44.000000000 +0000
+++ acl2-6.3/books/centaur/4v-sexpr/top.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -47,7 +47,9 @@
 
 
 (defxdoc 4v
-  :short "Centaur four-valued logic library."
+  :parents (boolean-reasoning)
+  :short "An @(see hons)-based, s-expression representation of <see
+topic='@(url 4v-monotonicity)'>monotonic</see>, four-valued functions."
 
   :long "<p>This library defines the logic of the @(see esim) symbolic
 simulator.  By \"four-valued\", we mean that each wire can take one of the four
@@ -176,8 +178,8 @@
 operations are <see topic='@(url 4v-monotonicity)'>monotonic</see>,
 monotonicity is an intrinsic property of every sexpr.</p>
 
-<p>As with our @(see aig) and @(see ubdd) representations, we generally expect
-to create all sexprs with @(see hons), and we often @(see memoize) operations
-that deal with sexprs.  We provide some @(see 4vs-constructors) for building
-s-expressions.</p>")
+<p>As with our @(see aig) and <see topic='@(url ubdds)'>ubdd</see>
+representations, we generally expect to create all sexprs with @(see hons), and
+we often @(see memoize) operations that deal with sexprs.  We provide some
+@(see 4vs-constructors) for building s-expressions.</p>")
 
diff -Nru acl2-6.2/books/centaur/README.html acl2-6.3/books/centaur/README.html
--- acl2-6.2/books/centaur/README.html	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/README.html	2013-09-30 17:53:15.000000000 +0000
@@ -73,7 +73,7 @@
 processors</a> for our parent company, <a href="http://www.via.com.tw/">VIA
 Technologies</a>.  We have used these books to prove correctness properties of
 several execution units, and to develop other tools such as an equivalence
-checker, a linter, etc.
+checker, a linter, etc.</p>
 
 
 <h3>Prerequisites</h3>
@@ -86,23 +86,26 @@
 
 <dt>Recommended Hardware</dt>
 
-<dd>You probably want at least a <b>dual-core</b> machine with <b>8 GB</b> of
-memory.</dd>
-
-<dd>You might even want more memory than this.  Having ample memory is
-especially important when you want to carry out proofs using BDDs.  Many of our
-real hardware proofs are made faster (or possible) by having 32 or more GB of
-memory.  Even things like our Verilog parser are written in a memory-hungry way
-because that's just the kind of environment we work in.</dd>
-
-<dd>Having additional cores is very useful for certifying books in parallel.</dd>
+<dd>You will at least want a fast <b>dual-core</b> machine with <b>8 GB</b> of
+memory.  Having additional cores is very useful for quickly re-certifying books
+in parallel, but careful here: with more cores you'll need even more memory to
+avoid swapping death.  A good target might be at least
+<b>4 GB per core</b>.</dd>
+
+<dd>We used to recommend even more memory than this.  Ample memory was
+especially important when we carried out large proofs using BDDs, but these
+days we often use SAT instead, and SAT is far less memory intensive.  Even so,
+today many of our real hardware proofs are made faster (or possible) by having
+32 or more GB of memory.  Also, many of our tools, e.g., our Verilog parser,
+are written in a memory-hungry way because that's just the kind of environment
+we work in.</dd>
 
 
 <dt>Recommended Operating System</dt>
 
-<dd>We use <b>64-bit Linux</b>.  It might be possible to use Darwin or BSD or
-other unixes instead, but Linux is the main platform.  You will need the
-typical tools like perl, make, etc.</dd>
+<dd>We use <b>64-bit Linux</b>.  Other unix derivatives like Darwin, FreeBSD,
+etc., might work reasonably well, but Linux is our main platform.  Windows
+probably won't work.  You will need ordinary tools like perl, make, etc.</dd>
 
 
 <dt>Clozure Common Lisp Configuration</dt>
@@ -112,9 +115,10 @@
 
 <dd>We usually use a fairly recent SVN snapshot.</dd>
 
-<dd>We use <a href="ccl-config.lsp">ccl-config.lsp</a> to do some extra
-configuration that increases the stack sizes and tunes the garbage
-collector for better performance.</dd>
+<dd><b style="color: #ff0000;">CCL Configuration before building ACL2:</b> We
+use <a href="ccl-config.lsp">ccl-config.lsp</a> to do some extra configuration
+that increases the stack sizes and tunes the garbage collector for better
+performance.</dd>
 
 <dd>We configure our <tt>PATH</tt> so that we can launch CCL by
 typing <tt>ccl</tt>.</dd>
@@ -124,26 +128,30 @@
 
 <dd>You will need to
 build <a href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2</a> with Hons
-enabled.  The recommended way to build is with:</dd>
+enabled.  The recommended way to build is,  with:</dd>
 
-<dd><pre>make LISP=ccl ACL2_HONS=h ACL2_SIZE=3000000</pre></dd>
+<dd><pre>
+$ # rebuild ccl using ccl-config.lsp
+$ cd [...]/acl2/
+$ make LISP=ccl ACL2_HONS=h ACL2_SIZE=3000000
+</pre></dd>
 
-<dd>Using a large <tt>ACL2_SIZE</tT> can help avoid performance problems due to
+<dd>Using a large <tt>ACL2_SIZE</tt> can help avoid performance problems due to
 filling up the ACL2 package with too many symbols.</dd>
 
-<dd>We generally configure our <tt>PATH</tt> so that we can launch ACL2(h) by
+<dd>We configure our <tt>PATH</tt> so that we can launch ACL2(h) by
 typing <tt>acl2</tt>.</dd>
 
 
 <dt>cert.pl Configuration</dt>
 
-<dd>We use <tt>cert.pl</tt> instead of Makefiles.  This script is located in
-the <tt>acl2/books</tt> directory.  We recommend that you configure
+<dd>We generally use <tt>cert.pl</tt> to certify books.  This script is located
+in the <tt>acl2/books</tt> directory.  We recommend that you configure
 your <tt>PATH</tt> so you can invoke it by just typing <tt>cert.pl</tt>.</dd>
 
+<dt>(Optional) GTKWave Configuration</dt>
 
-
-<dt>GTKWave Configuration (Optional)</dt>
+<dd>You can skip this if you aren't doing hardware verification.</dd>
 
 <dd>We often use <a href="http://gtkwave.sourceforge.net/">GTKWave</a> for
 debugging waveforms.  Other VCD file viewers may also work.</dd>
@@ -151,47 +159,66 @@
 <dd>We configure our <tt>PATH</tt> so that we can run GTKWave by
 typing <tt>gtkwave</tt>.</dd>
 
-</dl>
 
+<dt>(Optional) Glucose Configuration</dt>
 
-<h3>Building the Centaur Books</h3>
+<dd>We often use the <a href="http://www.lri.fr/~simon/?page=glucose">Glucose</a>
+Sat Solver.</dd>
 
-<p>Once you have all the above prerequisites, you will be ready to certify the
-Centaur books.  There are two steps:</p>
+<dd>We configure out <tt>PATH</tt> so that we can run Glucose (sometimes called
+<tt>glucose.sh</tt>) by typing <tt>glucose</tt>.</dd>
 
-<p>1. Build the Quicklisp book.  This is special because it has to go download
-Quicklisp and run its setup.</p>
 
-<pre>
-cd [...]/acl2/books/centaur/quicklisp
-make
-</pre>
+<dt>(Optional) Lingeling Configuration</dt>
+
+<dd>We sometimes use the <a href="http://fmv.jku.at/lingeling/">Lingeling</a>
+Sat Solver.</dd>
 
-<p>2. Build the rest of the books and all available documentation:</p>
+<dd>We configure our path so that we can run the Lingeling executable by
+typing <tt>lingeling</tt>.</dd>
+
+</dl>
+
+
+<h3>Building the Books</h3>
+
+<p>Once you have the above prerequisites, you will be ready to certify the ACL2
+books.  The preferred command to do this is:</p>
 
 <pre>
-cd [...]/acl2/books/centaur
-cert.pl doc.lisp -j 4           # -j 4 for a quad-core processor
+$ # get ccl, reconfigure it, build acl2, set up your path as explained above.
+$ cd [...]/acl2/books/
+$ make USE_QUICKLISP=1 -j 4    # -j 4 for a quad-core processor
 </pre>
 
-<p>Depending on your hardware this may take ten minutes up to hours.</p>
+<p>The USE_QUICKLISP=1 instructs <tt>make</tt> to download and install
+<a href="http://www.quicklisp.org">Quicklisp</a>, which is sort of a Common
+Lisp equivalent to CPAN for Perl, RubyGems for Ruby, etc.  This is necessary
+for certain books.</p>
+
+<p>Depending on your hardware this may take ten minutes up to hours.  For
+reference, it takes about an hour on an 8-core AMD-FX8350 with 32 GB of memory
+running FreeBSD, using -j 8.</p>
 
 
 <h3>Next Steps</h3>
 
-<p>The <tt>cert.pl</tt> command above should produce a <b>reference manual</b>
-with documentation for the Centaur books.  The manual also has all of the
-regular documentation for ACL2 and also for several other libraries that we
-use, e.g., str, osets, ihs, etc.</p>
+<p>After building the books with the <tt>make</tt> command above, you should
+obtain an <b>XDOC Manual</b> with documentation for the Centaur books, and also
+has the regular documentation for ACL2 and other Community Books like str,
+osets, ihs, etc.</p>
 
 <p>To view the manual, point your web browser
-at <a href="manual/preview.html">books/centaur/manual/preview.html</a>.  (Note:
-this will be a broken link until you generate the manual.)  You can also build
-an HTML version of the manual that may render faster, see the documentation for
-XDOC for more information.</p>
-
-<p>There is also a very preliminary <b>tutorial</b> that walks through the
-verification of a trivial ALU module.  To get started, see:</p>
+at <a href="manual/index.html">manual/index.html</a>&mdash;this link will be
+broken until you generate the manual.  (We also keep
+a <a href="http://fv.centtech.com/acl2/latest/doc/">public copy</a> of the
+manual on our web site, but we only update it at each ACL2 release, so it's
+generally best to use a local copy that matches your specific version of the
+books.)</p>
+
+<p>If you are specifically interested in hardware verification, there is also a
+preliminary <b>tutorial</b> that walks through the verification of a trivial
+ALU module.  To get started, see:</p>
 
 <pre>
 books/centaur/tutorial/intro.lisp
@@ -209,7 +236,7 @@
 
 <h3>License Information</h3>
 
-<p>Copyright &copy; 2008-2012 Centaur Technology and others
+<p>Copyright &copy; 2008-2013 Centaur Technology and others
 (see <b style="color: #009000">**</b>)</p>
 
 <dl>
@@ -236,10 +263,10 @@
 under the GPL "2 or later."  Most are copyright by Centaur Technology, but some
 are copyrights of others, e.g., the books in ubdds/ are copyright by Bob Boyer
 and Warren Hunt; see the individual headers on each file for more information.
-Also note that many books here depend on other ACL2 libraries, each of which
-are copyright by their respective owners.  To the best of our knowledge, we
-believe all libraries we include are also licensed under the GPL "2 or later"
-or compatible licenses.</p>
+Many of these books also depend on other ACL2 libraries that are copyright by
+their respective owners.  To the best of our knowledge, we believe all
+libraries we include are also licensed under the GPL "2 or later" or compatible
+licenses.</p>
 
 
 </div>
diff -Nru acl2-6.2/books/centaur/acl2-customization.lsp acl2-6.3/books/centaur/acl2-customization.lsp
--- acl2-6.2/books/centaur/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/acl2-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,29 @@
+; Centaur Books ACL2 Customization File
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+#!ACL2
+(in-package "ACL2")
+
+(assign :suppress-preload-xdoc t)
+(ld "~/acl2-customization.lsp" :ld-missing-input-ok t)
+
+
+
+
diff -Nru acl2-6.2/books/centaur/aig/acl2-customization.lsp acl2-6.3/books/centaur/aig/acl2-customization.lsp
--- acl2-6.2/books/centaur/aig/acl2-customization.lsp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/acl2-customization.lsp	2013-09-30 17:53:11.000000000 +0000
@@ -18,4 +18,5 @@
 ;
 ; Original author: Sol Swords <sswords@centtech.com>
 
-(set-inhibit-warnings "theory" "disable")
\ No newline at end of file
+(set-inhibit-warnings "theory" "disable")
+(ld "~/acl2-customization.lsp" :ld-missing-input-ok t)
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/aig/aig-base.lisp acl2-6.3/books/centaur/aig/aig-base.lisp
--- acl2-6.2/books/centaur/aig/aig-base.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aig-base.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,804 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+;
+; July 2011, Jared added lots of documentation.
+
+(in-package "ACL2")
+(include-book "cutil/define" :dir :system)
+(include-book "../misc/hons-alphorder-merge")
+
+; aig-base.lisp
+;   - Semantics of AIGs (aig-eval)
+;   - Primitive AIG constructors (aig-not, aig-and, ...)
+;   - Substitution operations: aig-restrict, aig-compose, aig-partial-eval
+
+; BOZO consider using defprojection throughout?
+
+(defsection aig-cases
+  :parents (aig-other)
+  :short "Control-flow macro to split into cases on what kind of AIG you have
+encountered."
+  :long "@(def aig-cases)"
+
+  (defmacro aig-cases (x &key true false var inv and)
+    `(let ((aig-cases-var ,x))
+       (cond
+        ((atom aig-cases-var)
+         (cond ((eq aig-cases-var t) ,true)
+               ((eq aig-cases-var nil) ,false)
+               (t ,var)))
+        ((eq (cdr aig-cases-var) nil) ,inv)
+        (t ,and)))))
+
+
+; -----------------------------------------------------------------------------
+;
+;                            EVALUATING AIGS
+;
+; -----------------------------------------------------------------------------
+
+(defsection aig-env-lookup-missing-output
+  :parents (aig-eval)
+  :short "Stub for warnings about missing variables in AIG evaluation."
+
+  :long "<p>This stub is called when @(see aig-eval) encounters a variable in
+the AIG that has no binding in the environment.  It is generally configured
+with @(see aig-env-lookup-missing-action).</p>"
+
+  (defstub aig-env-lookup-missing-output (name) nil))
+
+
+(defsection aig-env-lookup-missing-action
+  :parents (aig-eval)
+  :short "Configurable warnings about missing variables in AIG evaluation."
+
+  :long "<p>Ordinarily @(see aig-eval) treats any variables that are not bound
+in the environment as having value @('t').  But a missing bindings could be the
+result of a bug in your program, so by default @('aig-eval') is set up to print
+a warning if this happens.</p>
+
+<p>@(call aig-env-lookup-missing-action) allows you to control whether these
+warnings are printed, and also whether @(see break$) should be called.  The
+valid @('action')s are:</p>
+
+<ul>
+ <li>@('nil'), silently bind the variable to @('t'),</li>
+ <li>@(':warn') (the default), print a warning but do not @('break$'), and</li>
+ <li>@(':break'), to print the warning and then call @('break$').</li>
+</ul>"
+
+  (defconst *aig-env-lookup-warn-missing-binding*
+    ;; Even with the stub and defattach, it is useful to have this "constant"
+    ;; so that, in raw lisp, we can use a let-binding to disable missing output
+    ;; warnings temporarily, e.g., so that if a SAT solver produces an
+    ;; incomplete counterexample, we don't print warnings when we check it.
+    ;; Doing this with defattach directly would be hard/impossible due to
+    ;; attachment being an event.
+    t)
+
+  (defun aig-env-lookup-missing-quiet (name)
+    (declare (xargs :guard t) (ignore name))
+    nil)
+
+  (defun aig-env-lookup-missing-complain (name)
+    (declare (xargs :guard t))
+    (and *aig-env-lookup-warn-missing-binding*
+         (cw "WARNING: Missing variable binding ~x0 in AIG-ENV-LOOKUP; ~
+              assigning T~%"
+             name)))
+
+  (local (in-theory (disable (break$))))
+
+  (defun aig-env-lookup-missing-break (name)
+    (declare (xargs :guard t))
+    (and *aig-env-lookup-warn-missing-binding*
+         (prog2$ (cw "WARNING: Missing variable binding ~x0 in ~x1; assigning ~
+                      T. To avoid this break, run ~x2, where action is NIL or ~
+                      :WARN.~%"
+                     name
+                     'aig-env-lookup
+                     '(aig-env-lookup-missing-action action))
+                 (break$))))
+
+  (defmacro aig-env-lookup-missing-action (val)
+    (case val
+      ((nil) '(defattach aig-env-lookup-missing-output
+                aig-env-lookup-missing-quiet))
+      (:warn '(defattach aig-env-lookup-missing-output
+                aig-env-lookup-missing-complain))
+      (:break '(defattach aig-env-lookup-missing-output
+                 aig-env-lookup-missing-break))
+      (t (er hard 'aig-env-lookup-missing-action
+             "Expected argument NIL, :WARN, or :BREAK.~%"))))
+
+  (aig-env-lookup-missing-action :warn))
+
+
+(define aig-env-lookup
+  :parents (aig-eval)
+  :short "Look up the value of an AIG variable in an environment."
+
+  ((x   "Variable to look up.")
+   (env "Fast alist mapping variables to values."))
+
+  :long "<p>Unbound variables are given the default value @('t') instead of
+@('nil') because this makes theorems about @(see faig) evaluation work out more
+nicely (it makes unbound FAIG variables evaluate to @('X')).</p>
+
+<p>Jared was once tempted to change this to produce an always Boolean
+result, since it would seem nicer to do that here than in @(see aig-eval).  But
+this function is also used in @(see aig-compose), and it is not valid to
+Boolean-fix it there.</p>"
+
+  :enabled t
+
+  (let ((look (hons-get x env)))
+    (if look
+        (cdr look)
+      (mbe :logic t
+           :exec
+           (if *aig-env-lookup-warn-missing-binding*
+               (prog2$ (aig-env-lookup-missing-output x)
+                       t)
+             t)))))
+
+
+(define aig-eval
+  :parents (aig-semantics)
+  :short "@(call aig-eval) gives the semantics of @(see AIG)s: it gives the
+Boolean value of the AIG @('x') under the environment @('env')."
+
+  ((x   "The AIG to evaluate.")
+   (env "A fast alist that binds variables to values.  Typically it should bind
+every variable in @('x') to some Boolean value.  When this isn't the case,
+variables are assigned the default value @('t'); see @(see aig-env-lookup)."))
+
+  :long "<p>This function is @(see memoize)d.  You should typically free its
+memo table after you are done with whatever @('env') you are using, to avoid
+excessive memory usage.  (We don't use @(':forget t') because you often want to
+evaluate several related AIGs.)</p>"
+
+  :enabled t
+
+  (aig-cases x
+    :true t
+    :false nil
+    :var (and (aig-env-lookup x env) t)
+    :inv (not (aig-eval (car x) env))
+    :and (and (aig-eval (car x) env)
+              (aig-eval (cdr x) env)))
+
+  ///
+  (memoize 'aig-eval :condition '(and (consp x) (cdr x))))
+
+(define aig-eval-list
+  :parents (aig-semantics)
+  :short "@(call aig-eval-list) evaluates a list of AIGs."
+  ((x   "The AIG list to evaluate.")
+   (env "The environment to use; see @(see aig-eval)."))
+  :returns
+  (vals "A list of Boolean values; the evaluations of each AIG under this
+         environment.")
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (aig-eval (car x) env)
+          (aig-eval-list (cdr x) env))))
+
+(define aig-eval-alist
+  :parents (aig-semantics)
+  :short "@(call aig-eval-alist) evaluates an AIG Alist (an alist binding keys
+to AIGs)."
+  ((x   "The AIG alist to evaluate.  This does not need to be a fast alist.")
+   (env "The environment to use; see @(see aig-eval)."))
+  :returns
+  (vals-alist "An ordinary (slow) alist that binds the same keys to the values
+               of their associated AIGs.")
+  :enabled t
+  (cond ((atom x)
+         nil)
+        ((atom (car x))
+         ;; Bad-alist convention
+         (aig-eval-alist (cdr x) env))
+        (t
+         (cons (cons (caar x) (aig-eval (cdar x) env))
+               (aig-eval-alist (cdr x) env))))
+  ///
+  (defthm hons-assoc-equal-aig-eval-alist
+    (equal (hons-assoc-equal key (aig-eval-alist x env))
+           (and (hons-assoc-equal key x)
+                (cons key
+                      (aig-eval (cdr (hons-assoc-equal key x)) env))))
+    :hints(("Goal" :induct t))))
+
+(define aig-eval-alists
+  :parents (aig-semantics)
+  :short "Evaluate a list of AIG Alists."
+  ((x   "List of AIG Alists to evaluate.")
+   (env "The environment to use; see @(see aig-eval)."))
+  :returns
+  (vals-alists "A copy of @('x'), except that each AIG has been replaced with
+                its value.")
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (aig-eval-alist (car x) env)
+          (aig-eval-alists (cdr x) env))))
+
+
+
+
+; -----------------------------------------------------------------------------
+;
+;                        COLLECTING AIG VARIABLES
+;
+; -----------------------------------------------------------------------------
+
+(define aig-vars (x)
+  :parents (aig)
+  :short "@(call aig-vars) returns the variables of the AIG @('X')."
+  :returns (vars "An ordered set of AIG variables (atoms).")
+
+  :long "<p>Note: variable collection can be surprisingly tricky to do
+efficiently.  For a good background discussion that describes various
+approaches to the problem and ways to avoid needing to collect variables, see
+@(see 4v-sexpr-vars).</p>
+
+<p>@('aig-vars') is a slow but simple way to collect the variables that occur
+within an AIG, and we adopt it as our <b>normal form</b> for talking about the
+variables of an AIG.  That is, when we introduce other, faster algorithms for
+collecting variables, we always relate them back to @('aig-vars').</p>
+
+<p>The variable collection strategy used by @('aig-vars') is to memoize the
+whole computation; this implicitly records, for every AND node, the exact set
+of variables that are found under that node.  We use ordinary @(see osets) as
+our variable set representation so that merging these sets is linear at each
+node.  The overall complexity is then @('O(n^2)') in the size of the AIG.</p>
+
+<p>This approach records the full variable information for every AND node
+throughout the AIG.  This takes a lot of memory, and often you do not need
+nearly this much information.  In practice, functions like @(see
+aig-vars-1pass) are often much more practical.</p>"
+
+  :verify-guards nil
+  :enabled t
+  (aig-cases x
+    :true  nil
+    :false nil
+    :var   (mbe :logic (sets::insert x nil)
+                :exec (hons x nil))
+    :inv   (aig-vars (car x))
+    :and   (mbe :logic (sets::union (aig-vars (car x))
+                                    (aig-vars (cdr x)))
+                :exec (hons-alphorder-merge (aig-vars (car x))
+                                            (aig-vars (cdr x)))))
+  ///
+  (defthm atom-listp-aig-vars
+    (atom-listp (aig-vars x)))
+
+  (defthm true-listp-aig-vars
+    (true-listp (aig-vars x))
+    :rule-classes :type-prescription)
+
+  (defthm setp-aig-vars
+    (sets::setp (aig-vars x))
+    :hints(("Goal" :in-theory (enable* (:ruleset sets::primitive-rules)))))
+
+  (verify-guards aig-vars
+    :hints(("Goal" :in-theory (enable* (:ruleset sets::primitive-rules)))))
+
+  (memoize 'aig-vars :condition '(and (consp x) (cdr x))))
+
+
+
+
+; -----------------------------------------------------------------------------
+;
+;                              AIG CONSTRUCTION
+;
+; -----------------------------------------------------------------------------
+
+(define aig-not (x)
+  :parents (aig-constructors)
+  :short "@(call aig-not) constructs an AIG representing @('(not x)')."
+  :long "<p>This could be implemented as @('(hons x nil)'), but we at least
+take care to fold constants and avoid creating double negatives.</p>"
+  :returns aig
+  (cond ((eq x nil) t)
+        ((eq x t) nil)
+        ((and (consp x) (eq (cdr x) nil))
+         (car x))
+        (t
+         (hons x nil)))
+  ///
+  (defthm aig-eval-not
+    (equal (aig-eval (aig-not x) env)
+           (not (aig-eval x env)))))
+
+(define aig-and (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-and) constructs an AIG representing @('(and x y)')."
+  :long "<p>This could have been implemented as @('(hons x y)'), but we take
+care to fold constants and reduce @('x & x') and @('x & ~x').</p>"
+  :returns aig
+  (cond ((or (eq x nil) (eq y nil)) nil)
+        ((eq x t) y)
+        ((eq y t) x)
+        ((hons-equal x y) x)
+        ((and (consp y) (eq (cdr y) nil)
+              (hons-equal (car y) x))
+         nil)
+        ((and (consp x) (eq (cdr x) nil)
+              (hons-equal (car x) y))
+         nil)
+        (t (hons x y)))
+  ///
+  (defthm aig-eval-and
+    (equal (aig-eval (aig-and x y) env)
+           (and (aig-eval x env)
+                (aig-eval y env))))
+  (defthm aig-and-constants
+    (and (equal (aig-and nil x) nil)
+         (equal (aig-and x nil) nil)
+         (equal (aig-and x t) x)
+         (equal (aig-and t x) x))))
+
+(define aig-or (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-or) constructs an AIG representing @('(or x y)')."
+  :returns aig
+  (aig-not (aig-and (aig-not x) (aig-not y)))
+  ///
+  (defthm aig-eval-or
+    (equal (aig-eval (aig-or x y) env)
+           (or (aig-eval x env)
+               (aig-eval y env)))))
+
+(define aig-xor (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-xor) constructs an AIG representing @('(xor x y)')."
+  :returns aig
+  (aig-or (aig-and x (aig-not y))
+          (aig-and (aig-not x) y))
+  ///
+  (defthm aig-eval-xor
+    (equal (aig-eval (aig-xor x y) env)
+           (xor (aig-eval x env)
+                (aig-eval y env)))))
+
+(define aig-iff (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-iff) constructs an AIG representing @('(iff x y)')."
+  :returns aig
+  (aig-or (aig-and x y)
+          (aig-and (aig-not x) (aig-not y)))
+  ///
+  (defthm aig-eval-iff
+    (equal (aig-eval (aig-iff x y) env)
+           (iff (aig-eval x env)
+                (aig-eval y env)))))
+
+(define aig-implies (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-implies) constructs an AIG representing @('(implies x
+  y)')."
+  :returns aig
+  (aig-not (aig-and x (aig-not y)))
+  ///
+  (defthm aig-eval-implies
+    (equal (aig-eval (aig-implies x y) env)
+           (implies (aig-eval x env)
+                    (aig-eval y env)))))
+
+(define aig-ite (a b c)
+  :parents (aig-constructors)
+  :short "@(call aig-ite) constructs an AIG representing @('(if a b c)')."
+  :returns aig
+  (cond ((hons-equal b c)
+         b)
+        ((eq b t)
+         (aig-or a c))
+        (t
+         (aig-or (aig-and a b)
+                 (aig-and (aig-not a) c))))
+  ///
+  (defthm aig-eval-ite
+    (iff (aig-eval (aig-ite a b c) env)
+         (if (aig-eval a env)
+             (aig-eval b env)
+           (aig-eval c env)))))
+
+(define aig-not-list (x)
+  :parents (aig-constructors)
+  :short "@(call aig-not-list) negates every AIG in the list @('x')."
+  :returns aig-list
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (aig-not (car X))
+          (aig-not-list (cdr x)))))
+
+(define aig-and-list (x)
+  :parents (aig-constructors)
+  :short "@(call aig-and-list) <i>and</i>s together all of the AIGs in the list
+@('x')."
+  :returns aig
+  :enabled t
+  (if (atom x)
+      t
+    (aig-and (car x)
+             (aig-and-list (cdr x)))))
+
+(define aig-or-list (x)
+  :parents (aig-constructors)
+  :short "@(call aig-or-list) <i>or</i>s together all of the AIGs in the list
+@('x')."
+  :returns aig
+  :enabled t
+  (if (atom x)
+      nil
+    (aig-or (car x) (aig-or-list (cdr x)))))
+
+(define aig-and-lists (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-and-lists) pairwise <i>and</i>s together the AIGs from the
+lists @('x') and @('y')."
+  :returns aig-list
+  :enabled t
+  (if (or (atom x) (atom y))
+      nil
+    (cons (aig-and (car x) (car y))
+          (aig-and-lists (cdr x) (cdr y)))))
+
+(define aig-or-lists (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-or-lists) pairwise <i>or</i>s together the AIGs from the
+lists @('x') and @('y')."
+  :returns aig-list
+  :enabled t
+  (if (or (atom x) (atom y))
+      nil
+    (cons (aig-or (car x) (car y))
+          (aig-or-lists (cdr x) (cdr y)))))
+
+(define aig-iff-lists (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-iff-lists) pairwise <i>iff</i>s together the AIGs from the
+lists @('x') and @('y')."
+  :returns aig-list
+  :enabled t
+  (if (or (atom x) (atom y))
+      nil
+    (cons (aig-iff (car x) (car y))
+          (aig-iff-lists (cdr x) (cdr y)))))
+
+(define aig-xor-lists (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-xor-lists) pairwise <i>xor</i>s together the AIGs from the
+lists @('x') and @('y')."
+  :returns aig-list
+  :enabled t
+  (if (or (atom x) (atom y))
+      nil
+    (cons (aig-xor (car x) (car y))
+          (aig-xor-lists (cdr x) (cdr y)))))
+
+(define aig-implies-lists (x y)
+  :parents (aig-constructors)
+  :short "@(call aig-implies-lists) pairwise <i>implies</i> together the AIGs
+from the lists @('x') and @('y')."
+  :returns aig-list
+  :enabled t
+  (if (or (atom x) (atom y))
+      nil
+    (cons (aig-implies (car x) (car y))
+          (aig-implies-lists (cdr x) (cdr y)))))
+
+
+
+; -----------------------------------------------------------------------------
+;
+;                         SUBSTITUTION INTO AIGS
+;
+; -----------------------------------------------------------------------------
+
+(define aig-restrict
+  :parents (aig-substitution)
+  :short "@(call aig-restrict) performs variable substitution throughout the
+AIG @('x'), replacing any variables bound in @('sigma') with their
+corresponding values."
+  ((x     "The AIG to restrict.")
+   (sigma "A fast alist binding variables to replacement AIGs."))
+  :returns
+  (aig "Modified version of @('x') where all variables bound in @('sigma') are
+replaced, and any unmentioned variables are left <b>unchanged</b>.")
+
+  :long "<p>The name @('sigma') is intended to evoke the notion of substitution
+lists in logic.  Any variables that are not mentioned in @('sigma') are left
+unchanged.  When all of the variables in @('x') are bound in @('sigma'), and
+all of the values are Boolean, this is equivalent to @(see aig-eval).</p>
+
+<p>This function is @(see memoize)d.  You should typically free its memo table
+after you are done with whatever @('sigma') you are using, to avoid excessive
+memory usage.  (We don't use @(':forget t') because you often want to restrict
+several related AIGs.)</p>"
+
+  :enabled t
+
+  (aig-cases x
+    :true t
+    :false nil
+    :var (let ((a (hons-get x sigma)))
+           (if a
+               (cdr a)
+             x))
+    :inv (aig-not (aig-restrict (car x) sigma))
+    :and (let ((a (aig-restrict (car x) sigma)))
+           (and a (aig-and a (aig-restrict (cdr x) sigma)))))
+  ///
+  (memoize 'aig-restrict :condition '(and (consp x) (cdr x)))
+
+  (local (defthm hons-assoc-equal-of-append
+           (equal (hons-assoc-equal k (append a b))
+                  (or (hons-assoc-equal k a)
+                      (hons-assoc-equal k b)))))
+
+  (defthm aig-eval-of-aig-restrict
+    (equal (aig-eval (aig-restrict x al1) al2)
+           (aig-eval x (append (aig-eval-alist al1 al2) al2)))
+    :hints(("Goal"
+            :induct t
+            :in-theory (enable aig-env-lookup)))))
+
+(define aig-restrict-list
+  :parents (aig-substitution)
+  :short "@(call aig-restrict-list) substitutes into a list of AIGs."
+  ((x     "List of AIGs.")
+   (sigma "Fast alist binding variables to replacement AIGs, as in @(see
+           aig-restrict)."))
+  :returns aig-list
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (aig-restrict (car x) sigma)
+          (aig-restrict-list (cdr x) sigma))))
+
+(define aig-restrict-alist
+  :parents (aig-substitution)
+  :short "@(call aig-restrict-alist) substitutes into an AIG Alist (an alist
+binding keys to AIGs)."
+  ((x     "Alist binding names to AIGs.  This doesn't need to be a fast alist.")
+   (sigma "Fast alist binding variables to replacement AIGs, as in @(see
+           aig-restrict)."))
+  :returns
+  (aig-alist "Ordinary (slow) alist with the same keys as @('x'), and values
+              formed by restricting each aig with @(see aig-restrict).")
+  :enabled t
+  (cond ((atom x)
+         nil)
+        ((atom (car x))
+         ;; Bad-alist convention
+         (aig-restrict-alist (cdr x) sigma))
+        (t
+         (cons (cons (caar x)
+                     (aig-restrict (cdar x) sigma))
+               (aig-restrict-alist (cdr x) sigma))))
+  ///
+  (defthm alistp-of-aig-restrict-alist
+    (alistp (aig-restrict-alist x sigma))))
+
+(define aig-restrict-alists
+  :parents (aig-substitution)
+  :short "@(call aig-restrict-alists) substitutes into a list of AIG Alists."
+  ((x     "List of AIG alists, which need not be fast.")
+   (sigma "Fast alist binding variables to replacement AIGs, as in @(see
+           aig-restrict)."))
+  :returns
+  (aig-alists "List of ordinary (slow) alists, derived from @('x') via
+               @(see aig-restrict-alist).")
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (aig-restrict-alist (car x) sigma)
+          (aig-restrict-alists (cdr x) sigma))))
+
+
+
+; -----------------------------------------------------------------------------
+;
+;                             AIG COMPOSITION
+;
+; -----------------------------------------------------------------------------
+
+(define aig-compose
+  :parents (aig-substitution)
+  :short "@(call aig-compose) performs variable substitution throughout the AIG
+@('x'), <b>unconditionally</b> replacing every variable in @('x') with its
+binding in @('sigma')."
+  ((x     "The AIG to compose into.")
+   (sigma "A fast alist that should bind variables to replacement AIGs."))
+  :returns
+  (aig "Modified version of @('x') where every variable is replaced with its
+        binding in @('sigma') or @('t') if it has no binding.")
+
+  :long "<p>The name @('sigma') is intended to evoke the notion of substitution
+lists in logic.  This operation is similar to @(see aig-restrict), except that
+whereas @('aig-restrict') leaves unbound variables alone, @('aig-compose')
+replaces them with @('t').  This has the logically nice property that the
+variables after composition are just the variables in the AIGs of
+@('sigma').</p>
+
+<p>This function is @(see memoize)d.  You should typically free its memo table
+after you are done with whatever @('sigma') you are using, to avoid excessive
+memory usage.  (We don't use @(':forget t') because you often want to compose
+several related AIGs.)</p>"
+
+  :enabled t
+
+  (aig-cases x
+    :true t
+    :false nil
+    :var (aig-env-lookup x sigma)
+    :inv (aig-not (aig-compose (car x) sigma))
+    :and (let ((a (aig-compose (car x) sigma)))
+           (and a (aig-and a (aig-compose (cdr x) sigma)))))
+  ///
+  (memoize 'aig-compose :condition '(and (consp x) (cdr x))))
+
+(define aig-compose-list
+  :parents (aig-substitution)
+  :short "@(call aig-compose-list) composes into a list of AIGs."
+  ((x     "List of AIGs.")
+   (sigma "Fast alist binding variables to replacement AIGs, as in @(see
+           aig-compose)."))
+  :returns aig-list
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (aig-compose (car x) sigma)
+          (aig-compose-list (cdr x) sigma))))
+
+(define aig-compose-alist
+  :parents (aig-substitution)
+  :short "@(call aig-compose-alist) composes into an AIG Alist (an alist
+binding keys to AIGs)."
+  ((x     "Alist binding names to AIGs.  This doesn't need to be a fast alist.")
+   (sigma "Fast alist binding variables to replacement AIGs, as in @(see
+           aig-compose)."))
+  :returns
+  (aig-alist "Ordinary (slow) alist with the same keys as @('x'), and values formed
+              by restricting each aig with @(see aig-compose).")
+  :enabled t
+  (cond ((atom x)
+         nil)
+        ((atom (car x))
+         ;; Bad alist convention
+         (aig-compose-alist (cdr x) sigma))
+        (t
+         (cons (cons (caar x)
+                     (aig-compose (cdar x) sigma))
+               (aig-compose-alist (cdr x) sigma)))))
+
+(define aig-compose-alists
+  :parents (aig-substitution)
+  :short "@(call aig-compose-alists) composes into a list of AIG Alists."
+  ((x     "List of AIG alists, which need not be fast.")
+   (sigma "Fast alist binding variables to replacement AIGs, as in @(see
+           aig-compose)."))
+  :returns
+  (aig-alists "List of ordinary (slow) alists, derived from @('x') via @(see
+               aig-compose-alist).")
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (aig-compose-alist (car x) sigma)
+          (aig-compose-alists (cdr x) sigma))))
+
+
+
+; -----------------------------------------------------------------------------
+;
+;                      PARTIALLY EVALUATING AIGS
+;
+; -----------------------------------------------------------------------------
+
+(define aig-partial-eval
+  :parents (aig-substitution)
+  :short "@(call aig-partial-eval) evaluates @('x'), an AIG, under the partial
+environment @('env'), producing a new AIG as a result."
+  ((x   "The AIG to partially evaluate.")
+   (env "A fast alist that (typically) binds some of the variables in @('x') to
+         Boolean values."))
+  :returns
+  (aig "Modified version of @('x') obtained by replacing bound variables with their
+        values and doing basic constant propagation.")
+
+  :long "<p>In ordinary AIG evaluation with @(see aig-eval), any variables that
+are missing from @('env') are just assumed to have a default value.  Because of
+this, every variable can be given a Boolean value and we can evaluate the whole
+AIG to produce a Boolean result.</p>
+
+<p>In partial evaluation, variables that aren't bound in @('env') are left
+alone.  Because of this, the result of a partial evaluation is a typically a
+reduced AIG instead of a Boolean.</p>
+
+<p>Another way to do partial evaluations is with @(see aig-restrict).  In fact,
+the only difference between @('aig-restrict') and @('aig-partial-eval') is that
+@('aig-partial-eval') Boolean-fixes the values in the alist as it looks them
+up.  This has logically nice properties, e.g., since we never replace a
+variable by a subtree, only by a Boolean, we know unconditionally that the
+variables of the resulting AIG are a subset of the variables of the
+original.</p>
+
+<p>This function is @(see memoize)d.  You should typically free its memo table
+after you are done with whatever @('env') you are using, to avoid excessive
+memory usage.  (We don't use @(':forget t') because you often want to evaluate
+several related AIGs.)</p>"
+
+  :enabled t
+  (aig-cases x
+    :true t
+    :false nil
+    :var (let ((a (hons-get x env)))
+           (if a (and (cdr a) t) x))
+    :inv (aig-not (aig-partial-eval (car x) env))
+    :and (let ((a (aig-partial-eval (car x) env)))
+           (and a
+                (aig-and a (aig-partial-eval (cdr x) env)))))
+  ///
+  (memoize 'aig-partial-eval :condition '(and (consp x) (cdr x))))
+
+(define aig-partial-eval-list
+  :parents (aig-substitution)
+  :short "@(call aig-partial-eval-list) partially evaluates a list of AIGs."
+  ((x   "List of AIGs.")
+   (env "Fast alist binding variables to Booleans, as in @(see
+         aig-partial-eval)."))
+  :returns aig-list
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (aig-partial-eval (car x) env)
+          (aig-partial-eval-list (cdr x) env))))
+
+(define aig-partial-eval-alist
+  :parents (aig-substitution)
+  :short "@(call aig-partial-eval-alist) partially evaluates an AIG Alist (an
+alist binding keys to AIGs)."
+  ((x   "Alist binding names to AIGs.  This doesn't need to be a fast alist.")
+   (env "Fast alist binding variables to Booleans, as in @(see
+         aig-partial-eval)."))
+  :returns
+  (aig-alist "Ordinary (slow) alist with the same keys as x, and values formed
+              by restricting each aig with @(see aig-partial-eval).")
+  :enabled t
+  (cond ((atom x)
+         nil)
+        ((atom (car x))
+         ;; Bad-alist convention
+         (aig-partial-eval-alist (cdr x) env))
+        (t
+         (cons (cons (caar x)
+                     (aig-partial-eval (cdar x) env))
+               (aig-partial-eval-alist (cdr x) env))))
+  ///
+  (defthm alistp-of-aig-partial-eval-alist
+    (alistp (aig-partial-eval-alist x env))))
+
diff -Nru acl2-6.2/books/centaur/aig/aig-equivs.lisp acl2-6.3/books/centaur/aig/aig-equivs.lisp
--- acl2-6.2/books/centaur/aig/aig-equivs.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aig-equivs.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -19,8 +19,7 @@
 ; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
-
-(include-book "base")
+(include-book "aig-base")
 (include-book "centaur/misc/witness-cp" :dir :system)
 (include-book "centaur/misc/universal-equiv" :dir :system)
 (include-book "centaur/misc/fast-alists" :dir :system)
@@ -28,7 +27,7 @@
 
 
 (defsection aig-equiv
-  :parents (aig)
+  :parents (aig-semantics)
   :short "We say the AIGs @('X') and @('Y') are equivalent when they always
 evaluate to the same value, per @(see aig-eval)."
   :long "@(def aig-equiv)"
@@ -44,7 +43,7 @@
 
 
 (defsection aig-alist-equiv
-  :parents (aig)
+  :parents (aig-semantics)
   :short "We say the AIG Alists @('X') and @('Y') are equivalent when they bind
 the same keys to equivalent AIGs, in the sense of @(see aig-equiv)."
   :long "@(def aig-alist-equiv)"
@@ -65,7 +64,7 @@
 
 
 (defsection aig-env-equiv
-  :parents (aig)
+  :parents (aig-semantics)
   :short "We say the environments @('X') and @('Y') are equivalent when they
 give equivalent values to variables looked up with @(see aig-env-lookup)."
   :long "@(def aig-env-equiv)"
@@ -81,38 +80,3 @@
   (defrefinement alist-equiv aig-env-equiv
     :hints ((witness))))
 
-
-
-
-(defsection faig-equiv
-  :parents (faig)
-  :short "We say the FAIGs @('X') and @('Y') are equivalent when they always
-evaluate to the same value, per @(see faig-eval)."
-
-  (def-universal-equiv faig-equiv
-    :qvars env
-    :equiv-terms ((equal (faig-eval x env)))
-    :defquant t
-    :witness-dcls ((declare (xargs :guard t))))
-
-  (verify-guards faig-equiv))
-
-
-(defsection faig-alist-equiv
-  :parents (faig)
-  :short "We say the FAIG Alists @('X') and @('Y') are equivalent when they
-bind the same keys to equivalent FAIGs, in the sense of @(see faig-equiv)."
-
-  (def-universal-equiv faig-alist-equiv
-    :qvars k
-    :equiv-terms ((iff (hons-assoc-equal k x))
-                  (faig-equiv (cdr (hons-assoc-equal k x))))
-    :defquant t
-    :witness-dcls ((declare (xargs :guard t))))
-
-  (verify-guards faig-alist-equiv)
-
-  (defrefinement alist-equiv faig-alist-equiv
-    :hints ((witness))))
-
-
diff -Nru acl2-6.2/books/centaur/aig/aig-print.lisp acl2-6.3/books/centaur/aig/aig-print.lisp
--- acl2-6.2/books/centaur/aig/aig-print.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aig-print.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,124 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+(include-book "aig-base")
+
+(define aig-print
+  :parents (aig-other)
+  :short "Convert an AIG into an ACL2-like S-expression."
+  ((x "An AIG"))
+  :returns (sexpr "A s-expression with AND and NOT calls.")
+  :long "<p>We generally don't imagine using this for anything other than
+one-off debugging.  Note that the S-expressions you generate this way can
+easily be too large to print.</p>"
+  :verify-guards nil
+  (aig-cases
+    x
+    :true t
+    :false nil
+    :var x
+    :inv `(not ,(aig-print (car x)))
+    :and (let* ((a (aig-print (car x)))
+                (d (aig-print (cdr x))))
+           `(and ,@(if (and (consp a) (eq (car a) 'and))
+                       (cdr a)
+                     (list a))
+                 ,@(if (and (consp d) (eq (car d) 'and))
+                       (cdr d)
+                     (list d)))))
+  ///
+  (local (defthm lemma
+           (implies (and (consp (aig-print x))
+                         (eq (car (aig-print x)) 'and))
+                    (true-listp (cdr (aig-print x))))))
+  (verify-guards aig-print)
+  (memoize 'aig-print :condition '(consp x)))
+
+
+
+(defsection expr-to-aig
+  :parents (aig-other)
+  :short "Convert an ACL2-like S-expression into an AIG."
+  :long "<p>@(call expr-to-aig) accepts S-expressions @('expr') such as:</p>
+
+@({
+     a
+     (not a)
+     (and a b c)
+})
+
+<p>It currently accepts S-expressions composed of the following operators, all
+of which are assumed to be Boolean-valued (i.e., there's nothing four-valued
+going on here):</p>
+
+<ul>
+  <li>@('not') -- unary</li>
+  <li>@('and'), @('or'), @('nand'), @('nor') -- variable arity</li>
+  <li>@('iff'), @('xor'), @('implies') -- binary</li>
+  <li>@('if') -- ternary</li>
+</ul>
+
+<p>It constructs an AIG from the S-expression using the ordinary @(see
+aig-constructors).</p>
+
+<p>This can be useful for one-off debugging.  We probably wouldn't recommend
+using it for anything serious, or trying to prove anything about it.</p>"
+
+  (mutual-recursion
+   (defun expr-to-aig (expr)
+     (declare (Xargs :guard t
+                     :measure (+ 1 (* 2 (acl2-count expr)))))
+     (if (atom expr)
+         expr
+       (let ((fn (car expr))
+             (args (cdr expr)))
+         (cond
+          ((and (eq fn 'not) (= (len args) 1))
+           (aig-not (expr-to-aig (car args))))
+          ((eq fn 'and) (expr-to-aig-args 'and t args))
+          ((eq fn 'or)  (expr-to-aig-args 'or nil args))
+          ((eq fn 'nand) (aig-not (expr-to-aig-args 'and t args)))
+          ((eq fn 'nor)  (aig-not (expr-to-aig-args 'or nil args)))
+          ((and (eq fn 'iff) (= (len args) 2))
+           (aig-iff (expr-to-aig (car args))
+                    (expr-to-aig (cadr args))))
+          ((and (eq fn 'xor) (= (len args) 2))
+           (aig-xor (expr-to-aig (car args))
+                    (expr-to-aig (cadr args))))
+          ((and (eq fn 'implies) (= (len args) 2))
+           (aig-or (aig-not (expr-to-aig (car args)))
+                   (expr-to-aig (cadr args))))
+          ((and (eq fn 'if) (= (len args) 3))
+           (aig-ite (expr-to-aig (car args))
+                    (expr-to-aig (cadr args))
+                    (expr-to-aig (caddr args))))
+          (t (prog2$ (er hard? 'expr-to-aig "Malformed: ~x0~%" expr)
+                     nil))))))
+   (defun expr-to-aig-args (op final exprs)
+     (declare (xargs :guard t
+                     :measure (* 2 (acl2-count exprs))))
+     (if (atom exprs)
+         final
+       (let ((first (expr-to-aig (car exprs)))
+             (rest (expr-to-aig-args op final (cdr exprs))))
+         (case op
+           (and (aig-and first rest))
+           (or (aig-or first rest))))))))
diff -Nru acl2-6.2/books/centaur/aig/aig-sat-tests.lisp acl2-6.3/books/centaur/aig/aig-sat-tests.lisp
--- acl2-6.2/books/centaur/aig/aig-sat-tests.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aig-sat-tests.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,74 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>
+;                   Sol Swords <sswords@centtech.com>
+
+; cert_param: (uses-glucose)
+
+(in-package "ACL2")
+
+(local (progn
+
+(include-book "aig-sat")
+
+(defun my-glucose-config ()
+  (declare (xargs :guard t))
+  (satlink::make-config :cmdline "glucose"
+                        :verbose t
+                        :mintime 1/2
+                        :remove-temps t))
+
+(value-triple (tshell-ensure))
+
+; These are some extremely basic tests.  The point isn't to thoroughly test the
+; SAT solver.  It's just to make sure that everything seems to be basically
+; holding together.
+
+(defun test-aig-sat (input expect)
+  (b* (((mv status ?alist)
+        (aig-sat input :config (my-glucose-config))))
+    (cw "Alist: ~x0" alist)
+    (equal status expect)))
+
+(assert! (test-aig-sat nil :unsat))
+(assert! (test-aig-sat t :sat))
+
+(assert! (test-aig-sat 'x :sat))
+(assert! (test-aig-sat (aig-and 'x 'y) :sat))
+(assert! (test-aig-sat (aig-ite 'x 'y 'z) :sat))
+
+(assert! (test-aig-sat (aig-and
+                        (aig-ite 'x 'y 'z)
+                        (aig-ite 'x (aig-not 'y) (aig-not 'z)))
+                       :unsat))
+
+
+(assert! (test-aig-sat (aig-and-list
+                        (list (aig-or 'x 'y)
+                              'a
+                              (aig-or (aig-not 'x) 'y)
+                              (aig-and 'a 'b)
+                              (aig-or 'x (aig-not 'y))
+                              'c
+                              (aig-not 'x)
+                              (aig-not 'y)))
+                       :unsat))
+
+
+))
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/aig/aig-sat.lisp acl2-6.3/books/centaur/aig/aig-sat.lisp
--- acl2-6.2/books/centaur/aig/aig-sat.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aig-sat.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,101 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>
+;                   Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+(include-book "centaur/aignet/aig-cnf" :dir :system)
+(include-book "centaur/satlink/top" :dir :system)
+(local (include-book "centaur/satlink/cnf-basics" :dir :system))
+(local (in-theory (disable nth update-nth aig-eval)))
+
+(define aig-sat
+  :parents (aig)
+  :short "Determine whether an AIG is satisfiable."
+  ((aig "The AIG to inspect.")
+   &key
+   ((config satlink::config-p "How to invoke the SAT solver.")
+    'satlink::*default-config*))
+  :returns (mv (status "Either :sat, :unsat, or :failed")
+               (env    "When :sat, an (ordinary, slow) alist binding the
+                        aig vars to t/nil."))
+
+  :long "<p>This is a convenient, high level way to ask a SAT solver whether a
+Hons AIG is satisfiable.  When the AIG is satisfiable, you get back a
+satisfying assignment in terms of the Hons AIG's variables.</p>
+
+<p>This function should only fail if there is some problem with the SAT solver,
+e.g., it produces output that @(see satlink) does not understand.</p>
+
+<p>The underlying mechanism takes advantage of @(see aignet) to carry out the
+<see topic='@(url aignet-cnf)'>cnf conversion</see> and @(see satlink) to call
+the SAT solver.  As a picture:</p>
+
+@({
+           convert                export              dimacs
+    AIG -------------> AIGNET -----------------> CNF -------> Solver
+     ||                  ||                       ||            |
+     ||                  ||                       ||            | interpret
+  satisfying          satisfying               satisfying       |  output
+   alist or  <-------  array or   <-----------  assign or  <----'
+   'unsat'    convert  'unsat'      translate   'unsat'
+})
+
+<p>We simply trust the SAT solver if it says @('unsat'), but the other
+translation and conversion steps are all verified.</p>"
+
+  (b* (;; Locally create arrays to work with
+       ((local-stobjs satlink::env$ aignet::sat-lits aignet::aignet)
+        (mv status env satlink::env$ aignet::sat-lits aignet::aignet))
+
+       ;; Convert the AIG into a CNF formula, using fancy AIGNET algorithm
+       ((mv cnf ?lit vars aignet::sat-lits aignet::aignet)
+        (aignet::aig->cnf aig aignet::sat-lits aignet::aignet))
+
+       ((mv result satlink::env$)
+        (satlink::sat cnf satlink::env$ :config config))
+
+       ((unless (eq result :sat))
+        (mv result nil satlink::env$ aignet::sat-lits aignet))
+
+       (env (aignet::aig-cnf-vals->env satlink::env$ vars aignet::sat-lits aignet)))
+
+    (mv :sat env satlink::env$ aignet::sat-lits aignet))
+
+  ///
+  (defthm aig-sat-when-sat
+    (b* (((mv status env) (aig-sat aig :config config)))
+      (implies (equal status :sat)
+               (aig-eval aig env))))
+
+  (defthm aig-sat-when-unsat
+    (b* (((mv status &) (aig-sat aig :config config)))
+      (implies (aig-eval aig env)
+               (not (equal status :unsat))))
+    :hints (("goal"
+             :use ((:instance
+                    aignet::aig-satisfying-assign-induces-aig->cnf-satisfying-assign
+                    (aignet::aig      aig)
+                    (aignet::env      env)
+                    (aignet::sat-lits (aignet::create-sat-lits))
+                    (aignet::aignet   (acl2::create-aignet))))
+             :in-theory (disable
+                         aignet::aig-satisfying-assign-induces-aig->cnf-satisfying-assign)))))
+
+
diff -Nru acl2-6.2/books/centaur/aig/aig-vars-ext.lisp acl2-6.3/books/centaur/aig/aig-vars-ext.lisp
--- acl2-6.2/books/centaur/aig/aig-vars-ext.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aig-vars-ext.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -21,7 +21,7 @@
 
 (in-package "ACL2")
 (include-book "defsort/defsort" :dir :system)
-(include-book "centaur/aig/base" :dir :system)
+(include-book "aig-base")
 (include-book "tools/bstar" :dir :system)
 (include-book "centaur/bitops/sbitsets" :dir :system)
 (include-book "centaur/misc/hons-extra" :dir :system)
diff -Nru acl2-6.2/books/centaur/aig/aig-vars.lisp acl2-6.3/books/centaur/aig/aig-vars.lisp
--- acl2-6.2/books/centaur/aig/aig-vars.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aig-vars.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -19,45 +19,50 @@
 ; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
+(include-book "aig-base")
 
-(include-book "base")
+;; BOZO should these be local?
 (include-book "centaur/misc/equal-sets" :dir :system)
 (include-book "centaur/misc/alist-equiv" :dir :system)
 
 (local (in-theory (disable sets::double-containment)))
 
-(defthm aig-vars-cons
-  (equal (aig-vars (cons x y))
-         (sets::union (aig-vars x)
-                      (aig-vars y))))
-
-(defthm member-aig-vars-alist-vals
-  (implies (not (sets::in v (aig-vars (alist-vals al))))
-           (not (sets::in v (aig-vars (cdr (hons-assoc-equal x al))))))
-  :hints(("Goal" :in-theory (enable hons-assoc-equal))))
-
-(defthm member-aig-vars-aig-and
-  (implies (and (not (sets::in v (aig-vars x)))
-                (not (sets::in v (aig-vars y))))
-           (not (sets::in v (aig-vars (aig-and x y)))))
-  :hints(("Goal" :in-theory (enable aig-and))))
-
-(defthm aig-vars-aig-not
-  (equal (aig-vars (aig-not x))
-         (aig-vars x))
-  :hints(("Goal" :in-theory (enable aig-not))))
-
-(defthm member-aig-vars-aig-restrict
-  (implies (and (not (and (sets::in v (aig-vars x))
-                          (not (member-equal v (alist-keys al)))))
-                (not (sets::in v (aig-vars (alist-vals al)))))
-           (not (sets::in v (aig-vars (aig-restrict x al)))))
-  :hints(("Goal" :in-theory (enable aig-restrict))))
-
-(defthm member-aig-vars-aig-partial-eval
-  (implies (not (and (sets::in v (aig-vars x))
-                     (not (member-equal v (alist-keys al)))))
-           (not (sets::in v (aig-vars (aig-partial-eval x al)))))
-  :hints(("Goal" :in-theory (enable aig-partial-eval))))
+(defsection aig-vars-thms
+  :parents (aig-vars)
+  :short "Theorems about @(see aig-vars) from @(see centaur/aig/aig-vars)."
+
+  (defthm aig-vars-cons
+    (equal (aig-vars (cons x y))
+           (sets::union (aig-vars x)
+                        (aig-vars y))))
+
+  (defthm member-aig-vars-alist-vals
+    (implies (not (sets::in v (aig-vars (alist-vals al))))
+             (not (sets::in v (aig-vars (cdr (hons-assoc-equal x al))))))
+    :hints(("Goal" :in-theory (enable hons-assoc-equal))))
+
+  (defthm member-aig-vars-aig-and
+    (implies (and (not (sets::in v (aig-vars x)))
+                  (not (sets::in v (aig-vars y))))
+             (not (sets::in v (aig-vars (aig-and x y)))))
+    :hints(("Goal" :in-theory (enable aig-and))))
+
+  (defthm aig-vars-aig-not
+    (equal (aig-vars (aig-not x))
+           (aig-vars x))
+    :hints(("Goal" :in-theory (enable aig-not))))
+
+  (defthm member-aig-vars-aig-restrict
+    (implies (and (not (and (sets::in v (aig-vars x))
+                            (not (member-equal v (alist-keys al)))))
+                  (not (sets::in v (aig-vars (alist-vals al)))))
+             (not (sets::in v (aig-vars (aig-restrict x al)))))
+    :hints(("Goal" :in-theory (enable aig-restrict))))
+
+  (defthm member-aig-vars-aig-partial-eval
+    (implies (not (and (sets::in v (aig-vars x))
+                       (not (member-equal v (alist-keys al)))))
+             (not (sets::in v (aig-vars (aig-partial-eval x al)))))
+    :hints(("Goal" :in-theory (enable aig-partial-eval)))))
 
 
diff -Nru acl2-6.2/books/centaur/aig/aig2c.lisp acl2-6.3/books/centaur/aig/aig2c.lisp
--- acl2-6.2/books/centaur/aig/aig2c.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aig2c.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,630 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "cutil/top" :dir :system)
+(include-book "centaur/vl/util/namedb" :dir :system)
+(include-book "aig-base")
+(include-book "aig-vars-ext")
+(local (include-book "std/typed-lists/string-listp" :dir :system))
+
+(local (defthm stringp-of-lookup-when-string-listp-of-alist-vals
+         (implies (string-listp (alist-vals map))
+                  (equal (stringp (cdr (hons-assoc-equal key map)))
+                         (if (hons-assoc-equal key map)
+                             t
+                           nil)))
+         :hints(("Goal" :induct (len map)))))
+
+
+(defsection aig2c
+  :parents (aig-other)
+  :short "Naive compiler from Hons AIGs into C/C++ code fragments."
+
+  :long "<p>The idea here is to be able to take an AIG and embed it in a C or
+C++ program.  You can tweak various aspects of the code that gets generated,
+but some basic example output is:</p>
+
+@({
+  const uint32_t n_8 = inputs.a;     // prologue: initializes temp variables
+  const uint32_t n_2 = inputs.b;     //   you can control the rhs'es here
+  const uint32_t n_4 = inputs.c;
+
+  const uint32_t n_3 = ~n_4;         // main aig contents
+  const uint32_t n_1 = n_2 & n_3;    //   never try to understand this
+  const uint32_t n_7 = ~n_8;
+  const uint32_t n_6 = n_4 & n_7;
+  const uint32_t n_5 = n_6 & n_1;
+
+  out1 = n_1;                        // epilogue: extracts aigs to outputs
+  out2 = n_5;                        //   you can control the lhs'es here
+})
+
+<p>We try to make relatively few assumptions about how you might actually use
+this code.  Toward that goal, you may <see topic='@(url
+aig2c-config-p)'>configure</see>, e.g., the names and types of the temporary
+variables, and the operators used to carry out each AND and NOT operation.</p>
+
+<p>Some high level notes:</p>
+
+<ul>
+
+<li>We basically turn each AIG node into one line of C/C++ code.</li>
+
+<li>We do at least take advantage of shared structure in the AIG, and avoid
+recomputing an AND node just because it has multiple fanouts.</li>
+
+<li>We don't even do basic optimizations like using @('|') or @('^') operators,
+but doing so might be useful.</li>
+
+<li>We do nothing to smartly collapse the AIG into vectors to take advantage
+of, e.g., 32-bit bitwise ANDs, or anything like that.</li>
+
+</ul>
+
+<p>The top-level function is @(see aig2c-compile).</p>")
+
+
+(define aig2c-boolean-sanity-check-p ((type   stringp)
+                                      (op-and stringp)
+                                      (op-not stringp))
+  :parents (aig2c-config-p)
+  (b* ((tokens (str::strtok type '(#\Space #\Newline #\Tab)))
+       ((unless (or (equal tokens '("bool"))
+                    (equal tokens '("const" "bool"))))
+        t)
+       ((unless (and (equal op-and "&&")
+                     (equal op-not "!")))
+        (raise "Insane AIG2C configuration.  You are trying to make an aig2c ~
+                configuration using bool variables, but with operators other ~
+                than && and !.  The bitwise operators won't work here.  See ~
+                :xdoc aig2c-config-p for more information.")))
+    t))
+
+(cutil::defaggregate aig2c-config
+  :parents (aig2c)
+  :short "Configuration object that governs how we translate an AIG into C/C++."
+
+  :long "<p>The default configuration generates code for carry out 32-bit wide
+AIG simulations on @('uint32_t')s.  Changing to, e.g., 8-bit or 64-bit wide
+simulations is trivial.</p>
+
+<p>But the C++ @('bool') type is special.  If you want to use it, you need to
+make sure to use @('&&') and @('!') instead of @('&') and @('~').  Consider for
+instance this C++ program:</p>
+
+@({
+  int main() {
+    bool b = true;
+    cout << \"B is \" << (bool)b << endl;    // Prints 'B is 1'
+    b = ~b;
+    cout << \"~B is \" << (bool)b << endl;   // Prints '~B is 1' (!!!)
+    return 0;
+  }
+})
+
+<p>We try to at least do a rudimentary check for incorrect uses of @('bool'),
+but it's not any sort of foolproof thing.</p>"
+
+  :tag :aig2c-config
+
+  ((prefix stringp
+           :rule-classes :type-prescription
+           :default "_temp"
+           "The naming prefix to use for generating temporary variable
+            names. Typically you just want this to be something that won't
+            clash with other names in the rest of your C program.  By default
+            we use @('\"_temp\"').")
+
+   (type   stringp
+           :rule-classes :type-prescription
+           :default "const uint32_t"
+           "The C/C++ data type to use for each temporary variable.  By default
+            we use @('\"const uint32_t\"'), which might be appropriate for
+            32-bit wide simulations.  For single-bit simulations, you could
+            use, e.g., @('\"const bool\"') here, but <b>WARNING</b> if you use
+            @('bool') or @('const bool') you need to also change the operators
+            from @('&') and @('~') to @('&&') and @('!'), respectively.  See
+            @(see aig2c) for more information.")
+
+   (op-and stringp
+           :rule-classes :type-prescription
+           :default "&"
+           "The C/C++ operator to use to AND expressions of this @('type').
+            Typically this should be @('&') for integers or @('&&') for
+            booleans.")
+
+   (op-not stringp
+           :rule-classes :type-prescription
+           :default "~"
+           "The C/C++ operator used to NOT expressions of this type.  Typically
+            this should be @('~') for integers or @('!') for booleans."))
+
+  :require
+  ((aig2c-config-sanity-constraint
+    (aig2c-boolean-sanity-check-p type op-and op-not)
+    :rule-classes nil)))
+
+(defconst *aig2c-default-config*
+  (make-aig2c-config))
+
+
+(define aig2c-maketemps
+  :parents (aig2c)
+  :short "Create the temporary C code variable names that will be used for each
+each AIG node, for a single AIG."
+
+  ((x       "The AIG to process.")
+   (config  aig2c-config-p)
+   (tempmap "Answer we are accumulating.  Fast alist assigning AIG nodes and
+             variables to fresh, \"temporary\" names."
+            (string-listp (alist-vals tempmap)))
+   (db      "Name database to make sure the names we are generating are
+             really unique."
+            vl::vl-namedb-p))
+
+  :returns
+  (mv (new-map "Fast alist mapping AIG nodes to their newly assigned names.")
+      (new-db  "Updated name database."
+               vl::vl-namedb-p
+               :hyp (and (force (vl::vl-namedb-p db))
+                         (force (aig2c-config-p config)))))
+
+  :verify-guards nil
+  (b* (((when (hons-get x tempmap))
+        ;; Already have a name for this node.
+        (mv tempmap db))
+       ((mv fresh-name db) (vl::vl-namedb-indexed-name
+                            (aig2c-config->prefix config)
+                            db))
+       (tempmap            (hons-acons x fresh-name tempmap))
+       ((when (atom x))
+        (mv tempmap db))
+       ((when (not (cdr x))) ;; NOT node
+        (aig2c-maketemps (car x) config tempmap db))
+       ((mv tempmap db) (aig2c-maketemps (car x) config tempmap db))
+       ((mv tempmap db) (aig2c-maketemps (cdr x) config tempmap db)))
+    (mv tempmap db))
+  ///
+  (defthm string-listp-of-alist-vals-of-aig2c-maketemps
+    (b* (((mv new-map ?new-db)
+          (aig2c-maketemps x config tempmap db)))
+      (implies (and (force (string-listp (alist-vals tempmap)))
+                    (force (vl::vl-namedb-p db))
+                    (force (aig2c-config-p config)))
+               (string-listp (alist-vals new-map)))))
+
+  (defthm aig2c-maketemps-monotonic
+    (b* (((mv new-map ?new-db)
+          (aig2c-maketemps x config tempmap db)))
+      (implies (subsetp-equal keys (alist-keys tempmap))
+               (subsetp-equal keys (alist-keys new-map)))))
+
+  (verify-guards aig2c-maketemps))
+
+
+(define aig2c-maketemps-list
+  :parents (aig2c)
+  :short "Create the temporary C code variable names for a whole list of AIGs."
+  :long "<p>This just extends @(see aig2c-maketemps) to an AIG list.</p>"
+
+  ((x       "AIG list to process.")
+   (config  aig2c-config-p)
+   (tempmap (string-listp (alist-vals tempmap)))
+   (db      vl::vl-namedb-p))
+
+  :returns
+  (mv (new-map)
+      (new-db vl::vl-namedb-p :hyp (and (force (vl::vl-namedb-p db))
+                                        (force (aig2c-config-p config)))))
+
+  (b* (((when (atom x))
+        (mv tempmap db))
+       ((mv tempmap db)
+        (aig2c-maketemps (car x) config tempmap db)))
+    (aig2c-maketemps-list (cdr x) config tempmap db))
+  ///
+  (defthm string-listp-of-alist-vals-of-aig2c-maketemps-list
+    (b* (((mv new-map ?new-db)
+          (aig2c-maketemps-list x config tempmap db)))
+      (implies (and (force (string-listp (alist-vals tempmap)))
+                    (force (vl::vl-namedb-p db))
+                    (force (aig2c-config-p config)))
+               (string-listp (alist-vals new-map)))))
+
+  (defthm aig2c-maketemps-list-monotonic
+    (b* (((mv new-map ?new-db)
+          (aig2c-maketemps-list x config tempmap db)))
+      (implies (subsetp-equal keys (alist-keys tempmap))
+               (subsetp-equal keys (alist-keys new-map)))))
+
+  (verify-guards aig2c-maketemps-list))
+
+
+(define aig2c-prologue
+  :parents (aig2c)
+  :short "Create the assignments for AIG constant and variable nodes."
+
+  ((input-init "Mapping from every AIG variable to a C code fragment that
+                should be used to initialize it."
+               (string-listp (alist-vals input-init)))
+
+   (tempmap    "Fast alist mapping every AIG variable (and other nodes) to
+                the temporary variable name to use."
+               (string-listp (alist-vals tempmap)))
+
+   (config     aig2c-config-p)
+
+   (code       "The C code fragment we are building, a character list in reverse
+                order (e.g., for use with @(see str::revappend-chars))."
+               character-listp))
+
+  :returns (new-code character-listp
+                     :hyp (force (character-listp code)))
+
+  (b* (((when (atom input-init))
+        code)
+       ((when (atom (car input-init)))
+        ;; Bad alist convention
+        (aig2c-prologue (cdr input-init) tempmap config code))
+       (var   (caar input-init))            ;; The AIG variable
+       (c-rhs (cdar input-init))            ;; C code fragment to initialize this var
+       (c-lhs (cdr (hons-get var tempmap))) ;; C variable name for this AIG var
+       ((unless c-lhs)
+        (raise "Variable ~x0 not bound in tempmap!")
+        code)
+
+       ;; Now print, e.g., "int temp_123 = init;"
+       (code (str::revappend-chars "  "  code))
+       (code (str::revappend-chars (aig2c-config->type config) code))
+       (code (str::revappend-chars " "   code))
+       (code (str::revappend-chars c-lhs code))
+       (code (str::revappend-chars " = " code))
+       (code (str::revappend-chars c-rhs code))
+       (code (list* #\Newline #\; code)))
+    (aig2c-prologue (cdr input-init) tempmap config code)))
+
+#||
+;; Example:
+(str::rchars-to-string
+ (aig2c-prologue
+  '((nil . "0")
+    (t   . "~temp_false")
+    (a . "inputs.a")
+    (b . "inputs.b")
+    (c . "inputs.c"))
+  (make-fast-alist '((nil . "temp_false")
+                     (t . "temp_true")
+                     (a . "temp_123")
+                     (b . "temp_124")
+                     (c . "temp_125")))
+  (make-aig2c-config)
+  nil))
+||#
+
+(define aig2c-main
+  :parents (aig2c)
+  :short "Create the assignments for a single AIG."
+
+  ((x          "The AIG we are compiling.")
+
+   (seen       "Fast alist mapping AIG nodes we've already compiled to T.")
+
+   (tempmap    "Fast alist mapping every AIG node to its C variable name."
+               (string-listp (alist-vals tempmap)))
+
+   (config     aig2c-config-p)
+
+   (code       "The C code fragment we are building, a character list in reverse
+                order (e.g., for use with @(see str::revappend-chars))."
+               character-listp))
+
+  :verify-guards nil
+  :returns (mv (new-code character-listp
+                         :hyp (force (character-listp code)))
+               seen)
+
+  (b* ((name (cdr (hons-get x tempmap)))
+
+       ((unless name)
+        ;; We shouldn't hit this if we've constructed the tempmap correctly.
+        (raise "AIG node isn't bound!")
+        (mv code seen))
+
+       ((when (atom x))
+        ;; We don't need to do anything in this case because we've dealt
+        ;; with all the variables and constants in the prologue.
+        (mv code seen))
+
+       ((when (hons-get x seen))
+        ;; We already initialized this variable so we don't need to process it
+        ;; again.
+        (mv code seen))
+
+       (seen (hons-acons x t seen))
+
+       ;; Recursively process fanins
+       ((mv code seen)
+        (aig2c-main (car x) seen tempmap config code))
+
+       ((mv code seen)
+        (if (cdr x)
+            (aig2c-main (cdr x) seen tempmap config code)
+          (mv code seen)))
+
+       (code (list* #\Space #\Space code))
+       (code (str::revappend-chars (aig2c-config->type config) code))
+       (code (cons #\Space code))
+       (code (str::revappend-chars name code))
+       (code (list* #\Space #\= #\Space code))
+
+       (car-name (cdr (hons-get (car x) tempmap)))
+       ((unless car-name)
+        (raise "AIG node for CAR isn't bound!")
+        (mv code seen))
+
+       ((unless (cdr x))
+        (b* ((code (str::revappend-chars (aig2c-config->op-not config) code))
+             (code (str::revappend-chars car-name code))
+             (code (list* #\Newline #\; code)))
+          (mv code seen)))
+
+       ;; Else, an AND node.
+       (cdr-name (cdr (hons-get (cdr x) tempmap)))
+       ((unless cdr-name)
+        (raise "AIG node for CDR isn't bound!")
+        (mv code seen))
+
+       (code (str::revappend-chars car-name code))
+       (code (cons #\Space code))
+       (code (str::revappend-chars (aig2c-config->op-and config) code))
+       (code (cons #\Space code))
+       (code (str::revappend-chars cdr-name code))
+       (code (list* #\Newline #\; code)))
+    (mv code seen))
+
+  ///
+  (verify-guards aig2c-main))
+
+
+#||
+;; Example:
+
+(b* ((x0 'a)
+     (x1 'b)
+     (x2 'c)
+     (x3 (aig-not x1))
+     (x4 (aig-not x2))
+     (x5 (aig-and x1 x4))
+     (x6 (aig-and x0 x3))
+     (x7 (aig-and x5 x6))
+     (x8 (aig-and x7 x4))
+
+     (tempmap `((,x0 . "_var0")
+                (,x1 . "_var1")
+                (,x2 . "_var2")
+                (,x3 . "_foo3")
+                (,x4 . "_foo4")
+                (,x5 . "_foo5")
+                (,x6 . "_foo6")
+                (,x7 . "_foo7")
+                (,x8 . "_foo8")))
+     ((with-fast tempmap))
+     ((mv code seen)
+      (aig2c-main x8 'seen tempmap
+                  (make-aig2c-config)
+                  nil))
+     ((mv code2 seen2)
+      (aig2c-main x8 'seen2 tempmap
+                  (make-aig2c-config :type "const bool"
+                                     :op-and "&&"
+                                     :op-not "!")
+                  nil)))
+  (fast-alist-free seen)
+  (fast-alist-free seen2)
+  (list :code (str::rchars-to-string code)
+        :code2 (str::rchars-to-string code2)))
+
+||#
+
+(define aig2c-main-list
+  :parents (aig2c)
+  :short "Create the assignments for a list of AIGs."
+  ((x "The AIG list to compile.")
+   (seen)
+   (tempmap (string-listp (alist-vals tempmap)))
+   (config  aig2c-config-p)
+   (code    character-listp))
+  :returns (mv (new-code character-listp
+                         :hyp (force (character-listp code)))
+               seen)
+  (b* (((when (atom x))
+        (mv code seen))
+       ((mv code seen)
+        (aig2c-main (car x) seen tempmap config code)))
+    (aig2c-main-list (cdr x) seen tempmap config code)))
+
+
+
+
+(define aig2c-epilogue
+  :parents (aig2c)
+  :short "Create the assignments from AIG nodes to outputs."
+  ((aig-alist "Alist binding names to AIGs."
+              (string-listp (alist-keys aig-alist)))
+   (tempmap   "Binds each AIG to its temporary C variable name."
+              (string-listp (alist-vals tempmap)))
+   (code      character-listp))
+  :returns (new-code character-listp
+                     :hyp (force (character-listp code)))
+  (b* (((when (atom aig-alist))
+        code)
+       ((when (atom (car aig-alist)))
+        ;; Bad alist convention
+        (aig2c-epilogue (cdr aig-alist) tempmap code))
+       ((cons c-out-name aig1) (car aig-alist))
+       (c-temp-name (cdr (hons-get aig1 tempmap)))
+       ((unless c-temp-name)
+        (raise "AIG not bound in tempmap!")
+        code)
+       (code (list* #\Space #\Space code))
+       (code (str::revappend-chars c-out-name code))
+       (code (list* #\Space #\= #\Space code))
+       (code (str::revappend-chars c-temp-name code))
+       (code (list* #\Newline #\; code)))
+    (aig2c-epilogue (cdr aig-alist) tempmap code)))
+
+
+(define aig2c-compile
+  :parents (aig2c)
+  :short "Compile an alist of AIGs into a C code fragment."
+
+  ((aig-alist   "Name &rarr; AIG Alist.  The names here must be strings and should
+                 refer to proper lvalues in your C code, i.e., they might be
+                 variables, or fields in a structure that you want to
+                 initialize. For the C code to work, these names must be
+                 compatible with the datatype you want to use."
+                (string-listp (alist-keys aig-alist)))
+
+   (input-names "AIG Variable &rarr; Name Alist.  This should bind every AIG
+                 variable to a string that will be used as its initial value in
+                 the C code.  Each name should be a C code fragment that
+                 evaluates without side effects."
+                (string-listp (alist-vals input-names)))
+
+   &key
+   ((config     "Controls names, types, and operators to use in the C code being
+                 generated."
+                aig2c-config-p)
+    '*aig2c-default-config*))
+
+  :returns (mv (err    "NIL on success, or an error @(see msg) on failure,
+                        suitable for printing with @('~@').")
+
+               (c-code "C code fragment that implements this AIG, on success,
+                        or the empty string on failure."
+                       stringp :rule-classes :type-prescription))
+
+  (b* ((output-c-names (alist-keys aig-alist))
+       (output-aigs    (alist-vals aig-alist))
+
+       (input-vars     (alist-keys input-names))
+       (input-c-names  (alist-vals input-names))
+
+       (all-aig-vars   (aig-vars-1pass output-aigs))
+
+       ((unless (uniquep input-vars))
+        (mv (msg "Error: multiple bindings for input variables ~x0"
+                 (duplicated-members input-vars))
+            ""))
+
+       ((unless (sets::subset all-aig-vars (sets::mergesort input-vars)))
+        (mv (msg "Some AIG variables do not have C input names: ~x0"
+                 (sets::difference all-aig-vars (sets::mergesort input-vars)))
+            ""))
+
+       ;; I originally thought I might check for unique input-c-names and
+       ;; unique output-c-names.  This would be important if we were going to
+       ;; avoid prologue and epilogue parts.  But by separating out the
+       ;; prologue and epilogue, there's no danger of overwriting an input
+       ;; before we use it again.  And, moreover, it might sometimes be useful
+       ;; to write the same AIG to multiple places, or to read the same
+       ;; location and feed it into several parts of the AIG.  So I no longer
+       ;; have these checks.
+
+       (all-c-names     (append input-c-names output-c-names))
+       (db              (vl::vl-starting-namedb all-c-names))
+       ((mv tempmap db) (aig2c-maketemps-list output-aigs config 'aig2c-tempmap db))
+       (-               (vl::vl-free-namedb db))
+
+       ;; Most AIGs, built with things like AIG-AND and AIG-NOT, won't include
+       ;; NIL or T because it can get constant-propagated.  But if these do
+       ;; occur, they will show up in the tempmap.  We'll hack the
+       ;; input-c-names list to handle these in the prologue.
+       (input-names
+        (if (hons-get nil tempmap)
+            (cons (cons nil "0") input-names)
+          input-names))
+
+       (input-names
+        (if (hons-get t tempmap)
+            (cons (cons t (str::cat (aig2c-config->op-not config)
+                                    "((" (aig2c-config->type config) ")0)"))
+                  input-names)
+          input-names))
+
+       ;; Assign C expressions to each input variable
+       (code nil)
+       (code (aig2c-prologue input-names tempmap config code))
+       ((mv code seen)
+        (aig2c-main-list output-aigs 'aig2c-seen tempmap config code))
+       (- (fast-alist-free seen))
+       (code (aig2c-epilogue aig-alist tempmap code))
+       (- (fast-alist-free tempmap)))
+
+    (mv nil (str::rchars-to-string code))))
+
+
+#||
+
+(defconst *bool-config*
+  (make-aig2c-config :type "bool" :op-and "&&" :op-not "!"))
+
+(aig2c-compile '(("foo" . nil)) nil)
+(aig2c-compile '(("foo" . t)) nil)
+
+(aig2c-compile '(("foo" . nil)) nil :config *bool-config*)
+(aig2c-compile '(("foo" . t)) nil :config *bool-config*)
+
+(aig2c-compile '(("foo" . (t . nil))) nil)
+(aig2c-compile '(("foo" . (nil . nil))) nil)
+
+(aig2c-compile '(("foo" . (t . nil))) nil :config *bool-config*)
+(aig2c-compile '(("foo" . (nil . nil))) nil :config *bool-config*))
+
+(aig2c-compile '(("foo" . t)) nil)
+(aig2c-compile '(("foo" . t)) nil
+               :config (change-aig2c-config *aig2c-default-config*
+                                            :prefix "xyz"
+                                            :type "vector"))
+
+(aig2c-compile `(("foo" . ,(aig-and 'a 'b)))
+               `((a . "inputs.a")
+                 (b . "inputs.b"))
+               :config (make-aig2c-config))
+
+
+(let* ((line1 'a)
+       (line2 'b)
+       (line3 'c)
+       (line4 (aig-not line3))
+       (line5 (aig-and line2 line4))
+       (line6 (aig-not line1))
+       (line7 (aig-and line3 line6))
+       (line8 (aig-and line7 line5)))
+  (aig2c-compile `(("out1" . ,line5)
+                   ("out2" . ,line8))
+                 `((a . "inputs.a")
+                   (b . "inputs.b")
+                   (c . "inputs.c"))))
+
+||#
+
+
diff -Nru acl2-6.2/books/centaur/aig/aiger.lisp acl2-6.3/books/centaur/aig/aiger.lisp
--- acl2-6.2/books/centaur/aig/aiger.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/aiger.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -1752,6 +1752,7 @@
            (maybe-byte-p (mv-nth 7 (aiger-parse-header stream buf state))))
   :rule-classes (:rewrite :type-prescription))
 
+(local (in-theory (disable nth-when-zp)))
 (defmvtypes aiger-parse-header (nil natp natp natp natp natp natp nil nil))
 
 (local (in-theory (disable aiger-parse-header)))
diff -Nru acl2-6.2/books/centaur/aig/base.lisp acl2-6.3/books/centaur/aig/base.lisp
--- acl2-6.2/books/centaur/aig/base.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/base.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -1,1520 +1,6 @@
-; Centaur AIG Library
-; Copyright (C) 2008-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Sol Swords <sswords@centtech.com>
-;
-; July 2011, Jared added lots of documentation.
-
 (in-package "ACL2")
-(include-book "xdoc/top" :dir :system)
-(include-book "../misc/hons-alphorder-merge")
-
-; aig/base.lisp
-;   - Semantics of AIGs (aig-eval) and FAIGs (faig-eval)
-;   - Primitive AIG constructors (aig-not, aig-and, ...)
-;   - Substitution operations: aig-restrict, aig-compose, aig-partial-eval
-;   - FAIG versions of the substitution operations
-
-
-; BOZO consider using defprojection throughout?
-
-(defxdoc aig
-  :short "Centaur AIG Library"
-
-  :long "<p><b>AIGs</b> (And/Inverter Graphs) are a representation of Boolean
-functions, using only <i>and</i> and <i>not</i> operations.</p>
-
-<p><b><see topic='@(url faig)'>FAIGs</see></b> (Four-valued AIGs) are a related
-concept, where two AIGs are pasted together to represent a function in
-four-valued logic.</p>
-
-
-<h3>Motivation for AIGs</h3>
-
-<p>There are many ways to represent Boolean functions.  One alternative is
-to use BDDs, e.g., we provide a @(see ubdds) library.  In comparison with
-BDDs, AIGs are:</p>
-
-<ul>
-
-<li>cheaper to construct, e.g., if we want to <i>or</i> together the functions
-@('f') and @('g'), it only takes a few conses with AIGs, whereas with BDDs we
-need to walk through @('f') and @('g') to construct a new structure (which
-might be quite large); but</li>
-
-<li>more expensive to compare, e.g., with BDDs we can determine if @('f') and
-@('g') are equal via pointer equality, whereas with AIGs this is a
-satisfiablity problem.</li>
-
-</ul>
-
-<p>This tradeoff is often worth it because you can simplify and reduce AIGs
-after they have been constructed, but before comparing them.  For instance, our
-@(see bddify) algorithm converts an AIG into a BDD, and since it can often
-\"prune\" branches of the AIG that turn out to be irrelevant, it can be much
-more efficient than directly constructing BDDs.  A more sophisticated tool is
-@(see abc), which provides various kinds of rewriting and reductions on AIGs.
-These reductions can be used before calling a SAT solver or @('bddify') to make
-the input AIGs much smaller and easier to process.</p>
-
-<p>Another alternative would be to use a richer language such as Lisp-style
-s-expressions, where operations other than <i>and</i> and <i>not</i> could be
-used directly.  On the surface, this approach would appear to be more compact,
-e.g., we can represent @('(or a b)') as a single operation instead of as
-something like @('(not (and (not a) (not b)))').</p>
-
-<p>But another critical part of memory efficiency is structure sharing.  That
-is, suppose that we already need @('(not a)') and @('(not b)') elsewhere in the
-function.  With s-expressions, these terms would have nothing in common with
-@('(or a b)'), but with AIGs we can reuse the existing parts of
-@('(not (and (not a) (not b)))').</p>
-
-
-<h3>Representation of AIGs</h3>
-
-<p>We always construct AIGs with @(see hons) so that existing pieces of AIGs
-will be automatically reused.  We represent AIGs as arbitrary cons trees, which
-we interpret as follows:</p>
-
-<ul>
-
-<li>@('T') represents the constant-true function.</li>
-
-<li>@('NIL') represents the constant-false function.</li>
-
-<li>Any other atom represents a Boolean variable (i.e., an input to the
-function.)</li>
-
-<li>A cons of the form @('(A . NIL)') represents the negation of @('A').</li>
-
-<li>Any other cons, @('(A . B)'), represents the conjunction of @('A') and
-@('B').</li>
-
-</ul>
-
-<p>This meaning of cons trees is given by the evaluation function @(see
-aig-eval), which returns the (Boolean) value of an AIG under some particular
-assignment to its variables.  Note that every ACL2 object is a well-formed AIG
-under this definition.</p>
-
-
-<h3>Library Functions</h3>
-
-<p>We provide some basic, low-level @(see aig-constructors) for building
-AIGs (<i>and</i>, <i>or</i>, etc.).  We prove these operations correct with
-respect to @(see aig-eval).</p>
-
-<p>There are also higher-level operations such as @(see aig-restrict) and @(see
-aig-compose) allow you to substitute into AIGs.</p>
-
-<p>It is often important to know which variables occur in an AIG.  One way to
-do this is with @(see aig-vars).</p>
-
-<p>The @(see bddify) algorithm provides a way to construct a BDD from an AIG.
-This is also used as the basis for an efficient @(see GL) symbolic counterpart
-of @(see aig-eval).</p>
-
-<p>BOZO other things that we haven't released yet.</p>")
-
-
-
-; -----------------------------------------------------------------------------
-;
-;                            EVALUATING AIGS
-;
-; -----------------------------------------------------------------------------
-
-(defsection aig-env-lookup-missing-output
-  :parents (aig-eval)
-  :short "Stub for warnings about missing variables in AIG evaluation."
-
-  :long "<p>This stub is called when @(see aig-eval) encounters a variable in
-the AIG that has no binding in the environment.  It is generally configured
-with @(see aig-env-lookup-missing-action).</p>"
-
-  (defstub aig-env-lookup-missing-output (name) nil))
-
-
-(defsection aig-env-lookup-missing-action
-  :parents (aig-eval)
-  :short "Configure warnings about missing variables in AIG evaluation."
-
-  :long "<p>Ordinarily @(see aig-eval) treats any variables that are not bound
-in the environment as having value @('t').  But a missing bindings could be the
-result of a bug in your program, so by default @('aig-eval') is set up to print
-a warning if this happens.</p>
-
-<p>@(call aig-env-lookup-missing-action) allows you to control whether these
-warnings are printed, and also whether @(see break$) should be called.  The
-valid @('action')s are:</p>
-
-<ul>
- <li>@('nil'), silently bind the variable to @('t'),</li>
- <li>@(':warn') (the default), print a warning but do not @('break$'), and</li>
- <li>@(':break'), to print the warning and then call @('break$').</li>
-</ul>"
-
-  (defconst *aig-env-lookup-warn-missing-binding*
-    ;; Even with the stub and defattach, it is useful to have this "constant"
-    ;; so that, in raw lisp, we can use a let-binding to disable missing output
-    ;; warnings temporarily, e.g., so that if a SAT solver produces an
-    ;; incomplete counterexample, we don't print warnings when we check it.
-    ;; Doing this with defattach directly would be hard/impossible due to
-    ;; attachment being an event.
-    t)
-
-  (defun aig-env-lookup-missing-quiet (name)
-    (declare (xargs :guard t) (ignore name))
-    nil)
-
-  (defun aig-env-lookup-missing-complain (name)
-    (declare (xargs :guard t))
-    (and *aig-env-lookup-warn-missing-binding*
-         (cw "WARNING: Missing variable binding ~x0 in AIG-ENV-LOOKUP; ~
-              assigning T~%"
-             name)))
-
-  (local (in-theory (disable (break$))))
-
-  (defun aig-env-lookup-missing-break (name)
-    (declare (xargs :guard t))
-    (and *aig-env-lookup-warn-missing-binding*
-         (prog2$ (cw "WARNING: Missing variable binding ~x0 in ~x1; assigning ~
-                      T. To avoid this break, run ~x2, where action is NIL or ~
-                      :WARN.~%"
-                     name
-                     'aig-env-lookup
-                     '(aig-env-lookup-missing-action action))
-                 (break$))))
-
-  (defmacro aig-env-lookup-missing-action (val)
-    (case val
-      ((nil) '(defattach aig-env-lookup-missing-output
-                aig-env-lookup-missing-quiet))
-      (:warn '(defattach aig-env-lookup-missing-output
-                aig-env-lookup-missing-complain))
-      (:break '(defattach aig-env-lookup-missing-output
-                 aig-env-lookup-missing-break))
-      (t (er hard 'aig-env-lookup-missing-action
-             "Expected argument NIL, :WARN, or :BREAK.~%"))))
-
-  (aig-env-lookup-missing-action :warn))
-
-
-;;(defsection aig-cases
-;;  :parents (aig)
-;;  :short "Control-flow macro to split into cases on what kind of AIG you have
-;;encountered."
-;;  :long "@(def aig-cases)"
-
-;;  (defmacro aig-cases (x &key true false var inv and)
-;;    `(let ((aig-cases-var ,x))
-;;       (cond
-;;        ((eq aig-cases-var t) ,true)
-;;        ((eq aig-cases-var nil) ,false)
-;;        ((atom aig-cases-var) ,var)
-;;        ((eq (cdr aig-cases-var) nil) ,inv)
-;;        (t ,and)))))
-
-(defsection aig-cases
-  :parents (aig)
-  :short "Control-flow macro to split into cases on what kind of AIG you have
-encountered."
-  :long "@(def aig-cases)"
-
-  (defmacro aig-cases (x &key true false var inv and)
-    `(let ((aig-cases-var ,x))
-       (cond
-        ((atom aig-cases-var)
-         (cond ((eq aig-cases-var t) ,true)
-               ((eq aig-cases-var nil) ,false)
-               (t ,var)))
-        ((eq (cdr aig-cases-var) nil) ,inv)
-        (t ,and)))))
-
-
-
-(defsection aig-eval
-  :parents (aig)
-  :short "@(call aig-eval) evaluates @('x'), an @(see aig), under the
-environment @('env'), producing a Boolean result."
-
-  :long "<p>The @('env') should be a fast alist (see @(see fast-alists)) that
-binds variables in the AIG to values.  Typically it should bind every variable
-in the AIG to a Boolean value.</p>
-
-<p>This function is @(see memoize)d.  You should typically free its memo table
-after you are done with whatever @('env') you are using, to avoid excessive
-memory usage.  (We don't use @(':forget t') because you often want to evaluate
-several related AIGs.)</p>
-
-<p>Unbound variables are given the default value @('t') instead of @('nil')
-because this makes theorems about @(see faig) evaluation work out more
-nicely (it makes unbound FAIG variables evaluate to @('X')).</p>
-
-<p>This function essentially defines the semantics of AIGs.</p>"
-
-  ;; [Jared] BOZO it might be good to add a check that the variables are indeed
-  ;; bound to Booleans.
-
-  (defun aig-env-lookup (x env)
-    (declare (xargs :guard t))
-    (let ((look (hons-get x env)))
-      (if look
-          ;; [Jared] I was once tempted to change this to produce an always
-          ;; Boolean result, since it would seem nicer to do that here than in
-          ;; aig-eval.  But this function is also used in AIG-COMPOSE, and it
-          ;; is not valid to Boolean-fix it there.
-          (cdr look)
-        (mbe :logic t
-             :exec
-             (if *aig-env-lookup-warn-missing-binding*
-                 (prog2$ (aig-env-lookup-missing-output x)
-                         t)
-               t)))))
-
-  (defun aig-eval (x env)
-    (declare (xargs :guard t))
-    (aig-cases x
-               :true t
-               :false nil
-               :var (and (aig-env-lookup x env) t)
-               :inv (not (aig-eval (car x) env))
-               :and (and (aig-eval (car x) env)
-                         (aig-eval (cdr x) env))))
-
-  ;; [Jared] note, changed memoization condition from just (consp x) to exclude
-  ;; not nodes; this matches aig-vars and I think is probably what we want.
-  (memoize 'aig-eval :condition '(and (consp x) (cdr x))))
-
-
-(defsection aig-eval-list
-  :parents (aig-eval)
-  :short "@(call aig-eval-list) evaluates a list of AIGs."
-
-  ;; BOZO formal is named benv right now, eventually rename to env but we need
-  ;; to patch up GL so it doesn't care about formals named env.
-  (defun aig-eval-list (x benv)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (aig-eval (car x) benv)
-            (aig-eval-list (cdr x) benv)))))
-
-
-(defsection aig-eval-alist
-  :parents (aig-eval)
-  :short "@(call aig-eval-alist) evaluates an AIG Alist (an alist binding keys
-to AIGs)."
-
-  :long "<p>The alist @('x') does not need to be fast, and we produce an
-ordinary (slow) alist as a result.</p>"
-
-  (defun aig-eval-alist (x env)
-    (declare (xargs :guard t))
-    (cond ((atom x)
-           nil)
-          ((atom (car x))
-           ;; Bad-alist convention
-           (aig-eval-alist (cdr x) env))
-          (t
-           (cons (cons (caar x) (aig-eval (cdar x) env))
-                 (aig-eval-alist (cdr x) env))))))
-
-
-
-(defsection aig-eval-alists
-  :parents (aig-eval)
-  :short "Evaluate a list of AIG Alists."
-
-  (defun aig-eval-alists (x env)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (aig-eval-alist (car x) env)
-            (aig-eval-alists (cdr x) env)))))
-
-
-
-
-; -----------------------------------------------------------------------------
-;
-;                        COLLECTING AIG VARIABLES
-;
-; -----------------------------------------------------------------------------
-
-(defsection aig-vars
-  :parents (aig)
-  :short "@(call aig-vars) returns the list of variables used in the AIG
-@('X')."
-
-;; BOZO the :long here refers to the unreleased sexpr library, but I don't want
-;; to redo all that documentation for AIGs.
-
-  :long "<p>This is one scheme for collecting variables from an AIG.  We
-memoize the whole computation and return ordered lists so that merging is
-linear.  This can be very expensive.  See @(see 4v-sexpr-vars) for an analagous
-discussion.</p>"
-
-  (defun aig-vars (x)
-    (declare (xargs :guard t
-                    :verify-guards nil))
-    (aig-cases x
-               :true  nil
-               :false nil
-               :var   (mbe :logic (sets::insert x nil)
-                           :exec (hons x nil))
-               :inv   (aig-vars (car x))
-               :and   (mbe :logic (sets::union (aig-vars (car x))
-                                               (aig-vars (cdr x)))
-                           :exec (hons-alphorder-merge (aig-vars (car x))
-                                                       (aig-vars (cdr x))))))
-
-  (defthm atom-listp-aig-vars
-    (atom-listp (aig-vars x)))
-
-  (defthm true-listp-aig-vars
-    (true-listp (aig-vars x))
-    :rule-classes :type-prescription)
-
-  (defthm setp-aig-vars
-    (sets::setp (aig-vars x))
-    :hints(("Goal" :in-theory (enable* (:ruleset sets::primitive-rules)))))
-
-  (verify-guards aig-vars
-    :hints(("Goal" :in-theory (enable* (:ruleset sets::primitive-rules)))))
-
-  (memoize 'aig-vars :condition '(and (consp x) (cdr x))))
-
-
-
-
-; -----------------------------------------------------------------------------
-;
-;                              AIG CONSTRUCTION
-;
-; -----------------------------------------------------------------------------
-
-(defxdoc aig-constructors
-  :parents (aig)
-  :short "Low-level functions for constructing AIGs.")
-
-
-
-(defsection aig-not
-  :parents (aig-constructors)
-  :short "@(call aig-not) constructs an AIG representing @('(not x)')."
-
-  :long "<p>This could be implemented as @('(hons x nil)'), but we at least
-take care to fold constants and avoid creating double negatives.</p>"
-
-  (defund aig-not (x)
-    (declare (xargs :guard t))
-    (cond ((eq x nil) t)
-          ((eq x t) nil)
-          ((and (consp x) (eq (cdr x) nil))
-           (car x))
-          (t
-           (hons x nil))))
-
-  (local (in-theory (enable aig-not)))
-
-  (defthm aig-eval-not
-    (equal (aig-eval (aig-not x) env)
-           (not (aig-eval x env)))))
-
-
-
-(defsection aig-and
-  :parents (aig-constructors)
-  :short "@(call aig-and) constructs an AIG representing @('(and x y)')."
-
-  :long "<p>This could have been implemented as @('(hons x y)'), but we take
-care to fold constants and reduce @('x & x') and @('x & ~x').</p>"
-
-  (defund aig-and (x y)
-    (declare (xargs :guard t))
-    (cond
-     ((or (eq x nil) (eq y nil)) nil)
-     ((eq x t) y)
-     ((eq y t) x)
-     ((hons-equal x y) x)
-     ((and (consp y) (eq (cdr y) nil)
-           (hons-equal (car y) x))
-      nil)
-     ((and (consp x) (eq (cdr x) nil)
-           (hons-equal (car x) y))
-      nil)
-     (t (hons x y))))
-
-  (local (in-theory (enable aig-and)))
-
-  (defthm aig-eval-and
-    (equal (aig-eval (aig-and x y) env)
-           (and (aig-eval x env)
-                (aig-eval y env))))
-
-  (defthm aig-and-constants
-    (and (equal (aig-and nil x) nil)
-         (equal (aig-and x nil) nil)
-         (equal (aig-and x t) x)
-         (equal (aig-and t x) x))))
-
-
-
-(defsection aig-or
-  :parents (aig-constructors)
-  :short "@(call aig-or) constructs an AIG representing @('(or x y)')."
-
-  (defund aig-or (x y)
-    (declare (xargs :guard t))
-    (aig-not (aig-and (aig-not x) (aig-not y))))
-
-  (local (in-theory (enable aig-or)))
-
-  (defthm aig-eval-or
-    (equal (aig-eval (aig-or x y) env)
-           (or (aig-eval x env)
-               (aig-eval y env)))))
-
-
-
-(defsection aig-xor
-  :parents (aig-constructors)
-  :short "@(call aig-xor) constructs an AIG representing @('(xor x y)')."
-
-  (defund aig-xor (x y)
-    (declare (xargs :guard t))
-    (aig-or (aig-and x (aig-not y))
-            (aig-and (aig-not x) y)))
-
-  (local (in-theory (enable aig-xor)))
-
-  (defthm aig-eval-xor
-    (equal (aig-eval (aig-xor x y) env)
-           (xor (aig-eval x env)
-                (aig-eval y env)))))
-
-
-
-(defsection aig-iff
-  :parents (aig-constructors)
-  :short "@(call aig-iff) constructs an AIG representing @('(iff x y)')."
-
-  (defund aig-iff (x y)
-    (declare (xargs :guard t))
-    (aig-or (aig-and x y)
-            (aig-and (aig-not x) (aig-not y))))
-
-  (local (in-theory (enable aig-iff)))
-
-  (defthm aig-eval-iff
-    (equal (aig-eval (aig-iff x y) env)
-           (iff (aig-eval x env)
-                (aig-eval y env)))))
-
-
-
-(defsection aig-implies
-  :parents (aig-constructors)
-  :short "@(call aig-implies) constructs an AIG representing @('(implies x
-  y)')."
-
-  (defund aig-implies (x y)
-    (declare (xargs :guard t))
-    (aig-not (aig-and x (aig-not y))))
-
-  (local (in-theory (enable aig-implies)))
-
-  (defthm aig-eval-implies
-    (equal (aig-eval (aig-implies x y) env)
-           (implies (aig-eval x env)
-                    (aig-eval y env)))))
-
-
-
-(defsection aig-ite
-  :parents (aig-constructors)
-  :short "@(call aig-ite) constructs an AIG representing @('(if a b c)')."
-
-  (defund aig-ite (a b c)
-    (declare (xargs :guard t))
-    (cond ((hons-equal b c)
-           b)
-          ((eq b t)
-           (aig-or a c))
-          (t
-           (aig-or (aig-and a b)
-                   (aig-and (aig-not a) c)))))
-
-  (local (in-theory (enable aig-ite)))
-
-  (defthm aig-eval-ite
-    (iff (aig-eval (aig-ite a b c) env)
-         (if (aig-eval a env)
-             (aig-eval b env)
-           (aig-eval c env)))))
-
-
-(defsection aig-not-list
-  :parents (aig-constructors)
-  :short "@(call aig-not-list) negates every AIG in the list @('x')."
-
-  (defun aig-not-list (x)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (aig-not (car X))
-            (aig-not-list (cdr x))))))
-
-
-(defsection aig-and-list
-  :parents (aig-constructors)
-  :short "@(call aig-and-list) ands together all of the AIGs in the list
-@('x')."
-
-  (defun aig-and-list (x)
-    (declare (xargs :guard t))
-    (if (atom x)
-        t
-      (aig-and (car x)
-               (aig-and-list (cdr x))))))
-
-
-(defsection aig-or-list
-  :parents (aig-constructors)
-  :short "@(call aig-or-list) ors together all of the AIGs in the list @('x')."
-
-  (defun aig-or-list (x)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (aig-or (car x) (aig-or-list (cdr x))))))
-
-
-(defsection aig-and-lists
-  :parents (aig-constructors)
-  :short "@(call aig-and-lists) pairwise <i>and</i>s together the AIGs from the
-lists @('x') and @('y')."
-
-  (defun aig-and-lists (x y)
-    (if (or (atom x) (atom y))
-        nil
-      (cons (aig-and (car x) (car y))
-            (aig-and-lists (cdr x) (cdr y))))))
-
-
-(defsection aig-or-lists
-  :parents (aig-constructors)
-  :short "@(call aig-or-lists) pairwise <i>or</i>s together the AIGs from the
-lists @('x') and @('y')."
-
-  (defun aig-or-lists (x y)
-    (declare (xargs :guard t))
-    (if (or (atom x) (atom y))
-        nil
-      (cons (aig-or (car x) (car y))
-            (aig-or-lists (cdr x) (cdr y))))))
-
-
-(defsection aig-iff-lists
-  :parents (aig-constructors)
-  :short "@(call aig-iff-lists) pairwise <i>iff</i>s together the AIGs from the
-lists @('x') and @('y')."
-
-  (defun aig-iff-lists (x y)
-    (declare (xargs :guard t))
-    (if (or (atom x) (atom y))
-        nil
-      (cons (aig-iff (car x) (car y))
-            (aig-iff-lists (cdr x) (cdr y))))))
-
-
-(defsection aig-xor-lists
-  :parents (aig-constructors)
-  :short "@(call aig-xor-lists) pairwise <i>xor</i>s together the AIGs from the
-lists @('x') and @('y')."
-
-  (defun aig-xor-lists (x y)
-    (declare (xargs :guard t))
-    (if (or (atom x) (atom y))
-        nil
-      (cons (aig-xor (car x) (car y))
-            (aig-xor-lists (cdr x) (cdr y))))))
-
-
-(defsection aig-implies-lists
-  :parents (aig-constructors)
-  :short "@(call aig-implies-lists) pairwise <i>implies</i> together the AIGs
-from the lists @('x') and @('y')."
-
-  (defun aig-implies-lists (x y)
-    (declare (xargs :guard t))
-    (if (or (atom x) (atom y))
-        nil
-      (cons (aig-implies (car x) (car y))
-            (aig-implies-lists (cdr x) (cdr y))))))
-
-
-
-
-; -----------------------------------------------------------------------------
-;
-;                         SUBSTITUTION INTO AIGS
-;
-; -----------------------------------------------------------------------------
-
-(defsection aig-restrict
-  :parents (aig)
-  :short "@(call aig-restrict) performs variable substitution throughout the
-AIG @('x'), replacing any variables bound in @('sigma') with their
-corresponding values."
-
-  :long "<p>@('sigma') should be a fast alist; its name is intended to evoke
-the notion of substitution lists in logic.  Any variables that are not
-mentioned in @('sigma') are left unchanged.</p>
-
-<p>This function is @(see memoize)d.  You should typically free its memo table
-after you are done with whatever @('sigma') you are using, to avoid excessive
-memory usage.  (We don't use @(':forget t') because you often want to restrict
-several related AIGs.)</p>
-
-<p>When all of the variables in @('x') are bound in @('sigma'), and all of the
-values are Boolean, this is equivalent to @(see aig-eval).</p>
-
-<p>Some related functions are @(see aig-compose) and @(see
-aig-partial-eval).</p>"
-
-  (defun aig-restrict (x sigma)
-    (declare (xargs :guard t))
-    (aig-cases x
-               :true t
-               :false nil
-               :var (let ((a (hons-get x sigma)))
-                      (if a
-                          (cdr a)
-                        x))
-               :inv (aig-not (aig-restrict (car x) sigma))
-               :and (let ((a (aig-restrict (car x) sigma)))
-                      (and a (aig-and a (aig-restrict (cdr x) sigma))))))
-
-  (memoize 'aig-restrict :condition '(and (consp x) (cdr x))))
-
-
-(defsection aig-restrict-list
-  :parents (aig-restrict)
-  :short "@(call aig-restrict-list) substitutes into a list of AIGs."
-
-  (defun aig-restrict-list (x sigma)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (aig-restrict (car x) sigma)
-            (aig-restrict-list (cdr x) sigma)))))
-
-
-(defsection aig-restrict-alist
-  :parents (aig-restrict)
-  :short "@(call aig-restrict-alist) substitutes into an AIG Alist (an alist
-binding keys to AIGs)."
-
-  :long "<p>The alist @('x') does not need to be fast, and we produce an
-ordinary (slow) alist as a result.</p>"
-
-  (defun aig-restrict-alist (x sigma)
-    (declare (xargs :guard t))
-    (cond ((atom x)
-           nil)
-          ((atom (car x))
-           ;; Bad-alist convention
-           (aig-restrict-alist (cdr x) sigma))
-          (t
-           (cons (cons (caar x)
-                       (aig-restrict (cdar x) sigma))
-                 (aig-restrict-alist (cdr x) sigma)))))
-
-  (defthm alistp-of-aig-restrict-alist
-    (alistp (aig-restrict-alist x sigma))))
-
-
-(defsection aig-restrict-alists
-  :parents (aig-restrict)
-  :short "@(call aig-restrict-alists) substitutes into a list of AIG Alists."
-
-  (defun aig-restrict-alists (x sigma)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (aig-restrict-alist (car x) sigma)
-            (aig-restrict-alists (cdr x) sigma)))))
-
-
-
-
-; -----------------------------------------------------------------------------
-;
-;                             AIG COMPOSITION
-;
-; -----------------------------------------------------------------------------
-
-(defsection aig-compose
-  :parents (aig)
-  :short "@(call aig-compose) performs variable substitution throughout the AIG
-@('x'), <b>unconditionally</b> replacing every variable in @('x') with its
-binding in @('sigma')."
-
-  :long "<p>@('sigma') should be a fast alist; its name is intended to evoke
-the notion of substitution lists in logic.</p>
-
-<p>This function is @(see memoize)d.  You should typically free its memo table
-after you are done with whatever @('sigma') you are using, to avoid excessive
-memory usage.  (We don't use @(':forget t') because you often want to compose
-several related AIGs.)</p>
-
-<p>This operation is similar to @(see aig-restrict), except that whereas
-@('aig-restrict') leaves unbound variables alone, @('aig-compose') replaces
-them with @('t').  (This has the logically nice property that the variables
-after composition are just the variables in the AIGs of @('sigma').)</p>"
-
-  (defun aig-compose (x sigma)
-    (declare (xargs :guard t))
-    (aig-cases x
-               :true t
-               :false nil
-               :var (aig-env-lookup x sigma)
-               :inv (aig-not (aig-compose (car x) sigma))
-               :and (let ((a (aig-compose (car x) sigma)))
-                      (and a (aig-and a (aig-compose (cdr x) sigma))))))
-
-  (memoize 'aig-compose :condition '(and (consp x) (cdr x))))
-
-
-(defsection aig-compose-list
-  :parents (aig-compose)
-  :short "@(call aig-compose-list) composes into a list of AIGs."
-
-  (defun aig-compose-list (x sigma)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (aig-compose (car x) sigma)
-            (aig-compose-list (cdr x) sigma)))))
-
-
-(defsection aig-compose-alist
-  :parents (aig-compose)
-  :short "@(call aig-compose-alist) composes into an AIG Alist (an alist
-binding keys to AIGs)."
-
-  :long "<p>The alist @('x') does not need to be fast, and we produce an
-ordinary (slow) alist as a result.</p>"
-
-  (defun aig-compose-alist (x sigma)
-    (declare (xargs :guard t))
-    (cond ((atom x)
-           nil)
-          ((atom (car x))
-           ;; Bad alist convention
-           (aig-compose-alist (cdr x) sigma))
-          (t
-           (cons (cons (caar x)
-                       (aig-compose (cdar x) sigma))
-                 (aig-compose-alist (cdr x) sigma))))))
-
-
-(defsection aig-compose-alists
-  :parents (aig-compose)
-  :short "@(call aig-compose-alists) composes into a list of AIG Alists."
-
-  (defn aig-compose-alists (x sigma)
-    (if (atom x)
-        nil
-      (cons (aig-compose-alist (car x) sigma)
-            (aig-compose-alists (cdr x) sigma)))))
-
-
-
-; -----------------------------------------------------------------------------
-;
-;                      PARTIALLY EVALUATING AIGS
-;
-; -----------------------------------------------------------------------------
-
-(defsection aig-partial-eval
-  :parents (aig)
-  :short "@(call aig-partial-eval) evaluates @('x'), an AIG, under the partial
-environment @('env'), producing a new AIG as a result."
-
-  :long "<p>@('env') should be a fast alist that binds some of the variables in
-the AIG to Boolean values.</p>
-
-<p>This function is @(see memoize)d.  You should typically free its memo table
-after you are done with whatever @('env') you are using, to avoid excessive
-memory usage.  (We don't use @(':forget t') because you often want to evaluate
-several related AIGs.)</p>
-
-<p>In ordinary AIG evaluation with @(see aig-eval), any variables that are
-missing from @('env') are just assumed to have a default value.  Because of
-this, every variable can be given a Boolean value and we can evaluate the whole
-AIG to produce a Boolean result.</p>
-
-<p>In partial evaluation, variables that aren't bound in @('env') are left
-alone.  Because of this, the result of a partial evaluation is a
-new (presumably smaller) AIG, instead of a Boolean.</p>
-
-<p>Another way to do partial evaluations is with @(see aig-restrict).  The only
-difference between @('aig-restrict') and @('aig-partial-eval') is that
-@('aig-partial-eval') Boolean-fixes the values in the alist as it looks them
-up.  This has logically nice properties, e.g., since we never replace a
-variable by a subtree, only by a Boolean, we know unconditionally that the
-variables of the resulting AIG are a subset of the variables of the
-original.</p>"
-
-  (defun aig-partial-eval (x env)
-    (declare (xargs :guard t))
-    (aig-cases x
-               :true t
-               :false nil
-               :var (let ((a (hons-get x env)))
-                      (if a (and (cdr a) t) x))
-               :inv (aig-not (aig-partial-eval (car x) env))
-               :and (let ((a (aig-partial-eval (car x) env)))
-                      (and a
-                           (aig-and a (aig-partial-eval (cdr x) env))))))
-
-  ;; [Jared] note: this had no memoize condition, so I added the usual one.
-
-  (memoize 'aig-partial-eval :condition '(and (consp x) (cdr x))))
-
-
-(defsection aig-partial-eval-list
-  :parents (aig-partial-eval)
-  :short "@(call aig-partial-eval-list) partially evaluates a list of AIGs."
-
-  (defun aig-partial-eval-list (x env)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (aig-partial-eval (car x) env)
-            (aig-partial-eval-list (cdr x) env)))))
-
-
-(defsection aig-partial-eval-alist
-  :parents (aig-partial-eval)
-  :short "@(call aig-partial-eval-alist) partially evaluates an AIG Alist (an
-alist binding keys to AIGs)."
-
-  :long "<p>The alist @('x') does not need to be fast, and we produce an
-ordinary (slow) alist as a result.</p>"
-
-  (defun aig-partial-eval-alist (x env)
-    (declare (xargs :guard t))
-    (cond ((atom x)
-           nil)
-          ((atom (car x))
-           ;; Bad-alist convention
-           (aig-partial-eval-alist (cdr x) env))
-          (t
-           (cons (cons (caar x)
-                       (aig-partial-eval (cdar x) env))
-                 (aig-partial-eval-alist (cdr x) env)))))
-
-  (defthm alistp-of-aig-partial-eval-alist
-    (alistp (aig-partial-eval-alist x env))))
-
-
-
-
-; -----------------------------------------------------------------------------
-;
-;                       FOUR-VALUED AIG OPERATIONS
-;
-; -----------------------------------------------------------------------------
-
-; [Jared] it would be nice to move the FAIG stuff out into a separate file.
-
-(defxdoc faig
-  :short "A representation of a four-valued function using two AIGs."
-
-  :long "<p>A <b>FAIG</b> (Four-valued AIG) combines two @(see aig)s together
-to represent a function with four possible values.  Such functions can be
-useful in hardware verification.</p>
-
-<p>We represent an FAIG as the cons of two AIGs, which are called the
-<i>onset</i> and <i>offset</i> of the FAIG.  Our FAIG evaluation function,
-@(see faig-eval), just evaluates these two AIGs, separately, using ordinary
-@(see aig-eval), and conses together the resulting Boolean values.  So, the
-four possible values of an FAIG are:</p>
-
-<ul>
-
-<li>@('(nil . nil)'), which we call Z,</li>
-
-<li>@('(t . nil)'), which we call True,</li>
-
-<li>@('(nil . t)'), which we call False, and</li>
-
-<li>@('(t . t)'), which we call X.</li>
-
-</ul>
-
-<p>We generally think of the onset as being a Boolean functions that should
-evaluate to @('T') when the wire is being driven to 1.  The offset is similar,
-but indicates whether the wire is being driven to 0.  So, the Z value
-represents a situation where the wire is completely undriven, and the X value
-represents a bad case where the wire is simultaneously driven to both True and
-False.</p>
-
-<p>Hons convention.  We ordinarly construct all AIGs with @(see hons), but we
-don't bother to hons the FAIG conses that put these AIGs together.</p>
-
-<p>BOZO discuss vu-faigs too.</p>")
-
-
-; [Jared] BOZO consider a warning as in aig-eval for when faig-eval,
-; faig-restrict, etc., are used on non-consp arguments.
-
-(defsection faig-eval
-  :parents (faig)
-  :short "@(call faig-eval) evaluates @('x'), a @(see faig), under the
-environment @('env'), producing a pair of Boolean values."
-
-  :long "<p>See @(see aig-eval); the @('env') should be a fast alist and you
-will want to clear the memoize table for @('aig-eval') when you are done using
-the @('env').</p>"
-
-  (defun faig-eval (x env)
-    (declare (xargs :guard t))
-    (if (atom x)
-        '(t . t)
-      (cons (aig-eval (car x) env)
-            (aig-eval (cdr x) env)))))
-
-
-(defsection faig-eval-list
-  :parents (faig-eval)
-  :short "@(call faig-eval-list) evaluates a list of FAIGs."
-
-  (defun faig-eval-list (x env)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (faig-eval (car x) env)
-            (faig-eval-list (cdr x) env)))))
-
-
-(defsection faig-eval-alist
-  :parents (faig-eval)
-  :short "@(call faig-eval-list) evaluates an FAIG alist (an alist binding
-keys to FAIGs)."
-
-  :long "<p>The alist @('x') does not need to be fast, and we produce an
-ordinary (slow) alist as a result.</p>"
-
-  (defun faig-eval-alist (x env)
-    (declare (xargs :guard t))
-    (cond ((atom x)
-           nil)
-          ((atom (car x))
-           ;; Bad alist convention
-           (faig-eval-alist (cdr x) env))
-          (t
-           (cons (cons (caar x)
-                       (faig-eval (cdar x) env))
-                 (faig-eval-alist (cdr x) env))))))
-
-
-
-
-(defsection faig-restrict
-  :parents (faig)
-  :short "@(call faig-restrict) performs variable substitution throughout the
-FAIG @('x'), replacing any variables bound in @('sigma') with their
-corresponding values."
-
-  :long "<p>See @(see aig-restrict); the @('env') should be a fast alist and
-you will want to clear the memoize table for @('aig-restrict') when you are
-done using the @('env').</p>"
-
-  (defun faig-restrict (x sigma)
-    (declare (xargs :guard t))
-    (if (atom x)
-        '(t . t)
-      (cons (aig-restrict (car x) sigma)
-            (aig-restrict (cdr x) sigma)))))
-
-
-(defsection faig-restrict-alist
-  :parents (faig-restrict)
-  :short "@(call faig-restrict-alist) substitutes into an FAIG alist (an alist
-binding keys to FAIGs)."
-
-  :long "<p>The alist @('x') does not need to be fast, and we produce an
-ordinary (slow) alist as a result.</p>"
-
-  (defun faig-restrict-alist (x sigma)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (let ((rest (faig-restrict-alist (cdr x) sigma)))
-        (if (atom (car x))
-            ;; Bad alist convention
-            rest
-          (cons (cons (caar x) (faig-restrict (cdar x) sigma))
-                rest))))))
-
-
-(defsection faig-restrict-alists
-  :parents (faig-restrict)
-  :short "@(call faig-restrict-alists) substitutes into a list of FAIG alists."
-
-  (defun faig-restrict-alists (x sigma)
-    (if (atom x)
-        nil
-      (cons (faig-restrict-alist (car x) sigma)
-            (faig-restrict-alists (cdr x) sigma)))))
-
-
-
-
-(defsection faig-compose
-  :parents (faig)
-  :short "@(call faig-compose) performs variable substitution throughout the
-FAIG @('x'), <b>unconditionally</b> replacing every variable in @('x') with its
-binding in @('sigma')."
-
-  :long "<p>See @(see aig-compose); the @('sigma') should be a fast alist and
-you will want to clear the memoize table for @('aig-compose') when you are done
-using the @('env').</p>"
-
-  (defun faig-compose (x sigma)
-    (declare (xargs :guard t))
-    (if (atom x)
-        '(t . t)
-      (cons (aig-compose (car x) sigma)
-            (aig-compose (cdr x) sigma)))))
-
-
-(defsection faig-compose-alist
-  :parents (faig)
-  :short "@(call faig-compose-alist) composes into an FAIG Alist (an alist
-binding keys to FAIGs)."
-
-  :long "<p>The alist @('x') does not need to be fast, and we produce an
-ordinary (slow) alist as a result.</p>"
-
-  (defun faig-compose-alist (x sigma)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (let ((rest (faig-compose-alist (cdr x) sigma)))
-        (if (atom (car x))
-            ;; Bad alist convention
-            rest
-          (cons (cons (caar x) (faig-compose (cdar x) sigma))
-                rest))))))
-
-
-
-
-(defsection faig-partial-eval
-  :parents (faig)
-  :short "@(call faig-partial-eval) evaluates @('x'), an FAIG, under the
-partial environment @('env'), producing a new FAIG as a result."
-
-  :long "<p>See @(see aig-partial-eval); the @('env') should be a fast alist
-and you will want to clear the memoize table for @('aig-partial-eval') when you
-are done using the @('env').</p>"
-
-  (defun faig-partial-eval (x env)
-    (declare (xargs :guard t))
-    (if (atom x)
-        '(t . t)
-      (cons (aig-partial-eval (car x) env)
-            (aig-partial-eval (cdr x) env)))))
-
-
-(defsection faig-partial-eval-alist
-  :parents (faig-partial-eval)
-  :short "@(call faig-partial-eval-alist) partially evaluates an FAIG alist (an
-alist binding keys to FAIGs)."
-
-  :long "<p>The alist @('x') does not need to be fast, and we produce an
-ordinary (slow) alist as a result.</p>"
-
-  (defun faig-partial-eval-alist (x env)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (let ((rest (faig-partial-eval-alist (cdr x) env)))
-        (if (atom (car x))
-            ;; Bad alist convention
-            rest
-          (cons (cons (caar x) (faig-partial-eval (cdar x) env))
-                rest))))))
-
-
-(defsection faig-partial-eval-alists
-  :parents (faig-partial-eval)
-  :short "@(call faig-partial-eval-alists) partially evaluates a list of FAIG
-alists."
-
-  (defund faig-partial-eval-alists (x env)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (faig-partial-eval-alist (car x) env)
-            (faig-partial-eval-alists (cdr x) env)))))
-
-
-
-
-(defsection faig-fix
-  :parents (faig)
-  :short "@(call faig-fix) is the identity for FAIGs, but coerces atoms to
-@('(t . t)'), i.e., X."
-
-  :long "<p>This is sometimes when reasoning about FAIG operations.</p>"
-
-  (defun faig-fix (x)
-    (declare (xargs :guard t))
-    (if (consp x) x '(t . t))))
-
-
-(defsection faig-fix-list
-  :parents (faig-fix)
-  :short "@(call faig-fix-list) fixes every element of a list with @(see
-faig-fix)."
-
-  (defun faig-fix-list (x)
-    (declare (xargs :guard t))
-    (if (atom x)
-        nil
-      (cons (faig-fix (car x))
-            (faig-fix-list (cdr x))))))
-
-
-(defsection faig-fix-alist
-  :parents (faig-fix)
-  :short "@(call faig-fix-alist) fixes every value in an alist with @(see
-faig-fix)."
-
-  (defun faig-fix-alist (x)
-    (declare (xargs :guard t))
-    (cond ((atom x)
-           nil)
-          ((atom (car x))
-           ;; Bad-alist convention
-           (faig-fix-alist (cdr x)))
-          (t
-           (cons (cons (caar x) (faig-fix (cdar x)))
-                 (faig-fix-alist (cdr x)))))))
-
-
-
-
-
-
-;; [Jared] These might be more properly part of EMOD/ESIM
-
-(defun aig-eval-pat (pat x al)
-  (declare (xargs :guard t))
-  (if pat
-      (if (atom pat)
-          (aig-eval x al)
-        (cons (aig-eval-pat (car pat) (ec-call (car x)) al)
-              (aig-eval-pat (cdr pat) (ec-call (cdr x)) al)))
-    nil))
-
-(defn faig-eval-pat (pat x al)
-  (if pat
-      (if (atom pat)
-          (faig-eval x al)
-        (cons (faig-eval-pat (car pat) (ec-call (car x)) al)
-              (faig-eval-pat (cdr pat) (ec-call (cdr x)) al)))
-    nil))
-
-(defn faig-restrict-pat (pat fpat al)
-  (if pat
-      (if (atom pat)
-          (faig-restrict fpat al)
-        (cons (faig-restrict-pat (car pat) (ec-call (car fpat)) al)
-              (faig-restrict-pat (cdr pat) (ec-call (cdr fpat)) al)))
-    nil))
-
-(defn faig-compose-pat (pat fpat al)
-  (if pat
-      (if (atom pat)
-          (faig-compose fpat al)
-        (cons (faig-compose-pat (car pat) (ec-call (car fpat)) al)
-              (faig-compose-pat (cdr pat) (ec-call (cdr fpat)) al)))
-    nil))
-
-(defn faig-partial-eval-pat (pat fpat al)
-  (if pat
-      (if (atom pat)
-          (faig-partial-eval fpat al)
-        (cons (faig-partial-eval-pat (car pat) (ec-call (car fpat)) al)
-              (faig-partial-eval-pat (cdr pat) (ec-call (cdr fpat)) al)))
-    nil))
-
-
-
-
-
-;; [Jared] Can we get rid of this stuff?
-
-(defn faigp (x) (consp x))
-
-(defn faig-listp (x)
-  (if (consp x)
-      (and (faigp (car x))
-           (faig-listp (cdr x)))
-    (null x)))
-
-(in-theory (disable faig-listp))
-
-(defn aig-p (x)
-  (aig-cases
-   x
-   :true t
-   :false t
-   :var t
-   :inv (and (aig-p (car x))
-             (hons-equal (aig-not (car x)) x))
-   :and (and (aig-p (car x))
-             (aig-p (cdr x))
-             (hons-equal (aig-and (car x) (cdr x)) x))))
-
-(memoize 'aig-p :condition '(and (consp x) (cdr x)))
-
-(defn faig-patternp (pat x)
-  (if pat
-      (if (atom pat)
-          (and (consp x)
-               (aig-p (car x))
-               (aig-p (cdr x)))
-        (and (consp x)
-             (faig-patternp (car pat) (car x))
-             (faig-patternp (cdr pat) (cdr x))))
-    t))
-
-
-
-
-
-
-
-
-
-;; [Jared] Removed these things...
-
-
-;; Note that these next two functions are provably equal to T.
-;; (defn aigp (x)
-;;   (or
-;;    (atom x)
-;;    (and (consp x) (null (cdr x)))
-;;    (and (aigp (car x)) (aigp (cdr x))))
-;;   )
-
-;; (defn aig-listp (x)
-;;   (if (consp x)
-;;       (and
-;;        (aigp (car x))
-;;        (aig-listp (cdr x)))
-;;     t))
-
-
-;; [Jared] this was never used anywhere, i think it's not necessary since
-;; aig-compose uses aig-env-lookup
-
-;; (defconst *aig-compose-warn-missing-binding* t)
-
-
-
-
-
-;; [jared] this macro stuff was just used in one old mmx property checking
-;; thing it might be reasonable to put in xxxjoin style macros for aig-and,
-;; aig-or, etc.; could also implement the lazy evaluation stuff like in ubdds,
-;; if desired.
-
-;; ;---- some macros for aig-or/aig-and/... 
-;; ;do we want to rebalance it (make it less deep and smaller)?
-;; ; would rebalancing have any impact on zz-sat performance?
-;; (defn aig-and-fn (lst)
-;;   (if (consp lst)
-;;       (if (consp (cdr lst))
-;;           (list
-;;            'aig-and
-;;            (car lst)
-;;            (aig-and-fn (cdr lst)))
-;;         (car lst))
-;;     t)
-;;   )
-
-;; (defmacro aig-and-macro (&rest args) (aig-and-fn args))
-
-;; (defn aig-or-fn (lst)
-;;   (if (consp lst)
-;;       (if (consp (cdr lst))
-;;           (list
-;;            'aig-or
-;;            (car lst)
-;;            (aig-or-fn (cdr lst)))
-;;         (car lst))
-;;     nil)
-;;   )
-
-;; (defmacro aig-or-macro (&rest args) (aig-or-fn args))
-
-;; (defn one-hot-fn (lst)
-;;   (if (consp lst)
-;;       (if (consp (cdr lst))
-;;           `(aig-or
-;;             (aig-and 
-;;              ,(car lst) 
-;;              (aig-not ,(aig-or-fn (cdr lst))))
-;;             (aig-and
-;;              (aig-not ,(car lst))
-;;              ,(one-hot-fn (cdr lst))))
-;;         (car lst))
-;;     nil
-;;     )
-;;   )
-
-;; (defmacro one-hot (&rest args) (one-hot-fn args))
-
-
-
-;; [Jared] looks like this was part of an experiment in transistor/propagate
-;; at one point, but it doesn't seem to be used anymore
-
-;; (defun aig-env-lookup-nil (x al)
-;;   (declare (Xargs :guard t))
-;;   (let ((look (hons-get x al)))
-;;     (if look
-;;         (cdr look)
-;;       (prog2$ (and *aig-env-lookup-warn-missing-binding*
-;;                    (aig-env-lookup-missing-output x))
-;;               nil))))
-
-;; (defn aig-compose-nil (x al)
-;;   (aig-cases
-;;    x
-;;    :true t
-;;    :false nil
-;;    :var (aig-env-lookup-nil x al)
-;;    :inv (aig-not (aig-compose-nil (car x) al))
-;;    :and (let ((a (aig-compose-nil (car x) al)))
-;;           (and a (aig-and a (aig-compose-nil (cdr x) al))))))
-
-;; (memoize 'aig-compose-nil :condition '(and (consp x) (cdr x)))
-
-;; (defn aig-compose-nil-alist (x-alst al)
-;;   (if (atom x-alst)
-;;       nil
-;;     (if (atom (car x-alst))
-;;         (aig-compose-nil-alist (cdr x-alst) al)
-;;       (cons (cons (caar x-alst)
-;;                   (aig-compose-nil (cdar x-alst) al))
-;;             (aig-compose-nil-alist (cdr x-alst) al)))))
-
-;; (defn aig-compose-nil-list (x al)
-;;   (if (atom x)
-;;       nil
-;;     (cons (aig-compose-nil (car x) al)
-;;           (aig-compose-nil-list (cdr x) al))))
-
-
-
-
-;; (defn faig-compose-nil (x comp-al)
-;;   (if (atom x)
-;;       '(t . t)
-;;     (cons (aig-compose-nil (car x) comp-al)
-;;           (aig-compose-nil (cdr x) comp-al))))
-
-;; (defn faig-compose-nil-pat (pat fpat al)
-;;   (if pat
-;;       (if (atom pat)
-;;           (faig-compose-nil fpat al)
-;;         (cons (faig-compose-nil-pat (car pat) (ec-call (car fpat)) al)
-;;               (faig-compose-nil-pat (cdr pat) (ec-call (cdr fpat)) al)))
-;;     nil))
-
-;; (defn faig-compose-nil-alist (al comp-al)
-;;   (if (atom al)
-;;       nil
-;;     (let ((rest (faig-compose-nil-alist (cdr al) comp-al)))
-;;       (if (atom (car al))
-;;           rest
-;;         (cons (cons (caar al) (faig-compose-nil (cdar al) comp-al))
-;;               rest)))))
-
-
-
-
-
-
-
-
-;; [Jared] This doesn't seem to be used for anything...
-
-;; ;; Translate Lisp-like terms into AIGs.
-;; (mutual-recursion
-;;  (defun logic-to-aig (tree)
-;;    (declare (xargs :measure (acl2-count tree)
-;;                    :guard t))
-;;    (if (atom tree)
-;;        tree
-;;      (case (car tree)
-;;        ((and or xor iff) (logic-to-aig-list (car tree) (cdr tree)))
-;;        (nand (aig-not (logic-to-aig-list 'and (cdr tree))))
-;;        (nor (aig-not (logic-to-aig-list 'or (cdr tree))))
-;;        (implies (and (eql (len tree) 3)
-;;                      (aig-or (aig-not (logic-to-aig (cadr tree)))
-;;                              (logic-to-aig (caddr tree)))))
-;;        (if (and (eql (len tree) 4)
-;;                 (aig-ite (logic-to-aig (cadr tree))
-;;                          (logic-to-aig (caddr tree))
-;;                          (logic-to-aig (cadddr tree)))))
-;;        (not (and (eql (len tree) 2)
-;;                  (aig-not (logic-to-aig (cadr tree))))))))
-;;  (defun logic-to-aig-list (op trees)
-;;    (declare (xargs :measure (acl2-count trees)
-;;                    :guard t))
-;;    (if (atom trees)
-;;        (case op
-;;          (xor nil)
-;;          (iff t)
-;;          (and t)
-;;          (or nil))
-;;      (let ((first (logic-to-aig (car trees)))
-;;            (rest (logic-to-aig-list op (cdr trees))))
-;;        (case op
-;;          (xor (aig-xor first rest))
-;;          (iff (aig-iff first rest))
-;;          (and (aig-and first rest))
-;;          (or (aig-or first rest)))))))
-
-;; (memoize 'logic-to-aig :condition '(consp tree))
-
 
+; cert_param: (reloc_stub)
+(include-book "aig-base")
+(include-book "faig-base")
 
diff -Nru acl2-6.2/books/centaur/aig/bddify-correct.lisp acl2-6.3/books/centaur/aig/bddify-correct.lisp
--- acl2-6.2/books/centaur/aig/bddify-correct.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/bddify-correct.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -33,8 +33,6 @@
 (set-inhibit-warnings "theory")
 (set-waterfall-parallelism nil) ; for defthm aig-bddify-x-weakening-ok-point
 
-(local (in-theory (disable append-of-nil)))
-
 
 ;; --------- UBDDP-VAL-ALISTP
 
diff -Nru acl2-6.2/books/centaur/aig/bddify.lisp acl2-6.3/books/centaur/aig/bddify.lisp
--- acl2-6.2/books/centaur/aig/bddify.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/bddify.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -29,7 +29,8 @@
 
 (in-package "ACL2")
 
-(include-book "base")
+(include-book "aig-base")
+(include-book "faig-base")
 (include-book "tools/bstar" :dir :system)
 (include-book "tools/mv-nth" :dir :system)
 (include-book "misc/hons-help2" :dir :system)
@@ -812,12 +813,12 @@
 (def-with-bddify aig-eval)
 (def-with-bddify faig-eval)
 (def-with-bddify aig-eval-list)
-(def-with-bddify aig-eval-pat)
 (def-with-bddify aig-eval-alist)
 (def-with-bddify faig-eval-list)
-(def-with-bddify faig-eval-pat)
 (def-with-bddify faig-eval-alist)
 
+
+
 ;; Now we apply these to various shapes of AIG-EVAL.
 (local
  (progn
@@ -828,26 +829,6 @@
               al tries mwa))
             (faig-eval-list-with-bddify pairs al tries mwa)))
 
-
-   (defthm aig-eval-pat-to-aig-eval-list
-     (equal (aig-list-to-pat
-             pat
-             (aig-eval-list-with-bddify
-              (pat-to-aig-list pat x acc)
-              al tries mwa))
-            (mv (aig-eval-pat-with-bddify pat x al tries mwa)
-                (aig-eval-list-with-bddify acc al tries mwa))))
-
-
-
-   (defthm faig-eval-pat-is-faig-eval-list
-     (equal (b* ((faig-list (pat-to-aig-list pat x acc))
-                 (pair-eval (faig-eval-list-with-bddify faig-list al tries mwa)))
-              (aig-list-to-pat pat pair-eval))
-            (mv (faig-eval-pat-with-bddify pat x al tries mwa)
-                (faig-eval-list-with-bddify acc al tries mwa))))
-
-
    (defthm aig-eval-alist-is-aig-eval-list
      (equal (pairlis$ (strip-pair-cars aig-al)
                       (aig-eval-list-with-bddify
@@ -855,7 +836,6 @@
                        al tries mwa))
             (aig-eval-alist-with-bddify aig-al al tries mwa)))
 
-
    (defthm faig-eval-alist-is-faig-eval-list
      (equal (pairlis$ (strip-pair-cars aig-al)
                       (faig-eval-list-with-bddify
@@ -869,10 +849,8 @@
    
    (in-theory (disable aig-eval-with-bddify
                        aig-eval-list-with-bddify
-                       aig-eval-pat-with-bddify
                        aig-eval-alist-with-bddify
                        faig-eval-list-with-bddify
-                       faig-eval-pat-with-bddify
                        faig-eval-alist-with-bddify))))
 
 
@@ -902,38 +880,7 @@
            al tries mwa)))
   :rule-classes nil)
 
-(defthm aig-eval-pat-in-terms-of-aig-eval-list
-  (equal (aig-eval-pat-with-bddify pat x al tries mwa)
-         (mv-let (ev rest)
-           (aig-list-to-pat
-            pat
-            (aig-eval-list-with-bddify
-             (pat-to-aig-list pat x nil)
-             al tries mwa))
-           (declare (ignore rest))
-           ev))
-  :rule-classes nil)
-
 
-;; (defthm faig-eval-pat-in-terms-of-faig-eval-list1
-;;   (equal (faig-eval-pat-with-bddify pat x al tries mwa)
-;;          (b* ((faig-list (pat-to-aig-list pat x acc))
-;;               (pair-eval (faig-eval-list-with-bddify
-;;                           faig-list al tries mwa))
-;;               ((mv ev &) (aig-list-to-pat pat pair-eval)))
-;;            ev))
-;;   :hints(("Goal" :in-theory (disable faig-eval-list-to-aig-eval-list)))
-;;   :rule-classes nil)
-
-(defthm faig-eval-pat-in-terms-of-faig-eval-list
-  (equal (faig-eval-pat-with-bddify pat x al tries mwa)
-         (b* ((faig-list (pat-to-aig-list pat x nil))
-              (pair-eval (faig-eval-list-with-bddify
-                          faig-list al tries mwa))
-              ((mv ev &) (aig-list-to-pat pat pair-eval)))
-           ev))
-  :hints(("Goal" :in-theory (disable faig-eval-list-to-aig-eval-list)))
-  :rule-classes nil)
 
 (defthm aig-eval-alist-in-terms-of-aig-eval-list
   (equal (aig-eval-alist-with-bddify aig-al al tries mwa)
@@ -968,26 +915,6 @@
         (aig-list-to-faig-list aigs)
         exact)))
 
-(defun aig-bddify-pat (tries pat x al maybe-wash-args)
-  (b* (((mv bdds aigs exact)
-        (aig-bddify-list
-         tries
-         (pat-to-aig-list pat x nil)
-         al maybe-wash-args))
-       ((mv bdds &) (aig-list-to-pat pat bdds))
-       ((mv aigs &) (aig-list-to-pat pat aigs)))
-    (mv bdds aigs exact)))
-
-(defun faig-bddify-pat (tries pat x al maybe-wash-args)
-  (b* (((mv bdds aigs exact)
-        (faig-bddify-list
-         tries
-         (pat-to-aig-list pat x nil)
-         al maybe-wash-args))
-       ((mv bdds &) (aig-list-to-pat pat bdds))
-       ((mv aigs &) (aig-list-to-pat pat aigs)))
-    (mv bdds aigs exact)))
-
 
 (defun aig-bddify-alist (tries x al maybe-wash-args)
   (b* (((mv bdds aigs exact)
diff -Nru acl2-6.2/books/centaur/aig/best-aig.lisp acl2-6.3/books/centaur/aig/best-aig.lisp
--- acl2-6.2/books/centaur/aig/best-aig.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/best-aig.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -20,54 +20,72 @@
 ;                   Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
-(include-book "tools/bstar" :dir :system)
-(include-book "tools/mv-nth" :dir :system)
-(include-book "finite-set-theory/osets/sets" :dir :system)
+(include-book "cutil/define" :dir :system)
+(include-book "std/osets/top" :dir :system)
 (include-book "centaur/vl/util/cwtime" :dir :system)
 
-; Given two AIGs, A and B, we say that A is "better" than B if:
-;
-;  (1) A has fewer unique AND nodes than B, or
-;  (2) A,B have the same number of unique AND nodes, but A has fewer
-;        total nodes than B.
-;
-; We introduce two main functions.
-;
-; 1. (AIG-LIST-BEST X) is given a non-empty AIG List and returns the best AIG
-;    within it.
-;
-; 2. (AIG-LIST-LIST-BEST X) is given a list of non-empty AIG Lists, say (L1 L2
-;    ... Ln), and returns (B1 B2 ... Bn) where Bi is the best AIG from each Li.
-;
-; Logically AIG-LIST-LIST-BEST is just the ordinary "map" or projection of
-; AIG-LIST-BEST, but it takes advantage of more structure sharing and
-; memoization than the naive projection would and hence may be much more
-; efficient.
-;
-; Implementation.
-;
-; It is tricky to directly count "unique nodes" in a memoized way, but there
-; is a very easy way to do it indirectly.
-;
-; First, we assign a number to every unique AIG node in sight, which (assuming
-; constant-time hashing) is linear in the sizes of the input AIGs.  We call
-; these numbers labels.
-;
-; Next, we can write memoized functions to gather the sets of labels for all of
-; the AND nodes within an AIG, and similarly for all of the nodes.  We just use
-; regular ordered sets to represent these sets.  Importantly, these collection
-; functions can be easily memoized.
-;
-; Finally, to count the number of ANDs (or all nodes) in an AIG, we just
-; collect the labels for its ANDs (or all nodes) and see how many labels were
-; found.
-
-(defund aig-label-nodes (x free map)
-  "Returns (MV FREE' MAP')"
-  (declare (xargs :guard (natp free) :verify-guards nil))
-  ;; X is the AIG to traverse.
-  ;; FREE is the smallest label that hasn't been assigned to any node yet.
-  ;; MAP is the fast alist from AIG nodes to labels that we're constructing.
+(defsection best-aig
+  :parents (aig-other)
+  :short "Algorithms for choosing \"better\" (smaller) AIGs."
+
+  :long "<p>Given two AIGs, A and B, we say that A is \"better\" than B if:</p>
+
+<ul>
+ <li>A has fewer unique AND nodes than B, or</li>
+ <li>A,B have the same number of unique AND nodes, but A has fewer
+       total nodes than B.</li>
+</ul>
+
+<p>We provide two main functions for choosing good AIGs:</p>
+
+<ul>
+
+<li>@(see aig-list-best) chooses the best AIG from a non-empty list of
+AIGs.</li>
+
+<li>@(see aig-list-list-best) is given a list of non-empty AIG Lists, say
+@('(L1 L2 ... Ln)'), and returns @('(B1 B2 ... Bn)'), where each @('Bi') is the
+best AIG from the corresponding @('Li').</li>
+
+</ul>
+
+<p>You could just implement @(see aig-list-list-best) as an ordinary \"map\" or
+projection of @(see aig-list-best).  But @('aig-list-list-best') is written in
+a slightly smarter way than this, so that it can share the labels and
+memoization results across all of the AIGs in all of the lists.</p>
+
+<h3>Implementation</h3>
+
+<p>It is tricky to directly count \"unique nodes\" in a memoized way, but there
+is a very easy way to do it indirectly.</p>
+
+<p>First, we assign a number to every unique AIG node in sight, which (assuming
+constant-time hashing) is linear in the sizes of the input AIGs.  We call these
+numbers labels.</p>
+
+<p>Next, we can write memoized functions to gather the sets of labels for all
+of the AND nodes within an AIG, and similarly for all of the nodes.  We just
+use regular ordered sets to represent these sets.  Importantly, these
+collection functions can be easily memoized.</p>
+
+<p>Finally, to count the number of ANDs (or all nodes) in an AIG, we just
+collect the labels for its ANDs (or all nodes) and see how many labels were
+found.</p>
+
+<p>BOZO it would probably be much better to use @(see sbitsets) to represent
+label sets.  If we ever need to speed this up, that's probably the first thing
+to try.</p>")
+
+(define aig-label-nodes
+  :parents (best-aig)
+  :short "Assign unique numbers (labels) to the nodes of an AIG."
+  ((x    "A single AIG to traverse")
+   (free "Smallest label that hasn't been assigned to any node, yet."
+         natp)
+   (map  "Fast alist from AIG nodes to labels (which we're constructing)."))
+  :returns (mv (free "Updated free index" natp :rule-classes :type-prescription)
+               (map  "Updated map."))
+  :verify-guards nil
   (b* (((when (atom x))
         (mv (lnfix free) map))
        ((when (hons-get x map))
@@ -76,143 +94,143 @@
        ((mv free map) (aig-label-nodes (cdr x) free map))
        (map           (hons-acons x free map))
        (free          (+ 1 free)))
-    (mv free map)))
-
-(defthm natp-of-aig-label-nodes
-  (natp (mv-nth 0 (aig-label-nodes x free map)))
-  :rule-classes :type-prescription
-  :hints(("Goal" :in-theory (enable aig-label-nodes))))
-
-(verify-guards aig-label-nodes)
-
-
-
-(defund aig-list-label-nodes (x free map)
-  "Returns (MV FREE' MAP')"
-  (declare (xargs :guard (natp free) :verify-guards nil))
-  ;; Extends AIG-LABEL-NODES to an AIG List.
-  (if (atom x)
-      (mv (nfix free) map)
-    (b* (((mv free map) (aig-label-nodes (car x) free map))
-         ((mv free map) (aig-list-label-nodes (cdr x) free map)))
-      (mv free map))))
-
-(defthm natp-of-aig-list-label-nodes
-  (natp (mv-nth 0 (aig-list-label-nodes x free map)))
-  :rule-classes :type-prescription
-  :hints(("Goal" :in-theory (enable aig-list-label-nodes))))
-
-(verify-guards aig-list-label-nodes)
-
-
-
-(defund aig-list-list-label-nodes (x free map)
-  "Returns (MV FREE' MAP')"
-  (declare (xargs :guard (natp free) :verify-guards nil))
-  ;; Extends AIG-LABEL-NODES to an AIG List List.
-  (if (atom x)
-      (mv (nfix free) map)
-    (b* (((mv free map) (aig-list-label-nodes (car x) free map))
-         ((mv free map) (aig-list-list-label-nodes (cdr x) free map)))
-      (mv free map))))
-
-(defthm natp-of-aig-list-list-label-nodes
-  (natp (mv-nth 0 (aig-list-list-label-nodes x free map)))
-  :rule-classes :type-prescription
-  :hints(("Goal" :in-theory (enable aig-list-list-label-nodes))))
-
-(verify-guards aig-list-list-label-nodes)
-
+    (mv free map))
+  ///
+  (verify-guards aig-label-nodes))
+
+(define aig-list-label-nodes
+  :parents (best-aig)
+  :short "Extends @(see aig-label-nodes) to an AIG list."
+  ((x "AIG list to traverse.")
+   (free natp)
+   map)
+  :returns (mv (free natp :rule-classes :type-prescription)
+               map)
+  (b* (((when (atom x))
+        (mv (nfix free) map))
+       ((mv free map) (aig-label-nodes (car x) free map)))
+    (aig-list-label-nodes (cdr x) free map)))
+
+(define aig-list-list-label-nodes
+  :parents (best-aig)
+  :short "Extends @(see aig-label-nodes) to an AIG list list."
+  ((x "AIG list list to traverse.")
+   (free natp)
+   map)
+  :returns (mv (free natp :rule-classes :type-prescription)
+               map)
+  (b* (((when (atom x))
+        (mv (nfix free) map))
+       ((mv free map) (aig-list-label-nodes (car x) free map)))
+    (aig-list-list-label-nodes (cdr x) free map)))
 
 
-(defund aig-collect-andnode-labels (x map)
-  "Returns INDEX-SET"
-  (declare (xargs :guard t))
-  ;; X is an AIG.
-  ;; MAP is the mapping from AIG nodes to labels.
-  ;; We collect the set of labels for all AND nodes in X.
-  (cond ((atom x)
-         nil)
-        ((not (cdr x))
-         (aig-collect-andnode-labels (car x) map))
-        (t
-         (let ((x-label    (cdr (hons-get x map)))
-               (car-labels (aig-collect-andnode-labels (car x) map))
-               (cdr-labels (aig-collect-andnode-labels (cdr x) map)))
-           (sets::insert x-label (sets::union car-labels cdr-labels))))))
-
-(memoize 'aig-collect-andnode-labels :condition '(and (consp x) (cdr x)))
-
-(defthm setp-of-aig-collect-andnode-labels
-  (sets::setp (aig-collect-andnode-labels x map))
-  :hints(("Goal" :in-theory (enable aig-collect-andnode-labels))))
 
-(defund aig-count-andnode-labels (x map)
-  (declare (xargs :guard t))
+(define aig-collect-andnode-labels
+  :parents (best-aig)
+  :short "Collect the labels for AND nodes in an AIG.  (memoized)"
+  ((x   "A single AIG")
+   (map "Mapping of AIG nodes to labels."))
+  :returns (label-set "Ordered set of labels for all AND nodes in X."
+                      sets::setp)
+  (b* (((when (atom x))
+        nil)
+       ((unless (cdr x))
+        (aig-collect-andnode-labels (car x) map))
+       (x-label    (cdr (hons-get x map)))
+       (car-labels (aig-collect-andnode-labels (car x) map))
+       (cdr-labels (aig-collect-andnode-labels (cdr x) map)))
+    (sets::insert x-label (sets::union car-labels cdr-labels)))
+  ///
+  (memoize 'aig-collect-andnode-labels :condition '(and (consp x) (cdr x))))
+
+(define aig-count-andnode-labels
+  :parents (best-aig)
+  ((x   "A single AIG.")
+   (map "Mapping of AIG nodes to labels."))
+  :returns (count natp :rule-classes :type-prescription)
   (sets::cardinality (aig-collect-andnode-labels x map)))
 
 
-
-(defund aig-collect-labels (x map)
-  "Returns INDEX-SET"
-  (declare (xargs :guard t))
-  ;; X is an AIG.
-  ;; MAP is the mapping from AIG nodes to labels.
-  ;; We collect the set of labels for all nodes in X.
-  (cond ((atom x)
-         nil)
-        (t
-         (let ((x-label    (cdr (hons-get x map)))
-               (car-labels (aig-collect-labels (car x) map))
-               (cdr-labels (aig-collect-labels (cdr x) map)))
-           (sets::insert x-label
-                         (sets::union car-labels cdr-labels))))))
-
-(memoize 'aig-collect-labels :condition '(and (consp x) (cdr x)))
-
-(defthm setp-of-aig-collect-labels
-  (sets::setp (aig-collect-labels x map))
-  :hints(("Goal" :in-theory (enable aig-collect-labels))))
-
-(defund aig-count-labels (x map)
-  (declare (xargs :guard t))
+(define aig-collect-labels
+  :parents (best-aig)
+  :short "Collect the labels of ALL nodes in an AIG.  (memoized)"
+  ((x   "A single AIG")
+   (map "Mapping of AIG nodes to labels."))
+  :returns (label-set "Ordered set of labels for all nodes in X."
+                      sets::setp)
+  (b* (((when (atom x))
+        nil)
+       (x-label    (cdr (hons-get x map)))
+       (car-labels (aig-collect-labels (car x) map))
+       (cdr-labels (aig-collect-labels (cdr x) map)))
+    (sets::insert x-label
+                  (sets::union car-labels cdr-labels)))
+  ///
+  (memoize 'aig-collect-labels :condition '(and (consp x) (cdr x))))
+
+(define aig-count-labels
+  :parents (best-aig)
+  ((x   "A single AIG.")
+   (map "Mapping of AIG nodes to labels."))
+  :returns (count natp :rule-classes :type-prescription)
   (sets::cardinality (aig-collect-labels x map)))
 
 
 
-
-(defund aig-list-best-aux1 (x best best-ands map)
-  (declare (xargs :guard (natp best-ands)))
-  (if (atom x)
-      best
-    (b* ((ands (aig-count-andnode-labels (car x) map)))
-      (if (or (< ands best-ands)
-              (and (= best-ands ands)
-                   (< (aig-count-labels (car x) map)
-                      (aig-count-labels best map))))
-          (aig-list-best-aux1 (cdr x) (car x) ands map)
-        (aig-list-best-aux1 (cdr x) best best-ands map)))))
-
-(defund aig-list-best-aux (x map)
-  (declare (xargs :guard t))
+(define aig-list-best-aux1
+  :parents (best-aig)
+  :short "Main loop for finding the best AIG."
+  ((x         "An AIG list.")
+   (best      "Best AIG we've seen so far.")
+   (best-ands "How many unique AND nodes in our best AIG so far."
+              natp)
+   (map       "Mapping of AIG nodes to labels."))
+  :returns
+  (new-best "Best AIG in X, or @('best') it's better than everything in X.")
+  (b* (((when (atom x))
+        best)
+       (ands (aig-count-andnode-labels (car x) map))
+       ((when (or (< ands best-ands)
+                  (and (= best-ands ands)
+                       (< (aig-count-labels (car x) map)
+                          (aig-count-labels best map)))))
+        ;; The car is better than best.
+        (aig-list-best-aux1 (cdr x) (car x) ands map)))
+    ;; Best is better than the car.
+    (aig-list-best-aux1 (cdr x) best best-ands map)))
+
+(define aig-list-best-aux
+  :parents (best-aig)
+  ((x   "A non-empty list of AIGs.")
+   (map "Mapping of AIG nodes to labels."))
+  :returns (best "Best AIG in X.")
   (if (atom x)
-      (er hard? 'aig-list-best-aux "Expected at least one aig.")
+      ;; BOZO this is kind of a lousy thing to do.
+      (raise "Expected at least one aig.")
     (aig-list-best-aux1 (cdr x)
                         (car x)
                         (aig-count-andnode-labels (car x) map)
                         map)))
 
-(defund aig-list-list-best-aux (x map)
-  (declare (xargs :guard t))
+(define aig-list-list-best-aux
+  :parents (best-aig)
+  ((x   "An AIG List List.  Shouldn't contain any empty lists.")
+   (map "Mapping of AIG nodes to labels."))
+  :returns
+  (best-list "A list containing the best AIG from each list in @('x').")
   (if (atom x)
       nil
     (cons (aig-list-best-aux (car x) map)
           (aig-list-list-best-aux (cdr x) map))))
 
-
-(defund aig-list-best (x)
-  ; X is an AIG List.
-  (declare (xargs :guard t))
+(define aig-list-best
+  :parents (best-aig)
+  :short "Top level function for choosing the best AIG out of a list."
+  ((x "An AIG List, which should be non-empty."))
+  :returns (best "The best AIG in @('x').")
+  :long "<p>This is easy to use: it handles all of the details of freeing the
+         fast alists and memo tables it uses.</p>"
   (b* (((mv ?free map) (cwtime (aig-list-label-nodes x 0 nil)
                                :mintime 1/2))
        (ret (cwtime (aig-list-best-aux x map)
@@ -222,9 +240,16 @@
     (clear-memoize-table 'aig-collect-labels)
     ret))
 
-(defund aig-list-list-best (x)
-  ; X is an AIG List List.
-  (declare (xargs :guard t))
+(define aig-list-list-best
+  :parents (best-aig)
+  :short "Top-level function for choosing the best AIGs from a list of AIG
+          lists."
+  ((x "An AIG List List, say @('(L1 L2 ... Ln)'.  These should each be
+       non-empty."))
+  :returns (best "An AIG List, say @('(B1 B2 ... Bn)'), where each @('Bi') is
+                  the best AIG from the corresponding @('Li').")
+  :long "<p>This is easy to use: it handles all of the details of freeing the
+         fast alists and memo tables it uses.</p>"
   (b* (((mv ?free map) (cwtime (aig-list-list-label-nodes x 0 nil)
                                :mintime 1))
        (ret (cwtime (aig-list-list-best-aux x map)
diff -Nru acl2-6.2/books/centaur/aig/eval-restrict.lisp acl2-6.3/books/centaur/aig/eval-restrict.lisp
--- acl2-6.2/books/centaur/aig/eval-restrict.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/eval-restrict.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -23,10 +23,11 @@
 
 (in-package "ACL2")
 
-(include-book "base")
+(include-book "aig-base")
 (include-book "aig-equivs")
-(include-book "three-four")
 (include-book "aig-vars")
+(include-book "faig-constructors") ;; bozo?
+(include-book "faig-equivs")       ;; bozo?
 
 (in-theory (disable aig-env-lookup))
 (in-theory (disable aig-restrict))
@@ -119,13 +120,6 @@
 (defsection aig-eval-alist-thms
   :extension aig-eval-alist
 
-  (defthm hons-assoc-equal-aig-eval-alist
-    (equal (hons-assoc-equal key (aig-eval-alist x env))
-           (and (hons-assoc-equal key x)
-                (cons key
-                      (aig-eval (cdr (hons-assoc-equal key x)) env))))
-    :hints(("Goal" :induct t)))
-
   (defcong aig-alist-equiv alist-equiv (aig-eval-alist x env) 1
     :hints((witness)))
 
@@ -157,13 +151,6 @@
 
   (local (in-theory (enable aig-restrict)))
 
-  (defthm aig-eval-of-aig-restrict
-    (equal (aig-eval (aig-restrict x al1) al2)
-           (aig-eval x (append (aig-eval-alist al1 al2) al2)))
-    :hints(("Goal"
-            :induct t
-            :in-theory (enable aig-env-lookup))))
-
   (defcong aig-equiv aig-equiv (aig-restrict x al) 1
     :hints((witness :ruleset aig-equiv-witnessing)))
 
@@ -766,7 +753,7 @@
 (defmacro prove-faig-congruences (f args)
   `(progn . ,(prove-faig-congruences-fn (len args) f args)))
 
-(prove-faig-congruences t-aig-fix (a))
+(prove-faig-congruences f-aig-unfloat (a))
 (prove-faig-congruences t-aig-not (a))
 (prove-faig-congruences f-aig-not (a))
 (prove-faig-congruences t-aig-and (a b))
@@ -781,29 +768,8 @@
 (prove-faig-congruences f-aig-ite (c a b))
 (prove-faig-congruences t-aig-ite* (c a b))
 (prove-faig-congruences f-aig-ite* (c a b))
-(prove-faig-congruences t-aig-buf (c a))
+(prove-faig-congruences f-aig-zif (c a b))
+(prove-faig-congruences t-aig-tristate (c a))
 (prove-faig-congruences f-aig-pullup (a))
-(prove-faig-congruences f-aig-bi-buf (c a b))
-
-
-
-
-;; Pat stuff, could maybe move to EMOD/ESIM books...
-
-(defthm faig-eval-pat-of-faig-restrict-pat
-  (equal (faig-eval-pat pat (faig-restrict-pat pat aigs al1) al2)
-         (faig-eval-pat pat aigs (append (aig-eval-alist al1 al2) al2)))
-  :hints(("Goal" :induct t)))
-
-(defthm faig-eval-pat-of-faig-partial-eval-pat
-  (equal (faig-eval-pat pat (faig-partial-eval-pat pat aigs al1) al2)
-         (faig-eval-pat pat aigs (append al1 al2)))
-  :hints(("Goal" :induct t)))
 
-(defthm faig-eval-pat-of-faig-compose-pat
-  (equal (faig-eval-pat pat (faig-compose-pat pat aigs al1) al2)
-         (faig-eval-pat pat aigs (aig-eval-alist al1 al2)))
-  :hints(("Goal" :induct t)))
 
-(defcong aig-env-equiv equal (faig-eval-pat pat x env) 3
-  :hints(("Goal" :induct t)))
diff -Nru acl2-6.2/books/centaur/aig/faig-base.lisp acl2-6.3/books/centaur/aig/faig-base.lisp
--- acl2-6.2/books/centaur/aig/faig-base.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/faig-base.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,271 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+;
+; July 2011, Jared added lots of documentation.
+; August 2013, Jared split base.lisp into aig-base.lisp and faig-base.lisp
+
+(in-package "ACL2")
+(include-book "aig-base")
+
+(defxdoc faig
+  :parents (boolean-reasoning)
+  :short "A @(see hons)-based representation of four-valued functions as
+pairs of @(see aig)s."
+
+  :long "<p>A <b>FAIG</b> (Four-valued AIG) combines two @(see aig)s together
+to represent a function with four possible values.  Such functions can be
+useful in hardware verification.</p>
+
+<p>We represent an FAIG as the cons of two AIGs, which are called the
+<i>onset</i> and <i>offset</i> of the FAIG.  Our FAIG evaluation function,
+@(see faig-eval), just evaluates these two AIGs, separately, using ordinary
+@(see aig-eval), and conses together the resulting Boolean values.  So, the
+four possible values of an FAIG are:</p>
+
+<ul>
+<li>@('(nil . nil)'), which we call Z,</li>
+<li>@('(t . nil)'), which we call True,</li>
+<li>@('(nil . t)'), which we call False, and</li>
+<li>@('(t . t)'), which we call X.</li>
+</ul>
+
+<p>We generally think of the onset as being a Boolean functions that should
+evaluate to @('T') when the wire is being driven to 1.  The offset is similar,
+but indicates whether the wire is being driven to 0.  So, the Z value
+represents a situation where the wire is completely undriven, and the X value
+represents a bad case where the wire is simultaneously driven to both True and
+False.</p>
+
+<p>Hons convention.  We ordinarly construct all AIGs with @(see hons), but we
+don't bother to hons the FAIG conses that put these AIGs together.</p>")
+
+
+(defsection faig-constants
+  :parents (faig)
+  :short "The four @(see FAIG) values, representing true, false, X, and Z."
+
+  (defmacro faig-x () ''(t   . t))
+  (defmacro faig-z () ''(nil . nil))
+  (defmacro faig-t () ''(t   . nil))
+  (defmacro faig-f () ''(nil . t)))
+
+
+
+; [Jared] BOZO consider a warning as in aig-eval for when faig-eval,
+; faig-restrict, etc., are used on non-consp arguments.
+
+(define faig-eval (x env)
+  :parents (faig)
+  :short "@(call faig-eval) evaluates @('x'), a @(see faig), under the
+environment @('env'), producing a pair of Boolean values."
+  :long "<p>See @(see aig-eval); the @('env') should be a fast alist and you
+will want to clear the memoize table for @('aig-eval') when you are done using
+the @('env').</p>"
+  :enabled t
+  (if (atom x)
+      '(t . t)
+    (cons (aig-eval (car x) env)
+          (aig-eval (cdr x) env))))
+
+(define faig-eval-list (x env)
+  :parents (faig-eval)
+  :short "@(call faig-eval-list) evaluates a list of FAIGs."
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (faig-eval (car x) env)
+          (faig-eval-list (cdr x) env))))
+
+(define faig-eval-alist (x env)
+  :parents (faig-eval)
+  :short "@(call faig-eval-list) evaluates an FAIG alist (an alist binding
+keys to FAIGs)."
+  :long "<p>The alist @('x') does not need to be fast, and we produce an
+ordinary (slow) alist as a result.</p>"
+  :enabled t
+  (cond ((atom x)
+         nil)
+        ((atom (car x))
+         ;; Bad alist convention
+         (faig-eval-alist (cdr x) env))
+        (t
+         (cons (cons (caar x)
+                     (faig-eval (cdar x) env))
+               (faig-eval-alist (cdr x) env)))))
+
+(define faig-restrict (x sigma)
+  :parents (faig)
+  :short "@(call faig-restrict) performs variable substitution throughout the
+FAIG @('x'), replacing any variables bound in @('sigma') with their
+corresponding values."
+  :long "<p>See @(see aig-restrict); the @('env') should be a fast alist and
+you will want to clear the memoize table for @('aig-restrict') when you are
+done using the @('env').</p>"
+  :enabled t
+  (if (atom x)
+      '(t . t)
+    (cons (aig-restrict (car x) sigma)
+          (aig-restrict (cdr x) sigma))))
+
+(define faig-restrict-alist (x sigma)
+  :parents (faig-restrict)
+  :short "@(call faig-restrict-alist) substitutes into an FAIG alist (an alist
+binding keys to FAIGs)."
+  :long "<p>The alist @('x') does not need to be fast, and we produce an
+ordinary (slow) alist as a result.</p>"
+  :enabled t
+  (b* (((when (atom x))
+        nil)
+       (rest (faig-restrict-alist (cdr x) sigma))
+       ((when (atom (car x)))
+        ;; Bad alist convention
+        rest))
+    (cons (cons (caar x) (faig-restrict (cdar x) sigma))
+          rest)))
+
+(define faig-restrict-alists (x sigma)
+  :parents (faig-restrict)
+  :short "@(call faig-restrict-alists) substitutes into a list of FAIG alists."
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (faig-restrict-alist (car x) sigma)
+          (faig-restrict-alists (cdr x) sigma))))
+
+(define faig-compose (x sigma)
+  :parents (faig)
+  :short "@(call faig-compose) performs variable substitution throughout the
+FAIG @('x'), <b>unconditionally</b> replacing every variable in @('x') with its
+binding in @('sigma')."
+  :long "<p>See @(see aig-compose); the @('sigma') should be a fast alist and
+you will want to clear the memoize table for @('aig-compose') when you are done
+using the @('env').</p>"
+  :enabled t
+  (if (atom x)
+      '(t . t)
+    (cons (aig-compose (car x) sigma)
+          (aig-compose (cdr x) sigma))))
+
+(define faig-compose-alist (x sigma)
+  :parents (faig)
+  :short "@(call faig-compose-alist) composes into an FAIG Alist (an alist
+binding keys to FAIGs)."
+  :long "<p>The alist @('x') does not need to be fast, and we produce an
+ordinary (slow) alist as a result.</p>"
+  :enabled t
+  (b* (((when (atom x))
+        nil)
+       (rest (faig-compose-alist (cdr x) sigma))
+       ((when (atom (car x)))
+        ;; Bad alist convention
+        rest))
+    (cons (cons (caar x) (faig-compose (cdar x) sigma))
+          rest)))
+
+(define faig-partial-eval (x env)
+  :parents (faig)
+  :short "@(call faig-partial-eval) evaluates @('x'), an FAIG, under the
+partial environment @('env'), producing a new FAIG as a result."
+  :long "<p>See @(see aig-partial-eval); the @('env') should be a fast alist
+and you will want to clear the memoize table for @('aig-partial-eval') when you
+are done using the @('env').</p>"
+  :enabled t
+  (if (atom x)
+      '(t . t)
+    (cons (aig-partial-eval (car x) env)
+          (aig-partial-eval (cdr x) env))))
+
+(define faig-partial-eval-alist (x env)
+  :parents (faig-partial-eval)
+  :short "@(call faig-partial-eval-alist) partially evaluates an FAIG alist (an
+alist binding keys to FAIGs)."
+  :long "<p>The alist @('x') does not need to be fast, and we produce an
+ordinary (slow) alist as a result.</p>"
+  :enabled t
+  (b* (((when (atom x))
+        nil)
+       (rest (faig-partial-eval-alist (cdr x) env))
+       ((when (atom (car x)))
+        ;; Bad alist convention
+        rest))
+    (cons (cons (caar x) (faig-partial-eval (cdar x) env))
+          rest)))
+
+(define faig-partial-eval-alists (x env)
+  :parents (faig-partial-eval)
+  :short "@(call faig-partial-eval-alists) partially evaluates a list of FAIG
+alists."
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (faig-partial-eval-alist (car x) env)
+          (faig-partial-eval-alists (cdr x) env))))
+
+(define faig-fix (x)
+  :parents (faig)
+  :short "@(call faig-fix) is the identity for FAIGs, but coerces atoms to
+@('(t . t)'), i.e., X."
+  :long "<p>This is sometimes when reasoning about FAIG operations, and, e.g.,
+allows for permissive guards on @(see faig-constructors), etc.</p>"
+  :enabled t
+  ;; inline this one since it's used in the faig b* binder, and hence just
+  ;; about everywhere that faigs are being constructed or dealt with
+  :inline t
+  (if (consp x)
+      x
+    (faig-x)))
+
+(define faig-fix-list (x)
+  :parents (faig-fix)
+  :short "@(call faig-fix-list) fixes every element of a list with @(see
+faig-fix)."
+  :enabled t
+  (if (atom x)
+      nil
+    (cons (faig-fix (car x))
+          (faig-fix-list (cdr x)))))
+
+(define faig-fix-alist (x)
+  :parents (faig-fix)
+  :short "@(call faig-fix-alist) fixes every value in an alist with @(see
+faig-fix)."
+  :enabled t
+  (cond ((atom x)
+         nil)
+        ((atom (car x))
+         ;; Bad-alist convention
+         (faig-fix-alist (cdr x)))
+        (t
+         (cons (cons (caar x) (faig-fix (cdar x)))
+               (faig-fix-alist (cdr x))))))
+
+(def-b*-binder faig
+  ":doc-section B*-BINDERS
+Binds two variables to the onset and offset, respectively, of the
+faig-fix of the given expression.~/~/~/"
+  (declare (xargs :guard (and (true-listp args)
+                              (equal (len args) 2)
+                              (true-listp forms)
+                              (equal (len forms) 1))))
+  `(b* (((mv ,(first args) ,(second args))
+         (let ((x (faig-fix ,(car forms))))
+           (mv (car x) (cdr x)))))
+     ,rest-expr))
+
diff -Nru acl2-6.2/books/centaur/aig/faig-constructors.lisp acl2-6.3/books/centaur/aig/faig-constructors.lisp
--- acl2-6.2/books/centaur/aig/faig-constructors.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/faig-constructors.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,423 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+;
+; July 2011, Jared added some documentation and merged in the
+; faig-op-commutativity theorems.
+
+(in-package "ACL2")
+(include-book "faig-base")
+
+(defxdoc faig-constructors
+  :parents (faig)
+  :short "Low-level functions for constructing @(see faig)s."
+
+  :long "<p>These functions construct new FAIGs from existing ones.  They
+typically @(see hons)ing up some new onset and offset @(see aig)s by using the
+using @(see aig-constructors) like @(see aig-and) and @(see aig-not), and then
+@(see cons) those new onset/offset AIGs together to form a new FAIG.</p>
+
+<p>Most of these functions are geared toward modeling hardware.  For instance,
+@(see f-aig-and) is intended to produce a new FAIG that captures the
+four-valued logic semantics of an AND gate.</p>
+
+<box><p>Note: the details about how X and Z are handled by these functions are
+often subtle and this documentation doesn't really explain <i>why</i> these
+functions work the way they do.  <b>However</b>, for most functions here there
+are corresponding @(see 4v-operations), and the documentation there typically
+<i>does</i> explaining the X/Z behavior.</p></box>
+
+
+<h3>Three-valued (T-) vs. Four-valued (F-) constructors</h3>
+
+<p>There is an important optimization you can make when modeling hardware gates
+as FAIGs.  In particular, it is often possible to construct more
+efficient (smaller) FAIGs to represent the gate's output when you know that the
+gate's inputs cannot evaluate to Z.</p>
+
+<p>In CMOS designs, this property&mdash;never evaluating to Z&mdash;holds for
+the outputs of most logic gates.  Accordingly, it's true for most <i>inputs</i>
+to other gates.  For example, suppose you are trying to model a circuit like
+this:</p>
+
+@({
+        |\\  b
+     ---| >o---+
+        |/     |       ____
+               +------|    \\
+        |\             | and )---
+     ---| >o----------|____/   o
+        |/    a
+})
+
+<p>Here, we know that wires @('a') and @('b') can never have the value Z,
+because they are produced by NOT gates.  Accordingly, when we want to create
+the FAIG corresponding to @('o'), we can use an optimized, less-general
+implementation of the <i>and</i> gate, where we assume that our inputs are
+non-Z.</p>
+
+<p>Of course, some logic gates (e.g., tri-state buffers) <i>can</i> produce Z
+valued outputs, so occasionally these sorts of optimizations aren't possible.
+Because of this, we typically have two versions of each FAIG constructor:</p>
+
+<ul>
+
+<li>@('t-aig-*') functions make the assumption that their inputs are can never
+evaluate to Z.  These are generally more efficient, and will produce smaller
+AIGs that are easier to analyze with SAT solvers.</li>
+
+<li>@('f-aig-*') functions do not make this assumption.  This makes them more
+general purpose and able to operate on any FAIG inputs, at the cost of larger
+AIGs.</li>
+
+</ul>
+
+<h3>Rulesets</h3>
+
+<p>For historic reasons these functions are left enabled.  There are two
+useful @(see rulesets) you can use to disable them:</p>
+
+<ul>
+<li>@('f-aig-defs') has all of the @('f-') constructors.</li>
+<li>@('t-aig-defs') has all of the @('t-') constructors.</li>
+</ul>")
+
+
+; Macro to prove the FAIG constructors commute over FAIG-EVAL.
+
+(defun pfoc-faig-eval-args (args)
+  (if (atom args)
+      nil
+    (cons (list 'faig-eval (car args) 'env)
+          (pfoc-faig-eval-args (cdr args)))))
+
+(defun pfoc-arg-casesplit-list (args)
+  (if (atom args)
+      nil
+    (list* `(and stable-under-simplificationp
+                 '(:cases ((aig-eval (car ,(car args)) env))))
+           `(and stable-under-simplificationp
+                 '(:cases ((aig-eval (cdr ,(car args)) env))))
+           (pfoc-arg-casesplit-list (cdr args)))))
+
+(defmacro prove-faig-op-commutes (op args)
+  `(defthm ,(intern-in-package-of-symbol
+             (concatenate 'string "FAIG-EVAL-OF-" (symbol-name op))
+             op)
+     (equal (faig-eval (,op . ,args) env)
+            (,op . ,(pfoc-faig-eval-args args)))
+     :hints ,(pfoc-arg-casesplit-list args)))
+
+(define f-aig-unfloat (a)
+  :parents (faig-constructors)
+  :short "@(call f-aig-unfloat) converts floating (Z) values to unknown (X)
+values."
+  :long "<p>See @(see 4v-unfloat); this is the analogous function for
+FAIGs.</p>"
+  :enabled t
+  (b* (((faig a1 a0) a))
+    (cons (aig-not (aig-and a0 (aig-not a1)))
+          (aig-not (aig-and a1 (aig-not a0)))))
+  ///
+  (prove-faig-op-commutes f-aig-unfloat (a)))
+
+
+(define t-aig-not (a)
+  :parents (faig-constructors)
+  :short "@(call t-aig-not) negates the FAIG @('a'), assuming that it cannot
+evaluate to Z."
+  :inline t
+  :enabled t
+  (b* (((faig a1 a0) a))
+    (cons a0 a1))
+  ///
+  (prove-faig-op-commutes t-aig-not (a)))
+
+(define f-aig-not (a)
+  :parents (faig-constructors)
+  :short "@(call f-aig-not) negates the FAIG @('a')."
+  :enabled t
+  (b* (((faig a1 a0) a))
+    (cons (aig-not (aig-and a1 (aig-not a0)))
+          (aig-not (aig-and a0 (aig-not a1)))))
+  ///
+  (prove-faig-op-commutes f-aig-not (a)))
+
+
+(define t-aig-and (a b)
+  :parents (faig-constructors)
+  :short "@(call t-aig-and) <i>and</i>s together the FAIGs @('a') and @('b'),
+assuming they cannot evaluate to Z."
+  :enabled t
+  (b* (((faig a1 a0) a)
+       ((faig b1 b0) b))
+    (cons (aig-and a1 b1)
+          (aig-or  a0 b0)))
+  ///
+  (prove-faig-op-commutes t-aig-and (a b)))
+
+(define f-aig-and (a b)
+  :parents (faig-constructors)
+  :short "@(call f-aig-and) <i>and</i>s together the FAIGs @('a') and @('b')."
+  :enabled t
+  (b* ((a (f-aig-unfloat a))
+       (b (f-aig-unfloat b)))
+    (t-aig-and a b))
+  ///
+  (prove-faig-op-commutes f-aig-and (a b)))
+
+
+(define t-aig-or (a b)
+  :parents (faig-constructors)
+  :short "@(call t-aig-or) <i>or</i>s together the FAIGs @('a') and @('b'),
+assuming they cannot evaluate to Z."
+  :enabled t
+  (b* (((faig a1 a0) a)
+       ((faig b1 b0) b))
+    (cons (aig-or  a1 b1)
+          (aig-and a0 b0)))
+  ///
+  (prove-faig-op-commutes t-aig-or (a b)))
+
+(define f-aig-or (a b)
+  :parents (faig-constructors)
+  :short "@(call f-aig-or) <i>or</i>s together the FAIGs @('a') and @('b')."
+  :enabled t
+  (b* ((a (f-aig-unfloat a))
+       (b (f-aig-unfloat b)))
+    (t-aig-or a b))
+  ///
+  (prove-faig-op-commutes f-aig-or (a b)))
+
+
+(define t-aig-xor (a b)
+  :parents (faig-constructors)
+  :short "@(call t-aig-xor) <i>xor</i>s together the FAIGs @('a') and @('b'),
+assuming they cannot evaluate to Z."
+  :enabled t
+  (t-aig-or (t-aig-and a (t-aig-not b))
+            (t-aig-and (t-aig-not a) b))
+  ///
+  (prove-faig-op-commutes t-aig-xor (a b)))
+
+(define f-aig-xor (a b)
+  :parents (faig-constructors)
+  :short "@(call f-aig-xor) <i>xor</i>s together the FAIGs @('a') and @('b')."
+  :enabled t
+  (b* ((a (f-aig-unfloat a))
+       (b (f-aig-unfloat b)))
+    (t-aig-xor a b))
+  ///
+  (prove-faig-op-commutes f-aig-xor (a b)))
+
+
+(define t-aig-iff (a b)
+  :parents (faig-constructors)
+  :short "@(call t-aig-iff) <i>iff</i>s together the FAIGs @('a') and @('b'),
+assuming they cannot evaluate to Z."
+  :enabled t
+  (t-aig-or (t-aig-and a b)
+            (t-aig-and (t-aig-not a) (t-aig-not b)))
+  ///
+  (prove-faig-op-commutes t-aig-iff (a b)))
+
+(define f-aig-iff (a b)
+  :parents (faig-constructors)
+  :short "@(call f-aig-iff) <i>iff</i>s together the FAIGs @('a') and @('b')."
+  :enabled t
+  (b* ((a (f-aig-unfloat a))
+       (b (f-aig-unfloat b)))
+    (t-aig-iff a b))
+  ///
+  (prove-faig-op-commutes f-aig-iff (a b)))
+
+
+(define t-aig-ite (c a b)
+  :parents (faig-constructors)
+  :short "@(call t-aig-ite) constructs a (less conservative) FAIG representing
+@('(if c a b)'), assuming these input FAIGs cannot evaluate to Z."
+  :long "<p>This is a less-conservative version of @(see t-aig-ite*) that emits
+@('a') in the case that @('c') is unknown but @('a = b').  See @(see 4v-ite)
+for discussion related to this issue.</p>"
+  :enabled t
+  (b* (((faig a1 a0) a)
+       ((faig b1 b0) b)
+       ((faig c1 c0) c))
+    (cons (aig-or (aig-and c1 a1) (aig-and c0 b1))
+          (aig-or (aig-and c1 a0) (aig-and c0 b0))))
+  ///
+  (prove-faig-op-commutes t-aig-ite (c a b)))
+
+(define f-aig-ite (c a b)
+  :parents (faig-constructors)
+  :short "@(call f-aig-ite) constructs a (less conservative) FAIG representing
+@('(if c a b)')."
+  :long "<p>This is a less-conservative version of @(see f-aig-ite*) that emits
+@('a') in the case that @('c') is unknown but @('a = b').  See @(see 4v-ite)
+for discussion related to this issue.</p>"
+  :enabled t
+  (b* ((c (f-aig-unfloat c))
+       (a (f-aig-unfloat a))
+       (b (f-aig-unfloat b)))
+    (t-aig-ite c a b))
+  ///
+  (prove-faig-op-commutes f-aig-ite (c a b)))
+
+
+(define t-aig-ite* (c a b)
+  :parents (faig-constructors)
+  :short "@(call t-aig-ite*) constructs a (more conservative) FAIG representing
+@('(if c a b)'), assuming these input FAIGs cannot evaluate to Z."
+  :long "<p>This is a more-conservative version of @(see t-aig-ite) that emits
+@('X') in the case that @('c') is unknown, even when @('a = b').  See @(see
+4v-ite) for discussion related to this issue.</p>"
+  :enabled t
+  (b* (((faig a1 a0) a)
+       ((faig b1 b0) b)
+       ((faig c1 c0) c)
+       (x (aig-and c1 c0)))
+    (cons (aig-or x (aig-or (aig-and c1 a1) (aig-and c0 b1)))
+          (aig-or x (aig-or (aig-and c1 a0) (aig-and c0 b0)))))
+  ///
+  (prove-faig-op-commutes t-aig-ite* (c a b)))
+
+(define f-aig-ite* (c a b)
+  :parents (faig-constructors)
+  :short "@(call f-aig-ite*) constructs a (more conservative) FAIG representing
+@('(if c a b)'), assuming these input FAIGs cannot evaluate to Z."
+  :long "<p>This is a more-conservative version of @(see f-aig-ite) that emits
+@('X') in the case that @('c') is unknown, even when @('a = b').  See @(see
+4v-ite) for discussion related to this issue.</p>"
+  :enabled t
+  (b* ((c (f-aig-unfloat c))
+       (a (f-aig-unfloat a))
+       (b (f-aig-unfloat b)))
+    (t-aig-ite* c a b))
+  ///
+  (prove-faig-op-commutes f-aig-ite* (c a b)))
+
+(define f-aig-zif (c a b)
+  :parents (faig-constructors)
+  :short "@(call f-aig-zif) constructs an FAIG representing a kind of pass gate
+style mux."
+  :long "<p>This mainly exists to support @(see 4v-zif) in sexpr-to-faig
+conversion.</p>"
+  :enabled t
+  (b* ((c (f-aig-unfloat c)))
+    (t-aig-ite* c a b))
+  ///
+  (prove-faig-op-commutes f-aig-zif (c a b)))
+
+(define f-aig-res (x y)
+  :parents (faig-constructors)
+  :short "@(call f-aig-res) constructs a FAIG that represents the result of
+connecting two (independently driven) wires together."
+  :long "<p>See @(see 4v-res) to understand what this is doing.  This is just
+the @(see faig) equivalent.</p>"
+  :enabled t
+  (b* (((faig x1 x0) x)
+       ((faig y1 y0) y))
+    (cons (aig-or x1 y1) (aig-or x0 y0)))
+  ///
+  (prove-faig-op-commutes f-aig-res (a b)))
+
+
+;; Theorem: no F-AIG-UNFLOAT needed around the answer of f-aig-ite.
+;; (thm
+;;      (and
+;;       (iff (aig-eval (car (f-aig-unfloat (t-aig-ite (f-aig-unfloat c)
+;;                                                 (f-aig-unfloat a)
+;;                                                 (f-aig-unfloat b))))
+;;                      al)
+;;            (aig-eval (car (t-aig-ite (f-aig-unfloat c)
+;;                                      (f-aig-unfloat a)
+;;                                      (f-aig-unfloat b)))
+;;                      al))
+;;       (iff (aig-eval (cdr (f-aig-unfloat (t-aig-ite (f-aig-unfloat c)
+;;                                                 (f-aig-unfloat a)
+;;                                                 (f-aig-unfloat b))))
+;;                      al)
+;;            (aig-eval (cdr (t-aig-ite (f-aig-unfloat c)
+;;                                      (f-aig-unfloat a)
+;;                                      (f-aig-unfloat b)))
+;;                      al))))
+
+(define t-aig-tristate (c a)
+  :parents (faig-constructors)
+  :short "@(call t-aig-tristate) constructs an FAIG representing a tri-state
+buffer whose inputs are known to be non-X."
+  :long "<p>See also @(see 4v-tristate).</p>
+
+<p>Onset of output:</p>
+@({
+    (not (or (and (not c.on) c.off)
+             (and c.on (not c.off) (not a.on) a.off)))
+})
+
+<p>Offset of output:</p>
+@({
+    (not (or (and (not c.on) c.off)
+         (and c.on (not c.off) a.off (not a.on))))
+})"
+  (b* (((faig a1 a0) a)
+       ((faig c1 c0) c)
+       (float (aig-and (aig-not c1) c0))
+       (set   (aig-and c1 (aig-not c0)))
+       (on    (aig-and (aig-not a0) a1))
+       (off   (aig-and (aig-not a1) a0)))
+    (cons (aig-and (aig-not float) (aig-not (aig-and set off)))
+          (aig-and (aig-not float) (aig-not (aig-and set on)))))
+  ///
+  (prove-faig-op-commutes t-aig-tristate (c a)))
+
+(define f-aig-pullup (a)
+  :parents (faig-constructors)
+  :short "@(call f-aig-pullup) constructs an FAIG representing a pullup
+resistor."
+  (b* (((faig a1 a0) a)
+       (a-not-aig-floating (aig-or a1 a0))
+       (a-floating (aig-not a-not-aig-floating)))
+    (cons (aig-or a-floating a1) a0))
+  ///
+  (prove-faig-op-commutes f-aig-pullup (a)))
+
+
+(def-ruleset f-aig-defs
+  '(f-aig-unfloat
+    f-aig-not
+    f-aig-and
+    f-aig-or
+    f-aig-xor
+    f-aig-iff
+    f-aig-res
+    f-aig-ite
+    f-aig-ite*
+    f-aig-zif
+    t-aig-tristate
+    f-aig-pullup))
+
+(def-ruleset t-aig-defs
+  '(t-aig-and
+    t-aig-iff
+    t-aig-ite
+    t-aig-ite*
+    t-aig-not
+    t-aig-or
+    t-aig-xor))
+
diff -Nru acl2-6.2/books/centaur/aig/faig-equivs.lisp acl2-6.3/books/centaur/aig/faig-equivs.lisp
--- acl2-6.2/books/centaur/aig/faig-equivs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/faig-equivs.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,56 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+(include-book "aig-equivs")
+(include-book "faig-base")
+(set-verify-guards-eagerness 0)
+
+
+(defsection faig-equiv
+  :parents (faig)
+  :short "We say the FAIGs @('X') and @('Y') are equivalent when they always
+evaluate to the same value, per @(see faig-eval)."
+
+  (def-universal-equiv faig-equiv
+    :qvars env
+    :equiv-terms ((equal (faig-eval x env)))
+    :defquant t
+    :witness-dcls ((declare (xargs :guard t))))
+
+  (verify-guards faig-equiv))
+
+
+(defsection faig-alist-equiv
+  :parents (faig)
+  :short "We say the FAIG Alists @('X') and @('Y') are equivalent when they
+bind the same keys to equivalent FAIGs, in the sense of @(see faig-equiv)."
+
+  (def-universal-equiv faig-alist-equiv
+    :qvars k
+    :equiv-terms ((iff (hons-assoc-equal k x))
+                  (faig-equiv (cdr (hons-assoc-equal k x))))
+    :defquant t
+    :witness-dcls ((declare (xargs :guard t))))
+
+  (verify-guards faig-alist-equiv)
+
+  (defrefinement alist-equiv faig-alist-equiv
+    :hints ((witness))))
diff -Nru acl2-6.2/books/centaur/aig/faig-purebool-p.lisp acl2-6.3/books/centaur/aig/faig-purebool-p.lisp
--- acl2-6.2/books/centaur/aig/faig-purebool-p.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/faig-purebool-p.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,343 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>
+;                   Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+(include-book "aig-sat")
+(include-book "faig-base")
+
+(local (in-theory (disable faig-eval)))
+
+(defsection faig-purebool-p
+  :parents (faig)
+  :short "Does a FAIG always evaluate to a purely Boolean value, i.e., is it
+never X or Z?"
+
+  :long "<p>When an FAIG is known to be purely Boolean, then there is not much
+reason to represent it as an FAIG&mdash;we might as well throw its offset away
+and just work with its onset as an AIG.</p>
+
+<p>When you are dealing with nice, well-behaved, RTL-level circuits that don't
+use any fancy low-level, four-valued sorts of things like tri-state buffers,
+this can be a useful optimization.  For instance, it may reduce the complexity
+of SAT queries, or carry out other kinds of analysis where you don't have to
+think about four-valuedness.</p>
+
+<p>@(call faig-purebool-p) is a logically nice, but non-executable way to
+express pure Boolean-ness.  See also @(see faig-purebool-check), which can be
+executed; it uses a SAT solver to answer the question.</p>
+
+@(def faig-purebool-p)"
+
+  (defun-sk faig-purebool-p (x)
+    (forall (env)
+            (or (equal (faig-eval x env) (faig-t))
+                (equal (faig-eval x env) (faig-f)))))
+
+  (verify-guards faig-purebool-p))
+
+
+(define faig-purebool-aig ((x "A single FAIG."))
+  :parents (faig-purebool-p)
+  :short "An AIG that captures exactly when the FAIG X is Boolean valued."
+  :long "<p>This is useful mainly to implement @(see faig-purebool-check).</p>"
+  :returns aig
+  (b* ((x      (faig-fix x))
+       (onset  (car x))
+       (offset (cdr x)))
+    (aig-or (aig-and onset (aig-not offset))
+            (aig-and offset (aig-not onset))))
+  ///
+  (local (defthm l0
+           (implies (not (aig-eval (faig-purebool-aig x) env))
+                    (not (faig-purebool-p x)))
+           :hints(("Goal"
+                   :in-theory (e/d (faig-eval)
+                                   (faig-purebool-p
+                                    faig-purebool-p-necc))
+                   :use ((:instance faig-purebool-p-necc
+                                    (env env)))))))
+
+  (local (defthm l1
+           (implies (not (faig-purebool-p x))
+                    (not (aig-eval (faig-purebool-aig x)
+                                   (faig-purebool-p-witness x))))
+           :hints(("Goal"
+                   :in-theory (e/d (faig-eval)
+                                   (faig-purebool-p))
+                   :use ((:instance faig-purebool-p))))))
+
+  (local (in-theory (disable faig-purebool-aig)))
+
+  (local (defthm l2
+           (implies (faig-purebool-p x)
+                    (aig-eval (faig-purebool-aig x) env))))
+
+  (defthmd faig-purebool-p-as-aig-eval
+    (equal (faig-purebool-p x)
+           (aig-eval (faig-purebool-aig x)
+                     (faig-purebool-p-witness x))))
+
+  (defthm faig-purebool-p-monotonicity
+    (implies (not (aig-eval (faig-purebool-aig x) env))
+             (not (aig-eval (faig-purebool-aig x)
+                            (faig-purebool-p-witness x))))))
+
+
+
+(define faig-purebool-check
+  :parents (faig-purebool-p)
+  :short "An executable version of @(see faig-purebool-p) using SAT."
+  ((x "The FAIG to check.")
+   &key
+   ((config satlink::config-p) 'satlink::*default-config*))
+  :returns (mv (fail     booleanp :rule-classes :type-prescription
+                         "If true, calling the SAT solver failed and the other
+                          answers are meaningless.")
+
+               (purebool booleanp :rule-classes :type-prescription
+                         "Does this FAIG always evaluate to purely Boolean?")
+
+               (alist    "When this FAIG is not purely Boolean: an example
+                          environment for @(see faig-eval) that drives it to
+                          X or Z."))
+
+  (b* ((aig               (faig-purebool-aig x))
+       ((mv status alist) (aig-sat (aig-not aig) :config config))
+       ((when (eq status :sat))
+        (mv nil nil alist))
+       ((when (eq status :unsat))
+        (mv nil t nil)))
+    (mv t nil nil))
+
+  ///
+  (local (defthm l0
+           (b* (((mv fail purebool ?alist)
+                 (faig-purebool-check x :config config)))
+             (implies (and (not fail)
+                           (not purebool))
+                      (not (faig-purebool-p x))))
+           :hints(("Goal"
+                   :in-theory (e/d (faig-purebool-p-as-aig-eval)
+                                   (aig-sat-when-sat))
+                   :use ((:instance aig-sat-when-sat
+                                    (aig (aig-not (faig-purebool-aig x)))))))))
+
+  (local (defthm l1
+           (b* (((mv fail purebool ?alist)
+                 (faig-purebool-check x :config config)))
+             (implies (and (not fail)
+                           purebool)
+                      (faig-purebool-p x)))
+           :hints(("Goal"
+                   :in-theory (e/d (faig-purebool-p-as-aig-eval)
+                                   (aig-sat-when-unsat))
+                   :use ((:instance aig-sat-when-unsat
+                                    (aig (aig-not (faig-purebool-aig x)))
+                                    (env (faig-purebool-p-witness x))))))))
+
+  (defthm faig-purebool-check-correct
+    (b* (((mv fail purebool ?alist)
+          (faig-purebool-check x :config config)))
+      (implies (not fail)
+               (equal purebool
+                      (faig-purebool-p x))))
+    :hints(("Goal"
+            :use ((:instance l0)
+                  (:instance l1)))))
+
+  (local (defthm l2
+           (b* (((mv fail purebool alist)
+                 (faig-purebool-check x :config config)))
+             (implies (and (not fail)
+                           (not purebool))
+                      (and (not (equal (faig-eval x alist) (faig-f)))
+                           (not (equal (faig-eval x alist) (faig-t))))))
+           :hints(("Goal"
+                   :in-theory (e/d (faig-purebool-p-as-aig-eval
+                                    faig-purebool-aig
+                                    faig-eval)
+                                   (aig-sat-when-sat))
+                   :use ((:instance aig-sat-when-sat
+                                    (aig (aig-not (faig-purebool-aig x)))))))))
+
+  (defthm faig-purebool-counterexample-correct
+    (b* (((mv fail ?purebool alist)
+          (faig-purebool-check x :config config)))
+      (implies (and (not fail)
+                    (not (faig-purebool-p x)))
+               (and (not (equal (faig-eval x alist) (faig-f)))
+                    (not (equal (faig-eval x alist) (faig-t))))))
+    :hints(("Goal"
+            :in-theory (disable faig-purebool-check-correct
+                                faig-purebool-check)
+            :use ((:instance l1))))))
+
+
+
+
+
+(cutil::deflist faig-purebool-list-p (x)
+  (faig-purebool-p x)
+  :guard t
+  :parents (faig-purebool-p)
+  :short "Do a list of FAIGs always evaluate to purely Boolean values, i.e.,
+are they never X or Z?"
+
+  :long "<p>This is a logically nice, but non-executable way to express pure
+Boolean-ness.  See also @(see faig-purebool-list-check), which can be executed;
+it uses a SAT solver to answer the question.</p>")
+
+
+(define faig-purebool-list-witness (x)
+  (cond ((atom x)
+         nil)
+        ((faig-purebool-p (car x))
+         (faig-purebool-list-witness (cdr x)))
+        (t
+         (faig-purebool-p-witness (car x))))
+  ///
+  (defthm faig-purebool-list-witness-when-atom
+    (implies (atom x)
+             (equal (faig-purebool-list-witness x)
+                    nil)))
+
+  (defthm faig-purebool-list-witness-of-cons
+    (equal (faig-purebool-list-witness (cons a x))
+           (if (faig-purebool-p a)
+               (faig-purebool-list-witness x)
+             (faig-purebool-p-witness a)))))
+
+
+(define faig-purebool-list-aig ((x "An FAIG List"))
+  :returns (aig)
+  :parents (faig-purebool-list-p)
+  :short "An AIG that captures exactly when a list of FAIGs always evaluate to
+purely Boolean values."
+  :long "<p>This is useful mainly to implement @(see
+faig-purebool-list-check).</p>"
+  (if (atom x)
+      t
+    (aig-and (faig-purebool-aig (car x))
+             (faig-purebool-list-aig (cdr x))))
+  ///
+
+  (local (defthm l0
+           (implies (not (aig-eval (faig-purebool-list-aig x) env))
+                    (not (faig-purebool-list-p x)))
+           :hints(("Goal"
+                   :in-theory (enable faig-purebool-p-as-aig-eval)))))
+
+  (local (defthm l1
+           (implies (not (faig-purebool-list-p x))
+                    (not (aig-eval (faig-purebool-list-aig x)
+                                   (faig-purebool-list-witness x))))
+           :hints(("Goal"
+                   :induct (len x)
+                   :in-theory (e/d (faig-purebool-list-witness
+                                    faig-purebool-p-as-aig-eval))))))
+
+  (local (in-theory (disable faig-purebool-list-aig)))
+
+  (local (defthm l2
+           (implies (faig-purebool-list-p x)
+                    (aig-eval (faig-purebool-list-aig x) env))))
+
+  (defthmd faig-purebool-list-p-as-aig-eval
+    (equal (faig-purebool-list-p x)
+           (aig-eval (faig-purebool-list-aig x)
+                     (faig-purebool-list-witness x)))
+    :hints(("Goal" :cases ((faig-purebool-list-p x)))))
+
+  (defthm faig-purebool-list-p-monotonicity
+    (implies (not (aig-eval (faig-purebool-list-aig x) env))
+             (not (aig-eval (faig-purebool-list-aig x)
+                            (faig-purebool-list-witness x))))))
+
+
+
+
+
+(define faig-purebool-list-check
+  :parents (faig-purebool-list-p)
+  :short "An executable version of @(see faig-purebool-list-p) using SAT."
+  ((x "The FAIG List to check.")
+   &key
+   ((config satlink::config-p) 'satlink::*default-config*))
+  :returns (mv (fail     booleanp :rule-classes :type-prescription
+                         "If true, calling the SAT solver failed and the other
+                          answers are meaningless.")
+
+               (purebool-list booleanp :rule-classes :type-prescription
+                              "Do these FAIGs always evaluate to purely Boolean?")
+
+               (alist    "When these FAIGs are not purely Boolean: an example
+                          environment for @(see faig-eval-list) that drives
+                          some FAIG to X or Z."))
+
+  (b* ((aig               (faig-purebool-list-aig x))
+       ((mv status alist) (aig-sat (aig-not aig) :config config))
+       ((when (eq status :sat))
+        (mv nil nil alist))
+       ((when (eq status :unsat))
+        (mv nil t nil)))
+    (mv t nil nil))
+
+  ///
+  (local (defthm l0
+           (b* (((mv fail purebool-list ?alist)
+                 (faig-purebool-list-check x :config config)))
+             (implies (and (not fail)
+                           (not purebool-list))
+                      (not (faig-purebool-list-p x))))
+           :hints(("Goal"
+                   :in-theory (e/d (faig-purebool-list-p-as-aig-eval)
+                                   (aig-sat-when-sat))
+                   :use ((:instance aig-sat-when-sat
+                                    (aig (aig-not (faig-purebool-list-aig x)))))))))
+
+  (local (defthm l1
+           (b* (((mv fail purebool-list ?alist)
+                 (faig-purebool-list-check x :config config)))
+             (implies (and (not fail)
+                           purebool-list)
+                      (faig-purebool-list-p x)))
+           :hints(("Goal"
+                   :in-theory (e/d (faig-purebool-list-p-as-aig-eval)
+                                   (aig-sat-when-unsat))
+                   :use ((:instance aig-sat-when-unsat
+                                    (aig (aig-not (faig-purebool-list-aig x)))
+                                    (env (faig-purebool-list-witness x))))))))
+
+  (defthm faig-purebool-list-check-correct
+    (b* (((mv fail purebool-list ?alist)
+          (faig-purebool-list-check x :config config)))
+      (implies (not fail)
+               (equal purebool-list
+                      (faig-purebool-list-p x))))
+    :hints(("Goal"
+            :use ((:instance l0)
+                  (:instance l1)))))
+
+  ;; BOZO could eventually prove that the alist returned does indeed drive at
+  ;; least some FAIG to X or Z.
+
+  )
+
diff -Nru acl2-6.2/books/centaur/aig/g-aig-eval.lisp acl2-6.3/books/centaur/aig/g-aig-eval.lisp
--- acl2-6.2/books/centaur/aig/g-aig-eval.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/g-aig-eval.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -104,6 +104,17 @@
                                                   x hyp)))
                  (hons-assoc-equal key x)))))
 
+(defthm deps-of-gobj-alist-to-bfr-alist
+  (implies (and (not (gl::gobj-depends-on k p x))
+                (atom-key-gobj-val-alistp x))
+           (and (not (gl::pbfr-list-depends-on
+                      k p (alist-vals (mv-nth 0 (gobj-alist-to-bfr-alist x hyp)))))
+                (not (gl::pbfr-depends-on
+                      k p (mv-nth 1 (gobj-alist-to-bfr-alist x hyp))))))
+  :hints(("Goal" :induct (gobj-alist-to-bfr-alist x hyp)
+          :in-theory (enable gl::pbfr-list-depends-on)
+          :expand ((gl::gobj-depends-on k p x)))))
+
 
 
 
@@ -257,7 +268,7 @@
  
    (local (in-theory (disable atom-key-gobj-val-alistp
                               suffixp ; car-member-when-suffix
-                              faig-bddify-pat)))))
+                              )))))
 
 
 
@@ -270,6 +281,10 @@
     (cons (gl::g-boolean (car x))
           (g-boolean-list (cdr x)))))
 
+(defthm deps-of-g-boolean-list
+  (implies (not (gl::pbfr-list-depends-on k p x))
+           (not (gl::gobj-depends-on k p (g-boolean-list x)))))
+
 
 (local
  (progn
@@ -322,6 +337,70 @@
    :bdd (aig-q-compose x al)
    :aig (aig-compose x al)))
 
+(local (defthm bfr-aig-q-compose
+         (implies (not (gl::bfr-mode))
+                  (equal (aig-q-compose x fal)
+                         (AIG-CASES
+                          X
+                          :TRUE T
+                          :FALSE NIL
+                          :VAR (AIG-ENV-LOOKUP X FAL)
+                          :INV (gl::bfr-not (AIG-Q-COMPOSE (CAR X) FAL))
+                          :AND (LET ((A (AIG-Q-COMPOSE (CAR X) FAL)))
+                                    (AND A
+                                         (gl::bfr-binary-and A (AIG-Q-COMPOSE (CDR X)
+                                                                              FAL)))))))
+         :hints(("Goal" :in-theory (enable gl::bfr-not gl::bfr-binary-and)))
+         :rule-classes ((:definition :controller-alist ((aig-q-compose t
+                                                                       nil))))))
+
+(defthm deps-of-hons-assoc-equal
+  (implies (not (gl::pbfr-list-depends-on k p (alist-vals al)))
+           (not (gl::pbfr-depends-on k p (cdr (hons-assoc-equal x al)))))
+  :hints(("Goal" :in-theory (enable hons-assoc-equal
+                                    gl::pbfr-list-depends-on))))
+
+(defthm deps-of-aig-env-lookup
+  (implies (not (gl::pbfr-list-depends-on k p (alist-vals al)))
+           (not (gl::pbfr-depends-on k p (aig-env-lookup x al))))
+  :hints(("Goal" :in-theory (enable aig-env-lookup))))
+
+(defthm deps-of-aig-q-compose
+  (implies (and (not (gl::pbfr-list-depends-on k p (alist-vals al)))
+                (not (gl::bfr-mode)))
+           (not (gl::pbfr-depends-on k p (aig-q-compose x al))))
+  :hints (("goal" :induct (aig-q-compose x al))))
+
+(local (defthm bfr-aig-compose
+         (implies (gl::bfr-mode)
+                  (equal (aig-compose x fal)
+                         (AIG-CASES
+                          X
+                          :TRUE T
+                          :FALSE NIL
+                          :VAR (AIG-ENV-LOOKUP X FAL)
+                          :INV (gl::bfr-not (AIG-COMPOSE (CAR X) FAL))
+                          :AND (LET ((A (AIG-COMPOSE (CAR X) FAL)))
+                                    (AND A
+                                         (gl::bfr-binary-and A (AIG-COMPOSE (CDR X)
+                                                                            FAL)))))))
+         :hints(("Goal" :in-theory (enable gl::bfr-not gl::bfr-binary-and aig-compose)))
+         :rule-classes ((:definition :controller-alist ((aig-compose t
+                                                                     nil))))))
+
+(defthm deps-of-aig-compose
+  (implies (and (not (gl::pbfr-list-depends-on k p (alist-vals al)))
+                (gl::bfr-mode))
+           (not (gl::pbfr-depends-on k p (aig-compose x al))))
+  :hints (("goal" :induct (aig-compose x al)
+           :in-theory (enable (:i aig-compose)))))
+
+(defthm deps-of-aig-bfr-compose
+  (implies (not (gl::pbfr-list-depends-on k p (alist-vals al)))
+           (not (gl::pbfr-depends-on k p (aig-bfr-compose x al)))))
+
+
+
 (defun aig-bfr-compose-list (x al)
   (if (atom x)
       nil
@@ -329,6 +408,13 @@
           (aig-bfr-compose-list (cdr x) al))))
 
 
+(defthm deps-of-aig-bfr-compose-list
+  (implies (not (gl::pbfr-list-depends-on k p (alist-vals al)))
+           (not (gl::pbfr-list-depends-on k p (aig-bfr-compose-list x al))))
+  :hints(("Goal" :in-theory (e/d (gl::pbfr-list-depends-on)
+                                 (aig-bfr-compose)))))
+
+
 
 (defthm bfr-eval-of-aig-bfr-compose
   (equal (bfr-eval (aig-bfr-compose x al) env)
@@ -367,6 +453,71 @@
                                     aig-bddify-list-ok)
           :induct (len aigs))))
 
+
+
+
+(local
+ #!GL
+ (progn
+   (defun pbfr-list-depends-on-witness (k p x)
+     (if (atom x)
+         nil
+       (if (pbfr-semantic-depends-on k p (car x))
+           (mv-let (env v)
+             (pbfr-semantic-depends-on-witness k p (car x))
+             (list env v))
+         (pbfr-list-depends-on-witness k p (cdr x)))))
+
+   (defthm pbfr-list-depends-on-witness-iff
+     (implies (not (bfr-mode))
+              (iff (pbfr-list-depends-on-witness k p x)
+                   (pbfr-list-depends-on k p x)))
+     :hints(("Goal" :in-theory (enable pbfr-list-depends-on
+                                       pbfr-depends-on))))
+
+   (defthm pbfr-list-depends-on-by-witness
+     (implies (and (acl2::rewriting-negative-literal
+                    `(pbfr-list-depends-on ,k ,p ,x))
+                   (not (bfr-mode)))
+              (equal (pbfr-list-depends-on k p x)
+                     (mv-let (env v) (pbfr-list-depends-on-witness k p x)
+                       (and (bfr-eval p env)
+                            (bfr-eval p (bfr-set-var k v env))
+                            (not (equal (bfr-eval-list x (bfr-param-env p (bfr-set-var k v env)))
+                                        (bfr-eval-list x (bfr-param-env p env))))))))
+     :hints(("Goal" :in-theory (enable pbfr-list-depends-on
+                                       pbfr-depends-on
+                                       bfr-eval-list))
+            (and stable-under-simplificationp
+                 '(:expand ((pbfr-semantic-depends-on k p (car x)))))))))
+
+(defthm bfr-eval-alist-when-set-non-dep
+  (implies (and (not (gl::pbfr-list-depends-on k p (alist-vals bfr-al)))
+                (gl::bfr-eval p env)
+                (gl::bfr-eval p (gl::bfr-set-var k v env)))
+           (equal (gl::bfr-eval-alist
+                   bfr-al (gl::bfr-param-env p (gl::bfr-set-var k v env)))
+                  (gl::bfr-eval-alist
+                   bfr-al (gl::bfr-param-env p env))))
+  :hints(("Goal" :in-theory (enable gl::pbfr-list-depends-on alist-vals))))
+
+
+
+(defthm deps-of-aig-bfrify-list
+  (mv-let (res exact)
+    (aig-bfrify-list tries aigs bfr-al maybe-wash-args)
+    (implies (and exact
+                  (not (gl::pbfr-list-depends-on k p (alist-vals bfr-al))))
+             (not (gl::pbfr-list-depends-on k p res))))
+  :hints(("Goal" :in-theory (disable aig-bfrify-list)
+          :cases ((gl::bfr-mode)))
+         (cond ((member-equal '(not (gl::bfr-mode)) clause)
+                '(:in-theory (enable aig-bfrify-list
+                                     gl::pbfr-list-depends-on
+                                     gl::pbfr-depends-on
+                                     gl::bfr-depends-on
+                                     gl::bfr-from-param-space)))))
+  :otf-flg t)
  
 
 
@@ -420,6 +571,13 @@
               (gl::g-apply 'aig-eval-list (gl::gl-list x al))))))
 
 
+(defthm deps-of-aig-eval-list-symbolic
+  (implies (and (not (gl::gobj-depends-on k p x))
+                (not (gl::gobj-depends-on k p al)))
+           (not (gl::gobj-depends-on k p (aig-eval-list-symbolic
+                                          x al tries maybe-wash-args hyp clk)))))
+
+
 
 
 
@@ -437,8 +595,10 @@
 
 (make-event
  `(defun ,(gl-fnsym 'aig-eval-list-with-bddify)
-    (x al tries maybe-wash-args hyp clk)
-    (declare (xargs :guard t))
+    (x al tries maybe-wash-args hyp clk config gl::bvar-db state)
+    (declare (xargs :guard t
+                    :stobjs (gl::bvar-db state))
+             (ignore config gl::bvar-db state))
     (aig-eval-list-symbolic x al tries maybe-wash-args hyp clk)))
 
 
@@ -455,7 +615,7 @@
   (make-event 
    `(acl2::without-waterfall-parallelism
      (gl::def-eval-g aig-eval-ev
-                     ,(list* 'aig-eval-list
+                     ,(list* 'aig-eval-list 'if 'cons
                              (cdar (table-alist 'gl::g-apply-table (w state))))))))
 
 (local
@@ -524,6 +684,13 @@
                                               aig-bddify-list))
             :do-not-induct t))))
 
+(local (in-theory (disable aig-eval-list-symbolic)))
+
+(gl::def-gobj-dependency-thm 
+ aig-eval-list-with-bddify
+ :hints`(("Goal" :in-theory (e/d (,gl::gfn)
+                                 (gl::gobj-depends-on)))))
+
 (gl::def-g-correct-thm ;;  g-aig-eval-list-with-bddify-correct
   aig-eval-list-with-bddify aig-eval-ev
   :hints `(("goal" :in-theory (e/d (aig-eval-list-with-bddify)
@@ -536,8 +703,6 @@
 
 (gl::set-preferred-def aig-eval-with-bddify
        aig-eval-in-terms-of-aig-eval-list)
-(gl::set-preferred-def aig-eval-pat-with-bddify
-       aig-eval-pat-in-terms-of-aig-eval-list)
 (gl::set-preferred-def aig-eval-alist-with-bddify
        aig-eval-alist-in-terms-of-aig-eval-list)
 
@@ -545,8 +710,6 @@
                        faig-eval-in-terms-of-faig-eval-list)
 (gl::set-preferred-def faig-eval-list-with-bddify
        faig-eval-list-in-terms-of-aig-eval-list)
-(gl::set-preferred-def faig-eval-pat-with-bddify
-       faig-eval-pat-in-terms-of-faig-eval-list)
 (gl::set-preferred-def faig-eval-alist-with-bddify
        faig-eval-alist-in-terms-of-faig-eval-list)
 
@@ -556,17 +719,11 @@
 (gl::set-preferred-def aig-eval-list aig-eval-list-in-terms-of-with-bddify)
 (table gl::override-props 'aig-eval-list '((recursivep . nil)))
 
-(gl::set-preferred-def aig-eval-pat aig-eval-pat-in-terms-of-with-bddify)
-(table gl::override-props 'aig-eval-pat '((recursivep . nil)))
-
 (gl::set-preferred-def faig-eval faig-eval-in-terms-of-with-bddify)
 
 (gl::set-preferred-def faig-eval-list faig-eval-list-in-terms-of-with-bddify)
 (table gl::override-props 'faig-eval-list '((recursivep . nil)))
 
-(gl::set-preferred-def faig-eval-pat faig-eval-pat-in-terms-of-with-bddify)
-(table gl::override-props 'faig-eval-pat '((recursivep . nil)))
-
 (gl::set-preferred-def aig-eval-alist aig-eval-alist-in-terms-of-with-bddify)
 (table gl::override-props 'aig-eval-alist '((recursivep . nil)))
 
diff -Nru acl2-6.2/books/centaur/aig/induction.lisp acl2-6.3/books/centaur/aig/induction.lisp
--- acl2-6.2/books/centaur/aig/induction.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/induction.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -78,7 +78,7 @@
            :induct (check-property-strong updates prop curr-st inputs))
           (and stable-under-simplificationp
                (cond
-                ((member-equal 
+                ((member-equal
                   '(AIG-EVAL PROP (binary-APPEND CURR-ST (CAR INPUTS)))
                   clause)
                  '(:use ((:instance check-ag-property-necc
@@ -98,7 +98,7 @@
                                           (if (consp rest)
                                               rest
                                             (list nil)))))))))))))
-  
+
 
 
 (defun-sk unsat-p (x)
@@ -173,9 +173,9 @@
 ;; initialization, then check-property is always true.
 ;; One subtlety: here the initial state may be partial, i.e. an alist that does
 ;; not bind all the state variables.  In this case the full initial state
-;; applied is determined by the first input vector.  
+;; applied is determined by the first input vector.
 (defthm inductive-invariant-impl-check-property
-  (implies (and 
+  (implies (and
             ;; The variables of the invariant must be state variables, not inputs
             (subsetp-equal (aig-vars invar)
                            (alist-keys updates))
@@ -193,7 +193,7 @@
            :in-theory (disable unsat-p))))
 
 (defthm inductive-invariant-impl-check-ag-property
-  (implies (and 
+  (implies (and
             ;; The variables of the invariant must be state variables, not inputs
             (subsetp-equal (aig-vars invar)
                            (alist-keys updates))
@@ -209,7 +209,7 @@
            (check-ag-property updates prop initst)))
 
 (defthm inductive-invariant-impl-check-property-strong
-  (implies (and 
+  (implies (and
             ;; The variables of the invariant must be state variables, not inputs
             (subsetp-equal (aig-vars invar)
                            (alist-keys updates))
diff -Nru acl2-6.2/books/centaur/aig/misc.lisp acl2-6.3/books/centaur/aig/misc.lisp
--- acl2-6.2/books/centaur/aig/misc.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/misc.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -21,100 +21,45 @@
 
 (in-package "ACL2")
 
-(include-book "base")
+(include-book "aig-base")
 (include-book "centaur/misc/equal-sets" :dir :system)
 (include-book "tools/mv-nth" :dir :system)
 (include-book "misc/gentle" :dir :system)
 (include-book "misc/hons-help" :dir :system)
 (local (include-book "std/alists/alistp" :dir :system))
-(local (include-book "eval-restrict"))
+; (local (include-book "eval-restrict"))
 
-(local (in-theory (disable append-of-nil)))
+;; (local (in-theory (disable append-of-nil)))
 
-(defn aig-print (x)
-  (declare (xargs :verify-guards nil))
-  (aig-cases
-   x
-   :true t
-   :false nil
-   :var x
-   :inv `(not ,(aig-print (car x)))
-   :and (let* ((a (aig-print (car x)))
-               (d (aig-print (cdr x))))
-          `(and ,@(if (and (consp a) (eq (car a) 'and))
-                      (cdr a)
-                    (list a))
-                ,@(if (and (consp d) (eq (car d) 'and))
-                      (cdr d)
-                    (list d))))))
-
-;; (local
-;;  (defthm true-listp-append
-;;    (implies (true-listp b)
-;;             (true-listp (append a b)))))
-(local
- (defthm true-listp-cdr-aig-print
-   (implies (and (consp (aig-print x))
-                 (eq (car (aig-print x)) 'and))
-            (true-listp (cdr (aig-print x))))))
-
-(verify-guards aig-print)
-
-(memoize 'aig-print :condition '(consp x))
+
+;; BOZO misplaced
+
+(local (defthm true-listp-of-make-fal
+         (implies (true-listp name)
+                  (true-listp (make-fal al name)))))
+
+(defthm make-fal-is-append
+  (implies (alistp x)
+           (equal (make-fal x y) (append x y))))
+
+(defthm aig-eval-alist-append
+  (equal (aig-eval-alist (append a b) env)
+         (append (aig-eval-alist a env)
+                 (aig-eval-alist b env))))
 
 
 
-;; Forms an AIG from an ACL2-like term.
-(mutual-recursion
- (defun expr-to-aig (expr)
-   (declare (Xargs :guard t
-                   :measure (+ 1 (* 2 (acl2-count expr)))))
-   (if (atom expr)
-       expr
-     (let ((fn (car expr))
-           (args (cdr expr)))
-       (cond
-        ((and (eq fn 'not) (= (len args) 1))
-         (aig-not (expr-to-aig (car args))))
-        ((eq fn 'and) (expr-to-aig-args 'and t args))
-        ((eq fn 'or)  (expr-to-aig-args 'or nil args))
-        ((eq fn 'nand) (aig-not (expr-to-aig-args 'and t args)))
-        ((eq fn 'nor)  (aig-not (expr-to-aig-args 'or nil args)))
-        ((and (eq fn 'iff) (= (len args) 2))
-         (aig-iff (expr-to-aig (car args))
-                  (expr-to-aig (cadr args))))
-        ((and (eq fn 'xor) (= (len args) 2))
-         (aig-xor (expr-to-aig (car args))
-                  (expr-to-aig (cadr args))))
-        ((and (eq fn 'implies) (= (len args) 2))
-         (aig-or (aig-not (expr-to-aig (car args)))
-                 (expr-to-aig (cadr args))))
-        ((and (eq fn 'if) (= (len args) 3))
-         (aig-ite (expr-to-aig (car args))
-                  (expr-to-aig (cadr args))
-                  (expr-to-aig (caddr args))))
-        (t (prog2$ (er hard? 'expr-to-aig "Malformed: ~x0~%" expr)
-                   nil))))))
- (defun expr-to-aig-args (op final exprs)
-   (declare (xargs :guard t
-                   :measure (* 2 (acl2-count exprs))))
-   (if (atom exprs)
-       final
-     (let ((first (expr-to-aig (car exprs)))
-           (rest (expr-to-aig-args op final (cdr exprs))))
-       (case op
-         (and (aig-and first rest))
-         (or (aig-or first rest)))))))
-
-(defun faig-vars-pat (pat aigs)
-  (if pat
-      (if (atom pat)
-          (list :signal pat
-                (aig-vars (car aigs))
-                (aig-vars (cdr aigs)))
-        (cons (faig-vars-pat (car pat) (car aigs))
-              (faig-vars-pat (cdr pat) (cdr aigs))))
-    nil))
+
+
+;; (defun faig-vars-pat (pat aigs)
+;;   (if pat
+;;       (if (atom pat)
+;;           (list :signal pat
+;;                 (aig-vars (car aigs))
+;;                 (aig-vars (cdr aigs)))
+;;         (cons (faig-vars-pat (car pat) (car aigs))
+;;               (faig-vars-pat (cdr pat) (cdr aigs))))
+;;     nil))
 
 
 ;; Extracts necessary variable assignments from an AIG by breaking down its
@@ -258,29 +203,33 @@
               (make-fal (assign-var-list falses nil)
                         nil))))
 
-(local (defthm true-listp-of-make-fal
-         (implies (true-listp name)
-                  (true-listp (make-fal al name)))))
-
 (local (defthm true-listp-of-aig-extract-assigns-alist
          (true-listp (aig-extract-assigns-alist x))))
 
-(defthm make-fal-is-append
-  (implies (alistp x)
-           (equal (make-fal x y) (append x y))))
 
 (defthm alistp-aig-extract-assigns-alist
   (alistp (aig-extract-assigns-alist x)))
 
-(defthm aig-eval-alist-append
-  (equal (aig-eval-alist (append a b) env)
-         (append (aig-eval-alist a env)
-                 (aig-eval-alist b env))))
-
 (defthm aig-eval-alist-aig-extract-assigns-alist
   (equal (aig-eval-alist (aig-extract-assigns-alist x) env)
          (aig-extract-assigns-alist x)))
 
+(defthm assign-var-list-lookup
+  (equal (hons-assoc-equal k (assign-var-list x v))
+         (and (member k x)
+              (cons k v)))
+  :hints(("Goal" :in-theory (enable assign-var-list hons-assoc-equal member))))
+
+(local (defthm hons-assoc-equal-of-append
+         (equal (hons-assoc-equal k (append x y))
+                (or (hons-assoc-equal k x)
+                    (hons-assoc-equal k y)))))
+
+(defthmd aig-extract-assigns-alist-lookup-boolean
+  (booleanp (cdr (hons-assoc-equal k (aig-extract-assigns-alist x))))
+  :hints(("Goal" :in-theory (enable aig-extract-assigns-alist)))
+  :rule-classes :type-prescription)
+
 
 (defthm aig-extract-assigns-restrict
 ;;   (implies (aig-eval x env)
@@ -344,6 +293,12 @@
   :hints (("goal" :use ((:instance aig-extract-iterated-assigns-restrict
                                    (env nil))))))
 
+(defthmd aig-extract-iterated-assigns-alist-lookup-boolean
+  (booleanp (cdr (hons-assoc-equal k (aig-extract-iterated-assigns-alist x clk))))
+  :hints(("Goal" :in-theory (enable aig-extract-iterated-assigns-alist
+                                    aig-extract-assigns-alist-lookup-boolean)))
+  :rule-classes :type-prescription)
+
 
 (memoize 'aig-extract-iterated-assigns-alist
          :recursive nil)
diff -Nru acl2-6.2/books/centaur/aig/portcullis.acl2 acl2-6.3/books/centaur/aig/portcullis.acl2
--- acl2-6.2/books/centaur/aig/portcullis.acl2	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/portcullis.acl2	2013-09-30 17:53:11.000000000 +0000
@@ -19,8 +19,8 @@
 ; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
-(ld "centaur/vl/package.lsp" :dir :system)
-(ld "centaur/vl/other-packages.lsp" :dir :system)
+(include-book "centaur/vl/portcullis" :dir :system)
+(include-book "centaur/satlink/portcullis" :dir :system)
+(include-book "centaur/aignet/portcullis" :dir :system)
 (ld "fsm-pkg.lsp")
 ; cert-flags: ? t :ttags :all
-(certify-book "portcullis" ? t :ttags :all)
diff -Nru acl2-6.2/books/centaur/aig/random-sim.lisp acl2-6.3/books/centaur/aig/random-sim.lisp
--- acl2-6.2/books/centaur/aig/random-sim.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/random-sim.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -24,123 +24,116 @@
 ;; Functions for performing fixnum-length data-parallel simulations on AIGs.
 ;; Much slower than AIGPU, you can be sure :-)
 (include-book "aig-equivs")
-(include-book "misc")
+(include-book "system/random" :dir :system)
 (include-book "centaur/bitops/equal-by-logbitp" :dir :system)
 (local (include-book "centaur/bitops/ihs-extensions" :dir :system))
 (local (include-book "ihs/quotient-remainder-lemmas" :dir :system))
-(local (include-book "data-structures/list-defthms" :dir :system))
-(local (include-book "eval-restrict"))
 (set-state-ok t)
 (local (in-theory (enable* arith-equiv-forwarding)))
 (local (in-theory (disable aig-vars)))
 
-(defthm state-p1-of-random
-  (implies (force (state-p1 state))
-           (state-p1 (mv-nth 1 (random$ limit state))))
-  :hints(("Goal" :in-theory (enable random$ read-acl2-oracle))))
 
-
-
-(defund random-list-aux (n limit acc state)
-  (declare (xargs :guard (and (natp n)
-                              (posp limit))))
-  (if (zp n)
-      (mv acc state)
-    (b* (((mv x1 state) (random$ limit state)))
-      (random-list-aux (- n 1) limit (cons x1 acc) state))))
-
-(defthm state-p1-of-random-list-aux
-  (implies (force (state-p1 state))
-           (state-p1 (mv-nth 1 (random-list-aux n limit acc state))))
-  :hints(("Goal" :in-theory (enable random-list-aux))))
-
-
-
-(defund random-list (n limit state)
-  ;; Generate N random integers in [0, limit)
-  (declare (xargs :guard (and (natp n)
-                              (posp limit))))
-  (random-list-aux n limit nil state))
-
-(defthm state-p1-of-random-list
-  (implies (force (state-p1 state))
-           (state-p1 (mv-nth 1 (random-list n limit state))))
-  :hints(("Goal" :in-theory (enable random-list))))
-
-
-
-(defun n-random-60-bit-nats (n state)
-  ;; Generate N random integers in [0, 2^60)
-  ;; We just leave this enabled.
-  (declare (xargs :guard (natp n)))
+(defxdoc aig-random-sim
+  :parents (aig-other)
+  :short "Functions for randomly vector simulations of Hons @(see aig)s."
+
+  :long "<p>Simulating AIGs on random vectors is useful in algorithms such as
+<a
+href='http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.66.3434'>fraiging</a>,
+to look for nodes that are probably equivalent and might be merged.</p>
+
+<p>Our hons-based @(see aig) representation is not especially efficient or
+well-suited for carrying out random simulations, and nowadays @(see aignet) is
+a much faster alternative.  Nevertheless, we have developed various routines
+for vector-simulations of Hons AIGs.</p>
+
+<p>Note that some of these routines make use of 60-bit natural numbers, which
+are fixnums on 64-bit CCL and SBCL.  They may perform quite badly on other
+Lisps with smaller fixnum ranges.</p>")
+
+
+(define n-random-60-bit-nats ((n natp "How many to generate.") state)
+  :parents (aig-random-sim)
+  :short "Generate a list of 60-bit naturals."
+  :long "<p>We just leave this enabled.</p>"
+  :enabled t
   (random-list n (ash 1 60) state))
 
 
-(defund init-random-state (vars state)
-  ;; Fast alist binding each variable to a random integer in [0, 2^60)
-  (declare (xargs :guard t))
-  (b* (((mv nums state)
-        (n-random-60-bit-nats (len vars) state)))
-    (mv (make-fal (ec-call (pairlis$ vars nums)) nil)
-        state)))
-
-(defthm state-p1-of-init-random-state
-  (implies (force (state-p1 state))
-           (state-p1 (mv-nth 1 (init-random-state vars state))))
-  :hints(("Goal" :in-theory (enable init-random-state))))
-
-
-
-(defconst *60-bit-mask* (1- (ash 1 60)))
-
-(encapsulate
- ()
- (local (include-book "arithmetic/top-with-meta" :dir :system))
- (defthm logbitp-of-60-bit-mask
-   (implies (natp i)
-           (equal (logbitp i *60-bit-mask*)
-                  (< i 60)))
-   :hints (("goal" :in-theory (enable logbitp**)))))
-
-
-(defun 60-bit-fix (x)
-  (declare (xargs :guard t :verify-guards nil))
+(define init-random-state
+  :parents (aig-random-sim)
+  :short "Create a fast alist binding each variable to a random 60-bit natural."
+  (vars state)
+  :returns (mv fal state)
+  (b* ((vars (mbe :logic (list-fix vars)
+                  :exec (if (true-listp vars)
+                            vars
+                          (list-fix vars))))
+       ((mv nums state)
+        (n-random-60-bit-nats (length vars) state)))
+    (mv (make-fast-alist (pairlis$ vars nums))
+        state))
+  ///
+  (defthm state-p1-of-init-random-state
+    (implies (force (state-p1 state))
+             (state-p1 (mv-nth 1 (init-random-state vars state))))))
 
-; Old definition:
-;
-; (the (signed-byte 61)
-;   (if (integerp x)
-;       (logand x (the (signed-byte 61) *60-bit-mask*))
-;     0)))
-;
-; The new definition is slightly faster because we avoid the lookup of the
-; *60-bit-mask*.
-;
-; We could make this almost twice as fast by redefining it under the hood as
-; (if (typep x '(signed-byte 61)) x 0), but I had some trouble getting this to
-; properly inline, and probably it's best to avoid a ttag for such a minor
-; optimization.
 
+(defsection *60-bit-mask*
+  :parents (aig-random-sim)
+  :short "The largest 60-bit natural, all ones."
+  (defconst *60-bit-mask* (1- (ash 1 60)))
+
+  (local (include-book "arithmetic/top-with-meta" :dir :system))
+
+  (defthm logbitp-of-60-bit-mask
+    (implies (natp i)
+             (equal (logbitp i *60-bit-mask*)
+                    (< i 60)))
+    :hints (("goal" :in-theory (enable logbitp**)))))
+
+
+(define 60-bit-fix (x)
+  :parents (aig-random-sim)
+  :short "Coerce an object to a 60-bit natural."
+  :long "<p>A previous definition for this function was:</p>
+
+@({
+    (the (signed-byte 61)
+      (if (integerp x)
+          (logand x (the (signed-byte 61) *60-bit-mask*))
+        0))
+})
+
+<p>But the new definition is slightly faster because we avoid the lookup of the
+@(see *60-bit-mask*).</p>
+
+<p>We could make this almost twice as fast by redefining it under the hood as
+@('(if (typep x '(signed-byte 61)) x 0)'), but I had some trouble getting this
+to properly inline, and probably it's best to avoid a ttag for such a minor
+optimization.</p>"
+
+  :inline t
+  :enabled t
+  :guard-hints(("Goal" :in-theory (disable logand-with-bitmask)))
   (if (integerp x)
       (the (signed-byte 61) (logand x (- (ash 1 60) 1)))
     0))
 
-(verify-guards 60-bit-fix
-  :hints(("Goal" :in-theory (disable logand-with-bitmask))))
-
-
 
-(defun aig-vecsim60 (aig alst)
-  ;; We do a 60-bit wide evaluation of AIG under ALST, which should bind the
-  ;; variables of AIG to 60-bit integers.  (If there are any missing or invalid
-  ;; bindings in ALST, we just 60-bit-fix them.)
-  (declare (xargs :guard t
-                  :verify-guards nil))
+(define aig-vecsim60
+  :parents (aig-random-sim)
+  :short "Do a 60-bit wide evaluation of an AIG."
+  ((aig "The AIG to simulate.")
+   (alst "An alist that should bind the variables of @('aig') to 60-bit
+          naturals.  If there are any missing or invalid bindings, we
+          just @(see 60-bit-fix) them."))
+  :verify-guards nil
   (cond ((atom aig)
          (cond ((eq aig nil)
                 0)
                ((eq aig t)
-                -1)
+                -1)           ;; BOZO shouldn't we return *60-bit-mask*???
                (t
                 (let ((look (hons-get aig alst)))
                   (if look
@@ -148,8 +141,8 @@
                     -1)))))
         ((not (cdr aig))
          (the (signed-byte 61)
-              (lognot (the (signed-byte 61)
-                           (aig-vecsim60 (car aig) alst)))))
+           (lognot (the (signed-byte 61)
+                     (aig-vecsim60 (car aig) alst)))))
         (t
          (let ((a (aig-vecsim60 (car aig) alst)))
            (mbe
@@ -157,63 +150,72 @@
             :exec (if (= (the (signed-byte 61) a) 0)
                       0
                     (the (signed-byte 61)
-                         (logand (the (signed-byte 61) a)
-                                 (the (signed-byte 61)
-                                      (aig-vecsim60 (cdr aig) alst))))))))))
-
-(defthm aig-vecsim60-60-bits
-  (signed-byte-p 61 (aig-vecsim60 aig alst))
-  :hints(("Goal" :in-theory (disable logand-with-bitmask))))
-
-(verify-guards aig-vecsim60)
+                      (logand (the (signed-byte 61) a)
+                              (the (signed-byte 61)
+                                (aig-vecsim60 (cdr aig) alst)))))))))
+  ///
+  (defthm aig-vecsim60-60-bits
+    (signed-byte-p 61 (aig-vecsim60 aig alst))
+    :hints(("Goal" :in-theory (disable logand-with-bitmask))))
+
+  (verify-guards aig-vecsim60)
+
+  (memoize 'aig-vecsim60 :condition '(and (consp aig) (cdr aig))))
 
-(memoize 'aig-vecsim60 :condition '(and (consp aig) (cdr aig)))
 
 
-(defun logbitp-env60 (i alst)
-  ;; Given an ALST binding variables to 60-bit integers as in aig-vecsim60, we
-  ;; extract the ordinary, Boolean-valued alist by using the Ith bit of each
-  ;; variable.
-  (if (atom alst)
-      nil
-    (if (atom (car alst))
-        (logbitp-env60 i (cdr alst))
-      (cons (cons (caar alst)
-                  (if (natp i)
-                      (if (< i 60)
-                          (logbitp i (cdar alst))
-                        nil)
-                    (logbitp 0 (cdar alst))))
-            (logbitp-env60 i (cdr alst))))))
-
-(local
- (progn
-   (local (include-book "arithmetic/top-with-meta" :dir :system))
-
-   (defthm hons-assoc-equal-logbitp-env60
-     (equal (cdr (hons-assoc-equal v (logbitp-env60 i alst)))
-            (if (natp i)
-                (and (< i 60)
-                     (logbitp i (cdr (hons-assoc-equal v alst))))
-              (logbitp 0 (cdr (hons-assoc-equal v alst)))))
-     :hints(("Goal" :in-theory (enable hons-assoc-equal))))
+(define logbitp-env60 (i alst)
+  :parents (aig-random-sim)
+  :short "Given an ALST binding variables to 60-bit integers as in @(see
+aig-vecsim60), we extract an ordinary, Boolean-valued alist by using the Ith
+bit of each variable."
+  :verify-guards nil ;; Not meant to be executed
+  (cond ((atom alst)
+         nil)
+        ((atom (car alst))
+         (logbitp-env60 i (cdr alst)))
+        (t
+         (cons (cons (caar alst)
+                     (if (natp i)
+                         (if (< i 60)
+                             (logbitp i (cdar alst))
+                           nil)
+                       (logbitp 0 (cdar alst))))
+               (logbitp-env60 i (cdr alst))))))
 
-   (defthm hons-assoc-equal-logbitp-env60-iff
-     (iff (hons-assoc-equal v (logbitp-env60 i alst))
-          (hons-assoc-equal v alst)))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
 
-   (defthm logbitp-env60-non-natp
-     (implies (not (natp i))
-              (equal (logbitp-env60 i alst)
-                     (logbitp-env60 0 alst))))))
+(encapsulate
+  ()
+  (local (in-theory (enable logbitp-env60)))
 
-(defthm logbitp-of-aig-vecsim60
-  (equal (aig-eval aig (logbitp-env60 i alst))
-         (logbitp i (aig-vecsim60 aig alst)))
-  :hints (("Goal" :induct (aig-vecsim60 aig alst)
-           :in-theory (enable natp aig-env-lookup))
-          (and stable-under-simplificationp
-               '(:cases ((natp i))))))
+  (local
+   (progn
+     (defthm hons-assoc-equal-logbitp-env60
+       (equal (cdr (hons-assoc-equal v (logbitp-env60 i alst)))
+              (if (natp i)
+                  (and (< i 60)
+                       (logbitp i (cdr (hons-assoc-equal v alst))))
+                (logbitp 0 (cdr (hons-assoc-equal v alst)))))
+       :hints(("Goal" :in-theory (enable hons-assoc-equal))))
+
+     (defthm hons-assoc-equal-logbitp-env60-iff
+       (iff (hons-assoc-equal v (logbitp-env60 i alst))
+            (hons-assoc-equal v alst)))
+
+     (defthm logbitp-env60-non-natp
+       (implies (not (natp i))
+                (equal (logbitp-env60 i alst)
+                       (logbitp-env60 0 alst))))))
+
+  (defthm logbitp-of-aig-vecsim60
+    (equal (aig-eval aig (logbitp-env60 i alst))
+           (logbitp i (aig-vecsim60 aig alst)))
+    :hints (("Goal" :induct (aig-vecsim60 aig alst)
+             :in-theory (enable natp aig-env-lookup
+                                aig-vecsim60))
+            (and stable-under-simplificationp
+                 '(:cases ((natp i)))))))
 
 
 
@@ -248,7 +250,8 @@
           :use ((:instance aig-equiv-necc
                            (env (aig-vecsim60-diff a b vecs))
                            (x a) (y b)))
-          :in-theory (disable aig-equiv-implies-equal-aig-eval-1))))
+          ;:in-theory (disable aig-equiv-implies-equal-aig-eval-1)
+          )))
 
 
 
@@ -909,6 +912,7 @@
                    :do-not '(generalize fertilize)
                    :induct (aig-rsim60 aig renv)
                    :in-theory (enable aig-rsim60 aig-vars aig-eval aig-env-lookup
+                                      aig-vecsim60 
                                       subsetp-equal
                                       logbitp-of-loghead-split)))))
 
@@ -968,7 +972,8 @@
                                                                (aig-vars b))
                                                    renv))
                              (x a) (y b)))
-            :in-theory (disable aig-equiv-implies-equal-aig-eval-1)))))
+            ;:in-theory (disable aig-equiv-implies-equal-aig-eval-1)
+            ))))
 
 
 (defsection aig-rsim60-bind-variable
diff -Nru acl2-6.2/books/centaur/aig/three-four.lisp acl2-6.3/books/centaur/aig/three-four.lisp
--- acl2-6.2/books/centaur/aig/three-four.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/three-four.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -23,375 +23,6 @@
 
 (in-package "ACL2")
 
-(include-book "base")
-(include-book "tools/bstar" :dir :system)
-(include-book "tools/rulesets" :dir :system)
-
-(defconst *4x* (hons t t))
-(defconst *4z* (hons nil nil))
-(defconst *4t* (hons t nil))
-(defconst *4f* (hons nil t))
-
-
-(def-b*-binder faig
-  ":doc-section B*-BINDERS
-Binds two variables to the onset and offset, respectively, of the faig-fix
-of the given expression.~/~/~/"
-  (declare (xargs :guard (and (true-listp args)
-                              (equal (len args) 2)
-                              (true-listp forms)
-                              (equal (len forms) 1))))
-  `(b* (((mv ,(first args) ,(second args))
-         (let ((x (faig-fix ,(car forms))))
-           (mv (car x) (cdr x)))))
-     ,rest-expr))
-
-
-(defxdoc faig-constructors
-  :parents (faig)
-  :short "Low-level functions for constructing FAIGs."
-
-  :long "<p>In many cases, it is possible to more efficiently construct FAIGs
-when it is known that the input FAIGs cannot evaluate to Z.  This is something
-that holds of the outputs of most logic gates, e.g., a NOT gate might produce
-an X, but it will never produce a Z.</p>
-
-<p>Because of this, we have two versions of most of our FAIG constructors.  The
-@('t-aig-*') functions make the assumption that their inputs are non-floating
-and can never evaluate to Z, and are more efficient.  The @('f-aig-*')
-functions do not make this assumption and can operate on any FAIG inputs, but
-are not as efficient and yield larger FAIGs.</p>")
-
-
-
-
-; Macro to prove the FAIG constructors commute over FAIG-EVAL.
-
-(defun pfoc-faig-eval-args (args)
-  (if (atom args)
-      nil
-    (cons (list 'faig-eval (car args) 'env)
-          (pfoc-faig-eval-args (cdr args)))))
-
-(defun pfoc-arg-casesplit-list (args)
-  (if (atom args)
-      nil
-    (list* `(and stable-under-simplificationp
-                 '(:cases ((aig-eval (car ,(car args)) env))))
-           `(and stable-under-simplificationp
-                 '(:cases ((aig-eval (cdr ,(car args)) env))))
-           (pfoc-arg-casesplit-list (cdr args)))))
-
-(defmacro prove-faig-op-commutes (op args)
-  `(defthm ,(intern-in-package-of-symbol
-             (concatenate 'string "FAIG-EVAL-OF-" (symbol-name op))
-             op)
-     (equal (faig-eval (,op . ,args) env)
-            (,op . ,(pfoc-faig-eval-args args)))
-     :hints ,(pfoc-arg-casesplit-list args)))
-
-
-
-
-
-(defsection t-aig-fix
-  ;; BOZO should probably rename this to f-aig-unfloat
-  :parents (faig-constructors)
-  :short "Unfloat operation, converts floating (Z) values to unknown (X)
-values."
-  :long "<p>See also @(see 4v-unfloat); this is the analagous function for
-FAIGs.</p>"
-
-  (defn t-aig-fix (a)
-    (b* (((faig a1 a0) a))
-      (cons (aig-not (aig-and a0 (aig-not a1)))
-            (aig-not (aig-and a1 (aig-not a0))))))
-
-  (prove-faig-op-commutes t-aig-fix (a)))
-
-
-
-(defsection t-aig-not
-  :parents (faig-constructors)
-  :short "@(call t-aig-not) negates the FAIG @('a'), assuming that it cannot
-evaluate to Z."
-
-  (defn t-aig-not (a)
-    (b* (((faig a1 a0) a))
-      (cons a0 a1)))
-
-  (prove-faig-op-commutes t-aig-not (a)))
-
-
-(defsection f-aig-not
-  :parents (faig-constructors)
-  :short "@(call f-aig-not) negates the FAIG @('a')."
-
-  (defn f-aig-not (a)
-    (b* (((faig a1 a0) a))
-      (cons (aig-not (aig-and a1 (aig-not a0)))
-            (aig-not (aig-and a0 (aig-not a1))))))
-
-  (prove-faig-op-commutes f-aig-not (a)))
-
-
-
-(defsection t-aig-and
-  :parents (faig-constructors)
-  :short "@(call t-aig-and) <i>and</i>s together the FAIGs @('a') and @('b'),
-assuming they cannot evaluate to Z."
-
-  (defn t-aig-and (a b)
-    (b* (((faig a1 a0) a)
-         ((faig b1 b0) b))
-      (cons (aig-and a1 b1)
-            (aig-or  a0 b0))))
-
-  (prove-faig-op-commutes t-aig-and (a b)))
-
-(defsection f-aig-and
-  :parents (faig-constructors)
-  :short "@(call f-aig-and) <i>and</i>s together the FAIGs @('a') and @('b')."
-
-  (defn f-aig-and (a b)
-    (let ((a (t-aig-fix a))
-          (b (t-aig-fix b)))
-      (t-aig-and a b)))
-
-  (prove-faig-op-commutes f-aig-and (a b)))
-
-
-
-(defsection t-aig-or
-  :parents (faig-constructors)
-  :short "@(call t-aig-or) <i>or</i>s together the FAIGs @('a') and @('b'),
-assuming they cannot evaluate to Z."
-
-  (defn t-aig-or (a b)
-    (b* (((faig a1 a0) a)
-         ((faig b1 b0) b))
-      (cons (aig-or  a1 b1)
-            (aig-and a0 b0))))
-
-  (prove-faig-op-commutes t-aig-or (a b)))
-
-(defsection f-aig-or
-  :parents (faig-constructors)
-  :short "@(call f-aig-or) <i>or</i>s together the FAIGs @('a') and @('b')."
-
-  (defn f-aig-or (a b)
-    (let ((a (t-aig-fix a))
-          (b (t-aig-fix b)))
-      (t-aig-or a b)))
-
-  (prove-faig-op-commutes f-aig-or (a b)))
-
-
-
-(defsection t-aig-xor
-  :parents (faig-constructors)
-  :short "@(call t-aig-xor) <i>xor</i>s together the FAIGs @('a') and @('b'),
-assuming they cannot evaluate to Z."
-
-  (defn t-aig-xor (a b)
-    (t-aig-or (t-aig-and a (t-aig-not b))
-              (t-aig-and (t-aig-not a) b)))
-
-  (prove-faig-op-commutes t-aig-xor (a b)))
-
-(defsection f-aig-xor
-  :parents (faig-constructors)
-  :short "@(call f-aig-xor) <i>xor</i>s together the FAIGs @('a') and @('b')."
-
-  (defn f-aig-xor (a b)
-    (let ((a (t-aig-fix a))
-          (b (t-aig-fix b)))
-      (t-aig-xor a b)))
-
-  (prove-faig-op-commutes f-aig-xor (a b)))
-
-
-
-(defsection t-aig-iff
-  :parents (faig-constructors)
-  :short "@(call t-aig-iff) <i>iff</i>s together the FAIGs @('a') and @('b'),
-assuming they cannot evaluate to Z."
-
-  (defn t-aig-iff (a b)
-    (t-aig-or (t-aig-and a b)
-              (t-aig-and (t-aig-not a) (t-aig-not b))))
-
-  (prove-faig-op-commutes t-aig-iff (a b)))
-
-
-(defsection f-aig-iff
-  :parents (faig-constructors)
-  :short "@(call f-aig-iff) <i>iff</i>s together the FAIGs @('a') and @('b')."
-
-  (defn f-aig-iff (a b)
-    (let ((a (t-aig-fix a))
-          (b (t-aig-fix b)))
-      (t-aig-iff a b)))
-
-  (prove-faig-op-commutes f-aig-iff (a b)))
-
-
-
-
-(defsection t-aig-ite
-  :parents (faig-constructors)
-  :short "@(call t-aig-ite) constructs a (less conservative) FAIG representing
-@('(if c a b)'), assuming these input FAIGs cannot evaluate to Z."
-
-  :long "<p>This is a less-conservative version of @(see t-aig-ite*) that emits
-@('a') in the case that @('c') is unknown but @('a = b').  See @(see 4v-ite)
-for discussion related to this issue.</p>"
-
-  (defn t-aig-ite (c a b)
-    (b* (((faig a1 a0) a)
-         ((faig b1 b0) b)
-         ((faig c1 c0) c))
-      (cons (aig-or (aig-and c1 a1)
-                    (aig-and c0 b1))
-            (aig-or (aig-and c1 a0)
-                    (aig-and c0 b0)))))
-
-  (prove-faig-op-commutes t-aig-ite (c a b)))
-
-(defsection f-aig-ite
-  :parents (faig-constructors)
-  :short "@(call f-aig-ite) constructs a (less conservative) FAIG representing
-@('(if c a b)')."
-
-  :long "<p>This is a less-conservative version of @(see f-aig-ite*) that emits
-@('a') in the case that @('c') is unknown but @('a = b').  See @(see 4v-ite)
-for discussion related to this issue.</p>"
-
-  (defn f-aig-ite (c a b)
-    (let* ((c (t-aig-fix c))
-           (a (t-aig-fix a))
-           (b (t-aig-fix b)))
-      (t-aig-ite c a b)))
-
-  (prove-faig-op-commutes f-aig-ite (c a b)))
-
-
-
-(defsection t-aig-ite*
-  :parents (faig-constructors)
-  :short "@(call t-aig-ite*) constructs a (more conservative) FAIG representing
-@('(if c a b)'), assuming these input FAIGs cannot evaluate to Z."
-
-  :long "<p>This is a more-conservative version of @(see t-aig-ite) that emits
-@('X') in the case that @('c') is unknown, even when @('a = b').  See @(see
-4v-ite) for discussion related to this issue.</p>"
-
-  (defn t-aig-ite* (c a b)
-    (b* (((faig a1 a0) a)
-         ((faig b1 b0) b)
-         ((faig c1 c0) c)
-         (x (aig-and c1 c0)))
-      (cons (aig-or x (aig-or (aig-and c1 a1)
-                              (aig-and c0 b1)))
-            (aig-or x (aig-or (aig-and c1 a0)
-                              (aig-and c0 b0))))))
-
-  (prove-faig-op-commutes t-aig-ite* (c a b)))
-
-(defsection f-aig-ite*
-  :parents (faig-constructors)
-  :short "@(call f-aig-ite*) constructs a (more conservative) FAIG representing
-@('(if c a b)'), assuming these input FAIGs cannot evaluate to Z."
-
-  :long "<p>This is a more-conservative version of @(see f-aig-ite) that emits
-@('X') in the case that @('c') is unknown, even when @('a = b').  See @(see
-4v-ite) for discussion related to this issue.</p>"
-
-  (defn f-aig-ite* (c a b)
-    (let* ((c (t-aig-fix c))
-           (a (t-aig-fix a))
-           (b (t-aig-fix b)))
-      (t-aig-ite* c a b)))
-
-  (prove-faig-op-commutes f-aig-ite* (c a b)))
-
-
-
-
-(defn f-aig-res (x y)
-  (b* (((faig x1 x0) x)
-       ((faig y1 y0) y))
-    (cons (aig-or x1 y1)
-          (aig-or x0 y0))))
-
-(prove-faig-op-commutes f-aig-res (a b))
-
-(defn f-aig-wire (a b)
-  (f-aig-res a b))
-
-
-
-
-
-;; Theorem: no T-AIG-FIX needed around the answer of f-aig-ite.
-;; (thm
-;;      (and
-;;       (iff (aig-eval (car (t-aig-fix (t-aig-ite (t-aig-fix c)
-;;                                                 (t-aig-fix a)
-;;                                                 (t-aig-fix b))))
-;;                      al)
-;;            (aig-eval (car (t-aig-ite (t-aig-fix c)
-;;                                      (t-aig-fix a)
-;;                                      (t-aig-fix b)))
-;;                      al))
-;;       (iff (aig-eval (cdr (t-aig-fix (t-aig-ite (t-aig-fix c)
-;;                                                 (t-aig-fix a)
-;;                                                 (t-aig-fix b))))
-;;                      al)
-;;            (aig-eval (cdr (t-aig-ite (t-aig-fix c)
-;;                                      (t-aig-fix a)
-;;                                      (t-aig-fix b)))
-;;                      al))))
-     
-
-(defn t-aig-buf (c a)
-  ;; onset  of output is (not (or (and (not con) coff) (and con (not coff) (not aon) aoff)))
-  ;; offset of output is (not (or (and (not con) coff) (and con (not coff) aoff (not aon))))
-  (b* (((faig a1 a0) a)
-       ((faig c1 c0) c)
-       (float (aig-and (aig-not c1) c0))
-       (set   (aig-and c1 (aig-not c0)))
-       (on    (aig-and (aig-not a0) a1))
-       (off   (aig-and (aig-not a1) a0)))
-    (cons (aig-and (aig-not float) (aig-not (aig-and set off)))
-          (aig-and (aig-not float) (aig-not (aig-and set on))))))
-
-(prove-faig-op-commutes t-aig-buf (c a))
-
-
-(defn f-aig-pullup (a)
-  (b* (((faig a1 a0) a)
-       (a-not-aig-floating (aig-or a1 a0))
-       (a-floating (aig-not a-not-aig-floating)))
-    (cons (aig-or a-floating a1) a0)))
-
-(prove-faig-op-commutes f-aig-pullup (a))
-
-
-(defn f-aig-bi-buf (cntl in bus)
-  (f-aig-wire (t-aig-buf cntl in) bus))
-
-(prove-faig-op-commutes f-aig-bi-buf (c a b))
-
-(def-ruleset f-aig-defs
-  '(t-aig-fix f-aig-not f-aig-and f-aig-or f-aig-xor f-aig-iff
-              f-aig-res f-aig-ite f-aig-ite*
-              t-aig-buf f-aig-pullup f-aig-bi-buf))
-
-(def-ruleset t-aig-defs
-  '(t-aig-and t-aig-iff t-aig-ite t-aig-ite* t-aig-not t-aig-or t-aig-xor))
-
-
-
-
+;; cert_param: (reloc_stub)
+(include-book "faig-constructors")
 
diff -Nru acl2-6.2/books/centaur/aig/top.lisp acl2-6.3/books/centaur/aig/top.lisp
--- acl2-6.2/books/centaur/aig/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/aig/top.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,194 @@
+; Centaur AIG Library
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Sol Swords <sswords@centtech.com>
+;                   Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "accumulate-nodes-vars")
+(include-book "aig2c")
+(include-book "aig-base")
+(include-book "aig-equivs")
+(include-book "aiger")
+(include-book "aig-print")
+(include-book "aig-sat")
+; Avoid dependence of this top.lisp book on glucose, so that running the
+; command " make everything USE_QUICKLISP=1" with ACL2(h) will build the
+; manual:
+; (include-book "aig-sat-tests")
+(include-book "aig-vars-ext")
+(include-book "aig-vars-fast")
+(include-book "aig-vars")
+(include-book "bddify-correct")
+(include-book "bddify")
+(include-book "best-aig")
+(include-book "eval-restrict")
+(include-book "faig-base")
+(include-book "faig-constructors")
+(include-book "faig-equivs")
+(include-book "faig-purebool-p")
+(include-book "g-aig-eval")
+(include-book "induction")
+(include-book "misc")
+(include-book "portcullis")
+(include-book "random-sim")
+
+
+(defxdoc aig
+  :parents (boolean-reasoning)
+  :short "A @(see hons)-based <a
+href='http://en.wikipedia.org/wiki/And-inverter_graph'>And-Inverter
+Graph</a> (AIG) library for representing and manipulating Boolean functions."
+
+  :long "<h3>Introduction</h3>
+
+<p>And-Inverter Graphs are a way to represent Boolean functions using only the
+operations <i>and</i> and <i>not</i>.</p>
+
+<p>This AIG library, found in @('centaur/aig'), is sometimes called the
+<b>Hons-AIG library</b> to distinguish it from another AIG library, @(see
+aignet).  Very briefly:</p>
+
+<ul>
+ <li>Hons-AIGs are simpler, easier to work with, and easier to reason about.</li>
+ <li>@(see aignet) is faster.</li>
+</ul>
+
+<p>We won't say anything more about Aignet here.  A much more detailed
+comparison of the libraries is available in: Jared Davis and Sol Swords.  <a
+href='http://dx.doi.org/10.4204/EPTCS.114.8'>Verified AIG Algorithms in
+ACL2.</a> In ACL2 Workshop 2013. May, 2013. EPTCS 114.  Pages 95-110.</p>
+
+
+<h3>Representation of AIGs</h3>
+
+<p>We always construct AIGs with @(see hons) so that existing pieces of AIGs
+will be automatically reused.  We represent AIGs as arbitrary cons trees, which
+we interpret as follows:</p>
+
+<ul>
+
+<li>@('T') represents the constant-true function.</li>
+
+<li>@('NIL') represents the constant-false function.</li>
+
+<li>Any other atom represents a Boolean variable (i.e., an input to the
+function.)</li>
+
+<li>A cons of the form @('(A . NIL)') represents the negation of @('A').</li>
+
+<li>Any other cons, @('(A . B)'), represents the conjunction of @('A') and
+@('B').</li>
+
+</ul>
+
+<p>Note that every ACL2 object is a well-formed AIG under this definition.</p>
+
+<p>This meaning of cons trees is given by the evaluation function @(see
+aig-eval), which returns the (Boolean) value of an AIG under some particular
+assignment to its variables.  This function naturally induces an equivalence
+relation, @(see aig-equiv): two AIGs are semantically equivalent if they have
+the same evaluation under every possible variable assignment.</p>
+
+<p>You might wonder why we would restrict ourselves to using only <i>and</i>
+and <i>not</i>?  On the surface, using a richer language like S-expressions
+might seem more compact.  For instance, with S-expressions we could represent
+@('(or a b)') is much smaller looking than its and/not equivalent:
+@('(not (and (not a) (not b)))').</p>
+
+<p>But another critical part of memory efficiency is structure sharing.  That
+is, suppose that we already need @('(not a)') and @('(not b)') elsewhere in the
+function.  With s-expressions, these terms would have nothing in common with
+@('(or a b)'), but with AIGs we can reuse the existing parts of
+@('(not (and (not a) (not b)))').</p>
+
+
+<h3>Library Functions</h3>
+
+<p>Besides the @(see aig-semantics) functions like @(see aig-eval) and @(see
+aig-equiv), the real core of the library includes:</p>
+
+<ul>
+
+<li>Basic, low-level @(see aig-constructors) for building
+AIGs (<i>and</i>, <i>or</i>, etc.).  We prove these operations correct with
+respect to @(see aig-eval).</li>
+
+<li>Somewhat higher-level @(see aig-substitution) operations, like @(see
+aig-restrict), @(see aig-compose), and @(see aig-partial-eval).</li>
+
+<li>Operations for collecting the variables from an AIG, such as @(see
+aig-vars).</li>
+
+</ul>
+
+<p>We provide some tools to \"solve\" AIGs.  Historically we have heavily used
+the @(see bddify) algorithm, which constructs a BDD from an AIG.  More
+recently, @(see aig-sat) provides a nice alternative using @(see aignet) and
+@(see satlink) to give the problem to a SAT solver.</p>
+
+<p>Beyond this, the rest of the library is a hodgepodge of @(see aig-other)
+algorithms for working with AIGs.</p>
+
+
+<h3>AIGs versus BDDs</h3>
+
+<p>Another option for representing Boolean functions would be to use <see
+topic='@(url ubdds)'>BDDs</see>.  In comparison with BDDs, AIGs are:</p>
+
+<ul>
+
+<li>cheaper to construct, e.g., if we want to <i>or</i> together the functions
+@('f') and @('g'), it only takes a few conses with AIGs, whereas with BDDs we
+need to walk through @('f') and @('g') to construct a new structure (which
+might be quite large); but</li>
+
+<li>more expensive to compare, e.g., with BDDs we can determine if @('f') and
+@('g') are equal via pointer equality, whereas with AIGs this is a
+satisfiability problem.</li>
+
+</ul>
+
+<p>This tradeoff is often worth it.  For instance, it can often be more faster
+to construct an AIG and then @(see bddify) it than to just directly build the
+BDD.  Why?  With the whole AIG visible, the bddify algorithm can often
+\"prune\" branches of the AIG that turn out to be irrelevant, and hence avoid
+constructing large parts of the BDD that aren't really needed.</p>
+
+
+
+
+")
+
+(defxdoc aig-substitution
+  :parents (aig)
+  :short "AIG operations for carrying out substitutions, compositions, and
+  partial evaluations.")
+
+(defxdoc aig-constructors
+  :parents (aig)
+  :short "Low-level functions for constructing AIGs.")
+
+(defxdoc aig-other
+  :parents (aig)
+  :short "Various hard-to-categorize algorithms for working with AIGs.")
+
+(defxdoc aig-semantics
+  :parents (aig)
+  :short "Functions related to the semantic meaning of AIGs, e.g., @(see
+aig-eval) and @(see aig-equiv).")
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/aig/vuaig.lisp acl2-6.3/books/centaur/aig/vuaig.lisp
--- acl2-6.2/books/centaur/aig/vuaig.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/vuaig.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,265 +0,0 @@
-; Centaur AIG Library
-; Copyright (C) 2008-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Sol Swords <sswords@centtech.com>
-
-(in-package "ACL2")
-(include-book "three-four")
-
-; vuaig.lisp -- Jared split this out of three-four.lisp; I don't think we're
-; actually using this stuff...
-
-
-;; VUAIG: Pairs of AIGs of the form <value, undef>, encoding 1/0/X/F as
-;; follows:
-;;  V   U   |  meaning
-;; ---------|----------
-;;  t  nil  |    1
-;; nil nil  |    0
-;;  t   t   |    X
-;; nil  t   |    F
-
-;; fix to three-valued, i.e. coerce F to X
-(defn vuaig-tfix (x)
-  (b* (((faig v u) x))
-    (cons (aig-or v u) u)))
-
-(defn vuaig-not (x)
-  (b* (((faig v u) x))
-    (cons (aig-or (aig-not v) u) u)))
-
-(defn vuaig-and (x y)
-  (b* (((faig vx ux) x)
-       ((faig vy uy) y))
-    (let ((x (aig-or (aig-and ux uy)
-                     (aig-or (aig-and ux vy)
-                             (aig-and uy vx)))))
-      (cons (aig-or (aig-and vx vy) x) x))))
-
-
-(defn vuaig-or (x y)
-  (b* (((faig vx ux) x)
-       ((faig vy uy) y))
-    (let ((x (aig-or (aig-and ux uy)
-                     (aig-or (aig-and ux (aig-not vy))
-                             (aig-and uy (aig-not vx))))))
-      (cons (aig-or (aig-or vx vy) x) x))))
-
-(defn vuaig-xor (x y)
-  (b* (((faig vx ux) x)
-       ((faig vy uy) y))
-    (let ((x (aig-or ux uy)))
-      (cons (aig-or (aig-xor vx vy) x) x))))
-
-(defn vuaig-iff (x y)
-  (b* (((faig vx ux) x)
-       ((faig vy uy) y))
-    (let ((x (aig-or ux uy)))
-      (cons (aig-or (aig-iff vx vy) x) x))))
-
-(defn vuaig-res (x y)
-  (b* (((faig vx ux) x)
-       ((faig vy uy) y))
-    (cons (aig-or vx vy)
-          (aig-or (aig-or (aig-and (aig-not (aig-or ux uy))
-                                   (aig-xor vx vy))
-                          (aig-and ux uy))
-                  (aig-or (aig-and ux vx)
-                          (aig-and uy vy))))))
-
-
-(defn vuaig-ite (c a b)
-  (b* (((faig va ua) a)
-       ((faig vb ub) b)
-       ((faig vc uc) c))
-    (let* ((x (aig-or (aig-or (aig-and uc ua)
-                              (aig-and uc ub))
-                      (aig-or (aig-and uc (aig-xor va vb))
-                              (aig-ite vc ua ub)))))
-      (cons (aig-or (aig-ite vc va vb) x) x))))
-
-
-(defn vuaig-tbuf (c a)
-  (b* (((faig va ua) a)
-       ((faig vc uc) c))
-    (let* ((float (aig-and (aig-not vc) (aig-not uc)))
-           (x     (aig-or uc (aig-and ua (aig-not float)))))
-      (cons (aig-or (aig-and va (aig-not float)) x)
-            (aig-or uc (aig-or (aig-not vc) ua))))))
-
-(defn vuaig-pullup (a)
-  (b* (((faig va ua) a)
-       (floating (aig-and (aig-not va) ua)))
-    (cons (aig-or va floating)
-          (aig-and ua (aig-not floating)))))
-
-
-(defn vuaig-bi-buf (cntl in bus)
-  (vuaig-res (vuaig-tbuf cntl in) bus))
-
-(defun to-vu (code)
-  (case code
-    (1 '(t   . nil))
-    (0 '(nil . nil))
-    (x '(t   . t))
-    (z '(nil . t))))
-
-(defun from-vu (vu)
-  (cond ((equal vu '(t   . nil)) 1)
-        ((equal vu '(nil . nil)) 0)
-        ((equal vu '(t   . t))   'x)
-        ((equal vu '(nil . t))   'z)))
-
-(defun to-fv (code)
-  (case code
-    (1 '(t   . nil))
-    (0 '(nil . t))
-    (x '(t   . t))
-    (z '(nil . nil))))
-
-(defun from-fv (vu)
-  (cond ((equal vu '(t   . nil)) 1)
-        ((equal vu '(nil . nil)) 'z)
-        ((equal vu '(t   . t))   'x)
-        ((equal vu '(nil . t))   0)))
-
-
-
-
-
-
-
-
-(defn vxz (v x z)
-  (cons v (and (or z x) (cons x z))))
-
-(defmacro patbind-vxz (args forms rest-expr)
-  `(b* ((,(car args) (ec-call (car ,(car forms))))
-        (patbind-vxz-xz-do-not-use (ec-call (cdr ,(car forms))))
-        (,(cadr args) (ec-call (car patbind-vxz-xz-do-not-use)))
-        (,(caddr args) (ec-call (cdr patbind-vxz-xz-do-not-use))))
-     (check-vars-not-free
-      (patbind-vxz-xz-do-not-use)
-      ,rest-expr)))
-
-
-(defn vxzaig-tfix (a)
-  (b* (((vxz v x z) a))
-    (vxz v (aig-or z x) nil)))
-
-(defn vxzaig-not (a)
-  (b* (((vxz v x z) a))
-    (vxz (aig-not v) (aig-or z x) nil)))
-
-(defn vxzaig-and (a b)
-  (b* (((vxz va xa za) a)
-       ((vxz vb xb zb) b)
-       (xa (aig-or za xa))
-       (xb (aig-or zb xb))
-       (x (aig-or (aig-and xa xb)
-                  (aig-or (aig-and xa vb)
-                          (aig-and xb va)))))
-    (vxz (aig-and va vb) x nil)))
-
-
-(defn vxzaig-or (a b)
-  (b* (((vxz va xa za) a)
-       ((vxz vb xb zb) b)
-       (xa (aig-or za xa))
-       (xb (aig-or zb xb))
-       (x (aig-or (aig-and xa xb)
-                  (aig-or (aig-and xa (aig-not vb))
-                          (aig-and xb (aig-not va))))))
-    (vxz (aig-or va vb) x nil)))
-
-(defn vxzaig-xor (a b)
-  (b* (((vxz va xa za) a)
-       ((vxz vb xb zb) b)
-       (xa (aig-or za xa))
-       (xb (aig-or zb xb))
-       (x (aig-or xa xb)))
-    (vxz (aig-xor va vb) x nil)))
-
-(defn vxzaig-iff (a b)
-  (b* (((vxz va xa za) a)
-       ((vxz vb xb zb) b)
-       (xa (aig-or za xa))
-       (xb (aig-or zb xb))
-       (x (aig-or xa xb)))
-    (vxz (aig-iff va vb) x nil)))
-
-(defn vxzaig-res (a b)
-  (b* (((vxz va xa za) a)
-       ((vxz vb xb zb) b)
-       (za (aig-and za (aig-not xa)))
-       (zb (aig-and zb (aig-not xb)))
-       (z (aig-and za zb)))
-    (vxz (aig-ite za vb va)
-         (aig-or (aig-or xa xb)
-                   (aig-and (aig-not (aig-or za zb))
-                            (aig-xor va vb))) z)))
-
-(defn vxzaig-ite (c a b)
-  (b* (((vxz vc xc zc) c)
-       ((vxz va xa za) a)
-       ((vxz vb xb zb) b)
-       (- (cw "~x0 ~x1 ~x2 ~x3 ~x4 ~x5 ~x6 ~x7 ~x8~%"
-              vc xc zc va xa za vb xb zb))
-       (xc (aig-or zc xc))
-       (xa (aig-or za xa))
-       (xb (aig-or zb xb)))
-    (vxz (aig-ite vc va vb)
-         (aig-ite xc (aig-or (aig-or xa xb)
-                             (aig-xor va vb))
-                  (aig-ite vc xa xb))
-         nil)))
-
-(defn vxzaig-tbuf (c a)
-  (b* (((vxz vc xc zc) c)
-       ((vxz va xa za) a)
-       (xc (aig-or zc xc))
-       (xa (aig-or za xa)))
-    (vxz va (aig-or xc (aig-and vc xa))
-         (aig-ite xc
-                     (aig-not xa)
-                     (aig-not vc)))))
-
-
-
-(defun from-vxz (a)
-  (b* (((vxz v x z) a))
-    (if x 'x (if z 'z (if v 1 0)))))
-
-
-
-
-
-(defconst *vu1* (hons t nil))   ; *4t*
-(defconst *vu0* (hons nil nil)) ; *4u*
-
-
-(defconst *vuT* *vu1*)
-(defconst *vuF* *vu0*)
-(defconst *vuX* (hons t t))     ; *4x*
-(defconst *vuZ* (hons nil t))   ; *4f*
-(defconst *vuU* (hons nil t))   ; *4f*
-
-
-
-
-
diff -Nru acl2-6.2/books/centaur/aig/witness.acl2 acl2-6.3/books/centaur/aig/witness.acl2
--- acl2-6.2/books/centaur/aig/witness.acl2	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/witness.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,24 +0,0 @@
-; Centaur AIG Library
-; Copyright (C) 2008-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Sol Swords <sswords@centtech.com>
-
-(in-package "ACL2")
-(ld "tools/flag-package.lsp" :dir :system)
-; cert-flags: ? t :ttags :all
-(certify-book "witness" ? t :ttags :all)
diff -Nru acl2-6.2/books/centaur/aig/witness.lisp acl2-6.3/books/centaur/aig/witness.lisp
--- acl2-6.2/books/centaur/aig/witness.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/aig/witness.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,219 +0,0 @@
-; Centaur AIG Library
-; Copyright (C) 2008-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Sol Swords <sswords@centtech.com>
-
-(in-package "ACL2")
-
-(include-book "misc/hons-help2" :dir :system)
-(include-book "base")
-
-(include-book "clause-processors/term-patterns" :dir :system)
-(include-book "clause-processors/join-thms" :dir :system)
-
-
-(defmacro aig-patterns ()
-  '(get-term-patterns aig))
-
-(defmacro set-aig-patterns (val)
-  `(set-term-patterns aig ,val))
-
-(defmacro add-aig-pat (val)
-  `(add-term-pattern aig ,val))
-
-(defmacro add-aig-pats (&rest val)
-  `(add-term-patterns aig . ,val))
-
-(defmacro add-aig-fn-pat (val)
-  `(add-fn-term-pattern aig ,val))
-
-(defmacro add-aig-fn-pats (&rest val)
-  `(add-fn-term-patterns aig . ,val))
-
-(set-aig-patterns nil)
-
-(add-aig-fn-pats
- aig-and aig-not aig-or aig-xor aig-iff aig-ite aig-restrict aig-partial-eval)
-
-(add-aig-pats 't 'nil)
-
-(defun aig-termp (x aig-terms pats)
-  (or (member-equal x aig-terms)
-      (match-term-pattern x pats)))
-
-
-
-(defevaluator aig-cp-ev aig-cp-evl
-  ((aig-eval a b) (equal a b) (not a)
-   (implies a b)
-   (if a b c)))
-
-(def-join-thms aig-cp-ev)
-
-
-
-
-
-(mutual-recursion
- (defun collect-aig-eval-vals (term)
-   (cond ((atom term) nil)
-         ((eq (car term) 'quote) nil)
-         ((member-eq (car term)
-                     '(aig-eval
-                       aig-eval-pat
-                       aig-eval-list
-                       aig-eval-alist
-                       faig-eval-pat
-                       faig-eval-list
-                       faig-eval-alist))
-          (and (eql (len term) 3)
-               (list (nth 2 term))))
-         (t (collect-aig-eval-vals-list (cdr term)))))
- (defun collect-aig-eval-vals-list (clause)
-   (if (atom clause)
-       nil
-     (union-equal (collect-aig-eval-vals (car clause))
-                  (collect-aig-eval-vals-list (cdr clause))))))
- 
-
-(include-book "tools/flag" :dir :system)        
-(flag::make-flag collect-aig-eval-vals-flag collect-aig-eval-vals
-                 :flag-mapping ((collect-aig-eval-vals . term)
-                                (collect-aig-eval-vals-list . list)))
-
-(defthm pseudo-term-listp-union-equal
-  (implies (and (pseudo-term-listp x) (pseudo-term-listp y))
-           (pseudo-term-listp (union-equal x y))))
-
-(defthm-collect-aig-eval-vals-flag pseudo-term-listp-collect-aig-eval-vals
-  (term (implies (pseudo-termp term)
-                 (pseudo-term-listp (collect-aig-eval-vals term))))
-  (list (implies (pseudo-term-listp clause)
-                 (pseudo-term-listp (collect-aig-eval-vals-list clause))))
-  :hints (("goal" :induct (collect-aig-eval-vals-flag flag term clause))
-          ("Subgoal *1/6" :expand (collect-aig-eval-vals-list clause))))
-
-
-(defun aig-eval-vals (clause)
-  (let ((collect (collect-aig-eval-vals-list clause)))
-    (or collect '(arbitrary-vals))))
-
-(defthm aig-eval-vals-pseudo-term-listp
-  (implies (pseudo-term-listp clause)
-           (pseudo-term-listp (aig-eval-vals clause))))
-
-(in-theory (disable aig-eval-vals))
-
-(defun instantiate-aig-evals (a b vals)
-  (if (atom vals)
-      nil
-    (cons `(not (equal (aig-eval ,a ,(car vals))
-                       (aig-eval ,b ,(car vals))))
-          (instantiate-aig-evals a b (cdr vals)))))
-
-(defthm instantiate-aig-evals-correct
-  (implies (and ;;(pseudo-termp x)
-                ;;(pseudo-termp y)
-                ;;(alistp a)
-                (equal (aig-cp-ev x a)
-                       (aig-cp-ev y a)))
-           (not (aig-cp-ev (disjoin (instantiate-aig-evals x y vals)) a)))
-  :hints (("goal" :induct (instantiate-aig-evals a b vals))))
-
-(defthm pseudo-term-listp-instantiate-aig-evals
-  (implies (and (pseudo-term-listp vals)
-                (pseudo-termp a)
-                (pseudo-termp b))
-           (pseudo-term-listp (instantiate-aig-evals a b vals))))
-
-(in-theory (disable instantiate-aig-evals))
-
-(defun instantiate-equals-with-aig-evals (clause vals aig-terms patterns)
-  (if (atom clause)
-      nil
-    (let* ((rst-clause (instantiate-equals-with-aig-evals
-                        (cdr clause) vals aig-terms patterns))
-           (lit (car clause)))
-      (mv-let (a b)
-        (case-match lit
-          (('not ('equal a b))
-           (mv a b))
-          (a (mv a ''nil))
-          (& (mv nil nil)))
-        (if (and (aig-termp a aig-terms patterns)
-                 (aig-termp b aig-terms patterns))
-            (cons (disjoin (instantiate-aig-evals a b vals))
-                  rst-clause)
-          (cons lit rst-clause))))))
-
-(defthm instantiate-equals-with-aig-evals-correct
-  (implies (and ;;(pseudo-term-listp clause)
-                ;;(alistp a)
-                (aig-cp-ev (disjoin (instantiate-equals-with-aig-evals
-                                     clause vals aig-terms patterns))
-                           a))
-           (aig-cp-ev (disjoin clause) a))
-  :hints (("goal" :induct (instantiate-equals-with-aig-evals
-                           clause vals aig-terms patterns))))
-
-
-
-(defthm pseudo-term-listp-instantiate-equals-with-aig-evals
-  (implies (and (pseudo-term-listp clause)
-                (pseudo-term-listp vals))
-           (pseudo-term-listp (instantiate-equals-with-aig-evals
-                               clause vals aig-terms patterns))))
-
-
-(defun aig-eval-cp (clause hints)
-  (let* ((aig-terms (car hints))
-         (patterns (cadr hints))
-         (vals (aig-eval-vals clause))
-         (clause (instantiate-equals-with-aig-evals
-                  clause vals aig-terms patterns)))
-    (list clause)))
-
-(in-theory (disable instantiate-equals-with-aig-evals
-                    collect-aig-eval-vals-list))
-
-(defthm aig-eval-cp-correct
-  (implies (and (pseudo-term-listp clause)
-                (alistp a)
-                (aig-cp-ev (conjoin-clauses
-                            (aig-eval-cp clause hints))
-                           a))
-           (aig-cp-ev (disjoin clause) a))
-  :rule-classes :clause-processor)
-
-(defmacro aig-reasoning (&key or-hint)
-  (declare (ignorable or-hint))
-  `(if stable-under-simplificationp
-       (er-progn 
-        ;; This just lets us collect the clauses on which this hint is used.
-        (assign aig-eval-cp-clauses
-                (cons clause
-                      (and (boundp-global
-                            'aig-eval-cp-clauses state)
-                           (@ aig-eval-cp-clauses))))
-        (let ((cphint `(:clause-processor
-                        (aig-eval-cp clause (list nil ',(get-term-patterns aig))))))
-          (value ,(if or-hint
-                      '`(:or ,cphint (:no-thanks t))
-                    'cphint))))
-     (value nil)))
-    
diff -Nru acl2-6.2/books/centaur/aignet/aig-sat.lisp acl2-6.3/books/centaur/aignet/aig-sat.lisp
--- acl2-6.2/books/centaur/aignet/aig-sat.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/aig-sat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,89 +0,0 @@
-; AIGNET - And-Inverter Graph Networks
-; Copyright (C) 2013 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Sol Swords <sswords@centtech.com>
-
-(in-package "AIGNET")
-
-(include-book "aig-cnf")
-(include-book "centaur/satlink/top" :dir :system)
-
-(local (include-book "centaur/satlink/cnf-basics" :dir :system))
-
-(local (in-theory (disable nth update-nth aig-eval)))
-
-(define aig-sat ((aig "any old aig")
-                 &key
-                 ((config satlink::config-p) 'satlink::*default-config*))
-  :returns (mv (status "one of :sat, :unsat, or :failed")
-               (env    "alist binding aig vars to t/nil, when sat"))
-  :guard-debug t
-  (b* (;; Locally create arrays to work with
-       ((local-stobjs satlink::env$ sat-lits aignet)
-        (mv status env satlink::env$ sat-lits aignet))
-
-       ;; Convert the AIG into a CNF formula, using fancy AIGNET algorithm
-       ((mv cnf ?lit vars sat-lits aignet)
-        (aig->cnf aig sat-lits aignet))
-
-       ((mv result satlink::env$)
-        (satlink::sat cnf satlink::env$ :config config))
-
-       ((unless (eq result :sat))
-        (mv result nil satlink::env$ sat-lits aignet))
-
-       (env (aig-cnf-vals->env satlink::env$ vars sat-lits aignet)))
-
-    (mv :sat env satlink::env$ sat-lits aignet))
-
-  ///
-  (defthm aig-sat-when-sat
-    (implies (eq (mv-nth 0 (aig-sat aig :config config)) :sat)
-             (aig-eval aig (mv-nth 1 (aig-sat aig :config config)))))
-
-  (defthm aig-sat-when-unsat
-    (implies (aig-eval aig env)
-             (not (equal (mv-nth 0 (aig-sat aig :config config)) :unsat)))
-    :hints (("goal" :use ((:instance aig-satisfying-assign-induces-aig->cnf-satisfying-assign
-                                     (sat-lits (create-sat-lits))
-                                     (aignet (acl2::create-aignet))))
-             :in-theory (disable aig-satisfying-assign-induces-aig->cnf-satisfying-assign)))))
-
-
-
-#||
-
-(in-package "ACL2")
-
-(tshell-ensure)
-
-(aignet::aig-sat nil)
-(aignet::aig-sat 'x)
-
-(aignet::aig-sat (aig-and 'x 'y))
-
-(aignet::aig-sat (aig-ite 'x 'y 'z))
-
-(aignet::aig-sat (aig-and
-                   (aig-ite 'x 'y 'z)
-                   (aig-ite 'x (aig-not 'y) (aig-not 'z))))
-
-(aignet::aig-sat '(1 2 3 4 5 2))
-
-
-||#
diff -Nru acl2-6.2/books/centaur/aignet/aignet-absstobj.lisp acl2-6.3/books/centaur/aignet/aignet-absstobj.lisp
--- acl2-6.2/books/centaur/aignet/aignet-absstobj.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/aignet-absstobj.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -703,43 +703,48 @@
 next-state node for a given register ID:</p> @(def lookup-reg->nxst)")
 
 
+; [Jared] changed parents here; previously everything below had
+; aignet-programming as another parent, but this topic was never defined.  it
+; may have been intended to be aignet-impl, but I think it's reasonable to just
+; not include it for now.
+
 (defxdoc num-nodes
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Total number of nodes in an aignet"
   :long "
 <p>Logically, @('(+ 1 (node-count aignet))'), (where @('node-count') is the
 same as @('len')), since the empty aignet implicitly has a constant node.</p>")
 
 (defxdoc num-ins
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Number of primary input nodes in an aignet"
   :long "
 <p>
 Logically, @('(stype-count :pi aignet)')</p> ")
 
 (defxdoc num-regs
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Number of register nodes in an aignet"
   :long "
 <p>
 Logically, @('(stype-count :reg aignet)')</p> ")
 
 (defxdoc num-outs
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Number of primary output nodes in an aignet"
   :long "
 <p>
 Logically, @('(stype-count :po aignet)')</p> ")
 
 (defxdoc num-nxsts
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Number of next-state nodes in an aignet"
   :long "
 <p>
 Logically, @('(stype-count :nxst aignet)')</p> ")
 
 (defxdoc num-gates
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Number of AND gate nodes in an aignet"
   :long "
 <p>
@@ -748,43 +753,43 @@
   :long "")
 
 (defxdoc fanin-litp
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Checks whether a literal is appropriate as a fanin to another node"
   :long "<p>AKA aignet-litp (but fanin-litp is the executable version).  True iff
 the literal's ID is in bounds and belongs to a non-output, non-next-state node.</p>")
 
 (defxdoc id-existsp
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Checks whether an ID is in bounds for an aignet"
   :long "<p>AKA aignet-idp.  True iff the ID is less than @('(num-nodes aignet)').</p>")
 
 (defxdoc innum->id
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the ID of the node with the given PI number"
   :long "<p>Logically, @('(node-count (lookup-stype n :pi aignet))')</p>")
 
 (defxdoc outnum->id
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the ID of the node with the given PO number"
   :long "<p>Logically, @('(node-count (lookup-stype n :po aignet))')</p>")
 
 (defxdoc regnum->id
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the ID of the node with the given register number"
   :long "<p>Logically, @('(node-count (lookup-stype n :reg aignet))')</p>")
 
 (defxdoc id->type
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the type code of the node with the given ID"
   :long "<p>Logically, @('(typecode (ctype (stype (car (lookup-id id aignet)))))').</p>")
 
 (defxdoc io-id->regp
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the register bit of the node with the given ID"
   :long "<p>Logically, @('(regp (stype (car (lookup-id id aignet))))')</p>")
 
 (defxdoc io-id->ionum
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the IO number of the node with the given ID"
   :long "<p>Logically,
 @({
@@ -796,7 +801,7 @@
 </p>")
 
 (defxdoc co-id->fanin
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the fanin of a next-state or primary output node"
   :long "<p>Logically,
  @({
@@ -808,7 +813,7 @@
  itself.</p>")
 
 (defxdoc gate-id->fanin0
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the 0th fanin of an AND gate node"
   :long "<p>Logically,
  @({
@@ -820,7 +825,7 @@
 output node.</p>")
 
 (defxdoc gate-id->fanin1
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the 1st fanin of an AND gate node"
   :long "<p>Logically,
  @({
@@ -832,12 +837,12 @@
 output node.</p>")
 
 (defxdoc reg-id->nxst
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Finds the next-state node associated with a register ID, if it exists"
   :long "<p>Logically, @('(node-count (lookup-reg->nxst id aignet))')</p>")
 
 (defxdoc nxst-id->reg
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Gets the register ID associated with a next-state node"
   :long "<p>Logically,
 @({
@@ -851,22 +856,22 @@
 reg-id->nxst)) rather than the other way around.</p>")
 
 (defxdoc id->phase
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Finds the value of the node under the all-0 simulation"
   :long "<p></p>")
 
 (defxdoc aignet-add-in
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Adds a primary input node to the aignet"
   :long "<p>Logically, @('(cons (pi-node) aignet)').</p>")
 
 (defxdoc aignet-add-reg
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Adds a register node to the aignet"
   :long "<p>Logically, @('(cons (reg-node) aignet)').</p>")
 
 (defxdoc aignet-add-gate
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Adds an AND gate node to the aignet"
   :long "<p>Logically,
  @({
@@ -877,7 +882,7 @@
 unconditionally.</p>")
 
 (defxdoc aignet-add-out
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Adds a primary output node to the aignet"
   :long "<p>Logically,
  @({
@@ -887,7 +892,7 @@
 unconditionally.</p>")
 
 (defxdoc aignet-set-nxst
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Adds a next-state node to the aignet"
   :long "<p>Logically,
 @({
@@ -898,14 +903,14 @@
 network is preserved unconditionally.</p>")
 
 (defxdoc aignet-init
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Clears the aignet, ensuring minimum sizes for arrays"
   :long "<p>Logically, just returns NIL.  The resulting aignet contains only
 the implicit constant-0 node.  The sizes given are used to adjust arrays in the
 implementation.</p>")
 
 (defxdoc aignet-clear
-  :parents (aignet-logic aignet-programming)
+  :parents (aignet-logic)
   :short "Clears the aignet"
   :long "<p>Logically, just returns NIL.  The resulting aignet contains only the
 implicit constant-0 node.</p>")
diff -Nru acl2-6.2/books/centaur/aignet/cnf.lisp acl2-6.3/books/centaur/aignet/cnf.lisp
--- acl2-6.2/books/centaur/aignet/cnf.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/cnf.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -53,14 +53,14 @@
 
 It's when we add additional constraints to the CNF that it may become
 unsatisfiable.  So suppose we want to show that some cube among the nodes of
-the circuit is unsat -- say, A & B & ~C.  We first convert their subcircuits to
-CNF and then add the three singleton clauses.  Now, suppose that we have some
-assignment to the CIs that satisfies A & B & ~C.  That induces a satisfying
-assignment for the generated part of the CNF where (in particular) the literals
-corresponding to A, B, and ~C are assigned true.  That makes the three
-singleton clauses also true, so the whole CNF is satisfied.  Therefore, if we
-prove the CNF unsatisfiable, then we've proven that no assignment to the CIs
-can simultaneously satisfy A & B & ~C.</p>
+the circuit is unsat -- say, @('A & B & ~C').  We first convert their
+subcircuits to CNF and then add the three singleton clauses.  Now, suppose that
+we have some assignment to the CIs that satisfies @('A & B & ~C').  That
+induces a satisfying assignment for the generated part of the CNF where (in
+particular) the literals corresponding to A, B, and ~C are assigned true.  That
+makes the three singleton clauses also true, so the whole CNF is satisfied.
+Therefore, if we prove the CNF unsatisfiable, then we've proven that no
+assignment to the CIs can simultaneously satisfy @('A & B & ~C').</p>
 
 <p>Now the counterexample case.  We want to show that any satisfying assignment
 of the CNF is a satisfying assignment for whatever circuit constraints we've
@@ -94,7 +94,7 @@
 vals object.  We'll show that this satisfies
 <tt>cnf/aignet-evals-agree</tt> and that the CNF assignment
 satisfies the generated CNF.</li>
-</ul>
+</ul></p>
 
 <p>When actually converting an aignet to CNF, we of course process the AIG
 recursively.  We do this in chunks, where each chunk is either:
@@ -103,8 +103,8 @@
 <li>a mux.</li>
 </ul>
 For both of these cases, we prove that the chunk we've just added preserves the
-correctness criterion we've described.
-</p>
+correctness criterion we've described.</p>
+
 ")
 
 ;; (local (defun trivial-worse-than-or-equal (term1 term2)
diff -Nru acl2-6.2/books/centaur/aignet/copying.lisp acl2-6.3/books/centaur/aignet/copying.lisp
--- acl2-6.2/books/centaur/aignet/copying.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/copying.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -17,8 +17,7 @@
                            sets::double-containment
                            sets::sets-are-true-lists
                            make-list-ac)))
-
-(local (include-book "centaur/misc/equal-by-nths" :dir :system))
+(local (include-book "std/lists/nth" :dir :system))
 
 (local (acl2::use-trivial-ancestors-check))
 
diff -Nru acl2-6.2/books/centaur/aignet/from-hons-aig.lisp acl2-6.3/books/centaur/aignet/from-hons-aig.lisp
--- acl2-6.2/books/centaur/aignet/from-hons-aig.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/from-hons-aig.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -22,9 +22,9 @@
 (include-book "construction")
 (include-book "misc/hons-help" :dir :system)
 (include-book "centaur/aig/aig-vars-fast" :dir :system)
-(include-book "centaur/aig/base" :dir :system)
+(include-book "centaur/aig/aig-base" :dir :system)
 (local (include-book "arithmetic/top-with-meta" :dir :system))
-
+(local (include-book "std/lists/nthcdr" :dir :system))
 ;; Translating from Hons AIGs to aignets.
 
 ;; We need a memoization table so that we don't revisit AIG nodes we've already
diff -Nru acl2-6.2/books/centaur/aignet/prune.lisp acl2-6.3/books/centaur/aignet/prune.lisp
--- acl2-6.2/books/centaur/aignet/prune.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/prune.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -15,7 +15,7 @@
                            sets::double-containment
                            sets::sets-are-true-lists
                            make-list-ac)))
-(local (include-book "centaur/misc/equal-by-nths" :dir :system))
+(local (include-book "std/lists/nth" :dir :system))
 
 
 (local (acl2::use-trivial-ancestors-check))
diff -Nru acl2-6.2/books/centaur/aignet/semantics.lisp acl2-6.3/books/centaur/aignet/semantics.lisp
--- acl2-6.2/books/centaur/aignet/semantics.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/semantics.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -42,12 +42,13 @@
                            sets::sets-are-true-lists
                            make-list-ac)))
 
-(local (include-book "centaur/misc/equal-by-nths" :dir :system))
+(local (include-book "std/lists/nth" :dir :system))
 
 (set-waterfall-parallelism nil) ; currently unknown why we need to disable
                                 ; waterfall-parallelism; something to examine
 
 (local (in-theory (disable true-listp-update-nth
+                           acl2::nth-when-zp
                            acl2::nth-with-large-index)))
 
 (local (defthmd equal-1-to-bitp
@@ -78,8 +79,9 @@
 (defmacro out-type () 3)
 
 (defxdoc aignet
-  :short "AIGNET is an and-inverter graph implementation: a representation for
-both Boolean functions and finite-state machines."
+  :parents (acl2::boolean-reasoning)
+  :short "An efficient, @(see acl2::stobj)-based And-Inverter Graph (AIG)
+representation for Boolean functions and finite-state machines."
   :long
   "<p>An and-inverter graph (AIG) at its most basic is a DAG whose nodes are either
 AND gates, outputs, or inputs.  Outputs have 1 descendant, ANDs have 2, and
@@ -1069,6 +1071,7 @@
   (local (in-theory (disable acl2::bfix-when-not-1
                              acl2::nfix-when-not-natp)))
   (local (in-theory (enable acl2::make-list-ac-redef)))
+  (local (in-theory (disable acl2::make-list-ac-removal)))
 
   (acl2::def2darr frames
                   :prefix frames
@@ -1126,32 +1129,32 @@
            ;; out-of-bounds IDs are false
            0)
           (type (id->type id aignet)))
-       (aignet-case
-        type
-        :gate (b* ((f0 (gate-id->fanin0 id aignet))
-                   (f1 (gate-id->fanin1 id aignet)))
-                (mbe :logic (eval-and-of-lits-seq
-                             k f0 f1 frames initsts aignet)
-                     :exec (b-and (b-xor (id-eval-seq k (lit-id f0)
-                                                      frames
-                                                      initsts aignet)
-                                         (lit-neg f0))
-                                  (b-xor (id-eval-seq k (lit-id f1)
-                                                      frames
-                                                      initsts aignet)
-                                         (lit-neg f1)))))
-        :in    (let ((ionum (io-id->ionum id aignet)))
-                 (if (int= (io-id->regp id aignet) 1)
-                     (if (zp k)
-                         (get-bit ionum initsts)
-                       (id-eval-seq (1- k)
-                                    (reg-id->nxst id aignet)
-                                    frames initsts aignet))
-                   (frames-get2 k ionum frames)))
-        :out (b* ((f (co-id->fanin id aignet)))
-               (lit-eval-seq
-                k f frames initsts aignet))
-        :const 0))))
+         (aignet-case
+          type
+          :gate (b* ((f0 (gate-id->fanin0 id aignet))
+                     (f1 (gate-id->fanin1 id aignet)))
+                    (mbe :logic (eval-and-of-lits-seq
+                                 k f0 f1 frames initsts aignet)
+                         :exec (b-and (b-xor (id-eval-seq k (lit-id f0)
+                                                          frames
+                                                          initsts aignet)
+                                             (lit-neg f0))
+                                      (b-xor (id-eval-seq k (lit-id f1)
+                                                          frames
+                                                          initsts aignet)
+                                             (lit-neg f1)))))
+          :in    (let ((ionum (io-id->ionum id aignet)))
+                   (if (int= (io-id->regp id aignet) 1)
+                       (if (zp k)
+                           (get-bit ionum initsts)
+                         (id-eval-seq (1- k)
+                                      (reg-id->nxst id aignet)
+                                      frames initsts aignet))
+                     (frames-get2 k ionum frames)))
+          :out (b* ((f (co-id->fanin id aignet)))
+                   (lit-eval-seq
+                    k f frames initsts aignet))
+          :const 0))))
 
   (in-theory (disable id-eval-seq lit-eval-seq eval-and-of-lits-seq))
   (local (in-theory (enable id-eval-seq lit-eval-seq eval-and-of-lits-seq)))
@@ -1163,25 +1166,25 @@
           ;; out-of-bounds IDs are false
           0)
          (type (id->type id aignet)))
-      (aignet-case
-       type
-       :gate (b* ((f0 (gate-id->fanin0 id aignet))
-                  (f1 (gate-id->fanin1 id aignet)))
-               (list
-                (id-eval-seq-ind
-                 k (lit-id f0) aignet)
-                (id-eval-seq-ind
-                 k (lit-id f1) aignet)))
-       :in     (if (int= (io-id->regp id aignet) 1)
-                   (if (zp k)
-                       0
-                     (id-eval-seq-ind
-                      (1- k) (reg-id->nxst id aignet) aignet))
-                 0)
-       :out  (b* ((f (co-id->fanin id aignet)))
-               (id-eval-seq-ind
-                k (lit-id f) aignet))
-       :const 0)))
+        (aignet-case
+         type
+         :gate (b* ((f0 (gate-id->fanin0 id aignet))
+                    (f1 (gate-id->fanin1 id aignet)))
+                   (list
+                    (id-eval-seq-ind
+                     k (lit-id f0) aignet)
+                    (id-eval-seq-ind
+                     k (lit-id f1) aignet)))
+         :in     (if (int= (io-id->regp id aignet) 1)
+                     (if (zp k)
+                         0
+                       (id-eval-seq-ind
+                        (1- k) (reg-id->nxst id aignet) aignet))
+                   0)
+         :out  (b* ((f (co-id->fanin id aignet)))
+                   (id-eval-seq-ind
+                    k (lit-id f) aignet))
+         :const 0)))
 
   (defcong nat-equiv equal (id-eval-seq k id frames initvals aignet) 1
     :hints (("goal" :induct (id-eval-seq-ind k id aignet))))
@@ -1199,9 +1202,9 @@
              :in-theory (disable id-eval-seq lit-eval-seq))
             (and stable-under-simplificationp
                  '(:expand ((:free (k aignet)
-                             (id-eval-seq k id frames initvals aignet))
+                                   (id-eval-seq k id frames initvals aignet))
                             (:free (lit aignet)
-                             (lit-eval-seq k lit frames initvals aignet)))))))
+                                   (lit-eval-seq k lit frames initvals aignet)))))))
 
   (defcong nat-equiv equal (lit-eval-seq k lit frames initvals aignet) 1
     :hints (("goal" :expand ((lit-eval-seq k lit frames initvals aignet)))))
@@ -1211,7 +1214,7 @@
     :hints (("goal" :expand ((lit-eval-seq k lit frames initvals aignet)))))
   (defcong list-equiv equal (lit-eval-seq k lit frames initvals aignet) 5
     :hints (("goal" :expand ((:free (aignet)
-                              (lit-eval-seq k lit frames initvals aignet))))))
+                                    (lit-eval-seq k lit frames initvals aignet))))))
 
   (defcong nat-equiv equal (eval-and-of-lits-seq k lit1 lit2 frames initvals aignet) 1
     :hints (("goal" :expand ((eval-and-of-lits-seq k lit1 lit2 frames initvals aignet)))))
@@ -1223,7 +1226,7 @@
     :hints (("goal" :expand ((eval-and-of-lits-seq k lit1 lit2 frames initvals aignet)))))
   (defcong list-equiv equal (eval-and-of-lits-seq k lit1 lit2 frames initvals aignet) 6
     :hints (("goal" :expand ((:free (aignet)
-                              (eval-and-of-lits-seq k lit1 lit2 frames initvals aignet))))))
+                                    (eval-and-of-lits-seq k lit1 lit2 frames initvals aignet))))))
 
 
   (defthm bitp-of-lit-eval-seq
@@ -1238,7 +1241,7 @@
     (bitp (id-eval-seq k id frames initsts aignet))
     :hints (("goal" :expand ((id-eval-seq k id frames initsts aignet)
                              (:free (id)
-                              (id-eval-seq (+ -1 k) id frames initsts aignet))))))
+                                    (id-eval-seq (+ -1 k) id frames initsts aignet))))))
 
   (verify-guards id-eval-seq)
 
@@ -1266,9 +1269,9 @@
     :hints (("goal" :induct (id-eval-ind id aignet)
              :expand ((:free (k) (id-eval-seq k id frames initsts aignet))
                       (:free (invals regvals)
-                       (id-eval id invals regvals aignet))
+                             (id-eval id invals regvals aignet))
                       (:free (k lit)
-                       (lit-eval-seq k lit invals regvals aignet)))
+                             (lit-eval-seq k lit invals regvals aignet)))
              :in-theory (e/d (lit-eval
                               eval-and-of-lits)
                              (id-eval-seq
@@ -1320,7 +1323,7 @@
              (equal (lit-eval-seq k lit frames initvals new)
                     (lit-eval-seq k lit frames initvals orig)))
     :hints (("goal" :expand ((:free (aignet)
-                              (lit-eval-seq k lit frames initvals aignet))))))
+                                    (lit-eval-seq k lit frames initvals aignet))))))
 
   (defthm frame-regvals-of-non-reg/nxst-extension
     (implies (and (aignet-extension-binding)
@@ -1335,11 +1338,11 @@
                  (acl2::equal-by-nths-hint))))
 
   (defthm frame-regvals-when-zp
-  (implies (zp k)
-           (bits-equiv (frame-regvals k frames initvals aignet)
-                       (take (num-regs aignet) initvals)))
-  :hints(("Goal" :in-theory (enable bits-equiv
-                                    nth-of-frame-regvals-split)))))
+    (implies (zp k)
+             (bits-equiv (frame-regvals k frames initvals aignet)
+                         (take (num-regs aignet) initvals)))
+    :hints(("Goal" :in-theory (enable bits-equiv
+                                      nth-of-frame-regvals-split)))))
 
 
 
diff -Nru acl2-6.2/books/centaur/aignet/to-hons-aig.lisp acl2-6.3/books/centaur/aignet/to-hons-aig.lisp
--- acl2-6.2/books/centaur/aignet/to-hons-aig.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/to-hons-aig.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -20,7 +20,7 @@
 
 (in-package "AIGNET")
 (include-book "semantics")
-(include-book "centaur/aig/base" :dir :system)
+(include-book "centaur/aig/aig-base" :dir :system)
 (include-book "centaur/vl/util/cwtime" :dir :system)
 (local (include-book "arithmetic/top-with-meta" :dir :system))
 (local (in-theory (disable nth update-nth
@@ -45,7 +45,7 @@
                   :slotname aig
                   :default-val nil)
 
-  
+
 
 (define id-trans-logic ((id :type (integer 0 *))
                         aigtrans aignet)
@@ -165,7 +165,7 @@
     (equal (id-trans-logic id (aignet-translate-iter n aigtrans aignet)
                            aignet)
            (id-trans-logic id aigtrans aignet))
-    :hints((acl2::just-induct-and-expand 
+    :hints((acl2::just-induct-and-expand
             (aignet-translate-iter n aigtrans aignet))))
 
   (defthm aignet-translate-iter-preserves-input-entries
@@ -178,7 +178,7 @@
   (defthm aignet-trans-invariant-of-aignet-translate-iter
     (aignet-trans-invariant
      n (aignet-translate-iter n aigtrans aignet) aignet)
-    :hints((acl2::just-induct-and-expand 
+    :hints((acl2::just-induct-and-expand
             (aignet-translate-iter n aigtrans aignet))
            (and stable-under-simplificationp
                 '(:expand ((:free (aigtrans)
@@ -191,7 +191,7 @@
   (defthm aignet-aigs-size-of-aignet-translate-iter
     (<= (len aigtrans)
         (len (aignet-translate-iter n aigtrans aignet)))
-    :hints((acl2::just-induct-and-expand 
+    :hints((acl2::just-induct-and-expand
             (aignet-translate-iter n aigtrans aignet)))
     :rule-classes :linear)
 
@@ -303,6 +303,3 @@
        (outlist (aignet-trans-get-outs 0 aigtrans aignet))
        (reglist (aignet-trans-get-nxsts 0 aigtrans aignet)))
     (mv outlist (pairlis$ regnames reglist) aigtrans)))
-
-
-
diff -Nru acl2-6.2/books/centaur/aignet/vecsim.lisp acl2-6.3/books/centaur/aignet/vecsim.lisp
--- acl2-6.2/books/centaur/aignet/vecsim.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/aignet/vecsim.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -25,6 +25,8 @@
 (local (in-theory (disable nth update-nth sets::double-containment)))
 (local (in-theory (enable* acl2::arith-equiv-forwarding)))
 
+(local (in-theory (disable acl2::make-list-ac-removal)))
+
 (acl2::def2darr s61v
                 :elt-type (signed-byte 61)
                 :elt-typep (lambda (x) (signed-byte-p 61 x))
diff -Nru acl2-6.2/books/centaur/bitops/bits-between.lisp acl2-6.3/books/centaur/bitops/bits-between.lisp
--- acl2-6.2/books/centaur/bitops/bits-between.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/bits-between.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -21,7 +21,7 @@
 (in-package "ACL2")
 (include-book "xdoc/top" :dir :system)
 (include-book "tools/bstar" :dir :system)
-(include-book "finite-set-theory/osets/sets" :dir :system)
+(include-book "std/osets/top" :dir :system)
 (local (include-book "ihs-extensions"))
 (local (include-book "std/lists/rev" :dir :system))
 (local (include-book "std/lists/append" :dir :system))
diff -Nru acl2-6.2/books/centaur/bitops/bitsets.lisp acl2-6.3/books/centaur/bitops/bitsets.lisp
--- acl2-6.2/books/centaur/bitops/bitsets.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/bitsets.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -36,9 +36,9 @@
   :long "<h3>Introduction</h3>
 
 <p>In this library, sets of natural numbers are represented as natural numbers
-by saying @('a') is a member of the set @('X') when @('(@(see logbitp) a X)').
-For instance, the set {1, 2, 4} would be represented as the number 22.  In
-binary, this number is 10110, and you can see that bits 1, 2, and 4 are each
+by saying @('a') is a member of the set @('X') when @('(logbitp a X)').  For
+instance, the set {1, 2, 4} would be represented as the number 22.  In binary,
+this number is 10110, and you can see that bits 1, 2, and 4 are each
 \"true\".</p>
 
 <p>This representation enjoys certain efficiencies.  In particular, operations
@@ -82,13 +82,13 @@
 <p>The basic bitsets library can be loaded with:</p>
 
 @({
- (include-book \"bitops/bitsets\" :dir :cbooks)
+ (include-book \"centaur/bitops/bitsets\" :dir :system)
 })
 
 <p>An optimized version (that requires additional ttags) can be loaded with:</p>
 
 @({
- (include-book \"bitops/bitsets-opt\" :dir :cbooks)
+ (include-book \"centaur/bitops/bitsets-opt\" :dir :system)
 })
 
 
@@ -110,34 +110,34 @@
 
 <h5>Bitset Constructors</h5>
 
-<dl> <dt>@('(@(see bitset-singleton) a)')</dt> <dd>Constructs the set @('{ a
+<dl> <dt>@('(bitset-singleton a)')</dt> <dd>Constructs the set @('{ a
 }')</dd> <dd>Execution: @('(ash 1 a)')</dd>
 
-<dt>@('(@(see bitset-insert) a X)')</dt>
+<dt>@('(bitset-insert a X)')</dt>
 <dd>Constructs the set @('X U {a}')</dd>
 <dd>Execution: @('(logior (ash 1 a) x)')</dd>
 
-<dt>@('(@(see bitset-list) a b ...)')</dt>
+<dt>@('(bitset-list a b ...)')</dt>
 <dd>Constructs the set @('{a, b, ...}')</dd>
 <dd>Execution: repeated @('bitset-insert')s</dd>
 
-<dt>@('(@(see bitset-list*) a b ... X)')</dt>
+<dt>@('(bitset-list* a b ... X)')</dt>
 <dd>Constructs the set @('X U {a, b, ...}')</dd>
 <dd>Execution: repeated @('bitset-insert')s</dd>
 
-<dt>@('(@(see bitset-delete) a X)')</dt>
+<dt>@('(bitset-delete a X)')</dt>
 <dd>Constructs the set @('X - {a}')</dd>
 <dd>Execution: @('(logandc1 (ash 1 a) x)')</dd>
 
-<dt>@('(@(see bitset-union) X Y)')</dt>
+<dt>@('(bitset-union X Y)')</dt>
 <dd>Constructs the set @('X U Y')</dd>
 <dd>Execution: @('(logior x y)')</dd>
 
-<dt>@('(@(see bitset-intersect) X Y)')</dt>
+<dt>@('(bitset-intersect X Y)')</dt>
 <dd>Constructs the set @('X \\intersect Y')</dd>
 <dd>Execution: @('(logand x y)')</dd>
 
-<dt>@('(@(see bitset-difference) X Y)')</dt>
+<dt>@('(bitset-difference X Y)')</dt>
 <dd>Constructs the set @('X - Y')</dd>
 <dd>Execution: @('(logandc1 y x)')</dd>
 </dl>
@@ -145,19 +145,19 @@
 <h5>Inspecting Bitsets</h5>
 
 <dl>
-<dt>@('(@(see bitset-memberp) a X)')</dt>
+<dt>@('(bitset-memberp a X)')</dt>
 <dd>Determine whether @('a') is a member of the set @('X')</dd>
 <dd>Execution: @('(logbitp a x)')</dd>
 
-<dt>@('(@(see bitset-intersectp) X Y)')</dt>
+<dt>@('(bitset-intersectp X Y)')</dt>
 <dd>Determines whether @('X') and @('Y') have any common members</dd>
 <dd>Execution: @('(logtest x y)')</dd>
 
-<dt>@('(@(see bitset-subsetp) X Y)')</dt>
+<dt>@('(bitset-subsetp X Y)')</dt>
 <dd>Determines whether @('X') is a subset of @('Y')</dd>
 <dd>Execution: @('(= 0 (logandc2 y x))')</dd>
 
-<dt>@('(@(see bitset-cardinality) X)')</dt>
+<dt>@('(bitset-cardinality X)')</dt>
 <dd>Determines the cardinality of @('X')</dd>
 <dd>Execution: @('(logcount x)')</dd>
 
@@ -166,7 +166,7 @@
 <h5>Enumerating Bitset Members</h5>
 
 <dl>
-<dt>@('(@(see bitset-members) X)')</dt>
+<dt>@('(bitset-members X)')</dt>
 <dd>Constructs an ordinary ordered set with the elements of X.</dd>
 <dd>Expensive: must cons together all of the set elements.</dd>
 </dl>
@@ -249,7 +249,7 @@
 
 <p>It is simple enough to convert a bitset into an ordered set: since the @(see
 integer-length) of @('x') gives us an upper bound on its elements, we just need
-to walk up to this bound and collect all @('i') such that @('(@(see logbitp) i
+to walk up to this bound and collect all @('i') such that @('(logbitp i
 x)').</p>
 
 <p>The definition below uses @(see bits-between) to do just this.  However,
@@ -584,7 +584,7 @@
   :short "@(call bitset-singleton) constructs the singleton set @('{a}')."
 
   :long "<p>This is perhaps slightly more efficient than the equivalent,
- @('(@(see bitset-insert) A 0)').</p>"
+ @('(bitset-insert A 0)').</p>"
 
   (definlined bitset-singleton (a)
     (declare (xargs :guard (natp a)))
diff -Nru acl2-6.2/books/centaur/bitops/cert.acl2 acl2-6.3/books/centaur/bitops/cert.acl2
--- acl2-6.2/books/centaur/bitops/cert.acl2	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/cert.acl2	2013-09-30 17:53:11.000000000 +0000
@@ -19,6 +19,6 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "ACL2")
-(ld "finite-set-theory/osets/sets.defpkg" :dir :system)
-(ld "cutil/package.lsp" :dir :system)
+(include-book "std/osets/portcullis" :dir :system)
+(include-book "cutil/portcullis" :dir :system)
 ; cert-flags: ? t :ttags :all
diff -Nru acl2-6.2/books/centaur/bitops/congruences.lisp acl2-6.3/books/centaur/bitops/congruences.lisp
--- acl2-6.2/books/centaur/bitops/congruences.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/congruences.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -69,10 +69,14 @@
 
 ;; Since we're normalizing to logsquash of loghead, propagate a logsquash
 ;; context inside loghead:
+;; This is its own removal rule.
 (def-context-rule logsquash-of-loghead-context
   (equal (logsquash n (loghead m (logsquash n x)))
          (logsquash n (loghead m x)))
   :fnname logsquash$inline)
+(in-theory (disable apply-context-for-logsquash$inline))
+
+(in-theory (enable logsquash-of-loghead-context))
 
 ;; ;; Logbitp induces both a logsquash and loghead context.
 ;; (defthm logbitp-remove-logsquash
@@ -85,6 +89,7 @@
 ;;            (equal (logbitp n (loghead m i))
 ;;                   (logbitp n i))))
 
+;; Removal rule: logbitp-of-logsquash-in-bounds
 (def-context-rule logbitp-induces-logsquash/loghead-context
   (implies (syntaxp (not (quotep n)))
            ;; if n is quotep we'll prefer a logand context instead
@@ -92,25 +97,28 @@
                   (logbitp n i)))
   :fnname logbitp)
 
+(in-theory (disable common-lisp::apply-context-for-logbitp))
+
 ;; ;; Logtail induces a logsquash context.
-;; (defthm logtail-remove-logsquash
-;;   (implies (<= (nfix m) (nfix n))
-;;            (equal (logtail n (logsquash m i))
-;;                   (logtail n i))))
+;; It also passes a (modified) loghead context.
 
+;; Removal rule: logtail-of-logsquash
 (def-context-rule logtail-induces-logsquash-context
   (equal (logtail n (logsquash n i))
          (logtail n i))
   :fnname logtail$inline)
 
-;; It also passes a (modified) loghead context.
-;; We already have logtail-of-loghead to remove this context.
+(in-theory (disable apply-context-for-logtail$inline))
+
+;; Removal rule: logtail-of-loghead
 (def-context-rule logtail-pass-loghead-context
   (equal (loghead n (logtail m (loghead (+ (nfix n) (nfix m)) i)))
          (loghead n (logtail m i)))
   :hints(("Goal" :in-theory (disable logsquash)))
   :fnname loghead$inline)
 
+(in-theory (disable apply-context-for-loghead$inline))
+
 
 ;; Logic ops are transparent to both types of context.
 
@@ -120,16 +128,16 @@
            (equal (loghead n (logior (loghead m a) b))
                   (loghead n (logior a b)))))
 
-(defthm logior-remove-loghead-2
-  (implies (<= (nfix n) (nfix m))
-           (equal (loghead n (logior a (loghead m b)))
-                  (loghead n (logior a b)))))
-
 (def-context-rule logior-pass-loghead-context-1
   (equal (loghead n (logior (loghead n a) b))
          (loghead n (logior a b)))
   :fnname loghead$inline)
 
+(defthm logior-remove-loghead-2
+  (implies (<= (nfix n) (nfix m))
+           (equal (loghead n (logior a (loghead m b)))
+                  (loghead n (logior a b)))))
+
 (def-context-rule logior-pass-loghead-context-2
   (equal (loghead n (logior a (loghead n b)))
          (loghead n (logior a b)))
@@ -139,15 +147,13 @@
   (implies (<= (nfix m) (nfix n))
            (equal (logsquash n (logior (logsquash m a) b))
                   (logsquash n (logior a b))))
-  :hints(("Goal" :in-theory (enable* ihsext-inductions
-                                     ihsext-recursive-redefs))))
+  :hints ((logbitp-reasoning)))
 
 (defthm logior-remove-logsquash-2
   (implies (<= (nfix m) (nfix n))
            (equal (logsquash n (logior a (logsquash m b)))
                   (logsquash n (logior a b))))
-  :hints(("Goal" :in-theory (enable* ihsext-inductions
-                                     ihsext-recursive-redefs))))
+  :hints ((logbitp-reasoning)))
 
 (def-context-rule logior-pass-logsquash-context-1
   (equal (logsquash n (logior (logsquash n a) b))
@@ -180,19 +186,18 @@
          (loghead n (logand a b)))
   :fnname loghead$inline)
 
+(local (set-default-hints
+        '((logbitp-reasoning))))
+
 (defthm logand-remove-logsquash-1
   (implies (<= (nfix m) (nfix n))
            (equal (logsquash n (logand (logsquash m a) b))
-                  (logsquash n (logand a b))))
-  :hints(("Goal" :in-theory (enable* ihsext-inductions
-                                     ihsext-recursive-redefs))))
+                  (logsquash n (logand a b)))))
 
 (defthm logand-remove-logsquash-2
   (implies (<= (nfix m) (nfix n))
            (equal (logsquash n (logand a (logsquash m b)))
-                  (logsquash n (logand a b))))
-  :hints(("Goal" :in-theory (enable* ihsext-inductions
-                                     ihsext-recursive-redefs))))
+                  (logsquash n (logand a b)))))
 
 (def-context-rule logand-pass-logsquash-context-1
   (equal (logsquash n (logand (logsquash n a) b))
@@ -228,16 +233,12 @@
 (defthm logxor-remove-logsquash-1
   (implies (<= (nfix m) (nfix n))
            (equal (logsquash n (logxor (logsquash m a) b))
-                  (logsquash n (logxor a b))))
-  :hints(("Goal" :in-theory (enable* ihsext-inductions
-                                     ihsext-recursive-redefs))))
+                  (logsquash n (logxor a b)))))
 
 (defthm logxor-remove-logsquash-2
   (implies (<= (nfix m) (nfix n))
            (equal (logsquash n (logxor a (logsquash m b)))
-                  (logsquash n (logxor a b))))
-  :hints(("Goal" :in-theory (enable* ihsext-inductions
-                                     ihsext-recursive-redefs))))
+                  (logsquash n (logxor a b)))))
 
 (def-context-rule logxor-pass-logsquash-context-1
   (equal (logsquash n (logxor (logsquash n a) b))
@@ -255,6 +256,7 @@
 ;;            (equal (loghead n (lognot (loghead m a)))
 ;;                   (loghead n (lognot a)))))
 
+;; Removal rule: loghead-cancel-in-lognot
 (def-context-rule lognot-pass-loghead-context
   (equal (loghead n (lognot (loghead n a)))
          (loghead n (lognot a)))
@@ -265,6 +267,7 @@
 ;;            (equal (logsquash n (lognot (logsquash m a)))
 ;;                   (logsquash n (lognot a)))))
 
+;; Removal rule: logsquash-cancel-in-lognot
 (def-context-rule lognot-pass-logsquash-context
   (equal (logsquash n (lognot (logsquash n a)))
          (logsquash n (lognot a)))
@@ -275,44 +278,43 @@
 ;; Ash propagates a modified loghead/logsquash context.  Right shift also
 ;; induces a logsquash context (same as logtail-induces-logsquash-context).
 
-;; This is not compatible with loghead-of-ash.
+;; This is not compatible with loghead-of-ash.  But loghead-of-ash doesn't work
+;; as a context removal rule; it just pushes the outer context inside.  This
+;; works because it pulls the inner context out.
 (defthmd ash-of-loghead
   (equal (ash (loghead m i) n)
-         (loghead (+ (nfix m) (ifix n)) (ash i n)))
-  :hints(("Goal" :in-theory (e/d (loghead-of-ash ifix nfix loghead**)
-                                 (loghead-identity)))))
+         (loghead (+ (nfix m) (ifix n)) (ash i n))))
 
 (local (in-theory (disable loghead-of-ash)))
 
 (def-context-rule ash-propagate-loghead-context
   (equal (loghead n (ash (loghead (- (nfix n) (ifix m)) i) m))
          (loghead n (ash i m)))
-  :hints(("Goal" :in-theory (e/d (ash-of-loghead
-                                  ifix nfix loghead-of-loghead-split
-                                  loghead**)
-                                 (loghead-identity))))
   :fnname loghead$inline)
 
 (defthmd ash-of-logsquash
   (equal (ash (logsquash m i) n)
-         (logsquash (+ (nfix m) (ifix n)) (ash i n)))
-  :hints(("Goal" :in-theory (e/d (logsquash-of-ash ifix nfix
-                                  logsquash**)))))
+         (logsquash (+ (nfix m) (ifix n)) (ash i n))))
 
 (def-context-rule ash-propagate-logsquash-context
   (equal (logsquash n (ash (logsquash (- (nfix n) (ifix m)) i) m))
          (logsquash n (ash i m)))
-  :hints(("Goal" :in-theory (enable logsquash-of-ash)))
   :fnname logsquash$inline)
 
+;; (defthm right-shift-remove-logsquash
+;;   (implies (and (<= (ifix m) 0)
+;;                 (<= (nfix n) (- (ifix m))))
+;;            (equal (ash (logsquash n i) m)
+;;                   (ash i m)))
+;;   :hints(("Goal" :in-theory (e/d (ash-of-logsquash logsquash**)
+;;                                  (right-shift-to-logtail)))))
+
+;; ash-of-logsquash should work as the removal rule for this too
 (def-context-rule right-shift-induces-logsquash-context
   (implies (<= (ifix m) 0)
            (equal (ash (logsquash (- (ifix m)) i) m)
                   (ash i m)))
-  :hints(("Goal" :in-theory (e/d ()
-                                 (right-shift-to-logtail))
-          :use ((:instance logsquash-of-ash
-                 (x i) (n 0)))))
+  :hints(("Goal" :in-theory (e/d (ifix nfix))))
   :fnname ash)
   
 
@@ -414,66 +416,119 @@
 ;; Logand.  This is the most general, but only works with a constant as the
 ;; mask.  Doesn't work with add/subtract.
 
+;; This is useful for removal of logbitp-of-logand
+(defthm bool->bit-equal-1
+  (implies (booleanp x)
+           (equal (equal 1 (bool->bit x))
+                  x))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
 (def-context-rule logbitp-induces-logand-context
   (implies (syntaxp (quotep n))
            (equal (logbitp n (logand (ash 1 (nfix n)) m))
                   (logbitp n m)))
   :fnname logbitp)
 
+(defthm logior-remove-logand
+  (implies (and (syntaxp (and (quotep n1) (quotep n2)))
+                (equal (logior n1 n2) -1))
+           (equal (logior n1 (logand n2 m))
+                  (logior n1 m))))
+
 (def-context-rule logior-induces-logand-context
   (implies (syntaxp (quotep n))
            (equal (logior n (logand (lognot n) m))
                   (logior n m)))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logior)
 
+(defthm lognot-remove-logand-context
+  (implies (and (syntaxp (and (quotep n1) (quotep n2)))
+                (equal (logand n1 (lognot n2)) 0))
+           (equal (logand n1 (lognot (logand n2 m)))
+                  (logand n1 (lognot m)))))
+
 (def-context-rule lognot-pass-logand-context
   (implies (syntaxp (quotep n))
            (equal (logand n (lognot (logand n m)))
                   (logand n (lognot m))))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logand)
 
+(defthm logior-remove-logand-context-1
+  (implies (and (syntaxp (and (quotep n1)
+                              (quotep n2)))
+                (equal (logand n1 (lognot n2)) 0))
+           (equal (logand n1 (logior (logand n2 m1) m2))
+                  (logand n1 (logior m1 m2)))))
+
 (def-context-rule logior-pass-logand-context-1
   (implies (syntaxp (quotep n))
            (equal (logand n (logior (logand n m1) m2))
                   (logand n (logior m1 m2))))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logand)
 
+(defthm logior-remove-logand-context-2
+  (implies (and (syntaxp (and (quotep n1)
+                              (quotep n2)))
+                (equal (logand n1 (lognot n2)) 0))
+           (equal (logand n1 (logior m2 (logand n2 m1)))
+                  (logand n1 (logior m2 m1)))))
+
 (def-context-rule logior-pass-logand-context-2
   (implies (syntaxp (quotep n))
            (equal (logand n (logior m2 (logand n m1)))
                   (logand n (logior m2 m1))))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logand)
 
+(defthm logand-remove-logand-context-1
+  (implies (and (syntaxp (and (quotep n1)
+                              (quotep n2)))
+                (equal (logand n1 (lognot n2)) 0))
+           (equal (logand n1 (logand (logand n2 m1) m2))
+                  (logand n1 (logand m1 m2)))))
+
 (def-context-rule logand-pass-logand-context-1
   (implies (syntaxp (quotep n))
            (equal (logand n (logand (logand n m1) m2))
                   (logand n (logand m1 m2))))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logand)
 
+(defthm logand-remove-logand-context-2
+  (implies (and (syntaxp (and (quotep n1)
+                              (quotep n2)))
+                (equal (logand n1 (lognot n2)) 0))
+           (equal (logand n1 (logand m2 (logand n2 m1)))
+                  (logand n1 (logand m2 m1)))))
+
 (def-context-rule logand-pass-logand-context-2
   (implies (syntaxp (quotep n))
            (equal (logand n (logand m2 (logand n m1)))
                   (logand n (logand m2 m1))))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logand)
 
+(defthm logxor-remove-logand-context-1
+  (implies (and (syntaxp (and (quotep n1)
+                              (quotep n2)))
+                (equal (logand n1 (lognot n2)) 0))
+           (equal (logand n1 (logxor (logand n2 m1) m2))
+                  (logand n1 (logxor m1 m2)))))
+
 (def-context-rule logxor-pass-logand-context-1
   (implies (syntaxp (quotep n))
            (equal (logand n (logxor (logand n m1) m2))
                   (logand n (logxor m1 m2))))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logand)
 
+(defthm logxor-remove-logand-context-2
+  (implies (and (syntaxp (and (quotep n1)
+                              (quotep n2)))
+                (equal (logand n1 (lognot n2)) 0))
+           (equal (logand n1 (logxor m2 (logand n2 m1)))
+                  (logand n1 (logxor m2 m1)))))
+
 (def-context-rule logxor-pass-logand-context-2
   (implies (syntaxp (quotep n))
            (equal (logand n (logxor m2 (logand n m1)))
                   (logand n (logxor m2 m1))))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logand)
 
 
@@ -518,23 +573,25 @@
            :in-theory (e/d () (ash-1-removal
                                logand-with-negated-bitmask)))))
 
+(defthm ash-remove-logand-context
+  (implies (and (syntaxp (and (quotep n1)
+                              (quotep n2)))
+                (equal (logand (lognot (ash n2 (ifix m))) n1) 0))
+           (equal (logand n1 (ash (logand n2 i) m))
+                  (logand n1 (ash i m)))))
+
 
 (def-context-rule ash-propagate-logand-context
   (implies (syntaxp (quotep n))
            (equal (logand n (ash (logand (ash n (- (ifix m))) i) m))
                   (logand n (ash i m))))
-  :hints ((equal-by-logbitp-hammer))
   :fnname binary-logand)
 
 ;; Rewrite a logsquash of loghead to a logand when sizes are constant:
 (defthm logsquash-of-loghead-to-logand
   (implies (syntaxp (and (quotep n) (quotep m)))
            (equal (logsquash n (loghead m i))
-                  (logand (logsquash n (loghead m -1)) i)))
-  :hints(("Goal" :in-theory (enable* ihsext-inductions
-                                     ihsext-recursive-redefs)
-          :induct (and (logsquash n i)
-                       (loghead m i)))))
+                  (logand (logsquash n (loghead m -1)) i))))
 
 (local (defthm logbitp-when-gte-integer-length
          (implies (<= (integer-length n) (nfix i))
@@ -550,8 +607,27 @@
 (defthmd logand-of-loghead-context-lemma
   (implies (<= 0 (ifix n))
            (equal (logand n (loghead (integer-length n) b))
-                  (logand n b)))
-  :hints ((equal-by-logbitp-hammer)))
+                  (logand n b))))
+
+
+
+(defthm equal-of-logands-by-equal-of-logheads
+  (implies (and (equal (loghead h a) (loghead h b))
+                (equal (logsquash h n) 0))
+           (equal (logand n a) (logand n b)))
+  :rule-classes nil)
+
+(defthm logand-minus-remove-loghead-context
+  (implies (and (syntaxp (and (quotep n)
+                              (quotep h)))
+                (<= 0 (ifix n))
+                (equal (logsquash h n) 0)
+                (integerp b))
+           (equal (logand n (- (loghead h b)))
+                  (logand n (- b))))
+  :hints (("goal" :use ((:instance equal-of-logands-by-equal-of-logheads
+                         (a (- (loghead h b))) (b (- b))))
+           :in-theory (enable loghead-of-minus-of-loghead))))
 
 ;; Logand can create a loghead context for +/-
 ;; Context rules for plus/minus
@@ -568,6 +644,18 @@
           :in-theory (enable loghead-of-minus-of-loghead)))
   :fnname binary-logand)
 
+(defthm logand-plus-remove-loghead-context-1
+  (implies (and (syntaxp (and (quotep n)
+                              (quotep h)))
+                (<= 0 (ifix n))
+                (equal (logsquash h n) 0)
+                (integerp b) (integerp c))
+           (equal (logand n (+ (loghead h b) c))
+                  (logand n (+ b c))))
+  :hints (("goal" :use ((:instance equal-of-logands-by-equal-of-logheads
+                         (a (+ (loghead h b) c)) (b (+ b c))))
+           :in-theory (enable loghead-of-plus-loghead-second))))
+
 (def-context-rule logand-of-plus-context-first
   (implies (and (syntaxp (quotep n))
                 (<= 0 (ifix n))
@@ -579,10 +667,21 @@
                         (b (+ a b)))
                        (:instance logand-of-loghead-context-lemma
                         (b (+ (loghead (integer-length n) a) b))))
-          :in-theory (enable loghead-of-plus-loghead-first
-                             loghead-of-plus-loghead-second)))
+          :in-theory (enable loghead-of-plus-loghead-second)))
   :fnname binary-logand)
 
+(defthm logand-plus-remove-loghead-context-2
+  (implies (and (syntaxp (and (quotep n)
+                              (quotep h)))
+                (<= 0 (ifix n))
+                (equal (logsquash h n) 0)
+                (integerp b) (integerp c))
+           (equal (logand n (+ c (loghead h b)))
+                  (logand n (+ c b))))
+  :hints (("goal" :use ((:instance equal-of-logands-by-equal-of-logheads
+                         (a (+ c (loghead h b))) (b (+ c b))))
+           :in-theory (enable loghead-of-plus-loghead-second))))
+
 (def-context-rule logand-of-plus-context-second
   (implies (and (syntaxp (quotep n))
                 (<= 0 (ifix n))
@@ -608,11 +707,14 @@
     apply-context-for-logtail$inline
     loghead-of-logsquash-commute
     logsquash-of-loghead-zero
+    logsquash-of-loghead-context
     logsquash-idempotent
     logsquash-of-logsquash-split
     loghead-of-loghead-split
     logbitp-of-logsquash-in-bounds
     logbitp-of-loghead-out-of-bounds
+    logtail-of-logsquash
+    logtail-of-loghead
     logior-remove-loghead-1
     logior-remove-loghead-2
     logior-pass-loghead-context-1
@@ -651,12 +753,19 @@
     loghead-of-plus-context-2
     logbitp-induces-logand-context
     logior-induces-logand-context
+    lognot-remove-logand-context
     lognot-pass-logand-context
+    logior-remove-logand-context-1
     logior-pass-logand-context-1
+    logior-remove-logand-context-2
     logior-pass-logand-context-2
+    logand-remove-logand-context-1
     logand-pass-logand-context-1
+    logand-remove-logand-context-2
     logand-pass-logand-context-2
+    logxor-remove-logand-context-1
     logxor-pass-logand-context-1
+    logxor-remove-logand-context-2
     logxor-pass-logand-context-2
     logand-loghead-combine-contexts
     loghead-logand-combine-contexts
@@ -664,8 +773,11 @@
     logsquash-logand-combine-contexts
     ash-propagate-logand-context
     logsquash-of-loghead-to-logand
+    logand-minus-remove-loghead-context
     logand-of-minus-context
+    logand-plus-remove-loghead-context-1
     logand-of-plus-context-first
+    logand-plus-remove-loghead-context-2
     logand-of-plus-context-second))
 
 (def-ruleset! bitops-congruence-incompatible
diff -Nru acl2-6.2/books/centaur/bitops/defaults.lisp acl2-6.3/books/centaur/bitops/defaults.lisp
--- acl2-6.2/books/centaur/bitops/defaults.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/defaults.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -111,7 +111,7 @@
 
 
 (defsection logcdr-default
-  :parents (bigops/defaults logcdr)
+  :parents (bitops/defaults logcdr)
 
   (defthm logcdr-default
     (implies (not (integerp x))
@@ -149,7 +149,7 @@
 
 
 (defsection logxor-defaults
-  :parents (bitops/default logxor)
+  :parents (bitops/defaults logxor)
 
   (defthm logxor-default-1
     (implies (not (integerp x))
diff -Nru acl2-6.2/books/centaur/bitops/equal-by-logbitp.lisp acl2-6.3/books/centaur/bitops/equal-by-logbitp.lisp
--- acl2-6.2/books/centaur/bitops/equal-by-logbitp.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/equal-by-logbitp.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -30,6 +30,7 @@
 (local (in-theory (disable logcons logcar logcdr integer-length)))
 (include-book "ihsext-basics")
 (local (include-book "arithmetic/top-with-meta" :dir :system))
+(include-book "clause-processors/witness-cp" :dir :system)
 
 (local (defthm equal-of-logcdrs-when-equal-of-logcars
          (implies (and (integerp i)
@@ -761,6 +762,9 @@
 
 
 
+
+
+
 (defsection equal-by-logbitp-hammer
   :parents (equal-by-logbitp)
   :short "Drastic automation for @(see equal-by-logbitp)."
@@ -772,9 +776,10 @@
 
   (def-ruleset! logbitp-case-splits
     ;; Basic logbitp case-splitting rules to enable first
-    '(acl2::logbitp-of-ash-split
-      acl2::logbitp-of-loghead-split
-      acl2::logbitp-of-logapp-split))
+    '(logbitp-of-ash-split
+      logbitp-of-loghead-split
+      logbitp-of-logapp-split
+      logbitp-of-logsquash-split))
 
   (def-ruleset! logbitp-case-splits+
     ;; Even more case splitting rules to enable after that
@@ -803,5 +808,57 @@
             :no-thanks t))))
 
 
+(defsection equal-by-logbitp-witnessing
+  (definstantiate equal-by-logbitp-instancing
+    :predicate (equal x y)
+    :vars (bit)
+    :expr (equal (logbitp bit x) (logbitp bit y))
+    :hints ('(:in-theory nil)))
+
+  (defexample equal-by-logbitp-example
+    :pattern (logbitp bit x)
+    :templates (bit)
+    :instance-rules (equal-by-logbitp-instancing))
+
+  (defwitness unequal-by-logbitp-witnessing
+    :predicate (not (equal x y))
+    :expr (or (not (integerp x))
+              (not (integerp y))
+              (let ((bit (logbitp-mismatch x y)))
+                (not (equal (logbitp bit x)
+                            (logbitp bit y)))))
+    :generalize (((logbitp-mismatch x y) . wbit))
+    :hints ('(:in-theory '(logbitp-mismatch-correct
+                           logbitp-mismatch-under-iff
+                           ifix-when-integerp))))
+
+
+  (def-witness-ruleset equal-by-logbitp-rules
+    '(equal-by-logbitp-instancing
+      equal-by-logbitp-example
+      unequal-by-logbitp-witnessing))
+
+  (defmacro logbitp-reasoning ()
+    '(let ((witness-hint
+            (witness :ruleset equal-by-logbitp-rules)))
+       (and witness-hint
+            (let* ((hint-body (cddr witness-hint))
+                   (chr-forms (cadr witness-hint)))
+              `(:computed-hint-replacement
+                ,(append chr-forms
+                         '((and stable-under-simplificationp
+                                '(:in-theory (e/d* (acl2::logbitp-of-const-split))))
+                           (and stable-under-simplificationp
+                                '(:in-theory (e/d* (logbitp-case-splits
+                                                    logbitp-when-bit
+                                                    acl2::logbitp-of-const-split))))
+                           (and stable-under-simplificationp
+                                '(:in-theory (e/d* (logbitp-case-splits
+                                                    logbitp-when-bit
+                                                    acl2::logbitp-of-const-split
+                                                    b-xor b-ior b-and))))))
+                . ,hint-body))))))
+
+
 
 
diff -Nru acl2-6.2/books/centaur/bitops/extra-defs.lisp acl2-6.3/books/centaur/bitops/extra-defs.lisp
--- acl2-6.2/books/centaur/bitops/extra-defs.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/extra-defs.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -21,288 +21,313 @@
 (in-package "ACL2")
 (local (include-book "ihsext-basics"))
 (local (include-book "arithmetic/top" :dir :system))
+(include-book "cutil/define" :dir :system)
 (include-book "centaur/misc/arith-equivs" :dir :system)
 (include-book "ihs/logops-definitions" :dir :system)
-(include-book "xdoc/top" :dir :system)
+(local (include-book "signed-byte-p"))
 
-; extra-defs.lisp
-;
-; These are some functions I wanted when writing specs for integer and
-; packed-integer instructions.
+(defsection extra-defs
+  :parents (bitops)
+  :short "Additional bitwise operations."
+  :long "<p>This is just an ad-hoc collection of low-level bit operations,
+mostly developed in support of specifying various integer and packed-integer
+instructions.</p>")
 
 (local (in-theory (enable* arith-equiv-forwarding)))
 
-(defun nth-slice2 (n x)
-  "Extract the Nth 2-bit slice of the integer X."
-  (declare (xargs :guard (and (natp n)
-                              (integerp x))))
+
+(define nth-slice2 ((n natp)
+                    (x integerp))
+  :returns (slice natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Extract the @('n')th 2-bit slice of the integer @('x')."
+  :long "<p>We leave this enabled; we would usually not expect to try to reason
+about it.</p>"
+  :enabled t
+  :inline t
   (mbe :logic
        (logand (ash (ifix x) (* (nfix n) -2)) (1- (expt 2 2)))
        :exec
-       (logand (ash x (* n -2)) #x3)))
-
-(defcong nat-equiv equal (nth-slice2 n x) 1)
-(defcong int-equiv equal (nth-slice2 n x) 2)
-
-(defun nth-slice8 (n x)
-  "Extract the Nth 8-bit slice of the integer X."
-  (declare (xargs :guard (and (natp n)
-                              (integerp x))))
+       (the (unsigned-byte 2)
+         (logand (ash x (the (integer * 0) (* n -2))) #x3)))
+  ///
+  (defcong nat-equiv equal (nth-slice2 n x) 1)
+  (defcong int-equiv equal (nth-slice2 n x) 2)
+  (defthm unsigned-byte-p-2-of-nth-slice2
+    (unsigned-byte-p 2 (nth-slice2 n x))))
+
+
+(define nth-slice8 ((n natp)
+                    (x integerp))
+  :returns (slice natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Extract the @('n')th 8-bit slice of the integer @('x')."
+  :long "<p>We leave this enabled; we would usually not expect to try to reason
+about it.</p>"
+  :enabled t
+  :inline t
   (mbe :logic
        (logand (ash (ifix x) (* (nfix n) -8)) (1- (expt 2 8)))
        :exec
-       (logand (ash x (* n -8)) #xFF)))
-
-(defcong nat-equiv equal (nth-slice8 n x) 1)
-(defcong int-equiv equal (nth-slice8 n x) 2)
-
-(defun nth-slice16 (n x)
-  "Extract the Nth 16-bit slice of the integer X."
-  (declare (xargs :guard (and (natp n)
-                              (integerp x))))
+       (the (unsigned-byte 8)
+         (logand (ash x (* n -8)) #xFF)))
+  ///
+  (defcong nat-equiv equal (nth-slice8 n x) 1)
+  (defcong int-equiv equal (nth-slice8 n x) 2)
+  (defthm unsigned-byte-p-8-of-nth-slice8
+    (unsigned-byte-p 8 (nth-slice8 n x))))
+
+
+(define nth-slice16 ((n natp)
+                     (x integerp))
+  :returns (slice natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Extract the @('n')th 16-bit slice of the integer @('x')."
+  :long "<p>We leave this enabled; we would usually not expect to try to reason
+about it.</p>"
+  :enabled t
+  :inline t
   (mbe :logic
        (logand (ash (ifix x) (* (nfix n) -16)) (1- (expt 2 16)))
        :exec
-       (logand (ash x (* n -16)) #xFFFF)))
-
-(defcong nat-equiv equal (nth-slice16 n x) 1)
-(defcong int-equiv equal (nth-slice16 n x) 2)
-
-
-(defun nth-slice32 (n x)
-  "Extract the Nth 32-bit slice of the integer X."
-  (declare (xargs :guard (and (natp n)
-                              (integerp x))))
+       (the (unsigned-byte 16)
+         (logand (ash x (* n -16)) #xFFFF)))
+  ///
+  (defcong nat-equiv equal (nth-slice16 n x) 1)
+  (defcong int-equiv equal (nth-slice16 n x) 2)
+  (defthm unsigned-byte-p-16-of-nth-slice16
+    (unsigned-byte-p 16 (nth-slice16 n x))))
+
+
+(define nth-slice32 ((n natp)
+                     (x integerp))
+  :returns (slice natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Extract the @('n')th 32-bit slice of the integer @('x')."
+  :long "<p>We leave this enabled; we would usually not expect to try to reason
+about it.</p>"
+  :enabled t
+  :inline t
   (mbe :logic
        (logand (ash (ifix x) (* (nfix n) -32)) (1- (expt 2 32)))
        :exec
-       (logand (ash x (* n -32)) #ux_FFFF_FFFF)))
-
-(defcong nat-equiv equal (nth-slice32 n x) 1)
-(defcong int-equiv equal (nth-slice32 n x) 2)
-
-
-(defun nth-slice64 (n x)
-  "Extract the Nth 64-bit slice of the integer X."
-  (declare (xargs :guard (and (natp n)
-                              (integerp x))))
+       (the (unsigned-byte 32)
+         (logand (ash x (* n -32)) #ux_FFFF_FFFF)))
+  ///
+  (defcong nat-equiv equal (nth-slice32 n x) 1)
+  (defcong int-equiv equal (nth-slice32 n x) 2)
+  (defthm unsigned-byte-p-32-of-nth-slice32
+    (unsigned-byte-p 32 (nth-slice32 n x))))
+
+
+(define nth-slice64 ((n natp)
+                     (x integerp))
+  :returns (slice natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Extract the @('n')th 32-bit slice of the integer @('x')."
+  :long "<p>We leave this enabled; we would usually not expect to try to reason
+about it.</p>"
+  :enabled t
+  :inline t
   (mbe :logic
        (logand (ash (ifix x) (* (nfix n) -64)) (1- (expt 2 64)))
        :exec
-       (logand (ash x (* n -64)) #ux_FFFF_FFFF_FFFF_FFFF)))
-
-(defcong nat-equiv equal (nth-slice64 n x) 1)
-(defcong int-equiv equal (nth-slice64 n x) 2)
-
-
-
-(defthm natp-of-nth-slice2
-  (natp (nth-slice2 n x))
-  :rule-classes :type-prescription)
-
-(defthm natp-of-nth-slice8
-  (natp (nth-slice8 n x))
-  :rule-classes :type-prescription)
-
-(defthm natp-of-nth-slice16
-  (natp (nth-slice16 n x))
-  :rule-classes :type-prescription)
-
-(defthm natp-of-nth-slice32
-  (natp (nth-slice32 n x))
-  :rule-classes :type-prescription)
-
-(defthm natp-of-nth-slice64
-  (natp (nth-slice64 n x))
-  :rule-classes :type-prescription)
-
-
-
-
-(defun negate-slice8 (x)
-  "X is an 8-bit natural.  Treat it as a signed, 8-bit value.  Compute the
-two's complement negation of X, and return it as an 8-bit natural.  For
-instance, (negate-slice8 3) = 253."
-  (declare (xargs :guard (natp x)))
+       (the (unsigned-byte 64)
+         (logand (ash x (* n -64)) #ux_FFFF_FFFF_FFFF_FFFF)))
+  ///
+  (defcong nat-equiv equal (nth-slice64 n x) 1)
+  (defcong int-equiv equal (nth-slice64 n x) 2)
+  (defthm unsigned-byte-p-64-of-nth-slice64
+    (unsigned-byte-p 64 (nth-slice64 n x))))
+
+
+(define negate-slice8 ((x :type (unsigned-byte 8)))
+  :returns (~x natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "@(call negate-slice8) computes the 8-bit two's complement negation of
+@('x') and returns it as an 8-bit natural."
+  :long "<p>For example, @('(negate-slice8 3) = 253').</p>
+<p>We leave this enabled; we would usually not expect to try to reason about
+it.</p>"
+  :inline t
+  :enabled t
   (mbe :logic
        (logand (+ 1 (lognot (nfix x))) (1- (expt 2 8)))
        :exec
-       (logand (+ 1 (lognot x)) #xFF)))
-
-(defcong nat-equiv equal (negate-slice8 x) 1)
-
-
-(defun negate-slice16 (x)
-  "X is a 16-bit natural.  Treat it as a signed, 16-bit value.  Compute the
-   two's complement negation of X and return it as a 16-bit natural."
-  (declare (xargs :guard (natp x)))
+       (the (unsigned-byte 8)
+         (logand (the (signed-byte 9)
+                   (+ 1 (the (signed-byte 9) (lognot x))))
+                 #xFF)))
+  ///
+  (defcong nat-equiv equal (negate-slice8 x) 1)
+  (defthm unsigned-byte-p-8-of-negate-slice8
+    (unsigned-byte-p 8 (negate-slice8 x))))
+
+
+(define negate-slice16 ((x :type (unsigned-byte 16)))
+  :returns (~x natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "@(call negate-slice16) computes the 16-bit two's complement negation
+of @('x') and returns it as an 16-bit natural."
+  :long "<p>We leave this enabled; we would usually not expect to try to reason
+about it.</p>"
+  :inline t
+  :enabled t
   (mbe :logic
        (logand (+ 1 (lognot (nfix x))) (1- (expt 2 16)))
        :exec
-       (logand (+ 1 (lognot x)) #xFFFF)))
-
-(defcong nat-equiv equal (negate-slice16 x) 1)
-
-(defun negate-slice32 (x)
-  "X is a 32-bit natural.  Treat it as a signed, 32-bit value.  Compute the
-two's complement negation of X and return it as a 32-bit natural."
-  (declare (xargs :guard (natp x)))
+       (the (unsigned-byte 16)
+         (logand (the (signed-byte 17)
+                   (+ 1 (the (signed-byte 17) (lognot x))))
+                 #xFFFF)))
+  ///
+  (defcong nat-equiv equal (negate-slice16 x) 1)
+  (defthm unsigned-byte-p-16-of-negate-slice16
+    (unsigned-byte-p 16 (negate-slice16 x))))
+
+
+(define negate-slice32 ((x :type (unsigned-byte 32)))
+  :returns (~x natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "@(call negate-slice32) computes the 32-bit two's complement negation
+of @('x') and returns it as an 32-bit natural."
+  :long "<p>We leave this enabled; we would usually not expect to try to reason
+about it.</p>"
+  :inline t
+  :enabled t
   (mbe :logic
        (logand (+ 1 (lognot (nfix x))) (1- (expt 2 32)))
        :exec
-       (logand (+ 1 (lognot x)) #ux_FFFF_FFFF)))
-
-(defcong nat-equiv equal (negate-slice32 x) 1)
-
-(defun negate-slice64 (x)
-  "X is a 64-bit natural.  Treat it as a signed, 64-bit value.  Compute the
-two's complement negation of X and return it as a 64-bit natural."
-  (declare (xargs :guard (natp x)))
+       (the (unsigned-byte 32)
+         (logand (the (signed-byte 33)
+                   (+ 1 (the (signed-byte 33) (lognot x))))
+                 #ux_FFFF_FFFF)))
+  ///
+  (defcong nat-equiv equal (negate-slice32 x) 1)
+  (defthm unsigned-byte-p-32-of-negate-slice32
+    (unsigned-byte-p 32 (negate-slice32 x))))
+
+
+(define negate-slice64 ((x :type (unsigned-byte 64)))
+  :returns (~x natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "@(call negate-slice64) computes the 64-bit two's complement negation
+of @('x') and returns it as an 64-bit natural."
+  :long "<p>We leave this enabled; we would usually not expect to try to reason
+about it.</p>"
+  :enabled t
   (mbe :logic
        (logand (+ 1 (lognot (nfix x))) (1- (expt 2 64)))
        :exec
-       (logand (+ 1 (lognot x)) #ux_FFFF_FFFF_FFFF_FFFF)))
+       (the (unsigned-byte 64)
+         (logand (the (signed-byte 65)
+                   (+ 1 (the (signed-byte 65) (lognot x))))
+                 #ux_FFFF_FFFF_FFFF_FFFF)))
+  ///
+  (defcong nat-equiv equal (negate-slice64 x) 1)
+  (defthm unsigned-byte-p-64-of-negate-slice64
+    (unsigned-byte-p 64 (negate-slice64 x))))
 
-(defcong nat-equiv equal (negate-slice64 x) 1)
 
-(defthm natp-of-negate-slice8
-  (natp (negate-slice8 x))
-  :rule-classes :type-prescription)
-
-(defthm natp-of-negate-slice16
-  (natp (negate-slice16 x))
-  :rule-classes :type-prescription)
-
-(defthm natp-of-negate-slice32
-  (natp (negate-slice32 x))
-  :rule-classes :type-prescription)
-
-(defthm natp-of-negate-slice64
-  (natp (negate-slice64 x))
-  :rule-classes :type-prescription)
-
-
-; BOZO consider extending ihsext-basics with stuff about expt-2.
-(local (defthm posp-expt-2
-         (<= 0 (expt 2 width))
-         :rule-classes ((:rewrite)
-                        (:linear)
-                        (:type-prescription))
-         :hints(("Goal" :in-theory (enable expt)))))
-
-(local (defthm integerp-expt-2
-         (implies (<= 0 width)
-                  (integerp (expt 2 width)))
-         :rule-classes ((:rewrite)
-                        (:type-prescription))
-         :hints(("Goal" :in-theory (enable expt)))))
 
+(define abs-diff ((a integerp)
+                  (b integerp))
+  :returns (ans natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "@(call abs-diff) is just @('(abs (- (ifix a) (ifix b)))'), but
+optimized for @(see gl)."
+
+  :long "<p>@('abs-diff') is similar to @('(abs (- a b))') but has better
+performance for symbolic simulations with GL: it decides whether the
+subtraction will be necessary by looking at the arguments, which tend to be
+simple and perhaps nicely interleaved, instead of by looking at the result,
+which tend to be complex since they are the combined arguments.</p>
+
+<p>For an @('aig-cert-mode') proof of the 64-bit @('PSADBW') instruction, using
+@('abs-diff') instead of @('(abs (- a b))') reduced the proof time from 56.2
+seconds to 37.44 seconds.</p>
 
+<p>We disable this function, but we leave enabled the following theorem:</p>
 
-(defund abs-diff (a b) ;; Disabled since abs-diff-correct is nicer for reasoning.
-
-  "(ABS-DIFF A B) is provably equal to (ABS (- (IFIX A) (IFIX B))).
-
-ABS-DIFF performs better than (ABS (- A B)) for symbolic simulation with GL: it
-decides whether the subtraction will be necessary by looking at the arguments,
-which tend to be simple and nicely interleaved, instead of by looking at the
-result, which tend to be complex since they are the combined arguments.
-
-For an AIG-CERT-MODE proof of the 64-bit PSADBW instruction, using ABS-DIFF
-instead of (ABS (- A B)) reduced the proof time from 56.2 seconds to 37.44
-seconds."
-    (declare (xargs :guard (and (integerp a)
-                                (integerp b))))
-    (mbe :logic
-         ;; Don't be tempted to change the :logic definition to (abs (- (ifix
-         ;; a) (ifix b))).  GL uses :logic definitions!
-         (let ((a (ifix a))
-               (b (ifix b)))
-           (if (<= b a)
-               (- a b)
-             (- b a)))
-         :exec
-         (if (<= b a)
-             (- a b)
-           (- b a))))
+@(thm abs-diff-correct)
 
-(defthm abs-diff-correct
-  (equal (abs-diff a b)
-         (abs (- (ifix a) (ifix b))))
-  :hints(("Goal" :in-theory (enable abs-diff))))
-
-(defthm natp-of-abs-diff
-  (natp (abs-diff a b))
-  :rule-classes :type-prescription)
+<p>We therefore would not expect to ever need to reason about @('abs-diff')
+directly.</p>"
 
+  (mbe :logic
+       ;; Don't be tempted to change the :logic definition to (abs (- (ifix a)
+       ;; (ifix b))).  GL uses :logic definitions!
+       (let ((a (ifix a))
+             (b (ifix b)))
+         (if (<= b a)
+             (- a b)
+           (- b a)))
+       :exec
+       (if (<= b a)
+           (- a b)
+         (- b a)))
+  ///
+  (defthm abs-diff-correct
+    (equal (abs-diff a b)
+           (abs (- (ifix a) (ifix b))))))
 
 
-(defun setbit (n x)
-  "Set X[n] := 1"
-  (declare (xargs :guard (and (natp n)
-                              (integerp x))))
+(define setbit ((n natp     "Bit position to set to 1.")
+                (x integerp "Starting value."))
+  :returns (ans integerp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Set X[n] := 1"
+  :enabled t
   (let ((n (lnfix n))
         (x (lifix x)))
-    (logior (ash 1 n) x)))
-
-(defcong nat-equiv equal (setbit n x) 1)
-(defcong int-equiv equal (setbit n x) 2)
+    (logior (ash 1 n) x))
+  ///
+  (defcong nat-equiv equal (setbit n x) 1)
+  (defcong int-equiv equal (setbit n x) 2))
 
-(defthm integerp-of-setbit
-  (integerp (setbit n x))
-  :rule-classes :type-prescription)
 
-
-(defun clearbit (n x)
-  "Set X[n] := 0"
-  (declare (xargs :guard (and (natp n)
-                              (integerp x))))
+(define clearbit ((n natp     "Bit position to clear to 0.")
+                  (x integerp "Starting value."))
+  :returns (ans integerp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Set X[n] := 0"
+  :enabled t
   (let ((n (lnfix n))
         (x (lifix x)))
-    (logand (lognot (ash 1 n)) x)))
-
-(defcong nat-equiv equal (clearbit n x) 1)
-(defcong int-equiv equal (clearbit n x) 2)
-
-(defthm integerp-of-clearbit
-  (integerp (clearbit n x))
-  :rule-classes :type-prescription)
+    (logand (lognot (ash 1 n)) x))
+  ///
+  (defcong nat-equiv equal (clearbit n x) 1)
+  (defcong int-equiv equal (clearbit n x) 2))
 
 
-(defun copybit (n from to)
-  "Set To[n] := From[n]"
-  (declare (xargs :guard (and (natp n)
-                              (integerp from)
-                              (integerp to))))
+(define copybit ((n    natp     "Bit position to copy.")
+                 (from integerp)
+                 (to   integerp))
+  :returns (ans integerp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Set To[n] := From[n]"
+  :enabled t
   (if (logbitp n from)
       (setbit n to)
-    (clearbit n to)))
-
-(defcong nat-equiv equal (copybit n x y) 1)
-(defcong int-equiv equal (copybit n x y) 2)
-(defcong int-equiv equal (copybit n x y) 3)
-
-
-(defthm integerp-of-copybit
-  (integerp (copybit n from to))
-  :rule-classes :type-prescription)
+    (clearbit n to))
+  ///
+  (defcong nat-equiv equal (copybit n x y) 1)
+  (defcong int-equiv equal (copybit n x y) 2)
+  (defcong int-equiv equal (copybit n x y) 3))
 
 
-(defun notbit (n x)
-  "Set X[n] := ~X[n]"
-  (declare (xargs :guard (and (natp n)
-                              (integerp x))))
+(define notbit ((n natp     "Bit position to negate.")
+                (x integerp "Starting value."))
+  :returns (ans integerp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "Set X[n] := ~X[n]"
+  :enabled t
   (if (logbitp n x)
       (clearbit n x)
-    (setbit n x)))
-
-(defcong nat-equiv equal (notbit n x) 1)
-(defcong int-equiv equal (notbit n x) 2)
-
-(defthm integerp-of-notbit
-  (integerp (notbit n x))
-  :rule-classes :type-prescription)
-
+    (setbit n x))
+  ///
+  (defcong nat-equiv equal (notbit n x) 1)
+  (defcong int-equiv equal (notbit n x) 2))
 
 
 (local
@@ -311,94 +336,99 @@
             (< (logtail 1 src) src))
    :hints(("Goal" :in-theory (e/d (logtail**))))))
 
-(defund bitscan-fwd (src)
-  "(BITSCAN-FWD SRC) returns the bit position of the least significant bit in
-SRC that is set, or 0 when SRC is zero (and hence has no such bit)."
-  (declare (xargs :guard (natp src)
-                  :measure (nfix src)))
+(define bitscan-fwd ((src natp))
+  :returns (position natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "@(call bitscan-fwd) returns the bit position of the least significant
+bit in @('src') that is set, or 0 when @('src') is zero (and hence has no such
+bit)."
+  :long "<p>Examples:</p>
+@({
+     (bitscan-fwd #b1001) = 0
+     (bitscan-fwd #b1010) = 1
+     (bitscan-fwd #b1100) = 2
+     (bitscan-fwd #b1000) = 3
+})"
   (cond ((zp src)         0)
         ((logbitp 0 src)  0)
-        (t                (+ 1 (bitscan-fwd (ash src -1))))))
+        (t                (+ 1 (bitscan-fwd (ash src -1)))))
+  ///
+  (local (defthmd bitscan-fwd-examples
+           ;; This is just to try to "validate the spec" by showing it produces the
+           ;; values we want for some examples.
+           (and
+            ;; Some basic examples...
+            (equal (bitscan-fwd #ub_0000_0000_0001) 0)
+            (equal (bitscan-fwd #ub_0000_0000_0010) 1)
+            (equal (bitscan-fwd #ub_0000_0000_0100) 2)
+            (equal (bitscan-fwd #ub_0000_0000_1000) 3)
+            (equal (bitscan-fwd #ub_0000_0001_0000) 4)
+            (equal (bitscan-fwd #ub_0000_0010_0000) 5)
+            (equal (bitscan-fwd #ub_0000_0100_0000) 6)
+            ;; Same examples, but with upper bits changed to 1s...
+            (equal (bitscan-fwd #ub_0100_0101_0001) 0)
+            (equal (bitscan-fwd #ub_0110_0110_1010) 1)
+            (equal (bitscan-fwd #ub_1010_0101_0100) 2)
+            (equal (bitscan-fwd #ub_1010_1110_1000) 3)
+            (equal (bitscan-fwd #ub_1111_1111_0000) 4)
+            (equal (bitscan-fwd #ub_1010_1010_0000) 5)
+            (equal (bitscan-fwd #ub_0011_1100_0000) 6))))
+
+  (defcong nat-equiv equal (bitscan-fwd src) 1))
+
+
+(define bitscan-rev ((src natp))
+  :returns (position natp :rule-classes :type-prescription)
+  :parents (extra-defs)
+  :short "@(call bitscan-rev) returns the bit position of the most significant
+bit in @('src') that is set, or 0 when @('src') is zero (and hence has no such
+bit)."
+  :long "<p>Examples:</p>
+@({
+    (bitscan-rev #b0001) = 0
+    (bitscan-rev #b0011) = 1
+    (bitscan-rev #b0101) = 2
+    (bitscan-rev #b1001) = 3
+})"
 
-(local (defthmd bitscan-fwd-examples
-         ;; This is just to try to "validate the spec" by showing it produces the
-         ;; values we want for some examples.
-         (and
-          ;; Some basic examples...
-          (equal (bitscan-fwd #ub_0000_0000_0001) 0)
-          (equal (bitscan-fwd #ub_0000_0000_0010) 1)
-          (equal (bitscan-fwd #ub_0000_0000_0100) 2)
-          (equal (bitscan-fwd #ub_0000_0000_1000) 3)
-          (equal (bitscan-fwd #ub_0000_0001_0000) 4)
-          (equal (bitscan-fwd #ub_0000_0010_0000) 5)
-          (equal (bitscan-fwd #ub_0000_0100_0000) 6)
-          ;; Same examples, but with upper bits changed to 1s...
-          (equal (bitscan-fwd #ub_0100_0101_0001) 0)
-          (equal (bitscan-fwd #ub_0110_0110_1010) 1)
-          (equal (bitscan-fwd #ub_1010_0101_0100) 2)
-          (equal (bitscan-fwd #ub_1010_1110_1000) 3)
-          (equal (bitscan-fwd #ub_1111_1111_0000) 4)
-          (equal (bitscan-fwd #ub_1010_1010_0000) 5)
-          (equal (bitscan-fwd #ub_0011_1100_0000) 6))))
-
-(defthm natp-of-bitscan-fwd
-  (natp (bitscan-fwd src))
-  :rule-classes :type-prescription)
-
-(defcong nat-equiv equal (bitscan-fwd src) 1
-  :hints(("Goal" :in-theory (enable bitscan-fwd))))
-
-
-(defund bitscan-rev (src)
-  "(BITSCAN-REV SRC) returns the bit position of the most significant bit in
-SRC that is set, or 0 when SRC is zero (and hence has no such bit)."
-  (declare (xargs :guard (natp src)
-                  :measure (nfix src)))
   (if (zp src)
       0
     (let ((next (ash src -1)))
       (if (= next 0)
           0
-        (+ 1 (bitscan-rev next))))))
-
-(defcong nat-equiv equal (bitscan-rev src) 1
-  :hints(("Goal" :in-theory (enable bitscan-rev))))
-
-(local (defthmd bitscan-rev-examples
-         ;; This is just to try to "validate the spec" by showing it produces the
-         ;; values we want for some examples.
-         (and
-          ;; Some basic examples... just like bsf since only one bit is set
-          (equal (bitscan-rev #ub_0000_0000_0001) 0)
-          (equal (bitscan-rev #ub_0000_0000_0010) 1)
-          (equal (bitscan-rev #ub_0000_0000_0100) 2)
-          (equal (bitscan-rev #ub_0000_0000_1000) 3)
-          (equal (bitscan-rev #ub_0000_0001_0000) 4)
-          (equal (bitscan-rev #ub_0000_0010_0000) 5)
-          (equal (bitscan-rev #ub_0000_0100_0000) 6)
-          (equal (bitscan-rev #ub_0000_1000_0000) 7)
-          (equal (bitscan-rev #ub_0001_0000_0000) 8)
-          (equal (bitscan-rev #ub_0010_0000_0000) 9)
-          (equal (bitscan-rev #ub_0100_0000_0000) 10)
-          (equal (bitscan-rev #ub_1000_0000_0000) 11)
-          ;; Same examples, but with some low bits flipped to one.
-          (equal (bitscan-rev #ub_0000_0000_0001) 0)
-          (equal (bitscan-rev #ub_0000_0000_0011) 1)
-          (equal (bitscan-rev #ub_0000_0000_0101) 2)
-          (equal (bitscan-rev #ub_0000_0000_1101) 3)
-          (equal (bitscan-rev #ub_0000_0001_0101) 4)
-          (equal (bitscan-rev #ub_0000_0011_0101) 5)
-          (equal (bitscan-rev #ub_0000_0101_0111) 6)
-          (equal (bitscan-rev #ub_0000_1101_1111) 7)
-          (equal (bitscan-rev #ub_0001_1111_1111) 8)
-          (equal (bitscan-rev #ub_0010_0100_0101) 9)
-          (equal (bitscan-rev #ub_0101_0100_0001) 10)
-          (equal (bitscan-rev #ub_1010_0101_0110) 11))))
-
-(defthm natp-of-bitscan-rev
-  (natp (bitscan-rev src))
-  :rule-classes :type-prescription)
-
+        (+ 1 (bitscan-rev next)))))
+  ///
+  (local (defthmd bitscan-rev-examples
+           ;; This is just to try to "validate the spec" by showing it produces the
+           ;; values we want for some examples.
+           (and
+            ;; Some basic examples... just like bsf since only one bit is set
+            (equal (bitscan-rev #ub_0000_0000_0001) 0)
+            (equal (bitscan-rev #ub_0000_0000_0010) 1)
+            (equal (bitscan-rev #ub_0000_0000_0100) 2)
+            (equal (bitscan-rev #ub_0000_0000_1000) 3)
+            (equal (bitscan-rev #ub_0000_0001_0000) 4)
+            (equal (bitscan-rev #ub_0000_0010_0000) 5)
+            (equal (bitscan-rev #ub_0000_0100_0000) 6)
+            (equal (bitscan-rev #ub_0000_1000_0000) 7)
+            (equal (bitscan-rev #ub_0001_0000_0000) 8)
+            (equal (bitscan-rev #ub_0010_0000_0000) 9)
+            (equal (bitscan-rev #ub_0100_0000_0000) 10)
+            (equal (bitscan-rev #ub_1000_0000_0000) 11)
+            ;; Same examples, but with some low bits flipped to one.
+            (equal (bitscan-rev #ub_0000_0000_0001) 0)
+            (equal (bitscan-rev #ub_0000_0000_0011) 1)
+            (equal (bitscan-rev #ub_0000_0000_0101) 2)
+            (equal (bitscan-rev #ub_0000_0000_1101) 3)
+            (equal (bitscan-rev #ub_0000_0001_0101) 4)
+            (equal (bitscan-rev #ub_0000_0011_0101) 5)
+            (equal (bitscan-rev #ub_0000_0101_0111) 6)
+            (equal (bitscan-rev #ub_0000_1101_1111) 7)
+            (equal (bitscan-rev #ub_0001_1111_1111) 8)
+            (equal (bitscan-rev #ub_0010_0100_0101) 9)
+            (equal (bitscan-rev #ub_0101_0100_0001) 10)
+            (equal (bitscan-rev #ub_1010_0101_0110) 11))))
 
+  (defcong nat-equiv equal (bitscan-rev src) 1))
 
 
diff -Nru acl2-6.2/books/centaur/bitops/ihsext-basics.lisp acl2-6.3/books/centaur/bitops/ihsext-basics.lisp
--- acl2-6.2/books/centaur/bitops/ihsext-basics.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/ihsext-basics.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -56,7 +56,7 @@
   unsigned-byte-p-0
   unsigned-byte-p-plus
   difference-unsigned-byte-p
-  signed-byte-p-base-cases
+  ;; signed-byte-p-base-cases
   ;; backchain-signed-byte-p-to-unsigned-byte-p
   loghead-identity
   ;; loghead-0-i remove hyp
@@ -2149,6 +2149,197 @@
     :hints(("Goal" :in-theory (enable* ihsext-recursive-redefs
                                        ihsext-inductions nfix ifix)))))
 
+(defsection expt
+
+  (defthmd expt-2-is-ash
+    (implies (natp n)
+             (equal (expt 2 n)
+                    (ash 1 n)))
+    :hints(("Goal" :in-theory (enable ash floor))))
+
+  (defthm expt-of-ifix
+    (equal (expt r (ifix i))
+           (expt r i))
+    :hints(("Goal" :in-theory (enable expt))))
+
+  (add-to-ruleset ihsext-arithmetic '(expt-2-is-ash))
+  (add-to-ruleset ihsext-basic-thms expt-of-ifix))
+
+
+
+
+(defsection unsigned-byte-p**
+
+  (local (in-theory (enable* ihsext-recursive-redefs
+                             ihsext-inductions)))
+
+  (local (in-theory (enable expt-2-is-ash)))
+
+
+  (defthm unsigned-byte-p-of-n-0
+    (equal (unsigned-byte-p n 0)
+           (natp n)))
+
+  (defthm unsigned-byte-p-of-0-x
+    (equal (unsigned-byte-p 0 x)
+           (equal x 0)))
+
+  (defthmd unsigned-byte-p**
+    (equal (unsigned-byte-p bits x)
+           (and (integerp x)
+                (natp bits)
+                (if (zp bits)
+                    (equal x 0)
+                  (unsigned-byte-p (1- bits)
+                                   (logcdr x)))))
+    :rule-classes ((:definition
+                    :clique (unsigned-byte-p)
+                    :controller-alist ((unsigned-byte-p t t)))))
+
+  (local (in-theory (enable unsigned-byte-p**)))
+  (local (in-theory (disable unsigned-byte-p)))
+
+  (add-to-ruleset ihsext-recursive-redefs '(unsigned-byte-p**))
+
+
+  (defun unsigned-byte-p-ind (bits x)
+    (and (integerp x)
+         (natp bits)
+         (if (zp bits)
+             (equal x 0)
+           (unsigned-byte-p-ind (1- bits) (logcdr x)))))
+
+  (defthm unsigned-byte-p-induct
+    t
+    :rule-classes ((:induction
+                    :pattern (unsigned-byte-p bits x)
+                    :scheme (unsigned-byte-p-ind bits x))))
+
+  (defthmd unsigned-byte-p-incr
+    (implies (and (unsigned-byte-p a x)
+                  (natp b)
+                  (<= a b))
+             (unsigned-byte-p b x)))
+
+  (local (in-theory (enable unsigned-byte-p-incr)))
+
+  (defthmd unsigned-byte-p-logcons
+    (implies (and (unsigned-byte-p (1- b) x)
+                  (natp b))
+             (unsigned-byte-p b (logcons bit x)))
+    :hints (("goal" :expand ((unsigned-byte-p b (logcons bit x))))))
+
+  (defthmd unsigned-byte-p-logcons-free
+    (implies (and (unsigned-byte-p a x)
+                  (natp b)
+                  (<= a (1- b)))
+             (unsigned-byte-p b (logcons bit x)))
+    :hints (("goal" :expand ((unsigned-byte-p b (logcons bit x))))))
+
+  (defthmd unsigned-byte-p-logcdr
+    (implies (and (unsigned-byte-p a x)
+                  (natp b)
+                  (<= a (1+ b)))
+             (unsigned-byte-p b (logcdr x))))
+
+  (add-to-ruleset ihsext-bounds-thms '(unsigned-byte-p-incr
+                                       unsigned-byte-p-logcons
+                                       unsigned-byte-p-logcons-free
+                                       unsigned-byte-p-logcdr))
+
+  (local (in-theory (disable unsigned-byte-p-logand
+                             unsigned-byte-p-logior
+                             logior-=-0)))
+
+  (defthmd unsigned-byte-p-logand-fix
+    (implies (or (unsigned-byte-p b x)
+                 (unsigned-byte-p b y))
+             (unsigned-byte-p b (logand x y))))
+
+  (defun unsigned-byte-p-logior-ind (b x y)
+    (cond ((zp b) (list x y))
+          (t (unsigned-byte-p-logior-ind
+              (1- b) (logcdr x) (logcdr y)))))
+
+  (defthmd unsigned-byte-p-logior-fix
+    (equal (unsigned-byte-p b (logior x y))
+           (and (unsigned-byte-p b (ifix x))
+                (unsigned-byte-p b (ifix y))))
+    :hints (("goal" :induct (unsigned-byte-p-logior-ind b x y))))
+
+  (add-to-ruleset ihsext-basic-thms '(unsigned-byte-p-logand-fix
+                                      unsigned-byte-p-logior-fix))
+
+  (defthm unsigned-byte-p-of-loghead
+    (implies (and (integerp size1)
+                  (<= (nfix size) size1))
+             (unsigned-byte-p size1 (loghead size i))))
+
+  (defthm unsigned-byte-p-of-logtail
+    (implies (natp size1)
+             (equal (unsigned-byte-p size1 (logtail size i))
+                    (unsigned-byte-p (+ size1 (nfix size)) (ifix i))))
+    :hints (("goal" :induct (and (logtail size i)
+                                 (logtail size1 i)))))
+
+  (defthm unsigned-byte-p-when-unsigned-byte-p-less
+    (implies (and (unsigned-byte-p n x)
+                  (natp m)
+                  (<= n m))
+             (unsigned-byte-p m x)))
+
+  (encapsulate
+    nil
+    (local (defun ind (n m x)
+             (cond ((zip m) (list n x))
+                   ((< m 0) (ind (1+ n) (1+ m) x))
+                   (t (ind (1- n) (1- m) x)))))
+
+    (local (defthm help1
+             (implies (unsigned-byte-p n x)
+                      (natp n))))
+
+
+    (local (defthm unsigned-byte-p-of-ash-worse
+             ;; "worse" because of the natp hyp, which we'll eliminate in a moment
+             (implies (and (unsigned-byte-p (- n (ifix m)) x)
+                           (natp n))
+                      (unsigned-byte-p n (ash x m)))
+             :hints(("Goal" :in-theory (e/d* (acl2::ihsext-recursive-redefs
+                                              acl2::ihsext-inductions
+                                              nfix ifix zip)
+                                             (unsigned-byte-p))
+                     :induct (ind n m x)
+                     :do-not-induct t)
+                    (and stable-under-simplificationp
+                         '(:expand ((ash x m)))))
+             :otf-flg t))
+
+    (defthm unsigned-byte-p-of-ash
+      (implies (unsigned-byte-p (- n (ifix m)) x)
+               (equal (unsigned-byte-p n (ash x m))
+                      (natp n)))
+      :hints(("Goal"
+              :in-theory (disable unsigned-byte-p)
+              :cases ((natp n))))))
+
+  (encapsulate
+    ()
+    (local (defun my-induct (n x y)
+             (if (zp n)
+                 (list n x y)
+               (my-induct (- n 1) (logcdr x) (logcdr y)))))
+
+    (defthm unsigned-byte-p-of-logxor
+      (implies (and (unsigned-byte-p n x)
+                    (unsigned-byte-p n y))
+               (unsigned-byte-p n (logxor x y)))
+      :hints(("Goal"
+              :induct (my-induct n x y)
+              :in-theory (enable acl2::logxor**
+                                 acl2::unsigned-byte-p**))))))
+
+
 (defsection logsquash**
 
   ;; Squashes to 0 the lowest N bits of I.
@@ -2193,8 +2384,6 @@
                     :pattern (logsquash size i)
                     :scheme (logbitp-ind size i))))
 
-
-
   (add-to-ruleset ihsext-inductions '(logsquash-induct))
 
   (defthm logsquash-of-n-0
@@ -2379,205 +2568,25 @@
 
   (defthm logsquash-<-0
     (equal (< (logsquash n x) 0)
-           (< (ifix x) 0))))
+           (< (ifix x) 0)))
 
-
-
-
-(defsection expt
-
-  (defthmd expt-2-is-ash
-    (implies (natp n)
-             (equal (expt 2 n)
-                    (ash 1 n)))
-    :hints(("Goal" :in-theory (enable ash floor))))
-
-  (defthm expt-of-ifix
-    (equal (expt r (ifix i))
-           (expt r i))
-    :hints(("Goal" :in-theory (enable expt))))
-
-  (add-to-ruleset ihsext-arithmetic '(expt-2-is-ash))
-  (add-to-ruleset ihsext-basic-thms expt-of-ifix))
-
-
-(defsection unsigned-byte-p**
-
-  (local (in-theory (enable* ihsext-recursive-redefs
-                             ihsext-inductions)))
-
-  (local (in-theory (enable expt-2-is-ash)))
-
-
-  (defthm unsigned-byte-p-of-n-0
-    (equal (unsigned-byte-p n 0)
-           (natp n)))
-
-  (defthm unsigned-byte-p-of-0-x
-    (equal (unsigned-byte-p 0 x)
-           (equal x 0)))
-
-  (defthmd unsigned-byte-p**
-    (equal (unsigned-byte-p bits x)
-           (and (integerp x)
-                (natp bits)
-                (if (zp bits)
-                    (equal x 0)
-                  (unsigned-byte-p (1- bits)
-                                   (logcdr x)))))
-    :rule-classes ((:definition
-                    :clique (unsigned-byte-p)
-                    :controller-alist ((unsigned-byte-p t t)))))
-
-  (local (in-theory (enable unsigned-byte-p**)))
-  (local (in-theory (disable unsigned-byte-p)))
-
-  (add-to-ruleset ihsext-recursive-redefs '(unsigned-byte-p**))
-
-
-  (defun unsigned-byte-p-ind (bits x)
-    (and (integerp x)
-         (natp bits)
-         (if (zp bits)
-             (equal x 0)
-           (unsigned-byte-p-ind (1- bits) (logcdr x)))))
-
-  (defthm unsigned-byte-p-induct
-    t
-    :rule-classes ((:induction
-                    :pattern (unsigned-byte-p bits x)
-                    :scheme (unsigned-byte-p-ind bits x))))
-
-  (defthmd unsigned-byte-p-incr
-    (implies (and (unsigned-byte-p a x)
-                  (natp b)
-                  (<= a b))
-             (unsigned-byte-p b x)))
-
-  (local (in-theory (enable unsigned-byte-p-incr)))
-
-  (defthmd unsigned-byte-p-logcons
-    (implies (and (unsigned-byte-p (1- b) x)
-                  (natp b))
-             (unsigned-byte-p b (logcons bit x)))
-    :hints (("goal" :expand ((unsigned-byte-p b (logcons bit x))))))
-
-  (defthmd unsigned-byte-p-logcons-free
-    (implies (and (unsigned-byte-p a x)
-                  (natp b)
-                  (<= a (1- b)))
-             (unsigned-byte-p b (logcons bit x)))
-    :hints (("goal" :expand ((unsigned-byte-p b (logcons bit x))))))
-
-  (defthmd unsigned-byte-p-logcdr
-    (implies (and (unsigned-byte-p a x)
-                  (natp b)
-                  (<= a (1+ b)))
-             (unsigned-byte-p b (logcdr x))))
-
-  (add-to-ruleset ihsext-bounds-thms '(unsigned-byte-p-incr
-                                       unsigned-byte-p-logcons
-                                       unsigned-byte-p-logcons-free
-                                       unsigned-byte-p-logcdr))
-
-  (local (in-theory (disable unsigned-byte-p-logand
-                             unsigned-byte-p-logior
-                             logior-=-0)))
-
-  (defthmd unsigned-byte-p-logand-fix
-    (implies (or (unsigned-byte-p b x)
-                 (unsigned-byte-p b y))
-             (unsigned-byte-p b (logand x y))))
-
-  (defun unsigned-byte-p-logior-ind (b x y)
-    (cond ((zp b) (list x y))
-          (t (unsigned-byte-p-logior-ind
-              (1- b) (logcdr x) (logcdr y)))))
-
-  (defthmd unsigned-byte-p-logior-fix
-    (equal (unsigned-byte-p b (logior x y))
-           (and (unsigned-byte-p b (ifix x))
-                (unsigned-byte-p b (ifix y))))
-    :hints (("goal" :induct (unsigned-byte-p-logior-ind b x y))))
-
-  (add-to-ruleset ihsext-basic-thms '(unsigned-byte-p-logand-fix
-                                      unsigned-byte-p-logior-fix))
-
-  (defthm unsigned-byte-p-of-loghead
-    (implies (and (integerp size1)
-                  (<= (nfix size) size1))
-             (unsigned-byte-p size1 (loghead size i))))
+  (defthm logsquash-cancel
+    (implies (unsigned-byte-p n x)
+             (equal (logsquash n x) 0))
+    :hints(("Goal" :in-theory (disable unsigned-byte-p))))
 
   (defthm unsigned-byte-p-of-logsquash
     (implies (and (unsigned-byte-p size1 i)
                   (<= (nfix size) (nfix size1)))
-             (unsigned-byte-p size1 (logsquash size i))))
-
-  (defthm unsigned-byte-p-of-logtail
-    (implies (natp size1)
-             (equal (unsigned-byte-p size1 (logtail size i))
-                    (unsigned-byte-p (+ size1 (nfix size)) (ifix i))))
-    :hints (("goal" :induct (and (logtail size i)
-                                 (logtail size1 i)))))
-
-  (defthm unsigned-byte-p-when-unsigned-byte-p-less
-    (implies (and (unsigned-byte-p n x)
-                  (natp m)
-                  (<= n m))
-             (unsigned-byte-p m x)))
-
-  (encapsulate
-    nil
-    (local (defun ind (n m x)
-             (cond ((zip m) (list n x))
-                   ((< m 0) (ind (1+ n) (1+ m) x))
-                   (t (ind (1- n) (1- m) x)))))
-
-    (local (defthm help1
-             (implies (unsigned-byte-p n x)
-                      (natp n))))
-
-
-    (local (defthm unsigned-byte-p-of-ash-worse
-             ;; "worse" because of the natp hyp, which we'll eliminate in a moment
-             (implies (and (unsigned-byte-p (- n (ifix m)) x)
-                           (natp n))
-                      (unsigned-byte-p n (ash x m)))
-             :hints(("Goal" :in-theory (e/d* (acl2::ihsext-recursive-redefs
-                                              acl2::ihsext-inductions
-                                              nfix ifix zip)
-                                             (unsigned-byte-p))
-                     :induct (ind n m x)
-                     :do-not-induct t)
-                    (and stable-under-simplificationp
-                         '(:expand ((ash x m)))))
-             :otf-flg t))
-
-    (defthm unsigned-byte-p-of-ash
-      (implies (unsigned-byte-p (- n (ifix m)) x)
-               (equal (unsigned-byte-p n (ash x m))
-                      (natp n)))
-      :hints(("Goal"
-              :in-theory (disable unsigned-byte-p)
-              :cases ((natp n))))))
-
-  (encapsulate
-    ()
-    (local (defun my-induct (n x y)
-             (if (zp n)
-                 (list n x y)
-               (my-induct (- n 1) (logcdr x) (logcdr y)))))
-
-    (defthm unsigned-byte-p-of-logxor
-      (implies (and (unsigned-byte-p n x)
-                    (unsigned-byte-p n y))
-               (unsigned-byte-p n (logxor x y)))
-      :hints(("Goal"
-              :induct (my-induct n x y)
-              :in-theory (enable acl2::logxor**
-                                 acl2::unsigned-byte-p**))))))
-
+             (unsigned-byte-p size1 (logsquash size i)))
+    :hints(("Goal" :in-theory (disable unsigned-byte-p))))
 
+  (defthm logsquash-of-ash-greater
+    (implies (<= (nfix n) (ifix i))
+             (equal (logsquash n (ash x i))
+                    (ash x i)))
+    :hints (("goal" :induct (and (logsquash n b)
+                                 (logsquash i b))))))
 
 
 (defsection signed-byte-p**
@@ -2906,8 +2915,8 @@
   (add-to-ruleset ihsext-basic-thms '(unsigned-byte-p-of-logapp
                                       signed-byte-p-of-logapp))
 
-  (defthm logapp-zeros
-    (equal (logapp i 0 0) 0))
+  ;; (defthm logapp-zeros
+  ;;   (equal (logapp i 0 0) 0))
 
   (defthm logapp-minus1s
     (equal (logapp i -1 -1) -1)))
diff -Nru acl2-6.2/books/centaur/bitops/rotate.acl2 acl2-6.3/books/centaur/bitops/rotate.acl2
--- acl2-6.2/books/centaur/bitops/rotate.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/rotate.acl2	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,26 @@
+; Centaur Bitops Library
+; Copyright (C) 2010-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "std/osets/portcullis" :dir :system)
+(include-book "cutil/portcullis" :dir :system)
+(include-book "centaur/gl/portcullis" :dir :system)
+; cert-flags: ? t :ttags :all
+(certify-book "rotate" ? t :ttags :all)
diff -Nru acl2-6.2/books/centaur/bitops/rotate.lisp acl2-6.3/books/centaur/bitops/rotate.lisp
--- acl2-6.2/books/centaur/bitops/rotate.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/rotate.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -23,6 +23,7 @@
 (include-book "tools/bstar" :dir :system)
 (include-book "ihs/logops-definitions" :dir :system)
 (include-book "centaur/misc/arith-equivs" :dir :system)
+(include-book "centaur/gl/gl-mbe" :dir :system)
 (local (include-book "ihsext-basics"))
 (local (include-book "arithmetic/top-with-meta" :dir :system))
 (local (include-book "equal-by-logbitp"))
@@ -37,6 +38,20 @@
                 0)
          :hints(("Goal" :in-theory (enable mod floor)))))
 
+(local (defthm rem-is-mod
+         ;; (let ((places 20)
+         ;;       (width 4))
+         ;;   ;; REM finishes in 2.4 seconds, MOD in 2.8 seconds...
+         ;;   (time (loop for i fixnum from 1 to 100000000 do
+         ;;               (mod places width)))
+         ;;   (time (loop for i fixnum from 1 to 100000000 do
+         ;;               (rem places width))))
+         (implies (and (natp places)
+                       (posp width))
+                  (equal (rem places width)
+                         (mod places width)))
+         :hints(("Goal" :in-theory (enable mod rem)))))
+
 
 (defsection rotate-left
 
@@ -57,8 +72,24 @@
 
     (let* ((width      (lnfix width))
            (places     (lnfix places))
-           (x          (logand x (1- (ash 1 width)))) ; chop x down to size
-           (places     (mod places width))            ; e.g., 20 places --> 4 places
+           (wmask      (1- (ash 1 width)))
+           (x          (logand x wmask))              ; chop x down to size
+           (places     (mbe :logic (mod places width) ; e.g., 20 places --> 4 places
+                            :exec
+                            ;; REM is slightly cheaper than MOD, but in many
+                            ;; cases we can probably avoid REM entirely because
+                            ;; usually we'll be rotating by some amount less
+                            ;; than the width...
+                            (if (< places width)
+                                places
+                              (rem places width))))
+           (places     (gl::gl-mbe places ;; logically this is a no-op
+                                   ;; ensure that GL knows places is short
+                                   (logand places (lognot (ash -1
+                                                               (integer-length
+                                                                width))))
+                                   ;; debugging if this check failes
+                                   (list places width)))
            (low-num    (- width places))              ; e.g., 12
            (mask       (1- (ash 1 low-num)))          ; e.g., 0000_1111_1111_1111
            (xl         (logand x mask))               ; e.g., 0000_BBBB_CCCC_DDDD
@@ -302,9 +333,18 @@
                                    logbitp-of-rotate-left-split)))))))
 
 
-
 (defsection rotate-right
 
+  (local (defthm loghead-removal-backwards
+           ;; BOZO should really fix loghead's definition instead...
+           (implies (natp width)
+                    (equal (logand x (+ -1 (ash 1 width)))
+                           (loghead width x)))
+           :hints((equal-by-logbitp-hint)
+                  (and stable-under-simplificationp
+                       '(:in-theory (enable b-and bool->bit
+                                            logbitp-of-loghead-split))))))
+
   (defund rotate-right (x width places)
     "Rotate X, a vector of some WIDTH, by PLACES places to the right.
 
@@ -315,14 +355,19 @@
     (declare (xargs :guard (and (integerp x)
                                 (posp width)
                                 (natp places))))
-
     ;; Running example to help understand the code: suppose X is some 16-bit
     ;; number, say 16'b AAAA_BBBB_CCCC_DDDD, so the width is 16, and suppose we
     ;; want to rotate by 20 places.
     (let* ((width      (lnfix width))
-           (x          (loghead width x))
+           (x          (mbe :logic (loghead width x)
+                            :exec (logand x (+ -1 (ash 1 width)))))
            (places     (lnfix places))
-           (places     (mod places width))          ; e.g., 20 places --> 4 places
+           (places     (mbe :logic (mod places width) ; e.g., 20 places --> 4 places
+                            :exec
+                            ;; As in rotate-left
+                            (if (< places width)
+                                places
+                              (rem places width))))
            (mask       (1- (ash 1 places)))         ; e.g., 0000_0000_0000_1111
            (xl         (logand x mask))             ; e.g., 0000_0000_0000_DDDD
            (xh-shift   (ash x (- places)))          ; e.g., 0000_AAAA_BBBB_CCCC
diff -Nru acl2-6.2/books/centaur/bitops/sbitsets.lisp acl2-6.3/books/centaur/bitops/sbitsets.lisp
--- acl2-6.2/books/centaur/bitops/sbitsets.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/sbitsets.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -39,7 +39,7 @@
 
   :long "<h3>Introduction</h3>
 
-<p>In the ordinary @(see bitset) library, sets of natural numbers are encoded
+<p>In the ordinary @(see bitsets) library, sets of natural numbers are encoded
 as bignums.  This is perfectly fine when the set elements are relatively small,
 but it is not an efficient way to deal with sets of large numbers.  For
 instance, trying to insert a number like 2^30 into an ordinary bitset will
@@ -110,7 +110,7 @@
 <p>The sbitsets library can be loaded with:</p>
 
 @({
-  (include-book \"bitops/sbitsets\" :dir :cbooks)
+  (include-book \"centaur/bitops/sbitsets\" :dir :system)
 })
 
 <p>Valid sparse bitsets are recognized by @(see sbitsetp), and there is a
@@ -548,7 +548,7 @@
 (defsection sbitset-pair-members
   :parents (sbitset-members)
   :short "@(call sbitset-pair-members) extracts the members of a single @(see
-sbitset-pair)."
+sbitset-pairp)."
 
   :long "<p>For instance, if the pair is @('(0 . 7)'), we produce the set
 @('{0, 1, 2}'); if the set is @('(1 . 7)'), we produce @('{60, 61, 62}').</p>
@@ -607,7 +607,7 @@
                   (syntaxp (term-order y x)))
              (equal (sbitset-pair-offset x)
                     (sbitset-pair-offset y)))
-    :hints((witness)))
+    :hints((set-reasoning)))
 
   (defthm consp-of-sbitset-pair-members
     (implies (force (sbitset-pairp x))
diff -Nru acl2-6.2/books/centaur/bitops/signed-byte-p.lisp acl2-6.3/books/centaur/bitops/signed-byte-p.lisp
--- acl2-6.2/books/centaur/bitops/signed-byte-p.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/signed-byte-p.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -823,3 +823,189 @@
   :hints(("Goal" :in-theory (enable lognot
                                     unsigned-byte-p
                                     signed-byte-p))))
+
+(defthm basic-signed-byte-p-of-1+lognot
+  (implies (unsigned-byte-p n x)
+           (signed-byte-p (+ 1 n) (+ 1 (lognot x))))
+  :hints(("Goal" :in-theory (enable lognot
+                                    unsigned-byte-p
+                                    signed-byte-p))))
+
+(defthm signed-byte-p-of-decrement-when-natural-signed-byte-p
+  (implies (and (signed-byte-p n x)
+                (<= 0 x))
+           (signed-byte-p n (1- x)))
+  :hints(("Goal" :in-theory (enable signed-byte-p))))
+
+(defthm signed-byte-p-when-signed-byte-p-smaller
+  (implies (and (signed-byte-p size1 x)
+                (<= size1 (nfix size2)))
+           (signed-byte-p size2 x))
+   :hints(("Goal" :in-theory (enable signed-byte-p))))
+
+
+(encapsulate
+  ()
+  (local (defun my-induct (size1 size2 x)
+           (if (or (zp size1)
+                   (zp size2))
+               (list size1 size2 x)
+             (my-induct (- size1 1)
+                        (- size2 1)
+                        (logcdr x)))))
+
+  (defthm signed-byte-p-when-unsigned-byte-p-smaller
+    (implies (and (unsigned-byte-p size1 x)
+                  (< size1 (nfix size2)))
+             (signed-byte-p size2 x))
+    :hints(("Goal"
+            :induct (my-induct size1 size2 x)
+            :in-theory (enable* ihsext-recursive-redefs
+                                ihsext-inductions)))))
+
+
+(defsection signed-byte-p-of-ash-split
+
+  (local (in-theory (enable* arith-equiv-forwarding)))
+
+  (local (defun dec-induct (n)
+           (if (zp n)
+               nil
+             (dec-induct (- n 1)))))
+
+  (local (defthm k0
+           (implies (and (signed-byte-p width x)
+                         (natp n))
+                    (signed-byte-p (+ width n) (ash x n)))
+           :hints(("Goal"
+                   :induct (dec-induct n)
+                   :in-theory (enable* ihsext-recursive-redefs)))))
+
+  (local (defthm k0-better
+           (implies (and (signed-byte-p (- width n) x)
+                         (natp n))
+                    (signed-byte-p width (ash x n)))
+           :hints(("Goal"
+                   :in-theory (disable k0)
+                   :use ((:instance k0
+                                    (x x)
+                                    (n n)
+                                    (width (- width n))))))))
+
+  (local (defthm k1
+           (implies (and (signed-byte-p (+ width n) (ash x n))
+                         (natp n))
+                    (equal (signed-byte-p width x)
+                           (and (posp width)
+                                (integerp x))))
+           :hints(("Goal"
+                   :induct (dec-induct n)
+                   :in-theory (enable* ihsext-recursive-redefs)))))
+
+  (local (defthm k1-better
+           (implies (and (signed-byte-p width (ash x n))
+                         (natp n))
+                    (equal (signed-byte-p (- width n) x)
+                           (and (integerp x)
+                                (< n width))))
+           :hints(("Goal"
+                   :use ((:instance k1 (width (- width n))))))))
+
+  (local (defthm m1
+           (implies (not (integerp x))
+                    (equal (signed-byte-p width (ash x n))
+                           (posp width)))))
+
+  (local (defthm m2
+           (implies (not (integerp n))
+                    (equal (signed-byte-p width (ash x n))
+                           (signed-byte-p width (ifix x))))))
+
+  (local (defthm m3a
+           (implies (and (integerp x)
+                         (natp n)
+                         (< n width))
+                    (equal (signed-byte-p width (ash x n))
+                           (signed-byte-p (- width n) x)))
+           :hints(("Goal"
+                   :use ((:instance k0-better)
+                         (:instance k1-better))
+                   :do-not-induct t))))
+
+  (local (defthm m3b
+           (implies (and (integerp x)
+                         (integerp n)
+                         (< n 0)
+                         (posp width))
+                    (equal (signed-byte-p width (ash x n))
+                           (signed-byte-p (- width n) x)))
+           :hints(("Goal"
+                   :do-not-induct t
+                   :in-theory (disable signed-byte-p-of-logtail
+                                       right-shift-to-logtail)
+                   :use ((:instance signed-byte-p-of-logtail
+                                    (n (- n)))
+                         (:instance right-shift-to-logtail
+                                    (count n)
+                                    (i x)))))))
+
+  (local (defthm m3
+           (implies (and (integerp x)
+                         (integerp n)
+                         (< n width))
+                    (equal (signed-byte-p width (ash x n))
+                           (and (posp width)
+                                (signed-byte-p (- width n) x))))
+           :hints(("Goal" :use ((:instance m3a)
+                                (:instance m3b))))))
+
+  (local (defthm m4
+           (implies (and (integerp x)
+                         (natp n)
+                         (>= n width))
+                    (equal (signed-byte-p width (ash x n))
+                           (and (posp width)
+                                (equal x 0))))
+           :hints(("Goal"
+                   :induct (ash x n)
+                   :in-theory (enable* ihsext-recursive-redefs
+                                       ihsext-inductions)))))
+
+  (defthm signed-byte-p-of-ash-split
+    (equal (signed-byte-p width (ash x n))
+           (and (posp width)
+                (or (zip x)
+                    (if (zip n)
+                        (signed-byte-p width (ifix x))
+                      (signed-byte-p (- width n) x)))))
+    :hints(("Goal"
+            :do-not-induct t
+            :cases ((< n 0)
+                    (< n width))))))
+
+
+
+(defsection signed-byte-p-of-loghead
+
+  (local (defthm l0
+           (implies (and (natp n)
+                         (natp size)
+                         (< size n))
+                    (signed-byte-p n (loghead size x)))
+           :hints(("Goal"
+                   :do-not-induct t
+                   :in-theory (disable unsigned-byte-p-of-loghead
+                                       signed-byte-p-when-unsigned-byte-p-smaller)
+                   :use ((:instance unsigned-byte-p-of-loghead
+                                    (i x)
+                                    (size size)
+                                    (size1 size))
+                         (:instance signed-byte-p-when-unsigned-byte-p-smaller
+                                    (x (loghead size x))
+                                    (size1 size)
+                                    (size2 n)))))))
+
+  (defthm signed-byte-p-of-loghead
+    (implies (and (integerp m)
+                  (< (nfix size) m))
+             (signed-byte-p m (loghead size x)))))
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/bitops/top.lisp acl2-6.3/books/centaur/bitops/top.lisp
--- acl2-6.2/books/centaur/bitops/top.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bitops/top.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -31,7 +31,9 @@
 (include-book "extra-defs")
 
 (defxdoc bitops
-  :short "Centaur Bitops Library"
+  :parents (arithmetic)
+  :short "The Centaur Bitops Library is a successor to @(see ihs); it is a
+comprehensive library geared towards bit-vector arithmetic."
 
   :long "<p>We provide:</p>
 
@@ -54,20 +56,20 @@
 might try:</p>
 
 @({
- (local (include-book \"bitops/ihs-extensions\" :dir :cbooks))
- (local (include-book \"bitops/equal-by-logbitp\" :dir :cbooks))
+ (local (include-book \"centaur/bitops/ihs-extensions\" :dir :system))
+ (local (include-book \"centaur/bitops/equal-by-logbitp\" :dir :system))
 })
 
 <p>For the bitsets library:</p>
 
 @({
- (include-book \"bitops/bitsets\" :dir :cbooks)
+ (include-book \"centaur/bitops/bitsets\" :dir :system)
 })
 
 <p>Or for the sparse bitsets library:</p>
 
 @({
- (include-book \"bitops/sbitsets\" :dir :cbooks)
+ (include-book \"centaur/bitops/sbitsets\" :dir :system)
 })
 
 <h3>Copyright Information</h3>
diff -Nru acl2-6.2/books/centaur/bridge/bridge-raw.lsp acl2-6.3/books/centaur/bridge/bridge-raw.lsp
--- acl2-6.2/books/centaur/bridge/bridge-raw.lsp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/bridge/bridge-raw.lsp	2013-09-30 17:53:11.000000000 +0000
@@ -295,10 +295,6 @@
 
 ; Worker Threads --------------------------------------------------------------
 
-(defun json-encode (x)
-  (let ((acc (json-encode-main x nil)))
-    (nreverse (coerce acc 'string))))
-
 (defun worker-write-return (type ret-list stream)
   (case type
     (:lisp    (send-message "RETURN" (prin1-to-string (car ret-list)) stream))
diff -Nru acl2-6.2/books/centaur/bridge/package.lsp acl2-6.3/books/centaur/bridge/package.lsp
--- acl2-6.2/books/centaur/bridge/package.lsp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bridge/package.lsp	2013-09-30 17:53:11.000000000 +0000
@@ -26,8 +26,9 @@
     (union-equal acl2::*acl2-exports*
                  acl2::*common-lisp-symbols-from-main-lisp-package*)
     '(b* defsection defxdoc include-raw assert! definline definlined
+         define
          ;; to make Bridge::Bridge show up as just "Bridge" in the XDOC index
-         bridge))
+         explode implode bridge))
    '(include-book)))
 
 ; It's too frustrating NOT to have this be part of package.lsp
diff -Nru acl2-6.2/books/centaur/bridge/portcullis.acl2 acl2-6.3/books/centaur/bridge/portcullis.acl2
--- acl2-6.2/books/centaur/bridge/portcullis.acl2	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/bridge/portcullis.acl2	2013-09-30 17:53:11.000000000 +0000
@@ -22,8 +22,6 @@
 
 (ld "package.lsp")
 (ld "tools/flag-package.lsp" :dir :system)
-(ld "str/package.lsp" :dir :system)
-(ld "xdoc/package.lsp" :dir :system)
-
+(include-book "str/portcullis" :dir :system)
+(include-book "xdoc/portcullis" :dir :system)
 ; cert-flags: ? t :ttags :all
-(certify-book "portcullis" ? t :ttags :all)
diff -Nru acl2-6.2/books/centaur/bridge/to-json.lisp acl2-6.3/books/centaur/bridge/to-json.lisp
--- acl2-6.2/books/centaur/bridge/to-json.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/bridge/to-json.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -23,10 +23,10 @@
 (include-book "str/cat" :dir :system)
 (include-book "str/natstr" :dir :system)
 (include-book "std/misc/two-nats-measure" :dir :system)
-(local (include-book "std/misc/explode-atom" :dir :system))
+(local (include-book "str/explode-atom" :dir :system))
 (local (include-book "centaur/bitops/ihsext-basics" :dir :system))
 (local (include-book "misc/assert" :dir :system))
-
+(local (include-book "std/typed-lists/character-listp" :dir :system))
 
 (defsection json-encoding
   :parents (bridge)
@@ -216,9 +216,9 @@
              (character-listp (json-encode-weird-char x acc))))
 
   (local (defun test (x)
-           (let* ((acc (reverse (coerce "abc " 'list)))
+           (let* ((acc (reverse (explode "abc ")))
                   (acc (json-encode-weird-char x acc)))
-             (reverse (coerce acc 'string)))))
+             (str::rchars-to-string acc))))
 
   (local
    (progn
@@ -315,16 +315,16 @@
                   (<= n xl)
                   (eql xl (length x)))
              (equal (json-encode-str-aux x n xl acc)
-                    (json-encode-chars (nthcdr n (coerce x 'list)) acc)))
+                    (json-encode-chars (nthcdr n (explode x)) acc)))
     :hints(("Goal"
             :in-theory (enable json-encode-str-aux
                                json-encode-chars)
             :induct (json-encode-str-aux x n xl acc)
-            :expand (json-encode-chars (nthcdr n (coerce x 'list)) acc))))
+            :expand (json-encode-chars (nthcdr n (explode x)) acc))))
 
   (definline json-encode-str (x acc)
     (declare (type string x))
-    (mbe :logic (json-encode-chars (coerce x 'list) acc)
+    (mbe :logic (json-encode-chars (explode x) acc)
          :exec (json-encode-str-aux x 0 (length x) acc))))
 
 
@@ -363,9 +363,9 @@
              (character-listp (json-encode-atom x acc))))
 
   (local (defun test (x)
-           (let* ((acc (reverse (coerce "abc " 'list)))
+           (let* ((acc (reverse (explode "abc ")))
                   (acc (json-encode-atom x acc)))
-             (reverse (coerce acc 'string)))))
+             (str::rchars-to-string acc))))
 
   (local
    (progn
@@ -475,10 +475,10 @@
            (string-append-lst (str::strtok x '(#\Newline)))))
 
   (local (defun test (x)
-           (let* ((acc (reverse (coerce "abc " 'list)))
+           (let* ((acc (reverse (explode "abc ")))
                   (acc (json-encode-main x acc)))
              (collapse-newlines
-              (reverse (coerce acc 'string))))))
+              (str::rchars-to-string acc)))))
 
   ;; Same atom tests as above
   (local
@@ -590,9 +590,9 @@
 getting the characters into the right order.</p>"
 
   (defund json-encode (x)
-    "Gets nreverse optimization in bridge-raw.lsp"
+    (declare (xargs :guard t))
     (let ((acc (json-encode-main x nil)))
-      (reverse (coerce acc 'string))))
+      (str::rchars-to-string acc)))
 
   (local (in-theory (enable json-encode)))
 
diff -Nru acl2-6.2/books/centaur/bridge/top.lisp acl2-6.3/books/centaur/bridge/top.lisp
--- acl2-6.2/books/centaur/bridge/top.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/bridge/top.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -26,6 +26,7 @@
 ; (depends-on "bridge-raw.lsp")
 
 (defxdoc bridge
+  :parents (acl2::interfacing-tools)
   :short "Connects ACL2 and the outside world."
 
   :long "<p>The ACL2 Bridge is a general mechanism for allowing other
diff -Nru acl2-6.2/books/centaur/ccl-config.lsp acl2-6.3/books/centaur/ccl-config.lsp
--- acl2-6.2/books/centaur/ccl-config.lsp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/ccl-config.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -51,10 +51,17 @@
 ; These stack sizes apply to the first (initial) Lisp listener thread, where
 ; the bulk of ACL2 computations take place.
 
+; WARNING: This setting of stack size values only takes effect after starting a
+; new Lisp process.  The typical ACL2 procedure is to save an executable using
+; save-exec after doing these assignments, which will then take effect when you
+; invoke the new executable.
+
 (let ((stack-size (if (< most-positive-fixnum (expt 2 34))
                       (expt 2 23)
                     (expt 2 28))))
 
+; See WARNING above.
+
   (setq *initial-listener-default-control-stack-size* stack-size)
   (setq *initial-listener-default-value-stack-size*   stack-size)
 
diff -Nru acl2-6.2/books/centaur/clex/arithmetic.lisp acl2-6.3/books/centaur/clex/arithmetic.lisp
--- acl2-6.2/books/centaur/clex/arithmetic.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/clex/arithmetic.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -29,6 +29,7 @@
                     update-nth
                     ;; These can interfere with stobj stuff
                     nth-0-cons
+                    nth-when-zp
                     nth-add1))
 
 (local (in-theory (enable nthcdr len nth)))
@@ -53,10 +54,11 @@
            (equal (nth n x)
                   nil)))
 
-(defrule nth-of-nthcdr
-  (equal (nth a (nthcdr b x))
-         (nth (+ (nfix a) (nfix b)) x))
-  :disable (acl2::nthcdr-of-cdr))
+;; now part of std/lists
+;; (defrule nth-of-nthcdr
+;;   (equal (nth a (nthcdr b x))
+;;          (nth (+ (nfix a) (nfix b)) x))
+;;   :disable (acl2::nthcdr-of-cdr))
 
 (defrule nthcdr-under-iff-when-true-listp
   (implies (true-listp x)
diff -Nru acl2-6.2/books/centaur/clex/charset.lisp acl2-6.3/books/centaur/clex/charset.lisp
--- acl2-6.2/books/centaur/clex/charset.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/clex/charset.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -42,8 +42,7 @@
 <p>To introduce new sets of characters, e.g., to recognize \"whitespace
 characters,\" or \"hex digits,\" or whatever, we use the @(see defcharset)
 macro.  After defining suitable character sets, functions like @(see
-read-while-in-charset) and @(see read-until-in-charset) become quite
-useful.</p>
+sin-match-charset*) become quite useful.</p>
 
 <p>We generally treat character sets as opaque.  It would be quite odd to,
 e.g., allow the theorem prover to expand a character set's definition into its
@@ -310,7 +309,7 @@
            :hints(("Goal"
                    :in-theory (enable code-in-charset-p)
                    :use ((:instance defcharset-lemma2
-                                    (i (char-code x))))))))
+                                    (i (char-code ,x))))))))
 
        (deflist ,foo-charlist-p (,x)
          (,foo-char-p ,x)
diff -Nru acl2-6.2/books/centaur/clex/example.lisp acl2-6.3/books/centaur/clex/example.lisp
--- acl2-6.2/books/centaur/clex/example.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/clex/example.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -162,7 +162,7 @@
   (defthm lex-whitespace-reconstruction
     (b* (((mv tok new-sin) (lex-whitespace sin)))
       (implies tok
-               (equal (append (coerce (token->text tok) 'list)
+               (equal (append (explode (token->text tok))
                               (strin-left new-sin))
                       (strin-left sin))))))
 
@@ -190,7 +190,7 @@
   (defthm lex-punctuation-reconstruction
     (b* (((mv tok new-sin) (lex-punctuation sin)))
       (implies tok
-               (equal (append (coerce (token->text tok) 'list)
+               (equal (append (explode (token->text tok))
                               (strin-left new-sin))
                       (strin-left sin))))))
 
@@ -231,7 +231,7 @@
   (defthm lex-id/keyword-reconstruction
     (b* (((mv tok new-sin) (lex-id/keyword sin)))
       (implies tok
-               (equal (append (coerce (token->text tok) 'list)
+               (equal (append (explode (token->text tok))
                               (strin-left new-sin))
                       (strin-left sin))))))
 
@@ -241,7 +241,7 @@
   :parents (example-lexer)
   :short "A string with just the newline character."
   (defmacro newline-string ()
-    (coerce (list #\Newline) 'string)))
+    (implode (list #\Newline))))
 
 (define lex-comment
   :parents (example-lexer)
@@ -269,7 +269,7 @@
   (defthm lex-comment-reconstruction
     (b* (((mv tok new-sin) (lex-comment sin)))
       (implies tok
-               (equal (append (coerce (token->text tok) 'list)
+               (equal (append (explode (token->text tok))
                               (strin-left new-sin))
                       (strin-left sin))))))
 
@@ -305,7 +305,7 @@
   (defthm lex1-reconstruction
     (b* (((mv tok new-sin) (lex1 sin)))
       (implies tok
-               (equal (append (coerce (token->text tok) 'list)
+               (equal (append (explode (token->text tok))
                               (strin-left new-sin))
                       (strin-left sin))))))
 
@@ -364,7 +364,7 @@
     (b* (((mv okp tokens ?new-sin) (lex* sin)))
       (implies okp
                (equal (tokenlist-all-text tokens)
-                      (coerce (strin-left sin) 'string))))))
+                      (implode (strin-left sin)))))))
 
 
 (define lex-main
@@ -399,7 +399,7 @@
     (b* (((mv errmsg tokens ?new-sin) (lex-main sin)))
       (implies (not errmsg)
                (equal (tokenlist-all-text tokens)
-                      (coerce (strin-left sin) 'string))))))
+                      (implode (strin-left sin)))))))
 
 
 (define lex-string
diff -Nru acl2-6.2/books/centaur/clex/matchers.lisp acl2-6.3/books/centaur/clex/matchers.lisp
--- acl2-6.2/books/centaur/clex/matchers.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/clex/matchers.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -126,8 +126,8 @@
          (defthm ,(intern-in-package-of-symbol (cat "NON-EMPTY-OF-" name-s ".MATCH")
                                                name)
            (b* (((mv . ,return-names) (,name . ,formals)))
-             (equal (consp (coerce match 'list))
-                    (if match t nil))))
+             (equal (equal match "")
+                    nil)))
 
          (defthm ,(intern-in-package-of-symbol (cat name-s "-PROGRESS-WEAK")
                                                name)
@@ -150,7 +150,7 @@
              ;; This very nicely takes advantage of the fact that (COERCE NIL
              ;; 'LIST) happens to be NIL, so we don't even need to check for a
              ;; match.
-             (equal (append (coerce match 'list) (strin-left new-sin))
+             (equal (append (explode match) (strin-left new-sin))
                     (strin-left sin))))
 
          (defthm ,(intern-in-package-of-symbol (cat name-s "-GRACEFUL-FAILURE")
@@ -227,7 +227,7 @@
 
   (defthm non-empty-of-sin-match-everything.match
     (b* (((mv ?match ?new-sin) (sin-match-everything sin)))
-      (iff (consp (coerce match 'list))
+      (iff (consp (explode match))
            (consp (strin-left sin)))))
 
   (defthm sin-match-everything-progress
@@ -237,7 +237,7 @@
 
   (defthm sin-match-everything-reconstruction
     (b* (((mv match new-sin) (sin-match-everything sin)))
-      (equal (append (coerce match 'list) (strin-left new-sin))
+      (equal (append (explode match) (strin-left new-sin))
              (strin-left sin)))))
 
 
@@ -314,7 +314,7 @@
       (equal (equal match lit)
              (if match
                  (and (stringp lit)
-                      (consp (coerce lit 'list)))
+                      (consp (explode lit)))
                (not lit))))))
 
 
@@ -371,7 +371,8 @@
     (b* (((mv match ?new-sin) (sin-match-some-lit lits sin)))
       (implies match
                (member match lits)))
-    :hints(("Goal" :in-theory (enable sin-match-lit.match-when-ok)))))
+    :hints(("Goal" :in-theory (enable sin-match-lit.match-when-ok
+                                      member)))))
 
 
 
@@ -418,7 +419,7 @@
     ;; checking whether the match is one thing or another.
     (b* (((mv ?match ?new-sin)
           (sin-match-charset* set sin)))
-      (implies (equal chars (coerce match 'list))
+      (implies (equal chars (explode match))
                (equal (append chars (strin-left new-sin))
                       (strin-left sin)))))
 
@@ -434,7 +435,7 @@
   (defthm chars-in-charset-p-of-sin-match-charset*.match
     (b* (((mv ?match ?new-sin) (sin-match-charset* set sin)))
       ;; Nicely abusing that NIL coerces to NIL...
-      (chars-in-charset-p (coerce match 'list) set))))
+      (chars-in-charset-p (explode match) set))))
 
 
 
diff -Nru acl2-6.2/books/centaur/clex/package.lsp acl2-6.3/books/centaur/clex/package.lsp
--- acl2-6.2/books/centaur/clex/package.lsp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/clex/package.lsp	2013-09-30 17:53:11.000000000 +0000
@@ -20,8 +20,8 @@
 
 (in-package "ACL2")
 
-(ld "cutil/package.lsp" :dir :system)
-(ld "str/package.lsp" :dir :system)
+(include-book "cutil/portcullis" :dir :system)
+(include-book "str/portcullis" :dir :system)
 
 (defpkg "CLEX"
   (set-difference-eq
@@ -39,7 +39,8 @@
                defxdoc defsection definline definlined
                defabsstobj-events
                unsigned-byte-p signed-byte-p
-               cutil::deflist
+               unsigned-byte-listp
+               explode implode
                str::cat str::natstr
                nat-equiv int-equiv))
    '(number-char-p digit-char-p sin)))
diff -Nru acl2-6.2/books/centaur/clex/sin.lisp acl2-6.3/books/centaur/clex/sin.lisp
--- acl2-6.2/books/centaur/clex/sin.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/clex/sin.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -26,7 +26,7 @@
 
 (defxdoc sin
   :parents (clex)
-  :short "Abstract @(see stobj) for a string input stream."
+  :short "Abstract @(see acl2::stobj) for a string input stream."
 
   :long "<p>The @('sin') (\"string input\") stobj allows you to efficiently,
 easily process strings in a stream-like, sequential fashion, while remembering
@@ -50,7 +50,7 @@
 
 (defsection sin$c
   :parents (sin)
-  :short "Concrete string input stream @(see stobj)."
+  :short "Concrete string input stream @(see acl2::stobj)."
 
   :long "<p>In the implementation, we take care to ensure that all indices
 satisfy @('(unsigned-byte-p 60)'), making them fixnums on Lisps such as CCL and
diff -Nru acl2-6.2/books/centaur/clex/top.lisp acl2-6.3/books/centaur/clex/top.lisp
--- acl2-6.2/books/centaur/clex/top.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/clex/top.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -24,17 +24,18 @@
 (include-book "str/natstr" :dir :system)
 
 (defsection clex
+  :parents (acl2::interfacing-tools)
   :short "<b>C</b>entaur <b>Lex</b>er Library."
 
   :long "<p>This is a rudimentary library for creating lexers for character
 data in ACL2.  It is an outgrowth and revision of lexer support routines that
-were originally developed as part of the @(see vl) library.</p>
+were originally developed as part of the @(see vl::vl) library.</p>
 
-<p>These routines are based on ACL2 @(see characters).  They are, accordingly,
-suitable for processing text in ASCII or ISO-8859-1 or some other 8-bit
-character set, but <b>not Unicode</b> or other wide character sets.  It would
-generally be a bad idea to use CLEX to write a lexer for a language like Java
-or XML that needs Unicode support.</p>
+<p>These routines are based on ACL2 @(see acl2::characters).  They are,
+accordingly, suitable for processing text in ASCII or ISO-8859-1 or some other
+8-bit character set, but <b>not Unicode</b> or other wide character sets.  It
+would generally be a bad idea to use CLEX to write a lexer for a language like
+Java or XML that needs Unicode support.</p>
 
 <p>Many lexical analyzers like <a href='http://flex.sourceforge.net/'>Flex</a>
 are rather sophisticated and allow you to declare the syntax of your tokens at
@@ -47,8 +48,8 @@
 
 <ul>
 
-<li>A <see topic='sin'>stream input</see> mechanism that is somewhat efficient
-and conveniently tracks your position (for good error messages).</li>
+<li>A <see topic='@(url sin)'>stream input</see> mechanism that is somewhat
+efficient and conveniently tracks your position (for good error messages).</li>
 
 <li>A @(see defcharset) macro for describing basic character types (e.g.,
 whitespace, digits, letters, etc).</li>
diff -Nru acl2-6.2/books/centaur/defrstobj/defrstobj.lisp acl2-6.3/books/centaur/defrstobj/defrstobj.lisp
--- acl2-6.2/books/centaur/defrstobj/defrstobj.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/defrstobj/defrstobj.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -32,10 +32,6 @@
 (include-book "array-lemmas")
 ||#
 
-(make-event
- (let ((array-lemmas (extend-pathname (cbd) "array-lemmas" state)))
-   `(defconst *array-lemmas-book* ',array-lemmas)))
-
 
 (defun-nx non-executable-nth (n x)
   ;; Used in good-stp below, to get around stobj restrictions
@@ -898,7 +894,7 @@
          (logic)
          (set-inhibit-warnings "non-rec" "disable" "subsume") ;; implicitly local
          (local (set-default-hints nil))
-         (local (include-book ,*array-lemmas-book*))
+         (local (include-book "centaur/defrstobj/array-lemmas" :dir :system))
          (local (in-theory
                  (union-theories
                   (union-theories (theory 'minimal-theory)
diff -Nru acl2-6.2/books/centaur/defrstobj/groundwork/array-rec.lisp acl2-6.3/books/centaur/defrstobj/groundwork/array-rec.lisp
--- acl2-6.2/books/centaur/defrstobj/groundwork/array-rec.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/defrstobj/groundwork/array-rec.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -21,7 +21,7 @@
 (in-package "ACL2")
 (include-book "misc/records" :dir :system)
 (local (include-book "misc/equal-by-g" :dir :system))
-(local (include-book "centaur/misc/equal-by-nths" :dir :system))
+(local (include-book "std/lists/nth" :dir :system))
 (local (include-book "local"))
 
 
diff -Nru acl2-6.2/books/centaur/defrstobj/typed-records.lisp acl2-6.3/books/centaur/defrstobj/typed-records.lisp
--- acl2-6.2/books/centaur/defrstobj/typed-records.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/defrstobj/typed-records.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -22,7 +22,7 @@
 (include-book "misc/total-order" :dir :system)
 (include-book "std/lists/mfc-utils" :dir :system)
 (include-book "centaur/misc/introduce-var" :dir :system)
-(local (include-book "centaur/misc/equal-by-nths" :dir :system))
+(local (include-book "std/lists/nth" :dir :system))
 (local (include-book "array-lemmas"))
 (set-verify-guards-eagerness 2)
 
diff -Nru acl2-6.2/books/centaur/doc.acl2 acl2-6.3/books/centaur/doc.acl2
--- acl2-6.2/books/centaur/doc.acl2	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/doc.acl2	2013-09-30 17:53:15.000000000 +0000
@@ -23,4 +23,6 @@
 (ld "vl/package.lsp")
 (ld "gl/package.lsp")
 ; cert-flags: ? t :ttags :all :skip-proofs-okp t
-(certify-book "doc" ? t :ttags :all :skip-proofs-okp t)
+(set-deferred-ttag-notes t state)
+
+
diff -Nru acl2-6.2/books/centaur/doc.lisp acl2-6.3/books/centaur/doc.lisp
--- acl2-6.2/books/centaur/doc.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/doc.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -19,7 +19,7 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "ACL2")
-
+(set-inhibit-warnings "ttags")
 (make-event
 
 ; Disabling waterfall parallelism because the include-books are too slow with
@@ -27,161 +27,170 @@
 ; that ACL2(h) memoizes by default (in particular, fchecksum-obj needs to be
 ; memoized to include centaur/tutorial/alu16-book).
 
- (if (and (hons-enabledp state) 
-          (f-get-global 'parallel-execution-enabled state)) 
+ (if (and (hons-enabledp state)
+          (f-get-global 'parallel-execution-enabled state))
      (er-progn (set-waterfall-parallelism nil)
                (value '(value-triple nil)))
    (value '(value-triple nil))))
 
+(include-book "misc/memory-mgmt")
+(value-triple (set-max-mem (* 10 (expt 2 30))))
 
-(include-book "vl/top")
-(include-book "vl/lint/lint")
-(include-book "vl/mlib/clean-concats")
-(include-book "vl/mlib/atts")
-(include-book "vl/transforms/xf-clean-selects")
-(include-book "vl/transforms/xf-propagate")
-(include-book "vl/transforms/xf-expr-simp")
-(include-book "vl/transforms/xf-inline")
+; [Jared]: I suspect the following comment may be out of date?  But this
+; seems harmless enough anyway...
+;
+;   The following are included automatically by the xdoc::save command below,
+;   but we include them explicitly to support the hons `make' target in the
+;   books/ directory (and hence the regression-hons `make' target in the
+;   acl2-sources directory).
+
+(include-book "xdoc/save-fancy" :dir :system)
+(include-book "xdoc/defxdoc-raw" :dir :system)
+(include-book "xdoc/topics" :dir :system)
 
-(include-book "aig/aiger")
-(include-book "aig/aig-equivs")
-(include-book "aig/aig-vars")
-(include-book "aig/aig-vars-fast")
-(include-book "aig/base")
-(include-book "aig/bddify")
-(include-book "aig/bddify-correct")
-(include-book "aig/eval-restrict")
-(include-book "aig/g-aig-eval")
-(include-book "aig/induction")
-(include-book "aig/misc")
-(include-book "aig/three-four")
-(include-book "aig/witness")
-(include-book "aig/vuaig")
+(include-book "4v-sexpr/top")
+(include-book "aig/top")
 
-(include-book "ubdds/lite")
-(include-book "ubdds/param")
+(include-book "aignet/aig-sim")
+(include-book "aignet/copying")
+(include-book "aignet/from-hons-aig-fast")
+(include-book "aignet/prune")
+(include-book "aignet/to-hons-aig")
+(include-book "aignet/types")
+(include-book "aignet/vecsim")
 
 (include-book "bitops/top")
+(include-book "bitops/congruences")
+(include-book "bitops/sign-extend")
+(include-book "bitops/install-bit")
+(include-book "bitops/rotate")
+(include-book "bitops/ash-bounds")
+(include-book "bitops/defaults")
+(include-book "bitops/saturate")
+(include-book "bitops/signed-byte-p")
+
+(include-book "bridge/top")
 
 (include-book "clex/example")
 
-(include-book "gl/gl")
-(include-book "gl/bfr-aig-bddify")
+(include-book "cgen/top" :dir :system)
 
-(include-book "4v-sexpr/top")
+(include-book "defrstobj/defrstobj")
 
 (include-book "esim/stv/stv-top")
 (include-book "esim/stv/stv-debug")
 (include-book "esim/esim-sexpr-correct")
 
+(include-book "centaur/getopt/top" :dir :system)
+(include-book "centaur/getopt/demo" :dir :system)
+(include-book "centaur/getopt/demo2" :dir :system)
 
-; The following are included automatically by the xdoc::save command below, but
-; we include them explicitly to support the hons `make' target in the books/
-; directory (and hence the regression-hons `make' target in the acl2-sources
-; directory).
-(include-book "../xdoc-impl/save")
-(include-book "../xdoc/defxdoc-raw")
-(include-book "../xdoc-impl/mkdir-raw")
-(include-book "../xdoc-impl/topics")
-(include-book "../xdoc-impl/extra-packages")
+(include-book "gl/gl")
+(include-book "gl/bfr-aig-bddify")
+(include-book "gl/gl-ttags")
+(include-book "gl/gobject-type-thms")
+(include-book "gl/bfr-satlink")
 
+(include-book "misc/top")
+(include-book "misc/smm")
+(include-book "misc/tailrec")
 (include-book "misc/hons-remove-dups")
 (include-book "misc/seed-random")
-(include-book "misc/equal-by-nths")
 (include-book "misc/load-stobj")
 (include-book "misc/load-stobj-tests")
+(include-book "misc/count-up")
 
-(include-book "tutorial/intro")
-(include-book "tutorial/alu16-book")
-(include-book "tutorial/counter")
+;; BOZO conflicts with something in 4v-sexpr?
 
-(include-book "bridge/top")
+;; (include-book "misc/remove-assoc")
+;; (include-book "misc/sparsemap")
+;; (include-book "misc/sparsemap-impl")
+(include-book "misc/stobj-swap")
 
-(include-book "defrstobj/defrstobj")
+(include-book "oslib/top" :dir :system)
 
-(include-book "misc/smm")
-(include-book "bitops/install-bit")
-(include-book "bitops/rotate")
-(include-book "misc/tailrec")
+(include-book "regex/regex-ui" :dir :system)
+
+(include-book "regression/common")
+
+(include-book "std/top" :dir :system)
+(include-book "std/lists/resize-list" :dir :system)
+(include-book "std/lists/nth" :dir :system)
+
+(include-book "ubdds/lite")
+(include-book "ubdds/param")
+
+(include-book "vcd/vcd")
+(include-book "vcd/esim-snapshot")
+(include-book "vcd/vcd-stub")
+;; BOZO causes some error with redefinition?  Are we loading the right
+;; books above?  What does stv-debug load?
+;; (include-book "vcd/vcd-impl")
+
+(include-book "vl/top")
+(include-book "vl/kit/top")
+(include-book "vl/mlib/clean-concats")
+(include-book "vl/mlib/atts")
+(include-book "vl/mlib/json")
+(include-book "vl/transforms/xf-clean-selects")
+(include-book "vl/transforms/xf-propagate")
+(include-book "vl/transforms/xf-expr-simp")
+(include-book "vl/transforms/xf-inline")
 (include-book "vl/mlib/sub-counts")
+
+;; BOZO these are incompatible?  which is right?
 (include-book "vl/util/prefix-hash")
+;;(include-book "vl/util/prefixp")
 
-(include-book "regex/regex-ui" :dir :system)
+(include-book "vl/checkers/use-set-tool")
+
+;; BOZO uh, incompatible with lint?  is this dead?
+;; (include-book "vl/lint/xf-drop-unresolved-submodules")
+(include-book "vl/mlib/lvalues-mentioning")
+(include-book "vl/mlib/rvalues")
+(include-book "vl/mlib/ram-tools")
+
+
+(include-book "hacking/all" :dir :system)
+(include-book "hints/consider-hint" :dir :system)
+(include-book "tools/do-not" :dir :system)
+
+(include-book "tutorial/intro")
+(include-book "tutorial/alu16-book")
+(include-book "tutorial/counter")
 
-(include-book "countereg-gen/top" :dir :system)
 
 #||
 
-;; This really doesn't belong here, but I want it out of cutil/top to improve
-;; the critical path.  This just tricks the dependency scanner into building these
-;; books.
-(include-book "bitops/congruences")
+;; This is a nice place to put include-book scanner hacks that trick cert.pl
+;; into certifying unit-testing books that don't actually need to be included
+;; anywhere.  This just tricks the dependency scanner into building
+;; these books.
+
 (include-book "defrstobj/basic-tests")
 (include-book "cutil/deflist-tests" :dir :system)
 (include-book "cutil/defalist-tests" :dir :system)
 (include-book "cutil/defmapappend-tests" :dir :system)
 (include-book "cutil/defprojection-tests" :dir :system)
+(include-book "cutil/defredundant-tests" :dir :system)
+(include-book "cutil/tools/assert-return-thms" :dir :system)
+(include-book "centaur/misc/tshell-tests" :dir :system)
 
-;; Here is more tricking of the dependency scanner, to avoid leaving out books
-;; under books/centaur/ from the certification process invoked by running 'make
-;; regression-hons' from the acl2-sources directory.  Note that at least one of
-;; these can't be moved to outside this comment: defrstobj/groundwork/demo1
-;; gives a conflicting definition of a stobj, st.
-
-(include-book "bitops/sign-extend")
 (include-book "defrstobj/groundwork/demo1")
 (include-book "defrstobj/groundwork/demo2")
 (include-book "defrstobj/groundwork/demo3")
 (include-book "defrstobj/groundwork/demo4")
 (include-book "defrstobj/groundwork/demo5")
-(include-book "misc/top")
-(include-book "ubdds/sanity-check-macros")
-(include-book "vl/checkers/use-set-tool")
-(include-book "vl/lint/xf-drop-unresolved-submodules")
-(include-book "vl/mlib/lvalues-mentioning")
-(include-book "vl/mlib/rvalues")
-(include-book "vl/util/prefixp")
 
-; Another useful book:
-(include-book "gl/bfr-satlink")
-
-; Let's just put down the rest of the books that were discovered missing on
-; 5/10/2013, when we certified with the legacy makefile (books/Makefile.legacy)
-; instead of the new makefile (books/Makefile).
+(include-book "ubdds/sanity-check-macros")
 
-(include-book "aig/best-aig")
-(include-book "aignet/aig-sim")
-(include-book "aignet/copying")
-(include-book "aignet/from-hons-aig-fast")
-(include-book "aignet/prune")
-(include-book "aignet/to-hons-aig")
-(include-book "aignet/types")
-(include-book "aignet/vecsim")
-(include-book "aig/random-sim")
-(include-book "bitops/ash-bounds")
-(include-book "bitops/defaults")
-(include-book "bitops/saturate")
-(include-book "bitops/signed-byte-p")
-(include-book "gl/gl-ttags")
-(include-book "gl/gobject-type-thms")
-(include-book "misc/count-up")
-(include-book "misc/memory-mgmt")
-(include-book "misc/remove-assoc")
-(include-book "misc/resize-list")
-(include-book "misc/sparsemap")
-(include-book "misc/sparsemap-impl")
-(include-book "misc/stobj-swap")
-(include-book "vcd/esim-snapshot")
-(include-book "vcd/vcd")
-(include-book "vcd/vcd-impl")
-(include-book "vcd/vcd-stub")
-(include-book "vl/mlib/ram-tools")
+;; BOZO why do we care about coi/records/fast?
 (include-book "../coi/records/fast/log2")
 (include-book "../coi/records/fast/memory")
 (include-book "../coi/records/fast/memory-impl")
 (include-book "../coi/records/fast/memtree")
 (include-book "../coi/records/fast/private")
-(include-book "../cutil/tools/assert-return-thms")
+
 (include-book "../memoize/old/case")
 (include-book "../memoize/old/profile")
 (include-book "../memoize/old/watch")
@@ -191,10 +200,488 @@
 
 ||#
 
+; Historically we had a completely ad-hoc organization that grew organically as
+; topics were added.  This turned out to be a complete mess.  To make the
+; manual more approachable and relevant, we now try to impose a better
+; hierarchy and add some context.
+
+(local
+ (defxdoc acl2::top
+
+; The TOP topic will be the first thing the user sees when they open the
+; manual!  We localize this because you may want to write your own top topics
+; for custom manuals.
+
+   :short "User manual for the <a
+href='http://www.cs.utexas.edu/users/moore/acl2/'>ACL2 Theorem Prover</a> and
+the <a href='http://acl2-books.googlecode.com/'>ACL2 Community Books</a>"
+
+   :long "<h3>Introduction</h3>
+
+<p><a href='http://www.cs.utexas.edu/users/moore/acl2/'>ACL2</a> is an
+interactive theorem prover.  It combines a Lisp-based programming language for
+developing formal models of systems with a reasoning engine that can prove
+properties about these models.  It has been used to <a
+href='http://en.wikipedia.org/wiki/Formal_verification'>formally verify</a>
+many <see topic='@(url interesting-applications)'>interesting systems</see> in
+academia and industry.</p>
+
+<p>The <a href='http://acl2-books.googlecode.com/'>ACL2 Community Books</a> are
+the canonical set of open-source libraries (\"@(see books)\") for ACL2.  They
+include lemma libraries for reasoning in many domains, macro libraries for more
+quickly writing and documenting code, interfacing tools for connecting ACL2 to
+other systems, productivity tools for better proof automation and debugging,
+and specialty libraries for areas like @(see hardware-verification).</p>
+
+<p>This user manual covers both ACL2 and the Community Books.  It is derived by
+combining the classic @(see doc-string)s found in the ACL2 source code and some
+books with the @(see xdoc) topics found in other books.  Besides just importing
+the documentation, we also rearrange the topic hierarchy to try to improve its
+organization.</p>
+
+<p>This manual is very much a work in progress.  If you would like to
+contribute to its development, please join the <a
+href='https://code.google.com/p/acl2-books/'>acl2-books</a> project!</p>"))
+
+(defsection arithmetic
+  :parents (top)
+  :short "Libraries for reasoning about basic arithmetic, bit-vector
+arithmetic, modular arithmetic, etc.")
+
+(defsection boolean-reasoning
+  :parents (top)
+  :short "Libraries related to representing and processing Boolean functions,
+geared toward large-scale automatic reasoning, e.g., via SAT solving and AIG or
+BDD packages."
+
+  :long "<h3>Introduction</h3>
+
+<p><a href='http://en.wikipedia.org/wiki/Boolean_function'>Boolean
+functions</a> are widely useful throughout mathematical logic, computer
+science, and computer engineering.  In formal verification, they are especially
+interesting because many high-capacity, fully automatic techniques are known
+for analyzing, comparing, and simplifying them; for instance, see <a
+href='http://en.wikipedia.org/wiki/Binary_decision_diagram'>binary decision
+diagrams</a> (bdds), <a
+href='http://en.wikipedia.org/wiki/Boolean_satisfiability_problem'>SAT
+solvers</a>, <a
+href='http://en.wikipedia.org/wiki/And-inverter_graph'>and-inverter
+graphs</a> (aigs), <a href='http://en.wikipedia.org/wiki/Model_checking'>model
+checking</a>, <a
+href='http://en.wikipedia.org/wiki/Formal_equivalence_checking'>equivalence
+checking</a>, and so forth.</p>
+
+<h3>Libraries for Boolean Functions</h3>
+
+<p>We have developed some libraries for working with Boolean functions, for
+instance:</p>
+
+<ul>
+
+<li>@(see satlink) provides a representation of <a
+href='http://en.wikipedia.org/wiki/Conjunctive_normal_form'>conjunctive normal
+form</a> formulas and a way to call SAT solvers from ACL2 and trust their
+results.</li>
+
+<li>Libraries like @(see aig) and @(see ubdds) provide @(see hons)-based AIG and
+BDD packages.</li>
+
+<li>@(see aignet) provides a more efficient, @(see stobj)-based AIG
+representation similar to that used by <a
+href='http://www.eecs.berkeley.edu/~alanmi/abc/'>ABC</a>.</li>
+
+</ul>
+
+<p>These libraries are important groundwork for the @(see gl) framework for
+bit-blasting ACL2 theorems, and may be of interest to anyone who is trying to
+develop new, automatic tools or proof techniques.</p>
+
+<h3>Libraries for Four-Valued Logic</h3>
+
+<p>Being able to process large-scale Boolean functions is especially important
+in @(see hardware-verification).  But actually, here, to model certain circuits
+and to implement certain algorithms, it can be useful to go beyond Boolean
+functions and consider a richer logic.</p>
+
+<p>You might call Boolean functions or Boolean logic a two-valued logic, since
+there are just two values (true and false) that any variable can take.  It is
+often useful to add a third value, usually called X, to represent an
+\"unknown\" value.  In some systems, a fourth value, Z, is added to represent
+an undriven wire.  For more on this, see @(see why-4v-logic).</p>
+
+<p>We have developed two libraries to support working in four-valued logic.  Of
+these, the @(see 4v) library is somewhat higher level and is generally simpler
+and more convenient to work with.  It serves as the basis of the @(see esim)
+hardware simulator.  Meanwhile, the @(see faig) library is a bit lower-level
+and does not enjoy the very nice @(see 4v-monotonicity) property of @(see
+4v-sexprs).  On the other hand, @(see faig)s are closer to @(see aig)s, and can
+be useful for loading expressions into @(see aignet) or @(see satlink).</p>
+
+<h3>Related Papers</h3>
+
+<p>Besides the documentation here, you may find the following papers
+useful:</p>
+
+<p>Jared Davis and Sol Swords.  <a
+href='http://dx.doi.org/10.4204/EPTCS.114.8'>Verified AIG Algorithms in
+ACL2.</a>  In ACL2 Workshop 2013. May, 2013. EPTCS 114.  Pages 95-110.</p>
+
+<p>Sol Swords and Jared Davis.  <a
+href='http://dx.doi.org/10.4204/EPTCS.70.7'>Bit-Blasting ACL2 Theorems</a>.
+In ACL2 Workshop 2011.  November, 2011.  EPTCS 70.  Pages 84-102.</p>
+
+<p>Sol Swords and Warren A Hunt, Jr.  <a
+href='http://dx.doi.org/10.1007/978-3-642-14052-5_30'>A Mechanically Verified
+AIG to BDD Conversion Algorithm</a>.  In ITP 2010,LNCS 6172, Springer.  Pages
+435-449.</p>")
+
+(defsection macro-libraries
+  :parents (top macros)
+  :short "Generally useful macros for writing more concise code, and frameworks
+for quickly introducing concepts like typed structures, typed lists, defining
+functions with type signatures, and automating other common tasks.")
+
+(defsection hardware-verification
+  :parents (top)
+  :short "Libraries for working with hardware description languages, modeling
+circuits, etc.")
+
+(defsection proof-automation
+  :parents (top)
+  :short "Tools, utilities, and strategies for dealing with particular kinds
+of proofs.")
+
+(defsection interfacing-tools
+  :parents (top)
+  :short "Libraries and tools for doing basic <see topic='@(url std/io)'>file
+i/o</see>, using raw <see topic='@(url quicklisp)'>Common Lisp libraries</see>,
+working with the <see topic='@(url oslib)'>operating system</see>, and
+interfacing with <see topic='@(url bridge)'>other programs</see>.")
+
+(defsection debugging
+  :parents (top)
+  :short "Tools for debugging failed or slow proofs, or misbehaving
+functions.")
+
+(defsection macros
+  :parents (acl2)
+  :short "Macros allow you to extend the syntax of ACL2.")
+
+
+
+; Huge stupid hack.  Topics that are documented with the old :DOC system can't
+; have XDOC topics for their parents.  So, get them all loaded and converted
+; into proper XDOC topics, then move them around where we want them.
+
+
+(local (xdoc::import-acl2doc))
+
+#!XDOC
+(defun change-parents-fn (name new-parents all-topics)
+  (declare (xargs :mode :program))
+  (b* (((when (atom all-topics))
+        (er hard? 'change-parents-fn "Topic ~x0 was not found." name))
+       (topic (car all-topics))
+       ((unless (equal (cdr (assoc :name topic)) name))
+        (cons (car all-topics)
+              (change-parents-fn name new-parents (cdr all-topics))))
+       (topic (cons (cons :parents new-parents)
+                    (delete-assoc-equal :parents topic))))
+    (cons topic (cdr all-topics))))
+
+#!XDOC
+(defmacro change-parents (name new-parents)
+  `(table xdoc 'doc
+          (change-parents-fn ',name ',new-parents
+                             (get-xdoc-table world))))
+
+
+(defmacro xdoc::fix-the-hierarchy ()
+  ;; I make this a macro so I can reuse it in Centaur internal manuals.
+  `(progn
+     (xdoc::change-parents ihs (arithmetic))
+
+     (xdoc::change-parents b* (macro-libraries))
+     (xdoc::change-parents data-definitions (macro-libraries))
+     (xdoc::change-parents data-structures (macro-libraries))
+
+     (xdoc::change-parents io (interfacing-tools))
+     (xdoc::change-parents hacker (interfacing-tools))
+
+     (xdoc::change-parents witness-cp (proof-automation))
+     (xdoc::change-parents esim (hardware-verification))
+
+     (xdoc::change-parents testing (debugging))
+
+;; So I got started on that, and decided to move around a whole bunch of ACL2
+;; doc topics.  Much of this would probably make more sense to do in ACL2 itself.
+
+     (xdoc::change-parents copyright (about-acl2))
+     (xdoc::change-parents version (about-acl2))
+     (xdoc::change-parents release-notes (about-acl2))
+     (xdoc::change-parents bibliography (about-acl2))
+     (xdoc::change-parents acknowledgments (about-acl2))
+     (xdoc::change-parents acl2-help (about-acl2))
+
+     (xdoc::change-parents nqthm-to-acl2 (acl2-tutorial))
+
+     (xdoc::change-parents exit (good-bye))
+     (xdoc::change-parents quit (good-bye))
+
+     (xdoc::change-parents |Pages Written Especially for the Tours| (acl2-tutorial))
+
+     (xdoc::change-parents introduction-to-the-tau-system (tau-system))
+     (xdoc::change-parents tau-data (tau-system))
+     (xdoc::change-parents tau-database (tau-system))
+
+     (xdoc::change-parents wof (io))
+     (xdoc::change-parents serialize (io))
+
+     (xdoc::change-parents guard-obligation (guard))
+     (xdoc::change-parents guard-debug (guard debugging))
+     (xdoc::change-parents verify-guards-formula (guard))
+     (xdoc::change-parents print-gv (guard debugging))
+     (xdoc::change-parents walkabout (debugging))
+     (xdoc::change-parents trace (debugging))
+     (xdoc::change-parents time-tracker (debugging))
+     (xdoc::change-parents disassemble$ (debugging))
+     (xdoc::change-parents splitter (debugging))
+     (xdoc::change-parents splitter-output (splitter))
+     (xdoc::change-parents immed-forced (splitter))
+     (xdoc::change-parents if-intro (splitter))
+     (xdoc::change-parents proof-checker (debugging))
+     (xdoc::change-parents proof-tree (debugging))
+     (xdoc::change-parents pstack (debugging))
+     (xdoc::change-parents forward-chaining-reports (debugging))
+     (xdoc::change-parents accumulated-persistence (debugging))
+     (xdoc::change-parents set-accumulated-persistence (accumulated-persistence))
+     (xdoc::change-parents show-accumulated-persistence (accumulated-persistence))
+     (xdoc::change-parents dmr (debugging))
+     (xdoc::change-parents dynamically-monitor-rewrites (dmr))
+     (xdoc::change-parents break-rewrite (debugging))
+     (xdoc::change-parents why-brr (break-rewrite))
+     (xdoc::change-parents cw-gstack (break-rewrite))
+
+     (xdoc::change-parents default-hints (hints))
+     (xdoc::change-parents override-hints (hints))
+     (xdoc::change-parents hints-and-the-waterfall (hints))
+     (xdoc::change-parents lemma-instance (hints))
+     (xdoc::change-parents induct (hints))
+     (xdoc::change-parents hands-off (hints))
+     (xdoc::change-parents expand (hints))
+     (xdoc::change-parents nonlinearp (hints linear-arithmetic))
+     (xdoc::change-parents no-thanks (hints))
+     (xdoc::change-parents backchain-limit-rw (hints))
+     (xdoc::change-parents backtrack (hints))
+     (xdoc::change-parents consideration (hints))
+     (xdoc::change-parents restrict (hints))
+     (xdoc::change-parents reorder (hints))
+     (xdoc::change-parents use (hints))
+     (xdoc::change-parents by (hints))
+     (xdoc::change-parents do-not (hints))
+     (xdoc::change-parents do-not-hint (hints))
+     (xdoc::change-parents do-not-induct (hints))
+     (xdoc::change-parents goal-spec (hints))
+     (xdoc::change-parents clause-identifier (goal-spec))
+
+
+     (xdoc::change-parents otf-flg (defthm thm xargs))
+
+     (xdoc::change-parents package-reincarnation-import-restrictions
+                           (defpkg))
+
+     (xdoc::change-parents print-doc-start-column (documentation))
+     (xdoc::change-parents proof-supporters-alist (dead-events))
+
+     (xdoc::change-parents cases (hints))
+     (xdoc::change-parents custom-keyword-hints (hints))
+     (xdoc::change-parents computed-hints (hints))
+     (xdoc::change-parents using-computed-hints (computed-hints))
+     (xdoc::change-parents using-computed-hints-1 (computed-hints))
+     (xdoc::change-parents using-computed-hints-2 (computed-hints))
+     (xdoc::change-parents using-computed-hints-3 (computed-hints))
+     (xdoc::change-parents using-computed-hints-4 (computed-hints))
+     (xdoc::change-parents using-computed-hints-5 (computed-hints))
+     (xdoc::change-parents using-computed-hints-6 (computed-hints))
+     (xdoc::change-parents using-computed-hints-7 (computed-hints))
+     (xdoc::change-parents using-computed-hints-8 (computed-hints))
+
+     (xdoc::change-parents forced (force))
+     (xdoc::change-parents forcing-round (force))
+     (xdoc::change-parents enable-forcing (force))
+     (xdoc::change-parents disable-forcing (force))
+     (xdoc::change-parents immediate-force-modep (force))
+     (xdoc::change-parents enable-immediate-force-modep (force))
+     (xdoc::change-parents disable-immediate-force-modep (force))
+     (xdoc::change-parents failed-forcing (force))
+
+     (xdoc::change-parents lambda (term))
+
+     (xdoc::change-parents loop-stopper (rewrite))
+
+     (xdoc::change-parents lp (ld))
+     (xdoc::change-parents reset-ld-specials (ld))
+     (xdoc::change-parents keyword-commands (ld))
+     (xdoc::change-parents ld-error-action (ld))
+     (xdoc::change-parents ld-error-triples (ld))
+     (xdoc::change-parents ld-evisc-tuple (ld))
+     (xdoc::change-parents ld-keyword-aliases (ld))
+     (xdoc::change-parents ld-missing-input-ok (ld))
+     (xdoc::change-parents ld-post-eval-print (ld))
+     (xdoc::change-parents ld-pre-eval-filter (ld))
+     (xdoc::change-parents ld-pre-eval-print (ld))
+     (xdoc::change-parents ld-prompt (ld))
+     (xdoc::change-parents ld-query-control-alist (ld))
+     (xdoc::change-parents ld-redefinition-action (ld))
+     (xdoc::change-parents ld-skip-proofsp (ld))
+     (xdoc::change-parents ld-verbose (ld))
+     (xdoc::change-parents prompt (ld))
+     (xdoc::change-parents p! (ld))
+     (xdoc::change-parents a! (ld))
+     (xdoc::change-parents abort! (ld))
+     (xdoc::change-parents default-print-prompt (ld))
+     (xdoc::change-parents redef (ld))
+     (xdoc::change-parents redef- (ld))
+     (xdoc::change-parents redef+ (ld))
+     (xdoc::change-parents redef! (ld))
+
+     (xdoc::change-parents ignorable (declare))
+     (xdoc::change-parents ignore (declare))
+     (xdoc::change-parents optimize (declare))
+     (xdoc::change-parents type (declare))
+
+
+     (xdoc::change-parents xargs (defun))
+     (xdoc::change-parents measure (xargs))
+     (xdoc::change-parents guard-hints (xargs))
+     (xdoc::change-parents mode (xargs))
+     (xdoc::change-parents non-executable (xargs))
+     (xdoc::change-parents normalize (xargs))
+     (xdoc::change-parents stobjs (xargs))
+
+     (xdoc::change-parents stobj (programming))
+     (xdoc::change-parents defabsstobj (stobj events))
+     (xdoc::change-parents single-threaded-objects (stobj))
+
+
+     (xdoc::change-parents obdd (bdd))
+
+     (xdoc::change-parents defund (defun))
+     (xdoc::change-parents defun-inline (defun))
+     (xdoc::change-parents defund-inline (defun))
+     (xdoc::change-parents defun-notinline (defun))
+     (xdoc::change-parents defund-notinline (defun))
+     (xdoc::change-parents defun-nx (defun))
+     (xdoc::change-parents defun-mode (defun))
+
+
+     (xdoc::change-parents defabbrev (macros))
+     (xdoc::change-parents macro-args (macros))
+     (xdoc::change-parents &allow-other-keys (macro-args))
+     (xdoc::change-parents &body (macro-args))
+     (xdoc::change-parents &key (macro-args))
+     (xdoc::change-parents &optional (macro-args))
+     (xdoc::change-parents &rest (macro-args))
+     (xdoc::change-parents &whole (macro-args))
+     (xdoc::change-parents trans (macros))
+     (xdoc::change-parents trans1 (macros))
+     (xdoc::change-parents trans! (macros))
+     (xdoc::change-parents defmacro (macros events))
+     (xdoc::change-parents make-event (macros events))
+     (xdoc::change-parents untranslate-patterns (macros user-defined-functions-table))
+     (xdoc::change-parents add-macro-alias (macros switches-parameters-and-modes))
+     (xdoc::change-parents add-macro-fn (macros switches-parameters-and-modes))
+     (xdoc::change-parents macro-aliases-table (macros switches-parameters-and-modes))
+     (xdoc::change-parents remove-binop (macros switches-parameters-and-modes))
+     (xdoc::change-parents remove-macro-alias (macros switches-parameters-and-modes))
+     (xdoc::change-parents remove-macro-fn (macros switches-parameters-and-modes))
+     (xdoc::change-parents untrans-table (macros switches-parameters-and-modes))
+     (xdoc::change-parents user-defined-functions-table (macros switches-parameters-and-modes))
+
+
+
+
+     (xdoc::change-parents apropos (docs))
+
+     (xdoc::change-parents certify-book! (certify-book))
+
+     (xdoc::change-parents save-exec (interfacing-tools))
+
+     (xdoc::change-parents wormhole-data (wormhole))
+     (xdoc::change-parents wormhole-entry-code (wormhole))
+     (xdoc::change-parents wormhole-eval (wormhole))
+     (xdoc::change-parents wormhole-implementation (wormhole))
+     (xdoc::change-parents wormhole-p (wormhole))
+     (xdoc::change-parents wormhole-statusp (wormhole))
+     (xdoc::change-parents make-wormhole-status (wormhole))
+     (xdoc::change-parents get-wormhole-status (wormhole))
+     (xdoc::change-parents set-wormhole-entry-code (wormhole))
+     (xdoc::change-parents set-wormhole-data (wormhole))
+
+     (xdoc::change-parents show-bodies (definition))
+     (xdoc::change-parents set-body (events definition))
+
+     (xdoc::change-parents the-method (acl2-tutorial))
+
+     (xdoc::change-parents proof-of-well-foundedness (ordinals))
+     (xdoc::change-parents o< (ordinals))
+     (xdoc::change-parents o-p (ordinals))
+
+     (xdoc::change-parents keyword (keywordp))))
+
+(local (xdoc::fix-the-hierarchy))
+
+(local (deflabel doc-rebuild-label))
+
+(make-event
+ (b* ((state (serialize-write "xdoc.sao"
+                              (xdoc::get-xdoc-table (w state))
+                              :verbosep t)))
+   (value '(value-triple "xdoc.sao"))))
+
 (make-event
 ; xdoc::save is an event, so we might have just called it directly.  But for
 ; reasons Jared doesn't understand this is screwing up the extended manual we
 ; build at Centaur.  So, I'm putting the save event into a make-event to try
 ; to localize its effects to just this book's certification.
-  (er-progn (xdoc::save "./manual")
-            (value `(value-triple :manual))))
+ (er-progn (xdoc::save "./manual"
+                       ;; Don't import again since we just imported.
+                       :import nil
+                       ;; For classic mode only...
+                       :expand-level 2)
+           (value `(value-triple :manual))))
+
+(local
+ (defmacro doc-rebuild ()
+
+; It is sometimes useful to make tweaks to the documentation and then quickly
+; be able to see your changes.  This macro can be used to do this, as follows:
+;
+; SETUP:
+;
+;  (ld "doc.lisp")  ;; slow, takes a few minutes to get all the books loaded
+;
+; DEVELOPMENT LOOP: {
+;
+;   1. make documentation changes in new-doc.lsp; e.g., you can add new topics
+;      there with defxdoc, or use commands like change-parents, etc.
+;
+;   2. type (doc-rebuild) to rebuild the manual with your changes; this only
+;      takes 20-30 seconds
+;
+;   3. view your changes, make further edits
+;
+; }
+;
+; Finally, move your changes out of new-doc.lsp and integrate them properly
+; into the other sources, and do a proper build.
+
+   `(er-progn
+     (ubt! 'doc-rebuild-label)
+     (ld ;; newline to fool dependency scanner
+      "new-doc.lsp")
+     (make-event
+      (er-progn (xdoc::save "./manual"
+                            :import nil
+                            :expand-level 2)
+                (value `(value-triple :manual)))))))
diff -Nru acl2-6.2/books/centaur/esim/esim-cut.lisp acl2-6.3/books/centaur/esim/esim-cut.lisp
--- acl2-6.2/books/centaur/esim/esim-cut.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/esim/esim-cut.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,360 @@
+; ESIM Symbolic Hardware Simulator
+; Copyright (C) 2010-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+
+; esim-cut.lisp -- transform to cut wires in E modules
+;
+; Original authors: Jared Davis <jared@centtech.com>
+;                   Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+(include-book "esim-primitives")
+(include-book "esim-paths")
+(local (include-book "esim-sexpr-support-thms"))
+(include-book "cutil/define" :dir :system)
+(include-book "cutil/defaggregate" :dir :system)
+(include-book "cutil/defprojection" :dir :system)
+(include-book "cutil/defalist" :dir :system)
+(include-book "cutil/defmapappend" :dir :system)
+(include-book "centaur/vl/toe/toe-emodwire" :dir :system)
+
+#||
+(include-book
+ "tools/defconsts" :dir :system)
+(defconsts (*esims* state)
+  (serialize-read "/n/fv2/translations/nightly/cnr/esims.sao"
+                  :verbosep t))
+||#
+
+
+; We always cut only internal or output wires (it's an error to try to cut
+; an input wire.)
+;
+; Say we are cutting the wire W.
+; We need to:
+;
+;  - Change whatever occ is driving W, and make it drive W<original_value> instead
+;
+;  - Insert two clockless flip-flops:
+;
+;    The input here isn't really very important, but it gives us an easy
+;    way to pull out the original value if we want it.  The output is only
+;    relevant if we're going to override the wire, and in that case, it
+;    contains the value we're overriding it with.
+;
+;       fsm_reg W<override_value_reg> (.in(W<original_value>),
+;                                      .out(W<override_value>))
+;
+;    This one just controls whether we're overriding W at all.
+;
+;       fsm_reg W<override_decision_reg> (.in(0), .out(W<override_decision>))
+;
+;  - Insert a ZIF mux: If we're overriding, it chooses the override value we
+;    want to use (a), otherwise it chooses the original value (b).
+;
+;       zif_mux W<override_mux> (.sel(W<override_decision>),
+;                                .a(W<override_value>),
+;                                .b(W<original_value>),
+;                                .o(W))
+;
+;  - Done.  Check for name conflicts?
+
+
+; Our core transform will do this for a list of paths into some module.  At any
+; point, some of these paths may be terminal.
+
+(cutil::defaggregate ecutnames
+  ((original      symbolp :rule-classes :type-prescription)
+   (value         symbolp :rule-classes :type-prescription)
+   (value-reg     symbolp :rule-classes :type-prescription)
+   (decision-wire symbolp :rule-classes :type-prescription)
+   (decision-reg  symbolp :rule-classes :type-prescription)
+   (mux           symbolp :rule-classes :type-prescription)
+   ))
+
+(cutil::deflist ecutname-list-p (x)
+  (ecutnames-p x)
+  :guard t)
+
+(define ecutnames->flat-names ((x ecutnames-p))
+  (b* (((ecutnames x) x))
+    (list x.original
+          x.value
+          x.value-reg
+          x.decision-wire
+          x.decision-reg
+          x.mux)))
+
+(cutil::defmapappend ecutname-list->flat-names (x)
+  (ecutnames->flat-names x)
+  :guard (ecutname-list-p x))
+
+(define ecut-make-sym ((x symbolp)
+                       (suffix stringp))
+  :returns (name symbolp)
+  ;; We originally tried not to bother to use any emodwire stuff here.  That
+  ;; worked fine for most stuff (stv definition, running, etc.)  But the VCD
+  ;; generation stuff relies on emodwires (for good reason, e.g., to bundle
+  ;; together wires).  So, now, try to make sure our names are good emodwires,
+  ;; if they were originally.
+  (b* (((unless (vl::vl-emodwire-p x))
+        (intern-in-package-of-symbol
+         (str::cat (symbol-name x) suffix)
+         x))
+       (basename (vl::vl-emodwire->basename x))
+       (index    (vl::vl-emodwire->index x))
+       (new-name (str::cat basename suffix))
+       ((when (equal new-name "NIL"))
+        ;; Stupidity, too hard...
+        (raise "This will never happen.")))
+    (vl::vl-emodwire new-name index)))
+
+(define ecut-wire-names ((x symbolp))
+  :returns (names ecutnames-p)
+  (make-ecutnames
+   :original      (ecut-make-sym x "<original_value>")
+   :value         (ecut-make-sym x "<override_value>")
+   :value-reg     (ecut-make-sym x "<override_value_reg>")
+   :decision-wire (ecut-make-sym x "<override_decision>")
+   :decision-reg  (ecut-make-sym x "<override_decision_reg>")
+   :mux           (ecut-make-sym x "<override_mux>")))
+
+(cutil::defprojection ecut-wire-list-names (x)
+  (ecut-wire-names x)
+  :guard (symbol-listp x)
+  :result-type ecutname-list-p)
+
+
+(cutil::defalist ecut-wirename-alistp (x)
+  :key (symbolp x)
+  :val (ecutnames-p x)
+  :keyp-of-nil t
+  :valp-of-nil nil)
+
+(define ecut-names-alist ((wires symbol-listp))
+  :returns (alist ecut-wirename-alistp :hyp :guard)
+  (pairlis$ wires
+            (ecut-wire-list-names wires)))
+
+(define ecut-update-output-pattern (pat
+                                    (name-fal ecut-wirename-alistp))
+  (if pat
+      (if (atom pat)
+          (b* ((look (hons-get pat name-fal))
+               ((unless look) pat))
+            (ecutnames->original (cdr look)))
+        (cons (ecut-update-output-pattern (car pat) name-fal)
+              (ecut-update-output-pattern (cdr pat) name-fal)))
+    nil))
+
+(define ecut-update-drivers (occs
+                             (name-fal ecut-wirename-alistp))
+  (if (atom occs)
+      nil
+    (cons (chgpl :o (ecut-update-output-pattern (gpl :o (car occs))
+                                                name-fal)
+                 (car occs))
+          (ecut-update-drivers (cdr occs) name-fal))))
+
+(define ecut-add-override-occs-1 ((wire symbolp "The original wire name")
+                                  (names ecutnames-p "Names to use"))
+  :returns occs
+  (b* (((ecutnames x) names)
+
+       (value-occ
+        ;;       W<override_value_reg> (.in(W<original_value>),
+        ;;                              .out(W<override_value>))
+        (list :u x.value-reg
+              :op *esim-fsmreg*
+              :i `((,x.original))
+              :o `((,x.value))))
+
+       (decision-occ
+        ;;       W<override_decision_reg> (.in(0),
+        ;;                                 .out(W<override_decision>))
+        (list :u  x.decision-reg
+              :op *esim-fsmreg*
+              :i `((acl2::f))
+              :o `((,x.decision-wire))))
+
+       (mux-occ
+        ;;       W<override_mux> (.sel(W<override_decision>),
+        ;;                        .a(W<override_value>),
+        ;;                        .b(W<original_value>),
+        ;;                        .o(W))
+        (list :u  x.mux
+              :op *esim-zif*
+              :i  `((,x.decision-wire) ;; sel
+                    (,x.value)         ;; a
+                    (,x.original))     ;; b
+              :o  `((,wire)))))
+    (list value-occ decision-occ mux-occ)))
+
+(define ecut-add-override-occs ((name-fal ecut-wirename-alistp))
+  :returns occs
+  (if (atom name-fal)
+      nil
+    (append (ecut-add-override-occs-1 (caar name-fal)
+                                      (cdar name-fal))
+            (ecut-add-override-occs (cdr name-fal)))))
+
+(local (defthm l0
+         (implies (ecut-wirename-alistp x)
+                  (ECUTNAME-LIST-P (ALIST-VALS x)))
+         :hints(("Goal" :induct (len x)))))
+
+(define find-f-driver (occs)
+  (if (atom occs)
+      nil
+    (if (member-of-pat-flatten 'f (gpl :o (car occs)))
+        (car occs)
+      (find-f-driver (cdr occs)))))
+
+(defconst *ecut-f-driver-occ*
+  (list :o '((f))
+        :u 'ecut-f-driver-occ
+        :op *esim-f*))
+
+(define ecut-make-sure-f-is-driven-to-false (mod)
+  (b* ((driver (find-f-driver (gpl :occs mod)))
+       ((when driver)
+        (if (equal (gpl :op driver) *esim-f*)
+            mod
+          (raise "F is driven by something other than *esim-f*!"))))
+    (chgpl :occs (cons *ecut-f-driver-occ* (gpl :occs mod))
+           mod)))
+
+(define ecut-wires-in-module
+  ((wire-list   "A plain list of wires that should exist in this module.")
+   (mod         "The E module to transform."))
+  (b* (((when (atom wire-list))
+        mod)
+       (modname (gpl :n mod))
+       ((unless modname)
+        (raise "Expected a name on module ~x0." mod))
+       ((unless (symbol-listp wire-list))
+        (raise "Expected cut wire names to be symbols in ~x0" modname))
+       ((when (gpl :x mod))
+        (raise "In module ~x0: Can't cut wires in primitive module." modname))
+
+       (ins       (pat-flatten1 (gpl :i mod)))
+       (occs      (gpl :occs mod))
+       (driven    (collect-signal-list :o occs))
+       (instnames (collect-signal-list :u occs)) ;; ugh
+
+       (has-inputs (hons-intersection ins wire-list))
+       ((when has-inputs)
+        (raise "In module ~x0: Can't cut input wires, such as ~x1~%"
+               modname has-inputs))
+
+       ((unless (hons-subset wire-list driven))
+        (raise "In module ~x0: trying to cut nonexistent wires: ~x1."
+               modname (hons-set-diff wire-list driven)))
+
+       (wire-dups (duplicated-members wire-list))
+       ((when wire-dups)
+        (raise "In module ~x0: told to cut multiple occurrences of ~x1"
+               modname wire-dups))
+
+       (mod (ecut-make-sure-f-is-driven-to-false mod))
+
+       (name-fal (ecut-names-alist wire-list))
+       ((with-fast name-fal))
+
+       (all-new-names (ecutname-list->flat-names (alist-vals name-fal)))
+       (all-old-names (hons-remove-duplicates (append ins driven instnames)))
+       (dups (duplicated-members (append all-new-names all-old-names)))
+       ((when dups)
+        (raise "Name clashes in ~x0: ~x1" modname dups))
+
+       (occs (ecut-update-drivers (gpl :occs mod) name-fal))
+       (occs (append (ecut-add-override-occs name-fal) occs)))
+    (chgpl :occs occs mod)))
+
+(define ecut-bind-paths (x atoms-acc subs-acc)
+  ;; Sort paths x into atoms (cuts for the current module) and submodule paths,
+  ;; and further sort the submodule paths into an alist by the immediate
+  ;; submodule name.
+  (b* (((when (atom x))
+        (mv atoms-acc subs-acc))
+       ((when (atom (car x)))
+        (ecut-bind-paths (cdr x) (cons (car x) atoms-acc) subs-acc))
+       (occname (caar x))
+       (occ-paths (cdr (hons-get occname subs-acc)))
+       (subs-acc (hons-acons occname (cons (cdar x) occ-paths) subs-acc)))
+    (ecut-bind-paths (cdr x) atoms-acc subs-acc)))
+
+(mutual-recursion
+ (defun ecut-module (paths x)
+   (declare (xargs :guard t
+                   :well-founded-relation nat-list-<
+                   :measure (list (acl2-count x) 2)))
+   (b* (((when (atom paths)) x)
+        ((mv atoms subpaths) (ecut-bind-paths paths nil nil))
+        (occs (ecut-occs subpaths (gpl :occs x)))
+        (- (fast-alist-free subpaths))
+        (x (chgpl :occs occs x)))
+     (ecut-wires-in-module atoms x)))
+ (defun ecut-occs (subpaths occs)
+   (declare (xargs :guard t
+                   :measure (list (acl2-count occs) 1)))
+   (if (atom occs)
+       nil
+     (cons (ecut-occ subpaths (car occs))
+           (ecut-occs subpaths (cdr occs)))))
+ (defun ecut-occ (subpaths occ)
+   (declare (xargs :guard t
+                   :measure (list (acl2-count occ) 3)))
+   (b* ((instname (gpl :u occ))
+        (paths (cdr (hons-get instname subpaths)))
+        ((when (atom paths)) occ))
+     (chgpl :op (ecut-module paths (gpl :op occ))
+            occ))))
+
+
+#||
+
+(defun find-module (name x)
+  (if (atom x)
+      nil
+    (if (equal (gpl :n (car x)) name)
+        (car x)
+      (find-module name (Cdr x)))))
+
+(defconst *decode16*
+  (find-module '|*decode16*| *esims*))
+
+
+
+
+(good-esim-modulep (ecut-module '(|dout[3]|) *decode16*))
+(bad-esim-modulep (ecut-module '(|dout[3]|) *decode16*))
+
+(include-book
+ "esim-sexpr")
+
+(esim-sexpr-general-nst (ecut-module '(|dout[3]|) *decode16*))
+(esim-sexpr-general-out (ecut-module '(|dout[3]|) *decode16*))
+
+(defconst *m*
+  (find-module '|*rmux2regi_en$width=1*| *esims*))
+
+(ecut-module '((|r1| . |q|)) *m*)
+(good-esim-modulep (ecut-module '((|r1| . |q[0]|)) *m*))
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/esim/esim-primitives.lisp acl2-6.3/books/centaur/esim/esim-primitives.lisp
--- acl2-6.2/books/centaur/esim/esim-primitives.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/esim-primitives.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -220,6 +220,23 @@
   :x (:out ((|q| . (ite |clk| |d| s)))
       :nst ((s   . (ite |clk| |d| s)))))
 
+(def-esim-primitive *esim-fsmreg*
+  :short "Primitive E module for an unclocked register."
+  :long "<p>This is an FSM-style register that always updates its state bit to
+its input value at each step.</p>"
+  :i ((|d|))
+  :o ((|q|))
+  :x (:out ((|q| . s))
+      :nst ((s   . |d|))))
+
+(def-esim-primitive *esim-zif*
+  :short "Primitive E module for a kind of pass-gate style mux."
+  :long "<p>This is a special kind of mux that can preserve Z values on its
+inputs, used to support experimental esim decomposition.</p>"
+  :i ((|sel|) (|a|) (|b|))
+  :o ((|o|))
+  :x (:out ((|o| . (zif |sel| |a| |b|)))))
+
 (defsection *esim-primitives*
   :parents (esim-primitives)
   :short "A list of all esim primitives."
@@ -244,5 +261,7 @@
 ;;          *esim-res*
           *esim-tri*
           *esim-flop*
-          *esim-latch*)))
+          *esim-latch*
+          *esim-fsmreg*
+          *esim-zif*)))
 
diff -Nru acl2-6.2/books/centaur/esim/esim-sexpr-correct.lisp acl2-6.3/books/centaur/esim/esim-sexpr-correct.lisp
--- acl2-6.2/books/centaur/esim/esim-sexpr-correct.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/esim-sexpr-correct.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -1192,7 +1192,7 @@
                                   keys-equiv-when-alist-keys
                                   (:type-prescription 4v-fix$inline)
                                   4v-sexpr-eval
-                                  alist-equiv-append-atom
+                                  ;alist-equiv-append-atom
                                   esim-fixpoint-p-occs
                                   4v-fix))
           :expand ((esim-fixpoint-p-occs mod occs (append fixpoint env) env)
@@ -1280,7 +1280,7 @@
   (implies (member-equal occ occs)
            (subsetp-equal (pat-flatten1 (gpl k (esim-get-occ occ mod)))
                           (collect-signal-list k (occs-for-names occs mod))))
-  :hints (("goal" :induct t :in-theory (enable fal-extract))
+  :hints (("goal" :induct t :in-theory (enable member-equal fal-extract))
           (and stable-under-simplificationp
                '(:in-theory (enable gpl fal-extract)))))
 
@@ -1296,7 +1296,8 @@
 (defthm occ-state-subset-of-occs-state
   (implies (member-equal occ occs)
            (subsetp-equal (pat-flatten1 (occ-state occ))
-                          (pat-flatten1 (occs-state occs)))))
+                          (pat-flatten1 (occs-state occs))))
+  :hints(("Goal" :in-theory (enable member-equal))))
 
 (defthm occ-state-subset-of-mod-state
   (implies (and (member-equal occ (gpl :occs mod))
@@ -1715,7 +1716,7 @@
                            alist-equiv-append-when-keys-nil
                            append ; 4v-sexpr-eval-lookup-in-atom-val-alist
                            4v-alist-extract
-                           alist-equiv-append-atom
+                           ;alist-equiv-append-atom
                            4v-sexpr-eval-possibilities
                            ; 4v-sexpr-fixpoint-lower-boundp-atom-ups
                            4v-alists-agree-commute
@@ -2560,7 +2561,8 @@
                                        (pat-flatten1 (occs-state occs))))
                 (member-equal occ2 occs))
            (not (intersectp-equal (pat-flatten1 (occ-state occ))
-                                  (pat-flatten1 (occ-state occ2))))))
+                                  (pat-flatten1 (occ-state occ2)))))
+  :hints(("Goal" :in-theory (enable member-equal))))
 
 (defthmd state-of-occ-not-intersecting-member1
   (implies (and (not (intersectp-equal (pat-flatten1 (occ-state occ))
@@ -2578,7 +2580,8 @@
                 (not (equal occ1 occ2)))
            (not (intersectp-equal (pat-flatten1 (occ-state occ1))
                                   (pat-flatten1 (occ-state occ2)))))
-  :hints(("Goal" :in-theory (enable state-of-occ-not-intersecting-member
+  :hints(("Goal" :in-theory (enable member-equal
+                                    state-of-occ-not-intersecting-member
                                     state-of-occ-not-intersecting-member1))))
 
 (defthm states-of-diff-occs-not-intersecting-occs-of-mod
@@ -2620,7 +2623,7 @@
                  (pat-flatten1 (occs-state (alist-vals (fal-extract
                                                         rest-occnames (occmap mod))))))))
   :hints(("Goal" :in-theory
-          (e/d (fal-extract alist-vals occs-state)
+          (e/d (fal-extract alist-vals occs-state member-equal)
                (good-esim-modulep occ-state gpl-u-occmap-lookup
                                   default-car default-cdr))
           :induct t)
diff -Nru acl2-6.2/books/centaur/esim/esim-sexpr-support.lisp acl2-6.3/books/centaur/esim/esim-sexpr-support.lisp
--- acl2-6.2/books/centaur/esim/esim-sexpr-support.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/esim-sexpr-support.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -24,9 +24,9 @@
 (include-book "centaur/esim/plist" :dir :system)
 (include-book "centaur/misc/patterns" :dir :system)
 (include-book "centaur/4v-sexpr/sexpr-vars" :dir :system)
-(include-book "std/misc/explode-nonnegative-integer" :dir :system)
 (include-book "std/misc/two-nats-measure" :dir :system)
 (include-book "arithmetic/nat-listp" :dir :system)
+(local (include-book "str/explode-atom" :dir :system))
 (set-well-founded-relation nat-list-<)
 
 (make-event
diff -Nru acl2-6.2/books/centaur/esim/esim-spec.lisp acl2-6.3/books/centaur/esim/esim-spec.lisp
--- acl2-6.2/books/centaur/esim/esim-spec.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/esim-spec.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -1497,7 +1497,8 @@
 
 (defthm good-occsp-nonnil
   (implies (good-esim-occsp x)
-           (not (member-equal nil x))))
+           (not (member-equal nil x)))
+  :hints(("Goal" :in-theory (enable member-equal))))
 
 (defthm nonnil-vals-occmap
   (implies (good-esim-occsp occs)
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-compile.lisp acl2-6.3/books/centaur/esim/stv/stv-compile.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-compile.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-compile.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -24,8 +24,9 @@
 
 (in-package "ACL2")
 (include-book "stv-util")
+(include-book "../esim-cut")
 (include-book "../esim-sexpr-support")
-(include-book "../follow-backwards")
+;; (include-book "../follow-backwards")
 (include-book "centaur/misc/vecs-ints" :dir :system)
 (include-book "centaur/misc/tuplep" :dir :system)
 (include-book "cutil/defmvtypes" :dir :system)
@@ -39,42 +40,20 @@
 (make-event
 
 ; Disabling waterfall parallelism because this book allegedly uses memoization
-; while performing its proofs.  
+; while performing its proofs.
 
- (if (and (hons-enabledp state) 
-          (f-get-global 'parallel-execution-enabled state)) 
+ (if (and (hons-enabledp state)
+          (f-get-global 'parallel-execution-enabled state))
      (er-progn (set-waterfall-parallelism nil)
                (value '(value-triple nil)))
    (value '(value-triple nil))))
 
-(local (defthm atom-listp-of-append
-         (implies (and (atom-listp x)
-                       (atom-listp y))
-                  (atom-listp (append x y)))
-         :hints(("Goal" :in-theory (disable (force))))))
-
 (local (defthm atom-listp-of-pat-flatten1
          (atom-listp (pat-flatten1 x))
          :hints(("Goal" :in-theory (e/d (pat-flatten1)
                                         ((force)))))))
 
-;; (local (defthm alist-keys-of-pairlis$
-;;          (equal (alist-keys (pairlis$ x y))
-;;                 (list-fix x))
-;;          :hints(("Goal" :in-theory (enable pairlis$)))))
-
-(local (defthm consp-when-member-of-atom-listp
-         (implies (and (atom-listp x)
-                       (member-equal a x))
-                  (equal (consp a)
-                         nil))))
-
-(local (defthm atom-listp-when-subsetp
-         (implies (and (subsetp x y)
-                       (atom-listp y))
-                  (equal (atom-listp x)
-                         (true-listp x)))
-         :hints(("Goal" :induct (len x)))))
+(local (in-theory (enable consp-when-member-equal-of-atom-listp)))
 
 
 ; NOTE: throughout this code we assume the STV has already been preprocessed!
@@ -88,466 +67,36 @@
 ;  - The input/output/internal lines have been widened (e.g., by stv-widen),
 ;    and all share some length.
 
-
-(defsection stv-gensyms
+(define stv-gensyms-aux ((prefix stringp)
+                         (n      natp)
+                         acc)
+  :returns (syms symbol-listp :hyp (symbol-listp acc))
+  :parents (stv-gensyms)
+  (b* (((when (zp n))
+        acc)
+       (n     (- n 1))
+       (sym1  (intern$ (str::cat prefix "[" (str::natstr n) "]") "ACL2")))
+    (stv-gensyms-aux prefix n (cons sym1 acc)))
+  ///
+  (defthm len-of-stv-gensyms-aux
+    (equal (len (stv-gensyms-aux prefix n acc))
+           (+ (len acc) (nfix n)))))
+
+
+(define stv-gensyms ((prefix stringp)
+                     (n      natp))
+  :returns (syms symbol-listp)
   :parents (stv-compile)
-  :short "@(call stv-gensyms) produces the list of symbols @('(prefix[0]
-  ... prefix[n-1])')."
-
+  :short "Generate a list of symbols, @('(foo[0] ... foo[n-1])')."
   ;; I originally used VL's emodwire stuff for this, but it's nice to eliminate
   ;; that dependency and just generate our own symbols.
-
-  (defund stv-gensyms-aux (prefix n acc)
-    (declare (xargs :guard (and (stringp prefix)
-                                (natp n))))
-    (b* (((when (zp n))
-          acc)
-         (n     (- n 1))
-         (sym1  (intern$ (str::cat prefix "[" (str::natstr n) "]") "ACL2")))
-      (stv-gensyms-aux prefix n (cons sym1 acc))))
-
-  (defun stv-gensyms (prefix n)
-    "Enumerate (prefix[0] ... prefix[n-1])"
-    (declare (xargs :guard (and (stringp prefix)
-                                (natp n))))
-    (stv-gensyms-aux prefix n nil)))
-
-
-
-
-
-; -----------------------------------------------------------------------------
-;
-;              COMPILING :INITIAL LINES INTO A 4V-SEXPR-ALIST
-;
-; -----------------------------------------------------------------------------
-
-; The basic goal here *sounds* really easy: I want to let the user write down
-; names of Verilog regs, e.g., "foo.bar.baz.myreg[2:0]", and then somehow
-; figure out what E state bits correspond to this register.
-;
-; I've wrestled with this before, e.g., for "design registers."  But really I'd
-; like to get away from design registers.  They are sort of always getting
-; broken (when we change around how flop/latch inference stuff works), and
-; that's really irritating.  And EMAPs are really big/slow/awful when we get to
-; large modules.
-;
-; Can't we just use something like the ordinary path stuff (from stv-expand)?
-; After all, this path stuff is great: it keeps everything strictly at the
-; Verilog level and uses only the information that's already embedded in the
-; module to resolve the paths.
-;
-; Well, there are a couple of things that make this hard.
-;
-; A minor problem is that latches just have one E bit, but flops need two state
-; bits.  This means there isn't a nice, direct correspondence between a Verilog
-; "reg" bit and an E state bit.  But let's not worry about this yet.
-;
-; A harder problem is that, at least with the current flop inference stuff, the
-; E state bits aren't really "directly connected" to wire that arises from the
-; Verilog reg.  That is, if a Verilog module has a flop like:
-;
-;     always @(posedge clk) q <= d;
-;
-; Then the transformed module will have something like:
-;
-;     wire [n-1:0] q_temp_rhs = d;
-;     wire [n-1:0] q_temp_lhs;
-;     VL_N_BIT_LATCH guts (q_temp_lhs, q_temp_rhs, clk);
-;     wire [n-1:0] q = q_temp_lhs;
-;
-; Notice here that the VL_N_BIT_LATCH, where the E state bits live, isn't
-; driving Q; it's driving this other temporary wire instead.  There are good
-; reasons for it to work this way (e.g., it lets us handle delays and
-; truncations).  But if we want to let users write things like
-; "foo.bar.baz.myreg.q", then we'll have to deal with this.
-;
-; I have come up with, I think, a very nice solution to this whole mess.  This
-; solution "automatically" deals with things like the q = q_temp_lhs stuff,
-; without any special knowledge of how latch/flop inference works.  This should
-; be very helpful when we want to change and extend our support for always
-; blocks.  An even nicer, extremely neat thing is that the solution also lets
-; you refer to state bits in an even *less* direct way.
-;
-; To explain what I mean and why it is so good, consider a high-level module
-; that contains a module instance such as:
-;
-;     // stage A signals to B...
-;     myreg #(10) stageSignalsB (.q({ foo_B[5:0], bar_B, baz_B[2:0] }),
-;                                .d({ foo_A[5:0], bar_A, baz_A[2:0] }),
-;                                .clk(clk), .en1(en1), .en2(en2), ...);
-;
-; If I just gave you a way to refer to actual Verilog regs, it'd still be a
-; pain in the ass to initialize these state bits.  Suppose you wanted to
-; initialize bar_B to some particular value.  The actual "reg" for bar_B is
-; somewhere inside of myreg, so you'd have to write something like:
-;
-;     top.sub1.sub2.stageSignalsB.q[3], or
-;     top.sub1.sub2.stageSignalsB.guts.q[3], or similar.
-;
-; This is awful: you'll have to update the index every time a logic designer
-; adds something to the register or moves these wires around.  The basic point
-; is: it'd be really nice to be able to refer to this state bit using the name
-; top.sub1.sub2.bar_B, instead of the name of some Verilog reg, and my solution
-; lets us do this!
-;
-; The solution is simple once we have a tool that lets us linearly follow a
-; path backwards through an E module to its "real" driver.  This is pretty
-; tricky, but the tool has other uses as well.  See follow-backwards.lisp for
-; the details.
-;
-; With this code in place, we can do something pretty elegant: Given a path
-; that the user says refers to a state bit, first follow it back to where it
-; originates.  If it's a flop or a latch, we win: we have figured out what
-; state bit they're talking about, and we even know whether we should invert
-; it.  Otherwise, we'll just cause an error because the user is trying to
-; initialize things that aren't very simply connected up to state bits, and
-; that's either crazy or just beyond the scope of what I want to think about
-; supporting.
-
-(defsection stv-forge-state-bit
-  :parents (stv-compile)
-  :short "Generate the name for a state bit, like @('foo!bar!baz!inst!S'),
-given a list of instance names and the name of the state bit."
-
-  ;; BOZO have to keep this in sync with mod-state/occ-state
-
-  (defund stv-forge-state-bit (instnames st-name)
-    (declare (xargs :guard (atom st-name)))
-    (if (atom instnames)
-        st-name
-      (acl2::prefix-atom (acl2::stringify (car instnames))
-                         "!"
-                         (stv-forge-state-bit (cdr instnames) st-name))))
-
-  (local (in-theory (enable stv-forge-state-bit)))
-
-  (defthm atom-of-stv-forge-state-bit
-    (implies (atom st-name)
-             (atom (stv-forge-state-bit instnames st-name)))))
-
-
-(cutil::defprojection stv-forge-state-bits (instnames x)
-  (stv-forge-state-bit instnames x)
-  :guard (atom-listp x)
-  :result-type atom-listp)
-
-
-
-
-
-(defsection stv-initial-line-binding
-  :parents (stv-compile)
-  :short "Find the state bit(s) associated with some path and bind them to
-their initial values."
-
-  :long "<p><b>Signature:</b> @(call stv-initial-line-binding) returns a sexpr
-alist.</p>
-
-<p>The @('path') is any path into @('mod').  It need not be canonical.  We will
-follow the path with @(see follow-path-backwards), and we expect that new path
-we arrive at will be either an @(see *esim-flop*) or to an @(see *esim-latch*).
-If not, we cause a run-time error.</p>
-
-<p>The @('sexpr') is a sexpr that we want to use as the initial value for
-@('path').  The basic idea is to bind @('sexpr') to the state bits we have
-found.  A slight twist is that, if walking from @('path') to the state bits
-took us through an inversion, then we will bind the state bits to @('(not
-sexpr)') instead.  This should ensure that our initial bindings to state bits
-do indeed initialize @('path') to the desired value.</p>
-
-<p>If the path leads to a latch then there is just one state bit, and our alist
-will contain only a single entry.</p>
-
-<p>If the path leads to a flop, then there are two state bits!  <b>BOZO</b> for
-now, we initialize <b>BOTH</b> state bits together.  This shouldn't cause any
-problems until we want to compose together different STV runs.  To support
-composition, we'll probably want an extended syntax that lets you specify
-whether the master or slave bit gets initialized.</p>"
-
-  (defund stv-initial-line-binding (path sexpr mod)
-    (declare (xargs :guard (good-esim-modulep mod)))
-    (b* (((mv new-path invp) (follow-path-backwards path mod))
-         (instnames          (list-fix new-path))
-         (wirename           (final-cdr new-path))
-         (submod             (follow-esim-path instnames mod))
-         ((unless submod)
-          (er hard? 'stv-initial-line-binding
-              "Error creating :initial binding for ~x0.  We followed the path ~
-               backward to ~x1, but this path doesn't seem valid?" path new-path))
-
-         ;; Basic sanity check to make sure that the path leads to a flop/latch.
-         (name (gpl :n submod))
-         ((unless (or (eq name 'acl2::*esim-latch*)
-                      (eq name 'acl2::*esim-flop*)))
-          ;; BOZO I'm just using a name-based check to see if we're at a flop
-          ;; or a latch.  Is this okay?  Should we do something deeper?
-          (er hard? 'stv-initial-line-binding
-              "Error creating :initial binding for ~x0.  We followed the path ~
-               backward to ~x1.  We expected this to be a latch or flop, but ~
-               instead it is a ~x2 module." path new-path name))
-
-         ((unless (eq wirename 'acl2::|q|))
-          ;; Probably silly sanity check.  This may be of no use.  If it ever
-          ;; fails, it might indicate that our flop/latch format has changed.
-          (er hard? 'stv-initial-line-binding
-              "Error creating :initial binding for ~x0.  We followed the path ~
-               backward to ~x1, and found a flop/latch whose output isn't ~
-               even named acl2::|q|: ~x2?" path new-path wirename))
-
-         (ebits
-          ;; Gross way to come up with the actual state bits we want.  Note
-          ;; that the PAT-FLATTEN1 here is quite cheap: the submod is a latch
-          ;; or a flop, so its mod-state is just one or two bits.
-          (stv-forge-state-bits instnames (pat-flatten1 (mod-state submod))))
-         (nbits (length ebits))
-
-         ((unless (or (and (eq name 'acl2::*esim-latch*) (= nbits 1))
-                      (and (eq name 'acl2::*esim-flop*) (= nbits 2))))
-          ;; Cheap, very trivial sanity check.  This could save us if we do
-          ;; something to the representation of latches/flops.
-          (er hard? 'stv-initial-line-binding
-              "Error creating :initial binding for ~x0.  Wrong number of bits ~
-               for flop/latch?  The new-path is ~x1 and alleged ebits are ~x2."
-              path new-path ebits))
-
-         ((unless (subsetp-of-pat-flatten ebits (mod-state mod)))
-          ;; Cheap, good sanity check to make sure that we've actually
-          ;; identified state bits.  Note that EBITS is only going to be one or
-          ;; two bits, so even though this is O(n^2), N is very small.  This
-          ;; should save us from disaster if our naming conventions change.
-          (er hard? 'stv-path-to-statepath
-              "Error creating :initial binding for ~x0.  Something has gone ~
-               horribly wrong. The new-path, ~x1, seems to point to a valid ~
-               flop/latch.  But the bits we generated, ~x2, aren't in the ~
-               mod-state for the module?" path new-path ebits))
-
-         ;; Everything looks good, we got the right number of state bits,
-         ;; checked that they exist, etc.  Make the bindings.  We invert the
-         ;; sexpr if the path is inverting, so that the value on PATH will be
-         ;; what the user asked for.
-         (sexpr (if invp
-                    (hons-list 'acl2::not sexpr)
-                  sexpr))
-         (vals  (repeat sexpr nbits)))
-      (pairlis$ ebits vals)))
-
-  (local (in-theory (enable stv-initial-line-binding)))
-
-  (defthm alistp-of-stv-initial-line-binding
-    (alistp (stv-initial-line-binding path sexpr mod)))
-
-  (defthm keys-of-stv-initial-line-binding-are-states
-    (subsetp-equal (alist-keys (stv-initial-line-binding path sexpr mod))
-                   (pat-flatten1 (mod-state mod)))))
-
-
-(defsection stv-initial-line-bindings-aux
-  :parents (stv-compile)
-  :short "Extends @(see stv-initial-line-binding) to path/sexpr lists."
-
-  (defund stv-initial-line-bindings-aux (paths sexprs mod)
-    (declare (xargs :guard (and (equal (len paths) (len sexprs))
-                                (good-esim-modulep mod))))
-    (if (atom paths)
-        nil
-      (append (stv-initial-line-binding (car paths) (car sexprs) mod)
-              (stv-initial-line-bindings-aux (cdr paths) (cdr sexprs) mod))))
-
-  (local (in-theory (enable stv-initial-line-bindings-aux)))
-  (local (in-theory (disable (force))))
-
-  (defthm alistp-of-stv-initial-line-bindings-aux
-    (alistp (stv-initial-line-bindings-aux path sexpr mod)))
-
-  (defthm keys-of-stv-initial-line-bindings-aux-are-states
-    (subsetp-equal (alist-keys (stv-initial-line-bindings-aux path sexpr mod))
-                   (pat-flatten1 (mod-state mod)))))
+  (stv-gensyms-aux prefix n nil)
+  ///
+  (defthm len-of-stv-gensyms
+    (equal (len (stv-gensyms prefix n))
+           (nfix n))))
 
 
-(defsection stv-initial-line-bindings
-  :parents (stv-compile)
-  :short "Convert an :initial line into an alist binding state bits to sexprs."
-
-  :long "<p><b>Signature:</b> @(call stv-initial-line-bindings) returns @('(mv
-bindings usersyms)').</p>
-
-<p>The @('line') is an :initial line from the STV.  Note that its name should
-be a list of E paths in lsb-first order.  That is, Verilog-style names shoudl
-have already been expanded away using @(see stv-expand-names) or similar.
-These paths don't need to be canonical, and they don't need to refer to state
-bits.  We'll walk back from them to find the associated latch/flop that drives
-them.</p>
-
-<p>@('usersyms') is a fast alist that binds the names of simulation variables
-like @('opcode') to lists of bits that we generate for these symbols, i.e.,
-@('(opcode[0] ... opcode[n])').  This allows us to check for name collisions
-with generated symbols and width mismatches.  That is, we will allow the same
-variable to be given to multiple inputs at multiple phases, but for that to be
-sensible these inputs had better have the same width.</p>
-
-<p>The @('mod') is needed to do various path lookups.</p>"
-
-  (local (defthm len-of-bool-to-4v-sexpr-lst
-           (equal (len (bool-to-4v-sexpr-lst x))
-                  (len x))))
-
-  (local (defthm len-of-stv-gensyms-aux
-           (equal (len (stv-gensyms-aux prefix n acc))
-                  (+ (len acc) (nfix n)))
-           :hints(("Goal" :in-theory (enable stv-gensyms-aux)))))
-
-  (defund stv-initial-line-bindings (line usersyms mod)
-    "Returns (MV BINDINGS USERSYMS)"
-    (declare (xargs :guard (good-esim-modulep mod)))
-    (b* (((unless (tuplep 2 line))
-          (er hard? 'stv-initial-line-bindings
-              "An :initial line must have the form (name value), so this line ~
-               is not valid: ~x0." line)
-          (mv nil usersyms))
-
-         ((list paths entry) line)
-
-         ((unless (and (consp paths)
-                       (true-listp paths)))
-          (er hard? 'stv-initial-line-bindings
-              "Expected all :initial line names to be already expanded to ~
-               non-empty path lists, but found ~x0." paths)
-          (mv nil usersyms))
-
-         (width (length paths))
-
-         ((when (eq entry '_))
-          ;; Special case: we'll allow blanks, but generate no bindings for them.
-          (mv nil usersyms))
-
-         ((mv sexprs usersyms)
-          (b* (((when (natp entry))
-                (or (< entry (ash 1 width))
-                    (er hard? 'stv-initial-line-bindings
-                        "At :initial line for ~x0: value ~x1 is too wide to ~
-                         fit into ~x2 bits!" paths entry width))
-                (mv (bool-to-4v-sexpr-lst (int-to-v entry width)) usersyms))
-
-               ((when (eq entry 'x))
-                (mv (repeat *4vx-sexpr* width) usersyms))
-
-               ((when (eq entry :ones))
-                (mv (repeat *4vt-sexpr* width) usersyms))
-
-               ((when (or (eq entry '~)
-                          (keywordp entry)
-                          (not (symbolp entry))))
-                (er hard? 'stv-initial-line-bindings
-                    "At :initial line for ~x0: value ~x1 is not allowed in ~
-                     :initial lines." paths entry)
-                (mv (repeat *4vx-sexpr* width) usersyms))
-
-               (my-syms (stv-gensyms (symbol-name entry) width))
-               (look    (hons-get entry usersyms)))
-
-            (or (not look)
-                (equal (cdr look) my-syms)
-                (er hard? 'stv-expand-input-entry
-                    "At :initial line for ~x0: variable ~x1 cannot be used ~
-                     here.  This input is ~x2 bits wide, but ~x1 was ~
-                     previously used for a ~x3-bit input."
-                    paths entry width (len (cdr look))))
-
-            (mv my-syms (if look
-                            usersyms
-                          (hons-acons entry my-syms usersyms)))))
-
-         (bindings (stv-initial-line-bindings-aux paths sexprs mod)))
-      (mv bindings usersyms)))
-
-  (local (in-theory (enable stv-initial-line-bindings)))
-
-  (defmvtypes stv-initial-line-bindings (true-listp nil))
-
-  (defthm alistp-of-stv-initial-line-bindings
-    (b* ((ret (stv-initial-line-bindings line usersyms mod)))
-      (alistp (mv-nth 0 ret))))
-
-  (defthm keys-of-stv-initial-line-bindings-are-states
-    (let ((ret (stv-initial-line-bindings line usersyms mod)))
-      (subsetp-equal (alist-keys (mv-nth 0 ret))
-                     (pat-flatten1 (mod-state mod))))))
-
-
-(defsection stv-initial-lines-to-alist
-  :parents (stv-compile)
-  :short "Extend @(see stv-initial-line-bindings) across all the :initial lines."
-
-  (defund stv-initial-lines-to-alist (lines usersyms mod)
-    "Returns (MV BINDINGS USERSYMS)"
-    (declare (xargs :guard (good-esim-modulep mod)))
-    (b* (((when (atom lines))
-          (mv nil usersyms))
-         ((mv bindings1 usersyms) (stv-initial-line-bindings (car lines) usersyms mod))
-         ((mv bindings2 usersyms) (stv-initial-lines-to-alist (cdr lines) usersyms mod)))
-      (mv (append bindings1 bindings2) usersyms)))
-
-  (local (in-theory (disable (force))))
-  (local (in-theory (enable stv-initial-lines-to-alist)))
-
-  (defmvtypes stv-initial-lines-to-alist (true-listp nil))
-
-  (defthm alistp-of-stv-initial-lines-to-alist
-    (b* ((ret (stv-initial-lines-to-alist lines usersyms mod)))
-      (alistp (mv-nth 0 ret))))
-
-  (defthm keys-of-stv-initial-lines-to-alist-are-states
-    (let ((ret (stv-initial-lines-to-alist lines usersyms mod)))
-      (subsetp-equal (alist-keys (mv-nth 0 ret))
-                     (pat-flatten1 (mod-state mod)))))
-
-  (defthm atom-listp-of-alist-keys-of-stv-initial-lines-to-alist
-    (let ((ret (stv-initial-lines-to-alist lines usersyms mod)))
-      (atom-listp (alist-keys (mv-nth 0 ret))))
-    :hints(("Goal"
-            :in-theory (disable stv-initial-lines-to-alist
-                                keys-of-stv-initial-lines-to-alist-are-states)
-            :use ((:instance keys-of-stv-initial-lines-to-alist-are-states))))))
-
-
-
-(defsection stv-add-suffixes-to-initial-alist
-  :parents (stv-compile)
-  :short "Add .INIT suffixes to the state bits so that they can't clash with
-input signal names."
-
-  (defund stv-add-suffixes-to-initial-alist (x)
-    (declare (xargs :guard (atom-listp (alist-keys x))))
-    (b* ((keys (alist-keys x))
-         (vals (alist-vals x))
-         (keys.INIT (stv-suffix-signals keys ".INIT")))
-      (pairlis$ keys.INIT vals))))
-
-#||
-
-(include-book
- "stv-expand")
-
-(defconst *s0*
-  (make-stvdata :inputs nil
-                :outputs nil
-                :internals nil
-                :initial '(("mmxcntl.rsMmxSrc3_I" src3i)
-                             ("mmxcntl.rsMmxSrc2_I[4:2]" _)
-                             ("mmxcntl.rsMmxSrc2_I[0]" 1)
-                             ("mmxcntl.rsFeuBIBus_I[16:0]" bibus))))
-
-(defconst *s1*
-  (stv-expand *s0* |*mmx*|))
-
-(b* (((mv alist ?usersyms)
-      (stv-initial-lines-to-alist (stvdata->initial *s1*) nil |*mmx*|)))
-  (stv-add-suffixes-to-initial-alist alist))
-
-
-||#
-
 
 ; -----------------------------------------------------------------------------
 ;
@@ -555,18 +104,15 @@
 ;
 ; -----------------------------------------------------------------------------
 
-(defsection stv-expand-input-entry
+(define stv-expand-input-entry
   :parents (stv-compile)
   :short "Convert a single user-level input value (e.g., 17, X, abus, etc) into
 a list of @(see 4v-sexprs)."
 
-  :long "<p><b>Signature:</b> @(call stv-expand-input-entry) returns @('(mv
-new-val gensyms usersyms)').</p>
-
-<p>This function basically defines what each value in an :input line means.  We
-transform each such value into a list of @(see 4v-sexprs).  These are the
-sexprs that will be given to this input during this phase.  At a high level,
-our expansion strategy is:</p>
+  :long "<p>This function basically defines what each value in an :input line
+means.  We transform each such value into a list of @(see 4v-sexprs).  These
+are the sexprs that will be given to this input during this phase.  At a high
+level, our expansion strategy is:</p>
 
 <ul>
 
@@ -590,184 +136,170 @@
 <li><b>Simulation variables</b>.  A simulation variable like @('opcode') is
 turned into a list like @('(|opcode[0]| ... |opcode[n]|)').</li>
 
-</ul>
-
-<p>To support this strategy, this function takes a number of inputs.</p>
-
-<ul>
-
-<li>@('name') is the name of this input, and should be a list of E input bits
-in lsb-first order.  (That is, Verilog-style names should have already been
-expanded away using @(see stv-expand-names) or similar.)</li>
-
-<li>@('width') is the pre-computed width of this input, i.e., it must be
-exactly equal to @('(len name)').</li>
-
-<li>@('pnum') is the current phase number (and starts at 0).  We use this to
-know what suffix to put onto the generated variable names for @('_') values,
-e.g., @('|foo[0].P4|')</li>
-
-<li>@('entry') is the actual entry we are trying to expand.  For instance, it
-might be @('5'), @(':ones'), @('_'), or whatever else the user wrote down for
-this input at this phase number.</li>
-
-<li>@('gensyms') is a flat list of all the names we have generated so far for
-@('_') entries, which we may extend.  This allows us to check for name
-collisions later on.</li>
-
-<li>@('usersyms') is a fast alist that binds the names of simulation variables
-like @('opcode') to lists of bits that we generate for these symbols, i.e.,
-@('(opcode[0] ... opcode[n])').  This allows us to check for name collisions
-with generated symbols and width mismatches.  That is, we will allow the same
-variable to be given to multiple inputs at multiple phases, but for that to be
-sensible these inputs had better have the same width.</li>
-
-<li>@('prev-val') is the sexpr list that this signal expanded to in the
-previous phase, or NIL if this is the first phase of the simulation.  We use
-this to figure out the new value of a @('~') entry.</li>
-
 </ul>"
 
-  (defund stv-expand-input-entry (name width pnum entry gensyms usersyms prev-val)
-    (declare (xargs :guard (and (atom-listp name)
-                                (consp name)
-                                (natp pnum)
-                                (equal width (len name)))))
-    (b* (((when (natp entry))
-          (or (< entry (ash 1 width))
-              (er hard? 'stv-expand-input-entry
-                  "Phase ~x0 for ~x1: value ~x2 is too wide to fit in ~x3 ~
-                   bits!" pnum name entry width))
-          (mv (bool-to-4v-sexpr-lst (int-to-v entry width)) gensyms usersyms))
-
-         ((when (eq entry 'x))
-          (mv (repeat *4vx-sexpr* width) gensyms usersyms))
-
-         ((when (eq entry :ones))
-          (mv (repeat *4vt-sexpr* width) gensyms usersyms))
-
-         ((when (eq entry '~))
-          (or (= width 1)
-              (er hard? 'stv-expand-input-entry
-                  "Phase ~x0 for ~x1: value ~~ is not legal here.  It can ~
-                   only be used in one-bit inputs, but this input is ~x2 bits ~
-                   wide." pnum name width))
-          (or prev-val
-              (er hard? 'stv-expand-input-entry
-                  "Phase ~x0 for ~x1: value ~~ is not legal here.  It must be ~
-                   preceeded by a constant true or false, so it cannot be ~
-                   used at the start of a line." pnum name))
-          (or (equal prev-val (list *4vt-sexpr*))
-              (equal prev-val (list *4vf-sexpr*))
-              (er hard? 'stv-expand-input-entry
-                  "Phase ~x0 for ~x1: value ~~ is not legal here.  It must be ~
-                   preceeded by a constant true or false, but the previous ~
-                   value was ~x2." pnum name prev-val))
-          (mv (if (equal prev-val (list *4vt-sexpr*))
-                  (list *4vf-sexpr*)
-                (list *4vt-sexpr*))
-              gensyms usersyms))
-
-         ((when (eq entry '_))
-          (let ((my-syms (stv-suffix-signals name (str::cat ".P" (str::natstr pnum)))))
-            (mv my-syms
-                (append my-syms gensyms)
-                usersyms)))
-
-         ((unless (and (symbolp entry)
-                       (not (keywordp entry))))
-          (er hard? 'stv-expand-input-entry
-              "Phase ~x0 for ~x1: value ~x2 is not legal for input lines of ~
-               symbolic test vectors.  See :xdoc symbolic-test-vector-format ~
-               for help." pnum name entry)
-          (mv (repeat *4vx-sexpr* width) gensyms usersyms))
-
-         (my-syms (stv-gensyms (symbol-name entry) width))
-         (look    (hons-get entry usersyms)))
-
-      (or (not look)
-          (equal (cdr look) my-syms)
-          (er hard? 'stv-expand-input-entry
-              "Phase ~x0 for ~x1: variable ~x2 cannnot be used here.  This ~
-               input is ~x3 bits wide, but ~x2 was previously used for a ~
-               ~x4-bit input." pnum name entry width (len (cdr look))))
-      (mv my-syms gensyms (if look
-                              usersyms
-                            (hons-acons entry my-syms usersyms)))))
-
-  (local (in-theory (enable stv-expand-input-entry)))
-
+  ((name (and (atom-listp name)
+              (consp name))
+         "The name of this input, and should be a list of E input bits in
+          lsb-first order.  (That is, Verilog-style names should have already
+          been expanded away using @(see stv-expand-names) or similar.)")
+
+   (width (equal width (len name))
+          "Just the pre-computed width of this input.")
+
+   (pnum natp
+         "The current phase number (and starts at 0).  We use this to know what
+          suffix to put onto the generated variable names for @('_') values,
+          e.g., @('|foo[0].P4|').")
+
+   (entry "The actual entry we are trying to expand.  For instance, it might be
+           @('5'), @(':ones'), @('_'), or whatever else the user wrote down for
+           this input at this phase number.")
+
+   (gensyms "A flat list of all the names we have generated so far for @('_')
+             entries, which we may extend.  This allows us to check for name
+             collisions later on.")
+
+   (usersyms "A fast alist that binds the names of simulation variables like
+              @('opcode') to lists of bits that we generate for these symbols,
+              i.e., @('(opcode[0] ... opcode[n])').  This allows us to check
+              for name collisions with generated symbols and width mismatches.
+              That is, we will allow the same variable to be given to multiple
+              inputs at multiple phases, but for that to be sensible these
+              inputs had better have the same width.")
+
+   (prev-val "The sexpr list that this signal expanded to in the previous
+              phase, or NIL if this is the first phase of the simulation.  We
+              use this to figure out the new value of a @('~') entry."))
+
+  :returns (mv new-val gensyms usersyms)
+
+  (b* (((when (natp entry))
+        (or (< entry (ash 1 width))
+            (raise "Phase ~x0 for ~x1: value ~x2 is too wide to fit in ~x3 ~
+                    bits!" pnum name entry width))
+        (mv (bool-to-4v-sexpr-lst (int-to-v entry width)) gensyms usersyms))
+
+       ((when (eq entry 'x))
+        (mv (repeat *4vx-sexpr* width) gensyms usersyms))
+
+       ((when (eq entry :ones))
+        (mv (repeat *4vt-sexpr* width) gensyms usersyms))
+
+       ((when (eq entry '~))
+        (or (= width 1)
+            (raise "Phase ~x0 for ~x1: value ~~ is not legal here.  It can ~
+                    only be used in one-bit inputs, but this input is ~x2 ~
+                    bits wide." pnum name width))
+        (or prev-val
+            (raise "Phase ~x0 for ~x1: value ~~ is not legal here.  It must ~
+                    be preceeded by a constant true or false, so it cannot be ~
+                    used at the start of a line." pnum name))
+        (or (equal prev-val (list *4vt-sexpr*))
+            (equal prev-val (list *4vf-sexpr*))
+            (raise "Phase ~x0 for ~x1: value ~~ is not legal here.  It must ~
+                    be preceeded by a constant true or false, but the ~
+                    previous value was ~x2." pnum name prev-val))
+        (mv (if (equal prev-val (list *4vt-sexpr*))
+                (list *4vf-sexpr*)
+              (list *4vt-sexpr*))
+            gensyms usersyms))
+
+       ((when (eq entry '_))
+        (let ((my-syms (stv-suffix-signals name (str::cat ".P" (str::natstr pnum)))))
+          (mv my-syms
+              (append my-syms gensyms)
+              usersyms)))
+
+       ((unless (and (symbolp entry)
+                     (not (keywordp entry))))
+        (raise "Phase ~x0 for ~x1: value ~x2 is not legal for input lines of ~
+                symbolic test vectors.  See :xdoc symbolic-test-vector-format ~
+                for help." pnum name entry)
+        (mv (repeat *4vx-sexpr* width) gensyms usersyms))
+
+       (my-syms (stv-gensyms (symbol-name entry) width))
+       (look    (hons-get entry usersyms)))
+
+    (or (not look)
+        (equal (cdr look) my-syms)
+        (raise "Phase ~x0 for ~x1: variable ~x2 cannnot be used here.  This ~
+                input is ~x3 bits wide, but ~x2 was previously used for a ~
+                ~x4-bit input." pnum name entry width (len (cdr look))))
+    (mv my-syms gensyms (if look
+                            usersyms
+                          (hons-acons entry my-syms usersyms))))
+  ///
   (defthm true-listp-of-stv-expand-input-entry-gensyms
-    (let ((ret (stv-expand-input-entry name width pnum entry gensyms usersyms prev-val)))
-      (implies (true-listp gensyms)
-               (true-listp (mv-nth 1 ret))))))
+    (implies (true-listp gensyms)
+             (b* (((mv ?new-val gensyms ?usersyms)
+                   (stv-expand-input-entry name width pnum entry
+                                           gensyms usersyms prev-val)))
+               (true-listp gensyms)))))
 
 
-(defsection stv-expand-input-entries
+(define stv-expand-input-entries
   :parents (stv-compile)
   :short "Extend @(see stv-expand-input-entry) across a line."
-
-  (defund stv-expand-input-entries (name width pnum entries gensyms usersyms prev-val)
-    "Returns (MV NEW-ENTRIES GENSYMS USERSYMS)"
-    (declare (xargs :guard (and (atom-listp name)
-                                (consp name)
-                                (natp pnum)
-                                (equal width (len name))
-                                (true-listp entries))))
-    (b* (((when (atom entries))
-          (mv nil gensyms usersyms))
-         ((mv new-car gensyms usersyms)
-          (stv-expand-input-entry name width pnum (car entries)
-                                  gensyms usersyms prev-val))
-         ((mv new-cdr gensyms usersyms)
-          (stv-expand-input-entries name width (+ 1 pnum) (cdr entries)
-                                    gensyms usersyms new-car)))
-      (mv (cons new-car new-cdr) gensyms usersyms)))
-
-  (local (in-theory (enable stv-expand-input-entries)))
-
+  ((name (and (atom-listp name)
+              (consp name)))
+   (width (equal width (len name)))
+   (pnum natp)
+   (entries true-listp)
+   gensyms
+   usersyms
+   prev-val)
+  :returns (mv new-entries gensyms usersyms)
+
+  (b* (((when (atom entries))
+        (mv nil gensyms usersyms))
+       ((mv new-car gensyms usersyms)
+        (stv-expand-input-entry name width pnum (car entries)
+                                gensyms usersyms prev-val))
+       ((mv new-cdr gensyms usersyms)
+        (stv-expand-input-entries name width (+ 1 pnum) (cdr entries)
+                                  gensyms usersyms new-car)))
+    (mv (cons new-car new-cdr) gensyms usersyms))
+  ///
   (defmvtypes stv-expand-input-entries (true-listp nil nil))
 
   (defthm true-listp-of-stv-expand-input-entries-gensyms
-    (let ((ret (stv-expand-input-entries name width pnum entries gensyms usersyms prev-val)))
-      (implies (true-listp gensyms)
-               (true-listp (mv-nth 1 ret))))))
+    (implies (true-listp gensyms)
+             (b* (((mv ?new-entries gensyms ?usersyms)
+                   (stv-expand-input-entries name width pnum entries
+                                             gensyms usersyms prev-val)))
+               (true-listp gensyms)))))
 
 
-(defsection stv-expand-input-lines
+(define stv-expand-input-lines
   :parents (stv-compile)
   :short "Extend @(see stv-expand-input-entry) across a list of lines."
-
-  (defund stv-expand-input-lines (lines gensyms usersyms)
-    "Returns (MV NEW-LINES GENSYMS USERSYMS)"
-    (declare (xargs :guard (true-list-listp lines)))
-    (b* (((when (atom lines))
-          (mv nil gensyms usersyms))
-         (line1 (car lines))
-         ((cons name1 entries1) line1)
-
-         ((unless (and (consp name1)
-                       (atom-listp name1)))
-          (er hard? 'stv-expand-input-lines
-              "Expected all input line names to be already expanded to ~
-               non-empty lists of E bits, but found ~x0." name1)
-          (mv nil gensyms usersyms))
-
-         ((mv new-entries1 gensyms usersyms)
-          (stv-expand-input-entries name1 (len name1) 0 entries1 gensyms usersyms nil))
-         (new-car (cons name1 new-entries1))
-         ((mv new-cdr gensyms usersyms)
-          (stv-expand-input-lines (cdr lines) gensyms usersyms)))
-      (mv (cons new-car new-cdr) gensyms usersyms)))
-
-  (local (in-theory (enable stv-expand-input-lines)))
-
+  ((lines true-list-listp)
+   gensyms
+   usersyms)
+  :returns (mv (new-lines true-list-listp)
+               gensyms
+               usersyms)
+  (b* (((when (atom lines))
+        (mv nil gensyms usersyms))
+       (line1 (car lines))
+       ((cons name1 entries1) line1)
+
+       ((unless (and (consp name1)
+                     (atom-listp name1)))
+        (raise "Expected all input line names to be already expanded to ~
+                non-empty lists of E bits, but found ~x0." name1)
+        (mv nil gensyms usersyms))
+
+       ((mv new-entries1 gensyms usersyms)
+        (stv-expand-input-entries name1 (len name1) 0 entries1 gensyms usersyms nil))
+       (new-car (cons name1 new-entries1))
+       ((mv new-cdr gensyms usersyms)
+        (stv-expand-input-lines (cdr lines) gensyms usersyms)))
+    (mv (cons new-car new-cdr) gensyms usersyms))
+  ///
   (defmvtypes stv-expand-input-lines (true-listp nil nil))
 
-  (defthm true-list-listp-of-stv-expand-input-lines
-    (let ((ret (stv-expand-input-lines lines gensyms usersyms)))
-      (true-list-listp (mv-nth 0 ret))))
-
   (defthm true-listp-of-stv-expand-input-lines-gensyms
     (let ((ret (stv-expand-input-lines lines gensyms usersyms)))
       (implies (true-listp gensyms)
@@ -781,25 +313,39 @@
 ;
 ; -----------------------------------------------------------------------------
 
-(defsection stv-restrict-alist
+(define stv-restrict-alist-aux ((name atom-listp)
+                                (phase natp)
+                                entries
+                                acc)
+  :returns (acc alistp :hyp (alistp acc))
+  :parents (stv-restrict-alist)
+  (b* (((when (atom entries))
+        acc)
+       (name-at-phase (stv-suffix-signals name (str::cat ".P" (str::natstr phase))))
+       (val-at-phase  (car entries))
+       (acc           (safe-pairlis-onto-acc name-at-phase val-at-phase acc)))
+    (stv-restrict-alist-aux name (+ 1 phase) (cdr entries) acc)))
+
+(define stv-restrict-alist
   :parents (stv-compile)
   :short "Construct an alist binding fully-general input names (for all phases)
 to @(see 4v-sexprs) derived from the symbolic test vector."
 
-  :long "<p>@(call stv-restrict-alist) produces an alist.</p>
-
-<p>@('lines') are the output from @(see stv-expand-input-lines).  We expect
-that the lines have been widened, had their names resolved into E bits, and had
-their entries turned into 4v-sexpr lists.</p>
-
-<p>@('acc') is an alist that we extend.  Typically it is the alist that has the
-@(':initial') bindings.</p>
-
-<p>We construct an ordinary (slow) alist that binds the input names we are
-going to use in our fully-general simulation to their bindings according to the
-symbolic test vector.  This is a single alist that includes the bindings for
-the variables at all phases, plus (presumably, via acc) any initial bindings
-for state bits.</p>
+  ((lines true-list-listp
+          "The output from @(see stv-expand-input-lines).  That is, these
+           should STV input lines that have already been widened, had their
+           names resolved into E bits, and had their entries turned into
+           4v-sexpr lists.")
+   (acc "An alist that we extend.  Typically it is the alist that has the
+         @(':initial') bindings."))
+
+  :returns (restrict-alist alistp :hyp (alistp acc))
+
+  :long "<p>We construct an ordinary (slow) alist that binds the input names we
+are going to use in our fully-general @(see esim) simulation to their bindings
+according to the symbolic test vector.  This is a single alist that includes
+the bindings for the variables at all phases, plus (presumably, via acc) any
+initial bindings for state bits.</p>
 
 <p>The sexprs in this alist will often be constants (e.g., when natural
 numbers, @(':ones'), @('x'), or @('~') values are used), but they can also have
@@ -809,27 +355,14 @@
 with @(see 4v-sexpr-restrict) to specialize the fully general simulation,
 effectively \"assuming\" the STV.</p>"
 
-  (defund stv-restrict-alist-aux (name phase entries acc)
-    (declare (xargs :guard (and (atom-listp name)
-                                (natp phase))))
-    (b* (((when (atom entries))
-          acc)
-         (name-at-phase (stv-suffix-signals name (str::cat ".P" (str::natstr phase))))
-         (val-at-phase  (car entries))
-         (acc           (safe-pairlis-onto-acc name-at-phase val-at-phase acc)))
-      (stv-restrict-alist-aux name (+ 1 phase) (cdr entries) acc)))
-
-  (defund stv-restrict-alist (lines acc)
-    (declare (xargs :guard (true-list-listp lines)))
     (b* (((when (atom lines))
           acc)
          (line1 (car lines))
          ((cons name entries) line1)
          ((unless (atom-listp name))
-          (er hard? 'stv-restrict-alist
-              "Name should be a list of E bits, but is ~x0." name))
+          (raise "Name should be a list of E bits, but is ~x0." name))
          (acc (stv-restrict-alist-aux name 0 entries acc)))
-      (stv-restrict-alist (cdr lines) acc))))
+      (stv-restrict-alist (cdr lines) acc)))
 
 
 
@@ -839,135 +372,113 @@
 ;
 ; -----------------------------------------------------------------------------
 
-(defsection stv-expand-output-entry
+(define stv-expand-output-entry
   :parents (stv-compile)
   :short "Convert a single user-level output/internal value (e.g., _, result)
 into a list of @(see 4v-sexprs)."
 
-  :long "<p><b>Signature:</b> @(call stv-expand-output-entry) returns @('(mv
-new-val usersyms)').</p>
-
-<p>The only valid entries for output lines are @('_') (for signals we don't
-care about) and simulation variables.  Here, we just leave any @('_') values
-alone, but we replace simulation variables with lists of new variables that we
-generate from their names.  That is, a simulation variable like @('result')
-will be converted into a list of bits like @('(result[0] ... result[4])').</p>
-
-<p>We are given:</p>
-
-<ul>
-
-<li>@('name') is the name of this output.  It should be a list of E input bits
-in lsb-first order.  That is, Verilog-style names should have already been
-expanded away using @(see stv-expand-names) or similar.</li>
-
-<li>@('width') is the pre-computed width of this output.  It must be exactly
-equal to @('(len name)').  This lets us know how many variables to generate
-when we hit a simulation variable.</li>
-
-<li>@('pnum') is the current phase number (and starts at 0).  This is
-semantically irrelevant; we use it only to generate better error messages.</li>
-
-<li>@('entry') is the actual entry we are trying to expand, i.e., it's what the
-user wrote down for this output at this phase.  To be well-formed, the entry
-needs to be @('_') or a simulation variable, but the user can write down
-anything so we have to check that it is valid.</li>
-
-<li>@('usersyms') is a fast alist binding simulation variables to the lists of
-bits that we've generated to represent them.  We assume this only contains the
-output simulation variables.  This lets us make sure that output variables
-aren't being reused.</li>
+  :long "<p>The only valid entries for output lines are @('_') (for signals we
+don't care about) and simulation variables.  Here, we just leave any @('_')
+values alone, but we replace simulation variables with lists of new variables
+that we generate from their names.  That is, a simulation variable like
+@('result') will be converted into a list of bits like @('(result[0]
+... result[4])').</p>"
+
+  ((name (and (true-listp name)
+              (consp name))
+         "The name of this output.  It should be a list of E input bits in
+          lsb-first order.  That is, Verilog-style names should have already
+          been expanded away using @(see stv-expand-names) or similar.")
+
+   (width (equal width (len name))
+          "Just the pre-computed width of this output.  It must be exactly
+           equal to @('(len name)').  This lets us know how many variables to
+           generate when we hit a simulation variable.")
+
+   (pnum natp
+         "The current phase number (and starts at 0).  This is semantically
+          irrelevant; we use it only to generate better error messages.")
+
+   (entry "The actual entry we are trying to expand, i.e., it's what the user
+           wrote down for this output at this phase.  To be well-formed, the
+           entry needs to be @('_') or a simulation variable, but the user can
+           write down anything so we have to check that it is valid.")
+
+   (usersyms "A fast alist binding simulation variables to the lists of bits
+              that we've generated to represent them.  We assume this only
+              contains the output simulation variables.  This lets us make sure
+              that output variables aren't being reused."))
+
+  :returns (mv new-val usersyms)
+
+  (b* (((when (or (natp entry)
+                  (eq entry 'x)
+                  (eq entry '~)
+                  (keywordp entry)
+                  (not (symbolp entry))))
+        (raise "Phase ~x0 for ~x1: value ~x2 is not legal for :output lines."
+               pnum name entry)
+        (mv nil usersyms))
+
+       ((when (eq entry '_))
+        ;; That's fine, just leave it alone.
+        (mv entry usersyms))
+
+       ;; Else, a simulation variable.  It had better not be used yet.
+       (look (hons-get entry usersyms))
+       ((when look)
+        (raise "Phase ~x0 for ~x1: variable ~x2 is already in use, so it ~
+                cannot be used again." pnum name entry)
+        (mv nil usersyms))
+
+       ;; Okay it wasn't used.  Make its symbols and such.
+       (my-syms  (stv-gensyms (symbol-name entry) width))
+       (usersyms (hons-acons entry my-syms usersyms)))
+    (mv my-syms usersyms)))
 
-</ul>"
-
-  (defund stv-expand-output-entry (name width pnum entry usersyms)
-    "Returns (MV NEW-VAL USERSYMS)"
-    (declare (xargs :guard (and (true-listp name)
-                                (consp name)
-                                (natp pnum)
-                                (equal width (len name)))))
-    (b* (((when (or (natp entry)
-                    (eq entry 'x)
-                    (eq entry '~)
-                    (keywordp entry)
-                    (not (symbolp entry))))
-          (er hard? 'stv-expand-output-entry
-              "Phase ~x0 for ~x1: value ~x2 is not legal for :output lines."
-              pnum name entry)
-          (mv nil usersyms))
-
-         ((when (eq entry '_))
-          ;; That's fine, just leave it alone.
-          (mv entry usersyms))
-
-         ;; Else, a simulation variable.  It had better not be used yet.
-         (look (hons-get entry usersyms))
-         ((when look)
-          (er hard? 'stv-expand-output-entry
-              "Phase ~x0 for ~x1: variable ~x2 is already in use, so it ~
-               cannot be used again." pnum name entry)
-          (mv nil usersyms))
-
-         ;; Okay it wasn't used.  Make its symbols and such.
-         (my-syms  (stv-gensyms (symbol-name entry) width))
-         (usersyms (hons-acons entry my-syms usersyms)))
-      (mv my-syms usersyms))))
-
-
-(defsection stv-expand-output-entries
+(define stv-expand-output-entries
   :parents (stv-compile)
   :short "Extend @(see stv-expand-output-entry) across a line."
+  ((name    (and (true-listp name) (consp name)))
+   (width   (equal width (len name)))
+   (pnum    natp)
+   (entries true-listp)
+   usersyms)
+  :returns (mv (new-entries true-listp :rule-classes :type-prescription)
+               usersyms)
+  (b* (((when (atom entries))
+        (mv nil usersyms))
+       ((mv new-car usersyms)
+        (stv-expand-output-entry name width pnum (car entries) usersyms))
+       ((mv new-cdr usersyms)
+        (stv-expand-output-entries name width (+ 1 pnum) (cdr entries) usersyms)))
+    (mv (cons new-car new-cdr) usersyms)))
 
-  (defund stv-expand-output-entries (name width pnum entries usersyms)
-    "Returns (MV NEW-ENTRIES USERSYMS)"
-    (declare (xargs :guard (and (true-listp name)
-                                (consp name)
-                                (natp pnum)
-                                (equal width (len name))
-                                (true-listp entries))))
-    (b* (((when (atom entries))
-          (mv nil usersyms))
-         ((mv new-car usersyms)
-          (stv-expand-output-entry name width pnum (car entries) usersyms))
-         ((mv new-cdr usersyms)
-          (stv-expand-output-entries name width (+ 1 pnum) (cdr entries) usersyms)))
-      (mv (cons new-car new-cdr) usersyms)))
-
-  (defmvtypes stv-expand-output-entries (true-listp nil)))
-
-
-(defsection stv-expand-output-lines
+(define stv-expand-output-lines
   :parents (stv-compile)
   :short "Extend @(see stv-expand-output-entry) across a list of lines."
 
-  (defund stv-expand-output-lines (lines usersyms)
-    "Returns (MV NEW-LINES USERSYMS)"
-    (declare (xargs :guard (true-list-listp lines)))
-    (b* (((when (atom lines))
-          (mv nil usersyms))
-         (line1 (car lines))
-         ((cons name1 entries1) line1)
-
-         ((unless (and (consp name1)
-                       (atom-listp name1)))
-          (er hard? 'stv-expand-output-lines
-              "Expected :output line names to be already expanded to non-empty ~
-               lists of E bits, but found ~x0." name1)
-          (mv nil usersyms))
-
-         ((mv new-entries1 usersyms)
-          (stv-expand-output-entries name1 (len name1) 0 entries1 usersyms))
-
-         (new-car (cons name1 new-entries1))
-         ((mv new-cdr usersyms)
-          (stv-expand-output-lines (cdr lines) usersyms)))
-      (mv (cons new-car new-cdr) usersyms)))
-
-  (local (in-theory (enable stv-expand-output-lines)))
-
-  (defthm true-list-listp-of-stv-expand-output-lines
-    (let ((ret (stv-expand-output-lines lines usersyms)))
-      (true-list-listp (mv-nth 0 ret)))))
+  ((lines true-list-listp) usersyms)
+  :returns (mv (new-lines true-list-listp)
+               usersyms)
+  (b* (((when (atom lines))
+        (mv nil usersyms))
+       (line1 (car lines))
+       ((cons name1 entries1) line1)
+
+       ((unless (and (consp name1)
+                     (atom-listp name1)))
+        (raise "Expected :output line names to be already expanded to ~
+                non-empty lists of E bits, but found ~x0." name1)
+        (mv nil usersyms))
+
+       ((mv new-entries1 usersyms)
+        (stv-expand-output-entries name1 (len name1) 0 entries1 usersyms))
+
+       (new-car (cons name1 new-entries1))
+       ((mv new-cdr usersyms)
+        (stv-expand-output-lines (cdr lines) usersyms)))
+    (mv (cons new-car new-cdr) usersyms)))
 
 
 
@@ -980,59 +491,50 @@
 ; These are almost the same as output lines.  The only difference is that we
 ; need to canonicalize their paths.
 
-(defsection stv-expand-internal-line
+(define stv-expand-internal-line
   :parents (stv-compile)
+  ((line true-listp)
+   usersyms
+   (mod good-esim-modulep))
+  :returns (mv (new-line true-listp :rule-classes :type-prescription)
+               usersyms)
+  (b* (((cons name entries) line)
+       ((unless (and (consp name)
+                     (true-listp name)))
+        (raise "Expected :internal line names to be already expanded to ~
+                non-empty lists of E paths, but found ~x0." name)
+        (mv nil usersyms))
+
+       ;; The ESIM simulation only involves canonical paths, so to be able to
+       ;; extract the right paths we need to canonicalize these paths.
+       ((mv okp new-name) (fast-canonicalize-paths name mod))
+       ((unless okp)
+        (raise "Failed to canonicalize all the paths for ~x0." name)
+        (mv nil usersyms))
+       ((mv new-entries usersyms)
+        (stv-expand-output-entries new-name (len new-name) 0 entries usersyms))
+       (new-line (cons new-name new-entries)))
+    (mv new-line usersyms))
+  :prepwork
+  ((local (defthm fast-canonicalize-paths-1-under-iff
+            (iff (mv-nth 1 (fast-canonicalize-paths paths mod))
+                 (consp paths))
+            :hints(("Goal" :in-theory (enable fast-canonicalize-paths)))))))
 
-  (local (defthm fast-canonicalize-paths-1-under-iff
-           (iff (mv-nth 1 (fast-canonicalize-paths paths mod))
-                (consp paths))
-           :hints(("Goal" :in-theory (enable fast-canonicalize-paths)))))
-
-  (defund stv-expand-internal-line (line usersyms mod)
-    "Returns (MV NEW-LINE USERSYMS)"
-    (declare (xargs :guard (and (true-listp line)
-                                (good-esim-modulep mod))))
-    (b* (((cons name entries) line)
-
-         ((unless (and (consp name)
-                       (true-listp name)))
-          (er hard? 'stv-expand-internal-lines
-              "Expected :internal line names to be already expanded to non-empty ~
-               lists of E paths, but found ~x0." name)
-          (mv nil usersyms))
-
-         ;; The ESIM simulation only involves canonical paths, so to be able to
-         ;; extract the right paths we need to canonicalize these paths.
-         ((mv okp new-name) (fast-canonicalize-paths name mod))
-         ((unless okp)
-          (er hard? 'stv-expand-internal-lines
-              "Failed to canonicalize all the paths for ~x0." name)
-          (mv nil usersyms))
-
-         ((mv new-entries usersyms)
-          (stv-expand-output-entries new-name (len new-name) 0 entries usersyms))
-
-         (new-line (cons new-name new-entries)))
-      (mv new-line usersyms)))
-
-  (defmvtypes stv-expand-internal-line (true-listp nil)))
-
-
-(defsection stv-expand-internal-lines
+(define stv-expand-internal-lines
   :parents (stv-compile)
   :short "Extend @(see stv-expand-internal-line) across a list of lines."
+  ((lines true-list-listp)
+   (usersyms)
+   (mod good-esim-modulep))
+  :returns (mv (new-lines true-list-listp)
+               usersyms)
+  (b* (((when (atom lines))
+        (mv nil usersyms))
+       ((mv line1 usersyms) (stv-expand-internal-line (car lines) usersyms mod))
+       ((mv lines2 usersyms) (stv-expand-internal-lines (cdr lines) usersyms mod)))
+    (mv (cons line1 lines2) usersyms)))
 
-  (defund stv-expand-internal-lines (lines usersyms mod)
-    "Returns (MV NEW-LINES USERSYMS)"
-    (declare (xargs :guard (and (true-list-listp lines)
-                                (good-esim-modulep mod))))
-    (b* (((when (atom lines))
-          (mv nil usersyms))
-         ((mv line1 usersyms) (stv-expand-internal-line (car lines) usersyms mod))
-         ((mv lines2 usersyms) (stv-expand-internal-lines (cdr lines) usersyms mod)))
-      (mv (cons line1 lines2) usersyms)))
-
-  (defmvtypes stv-expand-internal-lines (true-list-listp nil)))
 
 
 ; -----------------------------------------------------------------------------
@@ -1041,18 +543,39 @@
 ;
 ; -----------------------------------------------------------------------------
 
-(defsection stv-extraction-alists
+(define stv-nth-extraction-alist
+  :parents (stv-extraction-alists)
+  :short "Add the bindings for name to entryN to the NTH-ALIST-ACC"
+  ((n             natp)
+   (lines         true-list-listp   "A list of (name entry1 ... entryK)")
+   (nth-alist-acc alistp))
+   (b* (((when (atom lines))
+         nth-alist-acc)
+        (line1 (car lines))
+        ((cons name entries) line1)
+        (entry (nth n entries))
+        ((when (eq entry '_))
+         ;; Don't care about this output at this time.  Keep going.
+         (stv-nth-extraction-alist n (cdr lines) nth-alist-acc))
+        (nth-alist-acc (safe-pairlis-onto-acc name entry nth-alist-acc)))
+     (stv-nth-extraction-alist n (cdr lines) nth-alist-acc)))
+
+(define stv-extraction-alists
   :parents (stv-compile)
   :short "Alists explaining what signals we want to extract from the simulation
 after each phase."
+  ((n          natp            "Initially this is the total number of phases.
+                                It will counts down from the max phase to 0.")
+
+   (lines      true-list-listp "Constant.  Expanded output or internals lines.")
+
+   (alists-acc "Accumulator, initially nil."))
 
-  :long "<p>@(call stv-extraction-alists) takes the total number of phases, the
-output or internal lines (which we assume have already been expanded), and an
-accumulator which should initially be @('nil').</p>
-
-<p>It returns a list of alists that say, after each step, which output bits we
-want to collect, and how we want to name them.  The basic idea is that if we have
-a list of outputs like this:</p>
+  :returns (alists-acc "A list of alists that say, after each step, which
+                        output bits we want to collect, and how to name them."
+                       true-listp :hyp (true-listp alists-acc))
+
+  :long "<p>The basic idea is that if we have a list of outputs lines like:</p>
 
 @({
    (foo  _ _ a _)
@@ -1085,32 +608,317 @@
 phase, the names of the output signals we want to extract from the simulation,
 and which bit of which simulation variable the name corresponds to.</p>"
 
-  (defund stv-nth-extraction-alist (n lines nth-alist-acc)
-    "Lines are (name entry1 ... entryK)
-     Add the bindings for name to entryN to the NTH-ALIST-ACC"
-    (declare (xargs :guard (and (natp n)
-                                (true-list-listp lines))))
-    (b* (((when (atom lines))
-          nth-alist-acc)
-         (line1 (car lines))
-         ((cons name entries) line1)
-         (entry (nth n entries))
-         ((when (eq entry '_))
-          ;; Don't care about this output at this time.  Keep going.
-          (stv-nth-extraction-alist n (cdr lines) nth-alist-acc))
-         (nth-alist-acc (safe-pairlis-onto-acc name entry nth-alist-acc)))
-      (stv-nth-extraction-alist n (cdr lines) nth-alist-acc)))
-
-  (defund stv-extraction-alists (n lines alists-acc)
-    "N counts down from the max phase to zero.  Lines are constant.
-     We return the list of binding alists, in the proper phase order."
-    (declare (xargs :guard (and (natp n)
-                                (true-list-listp lines))))
-    (let* ((nth-alist  (stv-nth-extraction-alist n lines nil))
-           (alists-acc (cons nth-alist alists-acc)))
-      (if (zp n)
-          alists-acc
-        (stv-extraction-alists (- n 1) lines alists-acc)))))
+  (let* ((nth-alist  (stv-nth-extraction-alist n lines nil))
+         (alists-acc (cons nth-alist alists-acc)))
+    (if (zp n)
+        alists-acc
+      (stv-extraction-alists (- n 1) lines alists-acc))))
+
+
+
+; -----------------------------------------------------------------------------
+;
+;                         COMPILING :OVERRIDE LINES
+;
+; -----------------------------------------------------------------------------
+
+(define stv-append-alist-keys ((lines))
+  :returns (name-bits "Flat list of paths from the car of each line."
+                      true-listp :rule-classes :type-prescription)
+  (if (atom lines)
+      nil
+    (append-without-guard (and (consp (car lines)) (caar lines))
+                          (stv-append-alist-keys (cdr lines)))))
+
+(define stv-cut-module
+  ((override-paths "Already expanded path to every signal we want to override.
+                    These are paths to real wire in the module, e.g., foo
+                    instead of foo<override_value> or similar."
+                   true-listp)
+   (mod            good-esim-modulep))
+  :returns (new-mod good-esim-modulep "The cut module." :hyp :guard)
+  (b* ((new-mod (ecut-module override-paths mod))
+       ((unless (good-esim-modulep new-mod))
+        (raise "Ecut failed to produce a good esim module: ~@0"
+               (bad-esim-modulep new-mod))
+        mod))
+    new-mod))
+
+(define stv-expand-override-entry
+  ((name "The name of this override line.  This will be a list of E paths."
+         (and (consp name)
+              (true-listp name)))
+   (width "Pre-computed width of the name."
+          (equal (len name) width))
+   (pnum  "Current phase number (may not be necessary for anything, but lets
+           us generate better error messages.)"
+          natp)
+   (entry "The actual entry we're trying to expand.")
+   (in-usersyms
+    "Fast alist binding simulation variables to lists of bits that we've
+     generated to represent them.  We assume this contains only the input
+     variables.")
+   (out-usersyms
+    "Same, but for outputs."))
+  :returns
+  (mv (in-value-sexprs)
+      (in-decision-sexprs)
+      (out-value-vars   "either a list of variables or a _")
+      (new-in-usersyms)
+      (new-out-usersyms))
+  (b* (((when (natp entry))
+        (or (< entry (ash 1 width))
+            (raise "Phase ~x0 for ~x1: value ~x2 is too wide to fit in ~x3 ~
+                    bits!" pnum name entry width))
+        (mv (bool-to-4v-sexpr-lst (int-to-v entry width))
+            (repeat *4vt-sexpr* width)
+            '_
+            in-usersyms
+            out-usersyms))
+
+       ((when (eq entry 'x))
+        (mv (repeat *4vx-sexpr* width)
+            (repeat *4vt-sexpr* width)
+            '_
+            in-usersyms
+            out-usersyms))
+
+       ((when (eq entry :ones))
+        (mv (repeat *4vt-sexpr* width)
+            (repeat *4vt-sexpr* width)
+            '_
+            in-usersyms
+            out-usersyms))
+
+       ((when (eq entry '~))
+        (raise "Phase ~x0 for ~x1: value ~~ is not legal on overrides." pnum name)
+        (mv (repeat *4vx-sexpr* width)
+            (repeat *4vt-sexpr* width)
+            '_
+            in-usersyms
+            out-usersyms))
+
+       ((when (eq entry '_))
+        (mv (repeat *4vx-sexpr* width)
+            (repeat *4vf-sexpr* width)
+            '_
+            in-usersyms
+            out-usersyms))
+
+       ((unless (and (symbolp entry)
+                     (not (keywordp entry))))
+        (raise "Phase ~x0 for ~x1: value ~x2 is not legal for override lines of ~
+                symbolic test vectors.  See :xdoc symbolic-test-vector-format ~
+                for help." pnum name entry)
+        (mv (repeat *4vx-sexpr* width)
+            (repeat *4vt-sexpr* width)
+            '_
+            in-usersyms
+            out-usersyms))
+
+       (my-syms (stv-gensyms (symbol-name entry) width))
+       (out-look    (hons-get entry out-usersyms))
+       (in-look    (hons-get entry in-usersyms)))
+
+    (and out-look
+         (raise "Phase ~x0 for ~x1: variable ~x2 is already in use, so it ~
+                 cannot be used again."
+          pnum name entry))
+
+    (or (not in-look)
+        (equal (cdr in-look) my-syms)
+        (raise "Phase ~x0 for ~x1: variable ~x2 cannnot be used here.  This ~
+                override is ~x3 bits wide, but ~x2 was previously used for a ~
+                ~x4-bit wire." pnum name entry width (len (cdr in-look))))
+
+    (mv my-syms
+        (repeat *4vt-sexpr* width)
+        my-syms
+        (if in-look in-usersyms (hons-acons entry my-syms in-usersyms))
+        (hons-acons entry my-syms out-usersyms))))
+
+
+(define stv-expand-override-entries
+  ((name "The name of this override line.  This will be a list of E paths."
+         (and (consp name)
+              (true-listp name)))
+   (width "Pre-computed width of the name."
+          (equal (len name) width))
+   (pnum  "Current phase number (may not be necessary for anything, but lets
+           us generate better error messages.)"
+          natp)
+   (entries "The rest of the entries")
+   (in-usersyms
+    "Fast alist binding simulation variables to lists of bits that we've
+     generated to represent them.  We assume this contains only the input
+     variables.")
+   (out-usersyms
+    "Same, but for outputs."))
+  :returns
+  (mv (in-value-entries    true-listp)
+      (in-decision-entries true-listp)
+      (out-value-entries   true-listp)
+      (new-in-usersyms)
+      (new-out-usersyms))
+  (b* (((when (atom entries))
+        (mv nil nil nil in-usersyms out-usersyms))
+       ((mv first-values first-decisions first-outs in-usersyms out-usersyms)
+        (stv-expand-override-entry
+         name width pnum (car entries) in-usersyms out-usersyms))
+       ((mv rest-values rest-decisions rest-outs in-usersyms out-usersyms)
+        (stv-expand-override-entries
+         name width (+ 1 pnum) (cdr entries) in-usersyms out-usersyms)))
+    (mv (cons first-values rest-values)
+        (cons first-decisions rest-decisions)
+        (cons first-outs rest-outs)
+        in-usersyms out-usersyms)))
+
+(define stv-forge-state-bit ((instnames "List of instance names")
+                             (st-name atom))
+  :returns (full-name atom :hyp :guard)
+  :parents (stv-compile)
+  :short "Generate the name for a state bit, like @('foo!bar!baz!inst!S'),
+given a list of instance names and the name of the state bit."
+  ;; BOZO have to keep this in sync with mod-state/occ-state
+  (if (atom instnames)
+      st-name
+    (acl2::prefix-atom (acl2::stringify (car instnames))
+                       "!"
+                       (stv-forge-state-bit (cdr instnames) st-name))))
+
+(cutil::defprojection stv-forge-state-bits (instnames x)
+  (stv-forge-state-bit instnames x)
+  :guard (atom-listp x)
+  :result-type atom-listp)
+
+
+(define stv-path-to-override-value-instnames (path)
+  :returns (st-path)
+  (if (atom path)
+      (if (symbolp path)
+          (list (ecutnames->value-reg (ecut-wire-names path)))
+        (raise "end of path isn't a symbol"))
+    (cons (car path) (stv-path-to-override-value-instnames (cdr path)))))
+
+(define stv-path-to-override-value-stbit (path)
+  :returns (st)
+  (stv-forge-state-bit (stv-path-to-override-value-instnames path)
+                       "S"))
+
+(define stv-path-to-override-decision-instnames (path)
+  :returns (st-path)
+  (if (atom path)
+      (if (symbolp path)
+          (list (ecutnames->decision-reg (ecut-wire-names path)))
+        (raise "end of path isn't a symbol"))
+    (cons (car path) (stv-path-to-override-decision-instnames (cdr path)))))
+
+(define stv-path-to-override-decision-stbit (path)
+  :returns (st)
+  (stv-forge-state-bit (stv-path-to-override-decision-instnames path)
+                       "S"))
+
+(cutil::defprojection stv-paths-to-override-value-stbits (x)
+  (stv-path-to-override-value-stbit x)
+  :guard t)
+
+(cutil::defprojection stv-paths-to-override-decision-stbits (x)
+  (stv-path-to-override-decision-stbit x)
+  :guard t)
+
+
+
+
+
+(define stv-expand-override-lines
+  ((lines "all the override lines, names already expanded into paths"
+          true-list-listp)
+   in-usersyms out-usersyms)
+  :returns (mv (in-table true-list-listp)
+               (out-table true-list-listp)
+               new-in-usersyms new-out-usersyms)
+  (b* (((when (atom lines))
+        (mv nil nil in-usersyms out-usersyms))
+       ((cons name entries) (car lines))
+       ((unless (and (consp name) (true-listp name)))
+        (raise "Programming error: malformed name ~x0" name)
+        (mv nil nil in-usersyms out-usersyms))
+       ((mv val-entries decision-entries out-entries in-usersyms out-usersyms)
+        (stv-expand-override-entries
+         name (len name) 0 entries in-usersyms out-usersyms))
+
+       (val-stbits (stv-paths-to-override-value-stbits name))
+       (dec-stbits (stv-paths-to-override-decision-stbits name))
+
+       (in-val-line (cons val-stbits val-entries))
+       (in-dec-line (cons dec-stbits decision-entries))
+
+       (out-line (cons val-stbits out-entries))
+
+       ((mv in-table out-table in-usersyms out-usersyms)
+        (stv-expand-override-lines (cdr lines) in-usersyms out-usersyms)))
+    (mv (cons in-val-line (cons in-dec-line in-table))
+        (cons out-line out-table)
+        in-usersyms out-usersyms)))
+
+
+#||
+(stv-expand-override-lines
+ '((;; name
+    ((a b . c[0])
+     (a b . c[1]))
+    ;; entries
+    0
+    X
+    :ones
+    a
+    b
+    2
+    _))
+ nil
+ nil)
+||#
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#||
+
+(include-book
+ "stv-expand")
+
+(defconst *s0*
+  (make-stvdata :inputs nil
+                :outputs nil
+                :internals nil
+                :initial '(("mmxcntl.rsMmxSrc3_I" src3i)
+                             ("mmxcntl.rsMmxSrc2_I[4:2]" _)
+                             ("mmxcntl.rsMmxSrc2_I[0]" 1)
+                             ("mmxcntl.rsFeuBIBus_I[16:0]" bibus))))
+
+(defconst *s1*
+  (stv-expand *s0* |*mmx*|))
+
+(b* (((mv alist ?usersyms)
+      (stv-initial-lines-to-alist (stvdata->initial *s1*) nil |*mmx*|)))
+  (stv-add-suffixes-to-initial-alist alist))
+
+
+||#
 
 
 
@@ -1120,34 +928,37 @@
 ;
 ; -----------------------------------------------------------------------------
 
-(defsection stv-compile
+(define stv-compile
   :parents (symbolic-test-vectors)
   :short "Syntactically transform a symbolic test vector, readying it for
 evaluation, debugging, etc."
 
-  :long "<p><b>Signature:</b> @(call stv-compile) returns a @(see
-compiled-stv-p).</p>
-
-<p>Here, @('mod') should be a valid @(see esim) module, and @('stv') should be
-an @(see stvdata-p) that has already had its lines widened and any
-Verilog-style names expanded; see for instance @(see stv-widen) and @(see
-stv-expand-names).</p>
-
-<p>Compiling an STV involves doing lots of error checking to ensure the STV is
-syntactically well-formed, only refers to legitimate inputs and outputs, and so
-forth.  After sanity checking, our basic goal is to compile the STV into a form
-that functions like @(see stv-run) and @(see stv-debug) can efficiently
-process.</p>
-
-<p>In particular, after compiling an STV we obtain an @(see compiled-stv-p)
-structure that says says how many steps we need to run for, explains the
-mappings from user-level simulation variables to their internal bit-encodings,
-and and has pre-computed alists for restricting the a @(see esim) run and
-extracting the results.</p>
-
-<p>Compilation is a syntactic process that is relatively cheap.  We memoize it
-mainly in the hopes that it will keep the various alists the same across
-multiple evaluations of an STV.</p>
+  ((stv stvdata-p
+        "An @(see stvdata-p) that has already had its lines widened and any
+         Verilog-style names expanded; see @(see stv-widen) and @(see
+         stv-expand-names).")
+
+   (mod good-esim-modulep
+        "The @(see esim) module this STV is about."))
+
+  :returns (cstv (equal (compiled-stv-p cstv)
+                        (if cstv t nil)))
+
+  :long "<p>Compiling an STV involves doing lots of error checking to ensure
+the STV is syntactically well-formed, only refers to legitimate inputs and
+outputs, and so forth.  After sanity checking, our basic goal is to compile the
+STV into a form that functions like @(see stv-run) and @(see stv-debug) can
+efficiently process.</p>
+
+<p>In particular, after (successfully) compiling an STV we obtain a @(see
+compiled-stv-p) structure that says says how many steps we need to run for,
+explains the mappings from user-level simulation variables to their internal
+bit-encodings, and and has pre-computed alists for restricting the a @(see
+esim) run and extracting the results.</p>
+
+<p>Compilation is a syntactic process that is relatively cheap.  We @(see
+memoize) it mainly in the hopes of keeping the various alists we create the
+same across multiple evaluations of an STV.</p>
 
 <p>Note that to reuse the same @(see esim) simulations across related STVs, our
 basic approach in @(see stv-run) is to do a fully general simulation of the
@@ -1166,106 +977,113 @@
 builds a list of alists that say, for each step, which output bits we want to
 collect and how we want to name them.</p>"
 
-  (defund stv-compile (stv mod)
-    (declare (xargs :guard (and (stvdata-p stv)
-                                (good-esim-modulep mod))))
-    (b* (((stvdata stv) stv)
-         (nphases (stv-number-of-phases stv))
-         ((unless (posp nphases))
-          (er hard? 'stv-compile "Trying to compile an STV without any phases?"))
-
-         ;; Initials and inputs...
-         (in-usersyms nil)
-         ((mv initial-alist in-usersyms)  (stv-initial-lines-to-alist stv.initial in-usersyms mod))
-         ((mv inputs gensyms in-usersyms) (stv-expand-input-lines stv.inputs nil in-usersyms))
-         (restrict-alist (stv-add-suffixes-to-initial-alist initial-alist))
-         (restrict-alist (stv-restrict-alist inputs restrict-alist))
-         (restrict-alist (make-fast-alist restrict-alist))
-
-         ;; Outputs and internals...
-         (out-usersyms nil)
-         ((mv outputs out-usersyms)   (stv-expand-output-lines stv.outputs out-usersyms))
-         ((mv internals out-usersyms) (stv-expand-internal-lines stv.internals out-usersyms mod))
-         (out-extract-alists (stv-extraction-alists (- nphases 1) outputs nil))
-         (int-extract-alists (stv-extraction-alists (- nphases 1) internals nil))
-
-         (all-in-bits (alist-keys restrict-alist))
-         ((unless (uniquep all-in-bits))
-          ;; This could be really bad because you'd be shadowing one value with
-          ;; another, and it could easily happen to you if you gave two
-          ;; different paths on :initial things that turned out to refer to the
-          ;; same state bit.
-          (er hard? 'stv-compile
-              "Name clash.  Multiple input/initial bindings were generated for ~x0."
-              (duplicated-members all-in-bits)))
-
-         (in-simvars (alist-keys in-usersyms))
-         (out-simvars (alist-keys out-usersyms))
-         ((unless (and (uniquep in-simvars)
-                       (uniquep out-simvars)
-                       (symbol-listp in-simvars)
-                       (symbol-listp out-simvars)))
-          (er hard? 'stv-compile
-              "Programming error.  in-simvars or out-simvars aren't unique ~
-               symbols.  This shouldn't be possible."))
-
-         (illegally-reused-simvars (duplicated-members (append in-simvars out-simvars)))
-         ((when illegally-reused-simvars)
-          ;; This is something the user could try to do.  It wouldn't *really*
-          ;; be a problem, but certainly seems to indicate confusion on their
-          ;; part.
-          (er hard? 'stv-compile
-              "Error: It is illegal to reuse the input simulation variables ~
-               (from :input and :initial lines) as output simulation ~
-               variables (from :output and :internal lines).  Illegally ~
-               reused variables: ~x0" illegally-reused-simvars))
-
-         (all-bits (vl::append-domains-exec in-usersyms gensyms))
-         (all-bits (vl::append-domains-exec out-usersyms all-bits))
-         ((unless (uniquep all-bits))
-          ;; It's hard to imagine this happening, if the in-usersyms and
-          ;; out-usersyms have unique keys.  But if somehow the user gave a
-          ;; simulation variable name that clashed with a gensym, it'd be bad.
-          (er hard? 'stv-compile "Name clash for ~x0." (duplicated-members all-bits)))
-
-         (ret (make-compiled-stv
-               :nphases        nphases
-               :restrict-alist restrict-alist
-
-               ;; These have to stay separate because we have to use them to
-               ;; extract from different esim outputs
-               :out-extract-alists out-extract-alists
-               :int-extract-alists int-extract-alists
-
-               ;; I reverse these here so that they are "in the right order"
-               ;; per the lines of the STV.  This isn't anything that is
-               ;; semantically important, but it makes things like
-               ;; stv-autohyps, stv-autoins, stv->ins, etc. nicer to look at
-               ;; because you see the stuff in the same order as you put it in.
-               :in-usersyms  (make-fast-alist (rev in-usersyms))
-               :out-usersyms (make-fast-alist (rev out-usersyms))
-
-               ;; These have some various uses in documentation and also in
-               ;; stv-process, but probably we should work to get rid of these.
-               :expanded-ins  inputs
-               :expanded-outs outputs
-               :expanded-ints internals
-               )))
-
-      (fast-alist-free in-usersyms)
-      (fast-alist-free out-usersyms)
-      ret))
+  (b* (((stvdata stv) stv)
+       (nphases (stv-number-of-phases stv))
+       ((unless (posp nphases))
+        (raise "Trying to compile an STV without any phases?"))
+
+       (override-paths (stv-append-alist-keys stv.overrides))
+       (mod (stv-cut-module override-paths mod))
+
+       ;; Inputs...
+       (in-usersyms nil)
+       ((mv inputs gensyms in-usersyms)
+        (stv-expand-input-lines stv.inputs nil in-usersyms))
+
+       (restrict-alist nil)
+       (restrict-alist (stv-restrict-alist inputs restrict-alist))
+
+       ;; Outputs and internals...
+       (out-usersyms nil)
+       ((mv outputs out-usersyms)
+        (stv-expand-output-lines stv.outputs out-usersyms))
+       ((mv internals out-usersyms)
+        (stv-expand-internal-lines stv.internals out-usersyms mod))
+       (out-extract-alists (stv-extraction-alists (- nphases 1) outputs nil))
+       (int-extract-alists (stv-extraction-alists (- nphases 1) internals nil))
+
+       ((mv override-ins override-outs in-usersyms out-usersyms)
+        (stv-expand-override-lines stv.overrides in-usersyms out-usersyms))
+       (restrict-alist (stv-restrict-alist override-ins restrict-alist))
+       (nst-extract-alists (stv-extraction-alists (- nphases 1) override-outs nil))
+
+       (all-in-bits (alist-keys restrict-alist))
+       ((unless (uniquep all-in-bits))
+        ;; This could be really bad because you'd be shadowing one value with
+        ;; another, and it could easily happen to you if you gave two
+        ;; different paths on :initial things that turned out to refer to the
+        ;; same state bit.
+        (raise "Name clash.  Multiple input/initial bindings were generated ~
+                for ~x0." (duplicated-members all-in-bits)))
+
+       (in-simvars  (alist-keys in-usersyms))
+       (out-simvars (alist-keys out-usersyms))
+       ((unless (and (uniquep in-simvars)
+                     (uniquep out-simvars)
+                     (symbol-listp in-simvars)
+                     (symbol-listp out-simvars)))
+        (raise "Programming error.  in-simvars or out-simvars aren't unique ~
+                symbols.  This shouldn't be possible."))
+
+       ;; (illegally-reused-simvars
+       ;;  (duplicated-members (append in-simvars out-simvars)))
+       ;; ((when illegally-reused-simvars)
+       ;;  ;; This is something the user could try to do.  It wouldn't *really*
+       ;;  ;; be a problem, but certainly seems to indicate confusion on their
+       ;;  ;; part.
+       ;;  (raise "Error: It is illegal to reuse the input simulation variables ~
+       ;;          (from :input and :initial lines) as output simulation ~
+       ;;          variables (from :output and :internal lines).  Illegally ~
+       ;;          reused variables: ~x0" illegally-reused-simvars))
+
+       (all-in-bits (vl::append-domains-exec in-usersyms gensyms))
+       ((unless (uniquep all-in-bits))
+        ;; It's hard to imagine this happening, but if somehow the user gave an
+        ;; input simulation variable name that clashed with a gensym, it'd be
+        ;; bad.
+        (raise "Name clash for ~x0." (duplicated-members all-in-bits)))
+
+       (override-bits
+        (stv-append-alist-keys override-ins))
+       ((unless (symbol-listp override-bits))
+        (raise "Programming error -- override-bits should be a symbol-list: ~x0"
+               override-bits))
+
+       (ret (make-compiled-stv
+             :nphases        nphases
+             :restrict-alist restrict-alist
+
+             ;; These have to stay separate because we have to use them to
+             ;; extract from different esim outputs
+             :out-extract-alists out-extract-alists
+             :int-extract-alists int-extract-alists
+             :nst-extract-alists nst-extract-alists
+
+             :override-bits override-bits
+
+             ;; I reverse these here so that they are "in the right order"
+             ;; per the lines of the STV.  This isn't anything that is
+             ;; semantically important, but it makes things like
+             ;; stv-autohyps, stv-autoins, stv->ins, etc. nicer to look at
+             ;; because you see the stuff in the same order as you put it in.
+             :in-usersyms  (make-fast-alist (rev in-usersyms))
+             :out-usersyms (make-fast-alist (rev out-usersyms))
+
+             ;; These have some various uses in documentation and also in
+             ;; stv-process, but probably we should work to get rid of these.
+             :expanded-ins  inputs
+
+             :override-paths override-paths
+             )))
+
+    (fast-alist-free in-usersyms)
+    (fast-alist-free out-usersyms)
+    ret)
+
+  ///
 
   ;; Compilation isn't necessarily slow, but memoizing it seems like a good
   ;; idea to make sure that all of the alists stay the same.
-  (memoize 'stv-compile)
-
-  (local (in-theory (enable stv-compile)))
-
-  (defthm compiled-stv-p-of-stv-compile
-    (equal (compiled-stv-p (stv-compile stv mod))
-           (if (stv-compile stv mod)
-               t
-             nil))))
+  (memoize 'stv-compile))
 
 
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-debug.lisp acl2-6.3/books/centaur/esim/stv/stv-debug.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-debug.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-debug.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -28,7 +28,7 @@
 (include-book "centaur/misc/tshell" :dir :system)
 (include-book "../esim-vcd")
 (local (include-book "centaur/vl/util/arithmetic" :dir :system))
-
+(local (include-book "system/f-put-global" :dir :system))
 
 (local (defthm len-of-4v-sexpr-restrict-with-rw-alists
          (equal (len (4v-sexpr-restrict-with-rw-alists x al))
@@ -43,157 +43,181 @@
 (local (defthm cons-list-listp-of-4v-sexpr-restrict-with-rw-alists
          (vl::cons-list-listp (4v-sexpr-restrict-with-rw-alists x al))))
 
+(local (defthm cons-listp-of-4v-sexpr-eval-alist
+         (vl::cons-listp (4v-sexpr-eval-alist x al))))
+
+(local (defthm cons-list-listp-of-4v-sexpr-eval-alists
+         (vl::cons-list-listp (4v-sexpr-eval-alists x al))))
 
+(define stv-combine-into-snapshots
+  :parents (stv-debug)
+  ((in-alists true-list-listp)
+   (out-alists true-list-listp)
+   (int-alists true-list-listp))
+  :guard (and (same-lengthp in-alists out-alists)
+              (same-lengthp in-alists int-alists))
+  :returns (snapshots vl::cons-list-listp
+                      :hyp (and (vl::cons-list-listp in-alists)
+                                (vl::cons-list-listp out-alists)
+                                (vl::cons-list-listp int-alists)))
+  (b* (((when (atom in-alists))
+        nil)
+       (snapshot1 (append (car in-alists)
+                          (car out-alists)
+                          (car int-alists))))
+    (cons snapshot1 (stv-combine-into-snapshots (cdr in-alists)
+                                                (cdr out-alists)
+                                                (cdr int-alists)))))
+
+(define stv-make-snapshots
+  :parents (stv-debug)
+  :short "Prepare an STV for debugging by create \"snapshots\" that are ready
+to be evaluated and written to the VCD file."
+  ((pstv processed-stv-p)
+   (mod))
+  :returns (snapshots vl::cons-list-listp)
+  :long "<p>This is computationally expensive.  We memoize it so that we only
+need to make the snapshots the first time you want to debug an STV.  The same
+snapshots can then be reused across as many calls of @(see stv-debug) as you
+like.</p>"
+
+  (b* (((processed-stv pstv) pstv)
+       ((compiled-stv cstv) pstv.compiled-stv)
+       (nphases (nfix cstv.nphases))
+       ((unless (posp nphases))
+        (raise "STV has no phases?"))
+
+       ((mv ?init-st-general
+            in-alists-general
+            ?nst-alists-general
+            out-alists-general
+            int-alists-general)
+        (time$ (stv-fully-general-simulation-debug nphases mod cstv.override-bits)
+               :msg "; stv debug simulation: ~st sec, ~sa bytes.~%"
+               :mintime 1/2)))
+
+    (with-fast-alist cstv.restrict-alist
+      (time$ (stv-combine-into-snapshots
+              (4v-sexpr-restrict-with-rw-alists in-alists-general cstv.restrict-alist)
+              (4v-sexpr-restrict-with-rw-alists out-alists-general cstv.restrict-alist)
+              (4v-sexpr-restrict-with-rw-alists int-alists-general cstv.restrict-alist))
+             :msg "; stv-debug general snapshots: ~st sec, ~sa bytes.~%"
+             :mintime 1/2)))
+  ///
+  (memoize 'stv-make-snapshots :aokp t))
 
 (defttag writes-okp)
 (remove-untouchable acl2::writes-okp nil)
 
-(defsection stv-make-snapshots
-
-  (defund stv-combine-into-snapshots (in-alists out-alists int-alists)
-    (declare (xargs :guard (and (vl::same-lengthp in-alists out-alists)
-                                (vl::same-lengthp in-alists int-alists)
-                                (true-list-listp in-alists)
-                                (true-list-listp out-alists)
-                                (true-list-listp int-alists))))
-    (if (atom in-alists)
-        nil
-      (let ((snapshot1 (append (car in-alists)
-                               (car out-alists)
-                               (car int-alists))))
-        (cons snapshot1 (stv-combine-into-snapshots (cdr in-alists)
-                                                    (cdr out-alists)
-                                                    (cdr int-alists))))))
-
-  (local (defthm c0
-           (implies (and (vl::cons-list-listp in-alists)
-                         (vl::cons-list-listp out-alists)
-                         (vl::cons-list-listp int-alists))
-                    (vl::cons-list-listp
-                     (stv-combine-into-snapshots in-alists out-alists int-alists)))
-           :hints(("Goal" :in-theory (enable stv-combine-into-snapshots)))))
-
-  (defund stv-make-snapshots (pstv)
-    (declare (xargs :guard (processed-stv-p pstv)))
-    (b* (((processed-stv pstv) pstv)
-
-         ((compiled-stv cstv) pstv.compiled-stv)
-         (nphases (nfix cstv.nphases))
-         ((unless (posp nphases))
-          (er hard? 'stv-process "STV has no phases?"))
-
-         ((mv ?init-st-general
-              in-alists-general
-              ?nst-alists-general
-              out-alists-general
-              int-alists-general)
-          (time$ (stv-fully-general-simulation-debug nphases pstv.mod)
-                 :msg "; stv debug simulation: ~st sec, ~sa bytes.~%"
-                 :mintime 1/2))
-
-         (snapshots
-          (with-fast-alist cstv.restrict-alist
-            (time$ (stv-combine-into-snapshots
-                    (4v-sexpr-restrict-with-rw-alists in-alists-general cstv.restrict-alist)
-                    (4v-sexpr-restrict-with-rw-alists out-alists-general cstv.restrict-alist)
-                    (4v-sexpr-restrict-with-rw-alists int-alists-general cstv.restrict-alist))
-                   :msg "; stv-debug general snapshots: ~st sec, ~sa bytes.~%"
-                   :mintime 1/2))))
-      snapshots))
-
-  (memoize 'stv-make-snapshots :aokp t)
-
-  (defthm cons-list-listp-of-stv-make-snapshots
-    (vl::cons-list-listp (stv-make-snapshots pstv))
-    :hints(("Goal" :in-theory (e/d (stv-make-snapshots)
-                                   ((force)))))))
-
+; Added by Matt K., 9/28/2013, to get around ACL2(hp) error such as:
+;   Error:  Not owner of hash table #<HASH-TABLE :TEST EQL size 95/135 #x30205C1CDBBD>
+; David Rager points out (email, 9/28/2013) that "memoization is known
+; not to be thread-safe"; Jared Davis says this too.  (Perhaps this will be
+; addressed in the future.)
+(local (unmemoize 'mod-state))
+(local (unmemoize 'occmap))
 
-
-(defsection stv-debug
+(define stv-debug
   :parents (symbolic-test-vectors)
   :short "Evaluate a symbolic test vector at particular, concrete inputs, and
 generate a waveform."
-
+  ((pstv processed-stv-p)
+   input-alist
+   &key
+   ((filename stringp) '"stv.debug")
+   ((viewer   (or (stringp viewer) (not viewer))) '"gtkwave")
+   (state    'state))
+  :guard-debug t
+  :returns (mv out-alist state)
   :long "<p>This macro is an extended version of @(see stv-run).  In addition
 to building an alist of the output simulation variables, it also writes out a
 waveform that can be viewed in a VCD viewer.  Note that debugging can be slow,
 especially the first time before things are memoized.</p>"
 
-  (defun stv-debug-fn (pstv input-alist filename viewer state)
-    "Returns (MV OUT-ALIST STATE)"
-    (declare (xargs :guard (processed-stv-p pstv)
-                    :stobjs state
-                    :mode :program))
-    (time$
-     (b* (((processed-stv pstv) pstv)
-          ((compiled-stv cstv) pstv.compiled-stv)
-
-          (snapshots
-           (time$ (stv-make-snapshots pstv)
-                  :mintime 1/2
-                  :msg "; stv-debug snapshots: ~st sec, ~sa bytes.~%"))
-
-          (in-usersyms
-           ;; These should already be a fast alist, but in case the object was
-           ;; serialized and reloaded or something, we'll go ahead and try to
-           ;; make them fast again.
-           (make-fast-alist cstv.in-usersyms))
-
-          (ev-alist
-           (time$ (make-fast-alist
-                   (stv-simvar-inputs-to-bits input-alist in-usersyms))
-                  :mintime 1/2
-                  :msg "; stv-debug ev-alist: ~st sec, ~sa bytes.~%"))
-
-          (evaled-out-bits
-           (time$ (make-fast-alist
-                   (4v-sexpr-eval-alist pstv.relevant-signals ev-alist))
-                  :mintime 1/2
-                  :msg "; stv-debug evaluating sexprs: ~st sec, ~sa bytes.~%"))
-
-          (evaled-snapshots
-           (time$ (4v-sexpr-eval-alists snapshots ev-alist)
-                  :mintime 1/2
-                  :msg "; stv-debug evaluating snapshots: ~st sec, ~sa bytes.~%"))
-
-          (- (fast-alist-free ev-alist))
-
-          (assembled-outs
-           (time$ (stv-assemble-output-alist evaled-out-bits cstv.out-usersyms)
-                  :mintime 1/2
-                  :msg "; stv-debug assembling outs: ~st sec, ~sa bytes.~%"))
-
-          (- (fast-alist-free evaled-out-bits))
-
-          ;; Actual VCD generation
-          ((mv date state) (oslib::date))
-          (dump (vl::vcd-dump-main pstv.mod evaled-snapshots date))
-
-          ((mv & & state) (assign acl2::writes-okp t))
-          (state (time$ (vl::with-ps-file filename
-                           (vl::vl-ps-update-rchars dump))
-                        :mintime 1/2
-                        :msg "; vcd-dump file generation: ~st seconds, ~sa bytes.~%"))
-
-          ;; Maybe launch a VCD viewer, but not if we're certifying books
-          (certifying-book-p (acl2::f-get-global 'acl2::certify-book-info state))
-
-          ;; BOZO we aren't really escaping filenames right or anything like that
-          (- (if (and viewer (not certifying-book-p))
-                 (b* ((cmd (str::cat viewer " " filename)))
-                   (cw "; vcd-dump launching \"~s0\".~%" cmd)
-                   (acl2::tshell-ensure)
-                   (acl2::tshell-run-background cmd))
-               nil)))
-
-       (mv assembled-outs state))
-     :msg "; stv-debug: ~st sec, ~sa bytes.~%"
-     :mintime 1))
-
-  (defmacro stv-debug (pstv input-alist
-                            &key
-                            (filename '"stv.debug")
-                            (viewer   '"gtkwave"))
-    `(stv-debug-fn ,pstv ,input-alist ,filename ,viewer state)))
-
+  (time$
+   (b* (((processed-stv pstv) pstv)
+        ((compiled-stv cstv) pstv.compiled-stv)
+
+        (mod-function (intern-in-package-of-symbol
+                       (str::cat (symbol-name pstv.name) "-MOD")
+                       pstv.name))
+        ((mv er mod)
+         (magic-ev-fncall mod-function
+                          nil ;; args
+                          state
+                          t ;; hard error returns nil?  sure why not
+                          t ;; attachments allowed? sure why not
+                          ))
+
+        ((when er)
+         (mv (raise "Error evaluating ~x0 to look up STV module: ~@1."
+                    mod-function (if (eq er 't) "t" er))
+             state))
+        ((unless (good-esim-modulep mod))
+         (mv (raise "Error: ~x0 returned a bad ESIM module: ~@1"
+                    mod-function (bad-esim-modulep mod))
+             state))
+
+        (snapshots
+         (time$ (stv-make-snapshots pstv mod)
+                :mintime 1/2
+                :msg "; stv-debug snapshots: ~st sec, ~sa bytes.~%"))
+
+        (in-usersyms
+         ;; These should already be a fast alist, but in case the object was
+         ;; serialized and reloaded or something, we'll go ahead and try to
+         ;; make them fast again.
+         (make-fast-alist cstv.in-usersyms))
+
+        (ev-alist
+         (time$ (make-fast-alist
+                 (stv-simvar-inputs-to-bits input-alist in-usersyms))
+                :mintime 1/2
+                :msg "; stv-debug ev-alist: ~st sec, ~sa bytes.~%"))
+
+        (evaled-out-bits
+         (time$ (make-fast-alist
+                 (4v-sexpr-eval-alist pstv.relevant-signals ev-alist))
+                :mintime 1/2
+                :msg "; stv-debug evaluating sexprs: ~st sec, ~sa bytes.~%"))
+
+        (evaled-snapshots
+         (time$ (4v-sexpr-eval-alists snapshots ev-alist)
+                :mintime 1/2
+                :msg "; stv-debug evaluating snapshots: ~st sec, ~sa bytes.~%"))
+
+        (- (fast-alist-free ev-alist))
+
+        (assembled-outs
+         (time$ (stv-assemble-output-alist evaled-out-bits cstv.out-usersyms)
+                :mintime 1/2
+                :msg "; stv-debug assembling outs: ~st sec, ~sa bytes.~%"))
+
+        (- (fast-alist-free evaled-out-bits))
+
+        ;; Actual VCD generation
+        ((mv date state) (oslib::date))
+        (dump (vl::vcd-dump-main mod evaled-snapshots date))
+
+        ((mv & & state) (assign acl2::writes-okp t))
+        (state (time$ (vl::with-ps-file filename
+                                        (vl::vl-ps-update-rchars dump))
+                      :mintime 1/2
+                      :msg "; vcd-dump file generation: ~st seconds, ~sa bytes.~%"))
+
+        ;; Maybe launch a VCD viewer, but not if we're certifying books
+        (certifying-book-p
+         (and (acl2::boundp-global 'acl2::certify-book-info state)
+              (acl2::f-get-global 'acl2::certify-book-info state)))
+
+        ;; BOZO we aren't really escaping filenames right or anything like that
+        (- (if (and viewer (not certifying-book-p))
+               (b* ((cmd (str::cat viewer " " filename)))
+                 (cw "; vcd-dump launching \"~s0\".~%" cmd)
+                 (acl2::tshell-ensure)
+                 (acl2::tshell-run-background cmd))
+             nil)))
+
+     (mv assembled-outs state))
+   :msg "; stv-debug: ~st sec, ~sa bytes.~%"
+   :mintime 1))
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-doc.lisp acl2-6.3/books/centaur/esim/stv/stv-doc.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-doc.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-doc.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -26,18 +26,45 @@
 (include-book "stv-widen")
 (include-book "str/stringify" :dir :system)
 (include-book "centaur/vl/util/print-htmlencode" :dir :system)
+(local (include-book "std/typed-lists/character-listp" :dir :system))
+(local (include-book "str/explode-nonnegative-integer" :dir :system))
 
-(defund stv-name-bits-to-xml (bits col acc)
-  ;; Probably horrible way to print out individual bits, if the user writes that
-  ;; sort of thing
-  (declare (xargs :guard (and (true-listp bits)
-                              (natp col))))
+(defsection stv-doc
+  :parents (symbolic-test-vectors)
+  :short "Automatic documentation support for symbolic test vectors."
+
+  :long "<p>Symbolic test vectors are integrated into @(see xdoc) so that you
+can generate attractive explanations of your setup.  This is often useful when
+communicating with logic designers.  For an example, see @(see counter-run) in
+the @(see esim-tutorial).</p>
+
+<p><b>NOTE</b>: the topics here cover how we generate this documentation.  If
+you just want to document your own STVs, you don't need to know about any of
+this&mdash;just give a @(':parents'), @(':short'), or @(':long') argument to
+@(see defstv).</p>
+
+<p>These functions don't do much error checking.  We expect that we only are
+going to generate documentation after successfully processing the STV, so we
+generally just expect things to be well-formed at this point.</p>
+
+<p>The XML we generate is not documented in @(see xdoc)'s @(see xdoc::markup),
+and is not supported by tools like @(':xdoc').  How these new tags get rendered
+into HTML is controlled by, e.g., @('xdoc/fancy/render.xsl').</p>")
+
+(define stv-name-bits-to-xml ((bits true-listp)
+                              (col  natp)
+                              acc)
+  :returns (acc character-listp :hyp (character-listp acc))
+  :parents (stv-doc)
+  :short "Encode the name of an STV line, when the name is a list of E bits."
+  :long "<p>This is really horrible, but it doesn't matter since nobody would
+ever actually use a list of E bits to name their input.</p>"
   (b* (((when (atom bits))
         acc)
        ;; Print the name of this bit
        (name1 (stringify (car bits)))
        ((mv col acc)
-        (vl::vl-html-encode-string-aux name1 0 (length name1) col 8 acc))
+        (vl::vl-html-encode-string-aux name1 0 (length name1) (lnfix col) 8 acc))
        ;; Print ", " if there are more bits.
        ((mv col acc)
         (if (atom (cdr bits))
@@ -46,14 +73,10 @@
     ;; Print the rest of the bit names.
     (stv-name-bits-to-xml (cdr bits) col acc)))
 
-(defthm character-listp-of-stv-name-bits-to-xml
-  (implies (and (character-listp acc)
-                (natp col))
-           (character-listp (stv-name-bits-to-xml bits col acc)))
-  :hints(("Goal" :in-theory (enable stv-name-bits-to-xml))))
-
-(defund stv-name-to-xml (name acc)
-  (declare (xargs :guard t))
+(define stv-name-to-xml (name acc)
+  :returns (acc character-listp :hyp (character-listp acc))
+  :parents (stv-doc)
+  :short "Encode the name of an STV line."
   (cond ((stringp name)
          ;; It already looks like a Verilog name, so this is easy enough.
          (b* (((mv ?col acc)
@@ -66,15 +89,14 @@
               (acc (cons #\} acc)))
            acc))
         (t
-         (er hard? 'stv-name-to-xml "Bad name for stv line: ~x0." name))))
-
-(defthm character-listp-of-stv-name-to-xml
-  (implies (character-listp acc)
-           (character-listp (stv-name-to-xml name acc)))
-  :hints(("Goal" :in-theory (enable stv-name-to-xml))))
+         (raise "Bad name for stv line: ~x0." name))))
 
-(defund stv-entry-to-xml (entry expansion acc)
-  (declare (xargs :guard t))
+(define stv-entry-to-xml ((entry     "The value that the user gave, originally.")
+                          (expansion "Its expanded out value, a sexpr list.")
+                          acc)
+  :returns (acc character-listp :hyp (character-listp acc))
+  :parents (stv-doc)
+  :short "Encode a single value from an STV line."
   (cond ((natp entry)
          (if (< entry 10)
              ;; As a special nicety, write values under 10 without any
@@ -82,7 +104,7 @@
              (revappend (str::natchars entry) acc)
            ;; For any larger constants, write them in hex.  I'll use a 0x
            ;; prefix instead of a #x prefix, since it's probably more widely
-           ;; understood.
+           ;; understood (e.g., by logic designers)
            (let* ((pound-x-hex-digits (explode-atom+ entry 16 t))           ;; #x1000
                   (zero-x-hex-digits  (cons #\0 (cdr pound-x-hex-digits)))) ;; 0x1000
              (revappend zero-x-hex-digits acc))))
@@ -101,7 +123,7 @@
                ((equal expansion (list *4vf-sexpr*))
                 (cons #\0 acc))
                (t
-                (progn$ (er hard? 'stv-entry-to-xml "Expansion of ~ should be 1 or 0.")
+                (progn$ (raise "Expansion of ~ should be 1 or 0.")
                         acc))))
 
         ((eq entry '_)
@@ -118,16 +140,15 @@
            acc))
 
         (t
-         (er hard? 'stv-entry-to-xml
-             "Bad entry in stv line: ~x0." entry))))
+         (raise "Bad entry in stv line: ~x0." entry))))
 
-(defthm character-listp-of-stv-entry-to-xml
-  (implies (character-listp acc)
-           (character-listp (stv-entry-to-xml entry expansion acc)))
-  :hints(("Goal" :in-theory (enable stv-entry-to-xml))))
-
-(defund stv-entries-to-xml (entries expansions acc)
-  (declare (xargs :guard (true-listp expansions)))
+(define stv-entries-to-xml ((entries "The original entries for this line.")
+                            (expansions "The expanded entries for this line."
+                                        true-listp)
+                            acc)
+  :returns (acc character-listp :hyp (character-listp acc))
+  :parents (stv-doc)
+  :short "Encode all the values from an STV line."
   (b* (((when (atom entries))
         acc)
        (acc (str::revappend-chars "<stv_entry>" acc))
@@ -135,14 +156,15 @@
        (acc (str::revappend-chars "</stv_entry>" acc)))
     (stv-entries-to-xml (cdr entries) (cdr expansions) acc)))
 
-(defthm character-listp-of-stv-entries-to-xml
-  (implies (character-listp acc)
-           (character-listp (stv-entries-to-xml entries expansions acc)))
-  :hints(("Goal" :in-theory (enable stv-entries-to-xml))))
-
-(defund stv-line-to-xml (line expansion acc)
-  (declare (xargs :guard (and (true-listp line)
-                              (true-listp expansion))))
+(define stv-line-to-xml
+  ((line      "Original line, with name, given by the user."
+              true-listp)
+   (expansion "Fully expanded line, with name, after STV processing"
+              true-listp)
+   acc)
+  :returns (acc character-listp :hyp (character-listp acc))
+  :parents (stv-doc)
+  :short "Encode one full line from the STV into XML for XDOC."
   (b* ((acc (str::revappend-chars "<stv_line>" acc))
        (acc (str::revappend-chars "<stv_name>" acc))
        (acc (stv-name-to-xml (car line) acc))
@@ -152,27 +174,20 @@
        (acc (cons #\Newline acc)))
     acc))
 
-(defthm character-listp-of-stv-line-to-xml
-  (implies (character-listp acc)
-           (character-listp (stv-line-to-xml line expansion acc)))
-  :hints(("Goal" :in-theory (enable stv-line-to-xml))))
-
-(defund stv-lines-to-xml (lines expansions acc)
-  (declare (xargs :guard (and (true-list-listp lines)
-                              (true-list-listp expansions))))
+(define stv-lines-to-xml ((lines      true-list-listp)
+                          (expansions true-list-listp)
+                          acc)
+  :returns (acc character-listp :hyp (character-listp acc))
+  :parents (stv-doc)
   (b* (((when (atom lines))
         acc)
        (acc (stv-line-to-xml (car lines) (car expansions) acc)))
     (stv-lines-to-xml (cdr lines) (cdr expansions) acc)))
 
-(defthm character-listp-of-stv-lines-to-xml
-  (implies (character-listp acc)
-           (character-listp (stv-lines-to-xml lines expansions acc)))
-  :hints(("Goal" :in-theory (enable stv-lines-to-xml))))
-
-
-(defund stv-labels-to-xml (labels acc)
-  (declare (xargs :guard (symbol-listp labels)))
+(define stv-labels-to-xml ((labels symbol-listp)
+                           acc)
+  :returns (acc character-listp :hyp (character-listp acc))
+  :parents (stv-doc)
   (b* (((when (atom labels))
         acc)
        (acc (str::revappend-chars "<stv_label>" acc))
@@ -182,26 +197,25 @@
        (acc (str::revappend-chars "</stv_label>" acc)))
     (stv-labels-to-xml (cdr labels) acc)))
 
-(defthm character-listp-of-stv-labels-to-xml
-  (implies (character-listp acc)
-           (character-listp (stv-labels-to-xml labels acc)))
-  :hints(("Goal" :in-theory (enable stv-labels-to-xml))))
-
-
+(define stv-to-xml ((stv    stvdata-p)
+                    (cstv   compiled-stv-p)
+                    (labels symbol-listp))
+  :returns (encoding (or (stringp encoding)
+                         (not encoding))
+                     :rule-classes :type-prescription)
+  :parents (stv-doc)
+  :short "Top-level routine to generate a nice XML description of an STV."
 
-(defund stv-to-xml (stv cstv labels)
-  (declare (xargs :guard (and (stvdata-p stv)
-                              (compiled-stv-p cstv)
-                              (symbol-listp labels))))
   (b* (;; Widen all the lines so the table will be filled.
        (stv        (stv-widen stv))
        ((stvdata stv) stv)
 
        ;; Grab the expanded input lines, since they'll have the resolved tilde
-       ;; (~) entries.  We don't need to expand the output or internal lines.
-       (ex-ins    (compiled-stv->expanded-ins cstv))
+       ;; (~) entries.  We don't need to expand the output, internal, or
+       ;; override lines.
+       (ex-ins  (compiled-stv->expanded-ins cstv))
        ((unless (true-list-listp ex-ins))
-        (er hard? 'stv-to-xml "Expanded inputs aren't a true-list-listp?"))
+        (raise "Expanded inputs aren't a true-list-listp?"))
 
        (acc nil)
        (acc (str::revappend-chars "<stv>" acc))
@@ -215,12 +229,6 @@
               acc))
        (acc (cons #\Newline acc))
 
-       (acc (str::revappend-chars "<stv_initials>" acc))
-       (acc (cons #\Newline acc))
-       (acc (stv-lines-to-xml stv.initial nil acc))
-       (acc (str::revappend-chars "</stv_initials>" acc))
-       (acc (cons #\Newline acc))
-
        (acc (str::revappend-chars "<stv_inputs>" acc))
        (acc (cons #\Newline acc))
        (acc (stv-lines-to-xml stv.inputs ex-ins acc))
@@ -239,13 +247,14 @@
        (acc (str::revappend-chars "</stv_internals>" acc))
        (acc (cons #\Newline acc))
 
+       (acc (str::revappend-chars "<stv_overrides>" acc))
+       (acc (cons #\Newline acc))
+       (acc (stv-lines-to-xml stv.overrides nil acc))
+       (acc (str::revappend-chars "</stv_overrides>" acc))
+       (acc (cons #\Newline acc))
+
        (acc (str::revappend-chars "</stv>" acc)))
-    (reverse (coerce acc 'string))))
+    (str::rchars-to-string acc)))
 
-(defthm stringp-of-stv-to-xml
-  (or (stringp (stv-to-xml stv expansion labels))
-      (not (stv-to-xml stv expansion labels)))
-  :rule-classes :type-prescription
-  :hints(("Goal" :in-theory (enable stv-to-xml))))
 
 
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-expand.lisp acl2-6.3/books/centaur/esim/stv/stv-expand.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-expand.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-expand.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -123,16 +123,23 @@
                 (equal (list name msb lsb) '("foo" 5 3)))))))
 
 
-(defsection stv-expand-name
+(define stv-expand-name
   :parents (stv-expand)
   :short "Expand a name from a symbolic test vector's line into explicit lists
 of E bits."
 
-  :long "<p><b>Signature:</b> @(call stv-expand-name) returns an LSB-first list
-of E bits for a non-hierarchical valid STV signal name.</p>
+  ((x    "The name that the user put at the start of some STV line.")
+   (type "Either @(':i') or @(':o') and says whether this should be the name
+          of an input or output."
+         (or (eq type :i)
+             (eq type :o)))
+   (mod  "The @(see esim) module we are working in, so we can look up names."))
 
-<p>As described in @(see acl2::symbolic-test-vector-format), the signal names
-for :input and :output lines can be either:</p>
+  :returns (lsb-bits "An LSB-first list of E bits for a non-hierarchical valid
+                      STV signal name, e.g., @('(|foo[0]| |foo[1]| ...)').")
+
+  :long "<p>Recall from @(see acl2::symbolic-test-vector-format) that signal
+names for :input and :output lines can be either:</p>
 
 <ul>
 <li>A string that names a particular input bus,</li>
@@ -141,81 +148,68 @@
 <li>An explicit list of E bits (in LSB-first order).</li>
 </ul>
 
-<p>This function is given @('x'), the actual name that occurs on such a line.
-Our goal is to convert @('x') into the explicit bit list form.  If @('x') is
-already a list of bits then this is trivial.  Otherwise, we have to look it up
-in the module.</p>
-
-<p>Type is either @(':i') or @(':o') and says whether this should be the name
-of an input or output, and @('mod') is the whole E module so that we can look
-up its inputs and outputs.</p>
-
-<p>We do basic error checking to make sure that the name refers to valid input
-or output bits.</p>"
-
-  (defund stv-expand-name (x type mod)
-    "Returns an LSB-first list of bit names, e.g., (|foo[0]| |foo[1]| ...)."
-    (declare (xargs :guard (symbolp type)))
-    (b* ((pat     (gpl type mod))
-         (modname (gpl :n mod))
-
-         ((when (stringp x))
-          (b* ( ;; Note: for plain names msb/lsb will be nil.
-               ((mv ?err basename msb lsb) (stv-wirename-parse x))
-               ((when err)
-                (er hard? 'stv-expand-name "~s0" err))
-               (basename-bits         (vl::esim-vl-find-io basename pat))
-               ((unless basename-bits)
-                (er hard? 'stv-expand-name
-                    "Trying to expand ~s0, but there is no ~s1 named ~s2 in ~x3."
-                    x
-                    (if (equal type :i) "input" "output")
-                    basename
-                    modname))
-
-               ((unless (and msb lsb))
-                ;; The input name is just "foo", so get all of the wires of
-                ;; foo.  This lets you refer to busses by name without having
-                ;; to give their explicit indices in the STV.
-                basename-bits)
-
-               ;; Else, the input is "foo[5:3]" or similar, so we want to just
-               ;; get bits 5-3.  But put them in LSB-first order so they'll line
-               ;; up with the basename-bits
-               (expect-bits
-                ;; Stupid hack: it would be nicer to write:
-                ;; (reverse (vl-emodwires-from-msb-to-lsb basename msb lsb))
-                ;; But we just reverse the lsb/msb to avoid the extra consing
-                (vl::vl-emodwires-from-msb-to-lsb basename lsb msb))
-               ((unless (ordered-subsetp expect-bits basename-bits))
-                (er hard? 'stv-expand-name
-                    "Trying to expand ~s0, but the bits being asked for ~s1.~% ~
-                    - Found wires: ~x2 through ~x3~% ~
-                    - Want wires:  ~x4 through ~x5."
-                    x
-                    (if (subsetp-equal expect-bits basename-bits)
-                        "are not in the right order"
-                      "are not found")
-                    (car basename-bits)
-                    (car (last basename-bits))
-                    (car expect-bits)
-                    (car (last expect-bits)))))
-            expect-bits))
-
-         ;; Otherwise, we should have been given a list of valid input bits.
-         ((unless (symbol-listp x))
-          (er hard? 'stv-expand-name
-              "Invalid input name (expected string or a list of e bits), but ~
-              found ~x0."
-              x))
-
-         (flat-pat (pat-flatten1 pat))
-         ((unless  (subsetp-equal x flat-pat))
-          (er hard? 'stv-expand-name
-              "Trying to provide bindings for ~s0 that don't exist: ~x1."
-              (if (equal type :i) "inputs" "outputs")
-              (set-difference-equal flat-pat x))))
-      x)))
+<p>Here, our goal is to convert any such name, @('x'), into the explicit bit
+list form.  If @('x') is already a list of bits then this is trivial.
+Otherwise, we have to look it up in the module.  We do basic error checking to
+make sure that the name refers to valid input or output bits.</p>"
+
+  (b* ((pat     (gpl type mod))
+       (modname (gpl :n mod))
+
+       ((when (stringp x))
+        (b* ( ;; Note: for plain names msb/lsb will be nil.
+             ((mv ?err basename msb lsb) (stv-wirename-parse x))
+             ((when err)
+              (raise "~s0" err))
+             (basename-bits         (vl::esim-vl-find-io basename pat))
+             ((unless basename-bits)
+              (raise "Trying to expand ~s0, but there is no ~s1 named ~s2 in ~
+                      ~x3."
+                     x
+                     (if (eq type :i) "input" "output")
+                     basename
+                     modname))
+
+             ((unless (and msb lsb))
+              ;; The input name is just "foo", so get all of the wires of
+              ;; foo.  This lets you refer to busses by name without having
+              ;; to give their explicit indices in the STV.
+              basename-bits)
+
+             ;; Else, the input is "foo[5:3]" or similar, so we want to just
+             ;; get bits 5-3.  But put them in LSB-first order so they'll line
+             ;; up with the basename-bits
+             (expect-bits
+              ;; Stupid hack: it would be nicer to write:
+              ;; (reverse (vl-emodwires-from-msb-to-lsb basename msb lsb))
+              ;; But we just reverse the lsb/msb to avoid the extra consing
+              (vl::vl-emodwires-from-msb-to-lsb basename lsb msb))
+             ((unless (ordered-subsetp expect-bits basename-bits))
+              (raise "Trying to expand ~s0, but the bits being asked for ~s1.~% ~
+                      - Found wires: ~x2 through ~x3~% ~
+                      - Want wires:  ~x4 through ~x5."
+                     x
+                     (if (subsetp-equal expect-bits basename-bits)
+                         "are not in the right order"
+                       "are not found")
+                     (car basename-bits)
+                     (car (last basename-bits))
+                     (car expect-bits)
+                     (car (last expect-bits)))))
+          expect-bits))
+
+       ;; Otherwise, we should have been given a list of valid input bits.
+       ((unless (symbol-listp x))
+        (raise "Invalid input name (expected string or a list of e bits), but ~
+                found ~x0."
+               x))
+
+       (flat-pat (pat-flatten1 pat))
+       ((unless  (subsetp-equal x flat-pat))
+        (raise "Trying to provide bindings for ~s0 that don't exist: ~x1."
+               (if (eq type :i) "inputs" "outputs")
+               (set-difference-equal flat-pat x))))
+    x))
 
   #||
 
@@ -230,25 +224,21 @@
 
 
 
-(defsection stv-expand-names-in-lines
+(define stv-expand-names-in-lines
   :parents (stv-expand)
-  :short "@(call stv-expand-names-in-lines) expands all of the names in a list
-of STV :input or :output lines."
-
-  (defund stv-expand-names-in-lines (lines type mod)
-    (declare (xargs :guard (and (or (eq type :i)
-                                    (eq type :o))
-                                (true-list-listp lines))))
-    (b* (((when (atom lines))
-          nil)
-         (line1              (car lines))
-         ((cons name phases) line1)
-         (new-name           (stv-expand-name name type mod)))
-      (cons (cons new-name phases)
-            (stv-expand-names-in-lines (cdr lines) type mod))))
-
-  (local (in-theory (enable stv-expand-names-in-lines)))
-
+  :short "Expands all of the names in a list of STV :input or :output lines."
+  ((lines true-list-listp)
+   (type  (or (eq type :i) (eq type :o)))
+   mod)
+  :returns (new-lines)
+  (b* (((when (atom lines))
+        nil)
+       (line1              (car lines))
+       ((cons name phases) line1)
+       (new-name           (stv-expand-name name type mod)))
+    (cons (cons new-name phases)
+          (stv-expand-names-in-lines (cdr lines) type mod)))
+  ///
   (defthm alistp-of-stv-expand-names-in-lines
     (alistp (stv-expand-names-in-lines lines type mod)))
 
@@ -258,7 +248,6 @@
 
 
 
-
 ; -----------------------------------------------------------------------------
 ;
 ;               EXPANDING NAMES FOR :INTERNAL AND :INITIAL LINES
@@ -269,107 +258,91 @@
 ; E.g., the user might want to pull out or initialize some signal in the
 ; top-level module, or in some submodule.
 
-(defsection stv-hid-split
+(define stv-hid-split
   :parents (stv-expand)
   :short "Splits up a HID into a list of instance names and a wire name."
 
-  (defund stv-hid-split (hid)
-    "Returns (MV INSTNAMES WIRENAME) or causes an error."
-    (declare (xargs :guard (and (vl::vl-expr-p hid)
-                                (vl::vl-hidexpr-p hid))))
-    (b* (((unless (vl::vl-hid-indicies-resolved-p hid))
-          (er hard? 'stv-hid-split
-              "HID has unresolved indices: ~s0~%" (vl::vl-pps-expr hid))
-          (mv nil ""))
-         (parts (vl::vl-explode-hid hid))
-         ((unless (string-listp parts))
-          ;; Parts is like ("foo" "bar" 3 "baz") for foo.bar[3].baz, too hard
-          (er hard? 'stv-hid-split
-              "We don't currently support hierarchical identifiers that go ~
-             through array instances, like foo.bar[3].baz.  The HID that ~
-             triggered this error was: ~s0~%" (vl::vl-pps-expr hid))
-          (mv nil ""))
-         ((when (< (len parts) 2))
-          ;; I don't really see how this could happen.  Maybe it can't happen.
-          (er hard? 'stv-hid-split
-              "Somehow the HID has only one piece?  ~s0~%"
-              (vl::vl-pps-expr hid))
-          (mv nil ""))
-         (instnames (butlast parts 1))
-         (wirename  (car (last parts))))
-      (mv instnames wirename)))
-
-  (local (in-theory (enable stv-hid-split)))
-
-  (defthm true-listp-of-stv-hid-split
-    (true-listp (mv-nth 0 (stv-hid-split hid)))
-    :rule-classes :type-prescription)
-
-  (local (defthm l0
-           (implies (and (string-listp x)
-                         (consp x))
-                    (stringp (car (last x))))
-           :hints(("Goal" :expand (last x)))))
-
-  (defthm stringp-of-stv-hid-split
-    (stringp (mv-nth 1 (stv-hid-split hid)))
-    :rule-classes :type-prescription
-    :hints(("goal" :use ((:instance l0 (x (vl::vl-explode-hid hid)))))))
+  ((hid (and (vl::vl-expr-p hid)
+             (vl::vl-hidexpr-p hid))))
+
+  :returns (mv (instnames true-listp :rule-classes :type-prescription)
+               (wirename stringp :rule-classes :type-prescription))
 
+  (b* (((unless (vl::vl-hid-indicies-resolved-p hid))
+        (raise "HID has unresolved indices: ~s0~%" (vl::vl-pps-expr hid))
+        (mv nil ""))
+       (parts (vl::vl-explode-hid hid))
+       ((unless (string-listp parts))
+        ;; Parts is like ("foo" "bar" 3 "baz") for foo.bar[3].baz, too hard
+        (raise "We don't currently support hierarchical identifiers that go ~
+                through array instances, like foo.bar[3].baz.  The HID that ~
+                triggered this error was: ~s0~%" (vl::vl-pps-expr hid))
+        (mv nil ""))
+       ((when (< (len parts) 2))
+        ;; I don't really see how this could happen.  Maybe it can't happen.
+        (raise "Somehow the HID has only one piece?  ~s0~%"
+               (vl::vl-pps-expr hid))
+        (mv nil ""))
+       (instnames (butlast parts 1))
+       (wirename  (car (last parts))))
+    (mv instnames wirename))
+
+  ///
   (defthm string-listp-of-stv-hid-split
     (string-listp (mv-nth 0 (stv-hid-split hid)))))
 
 
-(defsection stv-hid-parse
+(define stv-hid-parse
   :parents (stv-expand)
   :short "Match a Verilog-style plain or hierarchical name, perhaps with a bit-
 or part-select on the end of it."
 
-  :long "<p><b>Signature:</b> @(call stv-hid-parse) returns @('(mv instnames
-wirename msb-idx lsb-idx)')</p>
-
-<p>This is sort of misnamed because it works for normal identifiers as well as
-hierarchical identifiers.</p>
+  :long "<p>This is sort of misnamed; it works for normal identifiers as well
+as hierarchical identifiers.</p>
 
 <p>Examples:</p>
 
-<ul>
- <li>\"foo[3]\" becomes @('(mv nil \"foo\" 3 3)')</li>
- <li>\"foo.bar.baz\" becomes @('(mv '(\"foo\" \"bar\") \"baz\" nil nil)')</li>
- <li>\"foo.bar.baz[3]\" becomes @('(mv '(\"foo\" \"bar\") \"baz\" 3 3)')</li>
- <li>\"foo.bar.baz[3:0]\" becomes @('(mv '(\"foo\" \"bar\") \"baz\" 3 0)')</li>
-</ul>
-
-<p>If the input string name isn't of an acceptable form, an error is
-caused.</p>"
-
-  (defund stv-hid-parse (str)
-    (declare (xargs :guard (stringp str)))
-    (b* ((expr (vl::vl-parse-expr-from-str str))
-         ((unless expr)
-          (er hard? 'stv-hid-parse "Failed to parse: ~s0" str)
-          (mv nil "" nil nil))
-         ((mv err from msb lsb) (stv-maybe-match-select expr))
-         ((when err)
-          (er hard? 'stv-hid-parse "~s0" err)
-          (mv nil "" nil nil))
-
-         ((when (vl::vl-idexpr-p from))
-          ;; This is legitimate for top-level internal wires like foo[3]; There
-          ;; just aren't any instnames to follow.
-          (mv nil (vl::vl-idexpr->name from) msb lsb))
-
-         ((unless (vl::vl-hidexpr-p from))
-          (er hard? 'stv-hid-parse "Invalid STV wire name: ~s0" str)
-          (mv nil "" nil nil))
+@({
+                       instnames    wirename   msb    lsb
+ foo[3]           -->  nil          foo        3      3
+ foo.bar.baz      -->  (foo bar)    baz        nil    nil
+ foo.bar.baz[3]   -->  (foo bar)    baz        3      3
+ foo.bar.baz[3:0] -->  (foo bar)    baz        3      0
+})
+
+<p>If the input string name isn't of an acceptable form, we cause an
+error.</p>"
+
+  ((str stringp "The string to parse and split up."))
+
+  :returns
+  (mv (instnames true-listp :rule-classes :type-prescription)
+      (wirename  stringp    :rule-classes :type-prescription)
+      (msb-idx   (or (not msb-idx) (natp msb-idx)) :rule-classes :type-prescription)
+      (lsb-idx   (or (not lsb-idx) (natp lsb-idx)) :rule-classes :type-prescription))
+
+  (b* ((expr (vl::vl-parse-expr-from-str str))
+       ((unless expr)
+        (raise "Failed to parse: ~s0" str)
+        (mv nil "" nil nil))
+       ((mv err from msb lsb) (stv-maybe-match-select expr))
+       ((when err)
+        (raise "~s0" err)
+        (mv nil "" nil nil))
+
+       ((when (vl::vl-idexpr-p from))
+        ;; This is legitimate for top-level internal wires like foo[3]; There
+        ;; just aren't any instnames to follow.
+        (mv nil (vl::vl-idexpr->name from) msb lsb))
+
+       ((unless (vl::vl-hidexpr-p from))
+        (raise "Invalid STV wire name: ~s0" str)
+        (mv nil "" nil nil))
 
-         ((mv instnames wirename) (stv-hid-split from)))
-      (mv instnames wirename msb lsb)))
+       ((mv instnames wirename) (stv-hid-split from)))
+    (mv instnames wirename msb lsb))
 
-  (local (in-theory (enable stv-hid-parse)))
-
-  (defmvtypes stv-hid-parse
-    (true-listp stringp (or (not x) (natp x)) (or (not x) (natp x))))
+  ///
 
   (defthm string-listp-of-stv-hid-parse
     (string-listp (mv-nth 0 (stv-hid-parse str))))
@@ -420,92 +393,87 @@
 
 
 
-(defsection stv-hid-to-paths
+(define stv-turn-bits-into-non-canonical-paths
+  :parents (stv-hid-to-paths)
+  ((instname-list  true-listp
+                   "e.g., (foo bar)")
+   (bits           "e.g., (baz[3] baz[2] baz[1] baz[0])"))
+  :returns (merged "e.g., @({
+                               ((foo bar . baz[3])
+                                (foo bar . baz[2])
+                                ...
+                                (foo bar . baz[0]))
+                          })")
+  (if (atom bits)
+      nil
+    (cons (append instname-list (car bits))
+          (stv-turn-bits-into-non-canonical-paths instname-list (cdr bits)))))
+
+
+(define stv-hid-to-paths
   :parents (stv-expand)
   :short "Convert a Verilog-style plain or hierarchical name (optionally with a
 bit- or part-select) into an LSB-ordered list of <b>non-canonical</b> ESIM
 paths."
 
-  :long "<p>@(call stv-hid-to-paths) returns a list of LSB-first ordered paths
-in the sense of @(see acl2::mod-internal-paths).</p>
-
-<ul>
-
-<li>@('x') is a string like @('foo'), @('foo[3:0]'), @('foo.bar.baz'),
-@('foo.bar.baz[3]'), etc.  That is, it should either be a plain or hierarchical
-Verilog identifier, perhaps with a bit or part-select on the end.</li>
-
-<li>@('mod') is the E module that X is based in.</li>
-
-</ul>"
-
-  (defund stv-turn-bits-into-non-canonical-paths
-    (instname-list  ;; (foo bar)
-     bits           ;; (baz[3] baz[2] baz[1] baz[0])
-     )
-    ;; ---> ( (foo bar . baz[3])
-    ;;        (foo bar . baz[2])
-    ;;        ...
-    ;;        (foo bar . baz[0]) )
-    (declare (xargs :guard (true-listp instname-list)))
-    (if (atom bits)
-        nil
-      (cons (append instname-list (car bits))
-            (stv-turn-bits-into-non-canonical-paths instname-list (cdr bits)))))
-
-  (defund stv-hid-to-paths (x mod)
-    (declare (xargs :guard (stringp x)))
-    (b* (((mv instnames wirename msb lsb) (stv-hid-parse x))
-
-         ;; 1. Find the submod that this HID points to.
-         (instnames (intern-list-in-package-of-symbol instnames (pkg-witness "ACL2")))
-         (submod    (follow-esim-path instnames mod))
-         ((unless submod)
-          (er hard? 'stv-hid-to-paths
-              "Error following path ~x0 in ~x1." x (gpl :n mod)))
-
-         ;; 2. Look up this E names for this wire in the wire alist.  Note that
-         ;; the WALIST has the bits in MSB-First order!
-         (walist (vl::esim-vl-wirealist submod))
-         (lookup (hons-assoc-equal wirename walist))
-         ((unless lookup)
-          (er hard? 'stv-hid-to-paths
-              "Can't follow ~s0: followed the instances ~x1 to an ~x2 ~
-               submodule, but then there was no wire named ~s3 in the wire ~
-               alist." x instnames (gpl :n submod) wirename))
-         (msb-first-wires (cdr lookup))
-         (lsb-first-wires (reverse msb-first-wires))
-
-         ((unless (and msb lsb))
-          ;; X is something like "foo" or "foo.bar.baz" with no bit- or
-          ;; part-select, so the user is asking for the whole wire!
-          (stv-turn-bits-into-non-canonical-paths instnames lsb-first-wires))
-
-         ;; Otherwise, X is something like "foo[3]" or "foo.bar.baz[5:3]", so
-         ;; we need to make sure this range is in bounds and going in the right
-         ;; direction.
-         (expect-bits
-          ;; Stupid hack: it would be nicer to write:
-          ;; (reverse (vl-emodwires-from-msb-to-lsb basename msb lsb))
-          ;; But we just reverse the lsb/msb to avoid the extra consing
-          (vl::vl-emodwires-from-msb-to-lsb wirename lsb msb))
-
-         ;; Make sure that the bits exist and are properly ordered for this wire
-         ((unless (ordered-subsetp expect-bits lsb-first-wires))
-          (er hard? 'stv-hid-to-paths
-              "Trying to expand ~s0, but the bits being asked for ~s1.~% ~
-               - Found wires: ~x2 through ~x3~% ~
-               - Want wires:  ~x4 through ~x5."
-              x
-              (if (subsetp-equal expect-bits lsb-first-wires)
-                  "are not in the right order"
-                "are not found")
-              (car lsb-first-wires)
-              (car (last lsb-first-wires))
-              (car expect-bits)
-              (car (last expect-bits)))))
+  ((x stringp "A string like @('foo'), @('foo[3:0]'), @('foo.bar.baz'),
+               @('foo.bar.baz[3]'), etc.  That is, it should either be a plain
+               or hierarchical Verilog identifier, perhaps with a bit or
+               part-select on the end.")
+
+   (mod "The @(see esim) module that this path should be relative to."))
+
+  :returns (lsb-paths "LSB-first list of non-canonical paths for @('x'), in the
+                       sense of @(see acl2::mod-internal-paths).")
+
+  (b* (((mv instnames wirename msb lsb) (stv-hid-parse x))
+
+       ;; 1. Find the submod that this HID points to.
+       (instnames (str::intern-list instnames))
+       (submod    (follow-esim-path instnames mod))
+       ((unless submod)
+        (raise "Error following path ~x0 in ~x1." x (gpl :n mod)))
+
+       ;; 2. Look up this E names for this wire in the wire alist.  Note that
+       ;; the WALIST has the bits in MSB-First order!
+       (walist (vl::esim-vl-wirealist submod))
+       (lookup (hons-assoc-equal wirename walist))
+       ((unless lookup)
+        (raise "Can't follow ~s0: followed the instances ~x1 to an ~x2 ~
+                submodule, but then there was no wire named ~s3 in the wire ~
+                alist." x instnames (gpl :n submod) wirename))
+       (msb-first-wires (cdr lookup))
+       (lsb-first-wires (reverse msb-first-wires))
+
+       ((unless (and msb lsb))
+        ;; X is something like "foo" or "foo.bar.baz" with no bit- or
+        ;; part-select, so the user is asking for the whole wire!
+        (stv-turn-bits-into-non-canonical-paths instnames lsb-first-wires))
+
+       ;; Otherwise, X is something like "foo[3]" or "foo.bar.baz[5:3]", so
+       ;; we need to make sure this range is in bounds and going in the right
+       ;; direction.
+       (expect-bits
+        ;; Stupid hack: it would be nicer to write:
+        ;; (reverse (vl-emodwires-from-msb-to-lsb basename msb lsb))
+        ;; But we just reverse the lsb/msb to avoid the extra consing
+        (vl::vl-emodwires-from-msb-to-lsb wirename lsb msb))
+
+       ;; Make sure that the bits exist and are properly ordered for this wire
+       ((unless (ordered-subsetp expect-bits lsb-first-wires))
+        (raise "Trying to expand ~s0, but the bits being asked for ~s1.~% ~
+                 - Found wires: ~x2 through ~x3~% ~
+                 - Want wires:  ~x4 through ~x5."
+               x
+               (if (subsetp-equal expect-bits lsb-first-wires)
+                   "are not in the right order"
+                 "are not found")
+               (car lsb-first-wires)
+               (car (last lsb-first-wires))
+               (car expect-bits)
+               (car (last expect-bits)))))
 
-      (stv-turn-bits-into-non-canonical-paths instnames expect-bits))))
+    (stv-turn-bits-into-non-canonical-paths instnames expect-bits)))
 
   #||
 
@@ -543,68 +511,88 @@
 ;; This one is an output:
 
 (stv-hid-to-paths "mmxdphi.logicops001.mdpmmxlogres_e" acl2::|*mmx*|)
-   ;; -- good, suerior module's wire, 64-127
+   ;; -- good, superior module's wire, 64-127
 
   ||#
 
 
+(define stv-check-noncanonical-paths (paths mod)
+  :parents (stv-expand)
+  :short "Checks that the listed paths all exist in the module"
+  (b* (((when (atom paths)) nil)
+       (path (car paths))
+       (submod (follow-esim-path path mod))
+       (wirename (if (atom path) path (cdr (last path)))))
+    (if (and wirename (symbolp wirename))
+        (or (member-of-pat-flatten wirename (gpl :i submod))
+            (find-in-occs-field :o wirename (gpl :occs submod))
+            (raise "Path ~x0 does not exist" path))
+      (raise "~x0 is not a valid wirename" wirename))
+    (stv-check-noncanonical-paths (cdr paths) mod)))
+       
+       
+    
+
+(define stv-expand-hid
+  :parents (stv-expand)
+  :short "@(call stv-expand-hid) expands a signal name when it is allowed to be
+hierarchical, i.e. a hid or a list of esim paths."
+  :returns (lsb-paths "LSB-first list of non-canonical paths for @('x'), in the
+                       sense of @(see acl2::mod-internal-paths).")
+  ((name "the name at the start of the STV line")
+   mod)
+
+  (if (stringp name)
+      ;; assume it's a hid
+      (stv-hid-to-paths name mod)
+    (prog2$ (stv-check-noncanonical-paths name mod)
+            name)))
 
-(defsection stv-expand-hids-in-lines
+(define stv-expand-hids-in-lines
   :parents (stv-expand)
   :short "@(call stv-expand-hids-in-lines) expands all of the HIDs in a list of
 STV internal lines into lists of esim paths."
+  ((lines true-list-listp) mod)
+  :returns (new-lines "Copy of @('lines') except with expanded names.")
 
-  (defund stv-expand-hids-in-lines (lines mod)
-    (declare (xargs :guard (true-list-listp lines)))
-    (b* (((when (atom lines))
-          nil)
-         (line1              (car lines))
-         ((cons name phases) line1)
-         ((unless (stringp name))
-          (er hard? 'stv-expand-hids-in-lines
-              "Internals line name is not a string: ~x0" name))
-         (lsb-paths (stv-hid-to-paths name mod)))
-      (cons (cons lsb-paths phases)
-            (stv-expand-hids-in-lines (cdr lines) mod))))
-
-  (local (in-theory (enable stv-expand-hids-in-lines)))
-
+  (b* (((when (atom lines))
+        nil)
+       (line1              (car lines))
+       ((cons name phases) line1)
+       (lsb-paths (stv-expand-hid name mod)))
+    (cons (cons lsb-paths phases)
+          (stv-expand-hids-in-lines (cdr lines) mod)))
+  ///
   (defthm alistp-of-stv-expand-hids-in-lines
     (alistp (stv-expand-hids-in-lines lines mod)))
-
   (defthm true-list-listp-of-stv-expand-hids-in-lines
     (implies (true-list-listp lines)
              (true-list-listp (stv-expand-hids-in-lines lines mod)))))
 
 
 
-(defsection stv-expand
+(define stv-expand
   :parents (symbolic-test-vectors)
   :short "Expand Verilog-style names throughout an STV into LSB-ordered ESIM
 style paths."
+  
 
-  :long "<p><b>Signature:</b> @(call stv-expand) returns a new @(see
-stvdata-p).</p>
+  ((stv stvdata-p)
+   mod)
+  :returns (new-stv stvdata-p :hyp :fguard
+                    "Copy of @('stv') but with all names expanded.")
 
-<p>This is an STV preprocessing step which can be run before or after @(see
-stv-widen).  It only affects the names in each STV line.</p>
+  :long "<p>This is an STV preprocessing step which can be run before or after
+@(see stv-widen).  It only affects the names in each STV line.</p>
 
 <p>During this step, we resolve Verilog-style names like \"foo[3:0]\" and
 \"foo.bar.baz[6:0],\" replacing them with LSB-ordered lists of ESIM bits or
 paths.  This keeps the Verilog-specific stuff out of the rest of the STV
 compiler.</p>"
 
-  (defund stv-expand (stv mod)
-    (declare (xargs :guard (stvdata-p stv)))
-    (b* (((stvdata stv) stv))
-      (make-stvdata :inputs    (stv-expand-names-in-lines stv.inputs :i mod)
-                    :outputs   (stv-expand-names-in-lines stv.outputs :o mod)
-                    :initial   (stv-expand-hids-in-lines stv.initial mod)
-                    :internals (stv-expand-hids-in-lines stv.internals mod))))
-
-  (local (in-theory (enable stv-expand)))
-
-  (defthm stvdata-p-of-stv-expand
-    (implies (force (stvdata-p stv))
-             (stvdata-p (stv-expand stv mod)))))
+  (b* (((stvdata stv) stv))
+    (make-stvdata :inputs    (stv-expand-names-in-lines stv.inputs :i mod)
+                  :outputs   (stv-expand-names-in-lines stv.outputs :o mod)
+                  :internals (stv-expand-hids-in-lines stv.internals mod)
+                  :overrides (stv-expand-hids-in-lines stv.overrides mod))))
 
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-run.lisp acl2-6.3/books/centaur/esim/stv/stv-run.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-run.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-run.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -32,38 +32,22 @@
 (local (include-book "centaur/vl/util/arithmetic" :dir :system))
 
 
-;; For efficient execution of stv-run in GL, we want to our clause processors
-;; to be able to natively execute these functions.
-(gl::add-clause-proc-exec-fns '(4v-sexpr-restrict-with-rw-alist
-                                vl::append-domains
-                                sets::mergesort
-                                sets::subset
-                                sets::union
-                                sets::difference))
-
-
-(defsection stv-simvar-inputs-to-bits
+(define stv-simvar-inputs-to-bits
   :parents (stv-run)
   :short "Convert the user-level input alist (which binds simulation variables
 to naturals) into a bit-level alist for @(see 4v-sexpr-eval)."
 
-  :long "<p>@(call stv-simvar-inputs-to-bits) is given:</p>
-
-<ul>
-
-<li>@('user-alist'), the alist provided by the user that gives values to the
-input simulation variables.  Each value should be a natural number that is in
-the range for that simulation variable.</li>
+  ((user-alist  "The alist provided by the user that gives values to the input
+                 simulation variables.  Each value should be a natural number that
+                 is in the range for that simulation variable.")
+
+   (in-usersyms "A fast alist that binds each input simulation variable for the
+                 STV with a list of variables that represent its bits; see @(see
+                 stv-compile), but in particular see the @('usersyms') output of
+                 @(see stv-expand-input-entry)."))
 
-<li>@('in-usersyms'), a fast alist that binds each input simulation variable
-for the STV with a list of variables that represent its bits; see @(see
-stv-compile), but in particular see the @('usersyms') output of @(see
-stv-expand-input-entry).</li>
-
-</ul>
-
-<p>We try to translate every user-level binding, like @('(opcode . 7)'), into a
-set of bit-level bindings, say something like:</p>
+  :long "<p>We try to translate every user-level binding, like @('(opcode
+. 7)'), into a set of bit-level bindings, say something like:</p>
 
 @({
   ((opcode[0] . *4vt*)
@@ -88,157 +72,143 @@
 the alist semantics are preserved because shadowed bindings are still shadowed
 in the bit-level alist.</p>"
 
-  (defund stv-simvar-inputs-to-bits (user-alist in-usersyms)
-    (declare (xargs :guard t))
-    (b* (((when (atom user-alist))
-          nil)
-
-         (rest  (stv-simvar-inputs-to-bits (cdr user-alist) in-usersyms))
-
-         ((when (atom (car user-alist)))
-          ;; Bad alist convention
-          (cw "stv-simvar-inputs-to-bits: skipping malformed alist entry
-               ~x0.~%" (car user-alist))
-          rest)
-
-         (name (caar user-alist))
-         (val  (cdar user-alist))
-         (look (hons-get name in-usersyms))
-
-         ((unless look)
-          (er hard? 'stv-simvar-inputs-to-bits
-              "Value given for ~x0, but this is not a simulation variable."
-              name)
-          rest)
-
-         (vars  (cdr look))
-         (nvars (len vars))
-
-         (vals (cond ((eq val *4vx*)
-                      (repeat *4vx* nvars))
-                     ((and (natp val)
-                           (< val (ash 1 nvars)))
-                      (bool-to-4v-lst (int-to-v val nvars)))
-                     (t
-                      (progn$
-                       (er hard? 'stv-simvar-inputs-to-bits
-                           "Value ~x0 given for ~x1, but this value is not X ~
-                           or in range for a ~x2-bit unsigned number."
-                           val name nvars)
-                       (repeat *4vx* nvars))))))
+  (b* (((when (atom user-alist))
+        nil)
 
-      (safe-pairlis-onto-acc vars vals rest))))
+       (rest  (stv-simvar-inputs-to-bits (cdr user-alist) in-usersyms))
 
+       ((when (atom (car user-alist)))
+        ;; Bad alist convention
+        (cw "stv-simvar-inputs-to-bits: skipping malformed alist entry ~x0.~%"
+            (car user-alist))
+        rest)
+
+       (name (caar user-alist))
+       (val  (cdar user-alist))
+       (look (hons-get name in-usersyms))
+
+       ((unless look)
+        (raise "Value given for ~x0, but this is not a simulation variable."
+               name)
+        rest)
+
+       (vars  (cdr look))
+       (nvars (len vars))
+
+       (vals (cond ((eq val *4vx*)
+                    (repeat *4vx* nvars))
+                   ((and (natp val)
+                         (< val (ash 1 nvars)))
+                    (bool-to-4v-lst (int-to-v val nvars)))
+                   (t
+                    (progn$
+                     (raise "Value ~x0 given for ~x1, but this value is not X ~
+                             or in range for a ~x2-bit unsigned number."
+                            val name nvars)
+                     (repeat *4vx* nvars))))))
+
+    (safe-pairlis-onto-acc vars vals rest)))
+
+
+(define collect-bits-bound-to-x (keys alist)
+  :parents (stv-assemble-output-alist)
+  (b* (((when (atom keys))
+        nil)
+       (lookup (hons-get (car keys) alist))
+       ((when (eq (cdr lookup) 'x))
+        (cons (car keys)
+              (collect-bits-bound-to-x (cdr keys) alist))))
+    (collect-bits-bound-to-x (cdr keys) alist)))
 
 
-(defsection stv-assemble-output-alist
+(define stv-assemble-output-alist
   :parents (stv-run)
   :short "Convert the bit-level bindings from after @(see 4v-sexpr-eval) into
 user-level bindings of the output simulation variables to naturals or X."
 
-  :long "<p>@(call stv-assemble-output-alist) is given:</p>
-
-<ul>
-
-<li>@('bit-out-alist'), a fast alist that binds the output simulation variable
-bit names to their @(see 4vp) constants.  This alist should have been produced
-by calling @(see 4v-sexpr-eval) on the @('relevant-signals') s-expressions of a
-@(see processed-stv-p).</li>
-
-<li>@('out-usersyms'), an alist that binds each output simulation variable for
-the STV with a list of variables that represent its bits; see @(see
-stv-compile), but in particular see the @('usersyms') output of @(see
-stv-expand-output-entry).</li>
-
-</ul>
-
-<p>We recur down @('out-usersyms').  For each output variable, we look up the
-values of its bits in @('bit-out-alist'), and then try to combine these bits
-into a single integer value.  If any bit is X, we just say the whole output is
-X.</p>"
-
-  (defund collect-bits-bound-to-x (keys alist)
-    (declare (xargs :guard t))
-    (if (atom keys)
-        nil
-      (let ((lookup (hons-get (car keys) alist)))
-        (if (eq (cdr lookup) 'x)
-            (cons (car keys)
-                  (collect-bits-bound-to-x (cdr keys) alist))
-          (collect-bits-bound-to-x (cdr keys) alist)))))
-
-  (defund stv-assemble-output-alist (bit-out-alist out-usersyms)
-    (declare (xargs :guard t))
-    (b* (((when (atom out-usersyms))
-          nil)
-         (rest (stv-assemble-output-alist bit-out-alist (cdr out-usersyms)))
-         ((when (atom (car out-usersyms)))
-          (er hard? 'stv-assemble-output-alist "out-usersyms should be an alist.")
-          rest)
-         ((cons user-name bits) (car out-usersyms))
-         (vals      (vl::look-up-each-fast bits bit-out-alist))
-         (true-val  (4v-to-nat vals))
-         (- (and (eq true-val 'x)
-                 (cw "Bits bound to X in ~x0: ~x1~%"
-                     user-name (collect-bits-bound-to-x bits bit-out-alist)))))
-      (cons (cons user-name true-val) rest))))
+  ((bit-out-alist "A fast alist that binds the output simulation variable bit
+                   names to their @(see 4vp) constants.  This alist should have
+                   been produced by calling @(see 4v-sexpr-eval) on the
+                   @('relevant-signals') sexprs of a @(see processed-stv-p).")
+
+   (out-usersyms "An ordinary alist that binds each output simulation variable
+                  for the STV with a list of variables that represent its bits;
+                  see @(see stv-compile), but in particular see the
+                  @('usersyms') output of @(see stv-expand-output-entry)"))
+
+  :long "<p>We recur down @('out-usersyms').  For each output variable, we look
+up the values of its bits in @('bit-out-alist'), and then try to combine these
+bits into a single integer value.  If any bit is X, we just say the whole
+output is X.</p>"
 
+  (b* (((when (atom out-usersyms))
+        nil)
+       (rest (stv-assemble-output-alist bit-out-alist (cdr out-usersyms)))
+       ((when (atom (car out-usersyms)))
+        (raise "out-usersyms should be an alist.")
+        rest)
+       ((cons user-name bits) (car out-usersyms))
+       (vals      (vl::look-up-each-fast bits bit-out-alist))
+       (true-val  (4v-to-nat vals))
+       (- (and (eq true-val 'x)
+               (cw "Bits bound to X in ~x0: ~x1~%"
+                   user-name (collect-bits-bound-to-x bits bit-out-alist)))))
+    (cons (cons user-name true-val) rest)))
 
 
-(defun stv-print-alist (x)
-  ;; Dumb printing utility.  X is expected to be an alist binding symbols to
-  ;; values.  We print them out hexified and indented in a nice way.
-  (declare (xargs :guard t))
+(define stv-print-alist (x)
+  :parents (stv-run)
+  :short "Dumb printing utility.  X is expected to be an alist binding symbols
+          to values.  We print them out hexified and indented in a nice way."
   (b* (((when (atom x))
         nil)
        ((unless (consp (car x)))
-        (er hard? 'stv-print-alist
-            "Malformed alist: Entry ~x0 is not a (key . val) pair.~%"
-            (car x)))
+        (raise "Malformed alist: Entry ~x0 is not a (key . val) pair.~%"
+               (car x)))
        ((cons key val) (car x))
        ((unless (symbolp key))
-        (er hard? 'stv-print-alist
-            "Malformed alist: name is not a symbolp.~%"
-            (car x)))
+        (raise "Malformed alist: name is not a symbolp.~%"
+               (car x)))
        (- (cw "  ~s0:~t1~s2~%" key 20 (str::hexify val))))
     (stv-print-alist (cdr x))))
 
 
-
-(defsection stv-run
+(define stv-run
   :parents (symbolic-test-vectors)
   :short "Evaluate a symbolic test vector at particular, concrete inputs."
 
-  :long "<p><b>Signature:</b> @(call stv-run) returns an alist that binds
-user-level outputs to natural numbers or X.</p>
-
-<p>The basic form of @('stv-run') only requires two inputs:</p>
-
-<ul>
-
-<li>The @('pstv') is an @(see processed-stv-p) that should have been produced
-by @(see stv-process).</li>
+  ((pstv        processed-stv-p
+                "The symbolic test vector to run.")
 
-<li>The @('input-alist') is an alist that should bind some of the input
-simulation variables to natural numbers, or to the symbol X.  Any inputs that
-aren't mentioned are implicitly bound to X.</li>
+   (input-alist "An alist that should typically bind at least some of the input
+                 simulation variables to natural numbers, or to the symbol X.
+                 Any inputs that aren't mentioned are implicitly bound to X.")
+   &key
+   (skip        "Advanced option to avoid computing certain outputs; see below.")
+
+   (quiet       "Suppress debugging output.  By default, @('stv-run') will print
+                 certain debugging information.  This is generally convenient in
+                 @(see def-gl-thm) forms involving an @('stv-run'), and will allow
+                 you to see nicely-formatted debugging info when counter-examples
+                 are found.  But you can use @(':quiet t') to suppress it."))
 
-</ul>
+  :returns (out-alist "Alist binding user-level STV outputs to either natural
+                       numbers or X.")
 
-<p>And in this case, the evaluation basically involves three steps:</p>
+  :long "<p>Evaluating an stv basically involves three steps:</p>
 
 <ol>
 
 <li>We translate the @('input-alist') into bit-level bindings; see @(see
 stv-simvar-inputs-to-bits).</li>
 
-<li>We evaluate the relevant output bits from the processed STV, using these
-bit-level bindings, basically by calling @(see 4v-sexpr-eval) on each output
+<li>Using these bit-level bindings, we evaluate the relevant output bits from
+the processed STV, basically by calling @(see 4v-sexpr-eval) on each output
 bit.</li>
 
-<li>We take the evaluated output bits and merge them back into an alist that
-binds the output simulation variables to natural numbers or Xes; see @(see
-stv-assemble-output-alist).</li>
+<li>We take the evaluated output bits and merge them back into a user-level
+alist that binds the output simulation variables to natural numbers or Xes; see
+@(see stv-assemble-output-alist).</li>
 
 </ol>
 
@@ -248,103 +218,94 @@
 a module that emits several flags in addition to its result, but you don't care
 about the flags for some instructions.  Then, you can tell @('stv-run') to skip
 computing the flags as you verify these instructions, which may lead to a big
-savings when BDDs are involved.</p>
+savings when BDDs are involved.</p>"
 
-<p>By default, @('stv-run') will print certain debugging information.  This is
-generally convenient in @(see def-gl-thm) forms involving an @('stv-run'), and
-will allow you to see nicely-formatted debugging info when counter-examples are
-found.  You can suppress this output with @(':quiet nil').</p>"
-
-  (defund stv-run-fn (pstv input-alist skip quiet)
-    (declare (xargs :guard (processed-stv-p pstv)))
-    (time$
-     (b* (((processed-stv pstv) pstv)
-          ((compiled-stv cstv) pstv.compiled-stv)
-
-          (- (or quiet
-                 (cw "STV Raw Inputs: ~x0.~%" input-alist)))
-
-          (out-usersyms cstv.out-usersyms)
-          (in-usersyms
-           ;; These should already be a fast alist, but in case the object was
-           ;; serialized and reloaded or something, we'll go ahead and try to
-           ;; make them fast again.
-           (make-fast-alist cstv.in-usersyms))
-
-          ;; Start with all of the signals that we have in our STV.  These have
-          ;; the expressions for the bits of the output simulation variables.
-          (sigs        pstv.relevant-signals)
-
-          ;; Prune away any signals that the user says he wants to skip.
-          ((mv sigs out-usersyms)
-           (time$ (b* (((unless skip)
-                        (mv sigs out-usersyms))
-
-                       ;; As a sanity check, complain if there are any bits
-                       ;; that are being skipped that don't actually exist.
-                       (skip     (sets::mergesort skip))
-                       (outnames (sets::mergesort (alist-keys out-usersyms)))
-                       ((unless (sets::subset skip outnames))
-                        (b* ((bad  (sets::difference skip outnames))
-                             ;; Don't use - or implicit progn$ on these, we want to make sure
-                             ;; these get evaluated during GL runs.
-                             (?msg (cw "Invalid skip!  Not outputs: ~&0." bad))
-                             (?err (er hard? 'stv-run-fn "Invalid skip!  Not outputs: ~&0." bad)))
-                          (mv sigs out-usersyms)))
-
-                       ;; Filter the out-usersyms down to just those that we want.
-                       (keep         (sets::difference outnames skip))
-                       (out-usersyms (b* ((tmp (make-fal out-usersyms nil))
-                                          (ret (fal-extract keep tmp)))
-                                       (fast-alist-free tmp)
-                                       ret))
-
-                       ;; Also filter the sigs down to just the bits we need.
-                       (keep-bits (vl::append-domains out-usersyms))
-                       (sigs      (b* ((tmp (make-fal sigs nil))
-                                       (ret (fal-extract keep-bits tmp)))
-                                    (fast-alist-free tmp)
-                                    ret)))
-
-                    (mv sigs out-usersyms))
-                  :mintime 1/2
-                  :msg "; stv-run skips: ~st sec, ~sa bytes."))
-
-          ;; Construct the alist to evaluate with
-          (ev-alist
-           (time$ (make-fast-alist
-                   (stv-simvar-inputs-to-bits input-alist in-usersyms))
-                  :mintime 1/2
-                  :msg "; stv-run ev-alist: ~st sec, ~sa bytes.~%"))
-
-          ;; Evaluate the non-skipped signals.
-          (evaled-out-bits
-           (time$ (make-fast-alist (4v-sexpr-simp-and-eval-alist sigs ev-alist))
-                  :mintime 1/2
-                  :msg "; stv-run out-bits: ~st sec, ~sa bytes.~%"))
-
-          (- (fast-alist-free ev-alist))
-
-          ;; Assemble the non-skipped outputs.
-          (assembled-outs
-           (time$ (stv-assemble-output-alist evaled-out-bits out-usersyms)
-                  :mintime 1/2
-                  :msg "; stv-run outs: ~st sec, ~sa bytes.~%"))
-
-          (- (fast-alist-free evaled-out-bits))
-
-          ;; Debugging Support
-          (- (or quiet
-                 (progn$ (cw "~%STV Inputs:~%")
-                         (stv-print-alist input-alist)
-                         (cw "~%STV Outputs:~%")
-                         (stv-print-alist assembled-outs)
-                         (cw "~%")))))
-
-       assembled-outs)
-     :msg "; stv-run: ~st sec, ~sa bytes.~%"
-     :mintime 1))
+  (time$
+   (b* (((processed-stv pstv) pstv)
+        ((compiled-stv cstv) pstv.compiled-stv)
+
+        (- (or quiet
+               (cw "STV Raw Inputs: ~x0.~%" input-alist)))
+
+        (out-usersyms cstv.out-usersyms)
+        (in-usersyms
+         ;; These should already be a fast alist, but in case the object was
+         ;; serialized and reloaded or something, we'll go ahead and try to
+         ;; make them fast again.
+         (make-fast-alist cstv.in-usersyms))
+
+        ;; Start with all of the signals that we have in our STV.  These have
+        ;; the expressions for the bits of the output simulation variables.
+        (sigs        pstv.relevant-signals)
+
+        ;; Prune away any signals that the user says he wants to skip.
+        ((mv sigs out-usersyms)
+         (time$ (b* (((unless skip)
+                      (mv sigs out-usersyms))
+
+                     ;; As a sanity check, complain if there are any bits
+                     ;; that are being skipped that don't actually exist.
+                     (skip     (sets::mergesort skip))
+                     (outnames (sets::mergesort (alist-keys out-usersyms)))
+                     ((unless (sets::subset skip outnames))
+                      (b* ((bad  (sets::difference skip outnames))
+                           ;; Don't use - or implicit progn$ on these, we want to make sure
+                           ;; these get evaluated during GL runs.
+                           (?msg (cw "Invalid skip!  Not outputs: ~&0." bad))
+                           (?err (er hard? 'stv-run-fn "Invalid skip!  Not outputs: ~&0." bad)))
+                        (mv sigs out-usersyms)))
+
+                     ;; Filter the out-usersyms down to just those that we want.
+                     (keep         (sets::difference outnames skip))
+                     (out-usersyms (b* ((tmp (make-fal out-usersyms nil))
+                                        (ret (fal-extract keep tmp)))
+                                     (fast-alist-free tmp)
+                                     ret))
+
+                     ;; Also filter the sigs down to just the bits we need.
+                     (keep-bits (vl::append-domains out-usersyms))
+                     (sigs      (b* ((tmp (make-fal sigs nil))
+                                     (ret (fal-extract keep-bits tmp)))
+                                  (fast-alist-free tmp)
+                                  ret)))
+
+                  (mv sigs out-usersyms))
+                :mintime 1/2
+                :msg "; stv-run skips: ~st sec, ~sa bytes."))
+
+        ;; Construct the alist to evaluate with
+        (ev-alist
+         (time$ (make-fast-alist
+                 (stv-simvar-inputs-to-bits input-alist in-usersyms))
+                :mintime 1/2
+                :msg "; stv-run ev-alist: ~st sec, ~sa bytes.~%"))
+
+        ;; Evaluate the non-skipped signals.
+        (evaled-out-bits
+         (time$ (make-fast-alist (4v-sexpr-simp-and-eval-alist sigs ev-alist))
+                :mintime 1/2
+                :msg "; stv-run out-bits: ~st sec, ~sa bytes.~%"))
+
+        (- (fast-alist-free ev-alist))
+
+        ;; Assemble the non-skipped outputs.
+        (assembled-outs
+         (time$ (stv-assemble-output-alist evaled-out-bits out-usersyms)
+                :mintime 1/2
+                :msg "; stv-run outs: ~st sec, ~sa bytes.~%"))
+
+        (- (fast-alist-free evaled-out-bits))
+
+        ;; Debugging Support
+        (- (or quiet
+               (progn$ (cw "~%STV Inputs:~%")
+                       (stv-print-alist input-alist)
+                       (cw "~%STV Outputs:~%")
+                       (stv-print-alist assembled-outs)
+                       (cw "~%")))))
+
+     assembled-outs)
+   :msg "; stv-run: ~st sec, ~sa bytes.~%"
+   :mintime 1))
 
-  (defmacro stv-run (pstv input-alist &key skip quiet)
-    `(stv-run-fn ,pstv ,input-alist ,skip ,quiet)))
 
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-sim.lisp acl2-6.3/books/centaur/esim/stv/stv-sim.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-sim.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-sim.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -25,12 +25,7 @@
 (include-book "stv-util")
 (include-book "centaur/vl/util/defs" :dir :system)
 (include-book "../steps")
-
-(local (defthm atom-listp-of-append
-         (implies (and (atom-listp x)
-                       (atom-listp y))
-                  (atom-listp (append x y)))
-         :hints(("Goal" :in-theory (disable (force))))))
+(local (include-book "std/typed-lists/atom-listp" :dir :system))
 
 (local (defthm atom-listp-of-pat-flatten1
          (atom-listp (pat-flatten1 x))
@@ -38,172 +33,226 @@
                                         ((force)))))))
 
 
-(defsection stv-fully-general-st-alist
+(define stv-fully-general-st-alist
   :parents (stv-process)
-  :short "@(call stv-fully-general-st-alist) generates a single alist that will
-provide the values for the initial state of @('mod') for a fully general
-simulation."
+  :short "Create the sexpr-alist to use as the initial state for fully general
+simulations of a module."
+  ((mod "The @(see esim) module."))
+  :returns (state-alist "Alist binding every state bit @('|foo|') to
+                         @('|foo.INIT|')")
 
-  :long "<p>We basically just bind every state bit @('|foo|') to
-@('|foo.INIT|').  These names can't clash with each other, or with those
+  :long "<p>These names (obviously) can't clash with each other, or with those
 produced by @(see stv-fully-general-in-alists).</p>
 
 <p>We memoize this to ensure we'll get the same initial state alist across
 different STVs that target the same module.</p>"
 
-  (defund stv-fully-general-st-alist (mod)
-    (declare (xargs :guard t))
-    (b* ((sts      (mod-state mod))
-         (flat-sts (pat-flatten sts nil))
-         ((unless (symbol-listp flat-sts))
-          (er hard? 'stv-fully-general-st-alist
-              "Expected mod-state to produce a symbol pattern for ~x0." (gpl :n mod))))
-      (pairlis$ flat-sts
-                (stv-suffix-signals flat-sts ".INIT"))))
-
+  (b* ((sts      (mod-state mod))
+       (flat-sts (pat-flatten sts nil))
+       ((unless (symbol-listp flat-sts))
+        (raise "Expected mod-state to produce a symbol pattern for ~x0."
+               (gpl :n mod))))
+    (pairlis$ flat-sts
+              (stv-suffix-signals flat-sts ".INIT")))
+  ///
   (memoize 'stv-fully-general-st-alist))
 
 
 
-(defsection stv-fully-general-in-alists
-  :parents (stv-process)
-  :short "@(call stv-fully-general-in-alists) generates @('n') alists which we
-will use as the inputs to @('mod') to do an @('n')-phase, fully general
-simulation."
-
-  :long "<p>This is basically name mangling.  For instance, at phase 5 the
-input @('|foo[3]|') will be represented by the variable @('|foo[3].P5|').
-There can't be any name clashes since we're adding a such a suffix to every
-signal.</p>
-
-<p>We memoize this to ensure that we'll get the same fully general alist across
-different STVs that target the same module for the same numbers of steps.</p>"
-
-  (defund stv-fully-general-in-alist-n (n flat-ins)
-    (declare (xargs :guard (and (symbol-listp flat-ins)
-                                (natp n))))
-    (pairlis$ flat-ins
-              (stv-suffix-signals flat-ins (str::cat ".P" (str::natstr n)))))
-
-  (memoize 'stv-fully-general-in-alist-n)
+(define stv-fully-general-in-alist-n ((n        natp)
+                                      (flat-ins symbol-listp))
+  :parents (stv-fully-general-in-alists)
+  :long "<p>We memoize this to ensure that we'll get the same fully general
+alist across different STVs that target the same module for the same numbers of
+steps.</p>"
+
+  :returns (nth-alist vl::cons-listp)
+  (pairlis$ flat-ins
+            (stv-suffix-signals flat-ins (str::cat ".P" (str::natstr n))))
 
-  (local (defthm c0
+  :prepwork
+  ((local (defthm c0
            (vl::cons-listp (pairlis$ x y))
-           :hints(("Goal" :in-theory (enable pairlis$)))))
+           :hints(("Goal" :in-theory (enable pairlis$))))))
+  ///
+  (memoize 'stv-fully-general-in-alist-n))
 
-  (defthm cons-listp-of-stv-fully-general-in-alist-n
-    (vl::cons-listp (stv-fully-general-in-alist-n n flat-ins))
-    :hints(("Goal" :in-theory (enable stv-fully-general-in-alist-n))))
-
-  (defund stv-fully-general-in-alists-aux (n flat-ins acc)
-    (declare (xargs :guard (and (symbol-listp flat-ins)
-                                (natp n))))
-    (let ((acc (cons (stv-fully-general-in-alist-n n flat-ins) acc)))
-      (if (zp n)
-          acc
-        (stv-fully-general-in-alists-aux (- n 1) flat-ins acc))))
 
+(define stv-fully-general-in-alists-aux ((n        natp)
+                                         (flat-ins symbol-listp)
+                                         acc)
+  :parents (stv-fully-general-in-alists)
+  :returns (in-alists vl::cons-list-listp :hyp (vl::cons-list-listp acc))
+  (let ((acc (cons (stv-fully-general-in-alist-n n flat-ins) acc)))
+    (if (zp n)
+        acc
+      (stv-fully-general-in-alists-aux (- n 1) flat-ins acc)))
+  ///
   (defthm len-stv-fully-general-in-alists-aux
     (equal (len (stv-fully-general-in-alists-aux n flat-ins acc))
-           (+ 1 (nfix n) (len acc)))
-    :hints(("Goal" :in-theory (enable stv-fully-general-in-alists-aux))))
+           (+ 1 (nfix n) (len acc)))))
 
-  (defthm cons-list-listp-of-stv-fully-general-in-alists-aux
-    (implies (vl::cons-list-listp acc)
-             (vl::cons-list-listp (stv-fully-general-in-alists-aux n flat-ins acc)))
-    :hints(("Goal" :in-theory (enable stv-fully-general-in-alists-aux))))
-
-  (defund stv-fully-general-in-alists (n mod)
-    (declare (xargs :guard (posp n)))
-    (b* ((ins      (gpl :i mod))
-         (flat-ins (pat-flatten1 ins))
-         ((when (mbe :logic (not (posp n)) :exec nil))
-          nil)
-         ((unless (symbol-listp flat-ins))
-          (er hard? 'stv-fully-general-in-alists
-              "Expected :i for ~x0 to be a symbol pattern." (gpl :n mod))
-          (ec-call (stv-fully-general-in-alists-aux (- n 1) flat-ins nil))))
-      (stv-fully-general-in-alists-aux (- n 1) flat-ins nil)))
 
+(define stv-fully-general-in-alists
+  :parents (stv-process)
+  :short "Create the sexpr-alists to use as the inputs for each phase of fully
+general simulations of a module."
+
+  ((n   "The number of phases to simulate." posp)
+   (mod "The @(see esim) module."))
+  :returns (in-alists vl::cons-list-listp)
+
+  :long "<p>This is basically name mangling.  For instance, at phase 5 the
+input @('|foo[3]|') will be represented by the variable @('|foo[3].P5|').
+There can't be any name clashes since we're adding a such a suffix to every
+signal.</p>"
+
+  (b* ((ins      (gpl :i mod))
+       (flat-ins (pat-flatten1 ins))
+       ((when (mbe :logic (not (posp n)) :exec nil))
+        nil)
+       ((unless (symbol-listp flat-ins))
+        (raise "Expected :i for ~x0 to be a symbol pattern." (gpl :n mod))
+        (ec-call (stv-fully-general-in-alists-aux (- n 1) flat-ins nil))))
+    (stv-fully-general-in-alists-aux (- n 1) flat-ins nil))
+  ///
   (defthm len-stv-fully-general-in-alists
     (equal (len (stv-fully-general-in-alists n mod))
-           (nfix n))
-    :hints(("Goal" :in-theory (enable stv-fully-general-in-alists))))
+           (nfix n))))
 
-  (defthm cons-list-listp-of-stv-fully-general-in-alists
-    (vl::cons-list-listp (stv-fully-general-in-alists n mod))
-    :hints(("Goal" :in-theory (enable stv-fully-general-in-alists)))))
 
+(local (in-theory (disable good-esim-modulep)))
 
-(defsection stv-fully-general-simulation-run
+(define stv-run-esim
   :parents (stv-process)
-  :short "Run an @('n') step, fully general simulation of @('mod')."
+  ((mod           "The module to run." good-esim-modulep)
+   (in-alists     "A list of N alists, to be used at each phase.")
+   (state-alists  "A list of N alists, to override particular state bits.")
+   (initial-state "Initial state to use."))
+  :guard (eql (len in-alists) (len state-alists))
+  :returns (mv (nsts "A list of next-state alists.")
+               (outs "A list of outputs alists."))
+  (b* (((when (atom in-alists))
+        (mv nil nil))
+       (state-alist (append-without-guard (car state-alists) initial-state))
+       ((mv nst1 out1)
+        (esim-sexpr-simp mod (car in-alists) state-alist))
+       ((mv nst-rest out-rest)
+        (stv-run-esim mod (cdr in-alists) (cdr state-alists) nst1)))
+    (mv (cons nst1 nst-rest)
+        (cons out1 out-rest))))
 
-  :long "<p><b>Signature:</b> @(call stv-fully-general-simulation-run) returns
-@('(mv init-st in-alists nst-alists out-alists NIL)').</p>
+(define stv-fully-general-simulation-run
+  :parents (stv-process)
+  :short "Run an @('n') step, fully general simulation of a module."
 
-<p>The @('init-st') and @('in-alists') are just generated by @(see
-stv-fully-general-st-alist) and @(see stv-fully-general-in-alists),
-respectively, and are probably not very interesting.</p>
-
-<p>The @('nst-alists') and @('out-alists') are each lists of @('n') alists,
-representing the fully-general next states and outputs after each phase.  These
-alists bind signal names to @(see 4v-sexprs) that do not have any assumptions
-about the values given to the module at each phase.</p>
+  ((n   "How many phases to simulate." posp)
+   (mod "The @(see esim) module.")
+   (override-stbits "List of override value and decision state bits"
+                    symbol-listp))
+
+  :returns
+  (mv (init-st "Initial state alist that we used.  This is just generated by
+                @(see stv-fully-general-st-alist) and is probably not very
+                interesting.")
+
+      (in-alists "Input alists that we used at each phase.  This is just
+                  generated by @(see stv-fully-general-in-alists) and is
+                  probably not very interesting.")
+
+      (nst-alists "A list of @('n') alists that capture the fully general
+                   next-state after each phase.")
+
+      (out-alists "A list of @('n') alists that capture the fully general
+                   outputs after each phase.")
+
+      (nil "An extra output which is always @('nil'), for signature
+            compatibility with @(see stv-fully-general-simulation-debug)."))
+
+  :long "<p>This is a fully general simulation, so the nst/out-alists bind
+signal names to @(see 4v-sexprs) in terms of the variables in the init-st and
+in-alists.</p>
 
 <p>See also @(see stv-fully-general-simulation-debug), which produces the same
-alists and also produces a list of fully general alists for the internal wires
-of the modules.  The extra @('nil') we return is for signature compatibility
-with the @('-debug') version.</p>
+outputs but also captures the internal signals after each phase.</p>
 
 <p>We memoize this function so that if we're reusing an STV, we can just reuse
 the same general simulation repeatedly.  BOZO maybe we should be memoizing the
-individual steps instead of the whole run.</p>"
-
-  (defund stv-fully-general-simulation-run (n mod)
-    "Returns (MV INIT-ST IN-ALISTS NST-ALISTS OUT-ALISTS NIL)"
-    (declare (xargs :guard (posp n)))
-    (b* ((in-alists     (stv-fully-general-in-alists n mod))
-         (init-st-alist (stv-fully-general-st-alist mod))
-         ((mv nsts outs)
-          (ec-call
-           (esim-sexpr-simp-steps mod in-alists init-st-alist))))
-      (mv init-st-alist in-alists nsts outs nil)))
+individual steps instead of the whole run, to get more cross-stv sharing.</p>"
 
+  (b* ((in-alists     (stv-fully-general-in-alists n mod))
+       (init-st-alist (stv-fully-general-st-alist mod))
+       (override-alists (stv-fully-general-in-alists-aux (- n 1) override-stbits nil))
+       ((mv nsts outs)
+        (ec-call
+         (stv-run-esim mod in-alists override-alists init-st-alist))))
+    (mv init-st-alist in-alists nsts outs nil))
+  ///
   (memoize 'stv-fully-general-simulation-run :aokp t))
 
 
 
-(local
- (defsection basic-esim-lemmas
 
-   (local (in-theory (enable esim-sexpr-simp-new-probe-steps)))
 
-   (defthm len-of-esim-sexpr-simp-new-probe-steps-0
-     (equal (len (mv-nth 0 (esim-sexpr-simp-new-probe-steps mod ins st)))
-            (len ins)))
-
-   (defthm len-of-esim-sexpr-simp-new-probe-steps-1
-     (equal (len (mv-nth 1 (esim-sexpr-simp-new-probe-steps mod ins st)))
-            (len ins)))
+(define stv-run-esim-debug
+  :parents (stv-process)
+  ((mod           "The module to run." (and (good-esim-modulep mod)
+                                            (new-good-esim-probe-modulep mod)))
+   (in-alists     "A list of N alists, to be used at each phase.")
+   (state-alists  "A list of N alists, to override particular state bits.")
+   (initial-state "Initial state to use."))
+  :guard (eql (len in-alists) (len state-alists))
+  :returns (mv (nsts "A list of next-state alists.")
+               (outs "A list of outputs alists.")
+               (ints "A list of internals alists."))
+  (b* (((when (atom in-alists))
+        (mv nil nil nil))
+       (state-alist (append-without-guard (car state-alists) initial-state))
+       ((mv nst1 out1 int1)
+        (esim-sexpr-simp-new-probe mod (car in-alists) state-alist))
+       ((mv nst-rest out-rest int-rest)
+        (stv-run-esim-debug mod (cdr in-alists) (cdr state-alists) nst1)))
+    (mv (cons nst1 nst-rest)
+        (cons out1 out-rest)
+        (cons int1 int-rest)))
+  ///
+  (defthm len-of-stv-run-esim-debug-0
+    (equal (len (mv-nth 0 (stv-run-esim-debug mod ins st-overrides initial-st)))
+           (len ins)))
+
+  (defthm len-of-stv-run-esim-debug-1
+    (equal (len (mv-nth 1 (stv-run-esim-debug mod ins st-overrides initial-st)))
+           (len ins)))
+
+  (defthm len-of-stv-run-esim-debug-2
+    (equal (len (mv-nth 2 (stv-run-esim-debug mod ins st-overrides initial-st)))
+           (len ins))))
 
-   (defthm len-of-esim-sexpr-simp-new-probe-steps-2
-     (equal (len (mv-nth 2 (esim-sexpr-simp-new-probe-steps mod ins st)))
-            (len ins)))))
 
 
-(defsection stv-fully-general-simulation-debug
+(define stv-fully-general-simulation-debug
   :parents (stv-debug)
   :short "Run an @('n') step, fully general simulation of @('mod') just like
 @(see stv-fully-general-simulation-run), but also gather the fully general
 expressions for internal signals."
 
-  :long "<p><b>Signature:</b> @(call stv-fully-general-simulation-debug)
-returns @('(mv init-st in-alists nst-alists out-alists int-alists)').</p>
-
-<p>This is practically identical to @(see stv-fully-general-simulation-run),
-except that it also gathers up and returns a list of @('int-alists') which
-contain the expressions for the internal signals of the module.</p>
+  ((n   "How many phases to simulate." posp)
+   (mod "The @(see esim) module.")
+   (override-stbits "List of override value and decision state bits"
+                    symbol-listp))
+
+  :returns (mv (init-st    "As in @(see stv-fully-general-simulation-run)")
+               (in-alists  "As in @(see stv-fully-general-simulation-run)")
+               (nst-alists "As in @(see stv-fully-general-simulation-run)")
+               (out-alists "As in @(see stv-fully-general-simulation-run)")
+
+               (int-alists "A list of @('n') alists that capture the fully
+                            general internal signals after each phase."))
+
+  :long "<p>This is practically identical to @(see
+stv-fully-general-simulation-run), except that it also gathers up and returns a
+list of @('int-alists') which contain the expressions for the internal signals
+of the module.</p>
 
 <p>These expressions are useful for generating waveforms for debugging
 simulations.  We could have just had @(see stv-fully-general-simulation-run)
@@ -220,204 +269,198 @@
 as with the -run function, maybe we should be doing the memoization at the level
 of individual steps, instead of memoizing the whole thing.</p>"
 
-  (defund stv-fully-general-simulation-debug (n mod)
-    ;; Same as -run, but includes internals for debugging
-    "Returns (MV INIT-ST IN-ALISTS NST-ALISTS OUT-ALISTS INT-ALISTS)"
-    (declare (xargs :guard (posp n)))
-    (b* ((in-alists     (stv-fully-general-in-alists n mod))
-         (init-st-alist (stv-fully-general-st-alist mod))
-         ((mv nsts outs internals)
-          (ec-call (esim-sexpr-simp-new-probe-steps mod in-alists init-st-alist))))
-      (mv init-st-alist in-alists nsts outs internals)))
-
+  (b* ((in-alists     (stv-fully-general-in-alists n mod))
+       (init-st-alist (stv-fully-general-st-alist mod))
+       (override-alists (stv-fully-general-in-alists-aux (- n 1) override-stbits nil))
+       ((mv nsts outs internals)
+        (ec-call (stv-run-esim-debug mod in-alists override-alists init-st-alist))))
+    (mv init-st-alist in-alists nsts outs internals))
+  ///
   (memoize 'stv-fully-general-simulation-debug :aokp t)
 
   (local (in-theory (enable stv-fully-general-simulation-debug)))
 
   (defthm len-of-stv-fully-general-simulation-debug-1
-    (equal (len (mv-nth 1 (stv-fully-general-simulation-debug nphases mod)))
+    (equal (len (mv-nth 1 (stv-fully-general-simulation-debug nphases mod override-stbits)))
            (nfix nphases)))
 
   (defthm len-of-stv-fully-general-simulation-debug-2
-    (equal (len (mv-nth 2 (stv-fully-general-simulation-debug nphases mod)))
+    (equal (len (mv-nth 2 (stv-fully-general-simulation-debug nphases mod override-stbits)))
            (nfix nphases)))
 
   (defthm len-of-stv-fully-general-simulation-debug-3
-    (equal (len (mv-nth 3 (stv-fully-general-simulation-debug nphases mod)))
+    (equal (len (mv-nth 3 (stv-fully-general-simulation-debug nphases mod override-stbits)))
            (nfix nphases)))
 
   (defthm len-of-stv-fully-general-simulation-debug-4
-    (equal (len (mv-nth 4 (stv-fully-general-simulation-debug nphases mod)))
+    (equal (len (mv-nth 4 (stv-fully-general-simulation-debug nphases mod override-stbits)))
            (nfix nphases)))
 
   (defthm cons-list-listp-of-stv-fully-general-simulation-debug-1
-    (vl::cons-list-listp (mv-nth 1 (stv-fully-general-simulation-debug nphases mod)))))
+    (vl::cons-list-listp
+     (mv-nth 1 (stv-fully-general-simulation-debug nphases mod override-stbits)))))
 
 
 
 ; The final processing stuff could go in its own file, but we already have
-; everything it depends on here, so for build time this seems like the right
-; place for it.
-
+; everything it depends on here, so to optimize build time this seems like the
+; right place for it.
 
-(defsection stv-extract-relevant-signals
+(define stv-extract-relevant-signals
   :parents (stv-process)
   :short "Pull out the fully general expressions for the signals that we care
 about, and bind them to the bit names of the simulation variables."
 
-  :long "<p>@(call stv-extract-relevant-signals) is given:</p>
+  ((extract-alists "The @(see stv-extraction-alists) we obtained from @(see
+                    stv-compile).")
+   (out-alists     "The list of output alists from the fully general simulation,
+                    e.g., from @(see stv-fully-general-simulation-run).")
+   (acc            "An accumulator to extend, which should initially be nil."))
 
-<ul>
-
-<li>@('extract-alists'), the @(see stv-extraction-alists) we obtained from
-@(see stv-compile),</li>
+  :long "<p>We walk down the @('extract-alists') and @('out-alists') together,
+extracting the expressions for the signals that we care about at each phase,
+and naming them with the output simulation variable bit names.</p>"
 
-<li>@('out-alists'), the list of output alists we got from the fully general
-simulation (e.g., from @(see stv-fully-general-simulation-run)), and</li>
+  (b* (((when (and (atom extract-alists)
+                   (atom out-alists)))
+        acc)
+
+       ((when (or (atom extract-alists)
+                  (atom out-alists)))
+        (raise "Should have as many extract alists as out-alists."))
+
+       (extr1 (car extract-alists))
+       (outs1 (car out-alists))
+       ((when (not extr1))
+        ;; Optimization.  There is nothing to extract during this phase,
+        ;; so just go on.  This is very common and lets us avoid making
+        ;; a fast-alist for the out-alist at this step.
+        (stv-extract-relevant-signals (cdr extract-alists)
+                                      (cdr out-alists)
+                                      acc))
+
+       (user-bits  (alist-vals extr1))
+       (want-names (alist-keys extr1))
+       (outs1      (make-fast-alist outs1))
+       (want-exprs (vl::look-up-each-fast want-names outs1))
+       (-          (fast-alist-free outs1))
+       (acc        (safe-pairlis-onto-acc user-bits want-exprs acc)))
+    (stv-extract-relevant-signals (cdr extract-alists)
+                                  (cdr out-alists)
+                                  acc)))
 
-<li>@('acc'), an accumulator to extend which should initially be nil.</li>
 
-</ul>
+(define stv-process
+  :parents (symbolic-test-vectors)
+  :short "Process a symbolic test vector and prepare it to be run."
 
-<p>We walk down the @('extract-alists') and @('out-alists') together,
-extracting the expressions for the signals that we care about at each phase,
-and naming them with the output simulation variable bit names.</p>"
+  ((name "A name for this STV.  Used by @(see stv-debug)."
+         symbolp)
 
-  (defund stv-extract-relevant-signals (extract-alists out-alists acc)
-    (declare (xargs :guard t))
-    (b* (((when (and (atom extract-alists)
-                     (atom out-alists)))
-          acc)
-
-         ((when (or (atom extract-alists)
-                    (atom out-alists)))
-          (er hard? 'stv-extract-relevant-signals
-              "Should have as many extract alists as out-alists."))
-
-         (extr1 (car extract-alists))
-         (outs1 (car out-alists))
-         ((when (not extr1))
-          ;; Optimization.  There is nothing to extract during this phase,
-          ;; so just go on.  This is very common and lets us avoid making
-          ;; a fast-alist for the out-alist at this step.
-          (stv-extract-relevant-signals (cdr extract-alists)
-                                        (cdr out-alists)
-                                        acc))
-
-         (user-bits  (alist-vals extr1))
-         (want-names (alist-keys extr1))
-         (outs1      (make-fast-alist outs1))
-         (want-exprs (vl::look-up-each-fast want-names outs1))
-         (-          (fast-alist-free outs1))
-         (acc        (safe-pairlis-onto-acc user-bits want-exprs acc)))
-      (stv-extract-relevant-signals (cdr extract-alists)
-                                    (cdr out-alists)
-                                    acc))))
+   (stv  stvdata-p
+         "The bundled up, original symbolic test vector description that the
+          user wrote.  This isn't actually used for anything, except that we
+          stuff it into the resulting processed-stv, perhaps mainly for
+          documentation?")
+
+   (cstv compiled-stv-p
+         "An already-compiled version of @('stv').  We take this as an argument,
+          rather than compiling it ourselves, mainly to parallelize the STV
+          book building process.")
+
+   (mod  good-esim-modulep
+         "The @(see esim) module that @('stv') is being written for."))
+
+  :returns (pstv (equal (processed-stv-p pstv)
+                        (if pstv t nil))
+                 :hyp (and (force (symbolp name))
+                           (force (compiled-stv-p cstv)))
+                 "The fully processed, ready-to-run STV.")
 
+  :long "<p>An STV must be processed before it can be run with @(see stv-run).
+This processing can be expensive and involves several steps.</p>
 
+<ul>
 
-(defsection stv-process
-  :parents (symbolic-test-vectors)
-  :short "Process a symbolic test vector and prepare it to be run."
+<li>The @('mod') is symbolically simulated using a fully-general multi-phase
+@(see esim) simulation.</li>
 
-  :long "<p><b>Signature:</b> @(call stv-process) returns a <see topic='@(url
-processed-stv-p)'>processed STV.</see></p>
+<li>The relevant outputs are then extracted from this simulation and
+specialized as suggested by this particular @('stv').</li>
 
-<p>The @('stv') should be an @(see stvdata-p), i.e., the bundled up original
-symbolic test vector description that the user wrote; see @(see defstv).</p>
+<li>These restricted outputs and other information is then saved into a @(see
+processed-stv-p) object that can be given to @(see stv-run) or @(see
+stv-debug).</li>
 
-<p>The @('cstv') should be the already-compiled version of @('stv').  We take
-this as an argument, rather than compiling it ourselves, to split up the build
-process more nicely.</p>
-
-<p>The @('mod') is the @(see esim) module that the @('stv') is being written
-for.</p>
-
-<p>An STV must be processed before it can be run with @(see stv-run).  This
-processing can be expensive and involves several steps.  The @('mod') is
-symbolically simulated using a fully-general multi-phase @(see esim)
-simulation.  The relevant outputs are then extracted from this simulation and
-specialized as suggested by this particular @('stv').  These restricted outputs
-and other information is then saved into a @(see processed-stv-p) object that
-can be given to @(see stv-run) or @(see stv-debug).</p>
+</ul>
 
 <p>Note that there are many chances for memoization, e.g., if you have a lot of
 different symbolic test vectors that all target the same module, they can reuse
 the same @(see esim) simulation, so processing the first STV may be very
 expensive but processing subsequent STVs can be much cheaper.</p>"
 
-  (defund stv-process (stv cstv mod)
-    (declare (xargs :guard (and (stvdata-p stv)
-                                (compiled-stv-p cstv)
-                                (good-esim-modulep mod))))
-    (b* (((compiled-stv cstv) cstv)
-
-         (need-internals
-          ;; We can avoid computing the internal signals if we didn't ask for
-          ;; any.  This is kind of silly, but it can save a lot of time if you
-          ;; don't care about the internals at all.  This isn't ideal, better
-          ;; would be to mark the CSTV with some flag that says whether it
-          ;; needs any int-out bits.
-          (consp cstv.expanded-ints))
-
-         ((mv ?init-st-general
-              ?in-alists-general
-              ?nst-alists-general
-              out-alists-general
-              int-alists-general)
-          ;; Do the fully general simulation for however many steps are needed.
-          (if need-internals
-              (time$ (stv-fully-general-simulation-debug cstv.nphases mod)
-                     :msg "; stv-process debug simulation: ~st sec, ~sa bytes.~%"
-                     :mintime 1/2)
-            (time$ (stv-fully-general-simulation-run cstv.nphases mod)
-                   :msg "; stv-process simulation: ~st sec, ~sa bytes.~%"
-                   :mintime 1/2)))
-
-         (relevant-signals-general
-          ;; The out-alists-general and int-alists-general bind names to sexprs
-          ;; based on the fully general inputs.  We probably don't care about
-          ;; the vast majority of these names---usually we only care about a
-          ;; few outputs at certain stages!  So now we pull out only the
-          ;; signals we actually care about.  This seems like a good place to
-          ;; stop distinguishing between internal and output signals, so that
-          ;; the user just sees uniform output simulation variables.
-          (time$ (let* ((acc nil)
-                        (acc (stv-extract-relevant-signals cstv.out-extract-alists
-                                                           out-alists-general
-                                                           acc))
-                        (acc
-                         (if need-internals
-                             (stv-extract-relevant-signals cstv.int-extract-alists
-                                                           int-alists-general
-                                                           acc)
-                           acc)))
-                   acc)
-                 :msg "; stv-process extraction: ~st sec, ~sa bytes.~%"
-                 :mintime 1/2))
-
-         (relevant-signals-specialized
-          ;; The general alists are still in terms of the fully general input
-          ;; variables.  So, we now rewrite them using the restrict-alist,
-          ;; which will basically (1) "assume" the concrete STV bindings, and
-          ;; (2) replaces certain general input variables with the names of the
-          ;; bits of the input simulation variables.
-          (time$ (4v-sexpr-restrict-with-rw-alist relevant-signals-general
-                                                  cstv.restrict-alist)
-                 :msg "; stv-process specialization: ~st sec, ~sa bytes.~%"
+  (b* (((compiled-stv cstv) cstv)
+
+       (need-internals
+        ;; We can avoid computing the internal signals if we didn't ask for
+        ;; any.  This is kind of silly, but it can save a lot of time if you
+        ;; don't care about the internals at all.
+        (not (subsetp cstv.int-extract-alists '(nil))))
+
+       ((mv ?init-st-general
+            ?in-alists-general
+            nst-alists-general
+            out-alists-general
+            int-alists-general)
+        ;; Do the fully general simulation for however many steps are needed.
+        (if need-internals
+            (time$ (stv-fully-general-simulation-debug cstv.nphases mod cstv.override-bits)
+                   :msg "; stv-process debug simulation: ~st sec, ~sa bytes.~%"
+                   :mintime 1/2)
+          (time$ (stv-fully-general-simulation-run cstv.nphases mod cstv.override-bits)
+                 :msg "; stv-process simulation: ~st sec, ~sa bytes.~%"
                  :mintime 1/2)))
 
-      (make-processed-stv :mod              mod
-                          :user-stv         stv
-                          :compiled-stv     cstv
-                          :relevant-signals relevant-signals-specialized)))
-
-  (local (in-theory (enable stv-process)))
-
-  (defthm processed-stv-p-of-stv-process
-    (implies (force (compiled-stv-p cstv))
-             (equal (processed-stv-p (stv-process stv cstv mod))
-                    (if (stv-process stv cstv mod)
-                        t
-                      nil)))))
+       (relevant-signals-general
+        ;; The out-alists-general and int-alists-general bind names to sexprs
+        ;; based on the fully general inputs.  We probably don't care about
+        ;; the vast majority of these names---usually we only care about a
+        ;; few outputs at certain stages!  So now we pull out only the
+        ;; signals we actually care about.  This seems like a good place to
+        ;; stop distinguishing between internal and output signals, so that
+        ;; the user just sees uniform output simulation variables.
+        (time$ (let* ((acc nil)
+                      (acc (stv-extract-relevant-signals cstv.out-extract-alists
+                                                         out-alists-general
+                                                         acc))
+                      (acc
+                       (if need-internals
+                           (stv-extract-relevant-signals cstv.int-extract-alists
+                                                         int-alists-general
+                                                         acc)
+                         acc))
+                      (acc
+                       (stv-extract-relevant-signals cstv.nst-extract-alists
+                                                     nst-alists-general
+                                                     acc)))
+                 acc)
+               :msg "; stv-process extraction: ~st sec, ~sa bytes.~%"
+               :mintime 1/2))
+
+       (relevant-signals-specialized
+        ;; The general alists are still in terms of the fully general input
+        ;; variables.  So, we now rewrite them using the restrict-alist,
+        ;; which will basically (1) "assume" the concrete STV bindings, and
+        ;; (2) replaces certain general input variables with the names of the
+        ;; bits of the input simulation variables.
+        (time$ (with-fast-alist cstv.restrict-alist
+                 (4v-sexpr-restrict-with-rw-alist relevant-signals-general
+                                                  cstv.restrict-alist))
+               :msg "; stv-process specialization: ~st sec, ~sa bytes.~%"
+               :mintime 1/2)))
+
+    (make-processed-stv :name             name
+                        :user-stv         stv
+                        :compiled-stv     cstv
+                        :relevant-signals relevant-signals-specialized)))
 
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-top.lisp acl2-6.3/books/centaur/esim/stv/stv-top.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-top.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-top.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -36,7 +36,6 @@
 ;;       these can be omitted unless desired.
 ;; (include-book "stv-debug")
 
-
 (defxdoc symbolic-test-vectors
   :parents (esim)
   :short "A concise way to describe, evaluate, and debug symbolic simulations
@@ -78,14 +77,11 @@
   :long "<h3>Example Test Vector</h3>
 
 @({
- ((:initial
-   (\"foo.statemachine.busy\"  0)
-   (\"foo.prevStutter\"        stutter))
-
- ;; phases:                0      1     2     3     4          5        6  ...
+ (
+ ;; phases:                0      1     2     3     4      5        6  ...
  ;; ---------------------------------------------------------------------------
 
-  (:inputs
+  (:inputs ;; for supplying values to input wires
    (\"clock\"               0      ~)
    (\"ibus[13:10]\"     #b101  #b101     _)
    (\"ibus[9:0]\"          op     op     _)
@@ -95,26 +91,30 @@
    (\"reset\"               0)
    (\"fuse[0]\"             X))
 
-  (:outputs
+  (:outputs ;; for extracting values on output wires
    (\"result_bus\"          _      _     _     _     _       res1     res2)
    (\"result_bus[63:32]\"   _      _     _     _     _    res-hi1  res-hi2)
    (\"result_bus[31:0]\"    _      _     _     _     _    res-lo1  res-lo2)
    )
 
-  (:internals
+  (:internals ;; for extracting values on internal wires
    (\"queue0.mgr.fail\"     _      _     qf1   qf2   _))
 
+ ;; advanced features:
+
+  (:overrides ;; for forcibly overriding values on wires
+
+   ;; abstract away product wire, replacing it with variables
+   (\"foo.prod\"           _      _   prod    _     _      _        _ )
+
+   ;; force fast mode to true after phase 1, no matter what its real value is
+   (\"foo.fastmode\"       _      _     1     1     1      1        1 ))
+
   )
- ;; ---------------------------------------------------------------------------
 })
 
 <h3>High-Level Overview</h3>
 
-<p>The @(':initial') section controls the initial values of state bits.  For
-the above vector, @('foo.statemachine.busy') will be initialized to zero and
-@('foo.prevStutter') will be some particular value, @('stutter'), that can be
-specified at @(see stv-run) time.</p>
-
 <p>The @(':inputs') section controls how the module's inputs will be set over
 the course of the simulation.  For the above vector,</p>
 
@@ -167,6 +167,11 @@
 you to pull out the values of internal signals in the module.</p>
 
 
+<p>The @(':overrides') section is similar to the inputs section, but it allows
+you to forcibly install new values onto wires, regardless of how they are
+actually driven by the circuit.</p>
+
+
 <h3>Input Line Format</h3>
 
 <p>Each line in the @(':inputs') section explains how a certain input should be
@@ -281,33 +286,40 @@
 use explicit lsb-first ordered lists of ESIM paths.</p>
 
 
-<h3>Initial Line Format</h3>
-
-<p>Each line in the @(':initial') section explains how to initialize some state
-bits.  Unlike input lines, each initial line has only a single value, namely
-its value at the start of the simulation.  This is because the value the
-register stores during the subsequent phases of the simulation is determined by
-the circuit.  Each initial line has the following format:</p>
+<h3>Override Line Format</h3>
 
-@({
- (name value)
-})
+<p>Each line in the @(':override') section explains how to override some
+internal wire.</p>
 
-<p>The names in initial lines may be strings that are Verilog-style plain or
+<p>The names in override lines may be strings that are Verilog-style plain or
 hierarchical identifiers using periods as separators, which may optionally
 include a Verilog-style bit- or part-select at the end.  It is also possible to
 use explicit lsb-first ordered lists of ESIM paths.</p>
 
-<p>STVs are slightly clever in how they interpret these names.  In short, you
-don't have to write down the whole path to a Verilog @('reg') or anything like
-that, because the STV compiler will automatically walk backwards from whatever
-paths you give it.  As long as this walk takes it to a flop or latch, it will
-know which state bit to initialize.  In practice, you can give paths that are
-separated from their Verilog @('reg')s through any number of assignments,
-inverters, and buffers.</p>
+<p>The @('value')s here are similar to those of input lines, except that:</p>
 
-<p>The @('value')s here are like those of input lines, except that you can't
-use @('~') since there isn't any previous value to invert.</p>")
+<ul>
+
+<li>@('~') is not allowed, because it would be somewhat confusing.</li>
+
+<li>@('_') means \"don't override the wire during this phase\".</li>
+
+</ul>
+
+<p>Every variable used in an override line becomes both an input and an output
+variable of the STV.  For instance, in the example above, we had the following
+override line:</p>
+
+@({
+   (\"foo.prod\"           _      _   prod    _     _      _        _ )
+})
+
+<p>Here, as an input to the STV, @('prod') allows us to forcibly set the value
+of the wire @('foo.prod').  As an output, @('prod') gives us the <b>original,
+un-overridden</b> expression for @('prod').  (Well, that's probably mostly
+true.  If @('prod') depends on other overridden values, or is involved in some
+combinational loop so that it affects itself, then this may not be quite
+right.)</p>")
 
 
 
@@ -388,7 +400,7 @@
 <p>Once the STV has been processed, we can run it with concrete values for the
 input simulation variables; see @(see stv-run).  To do this, we basically need
 to (1) translate the input numbers into bit-level bindings, (2) use @(see
-sexpr-eval) to reduce the sexprs that are found in the Processed STV with the
+4v-sexpr-eval) to reduce the sexprs that are found in the Processed STV with the
 bindings for their inputs, and (3) translate back from the resulting output-bit
 bindings into numbers (or Xes) for the output alist.  This is about as cheap as
 we know how to make it.</p>
@@ -401,62 +413,252 @@
 
 <p>Well, basically we just do a new @(see esim) simulation that does include
 the internal variables, and then run through the rest of the process again.  We
-memoize things so that even though your first call of @(see stv-debug) is
-expensive, subsequent calls will not need to redo the simulation or
+@(see memoize) things so that even though your first call of @(see stv-debug)
+is expensive, subsequent calls will not need to redo the simulation or
 specialization steps.</p>")
 
-(defsection stv-autohyps
+(define stv-autohyps-aux ((ins symbol-listp)
+                          (stv processed-stv-p))
+  :parents (stv-autohyps)
+  :long "<p>We could have used @(see unsigned-byte-p) instead, but that gets us
+into trouble with :expand hints when recursive definitions of unsigned-byte-p
+are installed, so just use explicit bounds instead.</p>"
+  (if (atom ins)
+      nil
+    (list* `(natp ,(car ins))
+           `(< ,(car ins) (expt 2 ,(stv-in->width (car ins) stv)))
+           (stv-autohyps-aux (cdr ins) stv))))
+
+(define stv-autohyps ((stv processed-stv-p))
+  :parents (defstv)
+  :short "Generate the body for an STV's autohyps macro."
+  (b* ((ins (stv->ins stv))
+       ((unless (symbol-listp ins))
+        (raise "Non-symbol inputs?")))
+    `(and . ,(stv-autohyps-aux ins stv))))
+
+(define stv-autobinds-aux ((ins symbol-listp)
+                           (stv processed-stv-p))
+  :parents (stv-autobinds)
+  (if (atom ins)
+      nil
+    (cons `(:nat ,(car ins) ,(stv-in->width (car ins) stv))
+          (stv-autobinds-aux (cdr ins) stv))))
+
+(define stv-autobinds ((stv processed-stv-p))
+  :parents (defstv)
+  :short "Generate the body for an STV's autobinds macro."
+  (b* ((ins (stv->ins stv))
+       ((unless (symbol-listp ins))
+        (raise "Non-symbol inputs?")))
+    `(gl::auto-bindings . ,(stv-autobinds-aux ins stv))))
+
+(define stv-autoins-aux (ins)
+  :parents (stv-autoins)
+  (if (atom ins)
+      nil
+    (cons `(cons ',(car ins) ,(car ins))
+          (stv-autoins-aux (cdr ins)))))
+
+(define stv-autoins ((stv processed-stv-p))
+  :parents (defstv)
+  :short "Generate the body for an STV's autoins macro."
+  `(list . ,(stv-autoins-aux (stv->ins stv))))
+
+
+
+(local (in-theory (disable good-esim-modulep)))
+
+(define defstv-main
+  :parents (defstv)
+  :short "Main error checking and processing of an STV."
+
+  (&key (mod good-esim-modulep)
+        (name symbolp)
+        inputs outputs internals overrides)
+
+  :returns (pstv (equal (processed-stv-p pstv)
+                        (if pstv t nil))
+                 :hyp (force (symbolp name)))
+
+  :long "<p>This is the main part of @(see defstv).</p>
+
+<p>We split this out into its own function for advanced users who need a
+non-event based way to introduce symbolic test vectors.</p>
+
+<p>This does only the STV processing.  We don't deal here with generating
+documentation, creating autohyps macros, etc.</p>"
+
+  (b* ((mod         (or mod
+                        ;; Blah, silly, (good-esim-modulep nil) is true, so
+                        ;; explicitly check for this.
+                        (raise "No :mod was specified.")))
+       (inputs      (if (true-list-listp inputs)
+                        inputs
+                      (raise ":inputs are not even a true-list-listp")))
+       (outputs     (if (true-list-listp outputs)
+                        outputs
+                      (raise ":outputs are not even a true-list-listp")))
+       (internals   (if (true-list-listp internals)
+                        internals
+                      (raise ":internals are not even a true-list-listp")))
+       (overrides   (if (true-list-listp overrides)
+                        overrides
+                      (raise ":overrides are not even a true-list-listp")))
+
+       (stv         (make-stvdata :overrides overrides
+                                  :inputs    inputs
+                                  :outputs   outputs
+                                  :internals internals))
+
+       (preprocessed-stv
+        (time$ (let* ((stv (stv-widen stv))
+                      (stv (stv-expand stv mod)))
+                 stv)
+               :msg "; stv preprocessing: ~st sec, ~sa bytes~%"
+               :mintime 1/2))
+
+       (compiled-stv
+        (time$ (stv-compile preprocessed-stv mod)
+               :msg "; stv compilation: ~st sec, ~sa bytes~%"
+               :mintime 1/2))
+
+       ((unless compiled-stv)
+        ;; this shouldn't happen... it should throw an error instead
+        (raise "stv-compile failed?"))
+
+       (mod (stv-cut-module
+             (compiled-stv->override-paths compiled-stv) mod))
+
+       (processed-stv
+        (time$ (stv-process name stv compiled-stv mod)
+               :msg "; stv processing: ~st sec, ~sa bytes~%"
+               :mintime 1/2))
+
+       ((unless processed-stv)
+        ;; this shouldn't happen... it should throw an error instead
+        (raise "stv-process failed?")))
+
+    processed-stv))
+
+
+(define defstv-fn
+  :parents (defstv)
+  :short "Implementation of @(see defstv)."
+
+  ((name            symbolp "E.g., mmx-run")
+   (mod-const-name  symbolp "E.g., the symbol *mmx*")
+   (mod             good-esim-modulep "E.g., the actual E module for *mmx*")
+   ;; Arguments from the user...
+   inputs outputs internals overrides
+   labels parents short long)
+
+  (b* ((labels      (if (symbol-listp labels)
+                        labels
+                      (raise ":labels need to be a symbol-listp.")))
+
+       (want-xdoc-p (or parents short long))
+       (short       (cond ((stringp short) short)
+                          ((not short)     "")
+                          (t               (progn$ (raise ":short must be a string.")
+                                                   ""))))
+       (long        (cond ((stringp long) long)
+                          ((not long)     "")
+                          (t              (progn$ (raise ":long must be a string.")
+                                                  ""))))
+
+       (processed-stv (defstv-main :mod       mod
+                                   :name      name
+                                   :overrides overrides
+                                   :inputs    inputs
+                                   :outputs   outputs
+                                   :internals internals))
+       ((unless processed-stv)
+        ;; In practice we should have already thrown an error, so we should
+        ;; never hit this.
+        (raise "Failed to process STV."))
+
+       (compiled-stv (processed-stv->compiled-stv processed-stv))
+       (stv          (processed-stv->user-stv processed-stv))
+
+       ((unless (stvdata-p stv))
+        ;; Stupidity to satisfy guards of stv-to-xml call, below; this should
+        ;; be impossible to hit, I just don't want to prove it.
+        (raise "stv processing didn't produce good stvdata?"))
+
+       ;; Only now, after we've already compiled and processed the STV, do we
+       ;; bother to generate the documentation.  We want to make sure it stays
+       ;; in this order, because stv-to-xml doesn't have good error reporting.
+       (long (if (not want-xdoc-p)
+                 long
+               (str::cat "<h3>Simulation Diagram</h3>
 
-  (defund stv-autohyps-aux (ins stv)
-    (declare (xargs :guard (and (symbol-listp ins)
-                                (processed-stv-p stv))))
-    (if (atom ins)
-        nil
-      ;; Could have used unsigned-byte-p instead, but that gets us into trouble
-      ;; with :expand hints when recursive definitions of unsigned-byte-p are
-      ;; installed, so just use explicit bounds instead.
-      (list* `(natp ,(car ins))
-             `(< ,(car ins) (expt 2 ,(stv-in->width (car ins) stv)))
-            (stv-autohyps-aux (cdr ins) stv))))
-
-  (defund stv-autohyps (stv)
-    (declare (xargs :guard (processed-stv-p stv)))
-    (b* ((ins (stv->ins stv))
-         ((unless (symbol-listp ins))
-          (er hard? 'stv-autohyps "Non-symbol inputs?")))
-      `(and . ,(stv-autohyps-aux ins stv)))))
-
-
-(defsection stv-autobinds
-
-  (defund stv-autobinds-aux (ins stv)
-    (declare (xargs :guard (and (symbol-listp ins)
-                                (processed-stv-p stv))))
-    (if (atom ins)
-        nil
-      (cons `(:nat ,(car ins) ,(stv-in->width (car ins) stv))
-            (stv-autobinds-aux (cdr ins) stv))))
-
-  (defund stv-autobinds (stv)
-    (declare (xargs :guard (processed-stv-p stv)))
-    (b* ((ins (stv->ins stv))
-         ((unless (symbol-listp ins))
-          (er hard? 'stv-autobinds "Non-symbol inputs?")))
-      `(gl::auto-bindings . ,(stv-autobinds-aux ins stv)))))
-
-
-(defsection stv-autoins
-
-  (defund stv-autoins-aux (ins)
-    (declare (xargs :guard t))
-    (if (atom ins)
-        nil
-      (cons `(cons ',(car ins) ,(car ins))
-            (stv-autoins-aux (cdr ins)))))
-
-  (defund stv-autoins (stv)
-    (declare (xargs :guard (processed-stv-p stv)))
-    `(list . ,(stv-autoins-aux (stv->ins stv)))))
+<p>This is a <see topic='@(url
+acl2::symbolic-test-vectors)'>symbolic test vector</see> defined with @(see
+acl2::defstv).</p>"
+                         (or (stv-to-xml stv compiled-stv labels)
+                             "Error generating diagram")
+                         long)))
+
+
+         ;; Stupid trick to avoid saving the module in the .cert file
+         (stvconst             (intern-in-package-of-symbol
+                                (str::cat "*" (symbol-name name) "*")
+                                name))
+         (modconst             (intern-in-package-of-symbol
+                                (str::cat "*" (symbol-name name) "-MOD*")
+                                name))
+         (name-mod             (intern-in-package-of-symbol
+                                (str::cat (symbol-name name) "-MOD")
+                                name))
+         (name-autohyps        (intern-in-package-of-symbol
+                                (str::cat (symbol-name name) "-AUTOHYPS")
+                                name))
+         (name-autoins         (intern-in-package-of-symbol
+                                (str::cat (symbol-name name) "-AUTOINS")
+                                name))
+         (name-autobinds       (intern-in-package-of-symbol
+                                (str::cat (symbol-name name) "-AUTOBINDS")
+                                name))
+
+         (cmds `((defconst ,stvconst ',processed-stv)
+
+                 (defconst ,modconst
+                   (stv-cut-module (compiled-stv->override-paths
+                                    (processed-stv->compiled-stv ,stvconst))
+                                   ,mod-const-name))
+
+                 (defund ,name ()
+                   ;; Using a 0-ary function instead of a constant is nice when
+                   ;; we want to look at DEF-GL-THMs with :PR, etc.
+                   (declare (xargs :guard t))
+                   ,stvconst)
+
+                 (defund ,name-mod ()
+                   (declare (xargs :guard t))
+                   ,modconst)
+
+                 (defmacro ,name-autohyps ()
+                   ',(stv-autohyps processed-stv))
+
+                 (defmacro ,name-autoins ()
+                   ',(stv-autoins processed-stv))
+
+                 (defmacro ,name-autobinds ()
+                    ',(stv-autobinds processed-stv))
+
+                 ))
+
+         (cmds (if (not want-xdoc-p)
+                   cmds
+                 (cons `(defxdoc ,name
+                          :parents ,parents
+                          :short ,short
+                          :long ,long)
+                       cmds))))
+
+      `(with-output :off (event)
+         (progn . ,cmds))))
 
 
 (defsection defstv
@@ -466,15 +668,15 @@
 
 @({
  (defstv my-run
-   :mod *my-mod*
-   :initial   '((\"foo.bar.myreg\" mr)       ...)
+   :mod       *my-mod*
    :inputs    '((\"opcode\" _ _ op _)        ...)
    :outputs   '((\"result\" _ _ _ _ res _)   ...)
    :internals '((\"foo.bar.mybus\" _ _ mb _) ...)
-   :labels '(A nil B nil C nil)]
-   :parents ...
-   :short ...
-   :long ...)
+   :overrides '((\"foo.bar.mywire\" _ mw _ _) ...)
+   :labels    '(A nil B nil C nil)]
+   :parents   ...
+   :short     ...
+   :long      ...)
 })
 
 <p>The @('defstv') command is the main interface for defining symbolic test
@@ -492,9 +694,9 @@
 requirement lets us avoid writing the module into the certificate, which can
 significantly improve performance when including books with STVs.</li>
 
-<li>The @(':initial'), @(':inputs'), @(':outputs'), and @(':internals') control
-how to simulate the module.  For the syntax and meaning of these lines, see
-@(see symbolic-test-vector-format).</li>
+<li>The @(':inputs'), @(':outputs'), @(':internals'), and @(':overrides')
+control how to simulate the module.  For the syntax and meaning of these lines,
+see @(see symbolic-test-vector-format).</li>
 
 </ul>
 
@@ -525,7 +727,6 @@
 not directly use the @('processed-stv-p') accessors (in case we change the
 format).</dd>
 
-
 <dt>@('(my-run-autohyps)')</dt>
 
 <dd>This is a macro that expands to something like:
@@ -590,164 +791,76 @@
 write your own binding macros.  See @(see stv-easy-bindings) for a high-level
 way to describe most kind of bindings.</dd>
 
-</dl>"
-
-  (local (in-theory (disable good-esim-modulep)))
-
-  (defund defstv-fn (name mod-const-name ;; e.g., *mmx*
-                          mod            ;; e.g., the value of *mmx*
-                          initial inputs outputs internals
-                          labels parents short long)
-    (declare (xargs :guard (and (symbolp name)
-                                (symbolp mod-const-name)
-                                (good-esim-modulep mod))))
-    (b* ((mod         (or mod (er hard? 'defstv "No :mod was specified.")))
-
-         (initial     (if (true-list-listp initial)
-                          initial
-                        (er hard? 'defstv ":initial is not even a true-list-listp?")))
-         (inputs      (if (true-list-listp inputs)
-                          inputs
-                        (er hard? 'defstv ":inputs are not even a true-list-listp?")))
-         (outputs     (if (true-list-listp outputs)
-                          outputs
-                        (er hard? 'defstv ":outputs are not even a true-list-listp?")))
-         (internals   (if (true-list-listp internals)
-                          internals
-                        (er hard? 'defstv ":internals are not even a true-list-listp?")))
-         (labels      (if (symbol-listp labels)
-                          labels
-                        (er hard? 'defstv ":labels need to be a symbol-listp.")))
-
-         (stv         (make-stvdata :initial initial
-                                    :inputs inputs
-                                    :outputs outputs
-                                    :internals internals))
-
-         (want-xdoc-p (or parents short long))
-         (short       (cond ((stringp short) short)
-                            ((not short)     "")
-                            (t               (progn$ (er hard? 'defstv ":short must be a string.")
-                                                     ""))))
-         (long        (cond ((stringp long) long)
-                            ((not long)     "")
-                            (t              (progn$ (er hard? 'defstv ":long must be a string.")
-                                                    ""))))
-
-         (preprocessed-stv
-          (time$ (let* ((stv (stv-widen stv))
-                        (stv (stv-expand stv mod)))
-                   stv)
-                 :msg "; stv preprocessing: ~st sec, ~sa bytes~%"
-                 :mintime 1/2))
-
-         (compiled-stv
-          (time$ (stv-compile preprocessed-stv mod)
-                 :msg "; stv compilation: ~st sec, ~sa bytes~%"
-                 :mintime 1/2))
-
-         ((unless compiled-stv)
-          ;; this shouldn't happen... it should throw an error instead
-          (er hard? 'defstv-fn "stv-compile failed?"))
-
-
-         (processed-stv
-          (time$ (stv-process stv compiled-stv mod)
-                 :msg "; stv processing: ~st sec, ~sa bytes~%"
-                 :mintime 1/2))
-
-         ((unless processed-stv)
-          ;; this shouldn't happen... it should throw an error instead
-          (er hard? 'defstv-fn "stv-process failed?"))
-
-
-         ;; Only now, after we've already compiled and processed the STV, do we
-         ;; bother to generate the documentation.  We want to make sure it
-         ;; stays in this order, because stv-to-xml doesn't have good error
-         ;; reporting.
-         (long (if (not want-xdoc-p)
-                   long
-                 (str::cat "<h3>Simulation Diagram</h3>
-
-<p>This is a <see topic='@(url
-acl2::symbolic-test-vectors)'>symbolic test vector</see> defined with @(see
-acl2::defstv).</p>"
-                           (or (stv-to-xml stv compiled-stv labels)
-                               "Error generating diagram"))))
-
-
-         ;; Stupid trick to avoid saving the module in the .cert file
-         (stvconst-without-mod (intern-in-package-of-symbol
-                                (str::cat "*" (symbol-name name) "-WITHOUT-MOD*")
-                                name))
-         (stvconst-with-mod    (intern-in-package-of-symbol
-                                (str::cat "*" (symbol-name name) "*")
-                                name))
-         (name-autohyps        (intern-in-package-of-symbol
-                                (str::cat (symbol-name name) "-AUTOHYPS")
-                                name))
-         (name-autoins         (intern-in-package-of-symbol
-                                (str::cat (symbol-name name) "-AUTOINS")
-                                name))
-         (name-autobinds       (intern-in-package-of-symbol
-                                (str::cat (symbol-name name) "-AUTOBINDS")
-                                name))
-
-         (cmds `((defconst ,stvconst-without-mod
-                   ;; Remove :mod from the quoted constant we save
-                   ',(change-processed-stv processed-stv :mod nil))
-
-                 (defconst ,stvconst-with-mod
-                   ;; Now restore it with a separate defconst, which gets evaluated
-                   ;; at include-book time
-                   (change-processed-stv ,stvconst-without-mod
-                                         :mod ,mod-const-name))
-
-                 (defund ,name ()
-                   ;; Using a 0-ary function instead of a constant is nice when
-                   ;; we want to look at DEF-GL-THMs with :PR, etc.
-                   (declare (xargs :guard t))
-                   ,stvconst-with-mod)
-
-                 (defmacro ,name-autohyps ()
-                   ',(stv-autohyps processed-stv))
-
-                 (defmacro ,name-autoins ()
-                   ',(stv-autoins processed-stv))
-
-                 (defmacro ,name-autobinds ()
-                    ',(stv-autobinds processed-stv))
-
-                 ))
+<dt>@('(my-run-mod)')</dt>
 
-         (cmds (if (not want-xdoc-p)
-                   cmds
-                 (cons `(defxdoc ,name
-                          :parents ,parents
-                          :short ,short
-                          :long ,long)
-                       cmds))))
+<dd>This is a disabled 0-ary function (i.e., a constant) that either returns
+@('*mod*') or, when @(':overrides') are used, some modified version of
+@('*mod*') where the overridden wires have been cut.  There is ordinarily no
+reason to need this, but certain functions like @('stv-debug') make use of
+it.</dd>
 
-      `(progn . ,cmds)))
+</dl>"
 
   (defmacro defstv (name &key
                          mod
-                         initial inputs outputs internals
+                         inputs outputs internals overrides
                          labels parents short long)
     `(make-event
       (let ((event (defstv-fn ',name
                      ',mod ,mod
-                     ,initial ,inputs ,outputs ,internals
+                     ,inputs ,outputs ,internals ,overrides
                      ,labels ',parents ,short ,long)))
         event))))
 
 
-(defsection stv-easy-bindings
+
+
+(define stv-easy-bindings-inside-mix ((x "Some arguments inside of a :mix")
+                                      (stv processed-stv-p))
+  :parents (stv-easy-bindings)
+  (cond ((atom x)
+         nil)
+        ((symbolp (car x))
+         ;; Should be an STV input.
+         (cons `(:nat ,(car x) ,(stv-in->width (car x) stv))
+               (stv-easy-bindings-inside-mix (cdr x) stv)))
+        (t
+         ;; Anything else is illegal inside mix.
+         (raise "Inside a :mix you can only have symbols (the names of stv ~
+                 inputs), so ~x0 is illegal." (car x)))))
+
+(define stv-easy-bindings-main ((x   "Some arguments to easy-bindings")
+                                (stv processed-stv-p))
+  (cond ((atom x)
+         nil)
+        ((symbolp (car x))
+         ;; Should be an STV input.
+         (cons `(:nat ,(car x) ,(stv-in->width (car x) stv))
+               (stv-easy-bindings-main (cdr x) stv)))
+        ((and (consp (car x))
+              (equal (caar x) :mix))
+         (let ((things-to-mix (cdar x)))
+           (if (consp things-to-mix)
+               (cons `(:mix . ,(stv-easy-bindings-inside-mix things-to-mix stv))
+                     (stv-easy-bindings-main (cdr x) stv))
+             (raise ":MIX with no arguments? ~x0" (car x)))))
+        (t
+         (raise "Arguments to stv-easy-bindings should be input names or ~
+                 (:mix input-name-list), so ~x0 is illegal." (car x)))))
+
+(program)
+
+(define stv-easy-bindings
   :parents (symbolic-test-vectors)
   :short "Generating G-bindings from an STV in a particular way."
 
-  :long "<p>@(call stv-easy-bindings) returns a list of G-bindings.  That is,
-you can write something like:</p>
+  ((stv   "The STV you are dealing with."
+          processed-stv-p)
+   (order "The variable order you want to use."))
+
+  :long "<p>@(call stv-easy-bindings) is a macro for proving theorems about
+@(see symbolic-test-vectors) using @(see gl).  It returns a list of G-bindings
+for use with @(see def-gl-thm).  That is, you can write something like:</p>
 
 @({
  (def-gl-thm foo
@@ -756,63 +869,39 @@
     (stv-easy-bindings (my-stv) '(opcode size special (:mix a b) c)))
 })
 
-<p>The format of @('x') is simple: you can list out STV inputs and also use
-@('(:mix a b c ...)') where @('a'), @('b'), @('c'), ... are all STV inputs.</p>
+<p>This is probably only useful when:</p>
+
+<ul>
+
+<li>You are using GL in BDD mode, not some AIG or SAT based mode.</li>
+
+<li>You are running into performance problems when using the default
+@('-autobinds') from the @(see defstv).</li>
 
-<p>Bindings will be generated in the order specified, e.g., in the above
-example the @('opcode') will have the smallest indices, then @('size') next,
-etc.</p>
+<li>You want to see if a different variable order performs better.</li>
+
+</ul>
 
-<p>You do <b>not</b> have to mention all of the STV variables.  All unmentioned
-variables will be assigned indices after mentioned variables.</p>
+<p>To use @('stv-easy-bindings'), you just list (a subset of) the STV inputs in
+priority order.  For instance, in the above example, the @('opcode') will get
+the smallest indices, then @('size') next, etc.  You do <b>not</b> have to list
+all of the STV variables.  Any unmentioned variables will be assigned indices
+after mentioned variables.</p>
+
+<p>As in @(see gl::auto-bindings), you can also use @('(:mix a b c ...)') to
+interleave the bits of @('a'), @('b'), @('c'), ...; note that for this to work
+these variables must all share the same width.  This is generally useful for
+data buses that are going to be combined together.</p>
 
 <p>An especially nice feature of easy-bindings is that they automatically
 adjust when inputs to the STV are resized, when new inputs are added, and when
 irrelevant inputs are removed.</p>"
 
-  (defund stv-easy-bindings-inside-mix (x stv)
-    (declare (xargs :guard (processed-stv-p stv)))
-    (cond ((atom x)
-           nil)
-          ((symbolp (car x))
-           ;; Should be an STV input.
-           (cons `(:nat ,(car x) ,(stv-in->width (car x) stv))
-                 (stv-easy-bindings-inside-mix (cdr x) stv)))
-          (t
-           ;; Anything else is illegal inside mix.
-           (er hard? 'stv-easy-bindings-inside-mix
-               "Inside a :mix you can only have symbols (the names of stv
-              inputs), ~ so ~x0 is illegal." (car x)))))
-
-  (defund stv-easy-bindings-main (x stv)
-    (declare (xargs :guard (processed-stv-p stv)))
-    (cond ((atom x)
-           nil)
-          ((symbolp (car x))
-           ;; Should be an STV input.
-           (cons `(:nat ,(car x) ,(stv-in->width (car x) stv))
-                 (stv-easy-bindings-main (cdr x) stv)))
-          ((and (consp (car x))
-                (equal (caar x) :mix))
-           (let ((things-to-mix (cdar x)))
-             (if (consp things-to-mix)
-                 (cons `(:mix . ,(stv-easy-bindings-inside-mix things-to-mix stv))
-                       (stv-easy-bindings-main (cdr x) stv))
-               (er hard? 'stv-easy-bindings-main
-                   ":MIX with no arguments? ~x0" (car x)))))
-          (t
-           (er hard? 'stv-easy-bindings-main
-               "Arguments to stv-easy-bindings should be input names or ~
-              (:mix input-name-list), so ~x0 is illegal." (car x)))))
-
-  (defun stv-easy-bindings (stv x)
-    (declare (xargs :guard (processed-stv-p stv)
-                    :mode :program))
-    (b* ((binds   (stv-easy-bindings-main x stv))
-         (unbound (set-difference-equal (stv->ins stv)
-                                        (pat-flatten1 binds))))
-      (gl::auto-bindings-fn
-       (append binds
-               ;; bozo ugly, but workable enough...
-               (stv-easy-bindings-inside-mix unbound stv))))))
+  (b* ((binds   (stv-easy-bindings-main order stv))
+       (unbound (set-difference-equal (stv->ins stv)
+                                      (pat-flatten1 binds))))
+    (gl::auto-bindings-fn
+     (append binds
+             ;; bozo ugly, but workable enough...
+             (stv-easy-bindings-inside-mix unbound stv)))))
 
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-util.lisp acl2-6.3/books/centaur/esim/stv/stv-util.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-util.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-util.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -24,75 +24,82 @@
 (in-package "ACL2")
 (include-book "../esim-sexpr-support")
 (include-book "cutil/defaggregate" :dir :system)
+(include-book "cutil/define" :dir :system)
 
 (cutil::defaggregate stvdata
-  (initial inputs outputs internals)
-  :tag :stvdata
-  :require ((true-list-listp-of-stvdata->initial   (true-list-listp initial))
-            (true-list-listp-of-stvdata->inputs    (true-list-listp inputs))
-            (true-list-listp-of-stvdata->outputs   (true-list-listp outputs))
-            (true-list-listp-of-stvdata->internals (true-list-listp internals)))
   :parents (symbolic-test-vectors)
-  :short "Temporary internal representation of STV lines during compilation.")
+  :short "Temporary internal representation of STV lines during compilation."
+  :tag :stvdata
+  ((inputs    true-list-listp)
+   (outputs   true-list-listp)
+   (internals true-list-listp)
+   (overrides true-list-listp)))
 
 (cutil::defaggregate compiled-stv
-  (nphases            ;; number of phases for this simulation
-   out-extract-alists ;; what to extract at times 0...{N-1} from outputs
-   int-extract-alists ;; what to extract at times 0...{N-1} from internals
-   restrict-alist     ;; (init-state -> sexpr) + (input-bit@phase -> sexpr) alist
-   in-usersyms        ;; (simulation var -> bit list) alist for INITIAL+INS
-   out-usersyms       ;; (simulation var -> bit list) alist for OUTS+INTS
-   expanded-ins       ;; not useful for much
-   expanded-outs      ;; not useful for much
-   expanded-ints      ;; not useful for much
-   )
-  :tag :compiled-stv
-  :require ((posp-of-compiled-stv->nphases
-             (posp nphases)
-             :rule-classes :type-prescription))
   :parents (symbolic-test-vectors)
-  :short "Compiled form of @(see symbolic-test-vectors).")
+  :short "Compiled form of @(see symbolic-test-vectors)."
+  :tag :compiled-stv
+  ((nphases posp
+            "number of phases for this simulation"
+            :rule-classes :type-prescription)
+
+   (nst-extract-alists "what to extract at times 0...{N-1} from next-states"
+                       true-listp :rule-classes :type-prescription)
+
+   (out-extract-alists "what to extract at times 0...{N-1} from outputs"
+                       true-listp :rule-classes :type-prescription)
+
+   (int-extract-alists "what to extract at times 0...{N-1} from internals"
+                       true-listp :rule-classes :type-prescription)
+
+   (override-bits      "flat list of state bits involved in overrides, i.e.,
+                        just the override_value and override_decision vars"
+                       symbol-listp)
+
+   (restrict-alist     "combined alist binding
+                          (input-bit@phase &rarr; sexpr) and
+                          (override-bit@phase &rarr; sexpr)")
+
+   (in-usersyms        "(simulation var &rarr; bit list) alist for Inputs +
+                        Overrides (replacement value insertion)")
+   (out-usersyms       "(simulation var &rarr; bit list) alist for Outputs +
+                        Internals + Overrides (original value extraction)")
+
+   (expanded-ins       "Input lines with s-expression values, used only so
+                        that we can resolve ~s in stv-doc.")
+
+   (override-paths     "Paths being overridden, so we can recreate the cut
+                        module as needed."
+                       true-listp)
+
+   ))
 
 (cutil::defaggregate processed-stv
-  (mod                ;; module
-   user-stv           ;; pre-compilation stv
-   compiled-stv       ;; post-compilation stv
-   relevant-signals   ;; (out/int sim var bit -> sexpr) alist
-   )
-  :tag :processed-stv
   :parents (stv-process)
   :short "Representation of a processed STV."
+  :tag :processed-stv
+  ((name               "A name for this STV."
+                       symbolp)
+   (user-stv           "The user-level, pre-compiled STV.  This may be useful when
+                        generating documentation for STVs.")
+   (compiled-stv       compiled-stv-p
+                       "A @(see compiled-stv-p), should be the compiled version
+                        of the user's STV; see @(see stv-compile).")
+   (relevant-signals   "(out/int sim var bit &rarr; sexpr) alist"))
 
   :long "<p>You should probably read @(see stv-implementation-details) to
 understand these fields.</p>
 
-<ul>
-
-<li>The @('mod') is the @(see esim) module for this STV.  We save this in the
-processed STV so that we re-simulate it later, if necessary, for @(see
-stv-debug).</li>
-
-<li>The @('user-stv') is the user-level, pre-compiled STV.  This may be useful
-when generating documentation for STVs.</li>
-
-<li>The @('compiled-stv') is a @(see compiled-stv-p) and should be the compiled
-version of the user's STV; see @(see stv-compile).</li>
-
-<li>The @('relevant-signals') is an alist computed by @(see stv-process) that
+<p>The @('relevant-signals') is an alist computed by @(see stv-process) that
 maps each the bits for each internal/output simulation variable to
 already-restricted @(see 4v-sexprs).  That is, these s-expressions are
 generally in terms of the input simulation variable bits, and ready to be
-evaluated by @(see stv-run).</li>
-
-</ul>
+evaluated by @(see stv-run).</p>
 
 <p>Historically we had another field that could also optionally store
 pre-computed snapshots for debugging.  We took this out because it could make
 @(see stv-run) a lot slower during GL proofs.  The snapshots were huge, and
-this really slowed down GL's gl-concrete-lite check.</p>"
-
-  :require ((compiled-stv-p-of-processed-stv->compiled-stv
-             (compiled-stv-p compiled-stv))))
+this really slowed down GL's gl-concrete-lite check.</p>")
 
 
 (defund ordered-subsetp (x y)
@@ -105,90 +112,69 @@
              (ordered-subsetp x (cdr y))))
     t))
 
-(defund intern-list-in-package-of-symbol (x y)
-  ;; BOZO find me a home
-  (declare (xargs :guard (and (string-listp x)
-                              (symbolp y))))
-  (if (atom x)
-      nil
-    (cons (intern-in-package-of-symbol (car x) y)
-          (intern-list-in-package-of-symbol (cdr x) y))))
-
-
-
-(defsection stv-number-of-phases
-  :parents (symbolic-test-vectors)
-  :short "@(call stv-number-of-phases) determines the maximum number of phases
-that are used in any line of a symbolic test vector."
-
-  (defund stv-max-phases-in-lines (lines)
-    (declare (xargs :guard (true-list-listp lines)))
-    (if (atom lines)
-        0
-      (max (length (cdr (car lines)))
-           (stv-max-phases-in-lines (cdr lines)))))
-
-  (defund stv-number-of-phases (stv)
-    (declare (xargs :guard (stvdata-p stv)))
-    (b* (((stvdata stv) stv))
-      (max (stv-max-phases-in-lines stv.inputs)
-           (max (stv-max-phases-in-lines stv.outputs)
-                (stv-max-phases-in-lines stv.internals))))))
-
 
-(defsection stv-suffix-signals
+(define stv-max-phases-in-lines ((lines true-list-listp))
+  :returns (max-phases natp :rule-classes :type-prescription)
+  :parents (stv-number-of-phases)
+  (if (atom lines)
+      0
+    (max (length (cdr (car lines)))
+         (stv-max-phases-in-lines (cdr lines)))))
+
+(define stv-number-of-phases ((stv stvdata-p))
+  :returns (num-phases natp :rule-classes :type-prescription)
+  :parents (symbolic-test-vectors)
+  :short "Maximum length of any line of an STV (i.e., how many phases we are
+going to simulate."
+
+  (b* (((stvdata stv) stv))
+    (max (stv-max-phases-in-lines stv.inputs)
+         (max (stv-max-phases-in-lines stv.outputs)
+              (max (stv-max-phases-in-lines stv.internals)
+                   (stv-max-phases-in-lines stv.overrides))))))
+
+
+(define stv-suffix-signals ((x atom-listp)
+                            (suffix stringp))
+  :returns (symbols symbol-listp)
   :parents (symbolic-test-vectors)
-  :short "@(call stv-suffix-signals) converts @('x'), a list of atoms, into a
-list of symbols with the given @('suffix')."
-
-  (defund stv-suffix-signals (x suffix)
-    (declare (xargs :guard (and (atom-listp x)
-                                (stringp suffix))))
-    (if (atom x)
-        nil
-      (cons (intern$ (str::cat (stringify (car x)) suffix) "ACL2")
-            (stv-suffix-signals (cdr x) suffix))))
-
-  (local (in-theory (enable stv-suffix-signals)))
-
-  (defthm symbol-listp-of-stv-suffix-signals
-    (symbol-listp (stv-suffix-signals x suffix))))
-
+  :short "Convert a list of atoms into a list of symbols with some suffix."
+  ;; BOZO do we really need to support atom-listps?
+  (if (atom x)
+      nil
+    (cons (intern$ (str::cat (stringify (car x)) suffix) "ACL2")
+          (stv-suffix-signals (cdr x) suffix))))
 
 
-(defsection safe-pairlis-onto-acc
+(define safe-pairlis-onto-acc (x y acc)
   :parents (stv-compile)
-  :short "@(call safe-pairlis-onto-acc) pairs up @('x') and @('y'), and
-accumulates them onto @('acc').  It is \"safe\" in that it causes an error if
-@('x') and @('y') aren't the same length."
-
-  (defun safe-pairlis-onto-acc (x y acc)
-    (declare (xargs :guard t))
-    (mbe :logic
-         (revappend (pairlis$ x y) acc)
-         :exec
-         (b* (((when (and (atom x)
-                          (atom y)))
-               acc)
-              ((when (atom x))
-               (er hard? 'safe-pairlis-onto-acc "Too many values!")
-               acc)
-              ((when (atom y))
-               (er hard? 'safe-pairlis-onto-acc "Not enough values!")
-               (safe-pairlis-onto-acc (cdr x) nil
-                                      (cons (cons (car x) nil) acc))))
-           (safe-pairlis-onto-acc (cdr x) (cdr y)
-                                  (cons (cons (car x) (car y)) acc))))))
-
+  :short "Just @(see pairlis$) onto an accumulator, but for safety cause an
+error if the lists to pair up aren't the same length."
+  :enabled t
+  (mbe :logic
+       (revappend (pairlis$ x y) acc)
+       :exec
+       (b* (((when (and (atom x)
+                        (atom y)))
+             acc)
+            ((when (atom x))
+             (raise "Too many values!")
+             acc)
+            ((when (atom y))
+             (raise "Not enough values!")
+             (safe-pairlis-onto-acc (cdr x) nil
+                                    (cons (cons (car x) nil) acc))))
+         (safe-pairlis-onto-acc (cdr x) (cdr y)
+                                (cons (cons (car x) (car y)) acc)))))
 
 
-(defsection stv->ins
+(define stv->ins ((x processed-stv-p))
+  :returns (inputs "Should be a symbol-listp in practice.") ;; BOZO strengthen
   :parents (symbolic-test-vectors)
   :short "Get a list of an STV's input simulation variables."
 
-  :long "<p>@(call stv->ins) returns the user-level symbolic variables from the
-input and initial lines of a symbolic test vector.  For instance, if you have
-an input line like:</p>
+  :long "<p>We collect simulation variables from all input and initial lines.
+For instance, if you have an input line like:</p>
 
 @({
  (\"a_bus\"  _ _ _ a1 _ a2 _ _)
@@ -196,20 +182,18 @@
 
 <p>Then the returned list will include @('a1') and @('a2').</p>"
 
-  (defund stv->ins (x)
-    (declare (xargs :guard (processed-stv-p x)))
-    (b* (((processed-stv x) x)
-         ((compiled-stv cstv) x.compiled-stv))
-      (alist-keys cstv.in-usersyms))))
+  (b* (((processed-stv x) x)
+       ((compiled-stv cstv) x.compiled-stv))
+    (alist-keys cstv.in-usersyms)))
 
 
-(defsection stv->outs
+(define stv->outs ((x processed-stv-p))
+  :returns (outputs "Should be a symbol-listp in practice.") ;; BOZO strengthen
   :parents (symbolic-test-vectors)
   :short "Get a list of an STV's output simulation variables."
 
-  :long "<p>@(call stv->outs) returns the user-level symbolic variables from
-the output and internals lines of a symbolic test vector.  For instance, if you
-have an output line like:</p>
+  :long "<p>We collect simulation variables from all output and internals
+lines.  For instance, if you have an output line like:</p>
 
 @({
  (\"main_result\"  _ _ _ res1 _ res2 _ _)
@@ -217,77 +201,75 @@
 
 <p>Then the returned list will include @('res1') and @('res2').</p>"
 
-  (defund stv->outs (x)
-    (declare (xargs :guard (processed-stv-p x)))
-    (b* (((processed-stv x) x)
-         ((compiled-stv cstv) x.compiled-stv))
-      (alist-keys cstv.out-usersyms))))
+  (b* (((processed-stv x) x)
+       ((compiled-stv cstv) x.compiled-stv))
+    (alist-keys cstv.out-usersyms)))
 
 
-(defsection stv->vars
+(define stv->vars ((x processed-stv-p))
+  :returns (vars "Should be a symbol-listp in practice.") ;; BOZO strengthen
   :parents (symbolic-test-vectors)
   :short "Get a list of an STV's simulation variables (both inputs and
 outputs)."
-  :long "<p>See @(see stv->ins) and @(see stv->outs).</p>"
 
-  (defund stv->vars (x)
-    (declare (xargs :guard (processed-stv-p x)))
-    (append (stv->ins x)
-            (stv->outs x))))
+  (append (stv->ins x)
+          (stv->outs x)))
 
 
-(defsection stv-out->width
+(define stv-out->width ((x   symbolp)
+                        (stv processed-stv-p))
+  ;; BOZO fix this up to guarantee posp?
+  :returns (width natp :rule-classes :type-prescription)
   :parents (symbolic-test-vectors)
   :short "Get the bit-length for a particular output simulation variable."
 
-  :long "<p>@(call stv-out->width) returns the bit-length of an output
-simulation variable.  For instance, if you have an STV output line like:</p>
+  :long "<p>For instance, if you have an STV output line like:</p>
 
 @({
  (\"main_result\"  _ _ _ res1 _ res2 _ _)
 })
 
 <p>Then @('(stv-out->width 'res1 stv)') will return the width of
-@('main_result'), say 64.  If @('x') isn't one of the STV's outputs, we cause a
-runtime error and logically return 0.</p>"
+@('main_result'), say 64.</p>
 
-  (defun stv-out->width (x stv)
-    (declare (xargs :guard (and (symbolp x)
-                                (processed-stv-p stv))))
-    (b* (((processed-stv stv) stv)
-         ((compiled-stv cstv) stv.compiled-stv)
-         (look (hons-assoc-equal x cstv.out-usersyms))
-         ((unless look)
-          (er hard? 'stv-out->width "Unknown output: ~x0~%" x)
-          ;; returning 0 gets us at least a natp type prescription
-          0))
-      (len (cdr look)))))
+<p>If @('x') isn't one of the STV's outputs, we cause a runtime error and
+logically return 0.</p>"
 
+  (b* (((processed-stv stv) stv)
+       ((compiled-stv cstv) stv.compiled-stv)
+       (look (hons-assoc-equal x cstv.out-usersyms))
+       ((unless look)
+        (raise "Unknown output: ~x0~%" x)
+        ;; returning 0 gets us at least a natp type prescription
+        0))
+    (len (cdr look))))
 
-(defsection stv-in->width
+
+(define stv-in->width ((x   symbolp)
+                       (stv processed-stv-p))
+  ;; BOZO fix this up to guarantee posp?
+  :returns (width natp :rule-classes :type-prescription)
   :parents (symbolic-test-vectors)
   :short "Get the bit-length for a particular input simulation variable."
 
-  :long "<p>@(call stv-in->width) returns the bit-length of an input simulation
-variable.  For instance, if you have an STV input line like:</p>
+  :long "<p>For instance, if you have an STV input line like:</p>
 
 @({
  (\"a_bus\"  _ _ _ a1 _ a2 _ _)
 })
 
 <p>Then @('(stv-in->width 'a1 stv)') will return the width of @('a_bus'), say
-128.  If @('x') isn't one of the STV's inputs, we cause a runtime error and
+128.</p>
+
+<p>If @('x') isn't one of the STV's inputs, we cause a runtime error and
 logically return 0.</p>"
 
-  (defun stv-in->width (x stv)
-    (declare (xargs :guard (and (symbolp x)
-                                (processed-stv-p stv))))
-    (b* (((processed-stv stv) stv)
-         ((compiled-stv cstv) stv.compiled-stv)
-         (look (hons-assoc-equal x cstv.in-usersyms))
-         ((unless look)
-          (er hard? 'stv-in->width "Unknown input: ~x0~%" x)
-          ;; returning 0 gets us at least a natp type prescription
-          0))
-      (len (cdr look)))))
+  (b* (((processed-stv stv) stv)
+       ((compiled-stv cstv) stv.compiled-stv)
+       (look (hons-assoc-equal x cstv.in-usersyms))
+       ((unless look)
+        (raise "Unknown input: ~x0~%" x)
+        ;; returning 0 gets us at least a natp type prescription
+        0))
+    (len (cdr look))))
 
diff -Nru acl2-6.2/books/centaur/esim/stv/stv-widen.lisp acl2-6.3/books/centaur/esim/stv/stv-widen.lisp
--- acl2-6.2/books/centaur/esim/stv/stv-widen.lisp	2013-06-06 17:11:46.000000000 +0000
+++ acl2-6.3/books/centaur/esim/stv/stv-widen.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -26,82 +26,68 @@
 (include-book "std/lists/repeat" :dir :system)
 (local (include-book "std/lists/take" :dir :system))
 
-(defsection stv-widen-lines
+(define stv-widen-lines ((lines true-list-listp)
+                         (number-of-phases natp)
+                         (warn-non-blank booleanp))
+  :returns (widened-lines true-list-listp :hyp :guard)
   :parents (stv-widen)
-  :short "@(call stv-widen-lines) rewrites lines of an STV, repeating the last
-entry in each line until the desired number of phases is reached."
+  :short "Rewrite lines of an STV, repeating the last entry in each line to
+extend it to the desired number of phases."
 
   :long "<p>The @('warn-non-blank') is intended to be set for :output lines
 and :internals lines.  When it is set, we cause an error if an attempt is made
 to replicate any element other than @('_'), since it doesn't make sense to
 replicate simulation variables.</p>"
 
-  (defund stv-widen-lines (lines number-of-phases warn-non-blank)
-    (declare (xargs :guard (and (true-list-listp lines)
-                                (natp number-of-phases))))
-    (b* (((when (atom lines))
-          nil)
-         (line1         (car lines))
-         (line1-name    (car line1))
-         (line1-phases  (cdr line1))
-         (- (or (consp line1-phases)
-                (er hard? 'stv-widen-lines
-                    "No phases were provided for ~x0.~%" line1-name)))
-         (line1-nphases (len line1-phases))
-         (line1-widened-phases
-          (cond ((= line1-nphases number-of-phases)
-                 line1-phases)
-                ((< line1-nphases number-of-phases)
-                 (b* ((repeat-me (car (last line1-phases))))
-                   (or (not warn-non-blank)
-                       (eq repeat-me '_)
-                       (er hard? 'stv-widen-lines
-                           "The line for ~x0 needs to be extended, but it ends ~
+  (b* (((when (atom lines))
+        nil)
+       (line1         (car lines))
+       (line1-name    (car line1))
+       (line1-phases  (cdr line1))
+       (- (or (consp line1-phases)
+              (er hard? 'stv-widen-lines
+                  "No phases were provided for ~x0.~%" line1-name)))
+       (line1-nphases (len line1-phases))
+       (line1-widened-phases
+        (cond ((= line1-nphases number-of-phases)
+               line1-phases)
+              ((< line1-nphases number-of-phases)
+               (b* ((repeat-me (car (last line1-phases))))
+                 (or (not warn-non-blank)
+                     (eq repeat-me '_)
+                     (er hard? 'stv-widen-lines
+                         "The line for ~x0 needs to be extended, but it ends ~
                           with ~x1.  We only allow output and internal lines ~
                           to be extended when they end with an underscore."
-                           line1-name repeat-me))
-                   (append line1-phases
-                           (repeat repeat-me (- number-of-phases line1-nphases)))))
-                (t
-                 (prog2$
-                  (er hard? 'stv-widen-lines
-                      "Entry for ~x0 is longer than the max number of phases?" line1-name)
-                  (take number-of-phases line1-phases))))))
-      (cons (cons line1-name line1-widened-phases)
-            (stv-widen-lines (cdr lines) number-of-phases warn-non-blank))))
-
-  (local (in-theory (enable stv-widen-lines)))
-
-  (defthm true-list-listp-of-stv-widen-lines
-    (implies (true-list-listp lines)
-             (true-list-listp (stv-widen-lines lines number-of-phases warn-non-blank)))))
-
+                         line1-name repeat-me))
+                 (append line1-phases
+                         (repeat repeat-me (- number-of-phases line1-nphases)))))
+              (t
+               (prog2$
+                (er hard? 'stv-widen-lines
+                    "Entry for ~x0 is longer than the max number of phases?" line1-name)
+                (take number-of-phases line1-phases))))))
+    (cons (cons line1-name line1-widened-phases)
+          (stv-widen-lines (cdr lines) number-of-phases warn-non-blank))))
 
-(defsection stv-widen
+(define stv-widen ((stv stvdata-p))
+  :returns (widened-stv stvdata-p :hyp :guard)
   :parents (symbolic-test-vectors)
   :short "Widen the input/output/internals lines so that they all agree on how
 many phases there are."
-  :long "<p><b>Signature:</b> @(call stv-widen) returns a new @(see stvdata-p).</p>
-
-<p>This is an STV preprocessing step which can be run before or after @(see
-stv-expand).  We generally expect that all the lines have been widened before
-any compilation is performed.</p>
-
-<p>Note that we don't widen @(':initial') lines; they have only one value, not
-a series of values over time.</p>"
-
-  (defund stv-widen (stv)
-    (declare (xargs :guard (stvdata-p stv)))
-    (b* (((stvdata stv) stv)
-         (number-of-phases  (stv-number-of-phases stv)))
-      (change-stvdata stv
-                      :inputs    (stv-widen-lines stv.inputs number-of-phases nil)
-                      :outputs   (stv-widen-lines stv.outputs number-of-phases t)
-                      :internals (stv-widen-lines stv.internals number-of-phases t))))
-
-  (local (in-theory (enable stv-widen)))
-
-  (defthm stvdata-p-of-stv-widen
-    (implies (stvdata-p stv)
-             (stvdata-p (stv-widen stv)))))
 
+  :long "<p>This is an STV preprocessing step which can be run before or after
+@(see stv-expand).  We generally expect that all the lines have been widened
+before any compilation is performed.</p>"
+
+  (b* (((stvdata stv) stv)
+       (number-of-phases (stv-number-of-phases stv))
+       (new-inputs       (stv-widen-lines stv.inputs number-of-phases nil))
+       (new-outputs      (stv-widen-lines stv.outputs number-of-phases t))
+       (new-internals    (stv-widen-lines stv.internals number-of-phases t))
+       (new-overrides    (stv-widen-lines stv.overrides number-of-phases t)))
+    (change-stvdata stv
+                    :inputs    new-inputs
+                    :outputs   new-outputs
+                    :internals new-internals
+                    :overrides new-overrides)))
diff -Nru acl2-6.2/books/centaur/getopt/acl2-customization.lsp acl2-6.3/books/centaur/getopt/acl2-customization.lsp
--- acl2-6.2/books/centaur/getopt/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/acl2-customization.lsp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,27 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+#!ACL2
+(in-package "ACL2")
+
+(ld "~/acl2-customization.lsp" :ld-missing-input-ok t)
+(include-book "portcullis")
+(in-package "GETOPT")
+
diff -Nru acl2-6.2/books/centaur/getopt/cert.acl2 acl2-6.3/books/centaur/getopt/cert.acl2
--- acl2-6.2/books/centaur/getopt/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/cert.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,22 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(include-book "portcullis")
+; cert-flags: ? t :ttags :all
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/getopt/demo.lisp acl2-6.3/books/centaur/getopt/demo.lisp
--- acl2-6.2/books/centaur/getopt/demo.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/demo.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,318 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "GETOPT-DEMO")
+(include-book "top")
+(include-book "str/top" :dir :system)
+(local (include-book "std/typed-lists/string-listp" :dir :system))
+
+(defoptions demo
+  :parents (getopt)
+  :short "A basic demo of using @(see getopt) to parse command-line options."
+
+  :long "<p>This is a basic demo of how to use getopt, and a collection of unit
+tests to make sure getopt is working correctly.</p>
+
+<p>Note: our focus in this demo is just on the command-line parsing piece.  We
+illustrate illustrates a lot of the things you can do with getopt, e.g., short
+aliases, long names, default values, validating inputs, and accumulating
+arguments.  But we <b>don't</b> turn it into a working program.  If you want to
+understand how @(see getopt) and @(see argv) and @(see save-exec) fit together,
+see @(see demo2).</p>
+
+<p>This @('defoptions') call does two things:</p>
+
+<ul>
+
+<li>It introduces @('demo-p'), an ordinary @(see cutil::defaggregate) with
+various fields and well-formedness conditions.  These @('demo-p') structures
+can be passed around throughout your program just like any ordinary ACL2
+object.</li>
+
+<li>It introduces @(see parse-demo), a function that can parse a command-line
+into a @('demo-p').  The command-line is represented as a list of strings; see
+for instance @(see oslib::argv) to understand how to get the command-line
+arguments given to ACL2.</li>
+
+</ul>"
+
+  ;; GETOPT::DEFOPTIONS is a strict superset of defaggregate.  So, everything
+  ;; here should look very familiar if you have created aggregates:
+
+  :tag :demo
+
+  ((help    "Print a help message and exit with status 0."
+            booleanp
+            :rule-classes :type-prescription
+
+            ;; Because this field is a Boolean, defoptions automatically
+            ;; "knows" to treat it as a plain option, i.e., it knows that
+            ;; --help takes no extra argument.
+
+            ;; You don't have to tell it to use --help, either, because it
+            ;; just figures that out from the field name.
+
+            ;; However, if we want to also support -h, we need to tell it
+            ;; to treat the letter #\h as an alias for help:
+            :alias #\h)
+
+   (verbose "Turn on excessive debugging information."
+            booleanp
+            :rule-classes :type-prescription
+
+            ;; As with --help, there's little "extra" work to do here.  We
+            ;; won't create an alias, because we'll use -v for --version.
+            )
+
+   (version "Print version information and exit with status 0."
+            booleanp
+            :rule-classes :type-prescription
+            :alias #\v)
+
+   (username "Change the username to something else."
+             stringp
+             :rule-classes :type-prescription
+             :default ""
+             :alias #\u
+             :argname "NAME"
+             ;; This option is more interesting.  By default, a stringp option
+             ;; takes an argument.  The ARGNAME affects how its printed in the
+             ;; usage message.
+             )
+
+   (port     "Port to connect to."
+             natp
+             :rule-classes :type-prescription
+             :default 55432
+             :alias #\p
+             :argname "PORT"
+             ;; Support for numeric arguments is built into defoptions, so it
+             ;; can automatically parse the option into a number for you.  We
+             ;; don't need to put in a :parser option here because parse-nat is
+             ;; the default for natp fields, but just to make this demo more
+             ;; complete I include it.
+             :parser getopt::parse-nat)
+
+   (dirs    "Directory list"
+            string-listp
+
+            ;; This option is more interesting in several ways.  The idea here
+            ;; is that the user can say, e.g.,
+            ;;
+            ;;   --dir /usr --dir /home --dir /bin
+            ;;
+            ;; And these options should all get bundled up together into a
+            ;; single list.
+
+            ;; Well, internally in our program, we want to think of this as a
+            ;; list of dirs.  So, we want to call the field "dirs".  But the
+            ;; user enters one dir at a time, so we want the user-visible
+            ;; option name to be different.  We can do that by overriding the
+            ;; longname that defoptions generates by default:
+            :longname "dir"
+
+            ;; Now, defoptions has no default way to parse in a string-listp.
+            ;; But it does have a built-in string parser, which we can reuse.
+            ;; So, first, tell it to use the string parser:
+            :parser getopt::parse-string
+
+            ;; But that wouldn't be enough on its own, because if we just set
+            ;; it to use parse-string, then that produces a stringp instead of
+            ;; a string-listp, and our proofs would fail.  Instead, we need to
+            ;; tell defoptions how to merge the results of the parser with the
+            ;; previous value.  Using CONS would actually reverse the order of
+            ;; the dirs, because the options are processed in order.  So we
+            ;; avoid that by using rcons, to push the strings on the end.
+            :merge rcons)
+
+   (extra-stuff "Hidden option that the user never sees, but that is part of
+                 our aggregate."
+                :hide t)
+
+   (extra-stuff2 stringp
+                 "Hidden option that the user never sees, but that is part of
+                 our aggregate."
+                 :hide t
+                 :default "")))
+
+
+#||
+
+;; Some good things to try:
+
+(xdoc::xdoc 'parse-demo)
+
+(princ$ *demo-usage* *standard-co* state)
+
+||#
+
+
+;; Here are some basic tests to make sure it's working.
+
+(defun run-parse-demo (input)
+  (let ((tokens (str::strtok input '(#\Space))))
+    (mv-let (err result extra)
+      (parse-demo tokens)
+      (if err
+          (prog2$ (cw "~@0~%" err)
+                  (list :err err))
+        (let ((res (list :result result
+                         :extra extra)))
+          (prog2$ (cw "Success: ~x0~%" res)
+                  res))))))
+
+(defmacro check (input result extra)
+  `(acl2::assert! (equal (run-parse-demo ,input)
+                         (list :result ,result :extra ,extra))))
+
+(defmacro fail (input)
+  `(acl2::assert! (equal (car (run-parse-demo ,input))
+                         :err)))
+
+(check "" (make-demo) nil)
+
+(check "--help --version"
+       (make-demo :help t :version t)
+       nil)
+
+(check "--version --help"
+       (make-demo :help t :version t)
+       nil)
+
+(fail "--help=123")
+(fail "--help --help")
+(fail "--hlep")
+
+
+(fail "--port")
+(fail "--port abc")
+
+(check "--port 123"
+       (make-demo :port 123)
+       nil)
+
+(check "--port=123"
+       (make-demo :port 123)
+       nil)
+
+(check "--dir= --dir=abc --dir= --dir=xyz"
+       (make-demo :dirs '("" "abc" "" "xyz"))
+       nil)
+
+(check "-h -v"
+       (make-demo :help t :version t)
+       nil)
+
+(check "-h --version"
+       (make-demo :help t :version t)
+       nil)
+
+(check "-hv"
+       (make-demo :help t :version t)
+       nil)
+
+(fail "-huv")
+(fail "-hxv")
+(fail "-u")
+
+(check "-hv"
+       (make-demo :help t :version t)
+       nil)
+
+(fail "-p")
+(fail "-p abc")
+
+(check "-p 123"
+       (make-demo :port 123)
+       nil)
+
+(check "-p=123"
+       (make-demo :port 123)
+       nil)
+
+(check "a b c d"
+       (make-demo)
+       '("a" "b" "c" "d"))
+
+(check "a -u b c d"
+       (make-demo :username "b")
+       '("a" "c" "d"))
+
+(check "a -u=b c d"
+       (make-demo :username "b")
+       '("a" "c" "d"))
+
+(check "a -u b c -p=12 d"
+       (make-demo :username "b"
+                  :port 12)
+       '("a" "c" "d"))
+
+(check "a b c --dir dir1 d e f"
+       (make-demo :dirs '("dir1"))
+       '("a" "b" "c" "d" "e" "f"))
+
+(check "a b c --dir dir1 --dir dir2 d e f"
+       (make-demo :dirs '("dir1" "dir2"))
+       '("a" "b" "c" "d" "e" "f"))
+
+(check "a b c --dir=dir1 --dir dir2 d e f"
+       (make-demo :dirs '("dir1" "dir2"))
+       '("a" "b" "c" "d" "e" "f"))
+
+(check "a b c --dir=dir1 --dir=dir2 d e f"
+       (make-demo :dirs '("dir1" "dir2"))
+       '("a" "b" "c" "d" "e" "f"))
+
+(check "a b c --dir dir1 --help --dir dir2 d e f"
+       (make-demo :help t
+                  :dirs '("dir1" "dir2"))
+       '("a" "b" "c" "d" "e" "f"))
+
+(check "a b c --dir dir1 --help x y z --dir dir2 d e f"
+       (make-demo :help t
+                  :dirs '("dir1" "dir2"))
+       '("a" "b" "c" "x" "y" "z" "d" "e" "f"))
+
+(check "a b c --dir dir1 --help x y z --dir=dir2 d e f --dir dir3"
+       (make-demo :help t
+                  :dirs '("dir1" "dir2" "dir3"))
+       '("a" "b" "c" "x" "y" "z" "d" "e" "f"))
+
+(fail "a b c --dir")
+
+(fail "a b c --dir dir1 --dir")
+
+
+(check "--"
+       (make-demo)
+       '("--"))
+
+
+(check "-- --help"
+       (make-demo)
+       '("--" "--help"))
+
+(check "-- -x -y -z"
+       (make-demo)
+       '("--" "-x" "-y" "-z"))
+
+(check "--verbose -- --help"
+       (make-demo :verbose t)
+       '("--" "--help"))
diff -Nru acl2-6.2/books/centaur/getopt/demo2-save.lsp acl2-6.3/books/centaur/getopt/demo2-save.lsp
--- acl2-6.2/books/centaur/getopt/demo2-save.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/demo2-save.lsp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,81 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+
+; You can give this script to ACL2 using something like:
+;
+;  ACL2_CUSTOMIZATION=NONE acl2 < demo2-save.lsp
+;
+; This should create a demo2 script and Lisp image that:
+;
+;   - Doesn't print any startup stuff
+;   - Doesn't read any customization files
+;   - Reads and processes the command-line arguments
+;
+; E.g.,
+;
+;     $ ./demo2
+;     colorless green ideas sleep furiously
+;     $ echo $?
+;     0
+;
+;     $ ./demo2 --help
+;     demo2: how to write a command line program in ACL2
+;         -h,--help             Print a help message and exit with status 0.
+;         -v,--version          Print out a version message and exit with
+;                               status 0.
+;     $ echo $?
+;     0
+;
+;     $ ./demo2 --version
+;     demo2: version 1.234
+;     $ echo $?
+;     0
+;
+;     $ ./demo2 --foo
+;     Unrecognized option --foo
+;     $ echo $?
+;     1
+;
+;     $ ./demo2 --help=17
+;     Option --help can't take an argument
+;     $ echo $?
+;     1
+
+(include-book "demo2")
+
+:q
+
+;; Set up our program to not print a bunch of ACL2 banners.
+(setq *print-startup-banner* nil)
+
+;; Set up our program NOT try to read the any customization files.
+(defun initial-customization-filename () :none)
+
+(save-exec "demo2" "getopt demo 2 program"
+
+           ;; Inert-args MUST be given, or ACL2 won't put the "--" into the
+           ;; startup script, and ARGV won't know which arguments belong to the
+           ;; Lisp, and which belong to our program.
+           :inert-args ""
+           :return-from-lp '(getopt-demo::demo2-main acl2::state))
+
+
+
diff -Nru acl2-6.2/books/centaur/getopt/demo2.lisp acl2-6.3/books/centaur/getopt/demo2.lisp
--- acl2-6.2/books/centaur/getopt/demo2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/demo2.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,102 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "GETOPT-DEMO")
+(include-book "top")
+(include-book "oslib/argv" :dir :system)
+(set-state-ok t)
+
+(defsection demo2
+  :parents (getopt)
+  :short "Demonstration of how to use @(see getopt) and @(see argv) to create a
+working command-line program from ACL2."
+
+  :long "<p>This is an example of how to write an extremely basic command-line
+program in ACL2 that parses some options from the command-line.</p>
+
+<p>Note: our focus in this demo is to show how @(see getopt) and @(see argv)
+and @(see save-exec) work together.  Our program takes just a few basic
+options.  If you want to see a demo of how to parse fancier command-line
+options, see @(see demo) instead.</p>
+
+<p>Depending on its input, our program will print out:</p>
+
+<ul>
+<li>A help message (--help or -h)</li>
+<li>A version message (--version or -v)</li>
+<li>The nonsense sentence @('colorless green ideas sleep furiously').</li>
+</ul>
+
+<p>Our top-level program is @(see demo2-main).</p>
+
+<ul>
+ <li>It uses @(see argv) to get the command-line options.</li>
+ <li>It uses @(see getopt) to parse them into a @(see demo2-opts-p) structure.</li>
+ <li>It then prints a message, as described above.</li>
+</ul>
+
+<p>To see how to turn @('demo2-main') into an executable, see the file
+@('centaur/getopt/demo2-save.lsp').</p>")
+
+(defoptions demo2-opts
+  :parents (demo2)
+  :tag :demo2
+
+  ((help    "Print a help message and exit with status 0."
+            booleanp
+            :rule-classes :type-prescription
+            :alias #\h)
+
+   (version "Print out a version message and exit with status 0."
+            booleanp
+            :rule-classes :type-prescription
+            :alias #\v)))
+
+(defsection demo2-main
+  :parents (demo2)
+  :short "Run the demo2 program."
+
+  (defund demo2-main (state)
+    (b* (((mv argv state)              (oslib::argv))
+         ((mv errmsg opts ?extra-args) (parse-demo2-opts argv))
+
+         ((when errmsg)
+          (cw "~@0~%" errmsg)
+          (exit 1)
+          state)
+
+         ((demo2-opts opts) opts)
+
+         ((when opts.help)
+          (b* ((- (cw "demo2: how to write a command line program in ACL2~%"))
+               (state (princ$ *demo2-opts-usage* *standard-co* state))
+               (- (cw "~%")))
+            (exit 0)
+            state))
+
+         ((when opts.version)
+          (cw "demo2: version 1.234~%")
+          (exit 0)
+          state))
+
+      (cw "colorless green ideas sleep furiously~%")
+      (exit 0)
+      state)))
+
diff -Nru acl2-6.2/books/centaur/getopt/package.lsp acl2-6.3/books/centaur/getopt/package.lsp
--- acl2-6.2/books/centaur/getopt/package.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/package.lsp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,89 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+
+(include-book "cutil/portcullis" :dir :system)
+(include-book "oslib/portcullis" :dir :system)
+
+(defpkg "GETOPT"
+  (union-eq (set-difference-eq
+             (union-eq *acl2-exports*
+                       *common-lisp-symbols-from-main-lisp-package*)
+             '(union delete))
+            sets::*sets-exports*
+            cutil::*cutil-exports*
+            '(;; Things we want to "export", for nicer use from other
+              ;; packages.
+              getopt
+              defoptions
+              ;; Things we want to "import"
+              quit
+              exit
+              b*
+              getopt
+              assert!
+              list-fix
+              rcons
+              prefixp
+              lnfix
+              lifix
+              lbfix
+              xdoc
+              defxdoc
+              defsection
+              definline
+              definlined
+              unsigned-byte-p
+              signed-byte-p
+              str::explode
+              str::implode
+              str::cat
+              str::natstr
+              str::join
+              uniquep
+              duplicated-members
+              msg
+              value
+              def-ruleset
+              enable*
+              disable*
+              e/d*
+              cutil::formal
+              cutil::formal-p
+              cutil::formal->opts
+              cutil::formal->name
+              cutil::formallist-p
+              cutil::formallist->names
+              cutil::look-up-formals
+              cutil::look-up-return-vals
+              cutil::tuplep)))
+
+#!GETOPT
+(defconst *getopt-exports*
+  '(getopt defoptions))
+
+(defpkg "GETOPT-DEMO"
+  (union-eq *acl2-exports*
+            *common-lisp-symbols-from-main-lisp-package*
+            getopt::*getopt-exports*
+            '(acl2::rcons xdoc::defsection xdoc::defxdoc
+                          b* oslib::argv)))
+
diff -Nru acl2-6.2/books/centaur/getopt/parsers.lisp acl2-6.3/books/centaur/getopt/parsers.lisp
--- acl2-6.2/books/centaur/getopt/parsers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/parsers.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,315 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "GETOPT")
+(include-book "cutil/top" :dir :system)
+(include-book "str/strval" :dir :system)
+
+
+(defsection parsers
+  :parents (getopt)
+  :short "Parsers for various kinds of command-line options."
+
+  :long "<p>Different programs will need to take all sorts of different kinds
+of options.  For instance:</p>
+
+<ul>
+<li>ssh takes a port number between 0 and 65535,</li>
+<li>svn takes a revision number that can be a natural or a
+    special word like HEAD, BASE, or PREV,</li>
+<li>wget takes a URL,</li>
+<li>mail takes an email address, and so on.</li>
+</ul>
+
+<p>There's no way for @(see getopt) to anticipate and support everything that
+every program might want, so instead we use a table-driven approach that you
+can extend with custom parsers for your types.</p>
+
+<p>Now, out of the box we do at least provide parsers for basic options like
+@('--verbose'), @('--username jared'), @('--level=100000'), and so forth.</p>
+
+<p>But when these aren't good enough, e.g., because you want to have stronger
+type requirements on your arguments structure, you can add your own @(see
+custom-parser) functions and plug them in.</p>")
+
+
+(defsection custom-parser
+  :parents (parsers)
+  :short "How to write custom argument-parsing functions."
+
+  :long "<p>You can extend getopt with new functions for parsing the arguments
+you care about.</p>
+
+<p>Note that once you have introduced such a new parsing function, you
+can (optionally) register it as the default parser for a predicate using @(see
+set-default-parser).</p>
+
+<p>Every argument-parsing function must have the following form:</p>
+
+<box><code>
+ (parse-foo name explicit-value args)
+   &rarr;
+ (mv errmsg? value rest-args)
+</code></box>
+
+<p>Inputs:</p>
+
+<ul>
+
+<li>@('name') is a string that is the name of the option the user typed in,
+e.g., it might be @('--verbose').  This is included so that the parser can
+provide a nice error message.</li>
+
+<li>@('explicit-value') is NIL unless the use types something like
+@('--foo=bar'), in which case it is the value being assigned, e.g.,
+@('\"bar\").</li>
+
+<li>@('args') is a @(see string-listp) with the full command line arguments
+that the user typed in after the @('name') and, if applicable, the
+@('explicit-value').  It may be the empty list if @('name') was the last
+argument to the program.</li>
+
+</ul>
+
+<p>Outputs</p>
+
+<ul>
+
+<li>@('errmsg?') should be @('nil') if everything is okay, or an error message
+produced by @(see msg).  Typically it might be something like:
+
+@({
+     (msg \"Option ~s0 needs a valid port number, but got ~x1\"
+            name (car args))
+})</li>
+
+<li>@('value') is irrelevant if there was an error, but otherwise must be a
+valid @('foop'), for whatever kind of data this parser is supposed to
+generate.</li>
+
+<li>@('rest-args') should be the remainder of @('args') after the arguments to
+@('name') have been removed.  For termination, its length must be no greater
+than the length of @('args').</li>
+
+</ul>
+
+<p>All of the built-in parsers fit into the above scheme, so you can see
+several examples of argument-parsing functions by just looking at the built-in
+@(see parsers) like @(see parse-nat).</p>
+
+<p>You might wonder why we have the @('explicit-value') separate from
+@('args').  The basic reason is that we want to support any mixture of the
+following syntaxes:</p>
+
+<ul>
+ <li>@('--color red ...')</li>
+ <li>@('--color=red ...')</li>
+</ul>
+
+<p>Making the explicit-value explicit lets us very easily support this without
+requiring, e.g., that every argument has exactly one value.</p>")
+
+(table getopt 'parsers
+       ;; Maps predicates to the names of their default parsing functions.
+       nil)
+
+(defun getopt-parsers (world)
+  (declare (xargs :mode :program))
+  (cdr (assoc-eq 'parsers (table-alist 'getopt world))))
+
+(defun default-getopt-parser (predicate world)
+  (declare (xargs :mode :program))
+  (cdr (assoc predicate (getopt-parsers world))))
+
+(defun check-plausibly-a-parser-p (ctx fn world)
+  (declare (xargs :mode :program))
+  (b* ((look (getprop fn 'acl2::formals :bad 'acl2::current-acl2-world world))
+       ((when (eq look :bad))
+        (er hard? ctx "~x0 is not the name of a defined function." fn))
+       (nformals (len (look-up-formals fn world)))
+       (nreturns (len (look-up-return-vals fn world)))
+       ((unless (and (eql nformals 3)
+                     (eql nreturns 3)))
+        (er hard? ctx
+            "The function ~x0 does not have the right signature for a getopt ~
+             parser.  Expected 2 formals and 3 return vals, but found ~x1 and ~
+             ~x2, respectively.  See :xdoc ~x3." fn nformals nreturns
+             'custom-parser)))
+    t))
+
+
+(defsection defparser
+  :parents (parsers)
+  :short "Register a new argument-parsing function with @(see getopt)."
+
+  :long "<p>@(call defparser) is a macro for registering parsing functions with
+@(see getopt).</p>
+
+<p>It first checks to make sure that @('fn') has the valid format for a @(see
+custom-parser), and tries to prove the necessary progress property.</p>
+
+<p>If @('predicate') is non-nil, it installs @('fn') as the default parsing
+function to use for options of type @('predicate').  The general idea here is
+that if you write a new custom parser for ports, you can then set it up to be
+the default parser for any @('port-p') field.</p>"
+
+  (defmacro defparser (fn &key predicate)
+    (declare (xargs :guard (symbolp fn)))
+    `(make-event
+      (b* ((world (w state))
+           (predicate ',predicate)
+           (fn        ',fn)
+           (- (check-plausibly-a-parser-p 'defparser fn world))
+           ((unless (or (not predicate)
+                        (and (eql (len (look-up-formals predicate world)) 1)
+                             (eql (len (look-up-return-vals predicate world)) 1))))
+            (er soft 'defparser
+                "The function ~x0 does not seem like a valid unary predicate."
+                predicate))
+           (look (assoc predicate (getopt-parsers world)))
+           ((unless (or (not predicate)
+                        (not look)
+                        (eq (cdr look) fn)))
+            (er soft 'defparser
+                "The predicate ~x0 already has a different getopt parser ~
+               as its default: ~x1" predicate (cdr look))))
+        (value
+         '(progn
+            (local (in-theory (enable ,fn)))
+
+            (defthm ,(intern-in-package-of-symbol
+                      (cat (symbol-name fn) "-MAKES-PROGRESS")
+                      fn)
+              (<= (len (mv-nth 2 (,fn name explicit-value args)))
+                  (len args))
+              :rule-classes ((:rewrite) (:linear)))
+
+            ,@(if (not predicate)
+                  nil
+                `((table getopt 'parsers
+                         (cons (cons ',predicate ',fn)
+                               (getopt-parsers world)))))))))))
+
+
+(define parse-plain
+  :parents (parsers)
+  :short "Parser for plain, argument-free options that are off by default and
+must be explicitly enabled, e.g., @('--verbose') or @('--force')."
+
+  :long "<p>We just return true, because by typing the name of the option the
+user is saying they want to turn it on.  This is useful for options that the
+user has to explicitly ask for because they are unsafe or just unusual.</p>"
+  ((name stringp)
+   (explicit-value (or (not explicit-value)
+                       (stringp explicit-value)))
+   (args string-listp))
+  :returns (mv err
+               (value booleanp :rule-classes :type-prescription)
+               (rest-args string-listp :hyp (force (string-listp args))))
+  (if explicit-value
+      (mv (msg "Option ~s0 can't take an argument" name) nil args)
+    (mv nil t args))
+  ///
+  (defparser parse-plain :predicate booleanp))
+
+
+(define parse-string
+  :parents (parsers)
+  :short "Parser for options that require an argument, but where any arbitrary
+string will do, e.g., @('--username') or @('--eval')."
+  :long "<p>The only way this can fail is if there aren't any more arguments,
+e.g., someone types something like @('myprogram --username') and doesn't say
+what username to use.</p>"
+  ((name stringp)
+   (explicit-value (or (not explicit-value)
+                       (stringp explicit-value)))
+   (args string-listp))
+  :returns (mv err
+               (value stringp :rule-classes :type-prescription)
+               (rest-args string-listp :hyp (force (string-listp args))))
+  (b* (((mv val args)
+        (if explicit-value
+            (mv explicit-value args)
+          (mv (car args) (cdr args))))
+       ((unless val)
+        (mv (msg "Option ~s0 needs an argument" name) "" args)))
+    (mv nil (str::str-fix val) args))
+  ///
+  (defparser parse-string :predicate stringp))
+
+
+(define parse-nat
+  :parents (parsers)
+  :short "Parser for options that require a @(see natp) argument, e.g.,
+@('--tabsize') or @('-O'), etc."
+  :long "<p>We just read the next string out of the argument list and try to
+interpret it as a decimal number.  This fails if it there is no argument, or if
+there are any non-numeric characters.</p>"
+  ((name stringp)
+   (explicit-value (or (not explicit-value)
+                       (stringp explicit-value)))
+   (args string-listp))
+  :returns (mv err
+               (value natp :rule-classes :type-prescription)
+               (rest-args string-listp :hyp (force (string-listp args))))
+  (b* (((mv val args)
+        (if explicit-value
+            (mv explicit-value args)
+          (mv (car args) (cdr args))))
+       ((unless val)
+        (mv (msg "Option ~s0 needs an argument" name) 0 args))
+       (ret (str::strval val))
+       ((unless ret)
+        (mv (msg "Option ~s0 needs a number, but got ~x1" name val)
+            0 args)))
+    (mv nil ret args))
+  ///
+  (defparser parse-nat :predicate natp))
+
+
+(define parse-pos
+  :parents (parsers)
+  :short "Parser for options that require a @(see posp) argument, e.g.,
+@('--block-size') or @('--line-number')."
+  :long "<p>This is just like @(see parse-nat) except that we also cause
+an error if the argument is zero.</p>"
+  ((name stringp)
+   (explicit-value (or (not explicit-value)
+                       (stringp explicit-value)))
+   (args string-listp))
+  :returns (mv err
+               (value posp :rule-classes :type-prescription)
+               (rest-args string-listp :hyp (force (string-listp args))))
+  (b* (((mv val args)
+        (if explicit-value
+            (mv explicit-value args)
+          (mv (car args) (cdr args))))
+       ((unless val)
+        (mv (msg "Option ~s0 needs an argument" name) 1 args))
+       (ret (str::strval val))
+       ((unless ret)
+        (mv (msg "Option ~s0 needs a number, but got ~x1" name val)
+            1 args))
+       ((when (eql ret 0))
+        (mv (msg "Option ~s0 can't be zero" name) 1 args)))
+    (mv nil ret args))
+  ///
+  (defparser parse-pos :predicate posp))
+
diff -Nru acl2-6.2/books/centaur/getopt/portcullis.acl2 acl2-6.3/books/centaur/getopt/portcullis.acl2
--- acl2-6.2/books/centaur/getopt/portcullis.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/portcullis.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,22 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(ld "package.lsp")
+; cert-flags: ? t :ttags :all
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/getopt/portcullis.lisp acl2-6.3/books/centaur/getopt/portcullis.lisp
--- acl2-6.2/books/centaur/getopt/portcullis.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/portcullis.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,21 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "GETOPT")
diff -Nru acl2-6.2/books/centaur/getopt/top.lisp acl2-6.3/books/centaur/getopt/top.lisp
--- acl2-6.2/books/centaur/getopt/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/getopt/top.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,1100 @@
+; ACL2 Getopt Library
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "GETOPT")
+(include-book "cutil/top" :dir :system)
+(include-book "str/case-conversion" :dir :system)
+(include-book "str/strprefixp" :dir :system)
+(include-book "str/subseq" :dir :system)
+(include-book "str/strpos" :dir :system)
+(include-book "parsers")
+(include-book "xdoc/word-wrap" :dir :system)
+(include-book "std/misc/two-nats-measure" :dir :system)
+
+
+(defxdoc getopt
+  :parents (acl2::interfacing-tools)
+  :short "A library for processing command-line option."
+
+  :long "<h3>Introduction</h3>
+
+<p><b>Getopt</b> is a tool for writing command-line programs in ACL2.  It is
+similar in spirit to <a
+href='http://perldoc.perl.org/Getopt/Long.html'>Getopt::Long</a> for Perl, <a
+href='http://trollop.rubyforge.org/'>Trollop</a> for Ruby, and so on.</p>
+
+<p>We basically extend @(see defaggregate) with a command-line parsing layer.
+This has some nice consequences:</p>
+
+<ul>
+
+<li>Argument parsing gives you an ordinary aggregate that can have nice, strong
+type guarantees on its fields.</li>
+
+<li>It's very easy to add new options, pass the arguments throughout your
+program, etc.</li>
+
+<li>You get excellent integration with @(see xdoc), i.e., documentation is
+mostly automated.</li>
+
+<li>We can automatically generate usage messages that stay up to date as you
+add new arguments.</li>
+
+</ul>
+
+<p>To make Getopt more automatic, we insist on some typical Unix conventions.
+We support options like these:</p>
+
+@({
+    --help              Long names use two dashes.
+    --color red         Values can use spaces or = signs.
+    --shape=square
+
+    -c red              Short aliases use one dash.  Plain
+    -s=square           aliases (with no arguments) can be
+    -xfvz               bundled.  E.g., -xfvz instead of
+                        -x -f -v -z.
+})
+
+<p>We insist on two dashes for long options, and one dash for short options.
+This lets us support mixing options in with other arguments like file names.
+For instance, after parsing something like:</p>
+
+@({ myprogram --depth 3 --verbose foo.java bar.java -o report.txt })
+
+<p>You get two things out:</p>
+
+<ul>
+
+<li>A proper options structure with <i>depth</i> @('3'), <i>verbose</i> @('t'),
+and <i>output</i> @('report.txt').</li>
+
+<li>The \"extra\" arguments, i.e., @('(\"foo.java\" \"bar.java\")').</li>
+
+</ul>
+
+<p>For rare cases where you need to process a file that starts with @('-'), the
+special syntax @('--') is a marker that means \"stop looking for options
+here.\"</p>
+
+<h3>Using Getopts</h3>
+
+<p>Getopts is an ordinary library with no ttags.  To load it, just include the
+top book:</p>
+
+@({ (include-book \"centaur/getopt/top\" :dir :system) })
+
+<p>After that, the main command is @(see defoptions).</p>
+
+<p>There is also a demo of how to use Getopt: @(see getopt-demo::demo-p).</p>
+
+
+<h3>Copyright Information</h3>
+
+<p>ACL2 Getopt Library<br/>
+Copyright (C) 2013
+<a href=\"http://www.centtech.com\">Centaur Technology</a>.</p>
+
+<p>Contact:</p>
+@({
+Centaur Technology Formal Verification Group
+7600-C N. Capital of Texas Highway, Suite 300
+Austin, TX 78731, USA.
+})
+
+<p>This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2 of the License, or (at your option) any
+later version.</p>
+
+<p>This program is distributed in the hope that it will be useful but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+details.</p>
+
+<p>You should have received a copy of the GNU General Public License along with
+this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
+Street, Suite 500, Boston, MA 02110-1335, USA.</p>
+
+<p>Original author: Jared Davis
+&lt;<a href='mailto:jared@centtech.com'>jared@centtech.com</a>&gt;</p>")
+
+
+(defsection defoptions
+  :parents (getopt)
+  :short "Define a structure for representing command line options, and a
+command-line parser that creates this structure."
+
+  :long "<p>@('defoptions') is the main command provided by @(see getopt)
+library.  It is really a thin wrapper around @(see defaggregate), where each
+field can have some additional keywords that have certain effects.</p>
+
+
+<h3>A Basic Example</h3>
+
+@({
+    (defoptions myopts
+      :parents (myprogram)
+      :short \"Command line options for my program.\"
+      :tag :myopts
+      ((help    booleanp
+                \"Print a help message and exit with status 0.\")
+       (outfile stringp
+                \"Where to write the output.\"
+                :default \"a.out\")))
+})
+
+<p>So far, this is identical to @('defaggregate') except that we use
+@('defoptions') instead.  Indeed, the first thing the above @('defoptions')
+form expands into is an ordinary @('defaggregate') call.  The @('defaggregate')
+introduces a @('myopts-p') structure as usual, complete with the usual
+accessors like @('myopts->help'), a @('make-myopts') macro, etc.</p>
+
+<p>But in addition to introducing an aggregate, @('defoptions') introduces a
+usage message and a command-line parsing function.</p>
+
+<p>For @('myopts') above, the usage message, @('*myopts-usage*'), will just
+be:</p>
+
+@({
+    --help                Print a help message and exit with status 0.
+    --outfile=ARG         Where to write the output.
+})
+
+<p>So that's handy, and below we'll see how to customize this message a bit.
+You can probably easily imagine incorporating this into your program's
+@('--help') message.</p>
+
+<p>Meanwhile, the parsing function, @('parse-myopts'), allows you to parse a
+@(see string-listp) into a @('myopts-p') structure.  The signature of
+@('parse-myopts') is:</p>
+
+@({
+ (parse-myopts args &key (init '*default-myopts*))
+  -->
+ (mv errmsg result extra)
+})
+
+<p>The @('args') here are just a string list.  Normally, if you were writing a
+real command-line program with ACL2, you would normally get the @('args') to
+process by calling @(see oslib::argv).  But for testing and development, we can
+just use any old string list we want.</p>
+
+<p>Usually you won't care about the optional @(':init') argument: it just lets
+you use a custom @('myopts') structure as the starting point, instead of
+starting from the default structure (which has the @(':default') value for each
+field.)</p>
+
+<p>Command-line parsing can fail because the user might type in something
+crazy.  For instance, they might try to run @('myprogram --hlep') instead of
+@('myprogram --help').  The @('errmsg') will be NIL if everything is okay, or
+else will be an error message produced by @(see msg), which is suitable for
+printing with the @(see fmt) directive @('~@').  For example:</p>
+
+@({
+    (b* (((mv errmsg result extra)
+           (parse-myopts '(\"--hlep\")))
+          ((when errmsg)
+           (cw \"Error processing options!~%\")
+           (cw \"~@0~%\" errmsg)
+           nil))
+       result)
+})
+
+<p>Will print out:</p>
+
+@({
+    Error processing options!
+    Unrecognized option --hlep
+})
+
+<p>When command-line processing is successful, the main return value,
+@('result'), is a valid @('myopts-p') structure that contains the various
+settings, and the @('extra') return value is a list of any command-line options
+that we skipped because they didn't look like options.  For example:</p>
+
+@({
+    (b* (((mv ?errmsg result extra)
+          (parse-myopts
+           '(\"foo.java\" \"--outfile\" \"report.txt\" \"bar.java\"))))
+      (list :result result
+            :extra extra))
+})
+
+<p>Will return:</p>
+
+@({
+    (:RESULT (:MYOPTS (HELP)
+                      (OUTFILE . \"report.txt\"))
+     :EXTRA (\"foo.java\" \"bar.java\"))
+})
+
+
+<h3>Adding Short Aliases (-h, -o, ...)</h3>
+
+<p>Ordinarily a program that takes options like @('--help') and @('--outfile')
+will also have shorter ways to give these options, e.g., @('-h') and @('-o').
+You can set up these short names by just adding an @(':alias') to your fields,
+like this:</p>
+
+@({
+    (defoptions myopts
+      :parents (myprogram)
+      :short \"Command line options for my program.\"
+      :tag :myopts
+      ((help    booleanp
+                \"Print a help message and exit with status 0.\"
+                :alias #\\h)
+       (outfile stringp
+                \"Where to write the output.\"
+                :default \"a.out\"
+                :alias #\\o)))
+})
+
+<p>Note that the usage message gets automatically extended to take these
+into account.  @('*myopts-usage*') becomes:</p>
+
+@({
+    -h,--help             Print a help message and exit with status 0.
+    -o,--outfile=ARG      Where to write the output.
+})
+
+
+<h3>Custom Option Types</h3>
+
+<p>The @('myopts-p') structure is especially simple in that it only contains
+@(see booleanp) and @(see stringp) fields.  Getopt has built-in @(see parsers)
+for these types, as well as for @(see natp) and @(see posp).  But in some cases
+these may not be sufficient.</p>
+
+<p>If you need something fancier, you can write your own parser.  See @(see
+custom-parser) for details.  After writing your own @('parse-foo') function, you can
+either register it as the default for all @('foo-p') fields, or you can install
+it just as the parser for a particular field using the @(':parser') option.
+For instance:</p>
+
+@({
+       (outfile stringp
+                \"Where to write the output.\"
+                :default \"a.out\"
+                :alias #\\o
+                ;; redundant, but acceptable, to explicitly say to use the
+                ;; default stringp parser
+                :parser getopt::parse-string)
+})
+
+
+<h3>Changing Option Names</h3>
+
+<p>By default the option name is just automatically inferred from the field
+name.  In rare cases you might want to change this, e.g., perhaps you prefer to
+use field-names like @('verbosep') instead of @('verbose').  You can accomplish
+this with a custom @(':longname') for the field, e.g.,</p>
+
+@({
+    (defoptions myopts
+      :parents (myprogram)
+      :short \"Command line options for my program.\"
+      :tag :myopts
+      ((verbosep booleanp
+                 :longname \"verbose\"
+                 \"Print excessive debugging information.\")
+       (help    booleanp
+                \"Print a help message and exit with status 0.\"
+                :alias #\\h)
+       (outfile stringp
+                \"Where to write the output.\"
+                :default \"a.out\"
+                :alias #\\o)))
+})
+
+
+<h3>List Types</h3>
+
+<p>By default options are <i>unmergeable</i>, meaning that it is an error to
+try to specify them more than once.  This is generally sensible behavior, e.g.,
+you probably don't want to support things like:</p>
+
+@({ myprog --username jared --username sol ... })
+
+<p>But occasionally you want to have an option that \"stacks\" with other
+options.  For instance, in our Verilog parsing stuff we often want a \"search
+path\" that is a list of directories.</p>
+
+<p>To facilitate this, the @(':merge') option can be used to specify a custom
+\"merging function\" (typically @(see cons)) that can extend a field with a new
+value.  For instance, here's basically the canonical way to have an option that
+lets the user write:</p>
+
+@({ myprog --dir /dir1 --dir /dir2 ... })
+
+<p>And turns them into a @('dirs') field:</p>
+
+@({
+      (dirs string-listp
+            :longname \"dir\"
+            :parser getopt::parse-string
+            :merge cons)
+})
+
+<p>Note that this will actually accumulate the options in the reverse
+order (because @(see cons) extends the front of a list).  This is easily
+corrected for by using some kind of @('push') function instead of @('cons'), or
+by reversing the list at the end.  See @(see getopt-demo::demo-p) for an
+example.</p>
+
+
+<h3>Customizing Usage Messages</h3>
+
+<p>By default we reuse the @(see xdoc) documentation for a field as its usage
+message.  If you want to have a separate usage message instead, you can just
+add one, e.g., via @(':usage \"blah blah\"').</p>
+
+<p>For options that take arguments, you may occasionally want to name the
+argument.  That is, by default, we will produce usage messages like:</p>
+
+@({
+    --port ARG      The port to connect to.
+    --out ARG       Where to write the output.
+})
+
+<p>But maybe you'd rather have this print as:</p>
+
+@({
+    --port PORT     The port to connect to.
+    --out FILE      Where to write the output.
+})
+
+<p>You can do this by adding, e.g., @(':argname \"PORT\"') and @(':argname
+\"FILE\"') to the port/out fields.</p>")
+
+
+(define split-equals ((x stringp))
+  :returns (mv (pre stringp
+                    :rule-classes :type-prescription)
+               (post (or (not post)
+                         (stringp post))
+                     :rule-classes :type-prescription))
+  (b* ((x (str::str-fix x))
+       (pos (str::strpos "=" x))
+       ((when pos)
+        (mv (subseq x 0 pos)
+            (subseq x (+ 1 pos) nil))))
+    (mv x nil)))
+
+
+#||
+(split-equals "foo=bar") --> (mv "foo" "bar")
+||#
+
+(program)
+
+(defconst *extra-fields-for-defoptions*
+  '(:longname   ;; Full name for this option, like "verbose".  Overrides
+                ;; the field name, if supplied.
+
+    :alias      ;; Short alias for this option, like #\v, if desired.
+
+    :parser     ;; What function will parse the arguments.  Automatically
+                ;; inferred from the field type, if not specified.
+
+    :merge      ;; How to merge the new values with the old, if applicable,
+                ;; e.g., for list-type values.
+
+    :usage      ;; A custom usage message, if one is needed instead of just
+                ;; using the formal's documentation
+
+    :argname    ;; Name for this argument in the usage message, e.g., you
+                ;; might want the message to look like
+                ;;
+                ;;   --port PORT     The port to connect to on the server.
+                ;;
+                ;;   --out FILE      Where to write the output
+                ;;
+                ;; And so on, so you'd use :argnames like "PORT" and "FILE"
+                ;; The default is "ARG" unless it's a plain option.
+
+    :hide       ;; A hidden option.  This requires that there is no alias,
+                ;; usage message, argname, or any of that.  This is generally
+                ;; useful for options you're going to fill in yourself, like
+                ;; file names.
+    ))
+
+(define formal->longname ((x formal-p))
+  :parents (getopt)
+  :returns (longname stringp)
+  (b* (((formal x) x)
+       (longname (cdr (assoc :longname x.opts)))
+       ((when (and (stringp longname)
+                   (not (equal longname ""))))
+        longname)
+       ((when longname)
+        (raise "In ~x0, :longname must be ~s1, but found: ~x2"
+               x.name
+               (if (stringp longname) "nonempty" "a string")
+               longname)
+        ""))
+    ;; Else, no longname at all, by default use the name of the formal.
+    (str::downcase-string (symbol-name x.name))))
+
+(defprojection formallist->longnames (x)
+  (formal->longname x)
+  :guard (formallist-p x)
+  :result-type string-listp
+  :optimize nil)
+
+
+(define formal->alias ((x formal-p))
+  :parents (getopt)
+  :returns (alias (or (not alias)
+                      (characterp alias)))
+  (b* (((formal x) x)
+       (alias (cdr (assoc :alias x.opts)))
+       ((when (characterp alias))
+        alias)
+       ((when alias)
+        (raise "In ~x0, :alias must be a character, but found ~x1."
+               x.name alias)
+        nil))
+    ;; No automatic inference of an alias
+    nil))
+
+(defprojection formallist->aliases (x)
+  (formal->alias x)
+  :guard (formallist-p x)
+  ;; :result-type maybe-character-listp
+  :optimize nil)
+
+
+
+(define formal->parser ((x formal-p) (world plist-worldp))
+  :parents (getopt)
+  :returns (parser-fn symbolp)
+  (b* (((formal x) x)
+       (parser (cdr (assoc :parser x.opts)))
+       ((when parser)
+        (check-plausibly-a-parser-p x.name parser world)
+        parser)
+       ;; Else, see if there is a default parser for this type
+       ((unless (and (tuplep 2 x.guard)
+                     (equal (second x.guard) x.name)))
+        (raise "In ~x0, there's no :parser and the type isn't simple enough ~
+                to infer a default." x.name))
+       (predicate (first x.guard))
+       (parser (default-getopt-parser predicate world))
+       ((when parser)
+        (check-plausibly-a-parser-p x.name parser world)
+        parser))
+    (raise "In ~x0, there's no :parser and there's no default parser for type ~
+            ~x1." x.name predicate)))
+
+(defprojection formallist->parsers (x world)
+  (formal->parser x world)
+  :guard (and (formallist-p x)
+              (plist-worldp world))
+  :result-type symbol-listp
+  :optimize nil)
+
+
+(define formal->merge ((x formal-p))
+  :parents (getopt)
+  :returns (merge-fn symbolp)
+  (b* (((formal x) x)
+       (merge (cdr (assoc :merge x.opts)))
+       ((unless (symbolp merge))
+        (raise "In ~x0, :merge is not even a symbol: ~x1." x.name merge)))
+    merge))
+
+(defprojection formallist->merges (x)
+  (formal->merge x)
+  :guard (formallist-p x)
+  :result-type symbol-listp
+  :optimize nil)
+
+
+(define formal->usage ((x formal-p))
+  :parents (getopt)
+  :returns (usage stringp)
+  (b* (((formal x) x))
+    (or (cdr (assoc :usage x.opts))
+        x.doc)))
+
+(define formal->argname ((x formal-p) (world plist-worldp))
+  :parents (getopt)
+  :returns (argname stringp)
+  (b* (((formal x) x)
+       (custom (assoc :argname x.opts))
+       ((when (stringp (cdr custom)))
+        (cdr custom))
+       ((when custom)
+        (raise "In ~x0, :argname is not even a stringp: ~x1."
+               x.name (cdr custom)))
+       (parser (formal->parser x world))
+       ((when (equal parser 'parse-plain))
+        ""))
+    "ARG"))
+
+(define formal->hiddenp ((x formal-p))
+  :parents (getopt)
+  :returns (longname stringp)
+  (b* (((formal x) x)
+       (hide (cdr (assoc :hide x.opts)))
+       ((when hide)
+        t))
+    nil))
+
+(define drop-hidden-options ((x formallist-p))
+  :returns (subset formallist-p)
+  (cond ((atom x)
+         nil)
+        ((formal->hiddenp (car x))
+         (drop-hidden-options (cdr x)))
+        (t
+         (cons (car x) (drop-hidden-options (cdr x))))))
+
+(define sanity-check-formals ((basename symbolp)
+                              (x        formallist-p)
+                              (world    plist-worldp))
+  :parents (getopt)
+  :short "Make sure longnames and aliases are unique, every field has a parser,
+and so forth.  This only applies to visible options."
+
+  (b* ((longnames (formallist->longnames x))
+       ((unless (uniquep longnames))
+        (raise "In ~x0, multiple fields have :longname ~&1."
+               basename (duplicated-members longnames)))
+
+       (aliases (remove nil (formallist->aliases x)))
+       ((unless (uniquep aliases))
+        (raise "In ~x0, multiple fields have :alias ~&1."
+               basename (duplicated-members aliases)))
+
+       ;; These are just doing the basic checks...
+       (?parsers (formallist->parsers x world))
+       (?merges  (formallist->merges x)))
+    t))
+
+(defun parser-name (basename)
+  (intern-in-package-of-symbol
+   (str::cat "PARSE-" (symbol-name basename))
+   basename))
+
+(defun parser-name-aux (basename)
+  (intern-in-package-of-symbol
+   (str::cat "PARSE-" (symbol-name basename) "-AUX")
+   basename))
+
+(defun parser-name-long (basename)
+  (intern-in-package-of-symbol
+   (str::cat "PARSE-" (symbol-name basename) "-LONG")
+   basename))
+
+(defun parser-name-bundle (basename)
+  (intern-in-package-of-symbol
+   (str::cat "PARSE-" (symbol-name basename) "-BUNDLE")
+   basename))
+
+(defun parser-name-short->long (basename)
+  (intern-in-package-of-symbol
+   (str::cat "PARSE-" (symbol-name basename) "-SHORT->LONG")
+   basename))
+
+(defun parser-name-short->long-list (basename)
+  (intern-in-package-of-symbol
+   (str::cat "PARSE-" (symbol-name basename) "-SHORT->LONG-LIST")
+   basename))
+
+(defun default-name (basename)
+  (intern-in-package-of-symbol
+   (str::cat "*DEFAULT-" (symbol-name basename) "*")
+   basename))
+
+
+
+(define make-parse-short->long ((basename symbolp)
+                                (formals  formallist-p))
+  (b* ((parse-foo              (parser-name basename))
+       (parse-short->long      (parser-name-short->long basename))
+       (parse-short->long-list (parser-name-short->long-list basename))
+       (alist                  (pairlis$ (formallist->aliases formals)
+                                         (formallist->longnames formals))))
+    `(progn
+       (define ,parse-short->long ((alias characterp))
+         :parents (,parse-foo)
+         :returns (mv errmsg?
+                      (longname stringp :rule-classes :type-prescription))
+         (b* ((look (assoc alias ',alist))
+              ((when look)
+               (mv nil (cdr look))))
+           (mv (msg "Unrecognized option -~s0." (implode (list alias)))
+               "")))
+
+       (define ,parse-short->long-list ((aliases character-listp))
+         :parents (,parse-foo)
+         :returns (mv (errmsg)
+                      (longnames string-listp))
+         (b* (((when (atom aliases))
+               (mv nil nil))
+              ((mv err longname) (,parse-short->long (car aliases)))
+              ((when err)
+               (mv err nil))
+              ((mv err rest) (,parse-short->long-list (cdr aliases))))
+           (mv err (cons longname rest)))
+         ///
+         (defthm ,(intern-in-package-of-symbol
+                   (cat "TRUE-LISTP-OF-" (symbol-name parse-short->long-list))
+                   parse-short->long-list)
+           (true-listp (mv-nth 1 (,parse-short->long-list aliases)))
+           :rule-classes :type-prescription)))))
+
+(define collect-plain-options ((x formallist-p) (world plist-worldp))
+  :returns (subset formallist-p)
+  (cond ((atom x)
+         nil)
+        ((equal (formal->parser (car x) world) 'parse-plain)
+         (cons (car x) (collect-plain-options (cdr x) world)))
+        (t
+         (collect-plain-options (cdr x) world))))
+
+(define make-parse-long-cases ((basename symbolp)
+                               (formals  formallist-p)
+                               (world    plist-worldp))
+  (b* (((when (atom formals))
+        nil)
+       (field    (formal->name (car formals)))
+       (longname (formal->longname (car formals)))
+       (parser   (formal->parser (car formals) world))
+       (merge    (formal->merge (car formals)))
+       (accessor (cutil::da-accessor-name basename field))
+       (changer  (cutil::da-changer-name basename))
+       (kwd      (intern$ (symbol-name field) "KEYWORD"))
+       (case1
+        `((equal longname ,longname)
+          (b* (;; If an option isn't mergeable, we don't allow it to be given
+               ;; multiple times.
+               ,@(and (not merge)
+                      '(((when (member-equal longname seen))
+                         (mv (msg "Option --~s0 given multiple times" longname)
+                             acc args))))
+
+               ((mv err value rest) (,parser (cat "--" longname) explicit-val args))
+               ((when err)
+                (mv err acc args))
+               ;; If an option is mergeable, we need to merge this new value
+               ;; into the old one.
+               ,@(and merge
+                      `((old-value (,accessor acc))
+                        (value     (,merge value old-value))))
+               ;; At this point everything should be good.
+               (acc (,changer acc ,kwd value)))
+            (mv nil acc rest)))))
+    (cons case1
+          (make-parse-long-cases basename (cdr formals) world))))
+
+(define make-parse-long ((basename symbolp)
+                         (formals  formallist-p)
+                         (world    plist-worldp))
+  (b* ((parse-foo  (parser-name basename))
+       (parse-long (parser-name-long basename))
+       (foop       (cutil::da-recognizer-name basename)))
+    `(define ,parse-long
+       :parents (,parse-foo)
+       ((longname stringp
+                  "Longname we've just found, e.g., \"foo\" if we've just
+                   seen @('--foo=bar').")
+        (explicit-val (or (not explicit-val)
+                          (stringp explicit-val))
+                      "Any explicit value passed to this option, e.g.,
+                       \"bar\" if we've just seen @('--foo=bar'), or NIL
+                       if we've just seen @('--foo').")
+        (args string-listp
+              "Remaining arguments <b>past longname</b>.")
+        (acc  ,foop
+              "Structure we're updating")
+        (seen string-listp
+              "List of longnames that we've seen so far."))
+       :returns
+       (mv (errmsg "NIL on success or an error message.")
+           (acc    ,foop
+                   :hyp (force (,foop acc))
+                   "Updated structure.")
+           (rest   string-listp :hyp (force (string-listp args))
+                   "Rest after this one."))
+       (cond ,@(make-parse-long-cases basename formals world)
+             (t
+              ;; No matching case for these formals
+              (mv (msg "Unrecognized option --~s0" longname)
+                  acc
+                  args)))
+       ///
+       (defthm ,(intern-in-package-of-symbol
+                 (cat (symbol-name parse-long) "-MAKES-PROGRESS")
+                 basename)
+         (<= (len (mv-nth 2 (,parse-long longname explicit-val args acc seen)))
+             (len args))
+         :rule-classes ((:rewrite) (:linear))))))
+
+(define make-parse-bundle ((basename symbolp))
+  (b* ((parse-foo    (parser-name basename))
+       (parse-long   (parser-name-long basename))
+       (parse-bundle (parser-name-bundle basename))
+       (foop         (cutil::da-recognizer-name basename)))
+    `(define ,parse-bundle
+       :parents (,parse-foo)
+       ((longnames string-listp "The already-expanded out names of the bundled
+                                 options, with no dashes.")
+        (args      string-listp "Remaining arguments <b>past longname</b>.")
+        (acc       ,foop        "Structure we're updating")
+        (seen      string-listp "List of longnames that we've seen so far."))
+       :returns
+       (mv (errmsg "NIL on success or an error message.")
+           (acc    ,foop :hyp (force (,foop acc)))
+           (seen   string-listp :hyp (and (force (string-listp longnames))
+                                          (force (string-listp seen))))
+           (rest   string-listp :hyp (force (string-listp args))))
+       (b* (((when (atom longnames))
+             (mv nil acc seen args))
+            ((mv err acc rest)
+             (,parse-long (car longnames) nil args acc seen))
+            ((when err)
+             (mv err acc seen rest))
+            (seen (cons (car longnames) seen)))
+         (,parse-bundle (cdr longnames) rest acc seen))
+       ///
+       (defthm ,(intern-in-package-of-symbol
+                 (cat (symbol-name parse-bundle) "-MAKES-PROGRESS")
+                 basename)
+         (<= (len (mv-nth 3 (,parse-bundle longnames args acc seen)))
+             (len args))
+         :rule-classes ((:rewrite) (:linear))))))
+
+(define make-parse-aux ((basename symbolp)
+                        (formals  formallist-p)
+                        (world    plist-worldp))
+  (b* ((parse-foo    (parser-name basename))
+       (parse-aux    (parser-name-aux basename))
+       (parse-long   (parser-name-long basename))
+       (parse-short->long      (parser-name-short->long basename))
+       (parse-short->long-list (parser-name-short->long-list basename))
+       (parse-bundle (parser-name-bundle basename))
+       (foop         (cutil::da-recognizer-name basename))
+       (plain        (collect-plain-options formals world))
+       (plain-longnames (formallist->longnames plain)))
+    `(define ,parse-aux
+       :parents (,parse-foo)
+       ((args    string-listp "Arguments we're processing")
+        (acc     ,foop        "Structure we're building.")
+        (seen    string-listp "List of longnames that we've seen so far.")
+        (skipped string-listp "Arguments we've skipped since they don't go with
+                               options, in reverse order."))
+       :returns (mv errmsg
+                    (result  ,foop :hyp (force (,foop acc)))
+                    (skipped string-listp
+                             :hyp (and (force (string-listp skipped))
+                                       (force (string-listp args)))))
+       :measure (len args)
+       (b* (((when (or (atom args)
+                       (equal (car args) "--")))
+             ;; Successfully processed all the arguments that belong to us.  We
+             ;; leave the -- in, so the programmer can choose to process it, if
+             ;; they want.
+             (mv nil acc (revappend skipped args)))
+
+            ((unless (str::strprefixp "-" (car args)))
+             ;; Not an option.  Skip it.
+             (,parse-aux (cdr args) acc seen (cons (car args) skipped)))
+
+            ((when (str::strprefixp "--" (car args)))
+             (b* (((mv longname explicit-value)
+                   (split-equals (subseq (car args) 2 nil)))
+                  ((mv err acc rest)
+                   (,parse-long longname explicit-value (cdr args) acc seen))
+                  ((when err)
+                   (mv err acc rest))
+                  (seen (cons longname seen)))
+               (,parse-aux rest acc seen skipped)))
+
+            ;; Else, just one leading dash.
+            ((mv shortnames explicit-value)
+             (split-equals (subseq (car args) 1 nil)))
+
+            (aliases (explode shortnames))
+            ((when (atom aliases))
+             ;; Very weird, either a stray dash or something like -= or -=blah.
+             ;; I guess we'll tolerate this but just treat it as a non-option
+             ;; by skipping it?
+             (,parse-aux (cdr args) acc seen (cons (car args) skipped)))
+
+            ((when (atom (cdr aliases)))
+             ;; A single alias.  This is easy, just try to translate it into a
+             ;; long option and handle it normally.
+             (b* ((alias (car aliases))
+                  ((mv err longname) (,parse-short->long alias))
+                  ((when err)
+                   (mv err acc args))
+                  ((mv err acc rest)
+                   (,parse-long longname explicit-value (cdr args) acc seen))
+                  ((when err)
+                   (mv err acc rest))
+                  (seen (cons longname seen)))
+               (,parse-aux rest acc seen skipped)))
+
+            ;; Else, an option bundle.  Try to translate them into longnames.
+            ((mv err longnames) (,parse-short->long-list aliases))
+            ((when err)
+             (mv err acc args))
+            ((when explicit-value)
+             (mv (msg "Option bundle ~s0 is not allowed (bundles can't have ~
+                       arguments)." (car args))
+                 acc args))
+
+            ;; We can only bundle options if they are plain, so check for that
+            ;; now.  The HIDE here is just to prevent case splits.
+            (illegal-to-bundle (set-difference-equal longnames ',plain-longnames))
+            ((when illegal-to-bundle)
+             (mv (msg "Option bundle ~s0 is not allowed (--~s1 needs an argument)"
+                      (car args)
+                      (car illegal-to-bundle))
+                 acc args))
+            ((mv err acc seen rest)
+             (,parse-bundle longnames (cdr args) acc seen))
+            ((when err)
+             (mv err acc rest)))
+         (,parse-aux rest acc seen skipped)))))
+
+(define make-parse ((basename symbolp))
+  (b* ((parse-foo   (parser-name basename))
+       (parse-aux   (parser-name-aux basename))
+       (default-foo (default-name basename))
+       (foop        (cutil::da-recognizer-name basename))
+       (foop-link (b* ((acc (str::revappend-chars "<see topic='" nil))
+                       (acc (xdoc::file-name-mangle foop acc))
+                       (acc (str::revappend-chars "'>" acc))
+                       (acc (xdoc::sym-mangle foop foop acc))
+                       (acc (str::revappend-chars "</see>" acc)))
+                    (str::rchars-to-string acc))))
+    `(define ,parse-foo
+       :parents (,foop)
+       :short ,(str::cat "Parse arguments from the command line into a "
+                         foop-link " aggregate.")
+       ((args string-listp "The command line arguments to parse, which is
+                            typically derived from @(see oslib::argv).")
+        &key
+        ((init ,foop ,(str::cat "An initial " foop-link " to start from, which
+                                 gives the default values for each field."))
+         ',default-foo))
+       :returns
+       (mv (errmsg "NIL on success, or an error message produced by @(see msg),
+                    suitable for printing the @(see fmt) directive @('~@').")
+           (result ,foop
+                   :hyp (force (,foop init))
+                   "An updated version of @('init') where the command-line
+                    arguments have been applied.  On any error, this may be
+                    only partially updated.")
+           (extra  string-listp
+                   :hyp (force (string-listp args))
+                   "Any other arguments in @('args') that were not recognized
+                    as options.  Typically this might include the \"main\"
+                    arguments to a program, e.g., file names, etc., that aren't
+                    associated with --options."))
+       :long "<p>This is an ordinary command line parser, automatically
+              produced by @(see getopt).</p>"
+       (,parse-aux args init nil nil))))
+
+(defsection defoption-lemmas
+  (logic)
+
+  (defthm defoptions-lemma-1
+    (equal (string-listp (append x y))
+           (and (string-listp (list-fix x))
+                (string-listp y))))
+
+  (defthm defoptions-lemma-2
+    (equal (string-listp (acl2::rev x))
+           (string-listp (list-fix x)))
+    :hints(("Goal" :induct (len x))))
+
+  (defthm defoptions-lemma-3
+    (implies (string-listp x)
+             (string-listp (list-fix x))))
+
+  (defthm defoptions-lemma-4
+    (implies (str::strprefixp "--" x)
+             (<= 2 (len (explode x))))
+    :rule-classes ((:rewrite) (:linear)))
+
+  (defthm defoptions-lemma-5
+    (implies (character-listp x)
+             (equal (characterp (car x))
+                    (consp x))))
+
+  (defthm defoptions-lemma-6
+    (implies (character-listp x)
+             (equal (characterp (second x))
+                    (consp (cdr x)))))
+
+  (defthm defoptions-lemma-7
+    (implies (character-listp x)
+             (character-listp (cdr x))))
+
+  (defthm defoptions-lemma-8
+    (implies (str::strprefixp "-" x)
+             (<= 1 (len (explode x))))
+    :rule-classes ((:rewrite) (:linear)))
+
+  (def-ruleset defoptions-lemmas
+    '(defoptions-lemma-1
+      defoptions-lemma-2
+      defoptions-lemma-3
+      defoptions-lemma-4
+      defoptions-lemma-5
+      defoptions-lemma-6
+      defoptions-lemma-7
+      acl2::revappend-removal
+      acl2::append-to-nil
+      acl2::list-fix-when-true-listp
+      str::stringp-of-subseq))
+
+  (in-theory (disable* defoptions-lemmas)))
+
+
+
+(defconst *ind-col* 26)
+(defconst *wrap-col* 72)
+
+(define usage-message-part ((title  stringp)
+                            (detail stringp)
+                            (acc    character-listp))
+  :returns (new-acc character-listp)
+  (b* ((title (cat "    " title))
+       (acc   (str::revappend-chars title acc))
+       (acc
+        (if (> (length title) (- *ind-col* 3))
+            ;; Title is really long.  Give it its own line.
+            (b* ((acc (cons #\Newline acc)))
+              (make-list-ac *ind-col* #\Space acc))
+          ;; Title fits nicely, space out to *ind-col*.
+          (make-list-ac (- *ind-col* (length title))
+                        #\Space acc)))
+       (x   (xdoc::normalize-whitespace detail))
+       (acc (xdoc::word-wrap-paragraph-aux x 0 (length x)
+                                           *ind-col*
+                                           *wrap-col*
+                                           *ind-col*
+                                           acc))
+       (acc (xdoc::remove-spaces-from-front acc))
+       (acc (cons #\Newline acc)))
+    acc))
+
+#||
+(str::rchars-to-string
+ (usage-message-part "-o,--output=FILE"
+                     "Lorem ipsum blah blah.  This message has random newlines
+                      in it, like something you might write in the middle of an
+                      aggregate's documentation, etc."  nil))
+
+(str::rchars-to-string
+ (usage-message-part "--a-really-long-option=FILE"
+                     "Lorem ipsum blah blah.  This message has random newlines
+                      in it, like something you might write in the middle of an
+                      aggregate's documentation, etc."
+                     nil))
+||#
+
+(define make-usage-aux ((x     formal-p)
+                        (world plist-worldp)
+                        (acc   character-listp))
+  (b* ((longname (formal->longname x))      ; e.g., "outfile"
+       (alias    (formal->alias x))         ; e.g., #\o
+       (argname  (formal->argname x world)) ; e.g., "FILE"
+       (usage    (formal->usage x))         ; e.g., "where to write ..."
+
+       (title (str::cat
+               (if alias (implode (list #\- alias #\,)) "")
+               "--"
+               longname
+               (if (equal argname "") "" "=")
+               argname)))
+    (usage-message-part title usage acc)))
+
+(define make-usage-loop ((x     formallist-p)
+                         (world plist-worldp)
+                         (acc   character-listp))
+  (if (atom x)
+      acc
+    (let ((acc (make-usage-aux (car x) world acc)))
+      (make-usage-loop (cdr x) world acc))))
+
+(define make-usage ((x     formallist-p)
+                    (world plist-worldp))
+  (str::rchars-to-string (make-usage-loop x world nil)))
+
+
+
+(define defoptions-fn ((info  cutil::agginfo-p)
+                       (world plist-worldp))
+  (b* (((cutil::agginfo info) info)
+       (visible      (drop-hidden-options info.efields))
+       (- (sanity-check-formals info.name visible world))
+       (foop         (cutil::da-recognizer-name info.name))
+       (usage-const  (intern-in-package-of-symbol
+                      (cat "*" (symbol-name info.name) "-USAGE*")
+                      info.name))
+       (usage-msg    (make-usage visible world))
+       (usage-html   (b* ((acc (str::revappend-chars "<code>" nil))
+                          (acc (xdoc::simple-html-encode-chars
+                                (explode usage-msg) acc))
+                          (acc (str::revappend-chars "</code>" acc)))
+                       (str::rchars-to-string acc)))
+       (events
+        `(progn
+           (local (in-theory (e/d* (defoptions-lemmas)
+                                   (str::strprefixp
+                                    set-difference-equal))))
+
+           ,(make-parse-long info.name visible world)
+           ,(make-parse-short->long info.name visible)
+           ,(make-parse-bundle info.name)
+           ,(make-parse-aux info.name visible world)
+           ,(make-parse info.name)
+           (defsection ,usage-const
+             :parents (,foop)
+             :short "Automatically generated usage message."
+             :long ,usage-html
+             (defconst ,usage-const ',usage-msg))
+           (value-triple '(defoptions ,info.name)))))
+    events))
+
+(defmacro defoptions (name &rest args)
+  (let ((default-foo (default-name name)))
+    `(progn
+       (defaggregate ,name
+         :extra-field-keywords ,*extra-fields-for-defoptions*
+         . ,args)
+       (defconst ,default-foo (,(cutil::da-maker-name name)))
+       (make-event
+        (b* ((world   (w state))
+             (agginfo (cutil::get-aggregate ',name world)))
+          (value
+           (defoptions-fn agginfo world)))))))
+
+
+
+
diff -Nru acl2-6.2/books/centaur/gl/acl2-customization.lsp acl2-6.3/books/centaur/gl/acl2-customization.lsp
--- acl2-6.2/books/centaur/gl/acl2-customization.lsp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/acl2-customization.lsp	2013-09-30 17:53:14.000000000 +0000
@@ -1,5 +1,25 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (ld "package.lsp")
 (set-gag-mode :goals)
 (set-inhibit-warnings "theory")
+(ld "~/acl2-customization.lsp" :ld-missing-input-ok t)
 (in-package "GL")
diff -Nru acl2-6.2/books/centaur/gl/always-equal-prep.lisp acl2-6.3/books/centaur/gl/always-equal-prep.lisp
--- acl2-6.2/books/centaur/gl/always-equal-prep.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/always-equal-prep.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,15 +1,32 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
 (include-book "symbolic-arithmetic-fns")
-(local (include-book "hyp-fix-logic"))
 (include-book "g-if")
-(local (include-book "eval-g-base-help"))
 (include-book "eval-g-base")
-
-
+(local (include-book "hyp-fix-logic"))
+(local (include-book "eval-g-base-help"))
+(local (include-book "clause-processors/find-subterms" :dir :system))
+(local (include-book "clause-processors/just-expand" :dir :system))
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
 
 ;; This introduces a symbolic counterpart function for EQUAL (more
 ;; specifically, for ALWAYS-EQUAL, which is defined as EQUAL) that takes a
@@ -33,484 +50,458 @@
   (declare (Xargs :guard t))
   (equal x y))
 
-;; X and Y should be unequal BDDs.  This produces a BDD with one path to a T,
-;; with the guarantee that X and Y are unequal on that path.
+;; X and Y should be unequal BDDs.  This produces an environment under which x
+;; and y evaluate to opposite values.
 (defun ctrex-for-always-equal (x y)
   (declare (xargs :guard t :measure (+ (acl2-count x) (acl2-count y))))
   (if (and (atom x) (atom y))
-      t
+      nil
     (b* (((mv xa xd) (if (consp x) (mv (car x) (cdr x)) (mv x x)))
          ((mv ya yd) (if (consp y) (mv (car y) (cdr y)) (mv y y))))
       (if (hqual xa ya)
           (cons nil (ctrex-for-always-equal xd yd))
-        (cons (ctrex-for-always-equal xa ya) nil)))))
+        (cons t (ctrex-for-always-equal xa ya))))))
 
-(local
- (progn
-   (defun ctrex-for-always-equal-ind (x y env)
-     (declare (xargs :measure (+ (acl2-count x) (acl2-count y))))
-     (if (and (atom x) (atom y))
-         env
-       (b* (((mv xa xd) (if (consp x) (mv (car x) (cdr x)) (mv x x)))
-            ((mv ya yd) (if (consp y) (mv (car y) (cdr y)) (mv y y))))
-         (if (hqual xa ya)
-             (cons nil (ctrex-for-always-equal-ind xd yd (cdr env)))
-           (cons (ctrex-for-always-equal-ind xa ya (cdr env)) nil)))))
-
-   (defthmd ctrex-for-always-equal-correct
-     (implies (and (acl2::ubddp x) (acl2::ubddp y) (not (equal x y))
-                   (acl2::eval-bdd (ctrex-for-always-equal x y) env))
-              (not (equal (acl2::eval-bdd x env) (acl2::eval-bdd y env))))
-     :hints (("goal" :induct (ctrex-for-always-equal-ind x y env)
-              :in-theory (enable acl2::eval-bdd acl2::ubddp))))
-
-   (defthm ctrex-for-always-equal-correct2
-     (implies (and (acl2::ubddp x) (acl2::ubddp y) (not (equal x y))
-                   (equal (acl2::eval-bdd x env) (acl2::eval-bdd y env)))
-              (not (acl2::eval-bdd (ctrex-for-always-equal x y) env)))
-     :hints(("Goal" :in-theory (enable ctrex-for-always-equal-correct))))
-      
-   (defthm acl2::ubddp-ctrex-for-always-equal
-     (acl2::ubddp (ctrex-for-always-equal a b))
-     :hints(("Goal" :in-theory (enable acl2::ubddp))))))
 
+(defthmd ctrex-for-always-equal-correct
+  (implies (and (acl2::ubddp x) (acl2::ubddp y) (not (equal x y)))
+           (equal (acl2::eval-bdd x (ctrex-for-always-equal x y))
+                  (not (acl2::eval-bdd y (ctrex-for-always-equal x y)))))
+  :hints (("goal" :induct (ctrex-for-always-equal x y)
+           :in-theory (enable acl2::ubddp acl2::eval-bdd))))
 
 
-
-;; This produces either: a BDD with one path to a T, with the guarantee that X
-;; and Y are unequal on that path and that the hyp holds on that path; or NIL,
-;; meaning X and Y are equal everywhere the hyp holds.
+;; This produces an environment under which x and y differ and hyp is true, if
+;; one exists.  The first return value is a flag saying whether we succeeded or not.
 
 ;; This is used as a helper function for the top-level
 ;; ctrex-for-always-equal-under-hyp, but it is actually complete; the top-level
 ;; function just tries to find an easier answer first.
 (defun ctrex-for-always-equal-under-hyp1 (x y hyp)
   (declare (xargs :guard t))
-  (cond ((hqual x y) nil)
-        ((eq hyp nil) nil)
-        ((atom hyp) (ctrex-for-always-equal x y))
+  (cond ((hqual x y) (mv nil nil))
+        ((eq hyp nil) (mv nil nil))
+        ((atom hyp) (mv (not (hqual x y))
+                        (ctrex-for-always-equal x y)))
         ((and (atom x) (atom y))
-         (ctrex-for-always-equal hyp nil))
+         (mv (not (eq hyp nil))
+             (ctrex-for-always-equal hyp nil)))
         ((eq (cdr hyp) nil)
-         (let ((res
-                (ctrex-for-always-equal-under-hyp1
-                 (if (consp x) (car x) x)
-                 (if (consp y) (car y) y)
-                 (car hyp))))
-           (and res (cons res nil))))
+         (mv-let (ok env)
+           (ctrex-for-always-equal-under-hyp1
+            (if (consp x) (car x) x)
+            (if (consp y) (car y) y)
+            (car hyp))
+           (mv ok (cons t env))))
         ((eq (car hyp) nil)
-         (let ((res (ctrex-for-always-equal-under-hyp1
-                     (if (consp x) (cdr x) x)
-                     (if (consp y) (cdr y) y)
-                     (cdr hyp))))
-           (and res (cons nil res))))
+         (mv-let (ok env)
+           (ctrex-for-always-equal-under-hyp1
+            (if (consp x) (cdr x) x)
+            (if (consp y) (cdr y) y)
+            (cdr hyp))
+           (mv ok (cons nil env))))
         (t (let ((x1 (acl2::q-and hyp x))
                  (y1 (acl2::q-and hyp y)))
-             (if (hqual x1 y1)
-                 nil
-               (ctrex-for-always-equal x1 y1))))))
-
-(local
- (defthm ctrex-for-always-equal-under-hyp1-ubddp
-   (implies (and (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp))
-            (acl2::ubddp (ctrex-for-always-equal-under-hyp1 x y hyp)))
-   :hints(("Goal" :in-theory (enable acl2::ubddp)
-           :induct (ctrex-for-always-equal-under-hyp1 x y hyp)))))
-
-
-
-
-
-
+             (mv (not (hqual x1 y1))
+                 (ctrex-for-always-equal x1 y1))))))
 
-(local
- (progn
-
-
-   (defun ctrex-for-always-equal-under-hyp-ind (x y hyp env)
-     (cond ((hqual x y) env)
-           ((eq hyp nil) env)
-           ((atom hyp) env)
-           (t (if (car env)
-                  (ctrex-for-always-equal-under-hyp-ind
-                   (if (consp x) (car x) x)
-                   (if (consp y) (car y) y)
-                   (car hyp) (cdr env))
-                (ctrex-for-always-equal-under-hyp-ind
-                 (if (consp x) (cdr x) x)
-                 (if (consp y) (cdr y) y)
-                 (cdr hyp) (cdr env))))))
-
-   (defthm ctrex-for-always-equal-under-hyp1-correct1
-     (implies (and (not (and (acl2::eval-bdd hyp env)
-                             (not (equal (acl2::eval-bdd x env) (acl2::eval-bdd y env)))))
-                   (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp))
-              (not (acl2::eval-bdd (ctrex-for-always-equal-under-hyp1 x y hyp) env)))
-     :hints(("Goal" :in-theory (e/d* (acl2::ubddp)
-                                     (ctrex-for-always-equal-under-hyp1
-                                      acl2::eval-bdd-when-qs-subset
-                                      ctrex-for-always-equal
-                                      acl2::eval-bdd-when-not-consp
-                                      acl2::eval-bdd-of-non-consp-cheap
-                                      acl2::ubddp-compound-recognizer
-                                      (:rules-of-class :type-prescription :here)
-;                                      acl2::eval-bdd-booleanp
-                                      equal-of-booleans-rewrite)
-                                     ((:type-prescription acl2::eval-bdd)))
-             :induct (ctrex-for-always-equal-under-hyp-ind x y hyp env)
-             :expand
-             ((:free (x y) (ctrex-for-always-equal-under-hyp1 x y hyp))
-              (:free (x y) (ctrex-for-always-equal-under-hyp1 x y t))
-              (:free (x y) (ctrex-for-always-equal-under-hyp1 x y nil))
-              (:free (x y env) (acl2::eval-bdd (cons x y) env))
-              (:free (env) (acl2::eval-bdd x env))
-              (:free (env) (acl2::eval-bdd y env))))))
-
-   (defthm hyp-eval-lemma
-     (implies (and (syntaxp (eq hyp 'hyp)) (consp hyp))
-              (and (implies (and (not (car env))
-                                 (not (acl2::eval-bdd (cdr hyp) (cdr env))))
-                            (not (acl2::eval-bdd hyp env)))
-                   (implies (and (car env)
-                                 (not (acl2::eval-bdd (car hyp) (cdr env))))
-                            (not (acl2::eval-bdd hyp env)))))
-     :hints(("Goal" :in-theory (enable acl2::eval-bdd))))
-
-
-   (defthm ctrex-for-always-equal-under-hyp1-correct2
-     (implies (and (bind-free '((env . (cdr env))) (env))
-                   (not (equal (acl2::eval-bdd x env) (acl2::eval-bdd y env)))
-                   (acl2::eval-bdd hyp env)
-                   (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp))
-              (ctrex-for-always-equal-under-hyp1 x y hyp))
-     :hints(("Goal" :in-theory (e/d* (acl2::ubddp)
-                                     (ctrex-for-always-equal-under-hyp1
-                                      acl2::eval-bdd-when-qs-subset
-                                      ctrex-for-always-equal
-                                      acl2::eval-bdd-when-not-consp
-                                      ; acl2::eval-bdd-of-non-consp-cheap
-                                      equal-of-booleans-rewrite
-                                      (:rules-of-class :type-prescription :here))
-                                     ((:type-prescription acl2::eval-bdd)
-                                      (:type-prescription ctrex-for-always-equal)))
-             :induct (ctrex-for-always-equal-under-hyp-ind x y hyp env)
-             :do-not-induct t
-             :expand
-             ((:free (x y) (ctrex-for-always-equal-under-hyp1 x y hyp))
-              (:free (x y) (ctrex-for-always-equal-under-hyp1 x y t))
-              (:free (x y) (ctrex-for-always-equal-under-hyp1 x y nil))))
+(defun ctrex-for-always-equal-under-hyp1-ind (x y hyp env)
+  (cond ((hqual x y) env)
+        ((eq hyp nil) env)
+        ((atom hyp) env)
+        ((and (atom x) (atom y))
+         env)
+        ((eq (cdr hyp) nil)
+         (ctrex-for-always-equal-under-hyp1-ind
+          (if (consp x) (car x) x)
+          (if (consp y) (car y) y)
+          (car hyp)
+          (cdr env)))
+        ((eq (car hyp) nil)
+         (ctrex-for-always-equal-under-hyp1-ind
+          (if (consp x) (cdr x) x)
+          (if (consp y) (cdr y) y)
+          (cdr hyp)
+          (cdr env)))
+        (t env)))
+
+(local (in-theory (disable ctrex-for-always-equal-under-hyp1
+                           ctrex-for-always-equal
+                           acl2::qs-subset-when-booleans
+                           acl2::eval-bdd-when-qs-subset
+                           equal-of-booleans-rewrite)))
+
+(defthm ctrex-for-always-equal-under-hyp1-correct
+  (implies (and (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp)
+                  (not (equal (acl2::eval-bdd x env)
+                              (acl2::eval-bdd y env)))
+                  (acl2::eval-bdd hyp env))
+             (let ((env (mv-nth 1 (ctrex-for-always-equal-under-hyp1 x y hyp))))
+               (and (not (equal (acl2::eval-bdd x env)
+                                (acl2::eval-bdd y env)))
+                    (acl2::eval-bdd hyp env))))
+    :hints ((acl2::just-induct-and-expand
+             (ctrex-for-always-equal-under-hyp1-ind x y hyp env)
+             :expand-others ((ctrex-for-always-equal-under-hyp1 x y hyp)))
             (and stable-under-simplificationp
-                 '(:clause-processor
-                   (acl2::eval-bdd-cp 
-                    clause (list '(x y hyp)
-                                 (let ((world (w state))) (acl2::bdd-patterns))
-                                 ;; '(env)
-                                 t))))
+                 (let ((call (acl2::find-call-lst 'ctrex-for-always-equal
+                                                  clause)))
+                   (and call
+                        `(:use ((:instance ctrex-for-always-equal-correct
+                                 (x ,(second call)) (y ,(third call))))
+                          :in-theory (disable
+                                      ctrex-for-always-equal-correct)))))
+            (and (equal (car clause)
+                        '(not (equal (acl2::q-binary-and hyp x)
+                                     (acl2::q-binary-and hyp y))))
+                 (acl2::bdd-reasoning))
             (and stable-under-simplificationp
-                 '(:expand ((acl2::eval-bdd x env)
-                            (acl2::eval-bdd y env))))))))
-
-
-
-
-
-(in-theory (Disable ctrex-for-always-equal-under-hyp1))
-
+                 '(;; :in-theory (e/d (acl2::eval-bdd acl2::ubddp)
+                   ;;                 (ctrex-for-always-equal-correct))
+                   :expand ((:free (x a b)
+                             (acl2::eval-bdd x (cons a b)))
+                            (acl2::eval-bdd x env)
+                            (acl2::eval-bdd x nil)
+                            (acl2::eval-bdd y env)
+                            (acl2::eval-bdd y nil)
+                            (acl2::eval-bdd hyp env)
+                            (acl2::eval-bdd hyp nil))))))
+
+(defthm ctrex-for-always-equal-under-hyp1-flag-correct
+  (implies (and (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp))
+           (iff (mv-nth 0 (ctrex-for-always-equal-under-hyp1 x y hyp))
+                (let ((env (mv-nth 1 (ctrex-for-always-equal-under-hyp1 x y hyp))))
+                  (and (not (equal (acl2::eval-bdd x env)
+                                   (acl2::eval-bdd y env)))
+                       (acl2::eval-bdd hyp env)))))
+    :hints ((acl2::just-induct-and-expand
+             (ctrex-for-always-equal-under-hyp1-ind x y hyp env)
+             :expand-others ((ctrex-for-always-equal-under-hyp1 x y hyp)))
+            (and stable-under-simplificationp
+                 (let ((call (acl2::find-call-lst 'ctrex-for-always-equal
+                                                  clause)))
+                   (and call
+                        `(:use ((:instance ctrex-for-always-equal-correct
+                                 (x ,(second call)) (y ,(third call))))
+                          :in-theory (disable
+                                      ctrex-for-always-equal-correct)))))
+            (and stable-under-simplificationp
+                 (member-equal '(not (equal (acl2::q-binary-and hyp x)
+                                            (acl2::q-binary-and hyp y)))
+                               clause)
+                 (acl2::bdd-reasoning))
+            (and stable-under-simplificationp
+                 '(;; :in-theory (e/d (acl2::eval-bdd acl2::ubddp)
+                   ;;                 (ctrex-for-always-equal-correct))
+                   :expand ((:free (x a b)
+                             (acl2::eval-bdd x (cons a b))))))))
 
 
 (defun ctrex-for-always-equal-under-hyp (x y hyp)
   (declare (xargs :guard t :measure (acl2-count hyp)))
-  (cond ((hqual x y) nil)
-        ((eq hyp nil) nil)
-        ((atom hyp) (ctrex-for-always-equal x y))
+  (cond ((hqual x y) (mv nil nil))
+        ((eq hyp nil) (mv nil nil))
+        ((atom hyp) (mv (not (hqual x y))
+                        (ctrex-for-always-equal x y)))
         ((eq (cdr hyp) nil)
-         (let ((res (ctrex-for-always-equal-under-hyp
-                     (if (consp x) (car x) x)
-                     (if (consp y) (car y) y)
-                     (car hyp))))
-           (and res (cons res nil))))
+         (mv-let (ok env)
+           (ctrex-for-always-equal-under-hyp
+            (if (consp x) (car x) x)
+            (if (consp y) (car y) y)
+            (car hyp))
+           (mv ok (cons t env))))
         ((eq (car hyp) nil)
-         (let ((res (ctrex-for-always-equal-under-hyp
-                     (if (consp x) (cdr x) x)
-                     (if (consp y) (cdr y) y)
-                     (cdr hyp))))
-           (and res (cons nil res))))
+         (mv-let (ok env)
+           (ctrex-for-always-equal-under-hyp
+            (if (consp x) (cdr x) x)
+            (if (consp y) (cdr y) y)
+            (cdr hyp))
+           (mv ok (cons nil env))))
         ;; The bad case here is when x and y are equal wherever the hyp holds
-        ;; and unequal everywhere else. 
+        ;; and unequal everywhere else.
         ;; Possible ways to deal with this: Q-AND the hyp with each arg and
-        ;; compare equality, or else recur on the car and then the cdr.  
+        ;; compare equality, or else recur on the car and then the cdr.
         ;; We take a hybrid approch: recur down the car in hopes of finding an
         ;; easy counterexample, then at each level, use the Q-AND approch on
         ;; the cdr.
-        (t (let ((car-result (ctrex-for-always-equal-under-hyp
-                              (if (consp x) (car x) x)
-                              (if (consp y) (car y) y)
-                              (car hyp))))
-             (if car-result
-                 (cons car-result nil)
-               (let ((cdr-result (ctrex-for-always-equal-under-hyp1
-                                  (if (consp x) (cdr x) x)
-                                  (if (consp y) (cdr y) y)
-                                  (cdr hyp))))
-                 (and cdr-result
-                      (cons nil cdr-result))))))))
-
-(local (defthm ctrex-for-always-equal-under-hyp-ubddp
-         (implies (and (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp))
-                  (acl2::ubddp (ctrex-for-always-equal-under-hyp x y hyp)))
-         :hints(("Goal" :in-theory (enable acl2::ubddp)))))
-
-;; (local (defthm ctrex-for-always-equal-under-hyp-bfr-p
-;;          (implies (and (not (bfr-mode))
-;;                        (bfr-p x) (bfr-p y) (bfr-p hyp))
-;;                   (bfr-p (ctrex-for-always-equal-under-hyp x y hyp)))
-;;          :hints(("Goal" :use ctrex-for-always-equal-under-hyp-ubddp
-;;                  :in-theory (e/d (bfr-p booleanp)
-;;                                  (ctrex-for-always-equal-under-hyp-ubddp))))))
-
-
-(local
- (defthm ctrex-for-always-equal-under-hyp-correct1
-   (implies (and (acl2::eval-bdd (ctrex-for-always-equal-under-hyp x y hyp) env)
-                 (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp))
-            (and (acl2::eval-bdd hyp env)
-                 (equal (acl2::eval-bdd x env)
-                        (not (acl2::eval-bdd y env)))))
-   :hints(("Goal" :in-theory (e/d* (acl2::ubddp)
-                                   (ctrex-for-always-equal-under-hyp
-                                    acl2::eval-bdd-when-qs-subset
-                                    equal-of-booleans-rewrite
-                                    ctrex-for-always-equal
-                                    acl2::eval-bdd-when-not-consp
-                                    (:rules-of-class :type-prescription :here))
-                                   ((:type-prescription acl2::eval-bdd)))
-           :induct (ctrex-for-always-equal-under-hyp-ind x y hyp env)
-           :expand
-             ((:free (x y) (ctrex-for-always-equal-under-hyp x y hyp))
-              (:free (x y) (ctrex-for-always-equal-under-hyp x y t))
-              (:free (x y) (ctrex-for-always-equal-under-hyp x y nil))
-              (:free (x y env) (acl2::eval-bdd (cons x y) env))
-              (:free (env) (acl2::eval-bdd x env))
-              (:free (env) (acl2::eval-bdd y env))
-              (:free (env) (acl2::eval-bdd hyp env)))))))
-
-(local
- (defthm ctrex-for-always-equal-under-hyp-correct2
-   (implies (and (not (equal (acl2::eval-bdd x env) (acl2::eval-bdd y env)))
-                 (acl2::eval-bdd hyp env)
-                 (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp))
-            (ctrex-for-always-equal-under-hyp x y hyp))
-   :hints(("Goal" :in-theory (e/d* (acl2::ubddp)
-                                   (ctrex-for-always-equal-under-hyp
-                                    ;ctrex-for-always-equal-under-hyp1-correct2
-                                    ctrex-for-always-equal-under-hyp-correct1
-                                    acl2::eval-bdd-when-qs-subset
-                                    ctrex-for-always-equal
-                                    acl2::eval-bdd-when-not-consp
-                                    ; acl2::eval-bdd-of-non-consp-cheap
-                                    equal-of-booleans-rewrite
-                                    (:rules-of-class :type-prescription :here))
-                                   ((:type-prescription acl2::eval-bdd)
-                                    (:type-prescription ctrex-for-always-equal)))
-           :induct (ctrex-for-always-equal-under-hyp-ind x y hyp env)
-           :do-not-induct t
-           :expand
-           ((:free (x y) (ctrex-for-always-equal-under-hyp x y hyp))
-            (:free (x y) (ctrex-for-always-equal-under-hyp x y t))
-            (:free (x y) (ctrex-for-always-equal-under-hyp x y nil))))
+        (t (b* (((mv ok env)
+                 (ctrex-for-always-equal-under-hyp
+                  (if (consp x) (car x) x)
+                  (if (consp y) (car y) y)
+                  (car hyp)))
+                ((when ok) (mv t (cons t env)))
+                ((mv ok env)
+                 (ctrex-for-always-equal-under-hyp1
+                  (if (consp x) (cdr x) x)
+                  (if (consp y) (cdr y) y)
+                  (cdr hyp))))
+             (mv ok (cons nil env))))))
+
+(defun ctrex-for-always-equal-under-hyp-ind (x y hyp env)
+  (declare (xargs :measure (acl2-count hyp)))
+  (cond ((hqual x y) env)
+        ((eq hyp nil) env)
+        ((atom hyp) env)
+        ((eq (cdr hyp) nil)
+         (ctrex-for-always-equal-under-hyp-ind
+            (if (consp x) (car x) x)
+            (if (consp y) (car y) y)
+            (car hyp)
+            (cdr env)))
+        ((eq (car hyp) nil)
+         (ctrex-for-always-equal-under-hyp-ind
+            (if (consp x) (cdr x) x)
+            (if (consp y) (cdr y) y)
+            (cdr hyp)
+            (cdr env)))
+        ;; The bad case here is when x and y are equal wherever the hyp holds
+        ;; and unequal everywhere else.
+        ;; Possible ways to deal with this: Q-AND the hyp with each arg and
+        ;; compare equality, or else recur on the car and then the cdr.
+        ;; We take a hybrid approch: recur down the car in hopes of finding an
+        ;; easy counterexample, then at each level, use the Q-AND approch on
+        ;; the cdr.
+        (t (ctrex-for-always-equal-under-hyp-ind
+            (if (consp x) (car x) x)
+            (if (consp y) (car y) y)
+            (car hyp) (cdr env)))))
+
+
+(local (in-theory (disable ctrex-for-always-equal-under-hyp
+                           sets::double-containment)))
+
+(defthm ctrex-for-always-equal-under-hyp-flag-correct
+  (implies (and (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp))
+           (iff (mv-nth 0 (ctrex-for-always-equal-under-hyp x y hyp))
+                (let ((env (mv-nth 1 (ctrex-for-always-equal-under-hyp x y hyp))))
+                  (and (not (equal (acl2::eval-bdd x env)
+                                   (acl2::eval-bdd y env)))
+                       (acl2::eval-bdd hyp env)))))
+  :hints ((acl2::just-induct-and-expand
+           (ctrex-for-always-equal-under-hyp-ind x y hyp env)
+           :expand-others ((ctrex-for-always-equal-under-hyp x y hyp)))
           (and stable-under-simplificationp
-               '(:clause-processor
-                 (acl2::eval-bdd-cp 
-                  clause (list '(x y hyp)
-                               (let ((world (w state))) (acl2::bdd-patterns))
-                               ;; '(env)
-                               t))))
+               (b* ((call (acl2::find-call-lst 'ctrex-for-always-equal
+                                               clause))
+                    ((when call)
+                     `(:use ((:instance ctrex-for-always-equal-correct
+                              (x ,(second call)) (y ,(third call))))
+                       :in-theory (disable
+                                   ctrex-for-always-equal-correct))))
+                 nil))
+          ;; (and (equal (car clause)
+          ;;             '(not (equal (acl2::q-binary-and hyp x)
+          ;;                          (acl2::q-binary-and hyp y))))
+          ;;      (acl2::bdd-reasoning))
           (and stable-under-simplificationp
-               '(:expand ((acl2::eval-bdd x env)
+               '(;; :in-theory (e/d (acl2::eval-bdd acl2::ubddp)
+                 ;;                 (ctrex-for-always-equal-correct))
+                 :expand ((:free (x a b)
+                           (acl2::eval-bdd x (cons a b)))
+                          (acl2::eval-bdd x env)
+                          (acl2::eval-bdd x nil)
                           (acl2::eval-bdd y env)
+                          (acl2::eval-bdd y nil)
                           (acl2::eval-bdd hyp env)
-                          (acl2::eval-bdd hyp nil)))))))
-
+                          (acl2::eval-bdd hyp nil))))))
 
-
-;; (local
-;;  (defthm ctrex-for-always-equal-under-hyp-correct1-bfr
-;;    (implies (and (not (bfr-mode))
-;;                  (bfr-eval (ctrex-for-always-equal-under-hyp x y hyp) env)
-;;                  (bfr-p x) (bfr-p y) (bfr-p hyp))
-;;             (and (bfr-eval hyp env)
-;;                  (equal (bfr-eval x env)
-;;                         (not (bfr-eval y env)))))
-;;    :hints(("goal" :in-theory
-;;            (e/d* (bfr-p bfr-eval booleanp)
-;;                  (ctrex-for-always-equal-under-hyp-correct1))
-;;            :use ctrex-for-always-equal-under-hyp-correct1))))
-
-;; (local
-;;  (defthm ctrex-for-always-equal-under-hyp-correct2-bfr
-;;    (implies (and (not (bfr-mode))
-;;                  (not (equal (bfr-eval x env) (bfr-eval y env)))
-;;                  (bfr-eval hyp env)
-;;                  (bfr-p x) (bfr-p y) (bfr-p hyp))
-;;             (ctrex-for-always-equal-under-hyp x y hyp))
-;;    :hints(("goal" :in-theory
-;;            (e/d* (bfr-p bfr-eval booleanp)
-;;                  (ctrex-for-always-equal-under-hyp-correct2))
-;;            :use ctrex-for-always-equal-under-hyp-correct2))))
+(defthm ctrex-for-always-equal-under-hyp-correct
+  (implies (and (acl2::ubddp x) (acl2::ubddp y) (acl2::ubddp hyp)
+                (not (equal (acl2::eval-bdd x env)
+                            (acl2::eval-bdd y env)))
+                (acl2::eval-bdd hyp env))
+           (let ((env (mv-nth 1 (ctrex-for-always-equal-under-hyp x y hyp))))
+             (and (not (equal (acl2::eval-bdd x env)
+                              (acl2::eval-bdd y env)))
+                  (acl2::eval-bdd hyp env))))
+  :hints ((acl2::just-induct-and-expand
+           (ctrex-for-always-equal-under-hyp-ind x y hyp env)
+           :expand-others ((ctrex-for-always-equal-under-hyp x y hyp)))
+          (and stable-under-simplificationp
+               (b* ((call (acl2::find-call-lst 'ctrex-for-always-equal
+                                               clause))
+                    ((when call)
+                     `(:use ((:instance ctrex-for-always-equal-correct
+                              (x ,(second call)) (y ,(third call))))
+                       :in-theory (disable
+                                   ctrex-for-always-equal-correct)))
+                    (call (acl2::find-call-lst 'ctrex-for-always-equal-under-hyp1
+                                               clause))
+                    ((when call)
+                     `(:use ((:instance ctrex-for-always-equal-under-hyp1-correct
+                              (x ,(second call)) (y ,(third call))
+                              (hyp ,(fourth call)) (env (cdr env))))
+                       :in-theory (disable
+                                   ctrex-for-always-equal-under-hyp1-correct))))
+                 nil))
+          ;; (and (equal (car clause)
+          ;;             '(not (equal (acl2::q-binary-and hyp x)
+          ;;                          (acl2::q-binary-and hyp y))))
+          ;;      (acl2::bdd-reasoning))
+          (and stable-under-simplificationp
+               '(;; :in-theory (e/d (acl2::eval-bdd acl2::ubddp)
+                 ;;                 (ctrex-for-always-equal-correct))
+                 :expand ((:free (x a b)
+                           (acl2::eval-bdd x (cons a b)))
+                          (acl2::eval-bdd x env)
+                          (acl2::eval-bdd x nil)
+                          (acl2::eval-bdd y env)
+                          (acl2::eval-bdd y nil)
+                          (acl2::eval-bdd hyp env)
+                          (acl2::eval-bdd hyp nil))
+                 :do-not-induct t))))
 
 
 
 
 
-(defun always-equal-uu (x y)
-  (declare (xargs :guard t :measure (+ (acl2-count x) (acl2-count y))))
-  (if (and (atom x) (atom y))
-      (mv t t)
-    (b* (((mv xa xd) (if (consp x) (mv (car x) (cdr x)) (mv nil nil)))
-         ((mv ya yd) (if (consp y) (mv (car y) (cdr y)) (mv nil nil)))
-         ((when (hqual xa ya)) (always-equal-uu xd yd))
-         (xa (acl2::ubdd-fix xa))
-         (ya (acl2::ubdd-fix ya))
-         ((when (hqual xa ya)) (always-equal-uu xd yd)))
-      (mv nil (ctrex-for-always-equal xa ya)))))
+;; (defun always-equal-uu (x y)
+;;   (declare (xargs :guard t :measure (+ (acl2-count x) (acl2-count y))))
+;;   (if (and (atom x) (atom y))
+;;       (mv t nil)
+;;     (b* (((mv xa xd) (if (consp x) (mv (car x) (cdr x)) (mv nil nil)))
+;;          ((mv ya yd) (if (consp y) (mv (car y) (cdr y)) (mv nil nil)))
+;;          ((when (hqual xa ya)) (always-equal-uu xd yd))
+;;          (xa (acl2::ubdd-fix xa))
+;;          (ya (acl2::ubdd-fix ya))
+;;          ((when (hqual xa ya)) (always-equal-uu xd yd)))
+;;       (mv nil (ctrex-for-always-equal xa ya)))))
 
 (defun always-equal-ss-under-hyp (x y hyp)
   (declare (xargs :guard t :measure (+ (acl2-count x) (acl2-count y))))
-  (b* (((mv xa xd xend) (if (consp x)
-                            (if (consp (cdr x))
-                                (mv (car x) (cdr x) nil)
-                              (mv (car x) x t))
-                          (mv nil nil t)))
-       ((mv ya yd yend) (if (consp y)
-                            (if (consp (cdr y))
-                                (mv (car y) (cdr y) nil)
-                              (mv (car y) y t))
-                          (mv nil nil t)))
+  (b* (((mv xa xd xend) (first/rest/end x))
+       ((mv ya yd yend) (first/rest/end y))
        ((when (hqual xa ya))
         (if (and xend yend)
-            (mv t t)
+            (mv t nil)
           (always-equal-ss-under-hyp xd yd hyp)))
        (xa (acl2::ubdd-fix xa))
        (ya (acl2::ubdd-fix ya))
-       (res (ctrex-for-always-equal-under-hyp xa ya hyp)))
-    (if (eq res nil)
-        (if (and xend yend)
-            (mv t t)
-          (always-equal-ss-under-hyp xd yd hyp))
-      (mv nil res))))
+       ((mv diffp res) (ctrex-for-always-equal-under-hyp xa ya hyp)))
+    (if diffp
+        (mv nil res)
+      (if (and xend yend)
+          (mv t nil)
+        (always-equal-ss-under-hyp xd yd hyp)))))
 
 
 
 
 (local
  (encapsulate nil
-  
+
    (local
     (progn
-      (include-book "arithmetic/top-with-meta" :dir :system)
 
-      (defthm even-not-equal-odd
-        (implies (and (evenp x) (evenp y))
-                 (not (equal x (+ 1 y)))))
-
-      (defthm evenp-ash-1
-        (implies (integerp x)
-                 (evenp (ash x 1)))
-        :hints(("Goal" :in-theory (enable ash))))
-
-      (defthm natp-ash-1
-        (implies (natp x)
-                 (natp (ash x 1)))
-        :hints(("Goal" :in-theory (enable ash)))
-        :rule-classes :type-prescription)
-
-      (defthm equal-ash-n
-        (implies (and (integerp x) (integerp n))
-                 (equal (equal (ash x 1) n)
-                        (equal x (* 1/2 n))))
-        :hints(("Goal" :in-theory (enable ash))))
-
-      (defthm half-of-ash
-        (implies (integerp x)
-                 (equal (* 1/2 (ash x 1)) x))
-        :hints(("Goal" :in-theory (enable ash))))))
+      (defthm equal-of-bool->bit
+        (equal (equal (acl2::bool->bit x) (acl2::bool->bit y))
+               (iff x y)))
+
+      ;; (defthm even-not-equal-odd
+      ;;   (implies (and (evenp x) (evenp y))
+      ;;            (not (equal x (+ 1 y)))))
+
+      ;; (defthm *-2-not-minus-1
+      ;;   (implies (integerp n)
+      ;;            (not (equal (* 2 n) -1)))
+      ;;   :hints (("goal" :use ((:instance even-not-equal-odd
+      ;;                          (x (* 2 n)) (y -2))))))
+
+      ;; (defthm evenp-ash-1
+      ;;   (implies (integerp x)
+      ;;            (evenp (ash x 1)))
+      ;;   :hints(("Goal" :in-theory (enable ash))))
+
+      ;; (defthm natp-ash-1
+      ;;   (implies (natp x)
+      ;;            (natp (ash x 1)))
+      ;;   :hints(("Goal" :in-theory (enable ash)))
+      ;;   :rule-classes :type-prescription)
+
+      ;; (defthm equal-ash-n
+      ;;   (implies (and (integerp x) (integerp n))
+      ;;            (equal (equal (ash x 1) n)
+      ;;                   (equal x (* 1/2 n))))
+      ;;   :hints(("Goal" :in-theory (enable ash))))
+
+      ;; (defthm half-of-ash
+      ;;   (implies (integerp x)
+      ;;            (equal (* 1/2 (ash x 1)) x))
+      ;;   :hints(("Goal" :in-theory (enable ash))))
+      ))
 
 
 
-   (defthm always-equal-uu-correct
-     (mv-let (always-equal ctrex-bdd)
-       (always-equal-uu x y)
-       (implies (and (not (bfr-mode)))
-                (and (implies always-equal
-                              (equal (v2n (bfr-eval-list x env))
-                                     (v2n (bfr-eval-list y env))))
-                     (implies (and (not always-equal)
-                                   (bfr-eval ctrex-bdd env))
-                              (not (equal (v2n (bfr-eval-list x env))
-                                          (v2n (bfr-eval-list y env))))))))
-     :hints(("Goal" 
-             :induct (always-equal-uu x y))
-            '(:use ((:instance ctrex-for-always-equal-correct
-                               (x (and (consp x) (acl2::ubdd-fix (car x))))
-                               (y (and (consp y) (acl2::ubdd-fix (car y)))))
-                    (:instance acl2::eval-bdd-ubdd-fix
-                     (x (car x)))
-                    (:instance acl2::eval-bdd-ubdd-fix
-                     (x (car y))))
-              :in-theory (e/d (bfr-eval bfr-eval-list v2n)
-                              (acl2::eval-bdd-ubdd-fix)))))
+   ;; (defthm always-equal-uu-correct
+   ;;   (mv-let (always-equal ctrex-bdd)
+   ;;     (always-equal-uu x y)
+   ;;     (implies (and (not (bfr-mode)))
+   ;;              (and (implies always-equal
+   ;;                            (equal (bfr-list->u x env)
+   ;;                                   (bfr-list->u y env)))
+   ;;                   (implies (and (not always-equal)
+   ;;                                 (bfr-eval ctrex-bdd env))
+   ;;                            (not (equal (bfr-list->u x env)
+   ;;                                        (bfr-list->u y env)))))))
+   ;;   :hints(("Goal"
+   ;;           :induct (always-equal-uu x y))
+   ;;          '(:use ((:instance ctrex-for-always-equal-correct
+   ;;                             (x (and (consp x) (acl2::ubdd-fix (car x))))
+   ;;                             (y (and (consp y) (acl2::ubdd-fix (car y)))))
+   ;;                  (:instance acl2::eval-bdd-ubdd-fix
+   ;;                   (x (car x)))
+   ;;                  (:instance acl2::eval-bdd-ubdd-fix
+   ;;                   (x (car y))))
+   ;;            :in-theory (e/d (bfr-eval bfr-eval-list)
+   ;;                            (acl2::eval-bdd-ubdd-fix)))))
 
    (defthm always-equal-ss-under-hyp-correct
-     (mv-let (always-equal ctrex-bdd)
+     (mv-let (always-equal ctrex)
        (always-equal-ss-under-hyp x y hyp)
        (and (implies (and always-equal
                           (not (bfr-mode))
                           (acl2::ubddp hyp)
                           (bfr-eval hyp env))
-                     (equal (v2i (bfr-eval-list x env))
-                            (v2i (bfr-eval-list y env))))
+                     (equal (bfr-list->s x env)
+                            (bfr-list->s y env)))
             (implies (and (not (bfr-mode))
                           (bfr-eval ctrex-bdd env)
                           (acl2::ubddp hyp)
                           (not always-equal))
-                     (and (bfr-eval hyp env)
-                          (not (equal (v2i (bfr-eval-list x env))
-                                      (v2i (bfr-eval-list y env))))))))
-     :hints(("Goal" :in-theory (e/d* (bfr-eval-list bfr-eval v2i)
-                                     (ctrex-for-always-equal-under-hyp-correct1
-                                      ctrex-for-always-equal-under-hyp-correct2
-                                      ctrex-for-always-equal-under-hyp
-;                                      bfr-eval-when-qs-subset
+                     (and (bfr-eval hyp ctrex)
+                          (not (equal (bfr-list->s x ctrex)
+                                      (bfr-list->s y ctrex)))))))
+     :hints(("Goal" :in-theory (e/d* (ACL2::EQUAL-LOGCONS-STRONG
+                                      bfr-list->s bfr-eval scdr s-endp)
+                                     (ctrex-for-always-equal-under-hyp
+                                      logcons
+                                      ctrex-for-always-equal-under-hyp-correct
+                                      ctrex-for-always-equal-under-hyp-flag-correct
                                       default-cdr default-car
-                                      natp-ash-1 default-+-1 default-+-2
-                                      hyp-eval-lemma
-                                      acl2::eval-bdd-ubdd-fix
-;;                                       bfr-eval-when-not-consp
-;;                                       bfr-eval-of-non-consp-cheap
-;;                                       bfr-eval-when-non-consp-values
+                                      default-+-1 default-+-2
                                       (:definition always-equal-ss-under-hyp)
                                       (:rules-of-class :type-prescription
                                                        :here))
                                      ((:type-prescription bfr-eval)
                                       (:type-prescription ash)
-                                      (:type-prescription v2i)))
+                                      (:type-prescription bfr-list->s)
+                                      (:type-prescription acl2::eval-bdd)))
              :induct (always-equal-ss-under-hyp x y hyp)
              :expand ((always-equal-ss-under-hyp x y hyp)
                       (always-equal-ss-under-hyp x nil hyp)
                       (always-equal-ss-under-hyp nil y hyp)
                       (always-equal-ss-under-hyp nil nil hyp)))
-            '(:use ((:instance ctrex-for-always-equal-under-hyp-correct1
-                     (x (and (consp x) (acl2::ubdd-fix (car x))))
-                     (y (and (consp y) (acl2::ubdd-fix (car y)))))
-                    (:instance ctrex-for-always-equal-under-hyp-correct2
-                     (x (and (consp x) (acl2::ubdd-fix (car x))))
-                     (y (and (consp y) (acl2::ubdd-fix (car y)))))
-                    (:instance acl2::eval-bdd-ubdd-fix
-                     (x (car x)))
-                    (:instance acl2::eval-bdd-ubdd-fix
-                     (x (car y))))))
+            (and stable-under-simplificationp
+                 (b* ((call (acl2::find-call-lst 'ctrex-for-always-equal-under-hyp
+                                                 clause))
+                      ((when call)
+                       `(:use ((:instance ctrex-for-always-equal-under-hyp-correct
+                                (x ,(second call)) (y ,(third call)) (hyp ,(fourth call)))
+                               (:instance ctrex-for-always-equal-under-hyp-flag-correct
+                                (x ,(second call)) (y ,(third call)) (hyp ,(fourth call)))))))
+                   nil)))
      :rule-classes ((:rewrite :match-free :all)))))
-                           
+
 
 
 ;; (local
@@ -534,12 +525,14 @@
 
 
 
+(include-book "ctrex-utils")
 
-
-(defun always-equal-of-numbers (a b hyp)
+(defun always-equal-of-numbers (a b hyp config bvar-db state)
   (declare (xargs :guard (and (not (bfr-mode))
+                              (glcp-config-p config)
                               (general-numberp a)
-                              (general-numberp b))))
+                              (general-numberp b))
+                  :stobjs (bvar-db state)))
   (b* (((mv arn ard ain aid)
         (general-number-components a))
        ((mv brn brd bin bid)
@@ -558,19 +551,32 @@
        ((mv requal rctrex)
         (always-equal-ss-under-hyp arn brn uhyp))
        ((unless requal)
-        (prog2$ (cw "reals, ctrex: ~x0~%" rctrex)
-                (g-if (mk-g-boolean rctrex)
-                      nil
-                      (g-apply 'equal (gl-list a b)))))
+        (ec-call
+         (glcp-print-single-ctrex rctrex
+                                  "Error:"
+                                  "ALWAYS-EQUAL violation"
+                                  config bvar-db state))
+        (g-apply 'equal (gl-list a b)))
        ((mv iequal ictrex)
         (always-equal-ss-under-hyp ain bin uhyp))
        ((unless iequal)
-        (prog2$ (cw "imags, ctrex: ~x0~%" rctrex)
-                (g-if (mk-g-boolean ictrex)
-                      nil
-                      (g-apply 'equal (gl-list a b))))))
+        (ec-call
+         (glcp-print-single-ctrex ictrex
+                                  "Error:"
+                                  "ALWAYS-EQUAL violation"
+                                  config bvar-db state))
+        (g-apply 'equal (gl-list a b))))
     t))
 
+(defthm deps-of-always-equal-of-numbers
+  (implies (and (not (gobj-depends-on k p a))
+                (not (gobj-depends-on k p b))
+                (general-numberp a)
+                (general-numberp b))
+           (not (gobj-depends-on
+                 k p (always-equal-of-numbers a b hyp config bvar-db state))))
+  :hints(("Goal" :in-theory (enable always-equal-of-numbers))))
+
 ;; (local (defthm always-equal-of-numbers-gobjectp
 ;;          (implies (and (not (bfr-mode))
 ;;                        (gobjectp a)
@@ -616,32 +622,48 @@
                        (general-numberp a)
                        (general-numberp b)
                        (bfr-eval hyp (car env)))
-                  (equal (eval-g-base (always-equal-of-numbers a b hyp) env)
+                  (equal (eval-g-base (always-equal-of-numbers
+                                       a b hyp config bvar-db state) env)
                          (equal (eval-g-base a env)
                                 (eval-g-base b env))))
-         :hints(("Goal" :in-theory (enable* (:ruleset general-object-possibilities)
-                                            ctrex-for-always-equal-correct
-                                            boolean-list-bfr-eval-list)))))
+         :hints(("Goal" :in-theory (e/d* ((:ruleset general-object-possibilities)
+                                          ctrex-for-always-equal-correct
+                                          boolean-list-bfr-eval-list)
+                                         (bfr-sat-bdd-unsat bfr-list->s))))))
 
 (in-theory (disable always-equal-of-numbers))
 
 
-(defun always-equal-of-booleans (a b hyp)
+(defun always-equal-of-booleans (a b hyp config bvar-db state)
   (declare (xargs :guard (and (not (bfr-mode))
+                              (glcp-config-p config)
                               (general-booleanp a)
-                              (general-booleanp b))))
-  (let ((av (general-boolean-value a))
-        (bv (general-boolean-value b)))
-    (or (hqual av bv)
-        (let* ((av (acl2::ubdd-fix av))
-               (bv (acl2::ubdd-fix bv)))
-          (or (hqual av bv)
-              (g-if
-               (mk-g-boolean
-                (ctrex-for-always-equal-under-hyp
-                 av bv (acl2::ubdd-fix hyp)))
-               nil
-               (g-apply 'equal (gl-list a b))))))))
+                              (general-booleanp b))
+                  :stobjs (bvar-db state)))
+  (b* ((av (general-boolean-value a))
+       (bv (general-boolean-value b))
+       ((when (hqual av bv)) t)
+       (av (acl2::ubdd-fix av))
+       (bv (acl2::ubdd-fix bv))
+       ((when (hqual av bv)) t)
+       ((mv unequal ctrex) (ctrex-for-always-equal-under-hyp
+                          av bv (acl2::ubdd-fix hyp)))
+       ((unless unequal) t))
+    (ec-call
+     (glcp-print-single-ctrex ctrex
+                              "Error:"
+                              "ALWAYS-EQUAL violation"
+                              config bvar-db state))
+    (g-apply 'equal (gl-list a b))))
+
+(defthm deps-of-always-equal-of-booleans
+  (implies (and (not (gobj-depends-on k p a))
+                (not (gobj-depends-on k p b))
+                (general-booleanp a)
+                (general-booleanp b))
+           (not (gobj-depends-on
+                 k p (always-equal-of-booleans a b hyp config bvar-db state))))
+  :hints(("Goal" :in-theory (enable always-equal-of-booleans))))
 
 ;; (local (defthm always-equal-of-booleans-gobjectp
 ;;          (implies (and (not (bfr-mode))
@@ -652,39 +674,50 @@
 ;;                        (bfr-p hyp))
 ;;                   (gobjectp (always-equal-of-booleans a b hyp)))))
 
+(local (defthm ubdd-fixes-unequal
+         (implies (not (equal (acl2::eval-bdd a env) (acl2::eval-bdd b env)))
+                  (not (equal (acl2::ubdd-fix a) (acl2::ubdd-fix b))))
+         :hints (("goal" :in-theory (disable ACL2::EVAL-BDD-UBDD-FIX)
+                  :use ((:instance ACL2::EVAL-BDD-UBDD-FIX (x a)
+                                   (acl2::env gl::env))
+                        (:instance ACL2::EVAL-BDD-UBDD-FIX (x b)
+                                   (acl2::env gl::env)))))))
+
 (local (defthm always-equal-of-booleans-correct
          (implies (and (not (bfr-mode))
                        (general-booleanp a)
                        (general-booleanp b)
                        (bfr-eval hyp (car env)))
-                  (equal (eval-g-base (always-equal-of-booleans a b hyp) env)
+                  (equal (eval-g-base (always-equal-of-booleans a b hyp config bvar-db state) env)
                          (equal (eval-g-base a env)
                                 (eval-g-base b env))))
          :hints(("Goal" :in-theory (e/d (bfr-eval)
-                                        (ctrex-for-always-equal-under-hyp-correct1
-                                         acl2::eval-bdd-ubdd-fix))
-                 :use ((:instance ctrex-for-always-equal-under-hyp-correct1
-                        (x (acl2::ubdd-fix (general-boolean-value a)))
-                        (y (acl2::ubdd-fix (general-boolean-value b)))
-                        (hyp (acl2::ubdd-fix hyp))
-                        (env (car env)))
-                       (:instance acl2::eval-bdd-ubdd-fix
-                        (x (general-boolean-value a))
-                        (env (car env)))
-                       (:instance acl2::eval-bdd-ubdd-fix
-                        (x (general-boolean-value b))
-                        (env (car env))))))))
+                                        (ctrex-for-always-equal-under-hyp-correct
+                                         ctrex-for-always-equal-under-hyp-flag-correct)))
+                (and stable-under-simplificationp
+                     (b* ((call (acl2::find-call-lst 'ctrex-for-always-equal-under-hyp
+                                                     clause))
+                          ((when call)
+                           `(:use ((:instance ctrex-for-always-equal-under-hyp-correct
+                                    (x ,(second call)) (y ,(third call))
+                                    (hyp ,(fourth call)) (env (car env)))
+                                   (:instance ctrex-for-always-equal-under-hyp-flag-correct
+                                    (x ,(second call)) (y ,(third call))
+                                    (hyp ,(fourth call)))))))
+                       nil)))))
 
 (in-theory (disable always-equal-of-booleans))
 
 
 
 
-(defun g-always-equal-core (a b hyp clk)
+(defun g-always-equal-core (a b hyp clk config bvar-db state)
   (declare (xargs :measure (+ (acl2-count a) (Acl2-count b))
                   :guard (and (not (bfr-mode))
-                              (natp clk))
-                  :verify-guards nil))
+                              (natp clk)
+                              (glcp-config-p config))
+                  :verify-guards nil
+                  :stobjs (bvar-db state)))
   (cond ((hqual a b) t)
         ((and (general-concretep a) (general-concretep b))
          (hons-equal (general-concrete-obj a) (general-concrete-obj b)))
@@ -697,12 +730,12 @@
                 (cond
                  ((general-booleanp a)
                   (and (general-booleanp b)
-                       (always-equal-of-booleans a b hyp)))
+                       (always-equal-of-booleans a b hyp config bvar-db state)))
                  ((general-booleanp b) nil)
                  ((general-numberp a)
                   (and
                    (general-numberp b)
-                   (always-equal-of-numbers a b hyp)))
+                   (always-equal-of-numbers a b hyp config bvar-db state)))
                  ((general-numberp b) nil)
                  ((general-consp a)
                   (and
@@ -711,12 +744,12 @@
                           (g-always-equal-core
                            (general-consp-car a)
                            (general-consp-car b)
-                           hyp clk)))
+                           hyp clk config bvar-db state)))
                      (if (eq car-equal t)
                          (g-always-equal-core
                           (general-consp-cdr a)
                           (general-consp-cdr b)
-                          hyp clk)
+                          hyp clk config bvar-db state)
                        (g-if car-equal
                              (g-apply 'equal (gl-list a b))
                              nil)))))
@@ -728,8 +761,8 @@
                          (then (g-ite->then b))
                          (else (g-ite->else b)))
                     (g-if test
-                          (g-always-equal-core a then hyp clk)
-                          (g-always-equal-core a else hyp clk)))))
+                          (g-always-equal-core a then hyp clk config bvar-db state)
+                          (g-always-equal-core a else hyp clk config bvar-db state)))))
                (t (g-apply 'equal (gl-list a b)))))
         ((eq (tag a) :g-ite)
          (if (zp clk)
@@ -738,8 +771,8 @@
                   (then (g-ite->then a))
                   (else (g-ite->else a)))
              (g-if test
-                   (g-always-equal-core then b hyp clk)
-                   (g-always-equal-core else b hyp clk)))))
+                   (g-always-equal-core then b hyp clk config bvar-db state)
+                   (g-always-equal-core else b hyp clk config bvar-db state)))))
         (t (g-apply 'equal (gl-list a b)))))
 
 
@@ -750,20 +783,20 @@
 ;;         (t (pattern-match a
 ;;              ((g-ite test then else)
 ;;               (g-if test
-;;                     (g-always-equal-core then b hyp clk)
-;;                     (g-always-equal-core else b hyp clk)))
+;;                     (g-always-equal-core then b hyp clk config bvar-db state)
+;;                     (g-always-equal-core else b hyp clk config bvar-db state)))
 ;;              (& (pattern-match b
 ;;                   ((g-ite test then else)
 ;;                    (g-if test
-;;                          (g-always-equal-core a then hyp clk)
-;;                          (g-always-equal-core a else hyp clk)))
+;;                          (g-always-equal-core a then hyp clk config bvar-db state)
+;;                          (g-always-equal-core a else hyp clk config bvar-db state)))
 ;;                   ((g-var &)
 ;;                    (or (equal a b)
 ;;                        (g-apply 'equal (list a b))))
 ;;                   ((g-apply fn args)
 ;;                    (pattern-match a
 ;;                      ((g-apply !fn aargs)
-;;                       (g-if (g-always-equal-core aargs args hyp clk)
+;;                       (g-if (g-always-equal-core aargs args hyp clk config bvar-db state)
 ;;                             t
 ;;                             (g-apply 'equal (list a b))))
 ;;                      (& (g-apply 'equal (list a b)))))
@@ -788,12 +821,12 @@
 ;;                                     (g-always-equal-core
 ;;                                      (general-consp-car a)
 ;;                                      (general-consp-car b)
-;;                                      hyp clk)))
+;;                                      hyp clk config bvar-db state)))
 ;;                                (if (eq car-equal t)
 ;;                                    (g-always-equal-core
 ;;                                     (general-consp-cdr a)
 ;;                                     (general-consp-cdr b)
-;;                                     hyp clk)
+;;                                     hyp clk config bvar-db state)
 ;;                                  (g-if car-equal
 ;;                                        (g-apply 'equal (list a b))
 ;;                                        nil)))))
@@ -802,7 +835,7 @@
 ;; (defthm g-always-equal-core-gobjectp
 ;;   (implies (and (not (bfr-mode))
 ;;                 (bfr-p hyp))
-;;            (gobjectp (g-always-equal-core x y hyp clk)))
+;;            (gobjectp (g-always-equal-core x y hyp clk config bvar-db state)))
 ;;   :hints (("Goal" :in-theory (e/d* (booleanp-gobjectp)
 ;;                                    ((:definition g-always-equal-core)
 ;;                                     general-boolean-value
@@ -819,9 +852,9 @@
 ;;                                     (:rules-of-class :type-prescription :here)
 ;;                                     equal-of-booleans-rewrite
 ;;                                     (force)))
-;;            :induct (g-always-equal-core x y hyp clk)
-;;            :expand ((g-always-equal-core x y hyp clk)
-;;                     (g-always-equal-core x x hyp clk))
+;;            :induct (g-always-equal-core x y hyp clk config bvar-db state)
+;;            :expand ((g-always-equal-core x y hyp clk config bvar-db state)
+;;                     (g-always-equal-core x x hyp clk config bvar-db state))
 ;;            :do-not-induct t)))
 
 
@@ -836,7 +869,7 @@
                           (:type-prescription general-numberp)
                           (:type-prescription acl2::ubddp)
                           (:type-prescription general-concretep)
-                          (:type-prescription =-uu)
+                          (:type-prescription bfr-=-uu)
                           ;; (:type-prescription assume-true-under-hyp2)
                           ;; (:type-prescription assume-false-under-hyp2)
                           ;(:type-prescription assume-true-under-hyp)
@@ -855,6 +888,17 @@
   (verify-guards g-always-equal-core))
 
 
+(defthm deps-of-g-always-equal-core
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y)))
+           (not (gobj-depends-on
+                 k p (g-always-equal-core x y hyp clk config bvar-db state))))
+  :hints('(:in-theory (e/d ((:i g-always-equal-core))
+                           (gobj-depends-on
+                            general-concrete-obj-when-consp-for-eval-g-base)))
+         (acl2::just-induct-and-expand
+          (g-always-equal-core x y hyp clk config bvar-db state))))
+
 (encapsulate nil
 
   (local (include-book "clause-processors/just-expand" :dir :system))
@@ -879,7 +923,7 @@
                       mk-g-boolean-correct-for-eval-g-base
                       geval-g-if-marker-eval-g-base
                       geval-g-or-marker-eval-g-base
-                      
+
                       general-concretep-not-general-consp
                       general-concretep-not-general-booleanp
                       general-concretep-not-general-numberp
@@ -897,45 +941,47 @@
                       booleanp-compound-recognizer
 
                       gtests-g-test-marker
-                      
+
                       bfr-eval-bfr-binary-and
                       bfr-eval-bfr-not
                       bfr-eval-bfr-binary-or
                       gtests-nonnil-correct-for-eval-g-base
-                      hyp-fix-correct 
+                      hyp-fix-correct
                       always-equal-of-numbers-correct
                       always-equal-of-booleans-correct
-                      (:type-prescription v2i)
-                      
+
                       bfr-eval-g-hyp-marker
                       cons-equal
 
                       eval-g-base-apply-of-equal-kwote-lst
-                      
+                      eval-g-base-list-of-gl-cons
+
                       general-concrete-obj-of-atomic-constants
                       general-concretep-of-atomic-constants
                       hons-equal acl2::always-equal
                       (:induction g-always-equal-core))
                      ((general-concrete-obj)
-                      (general-concretep)))))
+                      (general-concretep)
+                      (kwote-lst)))))
 
   (defthm g-always-equal-core-correct
     (implies (and (not (bfr-mode))
                   (bfr-eval hyp (car env)))
-             (equal (eval-g-base (g-always-equal-core x y hyp clk) env)
+             (equal (eval-g-base (g-always-equal-core x y hyp clk config bvar-db state) env)
                     (acl2::always-equal (eval-g-base x env)
                                         (eval-g-base y env))))
     :hints ((acl2::just-induct-and-expand
-             (g-always-equal-core x y hyp clk))
+             (g-always-equal-core x y hyp clk config bvar-db state))
             (and stable-under-simplificationp
-                 '(:expand ((g-always-equal-core x y hyp clk)
-                            (g-always-equal-core x x hyp clk)
-                            (g-always-equal-core x y hyp clk)
-                            (g-always-equal-core x x hyp clk)
+                 '(:expand ((g-always-equal-core x y hyp clk config bvar-db state)
+                            (g-always-equal-core x x hyp clk config bvar-db state)
+                            (g-always-equal-core x y hyp clk config bvar-db state)
+                            (g-always-equal-core x x hyp clk config bvar-db state)
                             (eval-g-base x env)
                             (eval-g-base y env)
                             (eval-g-base nil env)
-                            (eval-g-base t env))
+                            (eval-g-base t env)
+                            (eval-g-base-list nil env))
                    :do-not-induct t)))))
 
 (in-theory (disable g-always-equal-core))
diff -Nru acl2-6.2/books/centaur/gl/auto-bindings.lisp acl2-6.3/books/centaur/gl/auto-bindings.lisp
--- acl2-6.2/books/centaur/gl/auto-bindings.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/auto-bindings.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,21 +1,38 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
 ; auto-bindings.lisp
-; Original author: Jared Davis
+;
+; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "GL")
-(include-book "gl-doc-string")
 (include-book "gobject-types")
 (include-book "../misc/numlist")
 (include-book "tools/bstar" :dir :system)
 (program)
 
-(defdoc auto-bindings
-  ":Doc-Section ACL2::GL
-Simplified shape specifiers for ~c[:g-bindings].~/
+(defxdoc auto-bindings
+  :parents (reference shape-specs)
+  :short "Simplified shape specifiers for @(':g-bindings')."
+  :long "<p>The @('auto-bindings') function lets you create simple @(see
+shape-specs) in an easy way.  Here is an example:</p>
 
-The ~c[auto-bindings] function lets you create simple ~il[shape-specs] in an
-easy way.  Here is an example:
-
-~bv[]
+@({
  (def-gl-thm foo
    ...
    :g-bindings (auto-bindings               ; expands to:
@@ -27,25 +44,32 @@
                       (:nat c-bus 128))     ; }
                 (:nat fixup-bits 4)         ; g-number with indices 415-420
                 ))
-~ev[]
+})
+
+<p>This is good because</p>
+
+<ul>
+
+<li>you don't have to think about sign bits and do a bunch of stupid arithmetic
+to figure out the next free index, and</li>
+
+<li>you can painlessly etend the bindings when you want to add a new variable
+without having to update a bunch of indices.</li>
 
-This is good because (1) you don't have to think about sign bits and do a bunch
-of stupid arithmetic to figure out the next free index, and (2) you can
-painlessly etend the bindings when you want to add a new variable without
-having to update a bunch of indices.~/
+</ul>
 
-Auto-bindings are more limited than shape-specs.  Except for the special
-~c[:mix] command, you can only write:
+<p>Auto-bindings are more limited than shape-specs.  Except for the special
+@(':mix') command, you can only write:</p>
 
-~bv[]
+@({
     (:bool var)  -- expands to a g-boolean shape-specifier
     (:int var n) -- expands to a g-integer with n bits (signed 2's complement)
     (:nat var n) -- equivalent to (:int var (+ 1 n))
-~ev[]
+})
 
-The ~c[:mix] command cannot be nested and all of its elements must be numbers
-with the same size.  That is, think of a ~c[:nat] as just an abbreviation for
-an ~c[:int] with one more variable.~/")
+<p>The @(':mix') command cannot be nested and all of its elements must be
+numbers with the same size.  That is, think of a @(':nat') as just an
+abbreviation for an @(':int') with one more variable.</p>")
 
 (defun auto-bind-xlate (x inside-mix-p)
   ;; Syntax check that X is (:nat ...), (:int ...), or (:bool ...)
diff -Nru acl2-6.2/books/centaur/gl/bfr-aig-bddify.acl2 acl2-6.3/books/centaur/gl/bfr-aig-bddify.acl2
--- acl2-6.2/books/centaur/gl/bfr-aig-bddify.acl2	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bfr-aig-bddify.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (set-waterfall-parallelism nil)
 
diff -Nru acl2-6.2/books/centaur/gl/bfr-aig-bddify.lisp acl2-6.3/books/centaur/gl/bfr-aig-bddify.lisp
--- acl2-6.2/books/centaur/gl/bfr-aig-bddify.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bfr-aig-bddify.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,9 +1,28 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 
 (include-book "bfr-sat")
-(include-book "gl-doc-string")
-(include-book "../aig/bddify-correct")
+(include-book "../aig/bddify")
+(local (include-book "../aig/bddify-correct"))
 (local (include-book "../aig/eval-restrict"))
 
 
@@ -21,7 +40,7 @@
   (declare (xargs :guard t))
   (bfr-case
    :bdd (mv nil nil nil) ;; fail
-   :aig 
+   :aig
    (b* ((vars (acl2::aig-vars prop))
         (bindings (vars-to-bdd-bindings vars 0))
         ((mv bdd & exact)
@@ -33,8 +52,8 @@
 
 
 
-(defthm ubddp-val-alistp-vars-to-bdd-bindings
-  (acl2::ubddp-val-alistp (vars-to-bdd-bindings x n)))
+(local (defthm ubddp-val-alistp-vars-to-bdd-bindings
+         (acl2::ubddp-val-alistp (vars-to-bdd-bindings x n))))
 
 
 (local (include-book "arithmetic/top-with-meta" :dir :system))
@@ -58,7 +77,8 @@
            (equal (nth n (vars-to-bdd-env vars aig-env))
                   (if (hons-assoc-equal (nth n vars) aig-env)
                       (cdr (hons-assoc-equal (nth n vars) aig-env))
-                    t))))
+                    t)))
+  :hints(("Goal" :in-theory (enable nth))))
 
 (defthm len-member-equal
   (implies (member-equal x vars)
@@ -118,18 +138,19 @@
                  (acl2::vars (vars-to-bdd-env (acl2::aig-vars prop) env)))))))
 
 
-(defmacro gl-aig-bddify-mode ()
-  ":Doc-section ACL2::GL
-Use experimental AIG-based symbolic simulation in GL.~/
-This macro produces an event which sets the GL reasoning mode to use AIGs.
-This is a new, experimental feature under development.~/~/"
-  '(progn (acl2::defattach bfr-mode bfr-aig)
-          (acl2::defattach bfr-counterex-mode bfr-counterex-bdd)
-          (acl2::defattach
-           (bfr-sat bfr-sat-bddify)
-           :hints (("goal" :in-theory '(bfr-sat-bddify-unsat))
-                   (and stable-under-simplificationp
-                        '(:in-theory (enable bfr-sat-bddify)))))))
+(defsection gl-aig-bddify-mode
+  :parents (modes reference)
+  :short "GL: use AIGs as the Boolean function representation and solve queries
+by transforming them to BDDs."
+
+  (defmacro gl-aig-bddify-mode ()
+    '(progn (acl2::defattach bfr-mode bfr-aig)
+            (acl2::defattach bfr-counterex-mode bfr-counterex-bdd)
+            (acl2::defattach
+             (bfr-sat bfr-sat-bddify)
+             :hints (("goal" :in-theory '(bfr-sat-bddify-unsat))
+                     (and stable-under-simplificationp
+                          '(:in-theory (enable bfr-sat-bddify))))))))
 
 (local (gl-aig-bddify-mode))
 
diff -Nru acl2-6.2/books/centaur/gl/bfr-param.lisp acl2-6.3/books/centaur/gl/bfr-param.lisp
--- acl2-6.2/books/centaur/gl/bfr-param.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bfr-param.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,127 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "bvecs")
+(include-book "centaur/ubdds/param" :dir :system)
+(include-book "centaur/aig/misc" :dir :system)
+(local (include-book "centaur/aig/eval-restrict" :dir :system))
+
+(local (in-theory (disable acl2::append-of-nil)))
+
+
+(defun bfr-list-to-param-space (p x)
+  (declare (xargs :guard t
+                  :guard-hints ('(:in-theory (enable bfr-to-param-space
+                                                     bfr-list-to-param-space))))
+           (ignorable p))
+  (mbe :logic (if (atom x)
+                  nil
+                (cons (bfr-to-param-space p (car x))
+                      (bfr-list-to-param-space p (cdr x))))
+       :exec (if (atom x)
+                 nil
+               (bfr-case :bdd (acl2::to-param-space-list p x)
+                         :aig (acl2::aig-restrict-list
+                               x (acl2::aig-extract-iterated-assigns-alist p 10))))))
+
+
+(defthm bfr-eval-list-to-param-space-list
+  (implies (bfr-eval p env)
+           (equal (bfr-eval-list (bfr-list-to-param-space p x)
+                                 (bfr-param-env p env))
+                  (bfr-eval-list x env)))
+  :hints(("Goal" :in-theory (e/d (bfr-eval-list
+                                  bfr-list-to-param-space)
+                                 (bfr-param-env)))))
+
+(defthm bfr-eval-list-to-param-space-list-with-unparam-env
+  (implies (syntaxp (not (and (consp env)
+                              (eq (car env) 'bfr-param-env))))
+           (equal (bfr-eval-list (bfr-list-to-param-space p x)
+                                 env)
+                  (bfr-eval-list x (bfr-unparam-env p env))))
+  :hints(("Goal" :in-theory (e/d (bfr-eval-list
+                                  bfr-list-to-param-space)
+                                 (bfr-param-env)))))
+
+(defthm bfr-list->s-to-param-space-list
+  (implies (bfr-eval p env)
+           (equal (bfr-list->s (bfr-list-to-param-space p x)
+                               (bfr-param-env p env))
+                  (bfr-list->s x env)))
+  :hints(("Goal" :in-theory (e/d (bfr-list->s
+                                  scdr s-endp
+                                  default-car
+                                  bfr-list-to-param-space)
+                                 (bfr-to-param-space
+                                  bfr-param-env))
+          :induct (bfr-list-to-param-space p x)
+          :expand ((bfr-list->s x env)))))
+
+(defthm bfr-list->s-to-param-space-list-with-unparam-env
+  (implies (syntaxp (not (and (consp env)
+                              (eq (car env) 'bfr-param-env))))
+           (equal (bfr-list->s (bfr-list-to-param-space p x)
+                               env)
+                  (bfr-list->s x (bfr-unparam-env p env))))
+  :hints(("Goal" :in-theory (e/d (bfr-list->s
+                                  scdr s-endp
+                                  default-car
+                                  bfr-list-to-param-space)
+                                 (bfr-to-param-space
+                                  bfr-param-env))
+          :induct (bfr-list-to-param-space p x)
+          :expand ((:free (env) (bfr-list->s x env))))))
+
+(defthm bfr-list->u-to-param-space-list
+  (implies (bfr-eval p env)
+           (equal (bfr-list->u (bfr-list-to-param-space p x)
+                               (bfr-param-env p env))
+                  (bfr-list->u x env)))
+  :hints(("Goal" :in-theory (e/d (bfr-list->u scdr s-endp
+                                              ;; bfr-eval
+                                              bfr-list-to-param-space)
+                                 (bfr-to-param-space
+                                  bfr-param-env)))))
+
+(defthm bfr-list->u-to-param-space-list-with-unparam-env
+  (implies (syntaxp (not (and (consp env)
+                              (eq (car env) 'bfr-param-env))))
+           (equal (bfr-list->u (bfr-list-to-param-space p x)
+                               env)
+                  (bfr-list->u x (bfr-unparam-env p env))))
+  :hints(("Goal" :in-theory (e/d (bfr-list->u scdr s-endp
+                                              ;; bfr-eval
+                                              bfr-list-to-param-space)
+                                 (bfr-to-param-space
+                                  bfr-param-env)))))
+
+(defund genv-param (p env)
+  (declare (xargs :guard (consp env))
+           (ignorable p))
+  (cons (bfr-param-env p (car env))
+        (cdr env)))
+
+(defund genv-unparam (p env)
+  (declare (xargs :guard (consp env))
+           (ignorable p))
+  (cons (bfr-unparam-env p (car env))
+        (cdr env)))
diff -Nru acl2-6.2/books/centaur/gl/bfr-sat.lisp acl2-6.3/books/centaur/gl/bfr-sat.lisp
--- acl2-6.2/books/centaur/gl/bfr-sat.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bfr-sat.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,78 +1,25 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "bfr")
-(include-book "gl-doc-string")
-
-(defdoc experimental-aig-reasoning
-  ":Doc-section ACL2::GL
-  Note about GL's experimental AIG reasoning mode.~/
-
-  By default, GL operates on BDD-based data structures and resolves Boolean
-reasoning questions using BDD operations.  However, it also has some support
-for a different mode that uses And-Inverter graphs instead.
-Using AIG mode requires a way to solve Boolean satisfiability problems on AIGs.
-We provide one method, of dubious utility, which is to transform the AIG into a
-BDD.  This mode may be used by including the book \"bfr-aig-bddify\" and then
-running (GL-AIG-BDDIFY-MODE), which is an ACL2 event.  (To return to the
-default BDD-only mode, simply run (GL-BDD-MODE).)  We describe below the
-mechanisms provided for putting GL into different reasoning modes.  These
-mechanisms may be used, by an adventurous user, to attach an external SAT
-solver and use that to solve AIG satisfiability queries, avoiding the necessity
-of the AIG to BDD transformation.  ~/
-
-GL can be put into different modes using ~il[defattach].  There are several
-functions that need to have proper attachments in order for GL to function;
-when the GL library is loaded, they are set up to a default configuration in
-which GL will use BDD-based reasoning.
-
-The functions that need attachments follow.  Here, BFR stands for Boolean
-function representation.
-
- * BFR-MODE: 0-ary with no constraints.  This detemines whether the Boolean
-function components in the symbolic object representation are BDDs or AIGs, and
-thus the functions used to combine them.  E.g., the definition of BFR-NOT
-is (basically):
-
-~bv[]
- (if (bfr-mode) (aig-not x) (q-not x)).
-~ev[]
-
-Similarly, BFR-EVAL either applies EVAL-BDD or AIG-EVAL, depending on BFR-MODE.
-
-By default the function BFR-BDD (which returns NIL) is attached to BFR-MODE,
-and thus BFR-NOT uses the BDD operation Q-NOT.  To use AIGs instead, attach
-BFR-AIG, which returns T.  
-
- * BFR-SAT: Unary, returning three values: SAT, SUCCEEDED, CTREX.  The main
-constraint of BFR-SAT is that if it returns SAT=NIL and SUCCEEDED=T, then
-BFR-EVAL of the input on any environment must be NIL, i.e., the input must be
-an unsatisfiable BDD or AIG (depending on the BFR-MODE.)  The CTREX value
-should be a counterexample in the case of a SAT result, represented either as a
-BDD or an alist mapping variables to Boolean values; see below under
-BFR-COUNTEREX-MODE.
-
-To satisfy the constraint in the BDD case, it suffices to simply check whether
-the input BDD is NIL; if so, it is satisfiable, and otherwise, it isn't.  This
-method is implemented as BFR-SAT-BDD, which is the default attachment of
-BFR-SAT.  For AIG mode, we provide an attachment BFR-SAT-BDDIFY which solves an
-AIG satisfiability query by transforming the input AIG into a BDD.  However,
-one might instead hook up a SAT solver into ACL2 so that it can take an AIG as
-input.  Given a way of calling such an external tool, it would not be difficult
-to produce a function that conforms to the constraint described above. :-)
-
- * BFR-COUNTEREX-MODE: 0-ary, no constraints.  This says whether the
-counterexample value sometimes returned by BFR-SAT is in the form of a BDD or
-an association list.  If it is set up wrong, then output in case of a
-counterexample will be garbled.  In both the default BDD mode and in the AIG
-BDDIFY mode provided, the counterexample is in the form of a BDD, and so we
-attach BFR-COUNTEREX-BDD by default.  However, if an external SAT solver is
-used, then there will likely be a single assignment returned, which might more
-conveniently be provided as an alist.  Then one would instead attach
-BFR-COUNTEREX-ALIST.
-~/
-")
 
 (encapsulate
   (((bfr-sat *) => (mv * * *)))
@@ -112,10 +59,13 @@
           :use ((:instance acl2::eval-bdd-ubdd-fix
                            (x prop))))))
 
+
 (acl2::defattach
  (bfr-sat bfr-sat-bdd
           :hints (("goal" :in-theory '(bfr-sat-bdd-unsat)))))
 
+(in-theory (disable bfr-sat-bdd-unsat bfr-sat-unsat))
+
 
 
 ;; In the AIG case, the counterexample returned is either an alist giving a
@@ -153,3 +103,124 @@
   (if (eq (bfr-counterex-mode) t) ;; alist
       ctrex
     (to-satisfying-assign assign ctrex)))
+
+
+
+
+
+(defund bfr-known-value (x)
+  (declare (xargs :guard t))
+  (bfr-case :bdd (and x t)
+            :aig (acl2::aig-eval x nil)))
+
+
+(defsection bfr-constcheck
+  ;; Bfr-constcheck: use SAT (or examine the BDD) to determine whether x is
+  ;; constant, and if so return that constant.
+  (defund bfr-constcheck (x)
+    (declare (xargs :guard t))
+    (if (bfr-known-value x)
+        (b* (((mv sat ok &) (bfr-sat (bfr-not x))))
+          (if (or sat (not ok))
+              x
+            t))
+      (b* (((mv sat ok &) (bfr-sat x)))
+        (if (or sat (not ok))
+            x
+          nil))))
+
+  (local (in-theory (enable bfr-constcheck)))
+
+  (defthm bfr-eval-of-bfr-constcheck
+    (equal (bfr-eval (bfr-constcheck x) env)
+           (bfr-eval x env))
+    :hints (("goal" :use ((:instance bfr-sat-unsat
+                           (prop x))
+                          (:instance bfr-sat-unsat
+                           (prop (bfr-not x)))))))
+
+  (defthm pbfr-depends-on-of-bfr-constcheck
+    (implies (not (pbfr-depends-on k p x))
+             (not (pbfr-depends-on k p (bfr-constcheck x))))))
+
+(defsection bfr-constcheck-pathcond
+  ;; Bfr-constcheck: use SAT (or examine the BDD) to determine whether x is
+  ;; constant, and if so return that constant.
+  (defund bfr-constcheck-pathcond (x pathcond)
+    (declare (xargs :guard t))
+    (b* (((mv sat ok &) (bfr-sat (bfr-and pathcond x)))
+         ((unless (or sat (not ok)))
+          nil)
+         ((mv sat ok &) (bfr-sat (bfr-and pathcond (bfr-not x))))
+         ((unless (or sat (not ok)))
+          t))
+      x))
+
+  (local (in-theory (enable bfr-constcheck-pathcond)))
+
+  (defthm bfr-eval-of-bfr-constcheck-pathcond
+    (implies (bfr-eval pathcond env)
+             (equal (bfr-eval (bfr-constcheck-pathcond x pathcond) env)
+                    (bfr-eval x env)))
+    :hints (("goal" :use ((:instance bfr-sat-unsat
+                           (prop (bfr-and pathcond x)))
+                          (:instance bfr-sat-unsat
+                           (prop (bfr-and pathcond (bfr-not x))))))))
+
+  (defthm pbfr-depends-on-of-bfr-constcheck-pathcond
+    (implies (not (pbfr-depends-on k p x))
+             (not (pbfr-depends-on k p (bfr-constcheck-pathcond x pathcond))))))
+
+
+(defsection bfr-check-true
+  ;; Bfr-constcheck: use SAT (or examine the BDD) to determine whether x is
+  ;; constant, and if so return that constant.
+  (defund bfr-check-true (x)
+    (declare (xargs :guard t))
+    (if (bfr-known-value x)
+        (b* (((mv sat ok &) (bfr-sat (bfr-not x))))
+          (if (or sat (not ok))
+              x
+            t))
+      x))
+
+  (local (in-theory (enable bfr-check-true)))
+
+  (defthm bfr-eval-of-bfr-check-true
+    (equal (bfr-eval (bfr-check-true x) env)
+           (bfr-eval x env))
+    :hints (("goal" :use ((:instance bfr-sat-unsat
+                           (prop x))
+                          (:instance bfr-sat-unsat
+                           (prop (bfr-not x)))))))
+
+  (defthm pbfr-depends-on-of-bfr-check-true
+    (implies (not (pbfr-depends-on k p x))
+             (not (pbfr-depends-on k p (bfr-check-true x))))))
+
+(defsection bfr-check-false
+  ;; Bfr-constcheck: use SAT (or examine the BDD) to determine whether x is
+  ;; constant, and if so return that constant.
+  (defund bfr-check-false (x)
+    (declare (xargs :guard t))
+    (if (bfr-known-value x)
+        x
+      (b* (((mv sat ok &) (bfr-sat x)))
+        (if (or sat (not ok))
+            x
+          nil))))
+
+  (local (in-theory (enable bfr-check-false)))
+
+  (defthm bfr-eval-of-bfr-check-false
+    (equal (bfr-eval (bfr-check-false x) env)
+           (bfr-eval x env))
+    :hints (("goal" :use ((:instance bfr-sat-unsat
+                           (prop x))
+                          (:instance bfr-sat-unsat
+                           (prop (bfr-not x)))))))
+
+  (defthm pbfr-depends-on-of-bfr-check-false
+    (implies (not (pbfr-depends-on k p x))
+             (not (pbfr-depends-on k p (bfr-check-false x))))))
+
diff -Nru acl2-6.2/books/centaur/gl/bfr-satlink.acl2 acl2-6.3/books/centaur/gl/bfr-satlink.acl2
--- acl2-6.2/books/centaur/gl/bfr-satlink.acl2	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bfr-satlink.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (set-waterfall-parallelism nil)
 
diff -Nru acl2-6.2/books/centaur/gl/bfr-satlink.lisp acl2-6.3/books/centaur/gl/bfr-satlink.lisp
--- acl2-6.2/books/centaur/gl/bfr-satlink.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bfr-satlink.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,8 +1,30 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; bfr-satlink.lisp
+;
+; Original authors: Sol Swords <sswords@centtech.com>
+;                   Jared Davis <jared@centtech.com>
 
 (in-package "GL")
 
 (include-book "bfr-sat")
-(include-book "../aignet/aig-sat")
+(include-book "../aig/aig-sat")
 
 (encapsulate
   (((gl-satlink-config) => *))
@@ -24,22 +46,22 @@
    :bdd (mv nil nil nil) ;; fail
    :aig
    (b* (((mv status env)
-         (aignet::aig-sat prop :config (gl-satlink-config))))
+         (acl2::aig-sat prop :config (gl-satlink-config))))
      (case status
        (:sat (mv t t env))
        (:unsat (mv nil t nil))
        (t ;; failed
         (mv nil nil nil))))))
 
-(defmacro gl-satlink-mode ()
-  ":Doc-section ACL2::GL
-Use satlink to check AIGs in GL AIG mode~/
-Produces defattach events necessary to set the GL reasoning mode to use AIGs
-with Satlink.~/~/"
-  '(progn
-     (defattach bfr-mode bfr-aig)
-     (defattach bfr-counterex-mode bfr-counterex-alist)
-     (defattach (bfr-sat bfr-satlink)
-       :hints(("Goal" :in-theory (enable bfr-eval))))))
-
+(defsection gl-satlink-mode
+  :parents (modes reference)
+  :short "GL: Use AIGs as the Boolean function representation and @(see
+satlink) to solve queries."
+
+  (defmacro gl-satlink-mode ()
+    '(progn
+       (defattach bfr-mode bfr-aig)
+       (defattach bfr-counterex-mode bfr-counterex-alist)
+       (defattach (bfr-sat bfr-satlink)
+         :hints(("Goal" :in-theory (enable bfr-eval)))))))
 
diff -Nru acl2-6.2/books/centaur/gl/bfr.lisp acl2-6.3/books/centaur/gl/bfr.lisp
--- acl2-6.2/books/centaur/gl/bfr.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bfr.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,13 +1,36 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 (include-book "centaur/misc/universal-equiv" :dir :system)
+(include-book "centaur/misc/arith-equiv-defs" :dir :system)
+(include-book "centaur/ubdds/lite" :dir :system)
+(include-book "centaur/ubdds/param" :dir :system)
+(include-book "centaur/aig/misc" :dir :system)
+(local (include-book "centaur/aig/aig-vars" :dir :system))
+(local (include-book "centaur/misc/arith-equivs" :dir :system))
 
 (defstub bfr-mode () t)
 (defun bfr-aig () (declare (xargs :guard t)) t)
 (defun bfr-bdd () (declare (xargs :guard t)) nil)
 
-
 (defmacro bfr-case (&key aig bdd)
   `(if (bfr-mode)
        ,aig ,bdd))
@@ -17,15 +40,13 @@
 ;;     (if *experimental-aig-mode*
 ;;         ',aig ',bdd)))
 
-(include-book "centaur/ubdds/lite" :dir :system)
-(include-book "../aig/witness")
 
 (local (in-theory (enable booleanp)))
 
 ;; (defun bfr-p (x)
 ;;   (declare (xargs :guard t)
 ;;            (ignorable x))
-;;   (mbe :logic 
+;;   (mbe :logic
 ;;        (bfr-case :bdd (acl2::ubddp x) :aig t)
 ;;        :exec (or (booleanp x)
 ;;                  (bfr-case :bdd (acl2::ubddp x) :aig t))))
@@ -77,7 +98,7 @@
 ;;   `(let ,(bfr-fix-bindings vars)
 ;;      (declare (ignorable . ,vars))
 ;;      ,body))
-     
+
 
 (defun bfr-eval (x env)
   (declare (xargs :guard t))
@@ -130,7 +151,7 @@
 
 (defun bfr-binary-and (x y)
   (declare (xargs :guard t))
-  (mbe :logic 
+  (mbe :logic
        (bfr-case :bdd (acl2::q-binary-and x y)
                  :aig (acl2::aig-and x y))
        :exec
@@ -166,9 +187,9 @@
 (defun bfr-and-macro-logic-part (args)
   ;; Generates the :logic part for a bfr-and MBE call.
   (declare (xargs :mode :program))
-  (cond ((atom args) 
+  (cond ((atom args)
          t)
-        ((atom (cdr args)) 
+        ((atom (cdr args))
          (car args))
         (t
          `(bfr-binary-and ,(car args) ,(bfr-and-macro-logic-part (cdr args))))))
@@ -176,11 +197,11 @@
 (defun bfr-and-macro-exec-part (args)
   ;; Generates the :exec part for a bfr-and MBE call.
   (declare (xargs :mode :program))
-  (cond ((atom args) 
+  (cond ((atom args)
          t)
-        ((atom (cdr args)) 
+        ((atom (cdr args))
          (car args))
-        (t 
+        (t
          `(let ((bfr-and-x-do-not-use-elsewhere ,(car args)))
             (and bfr-and-x-do-not-use-elsewhere
                  (bfr-binary-and
@@ -238,7 +259,7 @@
   (cond ((and (or (quotep y) (atom y))
               (or (quotep z) (atom z)))
          `(bfr-ite-fn ,x ,y ,z))
-        (t 
+        (t
          `(mbe :logic (bfr-ite-fn ,x ,y ,z)
                :exec (let ((bfr-ite-x-do-not-use-elsewhere ,x))
                        (cond
@@ -285,20 +306,20 @@
 
 (defun bfr-or-macro-logic-part (args)
   (declare (xargs :mode :program))
-  (cond ((atom args) 
+  (cond ((atom args)
          nil)
-        ((atom (cdr args)) 
+        ((atom (cdr args))
          (car args))
         (t
          `(bfr-binary-or ,(car args) ,(bfr-or-macro-logic-part (cdr args))))))
 
 (defun bfr-or-macro-exec-part (args)
   (declare (xargs :mode :program))
-  (cond ((atom args) 
+  (cond ((atom args)
          nil)
-        ((atom (cdr args)) 
+        ((atom (cdr args))
          (car args))
-        (t 
+        (t
          `(let ((bfr-or-x-do-not-use-elsewhere ,(car args)))
             ;; We could be slightly more permissive and just check
             ;; for any non-nil atom here.  But it's probably faster
@@ -437,6 +458,17 @@
 (in-theory (disable bfr-set-var (bfr-set-var) bfr-eval))
 
 
+(defcong acl2::nat-equiv equal (bfr-var n) 1
+  :hints(("Goal" :in-theory (enable bfr-var))))
+
+(defcong acl2::nat-equiv equal (bfr-lookup n env) 1
+  :hints(("Goal" :in-theory (enable bfr-lookup))))
+
+(defcong acl2::nat-equiv equal (bfr-set-var n val env) 1
+  :hints(("Goal" :in-theory (enable bfr-set-var))))
+
+
+
 
 ;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ;; BFR reasoning clause processor
@@ -518,7 +550,7 @@
        nil
      (union-equal (collect-bfr-eval-vals (car clause) patterns)
                   (collect-bfr-eval-vals-list (cdr clause) patterns)))))
- 
+
 
 (include-book "tools/flag" :dir :system)
 (flag::make-flag collect-bfr-eval-vals-flag collect-bfr-eval-vals
@@ -649,7 +681,7 @@
 
 (defmacro bfr-reasoning (&key or-hint)
   `(if stable-under-simplificationp
-       (er-progn 
+       (er-progn
         ;; This just lets us collect the clauses on which this hint is used.
         ,'(assign bfr-eval-cp-clauses
                   (cons clause
@@ -668,7 +700,7 @@
                                  (:no-thanks t)))
                         cphint)))))
      (value nil)))
-    
+
 
 (defmacro bfr-reasoning-mode (flg)
   (if flg
@@ -735,6 +767,619 @@
 
 
 
+(defun bfr-to-param-space (p x)
+  (declare (xargs :guard t)
+           (ignorable p))
+  (bfr-case :bdd (acl2::to-param-space p x)
+            :aig (acl2::aig-restrict
+                  x (acl2::aig-extract-iterated-assigns-alist p 10))))
+
+(defun bfr-to-param-space-weak (p x)
+  (declare (xargs :guard t)
+           (ignorable p))
+  (bfr-case :bdd (acl2::to-param-space p x)
+            :aig x))
+
+(defun bfr-from-param-space (p x)
+  (declare (xargs :guard t)
+           (ignorable p))
+  (bfr-case :bdd (acl2::from-param-space p x)
+            :aig x))
+
+
+(defun bfr-param-env (p env)
+  (declare (xargs :guard t)
+           (ignorable p))
+  (bfr-case :bdd (acl2::param-env p env)
+            :aig env))
+
+(defthmd bfr-eval-to-param-space
+  (implies (bfr-eval p env)
+           (equal (bfr-eval (bfr-to-param-space p x)
+                            (bfr-param-env p env))
+                  (bfr-eval x env)))
+  :hints(("Goal" :in-theory (e/d* (bfr-eval
+                                   bfr-to-param-space
+                                   acl2::param-env-to-param-space)))))
+
+(defthm bfr-eval-to-param-space-weak
+  (implies (bfr-eval p env)
+           (equal (bfr-eval (bfr-to-param-space-weak p x)
+                            (bfr-param-env p env))
+                  (bfr-eval x env)))
+  :hints(("Goal" :in-theory (e/d* (bfr-eval
+                                   bfr-to-param-space-weak
+                                   acl2::param-env-to-param-space)))))
+
+
+(defthm bfr-eval-from-param-space
+  (implies (bfr-eval p env)
+           (equal (bfr-eval (bfr-from-param-space p x)
+                            env)
+                  (bfr-eval x (bfr-param-env p env))))
+  :hints(("Goal" :in-theory (e/d* (bfr-eval bfr-param-env
+                                   bfr-from-param-space
+                                   acl2::param-env-to-param-space)))))
+
+
+
+(defun bfr-unparam-env (p env)
+  (declare (xargs :guard t))
+  (bfr-case :bdd (acl2::unparam-env p env)
+            :aig (append (acl2::aig-extract-iterated-assigns-alist p 10)
+                         env)))
+
+(defthm bfr-eval-to-param-space-with-unparam-env
+  (equal (bfr-eval (bfr-to-param-space p x) env)
+         (bfr-eval x (bfr-unparam-env p env)))
+  :hints (("goal" :do-not-induct t
+           :in-theory (enable bfr-eval
+                              acl2::unparam-env-to-param-space)))
+  :otf-flg t)
+
+(local (defthm aig-eval-of-extract-iterated-assigns-self
+         (implies (acl2::aig-eval x env)
+                  (equal (acl2::aig-eval x
+                                         (append
+                                          (acl2::aig-extract-iterated-assigns-alist
+                                           x n)
+                                          env))
+                         t))))
+
+(defthm bfr-eval-to-param-space-weak-with-unparam-env
+  (implies (not (bfr-eval x (bfr-unparam-env x env)))
+           (not (bfr-eval (bfr-to-param-space-weak x x) env)))
+  :hints(("Goal" :in-theory (e/d (bfr-eval bfr-to-param-space-weak
+                                           acl2::unparam-env-to-param-space
+                                           bfr-unparam-env)
+                                 (acl2::eval-bdd acl2::aig-eval)))))
+
+
+
+(defthm bfr-unparam-env-of-param-env
+  (implies (bfr-eval p env)
+           (equal (bfr-eval x (bfr-unparam-env p (bfr-param-env p env)))
+                  (bfr-eval x env)))
+  :hints(("Goal" :in-theory (enable bfr-eval))))
+
+(defthm bfr-param-env-of-unparam-env-of-param-env
+  (implies (bfr-eval p env)
+           (equal (bfr-eval x (bfr-param-env
+                               p
+                               (bfr-unparam-env
+                                p
+                                (bfr-param-env p env))))
+                  (bfr-eval x (bfr-param-env p env))))
+  :hints(("Goal" :in-theory (disable bfr-param-env bfr-unparam-env
+                                     bfr-from-param-space)
+          :use ((:instance bfr-eval-from-param-space
+                 (env (bfr-unparam-env p (bfr-param-env p env))))))))
+
+(defthm bfr-lookup-of-unparam-env-of-param-env
+  (implies (bfr-eval p env)
+           (equal (bfr-lookup x (bfr-unparam-env p (bfr-param-env p env)))
+                  (bfr-lookup x env)))
+  :hints(("Goal" :use ((:instance bfr-unparam-env-of-param-env
+                        (x (bfr-var x))))
+          :in-theory (disable bfr-unparam-env-of-param-env))))
+
+(in-theory (disable bfr-to-param-space
+                    bfr-to-param-space-weak
+                    bfr-from-param-space
+                    bfr-unparam-env
+                    bfr-param-env))
+
+
+(defun-sk bfr-semantic-depends-on (k x)
+  (exists (env v)
+          (not (equal (bfr-eval x (bfr-set-var k v env))
+                      (bfr-eval x env)))))
+
+(defthm bfr-semantic-depends-on-of-set-var
+  (implies (not (bfr-semantic-depends-on k x))
+           (equal (bfr-eval x (bfr-set-var k v env))
+                  (bfr-eval x env))))
+
+(in-theory (disable bfr-semantic-depends-on
+                    bfr-semantic-depends-on-suff))
+
+(defund bfr-depends-on (k x)
+  (bfr-case :bdd (bfr-semantic-depends-on k x)
+            :aig (sets::in (nfix k) (acl2::aig-vars x))))
+
+(local (defthm aig-eval-under-env-with-non-aig-var-member
+         (implies (not (sets::in k (acl2::aig-vars x)))
+                  (equal (acl2::aig-eval x (cons (cons k v) env))
+                         (acl2::aig-eval x env)))
+         :hints(("Goal" :in-theory (enable acl2::aig-eval acl2::aig-vars)))))
+
+(defthm bfr-eval-of-set-non-dep
+  (implies (not (bfr-depends-on k x))
+           (equal (bfr-eval x (bfr-set-var k v env))
+                  (bfr-eval x env)))
+  :hints(("Goal" :in-theory (enable bfr-depends-on
+                                    bfr-semantic-depends-on-suff))
+         (and stable-under-simplificationp
+              '(:in-theory (enable bfr-eval bfr-set-var)))))
+
+;; (defthm bfr-eval-of-set-non-dep
+;;   (implies (not (bfr-depends-on k x))
+;;            (equal (bfr-eval x (bfr-set-var k v env))
+;;                   (bfr-eval x env)))
+;;   :hints(("Goal" :use bfr-depends-on-suff)))
+
+(defthm bfr-depends-on-of-bfr-var
+  (equal (bfr-depends-on m (bfr-var n))
+         (equal (nfix m) (nfix n)))
+  :hints(("goal" :in-theory (e/d (bfr-depends-on) (nfix)))
+         (cond ((member-equal '(bfr-mode) clause)
+                (and stable-under-simplificationp
+                     (if (eq (caar clause) 'not)
+                         '(:use ((:instance bfr-semantic-depends-on-suff
+                                  (k m) (x (bfr-var n))
+                                  (v (not (bfr-lookup n env)))))
+                           :in-theory (disable nfix))
+                       '(:expand ((bfr-semantic-depends-on m (bfr-var n)))))))
+               ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (e/d (bfr-depends-on bfr-var) (nfix))))))
+  :otf-flg t)
+
+(defthm no-new-deps-of-bfr-not
+  (implies (not (bfr-depends-on k x))
+           (not (bfr-depends-on k (bfr-not x))))
+  :hints(("goal" :in-theory (e/d (bfr-depends-on)))
+         (cond ((member-equal '(bfr-mode) clause)
+                '(:expand ((bfr-semantic-depends-on k (bfr-not x)))
+                  :use ((:instance bfr-semantic-depends-on-suff))))
+               ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (e/d (bfr-depends-on bfr-not)))))))
+
+(defthm no-new-deps-of-bfr-and
+  (implies (and (not (bfr-depends-on k x))
+                (not (bfr-depends-on k y)))
+           (not (bfr-depends-on k (bfr-binary-and x y))))
+  :hints(("goal" :in-theory (e/d (bfr-depends-on)))
+         (cond ((member-equal '(bfr-mode) clause)
+                '(:expand ((bfr-semantic-depends-on k (bfr-binary-and x y)))
+                  :use ((:instance bfr-semantic-depends-on-suff)
+                        (:instance bfr-semantic-depends-on-suff (x y)))))
+               ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (e/d (bfr-depends-on bfr-binary-and)))))))
+
+(defthm no-new-deps-of-bfr-or
+  (implies (and (not (bfr-depends-on k x))
+                (not (bfr-depends-on k y)))
+           (not (bfr-depends-on k (bfr-binary-or x y))))
+  :hints(("goal" :in-theory (e/d (bfr-depends-on)))
+         (cond ((member-equal '(bfr-mode) clause)
+                '(:expand ((bfr-semantic-depends-on k (bfr-binary-or x y)))
+                  :use ((:instance bfr-semantic-depends-on-suff)
+                        (:instance bfr-semantic-depends-on-suff (x y)))))
+               ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (e/d (bfr-depends-on bfr-binary-or acl2::aig-or)))))))
+
+(defthm no-new-deps-of-bfr-xor
+  (implies (and (not (bfr-depends-on k x))
+                (not (bfr-depends-on k y)))
+           (not (bfr-depends-on k (bfr-xor x y))))
+  :hints(("goal" :in-theory (e/d (bfr-depends-on)))
+         (cond ((member-equal '(bfr-mode) clause)
+                '(:expand ((bfr-semantic-depends-on k (bfr-xor x y)))
+                  :use ((:instance bfr-semantic-depends-on-suff)
+                        (:instance bfr-semantic-depends-on-suff (x y)))))
+               ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (e/d (bfr-depends-on bfr-xor acl2::aig-xor
+                                                  acl2::aig-or)))))))
+
+(defthm no-new-deps-of-bfr-iff
+  (implies (and (not (bfr-depends-on k x))
+                (not (bfr-depends-on k y)))
+           (not (bfr-depends-on k (bfr-iff x y))))
+  :hints(("goal" :in-theory (e/d (bfr-depends-on)))
+         (cond ((member-equal '(bfr-mode) clause)
+                '(:expand ((bfr-semantic-depends-on k (bfr-iff x y)))
+                  :use ((:instance bfr-semantic-depends-on-suff)
+                        (:instance bfr-semantic-depends-on-suff (x y)))))
+               ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (e/d (bfr-depends-on bfr-iff acl2::aig-iff
+                                                  acl2::aig-or)))))))
+
+(defthm no-new-deps-of-bfr-ite
+  (implies (and (not (bfr-depends-on k x))
+                (not (bfr-depends-on k y))
+                (not (bfr-depends-on k z)))
+           (not (bfr-depends-on k (bfr-ite-fn x y z))))
+  :hints(("goal" :in-theory (e/d (bfr-depends-on)))
+         (cond ((member-equal '(bfr-mode) clause)
+                '(:expand ((bfr-semantic-depends-on k (bfr-ite-fn x y z)))
+                  :use ((:instance bfr-semantic-depends-on-suff)
+                        (:instance bfr-semantic-depends-on-suff (x y))
+                        (:instance bfr-semantic-depends-on-suff (x z)))))
+               ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (e/d (bfr-depends-on bfr-ite-fn acl2::aig-ite
+                                                  acl2::aig-or)))))))
+
+(defthm no-deps-of-bfr-constants
+  (and (not (bfr-depends-on k t))
+       (not (bfr-depends-on k nil)))
+  :hints (("goal" :expand ((bfr-depends-on k nil)
+                           (bfr-depends-on k t)
+                           (bfr-semantic-depends-on k t)
+                           (bfr-semantic-depends-on k nil)))))
+
+
+
+(defun-sk pbfr-semantic-depends-on (k p x)
+  (exists (env v)
+          (and (bfr-eval p env)
+               (bfr-eval p (bfr-set-var k v env))
+               (not (equal (bfr-eval x (bfr-param-env p (bfr-set-var k v env)))
+                           (bfr-eval x (bfr-param-env p env)))))))
+
+
+(defthm pbfr-semantic-depends-on-of-set-var
+  (implies (and (not (pbfr-semantic-depends-on k p x))
+                (bfr-eval p env)
+                (bfr-eval p (bfr-set-var k v env)))
+           (equal (bfr-eval x (bfr-param-env p (bfr-set-var k v env)))
+                  (bfr-eval x (bfr-param-env p env)))))
+
+
+(in-theory (disable pbfr-semantic-depends-on
+                    pbfr-semantic-depends-on-suff))
+
+(defun pbfr-depends-on (k p x)
+  (bfr-case :bdd (pbfr-semantic-depends-on k p x)
+            :aig (bfr-depends-on k (bfr-from-param-space p x))))
+
+(in-theory (disable pbfr-depends-on))
+
+(defthm pbfr-eval-of-set-non-dep
+  (implies (and (not (pbfr-depends-on k p x))
+                (bfr-eval p env)
+                (bfr-eval p (bfr-set-var k v env)))
+           (equal (bfr-eval x (bfr-param-env p (bfr-set-var k v env)))
+                  (bfr-eval x (bfr-param-env p env))))
+  :hints (("goal" :in-theory (e/d (pbfr-depends-on)
+                                  (bfr-eval-of-set-non-dep))
+           :use ((:instance bfr-eval-of-set-non-dep
+                  (x (bfr-from-param-space p x)))))))
+
+(local (defthm non-var-implies-not-member-extract-assigns
+         (implies (not (sets::in v (acl2::aig-vars x)))
+                  (and (not (member v (mv-nth 0 (acl2::aig-extract-assigns x))))
+                       (not (member v (mv-nth 1 (acl2::aig-extract-assigns x))))))))
+
+(local (defthm non-var-implies-not-in-aig-extract-assigns-alist
+         (implies (not (sets::in v (acl2::aig-vars x)))
+                  (not (hons-assoc-equal v (acl2::aig-extract-assigns-alist x))))
+         :hints(("Goal" :in-theory (enable acl2::aig-extract-assigns-alist)))))
+
+(local (defthm non-var-implies-non-var-in-restrict-with-assigns-alist
+         (implies (not (sets::in v (acl2::aig-vars x)))
+                  (not (sets::in v (acl2::aig-vars
+                                    (acl2::aig-restrict
+                                     x (acl2::aig-extract-assigns-alist y))))))
+         :hints(("Goal" :in-theory (enable acl2::aig-restrict
+                                           acl2::aig-extract-assigns-alist-lookup-boolean)))))
+
+(local (defthm non-var-implies-not-in-aig-extract-iterated-assigns-alist
+         (implies (not (sets::in v (acl2::aig-vars x)))
+                  (not (hons-assoc-equal v (acl2::aig-extract-iterated-assigns-alist x clk))))
+         :hints(("Goal" :in-theory (enable
+                                    acl2::aig-extract-iterated-assigns-alist)))))
+
+(defthm non-var-implies-non-var-in-restrict-with-iterated-assigns-alist
+  (implies (not (sets::in v (acl2::aig-vars x)))
+           (not (sets::in v (acl2::aig-vars
+                             (acl2::aig-restrict
+                              x
+                              (acl2::aig-extract-iterated-assigns-alist
+                               y clk))))))
+  :hints(("Goal" :in-theory (e/d (acl2::aig-restrict
+                                  acl2::aig-extract-iterated-assigns-alist-lookup-boolean)
+                                 (acl2::aig-extract-iterated-assigns-alist)))))
+
+
+;; (encapsulate nil
+;;   (local (defun ind (x k env)
+;;            (if (or (atom x) (zp k))
+;;                env
+;;              (ind (if (car env) (car x) (cdr x)) (1- k) (cdr env)))))
+;;   (local (defthm eval-bdd-of-update-true
+;;            (implies (and (syntaxp (not (quotep v)))
+;;                          v)
+;;                     (equal (acl2::eval-bdd x (update-nth k v env))
+;;                            (acl2::eval-bdd x (update-nth k t env))))
+;;            :hints(("Goal" :in-theory (enable acl2::eval-bdd update-nth)
+;;                    :induct (ind x k env)))))
+
+;;   (defthmd bfr-semantic-depends-on-of-set-var-bdd
+;;     (implies (and (not (bfr-semantic-depends-on k x))
+;;                   (not (bfr-mode)))
+;;              (equal (acl2::eval-bdd x (update-nth k v env))
+;;                     (acl2::eval-bdd x env)))
+;;     :hints (("goal" :use bfr-semantic-depends-on-suff
+;;              :in-theory (e/d (bfr-eval bfr-set-var)
+;;                              (bfr-depends-on))))))
+
+(defthm pbfr-depends-on-of-bfr-var
+  (implies (and (not (bfr-depends-on m p))
+                (bfr-eval p env))
+           (equal (pbfr-depends-on m p (bfr-to-param-space p (bfr-var n)))
+                  (equal (nfix m) (nfix n))))
+  :hints(("Goal" :in-theory (e/d (pbfr-depends-on
+                                    bfr-depends-on)
+                                 (nfix))
+          :do-not-induct t)
+         (cond ((member-equal '(bfr-mode) clause)
+                (and stable-under-simplificationp
+                     (if (eq (caar (last clause)) 'not)
+                         `(:expand (,(cadar (last clause))))
+                       '(:use ((:instance pbfr-semantic-depends-on-of-set-var
+                                (k m) (x (bfr-to-param-space p (bfr-var n)))
+                                (v (not (bfr-lookup n env)))))
+                         :in-theory (disable pbfr-semantic-depends-on-of-set-var)))))
+               ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (enable bfr-to-param-space
+                                    bfr-from-param-space
+                                    bfr-var
+                                    acl2::aig-extract-iterated-assigns-alist-lookup-boolean)))))
+  :otf-flg t)
+
+
+(defthm pbfr-depends-on-of-constants
+  (and (not (pbfr-depends-on k p t))
+       (not (pbfr-depends-on k p nil)))
+  :hints (("goal" :in-theory (enable pbfr-depends-on
+                                     bfr-from-param-space
+                                     pbfr-semantic-depends-on))))
+
+(defthm no-new-deps-of-pbfr-not
+  (implies (not (pbfr-depends-on k p x))
+           (not (pbfr-depends-on k p (bfr-not x))))
+  :hints(("Goal" :in-theory (enable pbfr-depends-on
+                                    bfr-depends-on))
+         (cond ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (enable bfr-from-param-space bfr-not) ))
+               ((member-equal '(bfr-mode) clause)
+                '(:expand ((pbfr-semantic-depends-on k p (bfr-not x))))))))
+
+
+(defthm no-new-deps-of-pbfr-and
+  (implies (and (not (pbfr-depends-on k p x))
+                (not (pbfr-depends-on k p y)))
+           (not (pbfr-depends-on k p (bfr-binary-and x y))))
+  :hints(("Goal" :in-theory (enable pbfr-depends-on
+                                    bfr-depends-on))
+         (cond ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (enable bfr-from-param-space bfr-binary-and) ))
+               ((member-equal '(bfr-mode) clause)
+                '(:expand ((pbfr-semantic-depends-on k p (bfr-binary-and x y))))))))
+
+(defthm no-new-deps-of-pbfr-or
+  (implies (and (not (pbfr-depends-on k p x))
+                (not (pbfr-depends-on k p y)))
+           (not (pbfr-depends-on k p (bfr-binary-or x y))))
+  :hints(("Goal" :in-theory (enable pbfr-depends-on
+                                    bfr-depends-on))
+         (cond ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (enable bfr-from-param-space bfr-binary-or acl2::aig-or)))
+               ((member-equal '(bfr-mode) clause)
+                '(:expand ((pbfr-semantic-depends-on k p (bfr-binary-or x y))))))))
+
+(defthm no-new-deps-of-pbfr-xor
+  (implies (and (not (pbfr-depends-on k p x))
+                (not (pbfr-depends-on k p y)))
+           (not (pbfr-depends-on k p (bfr-xor x y))))
+  :hints(("Goal" :in-theory (enable pbfr-depends-on
+                                    bfr-depends-on))
+         (cond ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (enable bfr-from-param-space bfr-xor acl2::aig-xor
+                                     acl2::aig-or)))
+               ((member-equal '(bfr-mode) clause)
+                '(:expand ((pbfr-semantic-depends-on k p (bfr-xor x y))))))))
+
+(defthm no-new-deps-of-pbfr-iff
+  (implies (and (not (pbfr-depends-on k p x))
+                (not (pbfr-depends-on k p y)))
+           (not (pbfr-depends-on k p (bfr-iff x y))))
+  :hints(("Goal" :in-theory (enable pbfr-depends-on
+                                    bfr-depends-on))
+         (cond ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (enable bfr-from-param-space bfr-iff acl2::aig-iff
+                                     acl2::aig-or)))
+               ((member-equal '(bfr-mode) clause)
+                '(:expand ((pbfr-semantic-depends-on k p (bfr-iff x y))))))))
+
+(defthm no-new-deps-of-pbfr-ite
+  (implies (and (not (pbfr-depends-on k p x))
+                (not (pbfr-depends-on k p y))
+                (not (pbfr-depends-on k p z)))
+           (not (pbfr-depends-on k p (bfr-ite-fn x y z))))
+  :hints(("Goal" :in-theory (enable pbfr-depends-on
+                                    bfr-depends-on))
+         (cond ((member-equal '(not (bfr-mode)) clause)
+                '(:in-theory (enable bfr-from-param-space bfr-ite-fn acl2::aig-ite
+                                     acl2::aig-or)))
+               ((member-equal '(bfr-mode) clause)
+                '(:expand ((pbfr-semantic-depends-on k p (bfr-ite-fn x y z))))))))
+
+(defthm pbfr-depends-on-when-booleanp
+  (implies (booleanp y)
+           (not (pbfr-depends-on k p y)))
+  :hints(("Goal" :in-theory (enable booleanp)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+
+
+
+
+
+
+
+;; (defund ubdd-deps-to-nat-list (n deps)
+;;   (declare (xargs :guard (natp n)))
+;;   (if (atom deps)
+;;       nil
+;;     (if (car deps)
+;;         (cons n (ubdd-deps-to-nat-list (+ 1 n) (cdr deps)))
+;;       (ubdd-deps-to-nat-list (+ 1 n) (cdr deps)))))
+
+
+;; (encapsulate nil
+;;   (local (include-book "arithmetic/top-with-meta" :dir :system))
+;;   (defthm member-of-ubdd-deps-to-nat-list
+;;     (implies (integerp n)
+;;              (iff (member m (ubdd-deps-to-nat-list n deps))
+;;                   (and (integerp m)
+;;                        (<= n m)
+;;                        (nth (- m n) deps))))
+;;     :hints (("goal" :induct (ubdd-deps-to-nat-list n deps)
+;;              :in-theory (enable ubdd-deps-to-nat-list natp posp)))))
+
+
+;; (defun bfr-deps (x)
+;;   (declare (xargs :guard t))
+;;   (bfr-case :bdd (ubdd-deps-to-nat-list 0 (acl2::ubdd-deps x))
+;;             :aig (acl2::aig-vars x)))
+
+;; (local (defthm aig-eval-acons-when-not-in-vars
+;;          (implies (not (member k (acl2::aig-vars x)))
+;;                   (equal (acl2::aig-eval x (cons (cons k v) env))
+;;                          (acl2::aig-eval x env)))))
+
+;; (defund bfr-depends-on (k x)
+;;   (declare (xargs :guard (natp k)))
+;;   (consp (member (lnfix k) (bfr-deps x))))
+
+;; (local (defthm consp-member
+;;          (iff (consp (member k x))
+;;               (member k x))))
+
+;; (defthm bfr-eval-of-set-non-dep
+;;   (implies (not (bfr-depends-on k x))
+;;            (equal (bfr-eval x (bfr-set-var k v env))
+;;                   (bfr-eval x env)))
+;;   :hints(("Goal" :in-theory (e/d (bfr-eval
+;;                                   bfr-set-var
+;;                                   bfr-depends-on)
+;;                                  (update-nth)))))
+
+;; (defthm bfr-depends-on-of-bfr-var
+;;   (equal (bfr-depends-on m (bfr-var n))
+;;          (equal (nfix m) (nfix n)))
+;;   :hints(("Goal" :in-theory (e/d (bfr-depends-on bfr-var)
+;;                                  ((bfr-deps))))))
+
+;; (local
+;;  #!acl2
+;;  (progn
+;;    (defthm aig-vars-of-aig-not
+;;      (equal (aig-vars (aig-not x))
+;;             (aig-vars x))
+;;      :hints(("Goal" :in-theory (enable aig-not))))
+
+;;    (defthm aig-vars-of-aig-and
+;;      (implies (and (not (member v (aig-vars x)))
+;;                    (not (member v (aig-vars y))))
+;;               (not (member v (aig-vars (aig-and x y)))))
+;;      :hints(("Goal" :in-theory (enable aig-and))))
+
+;;    (defthm aig-vars-of-aig-or
+;;      (implies (and (not (member v (aig-vars x)))
+;;                    (not (member v (aig-vars y))))
+;;               (not (member v (aig-vars (aig-or x y)))))
+;;      :hints(("Goal" :in-theory (enable aig-or))))
+
+;;    (defthm aig-vars-of-aig-xor
+;;      (implies (and (not (member v (aig-vars x)))
+;;                    (not (member v (aig-vars y))))
+;;               (not (member v (aig-vars (aig-xor x y)))))
+;;      :hints(("Goal" :in-theory (enable aig-xor))))
+
+;;    (defthm aig-vars-of-aig-iff
+;;      (implies (and (not (member v (aig-vars x)))
+;;                    (not (member v (aig-vars y))))
+;;               (not (member v (aig-vars (aig-iff x y)))))
+;;      :hints(("Goal" :in-theory (enable aig-iff))))
+
+;;    (defthm aig-vars-of-aig-ite
+;;      (implies (and (not (member v (aig-vars x)))
+;;                    (not (member v (aig-vars y)))
+;;                    (not (member v (aig-vars z))))
+;;               (not (member v (aig-vars (aig-ite x y z)))))
+;;      :hints(("Goal" :in-theory (enable aig-ite))))))
+
+;; (defthm no-new-deps-of-bfr-not
+;;   (implies (not (bfr-depends-on k x))
+;;            (not (bfr-depends-on k (bfr-not x))))
+;;   :hints(("Goal" :in-theory (e/d (bfr-depends-on bfr-not)
+;;                                  (nth)))))
+
+;; (defthm no-new-deps-of-bfr-and
+;;   (implies (and (not (bfr-depends-on k x))
+;;                 (not (bfr-depends-on k y)))
+;;            (not (bfr-depends-on k (bfr-binary-and x y))))
+;;   :hints(("Goal" :in-theory (e/d (bfr-depends-on bfr-binary-and)
+;;                                  (nth)))))
+
+;; (defthm no-new-deps-of-bfr-or
+;;   (implies (and (not (bfr-depends-on k x))
+;;                 (not (bfr-depends-on k y)))
+;;            (not (bfr-depends-on k (bfr-binary-or x y))))
+;;   :hints(("Goal" :in-theory (e/d (bfr-depends-on bfr-binary-or)
+;;                                  (nth)))))
+
+;; (defthm no-new-deps-of-bfr-xor
+;;   (implies (and (not (bfr-depends-on k x))
+;;                 (not (bfr-depends-on k y)))
+;;            (not (bfr-depends-on k (bfr-xor x y))))
+;;   :hints(("Goal" :in-theory (e/d (bfr-depends-on bfr-xor)
+;;                                  (nth)))))
+
+;; (defthm no-new-deps-of-bfr-iff
+;;   (implies (and (not (bfr-depends-on k x))
+;;                 (not (bfr-depends-on k y)))
+;;            (not (bfr-depends-on k (bfr-iff x y))))
+;;   :hints(("Goal" :in-theory (e/d (bfr-depends-on bfr-iff)
+;;                                  (nth)))))
+
+;; (defthm no-new-deps-of-bfr-ite
+;;   (implies (and (not (bfr-depends-on k x))
+;;                 (not (bfr-depends-on k y))
+;;                 (not (bfr-depends-on k z)))
+;;            (not (bfr-depends-on k (bfr-ite-fn x y z))))
+;;   :hints(("Goal" :in-theory (e/d (bfr-depends-on bfr-ite-fn)
+;;                                  (nth)))))
+
+;; (defthm no-deps-of-bfr-constants
+;;   (and (not (bfr-depends-on k t))
+;;        (not (bfr-depends-on k nil)))
+;;   :hints(("Goal" :in-theory (e/d (bfr-depends-on) ((bfr-deps))))))
+
+
 
 
 
@@ -793,3 +1438,432 @@
 ;;                                 (w state)))))
 
 
+
+
+
+
+;; Could just be done on trees but this makes the proofs easier (?)
+;; This returns one plus the maximum natural number present -- this way it's
+;; similar to the BDD lib's MAX-DEPTH.
+;; (defund aig-max-nat (x)
+;;   (declare (xargs :guard t))
+;;   (cond ((natp x) (+ 1 x))
+;;         ((atom x) 0)
+;;         ((not (cdr x)) (aig-max-nat (car x)))
+;;         (t (max (aig-max-nat (car x))
+;;                 (aig-max-nat (cdr x))))))
+
+;; (local
+;;  (progn
+;;    (defthm aig-eval-of-acons-max-nat
+;;      (implies (and (<= (aig-max-nat x) var)
+;;                    (natp var))
+;;               (equal (acl2::aig-eval x (cons (cons var val) env))
+;;                      (acl2::aig-eval x env)))
+;;      :hints(("Goal" :in-theory (enable acl2::aig-eval aig-max-nat))))
+
+;;    (defthm aig-max-nat-of-aig-not
+;;      (equal (aig-max-nat (acl2::aig-not x))
+;;             (aig-max-nat x))
+;;      :hints(("Goal" :in-theory (enable acl2::aig-not aig-max-nat))))
+
+;;    ;; (defthm aig-max-nat-of-aig-and
+;;    ;;   (<= (aig-max-nat (acl2::aig-and x y)) (max (aig-max-nat x)
+;;    ;;                                              (aig-max-nat y)))
+;;    ;;   :hints(("Goal" :in-theory (enable acl2::aig-and aig-max-nat)))
+;;    ;;   :rule-classes (:rewrite :linear))
+
+;;    (defthm gte-aig-max-nat-of-and
+;;      (implies (and (<= (aig-max-nat x) n)
+;;                    (<= (aig-max-nat y) n))
+;;               (<= (aig-max-nat (acl2::aig-and x y)) n))
+;;      :hints(("Goal" :in-theory (enable acl2::aig-and aig-max-nat)))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))
+
+;;    ;; (defthm aig-max-nat-of-aig-or
+;;    ;;   (<= (aig-max-nat (acl2::aig-or x y)) (max (aig-max-nat x)
+;;    ;;                                             (aig-max-nat y)))
+;;    ;;   :hints(("Goal" :in-theory (e/d (acl2::aig-or aig-max-nat))))
+;;    ;;   :rule-classes (:rewrite :linear))
+
+;;    (defthm gte-aig-max-nat-of-or
+;;      (implies (and (<= (aig-max-nat x) n)
+;;                    (<= (aig-max-nat y) n))
+;;               (<= (aig-max-nat (acl2::aig-or x y)) n))
+;;      :hints(("Goal" :in-theory (enable acl2::aig-or aig-max-nat)))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))
+
+
+;;    ;; (defthm aig-max-nat-of-aig-xor
+;;    ;;   (<= (aig-max-nat (acl2::aig-xor x y)) (max (aig-max-nat x)
+;;    ;;                                              (aig-max-nat y)))
+;;    ;;   :hints(("Goal" :in-theory (enable acl2::aig-xor aig-max-nat)
+;;    ;;           :do-not-induct t))
+;;    ;;   :rule-classes (:rewrite :linear))
+
+;;    (defthm gte-aig-max-nat-of-xor
+;;      (implies (and (<= (aig-max-nat x) n)
+;;                    (<= (aig-max-nat y) n))
+;;               (<= (aig-max-nat (acl2::aig-xor x y)) n))
+;;      :hints(("Goal" :in-theory (enable acl2::aig-xor aig-max-nat)))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))
+
+;;    (defthm gte-aig-max-nat-of-iff
+;;      (implies (and (<= (aig-max-nat x) n)
+;;                    (<= (aig-max-nat y) n))
+;;               (<= (aig-max-nat (acl2::aig-iff x y)) n))
+;;      :hints(("Goal" :in-theory (enable acl2::aig-iff aig-max-nat)))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))
+
+;;    (defthm gte-aig-max-nat-of-ite
+;;      (implies (and (<= (aig-max-nat x) n)
+;;                    (<= (aig-max-nat y) n)
+;;                    (<= (aig-max-nat z) n))
+;;               (<= (aig-max-nat (acl2::aig-ite x y z)) n))
+;;      :hints(("Goal" :in-theory (enable acl2::aig-ite aig-max-nat)))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))))
+
+
+;; (memoize 'aig-max-nat :condition '(and (consp x) (cdr x)))
+
+;; (local
+;;  (progn
+;;    (defun ind (x n env)
+;;          (if (zp n)
+;;              x
+;;            (if (car env)
+;;                (ind (car x) (1- n) (cdr env))
+;;              (ind (cdr x) (1- n) (cdr env)))))
+
+;;    (defthm eval-bdd-of-update-past-max-depth
+;;      (implies (<= (max-depth x) (nfix n))
+;;               (equal (acl2::eval-bdd x (update-nth n v env))
+;;                      (acl2::eval-bdd x env)))
+;;      :hints(("Goal" :expand ((:free (env) (acl2::eval-bdd x env))
+;;                              (max-depth x)
+;;                              (update-nth n v env))
+;;              :induct (ind x n env))))))
+
+;; (defund bfr-max-nat-var (x)
+;;   (declare (xargs :guard t))
+;;   (bfr-case :bdd (max-depth x)
+;;             :aig (aig-max-nat x)))
+
+;; (local (in-theory (enable bfr-max-nat-var)))
+
+
+;; (defthm bfr-eval-of-bfr-set-var-past-max-nat
+;;   (implies (and (<= (bfr-max-nat-var x) var)
+;;                 (natp var))
+;;            (equal (bfr-eval x (bfr-set-var var val env))
+;;                   (bfr-eval x env)))
+;;   :hints(("Goal" :in-theory (enable bfr-set-var bfr-eval))))
+
+
+
+;; (local
+;;  (progn
+;;    (include-book "arithmetic/top-with-meta" :dir :system)
+
+;;    (defthm max-plus
+;;      (equal (max (+ n x) (+ n y))
+;;             (+ n (max x y))))
+
+;;    (defthm max-assoc
+;;      (equal (max (max a b) c)
+;;             (max a (max b c))))
+
+;;    (defthm max-commute
+;;      (implies (and (rationalp a) (rationalp b))
+;;               (equal (max a b)
+;;                      (max b a)))
+;;      :rule-classes ((:rewrite :loop-stopper ((a b max)))))
+
+;;    (defthm max-commute-2
+;;      (implies (and (rationalp a) (rationalp b))
+;;               (equal (max a (max b c))
+;;                      (max b (max a c))))
+;;      :rule-classes ((:rewrite :loop-stopper ((a b max)))))
+
+;;    (defthm max-id
+;;      (equal (max x x) x))
+
+;;    (defthm max-id-2
+;;      (equal (max x (max x y)) (max x y)))
+
+;;    (defthm gt-max-implies
+;;      (equal (< (max a b) c)
+;;             (and (< a c)
+;;                  (< b c))))
+
+;;    (defthm lt-max-implies
+;;      (equal (< c (max a b))
+;;             (or (< c a)
+;;                 (< c b))))
+
+;;    (defthm gt-max-plus-1-implies
+;;      (equal (< (+ 1 (max a b)) c)
+;;             (and (< (+ 1 a) c)
+;;                  (< (+ 1 b) c))))
+
+;;    (defthm lt-max-plus-1-implies
+;;      (equal (< c (+ 1 (max a b)))
+;;             (or (< c (+ 1 a))
+;;                 (< c (+ 1 b)))))
+
+;;    (defun max-depth2-ind (x y n)
+;;      (declare (xargs :measure (+ (acl2-count x) (acl2-count y))))
+;;      (if (and (atom x) (atom y))
+;;          n
+;;        (list (max-depth2-ind (car x) (car y) (1- n))
+;;              (max-depth2-ind (cdr x) (cdr y) (1- n)))))
+
+;;    (defthm max-depth-of-q-not
+;;      (equal (max-depth (acl2::q-not x))
+;;             (max-depth x))
+;;      :hints(("Goal" :in-theory (enable acl2::q-not max-depth))))
+
+;;    (defthm max-depth-of-q-and
+;;      (implies (and (<= (max-depth x) n)
+;;                    (<= (max-depth y) n))
+;;               (<= (max-depth (acl2::q-and x y)) n))
+;;      :hints(("Goal" :in-theory (e/d (max-depth)
+;;                                     ((force) max))
+;;              :induct (max-depth2-ind x y n)
+;;              :expand ((acl2::q-and x y))))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))
+
+;;    (defthm max-depth-of-q-or
+;;      (implies (and (<= (max-depth x) n)
+;;                    (<= (max-depth y) n))
+;;               (<= (max-depth (acl2::q-or x y)) n))
+;;      :hints(("Goal" :in-theory (e/d (max-depth)
+;;                                     ((force) max))
+;;              :induct (max-depth2-ind x y n)
+;;              :expand ((acl2::q-or x y))))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))
+
+;;    (defthm max-depth-of-q-xor
+;;      (implies (and (<= (max-depth x) n)
+;;                    (<= (max-depth y) n))
+;;               (<= (max-depth (acl2::q-xor x y)) n))
+;;      :hints(("Goal" :in-theory (e/d (max-depth)
+;;                                     ((force) max))
+;;              :induct (max-depth2-ind x y n)
+;;              :expand ((acl2::q-binary-xor x y))))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))
+
+;;    (defthm max-depth-of-q-iff
+;;      (implies (and (<= (max-depth x) n)
+;;                    (<= (max-depth y) n))
+;;               (<= (max-depth (acl2::q-iff x y)) n))
+;;      :hints(("Goal" :in-theory (e/d (max-depth)
+;;                                     ((force) max))
+;;              :induct (max-depth2-ind x y n)
+;;              :expand ((acl2::q-binary-iff x y))))
+;;      :rule-classes (:rewrite
+;;                     (:linear :match-free :all)))))
+
+;; (local
+;;  (progn
+
+;;    (defun replace-if-equal (x y v)
+;;      (if (equal x y) v y))
+
+;;    (defthm q-ite-redef
+;;      (equal (acl2::q-ite-fn x y z)
+;;             (COND
+;;              ((NULL X) Z)
+;;              ((ATOM X) Y)
+;;              (T
+;;               (LET
+;;                ((Y (replace-if-equal x y t))
+;;                 (Z (replace-if-equal x z nil)))
+;;                (COND
+;;                 ((HONS-EQUAL Y Z) Y)
+;;                 ((AND (EQ Y T) (EQ Z NIL)) X)
+;;                 ((AND (EQ Y NIL) (EQ Z T))
+;;                  (ACL2::Q-NOT X))
+;;                 (T (ACL2::QCONS (ACL2::Q-ITE-FN (CAR X)
+;;                                                 (ACL2::QCAR Y)
+;;                                                 (ACL2::QCAR Z))
+;;                                 (ACL2::Q-ITE-FN (CDR X)
+;;                                                 (ACL2::QCDR Y)
+;;                                                 (ACL2::QCDR Z)))))))))
+;;      :hints(("Goal" :in-theory (e/d () ((force)))))
+;;      :rule-classes ((:definition :clique (acl2::q-ite-fn)
+;;                      :controller-alist ((acl2::q-ite-fn t nil nil)))))
+
+;;    (defun max-depth3-ind (x y z n)
+;;      (if (atom x)
+;;          (list y z n)
+;;        (list (max-depth3-ind (car x)
+;;                              (acl2::qcar (replace-if-equal x y t))
+;;                              (acl2::qcar (replace-if-equal x z nil))
+;;                              (1- n))
+;;              (max-depth3-ind (cdr x)
+;;                              (acl2::qcdr (replace-if-equal x y t))
+;;                              (acl2::qcdr (replace-if-equal x z nil))
+;;                              (1- n)))))
+
+;;    (defthm max-depth-of-qcar-replace-strong
+;;      (implies (and (consp y) (not (consp a)))
+;;               (< (max-depth (acl2::qcar (replace-if-equal x y a))) (max-depth y)))
+;;      :hints (("goal" :expand ((max-depth y)
+;;                               (max-depth a))))
+;;      :rule-classes :linear)
+
+;;    (defthm max-depth-of-qcdr-replace-strong
+;;      (implies (and (consp y) (not (consp a)))
+;;               (< (max-depth (acl2::qcdr (replace-if-equal x y a))) (max-depth y)))
+;;      :hints (("goal" :expand ((max-depth y)
+;;                               (max-depth a))))
+;;      :rule-classes :linear)
+
+;;    (defthm max-depth-of-qcar-replace-weak
+;;      (implies (not (consp a))
+;;               (<= (max-depth (acl2::qcar (replace-if-equal x y a))) (max-depth y)))
+;;      :hints (("goal" :expand ((max-depth y)
+;;                               (max-depth a))))
+;;      :rule-classes :linear)
+
+;;    (defthm max-depth-of-qcdr-replace-weak
+;;      (implies (not (consp a))
+;;               (<= (max-depth (acl2::qcdr (replace-if-equal x y a))) (max-depth y)))
+;;      :hints (("goal" :expand ((max-depth y)
+;;                               (max-depth a))))
+;;      :rule-classes :linear)
+
+;;    (defthm max-depth-of-qcar-replace-atom
+;;      (implies (and (not (consp y)) (not (consp a)))
+;;               (equal (max-depth (acl2::qcar (replace-if-equal x y a))) 0))
+;;      :hints (("goal" :expand ((max-depth y)
+;;                               (max-depth a)))))
+
+;;    (defthm max-depth-of-qcdr-replace-atom
+;;      (implies (and (not (consp y)) (not (consp a)))
+;;               (equal (max-depth (acl2::qcdr (replace-if-equal x y a))) 0))
+;;      :hints (("goal" :expand ((max-depth y)
+;;                               (max-depth a)))))
+
+;;    ;; (defthm max-depth-of-qcdr-strong
+;;    ;;   (implies (consp x)
+;;    ;;            (< (max-depth (acl2::qcdr x)) (max-depth x)))
+;;    ;;   :hints (("goal" :expand ((max-depth x))))
+;;    ;;   :rule-classes :linear)
+
+;;    ;; (defthm max-depth-of-qcdr-atom
+;;    ;;   (implies (not (consp x))
+;;    ;;            (equal (max-depth (acl2::qcdr x)) 0))
+;;    ;;   :hints (("goal" :expand ((max-depth x)))))
+
+;;    (defthm max-depth-of-replace-if-equal
+;;      (implies (not (consp a))
+;;               (<= (max-depth (replace-if-equal x y a)) (max-depth y)))
+;;      :hints (("goal" :expand ((max-depth a))))
+;;      :rule-classes :linear)
+
+;;    (local (in-theory (disable replace-if-equal acl2::qcar acl2::qcdr)))
+
+;;    (defthm max-depth-of-qcons
+;;      (implies (and (<= (max-depth x) (+ -1 n))
+;;                    (<= (max-depth y) (+ -1 n)))
+;;               (<= (max-depth (acl2::qcons x y)) n))
+;;      :hints(("Goal" :in-theory (enable acl2::qcons max-depth)))
+;;      :rule-classes ((:linear :trigger-terms ((max-depth (acl2::qcons x y)))
+;;                      :match-free :all)))
+
+
+;;    ;; (local (defthm qcar/cdr-when-consp
+;;    ;;          (implies (consp x)
+;;    ;;                   (and (equal (acl2::qcar x) (car x))
+;;    ;;                        (equal (acl2::qcdr x) (cdr x))))
+;;    ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+;;    ;; (local (defthm qcar/cdr-when-atom
+;;    ;;          (implies (not (consp x))
+;;    ;;                   (and (equal (acl2::qcar x) x)
+;;    ;;                        (equal (acl2::qcdr x) x)))
+;;    ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;;    (defthm max-depth-of-q-ite
+;;      (implies (and (<= (max-depth x) n)
+;;                    (<= (max-depth y) n)
+;;                    (<= (max-depth z) n))
+;;               (<= (max-depth (acl2::q-ite-fn x y z)) n))
+;;      :hints(("Goal" :in-theory (e/d (max-depth)
+;;                                     ((force) max acl2::qcar acl2::qcdr acl2::qcons))
+;;              :induct (max-depth3-ind x y z n)
+;;              :expand ((acl2::q-ite-fn x y z)))
+;;             (and stable-under-simplificationp
+;;                  '(:cases ((consp y))))
+;;             (and stable-under-simplificationp
+;;                  '(:cases ((consp z)))))
+;;      :rule-classes ((:rewrite)
+;;                     (:linear :match-free :all)))))
+
+;; (defthm bfr-max-nat-var-of-bfr-not
+;;   (equal (bfr-max-nat-var (bfr-not x))
+;;          (bfr-max-nat-var x))
+;;   :hints(("Goal" :in-theory (enable bfr-max-nat-var bfr-not))))
+
+;; (defthm bfr-max-nat-var-of-bfr-and
+;;   (implies (and (<= (bfr-max-nat-var x) n)
+;;                 (<= (bfr-max-nat-var y) n))
+;;            (<= (bfr-max-nat-var (bfr-binary-and x y)) n))
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var bfr-binary-and)
+;;                                  (max gt-max-implies gt-max-plus-1-implies))))
+;;   :rule-classes ((:rewrite)
+;;                  (:linear :match-free :all)))
+
+;; (defthm bfr-max-nat-var-of-bfr-or
+;;   (implies (and (<= (bfr-max-nat-var x) n)
+;;                 (<= (bfr-max-nat-var y) n))
+;;            (<= (bfr-max-nat-var (bfr-binary-or x y)) n))
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var bfr-binary-or)
+;;                                  (max gt-max-implies gt-max-plus-1-implies))))
+;;   :rule-classes ((:rewrite)
+;;                  (:linear :match-free :all)))
+
+;; (defthm bfr-max-nat-var-of-bfr-xor
+;;   (implies (and (<= (bfr-max-nat-var x) n)
+;;                 (<= (bfr-max-nat-var y) n))
+;;            (<= (bfr-max-nat-var (bfr-xor x y)) n))
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var bfr-xor)
+;;                                  (max gt-max-implies gt-max-plus-1-implies))))
+;;   :rule-classes ((:rewrite)
+;;                  (:linear :match-free :all)))
+
+;; (defthm bfr-max-nat-var-of-bfr-iff
+;;   (implies (and (<= (bfr-max-nat-var x) n)
+;;                 (<= (bfr-max-nat-var y) n))
+;;            (<= (bfr-max-nat-var (bfr-iff x y)) n))
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var bfr-iff)
+;;                                  (max gt-max-implies gt-max-plus-1-implies))))
+;;   :rule-classes (:rewrite
+;;                  (:linear :match-free :all)))
+
+;; (defthm bfr-max-nat-var-of-bfr-ite
+;;   (implies (and (<= (bfr-max-nat-var x) n)
+;;                 (<= (bfr-max-nat-var y) n)
+;;                 (<= (bfr-max-nat-var z) n))
+;;            (<= (bfr-max-nat-var (bfr-ite-fn x y z)) n))
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var bfr-ite-fn)
+;;                                  (max gt-max-implies gt-max-plus-1-implies))))
+;;   :rule-classes ((:rewrite)
+;;                  (:linear :match-free :all)))
+
+;; (defthm bfr-max-nat-var-of-consts
+;;   (and (equal (bfr-max-nat-var nil) 0)
+;;        (equal (bfr-max-nat-var t) 0))
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var)
+;;                                  ((bfr-max-nat-var))))))
+
+
diff -Nru acl2-6.2/books/centaur/gl/bvar-db.lisp acl2-6.3/books/centaur/gl/bvar-db.lisp
--- acl2-6.2/books/centaur/gl/bvar-db.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bvar-db.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,933 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "centaur/misc/arith-equiv-defs" :dir :system)
+(include-book "centaur/misc/absstobjs" :dir :system)
+;; (include-book "std/lists/index-of" :dir :system)
+(local (include-book "centaur/misc/arith-equivs" :dir :system))
+(local (include-book "std/lists/final-cdr" :dir :system))
+(local (include-book "std/lists/resize-list" :dir :system))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+(local (include-book "std/lists/nth" :dir :system))
+
+(local (in-theory (enable* acl2::arith-equiv-forwarding)))
+
+(local (in-theory (disable nth update-nth acl2::nth-when-zp)))
+
+
+;; ----------- Implementation ----------------
+;; The "terms" stored in the bvar-db$c are really g-apply objects
+(defstobj bvar-db$c
+  (base-bvar$c :type (integer 0 *) :initially 0)
+  (next-bvar$c :type (integer 0 *) :initially 0)
+  (bvar-terms$c :type (array t (0)) :resizable t)
+  (term-bvars$c :type t)
+  (term-equivs$c :type t))
+
+(defun get-term->bvar$c (x bvar-db$c)
+  (declare (xargs :stobjs bvar-db$c))
+  (cdr (hons-get x (term-bvars$c bvar-db$c))))
+
+(defun bvar-db-wfp$c (bvar-db$c)
+  (declare (xargs :stobjs bvar-db$c))
+  (and (<= (lnfix (base-bvar$c bvar-db$c))
+           (lnfix (next-bvar$c bvar-db$c)))
+       (<= (- (lnfix (next-bvar$c bvar-db$c))
+              (lnfix (base-bvar$c bvar-db$c)))
+           (bvar-terms$c-length bvar-db$c))))
+
+(defun get-bvar->term$c (n bvar-db$c)
+  (declare (type (integer 0 *) n)
+           (xargs :stobjs bvar-db$c
+                  :guard (and (<= (base-bvar$c bvar-db$c) n)
+                              (< n (next-bvar$c bvar-db$c))
+                              (bvar-db-wfp$c bvar-db$c))))
+  (bvar-terms$ci (- (lnfix n) (lnfix (base-bvar$c bvar-db$c))) bvar-db$c))
+
+(defcong acl2::nat-equiv equal (get-bvar->term$c n bvar-db$c) 1)
+
+(defun add-term-bvar$c (x bvar-db$c)
+  (declare (xargs :stobjs bvar-db$c
+                  :guard (bvar-db-wfp$c bvar-db$c)))
+  (b* ((next (the (integer 0 *) (lnfix (next-bvar$c bvar-db$c))))
+       (idx (the (integer 0 *) (lnfix (- next (lnfix (base-bvar$c bvar-db$c))))))
+       (terms-len (the (integer 0 *) (bvar-terms$c-length bvar-db$c)))
+       (bvar-db$c (if (mbe :logic (<= terms-len idx)
+                           :exec (int= terms-len idx))
+                      (resize-bvar-terms$c
+                       (max 16 (* 2 terms-len)) bvar-db$c)
+                    bvar-db$c))
+       (bvar-db$c (update-bvar-terms$ci idx x bvar-db$c))
+       (bvar-db$c (update-next-bvar$c (+ 1 next) bvar-db$c)))
+    (update-term-bvars$c
+     (hons-acons (hons-copy x) next (term-bvars$c bvar-db$c))
+     bvar-db$c)))
+
+(defthm get-term->bvar$c-of-add-term-bvar$c
+  (equal (get-term->bvar$c x (add-term-bvar$c y bvar-db$c))
+         (if (equal x y)
+             (nfix (next-bvar$c bvar-db$c))
+           (get-term->bvar$c x bvar-db$c))))
+
+(defthm term-equivs$c-of-add-term-bvar$c
+  (equal (term-equivs$c (add-term-bvar$c y bvar-db$c))
+         (term-equivs$c bvar-db$c)))
+
+(defthm get-bvar->term$c-of-add-term-bvar$c
+  (implies (and (<= (nfix (base-bvar$c bvar-db$c)) (nfix n))
+                (<= (nfix (base-bvar$c bvar-db$c))
+                    (nfix (next-bvar$c bvar-db$c))))
+           (equal (get-bvar->term$c n (add-term-bvar$c x bvar-db$c))
+                  (if (equal (nfix n) (nfix (next-bvar$c bvar-db$c)))
+                      x
+                    (get-bvar->term$c n bvar-db$c)))))
+
+
+
+(defthm base-bvar$c-of-add-term-bvar$c
+  (equal (nth *base-bvar$c* (add-term-bvar$c x bvar-db$c))
+         (nth *base-bvar$c* bvar-db$c)))
+
+(defthm next-bvar$c-of-add-term-bvar$c
+  (equal (nth *next-bvar$c* (add-term-bvar$c x bvar-db$c))
+         (+ 1 (nfix (nth *next-bvar$c* bvar-db$c)))))
+
+(defthm bvar-db-wfp$c-of-add-term-bvar$c
+  (implies (bvar-db-wfp$c bvar-db$c)
+           (bvar-db-wfp$c (add-term-bvar$c x bvar-db$c))))
+
+;; (defun add-term-equiv$c (x n bvar-db$c)
+;;   (declare (xargs :stobjs bvar-db$c
+;;                   :guard (and (integerp n)
+;;                               (<= (base-bvar$c bvar-db$c) n)
+;;                               (< n (next-bvar$c bvar-db$c))
+;;                               (bvar-db-wfp$c bvar-db$c))))
+;;   (b* ((term-equivs (term-equivs$c bvar-db$c)))
+;;     (update-term-equivs$c (hons-acons x (cons n (cdr (hons-get x term-equivs)))
+;;                                       term-equivs)
+;;                           bvar-db$c)))
+
+(defthm get-term->bvar$c-of-update-term-equivs$c
+  (equal (get-term->bvar$c x (update-term-equivs$c q bvar-db$c))
+         (get-term->bvar$c x bvar-db$c)))
+
+(defthm term-equivs$c-of-update-term-equivs$c
+  (equal (term-equivs$c (update-term-equivs$c q bvar-db$c))
+         q))
+;; (defthm get-term->bvar$c-of-add-term-equiv$c
+;;   (equal (get-term->bvar$c x (add-term-equiv$c y n bvar-db$c))
+;;          (get-term->bvar$c x bvar-db$c)))
+
+;; (defthm get-term->equivs$c-of-add-term-equiv$c
+;;   (equal (term-equivs$c (add-term-equiv$c y n bvar-db$c))
+;;          (hons-acons x (cons n (get-term->equivs$c x bvar-db$c))
+;;                      (term-equivs$c bvar-db$c))))
+
+
+(defthm get-bvar->term$c-of-update-term-equivs$c
+  (equal (get-bvar->term$c x (update-term-equivs$c q bvar-db$c))
+         (get-bvar->term$c x bvar-db$c)))
+
+(defthm base-bvar$c-of-update-term-equivs$c
+  (equal (nth *base-bvar$c* (update-term-equivs$c q bvar-db$c))
+         (nth *base-bvar$c* bvar-db$c)))
+
+(defthm next-bvar$c-of-update-term-equivs$c
+  (equal (nth *next-bvar$c* (update-term-equivs$c q bvar-db$c))
+         (nth *next-bvar$c* bvar-db$c)))
+
+
+(defthm bvar-db-wfp$c-of-update-term-equivs$c
+  (implies (bvar-db-wfp$c bvar-db$c)
+           (bvar-db-wfp$c (update-term-equivs$c q bvar-db$c))))
+
+
+
+;; (defthm get-bvar->term$c-of-add-term-equiv$c
+;;   (equal (get-bvar->term$c x (add-term-equiv$c y n bvar-db$c))
+;;          (get-bvar->term$c x bvar-db$c)))
+
+;; (defthm base-bvar$c-of-add-term-equiv$c
+;;   (equal (nth *base-bvar$c* (add-term-equiv$c x n bvar-db$c))
+;;          (nth *base-bvar$c* bvar-db$c)))
+
+;; (defthm next-bvar$c-of-add-term-equiv$c
+;;   (equal (nth *next-bvar$c* (add-term-equiv$c x n bvar-db$c))
+;;          (nth *next-bvar$c* bvar-db$c)))
+
+
+;; (defthm bvar-db-wfp$c-of-add-term-equiv$c
+;;   (implies (bvar-db-wfp$c bvar-db$c)
+;;            (bvar-db-wfp$c (add-term-equiv$c x n bvar-db$c))))
+
+
+
+(defun init-bvar-db$c (base-bvar bvar-db$c)
+  (declare (type (integer 0 *) base-bvar)
+           (xargs :stobjs bvar-db$c))
+  (b* ((bvar-db$c (update-base-bvar$c (lnfix base-bvar) bvar-db$c))
+       (bvar-db$c (update-next-bvar$c (lnfix base-bvar) bvar-db$c))
+       (bvar-db$c (update-term-equivs$c nil bvar-db$c)))
+    (update-term-bvars$c nil bvar-db$c)))
+
+(defthm base-bvar$c-of-init-bvar-db$c
+  (equal (nth *base-bvar$c* (init-bvar-db$c base bvar-db$c))
+         (nfix base)))
+
+(defthm term-equivs$c-of-init-bvar-db$c
+  (equal (term-equivs$c (init-bvar-db$c base-bvar bvar-db$c))
+         nil))
+
+(defthm next-bvar$c-of-init-bvar-db$c
+  (equal (nth *next-bvar$c* (init-bvar-db$c base bvar-db$c))
+         (nfix base)))
+
+(defthm get-term->bvar-of-init-bvar-db$c
+  (equal (get-term->bvar$c x (init-bvar-db$c base bvar-db$c))
+         nil))
+
+(defthm bvar-db-wfp$c-of-init-bvar-db$c
+  (bvar-db-wfp$c (init-bvar-db$c base bvar-db$c)))
+
+
+(defthm create-bvar-db$c-rewrite
+  (equal (create-bvar-db$c)
+         (init-bvar-db$c 0 '(0 0 nil nil nil))))
+
+(local (in-theory (disable (create-bvar-db$c) create-bvar-db$c)))
+
+
+(defund bvar-listp$c (x bvar-db$c)
+  (declare (xargs :stobjs bvar-db$c))
+  (if (atom x)
+      (eq x nil)
+    (and (natp (car x))
+         (<= (base-bvar$c bvar-db$c) (car x))
+         (< (car x) (next-bvar$c bvar-db$c))
+         (bvar-listp$c (cdr x) bvar-db$c))))
+
+(defund term-equivsp$c (equivs bvar-db$c)
+  (declare (xargs :stobjs bvar-db$c))
+  (if (atom equivs)
+      (eq equivs nil)
+    (and (consp (car equivs))
+         (bvar-listp$c (cdar equivs) bvar-db$c)
+         (term-equivsp$c (cdr equivs) bvar-db$c))))
+
+;; ------------------ Logic ----------------
+
+;; (encapsulate
+;;   ;; (((next-bvar$a *) => *
+;;   ;;   :formals (bvar-db$a)
+;;   ;;   :guard t)
+;;   ;;  ((base-bvar$a *) => *
+;;   ;;   :formals (bvar-db$a)
+;;   ;;   :guard t)
+;;   ;;  ((get-bvar->term$a * *) => *
+;;   ;;   :formals (n bvar-db$a)
+;;   ;;   :guard (and (natp n)
+;;   ;;               (<= (base-bvar$a bvar-db$a) n)
+;;   ;;               (< n (next-bvar$a bvar-db$a))))
+;;   ;;  ((get-term->bvar$a * *) => *
+;;   ;;   :formals (x bvar-db$a)
+;;   ;;   :guard t)
+;;   ;;  ((add-term-bvar$a * *) => *
+;;   ;;   :formals (x bvar-db$a)
+;;   ;;   :guard (not (get-term->bvar$a x bvar-db$a)))
+;;   ;;  ((init-bvar-db$a * *) => *
+;;   ;;   :formals (base bvar-db$a)
+;;   ;;   :guard (natp base)))
+
+;;   (defund init-bvar-db$a (base bvar-db$a)
+;;     (declare (ignore bvar-db$a))
+;;     (cons (nfix base) nil))
+
+;;   (defund base-bvar$a (bvar-db$a)
+;;     (nfix (car bvar-db$a)))
+
+;;   (defund next-bvar$a (bvar-db$a)
+;;     (+ (base-bvar$a bvar-db$a)
+;;        (len (cdr bvar-db$a))))
+
+;;   (defund get-bvar->term$a (n bvar-db$a)
+;;     (nth (- (nfix n) (base-bvar$a bvar-db$a))
+;;          (cdr bvar-db$a)))
+
+;;   (defund get-term->bvar$a (x bvar-db$a)
+;;     (let ((idx (acl2::index-of x (cdr bvar-db$a))))
+;;       (and idx (+ idx (base-bvar$a bvar-db$a)))))
+
+;;   (defund add-term-bvar$a (x bvar-db$a)
+;;     (cons (car bvar-db$a)
+;;           (append (cdr bvar-db$a) (list x))))
+
+;;   (local (in-theory (enable init-bvar-db$a
+;;                             base-bvar$a
+;;                             next-bvar$a
+;;                             get-bvar->term$a
+;;                             get-term->bvar$a
+;;                             add-term-bvar$a)))
+
+;;   (defthm type-of-base-bvar$a
+;;     (natp (base-bvar$a bvar-db$a))
+;;     :rule-classes :type-prescription)
+
+;;   (defthm type-of-next-bvar$a
+;;     (natp (next-bvar$a bvar-db$a))
+;;     :rule-classes :type-prescription)
+
+;;   (defthm type-of-get-term->bvar$a
+;;     (or (not (get-term->bvar$a x bvar-db$a))
+;;         (natp (get-term->bvar$a x bvar-db$a)))
+;;     :rule-classes :type-prescription)
+
+;;   (defthm next-bvar-gte-base-bvar$a
+;;     (<= (base-bvar$a bvar-db$a) (next-bvar$a bvar-db$a))
+;;     :rule-classes (:rewrite :linear))
+
+;;   (defthm term-bvar-gte-base-bvar$a
+;;     (implies (get-term->bvar$a x bvar-db$a)
+;;              (<= (base-bvar$a bvar-db$a)
+;;                  (get-term->bvar$a x bvar-db$a)))
+;;     :rule-classes (:rewrite :linear))
+
+;;   ;; this is probably derivable
+;;   (defthm term-bvar-less-than-next-bvar$a
+;;     (implies (get-term->bvar$a x bvar-db$a)
+;;              (< (get-term->bvar$a x bvar-db$a)
+;;                 (next-bvar$a bvar-db$a)))
+;;     :rule-classes (:rewrite :linear))
+
+;;   (defthm init-bvar-db$a-normalize
+;;     (implies (syntaxp (not (equal bvar-db$a ''nil)))
+;;              (equal (init-bvar-db$a base bvar-db$a)
+;;                     (init-bvar-db$a base nil))))
+
+;;   (defthm base-bvar-of-init-bvar-db$a
+;;     (equal (base-bvar$a (init-bvar-db$a base bvar-db$a))
+;;            (nfix base)))
+
+;;   (defthm next-bvar-of-init-bvar-db$a
+;;     (equal (next-bvar$a (init-bvar-db$a base bvar-db$a))
+;;            (nfix base)))
+
+;;   (defthm get-term->bvar-of-init-bvar-db$a
+;;     (equal (get-term->bvar$a x (init-bvar-db$a base bvar-db$a))
+;;            nil))
+
+;;   (defthm base-bvar$a-of-add-term-bvar$a
+;;     (equal (base-bvar$a (add-term-bvar$a x bvar-db$a))
+;;            (base-bvar$a bvar-db$a)))
+
+;;   (local (defthm len-append
+;;            (equal (len (append a b))
+;;                   (+ (len a) (len b)))))
+
+;;   (defthm next-bvar$a-of-add-term-bvar$a
+;;     (equal (next-bvar$a (add-term-bvar$a x bvar-db$a))
+;;            (+ 1 (next-bvar$a bvar-db$a))))
+
+;;   (defthm get-bvar->term$a-of-add-term-bvar$a-existing
+;;     (implies (and (<= (base-bvar$a bvar-db$a) (nfix n))
+;;                   (not (equal (nfix n) (next-bvar$a bvar-db$a))))
+;;              (equal (get-bvar->term$a n (add-term-bvar$a x bvar-db$a))
+;;                     (get-bvar->term$a n bvar-db$a))))
+
+;;   (defthm get-bvar->term$a-of-add-term-bvar$a-new
+;;     (implies (and (<= (base-bvar$a bvar-db$a) (nfix n))
+;;                   (equal (nfix n) (next-bvar$a bvar-db$a)))
+;;              (equal (get-bvar->term$a n (add-term-bvar$a x bvar-db$a))
+;;                     x)))
+
+;;   (defthm get-term->bvar$a-of-add-term-bvar$a-other
+;;     (implies (not (equal x y))
+;;              (equal (get-term->bvar$a y (add-term-bvar$a x bvar-db$a))
+;;                     (get-term->bvar$a y bvar-db$a)))
+;;     :hints(("Goal" :in-theory (enable acl2::index-of-append-split))))
+
+;;   (defthm get-term->bvar$a-of-add-term-bvar$a-new
+;;     (implies (not (get-term->bvar$a x bvar-db$a))
+;;              (equal (get-term->bvar$a x (add-term-bvar$a x bvar-db$a))
+;;                     (next-bvar$a bvar-db$a)))))
+
+(encapsulate
+  (((next-bvar$a *) => *
+    :formals (bvar-db$a)
+    :guard t)
+   ((base-bvar$a *) => *
+    :formals (bvar-db$a)
+    :guard t)
+   ((get-bvar->term$a * *) => *
+    :formals (n bvar-db$a)
+    :guard (and (natp n)
+                (<= (base-bvar$a bvar-db$a) n)
+                (< n (next-bvar$a bvar-db$a))))
+   ((get-term->bvar$a * *) => *
+    :formals (x bvar-db$a)
+    :guard t)
+   ((add-term-bvar$a * *) => *
+    :formals (x bvar-db$a)
+    :guard t)
+   ((term-equivs$a *) => *
+    :formals (bvar-db$a)
+    :guard t)
+   ((bvar-listp$a * *) => *
+    :formals (x bvar-db$a)
+    :guard t)
+   ((term-equivsp$a * *) => *
+    :formals (equivs bvar-db$a)
+    :guard t)
+   ((update-term-equivs$a * *) => *
+    :formals (equivs bvar-db$a)
+    :guard (term-equivsp$a equivs bvar-db$a))
+   ((init-bvar-db$a * *) => *
+    :formals (base bvar-db$a)
+    :guard (natp base)))
+
+  (local
+   (progn
+     
+
+     (defund init-bvar-db$a (base bvar-db$a)
+       (declare (ignore bvar-db$a)
+                (xargs :guard t))
+       (cons (nfix base) nil))
+
+     (defund base-bvar$a (bvar-db$a)
+       (declare (xargs :guard t))
+       (nfix (acl2::final-cdr (ec-call (car bvar-db$a)))))
+
+     (defund next-bvar$a (bvar-db$a)
+       (declare (xargs :guard t))
+       (+ (base-bvar$a bvar-db$a) (len (ec-call (car bvar-db$a)))))
+     
+     (defund filter-bvars (x bvar-db$a)
+       (declare (xargs :guard t))
+       (if (atom x)
+           nil
+         (if (and (natp (car x))
+                  (<= (base-bvar$a bvar-db$a) (car x))
+                  (< (car x) (next-bvar$a bvar-db$a)))
+             (cons (car x) (filter-bvars (cdr x) bvar-db$a))
+           (filter-bvars (cdr x) bvar-db$a))))
+
+     (defund filter-equivs (x bvar-db$a)
+       (declare (xargs :guard t))
+       (if (atom x)
+           nil
+         (if (consp (car x))
+             (cons (cons (caar x) (filter-bvars (cdar x) bvar-db$a))
+                   (filter-equivs (cdr x) bvar-db$a))
+           (filter-equivs (cdr x) bvar-db$a))))
+
+     (defund get-bvar->term$a (n bvar-db$a)
+       (declare (xargs :guard (and (natp n)
+                                   (<= (base-bvar$a bvar-db$a) n)
+                                   (< n (next-bvar$a bvar-db$a)))))
+       (and (< (nfix n) (next-bvar$a bvar-db$a))
+            (ec-call (nth (+ -1 (len (ec-call (car bvar-db$a))) (base-bvar$a bvar-db$a) (- (nfix n) ))
+                          (ec-call (car bvar-db$a))))))
+
+     (defund term-equivs$a (bvar-db$a)
+       (declare (xargs :guard t))
+       (filter-equivs (ec-call (cdr bvar-db$a)) bvar-db$a))
+
+     
+     (defund bvar-listp$a (x bvar-db$a)
+       (declare (xargs :guard t))
+       (if (atom x)
+           (eq x nil)
+         (and (natp (car x))
+              (<= (base-bvar$a bvar-db$a) (car x))
+              (< (car x) (next-bvar$a bvar-db$a))
+              (bvar-listp$a (cdr x) bvar-db$a))))
+
+     (defund term-equivsp$a (equivs bvar-db$a)
+       (declare (xargs :guard t))
+       (if (atom equivs)
+           (eq equivs nil)
+         (and (consp (car equivs))
+              (bvar-listp$a (cdar equivs) bvar-db$a)
+              (term-equivsp$a (cdr equivs) bvar-db$a))))
+
+     (defund update-term-equivs$a (equivs bvar-db$a)
+       (declare (xargs :guard (term-equivsp$a equivs bvar-db$a)))
+       (cons (ec-call (car bvar-db$a))
+             (filter-equivs equivs bvar-db$a)))
+
+     (defund get-term->bvar$a (x bvar-db$a)
+       (declare (xargs :guard t))
+       (let ((suff (ec-call (member-equal x (ec-call (car bvar-db$a))))))
+         (and suff (+ -1 (len suff) (base-bvar$a bvar-db$a)))))
+
+     (defund add-term-bvar$a (x bvar-db$a)
+       (declare (xargs :guard t))
+       (cons (cons x (ec-call (car bvar-db$a)))
+             (filter-equivs (ec-call (cdr bvar-db$a)) bvar-db$a)))))
+
+  (defthm bvar-listp$a-def
+    (equal (bvar-listp$a x bvar-db$a)
+           (if (atom x)
+               (eq x nil)
+             (and (natp (car x))
+                  (<= (base-bvar$a bvar-db$a) (car x))
+                  (< (car x) (next-bvar$a bvar-db$a))
+                  (bvar-listp$a (cdr x) bvar-db$a))))
+    :hints(("Goal" :in-theory (enable bvar-listp$a)))
+    :rule-classes ((:definition :controller-alist ((bvar-listp$a t nil)))))
+
+  (defthm term-equivsp$a-def
+    (equal (term-equivsp$a equivs bvar-db$a)
+           (if (atom equivs)
+               (eq equivs nil)
+             (and (consp (car equivs))
+                  (bvar-listp$a (cdar equivs) bvar-db$a)
+                  (term-equivsp$a (cdr equivs) bvar-db$a))))
+    :hints(("Goal" :in-theory (enable term-equivsp$a)))
+    :rule-classes ((:definition :controller-alist ((term-equivsp$a t nil)))))
+           
+
+  (local (in-theory (enable init-bvar-db$a
+                            base-bvar$a
+                            next-bvar$a
+                            get-bvar->term$a
+                            get-term->bvar$a
+                            add-term-bvar$a
+                            term-equivs$a
+                            update-term-equivs$a)))
+
+  (defcong acl2::nat-equiv equal (get-bvar->term$a n bvar-db$a) 1)
+  (defcong acl2::nat-equiv equal (init-bvar-db$a n bvar-db$a) 1)
+
+  (defthm type-of-base-bvar$a
+    (natp (base-bvar$a bvar-db$a))
+    :rule-classes :type-prescription)
+
+  (defthm type-of-next-bvar$a
+    (natp (next-bvar$a bvar-db$a))
+    :rule-classes :type-prescription)
+
+  (local (defthm equal-len-0
+           (equal (equal (len x) 0)
+                  (not (consp x)))))
+
+  (defthm type-of-get-term->bvar$a
+    (or (not (get-term->bvar$a x bvar-db$a))
+        (natp (get-term->bvar$a x bvar-db$a)))
+    :rule-classes :type-prescription)
+
+  (local (defthm bvar-listp$a-of-filter-bvars
+           (bvar-listp$a (filter-bvars x bvar-db$a) bvar-db$a)
+           :hints(("Goal" :in-theory (enable filter-bvars)))))
+
+  (local (defthm nat-listp-of-filter-bvars
+           (acl2::nat-listp (filter-bvars x bvar-db$a))
+           :hints(("Goal" :in-theory (enable filter-bvars)))))
+
+  (local (defthm term-equivsp$a-of-filter-equivs
+           (term-equivsp$a (filter-equivs x bvar-db$a) bvar-db$a)
+           :hints(("Goal" :in-theory (enable filter-equivs)))))
+
+  (local (defthm lookup-of-filter-equivs
+           (equal (cdr (hons-assoc-equal x (filter-equivs y bvar-db$a)))
+                  (filter-bvars (cdr (hons-assoc-equal x y)) bvar-db$a))
+           :hints(("Goal" :in-theory (enable filter-equivs)
+                   :induct t)
+                  (and stable-under-simplificationp
+                       '(:in-theory (enable filter-bvars))))))
+
+  (defthm next-bvar-gte-base-bvar$a
+    (<= (base-bvar$a bvar-db$a) (next-bvar$a bvar-db$a))
+    :rule-classes (:rewrite :linear))
+
+  (defthm term-bvar-gte-base-bvar$a
+    (implies (get-term->bvar$a x bvar-db$a)
+             (<= (base-bvar$a bvar-db$a)
+                 (get-term->bvar$a x bvar-db$a)))
+    :rule-classes (:rewrite :linear))
+
+  (local (defthm len-member
+           (<= (len (member x y)) (len y))
+           :rule-classes :linear))
+
+  (defthm term-bvar-less-than-next-bvar$a
+    (implies (get-term->bvar$a x bvar-db$a)
+             (< (get-term->bvar$a x bvar-db$a)
+                (next-bvar$a bvar-db$a)))
+    :rule-classes (:rewrite :linear))
+
+  (defthm term-equivsp$a-of-term-equivs$a
+    (term-equivsp$a (term-equivs$a bvar-db) bvar-db))
+
+  (defthm bvar-listp$a-of-lookup
+    (implies (term-equivsp$a q bvar-db$a)
+             (bvar-listp$a (cdr (hons-assoc-equal x q)) bvar-db$a)))
+
+  ;; (local (defun nth-filter-ind (n x bvar-db$a)
+  ;;          (if (atom x)
+  ;;              n
+  ;;            (nth-filter-ind (if (and (natp (car x))
+  ;;                                     (<= (base-bvar$a bvar-db$a) (car x))
+  ;;                                     (< (car x) (next-bvar$a bvar-db$a)))
+  ;;                                (1- n)
+  ;;                              n)
+  ;;                            (cdr x) bvar-db$a))))
+    
+
+  ;; (local (defthm nth-filter-bvars-gte-base-bvar$a
+  ;;          (implies (< (nfix n) (len (filter-bvars x bvar-db$a)))
+  ;;                   (<= (base-bvar$a bvar-db$a) (nth n (filter-bvars x bvar-db$a))))
+  ;;          :hints(("Goal" :in-theory (enable filter-bvars nth)
+  ;;                  :induct (nth-filter-ind n x bvar-db$a)))
+  ;;          :rule-classes :linear))
+
+  ;; (defthm term-equiv-gte-base-bvar$a
+  ;;   (implies (< (nfix n) (len (get-term->equivs$a x bvar-db$a)))
+  ;;            (<= (base-bvar$a bvar-db$a) (nth n (get-term->equivs$a x bvar-db$a))))
+  ;;          :rule-classes :linear)
+
+  ;; (local (defthm nth-filter-bvars-less-than-next-bvar$a
+  ;;          (implies (< (nfix n) (len (filter-bvars x bvar-db$a)))
+  ;;                   (< (nth n (filter-bvars x bvar-db$a)) (next-bvar$a bvar-db$a)))
+  ;;          :hints(("Goal" :in-theory (enable filter-bvars nth)
+  ;;                  :induct (nth-filter-ind n x bvar-db$a)))
+  ;;          :rule-classes :linear))
+
+  ;; (defthm term-equiv-less-than-next-bvar$a
+  ;;   (implies (< (nfix n) (len (get-term->equivs$a x bvar-db$a)))
+  ;;            (< (nth n (get-term->equivs$a x bvar-db$a)) (next-bvar$a bvar-db$a))))
+
+  (defthm init-bvar-db$a-normalize
+    (implies (syntaxp (not (equal bvar-db$a ''nil)))
+             (equal (init-bvar-db$a base bvar-db$a)
+                    (init-bvar-db$a base nil))))
+
+  (defthm base-bvar-of-init-bvar-db$a
+    (equal (base-bvar$a (init-bvar-db$a base bvar-db$a))
+           (nfix base)))
+
+  (defthm next-bvar-of-init-bvar-db$a
+    (equal (next-bvar$a (init-bvar-db$a base bvar-db$a))
+           (nfix base)))
+
+  (defthm get-term->bvar-of-init-bvar-db$a
+    (equal (get-term->bvar$a x (init-bvar-db$a base bvar-db$a))
+           nil))
+
+  (defthm term->equivs-of-init-bvar-db$a
+    (equal (term-equivs$a (init-bvar-db$a base bvar-db$a))
+           nil)
+    :hints(("Goal" :in-theory (enable filter-bvars filter-equivs))))
+
+  (defthm base-bvar$a-of-add-term-bvar$a
+    (equal (base-bvar$a (add-term-bvar$a x bvar-db$a))
+           (base-bvar$a bvar-db$a)))
+
+  (local (defthm len-append
+           (equal (len (append a b))
+                  (+ (len a) (len b)))))
+
+  (defthm base-bvar$a-of-update-term-equivs$a
+    (equal (base-bvar$a (update-term-equivs$a x bvar-db$a))
+           (base-bvar$a bvar-db$a)))
+
+  (defthm next-bvar$a-of-update-term-equivs$a
+    (equal (next-bvar$a (update-term-equivs$a x bvar-db$a))
+           (next-bvar$a bvar-db$a)))
+
+  (defthm get-term->bvar$a-of-update-term-equivs$a
+    (equal (get-term->bvar$a x (update-term-equivs$a q bvar-db$a))
+           (get-term->bvar$a x bvar-db$a)))
+
+  (defthm get-bvar->term$a-of-update-term-equivs$a
+    (equal (get-bvar->term$a x (update-term-equivs$a q bvar-db$a))
+           (get-bvar->term$a x bvar-db$a)))
+
+  (local (defthm filter-bvars-of-filter-bvars
+           (implies (equal (car db1) (car db2))
+                    (equal (filter-bvars (filter-bvars x db1) db2)
+                           (filter-bvars x db1)))
+           :hints(("Goal" :in-theory (enable base-bvar$a next-bvar$a
+                                             filter-bvars)))))
+
+  (local (defthm filter-bvars-when-bvar-listp$a
+           (implies (and (bvar-listp$a q bvar-db2)
+                         (equal (car bvar-db2) (car bvar-db$a)))
+                    (equal (filter-bvars q bvar-db$a)
+                           q))
+           :hints(("Goal" :in-theory (enable filter-bvars)))))
+
+  (local (defthm filter-equivs-when-term-equivsp$a
+           (implies (and (term-equivsp$a q bvar-db2)
+                         (equal (car bvar-db2) (car bvar-db$a)))
+                    (equal (filter-equivs q bvar-db$a)
+                           q))
+           :hints(("Goal" :in-theory (enable filter-equivs)))))
+
+  (defthm term-equivs-of-update-term-equiv1$a
+    (implies (term-equivsp$a q bvar-db$a)
+             (equal (term-equivs$a (update-term-equivs$a q bvar-db$a))
+                    q)))
+
+
+  ;; (local (defthm member-remove-duplicates
+  ;;          (iff (member k (remove-duplicates-equal x))
+  ;;               (member k x))))
+
+  (defthm next-bvar$a-of-add-term-bvar$a-split
+    (equal (next-bvar$a (add-term-bvar$a x bvar-db$a))
+           (+ 1 (next-bvar$a bvar-db$a))))
+
+  (local (defthm nth-of-cons
+           (equal (nth n (cons a b))
+                  (if (zp n) a
+                    (nth (1- n) b)))
+           :hints(("Goal" :in-theory (enable nth)))))
+
+  (defthm get-bvar->term$a-of-add-term-bvar$a-split
+    (implies (<= (base-bvar$a bvar-db$a) (nfix n))
+             (equal (get-bvar->term$a n (add-term-bvar$a x bvar-db$a))
+                    (if (equal (nfix n) (next-bvar$a bvar-db$a))
+                        x
+                      (get-bvar->term$a n bvar-db$a)))))
+
+  ;; (defthm get-bvar->term$a-of-add-term-bvar$a-existing
+  ;;   (implies (and (<= (base-bvar$a bvar-db$a) (nfix n))
+  ;;                 (not (equal (nfix n) (next-bvar$a bvar-db$a))))
+  ;;            (equal (get-bvar->term$a n (mv-nth 1 (add-term-bvar$a x bvar-db$a)))
+  ;;                   (get-bvar->term$a n bvar-db$a))))
+
+  ;; (defthm get-bvar->term$a-of-add-term-bvar$a-new
+  ;;   (implies (and (<= (base-bvar$a bvar-db$a) (nfix n))
+  ;;                 (equal (nfix n) (next-bvar$a bvar-db$a)))
+  ;;            (equal (get-bvar->term$a n (add-term-bvar$a x bvar-db$a))
+  ;;                   x)))
+
+  (defthm get-term->bvar$a-of-add-term-bvar$a-split
+    (equal (get-term->bvar$a y (add-term-bvar$a x bvar-db$a))
+           (if (equal x y)
+               (next-bvar$a bvar-db$a)
+             (get-term->bvar$a y bvar-db$a))))
+
+  (local (defthm filter-bvars-of-filter-bvars-cons
+           (equal (filter-bvars (filter-bvars x db1)
+                                (cons (cons y (car db1)) z))
+                  (filter-bvars x db1))
+           :hints(("Goal" :in-theory (enable base-bvar$a next-bvar$a
+                                             filter-bvars)))))
+
+  (local (defthm filter-equivs-of-filter-equivs-cons
+           (equal (filter-equivs (filter-equivs x db1)
+                                 (cons (cons y (car db1)) z))
+                  (filter-equivs x db1))
+           :hints(("Goal" :in-theory (enable base-bvar$a next-bvar$a
+                                             filter-equivs)))))
+
+  (defthm term-equivs-of-add-term-bvar$a
+    (equal (term-equivs$a (add-term-bvar$a x bvar-db$a))
+           (term-equivs$a bvar-db$a)))
+
+  (local (defthm len-of-member-bound
+           (<= (len (member x y)) (len y))
+           :rule-classes :linear))
+
+  (local (defthm consp-member-equal
+           (iff (consp (member-equal x y))
+                (member-equal x y))))
+
+  (local (defthm len-member-when-member
+           (implies (member x y)
+                    (< 0 (len (member x y))))
+           :rule-classes :linear))
+
+  (local (defthm nth-by-member
+           (implies (member x z)
+                    (equal (nth (+ (len z)
+                                   (- (len (member x z))))
+                                z)
+                           x))
+           :hints(("Goal" :in-theory (enable nth member)))))
+
+
+  (defthm get-bvar->term$a-of-get-term->bvar
+    (let ((bvar (get-term->bvar$a x bvar-db$a)))
+      (implies bvar
+               (equal (get-bvar->term$a bvar bvar-db$a)
+                      x))))
+
+  ;; (local (defthm no-duplicatesp-of-remove-duplicates
+  ;;          (no-duplicatesp (remove-duplicates-equal x))))
+
+  ;; (local (defthm len-member-nth-when-no-duplicates
+  ;;          (implies (and (< (nfix n) (len x))
+  ;;                        (no-duplicatesp x))
+  ;;                   (equal (len (member (nth n x) x))
+  ;;                          (- (len x) (nfix n))))
+  ;;          :hints(("Goal" :in-theory (enable nth)))))
+
+  (defthm get-term->bvar$a-of-get-bvar->term
+    (let ((term (get-bvar->term$a n bvar-db$a)))
+      (implies (and (<= (base-bvar$a bvar-db$a) (nfix n))
+                    (< (nfix n) (next-bvar$a bvar-db$a)))
+               (get-term->bvar$a term bvar-db$a)))))
+
+
+(defun create-bvar-db$a ()
+  (declare (xargs :guard t))
+  (init-bvar-db$a 0 nil))
+
+(defun bvar-db$ap (bvar-db$a)
+  (declare (ignore bvar-db$a)
+           (xargs :guard t))
+  t)
+
+
+(defun-sk bvar-dbs-terms-corr (bvar-db$c bvar-db$a)
+  (forall x
+          (and (equal (get-term->bvar$c x bvar-db$c)
+                      (get-term->bvar$a x bvar-db$a))
+               (equal (term-equivs$c bvar-db$c)
+                      (term-equivs$a bvar-db$a))))
+  :rewrite :direct)
+
+(defun-sk bvar-dbs-bvars-corr (bvar-db$c bvar-db$a)
+  (forall n
+          (implies (and (natp n)
+                        (<= (base-bvar$a bvar-db$a) n)
+                        (< n (next-bvar$a bvar-db$a)))
+                   (equal (get-bvar->term$c n bvar-db$c)
+                          (get-bvar->term$a n bvar-db$a))))
+  :rewrite :direct)
+
+(local (in-theory (disable bvar-dbs-terms-corr
+                           bvar-dbs-bvars-corr)))
+
+(defun-nx bvar-dbs-corr (bvar-db$c bvar-db$a)
+  (and (equal (base-bvar$c bvar-db$c) (base-bvar$a bvar-db$a))
+       (equal (next-bvar$c bvar-db$c) (next-bvar$a bvar-db$a))
+       (bvar-dbs-bvars-corr bvar-db$c bvar-db$a)
+       (bvar-dbs-terms-corr bvar-db$c bvar-db$a)
+       (bvar-db-wfp$c bvar-db$c)))
+
+(defthm bvar-listp$c-is-$a
+  (implies (and (bind-free '((bvar-db . bvar-db)) (bvar-db))
+                (equal (base-bvar$c bvar-db$c)
+                       (base-bvar$a bvar-db))
+                (equal (next-bvar$c bvar-db$c)
+                       (next-bvar$a bvar-db)))
+           (equal (bvar-listp$c x bvar-db$c)
+                  (bvar-listp$a x bvar-db)))
+  :hints (("goal" :induct (bvar-listp$c x bvar-db$c)
+           :in-theory (enable bvar-listp$c))))
+
+(defthm term-equivsp$c-is-$a
+  (implies (and (bind-free '((bvar-db . bvar-db)) (bvar-db))
+                (equal (base-bvar$c bvar-db$c)
+                       (base-bvar$a bvar-db))
+                (equal (next-bvar$c bvar-db$c)
+                       (next-bvar$a bvar-db)))
+           (equal (term-equivsp$c x bvar-db$c)
+                  (term-equivsp$a x bvar-db)))
+  :hints (("goal" :induct (term-equivsp$c x bvar-db$c)
+           :in-theory (enable term-equivsp$c))))
+
+
+(encapsulate nil
+  (local (set-default-hints
+          '((and stable-under-simplificationp
+                 (let ((lit (car (last clause))))
+                   (and (not (eq (car lit) 'equal))
+                        `(:expand (,lit))))))))
+
+  (local (in-theory (disable (init-bvar-db$c)
+                             init-bvar-db$c
+                             get-term->bvar$c
+                             add-term-bvar$c
+                             get-bvar->term$c
+                             update-term-equivs$c
+                             term-equivs$c)))
+
+  (acl2::defabsstobj-events bvar-db
+    :creator (create-bvar-db :logic create-bvar-db$a :exec create-bvar-db$c)
+    :recognizer (bvar-dbp :logic bvar-db$ap :exec bvar-db$cp)
+    :corr-fn bvar-dbs-corr
+    :exports ((base-bvar :logic base-bvar$a :exec base-bvar$c)
+              (next-bvar :logic next-bvar$a :exec next-bvar$c)
+              (get-term->bvar :logic get-term->bvar$a :exec get-term->bvar$c)
+              (get-bvar->term :logic get-bvar->term$a :exec get-bvar->term$c)
+              (term-equivs :logic term-equivs$a :exec term-equivs$c)
+              (bvar-listp :logic bvar-listp$a :exec bvar-listp$c)
+              (term-equivsp :logic term-equivsp$a :exec term-equivsp$c)
+              (add-term-bvar :logic add-term-bvar$a :exec add-term-bvar$c :protect t)
+              (update-term-equivs :logic update-term-equivs$a :exec update-term-equivs$c)
+              (init-bvar-db :logic init-bvar-db$a :exec init-bvar-db$c :protect t))))
+
+
+(defun add-term-bvar-unique (x bvar-db)
+  (declare (xargs :stobjs bvar-db))
+  (let ((look (get-term->bvar x bvar-db)))
+    (if look
+        (mv look bvar-db)
+      (b* ((next (next-bvar bvar-db))
+           (bvar-db (add-term-bvar x bvar-db)))
+        (mv next bvar-db)))))
+
+(defsection get-term->equivs
+
+  (defund get-term->equivs (x bvar-db)
+    (declare (xargs :stobjs bvar-db))
+    (cdr (hons-get x (term-equivs bvar-db))))
+
+  (local (in-theory (enable get-term->equivs)))
+
+  (defthm bvar-listp-get-term->equivs
+    (bvar-listp$a (get-term->equivs x bvar-db) bvar-db)
+    :hints(("Goal" :in-theory (enable get-term->equivs)))))
+
+
+(defsection add-term-equiv
+  (defund add-term-equiv (x n bvar-db)
+    (declare (xargs :guard (and (integerp n)
+                                (<= (base-bvar bvar-db) n)
+                                (< n (next-bvar bvar-db)))
+                    :stobjs bvar-db))
+    (update-term-equivs (hons-acons x
+                                    (cons n (get-term->equivs x bvar-db))
+                                    (term-equivs bvar-db))
+                        bvar-db))
+
+  (local (in-theory (enable add-term-equiv)))
+
+  (defthm base-bvar-of-add-term-equiv
+    (equal (base-bvar$a (add-term-equiv x n bvar-db))
+           (base-bvar$a bvar-db)))
+
+  (defthm next-bvar-of-add-term-equiv
+    (equal (next-bvar$a (add-term-equiv x n bvar-db))
+           (next-bvar$a bvar-db)))
+
+  (defthm get-term->bvar-of-add-term-equiv
+    (equal (get-term->bvar$a y (add-term-equiv x n bvar-db))
+           (get-term->bvar$a y bvar-db)))
+
+  (defthm get-bvar->term-of-add-term-equiv
+    (equal (get-bvar->term$a y (add-term-equiv x n bvar-db))
+           (get-bvar->term$a y bvar-db))))
diff -Nru acl2-6.2/books/centaur/gl/bvec-ite.lisp acl2-6.3/books/centaur/gl/bvec-ite.lisp
--- acl2-6.2/books/centaur/gl/bvec-ite.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bvec-ite.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,11 +1,30 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
 (include-book "bvecs")
-
 (include-book "tools/bstar" :dir :system)
+(include-book "ihs/logops-definitions" :dir :system)
+(include-book "centaur/misc/arith-equiv-defs" :dir :system)
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (in-theory (disable floor)))
 
 (defthm consp-bfr-eval-list
   (equal (consp (bfr-eval-list x env))
@@ -20,20 +39,42 @@
 
 (local (bfr-reasoning-mode t))
 
+
 ;; If/then/else where the branches are (unsigned) bit vectors
 (defn bfr-ite-bvv-fn (c v1 v0)
   (declare (xargs :measure (+ (acl2-count v1) (acl2-count v0))
                   :guard t))
   (if (and (atom v1) (atom v0))
       nil
-    (let ((tail (bfr-ite-bvv-fn c (if (atom v1) nil (cdr v1))
-                          (if (atom v0) nil (cdr v0))))
-          (head (bfr-ite-fn c (if (atom v1) nil (car v1))
-                            (if (atom v0) nil (car v0)))))
-      (if (or head tail)
-          (cons head tail)
-        nil))))
+    (b* (((mv v11 v1r) (car/cdr v1))
+         ((mv v01 v0r) (car/cdr v0))
+         (tail (bfr-ite-bvv-fn c v1r v0r))
+         (head (bfr-ite-fn c v11 v01)))
+      (bfr-ucons head tail))))
+
+(defthm pbfr-list-depends-on-of-bfr-ite-bvv-fn
+  (implies (and (not (pbfr-depends-on n p c))
+                (not (pbfr-list-depends-on n p v1))
+                (not (pbfr-list-depends-on n p v0)))
+           (not (pbfr-list-depends-on n p (bfr-ite-bvv-fn c v1 v0))))
+  :hints(("Goal" :in-theory (e/d (pbfr-list-depends-on)
+                                 (pbfr-depends-on (pbfr-depends-on)
+                                                  (pbfr-list-depends-on))))))
+
+(defthm eval-of-bfr-ite-bvv-fn
+  (equal (bfr-list->u (bfr-ite-bvv-fn c v1 v0) env)
+         (if (bfr-eval c env)
+             (bfr-list->u v1 env)
+           (bfr-list->u v0 env)))
+  :hints (("goal" :induct (bfr-ite-bvv-fn c v1 v0))))
 
+(defmacro bfr-ite-bvv (c v1 v0)
+  `(let ((bfr-ite-bvv-test ,c))
+     (if bfr-ite-bvv-test
+         (if (eq bfr-ite-bvv-test t)
+             ,v1
+           (bfr-ite-bvv-fn bfr-ite-bvv-test ,v1 ,v0))
+       ,v0)))
 
 ;; (defcong bfr-equiv bfr-list-equiv (cons a b) 1
 ;;   :hints ((and stable-under-simplificationp
@@ -71,34 +112,37 @@
 ;; (defcong bfr-list-equiv equal (bfr-ite-bvv-fn c v1 v0) 2)
 ;; (defcong bfr-list-equiv equal (bfr-ite-bvv-fn c v1 v0) 3)
 
-(defmacro bfr-ite-bvv (c v1 v0)
-  `(let ((bfr-ite-bvv-test ,c))
-     (if bfr-ite-bvv-test
-         (if (eq bfr-ite-bvv-test t)
-             ,v1
-           (bfr-ite-bvv-fn bfr-ite-bvv-test ,v1 ,v0))
-       ,v0)))
+
 
 (defn bfr-ite-bss-fn (c v1 v0)
   (declare (xargs :measure (+ (acl2-count v1) (acl2-count v0))
                   :guard t))
-  (b* (((mv head1 tail1 end1) (if (atom v1)
-                                  (mv nil nil t)
-                                (if (atom (cdr v1))
-                                    (mv (car v1) v1 t)
-                                  (mv (car v1) (cdr v1) nil))))
-       ((mv head0 tail0 end0) (if (atom v0)
-                                  (mv nil nil t)
-                                (if (atom (cdr v0))
-                                    (mv (car v0) v0 t)
-                                  (mv (car v0) (cdr v0) nil)))))
+  (b* (((mv head1 tail1 end1) (first/rest/end v1))
+       ((mv head0 tail0 end0) (first/rest/end v0)))
     (if (and end1 end0)
-        (list (bfr-ite-fn c head1 head0))
+        (bfr-sterm (bfr-ite-fn c head1 head0))
       (let ((rst (bfr-ite-bss-fn c tail1 tail0))
             (head (bfr-ite c head1 head0)))
-        (if (and (atom (cdr rst)) (hqual head (car rst)))
-            rst
-          (cons head rst))))))
+        (bfr-scons head rst)))))
+
+
+(defthm pbfr-list-depends-on-of-bfr-ite-bss-fn
+  (implies (and (not (pbfr-depends-on n p c))
+                (not (pbfr-list-depends-on n p v1))
+                (not (pbfr-list-depends-on n p v0)))
+           (not (pbfr-list-depends-on n p (bfr-ite-bss-fn c v1 v0))))
+  :hints(("Goal" :in-theory (e/d (pbfr-list-depends-on)
+                                 (pbfr-depends-on (pbfr-depends-on)
+                                                  (pbfr-list-depends-on))))))
+
+
+
+(defthm eval-of-bfr-ite-bss-fn
+  (equal (bfr-list->s (bfr-ite-bss-fn c v1 v0) env)
+            (if (bfr-eval c env)
+                (bfr-list->s v1 env)
+              (bfr-list->s v0 env)))
+  :hints (("goal" :induct (bfr-ite-bss-fn c v1 v0))))
 
 ;; (defcong bfr-equiv equal (bfr-ite-bss-fn c v1 v0) 1)
 ;; (defcong bfr-list-equiv equal (bfr-ite-bss-fn c v1 v0) 2)
@@ -115,63 +159,68 @@
 
 (add-macro-alias bfr-ite-bss bfr-ite-bss-fn)
 
-(defthmd v2n-bfr-eval-list-atom
-  (implies (atom x)
-           (equal (v2n (bfr-eval-list x env)) 0))
-  :hints (("goal" :in-theory (enable v2n bfr-eval-list))))
-
-
-(defthmd bfr-ite-bvv-fn-nil
-  (implies (not (bfr-ite-bvv-fn c v1 v0))
-           (and (implies (bfr-eval c env)
-                         (equal (v2n (bfr-eval-list v1 env)) 0))
-                (implies (not (bfr-eval c env))
-                         (equal (v2n (bfr-eval-list v0 env)) 0))))
-  :hints (("Goal" :in-theory (enable v2n bfr-eval-list)))
-  :otf-flg t)
-
-(defthmd v2n-bfr-ite-bvv-fn
-  (equal (v2n (bfr-eval-list (bfr-ite-bvv-fn c v1 v0) env))
-         (if (bfr-eval c env)
-             (v2n (bfr-eval-list v1 env))
-           (v2n (bfr-eval-list v0 env))))
-  :hints (("Goal" :in-theory (enable v2n bfr-eval-list))))
-
-(defthm v2i-bfr-ite-bss-fn
-  (equal (v2i (bfr-eval-list (bfr-ite-bss-fn c v1 v0) env))
-         (if (bfr-eval c env)
-             (v2i (bfr-eval-list v1 env))
-           (v2i (bfr-eval-list v0 env))))
-  :hints(("Goal" :in-theory (enable v2i bfr-eval-list))))
-
-
-(defthmd boolean-listp-bfr-ite-bvv-fn-v2n-bind-env-car-env
-  (implies (and (bind-free '((env . (car env))) (env))
-                (boolean-listp (bfr-ite-bvv-fn c v1 v0)))
-           (equal (v2n (bfr-ite-bvv-fn c v1 v0))
-                  (if (bfr-eval c env)
-                      (v2n (bfr-eval-list v1 env))
-                    (v2n (bfr-eval-list v0 env)))))
-  :hints (("goal" :use ((:instance bfr-eval-list-consts
-                                   (x (bfr-ite-bvv-fn c v1 v0)))
-                        v2n-bfr-ite-bvv-fn)
-           :in-theory (e/d ()
-                           (bfr-ite-bvv-fn v2n-bfr-ite-bvv-fn
-                               bfr-eval-list-consts)))))
-
-(defthmd boolean-listp-bfr-ite-bss-fn-v2i-bind-env-car-env
-  (implies (and (bind-free '((env . (car env))) (env))
-                (boolean-listp (bfr-ite-bss-fn c v1 v0)))
-           (equal (v2i (bfr-ite-bss-fn c v1 v0))
-                  (if (bfr-eval c env)
-                      (v2i (bfr-eval-list v1 env))
-                    (v2i (bfr-eval-list v0 env)))))
-  :hints (("goal" :use ((:instance bfr-eval-list-consts
-                                   (x (bfr-ite-bss-fn c v1 v0)))
-                        v2i-bfr-ite-bss-fn)
-           :in-theory (e/d ()
-                           (bfr-ite-bss-fn v2i-bfr-ite-bss-fn
-                               bfr-eval-list-consts)))))
+(defthm bfr-eval-list-of-atom
+  (implies (not (consp x))
+           (equal (bfr-eval-list x env) nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+;; (defthmd v2n-bfr-eval-list-atom
+;;   (implies (atom x)
+;;            (equal (v2n (bfr-eval-list x env)) 0))
+;;   :hints (("goal" :in-theory (enable v2n bfr-eval-list))))
+
+
+;; (defthmd bfr-ite-bvv-fn-nil
+;;   (implies (not (bfr-ite-bvv-fn c v1 v0))
+;;            (and (implies (bfr-eval c env)
+;;                          (equal (v2n (bfr-eval-list v1 env)) 0))
+;;                 (implies (not (bfr-eval c env))
+;;                          (equal (v2n (bfr-eval-list v0 env)) 0))))
+;;   :hints (("Goal" :in-theory (enable v2n bfr-eval-list)))
+;;   :otf-flg t)
+
+;; (defthmd v2n-bfr-ite-bvv-fn
+;;   (equal (v2n (bfr-eval-list (bfr-ite-bvv-fn c v1 v0) env))
+;;          (if (bfr-eval c env)
+;;              (v2n (bfr-eval-list v1 env))
+;;            (v2n (bfr-eval-list v0 env))))
+;;   :hints (("Goal" :in-theory (enable v2n bfr-eval-list))))
+
+;; (defthm v2i-bfr-ite-bss-fn
+;;   (equal (v2i (bfr-eval-list (bfr-ite-bss-fn c v1 v0) env))
+;;          (if (bfr-eval c env)
+;;              (v2i (bfr-eval-list v1 env))
+;;            (v2i (bfr-eval-list v0 env))))
+;;   :hints(("Goal" :in-theory (enable v2i bfr-eval-list))))
+
+
+;; (defthmd boolean-listp-bfr-ite-bvv-fn-v2n-bind-env-car-env
+;;   (implies (and (bind-free '((env . (car env))) (env))
+;;                 (boolean-listp (bfr-ite-bvv-fn c v1 v0)))
+;;            (equal (v2n (bfr-ite-bvv-fn c v1 v0))
+;;                   (if (bfr-eval c env)
+;;                       (v2n (bfr-eval-list v1 env))
+;;                     (v2n (bfr-eval-list v0 env)))))
+;;   :hints (("goal" :use ((:instance bfr-eval-list-consts
+;;                                    (x (bfr-ite-bvv-fn c v1 v0)))
+;;                         v2n-bfr-ite-bvv-fn)
+;;            :in-theory (e/d ()
+;;                            (bfr-ite-bvv-fn v2n-bfr-ite-bvv-fn
+;;                                bfr-eval-list-consts)))))
+
+;; (defthmd boolean-listp-bfr-ite-bss-fn-v2i-bind-env-car-env
+;;   (implies (and (bind-free '((env . (car env))) (env))
+;;                 (boolean-listp (bfr-ite-bss-fn c v1 v0)))
+;;            (equal (v2i (bfr-ite-bss-fn c v1 v0))
+;;                   (if (bfr-eval c env)
+;;                       (v2i (bfr-eval-list v1 env))
+;;                     (v2i (bfr-eval-list v0 env)))))
+;;   :hints (("goal" :use ((:instance bfr-eval-list-consts
+;;                                    (x (bfr-ite-bss-fn c v1 v0)))
+;;                         v2i-bfr-ite-bss-fn)
+;;            :in-theory (e/d ()
+;;                            (bfr-ite-bss-fn v2i-bfr-ite-bss-fn
+;;                                bfr-eval-list-consts)))))
 
 
 
diff -Nru acl2-6.2/books/centaur/gl/bvecs.lisp acl2-6.3/books/centaur/gl/bvecs.lisp
--- acl2-6.2/books/centaur/gl/bvecs.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/bvecs.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,18 +1,36 @@
-
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "bfr")
+(include-book "ihs/logops-definitions" :dir :system)
+(include-book "centaur/misc/arith-equiv-defs" :dir :system)
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (in-theory (disable floor)))
 
 ;; (include-book "tools/with-arith5-help" :dir :system)
 
 ;; (allow-arith5-help)
 
-(local (include-book "ihs/quotient-remainder-lemmas" :dir :system))
-(local (include-book "ihs/math-lemmas" :dir :system))
-(local (in-theory (disable floor)))
-
+;; (local (include-book "ihs/quotient-remainder-lemmas" :dir :system))
+;; (local (include-book "ihs/math-lemmas" :dir :system))
 
 
 ;; (defun bfr-listp1 (x)
@@ -71,9 +89,429 @@
   (equal (bfr-eval-list (acl2::list-fix x) env)
          (bfr-eval-list x env)))
 
+
+(defund pbfr-list-depends-on (k p x)
+  (if (atom x)
+      nil
+    (or (pbfr-depends-on k p (car x))
+        (pbfr-list-depends-on k p (cdr x)))))
+
+(defthm pbfr-list-depends-on-of-list-fix
+  (equal (pbfr-list-depends-on k p (acl2::list-fix x))
+         (pbfr-list-depends-on k p x))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on))))
+
+(defthm bfr-eval-list-of-set-non-dep
+  (implies (and (not (pbfr-list-depends-on k p x))
+                (bfr-eval p env)
+                (bfr-eval p (bfr-set-var k v env)))
+           (equal (bfr-eval-list x (bfr-param-env p (bfr-set-var k v env)))
+                  (bfr-eval-list x (bfr-param-env p env))))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on))))
+
+
+(defthm bfr-depends-on-car
+  (implies (not (pbfr-list-depends-on k p x))
+           (not (pbfr-depends-on k p (car x))))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on default-car))))
+
+(defthm bfr-depends-on-cdr
+  (implies (not (pbfr-list-depends-on k p x))
+           (not (pbfr-list-depends-on k p (cdr x))))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on))))
+
+;; (defund bfr-max-nat-var-list (x)
+;;   (declare (xargs :guard t))
+;;   (if (atom x)
+;;       0
+;;     (max (bfr-max-nat-var (car x))
+;;          (bfr-max-nat-var-list (cdr x)))))
+
+;; (defthm bfr-eval-list-of-bfr-set-var-past-max-nat
+;;   (implies (and (<= (bfr-max-nat-var-list x) var)
+;;                 (natp var))
+;;            (equal (bfr-eval-list x (bfr-set-var var val env))
+;;                   (bfr-eval-list x env)))
+;;   :hints(("Goal" :in-theory (enable bfr-max-nat-var-list))))
+
+
+;; (defthm bfr-max-nat-var-of-car
+;;   (<= (bfr-max-nat-var (car x)) (bfr-max-nat-var-list x))
+;;   :hints(("Goal" :in-theory (enable bfr-max-nat-var-list)))
+;;   :rule-classes :linear)
+
+;; (defthm bfr-max-nat-var-list-of-car-rw
+;;   (implies (<= (bfr-max-nat-var-list x) n)
+;;            (<= (bfr-max-nat-var (car x)) n)))
+
+;; (defthm bfr-max-nat-var-of-cdr
+;;   (<= (bfr-max-nat-var-list (cdr x)) (bfr-max-nat-var-list x))
+;;   :hints(("Goal" :in-theory (enable bfr-max-nat-var-list)))
+;;   :rule-classes :linear)
+
+;; (defthm bfr-max-nat-var-list-of-cdr-rw
+;;   (implies (<= (bfr-max-nat-var-list x) n)
+;;            (<= (bfr-max-nat-var-list (cdr x)) n)))
+
+
+
+
+
+
+
+(defund-inline scdr (v)
+  (declare (xargs :guard t))
+  (mbe :logic (if (atom (cdr v)) v (cdr v))
+       :exec (if (or (atom v) (atom (cdr v))) v (cdr v))))
+
+(defthm pbfr-list-depends-on-scdr
+  (implies (not (pbfr-list-depends-on k p x))
+           (not (pbfr-list-depends-on k p (scdr x))))
+  :hints(("Goal" :in-theory (enable scdr pbfr-list-depends-on))))
+
+;; (defthm bfr-max-nat-var-list-of-scdr
+;;   (<= (bfr-max-nat-var-list (scdr x)) (bfr-max-nat-var-list x))
+;;   :hints(("Goal" :in-theory (enable bfr-max-nat-var-list scdr)))
+;;   :rule-classes :linear)
+
+;; (defthm bfr-max-nat-var-list-of-scdr-rw
+;;   (implies (<= (bfr-max-nat-var-list x) n)
+;;            (<= (bfr-max-nat-var-list (scdr x)) n)))
+
+(defthm scdr-of-list-fix
+  (equal (scdr (acl2::list-fix x))
+         (acl2::list-fix (scdr x)))
+  :hints(("Goal" :in-theory (enable scdr))))
+
+
+(defund-inline s-endp (v)
+  (declare (xargs :guard t))
+  (mbe :logic (atom (cdr v)) :exec (or (atom v) (atom (cdr v)))))
+
+(defun-inline first/rest/end (x)
+  (declare (xargs :guard t
+                  :guard-hints ('(:in-theory (enable scdr s-endp)))))
+  (mbe :logic (mv (car x) (scdr x) (s-endp x))
+       :exec (cond ((atom x)       (mv nil x t))
+                   ((atom (cdr x)) (mv (car x) x t))
+                   (t              (mv (car x) (cdr x) nil)))))
+
+(defthm s-endp-of-list-fix
+  (equal (s-endp (acl2::list-fix x))
+         (s-endp x))
+  :hints(("Goal" :in-theory (enable s-endp))))
+
+(defthm scdr-count-strong
+  (implies (not (s-endp v))
+           (< (acl2-count (scdr v)) (acl2-count v)))
+  :hints(("Goal" :in-theory (enable s-endp scdr)))
+  :rule-classes :linear)
+
+(defthm scdr-count-weak
+  (<= (acl2-count (scdr v)) (acl2-count v))
+  :hints(("Goal" :in-theory (enable s-endp scdr)))
+  :rule-classes :linear)
+
+(defthm scdr-len-strong
+  (implies (not (s-endp v))
+           (< (len (scdr v)) (len v)))
+  :hints(("Goal" :in-theory (enable s-endp scdr)))
+  :rule-classes :linear)
+
+(defthm scdr-len-weak
+  (<= (len (scdr v)) (len v))
+  :hints(("Goal" :in-theory (enable s-endp scdr)))
+  :rule-classes :linear)
+
+
+
+(defthm s-endp-of-scdr
+  (implies (s-endp b)
+           (s-endp (scdr b)))
+  :hints(("Goal" :in-theory (enable s-endp scdr))))
+
+(defun bool->sign (x)
+  (declare (xargs :guard t))
+  (if x -1 0))
+
+
+(defun bfr-list->s (x env)
+  (declare (xargs :guard t))
+  (b* (((mv first rest end) (first/rest/end x)))
+    (if end
+        (bool->sign (bfr-eval first env))
+      (logcons (acl2::bool->bit (bfr-eval first env))
+               (bfr-list->s rest env)))))
+
+
+(defthm bfr-list->s-of-list-fix
+  (equal (bfr-list->s (acl2::list-fix x) env)
+         (bfr-list->s x env)))
+
+(defund bfr-snorm (v)
+  (declare (xargs :guard t))
+  (if (atom v) '(nil) v))
+
+(defthm s-endp-of-bfr-snorm
+  (equal (s-endp (bfr-snorm v))
+         (s-endp v))
+  :hints(("Goal" :in-theory (enable s-endp bfr-snorm))))
+
+(defthm scdr-of-bfr-snorm
+  (equal (scdr (bfr-snorm v))
+         (bfr-snorm (scdr v)))
+  :hints(("Goal" :in-theory (enable scdr bfr-snorm))))
+
+(defthm car-of-bfr-snorm
+  (equal (car (bfr-snorm v))
+         (car v))
+  :hints(("Goal" :in-theory (enable bfr-snorm))))
+
+(defthm bfr-list->s-of-bfr-snorm
+  (equal (bfr-list->s (bfr-snorm v) env)
+         (bfr-list->s v env)))
+
+(defund bfr-scons (b v)
+  (declare (xargs :guard t))
+  (if (atom v)
+      (if b (list b nil) '(nil))
+    (if (and (atom (cdr v))
+             (hons-equal (car v) b))
+        v
+      (cons b v))))
+
+(defthm scdr-of-bfr-scons
+  (equal (scdr (bfr-scons b v))
+         (bfr-snorm v))
+  :hints(("Goal" :in-theory (enable bfr-snorm bfr-scons scdr))))
+
+(defthm s-endp-of-bfr-scons
+  (equal (s-endp (bfr-scons b v))
+         (and (s-endp v)
+              (hqual b (car v))))
+  :hints(("Goal" :in-theory (enable s-endp bfr-scons))))
+
+(defthm car-of-bfr-scons
+  (equal (car (bfr-scons b v))
+         b)
+  :hints(("Goal" :in-theory (enable bfr-scons))))
+
+(defthm bfr-list->s-of-bfr-scons
+  (equal (bfr-list->s (bfr-scons b x) env)
+         (logcons (acl2::bool->bit (bfr-eval b env))
+                  (bfr-list->s x env)))
+  :hints(("Goal" ;:in-theory (enable bfr-scons scdr s-endp)
+          :expand ((bfr-list->s (bfr-scons b x) env))
+          :do-not-induct t)))
+
+(defthm pbfr-list-depends-on-of-scons
+  (implies (and (not (pbfr-depends-on k p b))
+                (not (pbfr-list-depends-on k p x)))
+           (not (pbfr-list-depends-on k p (bfr-scons b x))))
+  :hints(("Goal" :in-theory (enable bfr-scons pbfr-list-depends-on))))
+
+;; (defthm bfr-max-nat-var-list-of-bfr-scons
+;;   (implies (and (<= (bfr-max-nat-var b) n)
+;;                 (<= (bfr-max-nat-var-list x) n))
+;;            (<= (bfr-max-nat-var-list (bfr-scons b x)) n))
+;;   :hints(("Goal" :in-theory (e/d (bfr-scons bfr-max-nat-var-list)
+;;                                  ((bfr-max-nat-var-list)))))
+;;   :rule-classes (:rewrite (:linear :match-free :all)))
+
+(defund bfr-sterm (b)
+  (declare (xargs :guard t))
+  (list b))
+
+(defthm s-endp-of-bfr-sterm
+  (equal (s-endp (bfr-sterm b)) t)
+  :hints(("Goal" :in-theory (enable s-endp bfr-sterm))))
+
+(defthm scdr-of-bfr-sterm
+  (equal (scdr (bfr-sterm b))
+         (bfr-sterm b))
+  :hints(("Goal" :in-theory (enable scdr bfr-sterm))))
+
+(defthm car-of-bfr-sterm
+  (equal (car (bfr-sterm b))
+         b)
+  :hints(("Goal" :in-theory (enable bfr-sterm))))
+
+
+(defthm bfr-list->s-of-bfr-sterm
+  (equal (bfr-list->s (bfr-sterm b) env)
+         (bool->sign (bfr-eval b env))))
+
+(defthm pbfr-list-depends-on-of-bfr-sterm
+  (equal (pbfr-list-depends-on k p (bfr-sterm b))
+         (pbfr-depends-on k p b))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on bfr-sterm))))
+
+;; (defthm bfr-max-nat-var-list-of-bfr-sterm
+;;   (equal (bfr-max-nat-var-list (bfr-sterm b))
+;;          (bfr-max-nat-var b))
+;;   :hints(("Goal" :in-theory (enable bfr-sterm bfr-max-nat-var-list))))
+
+(defthm scdr-when-s-endp
+  (implies (s-endp x)
+           (equal (scdr x) x))
+  :hints(("Goal" :in-theory (enable scdr s-endp)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthmd bfr-list->s-of-scdr
+  (equal (bfr-list->s (scdr x) env)
+         (logcdr (bfr-list->s x env))))
+
+(defthm logcdr-of-bfr-list->s
+  (equal (logcdr (bfr-list->s x env))
+         (bfr-list->s (scdr x) env)))
+
+(defthm logcar-of-bfr-list->s
+  (equal (logcar (bfr-list->s x env))
+         (acl2::bool->bit (bfr-eval (car x) env))))
+
+(defthm bfr-list->s-when-s-endp
+  (implies (s-endp x)
+           (equal (bfr-list->s x env)
+                  (bool->sign (bfr-eval (car x) env))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+(defn i2v (n)
+  (declare (xargs :measure (integer-length n)
+                  :hints(("Goal" :in-theory (enable acl2::integer-length**)))))
+  (cond ((eql 0 (ifix n)) '(nil))
+        ((eql n -1) '(t))
+        (t (bfr-scons (equal (logcar n) 1) (i2v (logcdr n))))))
+
+(defthm bfr-list->s-of-i2v
+  (equal (bfr-list->s (i2v n) env)
+         (ifix n)))
+
+(defthm pbfr-list-depends-on-of-i2v
+  (not (pbfr-list-depends-on k p (i2v n)))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on i2v))))
+
+;; (defthm bfr-max-nat-var-list-of-i2v
+;;   (equal (bfr-max-nat-var-list (i2v n)) 0)
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var-list bfr-scons bfr-max-nat-var)
+;;                                  ((bfr-max-nat-var-list))))))
+
+
+(defthm bfr-list->s-of-set-non-dep
+  (implies (and (not (pbfr-list-depends-on k p x))
+                (bfr-eval p env)
+                (bfr-eval p (bfr-set-var k v env)))
+           (equal (bfr-list->s x (bfr-param-env p (bfr-set-var k v env)))
+                  (bfr-list->s x (bfr-param-env p env))))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on))))
+
+;; (defthm bfr-list->s-of-bfr-set-var-past-max-nat
+;;   (implies (and (<= (bfr-max-nat-var-list x) var)
+;;                 (natp var))
+;;            (equal (bfr-list->s x (bfr-set-var var val env))
+;;                   (bfr-list->s x env)))
+;;   :hints(("Goal" :in-theory (enable bfr-max-nat-var-list))))
+
+
+
+
+
+
+
+
+
+
+
+
+(defmacro car/cdr (x)
+  `(let* ((a ,x))
+     (mbe :logic (mv (car a) (cdr a))
+          :exec (if (atom a) (mv nil nil) (mv (car a) (cdr a))))))
+
+(defun bfr-list->u (x env)
+  (declare (xargs :guard t))
+  (if (atom x)
+      0
+    (logcons (acl2::bool->bit (bfr-eval (car x) env))
+             (bfr-list->u (cdr x) env))))
+
+(defthm bfr-list->u-of-list-fix
+  (equal (bfr-list->u (acl2::list-fix x) env)
+         (bfr-list->u x env)))
+
+(defthm bfr-list->u-type
+  (natp (bfr-list->u x env))
+  :rule-classes :type-prescription)
+
+(in-theory (disable (:t bfr-list->u)))
+
+(defthm bfr-list->u-of-set-non-dep
+  (implies (and (not (pbfr-list-depends-on k p x))
+                (bfr-eval p env)
+                (bfr-eval p (bfr-set-var k v env)))
+           (equal (bfr-list->u x (bfr-param-env p (bfr-set-var k v env)))
+                  (bfr-list->u x (bfr-param-env p env))))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on))))
+
+;; (defthm bfr-list->u-of-bfr-set-var-past-max-nat
+;;   (implies (and (<= (bfr-max-nat-var-list x) var)
+;;                 (natp var))
+;;            (equal (bfr-list->u x (bfr-set-var var val env))
+;;                   (bfr-list->u x env)))
+;;   :hints(("Goal" :in-theory (enable bfr-max-nat-var-list))))
+
 ;; (in-theory (disable (bfr-listp)))
 
 (add-bfr-eval-pat (bfr-eval-list & env))
+(add-bfr-eval-pats (bfr-list->u & env))
+(add-bfr-eval-pats (bfr-list->s & env))
+
+(defund bfr-ucons (b x)
+  (declare (xargs :guard t))
+  (if (and (atom x) (not b))
+      nil
+    (cons b x)))
+
+(defthm bfr-list->u-of-bfr-ucons
+  (equal (bfr-list->u (bfr-ucons b x) env)
+         (logcons (acl2::bool->bit (bfr-eval b env))
+                  (bfr-list->u x env)))
+  :hints(("Goal" :in-theory (enable bfr-ucons))))
+
+(defthm pbfr-list-depends-on-of-bfr-ucons
+  (implies (and (not (pbfr-depends-on k p b))
+                (not (pbfr-list-depends-on k p x)))
+           (not (pbfr-list-depends-on k p (bfr-ucons b x))))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on bfr-ucons))))
+
+;; (defthm bfr-max-nat-var-list-of-bfr-ucons
+;;   (implies (and (<= (bfr-max-nat-var b) n)
+;;                 (<= (bfr-max-nat-var-list x) n))
+;;            (<= (bfr-max-nat-var-list (bfr-ucons b x)) n))
+;;   :hints(("Goal" :in-theory (enable bfr-ucons bfr-max-nat-var-list)))
+;;   :rule-classes (:rewrite (:linear :match-free :all)))
+
+
+(defn n2v (n)
+  (if (eql (nfix n) 0)
+      nil
+    (bfr-ucons (equal 1 (logcar n))
+               (n2v (logcdr n)))))
+
+(defthm bfr-list->u-of-n2v
+  (equal (bfr-list->u (n2v n) env)
+         (nfix n)))
+
+(defthm pbfr-list-depends-on-of-n2v
+  (not (pbfr-list-depends-on k p  (n2v n)))
+  :hints(("Goal" :in-theory (enable pbfr-list-depends-on n2v))))
+
+;; (defthm bfr-max-nat-var-list-of-n2v
+;;   (equal (bfr-max-nat-var-list (n2v n)) 0)
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var-list bfr-ucons bfr-max-nat-var)
+;;                                  ((bfr-max-nat-var-list))))))
+
+
 
 ;; (defun bfr-list-fix (x)
 ;;   (declare (xargs :guard t))
@@ -120,7 +558,6 @@
 ;;   :hints (("goal" :in-theory (enable bfr-list-equiv-necc))))
 
 
-
 (defun bfr-eval-alist (al vals)
   (declare (xargs :guard t))
   (if (atom al)
@@ -133,65 +570,305 @@
 
 
 
+(defun boolfix (x)
+  (declare (xargs :guard t))
+  (if x t nil))
+
+(defcong iff equal (boolfix x) 1)
+
+(defthm boolfix-under-iff
+  (iff (boolfix x) x))
+
+
+
+
+
+;; useful for dealing with unsigned and signed bit vectors, resp.
+
+
+
+;; (defund scons (b v)
+;;   (declare (xargs :guard t))
+;;   (let* ((b (boolfix b)))
+;;     (if (atom v)
+;;         (if b '(t nil) '(nil))
+;;       (if (and (atom (cdr v))
+;;                (eq (boolfix (car v)) b))
+;;           v
+;;         (cons b v)))))
+
+;; (defthm car-of-scons
+;;   (iff (car (scons b v))
+;;        b)
+;;   :hints(("Goal" :in-theory (enable scons))))
+
+;; (defcong iff equal (scons b v) 1
+;;   :hints(("Goal" :in-theory (enable scons))))
+
+
+
+
+
+;; (defund sterm (x)
+;;   (declare (xargs :guard t))
+;;   (if x '(t) '(nil)))
+
+;; (defthm car-of-sterm
+;;   (equal (car (sterm x))
+;;          (boolfix x))
+;;   :hints(("Goal" :in-theory (enable sterm))))
+
+;; (defcong iff equal (sterm x) 1
+;;   :hints(("Goal" :in-theory (enable sterm))))
+
+
+;; (defn sfix (v)
+;;   (declare (xargs :verify-guards nil))
+;;   (mbe :logic (if (s-endp v)
+;;                   (sterm (car v))
+;;                 (scons (car v)
+;;                        (sfix (scdr v))))
+;;        :exec (if (atom v)
+;;                  (list nil)
+;;                (if (atom (cdr v))
+;;                    (list (if (car v) t nil))
+;;                  (let ((rst (sfix (cdr v)))
+;;                        (car (if (car v) t nil)))
+;;                    (if (and (atom (cdr rst)) (eq (car rst) car))
+;;                        rst
+;;                      (cons car rst)))))))
+
+;; (defthm consp-sfix
+;;   (consp (sfix v))
+;;   :hints(("Goal" :in-theory (enable scons s-endp)))
+;;   :rule-classes :type-prescription)
+
+;; (defthmd boolean-listp-sfix
+;;   (boolean-listp (sfix v))
+;;   :hints(("Goal" :in-theory (enable scons sterm))))
+
+;; (local (defthm booleanp-car-sfix
+;;          (booleanp (car (sfix v)))
+;;          :hints (("goal" :use boolean-listp-sfix))
+;;          :rule-classes :type-prescription))
+
+;; (verify-guards sfix :hints(("Goal" :in-theory (enable sterm scons scdr s-endp))))
+
+;; (defun sv-equiv (x y)
+;;   (declare (xargs :guard t))
+;;   (equal (sfix x) (sfix y)))
+
+;; (defequiv sv-equiv)
+
+;; (defthm sfix-of-scons
+;;   (equal (sfix (scons b v))
+;;          (scons b (sfix v)))
+;;   :hints(("Goal" :in-theory (enable scons scdr s-endp sterm))))
+
+;; (defthm sfix-of-sterm
+;;   (equal (sfix (sterm b))
+;;          (sterm b))
+;;   :hints(("Goal" :in-theory (enable sterm s-endp))))
+
+;; (defthm sfix-of-sfix
+;;   (equal (sfix (sfix x)) (sfix x)))
+
+;; (defthm sfix-under-sv-equiv
+;;   (sv-equiv (sfix x) x))
+
+;; (defthm car-of-sfix
+;;   (equal (car (sfix x))
+;;          (boolfix (car x)))
+;;   :hints(("Goal" :in-theory (enable scons))))
+
+;; (defcong sv-equiv iff (car x) 1
+;;   :hints(("Goal" :in-theory (enable car-of-sfix))))
+
+;; (defcong sv-equiv sv-equiv (scdr x) 1
+;;   :hints(("Goal" :in-theory (enable scdr s-endp sterm scons))))
+
+
+;; (defthm sv-equiv-repeat-last
+;;   (sv-equiv (append v (last v))
+;;             v)
+;;   :hints(("Goal" :in-theory (enable append s-endp scdr scons sterm)
+;;           :induct (last v))))
+
+
+;; ;; (defthm sv-equiv-of-cdr-sfix
+;; ;;   (implies (consp (cdr (sfix x)))
+;; ;;            (sv-equiv (cdr (sfix x))
+;; ;;                      (cdr x)))
+;; ;;   :hints(("Goal" :in-theory (enable scons scdr s-endp sterm))))
+
+
+;; (defthm sterm-when-s-endp
+;;   (implies (s-endp x)
+;;            (sv-equiv (sterm (car x)) x))
+;;   :hints(("Goal" :in-theory (enable s-endp sterm)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+;; (defthm scons-car-cdr
+;;   (sv-equiv (scons (car x) (scdr x))
+;;             x)
+;;   :hints(("Goal" :in-theory (enable scons scdr s-endp sterm))))
+
+;; (defcong sv-equiv sv-equiv (scons a b) 2)
+
+
+;; (defthm scdr-of-scons
+;;   (sv-equiv (scdr (scons a b))
+;;             b)
+;;   :hints(("Goal" :in-theory (e/d (scdr scons s-endp)
+;;                                  (boolfix sfix))
+;;           :use ((:instance sfix (v b))))))
+
+
+
+;; (defthmd sv-equiv-of-scons
+;;   (equal (sv-equiv (scons a b) c)
+;;          (and (iff (car c) a)
+;;               (sv-equiv (scdr c) b)))
+;;   :hints(("Goal" :in-theory (disable sv-equiv scons-car-cdr)
+;;           :use ((:instance scons-car-cdr
+;;                  (x (scons a b)))
+;;                 (:instance scons-car-cdr
+;;                  (x c))))))
+
+;; (defthmd scdr-when-equiv-to-endp
+;;   (implies (and (sv-equiv a b)
+;;                 (s-endp b))
+;;            (sv-equiv (scdr a) b))
+;;   :hints(("Goal" :in-theory (disable sv-equiv)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+;; (defthm scons-sterm
+;;   (equal (scons b (sterm b))
+;;          (sterm b))
+;;   :hints(("Goal" :in-theory (enable scons sterm))))
+
+;; (defthm scdr-sterm
+;;   (equal (scdr (sterm b))
+;;          (sterm b))
+;;   :hints(("Goal" :in-theory (enable scdr sterm))))
+
+;; (defthm scons-equiv-sterm
+;;   (and (equal (sv-equiv (scons a b) (sterm c))
+;;               (and (iff a c)
+;;                    (sv-equiv b (sterm c))))
+;;        (equal (sv-equiv (sterm c) (scons a b))
+;;               (and (iff a c)
+;;                    (sv-equiv b (sterm c)))))
+;;   :hints(("Goal" :in-theory (enable sterm scons s-endp sfix scdr))))
+
+;; (defthm sv-equiv-of-sconses
+;;   (equal (sv-equiv (scons a b) (scons c d))
+;;          (and (iff a c)
+;;               (sv-equiv b d)))
+;;   :hints(("Goal" :in-theory (enable sterm scons s-endp sfix scdr))))
+
+
 
 
 (defn v2i (v)
-  (if (atom v)
-      0
-    (if (atom (cdr v))
-        (if (car v) -1 0)
-      (let ((rst (ash (v2i (cdr v)) 1)))
-        (+ (if (car v) 1 0) rst)))))
+  (declare (xargs :guard-hints (("goal" :in-theory (enable logcons s-endp scdr
+                                                           acl2::bool->bit)))))
+  (mbe :logic (if (s-endp v)
+                  (bool->sign (car v))
+                (logcons (acl2::bool->bit (car v))
+                         (v2i (scdr v))))
+       :exec
+       (if (atom v)
+           0
+         (if (atom (cdr v))
+             (if (car v) -1 0)
+           (logcons (acl2::bool->bit (car v))
+                    (v2i (cdr v)))))))
+
+(defthm consp-of-bfr-eval-list
+  (equal (consp (bfr-eval-list x env))
+         (consp x)))
+
+
+
+(defthm v2i-of-bfr-eval-list
+  (equal (v2i (bfr-eval-list x env))
+         (bfr-list->s x env))
+  :hints(("Goal" :induct (bfr-list->s x env)
+          :expand ((bfr-eval-list x env))
+          :in-theory (enable s-endp scdr default-car))))
+
+(defthm v2i-of-i2v
+  (equal (v2i (i2v x))
+         (ifix x))
+  :hints(("Goal" :in-theory (enable bfr-scons s-endp scdr))))
+
+
+
+;; ;; (defthmd v2i-of-scons
+;; ;;   (equal (v2i (scons b v))
+;; ;;          (v2i (cons b v)))
+;; ;;   :hints(("Goal" :in-theory (enable scons))))
 
-(defn i2v (n)
-  (if (eql (ifix n) 0)
-      '(nil)
-    (if (eql n -1)
-        '(t)
-      (cons (logbitp 0 n)
-            (i2v (ash n -1))))))
-
-
-(defthm v2i-repeat-last
-  (equal (v2i (append v (last v)))
-         (v2i v))
-  :hints(("Goal" :in-theory (enable append))))
-
-(defthm v2i-i2v
-  (equal (v2i (i2v i)) (ifix i))
-  :hints (("goal" :in-theory (e/d (logbitp) ((:definition i2v)))
-           :induct (i2v i)
-           :expand ((i2v i)))))
 
-(defn sfix (v)
-  (if (atom v)
-      (list nil)
-    (if (atom (cdr v))
-        (list (if (car v) t nil))
-      (let ((rst (sfix (cdr v)))
-            (car (if (car v) t nil)))
-        (if (and (atom (cdr rst)) (eq (car rst) car))
-            rst
-          (cons car rst))))))
-
-(defthm v2i-sfix
-  (equal (v2i (sfix n))
-         (v2i n)))
-
-(defthm i2v-singleton
-  (implies (and (atom (cdr (i2v x)))
-                (integerp x))
-           (equal x (if (car (i2v x)) -1 0)))
-  :rule-classes nil)
-
-(defthm i2v-v2i
-  (equal (i2v (v2i v)) (sfix v))
-  :hints (("goal" :in-theory (e/d (logbitp) ((:definition v2i)))
-           :induct (v2i v)
-           :expand ((v2i v)))
-          ("subgoal *1/4"
-           :use ((:instance i2v-singleton
-                            (x (v2i (cdr v))))))))
+
+
+
+
+
+
+;; (local (defthmd cons-equals-scons-in-i2v
+;;          (implies (and (not (zip (logcons b n)))
+;;                        (not (equal (logcons b n) -1)))
+;;                   (equal (cons (equal b 1) (i2v n))
+;;                          (scons (equal b 1) (i2v n))))
+;;          :hints(("Goal" :in-theory (enable scons i2v)))))
+
+;; (verify-guards i2v
+;;   :hints(("Goal" :in-theory (enable cons-equals-scons-in-i2v))))
+
+;;   ;; (if (eql (ifix n) 0)
+;;   ;;     '(nil)
+;;   ;;   (if (eql n -1)
+;;   ;;       '(t)
+;;   ;;     (cons (logbitp 0 n)
+;;   ;;           (i2v (ash n -1))))))
+
+
+
+
+;; (defthm v2i-scons
+;;   (equal (v2i (scons a b))
+;;          (logcons (acl2::bool->bit a) (v2i b)))
+;;   :hints(("Goal" :in-theory (enable scons s-endp scdr))))
+
+;; (defthm v2i-i2v
+;;   (equal (v2i (i2v i)) (ifix i))
+;;   :hints (("goal" :in-theory (e/d () ((:definition i2v)))
+;;            :induct (i2v i)
+;;            :expand ((i2v i)))))
+
+
+;; (defthm v2i-sterm
+;;   (equal (v2i (sterm x))
+;;          (bool->sign x))
+;;   :hints(("Goal" :in-theory (enable sterm))))
+
+
+;; (defthm v2i-sfix
+;;   (equal (v2i (sfix n))
+;;          (v2i n)))
+
+;; (defcong sv-equiv equal (sfix x) 1)
+
+;; (defcong sv-equiv equal (v2i x) 1
+;;   :hints (("goal" :use ((:instance v2i-sfix (n x))
+;;                         (:instance v2i-sfix (n x-equiv)))
+;;            :in-theory (disable v2i-sfix))))
+
+
+;; (defthm i2v-v2i
+;;   (equal (i2v (v2i v)) (sfix v)))
 
 
 
@@ -199,65 +876,210 @@
 (defn v2n (v)
   (if (atom v)
       0
-    (let ((rst (ash (v2n (cdr v)) 1)))
-      (+ (if (car v) 1 0) rst))))
+    (logcons (acl2::bool->bit (car v))
+             (v2n (cdr v)))))
+
+(defthm v2n-of-bfr-eval-list
+  (equal (v2n (bfr-eval-list x env))
+         (bfr-list->u x env)))
+
+(defthm v2n-of-n2v
+  (equal (v2n (n2v x))
+         (nfix x))
+  :hints(("Goal" :in-theory (enable bfr-ucons))))
 
-(defn n2v (n)
-  (if (eql (nfix n) 0)
-      nil
-    (cons (logbitp 0 n)
-          (n2v (ash n -1)))))
 
+;; (defund ucons (b x)
+;;   (declare (xargs :guard t))
+;;   (if (and (atom x) (not b))
+;;       nil
+;;     (cons (boolfix b) x)))
 
-(defthm v2n-n2v
-  (equal (v2n (n2v n)) (nfix n))
-  :hints(("Goal" :in-theory (e/d (logbitp) ((:definition n2v)))
-          :induct (n2v n)
-          :expand ((n2v n)))))
+;; (defthm v2n-of-ucons
+;;   (equal (v2n (ucons b v))
+;;          (logcons (acl2::bool->bit b)
+;;                   (v2n v)))
+;;   :hints(("Goal" :in-theory (enable ucons))))
 
+;; (defthm car-of-ucons
+;;   (equal (car (ucons b v))
+;;          (boolfix b))
+;;   :hints(("Goal" :in-theory (enable ucons))))
 
-(defn ufix (v)
-  (if (atom v)
-      nil
-    (let ((rst (ufix (cdr v)))
-          (car (if (car v) t nil)))
-      (if (and (eq rst nil) (eq car nil))
-          nil
-        (cons car rst)))))
-
-(defthm v2n-ufix
-  (equal (v2n (ufix v))
-         (v2n v)))
-
-(defthm v2n-nonneg
-  (<= 0 (v2n v))
-  :rule-classes (:rewrite :linear :type-prescription))
-
-(in-theory (disable (:rewrite v2n-nonneg)
-                    (:linear v2n-nonneg)))
-
-(defthm n2v-v2n
-  (equal (n2v (v2n v)) (ufix v))
-  :hints(("Goal" :in-theory (e/d (v2n-nonneg logbitp)
-                                 ((:definition v2n)))
-          :induct (v2n v)
-          :expand ((v2n v)))))
-
-
-(in-theory (disable v2n n2v v2i i2v ash logbitp))
+;; (defcong iff equal (ucons b v) 1
+;;   :hints(("Goal" :in-theory (enable ucons))))
+
+
+
+
+;; (local (defthm cons-is-ucons-in-n2v
+;;          (implies (not (zp (logcons b n)))
+;;                   (equal (cons (equal 1 b) (n2v n))
+;;                          (ucons (equal 1 b) (n2v n))))
+;;          :hints(("Goal" :in-theory (enable ucons)))))
+
+;; (verify-guards n2v)
+
+
+;; (defthm v2n-n2v
+;;   (equal (v2n (n2v n)) (nfix n)))
+
+
+
+;; (defn ufix (v)
+;;   (declare (xargs :verify-guards nil))
+;;   (mbe :logic (if (atom v)
+;;                   nil
+;;                 (ucons (car v) (ufix (cdr v))))
+;;        :exec
+;;        (if (atom v)
+;;            nil
+;;          (let ((rst (ufix (cdr v)))
+;;                (car (if (car v) t nil)))
+;;            (if (and (eq rst nil) (eq car nil))
+;;                nil
+;;              (cons car rst))))))
+
+;; (verify-guards ufix :hints (("goal" :in-theory (enable ucons))))
+
+;; (defthm ufix-of-ucons
+;;   (equal (ufix (ucons a b))
+;;          (ucons a (ufix b)))
+;;   :hints(("Goal" :in-theory (enable ucons))))
+
+;; (defthm v2n-ufix
+;;   (equal (v2n (ufix v))
+;;          (v2n v)))
+
+;; (defun uv-equiv (x y)
+;;   (declare (xargs :guard t))
+;;   (equal (ufix x) (ufix y)))
+
+;; (defequiv uv-equiv)
+
+;; (defcong uv-equiv equal (ufix x) 1)
+
+;; (defcong uv-equiv equal (v2n x) 1
+;;   :hints (("goal" :use ((:instance v2n-ufix (v x))
+;;                         (:instance v2n-ufix (v x-equiv)))
+;;            :in-theory (disable v2n-ufix))))
+
+;; (defthm ufix-of-ufix
+;;   (equal (ufix (ufix x)) (ufix x)))
+
+
+;; (defcong uv-equiv uv-equiv (cdr x) 1
+;;   :hints(("Goal" :in-theory (enable ucons))))
+
+;; (defcong uv-equiv iff (car a) 1
+;;   :hints(("Goal" :in-theory (enable ucons))))
 
+;; (defthmd uv-equiv-implies-cars-equiv
+;;   (implies (not (iff (car a) (car b)))
+;;            (not (uv-equiv a b)))
+;;   :hints(("Goal" :in-theory (enable ucons))))
 
+;; (defthmd equal-of-ucons
+;;   (equal (uv-equiv (ucons x y) z)
+;;          (and (iff (car z) x)
+;;               (uv-equiv y (cdr z))))
+;;   :hints(("Goal" :in-theory (enable ucons))))
 
-(defthm us-to-num
-  (implies (natp n)
-           (equal (v2n (bfr-eval-list (n2v n) env))
-                  n))
-  :hints(("Goal" :in-theory (enable n2v v2n logbitp ash natp))))
-
-(defthm i2v-to-num
-  (implies (integerp n)
-           (equal (v2i (bfr-eval-list (i2v n) env)) n))
-  :hints(("Goal" :in-theory (enable i2v v2i logbitp
-                                    ash natp))))
 
 
+;; (defthm v2n-nonneg
+;;   (<= 0 (v2n v))
+;;   :rule-classes (:rewrite :linear :type-prescription))
+
+;; (in-theory (disable (:rewrite v2n-nonneg)
+;;                     (:linear v2n-nonneg)))
+
+;; (defthm n2v-v2n
+;;   (equal (n2v (v2n v)) (ufix v)))
+
+
+;; (in-theory (disable v2n n2v v2i i2v ash logbitp))
+
+
+
+
+
+;; ;; (defthm us-to-num
+;; ;;   (equal (v2n (bfr-eval-list (n2v n) env))
+;; ;;          (nfix n))
+;; ;;   :hints(("Goal" :in-theory (enable n2v v2n logbitp ash natp))))
+
+;; ;; (defthm i2v-to-num
+;; ;;   (equal (v2i (bfr-eval-list (i2v n) env))
+;; ;;          (ifix n))
+;; ;;   :hints(("Goal" :in-theory (enable i2v v2i logbitp
+;; ;;                                     ash natp))))
+
+;; (defthm bfr-max-nat-var-list-of-i2v
+;;   (equal (bfr-max-nat-var-list (i2v n)) 0)
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var-list i2v scons)
+;;                                  ((bfr-max-nat-var-list) (bfr-max-nat-var))))))
+
+;; (defthm bfr-max-nat-var-list-of-n2v
+;;   (equal (bfr-max-nat-var-list (n2v n)) 0)
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var-list n2v ucons)
+;;                                  ((bfr-max-nat-var-list) (bfr-max-nat-var))))))
+
+;; (defthm bfr-max-nat-var-list-of-ufix
+;;   (equal (bfr-max-nat-var-list (ufix x)) 0)
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var-list ufix ucons)
+;;                                  ((bfr-max-nat-var-list) (bfr-max-nat-var))))))
+
+;; (defthm bfr-max-nat-var-list-of-sfix
+;;   (equal (bfr-max-nat-var-list (sfix x)) 0)
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var-list sfix scons sterm)
+;;                                  ((bfr-max-nat-var-list) (bfr-max-nat-var))))))
+
+;; (defthm bfr-max-nat-var-of-car-when-s-endp
+;;   (implies (s-endp x)
+;;            (equal (bfr-max-nat-var (car x))
+;;                   (bfr-max-nat-var-list x)))
+;;   :hints(("Goal" :in-theory (enable s-endp bfr-max-nat-var-list)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+;; (defthm bfr-max-nat-var-list-of-append
+;;   (equal (bfr-max-nat-var-list (append x y))
+;;          (max (bfr-max-nat-var-list x)
+;;               (bfr-max-nat-var-list y)))
+;;   :hints(("Goal" :in-theory (e/d (bfr-max-nat-var-list)))))
+
+;; (defthm bfr-max-nat-var-list-of-last
+;;   (<= (bfr-max-nat-var-list (last x)) (bfr-max-nat-var-list x))
+;;   :hints(("Goal" :in-theory (enable bfr-max-nat-var-list)))
+;;   :rule-classes (:rewrite :linear))
+
+
+
+;; (acl2::def-universal-equiv
+;;  bfr-sv-equiv
+;;  :qvars (env)
+;;  :equiv-terms ((sv-equiv (bfr-eval-list x env))))
+
+;; (acl2::def-universal-equiv
+;;  bfr-uv-equiv
+;;  :qvars (env)
+;;  :equiv-terms ((uv-equiv (bfr-eval-list x env))))
+
+;; (defcong bfr-sv-equiv sv-equiv (bfr-eval-list x env) 1
+;;   :hints(("Goal" :in-theory (disable sv-equiv)
+;;           :use ((:instance bfr-sv-equiv-necc (y x-equiv))))))
+
+;; (defcong bfr-uv-equiv uv-equiv (bfr-eval-list x env) 1
+;;   :hints(("Goal" :in-theory (disable uv-equiv)
+;;           :use ((:instance bfr-uv-equiv-necc (y x-equiv))))))
+
+;; (defthm scdr-when-endp-under-bfr-sv-equiv
+;;   (implies (s-endp x)
+;;            (bfr-sv-equiv (scdr x) x))
+;;   :hints(("Goal" :in-theory (e/d (bfr-sv-equiv bfr-eval-list)))))
+
+;; (defthm scdr-when-endp
+;;   (implies (s-endp b)
+;;            (sv-equiv (scdr b) b))
+;;   :hints(("Goal" :in-theory (enable s-endp scdr)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0)))
diff -Nru acl2-6.2/books/centaur/gl/cert.acl2 acl2-6.3/books/centaur/gl/cert.acl2
--- acl2-6.2/books/centaur/gl/cert.acl2	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/cert.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,36 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
 ; We disabled waterfall parallelism for the gl books.  Many of them
 ; use the bfr-reasoning hint, which can modify state.  Here are at
 ; least some of the books that fail because of this:
 
-; centaur/gl/g-floor.lisp                      
-; centaur/gl/cert.acl2						 
-; centaur/gl/ite-merge.lisp					 
-; centaur/gl/hyp-fix-logic.lisp				 
-; centaur/gl/gl-generic-clause-proc.lisp		 
-; centaur/gl/symbolic-arithmetic.lisp			 
-; centaur/gl/gify-clause-proc.lisp			 
-; centaur/gl/gtests.lisp						 
-; centaur/gl/bvec-ite.lisp					 
+; centaur/gl/g-floor.lisp
+; centaur/gl/cert.acl2
+; centaur/gl/ite-merge.lisp
+; centaur/gl/hyp-fix-logic.lisp
+; centaur/gl/gl-generic-clause-proc.lisp
+; centaur/gl/symbolic-arithmetic.lisp
+; centaur/gl/gify-clause-proc.lisp
+; centaur/gl/gtests.lisp
+; centaur/gl/bvec-ite.lisp
 ; centaur/gl/bfr.lisp
 
 (set-waterfall-parallelism nil)
diff -Nru acl2-6.2/books/centaur/gl/constraint-db-deps.lisp acl2-6.3/books/centaur/gl/constraint-db-deps.lisp
--- acl2-6.2/books/centaur/gl/constraint-db-deps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/constraint-db-deps.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,522 @@
+
+(in-package "GL")
+
+(include-book "constraint-db")
+(include-book "glcp-unify-thms")
+
+(define gobj-alist-list-depends-on (k p x)
+  :verify-guards nil
+  (if (atom x)
+      nil
+    (or (gobj-alist-depends-on k p (car x))
+        (gobj-alist-list-depends-on k p (cdr x))))
+  ///
+  (defthm gobj-alist-list-depends-on-of-append
+    (equal (gobj-alist-list-depends-on k p (append a b))
+           (or (gobj-alist-list-depends-on k p a)
+               (gobj-alist-list-depends-on k p b)))
+    :hints(("Goal" :in-theory (enable gobj-alist-list-depends-on))))
+  (defthm gobj-alist-list-depends-on-nil
+         (not (gobj-alist-list-depends-on k p nil))
+         :hints(("Goal" :in-theory (enable gobj-alist-list-depends-on)))))
+
+(define gbc-sigtable-depends-on (k p sigtable)
+  :verify-guards nil
+  (if (atom sigtable)
+      nil
+    (if (atom (car sigtable))
+        (gbc-sigtable-depends-on k p (cdr sigtable))
+      (or (gobj-alist-list-depends-on k p (cdar sigtable))
+          (gbc-sigtable-depends-on k p (cdr sigtable))))))
+
+(define gbc-tuples-depends-on (k p tuples)
+  :verify-guards nil
+  (if (atom tuples)
+      nil
+    (or (gbc-sigtable-depends-on k p (constraint-tuple->sig-table (car tuples)))
+        (gbc-tuples-depends-on k p (cdr tuples)))))
+
+
+(define gbc-db-depends-on (k p ccat)
+  :verify-guards nil
+  (if (atom ccat)
+      nil
+    (if (atom (car ccat))
+        (gbc-db-depends-on k p (cdr ccat))
+      (or (gbc-tuples-depends-on k p (cdar ccat))
+          (gbc-db-depends-on k p (cdr ccat))))))
+
+
+(defsection gbc-db-emptyp
+
+  (define gbc-sigtable-emptyp (x)
+    :verify-guards nil
+    (if (atom x)
+        t
+      (and (or (atom (car x))
+               (subsetp (cdar x) '(nil)))
+           (gbc-sigtable-emptyp (cdr X))))
+    ///
+    (defthm gbc-sigtable-empty-implies-no-dependencies
+      (implies (gbc-sigtable-emptyp x)
+               (not (gbc-sigtable-depends-on k p x)))
+      :hints(("Goal" :in-theory (enable gbc-sigtable-depends-on
+                                        gobj-alist-list-depends-on)))))
+
+
+  (define gbc-tuples-emptyp (x)
+    :verify-guards nil
+    (if (atom x)
+        t
+      (and (gbc-sigtable-emptyp (constraint-tuple->sig-table (car x)))
+           (gbc-tuples-emptyp (cdr x))))
+    ///
+    (defthm gbc-tuples-empty-implies-no-dependencies
+      (implies (gbc-tuples-emptyp x)
+               (not (gbc-tuples-depends-on k p x)))
+      :hints(("Goal" :in-theory (enable gbc-tuples-depends-on)))))
+
+  (define gbc-db-emptyp (x)
+    :verify-guards nil
+    (if (atom x)
+        t
+      (and (or (atom (car x))
+               (gbc-tuples-emptyp (cdar x)))
+           (gbc-db-emptyp (cdr x))))
+    ///
+    (defthm gbc-db-emptyp-implies-no-dependencies
+      (implies (gbc-db-emptyp x)
+               (not (gbc-db-depends-on k p x)))
+      :hints(("Goal" :in-theory (enable gbc-db-depends-on))))))
+
+
+
+(defthm gbc-extend-substs-dependencies
+  (implies (and (not (gobj-alist-depends-on k p lit-subst))
+                (not (gobj-alist-list-depends-on k p partial-substs)))
+           (not (gobj-alist-list-depends-on k p (gbc-extend-substs lit-subst
+                                                                   partial-substs))))
+  :hints(("Goal" :in-theory (enable gobj-alist-list-depends-on))))
+
+(local (in-theory (enable alist-vals)))
+
+(defthm gbc-substs-check-syntaxp-dependencies
+  (implies (not (gobj-alist-list-depends-on k p substs))
+           (not (gobj-alist-list-depends-on
+                 k p (alist-vals (gbc-substs-check-syntaxp substs thmname syntaxp
+                                                           state)))))
+  :hints(("Goal" :in-theory (enable gbc-substs-check-syntaxp
+                                    gobj-alist-list-depends-on))))
+
+(defthm dependencies-of-sigtable-lookup
+  (implies (not (gbc-sigtable-depends-on k p sigtable))
+           (not (gobj-alist-list-depends-on k p (cdr (hons-assoc-equal sig
+                                                                       sigtable)))))
+  :hints(("Goal" :in-theory (enable gbc-sigtable-depends-on
+                                    gobj-alist-list-depends-on))))
+
+(defthm gbc-sort-substs-into-sigtable-dependencies
+  (implies (and (not (gobj-alist-list-depends-on k p substs))
+                (not (gbc-sigtable-depends-on k p sigtable)))
+           (not (gbc-sigtable-depends-on
+                 k p (gbc-sort-substs-into-sigtable substs common-vars
+                                                    sigtable))))
+  :hints(("Goal" :in-theory (enable gobj-alist-list-depends-on
+                                    gbc-sigtable-depends-on))))
+
+(defthm gbc-unbound-lits-add-to-existing-tuple-dependencies
+  (implies (and (not (gobj-alist-list-depends-on k p substs))
+                (not (gbc-tuples-depends-on k p tuples)))
+           (not (gbc-tuples-depends-on
+                 k p (mv-nth 1 (gbc-unbound-lits-add-to-existing-tuple
+                                rule existing-lits lit substs tuples)))))
+  :hints(("Goal" :in-theory (enable gbc-tuples-depends-on))))
+
+(defthm gbc-unbound-lits-add-tuples-dependencies
+  (implies (and (not (gobj-alist-list-depends-on k p substs))
+                (not (gbc-db-depends-on k p ccat)))
+           (not (gbc-db-depends-on k p (gbc-unbound-lits-add-tuples
+                                        litvars rule existing-lits
+                                        existing-vars substs ccat))))
+  :hints(("Goal" :in-theory (enable gbc-db-depends-on
+                                    gbc-tuples-depends-on))))
+
+
+;; (local (defthm gobj-alist-depends-on-nil
+;;          (not (gobj-alist-depends-on k p nil))
+;;          :hints(("Goal" :in-theory (enable gobj-alist-depends-on)))))
+
+(defthm dependencies-of-gbc-db-lookup
+  (implies (not (gbc-db-depends-on k p sigtable))
+           (not (gbc-tuples-depends-on k p (cdr (hons-assoc-equal sig sigtable)))))
+  :hints(("Goal" :in-theory (enable gbc-db-depends-on))))
+
+(defthm gbc-process-new-lit-tuple-dependencies
+  (implies (and (not (gobj-depends-on k p lit))
+                (not (gbc-sigtable-depends-on k p (constraint-tuple->sig-table
+                                                   tuple)))
+                (not (gbc-db-depends-on k p ccat)))
+           (mv-let (substs ccat)
+             (gbc-process-new-lit-tuple lit tuple ccat state)
+             (and (not (gobj-alist-list-depends-on k p (alist-vals substs)))
+                  (not (gbc-db-depends-on k p ccat)))))
+  :hints (("goal" :expand ((:free (a b) (gbc-db-depends-on k p (cons a b)))
+                           (:free (a b) (gbc-tuples-depends-on k p (cons a
+                                                                         b)))))))
+
+(local (defthm alist-vals-of-append
+         (equal (alist-vals (append a b))
+                (append (alist-vals a) (alist-vals b)))))
+
+
+
+(defthm gbc-process-new-lit-tuples-dependencies
+  (implies (and (not (gobj-depends-on k p lit))
+                (not (gbc-tuples-depends-on k p tuples))
+                (not (gbc-db-depends-on k p ccat)))
+           (mv-let (substs ccat)
+             (gbc-process-new-lit-tuples lit tuples ccat state)
+             (and (not (gobj-alist-list-depends-on k p (alist-vals substs)))
+                  (not (gbc-db-depends-on k p ccat)))))
+  :hints(("Goal" :in-theory (e/d (gbc-tuples-depends-on)
+                                 (gbc-process-new-lit-tuple)))))
+
+(defthm gbc-process-new-lit-dependencies
+  (implies (and (not (gobj-depends-on k p lit))
+                (not (gbc-db-depends-on k p ccat)))
+           (mv-let (substs ccat)
+             (gbc-process-new-lit lit ccat state)
+             (and (not (gobj-alist-list-depends-on k p (alist-vals substs)))
+                  (not (gbc-db-depends-on k p ccat)))))
+  :hints(("Goal" :in-theory (enable gbc-process-new-lit))))
+
+
+
+(defund parametrize-gobj-alists (p alists)
+  (declare (xargs :guard t))
+  (if (atom alists)
+      nil
+    (cons (gobj-alist-to-param-space (car alists) p)
+          (parametrize-gobj-alists p (cdr alists)))))
+
+(defund parametrize-sig-table (p sig-table)
+  (declare (xargs :guard t))
+  (if (atom sig-table)
+      nil
+    (if (atom (car sig-table))
+        (parametrize-sig-table p (cdr sig-table))
+      (hons-acons (gobj-list-to-param-space (caar sig-table) p)
+                  (parametrize-gobj-alists p (cdar sig-table))
+                  (parametrize-sig-table p (cdr sig-table))))))
+                   
+
+(defund parametrize-constraint-db-tuples (p tuples)
+  (declare (xargs :guard t))
+  (b* (((when (atom tuples)) nil)
+       ((unless (constraint-tuple-p (car tuples)))
+        (parametrize-constraint-db-tuples p (cdr tuples)))
+       ((constraint-tuple x) (car tuples))
+       (sig-table (parametrize-sig-table p x.sig-table)))
+    (fast-alist-free x.sig-table)
+    (cons (constraint-tuple x.rule x.existing-lits x.matching-lit x.common-vars
+                            x.existing-vars sig-table)
+          (parametrize-constraint-db-tuples p (cdr tuples)))))
+
+(defund parametrize-constraint-db (p ccat)
+  (declare (xargs :guard t))
+  (b* (((when (atom ccat)) nil)
+       ((when (atom (car ccat)))
+        (parametrize-constraint-db p (cdr ccat))))
+    (hons-acons (caar ccat)
+                (parametrize-constraint-db-tuples p (cdar ccat))
+                (parametrize-constraint-db p (cdr ccat)))))
+
+
+
+
+
+(defsection gobj-alist-list-vars-bounded
+  (defund gobj-alist-list-vars-bounded (k p x)
+    (if (atom x)
+        t
+      (and (gobj-alist-vars-bounded k p (car x))
+           (gobj-alist-list-vars-bounded k p (cdr x)))))
+
+  (defund gobj-alist-list-vars-bounded-witness (k p x)
+    (if (atom x)
+        nil
+      (or (gobj-alist-vars-bounded-witness k p (car x))
+          (gobj-alist-list-vars-bounded-witness k p (cdr x)))))
+
+  (local (in-theory (enable gobj-alist-list-vars-bounded
+                            gobj-alist-list-vars-bounded-witness)))
+
+  (local (in-theory (disable nfix)))
+
+  (defthm gobj-alist-list-vars-bounded-implies-not-depends-on
+    (implies (and (gobj-alist-list-vars-bounded k p x)
+                  (<= (nfix k) (nfix n)))
+             (not (gobj-alist-list-depends-on n p x)))
+    :hints(("Goal" :in-theory (e/d (gobj-alist-list-depends-on)))))
+
+  (defthm gobj-alist-list-vars-bounded-incr
+    (implies (and (gobj-alist-list-vars-bounded m p x)
+                  (<= (nfix m) (nfix n)))
+             (gobj-alist-list-vars-bounded n p x)))
+
+  (defthm gobj-alist-list-vars-bounded-witness-under-iff
+    (iff (gobj-alist-list-vars-bounded-witness k p x)
+         (not (gobj-alist-list-vars-bounded k p x))))
+
+  (defthmd gobj-alist-list-vars-bounded-in-terms-of-witness
+    (implies (acl2::rewriting-positive-literal
+              `(gobj-alist-list-vars-bounded ,k ,p ,x))
+             (equal (gobj-alist-list-vars-bounded k p x)
+                    (let ((n (gobj-alist-list-vars-bounded-witness k p x)))
+                      (or (< (nfix n) (nfix k))
+                          (not (gobj-alist-list-depends-on n p x))))))
+    :hints(("Goal" :in-theory (enable gobj-alist-list-depends-on
+                                      gobj-alist-vars-bounded-in-terms-of-witness))))
+
+  (defthm gobj-alist-list-vars-bounded-of-cons
+    (equal (gobj-alist-list-vars-bounded k p (cons a b))
+           (and (gobj-alist-vars-bounded k p a)
+                (gobj-alist-list-vars-bounded k p b))))
+
+  (defthm gobj-alist-list-vars-bounded-of-atom
+    (implies (not (consp x))
+             (equal (gobj-alist-list-vars-bounded k p x) t))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gobj-alist-list-vars-bounded-of-parametrize-gobj-alists
+    (implies (gobj-alist-list-vars-bounded k t x)
+             (gobj-alist-list-vars-bounded
+              k p (parametrize-gobj-alists p x)))
+    :hints(("Goal" :in-theory (enable gobj-alist-list-vars-bounded
+                                      parametrize-gobj-alists)))))
+
+
+(defsection gbc-sigtable-vars-bounded
+  (defund gbc-sigtable-vars-bounded (k p x)
+    (if (atom x)
+        t
+      (and (or (atom (car x))
+               (gobj-alist-list-vars-bounded k p (cdar x)))
+           (gbc-sigtable-vars-bounded k p (cdr x)))))
+
+  (defund gbc-sigtable-vars-bounded-witness (k p x)
+    (if (atom x)
+        nil
+      (or (and (consp (car x))
+               (gobj-alist-list-vars-bounded-witness k p (cdar x)))
+          (gbc-sigtable-vars-bounded-witness k p (cdr x)))))
+
+  (local (in-theory (enable gbc-sigtable-vars-bounded
+                            gbc-sigtable-vars-bounded-witness)))
+
+  (local (in-theory (disable nfix)))
+
+  (defthm gbc-sigtable-vars-bounded-implies-not-depends-on
+    (implies (and (gbc-sigtable-vars-bounded k p x)
+                  (<= (nfix k) (nfix n)))
+             (not (gbc-sigtable-depends-on n p x)))
+    :hints(("Goal" :in-theory (e/d (gbc-sigtable-depends-on)))))
+
+  (defthm gbc-sigtable-vars-bounded-incr
+    (implies (and (gbc-sigtable-vars-bounded m p x)
+                  (<= (nfix m) (nfix n)))
+             (gbc-sigtable-vars-bounded n p x)))
+
+  (defthm gbc-sigtable-vars-bounded-witness-under-iff
+    (iff (gbc-sigtable-vars-bounded-witness k p x)
+         (not (gbc-sigtable-vars-bounded k p x))))
+
+  (defthmd gbc-sigtable-vars-bounded-in-terms-of-witness
+    (implies (acl2::rewriting-positive-literal
+              `(gbc-sigtable-vars-bounded ,k ,p ,x))
+             (equal (gbc-sigtable-vars-bounded k p x)
+                    (let ((n (gbc-sigtable-vars-bounded-witness k p x)))
+                      (or (< (nfix n) (nfix k))
+                          (not (gbc-sigtable-depends-on n p x))))))
+    :hints(("Goal" :in-theory (enable gbc-sigtable-depends-on
+                                      gobj-alist-list-vars-bounded-in-terms-of-witness))))
+
+  (defthm gbc-sigtable-vars-bounded-of-cons
+    (equal (gbc-sigtable-vars-bounded k p (cons a b))
+           (and (or (atom a)
+                    (gobj-alist-list-vars-bounded k p (cdr a)))
+                (gbc-sigtable-vars-bounded k p b))))
+
+  (defthm gbc-sigtable-vars-bounded-of-atom
+    (implies (not (consp x))
+             (equal (gbc-sigtable-vars-bounded k p x) t))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+  (defthm gbc-sigtable-vars-bounded-of-parametrize-sig-table
+    (implies (gbc-sigtable-vars-bounded k t x)
+             (gbc-sigtable-vars-bounded
+              k p (parametrize-sig-table p x)))
+    :hints(("Goal" :in-theory (enable gbc-sigtable-vars-bounded
+                                      parametrize-sig-table)))))
+
+
+(defsection gbc-tuples-vars-bounded
+  (defund gbc-tuples-vars-bounded (k p x)
+    (if (atom x)
+        t
+      (and (gbc-sigtable-vars-bounded k p (constraint-tuple->sig-table (car x)))
+           (gbc-tuples-vars-bounded k p (cdr x)))))
+
+  (defund gbc-tuples-vars-bounded-witness (k p x)
+    (if (atom x)
+        nil
+      (or (gbc-sigtable-vars-bounded-witness k p (constraint-tuple->sig-table (car x)))
+          (gbc-tuples-vars-bounded-witness k p (cdr x)))))
+
+  (local (in-theory (enable gbc-tuples-vars-bounded
+                            gbc-tuples-vars-bounded-witness)))
+
+  (local (in-theory (disable nfix)))
+
+  (defthm gbc-tuples-vars-bounded-implies-not-depends-on
+    (implies (and (gbc-tuples-vars-bounded k p x)
+                  (<= (nfix k) (nfix n)))
+             (not (gbc-tuples-depends-on n p x)))
+    :hints(("Goal" :in-theory (e/d (gbc-tuples-depends-on)))))
+
+  (defthm gbc-tuples-vars-bounded-incr
+    (implies (and (gbc-tuples-vars-bounded m p x)
+                  (<= (nfix m) (nfix n)))
+             (gbc-tuples-vars-bounded n p x)))
+
+  (defthm gbc-tuples-vars-bounded-witness-under-iff
+    (iff (gbc-tuples-vars-bounded-witness k p x)
+         (not (gbc-tuples-vars-bounded k p x))))
+
+  (defthmd gbc-tuples-vars-bounded-in-terms-of-witness
+    (implies (acl2::rewriting-positive-literal
+              `(gbc-tuples-vars-bounded ,k ,p ,x))
+             (equal (gbc-tuples-vars-bounded k p x)
+                    (let ((n (gbc-tuples-vars-bounded-witness k p x)))
+                      (or (< (nfix n) (nfix k))
+                          (not (gbc-tuples-depends-on n p x))))))
+    :hints(("Goal" :in-theory (enable gbc-tuples-depends-on
+                                      gbc-sigtable-vars-bounded-in-terms-of-witness))))
+
+  (defthm gbc-tuples-vars-bounded-of-cons
+    (equal (gbc-tuples-vars-bounded k p (cons a b))
+           (and (gbc-sigtable-vars-bounded k p (constraint-tuple->sig-table a))
+                (gbc-tuples-vars-bounded k p b))))
+
+  (defthm gbc-tuples-vars-bounded-of-atom
+    (implies (not (consp x))
+             (equal (gbc-tuples-vars-bounded k p x) t))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gbc-tuples-vars-bounded-of-parametrize-constraint-db-tuples
+    (implies (gbc-tuples-vars-bounded k t x)
+             (gbc-tuples-vars-bounded
+              k p (parametrize-constraint-db-tuples p x)))
+    :hints(("Goal" :in-theory (enable gbc-tuples-vars-bounded
+                                      parametrize-constraint-db-tuples)))))
+
+
+
+(defsection gbc-db-vars-bounded
+  (defund gbc-db-vars-bounded (k p x)
+    (if (atom x)
+        t
+      (and (or (atom (car x))
+               (gbc-tuples-vars-bounded k p (cdar x)))
+           (gbc-db-vars-bounded k p (cdr x)))))
+
+  (defund gbc-db-vars-bounded-witness (k p x)
+    (if (atom x)
+        nil
+      (or (and (consp (car x))
+               (gbc-tuples-vars-bounded-witness k p (cdar x)))
+          (gbc-db-vars-bounded-witness k p (cdr x)))))
+
+  (local (in-theory (enable gbc-db-vars-bounded
+                            gbc-db-vars-bounded-witness)))
+
+  (local (in-theory (disable nfix)))
+
+  (defthm gbc-db-vars-bounded-implies-not-depends-on
+    (implies (and (gbc-db-vars-bounded k p x)
+                  (<= (nfix k) (nfix n)))
+             (not (gbc-db-depends-on n p x)))
+    :hints(("Goal" :in-theory (e/d (gbc-db-depends-on)))))
+
+  (defthm gbc-db-vars-bounded-incr
+    (implies (and (gbc-db-vars-bounded m p x)
+                  (<= (nfix m) (nfix n)))
+             (gbc-db-vars-bounded n p x)))
+
+  (defthm gbc-db-vars-bounded-witness-under-iff
+    (iff (gbc-db-vars-bounded-witness k p x)
+         (not (gbc-db-vars-bounded k p x))))
+
+  (defthmd gbc-db-vars-bounded-in-terms-of-witness
+    (implies (acl2::rewriting-positive-literal
+              `(gbc-db-vars-bounded ,k ,p ,x))
+             (equal (gbc-db-vars-bounded k p x)
+                    (let ((n (gbc-db-vars-bounded-witness k p x)))
+                      (or (< (nfix n) (nfix k))
+                          (not (gbc-db-depends-on n p x))))))
+    :hints(("Goal" :in-theory (enable gbc-db-depends-on
+                                      gbc-tuples-vars-bounded-in-terms-of-witness))))
+
+  (defthm gbc-db-vars-bounded-of-cons
+    (equal (gbc-db-vars-bounded k p (cons a b))
+           (and (or (atom a)
+                    (gbc-tuples-vars-bounded k p (cdr a)))
+                (gbc-db-vars-bounded k p b))))
+
+  (defthm gbc-db-vars-bounded-of-atom
+    (implies (not (consp x))
+             (equal (gbc-db-vars-bounded k p x) t))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+  (defthm gbc-db-vars-bounded-of-parametrize-constraint-db
+    (implies (gbc-db-vars-bounded k t x)
+             (gbc-db-vars-bounded
+              k p (parametrize-constraint-db p x)))
+    :hints(("Goal" :in-theory (enable gbc-db-vars-bounded
+                                      parametrize-constraint-db)))))
+
+
+
+
+
+(defthm gbc-process-new-lit-bounded
+  (implies (and (gobj-vars-bounded k p lit)
+                (gbc-db-vars-bounded k p ccat))
+           (mv-let (substs ccat)
+             (gbc-process-new-lit lit ccat state)
+             (and (gobj-alist-list-vars-bounded k p (alist-vals substs))
+                  (gbc-db-vars-bounded k p ccat))))
+  :hints (("goal" :in-theory (enable
+                              gobj-alist-list-vars-bounded-in-terms-of-witness
+                              gbc-db-vars-bounded-in-terms-of-witness))))
+
+
+           
+
+(defthm gbc-db-vars-bounded-of-incr
+  (implies (and (gbc-db-vars-bounded n p x)
+                (<= (nfix n) (nfix k)))
+           (gbc-db-vars-bounded k p x))
+  :hints (("goal" :in-theory (e/d (gbc-db-vars-bounded-in-terms-of-witness)
+                                  (nfix)))))
+
+
+
+(defthmd gbc-db-empty-implies-gbc-db-vars-bounded
+  (implies (gbc-db-emptyp x)
+           (gbc-db-vars-bounded k p x))
+  :hints(("Goal" :in-theory (enable gbc-db-vars-bounded-in-terms-of-witness))))
+
+
diff -Nru acl2-6.2/books/centaur/gl/constraint-db.lisp acl2-6.3/books/centaur/gl/constraint-db.lisp
--- acl2-6.2/books/centaur/gl/constraint-db.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/constraint-db.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,413 @@
+
+
+(in-package "GL")
+
+(include-book "clause-processors/unify-subst" :dir :system)
+(include-book "glcp-unify-defs")
+(include-book "clause-processors/magic-ev" :dir :system)
+
+
+(defun gl-bool-fix (x)
+  (and x t))
+
+;; A constraint rule is written as follows:
+
+;; (gl::def-gl-boolean-constraint thmname
+;;        :bindings ((x (logbitp n a))
+;;                   (y (logbitp m a)))
+;;        :syntaxp (and (<< n m)
+;;                      (not (and (atom n) (atom m))))
+;;        :body (implies (equal n m)
+;;                       (equal x y))
+;;        :hints ...)
+
+;; This generates an ACL2 theorem:
+;; (defthm thmname
+;;    (let ((x (gl-bool-fix (logbitp n a)))
+;;          (y (gl-bool-fix (logbitp m a))))
+;;       (implies (equal n m)
+;;                (equal x y)))
+;;   :hints ...
+;;   :rule-classes nil).
+
+;; The point of this rule is to add a constraint when we have two Boolean
+;; variables generated from (logbitp n a) terms.  When we find two such
+;; variables, we call their corresponding terms the literals of the
+;; constraint.  We generate the constraint by unifying the literals with the
+;; bindings from the constraint rule and then symbolically executing the body
+;; of the theorem under a Boolean context.  Since it's a theorem, we can assume
+;; the symbolic-Boolean result to be true under our bvar-db.
+
+
+
+;; To find such literals, we maintain a constraint catalog, a data structure
+;; that lets us quickly match a new literal to existing ones.  This uses a
+;; several-levels lookup system, as follows.
+;; 
+;; Outermost structure is indexed by the first function symbol of the literal.
+;; Inside that is a list of tuples:
+;; (rule existing-lits matching-lit common-variables signature-table)
+;; rule is a constraint rule structure, matching-lit is the variable of the
+;; lit pattern we'll match against, existing-lits are variables of lit
+;; patterns for which literals have already been found.
+;; Common-vars are the intersection of the vars of the matching-lit pattern
+;; with the vars of the existing-lit patterns.
+;; Signature-table maps signatures to partial unifying substitution lists.  A
+;; signature is the list of unifying bindings of common-vars.
+
+;; So to find new constraints given a new literal:
+;; - look up the tuples for that literal's leading function symbol
+;; - for each tuple,
+;;      unify the literal with the matching-lit of the rule
+;;      extract the bindings of common-vars to make the signature
+;;      look up the signature in the signature-table to get the partial substs
+;;      for each partial unifying subst, union the unifying subst for the
+;;          literal.
+;;      If the matching-lit + existing-lits are all the literals of the rule,
+;;      then these substitutions are now complete and can be used to generate constraints.
+;;      Otherwise, new entries should be added to the constraint-catalog for
+;;      each other literal of the rule, as follows:
+;;  under the function symbol of the addtl-literal,
+;;    find the tuple matching (rule existing-lits+matching-lit addtl-lit ....)
+;;    create it if not, computing the common-vars
+;;    for each partial-subst:
+;;        extract the common-vars to get the signature
+;;        add the partial-subst to the list for that signature.
+
+;; As a GL proof progresses, new literals may be added to the bvar-db and the
+;; constraint-table may be extended.  But we start with a base constraint-table
+;; at the beginning of any proof; this is stored in an ACL2 table.  In this
+;; initial constraing table, each tuple has empty existing-lits, thus empty
+;; common-vars and thus the unique signature is NIL, and a single empty
+;; partial unifying subst is stored under that signature.
+
+;; Heuristic info about a constraint rule.
+;; We'll look up the theorem in the world, so it doesn't need to be stored
+;; here.
+;; Constrained-terms is an alist mapping variables to terms.
+(cutil::defaggregate constraint-rule
+  (thmname lit-alist syntaxp))
+
+;; this is the tuple referred to above
+(cutil::defaggregate constraint-tuple
+  (rule existing-lits matching-lit common-vars existing-vars sig-table))
+
+
+;; Code to add a rule to the initial catalog (with empty existing-lits etc).
+(defun gbc-rule-lit-add-catalog-entry (var pat rule ccat)
+  (b* ((fnsym (car pat))
+       (tuples (cdr (hons-assoc-equal fnsym ccat)))
+       ;; assume rule is new, so no matching tuple exists -- just cons on a new
+       ;; one.
+       ;; signature-table contains nil mapped to (list nil) -- list containing
+       ;; one empty unifying subst
+       (new-tuple (constraint-tuple rule nil var nil nil (hons-acons nil (list nil) nil))))
+    (cons (cons fnsym (cons new-tuple tuples)) ccat)))
+
+(defun gbc-rule-add-catalog-entries (lit-alist rule ccat)
+  (b* (((when (atom lit-alist)) ccat)
+       ((cons var pat) (car lit-alist))
+       (ccat (gbc-rule-lit-add-catalog-entry var pat rule ccat)))
+    (gbc-rule-add-catalog-entries (cdr lit-alist) rule ccat)))
+
+
+;; Optimization: if two constrained terms are isomorphic (they unify with the
+;; same terms), and there's no syntaxp, then there's no need to list the rule
+;; under both of them
+(defun gbc-alist-has-symmetric (term alist)
+  (b* (((when (atom alist)) nil)
+       (term2 (cdar alist))
+       ((mv ok1 &) (acl2::simple-one-way-unify term term2 nil))
+       ((mv ok2 &) (acl2::simple-one-way-unify term2 term nil)))
+    (or (and ok1 ok2)
+        (gbc-alist-has-symmetric term (cdr alist)))))
+
+(defun gbc-alist-remove-symmetric (alist)
+  (if (atom alist)
+      nil
+    (if (gbc-alist-has-symmetric (cdar alist) (cdr alist))
+        (gbc-alist-remove-symmetric (cdr alist))
+      (cons (car alist) (gbc-alist-remove-symmetric (cdr alist))))))
+
+
+    
+
+(defun gbc-rule-add-to-catalog (rule ccat)
+  ;; Iterate over the constraint-alist.
+  (b* ((syntaxp (constraint-rule->syntaxp rule))
+       (alist (constraint-rule->lit-alist rule))
+       (reduced-alist (if (equal syntaxp ''t)
+                          (gbc-alist-remove-symmetric alist)
+                        alist)))
+    (hons-shrink-alist
+     (gbc-rule-add-catalog-entries reduced-alist rule ccat)
+     nil)))
+
+(defmacro gbc-add-rule (name lit-alist syntaxp)
+  `(table gl::gl-bool-constraints
+          nil
+          (gbc-rule-add-to-catalog
+           (constraint-rule ',name ',lit-alist ',syntaxp)
+           (table-alist 'gl::gl-bool-constraints world))
+          :clear))
+
+
+
+
+(defun gbc-translate-lit-alist (lit-patterns state)
+  (declare (xargs :mode :program :stobjs state))
+  (b* (((when (atom lit-patterns)) (value nil))
+       ((list var term) (car lit-patterns))
+       ((er trans) (acl2::translate term t t nil 'def-gl-boolean-constraint (w state)
+                              state))
+       ((er rest) (gbc-translate-lit-alist (cdr lit-patterns) state)))
+    (value (cons (cons var trans) rest))))
+       
+
+
+(defun def-gl-boolean-constraint-fn (name lit-patterns syntaxp body hints state)
+  (declare (xargs :mode :program :stobjs state))
+  (b* (((er syntaxp-trans) (acl2::translate syntaxp t t nil 'def-gl-boolean-constraint
+                                      (w state) state))
+       ((er alist) (gbc-translate-lit-alist lit-patterns state))
+       (body1 `(let ,(pairlis$ (strip-cars lit-patterns)
+                               (pairlis$ (pairlis$ 
+                                          (make-list-ac (len lit-patterns) 'gl-bool-fix nil)
+                                          (strip-cdrs lit-patterns))
+                                         nil))
+                 ,body)))
+    (value `(progn (defthm ,name
+                     ,body1
+                     :hints ,hints
+                     :rule-classes nil)
+                   (gbc-add-rule ,name ,alist ,syntaxp-trans)))))
+
+(defsection def-gl-boolean-constraint
+  :parents (reference g-call)
+  :short "Define a rule that recognizes constraints among GL generated Boolean variables"
+  :long "
+<p>When using GL in a term-level style (see @(see term-level-reasoning)), GL
+may generate new Boolean variables from terms that appear as IF tests.</p>
+
+<p>Sometimes, the terms from which these variables are generated have
+interdependent meanings.  For example, if Boolean variable @('a') represents
+@('(logbitp 5 x)') and Boolean variable @('b') represents @('(integerp x)'), it
+should be impossible for @('a') to be true when @('b') is false.  However, by
+default, the Boolean variables generated this way are unconstrained.  When
+this sort of interdependency among variables exists but is not accounted for,
+it can cause GL to find @(see false-counterexamples).</p>
+
+<p>@('Def-gl-boolean-constraint') provides a mechanism to make such constraints
+known to GL.  While symbolically executing a form, GL maintains a constraint, a
+Boolean formula known to always be true (under the evolving assignment of
+Boolean variables to terms).  </p>"
+
+
+  (defmacro def-gl-boolean-constraint (name &key bindings (syntaxp ''t) body
+                                            hints)
+    `(make-event
+      (def-gl-boolean-constraint-fn
+        ',name ',bindings ',syntaxp ',body ',hints state))))
+
+(defun gbc-signature (common-vars subst)
+  (if (atom common-vars)
+      nil
+    (hons (cdr (assoc (car common-vars) subst))
+          (gbc-signature (cdr common-vars) subst))))
+
+(defun gbc-extend-substs (lit-subst partial-substs)
+  (if (atom partial-substs)
+      nil
+    ;; is append good enough? I think so
+    (cons (append lit-subst (car partial-substs))
+          (gbc-extend-substs lit-subst (cdr partial-substs)))))
+
+(defun gbc-substs-check-syntaxp (substs thmname syntaxp state)
+  (declare (xargs :stobjs state :verify-guards nil))
+  (b* (((when (atom substs)) nil)
+       ((mv err ok) (acl2::magic-ev syntaxp (car substs) state t t))
+       ((when (or err (not ok)))
+        (gbc-substs-check-syntaxp (cdr substs) thmname syntaxp state)))
+    (cons (cons thmname (car substs))
+          (gbc-substs-check-syntaxp (cdr substs) thmname syntaxp state))))
+
+
+(defun gbc-sort-substs-into-sigtable (substs common-vars sigtable)
+  (b* (((when (atom substs)) sigtable)
+       (subst (car substs))
+       (sig (gbc-signature common-vars subst))
+       (sig-substs (cdr (hons-get sig sigtable)))
+       (sigtable (hons-acons sig (cons subst sig-substs) sigtable)))
+    (gbc-sort-substs-into-sigtable (cdr substs) common-vars sigtable)))
+
+(defun gbc-unbound-lits-add-to-existing-tuple (rule existing-lits lit substs tuples)
+  (b* (((when (atom tuples)) (mv nil tuples))
+       ((constraint-tuple x) (car tuples))
+       ((unless (and (equal rule x.rule)
+                     (equal existing-lits x.existing-lits)
+                     (equal lit x.matching-lit)))
+        (b* (((mv found rest)
+              (gbc-unbound-lits-add-to-existing-tuple
+               rule existing-lits lit substs (cdr tuples)))
+             ((when found)
+              (mv t (cons (car tuples) rest))))
+          (mv nil tuples)))
+       (sigtable (gbc-sort-substs-into-sigtable substs x.common-vars
+                                                x.sig-table)))
+    (mv t
+        (cons (constraint-tuple rule existing-lits lit
+                                x.common-vars x.existing-vars sigtable)
+              (cdr tuples)))))
+
+
+(defun gbc-unbound-lits-add-tuples (litvars rule existing-lits existing-vars
+                                            substs ccat)
+  (b* (((when (atom litvars)) ccat)
+       (var (car litvars))
+       ((constraint-rule r) rule)
+       (lit (cdr (hons-assoc-equal var r.lit-alist)))
+       (fnsym (car lit))
+       (tuples (cdr (hons-get fnsym ccat)))
+       ((mv found tuples)
+        (gbc-unbound-lits-add-to-existing-tuple
+         rule existing-lits var substs tuples))
+       ((when found)
+        (hons-acons fnsym tuples ccat))
+       (lit-vars (sets::mergesort (acl2::simple-term-vars lit)))
+       (common-vars (sets::intersect existing-vars lit-vars))
+       (sigtable (gbc-sort-substs-into-sigtable substs common-vars nil))
+       (new-tuple (constraint-tuple rule existing-lits var common-vars
+                                    existing-vars sigtable)))
+    (hons-acons fnsym (cons new-tuple tuples) ccat)))
+
+(defun gbc-process-new-lit-tuple (lit tuple ccat state)
+  (declare (xargs :stobjs state :verify-guards nil))
+  (b* (((constraint-tuple x) tuple)
+       ;; (rule existing-lits matching-lit common-vars existing-vars sig-table)
+       ((constraint-rule r) x.rule)
+       ;; (thmname lit-alist syntaxp)
+       (pat (cdr (hons-assoc-equal x.matching-lit r.lit-alist)))
+       ((mv ok lit-subst) (glcp-unify-term/gobj pat lit nil))
+       ((unless ok) (mv nil ccat))
+       (sig (gbc-signature x.common-vars lit-subst))
+       (partial-substs (cdr (hons-get sig x.sig-table)))
+       (new-substs (gbc-extend-substs lit-subst partial-substs))
+       (rest-litvars (set-difference-eq (strip-cars r.lit-alist)
+                                        (cons x.matching-lit x.existing-lits)))
+       ;; (- (cw "rest-litvars: ~x0 matching: ~x1 existing: ~x2~%" rest-litvars
+       ;;        x.matching-lit x.existing-lits))
+       ((unless rest-litvars)
+        (b* ((substs (gbc-substs-check-syntaxp new-substs r.thmname r.syntaxp state)))
+          (mv substs ccat)))
+       (new-existing-vars (sets::union (sets::mergesort (strip-cars lit-subst))
+                                       x.existing-vars))
+       ;; unbound lits remaining -- add to ccat
+       (ccat (gbc-unbound-lits-add-tuples 
+              rest-litvars
+              x.rule
+              ;; need to keep these canonical
+              ;; so that we can find an existing
+              ;; tuple if it exists
+              (sets::insert x.matching-lit x.existing-lits)
+              new-existing-vars
+              new-substs
+              ccat)))
+    (mv nil ccat)))
+
+
+       
+
+(defun gbc-process-new-lit-tuples (lit tuples ccat state)
+  (declare (xargs :stobjs state :verify-guards nil))
+  (b* (((when (atom tuples)) (mv nil ccat))
+       ((mv substs1 ccat)
+        (gbc-process-new-lit-tuple lit (car tuples) ccat state))
+       ((mv substs-rest ccat)
+        (gbc-process-new-lit-tuples lit (cdr tuples) ccat state)))
+    (mv (append substs1 substs-rest) ccat)))
+
+
+(defund gbc-process-new-lit (lit ccat state)
+  (declare (xargs :stobjs state :verify-guards nil))
+  (b* (((unless (and (consp lit)
+                     (eq (tag lit) :g-apply)))
+        (mv nil ccat))
+       (tuples (cdr (hons-get (g-apply->fn lit) ccat))))
+    (gbc-process-new-lit-tuples lit tuples ccat state)))
+
+
+(defun gbc-tuples-make-fast (x)
+  (if (atom x)
+      nil
+    (cons (change-constraint-tuple (car x)
+                                   :sig-table
+                                   (make-fast-alist
+                                    (constraint-tuple->sig-table (car x))))
+          (gbc-tuples-make-fast (cdr x)))))
+
+(defun gbc-tuples-free (x)
+  (if (atom x)
+      nil
+    (prog2$ (fast-alist-free (constraint-tuple->sig-table (car x)))
+            (gbc-tuples-free (cdr x)))))
+
+(defun gbc-db-make-fast-rec (x acc)
+  (b* (((when (atom x)) acc)
+       (acc (if (and (consp (car x))
+                     (not (hons-get (caar x) acc)))
+                (hons-acons (caar x)
+                            (gbc-tuples-make-fast (cdar x))
+                            acc)
+              acc)))
+    (gbc-db-make-fast-rec (cdr x) acc)))
+
+(defund gbc-db-make-fast (x)
+  (gbc-db-make-fast-rec x nil))
+
+(defun gbc-db-free-rec (x)
+  (if (atom x)
+      nil
+    (prog2$ (and (consp (car x))
+                 (gbc-tuples-free (cdar x)))
+            (gbc-db-free-rec (cdr x)))))
+
+(defund gbc-db-free (x)
+  (gbc-db-free-rec (fast-alist-free x)))
+
+
+
+
+#||
+
+(gl::def-gl-boolean-constraint logbitp-n-m
+       :bindings ((x (logbitp n a))
+                  (y (logbitp m a)))
+       :syntaxp (and (acl2::<< n m)
+                     (not (and (atom n) (atom m))))
+       :body (implies (equal n m)
+                      (equal x y)))
+
+(time$ (b* ((ccat (table-alist 'gl-bool-constraints (w state)))
+     ((mv substs ccat)
+      (gbc-process-new-lit '(:g-apply logbitp (fff) q) ccat state))
+     (- (cw "substs1: ~x0~%" substs))
+     (ccat (hons-shrink-alist ccat nil))
+     (state (f-put-global 'ccat1 ccat state))
+     ((mv substs ccat)
+      (gbc-process-new-lit '(:g-apply logbitp (qwr) b) ccat state))
+     (- (cw "substs2: ~x0~%" substs))
+     (ccat (hons-shrink-alist ccat nil))
+     (state (f-put-global 'ccat2 ccat state))
+     ((mv substs ccat)
+      (gbc-process-new-lit '(:g-apply logbitp (qwf) q) ccat state))
+     (- (cw "substs3: ~x0~%" substs))
+     (ccat (hons-shrink-alist ccat nil))
+     (state (f-put-global 'ccat3 ccat state))
+     ((mv substs ccat)
+      (gbc-process-new-lit '(:g-apply logbitp (fff) b) ccat state))
+     (- (cw "substs4: ~x0~%" substs))
+     (ccat (hons-shrink-alist ccat nil))
+     (state (f-put-global 'ccat3 ccat state)))
+  state))
+
+||#
diff -Nru acl2-6.2/books/centaur/gl/ctrex-utils.lisp acl2-6.3/books/centaur/gl/ctrex-utils.lisp
--- acl2-6.2/books/centaur/gl/ctrex-utils.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/ctrex-utils.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,1123 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "bvar-db")
+(include-book "cutil/defaggregate" :dir :system)
+(include-book "clause-processors/meta-extract-user" :dir :system)
+(include-book "bfr")
+(include-book "bfr-sat")
+(include-book "centaur/aig/misc" :dir :system)
+(include-book "param")
+(include-book "centaur/misc/vecs-ints" :dir :system)
+(include-book "std/misc/two-nats-measure" :dir :system)
+(include-book "generic-geval")
+(include-book "glcp-config")
+(include-book "centaur/misc/hons-extra" :dir :system)
+(local (include-book "centaur/misc/arith-equivs" :dir :system))
+(set-state-ok t)
+
+;; To-satisfying-assign-spec generates the same satisfying assignment as
+;; to-satisfying-assign given the same lst and bdd, except that when a
+;; variable's value is irrelevant (car and cdr are equal), we put X in the list
+;; instead of T or NIL.
+(defun to-satisfying-assign-spec (lst bdd)
+  (declare (xargs :hints (("goal" :in-theory (enable acl2-count)))))
+  (cond ((atom bdd) lst)
+        ((eq (cdr bdd) nil) (cons t (to-satisfying-assign-spec lst (car bdd))))
+        ((eq (car bdd) nil) (cons nil (to-satisfying-assign-spec lst (cdr bdd))))
+        ((hqual (car bdd) (cdr bdd))
+         (cons 'x (to-satisfying-assign-spec (cdr lst) (car bdd))))
+        (t (cons (car lst) (to-satisfying-assign-spec
+                            (cdr lst)
+                            (if (car lst) (car bdd) (cdr bdd)))))))
+
+
+(defun n-satisfying-assigns-and-specs (n hyp-bdd bdd bound state)
+  (declare (ignorable hyp-bdd))
+  (if (zp n)
+      (value nil)
+    (b* (((mv rand state) (acl2::random$ (ash 1 bound) state))
+         (lst (acl2::nat-to-v rand bound))
+         ;; From when we passed in the unparametrized counterexample BDD:
+;;          (assign (to-satisfying-assign lst bdd))
+;;          (assign-spec (to-satisfying-assign-spec lst bdd))
+         (assign (to-satisfying-assign lst bdd))
+         (assign-spec (to-satisfying-assign-spec lst (acl2::from-param-space hyp-bdd bdd)))
+         ((er rest) (n-satisfying-assigns-and-specs (1- n) hyp-bdd bdd bound state)))
+      (value (cons (list* "generated randomly:" assign assign-spec) rest)))))
+
+(defthm n-satisfying-assigns-does-not-fail
+  (not (mv-nth 0 (n-satisfying-assigns-and-specs n hyp-bdd bdd bound state))))
+
+
+(defun vars-onto-alist (vars val al)
+  (if (atom vars)
+      al
+    (if (hons-get (car vars) al)
+        (vars-onto-alist (cdr vars) val al)
+      (vars-onto-alist (cdr vars) val (hons-acons (car vars) val al)))))
+
+(defun nat-list-max (x)
+  (declare (xargs :guard (nat-listp x)
+                  :guard-hints (("goal" :in-theory (enable nat-listp)))))
+  (if (atom x)
+      0
+    (max (+ 1 (lnfix (car x)))
+         (nat-list-max (cdr x)))))
+
+
+
+(mutual-recursion
+ (defun shape-spec-max-bvar (x)
+   (declare (xargs :guard (shape-specp x)
+                   :verify-guards nil))
+   (if (atom x)
+       0
+     (case (tag x)
+       (:g-number (b* ((num (g-number->num x))
+                       ((list rn rd in id) num))
+                    (max (nat-list-max rn)
+                         (max (nat-list-max rd)
+                              (max (nat-list-max in)
+                                   (nat-list-max id))))))
+       (:g-integer (max (+ 1 (lnfix (g-integer->sign x)))
+                        (nat-list-max (g-integer->bits x))))
+       (:g-integer? (max (+ 1 (lnfix (g-integer?->sign x)))
+                         (max (+ 1 (lnfix (g-integer?->intp x)))
+                              (nat-list-max (g-integer?->bits x)))))
+       (:g-boolean (+ 1 (lnfix (g-boolean->bool x))))
+       (:g-concrete 0)
+       (:g-var 0)
+       (:g-ite (max (shape-spec-max-bvar (g-ite->test x))
+                    (max (shape-spec-max-bvar (g-ite->then x))
+                         (shape-spec-max-bvar (g-ite->else x)))))
+       (:g-call (shape-spec-max-bvar-list (g-call->args x)))
+       (otherwise (max (shape-spec-max-bvar (car x))
+                       (shape-spec-max-bvar (cdr x)))))))
+ (defun shape-spec-max-bvar-list (x)
+   (declare (xargs :guard (shape-spec-listp x)))
+   (if (atom x)
+       0
+     (max (shape-spec-max-bvar (car x))
+          (shape-spec-max-bvar-list (cdr x))))))
+
+
+
+(defun glcp-gen-assignments (ctrex-info alist hyp-bdd n state)
+  (if (and (bfr-mode) ;; AIG mode
+           (bfr-counterex-mode)) ;; alist counterexample mode
+      (b* ((al (acl2::aig-extract-iterated-assigns-alist hyp-bdd 10))
+           ;; Careful: al is memoized so we can't steal it.
+           (cex-alist (hons-shrink-alist (append al ctrex-info) nil)))
+        (value (list (list "counterexample from SAT:"
+                           (vars-onto-alist
+                            ;; WRONG:
+                            ;; Hmm, logically this isn't really well-typed,
+                            ;; because alist consists of real g-objects whereas
+                            ;; shape-spec-indices wants shape-specs.  But in the
+                            ;; AIG case, parametrization doesn't do anything, so
+                            ;; this works.  If we were to apply this in cases
+                            ;; where alist was not generated by parametrizing a
+                            ;; shape-spec-alist, this would need to be changed.
+
+                            ;; Actually, parametrization gets rid of any AIG
+                            ;; variables that are constrained to concrete values.
+                            ;; So we need to reproduce the parametrized binding
+                            ;; alist here.
+                            (shape-spec-indices (strip-cdrs alist)) nil
+                            cex-alist)))))
+    (b* ((bound (shape-spec-max-bvar-list (strip-cdrs alist)))
+         ((er assigns) (n-satisfying-assigns-and-specs
+                        (max 0 (- n 2)) hyp-bdd ctrex-info bound state))
+         (nils (acl2::nat-to-v 0 bound))
+         (ts (acl2::nat-to-v -1 bound)))
+      (value (take n
+                   (list* (list* "generated by assigning 0/NIL to all possible bits:"
+                                 (to-satisfying-assign nils ctrex-info)
+                                 (to-satisfying-assign-spec
+                                  nils (acl2::from-param-space hyp-bdd ctrex-info)))
+                          (list* "generated by assigning 1/T to all possible bits:"
+                                 (to-satisfying-assign ts ctrex-info)
+                                 (to-satisfying-assign-spec
+                                  ts (acl2::from-param-space hyp-bdd ctrex-info)))
+                          assigns))))))
+
+(defun glcp-ctrex-complete-single-assign (string bfr-env alist hyp-bdd)
+  (if (and (bfr-mode)
+           (bfr-counterex-mode))
+      (b* ((al (acl2::aig-extract-iterated-assigns-alist hyp-bdd 10))
+           ;; Careful: al is memoized so we can't steal it.
+           (cex-alist (hons-shrink-alist (append al bfr-env) nil)))
+        (list string
+              (vars-onto-alist
+               (shape-spec-indices (strip-cdrs alist)) nil
+               cex-alist)))
+    (list* string
+           (acl2::unparam-env hyp-bdd bfr-env)
+           nil)))
+
+
+
+(defthm glcp-gen-assignments-does-not-fail
+  (not (mv-nth 0 (glcp-gen-assignments n hyp-bdd bdd bound state))))
+
+
+(defun pos-fix (x)
+  (if (posp x) x 1))
+
+
+(defun gl-ctrex-def (fn state)
+  (declare (xargs :stobjs state
+                  :guard (symbolp fn)))
+  (b* ((tab (table-alist 'gl-ctrex-defs (w state)))
+       (look (cdr (hons-assoc-equal fn tab)))
+       ((when (equal (len look) 2))
+        (b* (((list formals body) look))
+          (mv t formals body))))
+    (acl2::fn-get-def fn state)))
+
+
+
+(mutual-recursion
+ (defun magicer-ev (x alist clk state hard-errp aokp)
+   (declare (xargs :guard (and (natp clk)
+                               (pseudo-termp x)
+                               (symbol-alistp alist))
+                   :well-founded-relation acl2::nat-list-<
+                   :measure (list clk (acl2-count x))
+                   :hints(("Goal" :in-theory (enable nfix)))
+                   :verify-guards nil
+                   :stobjs state))
+   (cond ((not x) (mv nil nil))
+         ((atom x)
+          (mv nil (cdr (assoc-eq x alist))))
+         ((eq (car x) 'quote) (mv nil (cadr x)))
+         ((zp clk) (mv "clock ran out" nil))
+         ((consp (car x))
+          (b* (((mv err args)
+                (magicer-ev-lst (cdr x) alist clk state hard-errp aokp))
+               ((when err)
+                (mv err nil))
+               (new-alist (pairlis$ (cadar x) args)))
+            (magicer-ev (caddar x) new-alist clk state hard-errp aokp)))
+         ((eq (car x) 'if)
+          (b* (((mv err test)
+                (magicer-ev (cadr x) alist clk state hard-errp aokp))
+               ((when err) (mv err nil)))
+            (if test
+                (magicer-ev (caddr x) alist clk state hard-errp aokp)
+              (magicer-ev (cadddr x) alist clk state hard-errp aokp))))
+         ((and (eq (car x) 'return-last)
+               (quotep (cadr x)))
+          (b* ((fnsym (cadr (cadr x))))
+            (case fnsym
+              (progn (b* (((mv err args)
+                           (magicer-ev-lst (cddr x) alist clk state hard-errp
+                                           aokp))
+                          ((when err) (mv err nil)))
+                       (mv nil (cadr args))))
+              (otherwise
+               (magicer-ev (fourth x) alist clk state hard-errp aokp)))))
+         (t (b* (((mv err args)
+                  (magicer-ev-lst (cdr x) alist clk state hard-errp aokp))
+                 ((when err)
+                  (mv err nil))
+                 (fn (car x))
+                 ((mv ev-err val)
+                  (acl2::magic-ev-fncall fn args state hard-errp aokp))
+                 ((unless ev-err) (mv nil val))
+                 ((mv ok formals body) (gl-ctrex-def fn state))
+                 ((unless ok) (mv (acl2::msg
+                                   "can't execute and no definition: ~x0 ~@1~%"
+                                   fn (if (eq ev-err t) "" ev-err))
+                                  nil)))
+              (magicer-ev body (pairlis$ formals args) (1- clk) state hard-errp
+                          aokp)))))
+
+ (defun magicer-ev-lst (x alist clk state hard-errp aokp)
+   (declare (xargs :guard (and (posp clk)
+                               (pseudo-term-listp x)
+                               (symbol-alistp alist))
+                   :measure (list (pos-fix clk) (acl2-count x))
+                   :stobjs state))
+   (if (endp x)
+       (mv nil nil)
+     (b* (((mv err first) (magicer-ev (car x) alist clk state hard-errp aokp))
+          ((when err) (mv err nil))
+          ((mv err rest) (magicer-ev-lst (cdr x) alist clk state hard-errp aokp))
+          ((when err) (mv err nil)))
+       (mv nil (cons first rest))))))
+
+(defun set-gl-ctrex-def-fn (fn formals body state)
+  (declare (xargs :mode :program :stobjs state))
+  (b* (((er tr-body) (acl2::translate body t t t 'set-gl-ctrex-def (w state) state)))
+    (value `(table gl-ctrex-defs ',fn '(,formals ,tr-body)))))
+
+(defmacro set-gl-ctrex-def (fn formals body)
+  `(make-event (set-gl-ctrex-def-fn ',fn ',formals ',body state)))
+
+
+
+(mutual-recursion
+ (defun magic-geval (x env state)
+   (declare (xargs :guard (consp env)
+                   :stobjs state
+                   :measure (acl2-count x)
+                   :hints (("goal" :in-theory '(measure-for-geval atom)))))
+   (if (atom x)
+       ;; Every atom represents itself.
+       (mv nil x)
+     (pattern-match x
+
+       ;; A Concrete is like an escape sequence; we take (cdr x) as a concrete
+       ;; object even if it looks symbolic.
+       ((g-concrete obj) (mv nil obj))
+
+       ;; Boolean
+       ((g-boolean bool) (mv nil (bfr-eval bool (car env))))
+
+       ;; Number.  This is the hairy case.  Can represent all ACL2-NUMBERPs,
+       ;; but naturals are more compact than integers, which are more compact
+       ;; than rationals, which are more compact than complexes.  Denominators
+       ;; are coerced to 1 if they evaluate to 0 -- ugly.
+       ((g-number num)
+        (b* (((mv real-num
+                  real-denom
+                  imag-num
+                  imag-denom)
+              (break-g-number num)))
+          (flet ((uval (n env)
+                       (bfr-list->u n (car env)))
+                 (sval (n env)
+                       (bfr-list->s n (car env))))
+            (mv nil (components-to-number (sval real-num env)
+                                          (uval real-denom env)
+                                          (sval imag-num env)
+                                          (uval imag-denom env))))))
+
+       ;; If-then-else.
+       ((g-ite test then else)
+        (b* (((mv err test) (magic-geval test env state))
+             ((unless err)
+              (if test
+                  (magic-geval then env state)
+                (magic-geval else env state))))
+          (mv err nil)))
+
+       ;; Apply: Unevaluated function call.
+       ((g-apply fn args)
+        (b* (((mv err args) (magic-geval args env state))
+             ((when err) (mv err nil))
+             (term (cons fn (ec-call (kwote-lst args)))))
+          (mv-let (err val)
+            (ec-call (magicer-ev term nil 10000 state t t))
+            (if err
+                (mv err nil)
+              (mv nil val)))))
+
+       ;; Var: untyped variable.
+       ((g-var name)   (mv nil (cdr (het name (cdr env)))))
+
+       ;; Conses where the car is not a recognized flag represent conses.
+       (& (b* (((mv err car) (magic-geval (car x) env state))
+               ((when err) (mv err nil))
+               ((mv err cdr) (magic-geval (cdr x) env state))
+               ((when err) (mv err nil)))
+            (mv nil (cons car cdr)))))))
+ (defun magic-geval-list (x env state)
+   (declare (xargs :guard (consp env)
+                   :stobjs state
+                   :measure (acl2-count x)))
+   (if (atom x)
+       (mv nil nil)
+     (b* (((mv err val) (magic-geval (car x) env state))
+          ((when err) (mv err nil))
+          ((mv err rest) (magic-geval (car x) env state))
+          ((when err) (mv err nil)))
+       (mv nil (cons val rest))))))
+
+(defun gl-bit-abstract (bfr bfr-alist n)
+  (declare (xargs :guard (natp n)))
+  (b* ((n (lnfix n))
+       ((when (booleanp bfr))
+        (mv bfr bfr-alist n))
+       (res (hons-get bfr bfr-alist))
+       ((when res)
+        (mv (cdr res) bfr-alist n)))
+    (mv n (hons-acons bfr n bfr-alist) (1+ n))))
+
+(defthm gl-bit-abstract-new-n-type
+  (natp (mv-nth 2 (gl-bit-abstract bfr bfr-alist n)))
+  :rule-classes :type-prescription)
+
+(defun gl-bitlist-abstract (bfrs bfr-alist n)
+  (declare (xargs :guard (natp n)))
+  (b* (((when (atom bfrs))
+        (mv nil bfr-alist (lnfix n)))
+       ((mv first bfr-alist n) (gl-bit-abstract (car bfrs) bfr-alist n))
+       ((mv rest bfr-alist n) (gl-bitlist-abstract (cdr bfrs) bfr-alist n)))
+    (mv (cons first rest) bfr-alist n)))
+
+(defthm gl-bitlist-abstract-new-n-type
+  (natp (mv-nth 2 (gl-bitlist-abstract bfrs bfr-alist n)))
+  :rule-classes :type-prescription)
+
+(defun gl-bitlistlist-abstract (bfr-lists bfr-alist n)
+  (declare (xargs :guard (natp n)))
+  (b* (((when (atom bfr-lists))
+        (mv nil bfr-alist (lnfix n)))
+       ((mv first bfr-alist n) (gl-bitlist-abstract (car bfr-lists) bfr-alist n))
+       ((mv rest bfr-alist n) (gl-bitlistlist-abstract (cdr bfr-lists) bfr-alist n)))
+    (mv (cons first rest) bfr-alist n)))
+
+(defthm gl-bitlistlist-abstract-new-n-type
+  (natp (mv-nth 2 (gl-bitlistlist-abstract bfrs bfr-alist n)))
+  :rule-classes :type-prescription)
+
+(mutual-recursion
+ (defun gobj-abstract (x bfr-alist n)
+   (declare (xargs :guard (natp n)
+                   :verify-guards nil))
+   (if (atom x)
+       (mv x bfr-alist (lnfix n))
+     (case (tag x)
+       (:g-boolean (b* (((mv bit bfr-alist n)
+                         (gl-bit-abstract (g-boolean->bool x) bfr-alist n)))
+                     (mv (g-boolean bit) bfr-alist n)))
+       (:g-number (b* (((mv bits bfr-alist n)
+                        (gl-bitlistlist-abstract (g-number->num x) bfr-alist n)))
+                    (mv (g-number bits) bfr-alist n)))
+       (:g-concrete (mv x bfr-alist (lnfix n)))
+       (:g-ite (b* (((mv test bfr-alist n)
+                     (gobj-abstract (g-ite->test x) bfr-alist n))
+                    ((mv then bfr-alist n)
+                     (gobj-abstract (g-ite->then x) bfr-alist n))
+                    ((mv else bfr-alist n)
+                     (gobj-abstract (g-ite->else x) bfr-alist n)))
+                 (mv (g-ite test then else) bfr-alist n)))
+       (:g-var (mv x bfr-alist (lnfix n)))
+       (:g-apply (b* (((mv args bfr-alist n)
+                       (gobjlist-abstract (g-apply->args x) bfr-alist n)))
+                   (mv (g-apply (g-apply->fn x) args) bfr-alist n)))
+       (otherwise (b* (((mv car bfr-alist n)
+                        (gobj-abstract (car x) bfr-alist n))
+                       ((mv cdr bfr-alist n)
+                        (gobj-abstract (cdr x) bfr-alist n)))
+                    (mv (cons car cdr) bfr-alist n))))))
+
+ (defun gobjlist-abstract (x bfr-alist n)
+   (declare (xargs :guard (natp n)))
+   (b* (((when (atom x)) (mv x bfr-alist (lnfix n)))
+        ((mv car bfr-alist n)
+         (gobj-abstract (car x) bfr-alist n))
+        ((mv cdr bfr-alist n)
+         (gobjlist-abstract (cdr x) bfr-alist n)))
+     (mv (cons car cdr) bfr-alist n))))
+
+
+(flag::make-flag gobj-abstract-flg gobj-abstract)
+
+(defthm-gobj-abstract-flg
+  (defthm gobj-abstract-new-n-type
+    (natp (mv-nth 2 (gobj-abstract x bfr-alist n)))
+    :hints ('(:expand ((gobj-abstract x bfr-alist n))))
+    :flag gobj-abstract)
+  (defthm gobjlist-abstract-new-n-type
+    (natp (mv-nth 2 (gobjlist-abstract x bfr-alist n)))
+    :hints ('(:expand ((gobjlist-abstract x bfr-alist n))))
+    :flag gobjlist-abstract))
+
+(verify-guards gobj-abstract)
+
+(defun gobj-abstract-top (x)
+  (declare (xargs :guard t))
+  (b* (((mv x al &) (gobj-abstract x nil 0)))
+    (fast-alist-free al)
+    x))
+
+(defun gobjlist-abstract-top (x)
+  (declare (xargs :guard t))
+  (b* (((mv x al &) (gobjlist-abstract x nil 0)))
+    (fast-alist-free al)
+    x))
+
+
+
+
+(defun bool-to-bit (x)
+  (cond ((eq x t) 1)
+        ((eq x nil) 0)
+        (t x)))
+
+
+(defun nth-list-bits (x lst)
+  (if (atom x)
+      nil
+    (cons (bool-to-bit (nth (car x) lst))
+          (nth-list-bits (cdr x) lst))))
+
+(defun nth-list-list-bits (x lst)
+  (if (atom x)
+      nil
+    (cons (nth-list-bits (car x) lst)
+          (nth-list-list-bits (cdr x) lst))))
+
+
+;; For each index N in an shape spec, this substitutes the Nth value found in
+;; lst.  In the number case, it substitutes 1 and 0 for booleans.
+(defund inspec-show-assign-spec (x lst)
+  (if (atom x)
+      x
+    (pattern-match x
+      ((g-concrete &) x)
+      ((g-boolean b) (g-boolean (nth b lst)))
+      ((g-number n) (g-number (nth-list-list-bits n lst)))
+      ((g-ite if then else)
+       (g-ite (inspec-show-assign-spec if lst)
+              (inspec-show-assign-spec then lst)
+              (inspec-show-assign-spec else lst)))
+      ((g-apply fn args) (g-apply fn (inspec-show-assign-spec args lst)))
+      ((g-var &) x)
+      (& (cons (inspec-show-assign-spec (car x) lst)
+               (inspec-show-assign-spec (cdr x) lst))))))
+
+
+;; recursively match patterns, e.g.:
+;; set (equal (logcar (logcdr (logcdr x))) 1) to t
+;; --> set (logcar (logcdr (logcdr x))) to 1
+;; --> set (logbitp 0 (logcdr (logcdr x))) to t
+;; --> set (logbitp 1 (logcdr x)) to t
+;; --> set (logbitp 2 x) to t
+;; --> set x to (logior (ash 1 2) x)
+
+(defun translate-pair (pair ctx state)
+  (declare (xargs :stobjs state :mode :program))
+  (b* (((list a b) pair)
+       ((er aa) (acl2::translate a t t t ctx (w state) state))
+       ((er bb) (acl2::translate b t t t ctx (w state) state)))
+    (value (list aa bb))))
+
+(defun translate-pair-list (pairs ctx state)
+  (declare (xargs :stobjs state :mode :program))
+  (b* (((when (atom pairs)) (value nil))
+       ((er first) (translate-pair (car pairs) ctx state))
+       ((er rest) (translate-pair-list (cdr pairs) ctx state)))
+    (value (cons first rest))))
+
+(defun def-glcp-ctrex-rewrite-fn (from test tos state)
+  (declare (xargs :mode :program :stobjs state))
+  (b* (((er fromtrans) (translate-pair from 'def-gplcp-ctrex-rewrite state))
+       ((er tostrans) (translate-pair-list tos 'def-gplcp-ctrex-rewrite state))
+       ((er testtrans) (acl2::translate test t t t 'def-gplcp-ctrex-rewrite (w state) state))
+       (entry (list* fromtrans testtrans tostrans))
+       (fnsym (caar fromtrans)))
+    (value `(table glcp-ctrex-rewrite
+                   ',fnsym
+                   (cons ',entry
+                         (cdr (assoc ',fnsym (table-alist
+                                              'glcp-ctrex-rewrite world))))))))
+
+(defsection def-glcp-ctrex-rewrite
+  :parents (reference)
+  :short "Define a heuristic for GL to use when generating counterexamples"
+  :long
+  "<p>Usage:</p>
+
+@({
+ (gl::def-glcp-ctrex-rewrite
+   ;; from:
+   (lhs-lvalue lhs-rvalue)
+   ;; to:
+   (rhs-lvalue rhs-rvalue)
+   :test syntaxp-term)
+ })
+<p>Example:</p>
+@({
+ (gl::def-glcp-ctrex-rewrite
+   ((logbitp n x) t)
+   (x (logior (ash 1 n) x))
+   :test (quotep n))
+})
+
+<p>If GL has generated Boolean variables corresponding to term-level objects,
+then an assignment to the Boolean variables does not directly induce an
+assignment of ACL2 objects to the ACL2 variables.  Instead, we have terms that
+are assigned true or false by the Boolean assignment, and to generate a
+counterexample, we must find an assignment for the variables in those terms
+that cause the terms to take the required truth values.  Ctrex-rewrite rules
+tell GL how to move from a valuation of a term to valuations of its
+components.</p>
+
+<p>The example rule above says that if we want @('(logbitp n x)') to be @('t'),
+and @('n') is (syntactically) a quoted constant, then assign @('x') a new value
+by effectively setting its @('n')th bit to T (that is, bitwise ORing X with the
+appropriate mask).</p>
+
+<p>Note that this rule does not always yield the desired result -- for example,
+in the case where N is a negative integer.  Because these are just heuristics
+for generating counterexamples, there is no correctness requirement and no
+checking of these rules.  Bad counterexample rules can't make anything unsound,
+but they can cause generated counterexamples to be nonsense.  Be careful!</p>"
+
+  (defmacro def-glcp-ctrex-rewrite (from to &key (test 't))
+    `(make-event
+      (def-glcp-ctrex-rewrite-fn ',from ',test ',(list to) state))))
+
+(defmacro def-glcp-ctrex-split-rewrite (from tos &key (test 't))
+  `(make-event
+    (def-glcp-ctrex-rewrite-fn ',from ',test ',tos state)))
+
+(def-glcp-ctrex-rewrite ((equal x y) t) (x y)
+  :test (symbolp x))
+(def-glcp-ctrex-rewrite ((equal x y) t) (x y)
+  :test (quotep y))
+(def-glcp-ctrex-rewrite ((equal x y) t) (y x)
+  :test (symbolp y))
+(def-glcp-ctrex-rewrite ((equal x y) t) (y x)
+  :test (quotep x))
+(def-glcp-ctrex-rewrite
+  ((logcar x) 1)
+  ((logbitp 0 x) t))
+(def-glcp-ctrex-rewrite
+  ((logcar x) 0)
+  ((logbitp 0 x) nil))
+(def-glcp-ctrex-rewrite
+  ((logbitp n x) t)
+  (x (logior (ash 1 n) x))
+  :test (and (quotep n) (symbolp x)))
+(def-glcp-ctrex-rewrite
+  ((logbitp n x) t)
+  (x (logior (ash 1 n) x))
+  :test (quotep n))
+(def-glcp-ctrex-rewrite
+  ((logbitp n x) nil)
+  (x (logand (lognot (ash 1 n)) x))
+  :test (quotep n))
+(def-glcp-ctrex-rewrite
+  ((logbitp n (logcdr x)) v)
+  ((logbitp (+ 1 (nfix n)) x) v))
+(def-glcp-ctrex-rewrite
+  ((logbitp n (logtail m x)) v)
+  ((logbitp (+ (nfix m) (nfix n)) x) v))
+(def-glcp-ctrex-rewrite
+  ((integerp x) t)
+  (x (ifix x)))
+(def-glcp-ctrex-rewrite
+  ((integerp x) nil)
+  (x (if (integerp x) nil x)))
+
+
+;; (glcp-ctrex-rewrite 10
+;;                     '((equal (logcar (logcdr (logcdr x))) '1) 't)
+;;                     (table-alist 'glcp-ctrex-rewrites (w state))
+;;                     state)
+
+
+(mutual-recursion
+ (defun gobj->term-partial (x bfr-env)
+   (declare (xargs :guard t
+                   :measure (acl2-count x)
+                   :hints (("goal" :in-theory '(measure-for-geval atom)))))
+   (if (atom x)
+       (kwote x)
+     (pattern-match x
+       ((g-concrete obj) (kwote obj))
+
+       ((g-boolean bool) (kwote (bfr-eval bool bfr-env)))
+
+       ((g-number num)
+        (b* (((mv real-num
+                  real-denom
+                  imag-num
+                  imag-denom)
+              (break-g-number num)))
+          (flet ((uval (n env)
+                       (bfr-list->u n env))
+                 (sval (n env)
+                       (bfr-list->s n env)))
+            (kwote
+             (components-to-number (sval real-num bfr-env)
+                                   (uval real-denom bfr-env)
+                                   (sval imag-num bfr-env)
+                                   (uval imag-denom bfr-env))))))
+
+       ((g-ite test then else)
+        (list 'if
+              (gobj->term-partial test bfr-env)
+              (gobj->term-partial then bfr-env)
+              (gobj->term-partial else bfr-env)))
+
+       ((g-var name) name)
+
+       ((g-apply fn args)
+        (and (not (eq fn 'quote))
+             (cons fn (gobj-list->terms-partial args bfr-env))))
+
+       (& ;; cons
+        (list 'cons
+              (gobj->term-partial (car x) bfr-env)
+              (gobj->term-partial (cdr x) bfr-env))))))
+
+ (defun gobj-list->terms-partial (x bfr-env)
+   (declare (xargs :guard t
+                   :measure (acl2-count x)))
+   (if (atom x)
+       nil
+     (cons (gobj->term-partial (car x) bfr-env)
+           (gobj-list->terms-partial (cdr x) bfr-env)))))
+
+
+(defun unquote-lst (x)
+  (declare (xargs :guard (and (pseudo-term-listp x)
+                              (acl2::quote-listp x))))
+  (if (atom x)
+      nil
+    (cons (acl2::unquote (car x))
+          (unquote-lst (cdr x)))))
+
+(mutual-recursion
+ ;; Like magic-ev but constructs a partially-evaluated term by evaluating
+ ;; ground calls.
+ ;; A little bit wrong with respect to a regular pseudo-term evaluator because
+ ;; if the alist doesn't bind a variable, it's effectively bound to itself.
+ (defun magic-ev-partial (x alist state hard-errp aokp)
+   (declare (xargs :guard (and (pseudo-termp x)
+                               (symbol-alistp alist)
+                               (pseudo-term-listp (strip-cdrs alist)))
+                   :measure (acl2-count x)
+                   :hints(("Goal" :in-theory (enable nfix)))
+                   :verify-guards nil
+                   :stobjs state))
+   (cond ((not x) nil)
+         ((atom x) (let ((look (assoc x alist)))
+                     (if look (cdr look) x)))
+         ((eq (car x) 'quote) x)
+         ((consp (car x))
+          (b* ((args
+                (magic-ev-partial-lst (cdr x) alist state hard-errp aokp))
+               (new-alist (pairlis$ (cadar x) args)))
+            (magic-ev-partial (caddar x) new-alist state hard-errp aokp)))
+         ((eq (car x) 'if)
+          (b* ((test
+                (magic-ev-partial (cadr x) alist state hard-errp aokp)))
+            (if (quotep test)
+                (if (cadr test)
+                    (magic-ev-partial (caddr x) alist state hard-errp aokp)
+                  (magic-ev-partial (cadddr x) alist state hard-errp
+                                    aokp))
+              (b* ((then
+                    (magic-ev-partial (caddr x) alist state hard-errp aokp))
+                   (else
+                    (magic-ev-partial (cadddr x) alist state hard-errp aokp)))
+                (if (equal then else)
+                    then
+                  `(if ,test ,then ,else))))))
+         (t (b* ((args
+                  (magic-ev-partial-lst (cdr x) alist state hard-errp aokp))
+                 (fn (car x))
+                 ((unless (acl2::quote-listp args)) (cons fn args))
+                 ((mv ev-err val)
+                  (acl2::magic-ev-fncall fn (unquote-lst args) state hard-errp aokp))
+                 ((unless ev-err) (kwote val)))
+              (cons fn args)))))
+
+ (defun magic-ev-partial-lst (x alist state hard-errp aokp)
+   (declare (xargs :guard (and (pseudo-term-listp x)
+                               (symbol-alistp alist)
+                               (pseudo-term-listp (strip-cdrs alist)))
+                   :measure (acl2-count x)
+                   :stobjs state))
+   (if (endp x)
+       nil
+     (cons (magic-ev-partial (car x) alist state hard-errp aokp)
+           (magic-ev-partial-lst (cdr x) alist state hard-errp aokp)))))
+
+
+(flag::make-flag magic-ev-partial-flg magic-ev-partial)
+
+(defthm pseudo-term-listp-strip-cdrs-pairlis
+  (implies (pseudo-term-listp vals)
+           (pseudo-term-listp (strip-cdrs (pairlis$ keys vals)))))
+
+(defthm-magic-ev-partial-flg
+  (defthm pseudo-termp-of-magic-ev-partial
+    (implies (and (pseudo-termp x)
+                  (pseudo-term-listp (strip-cdrs alist)))
+             (pseudo-termp (magic-ev-partial x alist state hard-errp aokp)))
+    :flag magic-ev-partial)
+  (defthm pseudo-term-listp-of-magic-ev-partial-lst
+    (implies (and (pseudo-term-listp x)
+                  (pseudo-term-listp (strip-cdrs alist)))
+             (pseudo-term-listp (magic-ev-partial-lst x alist state hard-errp aokp)))
+    :flag magic-ev-partial-lst))
+
+(defun glcp-ctrex-subst-pairs (subst pairs)
+  (if (atom pairs)
+      nil
+    (cons (acl2::substitute-into-list (car pairs) subst)
+          (glcp-ctrex-subst-pairs subst (cdr pairs)))))
+
+
+(defun glcp-ctrex-apply-rule (pair rule state)
+  (declare (xargs :stobjs state :verify-guards nil))
+  (b* (((list* pat-pair cond subst-pairs)
+        rule)
+       ((mv ok alist) (acl2::simple-one-way-unify-lst pat-pair pair nil))
+       ((unless ok) (mv nil nil))
+       ((mv ev-err ok) (acl2::magic-ev cond alist state t t))
+       ((when (and (not ev-err) ok))
+        (mv t (glcp-ctrex-subst-pairs alist subst-pairs))))
+    (mv nil nil)))
+
+(defun glcp-ctrex-apply-rules (pair rules state)
+  (declare (xargs :stobjs state :verify-guards nil))
+  (b* (((when (atom rules)) (mv nil nil))
+       ((mv ok new-pairs) (glcp-ctrex-apply-rule pair (car rules) state))
+       ((when ok) (mv ok new-pairs)))
+    (glcp-ctrex-apply-rules pair (cdr rules) state)))
+
+
+(mutual-recursion
+ (defun glcp-ctrex-rewrite (limit pair rule-table state)
+   (declare (xargs :stobjs state :verify-guards nil
+                   :measure (list limit 0)))
+   (b* ((pair (magic-ev-partial-lst pair nil state t t))
+        ((when (zp limit)) (list pair))
+        (lhs (car pair))
+        ((when (atom lhs)) (list pair))
+        (fn (car lhs))
+        (rules (cdr (assoc fn rule-table)))
+        ((mv ok new-pairs) (glcp-ctrex-apply-rules pair rules state))
+        ((unless ok) (list pair)))
+     (glcp-ctrex-rewrite-list (1- limit) new-pairs rule-table state)))
+ (defun glcp-ctrex-rewrite-list (limit pairs rule-table state)
+   (declare (xargs :stobjs state :verify-guards nil
+                   :well-founded-relation acl2::nat-list-<
+                   :measure (list limit (len pairs))))
+   (if (atom pairs)
+       nil
+     (append (glcp-ctrex-rewrite limit (car pairs) rule-table state)
+             (glcp-ctrex-rewrite-list limit (cdr pairs) rule-table state)))))
+
+
+(defun glcp-ctrex-update-assigns (pairs var-alist state)
+  (declare (xargs :stobjs state
+                  :verify-guards nil))
+  (b* (((when (atom pairs)) var-alist)
+       (pair1 (car pairs))
+       ((list lhs rhs) pair1)
+       ((unless (symbolp lhs))
+        (and (not (and (consp lhs)
+                       (eq (car lhs) 'quote)))
+             (cw "failed ctrex assignment:~%lhs:~%~x0~%rhs:~%~x1~%"
+                 lhs rhs))
+        (glcp-ctrex-update-assigns (cdr pairs) var-alist state))
+       ((mv ev-err rhs-val) (magicer-ev rhs var-alist 10000 state t t))
+       ((when ev-err)
+        (cw "Error evaluating RHS in counterexample generation: ~@0~%"
+            (if (eq ev-err t) "T" ev-err))
+        (glcp-ctrex-update-assigns (cdr pairs) var-alist state)))
+    (glcp-ctrex-update-assigns (cdr pairs) (hons-acons lhs rhs-val var-alist) state)))
+
+
+(local (in-theory (enable* acl2::arith-equiv-forwarding)))
+;; Iterates up the bvar-db list chronologically, given a counterexample
+;; assignment (a bfr environment).  Builds up a variable alist by applying
+;; rewrites to simplify the assignments induced by the bvar-db.
+;; (defun glcp-ctrex-set-vars1 (n ctrex-assign unparam-ctrex-assign
+;;                                rule-table bvar-db state)
+;;   (declare (xargs :stobjs (state bvar-db)
+;;                   :guard (natp n)
+;;                   :verify-guards nil
+;;                   :measure (nfix n)))
+;;   (b* (((when (<= (the integer (lnfix n))
+;;                   (the integer (base-bvar bvar-db))))
+;;         nil)
+;;        (n (1- n))
+;;        (var-alist (glcp-ctrex-set-vars1
+;;                    n ctrex-assign unparam-ctrex-assign
+;;                    rule-table bvar-db state))
+;;        (bvar-val (bfr-lookup n unparam-ctrex-assign))
+;;        (gobj (get-bvar->term n bvar-db))
+;;        (term (gobj->term-partial gobj ctrex-assign))
+;;        (lhs1 (magic-ev-partial term nil state t t))
+;;        (pair (list lhs1 (kwote bvar-val)))
+;;        (assign-pairs (glcp-ctrex-rewrite 10000 pair rule-table state))
+;;        (gregs3 (nth 3 (nth 4 (cdr (assoc 'uc::st var-alist)))))
+;;        (var-alist (glcp-ctrex-update-assigns assign-pairs var-alist state))
+;;        (gregs3-new (nth 3 (nth 4 (cdr (assoc 'uc::st var-alist))))))
+;;     (and (not (equal gregs3 gregs3-new))
+;;          (cw "gregs3: prev ~x0 new ~x1~%pair: ~x2~%assigns: ~x3~%gobj: ~x4"
+;;              gregs3 gregs3-new pair assign-pairs gobj))
+;;     var-alist))
+
+(defun glcp-ctrex-set-vars1 (n ctrex-assign unparam-ctrex-assign
+                               rule-table var-alist bvar-db state)
+  (declare (xargs :stobjs (state bvar-db)
+                  :guard (natp n)
+                  :verify-guards nil
+                  :measure (nfix n)))
+  (b* (((when (<= (the integer (lnfix n))
+                  (the integer (base-bvar bvar-db))))
+        var-alist)
+       (n (1- n))
+       (var-alist (glcp-ctrex-set-vars1
+                   n ctrex-assign unparam-ctrex-assign
+                   rule-table var-alist bvar-db state))
+       (bvar-val (bfr-lookup n unparam-ctrex-assign))
+       (gobj (get-bvar->term n bvar-db))
+       (term (gobj->term-partial gobj ctrex-assign))
+       (lhs1 (magic-ev-partial term nil state t t))
+       (pair (list lhs1 (kwote bvar-val)))
+       (assign-pairs (glcp-ctrex-rewrite 10000 pair rule-table state)))
+    (glcp-ctrex-update-assigns assign-pairs var-alist state)))
+
+(defun glcp-ctrex-set-vars (ctrex-assign unparam-assign bvar-db state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :verify-guards nil))
+  (b* ((rule-table (table-alist 'glcp-ctrex-rewrite (w state)))
+       (var-alist (glcp-ctrex-set-vars1 (next-bvar bvar-db)
+                                        ctrex-assign
+                                        unparam-assign
+                                        rule-table nil bvar-db state)))
+    (glcp-ctrex-set-vars1 (next-bvar bvar-db)
+                          ctrex-assign
+                          unparam-assign
+                          rule-table var-alist bvar-db state)))
+
+(defun glcp-ctrex-bits-to-objs (ctrex-assign param-bfr gobj-alist bvar-db state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :verify-guards nil))
+  (b* ((unparam-ctrex-assign (bfr-unparam-env param-bfr ctrex-assign))
+       ((acl2::with-fast unparam-ctrex-assign))
+       (var-alist (glcp-ctrex-set-vars ctrex-assign unparam-ctrex-assign bvar-db state))
+       (env (cons ctrex-assign var-alist))
+       ((mv err alist) (magic-geval gobj-alist env state))
+       ((when err) (list :unknown env)))
+    (list alist env)))
+
+
+
+(defun glcp-bit-to-obj-ctrexamples (assigns sspec-alist gobj-alist param-bfr bvar-db state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :verify-guards nil))
+  (if (atom assigns)
+      nil
+    (if (or (atom (car assigns))
+            (atom (cdar assigns)))
+        (glcp-bit-to-obj-ctrexamples (cdr assigns) sspec-alist gobj-alist
+                                     param-bfr bvar-db state)
+      (cons (cons (caar assigns)
+                  (append
+                   (acl2::with-fast-alist (cadar assigns)
+                                          (glcp-ctrex-bits-to-objs
+                                           (cadar assigns) param-bfr gobj-alist bvar-db state))
+                   (ec-call (inspec-show-assign-spec sspec-alist (cddar assigns)))))
+            (glcp-bit-to-obj-ctrexamples (cdr assigns) sspec-alist gobj-alist
+                                         param-bfr bvar-db state)))))
+
+(defun glcp-gen-ctrexes (ctrex-info alist param-bfr n bvar-db state)
+  (declare (xargs :stobjs (bvar-db state) :verify-guards nil))
+  (b* (((er assigns) (glcp-gen-assignments ctrex-info alist param-bfr n state)))
+    (value (glcp-bit-to-obj-ctrexamples
+            assigns alist
+            (gobj-alist-to-param-space
+             (shape-spec-to-gobj alist) param-bfr)
+            param-bfr bvar-db state))))
+
+(defthm glcp-gen-ctrexes-does-not-fail
+  (not (mv-nth 0 (glcp-gen-ctrexes n param-bfr bdd bound bvar-db state)))
+  :hints(("Goal" :in-theory (disable glcp-gen-assignments))))
+
+(in-theory (disable glcp-gen-ctrexes))
+
+;; Collects violated assumptions in the bvar-db.
+(defun glcp-ctrex-check-bvar-db (n env unparam-env bvar-db state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :guard (and (natp n)
+                              (consp env)
+                              (<= n (next-bvar bvar-db)))
+                  ; :verify-guards nil
+                  :measure (nfix n)))
+  (b* (((when (<= (lnfix n) (base-bvar bvar-db))) nil)
+       (n (1- (lnfix n)))
+       (rest (glcp-ctrex-check-bvar-db n env unparam-env bvar-db state))
+       (gobj (get-bvar->term n bvar-db))
+       (bvalue (bfr-lookup n unparam-env))
+       ((mv er gvalue) (magic-geval gobj env state))
+       ;; ((when (and (not er) (iff bvalue gvalue)))
+       ;;  rest)
+       (partial (gobj->term-partial gobj (car env)))
+       ((when er)
+        (cw "Couldn't evaluate bvar-db term: ~x0, error: ~@1~%"
+            partial (if (eq er t) "T" er))
+        rest))
+    (cons (list (if (iff bvalue gvalue) "GOOD" "FAIL") partial bvalue gobj n) rest)))
+
+(defun glcp-pretty-print-bvar-db-violations (pairs)
+  (declare (xargs :guard t))
+  (b* (((when (atom pairs)) nil)
+       ((unless (true-listp (car pairs)))
+        (glcp-pretty-print-bvar-db-violations (cdr pairs))))
+    (and (equal (caar pairs) "FAIL")
+         (or (cw "~x0 should be ~x1~%" (cadar pairs) (caddar pairs))
+             (cw "gobj: ~x0~%" (gobj-abstract-top (ec-call (nth 3 (car pairs)))))))
+    (glcp-pretty-print-bvar-db-violations (cdr pairs))))
+
+(defun quote-if-needed (obj)
+  (declare (xargs :mode :logic :guard t))
+  (if (or (booleanp obj)
+          (keywordp obj)
+          (acl2-numberp obj)
+          (characterp obj)
+          (stringp obj))
+      obj
+    (list 'quote obj)))
+
+(defun bindings-quote-if-needed (bindings)
+  (declare (xargs :guard (true-list-listp bindings)))
+  (if (atom bindings)
+      nil
+    (cons (list (caar bindings)
+                (quote-if-needed (cadar bindings)))
+          (bindings-quote-if-needed (cdr bindings)))))
+
+(defun glcp-pretty-print-assignments (n ctrexes concl execp param-bfr bvar-db state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :guard (and (natp n)
+                              (true-list-listp ctrexes)
+                              (pseudo-termp concl))))
+  (if (atom ctrexes)
+      nil ;; (value nil)
+    (b* (((list* string assign-alist env assign-spec-alist) (car ctrexes))
+         (bindings (ec-call (bindings-quote-if-needed assign-alist)))
+         (- (if (bfr-mode)
+                (cw "Example ~x2, ~@0~%Assignment:~%~x1~%~%" string bindings n)
+              (cw "Example ~x3, ~@0~%Template:~%~x1~%Assignment:~%~x2~%~%" string assign-spec-alist
+                  bindings n)))
+
+         ((unless (and execp (consp env)))
+          (glcp-pretty-print-assignments (1+ n) (cdr ctrexes) concl execp param-bfr
+                                     bvar-db state))
+
+         (unparam-env (bfr-unparam-env param-bfr (car env)))
+         ((acl2::with-fast unparam-env))
+         (bvar-db-info (glcp-ctrex-check-bvar-db
+                        (next-bvar bvar-db) env unparam-env bvar-db
+                        state))
+         ;;(state (f-put-global 'bvar-db-info bvar-db-info state))
+         (- (and (hons-assoc-equal "FAIL" bvar-db-info)
+                 ;; bozo make error message better
+                 (not (cw "Some IF test terms were assigned inconsistent values:~%"))
+                 (glcp-pretty-print-bvar-db-violations bvar-db-info)))
+         (- (cw "Running conclusion to verify the counterexample.~%"))
+         ;; ((acl2::cmp concl-term)
+         ;;  (acl2::translate-cmp
+         ;;   concl t t t 'glcp-print-ctrexamples (w state)
+         ;;   (default-state-vars state)))
+
+         ;; assign-alist is actually of the form
+         ;; ((var0 val0) (var1 val1)...) --
+         ;; change it to ((var0 . val0) (var1 . val1) ...)
+         (alist (pairlis$ (acl2::alist-keys assign-alist)
+                          (acl2::alist-keys (acl2::alist-vals assign-alist))))
+         ((mv err val)
+          (ec-call (acl2::magic-ev concl alist state t t)))
+         ((mv err val)
+          (if (not err)
+              (mv err val)
+            (progn$
+             (cw "Failed to execute the counterexample: ~@0~%"
+                 (if (eq err t) "(t)" err))
+             (cw "Trying to logically simulate it...~%")
+             (ec-call (magicer-ev concl alist 10000 state t t)))))
+         ((when err)
+          (cw "Evaluating the counterexample failed: ~@0~%"
+              (if (eq err t) "(t)" err))
+          ;; (value nil)
+          ))
+      (if val
+          (cw "False counterexample!  See :xdoc gl::false-counterexamples.~%")
+        (cw "Counterexample verified.~%"))
+      (glcp-pretty-print-assignments (1+ n) (cdr ctrexes) concl execp param-bfr
+                                     bvar-db state))))
+
+
+(defun glcp-print-ctrexamples (ctrexes warn-err type concl execp param-bfr bvar-db state)
+  (declare (xargs :stobjs (state bvar-db)
+                  :guard (and (true-list-listp ctrexes)
+                              (pseudo-termp concl))))
+  (b* ((- (cw "
+*** SYMBOLIC EXECUTION ~@0 ***: ~@1 found." warn-err type))
+       (- (and ctrexes
+               (if (and (bfr-mode)
+                        (bfr-counterex-mode))
+                   (cw "~%Showing the example produced by SAT.~%~%")
+                 (cw "
+Showing ~x0 examples. Each example consists of a template and a
+concrete assignment.  The template shows a class of examples, and the
+concrete assignment represents a specific example from that
+class:~%~%" (len ctrexes))))))
+    (glcp-pretty-print-assignments 1 ctrexes concl execp param-bfr bvar-db state)))
+
+
+
+(defun glcp-gen/print-ctrexamples (ctrex-info ;; bdd or alist
+                                   warn/err type config bvar-db state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :verify-guards nil))
+  (b* (((glcp-config config) config)
+       (state (acl2::f-put-global 'glcp-var-bindings config.shape-spec-alist state))
+       (state (acl2::f-put-global 'glcp-counterex ctrex-info state))
+       ((er ctrexes) (glcp-gen-ctrexes ctrex-info
+                                       config.shape-spec-alist
+                                       config.param-bfr
+                                       config.nexamples
+                                       bvar-db state))
+       (state (acl2::f-put-global 'glcp-counterex-assignments ctrexes state)))
+    (value (glcp-print-ctrexamples
+            ctrexes warn/err type
+            config.top-level-term
+            config.exec-ctrex
+            config.param-bfr
+            bvar-db state))))
+
+
+(defun glcp-print-single-ctrex (bfr-env warn/err type config bvar-db state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :verify-guards nil))
+  (b* (((glcp-config config) config)
+       (assign (glcp-ctrex-complete-single-assign
+                type bfr-env config.shape-spec-alist config.param-bfr))
+       (ctrexes (glcp-bit-to-obj-ctrexamples
+                 (list assign)
+                 config.shape-spec-alist
+                 (gobj-alist-to-param-space
+                  (shape-spec-to-gobj config.shape-spec-alist)
+                  config.param-bfr)
+                 config.param-bfr
+                 bvar-db state)))
+    (glcp-print-ctrexamples
+     ctrexes warn/err type
+     config.top-level-term
+     config.exec-ctrex
+     config.param-bfr
+     bvar-db state)))
diff -Nru acl2-6.2/books/centaur/gl/def-gl-clause-proc.lisp acl2-6.3/books/centaur/gl/def-gl-clause-proc.lisp
--- acl2-6.2/books/centaur/gl/def-gl-clause-proc.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/def-gl-clause-proc.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,17 +1,33 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
-
 (include-book "parallel/without-waterfall-parallelism" :dir :system)
-;; (include-book "centaur/misc/defapply" :dir :system)
 (include-book "gify")
-(local (include-book "gify-thms"))
 (include-book "run-gified-cp")
-(local (include-book "general-object-thms"))
 (include-book "glcp-templates")
-(include-book "gl-doc-string")
 (include-book "generic-geval")
+(local (include-book "gify-thms"))
+(local (include-book "general-object-thms"))
+;; (include-book "centaur/misc/defapply" :dir :system)
+
 ;; Now that we've proven the correctness of the generic clause processor above,
 ;; we now define a macro which makes a clause processor for a particular set of
 ;; pre-Gified functions.
@@ -31,7 +47,7 @@
                        ,@(make-list-of-nths
                           'actuals 0
                           (len (wgetprop (car names) 'formals)))
-                       hyp clk)))
+                       hyp clk config bvar-db state)))
     (glcp-predef-cases-fn (cdr names) world))))
 
 
@@ -105,7 +121,7 @@
 ;; (defthm open-cdr-kwote-lst
 ;;   (equal (cdr (acl2::kwote-lst lst))
 ;;          (acl2::kwote-lst (cdr lst))))
- 
+
 ;; (defthm gobj-listp-cdr
 ;;   (implies (gobj-listp x)
 ;;            (gobj-listp (cdr x)))
@@ -239,332 +255,360 @@
            (true-listp x))
   :hints(("Goal" :in-theory (enable gobj-listp)))
   :rule-classes :forward-chaining)
-      
+
+
+(defthm gobj-depends-on-of-nth
+  (implies (not (gobj-list-depends-on k p x))
+           (not (gobj-depends-on k p (nth n x))))
+  :hints(("Goal" :in-theory (enable nth gobj-list-depends-on))))
+
+(defthm gobj-depends-on-of-nil
+  (not (gobj-depends-on k p nil)))
+
+
 (defun def-gl-clause-processor-fn
   (clause-proc output state)
   (declare (xargs :mode :program :stobjs state))
   (b* ((world (w state))
-       (current-geval (find-current-geval world))
-       (geval (or current-geval
-                  (incat clause-proc (symbol-name clause-proc) "-GEVAL")))
+       ;; (current-geval (find-current-geval world))
+       (geval ;;(or current-geval
+        (incat clause-proc (symbol-name clause-proc) "-GEVAL"))
+       (geval-ev ;;(or current-geval
+        (incat clause-proc (symbol-name clause-proc) "-GEVAL-EV"))
+       (geval-list (incat clause-proc (symbol-name clause-proc) "-GEVAL-LIST"))
+       (geval-ev-lst ;;(or current-geval
+        (incat clause-proc (symbol-name clause-proc) "-GEVAL-EV-LST"))
        (run-gified (incat clause-proc (symbol-name clause-proc) "-RUN-GIFIED"))
        (g-fns (strip-cars (table-alist 'gl-function-info world)))
-       (ev (incat clause-proc (symbol-name clause-proc) "-EV"))
-       (ev-lst (incat clause-proc (symbol-name clause-proc) "-EV-LST"))
-       (falsify (incat clause-proc (symbol-name clause-proc) "-EV-FALSIFY"))
-       (badguy (incat clause-proc (symbol-name clause-proc)
+       (ev (incat clause-proc (symbol-name geval) "-EV"))
+       (ev-lst (incat clause-proc (symbol-name geval) "-EV-LST"))
+       (ev-rules (incat clause-proc (symbol-name geval) "-EV-RULES"))
+       (falsify (incat clause-proc (symbol-name geval) "-EV-FALSIFY"))
+       (badguy (incat clause-proc (symbol-name geval)
                       "-EV-META-EXTRACT-GLOBAL-BADGUY"))
        (meta-facts
-        (incat clause-proc (symbol-name clause-proc) "-EV-META-EXTRACT-GLOBAL-FACTS"))
-       (ctrex-thm (incat clause-proc (symbol-name clause-proc)
+        (incat clause-proc (symbol-name geval) "-EV-META-EXTRACT-GLOBAL-FACTS"))
+       (ctrex-thm (incat clause-proc (symbol-name geval)
                          "-EV-FALSIFY-COUNTEREXAMPLE"))
-       (constraints (incat ev (symbol-name ev) "-CONSTRAINTS"))
        (f-i-thm (incat geval (symbol-name geval)
                        "-IS-FUNCTIONAL-INST-OF-GENERIC-GEVAL-FOR-GL-CLAUSE-PROC"))
        (run-gified-correct
         (incat run-gified (symbol-name run-gified) "-CORRECT"))
-       (interp-term (interp-term-fnname clause-proc))
-       (interp-list (incat clause-proc (symbol-name clause-proc)
-                           "-INTERP-LIST"))
-       (run-parametrized (incat clause-proc (symbol-name clause-proc)
-                           "-RUN-PARAMETRIZED"))
-       (run-cases (incat clause-proc (symbol-name clause-proc)
-                           "-RUN-CASES"))
-       (subst `((interp-term . ,interp-term)
-                (interp-list . ,interp-list)
-                (run-parametrized . ,run-parametrized)
-                (run-cases . ,run-cases)
-                (clause-proc-name . ',clause-proc)
-                (clause-proc . ,clause-proc)
-                (run-gified . ,run-gified)
-                ;; (apply-concrete . ,apply-concrete)
-                ))
+       (run-gified-deps
+        (incat run-gified (symbol-name run-gified) "-DEPS"))
+       (interp-term
+        (incat clause-proc (symbol-name clause-proc) "-INTERP-TERM"))
+       ;; (run-parametrized
+       ;;  (incat clause-proc (symbol-name clause-proc) "-RUN-PARAMETRIZED"))
+       ;; (run-cases
+       ;;  (incat clause-proc (symbol-name clause-proc) "-RUN-CASES"))
+       (subst-names (append '(run-gified
+                              geval
+                              geval-list
+                              geval-ev
+                              geval-ev-lst
+                              geval-ev-falsify
+                              geval-ev-meta-extract-global-badguy)
+                            (remove 'clause-proc *glcp-fnnames*)))
+       (fn-names (cons clause-proc (glcp-put-name-each clause-proc subst-names)))
+       (subst (pairlis$ (cons 'clause-proc subst-names) fn-names))
+       (fi-subst (pairlis$ (cons 'glcp-generic (glcp-put-name-each 'glcp-generic subst-names))
+                           (pairlis$ fn-names nil)))
        (f-i-lemmas (incat clause-proc (symbol-name clause-proc)
                           "-FUNCTIONAL-INSTANCE-LEMMAS"))
        (correct-thm (incat clause-proc (symbol-name clause-proc) "-CORRECT")))
     `(with-output
-      ,@output
-      (encapsulate
-        nil
-        (set-state-ok t)
-        (set-ignore-ok t)
-        (set-irrelevant-formals-ok t)
-        ,@(if current-geval
-              nil
-            `((make-geval ,geval nil
-                          :output nil)))
-        (encapsulate nil
-          (set-case-split-limitations '(1 1))
-          (defun ,run-gified
-            (fn actuals hyp clk state)
-            (declare (xargs :guard (and (symbolp fn)
-                                        (gobj-listp actuals)
-                                        (natp clk))
-                            :guard-hints
-                            (("goal" :in-theory
-                              (e/d** ((:forward-chaining gobj-listp-true-listp)))
-                              :do-not '(preprocess)))
-                            :stobjs state)
-                     (ignorable state))
-            (case fn
-              . ,(glcp-predef-cases-fn
-                  (remove 'if g-fns) world))))
-
-       
-
-        ;; make the evaluator, falsifier
-        (local (defun dummy-label-for-make-evaluator-fn () nil))
-        (acl2::defevaluator-fast
-         ,ev ,ev-lst
-         ,(fns-to-calls
-           (append `(if gl-cp-hint shape-spec-obj-in-range
-                      return-last use-by-hint equal acl2::typespec-check implies iff
-                      not cons gl-aside gl-ignore gl-error)
-                   (set-difference-eq
-                    g-fns
-                    `(if gl-cp-hint shape-spec-obj-in-range
-                       return-last use-by-hint equal not cons
-                       ,geval gl-aside gl-ignore gl-error)))
-           world)
-         :namedp t)
-        (local (def-ruleset! ,constraints
-                 (set-difference-theories
-                  (current-theory :here)
-                  (current-theory 'dummy-label-for-make-evaluator-fn))))
-        (acl2::def-meta-extract ,ev ,ev-lst)
-        ;; (defchoose ,falsify (a) (x)
-        ;;   (not (,ev x a)))
-        (local (defthm ,ctrex-thm
-                 (implies (not (,ev x a))
-                          (not (,ev x (,falsify x))))
-                 :hints (("goal" :use ,falsify))))
-
-
-        ;; Define the interpreter mutual-recursion, the
-        ;; run-parametrized and run-cases functions, and the clause proc.
-        ,@(sublis subst (list *glcp-interp-template*
-                              *glcp-run-parametrized-template*
-                              *glcp-run-cases-template*
-                              *glcp-clause-proc-template*))
-
-        ;; Prep for the run-gified correctness and gobjectp theorems
-        (local 
-         (progn
-           (eval-g-prove-f-i ,f-i-thm ,geval generic-geval)
-           (eval-g-functional-instance
-            gl-eval-car-cdr-of-gobj-listp ,geval generic-geval)
-           (eval-g-functional-instance
-            gl-eval-consp-when-gobj-listp ,geval generic-geval)
-           (eval-g-functional-instance
-            gl-eval-of-nil ,geval generic-geval)
-           (eval-g-functional-instance
-            general-concrete-obj-correct ,geval generic-geval)
-           
-           ;; Prove correctness of run-gified
-           (defthm ,run-gified-correct
-             (implies (and (bfr-eval hyp (car env))
-                           (gobj-listp actuals)
-                           (mv-nth 0 (,run-gified
-                                      fn actuals hyp clk state)))
-                      (equal (,geval (mv-nth 1 (,run-gified
-                                                fn actuals hyp clk state))
-                                     env)
-                             (,ev (cons fn (acl2::kwote-lst
-                                            (,geval actuals env))) nil)))
-             :hints (("goal" :clause-processor
-                      (run-gified-clause-proc
-                       clause
-                       '(,(f-i-thmname
-                           'gl-eval-consp-when-gobj-listp geval)
-                         ,(f-i-thmname
-                           'gl-eval-car-cdr-of-gobj-listp geval)
-                         ,(f-i-thmname 'gl-eval-of-nil geval))
-                       state))
-                     (use-by-computed-hint clause)))
-
-           (in-theory (disable ,run-gified))
-
-           ;; Prep to prove the guards of the interpreter and the correctness of
-           ;; the clause processor.
-           (eval-g-functional-instance shape-spec-to-gobj-eval-env
-                                       ,geval generic-geval)
-           (eval-g-functional-instance mk-g-boolean-correct
-                                       ,geval generic-geval)
-           (eval-g-functional-instance
-            generic-geval-gl-cons ,geval generic-geval)
-
-           (eval-g-functional-instance
-            gobj-to-param-space-correct ,geval generic-geval)
-
-           (eval-g-functional-instance
-            generic-geval-non-cons ,geval generic-geval)
-
-           (def-ruleset! ,f-i-lemmas
-             (append '(car-cons cdr-cons)
-                     ;; (let ((constr (acl2::ruleset ',constraints)))
-                     ;;   (nthcdr (- (len constr) 18) constr))
-                     '(,ctrex-thm
-                       ,run-gified-correct
-                       ;; ,apply-concrete-lemma
-                       ;; ,apply-concrete-state
-                       ,(f-i-thmname 'generic-geval-gl-cons geval)
-                       (:type-prescription ,run-gified)
-                       ;; (:type-prescription ,apply-concrete)
-                       ,(f-i-thmname 'gobj-ite-merge-correct geval)
-                       ,(f-i-thmname 'gtests-nonnil-correct geval)
-                       ,(f-i-thmname 'gtests-obj-correct geval)
-                       ,(f-i-thmname 'shape-spec-to-gobj-eval-env geval)
-                       ,(f-i-thmname 'mk-g-boolean-correct geval)
-                       ,(f-i-thmname 'mk-g-concrete-correct geval)
-                       ,(f-i-thmname 'g-concrete-quote-correct geval)
-                       ,(f-i-thmname 'mk-g-ite-correct geval)
-                       ,(f-i-thmname 'generic-geval-non-cons geval)
-                       ,(f-i-thmname 'gobj-to-param-space-correct geval)
-                       ,(f-i-thmname 'general-concrete-obj-correct geval))))))
-
-        ;; Verify guards of the interpreter.
-        (local (in-theory nil))
-        (verify-guards 
-         ,interp-term
-         :hints (("goal" :by
-                  (:functional-instance
-                   glcp-generic-interp-guards-ok
-                   (glcp-generic-interp-term ,interp-term)
-                   (glcp-generic-interp-list ,interp-list)
-                   (glcp-generic-ev ,ev)
-                   (glcp-generic-ev-lst ,ev-lst)
-                   (glcp-generic-geval ,geval)
-                   (glcp-generic-run-gified ,run-gified)
-                   (glcp-generic-ev-falsify ,falsify)
-                   ;; (glcp-generic-apply-concrete ,apply-concrete)
-                   ;; (glcp-generic-apply-concrete-guard-wrapper ,apply-concrete)
-                   )
-                  :in-theory (e/d** ((:ruleset ,f-i-lemmas)))
-                  :expand ((,interp-list x alist hyp clk obligs config state)
-                           (,interp-term x alist hyp clk obligs config state))
-                  :do-not-induct t)
-                 (and stable-under-simplificationp
-                      '(:in-theory (e/d** ((:ruleset ,f-i-lemmas)
-                                           (:ruleset ,constraints)))))
-                 (and stable-under-simplificationp
-                      '(:in-theory (e/d** ((:ruleset ,f-i-lemmas)
-                                           (:ruleset ,constraints)
-                                           ;; ,apply-concrete
-                                           ,(incat ev (symbol-name ev)
-                                                   "-OF-FNCALL-ARGS")))))))
-
-        ;; Prove correctness of the clause processor.
-        (defthm ,correct-thm
-          (implies (and (pseudo-term-listp clause)
-                        (alistp alist)
-                        (,meta-facts)
-                        (,ev (conjoin-clauses
-                              (acl2::clauses-result
-                               (,clause-proc clause hints state)))
-                             (,falsify
-                              (conjoin-clauses
+       ,@output
+       (encapsulate
+         nil
+         (set-state-ok t)
+         (set-ignore-ok t)
+         (set-irrelevant-formals-ok t)
+         ;; ,@(if current-geval
+         ;;       nil
+         (make-geval ,geval nil
+                     :output nil)
+         (encapsulate nil
+           (set-case-split-limitations '(1 1))
+           (defun ,run-gified
+             (fn actuals hyp clk config bvar-db state)
+             (declare (xargs :guard (and (symbolp fn)
+                                         (true-listp actuals)
+                                         (glcp-config-p config)
+                                         (natp clk))
+                             :guard-hints
+                             (("goal" :in-theory
+                               (e/d** ((:forward-chaining gobj-listp-true-listp)))
+                               :do-not '(preprocess)))
+                             :stobjs (bvar-db state))
+                      (ignorable state))
+             (case fn
+               . ,(glcp-predef-cases-fn
+                   (remove 'if g-fns) world))))
+
+
+
+         ;; ;; make the evaluator, falsifier
+         ;; (local (defun dummy-label-for-make-evaluator-fn () nil))
+         ;; (acl2::defevaluator-fast
+         ;;  ,ev ,ev-lst
+         ;;  ,(fns-to-calls
+         ;;    (append `(if gl-cp-hint shape-spec-obj-in-range
+         ;;               return-last use-by-hint equal acl2::typespec-check implies iff
+         ;;               not cons gl-aside gl-ignore gl-error)
+         ;;            (set-difference-eq
+         ;;             g-fns
+         ;;             `(if gl-cp-hint shape-spec-obj-in-range
+         ;;                return-last use-by-hint equal not cons
+         ;;                ,geval gl-aside gl-ignore gl-error)))
+         ;;    world)
+         ;;  :namedp t)
+         ;; (local (def-ruleset! ,constraints
+         ;;          (set-difference-theories
+         ;;           (current-theory :here)
+         ;;           (current-theory 'dummy-label-for-make-evaluator-fn))))
+         (acl2::def-meta-extract ,ev ,ev-lst)
+         ;; (defchoose ,falsify (a) (x)
+         ;;   (not (,ev x a)))
+         (local (defthm ,ctrex-thm
+                  (implies (not (,ev x a))
+                           (not (,ev x (,falsify x))))
+                  :hints (("goal" :use ,falsify))))
+
+
+         ;; Define the interpreter mutual-recursion, the
+         ;; run-parametrized and run-cases functions, and the clause proc.
+         ,@(sublis subst (list *glcp-interp-template*
+                               *glcp-clause-proc-template*))
+
+         ;; Prep for the run-gified correctness and gobjectp theorems
+         (local
+          (progn
+            (eval-g-prove-f-i ,f-i-thm ,geval generic-geval)
+            (eval-g-functional-instance
+             gl-eval-car-cdr-of-gobj-listp ,geval generic-geval)
+            (eval-g-functional-instance
+             gl-eval-consp-when-gobj-listp ,geval generic-geval)
+            (eval-g-functional-instance
+             gl-eval-of-nil ,geval generic-geval)
+            (eval-g-functional-instance
+             general-concrete-obj-correct ,geval generic-geval)
+
+
+            ;; Prove correctness of run-gified
+            (defthm ,run-gified-deps
+              (implies (not (gobj-list-depends-on k p actuals))
+                       (not (gobj-depends-on
+                             k p (mv-nth 1 (,run-gified
+                                            fn actuals hyp clk config bvar-db state)))))
+              :hints(("Goal" :in-theory (append '(gobj-depends-on-of-nth
+                                                  gobj-depends-on-of-nil
+                                                  ,run-gified)
+                                                (strip-cdrs
+                                                 (table-alist
+                                                  'sym-counterpart-dep-thms
+                                                  world))))))
+
+            ;; Prove correctness of run-gified
+            (defthm ,run-gified-correct
+              (implies (and (bfr-eval hyp (car env))
+                            (mv-nth 0 (,run-gified
+                                       fn actuals hyp clk config bvar-db state)))
+                       (equal (,geval (mv-nth 1 (,run-gified
+                                                 fn actuals hyp clk config bvar-db state))
+                                      env)
+                              (,ev (cons fn (acl2::kwote-lst
+                                             (,geval-list actuals env))) nil)))
+              :hints (("goal" :clause-processor
+                       (run-gified-clause-proc
+                        clause
+                        ',(f-i-thmname 'gl-eval-of-nil geval)
+                        state))
+                      (use-by-computed-hint clause)))
+
+            (in-theory (disable ,run-gified))
+
+            ;; Prep to prove the guards of the interpreter and the correctness of
+            ;; the clause processor.
+            (eval-g-functional-instance shape-spec-to-gobj-eval-env
+                                        ,geval generic-geval)
+            (eval-g-functional-instance mk-g-boolean-correct
+                                        ,geval generic-geval)
+            (eval-g-functional-instance
+             generic-geval-gl-cons ,geval generic-geval)
+
+            (eval-g-functional-instance
+             gobj-to-param-space-correct ,geval generic-geval)
+
+            (eval-g-functional-instance
+             generic-geval-non-cons ,geval generic-geval)
+
+            (def-ruleset! ,f-i-lemmas
+              (append '(car-cons cdr-cons)
+                      ;; (let ((constr (acl2::ruleset ',constraints)))
+                      ;;   (nthcdr (- (len constr) 18) constr))
+                      '(,ctrex-thm
+                        ,run-gified-correct
+                        ,run-gified-deps
+                        ;; ,apply-concrete-lemma
+                        ;; ,apply-concrete-state
+                        ,(f-i-thmname 'generic-geval-gl-cons geval)
+                        (:type-prescription ,run-gified)
+                        ;; (:type-prescription ,apply-concrete)
+                        ,(f-i-thmname 'gobj-ite-merge-correct geval)
+                        ,(f-i-thmname 'gtests-nonnil-correct geval)
+                        ,(f-i-thmname 'gtests-obj-correct geval)
+                        ,(f-i-thmname 'shape-spec-to-gobj-eval-env geval)
+                        ,(f-i-thmname 'mk-g-boolean-correct geval)
+                        ,(f-i-thmname 'mk-g-concrete-correct geval)
+                        ,(f-i-thmname 'g-concrete-quote-correct geval)
+                        ,(f-i-thmname 'mk-g-ite-correct geval)
+                        ,(f-i-thmname 'generic-geval-non-cons geval)
+                        ,(f-i-thmname 'gobj-to-param-space-correct geval)
+                        ,(f-i-thmname 'general-concrete-obj-correct geval))))))
+
+         ;; Verify guards of the interpreter.
+         (local (in-theory nil))
+         (verify-guards
+           ,interp-term
+           :hints (("goal" :by
+                    (:functional-instance
+                     glcp-generic-interp-guards-ok
+                     . ,fi-subst
+                     ;; (glcp-generic-apply-concrete ,apply-concrete)
+                     ;; (glcp-generic-apply-concrete-guard-wrapper ,apply-concrete)
+                     )
+                    :do-not '(preprocess simplify)
+                    :in-theory (e/d** ((:ruleset ,f-i-lemmas)))
+                    :do-not-induct t)
+                   '(:clause-processor dumb-clausify-cp)
+                   (let ((term (car (last clause))))
+                     (case-match term
+                       (('equal (fn . args) . &)
+                        (if (member fn ',(set-difference-eq fn-names
+                                                            (list geval-ev
+                                                                  geval-ev-lst)))
+                            `(:by ,fn
+                              :do-not nil)
+                          '(:do-not nil)))
+                       (& '(:do-not nil))))
+                   (and stable-under-simplificationp
+                        '(:in-theory (e/d** ((:ruleset ,f-i-lemmas)
+                                             (:ruleset ,ev-rules)))))
+                   (and stable-under-simplificationp
+                        '(:in-theory (e/d** ((:ruleset ,f-i-lemmas)
+                                             (:ruleset ,ev-rules)
+                                             ;; ,apply-concrete
+                                             ,(incat ev (symbol-name ev)
+                                                     "-OF-FNCALL-ARGS")))))))
+
+         ;; Prove correctness of the clause processor.
+         (defthm ,correct-thm
+           (implies (and (pseudo-term-listp clause)
+                         (alistp alist)
+                         (,meta-facts)
+                         (,ev (conjoin-clauses
                                (acl2::clauses-result
-                                (,clause-proc clause hints state))))))
-                   (,ev (disjoin clause) alist))
-          :hints (("goal" :do-not-induct t
-                   :in-theory (e/d** (,ctrex-thm))
-                   :by (:functional-instance
-                        glcp-generic-correct
-                        (glcp-generic-interp-term ,interp-term)
-                        (glcp-generic-interp-list ,interp-list)
-                        (glcp-generic-ev ,ev)
-                        (glcp-generic-ev-lst ,ev-lst)
-                        (glcp-generic-geval ,geval)
-                        (glcp-generic-run-gified ,run-gified)
-                        ;; (glcp-generic-apply-concrete ,apply-concrete)
-                        ;; (glcp-generic-apply-concrete-guard-wrapper ,apply-concrete)
-                        (glcp-generic-ev-falsify ,falsify)
-                        (glcp-generic-ev-meta-extract-global-badguy
-                         ,badguy)
-                        (glcp-generic-run-parametrized
-                         ,run-parametrized)
-                        (glcp-generic-run-cases ,run-cases)
-                        (glcp-generic ,clause-proc)))
-                  (case-match clause
-                    ((('equal (fn . args) . &))
-                     (and (member fn '(,clause-proc
-                                      ,run-parametrized
-                                      ,run-cases))
-                          `(:expand ((,fn . ,args)))))
-                    (((ev ('acl2::meta-extract-global-fact+ . &)
-                          . &)
-                      ('not (ev ('acl2::meta-extract-global-fact+ . &)
-                                . &)))
-                     '(:use ,badguy))
-                    ((('true-listp . &) . &)
-                     '(:use ,badguy))))
-          :otf-flg t
-          :rule-classes :clause-processor)
-
-        (table latest-greatest-gl-clause-proc ',clause-proc t)))))
+                                (,clause-proc clause hints state)))
+                              (,falsify
+                               (conjoin-clauses
+                                (acl2::clauses-result
+                                 (,clause-proc clause hints state))))))
+                    (,ev (disjoin clause) alist))
+           :hints (("goal" :do-not-induct t
+                    :in-theory (e/d** (,ctrex-thm))
+                    :do-not '(preprocess)
+                    :by (:functional-instance
+                         glcp-generic-correct
+                         . ,fi-subst))
+                   '(:clause-processor dumb-clausify-cp)
+                   (case-match clause
+                     ((('equal (fn . args) . &))
+                      (and (member fn ',(set-difference-eq fn-names
+                                                           (list geval-ev
+                                                                 geval-ev-lst)))
+                           `(:by ,fn)))
+                     (((ev ('acl2::meta-extract-global-fact+ . &)
+                           . &)
+                       ('not (ev ('acl2::meta-extract-global-fact+ . &)
+                                 . &)))
+                      '(:use ,badguy :do-not nil))
+                     ((('true-listp . &) . &)
+                      '(:use ,badguy :do-not nil))))
+           :otf-flg t
+           :rule-classes :clause-processor)
+
+         (table latest-greatest-gl-clause-proc nil ',subst :clear)))))
+
 
 
 
 
+(defsection def-gl-clause-processor
+  :parents (reference)
+  :short "Define a GL clause processor with a given set of built-in symbolic
+  counterparts."
 
-(defmacro def-gl-clause-processor
-  (name &rest rest-args
-        ;; apply-fns &key (output
-        ;;                 '(:off (warning warning! observation prove
-        ;;                                 event summary proof-tree
-        ;;                                 acl2::expansion)
-        ;;                        :gag-mode nil))
-        ;; top-apply-fns
-        ;; include-nonrec
-        )
-  ":Doc-section ACL2::GL
-Define a GL clause processor with a given set of built-in symbolic counterparts.~/
+  :long "<p>Usage:</p>
 
-Usage:
-~bv[]
+@({
  (def-gl-clause-processor my-gl-clause-processor
    :output with-output-settings)
-~ev[]
-The above form defines a GL clause processor function named
+})
+
+<p>The above form defines a GL clause processor function named
 my-gl-clause-processor.  This clause processor is defined so that it can
-execute all existing symbolic counterpart functions.
+execute all existing symbolic counterpart functions.</p>
 
-There is rarely a necessity for a user to define a new GL clause processor now,
-unless they have added symbolic counterpart functions either by hand-coding
-them or using ~c[MAKE-G-WORLD].~/
+<p>There is rarely a necessity for a user to define a new GL clause processor
+now, unless they have added symbolic counterpart functions either by
+hand-coding them or using @(see make-g-world).</p>
 
-Each GL clause processor has an associated sets of functions that it can
+<p>Each GL clause processor has an associated sets of functions that it can
 directly execute symbolically.  DEF-GL-CLAUSE-PROCESSOR makes a new processor
-that can execute the full set of existing symbolic counterparts.
- (Symbolic counterparts may be defined by hand or using ~c[MAKE-G-WORLD].)
+that can execute the full set of existing symbolic counterparts. (Symbolic
+counterparts may be defined by hand or using @(see make-g-world).)</p>
 
-It used to be the case that the clause processor also had a fixed set of
+<p>It used to be the case that the clause processor also had a fixed set of
 functions it could execute concretely.  That is no longer the case.  We still
 accept the old form of def-gl-clause-processor, which takes an additional
 argument after the name of the clause processor and before the :output keyword
  (if any).  However, this is deprecated and a message will be printed saying so.
+</p>
 
-~l[DEF-GL-THM] and ~il[GL-HINT] for information on using the GL
-clause processor to prove theorems.~/"
-  (b* (((mv oldp keys)
-        (if (keywordp (car rest-args))
-            (mv nil rest-args)
-          (mv t (cdr rest-args))))
-       (- (and oldp
-               (cw "DEPRECATED (def-gl-clause-proc): Def-gl-clause-proc now ~
-                    takes fewer arguments than it used to; in particular, the ~
-                    old APPLY-FNS argument is now ignored.  See :doc ~
-                    def-gl-clause-proc for the new syntax.~%")))
-       (output-look (assoc-keyword :output keys))
-       (output (if output-look
-                   (cadr output-look)
-                 '(:off (warning warning! observation prove
-                                 event summary proof-tree
-                                 acl2::expansion)
-                   :gag-mode nil))))
-  `(make-event
-    (def-gl-clause-processor-fn
-      ',name ',output state))))
+<p>See @(see def-gl-thm) and @(see gl-hint) for information on using the GL
+clause processor to prove theorems.</p>"
+
+  (defmacro def-gl-clause-processor
+    (name &rest rest-args
+          ;; apply-fns &key (output
+          ;;                 '(:off (warning warning! observation prove
+          ;;                                 event summary proof-tree
+          ;;                                 acl2::expansion)
+          ;;                        :gag-mode nil))
+          ;; top-apply-fns
+          ;; include-nonrec
+          )
+    (b* (((mv oldp keys)
+          (if (or (not rest-args)
+                  (keywordp (car rest-args)))
+              (mv nil rest-args)
+            (mv t (cdr rest-args))))
+         (- (and oldp
+                 (cw "DEPRECATED (def-gl-clause-proc): Def-gl-clause-proc now ~
+                      takes fewer arguments than it used to; in particular, ~
+                      the old APPLY-FNS argument is now ignored.  See :doc ~
+                      def-gl-clause-proc for the new syntax.~%")))
+         (output-look (assoc-keyword :output keys))
+         (output (if output-look
+                     (cadr output-look)
+                   '(:off (warning warning! observation prove
+                                   event summary proof-tree
+                                   acl2::expansion)
+                          :gag-mode nil))))
+      `(make-event
+        (def-gl-clause-processor-fn
+          ',name ',output state)))))
 
 
 
@@ -711,7 +755,7 @@
                  :case-split-override case-split-override))
 
         (cov-hints (glcp-coverage-hints
-                    do-not-expand cov-theory-add cov-hints cov-hints-position)) 
+                    do-not-expand cov-theory-add cov-hints cov-hints-position))
         ((er trhyp)
          (acl2::translate hyp t t nil 'gl-hint-fn (w state) state))
         ((er trparam)
@@ -730,7 +774,7 @@
                       (cw "****  WARNING ****~%~@0~%" msg)
                   ;;  (er hard? 'gl-hint "~@0" msg)
                       )))
-        (bindings 
+        (bindings
          (add-var-bindings missing-vars
                            bindings))
         (param-bindings (add-param-var-bindings vars param-bindings))
@@ -740,46 +784,30 @@
                 state)))
      (value (glcp-combine-hints call cov-hints hyp-hints result-hints case-split-hints))))
 
-(defmacro gl-hint (clause-proc &key
-                               bindings param-bindings
-                               (hyp-clk '1000000)
-                               (concl-clk '1000000)
-                               cov-hints cov-hints-position
-                               cov-theory-add do-not-expand
-                               hyp-hints
-                               result-hints
-                               (hyp ''t) param-hyp concl
-                               (n-counterexamples '3)
-                               (abort-indeterminate 't)
-                               (abort-ctrex 't)
-                               (exec-ctrex 't)
-                               (abort-vacuous 't)
-                               (case-split-override 'nil)
-                               case-split-hints
-                               run-before-cases run-after-cases
-                               test-side-goals)
-  ":Doc-section ACL2::GL
-Try to prove a goal using GL symbolic simulation.~/
 
-Usage, as a computed hint (~l[using-computed-hints]):
-~bv[]
+(defsection gl-hint
+  :parents (reference)
+  :short "Try to prove a goal using GL symbolic simulation."
+  :long "<p>Usage, as a <see topic='@(url acl2::computed-hints)'>computed hint</see>:</p>
+
+@({
  (gl-hint my-gl-clause-processor
          :bindings `((a ,(g-number (list (mk-number-list 1 1 9))))
                      (b ,(g-boolean 0)))
          :hyp '(bvecp a 8)
          :coverage-hints ('(:expand ((bvecp a 8)))))
-~ev[]
+})
 
-The above hint causes an attempt to apply the clause processor
-my-gl-clause-processor to the current clause.  Such a clause processor
-must be created using ~il[DEF-GL-CLAUSE-PROCESSOR].  One such
-clause processor, ~c[GL::GLCP], is predefined in the GL system.
-Various keyword arguments control the symbolic simulation and
-auxilliary proofs.~/
-
-The full interface is as follows, with default values and brief
-descriptions of each keyword argument:
-~bv[]
+<p>The above hint causes an attempt to apply the clause processor
+my-gl-clause-processor to the current clause.  Such a clause processor must be
+created using @(see def-gl-clause-processor).  One such clause processor, @(see
+glcp), is predefined in the GL system.  Various keyword arguments control the
+symbolic simulation and auxilliary proofs.</p>
+
+<p>The full interface is as follows, with default values and brief
+descriptions of each keyword argument:</p>
+
+@({
  (gl-hint clause-processor-name
 
           ;; bindings of variables to symbolic object specs
@@ -793,7 +821,7 @@
 
           ;; conclusion of the theorem
           :concl                   nil
-           
+
           ;; hints for proving coverage
           :cov-hints               nil
           :cov-hints-position      nil
@@ -823,19 +851,36 @@
           :param-hyp               nil
           :run-before-cases        nil
           :run-after-cases         nil)
-~ev[]
+})
 
-The keyword arguments to ~c[GL-HINT] are similar to ones for the
-macros ~il[DEF-GL-THM] and ~il[DEF-GL-PARAM-THM], and are
-documented there.
-~/"
-
-  (gl-hint-fn clause-proc bindings param-bindings hyp param-hyp concl
-              hyp-clk concl-clk cov-hints cov-hints-position
-              cov-theory-add do-not-expand hyp-hints result-hints
-              n-counterexamples abort-indeterminate abort-ctrex exec-ctrex abort-vacuous
-              run-before-cases run-after-cases
-              case-split-override case-split-hints test-side-goals))
+<p>The keyword arguments to @('gl-hint') are similar to ones for the macros
+@(see def-gl-thm) and @(see def-gl-param-thm), and are documented there.</p>"
+
+  (defmacro gl-hint (clause-proc &key
+                                 bindings param-bindings
+                                 (hyp-clk '1000000)
+                                 (concl-clk '1000000)
+                                 cov-hints cov-hints-position
+                                 cov-theory-add do-not-expand
+                                 hyp-hints
+                                 result-hints
+                                 (hyp ''t) param-hyp concl
+                                 (n-counterexamples '3)
+                                 (abort-indeterminate 't)
+                                 (abort-ctrex 't)
+                                 (exec-ctrex 't)
+                                 (abort-vacuous 't)
+                                 (case-split-override 'nil)
+                                 case-split-hints
+                                 run-before-cases run-after-cases
+                                 test-side-goals)
+
+    (gl-hint-fn clause-proc bindings param-bindings hyp param-hyp concl
+                hyp-clk concl-clk cov-hints cov-hints-position
+                cov-theory-add do-not-expand hyp-hints result-hints
+                n-counterexamples abort-indeterminate abort-ctrex exec-ctrex abort-vacuous
+                run-before-cases run-after-cases
+                case-split-override case-split-hints test-side-goals)))
 
 
 (defun def-gl-thm-fn
@@ -879,15 +924,15 @@
       form)))
 
 (defmacro latest-gl-clause-proc ()
-  '(caar (table-alist
-          'latest-greatest-gl-clause-proc
-          (w state))))
+  '(cdr (assoc 'clause-proc (table-alist
+                             'latest-greatest-gl-clause-proc
+                             (w state)))))
 
 (defmacro latest-gl-interp ()
-  '(interp-term-fnname
-    (caar (table-alist
-           'latest-greatest-gl-clause-proc
-           (w state)))))
+  '(cdr (assoc 'interp-term
+               (table-alist
+                'latest-greatest-gl-clause-proc
+                (w state)))))
 
 
 ;; just wraps with-output around all this stuff and invisiblifies the return value
@@ -898,7 +943,7 @@
         (with-output :stack :pop
           ,form))
        (value-triple :invisible))))
-  
+
 
 
 ;; If a clause-processor name is supplied, this creates a defthm event
@@ -918,29 +963,12 @@
 
 
 
-;; Define a macro that provides a drop-in replacement for DEF-G-THM and
-;; uses the new clause processor.
-(defmacro def-gl-thm
-  (name &key (clause-proc 'nil clause-procp)
-        skip-g-proofs
-        (hyp 'nil hyp-p)
-        (concl 'nil concl-p)
-        (g-bindings 'nil g-bindings-p)
-        cov-hints cov-hints-position
-        cov-theory-add
-        do-not-expand 
-        (hyp-clk '1000000)
-        (concl-clk '1000000)
-        (n-counterexamples '3)
-        (abort-indeterminate 't) (abort-ctrex 't) (exec-ctrex 't) (abort-vacuous 't)
-        local
-        test-side-goals
-        (rule-classes ':rewrite))
-  ":Doc-section ACL2::GL
-Prove a theorem using GL symbolic simulation~/
+(defsection def-gl-thm
+  :parents (reference)
+  :short "Prove a theorem using GL symbolic simulation."
+  :long "<p>Usage:</p>
 
-Usage:
-~bv[]
+@({
  (def-gl-thm <theorem-name>
    :hyp <hypothesis term>
    :concl <conclusion term>
@@ -959,123 +987,155 @@
    :do-not-expand <list of functions>
    :cov-hints <computed hints>
    :cov-hints-position <:replace, :before, or :after>
-   
+
    :test-side-goals <t or nil>)
-~ev[]
+})
+
+<p>This form submits a @(see defthm) event for the theorem</p>
+
+@({(implies <hyp> <concl>)})
+
+<p>and the specified rule-classes, and gives a hint to attempt to prove it by
+symbolic execution using a GL clause processor.</p>
 
-This form submits a ~c[DEFTHM] event for the theorem
-~c[(implies <hyp> <concl>)] and the specified rule-classes, and gives a hint to
-attempt to prove it by symbolic execution using a GL clause processor.~/
-
-Out of the list of keyword arguments recognized by this macro, three are
-necessary: ~c[:hyp], ~c[:concl], and ~c[:g-bindings].  As noted, the theorem to
-be proved takes the form ~c[(implies <hyp> <concl>)].  The ~c[hyp] is also used
-in proving coverage, explained below.
+<p>Out of the list of keyword arguments recognized by this macro, three are
+necessary: @(':hyp'), @(':concl'), and @(':g-bindings').  As noted, the theorem
+to be proved takes the form @('(implies <hyp> <concl>)').  The @('hyp') is also
+used in proving coverage, explained below.</p>
 
-The ~c[g-bindings] must be a term evaluating to an alist formatted as follows:
-~bv[]
+<p>The @(':g-bindings') must be a term evaluating to an alist formatted as
+follows:</p>
+
+@({
  ((<var-name1>  <shape-spec1>)
   (<var-name2>  <shape-spec2>)
   ...)
-~ev[]
-The shape specs must be well-formed as described in ~il[GL::SHAPE-SPECS]; notably,
-they must not reuse BDD variable numbers or unconstrainted variable names.
-Note also that this is not a dotted alist; the shape spec is the ~c[CADR], not
-the ~c[CDR], of each entry.  If any variables mentioned in the theorem are not
-bound in this alist, they will be given an unconstrained variable binding.
-
-The symbolic objects used as the inputs to the symbolic simulation are obtained
-by translating each shape spec into a symbolic object.  The hyp is symbolically
-executed on these symbolic inputs.  Parametrizing the symbolic objects by the
-resulting predicate object yields (absent any ~c[G-APPLY] or ~c[G-VAR] objects)
-symbolic objects with coverage restricted to only inputs satisfying the hyp.
+})
+
+<p>The shape specs must be well-formed as described in @(see shape-specs);
+notably, they must not reuse BDD variable numbers or unconstrained variable
+names.  Note also that this is not a dotted alist; the shape spec is the @(see
+cadr), not the @(see cdr), of each entry.  If any variables mentioned in the
+theorem are not bound in this alist, they will be given an unconstrained
+variable binding.</p>
+
+<p>The symbolic objects used as the inputs to the symbolic simulation are
+obtained by translating each shape spec into a symbolic object.  The hyp is
+symbolically executed on these symbolic inputs.  Parametrizing the symbolic
+objects by the resulting predicate object yields (absent any @('G-APPLY') or
+@('G-VAR') objects) symbolic objects with coverage restricted to only inputs
+satisfying the hyp.</p>
+
+<p>Here is a simple example theorem:</p>
 
-Here is a simple example theorem:
-~bv[]
+@({
  (def-gl-thm commutativity-of-+-up-to-16
     :hyp (and (natp a) (natp b)
               (< a 16) (< b 16))
     :concl (equal (+ a b) (+ b a))
     :g-bindings '((a (:g-number (0 2 4 6 8)))
                   (b (:g-number (1 3 5 7 9)))))
-~ev[]
+})
 
-This theorem binds its free variables ~c[A] and ~c[B] to symbolic numbers of
-five bits.  Note that integers are two's-complement, so to represent natural
+<p>This theorem binds its free variables @('a') and @('b') to symbolic numbers
+of five bits.  Note that integers are two's-complement, so to represent natural
 numbers one needs one more bit than in the unsigned representation.  Therefore,
 these shape specs cover negative numbers down to -16 as well as naturals less
 than 16.  However, parametrization by the hypotheses will yield symbolic
-objects that only cover the specified range.
+objects that only cover the specified range.</p>
 
-The coverage obligation for a theorem will be a goal like this:
-~bv[]
+<p>The coverage obligation for a theorem will be a goal like this:</p>
+
+@({
  (implies <hyp>
           (shape-spec-obj-in-range
            (list <shape-spec1> <shape-spec2> ...)
            (list <var-name1> <var-name2> ...)))
-~ev[]
-In the example above:
-~bv[]
+})
+
+<p> In the example above:</p>
+
+@({
  (implies (and (natp a) (natp b)
                (< a 16) (< b 16))
           (shape-spec-obj-in-range
            '((:g-number (0 2 4 6 8)) (:g-number (1 3 5 7 9)))
            (list a b)))
-~ev[]
+})
 
-It is often convenient to work out the coverage theorem before running the
+<p>It is often convenient to work out the coverage theorem before running the
 symbolic simulation, since the symbolic simulation may take a very long time
-even when successful.  The keyword argument ~c[:test-side-goals] may be given a
-value of ~c[T] in order to attempt the coverage proof on its own; if
+even when successful.  The keyword argument @(':test-side-goals') may be given
+a value of @('T') in order to attempt the coverage proof on its own; if
 successful, no theorem will be stored by ACL2, but one can then be fairly sure
-that the coverage proof will go through in the real theorem.
+that the coverage proof will go through in the real theorem.</p>
 
-Several hints are given by default for proving coverage; see
-~il[GL::SHAPE-SPECS] for details.  The keyword arguments ~c[:cov-theory-add],
-~c[:do-not-expand], ~c[:cov-hints], and ~c[cov-hints-position] affect the
-coverage proof.
+<p>Several hints are given by default for proving coverage; see @(see
+shape-specs) for details.  The keyword arguments @(':cov-theory-add'),
+@(':do-not-expand'), @(':cov-hints'), and @(':cov-hints-position') affect the
+coverage proof.</p>
 
-When proof by symbolic simulation fails, the clause processor will print
-randomized counterexamples.  The keyword argument ~c[:n-counterexamples]
+<p>When proof by symbolic simulation fails, the clause processor will print
+randomized counterexamples.  The keyword argument @(':n-counterexamples')
 determines how many it prints.  The default is 3.  (For SAT-based proofs,
 likely only one counterexample is available, so it may print the same
-counterexample each time.)
+counterexample each time.)</p>
 
-By default, the clause processor will execute conclusion on the counterexamples
-that it finds; this is useful for printing debugging information.  However,
-sometimes the conclusion is not executable; in that case, you may turn off
-execution of counterexamples using ~c[:exec-ctrex nil].
+<p>By default, the clause processor will execute conclusion on the
+counterexamples that it finds; this is useful for printing debugging
+information.  However, sometimes the conclusion is not executable; in that
+case, you may turn off execution of counterexamples using @(':exec-ctrex
+nil').</p>
 
-A symbolic simulation may result in a symbolic object that can't be
+<p>A symbolic simulation may result in a symbolic object that can't be
 syntactically determined to be non-nil; for example, the result may contain a
-~c[:G-APPLY] object.  In these situations, the proof attempt will
-abort, and an example will be shown of inputs for which the symbolic result's
-value could not be determined.  To debug this type of problem, see
-~il[GL::DEBUGGING-INDETERMINATE-RESULTS].
+@(':G-APPLY') object.  In these situations, the proof attempt will abort, and
+an example will be shown of inputs for which the symbolic result's value could
+not be determined.  To debug this type of problem, see @(see
+debugging-indeterminate-results).</p>
 
-The symbolic interpreter and all symbolic counterpart functions take a clock
+<p>The symbolic interpreter and all symbolic counterpart functions take a clock
 argument to ensure termination.  The starting clocks for the symbolic
 executions of the hyp (for parametrization) and the conclusion may be set using
-the keyword arguments ~c[:hyp-clk] and ~c[:concl-clk]; the defaults are both
-1000000.
-
-The keyword argument ~c[:clause-proc] can be used to select the clause
-processor to be used; see ~c[DEF-GL-CLAUSE-PROCESSOR].  By default, the latest
-clause processor introduced is used.  If no ~c[:clause-proc] keyword argument
-is given, then this macro expands to a ~c[make-event], which in turn expands to
-the ~c[defthm] event; otherwise, this expands directly to the ~c[defthm].
-
-The keyword argument ~c[:rule-classes] can be used to select the rule-classes
-for the theorem produced, as in ~c[defthm]; the default is ~c[:rewrite].
-~/
-"
-  (declare (ignore skip-g-proofs local))
-  (def-gl-thm-find-cp name clause-proc clause-procp
-    (list hyp hyp-p concl concl-p g-bindings g-bindings-p cov-hints
-          cov-hints-position cov-theory-add do-not-expand hyp-clk concl-clk
-          n-counterexamples abort-indeterminate abort-ctrex exec-ctrex abort-vacuous test-side-goals
-          rule-classes)))
+the keyword arguments @(':hyp-clk') and @(':concl-clk'); the defaults are both
+1000000.</p>
 
+<p>The keyword argument @(':clause-proc') can be used to select the clause
+processor to be used; see @(see def-gl-clause-processor).  By default, the
+latest clause processor introduced is used.  If no @(':clause-proc') keyword
+argument is given, then this macro expands to a @(see make-event), which in
+turn expands to the @(see defthm) event; otherwise, this expands directly to
+the @(see defthm).</p>
+
+<p>The keyword argument @(':rule-classes') can be used to select the
+rule-classes for the theorem produced, as in @(see defthm); the default is
+@(':rewrite').</p>"
+
+  ;; Define a macro that provides a drop-in replacement for DEF-G-THM and
+  ;; uses the new clause processor.
+  (defmacro def-gl-thm
+    (name &key (clause-proc 'nil clause-procp)
+          skip-g-proofs
+          (hyp 'nil hyp-p)
+          (concl 'nil concl-p)
+          (g-bindings 'nil g-bindings-p)
+          cov-hints cov-hints-position
+          cov-theory-add
+          do-not-expand
+          (hyp-clk '1000000)
+          (concl-clk '1000000)
+          (n-counterexamples '3)
+          (abort-indeterminate 't) (abort-ctrex 't) (exec-ctrex 't) (abort-vacuous 't)
+          local
+          test-side-goals
+          (rule-classes ':rewrite))
+
+    (declare (ignore skip-g-proofs local))
+    (def-gl-thm-find-cp name clause-proc clause-procp
+      (list hyp hyp-p concl concl-p g-bindings g-bindings-p cov-hints
+            cov-hints-position cov-theory-add do-not-expand hyp-clk concl-clk
+            n-counterexamples abort-indeterminate abort-ctrex exec-ctrex abort-vacuous test-side-goals
+            rule-classes))))
 
 
 
@@ -1142,37 +1202,19 @@
          ,(def-gl-param-thm-fn name clause-proc rest))
     `(without-waterfall-parallelism
        (make-event
-        (let ((clause-proc
-               (caar (table-alist
-                      'latest-greatest-gl-clause-proc
-                      (w state)))))
+        (let ((clause-proc (latest-gl-clause-proc)))
           (def-gl-param-thm-fn ',name clause-proc ',rest))))))
 
 
-(defmacro def-gl-param-thm
-  (name &key (clause-proc 'nil clause-procp)
-        skip-g-proofs
-        (hyp 'nil hyp-p)
-        (param-hyp 'nil param-hyp-p)
-        (concl 'nil concl-p)
-        (cov-bindings 'nil cov-bindings-p)
-        (param-bindings 'nil param-bindings-p)
-        cov-hints cov-hints-position
-        cov-theory-add
-        do-not-expand 
-        (hyp-clk '1000000)
-        (concl-clk '1000000)
-        (n-counterexamples '3)
-        (abort-indeterminate 't) (abort-ctrex 't) (exec-ctrex 't) (abort-vacuous 't)
-        run-before-cases run-after-cases
-        case-split-override
-        case-split-hints local test-side-goals
-        (rule-classes ':rewrite))
-  ":Doc-section ACL2::GL
-Prove a theorem using GL symbolic simulation with parametrized case-splitting.~/
 
-Usage:
-~bv[]
+(defsection def-gl-param-thm
+  :parents (reference optimization)
+  :short "Prove a theorem using GL symbolic simulation with parametrized
+case-splitting."
+
+  :long "<p>Usage:</p>
+
+@({
  (def-gl-param-thm <theorem-name>
    :hyp <hypotheses>
    :concl <conclusion>
@@ -1195,53 +1237,59 @@
    :do-not-expand <list of functions>
    :cov-hints <computed hints>
    :cov-hints-position <:replace, :before, or :after>
-   
+
    :test-side-goals <t or nil>)
-~ev[]
+})
 
-This form submits a ~c[DEFTHM] event for the theorem
-~c[(implies <hyp> <concl>)] and the specified rule classes, and gives a hint to
-attempt to prove it using a GL clause processor with parametrized
-case-splitting.  See ~il[def-gl-thm] for a simpler version that does not do
-case splitting.~/
-
-Out of the list of keyword arguments recognized by this macro, five are
-necessary: ~c[:hyp], ~c[:concl], ~c[param-hyp], ~c[:cov-bindings], and
-~c[:param-bindings].  As noted, the theorem to be proved takes the form
-~c[(implies <hyp> <concl>)].  The theorem is split into cases based on the
-~c[param-hyp], a term containing some free variables of the theorem and some
+<p>This form submits a @(see defthm) event for the theorem @('(implies <hyp>
+<concl>)') and the specified rule classes, and gives a hint to attempt to prove
+it using a GL clause processor with parametrized case-splitting.  See @(see
+def-gl-thm) for a simpler version that does not do case splitting.</p>
+
+<p>Out of the list of keyword arguments recognized by this macro, five are
+necessary: @(':hyp'), @(':concl'), @('param-hyp'), @(':cov-bindings'), and
+@(':param-bindings').  As noted, the theorem to be proved takes the form
+@('(implies <hyp> <concl>)').  The theorem is split into cases based on the
+@('param-hyp'), a term containing some free variables of the theorem and some
 additional variables used in case splitting.  Values are assigned to these
-variables based on the entries in the ~c[param-bindings], an alist of the
-following form:
-~bv[]
+variables based on the entries in the @('param-bindings'), an alist of the
+following form:</p>
+
+@({
  ((<case-bindings1> <var-bindings1>)
   (<case-bindings2> <var-bindings2>)
   ...)
-~ev[]
-Each of the case-bindings is, in turn, an alist of the following form:
-~bv[]
+})
+
+<p>Each of the case-bindings is, in turn, an alist of the following form:</p>
+
+@({
  ((<case-var1> <obj1>)
   (<case-var2> <obj2>)
   ...)
-~ev[]
-and each of the var-bindings is an alist of the following form:
-~bv[]
+})
+
+<p>and each of the var-bindings is an alist of the following form:</p>
+
+@({
  ((<thm-var1> <shape-spec1>)
   (<thm-var2> <shape-spec2>)
   ...)
-~ev[]
+})
 
-For each entry in the ~c[param-bindings], the ~c[param-hyp] is instantiated
-with the case variables bound to the objects specified in the entry's
-case-bindings.  This term gives a hypothesis about the free variables of the
-theorem, and the set of these terms generated from the param-bindings gives the
-full case-split.  The case split must cover the theorem's hypotheses; that is,
-the theorem's hypothesis must imply the disjunction of the case hypotheses.  To
-prove this, we symbolically simulate this disjunction using the shape specs
-given in the ~c[cov-bindings], which are formatted like the var-bindings above.
+<p>For each entry in the @('param-bindings'), the @('param-hyp') is
+instantiated with the case variables bound to the objects specified in the
+entry's case-bindings.  This term gives a hypothesis about the free variables
+of the theorem, and the set of these terms generated from the param-bindings
+gives the full case-split.  The case split must cover the theorem's hypotheses;
+that is, the theorem's hypothesis must imply the disjunction of the case
+hypotheses.  To prove this, we symbolically simulate this disjunction using the
+shape specs given in the @('cov-bindings'), which are formatted like the
+var-bindings above.</p>
 
-A simple example is as follows:
-~bv[]
+<p>A simple example is as follows:</p>
+
+@({
  (def-gl-param-thm addititive-inverse-for-5-bits
    :hyp (and (integerp n) (<= -16 n) (< n 16))
    :concl (equal (- n n) 0)
@@ -1257,52 +1305,70 @@
      (((sign nil) (lower-bits 1)) ((n (:g-number (0 1 2 4 5)))))
      (((sign nil) (lower-bits 2)) ((n (:g-number (0 1 2 3 5)))))
      (((sign nil) (lower-bits 3)) ((n (:g-number (0 1 2 3 4)))))))
-~ev[]
+})
+
+<p>This theorem is proved by symbolic simulation of five cases, in each of
+which the param-hyp is assumed with a different setting of the sign and
+lower-bits case variables; in one case @('N') is required to be negative, and
+in the others it is required to be positive and have a given value on its two
+low-order bits.  To show that the case-split is complete, another symbolic
+simulation is performed (using the given @(':cov-bindings')) which proves that
+the disjunction of the case assumptions is complete; effectively,</p>
 
-This theorem is proved by symbolic simulation of five cases, in each of which
-the param-hyp is assumed with a different setting of the sign and lower-bits
-case variables; in one case ~c[N] is required to be negative, and in the others
-it is required to be positive and have a given value on its two low-order
-bits.  To show that the case-split is complete, another symbolic simulation is
-performed (using the given ~c[:cov-bindings]) which proves that the disjunction
-of the case assumptions is complete; effectively,
-~bv[]
+@({
  (implies (and (integerp n) (<= -16 n) (< n 16))
           (or (< n 0)
               (and (<= 0 n) (equal (logand n 3) 0))
               (and (<= 0 n) (equal (logand n 3) 1))
               (and (<= 0 n) (equal (logand n 3) 2))
               (and (<= 0 n) (equal (logand n 3) 3))))
-~ev[]
+})
 
-Most of the remaining keyword arguments to ~c[DEF-GL-PARAM-THM] are also
-available in ~il[DEF-GL-THM] and are documented there.  The rest are as
-follows:
+<p>Most of the remaining keyword arguments to @('DEF-GL-PARAM-THM') are also
+available in @(see def-gl-thm) and are documented there.  The rest are as
+follows:</p>
 
-~c[:RUN-BEFORE-CASES] and ~c[:RUN-AFTER-CASES] cause a user-specified form to
+<p>@(':RUN-BEFORE-CASES') and @(':RUN-AFTER-CASES') cause a user-specified form to
 be run between the parametrized symbolic simulations.  These may use the
-variable ~c[id], which is bound to the current assignment of the case-splitting
+variable @('id'), which is bound to the current assignment of the case-splitting
 variables.  These can be used to print a message before and after running each
-case so that the user can monitor the theorem's progress.
+case so that the user can monitor the theorem's progress.</p>
 
-By default, if a counterexample is encountered on any of the cases, the proof
-will abort.  Setting ~c[:ABORT-CTREX] to ~c[NIL] causes it to go on; the proof
+<p>By default, if a counterexample is encountered on any of the cases, the proof
+will abort.  Setting @(':ABORT-CTREX') to @('NIL') causes it to go on; the proof
 will fail after the clause processor returns because it will produce a goal of
-~c[NIL].
+@('NIL').</p>
 
-By default, if any case hypothesis is unsatisfiable, the proof will abort.
-Setting ~c[:ABORT-VACUOUS] to ~c[NIL] causes it to go on.
+<p>By default, if any case hypothesis is unsatisfiable, the proof will abort.
+Setting @(':ABORT-VACUOUS') to @('NIL') causes it to go on.</p>"
 
-~/
-"
-  (declare (ignore skip-g-proofs local))
-  (def-gl-param-thm-find-cp name clause-proc clause-procp
-    (list hyp hyp-p param-hyp param-hyp-p concl concl-p cov-bindings
-          cov-bindings-p param-bindings param-bindings-p cov-hints
-          cov-hints-position cov-theory-add do-not-expand hyp-clk concl-clk
-          n-counterexamples abort-indeterminate abort-ctrex exec-ctrex
-          abort-vacuous run-before-cases run-after-cases case-split-override
-          case-split-hints test-side-goals rule-classes)))
+  (defmacro def-gl-param-thm
+    (name &key (clause-proc 'nil clause-procp)
+          skip-g-proofs
+          (hyp 'nil hyp-p)
+          (param-hyp 'nil param-hyp-p)
+          (concl 'nil concl-p)
+          (cov-bindings 'nil cov-bindings-p)
+          (param-bindings 'nil param-bindings-p)
+          cov-hints cov-hints-position
+          cov-theory-add
+          do-not-expand
+          (hyp-clk '1000000)
+          (concl-clk '1000000)
+          (n-counterexamples '3)
+          (abort-indeterminate 't) (abort-ctrex 't) (exec-ctrex 't) (abort-vacuous 'nil)
+          run-before-cases run-after-cases
+          case-split-override
+          case-split-hints local test-side-goals
+          (rule-classes ':rewrite))
+    (declare (ignore skip-g-proofs local))
+    (def-gl-param-thm-find-cp name clause-proc clause-procp
+      (list hyp hyp-p param-hyp param-hyp-p concl concl-p cov-bindings
+            cov-bindings-p param-bindings param-bindings-p cov-hints
+            cov-hints-position cov-theory-add do-not-expand hyp-clk concl-clk
+            n-counterexamples abort-indeterminate abort-ctrex exec-ctrex
+            abort-vacuous run-before-cases run-after-cases case-split-override
+            case-split-hints test-side-goals rule-classes))))
 
 
 
diff -Nru acl2-6.2/books/centaur/gl/def-gl-rewrite.lisp acl2-6.3/books/centaur/gl/def-gl-rewrite.lisp
--- acl2-6.2/books/centaur/gl/def-gl-rewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/def-gl-rewrite.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,200 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "tools/bstar" :dir :system)
+(include-book "centaur/misc/beta-reduce-full" :dir :system)
+
+(defun scan-lemmas-for-nume (lemmas nume)
+  (declare (xargs :mode :program))
+  (b* (((when (endp lemmas)) nil)
+       (rule (car lemmas))
+       ((when (eql (acl2::access acl2::rewrite-rule rule :nume) nume))
+        rule))
+    (scan-lemmas-for-nume (cdr lemmas) nume)))
+
+(defun scan-props-for-nume-lemma (props nume)
+  (declare (xargs :mode :program))
+  (and (consp props)
+       (or (and (eq (cadar props) 'acl2::lemmas)
+                (scan-lemmas-for-nume (cddar props) nume))
+           (scan-props-for-nume-lemma (cdr props) nume))))
+
+
+(defun find-lemma-for-rune (rune world)
+  (declare (xargs :mode :program))
+  (b* ((nume (acl2::runep rune world))
+       ((unless nume) nil)
+       (segment (acl2::world-to-next-event
+                 (cdr (acl2::decode-logical-name (cadr rune) world)))))
+    (scan-props-for-nume-lemma (acl2::actual-props segment nil nil) nume)))
+
+(defun add-gl-rewrite-fn (rune world)
+  (declare (xargs :mode :program))
+  (b* ((rune (if (symbolp rune) `(:rewrite ,rune) rune))
+       (rule (find-lemma-for-rune rune world))
+       ((unless rule)
+        (cw "Failed to find a lemma for rune ~x0~%" rune))
+       (fnsym (car (acl2::access acl2::rewrite-rule rule :lhs)))
+       (entries (cdr (assoc fnsym (table-alist 'gl-rewrite-rules world))))
+       ((when (member-equal rule entries))
+        '(value-triple nil)))
+    `(table gl-rewrite-rules ',fnsym '(,rune . ,entries))))
+
+(defmacro add-gl-rewrite (rune)
+  `(make-event
+    (add-gl-rewrite-fn ',rune (w state))))
+
+(defsection def-gl-rewrite
+  :parents (reference)
+  :short "Define a rewrite rule for GL to use on term-level objects"
+  :long
+  "<p>GL can use ACL2-style rewrite rules to simplify term-level symbolic
+objects.  However, typically one wants a different theory for ACL2 theorem
+proving than one wants to use inside GL.  @('GL::DEF-GL-REWRITE') defines a
+rewrite rule that is only used inside GL:</p>
+
+@({
+  (gl::def-gl-rewrite my-rewrite-rule
+     (implies (and (syntaxp (and (integerp n) (< 0 (integer-length n))))
+                   (< 0 m))
+              (equal (logand n m)
+                     (logcons (b-and (logcar n) (logcar m))
+                              (logand (logcdr n) (logcdr m)))))
+    :hints ...)
+})
+
+<p>This defines a disabled ACL2 rewrite rule called my-rewrite-rule, and adds
+my-rewrite-rule to the table of rules GL is allowed to use. (GL will still use
+it even though it is disabled, as long it is in that table.)</p>
+
+<p>Def-gl-rewrite supports syntaxp hypotheses, but the term representation used
+is different from ACL2's.  Instead of being bound to TERMPs, the variables are
+bound to symbolic objects.  See @(see gl::symbolic-objects) for
+reference.</p>"
+
+  (defmacro def-gl-rewrite (name &rest args)
+    `(progn (defthmd ,name . ,args)
+            (add-gl-rewrite ,name))))
+
+
+
+(defun gl-set-uninterpreted-fn (fn val world)
+  (b* ((formals (getprop fn 'formals :none 'current-acl2-world world))
+       (fn (if (eq formals :none)
+               (cdr (assoc fn (table-alist 'acl2::macro-aliases-table world)))
+             fn))
+       (formals (if (eq formals :none)
+                    (getprop fn 'formals :none 'current-acl2-world world)
+                  formals))
+       ((when (eq formals :none))
+        (er hard? 'gl-set-uninterpreted-fn
+            "~x0 is neither a function nor a macro-alias for a function~%" fn)))
+    `(table gl-uninterpreted-functions ',fn ,val)))
+
+(defsection gl-set-uninterpreted
+  :parents (reference)
+  :short "Prevent GL from interpreting a function's definition or concretely executing it."
+  :long
+  "<p>Usage:</p>
+@({
+  (gl::gl-set-uninterpreted fnname)
+})
+<p>prevents GL from opening the definition of fnname or concretely executing
+it.  GL will still apply rewrite rules to a call of @('fnname').  If the
+call is not rewritten away, symbolic execution of a @('fnname') call will
+simply produce an object (of the :g-apply type) representing a call of
+@('fnname') on the given arguments.</p>
+
+<p>@('gl::gl-unset-uninterpreted') undoes the effect of @('gl::gl-set-uninterpreted').</p>"
+
+  (defmacro gl-set-uninterpreted (fn)
+    `(make-event
+      (gl-set-uninterpreted-fn ',fn t (w state)))))
+
+(defmacro gl-unset-uninterpreted (fn)
+  `(make-event
+    (gl-set-uninterpreted-fn ',fn nil (w state))))
+
+
+
+(defun gl-branch-merge-find-fnsym (name state)
+  (declare (xargs :mode :program :stobjs state))
+  (b* ((thm (acl2::beta-reduce-full (acl2::meta-extract-formula name state)))
+       (concl
+        (if (eq (car thm) 'implies)
+            (third thm)
+          thm))
+       (equiv (car concl))
+       ((unless (and (symbolp equiv)
+                     (getprop equiv 'acl2::coarsenings nil 'current-acl2-world
+                              (w state))
+                     (consp (second concl))
+                     (eq (car (second concl)) 'if)
+                     (consp (third (second concl)))
+                     (symbolp (car (third (second concl))))))
+        (er hard? 'gl-branch-merge-find-fnsym
+            "The theorem ~x0 did not have the expected form for a branch ~
+             merge rule: conclusion should be:~%  (equiv (if c (fn args) b) ~
+             rhs)" name)))
+    (car (third (second concl)))))
+
+(defsection def-gl-branch-merge
+  :parents (reference)
+  :short "Define a rule for GL to use in merging IF branches"
+  :long
+  "<p>Usage:</p>
+
+@({
+  (gl::def-gl-branch-merge my-branch-merge-rule
+     (implies (and (syntaxp (integerp m))
+                   (integerp m))
+              (equal (if cond (logcons b n) m)
+                     (logcons (if cond b (logcar m))
+                              (if cond n (logcdr m)))))
+   :hints ...)
+})
+
+<p>This form creates an ACL2 theorem with :rule-classes nil and installs it in
+a table that GL references when attempting to merge branches of an IF term.</p>
+
+<p>Branch merge rules work similarly to normal rewrite rules, except that:</p>
+<ul>
+<li>the LHS must be of the form: @('(if <var> <then-term> <else-term>)')</li>
+<li>each rule is indexed by the function symbol of the then-term, so then-term
+must be a function call.</li>
+</ul>"
+
+  (defun def-gl-branch-merge-fn (name body hints otf-flg)
+    `(progn
+       (defthm ,name
+         ,body
+         :hints ,hints
+         :otf-flg ,otf-flg
+         :rule-classes nil)
+       (make-event
+        (let* ((fn (gl-branch-merge-find-fnsym ',name state))
+               (rules (cons ',name (cdr (assoc fn (table-alist
+                                                   'gl-branch-merge-rules
+                                                   (w state)))))))
+          `(table gl-branch-merge-rules ',fn ',rules)))))
+
+  (defmacro def-gl-branch-merge (name body &key hints otf-flg)
+    (def-gl-branch-merge-fn name body hints otf-flg)))
diff -Nru acl2-6.2/books/centaur/gl/defagg.lisp acl2-6.3/books/centaur/gl/defagg.lisp
--- acl2-6.2/books/centaur/gl/defagg.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/defagg.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,8 +1,24 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
 (include-book "cutil/defaggregate" :dir :system)
 (include-book "tools/flag" :dir :system)
 (include-book "tools/pattern-match" :dir :system)
@@ -100,8 +116,8 @@
     `(cons ,(mk-constructor-aux (car tree))
            ,(mk-constructor-aux (cdr tree)))))
 
-(defun mk-constructor (basename tag names tree)
-  `(defund-inline ,basename ,names
+(defun mk-constructor (basename tag names tree notinline)
+  `(,(if notinline 'defund 'defund-inline) ,basename ,names
      (declare (xargs :guard t))
      ,(if tag
           `(cons ',tag
@@ -136,12 +152,12 @@
                :rule-classes (:rewrite :linear))
             (accessor-acl2-count-thms basename (cdr accs-alist))))))
 
-(defun defagg-fn (basename fields tag)
+(defun defagg-fn (basename fields tag notinline)
   (b* ((tree (list-to-tree fields))
        (accs-alist (mk-accs-alist basename tree))
        (?accs (strip-cars accs-alist)))
     `(defsection ,basename
-       ,(mk-constructor basename tag fields tree)
+       ,(mk-constructor basename tag fields tree notinline)
        ,@(mk-accessors accs-alist tag)
        ,@(accessors-of-constructor basename accs-alist fields fields)
        ,@(accessor-acl2-count-thms basename accs-alist)
@@ -160,9 +176,10 @@
                 (def-pattern-match-constructor
                   (x) ,basename (eq (tag x) ',tag) ,accs))))))
 
-(defmacro defagg (basename fields &key (tag 'nil tag-p))
+(defmacro defagg (basename fields &key (tag 'nil tag-p) notinline)
   (defagg-fn basename fields
-    (if tag-p tag (intern (symbol-name basename) "KEYWORD"))))
+    (if tag-p tag (intern (symbol-name basename) "KEYWORD"))
+    notinline))
 
 (logic)
 
@@ -173,7 +190,7 @@
 
 
 
-      
+
 
 ;; (defun da-accessors (name fields)
 ;;   (if (atom fields)
@@ -258,7 +275,7 @@
 ;;        (or (consp fields)
 ;;            (er hard 'defaggregate "There must be at least one field.~%"))
 ;;        (or (and (tuple-listp 2 require)
-;;                 (symbol-listp (strip-cars require)))     
+;;                 (symbol-listp (strip-cars require)))
 ;;            (er hard 'defaggregate ":require must be a list of (name requirement) tuples.~%"))
 ;;        (or (no-duplicatesp (strip-cars require))
 ;;            (er hard 'defaggregate "The names given to :require must be unique.~%"))
diff -Nru acl2-6.2/books/centaur/gl/defapply.lisp acl2-6.3/books/centaur/gl/defapply.lisp
--- acl2-6.2/books/centaur/gl/defapply.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/defapply.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,14 +1,29 @@
-
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "clause-processors/generalize" :dir :system)
 (include-book "tools/defevaluator-fast" :dir :system)
 (include-book "tools/mv-nth" :dir :system)
 (include-book "tools/rulesets" :dir :system)
 (include-book "gl-util")
-
 (include-book "misc/hons-help2" :dir :system)
 
 (defun defeval-fns-to-calls (fns world)
@@ -55,7 +70,7 @@
       nil
     (cons `(nth ,start ,sym)
           (make-list-of-nths sym (1+ start) (1- n)))))
-  
+
 (defmacro ecc (call)
   (declare (xargs :guard (consp call)))
   (if (member-eq (car call) acl2::*ec-call-bad-ops*)
@@ -117,7 +132,7 @@
 ;;                                 ;; (:executable-counterpart-theory :here)
 ;;                                 (equal) (len) (nth) (binary-+) (not)
 ;;                                 (zp)
-;;                                 (:definition ,name) 
+;;                                 (:definition ,name)
 ;;                                 len-open-for-defapply
 ;;                                 nth-open-for-defapply))
 ;;                         :do-not '(preprocess))
@@ -126,8 +141,8 @@
 ;;                             ;; normalize to a constant.
 ;;                             '(:expand ((:free ,formals (,fn . ,formals)))))))
 ;;             (apply-rw-thms (cdr clique) name world)))))
-            
-                 
+
+
 
 
 ;; (defun make-apply-rewrites (name fns world)
@@ -193,7 +208,7 @@
                                  ;; (zp) (unary--) (binary-+)
                                  (:rules-of-class :type-prescription :here)))))
        (defeval-wrap ,ev ,ev-lst ,fns)
-       
+
        (defund ,name (f args)
          (declare (xargs :guard t
                          :normalize nil))
@@ -295,8 +310,8 @@
                          (x (cadr x))))
            :in-theory (disable cadr-kwote-lst-count-cdrs-correct-nth)))
   :rule-classes ((:meta :trigger-fns (car))))
-           
-            
+
+
 
 
 ;; (defapply myapp (BINARY-*
diff -Nru acl2-6.2/books/centaur/gl/doc.lisp acl2-6.3/books/centaur/gl/doc.lisp
--- acl2-6.2/books/centaur/gl/doc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/doc.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,1530 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; doc.lisp
+;
+; Original authors: Sol Swords <sswords@centtech.com>
+;                   Jared Davis <jared@centtech.com>
+
+(in-package "GL")
+(include-book "xdoc/top" :dir :system)
+
+
+(defxdoc gl
+  :parents (acl2::proof-automation acl2::hardware-verification)
+  :short "A symbolic simulation framework for proving finitely bounded ACL2
+theorems by bit-blasting with a <a
+href='http://en.wikipedia.org/wiki/Binary_decision_diagram'>Binary Decision
+Diagram</a> (BDD) package or a <a
+href='http://en.wikipedia.org/wiki/Boolean_satisfiability_problem'>SAT
+solver</a>."
+
+  :long "<h3>Overview</h3>
+
+<p>GL is a convenient and efficient tool for solving many finite ACL2 theorems
+that arise in @(see acl2::hardware-verification) and other contexts.  It plays
+an important role in the verification of arithmetic units and microcode
+routines at <a href='http://www.centtech.com/'>Centaur Technology</a>.</p>
+
+<p>GL <b>requires ACL2(h)</b> because it makes extensive use of @(see
+acl2::hons-and-memoization).  Some optional parts of GL also require <see
+topic='@(url defttag)'>trust tags</see>.</p>
+
+<p>GL translates ACL2 problems into Boolean problems that can be solved by
+automatic @(see acl2::boolean-reasoning) tools.  When this approach can be
+used, there are some good reasons to prefer it over @(see acl2::the-method) of
+traditional, interactive theorem proving.  For instance, it can:</p>
+
+<ul>
+
+<li>Reduce the level of human understanding needed in the initial process of
+developing the proof;</li>
+
+<li>Provide clear counterexamples, whereas failed ACL2 proofs can often be
+difficult to debug; and</li>
+
+<li>Ease the maintenance of the proof, since after the design changes they can
+often find updated proofs without help.</li>
+
+</ul>
+
+<p>How does this translation work?  You can probably imagine writing a
+bit-based encoding of ACL2 objects.  For instance, you might represent an
+integer with some structure that contains a 2's-complement list of bits.  GL
+uses an encoding like this, except that Boolean expressions take the place of
+the bits.  We call these structures @(see symbolic-objects).</p>
+
+<p>GL provides a way to effectively compute with symbolic objects; e.g., it can
+\"add\" two integers whose bits are expressions, producing a new symbolic
+object that represents their sum.  GL can perform similar computations for most
+ACL2 primitives.  Building on this capability, it can <b>symbolically
+execute</b> terms. The result of a symbolic execution is a new symbolic object
+that captures all the possible values the result could take.</p>
+
+<p>Symbolic execution can be used as a <b>proof procedure</b>.  To prove a
+theorem, we first symbolically execute its goal formula, then show the
+resulting symbolic object cannot represent @('nil').  GL provides a @(see
+def-gl-thm) command that makes it easy to prove theorems with this approach.
+It handles all the details of working with symbolic objects, and only needs to
+be told how to represent the variables in the formula.</p>
+
+<h3>GL Documentation</h3>
+
+<box><p><b>New users</b> should begin with the @(see basic-tutorial), which walks
+through the basic ideas behind how GL works, and includes some examples that
+cover how to use GL.</p></box>
+
+<p>Once you start to use GL, you will likely be interested in the @(see
+reference) section of this documentation.</p>
+
+<p>Like any automatic procedure, GL has a certain capacity.  But when these
+limits are reached, you may be able to work around the problem in various ways.
+The @(see optimization) section explains various ways to improve GL's
+performance.</p>
+
+<p>Occasionally GL proofs will fail due to resource limitations or limitations
+of its symbolic evaluation strategy.  When you run into problems, you may be
+interested in some tools and techniques for @(see debugging) failed proofs.</p>
+
+<p>If you want to go further with GL, you will probably want to explore @(see
+other-resources) beyond just this documentation, which include Sol Swords'
+Ph.D. dissertation, as well as many other academic papers and talks.</p>
+
+
+<h3>Copyright Information</h3>
+
+<p>GL &mdash; A Symbolic Simulation Framework for ACL2<br/>
+Copyright (C) 2008-2013 <a href=\"http://www.centtech.com\">Centaur
+Technology</a>.</p>
+
+<p>Contact:</p>
+@({
+Centaur Technology Formal Verification Group
+7600-C N. Capital of Texas Highway, Suite 300
+Austin, TX 78731, USA.
+})
+
+<p>This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2 of the License, or (at your option) any
+later version.</p>
+
+<p>This program is distributed in the hope that it will be useful but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+details.</p>
+
+<p>You should have received a copy of the GNU General Public License along with
+this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
+Street, Suite 500, Boston, MA 02110-1335, USA.</p>")
+
+
+(defxdoc reference
+  :parents (gl)
+  :short "Reference documentation for using GL.")
+
+
+(defxdoc other-resources
+  :parents (gl)
+  :short "Additional resources (talks, academic papers, a dissertation) for
+learning about GL."
+
+  :long "<p>Besides this @(see xdoc::xdoc) documentation, most GL users will
+probably want to be aware of at least the following resources:</p>
+
+<dl>
+
+<dt>Sol Swords and Jared Davis.  <a
+href='http://dx.doi.org/10.4204/EPTCS.70.7'>Bit-Blasting ACL2 Theorems</a>.
+In ACL2 Workshop 2011.  November, 2011.  EPTCS 70.  Pages 84-102.</dt>
+
+<dd>This is an approachable, user-focused introduction to GL as of 2011, which
+also contains many pointers to related work.  It's probably a good idea to read
+this first, noting that a few details have changed.  Much of this paper has now
+been incorporated into this @(see xdoc::xdoc) documentation.</dd>
+
+<dt>Sol Swords.  <a
+href='http://repositories.lib.utexas.edu/handle/2152/ETD-UT-2010-12-2210'>A
+Verified Framework for Symbolic Execution in the ACL2 Theorem Prover</a>.
+Ph.D. thesis, University of Texas at Austin.  December, 2010.</dt>
+
+<dd>This is the most comprehensive guide to GL's internals.  It covers tricky
+topics like the handling of <i>if</i> statements and the details of BDD
+parametrization.  It also covers the logical foundations of GL, such as
+correctness claims for symbolic counterparts, the introduction of symbolic
+interpreters, and the definition and verification of the GL clause processor.
+Some topics are now somewhat dated, but it is good general background for
+anyone who wants to extend GL.</dd>
+
+<dt>The documentation for @(see acl2::hons-and-memoization).</dt>
+
+<dd>GL makes heavy use of the ACL2(h) extension for hash consing and
+memoization.  GL users will likely want to be aware of the basics of ACL2(h),
+and of commands like @(see hons-summary), @(see hons-wash), and @(see
+acl2::set-max-mem).</dd>
+
+</dl>
+
+
+<h4>Back-end Solvers</h4>
+
+<dl>
+
+<dt>Jared Davis and Sol Swords.  <a
+href='http://dx.doi.org/10.4204/EPTCS.114.8'>Verified AIG Algorithms in
+ACL2.</a> In ACL2 Workshop 2013. May, 2013. EPTCS 114.  Pages 95-110.</dt>
+<dd>This is a more recent paper that's not especially focused on GL, but which
+covers @(see aignet::aignet) and @(see satlink::satlink), which can be used by
+GL in its new @(see gl-satlink-mode).  Many problems that are difficult to
+solve using @(see acl2::ubdds) can be solved using @(see
+satlink::satlink).</dd>
+
+<dt>Sol Swords and Warren A Hunt, Jr.  <a
+href='http://dx.doi.org/10.1007/978-3-642-14052-5_30'>A Mechanically Verified
+AIG to BDD Conversion Algorithm</a>.  In ITP 2010, LNCS 6172, Springer.  Pages
+435-449.</dt>
+<dd>This is an older paper about the details of the @('bddify') algorithm that
+is used as the engine for @(see gl-aig-bddify-mode).</dd>
+
+</dl>
+
+<h4>GL Applications</h4>
+
+<p>GL has been used at <a href='http://www.centtech.com/'>Centaur
+Technology</a> to verify RTL implementations of floating-point addition,
+multiplication, and conversion operations, as well as hundreds of bitwise and
+arithmetic operations on scalar and packed integers.  Some papers describing
+some of this work include:</p>
+
+<ul>
+
+<li>Anna Slobodova, Jared Davis, Sol Swords, and Warren A. Hunt, Jr.  <a
+href='http://dx.doi.org/10.1109/MEMCOD.2011.5970515'>A Flexible Formal
+Verification Framework for Industrial Scale Validation</a>.  In Memocode 2011,
+IEEE.  Pages 89-97.</li>
+
+<li>Warren A. Hunt, Jr., Sol Swords, Jared Davis, and Anna Slobodova.  <i>Use
+of Formal Verification at Centaur Technology</i>.  In David Hardin, editor, <a
+href='http://dl.acm.org/citation.cfm?id=1841184'>Design and Verification of
+Microprocessor Systems for High-Assurance Applications</a>, Pages 65-88.
+Springer, 2010.</li>
+
+</ul>
+
+<h4>History</h4>
+
+<p>GL is the successor of Boyer and Hunt's <b>G</b> system, the best
+description of which may be found in:</p>
+
+<ul>
+<li>Robert S. Boyer and Warren A. Hunt, Jr.  <a
+href='http://dx.doi.org/10.1145/1637837.1637840'>Symbolic Simulation in
+ACL2</a>.  In ACL2 Workshop 2009, ACM, 2009.  Pages 20-24.</li>
+</ul>
+
+<p>The name, GL, its name stands for <i>G in the Logic</i>.  The G system was
+written as a raw Lisp extension of the ACL2 kernel, so using it meant trusting
+this additional code.  In contrast, GL is implemented as ACL2 books and its
+proof procedure is formally verified by ACL2, so the only code we have to trust
+besides ACL2 is the ACL2(h) extension that provides @(see
+acl2::hons-and-memoization).</p>")
+
+
+(defxdoc debugging
+  :parents (gl)
+  :short "Advice and tools for debugging performance problems and failed @(see
+gl) proofs."
+
+:long "<p>A GL proof attempt can end in several ways.  Ideally, GL will either
+quickly prove your conjecture, or disprove it and show you counterexamples to
+help diagnose the problem.  But things will not always end so well.</p>
+
+
+<h4>Capacity Problems</h4>
+
+<dl>
+
+<dt>GL is running out of memory.</dt>
+
+<dd>Symptoms: your ACL2 process is using too much memory and your machine is
+<i>swapping</i>, or you are seeing <i>frequent garbage collection</i> messages
+that seem unsuccessful&mdash;that is, few bytes are freed by each GC.</dd>
+
+<dd>There are @(see memory-management) tools that may help to avoid these
+problems.  You may need to look into @(see optimization) techniques.</dd>
+
+<dt>GL has enough memory, but is running forever.</dt>
+
+<dd>You may be running into a bad case for GL's symbolic execution strategy, or
+your problem may be too hard for the back-end solver (BDDs, SAT).  See @(see
+performance-problems) for some tools and advice for dealing with these
+situations.</dd>
+
+</dl>
+
+
+<h4>Other Problems</h4>
+
+<dl>
+
+<dt>GL is failing to prove coverage.</dt>
+
+<dd>Symptoms: You are seeing <i>failed ACL2 proof goals</i> after GL says
+it is proving coverage.</dd>
+
+<dd>It might be that your :g-bindings aren't sufficient to cover your theorem's
+hypotheses, or GL's strategy for proving coverage is misbehaving.  See @(see
+coverage-problems) for advice on debugging this situation.</dd>
+
+<dt>GL produces false counterexamples.</dt>
+
+<dd>This is easy to identify because GL will print @('False counterexample!')
+and direct you to @(see false-counterexamples).</dd>
+
+</dl>")
+
+
+(defxdoc performance-problems
+  :parents (debugging)
+  :long "
+
+<p>Any bit-blasting tool has capacity limitations.  However, you may also run into
+cases where GL is performing poorly due to preventable issues.  When GL seems
+to be running forever, it can be helpful to trace the symbolic interpreter to
+see which functions are causing the problem.  To trace the symbolic
+interpreter, run</p>
+
+@({
+     (gl::trace-gl-interp :show-values t)
+})
+
+<p>Here, at each call of the symbolic interpreter, the term being interpreted
+and the variable bindings are shown, but since symbolic objects may be too
+large to print, any bindings that are not concrete are hidden.  You can also
+get a trace with no variable bindings using @(':show-values nil').  It may also
+be helpful to simply interrupt the computation and look at the Lisp backtrace,
+after executing</p>
+
+@({
+     (set-debugger-enable t)
+})
+
+<p>In many cases, performance problems are due to BDDs growing too large.  This
+is likely the case if the interpreter appears to get stuck (not printing any
+more trace output) and the backtrace contains a lot of functions with names
+beginning in @('q-'), which is the convention for BDD operators.  In some
+cases, these performance problems may be solved by choosing a more efficient
+BDD order.  But note that certain operations like multiplication are
+exponentially hard.  If you run into these limits, you may need to refactor or
+decompose your problem into simpler sub-problems, e.g., with @(see
+def-gl-param-thm).</p>
+
+<p>There is one kind of BDD performance problem with a special solution.
+Suppose GL is asked to prove @('(equal spec impl)') when this does not actually
+hold.  Sometimes the symbolic objects for @('spec') and @('impl') can be
+created, but the BDD representing their equality is too large to fit in memory.
+The goal may then be restated with @(see always-equal) instead of @('equal') as
+the final comparison.  Logically, @('always-equal') is just @('equal').  But
+@('always-equal') has a custom symbolic counterpart that returns @('t') when
+its arguments are equivalent, or else produces a symbolic object that captures
+just one counterexample and is indeterminate in all other cases.</p>
+
+<p>Another possible problem is that the symbolic interpreter never gets stuck,
+but keeps opening up more and more functions.  These problems might be due to
+@(see redundant-recursion), which may be avoided by providing a more efficient
+@(see preferred-definitions).</p>")
+
+
+(defxdoc false-counterexamples
+  :parents (debugging)
+  :long "
+
+<p>Occasionally, GL will abort a proof after printing:</p>
+
+@({
+    False counterexample!  See :xdoc gl::false-counterexamples.
+})
+
+<p>Most of the time, you might think of GL as an \"exact\" system where we have
+an explicit Boolean function representation of every bit in all the objects in
+your conjecture.  Ideally, this should allow GL to either prove your theorem or
+find a counterexample.</p>
+
+<p>This isn't always the case. Sometimes GL represents objects more abstractly.
+For example, GL tends not to support operations on non-integer rational
+numbers.  If it runs into a call of @('(* 1/3 x)'), it may represent the result
+abstractly, as a term-like symbolic object:</p>
+
+@({
+    (:g-apply binary-*  1/3  (:g-number ...))
+})
+
+<p>(assuming @('x') is represented as a @(':g-number') object).  This sort of
+abstraction can help to avoid creating potentially very-expensive symbolic
+objects, and is an important part of GL's @(see term-level-reasoning).</p>
+
+<p>This kind of abstraction can be contagious.  For example, if we are trying
+to prove @('(not (equal (* 1/3 x) 'not-a-number))'), then using the
+@(':g-apply') representation for the @('*') subterm will likely cause GL to
+also use a @(':g-apply') representation for the whole term.  But now, how is GL
+supposed to give this to a SAT solver?</p>
+
+<p>When GL finds a @(':g-apply') object in a Boolean context, such as an IF
+test or a theorem's hypothesis or conclusion, it will create a fresh Boolean
+variable to represent that term.  But if, say, that term is something like</p>
+
+@({
+     (:g-apply equal (:g-apply binary-* 1/3 ...)
+                     not-a-number)
+})
+
+<p>which is always false, then this Boolean variable is too general, and by
+replacing the term with the Boolean variable, GL has lost track of the fact
+that the term is actually always false.  This generally leads to false
+counterexamples.</p>
+
+<h3>Dealing with False Counterexamples</h3>
+
+
+<p>The first things to check for when you encounter a false counterexample:</p>
+
+<ul>
+
+<li>Missing @(':g-bindings'): When a variable is omitted from the
+@(':g-bindings') form, a warning is printed and the missing variable is
+assigned a @(':g-var') object.  A @(':g-var') can represent any ACL2 object,
+without restriction.  Symbolic counterparts typically produce @(':g-apply')
+objects when called on @(':g-var') arguments, and this can easily lead to false
+counterexamples.</li>
+
+<li>The stack depth limit, or \"clock\", was exhausted.  This may happen when
+symbolically executing a recursive function if the termination condition can't
+be detected, though this is often caused by previous introduction of an
+unexpected G-APPLY object.</li>
+
+<li>An unsupported primitive was called.  For example, as of August 2013 we do
+not yet support UNARY-/, so any call of UNARY-/ encountered during symbolic
+execution will return a G-APPLY of UNARY-/ to the input argument.  It may be
+that you can avoid calling such functions by installing an <see topic='@(url
+alternate-definitions)'>alternate definition</see>.</li>
+
+<li>A primitive was called on an unsupported type of symbolic object.  For
+example, the symbolic counterparts for most arithmetic primitives will produce
+a G-APPLY object if an input seems like it might represent a non-integer
+rational.  Since symbolic operations on rationals are absurdly expensive, we
+simply don't implement them for the most part.</li>
+
+</ul>
+
+<p>It is common to use GL in such a way that G-VAR forms are not used, and
+G-APPLY forms are unwelcome if they appear at all; when they do, they typically
+result in a symbolic execution failure of some sort.  However, there are ways
+of using GL in which G-VAR and G-APPLY forms are expected to exist; see @(see
+term-level-reasoning).  If you are not expecting GL to create G-APPLY objects
+but you are encountering false counterexamples, we suggest using the following
+form to determine why a G-APPLY object is first being created:</p>
+
+@({
+ (gl::break-on-g-apply)
+})
+
+<p>Then when GL::G-APPLY is called in order to create the form, @('(BREAK$)')
+will be called.  Usually this will allow you to look at the backtrace and
+determine in what context the first G-APPLY object is being created.</p>
+
+<p>Alternatively, if you are expecting some G-APPLY forms to be created but
+unexpected ones are cropping up, you can make the break conditional
+on the function symbol being applied:</p>
+
+@({
+ (gl::break-on-g-apply :allowed-fns (foo bar))
+})")
+
+
+
+
+(defxdoc memory-management
+  :parents (optimization debugging)
+  :long "
+
+<p>Memory management can play a significant role in symbolic execution
+performance.  In some cases GL may use too much memory, leading to swapping and
+slow performance.  In other cases, garbage collection may run too frequently or
+may not reclaim much space.  We have several recommendations for managing
+memory in large-scale GL proofs.  Some of these suggestions are specific to
+Clozure Common Lisp.</p>
+
+
+<h4>Use set-max-mem</h4>
+
+<p>You can load the @('centaur/misc/memory-mgmt') book and use the @(see
+set-max-mem) command to indicate how large you would like the Lisp heap to be.
+For instance,</p>
+
+@({
+     (set-max-mem (* 8 (expt 2 30)))
+})
+
+<p>says to allocate 8 GB of memory.  To avoid swapping, you should use somewhat
+less than your available physical memory.  This book disables ephemeral garbage
+collection and configures the garbage collector to run only when the threshold
+set above is exceeded, which can boost performance.</p>
+
+
+<h4>Optimize hash-consing performance.</h4>
+
+<p>GL's representations of BDDs and AIGs use @(see hons) for structure-sharing.
+The @(see hons-summary) command can be used at any time to see how many honses
+are currently in use, and hash-consing performance can be improved by
+pre-allocating space for these honses with @(see hons-resize).</p>
+
+
+<h4>Manage hash-consing and memoization overhead.</h4>
+
+<p>Symbolic execution can use a lot of hash conses and can populate the
+memoization tables for various functions.  The memory used for these purposes
+is <b>not</b> automatically freed during garbage collection, so it may
+sometimes be necessary to manually reclaim it.</p>
+
+<p>A useful function is @('(maybe-wash-memory n)'), which frees this memory and
+triggers a garbage collection only when the amount of free memory is below some
+threshold @('n').  A good choice for @('n') might be 20\% of the @(see
+set-max-mem) threshold.</p>
+
+<p>It can be useful to call @(see maybe-wash-memory) between proofs, or between
+the cases of parametrized theorems; see for instance the @(':run-before-cases')
+argument of @(see def-gl-param-thm).</p>")
+
+
+
+(defxdoc symbolic-objects
+  :parents (reference)
+  :short "Format of symbolic objects in @(see gl)."
+
+  :long "<p>Symbolic objects represent functions from the set of
+environments (described below) to the set of ACL2 objects.  The value of an
+object at an environment is given by an evaluator function.  Symbolic objects
+are recursively structured and have a number of constructors.  We first briefly
+describe evaluators (and why there can be more than one), then the structure of
+environment objects, and then the symbolic object constructors.</p>
+
+
+<h4>Evaluators</h4>
+
+<p>A symbolic object evaluator is a function with the interface</p>
+
+@({
+ (EV symbolic-object environment) => value.
+})
+
+<p>There may be several evaluators defined.  The differences between evaluators
+have to do with the G-APPLY symbolic object type, which represents a function
+applied to symbolic arguments.  In order to evaluate such an object, the
+evaluator must be defined such that it recognizes the particular function
+symbol used in the G-APPLY object.  An evaluator may not evaluate a symbolic
+object containing a G-APPLY construct with an unrecognized function symbol.
+One evaluator, named EVAL-G-BASE, is initially defined in the GL library, and
+recognizes function symbols of the predefined primitives included with the
+library.</p>
+
+<h4>Environments</h4>
+
+<p>The basic components of symbolic objects are data structures containing
+Boolean functions, represented either by BDDs or AIGs (see @(see modes)), and G-VAR
+constructs, which represent unconstrained variables.  To evaluate a symbolic
+object, each of these needs to be evaluated to a constant.  An environment
+contains the information necessary to evaluate either kind of expression:</p>
+<ul>
+<li>a truth assignment for the Boolean variables used in the Boolean function
+representation; in AIG mode, this is an alist mapping variable names to
+Booleans, and in BDD mode, an ordered list of Booleans corresponding to the
+decision levels of the BDDs.</li>
+<li>an alist mapping unconstrained variable names to their values.</li>
+</ul>
+
+<h4>Symbolic Object Representation</h4>
+
+<p>There are eight basic constructions of symbolic objects, some of which may
+recursively contain other symbolic objects.  We now describe each such
+construction and its evaluation.</p>
+
+<dl>
+
+<dt>Representation: (:G-BOOLEAN . bfr)</dt>
+<dt>Constructor: (G-BOOLEAN bfr)</dt>
+
+<dd>Takes the values T and NIL.  The evaluation of a G-BOOLEAN object is simply
+the evaluation of @('<bdd>') using the list of Booleans in the
+environment.</dd>
+
+<dt>Representation: (:G-NUMBER . list-of-lists-of-bdds)</dt>
+<dt>Constructor: (G-NUMBER list-of-lists-of-bdds)</dt>
+
+<dd>Evaluates to a (complex rational) number.  @('<list-of-lists-of-bdds>')
+should be a list containing four or fewer lists of UBDDs, which represent (in
+order):
+
+<ul>
+<li>the numerator of the real part  (two's-complement, default 0)</li>
+<li>the denominator of the real part (unsigned, default 1)</li>
+<li>the numerator of the imaginary part (two's-complement, default 0)</li>
+<li>the denominator of the imaginary part (unsigned, default 1).</li>
+</ul>
+
+It is most common to represent an integer, for which only the first list need
+be included.  In both the two's-complement and unsigned representations, the
+bits are ordered from least to most significant, with the last bit in the two's
+complement representation giving the sign.  Two's complement lists may be
+sign-extended by repeating the final bit, and unsigned lists may be
+zero-extended by appending NILs after the final bit.</dd>
+
+<dt>Representation (:G-CONCRETE . object)</dt>
+<dt>Constructor: (G-CONCRETE object)</dt>
+
+<dd>Evaluates to @('<object>').  While most ACL2 objects evaluate to themselves
+anyway, this construct is useful for representing symbolic objects or objects
+structured similarly to symbolic objects.  For example, @({
+ (:G-CONCRETE . (:G-BOOLEAN . (T . NIL))) evaluates to
+ (:G-BOOLEAN . (T . NIL)), whereas
+ (:G-BOOLEAN . (T . NIL)) evaluates to either T or NIL.
+})</dd>
+
+<dt>Representation: (:G-VAR . name)</dt>
+<dt>Constructor: (G-VAR . name)</dt>
+
+<dd>@('<name>') may be any object.  Evaluates to the object bound to
+@('<name>') in the environment.</dd>
+
+<dt>Representation: (:G-ITE test then . else)</dt>
+<dt>Constructor: (G-ITE test then else)</dt>
+
+<dd>Each of @('<test>'), @('<then>'), and @('<else>') must be symbolic objects.
+If @('<test>') evaluates to a nonnil value, then this object evaluates to the
+evaluation of @('<then>'); otherwise this evaluates to the evaluation of
+@('<else>').</dd>
+
+<dt>Representation: (:G-APPLY fn . arglist)</dt>
+<dt>Constructor: (G-APPLY fnsym arglist)</dt>
+
+<dd>@('<fn>') should be a symbol and @('<arglist>') should be a symbolic
+object.  If the evaluator recognizes @('<fn>') and @('<arglist>') evaluates to
+@('<args>'), a true-list of length equal to the arity of the function
+@('<fn>'), then this object evaluates to the application of @('<fn>') to
+@('<args>').  Otherwise, the evaluation is undefined.</dd>
+
+<dt>Representation: atom</dt>
+
+<dd>Every atom evaluates to itself.  However, the keyword symbols
+:G-BOOLEAN, :G-NUMBER, :G-CONCRETE, :G-VAR, :G-ITE, and :G-APPLY are not
+themselves well-formed symbolic objects.</dd>
+
+<dt>Representation: @('(car . cdr)')</dt>
+
+<dd>A cons of two symbolic objects evaluates to the cons of their evaluations.
+Note that since the keyword symbols that distinguish symbolic object
+constructions are not themselves well-formed symbolic objects, this
+construction is unambiguous.</dd>
+
+</dl>
+
+<h4>Miscellaneous notes about symbolic objects and evaluation</h4>
+
+<ul>
+
+<li>Any function from finitely many Boolean values to the universe of
+ACL2 objects can be expressed using only the G-ITE, G-BOOLEAN, and
+G-CONCRETE forms.</li>
+
+<li>Most ACL2 objects are themselves well-formed symbolic objects which
+evaluate to themselves.  The exceptions are ones which contain the special
+keyword symbolis :G-BOOLEAN, :G-NUMBER, :G-CONCRETE, :G-VAR,
+:G-ITE, and :G-APPLY.  These atoms (and out of all atoms, only these)
+are not well-formed symbolic objects.  Since a cons of any two
+well-formed symbolic objects is itself a well-formed symbolic objects,
+only objects containing these atoms may be non-well-formed.</li>
+
+<li>The function that checks well-formedness of symbolic objects is GOBJECTP,
+and the initial evaluator function is GL::EVAL-G-BASE.  It may be useful to
+read the definitions of these functions for reference in case the above
+symbolic object documentation is unclear.</li>
+
+</ul>")
+
+
+
+
+
+(defxdoc alternate-definitions
+  :parents (optimization)
+  :short "Specifying alternative definitions to be used for symbolic
+  execution."
+
+  :long "<p>Sometimes the definition of some function is ill-suited for
+automatic methods of symbolic execution.  For example, @('(EVENP X)') is defined
+as</p>
+
+@({
+ (integerp (* x (/ 2)))
+})
+
+<p>and because currently multiplication by a non-integer is not supported in
+GL, this yields a G-APPLY form in most cases.</p>
+
+<p>In this case and several others, one may instead provide an alternate
+definition for the function in question and use that as the basis for GL
+symbolic execution.</p>
+
+<p>In the case of EVENP, the following theorem works as an alternate
+definition:</p>
+
+@({
+ (defthm evenp-is-logbitp
+   (equal (evenp x)
+          (or (not (acl2-numberp x))
+              (and (integerp x)
+                   (equal (logbitp 0 x) nil))))
+   :rule-classes nil)
+})
+
+<p>After proving this theorem, the following form sets this alternate
+definition as the one GL will use when symbolically interpreting EVENP:</p>
+
+@({
+ (gl::set-preferred-def evenp evenp-is-logbitp)
+})
+
+<p>This form produces one or more @(see table) events.</p>")
+
+
+(defxdoc coverage-problems
+  :parents (debugging)
+  :short "Proving the coverage obligation in GL-based proofs."
+
+  :long "<p>In order to prove a theorem using GL, one must show that the
+symbolic objects chosen to represent the inputs are sufficiently general to
+cover the entire set of interest.  See @(see SHAPE-SPECS) for a more in-depth
+discussion.  The @(see DEF-GL-THM) and @(see DEF-GL-PARAM-THM) events as well
+as the @(see GL-HINT) hints all provide some degree of automation for coverage
+proofs; often this is enough to satisfy the coverage obligation without further
+user interaction.  Here we discuss how to debug coverage proofs that do not
+succeed.</p>
+
+<p>First, it is probably important to be able to re-run a coverage proof easily
+without also re-running the associated symbolic execution, which may be quite
+time-consuming.  To do this, in either the @(see DEF-GL-THM) or @(see
+DEF-GL-PARAM-THM) forms, add the keyword argument @(':TEST-SIDE-GOALS T').
+This form will then try to prove the coverage obligation in exactly the manner
+it would do during the real proof, but it will not attempt to prove the theorem
+itself, and will not record a new ACL2 theorem even if the proof is
+successful.</p>
+
+<p>During proof output, GL prints a message \"Now proving coverage\" when it
+begins the coverage proof.  The initial goal of a coverage proof will also have
+a hypothesis @('(GL::GL-CP-HINT 'GL::COVERAGE)'); this hypothesis is logically
+meaningless, but a useful indicator of the beginning of a coverage proof.</p>
+
+<p>When GL's usual set of heuristics is used, a coverage proof proceeds as
+follows.  The initial goal is as follows:</p>
+
+@({
+ (implies <theorem-hyps>
+          (gl::shape-spec-obj-in-range
+            <list-of-input-bindings>
+            <list-of-input-variables>))
+})
+
+<p>The coverage heuristics proceed by repeatedly opening up the
+@('GL::SHAPE-SPEC-OBJ-IN-RANGE') function.  This effectively splits the proof
+into cases for each component of each variable; for example, if one variable's
+shape specifier binding is a cons of two :G-NUMBER forms, then its CAR and CDR
+will be considered separately.  Eventually, this results in several subgoals,
+each with conjunction of requirements for some component of some input.</p>
+
+<p>During this process of opening the @('GL::SHAPE-SPEC-OBJ-IN-RANGE')
+conclusion, the coverage heuristics also examine and manipulate the hypotheses.
+When the conclusion is focused on a certain input variable or component of that
+variable, and some hypothesis does not mention that variable, that hypothesis
+will be dropped so as to speed up the proof.  If a hypothesis does mention that
+variable, it may be expanded (if it is not a primitive) so as to try and gain
+more information about that variable.  This is a useful heuristic because often
+the hypotheses consist of a conjunction of predicates about different input
+variables or components of input variables, and some of these predicates are
+often themselves defined as conjunctions of predicates about subcomponents.</p>
+
+<p>However, sometimes this expansion goes too far.  In many cases, some
+conjuncts from the hypothesis have nothing to do with the coverage obligation.
+In these cases, the @(':DO-NOT-EXPAND') keyword argument to @('DEF-GL-THM') and
+@('DEF-GL-PARAM-THM') may be used.  This argument should evaluate to a list of
+function symbols; the coverage heuristic is then prohibited from expanding any
+of these functions.</p>
+
+<p>For efficiency, the set of rules used in coverage proofs is very restricted.
+Because of this, you may see in the proof output a goal which should be
+obvious, but is not proven because the necessary rule is not included.  The
+keyword argument @(':COV-THEORY-ADD') may be used to enable certain additional
+rules that are not included.  The set of rules that are used is defined in the
+ruleset @('GL::SHAPE-SPEC-OBJ-IN-RANGE-OPEN'), which can be listed using</p>
+
+@({
+ (get-ruleset 'gl::shape-spec-obj-in-range-open (w state)).
+})
+
+<p>The default heuristics for coverage proofs may not always be useful.
+Therefore, the user may also supplement or replace the coverage heuristics with
+arbitrary computed hints.  The keyword argument @(':COV-HINTS') gives a list of
+computed hint forms which, according to the value of the keyword argument
+@(':COV-HINTS-POSITION'), either replaces or supplements the default hints.
+@(':COV-HINTS-POSITION') may be either @(':REPLACE'), in which case the
+defaults are not used at all; @(':FIRST'), in which case the user-provided
+@(':COV-HINTS') are tried first and the defaults afterward, or the default,
+@(':LAST'), in which case the default coverage heuristic is tried before the
+user-provided hints.</p>
+
+<p>Note that subgoal names will be different between a @(':TEST-SIDE-GOALS')
+and an actual attempt at proving the theorem.  Therefore, it is best not to
+write computed hints that depend on the @('ID') variable.</p>")
+
+
+
+
+
+(defxdoc optimization
+  :parents (gl)
+  :short "How to optimize GL's symbolic simulations for faster or
+larger-scale proofs."
+
+  :long "
+
+<ul>
+
+<li>Using different @(see modes) to solve the problem.  Some modes vastly
+outperform others on particular problems and it is very easy to switch modes,
+so this is often a good first thing to try when you run into a performance
+problem.</li>
+
+<li>Decomposing difficult problems into easier subgoals.  GL provides some
+support for @(see case-splitting) hard proofs, and in some cases this kind of
+decomposition can tremendously boost performance.</li>
+
+<li>Using other @(see optimization) techniques to make GL's symbolic execution
+strategy more efficient.</li>
+
+</ul>
+
+
+<p>The scope of theorems GL can handle is directly impacted by its symbolic
+execution performance.  It is actually quite easy to customize the way certain
+terms are interpreted, and this can sometimes provide important speedups.</p>
+
+<p>GL's symbolic interpreter operates much like a basic Lisp interpreter.  To
+symbolically interpret a function call, GL first eagerly interprets its
+arguments to obtain symbolic objects for the actuals.  Then GL symbolically
+executes the function in one of three ways:</p>
+
+<ul>
+
+<li>As a special case, if the actuals evaluate to concrete objects, then GL may
+be able to stop symbolically executing and just call the actual ACL2 function
+on these arguments; see @(see concrete-execution).</li>
+
+<li>For primitive ACL2 functions like @(see +), @(see consp), @(see equal), and
+for some defined functions like @(see logand) and @(see ash) where performance
+is important, GL uses hand-written functions called <b>symbolic
+counterparts</b> that can operate on symbolic objects.  The advanced GL user
+can write new @(see custom-symbolic-counterparts) to speed up symbolic
+execution.</li>
+
+<li>Otherwise, GL looks up the definition of the function, and recursively
+interprets its body in a new environment binding the formals to the symbolic
+actuals.  The way a function is written can impact its symbolic execution
+performance; see @(see redundant-recursion).  It is easy to instruct GL to use
+more efficient, @(see preferred-definitions) for particular functions.</li>
+
+</ul>
+
+<p>GL symbolically executes functions strictly according to the ACL2 logic and
+does not consider guards.  An important consequence is that when @(see mbe) is
+used, GL's interpreter follows the @(':logic') definition instead of the
+@(':exec') definition, since it might be unsound to use the @(':exec') version
+of a definition without establishing the guard is met.  Also, while GL can
+symbolically simulate functions that take user-defined stobjs or even the ACL2
+@(see state), it does not operate on \"real\" @(see acl2::stobj)s; instead, it
+uses the logical definitions of the relevant stobj operations, which do not
+provide the performance benefits of destructive operations.  Non-executable
+functions cannot be symbolically executed.</p>")
+
+
+(defxdoc modes
+  :parents (optimization)
+  :short "GL modes allow you to control major aspects of how GL carries out its
+symbolic simulation and how it should solve Boolean formulas that arise during
+proofs."
+
+  :long "<p>For some general background, see section
+@(see |4. Proving Theorems by Symbolic Execution|) of the @(see basic-tutorial).</p>
+
+<p>By default, GL operates in @(see gl-bdd-mode).  In this mode, the Boolean
+formulas within @(see symbolic-objects) are represented using @(see ubdds), and
+questions about these formulas are resolved using BDD operations.</p>
+
+<p>But GL also supports other modes, and you can easily switch between modes on
+a proof-by-proof basis.  Typically this looks like:</p>
+
+@({
+   (local (gl::gl-bdd-mode))
+   (def-gl-thm foo ...)
+
+   (local (gl::gl-satlink-mode))
+   (def-gl-thm bar ...)
+})
+
+<p>GL's other modes use And-Inverter Graphs (@(see aig)s) as the Boolean
+function representation.  Unlike BDDs, AIGs are non-canonical, and this affects
+performance in fundamental ways: AIGs are generally much cheaper to construct
+than BDDs, but it can be hard to determine whether AIGs are equivalent, whereas
+with BDDs this is just a pointer-equality check.</p>
+
+<p>A very convenient feature of AIGs is that you do not have to come up with a
+good variable ordering&mdash;this may be especially helpful on problems where
+@(see case-splitting) would be necessary because there's not a universally good
+BDD ordering.  On the other hand, BDDs can provide especially nice
+counterexamples, whereas with AIGs we typically get just one, essentially
+random counterexample.</p>
+
+<p>Performance-wise, AIGs are better for some problems and BDDs for others.
+Many operations combine bits from data buses in a regular, orderly way; in
+these cases, there is often a good BDD ordering and BDDs may be faster than our
+AIG modes.  But when the operations are less regular, when no good BDD ordering
+is apparent, or when case-splitting seems necessary to get good BDD
+performance, the AIG modes may do better.  For many of our proofs, AIG mode
+performs well and saves us the trouble of finding a good BDD ordering.</p>
+
+<h4>Solving AIGs</h4>
+
+<p>When AIGs are used to carry out GL proofs, we need some way to answer
+whether the final AIG is satisfiable.  To do this, GL can use one of two
+back-end solvers.</p>
+
+<p>Usually the better and higher-performance option is to send the AIG to an
+external SAT solver; see @(see gl-satlink-mode).  In this mode, GL uses the
+@(see satlink) library to call upon an off-the-shelf SAT solver.  Using
+external SAT solvers raises questions of trust, and GL does not yet implement
+any sort of proof-checking for the SAT solver's output.  But pragmatically, for
+most verification efforts, it is probably reasonable to trust a SAT solver.</p>
+
+<p>Another option is to simply convert the AIG into BDDs; see @(see
+gl-aig-bddify-mode).  This isn't necessarily a good idea, and you still have to
+worry about the variable order in this case.  Occasionally this <i>may</i>
+out-perform just using BDDs to begin with, because there are certain
+optimizations you can make when converting from AIGs to BDDs that aren't
+possible when you just use BDDs for everything.  This is also a high-confidence
+mode, where the whole proof is carried out within ACL2, with just some minimal
+trust-tags to boost performance.</p>
+
+")
+
+(defxdoc gl-mode-implementation
+  :parents (modes)
+  :short "Implementation details about switching between GL reasoning modes"
+  :long "
+
+<p>GL's various reasoning modes are implemented using @(see defattach).  There
+are several functions that need to have proper attachments in order for GL to
+function; when the GL library is loaded, they are set up to a default
+configuration in which GL will use BDD-based reasoning.</p>
+
+<p>The functions that need attachments follow.  Here, BFR stands for Boolean
+function representation.</p>
+
+<ul>
+<li><p>BFR-MODE: 0-ary with no constraints.  This detemines whether the Boolean
+function components in the symbolic object representation are BDDs or AIGs, and
+thus the functions used to combine them.  E.g., the definition of BFR-NOT
+is (basically):</p>
+
+@({
+ (if (bfr-mode) (aig-not x) (q-not x)).
+})
+
+<p>Similarly, BFR-EVAL either applies EVAL-BDD or AIG-EVAL, depending on
+BFR-MODE.</p>
+
+<p>By default the function BFR-BDD (which returns NIL) is attached to BFR-MODE,
+and thus BFR-NOT uses the BDD operation Q-NOT.  To use AIGs instead, attach
+BFR-AIG, which returns T.</p></li>
+
+<li><p>BFR-SAT: Unary, returning three values: SAT, SUCCEEDED, CTREX.  The main
+constraint of BFR-SAT is that if it returns SAT=NIL and SUCCEEDED=T, then
+BFR-EVAL of the input on any environment must be NIL, i.e., the input must be
+an unsatisfiable BDD or AIG (depending on the BFR-MODE.)  The CTREX value
+should be a counterexample in the case of a SAT result, represented either as a
+BDD or an alist mapping variables to Boolean values; see below under
+BFR-COUNTEREX-MODE.</p>
+
+<p>To satisfy the constraint in the BDD case, it suffices to simply check whether
+the input BDD is NIL; if so, it is satisfiable, and otherwise, it isn't.  This
+method is implemented as BFR-SAT-BDD, which is the default attachment of
+BFR-SAT.  For AIG mode, we provide an attachment BFR-SAT-BDDIFY which solves an
+AIG satisfiability query by transforming the input AIG into a BDD.  However,
+one might instead hook up a SAT solver into ACL2 so that it can take an AIG as
+input.  Given a way of calling such an external tool, it would not be difficult
+to produce a function that conforms to the constraint described above. :-)</p></li>
+
+<li><p>BFR-COUNTEREX-MODE: 0-ary, no constraints.  This says whether the
+counterexample value sometimes returned by BFR-SAT is in the form of a BDD or
+an association list.  If it is set up wrong, then output in case of a
+counterexample will be garbled.  In both the default BDD mode and in the AIG
+BDDIFY mode provided, the counterexample is in the form of a BDD, and so we
+attach BFR-COUNTEREX-BDD by default.  However, if an external SAT solver is
+used, then there will likely be a single assignment returned, which might more
+conveniently be provided as an alist.  Then one would instead attach
+BFR-COUNTEREX-ALIST.</p></li></ul>")
+
+(defxdoc redundant-recursion
+  :parents (optimization)
+  :long "
+
+<p>Here is a way to write a list-filtering function.</p>
+
+@({
+     (defun filter1 (x)
+       (cond ((atom x)
+              nil)
+             ((element-okp (car x))               ;; keep it
+              (cons (car x) (filter1 (cdr x))))
+             (t                                   ;; skip it
+              (filter1 (cdr x)))))
+})
+
+<p>This definition can be inefficient for symbolic execution.  Suppose we are
+symbolically executing @('filter1'), and the @('element-okp') check has
+produced a symbolic object that can take both @('nil') and non-@('nil') values.
+Then, we proceed by symbolically executing both the keep- and skip-branches,
+and construct a @(':g-ite') form for the result.  Since we have to evaluate the
+recursive call twice, this execution becomes exponential in the length of
+@('x').</p>
+
+<p>We can avoid this blow-up by consolidating the recursive calls, as
+follows.</p>
+
+@({
+    (defun filter2 (x)
+      (if (atom x)
+          nil
+        (let ((rest (filter2 (cdr x))))
+          (if (element-okp (car x))
+              (cons (car x) rest)
+            rest))))
+})
+
+<p>Of course, @('filter1') is probably slightly better for concrete execution
+since it has a tail call in at least some cases.  If we do not want to change
+the definition of @('filter1'), we can simply tell GL to use the @('filter2')
+definition instead, as described in the next section.</p>")
+
+
+(defxdoc preferred-definitions
+  :parents (optimization)
+  :long "<p>To instruct GL to symbolically execute @('filter2') in place of
+@('filter1'), we can do the following:</p>
+
+@({
+    (defthm filter1-for-gl
+      (equal (filter1 x) (filter2 x))
+      :rule-classes nil)
+
+    (gl::set-preferred-def filter1 filter1-for-gl)
+})
+
+<p>The @(see gl::set-preferred-def) form extends a table that GL consults when
+expanding a function's definition.  Each entry in the table pairs a function
+name with the name of a theorem.  The theorem must state that a call of the
+function is unconditionally equal to some other term.</p>
+
+<p>When GL encounters a call of a function in this table, it replaces the call
+with the right-hand side of the theorem, which is justified by the theorem.  So
+after the above event, GL will replace calls of @('filter1') with
+@('filter2').</p>
+
+<p>As another example of a preferred definition, GL automatically optimizes the
+definition of @(see evenp), which ACL2 defines as follows:</p>
+
+@({
+    (evenp x) = (integerp (* x (/ 2)))
+})
+
+<p>This definition is basically unworkable since GL provides little support for
+rational numbers.  However, GL has an efficient, built-in implementation of
+@(see logbitp).  So to permit the efficient execution of @('evenp'), GL proves
+the following identity and uses it as @('evenp')'s preferred definition.</p>
+
+@({
+     (defthm evenp-is-logbitp
+       (equal (evenp x)
+              (or (not (acl2-numberp x))
+                  (and (integerp x)
+                       (equal (logbitp 0 x) nil)))))
+})")
+
+
+(defxdoc custom-symbolic-counterparts
+  :parents (optimization)
+  :long "
+
+<p>The advanced GL user can write custom symbolic counterparts to get better
+performance.</p>
+
+<p>This is somewhat involved.  Generally, such a function operates by cases on
+what kinds of symbolic objects it has been given.  Most of these cases are
+easy; for instance, the symbolic counterpart for @(see consp) just returns
+@('nil') when given a @(':g-boolean') or @(':g-number').  But in other cases
+the operation can require combining the Boolean expressions making up the
+arguments in some way, e.g., the symbolic counterpart for @(see binary-*)
+implements a simple binary multiplier.</p>
+
+<p>Once the counterpart has been defined, it must be proven sound with respect
+to the semantics of ACL2 and the symbolic object format.  This is an ordinary
+ACL2 proof effort that requires some understanding of GL's implementation.</p>
+
+<p>An example of a more sophisticated symbolic counterpart is an @(see aig) to
+<see topic='@(url ubdds)'>ubdd</see> conversion algorithm.  This function
+serves as a symbolic counterpart for AIG evaluation.  This algorithm and its
+correctness proof can be found in the book @('centaur/aig/g-aig-eval').</p>")
+
+
+
+(defxdoc case-splitting
+  :parents (optimization)
+  :long "
+
+<p>BDD performance can sometimes be improved by breaking a problem into
+subcases.  The standard example is floating-point addition, which benefits from
+separating the problem into cases based on the difference between the two
+inputs' exponents.  (See for instance work by <a
+href='http://dx.doi.org/10.1007/BFb0028769'>Chen and Bryant</a> and <a
+href='http://dx.doi.org/10.1145/309847.309968'>Aagard, Jones, and
+Seger</a>.)</p>
+
+<p>For each exponent difference, the two mantissas are aligned differently
+before being added together, so a different BDD order is necessary to
+interleave their bits at the right offset.  Without case splitting, a single
+BDD ordering has to be used for the whole problem; no matter what ordering we
+choose, the mantissas will be poorly interleaved for some exponent differences,
+causing severe performance problems.  Separating the cases allows the
+appropriate order to be used for each difference.</p>
+
+<p>GL provides a @(see def-gl-param-thm) command that supports this technique.
+This command splits the goal formula into several subgoals and attempts to
+prove each of them using the @(see def-gl-thm) approach, so for each subgoal
+there is a symbolic execution step and coverage proof.  To show the subgoals
+suffice to prove the goal formula, it also does another @(see def-gl-thm)-style
+proof that establishes that any inputs satisfying the hypothesis are covered by
+some case.</p>
+
+<p>Here is how we might split the proof for @('fast-logcount-32') into five
+subgoals.  One goal handles the case where the most significant bit is 1.  The
+other four goals assume the most significant bit is 0, and separately handle
+the cases where the lower two bits are 0, 1, 2, or 3.  Each case has a
+different symbolic binding for @('x'), giving the BDD variable order. Of
+course, splitting into cases and varying the BDD ordering is unnecessary for
+this theorem, but it illustrates how the @(see def-gl-param-thm) command
+works.</p>
+
+@({
+    (def-gl-param-thm fast-logcount-32-correct-alt
+      :hyp (unsigned-byte-p 32 x)
+      :concl (equal (fast-logcount-32 x)
+                    (logcount x))
+      :param-bindings
+      `((((msb 1) (low nil)) ((x ,(g-int 32 -1 33))))
+        (((msb 0) (low 0))   ((x ,(g-int  0  1 33))))
+        (((msb 0) (low 1))   ((x ,(g-int  5  1 33))))
+        (((msb 0) (low 2))   ((x ,(g-int  0  2 33))))
+        (((msb 0) (low 3))   ((x ,(g-int  3  1 33)))))
+      :param-hyp (and (equal msb (ash x -31))
+                      (or (equal msb 1)
+                          (equal (logand x 3) low)))
+      :cov-bindings `((x ,(g-int 0 1 33))))
+})
+
+<p>We specify the five subgoals to consider using two new variables, @('msb')
+and @('low').  Here, @('msb') will determine the most significant bit of
+@('x'); @('low') will determine the two least significant bits of @('x'), but
+only when @('msb') is 0.</p>
+
+<p>The @(':param-bindings') argument describes the five subgoals by assigning
+different values to @('msb') and @('low').  It also gives the @('g-bindings')
+to use in each case.  We use different bindings for @('x') for each subgoal to
+show how it is done.</p>
+
+<p>The @(':param-hyp') argument describes the relationship between @('msb'),
+@('low'), and @('x') that will be assumed in each subgoal.  In the symbolic
+execution performed for each subgoal, the @(':param-hyp') is used to reduce the
+space of objects represented by the symbolic binding for @('x').  For example,
+in the subgoal where @('msb = 1'), this process will assign @('t') to
+@('x[31]').  The @(':param-hyp') will also be assumed to hold for the coverage
+proof for each case.</p>
+
+<p>How do we know the case-split is complete?  One final proof is needed to
+show that whenever the hypothesis holds for some @('x'), then at least one of
+the settings of @('msb') and @('low') satisfies the @(':param-hyp') for this
+@('x').  That is:</p>
+
+@({
+    (implies (unsigned-byte-p 32 x)
+             (or (let ((msb 1) (low nil))
+                   (and (equal msb (ash x -31))
+                        (or (equal msb 1)
+                            (equal (logand x 3) low))))
+                 (let ((msb 0) (low 0)) ...)
+                 (let ((msb 0) (low 1)) ...)
+                 (let ((msb 0) (low 2)) ...)
+                 (let ((msb 0) (low 3)) ...)))
+})
+
+<p>This proof is also done in the @(see def-gl-thm) style, so we need we need
+one last set of symbolic bindings, which is provided by the @(':cov-bindings')
+argument.</p>")
+
+
+
+
+(defxdoc term-level-reasoning
+  :parents (gl optimization)
+  :short "GL's term-level proof support"
+  :long
+
+  "<p>The traditional way of using GL to prove a theorem is to give a bit-level
+description of each variable of the theorem as a shape spec in the :g-bindings
+argument of def-gl-thm -- X is a 10-bit integer, Y is a three-entry Boolean
+list, etc.  In this mode of operation, the goal is for every function to be
+able to symbolically execute and produce a purely bit-level symbolic object as
+its output.</p>
+
+<p>This style of reasoning is somewhat restrictive.  ACL2 code is often
+written in a way that makes this sort of symbolic execution expensive.  For
+example, suppose we want a structure that maps integer keys to values.  For
+best execution speed, we might represent this as a stobj array.  For best
+ease of reasoning, we might represent it as a record (as in
+books/misc/records.lisp), since these have nice, intuitive, hypothesis-free
+rules about them.  For symbolic execution performance, on the other hand,
+we might decide that a simple alist is the best representation.  But if we've
+written the code in one of the other styles, then we'd like to be able to
+escape the suboptimal symbolic execution this entails.</p>
+
+<p>We have added features to GL which provide a way around these problems by
+allowing for term-level reasoning as well as bit-level:</p>
+
+
+<ul>
+
+<li>rewrite rules, conditional/unconditional, supporting syntaxp hypotheses</li>
+
+<li>uninterpreted functions</li>
+
+<li>rules for merging IF branches that resolve to term- rather than bit-level
+objects</li>
+
+<li>automatic generation of new Boolean variables for IF tests that resolve to
+terms rather than bits</li>
+
+</ul>
+
+<p>Warning: These features require careful setup of a rewriting theory with good
+normal forms.  It's difficult to debug problems with them.  In many ways
+they may not yet be ready for prime time.</p>
+
+<h3>Rewriting</h3>
+
+<p>Elaborating on our memory example, suppose we are trying to prove something
+about a program that loads and stores from computed addresses in a 1024-entry
+memory of 32-bit unsigned numbers.  For good execution speed when running
+concrete simulations, we might represent this memory as a stobj containing a
+1024-element array.  However, this doesn't perform well when proving theorems
+about this representation using GL, because at each update to a symbolic
+address we must modify several (perhaps all) entries in the array
+representation: if our update is</p>
+
+@({
+  (update-mem <sym_address> <sym_value> <arr>)
+})
+
+<p>then at each address i of the array we must store an object representing:</p>
+
+@({
+  if (sym_address == i) then sym_value else arr[i].
+})
+
+<p>We might do better if we didn't try to compute an explicit interpretation of
+the array after each update, but instead simply tracked the updates in
+chronological order, as in an alist.  To illustrate how to do this, suppose
+that our updater, accessor, and creator functions are, respectively,</p>
+
+<ul>
+<li>@('(update-mem addr val mem)')</li>
+<li>@('(access-mem addr mem)')</li>
+<li>@('(create-mem)')</li>
+</ul>
+
+<p>First, tell GL never to open the definitions of these functions:</p>
+
+@({
+ (gl::gl-set-uninterpreted update-mem)
+ (gl::gl-set-uninterpreted access-mem)
+ (gl::gl-set-uninterpreted create-mem)
+})
+
+<p>Now, when GL encounters updates, rather than computing a new explicit
+symbolic representation for the memory, it will return a term representation,
+such as</p>
+
+@({
+  (update-mem addr1 val1 (update-mem addr2 val2 (create-mem))).
+})
+
+<p>To make this work, we just need to provide rewrite rules so that GL can reason
+about accesses:</p>
+
+@({
+ (gl::def-gl-rewrite access-of-create
+    (equal (access-mem addr (create-mem))
+           (and (natp addr) (< addr 1024) 0)))
+
+ (gl::def-gl-rewrite access-of-update
+    (equal (access-mem addr (update-mem waddr val mem))
+           (if (equal (nfix addr) (nfix waddr))
+               val
+             (access-mem addr mem))))
+})
+
+<h3>Branch Merging</h3>
+
+<p>Suppose that somewhere in our program we have an update as follows:</p>
+
+@({
+  (let ((mem (if special-condition
+                 (update-mem addr val mem)
+               mem)))
+      ...)
+})
+
+<p>At this point, simulating with just the rules we have above, our proof will
+probably fail because a subsequent access of the memory won't be resolved by
+the access-of-update rule: we no longer have a term of the form</p>
+
+@({
+  (access-mem addr (update-mem waddr val mem))
+})
+
+<p>but rather</p>
+
+@({
+ (access-mem addr (if cond (update-mem waddr val mem) mem)).
+})
+
+<p>We could fix this by introducing a new rule:</p>
+
+@({
+ (gl::def-gl-rewrite access-of-if
+     (equal (access-mem addr (if c mem1 mem2))
+            (if c (access-mem addr mem1) (access-mem addr mem2))))
+})
+
+<p>This is probably the easiest solution if ACCESS-MEM is the only important
+function that must interact with UPDATE-MEM.  An alternative is to write a rule
+that merges the two branches into a single term.  A branch merge rule can
+accomplish this:</p>
+
+@({
+ (gl::def-gl-branch-merge merge-conditional-update
+   (equal (if cond (update-mem addr val mem) mem)
+          (update-mem addr (if cond val (access-mem addr mem)) mem)))
+})
+
+<p>This isn't necessarily cheap -- in order to apply this rule, we need to find
+the previous value of addr in mem, and this symbolic lookup is relatively
+expensive, since it may need to traverse all the updates in mem to construct
+the symbolic value of the access.</p>
+
+
+<h3>Term-level shape specifiers</h3>
+
+<p>Traditionally, to do a proof in GL one must supply, for each free variable of
+the theorem, a shape specifier, which tells GL how to create a symbolic object
+to represent that variable.  After GL finishes the symbolic execution portion
+of the proof, the shape specifiers must be shown to be appropriate given the
+assumptions about each variable; it therefore generates proof obligations of
+the form:</p>
+
+@({
+ (implies (<hypotheses> var)
+          (shape-spec-obj-in-range <shape-spec> var))
+})
+
+<p>These are called coverage obligations.  Shape-spec-obj-in-range says that the
+value var is expressible by the given shape-spec; that is, the shape-spec
+covers all possible values of var satisfying the hyps.  For example, if the
+shape-spec is the :g-number construct for a 10-bit integer, then the
+shape-spec-obj-in-range term reduces to:</p>
+
+@({
+  (and (integerp var)
+       (< var (expt 2 9))
+       (<= (- (expt 2 9)) var)).
+})
+
+<p>Since the new GL capabilities described above allow manipulation of
+term-level symbolic objects, it can be useful to supply term-level shape
+specifiers.  This can be done using the G-CALL and G-VAR constructs.</p>
+
+<p>A G-VAR construct is simply a free variable; it can represent any object
+whatsoever, so its coverage obligations are trivial.</p>
+
+<p>A G-CALL represents a function call.  It takes three arguments:</p>
+
+<ul>
+<li>FN, a function symbol</li>
+<li>ARGS, a list of arguments, each (recursively) a shape spec</li>
+<li>INV, a 1-argument function symbol or lambda, the inverse function.</li>
+</ul>
+
+<p>The symbolic term resulting from this shape spec is simply the application
+(G-APPLY) of FN to the symbolic objects derived from ARGS.  INV is an extra
+piece of information that tells us how to prove coverage.  Its usage is
+discussed in @(see g-call).</p>
+
+<h3>Automatic Boolean Variable Generation</h3>
+
+<p>GL now has the ability to generate fresh Boolean variables in addition to
+the ones existing in the user-provided shape spec.  It does this anytime an IF
+condition's value ends up as a term-level object, i.e. a G-APPLY (function
+call) or G-VAR (free variable).  The mapping between these term-level objects
+and the generated Boolean variables are stored as we symbolically execute and
+can be reused if the same condition is encountered again.  Careful use of this
+feature can allow GL to work without giving such detailed shape specifiers.</p>
+
+<p>For example, suppose that we don't want to assume anything about our memory
+variable, but we know that for any slot we access, we'll only use 5 bits of the
+stored value: perhaps our accessors always take (LOGHEAD 5 x) of the slot.  We
+can assign a G-VAR object to the memory; that way it can represent any object
+at all.  We then want to arrange things so that at every access, we generate 5
+new Boolean variables for the integer bits of that access (if we haven't
+already done so).  Here is one rule that will accomplish that:</p>
+
+@({
+ (gl::def-gl-rewrite loghead-5-of-access-mem
+    ;; We don't want this rule to apply to an update-mem term, so this syntaxp
+    ;; hyp prevents that.  We also should only apply this if ADDR is a concrete
+    ;; object; we'd need a different strategy for symbolic addresses.
+    (implies (syntaxp (and (not (and (consp mem)
+                                     (gl::g-apply-p mem)
+                                     (eq (gl::g-apply->fn mem) 'update-mem)))
+                           (gl::general-concrete-p addr)))
+              (equal (loghead 5 (access-mem addr mem))
+                     (logcons
+                      (if (logbitp 0 (access-mem addr mem)) 1 0)
+                      (logcons
+                       (if (logbitp 1 (access-mem addr mem)) 1 0)
+                       (logcons
+                        (if (logbitp 2 (access-mem addr mem)) 1 0)
+                        (logcons
+                         (if (logbitp 3 (access-mem addr mem)) 1 0)
+                         (logcons
+                          (if (logbitp 4 (access-mem addr mem)) 1 0)
+                          0))))))))
+})
+
+<p>Performing this rewrite will causes GL to generate a Boolean variable for each
+of these LOGBITP terms, because they produce term-level objects that are then
+used in IF tests.</p>
+
+<p>Using this strategy makes it harder to generate counterexamples.  In fact, it
+is impossible to generally solve the problem of generating counterexamples when
+using this strategy.  A satisfying assignment from a SAT solver gives us an
+assignment of values to our Boolean variables.  But these Boolean variables
+each just correspond to some term, which may be an arbitrary nesting of
+functions.  To map this Boolean-level counterexample to an ACL2-level
+counterexample, we are then left with finding an assignment for some variables
+that makes a series of terms take certain truth values, which is undecidable.
+In the next section, we describe a heuristic method for generating
+counterexamples that works in practice when applied carefully.</p>
+
+<p>Furthermore, unless this strategy is used with utmost care, it is likely that
+proofs will fail due to detection of \"counterexamples\" that are actually
+impossible.  For example, we might generate a Boolean variable for (integerp x)
+and another one for (logbitp 0 x).  But these two terms are not independent; in
+fact, (logbitp 0 x) implies (integerp x).  Currently, GL has no mechanism to
+pass this restriction to a SAT solver, so we may find false counterexamples
+that violate this constraint. This can't render GL unsound, but may lead to
+failed proofs.</p>
+
+<p>The situation described above (where every field is accessed via LOGHEAD and
+via concrete address) is a particularly good one for this strategy, since then
+all we need to know about each field are its LOGBITPs, which are all
+independent.</p>
+
+<h3>Counterexamples with Automatic Boolean Variable Generation</h3>
+
+<p>Our strategy for generating counterexamples when using automatic Boolean
+variable generation is to provide rules for manipulating assignments.  For
+example:</p>
+
+@({
+ (gl::def-glcp-ctrex-rewrite
+   ((logbitp n x) t)
+   (x (logior (ash 1 n) x)))
+
+ (gl::def-glcp-ctrex-rewrite
+   ((logbitp n x) nil)
+   (x (logand (lognot (ash 1 n)) x)))
+})
+
+<p>These two rules, respectively, say:</p>
+
+<ul>
+<li>\"if (logbitp n x) should be T, then assign X = (logior (ash 1 n) x)\"</li>
+<li>\"if (logbitp n x) should be NIL, then assign X = (logand (lognot (ash 1 n)) x)\".</li>
+</ul>
+
+<p>DEF-GLCP-CTREX-REWRITE can also take a keyword argument :test, which can do
+a syntactic check on the variables matched. E.g., we could ensure that N was a
+constant in the rules above:</p>
+
+@({
+ (gl::def-glcp-ctrex-rewrite
+   ((logbitp n x) t)
+   (x (logior (ash 1 n) x))
+   :test (quotep n))
+})
+
+<p>Note that these rules are purely heuristic, have no bearing on the soundness of
+GL, and do not require any proofs.  Getting them wrong may cause GL to generate
+false counterexamples, however.</p>
+
+<p>Another rule that would be useful in the memory example above:</p>
+
+@({
+ (gl::def-glcp-ctrex-rewrite
+   ((access-mem addr mem) val)
+   (mem (update-mem addr val mem))
+   :test (quotep addr))
+})")
+
+
+
+
diff -Nru acl2-6.2/books/centaur/gl/eval-f-i-cp.lisp acl2-6.3/books/centaur/gl/eval-f-i-cp.lisp
--- acl2-6.2/books/centaur/gl/eval-f-i-cp.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/eval-f-i-cp.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,6 +1,24 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "gl-util")
 (include-book "tools/bstar" :dir :system)
 (include-book "tools/mv-nth" :dir :system)
@@ -267,7 +285,7 @@
                             default-cdr
                             eval-conds
                             conds-match)))))
-  
+
 
 (defun apply-cond-cp (clause)
   (if (consp clause)
diff -Nru acl2-6.2/books/centaur/gl/eval-g-base-help.lisp acl2-6.3/books/centaur/gl/eval-g-base-help.lisp
--- acl2-6.2/books/centaur/gl/eval-g-base-help.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/eval-g-base-help.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,28 +1,42 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "eval-g-base")
-
+(include-book "g-if")
 (include-book "gify-clause-proc")
-
 (include-book "general-object-thms")
-
 (include-book "tools/def-functional-instance" :dir :system)
 
-
-
-
-
 (acl2::def-functional-instance
  eval-g-base-alt-def
  generic-geval-alt-def
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base))
- :hints ('(:in-theory (e/d* (eval-g-base-ev-constraint-0
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list))
+ :hints ('(:in-theory (e/d* (eval-g-base-ev-of-fncall-args
                              eval-g-base-apply-agrees-with-eval-g-base-ev)
                             (eval-g-base-apply))
-           :expand ((eval-g-base x env))))
+           :expand ((eval-g-base x env)
+                    (eval-g-base-list x env))))
          ;; :do-not-induct
          ;;   t
          ;;   :expand ((eval-g-base x env))))
@@ -34,7 +48,8 @@
  mk-g-boolean-correct
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 
 
@@ -43,14 +58,16 @@
  gtests-obj-correct
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  gtests-nonnil-correct-for-eval-g-base
  gtests-nonnil-correct
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (local
  (progn
@@ -62,7 +79,8 @@
     mk-g-ite-correct
     ((generic-geval-ev eval-g-base-ev)
      (generic-geval-ev-lst eval-g-base-ev-lst)
-     (generic-geval eval-g-base)))
+     (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 
    (acl2::def-functional-instance
@@ -70,28 +88,32 @@
     gobj-ite-merge-correct
     ((generic-geval-ev eval-g-base-ev)
      (generic-geval-ev-lst eval-g-base-ev-lst)
-     (generic-geval eval-g-base)))))
+     (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))))
 
 (acl2::def-functional-instance
  eval-g-base-g-apply
  generic-geval-g-apply
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  general-consp-car-correct-for-eval-g-base
  general-consp-car-correct
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  general-consp-cdr-correct-for-eval-g-base
  general-consp-cdr-correct
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (in-theory (disable general-consp-car-correct-for-eval-g-base
                     general-consp-cdr-correct-for-eval-g-base))
@@ -101,14 +123,16 @@
  generic-geval-cons
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  eval-g-base-non-cons
  generic-geval-non-cons
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (in-theory (disable eval-g-base-non-cons))
 
@@ -117,49 +141,63 @@
 ;;  generic-geval-gobj-fix
 ;;  ((apply-stub eval-g-base-apply)
 ;;   (generic-geval-apply eval-g-base-apply)
-;;   (generic-geval eval-g-base)))
+;;   (generic-geval eval-g-base)
 
 (acl2::def-functional-instance
  general-concrete-obj-when-consp-for-eval-g-base
  general-concrete-obj-when-consp
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  not-general-numberp-not-acl2-numberp-for-eval-g-base
  not-general-numberp-not-acl2-numberp
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  mk-g-number-correct-for-eval-g-base
  mk-g-number-correct
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  mk-g-concrete-correct-for-eval-g-base
  mk-g-concrete-correct
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  g-concrete-quote-correct-for-eval-g-base
  g-concrete-quote-correct
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 (acl2::def-functional-instance
  eval-g-base-of-gl-cons
  generic-geval-gl-cons
  ((generic-geval-ev eval-g-base-ev)
   (generic-geval-ev-lst eval-g-base-ev-lst)
-  (generic-geval eval-g-base)))
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
+
+(acl2::def-functional-instance
+ eval-g-base-list-of-gl-cons
+ generic-geval-list-gl-cons
+ ((generic-geval-ev eval-g-base-ev)
+  (generic-geval-ev-lst eval-g-base-ev-lst)
+  (generic-geval eval-g-base)
+  (generic-geval-list eval-g-base-list)))
 
 
 
diff -Nru acl2-6.2/books/centaur/gl/eval-g-base.lisp acl2-6.3/books/centaur/gl/eval-g-base.lisp
--- acl2-6.2/books/centaur/gl/eval-g-base.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/eval-g-base.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,13 +1,31 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-;; (include-book "defapply")
 (include-book "generic-geval")
-
+(include-book "symbolic-arithmetic-fns")
+;; (include-book "defapply")
 
 (def-eval-g eval-g-base
   (BINARY-*
+   cons if
    BINARY-+
    PKG-WITNESS
 ;   UNARY-/
@@ -49,6 +67,7 @@
    truncate
    rem
    acl2::boolfix
+   hons-assoc-equal
 
    ;; these are from the constant *expandable-boot-strap-non-rec-fns*.
    NOT IMPLIES
@@ -56,7 +75,8 @@
    PLUSP MINUSP LISTP ;; RETURN-LAST causes guard violation
    ;; FORCE CASE-SPLIT
    ;; DOUBLE-REWRITE
-   ))
+
+   logapp int-set-sign maybe-integer))
 
 
 (in-theory (disable eval-g-base))
diff -Nru acl2-6.2/books/centaur/gl/factor-fns.lisp acl2-6.3/books/centaur/gl/factor-fns.lisp
--- acl2-6.2/books/centaur/gl/factor-fns.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/factor-fns.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,9 +1,24 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
-
 (include-book "tools/bstar" :dir :system)
 (include-book "rws")
 (include-book "clause-processors/generalize" :dir :system)
@@ -12,9 +27,6 @@
 
 (program)
 
-; what is the reason for this switch over to program mode?
-; who did it?  ????? -- Boyer
-
 (defun constant-syntax-p (name)
   ;; This is adapted from legal-variable-or-constant-namep, but only performs
   ;; the checks necessary to distinguish variable from constant.
@@ -40,7 +52,7 @@
   (incat 'gl-fact::foo
          (symbol-package-name fn) "::" (symbol-name fn) "-LAMBDA-"
          (acl2::nat-to-str idx)))
-  
+
 (mutual-recursion
  (defun calldepth-greaterp (term depth)
    (cond ((or (atom term)
@@ -252,7 +264,7 @@
       events
     (b* ((fn (car clique))
          (body (norm-function-body fn world))
-         (- (or body 
+         (- (or body
                 (er hard 'factor-fn-clique
                     "No body retrieved for ~x0~%" fn)))
          (vars (wgetprop fn 'formals))
@@ -280,5 +292,5 @@
        `(progn (logic)
                ,@(reverse (factor-fn-clique clique world nil))
                (local (in-theory (disable* (:ruleset factor-ruleset)))))))))
-         
-         
+
+
diff -Nru acl2-6.2/books/centaur/gl/g-always-equal.lisp acl2-6.3/books/centaur/gl/g-always-equal.lisp
--- acl2-6.2/books/centaur/gl/g-always-equal.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-always-equal.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,23 +1,38 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-primitives-help")
-
-
 (include-book "g-if")
 (include-book "symbolic-arithmetic-fns")
-(local (include-book "eval-g-base-help"))
 (include-book "eval-g-base")
-(local (include-book "hyp-fix-logic"))
 (include-book "always-equal-prep")
 (include-book "g-equal")
+(local (include-book "eval-g-base-help"))
+(local (include-book "hyp-fix-logic"))
 
 (def-g-fn acl2::always-equal
   ;; Once we've ruled out the case where they're both atoms, start by recurring
   ;; down to non-ITEs on both a and b:
-  `(bfr-case :bdd (g-always-equal-core x y hyp clk)
-             :aig (glr equal x y hyp clk)))
+  `(bfr-case :bdd (g-always-equal-core x y hyp clk config bvar-db state)
+             :aig (glr equal x y hyp clk config bvar-db state)))
 
 
 
@@ -32,7 +47,7 @@
 ;;                                     (:type-prescription booleanp)
 ;;                                     (:type-prescription gobj-fix)
 ;;                                     equal-of-booleans-rewrite))
-;;             :expand ((,gfn x y hyp clk)))))
+;;             :expand ((,gfn x y hyp clk config bvar-db state)))))
 
 (verify-g-guards
    acl2::always-equal
@@ -40,7 +55,10 @@
 
 
 
-
+(def-gobj-dependency-thm acl2::always-equal
+  :hints `(("Goal" :in-theory (e/d (,gfn)
+                                   (g-always-equal-core
+                                    gobj-depends-on)))))
 
 
 (def-g-correct-thm acl2::always-equal eval-g-base
diff -Nru acl2-6.2/books/centaur/gl/g-ash.lisp acl2-6.3/books/centaur/gl/g-ash.lisp
--- acl2-6.2/books/centaur/gl/g-ash.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-ash.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,8 +1,24 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-(set-inhibit-warnings "theory")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
@@ -11,7 +27,8 @@
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-
+(local (include-book "clause-processors/just-expand" :dir :system))
+(set-inhibit-warnings "theory")
 
 (defun g-ash-of-numbers (i c)
   (declare (xargs :guard (and (general-numberp i)
@@ -22,22 +39,27 @@
         (general-number-components c))
        ((mv iintp iintp-known)
         (if (equal ird '(t))
-            (mv (bfr-or (=-ss iin nil) (=-uu iid nil)) t)
+            (mv (bfr-or (bfr-=-ss iin nil) (bfr-=-uu iid nil)) t)
           (mv nil nil)))
        ((mv cintp cintp-known)
         (if (equal crd '(t))
-            (mv (bfr-or (=-ss cin nil) (=-uu cid nil)) t)
+            (mv (bfr-or (bfr-=-ss cin nil) (bfr-=-uu cid nil)) t)
           (mv nil nil))))
     (if (and cintp-known iintp-known)
         (mk-g-number
          (rlist-fix
-          (ash-ss 1 (bfr-ite-bss-fn iintp irn nil)
+          (bfr-ash-ss 1 (bfr-ite-bss-fn iintp irn nil)
                   (bfr-ite-bss-fn cintp crn nil))))
       (g-apply 'ash (gl-list i c)))))
 
 (in-theory (disable (g-ash-of-numbers)))
 
-
+(defthm deps-of-g-ash-of-numbers
+  (implies (and (not (gobj-depends-on k p i))
+                (not (gobj-depends-on k p c))
+                (general-numberp i)
+                (general-numberp c))
+           (not (gobj-depends-on k p (g-ash-of-numbers i c)))))
 
 (local
  (progn
@@ -47,9 +69,9 @@
    ;;   :hints(("Goal" :in-theory (enable bfr-listp))))
 
 
-   ;; (defthm not-integerp-ash-ss
-   ;;   (not (integerp (ash-ss place n shamt)))
-   ;;   :hints(("Goal" :in-theory (enable ash-ss))))
+   ;; (defthm not-integerp-bfr-ash-ss
+   ;;   (not (integerp (bfr-ash-ss place n shamt)))
+   ;;   :hints(("Goal" :in-theory (enable bfr-ash-ss))))
 
 
    (defthm ash-complex-1
@@ -121,6 +143,12 @@
                        (equal (ash x y) (ash x 0))))
          :hints(("Goal" :in-theory (enable ash)))))
 
+(def-gobj-dependency-thm ash
+  :hints `(("goal" :in-theory (e/d ((:i ,gfn))
+                                   ((:d ,gfn)
+                                    gobj-depends-on)))
+           (acl2::just-induct-and-expand ,gcall)))
+
 (def-g-correct-thm ash eval-g-base
   :hints
   `(("goal" :in-theory (e/d* (general-concretep-atom
@@ -136,14 +164,13 @@
                               member-equal
                               general-number-components-ev
                               general-concretep-def
-                              v2n-is-v2i-when-sign-nil
                               general-concretep-def
                               rationalp-implies-acl2-numberp
+                              ash
                               (:rules-of-class :type-prescription :here))
                              ((:type-prescription bfr-eval)))
-     :induct (,gfn i c hyp clk)
-     :do-not-induct t
-     :expand ((,gfn i c hyp clk)))
+     :do-not-induct t)
+    (acl2::just-induct-and-expand ,gcall)
     (and stable-under-simplificationp
          (flag::expand-calls-computed-hint
           clause '(eval-g-base)))))
diff -Nru acl2-6.2/books/centaur/gl/g-binary-+.lisp acl2-6.3/books/centaur/gl/g-binary-+.lisp
--- acl2-6.2/books/centaur/gl/g-binary-+.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-binary-+.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,6 +1,24 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
@@ -9,6 +27,7 @@
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
+(local (include-book "clause-processors/just-expand" :dir :system))
 ;(local (allow-arith5-help))
 
 ;; (include-book "univ-gl-eval")
@@ -24,12 +43,9 @@
              (equal yrd '(t))
              (equal xid '(t))
              (equal yid '(t)))
-        (let* ((rsum (+-ss nil xrn yrn))
-               (isum (+-ss nil xin yin)))
-          (mk-g-number
-           (if (boolean-listp rsum) (v2i rsum) rsum)
-           1
-           (if (boolean-listp isum) (v2i isum) isum)))
+        (let* ((rsum (bfr-+-ss nil xrn yrn))
+               (isum (bfr-+-ss nil xin yin)))
+          (mk-g-number rsum 1 isum))
       (g-apply 'binary-+ (gl-list x y)))))
 
 (in-theory (disable (g-binary-+-of-numbers)))
@@ -40,34 +56,34 @@
                   (equal (bfr-eval-list x env)
                          x))))
 
-(local (defthm rewrite-v2i-of-boolean-list
-         (implies (and (syntaxp (not (and (consp x)
-                                          (eq (car x) 'bfr-eval-list))))
-                       (bind-free '((env . (car env))) (env))
-                       (boolean-listp x))
-                  (equal (v2i x)
-                         (v2i (bfr-eval-list x env))))
-         :hints(("Goal" :in-theory (enable bfr-eval-list-when-boolean-listp)))
-         :rule-classes ((:rewrite :backchain-limit-lst 0))))
-
-(local (defthm rewrite-v2n-of-boolean-list
-         (implies (and (syntaxp (not (and (consp x)
-                                          (eq (car x) 'bfr-eval-list))))
-                       (bind-free '((env . (car env))) (env))
-                       (boolean-listp x))
-                  (equal (v2n x)
-                         (v2n (bfr-eval-list x env))))
-         :hints(("Goal" :in-theory (enable bfr-eval-list-when-boolean-listp)))
-         :rule-classes ((:rewrite :backchain-limit-lst 0))))
-
-(defthm bfr-eval-list-of-bfr-ite-bvv-fn-under-v2n
-  (equal (v2n (bfr-eval-list (bfr-ite-bvv-fn c a b) env))
-         (v2n (if (bfr-eval c env)
-                  (bfr-eval-list a env)
-                (bfr-eval-list b env))))
-  :hints(("Goal" :in-theory (enable bfr-ite-bvv-fn v2n)
-          :induct t)
-         (bfr-reasoning)))
+;; (local (defthm rewrite-v2i-of-boolean-list
+;;          (implies (and (syntaxp (not (and (consp x)
+;;                                           (eq (car x) 'bfr-eval-list))))
+;;                        (bind-free '((env . (car env))) (env))
+;;                        (boolean-listp x))
+;;                   (equal (v2i x)
+;;                          (bfr-list->s x env)))
+;;          :hints(("Goal" :in-theory (enable bfr-eval-list-when-boolean-listp)))
+;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;; (local (defthm rewrite-v2n-of-boolean-list
+;;          (implies (and (syntaxp (not (and (consp x)
+;;                                           (eq (car x) 'bfr-eval-list))))
+;;                        (bind-free '((env . (car env))) (env))
+;;                        (boolean-listp x))
+;;                   (equal (v2n x)
+;;                          (bfr-list->u x env)))
+;;          :hints(("Goal" :in-theory (enable bfr-eval-list-when-boolean-listp)))
+;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;; (defthm bfr-eval-list-of-bfr-ite-bvv-fn-unde
+;;   (equal (bfr-list->u (bfr-ite-bvv-fn c a b) env)
+;;          (if (bfr-eval c env)
+;;              (bfr-list->u a env)
+;;            (bfr-list->u b env))))
+;;   :hints(("Goal" :in-theory (enable bfr-ite-bvv-fn v2n)
+;;           :induct t)
+;;          (bfr-reasoning)))
 
 
 (local
@@ -82,6 +98,16 @@
                                      general-number-components))
             :do-not-induct t))))
 
+(local
+ (defthm dependencies-of-g-binary-+-of-numbers
+   (implies (and (general-numberp x)
+                 (general-numberp y)
+                 (not (gobj-depends-on n p x))
+                 (not (gobj-depends-on n p y)))
+            (not (gobj-depends-on n p (g-binary-+-of-numbers x y))))
+   :hints (("goal" :do-not-induct t))
+   :otf-flg t))
+
 (in-theory (disable g-binary-+-of-numbers))
 
 (def-g-binary-op binary-+
@@ -95,7 +121,7 @@
 
 (verify-g-guards
  binary-+
- :hints `(("goal" :in-theory (disable* ,gfn 
+ :hints `(("goal" :in-theory (disable* ,gfn
                                        (:rules-of-class :type-prescription
                                                         :here)))))
 
@@ -108,12 +134,18 @@
                        (equal (+ x y)
                               (+ x 0))))))
 
+(def-gobj-dependency-thm binary-+
+  :hints `(("goal" :in-theory (disable (:d ,gfn)
+                                       gobj-depends-on)
+            :induct ,gcall
+            :expand (,gcall))))
+
 (def-g-correct-thm binary-+ eval-g-base
   :hints
   `(("goal" :in-theory (e/d* (general-concretep-atom
                               (:ruleset general-object-possibilities))
                              ((:definition ,gfn)
-                              i2v n2v v2i +-ss
+                              i2v n2v bfr-+-ss
                               general-numberp-eval-to-numberp
                               general-boolean-value-correct
                               bool-cond-itep-eval
@@ -124,14 +156,14 @@
                               member-equal
                               general-number-components-ev
                               general-concretep-def
-                              v2n-is-v2i-when-sign-nil
                               general-concretep-def
                               rationalp-implies-acl2-numberp
                               (:rules-of-class :type-prescription :here))
-                             ((:type-prescription bfr-eval)))
-     :induct (,gfn x y hyp clk)
+                             ((:type-prescription bfr-eval)
+                              (:type-prescription components-to-number-fn)))
+     :induct ,gcall
      :do-not-induct t
-     :expand ((,gfn x y hyp clk)))
+     :expand (,gcall))
     (and stable-under-simplificationp
          (flag::expand-calls-computed-hint
           clause '(eval-g-base)))))
diff -Nru acl2-6.2/books/centaur/gl/g-binary-mult.lisp acl2-6.3/books/centaur/gl/g-binary-mult.lisp
--- acl2-6.2/books/centaur/gl/g-binary-mult.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-binary-mult.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,7 +1,24 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
@@ -23,19 +40,25 @@
              (equal yrd '(t))
              (equal xid '(t))
              (equal yid '(t)))
-        (let* ((rprod (+-ss nil (*-ss xrn yrn)
-                            (unary-minus-s
-                             (*-ss xin yin))))
-               (iprod (+-ss nil (*-ss xrn yin)
-                            (*-ss xin yrn))))
+        (let* ((rprod (bfr-+-ss nil (bfr-*-ss xrn yrn)
+                            (bfr-unary-minus-s
+                             (bfr-*-ss xin yin))))
+               (iprod (bfr-+-ss nil (bfr-*-ss xrn yin)
+                            (bfr-*-ss xin yrn))))
           (mk-g-number
-           (if (boolean-listp rprod) (v2i rprod) rprod)
-           1
-           (if (boolean-listp iprod) (v2i iprod) iprod)))
+           rprod
+           1 iprod))
       (g-apply 'binary-* (gl-list x y)))))
 
 (in-theory (disable (g-binary-*-of-numbers)))
 
+(defthm deps-of-g-binary-*-of-numbers
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-binary-*-of-numbers x y)))))
+
 (local
  (progn
    ;; (defthm gobjectp-g-binary-*-of-numbers
@@ -120,6 +143,12 @@
                               (* x 0))))))
 
 
+(def-gobj-dependency-thm binary-*
+  :hints `(("goal" :induct ,gcall
+           :expand (,gcall)
+           :in-theory (disable (:d ,gfn)
+                               gobj-depends-on))))
+
 
 (def-g-correct-thm binary-* eval-g-base
   :hints
@@ -137,14 +166,13 @@
                               member-equal
                               general-number-components-ev
                               general-concretep-def
-                              v2n-is-v2i-when-sign-nil
                               general-concretep-def
                               rationalp-implies-acl2-numberp
                               (:rules-of-class :type-prescription :here))
                              ((:type-prescription bfr-eval)))
-     :induct (,gfn x y hyp clk)
+     :induct ,gcall
      :do-not-induct t
-     :expand ((,gfn x y hyp clk)))
+     :expand (,gcall))
 ;;     '(:use ((:instance possibilities-for-x)
 ;;             (:instance possibilities-for-x (x y))))
     (and stable-under-simplificationp
diff -Nru acl2-6.2/books/centaur/gl/g-code-char.lisp acl2-6.3/books/centaur/gl/g-code-char.lisp
--- acl2-6.2/books/centaur/gl/g-code-char.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-code-char.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,36 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "eval-g-base")
 (include-book "symbolic-arithmetic-fns")
+(include-book "g-lessthan")
 (local (include-book "symbolic-arithmetic"))
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-(include-book "g-lessthan")
 (local (include-book "arithmetic/top-with-meta" :dir :system))
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "tools/trivial-ancestors-check" :dir :system))
+(local (acl2::use-trivial-ancestors-check))
 
 ;; (defaxiom completion-of-code-char
 ;;   (equal (code-char x)
@@ -38,6 +58,10 @@
         (t ;; cons
          (code-char 0))))
 
+(defthm deps-of-g-code-char-concrete
+  (implies (not (gobj-depends-on k p x))
+           (not (gobj-depends-on k p (g-code-char-concrete x)))))
+
 (local
  (progn
    ;; (defthm gobjectp-characterp
@@ -104,6 +128,7 @@
                                      general-booleanp
                                      general-consp
                                      eval-g-base
+                                     eval-g-base-list
                                      g-keyword-symbolp)
                                     ((code-char)
                                      eval-g-base-alt-def))
@@ -123,6 +148,10 @@
    ;;   :hints(("Goal" :in-theory (enable bfr-listp))))
    ))
 
+(local (defthm floor-1
+         (implies (integerp n)
+                  (equal (floor n 1) n))
+         :hints(("Goal" :in-theory (enable floor)))))
 
 (defun code-char-s (n x acc hyp)
   (declare (xargs :guard (and (natp n)
@@ -131,13 +160,24 @@
                               (natp acc)
                               (<= acc (- 256 (ash 1 n))))
                   :guard-hints ((and stable-under-simplificationp
-                                     '(:in-theory (enable ash))))))
+                                     '(:in-theory (enable ash expt))))))
   (if (zp n)
       (code-char acc)
     (g-if (mk-g-boolean (nth (1- n) x))
           (code-char-s (1- n) x (+ (ash 1 (1- n)) acc) hyp)
           (code-char-s (1- n) x acc hyp))))
 
+(defthm pbfr-depends-on-nth
+  (implies (not (pbfr-list-depends-on k p x))
+           (not (pbfr-depends-on k p (nth n x)))))
+
+(defthm deps-of-code-char-s
+  (implies (not (pbfr-list-depends-on k p x))
+           (not (gobj-depends-on k p (code-char-s n x acc hyp))))
+  :hints (("goal" :induct (code-char-s n x acc hyp)
+           :in-theory (disable (:d code-char-s))
+           :expand ((code-char-s n x acc hyp)))))
+
 ;; (local (defun first-n (n x)
 ;;          (if (zp n)
 ;;              nil
@@ -163,17 +203,24 @@
             (append (bfr-eval-list a env)
                     (bfr-eval-list b env))))
 
-   (defthm v2n-append
-     (equal (v2n (append a b))
-            (+ (v2n a)
-               (* (v2n b) (expt 2 (len a)))))
-     :hints(("Goal" :in-theory (enable v2n ash))))
+   ;; (defthm v2n-append
+   ;;   (equal (v2n (append a b))
+   ;;          (+ (v2n a)
+   ;;             (* (v2n b) (expt 2 (len a)))))
+   ;;   :hints(("Goal" :in-theory (enable v2n ash))))
+   (defthm bfr-list->u-of-append
+     (equal (bfr-list->u (append a b) env)
+            (+ (bfr-list->u a env)
+               (* (bfr-list->u b env) (expt 2 (len a)))))
+     :hints(("Goal" :in-theory (e/d* (acl2::logapp** logcons
+                                                     acl2::bool->bit)
+                                     (logapp)))))
 
 ;; (defthm bfr-eval-list-first-n
 ;;   (implies (not (zp n))
-;;            (equal (v2n (bfr-eval-list (first-n n x) env))
+;;            (equal (bfr-list->u (first-n n x) env)
 ;;                   (+ (if (bfr-eval (nth (1- n) x) env) (expt 2 (1- n)) 0)
-;;                      (v2n (bfr-eval-list (first-n (1- n) x) env)))))
+;;                      (bfr-list->u (first-n (1- n) x) env))))
 ;;   :hints (("goal" :induct (first-n n x)
 ;;            :in-theory (e/d (ash) ((:definition first-n)))
 ;;            :expand ((first-n n x)
@@ -182,28 +229,30 @@
 
    (defthm floor-1
      (implies (integerp n)
-              (equal (floor n 1) n)))
+              (equal (floor n 1) n))
+     :hints(("Goal" :in-theory (enable floor))))
 
    (defthm len-bfr-eval-list
      (equal (len (Bfr-eval-list x env))
             (len x)))
 
    (defthm code-char-s-correct1
-     (implies (and (< (+ acc (v2n (bfr-eval-list (first-n n x) (car env)))) 256)
+     (implies (and (< (+ acc (bfr-list->u (first-n n x) (car env))) 256)
                    (integerp acc)
                    (bfr-eval hyp (car env)))
               (equal (eval-g-base (code-char-s n x acc hyp) env)
-                     (code-char (+ acc (v2n (bfr-eval-list (first-n n x) (car
-                                                                          env)))))))
+                     (code-char (+ acc (bfr-list->u (first-n n x) (car env))))))
      :hints (("goal" :induct (code-char-s n x acc hyp)
               :expand ((code-char-s n x acc hyp)
                        (code-char-s 0 x acc hyp))
               :in-theory (e/d (ash) (floor (:definition code-char-s))))))
 
-   (defthm v2i-when-<=-0
-     (implies (<= 0 (v2i x))
-              (equal (v2i x) (v2n x)))
-     :hints(("Goal" :in-theory (enable v2i v2n ash))))
+   (defthm bfr-list->s-when-<=-0
+     (implies (<= 0 (bfr-list->s x env))
+              (equal (bfr-list->s x env) (bfr-list->u x env)))
+     :hints(("Goal" :in-theory (enable scdr s-endp))))
+
+
 
    (defthm bfr-eval-list-nth
      (equal (nth n (bfr-eval-list x env))
@@ -223,24 +272,31 @@
      (equal (first-n n x)
             (first-n-alt n x)))
 
-   (defthm v2n-first-n
-     (implies (< (v2n x) (expt 2 (nfix n)))
-              (equal (v2n (first-n n x))
-                     (v2n x)))
-     :hints(("Goal" :in-theory (enable v2n ash first-n-is-first-n-alt)
-             :induct (first-n-alt n x)
-             :expand ( ;; (v2n x)
-                      (:free (a b) (v2n (cons a b)))))))
+   (defthm bfr-list->u-of-first-n
+     (implies (< (bfr-list->u x env) (expt 2 (nfix n)))
+              (equal (bfr-list->u (first-n n x) env)
+                     (bfr-list->u x env)))
+     :hints(("Goal" :in-theory (enable first-n-is-first-n-alt
+                                       logcons acl2::bool->bit
+                                       expt))))
+
+   ;; (defthm v2n-first-n
+   ;;   (implies (< (v2n x) (expt 2 (nfix n)))
+   ;;            (equal (v2n (first-n n x))
+   ;;                   (v2n x)))
+   ;;   :hints(("Goal" :in-theory (enable v2n ash first-n-is-first-n-alt)
+   ;;           :induct (first-n-alt n x)
+   ;;           :expand ( ;; (v2n x)
+   ;;                    (:free (a b) (v2n (cons a b)))))))
 
    (defthm code-char-s-correct
      (implies (and (bfr-eval hyp (car env))
-                   (<= 0 (v2i (bfr-eval-list x (car env))))
-                   (< (v2i (bfr-eval-list x (car env))) 256))
+                   (<= 0 (bfr-list->s x (car env)))
+                   (< (bfr-list->s x (car env)) 256))
               (equal (eval-g-base (code-char-s 8 x 0 hyp) env)
-                     (code-char (v2i (bfr-eval-list x (car env))))))
-     :hints(("Goal" :in-theory (disable v2n-is-v2i-when-sign-nil
-                                        code-char-s))))))
-                
+                     (code-char (bfr-list->s x (car env)))))
+     :hints(("Goal" :in-theory (disable code-char-s))))))
+
 
 ;; (defun g-code-char-of-integer (x hyp clk)
 ;;   (declare (xargs :guard (and (gobjectp x) (g-number-p x)
@@ -248,26 +304,37 @@
 ;;   (g-if (glr < x 0 hyp clk)
 ;;         nil
 ;;         (glr < x 256 hyp clk))
-  
-(defun g-code-char-of-number (x hyp clk)
+
+(defun g-code-char-of-number (x hyp clk config bvar-db state)
   (declare (xargs :guard (and (consp x)
                               (g-number-p x)
+                              (glcp-config-p config)
                               (natp clk))
+                  :stobjs (bvar-db state)
                   :guard-hints(("Goal" :in-theory
                                 (disable code-char-s)))))
   (mv-let (xrn xrd xin xid)
     (break-g-number (g-number->num x))
     (if (equal xrd '(t))
-        (g-if (g-if (mk-g-boolean (bfr-or (=-ss xin nil)
-                                          (=-uu xid nil)))
-                    (g-if (glr < x 0 hyp clk)
+        (g-if (g-if (mk-g-boolean (bfr-or (bfr-=-ss xin nil)
+                                          (bfr-=-uu xid nil)))
+                    (g-if (glr < x 0 hyp clk config bvar-db state)
                           nil
-                          (glr < x 256 hyp clk))
+                          (glr < x 256 hyp clk config bvar-db state))
                     nil)
-              (code-char-s 8 xrn 0 hyp)
+              (code-char-s 8 (rlist-fix xrn) 0 hyp)
               (code-char 0))
       (g-apply 'code-char (list x)))))
 
+(defthm deps-of-g-code-char-of-number
+  (implies (and (not (gobj-depends-on k p x))
+                (g-number-p x))
+           (not (gobj-depends-on k p (g-code-char-of-number x hyp clk config
+                                                            bvar-db state))))
+  :hints (("goal" :in-theory (e/d ((force))
+                                  (gobj-depends-on
+                                   code-char-s)))))
+
 
 ;; (defun g-code-char-of-number (x hyp clk)
 ;;   (declare (xargs :guard (and (gobjectp x)
@@ -279,8 +346,8 @@
 ;;   (mv-let (xrn xrd xin xid)
 ;;     (break-g-number (g-number->num x))
 ;;     (if (equal xrd '(t))
-;;         (g-if (mk-g-boolean (bfr-or (=-ss xin nil)
-;;                                     (=-uu xid nil)))
+;;         (g-if (mk-g-boolean (bfr-or (bfr-=-ss xin nil)
+;;                                     (bfr-=-uu xid nil)))
 ;;               (g-if (glr < x 0 hyp clk)
 ;;                     (code-char 0)
 ;;                     (g-if (glr < x 256 hyp clk)
@@ -312,13 +379,13 @@
               (not (equal (/ x) 0))))
 
    (defthm not-integerp-when-imag-parts-nonzero
-     (implies (and (not (equal (v2i (bfr-eval-list
+     (implies (and (not (equal (bfr-list->s
                                      (mv-nth 2 (break-g-number (g-number->num x)))
-                                     (car env)))
+                                     (car env))
                                0))
-                   (not (equal (v2n (bfr-eval-list
+                   (not (equal (bfr-list->u
                                      (mv-nth 3 (break-g-number (g-number->num x)))
-                                     (car env)))
+                                     (car env))
                                0))
                    (g-number-p x))
               (not (integerp (eval-g-base x env))))
@@ -337,17 +404,16 @@
      (defthm g-code-char-of-number-correct
        (implies (and (bfr-eval hyp (car env))
                      (g-number-p x))
-                (equal (eval-g-base (g-code-char-of-number x hyp clk) env)
+                (equal (eval-g-base (g-code-char-of-number x hyp clk config
+                                                           bvar-db state) env)
                        (code-char (eval-g-base x env))))
-       :hints(("Goal" :in-theory (e/d (eval-g-base)
+       :hints(("Goal" :in-theory (e/d (eval-g-base eval-g-base-list)
                                       (code-char-s
-                                       v2i-when-<=-0
-                                       v2n-is-v2i-when-sign-nil
                                        equal-of-booleans-rewrite
-                                       s-sign-correct
                                        code-char-s-correct1
                                        code-char-s-correct
                                        bfr-eval-list
+                                       bfr-list->s-when-<=-0
                                        eval-g-base-alt-def))
                :do-not-induct t
                :do-not '(generalize fertilize eliminate-destructors))
@@ -367,13 +433,13 @@
 
 (def-g-fn code-char
   `(cond ((atom x) (g-code-char-concrete x))
-         ((g-number-p x) (g-code-char-of-number x hyp clk))
+         ((g-number-p x) (g-code-char-of-number x hyp clk config bvar-db state))
          ((g-ite-p x)
           (if (zp clk)
               (g-apply 'code-char (gl-list x))
             (g-if (g-ite->test x)
-                  (,gfn (g-ite->then x) hyp clk)
-                  (,gfn (g-ite->else x) hyp clk))))
+                  (,gfn (g-ite->then x) hyp clk config bvar-db state)
+                  (,gfn (g-ite->else x) hyp clk config bvar-db state))))
          (t (g-code-char-concrete x))))
 
 ;;(def-gobjectp-thm code-char)
@@ -381,6 +447,12 @@
 (verify-g-guards code-char
                  :hints `(("goal" :in-theory (Disable ,gfn))))
 
+(def-gobj-dependency-thm code-char
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn) gobj-depends-on
+                                g-code-char-of-number))))
+
 
 (def-g-correct-thm code-char eval-g-base
   :hints `(("goal" :in-theory (e/d ()
@@ -388,8 +460,8 @@
                                     g-code-char-of-number
                                     eval-g-base-alt-def
                                     (:definition ,gfn)))
-            :expand ((,gfn x hyp clk))
-            :induct (,gfn x hyp clk))
+            :expand (,gcall)
+            :induct ,gcall)
            (and stable-under-simplificationp
                 '(:expand ((:with eval-g-base (eval-g-base x env))
                            (:with eval-g-base (eval-g-base nil env)))))))
diff -Nru acl2-6.2/books/centaur/gl/g-coerce.lisp acl2-6.3/books/centaur/gl/g-coerce.lisp
--- acl2-6.2/books/centaur/gl/g-coerce.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-coerce.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,20 +1,41 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
 
 (local (in-theory (disable acl2::revappend-removal)))
 
-
-
+;; [Jared] I suspect we could get this easily working with implode/explode, but
+;; it seems easiest to just say, "this book is low level and wants to deal with
+;; coerce on its own."
+(local (in-theory (e/d (str::implode
+                        str::explode)
+                       (str::coerce-to-string-removal
+                        str::coerce-to-list-removal))))
 
 ;; ;; This brings if-then-elses up from atoms to the top level of a cons tree.
 ;; (defun propagate-ites-above-conses (x )
@@ -42,6 +63,10 @@
     (revappend-concrete (cdr a)
                         (gl-cons (mk-g-concrete (car a)) b))))
 
+(defthm no-deps-of-revappend-concrete
+  (implies (not (gobj-depends-on k p b))
+           (not (gobj-depends-on k p (revappend-concrete a b)))))
+
 (local
  (progn
    ;; (defthm gobjectp-revappend-concrete
@@ -65,7 +90,7 @@
 ;;   (cond ((or (atom x) (not (eq (tag x) :g-ite))) 0)
 ;;         (t (+ 1 (max (g-ite-depth (g-ite->then x))
 ;;                      (g-ite-depth (g-ite->else x)))))))
-    
+
 ;; (defthm g-ite-depth-of-g-ite->then
 ;;   (implies (eq (tag x) :g-ite)
 ;;            (< (g-ite-depth (g-ite->then x)) (g-ite-depth x)))
@@ -138,6 +163,13 @@
              (&
               (coerce-string (cdr x) (cons (code-char 0) pre) hyp))))))))
 
+(defthm deps-of-coerce-string
+  (implies (not (gobj-depends-on k p x))
+           (not (gobj-depends-on k p (coerce-string x pre hyp))))
+  :hints (("goal" :induct (coerce-string x pre hyp)
+           :expand ((coerce-string x pre hyp))
+           :in-theory (disable (:d coerce-string)))))
+
 
 (local
  (progn
@@ -302,6 +334,7 @@
                      (coerce (revappend pre (eval-g-base x env)) 'string)))
      :hints(("Goal" :in-theory (e/d* ( general-concrete-obj
                                        concrete-gobjectp-def
+                                       eval-g-base-list
                                        general-concretep-def)
                                      ((:definition coerce-string)
                                       member eval-g-base
@@ -347,6 +380,13 @@
       ((g-var &) (g-apply 'coerce (gl-list x 'list)))
       (& nil))))
 
+(defthm deps-of-coerce-list
+  (implies (not (gobj-depends-on k p x))
+           (not (gobj-depends-on k p (coerce-list x hyp))))
+  :hints (("goal" :induct  (coerce-list x hyp)
+           :expand ((coerce-list x hyp))
+           :in-theory (disable (:d coerce-list)))))
+
 
 ;; (local
 ;;  (defthm gobjectp-coerce-list
@@ -366,15 +406,16 @@
 (encapsulate nil
   (local (in-theory (disable member-equal)))
 
-  (local (defthm stringp-eval-g-base
-           (implies (and (not (general-concretep x))
-                         (not (g-ite-p x))
-                         (not (g-apply-p x))
-                         (not (g-var-p x)))
-                    (not (stringp (eval-g-base x env))))
-           :hints(("Goal" :in-theory (e/d ((:induction eval-g-base)
-                                           general-concretep-def))
-                   :induct (eval-g-base x env)
+  (local (defthm-gobj-flag
+           (defthm stringp-eval-g-base
+             (implies (and (not (general-concretep x))
+                           (not (g-ite-p x))
+                           (not (g-apply-p x))
+                           (not (g-var-p x)))
+                      (not (stringp (eval-g-base x env))))
+             :flag gobj)
+           :skip-others t
+           :hints(("Goal" :in-theory (e/d (general-concretep-def))
                    :expand ((:with eval-g-base (eval-g-base x env)))))))
 
 
@@ -385,7 +426,7 @@
                     (coerce (eval-g-base x env) 'list)))
     :hints(("Goal" :in-theory (e/d* (; (:ruleset g-correct-lemmas)
                                      eval-g-base-general-concrete-obj
-                                     eval-g-base)
+                                     eval-g-base eval-g-base-list)
                                     ((:definition coerce-list)
                                      eval-g-base-alt-def))
             :induct (coerce-list x hyp)
@@ -405,8 +446,8 @@
         (if (zp clk)
             (g-apply 'coerce (gl-list x y))
           (g-if ytest
-                (,gfn x ythen hyp clk)
-                (,gfn x yelse hyp clk))))
+                (,gfn x ythen hyp clk config bvar-db state)
+                (,gfn x yelse hyp clk config bvar-db state))))
        ((g-apply & &)
         (g-apply 'coerce (gl-list x y)))
        ((g-var &)
@@ -425,17 +466,23 @@
  coerce
  :hints `(("Goal" :in-theory (disable ,gfn))))
 
+(def-gobj-dependency-thm coerce
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local
- (defthm eval-g-base-not-equal-list
-   (implies (and (not (general-concretep y))
-                 (not (g-ite-p y))
-                 (not (g-apply-p y))
-                 (not (g-var-p y)))
-            (not (equal (eval-g-base y env) 'list)))
-   :hints(("Goal" :in-theory (e/d ((:induction eval-g-base)
-                                   general-concretep-def)
+ (defthm-gobj-flag
+   (defthm eval-g-base-not-equal-list
+     (implies (and (not (general-concretep y))
+                   (not (g-ite-p y))
+                   (not (g-apply-p y))
+                   (not (g-var-p y)))
+              (not (equal (eval-g-base y env) 'list)))
+     :flag gobj)
+   :skip-others t
+   :hints(("Goal" :in-theory (e/d (general-concretep-def)
                                   (eval-g-base-alt-def))
-           :induct (eval-g-base y env)
            :expand ((:with eval-g-base (eval-g-base y env)))))))
 
 
@@ -462,8 +509,8 @@
                                      ; eval-g-base-g-apply-p
                                      eval-g-base-alt-def
                                      eval-g-base-not-equal-list))
-            :induct (,gfn x y hyp clk)
-            :expand ((,gfn x y hyp clk)))
+            :induct ,gcall
+            :expand (,gcall))
            (and stable-under-simplificationp
                 '(:in-theory (enable general-concrete-obj-correct
                                      eval-g-base-not-equal-list)))))
diff -Nru acl2-6.2/books/centaur/gl/g-cons.lisp acl2-6.3/books/centaur/gl/g-cons.lisp
--- acl2-6.2/books/centaur/gl/g-cons.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-cons.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,11 +1,28 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
-(local (include-book "eval-g-base-help"))
 (include-book "eval-g-base")
+(local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
 
 (def-g-fn cdr
@@ -15,7 +32,8 @@
        ((g-ite test then else)
         (if (zp clk)
             (g-apply 'cdr (gl-list x))
-          (g-if test (,gfn then hyp clk) (,gfn else hyp clk))))
+          (g-if test (,gfn then . ,params)
+                (,gfn else . ,params))))
        ((g-boolean &) nil)
        ((g-number &) nil)
        ((g-apply & &) (g-apply 'cdr (gl-list x)))
@@ -32,11 +50,17 @@
  cdr
  :hints `(("goal" :in-theory (disable ,gfn))))
 
+(def-gobj-dependency-thm cdr
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
+
 (def-g-correct-thm cdr eval-g-base
   :hints `(("goal" :in-theory (e/d (eval-g-base general-concrete-obj)
                                    ((:definition ,gfn)))
-            :induct (,gfn x hyp clk)
-            :expand ((,gfn x hyp clk)))))
+            :induct (,gfn x . ,params)
+            :expand ((,gfn x . ,params)))))
 
 
 (def-g-fn car
@@ -46,7 +70,7 @@
        ((g-ite test then else)
         (if (zp clk)
             (g-apply 'car (gl-list x))
-          (g-if test (,gfn then hyp clk) (,gfn else hyp clk))))
+          (g-if test (,gfn then . ,params) (,gfn else . ,params))))
        ((g-boolean &) nil)
        ((g-number &) nil)
        ((g-apply & &) (g-apply 'car (gl-list x)))
@@ -56,18 +80,23 @@
 
 ;; (def-gobjectp-thm car
 ;;   :hints `(("goal" :in-theory (disable (:definition ,gfn))
-;;             :induct (,gfn x hyp clk)
-;;             :expand ((,gfn x hyp clk)))))
+;;             :induct (,gfn x . ,params)
+;;             :expand ((,gfn x . ,params)))))
 
 (verify-g-guards
  car
  :hints `(("goal" :in-theory (disable ,gfn))))
 
+(def-gobj-dependency-thm car
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (def-g-correct-thm car eval-g-base
   :hints `(("goal" :in-theory (e/d (eval-g-base general-concrete-obj)
                                    ((:definition ,gfn)))
-            :induct (,gfn x hyp clk)
-            :expand ((,gfn x hyp clk)))))
+            :induct (,gfn x . ,params)
+            :expand ((,gfn x . ,params)))))
 
 
 
@@ -78,4 +107,6 @@
 
 (verify-g-guards cons)
 
+(def-gobj-dependency-thm cons)
+
 (def-g-correct-thm cons eval-g-base)
diff -Nru acl2-6.2/books/centaur/gl/g-equal.lisp acl2-6.3/books/centaur/gl/g-equal.lisp
--- acl2-6.2/books/centaur/gl/g-equal.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-equal.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,33 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-(set-inhibit-warnings "theory")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
-(local (include-book "eval-g-base-help"))
 (include-book "eval-g-base")
-; (include-book "tools/with-arith5-help" :dir :system)
+(local (include-book "eval-g-base-help"))
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "hyp-fix-logic"))
+(local (include-book "var-bounds"))
+(set-inhibit-warnings "theory")
 
 (local (defthm eval-g-base-apply-of-equal
          (equal (eval-g-base-ev (cons 'equal (kwote-lst (list x y))) a)
@@ -85,12 +102,12 @@
         (general-number-components a))
        ((mv brn brd bin bid)
         (general-number-components b)))
-    (g-if (mk-g-boolean (bfr-and (=-uu ard brd)
-                               (=-uu aid bid)))
-          (mk-g-boolean (bfr-and (bfr-or (=-uu nil ard)
-                                     (=-ss arn brn))
-                               (bfr-or (=-uu nil aid)
-                                     (=-ss ain bin))))
+    (g-if (mk-g-boolean (bfr-and (bfr-=-uu ard brd)
+                               (bfr-=-uu aid bid)))
+          (mk-g-boolean (bfr-and (bfr-or (bfr-=-uu nil ard)
+                                     (bfr-=-ss arn brn))
+                               (bfr-or (bfr-=-uu nil aid)
+                                     (bfr-=-ss ain bin))))
           (g-apply 'equal (gl-list a b)))))
 
 
@@ -106,8 +123,16 @@
                  (e/d* ((:ruleset general-object-possibilities)
                         boolean-list-bfr-eval-list))))))
 
+(local (defthm dependencies-of-equal-of-numbers
+         (implies (and (not (gobj-depends-on k p a))
+                       (not (gobj-depends-on k p b))
+                       (general-numberp a)
+                       (general-numberp b))
+                  (not (gobj-depends-on k p (equal-of-numbers a b hyp))))))
+
 (in-theory (Disable equal-of-numbers))
 
+
 (def-g-fn equal
   ;; Once we've ruled out the case where they're both atoms, start by recurring
   ;; down to non-ITEs on both a and b:
@@ -115,10 +140,28 @@
      (cond ((hqual a b) t)
            ((and (general-concretep a) (general-concretep b))
             (hons-equal (general-concrete-obj a) (general-concrete-obj b)))
+           ((and (consp a) (eq (tag a) :g-ite))
+            (if (zp clk)
+                (g-apply 'equal (gl-list a b))
+              (let* ((test (g-ite->test a))
+                     (then (g-ite->then a))
+                     (else (g-ite->else a)))
+                (g-if test
+                      (,gfn then b hyp clk config bvar-db state)
+                      (,gfn else b hyp clk config bvar-db state)))))
+           ((and (consp b) (eq (tag b) :g-ite))
+            (if (zp clk)
+                (g-apply 'equal (gl-list a b))
+              (let* ((test (g-ite->test b))
+                     (then (g-ite->then b))
+                     (else (g-ite->else b)))
+                (g-if test
+                      (,gfn a then hyp clk config bvar-db state)
+                      (,gfn a else hyp clk config bvar-db state)))))
            ((or (atom a)
-                (not (member-eq (tag a) '(:g-ite :g-var :g-apply))))
+                (not (member-eq (tag a) '(:g-var :g-apply))))
             (cond ((or (atom b)
-                       (not (member-eq (tag b) '(:g-ite :g-var :g-apply))))
+                       (not (member-eq (tag b) '(:g-var :g-apply))))
                    (cond ((general-booleanp a)
                           (and (general-booleanp b)
                                (mk-g-boolean (bfr-iff (general-boolean-value a)
@@ -130,31 +173,13 @@
                           (and (general-consp b)
                                (g-if (,gfn (general-consp-car a)
                                            (general-consp-car b)
-                                           hyp clk)
+                                           hyp clk config bvar-db state)
                                      (,gfn (general-consp-cdr a)
                                            (general-consp-cdr b)
-                                           hyp clk)
+                                           hyp clk config bvar-db state)
                                      nil)))
                          (t nil)))
-                  ((eq (tag b) :g-ite)
-                   (if (zp clk)
-                       (g-apply 'equal (gl-list a b))
-                     (let* ((test (g-ite->test b))
-                            (then (g-ite->then b))
-                            (else (g-ite->else b)))
-                       (g-if test
-                             (,gfn a then hyp clk)
-                             (,gfn a else hyp clk)))))
                   (t (g-apply 'equal (gl-list a b)))))
-           ((eq (tag a) :g-ite)
-            (if (zp clk)
-                (g-apply 'equal (gl-list a b))
-              (let* ((test (g-ite->test a))
-                     (then (g-ite->then a))
-                     (else (g-ite->else a)))
-                (g-if test
-                      (,gfn then b hyp clk)
-                      (,gfn else b hyp clk)))))
            (t (g-apply 'equal (gl-list a b))))))
 
 ;; (cond ((and (general-concretep a) (general-concretep b))
@@ -164,20 +189,20 @@
 ;;            (t (pattern-match a
 ;;                 ((g-ite test then else)
 ;;                  (g-if test
-;;                        (,gfn then b hyp clk)
-;;                        (,gfn else b hyp clk)))
+;;                        (,gfn then b hyp clk config bvar-db state)
+;;                        (,gfn else b hyp clk config bvar-db state)))
 ;;                 (& (pattern-match b
 ;;                      ((g-ite test then else)
 ;;                       (g-if test
-;;                             (,gfn a then hyp clk)
-;;                             (,gfn a else hyp clk)))
+;;                             (,gfn a then hyp clk config bvar-db state)
+;;                             (,gfn a else hyp clk config bvar-db state)))
 ;;                      ((g-var &)
 ;;                       (or (equal a b)
 ;;                           (g-apply 'equal (gl-list a b))))
 ;;                      ((g-apply fn args)
 ;;                       (pattern-match a
 ;;                         ((g-apply !fn aargs)
-;;                          (g-if (,gfn args aargs hyp clk)
+;;                          (g-if (,gfn args aargs hyp clk config bvar-db state)
 ;;                                t
 ;;                                (g-apply 'equal (gl-list a b))))
 ;;                         (& (g-apply 'equal (gl-list a b)))))
@@ -199,10 +224,10 @@
 ;;                                (if (general-consp b)
 ;;                                    (g-if (,gfn (general-consp-car a)
 ;;                                                (general-consp-car b)
-;;                                                hyp clk)
+;;                                                hyp clk config bvar-db state)
 ;;                                          (,gfn (general-consp-cdr a)
 ;;                                                (general-consp-cdr b)
-;;                                                hyp clk)
+;;                                                hyp clk config bvar-db state)
 ;;                                          nil)
 ;;                                  nil))
 ;;                               (t nil))))))))))))
@@ -227,9 +252,9 @@
 ;;                                      (:rules-of-class :type-prescription :here)
 ;;                                      (:ruleset gl-wrong-tag-rewrites)
 ;;                                      (:ruleset gl-tag-forward)))
-;;             :induct (,gfn x y hyp clk)
-;;             :expand ((,gfn x y hyp clk)
-;;                      (,gfn x x hyp clk)))
+;;             :induct (,gfn x y hyp clk config bvar-db state)
+;;             :expand ((,gfn x y hyp clk config bvar-db state)
+;;                      (,gfn x x hyp clk config bvar-db state)))
 ;;            (and stable-under-simplificationp
 ;;                 '(:in-theory (e/d* (booleanp-gobjectp)
 ;;                                     ((:definition ,gfn)
@@ -258,7 +283,7 @@
                            (:type-prescription general-booleanp)
                            (:type-prescription general-numberp)
                            (:type-prescription general-concretep)
-                           (:type-prescription =-uu)
+                           (:type-prescription bfr-=-uu)
                            hyp-fix-of-hyp-fixedp
                            (:meta mv-nth-cons-meta)
                            zp-open default-<-2 default-<-1
@@ -279,12 +304,31 @@
 
 (local (include-book "clause-processors/just-expand" :dir :System))
 
+
+
+(def-gobj-dependency-thm equal
+    :hints `((acl2::just-induct-and-expand
+              (,gfn x y hyp clk config bvar-db state))
+             '(:in-theory (disable ,gfn))
+             (and stable-under-simplificationp
+                  `(:expand ((,',gfn x y hyp clk config bvar-db state)
+                             (,',gfn x x hyp clk config bvar-db state)
+                             (,',gfn x y hyp clk config bvar-db state)
+                             (,',gfn x x hyp clk config bvar-db state)
+                             (eval-g-base x env)
+                             (eval-g-base y env)
+                             (eval-g-base nil env)
+                             (eval-g-base-list nil env)
+                             (eval-g-base t env))
+                    :do-not-induct t))))
+
+
 (encapsulate nil
 
   (local
    (in-theory (e/d** (
                       possibilities-for-x-1
-                      
+
                       possibilities-for-x-2
                       possibilities-for-x-3
                       possibilities-for-x-4
@@ -301,7 +345,11 @@
                       mk-g-boolean-correct-for-eval-g-base
                       geval-g-if-marker-eval-g-base
                       geval-g-or-marker-eval-g-base
-                      
+
+                      gobj-depends-on-of-g-apply
+                      gobj-depends-on-of-gl-cons
+                      gobj-list-depends-on-of-gl-cons
+
                       general-concretep-not-general-consp
                       general-concretep-not-general-booleanp
                       general-concretep-not-general-numberp
@@ -317,14 +365,13 @@
                       booleanp-compound-recognizer
 
                       gtests-g-test-marker
-                      
+
                       bfr-eval-bfr-binary-and
                       bfr-eval-bfr-not
                       bfr-eval-bfr-binary-or
                       bfr-eval-booleanp
                       gtests-nonnil-correct-for-eval-g-base
                       hyp-fix-correct
-                      (:type-prescription v2i)
                       bfr-eval-g-hyp-marker
 
                       cons-equal
@@ -332,32 +379,35 @@
                       bfr-eval-bfr-iff
                       equal-of-numbers-correct
                       general-numberp-of-atom
-                      
+
+                      eval-g-base-list-of-gl-cons
                       hons-equal
                       general-concrete-obj-of-atomic-constants
                       general-concretep-of-atomic-constants)
                      ((general-concrete-obj)
-                      (general-concretep)))))
+                      (general-concretep)
+                      (kwote-lst)))))
 
   (local
    (make-event
     `(in-theory
       (enable (:induction ,(gl-fnsym 'equal))))))
 
-  
 
 
-  (def-g-correct-thm equal eval-g-base
+
+    (def-g-correct-thm equal eval-g-base
     :hints `((acl2::just-induct-and-expand
-              (,gfn x y hyp clk))
+              (,gfn x y hyp clk config bvar-db state))
              (and stable-under-simplificationp
-                  `(:expand ((,',gfn x y hyp clk)
-                             (,',gfn x x hyp clk)
-                             (,',gfn x y hyp clk)
-                             (,',gfn x x hyp clk)
+                  `(:expand ((,',gfn x y hyp clk config bvar-db state)
+                             (,',gfn x x hyp clk config bvar-db state)
+                             (,',gfn x y hyp clk config bvar-db state)
+                             (,',gfn x x hyp clk config bvar-db state)
                              (eval-g-base x env)
                              (eval-g-base y env)
                              (eval-g-base nil env)
+                             (eval-g-base-list nil env)
                              (eval-g-base t env))
                     :do-not-induct t))
              ;; (case-match id
@@ -372,7 +422,7 @@
              ;;                   possibilities-for-x-7
              ;;                   possibilities-for-x-8
              ;;                   possibilities-for-x-9)
-             ;;          :expand ((,',gfn x y hyp clk)
+             ;;          :expand ((,',gfn x y hyp clk config bvar-db state)
              ;;                   (eval-g-base ,(if (eql n 3) 'x 'y) env)
              ;;                   (eval-g-base nil env)
              ;;                   (eval-g-base t env)))
diff -Nru acl2-6.2/books/centaur/gl/g-floor.lisp acl2-6.3/books/centaur/gl/g-floor.lisp
--- acl2-6.2/books/centaur/gl/g-floor.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-floor.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,15 +1,31 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
 
 (defun g-floor-of-numbers (x y)
   (declare (xargs :guard (and (general-numberp x)
@@ -18,17 +34,24 @@
         (general-number-components x))
        ((mv yrn yrd yin yid)
         (general-number-components y)))
-    (if (and (eq (=-uu xrd '(t)) t)
-             (eq (=-uu yrd '(t)) t)
-             (eq (bfr-or (=-ss xin nil)
-                       (=-uu xid nil)) t)
-             (eq (bfr-or (=-ss yin nil)
-                       (=-uu yid nil)) t))
-        (mk-g-number (rlist-fix (floor-ss xrn yrn)))
+    (if (and (eq (bfr-=-uu xrd '(t)) t)
+             (eq (bfr-=-uu yrd '(t)) t)
+             (eq (bfr-or (bfr-=-ss xin nil)
+                       (bfr-=-uu xid nil)) t)
+             (eq (bfr-or (bfr-=-ss yin nil)
+                       (bfr-=-uu yid nil)) t))
+        (mk-g-number (rlist-fix (bfr-floor-ss xrn yrn)))
       (g-apply 'floor (gl-list x y)))))
 
 (in-theory (disable (g-floor-of-numbers)))
 
+(defthm deps-of-g-floor-of-numbers
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-floor-of-numbers x y)))))
+
 ;; (local
 ;;  (defthm gobjectp-g-floor-of-numbers
 ;;    (implies (and (gobjectp x)
@@ -39,14 +62,14 @@
 
 (local (include-book "arithmetic/top-with-meta" :dir :system))
 
-;; (local (defthm not-integerp-floor-ss
+;; (local (defthm not-integerp-bfr-floor-ss
 ;;          (implies (and (bfr-listp a) (bfr-listp b))
-;;                   (not (integerp (floor-ss a b))))
-;;          :hints (("goal" :use ((:instance bfr-listp-floor-ss))
-;;                   :in-theory (e/d (bfr-listp) (bfr-listp-floor-ss))))))
+;;                   (not (integerp (bfr-floor-ss a b))))
+;;          :hints (("goal" :use ((:instance bfr-listp-bfr-floor-ss))
+;;                   :in-theory (e/d (bfr-listp) (bfr-listp-bfr-floor-ss))))))
 
-(local (add-bfr-fn-pat =-uu))
-(local (add-bfr-fn-pat =-ss))
+(local (add-bfr-fn-pat bfr-=-uu))
+(local (add-bfr-fn-pat bfr-=-ss))
 
 (local
  (defthm g-floor-of-numbers-correct
@@ -83,17 +106,22 @@
 ;;                                      gobj-fix-when-gobjectp
 ;;                                      (:rules-of-class :type-prescription :here)
 ;;                                      (:ruleset gl-wrong-tag-rewrites)))
-;;             :induct (,gfn i j hyp clk)
+;;             :induct (,gfn i j . ,params)
 ;;             :do-not-induct t
-;;             :expand ((,gfn i j hyp clk)
+;;             :expand ((,gfn i j . ,params)
 ;;                      (gobjectp (floor (gobj-fix i) (gobj-fix j)))))))
 
 (verify-g-guards
  floor
  :hints `(("goal" :in-theory
-           (disable* ,gfn 
+           (disable* ,gfn
                      (:rules-of-class :type-prescription :here)))))
 
+(def-gobj-dependency-thm floor
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local (defthm floor-when-not-numberp
          (and (implies (not (acl2-numberp i))
                        (equal (floor i j) (floor 0 j)))
@@ -112,19 +140,18 @@
                               general-consp-cdr-correct-for-eval-g-base
                               boolean-listp
                               components-to-number-alt-def
-                              member-equal 
+                              member-equal
                               general-number-components-ev
                               general-concretep-def
-                              v2n-is-v2i-when-sign-nil
                               general-concretep-def
                               floor
                               hons-assoc-equal
                               rationalp-implies-acl2-numberp
                               (:rules-of-class :type-prescription :here))
                              ((:type-prescription bfr-eval)))
-     :induct (,gfn i j hyp clk)
+     :induct (,gfn i j . ,params)
      :do-not-induct t
-     :expand ((,gfn i j hyp clk)))
+     :expand ((,gfn i j . ,params)))
     (and stable-under-simplificationp
          (flag::expand-calls-computed-hint
           clause '(eval-g-base)))))
diff -Nru acl2-6.2/books/centaur/gl/g-gl-mbe.lisp acl2-6.3/books/centaur/gl/g-gl-mbe.lisp
--- acl2-6.2/books/centaur/gl/g-gl-mbe.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-gl-mbe.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 (include-book "bfr-sat")
@@ -15,7 +34,7 @@
 
 
 (def-g-fn gl-mbe
-  `(b* ((equal? (glr acl2::always-equal spec impl hyp clk))
+  `(b* ((equal? (glr acl2::always-equal spec impl . ,params))
         (tests (gtests equal? hyp))
         (false (bfr-and hyp
                         (bfr-not (gtests-unknown tests))
@@ -23,8 +42,15 @@
         ((mv false-sat false-succ ?false-ctrex)
          (bfr-sat false))
         ((when (and false-sat false-succ))
+         (make-fast-alist false-ctrex)
          ;; (acl2::sneaky-save 'gl-mbe-ctrex false-ctrex)
-         (er hard? 'gl-mbe "GL-MBE assertion failed. Ctrex: ~x0" false-ctrex)
+         (er hard? 'gl-mbe "GL-MBE assertion failed. Ctrex: ~x0 Args: ~x1 ~
+                            ~x2. Other: ~x3~%"
+             false-ctrex
+             ;; BOZO this is all assuming aig/alist-ctrex mode
+             (gobj->term spec (list false-ctrex))
+             (gobj->term impl (list false-ctrex))
+             (gobj->term other-info (list false-ctrex)))
          spec)
         ((when (not false-succ))
          (er hard? 'gl-mbe "GL-MBE assertion failed to prove.")
@@ -58,6 +84,11 @@
                 (instantiate-bfr-sat-hint (cdr clause) env)))
          (& (instantiate-bfr-sat-hint (cdr clause) env)))))))
 
+(def-gobj-dependency-thm gl-mbe
+  :hints `(("goal"
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (def-g-correct-thm gl-mbe eval-g-base
   :hints '(("goal" :do-not-induct t
             :in-theory (disable bfr-sat-unsat))
diff -Nru acl2-6.2/books/centaur/gl/g-hide.lisp acl2-6.3/books/centaur/gl/g-hide.lisp
--- acl2-6.2/books/centaur/gl/g-hide.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-hide.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,10 +1,27 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-; (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "eval-g-base")
+(include-book "gtypes")
 (local (include-book "gobjectp-thms"))
 
 (def-g-fn hide 'x)
@@ -17,6 +34,10 @@
 
 (verify-g-guards hide)
 
+(def-gobj-dependency-thm hide
+  :hints `(("goal"
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
 
 (def-g-correct-thm hide eval-g-base
   :hints `(("Goal" :in-theory '(hide-open ,gfn))))
diff -Nru acl2-6.2/books/centaur/gl/g-if.lisp acl2-6.3/books/centaur/gl/g-if.lisp
--- acl2-6.2/books/centaur/gl/g-if.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-if.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,7 +1,24 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "ite-merge")
 (include-book "gtests")
 
@@ -32,7 +49,7 @@
 
 (defmacro def-g-identity (name top-p)
   (def-g-identity-fn name top-p))
-          
+
 
 (def-g-identity g-if-marker t)
 (def-g-identity g-or-marker t)
@@ -47,6 +64,10 @@
   (equal (bfr-eval (g-hyp-marker x) env)
          (bfr-eval x env)))
 
+(defthm pbfr-depends-on-of-g-hyp-marker
+  (equal (pbfr-depends-on n p (g-hyp-marker x))
+         (pbfr-depends-on n p x)))
+
 (in-theory (disable g-hyp-marker (:t g-hyp-marker)
                     (g-hyp-marker)))
 
@@ -79,13 +100,14 @@
            (and (hide else-hyp)
                 (let ((hyp else-hyp))
                   (declare (ignorable hyp))
-                  (g-branch-marker$inline ,else))))
-          (merge (gobj-ite-merge (gtests-nonnil gtests) then else
-                                 (bfr-and (bfr-not (gtests-unknown gtests))
-                                                  hyp))))
+                  (g-branch-marker$inline ,else)))))
        (mk-g-bdd-ite (gtests-unknown gtests)
                      (mk-g-ite (gtests-obj gtests) then else)
-                     merge hyp)))))
+                     (gobj-ite-merge (gtests-nonnil gtests)
+                                     then else
+                                     (bfr-and (bfr-not (gtests-unknown gtests))
+                                              hyp))
+                     hyp)))))
 
 (defmacro g-or (test else)
   `(g-or-marker$inline
@@ -101,10 +123,10 @@
            (and (hide else-hyp)
                 (let ((hyp else-hyp))
                   (declare (ignorable hyp))
-                  (g-branch-marker$inline ,else))))
-          (merge (gobj-ite-merge (gtests-nonnil gtests) test else
-                                 (bfr-and (bfr-not (gtests-unknown gtests))
-                                                  hyp))))
+                  (g-branch-marker$inline ,else)))))
        (mk-g-bdd-ite (gtests-unknown gtests)
                      (mk-g-ite (gtests-obj gtests) test else)
-                     merge hyp)))))
+                     (gobj-ite-merge (gtests-nonnil gtests) test else
+                                 (bfr-and (bfr-not (gtests-unknown gtests))
+                                                  hyp))
+                     hyp)))))
diff -Nru acl2-6.2/books/centaur/gl/g-integer-length.lisp acl2-6.3/books/centaur/gl/g-integer-length.lisp
--- acl2-6.2/books/centaur/gl/g-integer-length.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-integer-length.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,18 +1,43 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-(set-inhibit-warnings "theory")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
- 
+(set-inhibit-warnings "theory")
+
+;; (defthm true-listp-of-bfr-integer-length-s1
+;;   (true-listp (mv-nth 1 (bfr-integer-length-s1 offset x)))
+;;   :hints(("Goal" :in-theory (enable bfr-integer-length-s1)))
+;;   :rule-classes :type-prescription)
+
+;; (defthm true-listp-of-bfr-integer-length-s
+;;   (true-listp (bfr-integer-length-s x))
+;;   :hints(("Goal" :in-theory (enable bfr-integer-length-s)))
+;;   :rule-classes :type-prescription)
+
 
 (def-g-fn integer-length
   `(let ((x i))
@@ -23,8 +48,8 @@
           (if (zp clk)
               (g-apply 'integer-length (gl-list x))
             (g-if test
-                  (,gfn then hyp clk)
-                  (,gfn else hyp clk))))
+                  (,gfn then . ,params)
+                  (,gfn else . ,params))))
          ((g-apply & &)
           (g-apply 'integer-length (gl-list x)))
          ((g-var &)
@@ -34,10 +59,10 @@
          ((g-number num)
           (mv-let (arn ard ain aid)
             (break-g-number num)
-            (g-if (mk-g-boolean (hyp-fix (bfr-or (=-uu aid nil)
-                                               (=-ss ain nil)) hyp))
+            (g-if (mk-g-boolean (hyp-fix (bfr-or (bfr-=-uu aid nil)
+                                               (bfr-=-ss ain nil)) hyp))
                   (g-if (equal ard '(t))
-                        (let ((res (integer-length-s arn)))
+                        (let ((res (rlist-fix (bfr-integer-length-s arn))))
                           (mk-g-number res 1 0 1))
                         (g-apply 'integer-length (gl-list x)))
                   0)))
@@ -55,14 +80,19 @@
 ;; (def-gobjectp-thm integer-length
 ;;   :hints `(("Goal" :in-theory (e/d ()
 ;;                                  ((:definition ,gfn)))
-;;           :induct (,gfn i hyp clk)
-;;           :expand ((,gfn i hyp clk)))))
+;;           :induct (,gfn i . ,params)
+;;           :expand ((,gfn i . ,params)))))
 
 (verify-g-guards
  integer-length
  :hints `(("Goal" :in-theory (disable ,gfn))))
 
 
+(def-gobj-dependency-thm integer-length
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 
 (local (defthm non-integerp-integer-length
          (implies (not (integerp x))
@@ -92,7 +122,7 @@
                                     general-concretep-def
                                     eval-g-base-alt-def
                                     integer-length))
-            :induct (,gfn i hyp clk)
-            :expand ((,gfn i hyp clk)))
+            :induct (,gfn i . ,params)
+            :expand ((,gfn i . ,params)))
            (and stable-under-simplificationp
                 '(:expand ((:with eval-g-base (eval-g-base i env)))))))
diff -Nru acl2-6.2/books/centaur/gl/g-intern.lisp acl2-6.3/books/centaur/gl/g-intern.lisp
--- acl2-6.2/books/centaur/gl/g-intern.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-intern.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,12 +1,28 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-primitives-help")
 (include-book "eval-g-base")
-(local (include-book "eval-g-base-help"))
 (include-book "g-if")
-
+(local (include-book "eval-g-base-help"))
 (local (in-theory (enable general-concretep-atom)))
 
 (def-g-binary-op intern-in-package-of-symbol
@@ -30,6 +46,11 @@
 (verify-g-guards intern-in-package-of-symbol
                  :hints `(("Goal" :in-theory (disable ,gfn))))
 
+(def-gobj-dependency-thm intern-in-package-of-symbol
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local
  (progn
    ;; (defthm gobjectp-not-g-keyword-symbolp
@@ -70,20 +91,22 @@
     mk-g-ite-correct
     ((generic-geval-ev eval-g-base-ev)
      (generic-geval-ev-lst eval-g-base-ev-lst)
-     (generic-geval eval-g-base))
- :hints ('(:in-theory (e/d* (eval-g-base-ev-constraint-0
+     (generic-geval eval-g-base)
+     (generic-geval-list eval-g-base-list))
+ :hints ('(:in-theory (e/d* (eval-g-base-ev-of-fncall-args
                              eval-g-base-apply-agrees-with-eval-g-base-ev)
                             (eval-g-base-apply))
-           :expand ((:with eval-g-base (eval-g-base x env))))))))
+           :expand ((:with eval-g-base (eval-g-base x env))
+                    (eval-g-base-list x env)))))))
 
 
 (def-g-correct-thm intern-in-package-of-symbol eval-g-base
-  :hints `(("goal" :induct (,gfn acl2::str acl2::sym hyp clk)
+  :hints `(("goal" :induct (,gfn acl2::str acl2::sym . ,params)
             :in-theory (e/d (general-concrete-obj)
                             ((:definition ,gfn)
                              bfr-eval-list
                              eval-g-base-alt-def))
-            :expand ((,gfn acl2::str acl2::sym hyp clk)
+            :expand ((,gfn acl2::str acl2::sym . ,params)
                      (:with eval-g-base (eval-g-base nil env))))
            (and stable-under-simplificationp
                 '(:expand ((:with eval-g-base
diff -Nru acl2-6.2/books/centaur/gl/g-lessthan.lisp acl2-6.3/books/centaur/gl/g-lessthan.lisp
--- acl2-6.2/books/centaur/gl/g-lessthan.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-lessthan.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,31 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
-
 
 (defun g-<-of-numbers (a b)
   (declare (xargs :guard (and (general-numberp a)
@@ -19,23 +34,70 @@
         (general-number-components a))
        ((mv brn brd bin bid)
         (general-number-components b)))
-    
+
     (if (and (equal ard brd)
              (equal aid bid))
-        (b* (((mv r< r=) (<-=-ss arn brn)))
+        (b* (((mv r< r=) (bfr-<-=-ss arn brn)))
           (mk-g-boolean
-           (bfr-ite (=-uu ard nil)
-                  (bfr-and (bfr-not (=-uu aid nil))
-                         (<-ss ain bin))
+           (bfr-ite (bfr-=-uu ard nil)
+                  (bfr-and (bfr-not (bfr-=-uu aid nil))
+                         (bfr-<-ss ain bin))
                   (bfr-or r<
                         (bfr-and r=
-                               (bfr-not (=-uu aid nil))
-                               (<-ss ain bin))))))
+                               (bfr-not (bfr-=-uu aid nil))
+                               (bfr-<-ss ain bin))))))
       (g-apply '< (gl-list a b)))))
 
+(defthm deps-of-g-<-of-numbers
+  (implies (and (not (gobj-depends-on k p a))
+                (not (gobj-depends-on k p b))
+                (general-numberp a)
+                (general-numberp b))
+           (not (gobj-depends-on k p (g-<-of-numbers a b)))))
+
 (in-theory (disable (g-<-of-numbers)))
 
 (local
+ (encapsulate nil
+   (local
+    (defthm rationalp-complex
+      (equal (rationalp (complex a b))
+             (equal (rfix b) 0))
+      :hints (("goal" :use ((:instance
+                             (:theorem (implies (rationalp x)
+                                                (equal (imagpart x) 0)))
+                             (x (complex a b))))))))
+
+
+   (defthm realpart-of-complex
+     (equal (realpart (complex a b))
+            (rfix a))
+     :hints (("goal" :cases ((rationalp b)))))
+
+   (defthm imagpart-of-complex
+     (equal (imagpart (complex a b))
+            (rfix b))
+     :hints (("goal" :cases ((rationalp a)))))
+
+
+   (defthm complex-<-1
+     (equal (< (complex a b) c)
+            (or (< (rfix a) (realpart c))
+                (and (equal (rfix a) (realpart c))
+                     (< (rfix b) (imagpart c)))))
+     :hints (("goal" :use ((:instance completion-of-<
+                            (x (complex a b)) (y c))))))
+
+
+   (defthm complex-<-2
+     (equal (< a (complex b c))
+            (or (< (realpart a) (rfix b))
+                (and (equal (realpart a) (rfix b))
+                     (< (imagpart a) (rfix c)))))
+     :hints (("goal" :use ((:instance completion-of-<
+                            (x a) (y (complex b c)))))))))
+
+(local
  (progn
    ;; (defthm gobjectp-g-<-of-numbers
    ;;   (implies (and (gobjectp a)
@@ -80,6 +142,11 @@
 (verify-g-guards
  < :hints `(("Goal" :in-theory (disable* ,gfn general-concretep-def))))
 
+(def-gobj-dependency-thm <
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 
 (def-g-correct-thm < eval-g-base
   :hints `(("Goal" :in-theory (e/d* ((:ruleset general-object-possibilities)
@@ -91,9 +158,8 @@
                                      components-to-number-alt-def
                                      eval-g-base-non-cons
                                      acl2::/r-when-abs-numerator=1
-                                     v2n-is-v2i-when-sign-nil
                                      default-unary-/
-                                     s-sign-correct default-car default-cdr
+                                     default-car default-cdr
                                      hons-assoc-equal))
-            :induct (,gfn x y hyp clk)
-            :expand ((,gfn x y hyp clk)))))
+            :induct ,gcall
+            :expand (,gcall))))
diff -Nru acl2-6.2/books/centaur/gl/g-logand.lisp acl2-6.3/books/centaur/gl/g-logand.lisp
--- acl2-6.2/books/centaur/gl/g-logand.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-logand.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,31 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
-
 
 (defun g-binary-logand-of-numbers (x y)
   (declare (xargs :guard (and (general-numberp x)
@@ -21,23 +36,30 @@
         (general-number-components y))
        ((mv xintp xintp-known)
         (if (equal xrd '(t))
-            (mv (bfr-or (=-ss xin nil)
-                      (=-uu xid nil)) t)
+            (mv (bfr-or (bfr-=-ss xin nil)
+                      (bfr-=-uu xid nil)) t)
           (mv nil nil)))
        ((mv yintp yintp-known)
         (if (equal yrd '(t))
-            (mv (bfr-or (=-ss yin nil)
-                      (=-uu yid nil)) t)
+            (mv (bfr-or (bfr-=-ss yin nil)
+                      (bfr-=-uu yid nil)) t)
           (mv nil nil))))
     (if (and xintp-known yintp-known)
         (mk-g-number
-         (logand-ss (bfr-ite-bss-fn xintp xrn nil)
+         (bfr-logand-ss (bfr-ite-bss-fn xintp xrn nil)
                     (bfr-ite-bss-fn yintp yrn nil)))
       (g-apply 'binary-logand (gl-list x y)))))
 
 (in-theory (disable (g-binary-logand-of-numbers)))
 
 
+(defthm deps-of-g-binary-logand-of-numbers
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-binary-logand-of-numbers x y)))))
+
 (local (defthm logand-non-integers
          (and (implies (not (integerp i))
                        (equal (logand i j) (logand 0 j)))
@@ -84,8 +106,8 @@
 ;;                                      gobj-fix-when-gobjectp
 ;;                                      (:ruleset gl-wrong-tag-rewrites)
 ;;                                      (:rules-of-class :type-prescription :here)))
-;;             :induct (,gfn i j hyp clk)
-;;             :expand ((,gfn i j hyp clk)
+;;             :induct (,gfn i j . ,params)
+;;             :expand ((,gfn i j . ,params)
 ;;                      (gobjectp (logand (gobj-fix i)
 ;;                                        (gobj-fix j)))))))
 
@@ -94,6 +116,11 @@
  :hints `(("Goal" :in-theory (disable* ,gfn
                                        general-concretep-def))))
 
+(def-gobj-dependency-thm binary-logand
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local (defthm logand-non-acl2-numbers
          (and (implies (not (acl2-numberp i))
                        (equal (logand i j) (logand 0 j)))
@@ -108,11 +135,9 @@
                                      general-concretep-def
                                      binary-logand
                                      components-to-number-alt-def
-                                     v2n-is-v2i-when-sign-nil
-                                     s-sign-correct
                                      hons-assoc-equal
                                      default-car default-cdr
                                      (:rules-of-class :type-prescription :here)))
-            :induct (,gfn i j hyp clk)
+            :induct (,gfn i j . ,params)
             :do-not-induct t
-            :expand ((,gfn i j hyp clk)))))
+            :expand ((,gfn i j . ,params)))))
diff -Nru acl2-6.2/books/centaur/gl/g-logapp.lisp acl2-6.3/books/centaur/gl/g-logapp.lisp
--- acl2-6.2/books/centaur/gl/g-logapp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-logapp.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,640 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "g-if")
+(include-book "g-primitives-help")
+(include-book "symbolic-arithmetic-fns")
+(include-book "eval-g-base")
+(local (include-book "symbolic-arithmetic"))
+(local (include-book "eval-g-base-help"))
+(local (include-book "hyp-fix-logic"))
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+
+(defun s-take (n x)
+  (declare (xargs :guard (natp n)))
+  (b* (((when (zp n)) (bfr-sterm nil))
+       ((mv first rest &) (first/rest/end x)))
+    (bfr-ucons first (s-take (1- n) rest))))
+
+(defthm deps-of-s-take
+  (implies (not (pbfr-list-depends-on k p x))
+           (not (pbfr-list-depends-on k p (s-take n x)))))
+
+
+(defthm s-take-correct
+  (equal (bfr-list->u (s-take n x) env)
+         (loghead n (bfr-list->s x env)))
+  :hints (("goal" :induct (s-take n x)
+           :in-theory (enable* acl2::ihsext-recursive-redefs))))
+
+
+
+;; (local (defthm v2i-of-append
+;;          (implies (consp y)
+;;                   (equal (v2i (append x y))
+;;                          (logapp (len x) (v2n x) (v2i y))))
+;;          :hints (("goal" :induct (append x y)
+;;                   :in-theory (enable* acl2::ihsext-recursive-redefs
+;;                                       v2i v2n)))))
+
+;; (defthm bfr-eval-list-of-append
+;;   (equal (bfr-eval-list (append a b) env)
+;;          (append (bfr-eval-list a env)
+;;                  (bfr-eval-list b env))))
+
+;; (defthm len-of-bfr-eval-list
+;;   (equal (len (bfr-eval-list x env))
+;;          (len x)))
+
+;; (defthm len-of-s-take
+;;   (equal (len (s-take w x))
+;;          (nfix w)))
+
+;; (defun append-us (x y)
+;;   (declare (xargs :guard (true-listp x)))
+;;   (append x (if (consp y) y '(nil))))
+
+;; (defthm append-us-correct
+;;   (equal (bfr-list->s (append-us x y) env)
+;;          (logapp (len x) (bfr-list->u x env)
+;;                  (bfr-list->s y env)))
+;;   :hints(("Goal" :in-theory (enable append-us))))
+
+
+(defun logapp-uss (w n x y)
+  (declare (xargs :measure (len n)
+                  :guard (natp w)))
+  (if (atom n)
+      y
+    (bfr-ite-bss
+     (car n)
+     (bfr-logapp-nus (lnfix w) (s-take w x)
+                 (logapp-uss (ash (lnfix w) 1) (cdr n) (logtail-ns w x)
+                             y))
+     (logapp-uss (ash (lnfix w) 1) (cdr n) x y))))
+
+(defthm deps-of-logapp-uss
+  (implies (and (not (pbfr-list-depends-on k p n))
+                (not (pbfr-list-depends-on k p x))
+                (not (pbfr-list-depends-on k p y)))
+           (not (pbfr-list-depends-on k p (logapp-uss w n x y)))))
+
+(local
+ (progn
+   (defthm logapp-of-logapp
+     (implies (equal w (logapp m y z))
+              (equal (logapp n x w)
+                     (logapp (+ (nfix n) (nfix m)) (logapp n x y) z)))
+     :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                        acl2::ihsext-recursive-redefs)
+             :induct (loghead n x))))
+
+   (defthm logcar-non-integer
+     (implies (not (integerp x))
+              (equal (logcar x) 0))
+     :hints(("Goal" :in-theory (enable logcar)))
+     :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+   (defthm logcdr-non-integer
+     (implies (not (integerp x))
+              (equal (logcdr x) 0))
+     :hints(("Goal" :in-theory (enable logcdr)))
+     :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+   (defthm remake-*-n-w
+     (and (implies (equal (logcar n) 1)
+                   (equal (+ (nfix w) (* 2 (logcdr n) (nfix w)))
+                          (* (ifix n) (nfix w))))
+          (implies (equal (logcar n) 0)
+                   (equal (* 2 (logcdr n) (nfix w))
+                          (* (ifix n) (nfix w)))))
+     :hints(("Goal" :in-theory (e/d (logcons)
+                                    (acl2::logcons-destruct))
+             :use ((:instance acl2::logcar-logcdr-elim
+                    (i n))))))
+
+
+   (defthm logapp-loghead-logtail
+     (equal (logapp n (loghead n x) (logtail n x))
+            (ifix x))
+     :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                        acl2::ihsext-recursive-redefs)
+             :induct (loghead n x))))))
+
+;; (defthm true-listp-append-us
+;;   (implies (true-listp y)
+;;            (true-listp (append-us x y)))
+;;   :hints(("Goal" :in-theory (enable append-us)))
+;;   :rule-classes :type-prescription)
+
+;; (defthm true-listp-logapp-uss
+;;   (implies (true-listp y)
+;;            (true-listp (logapp-uss w n x y)))
+;;   :rule-classes :type-prescription)
+
+;; (defun logapp-uss-conc (w n x y)
+;;   (if (zp n)
+;;       (ifix y)
+;;     (if (equal (logcar n) 1)
+;;         (logapp w (loghead w x)
+;;                 (logapp-uss-conc (* 2 (nfix w)) (logcdr n)
+;;                                  (logtail w x) y))
+;;       (logapp-uss-conc (* 2 (nfix w)) (logcdr n) x y))))
+
+;; (defthm logapp-uss-conc-correct
+;;   (equal (logapp-uss-conc w n x y)
+;;          (logapp (* (nfix w) (nfix n)) x y)))
+
+
+
+
+
+
+;; (local (in-theory (disable append-us)))
+
+
+
+(defthm logapp-uss-correct
+  (equal (bfr-list->s (logapp-uss w n x y) env)
+         (logapp (* (bfr-list->u n env)
+                    (nfix w))
+                 (bfr-list->s x env)
+                 (bfr-list->s y env)))
+  :hints(("Goal" :in-theory (enable acl2::ash** logcons))))
+
+(local (in-theory (disable logapp-uss)))
+
+
+
+(defun g-logapp-of-numbers (n x y)
+  (declare (xargs :guard (and (general-numberp n)
+                              (general-numberp x)
+                              (general-numberp y))))
+  (b* (((mv nrn nrd nin nid)
+        (general-number-components n))
+       ((mv xrn xrd xin xid)
+        (general-number-components x))
+       ((mv yrn yrd yin yid)
+        (general-number-components y))
+       ((mv nintp nintp-known)
+        (if (equal nrd '(t))
+            (mv (bfr-or (bfr-=-ss nin nil)
+                        (bfr-=-uu nid nil)) t)
+          (mv nil nil)))
+       ((mv xintp xintp-known)
+        (if (equal xrd '(t))
+            (mv (bfr-or (bfr-=-ss xin nil)
+                      (bfr-=-uu xid nil)) t)
+          (mv nil nil)))
+       ((mv yintp yintp-known)
+        (if (equal yrd '(t))
+            (mv (bfr-or (bfr-=-ss yin nil)
+                      (bfr-=-uu yid nil)) t)
+          (mv nil nil)))
+       ((unless (and nintp-known xintp-known yintp-known))
+        (g-apply 'logapp (gl-list n x y)))
+       ;; nfix
+       (nbits (bfr-ite-bvv-fn (bfr-and (bfr-not (s-sign nrn)) nintp)
+                              nrn nil))
+       ;; ifix
+       (xbits (bfr-ite-bss-fn xintp xrn nil))
+       (ybits (bfr-ite-bss-fn yintp yrn nil))
+       (resbits (logapp-uss 1 nbits xbits ybits)))
+    (mk-g-number (rlist-fix resbits))))
+
+
+(in-theory (disable (g-logapp-of-numbers)))
+
+(defthm deps-of-g-logapp-of-numbers
+  (implies (and (not (gobj-depends-on k p n))
+                (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp n)
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-logapp-of-numbers n x y)))))
+
+(local (defthm logapp-zp-n
+         (implies (zp n)
+                  (equal (logapp n x y)
+                         (ifix y)))
+         :hints(("Goal" :in-theory (enable acl2::logapp**)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+(local (defthm logapp-zip-x
+         (implies (and (syntaxp (not (equal x ''0)))
+                       (zip x))
+                  (equal (logapp n x y)
+                         (logapp n 0 y)))
+         :hints(("Goal" :in-theory (enable acl2::logapp**)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+(local (defthm logapp-zip-y
+         (implies (and (syntaxp (not (equal y ''0)))
+                       (zip y))
+                  (equal (logapp n x y)
+                         (logapp n x 0)))
+         :hints(("Goal" :in-theory (enable acl2::logapp**)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(local (defthm bfr-list->s-when-gte-0
+         (implies (<= 0 (bfr-list->s x env))
+                  (equal (bfr-list->s x env)
+                         (bfr-list->u x env)))
+         :hints(("Goal" :in-theory (enable scdr s-endp)))))
+
+(defthm g-logapp-of-numbers-correct
+  (implies (and (general-numberp n)
+                (general-numberp x)
+                (general-numberp y))
+           (equal (eval-g-base (g-logapp-of-numbers n x y) env)
+                  (logapp (eval-g-base n env)
+                          (eval-g-base x env)
+                          (eval-g-base y env))))
+  :hints (("goal" :in-theory (e/d* ((:ruleset general-object-possibilities)
+                                    )
+                                   (general-numberp
+                                    bfr-list->s
+                                    general-number-components))
+           :do-not-induct t)))
+
+(in-theory (disable g-logapp-of-numbers))
+
+(def-g-fn logapp
+  `(let ((size acl2::size))
+     (b* (((when (and (general-concretep size)
+                      (general-concretep i)
+                      (general-concretep j)))
+           (ec-call (logapp (general-concrete-obj size)
+                            (general-concrete-obj i)
+                            (general-concrete-obj j))))
+          ((unless (or (atom size)
+                       (not (member-eq (tag size) '(:g-ite :g-var :g-apply)))))
+           (if (and (eq (tag size) :g-ite)
+                    (not (zp clk)))
+               (let* ((test (g-ite->test size))
+                      (then (g-ite->then size))
+                      (else (g-ite->else size)))
+                 (g-if test
+                       (,gfn then i j . ,params)
+                       (,gfn else i j . ,params)))
+             (g-apply 'logapp (gl-list size i j))))
+          ((unless (or (atom i)
+                       (not (member-eq (tag i) '(:g-ite :g-var :g-apply)))))
+           (if (and (eq (tag i) :g-ite)
+                    (not (zp clk)))
+               (let* ((test (g-ite->test i))
+                      (then (g-ite->then i))
+                      (else (g-ite->else i)))
+                 (g-if test
+                       (,gfn size then j . ,params)
+                       (,gfn size else j . ,params)))
+             (g-apply 'logapp (gl-list size i j))))
+          ((unless (or (atom j)
+                       (not (member-eq (tag j) '(:g-ite :g-var :g-apply)))))
+           (if (and (eq (tag j) :g-ite)
+                    (not (zp clk)))
+               (let* ((test (g-ite->test j))
+                      (then (g-ite->then j))
+                      (else (g-ite->else j)))
+                 (g-if test
+                       (,gfn size i then . ,params)
+                       (,gfn size i else . ,params)))
+             (g-apply 'logapp (gl-list size i j))))
+          (size (if (general-numberp size) size 0))
+          (i (if (general-numberp i) i 0))
+          (j (if (general-numberp j) j 0)))
+       (g-logapp-of-numbers size i j))))
+
+(verify-g-guards logapp
+                 :hints `(("Goal" :in-theory (disable* ,gfn
+                                                       general-concretep-def))))
+
+(def-gobj-dependency-thm logapp
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
+(local (defthm logapp-non-acl2-numbers
+         (and (implies (not (acl2-numberp size))
+                       (equal (logapp size i j) (ifix j)))
+              (implies (not (acl2-numberp i))
+                       (equal (logapp size i j) (logapp size 0 j)))
+              (implies (not (acl2-numberp j))
+                       (equal (logapp size i j) (logapp size i 0))))))
+
+
+
+(def-g-correct-thm logapp eval-g-base
+  :hints `(("Goal" :in-theory (e/d* (general-concretep-atom
+                                     (:ruleset general-object-possibilities)
+                                     not-general-numberp-not-acl2-numberp
+                                     eval-g-base-non-cons)
+                                    ((:definition ,gfn)
+                                     general-concretep-def
+                                     logapp
+                                     member-equal
+                                     eval-g-base-alt-def
+                                     components-to-number-alt-def
+                                     hons-assoc-equal
+                                     sets::double-containment
+                                     equal-of-booleans-rewrite
+                                     bfr-eval-list
+                                     acl2::cancel_times-equal-correct
+                                     acl2::cancel_plus-equal-correct
+                                     default-car default-cdr
+                                     (:rules-of-class :type-prescription
+                                      :here))
+                                    ((:t logapp)))
+            :induct (,gfn acl2::size i j . ,params)
+            :do-not-induct t
+            :expand ((,gfn acl2::size i j . ,params)))
+           (and stable-under-simplificationp
+                (intersectp-equal '((not (equal (tag$inline acl2::size) ':g-ite))
+                                    (not (general-concretep acl2::size)))
+                                  clause)
+                '(:expand ((eval-g-base acl2::size env))))
+           (and stable-under-simplificationp
+                (intersectp-equal '((not (equal (tag$inline i) ':g-ite))
+                                    (not (general-concretep i)))
+                                  clause)
+                '(:expand ((eval-g-base i env))))
+           (and stable-under-simplificationp
+                (intersectp-equal '((not (equal (tag$inline j) ':g-ite))
+                                    (not (general-concretep j)))
+                                  clause)
+                '(:expand ((eval-g-base j env))))))
+
+
+
+
+
+
+(defun g-int-set-sign-of-number (negp y hyp)
+  (declare (xargs :guard (general-numberp y)))
+  (b* (((mv yrn yrd yin yid)
+        (general-number-components y))
+       ((mv yintp yintp-known)
+        (if (equal yrd '(t))
+            (mv (bfr-or (bfr-=-ss yin nil)
+                        (bfr-=-uu yid nil)) t)
+          (mv nil nil)))
+       (negtest (gtests negp hyp))
+       ((unless (and yintp-known
+                     (not (gtests-unknown negtest))))
+        (g-apply 'int-set-sign (gl-list negp y)))
+       (negbfr (gtests-nonnil negtest))
+       (ybits (bfr-ite-bss-fn yintp yrn nil))
+       (ylen (bfr-integer-length-s ybits))
+       (resbits (logapp-uss 1 ylen ybits (bfr-ite-bss-fn negbfr '(t) '(nil)))))
+    (mk-g-number (rlist-fix resbits))))
+
+(defthm deps-of-g-int-set-sign-of-number
+  (implies (and (not (gobj-depends-on k p negp))
+                (not (gobj-depends-on k p y))
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-int-set-sign-of-number negp y hyp)))))
+
+
+(local (defthm bfr-integer-length-s-correct-v2n
+         (equal (bfr-list->u (bfr-integer-length-s x) env)
+                (integer-length (bfr-list->s x env)))
+         :hints(("Goal" :use ((:instance bfr-integer-length-s-correct))
+                 :in-theory (disable bfr-integer-length-s-correct)))))
+
+(local (defthm integer-length-zip
+         (implies (zip x)
+                  (equal (integer-length x) 0))))
+
+
+(defthm g-int-set-sign-of-number-correct
+  (implies (and (bfr-eval hyp (car env))
+                (general-numberp y))
+           (equal (eval-g-base (g-int-set-sign-of-number negp y hyp) env)
+                  (int-set-sign (eval-g-base negp env)
+                                (eval-g-base y env))))
+  :hints (("goal" :in-theory (e/d* ((:ruleset general-object-possibilities)
+                                    int-set-sign)
+                                   (general-numberp
+                                    bfr-list->s-when-gte-0
+                                    general-number-components))
+           :do-not-induct t)))
+
+(in-theory (disable g-int-set-sign-of-number))
+
+
+(def-g-binary-op int-set-sign
+  (b* ((i-num (if (general-numberp i) i 0)))
+    (g-int-set-sign-of-number negp i-num hyp)))
+
+(verify-g-guards
+ int-set-sign
+ :hints `(("Goal" :in-theory
+           (disable* ,gfn
+                     (:rules-of-class :type-prescription :here)))))
+
+(def-gobj-dependency-thm int-set-sign
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
+(local (defthm int-set-sign-non-acl2-number
+         (implies (not (acl2-numberp i))
+                  (equal (int-set-sign negp i)
+                         (int-set-sign negp 0)))
+         :hints(("Goal" :in-theory (enable int-set-sign)))))
+
+(def-g-correct-thm int-set-sign eval-g-base
+   :hints `(("Goal" :in-theory (e/d* (general-concretep-atom
+                                      (:ruleset general-object-possibilities))
+                                     ((:definition ,gfn)
+                                      general-numberp-eval-to-numberp
+                                      general-boolean-value-correct
+                                      bool-cond-itep-eval
+                                      boolean-listp
+                                      eval-g-base-alt-def
+                                      components-to-number-alt-def
+                                      member-equal
+                                      general-number-components-ev
+                                      general-concretep-def
+                                      general-concretep-def
+                                      rationalp-implies-acl2-numberp
+                                      hons-assoc-equal
+                                      default-car default-cdr
+                                      bfr-eval-list-consts
+                                      mv-nth-cons-meta
+                                      possibilities-for-x-5
+                                      possibilities-for-x-3
+                                      general-boolean-value-cases
+                                      (:rules-of-class :type-prescription :here))
+                                     ((:type-prescription bfr-eval)
+                                      eval-g-base-non-cons))
+             :induct (,gfn negp i . ,params)
+             :expand ((,gfn negp i . ,params)))
+           (and stable-under-simplificationp
+                (intersectp-equal '((not (equal (tag$inline negp) ':g-ite))
+                                    (not (general-concretep negp)))
+                                  clause)
+                '(:expand ((eval-g-base negp env))))
+           (and stable-under-simplificationp
+                (intersectp-equal '((not (equal (tag$inline i) ':g-ite))
+                                    (not (general-concretep i)))
+                                  clause)
+                '(:expand ((eval-g-base i env))))))
+
+
+
+(defund g-ifix-of-number (i)
+  (declare (xargs :guard (general-numberp i)))
+  (b* (((mv irn ird iin iid)
+        (general-number-components i))
+       ((mv iintp iintp-known)
+        (if (equal ird '(t))
+            (mv (bfr-or (bfr-=-ss iin nil)
+                        (bfr-=-uu iid nil)) t)
+          (mv nil nil)))
+       ((unless iintp-known) (mv t nil)) ;; error
+       ;; ifix
+       (ibits (bfr-ite-bss-fn iintp irn nil)))
+    (mv nil (mk-g-number ibits))))
+
+(defthm deps-of-g-ifix-of-number
+  (implies (and (not (gobj-depends-on k p i))
+                (general-numberp i))
+           (not (gobj-depends-on k p (mv-nth 1 (g-ifix-of-number i)))))
+  :hints(("Goal" :in-theory (enable g-ifix-of-number))))
+
+(defthm g-ifix-of-number-correct
+  (b* (((mv erp res) (g-ifix-of-number i)))
+    (implies (and (not erp)
+                  (general-numberp i))
+             (equal (eval-g-base res env)
+                    (ifix (eval-g-base i env)))))
+  :hints(("Goal" :in-theory (enable g-ifix-of-number))))
+
+
+
+(def-g-fn maybe-integer
+  `(b* (((when (and (general-concretep i)
+                    (general-concretep x)
+                    (general-concretep intp)))
+         (g-concrete-quote
+          (ec-call (maybe-integer (general-concrete-obj i)
+                                  (general-concrete-obj x)
+                                  (general-concrete-obj intp)))))
+        ;; ((unless (or (atom intp)
+        ;;              (not (member-eq (tag intp) '(:g-ite :g-var :g-apply)))))
+        ;;  (if (and (eq (tag intp) :g-ite)
+        ;;           (not (zp clk)))
+        ;;      (let* ((test (g-ite->test intp))
+        ;;             (then (g-ite->then intp))
+        ;;             (else (g-ite->else intp)))
+        ;;        (g-if test
+        ;;              (,gfn i x then . ,params)
+        ;;              (,gfn i x else . ,params)))
+        ;;    (g-apply 'maybe-integer (gl-list i x intp))))
+        ((when (and (consp i)
+                    (member (tag i) '(:g-ite :g-var :g-apply))))
+         (if (and (eq (tag i) :g-ite)
+                  (not (zp clk)))
+             (let* ((test (g-ite->test i))
+                    (then (g-ite->then i))
+                    (else (g-ite->else i)))
+               (g-if test
+                     (,gfn then x intp . ,params)
+                     (,gfn else x intp . ,params)))
+           (g-apply 'maybe-integer (gl-list i x intp))))
+        ;; ((when (and (consp x) (eq (tag x) :g-ite)))
+        ;;  (if (not (zp clk))
+        ;;      (let* ((test (g-ite->test x))
+        ;;             (then (g-ite->then x))
+        ;;             (else (g-ite->else x)))
+        ;;        (g-if test
+        ;;              (,gfn i then intp . ,params)
+        ;;              (,gfn i else intp . ,params)))
+        ;;    (g-apply 'maybe-integer (gl-list i x intp))))
+        (i (if (general-numberp i) i 0))
+        ((mv undef ifix) (g-ifix-of-number i))
+        ((when undef)
+         (g-apply 'maybe-integer (gl-list i x intp))))
+     (g-if intp
+           ifix
+           (g-apply 'maybe-integer (gl-list i x intp)))))
+
+
+
+(verify-g-guards
+ maybe-integer
+ :hints `(("Goal" :in-theory
+           (disable* ,gfn
+                     (:rules-of-class :type-prescription :here)))))
+
+(def-gobj-dependency-thm maybe-integer
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
+
+(def-g-correct-thm maybe-integer eval-g-base
+   :hints `(("Goal" :in-theory (e/d* (general-concretep-atom
+                                      maybe-integer
+                                      (:ruleset general-object-possibilities))
+                                     ((:definition ,gfn)
+                                      (g-ifix-of-number)
+                                      general-numberp-eval-to-numberp
+                                      general-boolean-value-correct
+                                      bool-cond-itep-eval
+                                      boolean-listp
+                                      eval-g-base-alt-def
+                                      components-to-number-alt-def
+                                      member-equal
+                                      general-number-components-ev
+                                      general-concretep-def
+                                      general-concretep-def
+                                      rationalp-implies-acl2-numberp
+                                      hons-assoc-equal
+                                      default-car default-cdr
+                                      bfr-eval-list-consts
+                                      mv-nth-cons-meta
+                                      possibilities-for-x-5
+                                      possibilities-for-x-3
+                                      general-boolean-value-cases
+                                      (:rules-of-class :type-prescription :here))
+                                     ((:type-prescription bfr-eval)
+                                      eval-g-base-non-cons))
+             :induct (,gfn i x intp . ,params)
+             :expand ((,gfn i x intp . ,params)))
+           (and stable-under-simplificationp
+                (intersectp-equal '((not (equal (tag$inline i) ':g-ite))
+                                    (not (general-concretep i))
+                                    (general-numberp i))
+                                  clause)
+                '(:expand ((eval-g-base i env))))
+           (and stable-under-simplificationp
+                (intersectp-equal '((not (equal (tag$inline intp) ':g-ite))
+                                    (not (general-concretep intp)))
+                                  clause)
+                '(:expand ((eval-g-base intp env))))
+           (and stable-under-simplificationp
+                (intersectp-equal '((not (equal (tag$inline x) ':g-ite))
+                                    (not (general-concretep x)))
+                                  clause)
+                '(:expand ((eval-g-base x env))))))
+
diff -Nru acl2-6.2/books/centaur/gl/g-logbitp.lisp acl2-6.3/books/centaur/gl/g-logbitp.lisp
--- acl2-6.2/books/centaur/gl/g-logbitp.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-logbitp.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,18 +1,32 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-(set-inhibit-warnings "theory")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
- 
+(set-inhibit-warnings "theory")
 
 (defun g-logbitp-of-numbers (a b)
   (declare (xargs :guard (and (general-numberp a)
@@ -23,16 +37,16 @@
         (general-number-components b))
        ((mv aintp aintp-known)
         (if (equal ard '(t))
-            (mv (bfr-or (=-ss ain nil) (=-uu aid nil)) t)
+            (mv (bfr-or (bfr-=-ss ain nil) (bfr-=-uu aid nil)) t)
           (mv nil nil)))
        ((mv bintp bintp-known)
         (if (equal brd '(t))
-            (mv (bfr-or (=-ss bin nil) (=-uu bid nil)) t)
+            (mv (bfr-or (bfr-=-ss bin nil) (bfr-=-uu bid nil)) t)
           (mv nil nil))))
     (if (and bintp-known aintp-known)
         (mk-g-boolean
-         (logbitp-n2v 1
-                      (bfr-ite-bss-fn (bfr-and
+         (bfr-logbitp-n2v 1
+                      (bfr-ite-bvv-fn (bfr-and
                                      aintp (bfr-not (s-sign arn)))
                                     arn nil)
                       (bfr-ite-bss-fn bintp brn nil)))
@@ -40,6 +54,14 @@
 
 (in-theory (disable (g-logbitp-of-numbers)))
 
+
+(defthm deps-of-g-logbitp-of-numbers
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-logbitp-of-numbers x y)))))
+
 ;; (local
 ;;  (defthm gobjectp-g-logbitp-of-numbers
 ;;    (implies (and (gobjectp a)
@@ -57,6 +79,12 @@
                        (equal (logbitp a b) (logbitp a 0))))
          :hints(("Goal" :in-theory (enable logbitp)))))
 
+(local (defthm bfr-list->s-when-positive
+         (implies (<= 0 (bfr-list->s x env))
+                  (equal (bfr-list->s x env)
+                         (bfr-list->u x env)))
+         :hints(("Goal" :in-theory (enable scdr s-endp)))))
+
 (local
  (defthm g-logbitp-of-numbers-correct
    (implies (and (general-numberp a)
@@ -66,7 +94,8 @@
                             (eval-g-base b env))))
    :hints (("goal" :in-theory (e/d* ((:ruleset general-object-possibilities))
                                     (general-numberp
-                                     general-number-components))
+                                     general-number-components
+                                     logbitp))
             :do-not-induct t))))
 
 (in-theory (disable g-logbitp-of-numbers))
@@ -89,8 +118,8 @@
 ;;                    (:ruleset gl-tag-rewrites)
 ;;                    mv-nth-cons-meta
 ;;                    bfr-ite-bss-fn))
-;;             :induct (,gfn i j hyp clk)
-;;             :expand ((,gfn i j hyp clk)))))
+;;             :induct (,gfn i j . ,params)
+;;             :expand ((,gfn i j . ,params)))))
 
 (verify-g-guards
  logbitp
@@ -99,6 +128,11 @@
                      (:rules-of-class :type-prescription :here)))))
 
 
+(def-gobj-dependency-thm logbitp
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local (defthm logbitp-when-not-numbers
          (and (implies (not (acl2-numberp a))
                        (equal (logbitp a b) (logbitp 0 b)))
@@ -118,7 +152,6 @@
                                       member-equal
                                       general-number-components-ev
                                       general-concretep-def
-                                      v2n-is-v2i-when-sign-nil
                                       general-concretep-def
                                       rationalp-implies-acl2-numberp
                                       hons-assoc-equal
@@ -128,7 +161,8 @@
                                       possibilities-for-x-5
                                       possibilities-for-x-3
                                       general-boolean-value-cases
+                                      logbitp bfr-list->s bfr-list->u
                                       (:rules-of-class :type-prescription :here))
                                      ((:type-prescription bfr-eval)))
-             :induct (,gfn i j hyp clk)
-             :expand ((,gfn i j hyp clk)))))
+             :induct (,gfn i j . ,params)
+             :expand ((,gfn i j . ,params)))))
diff -Nru acl2-6.2/books/centaur/gl/g-logior.lisp acl2-6.3/books/centaur/gl/g-logior.lisp
--- acl2-6.2/books/centaur/gl/g-logior.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-logior.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,32 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
-
+(local (include-book "centaur/misc/arith-equivs" :dir :system))
 
 (defun g-binary-logior-of-numbers (x y)
   (declare (xargs :guard (and (general-numberp x)
@@ -21,22 +37,28 @@
         (general-number-components y))
        ((mv xintp xintp-known)
         (if (equal xrd '(t))
-            (mv (bfr-or (=-ss xin nil)
-                      (=-uu xid nil)) t)
+            (mv (bfr-or (bfr-=-ss xin nil)
+                      (bfr-=-uu xid nil)) t)
           (mv nil nil)))
        ((mv yintp yintp-known)
         (if (equal yrd '(t))
-            (mv (bfr-or (=-ss yin nil)
-                      (=-uu yid nil)) t)
+            (mv (bfr-or (bfr-=-ss yin nil)
+                      (bfr-=-uu yid nil)) t)
           (mv nil nil))))
     (if (and xintp-known yintp-known)
         (mk-g-number
-         (logior-ss (bfr-ite-bss-fn xintp xrn nil)
+         (bfr-logior-ss (bfr-ite-bss-fn xintp xrn nil)
                     (bfr-ite-bss-fn yintp yrn nil)))
       (g-apply 'binary-logior (gl-list x y)))))
 
 (in-theory (disable (g-binary-logior-of-numbers)))
 
+(defthm deps-of-g-binary-logior-of-numbers
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-binary-logior-of-numbers x y)))))
 
 (local (defthm logior-non-integers
          (and (implies (not (integerp i))
@@ -83,6 +105,11 @@
  :hints `(("Goal" :in-theory (disable* ,gfn
                                        general-concretep-def))))
 
+(def-gobj-dependency-thm binary-logior
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local (defthm logior-non-acl2-numbers
          (and (implies (not (acl2-numberp i))
                        (equal (logior i j) (logior 0 j)))
@@ -97,12 +124,10 @@
                                      general-concretep-def
                                      binary-logior
                                      components-to-number-alt-def
-                                     v2n-is-v2i-when-sign-nil
-                                     s-sign-correct
                                      hons-assoc-equal
                                      eval-g-base-non-cons
                                      default-car default-cdr
                                      (:rules-of-class :type-prescription :here)))
-            :induct (,gfn i j hyp clk)
+            :induct (,gfn i j . ,params)
             :do-not-induct t
-            :expand ((,gfn i j hyp clk)))))
+            :expand ((,gfn i j . ,params)))))
diff -Nru acl2-6.2/books/centaur/gl/g-lognot.lisp acl2-6.3/books/centaur/gl/g-lognot.lisp
--- acl2-6.2/books/centaur/gl/g-lognot.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-lognot.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,19 +1,32 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-(set-inhibit-warnings "theory")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
- 
-
+(set-inhibit-warnings "theory")
 
 (def-g-fn lognot
   `(let ((x i))
@@ -24,8 +37,8 @@
           (if (zp clk)
               (g-apply 'lognot (gl-list x))
             (g-if test
-                  (,gfn then hyp clk)
-                  (,gfn else hyp clk))))
+                  (,gfn then . ,params)
+                  (,gfn else . ,params))))
          ((g-apply & &)
           (g-apply 'lognot (gl-list x)))
          ((g-concrete obj)
@@ -38,10 +51,10 @@
                 (break-g-number num))
                ((mv intp intp-known)
                 (if (equal rd '(t))
-                    (mv (bfr-or (=-ss in nil) (=-uu id nil)) t)
+                    (mv (bfr-or (bfr-=-ss in nil) (bfr-=-uu id nil)) t)
                   (mv nil nil))))
             (if intp-known
-                (mk-g-number (lognot-s (bfr-ite-bss-fn intp rn nil)))
+                (mk-g-number (bfr-lognot-s (bfr-ite-bss-fn intp rn nil)))
               (g-apply 'lognot (gl-list x)))))
          (& -1)))))
 
@@ -54,14 +67,19 @@
 ;; (def-gobjectp-thm lognot
 ;;   :hints `(("Goal" :in-theory (e/d ()
 ;;                                    ((:definition ,gfn) lognot))
-;;             :induct (,gfn i hyp clk)
-;;             :expand ((,gfn i hyp clk)
+;;             :induct (,gfn i . ,params)
+;;             :expand ((,gfn i . ,params)
 ;;                      (:free (x) (gobjectp (- x)))))))
 
 (verify-g-guards
  lognot
  :hints `(("Goal" :in-theory (disable ,gfn))))
 
+(def-gobj-dependency-thm lognot
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local
  (progn
    (defthm lognot-non-acl2-numberp
@@ -81,7 +99,7 @@
                                      general-number-components-ev
                                      general-numberp-eval-to-numberp
                                      lognot))
-             :induct (,gfn i hyp clk)
-             :expand ((,gfn i hyp clk)
+             :induct (,gfn i . ,params)
+             :expand ((,gfn i . ,params)
                       (:with eval-g-base (eval-g-base i env))))))
 
diff -Nru acl2-6.2/books/centaur/gl/g-make-fast-alist.acl2 acl2-6.3/books/centaur/gl/g-make-fast-alist.acl2
--- acl2-6.2/books/centaur/gl/g-make-fast-alist.acl2	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-make-fast-alist.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (set-waterfall-parallelism nil)
 
diff -Nru acl2-6.2/books/centaur/gl/g-make-fast-alist.lisp acl2-6.3/books/centaur/gl/g-make-fast-alist.lisp
--- acl2-6.2/books/centaur/gl/g-make-fast-alist.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-make-fast-alist.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,13 +1,29 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "centaur/gl/g-primitives-help" :dir :system)
 (include-book "centaur/gl/eval-g-base" :dir :system)
 (include-book "centaur/gl/g-if" :dir :system)
 (local (include-book "centaur/gl/eval-g-base-help" :dir :system))
 
-
 (def-g-fn acl2::make-fast-alist
   `(let ((x acl2::alist))
      (if (general-concretep x)
@@ -18,8 +34,8 @@
           (if (zp clk)
               x
             (g-if test
-                  (,gfn then hyp clk)
-                  (,gfn else hyp clk))))
+                  (,gfn then . ,params)
+                  (,gfn else . ,params))))
          ((g-apply & &) x)
          ((g-var &) x)
          ((g-boolean &) x)
@@ -36,9 +52,14 @@
 
 (verify-g-guards acl2::make-fast-alist)
 
+(def-gobj-dependency-thm acl2::make-fast-alist
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (def-g-correct-thm acl2::make-fast-alist eval-g-base
-  :hints `(("Goal" :induct (,gfn acl2::alist hyp clk)
-            :expand (,gfn acl2::alist hyp clk)
+  :hints `(("Goal" :induct (,gfn acl2::alist . ,params)
+            :expand (,gfn acl2::alist . ,params)
             :in-theory (disable (:definition ,gfn)))
            (and stable-under-simplificationp
                 '(:expand ((:with eval-g-base (eval-g-base acl2::alist
diff -Nru acl2-6.2/books/centaur/gl/g-mod.lisp acl2-6.3/books/centaur/gl/g-mod.lisp
--- acl2-6.2/books/centaur/gl/g-mod.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-mod.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,31 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
 
 (defun g-mod-of-numbers (x y)
   (declare (xargs :guard (and (general-numberp x)
@@ -19,32 +34,38 @@
         (general-number-components x))
        ((mv yrn yrd yin yid)
         (general-number-components y)))
-    (if (and (eq (=-uu xrd '(t)) t)
-             (eq (=-uu yrd '(t)) t)
-             (eq (bfr-or (=-ss xin nil)
-                       (=-uu xid nil)) t)
-             (eq (bfr-or (=-ss yin nil)
-                       (=-uu yid nil)) t))
-        (mk-g-number (rlist-fix (mod-ss xrn yrn)))
+    (if (and (eq (bfr-=-uu xrd '(t)) t)
+             (eq (bfr-=-uu yrd '(t)) t)
+             (eq (bfr-or (bfr-=-ss xin nil)
+                         (bfr-=-uu xid nil)) t)
+             (eq (bfr-or (bfr-=-ss yin nil)
+                         (bfr-=-uu yid nil)) t))
+        (mk-g-number (rlist-fix (bfr-mod-ss xrn yrn)))
       (g-apply 'mod (gl-list x y)))))
 
 (in-theory (disable (g-mod-of-numbers)))
 
+(defthm deps-of-g-mod-of-numbers
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-mod-of-numbers x y)))))
 
 (local (include-book "arithmetic/top-with-meta" :dir :system))
 
-;; (local (defthm not-integerp-mod-ss
+;; (local (defthm not-integerp-bfr-mod-ss
 ;;          (implies (and (bfr-listp a) (bfr-listp b))
-;;                   (not (integerp (mod-ss a b))))
-;;          :hints (("goal" :use ((:instance bfr-listp-mod-ss))
-;;                   :in-theory (e/d (bfr-listp) (bfr-listp-mod-ss))))))
+;;                   (not (integerp (bfr-mod-ss a b))))
+;;          :hints (("goal" :use ((:instance bfr-listp-bfr-mod-ss))
+;;                   :in-theory (e/d (bfr-listp) (bfr-listp-bfr-mod-ss))))))
 
 (local (defthm rationalp-mod
          (implies (and (integerp x) (integerp y))
                   (rationalp (mod x y)))))
 
-(local (add-bfr-fn-pat =-uu))
-(local (add-bfr-fn-pat =-ss))
+(local (add-bfr-fn-pat bfr-=-uu))
+(local (add-bfr-fn-pat bfr-=-ss))
 
 (local
  (defthm g-mod-of-numbers-correct
@@ -81,17 +102,22 @@
 ;;                                      gobj-fix-when-gobjectp
 ;;                                      (:rules-of-class :type-prescription :here)
 ;;                                      (:ruleset gl-wrong-tag-rewrites)))
-;;             :induct (,gfn x y hyp clk)
+;;             :induct (,gfn x y . ,params)
 ;;             :do-not-induct t
-;;             :expand ((,gfn x y hyp clk)
+;;             :expand ((,gfn x y . ,params)
 ;;                      (gobjectp (mod (gobj-fix i) (gobj-fix j)))))))
 
 (verify-g-guards
  mod
  :hints `(("goal" :in-theory
-           (disable* ,gfn 
+           (disable* ,gfn
                      (:rules-of-class :type-prescription :here)))))
 
+(def-gobj-dependency-thm mod
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local (defthm mod-when-not-numberp
          (and (implies (not (acl2-numberp x))
                        (equal (mod x y) (mod 0 y)))
@@ -113,16 +139,15 @@
                               member-equal
                               general-number-components-ev
                               general-concretep-def
-                              v2n-is-v2i-when-sign-nil
                               general-concretep-def
                               mod floor
                               hons-assoc-equal
                               rationalp-implies-acl2-numberp
                               (:rules-of-class :type-prescription :here))
                              ((:type-prescription bfr-eval)))
-     :induct (,gfn x y hyp clk)
+     :induct (,gfn x y . ,params)
      :do-not-induct t
-     :expand ((,gfn x y hyp clk)))
+     :expand ((,gfn x y . ,params)))
     (and stable-under-simplificationp
          (flag::expand-calls-computed-hint
           clause '(eval-g-base)))))
diff -Nru acl2-6.2/books/centaur/gl/g-predicates.lisp acl2-6.3/books/centaur/gl/g-predicates.lisp
--- acl2-6.2/books/centaur/gl/g-predicates.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-predicates.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,15 +1,31 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
 
 (local (defthm nth-open-when-constant-idx
          (implies (syntaxp (quotep n))
@@ -58,8 +74,8 @@
                (if (zp clk)
                    (g-apply ',',fn (list ,',x))
                  (g-if test
-                       (,gfn then hyp clk)
-                       (,gfn else hyp clk))))
+                       (,gfn then . ,params)
+                       (,gfn else . ,params))))
               ((g-apply & &) (g-apply ',',fn (list ,',x)))
               ((g-var &) (g-apply ',',fn (list ,',x)))
               . ,',cases)))
@@ -111,8 +127,8 @@
 ;;          ,@gobj-encap
 ;;          (def-gobjectp-thm ,fn
 ;;            :hints `(("goal"
-;;                      :induct (,gfn ,',x hyp clk)
-;;                      :expand ((,gfn ,',x hyp clk)))
+;;                      :induct (,gfn ,',x . ,params)
+;;                      :expand ((,gfn ,',x . ,params)))
 ;;                     . ,',gobj-hints)))
        (encapsulate nil
          (local (in-theory
@@ -161,6 +177,10 @@
          ,@guard-encap
          (verify-g-guards ,fn
                           :hints ',guard-hints))
+       (def-gobj-dependency-thm ,fn
+         :hints `(("goal" :induct ,gcall
+                   :expand (,gcall)
+                   :in-theory (e/d ((:i ,gfn)) ((:d ,gfn))))))
        (encapsulate nil
          (local (in-theory (e/d* (;; gobjectp-tag-rw-to-types
                                   ;; gobjectp-gobj-fix
@@ -179,12 +199,13 @@
                                   g-if-geval-meta-correct-eval-g-base
                                   g-or-geval-meta-correct-eval-g-base
                                   eval-g-base-atom
+                                  eval-g-base-list
                                   ;; booleanp-gobjectp
                                   )
                                  (;; bfr-p-of-boolean
                                   general-number-components-ev
                                   (:type-prescription booleanp)
-                                  
+
                                   bfr-eval-booleanp
                                   general-boolean-value-correct
                                   bool-cond-itep-eval
@@ -196,8 +217,8 @@
          ,@corr-encap
          (def-g-correct-thm ,fn eval-g-base
            :hints `(("goal" :in-theory (enable (:induction ,gfn))
-                     :induct (,gfn ,',x hyp clk)
-                     :expand ((,gfn ,',x hyp clk)))
+                     :induct (,gfn ,',x . ,params)
+                     :expand ((,gfn ,',x . ,params)))
                     (and stable-under-simplificationp
                          '(:expand ((:with eval-g-base (eval-g-base ,',x env))
                                     (:with eval-g-base (eval-g-base nil env))
@@ -206,11 +227,11 @@
 
 
 (defmacro def-g-predicate
-  (fn cases &key 
+  (fn cases &key
       corr-hints guard-hints gobj-hints encap
       gobj-encap guard-encap corr-encap (formals '(x)))
   (declare (ignorable gobj-hints gobj-encap))
-  (def-g-predicate-fn 
+  (def-g-predicate-fn
     fn cases corr-hints guard-hints
     encap guard-encap corr-encap formals))
 
@@ -245,7 +266,7 @@
    (& t)))
 
 
-         
+
 (encapsulate nil
 
   (def-g-predicate integerp
@@ -255,17 +276,17 @@
         (declare (ignore arn))
         (if (equal ard '(t))
             (mk-g-boolean
-             (bfr-or (=-ss ain nil)
-                   (=-uu aid nil)))
+             (bfr-or (bfr-=-ss ain nil)
+                   (bfr-=-uu aid nil)))
           (g-apply 'integerp (list x)))))
      (& nil))
     :encap ((local (in-theory (enable bfr-eval-bfr-binary-or
                                       bfr-or-of-t
-                                      =-uu-correct
-                                      =-ss-correct
+                                      bfr-=-uu-correct
+                                      bfr-=-ss-correct
                                       (:type-prescription break-g-number)))))
     :guard-encap ((local (bfr-reasoning-mode t))
-                  (local (add-bfr-pats (=-uu . &) (=-ss . &))))
+                  (local (add-bfr-pats (bfr-=-uu . &) (bfr-=-ss . &))))
     :corr-hints ((and stable-under-simplificationp
                       (append '(:in-theory (enable components-to-number-alt-def))
                               (flag::expand-calls-computed-hint
@@ -279,12 +300,12 @@
         (break-g-number num)
         (declare (ignore arn ard))
         (mk-g-boolean
-         (bfr-or (=-ss ain nil)
-               (=-uu aid nil)))))
+         (bfr-or (bfr-=-ss ain nil)
+               (bfr-=-uu aid nil)))))
      (& nil))
     :encap ((local (in-theory (enable bfr-eval-bfr-binary-or
-                                      =-uu-correct
-                                      =-ss-correct
+                                      bfr-=-uu-correct
+                                      bfr-=-ss-correct
                                       bfr-or-of-t
                                       (:type-prescription break-g-number)))))
     :guard-encap ((local (bfr-reasoning-mode t)))
diff -Nru acl2-6.2/books/centaur/gl/g-primitives-help.lisp acl2-6.3/books/centaur/gl/g-primitives-help.lisp
--- acl2-6.2/books/centaur/gl/g-primitives-help.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-primitives-help.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,10 +1,28 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "tools/flag" :dir :system)
 (include-book "gl-util")
-
+(include-book "bvar-db")
+(include-book "glcp-config")
 (program)
 
 
@@ -27,19 +45,22 @@
 ;;                                 :exec ,(car formals)))
 ;;           (mbe-gobj-fix-formals-list (cdr formals)))))
 
-(defmacro def-g-fn (fn body)
+(defmacro def-g-fn (fn body &key measure)
   `(make-event
-    (let* ((gfn (gl-fnsym ',fn))
-           (world (w state))
-           (formals (wgetprop ',fn 'formals)))
+    (b* ((gfn (gl-fnsym ',fn))
+         (world (w state))
+         (formals (wgetprop ',fn 'formals))
+         (params '(hyp clk config bvar-db state))
+         (measure (or ',measure `(+ . ,(acl2-count-formals-list
+                                        formals)))))
       `(progn
-         (defun ,gfn (,@formals hyp clk)
-           (declare (xargs :guard (natp clk)
-                           :measure
-                           (+ . ,(acl2-count-formals-list
-                                  formals))
-                           :verify-guards nil)
-                    (ignorable ,@formals hyp clk))
+         (defun ,gfn (,@formals hyp clk config bvar-db state)
+           (declare (xargs :guard (and (natp clk)
+                                       (glcp-config-p config))
+                           :measure ,measure
+                           :verify-guards nil
+                           :stobjs (bvar-db state))
+                    (ignorable ,@formals . ,params))
              ,,body)
          (table g-functions ',',fn ',gfn)))))
 
@@ -56,30 +77,30 @@
                    (mk-g-concrete
                     (ec-call (,fn (general-concrete-obj ,a)
                                   (general-concrete-obj ,b)))))
-                  ((or (atom ,a)
-                       (not (member-eq (tag ,a) '(:g-ite :g-var :g-apply))))
-                   (cond ((or (atom ,b)
-                              (not (member-eq (tag ,b) '(:g-ite :g-var :g-apply))))
-                          ,',',body)
-                         ((eq (tag ,b) :g-ite)
-                          (if (zp clk)
-                              (g-apply ',fn (gl-list ,a ,b))
-                            (let* ((test (g-ite->test ,b))
-                                   (then (g-ite->then ,b))
-                                   (else (g-ite->else ,b)))
-                              (g-if test
-                                    (,gfn ,a then hyp clk)
-                                    (,gfn ,a else hyp clk)))))
-                         (t (g-apply ',fn (gl-list ,a ,b)))))
-                  ((eq (tag ,a) :g-ite)
+                  ((and (consp ,a) (eq (tag ,a) :g-ite))
                    (if (zp clk)
                        (g-apply ',fn (gl-list ,a ,b))
                      (let* ((test (g-ite->test ,a))
                             (then (g-ite->then ,a))
                             (else (g-ite->else ,a)))
                        (g-if test
-                             (,gfn then ,b hyp clk)
-                             (,gfn else ,b hyp clk)))))
+                             (,gfn then ,b hyp clk config bvar-db state)
+                             (,gfn else ,b hyp clk config bvar-db state)))))
+                  ((and (consp ,b) (eq (tag ,b) :g-ite))
+                   (if (zp clk)
+                       (g-apply ',fn (gl-list ,a ,b))
+                     (let* ((test (g-ite->test ,b))
+                            (then (g-ite->then ,b))
+                            (else (g-ite->else ,b)))
+                       (g-if test
+                             (,gfn ,a then hyp clk config bvar-db state)
+                             (,gfn ,a else hyp clk config bvar-db state)))))
+                  ((or (atom ,a)
+                       (not (member-eq (tag ,a) '(:g-var :g-apply))))
+                   (cond ((or (atom ,b)
+                              (not (member-eq (tag ,b) '( :g-var :g-apply))))
+                          ,',',body)
+                         (t (g-apply ',fn (gl-list ,a ,b)))))
                   (t (g-apply ',fn (gl-list ,a ,b)))))))))
 
 ;; (defun gobjectp-thmname (fn)
@@ -89,8 +110,8 @@
 (defun correct-thmname (fn)
   (incat 'gl-thm::foo (symbol-name fn) "-CORRECT"))
 
-(defun correct-thmname-appalist (fn)
-  (incat 'gl-thm::foo (symbol-name fn) "-CORRECT-APPALIST"))
+;; (defun correct-thmname-appalist (fn)
+;;   (incat 'gl-thm::foo (symbol-name fn) "-CORRECT-APPALIST"))
 
 (defun correct1-thmname (fn)
   (incat 'gl-thm::foo (symbol-name fn) "-CORRECT1"))
@@ -103,7 +124,7 @@
 ;;        (thmname (gobjectp-thmname gfn)))
 ;;     `(progn
 ;;        (defthm ,thmname
-;;          (gobjectp (,gfn ,@formals hyp clk))
+;;          (gobjectp (,gfn ,@formals hyp clk config bvar-db state))
 ;;          :hints ,hints)
 ;;        (add-to-ruleset! g-gobjectp-lemmas '(,thmname)))))
 
@@ -122,13 +143,13 @@
     (cons `(,ev ,(car formals) env)
           (ev-formals-list ev (cdr formals)))))
 
-(defun ev-formals-appalist-list (ev formals aps)
-  (declare (xargs :mode :logic
-                  :guard t))
-  (if (atom formals)
-      nil
-    (cons `(,ev ,(car formals) env ,aps)
-          (ev-formals-appalist-list ev (cdr formals) aps))))
+;; (defun ev-formals-appalist-list (ev formals aps)
+;;   (declare (xargs :mode :logic
+;;                   :guard t))
+;;   (if (atom formals)
+;;       nil
+;;     (cons `(,ev ,(car formals) env ,aps)
+;;           (ev-formals-appalist-list ev (cdr formals) aps))))
 
 ;; (defun gobj-fix-formals-list (formals)
 ;;   (if (atom formals)
@@ -145,34 +166,79 @@
 (defun def-g-correct-thm-fn (gfn fn ev hints world)
   (b* ((formals (wgetprop fn 'formals))
        (thmname (correct-thmname gfn))
-       (thmname2 (correct-thmname-appalist gfn))
-       (ev-appalist
-        (cadr (assoc ev (table-alist 'eval-g-table world)))))
+       ;;(thmname2 (correct-thmname-appalist gfn))
+       ;; (ev-appalist
+       ;;  (cadr (assoc ev (table-alist 'eval-g-table world))))
+       )
     `(encapsulate nil
        (defthm ,thmname
          (implies (bfr-eval hyp (car env))
-                  (equal (,ev (,gfn ,@formals hyp clk) env)
+                  (equal (,ev (,gfn ,@formals hyp clk config bvar-db state) env)
                          (,fn . ,(ev-formals-list ev formals))))
          :hints ,hints)
        (in-theory (disable ,gfn))
-       (defthm ,thmname2
-         (implies (bfr-eval hyp (car env))
-                  (equal (,ev-appalist (,gfn ,@formals hyp clk) env appalist)
-                         (,fn . ,(ev-formals-appalist-list ev-appalist formals
-                                                           'appalist))))
-         :hints ((geval-appalist-functional-inst-hint
-                  ',thmname ',ev)))
-                              
-       (table sym-counterparts-table ',fn '(,gfn ,thmname2))
+       ;; (defthm ,thmname2
+       ;;   (implies (bfr-eval hyp (car env))
+       ;;            (equal (,ev-appalist (,gfn ,@formals hyp clk config bvar-db state) env appalist)
+       ;;                   (,fn . ,(ev-formals-appalist-list ev-appalist formals
+       ;;                                                     'appalist))))
+       ;;   :hints ((geval-appalist-functional-inst-hint
+       ;;            ',thmname ',ev)))
+
+       (table sym-counterparts-table ',fn '(,gfn ,thmname))
        (table gl-function-info ',fn '(,gfn (,thmname . ,ev))))))
 
-(defmacro def-g-correct-thm (fn ev &key hints)
+(defun def-g-correct-thm-macro (fn ev hints)
   `(make-event
-    (let ((gfn (gl-fnsym ',fn)))
+    (b* ((fn ',fn)
+         (gfn (gl-fnsym fn))
+         (world (w state))
+         (formals (wgetprop fn 'formals))
+         (params '(hyp clk config bvar-db state))
+         (?gcall (cons gfn
+                      (append formals params)))
+         (?fcall (cons fn formals)))
       (def-g-correct-thm-fn gfn ',fn ',ev ,hints (w state)))))
 
+(defmacro def-g-correct-thm (fn ev &key hints)
+  (def-g-correct-thm-macro fn ev hints))
+
 
 (defmacro verify-g-guards (fn &key hints)
   `(make-event
     (let ((gfn (gl-fnsym ',fn)))
       `(verify-guards ,gfn :hints ,,hints))))
+
+
+(defun not-gobj-depends-on-hyps (formals)
+  (if (atom formals)
+      nil
+    (cons `(not (gobj-depends-on badvar parambfr ,(car formals)))
+          (not-gobj-depends-on-hyps (cdr formals)))))
+
+(defun dependency-thmname (fn)
+  (incat 'gl-thm::foo (symbol-name fn) "-DEPENDENCIES"))
+
+(defun def-gobj-dependency-thm-fn (gcall fn hints world)
+  (b* ((formals (wgetprop fn 'formals))
+       (thmname (dependency-thmname fn)))
+    `(encapsulate nil
+       (defthm ,thmname
+         (implies (and . ,(not-gobj-depends-on-hyps formals))
+                  (not (gobj-depends-on badvar parambfr ,gcall)))
+         :hints ,hints)
+       (table sym-counterpart-dep-thms ',fn ',thmname))))
+
+(defun def-gobj-dependency-thm-macro (fn hints)
+  `(make-event
+    (b* ((fn ',fn)
+         (gfn (gl-fnsym fn))
+         (world (w state))
+         (formals (wgetprop fn 'formals))
+         (params '(hyp clk config bvar-db state))
+         (gcall (cons gfn
+                      (append formals params))))
+      (def-gobj-dependency-thm-fn gcall ',fn ,hints (w state)))))
+
+(defmacro def-gobj-dependency-thm (fn &key hints)
+  (def-gobj-dependency-thm-macro fn hints))
diff -Nru acl2-6.2/books/centaur/gl/g-rem.lisp acl2-6.3/books/centaur/gl/g-rem.lisp
--- acl2-6.2/books/centaur/gl/g-rem.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-rem.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,31 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
 
 (defun g-rem-of-numbers (x y)
   (declare (xargs :guard (and (general-numberp x)
@@ -19,32 +34,39 @@
         (general-number-components x))
        ((mv yrn yrd yin yid)
         (general-number-components y)))
-    (if (and (eq (=-uu xrd '(t)) t)
-             (eq (=-uu yrd '(t)) t)
-             (eq (bfr-or (=-ss xin nil)
-                       (=-uu xid nil)) t)
-             (eq (bfr-or (=-ss yin nil)
-                       (=-uu yid nil)) t))
-        (mk-g-number (rlist-fix (rem-ss xrn yrn)))
+    (if (and (eq (bfr-=-uu xrd '(t)) t)
+             (eq (bfr-=-uu yrd '(t)) t)
+             (eq (bfr-or (bfr-=-ss xin nil)
+                       (bfr-=-uu xid nil)) t)
+             (eq (bfr-or (bfr-=-ss yin nil)
+                       (bfr-=-uu yid nil)) t))
+        (mk-g-number (rlist-fix (bfr-rem-ss xrn yrn)))
       (g-apply 'rem (gl-list x y)))))
 
 (in-theory (disable (g-rem-of-numbers)))
 
 
+(defthm deps-of-g-rem-of-numbers
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-rem-of-numbers x y)))))
+
 (local (include-book "arithmetic/top-with-meta" :dir :system))
 
-;; (local (defthm not-integerp-rem-ss
+;; (local (defthm not-integerp-bfr-rem-ss
 ;;          (implies (and (bfr-listp a) (bfr-listp b))
-;;                   (not (integerp (rem-ss a b))))
-;;          :hints (("goal" :use ((:instance bfr-listp-rem-ss))
-;;                   :in-theory (e/d (bfr-listp) (bfr-listp-rem-ss))))))
+;;                   (not (integerp (bfr-rem-ss a b))))
+;;          :hints (("goal" :use ((:instance bfr-listp-bfr-rem-ss))
+;;                   :in-theory (e/d (bfr-listp) (bfr-listp-bfr-rem-ss))))))
 
 (local (defthm rationalp-rem
          (implies (and (integerp x) (integerp y))
                   (rationalp (rem x y)))))
 
-(local (add-bfr-fn-pat =-uu))
-(local (add-bfr-fn-pat =-ss))
+(local (add-bfr-fn-pat bfr-=-uu))
+(local (add-bfr-fn-pat bfr-=-ss))
 
 (local
  (defthm g-rem-of-numbers-correct
@@ -77,6 +99,13 @@
            (disable* ,gfn
                      (:rules-of-class :type-prescription :here)))))
 
+(def-gobj-dependency-thm rem
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
+
+
 (local (defthm rem-when-not-numberp
          (and (implies (not (acl2-numberp x))
                        (equal (rem x y) (rem 0 y)))
@@ -98,16 +127,15 @@
                               member-equal
                               general-number-components-ev
                               general-concretep-def
-                              v2n-is-v2i-when-sign-nil
                               general-concretep-def
                               rem floor
                               hons-assoc-equal
                               rationalp-implies-acl2-numberp
                               (:rules-of-class :type-prescription :here))
                              ((:type-prescription bfr-eval)))
-     :induct (,gfn x y hyp clk)
+     :induct (,gfn x y . ,params)
      :do-not-induct t
-     :expand ((,gfn x y hyp clk)))
+     :expand ((,gfn x y . ,params)))
     (and stable-under-simplificationp
          (flag::expand-calls-computed-hint
           clause '(eval-g-base)))))
diff -Nru acl2-6.2/books/centaur/gl/g-truncate.lisp acl2-6.3/books/centaur/gl/g-truncate.lisp
--- acl2-6.2/books/centaur/gl/g-truncate.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-truncate.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,15 +1,32 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
 
 (defun g-truncate-of-numbers (x y)
   (declare (xargs :guard (and (general-numberp x)
@@ -18,22 +35,26 @@
         (general-number-components x))
        ((mv yrn yrd yin yid)
         (general-number-components y)))
-    (if (and (eq (=-uu xrd '(t)) t)
-             (eq (=-uu yrd '(t)) t)
-             (eq (bfr-or (=-ss xin nil)
-                       (=-uu xid nil)) t)
-             (eq (bfr-or (=-ss yin nil)
-                       (=-uu yid nil)) t))
-        (mk-g-number (rlist-fix (truncate-ss xrn yrn)))
+    (if (and (eq (bfr-=-uu xrd '(t)) t)
+             (eq (bfr-=-uu yrd '(t)) t)
+             (eq (bfr-or (bfr-=-ss xin nil)
+                       (bfr-=-uu xid nil)) t)
+             (eq (bfr-or (bfr-=-ss yin nil)
+                       (bfr-=-uu yid nil)) t))
+        (mk-g-number (rlist-fix (bfr-truncate-ss xrn yrn)))
       (g-apply 'truncate (gl-list x y)))))
 
 (in-theory (disable (g-truncate-of-numbers)))
 
-(local (include-book "arithmetic/top-with-meta" :dir :system))
+(defthm deps-of-g-truncate-of-numbers
+  (implies (and (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (g-truncate-of-numbers x y)))))
 
-
-(local (add-bfr-fn-pat =-uu))
-(local (add-bfr-fn-pat =-ss))
+(local (add-bfr-fn-pat bfr-=-uu))
+(local (add-bfr-fn-pat bfr-=-ss))
 
 (local
  (defthm g-truncate-of-numbers-correct
@@ -67,6 +88,11 @@
            (disable* ,gfn
                      (:rules-of-class :type-prescription :here)))))
 
+(def-gobj-dependency-thm truncate
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 (local (defthm truncate-when-not-numberp
          (and (implies (not (acl2-numberp i))
                        (equal (truncate i j) (truncate 0 j)))
@@ -88,16 +114,15 @@
                               member-equal
                               general-number-components-ev
                               general-concretep-def
-                              v2n-is-v2i-when-sign-nil
                               general-concretep-def
                               truncate
                               hons-assoc-equal
                               rationalp-implies-acl2-numberp
                               (:rules-of-class :type-prescription :here))
                              ((:type-prescription bfr-eval)))
-     :induct (,gfn i j hyp clk)
+     :induct (,gfn i j . ,params)
      :do-not-induct t
-     :expand ((,gfn i j hyp clk)))
+     :expand ((,gfn i j . ,params)))
     (and stable-under-simplificationp
          (flag::expand-calls-computed-hint
           clause '(eval-g-base)))))
diff -Nru acl2-6.2/books/centaur/gl/g-unary--.lisp acl2-6.3/books/centaur/gl/g-unary--.lisp
--- acl2-6.2/books/centaur/gl/g-unary--.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-unary--.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,18 +1,33 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-(set-inhibit-warnings "theory")
-
 (include-book "g-if")
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
-
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+(set-inhibit-warnings "theory")
 
 (def-g-fn unary--
   `(if (atom x)
@@ -22,8 +37,8 @@
         (if (zp clk)
             (g-apply 'unary-- (gl-list x))
           (g-if test
-                (,gfn then hyp clk)
-                (,gfn else hyp clk))))
+                (,gfn then . ,params)
+                (,gfn else . ,params))))
        ((g-apply & &)
         (g-apply 'unary-- (gl-list x)))
        ((g-concrete obj)
@@ -34,24 +49,28 @@
        ((g-number num)
         (mv-let (rn rd in id)
           (break-g-number num)
-          (mk-g-number (unary-minus-s rn)
-                       rd
-                       (unary-minus-s in)
-                       id)))
+          (mk-g-number (bfr-unary-minus-s rn)
+                       (rlist-fix rd)
+                       (bfr-unary-minus-s in)
+                       (rlist-fix id))))
        (& 0))))
 
 ;; (def-gobjectp-thm unary--
 ;;   :hints `(("Goal" :in-theory (e/d () ((:definition ,gfn)))
-;;             :induct (,gfn x hyp clk)
-;;             :expand ((,gfn x hyp clk)
+;;             :induct (,gfn x . ,params)
+;;             :expand ((,gfn x . ,params)
 ;;                      (:free (x) (gobjectp (- x)))))))
 
 (verify-g-guards
  unary--
  :hints `(("Goal" :in-theory (disable ,gfn))))
 
+(def-gobj-dependency-thm unary--
+  :hints `(("goal" :induct ,gcall
+            :expand (,gcall)
+            :in-theory (disable (:d ,gfn)))))
+
 
-(local (include-book "arithmetic/top-with-meta" :dir :system))
 
 
 (local
@@ -96,7 +115,7 @@
                                     ((:definition ,gfn)
                                      general-number-components-ev
                                      general-numberp-eval-to-numberp))
-            :induct (,gfn x hyp clk)
+            :induct (,gfn x . ,params)
             :do-not-induct t
-            :expand ((,gfn x hyp clk)
+            :expand ((,gfn x . ,params)
                      (:with eval-g-base (eval-g-base x env))))))
diff -Nru acl2-6.2/books/centaur/gl/g-unary-concrete.lisp acl2-6.3/books/centaur/gl/g-unary-concrete.lisp
--- acl2-6.2/books/centaur/gl/g-unary-concrete.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/g-unary-concrete.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 
@@ -5,12 +24,9 @@
 (include-book "g-primitives-help")
 (include-book "symbolic-arithmetic-fns")
 (include-book "eval-g-base")
-;(include-book "tools/with-arith5-help" :dir :system)
 (local (include-book "symbolic-arithmetic"))
 (local (include-book "eval-g-base-help"))
 (local (include-book "hyp-fix-logic"))
-;(local (allow-arith5-help))
-
 (in-theory (disable (mk-g-concrete)))
 
 (defthm mk-g-concrete-of-atomic-constant
@@ -39,8 +55,8 @@
                  (if (zp clk)
                      (g-apply ',fn (gl-list ,x))
                    (g-if test
-                         (,gfn then hyp clk)
-                         (,gfn else hyp clk))))
+                         (,gfn then . ,params)
+                         (,gfn else . ,params))))
                 ((g-apply & &) (g-apply ',fn (gl-list ,x)))
                 ((g-var &) (g-apply ',fn (gl-list ,x)))
                 ((g-number &) ,',number-case)
@@ -51,18 +67,23 @@
        ;;             (e/d ()
        ;;                  ((force)
        ;;                   (:definition ,gfn)))
-       ;;             :induct (,gfn ,',x hyp clk)
-       ;;             :expand ((,gfn ,',x hyp clk)))))
+       ;;             :induct (,gfn ,',x . ,params)
+       ;;             :expand ((,gfn ,',x . ,params)))))
        (verify-g-guards
         ,fn
         :hints `(("Goal" :in-theory (Disable ,gfn))))
 
+       (def-gobj-dependency-thm ,fn
+         :hints `(("goal" :induct ,gcall
+                   :expand (,gcall)
+                   :in-theory (disable (:d ,gfn)))))
+
        (def-g-correct-thm ,fn eval-g-base
          :hints `(("Goal" :in-theory (e/d ((:induction ,gfn)
                                            general-concrete-obj)
                                           ((:definition ,gfn)))
-                   :induct (,gfn ,',x hyp clk)
-                   :expand ((,gfn ,',x hyp clk)
+                   :induct (,gfn ,',x . ,params)
+                   :expand ((,gfn ,',x . ,params)
                             (:with eval-g-base (eval-g-base ,',x env))))
                   . ,',hints)))))
 
@@ -118,7 +139,7 @@
   (mv-let (rn rd in id)
     (break-g-number (g-number->num x))
     (declare (ignore in id))
-    (mk-g-number rn rd))
+    (mk-g-number (rlist-fix rn) (rlist-fix rd)))
   :boolean-case 0
   :cons-case 0)
 
@@ -127,7 +148,7 @@
   (mv-let (rn rd in id)
     (break-g-number (g-number->num x))
     (declare (ignore rn rd))
-    (mk-g-number in id))
+    (mk-g-number (rlist-fix in) (rlist-fix id)))
   :boolean-case 0
   :cons-case 0)
 
diff -Nru acl2-6.2/books/centaur/gl/general-object-thms.lisp acl2-6.3/books/centaur/gl/general-object-thms.lisp
--- acl2-6.2/books/centaur/gl/general-object-thms.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/general-object-thms.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,12 +1,28 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "gtype-thms")
 (include-book "general-objects")
 
 
-
 (defthmd generic-geval-g-boolean
   (implies (g-boolean-p x)
            (equal (generic-geval x env)
@@ -49,6 +65,13 @@
   :hints (("goal" :in-theory (enable generic-geval)))
   :rule-classes ((:rewrite :backchain-limit-lst 0)))
 
+(defthm pbfr-depends-on-of-general-boolean-value
+  (implies (and (not (gobj-depends-on k p x))
+                (general-booleanp x))
+           (not (pbfr-depends-on k p (general-boolean-value x))))
+  :hints(("Goal" :in-theory (enable general-booleanp general-boolean-value
+                                    booleanp))))
+
 
 (in-theory (disable general-booleanp general-boolean-value))
 
@@ -67,11 +90,11 @@
 
 (defthm boolean-listp-n2v
   (boolean-listp (n2v n))
-  :hints(("Goal" :in-theory (enable n2v))))
+  :hints(("Goal" :in-theory (e/d (n2v bfr-ucons) (logcar logcdr)))))
 
 (defthm boolean-listp-i2v
   (boolean-listp (i2v n))
-  :hints(("Goal" :in-theory (enable i2v))))
+  :hints(("Goal" :in-theory (e/d (i2v bfr-scons) (logcar logcdr)))))
 
 (defthm number-to-components-boolean-listps
   (and (boolean-listp (mv-nth 0 (number-to-components n)))
@@ -81,39 +104,33 @@
 
 
 
-(defthm v2n-us
-  (implies (natp n)
-           (equal (v2n (n2v n)) n))
-  :hints (("goal" :in-theory (disable floor))))
-
-(defthm v2n-non-natp
-  (implies (not (natp n))
-           (equal (v2n (n2v n)) 0)))
-
-(defthm acl2-numberp-v2n
-  (and (acl2-numberp (v2n x))
-       (rationalp (v2n x))
-       (integerp (v2n x))
-       (natp (v2n x)))
-  :rule-classes (:rewrite :type-prescription))
+;; (defthm v2n-us
+;;   (implies (natp n)
+;;            (equal (v2n (n2v n)) n))
+;;   :hints (("goal" :in-theory (disable floor))))
+
+;; (defthm v2n-non-natp
+;;   (implies (not (natp n))
+;;            (equal (v2n (n2v n)) 0)))
+
+;; (defthm acl2-numberp-v2n
+;;   (and (acl2-numberp (v2n x))
+;;        (rationalp (v2n x))
+;;        (integerp (v2n x))
+;;        (natp (v2n x)))
+;;   :rule-classes (:rewrite :type-prescription))
 
 
 (defthm number-to-components-components-to-number
   (b* (((mv rnum rden inum iden)
         (number-to-components n)))
     (implies (acl2-numberp n)
-             (and (equal (components-to-number
-                          (v2i rnum)
-                          (v2n rden)
-                          (v2i inum)
-                          (v2n iden))
-                         n)
-                  (equal (components-to-number
-                          (v2i (bfr-eval-list rnum env))
-                          (v2n (bfr-eval-list rden env))
-                          (v2i (bfr-eval-list inum env))
-                          (v2n (bfr-eval-list iden env)))
-                         n))))
+             (equal (components-to-number
+                     (bfr-list->s rnum env)
+                     (bfr-list->u rden env)
+                     (bfr-list->s inum env)
+                     (bfr-list->u iden env))
+                    n)))
   :hints (("goal" :in-theory (enable components-to-number-alt-def))))
 
 
@@ -138,9 +155,9 @@
            (mv-let (rn rd in id)
              (general-number-components a)
              (flet ((uval (n env)
-                          (v2n (bfr-eval-list n (car env))))
+                          (bfr-list->u n (car env)))
                     (sval (n env)
-                          (v2i (bfr-eval-list n (car env)))))
+                          (bfr-list->s n (car env))))
                (equal (generic-geval a env)
                       (components-to-number
                        (sval rn env)
@@ -153,6 +170,18 @@
 (in-theory (disable general-number-components
                     general-numberp))
 
+(defthm pbfr-depends-on-of-general-number-components
+  (implies (and (general-numberp x)
+                (not (gobj-depends-on k p x)))
+           (b* (((mv rn rd in id) (general-number-components x)))
+             (and (not (pbfr-list-depends-on k p rn))
+                  (not (pbfr-list-depends-on k p rd))
+                  (not (pbfr-list-depends-on k p in))
+                  (not (pbfr-list-depends-on k p id)))))
+  :hints(("Goal" :in-theory (enable general-number-components)
+          :expand ((gobj-depends-on k p x)
+                   (general-numberp x)))))
+
 
 
 (local (defthm nth-open-when-constant-idx
@@ -160,7 +189,7 @@
                   (equal (nth n x)
                          (if (zp n) (car x)
                            (nth (1- n) (cdr x)))))))
-                       
+
 
 (defthm general-numberp-of-atom
   (implies (not (consp x))
@@ -227,6 +256,17 @@
   :hints (("goal" :in-theory (enable mk-g-concrete g-concrete g-concrete->obj)))
   :rule-classes (:rewrite :linear))
 
+(defthm gobj-depends-on-of-general-consp
+  (implies (and (not (gobj-depends-on k p x))
+                (general-consp x))
+           (and (not (gobj-depends-on k p (general-consp-car x)))
+                (not (gobj-depends-on k p (general-consp-cdr x)))))
+  :hints(("Goal" :in-theory (enable general-consp
+                                    general-consp-car
+                                    general-consp-cdr
+                                    g-keyword-symbolp-def))))
+
+
 (in-theory (disable general-consp general-consp-car general-consp-cdr))
 
 
@@ -338,7 +378,7 @@
 
 (verify-guards
  general-concrete-obj)
-    
+
 
 ;; (defun general-concretep (x)
 ;;   (declare (xargs :guard (gobjectp x)))
@@ -358,14 +398,16 @@
   (implies (concrete-gobjectp x)
            (equal (generic-geval x env)
                   x))
-  :hints(("Goal" :in-theory (enable concrete-gobjectp-def)))
+  :hints(("Goal" :in-theory (enable concrete-gobjectp
+                                    gobject-hierarchy-lite
+                                    generic-geval)))
   :rule-classes ((:rewrite :backchain-limit-lst 0)))
 
 (defthmd general-concrete-obj-correct
   (implies (general-concretep x)
            (equal (generic-geval x env)
                   (general-concrete-obj x)))
-  :hints(("Goal" 
+  :hints(("Goal"
           :induct (general-concrete-obj x)
 
           :expand ((general-concretep x)
@@ -467,7 +509,7 @@
 
 
 
-;; (local 
+;; (local
 ;;  (defthm g-concrete-p-impl-not-general-concretep-car
 ;;    (implies (g-concrete-p x)
 ;;             (not (general-concretep (car x))))
@@ -506,9 +548,9 @@
            (b* (((mv rn rd in id)
                  (general-number-components x)))
              (flet ((uval (n env)
-                          (v2n (bfr-eval-list n (car env))))
+                          (bfr-list->u n (car env)))
                     (sval (n env)
-                          (v2i (bfr-eval-list n (car env)))))
+                          (bfr-list->s n (car env))))
                (components-to-number (sval rn env)
                                      (uval rd env)
                                      (sval in env)
@@ -521,18 +563,19 @@
                (generic-geval (g-ite->then x) env)
              (generic-geval (g-ite->else x) env)))
           ((g-apply-p x)
-           (generic-geval-ev
-            (cons (g-apply->fn x)
-                  (kwote-lst
-                   (generic-geval (g-apply->args x) env)))
-            nil))
+           (and (not (eq (g-apply->fn x) 'quote))
+                (generic-geval-ev
+                 (cons (g-apply->fn x)
+                       (kwote-lst
+                        (generic-geval-list (g-apply->args x) env)))
+                 nil)))
           (t
            (cdr (hons-assoc-equal (g-var->name x) (cdr env))))))
   :hints (("goal" ;; :induct (generic-geval x env)
            :in-theory (e/d** (general-concretep-def
                               (:induction generic-geval)
                               general-numberp general-booleanp
-                              general-consp eq 
+                              general-consp eq
                               atom
                               acl2::cons-car-cdr
                               concrete-gobjectp-def
@@ -549,7 +592,10 @@
                               hons-get))
            :do-not-induct t
            :expand ((generic-geval x env))))
-  :rule-classes :definition)
+  :rule-classes
+  ((:definition :clique (generic-geval generic-geval-list)
+    :controller-alist ((generic-geval t nil)
+                       (generic-geval-list t nil)))))
 
 
 (in-theory (disable generic-geval-alt-def))
@@ -786,10 +832,10 @@
              (general-number-components x)
              (equal (general-concrete-obj x)
                     (components-to-number-fn
-                     (v2i (bfr-eval-list rn (car env)))
-                     (v2n (bfr-eval-list rd (car env)))
-                     (v2i (bfr-eval-list in (car env)))
-                     (v2n (bfr-eval-list id (car env)))))))
+                     (bfr-list->s rn (car env))
+                     (bfr-list->u rd (car env))
+                     (bfr-list->s in (car env))
+                     (bfr-list->u id (car env))))))
   :hints(("Goal" :in-theory (enable ;general-concretep-def
                              general-numberp
                              general-concrete-obj
diff -Nru acl2-6.2/books/centaur/gl/general-objects.lisp acl2-6.3/books/centaur/gl/general-objects.lisp
--- acl2-6.2/books/centaur/gl/general-objects.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/general-objects.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,7 +1,24 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "gtypes")
 
 
diff -Nru acl2-6.2/books/centaur/gl/generic-geval.lisp acl2-6.3/books/centaur/gl/generic-geval.lisp
--- acl2-6.2/books/centaur/gl/generic-geval.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/generic-geval.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,13 +1,28 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "gobjectp")
 (include-book "bvecs")
 (include-book "tools/bstar" :dir :system)
 (include-book "tools/templates" :dir :system)
-;; (include-book "defapply")
-;; (include-book "defapply-proofs")
 (include-book "cutil/defmvtypes" :dir :system)
 (include-book "../misc/defapply")
 
@@ -42,12 +57,16 @@
                               (mv (car x) (cdr x))
                             (mv nil nil)))
        (imag-denom (if (consp x) (car x) '(t))))
-    (mv (rlist-fix real-numer)
-        (rlist-fix real-denom)
-        (rlist-fix imag-numer)
-        (rlist-fix imag-denom))))
+    ;; (mv (rlist-fix real-numer)
+    ;;     (rlist-fix real-denom)
+    ;;     (rlist-fix imag-numer)
+    ;;     (rlist-fix imag-denom))
+    (mv real-numer
+        real-denom
+        imag-numer
+        imag-denom)))
 
-(acl2::defmvtypes break-g-number (true-listp true-listp true-listp true-listp))
+;; (acl2::defmvtypes break-g-number (true-listp true-listp true-listp true-listp))
 
 
 
@@ -126,138 +145,198 @@
   (implies (symbol-alistp x)
            (eqlable-alistp x)))
 
+(mutual-recursion
+ (defun gobj->term (x env)
+   (declare (xargs :guard (consp env)
+                   :measure (acl2-count x)
+                   :hints (("goal" :in-theory '(measure-for-geval atom)))))
+   (if (atom x)
+       (kwote x)
+     (pattern-match x
+       ((g-concrete obj) (kwote obj))
+
+       ((g-boolean bool) (kwote (bfr-eval bool (car env))))
+
+       ((g-number num)
+        (b* (((mv real-num
+                  real-denom
+                  imag-num
+                  imag-denom)
+              (break-g-number num)))
+          (flet ((uval (n env)
+                       (bfr-list->u n (car env)))
+                 (sval (n env)
+                       (bfr-list->s n (car env))))
+            (kwote
+             (components-to-number (sval real-num env)
+                                   (uval real-denom env)
+                                   (sval imag-num env)
+                                   (uval imag-denom env))))))
+
+       ((g-ite test then else)
+        (list 'if
+              (gobj->term test env)
+              (gobj->term then env)
+              (gobj->term else env)))
+
+       ((g-var name) (kwote (cdr (hons-get name (cdr env)))))
+
+       ((g-apply fn args)
+        (and (not (eq fn 'quote))
+             (cons fn (gobj-list->terms args env))))
+
+       (& ;; cons
+        (list 'cons
+              (gobj->term (car x) env)
+              (gobj->term (cdr x) env))))))
+
+ (defun gobj-list->terms (x env)
+   (declare (xargs :guard (consp env)
+                   :measure (acl2-count x)))
+   (if (atom x)
+       nil
+     (cons (gobj->term (car x) env)
+           (gobj-list->terms (cdr x) env)))))
+
+(mutual-recursion
+ (defun gobj-ind (x env)
+   (declare (xargs :guard (consp env)
+                   :measure (acl2-count x)
+                   :hints (("goal" :in-theory '(measure-for-geval atom)))))
+   (if (atom x)
+       (kwote x)
+     (pattern-match x
+       ((g-concrete obj) (kwote obj))
+
+       ((g-boolean bool) (kwote (bfr-eval bool (car env))))
+
+       ((g-number num)
+        (b* (((mv real-num
+                  real-denom
+                  imag-num
+                  imag-denom)
+              (break-g-number num)))
+          (flet ((uval (n env)
+                       (bfr-list->u n (car env)))
+                 (sval (n env)
+                       (bfr-list->s n (car env))))
+            (kwote
+             (components-to-number (sval real-num env)
+                                   (uval real-denom env)
+                                   (sval imag-num env)
+                                   (uval imag-denom env))))))
+
+       ((g-ite test then else)
+        (list 'if
+              (gobj-ind test env)
+              (gobj-ind then env)
+              (gobj-ind else env)))
+
+       ((g-var name) (kwote (cdr (hons-get name (cdr env)))))
+
+       ((g-apply fn args)
+        (cons fn (gobj-list-ind args env)))
+
+       (& ;; cons
+        (list 'cons
+              (gobj-ind (car x) env)
+              (gobj-ind (cdr x) env))))))
+
+ (defun gobj-list-ind (x env)
+   (declare (xargs :guard (consp env)
+                   :measure (acl2-count x)))
+   (if (atom x)
+       nil
+     (cons (gobj-ind (car x) env)
+           (gobj-list-ind (cdr x) env)))))
+
+
+(flag::make-flag gobj-flag gobj-ind
+                 :flag-mapping ((gobj-ind . gobj)
+                                (gobj-list-ind . list)))
+
+(in-theory (disable gobj-ind gobj-list-ind))
 
 
 (defconst *geval-template*
   '(progn
      (acl2::defapply/ev/concrete-ev _geval_ _apply-fns_)
      ;; (defapply _geval_-apply _apply-fns_)
-     (defun _geval_ (x env)
-       (declare (xargs :guard (consp env)
-                       :measure (acl2-count x)
-                       :verify-guards nil
-                       :hints (("goal" :in-theory '(measure-for-geval atom)))))
-       (if (atom x)
-           ;; Every atom represents itself.
-           x
-         (pattern-match x
-
-           ;; A Concrete is like an escape sequence; we take (cdr x) as a concrete
-           ;; object even if it looks symbolic.
-           ((g-concrete obj) obj)
-
-           ;; Boolean
-           ((g-boolean bool) (bfr-eval bool (car env)))
-
-           ;; Number.  This is the hairy case.  Can represent all ACL2-NUMBERPs,
-           ;; but naturals are more compact than integers, which are more compact
-           ;; than rationals, which are more compact than complexes.  Denominators
-           ;; are coerced to 1 if they evaluate to 0 -- ugly.
-           ((g-number num)
-            (b* (((mv real-num
-                      real-denom
-                      imag-num
-                      imag-denom)
-                  (break-g-number num)))
-              (flet ((uval (n env)
-                           (v2n (bfr-eval-list n (car env))))
-                     (sval (n env)
-                           (v2i (bfr-eval-list n (car env)))))
-                (components-to-number (sval real-num env)
-                                      (uval real-denom env)
-                                      (sval imag-num env)
-                                      (uval imag-denom env)))))
-
-           ;; If-then-else.
-           ((g-ite test then else)
-            (if (_geval_ test env)
-                (_geval_ then env)
-              (_geval_ else env)))
-
-           ;; Apply: Unevaluated function call.
-           ((g-apply fn args)
-            (let* ((args (_geval_ args env)))
-              (mbe :logic (_geval_-ev (cons fn (kwote-lst args)) nil)
-                   :exec (b* ((args (acl2::list-fix args))
-                              ((mv ok val) (_geval_-apply fn args))
-                              ((when ok) val))
-                           (_geval_-ev (cons fn (kwote-lst args))
-                                       nil)))))
- 
-           ;; Var: untyped variable.
-           ((g-var name)   (cdr (het name (cdr env))))
-
-           ;; Conses where the car is not a recognized flag represent conses.
-           (& (cons (_geval_ (car x) env)
-                    (_geval_ (cdr x) env))))))
-
-     (defun _geval_-appalist (x env appal)
-       (declare (xargs :guard (and (consp env) (symbol-alistp appal))
-                       :measure (acl2-count x)
-                       :guard-hints (("goal" :in-theory
-                                      '((:type-prescription v2i)
-                                        (alistp)
-                                        (:type-prescription v2n)
-                                        (:type-prescription hons-assoc-equal)
-                                        hons-get
-                                        acl2::true-listp-of-list-fix
-                                        acl2::assoc-eql-exec-is-assoc-equal
-                                        eqlablep-compound-recognizer
-                                        consp-assoc-equal-of-cons
-                                        symbol-alistp-implies-eqlable-alistp)))
-                       :hints (("goal" :in-theory '(measure-for-geval atom)))))
-       (if (atom x)
-           ;; Every atom represents itself.
-           x
-         (pattern-match x
-
-           ;; A Concrete is like an escape sequence; we take (cdr x) as a concrete
-           ;; object even if it looks symbolic.
-           ((g-concrete obj) obj)
-
-           ;; Boolean
-           ((g-boolean bool) (bfr-eval bool (car env)))
-
-           ;; Number.  This is the hairy case.  Can represent all ACL2-NUMBERPs,
-           ;; but naturals are more compact than integers, which are more compact
-           ;; than rationals, which are more compact than complexes.  Denominators
-           ;; are coerced to 1 if they evaluate to 0 -- ugly.
-           ((g-number num)
-            (b* (((mv real-num
-                      real-denom
-                      imag-num
-                      imag-denom)
-                  (break-g-number num)))
-              (flet ((uval (n env)
-                           (v2n (bfr-eval-list n (car env))))
-                     (sval (n env)
-                           (v2i (bfr-eval-list n (car env)))))
-                (components-to-number (sval real-num env)
-                                      (uval real-denom env)
-                                      (sval imag-num env)
-                                      (uval imag-denom env)))))
-
-           ;; If-then-else.
-           ((g-ite test then else)
-            (if (_geval_-appalist test env appal)
-                (_geval_-appalist then env appal)
-              (_geval_-appalist else env appal)))
-
-           ;; Apply: Unevaluated function call.
-           ((g-apply fn args)
-            (let* ((args (_geval_-appalist args env appal)))
-              (ec-call (_geval_-ev-concrete (cons fn (kwote-lst (acl2::list-fix args))) nil appal))))
-
-           ;; Var: untyped variable.
-           ((g-var name)   (cdr (het name (cdr env))))
-
-           ;; Conses where the car is not a recognized flag represent conses.
-           (& (cons (_geval_-appalist (car x) env appal)
-                    (_geval_-appalist (cdr x) env appal))))))
-     
-     (table eval-g-table '_geval_ '(_geval_-appalist
+     (mutual-recursion
+      (defun _geval_ (x env)
+        (declare (xargs :guard (consp env)
+                        :measure (acl2-count x)
+                        :verify-guards nil
+                        :hints (("goal" :in-theory '(measure-for-geval atom)))))
+        (if (atom x)
+            ;; Every atom represents itself.
+            x
+          (pattern-match x
+
+            ;; A Concrete is like an escape sequence; we take (cdr x) as a concrete
+            ;; object even if it looks symbolic.
+            ((g-concrete obj) obj)
+
+            ;; Boolean
+            ((g-boolean bool) (bfr-eval bool (car env)))
+
+            ;; Number.  This is the hairy case.  Can represent all ACL2-NUMBERPs,
+            ;; but naturals are more compact than integers, which are more compact
+            ;; than rationals, which are more compact than complexes.  Denominators
+            ;; are coerced to 1 if they evaluate to 0 -- ugly.
+            ((g-number num)
+             (b* (((mv real-num
+                       real-denom
+                       imag-num
+                       imag-denom)
+                   (break-g-number num)))
+               (flet ((uval (n env)
+                            (bfr-list->u n (car env)))
+                      (sval (n env)
+                            (bfr-list->s n (car env))))
+                 (components-to-number (sval real-num env)
+                                       (uval real-denom env)
+                                       (sval imag-num env)
+                                       (uval imag-denom env)))))
+
+            ;; If-then-else.
+            ((g-ite test then else)
+             (if (_geval_ test env)
+                 (_geval_ then env)
+               (_geval_ else env)))
+
+            ;; Apply: Unevaluated function call.
+            ((g-apply fn args)
+             (and (not (eq fn 'quote))
+                  (let* ((args (_geval_-list args env)))
+                    (mbe :logic (_geval_-ev (cons fn (kwote-lst args)) nil)
+                         :exec (b* ((args (acl2::list-fix args))
+                                    ((mv ok val) (_geval_-apply fn args))
+                                    ((when ok) val))
+                                 (_geval_-ev (cons fn (kwote-lst args))
+                                             nil))))))
+
+            ;; Var: untyped variable.
+            ((g-var name)   (cdr (het name (cdr env))))
+
+            ;; Conses where the car is not a recognized flag represent conses.
+            (& (cons (_geval_ (car x) env)
+                     (_geval_ (cdr x) env))))))
+
+      (defun _geval_-list (x env)
+        (declare (xargs :guard (consp env)
+                        :measure (acl2-count x)))
+        (if (atom x)
+            nil
+          (cons (_geval_ (car x) env)
+                (_geval_-list (cdr x) env)))))
+
+     (in-theory (disable _geval_ _geval_-list))
+
+     (table eval-g-table '_geval_ '(_geval_-list
                                     _geval_-ev
                                     _geval_-ev-lst
+                                    _geval_-apply
                                     _geval_-ev-concrete
                                     _geval_-ev-concrete-lst
                                     . _apply-fns_))))
@@ -276,7 +355,9 @@
   (def-geval-fn geval fns))
 
 
-(def-geval generic-geval nil)
+(def-geval base-geval nil)
+
+
 
 ;; (defthm generic-geval-apply-ev-lst-of-kwote-lst
 ;;   (equal (generic-geval-apply-ev-lst (kwote-lst x) a)
@@ -384,51 +465,51 @@
 ;;            :do-not-induct t))
 ;;   :rule-classes nil
 ;;   :otf-flg t)
-                     
-           
 
-(local (defthm generic-geval-appalist-is-instance-of-generic-geval
-         t
-         :hints (("goal" :use ((:functional-instance
-                                generic-geval
-                                (generic-geval
-                                 (lambda (x env)
-                                   (generic-geval-appalist x env appalist)))
-                                (generic-geval-ev
-                                 (lambda (x a)
-                                   (generic-geval-ev-concrete x a appalist)))
-                                (generic-geval-ev-lst
-                                 (lambda (x a)
-                                   (generic-geval-ev-concrete-lst
-                                    x a appalist)))))
-                  ;; '(generic-geval-apply-ev-lst-of-atom
-                             ;;   generic-geval-apply-ev-substitution)
-                  ;; :in-theory '(generic-geval-apply
-                  ;;              generic-geval-apply-arities
-                  ;;              member-equal
-                  ;;              generic-geval-appalist)
-                  :do-not-induct t)
-                 ;; (and stable-under-simplificationp
-                 ;;      '(:in-theory (enable
-                 ;;                    generic-geval-apply-ev-of-fncall-args)
-                 ;;        :expand ((:free (a)
-                 ;;                  (generic-geval-apply-ev-substitution
-                 ;;                   x a appalist))
-                 ;;                 (:free (x y a)
-                 ;;                  (generic-geval-apply-ev-substitution
-                 ;;                   (cons x y) a appalist)))))
-                 ;; (and stable-under-simplificationp
-                 ;;      '(:in-theory (enable
-                 ;;                    generic-geval-apply-ev-substitution
-                 ;;                    generic-geval-apply-ev-of-fncall-args)))
-                 ;; (and stable-under-simplificationp
-                 ;;      '(:expand ((generic-geval-ev-concrete-lst
-                 ;;                  acl2::x-lst a appalist)
-                 ;;                 (generic-geval-apply-ev-substitution
-                 ;;                  x a appalist))))
-                 )
-         :rule-classes nil
-         :otf-flg t))
+
+
+;; (local (defthm generic-geval-appalist-is-instance-of-generic-geval
+;;          t
+;;          :hints (("goal" :use ((:functional-instance
+;;                                 generic-geval
+;;                                 (generic-geval
+;;                                  (lambda (x env)
+;;                                    (generic-geval-appalist x env appalist)))
+;;                                 (generic-geval-ev
+;;                                  (lambda (x a)
+;;                                    (generic-geval-ev-concrete x a appalist)))
+;;                                 (generic-geval-ev-lst
+;;                                  (lambda (x a)
+;;                                    (generic-geval-ev-concrete-lst
+;;                                     x a appalist)))))
+;;                   ;; '(generic-geval-apply-ev-lst-of-atom
+;;                              ;;   generic-geval-apply-ev-substitution)
+;;                   ;; :in-theory '(generic-geval-apply
+;;                   ;;              generic-geval-apply-arities
+;;                   ;;              member-equal
+;;                   ;;              generic-geval-appalist)
+;;                   :do-not-induct t)
+;;                  ;; (and stable-under-simplificationp
+;;                  ;;      '(:in-theory (enable
+;;                  ;;                    generic-geval-apply-ev-of-fncall-args)
+;;                  ;;        :expand ((:free (a)
+;;                  ;;                  (generic-geval-apply-ev-substitution
+;;                  ;;                   x a appalist))
+;;                  ;;                 (:free (x y a)
+;;                  ;;                  (generic-geval-apply-ev-substitution
+;;                  ;;                   (cons x y) a appalist)))))
+;;                  ;; (and stable-under-simplificationp
+;;                  ;;      '(:in-theory (enable
+;;                  ;;                    generic-geval-apply-ev-substitution
+;;                  ;;                    generic-geval-apply-ev-of-fncall-args)))
+;;                  ;; (and stable-under-simplificationp
+;;                  ;;      '(:expand ((generic-geval-ev-concrete-lst
+;;                  ;;                  acl2::x-lst a appalist)
+;;                  ;;                 (generic-geval-apply-ev-substitution
+;;                  ;;                  x a appalist))))
+;;                  )
+;;          :rule-classes nil
+;;          :otf-flg t))
 
 (defun get-guard-verification-theorem (name state)
   (declare (xargs :mode :program
@@ -447,44 +528,46 @@
 
 (make-event
  (b* (((er thm) (get-guard-verification-theorem
-                 'generic-geval state)))
-   (value `(defthm generic-geval-guards-ok
+                 'base-geval state)))
+   (value `(defthm base-geval-guards-ok
              ,thm
              :hints (("goal" :do-not-induct t))
              :rule-classes nil))))
 
 ;; (prove-congruences (gobj-equiv) generic-geval)
 
-(defconst *geval-appalist-func-inst-template*
-  '(:computed-hint-replacement
-    ((and stable-under-simplificationp
-          '(:expand ((:free (f ar)
-                      (_geval_-apply f ar))))))
-    :use
-    ((:functional-instance
-      _theorem_
-      (_geval_ (lambda (x env)
-                       (_geval_-appalist x env appalist)))
-      (_geval_-ev (lambda (x a)
-                          (_geval_-ev-concrete x a appalist)))
-      (_geval_-ev-lst
-       (lambda (x a)
-               (_geval_-ev-concrete-lst x a appalist)))))
-    :in-theory '(nth-of-_geval_-ev-concrete-lst
-                 acl2::car-to-nth-meta-correct
-                 acl2::nth-of-cdr
-                 _geval_-ev-concrete-lst-of-kwote-lst
-                 acl2::list-fix-when-true-listp
-                 acl2::kwote-list-list-fix
-                 (:t _geval_-ev-concrete-lst)
-                 (:t acl2::list-fix)
-                 car-cons cdr-cons nth-0-cons (nfix))
-    :expand ((_geval_-ev-concrete x a appalist)
-             (:free (f ar)
-              (_geval_-ev-concrete (cons f ar) nil appalist))
-             (_geval_-ev-concrete-lst acl2::x-lst a appalist)
-             (_geval_-appalist x env appalist))
-    :do-not-induct t))
+;; (defconst *geval-appalist-func-inst-template*
+;;   '(:computed-hint-replacement
+;;     ((and stable-under-simplificationp
+;;           '(:expand ((:free (f ar)
+;;                       (_geval_-apply f ar))
+;;                      (:free (x) (hide x))))))
+;;     :use
+;;     ((:functional-instance
+;;       _theorem_
+;;       (_geval_ (lambda (x env)
+;;                        (_geval_-appalist x env appalist)))
+;;       (_geval_-ev (lambda (x a)
+;;                           (_geval_-ev-concrete x a appalist)))
+;;       (_geval_-ev-lst
+;;        (lambda (x a)
+;;                (_geval_-ev-concrete-lst x a appalist)))))
+;;     :in-theory '(nth-of-_geval_-ev-concrete-lst
+;;                  acl2::car-to-nth-meta-correct
+;;                  acl2::nth-of-cdr
+;;                  _geval_-ev-concrete-lst-of-kwote-lst
+;;                  acl2::list-fix-when-true-listp
+;;                  acl2::kwote-list-list-fix
+;;                  (:t _geval_-ev-concrete-lst)
+;;                  (:t acl2::list-fix)
+;;                  car-cons cdr-cons nth-0-cons (nfix))
+;;     :expand ((_geval_-ev-concrete x a appalist)
+;;              (:free (f ar)
+;;               (_geval_-ev-concrete (cons f ar) nil appalist))
+;;              (:free (x) (hide x))
+;;              (_geval_-ev-concrete-lst acl2::x-lst a appalist)
+;;              (_geval_-appalist x env appalist))
+;;     :do-not-induct t))
 
 
 ;; (:use ((:functional-instance
@@ -536,14 +619,14 @@
 ;;     :in-theory nil
 ;;     :do-not '(preprocess simplify)))
 
-(defun geval-appalist-functional-inst-hint (thm geval)
-  (declare (xargs :mode :program))
-  (acl2::template-subst
-   *geval-appalist-func-inst-template*
-   :atom-alist `((_geval_ . ,geval)
-                 (_theorem_ . ,thm))
-   :str-alist `(("_GEVAL_" . ,(symbol-name geval)))
-   :pkg-sym geval))
+;; (defun geval-appalist-functional-inst-hint (thm geval)
+;;   (declare (xargs :mode :program))
+;;   (acl2::template-subst
+;;    *geval-appalist-func-inst-template*
+;;    :atom-alist `((_geval_ . ,geval)
+;;                  (_theorem_ . ,thm))
+;;    :str-alist `(("_GEVAL_" . ,(symbol-name geval)))
+;;    :pkg-sym geval))
 
 
 (defconst *def-eval-g-template*
@@ -566,20 +649,24 @@
      (def-geval _geval_ _apply-fns_)
      (verify-guards _geval_
        :hints (("goal" :use ((:functional-instance
-                              generic-geval-guards-ok
-                              (generic-geval _geval_)
-                              (generic-geval-ev _geval_-ev)
-                              (generic-geval-ev-lst _geval_-ev-lst)))
-                :in-theory (e/d* (_geval_-ev-constraint-0
+                              base-geval-guards-ok
+                              (base-geval _geval_)
+                              (base-geval-list _geval_-list)
+                              (base-geval-ev _geval_-ev)
+                              (base-geval-ev-lst _geval_-ev-lst)))
+                :in-theory (e/d* (_geval_-ev-of-fncall-args
                                   _geval_-apply-agrees-with-_geval_-ev
                                   eq atom
-                                  generic-geval-apply)
+                                  _geval_
+                                  _geval_-list
+                                  base-geval-apply)
                                  (_geval_-apply))))
        :otf-flg t)
-     (local (defthm _geval_-appalist-is-instance-of-_geval_
-              t
-              :hints ((geval-appalist-functional-inst-hint '_geval_ '_geval_))
-              :rule-classes nil))))
+     ;; (local (defthm _geval_-appalist-is-instance-of-_geval_
+     ;;          t
+     ;;          :hints ((geval-appalist-functional-inst-hint '_geval_ '_geval_))
+     ;;          :rule-classes nil))
+     ))
 
 (defmacro def-eval-g (geval fns)
   (acl2::template-subst
@@ -589,6 +676,30 @@
    :str-alist `(("_GEVAL_" . ,(symbol-name geval)))
    :pkg-sym geval))
 
+(def-eval-g generic-geval (cons if))
+
+(defthm-gobj-flag
+  (defthm generic-geval-is-generic-geval-ev-of-gobj->term
+    (equal (generic-geval-ev (gobj->term x env) a)
+           (generic-geval x env))
+    :hints('(:in-theory (enable generic-geval-ev-of-fncall-args
+                                generic-geval gobj->term)
+             :expand ((gobj->term x env)))
+           (and stable-under-simplificationp
+                '(:cases ((eq (g-apply->fn x) 'quote))
+                  :expand ((gobj-list->terms (g-apply->args x) env)))))
+    :flag gobj)
+  (defthm generic-geval-list-is-generic-geval-ev-lst-of-gobj-list->terms
+    (equal (generic-geval-ev-lst (gobj-list->terms x env) a)
+           (generic-geval-list x env))
+    :hints ('(:expand ((generic-geval-list x env)
+                       (gobj-list->terms x env))))
+    :flag list))
+
+
+
+
+
 (local
  ;; test
  (def-eval-g implies-geval
@@ -633,7 +744,7 @@
   (local
    ;; test
    (def-eval-g little-geval
-     (BINARY-*
+     (BINARY-* if cons
       BINARY-+
       PKG-WITNESS
 ;   UNARY-/
diff -Nru acl2-6.2/books/centaur/gl/gify-clause-proc.lisp acl2-6.3/books/centaur/gl/gify-clause-proc.lisp
--- acl2-6.2/books/centaur/gl/gify-clause-proc.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gify-clause-proc.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,13 +1,36 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "g-if")
 (include-book "clause-processors/unify-subst" :dir :system)
-(local (include-book "tools/def-functional-instance" :dir :system))
 (include-book "tools/defevaluator-fast" :dir :system)
-
+(local (include-book "tools/def-functional-instance" :dir :system))
+(local (include-book "hyp-fix-logic"))
 (local (defun dummy-for-g-if-ev-start () nil))
 
+(defun-nx gobj-depends-on-g-if (n p x)
+  (gobj-depends-on n p (g-if-marker x)))
+
+(defun-nx gobj-depends-on-g-or (n p x)
+  (gobj-depends-on n p (g-or-marker x)))
 
 (acl2::defevaluator-fast g-if-ev g-if-ev-lst
   ((g-if-marker$inline x)
@@ -32,11 +55,16 @@
    (mk-g-boolean bdd)
    (cons a b)
    (binary-+ a b)
-;   (generic-geval x env)
+   ; (generic-geval x env)
    (hide x)
    (bfr-eval x env)
+   (pbfr-depends-on n p x)
+   (gobj-depends-on n p x)
+   (gobj-depends-on-g-if n p x)
+   (gobj-depends-on-g-or n p x)
    (car x)
-   (equal x y))
+   (equal x y)
+   (force x))
   :namedp t)
 
 (local (encapsulate nil
@@ -226,6 +254,156 @@
 (local (include-book "gtype-thms"))
 
 
+
+
+(make-event
+ `(defthm gobj-depends-on-of-g-if-pattern
+    (implies (and (not (gobj-depends-on n p test-term))
+                  (not (gobj-depends-on n p then-term))
+                  (not (gobj-depends-on n p else-term)))
+             (not (gobj-depends-on-g-if n p ,(cadr *g-if-pattern*))))
+    :hints (("goal" :expand ((:free (x) (hide x)))
+             :in-theory (enable g-if-marker
+                                g-test-marker
+                                g-branch-marker
+                                mk-g-bdd-ite)))))
+
+(defthm gobj-depends-on-of-g-if-marker
+  (equal (gobj-depends-on n p (g-if-marker x))
+         (gobj-depends-on-g-if n p x)))
+
+(in-theory (disable gobj-depends-on-g-if))
+
+
+(make-event
+ `(defthm gobj-depends-on-of-g-or-pattern
+    (implies (and (not (gobj-depends-on n p test-term))
+                  (not (gobj-depends-on n p else-term)))
+             (not (gobj-depends-on-g-or n p ,(cadr *g-or-pattern*))))
+    :hints (("goal" :expand ((:free (x) (hide x)))
+             :in-theory (enable g-or-marker
+                                g-test-marker
+                                g-branch-marker
+                                mk-g-bdd-ite)))))
+
+(defthm gobj-depends-on-of-g-or-marker
+  (equal (gobj-depends-on n p (g-or-marker x))
+         (gobj-depends-on-g-or n p x)))
+
+(in-theory (disable gobj-depends-on-g-or))
+
+
+
+(defun simp-if-term (x)
+  (beta-reduce-to-fns
+   (remove-return-lasts x)
+   '(g-test-marker$inline g-branch-marker$inline g-hyp-marker$inline)))
+
+(defthm simp-if-term-correct
+  (implies (pseudo-termp x)
+           (equal (g-if-ev (simp-if-term x) a)
+                  (g-if-ev x a))))
+
+(defthm pseudo-termp-of-simp-if-term
+  (implies (pseudo-termp x)
+           (pseudo-termp (simp-if-term x))))
+
+(local (in-theory (disable simp-if-term)))
+
+(local (defthm pseudo-termp-fourth
+         (implies (pseudo-termp x)
+                  (pseudo-termp (fourth x)))))
+
+
+(defun gobj-depends-on-g-or-hyp (x)
+  (b* (((unless (and (consp x) (eq (car x) 'gobj-depends-on-g-or)))
+        ''nil)
+       (n-term (second x))
+       (p-term (third x))
+       (x-term (fourth x))
+       (x-simp (simp-if-term x-term))
+       ((mv match alist) (acl2::simple-one-way-unify (cadr *g-or-pattern*)
+                                                     x-simp nil))
+       ((unless match) ''nil))
+    `(if (force (not (gobj-depends-on ,n-term ,p-term ,(cdr (assoc 'test-term alist)))))
+         (force (not (gobj-depends-on ,n-term ,p-term ,(cdr (assoc 'else-term alist)))))
+       'nil)))
+
+(defun gobj-depends-on-g-or-res (x)
+  (declare (ignore x))
+  ''nil)
+
+(defthm gobj-depends-on-g-or-meta
+  (implies (and (pseudo-termp x)
+                (g-if-ev (gobj-depends-on-g-or-hyp x) a))
+           (equal (g-if-ev x a)
+                  (g-if-ev (gobj-depends-on-g-or-res x) a)))
+  :hints(("Goal" :in-theory (e/d (g-if-ev-of-fncall-args)
+                                 (gobj-depends-on
+                                  assoc-equal
+                                  gobj-depends-on-of-g-or-pattern)))
+         (let* ((unify '(mv-nth 1 (acl2::simple-one-way-unify
+                                   (cadr *g-or-pattern*)
+                                   (simp-if-term (cadddr x))
+                                   nil))))
+           `(:use ((:instance gobj-depends-on-of-g-or-pattern
+                    (n (g-if-ev (cadr x) a))
+                    (p (g-if-ev (caddr x) a))
+                    (test-term (g-if-ev (cdr (assoc 'test-term ,unify)) a))
+                    (else-term (g-if-ev (cdr (assoc 'else-term ,unify)) a))
+                    (hyp (g-if-ev (cdr (assoc 'hyp ,unify)) a))))))
+         (and stable-under-simplificationp
+              '(:expand ((:free (x) (hide x))))))
+  :rule-classes ((:meta :trigger-fns (gobj-depends-on-g-or))))
+
+
+(defun gobj-depends-on-g-if-hyp (x)
+  (b* (((unless (and (consp x) (eq (car x) 'gobj-depends-on-g-if)))
+        ''nil)
+       (n-term (second x))
+       (p-term (third x))
+       (x-term (fourth x))
+       (x-simp (simp-if-term x-term))
+       ((mv match alist) (acl2::simple-one-way-unify (cadr *g-if-pattern*)
+                                                     x-simp nil))
+       ((unless match) ''nil))
+    `(if (force (not (gobj-depends-on ,n-term ,p-term ,(cdr (assoc 'test-term alist)))))
+         (if (force (not (gobj-depends-on ,n-term ,p-term ,(cdr (assoc 'then-term alist)))))
+             (force (not (gobj-depends-on ,n-term ,p-term ,(cdr (assoc 'else-term alist)))))
+           'nil)
+       'nil)))
+
+(defun gobj-depends-on-g-if-res (x)
+  (declare (ignore x))
+  ''nil)
+
+(defthm gobj-depends-on-g-if-meta
+  (implies (and (pseudo-termp x)
+                (g-if-ev (gobj-depends-on-g-if-hyp x) a))
+           (equal (g-if-ev x a)
+                  (g-if-ev (gobj-depends-on-g-if-res x) a)))
+  :hints(("Goal" :in-theory (e/d (g-if-ev-of-fncall-args)
+                                 (gobj-depends-on
+                                  assoc-equal
+                                  gobj-depends-on-of-g-if-pattern)))
+         (let* ((unify '(mv-nth 1 (acl2::simple-one-way-unify
+                                   (cadr *g-if-pattern*)
+                                   (simp-if-term (cadddr x))
+                                   nil))))
+           `(:use ((:instance gobj-depends-on-of-g-if-pattern
+                    (n (g-if-ev (cadr x) a))
+                    (p (g-if-ev (caddr x) a))
+                    (test-term (g-if-ev (cdr (assoc 'test-term ,unify)) a))
+                    (then-term (g-if-ev (cdr (assoc 'then-term ,unify)) a))
+                    (else-term (g-if-ev (cdr (assoc 'else-term ,unify)) a))
+                    (hyp (g-if-ev (cdr (assoc 'hyp ,unify)) a))))))
+         (and stable-under-simplificationp
+              '(:expand ((:free (x) (hide x))))))
+  :rule-classes ((:meta :trigger-fns (gobj-depends-on-g-if))))
+
+
+
+
 (encapsulate
   (((geval-for-meta * *) => *))
   (local (defun geval-for-meta (x env)
@@ -271,7 +449,7 @@
                (geval-for-meta x b)
              (geval-for-meta y b)))))
 
-         
+
 
 
 
@@ -289,7 +467,7 @@
      (local (add-bfr-pat (bfr-fix . &)))
      (local (in-theory (disable bfr-eval-booleanp
                                 equal-of-booleans-rewrite)))
- 
+
 
 
      (defthm geval-for-meta-mk-g-bdd-ite-correct
@@ -298,9 +476,11 @@
                        (if (bfr-eval bdd (car env))
                            (geval-for-meta then env)
                          (geval-for-meta else env))))
-       :hints(("Goal" :in-theory (enable true-under-hyp
-                                         false-under-hyp
-                                         mk-g-bdd-ite)
+       :hints(("Goal" :in-theory (e/d (mk-g-bdd-ite
+                                       hyp-ops-correct)
+                                      (hyp-fix
+                                       true-under-hyp
+                                       false-under-hyp))
                :do-not-induct t)
               (bfr-reasoning)))
 
@@ -487,7 +667,7 @@
 ;;              :do-not-induct t)))))
 
 ;; (in-theory (disable g-or-gobjectp-extract))
-  
+
 
 ;; (defun g-or-gobjectp-meta-hyp (x)
 ;;   (b* (((mv ok term) (g-or-gobjectp-extract x 'extract))
@@ -556,7 +736,7 @@
 ;;              :do-not-induct t)))))
 
 ;; (in-theory (disable g-if-gobjectp-extract))
-  
+
 
 ;; (defun g-if-gobjectp-meta-hyp (x)
 ;;   (b* (((mv ok term) (g-if-gobjectp-extract x 'extract))
@@ -617,7 +797,12 @@
        (bfr-eval x env)
        (car x)
        (equal x y)
-       (geval x env))
+       (geval x env)
+       (force x)
+       (pbfr-depends-on n p x)
+       (gobj-depends-on n p x)
+       (gobj-depends-on-g-if n p x)
+       (gobj-depends-on-g-or n p x))
       :namedp t)
 
      (local (def-ruleset! g-if-or-meta-evaluator-constraints
@@ -674,7 +859,7 @@
                       (geval-for-meta geval)
                       (g-if-ev eval)
                       (g-if-ev-lst eval-lst))))))
-     
+
 
      (local
       (defthm geval-of-g-or-term-subst
@@ -760,7 +945,7 @@
      (defun g-or-geval-meta-subterms-wrapper (x)
        (declare (xargs :guard t))
        (ec-call (g-or-geval-meta-subterms x 'subterms)))
-    
+
 
      (defthm g-or-geval-meta-subterms-correct
        (mv-let (ok hyp test else env)
@@ -780,7 +965,7 @@
      (in-theory (disable g-or-geval-meta-subterms))
 
      (memoize 'g-or-geval-meta-subterms-wrapper :condition nil)
-             
+
      (defun g-or-geval-meta-hyp (x)
        (b* (((mv ok hyp & & env)
              (g-or-geval-meta-subterms-wrapper x))
@@ -854,7 +1039,7 @@
                   :do-not-induct t)))))
 
      (in-theory (disable g-if-geval-extract))
-  
+
 
      (defun g-if-geval-meta-subterms (x dummy)
        (declare (ignore dummy))
@@ -875,7 +1060,7 @@
      (defun g-if-geval-meta-subterms-wrapper (x)
        (declare (xargs :guard t))
        (ec-call (g-if-geval-meta-subterms x 'subterms)))
-    
+
 
      (defthm g-if-geval-meta-subterms-correct
        (mv-let (ok hyp test then else env)
@@ -897,7 +1082,7 @@
      (in-theory (disable g-if-geval-meta-subterms))
 
      (memoize 'g-if-geval-meta-subterms-wrapper :condition nil)
-             
+
      (defun g-if-geval-meta-hyp (x)
        (b* (((mv ok hyp & & & env)
              (g-if-geval-meta-subterms-wrapper x))
@@ -1000,7 +1185,7 @@
 
 ;; test.
 (local (def-geval-meta generic-geval generic-gify-ev generic-gify-ev-lst))
-                                  
+
 
 
 
@@ -1106,10 +1291,10 @@
 ;;                    (mv erp (cons x gobj-assms) gnorm-assms obligs)))
 ;;              (mv "bad or" gobj-assms gnorm-assms obligs))))
 ;;         (&
-         
-         
-              
-        
+
+
+
+
 
 
 
diff -Nru acl2-6.2/books/centaur/gl/gify-thms.lisp acl2-6.3/books/centaur/gl/gify-thms.lisp
--- acl2-6.2/books/centaur/gl/gify-thms.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gify-thms.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,14 +1,31 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "gify-clause-proc")
-
+(include-book "std/misc/two-nats-measure" :dir :system)
 (local (include-book "gtype-thms"))
 (local (include-book "gobjectp-thms"))
 (local (include-book "general-object-thms"))
 (local (include-book "hyp-fix-logic"))
-(include-book "std/misc/two-nats-measure" :dir :system)
+
 
 ;; These events are included here redundantly to avoid having to include all
 ;; the above (locally-included) books everywhere we want a GL clause processor.
@@ -68,6 +85,26 @@
          (cons (generic-geval x env)
                (generic-geval y env))))
 
+(defthm generic-geval-list-gl-cons
+  (equal (generic-geval-list (gl-cons x y) env)
+         (cons (generic-geval x env)
+               (generic-geval-list y env)))
+  :hints(("Goal" :expand ((:free (x) (generic-geval-list (cons x y) env))))))
+
+(defthm generic-geval-list-atom
+  (implies (not (consp x))
+           (equal (generic-geval-list x env) nil))
+  :hints(("Goal" :expand ((generic-geval-list x env))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm generic-geval-g-apply
+  (implies (not (equal fn 'quote))
+           (equal (generic-geval (g-apply fn args) env)
+                  (generic-geval-ev (cons fn (kwote-lst (generic-geval-list args env)))
+                                    nil)))
+  :hints (("goal" :expand ((generic-geval (g-apply fn args) env))
+           :in-theory (enable generic-geval-apply))))
+
 (defthm generic-geval-nil
   (equal (generic-geval nil env) nil))
 
@@ -76,10 +113,11 @@
            (equal (generic-geval x env) x))
   :rule-classes ((:rewrite :backchain-limit-lst 0)))
 
-(defthm generic-geval-g-apply
-  (equal (generic-geval (g-apply fn args) env)
-         (generic-geval-ev (cons fn (kwote-lst (generic-geval args env)))
-                           nil)))
+;; (defthm generic-geval-g-apply
+;;   (implies (not (eq fn 'quote))
+;;            (equal (generic-geval (g-apply fn args) env)
+;;                   (generic-geval-ev (cons fn (kwote-lst (generic-geval-list args env)))
+;;                                     nil))))
 
 ;; (defthm generic-geval-gobj-fix
 ;;   (equal (generic-geval (gobj-fix x) env)
@@ -120,7 +158,7 @@
 ;; (add-to-ruleset! g-gobjectp-lemmas '(g-if-gobjectp-meta-correct
 ;;                                      gobjectp-g-if-marker
 ;;                                      g-or-gobjectp-meta-correct
-;;                                      gobjectp-g-or-marker 
+;;                                      gobjectp-g-or-marker
 ;;                                      gobjectp-g-apply
 ;;                                      gobjectp-gobj-fix
 ;;                                      gobjectp-g-test-marker
@@ -146,6 +184,8 @@
   '(generic-geval-gl-cons
     generic-geval-nil
     generic-geval-g-apply
+    generic-geval-list-gl-cons
+    generic-geval-list-atom
     mk-g-ite-correct
     mk-g-boolean-correct
     mk-g-concrete-correct
@@ -169,7 +209,11 @@
                                  bfr-and-of-nil
                                  bfr-or-of-t
                                  (g-keyword-symbolp)
-                                 gl-aside gl-error-is-nil))
+                                 gl-aside gl-error-is-nil
+                                 gobj-depends-on-of-g-if-marker
+                                 gobj-depends-on-of-g-or-marker
+                                 gobj-depends-on-g-if-meta
+                                 gobj-depends-on-g-or-meta))
 
 ;; (defthm bfr-fix-x-is-x-when-bfr-p
 ;;   (implies (bfr-p x)
diff -Nru acl2-6.2/books/centaur/gl/gify.lisp acl2-6.3/books/centaur/gl/gify.lisp
--- acl2-6.2/books/centaur/gl/gify.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gify.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,7 +1,24 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "tools/bstar" :dir :system)
 (include-book "defapply")
 (include-book "misc/hons-help" :dir :system)
@@ -30,7 +47,7 @@
        acc
      (collect-fns-lst (cdr lst) clique
                       (collect-fns (car lst) clique acc)))))
-          
+
 
 (defun clique-bodies (clique world)
   (if (atom clique)
@@ -101,13 +118,13 @@
                    (else (gify-term (cadddr x) fn)))
               `(g-if ,test ,then ,else))))
          ((consp (car x))
-          (er hard 'gify-term 
+          (er hard 'gify-term
               "We expect lambdas to all have been factored out of functions to
 be gified.  If not, implement this case.  Culprit (in function ~x0): ~x1~%"
               fn (car x)))
          (t (cons (gl-fnsym (car x))
                   (append (gify-term-list (cdr x) fn)
-                          '(hyp clk))))))
+                          '(hyp clk config bvar-db state))))))
  (defun gify-term-list (x fn)
    (if (endp x)
        nil
@@ -168,13 +185,15 @@
          (gbody (gify-body body (car fns)))
          (formals (wgetprop fn 'formals))
          (recursivep (wgetprop top-fn 'recursivep))
-         (guards `(natp clk))
+         (guards `(and (natp clk)
+                       (glcp-config-p config)))
          (name (gl-fnsym (if endp top-fn fn)))
          (defun
-           `(defun ,name ,(append formals '(hyp clk))
+           `(defun ,name ,(append formals '(hyp clk config bvar-db state))
               (declare
                (xargs
                 :guard ,guards
+                :stobjs (bvar-db state)
                 :verify-guards nil
                 . ,(and recursivep
                         `(:measure
@@ -183,7 +202,7 @@
                                   `(:hints (("goal" :in-theory
                                              (e/d** ((:ruleset
                                                       clk-measure-rules))))))))))
-               (ignorable hyp clk . ,formals))
+               (ignorable hyp clk config bvar-db state . ,formals))
                 ,(if endp
                      (let ((clkbody `(if (zp clk)
                                          (prog2$
@@ -209,7 +228,7 @@
         (gify-factored-fns top-fn (cdr fns) (1+ idx) world
                            (cons defun defuns))))))
 
-                           
+
 
 (defmacro factored-fns (fn)
   `(cdr (assoc-eq ,fn (table-alist 'factored-fns world))))
@@ -232,7 +251,7 @@
     (if (and recp (<= 2 (length defuns)))
         `(mutual-recursion . ,defuns)
       `(progn . ,(reverse defuns)))))
-                     
+
 
 (defun gify-stub (fn world)
   (let* ((formals (wgetprop fn 'formals))
@@ -241,8 +260,10 @@
                       (wgetprop fn 'non-executablep)
                       (assoc-eq fn (table-alist 'do-not-execute
                                                 world)))))
-    `(defun ,name (,@formals hyp clk)
-       (declare (xargs :guard (natp clk)
+    `(defun ,name (,@formals hyp clk config bvar-db state)
+       (declare (xargs :guard (and (natp clk)
+                                   (glcp-config-p config))
+                       :stobjs (bvar-db state)
                        :verify-guards nil))
        ,(if nonexec
             `(g-apply ',fn (gl-list . ,formals))
@@ -282,7 +303,7 @@
 
 
 
-            
+
 
 ;; (defun gobjectp-thmname (fn)
 ;;   (incat 'gl-thm::foo "GOBJECTP-" (symbol-name fn)))
@@ -298,7 +319,7 @@
 ;;          (endp (endp (cdr fns)))
 ;;          (name (gl-fnsym (if endp top-fn fn)))
 ;;          (gobjectp-thm `(,name
-;;                          (gobjectp (,name ,@formals hyp clk))
+;;                          (gobjectp (,name ,@formals hyp clk config bvar-db state))
 ;;                          :name ,(gobjectp-thmname name))))
 ;;       (if endp
 ;;           (cons gobjectp-thm entries)
@@ -321,10 +342,10 @@
 ;;          (thmname (gobjectp-thmname name))
 ;;          (formals (wgetprop fn 'formals)))
 ;;       (cons `(defthm ,thmname
-;;                (gobjectp (,name ,@formals hyp clk)))
+;;                (gobjectp (,name ,@formals hyp clk config bvar-db state)))
 ;;             (gobjectp-redundant-top-thms (cdr clique) world)))))
-         
-         
+
+
 
 
 (defmacro defname (name)
@@ -343,9 +364,9 @@
 ;;          (defname (defname name))
 ;;          (gobjectp-thm
 ;;           `(defthm ,gobjectp-name
-;;              (gobjectp (,name ,@formals hyp clk))
+;;              (gobjectp (,name ,@formals hyp clk config bvar-db state))
 ;;              :hints (("goal" :expand ((:with (:definition ,defname)
-;;                                              (,name ,@formals hyp clk)))
+;;                                              (,name ,@formals hyp clk config bvar-db state)))
 ;;                       :do-not '(preprocess)))))
 ;;          (gobjectp-thm (if endp gobjectp-thm `(local ,gobjectp-thm))))
 ;;       (if endp
@@ -530,7 +551,7 @@
 
 
 
-(defun g-factored-fns-verify-guards (top-fn fns world) 
+(defun g-factored-fns-verify-guards (top-fn fns world)
  (if (endp fns)
       (er hard 'g-factored-fns-verify-guards
           "Empty list of functions; top: ~x0~%" top-fn)
@@ -554,7 +575,7 @@
           (cons `(:type-prescription ,(car clique))
                 (type-prescriptions-of-mv-fns (cdr clique) world))
         (type-prescriptions-of-mv-fns (cdr clique) world)))))
-          
+
 
 
 (defun g-guards-fns-and-deps1 (deps world)
@@ -588,7 +609,7 @@
                                  zp natp)
                                 ((immediate-force-modep) not))))
        . ,(g-guards-fns-and-deps1 deps world))))
-           
+
 
 
 
@@ -622,7 +643,7 @@
          (name (gl-fnsym fn))
          (g-correct-thm `(,name
                           (implies (bfr-eval hyp (car env))
-                                   (equal (,ev (,name ,@formals hyp clk) env)
+                                   (equal (,ev (,name ,@formals hyp clk config bvar-db state) env)
                                           (,fn . ,(eval-list-env ev formals))))
                           . ,(if endp
                                  `(:name ,(correct-thmname name))
@@ -662,10 +683,10 @@
          (g-correct-thm
           `(defthm ,g-correct-name
              (implies (bfr-eval hyp (car env))
-                      (equal (,ev (,name ,@formals hyp clk) env)
+                      (equal (,ev (,name ,@formals hyp clk config bvar-db state) env)
                              (,fn . ,(eval-list-env ev formals))))
              :hints (("goal" :expand
-                      ((,name ,@formals hyp clk))
+                      ((,name ,@formals hyp clk config bvar-db state))
                       ,@(and endp definedp
                              `(:in-theory (e/d ()
                                                ,(factored-fn-correct-thms
@@ -789,7 +810,7 @@
                                              `(:expand (,term)))))))
                                (and stable-under-simplificationp
                                     '(:expand ((:free (x) (hide x))))))))
-                      
+
                       ;; BOZO. This is an ugly sort of desperation move. Blech.
                       ;; (and stable-under-simplificationp
 ;;                            '(:in-theory (union-theories
@@ -857,7 +878,7 @@
       (if (hons-get-any clique al)
           (remove-cliques-in-al (cdr fns) al world)
         (cons fn (remove-cliques-in-al (cdr fns) al world))))))
-         
+
 
 (defun lambda-for-apply-stub-fi (oldfns newfns world)
   `(lambda (f args)
@@ -897,7 +918,7 @@
 ;;          (applyfns
 ;;           (cdr (assoc apply (table-alist 'g-apply-table world))))
 ;;          (oldapplyfns
-;;           (cdr (assoc oldapply (table-alist 'g-apply-table world))))) 
+;;           (cdr (assoc oldapply (table-alist 'g-apply-table world)))))
 ;;   `(:functional-instance
 ;;     ,thmname
 ;;     ,@(if (eq oldapply 'apply-stub)
@@ -909,15 +930,16 @@
 
 
 (defun eval-g-fi (eval oldeval thmname world)
-  (b* (((list ?new-appalist new-ev new-evlst)
+  (b* (((list eval-list new-ev new-evlst)
         (cdr (assoc eval (table-alist 'eval-g-table world))))
-       ((list ?old-appalist old-ev old-evlst)
+       ((list oldeval-list old-ev old-evlst)
         (cdr (assoc oldeval (table-alist 'eval-g-table world)))))
     `(:functional-instance
       ,thmname
       (,old-ev ,new-ev)
       (,old-evlst ,new-evlst)
-      (,oldeval ,eval))))
+      (,oldeval ,eval)
+      (,oldeval-list ,eval-list))))
 
 (defconst *eval-g-prove-f-i-template*
   '(:computed-hint-replacement
@@ -930,11 +952,12 @@
     ((:functional-instance
       _theorem_
       (_oldgeval_ _newgeval_)
+      (_oldgeval_-list _newgeval_-list)
       (_oldgeval_-ev _newgeval_-ev)
       (_oldgeval_-ev-lst _newgeval_-ev-lst)))
     :in-theory (e/d**
-                (nth-of-_oldgeval_-ev-concrete-lst
-                 nth-of-_newgeval_-ev-concrete-lst
+                (;; nth-of-_oldgeval_-ev-concrete-lst
+                 ;; nth-of-_newgeval_-ev-concrete-lst
                  acl2::car-to-nth-meta-correct
                  acl2::nth-of-cdr
                  acl2::list-fix-when-true-listp
@@ -944,11 +967,12 @@
                  _newgeval_-apply-agrees-with-_newgeval_-ev-rev
                  _oldgeval_-ev-rules
                  _newgeval_-ev-rules
-                 _newgeval_-ev-constraint-0
-                 _oldgeval_-ev-constraint-0
+                 _newgeval_-ev-of-fncall-args
+                 _oldgeval_-ev-of-fncall-args
                  car-cons cdr-cons nth-0-cons (nfix)))
-    :expand ((_oldgeval_ x env)
-             (_newgeval_ x env))
+    :expand (; (_oldgeval_ x env)
+             (:with _newgeval_ (_newgeval_ x env))
+             (:with _newgeval_-list (_newgeval_-list x env)))
     :do-not-induct t))
 
 (defun eval-g-prove-f-i-fn (eval oldeval thmname)
@@ -990,7 +1014,7 @@
      ;;                   `(:theorem (equal (,oldeval x env)
      ;;                                     (,oldeval x env)))
      ;;                   world))
-               
+
      ;;           :do-not '(preprocess simplify)
      ;;           :in-theory nil))
      ;; :rule-classes nil)))
@@ -1006,12 +1030,17 @@
   (incat 'gl-thm::foo (symbol-name thm) "-FOR-" (symbol-name eval)))
 
 (defun eval-g-functional-instance-fn (eval oldeval thmname world)
-  (let* ((apply (caddr (assoc eval (table-alist 'eval-g-table world))))
-         (oldapply (caddr (assoc oldeval (table-alist 'eval-g-table world))))
-         (thmbody (wgetprop thmname 'theorem))
-         (subst-body (subst-fns-term thmbody (list (cons oldeval eval)
-                                                   (cons oldapply apply))))
-         (newthmname (f-i-thmname thmname eval)))
+  (b* (((list neweval-list new-ev new-evlst new-apply)
+        (cdr (assoc eval (table-alist 'eval-g-table world))))
+       ((list oldeval-list old-ev old-evlst old-apply)
+        (cdr (assoc oldeval (table-alist 'eval-g-table world))))
+       (thmbody (wgetprop thmname 'theorem))
+       (subst-body (subst-fns-term thmbody (list (cons oldeval eval)
+                                                 (cons old-apply new-apply)
+                                                 (cons oldeval-list neweval-list)
+                                                 (cons old-ev new-ev)
+                                                 (cons old-evlst new-evlst))))
+       (newthmname (f-i-thmname thmname eval)))
     `(defthm ,newthmname
        ,subst-body
        :hints (("goal" :in-theory (theory 'minimal-theory)
@@ -1019,8 +1048,8 @@
 
 (defmacro eval-g-functional-instance (thmname eval oldeval)
   `(make-event (eval-g-functional-instance-fn ',eval ',oldeval ',thmname (w state))))
-    
-  
+
+
 
 
 (defun correctness-lemmas-for-new-apply11
@@ -1035,7 +1064,7 @@
                ((mv thms done-finsts)
                 (if (member thmeval done-finsts)
                     (mv thms done-finsts)
-                  (mv (cons `(local (eval-g-prove-f-i 
+                  (mv (cons `(local (eval-g-prove-f-i
                                      ,(incat 'gl-thm::foo
                                              (symbol-name eval)
                                              "-IS-FUNCTIONAL-INSTANCE-OF-"
@@ -1054,7 +1083,7 @@
          (cdr alist) eval world done-finsts thms (cons thmbase theory))))))
 
 
-  
+
 (defun correctness-lemmas-for-new-apply1 (alist eval world
                                                 done-finsts thms theory)
   (if (atom alist)
@@ -1182,7 +1211,7 @@
              `(in-theory (disable ,thmname))
              `(table preferred-defs ',fn ',thmname)
              (make-unnorm-preferred-defs1 (cdr fns) world)))))
-           
+
 
 (defun make-unnorm-preferred-defs (fns world)
   `(progn . ,(make-unnorm-preferred-defs1 fns world)))
@@ -1225,7 +1254,9 @@
        (new-fns (set-difference-eq
                  (collect-fn-deps fns world)
                  '(acl2::return-last)))
-       (apply-fns (union-eq new-fns (prev-apply-fns world))))
+       (apply-fns (union-eq new-fns
+                            (prev-apply-fns world)
+                            (strip-cars (table-alist 'gl-function-info world)))))
     `(encapsulate nil
        (logic)
        (local (table acl2::theory-invariant-table nil nil :clear))
@@ -1241,8 +1272,8 @@
        (make-event (gify-fns-and-deps ',new-fns (w state)))
        (make-event (flagify-g-fns-and-deps ',new-fns (w state)))
 
-       
-       
+
+
        ;; (make-event (gobjectp-fns-and-deps ',new-fns (w state)))
        (make-event (g-guards-fns-and-deps ',new-fns (w state)))
 
@@ -1267,10 +1298,14 @@
                                                       state))))
 
 (defun make-geval-fn (geval new-fns state)
-  (declare (xargs :stobjs state))
+  (declare (xargs :stobjs state :mode :program))
   (b* ((world (w state))
-       (new-fns (collect-fn-deps new-fns world))
-       (fns (union-eq new-fns (prev-apply-fns world)))
+       (new-fns (set-difference-eq
+                 (collect-fn-deps new-fns world)
+                 '(acl2::return-last)))
+       (fns (union-eq new-fns
+                      (strip-cars (table-alist 'gl-function-info world))
+                      (prev-apply-fns world)))
        ;; (ap (incat geval (symbol-name geval) "-APPLY"))
        )
     `(encapsulate nil
diff -Nru acl2-6.2/books/centaur/gl/gl-doc-string.lisp acl2-6.3/books/centaur/gl/gl-doc-string.lisp
--- acl2-6.2/books/centaur/gl/gl-doc-string.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-doc-string.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-
-(in-package "GL")
-
-(defdoc acl2::gl ":Doc-section GL
-G in the Logic: a symbolic simulation framework for ACL2~/
-
-This library supports bit-level symbolic execution of ACL2 logic-mode
-programs.  Symbolic execution is supported in two ways: by a code
-transformation which translates an ACL2 logic-mode function into a new
-function called its *symbolic counterpart*; or by an interpreter which
-traverses a term symbolically evaluating its contents.  A symbolic
-execution performs analogous operations to a normal, concrete
-execution, but these operations are on *symbolic objects* rather than
-ordinary ACL2 objects.
-
-Various subtopics are linked below.  To begin proving theorems using
-GL, first read ~il[DEF-GL-THM], ~il[DEF-GL-CLAUSE-PROCESSOR], and
-~il[GL::SHAPE-SPECS].
-~/
-~/")
-
diff -Nru acl2-6.2/books/centaur/gl/gl-generic-clause-proc.lisp acl2-6.3/books/centaur/gl/gl-generic-clause-proc.lisp
--- acl2-6.2/books/centaur/gl/gl-generic-clause-proc.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-generic-clause-proc.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,1361 +1,111 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
-(include-book "param")
-(include-book "g-if")
+(include-book "tools/clone-stobj" :dir :system)
+(include-book "var-bounds")
+(include-book "shape-spec")
+(include-book "gl-generic-interp-defs")
+(include-book "ctrex-utils")
+(include-book "shape-spec")
 (include-book "gify")
 (include-book "bfr-sat")
-(include-book "glcp-templates")
-
 (include-book "misc/untranslate-patterns" :dir :system)
-(include-book "data-structures/no-duplicates" :dir :system)
 (include-book "clause-processors/use-by-hint" :dir :system)
 (include-book "clause-processors/decomp-hint" :dir :system)
 (include-book "centaur/misc/interp-function-lookup" :dir :system)
-
+(include-book "constraint-db-deps")
+(local (include-book "gl-generic-interp"))
 (local (include-book "general-object-thms"))
+(local (include-book "hyp-fix-logic"))
+(local (include-book "data-structures/no-duplicates" :dir :system))
 (local (include-book "centaur/misc/hons-sets" :dir :system))
 (local (include-book "tools/with-quoted-forms" :dir :system))
-(local (include-book "hyp-fix-logic"))
-(local (in-theory (disable* sets::double-containment
-                            w)))
-
-
-(defmacro glcp-value (res)
-  `(mv nil obligs ,res state))
-
-;; (defmacro glcp-er-let* (alist body)
-;;   (declare (xargs :guard (and (acl2::doubleton-list-p alist)
-;;                               (symbol-alistp alist))))
-;;   (if (null alist)
-;;       `(check-vars-not-free
-;;         (glcp-er-let*-use-nowhere-else)
-;;         ,body)
-;;     `(mv-let (glcp-er-let*-use-nowhere-else
-;;               obligs ,(caar alist) state)
-;;        ,(cadar alist)
-;;        (if glcp-er-let*-use-nowhere-else
-;;            (mv glcp-er-let*-use-nowhere-else
-;;                obligs ,(caar alist) state)
-;;          (glcp-er-let* ,(cdr alist) ,body)))))
-
-(defmacro patbind-glcp-er (args bindings expr)
-  (declare (xargs :guard (and (consp args) (eq (cdr args) nil))))
-  `(b* (((mv patbind-glcp-er-error obligs ,(car args) state)
-         ,(car bindings))
-        ((when patbind-glcp-er-error)
-         (mv patbind-glcp-er-error obligs nil state)))
-     (check-vars-not-free
-      (patbind-glcp-er-error) ,expr)))
-
-(verify-termination acl2::evisc-tuple)
-(verify-guards acl2::evisc-tuple)
-
-(defmacro glcp-if (test then else)
-  `(b* (((glcp-er test) ,test)
-        (gtests (gtests test hyp))
-        (then-hyp (hf (bfr-or (gtests-unknown gtests)
-                               (gtests-nonnil gtests))))
-        (else-hyp (hf (bfr-or (gtests-unknown gtests)
-                               (bfr-not (gtests-nonnil gtests)))))
-        ((glcp-er then)
-         (if then-hyp
-             (let ((hyp (bfr-and hyp then-hyp)))
-               (declare (ignorable hyp))
-               ,then)
-           (glcp-value nil)))
-        ((glcp-er else)
-         (if else-hyp
-             (let ((hyp (bfr-and hyp else-hyp)))
-               (declare (ignorable hyp))
-               ,else)
-           (glcp-value nil)))
-        (merge (gobj-ite-merge (gtests-nonnil gtests) then else
-                               (bfr-and (bfr-not (gtests-unknown gtests))
-                                         hyp))))
-     (if (hf (gtests-unknown gtests))
-         (glcp-value
-          (mk-g-ite (mk-g-boolean (gtests-unknown gtests))
-                    (mk-g-ite (gtests-obj gtests) then else)
-                    merge))
-       (glcp-value merge))))
-
-
-(defmacro glcp-or (test else)
-  `(b* (((glcp-er test) ,test)
-        (gtests (gtests test hyp))
-        (else-hyp (hf (bfr-or (gtests-unknown gtests)
-                               (bfr-not (gtests-nonnil gtests)))))
-        ((glcp-er else)
-         (if else-hyp
-             (let ((hyp (bfr-and hyp else-hyp)))
-               (declare (ignorable hyp))
-               ,else)
-           (glcp-value nil)))
-        (merge (gobj-ite-merge (gtests-nonnil gtests) test else
-                               (bfr-and (bfr-not (gtests-unknown gtests))
-                                         hyp))))
-     (if (hf (gtests-unknown gtests))
-         (glcp-value
-          (mk-g-ite (mk-g-boolean (gtests-unknown gtests))
-                    (mk-g-ite (gtests-obj gtests) test else)
-                    merge))
-       (glcp-value merge))))
-
-
-(local
- (defthmd gl-eval-of-atom
-   (implies (atom x)
-            (equal (generic-geval x env) x))
-   :hints (("goal" :in-theory (enable tag)
-            :expand ((generic-geval x env))))
-   :rule-classes ((:rewrite :backchain-limit-lst 0))))
-
-(set-state-ok t)
-
-(defun gl-cp-hint (x)
-  (declare (ignore x))
-  t)
-
-(in-theory (disable gl-cp-hint (:type-prescription gl-cp-hint) (gl-cp-hint)))
-
-
-
-(encapsulate
-  (((glcp-generic-run-gified * * * * state)
-    => (mv * *)
-    :formals (fn actuals hyp clk state)
-    :guard (and (symbolp fn)
-                (gobj-listp actuals)
-                (natp clk)))
-   ((glcp-generic-ev * *) => *)
-   ((glcp-generic-ev-lst * *) => *)
-   ((glcp-generic-geval * *) => *))
-
-  (local (defun glcp-generic-geval (x env)
-           (generic-geval x env)))
-
-  (local (defun glcp-generic-run-gified (fn actuals hyp clk state)
-           (declare (xargs :stobjs state
-                           :guard (and (symbolp fn)
-                                       (natp clk)))
-                    (ignorable fn actuals hyp clk state))
-           (mv nil nil)))
-
-  (local (acl2::defevaluator-fast
-          glcp-generic-ev glcp-generic-ev-lst
-          ((if a b c)
-           (gl-cp-hint x)
-           (shape-spec-obj-in-range a b)
-           (return-last fn arg1 arg2)
-           (use-by-hint x)
-           (equal a b)
-           (acl2::typespec-check ts x)
-           (implies a b)
-           (iff a b)
-           (not x)
-           (cons a b)
-           (gl-aside x)
-           (gl-ignore x)
-           (gl-error x))
-          :namedp t))
-
-  (defthm glcp-generic-run-gified-correct
-    (implies (and (bfr-eval hyp (car env))
-                  (gobj-listp actuals)
-                  (mv-nth 0 (glcp-generic-run-gified fn actuals hyp
-                                                     clk state)))
-             (equal (glcp-generic-geval
-                     (mv-nth 1 (glcp-generic-run-gified
-                                fn actuals hyp clk state))
-                     env)
-                    (glcp-generic-ev
-                     (cons fn
-                           (acl2::kwote-lst
-                            (glcp-generic-geval actuals env))) nil))))
-
-  (defthm true-listp-glcp-generic-run-gified
-    (true-listp (glcp-generic-run-gified fn actuals hyp clk state)))
-
-  (make-event
-   `(progn
-      . ,(acl2::defevaluator-fast-form/defthms-named
-          'glcp-generic-ev 'glcp-generic-ev-lst
-          '((if a b c)
-            (gl-cp-hint x)
-            (shape-spec-obj-in-range a b)
-            (return-last fn arg1 arg2)
-            (use-by-hint x)
-            (equal a b)
-            (acl2::typespec-check ts x)
-            (implies a b)
-            (iff a b)
-            (not x)
-            (cons a b)
-            (gl-aside x)
-            (gl-ignore x)
-            (gl-error x)))))
-
-
-  (defthm glcp-generic-geval-atom
-    (implies (atom x)
-             (equal (glcp-generic-geval x env) x))
-    :hints(("Goal" :in-theory (enable gl-eval-of-atom)))
-    :rule-classes ((:rewrite :backchain-limit-lst 0)))
-
-  (defthm glcp-generic-geval-mk-g-boolean-correct
-    (equal (glcp-generic-geval (mk-g-boolean x) env)
-           (bfr-eval x (car env))))
-
-
-  (defthm glcp-generic-geval-gobj-ite-merge-correct
-    (implies (bfr-eval hyp (car env))
-             (equal (glcp-generic-geval (gobj-ite-merge c x y hyp)
-                                        env)
-                    (if (bfr-eval c (car env))
-                        (glcp-generic-geval x env)
-                      (glcp-generic-geval y env))))
-    :hints(("Goal" :in-theory (disable generic-geval))))
-
-  (defthmd glcp-generic-geval-gtests-nonnil-correct
-    (implies (and (not (bfr-eval (gtests-unknown (gtests x hyp))
-                                 (car env)))
-                  (bfr-eval hyp (car env)))
-             (equal (bfr-eval (gtests-nonnil (gtests x hyp))
-                              (car env))
-                    (if (glcp-generic-geval x env) t nil)))
-    :hints (("goal" :expand ((glcp-generic-geval x env))
-             :in-theory (e/d** (gtests-nonnil-correct)))))
-
-  (defthm glcp-generic-geval-gtests-obj-correct
-    (implies (and (bfr-eval (gtests-unknown (gtests x hyp))
-                            (car env))
-                  (bfr-eval hyp (car env)))
-             (iff (glcp-generic-geval (gtests-obj (gtests x hyp))
-                                      env)
-                  (glcp-generic-geval x env)))
-    :hints (("Goal" :in-theory
-             (e/d** (glcp-generic-geval
-                     gtests-obj-correct)))))
-
-  (defthm glcp-generic-geval-mk-g-ite-correct
-    (equal (glcp-generic-geval (mk-g-ite c x y) b)
-           (if (glcp-generic-geval c b)
-               (glcp-generic-geval x b)
-             (glcp-generic-geval y b)))
-    :hints (("Goal" :in-theory
-             (e/d** (glcp-generic-geval
-                     mk-g-ite-correct)))))
-
-  (defthm glcp-generic-geval-mk-g-concrete-correct
-    (equal (glcp-generic-geval (mk-g-concrete x) env)
-           x)
-    :hints (("goal" :in-theory
-             (e/d** (glcp-generic-geval mk-g-concrete-correct)))))
-
-  (defthm glcp-generic-geval-g-concrete-quote-correct
-    (equal (glcp-generic-geval (g-concrete-quote x) env)
-           x)
-    :hints (("goal" :in-theory
-             (e/d** (glcp-generic-geval g-concrete-quote-correct)))))
-
-  (defthm glcp-generic-geval-general-concrete-obj-correct
-    (implies (general-concretep x)
-             (equal (glcp-generic-geval x env)
-                    (general-concrete-obj x)))
-    :hints (("goal" :in-theory
-             (e/d** (glcp-generic-geval general-concrete-obj-correct)))))
-
-  (defthm glcp-generic-geval-shape-spec-to-gobj-eval-env
-    (implies (and (shape-specp x)
-                  (no-duplicatesp-equal (shape-spec-indices x))
-                  (no-duplicatesp-equal (shape-spec-vars x))
-                  (shape-spec-obj-in-range x obj))
-             (equal (glcp-generic-geval
-                     (shape-spec-to-gobj x)
-                     (shape-spec-to-env x obj))
-                    obj))
-    :hints (("goal" :in-theory
-             (e/d** (glcp-generic-geval
-; [Removed by Matt K. to handle changes to member, assoc, etc. after ACL2 4.2.]
-;                      acl2::no-duplicatesp-is-no-duplicatesp-equal
-                     shape-spec-to-gobj-eval-env)))))
-
-  (defthm glcp-generic-geval-gobj-to-param-space-correct
-    (implies (bfr-eval p (car env))
-             (equal (glcp-generic-geval (gobj-to-param-space x p)
-                                        (genv-param p env))
-                    (glcp-generic-geval x env)))
-    :hints (("goal" :in-theory
-             (e/d** (glcp-generic-geval
-                     gobj-to-param-space-correct)))))
-
-  (defthm glcp-generic-geval-of-gl-cons
-    (equal (glcp-generic-geval (gl-cons x y) env)
-           (cons (glcp-generic-geval x env)
-                 (glcp-generic-geval y env)))))
-
-
-(local (in-theory (enable glcp-generic-geval-gtests-nonnil-correct)))
-
-;; (defun univ-run-gified-guard-wrapper (fn actuals hyp clk state)
-;;   (declare (xargs :guard (and (symbolp fn)
-;;                               (gobject-listp actuals)
-;;                               (bfr-p hyp)
-;;                               (natp clk))
-;;                   :stobjs state))
-;;   (ec-call (univ-run-gified fn actuals hyp clk state)))
-
-;; (defun glcp-generic-apply-concrete-guard-wrapper
-;;   (fn actuals state)
-;;   (declare (xargs :guard (true-listp actuals)
-;;                   :stobjs state))
-;;   (ec-call (glcp-generic-apply-concrete fn actuals state)))
-
-
-(local
- (progn
-   ;; (defun-nx glcp-generic-geval-lst (x env)
-   ;;   (if (atom x)
-   ;;       nil
-   ;;     (cons (glcp-generic-geval (car x) env)
-   ;;           (glcp-generic-geval-lst (cdr x) env))))
-
-   ;; (defthmd glcp-generic-geval-of-gobj-list
-   ;;   (implies (gobj-listp x)
-   ;;            (equal (glcp-generic-geval x env)
-   ;;                   (glcp-generic-geval-lst x env)))
-   ;;   :hints
-   ;;   (("goal" :induct (gobject-listp x)
-   ;;     :in-theory (enable gobject-listp-impl-gobjectp
-   ;;                        glcp-generic-geval-of-gobject-car
-   ;;                        gobject-listp))))
-
-
-
-
+(local (include-book "std/lists/acl2-count" :dir :system))
+(local (include-book "clause-processors/find-matching" :dir :system))
+(local (include-book "clause-processors/just-expand" :dir :system))
+(local (in-theory (disable* sets::double-containment w)))
 
 
-   (defthm nonnil-symbol-listp-impl-eqlable-listp
-     (implies (nonnil-symbol-listp x)
-              (eqlable-listp x))
-     :hints(("Goal" :in-theory (enable nonnil-symbol-listp))))
-
-
-
-
-   ;; (defthm univ-run-gified-wrapper-unwrap
-   ;;   (equal (univ-run-gified-guard-wrapper fn actuals hyp clk state)
-   ;;          (univ-run-gified fn actuals hyp clk state)))
-
-
-
-
-   ;; (defthm glcp-generic-apply-concrete-wrapper-unwrap
-   ;;   (equal (glcp-generic-apply-concrete-guard-wrapper fn actuals state)
-   ;;          (glcp-generic-apply-concrete fn actuals state)))
-
-   ;; (in-theory (disable univ-run-gified-guard-wrapper 
-   ;;                     ;; glcp-generic-apply-concrete-guard-wrapper
-   ;;                     ))
-   ))
-
-
-
-
-(defun general-concrete-listp (x)
-  (declare (xargs :guard t))
-  (if (atom x)
-      (eq x nil)
-    (and (general-concretep (car x))
-         (general-concrete-listp (cdr x)))))
-
-(defun general-concrete-obj-list (x)
-  (declare (xargs :guard (general-concrete-listp x)))
-  (if (atom x)
-      nil
-    (cons (general-concrete-obj (car x))
-          (general-concrete-obj-list (cdr x)))))
+(defun shape-spec-to-gobj-param (spec p)
+  (declare (xargs :guard (shape-specp spec)))
+  (gobj-to-param-space (shape-spec-to-gobj spec) p))
 
+(defun shape-spec-to-env-param (x obj p)
+  (declare (xargs :guard (shape-specp x)))
+  (genv-param p (shape-spec-to-env x obj)))
 
-(mutual-recursion
- (defun sublis-into-term (x alist)
-   (declare (xargs :guard t))
-   (cond ((null x) nil)
-         ((atom x)
-          (let ((look (hons-assoc-equal x alist)))
-            (if look (acl2::kwote (cdr look)) x)))
-         ((eq (car x) 'quote) x)
-         (t (cons (car x) (sublis-into-list (cdr x) alist)))))
- (defun sublis-into-list (x alist)
-   (declare (xargs :guard t))
-   (if (atom x)
-       nil
-     (cons (sublis-into-term (car x) alist)
-           (sublis-into-list (cdr x) alist)))))
 
-(local (flag::make-flag sublis-into-term-flg sublis-into-term))
-
-;; (defthm assoc-equal-nonnil-of-append
-;;   (implies x
-;;            (equal (assoc-equal x (append a b))
-;;                   (or (assoc-equal x a)
-;;                       (assoc-equal x b))))
-;;   :hints(("Goal" :in-theory (enable append assoc-equal))))
-
-;; (defthm-sublis-into-term-flg
-;;   sublis-into-term-correct-lemma
-;;   (sublis-into-term
-;;    (implies (pseudo-termp x)
-;;             (equal (glcp-generic-ev (sublis-into-term x subst) alist)
-;;                    (glcp-generic-ev x (append subst alist))))
-;;    :name sublis-into-term-correct)
-;;   (sublis-into-list
-;;    (implies (pseudo-term-listp x)
-;;             (equal (glcp-generic-ev-lst (sublis-into-list x subst) alist)
-;;                    (glcp-generic-ev-lst x (append subst alist))))
-;;    :name sublis-into-list-correct)
-;;   :hints (("goal" :induct (sublis-into-term-flg flag x alist))
-;;           (and stable-under-simplificationp
-;;                '(:in-theory (enable glcp-generic-ev-constraint-0)))))
 
 (local
- (progn
-   (defthm len-sublis-into-list
-     (implies (pseudo-term-listp x)
-              (equal (length (sublis-into-list x subst))
-                     (length x)))
-     :hints (("goal" :induct (len x)
-              :in-theory (enable length))))
-
-   (defthm-sublis-into-term-flg
-     sublis-into-term-pseudo-term-lemma
-     (sublis-into-term
-      (implies (pseudo-termp x)
-               (pseudo-termp (sublis-into-term x subst)))
-      :name pseudo-termp-sublis-into-term)
-     (sublis-into-list
-      (implies (pseudo-term-listp x)
-               (pseudo-term-listp (sublis-into-list x subst)))
-      :name pseudo-term-listp-sublis-into-list)
-     :hints (("goal" :induct (sublis-into-term-flg flag x alist)
-              :expand ((pseudo-termp x)
-                       (:free (args) (pseudo-termp (cons (car x)
-                                                         args)))))))))
-
-
-(defconst *glcp-generic-template-subst*
-  `((interp-term . glcp-generic-interp-term)
-    (interp-list . glcp-generic-interp-list)
-    (run-cases . glcp-generic-run-cases)
-    (run-parametrized . glcp-generic-run-parametrized)
-    (clause-proc . glcp-generic)
-    (clause-proc-name . (glcp-generic-clause-proc-name))
-    (run-gified . glcp-generic-run-gified)))
-
-(defund gl-aside-wormhole (term alist)
-  (declare (xargs :guard t))
-  (wormhole 'glcp-interp-gl-aside
-            '(lambda (whs) whs)
-            nil
-            `(prog2$ ,(sublis-into-term
-                       term alist)
-                     (value :q))
-            :ld-prompt nil
-            :ld-pre-eval-print nil
-            :ld-post-eval-print nil
-            :ld-verbose nil))
-
-(defun glcp-interp-error-fn (msg state)
-  (declare (xargs :guard t :stobjs state))
-  (mv msg nil nil state))
-
-(defmacro glcp-interp-error (msg)
-  (declare (xargs :guard t))
-  `(glcp-interp-error-fn ,msg state))
-
-(add-macro-alias glcp-interp-error glcp-interp-error-fn)
-
-
-(defthmd acl2-count-last-cdr-when-cadr-hack
-  (implies (< 1 (len x))
-           (< (acl2-count (car (last x)))
-              (+ 1 (acl2-count (cdr x)))))
-  :rule-classes (:rewrite :linear))
-
-;; (defun gobject-vals-alistp (x)
-;;   (declare (Xargs :guard t))
-;;   (if (atom x)
-;;       (equal x nil)
-;;     (and (or (atom (car x))
-;;              (gobjectp (cdar x)))
-;;          (gobject-vals-alistp (cdr x)))))
-
-
-;; (defthm lookup-in-gobject-vals-alistp
-;;   (implies (gobject-vals-alistp x)
-;;            (gobjectp (cdr (hons-assoc-equal k x)))))
-
-;; (defthm gobject-vals-alistp-pairlis$
-;;   (implies (gobject-listp vals)
-;;            (gobject-vals-alistp (pairlis$ keys vals)))
-;;   :hints(("Goal" :in-theory (enable gobject-listp
-;;                                     pairlis$))))
-
-
-(cutil::defaggregate glcp-config
-  ((abort-unknown booleanp :default t)
-   (abort-ctrex booleanp :default t)
-   (exec-ctrex booleanp :default t)
-   (abort-vacuous booleanp :default t)
-   (nexamples natp :rule-classes :type-prescription :default 3)
-   (hyp-clk natp :rule-classes :type-prescription :default 1000000)
-   (concl-clk natp :rule-classes :type-prescription :default 1000000)
-   (clause-proc-name symbolp :rule-classes :type-prescription)
-   (overrides) ;;  acl2::interp-defs-alistp but might be too expensive to check the guards in clause processors
-   run-before
-   run-after
-   case-split-override)
-  :tag :glcp-config)
-
-
-
-
-
-(make-event
- (sublis *glcp-generic-template-subst*
-         *glcp-interp-template*))
-
-(in-theory (disable glcp-generic-interp-term glcp-generic-interp-list))
-
-(local (in-theory (disable* general-concretep-def acl2-count
-;                            sets::double-containment
-                            integer-abs 
-;                            sets::nonempty-means-set
-                            equal-of-booleans-rewrite
-                            put-global
-                            acl2::true-list-listp-forward-to-true-listp-assoc-equal)))
-
-(defchoose glcp-generic-ev-falsify (a) (x)
-  (not (glcp-generic-ev x a)))
-
-
-;; (defthmd gobject-listp-true-listp
-;;   (implies (gobject-listp x)
-;;            (true-listp x))
-;;   :hints(("Goal" :in-theory (enable gobject-listp)))
-;;   :rule-classes (:rewrite :forward-chaining))
-
-(acl2::def-meta-extract glcp-generic-ev glcp-generic-ev-lst)
-
-(defthm glcp-generic-geval-of-gobj-list
-  (implies (and (gobj-listp x)
-                (consp x))
-           (equal (glcp-generic-geval x env)
-                  (cons (glcp-generic-geval (car x) env)
-                        (glcp-generic-geval (cdr x) env))))
-  :hints(("Goal" :use ((:instance glcp-generic-geval-of-gl-cons
-                        (x (car x)) (y (cdr x))))
-          :in-theory (enable gl-cons gobj-listp))))
-
-
-(local
- (progn
-
-
-   (defun-nx glcp-generic-geval-alist (al env)
-     (if (atom al)
-         nil
-       (if (consp (car al))
-           (cons (cons (caar al)
-                       (glcp-generic-geval (cdar al)
-                                           env))
-                 (glcp-generic-geval-alist (cdr al) env))
-         (glcp-generic-geval-alist (cdr al) env))))
-
-   (defthm glcp-generic-geval-alist-pairlis$
-     (implies (gobj-listp actuals)
-              (equal (glcp-generic-geval-alist
-                      (pairlis$ formals actuals)
-                      env)
-                     (pairlis$ formals
-                               (glcp-generic-geval actuals env))))
-     :hints(("Goal" :in-theory (enable default-cdr pairlis$ gobj-listp)
-             :induct (pairlis$ formals actuals))))
-
-           
-
-   (flag::make-flag glcp-generic-interp-flg glcp-generic-interp-term
-                    :hints (("goal" :in-theory
-                             (e/d (acl2-count
-                                   acl2-count-last-cdr-when-cadr-hack)
-                                  (last)))))
-
-   (defthm assoc-in-add-pair
-     (implies (not (equal k1 k2))
-              (equal (assoc k1 (add-pair k2 v a))
-                     (assoc k1 a))))
-
-
-   (defthm w-of-put-global
-     (implies (not (eq var 'current-acl2-world))
-              (equal (w (put-global var val state))
-                     (w state)))
-     :hints(("Goal" :in-theory (enable w put-global add-pair))))
-
-   (local (in-theory (disable w)))
-
-   (defthm-glcp-generic-interp-flg
-     (defthm glcp-generic-interp-term-w-state-preserved
-       (equal (w (mv-nth 3 (glcp-generic-interp-term
-                            x alist hyp clk obligs config state)))
-              (w state))
-       :hints ('(:expand ((glcp-generic-interp-term
-                           x alist hyp clk obligs config state)
-                          (glcp-generic-interp-term
-                           nil alist hyp clk obligs config state))))
-       :flag glcp-generic-interp-term)
-     (defthm glcp-generic-interp-list-w-state-preserved
-       (equal (w (mv-nth 3 (glcp-generic-interp-list
-                            x alist hyp clk obligs config state)))
-              (w state))
-       :hints ('(:expand ((glcp-generic-interp-list
-                           x alist hyp clk obligs config state))))
-       :flag glcp-generic-interp-list))
-
-   
-
-   ;; (defthm-glcp-generic-interp-flg
-   ;;   (defthm gobjectp-glcp-generic-interp-term
-   ;;    (implies (and (glcp-generic-ev-meta-extract-global-facts)
-   ;;                  (equal (w st) (w state))
-   ;;                  (sym-counterparts-ok (w st))
-   ;;                  (bfr-p hyp)
-   ;;                  (not (mv-nth 0 (glcp-generic-interp-term
-   ;;                                  x alist hyp clk obligs config st))))
-   ;;             (gobjectp (mv-nth 2 (glcp-generic-interp-term
-   ;;                                  x alist hyp clk obligs config st))))
-   ;;    :flag glcp-generic-interp-term)
-
-   ;;   (defthm gobject-listp-glcp-generic-interp-list
-   ;;    (implies (and (glcp-generic-ev-meta-extract-global-facts)
-   ;;                  (equal (w st) (w state))
-   ;;                  (sym-counterparts-ok (w st))
-   ;;                  (bfr-p hyp)
-   ;;                  (not (mv-nth 0 (glcp-generic-interp-list
-   ;;                                  x alist hyp clk obligs config st))))
-   ;;             (gobject-listp (mv-nth 2 (glcp-generic-interp-list
-   ;;                                       x alist hyp clk obligs config st))))
-   ;;    :flag glcp-generic-interp-list)
-   ;;   :hints (("goal" :induct (glcp-generic-interp-flg flag x alist hyp clk obligs config st)
-   ;;            :expand ((glcp-generic-interp-term x alist hyp clk obligs config st)
-   ;;                     (glcp-generic-interp-list x alist hyp clk obligs config st)
-   ;;                     (glcp-generic-interp-term nil alist hyp clk obligs config st)
-   ;;                     (glcp-generic-interp-list nil alist hyp clk obligs config st)
-   ;;                     (gobject-listp nil)
-   ;;                     (:free (a b) (gobject-listp (cons a b))))
-   ;;            :in-theory (e/d** ( ;; gobjectp-gobj-ite-merge
-   ;;                               ;;                               gobjectp-cons
-   ;;                               ;;                               gtests-wfp
-   ;;                               ;;                               bfr-p-of-bfr-and
-   ;;                               ;;                               bfr-p-of-bfr-not
-   ;;                               ;;                               bfr-p-of-bfr-or
-   ;;                               ;;                               hyp-fix-bfr-p
-   ;;                               ;;                               (gobjectp)
-   ;;                               gobjectp-g-apply
-   ;;                               gobjectp-gobj-fix
-   ;;                               gtests-wfp
-   ;;                               gobjectp-cons
-   ;;                               bfr-p-bfr-binary-and
-   ;;                               bfr-p-bfr-not
-   ;;                               bfr-p-bfr-binary-or
-   ;;                               gobjectp-mk-g-concrete
-   ;;                               gobjectp-g-concrete-quote
-   ;;                               hyp-fix-bfr-p
-   ;;                               glcp-generic-interp-list-w-state-preserved
-   ;;                               glcp-generic-interp-term-w-state-preserved
-   ;;                               gl-aside gl-ignore gl-error-is-nil
-   ;;                               gobjectp-of-atomic-constants
-   ;;                               gobjectp-gobj-ite-merge
-   ;;                               gobjectp-mk-g-ite
-   ;;                               gobjectp-mk-g-boolean
-   ;;                               car-cons cdr-cons (bfr-p)
-   ;;                               glcp-interp-error
-   ;;                               glcp-generic-interp-flg-equivalences
-   ;;                               (:induction glcp-generic-interp-flg)
-   ;;                               booleanp-compound-recognizer
-   ;;                               bfr-p-bfr-binary-or
-   ;;                               gobjectp-mk-g-boolean
-   ;;                               (g-keyword-symbolp)))
-   ;;            :do-not-induct t)))
-
-
-
-
-
-   (defthm pseudo-termp-car
-     (implies (pseudo-term-listp x)
-              (pseudo-termp (car x))))
-
-   (defthm pseudo-term-listp-cdr
-     (implies (pseudo-term-listp x)
-              (pseudo-term-listp (cdr x))))
-
-   (defthmd pseudo-term-listp-cdr-pseudo-term
-     (implies (and (pseudo-termp x)
-                   (consp x)
-                   (not (equal (car x) 'quote)))
-              (pseudo-term-listp (cdr x))))
-
-   (defthmd pseudo-termp-symbolp-car-x
-     (implies (and (pseudo-termp x)
-                   (not (consp (car x))))
-              (symbolp (car x))))
-
-   (defthmd pseudo-termp-lambda-body
-     (implies (and (pseudo-termp x)
-                   (consp (car x)))
-              (pseudo-termp (caddar x))))
-   
-   (defthmd pseudo-termp-car-last-of-pseudo-term-listp
-     (implies (and (pseudo-term-listp x)
-                   (consp x))
-              (pseudo-termp (car (last x)))))
-
-   (defthm pseudo-termp-car-last
-     (implies (and (pseudo-termp x)
-                   (< 1 (len x))
-                   (not (equal (car x) 'quote)))
-              (pseudo-termp (car (last x))))
-     :hints(("Goal" :expand ((pseudo-termp x))
-             :in-theory (enable pseudo-termp-car-last-of-pseudo-term-listp))))
-                
-
-   (defthm-glcp-generic-interp-flg
-     (defthm obligs-okp-glcp-generic-interp-term
-      (implies (and (pseudo-termp x)
-                    (acl2::interp-defs-alistp obligs)
-                    (acl2::interp-defs-alistp (glcp-config->overrides config))
-                    (not (mv-nth 0 (glcp-generic-interp-term
-                                    x alist hyp clk obligs config state))))
-               (acl2::interp-defs-alistp
-                (mv-nth 1 (glcp-generic-interp-term
-                           x alist hyp clk obligs config state))))
-      :flag glcp-generic-interp-term)
-
-     (defthm obligs-okp-glcp-generic-interp-list
-      (implies (and (pseudo-term-listp x)
-                    (acl2::interp-defs-alistp obligs)
-                    (acl2::interp-defs-alistp (glcp-config->overrides config))
-                    (not (mv-nth 0 (glcp-generic-interp-list
-                                    x alist hyp clk obligs config state))))
-               (acl2::interp-defs-alistp
-                (mv-nth 1 (glcp-generic-interp-list
-                           x alist hyp clk obligs config state))))
-      :flag glcp-generic-interp-list)
-     :hints (("goal" ;; :induct (glcp-generic-interp-flg flag x alist hyp clk obligs config state)
-              :expand ((glcp-generic-interp-term x alist hyp clk obligs config state)
-                       (glcp-generic-interp-list x alist hyp clk obligs config state)
-                       (glcp-generic-interp-term nil alist hyp clk obligs config state)
-                       (glcp-generic-interp-list nil alist hyp clk obligs config state)
-                       (:free (a b) (acl2::interp-defs-alistp (cons a b))))
-              :in-theory (e/d** (glcp-generic-interp-flg-equivalences
-                                 car-cons cdr-cons ; pseudo-termp
-; pseudo-term-listp
-                                 pseudo-termp-car
-                                 pseudo-termp-car-last
-                                 pseudo-term-listp-cdr
-                                 pseudo-term-listp-cdr-pseudo-term
-                                 pseudo-termp-symbolp-car-x
-                                 pseudo-termp-lambda-body
-                                 glcp-interp-error
-                                 ;; Jared: changed from hons-get-fn-do-hopy to hons-get for new hons
-                                 hons-get
-                                 hons-acons hons-copy
-                                 acl2::hons-assoc-equal-interp-defs-alistp
-                                 acl2::interp-function-lookup-wfp
-                                 acl2::interp-function-lookup-defs-alistp
-                                 (:induction glcp-generic-interp-flg))))))
-
-
+ (defsection glcp-generic-geval
+   (local (in-theory (enable glcp-generic-geval)))
 
+   (acl2::def-functional-instance
+    glcp-generic-geval-shape-spec-oblig-term-correct
+    shape-spec-oblig-term-correct
+    ((sspec-geval-ev glcp-generic-geval-ev)
+     (sspec-geval-ev-lst glcp-generic-geval-ev-lst)
+     (sspec-geval glcp-generic-geval)
+     (sspec-geval-list glcp-generic-geval-list))
+    :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                                glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                               (glcp-generic-geval-apply))
+              :expand ((:with glcp-generic-geval (glcp-generic-geval x
+                                                                     env))))))
 
+   (acl2::def-functional-instance
+    glcp-generic-geval-shape-spec-list-oblig-term-correct
+    shape-spec-list-oblig-term-correct
+    ((sspec-geval-ev glcp-generic-geval-ev)
+     (sspec-geval-ev-lst glcp-generic-geval-ev-lst)
+     (sspec-geval glcp-generic-geval)
+     (sspec-geval-list glcp-generic-geval-list))
+    :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                                glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                               (glcp-generic-geval-apply))
+              :expand ((:with glcp-generic-geval (glcp-generic-geval x env))))))
 
-   (in-theory (disable equal-of-booleans-rewrite))
-
-   (defthm-glcp-generic-interp-flg
-     (defthm true-listp-glcp-generic-interp-list
-       (true-listp (mv-nth 2 (glcp-generic-interp-list
-                              x alist hyp clk obligs config state)))
-       :hints(("Goal" :induct (len x)
-               :expand (glcp-generic-interp-list
-                        x alist hyp clk obligs config state)))
-       :flag list)
-     :skip-others t)
-
-   (include-book "system/f-put-global" :dir :system)
-
-   (defthm-glcp-generic-interp-flg
-     (defthm state-p1-glcp-generic-interp-term
-      (implies (state-p1 state)
-               (state-p1
-                (mv-nth 3 (glcp-generic-interp-term
-                           x alist hyp clk obligs config state))))
-      :flag glcp-generic-interp-term)
-
-     (defthm state-p1-glcp-generic-interp-list
-      (implies (state-p1 state)
-               (state-p1
-                (mv-nth 3 (glcp-generic-interp-list
-                           x alist hyp clk obligs config state))))
-      :flag glcp-generic-interp-list)
-     :hints (("goal" :induct (glcp-generic-interp-flg flag x alist hyp clk obligs config state)
-              :expand ((glcp-generic-interp-term x alist hyp clk obligs config state)
-                       (glcp-generic-interp-list x alist hyp clk obligs config state)
-                       (glcp-generic-interp-term nil alist hyp clk obligs config state)
-                       (glcp-generic-interp-list nil alist hyp clk obligs config state))
-              :in-theory (e/d** (glcp-generic-interp-flg-equivalences
-                                 acl2::state-p1-put-global
-                                 glcp-interp-error-fn
-                                 ;; state-p1-glcp-generic-apply-concrete
-                                 ;; glcp-generic-apply-concrete-guard-wrapper
-                                 (:induction glcp-generic-interp-flg))))))
-
-
-   (defthm true-listp-gl-cons
-     (equal (true-listp (gl-cons x y))
-            (true-listp y))
-     :hints(("Goal" :in-theory (enable gl-cons))))
-
-   (defthm-glcp-generic-interp-flg
-     (defthm true-listp-glcp-generic-interp-list
-       (true-listp (mv-nth 2 (glcp-generic-interp-list
-                              x alist hyp clk obligs config state)))
-       :hints ('(:expand
-                 ((glcp-generic-interp-list
-                   x alist hyp clk obligs config state))))
-       :rule-classes :type-prescription
-       :flag glcp-generic-interp-list)
-     :skip-others t)
-
-   (defthm-glcp-generic-interp-flg
-     (defthm gobj-listp-glcp-generic-interp-list
-       (gobj-listp (mv-nth 2 (glcp-generic-interp-list
-                              x alist hyp clk obligs config state)))
-       :hints ('(:expand
-                 ((glcp-generic-interp-list
-                   x alist hyp clk obligs config state))))
-       :flag glcp-generic-interp-list)
-     :skip-others t)))
-
-
-(local
- (defthm consp-last
-   (equal (consp (last x))
-          (consp x))))
-
-
-
-(set-ignore-ok t)
-
-(local (defthm plist-worldp-of-w-state
-         (implies (state-p1 state)
-                  (plist-worldp (w state)))
-         :hints(("Goal" :in-theory (e/d (state-p1 get-global w)
-                                        (all-boundp))))))
-
-;; (defun get-guard-verification-theorem (name state)
-;;   (declare (xargs :mode :program
-;;                   :stobjs state))
-;;   (b* ((wrld (w state))
-;;        (ctx 'get-guard-verification-theorem)
-;;        ((er names) (acl2::chk-acceptable-verify-guards
-;;                     name ctx wrld state))
-;;        (ens (acl2::ens state))
-;;        ((mv clauses & state)
-;;         (acl2::guard-obligation-clauses
-;;          names nil ens wrld state))
-;;        (term (acl2::termify-clause-set clauses)))
-;;     (value term)))
+   (acl2::def-functional-instance
+    glcp-generic-geval-gobj-to-param-space-correct
+    gobj-to-param-space-correct
+    ((generic-geval-ev glcp-generic-geval-ev)
+     (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+     (generic-geval glcp-generic-geval)
+     (generic-geval-list glcp-generic-geval-list))
+    :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                                glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                               (glcp-generic-geval-apply))
+              :expand ((:with glcp-generic-geval (glcp-generic-geval x env))))))))
 
 
+;; redundant but included only locally
 (make-event
  (b* (((er &) (in-theory nil))
       ((er thm) (get-guard-verification-theorem 'glcp-generic-interp-term state)))
    (value
     `(defthm glcp-generic-interp-guards-ok
        ,thm
-       :hints (("goal" :in-theory
-                (e/d* (pseudo-termp-car-last-of-pseudo-term-listp
-                       gl-aside gl-ignore gl-error-is-nil)
-                      (glcp-generic-interp-term
-                       glcp-generic-interp-list
-                       consp-assoc-equal
-                       pseudo-term-listp
-                       w
-                       nonnil-symbol-listp-pseudo-term-listp true-listp symbol-listp
-                       not no-duplicatesp-equal
-                       fgetprop plist-worldp
-                       hons-assoc-equal
-;                       bfr-and-is-bfr-and
-;                       bfr-not-is-bfr-not
-;                       bfr-p-is-bfr-p
-                       assoc table-alist
-                       general-concrete-listp
-                       general-concretep-def
-                       state-p-implies-and-forward-to-state-p1
-                       (:rules-of-class :forward-chaining :here)
-                       (:rules-of-class :type-prescription :here)
-                       (force))
-                      ((:type-prescription glcp-generic-interp-term)
-                       (:type-prescription glcp-generic-interp-list)
-                       (:type-prescription acl2::interp-function-lookup)
-                       (:type-prescription general-concrete-obj-list)
-                       (:type-prescription hons-assoc-equal)))
-                :do-not-induct t))
        :rule-classes nil))))
 
 
-
-(local (defthm car-last-when-length-4
-         (implies (equal (len x) 4)
-                  (equal (car (last x))
-                         (cadddr x)))
-         :hints(("Goal" :in-theory (enable len last)))))
-
-(local
- (progn
-   (include-book "tools/def-functional-instance" :dir :system)
-
-   (acl2::def-functional-instance
-    glcp-generic-interp-function-lookup-correct
-    acl2::interp-function-lookup-correct
-    ((acl2::ifl-ev glcp-generic-ev)
-     (acl2::ifl-ev-lst glcp-generic-ev-lst)
-     (acl2::ifl-ev-falsify glcp-generic-ev-falsify)
-     (acl2::ifl-ev-meta-extract-global-badguy
-      glcp-generic-ev-meta-extract-global-badguy))
-    :hints ((and stable-under-simplificationp
-                 '(:use (glcp-generic-ev-of-fncall-args
-                         glcp-generic-ev-falsify
-                         glcp-generic-ev-meta-extract-global-badguy)))))
-
-   (acl2::def-functional-instance
-    glcp-generic-interp-function-lookup-theoremp-defs-history
-    acl2::interp-function-lookup-theoremp-defs-history
-    ((acl2::ifl-ev glcp-generic-ev)
-     (acl2::ifl-ev-lst glcp-generic-ev-lst)
-     (acl2::ifl-ev-falsify glcp-generic-ev-falsify)))
-
-
-
-   (defthm glcp-generic-interp-function-lookup-theoremp-defs-history-rev
-     (b* (((mv erp & & out-defs)
-           (acl2::interp-function-lookup fn in-defs overrides world)))
-       (implies (and (not (glcp-generic-ev-theoremp
-                           (conjoin-clauses
-                            (acl2::interp-defs-alist-clauses in-defs))))
-                     (not erp))
-                (not (glcp-generic-ev-theoremp
-                      (conjoin-clauses
-                       (acl2::interp-defs-alist-clauses out-defs)))))))
-
-   (defthm-glcp-generic-interp-flg
-     (defthm glcp-generic-interp-term-bad-obligs
-      (implies (and (not (glcp-generic-ev-theoremp
-                          (conjoin-clauses
-                           (acl2::interp-defs-alist-clauses obligs))))
-                    (not (mv-nth 0 (glcp-generic-interp-term
-                                    x alist hyp clk obligs config state))))
-               (not (glcp-generic-ev-theoremp
-                     (conjoin-clauses
-                      (acl2::interp-defs-alist-clauses
-                       (mv-nth 1 (glcp-generic-interp-term
-                                  x alist hyp clk obligs config state)))))))
-      :flag glcp-generic-interp-term)
-     (defthm glcp-generic-interp-list-bad-obligs
-      (implies (and (not (glcp-generic-ev-theoremp
-                          (conjoin-clauses
-                           (acl2::interp-defs-alist-clauses obligs))))
-                    (not (mv-nth 0 (glcp-generic-interp-list
-                                    x alist hyp clk obligs config state))))
-               (not (glcp-generic-ev-theoremp
-                     (conjoin-clauses
-                      (acl2::interp-defs-alist-clauses
-                       (mv-nth 1 (glcp-generic-interp-list
-                                  x alist hyp clk obligs config state)))))))
-      :flag glcp-generic-interp-list)
-     :hints (("goal" :induct (glcp-generic-interp-flg flag x alist hyp clk obligs config state)
-              :expand ((glcp-generic-interp-term x alist hyp clk obligs config state)
-                       (glcp-generic-interp-list x alist hyp clk obligs config state)
-                       (glcp-generic-interp-term nil alist hyp clk obligs config state)
-                       (glcp-generic-interp-list nil alist hyp clk obligs config state))
-              :in-theory (e/d** (glcp-generic-interp-flg-equivalences
-                                 hons-acons car-cons cdr-cons
-                                 glcp-interp-error           
-                                 glcp-generic-interp-function-lookup-correct
-                                 glcp-generic-interp-function-lookup-theoremp-defs-history
-                                 acl2::interp-function-lookup-defs-alistp
-                                 (:induction
-                                  glcp-generic-interp-flg))))))
-
-
-   (defthm glcp-generic-interp-term-ok-obligs
-     (implies (and (not (glcp-generic-ev-theoremp
-                         (conjoin-clauses
-                          (acl2::interp-defs-alist-clauses obligs))))
-                   (glcp-generic-ev-theoremp
-                    (conjoin-clauses
-                     (acl2::interp-defs-alist-clauses
-                      (mv-nth 1 (glcp-generic-interp-term
-                                 x alist hyp clk obligs config state))))))
-              (mv-nth 0 (glcp-generic-interp-term
-                         x alist hyp clk obligs config state))))
-
-   (defthm len-gl-cons
-     (equal (len (gl-cons x y))
-            (+ 1 (len y)))
-     :hints(("Goal" :in-theory (enable gl-cons))))
-
-
-   (defthm-glcp-generic-interp-flg
-     glcp-generic-interp-list-len-lemma
-     (glcp-generic-interp-term t :skip t)
-     (glcp-generic-interp-list
-      (mv-let (erp obligs res)
-        (glcp-generic-interp-list
-         x alist hyp clk obligs config state)
-        (declare (ignore obligs))
-        (implies (not erp)
-                 (equal (len res)
-                        (len x))))
-      :name len-glcp-generic-interp-list)
-     :hints (("goal" :induct (glcp-generic-interp-flg flag x alist hyp clk obligs
-                                                      config state)
-              :expand ((glcp-generic-interp-list x alist hyp clk obligs config state)
-                       (glcp-generic-interp-list nil alist hyp clk obligs config state)))))
-           
-
-   (defthm glcp-generic-obligs-okp-final-implies-start
-     (implies (and (glcp-generic-ev-theoremp
-                    (conjoin-clauses
-                     (acl2::interp-defs-alist-clauses
-                      (mv-nth 1 (glcp-generic-interp-term
-                                 x alist hyp clk obligs config state)))))
-                   (not (mv-nth 0 (glcp-generic-interp-term
-                                   x alist hyp clk obligs config state))))
-              (glcp-generic-ev-theoremp
-               (conjoin-clauses
-                (acl2::interp-defs-alist-clauses
-                 obligs))))
-     :rule-classes :forward-chaining)
-
-
-   (defthm assoc-eq-glcp-generic-geval-alist
-     (implies (alistp alist)
-              (equal (cdr (assoc-eq x (glcp-generic-geval-alist alist env)))
-                     (glcp-generic-geval (cdr (hons-assoc-equal x alist)) env))))
-
-
-   (defthm glcp-generic-geval-lst-general-concrete-obj-list
-     (implies (and (general-concrete-listp x)
-                   (gobj-listp x))
-              (equal (glcp-generic-geval x env)
-                     (general-concrete-obj-list x)))
-     :hints(("Goal" :in-theory (e/d (gobj-listp) ()))))
-
-
-   (defthm glcp-generic-ev-nil
-     (equal (glcp-generic-ev nil a) nil))
-
-
-
-
-   (defun glcp-generic-ev-constraint-hint (clause)
-     (declare (xargs :guard (true-listp clause)))
-     (cond
-      ((member-equal '(not (equal flag 'glcp-generic-interp-term)) clause)
-       (cond
-        ((member-equal '(not (consp x)) clause)
-         (cond
-          ((member-equal '(not (equal (car x) 'if)) clause)
-           '(:in-theory (enable glcp-generic-ev-of-if-call)))
-          ((member-equal '(not (equal (car x) 'return-last)) clause)
-           '(:in-theory (enable glcp-generic-ev-of-return-last-call)))
-          ((member-equal '(not (equal (car x) 'gl-aside)) clause)
-           '(:in-theory (enable glcp-generic-ev-of-gl-aside-call)))
-          ((member-equal '(not (equal (car x) 'gl-ignore)) clause)
-           '(:in-theory (enable glcp-generic-ev-of-gl-ignore-call)))
-          ((member-equal '(not (equal (car x) 'gl-error)) clause)
-           '(:in-theory (enable glcp-generic-ev-of-gl-error-call)))
-          ((member-equal '(not (equal (car x) 'quote)) clause)
-           '(:in-theory (enable glcp-generic-ev-of-quote)))
-          ((member-equal '(not (consp (car x))) clause)
-           '(:in-theory (enable glcp-generic-ev-of-lambda)))))
-        ((member-equal '(not (symbolp x)) clause)
-         '(:in-theory (enable glcp-generic-ev-of-variable)))))
-      ((member-equal '(equal flag 'glcp-generic-interp-term) clause)
-       (cond
-        ((member-equal '(consp x) clause)
-         '(:in-theory (enable glcp-generic-ev-lst-of-atom)))
-        ((member-equal '(not (consp x)) clause)
-         '(:in-theory (enable glcp-generic-ev-lst-of-cons)))))))
-
-   (encapsulate nil
-     (local 
-      (in-theory (e/d** (glcp-generic-geval-gobj-ite-merge-correct
-                         ; glcp-generic-geval-atom
-                         (:rules-of-class :executable-counterpart :here)
-                         pseudo-termp-car-last
-                         car-last-when-length-4
-                         gl-aside gl-ignore gl-error-is-nil
-                         (:induction glcp-generic-interp-flg)
-                         glcp-generic-interp-flg-equivalences
-                         ;; glcp-generic-apply-concrete-correct
-                         alistp-pairlis
-                         acl2::cons-car-cdr
-                         glcp-generic-ev-nil
-                         glcp-interp-error
-                         glcp-generic-geval-lst-general-concrete-obj-list
-                         gobj-listp-glcp-generic-interp-list
-                         acl2::hons-assoc-equal-interp-defs-alistp
-                         obligs-okp-glcp-generic-interp-list
-                         assoc-eq-glcp-generic-geval-alist
-                         glcp-generic-interp-term-w-state-preserved
-                         glcp-generic-interp-list-w-state-preserved
-                         ;; w-state-of-glcp-generic-apply-concrete
-                         ;; glcp-generic-ev-constraint-9
-                         ;;                       glcp-generic-ev-constraint-3
-                         ;;                       glcp-generic-ev-constraint-6
-                         ;;                       glcp-generic-ev-constraint-2
-                         ;;                       glcp-generic-ev-constraint-1
-                         ;;                       glcp-generic-ev-constraint-5
-                         ;;                       glcp-generic-ev-constraint-4
-                         pseudo-termp-car
-                         pseudo-term-listp-cdr
-                         pseudo-termp-symbolp-car-x
-                         len-glcp-generic-interp-list
-                         pseudo-term-listp-cdr-pseudo-term
-                         pseudo-termp-lambda-body
-                         car-cons cdr-cons hons-equal
-                         ;; glcp-generic-apply-concrete-wrapper-unwrap
-                         glcp-generic-geval-alist-pairlis$
-                         obligs-okp-glcp-generic-interp-term
-                         obligs-okp-glcp-generic-interp-list
-                         acl2::interp-function-lookup-defs-alistp
-                         acl2::interp-function-lookup-wfp
-                         glcp-generic-interp-function-lookup-correct
-                         glcp-generic-interp-function-lookup-theoremp-defs-history-rev
-                         ;; Jared: blah blah hons-get-fn-do-hopy
-                         hons-get
-                         eql
-                         glcp-generic-obligs-okp-final-implies-start
-                         glcp-generic-interp-term-bad-obligs
-                         glcp-generic-interp-list-bad-obligs
-                         ;; glcp-generic-obligs-okp-implies-glcp-generic-ev-fncall-equals-body-arbitrary-args
-                         ;; glcp-generic-ev-theoremp-implies-glcp-generic-ev-fncall-equals-body-arbitrary-args
-                         ;;glcp-generic-obligs-okp-hons-acons-implies
-                         ;;glcp-generic-obligs-okp-hons-assoc-equal
-                         ;; glcp-generic-ev-lst-pairlis-nonnil-symbol-list
-                         glcp-generic-run-gified-correct
-                         bfr-eval-consts
-                         bfr-and-of-nil (bfr-not) 
-                         bfr-eval-bfr-not bfr-eval-bfr-binary-and
-                         bfr-eval-bfr-binary-or
-                         glcp-generic-geval-mk-g-boolean-correct
-                         glcp-generic-geval-mk-g-ite-correct
-                         glcp-generic-geval-gtests-nonnil-correct
-                         hyp-fix-correct
-                         glcp-generic-geval-gtests-obj-correct
-                         glcp-generic-geval-mk-g-concrete-correct
-                         glcp-generic-geval-g-concrete-quote-correct
-                         GLCP-GENERIC-GEVAL-OF-GL-CONS)
-                        ())))
-
-     ;;   (local (add-bfr-fn-pat hyp-fix))
-     ;;   (local (add-bfr-fn-pat bfr-and))
-     ;;   (local (add-bfr-fn-pat bfr-or))
-     ;;   (local (add-bfr-fn-pat bfr-not))
-     ;;   (local (add-bfr-fn-pat gtests-unknown))
-     ;;   (local (add-bfr-fn-pat gtests-nonnil))
-     ;;   (local (bfr-reasoning-mode t))
-     
-;;      (local (defthm hyp-fix-iff-bfr-and
-;;               (iff (hyp-fix x hyp)
-;;                    (bfr-and x hyp))
-;;               :hints(("Goal" :in-theory (enable hyp-fix acl2::bfr-and-of-nil
-;;                                                 bfr-and)))))
-
-     (local
-      (encapsulate nil
-        (local (bfr-reasoning-mode t))
-        (local (acl2::set-bdd-patterns '((hyp-fix . &) 't 'nil)))
-        (defthm bfr-eval-gtests-unknown
-          (implies (and (not (hf (gtests-unknown (gtests test hyp))))
-                        (bfr-eval hyp env))
-                   (not (bfr-eval (gtests-unknown (gtests test hyp)) env))))
-
-        (defthm bfr-eval-gtests-unknown-or
-          (implies (and (not (hf (bfr-or (gtests-unknown (gtests test hyp)) other)))
-                        (bfr-eval hyp env))
-                   (not (bfr-eval (gtests-unknown (gtests test hyp)) env))))
-
-
-        (defthm geval-of-interp-res-hyp-fix-unknown-false
-          (implies (and (not (glcp-generic-geval interp-res env))
-                        (bfr-eval hyp (car env)))
-                   (hyp-fix (bfr-or
-                             (gtests-unknown (gtests interp-res hyp))
-                             (bfr-not
-                              (gtests-nonnil (gtests interp-res hyp))))
-                            hyp)))
-
-        (defthm geval-of-interp-res-hyp-fix-unknown-true
-          (implies (and (glcp-generic-geval interp-res env)
-                        (bfr-eval hyp (car env)))
-                   (hyp-fix (bfr-or
-                             (gtests-unknown (gtests interp-res hyp))
-                             (gtests-nonnil (gtests interp-res hyp)))
-                            hyp)))
-
-        (defthm gtests-nonnil-or-not
-          (implies
-           (and
-            (bfr-eval hyp (car env))
-            (not
-             (hyp-fix
-              (bfr-or
-               (gtests-unknown (gtests test hyp))
-               (gtests-nonnil (gtests test hyp)))
-              hyp)))
-           (hyp-fix
-            (bfr-or
-             (gtests-unknown (gtests test hyp))
-             (bfr-not (gtests-nonnil (gtests test hyp))))
-            hyp)))))
-
-
-     (defthm glcp-generic-interp-function-lookup-correct-special
-       (mv-let (erp body formals out-defs)
-         (acl2::interp-function-lookup fn in-defs overrides (w state))
-         (implies (and (not erp)
-                       (glcp-generic-ev-theoremp
-                        (conjoin-clauses
-                         (acl2::interp-defs-alist-clauses out-defs)))
-                       (acl2::interp-defs-alistp in-defs)
-                       (acl2::interp-defs-alistp overrides)
-                       (equal (len formals) (len actuals))
-                       (not (eq fn 'quote))
-                       (glcp-generic-ev-meta-extract-global-facts :state state1)
-                       (equal (w state) (w state1)))
-                  (equal (glcp-generic-ev body (pairlis$ formals
-                                                (glcp-generic-ev-lst actuals a)))
-                         (glcp-generic-ev (cons fn actuals) a)))))
-
-     (defthm glcp-generic-ev-magic-ev-fncall-special
-       (b* (((mv erp val)
-             (acl2::magic-ev-fncall f args st t nil)))
-         (implies (and (glcp-generic-ev-meta-extract-global-facts)
-                       (equal (w st) (w state))
-                       (not erp))
-                  (equal val
-                         (glcp-generic-ev (cons f (kwote-lst args)) nil))))
-       :hints(("Goal" :in-theory (enable glcp-generic-ev-meta-extract-fncall))))
-
-     (in-theory (disable glcp-generic-ev-meta-extract-fncall))
-     (local (in-theory (disable glcp-generic-interp-term-ok-obligs
-                                (:type-prescription hyp-fix)
-                                hyp-fix-of-hyp-fixedp)))
-
-     (defthm-glcp-generic-interp-flg
-       (defthm glcp-generic-interp-term-correct
-         (implies (and (bfr-eval hyp (car env))
-                       (alistp alist)
-                       (pseudo-termp x)
-                       (not (mv-nth 0 (glcp-generic-interp-term
-                                       x alist hyp clk obligs config state)))
-                       (acl2::interp-defs-alistp obligs)
-                       (acl2::interp-defs-alistp (glcp-config->overrides config))
-                       (glcp-generic-ev-theoremp
-                        (conjoin-clauses
-                         (acl2::interp-defs-alist-clauses
-                          (mv-nth 1 (glcp-generic-interp-term
-                                     x alist hyp clk obligs config state)))))
-                       ;; (glcp-generic-ev-meta-extract-global-facts)
-                       (glcp-generic-ev-meta-extract-global-facts :state state1)
-                       (equal (w state1) (w state)))
-                  (equal (glcp-generic-geval
-                          (mv-nth 2 (glcp-generic-interp-term
-                                     x alist hyp clk obligs config state))
-                          env)
-                         (glcp-generic-ev x (glcp-generic-geval-alist alist env))))
-         :flag glcp-generic-interp-term)
-
-       (defthm glcp-generic-interp-list-correct
-         (implies (and (bfr-eval hyp (car env))
-                       (not (mv-nth 0 (glcp-generic-interp-list
-                                       x alist hyp clk obligs config state)))
-                       (acl2::interp-defs-alistp obligs)
-                       (acl2::interp-defs-alistp (glcp-config->overrides config))
-                       (alistp alist)
-                       (pseudo-term-listp x)
-                       (glcp-generic-ev-theoremp
-                        (conjoin-clauses
-                         (acl2::interp-defs-alist-clauses
-                          (mv-nth 1 (glcp-generic-interp-list
-                                     x alist hyp clk obligs config state)))))
-                       (glcp-generic-ev-meta-extract-global-facts :state state1)
-                       (equal (w state1) (w state)))
-                  (equal (glcp-generic-geval
-                          (mv-nth 2 (glcp-generic-interp-list
-                                     x alist hyp clk obligs config state))
-                          env)
-                         (glcp-generic-ev-lst x (glcp-generic-geval-alist alist env))))
-         :flag glcp-generic-interp-list)
-       :hints (("goal" ;; :induct (glcp-generic-interp-flg flag x alist hyp clk obligs config state)
-                :expand
-                ((glcp-generic-interp-term x alist hyp clk obligs config state)
-                 (glcp-generic-interp-list x alist hyp clk obligs config state)
-                 (glcp-generic-interp-term nil alist hyp clk obligs config state)
-                 (glcp-generic-interp-list nil alist hyp clk obligs config state))
-                :do-not '(generalize fertilize)
-                :do-not-induct t)
-               (glcp-generic-ev-constraint-hint clause)
-               (and stable-under-simplificationp
-                    (case-match id
-                      ((('0 '1) (n . &) . &)
-                       '(:in-theory
-                         (enable
-                          glcp-generic-ev-of-fncall-args)))))
-;;                (if stable-under-simplificationp
-;;                    (let ((state (acl2::f-put-global
-;;                                  'evbdd-cp-clauses
-;;                                  (cons clause
-;;                                        (and (boundp-global 'evbdd-cp-clauses
-;;                                                            state)
-;;                                             (@ evbdd-cp-clauses)))
-;;                                  state)))
-;;                     (value '(:clause-processor
-;;                              (acl2::bfr-eval-cp
-;;                               clause
-;;                               (list '('t 'nil)
-;;                                     '((hyp-fix . &)
-;;                                ;;       (bfr-or . &)
-;; ;;                                      (bfr-not . &)
-;; ;;                                      (bfr-and . &)
-;; ;;                                      (gtests-unknown . &)
-;; ;;                                      (gtests-nonnil . &)
-;; ;;                                      'nil 't
-;;                                       )
-;;                                     ;; '((car env))
-;;                                     t)))))
-;;                  (value nil))
-               )))))
-
-(in-theory (disable glcp-generic-interp-term))
-
-
 (defun strip-cadrs (x)
   (if (atom x)
       nil
@@ -1376,24 +126,9 @@
                   (collect-vars-list (cdr x))))))
 
 
-(defun shape-spec-bindingsp (x)
-  (declare (xargs :guard t))
-  (if (atom x)
-      (equal x nil)
-    (and (consp (car x))
-         (symbolp (caar x))
-         (not (keywordp (caar x)))
-         (caar x)
-         (consp (cdar x))
-         (shape-specp (cadar x))
-         (shape-spec-bindingsp (cdr x)))))
 
 
-(defun gobj-alist-to-param-space (alist p)
-  (if (atom alist)
-      nil
-    (cons (cons (caar alist) (gobj-to-param-space (cdar alist) p))
-          (gobj-alist-to-param-space (cdr alist) p))))
+
 
 
 
@@ -1435,26 +170,26 @@
      :hints ((acl2::set-reasoning)))
 
    (defthm-collect-vars-flg
-     glcp-generic-ev-norm-alist-collect-vars-lemma
+     glcp-generic-geval-ev-norm-alist-collect-vars-lemma
      (collect-vars
       (implies (and (pseudo-termp x)
                     (subsetp-equal (collect-vars x) vars))
-               (equal (glcp-generic-ev x (norm-alist vars alist))
-                      (glcp-generic-ev x alist)))
-      :name glcp-generic-ev-norm-alist-collect-vars1)
+               (equal (glcp-generic-geval-ev x (norm-alist vars alist))
+                      (glcp-generic-geval-ev x alist)))
+      :name glcp-generic-geval-ev-norm-alist-collect-vars1)
      (collect-vars-list
       (implies (and (pseudo-term-listp x)
                     (subsetp-equal (collect-vars-list x) vars))
-               (equal (glcp-generic-ev-lst x (norm-alist vars alist))
-                      (glcp-generic-ev-lst x alist)))
-      :name glcp-generic-ev-lst-norm-alist-collect-vars-list1)
+               (equal (glcp-generic-geval-ev-lst x (norm-alist vars alist))
+                      (glcp-generic-geval-ev-lst x alist)))
+      :name glcp-generic-geval-ev-lst-norm-alist-collect-vars-list1)
      :hints (("goal" :induct (collect-vars-flg flag x)
               :in-theory (enable subsetp-equal))
              ("Subgoal *1/3"
-              :in-theory (enable glcp-generic-ev-of-fncall-args))))
+              :in-theory (enable glcp-generic-geval-ev-of-fncall-args))))
+
 
 
-        
 
    (encapsulate nil
      (local (defthm member-equal-second-revappend
@@ -1508,8 +243,8 @@
                    (glcp-generic-geval x env))
             :hints (("goal" :use ((:instance glcp-generic-geval-of-gl-cons)
                                   (:instance
-                                   glcp-generic-geval-g-concrete-quote-correct))
-                     :expand ((gobject-hierarchy-lite x))
+                                   glcp-generic-geval-g-concrete-quote-correct
+                                   (b env)))
                      :in-theory (e/d (gl-cons g-concrete-quote g-keyword-symbolp)
                                      (glcp-generic-geval-of-gl-cons
                                       glcp-generic-geval-g-concrete-quote-correct))))))
@@ -1518,15 +253,15 @@
      (implies (alistp x)
               (equal (glcp-generic-geval-alist x env)
                      (pairlis$ (strip-cars x)
-                               (glcp-generic-geval (gobj-strip-cdrs x) env))))
-     :hints(("Goal" :in-theory (enable strip-cars))))
+                               (glcp-generic-geval-list (strip-cdrs x) env))))
+     :hints(("Goal" :in-theory (enable strip-cars glcp-generic-geval-alist))))
 
    (defthm strip-cdrs-shape-specs-to-interp-al
      (implies (shape-spec-bindingsp x)
-              (equal (gobj-strip-cdrs (shape-specs-to-interp-al x))
-                     (shape-spec-to-gobj (strip-cadrs x))))
+              (equal (strip-cdrs (shape-specs-to-interp-al x))
+                     (shape-spec-to-gobj-list (strip-cadrs x))))
      :hints(("Goal" :induct (len x)
-             :expand ((:free (a b) (shape-spec-to-gobj (cons a b)))))))
+             :expand ((:free (a b) (shape-spec-to-gobj-list (cons a b)))))))
 
 
    ;; (defthm gobject-alistp-gobj-alist-to-param-space
@@ -1534,8 +269,9 @@
    ;;            (gobject-alistp (gobj-alist-to-param-space x p))))
 
    (defthm strip-cars-gobj-alist-to-param-space
-     (equal (strip-cars (gobj-alist-to-param-space x p))
-            (strip-cars x)))
+     (implies (alistp x)
+              (equal (strip-cars (gobj-alist-to-param-space x p))
+                     (strip-cars x))))
 
    (defthm gobj-to-param-space-of-gl-cons
      (equal (gobj-to-param-space (gl-cons a b) p)
@@ -1546,17 +282,17 @@
                                        gl-cons tag)
              :expand ((:free (a b) (gobj-to-param-space (cons a b) p))))))
 
-   (defthm strip-cdrs-gobj-alist-to-param-space
-     (equal (gobj-strip-cdrs (gobj-alist-to-param-space x p))
-            (gobj-to-param-space (gobj-strip-cdrs x) p))
-     :hints(("Goal" :in-theory (enable strip-cdrs 
-                                       gobj-to-param-space
-                                       tag)
-             :induct (gobj-alist-to-param-space x p)
-             :expand ((:free (a b) (gobj-to-param-space (cons a b) p))))))
+   ;; (defthm strip-cdrs-gobj-alist-to-param-space
+   ;;   (equal (gobj-strip-cdrs (gobj-alist-to-param-space x p))
+   ;;          (gobj-to-param-space (gobj-strip-cdrs x) p))
+   ;;   :hints(("Goal" :in-theory (enable strip-cdrs
+   ;;                                     gobj-to-param-space
+   ;;                                     tag)
+   ;;           :induct (gobj-alist-to-param-space x p)
+   ;;           :expand ((:free (a b) (gobj-to-param-space (cons a b) p))))))
 
-   (defthm alistp-gobj-alist-to-param-space
-     (alistp (gobj-alist-to-param-space x p)))
+   ;; (defthm alistp-gobj-alist-to-param-space
+   ;;   (alistp (gobj-alist-to-param-space x p)))
 
 
    (defthm nonnil-symbol-listp-strip-cars-shape-spec-bindings
@@ -1567,7 +303,8 @@
 
    (defthm shape-spec-listp-strip-cadrs
      (implies (shape-spec-bindingsp x)
-              (shape-spec-listp (strip-cadrs x))))
+              (shape-spec-listp (strip-cadrs x)))
+     :hints(("Goal" :in-theory (enable shape-spec-listp))))
 
    (defthm shape-specp-strip-cadrs-bindings
      (implies (shape-spec-bindingsp x)
@@ -1578,23 +315,9 @@
 
 
 
-(defun quote-if-needed (obj)
-  (declare (xargs :mode :logic :guard t))
-  (if (or (booleanp obj)
-          (keywordp obj)
-          (acl2-numberp obj)
-          (characterp obj)
-          (stringp obj))
-      obj
-    (list 'quote obj)))
 
-(defun bindings-quote-if-needed (bindings)
-  (declare (xargs :guard (true-list-listp bindings)))
-  (if (atom bindings)
-      nil
-    (cons (list (caar bindings)
-                (quote-if-needed (cadar bindings)))
-          (bindings-quote-if-needed (cdr bindings)))))
+
+
 
 (defun glcp-make-pretty-bindings (alist)
   (if (atom alist)
@@ -1638,211 +361,39 @@
     (max (max-list (car x))
          (max-list-list (cdr x)))))
 
-(defund inspec-max-index (x)
-  (if (atom x)
-      0
-    (pattern-match x
-      ((g-concrete &) 0)
-      ((g-boolean b) b)
-      ((g-number n) (max-list-list n))
-      ((g-ite if then else)
-       (max (inspec-max-index if)
-            (max (inspec-max-index then)
-                 (inspec-max-index else))))
-      ((g-apply & args) (inspec-max-index args))
-      ((g-var &) 0)
-      (& (max (inspec-max-index (car x))
-              (inspec-max-index (cdr x)))))))
+;; (defund inspec-max-index (x)
+;;   (if (atom x)
+;;       0
+;;     (pattern-match x
+;;       ((g-concrete &) 0)
+;;       ((g-boolean b) b)
+;;       ((g-number n) (max-list-list n))
+;;       ((g-ite if then else)
+;;        (max (inspec-max-index if)
+;;             (max (inspec-max-index then)
+;;                  (inspec-max-index else))))
+;;       ((g-apply & args) (inspec-max-index args))
+;;       ((g-var &) 0)
+;;       (& (max (inspec-max-index (car x))
+;;               (inspec-max-index (cdr x)))))))
 
 
 
 
-(defun bool-to-bit (x)
-  (cond ((eq x t) 1)
-        ((eq x nil) 0)
-        (t x)))
 
 
-(defun nth-list-bits (x lst)
-  (if (atom x)
-      nil
-    (cons (bool-to-bit (nth (car x) lst))
-          (nth-list-bits (cdr x) lst))))
 
-(defun nth-list-list-bits (x lst)
-  (if (atom x)
-      nil
-    (cons (nth-list-bits (car x) lst)
-          (nth-list-list-bits (cdr x) lst))))
 
 
 
 
 
 
-;; To-satisfying-assign-spec generates the same satisfying assignment as
-;; to-satisfying-assign given the same lst and bdd, except that when a
-;; variable's value is irrelevant (car and cdr are equal), we put X in the list
-;; instead of T or NIL.
-(defun to-satisfying-assign-spec (lst bdd)
-  (declare (xargs :hints (("goal" :in-theory (enable acl2-count)))))
-  (cond ((atom bdd) lst)
-        ((eq (cdr bdd) nil) (cons t (to-satisfying-assign-spec lst (car bdd))))
-        ((eq (car bdd) nil) (cons nil (to-satisfying-assign-spec lst (cdr bdd))))
-        ((hqual (car bdd) (cdr bdd))
-         (cons 'x (to-satisfying-assign-spec (cdr lst) (car bdd))))
-        (t (cons (car lst) (to-satisfying-assign-spec
-                            (cdr lst)
-                            (if (car lst) (car bdd) (cdr bdd)))))))
 
 
 
 
-;; For each index N in an shape spec, this substitutes the Nth value found in
-;; lst.  In the number case, it substitutes 1 and 0 for booleans.
-(defund inspec-show-assign-spec (x lst)
-  (if (atom x)
-      x
-    (pattern-match x
-      ((g-concrete &) x)
-      ((g-boolean b) (g-boolean (nth b lst)))
-      ((g-number n) (g-number (nth-list-list-bits n lst)))
-      ((g-ite if then else)
-       (g-ite (inspec-show-assign-spec if lst)
-              (inspec-show-assign-spec then lst)
-              (inspec-show-assign-spec else lst)))
-      ((g-apply fn args) (g-apply fn (inspec-show-assign-spec args lst)))
-      ((g-var &) x)
-      (& (cons (inspec-show-assign-spec (car x) lst)
-               (inspec-show-assign-spec (cdr x) lst))))))
-
-
 
-(include-book "centaur/misc/vecs-ints" :dir :system)
-
-
-(defun n-satisfying-assigns-and-specs (n hyp-bdd bdd bound state)
-  (if (zp n)
-      (value nil)
-    (b* (((mv rand state) (acl2::random$ (ash 1 bound) state))
-         (lst (acl2::nat-to-v rand bound))
-         ;; From when we passed in the unparametrized counterexample BDD:
-;;          (assign (to-satisfying-assign lst bdd))
-;;          (assign-spec (to-satisfying-assign-spec lst bdd))
-         (assign (acl2::unparam-env hyp-bdd (to-satisfying-assign lst bdd)))
-         (assign-spec (acl2::unparam-env hyp-bdd (to-satisfying-assign-spec lst bdd)))
-         ((er rest) (n-satisfying-assigns-and-specs (1- n) hyp-bdd bdd bound state)))
-      (value (cons (list* "generated randomly:" assign assign-spec) rest)))))
-
-(defthm n-satisfying-assigns-does-not-fail
-  (not (mv-nth 0 (n-satisfying-assigns-and-specs n hyp-bdd bdd bound state))))
-
-
-(defun vars-onto-alist (vars val al)
-  (if (atom vars)
-      al
-    (if (hons-get (car vars) al)
-        (vars-onto-alist (cdr vars) val al)
-      (vars-onto-alist (cdr vars) val (hons-acons (car vars) val al)))))
-
-(defun glcp-gen-assignments (ctrex-info alist hyp-bdd n state)
-  (if (and (bfr-mode) ;; AIG mode
-           (bfr-counterex-mode)) ;; alist counterexample mode
-      (b* ((al (acl2::aig-extract-iterated-assigns-alist hyp-bdd 10))
-           ;; Careful: al is memoized so we can't steal it.
-           (cex-alist (hons-shrink-alist (append al ctrex-info) nil)))
-        (value (list (list "counterexample from SAT:"
-                           (vars-onto-alist
-                            ;; WRONG:
-                            ;; Hmm, logically this isn't really well-typed,
-                            ;; because alist consists of real g-objects whereas
-                            ;; shape-spec-indices wants shape-specs.  But in the
-                            ;; AIG case, parametrization doesn't do anything, so
-                            ;; this works.  If we were to apply this in cases
-                            ;; where alist was not generated by parametrizing a
-                            ;; shape-spec-alist, this would need to be changed.
-
-                            ;; Actually, parametrization gets rid of any AIG
-                            ;; variables that are constrained to concrete values.
-                            ;; So we need to reproduce the parametrized binding
-                            ;; alist here.
-                            (shape-spec-indices (strip-cdrs alist)) nil
-                            cex-alist)))))
-    (b* ((bound (inspec-max-index alist))
-         ((er assigns) (n-satisfying-assigns-and-specs
-                        (max 0 (- n 2)) hyp-bdd ctrex-info bound state))
-         (nils (acl2::nat-to-v 0 bound))
-         (ts (acl2::nat-to-v -1 bound)))
-      (value (take n
-                   (list* (list* "generated by assigning 0/NIL to all possible bits:"
-                                 (acl2::unparam-env
-                                  hyp-bdd
-                                  (to-satisfying-assign nils ctrex-info))
-                                 (acl2::unparam-env
-                                  hyp-bdd
-                                  (to-satisfying-assign-spec nils ctrex-info)))
-                          (list* "generated by assigning 1/T to all possible bits:"
-                                 (acl2::unparam-env
-                                  hyp-bdd
-                                  (to-satisfying-assign ts ctrex-info))
-                                 (acl2::unparam-env
-                                  hyp-bdd
-                                  (to-satisfying-assign-spec ts ctrex-info)))
-                          assigns))))))
-
-(defthm glcp-gen-assignments-does-not-fail
-  (not (mv-nth 0 (glcp-gen-assignments n hyp-bdd bdd bound state)))) 
-
-
-(defun glcp-pretty-print-assignments (n ctrexes concl execp state)
-  (declare (xargs :stobjs state
-                  :guard (and (natp n)
-                              (true-list-listp ctrexes)
-                              (pseudo-termp concl))))
-  (if (atom ctrexes)
-      nil
-    (b* (((list string assign-alist assign-spec-alist) (car ctrexes))
-         (bindings (ec-call (bindings-quote-if-needed assign-alist)))
-         (- (if (bfr-mode)
-                (cw "Example ~x2, ~@0~%Assignment:~%~x1~%~%" string bindings n)
-              (cw "Example ~x3, ~@0~%Template:~%~x1~%Assignment:~%~x2~%~%" string assign-spec-alist
-                  bindings n)))
-         ((unless execp)
-          (glcp-pretty-print-assignments (1+ n) (cdr ctrexes) concl execp state))
-         (- (cw "Running conclusion:~%"))
-         ;; ((acl2::cmp concl-term)
-         ;;  (acl2::translate-cmp 
-         ;;   concl t t t 'glcp-print-ctrexamples (w state)
-         ;;   (default-state-vars state)))
-
-         ;; assign-alist is actually of the form
-         ;; ((var0 val0) (var1 val1)...) --
-         ;; change it to ((var0 . val0) (var1 . val1) ...)
-         (alist (pairlis$ (acl2::alist-keys assign-alist)
-                          (acl2::alist-keys (acl2::alist-vals assign-alist))))
-         ((mv err val)
-          (ec-call (acl2::magic-ev concl alist state t t)))
-         ((when err)
-          (cw "Failed to execute the counterexample: ~@0~%" err))
-         (- (cw "Result: ~x0~%~%" val)))
-      (glcp-pretty-print-assignments (1+ n) (cdr ctrexes) concl execp state))))
-
-(defun glcp-print-ctrexamples (ctrexes warn-err type concl execp state)
-  (declare (xargs :stobjs state
-                  :guard (and (true-list-listp ctrexes)
-                              (pseudo-termp concl))))
-  (b* ((- (cw "
-*** SYMBOLIC EXECUTION ~@0 ***: ~@1 found." warn-err type))
-       (- (and ctrexes
-               (if (and (bfr-mode)
-                        (bfr-counterex-mode))
-                   (cw "~%Showing the example produced by SAT.~%~%")
-                 (cw "
-Showing ~x0 examples. Each example consists of a template and a
-concrete assignment.  The template shows a class of examples, and the
-concrete assignment represents a specific example from that
-class:~%~%" (len ctrexes))))))
-    (glcp-pretty-print-assignments 1 ctrexes concl execp state)))
 
 ;; (defun glcp-counterexample-wormhole (ctrexes warn-err type concl execp)
 ;;   (wormhole
@@ -1870,157 +421,105 @@
 
 (add-macro-alias glcp-error glcp-error-fn)
 
-(defun glcp-bit-to-obj-ctrexamples (assigns sspec-alist gobj-alist)
-  (if (atom assigns)
-      nil
-    (cons (list (caar assigns)
-                (generic-geval gobj-alist (list (cadar assigns)))
-                (inspec-show-assign-spec sspec-alist (cddar assigns)))
-          (glcp-bit-to-obj-ctrexamples (cdr assigns) sspec-alist gobj-alist))))
-
-(defun glcp-gen-ctrexes (ctrex-info alist hyp-bdd n state)
-  (b* (((er assigns) (glcp-gen-assignments ctrex-info alist hyp-bdd n state)))
-    (value (glcp-bit-to-obj-ctrexamples assigns alist (shape-spec-to-gobj
-                                                       alist)))))
-
-(defthm glcp-gen-ctrexes-does-not-fail
-  (not (mv-nth 0 (glcp-gen-ctrexes n hyp-bdd bdd bound state)))
-  :hints(("Goal" :in-theory (disable glcp-gen-assignments))))
-
-(in-theory (disable glcp-gen-ctrexes))
-
-(defun glcp-analyze-interp-result (val al hyp-bdd id concl config state)
-  (b* (((glcp-config config) config)
-       (test (gtests val t))
-       (hyp-param (bfr-to-param-space hyp-bdd hyp-bdd))
-       (unk (bfr-and hyp-param (gtests-unknown test)))
-       (false (bfr-and hyp-param
-                       (bfr-not (gtests-unknown test))
-                       (bfr-not (gtests-nonnil test))))
+
+
+
+
+
+
+
+(defun glcp-analyze-interp-result (hyp-bfr concl-bfr constraint al id concl config bvar-db
+                                           state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :verify-guards nil))
+  (b* ((config (glcp-config-update-param hyp-bfr config))
+       (config (glcp-config-update-term concl config))
+       ((glcp-config config) config)
+       (hyp-param (bfr-to-param-space hyp-bfr hyp-bfr))
+       (false (bfr-and hyp-param (bfr-and constraint (bfr-not concl-bfr))))
        (state (acl2::f-put-global 'glcp-var-bindings al state))
-       (state (acl2::f-put-global 'glcp-counterex false state))
-       (state (acl2::f-put-global 'glcp-indeterminate unk state))
+       (state (acl2::f-put-global 'glcp-concl-bfr false state))
        ((mv false-sat false-succ false-ctrex) (bfr-sat false))
        ((when (and false-sat false-succ))
-        (b* (((er ctrexes) (glcp-gen-ctrexes
-                            false-ctrex al hyp-bdd config.nexamples state))
-             (state (acl2::f-put-global 'glcp-counterex-assignments
-                                        ctrexes state)))
-          (prog2$ (glcp-print-ctrexamples
-                   ctrexes "ERROR" "Counterexamples"
-                   concl config.exec-ctrex state)
-                  (if config.abort-ctrex
-                      (glcp-error
-                       (acl2::msg "~
-~x0: Counterexamples found in ~@1; aborting~%" config.clause-proc-name id))
-                    (value (list ''nil))))))
-       ;; False was either unsat or the check failed.  Either way we check unknown.
-       ((mv unk-sat unk-succ unk-ctrex) (bfr-sat unk))
-       ((when (and unk-sat unk-succ))
-        (b* (((er ctrexes) (glcp-gen-ctrexes
-                            unk-ctrex al hyp-bdd config.nexamples state))
-             (state (acl2::f-put-global 'glcp-indeterminate-assignments
-                                        ctrexes state)))
-          (prog2$ (glcp-print-ctrexamples
-                   ctrexes (if config.abort-unknown "ERROR" "WARNING")
-                   "Indeterminate results" concl config.exec-ctrex state)
-                  (if config.abort-unknown
-                      (glcp-error
-                       (acl2::msg "~
-~x0: Indeterminate results found in ~@1; aborting~%"
-                                  config.clause-proc-name id))
-                    (value (list ''nil))
-                    ;; NOTE: We used to produce the following clause when an
-                    ;; unknown result was encountered, giving the user the chance
-                    ;; to prove that the resulting symbolic object actually
-                    ;; represented something constant-true.  But this seems
-                    ;; impractical, and it requires that the evaluator used to
-                    ;; prove the clause processor correct recognize geval, which
-                    ;; causes soundness problems regarding bfr-mode attachment,
-                    ;; because we're producing a term whose meaning depends on
-                    ;; the current bfr-mode.  A fix might be to create separate
-                    ;; geval functions for the separate bfr modes and put down
-                    ;; whichever matches the current bfr mode.
-                    ;; 
-                    ;; (value `((not (gl-cp-hint 'result))
-                    ;;          (,geval-name ',val env)))
-                    ))))
-       ((when (and false-succ unk-succ))
+        (b* (((mv er & state)
+              (glcp-gen/print-ctrexamples
+               false-ctrex "ERROR" "Counterexamples" config bvar-db state))
+             ((when er) (mv er nil state))
+             ((when config.abort-ctrex)
+              (mv (msg
+                   "~x0: Counterexamples found in ~@1; aborting~%"
+                   config.clause-proc-name id)
+                  nil state)))
+          (value (list ''nil))))
+       ((when false-succ)
         ;; Both checks succeeded and were UNSAT, so the theorem is proved
         ;; (modulo side-goals).
         (value (list ''t))))
-    ;; One or both of the SAT checks failed.
+    ;; The SAT check failed:
     (if config.abort-unknown
-        (glcp-error
-         (acl2::msg "~ ~x0: SAT check failed in ~@1; aborting~%"
-                    config.clause-proc-name id))
-      (value (list ''nil))
-      ;; NOTE: See above comment about soundness problems with
-      ;; geval/bfr-mode/attachment.
-;;       (value `((not (gl-cp-hint 'result))
-;;                (,geval-name ',val env)))
-      )))
-
-(local
- (encapsulate nil
-   (local (defthm equal-of-cons
-            (equal (equal (cons a b) c)
-                   (and (consp c)
-                        (equal a (car c))
-                        (equal b (cdr c))))))
-   (defthm glcp-analyze-interp-result-irrelevant
-     (and (implies (syntaxp (not (and (equal al ''nil)
-                                      (equal concl ''nil)
-                                      (equal st ''nil))))
-                   (and (equal (mv-nth 0 (glcp-analyze-interp-result
-                                          val al hyp-bdd id concl config st))
-                               (mv-nth 0 (glcp-analyze-interp-result
-                                          val nil hyp-bdd id nil config nil)))
-                        (equal (mv-nth 1 (glcp-analyze-interp-result
-                                          val al hyp-bdd id concl config st))
-                               (mv-nth 1 (glcp-analyze-interp-result
-                                          val nil hyp-bdd id nil config nil)))))
-          ;; (implies (syntaxp (not (and (equal al ''nil)
-          ;;                             (equal concl ''nil)
-          ;;                             (equal st ''nil))))
-          ;;          (equal (mv-nth 1 (glcp-analyze-interp-result
-          ;;                            val al hyp-bdd id concl config st))
-          ;;                 (mv-nth 1 (glcp-analyze-interp-result
-          ;;                            val nil hyp-bdd abort-unknown abort-ctrex nil nil
-          ;;                            geval-name nil nil nil nil))))
-          )
-     :hints(("Goal" :in-theory '(glcp-analyze-interp-result
-                                 glcp-gen-ctrexes-does-not-fail
-                                 glcp-error))))))
+        (mv
+         (msg "~x0: SAT check failed in ~@1; aborting~%"
+              config.clause-proc-name id)
+         nil state)
+      (value (list ''nil)))))
+
+
+;; (local
+;;  (encapsulate nil
+;;    (local (defthm equal-of-cons
+;;             (equal (equal (cons a b) c)
+;;                    (and (consp c)
+;;                         (equal a (car c))
+;;                         (equal b (cdr c))))))
+;;    (defthm glcp-analyze-interp-result-irrelevant
+;;      (and (implies (syntaxp (not (and (equal al ''nil)
+;;                                       (equal concl ''nil)
+;;                                       (equal st ''nil))))
+;;                    (and (equal (mv-nth 0 (glcp-analyze-interp-result
+;;                                           val al hyp-bfr id concl config
+;;                                           bvar-db st))
+;;                                (mv-nth 0 (glcp-analyze-interp-result
+;;                                           val nil hyp-bfr id concl config nil nil)))
+;;                         (equal (mv-nth 1 (glcp-analyze-interp-result
+;;                                           val al hyp-bfr id concl config
+;;                                           bvar-db st))
+;;                                (mv-nth 1 (glcp-analyze-interp-result
+;;                                           val nil hyp-bfr id concl config nil nil)))))
+;;           ;; (implies (syntaxp (not (and (equal al ''nil)
+;;           ;;                             (equal concl ''nil)
+;;           ;;                             (equal st ''nil))))
+;;           ;;          (equal (mv-nth 1 (glcp-analyze-interp-result
+;;           ;;                            val al hyp-bfr id concl config st))
+;;           ;;                 (mv-nth 1 (glcp-analyze-interp-result
+;;           ;;                            val nil hyp-bfr abort-unknown abort-ctrex nil nil
+;;           ;;                            geval-name nil nil nil nil))))
+;;           )
+;;      :hints(("Goal" :in-theory '(glcp-analyze-interp-result
+;;                                  glcp-gen-ctrexes-does-not-fail
+;;                                  glcp-error))))))
 
+(local (in-theory (disable glcp-gen/print-ctrexamples)))
 
 (local
  (defthm glcp-analyze-interp-result-correct
-   (implies (and (not (glcp-generic-geval val (cdr (assoc-equal 'env alist))))
-                 (bfr-eval (bfr-to-param-space hyp-bdd hyp-bdd)
+   (implies (and (not (bfr-eval val (cadr (assoc-equal 'env alist))))
+                 (bfr-eval (bfr-to-param-space hyp-bfr hyp-bfr)
+                           (car (cdr (assoc-equal 'env alist))))
+                 (bfr-eval constraint
                            (car (cdr (assoc-equal 'env alist)))))
-            (not (glcp-generic-ev
+            (not (glcp-generic-geval-ev
                   (disjoin
                    (mv-nth 1 (glcp-analyze-interp-result
-                              val al hyp-bdd id concl config state)))
+                               hyp-bfr val constraint al id concl config bvar-db state)))
                   alist)))
    :hints (("goal" :use
-            ((:instance glcp-generic-geval-gtests-nonnil-correct
-                        (x val) (hyp t)
-                        (env (cdr (assoc-equal 'env alist))))
-             (:instance
-              bfr-sat-unsat
-              (prop (bfr-and (bfr-to-param-space hyp-bdd hyp-bdd)
-                             (bfr-not (gtests-unknown (gtests val t)))
-                             (bfr-not (gtests-nonnil (gtests val t)))))
-              (env (cadr (assoc-equal 'env alist))))
-             (:instance
+            ((:instance
               bfr-sat-unsat
-              (prop (bfr-and (bfr-to-param-space hyp-bdd hyp-bdd)
-                             (gtests-unknown (gtests val t))))
+              (prop (bfr-and (bfr-to-param-space hyp-bfr hyp-bfr)
+                             (bfr-and constraint (bfr-not val))))
               (env (cadr (assoc-equal 'env alist)))))
             :in-theory (e/d (gl-cp-hint)
-                            (glcp-generic-geval-gtests-nonnil-correct
+                            (; glcp-generic-geval-gtests-nonnil-correct
                              gtests-nonnil-correct
                              bfr-sat-unsat))
             :do-not-induct t)
@@ -2037,56 +536,71 @@
 (local
  (defthm w-state-of-n-satisfying-assigns-and-specs
    (equal (w (mv-nth 2 (n-satisfying-assigns-and-specs
-                        n  hyp-bdd ctrex-info max-index state)))
+                        n  hyp-bfr ctrex-info max-index state)))
           (w state))
    :hints(("Goal" :in-theory (enable random$)))))
 
 (local
  (defthm w-state-of-glcp-gen-assignments
-   (equal (w (mv-nth 2 (glcp-gen-assignments ctrex-info alist hyp-bdd n
+   (equal (w (mv-nth 2 (glcp-gen-assignments ctrex-info alist hyp-bfr n
                                              state)))
           (w state))))
 
+(local (in-theory (disable glcp-gen-assignments)))
+(local (in-theory (disable glcp-bit-to-obj-ctrexamples)))
 (local
  (defthm w-state-of-glcp-gen-ctrexes
-   (equal (w (mv-nth 2 (glcp-gen-ctrexes ctrex-info alist hyp-bdd n
-                                             state)))
+   (equal (w (mv-nth 2 (glcp-gen-ctrexes ctrex-info alist hyp-bfr n
+                                             bvar-db state)))
           (w state))
    :hints(("Goal" :in-theory (enable glcp-gen-ctrexes)))))
+(local (in-theory (disable glcp-gen-ctrexes)))
+
+(local (in-theory (disable w put-global)))
+
+;; (local (defthm w-state-of-glcp-pretty-print-assignments
+;;          (equal (w (mv-nth 2 (glcp-pretty-print-assignments
+;;                               n ctrexes concl execp param-bfr bvar-db state)))
+;;                 (w state))
+;;          :hints(("Goal" :in-theory (disable glcp-ctrex-check-bvar-db
+;;                                             bindings-quote-if-needed
+;;                                             acl2::magic-ev
+;;                                             magicer-ev)))))
 
 (local
  (defthm w-state-of-glcp-analyze-interp-result
    (equal (w (mv-nth 2 (glcp-analyze-interp-result
-                        val al hyp-bdd id concl config state)))
+                         hyp-bfr val constr al id concl config bvar-db state)))
           (w state))
-   :hints(("Goal" :in-theory (enable glcp-analyze-interp-result)))))
+   :hints(("Goal" :in-theory (enable glcp-analyze-interp-result
+                                     glcp-gen/print-ctrexamples)))))
 
 (local
  (defthm glcp-analyze-interp-result-pseudo-term-listp
    (pseudo-term-listp
     (mv-nth 1 (glcp-analyze-interp-result
-               val al hyp-bdd id concl config state)))))
+               hyp-bfr val constr al id concl config bvar-db state)))))
 
 (in-theory (disable glcp-analyze-interp-result))
 
-(local
- (progn
-   (defun gobj-list-to-param-space (list p)
-     (if (atom list)
-         nil
-       (gl-cons (gobj-to-param-space (car list) p)
-             (gobj-list-to-param-space (cdr list) p))))
-
-
-   (defthm glcp-generic-geval-alist-gobj-alist-to-param-space
-     (equal (glcp-generic-geval-alist
-             (gobj-alist-to-param-space alist p)
-             env)
-            (pairlis$ (strip-cars alist)
-                      (glcp-generic-geval
-                       (gobj-to-param-space (gobj-strip-cdrs alist) p)
-                       env)))
-     :hints(("Goal" :in-theory (enable strip-cdrs))))))
+;; (local
+;;  (progn
+;;    ;; (defun gobj-list-to-param-space (list p)
+;;    ;;   (if (atom list)
+;;    ;;       nil
+;;    ;;     (gl-cons (gobj-to-param-space (car list) p)
+;;    ;;           (gobj-list-to-param-space (cdr list) p))))
+
+
+;;    (defthm glcp-generic-geval-alist-gobj-alist-to-param-space
+;;      (equal (glcp-generic-geval-alist
+;;              (gobj-alist-to-param-space alist p)
+;;              env)
+;;             (pairlis$ (strip-cars alist)
+;;                       (glcp-generic-geval-list
+;;                        (gobj-list-to-param-space (strip-cdrs alist) p)
+;;                        env)))
+;;      :hints(("Goal" :in-theory (enable strip-cdrs))))))
 
 
 
@@ -2230,51 +744,274 @@
 
 (local
  (progn
-   (defthm glcp-generic-ev-dumb-negate-lit
-     (iff (glcp-generic-ev (dumb-negate-lit lit) a)
-          (not (glcp-generic-ev lit a))))
+   (defthm glcp-generic-geval-ev-dumb-negate-lit
+     (iff (glcp-generic-geval-ev (dumb-negate-lit lit) a)
+          (not (glcp-generic-geval-ev lit a))))
 
 
-   (defthm glcp-generic-ev-list*-macro
-     (equal (glcp-generic-ev (list*-macro (append x (list ''nil))) al)
-            (glcp-generic-ev-lst x al))
+   (defthm glcp-generic-geval-ev-list*-macro
+     (equal (glcp-generic-geval-ev (list*-macro (append x (list ''nil))) al)
+            (glcp-generic-geval-ev-lst x al))
      :hints(("Goal" :in-theory (enable append))))
 
 
    (defthm pairlis-eval-alist-is-norm-alist
      (implies (nonnil-symbol-listp vars)
               (equal (pairlis$ vars
-                               (glcp-generic-ev-lst vars alist))
+                               (glcp-generic-geval-ev-lst vars alist))
                      (norm-alist vars alist)))
      :hints(("Goal" :in-theory (enable nonnil-symbol-listp
                                        pairlis$))))
 
 
 
-   (defthmd glcp-generic-ev-disjoin-is-or-list-glcp-generic-ev-lst
-     (iff (glcp-generic-ev (disjoin lst) env)
-          (acl2::or-list (glcp-generic-ev-lst lst env)))
+   (defthmd glcp-generic-geval-ev-disjoin-is-or-list-glcp-generic-geval-ev-lst
+     (iff (glcp-generic-geval-ev (disjoin lst) env)
+          (acl2::or-list (glcp-generic-geval-ev-lst lst env)))
      :hints (("goal" :induct (len lst))))
 
-   (defthm glcp-generic-ev-disjoin-norm-alist
+   (defthm glcp-generic-geval-ev-disjoin-norm-alist
      (implies (and (pseudo-term-listp clause)
                    (subsetp-equal (collect-vars-list clause) vars))
-              (iff (glcp-generic-ev (disjoin clause) (norm-alist vars alist))
-                   (glcp-generic-ev (disjoin clause) alist)))
+              (iff (glcp-generic-geval-ev (disjoin clause) (norm-alist vars alist))
+                   (glcp-generic-geval-ev (disjoin clause) alist)))
      :hints(("Goal" :in-theory (enable
-                                glcp-generic-ev-disjoin-is-or-list-glcp-generic-ev-lst))))))
+                                glcp-generic-geval-ev-disjoin-is-or-list-glcp-generic-geval-ev-lst))))))
+
+
+
+
+(defun shape-spec-bindingsp (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      (equal x nil)
+    (and (consp (car x))
+         (symbolp (caar x))
+         (not (keywordp (caar x)))
+         (caar x)
+         (consp (cdar x))
+         (shape-specp (cadar x))
+         (shape-spec-bindingsp (cdr x)))))
+
+
+
+
+
+
+
+
+(local (defthm pbfr-depends-on-t-is-bfr-depends-on
+         (equal (pbfr-depends-on k t x)
+                (bfr-depends-on k x))
+         :hints (("goal" :in-theory (enable pbfr-depends-on
+                                            bfr-depends-on
+                                            pbfr-semantic-depends-on
+                                            bfr-from-param-space)))))
+
+(defthm pbfr-vars-bounded-of-bfr-var
+  (implies (<= (+ 1 (nfix v)) (nfix k))
+           (pbfr-vars-bounded k t (bfr-var v)))
+  :hints ((and stable-under-simplificationp
+               `(:expand (,(car (last clause)))))))
+
+
+(defthm pbfr-list-vars-bounded-of-numlist-to-vars
+  (implies (<= (nat-list-max x) (nfix n))
+           (pbfr-list-vars-bounded n t (numlist-to-vars x)))
+  :hints (("goal" :induct (nat-list-max x)
+           :expand ((nat-list-max x)
+                    (numlist-to-vars x)))))
+
+;; (defthm pbfr-list-vars-bounded-of-greater
+;;   (implies (and (pbfr-list-vars-bounded n p x)
+;;                 (<= (nfix n) (nfix k)))
+;;            (pbfr-list-vars-bounded k p x))
+;;   :hints ((and stable-under-simplificationp
+;;                `(:expand (,(car (last clause)))))))
+
+
+
+(include-book "symbolic-arithmetic")
+
+(defthm pbfr-list-vars-bounded-of-bfr-logapp-nus
+  (implies (and (pbfr-list-vars-bounded k p x)
+                (pbfr-list-vars-bounded k p y))
+           (pbfr-list-vars-bounded k p (bfr-logapp-nus n x y)))
+  :hints (("goal" :in-theory (enable pbfr-list-vars-bounded-in-terms-of-witness))))
+
+(defthm pbfr-list-vars-bounded-of-break-g-number
+  (implies (and (<= (nat-list-max (car num)) (nfix n))
+                (<= (nat-list-max (cadr num)) (nfix n))
+                (<= (nat-list-max (caddr num)) (nfix n))
+                (<= (nat-list-max (cadddr num)) (nfix n)))
+           (and (pbfr-list-vars-bounded
+                 n t (mv-nth 0 (break-g-number (num-spec-to-num-gobj num))))
+                (pbfr-list-vars-bounded
+                 n t (mv-nth 1 (break-g-number (num-spec-to-num-gobj num))))
+                (pbfr-list-vars-bounded
+                 n t (mv-nth 2 (break-g-number (num-spec-to-num-gobj num))))
+                (pbfr-list-vars-bounded
+                 n t (mv-nth 3 (break-g-number (num-spec-to-num-gobj num))))))
+  :hints(("Goal" :in-theory (enable break-g-number num-spec-to-num-gobj))))
+
+(defthm pbfr-list-vars-bounded-of-break-g-number-int
+  (implies (pbfr-list-vars-bounded k p int)
+           (and (pbfr-list-vars-bounded
+                 k p (mv-nth 0 (break-g-number (list int))))
+                (pbfr-list-vars-bounded
+                 k p (mv-nth 1 (break-g-number (list int))))
+                (pbfr-list-vars-bounded
+                 k p (mv-nth 2 (break-g-number (list int))))
+                (pbfr-list-vars-bounded
+                 k p (mv-nth 3 (break-g-number (list int))))))
+  :hints(("Goal" :in-theory (enable break-g-number))))
+
+
+
+(defthm-shape-spec-flag
+  (defthm gobj-vars-bounded-of-shape-spec-to-gobj
+    (implies (<= (shape-spec-max-bvar x) (nfix n))
+             (gobj-vars-bounded n t (shape-spec-to-gobj x)))
+    :flag ss)
+  (defthm gobj-vars-bounded-of-shape-spec-to-gobj-list
+    (implies (<= (shape-spec-max-bvar-list x) (nfix n))
+             (gobj-list-vars-bounded n t (shape-spec-to-gobj-list x)))
+    :flag list)
+  :hints (("goal" :do-not '(simplify preprocess)
+           :in-theory (disable shape-spec-max-bvar
+                               shape-spec-max-bvar-list
+                               shape-spec-to-gobj
+                               shape-spec-to-gobj-list
+                               nat-list-max))
+          (acl2::just-expand ((shape-spec-to-gobj-list x)
+                              (shape-spec-max-bvar-list x)
+                              (shape-spec-to-gobj x)
+                              (shape-spec-max-bvar x))
+                             :mark-only t :last-only t)
+            '(:do-not nil)
+            (and stable-under-simplificationp
+                 '(:in-theory (e/d (acl2::expand-marked-meta)
+                                   (shape-spec-max-bvar
+                                    shape-spec-max-bvar-list
+                                    shape-spec-to-gobj
+                                    shape-spec-to-gobj-list
+                                    nat-list-max))))))
+
+
+
+
+
+
+
+
+
+(local
+ (progn
+   (defthm bvar-db-fix-env-eval-gobj-list-vars-bounded-unparam-rw
+     (implies (and ; (bvar-db-orderedp p bvar-db)
+               (bfr-eval p env)
+               (bfr-vars-bounded min p)
+               (gobj-list-vars-bounded min t x)
+               (<= (nfix n) (next-bvar$a bvar-db)))
+              (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                             var-env)))
+                (equal (glcp-generic-geval-list x (cons (bfr-unparam-env p env-n) var-env))
+                       (glcp-generic-geval-list x (cons env var-env)))))
+     :hints (("goal" :induct (len x)
+              :expand ((:free (env) (glcp-generic-geval-list x env))))))
+
+   (defthm bvar-db-fix-env-eval-gobj-list-vars-bounded-unparam-with-no-param
+     (implies (and ; (bvar-db-orderedp p bvar-db)
+               (gobj-list-vars-bounded min t x)
+               (<= (nfix n) (next-bvar$a bvar-db)))
+              (let* ((env-n (bvar-db-fix-env n min bvar-db t env var-env)))
+                (equal (glcp-generic-geval-list x (cons env-n var-env))
+                       (glcp-generic-geval-list x (cons env var-env)))))
+     :hints (("goal" :induct (len x)
+              :expand ((:free (env) (glcp-generic-geval-list x env))))))))
+
+
+
+(defun glcp-cases-wormhole (term id)
+  (wormhole 'glcp-cases-wormhole
+            '(lambda (whs) whs)
+            nil
+            `(prog2$ (let ((id ',id))
+                       (declare (ignorable id))
+                       ,term)
+                     (value :q))
+            :ld-prompt nil
+            :ld-pre-eval-print nil
+            :ld-post-eval-print nil
+            :ld-verbose nil))
+
+(defun doubleton-list-to-alist (x)
+  (if (atom x)
+      nil
+    (cons (cons (caar x) (cadar x))
+          (doubleton-list-to-alist (cdr x)))))
+
+(defun bindings-to-vars-vals (x)
+  (if (atom x)
+      (mv nil nil)
+    (mv-let (vars vals)
+      (bindings-to-vars-vals (cdr x))
+      (if (and (symbolp (caar x))
+               (pseudo-termp (cadar x)))
+          (mv (cons (caar x) vars)
+              (cons (cadar x) vals))
+        (mv vars vals)))))
+
+(defun bindings-to-lambda (bindings term)
+  (mv-let (vars vals)
+    (bindings-to-vars-vals bindings)
+    `((lambda ,vars ,term) . ,vals)))
+
+(defthm bindings-to-vars-vals-wfp
+  (mv-let (vars vals)
+    (bindings-to-vars-vals x)
+    (and (symbol-listp vars)
+         (pseudo-term-listp vals)
+         (true-listp vals)
+         (equal (len vals) (len vars))
+         (not (stringp vars))
+         (not (stringp vals))))
+  :hints(("Goal" :in-theory (disable pseudo-termp))))
 
+(defthm bindings-to-lambda-pseudo-termp
+  (implies (pseudo-termp term)
+           (pseudo-termp (bindings-to-lambda bindings term)))
+  :hints(("Goal" :in-theory (enable true-listp length pseudo-termp))))
+
+(in-theory (disable bindings-to-lambda))
+
+;; Transforms an alist with elements of the form
+;; (((param1 val1) (param2 val2)) shape-spec)
+;; to the form (parametrized-hyp . shape-spec).
+(defun param-bindings-to-alist (hyp bindings)
+  (if (atom bindings)
+      nil
+    (cons (list* (sublis-into-term
+                  hyp (doubleton-list-to-alist (caar bindings)))
+;;           (bindings-to-lambda (caar bindings) hyp)
+           (acl2::msg "case: ~x0" (caar bindings))
+           (cadar bindings))
+          (param-bindings-to-alist hyp (cdr bindings)))))
+(local
+ (defthm param-bindings-to-alist-pseudo-term-listp-strip-cars
+   (implies (pseudo-termp hyp)
+            (pseudo-term-listp (strip-cars (param-bindings-to-alist hyp bindings))))))
 
 
 
 (make-event
- (sublis *glcp-generic-template-subst* *glcp-run-parametrized-template*))
+ (sublis *glcp-generic-template-subst* *glcp-clause-proc-template*))
 
 (local (progn
 ; [Removed by Matt K. to handle changes to member, assoc, etc. after ACL2 4.2.]
 ;          (defthm member-eq-is-member-equal
 ;            (equal (member-eq x y) (member-equal x y)))
-;          
+;
 ;          (defthm set-difference-eq-is-set-difference-equal
 ;            (equal (set-difference-eq x y) (set-difference-equal x y))
 ;            :hints(("Goal" :in-theory (enable set-difference-equal))))
@@ -2286,7 +1023,7 @@
 
 
 
-(local 
+(local
  (encapsulate nil
    (local (defthm true-listp-when-nat-listp
             (implies (nat-listp x)
@@ -2307,6 +1044,24 @@
        (append (shape-spec-vars (cadar x))
                (shape-spec-bindings-vars (cdr x)))))))
 
+
+
+(local
+ (progn
+   (defthm assoc-in-glcp-generic-geval-alist
+     (implies (alistp al)
+              (equal (assoc k (glcp-generic-geval-alist al env))
+                     (and (assoc k al)
+                          (cons k (glcp-generic-geval (cdr (assoc k al)) env))))))
+
+   (defthm assoc-in-shape-specs-to-interp-al
+     (implies (alistp al)
+              (equal (assoc k (shape-specs-to-interp-al al))
+                     (and (assoc k al)
+                          (cons k (shape-spec-to-gobj (cadr (assoc k al))))))))))
+
+
+
 ;; (defthm eval-of-shape-spec-to-interp-al-alist
 ;;   (implies (and (shape-spec-bindingsp bindings)
 ;;                 (no-duplicatesp (shape-spec-bindings-indices bindings))
@@ -2314,127 +1069,531 @@
 ;;            (equal (glcp-generic-geval-alist
 ;;                    (shape-specs-to-interp-al bindings)
 ;;                    (shape-spec-to-env (strip-cadrs bindings)
-;;                                       (glcp-generic-ev-lst (strip-cars bindings)
+;;                                       (glcp-generic-geval-ev-lst (strip-cars bindings)
 ;;                                                       alist)))
 ;;                   (pairlis$ (strip-cars bindings)
-;;                             (glcp-generic-ev-lst (strip-cars bindings) alist))))
+;;                             (glcp-generic-geval-ev-lst (strip-cars bindings) alist))))
 ;;   hie)
 
 ;;                 ((GLCP-GENERIC-GEVAL-ALIST
 ;;    (SHAPE-SPECS-TO-INTERP-AL BINDINGS)
 ;;    (SHAPE-SPEC-TO-ENV (STRIP-CADRS BINDINGS)
-;;                       (GLCP-GENERIC-EV-LST (STRIP-CARS BINDINGS)
+;;                       (GLCP-GENERIC-GEVAL-EV-LST (STRIP-CARS BINDINGS)
 ;;                                       ALIST)))
 
+(local
+ (defun-nx glcp-generic-run-parametrized-ctrex (alist hyp concl bindings obligs config state)
+   (b* (((glcp-config config) config)
+        (obj (strip-cadrs bindings))
+        (config (change-glcp-config config :shape-spec-alist bindings))
+        (al (shape-specs-to-interp-al bindings))
+        (env-term (shape-spec-list-env-term
+                   obj
+                   (strip-cars bindings)))
+        (env1 (glcp-generic-geval-ev env-term alist))
+        (env (cons (slice-to-bdd-env (car env1) nil) (cdr env1)))
+        (next-bvar (shape-spec-max-bvar-list
+                    (strip-cadrs bindings)))
+        (interp-st (create-interp-st))
+        (interp-st (update-is-obligs obligs interp-st))
+        (interp-st (update-is-constraint t interp-st))
+        (interp-st (update-is-constraint-db
+                    (gbc-db-make-fast
+                     (table-alist 'gl-bool-constraints (w state)))
+                    interp-st)))
+     (glcp-generic-interp-hyp/concl-env
+      env hyp concl al config.concl-clk config interp-st next-bvar state))))
+    ;;    ;; (bvar-db nil)
+    ;;    ;; (bvar-db1 nil)
+    ;;    (bvar-db (init-bvar-db (shape-spec-max-bvar-list
+    ;;                            (strip-cadrs bindings)) bvar-db))
+    ;;    ;; (config1 (glcp-config-update-param t config))
+    ;;    ((mv ?er obligs1 hyp-bfr bvar-db state)
+    ;;     (glcp-generic-interp-top-level-term hyp al t config.hyp-clk obligs config1 bvar-db state))
+    ;;    (env1 (cons (bvar-db-fix-env (next-bvar bvar-db)
+    ;;                                (base-bvar bvar-db)
+    ;;                                bvar-db t (car env) (cdr env))
+    ;;                (cdr env)))
+    ;;    (param-env (genv-param hyp-bfr env1))
+    ;;    (param-al (gobj-alist-to-param-space al hyp-bfr))
+    ;;    (bvar-db1 (parametrize-bvar-db hyp-bfr bvar-db bvar-db1))
+    ;;    (hyp-param (bfr-to-param-space hyp-bfr hyp-bfr))
+    ;;    (config2 (glcp-config-update-param hyp-bfr config1))
+    ;;    ((mv ?er ?obligs2 ?val bvar-db1 ?state)
+    ;;     (glcp-generic-interp-top-level-term concl param-al hyp-param config.concl-clk
+    ;;                                         obligs1 config2 bvar-db1 state))
+    ;;    (env2 (cons (bvar-db-fix-env (next-bvar bvar-db1)
+    ;;                                 (next-bvar bvar-db)
+    ;;                                 bvar-db1 hyp-bfr (car param-env) (cdr param-env))
+    ;;                (cdr param-env))))
+    ;; `((env1 . ,env1)
+    ;;   (env2 . ,env2)
+    ;;   (config1 . ,config1)
+    ;;   (config2 . ,config2)
+    ;;   (bvar-db . ,bvar-db)
+    ;;   (bvar-db1 . ,bvar-db1))))
+
+;; (defun-nx glcp-generic-run-parametrized-ctrex (alist hyp concl bindings obligs
+;;                                                      config state)
+;;   (cdr (assoc 'env2 (glcp-generic-run-parametrized-ctrex-aux alist hyp concl bindings
+;;                                                              obligs config state))))
+
+
+
+
+;; (defthm bvar-db-env-ok-of-bvar-db-fix-env-no-param
+;;   (implies (and (bvar-db-orderedp t bvar-db)
+;;                 (<= (nfix min) (nfix m))
+;;                 (<= (base-bvar$a bvar-db) (nfix m))
+;;                 (< (nfix m) (nfix n))
+;;                 (<= (nfix n) (next-bvar$a bvar-db)))
+;;            (let* ((bfr-env (bvar-db-fix-env n min bvar-db t bfr-env
+;;                                             var-env)))
+;;              (iff (bfr-lookup m bfr-env)
+;;                   (glcp-generic-geval (get-bvar->term m bvar-db)
+;;                                       (cons bfr-env var-env)))))
+;;   :hints (("Goal" :use ((:instance bvar-db-env-ok-of-bvar-db-fix-env-lemma
+;;                          (p t)))
+;;            :do-not-induct t)))
+
+
+
+
+
+;; (defthm glcp-generic-interp-top-level-term-correct-special
+;;   (b* (((mv ?erp ?obligs1 ?val ?bvar-db1 ?state1)
+;;         (glcp-generic-interp-top-level-term
+;;          term alist pathcond clk obligs config bvar-db state))
+;;        (bfr-env (bvar-db-fix-env n min bvar-db2 p bfr-env var-env)))
+;;     (implies (and (bfr-eval pathcond bfr-env)
+;;                   (not erp)
+;;                   (acl2::interp-defs-alistp obligs)
+;;                   (acl2::interp-defs-alistp (glcp-config->overrides config))
+;;                   (glcp-generic-geval-ev-theoremp
+;;                    (conjoin-clauses
+;;                     (acl2::interp-defs-alist-clauses
+;;                      obligs1)))
+;;                   ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+;;                   (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+;;                   (glcp-generic-bvar-db-env-ok bvar-db1 config (cons bfr-env var-env))
+;;                   (equal (w state0) (w state))
+;;                   (pseudo-termp term)
+;;                   (alistp alist))
+;;              (iff (bfr-eval val bfr-env)
+;;                   (glcp-generic-geval-ev term (glcp-generic-geval-alist
+;;                                                alist (cons bfr-env var-env))))))
+;;   :hints(("Goal" :use ((:instance glcp-generic-interp-top-level-term-correct
+;;                         (bfr-env (bvar-db-fix-env n min bvar-db2 p bfr-env
+;;                                                   var-env))
+;;                         (env (cons (bvar-db-fix-env n min bvar-db2 p bfr-env
+;;                                                     var-env)
+;;                                    var-env))))
+;;           :in-theory (disable glcp-generic-interp-top-level-term-correct))))
+
+;; (defthm bfr-vars-bounded-consts
+;;   (and (bfr-vars-bounded k t)
+;;        (bfr-vars-bounded k nil))
+;;   :hints(("Goal" :in-theory (enable bfr-vars-bounded))))
+
+;; (defthm bvar-db-env-ok-of-bvar-db-fix-env-no-param
+;;   (implies (and (bvar-db-orderedp t bvar-db)
+;;                 (equal t (glcp-config->param-bfr config))
+;;                 (equal n (next-bvar$a bvar-db))
+;;                 (equal b (base-bvar$a bvar-db)))
+;;            (let ((bfr-env (bvar-db-fix-env n b
+;;                                            bvar-db t bfr-env var-env)))
+;;              (glcp-generic-bvar-db-env-ok bvar-db config (cons bfr-env var-env))))
+;;   :hints (("goal" :use ((:instance bvar-db-env-ok-of-bvar-db-fix-env
+;;                          (p t)))
+;;            :in-theory (disable bvar-db-env-ok-of-bvar-db-fix-env)
+;;            :do-not-induct t)))
+
+
+;; (defthm bvar-db-ordered-of-glcp-generic-interp-top-level-special
+;;   (b* (((mv ?erp ?obligs1 ?val ?bvar-db1 ?state1)
+;;         (glcp-generic-interp-top-level-term
+;;          term alist pathcond clk obligs config bvar-db state))
+;;        (k (next-bvar$a bvar-db)))
+;;     (implies (and (equal t (glcp-config->param-bfr config))
+;;                   (bvar-db-orderedp t bvar-db)
+;;                   (gobj-alist-vars-bounded k t alist))
+;;              (bvar-db-orderedp t bvar-db1)))
+;;   :hints (("goal" :Use ((:instance
+;;                          bvar-db-ordered-of-glcp-generic-interp-top-level
+;;                          (p t)))
+;;            :in-theory (disable bvar-db-ordered-of-glcp-generic-interp-top-level))))
+
+
+;; ;; (defthm gobj-alist-vars-bounded-of-shape-specs-to-interp-al
+;; ;;   (implies (<= (shape-spec-max-bvar-list (strip-cadrs bindings)) (nfix n))
+;; ;;            (not (gobj-alist-depends-on n t (shape-specs-to-interp-al
+;; ;;                                             bindings))))
+;; ;;   :hints(("Goal" :in-theory (enable shape-specs-to-interp-al))))
+
+(local
+ (defthm gobj-alist-vars-bounded-of-shape-specs-to-interp-al
+   (implies (<= (shape-spec-max-bvar-list (strip-cadrs bindings)) (nfix n))
+            (gobj-alist-vars-bounded n t (shape-specs-to-interp-al bindings)))))
+
+
+
+
+
+;; (defthm bfr-vars-bounded-of-glcp-generic-interp-top-level
+;;     (b* (((mv ?erp ?obligs1 ?val ?bvar-db1 ?state1)
+;;           (glcp-generic-interp-top-level-term
+;;            term alist pathcond clk obligs config bvar-db state)))
+;;       (implies (and (<= (next-bvar$a bvar-db1) (nfix k))
+;;                     (equal t (glcp-config->param-bfr config))
+;;                     (gobj-alist-vars-bounded k t alist))
+;;                (bfr-vars-bounded k val)))
+;;     :hints (("goal" :use ((:instance
+;;                            vars-bounded-of-glcp-generic-interp-top-level
+;;                            (p t)))
+;;              :in-theory (disable vars-bounded-of-glcp-generic-interp-top-level))))
+
+
+
+;; (defthm glcp-generic-run-parametrized-bvar-db-env1-ok
+;;   (b* (((mv ?erp ?obligs1 ?val ?bvar-db1 ?state1)
+;;         (glcp-generic-interp-top-level-term
+;;          term alist pathcond clk obligs config bvar-db state))
+;;        (bfr-env (bvar-db-fix-env n min bvar-db2 p bfr-env var-env))
+;;        (aux (glcp-generic-run-parametrized-ctrex-aux alist hyp concl bindings
+;;                                                      obligs config state)))
+;;     (implies (and (bfr-eval pathcond bfr-env)
+;;                   (not erp)
+;;                   (acl2::interp-defs-alistp obligs)
+;;                   (acl2::interp-defs-alistp (glcp-config->overrides config))
+;;                   (glcp-generic-geval-ev-theoremp
+;;                    (conjoin-clauses
+;;                     (acl2::interp-defs-alist-clauses
+;;                      obligs1)))
+;;                   ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+;;                   (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+;;                   (glcp-generic-bvar-db-env-ok bvar-db1 config (cons bfr-env var-env))
+;;                   (equal (w state0) (w state))
+;;                   (pseudo-termp term)
+;;                   (alistp alist))
+;;              (glcp-generic-bvar-db-env-ok
+;;               (cdr (assoc 'bvar-db aux))
+;;               (cdr (assoc 'config1 aux))
+;;               (cdr (assoc 'env1 aux)))))
+;;   :hints (("goal" :do-not-induct t)
+;;           (and stable-under-simplificationp
+;;                `(:expand (,(car (last clause)))))
+;;           (and stable-under-simplificationp
+;;                (let ((w (acl2::find-call-lst
+;;                          'glcp-generic-bvar-db-env-ok-witness
+;;                          clause)))
+;;                  `(:clause-processor
+;;                    (acl2::simple-generalize-cp
+;;                     clause '((,w . idx)))))))
+;;   :otf-flg t)
+
+
+;; (defthm glcp-generic-run-parametrized-bvar-db-env3-ok
+;;   (b* (((mv ?erp ?obligs1 ?val ?bvar-db1 ?state1)
+;;         (glcp-generic-interp-top-level-term
+;;          term alist pathcond clk obligs config bvar-db state))
+;;        (bfr-env (bvar-db-fix-env n min bvar-db2 p bfr-env var-env))
+;;        (aux (glcp-generic-run-parametrized-ctrex-aux alist hyp concl bindings
+;;                                                      obligs config state)))
+;;     (implies (and (bfr-eval pathcond bfr-env)
+;;                   (not erp)
+;;                   (acl2::interp-defs-alistp obligs)
+;;                   (acl2::interp-defs-alistp (glcp-config->overrides config))
+;;                   (glcp-generic-geval-ev-theoremp
+;;                    (conjoin-clauses
+;;                     (acl2::interp-defs-alist-clauses
+;;                      obligs1)))
+;;                   ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+;;                   (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+;;                   (glcp-generic-bvar-db-env-ok bvar-db1 config (cons bfr-env var-env))
+;;                   (equal (w state0) (w state))
+;;                   (pseudo-termp term)
+;;                   (alistp alist))
+;;              (glcp-generic-bvar-db-env-ok
+;;               (cdr (assoc 'bvar-db1 aux))
+;;               (cdr (assoc 'config2 aux))
+;;               (cdr (assoc 'env2 aux)))))
+;;   :hints (("goal" :do-not-induct t)
+;;           (and stable-under-simplificationp
+;;                `(:expand (,(car (last clause)))))
+;;           (and stable-under-simplificationp
+;;                (let ((w (acl2::find-call-lst
+;;                          'glcp-generic-bvar-db-env-ok-witness
+;;                          clause)))
+;;                  `(:clause-processor
+;;                    (acl2::simple-generalize-cp
+;;                     clause '((,w . idx)))))))
+;;   :otf-flg t)
+
+;; (defun-nx glcp-generic-run-parametrized-ctrex
+;;   (env hyp concl bindings obligs config state)
+;;   (b* (((glcp-config config) config)
+;;        (al (shape-specs-to-interp-al bindings))
+;;        (next-bvar (shape-spec-max-bvar-list (strip-cadrs bindings)))
+;;        (config (glcp-config-update-param t config)))
+;;     (glcp-generic-interp-hyp/concl-env
+;;      env hyp concl al config.concl-clk obligs config next-bvar state)))
+       ;; ((mv er obligs1 hyp-bfr concl-bfr bvar-db bvar-db1 state)
+       ;;  (glcp-generic-interp-hyp/concl
+       ;;   hyp concl al config.concl-clk obligs config next-bvar bvar-db
+       ;;   bvar-db1 state))
+       ;;    ((when er)
+       ;;     (flush-hons-get-hash-table-link obligs1)
+       ;;     (mv er nil state bvar-db bvar-db1))
+       ;;    ((mv erp val-clause state)
+       ;;     (glcp-analyze-interp-result
+       ;;      concl-bfr bindings hyp-bfr id concl config state))
+       ;;    ((when erp)
+       ;;     (mv erp nil state bvar-db bvar-db1))
+       ;;    ((mv erp val state)
+       ;;     (value (list val-clause cov-clause obligs1))))
+       ;; (mv erp val state bvar-db bvar-db1))
+
 
 (local
- (progn
+ (defthm glcp-generic-run-parametrized-correct-lemma
+   (b* (((mv erp (list val-clause cov-clause out-obligs) &)
+         (glcp-generic-run-parametrized
+          hyp concl vars bindings id obligs
+          config state))
+        (ctrex-env
+         (glcp-generic-run-parametrized-ctrex
+          alist hyp concl bindings obligs config state)))
+     (implies (and (glcp-generic-geval-ev hyp alist)
+                   (not (glcp-generic-geval-ev concl alist))
+                   (glcp-generic-geval-ev-theoremp
+                    (conjoin-clauses
+                     (acl2::interp-defs-alist-clauses out-obligs)))
+                   (not erp)
+                   (acl2::interp-defs-alistp obligs)
+                   (acl2::interp-defs-alistp (glcp-config->overrides config))
+                   (pseudo-termp concl)
+                   (pseudo-termp hyp)
+                   (equal vars (collect-vars concl))
+                   (glcp-generic-geval-ev-meta-extract-global-facts :state state1)
+                   (equal (w state) (w state1))
+                   (glcp-generic-geval-ev (disjoin cov-clause) alist)
+                   )
+              (not (glcp-generic-geval-ev
+                    (disjoin val-clause)
+                    `((env . ,(list ctrex-env)))))))
+   :hints (("goal" :do-not-induct t
+            :in-theory (e/d (gbc-db-empty-implies-gbc-db-vars-bounded)
+                            (collect-vars nth update-nth
+                                          pseudo-termp
+                                          dumb-negate-lit))))))
+
+
+(local
+ (defthm glcp-generic-run-parametrized-correct
+   (b* (((mv erp (list val-clause cov-clause out-obligs) &)
+         (glcp-generic-run-parametrized
+          hyp concl vars bindings id obligs
+          config state)))
+     (implies (and (glcp-generic-geval-ev hyp alist)
+                   (not (glcp-generic-geval-ev concl alist))
+                   (glcp-generic-geval-ev-theoremp
+                    (conjoin-clauses
+                     (acl2::interp-defs-alist-clauses out-obligs)))
+                   (not erp)
+                   (acl2::interp-defs-alistp obligs)
+                   (acl2::interp-defs-alistp (glcp-config->overrides config))
+                   (pseudo-termp concl)
+                   (pseudo-termp hyp)
+                   (equal vars (collect-vars concl))
+                   (glcp-generic-geval-ev-meta-extract-global-facts :state state1)
+                   (equal (w state) (w state1))
+                   (glcp-generic-geval-ev (disjoin cov-clause) alist)
+                   )
+              (not (glcp-generic-geval-ev-theoremp
+                    (disjoin val-clause)))))
+   :hints (("goal" :do-not-induct t
+            :in-theory (disable collect-vars
+                                pseudo-termp
+                                dumb-negate-lit
+                                glcp-generic-run-parametrized
+                                glcp-generic-run-parametrized-ctrex)
+            :use ((:instance glcp-generic-geval-ev-falsify
+                   (x (disjoin (car (mv-nth 1 (glcp-generic-run-parametrized
+                                               hyp concl vars bindings id obligs
+                                               config state)))))
+                   (a `((env . ,(list (glcp-generic-run-parametrized-ctrex
+                                       alist hyp concl bindings obligs config state)))))))))))
+
+
+
+  ;; :hints (("goal" :do-not-induct
+  ;;          t
+  ;;          :in-theory
+  ;;          (e/d* ()
+  ;;                (glcp-generic-geval-alist-gobj-alist-to-param-space
+  ;;                 glcp-generic-geval-gtests-nonnil-correct
+  ;;                 glcp-generic-interp-bad-obligs-term
+  ;;                 ;; shape-spec-listp-impl-shape-spec-to-gobj-list
+  ;;                 (:rules-of-class :definition :here)
+  ;;                 (:rules-of-class :type-prescription :here))
+  ;;                (gl-cp-hint acl2::clauses-result assoc-equal
+  ;;                            glcp-generic-run-parametrized not
+  ;;                            glcp-error
+  ;;                            acl2::fast-no-duplicatesp
+  ;;                            acl2::fast-no-duplicatesp-equal))
+  ;;          :restrict ((glcp-generic-geval-ev-disjoin-append ((a alist)))))
+  ;;         (and stable-under-simplificationp
+  ;;              (acl2::bind-as-in-definition
+  ;;               (glcp-generic-run-parametrized
+  ;;                hyp concl  (collect-vars concl) bindings id obligs config state)
+  ;;               (cov-clause val-clause hyp-bfr hyp-val)
+  ;;               (b* ((binding-env
+  ;;                     '(let ((slice (glcp-generic-geval-ev
+  ;;                                    (shape-spec-env-term
+  ;;                                     (strip-cadrs bindings)
+  ;;                                     (list*-macro (append (strip-cars
+  ;;                                                           bindings) '('nil)))
+  ;;                                     nil)
+  ;;                                    alist)))
+  ;;                        (cons (slice-to-bdd-env (car slice) nil)
+  ;;                              (cdr slice))))
+  ;;                    (param-env `(genv-param ,hyp-bfr ,binding-env)))
+  ;;                 `(:use
+  ;;                   ((:instance glcp-generic-geval-ev-falsify
+  ;;                     (x (disjoin ,cov-clause))
+  ;;                     (a alist))
+  ;;                    (:instance glcp-generic-geval-ev-falsify
+  ;;                     (x (disjoin ,val-clause))
+  ;;                     (a `((env . ,,param-env))))
+  ;;                    (:instance glcp-generic-geval-gtests-nonnil-correct
+  ;;                     (x ,hyp-val)
+  ;;                     (hyp t)
+  ;;                     (env ,binding-env)))))))
+  ;;         (bfr-reasoning)))
+
+
+(local
+ (encapsulate nil
    ;; (defthm bfr-p-bfr-to-param-space
    ;;   (implies (and (bfr-p p) (bfr-p x))
    ;;            (bfr-p (bfr-to-param-space p x)))
    ;;   :hints(("Goal" :in-theory (enable bfr-to-param-space bfr-p))))
 
 
-   (encapsulate nil
-     (local (in-theory
-             (e/d (gl-cp-hint)
-                  (shape-specs-to-interp-al
-                   shape-spec-listp pseudo-term-listp
-                   pseudo-termp pairlis$
-                   shape-spec-bindingsp
-                   dumb-negate-lit
-                   gtests-nonnil-correct
-                   no-duplicatesp-equal
-                   (bfr-to-param-space)
-                   gobj-alist-to-param-space
-                   list*-macro binary-append strip-cadrs strip-cars member-equal))))
-     (defthm glcp-generic-run-parametrized-correct
-       (b* (((mv erp (cons clauses out-obligs) &)
-             (glcp-generic-run-parametrized
-              hyp concl untrans-concl vars bindings id obligs
-              config state)))
-         (implies (and (not (glcp-generic-ev concl alist))
-                       (glcp-generic-ev-theoremp
-                        (conjoin-clauses
-                         (acl2::interp-defs-alist-clauses out-obligs)))
-                       (not erp)
-                       (glcp-generic-ev hyp alist)
-                       (acl2::interp-defs-alistp obligs)
-                       (acl2::interp-defs-alistp (glcp-config->overrides config))
-                       (pseudo-termp concl)
-                       (pseudo-termp hyp)
-                       (equal vars (collect-vars concl))
-                       (glcp-generic-ev-meta-extract-global-facts :state state1)
-                       (equal (w state) (w state1)))
-                  (not (glcp-generic-ev-theoremp (conjoin-clauses clauses)))))
-       :hints (("goal" :do-not-induct
-                t
-                :in-theory
-                (e/d* ()
-                      (glcp-generic-geval-alist-gobj-alist-to-param-space
-                       glcp-generic-geval-gtests-nonnil-correct
-                       glcp-generic-interp-term-bad-obligs
-                       ;; shape-spec-listp-impl-shape-spec-to-gobj-list
-                       (:rules-of-class :definition :here)
-                       (:rules-of-class :type-prescription :here))
-                      (gl-cp-hint acl2::clauses-result assoc-equal
-                                  glcp-generic-run-parametrized not
-                                  glcp-error
-                                  acl2::fast-no-duplicatesp
-                                  acl2::fast-no-duplicatesp-equal))
-                :restrict ((glcp-generic-ev-disjoin-append ((a alist)))))
-               (and stable-under-simplificationp
-                    (acl2::bind-as-in-definition
-                     (glcp-generic-run-parametrized
-                      hyp concl untrans-concl (collect-vars concl) bindings id obligs config state)
-                     (cov-clause val-clause hyp-bdd hyp-val)
-                     (b* ((binding-env '(shape-spec-to-env
-                                         (strip-cadrs bindings)
-                                         (glcp-generic-ev-lst
-                                          (strip-cars bindings)
-                                          alist)))
-                          (param-env `(genv-param ,hyp-bdd ,binding-env)))
-                       `(:use
-                         ((:instance glcp-generic-ev-falsify
-                                     (x (disjoin ,cov-clause))
-                                     (a alist))
-                          (:instance glcp-generic-ev-falsify
-                                     (x (disjoin ,val-clause))
-                                     (a `((env . ,,param-env))))
-                          (:instance glcp-generic-geval-gtests-nonnil-correct
-                                     (x ,hyp-val)
-                                     (hyp t)
-                                     (env ,binding-env)))))))
-               (bfr-reasoning))))
+   (local (in-theory (disable shape-specs-to-interp-al
+                              pseudo-termp pseudo-term-listp
+                              shape-spec-bindingsp
+                              nth update-nth
+                              ; acl2::consp-by-len
+                              list*-macro)))
+
+   ;; (encapsulate nil
+   ;;   (local (in-theory
+   ;;           (e/d (gl-cp-hint)
+   ;;                (shape-specs-to-interp-al
+   ;;                 shape-spec-listp pseudo-term-listp
+   ;;                 pseudo-termp pairlis$
+   ;;                 shape-spec-bindingsp
+   ;;                 dumb-negate-lit
+   ;;                 gtests-nonnil-correct
+   ;;                 no-duplicatesp-equal
+   ;;                 (bfr-to-param-space)
+   ;;                 gobj-alist-to-param-space
+   ;;                 list*-macro binary-append strip-cadrs strip-cars member-equal))))
+   ;;   (defthm glcp-generic-run-parametrized-correct
+   ;;     (b* (((mv erp (cons clauses out-obligs) &)
+   ;;           (glcp-generic-run-parametrized
+   ;;            hyp concl  vars bindings id obligs
+   ;;            config state)))
+   ;;       (implies (and (not (glcp-generic-geval-ev concl alist))
+   ;;                     (glcp-generic-geval-ev-theoremp
+   ;;                      (conjoin-clauses
+   ;;                       (acl2::interp-defs-alist-clauses out-obligs)))
+   ;;                     (not erp)
+   ;;                     (glcp-generic-geval-ev hyp alist)
+   ;;                     (acl2::interp-defs-alistp obligs)
+   ;;                     (acl2::interp-defs-alistp (glcp-config->overrides config))
+   ;;                     (pseudo-termp concl)
+   ;;                     (pseudo-termp hyp)
+   ;;                     (equal vars (collect-vars concl))
+   ;;                     (glcp-generic-geval-ev-meta-extract-global-facts :state state1)
+   ;;                     (equal (w state) (w state1)))
+   ;;                (not (glcp-generic-geval-ev-theoremp (conjoin-clauses clauses)))))
+   ;;     :hints (("goal" :do-not-induct
+   ;;              t
+   ;;              :in-theory
+   ;;              (e/d* ()
+   ;;                    (; glcp-generic-geval-alist-gobj-alist-to-param-space
+   ;;                     glcp-generic-geval-gtests-nonnil-correct
+   ;;                     glcp-generic-interp-bad-obligs-term
+   ;;                     ;; shape-spec-listp-impl-shape-spec-to-gobj-list
+   ;;                     (:rules-of-class :definition :here)
+   ;;                     (:rules-of-class :type-prescription :here))
+   ;;                    (gl-cp-hint acl2::clauses-result assoc-equal
+   ;;                                glcp-generic-run-parametrized not
+   ;;                                glcp-error
+   ;;                                acl2::fast-no-duplicatesp
+   ;;                                acl2::fast-no-duplicatesp-equal))
+   ;;              :restrict ((glcp-generic-geval-ev-disjoin-append ((a alist)))))
+   ;;             (and stable-under-simplificationp
+   ;;                  (acl2::bind-as-in-definition
+   ;;                   (glcp-generic-run-parametrized
+   ;;                    hyp concl  (collect-vars concl) bindings id obligs config state)
+   ;;                   (cov-clause val-clause hyp-bfr hyp-val)
+   ;;                   (b* ((binding-env
+   ;;                         '(let ((slice (glcp-generic-geval-ev
+   ;;                                        (shape-spec-env-term
+   ;;                                         (strip-cadrs bindings)
+   ;;                                         (list*-macro (append (strip-cars
+   ;;                                                               bindings) '('nil)))
+   ;;                                         nil)
+   ;;                                        alist)))
+   ;;                            (cons (slice-to-bdd-env (car slice) nil)
+   ;;                                  (cdr slice))))
+   ;;                        (param-env `(genv-param ,hyp-bfr ,binding-env)))
+   ;;                     `(:use
+   ;;                       ((:instance glcp-generic-geval-ev-falsify
+   ;;                                   (x (disjoin ,cov-clause))
+   ;;                                   (a alist))
+   ;;                        (:instance glcp-generic-geval-ev-falsify
+   ;;                                   (x (disjoin ,val-clause))
+   ;;                                   (a `((env . ,,param-env))))
+   ;;                        (:instance glcp-generic-geval-gtests-nonnil-correct
+   ;;                                   (x ,hyp-val)
+   ;;                                   (hyp t)
+   ;;                                   (env ,binding-env)))))))
+   ;;             (bfr-reasoning))))
 
    (defthm glcp-generic-run-parametrized-bad-obligs
-     (b* (((mv erp (cons & out-obligs) &)
+     (b* (((mv erp (list & & out-obligs) &)
            (glcp-generic-run-parametrized
-            hyp concl untrans-concl vars bindings id obligs config state)))
+            hyp concl  vars bindings id obligs config state)))
        (implies (and (not erp)
-                     (not (glcp-generic-ev-theoremp
+                     (not (glcp-generic-geval-ev-theoremp
                            (conjoin-clauses
                             (acl2::interp-defs-alist-clauses obligs)))))
-                (not (glcp-generic-ev-theoremp
+                (not (glcp-generic-geval-ev-theoremp
                       (conjoin-clauses
-                       (acl2::interp-defs-alist-clauses out-obligs)))))))
+                       (acl2::interp-defs-alist-clauses out-obligs))))))
+     :hints(("Goal" :in-theory (disable collect-vars pseudo-termp
+                                        dumb-negate-lit))))
 
    (defthm glcp-generic-run-parametrized-ok-obligs
-     (b* (((mv erp (cons & out-obligs) &)
+     (b* (((mv erp (list & & out-obligs) &)
            (glcp-generic-run-parametrized
-            hyp concl untrans-concl vars bindings id obligs config state)))
+            hyp concl  vars bindings id obligs config state)))
        (implies (and (not erp)
-                     (glcp-generic-ev-theoremp
+                     (glcp-generic-geval-ev-theoremp
                       (conjoin-clauses
                        (acl2::interp-defs-alist-clauses out-obligs))))
-                (glcp-generic-ev-theoremp
+                (glcp-generic-geval-ev-theoremp
                  (conjoin-clauses
                   (acl2::interp-defs-alist-clauses obligs))))))
 
    (defthm glcp-generic-run-parametrized-defs-alistp
-     (b* (((mv erp (cons & out-obligs) &)
+     (b* (((mv erp (list & & out-obligs) &)
            (glcp-generic-run-parametrized
-            hyp concl untrans-concl vars bindings id obligs config state)))
+            hyp concl  vars bindings id obligs config state)))
        (implies (and (acl2::interp-defs-alistp obligs)
                      (acl2::interp-defs-alistp (glcp-config->overrides config))
                      (pseudo-termp concl)
@@ -2443,38 +1602,29 @@
 
    (defthm glcp-generic-run-paremetrized-w-state
      (equal (w (mv-nth 2 (glcp-generic-run-parametrized
-                          hyp concl untrans-concl vars bindings id obligs config state)))
+                          hyp concl  vars bindings id obligs config state)))
             (w state)))))
 
 
 (in-theory (disable glcp-generic-run-parametrized))
 
-(defun glcp-cases-wormhole (term id)
-  (wormhole 'glcp-cases-wormhole
-            '(lambda (whs) whs)
-            nil
-            `(prog2$ (let ((id ',id))
-                       (declare (ignorable id))
-                       ,term)
-                     (value :q))
-            :ld-prompt nil
-            :ld-pre-eval-print nil
-            :ld-post-eval-print nil
-            :ld-verbose nil))
 
-(in-theory (disable glcp-cases-wormhole))
 
+(in-theory (disable glcp-cases-wormhole))
 
 
-(make-event
- (sublis *glcp-generic-template-subst* *glcp-run-cases-template*))
 
 (local
- (progn
+ (encapsulate nil
+   (local (in-theory (disable pseudo-termp
+                              ;; acl2::consp-by-len
+                              shape-spec-bindingsp
+                              nonnil-symbol-listp-pseudo-term-listp)))
+
    (defthm glcp-generic-run-cases-interp-defs-alistp
      (b* (((mv erp (cons & out-obligs) &)
            (glcp-generic-run-cases
-            param-alist concl untrans-concl vars obligs config state)))
+            param-alist concl  vars obligs config state)))
        (implies (and (acl2::interp-defs-alistp obligs)
                      (acl2::interp-defs-alistp (glcp-config->overrides config))
                      (pseudo-termp concl)
@@ -2484,19 +1634,19 @@
 
    (defthm glcp-generic-run-cases-ok-w-state
      (equal (w (mv-nth 2 (glcp-generic-run-cases
-                          param-alist concl untrans-concl vars obligs config
+                          param-alist concl  vars obligs config
                           state)))
             (w state)))
 
    (defthm glcp-generic-run-cases-correct
      (b* (((mv erp (cons clauses out-obligs) &)
            (glcp-generic-run-cases
-            param-alist concl untrans-concl vars obligs config state)))
-       (implies (and (glcp-generic-ev-theoremp
+            param-alist concl  vars obligs config state)))
+       (implies (and (glcp-generic-geval-ev-theoremp
                       (conjoin-clauses
                        (acl2::interp-defs-alist-clauses out-obligs)))
-                     (not (glcp-generic-ev concl a))
-                     (glcp-generic-ev (disjoin (strip-cars param-alist))
+                     (not (glcp-generic-geval-ev concl a))
+                     (glcp-generic-geval-ev (disjoin (strip-cars param-alist))
                                       a)
                      (not erp)
                      (acl2::interp-defs-alistp obligs)
@@ -2504,32 +1654,35 @@
                      (pseudo-termp concl)
                      (pseudo-term-listp (strip-cars param-alist))
                      (equal vars (collect-vars concl))
-                     (glcp-generic-ev-meta-extract-global-facts :state state1)
+                     (glcp-generic-geval-ev-meta-extract-global-facts :state state1)
                      (equal (w state) (w state1)))
-                (not (glcp-generic-ev-theoremp (conjoin-clauses clauses))))))
+                (not (glcp-generic-geval-ev-theoremp (conjoin-clauses
+                                                      clauses)))))
+     :hints(("Goal" :in-theory (enable strip-cars
+                                       glcp-generic-geval-ev-falsify-sufficient))))
 
 
    (defthm glcp-generic-run-cases-bad-obligs
      (b* (((mv erp (cons & out-obligs) &)
            (glcp-generic-run-cases
-            param-alist concl untrans-concl vars obligs config state)))
+            param-alist concl  vars obligs config state)))
        (implies (and (not erp)
-                     (not (glcp-generic-ev-theoremp
+                     (not (glcp-generic-geval-ev-theoremp
                            (conjoin-clauses
                             (acl2::interp-defs-alist-clauses obligs)))))
-                (not (glcp-generic-ev-theoremp
+                (not (glcp-generic-geval-ev-theoremp
                       (conjoin-clauses
                        (acl2::interp-defs-alist-clauses out-obligs)))))))
 
    (defthm glcp-generic-run-cases-ok-obligs
      (b* (((mv erp (cons & out-obligs) &)
            (glcp-generic-run-cases
-            param-alist concl untrans-concl vars obligs config state)))
+            param-alist concl  vars obligs config state)))
        (implies (and (not erp)
-                     (glcp-generic-ev-theoremp
+                     (glcp-generic-geval-ev-theoremp
                       (conjoin-clauses
                        (acl2::interp-defs-alist-clauses out-obligs))))
-                (glcp-generic-ev-theoremp
+                (glcp-generic-geval-ev-theoremp
                  (conjoin-clauses
                   (acl2::interp-defs-alist-clauses obligs))))))))
 
@@ -2541,73 +1694,15 @@
 
 
 
-(defun doubleton-list-to-alist (x)
-  (if (atom x)
-      nil
-    (cons (cons (caar x) (cadar x))
-          (doubleton-list-to-alist (cdr x)))))
 
-(defun bindings-to-vars-vals (x)
-  (if (atom x)
-      (mv nil nil)
-    (mv-let (vars vals)
-      (bindings-to-vars-vals (cdr x))
-      (if (and (symbolp (caar x))
-               (pseudo-termp (cadar x)))
-          (mv (cons (caar x) vars)
-              (cons (cadar x) vals))
-        (mv vars vals)))))
-
-(defun bindings-to-lambda (bindings term)
-  (mv-let (vars vals)
-    (bindings-to-vars-vals bindings)
-    `((lambda ,vars ,term) . ,vals)))
 
-(defthm bindings-to-vars-vals-wfp
-  (mv-let (vars vals)
-    (bindings-to-vars-vals x)
-    (and (symbol-listp vars)
-         (pseudo-term-listp vals)
-         (true-listp vals)
-         (equal (len vals) (len vars))
-         (not (stringp vars))
-         (not (stringp vals)))))
 
-(defthm bindings-to-lambda-pseudo-termp
-  (implies (pseudo-termp term)
-           (pseudo-termp (bindings-to-lambda bindings term)))
-  :hints(("Goal" :in-theory (enable true-listp length))))
-
-(in-theory (disable bindings-to-lambda))
-
-;; Transforms an alist with elements of the form
-;; (((param1 val1) (param2 val2)) shape-spec)
-;; to the form (parametrized-hyp . shape-spec).
-(defun param-bindings-to-alist (hyp bindings)
-  (if (atom bindings)
-      nil
-    (cons (list* (sublis-into-term
-                  hyp (doubleton-list-to-alist (caar bindings)))
-;;           (bindings-to-lambda (caar bindings) hyp)
-           (acl2::msg "case: ~x0" (caar bindings))
-           (cadar bindings))
-          (param-bindings-to-alist hyp (cdr bindings)))))
-(local
- (defthm param-bindings-to-alist-pseudo-term-listp-strip-cars
-   (implies (pseudo-termp hyp)
-            (pseudo-term-listp (strip-cars (param-bindings-to-alist hyp bindings))))))
-
-
-
-
-
-(make-event (sublis *glcp-generic-template-subst* *glcp-clause-proc-template*))
 
 (local
  (progn
    ;; What am I doing here?
-   (defund glcp-generic-run-parametrized-placeholder (clauses)
-     (glcp-generic-ev-theoremp (conjoin-clauses clauses)))
+   (defund glcp-generic-run-parametrized-placeholder (term)
+     (glcp-generic-geval-ev-theoremp term))
 
    (defun check-top-level-bind-free (bindings mfc state)
      (declare (ignore state)
@@ -2616,44 +1711,46 @@
           bindings))
 
    (defthmd glcp-generic-run-parametrized-correct-rw
-     (b* (((mv erp (cons clauses out-obligs) &)
+     (b* (((mv erp (list val-clause cov-clause out-obligs) &)
            (glcp-generic-run-parametrized
-            hyp concl untrans-concl vars bindings id obligs config st)))
+            hyp concl  vars bindings id obligs config st)))
        (implies (and (bind-free (check-top-level-bind-free
                                  '((alist . alist)) acl2::mfc state)
                                 (alist))
-                     (glcp-generic-ev-theoremp
+                     (glcp-generic-geval-ev-theoremp
                       (conjoin-clauses
                        (acl2::interp-defs-alist-clauses out-obligs)))
                      (not erp)
-                     (glcp-generic-ev hyp alist)
+                     (glcp-generic-geval-ev hyp alist)
                      (acl2::interp-defs-alistp obligs)
                      (acl2::interp-defs-alistp (glcp-config->overrides config))
                      (pseudo-termp concl)
                      (pseudo-termp hyp)
                      (equal vars (collect-vars concl))
-                     (glcp-generic-ev-meta-extract-global-facts :state state1)
-                     (equal (w st) (w state1)))
-                (iff (glcp-generic-ev-theoremp (conjoin-clauses clauses))
+                     (glcp-generic-geval-ev-meta-extract-global-facts :state state1)
+                     (equal (w st) (w state1))
+                     (glcp-generic-geval-ev-theoremp (disjoin cov-clause)))
+                (iff (glcp-generic-geval-ev-theoremp (disjoin val-clause))
                      (and (glcp-generic-run-parametrized-placeholder
-                           clauses)
-                          (glcp-generic-ev concl alist)))))
+                           (disjoin val-clause))
+                          (glcp-generic-geval-ev concl alist)))))
      :hints(("Goal" :in-theory (enable
-                                glcp-generic-run-parametrized-placeholder))))
+                                glcp-generic-run-parametrized-placeholder
+                                glcp-generic-geval-ev-falsify-sufficient))))
 
    (defund glcp-generic-run-cases-placeholder (clauses)
-     (glcp-generic-ev-theoremp (conjoin-clauses clauses)))
+     (glcp-generic-geval-ev-theoremp (conjoin-clauses clauses)))
 
    (defthmd glcp-generic-run-cases-correct-rw
      (b* (((mv erp (cons clauses out-obligs) &)
            (glcp-generic-run-cases
-            param-alist concl untrans-concl vars obligs config st)))
+            param-alist concl  vars obligs config st)))
        (implies (and (bind-free (check-top-level-bind-free
                                  '((alist . alist)) mfc state) (alist))
-                     (glcp-generic-ev-theoremp
+                     (glcp-generic-geval-ev-theoremp
                       (conjoin-clauses
                        (acl2::interp-defs-alist-clauses out-obligs)))
-                     (glcp-generic-ev (disjoin (strip-cars param-alist))
+                     (glcp-generic-geval-ev (disjoin (strip-cars param-alist))
                                       a)
                      (not erp)
                      (acl2::interp-defs-alistp obligs)
@@ -2661,11 +1758,11 @@
                      (pseudo-termp concl)
                      (pseudo-term-listp (strip-cars param-alist))
                      (equal vars (collect-vars concl))
-                     (glcp-generic-ev-meta-extract-global-facts :state state1)
+                     (glcp-generic-geval-ev-meta-extract-global-facts :state state1)
                      (equal (w st) (w state1)))
-                (iff (glcp-generic-ev-theoremp (conjoin-clauses clauses))
+                (iff (glcp-generic-geval-ev-theoremp (conjoin-clauses clauses))
                      (and (glcp-generic-run-cases-placeholder clauses)
-                          (glcp-generic-ev concl a)))))
+                          (glcp-generic-geval-ev concl a)))))
      :hints(("Goal" :in-theory (enable glcp-generic-run-cases-placeholder))))))
 
 (local
@@ -2677,16 +1774,16 @@
 (defthm glcp-generic-correct
   (implies (and (pseudo-term-listp clause)
                 (alistp alist)
-                (glcp-generic-ev-meta-extract-global-facts)
-                (glcp-generic-ev
+                (glcp-generic-geval-ev-meta-extract-global-facts)
+                (glcp-generic-geval-ev
                  (conjoin-clauses
                   (acl2::clauses-result
                    (glcp-generic clause hints state)))
-                 (glcp-generic-ev-falsify
+                 (glcp-generic-geval-ev-falsify
                   (conjoin-clauses
                    (acl2::clauses-result
                     (glcp-generic clause hints state))))))
-           (glcp-generic-ev (disjoin clause) alist))
+           (glcp-generic-geval-ev (disjoin clause) alist))
   :hints
   (("goal" :do-not-induct
     t
@@ -2694,10 +1791,16 @@
     (e/d* (glcp-generic-run-cases-correct-rw
            glcp-generic-run-parametrized-correct-rw)
           (glcp-analyze-interp-result-correct
-           glcp-generic-geval-alist-gobj-alist-to-param-space
-           glcp-generic-geval-gtests-nonnil-correct
+           ;; glcp-generic-geval-alist-gobj-alist-to-param-space
+           ;; glcp-generic-geval-gtests-nonnil-correct
            glcp-generic-run-cases-correct
            glcp-generic-run-parametrized-correct
+           pseudo-term-listp-cdr
+           pseudo-termp-car
+           ;; acl2::consp-under-iff-when-true-listp
+           glcp-generic-run-cases-bad-obligs
+           ;; acl2::consp-by-len
+           nfix
            ;; shape-spec-listp-impl-shape-spec-to-gobj-list
            (:rules-of-class :definition :here))
           (gl-cp-hint
@@ -2709,19 +1812,19 @@
            glcp-generic glcp-error
            assoc-equal pseudo-term-listp))
 
-    :restrict ((glcp-generic-ev-disjoin-append ((a alist)))
-               (glcp-generic-ev-disjoin-cons ((a alist)))))
+    :restrict ((glcp-generic-geval-ev-disjoin-append ((a alist)))
+               (glcp-generic-geval-ev-disjoin-cons ((a alist)))))
    (and stable-under-simplificationp
         (acl2::bind-as-in-definition
          glcp-generic
          (hyp-clause concl-clause params-cov-term hyp)
-         `(:use ((:instance glcp-generic-ev-falsify
+         `(:use ((:instance glcp-generic-geval-ev-falsify
                             (x (disjoin ,hyp-clause))
                             (a alist))
-                 (:instance glcp-generic-ev-falsify
+                 (:instance glcp-generic-geval-ev-falsify
                             (x (disjoin ,concl-clause))
                             (a alist))
-                 (:instance glcp-generic-ev-falsify
+                 (:instance glcp-generic-geval-ev-falsify
                   (x (disjoin (CONS
                                (CONS
                                 'NOT
@@ -2743,28 +1846,26 @@
 ;; produces all the other necessary clauses.  We define this by
 ;; using a mock interp-term function that just returns T and no
 ;; obligs, and also a mock analyze-term
-(defun glcp-fake-interp-term (x bindings hyp clk obligs config state)
-  (declare (ignore x bindings hyp clk config))
-  (mv nil obligs t state))
+(defun glcp-fake-interp-hyp/concl (hyp concl bindings clk config interp-st
+                                       next-bvar bvar-db bvar-db1 state)
+  (declare (ignore hyp concl bindings clk config next-bvar)
+           (xargs :stobjs (interp-st bvar-db bvar-db1 state)))
+  (mv t t bvar-db1 nil interp-st bvar-db state))
 
 (defun glcp-fake-analyze-interp-result
-  (val param-al hyp-bdd id concl config state)
-  (declare (ignore val param-al hyp-bdd id concl config)
-           (xargs :stobjs state))
+  (hyp-bfr val constr param-al id concl config bvar-db state)
+  (declare (ignore val param-al hyp-bfr id concl config bvar-db constr)
+           (xargs :stobjs (bvar-db state)))
   (mv nil '('t) state))
 
 (defconst *glcp-side-goals-subst*
-  `((interp-term . glcp-fake-interp-term)
+  '((interp-hyp/concl . glcp-fake-interp-hyp/concl)
     (run-cases . glcp-side-goals-run-cases)
     (run-parametrized . glcp-side-goals-run-parametrized)
     (clause-proc . glcp-side-goals-clause-proc1)
     (clause-proc-name . 'glcp-side-goals-clause-proc)
     (glcp-analyze-interp-result . glcp-fake-analyze-interp-result)))
 
-(make-event (sublis *glcp-side-goals-subst*
-                    *glcp-run-parametrized-template*))
-
-(make-event (sublis *glcp-side-goals-subst* *glcp-run-cases-template*))
 
 (make-event (sublis *glcp-side-goals-subst*
                     *glcp-clause-proc-template*))
@@ -2815,22 +1916,26 @@
 
 ;; Looks up a function in the gl-function-info table to see if it has
 ;; a symbolic counterpart, and executes it if so.
-(defun gl-universal-run-gified (fn actuals hyp clk state)
-  (declare (xargs :guard (and (symbolp fn)
-                              (natp clk))
-                  :mode :program))
-  (b* ((world (w state))
-       (al (table-alist 'gl-function-info world))
-       (look (assoc-eq fn al))
-       ((unless look) (mv nil nil))
-       (gfn (cadr look))
-       ((mv er res)
-        (acl2::magic-ev-fncall gfn (append actuals (list hyp clk))
-                               state t t))
-       ((when er)
-        (prog2$ (cw "GL-UNIVERSAL-RUN-GIFIED: error: ~@0~%" er)
-                (mv nil nil))))
-    (mv t res)))
+;; (defun gl-universal-run-gified (fn actuals pathcond clk config bvar-db state)
+;;   (declare (xargs :guard (and (symbolp fn)
+;;                               (glcp-config-p config)
+;;                               (natp clk))
+;;                   :stobjs (bvar-db state)
+;;                   :mode :program)
+;;            (ignorable config bvar-db))
+;;   (b* ((world (w state))
+;;        (al (table-alist 'gl-function-info world))
+;;        (look (assoc-eq fn al))
+;;        ((unless look) (mv nil nil))
+;;        (gfn (cadr look))
+;;        ((mv er res)
+;;         (acl2::magic-ev-fncall gfn (append actuals (list pathcond clk config
+;;                                                          bvar-db state))
+;;                                state t t))
+;;        ((when er)
+;;         (prog2$ (cw "GL-UNIVERSAL-RUN-GIFIED: error: ~@0~%" er)
+;;                 (mv nil nil))))
+;;     (mv t res)))
 
 ;; (defun gl-universal-apply-concrete (fn actuals state)
 ;;   (declare (xargs :guard (true-listp actuals)
@@ -2849,402 +1954,183 @@
 ;;                 (mv nil nil state))))
 ;;     (mv t val state)))
 
-(defconst *gl-universal-subst*
-  `((run-gified . gl-universal-run-gified)
-    (apply-concrete . gl-universal-apply-concrete)
-    (interp-term . gl-universal-interp-term)
-    (interp-list . gl-universal-interp-list)
-    (run-cases . gl-universal-run-cases)
-    (run-parametrized . gl-universal-run-parametrized)
-    (clause-proc . gl-universal-clause-proc)
-    (clause-proc-name . 'gl-universal-clause-proc)))
-
-(program)
+;; (defconst *gl-universal-subst*
+;;   '((run-gified . gl-universal-run-gified)
+;;     (interp-term . gl-universal-interp-term)
+;;     (interp-fncall-ifs . gl-universal-interp-fncall-ifs)
+;;     (interp-fncall . gl-universal-interp-fncall)
+;;     (interp-if . gl-universal-interp-if)
+;;     (finish-or . gl-universal-finish-or)
+;;     (finish-if . gl-universal-finish-if)
+;;     (simplify-if-test . gl-universal-simplify-if-test)
+;;     (rewrite . gl-universal-rewrite)
+;;     (rewrite-apply-rules . gl-universal-rewrite-apply-rules)
+;;     (rewrite-apply-rule . gl-universal-rewrite-apply-rule)
+;;     (relieve-hyps . gl-universal-relieve-hyps)
+;;     (relieve-hyp . gl-universal-relieve-hyp)
+;;     (interp-list . gl-universal-interp-list)
+;;     (interp-top-level-term . gl-universal-interp-top-level-term)
+;;     (interp-concl . gl-universal-interp-concl)
+;;     (interp-hyp/concl . gl-universal-interp-hyp/concl)
+;;     (run-parametrized . gl-universal-run-parametrized)
+;;     (run-cases . gl-universal-run-cases)
+;;     (clause-proc . gl-universal)
+;;     (clause-proc-name . (gl-universal-clause-proc-name))))
 
-(make-event (sublis *gl-universal-subst* *glcp-interp-template*))
+;; (program)
 
-(make-event (sublis *gl-universal-subst*
-                    *glcp-run-parametrized-template*))
+;; (make-event (sublis *gl-universal-subst* *glcp-interp-template*))
+;; (make-event (sublis *gl-universal-subst* *glcp-interp-wrappers-template*))
 
-(make-event (sublis *gl-universal-subst* *glcp-run-cases-template*))
+;; (make-event (sublis *gl-universal-subst*
+;;                     *glcp-run-parametrized-template*))
 
-(make-event (sublis *gl-universal-subst*
-                    *glcp-clause-proc-template*))
+;; (make-event (sublis *gl-universal-subst* *glcp-run-cases-template*))
 
-(logic)
+;; (make-event (sublis *gl-universal-subst*
+;;                     *glcp-clause-proc-template*))
 
+;; (logic)
 
-;; To install this as a clause processor, run the following.  Note
-;; that this creates a ttag.
-(defmacro allow-gl-universal-clause-processor ()
-  '(acl2::define-trusted-clause-processor
-    gl-universal-clause-proc
-    nil :ttag gl-universal-clause-proc))
 
+;; ;; To install this as a clause processor, run the following.  Note
+;; ;; that this creates a ttag.
+;; (defmacro allow-gl-universal-clause-processor ()
+;;   '(acl2::define-trusted-clause-processor
+;;     gl-universal-clause-proc
+;;     nil :ttag gl-universal-clause-proc))
 
 
 
 
 
-;; Symbolic interpreter for translated terms, based on the universal clause
-;; processor defined above.  X is the term, ALIST gives a
-;; list of bindings of variables to g-objects, hyp is a BDD.
 
-(defun gl-interp-term (x alist hyp clk state)
-  (declare (xargs :mode :program :stobjs state))
-  (b* ((world (w state))
-       ((er overrides)
-        (preferred-defs-to-overrides
-         (table-alist 'preferred-defs world) state))
-       ((mv er obligs ans state)
-        (gl-universal-interp-term
-         x alist hyp clk nil (make-glcp-config :overrides overrides) state))
-       ((when er) (mv er nil state))
-       (- (flush-hons-get-hash-table-link obligs)))
-    (value ans)))
+;; ;; Symbolic interpreter for translated terms, based on the universal clause
+;; ;; processor defined above.  X is the term, ALIST gives a
+;; ;; list of bindings of variables to g-objects, hyp is a BDD.
+
+;; (defun gl-interp-term (x alist pathcond clk bvar-db state)
+;;   (declare (xargs :mode :program :stobjs (bvar-db state)))
+;;   (b* ((world (w state))
+;;        ((mv erp overrides state)
+;;         (preferred-defs-to-overrides
+;;          (table-alist 'preferred-defs world) state))
+;;        ((when erp)
+;;         (mv erp nil bvar-db state))
+;;        ((mv er obligs ans bvar-db state)
+;;         (gl-universal-interp-term
+;;          x alist pathcond nil clk nil (make-glcp-config :overrides overrides) bvar-db state))
+;;        ((when er) (mv er nil bvar-db state))
+;;        (- (flush-hons-get-hash-table-link obligs)))
+;;     (mv nil ans bvar-db state)))
 
 
 
 
-;; Translate the given term, then run the interpreter.
-(defmacro gl-interp-raw (x &optional alist (hyp 't) (clk '100000))
-  `(acl2::er-let*
-    ((trans (acl2::translate ,x :stobjs-out t t 'gl-interp (w state)
-                             state)))
-    (gl-interp-term trans ,alist ,hyp ,clk state)))
+;; ;; Translate the given term, then run the interpreter.
+;; (defmacro gl-interp-raw (x &optional alist (hyp 't) (clk '100000))
+;;   `(b* (((mv er trans state)
+;;          (acl2::translate ,x t t t 'gl-interp (w state)
+;;                           state))
+;;         ((when er) (mv er nil bvar-db state)))
+;;      (gl-interp-term trans ,alist ,hyp ,clk state)))
 
 
 
-(defdoc gl-interp-raw
-  ":Doc-section ACL2::GL
-Symbolically interpret a term using GL.~/
-
-Usage:
-~bv[]
- (gl-interp-raw term bindings)
-~ev[]
-
-The above form runs a symbolic interpretation of ~c[term] on the symbolic input
-~c[bindings].  ~c[bindings] should be an association list mapping variables to
-symbolic objects (not to shape specifiers, as in ~il[gl-interp].)  Note also
-that bindings is a dotted alist, rather than a doubleton list as in
-~il[gl-interp]: each pair is ~c[(CONS VAR BINDING)], not ~c[(LIST VAR BINDING)].~/~/")
-
-
-(defun gl-parametrize-by-hyp-fn (hyp al state)
-  (declare (xargs :mode :program))
-  (b* ((al (shape-specs-to-interp-al al))
-       ((er hyp-pred) (gl-interp-raw hyp al))
-       (hyp-test (gtests hyp-pred t))
-       (hyp-bdd (bfr-or (gtests-nonnil hyp-test)
-                      (gtests-unknown hyp-test))))
-    (value (gobj-to-param-space al hyp-bdd))))
-
-(defmacro gl-parametrize-by-hyp (hyp bindings)
-  `(gl-parametrize-by-hyp-fn ,hyp ,bindings state))
-
-(defun gl-interp-fn (hyp term al state)
-  (declare (xargs :mode :program
-                  :stobjs state))
-  (b* (((er param-al) (gl-parametrize-by-hyp hyp al))
-;;        (al (shape-specs-to-interp-al al))
+;; (defun gl-parametrize-by-hyp-fn (hyp al bvar-db state)
+;;   (declare (xargs :mode :program))
+;;   (b* ((al (shape-specs-to-interp-al al))
 ;;        ((er hyp-pred) (gl-interp-raw hyp al))
 ;;        (hyp-test (gtests hyp-pred t))
-;;        (hyp-bdd (q-or (gtests-nonnil hyp-test)
-;;                       (gtests-unknown hyp-test)))
-;;        (param-al (gobj-to-param-space al hyp-bdd))
-       ((er res) (gl-interp-raw term param-al)))
-    (value (cons param-al res))))
-
-(defmacro gl-interp (term al &key (hyp 't))
-  `(gl-interp-fn ',hyp ',term ,al state))
-
-(defdoc gl-interp
-  ":Doc-section ACL2::GL
-Symbolically interpret a term using GL, with inputs generated by parametrization.~/
-
-Usage:
-~bv[]
- (gl-interp term bindings :hyp hyp)
-~ev[]
-
-The above form runs a symbolic interpretation of ~c[term] on the symbolic input
-assignment produced by parametrizing ~c[bindings] using ~c[hyp].  The symbolic
-execution run by this form is similar to that run by
-~bv[]
- (def-gl-thm <name> :hyp hyp :concl term :g-bindings bindings).
-~ev[]
-~c[bindings] should be a binding list of the same kind as taken by
-~il[def-gl-thm], that is, a list of elements ~c[(var val)] such that ~c[var]
-is a variable free in ~c[term], and ~c[val] is a shape specifier
-(~l[gl::shape-specs].)
-
-Similar to ~c[def-gl-thm], ~c[term] and ~c[hyp] should be the (unquoted)
-terms of interest, whereas ~c[bindings] should be something that evaluates to
-the binding list (the quotation of that binding list, for example.)~/
-
-In more detail: First, the input bindings are converted to an assignment of
-symbolic inputs to variables.  The hyp term is symbolically interpreted using
-this variable assignment, yielding a predicate.  The symbolic input assignment is
-parametrized using this predicate to produce a new such assignment whose
-coverage is restricted to the subset satisfying the hyp.  The term is then
-symbolically interpreted using this assignment, and the result is returned.
-
-This macro expands to a function call taking state, and its return value is an
-error triple.
+;;        (hyp-bfr (bfr-or (gtests-nonnil hyp-test)
+;;                       (gtests-unknown hyp-test))))
+;;     (value (gobj-to-param-space al hyp-bfr))))
 
-The symbolic interpreter used by ~c[gl-interp] is not one introduced by
-def-gl-clause-processor as usual, but a special one which can call any function
-on concrete values, and any symbolic counterpart function.  (Other interpreters
-can call a fixed list of functions on concrete values and a fixed list of
-symbolic counterparts.)  However, typically a fixed interpreter is used when
-proving theorems (otherwise a ttag is needed.)  This has some
-performance-related consequences:
-
- - ~c[gl-interp] may interpret a term faster than ~c[def-gl-thm].  This
-occurs mainly when some function is run concretely by the universal interpreter
-but is not in the fixed list of functions callable by the fixed interpreter.
-Determine which function is at fault by looking at a backtrace, and then define
-your interpreter so that it can call this function.
-
- - ~c[gl-interp] may interpret a term slower than ~c[def-gl-thm].  The
-universal interpreter uses somewhat more overhead on each function call than
-fixed interpreters do, so when interpreter overhead is a large portion of the
-runtime relative to BDD operations, ~c[gl-interp] may be a constant factor
-slower than a fixed interpreter.
-
-See ~il[gl-interp-raw] for a similar function that does not perform
-parametrization.~/")
+;; (defmacro gl-parametrize-by-hyp (hyp bindings)
+;;   `(gl-parametrize-by-hyp-fn ,hyp ,bindings state))
 
 
+(table latest-greatest-gl-clause-proc nil *glcp-generic-template-subst* :clear)
 
+(defun gl-interp-fn (hyp term al config state)
+  (declare (xargs :mode :program :stobjs state))
+  (b* ((gobj-al (shape-specs-to-interp-al al))
+       ((mv erp overrides state)
+        (preferred-defs-to-overrides
+         (table-alist 'preferred-defs (w state)) state))
+       ((when erp) (mv erp nil nil nil state))
+       ((mv erp hyp-trans state)
+        (acl2::translate hyp t t t 'gl-interp (w state)
+                         state))
+       ((when erp) (mv erp nil nil nil state))
+       ((mv erp term-trans state)
+        (acl2::translate term t t t 'gl-interp (w state)
+                         state))
+       ((when erp) (mv erp nil nil nil state))
+       (config (or config (make-glcp-config :overrides overrides)))
+       (interp-fn (cdr (assoc 'interp-term-under-hyp
+                              (table-alist 'latest-greatest-gl-clause-proc
+                                           (w state)))))
+       (next-bvar (shape-spec-max-bvar-list (strip-cadrs al)))
+       (form `(,interp-fn ',hyp-trans ',term-trans ',gobj-al ',next-bvar ',config
+                          interp-st bvar-db bvar-db1 state))
+       ((mv trans-eval-erp (cons ?stobjs-out
+                                 (list hyp-bfr param-al res-obj interp-erp
+                                       ;; and some stobj symbols
+                                       ))
+            state)
+        (acl2::trans-eval form 'gl-interp state t))
+       ((when trans-eval-erp) (mv trans-eval-erp nil nil nil state))
+       ((when interp-erp) (mv interp-erp nil nil nil state)))
+    (mv nil hyp-bfr param-al res-obj state)))
+
+
+(defmacro gl-interp (term al &key (hyp 't) (config 'nil))
+  `(gl-interp-fn ',hyp ',term ,al ',config state))
+
+(defxdoc gl-interp
+  :parents (reference)
+  :short "Symbolically interpret a term using GL, with inputs generated by
+parametrization."
 
-(defun find-counterexamples-fn (hyp concl al state)
-  (declare (xargs :mode :program
-                  :stobjs state))
-  (b* (((er (cons param-al concl-pred))
-        (gl-interp-fn hyp concl al state))
-       (concl-tests (gtests concl-pred t))
-       (neg-concl (bfr-and (bfr-not (gtests-nonnil concl-tests))
-                         (bfr-not (gtests-unknown concl-tests))))
-       (false-al (gobj-to-param-space param-al neg-concl)))
-    (value false-al)))
-
-(defmacro find-counterexamples (concl alist &key (hyp 't))
-  `(find-counterexamples-fn ,hyp ,concl ,alist state))
-
-
-
-
-
-
-(defun max-max-max-depth (x)
-  (if (atom x)
-      0
-    (max (acl2::max-max-depth (car x))
-         (max-max-max-depth (cdr x)))))
-
-(defund gobj-max-depth (x)
-  (if (atom x)
-      0
-    (pattern-match x
-      ((g-concrete &) 0)
-      ((g-boolean b) (max-depth b))
-      ((g-number n) (max-max-max-depth n))
-      ((g-ite if then else)
-       (max (gobj-max-depth if)
-            (max (gobj-max-depth then)
-                 (gobj-max-depth else))))
-      ((g-apply & args) (gobj-max-depth args))
-      ((g-var &) 0)
-      (& (max (gobj-max-depth (car x))
-              (gobj-max-depth (cdr x)))))))
-
-
-
-
-(defun n-random-assignments-fn (n bound obj pred evfn state)
-  (declare (xargs :stobjs state
-                  :mode :program))
-  (if (eq pred nil)
-      (er soft 'n-random-assignments-fn
-          "Unsatisfiable predicate for n-random-assignments~%")
-    (if (zp n)
-        (value nil)
-      (b* (((er rest) (n-random-assignments-fn
-                       (1- n) bound obj pred evfn state))
-           ((mv envn state) (acl2::random$ bound state))
-           (env (list (to-satisfying-assign (n2v envn) pred))))
-        (if evfn
-            (b* ((term `(,evfn ',obj ',env))
-                 ((er (cons & val))
-                  (acl2::simple-translate-and-eval
-                   term nil nil
-                   (acl2::msg "~
-GL evaluation with ~x0 in n-random-assignments-fn" evfn)
-                   'n-random-assignments-fn (w state) state t)))
-              (value (cons val rest)))
-          (value (cons (generic-geval obj env) rest)))))))
-
-(defmacro n-random-assignments (n obj &optional (pred 't) evfn)
-  `(n-random-assignments-fn
-    ,n 
-    (expt 2 (gobj-max-depth ,obj))
-    ,obj ,pred ,evfn state))
-
-
+  :long "<p>Usage:</p>
 
+@({
+ (gl-interp term bindings :hyp hyp)
+})
 
+<p>The above form runs a symbolic interpretation of @('term') on the symbolic input
+assignment produced by parametrizing @('bindings') using @('hyp').  The symbolic
+execution run by this form is similar to that run by</p>
 
-(defun possibly-true (res)
-  (let ((test (gl::gtests res t)))
-    (bfr-or (gl::gtests-nonnil test)
-          (gl::gtests-unknown test))))
-
-(defun known-true (res)
-  (let ((test (gl::gtests res t)))
-    (bfr-and (gl::gtests-nonnil test)
-           (bfr-not (gl::gtests-unknown test)))))
-
-
-(defun sim-g-thm-fn (hyp concl g-bindings ctrex-info nexamples erp state)
-  (declare (xargs :stobjs state :mode :program))
-  (b* ((al (shape-specs-to-interp-al g-bindings))
-       ((er hyp-pred) (gl-interp-raw hyp al))
-       (hyp-possible (possibly-true hyp-pred))
-       ((er hyp-possible)
-        (if hyp-possible
-            (value hyp-possible)
-          (er soft 'sim-g-thm-fn "Impossible hyp~%")))
-       (hyp-al (gobj-to-param-space al hyp-possible))
-       ((er concl-pred) (gl-interp-raw concl hyp-al))
-       (concl-definite (known-true concl-pred)))
-    (if (eq concl-definite t)
-        (value "OK")
-      (b* ((ctrex-bdd (bfr-not concl-definite))
-           ((er ctrex-info-res) (gl-interp-raw ctrex-info hyp-al))
-           ((er ctrexamples)
-            (n-random-assignments nexamples (cons hyp-al ctrex-info-res)
-                                  ctrex-bdd)))
-        (if erp
-            (er soft 'sim-g-thm-fn
-                "Counterexamples found: ~x0~%" ctrexamples)
-          (value ctrexamples))))))
-
-(defmacro sim-g-thm
-  (&key hyp concl g-bindings ctrex-term (nexamples '3) (erp 't))
-  `(sim-g-thm-fn ',hyp ',concl ,g-bindings ',ctrex-term ,nexamples ,erp state))
+@({
+ (def-gl-thm <name> :hyp hyp :concl term :g-bindings bindings).
+})
 
+<p>@('bindings') should be a binding list of the same kind as taken by @(see
+def-gl-thm), that is, a list of elements @('(var val)') such that @('var') is a
+variable free in @('term'), and @('val') is a shape specifier; see @(see
+shape-specs).</p>
+
+<p>Similar to @('def-gl-thm'), @('term') and @('hyp') should be the (unquoted)
+terms of interest, whereas @('bindings') should be something that evaluates to
+the binding list (the quotation of that binding list, for example.)</p>
 
+<p>In more detail: First, the input bindings are converted to an assignment of
+symbolic inputs to variables.  The hyp term is symbolically interpreted using
+this variable assignment, yielding a predicate.  The symbolic input assignment
+is parametrized using this predicate to produce a new such assignment whose
+coverage is restricted to the subset satisfying the hyp.  The term is then
+symbolically interpreted using this assignment, and the result is returned.</p>
 
-(defun param-al-to-interp-al (al)
-  (if (atom al)
-      nil
-    (if (consp (car al))
-        (cons (cons (caar al) (mk-g-concrete (cadar al)))
-              (param-al-to-interp-al (cdr al)))
-      (param-al-to-interp-al (cdr al)))))
+<p>This macro expands to a function call taking state and the bvar-db and
+bvar-db1 live stobjs. It returns:</p>
 
+@({
+ (mv error-message hyp-bfr param-al result bvar-db bvar-db1 state)
+})
+
+<p>The symbolic interpreter used by @('gl-interp') is the latest interpreter
+defined using def-gl-clause-processor (as recorded in the
+gl::latest-greatest-gl-clause-proc table).</p>")
 
-(defun sim-param-coverage (param-hyp param-bindings cov-al state)
-  (declare (xargs :stobjs state
-                  :mode :program))
-  (if (atom param-bindings)
-      (value nil)
-    (b* (((er rest) (sim-param-coverage
-                     param-hyp (cdr param-bindings) cov-al state))
-         (curr-al (append (param-al-to-interp-al (caar param-bindings))
-                          cov-al))
-         ((er res) (gl-interp-raw param-hyp curr-al))
-         (res-known (known-true res)))
-      (value (bfr-or rest res-known)))))
-
-
-(defun sim-param-coverage-ok (hyp param-hyp param-bindings cov-bindings
-                                  nexamples erp state)
-  (declare (xargs :stobjs state
-                  :mode :program))
-  (b* ((cov-al (shape-specs-to-interp-al cov-bindings))
-       ((er hyp-res) (gl-interp-raw hyp cov-al))
-       (hyp-possible (possibly-true hyp-res))
-       ((er param-cov) (sim-param-coverage
-                        param-hyp param-bindings cov-al state))
-       (uncov (bfr-and hyp-possible (bfr-not param-cov))))
-    (if uncov
-        (b* (((er examples)
-              (n-random-assignments nexamples cov-al uncov)))
-          (if erp
-              (er soft 'sim-param-coverage-ok
-                  "Coverage gap found. Examples: ~x0~%" examples)
-            (value examples)))
-      (value "OK"))))
-
-(defun gl-interp-on-alists (term alists state)
-  (declare (xargs :stobjs state :mode :program))
-  (if (atom alists)
-      (value nil)
-    (b* (((er rest) (gl-interp-on-alists term (cdr alists) state))
-         ((er (cons & first))
-                  (acl2::simple-translate-and-eval
-                   term (car alists) nil
-                   "gl-interp-on-alists"
-                   'gl-interp-on-alists (w state) state t))
-;;           (gl-interp term (car alists))
-          )
-      (value (cons (cons (car alists) first) rest)))))
-
-(defun sim-params (param-bindings param-hyp concl ctrex-info nexamples
-                                  run-after-cases state)
-  (declare (xargs :stobjs state
-                  :mode :program))
-  (if (atom param-bindings)
-      (value "OK")
-    (b* ((- (cw "Param bindings: ~x0~%" (caar param-bindings)))
-         (al (shape-specs-to-interp-al (cadar param-bindings)))
-         (al-with-params (append (param-al-to-interp-al (caar param-bindings)) al))
-         ((er hyp) (gl-interp-raw param-hyp al-with-params))
-         (hyp-possible (possibly-true hyp))
-         ((er &)
-          (if hyp-possible
-              (b* ((param-al (gobj-to-param-space al hyp-possible))
-                   ((er concl-pred) (gl-interp-raw concl param-al))
-                   (concl-known (known-true concl-pred)))
-                (if (eq concl-known t)
-                    (value "OK")
-                  (b* ((ctrex-bdd (bfr-not concl-known))
-                       ((er ctrex-alists)
-                        (n-random-assignments
-                         nexamples param-al ctrex-bdd))
-                       ((er ctrexamples)
-                        (gl-interp-on-alists ctrex-info ctrex-alists state)))
-                    (er soft 'sim-params
-                        "Counterexamples found at parameters ~x0: ~x1~%" 
-                        (caar param-bindings) ctrexamples))))
-            (prog2$ (cw "Note: Param hyp is impossible with settings ~x0~%"
-                        (caar param-bindings))
-                    (value "OK"))))
-         ((er &)
-          (acl2::simple-translate-and-eval
-           run-after-cases nil nil
-           (acl2::msg "~
-sim-params: ~x0~%" run-after-cases)
-           'sim-params (w state) state t)))
-      (sim-params (cdr param-bindings) param-hyp concl ctrex-info nexamples
-                  run-after-cases state))))
-
-
-(defun sim-param-thm-fn (hyp param-hyp concl cov-bindings param-bindings
-                          ctrex-info nexamples run-after-cases erp state)
-  (declare (xargs :stobjs state
-                  :mode :program))
-  (er-progn
-   (sim-param-coverage-ok hyp param-hyp param-bindings cov-bindings
-                          nexamples erp state)
-   (sim-params param-bindings param-hyp concl ctrex-info nexamples
-               run-after-cases state)))
-
-(defmacro sim-param-thm
-  (&key hyp param-hyp concl cov-bindings param-bindings ctrex-term
-        (nexamples '3) run-after-cases (erp 't))
-  `(sim-param-thm-fn ',hyp ',param-hyp ',concl ,cov-bindings ,param-bindings
-                     ',ctrex-term ,nexamples ',run-after-cases ,erp state))
diff -Nru acl2-6.2/books/centaur/gl/gl-generic-interp-defs.lisp acl2-6.3/books/centaur/gl/gl-generic-interp-defs.lisp
--- acl2-6.2/books/centaur/gl/gl-generic-interp-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-generic-interp-defs.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,1148 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "ite-merge")
+(include-book "gtests")
+(include-book "glcp-templates")
+(include-book "shape-spec-defs")
+(include-book "symbolic-arithmetic-fns")
+(include-book "param")
+(include-book "bfr-sat")
+(include-book "glcp-config")
+(include-book "gl-mbe")
+(include-book "split-args")
+(include-book "glcp-unify-defs")
+(include-book "centaur/misc/rewrite-rule" :dir :system)
+(include-book "centaur/misc/beta-reduce-full" :dir :system)
+(include-book "glcp-geval")
+(include-book "constraint-db-deps")
+
+(verify-termination acl2::evisc-tuple)
+(verify-guards acl2::evisc-tuple)
+
+(defun glcp-case-split-report (test then else)
+  (declare (xargs :guard t)
+           (ignore test then else))
+  nil)
+
+
+(defmacro glcp-if (test then else &key report)
+  `(b* ((hyp pathcond)
+        (gtests (gtests ,test hyp))
+        (then-hyp (hf (bfr-or (gtests-unknown gtests)
+                               (gtests-nonnil gtests))))
+        (else-hyp (hf (bfr-or (gtests-unknown gtests)
+                               (bfr-not (gtests-nonnil gtests)))))
+        (- (and then-hyp else-hyp ,report))
+        ((glcp-er then)
+         (if then-hyp
+             (let ((pathcond (bfr-and hyp then-hyp)))
+               (declare (ignorable pathcond))
+               ,then)
+           (glcp-value nil)))
+        ((glcp-er else)
+         (if else-hyp
+             (let ((pathcond (bfr-and hyp else-hyp)))
+               (declare (ignorable pathcond))
+               ,else)
+           (glcp-value nil)))
+        (merge (gobj-ite-merge (gtests-nonnil gtests) then else
+                               (bfr-and (bfr-not (gtests-unknown gtests))
+                                         hyp))))
+     (if (hf (gtests-unknown gtests))
+         (glcp-value
+          (mk-g-ite (mk-g-boolean (gtests-unknown gtests))
+                    (mk-g-ite (gtests-obj gtests) then else)
+                    merge))
+       (glcp-value merge))))
+
+
+(defmacro glcp-or (test else)
+  `(b* ((hyp pathcond)
+        (test ,test)
+        (gtests (gtests test hyp))
+        (else-hyp (hf (bfr-or (gtests-unknown gtests)
+                               (bfr-not (gtests-nonnil gtests)))))
+        ((glcp-er else)
+         (if else-hyp
+             (let ((pathcond (bfr-and hyp else-hyp)))
+               (declare (ignorable pathcond))
+               ,else)
+           (glcp-value nil)))
+        (merge (gobj-ite-merge (gtests-nonnil gtests) test else
+                               (bfr-and (bfr-not (gtests-unknown gtests))
+                                         hyp))))
+     (if (hf (gtests-unknown gtests))
+         (glcp-value
+          (mk-g-ite (mk-g-boolean (gtests-unknown gtests))
+                    (mk-g-ite (gtests-obj gtests) test else)
+                    merge))
+       (glcp-value merge))))
+
+
+
+
+(acl2::def-meta-extract glcp-generic-geval-ev glcp-generic-geval-ev-lst)
+
+(encapsulate
+  (((glcp-generic-run-gified * * * * * bvar-db state)
+    => (mv * *)
+    :formals (fn actuals hyp clk config bvar-db state)
+    :guard (and (symbolp fn)
+                (true-listp actuals)
+                (glcp-config-p config)
+                (natp clk)))
+   ;; ((glcp-generic-geval-ev * *) => *)
+   ;; ((glcp-generic-geval-ev-lst * *) => *)
+   ;; ((glcp-generic-geval * *) => *)
+   )
+
+  ;; (local (def-eval-g glcp-generic-geval
+  ;;          (if gl-cp-hint shape-spec-obj-in-range return-last use-by-hint equal
+  ;;              acl2::typespec-check implies iff not cons gl-aside gl-ignore gl-error)))
+
+  ;; (local (defun glcp-generic-geval (x env)
+  ;;          (generic-geval x env)))
+
+  (local (defun glcp-generic-run-gified (fn actuals hyp clk config bvar-db state)
+           (declare (xargs :stobjs (bvar-db state)
+                           :guard (and (symbolp fn)
+                                       (natp clk)))
+                    (ignorable fn actuals hyp clk config bvar-db state))
+           (mv nil nil)))
+
+  ;; (local (acl2::defevaluator-fast
+  ;;         glcp-generic-ev glcp-generic-ev-lst
+  ;;         ((if a b c)
+  ;;          (gl-cp-hint x)
+  ;;          (shape-spec-obj-in-range a b)
+  ;;          (return-last fn arg1 arg2)
+  ;;          (use-by-hint x)
+  ;;          (equal a b)
+  ;;          (acl2::typespec-check ts x)
+  ;;          (implies a b)
+  ;;          (iff a b)
+  ;;          (not x)
+  ;;          (cons a b)
+  ;;          (gl-aside x)
+  ;;          (gl-ignore x)
+  ;;          (gl-error x))
+  ;;         :namedp t))
+
+  (defthm glcp-generic-run-gified-correct
+    (implies (and (bfr-eval hyp (car env))
+                  ;; (gobj-listp actuals)
+                  (mv-nth 0 (glcp-generic-run-gified fn actuals hyp
+                                                     clk config bvar-db state)))
+             (equal (glcp-generic-geval
+                     (mv-nth 1 (glcp-generic-run-gified
+                                fn actuals hyp clk config bvar-db state))
+                     env)
+                    (glcp-generic-geval-ev
+                     (cons fn
+                           (acl2::kwote-lst
+                            (glcp-generic-geval-list actuals env))) nil))))
+
+  (defthm gobj-depends-on-of-glcp-generic-run-gified
+    (implies (not (gobj-list-depends-on k p actuals))
+             (not (gobj-depends-on k p (mv-nth 1 (glcp-generic-run-gified
+                                                  fn actuals hyp clk config bvar-db state))))))
+
+
+  ;; (defthm true-listp-glcp-generic-run-gified
+  ;;   (true-listp (glcp-generic-run-gified fn actuals hyp clk config bvar-db state)))
+
+  ;; (make-event
+  ;;  `(progn
+  ;;     . ,(acl2::defevaluator-fast-form/defthms-named
+  ;;         'glcp-generic-geval-ev 'glcp-generic-geval-ev-lst
+  ;;         '((if a b c)
+  ;;           (gl-cp-hint x)
+  ;;           (shape-spec-obj-in-range a b)
+  ;;           (return-last fn arg1 arg2)
+  ;;           (use-by-hint x)
+  ;;           (equal a b)
+  ;;           (acl2::typespec-check ts x)
+  ;;           (implies a b)
+  ;;           (iff a b)
+  ;;           (not x)
+  ;;           (cons a b)
+  ;;           (gl-aside x)
+  ;;           (gl-ignore x)
+  ;;           (gl-error x)))))
+
+  )
+
+(defun general-concrete-listp (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      (eq x nil)
+    (and (general-concretep (car x))
+         (general-concrete-listp (cdr x)))))
+
+(defun general-concrete-obj-list (x)
+  (declare (xargs :guard (general-concrete-listp x)))
+  (if (atom x)
+      nil
+    (cons (general-concrete-obj (car x))
+          (general-concrete-obj-list (cdr x)))))
+
+
+(mutual-recursion
+ (defun sublis-into-term (x alist)
+   (declare (xargs :guard t))
+   (cond ((null x) nil)
+         ((atom x)
+          (let ((look (hons-assoc-equal x alist)))
+            (if look (acl2::kwote (cdr look)) x)))
+         ((eq (car x) 'quote) x)
+         (t (cons (car x) (sublis-into-list (cdr x) alist)))))
+ (defun sublis-into-list (x alist)
+   (declare (xargs :guard t))
+   (if (atom x)
+       nil
+     (cons (sublis-into-term (car x) alist)
+           (sublis-into-list (cdr x) alist)))))
+
+
+
+(defund gl-aside-wormhole (term alist)
+  (declare (xargs :guard t))
+  (wormhole 'glcp-interp-gl-aside
+            '(lambda (whs) whs)
+            nil
+            `(prog2$ ,(sublis-into-term
+                       term alist)
+                     (value :q))
+            :ld-prompt nil
+            :ld-pre-eval-print nil
+            :ld-post-eval-print nil
+            :ld-verbose nil))
+
+(defthmd acl2-count-last-cdr-when-cadr-hack
+  (implies (< 1 (len x))
+           (< (acl2-count (car (last x)))
+              (+ 1 (acl2-count (cdr x)))))
+  :rule-classes (:rewrite :linear))
+
+
+
+(acl2::def-b*-binder
+ rewrite-rule
+ #!acl2
+ (cutil::da-patbind-fn 'rewrite-rule
+                       #!GL '(rune hyps lhs rhs equiv subclass heuristic-info)
+                       args forms rest-expr))
+;; Note: careful with this; variable names that are imported symbols yield
+;; names in the other package.  In particular, since we import single-letter
+;; variables from the ACL2 package, use multiletter variables.
+
+;; used for measure
+(defun pos-fix (x)
+  (if (posp x) x 1))
+
+
+(defund glcp-relieve-hyp-synp (hyp bindings state)
+  (declare (xargs :stobjs state
+                  :guard (and (consp hyp)
+                              (pseudo-termp hyp))))
+  (b* ((args (cdr hyp))
+       ((unless #!acl2 (and
+                        ;; check that synp is defined as expected
+                        (fn-check-def 'synp state '(vars form term) ''t)
+                        ;; check that all three args are quoted
+                        (equal (len args) 3)
+                        (quote-listp args)))
+        (mv (acl2::msg "Bad synp hyp: ~x0~%" hyp) nil nil))
+       (hyp-form (second (second args)))
+       ((unless (and (consp hyp-form) (eq (car hyp-form) 'syntaxp)))
+        (mv (acl2::msg "Bind-free isn't supported yet: ~x0~%" hyp) nil nil))
+       (form (second ;; unquote
+              (third args)))
+       ((unless (and (pseudo-termp form)
+                     (symbol-alistp bindings)))
+        (mv (acl2::msg "ill-formed syntaxp form: ~x0~%" form) nil nil))
+       ((mv err val) (acl2::magic-ev form bindings state t t))
+       ((when err)
+        (mv (acl2::msg "synp error: ~@0~%" (if (eq err t) "error" err)) nil nil)))
+    (mv nil val bindings)))
+
+
+(mutual-recursion
+ (defun gl-term-to-apply-obj (x alist)
+   (declare (xargs :guard (pseudo-termp x)
+                   :verify-guards nil))
+   (b* (((when (not x)) nil)
+        ((when (atom x)) (cdr (hons-assoc-equal x alist)))
+        ((when (eq (car x) 'quote)) (g-concrete-quote (cadr x)))
+        (args (gl-termlist-to-apply-obj-list (cdr x) alist))
+        (fn (car x))
+        ((when (consp fn))
+         (b* ((formals (cadr fn))
+              (body (caddr fn)))
+           (gl-term-to-apply-obj body (pairlis$ formals args))))
+        ((when (eq fn 'if))
+         (g-ite (first args) (second args) (third args)))
+        ((when (eq fn 'cons))
+         (gl-cons (first args) (second args))))
+     (g-apply fn args)))
+ (defun gl-termlist-to-apply-obj-list (x alist)
+   (declare (xargs :guard (pseudo-term-listp x)))
+   (if (atom x)
+       nil
+     (cons (gl-term-to-apply-obj (car x) alist)
+           (gl-termlist-to-apply-obj-list (cdr x) alist)))))
+
+(in-theory (disable gl-term-to-apply-obj
+                    gl-termlist-to-apply-obj-list))
+
+
+(flag::make-flag gl-term-to-apply-obj-flag gl-term-to-apply-obj)
+
+(defthm-gl-term-to-apply-obj-flag
+  (defthm true-listp-gl-termlist-to-apply-obj-list
+    (true-listp (gl-termlist-to-apply-obj-list x alist))
+    :hints ('(:expand ((gl-termlist-to-apply-obj-list x alist))))
+    :rule-classes :type-prescription
+    :flag gl-termlist-to-apply-obj-list)
+  :skip-others t)
+
+(verify-guards gl-term-to-apply-obj)
+
+;; NOTE.  This is provably equal to pseudo-term-listp, but we use it
+;; differently.  When an element is a symbol, it stands for an equivalence
+;; relation; otherwise, it is a context "fixing" term.
+(defun contextsp (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      (eq x nil)
+    (and (or (symbolp (car x))
+             (pseudo-termp (car x)))
+         (contextsp (cdr x)))))
+
+
+;; (defund-nx glcp-generic-eval-context-equivs (contexts x y a)
+;;   (b* (((when (atom contexts))
+;;         (equal (glcp-generic-geval-ev x a)
+;;                (glcp-generic-geval-ev y a)))
+;;        (ctx (car contexts))
+;;        (ctx-fn (if (symbolp ctx)
+;;                    ctx
+;;                  `(lambda (x y)
+;;                     (equal ,ctx
+;;                            ((lambda (x) ,ctx) y))))))
+;;     (or (glcp-generic-geval-ev (list ctx-fn x y) a)
+;;         (glcp-generic-eval-context-equivs (cdr contexts) x y a))))
+
+;; (defun-sk glcp-generic-equiv-under-contexts (contexts x y)
+;;   (forall (a)
+;;           (glcp-generic-eval-context-equivs contexts x y a))
+;;   :rewrite :direct)
+
+
+(defun-sk glcp-generic-equiv-relp (f)
+  (forall (a x y z)
+          (and (booleanp (glcp-generic-geval-ev (list f x y) a))
+               (glcp-generic-geval-ev (list f x x) a)
+               (implies (glcp-generic-geval-ev (list f x y) a)
+                        (glcp-generic-geval-ev (list f y x) a))
+               (implies (and (glcp-generic-geval-ev (list f x y) a)
+                             (glcp-generic-geval-ev (list f y z) a))
+                        (glcp-generic-geval-ev (list f x z) a))))
+  :rewrite :direct)
+
+(in-theory (disable glcp-generic-equiv-relp))
+
+(defun proper-contextsp (contexts)
+  (if (atom contexts)
+      t
+    (and (or (not (symbolp (car contexts)))
+             (glcp-generic-equiv-relp (car contexts)))
+         (proper-contextsp (cdr contexts)))))
+
+(defund-nx glcp-generic-eval-context-equiv (contexts x y)
+  (b* (((when (atom contexts)) (equal x y))
+       (ctx (car contexts))
+       (ctx-fn (if (symbolp ctx)
+                   ctx
+                 `(lambda (x y)
+                    (equal ((lambda (x) ,ctx) x)
+                           ((lambda (x) ,ctx) y))))))
+    (or (glcp-generic-geval-ev (list ctx-fn (kwote x) (kwote y)) nil)
+        (glcp-generic-eval-context-equiv (cdr contexts) x y))))
+
+
+(defthmd glcp-generic-eval-context-equiv-commute
+  (implies (and (proper-contextsp contexts)
+                (glcp-generic-eval-context-equiv contexts x y))
+           (glcp-generic-eval-context-equiv contexts y x))
+  :hints (("goal" :induct (glcp-generic-eval-context-equiv contexts x y)
+           :in-theory (enable glcp-generic-eval-context-equiv
+                              glcp-generic-geval-ev-of-fncall-args)
+           :expand ((glcp-generic-eval-context-equiv contexts y x)
+                    (proper-contextsp contexts)))))
+
+(defun glcp-generic-eval-context-equiv-chain (contexts chain)
+  (declare (xargs :hints(("Goal" :in-theory (enable acl2-count)))))
+  (if (atom (cdr chain))
+      t
+    (and (glcp-generic-eval-context-equiv contexts
+                                          (car chain)
+                                          (cadr chain))
+         (glcp-generic-eval-context-equiv-chain contexts (cdr chain)))))
+
+(defun-sk glcp-generic-eval-context-equiv* (contexts x y)
+  (exists chain
+          (and (consp chain)
+               (equal (car chain) x)
+               (equal (car (last chain)) y)
+               (glcp-generic-eval-context-equiv-chain contexts chain))))
+
+(in-theory (disable glcp-generic-eval-context-equiv*))
+
+(defthm glcp-generic-eval-context-equiv*-refl
+  (glcp-generic-eval-context-equiv* contexts x x)
+  :hints (("goal" :use ((:instance glcp-generic-eval-context-equiv*-suff
+                         (chain (list x)) (y x))))))
+
+
+
+(defthm glcp-generic-eval-context-equiv*-chain-append
+  (implies (and (glcp-generic-eval-context-equiv-chain contexts c1)
+                (glcp-generic-eval-context-equiv-chain contexts c2)
+                (equal (car (last c1)) (car c2)))
+           (glcp-generic-eval-context-equiv-chain contexts (append c1 (cdr
+                                                                       c2))))
+  :hints(("Goal" :in-theory (disable glcp-generic-eval-context-equiv-commute))))
+
+
+(encapsulate nil
+  (local (defthm last-of-append-when-first/last-equal
+           (implies (equal (car b) (car (last a)))
+                    (equal (car (last (append a (cdr b))))
+                           (car (last b))))))
+
+  (local (defthm car-append-when-consp
+           (implies (consp x)
+                    (equal (car (append x y))
+                           (car x)))))
+
+  (defthm glcp-generic-eval-context-equiv*-trans
+    (implies (and (glcp-generic-eval-context-equiv* contexts x y)
+                  (glcp-generic-eval-context-equiv* contexts y z))
+             (glcp-generic-eval-context-equiv* contexts x z))
+    :hints (("goal" :use ((:instance glcp-generic-eval-context-equiv*-suff
+                           (chain (append
+                                   (glcp-generic-eval-context-equiv*-witness
+                                    contexts x y)
+                                   (cdr (glcp-generic-eval-context-equiv*-witness
+                                         contexts y z))))
+                           (y z)))
+             :expand ((glcp-generic-eval-context-equiv* contexts x y)
+                      (glcp-generic-eval-context-equiv* contexts y z))))))
+
+
+(encapsulate nil
+
+  (local (defthm chain-of-append-when-last/first-related
+           (implies (and (consp x)
+                         (glcp-generic-eval-context-equiv contexts (car (last x))
+                                                          (car y))
+                         (glcp-generic-eval-context-equiv-chain contexts x)
+                         (glcp-generic-eval-context-equiv-chain contexts y))
+                    (glcp-generic-eval-context-equiv-chain contexts (append x
+                                                                            y)))))
+
+  (local (defthm last-of-append-when-consp-second
+           (implies (consp y)
+                    (equal (last (append x y))
+                           (last y)))))
+
+
+  (local (defthm car-last-of-rev
+           (implies (consp x)
+                    (equal (car (last (acl2::rev x)))
+                           (car x)))
+           :hints(("Goal" :in-theory (enable acl2::rev)))))
+
+  (defthmd glcp-generic-eval-context-equiv-chain-rev
+    (implies (and (proper-contextsp contexts)
+                  (glcp-generic-eval-context-equiv-chain contexts chain))
+             (glcp-generic-eval-context-equiv-chain contexts (acl2::rev chain)))
+    :hints(("Goal" :in-theory (e/d (acl2::rev) (proper-contextsp))
+            :induct (acl2::rev chain))
+           (and stable-under-simplificationp
+                '(:expand ((acl2::rev (cdr chain)))
+                  :in-theory (e/d (glcp-generic-eval-context-equiv-commute)
+                                  (acl2::associativity-of-append))))))
+
+  (local (in-theory (enable glcp-generic-eval-context-equiv-chain-rev)))
+
+  (local (defthm consp-rev
+           (equal (consp (acl2::rev x))
+                  (consp x))))
+
+  (local (defthm car-append-when-consp
+           (implies (consp x)
+                    (equal (car (append x y))
+                           (car x)))))
+
+
+  (local (defthm car-rev-when-consp
+           (implies (consp x)
+                    (equal (car (acl2::rev x))
+                           (car (last x))))
+           :hints(("Goal" :in-theory (enable acl2::rev)))))
+
+  (defthmd glcp-generic-eval-context-equiv*-commute
+    (implies (and (proper-contextsp contexts)
+                  (glcp-generic-eval-context-equiv* contexts x y))
+             (glcp-generic-eval-context-equiv* contexts y x))
+    :hints (("goal" :use ((:instance glcp-generic-eval-context-equiv*-suff
+                           (chain (acl2::rev
+                                   (glcp-generic-eval-context-equiv*-witness
+                                    contexts x y)))
+                           (x y) (y x)))
+             :in-theory (disable proper-contextsp)
+             :expand ((glcp-generic-eval-context-equiv* contexts x y))))))
+
+
+(defthm g-ite->test-acl2-count-decr
+  (implies (equal (tag x) :g-ite)
+           (< (acl2-count (g-ite->test x)) (acl2-count x)))
+  :hints(("Goal" :in-theory (enable tag g-ite->test)))
+  :rule-classes :linear)
+
+(defthm g-ite->then-acl2-count-decr
+  (implies (equal (tag x) :g-ite)
+           (< (acl2-count (g-ite->then x)) (acl2-count x)))
+  :hints(("Goal" :in-theory (enable tag g-ite->then)))
+  :rule-classes :linear)
+
+(defthm g-ite->else-acl2-count-decr
+  (implies (equal (tag x) :g-ite)
+           (< (acl2-count (g-ite->else x)) (acl2-count x)))
+  :hints(("Goal" :in-theory (enable tag g-ite->else)))
+  :rule-classes :linear)
+
+
+
+(in-theory (disable glcp-generic-equiv-relp))
+
+(defsection ensure-equiv-relationp
+
+  (acl2::def-unify glcp-generic-geval-ev glcp-generic-geval-ev-alist)
+  (acl2::def-meta-extract glcp-generic-geval-ev glcp-generic-geval-ev-lst)
+
+  (defund search-match-in-conjunction (pat term)
+    (declare (xargs :guard (and (pseudo-termp pat)
+                                (pseudo-termp term))))
+    (b* (((mv ok &) (acl2::simple-one-way-unify term pat nil))
+         ((when ok) t)
+         ((when (atom term)) nil)
+         ((unless (and (eq (car term) 'if)
+                       (equal (fourth term) ''nil)))
+          nil))
+      (or (search-match-in-conjunction pat (second term))
+          (search-match-in-conjunction pat (third term)))))
+
+  (defthmd glcp-generic-geval-ev-theoremp-of-conjunction
+    (implies (and (equal (car term) 'if)
+                  (equal (fourth term) ''nil))
+             (iff (glcp-generic-geval-ev-theoremp term)
+                  (and (glcp-generic-geval-ev-theoremp (second term))
+                       (glcp-generic-geval-ev-theoremp (third term)))))
+    :hints (("goal" :use ((:instance glcp-generic-geval-ev-falsify
+                           (x term) (a (glcp-generic-geval-ev-falsify (second term))))
+                          (:instance glcp-generic-geval-ev-falsify
+                           (x term) (a (glcp-generic-geval-ev-falsify (third term))))
+                          (:instance glcp-generic-geval-ev-falsify
+                           (x (second term))
+                           (a (glcp-generic-geval-ev-falsify term)))
+                          (:instance glcp-generic-geval-ev-falsify
+                           (x (third term))
+                           (a (glcp-generic-geval-ev-falsify term))))
+             :in-theory (disable pseudo-termp pseudo-term-listp))))
+
+  (local (in-theory (enable glcp-generic-geval-ev-theoremp-of-conjunction)))
+
+  (defthmd search-match-in-conjunction-correct
+    (implies (and (glcp-generic-geval-ev-theoremp term)
+                  (pseudo-termp term)
+                  (pseudo-termp pat)
+                  (search-match-in-conjunction pat term))
+             (glcp-generic-geval-ev pat a))
+    :hints(("Goal" :in-theory (e/d (search-match-in-conjunction)
+                                   (glcp-generic-geval-ev-alist
+                                    symbol-listp
+                                    nonnil-symbol-listp))
+            :induct (search-match-in-conjunction pat term))
+           (and stable-under-simplificationp
+                '(:use ((:instance glcp-generic-geval-ev-falsify
+                         (x term)
+                         (a (glcp-generic-geval-ev-alist
+                             (mv-nth 1 (acl2::simple-one-way-unify term pat nil))
+                             a))))))))
+
+  (defund check-equiv-formula (form e)
+    (declare (xargs :guard (and (pseudo-termp form)
+                                (symbolp e)
+                                (not (eq e 'quote)))))
+    (and (search-match-in-conjunction `(booleanp (,e x y)) form)
+         (search-match-in-conjunction `(,e x x) form)
+         (search-match-in-conjunction `(implies (,e x y) (,e y x)) form)
+         (search-match-in-conjunction `(implies (if (,e x y)
+                                                    (,e y z)
+                                                  'nil)
+                                                (,e x z))
+                                      form)))
+
+  (local (defthm lemma1
+           (implies (and (pseudo-termp form)
+                         (glcp-generic-geval-ev-theoremp form)
+                         (search-match-in-conjunction `(booleanp (,e x y)) form)
+                         (symbolp e)
+                         (not (equal e 'quote)))
+                    (booleanp (glcp-generic-geval-ev (list e x y) a)))
+           :hints (("goal" :in-theory (e/d (check-equiv-formula
+                                            glcp-generic-geval-ev-of-fncall-args)
+                                           (search-match-in-conjunction-correct))
+                    :use ((:instance search-match-in-conjunction-correct
+                           (term form) (pat `(booleanp (,e x y)))
+                           (a `((x . ,(glcp-generic-geval-ev x a))
+                                (y . ,(glcp-generic-geval-ev y a))
+                                (z . ,(glcp-generic-geval-ev z a))))))))))
+
+  (local (defthm lemma2
+           (implies (and (pseudo-termp form)
+                         (glcp-generic-geval-ev-theoremp form)
+                         (search-match-in-conjunction `(,e x x) form)
+                         (symbolp e)
+                         (not (equal e 'quote)))
+                    (glcp-generic-geval-ev (list e x x) a))
+           :hints (("goal" :in-theory (e/d (check-equiv-formula
+                                            glcp-generic-geval-ev-of-fncall-args)
+                                           (search-match-in-conjunction-correct))
+                    :use ((:instance search-match-in-conjunction-correct
+                           (term form) (pat `(,e x x))
+                           (a `((x . ,(glcp-generic-geval-ev x a))
+                                (y . ,(glcp-generic-geval-ev y a))
+                                (z . ,(glcp-generic-geval-ev z a))))))))))
+
+  (local (defthm lemma3
+           (implies (and (pseudo-termp form)
+                         (glcp-generic-geval-ev-theoremp form)
+                         (search-match-in-conjunction
+                          `(implies (,e x y) (,e y x)) form)
+                         (symbolp e)
+                         (not (equal e 'quote))
+                         (glcp-generic-geval-ev (list e x y) a))
+                    (glcp-generic-geval-ev (list e y x) a))
+           :hints (("goal" :in-theory (e/d (check-equiv-formula
+                                            glcp-generic-geval-ev-of-fncall-args)
+                                           (search-match-in-conjunction-correct))
+                    :use ((:instance search-match-in-conjunction-correct
+                           (term form) (pat `(implies (,e x y) (,e y x)))
+                           (a `((x . ,(glcp-generic-geval-ev x a))
+                                (y . ,(glcp-generic-geval-ev y a))
+                                (z . ,(glcp-generic-geval-ev z a))))))))))
+
+  (local (defthm lemma4
+           (implies (and (pseudo-termp form)
+                         (glcp-generic-geval-ev-theoremp form)
+                         (search-match-in-conjunction
+                          `(implies (if (,e x y) (,e y z) 'nil) (,e x z)) form)
+                         (symbolp e)
+                         (not (equal e 'quote))
+                         (glcp-generic-geval-ev (list e x y) a)
+                         (glcp-generic-geval-ev (list e y z) a))
+                    (glcp-generic-geval-ev (list e x z) a))
+           :hints (("goal" :in-theory (e/d (check-equiv-formula
+                                            glcp-generic-geval-ev-of-fncall-args)
+                                           (search-match-in-conjunction-correct))
+                    :use ((:instance search-match-in-conjunction-correct
+                           (term form) (pat `(implies (if (,e x y) (,e y z) 'nil) (,e x z)))
+                           (a `((x . ,(glcp-generic-geval-ev x a))
+                                (y . ,(glcp-generic-geval-ev y a))
+                                (z . ,(glcp-generic-geval-ev z a))))))))))
+
+  (defthmd check-equiv-formula-correct
+    (implies (and (check-equiv-formula form e)
+                  (glcp-generic-geval-ev-theoremp form)
+                  (pseudo-termp form)
+                  (symbolp e)
+                  (not (eq e 'quote)))
+             (glcp-generic-equiv-relp e))
+    :hints(("Goal" :in-theory '(check-equiv-formula
+                                glcp-generic-equiv-relp
+                                lemma1 lemma2 lemma3 lemma4))))
+
+  (local (in-theory (enable check-equiv-formula-correct)))
+
+  (local (in-theory (disable w)))
+
+  (defund check-equiv-rule (rune e w)
+    (declare (xargs :guard (and (symbolp e)
+                                (not (eq e 'quote))
+                                (plist-worldp w))))
+    (b* ((rule (if (symbolp rune)
+                   rune
+                 (and (symbol-listp rune)
+                      (cadr rune))))
+         ((unless rule) nil)
+         (form (acl2::meta-extract-formula-w rule w))
+         ((unless (pseudo-termp form)) nil))
+      (check-equiv-formula form e)))
+
+  (defthmd check-equiv-rule-correct
+    (implies (and (check-equiv-rule rune e w)
+                  (glcp-generic-geval-ev-meta-extract-global-facts)
+                  (equal w (w state))
+                  (symbolp e) (not (eq e 'quote)))
+             (glcp-generic-equiv-relp e))
+    :hints(("Goal" :in-theory (e/d (check-equiv-rule)
+                                   (pseudo-termp)))))
+
+  (local (in-theory (enable check-equiv-rule-correct)))
+
+
+  (defund congruences-find-equiv-rule (congs e w)
+    (declare (xargs :guard (and (symbolp e)
+                                (not (eq e 'quote))
+                                (plist-worldp w))))
+    (b* (((when (atom congs)) nil)
+         (cong (car congs))
+         ((unless (and (acl2::weak-congruence-rule-p cong)
+                       (eq (acl2::access acl2::congruence-rule
+                                         cong :equiv)
+                           e)))
+          (congruences-find-equiv-rule (cdr congs) e w))
+         (rune (acl2::access acl2::congruence-rule cong :rune)))
+      (or (check-equiv-rule rune e w)
+          (congruences-find-equiv-rule (cdr congs) e w))))
+
+  (defthmd congruences-find-equiv-rule-correct
+    (implies (and (congruences-find-equiv-rule congs e w)
+                  (glcp-generic-geval-ev-meta-extract-global-facts)
+                  (equal w (w state))
+                  (symbolp e) (not (eq e 'quote)))
+             (glcp-generic-equiv-relp e))
+    :hints(("Goal" :in-theory (e/d (congruences-find-equiv-rule)
+                                   (pseudo-termp
+                                    acl2::weak-congruence-rule-p
+                                    default-car)))))
+
+  (local (in-theory (enable congruences-find-equiv-rule-correct)))
+
+  (defund ensure-equiv-relationp (e w)
+    (declare (xargs :guard (and (symbolp e)
+                                (plist-worldp w))))
+    (b* (((when (member-eq e '(equal iff))) t)
+         ((when (eq e 'quote)) nil)
+         (coarsenings (getprop e 'acl2::coarsenings nil 'current-acl2-world w))
+         ((unless coarsenings) nil)
+         ;; shortcut: ACL2 always stores e as a coarsening of itself if it's an
+         ;; equivalence relation.  In fact, it should only have coarsenings if it
+         ;; is one.  But we don't get to assume that in meta-extract so we look
+         ;; for a theorem stating it.
+         (congruences (getprop e 'acl2::congruences nil 'current-acl2-world w))
+         (equal-congs (cdr (hons-assoc-equal 'equal congruences)))
+         (first-arg-congs (and (consp equal-congs) (car equal-congs))))
+      (congruences-find-equiv-rule first-arg-congs e w)))
+
+  (defthmd ensure-equiv-relationp-correct
+    (implies (and (ensure-equiv-relationp e w)
+                  (glcp-generic-geval-ev-meta-extract-global-facts)
+                  (equal w (w state))
+                  (symbolp e))
+             (glcp-generic-equiv-relp e))
+    :hints(("Goal" :in-theory (e/d (ensure-equiv-relationp)
+                                   (pseudo-termp
+                                    acl2::weak-congruence-rule-p
+                                    default-car))
+            :expand ((glcp-generic-equiv-relp 'iff)
+                     (glcp-generic-equiv-relp 'equal))))))
+
+
+;; X is a gobj. Returns OK, repl, negp.
+;; OK implies that equiv-term <=> (xor negp (equiv x repl)) of x, where equiv
+;; is an equivalence ok under the contexts.
+(defund check-equiv-replacement (x equiv-term contexts state)
+  (declare (xargs :guard (contextsp contexts)
+                  :stobjs state)
+           (ignorable state))
+  ;; BOZO fix these to work with context fixing terms, refinements, etc
+  (b* (((when (hqual x equiv-term))
+        (mv t nil t))
+       ((unless (and (consp equiv-term)
+              (eq (tag equiv-term) :g-apply)))
+        (mv nil nil nil))
+       (equiv (g-apply->fn equiv-term))
+       ((unless (and (symbolp equiv)
+                     (not (eq equiv 'quote))
+                     (or (eq equiv 'equal)
+                         (member-eq equiv contexts))))
+        (mv nil nil nil))
+       (args (g-apply->args equiv-term))
+       ((unless (equal (len args) 2))
+        (mv nil nil nil))
+       ((when (hqual (car args) x))
+        (mv t (cadr args) nil))
+       ((when (hqual (cadr args) x))
+        (mv t (car args) nil)))
+    (mv nil nil nil)))
+
+
+;; (defund check-equiv-replacement-ok (x equiv-term contexts state)
+;;   (declare (xargs :guard (contextsp contexts)
+;;                   :stobjs state)
+;;            (ignorable state))
+;;   ;; BOZO fix these to work with context fixing terms, refinements, etc
+;;   (b* (((unless (and (consp equiv-term)
+;;                      (eq (tag equiv-term) :g-apply)))
+;;         nil)
+;;        (equiv (g-apply->fn equiv-term))
+;;        ((unless (and (symbolp equiv)
+;;                      (not (eq equiv 'quote))
+;;                      (or (eq equiv 'equal)
+;;                          (member-eq equiv contexts))))
+;;         nil)
+;;        (args (g-apply->args equiv-term))
+;;        ((unless (equal (len args) 2))
+;;         nil)
+;;        ((when (or (hqual (car args) x)
+;;                   (hqual (cadr args) x)))
+;;         t))
+;;     nil))
+
+;; (trace$ (check-equiv-replacement :cond (check-equiv-replacement-ok x equiv-term
+;;                                                                    contexts
+;;                                                                    state)
+;;                                  :entry (list 'check-equiv)
+;;                                  :exit (list 'check-equiv x (cadr values))
+;;                                  :evisc-tuple '(nil 5 10 nil)
+;;                                  :hide nil))
+
+
+(defund try-equivalences (x bvars pathcond contexts p bvar-db state)
+  (declare (xargs :guard (and (contextsp contexts)
+                              (non-exec (ec-call (bvar-listp bvars bvar-db))))
+                  :stobjs (bvar-db state)))
+  (b* (((when (atom bvars)) (mv nil nil))
+       (bvar (car bvars))
+       (equiv-term (get-bvar->term bvar bvar-db))
+       ((mv check-ok repl negp)
+        (check-equiv-replacement x equiv-term contexts state))
+       ((unless check-ok)
+        (try-equivalences x (cdr bvars) pathcond contexts p bvar-db state))
+       ((when negp)
+        (if (false-under-hyp
+             (hyp-fix (bfr-to-param-space p (bfr-var bvar))
+                      pathcond)
+             pathcond)
+            (mv t repl)
+          (try-equivalences x (cdr bvars) pathcond contexts p bvar-db state)))
+       ((unless (true-under-hyp
+                 (hyp-fix (bfr-to-param-space p (bfr-var bvar))
+                          pathcond)
+                 pathcond))
+        (try-equivalences x (cdr bvars) pathcond contexts p bvar-db state)))
+    (mv t repl)))
+
+
+
+(defund try-equivalences-loop (x pathcond contexts clk p bvar-db state)
+  (declare (xargs :guard (and (natp clk)
+                              (contextsp contexts))
+                  :stobjs (bvar-db state)
+                  :measure (nfix clk)))
+  (b* (((when (zp clk)) (mv "try-equivalences ran out of clock -- equiv loop?"
+                            x))
+       (equivs (get-term->equivs x bvar-db))
+       ((mv ok repl) (try-equivalences x equivs pathcond contexts p bvar-db
+                                       state))
+       ((when ok)
+        (try-equivalences-loop repl pathcond contexts (1- clk) p bvar-db
+                               state)))
+    (mv nil x)))
+
+
+(defund maybe-add-equiv-term (test-obj bvar bvar-db state)
+  (declare (xargs :stobjs (bvar-db state)
+                  :guard (and (integerp bvar)
+                              (<= (base-bvar bvar-db) bvar)
+                              (< bvar (next-bvar bvar-db))))
+           (ignorable state))
+  (b* (;; (equivp (getprop fn 'acl2::coarsenings nil 'current-acl2-world (w state)))
+       ;; ((unless equivp)
+       ;;  ;; not an equivalence relation
+       ;;  bvar-db)
+       ((unless (consp test-obj))
+        bvar-db)
+
+       ((when (eq (tag test-obj) :g-var))
+        (add-term-equiv test-obj bvar bvar-db))
+
+       ((unless (eq (tag test-obj) :g-apply))
+        bvar-db)
+
+       (fn (g-apply->fn test-obj))
+       (args (g-apply->args test-obj))
+
+       ((unless (and (eq fn 'equal)
+                     (equal (len args) 2)))
+        (add-term-equiv test-obj bvar bvar-db))
+       ((list a b) args)
+       ;; The rest is just a heuristic determination of which should rewrite to
+       ;; the other.
+       (a-goodp (or (atom a)
+                    (member (tag a) '(:g-number :g-boolean))
+                    (general-concretep a)))
+       ((when a-goodp)
+        (add-term-equiv b bvar bvar-db))
+       (b-goodp (or (atom b)
+                    (member (tag b) '(:g-number :g-boolean))
+                    (general-concretep b)))
+       ((when b-goodp)
+        (add-term-equiv a bvar bvar-db)))
+    bvar-db))
+
+;; (defund glcp-generic-geval-ev-theoremsp (rules)
+;;   (if (atom rules)
+;;       t
+;;     (and (glcp-generic-geval-ev-theoremp (car rules))
+;;          (glcp-generic-geval-ev-theoremsp (cdr rules)))))
+
+
+
+;; (defund meta-extract-formulas (names wrld)
+;;   (declare (xargs :guard (plist-worldp wrld)))
+;;   (b* (((when (atom names)) nil)
+;;        (name (car names))
+;;        ((unless (symbolp name)) (meta-extract-formulas (cdr names) wrld))
+;;        (thm (acl2::meta-extract-formula-w name wrld)))
+;;     (cons thm (meta-extract-formulas (cdr names) wrld))))
+
+;; (defthm glcp-generic-geval-ev-theoremsp-of-meta-extract-formulas
+;;   (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+;;                 (equal wrld (w state)))
+;;            (glcp-generic-geval-ev-theoremsp (meta-extract-formulas names wrld)))
+;;   :hints(("Goal" :in-theory (e/d (glcp-generic-geval-ev-theoremsp
+;;                                   meta-extract-formulas)
+;;                                  (w)))))
+
+(defund conjunction-to-list (x)
+  (declare (xargs :guard (pseudo-termp x)))
+  (if (or (atom x)
+          (not (eq (car x) 'if))
+          (not (equal (fourth x) ''nil)))
+      (list x)
+    (cons (second x)
+          (conjunction-to-list (third x)))))
+
+(defthm conjunction-to-list-pseudo-term-listp
+  (implies (pseudo-termp x)
+           (pseudo-term-listp (conjunction-to-list x)))
+  :hints(("Goal" :in-theory (enable conjunction-to-list))))
+
+
+(defsection glcp-branch-merge-formula-to-rule
+
+  (local (defthm pseudo-termp-subterms
+           (implies (and (pseudo-termp x)
+                         (consp x)
+                         (not (eq (car x) 'quote)))
+                    (and (pseudo-termp (cadr x))
+                         (pseudo-termp (caddr x))
+                         (pseudo-termp (cadddr x))
+                         (implies (cdr x)
+                                  (consp (cdr x)))
+                         (implies (cddr x)
+                                  (consp (cddr x)))
+                         (implies (cdddr x)
+                                  (consp (cdddr x)))))
+           :hints(("Goal" :expand ((pseudo-termp x)
+                                   (pseudo-term-listp (cdr x))
+                                   (pseudo-term-listp (cddr x))
+                                   (pseudo-term-listp (cdddr x)))))))
+
+  (local (in-theory (disable acl2::beta-reduce-full
+                             pseudo-termp)))
+
+
+  (defund glcp-branch-merge-formula-to-rule (name wrld)
+    (declare (xargs :guard (and (symbolp name) (plist-worldp wrld))
+                    :guard-hints
+                    (("goal" :use ((:instance
+                                    acl2::pseudo-termp-of-beta-reduce-full
+                                    (x (acl2::meta-extract-formula-w name wrld))))
+                      :in-theory (disable acl2::pseudo-termp-of-beta-reduce-full)))))
+    (b* ((thm (acl2::meta-extract-formula-w name wrld))
+         ((unless (pseudo-termp thm)) (mv nil nil))
+         (thm (acl2::beta-reduce-full thm))
+         ((when (atom thm)) (mv nil nil))
+         ((mv hyps concl)
+          (if (eq (car thm) 'implies)
+              (mv (conjunction-to-list (second thm))
+                  (third thm))
+            (mv nil thm)))
+         ((when (atom concl)) (mv nil nil))
+         (equiv (car concl))
+         ((unless (and (symbolp equiv)
+                       (not (eq equiv 'quote))
+                       (getprop equiv 'acl2::coarsenings nil 'current-acl2-world wrld)
+                       (eql (len concl) 3)))
+          (mv nil nil)))
+      (mv t (acl2::make-rewrite-rule
+             :rune `(:gl-branch-merge ,name)
+             :nume -1
+             :hyps hyps
+             :equiv equiv
+             :lhs (second concl)
+             :rhs (third concl)
+             :subclass 'acl2::backchain)))))
+
+(defund glcp-branch-merge-formulas-to-rules (names wrld)
+  (declare (xargs :guard (plist-worldp wrld)))
+  (b* (((when (atom names)) nil)
+       ((unless (symbolp (car names)))
+        (glcp-branch-merge-formulas-to-rules (cdr names) wrld))
+       ((mv ok rule) (glcp-branch-merge-formula-to-rule (car names) wrld)))
+    (if ok
+        (cons rule (glcp-branch-merge-formulas-to-rules (cdr names) wrld))
+      (glcp-branch-merge-formulas-to-rules (cdr names) wrld))))
+
+
+(defund glcp-get-branch-merge-rules (fn wrld)
+  (declare (xargs :guard (and (symbolp fn)
+                              (plist-worldp wrld))))
+  (b* ((thms (cdr (hons-assoc-equal fn (acl2::table-alist 'gl-branch-merge-rules wrld)))))
+    (glcp-branch-merge-formulas-to-rules thms wrld)))
+
+(memoize 'glcp-get-branch-merge-rules)
+
+(defun weak-rewrite-rule-listp (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      (eq x nil)
+    (and (acl2::weak-rewrite-rule-p (car x))
+         (weak-rewrite-rule-listp (cdr x)))))
+
+(defund rewrite-rules->runes (x)
+  (declare (xargs :guard (weak-rewrite-rule-listp x)))
+  (if (atom x)
+      nil
+    (cons (acl2::rewrite-rule->rune (car x))
+          (rewrite-rules->runes (cdr x)))))
+
+(defun-inline glcp-if-or-condition (test tbr contexts)
+  (declare (xargs :guard t))
+  (and (hons-equal test tbr)
+       ;; dumb
+       (or (not contexts) (equal contexts '(iff)))))
+
+(defun-inline glcp-or-test-contexts (contexts)
+  (declare (xargs :guard t))
+  (if (equal contexts '(iff))
+      '(iff)
+    nil))
+
+(defund glcp-lift-ifsp (fn flg w)
+  (declare (xargs :guard (and (symbolp fn)
+                              (plist-worldp w))))
+  (and flg
+       (not (cdr (hons-assoc-equal fn (table-alist 'gl-if-opaque-fns w))))))
+
+
+
+(defthmd acl2-count-of-car
+  (<= (acl2-count (car x)) (acl2-count x))
+  :rule-classes :linear)
+
+(defthmd acl2-count-of-cdr
+  (<= (acl2-count (cdr x)) (acl2-count x))
+  :rule-classes :linear)
+
+(defthmd acl2-count-of-car-g-apply->args
+  (implies (equal (tag x) :g-apply)
+           (< (acl2-count (car (g-apply->args x))) (acl2-count x)))
+  :hints(("Goal" :in-theory (enable acl2-count-of-car)))
+  :rule-classes :linear)
+
+(defthmd acl2-count-of-cadr-g-apply->args
+  (implies (equal (tag x) :g-apply)
+           (< (acl2-count (cadr (g-apply->args x))) (acl2-count x)))
+  :hints(("Goal" :in-theory (enable acl2-count-of-car
+                                    acl2-count-of-cdr)))
+  :rule-classes :linear)
+
+;; (local (defthm acl2-count-of-g-apply->args-consp
+;;          (implies (consp x)
+;;                   (< (acl2-count (g-apply->args x)) (acl2-count x)))
+;;          :rule-classes :linear))
+
+(encapsulate nil
+  (local (defthm acl2-count-of-g-concrete->obj
+           (implies (equal (tag x) :g-concrete)
+                    (< (acl2-count (g-concrete->obj x))
+                       (acl2-count x)))
+           :rule-classes :linear))
+  (local (defthm acl2-count-of-car-strong
+           (implies (consp x)
+                    (< (acl2-count (car X)) (acl2-count x)))
+           :rule-classes :linear))
+  (local (defthm acl2-count-of-cdr-strong
+           (implies (consp x)
+                    (< (acl2-count (cdr X)) (acl2-count x)))
+           :rule-classes :linear))
+
+  (local (defthm acl2-count-of-g-concrete
+           (equal (acl2-count (g-concrete x))
+                  (+ 1 (acl2-count x)))
+           :hints(("Goal" :in-theory (enable g-concrete)))))
+
+  (defthmd acl2-count-of-general-consp-car
+    (implies (general-consp x)
+             (< (acl2-count (general-consp-car x))
+                (acl2-count x)))
+    :hints(("Goal" :in-theory (enable mk-g-concrete)))
+    :rule-classes :linear)
+
+  (defthmd acl2-count-of-general-consp-cdr
+    (implies (general-consp x)
+             (< (acl2-count (general-consp-cdr x))
+                (acl2-count x)))
+    :hints(("Goal" :in-theory (enable mk-g-concrete)))
+    :rule-classes :linear))
+
+
+(defconst *glcp-generic-template-subst*
+  (let ((names (cons 'run-gified
+                     (remove 'clause-proc *glcp-fnnames*))))
+    (cons '(clause-proc . glcp-generic)
+          (pairlis$ names (glcp-put-name-each 'glcp-generic names)))))
+
+(make-event
+ (sublis *glcp-generic-template-subst*
+         *glcp-interp-template*))
+
+
+
diff -Nru acl2-6.2/books/centaur/gl/gl-generic-interp.lisp acl2-6.3/books/centaur/gl/gl-generic-interp.lisp
--- acl2-6.2/books/centaur/gl/gl-generic-interp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-generic-interp.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,5095 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "gl-generic-interp-defs")
+(include-book "misc/untranslate-patterns" :dir :system)
+(include-book "clause-processors/use-by-hint" :dir :system)
+(include-book "clause-processors/decomp-hint" :dir :system)
+(include-book "centaur/misc/interp-function-lookup" :dir :system)
+(include-book "var-bounds")
+(local (include-book "data-structures/no-duplicates" :dir :system))
+(local (include-book "general-object-thms"))
+(local (include-book "tools/with-quoted-forms" :dir :system))
+(local (include-book "hyp-fix-logic"))
+(local (include-book "std/lists/acl2-count" :dir :system))
+(local (include-book "clause-processors/find-matching" :dir :system))
+(local (include-book "clause-processors/just-expand" :dir :system))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+(local (in-theory (disable* sets::double-containment w)))
+(include-book "constraint-db-deps")
+(include-book "clause-processors/find-subterms" :dir :system)
+(include-book "glcp-unify-thms")
+(include-book "glcp-geval-thms")
+(flag::make-flag sublis-into-term-flg sublis-into-term)
+
+;; (defthm assoc-equal-nonnil-of-append
+;;   (implies x
+;;            (equal (assoc-equal x (append a b))
+;;                   (or (assoc-equal x a)
+;;                       (assoc-equal x b))))
+;;   :hints(("Goal" :in-theory (enable append assoc-equal))))
+
+;; (defthm-sublis-into-term-flg
+;;   sublis-into-term-correct-lemma
+;;   (sublis-into-term
+;;    (implies (pseudo-termp x)
+;;             (equal (glcp-generic-geval-ev (sublis-into-term x subst) alist)
+;;                    (glcp-generic-geval-ev x (append subst alist))))
+;;    :name sublis-into-term-correct)
+;;   (sublis-into-list
+;;    (implies (pseudo-term-listp x)
+;;             (equal (glcp-generic-geval-ev-lst (sublis-into-list x subst) alist)
+;;                    (glcp-generic-geval-ev-lst x (append subst alist))))
+;;    :name sublis-into-list-correct)
+;;   :hints (("goal" :induct (sublis-into-term-flg flag x alist))
+;;           (and stable-under-simplificationp
+;;                '(:in-theory (enable glcp-generic-geval-ev-constraint-0)))))
+
+(progn
+  (defthm len-sublis-into-list
+    (implies (pseudo-term-listp x)
+             (equal (length (sublis-into-list x subst))
+                    (length x)))
+    :hints (("goal" :induct (len x)
+             :in-theory (enable length))))
+
+  (defthm-sublis-into-term-flg
+    sublis-into-term-pseudo-term-lemma
+    (sublis-into-term
+     (implies (pseudo-termp x)
+              (pseudo-termp (sublis-into-term x subst)))
+     :name pseudo-termp-sublis-into-term)
+    (sublis-into-list
+     (implies (pseudo-term-listp x)
+              (pseudo-term-listp (sublis-into-list x subst)))
+     :name pseudo-term-listp-sublis-into-list)
+    :hints (("goal" :induct (sublis-into-term-flg flag x alist)
+             :expand ((pseudo-termp x)
+                      (:free (args) (pseudo-termp (cons (car x)
+                                                        args))))))))
+
+
+
+
+(set-state-ok t)
+
+
+
+
+;; (defun univ-run-gified-guard-wrapper (fn actuals hyp clk state)
+;;   (declare (xargs :guard (and (symbolp fn)
+;;                               (gobject-listp actuals)
+;;                               (bfr-p hyp)
+;;                               (natp clk))
+;;                   :stobjs state))
+;;   (ec-call (univ-run-gified fn actuals hyp clk state)))
+
+;; (defun glcp-generic-apply-concrete-guard-wrapper
+;;   (fn actuals state)
+;;   (declare (xargs :guard (true-listp actuals)
+;;                   :stobjs state))
+;;   (ec-call (glcp-generic-apply-concrete fn actuals state)))
+
+
+(local
+ (progn
+   ;; (defun-nx glcp-generic-geval-lst (x env)
+   ;;   (if (atom x)
+   ;;       nil
+   ;;     (cons (glcp-generic-geval (car x) env)
+   ;;           (glcp-generic-geval-lst (cdr x) env))))
+
+   ;; (defthmd glcp-generic-geval-of-gobj-list
+   ;;   (implies (gobj-listp x)
+   ;;            (equal (glcp-generic-geval x env)
+   ;;                   (glcp-generic-geval-lst x env)))
+   ;;   :hints
+   ;;   (("goal" :induct (gobject-listp x)
+   ;;     :in-theory (enable gobject-listp-impl-gobjectp
+   ;;                        glcp-generic-geval-of-gobject-car
+   ;;                        gobject-listp))))
+
+
+
+
+
+
+   (defthm nonnil-symbol-listp-impl-eqlable-listp
+     (implies (nonnil-symbol-listp x)
+              (eqlable-listp x))
+     :hints(("Goal" :in-theory (enable nonnil-symbol-listp))))
+
+
+
+
+   ;; (defthm univ-run-gified-wrapper-unwrap
+   ;;   (equal (univ-run-gified-guard-wrapper fn actuals hyp clk state)
+   ;;          (univ-run-gified fn actuals hyp clk state)))
+
+
+
+
+   ;; (defthm glcp-generic-apply-concrete-wrapper-unwrap
+   ;;   (equal (glcp-generic-apply-concrete-guard-wrapper fn actuals state)
+   ;;          (glcp-generic-apply-concrete fn actuals state)))
+
+   ;; (in-theory (disable univ-run-gified-guard-wrapper
+   ;;                     ;; glcp-generic-apply-concrete-guard-wrapper
+   ;;                     ))
+   ))
+
+
+
+
+
+
+
+
+
+;; (defun gobject-vals-alistp (x)
+;;   (declare (Xargs :guard t))
+;;   (if (atom x)
+;;       (equal x nil)
+;;     (and (or (atom (car x))
+;;              (gobjectp (cdar x)))
+;;          (gobject-vals-alistp (cdr x)))))
+
+
+;; (defthm lookup-in-gobject-vals-alistp
+;;   (implies (gobject-vals-alistp x)
+;;            (gobjectp (cdr (hons-assoc-equal k x)))))
+
+;; (defthm gobject-vals-alistp-pairlis$
+;;   (implies (gobject-listp vals)
+;;            (gobject-vals-alistp (pairlis$ keys vals)))
+;;   :hints(("Goal" :in-theory (enable gobject-listp
+;;                                     pairlis$))))
+
+
+
+
+(local (in-theory (disable* general-concretep-def acl2-count
+;                            sets::double-containment
+                            integer-abs
+;                            sets::nonempty-means-set
+                            equal-of-booleans-rewrite
+                            put-global
+                            acl2::true-list-listp-forward-to-true-listp-assoc-equal)))
+
+
+
+
+;; (defthmd gobject-listp-true-listp
+;;   (implies (gobject-listp x)
+;;            (true-listp x))
+;;   :hints(("Goal" :in-theory (enable gobject-listp)))
+;;   :rule-classes (:rewrite :forward-chaining))
+
+;; (defthm glcp-generic-geval-of-gobj-list
+;;   (implies (and (gobj-listp x)
+;;                 (consp x))
+;;            (equal (glcp-generic-geval x env)
+;;                   (cons (glcp-generic-geval (car x) env)
+;;                         (glcp-generic-geval (cdr x) env))))
+;;   :hints(("Goal" :use ((:instance glcp-generic-geval-of-gl-cons
+;;                         (x (car x)) (y (cdr x))))
+;;           :in-theory (enable gl-cons gobj-listp))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;; (defsection rune
+;;   (definlined rune->thmname (rune)
+;;     (declare (xargs :guard (symbol-listp rune)))
+;;     (mbe :logic (and (symbol-listp rune) (cadr rune))
+;;          :exec (cadr rune)))
+
+;;   (local (in-theory (enable rune->thmname)))
+
+;;   (defthm symbolp-of-rune->thmname
+;;     (symbolp (rune->thmname rune))))
+
+
+
+(defsection glcp-relieve-hyp-synp
+  (local (in-theory (enable glcp-relieve-hyp-synp)))
+
+  (defthm glcp-relieve-hyp-synp-bindings
+    (b* (((mv ?erp ?successp ?bindings1)
+          (glcp-relieve-hyp-synp hyp bindings state)))
+      (equal bindings1
+             (and (not erp) bindings))))
+
+  (defthm glcp-relieve-hyp-synp-correct
+    (b* (((mv ?erp ?successp ?bindings1)
+          (glcp-relieve-hyp-synp hyp bindings st)))
+      (implies (and successp
+                    (consp hyp)
+                    (eq (car hyp) 'synp)
+                    (glcp-generic-geval-ev-meta-extract-global-facts)
+                    (equal (w state) (w st)))
+               (glcp-generic-geval-ev hyp (glcp-generic-geval-alist bindings env))))))
+
+
+
+(defsection gl-term-to-apply-obj
+  (local (defthm assoc-is-hons-assoc
+           (implies k
+                    (equal (assoc k alist)
+                           (hons-assoc-equal k alist)))))
+
+  (local (defthm glcp-generic-geval-of-car-of-gl-cons
+           (equal (glcp-generic-geval (car (gl-cons x y)) env)
+                  (glcp-generic-geval x env))
+           :hints(("Goal" :in-theory (enable gl-cons glcp-generic-geval)))))
+
+  (defthm cdr-of-gl-cons
+    (equal (cdr (gl-cons x y)) y)
+    :hints(("Goal" :in-theory (enable gl-cons))))
+
+
+  (defthm-gl-term-to-apply-obj-flag
+    (defthm gobj-listp-of-gl-termlist-to-apply-obj-list
+      (true-listp (gl-termlist-to-apply-obj-list x alist))
+      :hints ('(:expand ((gl-termlist-to-apply-obj-list x alist))))
+      :flag gl-termlist-to-apply-obj-list)
+    :skip-others t)
+
+  (defthm-gl-term-to-apply-obj-flag
+    (defthm gl-term-to-apply-obj-correct
+      (implies (pseudo-termp x)
+               (equal (glcp-generic-geval (gl-term-to-apply-obj x alist) env)
+                      (glcp-generic-geval-ev x (glcp-generic-geval-alist alist env))))
+      :hints ('(:expand ((gl-term-to-apply-obj nil alist)
+                         (gl-term-to-apply-obj x alist)))
+              (and stable-under-simplificationp
+                   '(:in-theory (e/d (glcp-generic-geval-ev-of-fncall-args)
+                                     ((g-ite)))))
+              (and stable-under-simplificationp
+                   '(:expand ((gl-termlist-to-apply-obj-list (cdr x) alist)
+                              (gl-termlist-to-apply-obj-list (cddr x) alist)
+                              (gl-termlist-to-apply-obj-list (cdddr x) alist)
+                              (gl-termlist-to-apply-obj-list (cddddr x) alist)
+                              (gl-termlist-to-apply-obj-list nil alist)
+                              (:free (x y z)
+                               (:with glcp-generic-geval
+                                (glcp-generic-geval (g-ite x y z) env)))))))
+      :flag gl-term-to-apply-obj)
+    (defthm gl-termlist-to-apply-obj-list-correct
+      (implies (pseudo-term-listp x)
+               (equal (glcp-generic-geval-list (gl-termlist-to-apply-obj-list x alist) env)
+                      (glcp-generic-geval-ev-lst x (glcp-generic-geval-alist alist env))))
+      :hints ('(:expand ((gl-termlist-to-apply-obj-list x alist)
+                         (gl-termlist-to-apply-obj-list nil alist))))
+      :flag gl-termlist-to-apply-obj-list))
+
+  (defthm-gl-term-to-apply-obj-flag
+    (defthm gobj-depends-on-of-gl-term-to-apply-obj
+      (implies (not (gobj-alist-depends-on k p alist))
+               (not (gobj-depends-on k p (gl-term-to-apply-obj x alist))))
+      :hints ('(:expand ((gl-term-to-apply-obj nil alist)
+                         (gl-term-to-apply-obj x alist))))
+      :flag gl-term-to-apply-obj)
+    (defthm gobj-depends-on-of-gl-term-to-apply-obj-list
+      (implies (not (gobj-alist-depends-on k p alist))
+               (not (gobj-list-depends-on k p (gl-termlist-to-apply-obj-list x alist))))
+      :hints ('(:expand ((gl-termlist-to-apply-obj-list nil alist)
+                         (gl-termlist-to-apply-obj-list x alist))))
+      :flag gl-termlist-to-apply-obj-list)))
+
+
+(make-event
+ `(in-theory (disable . ,(glcp-put-name-each 'glcp-generic
+                                             (event-form-collect-fn-names
+                                              *glcp-interp-template*)))))
+
+(local (in-theory (disable acl2::weak-rewrite-rule-p)))
+
+(with-output :off (prove event)
+  (flag::make-flag glcp-generic-interp-flg
+                   glcp-generic-interp-term
+                   :flag-mapping
+                   ((glcp-generic-interp-test . test)
+                    (glcp-generic-interp-term . term)
+                    (glcp-generic-interp-fncall-ifs . fncall-ifs)
+                    (glcp-generic-maybe-interp-fncall-ifs . maybe-fncall-ifs)
+                    (glcp-generic-interp-term-equivs . equivs)
+                    (glcp-generic-interp-if/or . if/or)
+                    (glcp-generic-maybe-interp . maybe)
+                    (glcp-generic-interp-if . if)
+                    (glcp-generic-interp-or . or)
+                    (glcp-generic-merge-branches . merge)
+                    (glcp-generic-merge-branch-subterms . merge-sub)
+                    (glcp-generic-merge-branch-subterm-lists . merge-list)
+                    (glcp-generic-interp-fncall . fncall)
+                    (glcp-generic-simplify-if-test . test-simp)
+                    (glcp-generic-simplify-if-test-fncall . test-simp-fncall)
+                    (glcp-generic-add-bvar-constraints . constraints)
+                    (glcp-generic-add-bvar-constraint-substs . constraint-substs)
+                    (glcp-generic-rewrite . rewrite)
+                    (glcp-generic-rewrite-apply-rules . rules)
+                    (glcp-generic-rewrite-apply-rule . rule)
+                    (glcp-generic-relieve-hyps . hyps)
+                    (glcp-generic-relieve-hyp . hyp)
+                    (glcp-generic-interp-list . list))
+                   :formals-subst ((state . st))
+                   :hints (("goal" :in-theory
+                            (e/d (acl2-count
+                                  acl2-count-of-car-g-apply->args
+                                  acl2-count-of-cadr-g-apply->args
+                                  acl2-count-last-cdr-when-cadr-hack
+                                  acl2-count-of-general-consp-car
+                                  acl2-count-of-general-consp-cdr)
+                                 (last))))))
+
+(local
+ (defthm assoc-in-add-pair
+   (implies (not (equal k1 k2))
+            (equal (assoc k1 (add-pair k2 v a))
+                   (assoc k1 a)))))
+
+
+(defthm w-of-put-global
+  (implies (not (eq var 'current-acl2-world))
+           (equal (w (put-global var val state))
+                  (w state)))
+  :hints(("Goal" :in-theory (enable w put-global add-pair))))
+
+(local (in-theory (disable w)))
+
+
+
+(defun def-glcp-interp-thm-body (binder basename kws flag)
+  (declare (xargs :mode :program))
+  (b* ((fn-kws (cdr (assoc flag (cadr (assoc-keyword :special kws)))))
+       (body (or (cadr (assoc-keyword :body fn-kws))
+                 (cadr (assoc-keyword :body kws))))
+       (hyps (or (cadr (assoc-keyword :hyps fn-kws))
+                 (cadr (assoc-keyword :hyps kws))))
+       (add-hyps (cadr (assoc-keyword :add-hyps fn-kws)))
+       (add-concls (append (cadr (assoc-keyword :add-concls kws))
+                           (cadr (assoc-keyword :add-concls fn-kws))))
+       (add-bindings (cadr (assoc-keyword :add-bindings kws)))
+       (skip (cadr (assoc-keyword :skip fn-kws)))
+       (full-hyps (if hyps
+                      (if add-hyps `(and ,hyps ,add-hyps) hyps)
+                    add-hyps))
+       (concl (if body
+                  `(and ,body . ,add-concls)
+                `(and . ,add-concls)))
+       (full-body (if full-hyps
+                      `(implies ,full-hyps
+                                ,concl)
+                    concl)))
+    `(defthm ,(or (cadr (assoc-keyword :name fn-kws))
+                  (intern-in-package-of-symbol
+                   (concatenate 'string (symbol-name basename) "-" (symbol-name flag))
+                   basename))
+       (b* (,binder
+            . ,add-bindings)
+         ,full-body)
+       :hints (,@(let* ((fn-expand-look (assoc-keyword :expand-call fn-kws))
+                        (expand (if fn-expand-look
+                                    (cadr fn-expand-look)
+                                  (cadr (assoc-keyword :expand-calls kws)))))
+                   (and expand
+                        `((acl2::just-expand (,(cadr binder))
+                                             :last-only t
+                                             :mark-only ,(eq expand :mark-only))
+                          . ,(and (not (or (cadr (assoc-keyword :do-not-undo kws))
+                                         (cadr (assoc-keyword :do-not-undo fn-kws))))
+                                  '('(:do-not nil))))))
+                 ,@(cadr (assoc-keyword :hints fn-kws)))
+       :rule-classes ,(or (cadr (assoc-keyword :rule-classes fn-kws))
+                          (cadr (assoc-keyword :rule-classes kws))
+                          :rewrite)
+       :skip ,skip
+       :flag ,flag)))
+
+(defconst *glcp-ind-inputs*
+  (subst 'st 'state *glcp-common-inputs*))
+(defconst *glcp-ind-retvals*
+  '(?erp ?interp-st1 ?bvar-db1 ?state1))
+
+(defconst *glcp-generic-interp-signatures*
+  ;; flag call returns
+  `((test
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-interp-test x alist intro-bvars . ,*glcp-ind-inputs*))
+    (term
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-interp-term x alist contexts . ,*glcp-ind-inputs*))
+    (equivs
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-interp-term-equivs x alist contexts . ,*glcp-ind-inputs*))
+    (fncall-ifs
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-interp-fncall-ifs fn actuals x contexts . ,*glcp-ind-inputs*))
+    (maybe-fncall-ifs
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-maybe-interp-fncall-ifs fn actuals x contexts branchcond . ,*glcp-ind-inputs*))
+    (fncall
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-interp-fncall fn actuals x contexts . ,*glcp-ind-inputs*))
+    (if/or
+        (mv ?val . ,*glcp-ind-retvals*)
+        (glcp-generic-interp-if/or test tbr fbr alist contexts . ,*glcp-ind-inputs*))
+    (maybe
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-maybe-interp x alist contexts branchcond . ,*glcp-ind-inputs*))
+    (if
+        (mv ?val . ,*glcp-ind-retvals*)
+        (glcp-generic-interp-if test tbr fbr alist contexts . ,*glcp-ind-inputs*))
+    (or
+        (mv ?val . ,*glcp-ind-retvals*)
+        (glcp-generic-interp-or test fbr alist contexts . ,*glcp-ind-inputs*))
+    (merge
+        (mv ?val . ,*glcp-ind-retvals*)
+        (glcp-generic-merge-branches test-bfr then else switchedp contexts . ,*glcp-ind-inputs*))
+    (merge-sub
+        (mv ?val . ,*glcp-ind-retvals*)
+        (glcp-generic-merge-branch-subterms test-bfr then else . ,*glcp-ind-inputs*))
+    (merge-list
+        (mv ?val . ,*glcp-ind-retvals*)
+        (glcp-generic-merge-branch-subterm-lists test-bfr then else . ,*glcp-ind-inputs*))
+    (test-simp
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-simplify-if-test test-obj intro-bvars . ,*glcp-ind-inputs*))
+    (test-simp-fncall
+     (mv ?val . ,*glcp-ind-retvals*)
+     (glcp-generic-simplify-if-test-fncall fn args intro-bvars . ,*glcp-ind-inputs*))
+    (constraints
+     (mv . ,*glcp-ind-retvals*)
+     (glcp-generic-add-bvar-constraints lit . ,*glcp-ind-inputs*))
+    (constraint-substs
+     (mv . ,*glcp-ind-retvals*)
+     (glcp-generic-add-bvar-constraint-substs substs . ,*glcp-ind-inputs*))
+    (rewrite
+     (mv ?successp ?term ?bindings . ,*glcp-ind-retvals*)
+     (glcp-generic-rewrite fn actuals rwtype contexts . ,*glcp-ind-inputs*))
+    (rules
+     (mv ?successp ?term ?bindings . ,*glcp-ind-retvals*)
+     (glcp-generic-rewrite-apply-rules
+      fn-rewrites rules fn actuals contexts . ,*glcp-ind-inputs*))
+    (rule
+     (mv ?successp ?term ?bindings . ,*glcp-ind-retvals*)
+     (glcp-generic-rewrite-apply-rule
+      rule fn actuals contexts . ,*glcp-ind-inputs*))
+    (hyps
+     (mv ?successp ?bindings1 . ,*glcp-ind-retvals*)
+     (glcp-generic-relieve-hyps
+      rune hyps bindings . ,*glcp-ind-inputs*))
+    (hyp
+     (mv ?successp ?bindings1 . ,*glcp-ind-retvals*)
+     (glcp-generic-relieve-hyp
+      rune hyp bindings . ,*glcp-ind-inputs*))
+    (list
+     (mv ?vals . ,*glcp-ind-retvals*)
+     (glcp-generic-interp-list x alist . ,*glcp-ind-inputs*))))
+
+
+(defun interp-thm-body-calls (list basename keys)
+  (declare (xargs :mode :program))
+  (if (atom list)
+      nil
+    (cons (def-glcp-interp-thm-body
+            (cdar list) basename keys (caar list))
+          (interp-thm-body-calls (cdr list) basename keys))))
+
+
+
+(defun def-glcp-interp-thm-fn (basename keys)
+  (declare (xargs :mode :program))
+  `(with-output :off (prove) ;; induction scheme too big to print
+     (defthm-glcp-generic-interp-flg
+       ,@(interp-thm-body-calls *glcp-generic-interp-signatures* basename keys)
+       :hints (,@(and (cadr (assoc-keyword :expand-calls keys))
+                      `(("Goal" :do-not '(simplify preprocess))))
+                 ,@(cadr (assoc-keyword :hints keys)))
+       :no-induction-hint ,(cadr (assoc-keyword :no-induction-hint keys)))))
+
+(defmacro def-glcp-interp-thm (basename &rest keys)
+  (def-glcp-interp-thm-fn basename keys))
+
+
+
+
+
+
+
+(def-glcp-interp-thm glcp-generic-interp-w-state-preserved
+  :body (equal (w state1) (w st))
+  :expand-calls t)
+
+
+
+(local
+ (with-output :off (prove)
+   (defthm-glcp-generic-interp-flg
+     (defthm alistp-glcp-generic-rewrite
+       (b* (((mv ?successp ?term ?bindings ?erp ?interp-st1 ?bvar-db1 ?state1)
+             (glcp-generic-rewrite fn actuals rwtype contexts pathcond clk config interp-st bvar-db st)))
+         (alistp bindings))
+       :hints ('(:expand ((glcp-generic-rewrite fn actuals rwtype contexts pathcond clk config interp-st
+                                                bvar-db st))))
+       :flag rewrite)
+     (defthm alistp-glcp-generic-apply-rules
+       (b* (((mv ?successp ?term ?bindings ?erp ?interp-st1 ?bvar-db1 ?state1)
+             (glcp-generic-rewrite-apply-rules
+              fn-rewrites rules fn actuals contexts pathcond clk config interp-st bvar-db st)))
+         (alistp bindings))
+       :hints ('(:expand ((glcp-generic-rewrite-apply-rules
+                           fn-rewrites rules fn actuals contexts pathcond clk config interp-st bvar-db st))))
+       :flag rules)
+     (defthm alistp-glcp-generic-apply-rule
+       (b* (((mv ?successp ?term ?bindings ?erp ?interp-st1 ?bvar-db1 ?state1)
+             (glcp-generic-rewrite-apply-rule
+              rule fn actuals contexts pathcond clk config interp-st bvar-db st)))
+         (alistp bindings))
+       :hints ('(:expand ((:free (fn)
+                           (glcp-generic-rewrite-apply-rule
+                            rule fn actuals contexts pathcond clk config interp-st bvar-db st)))))
+       :flag rule)
+     (defthm alistp-glcp-generic-relieve-hyps
+       (b* (((mv ?successp ?bindings1 ?erp ?interp-st1 ?bvar-db1 ?state1)
+             (glcp-generic-relieve-hyps
+              rune hyps bindings pathcond clk config interp-st bvar-db st)))
+         (equal bindings1
+                (if erp nil bindings)))
+       :hints ('(:expand ((glcp-generic-relieve-hyps
+                           rune hyps bindings pathcond clk config interp-st bvar-db st))))
+       :flag hyps)
+     (defthm alistp-glcp-generic-relieve-hyp
+       (b* (((mv ?successp ?bindings1 ?erp ?interp-st1 ?bvar-db1 ?state1)
+             (glcp-generic-relieve-hyp
+              rune hyp bindings pathcond clk config interp-st bvar-db st)))
+         (equal bindings1
+                (if erp nil bindings)))
+       :hints ('(:expand ((glcp-generic-relieve-hyp
+                           rune hyp bindings pathcond clk config interp-st bvar-db st))))
+       :flag hyp)
+     :skip-others t)))
+
+
+   ;; (defthm-glcp-generic-interp-flg
+   ;;   (defthm gobjectp-glcp-generic-interp-term
+   ;;    (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+   ;;                  (equal (w st) (w state))
+   ;;                  (sym-counterparts-ok (w st))
+   ;;                  (bfr-p hyp)
+   ;;                  (not (mv-nth 0 (glcp-generic-interp-term
+   ;;                                  x alist pathcond clk obligs config st))))
+   ;;             (gobjectp (mv-nth 2 (glcp-generic-interp-term
+   ;;                                  x alist pathcond clk obligs config st))))
+   ;;    :flag glcp-generic-interp-term)
+
+   ;;   (defthm gobject-listp-glcp-generic-interp-list
+   ;;    (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+   ;;                  (equal (w st) (w state))
+   ;;                  (sym-counterparts-ok (w st))
+   ;;                  (bfr-p hyp)
+   ;;                  (not (mv-nth 0 (glcp-generic-interp-list
+   ;;                                  x alist pathcond clk obligs config st))))
+   ;;             (gobject-listp (mv-nth 2 (glcp-generic-interp-list
+   ;;                                       x alist pathcond clk obligs config st))))
+   ;;    :flag glcp-generic-interp-list)
+   ;;   :hints (("goal" :induct (glcp-generic-interp-flg flag x alist pathcond clk obligs config st)
+   ;;            :expand ((glcp-generic-interp-term x alist pathcond clk obligs config st)
+   ;;                     (glcp-generic-interp-list x alist pathcond clk obligs config st)
+   ;;                     (glcp-generic-interp-term nil alist pathcond clk obligs config st)
+   ;;                     (glcp-generic-interp-list nil alist pathcond clk obligs config st)
+   ;;                     (gobject-listp nil)
+   ;;                     (:free (a b) (gobject-listp (cons a b))))
+   ;;            :in-theory (e/d** ( ;; gobjectp-gobj-ite-merge
+   ;;                               ;;                               gobjectp-cons
+   ;;                               ;;                               gtests-wfp
+   ;;                               ;;                               bfr-p-of-bfr-and
+   ;;                               ;;                               bfr-p-of-bfr-not
+   ;;                               ;;                               bfr-p-of-bfr-or
+   ;;                               ;;                               hyp-fix-bfr-p
+   ;;                               ;;                               (gobjectp)
+   ;;                               gobjectp-g-apply
+   ;;                               gobjectp-gobj-fix
+   ;;                               gtests-wfp
+   ;;                               gobjectp-cons
+   ;;                               bfr-p-bfr-binary-and
+   ;;                               bfr-p-bfr-not
+   ;;                               bfr-p-bfr-binary-or
+   ;;                               gobjectp-mk-g-concrete
+   ;;                               gobjectp-g-concrete-quote
+   ;;                               hyp-fix-bfr-p
+   ;;                               glcp-generic-interp-list-w-state-preserved
+   ;;                               glcp-generic-interp-term-w-state-preserved
+   ;;                               gl-aside gl-ignore gl-error-is-nil
+   ;;                               gobjectp-of-atomic-constants
+   ;;                               gobjectp-gobj-ite-merge
+   ;;                               gobjectp-mk-g-ite
+   ;;                               gobjectp-mk-g-boolean
+   ;;                               car-cons cdr-cons (bfr-p)
+   ;;                               glcp-interp-error
+   ;;                               glcp-generic-interp-flg-equivalences
+   ;;                               (:induction glcp-generic-interp-flg)
+   ;;                               booleanp-compound-recognizer
+   ;;                               bfr-p-bfr-binary-or
+   ;;                               gobjectp-mk-g-boolean
+   ;;                               (g-keyword-symbolp)))
+   ;;            :do-not-induct t)))
+
+
+
+(local
+ (defsection glcp-generic-geval-thms
+   (local (in-theory (disable glcp-generic-geval-alt-def)))
+
+   (acl2::def-functional-instance
+     glcp-generic-geval-gobj-ite-merge-correct
+     gobj-ite-merge-correct
+     ((generic-geval-ev glcp-generic-geval-ev)
+      (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+      (generic-geval glcp-generic-geval)
+      (generic-geval-list glcp-generic-geval-list))
+     :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                                 glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                                (glcp-generic-geval-apply))
+               :expand ((:with glcp-generic-geval (glcp-generic-geval x env))
+                        (glcp-generic-geval-list x env)))))
+
+   (acl2::def-functional-instance
+     glcp-generic-geval-gtests-nonnil-correct
+     gtests-nonnil-correct
+     ((generic-geval-ev glcp-generic-geval-ev)
+      (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+      (generic-geval glcp-generic-geval)
+      (generic-geval-list glcp-generic-geval-list)))
+
+   (in-theory (disable glcp-generic-geval-gtests-nonnil-correct))
+
+   (acl2::def-functional-instance
+     glcp-generic-geval-gtests-obj-correct
+     gtests-obj-correct
+     ((generic-geval-ev glcp-generic-geval-ev)
+      (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+      (generic-geval glcp-generic-geval)
+      (generic-geval-list glcp-generic-geval-list)))
+
+
+   (acl2::def-functional-instance
+     glcp-generic-geval-gl-args-split-ite-correct
+     gl-args-split-ite-correct
+     ((generic-geval-ev glcp-generic-geval-ev)
+      (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+      (generic-geval glcp-generic-geval)
+      (generic-geval-list glcp-generic-geval-list)))
+
+   (acl2::def-functional-instance
+     glcp-generic-geval-gl-fncall-maybe-split-correct
+     gl-fncall-maybe-split-correct
+     ((generic-geval-ev glcp-generic-geval-ev)
+      (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+      (generic-geval glcp-generic-geval)
+      (generic-geval-list glcp-generic-geval-list)))
+
+   (acl2::def-functional-instance
+     glcp-generic-geval-gl-cons-maybe-split-correct
+     gl-cons-maybe-split-correct
+     ((generic-geval-ev glcp-generic-geval-ev)
+      (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+      (generic-geval glcp-generic-geval)
+      (generic-geval-list glcp-generic-geval-list)))))
+
+(local (in-theory (enable glcp-generic-geval-gtests-nonnil-correct)))
+
+
+
+
+(progn
+
+  (defthm pseudo-termp-car
+    (implies (pseudo-term-listp x)
+             (pseudo-termp (car x))))
+
+  (defthm pseudo-term-listp-cdr
+    (implies (pseudo-term-listp x)
+             (pseudo-term-listp (cdr x))))
+
+  (defthm pseudo-term-listp-cdr-pseudo-term
+    (implies (and (pseudo-termp x)
+                  (consp x)
+                  (not (equal (car x) 'quote)))
+             (pseudo-term-listp (cdr x))))
+
+  (defthm pseudo-termp-symbolp-car-x
+    (implies (and (pseudo-termp x)
+                  (not (consp (car x))))
+             (symbolp (car x))))
+
+  (defthm pseudo-termp-lambda-body
+    (implies (and (pseudo-termp x)
+                  (consp (car x)))
+             (pseudo-termp (caddar x))))
+
+  (defthm pseudo-termp-car-last-of-pseudo-term-listp
+    (implies (pseudo-term-listp x)
+             (pseudo-termp (car (last x))))
+    :hints(("Goal" :in-theory (enable last))))
+
+  (defthm pseudo-termp-car-last
+    (implies (and (pseudo-termp x)
+                  (< 1 (len x))
+                  (not (equal (car x) 'quote)))
+             (pseudo-termp (car (last x))))
+    :hints(("Goal" :expand ((pseudo-termp x))))))
+
+
+
+(encapsulate nil
+  (local (in-theory (disable
+                     sets::sets-are-true-lists
+                     pseudo-term-listp
+                     (:t hyp-fix)
+                     (:t acl2::interp-defs-alistp)
+                     (:t pseudo-termp)
+                     (:t glcp-generic-interp-term)
+                     (:t glcp-generic-interp-term-equivs)
+                     (:t glcp-generic-interp-test)
+                     (:t glcp-generic-interp-if/or)
+                     (:t glcp-generic-interp-if)
+                     (:t glcp-generic-interp-or)
+                     (:t glcp-generic-merge-branches)
+                     (:t glcp-generic-merge-branch-subterms)
+                     (:t glcp-generic-merge-branch-subterm-lists)
+                     (:t gtests)
+                     (:t pseudo-term-listp)
+                     (:t general-concrete-listp)
+                     (:t len)
+                     (:t glcp-generic-rewrite)
+                     (:t glcp-generic-interp-list)
+                     (:t acl2::interp-function-lookup)
+                     (:t glcp-generic-simplify-if-test)
+                     (:t glcp-generic-simplify-if-test-fncall)
+                     acl2::cancel_times-equal-correct
+                     acl2::cancel_plus-equal-correct
+                     fgetprop
+                     len
+                     nth update-nth
+                     default-car default-cdr
+                     true-listp-update-nth
+                     no-duplicatesp-equal
+                     member-equal
+                     hons-assoc-equal
+                     acl2::weak-rewrite-rule-p
+                     general-concrete-listp
+                     general-concrete-obj-list
+                     not
+                     true-listp
+                     hyp-fix-of-hyp-fixedp
+                     pseudo-termp)))
+  (def-glcp-interp-thm glcp-generic-interp-obligs-okp
+    :hyps (and (acl2::interp-defs-alistp (nth *is-obligs* interp-st))
+               (acl2::interp-defs-alistp (glcp-config->overrides config)))
+    :body (acl2::interp-defs-alistp (nth *is-obligs* interp-st1))
+    :special
+    ((test :add-hyps (pseudo-termp x))
+     (term :add-hyps (pseudo-termp x))
+     (equivs :add-hyps (pseudo-termp x))
+     (if/or :add-hyps (and (pseudo-termp test)
+                           (pseudo-termp tbr)
+                           (pseudo-termp fbr)))
+     (maybe :add-hyps (pseudo-termp x))
+     (if :add-hyps (and (pseudo-termp test)
+                           (pseudo-termp tbr)
+                           (pseudo-termp fbr)))
+     (or :add-hyps (and (pseudo-termp test)
+                        (pseudo-termp fbr)))
+     (list :add-hyps (pseudo-term-listp x))
+     (hyp :add-hyps (pseudo-termp hyp))
+     (hyps :add-hyps (pseudo-term-listp hyps))
+     (fncall-ifs :add-hyps (and (symbolp fn)
+                                (not (eq fn 'quote))))
+     (maybe-fncall-ifs :add-hyps (and (symbolp fn)
+                                      (not (eq fn 'quote))))
+     (fncall :add-hyps (and (symbolp fn)
+                            (not (eq fn 'quote))))
+     (rewrite :body (implies (and (symbolp fn)
+                                  (not (eq fn 'quote)))
+                             (and (acl2::interp-defs-alistp (nth *is-obligs* interp-st1))
+                                  (pseudo-termp term))))
+     (rules :body (implies (and (symbolp fn)
+                                (not (eq fn 'quote)))
+                           (and (acl2::interp-defs-alistp (nth *is-obligs* interp-st1))
+                                (pseudo-termp term))))
+     (rule :body (implies (and (symbolp fn)
+                               (not (eq fn 'quote)))
+                          (and (acl2::interp-defs-alistp (nth *is-obligs* interp-st1))
+                               (pseudo-termp term)))))
+    :expand-calls t))
+
+
+
+
+(local
+ (with-output :off (prove)
+   (defthm-glcp-generic-interp-flg
+     (defthm true-listp-glcp-generic-interp-list
+       (true-listp (mv-nth 0 (glcp-generic-interp-list
+                              x alist pathcond clk config interp-st bvar-db st)))
+       :hints('(:expand (glcp-generic-interp-list
+                         x alist pathcond clk config interp-st bvar-db st)
+                :in-theory (enable gl-cons)))
+       :rule-classes :type-prescription
+       :flag list)
+     :skip-others t)))
+
+
+(local (include-book "system/f-put-global" :dir :system))
+(local (in-theory (disable state-p1-forward)))
+
+(encapsulate nil
+  (local (in-theory (disable* pseudo-termp
+                              symbol-listp
+                              hyp-fix-of-hyp-fixedp
+                              state-p-implies-and-forward-to-state-p1
+                              len nth update-nth
+                              default-car default-cdr
+                              (:rules-of-class :type-prescription :here))))
+  (def-glcp-interp-thm glcp-generic-interp-state-p1-preserved
+    :body (implies (state-p1 st)
+                   (state-p1 state1))
+
+    :expand-calls t))
+
+
+(local
+ (defthm true-listp-gl-cons
+   (equal (true-listp (gl-cons x y))
+          (true-listp y))
+   :hints(("Goal" :in-theory (enable gl-cons)))))
+
+
+
+
+
+(local
+ (defthm consp-last
+   (equal (consp (last x))
+          (consp x))))
+
+
+
+(set-ignore-ok t)
+
+(defthm plist-worldp-of-w-state
+  (implies (state-p1 state)
+           (plist-worldp (w state)))
+  :hints(("Goal" :in-theory (e/d (state-p1 get-global w)
+                                 (all-boundp)))))
+
+;; (defun get-guard-verification-theorem (name state)
+;;   (declare (xargs :mode :program
+;;                   :stobjs state))
+;;   (b* ((wrld (w state))
+;;        (ctx 'get-guard-verification-theorem)
+;;        ((er names) (acl2::chk-acceptable-verify-guards
+;;                     name ctx wrld state))
+;;        (ens (acl2::ens state))
+;;        ((mv clauses & state)
+;;         (acl2::guard-obligation-clauses
+;;          names nil ens wrld state))
+;;        (term (acl2::termify-clause-set clauses)))
+;;     (value term)))
+
+
+;; (local (defthm symbol-listp-implies-true-listp
+;;          (implies (symbol-listp x)
+;;                   (true-listp x))
+;;          :rule-classes :forward-chaining))
+
+(local (defthm nonnil-symbol-listp-true-listp
+         (implies (nonnil-symbol-listp x)
+                  (true-listp x))))
+
+;; (local (defthm gobj-listp-impl-true-listp
+;;          (implies (gobj-listp x)
+;;                   (true-listp x))
+;;          :hints(("Goal" :in-theory (enable gobj-listp)))
+;;          :rule-classes :compound-recognizer))
+
+(local (defthm pseudo-termp-impl-symbol-listp-lambda-formals
+         (implies (and (pseudo-termp x)
+                       (consp (car x)))
+                  (symbol-listp (cadar x)))
+         :hints(("Goal" :expand ((pseudo-termp x))))))
+
+
+(local (defthm symbol-listp-impl-eqlable-listp
+         (implies (symbol-listp x)
+                  (eqlable-listp x))))
+
+(local (defthm symbol-listp-impl-true-listp
+         (implies (symbol-listp x)
+                  (true-listp x))))
+
+(local (defthm pseudo-termp-impl-len-lambda-formals
+         (implies (and (pseudo-termp x)
+                       (consp (car x)))
+                  (equal (equal (len (cadar x)) (len (cdr x)))
+                         t))
+         :hints(("Goal" :expand ((pseudo-termp x))))))
+
+
+(local
+ (with-output :off (prove)
+   (progn
+     (defthm len-gl-cons
+       (equal (len (gl-cons x y))
+              (+ 1 (len y)))
+       :hints(("Goal" :in-theory (enable gl-cons))))
+
+     (defthm-glcp-generic-interp-flg
+       (defthm len-of-glcp-generic-interp-list
+         (mv-let (res erp)
+           (glcp-generic-interp-list
+            x alist pathcond clk config interp-st bvar-db st)
+           (implies (not erp)
+                    (equal (len res)
+                           (len x))))
+         :hints ('(:expand ((glcp-generic-interp-list
+                             x alist pathcond clk config interp-st bvar-db st))))
+         :flag list)
+       :skip-others t))))
+
+(local (defthmd contextsp-implies-true-listp
+         (implies (contextsp x)
+                  (true-listp x))
+         :rule-classes :forward-chaining))
+
+
+
+(defsection glcp-branch-merge-formula-to-rule
+
+  (defthm conjunction-to-list-correct
+    (iff (glcp-generic-geval-ev (conjoin (conjunction-to-list x)) a)
+         (glcp-generic-geval-ev x a))
+    :hints(("Goal" :in-theory (enable conjunction-to-list))))
+
+  (local (in-theory (disable acl2::beta-reduce-full
+                             pseudo-termp)))
+
+  (local (in-theory (enable glcp-branch-merge-formula-to-rule)))
+
+  (defthm glcp-branch-merge-formula-to-rule-wfp
+    (b* (((mv ok rule)
+          (glcp-branch-merge-formula-to-rule name wrld)))
+      (implies ok
+               (acl2::weak-rewrite-rule-p rule)))
+    :hints(("Goal" :in-theory (disable acl2::weak-rewrite-rule-p))))
+
+  (local (defthmd beta-reduce-full-correct-for-glcp-generic-geval-ev
+           (implies (pseudo-termp x)
+                    (equal (glcp-generic-geval-ev (acl2::beta-reduce-full x) a)
+                           (glcp-generic-geval-ev x a)))
+           :hints (("goal" :use ((:instance
+                                  (:functional-instance
+                                   acl2::beta-reduce-full-correct
+                                   (acl2::beta-eval glcp-generic-geval-ev)
+                                   (acl2::beta-eval-list
+                                    glcp-generic-geval-ev-lst))))
+                    :in-theory (enable glcp-generic-geval-ev-of-fncall-args)))))
+
+
+  (defthmd rewrite-rule-term-alt-def
+    (equal (acl2::rewrite-rule-term x)
+           (if (eq (acl2::rewrite-rule->subclass x) 'acl2::meta)
+               ''t
+             `(implies ,(conjoin (acl2::rewrite-rule->hyps x))
+                       (,(acl2::rewrite-rule->equiv x)
+                        ,(acl2::rewrite-rule->lhs x)
+                        ,(acl2::rewrite-rule->rhs x)))))
+    :hints(("Goal" :in-theory (enable acl2::rewrite-rule->subclass
+                                      acl2::rewrite-rule->hyps
+                                      acl2::rewrite-rule->equiv
+                                      acl2::rewrite-rule->lhs
+                                      acl2::rewrite-rule->rhs))))
+
+  (local (in-theory (disable acl2::rewrite-rule-term)))
+
+  ; (local (include-book "arithmetic/top-with-meta" :dir :system))
+
+  (local (defthm equal-of-len
+           (implies (syntaxp (quotep n))
+                    (equal (equal (len x) n)
+                           (and (natp n)
+                                (if (equal n 0)
+                                    (atom x)
+                                  (and (consp x)
+                                       (equal (len (cdr x)) (1- n)))))))))
+
+
+
+  (defthm glcp-branch-merge-formula-to-rule-correct
+    (b* (((mv ok rule)
+          (glcp-branch-merge-formula-to-rule name wrld)))
+      (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+                    (equal wrld (w state))
+                    ok)
+               (glcp-generic-geval-ev-theoremp (acl2::rewrite-rule-term rule))))
+    :hints (("goal" :use ((:instance glcp-generic-geval-ev-falsify
+                           (x (acl2::meta-extract-formula-w name wrld))
+                           (a (glcp-generic-geval-ev-falsify
+                               (acl2::rewrite-rule-term
+                                (mv-nth 1 (glcp-branch-merge-formula-to-rule
+                                           name wrld))))))
+                          (:instance
+                           beta-reduce-full-correct-for-glcp-generic-geval-ev
+                           (x (acl2::meta-extract-formula-w name wrld))
+                           (a (glcp-generic-geval-ev-falsify
+                               (acl2::rewrite-rule-term
+                                (mv-nth 1 (glcp-branch-merge-formula-to-rule
+                                           name wrld)))))))
+             :expand ((glcp-branch-merge-formula-to-rule name wrld))
+             :in-theory (e/d (glcp-generic-geval-ev-of-fncall-args
+                              rewrite-rule-term-alt-def)
+                             (equal-of-booleans-rewrite
+                              default-car default-cdr
+                              sets::double-containment
+                              len kwote-lst
+                              w))))))
+
+
+
+(defun good-rewrite-rulesp (rules)
+  (if (atom rules)
+      t
+    (and (glcp-generic-geval-ev-theoremp (acl2::rewrite-rule-term (car rules)))
+         (good-rewrite-rulesp (cdr rules)))))
+
+(defsection glcp-branch-merge-formulas-to-rules
+
+  (local (in-theory (enable glcp-branch-merge-formulas-to-rules)))
+
+  (defthm good-rewrite-rulesp-of-glcp-branch-merge-formulas-to-rules
+    (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+                  (equal wrld (w state)))
+             (good-rewrite-rulesp
+              (glcp-branch-merge-formulas-to-rules names wrld)))
+    :hints(("Goal" :in-theory (e/d (good-rewrite-rulesp)
+                                   (acl2::rewrite-rule-term
+                                    rewrite-rule-term-alt-def)))))
+
+  (defthm weak-rewrite-rule-listp-of-glcp-branch-merge-formulas-to-rules
+    (weak-rewrite-rule-listp
+     (glcp-branch-merge-formulas-to-rules names wrld))))
+
+(defsection good-rewrite-rulesp-of-get-lemmas
+  (local (defthmd good-rewrite-rulesp-of-get-lemmas1
+           (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+                         (subsetp rules (getprop fn 'acl2::lemmas nil
+                                                 'current-acl2-world (w state))))
+                    (good-rewrite-rulesp rules))
+           :hints(("Goal" :in-theory (e/d (subsetp-equal
+                                           good-rewrite-rulesp)
+                                          (acl2::rewrite-rule-term
+                                           rewrite-rule-term-alt-def
+                                           w))))))
+  (defthm good-rewrite-rulesp-of-get-lemmas
+    (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+                  (equal wrld (w state)))
+             (good-rewrite-rulesp
+              (getprop fn 'acl2::lemmas nil
+                       'current-acl2-world (w state))))
+    :hints (("goal" :use ((:instance good-rewrite-rulesp-of-get-lemmas1
+                           (rules
+                            (getprop fn 'acl2::lemmas nil
+                                     'current-acl2-world (w state)))))))))
+
+
+
+
+(defthm good-rewrite-rules-of-glcp-get-branch-merge-rules
+  (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+                (equal wrld (w state)))
+           (good-rewrite-rulesp (glcp-get-branch-merge-rules fn wrld)))
+  :hints(("Goal" :in-theory (enable glcp-get-branch-merge-rules))))
+
+(defthm weak-rewrite-rule-listp-of-glcp-get-branch-merge-rules
+  (weak-rewrite-rule-listp
+   (glcp-get-branch-merge-rules fn wrld))
+  :hints(("Goal" :in-theory (enable glcp-get-branch-merge-rules))))
+
+
+(encapsulate nil
+  (local (defthm len-0
+           (equal (equal (len x) 0)
+                  (not (consp x)))))
+
+  (make-event
+   (b* (((er &) (in-theory nil))
+        ((er thm) (get-guard-verification-theorem 'glcp-generic-interp-term state)))
+     (value
+      `(with-output :off (prove)
+         (defthm glcp-generic-interp-guards-ok
+           ,thm
+           :hints (("goal" :in-theory
+                    (e/d* (pseudo-termp-car-last-of-pseudo-term-listp
+                           gl-aside gl-ignore gl-error-is-nil
+                           contextsp-implies-true-listp)
+                          (glcp-generic-interp-term
+                           glcp-generic-interp-list
+                           acl2::weak-rewrite-rule-p
+                           consp-assoc-equal
+                           pseudo-term-listp
+                           w
+                           nth update-nth
+                           contextsp
+                           nonnil-symbol-listp
+                           true-listp symbol-listp
+                           not no-duplicatesp-equal
+                           fgetprop plist-worldp
+                           hons-assoc-equal
+;                       bfr-and-is-bfr-and
+;                       bfr-not-is-bfr-not
+;                       bfr-p-is-bfr-p
+                           assoc table-alist
+                           general-concrete-listp
+                           general-concretep-def
+                           state-p-implies-and-forward-to-state-p1
+                           (:rules-of-class :forward-chaining :here)
+                           (:rules-of-class :type-prescription :here)
+                           (force))
+                          ((:type-prescription glcp-generic-interp-term)
+                           (:type-prescription glcp-generic-interp-list)
+                           (:type-prescription acl2::interp-function-lookup)
+                           (:type-prescription general-concrete-obj-list)
+                           (:type-prescription hons-assoc-equal)
+                           (:t type-of-get-term->bvar$a)))
+                    :do-not-induct t))
+           :rule-classes nil))))))
+
+
+
+(local (defthm car-last-when-length-4
+         (implies (equal (len x) 4)
+                  (equal (car (last x))
+                         (cadddr x)))
+         :hints(("Goal" :in-theory (enable len last)))))
+
+(local
+ (progn
+   (include-book "tools/def-functional-instance" :dir :system)
+
+   (acl2::def-functional-instance
+    glcp-generic-interp-function-lookup-correct
+    acl2::interp-function-lookup-correct
+    ((acl2::ifl-ev glcp-generic-geval-ev)
+     (acl2::ifl-ev-lst glcp-generic-geval-ev-lst)
+     (acl2::ifl-ev-falsify glcp-generic-geval-ev-falsify)
+     (acl2::ifl-ev-meta-extract-global-badguy
+      glcp-generic-geval-ev-meta-extract-global-badguy))
+    :hints ((and stable-under-simplificationp
+                 '(:use (glcp-generic-geval-ev-of-fncall-args
+                         glcp-generic-geval-ev-falsify
+                         glcp-generic-geval-ev-meta-extract-global-badguy)))))
+
+   (acl2::def-functional-instance
+    glcp-generic-interp-function-lookup-theoremp-defs-history
+    acl2::interp-function-lookup-theoremp-defs-history
+    ((acl2::ifl-ev glcp-generic-geval-ev)
+     (acl2::ifl-ev-lst glcp-generic-geval-ev-lst)
+     (acl2::ifl-ev-falsify glcp-generic-geval-ev-falsify)))
+
+
+
+   (defthm glcp-generic-interp-function-lookup-theoremp-defs-history-rev
+     (b* (((mv erp & & out-defs)
+           (acl2::interp-function-lookup fn in-defs overrides world)))
+       (implies (and (not (glcp-generic-geval-ev-theoremp
+                           (conjoin-clauses
+                            (acl2::interp-defs-alist-clauses in-defs))))
+                     (not erp))
+                (not (glcp-generic-geval-ev-theoremp
+                      (conjoin-clauses
+                       (acl2::interp-defs-alist-clauses out-defs)))))))
+
+   ;; (defthm glcp-generic-interp-function-lookup-theoremp-defs-history-fwd
+   ;;   (b* (((mv erp & & out-defs)
+   ;;         (acl2::interp-function-lookup fn in-defs overrides world)))
+   ;;     (implies (and (glcp-generic-geval-ev-theoremp
+   ;;                    (conjoin-clauses
+   ;;                     (acl2::interp-defs-alist-clauses out-defs)))
+   ;;                   (not erp))
+   ;;              (glcp-generic-geval-ev-theoremp
+   ;;               (conjoin-clauses
+   ;;                (acl2::interp-defs-alist-clauses in-defs)))))
+   ;;   :rule-classes :forward-chaining)
+
+   ))
+
+(local (in-theory (disable acl2::interp-defs-alist-clauses)))
+
+(encapsulate nil
+  (local (in-theory (disable* (:rules-of-class :type-prescription :here)
+                              pseudo-termp
+                              len nth update-nth default-car default-cdr
+                              fgetprop
+                              glcp-generic-geval-ev-conjoin-clauses-atom
+                              hons-assoc-equal
+                              glcp-generic-geval-ev-rules
+                              glcp-generic-interp-function-lookup-theoremp-defs-history
+                              pseudo-termp-car)))
+
+  (defun find-bad-obligs-lit (clause)
+    (declare (xargs :mode :program))
+    (if (atom clause)
+        nil
+      (b* (((mv ok &) (acl2::simple-one-way-unify
+                       '(GLCP-GENERIC-GEVAL-EV
+                         (CONJOIN-CLAUSES (ACL2::INTERP-DEFS-ALIST-CLAUSES OBLIGS))
+                         (GLCP-GENERIC-GEVAL-EV-FALSIFY
+                          (CONJOIN-CLAUSES (ACL2::INTERP-DEFS-ALIST-CLAUSES OBLIGS))))
+                       (car clause)
+                       nil))
+           ((when ok) t))
+        (find-bad-obligs-lit (cdr clause)))))
+
+  (defun bad-obligs-syntaxp (mfc state)
+    (declare (xargs :mode :program :stobjs state))
+    (or (acl2::mfc-ancestors mfc)
+        (car (acl2::mfc-current-literal mfc state))))
+          ;; (and negp
+          ;;      (case-match lit
+          ;;        (('glcp-generic-geval-ev
+          ;;          ('conjoin-clauses
+          ;;           ('acl2::interp-defs-alist-clauses . &))
+          ;;          ('glcp-generic-geval-ev-falsify . &))
+          ;;         t)))))
+
+  (defund interp-defs-ok (obligs)
+    (glcp-generic-geval-ev-theoremp
+     (conjoin-clauses
+      (acl2::interp-defs-alist-clauses obligs))))
+
+  (local (in-theory (enable interp-defs-ok)))
+  
+  (def-glcp-interp-thm glcp-generic-interp-bad-obligs
+    ;; :hyps (and ;; (syntaxp ((lambda (mfc state)
+    ;;            ;;             (find-bad-obligs-lit (mfc-clause mfc)))
+    ;;            ;;           mfc state))
+    ;;        
+    :hyps  ;; (and (syntaxp (bad-obligs-syntaxp mfc state))
+                (not (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st)))))
+  :body (not (glcp-generic-geval-ev-theoremp
+              (conjoin-clauses
+               (acl2::interp-defs-alist-clauses (nth *is-obligs*
+                                                     interp-st1)))))
+                   ; (and (interp-defs-ok (nth *is-obligs* interp-st1))
+                   ;; (glcp-generic-geval-ev-theoremp
+                   ;;  (conjoin-clauses
+                   ;;   (acl2::interp-defs-alist-clauses (nth *is-obligs*
+                   ;;                                         interp-st)))))
+;;    :rule-classes :forward-chaining
+    :expand-calls t)
+
+  ;; (defthm glcp-generic-interp-function-lookup-theoremp-defs-history-rev
+  ;;   (B* (((MV ERP & & OUT-DEFS)
+  ;;         (ACL2::INTERP-FUNCTION-LOOKUP FN IN-DEFS OVERRIDES WORLD)))
+  ;;     (implies (not erp)
+  ;;              (iff (glcp-generic-geval-ev-theoremp
+  ;;                    (conjoin-clauses
+  ;;                     (acl2::interp-defs-alist-clauses out-defs)))
+  ;;                   (and (interp-defs-ok out-defs)
+  ;;                        (glcp-generic-geval-ev-theoremp
+  ;;                         (conjoin-clauses
+  ;;                          (acl2::interp-defs-alist-clauses in-defs))))))))
+)
+
+
+
+
+
+
+
+
+
+
+
+
+
+(progn
+  (local (in-theory (disable nth update-nth)))
+  ;; (defthm glcp-generic-interp-term-ok-obligs
+  ;;   (implies (and (not (glcp-generic-geval-ev-theoremp
+  ;;                       (conjoin-clauses
+  ;;                        (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st)))))
+  ;;                 (glcp-generic-geval-ev-theoremp
+  ;;                  (conjoin-clauses
+  ;;                   (acl2::interp-defs-alist-clauses
+  ;;                    (nth *is-obligs*
+  ;;                         (mv-nth 2 (glcp-generic-interp-term
+  ;;                                    x alist contexts pathcond clk config interp-st bvar-db st)))))))
+  ;;            (mv-nth 1 (glcp-generic-interp-term
+  ;;                       x alist contexts pathcond clk config interp-st bvar-db
+  ;;                       st)))
+  ;;   :hints (("goal" :use glcp-generic-interp-bad-obligs-term)))
+
+
+
+
+
+  ;; (defthm glcp-generic-obligs-okp-final-implies-start
+  ;;   (implies (and (glcp-generic-geval-ev-theoremp
+  ;;                  (conjoin-clauses
+  ;;                   (acl2::interp-defs-alist-clauses
+  ;;                    (nth *is-obligs*
+  ;;                         (mv-nth 2 (glcp-generic-interp-term-equivs
+  ;;                                    x alist pathcond contexts clk config interp-st bvar-db state))))))
+  ;;                 (not (mv-nth 1 (glcp-generic-interp-term-equivs
+  ;;                                 x alist pathcond contexts clk config interp-st bvar-db state))))
+  ;;            (glcp-generic-geval-ev-theoremp
+  ;;             (conjoin-clauses
+  ;;              (acl2::interp-defs-alist-clauses
+  ;;               (nth *is-obligs* interp-st)))))
+  ;;   :rule-classes :forward-chaining)
+
+  (defthm glcp-generic-obligs-okp-final-implies-start
+    (implies (glcp-generic-geval-ev-theoremp
+              (conjoin-clauses
+               (acl2::interp-defs-alist-clauses
+                (nth *is-obligs*
+                     (mv-nth 2 (glcp-generic-interp-term-equivs
+                                x alist contexts pathcond clk config 
+                                (update-nth *is-obligs* obligs interp-st)
+                                bvar-db st))))))
+             (glcp-generic-geval-ev-theoremp
+              (conjoin-clauses
+               (acl2::interp-defs-alist-clauses obligs))))
+    :hints (("goal" :use ((:instance glcp-generic-interp-bad-obligs-equivs
+                           (interp-st (update-nth *is-obligs* obligs interp-st))))))
+    :rule-classes :forward-chaining)
+
+
+  (defthm assoc-eq-glcp-generic-geval-alist
+    (implies (alistp alist)
+             (equal (cdr (assoc-eq x (glcp-generic-geval-alist alist env)))
+                    (glcp-generic-geval (cdr (hons-assoc-equal x alist))
+                                        env)))
+    :hints(("Goal" :in-theory (enable glcp-generic-geval-alist
+                                      hons-assoc-equal))))
+
+
+  (defthm glcp-generic-geval-lst-general-concrete-obj-list
+    (implies (general-concrete-listp x)
+             (equal (glcp-generic-geval-list x env)
+                    (general-concrete-obj-list x)))
+    :hints(("Goal" :in-theory (e/d (gobj-listp) ()))))
+
+
+  (defthm glcp-generic-geval-ev-nil
+    (equal (glcp-generic-geval-ev nil a) nil))
+
+
+  (defthm glcp-generic-geval-ev-meta-extract-rewrite-rule
+    (implies (and (glcp-generic-geval-ev-theoremp (acl2::rewrite-rule-term rule))
+                  (not (equal (acl2::rewrite-rule->subclass rule) 'acl2::meta))
+                  (glcp-generic-geval-ev (conjoin (acl2::rewrite-rule->hyps
+                                                   rule))
+                                         a)
+                  (equal (acl2::rewrite-rule->equiv rule) 'equal))
+             (equal (glcp-generic-geval-ev
+                     (acl2::rewrite-rule->rhs rule) a)
+                    (glcp-generic-geval-ev
+                     (acl2::rewrite-rule->lhs rule) a)))
+    :hints (("goal" :use ((:instance glcp-generic-geval-ev-falsify
+                           (x (acl2::rewrite-rule-term rule))))
+             :in-theory (enable acl2::rewrite-rule->rhs
+                                acl2::rewrite-rule->lhs
+                                acl2::rewrite-rule->hyps
+                                acl2::rewrite-rule->equiv
+                                acl2::rewrite-rule->subclass)))))
+
+;; (defthm glcp-generic-rewrite-apply-rule-correct
+;;   (let* ((lhs (acl2::rewrite-rule->lhs rule))
+;;          (fn (car lhs))
+;;          (args (cdr lhs))
+;;          (unify-subst (glcp-generic-geval-alist
+;;                        (mv-nth 1 (glcp-unify-term/gobj-list
+;;                                   args actuals nil))
+;;                        env)))
+;;     (implies (and (symbolp fn)
+;;                   (not (eq fn 'quote))
+;;                   (member rule (getprop fn 'acl2::lemmas nil 'current-acl2-world (w state)))
+;;                   (glcp-generic-geval-ev
+;;                    (conjoin (acl2::rewrite-rule->hyps rule))
+;;                    unify-subst)
+;;                   (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+;;                   (equal (w state0) (w state)))
+;;              (equal (glcp-generic-geval-ev
+;;                      (acl2::rewrite-rule->rhs rule)
+;;                      unify-subst)
+;;                     (glcp-generic-geval-ev
+;;                      (cons fn (kwote-lst (glcp-generic-geval actuals env)))
+;;                      nil))))
+;;   :hints (("goal"
+
+
+
+(local (defthm true-listp-cdr-when-pseudo-termp
+         (implies (pseudo-termp x)
+                  (true-listp (cdr x)))
+         :rule-classes :forward-chaining))
+
+(progn
+  (encapsulate nil
+    (local (bfr-reasoning-mode t))
+    (local (acl2::set-bdd-patterns '((hyp-fix . &) 't 'nil)))
+    (defthm bfr-eval-gtests-unknown
+      (implies (and (not (hf (gtests-unknown (gtests test hyp))))
+                    (bfr-eval hyp env))
+               (not (bfr-eval (gtests-unknown (gtests test hyp)) env))))
+
+    (defthm bfr-eval-gtests-unknown-or
+      (implies (and (not (hf (bfr-or (gtests-unknown (gtests test hyp)) other)))
+                    (bfr-eval hyp env))
+               (not (bfr-eval (gtests-unknown (gtests test hyp)) env))))
+
+
+    (defthm geval-of-interp-res-hyp-fix-unknown-false
+      (implies (and (not (glcp-generic-geval interp-res env))
+                    (bfr-eval hyp (car env)))
+               (hyp-fix (bfr-or
+                         (gtests-unknown (gtests interp-res hyp))
+                         (bfr-not
+                          (gtests-nonnil (gtests interp-res hyp))))
+                        hyp)))
+
+    (defthm geval-of-interp-res-hyp-fix-unknown-true
+      (implies (and (glcp-generic-geval interp-res env)
+                    (bfr-eval hyp (car env)))
+               (hyp-fix (bfr-or
+                         (gtests-unknown (gtests interp-res hyp))
+                         (gtests-nonnil (gtests interp-res hyp)))
+                        hyp)))
+
+    (defthm gtests-nonnil-or-not
+      (implies
+       (and
+        (bfr-eval hyp (car env))
+        (not
+         (hyp-fix
+          (bfr-or
+           (gtests-unknown (gtests test hyp))
+           (gtests-nonnil (gtests test hyp)))
+          hyp)))
+       (hyp-fix
+        (bfr-or
+         (gtests-unknown (gtests test hyp))
+         (bfr-not (gtests-nonnil (gtests test hyp))))
+        hyp)))
+
+    (defthmd gtests-known-and-true
+      (implies (and (bfr-eval hyp (car env))
+                    (equal (gtests-unknown (gtests gobj hyp)) nil)
+                    (equal (glcp-generic-geval gobj env) nil))
+               (not (equal (gtests-nonnil (gtests gobj hyp)) t)))
+      :hints (("goal" :use ((:instance
+                             geval-of-interp-res-hyp-fix-unknown-false
+                             (interp-res gobj)))
+               :in-theory (e/d (hyp-fix)
+                               (geval-of-interp-res-hyp-fix-unknown-false))))))
+
+
+  (defthm len-kwote-lst
+    (equal (len (kwote-lst x))
+           (len x)))
+
+  (defthm glcp-generic-geval-ev-lst-kwote-lst
+    (equal (glcp-generic-geval-ev-lst (kwote-lst args) a)
+           (acl2::list-fix args)))
+
+  (defcong acl2::list-equiv equal (pairlis$ x y) 2)
+
+  (defthm glcp-generic-interp-function-lookup-correct-special
+    (mv-let (erp body formals out-defs)
+      (acl2::interp-function-lookup fn in-defs overrides (w state))
+      (implies (and (not erp)
+                    (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses out-defs)))
+                    (acl2::interp-defs-alistp in-defs)
+                    (acl2::interp-defs-alistp overrides)
+                    (equal (len formals) (len actuals))
+                    (not (eq fn 'quote))
+                    (glcp-generic-geval-ev-meta-extract-global-facts :state state1)
+                    (equal (w state) (w state1)))
+               (equal (glcp-generic-geval-ev body (pairlis$ formals actuals))
+                      (glcp-generic-geval-ev (cons fn (kwote-lst actuals))
+                                             nil))))
+    :hints (("goal" :use ((:instance
+                           glcp-generic-interp-function-lookup-correct
+                           (acl2::actuals (kwote-lst actuals))
+                           (acl2::overrides overrides)
+                           (acl2::fn fn)
+                           (a nil)
+                           (state state1)
+                           (acl2::in-defs in-defs)))
+             :in-theory (enable interp-defs-ok))))
+
+  (defthm glcp-generic-geval-ev-magic-ev-fncall-special
+    (b* (((mv erp val)
+          (acl2::magic-ev-fncall f args st t nil)))
+      (implies (and (glcp-generic-geval-ev-meta-extract-global-facts)
+                    (equal (w st) (w state))
+                    (not erp))
+               (equal val
+                      (glcp-generic-geval-ev (cons f (kwote-lst args)) nil))))
+    :hints(("Goal" :in-theory (enable glcp-generic-geval-ev-meta-extract-fncall))))
+
+  (in-theory (disable glcp-generic-geval-ev-meta-extract-fncall)))
+
+
+(defun-sk glcp-generic-bvar-db-env-ok (bvar-db p bound env)
+  (forall n
+          (implies (and (<= (base-bvar$a bvar-db) (nfix n))
+                        (< (nfix n) bound)
+                        (< (nfix n) (next-bvar$a bvar-db)))
+                   (iff (bfr-lookup
+                         n (bfr-unparam-env p (car env)))
+                        (glcp-generic-geval (get-bvar->term$a n bvar-db) env))))
+  :rewrite :direct)
+
+
+;; (defthm bfr-lookup-when-glcp-generic-bvar-db-env-ok
+;;   (implies (and (glcp-generic-bvar-db-env-ok bvar-db config env)
+;;                 (<= (base-bvar bvar-db) (nfix n))
+;;                 (< (nfix n) (next-bvar bvar-db)))
+;;            (iff (bfr-lookup n
+;;                             (bfr-unparam-env (glcp-config->param-bfr config) (car env)))
+;;                 (glcp-generic-geval (get-bvar->term$a n bvar-db) env)))
+;;   :hints (("goal" :use ((:instance glcp-generic-bvar-db-env-ok-necc
+;;                          (x (get-bvar->term$a n bvar-db))))
+;;            :in-theory (disable glcp-generic-bvar-db-env-ok-necc
+;;                                bfr-to-param-space))))
+
+(in-theory (disable glcp-generic-bvar-db-env-ok))
+
+(defthm glcp-generic-bvar-db-env-ok-of-add-term-bvar
+  (implies (<= bound (next-bvar$a bvar-db))
+           (equal (glcp-generic-bvar-db-env-ok (add-term-bvar$a x bvar-db)
+                                               p bound env)
+                  (glcp-generic-bvar-db-env-ok bvar-db p bound env)))
+  :hints (("goal" :cases ((glcp-generic-bvar-db-env-ok (add-term-bvar$a x bvar-db)
+                                                       p bound env)))
+          (and stable-under-simplificationp
+               (if (eq (caar clause) 'not)
+                   `(:expand (,(car (last clause))))
+                 `(:expand (,(car clause)))))))
+
+(defthm glcp-generic-bvar-db-env-ok-of-add-term-equiv
+  (equal (glcp-generic-bvar-db-env-ok (add-term-equiv x n bvar-db)
+                                      p bound env)
+         (glcp-generic-bvar-db-env-ok bvar-db p bound env))
+  :hints (("goal" :cases ((glcp-generic-bvar-db-env-ok (add-term-equiv x n bvar-db)
+                                                       p bound env)))
+          (and stable-under-simplificationp
+               (if (eq (caar clause) 'not)
+                   `(:expand (,(car (last clause))))
+                 `(:expand (,(car clause)))))))
+
+(defthm glcp-generic-bvar-db-env-ok-of-add-term-bvar-next
+  (implies (not (glcp-generic-bvar-db-env-ok bvar-db p (next-bvar$a bvar-db) env))
+           (not (glcp-generic-bvar-db-env-ok (add-term-bvar$a x bvar-db)
+                                             p (+ 1 (next-bvar$a bvar-db)) env)))
+  :hints (("goal" :expand ((glcp-generic-bvar-db-env-ok bvar-db p (next-bvar$a bvar-db) env)))))
+
+;; (defthm glcp-generic-bvar-db-env-ok-of-add-term-bvar
+;;   (implies (not (glcp-generic-bvar-db-env-ok bvar-db p bound env))
+;;            (not (glcp-generic-bvar-db-env-ok (add-term-bvar$a x bvar-db)
+;;                                              p bound env)))
+;;   :hints (("goal" :use ((:instance glcp-generic-bvar-db-env-ok-necc
+;;                          (bvar-db (add-term-bvar$a x bvar-db))
+;;                          (n (glcp-generic-bvar-db-env-ok-witness
+;;                              bvar-db p bound env))))
+;;            :expand ((glcp-generic-bvar-db-env-ok bvar-db p bound env))
+;;            :in-theory (disable glcp-generic-bvar-db-env-ok-necc))))
+
+(defthm glcp-generic-bvar-db-env-ok-bound-decr
+  (implies (and (glcp-generic-bvar-db-env-ok bvar-db p bound1 env)
+                (<= bound bound1))
+           (glcp-generic-bvar-db-env-ok bvar-db p bound env))
+  :hints (("goal" :expand ((glcp-generic-bvar-db-env-ok bvar-db p bound env)))))
+
+(encapsulate nil
+  (local (in-theory (disable* (:rules-of-class :type-prescription :here)
+                              pseudo-termp
+                             len
+                             ; acl2::nfix-when-natp
+                             no-duplicatesp-equal
+                             fgetprop
+                             general-concrete-listp
+                             member-equal
+                             hons-assoc-equal pairlis$ last
+                             pseudo-term-listp
+                             symbol-listp
+                             pseudo-termp-symbolp-car-x
+                             ; glcp-generic-interp-term-ok-obligs
+                             hyp-fix-of-hyp-fixedp
+                             nfix
+                             default-<-2
+                             default-<-1
+                             default-car default-cdr
+                             ;; rationalp-implies-acl2-numberp
+                             ;; acl2::cancel_plus-lessp-correct
+                             general-concrete-obj-list
+                             ; acl2::nfix-when-not-natp
+                             acl2::cancel_times-equal-correct
+                             acl2::cancel_plus-equal-correct)))
+
+  (defthm base-bvar-of-maybe-add-equiv-term
+    (equal (base-bvar$a (maybe-add-equiv-term test-obj bvar bvar-db state))
+           (base-bvar$a bvar-db))
+    :hints(("Goal" :in-theory (enable maybe-add-equiv-term))))
+
+  (defthm next-bvar-of-maybe-add-equiv-term
+    (equal (next-bvar$a (maybe-add-equiv-term test-obj bvar bvar-db state))
+           (next-bvar$a bvar-db))
+    :hints(("Goal" :in-theory (enable maybe-add-equiv-term))))
+
+  (defthm get-term->bvar-of-maybe-add-equiv-term
+    (equal (get-term->bvar$a x (maybe-add-equiv-term test-obj bvar bvar-db state))
+           (get-term->bvar$a x bvar-db))
+    :hints(("Goal" :in-theory (enable maybe-add-equiv-term))))
+
+  (defthm get-bvar->term-of-maybe-add-equiv-term
+    (equal (get-bvar->term$a x (maybe-add-equiv-term test-obj bvar bvar-db state))
+           (get-bvar->term$a x bvar-db))
+    :hints(("Goal" :in-theory (enable maybe-add-equiv-term))))
+
+  (def-glcp-interp-thm glcp-generic-interp-base-bvar-preserved
+    :body (equal (base-bvar$a bvar-db1) (base-bvar$a bvar-db))
+    :expand-calls t)
+
+  (def-glcp-interp-thm glcp-generic-interp-next-bvar-incr
+    :body (>= (next-bvar$a bvar-db1) (next-bvar$a bvar-db))
+    :rule-classes :linear
+    :expand-calls t)
+
+  (def-glcp-interp-thm glcp-generic-interp-get-bvar->term-preserved
+    :body (implies (and (<= (base-bvar$a bvar-db) (nfix n))
+                        (< (nfix n) (next-bvar$a bvar-db)))
+                   (equal (get-bvar->term$a n bvar-db1)
+                          (get-bvar->term$a n bvar-db)))
+    :expand-calls t)
+
+  (def-glcp-interp-thm glcp-generic-interp-get-term->bvar-preserved
+    :body (implies (get-term->bvar$a n bvar-db)
+                   (equal (get-term->bvar$a n bvar-db1)
+                          (get-term->bvar$a n bvar-db)))
+    :expand-calls t))
+
+(encapsulate nil
+  (local (in-theory (disable* pseudo-termp pseudo-term-listp
+                              pseudo-termp-car
+                              default-<-2 default-<-1 fgetprop
+                              len
+                              hons-assoc-equal
+                              (:rules-of-class :type-prescription :here))))
+
+  (defthm glcp-generic-interp-bvar-db-env-ok-of-maybe-add-equiv-term
+    (equal (glcp-generic-bvar-db-env-ok
+            (maybe-add-equiv-term test-obj bvar bvar-db state)
+            p bound env)
+           (glcp-generic-bvar-db-env-ok bvar-db p bound env))
+    :hints(("Goal" :in-theory (enable maybe-add-equiv-term))))
+
+  (local (deflabel pre-env-ok-preserved))
+
+  (def-glcp-interp-thm glcp-generic-interp-bvar-db-env-ok-preserved
+    :hyps (<= bound (next-bvar$a bvar-db))
+    :body (equal (glcp-generic-bvar-db-env-ok bvar-db1 p bound env)
+                 (glcp-generic-bvar-db-env-ok bvar-db p bound env))
+    :expand-calls t)
+
+  (def-ruleset! env-ok-preserved-rules
+    (set-difference-theories
+     (current-theory :here)
+     (current-theory 'pre-env-ok-preserved)))
+
+  (local (deflabel pre-env-ok-special))
+
+  (def-glcp-interp-thm glcp-generic-interp-bvar-db-preserved-special
+    :hyps (and ;; (syntaxp ((lambda (mfc state)
+               ;;             (assoc 'glcp-generic-bvar-db-env-ok
+               ;;                 (mfc-clause mfc)))
+               ;;           mfc state))
+               (not (glcp-generic-bvar-db-env-ok bvar-db p (next-bvar$a bvar-db) env)))
+    :body (not (glcp-generic-bvar-db-env-ok bvar-db1 p (next-bvar$a bvar-db1) env))
+    :expand-calls t)
+
+  (def-ruleset! env-ok-special-rules
+    (set-difference-theories
+     (current-theory :here)
+     (current-theory 'pre-env-ok-special)))
+
+  (in-theory (disable* env-ok-preserved-rules
+                       env-ok-special-rules)))
+
+(local (in-theory (disable bfr-to-param-space)))
+
+
+(encapsulate nil
+  (defthm glcp-generic-eval-context-equiv-nil
+    (equal (glcp-generic-eval-context-equiv
+            nil a b)
+           (equal a b))
+    :hints(("Goal" :in-theory (enable glcp-generic-eval-context-equiv))))
+
+  (defthm glcp-generic-eval-context-equiv-refl
+    (glcp-generic-eval-context-equiv
+     equivs a a)
+    :hints(("Goal" :in-theory (enable glcp-generic-eval-context-equiv))))
+
+  (local (defthm glcp-generic-eval-context-equiv-chain-nil
+           (implies (and (glcp-generic-eval-context-equiv-chain
+                          nil x)
+                         (equal (car x) a)
+                         (equal (car (last x)) b))
+                    (equal (equal a b) t))
+           :hints(("Goal" :in-theory (enable glcp-generic-eval-context-equiv-chain)))))
+
+  (defthm glcp-generic-eval-context-equiv*-nil
+    (equal (glcp-generic-eval-context-equiv* nil a b)
+           (equal a b))
+    :hints (("goal" :use ((:instance glcp-generic-eval-context-equiv*-suff
+                           (x a) (y b) (chain (list a)) (contexts nil)))
+             :in-theory (disable glcp-generic-eval-context-equiv*-suff)
+             :expand ((glcp-generic-eval-context-equiv* nil a b))))))
+
+(defsection iff*
+  (defund iff* (x y)
+    (iff x y))
+  (defequiv iff* :hints(("Goal" :in-theory (enable iff*))))
+  (defrefinement iff iff* :hints(("Goal" :in-theory (enable iff*))))
+  (defrefinement iff* iff :hints(("Goal" :in-theory (enable iff*))))
+
+  (defthm iff*-of-nonnils
+    (implies (and x y)
+             (equal (iff* x y) t))
+    :hints(("Goal" :in-theory (enable iff*)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(encapsulate nil
+  (defthm glcp-generic-eval-context-equiv-iff
+    (equal (glcp-generic-eval-context-equiv
+            '(iff) a b)
+           (iff* a b))
+    :hints(("Goal" :in-theory (enable glcp-generic-eval-context-equiv))))
+
+  (local (defthmd glcp-generic-eval-context-equiv-chain-iff
+           (implies (and (glcp-generic-eval-context-equiv-chain
+                          '(iff) x)
+                         (equal (car x) a)
+                         (equal (car (last x)) b))
+                    (equal (iff* a b) t))
+           :hints(("Goal" :in-theory (enable glcp-generic-eval-context-equiv-chain)))))
+
+  (defthm glcp-generic-eval-context-equiv*-iff
+    (equal (glcp-generic-eval-context-equiv* '(iff) a b)
+           (iff* a b))
+    :hints (("goal" :use ((:instance glcp-generic-eval-context-equiv*-suff
+                           (x a) (y b) (chain (list a b)) (contexts '(iff)))
+                          (:instance glcp-generic-eval-context-equiv-chain-iff
+                           (x (glcp-generic-eval-context-equiv*-witness
+                               '(iff) a b))))
+             :in-theory (disable glcp-generic-eval-context-equiv*-suff)
+             :expand ((glcp-generic-eval-context-equiv* '(iff) a b)
+                      (glcp-generic-eval-context-equiv* '(iff) a nil)
+                      (glcp-generic-eval-context-equiv* '(iff) nil b))))))
+
+
+
+
+
+
+
+(defthm glcp-generic-eval-context-equiv-of-rewrites
+  (implies (and (glcp-generic-geval-ev-theoremp (acl2::rewrite-rule-term rule))
+                (not (equal (acl2::rewrite-rule->subclass rule) 'acl2::meta))
+                (glcp-generic-geval-ev (conjoin (acl2::rewrite-rule->hyps
+                                                 rule))
+                                       a)
+                (proper-contextsp contexts)
+                (symbolp (acl2::rewrite-rule->equiv rule))
+                (not (eq (acl2::rewrite-rule->equiv rule) 'quote))
+                (member (acl2::rewrite-rule->equiv rule) contexts)
+                (equal lhs (glcp-generic-geval-ev
+                            (acl2::rewrite-rule->lhs rule) a)))
+           (glcp-generic-eval-context-equiv
+            contexts
+            (glcp-generic-geval-ev
+             (acl2::rewrite-rule->rhs rule) a)
+            lhs))
+  :hints (("goal" :induct (len contexts)
+           :in-theory (disable acl2::rewrite-rule-term)
+           :expand ((:free (a b) (glcp-generic-eval-context-equiv contexts a
+                                                                  b))))
+          (and stable-under-simplificationp
+               '(:use ((:instance glcp-generic-geval-ev-falsify
+                        (x (acl2::rewrite-rule-term rule))))
+             :in-theory (e/d ( ;; acl2::rewrite-rule->rhs
+                                ;; acl2::rewrite-rule->lhs
+                                ;; acl2::rewrite-rule->hyps
+                                ;; acl2::rewrite-rule->equiv
+                                ;; acl2::rewrite-rule->subclass
+                                rewrite-rule-term-alt-def
+                                glcp-generic-geval-ev-of-fncall-args)
+                             (acl2::rewrite-rule-term))))))
+
+(encapsulate nil
+  (defthmd glcp-generic-eval-context-equiv*-when-equiv
+    (implies (glcp-generic-eval-context-equiv contexts x y)
+             (glcp-generic-eval-context-equiv* contexts x y))
+    :hints (("goal" :use ((:instance glcp-generic-eval-context-equiv*-suff
+                           (chain (list x y))))
+             :in-theory (disable glcp-generic-eval-context-equiv*-suff))))
+
+  (local (in-theory (enable glcp-generic-eval-context-equiv*-when-equiv)))
+
+  (defthm glcp-generic-eval-context-equiv*-of-rewrites
+    (implies (and (glcp-generic-geval-ev-theoremp (acl2::rewrite-rule-term rule))
+                  (not (equal (acl2::rewrite-rule->subclass rule) 'acl2::meta))
+                  (glcp-generic-geval-ev (conjoin (acl2::rewrite-rule->hyps
+                                                   rule))
+                                         a)
+                  (proper-contextsp contexts)
+                  (symbolp (acl2::rewrite-rule->equiv rule))
+                  (not (eq (acl2::rewrite-rule->equiv rule) 'quote))
+                  (member (acl2::rewrite-rule->equiv rule) contexts)
+                  (equal lhs (glcp-generic-geval-ev
+                              (acl2::rewrite-rule->lhs rule) a)))
+             (glcp-generic-eval-context-equiv*
+              contexts
+              (glcp-generic-geval-ev
+               (acl2::rewrite-rule->rhs rule) a)
+              lhs))))
+
+
+(defsection bvar-db-depends-on
+  (defund-nx bvar-db-depends-on (k p n bvar-db)
+    (declare (xargs :measure (nfix n)))
+    (if (<= (nfix n) (base-bvar bvar-db))
+        nil
+      (or (gobj-depends-on k p (get-bvar->term (1- (nfix n)) bvar-db))
+          (bvar-db-depends-on k p (1- (nfix n)) bvar-db))))
+
+  (local (in-theory (enable bvar-db-depends-on)))
+  (local (include-book "centaur/misc/arith-equivs" :dir :system))
+
+  (defthm gobj-depends-on-of-get-bvar->term
+    (implies (and (<= (base-bvar bvar-db) (nfix m))
+                  (not (bvar-db-depends-on k p n bvar-db))
+                  (< (nfix m) (next-bvar bvar-db))
+                  (< (nfix m) (nfix n)))
+             (not (gobj-depends-on k p (get-bvar->term$a m bvar-db))))))
+
+(defsection check-equiv-replacement
+
+  (local (in-theory (enable check-equiv-replacement)))
+
+  (local (defthmd context-equiv-term-when-member-equivs
+           (implies (and (glcp-generic-geval-ev (list equiv (kwote x) (kwote y)) a)
+                         (symbolp equiv)
+                         (not (eq equiv 'quote))
+                         (member equiv contexts))
+                    (glcp-generic-eval-context-equiv contexts x y))
+           :hints(("Goal" :in-theory (enable member
+                                             glcp-generic-eval-context-equiv
+                                             glcp-generic-geval-ev-of-fncall-args)))))
+
+  (local (Defthm equal-of-len
+           (implies (syntaxp (quotep y))
+                    (equal (equal (len x) y)
+                           (if (zp y)
+                               (and (equal y 0)
+                                    (atom x))
+                             (and (consp x)
+                                  (equal (len (cdr x)) (1- y))))))))
+
+  (local (include-book "arithmetic/top-with-meta" :dir :system))
+
+
+  (local (defthm check-equiv-replacement-correct1
+           (b* (((mv ok replacement negp)
+                 (check-equiv-replacement x equiv-term contexts state)))
+             (implies (and (proper-contextsp contexts)
+                           ok
+                           (xor negp (glcp-generic-geval equiv-term env)))
+                      (glcp-generic-eval-context-equiv
+                       contexts
+                       (glcp-generic-geval replacement env)
+                       (glcp-generic-geval x env))))
+           :hints (("goal" :expand ((:with glcp-generic-geval
+                                     (glcp-generic-geval equiv-term env)))
+                    :in-theory (enable glcp-generic-geval-list
+                                       glcp-generic-eval-context-equiv-commute)
+                    :use ((:instance context-equiv-term-when-member-equivs
+                           (equiv (g-apply->fn equiv-term))
+                           (x (glcp-generic-geval (car (g-apply->args equiv-term)) env))
+                           (y (glcp-generic-geval (cadr (g-apply->args equiv-term)) env))
+                           (a nil)))))))
+
+  (defthmd glcp-generic-eval-context-equiv*-when-equiv
+    (implies (glcp-generic-eval-context-equiv contexts x y)
+             (glcp-generic-eval-context-equiv* contexts x y))
+    :hints (("goal" :use ((:instance glcp-generic-eval-context-equiv*-suff
+                           (chain (list x y))))
+             :in-theory (disable glcp-generic-eval-context-equiv*-suff))))
+
+  (defthm check-equiv-replacement-correct
+    (b* (((mv ok replacement negp) (check-equiv-replacement x equiv-term contexts state)))
+      (implies (and (proper-contextsp contexts)
+                    ok
+                    (xor negp (glcp-generic-geval equiv-term env)))
+               (glcp-generic-eval-context-equiv*
+                contexts
+                (glcp-generic-geval replacement env)
+                (glcp-generic-geval x env))))
+    :hints (("goal"
+             :in-theory (e/d (glcp-generic-eval-context-equiv*-when-equiv)
+                             (check-equiv-replacement)))))
+
+  (defthm check-equiv-replacement-depends-on
+    (b* (((mv ok replacement) (check-equiv-replacement x equiv-term contexts state)))
+      (implies (and ok
+                    (not (gobj-depends-on k p equiv-term)))
+               (not (gobj-depends-on k p replacement))))))
+
+
+(defsection try-equivalences
+  (local (in-theory (enable try-equivalences)))
+
+  (defthm try-equivalences-correct
+    (b* (((mv ok repl) (try-equivalences x bvars pathcond contexts p bvar-db state)))
+      (implies (and (bfr-eval pathcond (car env))
+                    (glcp-generic-bvar-db-env-ok bvar-db p (next-bvar$a bvar-db) env)
+                    ok
+                    (bvar-listp bvars bvar-db)
+                    (proper-contextsp contexts))
+               (glcp-generic-eval-context-equiv* contexts
+                                                 (glcp-generic-geval repl env)
+                                                 (glcp-generic-geval x env))))
+    :hints (("goal" :induct (try-equivalences x bvars pathcond contexts p bvar-db state)
+             :expand ((bvar-listp$a bvars bvar-db)))
+            (and stable-under-simplificationp
+                 '(:use ((:instance true-under-hyp-point
+                          (x (hyp-fix
+                              (bfr-to-param-space
+                               p (bfr-var (car bvars)))
+                              pathcond))
+                          (hyp pathcond)
+                          (v (car env)))
+                         (:instance false-under-hyp-point
+                          (x (hyp-fix
+                              (bfr-to-param-space
+                               p (bfr-var (car bvars)))
+                              pathcond))
+                          (hyp pathcond)
+                          (v (car env))))))))
+
+  (defthm try-equivalences-depends-on
+    (b* (((mv ok repl) (try-equivalences x bvars pathcond contexts pp bvar-db state)))
+      (implies (and ok
+                    (bvar-listp bvars bvar-db)
+                    (not (bvar-db-depends-on k p (next-bvar$a bvar-db) bvar-db)))
+               (not (gobj-depends-on k p repl))))
+    :hints (("goal" :induct (try-equivalences x bvars pathcond contexts pp bvar-db state)
+             :expand ((bvar-listp bvars bvar-db))))))
+
+(defsection try-equivalences-loop
+  (local (in-theory (enable try-equivalences-loop)))
+
+  (defthm try-equivalences-loop-correct
+    (b* (((mv ?er repl)
+          (try-equivalences-loop x pathcond contexts clk p bvar-db state)))
+      (implies (and (bfr-eval pathcond (car env))
+                    (glcp-generic-bvar-db-env-ok bvar-db p (next-bvar$a bvar-db) env)
+                    (proper-contextsp contexts))
+               (glcp-generic-eval-context-equiv* contexts
+                                                 (glcp-generic-geval repl env)
+                                                 (glcp-generic-geval x env))))
+    :hints (("goal" :induct (try-equivalences-loop x pathcond contexts clk p bvar-db state))
+            (and stable-under-simplificationp
+                 '(:use ((:instance try-equivalences-correct
+                          (bvars (get-term->equivs x bvar-db))))
+                   :in-theory (disable try-equivalences-correct)))))
+
+  (defthm try-equivalences-loop-depends-on
+    (b* (((mv ?er repl) (try-equivalences-loop x pathcond contexts clk pp bvar-db state)))
+      (implies (and (not (gobj-depends-on k p x))
+                    (not (bvar-db-depends-on k p (next-bvar$a bvar-db) bvar-db)))
+               (not (gobj-depends-on k p repl)))))
+
+  (defthm try-equivalences-loop-special
+    (b* (((mv ?er repl)
+          (try-equivalences-loop x pathcond contexts clk p bvar-db state)))
+      (implies (and (bfr-eval pathcond (car env))
+                    (glcp-generic-bvar-db-env-ok bvar-db p (next-bvar$a bvar-db) env)
+                    (proper-contextsp contexts)
+                    (glcp-generic-eval-context-equiv*
+                     contexts (glcp-generic-geval x env) y))
+               (glcp-generic-eval-context-equiv* contexts
+                                                 (glcp-generic-geval repl env)
+                                                 y)))
+    :hints(("Goal" :in-theory (e/d (glcp-generic-eval-context-equiv*-trans)
+                                   (try-equivalences-loop-correct))
+            :use try-equivalences-loop-correct
+            :do-not-induct t))))
+
+(defsection glcp-or-test-contexts
+  (defthmd glcp-context-equiv-of-glcp-or-test-contexts
+    (equal (glcp-generic-eval-context-equiv*
+            (glcp-or-test-contexts contexts) x y)
+           (and (hide (glcp-generic-eval-context-equiv*
+                       (glcp-or-test-contexts contexts) x y))
+                (iff* x y)
+                (glcp-generic-eval-context-equiv*
+                 contexts x y)))
+    :hints (("goal" :expand ((:free (x) (hide x))))))
+
+  (defthm proper-contextsp-of-glcp-or-test-contexts
+    (proper-contextsp (glcp-or-test-contexts contexts))
+    :hints(("Goal" :in-theory (e/d (glcp-generic-equiv-relp)
+                                   ((proper-contextsp))))))
+
+  (defthm contextsp-of-glcp-or-test-contexts
+    (contextsp (glcp-or-test-contexts contexts))))
+
+
+
+
+(defun id-on-the-way-to (id dest-id)
+  (and
+   ;; same induction step
+   (equal (car id) (car dest-id))
+   ;; case splits
+   (acl2::prefixp (cadr id) (cadr dest-id))))
+
+
+(defsection glcp-interp-accs-ok
+
+  (defund-nx glcp-interp-accs-ok (interp-st bvar-db config env)
+    (and (glcp-generic-geval-ev-theoremp
+          (conjoin-clauses
+           (acl2::interp-defs-alist-clauses (is-obligs interp-st))))
+         (glcp-generic-bvar-db-env-ok
+          bvar-db (glcp-config->param-bfr config)
+          (next-bvar bvar-db) env)))
+
+  (local (in-theory (enable glcp-interp-accs-ok)))
+
+  (def-glcp-interp-thm glcp-generic-interp-accs-ok
+    :hyps (not (glcp-interp-accs-ok interp-st bvar-db config env))
+    :body (not (glcp-interp-accs-ok interp-st1 bvar-db1 config env))
+    :hints(("Goal" :in-theory (enable* env-ok-special-rules)))
+    :no-induction-hint t)
+
+  (defthm glcp-interp-accs-ok-of-maybe-add-equiv-term
+    (equal (glcp-interp-accs-ok
+            interp-st
+            (maybe-add-equiv-term test-obj bvar bvar-db state) config env)
+           (glcp-interp-accs-ok interp-st bvar-db config env))
+    :hints(("Goal" :in-theory (enable maybe-add-equiv-term))))
+
+  (defthm glcp-interp-accs-ok-implies
+    (implies (glcp-interp-accs-ok interp-st bvar-db config env)
+             (and (glcp-generic-geval-ev-theoremp
+                   (conjoin-clauses
+                    (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st))))
+                  (glcp-generic-bvar-db-env-ok
+                   bvar-db (glcp-config->param-bfr config)
+                   (next-bvar$a bvar-db) env))))
+
+  (defthm glcp-interp-accs-ok-of-add-term-bvar
+    (implies (not (glcp-interp-accs-ok interp-st bvar-db config env))
+             (not (glcp-interp-accs-ok interp-st (add-term-bvar$a x bvar-db)
+                                       config env))))
+
+  (defthm glcp-interp-accs-ok-env-ok-necc
+    (implies (and (glcp-interp-accs-ok interp-st bvar-db config env)
+                  (<= (base-bvar$a bvar-db) (nfix n))
+                  (< (nfix n) (next-bvar$a bvar-db)))
+             (iff (bfr-lookup
+                   n (bfr-unparam-env (glcp-config->param-bfr config) (car env)))
+                  (glcp-generic-geval (get-bvar->term$a n bvar-db) env))))
+
+  (defthm glcp-interp-accs-ok-interp-function-lookup
+     (b* (((mv erp & & out-defs)
+           (acl2::interp-function-lookup fn (nth *is-obligs* interp-st) overrides world)))
+       (implies (and (not (glcp-interp-accs-ok interp-st bvar-db config env))
+                     (not erp))
+                (not (glcp-interp-accs-ok
+                      (update-nth *is-obligs* out-defs interp-st)
+                      bvar-db config env)))))
+
+  (defthm glcp-interp-accs-ok-interp-function-lookup-correct
+    (mv-let (erp body formals out-defs)
+      (acl2::interp-function-lookup fn (nth *is-obligs* interp-st) overrides (w state))
+      (implies (and (glcp-interp-accs-ok
+                     (update-nth *is-obligs* out-defs interp-st)
+                     bvar-db config env)
+                    (not erp)
+                    (acl2::interp-defs-alistp (nth *is-obligs* interp-st))
+                    (acl2::interp-defs-alistp overrides)
+                    (equal (len formals) (len actuals))
+                    (not (eq fn 'quote))
+                    (glcp-generic-geval-ev-meta-extract-global-facts :state state1)
+                    (equal (w state) (w state1)))
+               (equal (glcp-generic-geval-ev body (pairlis$ formals actuals))
+                      (glcp-generic-geval-ev (cons fn (kwote-lst actuals))
+                                             nil)))))
+
+  (defthm glcp-interp-accs-ok-final-implies-start
+    (b* (((mv & & interp-st1 bvar-db1 &)
+          (glcp-generic-interp-term-equivs
+           x alist contexts pathcond clk config 
+           interp-st bvar-db st)))
+      (implies (glcp-interp-accs-ok interp-st1 bvar-db1 confing env)
+               (glcp-interp-accs-ok interp-st bvar-db confing env)))
+    :hints(("Goal" :in-theory (enable* env-ok-special-rules)))
+    :rule-classes :forward-chaining))
+
+  
+
+
+(local (include-book "centaur/misc/arith-equivs" :dir :system))
+(local (include-book "clause-processors/constant-prop" :dir :System))
+
+(defsection bvar-in-range
+  (defund bvar-in-range (k bvar-db)
+    (declare (Xargs :stobjs bvar-db))
+    (and (<= (base-bvar bvar-db) (nfix k))
+         (< (nfix k) (next-bvar bvar-db))))
+
+  (local (in-theory (enable bvar-in-range)))
+
+
+  (defthm maybe-add-equiv-term-bvar-in-range-preserved
+    (implies (bvar-in-range k bvar-db)
+             (bvar-in-range k (maybe-add-equiv-term
+                               term bvar bvar-db state))))
+
+  (defthm maybe-add-equiv-term-bvar-in-range-preserved-fwd
+    (implies (not (bvar-in-range k (maybe-add-equiv-term
+                                    term bvar bvar-db state)))
+             (not (bvar-in-range k bvar-db)))
+    :rule-classes :forward-chaining)
+
+  (defthm add-term-bvar-bvar-in-range-preserved
+    (implies (bvar-in-range k bvar-db)
+             (bvar-in-range k (add-term-bvar$a term bvar-db))))
+
+  (defthm not-in-range-implies-not-equal-get-term->bvar
+    (implies (not (bvar-in-range k bvar-db))
+             (not (equal (nfix k) (get-term->bvar$a term bvar-db))))
+    :hints (("goal" :cases ((get-term->bvar$a term bvar-db)))))
+
+  (defun find-good-add-term-bvar$a-term (bvar-db calls)
+    (if (atom calls)
+        nil
+      (b* ((bdb1 (caddr (car calls)))
+           (add-term-call (acl2::find-call 'add-term-bvar$a bdb1)))
+        (if (and add-term-call
+                 (equal bvar-db (caddr add-term-call)))
+            `((bvar-db1 . ,bdb1))
+          (find-good-add-term-bvar$a-term bvar-db (cdr calls))))))
+
+  (defun find-add-term-bvar$a-term (bvar-db mfc state)
+    (declare (xargs :mode :program :stobjs state)
+             (ignorable state))
+    (b* ((calls (acl2::find-calls-lst 'bvar-in-range (mfc-clause mfc))))
+      (find-good-add-term-bvar$a-term bvar-db calls)))
+
+  (defthm not-in-range-implies-not-equal-next-bvar$a-bind-free
+    (implies (and (bind-free (find-add-term-bvar$a-term bvar-db mfc state) (bvar-db1))
+                  (not (bvar-in-range k bvar-db1))
+                  (equal (base-bvar bvar-db) (base-bvar bvar-db1))
+                  (< (next-bvar bvar-db) (next-bvar bvar-db1)))
+             (not (equal (nfix k) (next-bvar$a bvar-db))))
+    :hints (("goal" :cases ((get-term->bvar$a term bvar-db)))))
+
+  
+
+  (local (in-theory (disable bvar-in-range)))
+  
+  (local (in-theory (disable pseudo-termp
+                             pseudo-term-listp
+                             len
+                             fgetprop
+                             last
+                             no-duplicatesp-equal
+                             symbol-listp
+                             general-concrete-obj-list
+                             member-equal
+                             default-car default-cdr
+                             hons-assoc-equal)))
+
+  (def-glcp-interp-thm bvar-in-range-preserved
+    :body (implies (bvar-in-range k bvar-db)
+                   (bvar-in-range k bvar-db1))
+    :expand-calls t))
+
+
+(encapsulate nil
+
+  (local (defthm gobj-alist-depends-on-nil
+           (not (gobj-alist-depends-on k p nil))))
+
+  (local (in-theory (disable pseudo-termp
+                             pseudo-termp-symbolp-car-x
+                             gbc-process-new-lit
+                             gbc-db-emptyp-implies-no-dependencies
+                             tag-when-atom
+; glcp-generic-interp-term-ok-obligs
+                             (:t hyp-fix) (:t hyp-fixedp)
+                             hyp-fix-of-hyp-fixedp
+                             acl2::nfix-when-not-natp
+                             acl2::natp-when-integerp
+                             acl2::natp-rw
+                             default-cdr
+                             acl2::natp-when-gte-0
+                             default-<-1
+                             default-<-2
+                             not len
+                             pbfr-depends-on-t
+                             acl2::cancel_plus-lessp-correct
+                             acl2::cancel_plus-equal-correct
+                             rationalp-implies-acl2-numberp
+                             gobj-depends-on
+                             glcp-or-test-contexts
+                             gobj-alist-depends-on
+                             acl2::cancel_times-equal-correct
+                             acl2::cancel_plus-equal-correct)))
+
+
+  (local (defthm bvar-db-depends-on-of-add-term-bvar-preserved
+           (implies (and (not (bvar-db-depends-on k p n bvar-db))
+                         (<= (nfix n) (next-bvar$a bvar-db)))
+                    (not (bvar-db-depends-on k p n (add-term-bvar$a gobj bvar-db))))
+           :hints(("Goal" :in-theory (enable bvar-db-depends-on)))))
+
+  (local (defthm bvar-db-depends-on-of-add-term-bvar
+           (implies (and (not (bvar-db-depends-on k p (next-bvar$a bvar-db)
+                                                  bvar-db))
+                         (not (gobj-depends-on k p gobj)))
+                    (not (bvar-db-depends-on k p (+ 1 (next-bvar$a bvar-db))
+                                             (add-term-bvar$a
+                                              gobj bvar-db))))
+           :hints(("Goal" :expand ((bvar-db-depends-on k p (+ 1 (next-bvar$a bvar-db))
+                                                       (add-term-bvar$a
+                                                        gobj bvar-db)))))))
+
+  (defthm bvar-db-depends-on-of-add-term-equiv
+    (equal (bvar-db-depends-on k p n (add-term-equiv x z bvar-db))
+           (bvar-db-depends-on k p n bvar-db))
+    :hints(("Goal" :in-theory (enable bvar-db-depends-on))))
+
+  (defthm bvar-db-depends-on-of-maybe-add-equiv-term
+    (equal (bvar-db-depends-on k p n (maybe-add-equiv-term test-obj bvar bvar-db state))
+           (bvar-db-depends-on k p n bvar-db))
+    :hints(("Goal" :in-theory (enable maybe-add-equiv-term))))
+
+  (local (in-theory (disable* (:rules-of-class :type-prescription :here))))
+  (local (in-theory (enable (:t type-of-get-term->bvar$a)
+                            (:t type-of-next-bvar$a))))
+
+  (set-case-split-limitations '(2 100000))
+  (local (in-theory (disable gobj-list-depends-on
+                             BFR-VARS-BOUNDED-NECC
+                             gobj-vars-bounded-implies-not-depends-on
+                             glcp-generic-interp-get-term->bvar-preserved-rewrite
+                             fgetprop
+                             len hons-assoc-equal
+                             bfr-eval-booleanp
+                             no-duplicatesp-equal
+                             general-concrete-obj-list
+                             pbfr-vars-bounded-necc)))
+
+  (def-glcp-interp-thm dependencies-of-glcp-generic-interp
+    :hyps (and ;; (not erp)
+           (not (bvar-in-range k bvar-db1))
+           (not (bfr-depends-on k p))
+           (bfr-eval p env)
+           (equal p (glcp-config->param-bfr config))
+           (not (bvar-db-depends-on k p (next-bvar$a bvar-db) bvar-db))
+           (not (gbc-db-depends-on k p (nth *is-constraint-db* interp-st))))
+    :add-bindings ((nn (next-bvar$a bvar-db1)))
+    :add-concls ((not (gbc-db-depends-on k p (nth *is-constraint-db* interp-st1)))
+                 (implies (not (pbfr-depends-on k p (nth *is-constraint* interp-st)))
+                          (not (pbfr-depends-on k p (nth *is-constraint*
+                                                         interp-st1))))
+                 (not (bvar-db-depends-on k p nn bvar-db1)))
+    :special
+    ((test :add-hyps (not (gobj-alist-depends-on k p alist))
+           :body (not (pbfr-depends-on k p val)))
+     (equivs :add-hyps (not (gobj-alist-depends-on k p alist))
+             :body (not (gobj-depends-on k p val)))
+     (term :add-hyps (not (gobj-alist-depends-on k p alist))
+           :body (not (gobj-depends-on k p val)))
+     (if/or :add-hyps (not (gobj-alist-depends-on k p alist))
+            :body (not (gobj-depends-on k p val)))
+     (maybe :add-hyps (not (gobj-alist-depends-on k p alist))
+            :body (not (gobj-depends-on k p val)))
+     (if :add-hyps (not (gobj-alist-depends-on k p alist))
+       :body (not (gobj-depends-on k p val)))
+     (or :add-hyps (not (gobj-alist-depends-on k p alist))
+         :body (not (gobj-depends-on k p val)))
+     (merge :add-hyps (and (not (pbfr-depends-on k p test-bfr))
+                                (not (gobj-depends-on k p then))
+                                (not (gobj-depends-on k p else)))
+            :body (not (gobj-depends-on k p val)))
+     (merge-sub :add-hyps (and (not (pbfr-depends-on k p test-bfr))
+                                    (not (gobj-depends-on k p then))
+                                    (not (gobj-depends-on k p else)))
+                :body (not (gobj-depends-on k p val)))
+     (merge-list :add-hyps (and (not (pbfr-depends-on k p test-bfr))
+                                     (not (gobj-list-depends-on k p then))
+                                     (not (gobj-list-depends-on k p else))
+                                     (equal (len then) (len else)))
+                 :body (not (gobj-list-depends-on k p val))
+                 :hints ('(:in-theory (enable len))))
+     (test-simp :add-hyps (not (gobj-depends-on k p test-obj))
+                :body (not (pbfr-depends-on k p val)))
+     (constraints :add-hyps (not (gobj-depends-on k p lit)))
+     (constraint-substs :add-hyps (not (gobj-alist-list-depends-on
+                                        k p (alist-vals substs)))
+                        :hints('(:in-theory (enable
+                                             gobj-alist-list-depends-on
+                                             alist-vals))))
+     (test-simp-fncall :add-hyps (not (gobj-list-depends-on k p args))
+                       :body (not (pbfr-depends-on k p val)))
+     (fncall-ifs :add-hyps (not (gobj-list-depends-on k p actuals))
+                 :body (not (gobj-depends-on k p val)))
+     (maybe-fncall-ifs :add-hyps (not (gobj-list-depends-on k p actuals))
+                       :body (not (gobj-depends-on k p val)))
+     (fncall :add-hyps (not (gobj-list-depends-on k p actuals))
+             :body (not (gobj-depends-on k p val))
+             :hints ('(:in-theory (enable glcp-generic-geval-ev-of-fncall-args))))
+     (rewrite :add-hyps (not (gobj-list-depends-on k p actuals))
+              :body (not (gobj-alist-depends-on k p bindings)))
+     (rules :add-hyps (not (gobj-list-depends-on k p actuals))
+            :body (not (gobj-alist-depends-on k p bindings)))
+     (rule :add-hyps (not (gobj-list-depends-on k p actuals))
+           :body (not (gobj-alist-depends-on k p bindings)))
+     (hyps :add-hyps (not (gobj-alist-depends-on k p bindings)))
+     (hyp :add-hyps (not (gobj-alist-depends-on k p bindings)))
+     (list :add-hyps (not (gobj-alist-depends-on k p alist))
+           :body (not (gobj-list-depends-on k p vals))))
+    :expand-calls t
+    :hints (;;'(:error t)
+            ;; (case-match id
+            ;;   (('(0 1) '(29) . &)
+            ;;    (prog2$ (cw "empty~%")
+            ;;    (let ((state (f-put-global 'goals nil state)))
+            ;;      (value nil))))
+            ;;   (('(0 1) ('29 &) . &)
+            ;;    (prog2$ (cw "cons~%")
+            ;;    (let ((state (f-put-global 'goals (cons clause (@ goals))
+            ;;                               state)))
+            ;;      (value nil))))
+            ;;   (& (value nil)))
+            (let ((lit (car clause)))
+              (case-match lit
+                (('not ('acl2::flag-is . &) . &)
+                 '(:computed-hint-replacement
+                   ('(:expand :lambdas))
+                   :clause-processor acl2::constant-prop-cp))))
+            (and stable-under-simplificationp
+                 '(; :in-theory (enable acl2::expand-marked-meta)
+                   :do-not-induct t
+                   :do-not '(generalize)))
+            ;; (and (id-on-the-way-to id '((0 1) (29 93 95 41) . 0))
+            ;;      (cw "~x0~%" (acl2::prettyify-clause clause nil (w state)))
+            ;;      )
+            )))
+
+
+
+
+
+
+
+
+
+
+(defsection bvar-db-vars-bounded
+  (defund-nx bvar-db-vars-bounded (k p n bvar-db)
+    (declare (xargs :measure (nfix n)))
+    (if (<= (nfix n) (base-bvar bvar-db))
+        t
+      (and (gobj-vars-bounded k p (get-bvar->term (1- (nfix n)) bvar-db))
+           (bvar-db-vars-bounded k p (1- (nfix n)) bvar-db))))
+
+  (local (in-theory (enable bvar-db-vars-bounded)))
+
+  (defthm gobj-vars-bounded-of-get-bvar->term
+    (implies (and (<= (base-bvar bvar-db) (nfix m))
+                  (bvar-db-vars-bounded k p n bvar-db)
+                  (< (nfix m) (next-bvar bvar-db))
+                  (< (nfix m) (nfix n)))
+             (gobj-vars-bounded k p (get-bvar->term$a m bvar-db))))
+
+  (defund-nx bvar-db-vars-bounded-witness (k p n bvar-db)
+    (declare (xargs :measure (nfix n)))
+    (if (<= (nfix n) (base-bvar bvar-db))
+        nil
+      (or (gobj-vars-bounded-witness k p (get-bvar->term (1- (nfix n)) bvar-db))
+          (bvar-db-vars-bounded-witness k p (1- (nfix n)) bvar-db))))
+
+  (defthm bvar-db-vars-bounded-witness-under-iff
+    (iff (bvar-db-vars-bounded-witness k p n bvar-db)
+         (not (bvar-db-vars-bounded k p n bvar-db)))
+    :hints(("Goal" :in-theory (enable bvar-db-vars-bounded-witness))))
+
+  (defthmd bvar-db-vars-bounded-in-terms-of-witness
+    (implies (acl2::rewriting-positive-literal
+              `(bvar-db-vars-bounded ,k ,p ,n ,bvar-db))
+             (equal (bvar-db-vars-bounded k p n bvar-db)
+                    (let ((m (bvar-db-vars-bounded-witness k p n bvar-db)))
+                      (or (< (nfix m) (nfix k))
+                          (not (bvar-db-depends-on m p n bvar-db))))))
+    :hints(("Goal" :in-theory (enable bvar-db-vars-bounded-witness
+                                      bvar-db-depends-on
+                                      gobj-vars-bounded-in-terms-of-witness))))
+
+  (defthm bvar-db-depends-on-when-vars-bounded
+    (implies (and (bvar-db-vars-bounded k p n bvar-db)
+                  (<= (nfix k) (nfix m)))
+             (not (bvar-db-depends-on m p n bvar-db)))
+    :hints(("Goal" :in-theory (enable bvar-db-vars-bounded
+                                      bvar-db-depends-on))))
+
+  (defthm bvar-db-vars-bounded-of-add-term-bvar-preserved
+    (implies (and (bvar-db-vars-bounded k p n bvar-db)
+                  (<= (nfix n) (next-bvar$a bvar-db)))
+             (bvar-db-vars-bounded k p n (add-term-bvar$a gobj bvar-db)))
+    :hints(("Goal" :in-theory (enable bvar-db-vars-bounded))))
+
+  (defthmd bvar-db-vars-bounded-incr
+    (implies (and (bvar-db-vars-bounded k p n bvar-db)
+                  (<= (nfix k) (nfix m)))
+             (bvar-db-vars-bounded m p n bvar-db))
+    :hints(("Goal" :in-theory (enable bvar-db-vars-bounded-in-terms-of-witness))))
+
+  (defthm bvar-db-vars-bounded-of-add-term-bvar
+    (implies (and (bvar-db-vars-bounded k p (next-bvar$a bvar-db)
+                                        bvar-db)
+                  (gobj-vars-bounded j p gobj)
+                  (<= (nfix k) (nfix m))
+                  (<= (nfix j) (nfix m)))
+             (bvar-db-vars-bounded m p (+ 1 (next-bvar$a bvar-db))
+                                   (add-term-bvar$a
+                                    gobj bvar-db)))
+    :hints(("Goal" :expand ((bvar-db-vars-bounded k p (+ 1 (next-bvar$a bvar-db))
+                                                  (add-term-bvar$a
+                                                   gobj bvar-db)))
+            :in-theory (enable bvar-db-vars-bounded-incr)))))
+
+
+
+
+
+(encapsulate nil
+  (local (in-theory (disable ;; glcp-generic-interp-term-ok-obligs
+                             (:type-prescription hyp-fix)
+                             hyp-fix-of-hyp-fixedp
+                             pseudo-termp
+                             pseudo-term-listp
+                             acl2::interp-defs-alist-clauses
+                             general-concrete-listp
+                             general-concrete-obj-list
+                             acl2::weak-rewrite-rule-p
+                             acl2::eval-bdd
+                             hons-assoc-equal
+                             proper-contextsp
+                             (proper-contextsp)
+                             kwote-lst)))
+
+  ;; this isn't an induction, it's just based on the dependencies theorem
+  (def-glcp-interp-thm vars-bounded-of-glcp-generic-interp
+    :hyps (and ;; (not erp)
+           (<= (next-bvar$a bvar-db1) (nfix k))
+           (bfr-vars-bounded k p)
+           (bfr-eval p env)
+           (bvar-db-vars-bounded k p (next-bvar$a bvar-db) bvar-db)
+           (equal nn (next-bvar$a bvar-db1))
+           (equal p (glcp-config->param-bfr config))
+           (gbc-db-vars-bounded k p (nth *is-constraint-db* interp-st)))
+    :add-concls ((implies (pbfr-vars-bounded k p (nth *is-constraint* interp-st))
+                          (pbfr-vars-bounded k p (nth *is-constraint* interp-st1)))
+                 (bvar-db-vars-bounded k p nn bvar-db1)
+                 (gbc-db-vars-bounded k p (nth *is-constraint-db* interp-st1)))
+    :special
+    ((test :add-hyps (gobj-alist-vars-bounded k p alist)
+           :body (pbfr-vars-bounded k p val))
+     (equivs :add-hyps (gobj-alist-vars-bounded k p alist)
+             :body (gobj-vars-bounded k p val))
+     (term :add-hyps (gobj-alist-vars-bounded k p alist)
+           :body (gobj-vars-bounded k p val))
+     (if/or :add-hyps (gobj-alist-vars-bounded k p alist)
+            :body (gobj-vars-bounded k p val))
+     (maybe :add-hyps (gobj-alist-vars-bounded k p alist)
+            :body (gobj-vars-bounded k p val))
+     (if :add-hyps (gobj-alist-vars-bounded k p alist)
+       :body (gobj-vars-bounded k p val))
+     (or :add-hyps (gobj-alist-vars-bounded k p alist)
+         :body (gobj-vars-bounded k p val))
+     (merge :add-hyps (and (pbfr-vars-bounded k p test-bfr)
+                                (gobj-vars-bounded k p then)
+                                (gobj-vars-bounded k p else))
+            :body (gobj-vars-bounded k p val))
+     (merge-sub :add-hyps (and (pbfr-vars-bounded k p test-bfr)
+                                (gobj-vars-bounded k p then)
+                                (gobj-vars-bounded k p else))
+                :body (gobj-vars-bounded k p val))
+     (merge-list :add-hyps (and (pbfr-vars-bounded k p test-bfr)
+                                     (gobj-list-vars-bounded k p then)
+                                     (gobj-list-vars-bounded k p else)
+                                     (equal (len then) (len else)))
+                 :body (gobj-list-vars-bounded k p val))
+     (test-simp :add-hyps (gobj-vars-bounded k p test-obj)
+                :body (pbfr-vars-bounded k p val))
+
+     (test-simp-fncall :add-hyps (gobj-list-vars-bounded k p args)
+                       :body (pbfr-vars-bounded k p val))
+     (constraints :add-hyps (gobj-vars-bounded k p lit))
+     (constraint-substs :add-hyps (gobj-alist-list-vars-bounded
+                                   k p (alist-vals substs)))
+     (fncall-ifs :add-hyps (gobj-list-vars-bounded k p actuals)
+                 :body (gobj-vars-bounded k p val))
+
+     (maybe-fncall-ifs :add-hyps (gobj-list-vars-bounded k p actuals)
+                       :body (gobj-vars-bounded k p val))
+
+     (fncall :add-hyps (gobj-list-vars-bounded k p actuals)
+             :body (gobj-vars-bounded k p val))
+     (rewrite :add-hyps (gobj-list-vars-bounded k p actuals)
+              :body (gobj-alist-vars-bounded k p bindings))
+     (rules :add-hyps (gobj-list-vars-bounded k p actuals)
+            :body (gobj-alist-vars-bounded k p bindings))
+     (rule :add-hyps (gobj-list-vars-bounded k p actuals)
+           :body (gobj-alist-vars-bounded k p bindings))
+     (hyps :add-hyps (gobj-alist-vars-bounded k p bindings)
+           :body (bvar-db-vars-bounded k p nn bvar-db1))
+     (hyp :add-hyps (gobj-alist-vars-bounded k p bindings)
+          :body (bvar-db-vars-bounded k p nn bvar-db1))
+     (list :add-hyps (gobj-alist-vars-bounded k p alist)
+           :body (gobj-list-vars-bounded k p vals)))
+    :hints (("goal" :in-theory (enable bvar-db-vars-bounded-in-terms-of-witness
+                                       gobj-vars-bounded-in-terms-of-witness
+                                       gobj-list-vars-bounded-in-terms-of-witness
+                                       gobj-alist-vars-bounded-in-terms-of-witness
+                                       gbc-db-vars-bounded-in-terms-of-witness
+                                       bvar-in-range))
+            (and stable-under-simplificationp
+                 (member (caar (last clause)) '(pbfr-vars-bounded))
+                 `(:expand (,(car (last clause))))))
+    :no-induction-hint t))
+
+
+
+(defthm gobj-alist-vars-bounded-of-glcp-unify-term/gobj-list
+  (implies (and (gobj-list-vars-bounded k p actuals)
+                (gobj-alist-vars-bounded k p alist))
+           (gobj-alist-vars-bounded
+            k p (mv-nth 1 (glcp-unify-term/gobj-list pat actuals alist))))
+  :hints (("goal" :in-theory (enable gobj-alist-vars-bounded-in-terms-of-witness))))
+
+
+
+
+(defthm gobj-list-vars-bounded-of-gl-args-split-ite
+  (b* (((mv ?has-if test then else)
+        (gl-args-split-ite args)))
+    (implies (gobj-list-vars-bounded k p args)
+             (and (gobj-vars-bounded k p test)
+                  (gobj-list-vars-bounded k p then)
+                  (gobj-list-vars-bounded k p else))))
+  :hints (("goal" :in-theory (enable gobj-vars-bounded-in-terms-of-witness
+                                     gobj-list-vars-bounded-in-terms-of-witness
+                                     gobj-alist-vars-bounded-in-terms-of-witness))))
+
+
+(encapsulate nil
+  (local (in-theory (disable pseudo-termp
+                             pseudo-termp-symbolp-car-x
+                             ;;glcp-generic-interp-term-ok-obligs
+                             (:t hyp-fix) (:t hyp-fixedp)
+                             hyp-fix-of-hyp-fixedp
+                             acl2::nfix-when-not-natp
+                             pbfr-vars-bounded-t
+                             gbc-process-new-lit
+                             glcp-or-test-contexts
+                             acl2::cancel_times-equal-correct
+                             acl2::cancel_plus-equal-correct)))
+
+  (defthm bvar-db-orderedp-implies-vars-bounded
+    (implies (and (bvar-db-orderedp p bvar-db)
+                  (<= (next-bvar$a bvar-db) (nfix n))
+                  (<= (nfix m) (next-bvar$a bvar-db)))
+             (bvar-db-vars-bounded n p m bvar-db))
+    :hints(("Goal" :in-theory (enable bvar-db-vars-bounded))))
+
+  (defthm pbfr-vars-bounded-of-bfr-not
+    (implies (pbfr-vars-bounded k p x)
+             (pbfr-vars-bounded k p (bfr-not x)))
+    :hints (("goal" :expand ((pbfr-vars-bounded k p (bfr-not x))))))
+
+  (local (defthmd gobj-vars-bounded-when-gobject-hierarchy-lite
+           (implies (gobject-hierarchy-lite x)
+                    (gobj-vars-bounded k p x))
+           :hints(("Goal" :in-theory (enable gobject-hierarchy-lite
+                                             gobj-vars-bounded)))))
+
+  (local (in-theory (disable len default-car default-cdr bfr-eval-booleanp
+                             fgetprop hons-assoc-equal)))
+
+  (defthm gobj-vars-bounded-of-general-consp-car
+    (implies (and (gobj-vars-bounded k p x)
+                  (general-consp x))
+             (gobj-vars-bounded k p (general-consp-car x)))
+    :hints(("Goal" :in-theory (enable general-consp general-consp-car
+                                      mk-g-concrete
+                                      concrete-gobjectp
+                                      gobj-vars-bounded-when-gobject-hierarchy-lite))))
+
+  (defthm gobj-vars-bounded-of-general-consp-cdr
+    (implies (and (gobj-vars-bounded k p x)
+                  (general-consp x))
+             (gobj-vars-bounded k p (general-consp-cdr x)))
+    :hints(("Goal" :in-theory (enable general-consp general-consp-cdr
+                                      mk-g-concrete
+                                      concrete-gobjectp
+                                      gobj-vars-bounded-when-gobject-hierarchy-lite))))
+
+  ;; (defthm bvar-db-orderedp-of-update-term-equiv
+  ;;   (implies (bvar-db-orderedp p bvar-db)
+  ;;            (bvar-db-orderedp p (add-term-equiv x n bvar-db)))
+  ;;   :hints(("Goal" :in-theory (enable add-term-equiv))))
+
+  ;; (defthm bvar-db-orderedp-of-add-term-equiv
+  ;;   (implies (bvar-db-orderedp p bvar-db)
+  ;;            (bvar-db-orderedp p (add-term-equiv x n bvar-db)))
+  ;;   :hints(("Goal" :in-theory (enable add-term-equiv))))
+
+  (defthm bvar-db-orderedp-of-maybe-add-equiv-term
+    (implies (bvar-db-orderedp p bvar-db)
+             (bvar-db-orderedp p (maybe-add-equiv-term x n bvar-db state)))
+    :hints(("Goal" :in-theory (enable maybe-add-equiv-term
+                                      add-term-equiv))
+           (and stable-under-simplificationp
+                `(:expand (,(car (last clause)))))))
+
+  (defthm bvar-db-orderedp-of-add-term->bvar
+    (implies (and (bvar-db-orderedp p bvar-db)
+                  (gobj-vars-bounded (next-bvar$a bvar-db) p gobj))
+             (bvar-db-orderedp p (add-term-bvar$a gobj bvar-db)))
+    :hints((and stable-under-simplificationp
+                `(:expand (,(car (last clause)))))))
+
+
+  (def-glcp-interp-thm bvar-db-ordered-of-glcp-generic-interp
+    :body (implies (and ;; (not erp)
+                    (bfr-vars-bounded k p)
+                    (bfr-eval p env)
+                    (bvar-db-orderedp p bvar-db)
+                    (bvar-db-vars-bounded k p k bvar-db)
+                    (equal p (glcp-config->param-bfr config))
+                    (gbc-db-vars-bounded k p (nth *is-constraint-db* interp-st)))
+                   (bvar-db-orderedp p bvar-db1))
+    :add-bindings ((k (next-bvar$a bvar-db)))
+    :special
+    ((test :add-hyps (gobj-alist-vars-bounded k p alist))
+     (equivs :add-hyps (gobj-alist-vars-bounded k p alist))
+     (term :add-hyps (gobj-alist-vars-bounded k p alist))
+     (if/or :add-hyps (gobj-alist-vars-bounded k p alist))
+     (maybe :add-hyps (gobj-alist-vars-bounded k p alist))
+     (if :add-hyps (gobj-alist-vars-bounded k p alist))
+     (or :add-hyps (gobj-alist-vars-bounded k p alist))
+     (merge :add-hyps (and (pbfr-vars-bounded k p test-bfr)
+                           (gobj-vars-bounded k p then)
+                           (gobj-vars-bounded k p else)))
+     (merge-sub :add-hyps (and (pbfr-vars-bounded k p test-bfr)
+                           (gobj-vars-bounded k p then)
+                           (gobj-vars-bounded k p else)))
+     (merge-list :add-hyps (and (pbfr-vars-bounded k p test-bfr)
+                                (gobj-list-vars-bounded k p then)
+                                (gobj-list-vars-bounded k p else)
+                                (equal (len then) (len else)))
+                 :hints ('(:in-theory (enable len))))
+     (finish-if :add-hyps (and (pbfr-vars-bounded k p test-bfr)
+                               (gobj-alist-vars-bounded k p alist)))
+
+     (finish-or :add-hyps (and (pbfr-vars-bounded k p test-bfr)
+                               (gobj-vars-bounded k p then-obj)
+                               (gobj-alist-vars-bounded k p alist)))
+
+     (test-simp :add-hyps (gobj-vars-bounded k p test-obj)
+                :hints ((and stable-under-simplificationp
+                             '(:use ((:instance gobj-vars-bounded-when-g-var
+                                      (x test-obj) (k 0)
+                                      (p (glcp-config->param-bfr config))))
+                               :in-theory (disable
+                                           gobj-vars-bounded-when-g-var)))))
+     (test-simp-fncall :add-hyps (gobj-list-vars-bounded k p args))
+     (constraints :add-hyps (gobj-vars-bounded k p lit))
+     (constraint-substs :add-hyps (gobj-alist-list-vars-bounded
+                                   k p (alist-vals substs))
+                        :hints ((and stable-under-simplificationp
+                                     '(:expand ((alist-vals substs))
+                                       :in-theory (enable gobj-alist-list-vars-bounded)))))
+     (fncall-ifs :add-hyps (gobj-list-vars-bounded k p actuals))
+     (maybe-fncall-ifs :add-hyps (gobj-list-vars-bounded k p actuals))
+
+     (fncall :add-hyps (gobj-list-vars-bounded k p actuals)
+             :hints ('(:in-theory (enable glcp-generic-geval-ev-of-fncall-args))))
+     (rewrite :add-hyps (gobj-list-vars-bounded k p actuals))
+     (rules :add-hyps (gobj-list-vars-bounded k p actuals))
+     (rule :add-hyps (gobj-list-vars-bounded k p actuals))
+     (hyps :add-hyps (gobj-alist-vars-bounded k p bindings))
+     (hyp :add-hyps (gobj-alist-vars-bounded k p bindings))
+     (list :add-hyps (gobj-alist-vars-bounded k p alist)))
+    :expand-calls t
+    :hints (;; (let ((lit (car clause)))
+            ;;   (case-match lit
+            ;;     (('not ('acl2::flag-is . &) . &)
+            ;;      '(;; :computed-hint-replacement
+            ;;        ;; ('(:expand :lambdas))
+            ;;        :clause-processor acl2::constant-prop-cp))))
+            (and stable-under-simplificationp
+                 `(,@(and (eq (caar (last clause)) 'bvar-db-orderedp)
+                          `(:expand (,(car (last clause)))))
+                     :in-theory (enable bvar-db-vars-bounded-incr)
+                     :do-not-induct t)))))
+
+
+(encapsulate nil
+  (local (in-theory (disable ;;glcp-generic-interp-term-ok-obligs
+                             (:type-prescription hyp-fix)
+                             hyp-fix-of-hyp-fixedp
+                             pseudo-termp
+                             gbc-process-new-lit
+                             glcp-or-test-contexts
+                             glcp-generic-geval-general-concrete-obj-correct
+                             pseudo-term-listp
+                             acl2::interp-defs-alist-clauses
+                             general-concrete-listp
+                             general-concrete-obj-list
+                             acl2::weak-rewrite-rule-p
+                             acl2::eval-bdd
+                             hons-assoc-equal
+                             proper-contextsp
+                             (proper-contextsp)
+                             kwote-lst)))
+
+  (local (defthm proper-contextsp-of-iff
+           (proper-contextsp '(iff))
+           :hints(("Goal" :in-theory (enable proper-contextsp
+                                             glcp-generic-equiv-relp)))))
+  (local (defthm proper-contextsp-nil
+           (proper-contextsp nil)
+           :hints(("Goal" :in-theory (enable proper-contextsp
+                                             glcp-generic-equiv-relp)))))
+
+  (local (defthmd equal-len
+           (implies (syntaxp (quotep y))
+                    (Equal (equal (len x) y)
+                           (if (zp y)
+                               (and (equal y 0) (atom x))
+                             (and (consp x)
+                                  (equal (len (cdr x)) (1- y))))))))
+
+  (local (in-theory (disable* glcp-generic-geval-ev-rules len default-car
+                              default-cdr
+                              alistp
+                              no-duplicatesp-equal
+                              member-equal
+                              last nonnil-symbol-listp
+                              fgetprop pairlis$ subsetp-equal
+                              (:rules-of-class :type-prescription :here))))
+
+  (local (in-theory (enable (:t type-of-next-bvar$a)
+                            (:t type-of-base-bvar$a)
+                            (:t type-of-get-term->bvar$a))))
+
+  (local (defthm len-general-concrete-obj-list
+           (equal (len (general-concrete-obj-list x))
+                  (len x))
+           :hints(("Goal" :in-theory (enable general-concrete-obj-list len)))))
+
+  (local (defthmd glcp-generic-geval-of-consp
+           (implies (and (NOT (EQUAL (TAG X) :G-BOOLEAN))
+                         (NOT (EQUAL (TAG X) :G-NUMBER))
+                         (NOT (EQUAL (TAG X) :G-CONCRETE))
+                         (NOT (EQUAL (TAG X) :G-VAR))
+                         (NOT (EQUAL (TAG X) :G-ITE))
+                         (NOT (EQUAL (TAG X) :G-APPLY))
+                         (consp x))
+                    (equal (glcp-generic-geval x env)
+                           (cons (glcp-generic-geval (car x) env)
+                                 (glcp-generic-geval (cdr x) env))))
+           :hints(("Goal" :in-theory (enable g-keyword-symbolp)))))
+
+
+  (local (defthmd glcp-generic-geval-g-ite-p
+           (implies (equal (tag x) :g-ite)
+                    (equal (glcp-generic-geval x env)
+                           (if (glcp-generic-geval (g-ite->test x) env)
+                               (glcp-generic-geval (g-ite->then x) env)
+                             (glcp-generic-geval (g-ite->else x) env))))
+           :hints(("Goal" :in-theory (enable glcp-generic-geval)))))
+
+  (local (defthmd bfr-eval-test-when-false
+           (implies (and (not (hyp-fix x pathcond))
+                         (bfr-eval pathcond (car env)))
+                    (not (bfr-eval x (car env))))
+           :hints ((bfr-reasoning))))
+
+  (local (defthmd bfr-eval-test-when-true
+           (implies (and (not (hyp-fix (bfr-not x) pathcond))
+                         (bfr-eval pathcond (car env)))
+                    (bfr-eval x (car env)))
+           :hints ((bfr-reasoning))))
+
+  (local (defthmd bfr-eval-when-not-bfr-not
+           (implies (not (bfr-not x))
+                    (bfr-eval x (car env)))
+           :hints ((bfr-reasoning))))
+
+  (local (defthmd hyp-fix-bfr-not
+           (implies (and (not (hyp-fix x pathcond))
+                         (bfr-eval pathcond (car env)))
+                    (hyp-fix (bfr-not x) pathcond))
+           :hints (("goal" :use (bfr-eval-test-when-true
+                                 bfr-eval-test-when-false)))))
+
+  (local (Defthmd car-kwote-lst
+           (implies (>= (len x) 1)
+                    (equal (car (kwote-lst x))
+                           (list 'quote (car x))))
+           :hints(("Goal" :in-theory (enable kwote-lst len)))))
+
+  (local (Defthmd cadr-kwote-lst
+           (implies (>= (len x) 2)
+                    (equal (cadr (kwote-lst x))
+                           (list 'quote (cadr x))))
+           :hints(("Goal" :in-theory (enable kwote-lst len)))))
+
+  (local (Defthmd car-glcp-generic-geval-list
+           (implies (>= (len x) 1)
+                    (equal (car (glcp-generic-geval-list x env))
+                           (glcp-generic-geval (car x) env)))
+           :hints(("Goal" :in-theory (enable glcp-generic-geval-list len)))))
+
+  (local (Defthmd cadr-glcp-generic-geval-list
+           (implies (>= (len x) 2)
+                    (equal (cadr (glcp-generic-geval-list x env))
+                           (glcp-generic-geval (cadr x) env)))
+           :hints(("Goal" :in-theory (enable glcp-generic-geval-list len)))))
+
+  (local (defthmd glcp-generic-geval-of-g-boolean
+           (equal (glcp-generic-geval (g-boolean x) env)
+                  (bfr-eval x (car env)))
+           :hints(("Goal" :in-theory (enable glcp-generic-geval)))))
+
+  (local (defthm len-0
+           (equal (equal (len x) 0)
+                  (not (consp x)))
+           :hints(("Goal" :in-theory (enable len)))))
+
+  (local (defthm if-test-fncall-when-quote
+           (mv-nth 1 (glcp-generic-simplify-if-test-fncall
+                      'quote args intro-bvars pathcond clk config interp-st
+                      bvar-db st))
+           :hints (("goal" :expand
+                    ((glcp-generic-simplify-if-test-fncall
+                      'quote args intro-bvars pathcond clk config interp-st
+                      bvar-db st))))))
+
+  (local (in-theory (disable
+                     GLCP-GENERIC-INTERP-FUNCTION-LOOKUP-THEOREMP-DEFS-HISTORY
+                     glcp-generic-geval-ev-conjoin-clauses-atom
+                     acl2::cancel_times-equal-correct
+                     acl2::cancel_plus-equal-correct
+                     contextsp not iff tag-when-atom proper-contextsp
+                     mv-nth-cons-meta
+                     bfr-eval-booleanp
+                     glcp-if-or-condition
+                     acl2::rewrite-rule-term
+                     rewrite-rule-term-alt-def
+                     len hons-assoc-equal
+                     acl2::alistp-when-hons-duplicity-alist-p
+                     acl2::alistp-when-esc-alist-p
+                     glcp-generic-eval-context-equiv*-suff
+;glcp-if-test-contexts
+                     glcp-generic-interp-bvar-db-env-ok-preserved-term
+                     glcp-generic-interp-bvar-db-env-ok-preserved-maybe
+                     glcp-generic-interp-bvar-db-env-ok-preserved-equivs
+                     glcp-generic-interp-bvar-db-env-ok-preserved-merge
+                     glcp-generic-interp-bvar-db-env-ok-preserved-test-simp
+                     glcp-generic-interp-bvar-db-env-ok-preserved-test-simp-fncall
+; glcp-generic-interp-bvar-db-env-ok-preserved-fncall-ifs
+                     glcp-generic-interp-bvar-db-env-ok-preserved-rewrite
+                     glcp-generic-interp-bvar-db-env-ok-preserved-if/or
+                     glcp-generic-interp-bvar-db-env-ok-preserved-if
+                     glcp-generic-interp-bvar-db-env-ok-preserved-or
+                     glcp-generic-bvar-db-env-ok-bound-decr
+                     glcp-or-test-contexts)))
+
+  (local (in-theory (enable* env-ok-special-rules)))
+
+                                  
+  (local (in-theory (disable iff)))
+
+  (defthm if*-cases
+    (and (implies x
+                  (equal (if* x y z) y))
+         (implies (not x)
+                  (equal (if* x y z) z))))
+
+  (local (in-theory (disable if*)))
+
+  (defthm glcp-interp-accs-ok-of-update-constraint
+    (equal (glcp-interp-accs-ok (update-nth *is-constraint* c interp-st)
+                                bvar-db config env)
+           (glcp-interp-accs-ok interp-st bvar-db config env))
+    :hints(("Goal" :in-theory (enable glcp-interp-accs-ok))))
+
+  (defthm glcp-interp-accs-ok-of-update-constraint-db
+    (equal (glcp-interp-accs-ok (update-nth *is-constraint-db* cdb interp-st)
+                                bvar-db config env)
+           (glcp-interp-accs-ok interp-st bvar-db config env))
+    :hints(("Goal" :in-theory (enable glcp-interp-accs-ok))))
+
+  (def-glcp-interp-thm glcp-generic-interp-correct
+    :hyps (and (bfr-eval (nth *is-constraint* interp-st) (car env))
+               (acl2::interp-defs-alistp (nth *is-obligs* interp-st))
+               (acl2::interp-defs-alistp (glcp-config->overrides config))
+               ;; (glcp-generic-geval-ev-theoremp
+               ;;  (conjoin-clauses
+               ;;   (acl2::interp-defs-alist-clauses
+               ;;    (nth *is-obligs* interp-st1))))
+               ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+               (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+               ;; (glcp-generic-bvar-db-env-ok
+               ;;  bvar-db1 (glcp-config->param-bfr config)
+               ;;  (next-bvar$a bvar-db1) env)
+               (glcp-interp-accs-ok interp-st1 bvar-db1 config env)
+               (equal (w state0) (w st)))
+    :add-concls ((bfr-eval (nth *is-constraint* interp-st1) (car env)))
+    :special
+    ((test :add-hyps (and (pseudo-termp x)
+                          (alistp alist))
+           :body (implies (and (not erp)
+                               (bfr-eval pathcond (car env)))
+                          (iff* (bfr-eval val (car env))
+                               (glcp-generic-geval-ev x (glcp-generic-geval-alist
+                                                         alist env)))))
+     
+     (equivs :add-hyps (and (pseudo-termp x)
+                            (alistp alist)
+                            (proper-contextsp contexts)
+                            (contextsp contexts))
+             :body (implies (and (not erp)
+                                 (bfr-eval pathcond (car env)))
+                            (glcp-generic-eval-context-equiv*
+                             contexts
+                             (glcp-generic-geval val env)
+                             (glcp-generic-geval-ev x (glcp-generic-geval-alist
+                                                       alist env)))))
+     (term :add-hyps (and (pseudo-termp x)
+                          (alistp alist)
+                          (proper-contextsp contexts)
+                          (contextsp contexts))
+           :body (implies (and (not erp)
+                               (bfr-eval pathcond (car env)))
+                          (glcp-generic-eval-context-equiv*
+                           contexts
+                           (glcp-generic-geval val env)
+                           (glcp-generic-geval-ev x (glcp-generic-geval-alist
+                                                     alist env))))
+           :hints ((and stable-under-simplificationp
+                        '(:in-theory (enable
+                                      glcp-generic-geval-ev-of-fncall-args
+                                      glcp-generic-geval-ev-of-return-last-call
+                                      glcp-generic-geval-ev-of-if-call
+                                      glcp-generic-geval-ev-of-gl-ignore-call
+                                      glcp-generic-geval-ev-of-gl-aside-call
+                                      glcp-generic-geval-ev-of-lambda
+                                      glcp-generic-geval-ev-of-variable
+                                      glcp-generic-geval-ev-of-quote
+                                      equal-len
+                                      acl2::expand-marked-meta)))))
+     (if/or :add-hyps                     (and (pseudo-termp tbr)
+                                               (pseudo-termp fbr)
+                                               (pseudo-termp test)
+                                               (alistp alist)
+                                               (proper-contextsp contexts)
+                                               (contextsp contexts))
+            :body (implies (and (not erp)
+                                (bfr-eval pathcond (car env)))
+                           (glcp-generic-eval-context-equiv*
+                            contexts
+                            (glcp-generic-geval val env)
+                            (if (glcp-generic-geval-ev test (glcp-generic-geval-alist
+                                                             alist env))
+                                (glcp-generic-geval-ev tbr (glcp-generic-geval-alist
+                                                            alist env))
+                              (glcp-generic-geval-ev fbr (glcp-generic-geval-alist
+                                                          alist env))))))
+
+
+     (maybe :add-hyps (and (pseudo-termp x)
+                           (alistp alist)
+                           (proper-contextsp contexts)
+                           (contextsp contexts))
+            :body (implies (and (and (not erp)
+                                     (bfr-eval pathcond (car env)))
+                                (bfr-eval branchcond (car env)))
+                           (glcp-generic-eval-context-equiv*
+                            contexts
+                            (glcp-generic-geval val env)
+                            (glcp-generic-geval-ev x (glcp-generic-geval-alist
+                                                      alist env))))
+            :hints((and stable-under-simplificationp
+                        '(:in-theory (enable bfr-eval-test-when-false)))))
+
+     (if :add-hyps                  (and (pseudo-termp tbr)
+                                         (pseudo-termp fbr)
+                                         (pseudo-termp test)
+                                         (alistp alist)
+                                         (proper-contextsp contexts)
+                                         (contextsp contexts))
+       :body (implies (and (not erp)
+                           (bfr-eval pathcond (car env)))
+                      (glcp-generic-eval-context-equiv*
+                       contexts
+                       (glcp-generic-geval val env)
+                       (if* (glcp-generic-geval-ev test (glcp-generic-geval-alist
+                                                        alist env))
+                           (glcp-generic-geval-ev tbr (glcp-generic-geval-alist
+                                                       alist env))
+                         (glcp-generic-geval-ev fbr (glcp-generic-geval-alist
+                                                     alist env)))))
+       :hints ((prog2$ (cw "IF case~%")
+                       '(:no-op t))))
+
+     (or :add-hyps (and (pseudo-termp fbr)
+                        (pseudo-termp test)
+                        (alistp alist)
+                        (proper-contextsp contexts)
+                        (contextsp contexts))
+         :body (implies (and (not erp)
+                             (bfr-eval pathcond (car env)))
+                        (glcp-generic-eval-context-equiv*
+                         contexts
+                         (glcp-generic-geval val env)
+                         (if* (glcp-generic-geval-ev test (glcp-generic-geval-alist
+                                                          alist env))
+                              (glcp-generic-geval-ev test (glcp-generic-geval-alist
+                                                          alist env))
+                             (glcp-generic-geval-ev fbr (glcp-generic-geval-alist
+                                                         alist env)))))
+         :hints ('(:in-theory (enable glcp-context-equiv-of-glcp-or-test-contexts))))
+
+     (merge :add-hyps (and (proper-contextsp contexts)
+                           (contextsp contexts))
+            :body (implies (and (not erp)
+                                (bfr-eval pathcond (car env)))
+                           (glcp-generic-eval-context-equiv*
+                            contexts
+                            (glcp-generic-geval val env)
+                            (if (bfr-eval test-bfr (car env))
+                                (glcp-generic-geval then env)
+                              (glcp-generic-geval else env))))
+            :hints ((and stable-under-simplificationp
+                         '(:in-theory (enable glcp-generic-geval-ev-of-if-call
+                                              glcp-generic-geval-of-g-boolean
+                                              glcp-generic-geval-ev-of-quote
+                                              kwote-lst)))))
+
+     (merge-sub :body (implies (and (not erp)
+                                    (bfr-eval pathcond (car env)))
+                               (equal (glcp-generic-geval val env)
+                                      (if (bfr-eval test-bfr (car env))
+                                          (glcp-generic-geval then env)
+                                        (glcp-generic-geval else env))))
+                :hints ((and stable-under-simplificationp
+                             '(:in-theory (enable glcp-generic-geval-g-apply-p)))))
+
+     (merge-list :add-hyps (equal (len then) (len else))
+                 :body (implies (and (not erp)
+                                     (bfr-eval pathcond (car env)))
+                                (equal (glcp-generic-geval-list val env)
+                                       (if (bfr-eval test-bfr (car env))
+                                           (glcp-generic-geval-list then env)
+                                         (glcp-generic-geval-list else env))))
+                 :hints('(:in-theory (enable len))))
+
+     (test-simp :body (implies (and (not erp)
+                                    (bfr-eval pathcond (car env)))
+                               (iff* (bfr-eval val (car env))
+                                    (glcp-generic-geval test-obj env)))
+                :hints ((and stable-under-simplificationp
+                             '(:expand ((:with glcp-generic-geval (glcp-generic-geval test-obj env)))
+                               :in-theory (enable ;; glcp-generic-geval-of-consp
+                                           ;; glcp-generic-geval-g-apply-p
+                                           ;; glcp-generic-geval-g-ite-p
+                                           bfr-eval-test-when-true
+                                           bfr-eval-when-not-bfr-not
+                                           bfr-eval-test-when-false
+                                           glcp-generic-geval-ev-of-gl-force-check-call
+                                           glcp-generic-geval-ev-of-gl-force-check-strong-call
+                                           glcp-generic-geval-ev-of-gl-force-true-call
+                                           glcp-generic-geval-ev-of-gl-force-false-call
+                                           glcp-generic-geval-ev-of-equal-call
+                                           glcp-generic-geval-ev-of-not-call
+                                           car-glcp-generic-geval-list
+                                           cadr-glcp-generic-geval-list
+                                           car-kwote-lst
+                                           cadr-kwote-lst
+                                           glcp-generic-geval-ev-of-quote
+                                           hyp-fix-bfr-not
+                                           acl2::expand-marked-meta)))))
+
+     (test-simp-fncall
+      :body (implies (and (not erp)
+                          (bfr-eval pathcond (car env)))
+                     (iff* (bfr-eval val (car env))
+                          (glcp-generic-geval-ev
+                           (cons fn
+                                 (kwote-lst (glcp-generic-geval-list args env)))
+                           nil)))
+      :hints ((and stable-under-simplificationp
+                   '(:expand ((:with glcp-generic-geval (glcp-generic-geval test-obj env)))
+                     :in-theory (enable ;; glcp-generic-geval-of-consp
+                                 ;; glcp-generic-geval-g-apply-p
+                                 ;; glcp-generic-geval-g-ite-p
+                                 bfr-eval-test-when-true
+                                 bfr-eval-when-not-bfr-not
+                                 bfr-eval-test-when-false
+                                 glcp-generic-geval-ev-of-gl-force-check-call
+                                 glcp-generic-geval-ev-of-gl-force-check-strong-call
+                                 glcp-generic-geval-ev-of-gl-force-true-call
+                                 glcp-generic-geval-ev-of-gl-force-false-call
+                                 glcp-generic-geval-ev-of-equal-call
+                                 glcp-generic-geval-ev-of-not-call
+                                 car-glcp-generic-geval-list
+                                 cadr-glcp-generic-geval-list
+                                 car-kwote-lst
+                                 cadr-kwote-lst
+                                 glcp-generic-geval-ev-of-quote
+                                 hyp-fix-bfr-not
+                                 acl2::expand-marked-meta)))))
+     (constraints)
+     (constraint-substs)
+
+     (fncall-ifs :add-hyps (and (symbolp fn)
+                                (not (eq fn 'quote))
+                                (proper-contextsp contexts)
+                                (contextsp contexts))
+                 :body (implies (and (not erp)
+                                     (bfr-eval pathcond (car env)))
+                                (glcp-generic-eval-context-equiv*
+                                 contexts
+                                 (glcp-generic-geval val env)
+                                 (glcp-generic-geval-ev
+                                  (cons fn (kwote-lst (glcp-generic-geval-list actuals env)))
+                                  nil))))
+     (maybe-fncall-ifs :add-hyps (and (symbolp fn)
+                                      (not (eq fn 'quote))
+                                      (proper-contextsp contexts)
+                                      (contextsp contexts))
+                       :body (implies (and (bfr-eval branchcond (car env))
+                                           (and (not erp)
+                                                (bfr-eval pathcond (car env))))
+                                      (glcp-generic-eval-context-equiv*
+                                       contexts
+                                       (glcp-generic-geval val env)
+                                       (glcp-generic-geval-ev
+                                        (cons fn (kwote-lst (glcp-generic-geval-list actuals env)))
+                                        nil)))
+                       :hints('(:in-theory (enable bfr-eval-test-when-false))))
+
+     (fncall :add-hyps (and (symbolp fn)
+                            (not (eq fn 'quote))
+                            (proper-contextsp contexts)
+                            (contextsp contexts))
+             :body (implies (and (not erp)
+                                 (bfr-eval pathcond (car env)))
+                            (glcp-generic-eval-context-equiv*
+                             contexts
+                             (glcp-generic-geval val env)
+                             (glcp-generic-geval-ev
+                              (cons fn (kwote-lst (glcp-generic-geval-list actuals env)))
+                              nil)))
+             :hints ('(:in-theory (enable glcp-generic-geval-ev-of-fncall-args))))
+     (rewrite :add-hyps (and (symbolp fn)
+                             (not (eq fn 'quote))
+                             (contextsp contexts)
+                             (proper-contextsp contexts))
+              :body (implies (and (not erp)
+                                  (bfr-eval pathcond (car env)))
+                             (implies successp
+                                      (glcp-generic-eval-context-equiv*
+                                       contexts
+                                       (glcp-generic-geval-ev term
+                                                              (glcp-generic-geval-alist
+                                                               bindings env))
+                                       (glcp-generic-geval-ev
+                                        (cons fn (kwote-lst (glcp-generic-geval-list
+                                                             actuals env)))
+                                        nil)))))
+     (rules :add-hyps (and (symbolp fn)
+                           (not (eq fn 'quote))
+                           (good-rewrite-rulesp fn-rewrites)
+                           (contextsp contexts)
+                           (proper-contextsp contexts))
+            :body (implies (and (not erp)
+                                (bfr-eval pathcond (car env)))
+                           (implies successp
+                                    (glcp-generic-eval-context-equiv*
+                                     contexts
+                                     (glcp-generic-geval-ev term
+                                                            (glcp-generic-geval-alist
+                                                             bindings env))
+                                     (glcp-generic-geval-ev
+                                      (cons fn (kwote-lst (glcp-generic-geval-list
+                                                           actuals env)))
+                                      nil)))))
+     (rule :add-hyps (and (symbolp fn)
+                          (not (eq fn 'quote))
+                          (glcp-generic-geval-ev-theoremp
+                           (acl2::rewrite-rule-term rule))
+                          (contextsp contexts)
+                          (proper-contextsp contexts))
+           :body (implies (and (not erp)
+                               (bfr-eval pathcond (car env)))
+                          (implies successp
+                                   (glcp-generic-eval-context-equiv*
+                                    contexts
+                                    (glcp-generic-geval-ev term
+                                                           (glcp-generic-geval-alist
+                                                            bindings env))
+                                    (glcp-generic-geval-ev
+                                     (cons fn (kwote-lst (glcp-generic-geval-list
+                                                          actuals env)))
+                                     nil))))
+           :hints((and stable-under-simplificationp
+                       '(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                                           acl2::expand-marked-meta))))))
+     (hyps :add-hyps (and (pseudo-term-listp hyps)
+                          (alistp bindings))
+           :body (implies (and (not erp)
+                               (bfr-eval pathcond (car env)))
+                          (implies successp
+                                   (glcp-generic-geval-ev
+                                    (conjoin hyps)
+                                    (glcp-generic-geval-alist bindings env)))))
+     (hyp :add-hyps (and (pseudo-termp hyp)
+                         (alistp bindings))
+          :body (implies (and (not erp)
+                              (bfr-eval pathcond (car env)))
+                         (implies successp
+                                  (glcp-generic-geval-ev
+                                   hyp (glcp-generic-geval-alist bindings env))))
+          :hints ((and stable-under-simplificationp
+                       '(:in-theory (e/d* (gtests-known-and-true))))))
+     (list :add-hyps (and (pseudo-term-listp x)
+                          (alistp alist))
+           :body (implies (and (not erp)
+                               (bfr-eval pathcond (car env)))
+                          (equal (glcp-generic-geval-list vals env)
+                                 (glcp-generic-geval-ev-lst
+                                  x (glcp-generic-geval-alist alist
+                                                              env))))
+           :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-lst-of-cons
+                                       glcp-generic-geval-ev-lst-of-atom))))))
+    :expand-calls t
+    :hints (;; '(:error t)
+            (let ((lit (car clause)))
+              (case-match lit
+                (('not ('acl2::flag-is . &) . &)
+                 '(;; :computed-hint-replacement
+                   ;; ('(:expand :lambdas))
+                   :clause-processor acl2::constant-prop-cp))))
+            (and stable-under-simplificationp
+                 '(; :in-theory (enable acl2::expand-marked-meta)
+                   :do-not-induct t
+                   :do-not '(generalize)))
+            ;; (and (equal id '((0 1) (49) . 0))
+            ;;      (prog2$ (accumulated-persistence t)
+            ;;              nil))
+            ;; (and (equal id '((0 1) (48) . 0))
+            ;;      (prog2$ (show-accumulated-persistence)
+            ;;              nil))
+            ;; (and (id-on-the-way-to id '((0 1) (64 2) . 0))
+            ;;      '(:error t)
+            ;;      ;; (cw "~x0~%" (acl2::prettyify-clause clause nil (w state)))
+            ;;      )
+            )))
+
+
+
+  ;; (forall x
+  ;;         (implies (get-term->bvar$a x bvar-db)
+  ;;                  (iff (bfr-lookup
+  ;;                        (get-term->bvar$a x bvar-db)
+  ;;                        (bfr-unparam-env (glcp-config->param-bfr config) (car env)))
+  ;;                       (glcp-generic-geval x env))))
+
+
+(defun bvar-db-fix-env (n min bvar-db p bfr-env var-env)
+  (declare (xargs :stobjs bvar-db
+                  :measure (nfix n)
+                  :guard (and (integerp n)
+                              (integerp min)
+                              (<= (base-bvar bvar-db) min)
+                              (<= min n)
+                              (<= n (next-bvar bvar-db)))))
+  (b* ((n (lnfix n))
+       (min (lnfix min))
+       ((when (mbe :logic (or (<= n (base-bvar bvar-db))
+                              (<= n min))
+                   :exec (int= n min))) bfr-env)
+       (n (1- n))
+       (bfr-env (bvar-db-fix-env n min bvar-db p bfr-env var-env))
+       (term (get-bvar->term n bvar-db))
+       (val (glcp-generic-geval term (cons bfr-env var-env))))
+    (bfr-param-env p
+                   (bfr-set-var n val (bfr-unparam-env p bfr-env)))))
+
+(defthm bvar-db-fix-env-eval-p-lemma
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+                (bfr-eval p env)
+                (bfr-vars-bounded min p)
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (bfr-eval p (bfr-unparam-env p (bvar-db-fix-env n min bvar-db p
+                                                           (bfr-param-env p env)
+                                                           var-env)))))
+
+
+;; (defthm bfr-list->s-of-set-non-dep-bounded
+;;   (implies (and (pbfr-list-vars-bounded n p x)
+;;                 (<= (nfix n) (nfix k))
+;;                 (bfr-eval p env)
+;;                 (bfr-eval p (bfr-set-var k v env)))
+;;            (equal (bfr-list->s x (bfr-param-env p (bfr-set-var k v env)))
+;;                   (bfr-list->s x (bfr-param-env p env)))))
+;;   :hints(("Goal" :in-theory (enable pbfr-list-depends-on))))
+
+
+
+
+(defthm bfr-list->s-of-param-unparam-param-env
+  (implies (bfr-eval p env)
+           (equal (bfr-list->s x (bfr-param-env
+                                  p (bfr-unparam-env
+                                     p (bfr-param-env p env))))
+                  (bfr-list->s x (bfr-param-env p env))))
+  :hints(("Goal" :in-theory (enable bfr-list->s))))
+
+(defthm bfr-list->u-of-param-unparam-param-env
+  (implies (bfr-eval p env)
+           (equal (bfr-list->u x (bfr-param-env
+                                  p (bfr-unparam-env
+                                     p (bfr-param-env p env))))
+                  (bfr-list->u x (bfr-param-env p env))))
+  :hints(("Goal" :in-theory (enable bfr-list->u))))
+
+(defthm-gobj-flag
+  (defthm glcp-generic-geval-of-param-unparam-param-env
+    (implies (bfr-eval p env)
+             (equal (glcp-generic-geval x (cons (bfr-param-env
+                                                 p (bfr-unparam-env
+                                                    p (bfr-param-env p env)))
+                                                var-env))
+                    (glcp-generic-geval x (cons (bfr-param-env p env)
+                                                var-env))))
+    :hints ('(:expand ((:free (env) (:with glcp-generic-geval (glcp-generic-geval x env))))))
+    :flag gobj)
+  (defthm glcp-generic-geval-list-of-param-unparam-param-env
+    (implies (bfr-eval p env)
+             (equal (glcp-generic-geval-list x (cons (bfr-param-env
+                                                      p (bfr-unparam-env
+                                                         p (bfr-param-env p env)))
+                                                     var-env))
+                    (glcp-generic-geval-list x (cons (bfr-param-env p env)
+                                                     var-env))))
+    :hints ('(:expand ((:free (env) (glcp-generic-geval-list x env)))))
+    :flag list))
+
+
+(defthm bfr-list->s-of-unparam-param-env
+  (implies (bfr-eval p env)
+           (equal (bfr-list->s x (bfr-unparam-env
+                                  p (bfr-param-env p env)))
+                  (bfr-list->s x env)))
+  :hints(("Goal" :in-theory (enable bfr-list->s))))
+
+(defthm bfr-list->u-of-unparam-param-env
+  (implies (bfr-eval p env)
+           (equal (bfr-list->u x (bfr-unparam-env
+                                  p (bfr-param-env p env)))
+                  (bfr-list->u x env)))
+  :hints(("Goal" :in-theory (enable bfr-list->u))))
+
+
+(defthm-gobj-flag
+  (defthm glcp-generic-geval-of-unparam-param-env
+    (implies (bfr-eval p env)
+             (equal (glcp-generic-geval x (cons (bfr-unparam-env
+                                                 p (bfr-param-env p env))
+                                                var-env))
+                    (glcp-generic-geval x (cons env var-env))))
+    :hints ('(:expand ((:free (env) (:with glcp-generic-geval (glcp-generic-geval x env))))))
+    :flag gobj)
+  (defthm glcp-generic-geval-list-of-unparam-param-env
+    (implies (bfr-eval p env)
+             (equal (glcp-generic-geval-list x (cons (bfr-unparam-env
+                                                      p (bfr-param-env p env))
+                                                     var-env))
+                    (glcp-generic-geval-list x (cons env var-env))))
+    :hints ('(:expand ((:free (env) (glcp-generic-geval-list x env)))))
+    :flag list))
+
+(defthm glcp-generic-geval-param-unparam-fix-env
+  (implies (and (bfr-eval p env)
+                (bfr-vars-bounded min p)
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (equal (glcp-generic-geval x (cons (bfr-param-env
+                                               p (bfr-unparam-env
+                                                  p (bvar-db-fix-env
+                                                     n min bvar-db p (bfr-param-env p env)
+                                                     var-env)))
+                                              var-env2))
+                  (glcp-generic-geval x (cons (bvar-db-fix-env
+                                               n min bvar-db p (bfr-param-env p env)
+                                               var-env)
+                                              var-env2))))
+  :hints (("goal" :expand ((bvar-db-fix-env
+                            n min bvar-db p (bfr-param-env p env)
+                            var-env))
+           :do-not-induct t)))
+
+(defthm bfr-eval-param-unparam-fix-env
+  (implies (and (bfr-eval p env)
+                (bfr-vars-bounded min p)
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (equal (bfr-eval x (bfr-param-env
+                               p (bfr-unparam-env
+                                  p (bvar-db-fix-env
+                                     n min bvar-db p (bfr-param-env p env)
+                                     var-env))))
+                  (bfr-eval x (bvar-db-fix-env
+                               n min bvar-db p (bfr-param-env p env)
+                               var-env))))
+  :hints (("goal" :expand ((bvar-db-fix-env
+                            n min bvar-db p (bfr-param-env p env)
+                            var-env))
+           :do-not-induct t)))
+
+
+(acl2::def-functional-instance
+ glcp-generic-geval-of-set-var-when-gobj-vars-bounded
+ generic-geval-of-set-var-when-gobj-vars-bounded
+ ((generic-geval-ev glcp-generic-geval-ev)
+  (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+  (generic-geval glcp-generic-geval)
+  (generic-geval-list glcp-generic-geval-list))
+ :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                             glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                            (glcp-generic-geval-apply))
+           :expand ((:with glcp-generic-geval (glcp-generic-geval x env))))))
+
+(acl2::def-functional-instance
+ glcp-generic-geval-list-of-set-var-when-gobj-vars-bounded
+ generic-geval-list-of-set-var-when-gobj-vars-bounded
+ ((generic-geval-ev glcp-generic-geval-ev)
+  (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+  (generic-geval glcp-generic-geval)
+  (generic-geval-list glcp-generic-geval-list))
+ :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                             glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                            (glcp-generic-geval-apply))
+           :expand ((:with glcp-generic-geval (glcp-generic-geval x env))))))
+
+(defthm bvar-db-fix-env-eval-gobj-vars-bounded-lemma
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+                (bfr-eval p env)
+                (bfr-vars-bounded min p)
+                (gobj-vars-bounded m p gobj)
+                (< (nfix m) (nfix n))
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env))
+                  (env-m (bvar-db-fix-env m min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (glcp-generic-geval gobj (cons env-n var-env))
+                    (glcp-generic-geval gobj (cons env-m var-env)))))
+  :hints (("goal" :induct (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                           var-env))
+          (and stable-under-simplificationp
+               '(:expand ((bvar-db-fix-env m min bvar-db p (bfr-param-env p env) var-env))))))
+
+
+(defthm bvar-db-fix-env-eval-bfr-vars-bounded-lemma
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+                (bfr-eval p env)
+                (bfr-vars-bounded min p)
+                (pbfr-vars-bounded m p x)
+                (< (nfix m) (nfix n))
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env))
+                  (env-m (bvar-db-fix-env m min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (bfr-eval x env-n)
+                    (bfr-eval x env-m))))
+  :hints (("goal" :induct (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                           var-env))
+          (and stable-under-simplificationp
+               '(:expand ((bvar-db-fix-env m min bvar-db p (bfr-param-env p env) var-env))))))
+
+(defthm bvar-db-fix-env-eval-bfr-vars-bounded-lemma-rw
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+                (bfr-eval p env)
+                (bfr-vars-bounded min p)
+                (pbfr-vars-bounded min p x)
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (bfr-eval x env-n)
+                    (bfr-eval x (bfr-param-env p env)))))
+  :hints (("goal" :use ((:instance bvar-db-fix-env-eval-bfr-vars-bounded-lemma
+                         (m min)))
+           :in-theory (disable bvar-db-fix-env-eval-bfr-vars-bounded-lemma)
+           :expand ((bvar-db-fix-env min min bvar-db p (bfr-param-env p env)
+                                     var-env)))))
+
+
+
+;; (defthm bvar-db-env-ok-of-bvar-db-fix-env-lemma
+;;   (implies (and (bvar-db-orderedp p bvar-db)
+;;                 (bfr-eval p bfr-env)
+;;                 (bfr-vars-bounded min p)
+;;                 (<= (nfix min) (nfix m))
+;;                 (<= (base-bvar$a bvar-db) (nfix m))
+;;                 (< (nfix m) (nfix n))
+;;                 (<= (nfix n) (next-bvar$a bvar-db)))
+;;            (let* ((bfr-env (bvar-db-fix-env n min bvar-db p
+;;                                             (bfr-param-env p bfr-env)
+;;                                             var-env)))
+;;              (iff (bfr-lookup m (bfr-unparam-env p bfr-env))
+;;                   (glcp-generic-geval (get-bvar->term m bvar-db)
+;;                                       (cons bfr-env var-env)))))
+;;   :hints (("goal" :induct (bvar-db-fix-env n min bvar-db p
+;;                                            (bfr-param-env p bfr-env)
+;;                                            var-env))
+;;           (and stable-under-simplificationp
+;;                '(:use ((:instance bvar-db-orderedp-necc
+;;                         (n (nfix m)))
+;;                        (:instance bvar-db-orderedp-necc
+;;                         (n m)))
+;;                  :in-theory (disable bvar-db-orderedp-necc)))))
+
+(defthm bvar-db-env-ok-of-bvar-db-fix-env-lemma
+  (implies (and (bvar-db-orderedp p bvar-db)
+                (bfr-eval p bfr-env)
+                (bfr-vars-bounded min p)
+                (<= (base-bvar$a bvar-db) (nfix m))
+                (< (nfix m) (nfix n))
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((bfr-env1 (bvar-db-fix-env n min bvar-db p
+                                             (bfr-param-env p bfr-env)
+                                             var-env)))
+             (iff (bfr-lookup m (bfr-unparam-env p bfr-env1))
+                  (if (<= (nfix min) (nfix m))
+                      (glcp-generic-geval (get-bvar->term m bvar-db)
+                                          (cons bfr-env1 var-env))
+                    (bfr-lookup m bfr-env)))))
+  :hints (("goal" :induct (bvar-db-fix-env n min bvar-db p
+                                           (bfr-param-env p bfr-env)
+                                           var-env))
+          (and stable-under-simplificationp
+               '(:use ((:instance bvar-db-orderedp-necc
+                        (n (nfix m)))
+                       (:instance bvar-db-orderedp-necc
+                        (n m)))
+                 :in-theory (disable bvar-db-orderedp-necc
+                                     gobj-vars-bounded-of-get-bvar->term-when-bvar-db-orderedp)))))
+
+
+(defthm bvar-db-env-ok-of-bvar-db-fix-env
+  (implies (and (bvar-db-orderedp p bvar-db)
+                (bfr-eval p bfr-env)
+                (bfr-vars-bounded (base-bvar$a bvar-db) p)
+                (<= (nfix n) (next-bvar$a bvar-db))
+                (<= nn (nfix n))
+                (equal b (base-bvar$a bvar-db)))
+           (let ((bfr-env (bvar-db-fix-env n b
+                                           bvar-db p
+                                           (bfr-param-env p bfr-env) var-env)))
+             (glcp-generic-bvar-db-env-ok bvar-db p nn (cons bfr-env var-env))))
+  :hints ((and stable-under-simplificationp
+               `(:expand (,(car (last clause)))))))
+
+
+
+
+
+
+(defthm bvar-db-env-ok-of-bvar-db-fix-env2
+  (implies (and (bvar-db-orderedp p bvar-db)
+                (bfr-eval p bfr-env)
+                (bfr-vars-bounded min p)
+                (<= (nfix n) (next-bvar$a bvar-db))
+                (<= nn (nfix n))
+                (<= (base-bvar$a bvar-db) (nfix n))
+                (glcp-generic-bvar-db-env-ok bvar-db p min
+                                             (cons (bfr-param-env p bfr-env)
+                                                   var-env)))
+           (let ((bfr-env (bvar-db-fix-env n min
+                                           bvar-db p
+                                           (bfr-param-env p bfr-env) var-env)))
+             (glcp-generic-bvar-db-env-ok bvar-db p nn (cons bfr-env var-env))))
+  :hints ((and stable-under-simplificationp
+               (let* ((lit (car (last clause)))
+                      (witness (cons 'glcp-generic-bvar-db-env-ok-witness (cdr lit))))
+                 (prog2$ (cw "witness: ~x0~%" witness)
+                 `(:computed-hint-replacement
+                   ('(:use ((:instance glcp-generic-bvar-db-env-ok-necc
+                             (n ,witness)
+                             (env (cons (bfr-param-env p bfr-env) var-env))
+                             (bound min))
+                            (:instance bvar-db-fix-env-eval-gobj-vars-bounded-lemma
+                             (gobj (GET-BVAR->TERM$A ,witness BVAR-DB))
+                             (m min) (env bfr-env)))
+                      :expand ((BVAR-DB-FIX-ENV MIN
+                                                MIN BVAR-DB P (BFR-PARAM-ENV P BFR-ENV)
+                                                VAR-ENV))
+                      :in-theory (disable glcp-generic-bvar-db-env-ok-necc
+                                          bvar-db-fix-env-eval-gobj-vars-bounded-lemma)))
+                   :expand (,lit)
+                   :do-not-induct t))))))
+
+
+
+
+
+(defthm bvar-db-fix-env-eval-bfr-vars-bounded-unparam
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+            (bfr-eval p env)
+            (bfr-vars-bounded min p)
+            (pbfr-vars-bounded m t x)
+            (< (nfix m) (nfix n))
+            (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env))
+                  (env-m (bvar-db-fix-env m min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (bfr-eval x (bfr-unparam-env p env-n))
+                    (bfr-eval x (bfr-unparam-env p env-m)))))
+  :hints (("goal" :use ((:instance bvar-db-fix-env-eval-bfr-vars-bounded-lemma
+                         (x (bfr-to-param-space p x))))
+           :in-theory (disable bvar-db-fix-env-eval-bfr-vars-bounded-lemma)
+           :do-not-induct t)))
+
+(defthm bvar-db-fix-env-eval-bfr-vars-bounded-unparam-rw
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+            (bfr-eval p env)
+            (bfr-vars-bounded min p)
+            (pbfr-vars-bounded min t x)
+            (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (bfr-eval x (bfr-unparam-env p env-n))
+                    (bfr-eval x env))))
+  :hints (("goal" :use ((:instance bvar-db-fix-env-eval-bfr-vars-bounded-unparam
+                         (m min)))
+           :in-theory (disable bvar-db-fix-env-eval-bfr-vars-bounded-unparam)
+           :expand ((BVAR-DB-FIX-ENV MIN MIN BVAR-DB P (BFR-PARAM-ENV P ENV)
+                                     VAR-ENV))
+           :do-not-induct t)))
+
+(defthm bvar-db-fix-env-eval-bfr-vars-bounded-unparam-with-no-param
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+            (pbfr-vars-bounded min t x)
+            (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db t env var-env)))
+             (equal (bfr-eval x env-n)
+                    (bfr-eval x env))))
+  :hints (("goal" :use ((:instance bvar-db-fix-env-eval-bfr-vars-bounded-unparam-rw
+                         (p t)))
+           :expand ((bfr-vars-bounded min t))
+           :in-theory (disable bvar-db-fix-env-eval-bfr-vars-bounded-unparam-rw)
+           :do-not-induct t)))
+
+
+
+(include-book "param")
+
+
+
+
+
+
+
+
+
+
+
+
+
+(acl2::def-functional-instance
+ glcp-generic-geval-gobj-to-param-space-correct-with-unparam-env
+ gobj-to-param-space-correct-with-unparam-env
+ ((generic-geval-ev glcp-generic-geval-ev)
+  (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+  (generic-geval glcp-generic-geval)
+  (generic-geval-list glcp-generic-geval-list))
+ :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                             glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                            (glcp-generic-geval-apply))
+           :expand ((:with glcp-generic-geval (glcp-generic-geval x env))))))
+
+(acl2::def-functional-instance
+ glcp-generic-geval-gobj-list-to-param-space-correct-with-unparam-env
+ gobj-list-to-param-space-correct-with-unparam-env
+ ((generic-geval-ev glcp-generic-geval-ev)
+  (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+  (generic-geval glcp-generic-geval)
+  (generic-geval-list glcp-generic-geval-list))
+ :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                             glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                            (glcp-generic-geval-apply))
+           :expand ((:with glcp-generic-geval (glcp-generic-geval x env))))))
+
+
+
+
+
+
+
+(defthm bvar-db-fix-env-eval-gobj-vars-bounded-unparam
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+                (bfr-eval p env)
+                (bfr-vars-bounded min p)
+                (gobj-vars-bounded m t gobj)
+                (< (nfix m) (nfix n))
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env))
+                  (env-m (bvar-db-fix-env m min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (glcp-generic-geval gobj (cons (bfr-unparam-env p env-n) var-env))
+                    (glcp-generic-geval gobj (cons (bfr-unparam-env p env-m) var-env)))))
+  :hints (("goal" :use ((:instance bvar-db-fix-env-eval-gobj-vars-bounded-lemma
+                         (gobj (gobj-to-param-space gobj p))))
+           :in-theory (e/d (genv-unparam)
+                           (bvar-db-fix-env-eval-gobj-vars-bounded-lemma))
+           :do-not-induct t)))
+
+(defthm bvar-db-fix-env-eval-gobj-vars-bounded-unparam-rw
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+            (bfr-eval p env)
+            (bfr-vars-bounded min p)
+            (gobj-vars-bounded min t x)
+            (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (glcp-generic-geval x (cons (bfr-unparam-env p env-n) var-env))
+                    (glcp-generic-geval x (cons env var-env)))))
+  :hints (("goal" :use ((:instance bvar-db-fix-env-eval-gobj-vars-bounded-unparam
+                         (gobj x) (m min)))
+           :in-theory (disable bvar-db-fix-env-eval-gobj-vars-bounded-unparam)
+           :expand ((BVAR-DB-FIX-ENV MIN MIN BVAR-DB P (BFR-PARAM-ENV P ENV)
+                                     VAR-ENV))
+           :do-not-induct t)))
+
+(defthm bvar-db-fix-env-eval-gobj-vars-bounded-unparam-with-no-param
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+            (gobj-vars-bounded min t x)
+            (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db t env var-env)))
+             (equal (glcp-generic-geval x (cons env-n var-env))
+                    (glcp-generic-geval x (cons env var-env)))))
+  :hints (("goal" :use ((:instance bvar-db-fix-env-eval-gobj-vars-bounded-unparam-rw
+                         (p t)))
+           :expand ((bfr-vars-bounded min t))
+           :in-theory (disable bvar-db-fix-env-eval-gobj-vars-bounded-unparam-rw)
+           :do-not-induct t)))
+
+
+
+
+(defthm bvar-db-env-ok-of-bvar-db-fix-env2-no-param
+  (implies (and (bvar-db-orderedp t bvar-db)
+                (<= (nfix n) (next-bvar$a bvar-db))
+                (<= nn (nfix n))
+                (<= (base-bvar$a bvar-db) (nfix n))
+                (glcp-generic-bvar-db-env-ok bvar-db t min
+                                             (cons bfr-env var-env)))
+           (let ((bfr-env (bvar-db-fix-env n min
+                                           bvar-db t bfr-env var-env)))
+             (glcp-generic-bvar-db-env-ok bvar-db t nn (cons bfr-env var-env))))
+  :hints (("Goal" :use ((:instance bvar-db-env-ok-of-bvar-db-fix-env2
+                         (p t)))
+           :in-theory (disable bvar-db-env-ok-of-bvar-db-fix-env2))))
+
+
+
+
+
+
+;; What's really going to happen?
+
+;; We're going to simulate the hyps under P=t.  This may add some variables to
+;; the bvar-db.  We get some expression H for the hyps.  We translate the
+;; bvar-db to the param space of H.  Then we simulate the conclusion in the
+;; param space of H.  We get some expression C for the conclusion.  We try to
+;; prove C.  If we prove it, we have shown there is no env that is consistent
+;; with the bvar-db, satisfies (the self-parameterization of) H, and does not satisfy C.
+
+;; Now assume we have a counterexample to the original hyp => concl.  We want
+;; to construct an env from this that contradicts our proof.
+
+
+
+
+;; (defund glcp-generic-interp-top-level-term
+;;   (term alist pathcond clk config interp-st bvar-db state)
+;;   (declare (xargs :guard (and (pseudo-termp term)
+;;                               (natp clk)
+;;                               (acl2::interp-defs-alistp obligs)
+;;                               (glcp-config-p config)
+;;                               (acl2::interp-defs-alistp (glcp-config->overrides config)))
+;;                   :stobjs (bvar-db state)
+;;                   :verify-guards nil))
+;;   (b* (((glcp-er res-obj)
+;;         (glcp-generic-interp-term
+;;          term alist pathcond '(iff) clk config interp-st bvar-db state)))
+;;     (glcp-generic-simplify-if-test res-obj pathcond clk config interp-st bvar-db
+;;                                    state)))
+
+(defthm glcp-generic-equiv-relp-of-iff
+  (glcp-generic-equiv-relp 'iff)
+  :hints (("goal" :expand ((glcp-generic-equiv-relp 'iff)))))
+
+
+
+
+
+
+(defsection glcp-generic-interp-top-level-term
+  (local (in-theory (enable glcp-generic-interp-top-level-term)))
+
+  (defthm glcp-generic-interp-top-level-term-correct
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (bind-free
+                     (if (and (consp bfr-env)
+                              (eq (car bfr-env) 'bvar-db-fix-env))
+                         `((env . (cons ,bfr-env ,(nth 6 bfr-env))))
+                       `((free-var . free-var))))
+                    (bfr-eval pathcond bfr-env)
+                    (bfr-eval (is-constraint interp-st) bfr-env)
+                    (not erp)
+                    (acl2::interp-defs-alistp (is-obligs interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses
+                       (is-obligs interp-st1))))
+                    ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+                    (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+                    (equal p (glcp-config->param-bfr config))
+                    (glcp-generic-bvar-db-env-ok
+                     bvar-db1 p (next-bvar$a bvar-db1) env)
+                    (equal bfr-env (car env))
+                    (equal (w state0) (w state))
+                    (pseudo-termp term)
+                    (alistp alist))
+               (iff (bfr-eval val bfr-env)
+                    (glcp-generic-geval-ev term (glcp-generic-geval-alist
+                                                 alist env)))))
+    :hints(("Goal" :in-theory (e/d (glcp-interp-accs-ok)
+                                   (glcp-generic-interp-correct-term))
+            :use ((:instance glcp-generic-interp-correct-term
+                   (x term) (contexts '(iff)) (st state)
+                   (config (glcp-config-update-term term config)))))))
+
+  (defthm glcp-generic-interp-top-level-term-preserves-constraint
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (bind-free
+                     (if (and (consp bfr-env)
+                              (eq (car bfr-env) 'bvar-db-fix-env))
+                         `((env . (cons ,bfr-env ,(nth 6 bfr-env))))
+                       `((free-var . free-var))))
+                    (bfr-eval (is-constraint interp-st) bfr-env)
+                    (acl2::interp-defs-alistp (is-obligs interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses
+                       (is-obligs interp-st1))))
+                    ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+                    (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+                    (equal p (glcp-config->param-bfr config))
+                    (glcp-generic-bvar-db-env-ok
+                     bvar-db1 p (next-bvar$a bvar-db1) env)
+                    (equal bfr-env (car env))
+                    (equal (w state0) (w state))
+                    (pseudo-termp term)
+                    (alistp alist))
+               (bfr-eval (nth *is-constraint* interp-st1) bfr-env)))
+    :hints(("Goal" :in-theory (e/d (glcp-interp-accs-ok)
+                                   (glcp-generic-interp-correct-term))
+            :use ((:instance glcp-generic-interp-correct-term
+                   (x term) (contexts '(iff)) (st state)
+                   (config (glcp-config-update-term term config)))))))
+
+
+  (defthm w-state-preserved-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (equal (w state1) (w state))))
+
+  (defthm interp-defs-alistp-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (acl2::interp-defs-alistp (is-obligs interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (pseudo-termp term)
+                    (not erp))
+               (acl2::interp-defs-alistp (nth *is-obligs*  interp-st1)))))
+
+  (defthm state-p1-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (state-p1 state)
+               (state-p1 state1))))
+
+  (defthm bad-obligs-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (not (glcp-generic-geval-ev-theoremp
+                          (conjoin-clauses
+                           (acl2::interp-defs-alist-clauses
+                            (is-obligs interp-st)))))
+                    (not erp))
+               (not (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses
+                       (nth *is-obligs* interp-st1))))))))
+
+  (defthm forward-obligs-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses
+                       (nth *is-obligs* interp-st1))))
+                    (not erp))
+               (glcp-generic-geval-ev-theoremp
+                (conjoin-clauses
+                 (acl2::interp-defs-alist-clauses
+                  (nth *is-obligs* interp-st))))))
+    :rule-classes :forward-chaining)
+
+  (defthm bvar-db-env-ok-preserved-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (<= bound (next-bvar$a bvar-db))
+                    (equal p (glcp-config->param-bfr config)))
+               (equal (glcp-generic-bvar-db-env-ok bvar-db1 p bound env)
+                      (glcp-generic-bvar-db-env-ok bvar-db p bound env))))
+    :hints(("Goal" :in-theory (enable glcp-generic-interp-bvar-db-env-ok-preserved-test))))
+
+  (defthm bvar-db-env-ok-next-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (not (glcp-generic-bvar-db-env-ok
+                          bvar-db p (next-bvar$a bvar-db) env))
+                    (equal p (glcp-config->param-bfr config)))
+               (not (glcp-generic-bvar-db-env-ok
+                     bvar-db1 p (next-bvar$a bvar-db1) env))))
+    :hints(("Goal" :in-theory (enable glcp-generic-interp-bvar-db-preserved-special-test))))
+
+  (defthm base-bvar-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (equal (base-bvar$a bvar-db1) (base-bvar$a bvar-db))))
+
+  (defthm next-bvar-incr-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (>= (next-bvar$a bvar-db1) (next-bvar$a bvar-db)))
+    :rule-classes :linear)
+
+  (defthm get-bvar->term-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (<= (base-bvar$a bvar-db) (nfix n))
+                    (< (nfix n) (next-bvar$a bvar-db)))
+               (equal (get-bvar->term$a n bvar-db1)
+                      (get-bvar->term$a n bvar-db)))))
+
+  (defthm get-term->bvar-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (get-term->bvar$a x bvar-db)
+               (equal (get-term->bvar$a x bvar-db1)
+                      (get-term->bvar$a x bvar-db)))))
+
+
+  (defthm vars-bounded-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (<= (next-bvar$a bvar-db1) (nfix k))
+                    (gbc-db-vars-bounded k p (nth *is-constraint-db* interp-st))
+                    (bfr-vars-bounded k p)
+                    (bfr-eval p env)
+                    (bvar-db-orderedp p bvar-db)
+                    (equal p (glcp-config->param-bfr config))
+                    (gobj-alist-vars-bounded k p alist))
+               (and (pbfr-vars-bounded k p val)
+                    (gbc-db-vars-bounded k p (nth *is-constraint-db* interp-st1))))))
+
+  (defthm constraint-vars-bounded-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (<= (next-bvar$a bvar-db1) (nfix k))
+                    (gbc-db-vars-bounded k p (nth *is-constraint-db* interp-st))
+                    (bfr-vars-bounded k p)
+                    (bfr-eval p env)
+                    (bvar-db-orderedp p bvar-db)
+                    (equal p (glcp-config->param-bfr config))
+                    (gobj-alist-vars-bounded k p alist)
+                    (pbfr-vars-bounded k p (nth *is-constraint* interp-st)))
+               (pbfr-vars-bounded k p (nth *is-constraint* interp-st1)))))
+
+  (defthm bfr-vars-bounded-of-glcp-generic-interp-top-level-no-param
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state)))
+      (implies (and (<= (next-bvar$a bvar-db1) (nfix k))
+                    (equal t (glcp-config->param-bfr config))
+                    (gbc-db-vars-bounded k t (nth *is-constraint-db* interp-st))
+                    (bvar-db-orderedp t bvar-db)
+                    (gobj-alist-vars-bounded k t alist))
+               (bfr-vars-bounded k val)))
+    :hints (("Goal" :use ((:instance vars-bounded-of-glcp-generic-interp-top-level
+                           (p t)))
+             :in-theory (disable vars-bounded-of-glcp-generic-interp-top-level))))
+
+  (defthm bvar-db-ordered-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state))
+         (k (next-bvar$a bvar-db)))
+      (implies (and (equal p (glcp-config->param-bfr config))
+                    (gbc-db-vars-bounded k p (nth *is-constraint-db* interp-st))
+                    (bfr-vars-bounded k p)
+                    (bfr-eval p env)
+                    (bvar-db-orderedp p bvar-db)
+                    (gobj-alist-vars-bounded k p alist))
+               (bvar-db-orderedp p bvar-db1))))
+
+
+  (defthm fix-env-correct-of-glcp-generic-interp-top-level-no-param
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state))
+         (bfr-env1 (bvar-db-fix-env (next-bvar$a bvar-db1)
+                                    next-of-bvar-db
+                                    bvar-db1 t bfr-env var-env)))
+      (implies (and (equal t (glcp-config->param-bfr config))
+                    (equal next-of-bvar-db (next-bvar$a bvar-db))
+                    (gbc-db-vars-bounded
+                     (next-bvar$a bvar-db) t (nth *is-constraint-db* interp-st))
+                    (bvar-db-orderedp t bvar-db)
+                    (gobj-alist-vars-bounded (next-bvar$a bvar-db) t alist)
+                    (glcp-generic-bvar-db-env-ok
+                     bvar-db t (next-bvar$a bvar-db) (cons bfr-env var-env)))
+               (glcp-generic-bvar-db-env-ok
+                bvar-db1 t (next-bvar$a bvar-db1) (cons bfr-env1 var-env))))
+    :hints(("Goal" :in-theory (disable glcp-generic-interp-top-level-term
+                                       bfr-eval-consts bfr-eval-booleanp)
+            :use ((:theorem (bfr-eval t env))))
+           (and stable-under-simplificationp
+                '(:in-theory (enable bfr-eval-consts)))))
+
+  (defthm fix-env-correct-of-glcp-generic-interp-top-level
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+          (glcp-generic-interp-top-level-term
+           term alist pathcond clk config interp-st bvar-db state))
+         (bfr-env1 (bvar-db-fix-env (next-bvar$a bvar-db1)
+                                    next-of-bvar-db
+                                    bvar-db1 p
+                                    (bfr-param-env p bfr-env)
+                                    var-env)))
+      (implies (and (equal p (glcp-config->param-bfr config))
+                    (equal next-of-bvar-db (next-bvar$a bvar-db))
+                    (bfr-vars-bounded (next-bvar$a bvar-db) p)
+                    (bfr-eval p bfr-env)
+                    (bvar-db-orderedp p bvar-db)
+                    (gbc-db-vars-bounded
+                     (next-bvar$a bvar-db) p (nth *is-constraint-db* interp-st))
+                    (gobj-alist-vars-bounded (next-bvar$a bvar-db) p alist)
+                    (glcp-generic-bvar-db-env-ok
+                     bvar-db p (next-bvar$a bvar-db)
+                     (cons (bfr-param-env p bfr-env) var-env)))
+               (glcp-generic-bvar-db-env-ok
+                bvar-db1 p (next-bvar$a bvar-db1) (cons bfr-env1 var-env))))
+    :hints(("Goal" :in-theory (disable glcp-generic-interp-top-level-term)))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(defthm glcp-generic-geval-alist-of-gobj-alist-to-param-space
+  (equal (glcp-generic-geval-alist (gobj-alist-to-param-space alist pathcond) env)
+         (glcp-generic-geval-alist
+          alist (genv-unparam pathcond env)))
+  :hints (("goal" :induct (gobj-alist-to-param-space alist pathcond)
+           :in-theory (enable glcp-generic-geval-alist))))
+
+(defthm glcp-generic-geval-alist-of-unparam-param-env
+  (implies (bfr-eval p env)
+           (equal (glcp-generic-geval-alist x (cons (bfr-unparam-env
+                                                     p (bfr-param-env p env))
+                                                    var-env))
+                  (glcp-generic-geval-alist x (cons env var-env))))
+  :hints(("Goal" :in-theory (enable glcp-generic-geval-alist))))
+
+
+
+
+
+(encapsulate nil
+  (local (defthm bfr-lookup-to-param-space-with-unparam-env-rev
+           (implies (syntaxp (not (and (consp env)
+                                       (eq (car env) 'bfr-param-env))))
+                    (equal (bfr-lookup n (bfr-unparam-env p env))
+                           (bfr-eval (bfr-to-param-space p (bfr-var n)) env)))))
+
+  (local (defthm bfr-eval-to-param-space-with-unparam-env-rev
+           (implies (syntaxp (not (and (consp env)
+                                       (eq (car env) 'bfr-param-env))))
+                    (equal (bfr-eval x (bfr-unparam-env p env))
+                           (bfr-eval (bfr-to-param-space p x) env)))))
+  (local (in-theory (disable bfr-eval-to-param-space-with-unparam-env)))
+
+  (defthm bvar-db-env-ok-of-unparam-param
+    (implies (bfr-eval pathcond bfr-env)
+             (equal (glcp-generic-bvar-db-env-ok
+                     bvar-db p bound (cons (bfr-unparam-env pathcond (bfr-param-env pathcond bfr-env))
+                                           var-env))
+                    (glcp-generic-bvar-db-env-ok
+                     bvar-db p bound (cons bfr-env var-env))))
+    :hints (("goal" :cases ((glcp-generic-bvar-db-env-ok
+                             bvar-db p bound (cons bfr-env var-env))))
+            (and stable-under-simplificationp
+                 (if (eq (caar clause) 'not)
+                     `(:expand (,(car (last clause)))
+                     :use ((:instance glcp-generic-bvar-db-env-ok-necc
+                            (env (cons bfr-env
+                                       var-env))
+                            (n (glcp-generic-bvar-db-env-ok-witness
+                                bvar-db p bound (cons (bfr-unparam-env pathcond
+                                                        (bfr-param-env pathcond bfr-env))
+                                                      var-env)))))
+                     :in-theory (disable glcp-generic-bvar-db-env-ok-necc))
+                   `(:expand (,(car clause))
+                     :use ((:instance glcp-generic-bvar-db-env-ok-necc
+                            (env (cons (bfr-unparam-env pathcond
+                                                        (bfr-param-env pathcond bfr-env))
+                                       var-env))
+                            (n (glcp-generic-bvar-db-env-ok-witness
+                                bvar-db p bound (cons bfr-env var-env)))))
+                     :in-theory (disable glcp-generic-bvar-db-env-ok-necc)))))))
+
+
+
+
+(defsection parametrize-bvar-db
+  (local (in-theory (enable parametrize-bvar-db parametrize-bvar-db-aux)))
+  (local (include-book "arithmetic/top-with-meta" :dir :system))
+  (defthm get-bvar->term-of-parametrize-bvar-db-aux
+    (implies (and (<= (base-bvar$a bvar-db1) (nfix m))
+                  (< (nfix m) (+ (next-bvar$a bvar-db1)
+                                 (- (next-bvar$a bvar-db) (nfix n)))))
+             (equal (get-bvar->term$a m (parametrize-bvar-db-aux n p bvar-db bvar-db1))
+                    (if (<= (next-bvar$a bvar-db1) (nfix m))
+                        (gobj-to-param-space
+                         (get-bvar->term$a (+ (- (nfix m) (next-bvar$a bvar-db1))
+                                              (nfix n))
+                                           bvar-db)
+                         p)
+                      (get-bvar->term$a m bvar-db1)))))
+
+  (defthm base-bvar-of-parametrize-bvar-db-aux
+    (equal (base-bvar$a (parametrize-bvar-db-aux n p bvar-db bvar-db1))
+           (base-bvar$a bvar-db1)))
+
+  (defthm next-bvar-of-parametrize-bvar-db-aux
+    (equal (next-bvar$a (parametrize-bvar-db-aux n p bvar-db bvar-db1))
+           (+ (nfix (- (next-bvar$a bvar-db) (nfix n))) (next-bvar$a bvar-db1))))
+
+
+  (defthm normalize-parametrize-bvar-db
+    (implies (syntaxp (not (equal bvar-db1 ''nil)))
+             (equal (parametrize-bvar-db p bvar-db bvar-db1)
+                    (parametrize-bvar-db p bvar-db nil))))
+
+  (defthm base-bvar-of-parametrize-bvar-db
+    (equal (base-bvar$a (parametrize-bvar-db p bvar-db bvar-db1))
+           (base-bvar$a bvar-db)))
+
+  (defthm next-bvar-of-parametrize-bvar-db
+    (equal (next-bvar$a (parametrize-bvar-db p bvar-db bvar-db1))
+           (next-bvar$a bvar-db)))
+
+  (defthm get-bvar->term-of-parametrize-bvar-db
+    (implies (and (<= (base-bvar$a bvar-db) (nfix n))
+                  (< (nfix n) (next-bvar$a bvar-db)))
+             (equal (get-bvar->term$a n (parametrize-bvar-db p bvar-db bvar-db1))
+                    (gobj-to-param-space
+                     (get-bvar->term$a n bvar-db) p))))
+
+  (defthm bvar-db-orderedp-of-parametrize-bvar-db
+    (implies (bvar-db-orderedp t bvar-db)
+             (bvar-db-orderedp p (parametrize-bvar-db p bvar-db bvar-db1)))
+    :hints (("goal" :expand ((bvar-db-orderedp p (parametrize-bvar-db p bvar-db nil)))
+             :in-theory (disable parametrize-bvar-db))))
+
+  (defthm glcp-generic-bvar-db-env-ok-of-parametrize-bvar-db
+    (equal (glcp-generic-bvar-db-env-ok
+            (parametrize-bvar-db p bvar-db bvar-db1)
+            p bound env)
+           (glcp-generic-bvar-db-env-ok
+            bvar-db t bound
+            (cons (bfr-unparam-env p (car env)) (cdr env))))
+    :hints (("goal" :cases ((glcp-generic-bvar-db-env-ok
+                             bvar-db t bound
+                             (cons (bfr-unparam-env p (car env)) (cdr env)))))
+            (and stable-under-simplificationp
+                 (let* ((lit (if (eq (caar clause) 'not)
+                                 (car (last clause))
+                               (car clause)))
+                        (other (if (eq (caar clause) 'not)
+                                   (cadar clause)
+                                 (cadar (last clause))))
+                        (witness (cons 'glcp-generic-bvar-db-env-ok-witness
+                                       (cdr lit))))
+                   `(:expand (,lit)
+                     :in-theory (enable genv-unparam)
+                     :use ((:instance glcp-generic-bvar-db-env-ok-necc
+                            (n ,witness)
+                            (p ,(third other))
+                            (env ,(nth 4 other))))))))))
+
+
+
+;; ;; bvar-db1 is the real bvar-db from the hyp, bvar-db is initially empty
+;; (defund glcp-generic-interp-concl
+;;   (term alist pathcond clk config interp-st bvar-db1 bvar-db state)
+;;   (declare (xargs :guard (and (pseudo-termp term)
+;;                               (natp clk)
+;;                               (acl2::interp-defs-alistp obligs)
+;;                               (glcp-config-p config)
+;;                               (acl2::interp-defs-alistp (glcp-config->overrides config)))
+;;                   :stobjs (bvar-db bvar-db1 state)
+;;                   :verify-guards nil))
+;;   (b* ((al (gobj-alist-to-param-space alist pathcond))
+;;        (bvar-db (init-bvar-db (base-bvar bvar-db1) bvar-db))
+;;        (bvar-db (parametrize-bvar-db pathcond bvar-db1 bvar-db))
+;;        (config (glcp-config-update-param pathcond config))
+;;        (pathcond1 (bfr-to-param-space pathcond pathcond)))
+;;     (glcp-generic-interp-top-level-term
+;;      term al pathcond1 clk config interp-st bvar-db state)))
+
+
+(defsection glcp-generic-interp-concl
+  (local (in-theory (enable glcp-generic-interp-concl)))
+  (local (set-default-hints '('(:do-not-induct t))))
+
+  (defthm glcp-generic-interp-concl-norm
+    (implies (syntaxp (not (equal bvar-db ''nil)))
+             (equal (glcp-generic-interp-concl
+                     term alist pathcond clk config interp-st bvar-db1 bvar-db state)
+                    (glcp-generic-interp-concl
+                     term alist pathcond clk config interp-st bvar-db1 nil state))))
+
+  (defthm glcp-generic-interp-concl-correct
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (bind-free
+                     (if (and (consp bfr-env)
+                              (eq (car bfr-env) 'bvar-db-fix-env))
+                         `((env . (cons ,bfr-env ,(nth 6 bfr-env))))
+                       `((free-var . free-var))))
+                    (bfr-eval pathcond (bfr-unparam-env pathcond bfr-env))
+                    (bfr-eval (is-constraint interp-st) (bfr-unparam-env pathcond bfr-env))
+                    (not erp)
+                    (acl2::interp-defs-alistp (is-obligs interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses
+                       (is-obligs interp-st1))))
+                    ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+                    (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+                    (glcp-generic-bvar-db-env-ok
+                     bvar-db2 pathcond (next-bvar$a bvar-db2)
+                     env)
+                    (consp env)
+                    (equal (car env) bfr-env)
+                    (equal (w state0) (w state))
+                    (pseudo-termp term)
+                    (alistp alist))
+               (iff (bfr-eval val bfr-env)
+                    (glcp-generic-geval-ev
+                     term (glcp-generic-geval-alist
+                           alist
+                           (cons (bfr-unparam-env pathcond (car env))
+                                 (cdr env)))))))
+    :hints(("Goal" :in-theory (enable genv-unparam)
+            :do-not-induct t))
+    :otf-flg t)
+
+  (defthm glcp-generic-interp-concl-constraint-preserved
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (bind-free
+                     (if (and (consp bfr-env)
+                              (eq (car bfr-env) 'bvar-db-fix-env))
+                         `((env . (cons ,bfr-env ,(nth 6 bfr-env))))
+                       `((free-var . free-var))))
+                    (bfr-eval (is-constraint interp-st) (bfr-unparam-env pathcond bfr-env))
+                    (acl2::interp-defs-alistp (is-obligs interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses
+                       (is-obligs interp-st1))))
+                    ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+                    (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+                    (glcp-generic-bvar-db-env-ok
+                     bvar-db2 pathcond (next-bvar$a bvar-db2)
+                     env)
+                    (consp env)
+                    (equal (car env) bfr-env)
+                    (equal (w state0) (w state))
+                    (pseudo-termp term)
+                    (alistp alist))
+               (bfr-eval (nth *is-constraint* interp-st1) bfr-env)))
+    :hints(("Goal" :in-theory (enable genv-unparam)
+            :do-not-induct t))
+    :otf-flg t)
+
+  (defthm w-state-preserved-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (equal (w state1) (w state))))
+
+  (defthm interp-defs-alistp-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (acl2::interp-defs-alistp (nth *is-obligs* interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (pseudo-termp term)
+                    (not erp))
+               (acl2::interp-defs-alistp (nth *is-obligs* interp-st1)))))
+
+  (defthm state-p1-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (state-p1 state)
+               (state-p1 state1))))
+
+  (defthm bad-obligs-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (not (glcp-generic-geval-ev-theoremp
+                          (conjoin-clauses
+                           (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st)))))
+                    (not erp))
+               (not (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st1))))))))
+
+  (defthm forward-obligs-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st1))))
+                    (not erp))
+               (glcp-generic-geval-ev-theoremp
+                (conjoin-clauses
+                 (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st))))))
+    :rule-classes :forward-chaining)
+
+  (defthm bvar-db-env-ok-preserved-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (<= bound (next-bvar$a bvar-db1))
+                    (bfr-eval pathcond (car env))
+                    (glcp-generic-bvar-db-env-ok bvar-db1 t bound
+                                                 (cons (bfr-unparam-env pathcond (car env))
+                                                       (cdr env))))
+               (glcp-generic-bvar-db-env-ok bvar-db2 pathcond bound env))))
+
+  (defthm bvar-db-env-ok-next-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (not (glcp-generic-bvar-db-env-ok
+                          (parametrize-bvar-db pathcond bvar-db1 nil)
+                          pathcond (next-bvar$a bvar-db1)
+                          env)))
+               (not (glcp-generic-bvar-db-env-ok
+                     bvar-db2 pathcond (next-bvar$a bvar-db2) env)))))
+
+  (defthm bvar-db-env-ok-next-of-glcp-generic-interp-concl-forward
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (glcp-generic-bvar-db-env-ok
+                bvar-db2 pathcond (next-bvar$a bvar-db2) env)
+               (glcp-generic-bvar-db-env-ok
+                bvar-db1
+                t (next-bvar$a bvar-db1)
+                (cons (bfr-unparam-env pathcond (car env))
+                      (cdr env)))))
+    :rule-classes :forward-chaining)
+
+  (defthm base-bvar-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (equal (base-bvar$a bvar-db2) (base-bvar$a bvar-db1))))
+
+  (defthm next-bvar-incr-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (>= (next-bvar$a bvar-db2) (next-bvar$a bvar-db1)))
+    :rule-classes :linear)
+
+  (defthm get-bvar->term-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (<= (base-bvar$a bvar-db1) (nfix n))
+                    (< (nfix n) (next-bvar$a bvar-db1)))
+               (equal (get-bvar->term$a n bvar-db2)
+                      (gobj-to-param-space (get-bvar->term$a n bvar-db1)
+                                           pathcond)))))
+
+  ;; (defthm get-term->bvar-of-glcp-generic-interp-concl
+  ;;   (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+  ;;         (glcp-generic-interp-concl
+  ;;          term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+  ;;     (implies (get-term->bvar$a x bvar-db)
+  ;;              (equal (get-term->bvar$a x bvar-db1)
+  ;;                     (get-term->bvar$a x bvar-db)))))
+
+
+  (defthm vars-bounded-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (<= (next-bvar$a bvar-db2) (nfix k))
+                    (bfr-vars-bounded k pathcond)
+                    (bfr-eval pathcond env)
+                    (bvar-db-orderedp t bvar-db1)
+                    (gbc-db-vars-bounded k t (nth *is-constraint-db* interp-st))
+                    (gobj-alist-vars-bounded k t alist))
+               (and (pbfr-vars-bounded k pathcond val)
+                    (gbc-db-vars-bounded k pathcond (nth *is-constraint-db* interp-st1))))))
+
+  (defthm constraint-vars-bounded-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state)))
+      (implies (and (<= (next-bvar$a bvar-db2) (nfix k))
+                    (bfr-vars-bounded k pathcond)
+                    (bfr-eval pathcond env)
+                    (bvar-db-orderedp t bvar-db1)
+                    (gbc-db-vars-bounded k t (nth *is-constraint-db* interp-st))
+                    (gobj-alist-vars-bounded k t alist)
+                    (pbfr-vars-bounded k t (nth *is-constraint* interp-st)))
+               (pbfr-vars-bounded k pathcond (nth *is-constraint* interp-st1)))))
+
+  (defthm bvar-db-ordered-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state))
+         (k (next-bvar$a bvar-db1)))
+      (implies (and (bfr-vars-bounded k pathcond)
+                    (bfr-eval pathcond env)
+                    (bvar-db-orderedp t bvar-db1)
+                    (gbc-db-vars-bounded k t (nth *is-constraint-db* interp-st))
+                    (gobj-alist-vars-bounded k t alist))
+               (bvar-db-orderedp pathcond bvar-db2))))
+
+
+  ;; (defthm fix-env-correct-of-glcp-generic-interp-concl-no-param
+  ;;   (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+  ;;         (glcp-generic-interp-concl
+  ;;          term alist pathcond clk config interp-st bvar-db1 bvar-db state))
+  ;;        (bfr-env1 (bvar-db-fix-env (next-bvar$a bvar-db1)
+  ;;                                   (next-bvar$a bvar-db)
+  ;;                                   bvar-db1 t bfr-env var-env)))
+  ;;     (implies (and (equal t (glcp-config->param-bfr config))
+  ;;                   (bvar-db-orderedp t bvar-db)
+  ;;                   (gobj-alist-vars-bounded (next-bvar$a bvar-db) t alist)
+  ;;                   (glcp-generic-bvar-db-env-ok
+  ;;                    bvar-db t (next-bvar$a bvar-db) (cons bfr-env var-env)))
+  ;;              (glcp-generic-bvar-db-env-ok
+  ;;               bvar-db1 t (next-bvar$a bvar-db1) (cons bfr-env1 var-env))))
+  ;;   :hints(("Goal" :in-theory (disable glcp-generic-interp-concl
+  ;;                                      bfr-eval-consts bfr-eval-booleanp)
+  ;;           :use ((:theorem (bfr-eval t env))))
+  ;;          (and stable-under-simplificationp
+  ;;               '(:in-theory (enable bfr-eval-consts)))))
+
+  (defthm fix-env-correct-of-glcp-generic-interp-concl
+    (b* (((mv ?val ?erp ?interp-st1 ?bvar-db2 ?state1)
+          (glcp-generic-interp-concl
+           term alist pathcond clk config interp-st bvar-db1 bvar-db state))
+         (bfr-env1 (bvar-db-fix-env (next-bvar$a bvar-db2)
+                                    (next-bvar$a bvar-db1)
+                                    bvar-db2 pathcond
+                                    (bfr-param-env pathcond bfr-env)
+                                    var-env)))
+      (implies (and (bfr-vars-bounded (next-bvar$a bvar-db1) pathcond)
+                    (bfr-eval pathcond bfr-env)
+                    (bvar-db-orderedp t bvar-db1)
+                    (gobj-alist-vars-bounded (next-bvar$a bvar-db1) t alist)
+                    (glcp-generic-bvar-db-env-ok
+                     bvar-db1 t (next-bvar$a bvar-db1)
+                     (cons bfr-env var-env))
+                    (gbc-db-vars-bounded (next-bvar$a bvar-db1) t (nth *is-constraint-db* interp-st)))
+               (glcp-generic-bvar-db-env-ok
+                bvar-db2 pathcond (next-bvar$a bvar-db2) (cons bfr-env1 var-env))))
+    :hints (("goal" :do-not-induct t))))
+
+
+
+
+
+
+
+
+
+
+
+(defthm bvar-db-fix-env-eval-gobj-alist-vars-bounded-no-param
+  (implies (and (gobj-alist-vars-bounded min t x)
+                (<= (nfix n) (next-bvar$a bvar-db)))
+           (let ((env-n (bvar-db-fix-env
+                         n min bvar-db t env var-env)))
+             (equal (glcp-generic-geval-alist x (cons env-n var-env))
+                    (glcp-generic-geval-alist x (cons env var-env)))))
+  :hints(("Goal" :in-theory (enable glcp-generic-geval-alist))))
+
+
+(defthm bvar-db-fix-env-eval-gobj-alist-vars-bounded-unparam-rw
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+            (bfr-eval p env)
+            (bfr-vars-bounded min p)
+            (gobj-alist-vars-bounded min t x)
+            (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (glcp-generic-geval-alist x (cons (bfr-unparam-env p env-n) var-env))
+                    (glcp-generic-geval-alist x (cons env var-env)))))
+  :hints(("Goal" :in-theory (enable glcp-generic-geval-alist))))
+
+
+(defthm bvar-db-fix-env-eval-gobj-vars-bounded-param-rw
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+            (bfr-eval p env)
+            (bfr-vars-bounded min p)
+            (gobj-vars-bounded min p gobj)
+            (< (nfix min) (nfix n))
+            (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (glcp-generic-geval gobj (cons env-n var-env))
+                    (glcp-generic-geval gobj (cons (bfr-param-env p env) var-env)))))
+  :hints (("goal" :use ((:instance bvar-db-fix-env-eval-gobj-vars-bounded-lemma
+                         (m min)))
+           :expand ((bvar-db-fix-env min min bvar-db p (bfr-param-env p env)
+                                     var-env))
+           :in-theory (disable bvar-db-fix-env-eval-gobj-vars-bounded-lemma))))
+
+(defthm bvar-db-fix-env-eval-gobj-alist-vars-bounded-param-rw
+  (implies (and ; (bvar-db-orderedp p bvar-db)
+            (bfr-eval p env)
+            (bfr-vars-bounded min p)
+            (gobj-alist-vars-bounded min p x)
+            (< (nfix min) (nfix n))
+            (<= (nfix n) (next-bvar$a bvar-db)))
+           (let* ((env-n (bvar-db-fix-env n min bvar-db p (bfr-param-env p env)
+                                          var-env)))
+             (equal (glcp-generic-geval-alist x (cons env-n var-env))
+                    (glcp-generic-geval-alist x (cons (bfr-param-env p env) var-env)))))
+  :hints(("Goal" :in-theory (enable glcp-generic-geval-alist))))
+
+
+
+(defthm bvar-db-env-ok-of-init-bvar-db
+  (glcp-generic-bvar-db-env-ok (init-bvar-db$a base bvar-db) p bound env)
+  :hints(("Goal" :in-theory (enable glcp-generic-bvar-db-env-ok))))
+
+
+
+;; (defund glcp-generic-interp-hyp/concl
+;;   (hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)
+;;   (declare (xargs :guard (and (pseudo-termp hyp)
+;;                               (pseudo-termp concl)
+;;                               (natp clk)
+;;                               (acl2::interp-defs-alistp obligs)
+;;                               (glcp-config-p config)
+;;                               (acl2::interp-defs-alistp (glcp-config->overrides config)))
+;;                   :stobjs (bvar-db bvar-db1 state)
+;;                   :verify-guards nil))
+;;   (b* ((bvar-db (init-bvar-db next-bvar bvar-db))
+;;        (bvar-db1 (init-bvar-db next-bvar bvar-db1))
+;;        (config (glcp-config-update-param t config))
+;;        ((mv er obligs hyp-bfr bvar-db state)
+;;         (glcp-generic-interp-top-level-term
+;;          hyp alist t clk config interp-st bvar-db state))
+;;        ((when er)
+;;         (mv er obligs hyp-bfr nil bvar-db bvar-db1 state))
+;;        ((when (not hyp-bfr))
+;;         (mv "Hypothesis is not satisfiable"
+;;             obligs hyp-bfr nil bvar-db bvar-db1 state))
+;;        ((mv er obligs concl-bfr bvar-db1 state)
+;;         (glcp-generic-interp-concl
+;;          concl alist hyp-bfr clk config interp-st bvar-db bvar-db1 state)))
+;;     (mv er obligs hyp-bfr concl-bfr bvar-db bvar-db1 state)))
+
+(defund-nx glcp-generic-interp-hyp/concl-env
+  (env hyp concl alist clk config interp-st next-bvar state)
+  (b* ((bvar-db (init-bvar-db next-bvar nil))
+       (bvar-db1 (init-bvar-db next-bvar nil))
+       (config (glcp-config-update-param t config))
+       ((mv  hyp-bfr ?er ?interp-st bvar-db1 state)
+        (glcp-generic-interp-top-level-term
+         hyp alist t clk config interp-st bvar-db1 state))
+       (bfr-env1 (bvar-db-fix-env (next-bvar bvar-db1)
+                                  next-bvar bvar-db1 t
+                                  (car env) (cdr env)))
+       ((unless (glcp-generic-geval-ev
+                 hyp (glcp-generic-geval-alist alist env)))
+        bfr-env1)
+       ((mv ?concl-bfr ?er ?obligs bvar-db state)
+        (glcp-generic-interp-concl
+         concl alist hyp-bfr clk config interp-st bvar-db1 nil state)))
+    (bvar-db-fix-env (next-bvar bvar-db)
+                     (next-bvar bvar-db1)
+                     bvar-db hyp-bfr
+                     (bfr-param-env hyp-bfr bfr-env1)
+                     (cdr env))))
+
+
+
+(defsection glcp-generic-interp-hyp/concl
+  (local (in-theory (enable glcp-generic-interp-hyp/concl
+                            glcp-generic-interp-hyp/concl-env)))
+
+  (defthm glcp-generic-interp-hyp/concl-norm
+    (implies (syntaxp (not (and (equal bvar-db ''nil)
+                                (equal bvar-db1 ''nil))))
+             (equal (glcp-generic-interp-hyp/concl
+                     hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)
+                    (glcp-generic-interp-hyp/concl
+                     hyp concl alist clk config interp-st next-bvar nil nil state))))
+
+  (defthm glcp-generic-interp-hyp/concl-correct
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (not erp)
+                    (bfr-eval (nth *is-constraint* interp-st)
+                              (bfr-unparam-env hyp-bfr bfr-env))
+                    (acl2::interp-defs-alistp (nth *is-obligs* interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses
+                       (nth *is-obligs* interp-st1))))
+                    (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+                    (glcp-generic-bvar-db-env-ok
+                     concl-bvar-db hyp-bfr (next-bvar$a concl-bvar-db) env)
+                    (consp env)
+                    (equal bfr-env (car env))
+                    (equal (w state0) (w state))
+                    (pseudo-termp hyp)
+                    (pseudo-termp concl)
+                    (alistp alist))
+               (and (iff (bfr-eval hyp-bfr (bfr-unparam-env hyp-bfr bfr-env))
+                         (glcp-generic-geval-ev
+                          hyp
+                          (glcp-generic-geval-alist
+                           alist (cons (bfr-unparam-env hyp-bfr (car env))
+                                       (cdr env)))))
+                    (implies (bfr-eval hyp-bfr (bfr-unparam-env hyp-bfr bfr-env))
+                             (iff (bfr-eval concl-bfr bfr-env)
+                                  (glcp-generic-geval-ev
+                                   concl
+                                   (glcp-generic-geval-alist
+                                    alist (cons (bfr-unparam-env hyp-bfr (car env))
+                                                (cdr env)))))))))
+    :hints(("Goal" :in-theory (e/d (genv-unparam))
+            :do-not-induct t)))
+
+  (defthm w-state-preserved-of-glcp-generic-interp-hyp/concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (equal (w state1) (w state))))
+
+  (defthm interp-defs-alistp-of-glcp-generic-interp-hyp/concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (acl2::interp-defs-alistp (nth *is-obligs* interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (pseudo-termp hyp)
+                    (pseudo-termp concl)
+                    (not erp))
+               (acl2::interp-defs-alistp (nth *is-obligs* interp-st1)))))
+
+  (defthm state-p1-of-glcp-generic-interp-hyp/concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (state-p1 state)
+               (state-p1 state1))))
+
+  (defthm bad-obligs-of-glcp-generic-interp-hyp/concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (not (glcp-generic-geval-ev-theoremp
+                          (conjoin-clauses
+                           (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st)))))
+                    (not erp))
+               (not (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st1))))))))
+
+  (defthm forward-obligs-of-glcp-generic-interp-hyp/concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st1))))
+                    (not erp))
+               (glcp-generic-geval-ev-theoremp
+                (conjoin-clauses
+                 (acl2::interp-defs-alist-clauses (nth *is-obligs* interp-st))))))
+    :rule-classes :forward-chaining)
+
+  ;; (defthm bvar-db-env-ok-preserved-of-glcp-generic-interp-hyp/concl
+  ;;   (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+  ;;         (glcp-generic-interp-hyp/concl
+  ;;          hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+  ;;     (implies (and (<= bound (next-bvar$a bvar-db))
+  ;;                   (equal p (glcp-config->param-bfr config)))
+  ;;              (equal (glcp-generic-bvar-db-env-ok bvar-db1 p bound env)
+  ;;                     (glcp-generic-bvar-db-env-ok bvar-db p bound env)))))
+
+  ;; (defthm bvar-db-env-ok-next-of-glcp-generic-interp-hyp/concl
+  ;;   (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+  ;;         (glcp-generic-interp-hyp/concl
+  ;;          hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+  ;;     (implies (and (not (glcp-generic-bvar-db-env-ok
+  ;;                         bvar-db p (next-bvar$a bvar-db) env))
+  ;;                   (equal p (glcp-config->param-bfr config)))
+  ;;              (not (glcp-generic-bvar-db-env-ok
+  ;;                    bvar-db1 p (next-bvar$a bvar-db1) env)))))
+
+  (defthm base-bvar-of-glcp-generic-interp-hyp/concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (and (equal (base-bvar$a hyp-bvar-db) (nfix next-bvar))
+           (equal (base-bvar$a concl-bvar-db) (nfix next-bvar)))))
+
+  (defthm next-bvar-incr-of-glcp-generic-interp-hyp/concl-hyp
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (>= (next-bvar$a hyp-bvar-db) (nfix next-bvar)))
+    :rule-classes :linear)
+
+  (defthm next-bvar-incr-of-glcp-generic-interp-hyp/concl-concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (>= (next-bvar$a concl-bvar-db) (nfix next-bvar)))
+    :rule-classes :linear)
+
+  (defthm get-bvar->term-of-glcp-generic-interp-hyp/concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (<= (base-bvar$a hyp-bvar-db) (nfix n))
+                    (< (nfix n) (next-bvar$a hyp-bvar-db))
+                    (not erp))
+               (equal (get-bvar->term$a n concl-bvar-db)
+                      (gobj-to-param-space (get-bvar->term$a n hyp-bvar-db)
+                                           hyp-bfr)))))
+
+  ;; (defthm get-term->bvar-of-glcp-generic-interp-hyp/concl
+  ;;   (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+  ;;         (glcp-generic-interp-hyp/concl
+  ;;          hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+  ;;     (implies (get-term->bvar$a x bvar-db)
+  ;;              (equal (get-term->bvar$a x bvar-db1)
+  ;;                     (get-term->bvar$a x bvar-db)))))
+
+
+  (defthm vars-bounded-of-glcp-generic-interp-hyp/concl-hyp
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (<= (next-bvar$a hyp-bvar-db) (nfix k))
+                    (gobj-alist-vars-bounded k t alist)
+                    (gbc-db-vars-bounded k t (nth *is-constraint-db* interp-st)))
+               (pbfr-vars-bounded k t hyp-bfr)))
+    :hints (("goal" :use ((:instance bfr-eval-consts))
+             :in-theory (disable bfr-eval-consts bfr-eval-booleanp))))
+
+  (defthm vars-bounded-of-glcp-generic-interp-hyp/concl-concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (<= (next-bvar$a concl-bvar-db) (nfix k))
+                    (bfr-eval hyp-bfr env)
+                    (gobj-alist-vars-bounded next-bvar t alist)
+                    (gbc-db-vars-bounded next-bvar t (nth *is-constraint-db* interp-st)))
+               (pbfr-vars-bounded k hyp-bfr concl-bfr)))
+    :hints (("goal" :use ((:instance bfr-eval-consts))
+             :in-theory (disable bfr-eval-consts bfr-eval-booleanp))))
+
+  (defthm constraint-vars-bounded-of-glcp-generic-interp-hyp/concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (<= (next-bvar$a concl-bvar-db) (nfix k))
+                    (not erp)
+                    (bfr-eval hyp-bfr env)
+                    (gobj-alist-vars-bounded next-bvar t alist)
+                    (pbfr-vars-bounded next-bvar t (nth *is-constraint* interp-st))
+                    (gbc-db-vars-bounded next-bvar t (nth *is-constraint-db* interp-st)))
+               (pbfr-vars-bounded k hyp-bfr (nth *is-constraint* interp-st1))))
+    :hints (("goal" :use ((:instance bfr-eval-consts))
+             :in-theory (disable bfr-eval-consts bfr-eval-booleanp))))
+
+  (defthm bvar-db-ordered-of-glcp-generic-interp-hyp/concl-hyp
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (gobj-alist-vars-bounded next-bvar t alist)
+                    (gbc-db-vars-bounded next-bvar t (nth *is-constraint-db* interp-st)))
+               (bvar-db-orderedp t hyp-bvar-db)))
+    :hints (("goal" :use ((:instance bfr-eval-consts))
+             :in-theory (disable bfr-eval-consts bfr-eval-booleanp))))
+
+  (defthm bvar-db-ordered-of-glcp-generic-interp-hyp/concl-concl
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)))
+      (implies (and (gobj-alist-vars-bounded next-bvar t alist)
+                    (gbc-db-vars-bounded next-bvar t (nth *is-constraint-db* interp-st))
+                    (bfr-eval hyp-bfr henv))
+               (bvar-db-orderedp hyp-bfr concl-bvar-db)))
+    :hints (("goal" :use ((:instance bfr-eval-consts))
+             :in-theory (disable bfr-eval-consts bfr-eval-booleanp))))
+
+  (local (defthm glcp-generic-interp-top-level-term-correct-bind
+           (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+                 (glcp-generic-interp-top-level-term
+                  term alist pathcond clk config interp-st bvar-db state)))
+             (implies (and (bind-free
+                            `((env . (cons ,bfr-env (cdr env)))))
+                           (bfr-eval pathcond bfr-env)
+                           (bfr-eval (is-constraint interp-st) bfr-env)
+                           (not erp)
+                           (acl2::interp-defs-alistp (is-obligs interp-st))
+                           (acl2::interp-defs-alistp (glcp-config->overrides config))
+                           (glcp-generic-geval-ev-theoremp
+                            (conjoin-clauses
+                             (acl2::interp-defs-alist-clauses
+                              (is-obligs interp-st1))))
+                           ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+                           (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+                           (equal p (glcp-config->param-bfr config))
+                           (glcp-generic-bvar-db-env-ok
+                            bvar-db1 p (next-bvar$a bvar-db1) env)
+                           (equal bfr-env (car env))
+                           (equal (w state0) (w state))
+                           (pseudo-termp term)
+                           (alistp alist))
+                      (iff (bfr-eval val bfr-env)
+                           (glcp-generic-geval-ev term (glcp-generic-geval-alist
+                                                        alist env)))))
+           :hints(("Goal" :in-theory (e/d ()
+                                          (glcp-generic-interp-top-level-term))
+                   :use ((:instance glcp-generic-interp-correct-term
+                          (x term) (contexts '(iff))))))))
+
+  (local (defthm glcp-generic-interp-top-level-term-preserves-constraint-bind
+           (b* (((mv ?val ?erp ?interp-st1 ?bvar-db1 ?state1)
+                 (glcp-generic-interp-top-level-term
+                  term alist pathcond clk config interp-st bvar-db state)))
+             (implies (and (bind-free
+                            `((env . (cons ,bfr-env (cdr env)))))
+                           (bfr-eval (is-constraint interp-st) bfr-env)
+                           (acl2::interp-defs-alistp (is-obligs interp-st))
+                           (acl2::interp-defs-alistp (glcp-config->overrides config))
+                           (glcp-generic-geval-ev-theoremp
+                            (conjoin-clauses
+                             (acl2::interp-defs-alist-clauses
+                              (is-obligs interp-st1))))
+                           ;; (glcp-generic-geval-ev-meta-extract-global-facts)
+                           (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+                           (equal p (glcp-config->param-bfr config))
+                           (glcp-generic-bvar-db-env-ok
+                            bvar-db1 p (next-bvar$a bvar-db1) env)
+                           (equal bfr-env (car env))
+                           (equal (w state0) (w state))
+                           (pseudo-termp term)
+                           (alistp alist))
+                      (bfr-eval (nth *is-constraint* interp-st1) bfr-env)))
+           :hints (("goal" :use
+                    glcp-generic-interp-top-level-term-preserves-constraint
+                    :in-theory (disable glcp-generic-interp-top-level-term-preserves-constraint)))))
+
+  (defthm glcp-generic-interp-hyp/concl-env-correct
+    (b* (((mv ?hyp-bfr ?concl-bfr ?concl-bvar-db ?erp ?interp-st1 ?hyp-bvar-db ?state1)
+          (glcp-generic-interp-hyp/concl
+           hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state))
+         (fixed-env
+          (glcp-generic-interp-hyp/concl-env
+           env hyp concl alist clk config interp-st next-bvar state)))
+      (implies (and (not erp)
+                    (acl2::interp-defs-alistp (nth *is-obligs* interp-st))
+                    (acl2::interp-defs-alistp (glcp-config->overrides config))
+                    (glcp-generic-geval-ev-theoremp
+                     (conjoin-clauses
+                      (acl2::interp-defs-alist-clauses
+                       (nth *is-obligs* interp-st1))))
+                    (bfr-eval (nth *is-constraint* interp-st) (car env))
+                    (pbfr-vars-bounded next-bvar t (nth *is-constraint* interp-st))
+                    (glcp-generic-geval-ev-meta-extract-global-facts :state state0)
+                    (equal (w state0) (w state))
+                    (pseudo-termp hyp)
+                    (pseudo-termp concl)
+                    (alistp alist)
+                    (consp env)
+                    (natp next-bvar)
+                    (gobj-alist-vars-bounded next-bvar t alist)
+                    (gbc-db-vars-bounded next-bvar t (nth *is-constraint-db* interp-st))
+                    (glcp-generic-geval-ev
+                     hyp (glcp-generic-geval-alist alist env))
+                    (not (glcp-generic-geval-ev
+                          concl (glcp-generic-geval-alist alist env))))
+               (and (bfr-eval hyp-bfr (bfr-unparam-env hyp-bfr fixed-env))
+                    (not (bfr-eval concl-bfr fixed-env))
+                    (bfr-eval (nth *is-constraint* interp-st1) fixed-env) )))
+    :hints (("goal" :use ((:instance bfr-eval-consts)
+                          (:instance bfr-eval-consts (env (car env))))
+             :in-theory (disable bfr-eval-consts bfr-eval-booleanp)
+             :do-not-induct t))))
diff -Nru acl2-6.2/books/centaur/gl/gl-mbe.lisp acl2-6.3/books/centaur/gl/gl-mbe.lisp
--- acl2-6.2/books/centaur/gl/gl-mbe.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-mbe.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,41 +1,82 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
+(include-book "xdoc/top" :dir :system)
 
-(include-book "centaur/gl/gl-doc-string" :dir :system)
+(defsection gl-mbe
+  :parents (reference)
+  :short "Assert that a particular symbolic object is equivalent to a second
+form, and use the second in place of the first."
 
+  :long "<p>@(call gl-mbe) is defined to simply check whether its two arguments
+SPEC and IMPL are equal, throwing an error if not, and return SPEC.</p>
 
-(defun gl-mbe (spec impl)
-  ":doc-section ACL2::GL
-Assert that a particular symbolic object is equivalent to a second form, and
-use the second in place of the first.~/
-
-GL-MBE is defined to simply check whether its two arguments SPEC and IMPL are
-equal, throwing an error if not, and return SPEC.
-
-However, when GL-MBE is symbolically executed, the equality of the two
+<p>However, when GL-MBE is symbolically executed, the equality of the two
 arguments is checked symbolically.  If it can be proved that they are always
-equal, then IMPL is returned instead of SPEC, otherwise an error is produced.~/
+equal, then IMPL is returned instead of SPEC, otherwise an error is produced.</p>
 
-This is most useful when symbolically executing in AIG mode.  For example,
+<p>This is most useful when symbolically executing in AIG mode.  For example,
 suppose that through a series of shifting operations, the symbolic
 representation of some numeric operand X is expanded to thousands of bits.
 However, the user knows that only the bottom 25 bits may be non-zero.  Then the
 following form may speed up the rest of the computation involving X by cutting
-off all the upper bits, which are known to be zero:
-~bv[]
+off all the upper bits, which are known to be zero:</p>
+
+@({
  (let ((x (gl-mbe x (logand (1- (ash 1 25)) x))))
     ...)
-~ev[]
+})
 
-Here GL-MBE tries to prove that X and the LOGAND expression are equivalent,
+<p>Here GL-MBE tries to prove that X and the LOGAND expression are equivalent,
 that is, their symbolic representations evaluate to the same concrete values
 under all environments.  If this can be proved, X is bound to the LOGAND
 result, which cuts off the upper bits of X, improving symbolic execution
 performance.  However, because logically GL-MBE just returns X, the meaning of
-the specification is unaffected.~/
-"
+the specification is unaffected.</p>"
+
+  (defun gl-mbe (spec impl other-info)
+    (declare (xargs :guard t)
+             (ignore other-info))
+    (prog2$ (or (equal spec impl)
+                (er hard? 'gl-mbe "GL-MBE assertion failed: ~x0 not equal to ~x1~%"
+                    spec impl))
+            spec)))
+
+(defun gl-force-check (x)
+  (declare (xargs :guard t))
+  x)
+
+(defun gl-force-true (x)
+  (declare (xargs :guard t))
+  x)
+
+(defun gl-force-false (x)
   (declare (xargs :guard t))
-  (prog2$ (or (equal spec impl)
-              (er hard? 'gl-mbe "GL-MBE assertion failed: ~x0 not equal to ~x1~%"
-                  spec impl))
-          spec))
+  x)
+
+(defun gl-force-check-strong (x)
+  (declare (xargs :guard t))
+  x)
+
+(table gl-uninterpreted-functions 'gl-force-check-strong t)
+(table gl-uninterpreted-functions 'gl-force-check t)
+(table gl-uninterpreted-functions 'gl-force-true t)
+(table gl-uninterpreted-functions 'gl-force-false t)
diff -Nru acl2-6.2/books/centaur/gl/gl-misc-defs.lisp acl2-6.3/books/centaur/gl/gl-misc-defs.lisp
--- acl2-6.2/books/centaur/gl/gl-misc-defs.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-misc-defs.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,4 +1,22 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
 
@@ -151,7 +169,7 @@
   ()
   (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
   (local (in-theory (enable nonnegative-integer-quotient)))
-  
+
   (defthmd nonnegative-integer-quotient-for-gl
     (equal (nonnegative-integer-quotient i j)
            (floor (nfix i) (nfix j)))))
diff -Nru acl2-6.2/books/centaur/gl/gl-misc-doc.lisp acl2-6.3/books/centaur/gl/gl-misc-doc.lisp
--- acl2-6.2/books/centaur/gl/gl-misc-doc.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-misc-doc.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,327 +0,0 @@
-
-(in-package "GL")
-
-(include-book "gl-doc-string")
-
-(defdoc symbolic-objects ":Doc-section ACL2::GL
-Format of symbolic objects in ~il[GL].~/
-
-Symbolic objects represent functions from the set of environments
- (described below) to the set of ACL2 objects.  The value of an object
-at an environment is given by an evaluator function.  Symbolic objects
-are recursively structured and have a number of constructors.  We
-first briefly describe evaluators (and why there can be more than
-one), then the structure of environment objects, and then the symbolic
-object constructors.~/
-
-a. Evaluators
-
-A symbolic object evaluator is a function with the interface
-~bv[]
- (EV symbolic-object environment) => value.
-~ev[]
-
-There may be several evaluators defined.  The differences between
-evaluators have to do with the G-APPLY symbolic object type, which
-represents a function applied to symbolic arguments.  In order to
-evaluate such an object, the evaluator must be defined such that it
-recognizes the particular function symbol used in the G-APPLY object.
-An evaluator may not evaluate a symbolic object containing a G-APPLY
-construct with an unrecognized function symbol.  One evaluator, named
-EVAL-G-BASE, is initially defined in the GL library, and recognizes
-function symbols of the predefined primitives included with the
-library.  When new symbolic functions are created using the
-MAKE-G-WORLD event, a new evaluator is created that recognizes each of
-the functions for which symbolic counterparts exist, both newly
-created and preexisting.
-
-b. Environments
-
-The basic components of symbolic objects are data structures
-containing UBDDs, which represent Boolean functions of Boolean
-variables, and G-VAR constructs, which represent unconstrained
-variables.  To evaluate a symbolic object, each of these needs to be
-evaluated to a constant.  We evaluate UBDDs to Booleans by choosing to
-take either the true or false branch at each decision level; this
-series of choices is described by a list of Booleans.  We evaluate
-unconstrained variables by looking them up by name in a list of
-bindings.  Therefore an environment is a pair containing a list of
-Booleans used for evaluating UBDDs, and an association list containing
-pairings of variable names and objects, used for evaluating G-VAR
-constructs.
-
-c. Symbolic Object Representation
-
-There are eight basic constructions of symbolic objects, some of which
-may recursively contain other symbolic objects.  We now describe each
-such construction and its evaluation.
-
-Representation: (:G-BOOLEAN . bdd)
-Constructor: (G-BOOLEAN bdd)
-Takes the values T and NIL.  The evaluation of a G-BOOLEAN object is
-simply the evaluation of <bdd> using the list of Booleans in the
-environment.
-
-Representation: (:G-NUMBER . list-of-lists-of-bdds)
-Constructor: (G-NUMBER list-of-lists-of-bdds)
-Evaluates to a (complex rational) number.  <list-of-lists-of-bdds>
-should be a list containing four or fewer lists of UBDDs, which
-represent (in order):
- - the numerator of the real part  (two's-complement, default 0)
- - the denominator of the real part (unsigned, default 1)
- - the numerator of the imaginary part (two's-complement, default 0)
- - the denominator of the imaginary part (unsigned, default 1).
-It is most common to represent an integer, for which only the first
-list need be included.  In both the two's-complement and unsigned
-representations, the bits are ordered from least to most significant,
-with the last bit in the two's complement representation giving the
-sign.  Two's complement lists may be sign-extended by repeating the
-final bit, and unsigned lists may be zero-extended by appending NILs
-after the final bit.
-
-Representation (:G-CONCRETE . object)
-Constructor: (G-CONCRETE object)
-Evaluates to <object>.  While most ACL2 objects evaluate to themselves
-anyway, this construct is useful for representing symbolic objects or
-objects structured similarly to symbolic objects.  For example,
- (:G-CONCRETE . (:G-BOOLEAN . (T . NIL))) evaluates to
- (:G-BOOLEAN . (T . NIL)), whereas
- (:G-BOOLEAN . (T . NIL)) evaluates to either T or NIL.
-
-Representation: (:G-VAR . name)
-Constructor: (G-VAR . name)
-<name> may be any object.  Evaluates to the object bound to <name> in
-the environment.
-
-Representation: (:G-ITE test then . else)
-Constructor: (G-ITE test then else)
-Each of <test>, <then>, and <else> must be symbolic objects.  If
-<test> evaluates to a nonnil value, then this object evaluates to the
-evaluation of <then>; otherwise this evaluates to the evaluation of
-<else>.
-
-Representation: (:G-APPLY fn . arglist)
-Constructor: (G-APPLY fnsym arglist)
-<fn> should be a symbol and <arglist> should be a symbolic object.  If
-the evaluator recognizes <fn> and <arglist> evaluates to <args>, a
-true-list of length equal to the arity of the function <fn>, then this
-object evaluates to the application of <fn> to <args>.  Otherwise, the
-evaluation is undefined; more specifically, it is provably equal to
- (APPLY-STUB <fn> <args>), where APPLY-STUB is an undefined stub
-function.
-
-Representation: atom
-Every atom evaluates to itself.  However, the keyword symbols
-:G-BOOLEAN, :G-NUMBER, :G-CONCRETE, :G-VAR, :G-ITE, and :G-APPLY are
-not themselves well-formed symbolic objects.
-
-Representation: (car . cdr)
-A cons of two symbolic objects evaluates to the cons of their
-evaluations.  Note that since the keyword symbols that distinguish
-symbolic object constructions are not themselves well-formed symbolic
-objects, this construction is unambiguous.
-
-
-d. Miscellaneous notes about symbolic objects and evaluation
-
- - Any function from finitely many Boolean values to the universe of
-ACL2 objects can be expressed using only the G-ITE, G-BOOLEAN, and
-G-CONCRETE forms.
-
- - Most ACL2 objects are themselves well-formed symbolic objects which
-evaluate to themselves.  The exceptions are ones which contain the
-special keyword symbolis :G-BOOLEAN, :G-NUMBER, :G-CONCRETE, :G-VAR,
-:G-ITE, and :G-APPLY.  These atoms (and out of all atoms, only these)
-are not well-formed symbolic objects.  Since a cons of any two
-well-formed symbolic objects is itself a well-formed symbolic objects,
-only objects containing these atoms may be non-well-formed.
-
- - The function that checks well-formedness of symbolic objects is
-GOBJECTP, and the initial evaluator function is GL::EVAL-G-BASE.  It
-may be useful to read the definitions of these functions for reference
-in case the above symbolic object documentation is unclear.
-
-~/")
-
-
-(defdoc debugging-indeterminate-results
-  ":Doc-section ACL2::GL
-Debugging indeterminate results in symbolic executions~/
-
-GL includes two types of symbolic object, G-APPLY and G-VAR, whose symbolic
-truth values can't be syntactically determined.  When the result of
-symbolically executing the conclusion of a conjecture contains one of these
-objects, usually the proof will then fail, since GL can't determine that the
-result is never NIL.
-
-Usually, however, G-VAR forms are not used, and G-APPLY forms are unwelcome if
-they appear at all; they typically result in a symbolic execution failure of
-some sort.  The following are a few common situations in which G-APPLY forms
-are generated:
-
- * The stack depth limit, or \"clock\", was exhausted.
-
- * An unsupported primitive was called.  For example, as of November 2010 we
-do not yet support UNARY-/.
-
- * A primitive was called on an unsupported type of symbolic object.  For
-example, the symbolic counterparts for most arithmetic primitives will produce
-a G-APPLY object if an input seems like it might represent a non-integer
-rational.  Since symbolic operations on rationals are absurdly expensive, we
-simply don't implement them for the most part.
-~/
-
-In order to determine why a G-APPLY form is being created, we suggest using the
-following TRACE$ form:
-
-~bv[]
- (trace$ (gl::g-apply :entry (prog2$ (cw \"Note: G-APPLY called.~~%\")
-                                     (break$))
-                      :exit nil))
-~ev[]
-
-Then when GL::G-APPLY is called in order to create the form, ~c[(BREAK$)] will
-be called.  Usually this will allow you to look at the backtrace and determine
-in what context the first G-APPLY object is being created.
-
-Usually, the culprit is one of the last two bullets above.  Sometimes these
-problems may be worked around by choosing a slightly different implementation
-or by performing symbolic execution using an alternate definition of some
-function (see ~il[GL::ALTERNATE-DEFINITIONS]).  If the clock was to blame, then
-most likely the initial clock is set too low; use the ~c[HYP-CLK] or
-~c[CONCL-CLK] keyword arguments to ~c[DEF-GL-THM] and ~c[DEF-GL-PARAM-THM] to
-set this.~/ ")
-
-
-(defdoc alternate-definitions
-  ":Doc-section ACL2::GL
-Specifying alternative definitions to be used for symbolic execution~/
-
-Sometimes the definition of some function is ill-suited for automatic methods
-of symbolic execution.  For example, ~c[(EVENP X)] is defined as
-~bv[]
- (integerp (* x (/ 2)))
-~ev[]
-and because currently multiplication by a non-integer is not supported in GL,
-this yields a G-APPLY form in most cases.
-
-In this case and several others, one may instead provide an alternate
-definition for the function in question and use that as the basis for GL
-symbolic execution.
-
-In the case of EVENP, the following theorem works as an alternate definition:
-
-~bv[]
- (defthm evenp-is-logbitp
-   (equal (evenp x)
-          (or (not (acl2-numberp x))
-              (and (integerp x)
-                   (equal (logbitp 0 x) nil))))
-   :rule-classes nil)
-~ev[]
-
-After proving this theorem, the following form sets this alternate definition
-as the one GL will use when symbolically interpreting EVENP:
-
-~bv[]
- (gl::set-preferred-def evenp evenp-is-logbitp)
-~ev[]
-
-This form produces one or more table events; ~l[TABLE].
-~/~/")
-
-(defdoc coverage-proofs
-  ":Doc-Section ACL2::GL
-Proving the coverage obligation in GL-based proofs~/
-
-In order to prove a theorem using GL, one must show that the symbolic
-objects chosen to represent the inputs are sufficiently general to
-cover the entire set of interest.  See ~il[GL::SHAPE-SPECS] for a more
-in-depth discussion.  The ~il[DEF-GL-THM] and ~il[DEF-GL-PARAM-THM]
-events as well as the ~il[GL-HINT] hints all provide some degree
-of automation for coverage proofs; often this is enough to satisfy the
-coverage obligation without further user interaction.  Here we discuss
-how to debug coverage proofs that do not succeed.~/
-
-First, it is probably important to be able to re-run a coverage proof
-easily without also re-running the associated symbolic execution,
-which may be quite time-consuming.  To do this, in either the
-~il[DEF-GL-THM] or ~il[DEF-GL-PARAM-THM] forms, add the keyword
-argument ~c[:TEST-SIDE-GOALS T].  This form will then try to prove the
-coverage obligation in exactly the manner it would do during the real
-proof, but it will not attempt to prove the theorem itself, and will
-not record a new ACL2 theorem even if the proof is successful.
-
-During proof output, GL prints a message \"Now proving coverage\" when
-it begins the coverage proof.  The initial goal of a coverage proof
-will also have a hypothesis ~c[(GL::GL-CP-HINT 'GL::COVERAGE)]; this
-hypothesis is logically meaningless, but a useful indicator of the
-beginning of a coverage proof.
-
-When GL's usual set of heuristics is used, a coverage proof proceeds
-as follows.  The initial goal is as follows:
-
-~bv[]
- (implies <theorem-hyps>
-          (gl::shape-spec-obj-in-range
-            <list-of-input-bindings>
-            <list-of-input-variables>))
-~ev[]
-
-The coverage heuristics proceed by repeatedly opening up the
-~c[GL::SHAPE-SPEC-OBJ-IN-RANGE] function.  This effectively splits the
-proof into cases for each component of each variable; for example, if
-one variable's shape specifier binding is a cons of two :G-NUMBER
-forms, then its CAR and CDR will be considered separately.
-Eventually, this results in several subgoals, each with conjunction of
-requirements for some component of some input.
-
-During this process of opening the ~c[GL::SHAPE-SPEC-OBJ-IN-RANGE]
-conclusion, the coverage heuristics also examine and manipulate the
-hypotheses.  When the conclusion is focused on a certain input
-variable or component of that variable, and some hypothesis does not
-mention that variable, that hypothesis will be dropped so as to speed
-up the proof.  If a hypothesis does mention that variable, it may be
-expanded (if it is not a primitive) so as to try and gain more
-information about that variable.  This is a useful heuristic because
-often the hypotheses consist of a conjunction of predicates about
-different input variables or components of input variables, and some
-of these predicates are often themselves defined as conjunctions of
-predicates about subcomponents.
-
-However, sometimes this expansion goes too far.  In many cases, some
-conjuncts from the hypothesis have nothing to do with the coverage
-obligation.  In these cases, the ~c[:DO-NOT-EXPAND] keyword argument
-to ~c[DEF-GL-THM] and ~c[DEF-GL-PARAM-THM] may be used.  This argument
-should evaluate to a list of function symbols; the coverage heuristic
-is then prohibited from expanding any of these functions.
-
-For efficiency, the set of rules used in coverage proofs is very
-restricted.  Because of this, you may see in the proof output a goal
-which should be obvious, but is not proven because the necessary
-rule is not included.  The keyword argument ~c[:COV-THEORY-ADD] may be
-used to enable certain additional rules that are not included.  The
-set of rules that is used is defined in the ruleset
-~c[GL::SHAPE-SPEC-OBJ-IN-RANGE-OPEN], which can be listed using
-~bv[]
- (get-ruleset 'gl::shape-spec-obj-in-range-open (w state)).
-~ev[]
-
-The default heuristics for coverage proofs may not always be useful.
-Therefore, the user may also supplement or replace the coverage
-heuristics with arbitrary computed hints.  The keyword argument
-~c[:COV-HINTS] gives a list of computed hint forms which, according to
-the value of the keyword argument ~c[:COV-HINTS-POSITION], either
-replaces or supplements the default hints.  ~c[:COV-HINTS-POSITION]
-may be either ~c[:REPLACE], in which case the defaults are not used at
-all; ~c[:FIRST], in which case the user-provided ~c[:COV-HINTS] are
-tried first and the defaults afterward, or the default, ~c[:LAST], in
-which case the default coverage heuristic is tried before the
-user-provided hints.
-
-One thing to keep in mind when replacing or supplementing the default
-heuristics with your own computed hints is that subgoal names will be
-different between a ~c[:TEST-SIDE-GOALS] and an actual attempt at
-proving the theorem.  Therefore, it is best not to write computed
-hints that depend on the ~c[ID] variable.
-~/")
diff -Nru acl2-6.2/books/centaur/gl/gl-ttags.acl2 acl2-6.3/books/centaur/gl/gl-ttags.acl2
--- acl2-6.2/books/centaur/gl/gl-ttags.acl2	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-ttags.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (set-waterfall-parallelism nil)
 
diff -Nru acl2-6.2/books/centaur/gl/gl-ttags.lisp acl2-6.3/books/centaur/gl/gl-ttags.lisp
--- acl2-6.2/books/centaur/gl/gl-ttags.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-ttags.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 
@@ -7,5 +26,4 @@
 (include-book "bfr-aig-bddify")
 (include-book "bfr-satlink")
 
-(def-gl-clause-processor glcp-ttags)
-
+(def-gl-clause-processor glcp-ttags :output nil)
diff -Nru acl2-6.2/books/centaur/gl/gl-util.lisp acl2-6.3/books/centaur/gl/gl-util.lisp
--- acl2-6.2/books/centaur/gl/gl-util.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl-util.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,7 +1,24 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "tools/flag" :dir :system)
 (include-book "tools/bstar" :dir :system)
 
@@ -203,7 +220,7 @@
   `(,(gl-fnsym fn) ,@args))
 
 (defmacro glc (fn &rest args)
-  `(,(gl-fnsym fn) ,@args t 1000000))
+  `(,(gl-fnsym fn) ,@args hyp clk config bvar-db state))
 
 
 
@@ -230,5 +247,5 @@
            g-var g-var-p g-var->name))))
 
 
-                  
+
 
diff -Nru acl2-6.2/books/centaur/gl/gl.lisp acl2-6.3/books/centaur/gl/gl.lisp
--- acl2-6.2/books/centaur/gl/gl.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gl.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,9 +1,25 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
-
+(include-book "g-logapp")
 (include-book "g-ash")
 (include-book "g-binary-+")
 (include-book "g-cons")
@@ -37,7 +53,6 @@
 (include-book "gl-generic-clause-proc")
 (include-book "def-gl-clause-proc")
 (include-book "gify-thms")
-(include-book "gl-misc-doc")
 (include-book "auto-bindings")
 ;;; Matt K., 2/22/13: Sol Swords suggested commenting out the following
 ;;; include-book form, in order to avoid dependence on ttag :COUNT-BRANCHES-TO
@@ -45,6 +60,9 @@
 ; (include-book "bfr-aig-bddify")
 (include-book "g-gl-mbe")
 
+(include-book "doc")
+(include-book "tutorial")
+
 (local (include-book "general-object-thms"))
 (local (include-book "eval-g-base-help"))
 
@@ -55,6 +73,7 @@
 (defmacro def-g-simple (name body)
   `(progn (def-g-fn ,name ,body)
           (verify-g-guards ,name)
+          (def-gobj-dependency-thm ,name)
           (def-g-correct-thm ,name eval-g-base)))
 
 ;; complex-rationalp is an odd bird since it doesn't have a definition
@@ -63,58 +82,106 @@
 (def-g-simple complex-rationalp
   `(glr equal
         nil
-        (glr equal 0 (glr imagpart x hyp clk) hyp clk)
-        hyp clk))
+        (glr equal 0 (glr imagpart x hyp clk config bvar-db state) hyp clk config bvar-db state)
+        hyp clk config bvar-db state))
 
 
 (def-g-simple acl2::boolfix
   `(g-if x t nil))
 
 (def-g-simple implies
-  `(g-or (glr not p hyp clk)
-         (glr acl2::boolfix q hyp clk)))
+  `(g-or (glr not p hyp clk config bvar-db state)
+         (glr acl2::boolfix q hyp clk config bvar-db state)))
 
 (def-g-simple eq
-  `(glr equal x y hyp clk))
+  `(glr equal x y hyp clk config bvar-db state))
 
 (def-g-simple eql
-  `(glr equal x y hyp clk))
+  `(glr equal x y hyp clk config bvar-db state))
 
 (def-g-simple =
-  `(glr equal x y hyp clk))
+  `(glr equal x y hyp clk config bvar-db state))
 
 (def-g-simple /=
-`(glr not (glr equal x y hyp clk) hyp clk))
+`(glr not (glr equal x y hyp clk config bvar-db state) hyp clk config bvar-db state))
 
 (def-g-simple null
-  `(glr equal x nil hyp clk))
+  `(glr equal x nil hyp clk config bvar-db state))
 
 (def-g-simple atom
-  `(glr not (glr consp x hyp clk) hyp clk))
+  `(glr not (glr consp x hyp clk config bvar-db state) hyp clk config bvar-db state))
 
 (def-g-simple endp
-  `(glr not (glr consp x hyp clk) hyp clk))
+  `(glr not (glr consp x hyp clk config bvar-db state) hyp clk config bvar-db state))
 
 (def-g-simple zerop
-  `(glr equal x 0 hyp clk))
+  `(glr equal x 0 hyp clk config bvar-db state))
 
 (def-g-simple plusp
-  `(glr < 0 x hyp clk))
+  `(glr < 0 x hyp clk config bvar-db state))
 
 (def-g-simple minusp
-  `(glr < x 0 hyp clk))
+  `(glr < x 0 hyp clk config bvar-db state))
 
 (def-g-simple listp
-  `(g-or (glr consp x hyp clk)
-         (glr equal x nil hyp clk)))
+  `(g-or (glr consp x hyp clk config bvar-db state)
+         (glr equal x nil hyp clk config bvar-db state)))
 
 ; Obsolete, now that prog2$ is defined in terms of return-last:
 ; (def-g-simple prog2$
 ;   'y)
 
 
+(def-g-fn hons-assoc-equal
+  `(if (zp clk)
+       (g-apply 'hons-assoc-equal (list acl2::key acl2::alist))
+     (g-if (glc atom acl2::alist)
+           nil
+           (let ((car (glc car acl2::alist)))
+             (g-if (g-if (glc consp car)
+                         (glc equal acl2::key (glc car car))
+                         nil)
+                 car
+                 (let ((clk (1- clk)))
+                   (glc hons-assoc-equal acl2::key (glc cdr acl2::alist)))))))
+  :measure (nfix clk))
+
+(verify-g-guards hons-assoc-equal)
+
+(local (include-book "tools/trivial-ancestors-check" :dir :system))
+(local (acl2::use-trivial-ancestors-check))
+
+(local (include-book "centaur/misc/beta-reduce-full" :dir :system))
+
+;; Note: In the gobj dependency theorem for hons-assoc-equal, there are some
+;; HIDEs in the induction hyp that need to match HIDEs created by the rewriter,
+;; but they seem to sometimes differ in the order of the bindings.  So we beta
+;; reduce all HIDE terms with the rule below.
+(local (defthm beta-reduce-hides
+         #!acl2 (implies (pseudo-termp x)
+                         (equal (beta-eval x a)
+                                (beta-eval (beta-reduce-full x) a)))
+         :rule-classes ((:meta :trigger-fns (hide)))))
+
+(def-gobj-dependency-thm hons-assoc-equal
+  :hints `(("goal" :in-theory (e/d ((:i ,gfn))
+                                   ((:d ,gfn)))
+            :induct ,gcall
+            :expand (,gcall))))
+
+(def-g-correct-thm hons-assoc-equal eval-g-base
+  :hints `(("goal" :in-theory (e/d ((:i ,gfn))
+                                   ((:d ,gfn)))
+            :induct ,gcall
+            :expand (,gcall
+                     (:free (a b) (eval-g-base-list (cons a b) env))
+                     (eval-g-base-list nil env)
+                     (hons-assoc-equal (eval-g-base acl2::key env)
+                                       (eval-g-base acl2::alist env))))))
+
+;; (make-g-world (hons-assoc-equal) geval-basis)
+
 
-(make-g-world (hons-assoc-equal) geval-basis)
 
 (defun canonical-general-concretep (x)
   (declare (xargs :guard t
@@ -184,6 +251,40 @@
             obj)
         (hons-g-concrete obj)))))
 
+;; (local (defthm general-concrete-obj-of-car-when-tag
+;;          (implies (and (syntaxp (quotep key))
+;;                        (not (equal (tag x) :g-concrete))
+;;                        (not (equal (tag x) :g-boolean))
+;;                        (not (equal (tag x) :g-number))
+;;                        (not (equal (tag x) :g-ite))
+;;                        (not (equal (tag x) :g-apply))
+;;                        (not (equal (tag x) :g-var))
+;;                        (g-keyword-symbolp key))
+;;                   (not (equal (general-concrete-obj (car x)) key)))
+;;          :hints(("Goal" :in-theory (enable g-keyword-symbolp tag)
+;;                  :expand ((general-concrete-obj (car x)))))))
+
+;; (local (defthm gobj-depends-on-of-general-concrete-obj
+;;          (implies (and (not (gobj-depends-on k p x))
+;;                        (general-concretep x))
+;;                   (not (gobj-depends-on k p (general-concrete-obj x))))
+;;          :hints(("Goal" :in-theory (enable general-concretep
+;;                                            general-concrete-obj
+;;                                            concrete-gobjectp
+;;                                            gobject-hierarchy-lite)
+;;                  :induct t
+;;                  :expand ((:free (a b)
+;;                            (gobj-depends-on k p (cons a b))))))))
+
+
+(defthm gobj-depends-on-of-canonicalize-general-concrete
+  (implies (and (not (gobj-depends-on k p x))
+                (general-concretep x))
+           (not (gobj-depends-on k p (canonicalize-general-concrete x))))
+  :hints(("Goal" :in-theory (enable canonicalize-general-concrete
+                                    gobj-depends-on-when-concrete-gobjectp))))
+
+
 (local
  (progn
    (defthm canonicalize-general-concretep-correct
@@ -232,25 +333,25 @@
 
 (local
  (progn
-   (in-theory (enable geval-basis))
-   (eval-g-prove-f-i geval-basis-f-i
-                     geval-basis generic-geval)
+   (in-theory (e/d (eval-g-base)))
+   (eval-g-prove-f-i eval-g-base-f-i
+                     eval-g-base generic-geval)
 
    (eval-g-functional-instance
     canonical-eval-canonical-general-concretep
-    geval-basis generic-geval)
+    eval-g-base generic-geval)
 
    (eval-g-functional-instance
     canonicalize-general-concretep-correct
-    geval-basis generic-geval)
+    eval-g-base generic-geval)
 
    (eval-g-functional-instance
     generic-geval-cons
-    geval-basis generic-geval)
+    eval-g-base generic-geval)
 
    (eval-g-functional-instance
     general-concrete-obj-correct
-    geval-basis generic-geval)
+    eval-g-base generic-geval)
 
    ;; (defthmd not-keyword-symbolp-car-impl
    ;;   (implies (not (g-keyword-symbolp (car x)))
@@ -269,32 +370,33 @@
    (defthm ev-hons-assoc-equal-when-concrete-key-alistp
      (implies (and (concrete-key-alistp al)
                    (canonical-general-concretep key))
-              (equal (geval-basis
+              (equal (eval-g-base
                       (hons-assoc-equal key al)
                       env)
-                     (hons-assoc-equal (geval-basis key env)
-                                       (geval-basis al env))))
+                     (hons-assoc-equal (eval-g-base key env)
+                                       (eval-g-base al env))))
      :hints (("goal" :in-theory
               (e/d (; gobjectp-car-impl-not-g-types
                     ; canonical-general-concretep-impl-gobjectp
-                    gl-thm::canonical-eval-canonical-general-concretep-for-geval-basis
+                    gl-thm::canonical-eval-canonical-general-concretep-for-eval-g-base
                     ; not-keyword-symbolp-car-impl
 
                     hons-assoc-equal)
                    (canonical-general-concretep
                     general-concretep-def
                     concrete-gobjectp-def
-                    geval-basis
+                    eval-g-base
                     bfr-sat-bdd-unsat
                     (:d hons-assoc-equal)
-                    ;; gl-thm::general-concrete-obj-correct-gobj-fix-for-geval-basis
+                    ;; gl-thm::general-concrete-obj-correct-gobj-fix-for-eval-g-base
                     ))
               :induct (hons-assoc-equal key al)
               :expand ((:free (key) (hons-assoc-equal key al))))
              (and stable-under-simplificationp
                   '(:expand
-                    ((geval-basis al env)
-                     (geval-basis (car al) env))
+                    ((:with eval-g-base (eval-g-base al env))
+                     (:with eval-g-base (eval-g-base (car al) env))
+                     (:free (key a b) (hons-assoc-equal key (cons a b))))
                     ;;                  :in-theory
                     ;;                  (enable tag g-concrete-p g-concrete->obj)
                     ))))))
@@ -311,7 +413,6 @@
 
 (verify-g-guards hons-acons)
 
-
 ;; (def-gobjectp-thm hons-acons
 ;;   :hints `(("goal" :in-theory
 ;;             (enable canonical-general-concretep-impl-gobjectp))))
@@ -330,7 +431,9 @@
 
 ;;(local (in-theory (enable canonical-general-concretep-impl-gobjectp)))
 
-(def-g-correct-thm hons-acons geval-basis)
+(def-gobj-dependency-thm hons-acons)
+
+(def-g-correct-thm hons-acons eval-g-base)
 
 
 ;; Jared: changed hons-get-fn-do-hopy to hons-get for new hons
@@ -342,21 +445,24 @@
 
 (verify-g-guards hons-get)
 
+(def-gobj-dependency-thm hons-get)
+
+
 (local
  (progn
    (eval-g-functional-instance
     canonicalize-general-concretep-correct
-    geval-basis generic-geval)
+    eval-g-base generic-geval)
 
    (eval-g-functional-instance
     generic-geval-of-g-concrete-p
-    geval-basis generic-geval)
+    eval-g-base generic-geval)
 
    (eval-g-functional-instance
     eval-concrete-gobjectp
-    geval-basis generic-geval)))
+    eval-g-base generic-geval)))
 
-(def-g-correct-thm hons-get geval-basis)
+(def-g-correct-thm hons-get eval-g-base)
 
 
 ; Jared Note: removed hons-get-fn-do-not-hopy since it's no longer part
@@ -375,7 +481,7 @@
 
 ;; (def-gobjectp-thm hons-get-fn-do-not-hopy)
 ;; (verify-g-guards hons-get-fn-do-not-hopy)
-;; (def-g-correct-thm hons-get-fn-do-not-hopy geval-basis)
+;; (def-g-correct-thm hons-get-fn-do-not-hopy eval-g-base)
 
 ; Jared: changing flush-hons-get-hash-table-link to fast-alist-free
 
@@ -383,7 +489,8 @@
   `(fast-alist-free acl2::alist))
 
 (verify-g-guards fast-alist-free)
-(def-g-correct-thm fast-alist-free geval-basis)
+(def-gobj-dependency-thm fast-alist-free)
+(def-g-correct-thm fast-alist-free eval-g-base)
 
 
 
@@ -391,31 +498,78 @@
   `(flush-hons-get-hash-table-link acl2::alist))
 
 (verify-g-guards flush-hons-get-hash-table-link)
-(def-g-correct-thm flush-hons-get-hash-table-link geval-basis)
-
+(def-gobj-dependency-thm flush-hons-get-hash-table-link)
+(def-g-correct-thm flush-hons-get-hash-table-link eval-g-base)
 
 
 
+(acl2::defevaluator-fast cl-ev cl-ev-lst ((if a b c)) :namedp t)
 
-(def-gl-clause-processor glcp
-  '(string-append expt))
-
-(defmacro gl-bdd-mode ()
-  ":Doc-section ACL2::GL
-Use BDD-based symbolic simulation in GL.~/
-This macro produces an event which sets the GL reasoning mode to use uBDDs,
-This is the default, relatively stable form of GL symbolic simulation.~/~/"
-  '(progn (acl2::defattach bfr-mode bfr-bdd)
-          (acl2::defattach bfr-counterex-mode bfr-counterex-bdd)
-          (acl2::defattach
-           (bfr-sat bfr-sat-bdd)
-           :hints (("goal" :in-theory '(bfr-sat-bdd-unsat))
-                   (and stable-under-simplificationp
-                        '(:in-theory (enable bfr-sat-bdd)))))))
+(defun dumb-clausify (x)
+  (declare (xargs :guard (pseudo-termp x)))
+  (cond ((atom x) (list (list x)))
+        ((equal x ''t) nil)
+        ((and (eq (car x) 'if)
+              (equal (fourth x) ''nil))
+         (append (dumb-clausify (second x))
+                 (dumb-clausify (third x))))
+        (t (list (list x)))))
+
+(acl2::def-join-thms cl-ev)
+
+(defthm dumb-clausify-correct
+  (iff (cl-ev (conjoin-clauses (dumb-clausify x)) a)
+       (cl-ev x a)))
+
+(defun dumb-clausify-cp (x)
+  (declare (xargs :guard (pseudo-term-listp x)))
+  (if (or (atom x)
+          (consp (cdr x)))
+      (list x)
+    (dumb-clausify (car x))))
+
+(defthm dumb-clausify-cp-correct
+  (implies (and (pseudo-term-listp x)
+                (alistp a)
+                (cl-ev (conjoin-clauses (dumb-clausify-cp x)) a))
+           (cl-ev (disjoin x) a))
+  :rule-classes :clause-processor)
+
+
+(def-gl-clause-processor glcp :output nil)
+
+
+(defsection gl-bdd-mode
+  :parents (modes reference)
+  :short "Use BDD-based symbolic simulation in GL."
+  :long "<p>This macro produces an event which sets the GL reasoning mode to
+use @(see acl2::ubdds).  This is the default form of GL symbolic
+simulation.</p>"
+
+  (defmacro gl-bdd-mode ()
+    '(progn (acl2::defattach bfr-mode bfr-bdd)
+            (acl2::defattach bfr-counterex-mode bfr-counterex-bdd)
+            (acl2::defattach
+             (bfr-sat bfr-sat-bdd)
+             :hints (("goal" :in-theory '(bfr-sat-bdd-unsat))
+                     (and stable-under-simplificationp
+                          '(:in-theory (enable bfr-sat-bdd))))))))
 
 ;; Default to BDD mode.
 (gl-bdd-mode)
 
+(defsection g-int
+  :parents (shape-specs)
+  :short "Create a g-binding for an integer."
+  :long "<p>This is a low-level way to create a custom shape specifier for a
+signed integer.  You might generally prefer higher-level tools like @(see
+auto-bindings).</p>"
+
+  (defun g-int (start by n)
+    (g-number (list (numlist start by n)))))
+
+;; Fix for unsigned-byte-p's recursive definition in ihs books
+(table structural-decomp-defs 'unsigned-byte-p 'unsigned-byte-p)
 
 
 
@@ -468,3 +622,4 @@
                                     0
                                     (acl2::evisc-tuple 3 6 nil nil))
                                    (break$)))))
+
diff -Nru acl2-6.2/books/centaur/gl/glcp-config.lisp acl2-6.3/books/centaur/gl/glcp-config.lisp
--- acl2-6.2/books/centaur/gl/glcp-config.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/glcp-config.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,88 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "shape-spec-defs")
+
+(cutil::defaggregate glcp-config
+  ((abort-unknown booleanp :default t)
+   (abort-ctrex booleanp :default t)
+   (exec-ctrex booleanp :default t)
+   (abort-vacuous booleanp :default t)
+   (nexamples natp :rule-classes :type-prescription :default 3)
+   (hyp-clk natp :rule-classes :type-prescription :default 1000000)
+   (concl-clk natp :rule-classes :type-prescription :default 1000000)
+   (clause-proc-name symbolp :rule-classes :type-prescription)
+   (overrides) ;;  acl2::interp-defs-alistp but might be too expensive to check
+     ;;  the guards in clause processors
+   (param-bfr :default t)
+   top-level-term
+   (shape-spec-alist shape-spec-bindingsp)
+   run-before
+   run-after
+   case-split-override
+   (split-conses booleanp :default nil)
+   (split-fncalls booleanp :default nil)
+   (lift-ifsp booleanp :default nil)
+   )
+  :tag :glcp-config)
+
+
+(defund-inline glcp-config-update-param (p config)
+  (declare (xargs :guard (glcp-config-p config)))
+  (change-glcp-config config :param-bfr p))
+
+(defthm param-bfr-of-glcp-config-update-param
+  (equal (glcp-config->param-bfr (glcp-config-update-param p config))
+         p)
+  :hints(("Goal" :in-theory (enable glcp-config-update-param))))
+
+(defthm glcp-config->overrides-of-glcp-config-update-param
+  (equal (glcp-config->overrides (glcp-config-update-param p config))
+         (glcp-config->overrides config))
+  :hints(("Goal" :in-theory (enable glcp-config-update-param))))
+
+(defthm glcp-config->top-level-term-of-glcp-config-update-param
+  (equal (glcp-config->top-level-term (glcp-config-update-param p config))
+         (glcp-config->top-level-term config))
+  :hints(("Goal" :in-theory (enable glcp-config-update-param))))
+
+
+
+(defund-inline glcp-config-update-term (term config)
+  (declare (xargs :guard (glcp-config-p config)))
+  (change-glcp-config config :top-level-term term))
+
+(defthm param-bfr-of-glcp-config-update-term
+  (equal (glcp-config->param-bfr (glcp-config-update-term term config))
+         (glcp-config->param-bfr config))
+  :hints(("Goal" :in-theory (enable glcp-config-update-term))))
+
+(defthm glcp-config->overrides-of-glcp-config-update-term
+  (equal (glcp-config->overrides (glcp-config-update-term term config))
+         (glcp-config->overrides config))
+  :hints(("Goal" :in-theory (enable glcp-config-update-term))))
+
+(defthm glcp-config->top-level-term-of-glcp-config-update-term
+  (equal (glcp-config->top-level-term (glcp-config-update-term term config))
+         term)
+  :hints(("Goal" :in-theory (enable glcp-config-update-term))))
+
+
diff -Nru acl2-6.2/books/centaur/gl/glcp-geval-thms.lisp acl2-6.3/books/centaur/gl/glcp-geval-thms.lisp
--- acl2-6.2/books/centaur/gl/glcp-geval-thms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/glcp-geval-thms.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,199 @@
+
+(in-package "GL")
+
+(include-book "glcp-geval")
+(include-book "gtype-thms")
+(include-book "general-object-thms")
+
+(local
+ (defthmd gl-eval-of-atom
+   (implies (atom x)
+            (equal (generic-geval x env) x))
+   :hints (("goal" :in-theory (enable tag)
+            :expand ((generic-geval x env))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+
+(defsection glcp-generic-geval
+
+  (local (in-theory (enable glcp-generic-geval)))
+
+  (defthm glcp-generic-geval-atom
+    (implies (atom x)
+             (equal (glcp-generic-geval x env) x))
+    :hints(("Goal" :in-theory (enable gl-eval-of-atom)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-mk-g-boolean-correct
+   mk-g-boolean-correct
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list))
+   :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                               glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                              (glcp-generic-geval-apply))
+             :expand ((glcp-generic-geval x env)
+                      (glcp-generic-geval-list x env)))))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-cons
+   generic-geval-cons
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list))
+   :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                               glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                              (glcp-generic-geval-apply))
+             :expand ((glcp-generic-geval x env)
+                      (glcp-generic-geval-list x env)))))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-g-apply-p
+   generic-geval-g-apply-p
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list))
+   :hints ('(:in-theory (e/d* (glcp-generic-geval-ev-of-fncall-args
+                               glcp-generic-geval-apply-agrees-with-glcp-generic-geval-ev)
+                              (glcp-generic-geval-apply))
+             :expand ((glcp-generic-geval x env)
+                      (glcp-generic-geval-list x env)))))
+
+  (in-theory (disable glcp-generic-geval-g-apply-p))
+
+
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-mk-g-ite-correct
+   mk-g-ite-correct
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list)))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-mk-g-concrete-correct
+   mk-g-concrete-correct
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list)))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-g-concrete-quote-correct
+   g-concrete-quote-correct
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list)))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-general-concrete-obj-correct
+   general-concrete-obj-correct
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list)))
+
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-of-gl-cons
+   generic-geval-gl-cons
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list)))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-g-apply
+   generic-geval-g-apply
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list)))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-alt-def
+   generic-geval-alt-def
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list))
+   ;; :do-not-induct
+   ;;   t
+   ;;   :expand ((glcp-generic-geval x env))))
+   :rule-classes ((:definition :clique (glcp-generic-geval))))
+
+  (in-theory (disable glcp-generic-geval-alt-def))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-general-consp-car-correct
+   general-consp-car-correct
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list)))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-general-consp-cdr-correct
+   general-consp-cdr-correct
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list)))
+
+  (acl2::def-functional-instance
+   glcp-generic-geval-consp-general-consp
+   consp-general-consp
+   ((generic-geval-ev glcp-generic-geval-ev)
+    (generic-geval-ev-lst glcp-generic-geval-ev-lst)
+    (generic-geval glcp-generic-geval)
+    (generic-geval-list glcp-generic-geval-list))))
+
+
+
+
+
+(defsection glcp-generic-geval-list
+
+  (local (in-theory (enable glcp-generic-geval-list)))
+
+  (defthm glcp-generic-geval-list-of-cons
+    (equal (glcp-generic-geval-list (cons a b) env)
+           (cons (glcp-generic-geval a env)
+                 (glcp-generic-geval-list b env))))
+
+  (defthm glcp-generic-geval-list-of-atom
+    (implies (not (consp x))
+             (equal (glcp-generic-geval-list x env) nil))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  ;; (defthm glcp-generic-geval-when-gobj-list
+  ;;   (implies (gobj-listp x)
+  ;;            (equal (glcp-generic-geval x env)
+  ;;                   (glcp-generic-geval-list x env)))
+  ;;   :hints (("goal" :induct (gobj-listp x)
+  ;;            :in-theory (enable gobj-listp))
+  ;;           '(:use ((:instance glcp-generic-geval-of-gl-cons
+  ;;                    (x (car x)) (y (cdr x))))
+  ;;             :in-theory (enable gl-cons gobj-listp))))
+
+  (defthm glcp-generic-geval-list-of-gl-cons
+    (equal (glcp-generic-geval-list (gl-cons x y) env)
+           (cons (glcp-generic-geval x env)
+                 (glcp-generic-geval-list y env)))
+    :hints(("Goal" :in-theory (e/d (gl-cons) (glcp-generic-geval-alt-def
+                                              glcp-generic-geval-general-concrete-obj-correct))
+            :expand ((:with glcp-generic-geval (glcp-generic-geval x env))
+                     (:with glcp-generic-geval (glcp-generic-geval (g-concrete
+                                                                    x)
+                                                                   env))))))
+
+
+  (defthm len-of-glcp-generic-geval-list
+    (equal (len (glcp-generic-geval-list x env))
+           (len x))))
diff -Nru acl2-6.2/books/centaur/gl/glcp-geval.lisp acl2-6.3/books/centaur/gl/glcp-geval.lisp
--- acl2-6.2/books/centaur/gl/glcp-geval.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/glcp-geval.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,104 @@
+
+
+(in-package "GL")
+(include-book "generic-geval")
+(include-book "symbolic-arithmetic-fns")
+(include-book "shape-spec-defs")
+(include-book "gl-mbe")
+
+(defun gl-hide (x)
+  (declare (xargs :guard t))
+  x)
+
+(defun gl-cp-hint (x)
+  (declare (ignore x))
+  t)
+
+(in-theory (disable gl-cp-hint (:type-prescription gl-cp-hint) (gl-cp-hint)))
+
+(def-eval-g glcp-generic-geval
+  (
+   ;; used in shape specs
+   logapp int-set-sign maybe-integer
+          cons car cdr consp if not equal nth len iff
+          shape-spec-slice-to-env
+          ss-append-envs
+          shape-spec-obj-in-range-iff
+          shape-spec-obj-in-range
+          shape-spec-env-slice
+          shape-spec-iff-env-slice
+
+          if gl-cp-hint shape-spec-obj-in-range return-last use-by-hint equal
+      acl2::typespec-check implies iff not cons gl-aside gl-ignore gl-error gl-hide
+      BINARY-*
+      BINARY-+
+      PKG-WITNESS
+;   UNARY-/
+      UNARY--
+      COMPLEX-RATIONALP
+;   BAD-ATOM<=
+      ACL2-NUMBERP
+      SYMBOL-PACKAGE-NAME
+      INTERN-IN-PACKAGE-OF-SYMBOL
+      CODE-CHAR
+;   DENOMINATOR
+      CDR
+;   COMPLEX
+      CAR
+      CONSP
+      SYMBOL-NAME
+      CHAR-CODE
+      IMAGPART
+      SYMBOLP
+      REALPART
+;   NUMERATOR
+      EQUAL
+      STRINGP
+      RATIONALP
+      CONS
+      INTEGERP
+      CHARACTERP
+      <
+      COERCE
+      booleanp
+      logbitp
+      binary-logand
+      binary-logior
+      lognot
+      ash
+      integer-length
+      floor
+      mod
+      truncate
+      rem
+      acl2::boolfix
+
+      ;; these are from the constant *expandable-boot-strap-non-rec-fns*.
+      NOT IMPLIES
+      EQ ATOM EQL = /= NULL ENDP ZEROP ;; SYNP
+      PLUSP MINUSP LISTP ;; RETURN-LAST causes guard violation
+      ;; FORCE CASE-SPLIT
+      ;; DOUBLE-REWRITE
+
+      ;; used for shape specs
+      acl2::logapp int-set-sign maybe-integer
+
+      ;; force checks
+      gl-force-check gl-force-check-strong gl-force-false gl-force-true
+      ))
+
+(in-theory (disable glcp-generic-geval))
+
+
+
+
+(defund glcp-generic-geval-alist (al env)
+  (declare (xargs :guard (consp env)))
+  (if (atom al)
+      nil
+    (if (consp (car al))
+        (cons (cons (caar al)
+                    (glcp-generic-geval (cdar al)
+                                        env))
+              (glcp-generic-geval-alist (cdr al) env))
+      (glcp-generic-geval-alist (cdr al) env))))
diff -Nru acl2-6.2/books/centaur/gl/glcp-templates.lisp acl2-6.3/books/centaur/gl/glcp-templates.lisp
--- acl2-6.2/books/centaur/gl/glcp-templates.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/glcp-templates.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,346 +1,1152 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
+(include-book "gl-util")
 
-(include-book "tools/flag" :dir :system)
+(defstobj interp-st
+  is-obligs            ;; interp-defs-alistp
+  is-constraint        ;; bfr
+  is-constraint-db     ;; constraint database
+  )
+
+(defconst *glcp-common-inputs*
+  '(pathcond clk config interp-st bvar-db state))
+
+(defconst *glcp-common-guards*
+  '((acl2::interp-defs-alistp (is-obligs interp-st))
+    (glcp-config-p config)
+    (acl2::interp-defs-alistp (glcp-config->overrides config))))
+
+(defconst *glcp-stobjs* '(interp-st bvar-db state))
+
+(defconst *glcp-common-retvals* '(er interp-st bvar-db state))
+
+(defmacro glcp-value (&rest results)
+  `(mv ,@results nil ,@(cdr *glcp-common-retvals*)))
+
+
+(defun glcp-interp-error-trace (msg)
+  (declare (ignore msg)
+           (xargs :guard t))
+  nil)
+
+(defmacro break-on-glcp-error (flg)
+  (if flg
+      '(trace$ (glcp-interp-error-trace
+                :entry (progn$
+                        (cw "GLCP interpreter error:~%~@0~%" msg)
+                        (break$))))
+    '(untrace$ glcp-interp-error-trace)))
+    
+
+(defmacro glcp-interp-abort (msg &key (nvals '1))
+  `(mv ,@(make-list-ac nvals nil nil)
+      ,msg ,@(cdr *glcp-common-retvals*)))
+
+(defmacro glcp-interp-error (msg &key (nvals '1))
+  (declare (xargs :guard t))
+  `(progn$ (glcp-interp-error-trace ,msg)
+           (glcp-interp-abort ,msg :nvals ,nvals)))
+
+
+(defmacro patbind-glcp-er (args bindings expr)
+  (b* ((nvalsp (member :nvals args))
+       (nvals (or (cadr nvalsp) 1))
+       (args (take (- (len args) (len nvalsp)) args)))
+    `(b* (((mv ,@args patbind-glcp-er-error ,@(cdr *glcp-common-retvals*))
+           ,(car bindings))
+          ((when patbind-glcp-er-error)
+           (glcp-interp-abort patbind-glcp-er-error :nvals ,nvals)))
+       (check-vars-not-free
+        (patbind-glcp-er-error) ,expr))))
+
+(defmacro cpathcond ()
+  '(bfr-and pathcond (is-constraint interp-st)))
+
+
+(defun glcp-put-name-each (name lst)
+  (if (atom lst)
+      nil
+    (cons (incat name (symbol-name name) "-" (symbol-name (car lst)))
+          (glcp-put-name-each name (cdr lst)))))
+
+(mutual-recursion
+ (defun event-forms-collect-fn-names (x)
+   (if (atom x)
+       nil
+     (append (event-form-collect-fn-names (car x))
+             (event-forms-collect-fn-names (cdr x)))))
+ (defun event-form-collect-fn-names (x)
+   (case (car x)
+     ((defun defund) (list (cadr x)))
+     ((mutual-recursion progn)
+      (event-forms-collect-fn-names (cdr x))))))
 
 (defconst *glcp-interp-template*
-  '(mutual-recursion
-    (defun interp-term (x alist hyp clk obligs config state)
-      (declare (xargs :measure (make-ord 1 (1+ (nfix clk)) (acl2-count x))
-                      :hints (("goal" :in-theory
-                               (e/d**
-                                ((:rules-of-class :executable-counterpart :here)
-                                 acl2-count len make-ord nfix o-finp o-first-coeff
-                                 fix o-first-expt o-p o-rst o< car-cons cdr-cons
-                                 commutativity-of-+ ;  fold-constants-in-plus
-                                 nfix unicity-of-0 null atom eq
-                                 acl2-count-last-cdr-when-cadr-hack
-                                 car-cdr-elim natp-compound-recognizer
-                                 acl2::zp-compound-recognizer
-                                 acl2::posp-compound-recognizer
-                                 (:type-prescription acl2-count)))))
-                      :verify-guards nil
-                      :guard (and (natp clk)
-                                  (pseudo-termp x)
-                                  (acl2::interp-defs-alistp obligs)
-                                  (glcp-config-p config)
-                                  (acl2::interp-defs-alistp
-                                   (glcp-config->overrides config)))
-                      :stobjs state))
-      (cond ((zp clk)
-             (glcp-interp-error "The clock ran out.~%"))
-
-            ((null x) (glcp-value nil))
-
-            ;; X is a variable; look it up in the alist; the result must be a
-            ;; g-object because of the gobject-vals-alistp guard.
-            ((symbolp x)
-             (glcp-value (cdr (hons-assoc-equal x alist))))
-                 
-            ((atom x)
-             (glcp-interp-error
-              (acl2::msg "GLCP:  The unquoted atom ~x0 is not a term~%"
-                            x)))
-
-            ;; X is a quoted (concrete) object.  g-concrete-quote creates a
-            ;; constant-valued symbolic object.  We used to call mk-g-concrete
-            ;; here but that scans through the whole cons tree which can be
-            ;; expensive.  G-concrete-quote just wraps a g-concrete around the
-            ;; object unless it's a non-g-keyword atom.
-            ((eq (car x) 'quote) (glcp-value (g-concrete-quote
-                                              (car (cdr x)))))
-
-            ;; X is a lambda application; interpret each of the actuals, pair up
-            ;; the formals with these values, then interpret the body.
-            ((consp (car x))
-             (b* (((glcp-er actuals)
-                   (interp-list (cdr x) alist hyp clk obligs config state))
-                  (formals (car (cdar x)))
-                  (body (car (cdr (cdar x)))))
-               (if (and (equal (len actuals) (len formals))
-                        (nonnil-symbol-listp formals)
-                        (acl2::fast-no-duplicatesp formals))
-                   (interp-term
-                    body (pairlis$ formals actuals)
-                    hyp clk obligs config state)
-                 (glcp-interp-error
-                  (acl2::msg "Badly formed lambda application: ~x0~%" x)))))
-
-            ;; X is an IF; determine first whether it's an OR, then run the
-            ;; necessary cases.  Note that gli-or and gli-if are macros and the
-            ;; arguments are not necessarily all evaluated.
-            ((eq (car x) 'if)
-             (if (equal (len x) 4)
-                 (let ((test (car (cdr x)))
-                       (tbr (car (cdr (cdr x))))
-                       (fbr (car (cdr (cdr (cdr x))))))
-                   (if (hons-equal test tbr)
-                       (glcp-or
-                        (interp-term test alist hyp clk obligs config state)
-                        (interp-term fbr alist hyp clk obligs config state))
-                     (glcp-if
-                      (interp-term test alist hyp clk obligs config state)
-                      (interp-term tbr alist hyp clk obligs config state)
-                      (interp-term fbr alist hyp clk obligs config state))))
-               (glcp-interp-error
-                "Error: wrong number of args to IF~%")))
-
-            ;; GL-ASIDE call: run the arg in a wormhole and produce
-            ;; nil.
-            ((eq (car x) 'gl-aside)
-             (if (eql (len x) 2)
-                 (prog2$ (gl-aside-wormhole (cadr x) alist)
-                         (glcp-value nil))
-               (glcp-interp-error
-                "Error: wrong number of args to GL-ASIDE~%")))
-
-            ;; GL-IGNORE call: don't run the arg
-            ((eq (car x) 'gl-ignore)
-             (glcp-value nil))
+  `(progn
 
-            ;; GL-ERROR call: symbolically execute the arg and store the result in a
-            ;; state global, then quit the interpreter.
-            ((eq (car x) 'gl-error)
-             (if (eql (len x) 2)
-                 (b* (((glcp-er result)
-                       (interp-term (cadr x) alist hyp clk obligs config
-                                    state))
-                      (state (acl2::f-put-global 'gl-error-result result state)))
-                   (glcp-interp-error
-                    (acl2::msg
-                     "Error: GL-ERROR call encountered.  Data associated with the ~
+     (mutual-recursion
+      (defun interp-test
+        (x alist intro-bvars . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 12 0 0)
+                  :verify-guards nil
+                  :guard (and (posp clk)
+                              (pseudo-termp x)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (b* ((clk (1- clk))
+             ((glcp-er xobj)
+              (interp-term-equivs x alist '(iff) . ,*glcp-common-inputs*)))
+          (simplify-if-test xobj intro-bvars . ,*glcp-common-inputs*)))
+
+      (defun interp-term-equivs
+        (x alist contexts . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list clk 2020 (acl2-count x) 40)
+                  :guard (and (natp clk)
+                              (pseudo-termp x)
+                              (contextsp contexts)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (b* (((when (zp clk))
+              (glcp-interp-error "The clock ran out.~%"))
+             ((glcp-er xobj)
+              (interp-term x alist contexts . ,*glcp-common-inputs*))
+             ((mv er xobj) (try-equivalences-loop xobj
+                                                  (cpathcond)
+                                                  contexts clk
+                                                  (glcp-config->param-bfr config)
+                                                  bvar-db state))
+             ((when er) (glcp-interp-error er)))
+          (glcp-value xobj)))
+
+
+
+      (defun interp-term
+        (x alist contexts . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 2020 (acl2-count x) 20)
+                  :well-founded-relation acl2::nat-list-<
+                  :hints (("goal"
+                           :in-theory (e/d** ((:rules-of-class :executable-counterpart :here)
+                                              acl2::open-nat-list-<
+                                              acl2-count len nfix fix
+                                              acl2-count-of-general-consp-car
+                                              acl2-count-of-general-consp-cdr
+                                              car-cons cdr-cons commutativity-of-+
+                                              unicity-of-0 null atom
+                                              eq acl2-count-last-cdr-when-cadr-hack
+                                              car-cdr-elim natp-compound-recognizer
+                                              acl2::zp-compound-recognizer
+                                              acl2::posp-compound-recognizer
+                                              pos-fix
+                                              g-ite-depth-sum-of-gl-args-split-ite-then
+                                              g-ite-depth-sum-of-gl-args-split-ite-else
+                                              g-ite->test-acl2-count-decr
+                                              g-ite->then-acl2-count-decr
+                                              g-ite->else-acl2-count-decr
+                                              g-apply->args-acl2-count-thm
+                                              acl2-count-of-car-g-apply->args
+                                              acl2-count-of-cadr-g-apply->args
+                                              acl2-count-of-car
+                                              (:type-prescription acl2-count)
+                                              (:t len)))))
+                  :verify-guards nil
+                  :guard (and (posp clk)
+                              (pseudo-termp x)
+                              (contextsp contexts)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (b* (((when (null x)) (glcp-value nil))
+             ((when (symbolp x))
+              (glcp-value (cdr (hons-assoc-equal x alist))))
+             ((when (atom x))
+              (glcp-interp-error
+               (acl2::msg "GLCP:  The unquoted atom ~x0 is not a term~%"
+                          x)))
+             ((when (eq (car x) 'quote))
+              (glcp-value (g-concrete-quote (car (cdr x)))))
+             ((when (consp (car x)))
+              (b*
+                (((glcp-er actuals)
+                  (interp-list (cdr x)
+                               alist . ,*glcp-common-inputs*))
+                 (formals (car (cdar x)))
+                 (body (car (cdr (cdar x)))))
+                (if (and (mbt (and (equal (len actuals) (len formals))
+                                   (symbol-listp formals)))
+                         (acl2::fast-no-duplicatesp formals)
+                         (not (member-eq nil formals)))
+                    (interp-term body (pairlis$ formals actuals)
+                                 contexts . ,*glcp-common-inputs*)
+                  (glcp-interp-error (acl2::msg "Badly formed lambda application: ~x0~%"
+                                                x)))))
+             ((when (eq (car x) 'if))
+              (let ((test (car (cdr x)))
+                    (tbr (car (cdr (cdr x))))
+                    (fbr (car (cdr (cdr (cdr x))))))
+                (interp-if/or test tbr fbr alist contexts . ,*glcp-common-inputs*)))
+
+             ((when (eq (car x) 'gl-aside))
+              (if (eql (len x) 2)
+                  (prog2$ (gl-aside-wormhole (cadr x) alist)
+                          (glcp-value nil))
+                (glcp-interp-error "Error: wrong number of args to GL-ASIDE~%")))
+             ((when (eq (car x) 'gl-ignore))
+              (glcp-value nil))
+             ((when (eq (car x) 'gl-hide))
+              (glcp-value (gl-term-to-apply-obj x alist)))
+             ((when (eq (car x) 'gl-error))
+              (if (eql (len x) 2)
+                  (b* (((glcp-er result)
+                        (interp-term (cadr x)
+                                     alist nil . ,*glcp-common-inputs*))
+                       (state (f-put-global 'gl-error-result
+                                            result state)))
+                    (glcp-interp-error
+                     (acl2::msg
+                      "Error: GL-ERROR call encountered.  Data associated with the ~
                       error is accessible using (@ ~x0).~%"
-                     'gl-error-result)))
-               (glcp-interp-error
-                "Error: wrong number of args to GL-ERROR~%")))
-
-            ;; RETURN-LAST - interpret the last argument, i.e. the logical
-            ;; value of the term.  Insert exceptions before this point.
-            ((eq (car x) 'acl2::return-last)
-             (if (eql (len x) 4)
-                 (if (equal (cadr x) ''acl2::time$1-raw)
-                     (b* (((mv err & time$-args state)
-                           (interp-term (caddr x) alist hyp clk obligs config state)))
-                       (mbe :logic (interp-term (car (last x)) alist hyp clk obligs config state)
-                            :exec (if (and (not err) (general-concretep time$-args))
-                                      (return-last
-                                       'acl2::time$1-raw
-                                       (general-concrete-obj time$-args)
-                                       (interp-term (car (last x)) alist hyp clk obligs config state))
-                                    (time$ (interp-term (car (last x)) alist hyp clk obligs config state)))))
-                   (interp-term (car (last x)) alist hyp clk obligs config state))
-               (glcp-interp-error
-                "Error: wrong number of args to RETURN-LAST~%")))
-
-            ;; X is a function call.
-            (t (b* ((fn (car x))
-
-                    ;; Interpret the actuals first.
-                    ((glcp-er actuals)
-                     (interp-list (cdr x) alist hyp clk obligs config state))
-
-                    ;; This function returns the correct result if the function has
-                    ;; a symbolic counterpart which is known to it.
-                    ((mv ok ans)
-                     (run-gified fn actuals hyp clk state))
-                    ((when ok) (glcp-value ans))
-
-                    ((mv fncall-failed ans)
-                     (if (general-concrete-listp actuals)
-                         (acl2::magic-ev-fncall
-                          fn (general-concrete-obj-list actuals)
-                          state t nil)
-                       (mv t nil)))
-                    ((unless fncall-failed) (glcp-value (mk-g-concrete ans)))
-                 
-                    ((mv erp body formals obligs)
-                     (acl2::interp-function-lookup
-                      fn obligs (glcp-config->overrides config) (w state)))
-                    ((when erp) (glcp-interp-error erp))
-                    ((unless (equal (len formals) (len actuals)))
-                     (glcp-interp-error
-                      (acl2::msg "~
+                      'gl-error-result)))
+                (glcp-interp-error "Error: wrong number of args to GL-ERROR~%")))
+             ((when (eq (car x) 'return-last))
+              (if (eql (len x) 4)
+                  (if (equal (cadr x) ''acl2::time$1-raw)
+                      (b* (((mv time$-args err ,@(cdr *glcp-common-retvals*))
+                            (let ((clk (1- clk)))
+                              (interp-term-equivs
+                               (caddr x)
+                               alist nil . ,*glcp-common-inputs*))))
+                        (mbe :logic (interp-term
+                                     (car (last x)) alist contexts . ,*glcp-common-inputs*)
+                             :exec
+                             (if (and (not err)
+                                      (general-concretep time$-args))
+                                 (return-last
+                                  'acl2::time$1-raw
+                                  (general-concrete-obj time$-args)
+                                  (interp-term (car (last x))
+                                               alist contexts . ,*glcp-common-inputs*))
+                               (time$
+                                (interp-term (car (last x))
+                                             alist contexts . ,*glcp-common-inputs*)))))
+                    (interp-term (car (last x))
+                                 alist contexts . ,*glcp-common-inputs*))
+                (glcp-interp-error "Error: wrong number of args to RETURN-LAST~%")))
+             (fn (car x))
+             ;; outside-in rewriting?
+             ((glcp-er actuals)
+              (interp-list (cdr x)
+                           alist . ,*glcp-common-inputs*)))
+          (interp-fncall-ifs fn actuals x contexts . ,*glcp-common-inputs*)))
+
+      (defun interp-fncall-ifs
+        (fn actuals x contexts . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 1919 (g-ite-depth-sum actuals) 20)
+                  :guard (and (posp clk)
+                              (symbolp fn)
+                              (contextsp contexts)
+                              (not (eq fn 'quote))
+                              (true-listp actuals)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (b* (((unless (glcp-lift-ifsp fn (glcp-config->lift-ifsp config)
+                                      (w state)))
+              (interp-fncall fn actuals x contexts . ,*glcp-common-inputs*))
+             ((mv has-if test then-args else-args)
+              (gl-args-split-ite actuals))
+             ((unless has-if)
+              (interp-fncall fn actuals x contexts . ,*glcp-common-inputs*))
+             ((glcp-er test-bfr)
+              (simplify-if-test test t . ,*glcp-common-inputs*))
+             ((glcp-er then-obj)
+              (maybe-interp-fncall-ifs fn then-args x contexts test-bfr
+                                       . ,*glcp-common-inputs*))
+             ((glcp-er else-obj)
+              (maybe-interp-fncall-ifs fn else-args x contexts (bfr-not test-bfr)
+                                       . ,*glcp-common-inputs*)))
+          (merge-branches test-bfr then-obj else-obj nil contexts . ,*glcp-common-inputs*)))
+
+
+      (defun maybe-interp-fncall-ifs (fn actuals x contexts branchcond . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 1919 (g-ite-depth-sum actuals) 45)
+                  :verify-guards nil
+                  :guard (and (posp clk)
+                              (symbolp fn)
+                              (contextsp contexts)
+                              (not (eq fn 'quote))
+                              (true-listp actuals)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (let ((branchcond (hyp-fix branchcond (cpathcond))))
+          (if branchcond
+              (let ((pathcond (bfr-and pathcond branchcond)))
+                (interp-fncall-ifs
+                 fn actuals x contexts . ,*glcp-common-inputs*))
+            (glcp-value nil))))
+
+      (defun interp-fncall
+        (fn actuals x contexts . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 1414 0 20)
+                  :guard (and (posp clk)
+                              (symbolp fn)
+                              (not (eq fn 'quote))
+                              (true-listp actuals)
+                              (contextsp contexts)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (b* ((uninterp (cdr (hons-assoc-equal fn (table-alist
+                                                  'gl-uninterpreted-functions (w
+                                                                               state)))))
+             ((mv fncall-failed ans)
+              (if (and (not uninterp)
+                       (general-concrete-listp actuals))
+                  (acl2::magic-ev-fncall fn (general-concrete-obj-list actuals)
+                                         state t nil)
+                (mv t nil)))
+             ((unless fncall-failed)
+              (glcp-value (mk-g-concrete ans)))
+             ((glcp-er successp term bindings)
+              (rewrite fn actuals :fncall contexts . ,*glcp-common-inputs*))
+             ((when successp)
+              (b* ((clk (1- clk)))
+                (interp-term-equivs term bindings contexts . ,*glcp-common-inputs*)))
+             ((mv ok ans)
+              (run-gified fn actuals (cpathcond) clk config bvar-db state))
+             ((when ok) (glcp-value ans))
+             ((when (cdr (hons-assoc-equal fn (table-alist 'gl-uninterpreted-functions (w state)))))
+              (glcp-value (g-apply fn actuals)))
+             ((mv erp body formals obligs1)
+              (acl2::interp-function-lookup fn
+                                            (is-obligs interp-st)
+                                            (glcp-config->overrides config)
+                                            (w state)))
+             ((when erp) (glcp-interp-error erp))
+             (interp-st (update-is-obligs obligs1 interp-st))
+             ((unless (equal (len formals) (len actuals)))
+              (glcp-interp-error
+               (acl2::msg
+                "~
 In the function call ~x0, function ~x1 is given ~x2 arguments,
 but its arity is ~x3.  Its formal parameters are ~x4."
-                                 x fn (len actuals) (len formals) formals))))
-                 (interp-term
-                  body (pairlis$ formals actuals) hyp (1- clk)
-                  obligs config state)))))
-    (defun interp-list (x alist hyp clk obligs config state)
-      (declare (xargs :measure (make-ord 1 (1+ (nfix clk)) (acl2-count x))
-                      :guard (and (natp clk)
-                                  (pseudo-term-listp x)
-                                  (acl2::interp-defs-alistp obligs)
-                                  (glcp-config-p config)
-                                  (acl2::interp-defs-alistp (glcp-config->overrides config)))
-                      :stobjs state))
-      (if (atom x)
-          (glcp-value nil)
-        (b* (((glcp-er car)
-              (interp-term (car x) alist hyp clk obligs config state))
-             ((glcp-er cdr)
-              (interp-list (cdr x) alist hyp clk obligs config state)))
-          (glcp-value (gl-cons car cdr)))))))
-
-(defconst *glcp-run-parametrized-template*
-  '(defun run-parametrized
-     (hyp concl untrans-concl vars bindings id obligs config state)
-     (b* ((bound-vars (strip-cars bindings))
-          ((glcp-config config) config)
-          ((er hyp)
-           (if (pseudo-termp hyp)
-               (let ((hyp-unbound-vars
-                      (set-difference-eq (collect-vars hyp)
-                                         bound-vars)))
-                 (if hyp-unbound-vars
-                     (prog2$ (flush-hons-get-hash-table-link obligs)
-                             (glcp-error (acl2::msg "~
+                x fn (len actuals)
+                (len formals)
+                formals)))
+             (clk (1- clk)))
+          (interp-term-equivs body (pairlis$ formals actuals)
+                              contexts . ,*glcp-common-inputs*)))
+
+      (defun interp-if/or (test tbr fbr alist contexts . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 2020 (+ (acl2-count test)
+                                                       (acl2-count tbr)
+                                                       (acl2-count fbr)) 60)
+                  :verify-guards nil
+                  :guard (and (posp clk)
+                              (pseudo-termp test)
+                              (pseudo-termp tbr)
+                              (pseudo-termp fbr)
+                              (contextsp contexts)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (if (hqual test tbr)
+            (interp-or test fbr alist contexts . ,*glcp-common-inputs*)
+          (interp-if test tbr fbr alist contexts . ,*glcp-common-inputs*)))
+
+      (defun maybe-interp (x alist contexts branchcond . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 2020 (acl2-count x) 45)
+                  :verify-guards nil
+                  :guard (and (natp clk)
+                              (pseudo-termp x)
+                              (contextsp contexts)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (let ((branchcond (hyp-fix branchcond (cpathcond))))
+          (if branchcond
+              (let ((pathcond (bfr-and pathcond branchcond)))
+                (interp-term-equivs
+                 x alist contexts . ,*glcp-common-inputs*))
+            (glcp-value nil))))
+
+      (defun interp-or (test fbr alist contexts . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 2020 (+ (acl2-count test)
+                                                       (acl2-count fbr)) 50)
+                  :verify-guards nil
+                  :guard (and (posp clk)
+                              (pseudo-termp test)
+                              (pseudo-termp fbr)
+                              (contextsp contexts)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (b* (((glcp-er test-obj)
+              (interp-term-equivs
+               test alist (glcp-or-test-contexts contexts)  . ,*glcp-common-inputs*))
+             ((glcp-er test-bfr)
+              (simplify-if-test test-obj t . ,*glcp-common-inputs*))
+             ((glcp-er else)
+              (maybe-interp
+               fbr alist contexts (bfr-not test-bfr) . ,*glcp-common-inputs*)))
+          (merge-branches test-bfr test-obj else nil contexts . ,*glcp-common-inputs*)))
+
+      (defun interp-if (test tbr fbr alist contexts . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 2020 (+ (acl2-count test)
+                                                       (acl2-count tbr)
+                                                       (acl2-count fbr)) 50)
+                  :verify-guards nil
+                  :guard (and (posp clk)
+                              (pseudo-termp test)
+                              (pseudo-termp tbr)
+                              (pseudo-termp fbr)
+                              (contextsp contexts)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (b* (((glcp-er test-bfr)
+              (interp-test
+               test alist t . ,*glcp-common-inputs*))
+             ((glcp-er then)
+              (maybe-interp
+               tbr alist contexts test-bfr . ,*glcp-common-inputs*))
+             ((glcp-er else)
+              (maybe-interp
+               fbr alist contexts (bfr-not test-bfr) . ,*glcp-common-inputs*)))
+          (merge-branches test-bfr then else nil contexts . ,*glcp-common-inputs*)))
+
+      (defun merge-branches (test-bfr then else switchedp contexts . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list (pos-fix clk) 1818
+                                 (+ (acl2-count then) (acl2-count else))
+                                 (if switchedp 20 30))
+                  :verify-guards nil
+                  :guard (and (posp clk)
+                              (contextsp contexts)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (b* (((when (eq test-bfr t)) (glcp-value then))
+             ((when (eq test-bfr nil)) (glcp-value else))
+             ((when (hons-equal then else)) (glcp-value then))
+             ((when (or (atom then)
+                        (and (g-keyword-symbolp (tag then))
+                             (or (not (eq (tag then) :g-apply))
+                                 (not (symbolp (g-apply->fn then)))
+                                 (eq (g-apply->fn then) 'quote)))))
+              (if switchedp
+                  (merge-branch-subterms
+                   (bfr-not test-bfr) else then . ,*glcp-common-inputs*)
+                (merge-branches (bfr-not test-bfr) else then t contexts . ,*glcp-common-inputs*)))
+             (fn (if (eq (tag then) :g-apply)
+                     (g-apply->fn then)
+                   'cons))
+             (rules (glcp-get-branch-merge-rules fn (w state)))
+             (runes (rewrite-rules->runes rules))
+             ((glcp-er successp term bindings)
+              (rewrite-apply-rules
+               rules runes 'if (list (g-boolean test-bfr) then else)
+               contexts . ,*glcp-common-inputs*))
+             ((when successp)
+              (b* ((clk (1- clk)))
+                (interp-term-equivs term bindings contexts . ,*glcp-common-inputs*))))
+          (if switchedp
+              (merge-branch-subterms (bfr-not test-bfr) else then . ,*glcp-common-inputs*)
+            (merge-branches (bfr-not test-bfr) else then t contexts . ,*glcp-common-inputs*))))
+
+      (defun merge-branch-subterms (test-bfr then else
+                                             . ,*glcp-common-inputs*)
+        (declare (xargs :measure (list (pos-fix clk) 1818
+                                       (+ (acl2-count then) (acl2-count else))
+                                       15)
+                        :guard (and (posp clk)
+                                    . ,*glcp-common-guards*)
+                        :stobjs ,*glcp-stobjs*))
+        (b* (((when (or (atom then)
+                        (atom else)
+                        (xor (eq (tag then) :g-apply)
+                             (eq (tag else) :g-apply))
+                        (not (or (eq (tag then) :g-apply)
+                                 (and (general-consp then)
+                                      (general-consp else))))
+                        (and (eq (tag then) :g-apply)
+                             (not (and (symbolp (g-apply->fn then))
+                                       (not (eq (g-apply->fn then) 'quote))
+                                       (eq (g-apply->fn then) (g-apply->fn else))
+                                       (int= (len (g-apply->args then))
+                                             (len (g-apply->args else))))))))
+              (glcp-value (gobj-ite-merge test-bfr then else (cpathcond))))
+             ((unless (eq (tag then) :g-apply))
+              (b* (((glcp-er car) (merge-branches test-bfr
+                                                  (general-consp-car then)
+                                                  (general-consp-car else)
+                                                  nil nil . ,*glcp-common-inputs*))
+                   ((glcp-er cdr) (merge-branches test-bfr
+                                                  (general-consp-cdr then)
+                                                  (general-consp-cdr else)
+                                                  nil nil . ,*glcp-common-inputs*)))
+                (glcp-value ;; (gl-cons-split-ite car cdr)
+                 (gl-cons-maybe-split car cdr
+                                      (glcp-config->split-conses config)
+                                      (w state)))))
+             ((glcp-er args)
+              (merge-branch-subterm-lists test-bfr
+                                          (g-apply->args then)
+                                          (g-apply->args else)
+                                          . ,*glcp-common-inputs*)))
+          (glcp-value (gl-fncall-maybe-split
+                       (g-apply->fn then) args
+                       (glcp-config->split-fncalls config)
+                       (w state)))))
+
+      (defun merge-branch-subterm-lists (test-bfr then else
+                                                  . ,*glcp-common-inputs*)
+        (declare (xargs :measure (list (pos-fix clk) 1818
+                                       (+ (acl2-count then) (acl2-count else))
+                                       15)
+                        :guard (and (posp clk)
+                                    (equal (len then) (len else))
+                                    . ,*glcp-common-guards*)
+                        :stobjs ,*glcp-stobjs*))
+        (b* (((when (atom then))
+              (glcp-value nil))
+             ((cons then1 thenr) then)
+             ((cons else1 elser) else)
+             ((glcp-er rest) (merge-branch-subterm-lists test-bfr thenr elser
+                                                         . ,*glcp-common-inputs*))
+             ((glcp-er first) (merge-branches test-bfr then1 else1 nil nil
+                                              . ,*glcp-common-inputs*)))
+          (glcp-value (cons first rest))))
+
+      ;; (defun maybe-simplify-if-test (test-obj intro-bvars branchcond
+      ;;                                         . ,*glcp-common-inputs*)
+      ;;   (declare (xargs
+      ;;             :measure (list clk 1300 (acl2-count test-obj) 15)
+      ;;             :verify-guards nil
+      ;;             :guard (and (natp clk)
+      ;;                         . ,*glcp-common-guards*)
+      ;;             :stobjs ,*glcp-stobjs*))
+      ;;   (if branchcond
+      ;;       (let ((pathcond (bfr-and pathcond branchcond)))
+      ;;         (simplify-if-test
+      ;;          then intro-bvars . ,*glcp-common-inputs*))
+      ;;     (glcp-value nil)))
+
+      ;; returns a glcp-value of a bfr
+      (defun simplify-if-test (test-obj intro-bvars . ,*glcp-common-inputs*)
+        (declare (xargs
+                  :measure (list clk 1300 (acl2-count test-obj) 10)
+                  :verify-guards nil
+                  :guard (and (natp clk)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+        (if (atom test-obj)
+            (glcp-value (and test-obj t))
+          (pattern-match test-obj
+            ((g-boolean bfr) (glcp-value (hyp-fix bfr (cpathcond))))
+            ((g-number &) (glcp-value t))
+            ((g-concrete v) (glcp-value (and v t)))
+            ((g-var &)
+             (b* (((mv bvar bvar-db) (add-term-bvar-unique test-obj bvar-db))
+                  (bvar-db (maybe-add-equiv-term test-obj bvar bvar-db state)))
+               (glcp-value (hyp-fix
+                            (bfr-to-param-space (glcp-config->param-bfr config)
+                                                (bfr-var bvar))
+                            (cpathcond)))))
+            ((g-ite test then else)
+             (b* ((hyp pathcond)
+                  ((glcp-er test-bfr) (simplify-if-test
+                                       test intro-bvars . ,*glcp-common-inputs*))
+                  (then-hyp test-bfr)
+                  (else-hyp (bfr-not test-bfr))
+                  ((glcp-er then-bfr)
+                   (if then-hyp
+                       (let ((pathcond (bfr-and hyp then-hyp)))
+                         (simplify-if-test
+                          then intro-bvars . ,*glcp-common-inputs*))
+                     (glcp-value nil)))
+                  ((glcp-er else-bfr)
+                   (if else-hyp
+                       (let ((pathcond (bfr-and hyp else-hyp)))
+                         (simplify-if-test
+                          else intro-bvars . ,*glcp-common-inputs*))
+                     (glcp-value nil))))
+               ;; Seems unlikely that hyp-fix would give any reductions here:
+               ;; maybe test this
+               (glcp-value (bfr-ite test-bfr then-bfr else-bfr))))
+            ((g-apply fn args)
+             (simplify-if-test-fncall fn args intro-bvars . ,*glcp-common-inputs*))
+            (& ;; cons
+             (glcp-value t)))))
+
+
+      (defun simplify-if-test-fncall (fn args intro-bvars
+                                         . ,*glcp-common-inputs*)
+
+        (declare (xargs
+                  :measure (list clk 1300 (acl2-count args) 10)
+                  :verify-guards nil
+                  :guard (and (natp clk)
+                              . ,*glcp-common-guards*)
+                  :stobjs ,*glcp-stobjs*))
+
+        (b* (((when (or (not (symbolp fn))
+                        (eq fn 'quote)))
+              (glcp-interp-error (acl2::msg "Non function symbol in g-apply: ~x0" fn)))
+
+             ((when (and (eq fn 'not)
+                         (eql (len args) 1)))
+              (b* (((glcp-er neg-bfr)
+                    (simplify-if-test (first args) intro-bvars . ,*glcp-common-inputs*)))
+                (glcp-value (bfr-not neg-bfr))))
+             ((when (and (eq fn 'equal)
+                         (eql (len args) 2)
+                         (or (eq (car args) nil)
+                             (eq (cadr args) nil))))
+              (b* (((glcp-er neg-bfr)
+                    (simplify-if-test (or (car args) (cadr args)) intro-bvars . ,*glcp-common-inputs*)))
+                (glcp-value (bfr-not neg-bfr))))
+
+             ((when (and (eq fn 'gl-force-check)
+                         (eql (len args) 1)))
+              (b* (((glcp-er sub-bfr)
+                    (simplify-if-test (first args) intro-bvars . ,*glcp-common-inputs*)))
+                (glcp-value (bfr-constcheck sub-bfr))))
+
+             ((when (and (eq fn 'gl-force-check-strong)
+                         (eql (len args) 1)))
+              (b* (((glcp-er sub-bfr)
+                    (simplify-if-test (first args) intro-bvars . ,*glcp-common-inputs*)))
+                (glcp-value (bfr-constcheck-pathcond sub-bfr (cpathcond)))))
+
+             ((when (and (eq fn 'gl-force-true)
+                         (eql (len args) 1)))
+              (b* (((glcp-er sub-bfr)
+                    (simplify-if-test (first args) intro-bvars . ,*glcp-common-inputs*)))
+                (glcp-value (bfr-check-true sub-bfr))))
+
+             ((when (and (eq fn 'gl-force-false)
+                         (eql (len args) 1)))
+              (b* (((glcp-er sub-bfr)
+                    (simplify-if-test (first args) intro-bvars . ,*glcp-common-inputs*)))
+                (glcp-value (bfr-check-false sub-bfr))))
+
+             ((when (zp clk))
+              (glcp-interp-error "Clock ran out in simplify-if-test"))
+
+             ((glcp-er successp term bindings)
+              (rewrite fn args :if-test '(iff) . ,*glcp-common-inputs*))
+             ((when successp)
+              (interp-test term bindings intro-bvars
+                           . ,*glcp-common-inputs*))
+             
+             (x (g-apply fn args))
+             (look (get-term->bvar x bvar-db))
+
+             ((when look)
+              (glcp-value
+               (hyp-fix (bfr-to-param-space (glcp-config->param-bfr config)
+                                            (bfr-var look))
+                        (cpathcond))))
+
+             ((unless intro-bvars)
+              (glcp-interp-abort :intro-bvars-fail))
+
+             (bvar (next-bvar bvar-db))
+             (bvar-db (add-term-bvar x bvar-db))
+             (bvar-db (maybe-add-equiv-term x bvar bvar-db state))
+             ((glcp-er) (add-bvar-constraints x . ,*glcp-common-inputs*)))
+          (glcp-value (hyp-fix (bfr-to-param-space (glcp-config->param-bfr config)
+                                                   (bfr-var bvar))
+                               (cpathcond)))))
+
+      (defun add-bvar-constraints (lit . ,*glcp-common-inputs*)
+        (declare (xargs :stobjs ,*glcp-stobjs*
+                        :guard (and (posp clk)
+                                    . ,*glcp-common-guards*)
+                        :measure (list (pos-fix clk) 1000 0 0))
+                 (ignorable pathcond))
+        (b* ((ccat (is-constraint-db interp-st))
+             ((mv substs ccat) (ec-call (gbc-process-new-lit lit ccat state)))
+             (interp-st (update-is-constraint-db ccat interp-st)))
+          (add-bvar-constraint-substs substs . ,*glcp-common-inputs*)))
+
+      (defun add-bvar-constraint-substs (substs . ,*glcp-common-inputs*)
+        (declare (xargs :stobjs ,*glcp-stobjs*
+                        :guard (and (posp clk)
+                                    . ,*glcp-common-guards*)
+                        :measure (list (pos-fix clk) 900 (len substs) 0))
+                 (ignorable pathcond))
+        (b* (((when (atom substs)) (glcp-value))
+             (subst (car substs))
+             ((unless (and (consp subst)
+                           (symbolp (car subst))
+                           (alistp (cdr subst))))
+              (add-bvar-constraint-substs (cdr substs) . ,*glcp-common-inputs*))
+             ((cons thm alist) subst)
+             (thm-body (acl2::meta-extract-formula thm state))
+             ((unless (pseudo-termp thm-body))
+              (add-bvar-constraint-substs (cdr substs) . ,*glcp-common-inputs*))
+             ((mv new-constraint . ,*glcp-common-retvals*)
+              (let* ((pathcond t))
+                (interp-test thm-body alist nil . ,*glcp-common-inputs*)))
+             ((when (eq er :intro-bvars-fail))
+              (add-bvar-constraint-substs (cdr substs) . ,*glcp-common-inputs*))
+             ((when er) (glcp-interp-abort er :nvals 0))
+             (curr-constraint (is-constraint interp-st))
+             (interp-st (update-is-constraint (bfr-and 
+                                               (hyp-fix new-constraint curr-constraint)
+                                               curr-constraint)
+                                              interp-st)))
+          (add-bvar-constraint-substs (cdr substs) . ,*glcp-common-inputs*)))
+
+
+      (defun rewrite (fn actuals rwtype contexts . ,*glcp-common-inputs*)
+        (declare (xargs :stobjs ,*glcp-stobjs*
+                        :guard (and (posp clk)
+                                    (symbolp fn)
+                                    (not (eq fn 'quote))
+                                    (contextsp contexts)
+                                    . ,*glcp-common-guards*)
+                        :measure (list (pos-fix clk) 1212 0 0))
+                 (ignorable rwtype))
+
+        ;; (mv erp obligs1 successp term bindings bvar-db state)
+        (b* ((rules (cdr (hons-assoc-equal fn (table-alist 'gl-rewrite-rules (w state)))))
+             ;; or perhaps we should pass the table in the obligs? see if this is
+             ;; expensive
+             ((unless (and rules (true-listp rules))) ;; optimization (important?)
+              (glcp-value nil nil nil))
+             (fn-rewrites (getprop fn 'acl2::lemmas nil 'current-acl2-world (w state))))
+          (rewrite-apply-rules
+           fn-rewrites rules fn actuals contexts . ,*glcp-common-inputs*)))
+
+
+      (defun rewrite-apply-rules
+        (fn-rewrites rules fn actuals contexts . ,*glcp-common-inputs*)
+        (declare (xargs :stobjs ,*glcp-stobjs*
+                        :guard (and (true-listp rules)
+                                    (posp clk)
+                                    (symbolp fn)
+                                    (not (eq fn 'quote))
+                                    (contextsp contexts)
+                                    . ,*glcp-common-guards*)
+                        :measure (list (pos-fix clk) 88 (len fn-rewrites) 0)))
+        (b* (((when (atom fn-rewrites))
+              ;; no more rules, fail
+              (glcp-value nil nil nil))
+             (rule (car fn-rewrites))
+             ((unless (acl2::weak-rewrite-rule-p rule))
+              (cw "malformed rewrite rule?? ~x0~%" rule)
+              (rewrite-apply-rules
+               (cdr fn-rewrites) rules fn actuals contexts . ,*glcp-common-inputs*))
+             ((unless (member-equal (acl2::rewrite-rule->rune rule) rules))
+              (rewrite-apply-rules
+               (cdr fn-rewrites) rules fn actuals contexts . ,*glcp-common-inputs*))
+             ((glcp-er successp term bindings :nvals 3)
+              (rewrite-apply-rule
+               rule fn actuals contexts . ,*glcp-common-inputs*))
+             ((when successp)
+              (glcp-value successp term bindings)))
+          (rewrite-apply-rules
+           (cdr fn-rewrites) rules fn actuals contexts . ,*glcp-common-inputs*)))
+
+      (defun rewrite-apply-rule
+        (rule fn actuals contexts . ,*glcp-common-inputs*)
+        (declare (xargs :stobjs ,*glcp-stobjs*
+                        :guard (and (acl2::weak-rewrite-rule-p rule)
+                                    (posp clk)
+                                    (symbolp fn)
+                                    (not (eq fn 'quote))
+                                    (contextsp contexts)
+                                    . ,*glcp-common-guards*)
+                        :measure (list (pos-fix clk) 44 0 0)))
+        (b* (((rewrite-rule rule) rule)
+             ((unless (and (symbolp rule.equiv)
+                           (not (eq rule.equiv 'quote))
+                           ;; (ensure-equiv-relationp rule.equiv (w state))
+                           (not (eq rule.subclass 'acl2::meta))
+                           (pseudo-termp rule.lhs)
+                           (consp rule.lhs)
+                           (eq (car rule.lhs) fn)))
+              (cw "malformed gl rewrite rule (lhs)?? ~x0~%" rule)
+              (glcp-value nil nil nil))
+             ((unless (or (eq rule.equiv 'equal)
+                          ;; bozo check refinements
+                          (member rule.equiv contexts)))
+              (glcp-value nil nil nil))
+             ((mv unify-ok gobj-bindings)
+              (glcp-unify-term/gobj-list (cdr rule.lhs) actuals nil))
+             ((unless unify-ok) (glcp-value nil nil nil))
+             ((unless (pseudo-term-listp rule.hyps))
+              (cw "malformed gl rewrite rule (hyps)?? ~x0~%" rule)
+              (glcp-value nil nil nil))
+             ((glcp-er hyps-ok gobj-bindings :nvals 3)
+              (relieve-hyps rule.rune rule.hyps gobj-bindings . ,*glcp-common-inputs*))
+             ((unless hyps-ok) (glcp-value nil nil nil))
+             ((unless (pseudo-termp rule.rhs))
+              (cw "malformed gl rewrite rule (rhs)?? ~x0~%" rule)
+              (glcp-value nil nil nil)))
+          (glcp-value t rule.rhs gobj-bindings)))
+
+      (defun relieve-hyps (rune hyps bindings . ,*glcp-common-inputs*)
+        (declare (xargs :stobjs ,*glcp-stobjs*
+                        :guard (and (pseudo-term-listp hyps)
+                                    (posp clk)
+                                    . ,*glcp-common-guards*)
+                        :measure (list (pos-fix clk) 22 (len hyps) 0))
+                 (ignorable rune))
+        (b* (((when (atom hyps)) (glcp-value t bindings))
+             ((glcp-er ok bindings :nvals 2)
+              (relieve-hyp rune (car hyps) bindings . ,*glcp-common-inputs*))
+             ((when (not ok)) (glcp-value nil bindings)))
+          (relieve-hyps rune (cdr hyps) bindings . ,*glcp-common-inputs*)))
+
+      (defun relieve-hyp (rune hyp bindings . ,*glcp-common-inputs*)
+        (declare (xargs :stobjs ,*glcp-stobjs*
+                        :guard (and (pseudo-termp hyp)
+                                    (posp clk)
+                                    . ,*glcp-common-guards*)
+                        :measure (list (pos-fix clk) 15 0 0))
+                 (ignorable rune))
+        ;; "Simple" version for now; maybe free variable bindings, syntaxp, etc later...
+        (b* (((when (and (consp hyp) (eq (car hyp) 'synp)))
+              (b* (((mv erp successp bindings)
+                    (glcp-relieve-hyp-synp hyp bindings state))
+                   ((when erp) (glcp-interp-error
+                                (if (eq erp t) "t" erp) :nvals 2)))
+                (glcp-value successp bindings)))
+             ((mv bfr . ,*glcp-common-retvals*)
+              (interp-test hyp bindings nil . ,*glcp-common-inputs*))
+             ((when (eq er :intro-bvars-fail))
+              (glcp-value nil bindings))
+             ((when er) (glcp-interp-abort er :nvals 2))
+             ((when (eq bfr t))
+              (glcp-value t bindings)))
+          (glcp-value nil bindings)))
+
+      (defun interp-list
+        (x alist . ,*glcp-common-inputs*)
+        (declare
+         (xargs
+          :measure (list (pos-fix clk) 2020 (acl2-count x) 20)
+          :guard (and (natp clk)
+                      (pseudo-term-listp x)
+                      . ,*glcp-common-guards*)
+          :stobjs ,*glcp-stobjs*))
+        (if (atom x)
+            (glcp-value nil)
+          (b* (((glcp-er car)
+                (interp-term-equivs (car x)
+                                    alist nil . ,*glcp-common-inputs*))
+               ((glcp-er cdr)
+                (interp-list (cdr x)
+                             alist . ,*glcp-common-inputs*)))
+            (glcp-value (cons car cdr))))))
+
+     (defund interp-top-level-term
+       (term alist . ,*glcp-common-inputs*)
+       (declare (xargs :guard (and (pseudo-termp term)
+                                   (natp clk)
+                                   . ,*glcp-common-guards*)
+                       :stobjs ,*glcp-stobjs*
+                       :verify-guards nil))
+       (b* ((config (glcp-config-update-term term config)))
+         (interp-test
+          term alist t . ,*glcp-common-inputs*)))
+
+     (defund interp-concl
+       (term alist pathcond clk config interp-st bvar-db1 bvar-db state)
+       (declare (xargs :guard (and (pseudo-termp term)
+                                   (natp clk)
+                                   . ,*glcp-common-guards*)
+                       :stobjs (interp-st bvar-db bvar-db1 state)
+                       :verify-guards nil))
+       (b* ((al (gobj-alist-to-param-space alist pathcond))
+            (bvar-db (init-bvar-db (base-bvar bvar-db1) bvar-db))
+            (bvar-db (parametrize-bvar-db pathcond bvar-db1 bvar-db))
+            (constraint  (bfr-to-param-space pathcond
+                                             (is-constraint interp-st)))
+            (constraint-db (parametrize-constraint-db pathcond
+                                                      (is-constraint-db interp-st)))
+            (config (glcp-config-update-param pathcond config))
+            (interp-st (update-is-constraint constraint
+                                             interp-st))
+            (interp-st (update-is-constraint-db constraint-db interp-st))
+            
+            ((unless pathcond)
+             (glcp-value nil))
+            (pathcond (bfr-to-param-space pathcond pathcond)))
+         (interp-top-level-term
+          term al . ,*glcp-common-inputs*)))
+
+     (defund interp-hyp/concl
+       (hyp concl alist clk config interp-st next-bvar bvar-db bvar-db1 state)
+       (declare (xargs :guard (and (pseudo-termp hyp)
+                                   (pseudo-termp concl)
+                                   (natp clk)
+                                   . ,*glcp-common-guards*)
+                       :stobjs (interp-st bvar-db bvar-db1 state)
+                       :verify-guards nil))
+       (b* ((bvar-db (init-bvar-db next-bvar bvar-db))
+            (bvar-db1 (init-bvar-db next-bvar bvar-db1))
+            (config (glcp-config-update-param t config))
+            ((mv hyp-bfr . ,*glcp-common-retvals*)
+             (let ((pathcond t))
+               (interp-top-level-term
+                hyp alist . ,*glcp-common-inputs*)))
+            ((when er)
+             (mv hyp-bfr nil bvar-db1 . ,*glcp-common-retvals*))
+            ((when (and (glcp-config->abort-vacuous config)
+                        (not hyp-bfr)))
+             (mv hyp-bfr nil bvar-db1
+                 "Hypothesis is not satisfiable"
+                 . ,(cdr *glcp-common-retvals*)))
+            (- (and (not hyp-bfr)
+                    (cw "Note: hypothesis is not satisfiable~%")))
+            ((mv concl-bfr . ,(subst 'bvar-db1 'bvar-db *glcp-common-retvals*))
+             (interp-concl
+              concl alist hyp-bfr clk config interp-st bvar-db bvar-db1 state)))
+         (mv hyp-bfr concl-bfr bvar-db1 . ,*glcp-common-retvals*)))
+
+     ;; almost-user-level wrapper
+     (defun interp-term-under-hyp (hyp term al next-bvar config interp-st bvar-db bvar-db1 state)
+       (declare (xargs :stobjs (interp-st bvar-db bvar-db1 state)
+                       :verify-guards nil))
+       (b* ((bvar-db (init-bvar-db next-bvar bvar-db))
+            (bvar-db1 (init-bvar-db next-bvar bvar-db1))
+            (interp-st (update-is-obligs nil interp-st))
+            (interp-st (update-is-constraint t interp-st))
+            (interp-st (update-is-constraint-db (table-alist
+                                                 'gl-bool-constraints (w state))
+                                                interp-st))
+            ((mv hyp-bfr er interp-st bvar-db state)
+             (interp-top-level-term
+              hyp al t 1000000 config interp-st bvar-db state))
+            ((when er) (mv nil nil nil er interp-st bvar-db bvar-db1 state))
+            (param-al (gobj-alist-to-param-space al hyp-bfr))
+            (bvar-db1 (parametrize-bvar-db hyp-bfr bvar-db bvar-db1))
+            (config (glcp-config-update-param hyp-bfr config))
+            (pathcond (bfr-to-param-space hyp-bfr hyp-bfr))
+            ((mv res-obj erp interp-st bvar-db1 state)
+             (interp-term
+              term param-al nil pathcond 100000 config interp-st bvar-db1 state)))
+         (mv hyp-bfr param-al res-obj erp interp-st bvar-db bvar-db1 state)))))
+
+
+#||
+
+"GL"
+(trace$ (glcp-rewrite-fncall-apply-rule
+         :cond (b* (((rewrite-rule rule) rule)
+                    ((unless (eq (cadr rule.rune) 'logand-of-logapp))
+                     nil)
+                    ((unless (and (eq rule.equiv 'equal)
+                                  (not (eq rule.subclass 'acl2::meta))
+                                  (pseudo-termp rule.lhs)
+                                  (consp rule.lhs)
+                                  (eq (car rule.lhs) fn)))
+                     (cw "malformed gl rewrite rule (lhs)?? ~x0~%" rule))
+                    ((mv unify-ok ?gobj-bindings)
+                     (glcp-unify-term/gobj-list (cdr rule.lhs) actuals nil)))
+                 unify-ok)))
+
+
+||#
+
+(defconst *glcp-clause-proc-template*
+  `(progn
+     (defun run-parametrized
+       (hyp concl vars bindings id obligs config state)
+       (b* ((bound-vars (strip-cars bindings))
+            ((glcp-config config) config)
+            ((er hyp)
+             (if (pseudo-termp hyp)
+                 (let ((hyp-unbound-vars
+                        (set-difference-eq (collect-vars hyp)
+                                           bound-vars)))
+                   (if hyp-unbound-vars
+                       (prog2$ (flush-hons-get-hash-table-link obligs)
+                               (glcp-error (acl2::msg "~
 In ~@0: The hyp contains the following unbound variables: ~x1~%"
-                                                    id hyp-unbound-vars)))
-                   (value hyp)))
-             (glcp-error "The hyp is not a pseudo-term.~%")))
-          ((unless (shape-spec-bindingsp bindings))
-           (flush-hons-get-hash-table-link obligs)
-           (glcp-error
-            (acl2::msg "~
+                                                      id hyp-unbound-vars)))
+                     (value hyp)))
+               (glcp-error "The hyp is not a pseudo-term.~%")))
+            ((unless (shape-spec-bindingsp bindings))
+             (flush-hons-get-hash-table-link obligs)
+             (glcp-error
+              (acl2::msg "~
 In ~@0: the bindings don't satisfy shape-spec-bindingsp: ~x1"
-                       id bindings)))
-          (obj (strip-cadrs bindings))
-          ((unless (and (acl2::fast-no-duplicatesp (shape-spec-indices obj))
-                        (acl2::fast-no-duplicatesp-equal (shape-spec-vars obj))))
-           (flush-hons-get-hash-table-link obligs)
-           (glcp-error
-            (acl2::msg "~
+                         id bindings)))
+            (obj (strip-cadrs bindings))
+            ((unless (and (acl2::fast-no-duplicatesp (shape-spec-list-indices obj))
+                          (acl2::fast-no-duplicatesp-equal (shape-spec-list-vars obj))))
+             (flush-hons-get-hash-table-link obligs)
+             (glcp-error
+              (acl2::msg "~
 In ~@0: the indices or variables contain duplicates in bindings ~x1"
-                       id bindings)))
-          ((unless (subsetp-equal vars bound-vars))
-           (flush-hons-get-hash-table-link obligs)
-           (glcp-error
-            (acl2::msg "~
+                         id bindings)))
+            ((unless (subsetp-equal vars bound-vars))
+             (flush-hons-get-hash-table-link obligs)
+             (glcp-error
+              (acl2::msg "~
 In ~@0: The conclusion countains the following unbound variables: ~x1~%"
-                       id (set-difference-eq vars bound-vars))))
-          (al (shape-specs-to-interp-al bindings))
-          (cov-clause
-           (list '(not (gl-cp-hint 'coverage))
-                 (dumb-negate-lit hyp)
-                 `(shape-spec-obj-in-range
-                   ',obj
-                   ,(list*-macro (append (strip-cars bindings)
-                                         (list ''nil))))))
-          ((mv er obligs1 hyp-val state)
-           (interp-term hyp al t config.hyp-clk obligs config state))
-          ((when er)
-           (flush-hons-get-hash-table-link obligs1)
-           (glcp-error
-            (acl2::msg
-             "~x0 failed to run the hyp, error: ~@1~%"
-             config.clause-proc-name er)))
-          (hyp-test (gtests hyp-val t))
-          (hyp-bdd (bfr-or (gtests-nonnil hyp-test)
-                           (gtests-unknown hyp-test)))
-          ((when (not hyp-bdd))
-           (if config.abort-vacuous
-               (glcp-error "Hypothesis is not satisfiable.")
-             (prog2$ (cw "NOTE: Hypothesis is not satisfiable~%")
-                     (value (cons (list cov-clause) obligs1)))))
-          (param-al (gobj-alist-to-param-space al hyp-bdd))
-          (hyp-param (bfr-to-param-space hyp-bdd hyp-bdd))
-          ((mv er obligs2 val state)
-           (interp-term concl param-al hyp-param config.concl-clk obligs1 config state))
-          ((when er)
-           (flush-hons-get-hash-table-link obligs2)
-           (glcp-error
-            (acl2::msg
-             "~x0 failed with error: ~@1~%" config.clause-proc-name er)))
-          ((er val-clause)
-           (glcp-analyze-interp-result
-            val bindings hyp-bdd id untrans-concl config state)))
-       (value (cons (list val-clause cov-clause) obligs2)))))
+                         id (set-difference-eq vars bound-vars))))
+            (constraint-db (gbc-db-make-fast
+                            (table-alist 'gl-bool-constraints (w state))))
+            ((unless (gbc-db-emptyp constraint-db))
+             (flush-hons-get-hash-table-link obligs)
+             (gbc-db-free constraint-db)
+             (glcp-error
+              (acl2::msg "The constraint database stored in the table ~
+                          GL::GL-BOOL-CONSTRAINTS contains nonempty ~
+                          substitutions -- somehow it has gotten corrupted!~%")))
+            (config (change-glcp-config config :shape-spec-alist bindings))
+            (al (shape-specs-to-interp-al bindings))
+            (cov-clause
+             (list '(not (gl-cp-hint 'coverage))
+                   (dumb-negate-lit hyp)
+                   (shape-spec-list-oblig-term
+                    obj
+                    (strip-cars bindings))))
+            ((acl2::local-stobjs bvar-db bvar-db1 interp-st)
+             (mv erp val state bvar-db bvar-db1 interp-st))
+            (interp-st (update-is-obligs obligs interp-st))
+            (interp-st (update-is-constraint t interp-st))
+            (interp-st (update-is-constraint-db constraint-db interp-st))
+            (next-bvar (shape-spec-max-bvar-list (strip-cadrs bindings)))
+            ((mv hyp-bfr concl-bfr bvar-db1 . ,*glcp-common-retvals*)
+             (interp-hyp/concl
+              hyp concl al config.concl-clk  config interp-st next-bvar bvar-db
+              bvar-db1 state))
+            ((when er)
+             (flush-hons-get-hash-table-link (is-obligs interp-st))
+             (gbc-db-free (is-constraint-db interp-st))
+             (mv er nil state bvar-db bvar-db1 interp-st))
+            ((mv erp val-clause state)
+             (glcp-analyze-interp-result
+              hyp-bfr concl-bfr (is-constraint interp-st)
+              bindings id concl config bvar-db1 state))
+            ((when erp)
+             (flush-hons-get-hash-table-link (is-obligs interp-st))
+             (gbc-db-free (is-constraint-db interp-st))
+             (mv erp nil state bvar-db bvar-db1 interp-st))
+            ((mv erp val state)
+             (value (list val-clause cov-clause (is-obligs interp-st)))))
+         (gbc-db-free (is-constraint-db interp-st))
+         (mv erp val state bvar-db bvar-db1 interp-st)))
 
      ;; abort-unknown abort-ctrex exec-ctrex abort-vacuous nexamples hyp-clk concl-clk
      ;; clause-proc-name overrides  run-before run-after case-split-override
 
 
-(defconst *glcp-run-cases-template*
-  '(defun run-cases
-     (param-alist concl untrans-concl vars obligs config state)
-     (if (atom param-alist)
-         (value (cons nil obligs))
-       (b* (((er (cons rest obligs))
-             (run-cases
-              (cdr param-alist) concl untrans-concl vars obligs config state))
-            (hyp (caar param-alist))
-            (id (cadar param-alist))
-            (g-bindings (cddar param-alist))
-            (- (glcp-cases-wormhole (glcp-config->run-before config) id))
-            ((er (cons clauses obligs))
-             (run-parametrized
-              hyp concl untrans-concl vars g-bindings id obligs config state))
-            (- (glcp-cases-wormhole (glcp-config->run-after config) id)))
-         (value (cons (append clauses rest) obligs))))))
-
-(defconst *glcp-clause-proc-template*
-  '(defun clause-proc (clause hints state)
-     (b* (;; ((unless (sym-counterparts-ok (w state)))
-          ;;  (glcp-error "The installed symbolic counterparts didn't satisfy all our checks"))
-          ((list bindings param-bindings hyp param-hyp concl untrans-concl config) hints)
-          ((er overrides)
-           (preferred-defs-to-overrides
-            (table-alist 'preferred-defs (w state)) state))
-          (config (change-glcp-config config :overrides overrides))
-          ((er hyp)
-           (if (pseudo-termp hyp)
-               (value hyp)
-             (glcp-error "The hyp is not a pseudo-term.~%")))
-          (hyp-clause (cons '(not (gl-cp-hint 'hyp))
-                            (append clause (list hyp))))
-          ((er concl)
-           (if (pseudo-termp concl)
-               (value concl)
-             (glcp-error "The concl is not a pseudo-term.~%")))
-          (concl-clause (cons '(not (gl-cp-hint 'concl))
-                              (append clause (list (list 'not concl))))))
-       (if param-bindings
-           ;; Case splitting.
-           (b* (((er param-hyp)
-                 (if (pseudo-termp param-hyp)
-                     (value param-hyp)
-                   (glcp-error "The param-hyp is not a pseudo-term.~%")))
-                (full-hyp (conjoin (list param-hyp hyp)))
-                (param-alist (param-bindings-to-alist
-                              full-hyp param-bindings))
-                ;; If the hyp holds, then one of the cases in the
-                ;; param-alist holds.
-                (params-cov-term (disjoin (strip-cars param-alist)))
-                (params-cov-vars (collect-vars params-cov-term))
-                (- (cw "Checking case split coverage ...~%"))
-                ((er (cons params-cov-res-clauses obligs0))
-                 (if (glcp-config->case-split-override config)
-                     (value (cons (list `((not (gl-cp-hint 'casesplit))
-                                          (not ,hyp)
-                                          ,params-cov-term))
-                                  'obligs))
-                   (run-parametrized
-                    hyp params-cov-term params-cov-term params-cov-vars bindings
-                    "case-split coverage" 'obligs config state)))
-                (- (cw "Case-split coverage OK~%"))
-                ((er (cons cases-res-clauses obligs1))
+     ,'(defun run-cases
+         (param-alist concl vars obligs config state)
+         (if (atom param-alist)
+             (value (cons nil obligs))
+           (b* (((er (cons rest obligs))
                  (run-cases
-                  param-alist concl untrans-concl (collect-vars concl) obligs0 config state)))
-             (value (list* hyp-clause concl-clause
-                           (append cases-res-clauses
-                                   params-cov-res-clauses
-                                   (acl2::interp-defs-alist-clauses 
-                                    (flush-hons-get-hash-table-link obligs1))))))
-         ;; No case-splitting.
-         (b* (((er (cons res-clauses obligs))
-               (run-parametrized
-                hyp concl untrans-concl (collect-vars concl) bindings
-                "main theorem" nil config state)))
-           (cw "GL symbolic simulation OK~%")
-           (value (list* hyp-clause concl-clause
-                         (append res-clauses
-                                 (acl2::interp-defs-alist-clauses
-                                  (flush-hons-get-hash-table-link obligs))))))))))
+                  (cdr param-alist) concl vars obligs config state))
+                (hyp (caar param-alist))
+                (id (cadar param-alist))
+                (g-bindings (cddar param-alist))
+                (- (glcp-cases-wormhole (glcp-config->run-before config) id))
+                ((er (list val-clause cov-clause obligs))
+                 (run-parametrized
+                  hyp concl vars g-bindings id obligs config state))
+                (- (glcp-cases-wormhole (glcp-config->run-after config) id)))
+             (value (cons (list* val-clause cov-clause rest) obligs)))))
+
+
+     ,'(defun clause-proc (clause hints state)
+         (b* (;; ((unless (sym-counterparts-ok (w state)))
+              ;;  (glcp-error "The installed symbolic counterparts didn't satisfy all our checks"))
+              ((list bindings param-bindings hyp param-hyp concl ?untrans-concl config) hints)
+              ((er overrides)
+               (preferred-defs-to-overrides
+                (table-alist 'preferred-defs (w state)) state))
+              (config (change-glcp-config config :overrides overrides))
+              ((er hyp)
+               (if (pseudo-termp hyp)
+                   (value hyp)
+                 (glcp-error "The hyp is not a pseudo-term.~%")))
+              (hyp-clause (cons '(not (gl-cp-hint 'hyp))
+                                (append clause (list hyp))))
+              ((er concl)
+               (if (pseudo-termp concl)
+                   (value concl)
+                 (glcp-error "The concl is not a pseudo-term.~%")))
+              (concl-clause (cons '(not (gl-cp-hint 'concl))
+                                  (append clause (list (list 'not concl))))))
+           (if param-bindings
+               ;; Case splitting.
+               (b* (((er param-hyp)
+                     (if (pseudo-termp param-hyp)
+                         (value param-hyp)
+                       (glcp-error "The param-hyp is not a pseudo-term.~%")))
+                    (full-hyp (conjoin (list param-hyp hyp)))
+                    (param-alist (param-bindings-to-alist
+                                  full-hyp param-bindings))
+                    ;; If the hyp holds, then one of the cases in the
+                    ;; param-alist holds.
+                    (params-cov-term (disjoin (strip-cars param-alist)))
+                    (params-cov-vars (collect-vars params-cov-term))
+                    (- (cw "Checking case split coverage ...~%"))
+                    ((er (list params-cov-res-clause
+                               params-cov-cov-clause obligs0))
+                     (if (glcp-config->case-split-override config)
+                         (value (list `((not (gl-cp-hint 'casesplit))
+                                        (not ,hyp)
+                                        ,params-cov-term)
+                                      '('t)
+                                      'obligs))
+                       (run-parametrized
+                        hyp params-cov-term params-cov-vars bindings
+                        "case-split coverage" 'obligs config state)))
+                    (- (cw "Case-split coverage OK~%"))
+                    ((er (cons cases-res-clauses obligs1))
+                     (run-cases
+                      param-alist concl (collect-vars concl) obligs0 config state)))
+                 (clear-memoize-table 'glcp-get-branch-merge-rules)
+                 (value (list* hyp-clause concl-clause
+                               (append cases-res-clauses
+                                       (list* params-cov-res-clause
+                                              params-cov-cov-clause
+                                              (acl2::interp-defs-alist-clauses
+                                               (flush-hons-get-hash-table-link obligs1)))))))
+             ;; No case-splitting.
+             (b* (((er (list res-clause cov-clause obligs))
+                   (run-parametrized
+                    hyp concl (collect-vars concl) bindings
+                    "main theorem" nil config state)))
+               (cw "GL symbolic simulation OK~%")
+               (clear-memoize-table 'glcp-get-branch-merge-rules)
+               (value (list* hyp-clause concl-clause
+                             res-clause cov-clause
+                             (acl2::interp-defs-alist-clauses
+                              (flush-hons-get-hash-table-link obligs))))))))))
+
 
+(defconst *glcp-fnnames*
+  (event-forms-collect-fn-names (list *glcp-interp-template*
+                                      *glcp-clause-proc-template*)))
diff -Nru acl2-6.2/books/centaur/gl/glcp-unify-defs.lisp acl2-6.3/books/centaur/gl/glcp-unify-defs.lisp
--- acl2-6.2/books/centaur/gl/glcp-unify-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/glcp-unify-defs.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,125 @@
+
+(in-package "GL")
+
+(include-book "general-objects")
+(local (include-book "general-object-thms"))
+
+(verify-guards general-concrete-obj) ;; redundant
+
+;; x is a concrete object
+(defund glcp-unify-concrete (pat x alist)
+  (declare (xargs :guard (pseudo-termp pat)))
+  (b* (((when (eq pat nil))
+        (if (eq x nil)
+            (mv t alist)
+          (mv nil nil)))
+       ((when (atom pat))
+        (let ((pair (hons-assoc-equal pat alist)))
+          (if pair
+              (if (and (general-concretep (cdr pair))
+                       (equal (general-concrete-obj (cdr pair)) x))
+                  (mv t alist)
+                (mv nil nil))
+            (mv t (cons (cons pat (g-concrete-quote x)) alist)))))
+       ((when (eq (car pat) 'quote))
+        (if (equal (cadr pat) x)
+            (mv t alist)
+          (mv nil nil)))
+       ((when (and (eq (car pat) 'cons)
+                   (int= (len pat) 3)))
+        (if (consp x)
+            (b* (((mv car-ok alist)
+                  (glcp-unify-concrete (second pat) (car x) alist))
+                 ((unless car-ok) (mv nil nil)))
+              (glcp-unify-concrete (third pat) (cdr x) alist))
+          (mv nil nil))))
+    ;; ((and (eq (car pat) 'binary-+)
+    ;;       (int= (len pat) 3))
+    ;;  (cond ((not (acl2-numberp x))
+    ;;         (mv nil nil))
+    ;;        ((quotep (second pat))
+    ;;         (let ((num (unquote (second pat))))
+    ;;           (if (acl2-numberp num)
+    ;;               (glcp-unify-concrete (third pat) (- x num) alist)
+    ;;             (mv nil nil))))
+    ;;        ((quotep (third pat))
+    ;;         (let ((num (unquote (third pat))))
+    ;;           (if (acl2-numberp num)
+    ;;               (glcp-unify-concrete (second pat) (- x num) alist)
+    ;;             (mv nil nil))))
+    ;;        (t (mv nil nil))))
+    (mv nil nil)))
+
+(defthm symbol-alistp-glcp-unify-concrete
+  (implies (and (symbol-alistp alist)
+                (pseudo-termp pat))
+           (symbol-alistp (mv-nth 1 (glcp-unify-concrete pat x alist))))
+  :hints(("Goal" :in-theory (enable glcp-unify-concrete))))
+
+(mutual-recursion
+ (defun glcp-unify-term/gobj (pat x alist)
+   (declare (xargs :guard (pseudo-termp pat)
+                   :guard-debug t))
+   (b* (((when (eq pat nil))
+         (if (eq x nil) (mv t alist) (mv nil nil)))
+        ((when (atom pat))
+         (let ((pair (hons-assoc-equal pat alist)))
+           (if pair
+               (if (equal x (cdr pair))
+                   (mv t alist)
+                 (mv nil nil))
+             (mv t (cons (cons pat x) alist)))))
+        ((when (eq (car pat) 'quote))
+         (if (and (general-concretep x)
+                  (equal (general-concrete-obj x) (cadr pat)))
+             (mv t alist)
+           (mv nil nil)))
+        ((when (atom x))
+         (glcp-unify-concrete pat x alist))
+        ((when (eq (tag x) :g-concrete))
+         (glcp-unify-concrete pat (g-concrete->obj x) alist))
+        ((when (and (eq (car pat) 'if)
+                    (eql (len pat) 4)
+                    (eq (tag x) :g-ite)))
+         (b* ((test (g-ite->test x))
+              (then (g-ite->then x))
+              (else (g-ite->else x))
+              ((mv ok alist)
+               (glcp-unify-term/gobj (second pat) test alist))
+              ((unless ok) (mv nil nil))
+              ((mv ok alist)
+               (glcp-unify-term/gobj (third pat) then alist))
+              ((unless ok) (mv nil nil)))
+           (glcp-unify-term/gobj (fourth pat) else alist)))
+        ((when (or (eq (tag x) :g-boolean)
+                   (eq (tag x) :g-number)
+                   (eq (tag x) :g-ite)
+                   (eq (tag x) :g-var)))
+         (mv nil nil))
+        ((unless (eq (tag x) :g-apply))
+         ;; cons case
+         (if (and (eq (car pat) 'cons)
+                  (int= (len pat) 3))
+             (b* (((mv ok alist) (glcp-unify-term/gobj (cadr pat) (car x) alist))
+                  ((unless ok) (mv nil nil)))
+               (glcp-unify-term/gobj (caddr pat) (cdr x) alist))
+           (mv nil nil)))
+        ;; g-apply case remains
+        ((when (equal (g-apply->fn x) (car pat)))
+         (glcp-unify-term/gobj-list (cdr pat) (g-apply->args x) alist)))
+     (mv nil nil)))
+ (defun glcp-unify-term/gobj-list (pat x alist)
+   (declare (xargs :guard (pseudo-term-listp pat)))
+   (b* (((when (atom pat))
+         (if (eq x nil) (mv t alist) (mv nil nil)))
+        ((when (atom x)) (mv nil nil))
+        ((when (g-keyword-symbolp (tag x)))
+         ;;for now at least
+         (mv nil nil))
+        ((mv ok alist)
+         (glcp-unify-term/gobj (car pat) (car x) alist))
+        ((unless ok) (mv nil nil)))
+     (glcp-unify-term/gobj-list (cdr pat) (cdr x) alist))))
+
+(in-theory (disable glcp-unify-term/gobj
+                    glcp-unify-term/gobj-list))
diff -Nru acl2-6.2/books/centaur/gl/glcp-unify-thms.lisp acl2-6.3/books/centaur/gl/glcp-unify-thms.lisp
--- acl2-6.2/books/centaur/gl/glcp-unify-thms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/glcp-unify-thms.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,474 @@
+
+(in-package "GL")
+
+(include-book "glcp-unify-defs")
+(include-book "glcp-geval-thms")
+(include-book "var-bounds")
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+(local (include-book "clause-processors/find-matching" :dir :system))
+
+(defsection glcp-generic-geval-alist
+
+  (local (in-theory (enable glcp-generic-geval-alist)))
+
+  (defthm glcp-generic-geval-alist-pairlis$
+    (equal (glcp-generic-geval-alist
+            (pairlis$ formals actuals)
+            env)
+           (pairlis$ formals
+                     (glcp-generic-geval-list actuals env)))
+    :hints(("Goal" :in-theory (enable default-cdr pairlis$ gobj-listp
+                                      glcp-generic-geval-list)
+            :expand ((glcp-generic-geval nil env))
+            :induct (pairlis$ formals actuals))))
+
+  (defthm glcp-generic-geval-alist-lookup
+    (equal (hons-assoc-equal k (glcp-generic-geval-alist al env))
+           (and (hons-assoc-equal k al)
+                (cons k (glcp-generic-geval (cdr (hons-assoc-equal k al))
+                                            env)))))
+
+  (defthm glcp-generic-geval-alist-of-acons
+    (equal (glcp-generic-geval-alist (cons (cons k v) al) env)
+           (cons (cons k (glcp-generic-geval v env))
+                 (glcp-generic-geval-alist al env)))))
+
+
+
+
+(defsection all-keys-bound
+  (defund all-keys-bound (keys alist)
+    (declare (xargs :guard t))
+    (if (atom keys)
+        t
+      (and (hons-assoc-equal (car keys) alist)
+           (all-keys-bound (cdr keys) alist))))
+
+  (local (in-theory (enable all-keys-bound)))
+
+  (defthmd all-keys-bound-member-implies
+    (implies (and (member k keys)
+                  (not (hons-assoc-equal k alist)))
+             (not (all-keys-bound keys alist))))
+
+  (defthmd all-keys-bound-subset
+    (implies (and (subsetp keys1 keys)
+                  (all-keys-bound keys alist))
+             (all-keys-bound keys1 alist))
+    :hints(("Goal" :in-theory (enable all-keys-bound-member-implies
+                                      subsetp))))
+
+  (defcong acl2::set-equiv equal (all-keys-bound keys alist) 1
+    :hints(("Goal" :in-theory (enable acl2::set-equiv)
+            :use ((:instance all-keys-bound-subset
+                   (keys1 keys) (keys acl2::keys-equiv))
+                  (:instance all-keys-bound-subset
+                   (keys1 acl2::keys-equiv) (keys keys)))
+            :do-not-induct t)))
+
+  (defthm all-keys-bound-append
+    (equal (all-keys-bound (append a b) alist)
+           (and (all-keys-bound a alist)
+                (all-keys-bound b alist))))
+
+
+  (acl2::defthm-simple-term-vars-flag
+    (defthm glcp-generic-geval-ev-of-acons-when-all-vars-bound
+      (implies (and (all-keys-bound (acl2::simple-term-vars x) a)
+                    (not (hons-assoc-equal k a))
+                    (pseudo-termp x))
+               (equal (glcp-generic-geval-ev x (cons (cons k v) a))
+                      (glcp-generic-geval-ev x a)))
+      :hints ((and stable-under-simplificationp
+                   '(:in-theory (enable glcp-generic-geval-ev-of-fncall-args))))
+      :flag acl2::simple-term-vars)
+    (defthm glcp-generic-geval-ev-lst-of-acons-when-all-vars-bound
+      (implies (and (all-keys-bound (acl2::simple-term-vars-lst x) a)
+                    (not (hons-assoc-equal k a))
+                    (pseudo-term-listp x))
+               (equal (glcp-generic-geval-ev-lst x (cons (cons k v) a))
+                      (glcp-generic-geval-ev-lst x a)))
+      :flag acl2::simple-term-vars-lst))
+
+  (defthm all-keys-bound-of-glcp-generic-geval-alist
+    (equal (all-keys-bound keys (glcp-generic-geval-alist alist env))
+           (all-keys-bound keys alist))))
+
+(defsection glcp-unify-concrete
+  (local (defthm assoc-when-nonnil-key
+           (implies key
+                    (equal (assoc key alist)
+                           (hons-assoc-equal key alist)))
+           :rule-classes ((:rewrite :backchain-limit-lst 1))))
+
+  (local (in-theory (enable glcp-unify-concrete)))
+
+  (defthm glcp-unify-concrete-preserves-assoc
+    (b* (((mv ok alist1) (glcp-unify-concrete pat x alist)))
+      (implies (and ok (hons-assoc-equal k alist))
+               (equal (hons-assoc-equal k alist1)
+                      (hons-assoc-equal k alist)))))
+
+  (defthm alistp-glcp-unify-concrete
+    (b* (((mv ok alist1) (glcp-unify-concrete pat x alist)))
+      (equal (alistp alist1)
+             (or (not ok) (alistp alist)))))
+
+
+  (defthm glcp-unify-concrete-preserves-all-keys-bound
+    (b* (((mv ok alist1) (glcp-unify-concrete pat x alist)))
+      (implies (and ok (all-keys-bound keys alist))
+               (all-keys-bound keys alist1)))
+    :hints (("goal" :induct (all-keys-bound keys alist)
+             :in-theory (enable all-keys-bound))))
+
+  (local (defthm equal-len
+           (implies (syntaxp (quotep y))
+                    (Equal (equal (len x) y)
+                           (if (zp y)
+                               (and (equal y 0) (atom x))
+                             (and (consp x)
+                                  (equal (len (cdr x)) (1- y))))))))
+
+  (defthm all-keys-bound-of-glcp-unify-concrete
+    (b* (((mv ok newalist) (glcp-unify-concrete pat x alist)))
+      (implies ok
+               (all-keys-bound (acl2::simple-term-vars pat) newalist)))
+    :hints (("goal" :induct (glcp-unify-concrete pat x alist)
+             :in-theory (enable all-keys-bound))))
+
+
+
+  (defthm glcp-unify-concrete-preserves-eval
+    (b* (((mv ok newalist) (glcp-unify-concrete pat x alist)))
+      (implies (and ok
+                    (pseudo-termp term)
+                    (all-keys-bound (acl2::simple-term-vars term) alist))
+               (equal (glcp-generic-geval-ev term (glcp-generic-geval-alist
+                                                   newalist env))
+                      (glcp-generic-geval-ev term (glcp-generic-geval-alist
+                                                   alist env))))))
+
+  (defthmd glcp-unify-concrete-correct
+    (b* (((mv ok alist)
+          (glcp-unify-concrete pat x alist)))
+      (implies (and ok
+                    (pseudo-termp pat))
+               (equal (glcp-generic-geval-ev pat
+                                             (glcp-generic-geval-alist alist
+                                                                       env))
+                      x)))
+    :hints(("Goal" :in-theory (disable general-concretep))))
+
+  (defthm gobj-depends-on-of-glcp-unify-concrete
+    (implies (not (gobj-alist-depends-on k p alist))
+             (not (gobj-alist-depends-on
+                   k p (mv-nth 1 (glcp-unify-concrete pat x alist)))))
+    :hints(("Goal" :in-theory (enable g-concrete-quote))))
+
+  (local (defthm hons-assoc-equal-to-member-alist-keys
+           (iff (hons-assoc-equal k a)
+                (member k (acl2::alist-keys a)))
+           :hints(("Goal" :in-theory (enable hons-assoc-equal
+                                             acl2::alist-keys)))))
+
+  (local (defthm associativity-of-union-equal
+           (equal (union-equal (union-equal a b) c)
+                  (union-equal a (union-equal b c)))))
+
+  ;; (defthm alist-keys-of-glcp-unify-concrete
+  ;;   (b* (((mv ok alist1) (glcp-unify-concrete pat x alist)))
+  ;;     (implies ok
+  ;;              (equal (acl2::alist-keys alist1)
+  ;;                     (union-equal (acl2::simple-term-vars pat)
+  ;;                                  (acl2::alist-keys alist)))))
+  ;;   :hints(("Goal" :in-theory (enable acl2::alist-keys))))
+  )
+
+(defsection glcp-unify-term/gobj
+  (local (in-theory (enable pseudo-termp)))
+  (local (defthm assoc-when-nonnil-key
+           (implies key
+                    (equal (assoc key alist)
+                           (hons-assoc-equal key alist)))
+           :rule-classes ((:rewrite :backchain-limit-lst 1))))
+
+
+  (local (in-theory (enable glcp-unify-term/gobj
+                            glcp-unify-term/gobj-list)))
+
+  (flag::make-flag glcp-unify-term/gobj-flg glcp-unify-term/gobj
+                   :flag-mapping ((glcp-unify-term/gobj . term)
+                                  (glcp-unify-term/gobj-list . list)))
+
+  (local (in-theory (disable glcp-unify-term/gobj
+                             glcp-unify-term/gobj-list)))
+
+
+  (defthm-glcp-unify-term/gobj-flg
+    (defthm glcp-unify-term/gobj-preserves-assoc
+      (b* (((mv ok alist1) (glcp-unify-term/gobj pat x alist)))
+        (implies (and ok (hons-assoc-equal k alist))
+                 (equal (hons-assoc-equal k alist1)
+                        (hons-assoc-equal k alist))))
+      :hints ('(:in-theory (enable all-keys-bound)
+                :expand ((:free (x) (glcp-unify-term/gobj pat x alist))
+                         (:free (x) (glcp-unify-term/gobj nil x alist)))))
+      :flag term)
+    (defthm glcp-unify-term/gobj-list-preserves-assoc
+      (b* (((mv ok alist1) (glcp-unify-term/gobj-list pat x alist)))
+        (implies (and ok (hons-assoc-equal k alist))
+                 (equal (hons-assoc-equal k alist1)
+                        (hons-assoc-equal k alist))))
+      :hints ('(:in-theory (enable all-keys-bound)
+                :expand ((:free (x) (glcp-unify-term/gobj-list pat x alist)))))
+      :flag list))
+
+  (defthm-glcp-unify-term/gobj-flg
+    (defthm glcp-unify-term/gobj-preserves-alistp
+      (b* (((mv ok alist1) (glcp-unify-term/gobj pat x alist)))
+        (equal (alistp alist1)
+               (or (not ok) (alistp alist))))
+      :hints ('(:in-theory (enable all-keys-bound)
+                :expand ((:free (x) (glcp-unify-term/gobj pat x alist))
+                         (:free (x) (glcp-unify-term/gobj nil x alist)))))
+      :flag term)
+    (defthm glcp-unify-term/gobj-list-preserves-alistp
+      (b* (((mv ok alist1) (glcp-unify-term/gobj-list pat x alist)))
+        (equal (alistp alist1)
+               (or (not ok) (alistp alist))))
+      :hints ('(:in-theory (enable all-keys-bound)
+                :expand ((:free (x) (glcp-unify-term/gobj-list pat x alist)))))
+      :flag list))
+
+  (defthm glcp-unify-term/gobj-preserves-all-keys-bound
+    (b* (((mv ok alist1) (glcp-unify-term/gobj pat x alist)))
+      (implies (and ok (all-keys-bound keys alist))
+               (all-keys-bound keys alist1)))
+    :hints (("goal" :induct (all-keys-bound keys alist)
+             :in-theory (enable all-keys-bound))))
+
+  (defthm glcp-unify-term/gobj-list-preserves-all-keys-bound
+    (b* (((mv ok alist1) (glcp-unify-term/gobj-list pat x alist)))
+      (implies (and ok (all-keys-bound keys alist))
+               (all-keys-bound keys alist1)))
+    :hints (("goal" :induct (all-keys-bound keys alist)
+             :in-theory (enable all-keys-bound))))
+
+  (local (defthm equal-len
+           (implies (syntaxp (quotep y))
+                    (Equal (equal (len x) y)
+                           (if (zp y)
+                               (and (equal y 0) (atom x))
+                             (and (consp x)
+                                  (equal (len (cdr x)) (1- y))))))))
+
+  (defthm-glcp-unify-term/gobj-flg
+    (defthm all-keys-bound-of-glcp-unify-term/gobj
+      (b* (((mv ok newalist) (glcp-unify-term/gobj pat x alist)))
+        (implies ok
+                 (all-keys-bound (acl2::simple-term-vars pat) newalist)))
+      :hints ('(:in-theory (enable all-keys-bound)
+                :expand ((:free (x) (glcp-unify-term/gobj pat x alist))
+                         (:free (x) (glcp-unify-term/gobj nil x alist)))))
+      :flag term)
+    (defthm all-keys-bound-of-glcp-unify-term/gobj-list
+      (b* (((mv ok newalist) (glcp-unify-term/gobj-list pat x alist)))
+        (implies ok
+                 (all-keys-bound (acl2::simple-term-vars-lst pat) newalist)))
+      :hints ('(:in-theory (enable all-keys-bound)
+                :expand ((:free (x) (glcp-unify-term/gobj-list pat x alist)))))
+      :flag list))
+
+
+  (defthm-glcp-unify-term/gobj-flg
+    (defthm glcp-unify-term/gobj-preserves-eval
+      (b* (((mv ok newalist) (glcp-unify-term/gobj pat x alist)))
+        (implies (and ok
+                      (pseudo-termp term)
+                      (all-keys-bound (acl2::simple-term-vars term) alist))
+                 (equal (glcp-generic-geval-ev term (glcp-generic-geval-alist
+                                                     newalist env))
+                        (glcp-generic-geval-ev term (glcp-generic-geval-alist
+                                                     alist env)))))
+      :hints ('(:expand ((:free (x) (glcp-unify-term/gobj pat x alist))
+                         (:free (x) (glcp-unify-term/gobj nil x alist)))))
+      :flag term)
+    (defthm glcp-unify-term/gobj-list-preserves-eval
+      (b* (((mv ok newalist) (glcp-unify-term/gobj-list pat x alist)))
+        (implies (and ok
+                      (pseudo-termp term)
+                      (all-keys-bound (acl2::simple-term-vars term) alist))
+                 (equal (glcp-generic-geval-ev term (glcp-generic-geval-alist
+                                                     newalist env))
+                        (glcp-generic-geval-ev term (glcp-generic-geval-alist
+                                                     alist env)))))
+      :hints ('(:expand ((:free (x) (glcp-unify-term/gobj-list pat x alist)))))
+      :flag list))
+
+  (defthm glcp-unify-term/gobj-preserves-eval-list
+    (b* (((mv ok newalist) (glcp-unify-term/gobj pat x alist)))
+      (implies (and ok
+                    (pseudo-term-listp term)
+                    (all-keys-bound (acl2::simple-term-vars-lst term) alist))
+               (equal (glcp-generic-geval-ev-lst term (glcp-generic-geval-alist
+                                                   newalist env))
+                      (glcp-generic-geval-ev-lst term (glcp-generic-geval-alist
+                                                       alist env)))))
+    :hints (("goal" :induct (len term)
+             :in-theory (e/d () (glcp-unify-term/gobj)))))
+
+  (defthm glcp-unify-term/gobj-list-preserves-eval-list
+    (b* (((mv ok newalist) (glcp-unify-term/gobj-list pat x alist)))
+      (implies (and ok
+                    (pseudo-term-listp term)
+                    (all-keys-bound (acl2::simple-term-vars-lst term) alist))
+               (equal (glcp-generic-geval-ev-lst term (glcp-generic-geval-alist
+                                                   newalist env))
+                      (glcp-generic-geval-ev-lst term (glcp-generic-geval-alist
+                                                       alist env)))))
+    :hints (("goal" :induct (len term)
+             :in-theory (e/d () (glcp-unify-term/gobj-list)))))
+
+  (local (defthm glcp-generic-geval-of-non-kw-cons
+           (implies (and (consp x)
+                         (not (equal (tag x) :g-concrete))
+                         (not (equal (tag x) :g-boolean))
+                         (not (equal (tag x) :g-number))
+                         (not (equal (tag x) :g-ite))
+                         (not (equal (tag x) :g-var))
+                         (not (equal (tag x) :g-apply)))
+                    (equal (glcp-generic-geval x env)
+                           (cons (glcp-generic-geval (car x) env)
+                                 (glcp-generic-geval (cdr x) env))))
+           :hints(("Goal" :expand ((:with glcp-generic-geval
+                                    (glcp-generic-geval x env)))))))
+
+  (local (defthm glcp-generic-geval-of-non-kw-symbolp
+           (implies (and (consp x)
+                         (not (g-keyword-symbolp (tag x))))
+                    (equal (glcp-generic-geval x env)
+                           (cons (glcp-generic-geval (car x) env)
+                                 (glcp-generic-geval (cdr x) env))))
+           :hints(("Goal" :expand ((:with glcp-generic-geval
+                                    (glcp-generic-geval x env)))))))
+
+  (local (defthm glcp-generic-geval-of-g-apply
+           (implies (and (eq (tag x) :g-apply)
+                         (not (equal (g-apply->fn x) 'quote)))
+                    (equal (glcp-generic-geval x env)
+                           (glcp-generic-geval-ev
+                            (cons (g-apply->fn x)
+                                  (kwote-lst (glcp-generic-geval-list
+                                              (g-apply->args x) env)))
+                            nil)))
+           :hints(("Goal" :expand ((:with glcp-generic-geval
+                                    (glcp-generic-geval x env)))))))
+
+  (local (defthm glcp-generic-geval-of-g-concrete
+           (implies (eq (tag x) :g-concrete)
+                    (equal (glcp-generic-geval x env)
+                           (g-concrete->obj x)))
+           :hints(("Goal" :expand ((:with glcp-generic-geval
+                                    (glcp-generic-geval x env)))
+                   :in-theory (disable glcp-generic-geval-general-concrete-obj-correct)))))
+
+  (local (in-theory (enable glcp-generic-geval-ev-of-fncall-args)))
+
+  (local (defthm pseudo-terms-of-args
+           (implies (and (pseudo-termp x)
+                         (consp x)
+                         (not (eq (car x) 'quote)))
+                    (and (pseudo-termp (cadr x))
+                         (pseudo-termp (caddr x))
+                         (pseudo-termp (cadddr x))))
+           :hints (("goal" :expand ((pseudo-termp x)
+                                    (pseudo-term-listp (cdr x))
+                                    (pseudo-term-listp (cddr x))
+                                    (pseudo-term-listp (cdddr x)))))))
+
+  (local (defthm symbolp-when-pseudo-termp
+           (implies (not (consp x))
+                    (equal (pseudo-termp x)
+                           (symbolp x)))
+           :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+  (local (defthm pseudo-term-listp-cdr-when-pseudo-termp
+           (implies (and (pseudo-termp x)
+                         (not (eq (car x) 'quote)))
+                    (pseudo-term-listp (cdr x)))))
+
+  (local (in-theory (disable pseudo-term-listp
+                             pseudo-termp
+                             acl2::cancel_times-equal-correct
+                             acl2::cancel_plus-equal-correct
+                             tag-when-atom
+                             len)))
+
+
+  (defthm-glcp-unify-term/gobj-flg
+    (defthm glcp-unify-term/gobj-correct
+      (b* (((mv ok alist)
+            (glcp-unify-term/gobj pat x alist)))
+        ;; env: boolean vars of x -> boolean values, g-vars of x -> values
+        ;; alist: variables of pat -> symbolic objects (subobjects of x)
+        (implies (and ok
+                      (pseudo-termp pat))
+                 (equal (glcp-generic-geval-ev pat
+                                               (glcp-generic-geval-alist
+                                                alist env))
+                        (glcp-generic-geval x env))))
+      :hints ('(:expand ((glcp-unify-term/gobj pat x alist)
+                         (glcp-unify-term/gobj nil x alist)))
+              (and stable-under-simplificationp
+                   (b* (((mv ok lit)
+                         (acl2::find-matching-literal-in-clause
+                          '(not (mv-nth '0 (glcp-unify-concrete pat x alist)))
+                          clause nil))
+                        ((unless ok) nil)
+                        (pat (second (third (second lit))))
+                        (x (third (third (second lit))))
+                        (alist (fourth (third (second lit)))))
+                     `(:use ((:instance glcp-unify-concrete-correct
+                              (pat ,pat) (x ,x) (alist ,alist))))))
+              (and stable-under-simplificationp
+                   '(:expand ((:with glcp-generic-geval
+                               (glcp-generic-geval x env))))))
+      :flag term)
+    (defthm glcp-unify-term/gobj-list-correct
+      (b* (((mv ok alist)
+            (glcp-unify-term/gobj-list pat x alist)))
+        (implies (and ok
+                      (pseudo-term-listp pat))
+                 (equal (glcp-generic-geval-ev-lst pat
+                                                   (glcp-generic-geval-alist alist
+                                                                             env))
+                        (glcp-generic-geval-list x env))))
+      :hints ('(:expand ((glcp-unify-term/gobj-list pat x alist)))
+              (and stable-under-simplificationp
+                   '(:expand ((pseudo-term-listp pat)))))
+      :flag list))
+
+  (local (in-theory (disable gobj-depends-on gobj-list-depends-on)))
+
+  (defthm-glcp-unify-term/gobj-flg
+    (defthm gobj-depends-on-of-glcp-unify-term/gobj
+      (implies (and (not (gobj-alist-depends-on k p alist))
+                    (not (gobj-depends-on k p x)))
+               (not (gobj-alist-depends-on
+                     k p (mv-nth 1 (glcp-unify-term/gobj pat x alist)))))
+      :hints ('(:expand ((:free (x) (glcp-unify-term/gobj pat x alist))
+                         (:free (x) (glcp-unify-term/gobj nil x alist))
+                         (gobj-depends-on k p x)
+                         (gobj-depends-on k p nil)
+                         (gobj-depends-on k p (cdr (hons-assoc-equal pat alist))))))
+      :flag term)
+    (defthm gobj-depends-on-of-glcp-unify-term/gobj-list
+      (implies (and (not (gobj-alist-depends-on k p alist))
+                    (not (gobj-list-depends-on k p x)))
+               (not (gobj-alist-depends-on
+                     k p (mv-nth 1 (glcp-unify-term/gobj-list pat x alist)))))
+      :hints ('(:expand ((:free (x) (glcp-unify-term/gobj-list pat x alist))
+                         (gobj-list-depends-on k p x)
+                         (gobj-list-depends-on k p nil))))
+      :flag list)))
diff -Nru acl2-6.2/books/centaur/gl/gobject-type-thms.lisp acl2-6.3/books/centaur/gl/gobject-type-thms.lisp
--- acl2-6.2/books/centaur/gl/gobject-type-thms.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gobject-type-thms.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,5 +1,22 @@
-
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 
diff -Nru acl2-6.2/books/centaur/gl/gobject-types.lisp acl2-6.3/books/centaur/gl/gobject-types.lisp
--- acl2-6.2/books/centaur/gl/gobject-types.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gobject-types.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,6 +1,24 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "defagg")
 (include-book "tools/pattern-match" :dir :system)
 (include-book "misc/untranslate-patterns" :dir :system)
@@ -9,7 +27,7 @@
 (defagg g-boolean (bool))
 (defagg g-number (num))
 (defagg g-ite (test then else))
-(defagg g-apply (fn args))
+(defagg g-apply (fn args) :notinline t)
 (defagg g-var (name))
 
 (defconst *g-keywords*
@@ -98,3 +116,10 @@
   :rule-classes ((:rewrite :backchain-limit-lst 0)
                  :type-prescription))
 
+(defun gl-cons (x y)
+  (declare (xargs :guard t))
+  (cons (if (g-keyword-symbolp x)
+            (g-concrete x)
+          x)
+        y))
+
diff -Nru acl2-6.2/books/centaur/gl/gobjectp-thms.lisp acl2-6.3/books/centaur/gl/gobjectp-thms.lisp
--- acl2-6.2/books/centaur/gl/gobjectp-thms.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gobjectp-thms.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,4 +1,22 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 
diff -Nru acl2-6.2/books/centaur/gl/gobjectp.lisp acl2-6.3/books/centaur/gl/gobjectp.lisp
--- acl2-6.2/books/centaur/gl/gobjectp.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gobjectp.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,21 +1,33 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
 (include-book "bfr")
 (include-book "defagg")
 (include-book "tools/pattern-match" :dir :system)
-
 (include-book "bvecs")
-
-;;(in-theory (disable cutil::tag-forward-to-consp))
-
 (include-book "gobject-types")
+;;(in-theory (disable cutil::tag-forward-to-consp))
 
 ;; Mostly obsolete.  Some general utility stuff at the bottom.
 
-
 ;; ;; Recognizer for a well-formed cdr of a g-number.
 ;; (defun wf-g-numberp (x)
 ;;   (declare (xargs :guard t))
diff -Nru acl2-6.2/books/centaur/gl/gtests.lisp acl2-6.3/books/centaur/gl/gtests.lisp
--- acl2-6.2/books/centaur/gl/gtests.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gtests.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,15 +1,30 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-(set-inhibit-warnings "theory")
-
 (include-book "hyp-fix")
 (include-book "gtypes")
+(include-book "tools/mv-nth" :dir :system)
 (local (include-book "gtype-thms"))
 (local (include-book "hyp-fix-logic"))
-
-(include-book "tools/mv-nth" :dir :system)
+(set-inhibit-warnings "theory")
 
 (defun mk-g-bdd-ite (bdd then else hyp)
   (declare (xargs :guard t))
@@ -31,6 +46,13 @@
                                     false-under-hyp))
          (bfr-reasoning)))
 
+(defthm gobj-depends-on-of-mk-g-bdd-ite
+  (implies (and (not (pbfr-depends-on k p bdd))
+                (not (gobj-depends-on k p then))
+                (not (gobj-depends-on k p else)))
+           (not (gobj-depends-on k p (mk-g-bdd-ite bdd then else hyp))))
+  :hints(("Goal" :in-theory (enable mk-g-bdd-ite))))
+
 (in-theory (disable mk-g-bdd-ite))
 
 
@@ -58,14 +80,14 @@
        (b* (((mv cc uc oc)
              (gobj-nonnil-unknown-obj test hyp))
             (cc-t (th cc))
-            (cc-nil (fh cc)))
+            (cc-nil (fh cc))
+            (uc-nil (fh uc)))
          (cond
-          ((and (fh uc) cc-t)
+          ((and uc-nil cc-t)
            (gobj-nonnil-unknown-obj then hyp))
-          ((and (fh uc) cc-nil)
+          ((and uc-nil cc-nil)
            (gobj-nonnil-unknown-obj else hyp))
           (t (b* ((uc-t (th uc))
-                  (uc-nil (fh uc))
                   (hyp1 (bfr-or cc uc))
                   ((mv c1 u1 o1) (gobj-nonnil-unknown-obj then hyp1))
                   (hyp0 (bfr-or (hf (bfr-not cc)) uc))
@@ -153,7 +175,7 @@
 
 
 
-   (local 
+   (local
     (in-theory (disable (:definition generic-geval)
                         bfr-eval bfr-eval-list
                         components-to-number-alt-def
@@ -238,7 +260,21 @@
                     :do-not '(generalize
                               fertilize
                               eliminate-destructors))))
-     :rule-classes nil)))
+     :rule-classes nil)
+
+   (defthm gobj-depends-on-of-gobj-nonnil-unknown-obj
+     (implies (not (gobj-depends-on k p x))
+              (mv-let (cc uc uo)
+                (gobj-nonnil-unknown-obj x hyp)
+                (and (not (pbfr-depends-on k p cc))
+                     (not (pbfr-depends-on k p uc))
+                     (not (gobj-depends-on k p uo)))))
+     :hints (("goal" :induct (gnuo-ind x hyp)
+              :in-theory (disable hyp-fix))
+             (and stable-under-simplificationp
+                  '(:expand ((gobj-nonnil-unknown-obj x hyp)
+                             (gobj-nonnil-unknown-obj nil hyp)
+                             (gobj-depends-on k p x))))))))
 
 
 
@@ -292,10 +328,14 @@
   :hints (("goal" :use
            ((:instance gobj-nonnil-unknown-obj-correct)))))
 
-(in-theory (disable gtests gtestsp gtests-unknown gtests-obj gtests-nonnil))
-
+(defthm gobj-depends-on-of-gtests
+  (implies (not (gobj-depends-on k p x))
+           (and (not (pbfr-depends-on k p (gtests-nonnil (gtests x hyp))))
+                (not (pbfr-depends-on k p (gtests-unknown (gtests x hyp))))
+                (not (gobj-depends-on k p (gtests-obj (gtests x hyp)))))))
 
 
 
+(in-theory (disable gtests gtestsp gtests-unknown gtests-obj gtests-nonnil))
 
 
diff -Nru acl2-6.2/books/centaur/gl/gtype-thms.lisp acl2-6.3/books/centaur/gl/gtype-thms.lisp
--- acl2-6.2/books/centaur/gl/gtype-thms.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gtype-thms.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 
@@ -19,7 +38,7 @@
          (not (g-var-p x))
          (list (concrete-gobjectp-ind (car x))
                (concrete-gobjectp-ind (cdr x))))))
-    
+
 
 (defthm gobject-hierarchy-lite-possibilities
   (or (equal (gobject-hierarchy-lite x) nil)
@@ -63,10 +82,16 @@
                    concrete-gobjectp-def
                    acl2::cons-car-cdr)))))
 
-(in-theory (disable concrete-gobjectp-def))
+(defthmd gobj-depends-on-when-concrete-gobjectp
+  (implies (concrete-gobjectp x)
+           (not (gobj-depends-on k p x)))
+  :hints (("goal" :induct (concrete-gobjectp-ind x)
+           :expand ((gobj-depends-on k p x)))))
 
+(in-theory (disable concrete-gobjectp-def))
 
 
+(local (in-theory (enable generic-geval)))
 
 (defthm mk-g-concrete-correct
   (equal (generic-geval (mk-g-concrete x) b)
@@ -84,6 +109,15 @@
                   g-concrete-quote))))
 
 
+(defthm gobj-depends-on-of-mk-g-concrete
+  (not (gobj-depends-on k p (mk-g-concrete x)))
+  :hints(("Goal" :in-theory (enable gobj-depends-on mk-g-concrete
+                                    gobj-depends-on-when-concrete-gobjectp))))
+
+(defthm gobj-depends-on-of-g-concrete-quote
+  (not (gobj-depends-on k p (g-concrete-quote x)))
+  :hints(("Goal" :in-theory (enable gobj-depends-on g-concrete-quote))))
+
 
 (defthm mk-g-ite-correct
   (equal (generic-geval (mk-g-ite c x y) b)
@@ -96,12 +130,24 @@
               '(:expand ((generic-geval c b)))))
   :otf-flg t)
 
+(defthm gobj-depends-on-of-mk-g-ite-rw
+  (implies (and (not (gobj-depends-on k p c))
+                (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y)))
+           (not (gobj-depends-on k p (mk-g-ite c x y))))
+  :hints(("Goal" :in-theory (enable mk-g-ite))))
+
 
 (defthm mk-g-boolean-correct
   (equal (generic-geval (mk-g-boolean x) env)
          (bfr-eval x (car env)))
   :hints(("Goal" :in-theory (enable mk-g-boolean))))
 
+(defthm gobj-depends-on-of-mk-g-boolean
+  (equal (gobj-depends-on k p (mk-g-boolean x))
+         (pbfr-depends-on k p x))
+  :hints(("Goal" :in-theory (enable mk-g-boolean booleanp))))
+
 
 
 ;; (defthm car-mk-g-number
@@ -109,10 +155,10 @@
 ;;            (eq (car (mk-g-number a b c d e f)) :g-number)))
 
 
-(defthm nonzero-natp-implies-us
-  (implies (and (natp x) (not (eql x 0)))
-           (n2v x))
-  :hints(("Goal" :in-theory (enable n2v))))
+;; (defthm nonzero-natp-implies-us
+;;   (implies (and (natp x) (not (eql x 0)))
+;;            (n2v x))
+;;   :hints(("Goal" :in-theory (e/d (n2v bfr-ucons) (logcar logcdr)))))
 
 (encapsulate nil
   (local (include-book "arithmetic/top-with-meta" :dir :system))
@@ -135,7 +181,7 @@
     (implies (syntaxp (not (equal rnum ''0)))
              (equal (components-to-number rnum 0    inum iden)
                     (components-to-number 0    1    inum iden))))
-  
+
   (defthm components-to-number-alt-def
     (equal (components-to-number rnum rden inum iden)
            (complex (* rnum (/ rden))
@@ -170,19 +216,19 @@
 ;;   (equal (generic-geval (gobj-fix x) env)
 ;;          (generic-geval x env))
 ;;   :hints(("Goal" :in-theory (enable gobj-fix))))
-                         
+
 
 
 (encapsulate nil
   (local (include-book "arithmetic/top-with-meta" :dir :system))
-  (local (in-theory 
+  (local (in-theory
           (e/d*
            (boolean-list-bfr-eval-list)
            (generic-geval mk-g-number
 ; (components-to-number)
                           components-to-number
                           components-to-number-alt-def
-                          bfr-eval bfr-eval-list natp v2n
+                          bfr-eval bfr-eval-list natp
                           n2v i2v default-car default-cdr
                           (:rules-of-class :type-prescription :here)
                           acl2::cancel_times-equal-correct
@@ -195,18 +241,43 @@
            (equal (len (cons x y))
                   (+ 1 (len y)))
            :hints(("Goal" :in-theory (enable len)))))
+
+  (local (defthm boolean-listp-scdr
+           (implies (boolean-listp x)
+                    (boolean-listp (scdr x)))
+           :hints(("Goal" :in-theory (enable scdr)))))
+
+  (local (defthm bfr-list->s-of-boolean-list-norm
+           (implies (and (syntaxp (not (equal env ''nil)))
+                         (boolean-listp x))
+                    (equal (bfr-list->s x env)
+                           (bfr-list->s x nil)))))
+
+  (local (defthm bfr-list->u-of-boolean-list-norm
+           (implies (and (syntaxp (not (equal env ''nil)))
+                         (boolean-listp x))
+                    (equal (bfr-list->u x env)
+                           (bfr-list->u x nil)))))
+
+  ;; (local (defthm bfr-list->u-of-list-fix
+  ;;          (equal (bfr-list->u (acl2::list-fix x) env)
+  ;;                 (bfr-list->u x env))))
+
+  ;; (local (defthm bfr-list->s-of-list-fix
+  ;;          (equal (bfr-list->s (acl2::list-fix x) env)
+  ;;                 (bfr-list->s x env))))
+
   (defthm mk-g-number-correct
-    (flet ((to-nat (n env) (if (natp n) n (v2n (bfr-eval-list n (car env)))))
-           (to-int (n env) (if (integerp n) n (v2i (bfr-eval-list n (car
-                                                                     env))))))
+    (flet ((to-nat (n env) (if (natp n) n (bfr-list->u n (car env))))
+           (to-int (n env) (if (integerp n) n (bfr-list->s n (car env)))))
       (equal (generic-geval (mk-g-number rnum rden inum iden) env)
              (components-to-number (to-int rnum env)
                                    (to-nat rden env)
                                    (to-int inum env)
                                    (to-nat iden env))))
     :hints (("Goal" :do-not preprocess)
-            '(:cases ((and (integerp rnum) (natp rden)
-                           (integerp inum) (natp iden))))
+            ;; '(:cases ((and (integerp rnum) (natp rden)
+            ;;                (integerp inum) (natp iden))))
             '(:expand ((:free (a c d f)
                               (mk-g-number a c d f))))
             '(:expand ((:free (a b)
@@ -216,7 +287,51 @@
                               (generic-geval
                                (g-number x) env))))
             (and stable-under-simplificationp
-                 '(:in-theory (e/d (components-to-number-alt-def natp)))))))
+                 '(:in-theory (e/d (components-to-number-alt-def natp))))))
+
+  (defthm pbfr-depends-on-list-of-boolean-listp
+    (implies (and (syntaxp (quotep lst))
+                  (boolean-listp lst))
+             (not (pbfr-list-depends-on k p lst)))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on))))
+
+  (local (defthm gobj-depends-on-of-g-number
+           (equal (gobj-depends-on k p (g-number n))
+                  (or (pbfr-list-depends-on k p (car n))
+                      (pbfr-list-depends-on k p (cadr n))
+                      (pbfr-list-depends-on k p (caddr n))
+                      (pbfr-list-depends-on k p (cadddr n))))
+           :hints(("Goal" :in-theory (e/d (break-g-number
+                                           default-car default-cdr)
+                                          ((pbfr-list-depends-on)))))))
+
+  (local (in-theory (disable gobj-depends-on
+                             sets::double-containment
+                             default-<-1
+                             default-<-2)))
+
+  (defthm gobj-depends-on-of-mk-g-number
+    (implies (and (or (integerp rnum)
+                      (not (pbfr-list-depends-on k p rnum)))
+                  (or (natp rden)
+                      (not (pbfr-list-depends-on k p rden)))
+                  (or (integerp inum)
+                      (not (pbfr-list-depends-on k p inum)))
+                  (or (natp iden)
+                      (not (pbfr-list-depends-on k p iden))))
+             (not (gobj-depends-on k p (mk-g-number-fn rnum rden inum iden))))
+    :hints(("Goal" :in-theory (e/d (mk-g-number-fn
+                                    (:t components-to-number-fn))
+                                   ((pbfr-list-depends-on) max
+                                    gobj-depends-on
+                                    bfr-list->s
+                                    bfr-list->u
+                                    norm-bvec-s
+                                    norm-bvec-u))
+            :expand ((:free (a b c d)
+                      (gobj-depends-on k p
+                       (components-to-number-fn a b c d)))
+                     (mk-g-number-fn rnum rden inum iden))))))
 
 
 
@@ -260,6 +375,12 @@
            :do-not-induct t))
   :rule-classes ((:rewrite :backchain-limit-lst 0)))
 
+(defthm g-keyword-symbolp-compound-recognizer
+  (implies (g-keyword-symbolp x)
+           (and (symbolp x)
+                (not (booleanp x))))
+  :rule-classes :compound-recognizer)
+
 ;; (defthm gobjectp-gl-cons
 ;;   (gobjectp (gl-cons x y)))
 
@@ -268,6 +389,31 @@
          (cons (generic-geval x env)
                (generic-geval y env))))
 
+(defthm gobj-depends-on-of-gl-cons
+  (equal (gobj-depends-on k p (gl-cons x y))
+         (or (gobj-depends-on k p x)
+             (gobj-depends-on k p y)))
+  :hints(("Goal" :in-theory (enable gl-cons)
+          :expand ((gobj-depends-on k p (cons x y))))))
+
+(defthm generic-geval-list-gl-cons
+  (equal (generic-geval-list (gl-cons x y) env)
+         (cons (generic-geval x env)
+               (generic-geval-list y env)))
+  :hints(("Goal" :expand ((:free (x) (generic-geval-list (cons x y) env))))))
+
+(defthm gobj-list-depends-on-of-gl-cons
+  (equal (gobj-list-depends-on k p (gl-cons x y))
+         (or (gobj-depends-on k p x)
+             (gobj-list-depends-on k p y)))
+  :hints(("Goal" :in-theory (enable gl-cons))))
+
+(defthm generic-geval-list-atom
+  (implies (not (consp x))
+           (equal (generic-geval-list x env) nil))
+  :hints(("Goal" :expand ((generic-geval-list x env))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
 (in-theory (disable gl-cons))
 
 (defthmd generic-geval-of-gobj-list
@@ -302,21 +448,190 @@
 
 
 (defthm generic-geval-g-apply
-  (equal (generic-geval (g-apply fn args) env)
-         (generic-geval-ev (cons fn (kwote-lst (generic-geval args env)))
-                           nil))
+  (implies (not (equal fn 'quote))
+           (equal (generic-geval (g-apply fn args) env)
+                  (generic-geval-ev (cons fn (kwote-lst (generic-geval-list args env)))
+                                    nil)))
   :hints (("goal" :expand ((generic-geval (g-apply fn args) env))
            :in-theory (enable generic-geval-apply))))
 
 (defthmd generic-geval-g-apply-p
-  (implies (g-apply-p x)
+  (implies (and (g-apply-p x)
+                (not (equal (g-apply->fn x) 'quote)))
            (equal (generic-geval x env)
                   (generic-geval-ev
                    (cons (g-apply->fn x)
-                         (kwote-lst (generic-geval (g-apply->args x) env)))
+                         (kwote-lst (generic-geval-list (g-apply->args x) env)))
                    nil)))
   :hints (("goal" :expand ((generic-geval x env))
            :in-theory (enable generic-geval-apply)))
   :rule-classes ((:rewrite :backchain-limit-lst 0)))
 
 
+
+
+
+(defsection gobj-depends-on
+
+  (local (in-theory (enable gobj-depends-on)))
+
+  (defthm gobj-list-depends-on-of-g-apply->args
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-apply))
+             (not (gobj-list-depends-on k p (g-apply->args x)))))
+
+  (defthm gobj-depends-on-of-g-ite->test
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-ite))
+             (not (gobj-depends-on k p (g-ite->test x)))))
+
+  (defthm gobj-depends-on-of-g-ite->then
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-ite))
+             (not (gobj-depends-on k p (g-ite->then x)))))
+
+  (defthm gobj-depends-on-of-g-ite->else
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-ite))
+             (not (gobj-depends-on k p (g-ite->else x)))))
+
+  (defthm gobj-depends-on-car-of-gobj-list
+    (implies (not (gobj-list-depends-on k p x))
+             (not (gobj-depends-on k p (car x)))))
+
+  (defthm gobj-list-depends-on-cdr-of-gobj-list
+    (implies (not (gobj-list-depends-on k p x))
+             (not (gobj-list-depends-on k p (cdr x)))))
+
+  (defthm gobj-list-depends-on-of-cons
+    (equal (gobj-list-depends-on k p (cons a b))
+           (not (and (not (gobj-depends-on k p a))
+                     (not (gobj-list-depends-on k p b))))))
+
+  (defthm gobj-list-depends-on-of-atom
+    (implies (not (consp x))
+             (equal (gobj-list-depends-on k p x) nil))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gobj-depends-on-car-of-gobj
+    (implies (and (not (gobj-depends-on k p x))
+                  (NOT (EQUAL (TAG X) :G-CONCRETE))
+                  (NOT (EQUAL (TAG X) :G-BOOLEAN))
+                  (NOT (EQUAL (TAG X) :G-NUMBER))
+                  (NOT (EQUAL (TAG X) :G-ITE))
+                  (NOT (EQUAL (TAG X) :G-VAR))
+                  (NOT (EQUAL (TAG X) :G-APPLY)))
+             (not (gobj-depends-on k p (car x)))))
+
+  (defthm gobj-depends-on-cdr-of-gobj
+    (implies (and (not (gobj-depends-on k p x))
+                  (NOT (EQUAL (TAG X) :G-CONCRETE))
+                  (NOT (EQUAL (TAG X) :G-BOOLEAN))
+                  (NOT (EQUAL (TAG X) :G-NUMBER))
+                  (NOT (EQUAL (TAG X) :G-ITE))
+                  (NOT (EQUAL (TAG X) :G-VAR))
+                  (NOT (EQUAL (TAG X) :G-APPLY)))
+             (not (gobj-depends-on k p (cdr x)))))
+
+  (defthm gobj-depends-on-of-g-boolean->bool
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-boolean))
+             (not (pbfr-depends-on k p (g-boolean->bool x)))))
+
+  (defthm gobj-depends-on-of-g-number->num-0
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-number))
+             (not (pbfr-list-depends-on k p (mv-nth 0 (break-g-number (g-number->num x)))))))
+
+  (defthm gobj-depends-on-of-g-number->num-1
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-number))
+             (not (pbfr-list-depends-on k p (mv-nth 1 (break-g-number (g-number->num x)))))))
+
+  (defthm gobj-depends-on-of-g-number->num-2
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-number))
+             (not (pbfr-list-depends-on k p (mv-nth 2 (break-g-number (g-number->num x)))))))
+
+  (defthm gobj-depends-on-of-g-number->num-3
+    (implies (and (not (gobj-depends-on k p x))
+                  (eq (tag x) :g-number))
+             (not (pbfr-list-depends-on k p (mv-nth 3 (break-g-number
+                                                       (g-number->num x)))))))
+
+  (defthm-gobj-flag
+    (defthm generic-geval-of-set-var-when-gobj-depends-on
+      (implies (and (not (gobj-depends-on k p x))
+                    (bfr-eval p env)
+                    (bfr-eval p (bfr-set-var k v env)))
+               (equal (generic-geval x (cons (bfr-param-env p (bfr-set-var k v env))
+                                             var-env))
+                      (generic-geval x (cons (bfr-param-env p env)
+                                             var-env))))
+      :hints ('(:expand ((:free (env) (:with generic-geval (generic-geval x env))))))
+      :flag gobj)
+    (defthm generic-geval-list-of-set-var-when-gobj-depends-on
+      (implies (and (not (gobj-list-depends-on k p x))
+                    (bfr-eval p env)
+                    (bfr-eval p (bfr-set-var k v env)))
+               (equal (generic-geval-list x (cons (bfr-param-env p (bfr-set-var k v env))
+                                                  var-env))
+                      (generic-geval-list x (cons (bfr-param-env p env)
+                                                  var-env))))
+      :hints ('(:expand ((:free (env) (generic-geval-list x env)))))
+      :flag list))
+
+  (defthm gobj-depends-on-of-atom
+    (implies (not (consp x))
+             (not (gobj-depends-on k p x)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gobj-depends-on-of-cons
+    (implies (not (g-keyword-symbolp x))
+             (equal (gobj-depends-on k p (cons x y))
+                    (not (and (not (gobj-depends-on k p x))
+                              (not (gobj-depends-on k p y))))))
+    :hints(("Goal" :in-theory (enable g-keyword-symbolp))))
+
+
+
+  (defthm gobj-depends-on-of-g-apply
+    (equal (gobj-depends-on k p (g-apply fn args))
+           (gobj-list-depends-on k p args)))
+
+  (defthm gobj-depends-on-of-g-ite
+    (equal (gobj-depends-on k p (g-ite test then else))
+           (not (and (not (gobj-depends-on k p test))
+                     (not (gobj-depends-on k p then))
+                     (not (gobj-depends-on k p else))))))
+
+  (defthm gobj-depends-on-of-g-number
+    (equal (gobj-depends-on k p (g-number num))
+           (not (b* (((mv rn rd in id) (break-g-number num)))
+                  (and (not (pbfr-list-depends-on k p rn))
+                       (not (pbfr-list-depends-on k p rd))
+                       (not (pbfr-list-depends-on k p in))
+                       (not (pbfr-list-depends-on k p id)))))))
+
+  (defthm gobj-depends-on-of-g-boolean
+    (equal (gobj-depends-on k p (g-boolean bool))
+           (pbfr-depends-on k p bool)))
+
+  (defthm gobj-depends-on-of-g-concrete
+    (equal (gobj-depends-on k p (g-concrete val)) nil))
+
+  (defthm gobj-depends-on-of-g-var
+    (equal (gobj-depends-on k p (g-var val)) nil))
+
+
+  (defthm gobj-depends-on-when-g-concrete
+    (implies (equal (tag x) :g-concrete)
+             (equal (gobj-depends-on k p x) nil))
+    :hints (("goal" :expand ((not (gobj-depends-on k p x)))))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gobj-depends-on-when-g-var
+    (implies (equal (tag x) :g-var)
+             (equal (gobj-depends-on k p x) nil))
+    :hints (("goal" :expand ((gobj-depends-on k p x))))
+    :rule-classes ((:rewrite :backchain-limit-lst 0))))
diff -Nru acl2-6.2/books/centaur/gl/gtypes.lisp acl2-6.3/books/centaur/gl/gtypes.lisp
--- acl2-6.2/books/centaur/gl/gtypes.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/gtypes.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
 
@@ -273,24 +292,41 @@
 ;; Number
 ;; -------------------------
 
+(defun norm-bvec-s (v)
+  (declare (xargs :guard T))
+  (if (boolean-listp v)
+      (bfr-list->s v nil)
+    v))
+
+(defun norm-bvec-u (v)
+  (declare (xargs :guard t))
+  (if (boolean-listp v)
+      (bfr-list->u v nil)
+    v))
+
+
 (defun mk-g-number-fn (rnum rden inum iden)
   (declare (xargs :guard t))
-  (if (and (integerp rnum) (natp rden)
-           (integerp inum) (natp iden))
-      (components-to-number rnum rden inum iden)
-    (flet ((to-uvec (n)
-                   (if (natp n)
-                       (n2v n)
-                     n))
-           (to-svec (n)
-                    (if (integerp n)
-                        (i2v n)
-                      n)))
-      (let* ((rst (and (not (or (eql iden 1) (equal iden '(t)))) (list (to-uvec iden))))
-             (rst (and (not (or (eql inum 0) (equal inum '(nil)))) (cons (to-svec inum) rst)))
-             (rst (and (or rst (not (or (eql rden 1) (equal rden '(t))))) (cons (to-uvec rden) rst))))
-        (g-number (cons (to-svec rnum) rst))))))
-            
+  (b* ((rnum-norm (norm-bvec-s rnum))
+       (rden-norm (norm-bvec-u rden))
+       (inum-norm (norm-bvec-s inum))
+       (iden-norm (norm-bvec-u iden)))
+    (if (and (integerp rnum-norm) (natp rden-norm)
+             (integerp inum-norm) (natp iden-norm))
+        (components-to-number rnum-norm rden-norm inum-norm iden-norm)
+      (flet ((to-uvec (n)
+                      (if (natp n)
+                          (n2v n)
+                        n))
+             (to-svec (n)
+                      (if (integerp n)
+                          (i2v n)
+                        n)))
+        (let* ((rst (and (not (or (eql iden 1) (equal iden '(t)))) (list (to-uvec iden))))
+               (rst (and (not (or (eql inum 0) (equal inum '(nil)))) (cons (to-svec inum) rst)))
+               (rst (and (or rst (not (or (eql rden 1) (equal rden '(t))))) (cons (to-uvec rden) rst))))
+          (g-number (cons (to-svec rnum) rst)))))))
+
 
 (defmacro mk-g-number (rnum &optional
                               (rden '1)
@@ -313,13 +349,6 @@
 ;; the case, that is, if the first is a g-keyword-symbol it wraps it in a g-concrete.
 
 
-(defun gl-cons (x y)
-  (declare (xargs :guard t))
-  (cons (if (g-keyword-symbolp x)
-            (g-concrete x)
-          x)
-        y))
-
 (defun gl-list-macro (lst)
   (if (atom lst)
       nil
@@ -345,3 +374,32 @@
     (implies (gobj-listp x)
              (gobj-listp (gl-cons k x)))
     :hints(("Goal" :in-theory (enable gl-cons tag)))))
+
+
+(mutual-recursion
+ (defun gobj-depends-on (k p x)
+   (if (atom x)
+       nil
+     (pattern-match x
+       ((g-boolean b) (pbfr-depends-on k p b))
+       ((g-number n)
+        (b* (((mv rn rd in id) (break-g-number n)))
+          (or (pbfr-list-depends-on k p rn)
+              (pbfr-list-depends-on k p rd)
+              (pbfr-list-depends-on k p in)
+              (pbfr-list-depends-on k p id))))
+       ((g-ite test then else)
+        (or (gobj-depends-on k p test)
+            (gobj-depends-on k p then)
+            (gobj-depends-on k p else)))
+       ((g-concrete &) nil)
+       ((g-var &) nil)
+       ((g-apply & args) (gobj-list-depends-on k p args))
+       (& (or (gobj-depends-on k p (car x))
+              (gobj-depends-on k p (cdr x)))))))
+ (defun gobj-list-depends-on (k p x)
+   (if (atom x)
+       nil
+     (or (gobj-depends-on k p (car x))
+         (gobj-list-depends-on k p (cdr x))))))
+
diff -Nru acl2-6.2/books/centaur/gl/hyp-fix-logic.lisp acl2-6.3/books/centaur/gl/hyp-fix-logic.lisp
--- acl2-6.2/books/centaur/gl/hyp-fix-logic.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/hyp-fix-logic.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,10 +1,25 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
 (include-book "hyp-fix")
-
 (local (in-theory (disable (force))))
 
 ;; The interface for these three functions is summed up by the theorem below.
@@ -32,7 +47,10 @@
   (defthm hyp-fix-correct
     (implies (bfr-eval hyp env)
              (equal (bfr-eval (hyp-fix x hyp) env)
-                    (bfr-eval x env))))
+                    (bfr-eval x env)))
+    :hints ((and stable-under-simplificationp
+                 (member-equal '(not (bfr-mode)) clause)
+                 '(:in-theory (enable bfr-eval)))))
 
 
   (defthmd hyp-ops-correct
@@ -55,7 +73,10 @@
            (equal (hyp-fix x hyp)
                   x)))
 
-
+(defthm pbfr-depends-on-of-hyp-fix
+  (implies (not (pbfr-depends-on k p x))
+           (not (pbfr-depends-on k p (hyp-fix x hyp))))
+  :hints(("Goal" :in-theory (enable hyp-fix))))
 
 
 ;; (local (bfr-reasoning-mode t))
diff -Nru acl2-6.2/books/centaur/gl/hyp-fix.lisp acl2-6.3/books/centaur/gl/hyp-fix.lisp
--- acl2-6.2/books/centaur/gl/hyp-fix.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/hyp-fix.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,16 +1,124 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "bfr")
+(local (include-book "centaur/aig/aig-vars" :dir :system))
+;; determines whether x, a non-negated aig, is trivially necessarily true or
+;; false assuming hyp.  Just traverses the top-level ANDs of hyp.  Returns (mv
+;; known val).
+(defund aig-under-hyp1 (x hyp)
+  (declare (xargs :guard t))
+  (b* (((when (hqual hyp x)) (mv t t))
+       ((when (atom hyp))    (mv nil nil))
+       ((when (eq (cdr hyp) nil))
+        (mv (hqual (car hyp) x) nil))
+       ((mv known1 val1) (aig-under-hyp1 x (car hyp)))
+       ((when known1) (mv known1 val1)))
+    (aig-under-hyp1 x (cdr hyp))))
+
+(defthm aig-under-hyp1-correct
+  (b* (((mv known val) (aig-under-hyp1 x hyp)))
+    (implies (and known
+                  (acl2::aig-eval hyp env))
+             (equal (acl2::aig-eval x env) val)))
+  :hints (("Goal" :induct (aig-under-hyp1 x hyp)
+           :in-theory (e/d ((:i aig-under-hyp1))
+                           ((:d aig-under-hyp1) acl2::aig-eval))
+           :expand ((aig-under-hyp1 x hyp)
+                    (aig-under-hyp1 hyp hyp)))
+          (and stable-under-simplificationp
+               '(:expand ((acl2::aig-eval hyp env))))))
+
+(defthm booleanp-of-aig-under-hyp1-val
+  (booleanp (mv-nth 1 (aig-under-hyp1 x hyp)))
+  :hints(("Goal" :in-theory (enable aig-under-hyp1)))
+  :rule-classes :type-prescription)
+
+(defund aig-under-hyp (x hyp)
+  (declare (xargs :guard t))
+  (cond ((booleanp x) x)
+        ((atom x) (mv-let (known val)
+                    (aig-under-hyp1 x hyp)
+                    (if known val x)))
+        ((eq (cdr x) nil)
+         (b* (((mv known val) (aig-under-hyp1 (car x) hyp)))
+           (if known (not val) x)))
+        (t (b* ((x1 (aig-under-hyp (car x) hyp)))
+             (and x1
+                  (acl2::aig-and x1 (aig-under-hyp (cdr x) hyp)))))))
+
+(defthm aig-under-hyp-correct
+  (b* ((xx (aig-under-hyp x hyp)))
+    (implies (acl2::aig-eval hyp env)
+             (equal (acl2::aig-eval xx env)
+                    (acl2::aig-eval x env))))
+  :hints(("Goal" :in-theory (enable aig-under-hyp))))
+
+(defthm aig-under-hyp-of-booleans
+  (implies (booleanp x)
+           (equal (aig-under-hyp x hyp)
+                  x))
+  :hints(("Goal" :in-theory (enable aig-under-hyp)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm aig-under-hyp-idempotent
+  (equal (aig-under-hyp (aig-under-hyp x hyp) hyp)
+         (aig-under-hyp x hyp))
+  :hints(("Goal" :in-theory (enable aig-under-hyp
+                                    acl2::aig-and))))
+
+
+(defthm aig-under-hyp-bfr-depends-on
+  (implies (and (bfr-mode)
+                (not (bfr-depends-on k x)))
+           (not (bfr-depends-on k (aig-under-hyp x hyp))))
+  :hints(("Goal" :in-theory (e/d (aig-under-hyp
+                                  bfr-depends-on)
+                                 (sets::subset sets::in sets::union)))))
+
+(defthm aig-under-hyp-pbfr-depends-on
+  (implies (and (bfr-mode)
+                (not (pbfr-depends-on k p x)))
+           (not (pbfr-depends-on k p (aig-under-hyp x hyp))))
+  :hints(("Goal" :in-theory (e/d (pbfr-depends-on bfr-from-param-space))
+          :do-not-induct t))
+  :otf-flg t)
+
+;; (defthm booleanp-of-aig-under-hyp-val
+;;   (booleanp (mv-nth 1 (aig-under-hyp x hyp)))
+;;   :hints(("Goal" :in-theory (enable aig-under-hyp)))
+;;   :rule-classes :type-prescription)
+
+
 
 (defun hyp-fix (x hyp)
   (declare (xargs :guard t))
-  (let ((and (bfr-and x hyp)))
-    (if and
-        (if (hqual and hyp)
-            t
-          x)
-      nil)))
+  (bfr-case
+   :bdd (let ((and (bfr-and x hyp)))
+          (if and
+              (if (hqual and hyp)
+                  t
+                x)
+            nil))
+   :aig (aig-under-hyp x hyp)))
 
 ;; (prove-congruences (bfr-equiv bfr-equiv) hyp-fix)
 
diff -Nru acl2-6.2/books/centaur/gl/ite-merge.lisp acl2-6.3/books/centaur/gl/ite-merge.lisp
--- acl2-6.2/books/centaur/gl/ite-merge.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/ite-merge.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,19 +1,33 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "general-objects")
-
-(local (include-book "general-object-thms"))
-
-(local (include-book "hyp-fix-logic"))
-
 (include-book "bvec-ite")
 (include-book "hyp-fix")
+(include-book "split-args")
 (include-book "std/misc/two-nats-measure" :dir :system)
-
 (include-book "tools/mv-nth" :dir :system)
 (local (include-book "misc/invariants" :dir :system))
-
+(local (include-book "general-object-thms"))
+(local (include-book "hyp-fix-logic"))
 
 (verify-guards
  general-concrete-obj
@@ -31,20 +45,20 @@
         (general-number-components x))
        ((mv yrn yrd yin yid)
         (general-number-components y)))
-    (flet ((ubv-ite (c a b)
-                    (let ((res (bfr-ite-bvv-fn c a b)))
-                      (if (boolean-listp res)
-                          (v2n res)
-                        res)))
-           (sbv-ite (c a b)
-                    (let ((res (bfr-ite-bss-fn c a b)))
-                      (if (boolean-listp res)
-                          (v2i res)
-                        res))))
-      (mk-g-number (sbv-ite c xrn yrn)
-                     (ubv-ite c xrd yrd)
-                     (sbv-ite c xin yin)
-                     (ubv-ite c xid yid)))))
+    (mk-g-number (bfr-ite-bss-fn c xrn yrn)
+                 (bfr-ite-bvv-fn c xrd yrd)
+                 (bfr-ite-bss-fn c xin yin)
+                 (bfr-ite-bvv-fn c xid yid))))
+
+(defthm gobj-depends-on-of-merge-general-numbers
+  (implies (and (not (pbfr-depends-on k p c))
+                (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-numberp x)
+                (general-numberp y))
+           (not (gobj-depends-on k p (merge-general-numbers c x y))))
+  :hints(("Goal" :in-theory (enable merge-general-numbers
+                                    gobj-depends-on))))
 
 (in-theory (disable merge-general-numbers))
 
@@ -61,6 +75,16 @@
          (val (bfr-ite c av bv)))
     (mk-g-boolean val)))
 
+(defthm gobj-depends-on-of-merge-general-booleans
+  (implies (and (not (pbfr-depends-on k p c))
+                (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y))
+                (general-booleanp x)
+                (general-booleanp y))
+           (not (gobj-depends-on k p (merge-general-booleans c x y))))
+  :hints(("Goal" :in-theory (enable merge-general-booleans
+                                    gobj-depends-on))))
+
 (in-theory (disable merge-general-booleans))
 
 
@@ -114,7 +138,13 @@
         ((eq (tag x) :g-apply)
          (if (eq (tag y) :g-apply)
              (if (equal (g-apply->fn x) (g-apply->fn y))
-                 'applies
+                 (if (equal (len (g-apply->args x))
+                            (len (g-apply->args y)))
+                     'applies
+                   (if (< (len (g-apply->args x))
+                          (len (g-apply->args y)))
+                       '<
+                     '>))
                (if (hlexorder (cdr x) (cdr y)) '< '>))
            '<))
         ((eq (tag y) :g-apply) '>)
@@ -156,6 +186,18 @@
           (bool-cond-itep-falsebr x))
     (mv t x nil)))
 
+(defthm gobj-depends-on-of-breakdown-ite-by-cond
+  (implies (not (gobj-depends-on k p x))
+           (b* (((mv test x y) (breakdown-ite-by-cond x)))
+             (and (not (pbfr-depends-on k p test))
+                  (not (gobj-depends-on k p x))
+                  (not (gobj-depends-on k p y)))))
+  :hints(("Goal" :in-theory (enable breakdown-ite-by-cond
+                                    bool-cond-itep
+                                    bool-cond-itep-truebr
+                                    bool-cond-itep-falsebr
+                                    bool-cond-itep-cond))))
+
 
 
 
@@ -179,7 +221,9 @@
                (and (not (equal x y))
                     (equal (tag x) :g-apply)
                     (equal (tag y) :g-apply)
-                    (equal (g-apply->fn x) (g-apply->fn y)))))
+                    (equal (g-apply->fn x) (g-apply->fn y))
+                    (equal (len (g-apply->args x))
+                           (len (g-apply->args y))))))
    :hints (("goal" :in-theory (enable general-booleanp general-numberp
                                       general-consp general-concrete-atom
                                       tag ite-merge-ordering)))))
@@ -194,10 +238,10 @@
 (local
  (encapsulate nil
    (local (add-bfr-pat (hyp-fix . ?)))
-   (local (in-theory (disable* acl2-count integer-abs 
+   (local (in-theory (disable* acl2-count integer-abs
                                equal-of-booleans-rewrite not
                                hyp-fix-of-hyp-fixedp
-                               
+
 ;                               bfr-eval-nonnil-forward
                                default-+-2 o<
                                default-<-1
@@ -307,7 +351,15 @@
                             true-under-hyp
                             false-under-hyp)
                          ((two-nats-measure)
-                          (maybe-merge-measure)))))))))
+                          (maybe-merge-measure)))))))
+
+   (defthm ite-merge-lists-measure-thm
+     (implies (consp x)
+              (and (o< (ite-merge-measure (car x) (car y))
+                       (ite-merge-measure x y))
+                   (o< (ite-merge-measure (cdr x) (cdr y))
+                       (ite-merge-measure x y))))
+     :hints(("Goal" :in-theory (enable ite-merge-measure acl2-count))))))
 
 
 
@@ -336,24 +388,26 @@
                    :measure (maybe-merge-measure x y)))
    (let ((ordersym (ite-merge-ordering x y)))
      (case ordersym
-       (equal (mv t x))
+       (equal (mv 'merged x))
        (booleans (mv 'merged (merge-general-booleans c x y)))
        (numbers (mv 'merged (merge-general-numbers c x y)))
        (conses (let ((hyp (bfr-and hyp (hf (bfr-ite c xhyp yhyp)))))
-                 (mv 'merged (gl-cons (ite-merge (hf c)
-                                                 (general-consp-car x)
-                                                 (general-consp-car y)
-                                                 hyp)
-                                      (ite-merge (hf c)
-                                                 (general-consp-cdr x)
-                                                 (general-consp-cdr y)
-                                                 hyp)))))
+                 (mv 'merged (gl-cons ;; gl-cons-split-ite ;;
+                              (ite-merge (hf c)
+                                         (general-consp-car x)
+                                         (general-consp-car y)
+                                         hyp)
+                              (ite-merge (hf c)
+                                         (general-consp-cdr x)
+                                         (general-consp-cdr y)
+                                         hyp)))))
        (applies (let ((hyp (bfr-and hyp (hf (bfr-ite c xhyp yhyp)))))
-                  (mv 'merged (g-apply (g-apply->fn x)
-                                       (ite-merge (hf c)
-                                                  (g-apply->args x)
-                                                  (g-apply->args y)
-                                                  hyp)))))
+                  (mv 'merged (g-apply ;; gl-fncall-split-ite ;;
+                               (g-apply->fn x)
+                               (ite-merge-lists (hf c)
+                                                (g-apply->args x)
+                                                (g-apply->args y)
+                                                hyp)))))
        (otherwise (mv ordersym nil)))))
 
 
@@ -365,7 +419,8 @@
                    :hints (("goal" :do-not-induct t
                             :in-theory '(ite-merge-measure-thm
                                          merge-rest-measure-thm
-                                         maybe-merge-measure-thm)))))
+                                         maybe-merge-measure-thm
+                                         ite-merge-lists-measure-thm)))))
    (cond ((not hyp) nil)
          ((hons-equal x y) x)
          ((th c) x)
@@ -378,20 +433,36 @@
                   (maybe-merge c first-x first-y first-x-cond first-y-cond hyp)))
               (case merge-flg
                 (merged
-                 (if (and (eq first-x-cond t)
-                          (eq first-y-cond t))
-                     first
-                   (merge-rest (hf (bfr-ite c first-x-cond first-y-cond))
-                               first c rest-x rest-y hyp)))
+                 (cond ((and (eq first-x-cond t)
+                             (eq first-y-cond t))
+                        first)
+                       ((eq first-x-cond t)
+                        (mk-g-ite (mk-g-boolean (hf (bfr-or c first-y-cond)))
+                                  first rest-y))
+                       ((eq first-y-cond t)
+                        (mk-g-ite (mk-g-boolean (hf (bfr-or (bfr-not c)
+                                                            first-x-cond)))
+                                  first rest-x))
+                       (t (merge-rest (hf (bfr-ite c first-x-cond first-y-cond))
+                                      first c rest-x rest-y hyp))))
                 (< (if (eq first-x-cond t)
                        (mk-g-ite (mk-g-boolean c) first-x y)
                      (merge-rest (bfr-and c first-x-cond)
                                  first-x c rest-x y hyp)))
                 (t ;; >
                  (if (eq first-y-cond t)
-                     (mk-g-ite (mk-g-boolean c) x first-y)
+                     (mk-g-ite (mk-g-boolean (bfr-not c)) first-y x)
                    (merge-rest (bfr-and (bfr-not c) first-y-cond)
-                               first-y c x rest-y hyp)))))))))
+                               first-y c x rest-y hyp))))))))
+
+ (defun ite-merge-lists (c x y hyp)
+   ;; (if c x y), x and y lists
+   (declare (xargs :guard (equal (len x) (len y))
+                   :measure (ite-merge-measure x y)))
+   (if (atom x)
+       nil
+     (cons (ite-merge c (car x) (car y) hyp)
+           (ite-merge-lists c (cdr x) (cdr y) hyp)))))
 
 
 (in-theory (disable ite-merge merge-rest))
@@ -402,8 +473,6 @@
 
 
 
-
-
 ;; (local
 ;;  (defthm merge-general-numbers-gobjectp
 ;;    (implies (and (gobjectp a) (gobjectp b)
@@ -420,35 +489,35 @@
             (implies (boolean-listp x)
                      (equal (bfr-eval-list x env)
                             x))))
-   
-   (local (defthm rewrite-v2i-of-boolean-list
-            (implies (and (syntaxp (not (and (consp x)
-                                             (eq (car x) 'bfr-eval-list))))
-                          (bind-free '((env . (car env))) (env))
-                          (boolean-listp x))
-                     (equal (v2i x)
-                            (v2i (bfr-eval-list x env))))
-            :hints(("Goal" :in-theory (enable bfr-eval-list-when-boolean-listp)))
-            :rule-classes ((:rewrite :backchain-limit-lst 0))))
-
-   (local (defthm rewrite-v2n-of-boolean-list
-            (implies (and (syntaxp (not (and (consp x)
-                                             (eq (car x) 'bfr-eval-list))))
-                          (bind-free '((env . (car env))) (env))
-                          (boolean-listp x))
-                     (equal (v2n x)
-                            (v2n (bfr-eval-list x env))))
-            :hints(("Goal" :in-theory (enable bfr-eval-list-when-boolean-listp)))
-            :rule-classes ((:rewrite :backchain-limit-lst 0))))
-
-   (defthm bfr-eval-list-of-bfr-ite-bvv-fn-under-v2n
-     (equal (v2n (bfr-eval-list (bfr-ite-bvv-fn c a b) env))
-            (v2n (if (bfr-eval c env)
-                     (bfr-eval-list a env)
-                   (bfr-eval-list b env))))
-     :hints(("Goal" :in-theory (enable bfr-ite-bvv-fn v2n)
-             :induct t)
-            (bfr-reasoning)))
+
+   ;; (local (defthm rewrite-v2i-of-boolean-list
+   ;;          (implies (and (syntaxp (not (and (consp x)
+   ;;                                           (eq (car x) 'bfr-eval-list))))
+   ;;                        (bind-free '((env . (car env))) (env))
+   ;;                        (boolean-listp x))
+   ;;                   (equal (v2i x)
+   ;;                          (bfr-list->s x env)))
+   ;;          :hints(("Goal" :in-theory (enable bfr-eval-list-when-boolean-listp)))
+   ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+   ;; (local (defthm rewrite-v2n-of-boolean-list
+   ;;          (implies (and (syntaxp (not (and (consp x)
+   ;;                                           (eq (car x) 'bfr-eval-list))))
+   ;;                        (bind-free '((env . (car env))) (env))
+   ;;                        (boolean-listp x))
+   ;;                   (equal (v2n x)
+   ;;                          (bfr-list->u x env)))
+   ;;          :hints(("Goal" :in-theory (enable bfr-eval-list-when-boolean-listp)))
+   ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+   ;; (defthm bfr-list->u-of-bfr-ite-bvv-fn-under
+   ;;   (equal (bfr-list->u (bfr-ite-bvv-fn c a b) env)
+   ;;          (if (bfr-eval c env)
+   ;;              (bfr-list->u a env)
+   ;;            (bfr-list->u b env)))
+   ;;   :hints(("Goal" :in-theory (enable bfr-ite-bvv-fn)
+   ;;           :induct t)
+   ;;          (bfr-reasoning)))
 
    (defthm merge-general-numbers-correct
      (implies (and (general-numberp a) (general-numberp b))
@@ -526,7 +595,7 @@
 ;;                            env)))
 ;;    :hints(("Goal" :in-theory (enable hyp-fix hyp-fixedp)))))
 
-            
+
 ;; (local
 ;;  (defthm breakdown-ite-by-cond-nonnil
 ;;    (implies (and hyp (bfr-and c hyp)
@@ -564,7 +633,8 @@
                   :hints (("goal" :do-not-induct t
                            :in-theory '(ite-merge-measure-thm
                                         merge-rest-measure-thm
-                                        maybe-merge-measure-thm)))))
+                                        maybe-merge-measure-thm
+                                        ite-merge-lists-measure-thm)))))
 
 
 
@@ -642,7 +712,9 @@
                                      true-under-hyp
                                      hyp-fixedp
                                      hyp-fix
-                                     breakdown-ite-by-cond))))))))
+                                     breakdown-ite-by-cond
+                                     (:type-prescription len)
+                                     (tau-system)))))))))
 
 
 ;; (local
@@ -688,17 +760,40 @@
    (not (equal (ite-merge-ordering x y) 'merged))
    :hints(("Goal" :in-theory (enable ite-merge-ordering)))))
 
+
+
+(local (defthm generic-geval-list-when-not-consp
+         (implies (not (consp x))
+                  (equal (generic-geval-list x env) nil))
+         :hints(("Goal" :in-theory (enable generic-geval-list)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(local (defthm generic-geval-list-when-len-0
+         (implies (equal (len x) 0)
+                  (equal (generic-geval-list x env) nil))
+         :hints(("Goal" :in-theory (enable generic-geval-list)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(local (defthm len-when-not-consp
+         (implies (not (consp x))
+                  (equal (len x) 0))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(local (defthm len-when-consp
+         (implies (consp x)
+                  (posp (len x)))
+         :rule-classes :type-prescription))
+
 (local
  (encapsulate
    nil
    (local (in-theory (e/d* (generic-geval-g-apply-p)
-                           ((force) member-equal 
+                           ((force) member-equal
                             ite-merge merge-rest maybe-merge
                             general-number-components-ev
-                            
+
                             boolean-list-bfr-eval-list
                             mv-nth
-                            (:type-prescription len)
                             default-car default-cdr
                             hons-assoc-equal
                             (:rewrite bfr-eval-booleanp)
@@ -706,11 +801,10 @@
                             generic-geval
                             hyp-fix-of-hyp-fixedp
                             eval-concrete-gobjectp
-                            acl2-numberp-v2n
                             default-unary-/
-                            
-                            (:type-prescription v2n)
-                            (:type-prescription v2i)
+
+                            len
+
                             bfr-eval-list-consts
                             default-*-1 default-*-2
                             (:type-prescription booleanp)
@@ -737,36 +831,56 @@
    ;;            :in-theory (enable false-under-hyp true-under-hyp))))
 
    (def-ite-merge-thm ite-merge-correct-lemma
-     (ite-merge (implies (bfr-eval (double-rewrite hyp) (car env))
-                         (equal (generic-geval (ite-merge c x y hyp) env)
-                                (if (bfr-eval c (car env))
-                                    (generic-geval x env)
-                                  (generic-geval y env))))
-                :name ite-merge-correct)
-     (maybe-merge (mv-let (flg ans)
-                    (maybe-merge c x y xhyp yhyp hyp)
-                    (implies (and (equal flg 'merged)
-                                  (bfr-eval hyp (car env)))
-                             (and (implies (and (bfr-eval c (car env))
-                                                (bfr-eval xhyp (car env)))
-                                           (equal (generic-geval ans env)
-                                                  (generic-geval x env)))
-                                  (implies (and (not (bfr-eval c (car env)))
-                                                (bfr-eval yhyp (car env)))
-                                           (equal (generic-geval ans env)
-                                                  (generic-geval y env))))))
-                  :name maybe-merge-correct)
-                                
-     (merge-rest (implies (bfr-eval hyp (car env))
-                          (equal (generic-geval (merge-rest firstcond first c x y hyp) env)
-                                 (if (bfr-eval firstcond (car env))
-                                     (generic-geval first env)
-                                   (if (bfr-eval c (car env))
-                                       (generic-geval x env)
-                                     (generic-geval y env)))))
-                 :name merge-rest-correct)
-     :hints (("goal" :induct (ite-merge-ind flag firstcond first xhyp yhyp c x y hyp)
-              :do-not-induct t
+     (defthm ite-merge-correct
+       (implies (bfr-eval (double-rewrite hyp) (car env))
+                (equal (generic-geval (ite-merge c x y hyp) env)
+                       (if (bfr-eval c (car env))
+                           (generic-geval x env)
+                         (generic-geval y env))))
+       :hints ('(:expand ((ite-merge c x y hyp))))
+       :flag ite-merge)
+     (defthm ite-merge-lists-correct
+      (implies (and (bfr-eval (double-rewrite hyp) (car env))
+                    (equal (len x) (len y)))
+               (equal (generic-geval-list (ite-merge-lists c x y hyp) env)
+                      (if (bfr-eval c (car env))
+                          (generic-geval-list x env)
+                        (generic-geval-list y env))))
+       :hints ('(:expand ((ite-merge-lists c x y hyp)
+                          (generic-geval-list x env)
+                          (generic-geval-list y env)
+                          (generic-geval-list nil env)
+                          (:free (a b) (generic-geval-list (cons a b) env)))))
+      :flag ite-merge-lists)
+     (defthm maybe-merge-correct
+       (mv-let (flg ans)
+         (maybe-merge c x y xhyp yhyp hyp)
+         (implies (and (equal flg 'merged)
+                       (bfr-eval hyp (car env)))
+                  (and (implies (and (bfr-eval c (car env))
+                                     (bfr-eval xhyp (car env)))
+                                (equal (generic-geval ans env)
+                                       (generic-geval x env)))
+                       (implies (and (not (bfr-eval c (car env)))
+                                     (bfr-eval yhyp (car env)))
+                                (equal (generic-geval ans env)
+                                       (generic-geval y env))))))
+       :hints ('(:expand ((maybe-merge c x y xhyp yhyp hyp)))
+               (and stable-under-simplificationp
+                    '(:in-theory (enable generic-geval))))
+       :flag maybe-merge)
+
+     (defthm merge-rest-correct
+       (implies (bfr-eval hyp (car env))
+                (equal (generic-geval (merge-rest firstcond first c x y hyp) env)
+                       (if (bfr-eval firstcond (car env))
+                           (generic-geval first env)
+                         (if (bfr-eval c (car env))
+                             (generic-geval x env)
+                           (generic-geval y env)))))
+       :hints ('(:expand ((merge-rest firstcond first c x y hyp))))
+       :flag merge-rest)
+     :hints (("goal" :do-not-induct t
               :in-theory (set-difference-theories
                           (list* '(:induction ite-merge-ind)
                                  '(:rewrite ite-merge-ind-equivalences)
@@ -778,10 +892,10 @@
              ;;            ("Subgoal *1/13" :by nil)
              ;;            ("Subgoal *1/12" :by nil)
              ;;            ("Subgoal *1/11" :by nil)
-             (and ;;(subgoal-of "Subgoal *1/" id)
-              stable-under-simplificationp
-              (flag::expand-calls-computed-hint
-               clause '(ite-merge merge-rest maybe-merge)))
+             ;; (and ;;(subgoal-of "Subgoal *1/" id)
+             ;;  stable-under-simplificationp
+             ;;  (flag::expand-calls-computed-hint
+             ;;   clause '(ite-merge merge-rest maybe-merge)))
              (and ;;(subgoal-of "Subgoal *1/" id)
               stable-under-simplificationp
               (or (cw "enabling~%")
@@ -798,14 +912,60 @@
                                      ;; ite-merge-guard merge-rest-guard
                                      ;; maybe-merge-guard
                                      hyp-fix hyp-fixedp)
-                                    ()))))))))
+                                    ()))))))
 
+   (local (Defthm gobj-list-depends-on-nil
+            (not (gobj-list-depends-on k p nil))
+            :hints(("Goal" :in-theory (enable gobj-list-depends-on)))))
+
+   (def-ite-merge-thm gobj-depends-on-of-ite-merge-lemma
+     (defthm gobj-depends-on-of-ite-merge
+       (implies (and (not (pbfr-depends-on k p c))
+                     (not (gobj-depends-on k p x))
+                     (not (gobj-depends-on k p y)))
+                (not (gobj-depends-on k p (ite-merge c x y hyp))))
+       :hints ('(:expand ((ite-merge c x y hyp)
+                          (ite-merge c x y nil)
+                          (ite-merge c x x hyp))))
+       :flag ite-merge)
+     (defthm gobj-depends-on-of-ite-merge-lists
+       (implies (and (not (pbfr-depends-on k p c))
+                     (not (gobj-list-depends-on k p x))
+                     (not (gobj-list-depends-on k p y)))
+                (not (gobj-list-depends-on k p (ite-merge-lists c x y hyp))))
+       :hints ('(:expand ((ite-merge-lists c x y hyp))))
+      :flag ite-merge-lists)
+     (defthm gobj-depends-on-of-maybe-merge
+       (mv-let (flg ans)
+         (maybe-merge c x y xhyp yhyp hyp)
+         (declare (ignore flg))
+         (implies (and (not (pbfr-depends-on k p c))
+                       (not (gobj-depends-on k p x))
+                       (not (gobj-depends-on k p y)))
+                  (not (gobj-depends-on k p ans))))
+       :hints ('(:expand ((maybe-merge c x y xhyp yhyp hyp)
+                          (maybe-merge c x x xhyp yhyp hyp)))
+               (and stable-under-simplificationp
+                    '(:in-theory (enable generic-geval))))
+       :flag maybe-merge)
+
+     (defthm gobj-depends-on-of-merge-rest
+       (implies (and (not (pbfr-depends-on k p firstcond))
+                     (not (gobj-depends-on k p first))
+                     (not (pbfr-depends-on k p c))
+                     (not (gobj-depends-on k p x))
+                     (not (gobj-depends-on k p y)))
+                (not (gobj-depends-on k p (merge-rest firstcond first c x y hyp))))
+       :hints ('(:expand ((merge-rest firstcond first c x y hyp)
+                          (merge-rest firstcond first c x y nil))))
+       :flag merge-rest)
+     :hints (("goal" :do-not-induct t)))))
 
 
 (verify-guards ite-merge
                :hints (("Goal" :in-theory (e/d** ((:ruleset minimal-rules))))
                        (and stable-under-simplificationp
-                            '(:in-theory 
+                            '(:in-theory
                               (e/d** ((:ruleset minimal-rules)
                                       ite-merge-invariants))))
                        (and stable-under-simplificationp
@@ -865,3 +1025,10 @@
                     (generic-geval y env))))
   :hints(("Goal" :in-theory (e/d (gobj-ite-merge)))))
 
+(defthm gobj-depends-on-of-gobj-ite-merge
+  (implies (and (not (pbfr-depends-on k p c))
+                (not (gobj-depends-on k p x))
+                (not (gobj-depends-on k p y)))
+           (not (gobj-depends-on k p (gobj-ite-merge c x y hyp))))
+  :hints(("Goal" :in-theory (enable gobj-ite-merge))))
+
diff -Nru acl2-6.2/books/centaur/gl/package.lsp acl2-6.3/books/centaur/gl/package.lsp
--- acl2-6.2/books/centaur/gl/package.lsp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/package.lsp	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,22 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
 
@@ -10,6 +29,9 @@
      hons-acons hons-get hut het hqual hons-equal
      hons-assoc-equal make-fal
      definline definlined
+     defxdoc defsection define
+
+     alist-keys alist-vals
 
      qv bfr-and bfr-not bfr-and
      bfr-p bfr-or bfr-xor bfr-iff bfr-ite bfr-eval bfr-eval-list
@@ -130,13 +152,33 @@
      mk-g-number mk-g-boolean mk-g-ite mk-g-concrete
      gobjectp glc glr gl-fnsym gl-interp
      gl-interp-raw gl-interp
-     gl-aside gl-ignore nonnil-symbol-listp env
+     gl-aside gl-ignore nonnil-symbol-listp
 
      xor
      gl-bdd-mode gl-aig-mode gl-mbe
 
+     logcons logcar logcdr loghead logtail logapp
+     b-ior b-and b-xor b-not bfix bitp boolfix
+
      numlist
-     defsection))
+     defsection
+
+     ;; some imports for better xdoc integration
+     hardware-verification
+     proof-automation
+     boolean-reasoning
+     satlink
+     ubdds
+     aig
+     acl2::hons-and-memoization
+     xdoc
+     set-max-mem
+     the-method
+     aignet
+     gl
+
+
+     ))
   '(nat-listp ; included 12/4/2012 by Matt K., for addition to *acl2-exports*
     )))
 
diff -Nru acl2-6.2/books/centaur/gl/param.lisp acl2-6.3/books/centaur/gl/param.lisp
--- acl2-6.2/books/centaur/gl/param.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/param.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,36 +1,38 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-(include-book "shape-spec")
-
-
+(include-book "bfr-param")
+(include-book "gtypes")
+(include-book "bvar-db")
+(include-book "tools/clone-stobj" :dir :system)
+(include-book "centaur/ubdds/param" :dir :system)
+(include-book "centaur/ubdds/lite" :dir :system)
+(include-book "centaur/aig/misc" :dir :system)
 (local (include-book "gtype-thms"))
 (local (include-book "data-structures/no-duplicates" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
 (local (include-book "ihs/ihs-lemmas" :dir :system))
-
-(include-book "centaur/ubdds/param" :dir :system)
-(include-book "centaur/ubdds/lite" :dir :system)
-(include-book "../aig/misc")
-(local (include-book "../aig/eval-restrict"))
-
+(local (include-book "centaur/aig/eval-restrict" :dir :system))
 (local (in-theory (disable acl2::append-of-nil)))
 
-(defun bfr-to-param-space (p x)
-  (declare (xargs :guard t)
-           (ignorable p))
-  (bfr-case :bdd (acl2::to-param-space p x)
-            :aig (acl2::aig-restrict
-                  x (acl2::aig-extract-iterated-assigns-alist p 10))))
-
-(defun bfr-list-to-param-space (p x)
-  (declare (xargs :guard t)
-           (ignorable p))
-  (bfr-case :bdd (acl2::to-param-space-list p x)
-            :aig (acl2::aig-restrict-list
-                  x (acl2::aig-extract-iterated-assigns-alist p 10))))
-
 ;; (local
 ;;  (defthm bfr-p-to-param-space
 ;;    (implies (bfr-p x)
@@ -47,15 +49,20 @@
 
 (defund gnumber-to-param-space (n p)
   (declare (xargs :guard t))
-  (and (consp n)
-       (cons (bfr-list-to-param-space p (car n))
-             (and (consp (cdr n))
-                  (cons (bfr-list-to-param-space p (cadr n))
-                        (and (consp (cddr n))
-                             (cons (bfr-list-to-param-space p (caddr n))
-                                   (and (consp (cdddr n))
-                                        (list (bfr-list-to-param-space
-                                               p (cadddr n)))))))))))
+  (b* (((mv rnum rden inum iden) (break-g-number n)))
+    (mk-g-number (bfr-list-to-param-space p rnum)
+                 (bfr-list-to-param-space p rden)
+                 (bfr-list-to-param-space p inum)
+                 (bfr-list-to-param-space p iden))))
+  ;; (and (consp n)
+  ;;      (cons (bfr-list-to-param-space p (car n))
+  ;;            (and (consp (cdr n))
+  ;;                 (cons (bfr-list-to-param-space p (cadr n))
+  ;;                       (and (consp (cddr n))
+  ;;                            (cons (bfr-list-to-param-space p (caddr n))
+  ;;                                  (and (consp (cdddr n))
+  ;;                                       (list (bfr-list-to-param-space
+  ;;                                              p (cadddr n)))))))))))
 
 ;; (local
 ;;  (defthm wf-g-numberp-gnumber-to-param-space
@@ -63,24 +70,48 @@
 ;;             (wf-g-numberp (gnumber-to-param-space n p)))
 ;;    :hints(("Goal" :in-theory (enable wf-g-numberp gnumber-to-param-space)))))
 
-
-(defund gobj-to-param-space (x p)
-  (declare (xargs :guard t
-                  :verify-guards nil))
-  (if (atom x)
-      x
-    (pattern-match x
-      ((g-concrete &) x)
-      ((g-boolean b) (mk-g-boolean (bfr-to-param-space p b)))
-      ((g-number n) (g-number (gnumber-to-param-space n p)))
-      ((g-ite if then else)
-       (mk-g-ite (gobj-to-param-space if p)
-                 (gobj-to-param-space then p)
-                 (gobj-to-param-space else p)))
-      ((g-apply fn args) (g-apply fn (gobj-to-param-space args p)))
-      ((g-var &) x)
-      (& (gl-cons (gobj-to-param-space (car x) p)
-                  (gobj-to-param-space (cdr x) p))))))
+(mutual-recursion
+ (defun gobj-to-param-space (x p)
+   (declare (xargs :guard t
+                   :verify-guards nil))
+   (if (atom x)
+       x
+     (pattern-match x
+       ((g-concrete &) x)
+       ((g-boolean b) (mk-g-boolean (bfr-to-param-space p b)))
+       ((g-number n) (gnumber-to-param-space n p))
+       ((g-ite if then else)
+        (mk-g-ite (gobj-to-param-space if p)
+                  (gobj-to-param-space then p)
+                  (gobj-to-param-space else p)))
+       ((g-apply fn args) (g-apply fn (gobj-list-to-param-space args p)))
+       ((g-var &) x)
+       (& (gl-cons (gobj-to-param-space (car x) p)
+                   (gobj-to-param-space (cdr x) p))))))
+ (defun gobj-list-to-param-space (x p)
+   (declare (xargs :guard t))
+   (if (atom x)
+       nil
+     (cons (gobj-to-param-space (car x) p)
+           (gobj-list-to-param-space (cdr x) p)))))
+
+;; (defthm tag-of-gobj-to-param-space
+;;   (implies (and (syntaxp (quotep tag))
+;;                 (g-keyword-symbolp tag)
+;;                 (not (equal (tag x) tag))
+;;                 (not (equal (tag x) :g-ite)))
+;;            (not (equal (tag (gobj-to-param-space x p)) tag)))
+;;   :hints (("goal" :expand ((gobj-to-param-space x p))
+;;            :in-theory (e/d (g-keyword-symbolp
+;;                             mk-g-boolean
+;;                             gnumber-to-param-space
+;;                             mk-g-number
+;;                             mk-g-ite
+;;                             gl-cons)
+;;                            (norm-bvec-s
+;;                             norm-bvec-u
+;;                             break-g-number))
+;;            :do-not-induct t)))
 
 ;; (local (in-theory (enable tag-when-g-var-p
 ;;                           tag-when-g-ite-p
@@ -98,17 +129,7 @@
 (verify-guards gobj-to-param-space
                :hints(("Goal" :in-theory (e/d () ((force))))))
 
-(defun bfr-param-env (p env)
-  (declare (xargs :guard t)
-           (ignorable p))
-  (bfr-case :bdd (acl2::param-env p env)
-            :aig env))
-
-(defund genv-param (p env)
-  (declare (xargs :guard (consp env))
-           (ignorable p))
-  (cons (bfr-param-env p (car env))
-        (cdr env)))
+
 
 ;; (local
 ;;  (defthmd gobjectp-g-number-2
@@ -181,25 +202,6 @@
 ;;                                      g-ite->then g-ite->else tag)))))
 
 
-(local
- (defthm bfr-eval-to-param-space
-   (implies (bfr-eval p env)
-            (equal (bfr-eval (bfr-to-param-space p x)
-                             (bfr-param-env p env))
-                   (bfr-eval x env)))
-   :hints(("Goal" :in-theory (e/d* (bfr-eval
-                                    bfr-to-param-space
-                                    acl2::param-env-to-param-space))))))
-
-(local
- (defthm bfr-eval-list-to-param-space-list
-   (implies (bfr-eval p env)
-            (equal (bfr-eval-list (bfr-list-to-param-space p x)
-                                  (bfr-param-env p env))
-                   (bfr-eval-list x env)))
-   :hints(("Goal" :in-theory (enable bfr-eval-list
-                                     bfr-eval
-                                     bfr-list-to-param-space)))))
 
 (local
  (defthm nth-open-const-idx
@@ -222,54 +224,267 @@
           '(t))
    :hints (("goal" :in-theory (enable bfr-eval-list)))))
 
-(defthm gobj-to-param-space-correct
+(defthm gnumber-to-param-space-correct
   (implies (bfr-eval p (car env))
-           (equal (generic-geval (gobj-to-param-space x p)
-                                 (genv-param p env))
-                  (generic-geval x env)))
-  :hints(("Goal" :in-theory
-          (e/d* ((:induction gobj-to-param-space)
-                 genv-param
-                 ;; gobjectp-g-boolean-2
-                 ;; gobjectp-g-number-2
-                 gnumber-to-param-space
-                 break-g-number
-                 default-car default-cdr)
-                ((force) bfr-eval-list
-                 components-to-number-alt-def
-                 boolean-listp bfr-eval
-                 (:rules-of-class :type-prescription :here)
-                 ; generic-geval-when-g-var-tag
-                 
+           (equal (generic-geval (gnumber-to-param-space n p)
+                                 (cons (bfr-param-env p (car env))
+                                       (cdr env)))
+                  (generic-geval (g-number n) env)))
+  :hints(("Goal" :in-theory (e/d (gnumber-to-param-space
+                                  generic-geval)
+                                 (components-to-number-alt-def
+                                  break-g-number
+                                  bfr-param-env)))))
+
+(defthm gnumber-to-param-space-correct-with-unparam-env
+  (implies (syntaxp (not (case-match env
+                           (('cons ('bfr-param-env . &) . &) t))))
+           (equal (generic-geval (gnumber-to-param-space n p)
+                                 env)
+                  (generic-geval (g-number n)
+                                 (genv-unparam p env))))
+  :hints(("Goal" :in-theory (e/d (gnumber-to-param-space
+                                  generic-geval genv-unparam)
+                                 (components-to-number-alt-def
+                                  break-g-number
+                                  bfr-param-env)))))
+
+
+(local (defthm generic-geval-g-number-of-g-number->num
+         (implies (equal (tag x) :g-number)
+                  (equal (generic-geval (g-number (g-number->num x)) env)
+                         (generic-geval x env)))
+         :hints(("Goal" :in-theory (enable generic-geval)))))
+
+(defthm-gobj-flag
+  (defthm gobj-to-param-space-correct
+    (implies (bfr-eval p (car env))
+             (equal (generic-geval (gobj-to-param-space x p)
+                                   (genv-param p env))
+                    (generic-geval x env)))
+    :flag gobj)
+  (defthm gobj-list-to-param-space-correct
+    (implies (bfr-eval p (car env))
+             (equal (generic-geval-list (gobj-list-to-param-space x p)
+                                        (genv-param p env))
+                    (generic-geval-list x env)))
+    :flag list)
+    :hints(("Goal" :in-theory
+            (e/d* (genv-param
+                   ;; gobjectp-g-boolean-2
+                   ;; gobjectp-g-number-2
+                   default-car default-cdr)
+                  ((force) bfr-eval-list
+                   components-to-number-alt-def
+                   boolean-listp bfr-eval
+                   (:rules-of-class :type-prescription :here)
+; generic-geval-when-g-var-tag
+
 ;                 bfr-eval-of-non-consp-cheap
 ;                 bfr-eval-when-not-consp
-                 bfr-to-param-space
-                 bfr-list-to-param-space
-                 bfr-param-env
-                 ;;break-g-number
-                 generic-geval
-                 hons-assoc-equal)
-                ((:type-prescription len)))
-          :induct (gobj-to-param-space x p)
-          :expand ((gobj-to-param-space x p)))
-         (and stable-under-simplificationp
-              (flag::expand-calls-computed-hint
-               acl2::clause '(generic-geval)))))
+                   bfr-to-param-space
+                   bfr-list-to-param-space
+                   bfr-param-env
+                   ;;break-g-number
+                   generic-geval
+                   hons-assoc-equal)
+                  ((:type-prescription len)))
+            :expand ((gobj-to-param-space x p)
+                     (gobj-list-to-param-space x p))
+            :do-not-induct t)
+           (and stable-under-simplificationp
+                '(:expand ((:free (env) (generic-geval x env)))))
+           (and stable-under-simplificationp
+                (flag::expand-calls-computed-hint
+                 acl2::clause '(generic-geval generic-geval-list)))))
+
 
 
+(defthm-gobj-flag
+  (defthm gobj-to-param-space-correct-with-unparam-env
+    (implies (syntaxp (not (and (consp env) (eq (car env) 'genv-param))))
+             (equal (generic-geval (gobj-to-param-space x p) env)
+                    (generic-geval x (genv-unparam p env))))
+    :flag gobj)
+  (defthm gobj-list-to-param-space-correct-with-unparam-env
+    (implies (syntaxp (not (and (consp env) (eq (car env) 'genv-param))))
+             (equal (generic-geval-list (gobj-list-to-param-space x p) env)
+                    (generic-geval-list x (genv-unparam p env))))
+    :flag list)
+    :hints(("Goal" :in-theory
+            (e/d* (genv-unparam
+                   ;; gobjectp-g-boolean-2
+                   ;; gobjectp-g-number-2
+                   default-car default-cdr)
+                  ((force) bfr-eval-list
+                   components-to-number-alt-def
+                   boolean-listp bfr-eval
+                   (:rules-of-class :type-prescription :here)
+; generic-geval-when-g-var-tag
+
+;                 bfr-eval-of-non-consp-cheap
+;                 bfr-eval-when-not-consp
+                   bfr-to-param-space
+                   bfr-list-to-param-space
+                   bfr-param-env
+                   ;;break-g-number
+                   generic-geval
+                   hons-assoc-equal)
+                  ((:type-prescription len)))
+            :expand ((gobj-to-param-space x p)
+                     (gobj-list-to-param-space x p))
+            :do-not-induct t)
+           (and stable-under-simplificationp
+                '(:expand ((:free (env) (generic-geval x env)))))
+           (and stable-under-simplificationp
+                (flag::expand-calls-computed-hint
+                 acl2::clause '(generic-geval generic-geval-list)))))
 
-(defun shape-spec-to-gobj-param (spec p)
-  (declare (xargs :guard (shape-specp spec)))
-  (gobj-to-param-space (shape-spec-to-gobj spec) p))
-
-(defun shape-spec-to-env-param (x obj p)
-  (declare (xargs :guard (shape-specp x)))
-  (genv-param p (shape-spec-to-env x obj)))
 
 
 (defthm eval-bfr-to-param-space-self
   (implies (bfr-eval x (car env))
            (bfr-eval (bfr-to-param-space x x) (car (genv-param x env))))
   :hints(("Goal" :in-theory (enable bfr-eval bfr-to-param-space genv-param
-                                    bfr-param-env
+                                    bfr-param-env bfr-unparam-env
                                     default-car))))
+
+
+(defun gobj-alist-to-param-space (alist p)
+  (declare (xargs :guard t))
+  (if (atom alist)
+      nil
+    (if (consp (car alist))
+        (cons (cons (caar alist) (gobj-to-param-space (cdar alist) p))
+              (gobj-alist-to-param-space (cdr alist) p))
+      (gobj-alist-to-param-space (cdr alist) p))))
+
+(defthm alistp-gobj-alist-to-param-space
+  (alistp (gobj-alist-to-param-space x pathcond)))
+
+
+
+
+
+(acl2::defstobj-clone bvar-db1 bvar-db :suffix "1")
+
+
+;; Copies the entries of bvar-db into bvar-db1 but parametrizes all the bound g
+;; objects.
+(defund parametrize-bvar-db-aux (n p bvar-db bvar-db1)
+  (declare (xargs :stobjs (bvar-db bvar-db1)
+                  :guard (and (natp n)
+                              (<= (base-bvar bvar-db) n)
+                              (<= n (next-bvar bvar-db)))
+                  :measure (nfix (- (next-bvar bvar-db) (nfix n)))))
+  (b* (((when (mbe :logic (zp (- (next-bvar bvar-db) (nfix n)))
+                   :exec (int= (next-bvar bvar-db) n)))
+        bvar-db1)
+       (gobj (get-bvar->term n bvar-db))
+       (pgobj (gobj-to-param-space gobj p))
+       (bvar-db1 (add-term-bvar pgobj bvar-db1)))
+    (parametrize-bvar-db-aux (+ 1 (lnfix n)) p bvar-db bvar-db1)))
+
+(defund parametrize-term-equivs (p x)
+  (declare (xargs :guard (alistp x)))
+  (if (atom x)
+      nil
+    (hons-acons (gobj-to-param-space (caar x) p)
+                (cdar x)
+                (parametrize-term-equivs p (cdr x)))))
+
+
+(defund parametrize-bvar-db (p bvar-db bvar-db1)
+  (declare (xargs :stobjs (bvar-db bvar-db1)
+                  :verify-guards nil))
+  (b* ((base (base-bvar bvar-db))
+       (bvar-db1 (init-bvar-db base bvar-db1))
+       (bvar-db1 (parametrize-bvar-db-aux base p bvar-db bvar-db1)))
+    (update-term-equivs (parametrize-term-equivs p (term-equivs bvar-db))
+                        bvar-db1)))
+
+
+
+
+(defsection parametrize-bvar-db
+  (local (in-theory (enable parametrize-bvar-db parametrize-bvar-db-aux)))
+  (local (include-book "arithmetic/top-with-meta" :dir :system))
+  (local (include-book "centaur/misc/arith-equivs" :dir :system))
+
+  (local (defthm alistp-when-term-equivsp
+           (implies (and (bind-free '((bvar-db . bvar-db)) (bvar-db))
+                         (term-equivsp$a x bvar-db))
+                    (alistp x))
+           :hints(("Goal" :in-theory (enable alistp)))))
+
+  (defthm get-bvar->term-of-parametrize-bvar-db-aux
+    (implies (and (<= (base-bvar$a bvar-db1) (nfix m))
+                  (< (nfix m) (+ (next-bvar$a bvar-db1)
+                                 (- (next-bvar$a bvar-db) (nfix n)))))
+             (equal (get-bvar->term$a m (parametrize-bvar-db-aux n p bvar-db bvar-db1))
+                    (if (<= (next-bvar$a bvar-db1) (nfix m))
+                        (gobj-to-param-space
+                         (get-bvar->term$a (+ (- (nfix m) (next-bvar$a bvar-db1))
+                                              (nfix n))
+                                           bvar-db)
+                         p)
+                      (get-bvar->term$a m bvar-db1)))))
+
+  (defthm base-bvar-of-parametrize-bvar-db-aux
+    (equal (base-bvar$a (parametrize-bvar-db-aux n p bvar-db bvar-db1))
+           (base-bvar$a bvar-db1)))
+
+  (defthm next-bvar-of-parametrize-bvar-db-aux
+    (equal (next-bvar$a (parametrize-bvar-db-aux n p bvar-db bvar-db1))
+           (+ (nfix (- (next-bvar$a bvar-db) (nfix n))) (next-bvar$a
+                                                         bvar-db1))))
+
+  (local (defthm bvar-listp-when-same-next/base
+           (implies (and (bvar-listp$a x bvar-db)
+                         (equal (base-bvar$a bvar-db) (base-bvar$a bvar-db1))
+                         (equal (next-bvar$a bvar-db) (next-bvar$a bvar-db1)))
+                    (bvar-listp$a x bvar-db1))
+           :hints(("Goal" :induct (len x)))))
+
+  (local (defthm term-equivsp-when-same-next/base
+           (implies (and (term-equivsp$a x bvar-db)
+                         (equal (base-bvar$a bvar-db) (base-bvar$a bvar-db1))
+                         (equal (next-bvar$a bvar-db) (next-bvar$a bvar-db1)))
+                    (term-equivsp$a x bvar-db1))
+           :hints(("Goal" :induct (len x)))))
+
+  (defthm term-equivsp-of-parametrize-term-equivs
+    (implies (and (bind-free (and (consp x)
+                                  (equal (car x) 'term-equivs$a)
+                                  `((bvar-db . ,(cadr x))))
+                             (bvar-db))
+                  (term-equivsp x bvar-db)
+                  (equal (base-bvar$a bvar-db) (base-bvar$a bvar-db1))
+                  (equal (next-bvar$a bvar-db) (next-bvar$a bvar-db1)))
+             (term-equivsp$a (parametrize-term-equivs p x) bvar-db1))
+    :hints(("Goal" :in-theory (enable parametrize-term-equivs))))
+
+
+  (verify-guards parametrize-bvar-db)
+
+
+  (defthm normalize-parametrize-bvar-db
+    (implies (syntaxp (not (equal bvar-db1 ''nil)))
+             (equal (parametrize-bvar-db p bvar-db bvar-db1)
+                    (parametrize-bvar-db p bvar-db nil))))
+
+  (defthm base-bvar-of-parametrize-bvar-db
+    (equal (base-bvar$a (parametrize-bvar-db p bvar-db bvar-db1))
+           (base-bvar$a bvar-db)))
+
+  (defthm next-bvar-of-parametrize-bvar-db
+    (equal (next-bvar$a (parametrize-bvar-db p bvar-db bvar-db1))
+           (next-bvar$a bvar-db)))
+
+  (defthm get-bvar->term-of-parametrize-bvar-db
+    (implies (and (<= (base-bvar$a bvar-db) (nfix n))
+                  (< (nfix n) (next-bvar$a bvar-db)))
+             (equal (get-bvar->term$a n (parametrize-bvar-db p bvar-db bvar-db1))
+                    (gobj-to-param-space
+                     (get-bvar->term$a n bvar-db) p)))))
+
diff -Nru acl2-6.2/books/centaur/gl/portcullis.acl2 acl2-6.3/books/centaur/gl/portcullis.acl2
--- acl2-6.2/books/centaur/gl/portcullis.acl2	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/portcullis.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -1,10 +1,28 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (ld "package.lsp")
-(ld "centaur/vl/package.lsp" :dir :system)
-(ld "cutil/package.lsp" :dir :system)
-(ld "centaur/aignet/package.lsp" :dir :system)
 (ld "tools/flag-package.lsp" :dir :system)
+(include-book "centaur/vl/portcullis" :dir :system)
+(include-book "cutil/portcullis" :dir :system)
+(include-book "centaur/aignet/portcullis" :dir :system)
 ; cert-flags: ? t :ttags :all
-(certify-book "portcullis" ? t :ttags :all)
+
 
diff -Nru acl2-6.2/books/centaur/gl/portcullis.lisp acl2-6.3/books/centaur/gl/portcullis.lisp
--- acl2-6.2/books/centaur/gl/portcullis.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/portcullis.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,21 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
diff -Nru acl2-6.2/books/centaur/gl/rewrites.lisp acl2-6.3/books/centaur/gl/rewrites.lisp
--- acl2-6.2/books/centaur/gl/rewrites.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/rewrites.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,345 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "def-gl-rewrite")
+(include-book "symbolic-arithmetic-fns")
+(local (include-book "centaur/bitops/congruences" :dir :system))
+(local (include-book "centaur/bitops/ihs-extensions" :dir :system))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+
+(def-gl-rewrite integerp-of-logapp
+  (integerp (logapp a b c)))
+
+(defun plus-of-logapp-ind (n a c carry)
+  (if (zp n)
+      (list a c carry)
+    (plus-of-logapp-ind (1- n) (logcdr a) (logcdr c)
+                        (b-ior (b-and carry (logcar a))
+                               (b-and carry (logcar c))))))
+
+(local
+ (defthmd plus-of-logapp-lemma
+   (implies (and (bitp carry) (integerp c))
+            (equal (+ (logapp n a b) c carry)
+                   (+ (+ carry
+                         (loghead n a)
+                         (loghead n c))
+                      (ash (+ (ifix b) (logtail n c)) (nfix n)))))
+   :hints(("Goal" :in-theory (enable* acl2::ihsext-recursive-redefs)
+           :induct (plus-of-logapp-ind n a c carry))
+          (and stable-under-simplificationp
+               '(:in-theory (enable acl2::equal-logcons-strong
+                                    b-xor b-and b-ior))))))
+
+(def-gl-rewrite plus-of-logapp-1
+  (implies (integerp c)
+           (equal (+ (logapp n a b) c)
+                  (+ (+ (loghead n a)
+                        (loghead n c))
+                     (ash (+ (ifix b) (logtail n c)) (nfix n)))))
+  :hints (("goal" :use ((:instance plus-of-logapp-lemma
+                         (carry 0)))
+           :in-theory (disable plus-of-logapp-lemma))))
+
+(def-gl-rewrite plus-of-logapp-2
+  (implies (integerp c)
+           (equal (+ c (logapp n a b))
+                  (+ (+ (loghead n a)
+                        (loghead n c))
+                     (ash (+ (ifix b) (logtail n c)) (nfix n)))))
+  :hints (("goal" :use ((:instance plus-of-logapp-lemma
+                         (carry 0)))
+           :in-theory (disable plus-of-logapp-lemma))))
+
+;; (def-gl-rewrite loghead-of-logapp
+;;   (implies (<= (nfix n) (nfix m))
+;;            (equal (loghead n (logapp m a b))
+;;                   (loghead n a)))
+;;   :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+;;                                      acl2::ihsext-recursive-redefs))))
+
+(def-gl-rewrite loghead-of-logapp
+  (equal (loghead n (logapp m a b))
+         (logapp (min (nfix m) (nfix n)) a (loghead (nfix (- (nfix n) (nfix m))) b)))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(def-gl-rewrite loghead-of-0
+  (equal (loghead 0 x) 0))
+
+(def-gl-rewrite logapp-tail-0
+  (equal (logapp n a 0) (loghead n a)))
+
+(def-gl-rewrite logbitp-of-logapp
+  (equal (logbitp n (logapp m a b))
+         (if (< (nfix n) (nfix m))
+             (logbitp n a)
+           (logbitp (- (nfix n) (nfix m)) b)))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(def-gl-rewrite loghead-of-plus
+  (implies (and (integerp a) (integerp b))
+           (equal (loghead n (+ a b))
+                  (loghead n (+ (loghead n a) (loghead n b)))))
+  :hints(("Goal" :use ((:instance acl2::loghead-of-plus-loghead-first
+                        (m n))
+                       (:instance acl2::loghead-of-plus-loghead-first
+                        (m n) (a (loghead n b)) (b a))))))
+
+(def-gl-rewrite logbitp-of-plus
+  (implies (and (integerp a) (integerp b))
+           (equal (logbitp n (+ a b))
+                  (logbitp n (+ (loghead (+ 1 (nfix n)) a)
+                                (loghead (+ 1 (nfix n)) b)))))
+  :hints (("goal" :in-theory (e/d* (acl2::bitops-congruences)
+                                   (acl2::bitops-congruence-incompatible)))))
+
+
+(def-gl-rewrite logand-of-logapp
+  (equal (logand mask (logapp n a b))
+         (logapp n (logand mask a)
+                 (logand (logtail n mask) b)))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(def-gl-rewrite logand-of-logapp-2
+  (equal (logand (logapp n a b) mask)
+         (logapp n (logand mask a)
+                 (logand (logtail n mask) b)))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(def-gl-rewrite logior-of-logapp
+  (equal (logior mask (logapp n a b))
+         (logapp n (logior mask a)
+                 (logior (logtail n mask) b)))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(def-gl-rewrite logior-of-logapp-2
+  (equal (logior (logapp n a b) mask)
+         (logapp n (logior mask a)
+                 (logior (logtail n mask) b)))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(def-gl-rewrite logtail-of-logapp
+  (equal (logtail m (logapp n a b))
+         (logapp (- (nfix n) (nfix m))
+                 (logtail m a)
+                 (logtail (- (nfix m) (nfix n)) b)))
+  :hints(("Goal" :in-theory (e/d* (acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs)
+                                  (acl2::logtail-identity
+                                   acl2::bitmaskp**)))))
+
+(def-gl-rewrite logand-minus-1-first
+  (equal (logand -1 n)
+         (ifix n)))
+
+(def-gl-rewrite logand-minus-1-second
+  (equal (logand n -1)
+         (ifix n)))
+
+(def-gl-rewrite logior-minus-1-first
+  (equal (logior -1 n) -1))
+
+(def-gl-rewrite logior-minus-1-second
+  (equal (logior n -1) -1))
+
+(def-gl-rewrite logior-0-first
+  (equal (logior 0 n) (ifix n)))
+
+(def-gl-rewrite logior-0-second
+  (equal (logior 0 n) (ifix n)))
+
+(def-gl-rewrite ifix-of-logapp
+  (equal (ifix (logapp n a b))
+         (logapp n a b)))
+
+;; (def-gl-rewrite logand-of-logapp
+;;   (implies (and (<= 0 (ifix mask))
+;;                 (< (ifix mask) (ash 1 (nfix n))))
+;;            (equal (logand mask (logapp n a b))
+;;                   (logand mask a)))
+;;   :hints (("goal" :in-theory (enable* acl2::ihsext-recursive-redefs
+;;                                      acl2::ihsext-inductions))))
+
+(def-gl-rewrite integerp-of-maybe-integer
+  (equal (integerp (maybe-integer i x intp))
+         (and intp t))
+  :hints(("Goal" :in-theory (enable maybe-integer))))
+
+(def-gl-rewrite <-of-maybe-integer-1
+  (implies intp
+           (equal (< (maybe-integer i x intp) a)
+                  (< (ifix i) a)))
+  :hints(("Goal" :in-theory (enable maybe-integer))))
+
+(def-gl-rewrite <-of-maybe-integer-2
+  (implies intp
+           (equal (< a (maybe-integer i x intp))
+                  (< a (ifix i))))
+  :hints(("Goal" :in-theory (enable maybe-integer))))
+
+(local (defthm <-logapp-0-local
+         (equal (< (logapp n i j) 0)
+                (< (ifix j) 0))
+         :hints(("Goal" :in-theory (e/d* ;; acl2::ihsext-bounds-thms
+                                    (acl2::ihsext-recursive-redefs
+                                     acl2::ihsext-inductions)
+                                    ((force)))))))
+(def-gl-rewrite <-logapp-0
+  (equal (< (logapp n i j) 0)
+         (< (ifix j) 0)))
+
+(def-gl-rewrite integerp-int-set-sign
+  (integerp (int-set-sign negp i)))
+
+(def-gl-rewrite <-int-set-sign-0
+  (equal (< (int-set-sign negp i) 0)
+         (and negp t)))
+
+(defun ifix-or-zero (ip i)
+  (if ip (ifix i) 0))
+
+(def-gl-rewrite ifix-of-maybe-integer
+  (equal (ifix (maybe-integer i x intp))
+         (ifix-or-zero intp i))
+  :hints(("Goal" :in-theory (enable maybe-integer))))
+
+(def-gl-rewrite ifix-or-zero-of-logapp
+  (equal (ifix-or-zero ip (logapp n a b))
+         (logapp n (ifix-or-zero ip a)
+                 (ifix-or-zero ip b))))
+
+(def-gl-rewrite ifix-or-zero-of-int-set-sign
+  (equal (ifix-or-zero ip (int-set-sign negp i))
+         (int-set-sign (and ip negp) (ifix-or-zero ip i)))
+  :hints(("Goal" :in-theory (enable int-set-sign))))
+
+(defun nfix-or-zero (ip i)
+  (if ip (nfix i) 0))
+
+(def-gl-rewrite nfix-of-maybe-integer
+  (equal (nfix (maybe-integer i x intp))
+         (nfix-or-zero intp i))
+  :hints(("Goal" :in-theory (enable maybe-integer))))
+
+(local (defthm logapp-with-non-integer
+         (implies (zip b)
+                  (equal (logapp n a b)
+                         (loghead n a)))))
+
+(def-gl-rewrite nfix-or-zero-of-logapp
+  (equal (nfix-or-zero ip (logapp n a b))
+         (logapp n (ifix-or-zero (and ip (<= 0 (ifix b))) a)
+                 (nfix-or-zero ip b)))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(local (defthm loghead-with-zip
+         (implies (zip a)
+                  (equal (loghead n a) 0))))
+
+(def-gl-rewrite loghead-of-maybe-integer
+  (equal (loghead n (maybe-integer i x intp))
+         (ifix-or-zero intp (loghead n (ifix i))))
+  :hints(("Goal" :in-theory (enable non-int-fix maybe-integer))))
+
+(def-gl-rewrite ifix-or-zero-of-loghead
+  (equal (ifix-or-zero ip (loghead n i))
+         (loghead n (ifix-or-zero ip i))))
+
+
+(def-gl-rewrite equal-of-logapp
+  (equal (equal (logapp n a b) c)
+         (and (integerp c)
+              (equal (loghead n c) (loghead n a))
+              (equal (logtail n c) (ifix b))))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(def-gl-rewrite logand-0-first
+  (equal (logand 0 x)
+         0))
+
+(def-gl-rewrite logand-0-second
+  (equal (logand x 0)
+         0))
+
+(def-gl-rewrite integerp-floor
+  (equal (integerp (floor x y)) t))
+
+;; (local (defthm logapp-of-non-integer-second
+;;          (implies (not (integerp b))
+;;                   (equal (logapp n a b)
+;;                          (logapp n a 0)))
+;;          :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+;;                                             acl2::ihsext-recursive-redefs)))
+;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+#||
+
+
+
+
+(trace$ gl::glcp-unify-term/gobj)
+
+(thm (IMPLIES
+      (and (GL::INTEGER-WITH-NBITSP 64 ACL2::X0)
+           (UNSIGNED-BYTE-P 64 ACL2::X1)
+           (UNSIGNED-BYTE-P 64 ACL2::X2))
+      (OR (LOGBITP 10 ACL2::X1)
+          (EQUAL (UNSIGNED-BYTE-FIX 64
+                                    (AAA_AAS-G7 ACL2::X2 (LOGHEAD 64 ACL2::X0)))
+                 (LOGIOR 2 (ACL2::LOGSQUASH 32 ACL2::X2)
+                         (LOGAND 2261 ACL2::X0)))))
+     :hints (("goal" :in-theory nil)
+             (gl::try-gl
+              ;; :fixes
+              ;; (((nfix (st-get :eflags st)) (loghead 64 acl2::x)))
+              :subterms-types
+              (((nfix (st-get :eflags st))              (gl::integer-with-nbitsp 64 acl2::x))
+               ((u64-tr-get n g)                        (unsigned-byte-p 64 acl2::x))
+;            ((st-set :pc val st)                     (unknownp acl2::x))
+               ((st-get :oracle st)                     (unknownp acl2::x)))
+              :type-gens (((unknownp acl2::x) (gl::g-var 0)))
+;           :bad-subterms (st)
+              )))
+
+||#
+
+(gl::def-gl-rewrite not-to-if
+  (iff (not x)
+       (if x nil t)))
+
+
+;; (defthm merge-if-of-cons
+;;   (implies (consp z)
+;;            (equal (if c (cons x y) z)
+;;                   (cons (if c x (car z))
+;;                         (if c y (cdr z)))))
+;;   :rule-classes nil)
+
+;; (table gl-branch-merge-rules
+;;        'cons
+;;        '(merge-if-of-cons))
diff -Nru acl2-6.2/books/centaur/gl/run-gified-cp.lisp acl2-6.3/books/centaur/gl/run-gified-cp.lisp
--- acl2-6.2/books/centaur/gl/run-gified-cp.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/run-gified-cp.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,6 +1,24 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "bfr")
 (include-book "gobjectp")
 (include-book "gtypes")
@@ -13,6 +31,8 @@
 (include-book "centaur/ubdds/witness" :dir :system)
 (local (include-book "std/lists/take" :dir :system))
 (local (include-book "gtype-thms"))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+(local (include-book "centaur/misc/arith-equivs" :dir :system))
 
 (local (defun before-run-gified-ev-tag () nil))
 
@@ -36,13 +56,13 @@
    (symbolp x)
    (pairlis$ a b)
    (cons a b)
+   (atom a)
    (binary-+ a b)
    (hide a)
    (mv-nth n x)
    (mv-list n x)
    (acl2::return-last a b c)
    (force x)
-   (gobj-listp x)
    (bfr-eval x env)
    (acl2::typespec-check ts x)
    (iff a b)
@@ -127,9 +147,9 @@
 
 (defun run-gified-lhs-and-okp-breakdown (lhs okp)
   (case-match okp
-    (('mv-nth ''0 (acl2::fn . '(fn actuals hyp clk state)))
+    (('mv-nth ''0 (acl2::fn . '(fn actuals hyp clk config bvar-db state)))
      (case-match lhs
-       ((ev ('mv-nth ''1 (!fn . '(fn actuals hyp clk state))) 'env)
+       ((ev ('mv-nth ''1 (!fn . '(fn actuals hyp clk config bvar-db state))) 'env)
         (mv nil ev acl2::fn))
        (& (mv "lhs mismatched" nil nil))))
     (& (mv "okp mismatched" nil nil))))
@@ -140,30 +160,30 @@
      (run-gified-lhs-and-okp-breakdown lhs okp)
      (implies (not erp)
               (and (equal lhs
-                          `(,geval (mv-nth '1 (,run-gified fn actuals hyp clk state))
+                          `(,geval (mv-nth '1 (,run-gified fn actuals hyp clk config bvar-db state))
                                    env))
                    (equal okp
-                          `(mv-nth '0 (,run-gified fn actuals hyp clk state))))))
+                          `(mv-nth '0 (,run-gified fn actuals hyp clk config bvar-db state))))))
    :rule-classes :forward-chaining))
 
 (in-theory (disable run-gified-lhs-and-okp-breakdown))
 
-(defun run-gified-rhs-breakdown (rhs acl2::geval-fn)
+(defun run-gified-rhs-breakdown (rhs)
   (case-match rhs
     ((ev ('cons 'fn
                 ('acl2::kwote-lst
-                 (!geval-fn . '(actuals env))))
+                 (geval-list . '(actuals env))))
          . '('nil))
-     (mv nil ev))
-    (& (mv "rhs mismatched" nil))))
+     (mv nil ev geval-list))
+    (& (mv "rhs mismatched" nil nil))))
 
 (local
  (defthm run-gified-rhs-breakdown-correct
-   (mv-let (erp evfn)
-     (run-gified-rhs-breakdown rhs geval-fn)
+   (mv-let (erp evfn geval-list)
+     (run-gified-rhs-breakdown rhs)
      (implies (not erp)
               (equal rhs
-                     `(,evfn (cons fn (acl2::kwote-lst (,geval-fn actuals env)))
+                     `(,evfn (cons fn (acl2::kwote-lst (,geval-list actuals env)))
                              'nil))))
    :rule-classes :forward-chaining))
 
@@ -210,7 +230,7 @@
         (& (mv (acl2::msg "bad gl-function-info table entry: ~x0" entry) nil))))))
 
 (in-theory (disable geval-rule-alist))
-             
+
 
 
 (defun run-gified-case-breakdown (body)
@@ -280,14 +300,14 @@
       ('equal (the-geval (!gfn . gformals) . '(env))
               (!fn . evals)))
      (let ((nformals (len gformals)))
-       (if (<= 2 nformals)
-           (let ((formals (take (- nformals 2) gformals)))
+       (if (<= 5 nformals)
+           (let ((formals (take (- nformals 5) gformals)))
              (if (and (equal the-geval geval)
                       (evals-of-formalsp formals evals geval 'env)
                       (nonnil-symbol-listp gformals)
                       (acl2::fast-no-duplicatesp gformals)
                       (not (member 'env gformals))
-                      (equal (nthcdr (- nformals 2) gformals) '(hyp clk)))
+                      (equal (nthcdr (- nformals 5) gformals) '(hyp clk config bvar-db state)))
                  (mv nil gformals)
                (mv (acl2::msg "Malformed geval theorem: ~x0" thm) nil)))
          (mv (acl2::msg "Malformed geval theorem: ~x0" thm) nil))))
@@ -314,19 +334,19 @@
 ;  (defthmd member-is-member-equal
 ;    (equal (member x y)
 ;           (member-equal x y))))
-; 
-; (local (in-theory (enable member-is-member-equal)))  
+;
+; (local (in-theory (enable member-is-member-equal)))
 
 (local
  (defthm run-gified-check-geval-thm-formals
    (mv-let (erp formals)
      (run-gified-check-geval-thm thm gfn fn geval)
      (implies (not erp)
-              (and (<= 2 (len formals))
+              (and (<= 5 (len formals))
                    (nonnil-symbol-listp formals)
                    (no-duplicatesp-equal formals)
                    (not (member-equal 'env formals))
-                   (equal (nthcdr (+ -2 (len formals)) formals) '(hyp clk)))))
+                   (equal (nthcdr (+ -5 (len formals)) formals) '(hyp clk config bvar-db state)))))
    :rule-classes nil))
 
 (local
@@ -338,7 +358,7 @@
                      `(implies (bfr-eval hyp (car env))
                                (equal (,geval (,gfn . ,formals) env)
                                       (,fn . ,(make-evals-of-formals
-                                               (take (- (len formals) 2)
+                                               (take (- (len formals) 5)
                                                      formals)
                                                geval 'env)))))))
    :rule-classes :forward-chaining))
@@ -355,7 +375,7 @@
 (local
  (defthm nthcdr-nil
    (equal (nthcdr n nil) nil)))
-   
+
 (local
  (defthm nth-of-nthcdr
    (equal (nth n (nthcdr m y))
@@ -371,7 +391,7 @@
 ;;     :hints (("goal" :induct (nthcdr n x)))))
 
 
-           
+
 
 (local
  (encapsulate nil
@@ -477,7 +497,7 @@
      :hints (("goal" :induct (replace-term-flg flag new old avoid x))
              (and stable-under-simplificationp
                   '(:in-theory (enable equality-cp-ev-constraint-0)))))
-  
+
    (in-theory (disable replace-term replace-term-list))
 
    (defthm replace-term-list-correct-disjoin
@@ -549,12 +569,12 @@
  (defthm run-gified-check-geval-thm-correct
    (mv-let (erp formals)
      (run-gified-check-geval-thm thm gfn fn geval)
-     (let ((hyp (run-gified-ev (nth (+ -2 (len formals)) args)
+     (let ((hyp (run-gified-ev (nth (+ -5 (len formals)) args)
                                a))
            (env (cdr (assoc-equal 'env a))))
        (implies (and (not erp)
                      (run-gified-ev
-                      thm 
+                      thm
                       (cons (cons 'env (cdr (assoc-equal 'env a)))
                             (pairlis$ formals (run-gified-ev-lst args a))))
                      (not (eq geval 'quote))
@@ -567,23 +587,23 @@
                         a)
                        (run-gified-ev
                         `(,fn . ,(make-evals-of-formals
-                                  (take (- (len formals) 2)
+                                  (take (- (len formals) 5)
                                         args)
                                   geval 'env))
                         a)))))
    :hints(("Goal"
            :in-theory (e/d () ;; equal-nthcdr-cons
-                           (nth-of-nthcdr assoc-equal-pairlis-nth
+                           (nth-of-nthcdr acl2::car-nthcdr assoc-equal-pairlis-nth
                                           run-gified-check-geval-thm))
            :use ((:instance run-gified-check-geval-thm-form)
                  (:instance run-gified-check-geval-thm-formals)
                  (:instance
                   nth-of-nthcdr
-                  (n 0) (m (+ -2 (len args)))
+                  (n 0) (m (+ -5 (len args)))
                   (y (mv-nth 1 (run-gified-check-geval-thm thm gfn fn geval))))
                  (:instance
                   assoc-equal-pairlis-nth
-                  (n (- (len args) 2))
+                  (n (- (len args) 5))
                   (keys (mv-nth 1 (run-gified-check-geval-thm thm gfn fn geval)))
                   (vals (run-gified-ev-lst args a)))))
           (and stable-under-simplificationp
@@ -622,7 +642,7 @@
  (defthm run-gified-get-geval-thm-correct
    (mv-let (erp thm formals)
      (run-gified-get-geval-thm gfn fn geval-alist geval)
-     (let ((hyp (run-gified-ev (nth (+ -2 (len formals)) args) a))
+     (let ((hyp (run-gified-ev (nth (+ -5 (len formals)) args) a))
            (env (cdr (assoc-equal 'env a))))
        (implies
         (and (not erp)
@@ -636,7 +656,7 @@
                               a)
                (run-gified-ev `(,fn
                                 . ,(make-evals-of-formals
-                                    (take (- (len formals) 2) args) geval 'env))
+                                    (take (- (len formals) 5) args) geval 'env))
                               a)))))
    :hints(("Goal" :in-theory (e/d (use-by-hint) ())
            :use ((:instance run-gified-ev-falsify
@@ -653,7 +673,7 @@
  (defthm run-gified-get-geval-thm-correct-corollary
    (mv-let (erp thm formals)
      (run-gified-get-geval-thm gfn fn geval-alist geval)
-     (let ((hyp (run-gified-ev (nth (+ -2 (len formals)) args) a))
+     (let ((hyp (run-gified-ev (nth (+ -5 (len formals)) args) a))
            (env (cdr (assoc-equal 'env a))))
        (implies
         (and (not erp)
@@ -676,7 +696,7 @@
                               nil)
                (run-gified-ev `(,fn
                                 . ,(make-evals-of-formals
-                                    (take (- (len formals) 2) args) geval 'env))
+                                    (take (- (len formals) 5) args) geval 'env))
                               a)))))
    :hints(("Goal" :in-theory (e/d (run-gified-ev-constraint-0)
                                   (run-gified-get-geval-thm-correct))
@@ -726,9 +746,9 @@
             :in-theory (disable ev-function-clause-correct-for-run-gified-ev)))))
 
 (in-theory (disable run-gified-get-eval-thm))
-               
-             
-                  
+
+
+
 (defun nths-matching-formalsp (acl2::idx formals acl2::varname list)
   (declare (xargs :measure (acl2-count formals)))
   (if (atom formals)
@@ -757,10 +777,10 @@
 
 
 (in-theory (disable nths-matching-formalsp))
-    
 
 
-                       
+
+
 
 
 
@@ -793,34 +813,42 @@
 
 
 
-(defun geval-car-cdr-of-gobj-listp-thm (geval rune)
-  `((not (use-by-hint ',rune))
-    (not (gobj-listp x))
-    (if (equal (car (,geval x env))
-               (,geval (car x) env))
-        (equal (cdr (,geval x env))
-               (,geval (cdr x) env))
-      'nil)))
+(defun geval-list-def-thm (geval-list geval)
+  `((not (use-by-hint ',geval-list))
+    (equal (,geval-list x env)
+           (if (atom x)
+               'nil
+             (cons (,geval (car x) env)
+                   (,geval-list (cdr x) env))))))
 
 (local
- (defthm geval-car-cdr-of-gobj-listp-thm-correct
+ (defthm geval-list-def-thm-correct
    (implies (and (run-gified-ev-theoremp
-                  (disjoin (geval-car-cdr-of-gobj-listp-thm
-                            geval rune)))
+                  (disjoin (geval-list-def-thm
+                            geval-list geval)))
                  ;;    (gobjectp (run-gified-ev x a))
                  ;;                 (or (atom (run-gified-ev x a))
                  ;;                     (gobjectp (car (run-gified-ev x a))))
-                 (gobj-listp (run-gified-ev x a))
-                 (not (equal geval 'quote)))
-            (and (equal (car (run-gified-ev (list geval x env) a))
-                        (run-gified-ev (list geval `(car ,x) env) a))
-                 (equal (cdr (run-gified-ev (list geval x env) a))
-                        (run-gified-ev (list geval `(cdr ,x) env) a))))
+                 (not (equal geval 'quote))
+                 (not (equal geval-list 'quote)))
+            (and (implies (atom (run-gified-ev x a))
+                          (equal (run-gified-ev (list geval-list x env) a)
+                                 nil))
+                 (implies (consp (run-gified-ev x a))
+                          (equal (run-gified-ev (list geval-list x env) a)
+                                 (cons (run-gified-ev (list geval
+                                                            (kwote (car (run-gified-ev x a)))
+                                                            (kwote (run-gified-ev env a)))
+                                                      nil)
+                                       (run-gified-ev (list geval-list
+                                                            (kwote (cdr (run-gified-ev x a)))
+                                                            (kwote (run-gified-ev env a)))
+                                                      nil))))))
    :hints(("Goal" :in-theory (enable use-by-hint run-gified-ev-constraint-0
-                                     geval-car-cdr-of-gobj-listp-thm)
+                                     geval-list-def-thm)
            :use ((:instance run-gified-ev-falsify
-                            (x (disjoin (geval-car-cdr-of-gobj-listp-thm
-                                         geval rune)))
+                            (x (disjoin (geval-list-def-thm
+                                         geval-list geval)))
                             (a `((x . ,(run-gified-ev x a))
                                  (env . ,(run-gified-ev env a))))))))))
 
@@ -829,12 +857,12 @@
 ;;                 (natp n) (< 0 n))
 ;;            (or (atom x) (gobjectp (car x))))
 ;;   :rule-classes nil)
-           
 
 
-;; (defthm geval-car-cdr-of-gobj-listp-thm-correct-corollary
+
+;; (defthm geval-geval-list-def-thm-correct-corollary
 ;;   (implies (and (run-gified-ev-theoremp
-;;                  (disjoin (geval-car-cdr-of-gobj-listp-thm
+;;                  (disjoin (geval-geval-list-def-thm
 ;;                            geval rune)))
 ;;                 (gobjectp (run-gified-ev x a))
 ;;                 (gobj-listp (acl2::simple-take n (run-gified-ev x a)))
@@ -844,17 +872,17 @@
 ;;                        (run-gified-ev (list geval `(car ,x) env) a))
 ;;                 (equal (cdr (run-gified-ev (list geval x env) a))
 ;;                        (run-gified-ev (list geval `(cdr ,x) env) a))))
-;;   :hints(("Goal" :use (geval-car-cdr-of-gobj-listp-thm-correct
+;;   :hints(("Goal" :use (geval-geval-list-def-thm-correct
 ;;                        (:instance gobj-listp-simple-take-implies
 ;;                                   (x (run-gified-ev x a))))
-;;           :in-theory (disable geval-car-cdr-of-gobj-listp-thm
-;;                               geval-car-cdr-of-gobj-listp-thm-correct)
+;;           :in-theory (disable geval-geval-list-def-thm
+;;                               geval-geval-list-def-thm-correct)
 ;;           :do-not-induct t))
 ;;   :rule-classes ((:rewrite :backchain-limit-lst (0 nil 0 nil nil nil))))
 
-;; (defthm geval-car-cdr-of-gobj-listp-thm-correct-corollary2
+;; (defthm geval-geval-list-def-thm-correct-corollary2
 ;;   (implies (and (run-gified-ev-theoremp
-;;                  (disjoin (geval-car-cdr-of-gobj-listp-thm
+;;                  (disjoin (geval-geval-list-def-thm
 ;;                            geval rune)))
 ;;                 (gobj-listp (run-gified-ev x a))
 ;;                 (not (equal geval 'quote)))
@@ -862,41 +890,41 @@
 ;;                        (run-gified-ev (list geval `(car ,x) env) a))
 ;;                 (equal (cdr (run-gified-ev (list geval x env) a))
 ;;                        (run-gified-ev (list geval `(cdr ,x) env) a))))
-;;   :hints(("Goal" :use geval-car-cdr-of-gobj-listp-thm-correct
+;;   :hints(("Goal" :use geval-geval-list-def-thm-correct
 ;;           :in-theory (e/d (gobj-listp-impl-gobjectp)
-;;                           (geval-car-cdr-of-gobj-listp-thm
-;;                            geval-car-cdr-of-gobj-listp-thm-correct))
+;;                           (geval-geval-list-def-thm
+;;                            geval-geval-list-def-thm-correct))
 ;;           :do-not-induct t))
 ;;   :rule-classes ((:rewrite :backchain-limit-lst (0 1 nil))))
 
-(defun geval-consp-when-gobj-listp-thm (geval rune)
-  `((not (use-by-hint ',rune))
-    ;; (not (gobjectp x))
-;;     (not (if (consp x)
-;;              (gobjectp (car x))
-;;            't))
-    (not (gobj-listp x))
-    (equal (consp (,geval x env))
-           (consp x))))
-
-(local
- (defthm geval-consp-when-gobj-listp-thm-correct
-   (implies (and (run-gified-ev-theoremp
-                  (disjoin (geval-consp-when-gobj-listp-thm
-                            geval rune)))
-                 ;; (gobjectp (run-gified-ev x a))
-                 ;;                 (or (atom (run-gified-ev x a))
-                 ;;                     (gobjectp (car (run-gified-ev x a))))
-                 (gobj-listp (run-gified-ev x a))
-                 (not (equal geval 'quote)))
-            (equal (consp (run-gified-ev (list geval x env) a))
-                   (consp (run-gified-ev x a))))
-   :hints(("Goal" :in-theory (enable use-by-hint run-gified-ev-constraint-0)
-           :use ((:instance run-gified-ev-falsify
-                            (x (disjoin (geval-consp-when-gobj-listp-thm
-                                         geval rune)))
-                            (a `((x . ,(run-gified-ev x a))
-                                 (env . ,(run-gified-ev env a))))))))))
+;; (defun geval-consp-when-gobj-listp-thm (geval rune)
+;;   `((not (use-by-hint ',rune))
+;;     ;; (not (gobjectp x))
+;; ;;     (not (if (consp x)
+;; ;;              (gobjectp (car x))
+;; ;;            't))
+;;     (not (gobj-listp x))
+;;     (equal (consp (,geval x env))
+;;            (consp x))))
+
+;; (local
+;;  (defthm geval-consp-when-gobj-listp-thm-correct
+;;    (implies (and (run-gified-ev-theoremp
+;;                   (disjoin (geval-consp-when-gobj-listp-thm
+;;                             geval rune)))
+;;                  ;; (gobjectp (run-gified-ev x a))
+;;                  ;;                 (or (atom (run-gified-ev x a))
+;;                  ;;                     (gobjectp (car (run-gified-ev x a))))
+;;                  (gobj-listp (run-gified-ev x a))
+;;                  (not (equal geval 'quote)))
+;;             (equal (consp (run-gified-ev (list geval x env) a))
+;;                    (consp (run-gified-ev x a))))
+;;    :hints(("Goal" :in-theory (enable use-by-hint run-gified-ev-constraint-0)
+;;            :use ((:instance run-gified-ev-falsify
+;;                             (x (disjoin (geval-consp-when-gobj-listp-thm
+;;                                          geval rune)))
+;;                             (a `((x . ,(run-gified-ev x a))
+;;                                  (env . ,(run-gified-ev env a))))))))))
 
 ;; (defthm geval-consp-when-gobj-listp-thm-correct-corollary
 ;;   (implies (and (run-gified-ev-theoremp
@@ -950,8 +978,7 @@
                             (a `((env . ,(run-gified-ev env a))))))))))
 
 
-(in-theory (disable geval-consp-when-gobj-listp-thm
-                    geval-car-cdr-of-gobj-listp-thm
+(in-theory (disable geval-list-def-thm
                     geval-of-nil-thm))
 
 (local
@@ -964,7 +991,7 @@
    (defun make-n-cdrs (n term)
      (if (zp n)
          term
-       (list 'cdr (make-n-cdrs (1- n) term))))
+       (make-n-cdrs (1- n) (list 'cdr term))))
 
 
    (local (defthm cdr-nthcdr
@@ -985,7 +1012,7 @@
                                 `((args . ,args) (a . ,a))
                                 'acl2::? nil mfc state)
                  args)))
-                 
+
 
    (defthmd my-run-gified-ev-constraint-0
      (implies (and (syntaxp (test-constraint-0-result args a mfc state))
@@ -1005,12 +1032,13 @@
      (implies (and (gobj-listp lst)
                    (nthcdr n lst))
               (consp (nthcdr n lst)))
-     :hints(("Goal" :in-theory (enable gobj-listp))))
+     :hints(("Goal" :in-theory (e/d (gobj-listp)))))
 
    (defthm gobj-listp-nthcdr
      (implies (gobj-listp lst)
               (gobj-listp (nthcdr n lst)))
-     :hints(("Goal" :in-theory (enable gobj-listp))))
+     :hints(("Goal" :in-theory (e/d (gobj-listp)
+                                    (cdr-nthcdr)))))
 
    (defthm gobj-listp-take
      (implies (gobj-listp gobj)
@@ -1028,7 +1056,7 @@
                    (< (nfix n) (nfix m)))
               (gobj-listp (acl2::take n gobj)))
      :hints (("goal" :induct (count-down2-cdr m n gobj)
-              :in-theory (enable gobj-listp acl2::take-redefinition))))
+              :in-theory (enable gobj-listp acl2::take-redefinition nfix))))
 
    ;; (Defthm gobjectp-nth-when-gobj-listp-take
    ;;   (implies (and (gobj-listp (acl2::take m x))
@@ -1047,63 +1075,51 @@
               (equal (cdr x) nil))
      :rule-classes ((:rewrite :backchain-limit-lst 0)))
 
+   (defthm nthcdr-when-not-consp
+     (implies (and (not (consp x))
+                   (not (zp n)))
+              (equal (nthcdr n x) nil)))
+
+   (defthm nthcdr-of-cons
+     (implies (not (zp n))
+              (equal (nthcdr n (cons a b))
+                     (nthcdr (+ -1 n) b))))
 
-   (defthm nthcdr-run-gified-of-geval
+   (defthm nthcdr-run-gified-of-geval-list
      (implies (and (run-gified-ev-theoremp
-                    (disjoin (geval-consp-when-gobj-listp-thm
-                              gevalfn geval-consp)))
-                   (run-gified-ev-theoremp
-                    (disjoin (geval-car-cdr-of-gobj-listp-thm
-                              gevalfn geval-car-cdr)))
-                   (not (equal gevalfn 'quote))
-                   (gobj-listp (run-gified-ev args a))
+                    (disjoin (geval-list-def-thm
+                              geval-list geval)))
+                   (not (equal geval 'quote))
+                   (not (equal geval-list 'quote))
                    ;; (acl2::take n (run-gified-ev args a))
                    )
               (equal
-               (nthcdr n (run-gified-ev (list gevalfn args env) a))
-               (run-gified-ev (list gevalfn (make-n-cdrs n args) env) a)))
-     :hints(("Goal" :in-theory (e/d (my-run-gified-ev-constraint-0) (nthcdr nth))
-             :induct (make-n-cdrs n args))
-            (and stable-under-simplificationp
-                 (cond
-                  ((member-equal '(zp n) clause)
-                   '(:use ((:instance geval-car-cdr-of-gobj-listp-thm-correct
-                                      (geval gevalfn)
-                                      (x (list 'quote (run-gified-ev args a)))
-                                      (env (list 'quote (run-gified-ev env a)))
-                                      (a nil)
-                                      (rune geval-car-cdr))
-                           (:instance geval-car-cdr-of-gobj-listp-thm-correct
-                                      (geval gevalfn)
-                                      (x (list 'quote
-                                               (nthcdr (+ -1 n)
-                                                       (run-gified-ev args a))))
-                                      (env (list 'quote (run-gified-ev env a)))
-                                      (a nil)
-                                      (rune geval-car-cdr)))
-                          :in-theory (e/d (my-run-gified-ev-constraint-0)
-                                          (geval-car-cdr-of-gobj-listp-thm-correct
-                                           nthcdr nth))))
-                  ((member-equal '(not (zp n)) clause)
-                   '(:in-theory (e/d (nthcdr) (nth))))))))
+               (nthcdr n (run-gified-ev (list geval-list args env) a))
+               (run-gified-ev (list geval-list (make-n-cdrs n args) env) a)))
+     :hints(("Goal" :in-theory (e/d (my-run-gified-ev-constraint-0)
+                                    (nthcdr nth))
+             :induct (make-n-cdrs n args)
+             :expand ((:free (x) (nthcdr 0 x))))))
 
 
    (defthm nth-run-gified-of-geval
      (implies (and (run-gified-ev-theoremp
-                    (disjoin (geval-consp-when-gobj-listp-thm
-                              gevalfn geval-consp)))
+                    (disjoin (geval-list-def-thm
+                              geval-list geval)))
                    (run-gified-ev-theoremp
-                    (disjoin (geval-car-cdr-of-gobj-listp-thm
-                              gevalfn geval-car-cdr)))
-                   (not (equal gevalfn 'quote))
-                   (gobj-listp (run-gified-ev args a)))
+                    (disjoin (geval-of-nil-thm
+                              geval geval-nil)))
+                   (not (equal geval 'quote))
+                   (not (equal geval-list 'quote)))
               (equal
-               (nth n (run-gified-ev (list gevalfn args env) a))
-               (run-gified-ev (list gevalfn (list 'car (make-n-cdrs n args)) env) a)))
+               (nth n (run-gified-ev (list geval-list args env) a))
+               (run-gified-ev (list geval (list 'car (make-n-cdrs n args)) env) a)))
      :hints(("Goal" :use ((:instance
                            car-nthcdr
                            (a (run-gified-ev (list gevalfn args env) a))))
-             :in-theory (disable car-nthcdr))))
+             :in-theory (e/d (run-gified-ev-constraint-0)
+                             (car-nthcdr acl2::car-nthcdr))
+             :cases ((consp (run-gified-ev args a))))))
 
    (defthm run-gified-ev-lst-kwote-lst
      (equal (run-gified-ev-lst (acl2::kwote-lst x) a)
@@ -1169,25 +1185,21 @@
                (run-gified-ev-theoremp
                 (disjoin (acl2::ev-lookup-var-clause evalfn var-name)))
                (run-gified-ev-theoremp
-                (disjoin (geval-consp-when-gobj-listp-thm
-                          gevalfn geval-consp)))
+                (disjoin (geval-list-def-thm
+                          geval-list gevalfn)))
                (run-gified-ev-theoremp
                 (disjoin (geval-of-nil-thm
                           gevalfn geval-nil)))
-               (run-gified-ev-theoremp
-                (disjoin (geval-car-cdr-of-gobj-listp-thm
-                          gevalfn geval-car-cdr)))
                (not (equal gevalfn 'quote))
-               (not (equal evalfn 'quote))
-               ;; (gobj-listp (acl2::take n actuals))
-               (gobj-listp actuals))
+               (not (equal geval-list 'quote))
+               (not (equal evalfn 'quote)))
               (equal (run-gified-ev-lst
                       (acl2::ev-apply-arglist-on-result
                        n
                        evalfn
                        (acl2::kwote-lst
                         (run-gified-ev
-                         (list gevalfn
+                         (list geval-list
                                (list 'quote actuals)
                                env)
                          nil))
@@ -1201,9 +1213,9 @@
                          actuals))
                        gevalfn env)
                       nil)))
-     :hints(("Goal" 
+     :hints(("Goal"
              :induct t
-             :in-theory (enable gobj-listp acl2::take-redefinition)
+             :in-theory (enable acl2::take-redefinition)
              :expand ((:free (a b c)
                              (acl2::ev-apply-arglist-on-result
                               n a b c))))
@@ -1241,7 +1253,7 @@
 
    (defthm get-geval-thm-success-impl-len
      (implies (not (mv-nth 0 (run-gified-get-geval-thm gfn fn geval-alist geval)))
-              (<= 2 (len (mv-nth 2 (run-gified-get-geval-thm gfn fn geval-alist
+              (<= 5 (len (mv-nth 2 (run-gified-get-geval-thm gfn fn geval-alist
                                                              geval)))))
      :hints(("Goal" :in-theory (enable run-gified-get-geval-thm
                                        run-gified-check-geval-thm)))
@@ -1270,17 +1282,19 @@
          ((unless (equal (len args) (len formals)))
           (mv "The number of arguments doesn't match." nil))
          ((mv erp eval-thm)
-          (run-gified-get-eval-thm fnname (take (- (len formals) 2) formals)
+          (run-gified-get-eval-thm fnname (take (- (len formals) 5) formals)
                                    evalfn eval-alist))
          ((when erp) (mv erp nil))
-         ((unless (and (nths-matching-formalsp 0 (take (- (len formals) 2) formals)
+         ((unless (and (nths-matching-formalsp 0 (take (- (len formals) 5) formals)
                                                'actuals
-                                               (take (- (len formals) 2) args))
-                       (equal (nthcdr (- (len formals) 2) args) '(hyp clk))))
+                                               (take (- (len formals) 5) args))
+                       (equal (nthcdr (- (len formals) 5) args) '(hyp clk
+                                                                      config
+                                                                      bvar-db state))))
           (mv (acl2::msg "Malformed function args: ~x0" (caddr body))
               nil))
          (clauses (list* geval-thm eval-thm clauses)))
-      (mv nil clauses))))                                  
+      (mv nil clauses))))
 
 #!ACL2
 (progn
@@ -1303,7 +1317,7 @@
     access
     `(b* ,(access-b*-bindings (car args) (car forms) (cdr args))
        ,rest-expr)))
-                     
+
 
 (defun ev-constraint-for-search (lemmas hyp-terms ev-term)
   (if (atom lemmas)
@@ -1319,8 +1333,8 @@
           rune
         (ev-constraint-for-search
          (cdr lemmas) hyp-terms ev-term)))))
-         
-           
+
+
 
 
 (defun ev-constraint-for-fn (ev fn world)
@@ -1330,13 +1344,13 @@
 
 (defmacro ev-constraint-for (ev fn)
   `(ev-constraint-for-fn ',ev ',fn world))
-       
+
 
 (local
  (encapsulate nil
 
    (local
-    (in-theory (disable geval-consp-when-gobj-listp-thm-correct
+    (in-theory (disable
                         cheap-default-car cheap-default-cdr acl2::take-redefinition
                         ev-quote-clause-correct-for-run-gified-ev
                         ev-lookup-var-clause-correct-for-run-gified-ev
@@ -1368,14 +1382,14 @@
                         (:REWRITE RUN-GIFIED-EV-CONSTRAINT-3)
                         (:REWRITE ACL2::SYMBOLP-ASSOC-EQUAL)
                         (:DEFINITION ACL2::LIST-FIX)
-                        (:REWRITE GEVAL-CAR-CDR-OF-GOBJ-LISTP-THM-CORRECT)
+                        (:REWRITE GEVAL-LIST-DEF-THM-CORRECT)
                         (:DEFINITION SYMBOL-LISTP)
                         (:REWRITE CHEAP-DEFAULT-CDR)
                         (:TYPE-PRESCRIPTION SYMBOL-LISTP))))
    (local
     (in-theory (set-difference-theories
                 (current-theory :here)
-                (list (EV-CONSTRAINT-FOR RUN-GIFIED-EV GOBJ-LISTP)
+                (list ; (EV-CONSTRAINT-FOR RUN-GIFIED-EV GOBJ-LISTP)
                       (EV-CONSTRAINT-FOR RUN-GIFIED-EV BFR-EVAL)
                       (EV-CONSTRAINT-FOR RUN-GIFIED-EV FORCE)
                       (EV-CONSTRAINT-FOR RUN-GIFIED-EV MV-LIST)
@@ -1408,26 +1422,23 @@
                      (run-gified-ev-theoremp
                       (disjoin (acl2::ev-lookup-var-clause evalfn var-name)))
                      (run-gified-ev-theoremp
-                      (disjoin (geval-consp-when-gobj-listp-thm
-                                gevalfn geval-consp)))
-                     (run-gified-ev-theoremp
-                      (disjoin (geval-car-cdr-of-gobj-listp-thm
-                                gevalfn geval-car-cdr)))
+                      (disjoin (geval-list-def-thm
+                                geval-list gevalfn)))
                      (run-gified-ev-theoremp
                       (disjoin (geval-of-nil-thm
                                 gevalfn geval-nil)))
                      (not (equal evalfn 'quote))
                      (not (equal gevalfn 'quote))
+                     (not (equal geval-list 'quote))
                      (mv-nth 0 (run-gified-ev body a))
                      (bfr-eval (cdr (assoc-equal 'hyp a))
-                               (cadr (assoc-equal 'env a)))
-                     (gobj-listp (cdr (assoc-equal 'actuals a))))
-                (equal (run-gified-ev 
+                               (cadr (assoc-equal 'env a))))
+                (equal (run-gified-ev
                         `(,gevalfn (mv-nth '1 ,body) env)
                         a)
                        (run-gified-ev
                         `(,evalfn (cons fn (acl2::kwote-lst
-                                            (,gevalfn actuals env)))
+                                            (,geval-list actuals env)))
                                   'nil)
                         a))))
      :hints (("goal" :induct (run-gified-process-body body eval-alist evalfn
@@ -1443,15 +1454,15 @@
                            nth-of-nthcdr
                            (n 0)
                            (y (MV-NTH 3 (RUN-GIFIED-CASE-BREAKDOWN BODY)))
-                           (m (+ -2 (LEN (MV-NTH 3 (RUN-GIFIED-CASE-BREAKDOWN
+                           (m (+ -5 (LEN (MV-NTH 3 (RUN-GIFIED-CASE-BREAKDOWN
                                                     BODY))))))
                           (:instance
                            nths-matching-formalsp-make-nths-matching-formals-ev1
-                           (list (ACL2::TAKE (+ -2
+                           (list (ACL2::TAKE (+ -5
                                                        (LEN (MV-NTH 3 (RUN-GIFIED-CASE-BREAKDOWN BODY))))
                                                     (MV-NTH 3 (RUN-GIFIED-CASE-BREAKDOWN BODY))))
                            (formals (ACL2::TAKE
-                                     (+ -2
+                                     (+ -5
                                         (LEN (MV-NTH 3 (RUN-GIFIED-CASE-BREAKDOWN BODY))))
                                      (MV-NTH
                                       2
@@ -1475,50 +1486,44 @@
                    (run-gified-ev-theoremp
                     (disjoin (acl2::ev-lookup-var-clause evalfn var-name)))
                    (run-gified-ev-theoremp
-                    (disjoin (geval-consp-when-gobj-listp-thm
-                              gevalfn geval-consp)))
-                   (run-gified-ev-theoremp
-                    (disjoin (geval-car-cdr-of-gobj-listp-thm
-                              gevalfn geval-car-cdr)))
+                    (disjoin (geval-list-def-thm
+                              geval-list gevalfn)))
                    (run-gified-ev-theoremp
                     (disjoin (geval-of-nil-thm
                               gevalfn geval-nil)))
                    (not (equal evalfn 'quote))
                    (not (equal gevalfn 'quote))
+                   (not (equal geval-list 'quote))
                    (mv-nth 0 (run-gified-ev body a))
                    (bfr-eval (cdr (assoc-equal 'hyp a))
-                             (cadr (assoc-equal 'env a)))
-                   (gobj-listp (cdr (assoc-equal 'actuals a))))
-              (equal (run-gified-ev 
+                             (cadr (assoc-equal 'env a))))
+              (equal (run-gified-ev
                       (list gevalfn
                             (list 'quote (mv-nth 1 (run-gified-ev body a)))
                             (list 'quote (cdr (assoc-equal 'env a))))
                       nil)
                      (run-gified-ev
                       `(,evalfn (cons fn (acl2::kwote-lst
-                                          (,gevalfn actuals env)))
+                                          (,geval-list actuals env)))
                                 'nil)
                       a))))
    :hints(("Goal" :in-theory (e/d (run-gified-ev-constraint-0)
                                   (run-gified-process-body-correct))
            :use ((:instance run-gified-process-body-correct))))))
-   
 
 
 
 
-(defun run-gified-clause-proc (clause hints state)
+
+(defun run-gified-clause-proc (clause geval-nil state)
   (declare ; (ignore hints)
            (xargs :stobjs state
                   :verify-guards nil))
-  (b* (((list geval-consp geval-car-cdr geval-nil) hints)
-       ((mv ok subst)
+  (b* (((mv ok subst)
         (acl2::simple-one-way-unify-lst
          '((implies
             (if (bfr-eval hyp (car env))
-                (if (gobj-listp actuals)
-                    okp-term
-                  'nil)
+                okp-term
               'nil)
             (equal lhs-term rhs-term)))
          clause nil))
@@ -1526,8 +1531,7 @@
                                    clause)
                         nil state))
        ((unless (and (eq (cdr (assoc-equal 'hyp subst)) 'hyp)
-                     (eq (cdr (assoc-equal 'env subst)) 'env)
-                     (eq (cdr (assoc-equal 'actuals subst)) 'actuals)))
+                     (eq (cdr (assoc-equal 'env subst)) 'env)))
         (mv "Clause variables are different than expected" nil state))
        (lhs (cdr (assoc-equal 'lhs-term subst)))
        (rhs (cdr (assoc-equal 'rhs-term subst)))
@@ -1539,13 +1543,15 @@
         (mv "The geval function is QUOTE which is silly." nil state))
        ((when (equal run-gified-fn 'quote))
         (mv "The run-gified function is QUOTE which is silly." nil state))
-       ((mv erp ev-fn)
-        (run-gified-rhs-breakdown rhs geval-fn))
+       ((mv erp ev-fn geval-list-fn)
+        (run-gified-rhs-breakdown rhs))
+       ((when (eq geval-list-fn 'quote))
+        (mv "The geval-list function is QUOTE which is silly." nil state))
        ((when erp) (mv erp nil state))
        (world (w state))
        (body (acl2::body run-gified-fn nil world))
        (body-clause (function-def-clause run-gified-fn run-gified-fn
-                                         '(fn actuals hyp clk state)
+                                         '(fn actuals hyp clk config bvar-db state)
                                          body))
        ((when (eq ev-fn 'quote))
         (mv "The eval function is QUOTE which is silly."
@@ -1564,8 +1570,7 @@
              ev-fn (cdr (hons-get :quote eval-rule-alist)))
             (acl2::ev-lookup-var-clause
              ev-fn (cdr (hons-get :lookup-var eval-rule-alist)))
-            (geval-consp-when-gobj-listp-thm geval-fn geval-consp)
-            (geval-car-cdr-of-gobj-listp-thm geval-fn geval-car-cdr)
+            (geval-list-def-thm geval-list-fn geval-fn)
             (geval-of-nil-thm geval-fn geval-nil)
             body-clause
             clauses))))
@@ -1580,7 +1585,7 @@
 
 (local
  (encapsulate nil
-   (local 
+   (local
 
     (defun cdr-down2 (a b)
       (if (atom a)
@@ -1615,33 +1620,31 @@
                                                          (acl2::simple-one-way-unify-lst
                                                           template term alist))
                                                  a)))))))))
-
-
 (local
  (defthm run-gified-lhs-and-okp-breakdown-correct-eval
    (mv-let (erp geval run-gified)
      (run-gified-lhs-and-okp-breakdown lhs okp)
      (implies (not erp)
               (and (equal (run-gified-ev lhs a)
-                          (run-gified-ev 
-                           `(,geval (mv-nth '1 (,run-gified fn actuals hyp clk state))
+                          (run-gified-ev
+                           `(,geval (mv-nth '1 (,run-gified fn actuals hyp clk config bvar-db state))
                                     env)
                            a))
                    (equal (run-gified-ev okp a)
                           (run-gified-ev
-                           `(mv-nth '0 (,run-gified fn actuals hyp clk state))
+                           `(mv-nth '0 (,run-gified fn actuals hyp clk config bvar-db state))
                            a)))))
    :hints (("goal" :use run-gified-lhs-and-okp-breakdown-correct
             :in-theory (disable run-gified-lhs-and-okp-breakdown-correct)))))
 
 (local
  (defthm run-gified-rhs-breakdown-correct-eval
-   (mv-let (erp evfn)
-     (run-gified-rhs-breakdown rhs geval-fn)
+   (mv-let (erp evfn geval-list-fn)
+     (run-gified-rhs-breakdown rhs)
      (implies (not erp)
               (equal (run-gified-ev rhs a)
                      (run-gified-ev
-                      `(,evfn (cons fn (acl2::kwote-lst (,geval-fn actuals env)))
+                      `(,evfn (cons fn (acl2::kwote-lst (,geval-list-fn actuals env)))
                               'nil)
                       a))))))
 
@@ -1653,7 +1656,7 @@
  (in-theory (disable acl2::ev-collect-apply-lemmas body table-alist w)))
 
 (local (in-theory (disable run-gified-process-body assoc-equal)))
-
+(local (in-theory (disable SIMPLE-ONE-WAY-UNIFY-LST-WITH-RUN-GIFIED-EV)))
 (defthm run-gified-clause-proc-correct
   (implies (and (pseudo-term-listp clause)
                 (alistp a)
@@ -1687,9 +1690,11 @@
                                . run-gified-fn))))
                   '(:clause-processor
                     (acl2::simple-generalize-cp
-                     clause '(((MV-NTH '1 (RUN-GIFIED-RHS-BREAKDOWN
-                                           RHS GEVAL-FN)) . evalfn)
-                              
+                     clause '(((MV-NTH '1 (RUN-GIFIED-RHS-BREAKDOWN RHS))
+                               . evalfn)
+                              ((MV-NTH '2 (RUN-GIFIED-RHS-BREAKDOWN RHS))
+                               . geval-list-fn)
+
                               ((MV-NTH '1
                                        (GEVAL-RULE-ALIST (TABLE-ALIST 'GL-FUNCTION-INFO
                                                                       (W STATE))
@@ -1702,7 +1707,7 @@
                   '(:use ((:instance run-gified-ev-falsify
                                      (x (disjoin (function-def-clause
                                                   run-gified-fn run-gified-fn
-                                                  '(fn actuals hyp clk state)
+                                                  '(fn actuals hyp clk config bvar-db state)
                                                   (body run-gified-fn nil (w
                                                                            state)))))
                                      (a a)))
@@ -1711,8 +1716,7 @@
                  (acl2::simple-generalize-cp
                   clause '(((MV-NTH '1 (ACL2::SIMPLE-ONE-WAY-UNIFY-LST
                                         '((IMPLIES (IF (BFR-EVAL HYP (CAR ENV))
-                                                       (IF (GOBJ-LISTP ACTUALS)
-                                                           OKP-TERM 'NIL)
+                                                       OKP-TERM
                                                        'NIL)
                                                    (EQUAL LHS-TERM RHS-TERM)))
                                         CLAUSE 'NIL)) . subst))))))
diff -Nru acl2-6.2/books/centaur/gl/rws.lisp acl2-6.3/books/centaur/gl/rws.lisp
--- acl2-6.2/books/centaur/gl/rws.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/rws.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,14 +1,33 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
 (include-book "clause-processors/use-by-hint" :dir :system)
 (include-book "clause-processors/multi-env-trick" :dir :system)
 (include-book "tools/bstar" :dir :system)
 (include-book "tools/mv-nth" :dir :system)
 (include-book "tools/flag" :dir :system)
 (include-book "tools/rulesets" :dir :system)
-(include-book "centaur/misc/equal-sets" :dir :system)
-(include-book "centaur/misc/alist-equiv" :dir :system)
+(include-book "misc/hons-help" :dir :system)
+(local (include-book "centaur/misc/equal-sets" :dir :system))
+(local (include-book "centaur/misc/alist-equiv" :dir :system))
 
 
 ;;; What does 'rws' abbreviate, in anything, asks Boyer???
@@ -169,7 +188,7 @@
        nil
      (hons (beta-reduce-term (car x))
            (beta-reduce-list (cdr x))))))
-   
+
 
 (flag::make-flag beta-reduce-flag beta-reduce-term)
 
@@ -432,7 +451,7 @@
                           used
                         (hons-acons rule t used))))
              (mv ans (hons-acons x ans mem) used)))))))
- 
+
  (defun term-rw-lst (x rws mem used)
    (declare (xargs :guard (and (pseudo-term-listp x)
                                (term-rw-mem-wfp mem)
@@ -464,7 +483,7 @@
                 ((mv ans rule) (fncall-rewrite (cons (car x) args) rws))
                 (used (if (hons-get rule used) used (hons-acons rule t used))))
              (mv ans (hons-acons x ans mem) used)))))))
- 
+
  (defun term-rw-lst-indep-ind (x rws mem used)
    (declare (xargs :guard (and (pseudo-term-listp x)
                                (term-rw-mem-wfp mem)
@@ -505,7 +524,7 @@
   (implies (and (term-rw-mem-wfp mem)
                 (hons-assoc-equal x mem))
            (pseudo-termp (cdr (hons-assoc-equal x mem)))))
-      
+
 
 (defthm-term-rw-ind len-term-rw-lst1
   (term-rw t :skip t)
@@ -699,14 +718,9 @@
         (cons (cdr (hons-get (caar used) used-al))
               (used-and-used-al-to-alist-lists (cdr used) used-al))
       (used-and-used-al-to-alist-lists (cdr used) used-al))))
-          
-
-(acl2::def-multi-env-fns dumb-ev dumb-ev-lst)
 
-(defmacro alist-keys (x)
-  `(acl2::alist-keys ,x))
 
-(add-macro-alias alist-keys acl2::alist-keys)
+(acl2::def-multi-env-fns dumb-ev dumb-ev-lst)
 
 (defun alists-apply-alists-dumb-ev (used-al)
   (let ((used (used-al-to-used used-al)))
@@ -893,7 +907,7 @@
                           (dumb-ev-lst x a)))))
    :hints (("goal" :use ((:instance term-rw-lst-correct (used-al nil)))
             :in-theory (e/d** (used-al-to-used)))))
-                 
+
 
 
 (defthm fncall-rewrite-if
@@ -956,7 +970,7 @@
                               used-al-to-used
                               used-al-to-used-term-rw-term-rw-alist-lst
                               term-rw-mem-wfp)))))
-  
+
 
 (local (defun or-list (x)
          (if (atom x)
@@ -1011,15 +1025,11 @@
          (list* (cadr eq)
                 (caddr eq)
                 name))))
-    
 
 
 
-(defun rws-from-ruleset-fn (runes world)
-
-; What is the reason for this switch over to program mode?  Who did
-; it?????  Asks Boyer.
 
+(defun rws-from-ruleset-fn (runes world)
   (declare (xargs :mode :program))
   (if (atom runes)
       nil
diff -Nru acl2-6.2/books/centaur/gl/shape-spec-defs.lisp acl2-6.3/books/centaur/gl/shape-spec-defs.lisp
--- acl2-6.2/books/centaur/gl/shape-spec-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/shape-spec-defs.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,652 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "gobject-types")
+(include-book "symbolic-arithmetic-fns")
+
+; Modified slightly 12/4/2012 by Matt K. to be redundant with new ACL2
+; definition.
+(defund nat-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (eq l nil))
+        (t (and (natp (car l))
+                (nat-listp (cdr l))))))
+
+
+;; An shape spec is an object that is similar to a g object, but a) where there
+;; would be BDDs in a g object, there are natural numbers in an shape spec, and
+;; b) no G-APPLY constructs are allowed in an shape spec.
+
+(defund number-specp (nspec)
+  (declare (xargs :guard t))
+  (and (consp nspec)
+       (nat-listp (car nspec))
+       (if (atom (cdr nspec))
+           (not (cdr nspec))
+         (and (nat-listp (cadr nspec))
+              (if (atom (cddr nspec))
+                  (not (cddr nspec))
+                (and (nat-listp (caddr nspec))
+                     (if (atom (cdddr nspec))
+                         (not (cdddr nspec))
+                         (and (nat-listp (cadddr nspec))
+                              (not (cddddr nspec))))))))))
+
+
+(defagg g-integer (sign bits var))
+(defagg g-integer? (sign bits var intp))
+(defagg g-call (fn args inverse))
+
+(defund ss-unary-functionp (x)
+  (declare (xargs :guard t))
+  (and (not (eq x 'quote))
+       (or (symbolp x)
+           (and (consp x)
+                (eq (car x) 'lambda)
+                (consp (cdr x))
+                (symbol-listp (cadr x))
+                (eql (len (cadr x)) 1)
+                (consp (cddr x))
+                (pseudo-termp (caddr x))
+                (not (cdddr x))))))
+
+
+
+(mutual-recursion
+ (defun shape-specp (x)
+   (declare (xargs :guard t
+                   :measure (acl2-count x)))
+   (if (atom x)
+       (and (not (g-keyword-symbolp x))
+            (not (member x '(:g-integer :g-integer? :g-call))))
+     (case (tag x)
+       (:g-number (number-specp (g-number->num x)))
+       (:g-integer (and (natp (g-integer->sign x))
+                        (nat-listp (g-integer->bits x))))
+       (:g-integer? (and (natp (g-integer?->sign x))
+                         (nat-listp (g-integer?->bits x))
+                         (natp (g-integer?->intp x))))
+       (:g-boolean (natp (g-boolean->bool x)))
+       (:g-concrete t)
+       (:g-var t)
+       (:g-ite
+        (and (shape-specp (g-ite->test x))
+             (shape-specp (g-ite->then x))
+             (shape-specp (g-ite->else x))))
+       (:g-apply nil)
+       (:g-call (and (symbolp (g-call->fn x))
+                     (not (eq (g-call->fn x) 'quote))
+                     (shape-spec-listp (g-call->args x))
+                     (ss-unary-functionp (g-call->inverse x))))
+       (otherwise (and (shape-specp (car x))
+                       (shape-specp (cdr x)))))))
+ (defun shape-spec-listp (x)
+   (declare (xargs :guard t
+                   :measure (acl2-count x)))
+   (if (atom x)
+       (eq x nil)
+     (and (shape-specp (car x))
+          (shape-spec-listp (cdr x))))))
+
+(in-theory (disable shape-specp shape-spec-listp))
+
+
+
+(mutual-recursion
+ (defun shape-spec-ind (x)
+   (if (atom x)
+       x
+     (case (tag x)
+       ((:g-number :g-integer :g-integer? :g-boolean :g-concrete :g-var) x)
+       (:g-ite (list (shape-spec-ind (g-ite->test x))
+                     (shape-spec-ind (g-ite->then x))
+                     (shape-spec-ind (g-ite->else x))))
+       (:g-call (shape-spec-list-ind (g-call->args x)))
+       (otherwise (list (shape-spec-ind (car x))
+                        (shape-spec-ind (cdr x)))))))
+ (defun shape-spec-list-ind (x)
+   (if (atom x)
+       nil
+     (cons (shape-spec-ind (car x))
+           (shape-spec-list-ind (cdr x))))))
+
+
+(flag::make-flag shape-spec-flag shape-spec-ind
+                 :flag-mapping ((shape-spec-ind . ss)
+                                (shape-spec-list-ind . list)))
+
+
+
+
+(defund shape-spec-obj-in-range-iff (x obj)
+  (declare (xargs :guard (shape-specp x)
+                  :guard-hints(("Goal" :in-theory (enable shape-specp)))))
+  (if (atom x)
+      (iff x obj)
+    (pattern-match x
+      ((g-number &)
+       obj)
+      ((g-integer & & &) obj)
+      ((g-integer? & & & &) t)
+      ((g-boolean &) t)
+      ((g-var &) t)
+      ((g-ite if then else)
+       (or (and (shape-spec-obj-in-range-iff if t)
+                (shape-spec-obj-in-range-iff then obj))
+           (and (shape-spec-obj-in-range-iff if nil)
+                (shape-spec-obj-in-range-iff else obj))))
+      ((g-call & & &) nil)
+      ((g-concrete y) (iff y obj))
+      (& obj))))
+
+(defund integer-in-range (vlist obj)
+  (declare (xargs :guard t))
+  (and (integerp obj)
+       (if (atom vlist)
+           (eql obj 0)
+         (and (<= (- (ash 1 (len (cdr vlist)))) obj)
+              (< obj (ash 1 (len (cdr vlist))))))))
+
+(defund natural-in-range (vlist obj)
+  (declare (xargs :guard t))
+  (and (natp obj)
+       (and (<= 0 obj)
+            (< obj (ash 1 (len vlist))))))
+
+(defund number-spec-in-range (nspec obj)
+  (declare (xargs :guard (number-specp nspec)
+                  :guard-hints(("Goal" :in-theory (enable number-specp)))))
+  (and (acl2-numberp obj)
+       (integer-in-range (car nspec) (numerator (realpart obj)))
+       (if (consp (cdr nspec))
+           (and (natural-in-range (cadr nspec) (denominator (realpart obj)))
+                (if (consp (cddr nspec))
+                    (and (integer-in-range
+                          (caddr nspec) (numerator (imagpart obj)))
+                         (if (consp (cdddr nspec))
+                             (natural-in-range
+                              (cadddr nspec) (denominator (imagpart obj)))
+                           (eql (denominator (imagpart obj)) 1)))
+                  (rationalp obj)))
+         (integerp obj))))
+
+(defund shape-spec-obj-in-range (x obj)
+  (declare (xargs :guard (shape-specp x)
+                  :guard-hints(("Goal" :in-theory (enable shape-specp)))))
+  (if (atom x)
+      (equal x obj)
+    (pattern-match x
+      ((g-number n) (number-spec-in-range n obj))
+      ((g-integer & & &) (integerp obj))
+      ((g-integer? & & & &) t)
+      ((g-boolean &) (booleanp obj))
+      ((g-var &) t)
+      ((g-concrete y) (equal y obj))
+      ((g-ite if then else)
+       (or (and (shape-spec-obj-in-range-iff if t)
+                (shape-spec-obj-in-range then obj))
+           (and (shape-spec-obj-in-range-iff if nil)
+                (shape-spec-obj-in-range else obj))))
+      ((g-call & & &) nil)
+      (& (and (consp obj)
+              (shape-spec-obj-in-range (car x) (car obj))
+              (shape-spec-obj-in-range (cdr x) (cdr obj)))))))
+
+
+(defun-nx shape-spec-slice-to-env (obj)
+  (mv-let (ok bsl vsl) obj
+    (declare (ignore ok))
+    (cons bsl vsl)))
+
+(defun-nx ss-append-envs (x y)
+  (cons (append (car x) (car y))
+        (append (cdr x) (cdr y))))
+
+
+
+
+
+(defund integer-env-slice (vlist obj)
+  (declare (xargs :guard (and (nat-listp vlist)
+                              (integerp obj))
+                  :guard-hints(("Goal" :in-theory (enable nat-listp)))))
+  (if (atom vlist)
+      (mv (eql obj 0) nil)
+    (if (atom (cdr vlist))
+        (if (eql obj 0)
+            (mv t (list (cons (car vlist) nil)))
+          (mv (eql obj -1) (list (cons (car vlist) t))))
+      (mv-let (rest-ok rest-bslice)
+        (integer-env-slice (cdr vlist) (ash obj -1))
+        (mv rest-ok (cons (cons (car vlist) (logbitp 0 obj)) rest-bslice))))))
+
+(local
+ (defthm true-listp-integer-env-slice
+   (true-listp (mv-nth 1 (integer-env-slice vlist obj)))
+   :hints(("Goal" :in-theory (enable integer-env-slice)))))
+
+(defund natural-env-slice (vlist obj)
+  (declare (xargs :guard (and (nat-listp vlist)
+                              (integerp obj))
+                  :guard-hints(("Goal" :in-theory (enable nat-listp)))))
+  (if (atom vlist)
+      (mv (eql obj 0) nil)
+    (mv-let (rest-ok rest-bslice)
+      (natural-env-slice (cdr vlist) (ash obj -1))
+      (mv rest-ok (cons (cons (car vlist) (logbitp 0 obj)) rest-bslice)))))
+
+(local
+ (defthm true-listp-natural-env-slice
+   (true-listp (mv-nth 1 (natural-env-slice vlist obj)))
+   :hints(("Goal" :in-theory (enable natural-env-slice)))))
+
+(defund number-spec-env-slice (nspec obj)
+  (declare (xargs :guard (number-specp nspec)
+                  :guard-hints(("Goal" :in-theory (enable number-specp)))))
+  (mv-let (rn-ok rn-bspec)
+    (integer-env-slice (car nspec) (numerator (realpart (fix obj))))
+    (if (consp (cdr nspec))
+        (mv-let (rd-ok rd-bspec)
+          (natural-env-slice (cadr nspec) (denominator (realpart (fix obj))))
+          (if (consp (cddr nspec))
+              (mv-let (in-ok in-bspec)
+                (integer-env-slice
+                 (caddr nspec) (numerator (imagpart (fix obj))))
+                (if (consp (cdddr nspec))
+                    (mv-let (id-ok id-bspec)
+                      (natural-env-slice
+                       (cadddr nspec)
+                       (denominator (imagpart (fix obj))))
+                      (mv (and (acl2-numberp obj)
+                               rn-ok rd-ok in-ok id-ok)
+                          (append rn-bspec rd-bspec
+                                  in-bspec id-bspec)))
+                  (mv (and (acl2-numberp obj)
+                           (eql (denominator (imagpart obj)) 1)
+                           rn-ok rd-ok in-ok)
+                      (append rn-bspec rd-bspec
+                              in-bspec))))
+            (mv (and (acl2-numberp obj)
+                     (eql (imagpart obj) 0)
+                     rn-ok rd-ok)
+                (append rn-bspec rd-bspec))))
+      (mv (and (acl2-numberp obj)
+               (eql (denominator (realpart obj)) 1)
+               (eql (imagpart obj) 0) rn-ok)
+          rn-bspec))))
+
+(local
+ (defthm true-listp-number-spec-env-slice-1
+   (true-listp (mv-nth 1 (number-spec-env-slice nspec obj)))
+   :hints(("Goal" :in-theory (enable number-spec-env-slice)))))
+
+(defun g-integer-env-slice (sign bits var obj)
+  (declare (xargs :guard (and (natp sign) (nat-listp bits))))
+  (b* ((obj (ifix obj))
+       ((mv & slice) (natural-env-slice bits (loghead (len bits) obj)))
+       (rest (logtail (len bits) obj))
+       (signval (< rest 0)))
+    (mv (cons (cons sign signval)
+              slice)
+        (list (cons var rest)))))
+
+(mutual-recursion
+ (defun shape-spec-arbitrary-slice (x)
+   (declare (xargs :guard (shape-specp x)
+                   :verify-guards nil))
+   (if (atom x)
+       (mv nil nil)
+     (pattern-match x
+       ((g-number nspec)
+        (mv-let (ok bsl)
+          (number-spec-env-slice nspec 0)
+          (declare (ignore ok))
+          (mv bsl nil)))
+       ((g-integer sign bits var)
+        (g-integer-env-slice sign bits var 0))
+       ((g-integer? sign bits var intp)
+        (mv-let (bsl vsl)
+          (g-integer-env-slice sign bits var 0)
+          (mv (cons (cons intp t) bsl) vsl)))
+       ((g-boolean n) (mv (list (cons n nil)) nil))
+       ((g-var v) (mv nil (list (cons v nil))))
+       ((g-ite if then else)
+        (b* (((mv if-bsl if-vsl)
+              (shape-spec-arbitrary-slice if))
+             ((mv then-bsl then-vsl)
+              (shape-spec-arbitrary-slice then))
+             ((mv else-bsl else-vsl)
+              (shape-spec-arbitrary-slice else)))
+          (mv (append if-bsl then-bsl else-bsl)
+              (append if-vsl then-vsl else-vsl))))
+       ((g-concrete &) (mv nil nil))
+       ((g-call & args &) (shape-spec-list-arbitrary-slice args))
+       (& (b* (((mv car-bsl car-vsl)
+                (shape-spec-arbitrary-slice (car x)))
+               ((mv cdr-bsl cdr-vsl)
+                (shape-spec-arbitrary-slice (cdr x))))
+            (mv (append car-bsl cdr-bsl)
+                (append car-vsl cdr-vsl)))))))
+
+ (defun shape-spec-list-arbitrary-slice (x)
+   (declare (xargs :guard (shape-spec-listp x)))
+   (if (atom x)
+       (mv nil nil)
+     (b* (((mv bsl1 vsl1) (shape-spec-arbitrary-slice (car x)))
+          ((mv bsl2 vsl2) (shape-spec-list-arbitrary-slice (cdr x))))
+       (mv (append bsl1 bsl2)
+           (append vsl1 vsl2))))))
+
+(local
+ (defthm-shape-spec-flag
+   (defthm true-listp-shape-spec-arbitrary-slice-1
+     (true-listp (mv-nth 1 (shape-spec-arbitrary-slice x)))
+     :hints ('(:expand ((shape-spec-arbitrary-slice x))))
+     :flag ss)
+   (defthm true-listp-shape-spec-list-arbitrary-slice-1
+     (true-listp (mv-nth 1 (shape-spec-list-arbitrary-slice x)))
+     :flag list)))
+
+(local
+ (defthm-shape-spec-flag
+   (defthm true-listp-shape-spec-arbitrary-slice-0
+     (true-listp (mv-nth 0 (shape-spec-arbitrary-slice x)))
+     :hints ('(:expand ((shape-spec-arbitrary-slice x))))
+     :flag ss)
+   (defthm true-listp-shape-spec-list-arbitrary-slice-0
+     (true-listp (mv-nth 0 (shape-spec-list-arbitrary-slice x)))
+     :flag list)))
+
+
+(verify-guards shape-spec-arbitrary-slice
+               :hints(("Goal" :in-theory (enable shape-specp
+                                                 shape-spec-listp))))
+
+(in-theory (disable shape-spec-arbitrary-slice shape-spec-list-arbitrary-slice))
+
+(defund shape-spec-iff-env-slice (x obj)
+  (declare (xargs :guard (shape-specp x)
+                  :verify-guards nil))
+  (if (atom x)
+      (mv (iff x obj) nil nil)
+    (pattern-match x
+      ((g-number nspec)
+       (mv-let (ok bsl)
+         (number-spec-env-slice nspec 0)
+         (declare (ignore ok))
+         (mv obj bsl nil)))
+      ((g-integer sign bits var)
+       (mv-let (bsl vsl)
+         (g-integer-env-slice sign bits var 0)
+         (mv obj bsl vsl)))
+      ((g-integer? sign bits var intp)
+       (mv-let (bsl vsl)
+         (g-integer-env-slice sign bits var 0)
+         (if obj
+             (mv t (cons (cons intp t) bsl) vsl)
+           (mv t (cons (cons intp nil) bsl)
+               (list (cons var nil))))))
+      ((g-boolean n) (mv t (list (cons n obj)) nil))
+      ((g-var v) (mv t nil (list (cons v obj))))
+      ((g-ite if then else)
+       (b* (((mv then-ok then-bslice then-vslice)
+             (shape-spec-iff-env-slice then obj))
+            ((mv else-ok else-bslice else-vslice)
+             (shape-spec-iff-env-slice else obj))
+            ((mv if-t-ok if-t-bslice if-t-vslice)
+             (shape-spec-iff-env-slice if t))
+            ((mv if-nil-ok if-nil-bslice if-nil-vslice)
+             (shape-spec-iff-env-slice if nil)))
+         (if (and then-ok if-t-ok)
+             (mv t (append if-t-bslice then-bslice else-bslice)
+                 (append if-t-vslice then-vslice else-vslice))
+           (mv (and else-ok if-nil-ok)
+               (append if-nil-bslice then-bslice else-bslice)
+               (append if-nil-vslice then-vslice else-vslice)))))
+      ((g-concrete y) (mv (iff y obj) nil nil))
+      ((g-call & args &)
+       (mv-let (bsl vsl)
+         (shape-spec-list-arbitrary-slice args)
+         (mv nil bsl vsl)))
+      (& (b* (((mv car-bsl car-vsl)
+               (shape-spec-arbitrary-slice (car x)))
+              ((mv cdr-bsl cdr-vsl)
+               (shape-spec-arbitrary-slice (cdr x))))
+           (mv obj
+               (append car-bsl cdr-bsl)
+               (append car-vsl cdr-vsl)))))))
+
+(local
+ (defthm true-listp-shape-spec-iff-env-slice-1
+   (true-listp (mv-nth 1 (shape-spec-iff-env-slice x obj)))
+   :hints(("Goal" :in-theory (enable shape-spec-iff-env-slice)))))
+
+(local
+ (defthm true-listp-shape-spec-iff-env-slice-2
+   (true-listp (mv-nth 2 (shape-spec-iff-env-slice x obj)))
+   :hints(("Goal" :in-theory (enable shape-spec-iff-env-slice)))))
+
+(verify-guards shape-spec-iff-env-slice
+               :hints(("Goal" :in-theory (enable shape-specp))))
+
+(defund shape-spec-env-slice (x obj)
+  (declare (xargs :guard (shape-specp x)
+                  :verify-guards nil))
+  (if (atom x)
+      (mv (equal x obj) nil nil)
+    (pattern-match x
+      ((g-number nspec)
+       (mv-let (ok bspec)
+         (number-spec-env-slice nspec obj)
+         (mv ok bspec nil)))
+      ((g-integer sign bits var)
+       (mv-let (bsl vsl)
+         (g-integer-env-slice sign bits var obj)
+         (mv (integerp obj) bsl vsl)))
+      ((g-integer? sign bits var intp)
+       (mv-let (bsl vsl)
+         (g-integer-env-slice sign bits var obj)
+         (if (integerp obj)
+             (mv t (cons (cons intp t) bsl) vsl)
+           (mv t (cons (cons intp nil) bsl)
+               (list (cons var obj))))))
+      ((g-boolean n)
+       (mv (booleanp obj)
+           (list (cons n obj))
+           nil))
+      ((g-var v) (mv t nil (list (cons v obj))))
+      ((g-ite if then else)
+       (b* (((mv then-ok then-bslice then-vslice)
+             (shape-spec-env-slice then obj))
+            ((mv else-ok else-bslice else-vslice)
+             (shape-spec-env-slice else obj))
+            ((mv if-t-ok if-t-bslice if-t-vslice)
+             (shape-spec-iff-env-slice if t))
+            ((mv if-nil-ok if-nil-bslice if-nil-vslice)
+             (shape-spec-iff-env-slice if nil)))
+         (if (and then-ok if-t-ok)
+             (mv t (append if-t-bslice then-bslice else-bslice)
+                 (append if-t-vslice then-vslice else-vslice))
+           (mv (and else-ok if-nil-ok)
+               (append if-nil-bslice then-bslice else-bslice)
+               (append if-nil-vslice then-vslice else-vslice)))))
+      ((g-concrete y)
+       (mv (equal obj y) nil nil))
+      ((g-call & args &)
+       (mv-let (bsl vsl)
+         (shape-spec-list-arbitrary-slice args)
+         (mv nil bsl vsl)))
+      (& (b* (((mv car-ok car-bslice car-vslice)
+               (shape-spec-env-slice (car x) (ec-call (car obj))))
+              ((mv cdr-ok cdr-bslice cdr-vslice)
+               (shape-spec-env-slice (cdr x) (ec-call (cdr obj)))))
+           (mv (and (consp obj) car-ok cdr-ok)
+               (append car-bslice cdr-bslice)
+               (append car-vslice cdr-vslice)))))))
+
+(local
+ (defthm true-listp-shape-spec-env-slice-1
+   (true-listp (mv-nth 1 (shape-spec-env-slice x obj)))
+   :hints(("Goal" :in-theory (enable shape-spec-env-slice)))))
+
+(local
+ (defthm true-listp-shape-spec-env-slice-2
+   (true-listp (mv-nth 2 (shape-spec-env-slice x obj)))
+   :hints(("Goal" :in-theory (enable shape-spec-env-slice)))))
+
+(verify-guards shape-spec-env-slice
+               :hints(("Goal" :in-theory (enable shape-specp))))
+
+
+
+
+(defun shape-spec-bindingsp (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      (equal x nil)
+    (and (consp (car x))
+         (symbolp (caar x))
+         (not (keywordp (caar x)))
+         (caar x)
+         (consp (cdar x))
+         (shape-specp (cadar x))
+         (shape-spec-bindingsp (cdr x)))))
+
+
+(local
+ (defthm nat-listp-true-listp
+   (implies (nat-listp x)
+            (true-listp x))
+   :hints(("Goal" :in-theory (enable nat-listp)))
+   :rule-classes (:rewrite :forward-chaining)))
+
+
+(defund number-spec-indices (nspec)
+  (declare (xargs :guard (number-specp nspec)
+                  :guard-hints (("goal" :in-theory (enable number-specp)))))
+  (append (car nspec)
+          (and (consp (cdr nspec))
+               (append (cadr nspec)
+                       (and (consp (cddr nspec))
+                            (append (caddr nspec)
+                                    (and (consp (cdddr nspec))
+                                         (cadddr nspec))))))))
+
+
+(mutual-recursion
+ (defun shape-spec-indices (x)
+   (declare (xargs :guard (shape-specp x)
+                   :verify-guards nil))
+   (if (atom x)
+       nil
+     (pattern-match x
+       ((g-number nspec)
+        (number-spec-indices nspec))
+       ((g-integer sign bits &)
+        (cons sign bits))
+       ((g-integer? sign bits & intp)
+        (list* intp sign bits))
+       ((g-boolean n) (list n))
+       ((g-var &) nil)
+       ((g-ite if then else)
+        (append (shape-spec-indices if)
+                (shape-spec-indices then)
+                (shape-spec-indices else)))
+       ((g-concrete &) nil)
+       ((g-call & args &) (shape-spec-list-indices args))
+       (& (append (shape-spec-indices (car x))
+                  (shape-spec-indices (cdr x)))))))
+ (defun shape-spec-list-indices (x)
+   (declare (xargs :guard (shape-spec-listp x)))
+   (if (atom x)
+       nil
+     (append (shape-spec-indices (car x))
+             (shape-spec-list-indices (cdr x))))))
+
+
+
+(defund numlist-to-vars (lst)
+  (declare (xargs :guard (nat-listp lst)
+                  :guard-hints (("goal" :in-theory (enable nat-listp)))))
+  (if (atom lst)
+      nil
+    (cons (bfr-var (car lst))
+          (numlist-to-vars (cdr lst)))))
+
+(defund num-spec-to-num-gobj (nspec)
+  (declare (xargs :guard (number-specp nspec)
+                  :guard-hints (("goal" :in-theory (enable number-specp)))))
+  (cons (numlist-to-vars (car nspec))
+        (and (consp (cdr nspec))
+             (cons (numlist-to-vars (cadr nspec))
+                   (and (consp (cddr nspec))
+                        (cons (numlist-to-vars (caddr nspec))
+                              (and (consp (cdddr nspec))
+                                   (list (numlist-to-vars
+                                          (cadddr nspec))))))))))
+
+(mutual-recursion
+ (defun shape-spec-to-gobj (x)
+   (declare (xargs :guard (shape-specp x)
+                   :guard-hints (("goal" :in-theory (enable shape-specp
+                                                            shape-spec-listp)))))
+   (if (atom x)
+       x
+     (pattern-match x
+       ((g-number nspec)
+        (g-number (num-spec-to-num-gobj nspec)))
+       ((g-integer sign bits var)
+        (g-apply 'logapp
+                 (list (len bits)
+                       (g-number (list (bfr-logapp-nus
+                                        (len bits) (numlist-to-vars bits) nil)))
+                       (g-apply 'int-set-sign
+                                (list (g-boolean (bfr-var sign))
+                                      (g-var var))))))
+       ((g-integer? sign bits var intp)
+        (g-apply 'maybe-integer
+                 (list
+                  (g-apply 'logapp
+                           (list (len bits)
+                                 (g-number (list (bfr-logapp-nus
+                                                  (len bits) (numlist-to-vars bits) nil)))
+                                 (g-apply 'int-set-sign
+                                          (list (g-boolean (bfr-var sign))
+                                                (g-var var)))))
+                  (g-var var)
+                  (g-boolean (bfr-var intp)))))
+       ((g-boolean n) (g-boolean (bfr-var n)))
+       ((g-var &) x)
+       ((g-ite if then else)
+        (g-ite (shape-spec-to-gobj if)
+               (shape-spec-to-gobj then)
+               (shape-spec-to-gobj else)))
+       ((g-concrete &) x)
+       ((g-call fn args &) (g-apply fn (shape-spec-to-gobj-list args)))
+       (& (gl-cons (shape-spec-to-gobj (car x))
+                   (shape-spec-to-gobj (cdr x)))))))
+ (defun shape-spec-to-gobj-list (x)
+   (declare (xargs :guard (shape-spec-listp x)))
+   (if (atom x)
+       nil
+     (cons (shape-spec-to-gobj (car x))
+           (shape-spec-to-gobj-list (cdr x))))))
diff -Nru acl2-6.2/books/centaur/gl/shape-spec.lisp acl2-6.3/books/centaur/gl/shape-spec.lisp
--- acl2-6.2/books/centaur/gl/shape-spec.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/shape-spec.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,24 +1,35 @@
-
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
+(include-book "shape-spec-defs")
 (include-book "gtypes")
-(include-book "gl-doc-string")
+(include-book "symbolic-arithmetic-fns")
+(local (include-book "symbolic-arithmetic"))
 (local (include-book "gtype-thms"))
 (local (include-book "data-structures/no-duplicates" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
-(local (include-book "ihs/ihs-lemmas" :dir :system))
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
 (local (include-book "centaur/misc/fast-alists" :dir :system))
 
-; Modified slightly 12/4/2012 by Matt K. to be redundant with new ACL2
-; definition.
-(defund nat-listp (l)
-  (declare (xargs :guard t))
-  (cond ((atom l)
-         (eq l nil))
-        (t (and (natp (car l))
-                (nat-listp (cdr l))))))
 
 (defund slice-to-bdd-env (slice env)
   (declare (xargs :guard (and (alistp slice)
@@ -39,45 +50,6 @@
 (verify-guards slice-to-bdd-env
                :hints (("goal" :in-theory (enable nat-listp))))
 
-
-;; An shape spec is an object that is similar to a g object, but a) where there
-;; would be BDDs in a g object, there are natural numbers in an shape spec, and
-;; b) no G-APPLY constructs are allowed in an shape spec.
-
-(defund number-specp (nspec)
-  (declare (xargs :guard t))
-  (and (consp nspec)
-       (nat-listp (car nspec))
-       (if (atom (cdr nspec))
-           (not (cdr nspec))
-         (and (nat-listp (cadr nspec))
-              (if (atom (cddr nspec))
-                  (not (cddr nspec))
-                (and (nat-listp (caddr nspec))
-                     (if (atom (cdddr nspec))
-                         (not (cdddr nspec))
-                         (nat-listp (cadddr nspec)))))))))
-
-
-(defund shape-specp (x)
-  (declare (xargs :guard t))
-  (if (atom x)
-      (not (g-keyword-symbolp x))
-    (case (tag x)
-      (:g-number (number-specp (g-number->num x)))
-      (:g-boolean (natp (g-boolean->bool x)))
-      (:g-concrete t)
-      (:g-var t)
-      (:g-ite
-       (and (shape-specp (g-ite->test x))
-            (shape-specp (g-ite->then x))
-            (shape-specp (g-ite->else x))))
-      (:g-apply nil)
-      (otherwise (and (shape-specp (car x))
-                      (shape-specp (cdr x)))))))
-
-
-
 (local
  (defthm nat-listp-true-listp
    (implies (nat-listp x)
@@ -86,17 +58,6 @@
    :rule-classes (:rewrite :forward-chaining)))
 
 
-(defund number-spec-indices (nspec)
-  (declare (xargs :guard (number-specp nspec)
-                  :guard-hints (("goal" :in-theory (enable number-specp)))))
-  (append (car nspec)
-          (and (consp (cdr nspec))
-               (append (cadr nspec)
-                       (and (consp (cddr nspec))
-                            (append (caddr nspec)
-                                    (and (consp (cdddr nspec))
-                                         (cadddr nspec))))))))
-
 (local
  (defthm nat-listp-append
    (implies (and (nat-listp a)
@@ -114,319 +75,80 @@
            (nat-listp (number-spec-indices nspec)))
   :hints(("Goal" :in-theory (enable number-specp number-spec-indices))))
 
-(defund shape-spec-indices (x)
-  (declare (xargs :guard (shape-specp x)
-                  :verify-guards nil))
-  (if (atom x)
-      nil
-    (pattern-match x
-      ((g-number nspec)
-       (number-spec-indices nspec))
-      ((g-boolean n) (list n))
-      ((g-var &) nil)
-      ((g-ite if then else)
-       (append (shape-spec-indices if)
-               (shape-spec-indices then)
-               (shape-spec-indices else)))
-      ((g-concrete &) nil)
-      (& (append (shape-spec-indices (car x))
-                 (shape-spec-indices (cdr x)))))))
-
-(defthm nat-listp-shape-spec-indices
-  (implies (shape-specp x)
-           (nat-listp (shape-spec-indices x)))
-  :hints(("Goal" :in-theory (enable shape-specp shape-spec-indices
-                                    nat-listp))))
-
-(verify-guards shape-spec-indices
-               :hints (("goal" :in-theory (enable shape-specp))))
-
-(defund shape-spec-vars (x)
-  (declare (xargs :guard (shape-specp x)
-                  :verify-guards nil))
-  (if (atom x)
-      nil
-    (pattern-match x
-      ((g-number &) nil)
-      ((g-boolean &) nil)
-      ((g-var v) (list v))
-      ((g-ite if then else)
-       (append (shape-spec-vars if)
-               (shape-spec-vars then)
-               (shape-spec-vars else)))
-      ((g-concrete &) nil)
-      (& (append (shape-spec-vars (car x))
-                 (shape-spec-vars (cdr x)))))))
-
-(local
- (defthm true-listp-shape-spec-vars
-   (true-listp (shape-spec-vars x))
-   :hints(("Goal" :in-theory (enable shape-spec-vars)))))
-
-(verify-guards shape-spec-vars
-               :hints(("Goal" :in-theory (enable shape-specp))))
-
-
 
 
-(defund integer-env-slice (vlist obj)
-  (declare (xargs :guard (and (nat-listp vlist)
-                              (integerp obj))
-                  :guard-hints(("Goal" :in-theory (enable nat-listp)))))
-  (if (atom vlist)
-      (mv (eql obj 0) nil)
-    (if (atom (cdr vlist))
-        (if (eql obj 0)
-            (mv t (list (cons (car vlist) nil)))
-          (mv (eql obj -1) (list (cons (car vlist) t))))
-      (mv-let (rest-ok rest-bslice)
-        (integer-env-slice (cdr vlist) (ash obj -1))
-        (mv rest-ok (cons (cons (car vlist) (logbitp 0 obj)) rest-bslice))))))
-
-(local
- (defthm true-listp-integer-env-slice
-   (true-listp (mv-nth 1 (integer-env-slice vlist obj)))
-   :hints(("Goal" :in-theory (enable integer-env-slice)))))
 
-(defund natural-env-slice (vlist obj)
-  (declare (xargs :guard (and (nat-listp vlist)
-                              (integerp obj))
-                  :guard-hints(("Goal" :in-theory (enable nat-listp)))))
-  (if (atom vlist)
-      (mv (eql obj 0) nil)
-    (mv-let (rest-ok rest-bslice)
-      (natural-env-slice (cdr vlist) (ash obj -1))
-      (mv rest-ok (cons (cons (car vlist) (logbitp 0 obj)) rest-bslice)))))
-
-(local
- (defthm true-listp-natural-env-slice
-   (true-listp (mv-nth 1 (natural-env-slice vlist obj)))
-   :hints(("Goal" :in-theory (enable natural-env-slice)))))
-
-(defund number-spec-env-slice (nspec obj)
-  (declare (xargs :guard (number-specp nspec)
-                  :guard-hints(("Goal" :in-theory (enable number-specp)))))
-  (mv-let (rn-ok rn-bspec)
-    (integer-env-slice (car nspec) (numerator (realpart (fix obj))))
-    (if (consp (cdr nspec))
-        (mv-let (rd-ok rd-bspec)
-          (natural-env-slice (cadr nspec) (denominator (realpart (fix obj))))
-          (if (consp (cddr nspec))
-              (mv-let (in-ok in-bspec)
-                (integer-env-slice
-                 (caddr nspec) (numerator (imagpart (fix obj))))
-                (if (consp (cdddr nspec))
-                    (mv-let (id-ok id-bspec)
-                      (natural-env-slice
-                       (cadddr nspec)
-                       (denominator (imagpart (fix obj))))
-                      (mv (and (acl2-numberp obj)
-                               rn-ok rd-ok in-ok id-ok)
-                          (append rn-bspec rd-bspec
-                                  in-bspec id-bspec)))
-                  (mv (and (acl2-numberp obj)
-                           (eql (denominator (imagpart obj)) 1)
-                           rn-ok rd-ok in-ok)
-                      (append rn-bspec rd-bspec
-                              in-bspec))))
-            (mv (and (acl2-numberp obj)
-                     (eql (imagpart obj) 0)
-                     rn-ok rd-ok)
-                (append rn-bspec rd-bspec))))
-      (mv (and (acl2-numberp obj)
-               (eql (denominator (realpart obj)) 1)
-               (eql (imagpart obj) 0) rn-ok)
-          rn-bspec))))
-
-(local
- (defthm true-listp-number-spec-env-slice-1
-   (true-listp (mv-nth 1 (number-spec-env-slice nspec obj)))
-   :hints(("Goal" :in-theory (enable number-spec-env-slice)))))
-
-(defun shape-spec-arbitrary-slice (x)
-  (declare (xargs :guard (shape-specp x)
-                  :verify-guards nil))
-  (if (atom x)
-      (mv nil nil)
-    (pattern-match x
-      ((g-number nspec)
-       (mv-let (ok bsl)
-         (number-spec-env-slice nspec 0)
-         (declare (ignore ok))
-         (mv bsl nil)))
-      ((g-boolean n) (mv (list (cons n nil)) nil))
-      ((g-var v) (mv nil (list (cons v nil))))
-      ((g-ite if then else)
-       (b* (((mv if-bsl if-vsl)
-             (shape-spec-arbitrary-slice if))
-            ((mv then-bsl then-vsl)
-             (shape-spec-arbitrary-slice then))
-            ((mv else-bsl else-vsl)
-             (shape-spec-arbitrary-slice else)))
-         (mv (append if-bsl then-bsl else-bsl)
-             (append if-vsl then-vsl else-vsl))))
-      ((g-concrete &) (mv nil nil))
-      (& (b* (((mv car-bsl car-vsl)
-               (shape-spec-arbitrary-slice (car x)))
-              ((mv cdr-bsl cdr-vsl)
-               (shape-spec-arbitrary-slice (cdr x))))
-           (mv (append car-bsl cdr-bsl)
-               (append car-vsl cdr-vsl)))))))
-
-(local
- (defthm true-listp-shape-spec-arbitrary-slice-1
-   (true-listp (mv-nth 1 (shape-spec-arbitrary-slice x)))))
+(defthm-shape-spec-flag
+  (defthm nat-listp-shape-spec-indices
+    (implies (shape-specp x)
+             (nat-listp (shape-spec-indices x)))
+    :flag ss)
+  (defthm nat-listp-shape-spec-list-indices
+    (implies (shape-spec-listp x)
+             (nat-listp (shape-spec-list-indices x)))
+    :flag list)
+  :hints(("Goal" :in-theory (enable shape-specp shape-spec-listp
+                                    shape-spec-indices
+                                    nat-listp))))
 
-(local
- (defthm true-listp-shape-spec-arbitrary-slice-0
-   (true-listp (mv-nth 0 (shape-spec-arbitrary-slice x)))))
+(verify-guards shape-spec-indices
+  :hints (("goal" :in-theory (enable shape-specp shape-spec-listp))))
 
-(verify-guards shape-spec-arbitrary-slice
-               :hints(("Goal" :in-theory (enable shape-specp))))
+(in-theory (disable shape-spec-indices shape-spec-list-indices))
 
-(defund shape-spec-iff-env-slice (x obj)
-  (declare (xargs :guard (shape-specp x)
-                  :verify-guards nil))
-  (if (atom x)
-      (mv (iff x obj) nil nil)
-    (pattern-match x
-      ((g-number nspec)
-       (mv-let (ok bsl)
-         (number-spec-env-slice nspec 0)
-         (declare (ignore ok))
-         (mv obj bsl nil)))
-      ((g-boolean n) (mv t (list (cons n obj)) nil))
-      ((g-var v) (mv t nil (list (cons v obj))))
-      ((g-ite if then else)
-       (b* (((mv then-ok then-bslice then-vslice)
-             (shape-spec-iff-env-slice then obj))
-            ((mv else-ok else-bslice else-vslice)
-             (shape-spec-iff-env-slice else obj))
-            ((mv if-t-ok if-t-bslice if-t-vslice)
-             (shape-spec-iff-env-slice if t))
-            ((mv if-nil-ok if-nil-bslice if-nil-vslice)
-             (shape-spec-iff-env-slice if nil)))
-         (if (and then-ok if-t-ok)
-             (mv t (append if-t-bslice then-bslice else-bslice)
-                 (append if-t-vslice then-vslice else-vslice))
-           (mv (and else-ok if-nil-ok)
-               (append if-nil-bslice then-bslice else-bslice)
-               (append if-nil-vslice then-vslice else-vslice)))))
-      ((g-concrete y) (mv (iff y obj) nil nil))
-      (& (b* (((mv car-bsl car-vsl)
-               (shape-spec-arbitrary-slice (car x)))
-              ((mv cdr-bsl cdr-vsl)
-               (shape-spec-arbitrary-slice (cdr x))))
-           (mv obj
-               (append car-bsl cdr-bsl)
-               (append car-vsl cdr-vsl)))))))
+(mutual-recursion
+ (defun shape-spec-vars (x)
+   (declare (xargs :guard (shape-specp x)
+                   :verify-guards nil))
+   (if (atom x)
+       nil
+     (pattern-match x
+       ((g-number &) nil)
+       ((g-integer & & v) (list v))
+       ((g-integer? & & v &) (list v))
+       ((g-boolean &) nil)
+       ((g-var v) (list v))
+       ((g-ite if then else)
+        (append (shape-spec-vars if)
+                (shape-spec-vars then)
+                (shape-spec-vars else)))
+       ((g-concrete &) nil)
+       ((g-call & args &) (shape-spec-list-vars args))
+       (& (append (shape-spec-vars (car x))
+                  (shape-spec-vars (cdr x)))))))
+ (defun shape-spec-list-vars (x)
+   (declare (xargs :guard (shape-spec-listp x)))
+   (if (atom x)
+       nil
+     (append (shape-spec-vars (car x))
+             (shape-spec-list-vars (cdr x))))))
 
-(local
- (defthm true-listp-shape-spec-iff-env-slice-1
-   (true-listp (mv-nth 1 (shape-spec-iff-env-slice x obj)))
-   :hints(("Goal" :in-theory (enable shape-spec-iff-env-slice)))))
 
 (local
- (defthm true-listp-shape-spec-iff-env-slice-2
-   (true-listp (mv-nth 2 (shape-spec-iff-env-slice x obj)))
-   :hints(("Goal" :in-theory (enable shape-spec-iff-env-slice)))))
+ (defthm-shape-spec-flag
+   (defthm true-listp-shape-spec-vars
+     (implies (shape-specp x)
+              (true-listp (shape-spec-vars x)))
+     :flag ss)
+   (defthm true-listp-shape-spec-list-vars
+     (implies (shape-spec-listp x)
+              (true-listp (shape-spec-list-vars x)))
+     :flag list)
+   :hints(("Goal" :in-theory (enable shape-specp shape-spec-vars
+                                     true-listp)))))
 
-(verify-guards shape-spec-iff-env-slice
-               :hints(("Goal" :in-theory (enable shape-specp))))
-
-(defund shape-spec-env-slice (x obj)
-  (declare (xargs :guard (shape-specp x)
-                  :verify-guards nil))
-  (if (atom x)
-      (mv (equal x obj) nil nil)
-    (pattern-match x
-      ((g-number nspec)
-       (mv-let (ok bspec)
-         (number-spec-env-slice nspec obj)
-         (mv ok bspec nil)))
-      ((g-boolean n)
-       (mv (booleanp obj)
-           (list (cons n obj))
-           nil))
-      ((g-var v) (mv t nil (list (cons v obj))))
-      ((g-ite if then else)
-       (b* (((mv then-ok then-bslice then-vslice)
-             (shape-spec-env-slice then obj))
-            ((mv else-ok else-bslice else-vslice)
-             (shape-spec-env-slice else obj))
-            ((mv if-t-ok if-t-bslice if-t-vslice)
-             (shape-spec-iff-env-slice if t))
-            ((mv if-nil-ok if-nil-bslice if-nil-vslice)
-             (shape-spec-iff-env-slice if nil)))
-         (if (and then-ok if-t-ok)
-             (mv t (append if-t-bslice then-bslice else-bslice)
-                 (append if-t-vslice then-vslice else-vslice))
-           (mv (and else-ok if-nil-ok)
-               (append if-nil-bslice then-bslice else-bslice)
-               (append if-nil-vslice then-vslice else-vslice)))))
-      ((g-concrete y)
-       (mv (equal obj y) nil nil))
-      (& (b* (((mv car-ok car-bslice car-vslice)
-               (shape-spec-env-slice (car x) (ec-call (car obj))))
-              ((mv cdr-ok cdr-bslice cdr-vslice)
-               (shape-spec-env-slice (cdr x) (ec-call (cdr obj)))))
-           (mv (and (consp obj) car-ok cdr-ok)
-               (append car-bslice cdr-bslice)
-               (append car-vslice cdr-vslice)))))))
-
-(local
- (defthm true-listp-shape-spec-env-slice-1
-   (true-listp (mv-nth 1 (shape-spec-env-slice x obj)))
-   :hints(("Goal" :in-theory (enable shape-spec-env-slice)))))
+(verify-guards shape-spec-vars
+               :hints(("Goal" :in-theory (enable shape-specp shape-spec-listp))))
 
-(local
- (defthm true-listp-shape-spec-env-slice-2
-   (true-listp (mv-nth 2 (shape-spec-env-slice x obj)))
-   :hints(("Goal" :in-theory (enable shape-spec-env-slice)))))
+(in-theory (disable shape-spec-vars shape-spec-list-vars))
 
-(verify-guards shape-spec-env-slice
-               :hints(("Goal" :in-theory (enable shape-specp))))
 
 
-(defund numlist-to-vars (lst)
-  (declare (xargs :guard (nat-listp lst)
-                  :guard-hints (("goal" :in-theory (enable nat-listp)))))
-  (if (atom lst)
-      nil
-    (cons (bfr-var (car lst))
-          (numlist-to-vars (cdr lst)))))
 
-(defund num-spec-to-num-gobj (nspec)
-  (declare (xargs :guard (number-specp nspec)
-                  :guard-hints (("goal" :in-theory (enable number-specp)))))
-  (cons (numlist-to-vars (car nspec))
-        (and (consp (cdr nspec))
-             (cons (numlist-to-vars (cadr nspec))
-                   (and (consp (cddr nspec))
-                        (cons (numlist-to-vars (caddr nspec))
-                              (and (consp (cdddr nspec))
-                                   (list (numlist-to-vars
-                                          (cadddr nspec))))))))))
-
-(defund shape-spec-to-gobj (x)
-  (declare (xargs :guard (shape-specp x)
-                  :guard-hints (("goal" :in-theory (enable shape-specp)))))
-  (if (atom x)
-      x
-    (pattern-match x
-      ((g-number nspec)
-       (g-number (num-spec-to-num-gobj nspec)))
-      ((g-boolean n) (g-boolean (bfr-var n)))
-      ((g-var &) x)
-      ((g-ite if then else)
-       (g-ite (shape-spec-to-gobj if)
-              (shape-spec-to-gobj then)
-              (shape-spec-to-gobj else)))
-      ((g-concrete &) x)
-      (& (gl-cons (shape-spec-to-gobj (car x))
-                  (shape-spec-to-gobj (cdr x)))))))
 
 
+(in-theory (disable shape-spec-to-gobj
+                    shape-spec-to-gobj-list))
 
 
 
@@ -504,29 +226,57 @@
 ;;             (bfr-eval (bfr-var n) env)))))
 
 (local
- (defthm bfr-eval-list-numlist-subset-append
+ (defthm bfr-list->s-numlist-subset-append
    (implies (and (nat-listp lst)
                  (subsetp-equal lst (strip-cars bsl1)))
-            (equal (bfr-eval-list (numlist-to-vars lst)
+            (equal (bfr-list->s (numlist-to-vars lst)
+                                (slice-to-bdd-env (append bsl1 bsl2) env))
+                   (bfr-list->s (numlist-to-vars lst)
+                                (slice-to-bdd-env bsl1 env))))
+   :hints(("Goal" :in-theory (enable numlist-to-vars scdr s-endp
+                                     slice-to-bdd-env
+                                     subsetp-equal
+                                     nat-listp)
+           :induct (numlist-to-vars lst)))))
+
+(local
+ (defthm bfr-list->s-numlist-no-intersect-append
+   (implies (and (nat-listp lst)
+                 (nat-listp (strip-cars bsl1))
+                 (not (intersectp-equal lst (strip-cars bsl1))))
+            (equal (bfr-list->s (numlist-to-vars lst)
                                   (slice-to-bdd-env (append bsl1 bsl2) env))
-                   (bfr-eval-list (numlist-to-vars lst)
-                                  (slice-to-bdd-env bsl1 env))))
-   :hints(("Goal" :in-theory (enable numlist-to-vars
+                   (bfr-list->s (numlist-to-vars lst)
+                                  (slice-to-bdd-env bsl2 env))))
+   :hints(("Goal" :in-theory (enable numlist-to-vars scdr s-endp
+                                     slice-to-bdd-env
+                                     nat-listp)
+           :induct (numlist-to-vars lst)))))
+
+(local
+ (defthm bfr-list->u-numlist-subset-append
+   (implies (and (nat-listp lst)
+                 (subsetp-equal lst (strip-cars bsl1)))
+            (equal (bfr-list->u (numlist-to-vars lst)
+                                (slice-to-bdd-env (append bsl1 bsl2) env))
+                   (bfr-list->u (numlist-to-vars lst)
+                                (slice-to-bdd-env bsl1 env))))
+   :hints(("Goal" :in-theory (enable numlist-to-vars scdr s-endp
                                      slice-to-bdd-env
                                      subsetp-equal
                                      nat-listp)
            :induct (numlist-to-vars lst)))))
 
 (local
- (defthm bfr-eval-list-numlist-no-intersect-append
+ (defthm bfr-list->u-numlist-no-intersect-append
    (implies (and (nat-listp lst)
                  (nat-listp (strip-cars bsl1))
                  (not (intersectp-equal lst (strip-cars bsl1))))
-            (equal (bfr-eval-list (numlist-to-vars lst)
+            (equal (bfr-list->u (numlist-to-vars lst)
                                   (slice-to-bdd-env (append bsl1 bsl2) env))
-                   (bfr-eval-list (numlist-to-vars lst)
+                   (bfr-list->u (numlist-to-vars lst)
                                   (slice-to-bdd-env bsl2 env))))
-   :hints(("Goal" :in-theory (enable numlist-to-vars
+   :hints(("Goal" :in-theory (enable numlist-to-vars scdr s-endp
                                      slice-to-bdd-env
                                      nat-listp)
            :induct (numlist-to-vars lst)))))
@@ -574,23 +324,91 @@
 ;;    :hints(("Goal" :in-theory (enable gobj-fix)))))
 
 
+
+
+(def-eval-g sspec-geval
+  (logapp int-set-sign maybe-integer
+          cons car cdr consp if not equal nth len iff
+          shape-spec-slice-to-env
+          ss-append-envs
+          shape-spec-obj-in-range-iff
+          shape-spec-obj-in-range
+          shape-spec-env-slice
+          shape-spec-iff-env-slice))
+
+
+
+(local (in-theory (disable logapp integer-length
+                           loghead logtail sspec-geval
+                           acl2::member-equal-of-strip-cars-when-member-equal-of-hons-duplicated-members-aux
+                           acl2::consp-of-car-when-alistp
+                           sets::double-containment)))
+
+(defun expands-with-hint (def expands)
+  (if (atom expands)
+      nil
+    (cons `(:with ,def ,(car expands))
+          (expands-with-hint def (cdr expands)))))
+
+(defthm bfr-eval-list-of-append
+  (equal (bfr-eval-list (append a b) env)
+         (append (bfr-eval-list a env)
+                 (bfr-eval-list b env))))
+
+(defthm bfr-list->s-of-append
+  (implies (consp b)
+           (equal (bfr-list->s (append a b) env)
+                  (logapp (len a) (bfr-list->s a env)
+                          (bfr-list->s b env))))
+  :hints(("Goal" :in-theory (enable scdr s-endp acl2::logapp** append)
+          :induct (append a b)
+          :expand ((:free (a b) (bfr-list->s (cons a b) env))))))
+
+(defthm bfr-list->u-of-append
+  (equal (bfr-list->u (append a b) env)
+         (logapp (len a) (bfr-list->u a env)
+                 (bfr-list->u b env)))
+  :hints(("Goal" :in-theory (enable  acl2::logapp** append)
+          :induct (append a b)
+          :expand ((:free (a b) (bfr-list->u (cons a b) env))))))
+
+(local (in-theory (enable gl-cons)))
+
 (local
- (defthm shape-spec-to-gobj-eval-slice-subset-append-1
-   (implies (and (shape-specp x)
-                 (alistp vsl1)
-                 (subsetp-equal (shape-spec-indices x)
-                                (strip-cars bsl1)))
-            (equal (generic-geval
-                    (shape-spec-to-gobj x)
-                    (cons (slice-to-bdd-env
-                           (append bsl1 bsl2) env)
-                          vsl1))
-                   (generic-geval
-                    (shape-spec-to-gobj x)
-                    (cons (slice-to-bdd-env
-                           bsl1 env)
-                          vsl1))))
-   :hints(("Goal" :in-theory (e/d (break-g-number
+ (defthm-shape-spec-flag
+   (defthm shape-spec-to-gobj-eval-slice-subset-append-1
+     (implies (and (shape-specp x)
+                   (alistp vsl1)
+                   (subsetp-equal (shape-spec-indices x)
+                                  (strip-cars bsl1)))
+              (equal (sspec-geval
+                      (shape-spec-to-gobj x)
+                      (cons (slice-to-bdd-env
+                             (append bsl1 bsl2) env)
+                            vsl1))
+                     (sspec-geval
+                      (shape-spec-to-gobj x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            vsl1))))
+     :flag ss)
+   (defthm shape-spec-to-gobj-list-eval-slice-subset-append-1
+     (implies (and (shape-spec-listp x)
+                   (alistp vsl1)
+                   (subsetp-equal (shape-spec-list-indices x)
+                                  (strip-cars bsl1)))
+              (equal (sspec-geval-list
+                      (shape-spec-to-gobj-list x)
+                      (cons (slice-to-bdd-env
+                             (append bsl1 bsl2) env)
+                            vsl1))
+                     (sspec-geval-list
+                      (shape-spec-to-gobj-list x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            vsl1))))
+     :flag list)
+     :hints(("Goal" :in-theory (e/d (break-g-number
                                    num-spec-to-num-gobj
                                    number-spec-indices
                                    number-specp
@@ -602,43 +420,64 @@
                                    acl2::consp-by-len
                                    boolean-listp
                                    binary-append))
-           :induct (shape-spec-to-gobj x)
            :expand ((shape-spec-to-gobj x)
+                    (shape-spec-to-gobj-list x)
                     (shape-spec-indices x)
+                    (shape-spec-list-indices x)
                     (shape-spec-vars x)
-                    (shape-specp x)))
+                    (shape-spec-list-vars x)
+                    (shape-specp x)
+                    (shape-spec-listp x)))
           (and stable-under-simplificationp
-               (flag::expand-calls-computed-hint
-                acl2::clause '(generic-geval)))
-          (and stable-under-simplificationp
-               '(:in-theory (enable g-boolean->bool
-                                    g-apply->fn
-                                    g-apply->args))))))
+               (let ((calls1 (acl2::find-calls-of-fns-term
+                              (car (last clause)) '(sspec-geval) nil))
+                     (calls2 (acl2::find-calls-of-fns-term
+                              (car (last clause)) '(sspec-geval-list) nil)))
+                 (and (or calls1 calls2)
+                      `(:computed-hint-replacement t
+                        :expand (,@(expands-with-hint 'sspec-geval calls1)
+                                   ,@(expands-with-hint 'sspec-geval-list calls2)))))))))
 
 
 (local
- (defthm shape-spec-to-gobj-eval-slice-subset-append-2
-   (implies (and (shape-specp x)
-                 (alistp vsl1)
-                 (subsetp-equal (shape-spec-vars x)
-                                (strip-cars vsl1)))
-            (equal (generic-geval
-                    (shape-spec-to-gobj x)
-                    (cons (slice-to-bdd-env
-                           bsl1 env)
-                          (append vsl1 vsl2)))
-                   (generic-geval
-                    (shape-spec-to-gobj x)
-                    (cons (slice-to-bdd-env
-                           bsl1 env)
-                          vsl1))))
-   :hints(("Goal" :in-theory (e/d (break-g-number
+ (defthm-shape-spec-flag
+   (defthm shape-spec-to-gobj-eval-slice-subset-append-2
+     (implies (and (shape-specp x)
+                   (alistp vsl1)
+                   (subsetp-equal (shape-spec-vars x)
+                                  (strip-cars vsl1)))
+              (equal (sspec-geval
+                      (shape-spec-to-gobj x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            (append vsl1 vsl2)))
+                     (sspec-geval
+                      (shape-spec-to-gobj x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            vsl1))))
+     :flag ss)
+   (defthm shape-spec-to-gobj-list-eval-slice-subset-append-2
+     (implies (and (shape-spec-listp x)
+                   (alistp vsl1)
+                   (subsetp-equal (shape-spec-list-vars x)
+                                  (strip-cars vsl1)))
+              (equal (sspec-geval-list
+                      (shape-spec-to-gobj-list x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            (append vsl1 vsl2)))
+                     (sspec-geval-list
+                      (shape-spec-to-gobj-list x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            vsl1))))
+     :flag list)
+     :hints(("Goal" :in-theory (e/d (break-g-number
                                    num-spec-to-num-gobj
                                    number-spec-indices
                                    number-specp
                                    subsetp-equal
-                                   hons-assoc-equal
-                                   strip-cars
                                    (:induction shape-spec-to-gobj))
                                   (member-equal
                                    acl2::list-fix-when-true-listp
@@ -646,39 +485,67 @@
                                    acl2::consp-by-len
                                    boolean-listp
                                    binary-append))
-           :induct (shape-spec-to-gobj x)
            :expand ((shape-spec-to-gobj x)
+                    (shape-spec-to-gobj-list x)
                     (shape-spec-indices x)
+                    (shape-spec-list-indices x)
                     (shape-spec-vars x)
-                    (shape-specp x)))
+                    (shape-spec-list-vars x)
+                    (shape-specp x)
+                    (shape-spec-listp x)))
           (and stable-under-simplificationp
-               (flag::expand-calls-computed-hint
-                acl2::clause '(generic-geval))))))
-
-
+               (let ((calls1 (acl2::find-calls-of-fns-term
+                              (car (last clause)) '(sspec-geval) nil))
+                     (calls2 (acl2::find-calls-of-fns-term
+                              (car (last clause)) '(sspec-geval-list) nil)))
+                 (and (or calls1 calls2)
+                      `(:computed-hint-replacement t
+                        :expand (,@(expands-with-hint 'sspec-geval calls1)
+                                   ,@(expands-with-hint 'sspec-geval-list calls2)))))))))
 
 (local
- (defthm shape-spec-to-gobj-eval-slice-no-intersect-append-1
-   (implies (and (shape-specp x)
-                 (alistp vsl1)
-                 (nat-listp (strip-cars bsl1))
-                 (not (intersectp-equal
-                       (shape-spec-indices x)
-                       (strip-cars bsl1))))
-            (equal (generic-geval
-                    (shape-spec-to-gobj x)
-                    (cons (slice-to-bdd-env
-                           (append bsl1 bsl2) env)
-                          vsl1))
-                   (generic-geval
-                    (shape-spec-to-gobj x)
-                    (cons (slice-to-bdd-env
-                           bsl2 env)
-                          vsl1))))
+ (defthm-shape-spec-flag
+   (defthm shape-spec-to-gobj-eval-slice-no-intersect-append-1
+     (implies (and (shape-specp x)
+                   (alistp vsl1)
+                   (nat-listp (strip-cars bsl1))
+                   (not (intersectp-equal
+                         (shape-spec-indices x)
+                         (strip-cars bsl1))))
+              (equal (sspec-geval
+                      (shape-spec-to-gobj x)
+                      (cons (slice-to-bdd-env
+                             (append bsl1 bsl2) env)
+                            vsl1))
+                     (sspec-geval
+                      (shape-spec-to-gobj x)
+                      (cons (slice-to-bdd-env
+                             bsl2 env)
+                            vsl1))))
+     :flag ss)
+   (defthm shape-spec-list-to-gobj-eval-slice-no-intersect-append-1
+     (implies (and (shape-spec-listp x)
+                   (alistp vsl1)
+                   (nat-listp (strip-cars bsl1))
+                   (not (intersectp-equal
+                         (shape-spec-list-indices x)
+                         (strip-cars bsl1))))
+              (equal (sspec-geval-list
+                      (shape-spec-to-gobj-list x)
+                      (cons (slice-to-bdd-env
+                             (append bsl1 bsl2) env)
+                            vsl1))
+                     (sspec-geval-list
+                      (shape-spec-to-gobj-list x)
+                      (cons (slice-to-bdd-env
+                             bsl2 env)
+                            vsl1))))
+     :flag list)
    :hints(("Goal" :in-theory (e/d (break-g-number
                                    num-spec-to-num-gobj
                                    number-spec-indices
                                    number-specp
+                                   subsetp-equal
                                    (:induction shape-spec-to-gobj))
                                   (member-equal
                                    acl2::list-fix-when-true-listp
@@ -686,32 +553,59 @@
                                    acl2::consp-by-len
                                    boolean-listp
                                    binary-append))
-           :induct (shape-spec-to-gobj x)
            :expand ((shape-spec-to-gobj x)
+                    (shape-spec-to-gobj-list x)
                     (shape-spec-indices x)
+                    (shape-spec-list-indices x)
                     (shape-spec-vars x)
-                    (shape-specp x)))
+                    (shape-spec-list-vars x)
+                    (shape-specp x)
+                    (shape-spec-listp x)))
           (and stable-under-simplificationp
-               (flag::expand-calls-computed-hint
-                acl2::clause '(generic-geval))))))
+               (let ((calls1 (acl2::find-calls-of-fns-term
+                              (car (last clause)) '(sspec-geval) nil))
+                     (calls2 (acl2::find-calls-of-fns-term
+                              (car (last clause)) '(sspec-geval-list) nil)))
+                 (and (or calls1 calls2)
+                      `(:computed-hint-replacement t
+                        :expand (,@(expands-with-hint 'sspec-geval calls1)
+                                   ,@(expands-with-hint 'sspec-geval-list calls2)))))))))
 
 
 (local
- (defthm shape-spec-to-gobj-eval-slice-no-intersect-append-2
-   (implies (and (shape-specp x)
-                 (alistp vsl1)
-                 (not (intersectp-equal (shape-spec-vars x)
-                                        (strip-cars vsl1))))
-            (equal (generic-geval
-                    (shape-spec-to-gobj x)
-                    (cons (slice-to-bdd-env
-                           bsl1 env)
-                          (append vsl1 vsl2)))
-                   (generic-geval
-                    (shape-spec-to-gobj x)
-                    (cons (slice-to-bdd-env
-                           bsl1 env)
-                          vsl2))))
+ (defthm-shape-spec-flag
+   (defthm shape-spec-to-gobj-eval-slice-no-intersect-append-2
+     (implies (and (shape-specp x)
+                   (alistp vsl1)
+                   (not (intersectp-equal (shape-spec-vars x)
+                                          (strip-cars vsl1))))
+              (equal (sspec-geval
+                      (shape-spec-to-gobj x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            (append vsl1 vsl2)))
+                     (sspec-geval
+                      (shape-spec-to-gobj x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            vsl2))))
+     :flag ss)
+   (defthm shape-spec-list-to-gobj-eval-slice-no-intersect-append-2
+     (implies (and (shape-spec-listp x)
+                   (alistp vsl1)
+                   (not (intersectp-equal (shape-spec-list-vars x)
+                                          (strip-cars vsl1))))
+              (equal (sspec-geval-list
+                      (shape-spec-to-gobj-list x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            (append vsl1 vsl2)))
+                     (sspec-geval-list
+                      (shape-spec-to-gobj-list x)
+                      (cons (slice-to-bdd-env
+                             bsl1 env)
+                            vsl2))))
+     :flag list)
    :hints(("Goal" :in-theory (e/d (break-g-number
                                    num-spec-to-num-gobj
                                    number-spec-indices
@@ -722,17 +616,25 @@
                                    acl2::list-fix-when-true-listp
                                    acl2::list-fix-when-len-zero
                                    acl2::consp-by-len
-                                   acl2::hons-assoc-equal-append
                                    boolean-listp
                                    binary-append))
-           :induct (shape-spec-to-gobj x)
            :expand ((shape-spec-to-gobj x)
+                    (shape-spec-to-gobj-list x)
                     (shape-spec-indices x)
+                    (shape-spec-list-indices x)
                     (shape-spec-vars x)
-                    (shape-specp x)))
+                    (shape-spec-list-vars x)
+                    (shape-specp x)
+                    (shape-spec-listp x)))
           (and stable-under-simplificationp
-               (flag::expand-calls-computed-hint
-                acl2::clause '(generic-geval))))))
+               (let ((calls1 (acl2::find-calls-of-fns-term
+                              (car (last clause)) '(sspec-geval) nil))
+                     (calls2 (acl2::find-calls-of-fns-term
+                              (car (last clause)) '(sspec-geval-list) nil)))
+                 (and (or calls1 calls2)
+                      `(:computed-hint-replacement t
+                        :expand (,@(expands-with-hint 'sspec-geval calls1)
+                                   ,@(expands-with-hint 'sspec-geval-list calls2)))))))))
 
 
 (local
@@ -756,9 +658,15 @@
    :hints(("Goal" :in-theory (enable number-spec-env-slice)))))
 
 (local
- (defthm alistp-shape-spec-arbitrary-slice-1
-   (alistp (mv-nth 1 (shape-spec-arbitrary-slice x)))
-   :hints(("Goal" :in-theory (enable shape-spec-arbitrary-slice)))))
+ (defthm-shape-spec-flag
+   (defthm alistp-shape-spec-arbitrary-slice-1
+     (alistp (mv-nth 1 (shape-spec-arbitrary-slice x)))
+     :flag ss)
+   (defthm alistp-shape-spec-list-arbitrary-slice-1
+     (alistp (mv-nth 1 (shape-spec-list-arbitrary-slice x)))
+     :flag list)
+   :hints(("Goal" :in-theory (enable shape-spec-arbitrary-slice
+                                     shape-spec-list-arbitrary-slice)))))
 
 (local
  (defthm alistp-shape-spec-iff-env-slice-2
@@ -783,11 +691,19 @@
             (subsetp-equal x (append y z)))))
 
 (local
- (defthm shape-spec-vars-subset-cars-arbitrary-env-slice
-   (equal (strip-cars (mv-nth 1 (shape-spec-arbitrary-slice x)))
-          (shape-spec-vars x))
+ (defthm-shape-spec-flag
+   (defthm shape-spec-vars-subset-cars-arbitrary-env-slice
+     (equal (strip-cars (mv-nth 1 (shape-spec-arbitrary-slice x)))
+            (shape-spec-vars x))
+     :flag ss)
+   (defthm shape-spec-list-vars-subset-cars-arbitrary-env-slice
+     (equal (strip-cars (mv-nth 1 (shape-spec-list-arbitrary-slice x)))
+            (shape-spec-list-vars x))
+     :flag list)
    :hints(("Goal" :in-theory (enable shape-spec-vars
-                                     shape-spec-arbitrary-slice)))))
+                                     shape-spec-list-vars
+                                     shape-spec-arbitrary-slice
+                                     shape-spec-list-arbitrary-slice)))))
 
 (local
  (defthm shape-spec-vars-subset-cars-iff-env-slice
@@ -835,12 +751,22 @@
 
 
 (local
- (defthm shape-spec-indices-subset-cars-arbitrary-env-slice
-   (implies (shape-specp x)
-            (equal (strip-cars (mv-nth 0 (shape-spec-arbitrary-slice x)))
-                   (shape-spec-indices x)))
-   :hints (("goal" :in-theory (enable shape-spec-arbitrary-slice
+ (defthm-shape-spec-flag
+   (defthm shape-spec-indices-subset-cars-arbitrary-env-slice
+     (implies (shape-specp x)
+              (equal (strip-cars (mv-nth 0 (shape-spec-arbitrary-slice x)))
+                     (shape-spec-indices x)))
+     :flag ss)
+   (defthm shape-spec-list-indices-subset-cars-arbitrary-env-slice
+     (implies (shape-spec-listp x)
+              (equal (strip-cars (mv-nth 0 (shape-spec-list-arbitrary-slice x)))
+                     (shape-spec-list-indices x)))
+     :flag list)
+   :hints (("goal" :in-theory (enable shape-spec-list-arbitrary-slice
+                                      shape-spec-arbitrary-slice
+                                      shape-spec-list-indices
                                       shape-spec-indices
+                                      shape-spec-listp
                                       shape-specp)))))
 
 
@@ -893,32 +819,32 @@
 
 
 (local
- (defthm generic-geval-of-g-ite
-   (equal (generic-geval (g-ite if then else) env)
-          (if (generic-geval if env)
-              (generic-geval then env)
-            (generic-geval else env)))
-   :hints(("Goal" :in-theory (enable generic-geval)))))
+ (defthm sspec-geval-of-g-ite
+   (equal (sspec-geval (g-ite if then else) env)
+          (if (sspec-geval if env)
+              (sspec-geval then env)
+            (sspec-geval else env)))
+   :hints(("Goal" :in-theory (enable sspec-geval)))))
 
 
 (local
  (encapsulate nil
 
-   (defthm generic-geval-when-g-concrete-tag
+   (defthm sspec-geval-when-g-concrete-tag
      (implies (equal (tag x) :g-concrete)
-              (equal (generic-geval x env)
+              (equal (sspec-geval x env)
                      (g-concrete->obj x)))
-     :hints(("Goal" :in-theory (enable tag generic-geval)))
+     :hints(("Goal" :in-theory (e/d (tag sspec-geval))))
      :rule-classes ((:rewrite :backchain-limit-lst 0)))))
 
 
 (local
  (encapsulate nil
-   (defthm generic-geval-when-g-var-tag
+   (defthm sspec-geval-when-g-var-tag
      (implies (equal (tag x) :g-var)
-              (equal (generic-geval x env)
+              (equal (sspec-geval x env)
                      (cdr (hons-assoc-equal (g-var->name x) (cdr env)))))
-     :hints(("Goal" :in-theory (enable tag generic-geval))))))
+     :hints(("Goal" :in-theory (enable tag sspec-geval))))))
 
 (local (in-theory (disable member-equal equal-of-booleans-rewrite binary-append
                            intersectp-equal subsetp-equal)))
@@ -933,13 +859,13 @@
                               acl2::subsetp-car-member
                               acl2::append-when-not-consp
                               tag-when-atom
-                              generic-geval)))
+                              sspec-geval)))
    (defthm shape-spec-to-gobj-eval-iff-slice
      (implies (and (shape-specp x)
                    (no-duplicatesp (shape-spec-indices x))
                    (no-duplicatesp (shape-spec-vars x))
                    (mv-nth 0 (shape-spec-iff-env-slice x obj)))
-              (iff (generic-geval
+              (iff (sspec-geval
                     (shape-spec-to-gobj x)
                     (cons (slice-to-bdd-env
                            (mv-nth 1 (shape-spec-iff-env-slice x obj))
@@ -954,11 +880,9 @@
                       (shape-spec-to-gobj x)
                       (shape-specp x)
                       (:free (a b env)
-                             (generic-geval (cons a b) env))))
-            (and stable-under-simplificationp
-                 '(:in-theory (enable generic-geval)))
+                             (sspec-geval (cons a b) env))))
             (and stable-under-simplificationp
-                 '(:in-theory (enable slice-to-bdd-env generic-geval)))))))
+                 '(:in-theory (enable slice-to-bdd-env sspec-geval sspec-geval-list)))))))
 
 (local
  (defthm bfr-eval-list-numlist-update-non-member
@@ -970,6 +894,28 @@
    :hints(("Goal" :in-theory (enable numlist-to-vars bfr-eval-list
                                      nat-listp member-equal)))))
 
+(local
+ (defthm bfr-list->s-numlist-update-non-member
+   (implies (and (natp n) (nat-listp lst)
+                 (not (member-equal n lst)))
+            (equal (bfr-list->s (numlist-to-vars lst)
+                                  (bfr-set-var n x env))
+                   (bfr-list->s (numlist-to-vars lst) env)))
+   :hints(("Goal" :in-theory (enable numlist-to-vars bfr-list->s
+                                     scdr s-endp
+                                     nat-listp member-equal)))))
+
+(local
+ (defthm bfr-list->u-numlist-update-non-member
+   (implies (and (natp n) (nat-listp lst)
+                 (not (member-equal n lst)))
+            (equal (bfr-list->u (numlist-to-vars lst)
+                                  (bfr-set-var n x env))
+                   (bfr-list->u (numlist-to-vars lst) env)))
+   :hints(("Goal" :in-theory (enable numlist-to-vars bfr-list->u
+                                     scdr s-endp
+                                     nat-listp member-equal)))))
+
 
 (local
  (defthm consp-numlist-to-vars
@@ -979,22 +925,48 @@
 
 
 
+;; (local
+;;  (defthm v2i-redef
+;;    (equal (v2i x)
+;;           (if (atom x)
+;;               0
+;;             (if (atom (cdr x))
+;;                 (if (car x) -1 0)
+;;               (logcons (if (car x) 1 0) (v2i (cdr x))))))
+;;    :hints(("Goal" :in-theory (enable v2i acl2::ash**))
+;;           (and stable-under-simplificationp
+;;                '(:in-theory (enable logcons))))
+;;    :rule-classes ((:definition :clique (v2i)
+;;                    :controller-alist ((v2i t))))))
+
+;; (local
+;;  (defthm v2n-redef
+;;    (equal (v2n x)
+;;           (if (atom x)
+;;               0
+;;             (logcons (if (car x) 1 0) (v2n (cdr x)))))
+;;    :hints(("Goal" :in-theory (enable v2n acl2::ash**))
+;;           (and stable-under-simplificationp
+;;                '(:in-theory (enable logcons))))
+;;    :rule-classes ((:definition :clique (v2n)
+;;                    :controller-alist ((v2n t))))))
+
 (local
  (encapsulate nil
-   (local (in-theory (e/d (ash) (floor))))
+   (local (in-theory (e/d* (acl2::ihsext-recursive-redefs) (floor))))
    (defthm eval-slice-integer-env-slice
      (implies (and (mv-nth 0 (integer-env-slice lst n))
                    (no-duplicatesp lst)
                    (integerp n)
                    (nat-listp lst))
-              (equal (v2i (bfr-eval-list
+              (equal (bfr-list->s
                            (numlist-to-vars lst)
-                           (slice-to-bdd-env (mv-nth 1 (integer-env-slice lst n)) env)))
+                           (slice-to-bdd-env (mv-nth 1 (integer-env-slice lst n)) env))
                      n))
      :hints(("Goal" :in-theory (enable integer-env-slice
                                        numlist-to-vars
                                        bfr-eval-list
-                                       v2i nat-listp
+                                       nat-listp scdr s-endp
                                        slice-to-bdd-env
                                        integer-env-slice
                                        logbitp)
@@ -1005,19 +977,37 @@
                    (no-duplicatesp lst)
                    (natp n)
                    (nat-listp lst))
-              (equal (v2n (bfr-eval-list
+              (equal (bfr-list->u
                            (numlist-to-vars lst)
-                           (slice-to-bdd-env (mv-nth 1 (natural-env-slice lst n)) env)))
+                           (slice-to-bdd-env (mv-nth 1 (natural-env-slice lst n)) env))
                      n))
      :hints(("Goal" :in-theory (enable natural-env-slice
                                        numlist-to-vars
                                        bfr-eval-list
-                                       v2n nat-listp
+                                       nat-listp
                                        slice-to-bdd-env
                                        natural-env-slice
                                        logbitp)
              :induct (natural-env-slice lst n))))
 
+   ;; (defthm eval-slice-bfr-list->s-natural-env-slice
+   ;;   (implies (and (mv-nth 0 (natural-env-slice lst n))
+   ;;                 (no-duplicatesp lst)
+   ;;                 (natp n)
+   ;;                 (nat-listp lst))
+   ;;            (equal (bfr-list->s
+   ;;                         (numlist-to-vars lst)
+   ;;                         (slice-to-bdd-env (mv-nth 1 (natural-env-slice lst n)) env))
+   ;;                   n))
+   ;;   :hints(("Goal" :in-theory (enable natural-env-slice
+   ;;                                     numlist-to-vars
+   ;;                                     bfr-eval-list
+   ;;                                     nat-listp
+   ;;                                     slice-to-bdd-env
+   ;;                                     natural-env-slice
+   ;;                                     logbitp)
+   ;;           :induct (natural-env-slice lst n))))
+
 
    (defthm realpart-when-imagpart-0
      (implies (and (acl2-numberp x)
@@ -1056,6 +1046,64 @@
 ;;    :hints(("Goal" :in-theory (enable gobjectp-def g-concrete-p tag)))
 ;;    :rule-classes ((:rewrite :backchain-limit-lst 0))))
 
+;; (local (defthm loghead-non-integer
+;;          (implies (not (integerp x))
+;;                   (equal (loghead n x) 0))
+;;          :hints(("Goal" :in-theory (enable loghead)))
+;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;; (local (defthm logcdr-non-integer
+;;          (implies (not (integerp x))
+;;                   (equal (logcdr x) 0))
+;;          :hints(("Goal" :in-theory (enable logcdr)))))
+
+
+(local (defun cdr-logcdr (bits x)
+         (if (atom bits)
+             x
+           (cdr-logcdr (cdr bits) (logcdr x)))))
+
+(defthm natural-env-slice-ok-of-loghead
+  (mv-nth 0 (natural-env-slice bits (loghead (len bits) x)))
+  :hints(("Goal" :in-theory (enable len acl2::loghead** acl2::logtail**)
+          :expand ((:free (x)(natural-env-slice bits x)))
+          :induct (cdr-logcdr bits x))))
+
+
+;; (defthm v2i-of-append
+;;   (implies (consp b)
+;;            (equal (v2i (append a b))
+;;                   (logapp (len a) (v2n a) (v2i b))))
+;;   :hints(("Goal" :in-theory (e/d* (acl2::ihsext-recursive-redefs append len))
+;;           :induct (append a b))))
+
+(defthm len-bfr-eval-list
+  (equal (len (bfr-eval-list x env)) (len x)))
+
+(defthm len-numlist-to-vars
+  (equal (len (numlist-to-vars bits)) (len bits))
+  :hints(("Goal" :in-theory (enable numlist-to-vars))))
+
+(defthm logapp-of-loghead
+  (equal (logapp n (loghead n x) y)
+         (logapp n x y))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(defthm logapp-to-logtail
+  (equal (logapp n obj (logtail n obj))
+         (ifix obj))
+  :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+                                     acl2::ihsext-recursive-redefs))))
+
+(defthm int-set-sign-of-own-sign
+  (implies (integerp x)
+           (equal (int-set-sign (< x 0) x)
+                  x))
+  :hints(("Goal" :in-theory (e/d* (int-set-sign
+                                   acl2::ihsext-inductions
+                                   acl2::ihsext-recursive-redefs))))
+  :otf-flg t)
 
 
 (local
@@ -1063,15 +1111,42 @@
    (local (in-theory
            (e/d () (;; gobjectp-tag-rw-to-types
                     ;; gobjectp-ite-case
-                    ;; generic-geval-non-gobjectp
+                    ;; sspec-geval-non-gobjectp
                     break-g-number
                     sets::double-containment))))
+
+   (local (defthm g-keyword-symbolp-of-shape-spec-to-gobj
+            (equal (g-keyword-symbolp (shape-spec-to-gobj x))
+                   (g-keyword-symbolp x))
+            :hints(("Goal" :expand ((shape-spec-to-gobj x))))))
+   (local (defthm not-equal-shape-spec-to-gobj-keyword
+            (implies (and (not (g-keyword-symbolp x))
+                          (g-keyword-symbolp y))
+                     (not (equal (shape-spec-to-gobj x) y)))
+            :rule-classes ((:rewrite :backchain-limit-lst (0 1)))))
+   (local (defthm g-keyword-symbolp-compound-recognizer
+            (implies (g-keyword-symbolp x)
+                     (and (symbolp x)
+                          (not (booleanp x))))
+            :rule-classes :compound-recognizer))
+   (local (defthm shape-spec-to-gobj-when-atom
+            (implies (atom x)
+                     (equal (shape-spec-to-gobj x) x))
+            :hints(("Goal" :in-theory (enable shape-spec-to-gobj)))
+            :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+
+   (local (defthm kwote-lst-of-cons
+            (equal (kwote-lst (cons a b))
+                   (cons (kwote a) (kwote-lst b)))))
+   (local (in-theory (disable kwote-lst)))
+
    (defthm shape-spec-to-gobj-eval-slice
      (implies (and (shape-specp x)
                    (no-duplicatesp (shape-spec-indices x))
                    (no-duplicatesp (shape-spec-vars x))
                    (mv-nth 0 (shape-spec-env-slice x obj)))
-              (equal (generic-geval
+              (equal (sspec-geval
                       (shape-spec-to-gobj x)
                       (cons (slice-to-bdd-env
                              (mv-nth 1 (shape-spec-env-slice x obj))
@@ -1092,18 +1167,28 @@
                       (shape-spec-env-slice x obj))
              :induct (shape-spec-env-slice x obj))
             (and stable-under-simplificationp
-                 '(:in-theory (enable generic-geval break-g-number
+                 '(:in-theory (enable slice-to-bdd-env)
+                   :expand ((:free (x y env)
+                             (sspec-geval (cons x y) env))
+                            (:free (x y env)
+                             (sspec-geval-list (cons x y) env)))))
+            (and stable-under-simplificationp
+                 '(:in-theory (enable sspec-geval break-g-number
                                       number-spec-env-slice
                                       number-specp
                                       number-spec-indices
-                                      num-spec-to-num-gobj)))
-            (and stable-under-simplificationp
-                 '(:in-theory (enable slice-to-bdd-env generic-geval)))))))
-  
+                                      num-spec-to-num-gobj)))))))
+
 (local
- (defthm alistp-shape-spec-arbitrary-slice-0
-   (alistp (mv-nth 0 (shape-spec-arbitrary-slice x)))
-   :hints(("Goal" :in-theory (enable shape-spec-arbitrary-slice)))))
+ (defthm-shape-spec-flag
+   (defthm alistp-shape-spec-arbitrary-slice-0
+     (alistp (mv-nth 0 (shape-spec-arbitrary-slice x)))
+     :flag ss)
+   (defthm alistp-shape-spec-list-arbitrary-slice-0
+     (alistp (mv-nth 0 (shape-spec-list-arbitrary-slice x)))
+     :flag list)
+   :hints(("Goal" :in-theory (enable shape-spec-arbitrary-slice
+                                     shape-spec-list-arbitrary-slice)))))
 
 (local
  (defthm alistp-shape-spec-iff-env-slice-1
@@ -1124,23 +1209,6 @@
     (cons (slice-to-bdd-env bsl nil) vsl)))
 
 
-(defund shape-spec-obj-in-range-iff (x obj)
-  (declare (xargs :guard (shape-specp x)
-                  :guard-hints(("Goal" :in-theory (enable shape-specp)))))
-  (if (atom x)
-      (iff x obj)
-    (pattern-match x
-      ((g-number &)
-       obj)
-      ((g-boolean &) t)
-      ((g-var &) t)
-      ((g-ite if then else)
-       (or (and (shape-spec-obj-in-range-iff if t)
-                (shape-spec-obj-in-range-iff then obj))
-           (and (shape-spec-obj-in-range-iff if nil)
-                (shape-spec-obj-in-range-iff else obj))))
-      ((g-concrete y) (iff y obj))
-      (& obj))))
 
 (local
  (defthm shape-spec-obj-in-range-iff-shape-spec-iff-env-slice
@@ -1149,50 +1217,33 @@
    :hints(("Goal" :in-theory (enable shape-spec-obj-in-range-iff
                                      shape-spec-iff-env-slice)))))
 
-(defund integer-in-range (vlist obj)
-  (declare (xargs :guard t))
-  (and (integerp obj)
-       (if (atom vlist)
-           (eql obj 0)
-         (and (<= (- (ash 1 (len (cdr vlist)))) obj)
-              (< obj (ash 1 (len (cdr vlist))))))))
 
 (local
  (encapsulate nil
-   (local (include-book "ihs/ihs-lemmas" :dir :system))
    (local (in-theory (e/d (ash) (floor))))
-   (local (defthm expt-2-of-posp
-            (implies (posp x)
-                     (integerp (* 1/2 (expt 2 x))))
-            :rule-classes nil))
-   (local
-    (encapsulate nil
-      (local (defthm rw-equal-minus
-               (implies (and (posp x) (rationalp y))
-                        (equal (equal (expt 2 x) (- y))
-                               (equal (- (expt 2 x)) y)))))
-      (defthm negative-expt-2-of-posp
-        (implies (and (posp x) (rationalp y)
-                      (equal (expt 2 x) (- y)))
-                 (integerp (* 1/2 y)))
-        :rule-classes nil)))
+   (local (include-book "ihs/ihs-lemmas" :dir :system))
+   ;; (local (defthm expt-2-of-posp
+   ;;          (implies (posp x)
+   ;;                   (integerp (* 1/2 (expt 2 x))))
+   ;;          :rule-classes nil))
+   ;; (local
+   ;;  (encapsulate nil
+   ;;    (local (defthm rw-equal-minus
+   ;;             (implies (and (posp x) (rationalp y))
+   ;;                      (equal (equal (expt 2 x) (- y))
+   ;;                             (equal (- (expt 2 x)) y)))))
+   ;;    (defthm negative-expt-2-of-posp
+   ;;      (implies (and (posp x) (rationalp y)
+   ;;                    (equal (expt 2 x) (- y)))
+   ;;               (integerp (* 1/2 y)))
+   ;;      :rule-classes nil)))
 
    (defthm integer-in-range-integer-env-slice
      (implies (integerp obj)
               (equal (mv-nth 0 (integer-env-slice vlist obj))
                      (integer-in-range vlist obj)))
-     :hints(("Goal" :in-theory (enable integer-env-slice
-                                       integer-in-range))
-            ("Subgoal *1/4.4"
-             :use ((:instance negative-expt-2-of-posp
-                              (x (+ 1 (len (cddr vlist))))
-                              (y obj))))))))
-
-(defund natural-in-range (vlist obj)
-  (declare (xargs :guard t))
-  (and (natp obj)
-       (and (<= 0 obj)
-            (< obj (ash 1 (len vlist))))))
+     :hints(("Goal" :in-theory (enable* integer-env-slice
+                                        integer-in-range))))))
 
 (local
  (encapsulate nil
@@ -1206,23 +1257,6 @@
      :hints(("Goal" :in-theory (enable natural-env-slice
                                        natural-in-range))))))
 
-(defund number-spec-in-range (nspec obj)
-  (declare (xargs :guard (number-specp nspec)
-                  :guard-hints(("Goal" :in-theory (enable number-specp)))))
-  (and (acl2-numberp obj)
-       (integer-in-range (car nspec) (numerator (realpart obj)))
-       (if (consp (cdr nspec))
-           (and (natural-in-range (cadr nspec) (denominator (realpart obj)))
-                (if (consp (cddr nspec))
-                    (and (integer-in-range
-                          (caddr nspec) (numerator (imagpart obj)))
-                         (if (consp (cdddr nspec))
-                             (natural-in-range
-                              (cadddr nspec) (denominator (imagpart obj)))
-                           (eql (denominator (imagpart obj)) 1)))
-                  (rationalp obj)))
-         (integerp obj))))
-
 (local
  (defthm number-spec-in-range-number-spec-env-slice
    (equal (mv-nth 0 (number-spec-env-slice nspec obj))
@@ -1230,32 +1264,13 @@
    :hints(("Goal" :in-theory (enable number-spec-env-slice
                                      number-spec-in-range)))))
 
-(defund shape-spec-obj-in-range (x obj)
-  (declare (xargs :guard (shape-specp x)
-                  :guard-hints(("Goal" :in-theory (enable shape-specp)))))
-  (if (atom x)
-      (equal x obj)
-    (pattern-match x
-      ((g-number n) (number-spec-in-range n obj))
-      ((g-boolean &) (booleanp obj))
-      ((g-var &) t)
-      ((g-concrete y) (equal y obj))
-      ((g-ite if then else)
-       (or (and (shape-spec-obj-in-range-iff if t)
-                (shape-spec-obj-in-range then obj))
-           (and (shape-spec-obj-in-range-iff if nil)
-                (shape-spec-obj-in-range else obj))))
-      (& (and (consp obj)
-              (shape-spec-obj-in-range (car x) (car obj))
-              (shape-spec-obj-in-range (cdr x) (cdr obj)))))))
-
 (local
  (defthm shape-spec-obj-in-range-env-slice
    (iff (mv-nth 0 (shape-spec-env-slice x obj))
         (shape-spec-obj-in-range x obj))
    :hints(("Goal" :in-theory (enable shape-spec-obj-in-range
                                      shape-spec-env-slice)))))
-              
+
 
 
 
@@ -1264,7 +1279,7 @@
                 (no-duplicatesp (shape-spec-indices x))
                 (no-duplicatesp (shape-spec-vars x))
                 (shape-spec-obj-in-range x obj))
-           (equal (generic-geval
+           (equal (sspec-geval
                    (shape-spec-to-gobj x)
                    (shape-spec-to-env x obj))
                   obj))
@@ -1273,17 +1288,17 @@
 
 
 
-(defun shape-spec-to-gobj-list (x)
-  (if (atom x)
-      nil
-    (cons (shape-spec-to-gobj (car x))
-          (shape-spec-to-gobj-list (cdr x)))))
-
-(defun shape-spec-listp (x)
-  (if (atom x)
-      (equal x nil)
-    (and (shape-specp (car x))
-         (shape-spec-listp (cdr x)))))
+;; (defun shape-spec-to-gobj-list (x)
+;;   (if (atom x)
+;;       nil
+;;     (cons (shape-spec-to-gobj (car x))
+;;           (shape-spec-to-gobj-list (cdr x)))))
+
+;; (defun shape-spec-listp (x)
+;;   (if (atom x)
+;;       (equal x nil)
+;;     (and (shape-specp (car x))
+;;          (shape-spec-listp (cdr x)))))
 
 ;; (defthm shape-spec-listp-impl-shape-spec-to-gobj-list
 ;;   (implies (shape-spec-listp x)
@@ -1300,13 +1315,14 @@
 (defthm shape-spec-listp-implies-shape-specp
   (implies (shape-spec-listp x)
            (shape-specp x))
-  :hints(("Goal" :expand ((shape-specp x))
+  :hints(("Goal" :expand ((shape-specp x)
+                          (shape-spec-listp x))
           :in-theory (enable tag)
-          :induct (shape-spec-listp x))))
+          :induct (len x))))
+
 
 
 
-       
 
 
 
@@ -1369,6 +1385,9 @@
 
 (defthm shape-spec-obj-in-range-open-cons
   (implies (and (not (g-keyword-symbolp (car obj)))
+                (not (eq (car obj) :g-integer))
+                (not (eq (car obj) :g-integer?))
+                (not (eq (car obj) :g-call))
                 (consp obj))
            (equal (shape-spec-obj-in-range obj (cons carx cdrx))
                   (and (shape-spec-obj-in-range (car obj) carx)
@@ -1376,7 +1395,7 @@
   :hints(("Goal" :in-theory (enable shape-spec-obj-in-range
                                     g-keyword-symbolp-def
                                     member-equal)))
-  :rule-classes ((:rewrite :backchain-limit-lst (1 0))))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 0 0 0 0))))
 
 (defun binary-and* (a b)
   (declare (xargs :guard t))
@@ -1426,6 +1445,11 @@
   (implies (consp X)
            (natp (+ -1 (len x)))))
 
+(defthm shape-spec-obj-in-range-open-g-integer
+  (equal (shape-spec-obj-in-range `(:g-integer . ,rest) x)
+         (integerp x))
+  :hints(("Goal" :in-theory (enable shape-spec-obj-in-range))))
+
 (defthm shape-spec-obj-in-range-open-integer
   (equal (shape-spec-obj-in-range `(:g-number ,bits) x)
          (if (consp bits)
@@ -1433,7 +1457,7 @@
                    (<= (- (expt 2 (1- (len bits)))) x)
                    (< x (expt 2 (1- (len bits)))))
            (equal x 0)))
-  :hints(("Goal" :in-theory (enable shape-spec-obj-in-range 
+  :hints(("Goal" :in-theory (enable shape-spec-obj-in-range
                                     number-spec-in-range
                                     integer-in-range
                                     g-number->num
@@ -1489,6 +1513,16 @@
            (equal (shape-spec-obj-in-range lst obj) t)))
 
 
+(defthm shape-spec-obj-in-range-solve-integer?
+  (equal (shape-spec-obj-in-range `(:g-integer? . ,rest) x) t)
+  :hints(("Goal" :in-theory (enable shape-spec-obj-in-range))))
+
+(defthm shape-spec-obj-in-range-backchain-g-integer
+  (implies (integerp x)
+           (equal (shape-spec-obj-in-range `(:g-integer . ,rest) x)
+                  t))
+  :hints(("Goal" :in-theory (enable shape-spec-obj-in-range))))
+
 
 (defthm shape-spec-obj-in-range-backchain-integer-1
   (implies (and (consp bits)
@@ -1543,16 +1577,18 @@
 ;; simplification approach.  The backchain ruleset will be tried first to
 ;; reduce the goals to as few as possible clauses with conclusions that are
 ;; calls of shape-spec-obj-in-range on "atomic" shape specs (numbers, booleans,
-;; concretes.)  Then shape-spec-obj-in-range-open will 
+;; concretes.)  Then shape-spec-obj-in-range-open will
 (def-ruleset! shape-spec-obj-in-range-backchain
   '(shape-spec-obj-in-range-open-cons
+    shape-spec-obj-in-range-solve-integer?
+    shape-spec-obj-in-range-backchain-g-integer
     shape-spec-obj-in-range-backchain-integer-1
     shape-spec-obj-in-range-backchain-integer-2
     shape-spec-obj-in-range-backchain-boolean
     shape-spec-obj-in-range-backchain-concrete
     shape-spec-obj-in-range-backchain-atom
     shape-spec-obj-in-range-backchain-list-of-g-booleans
-    shape-spec-obj-in-range-var 
+    shape-spec-obj-in-range-var
     car-cons cdr-cons natp-compound-recognizer
     (shape-spec-obj-in-range) (g-keyword-symbolp) (ash)
     (expt) (unary--) (binary-+) (consp) (integerp) (len)
@@ -1561,6 +1597,8 @@
 
 (def-ruleset! shape-spec-obj-in-range-open
   '(shape-spec-obj-in-range-open-cons
+    shape-spec-obj-in-range-solve-integer?
+    shape-spec-obj-in-range-open-g-integer
     shape-spec-obj-in-range-open-integer
     shape-spec-obj-in-range-open-boolean
     shape-spec-obj-in-range-open-concrete
@@ -1575,108 +1613,862 @@
     (expt) (unary--) (binary-+) (consp) (integerp) (len)
     (car) (cdr) (booleanp) (list-of-g-booleansp) (tag) eql
     len-plus-one len-zero (zp) (boolean-listp) (true-listp)))
-    
 
 
 
-(defdoc shape-specs ":Doc-section ACL2::GL
-Simplified symbolic objects useful for coverage proofs in GL~/
+(defxdoc shape-specs
+  :parents (reference)
+  :short "Simplified symbolic objects useful for coverage proofs in GL."
+
+  :long "<p>Shape specifiers are a simplified format of GL symbolic objects,
+capable of representing Booleans, numbers, conses, free variables, and function
+calls.  While less expressive than full-fledged symbolic objects, shape spec
+objects make it easier to prove coverage lemmas necessary for proving theorems
+by symbolic simulation.  Here, we document common constructions of shape-spec
+objects and what it means to prove coverage.</p>
+
+<h3>Creating Shape Spec Objects</h3>
+
+<p>Shape spec objects are analogues of <see topic=\"@(url
+gl::symbolic-objects)\">symbolic objects</see>, but with several tweaks that make
+it more straightforward to prove that a given concrete object is covered:</p>
+<ul>
+<li>Symbolic objects contain arbitrary Boolean formulas (BDDs or AIGs), whereas
+shape specifiers are restricted to contain only independent Boolean variables.
+Therefore, every bit in a shape specifier is independent from every other
+bit.</li>
+<li>The @(':g-apply') symbolic object construct is replaced by the @(':g-call')
+shape specifier construct.  The @(':g-call') object has an additional field that holds a
+user-provided inverse function, which is useful for proving coverage; see @(see
+g-call).</li>
+</ul>
+
+<p>Shape spec objects may be created using the following constructors
+ (roughly in order of usefulness).  Additionally, a non-keyword atom is a shape
+spec representing itself:</p>
+
+<dl>
+
+<dt>@('(G-BOOLEAN <num>)')</dt>
+
+<dd>Represents a Boolean.  @('num') (a natural number) may not be repeated in
+any other @(':G-BOOLEAN') or @(':G-NUMBER') construct in the shape-spec.</dd>
+
+<dt>@('(G-NUMBER  (list <list-of-nums>))')</dt>
+
+<dd>Represents a two's-complement integer with bits corresponding to the list,
+least significant bit first.  Rationals and complex rationals are also
+available; @(see SYMBOLIC-OBJECTS).  A :G-NUMBER construct with a list of
+length @('N') represents integers @('X') where @('(<= (- (expt 2 n)) x)') and
+@('(< x (expt 2 n))').  The @('list-of-nums') must be natural numbers, may not
+repeat, and may not occur in any other @(':G-BOOLEAN') or @(':G-NUMBER')
+construct.</dd>
+
+<dt>@('(cons <Car> <Cdr>)')</dt>
+
+<dd>Represents a cons; Car and Cdr should be well-formed shape specifiers.</dd>
+
+<dt>@('(G-VAR <name>)')</dt>
+
+<dd>A free variable that may represent any object.  This is primarily useful
+when using GL's term-level capabilities; see @(see term-level-reasoning).</dd>
+
+<dt>@('(G-CALL <fnname> <arglist> <inverse>)')</dt>
+
+<dd>Represents a call of the named function applied to the given arguments.
+The @('inverse') does not affect the symbolic object generated, which is
+@('(:G-APPLY <fnname> . <arglist>)'), but is used in the coverage proof; see
+@(see g-call). This construct is primarily useful when using GL's term-level
+capabilities; see @(see term-level-reasoning).</dd>
+
+<dt>@('(G-ITE <test> <then> <else>)')</dt>
+<dd>Represents an if/then/else, where @('test'), @('then'), and @('else') are
+shape specs.</dd>
+
+</dl>
+
+
+<h3>What is a Coverage Proof?</h3>
+
+<p>In order to prove a theorem by symbolic simulation, one binds each variable
+mentioned in the theorem to a symbolic object and then symbolically simulates
+the conclusion of the theorem on these symbolic objects.  If the result is
+true, what can we conclude?  It depends on the coverage of the symbolic inputs.
+For example, one might symbolically simulate the term @('(< (+ A B) 7)') with
+@('A') and @('B') bound to symbolic objects representing two-bit natural
+numbers and recieve a result of @('T').  From this, it would be fallacious to
+conclude @('(< (+ 6 8) 7)'), because the symbolic simulation didn't cover the
+case where @('A') was 6 and @('B') 7.  In fact, it isn't certain that we can
+conclude @('(< (+ 2 2) 7)') from our symbolic simulation, because the symbolic
+object bindings for @('A') and @('B') might have interedependencies such that
+@('A') and @('B') can't simultaneously represent 2.  (For example, the bindings
+could be such that bit 0 of @('A') and @('B') are always opposite.)  In order
+to prove a useful theorem from the result of such a symbolic simulation, we
+must show that some set of concrete input vectors is covered by the symbolic
+objects bound to @('A') and @('B').  But in general, it is a tough
+computational problem to determine the set of concrete input vectors that are
+covered by a given symbolic input vector.</p>
+
+<p>To make these determinations easier, shape spec objects are somewhat
+restricted.  Whereas symbolic objects generally use BDDs (or AIGs, depending on
+the <see topic=\"@(url modes)\">mode</see>) to represent
+individual Booleans or bits of numeric values (see @(see symbolic-objects)),
+shape specs instead use natural numbers representing Boolean variables.
+Additionally, shape specs are restricted such that no Boolean variable number may
+be used more than once among the bindings for the variables of a theorem; this
+prevents interdependencies among them.</p>
+
+<p>While in general it is a difficult problem to determine whether a symbolic
+object can evaluate to a given concrete object, a function
+@('SHAPE-SPEC-OBJ-IN-RANGE') can make that determination about shape specs.
+@('SHAPE-SPEC-OBJ-IN-RANGE') takes two arguments, a shape spec and some object,
+and returns T if that object is in the coverage set of the shape spec, and NIL
+otherwise.  Therefore, if we wish to conclude that shape specs bound to @('A')
+and @('B') cover all two-bit natural numbers, we may prove the following
+theorem:</p>
 
-Shape specifiers are a simplified format of GL symbolic objects,
-capable of representing Booleans, numbers, and conses, as well as
-unconstrained variables and if-then-else objects.  While less
-expressive than full-fledged symbolic objects, shape spec objects make
-it easier to prove coverage lemmas necessary for proving theorems by
-symbolic simulation.  Here, we document common constructions of
-shape-spec objects and what it means to prove coverage.~/
-
-------------------------------------------------------
-
-CREATING SHAPE SPEC OBJECTS
-Shape spec objects are a straightforward transformation of symbolic
-objects: wherever a BDD occurs in a symbolic object, a shape specifier
-instead contains a natural number representing a BDD variable.
-Furthermore, ~c[G-APPLY] constructs are prohibited, and the BDD
-variable numbers used in an shape spec may not repeat, nor may the
-variable names used in ~c[G-VAR] constructs.  See
-~il[GL::SYMBOLIC-OBJECTS].  The most common and useful constructions
-of shape spec objects are as follows:
-
- (:G-BOOLEAN . <num>)
-Represents a Boolean.
-
- (:G-NUMBER  <list-of-nums>)
-Represents a two's-complement integer with bits corresponding to the
-list, least significant bit first.  Rationals and complex rationals
-are also available; ~l[GL::SYMBOLIC-OBJECTS].  A :G-NUMBER construct with
-a list of length ~c[N] represents integers ~c[X] where
- ~c[(<= (- (expt 2 n) x)] and ~c[(< x (expt 2 n))].
-
- (<Car> . <Cdr>)
-Represents a cons; Car and Cdr should be well-formed shape specifiers.
-
- <Atom>
-Represents the atom itself; must not be one of the six distinguished
-keyword symbols :G-CONCRETE, :G-BOOLEAN, :G-NUMBER, :G-ITE, :G-VAR, or
-:G-APPLY.
-
-------------------------------------------------------
-
-WHAT IS A COVERAGE PROOF?
-In order to prove a theorem by symbolic simulation, one binds each
-variable mentioned in the theorem to a symbolic object and then
-symbolically simulates the conclusion of the theorem on these symbolic
-objects.  If the result is true, what can we conclude?  It depends on
-the coverage of the symbolic inputs.  For example, one might
-symbolically simulate the term ~c[(< (+ A B) 7)] with ~c[A] and ~c[B]
-bound to symbolic objects representing two-bit natural numbers and
-recieve a result of ~c[T].  From this, it would be fallacious to
-conclude ~c[(< (+ 6 8) 7)], because the symbolic simulation didn't
-cover the case where ~c[A] was 6 and ~c[B] 7.  In fact, it isn't
-certain that we can conclude ~c[(< (+ 2 2) 7)] from our symbolic
-simulation, because the symbolic object bindings for ~c[A] and ~c[B]
-might have interedependencies such that ~c[A] and ~c[B] can't
-simultaneously represent 2.  (For example, the bindings could be such
-that bit 0 of ~c[A] and ~c[B] are always opposite.)  In order to prove
-a useful theorem from the result of such a symbolic simulation, we
-must show that some set of concrete input vectors is covered by the
-symbolic objects bound to ~c[A] and ~c[B].  But in general, it is a
-tough computational problem to determine the set of concrete input
-vectors that are covered by a given symbolic input vector.
-
-To make these determinations easier, shape spec objects are somewhat
-restricted.  Whereas symbolic objects generally use BDDs to represent
-individual Booleans or bits of numeric values (~l[GL::SYMBOLIC-OBJECTS]),
-shape specs instead use natural numbers representing UBDD variables.
-Additionally, shape specs are restricted such that no BDD variable
-number may be used more than once among the bindings for the variables
-of a theorem; this is to prevent interdependencies among them.
-
-While in general it is a difficult problem to determine whether a
-symbolic object can evaluate to a given concrete object, a function
-~c[SHAPE-SPEC-OBJ-IN-RANGE] can make that determination about shape
-specs.  ~c[SHAPE-SPEC-OBJ-IN-RANGE] takes two arguments, a shape spec
-and some object, and returns T if that object is in the coverage set
-of the shape spec, and NIL otherwise.  Therefore, if we wish to
-conclude that shape specs bound to ~c[A] and ~c[B] cover all two-bit
-natural numbers, we may prove the following theorem:
-~bv[]
+@({
  (implies (and (natp a) (< a 4)
                (natp b) (< b 4))
           (shape-spec-obj-in-range (list a-binding b-binding)
                                    (list a b)))
-~ev[]
+})
+
+<p>When proving a theorem using the GL clause processor, variable bindings are
+given as shape specs so that coverage obligations may be stated in terms of
+@('SHAPE-SPEC-OBJ-IN-RANGE').  The shape specs are converted to symbolic
+objects and may be parametrized based on some restrictions from the hypotheses,
+restricting their range further.  Thus, in order to prove a theorem about
+fixed-length natural numbers, for example, one may provide a shape specifier
+that additionally covers negative integers of the given length; parametrization
+can then restrict the symbolic inputs used in the simulation to only cover the
+naturals, while the coverage proof may still be done using the simpler,
+unparametrized shape spec.</p>")
+
+(defxdoc g-call
+  :parents (shape-specs term-level-reasoning)
+  :short "A shape-spec representing a function call."
+  :long
+  "<p>Note: This is an advanced topic.  You should first read @(see
+term-level-reasoning) to see whether this is of interest, then be familiar with
+@(see shape-specs) before reading this.</p>
+
+<p>@('G-CALL') is the constructor for a shape-spec representing a function
+call.  Usage:</p>
+
+@({
+  (g-call <function name>
+          <list of argument shape-specs>
+          <inverse function>)
+ })
+
+<p>This yields a G-APPLY object (see @(see symbolic-objects)):</p>
+@({
+  (g-apply <function name>
+           <list of argument symbolic objects>)
+ })
+
+<p>The inverse function field does not affect the symbolic object that is
+generated from the g-call object, but it determines how we attempt to prove the
+coverage obligation.</p>
+
+<p>The basic coverage obligation for assigning some variable V a shape spec SS
+is that for every possible value of V satisfying the hypotheses, there must be
+an environment under which the symbolic object derived from SS evaluates to
+that value.  The coverage proof must show that there exists such an
+environment.</p>
+
+<p>Providing an inverse function INV basically says:</p>
+
+<p><box>
+   \"If we need (FN ARGS) to evaluate to VAL, then ARGS should be (INV VAL).\"
+</box></p>
+
+<p>So to prove that (G-CALL FN ARGS INV) covers VAL, we first prove that ARGS
+cover (INV VAL), then that (FN (INV VAL)) equals VAL.  The argument that this
+works is:</p>
+
+<ul>
+
+<li>We first prove ARGS covers (INV VAL) -- that is, there exists some
+environment E under which the symbolic objects derived from ARGS evaluate
+to (INV VAL).</li>
+
+<li>Since (FN (INV VAL)) equals VAL, this same environment E suffices to make
+the symbolic object (FN ARGS) evaluate to VAL.</li>
+
+</ul>
+
+<p>We'll now show an example. We build on the memory example discussed in @(see
+term-level-reasoning).  Suppose we want to initially assign a memory object
+@('mem') a symbolic value under which address 1 has been assigned a 10-bit
+integer.  That is, we want to be able to assume only the following about
+@('mem'):</p>
+
+@({
+  (signed-byte-p 10 (access-mem 1 mem))
+ })
+
+<p>Assuming our memory follows the standard record rules, i.e.</p>
+
+@({
+  (update-mem addr (access-mem addr mem) mem) = mem,
+})
+
+<p>we can represent any such memory as</p>
+
+@({
+  (update-mem 1 <some 10-bit integer> <some memory>)
+})
+
+<p>Our shape-spec for this will therefore be:</p>
+
+@({
+ (g-call 'update-mem
+         (list 1
+               (g-number (list 0 1 2 3 4 5 6 7 8 9)) ;; 10-bit integer
+               (g-var 'mem)) ;; free variable
+         <some inverse function>)
+})
+
+<p>What is an appropriate inverse?  The inverse needs to take any memory
+satisfying our assumption and generate the list of necessary arguments to
+update-mem that fit this template.  The following works:</p>
+
+@({
+   (lambda (m) (list 1 (access-mem 1 m) m))
+})
+
+<p>because for any value m satisfying our assumptions,</p>
+
+<ul>
+
+<li>the first argument returned is 1, which is covered by our shape-spec 1</li>
+
+<li>the second argument returned will (by the assumption) be a 10-bit integer,
+which is covered by our g-number shape-spec</li>
+
+<li>the third argument returned matches our g-var shape-spec since anything at
+all is covered by it</li>
+
+<li>the final term we end up with is:
+@({
+        (update-mem 1 (access-mem 1 m) m)
+})
+    which (by the record rule above) equals m.</li>
+
+</ul>
+
+<p>GL tries to manage coverage proofs itself, and when using G-CALL constructs
+some rules besides the ones it typically uses may be necessary -- for example,
+the redundant record update rule used here.  You may add these rules to the
+rulesets used for coverage proofs as follows:</p>
+
+@({
+ (acl2::add-to-ruleset gl::shape-spec-obj-in-range-backchain
+                       redundant-mem-update)
+ (acl2::add-to-ruleset gl::shape-spec-obj-in-range-open
+                       redundant-mem-update)
+})
+
+<p>There are two rulesets because these are used in slightly different phases of
+the coverage proof.</p>
+
+<p>This feature has not yet been widely used and the detailed mechanisms
+for (e.g.)  adding rules to the coverage strategy are likely to change.</p>")
+
+
+
+
+
+(defund shape-spec-call-free (x)
+  (declare (xargs :guard t))
+  (or (atom x)
+      (pattern-match x
+        ((g-number &) t)
+        ((g-boolean &) t)
+        ((g-integer & & &) t)
+        ((g-integer? & & & &) t)
+        ((g-var &) t)
+        ((g-ite test then else)
+         (and (shape-spec-call-free test)
+              (shape-spec-call-free then)
+              (shape-spec-call-free else)))
+        ((g-concrete &) t)
+        ((g-call & & &) nil)
+        (& (and (shape-spec-call-free (car x))
+                (shape-spec-call-free (cdr x)))))))
+
+(local
+ (defsection shape-spec-call-free
+
+
+   (local (in-theory (enable shape-spec-call-free)))
+
+   (defthm shape-spec-call-free-by-tag
+     (implies (and (or (g-keyword-symbolp (tag x))
+                       (member (tag x) '(:g-integer :g-integer?)))
+                   (not (eq (tag x) :g-ite))
+                   (not (eq (tag x) :g-apply))
+                   (not (eq (tag x) :g-call)))
+              (shape-spec-call-free x))
+     :hints(("Goal" :in-theory (enable g-keyword-symbolp))))
+
+   (Defthm shape-spec-call-free-when-atom
+     (implies (not (consp x))
+              (shape-spec-call-free x))
+     :rule-classes ((:rewrite :backchain-limit-lst 0)))))
+
+(defsection car-term
+  (defund car-term (x)
+    (declare (xargs :guard (pseudo-termp x)))
+    (if (and (consp x)
+             (eq (car x) 'cons))
+        (cadr x)
+      `(car ,x)))
+  (local (in-theory (enable car-term)))
+  (defthm pseudo-termp-car-term
+    (implies (pseudo-termp x)
+             (pseudo-termp (car-term x))))
+
+  (defthm car-term-correct
+    (equal (sspec-geval-ev (car-term x) a)
+           (car (sspec-geval-ev x a)))))
+
+(defsection cdr-term
+  (defund cdr-term (x)
+    (declare (xargs :guard (pseudo-termp x)))
+    (if (and (consp x)
+             (eq (car x) 'cons))
+        (caddr x)
+      `(cdr ,x)))
+  (local (in-theory (enable cdr-term)))
+  (defthm pseudo-termp-cdr-term
+    (implies (pseudo-termp x)
+             (pseudo-termp (cdr-term x))))
+
+  (defthm cdr-term-correct
+    (equal (sspec-geval-ev (cdr-term x) a)
+           (cdr (sspec-geval-ev x a)))))
+
+
+
+(defsection make-nth-terms
+  (defund make-nth-terms (x start n)
+    (declare (xargs :guard (and (natp start) (natp n))))
+    (if (zp n)
+        nil
+      (cons `(nth ',(lnfix start) ,x)
+            (make-nth-terms x (1+ (lnfix start)) (1- n)))))
+
+  (local (in-theory (enable make-nth-terms)))
+
+  (defthm pseudo-term-listp-make-nth-terms
+    (implies (and (pseudo-termp x)
+                  (natp start))
+             (pseudo-term-listp (make-nth-terms x start n)))
+    :hints(("Goal" :in-theory (enable make-nth-terms))))
+
+  (defthm ev-of-make-nth-terms
+    (equal (sspec-geval-ev-lst (make-nth-terms x start n) a)
+           (take n (nthcdr start (sspec-geval-ev x a))))
+    :hints(("Goal" :in-theory (enable acl2::take-redefinition
+                                      nthcdr)))))
+
+(defsection shape-spec-oblig-term
+
+  ;; (defund sspec-apply-get-inverse-fn (fn state)
+  ;;   (declare (xargs :stobjs state))
+  ;;   (b* ((inverse (cdr (hons-assoc-equal fn (table-alist
+  ;;                                            'gl-inverse-functions (w
+  ;;                                                                   state))))))
+  ;;     (and (symbolp inverse)
+  ;;          (not (eq inverse 'quote))
+  ;;          inverse)))
+
+  ;; (defthm sspec-apply-get-inverse-type
+  ;;   (symbolp (sspec-apply-get-inverse-fn fn state))
+  ;;   :hints(("Goal" :in-theory (enable sspec-apply-get-inverse-fn)))
+  ;;   :rule-classes :type-prescription)
+
+  ;; (defthm sspec-apply-get-inverse-not-equote
+  ;;   (not (equal (sspec-apply-get-inverse-fn fn state) 'quote))
+  ;;   :hints(("Goal" :in-theory (enable sspec-apply-get-inverse-fn))))
+
+  (definlined ss-unary-function-fix (x)
+    (declare (xargs :guard (ss-unary-functionp x)))
+    (mbe :logic (if (ss-unary-functionp x)
+                    x
+                  nil)
+         :exec x))
+
+  (defthm ss-unary-functionp-of-ss-unary-function-fix
+    (ss-unary-functionp (ss-unary-function-fix x))
+    :hints(("Goal" :in-theory (enable ss-unary-function-fix))))
+
+  (defthm pseudo-termp-with-unary-function
+    (implies (and (ss-unary-functionp f)
+                  (pseudo-termp arg))
+             (pseudo-termp (list f arg)))
+    :hints(("Goal" :in-theory (enable ss-unary-functionp))))
+
+  (mutual-recursion
+   (defun shape-spec-oblig-term (x obj-term iff-flg)
+     (declare (xargs :guard (and (shape-specp x)
+                                 (pseudo-termp obj-term))
+                     :guard-hints (("goal" :expand ((shape-specp x)
+                                                    (shape-spec-listp x)
+                                                    (:free (a b) (pseudo-termp
+                                                                  (cons a b))))
+                                    :in-theory (disable pseudo-termp)))
+                     :guard-debug t))
+     (if (shape-spec-call-free x)
+         `(,(if iff-flg 'shape-spec-obj-in-range-iff 'shape-spec-obj-in-range)
+           ',x ,obj-term)
+       (pattern-match x
+         ((g-ite test then else)
+          `(if (if ,(shape-spec-oblig-term test ''t t)
+                   ,(shape-spec-oblig-term then obj-term iff-flg)
+                 'nil)
+               't
+             (if ,(shape-spec-oblig-term test ''nil t)
+                 ,(shape-spec-oblig-term else obj-term iff-flg)
+               'nil)))
+         ((g-call fn args inverse)
+          (b* ((inverse (ss-unary-function-fix inverse))
+               (arity (len args))
+               (inverse-term `(,inverse ,obj-term))
+               (nths (make-nth-terms inverse-term 0 arity)))
+            `(if ,(shape-spec-list-oblig-term args nths)
+                 (,(if iff-flg 'iff 'equal)
+                  (,fn . ,nths)
+                  ,obj-term)
+               'nil)))
+         (& (if iff-flg
+                obj-term
+              `(if (consp ,obj-term)
+                   (if ,(shape-spec-oblig-term (car x) (car-term obj-term) nil)
+                       ,(shape-spec-oblig-term (cdr x) (cdr-term obj-term) nil)
+                     'nil)
+                 'nil))))))
+   (defun shape-spec-list-oblig-term (x obj-terms)
+     (declare (xargs :guard (and (shape-spec-listp x)
+                                 (pseudo-term-listp obj-terms))))
+     (if (atom x)
+         (if (eq obj-terms nil)
+             ''t
+           ''nil)
+       (if (consp obj-terms)
+           `(if ,(shape-spec-oblig-term (car x) (car obj-terms) nil)
+                ,(shape-spec-list-oblig-term (cdr x) (cdr obj-terms))
+              'nil)
+         ''nil))))
+
+
+
+  (mutual-recursion
+   (defun shape-spec-env-term (x obj-term iff-flg)
+     (declare (xargs :guard (and (shape-specp x)
+                                 (pseudo-termp obj-term))
+                     :guard-hints (("goal" :expand ((shape-specp x)
+                                                    (shape-spec-listp x)
+                                                    (:free (a b) (pseudo-termp
+                                                                  (cons a b))))
+                                    :in-theory (disable pseudo-termp)))
+                     :guard-debug t))
+     (if (shape-spec-call-free x)
+         `(shape-spec-slice-to-env
+           (,(if iff-flg 'shape-spec-iff-env-slice 'shape-spec-env-slice)
+            ',x ,obj-term))
+       (pattern-match x
+         ((g-ite test then else)
+          (b* ((then-term (shape-spec-env-term then obj-term iff-flg))
+               (else-term (shape-spec-env-term else obj-term iff-flg))
+               (both `(ss-append-envs ,then-term ,else-term)))
+            `(if (if ,(shape-spec-oblig-term test ''t t)
+                     ,(shape-spec-oblig-term then obj-term iff-flg)
+                   'nil)
+                 (ss-append-envs
+                  ,(shape-spec-env-term test ''t t)
+                  ,both)
+               (ss-append-envs
+                ,(shape-spec-env-term test ''nil t)
+                ,both))))
+         ((g-call & args inverse)
+          (b* ((inverse (ss-unary-function-fix inverse))
+               (inverse-term `(,inverse ,obj-term))
+               (nths (make-nth-terms inverse-term 0 (len args))))
+            (shape-spec-list-env-term args nths)))
+         (& `(ss-append-envs
+              ,(shape-spec-env-term (car x) (car-term obj-term) nil)
+              ,(shape-spec-env-term (cdr x) (cdr-term obj-term) nil))))))
+   (defun shape-spec-list-env-term (x obj-terms)
+     (declare (xargs :guard (and (shape-spec-listp x)
+                                 (pseudo-term-listp obj-terms))))
+     (if (atom x)
+         ''(nil)
+       `(ss-append-envs
+         ,(shape-spec-env-term (car x) (car obj-terms) nil)
+         ,(shape-spec-list-env-term (cdr x) (cdr obj-terms))))))
+
+  (local (in-theory (enable shape-spec-oblig-term shape-spec-env-term)))
+
+
+  (flag::make-flag shape-spec-term-flag shape-spec-env-term
+                   :flag-mapping ((shape-spec-env-term . ss)
+                                  (shape-spec-list-env-term . list)))
+  (defthm-shape-spec-term-flag
+    (defthm pseudo-termp-shape-spec-oblig-term
+      (implies (and (pseudo-termp obj-term)
+                    (shape-specp x))
+               (pseudo-termp (shape-spec-oblig-term x obj-term iff-flg)))
+      :flag ss)
+    (defthm pseudo-term-listp-shape-spec-oblig-term
+      (implies (and (pseudo-term-listp obj-terms)
+                    (shape-spec-listp x))
+               (pseudo-termp (shape-spec-list-oblig-term x obj-terms)))
+      :flag list)
+    :hints(("Goal" ;;:induct (shape-spec-oblig-term x obj-term iff-flg)
+            :in-theory (disable pseudo-termp)
+            :expand ((shape-specp x)
+                     (shape-spec-listp x)
+                     (:free (a b) (pseudo-termp (cons a b)))))))
+
+  (defthm-shape-spec-term-flag
+    (defthm pseudo-termp-shape-spec-env-term
+      (implies (and (pseudo-termp obj-term)
+                    (shape-specp x))
+               (pseudo-termp (shape-spec-env-term x obj-term iff-flg)))
+      :flag ss)
+    (defthm pseudo-termp-shape-spec-list-env-term
+      (implies (and (pseudo-term-listp obj-terms)
+                    (shape-spec-listp x))
+               (pseudo-termp (shape-spec-list-env-term x obj-terms)))
+      :flag list)
+      :hints(("Goal" ;; :induct (shape-spec-env-term x obj-term iff-flg)
+              :in-theory (disable pseudo-termp)
+              :expand ((shape-specp x)
+                       (shape-spec-listp x)
+                       (:free (a b) (pseudo-termp (cons a b)))))))
+
+  (defthm-shape-spec-term-flag
+    (defthm indices-of-shape-spec-env-term
+      (implies (shape-specp x)
+               (equal (strip-cars
+                       (car (sspec-geval-ev (shape-spec-env-term x obj-term iff-flg) a)))
+                      (shape-spec-indices x)))
+      :flag ss)
+    (defthm indices-of-shape-spec-list-env-term
+      (implies (shape-spec-listp x)
+               (equal (strip-cars
+                       (car (sspec-geval-ev (shape-spec-list-env-term x obj-terms) a)))
+                      (shape-spec-list-indices x)))
+      :flag list)
+      :hints (("goal" ;; :induct (shape-spec-env-term x obj-term iff-flg)
+               :expand ((shape-spec-indices x)
+                        (shape-spec-list-indices x)
+                        (shape-specp x)
+                        (shape-spec-listp x)))
+              (and stable-under-simplificationp
+                   '(:use ((:instance shape-spec-indices-subset-cars-env-slice
+                            (obj (sspec-geval-ev obj-term a)))
+                           (:instance shape-spec-indices-subset-cars-iff-env-slice
+                            (obj (sspec-geval-ev obj-term a))))
+                     :in-theory (disable shape-spec-indices-subset-cars-env-slice
+                                         shape-spec-indices-subset-cars-iff-env-slice)))))
+
+  (defthm-shape-spec-term-flag
+    (defthm vars-of-shape-spec-env-term
+      (implies (shape-specp x)
+               (equal (strip-cars
+                       (cdr (sspec-geval-ev (shape-spec-env-term x obj-term iff-flg) a)))
+                      (shape-spec-vars x)))
+      :flag ss)
+    (defthm vars-of-shape-spec-list-env-term
+      (implies (shape-spec-listp x)
+               (equal (strip-cars
+                       (cdr (sspec-geval-ev (shape-spec-list-env-term x obj-terms) a)))
+                      (shape-spec-list-vars x)))
+      :flag list)
+      :hints (("goal" ;; :induct (shape-spec-env-term x obj-term iff-flg)
+               :expand ((shape-spec-vars x)
+                        (shape-spec-list-vars x)
+                        (shape-specp x)
+                        (shape-spec-listp x)))
+              (and stable-under-simplificationp
+                   '(:use ((:instance shape-spec-vars-subset-cars-env-slice
+                            (obj (sspec-geval-ev obj-term a)))
+                           (:instance shape-spec-vars-subset-cars-iff-env-slice
+                            (obj (sspec-geval-ev obj-term a))))
+                     :in-theory (disable shape-spec-vars-subset-cars-env-slice
+                                         shape-spec-vars-subset-cars-iff-env-slice)))))
+
+
+  (defthm-shape-spec-term-flag
+    (defthm alistp-car-shape-spec-env-term
+      (alistp (car (sspec-geval-ev (shape-spec-env-term x obj-term iff-flg)
+                                   a)))
+      :flag ss)
+    (defthm alistp-car-shape-spec-list-env-term
+      (alistp (car (sspec-geval-ev (shape-spec-list-env-term x obj-terms)
+                                   a)))
+      :flag list))
+
+  (defthm-shape-spec-term-flag
+    (defthm alistp-cdr-shape-spec-env-term
+      (alistp (cdr (sspec-geval-ev (shape-spec-env-term x obj-term iff-flg)
+                                   a)))
+      :flag ss)
+    (defthm alistp-cdr-shape-spec-list-env-term
+      (alistp (cdr (sspec-geval-ev (shape-spec-list-env-term x obj-terms)
+                                   a)))
+      :flag list))
+
+  (local (defthm g-keyword-symbolp-of-shape-spec-to-gobj
+           (equal (g-keyword-symbolp (shape-spec-to-gobj x))
+                  (g-keyword-symbolp x))
+           :hints(("Goal" :expand ((shape-spec-to-gobj x))))))
+
+  ;; (local (defthm equal-keyword-shape-spec-to-gobj
+  ;;          (implies (and (syntaxp (quotep key))
+  ;;                        (g-keyword-symbolp key))
+  ;;                   (equal (equal (shape-spec-to-gobj x) key)
+  ;;                          (equal x key)))
+  ;;          :hints(("Goal" :in-theory (enable shape-spec-to-gobj)))))
+
+  (defthm sspec-geval-of-gl-cons
+    (equal (sspec-geval (gl-cons a b) env)
+           (cons (sspec-geval a env)
+                 (sspec-geval b env)))
+    :hints(("Goal" :in-theory (enable sspec-geval g-keyword-symbolp))))
+
+  (defthm sspec-geval-of-g-apply
+    (implies (not (eq fn 'quote))
+             (equal (sspec-geval (g-apply fn args) env)
+                    (sspec-geval-ev (cons fn (kwote-lst (sspec-geval-list args env))) nil)))
+    :hints(("Goal" :in-theory (enable sspec-geval g-keyword-symbolp))))
+
+
+  ;; (local (defthm non-keyword-symbol-by-shape-spec-call-free
+  ;;          (implies (and (not (shape-spec-call-free x))
+  ;;                        (not (eq (tag x) :g-ite))
+  ;;                        (not (eq (tag x) :g-apply)))
+  ;;                   (not (g-keyword-symbolp (tag x))))
+  ;;          :hints(("Goal" :in-theory (enable g-keyword-symbolp)))))
+
+
+  (local (in-theory (disable shape-spec-call-free)))
+
+  (local (in-theory (disable iff kwote-lst)))
+
+  (local
+   (progn
+
+     (defthm shape-spec-to-gobj-of-cons
+       (implies (and (not (shape-spec-call-free x))
+                     (not (member (tag x) '(:g-ite :g-call))))
+                (equal (shape-spec-to-gobj x)
+                       (gl-cons (shape-spec-to-gobj (car x))
+                                (shape-spec-to-gobj (cdr x)))))
+       :hints(("Goal" :in-theory (enable shape-spec-to-gobj))))
+
+     (defthm shape-spec-indices-of-cons
+       (implies (and (not (shape-spec-call-free x))
+                     (not (member (tag x) '(:g-ite :g-call))))
+                (equal (shape-spec-indices x)
+                       (append (shape-spec-indices (car x))
+                               (shape-spec-indices (cdr x)))))
+       :hints(("Goal" :in-theory (enable shape-spec-indices))))
+
+     (defthm shape-spec-vars-of-cons
+       (implies (and (not (shape-spec-call-free x))
+                     (not (member (tag x) '(:g-ite :g-call))))
+                (equal (shape-spec-vars x)
+                       (append (shape-spec-vars (car x))
+                               (shape-spec-vars (cdr x)))))
+       :hints(("Goal" :in-theory (enable shape-spec-vars))))
+
+     (defthm shape-specp-car/cdr
+       (implies (and (not (shape-spec-call-free x))
+                     (not (member (tag x) '(:g-ite :g-call)))
+                     (shape-specp x))
+                (and (shape-specp (car x))
+                     (shape-specp (cdr x))))
+       :hints(("Goal" :in-theory (enable shape-specp))))
+
+     (defthm shape-spec-to-gobj-of-g-call
+       (implies (equal (tag x) :g-call)
+                (equal (shape-spec-to-gobj x)
+                       (g-apply (g-call->fn x)
+                                (shape-spec-to-gobj-list (g-call->args x)))))
+       :hints(("Goal" :in-theory (enable shape-spec-to-gobj))))
+
+     (defthm shape-spec-indices-of-g-call
+       (implies (equal (tag x) :g-call)
+                (equal (shape-spec-indices x)
+                       (shape-spec-list-indices (g-call->args x))))
+       :hints(("Goal" :in-theory (enable shape-spec-indices))))
+
+     (defthm shape-spec-vars-of-g-call
+       (implies (equal (tag x) :g-call)
+                (equal (shape-spec-vars x)
+                       (shape-spec-list-vars (g-call->args x))))
+       :hints(("Goal" :in-theory (enable shape-spec-vars))))
+
+     (defthm shape-specp-g-call
+       (implies (and (equal (tag x) :g-call)
+                     (shape-specp x))
+                (and (shape-spec-listp (g-call->args x))
+                     (symbolp (g-call->fn x))
+                     (not (equal (g-call->fn x) 'quote))
+                     (ss-unary-functionp (g-call->inverse x))))
+       :hints(("Goal" :in-theory (enable shape-specp))))
+
+     (defthm shape-spec-to-gobj-of-g-ite
+       (implies (equal (tag x) :g-ite)
+                (equal (shape-spec-to-gobj x)
+                       (g-ite (shape-spec-to-gobj (g-ite->test x))
+                              (shape-spec-to-gobj (g-ite->then x))
+                              (shape-spec-to-gobj (g-ite->else x)))))
+       :hints(("Goal" :in-theory (enable shape-spec-to-gobj))))
+
+     (defthm shape-spec-indices-of-g-ite
+       (implies (equal (tag x) :g-ite)
+                (equal (shape-spec-indices x)
+                       (append (shape-spec-indices (g-ite->test x))
+                               (shape-spec-indices (g-ite->then x))
+                               (shape-spec-indices (g-ite->else x)))))
+       :hints(("Goal" :in-theory (enable shape-spec-indices))))
+
+     (defthm shape-spec-vars-of-g-ite
+       (implies (equal (tag x) :g-ite)
+                (equal (shape-spec-vars x)
+                       (append (shape-spec-vars (g-ite->test x))
+                               (shape-spec-vars (g-ite->then x))
+                               (shape-spec-vars (g-ite->else x)))))
+       :hints(("Goal" :in-theory (enable shape-spec-vars))))
+
+     (defthm shape-specp-g-ite
+       (implies (and (equal (tag x) :g-ite)
+                     (shape-specp x))
+                (and (shape-specp (g-ite->test x))
+                     (shape-specp (g-ite->then x))
+                     (shape-specp (g-ite->else x))))
+       :hints(("Goal" :in-theory (enable shape-specp))))))
+
+  (local (in-theory (disable not)))
+
+  (local (in-theory (disable (:t shape-spec-oblig-term)
+                             (:t shape-spec-env-term)
+                             shape-spec-call-free-by-tag
+                             acl2::consp-by-len
+                             acl2::true-listp-append
+                             acl2::no-duplicatesp-equal-when-atom
+                             acl2::no-duplicatesp-equal-non-cons
+                             acl2::consp-of-append
+                             default-car
+                             tag-when-atom
+                             default-cdr)))
+
+
+  (local
+   (defthm-shape-spec-term-flag
+     (defthm shape-spec-oblig-term-correct-lemma
+       (let ((env (sspec-geval-ev (shape-spec-env-term
+                                   x obj-term iff-flg)
+                                  a)))
+         (implies (and (sspec-geval-ev (shape-spec-oblig-term x obj-term iff-flg) a)
+                       (shape-specp x)
+                       (no-duplicatesp (shape-spec-indices x))
+                       (no-duplicatesp (shape-spec-vars x)))
+                  (if iff-flg
+                      (iff (sspec-geval (shape-spec-to-gobj x)
+                                        (cons (slice-to-bdd-env (car env) ee)
+                                              (cdr env)))
+                           (sspec-geval-ev obj-term a))
+                    (equal (sspec-geval (shape-spec-to-gobj x)
+                                        (cons (slice-to-bdd-env (car env) ee)
+                                              (cdr env)))
+                           (sspec-geval-ev obj-term a)))))
+       :rule-classes nil
+       :flag ss)
+     (defthm shape-spec-list-oblig-term-correct
+       (let ((env (sspec-geval-ev (shape-spec-list-env-term
+                                   x obj-terms)
+                                  a)))
+         (implies (and (sspec-geval-ev (shape-spec-list-oblig-term x obj-terms) a)
+                       (shape-spec-listp x)
+                       (no-duplicatesp (shape-spec-list-indices x))
+                       (no-duplicatesp (shape-spec-list-vars x)))
+                  (equal (sspec-geval-list (shape-spec-to-gobj-list x)
+                                           (cons (slice-to-bdd-env (car env) ee)
+                                                 (cdr env)))
+                         (sspec-geval-ev-lst obj-terms a))))
+       :flag list)
+           :hints (("goal" ;; :induct (shape-spec-oblig-term
+                           ;;          x obj-term iff-flg)
+                    :in-theory (e/d (sspec-geval-ev-of-fncall-args)
+                                    (gl-cons (:d shape-spec-env-term)
+                                             (:d shape-spec-oblig-term)))
+                    :expand ((:free (iff-flg) (shape-spec-env-term
+                                               x obj-term iff-flg))
+                             (:free (iff-flg) (shape-spec-oblig-term
+                                               x obj-term iff-flg))
+                             (:free (env) (sspec-geval-list nil env))
+                             (:free (a b env) (sspec-geval-list (cons a b) env))
+                             (shape-spec-to-gobj-list x)
+                             (shape-spec-listp x)
+                             (shape-spec-list-indices x)
+                             (shape-spec-list-vars x))
+                    :do-not-induct t))
+           ;; (shape-specp x)
+           ;; (shape-spec-indices x)
+           ;; (shape-spec-vars x)
+           ;; (:with sspec-geval
+           ;;  (:free (a b env) (sspec-geval (cons a b) env)))
+           ))
+
+  (defthm shape-spec-oblig-term-correct
+    (let ((env (sspec-geval-ev (shape-spec-env-term
+                                x obj-term nil)
+                               a)))
+      (implies (and (sspec-geval-ev (shape-spec-oblig-term x obj-term nil) a)
+                    (shape-specp x)
+                    (no-duplicatesp (shape-spec-indices x))
+                    (no-duplicatesp (shape-spec-vars x)))
+               (equal (sspec-geval (shape-spec-to-gobj x)
+                                   (cons (slice-to-bdd-env (car env) ee)
+                                         (cdr env)))
+                      (sspec-geval-ev obj-term a))))
+    :hints (("goal" :use ((:instance shape-spec-oblig-term-correct-lemma
+                           (iff-flg nil))))))
+
+  (defthm shape-spec-list-oblig-term-correct
+    (let ((env (sspec-geval-ev (shape-spec-list-env-term
+                                x obj-terms)
+                               a)))
+      (implies (and (sspec-geval-ev (shape-spec-list-oblig-term x obj-terms) a)
+                    (shape-spec-listp x)
+                    (no-duplicatesp (shape-spec-list-indices x))
+                    (no-duplicatesp (shape-spec-list-vars x)))
+               (equal (sspec-geval-list (shape-spec-to-gobj-list x)
+                                        (cons (slice-to-bdd-env (car env) ee)
+                                              (cdr env)))
+                      (sspec-geval-ev-lst obj-terms a)))))
+
+  (defthm shape-spec-oblig-term-correct-iff
+    (let ((env (sspec-geval-ev (shape-spec-env-term
+                                x obj-term t)
+                               a)))
+      (implies (and (sspec-geval-ev (shape-spec-oblig-term x obj-term t) a)
+                    (shape-specp x)
+                    (no-duplicatesp (shape-spec-indices x))
+                    (no-duplicatesp (shape-spec-vars x)))
+               (iff (sspec-geval (shape-spec-to-gobj x)
+                                 (cons (slice-to-bdd-env (car env) ee)
+                                       (cdr env)))
+                    (sspec-geval-ev obj-term a))))
+    :hints (("goal" :use ((:instance shape-spec-oblig-term-correct-lemma
+                           (iff-flg t)))))))
+
 
-When proving a theorem using the GL clause processor, variable
-bindings are given as shape specs so that coverage obligations may be
-stated in terms of ~c[SHAPE-SPEC-OBJ-IN-RANGE].  The shape specs are
-converted to symbolic objects and may be parametrized based on some
-restrictions from the hypotheses, restricting their range further.
-Thus, in order to prove a theorem about fixed-length natural numbers,
-for example, one may provide a shape specifier that additionally
-covers negative integers of the given length; parametrization can then
-restrict the symbolic inputs used in the simulation to only cover the
-naturals, while the coverage proof may still be done using the
-simpler, unparametrized shape spec.
-~/
-")
diff -Nru acl2-6.2/books/centaur/gl/solutions.lisp acl2-6.3/books/centaur/gl/solutions.lisp
--- acl2-6.2/books/centaur/gl/solutions.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/solutions.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,270 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+
+; solutions.lisp - Solutions to the tutorial exercises
+;
+; Original authors: Sol Swords <sswords@centtech.com>
+;                   Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "gl")
+; cert_param: (hons-only)
+
+
+;; Solutions to exercises in the GL Basic Tutorial
+;;
+;; We space these out excessively, so you can avoid looking at answers you
+;; haven't gotten to yet.
+
+
+
+
+
+
+
+
+
+
+
+
+
+(def-gl-thm 1a
+  :hyp (and (unsigned-byte-p 4 x)
+            (unsigned-byte-p 4 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings '((x (:g-number (1 2 3 4 5)))
+                (y (:g-number (6 7 8 9 10)))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(def-gl-thm 1b-using-auto-bindings
+  :hyp (and (unsigned-byte-p 4 x)
+            (unsigned-byte-p 4 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings (gl::auto-bindings (:nat x 4)
+                                 (:nat y 4)))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(def-gl-thm 1b-using-g-int
+  :hyp (and (unsigned-byte-p 4 x)
+            (unsigned-byte-p 4 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings `((x ,(gl::g-int 0 1 5))
+                (y ,(gl::g-int 6 1 5))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;; We already did 1b manually (see 1a).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(def-gl-thm 1c
+  :hyp (and (unsigned-byte-p 20 x)
+            (unsigned-byte-p 20 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings (gl::auto-bindings (:nat x 20)
+                                 (:nat y 20)))
+
+;; The above took 24 seconds.
+
+
+(value-triple (hons-summary))  ;; It allocated 8 million honses.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+; 1d doesn't require a new proof.
+
+#||
+
+:u
+(def-gl-thm 1c
+  :hyp (and (unsigned-byte-p 20 x)
+            (unsigned-byte-p 20 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings (gl::auto-bindings (:nat x 20)
+                                 (:nat y 20)))
+
+||#
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(value-triple (clear-memoize-tables))
+(value-triple (hons-clear nil))
+
+(def-gl-thm 1e
+  :hyp (and (unsigned-byte-p 20 x)
+            (unsigned-byte-p 20 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings (gl::auto-bindings (:mix (:nat x 20)
+                                       (:nat y 20))))
+
+(value-triple (clear-memoize-tables))
+(value-triple (hons-clear nil))
+
+(def-gl-thm 1e-alt
+  :hyp (and (unsigned-byte-p 20 x)
+            (unsigned-byte-p 20 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings `((x ,(gl::g-int 0 2 21))
+                (y ,(gl::g-int 1 2 21))))
+
+
+
+
+
+
+
+
+
+
+
+; To make this execute much faster, we'll want a higher memory ceiling.
+
+; Added 8/24/13 by Matt K.: This book failed to certify because of a missing
+; :ttags for the include-book form below..  However, the difference between
+; using the two forms below, and not, was trivial when I used time$ to time the
+; proof of 1f below:
+;
+;   ; including memory-mgmt:
+;   36.39 seconds realtime, 36.29 seconds runtime
+;   (3,472,888,144 bytes allocated).
+;
+;   ; NOT including memory-mgmt:
+;   36.46 seconds realtime, 36.37 seconds runtime
+;   (3,472,888,240 bytes allocated).
+;
+; (include-book "centaur/misc/memory-mgmt" :dir :system)
+; (value-triple (set-max-mem (* 8 (expt 2 30))))
+
+; Added by Matt K., 9/21/2013:
+
+; With cmucl, one gets the following error for 1f (below) using a value here of
+; 3000, even if -dynamic-space-size is set to 1632 on the command line, which
+; is the maximum allowable in our CMUCL implementation, "CMU Common Lisp
+; snapshot-2013-06 (20D Unicode)".
+;   *A1 gc_alloc_large failed, nbytes=65244752.
+;    CMUCL has run out of dynamic heap space (1632 MB).
+;     You can control heap size with the -dynamic-space-size commandline option.
+; So we use a smaller for limit CMUCL.  Note: Adding the two forms just above, to
+; invoke set-max-mem, didn't solve the problem, whether I added them just above
+; or added them at the beginning of this book.
+
+#-cmucl
+(def-gl-thm 1f
+  :hyp (and (unsigned-byte-p 3000 x)
+            (unsigned-byte-p 3000 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings (gl::auto-bindings (:mix (:nat x 3000)
+                                       (:nat y 3000))))
+
+#+cmucl
+(def-gl-thm 1f
+  :hyp (and (unsigned-byte-p 2000 x)
+            (unsigned-byte-p 2000 y))
+  :concl (equal (+ x y) (+ y x))
+  :g-bindings (gl::auto-bindings (:mix (:nat x 2000)
+                                       (:nat y 2000))))
+
+
diff -Nru acl2-6.2/books/centaur/gl/split-args.lisp acl2-6.3/books/centaur/gl/split-args.lisp
--- acl2-6.2/books/centaur/gl/split-args.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/split-args.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,324 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+(in-package "GL")
+(include-book "gtypes")
+(local (include-book "gtype-thms"))
+(local (include-book "tools/mv-nth" :dir :system))
+
+(defun hide-if (x) x)
+
+(defund gl-args-split-ite-cond (test args)
+  (declare (xargs :guard t))
+  (b* (((when (atom args)) (mv nil nil))
+       (obj (car args))
+       ((mv rest-then rest-else)
+        (gl-args-split-ite-cond test (cdr args)))
+       ((when (and (consp obj)
+                   (eq (tag obj) :g-ite)
+                   (hons-equal (g-ite->test obj) test)))
+        (mv (cons (g-ite->then obj) rest-then)
+            (cons (g-ite->else obj) rest-else))))
+    (mv (cons obj rest-then)
+        (cons obj rest-else))))
+
+
+(defund gl-args-split-ite (args)
+  (declare (xargs :guard t))
+  (b* (((when (atom args))
+        (mv nil nil nil nil))
+       (obj (car args))
+       ((when (and (consp obj)
+                   (eq (tag obj) :g-ite)))
+        (b* ((test (g-ite->test obj))
+             (then (g-ite->then obj))
+             (else (g-ite->else obj))
+             ((mv then-rest else-rest)
+              (gl-args-split-ite-cond test (cdr args))))
+          (mv t test (cons then then-rest) (cons else else-rest))))
+       ((mv has-if test then else)
+        (gl-args-split-ite (cdr args)))
+       ((unless has-if)
+        (mv nil nil nil nil)))
+    (mv has-if test (cons obj then) (cons obj else))))
+
+(defund g-ite-depth (x)
+  (declare (xargs :guard t))
+  (if (mbe :logic (eq (tag x) :g-ite)
+           :exec (and (consp x)
+                      (eq (tag x) :g-ite)))
+      (+ 1 (max (g-ite-depth (g-ite->then x))
+                (g-ite-depth (g-ite->else x))))
+    0))
+
+(defthm posp-g-ite-depth
+  (implies (equal (tag x) :g-ite)
+           (posp (g-ite-depth x)))
+  :hints(("Goal" :in-theory (enable g-ite-depth)))
+  :rule-classes :type-prescription)
+
+
+(defthm g-ite-depth-of-g-ite->then
+  (implies (eq (tag x) :g-ite)
+           (< (g-ite-depth (g-ite->then x))
+              (g-ite-depth x)))
+  :hints(("Goal" :expand ((g-ite-depth x))))
+  :rule-classes :linear)
+
+(defthm g-ite-depth-of-g-ite->else
+  (implies (eq (tag x) :g-ite)
+           (< (g-ite-depth (g-ite->else x))
+              (g-ite-depth x)))
+  :hints(("Goal" :expand ((g-ite-depth x))))
+  :rule-classes :linear)
+
+(defund g-ite-depth-sum (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      0
+    (+ (g-ite-depth (car x))
+       (g-ite-depth-sum (cdr x)))))
+
+(defthm g-ite-depth-of-g-concrete
+  (equal (g-ite-depth (g-concrete x)) 0)
+  :hints(("Goal" :in-theory (enable g-ite-depth))))
+
+(defthm g-ite-depth-sum-of-gl-args-split-ite-cond-0
+  (<= (g-ite-depth-sum (mv-nth 0 (gl-args-split-ite-cond test args)))
+      (g-ite-depth-sum args))
+  :hints(("Goal" :in-theory (enable gl-args-split-ite-cond
+                                    g-ite-depth-sum gl-cons)))
+  :rule-classes :linear)
+
+(defthm g-ite-depth-sum-of-gl-args-split-ite-cond-1
+  (<= (g-ite-depth-sum (mv-nth 1 (gl-args-split-ite-cond test args)))
+      (g-ite-depth-sum args))
+  :hints(("Goal" :in-theory (enable gl-args-split-ite-cond
+                                    g-ite-depth-sum gl-cons)))
+  :rule-classes :linear)
+
+(defthm g-ite-depth-sum-of-gl-args-split-ite-then
+  (b* (((mv has-ite ?test ?then ?else)
+        (gl-args-split-ite args)))
+    (implies has-ite
+             (< (g-ite-depth-sum then) (g-ite-depth-sum args))))
+  :hints(("Goal" :in-theory (enable gl-args-split-ite
+                                    g-ite-depth-sum gl-cons)))
+  :rule-classes :linear)
+
+(defthm g-ite-depth-sum-of-gl-args-split-ite-else
+  (b* (((mv has-ite ?test ?then ?else)
+        (gl-args-split-ite args)))
+    (implies has-ite
+             (< (g-ite-depth-sum else) (g-ite-depth-sum args))))
+  :hints(("Goal" :in-theory (enable gl-args-split-ite
+                                    g-ite-depth-sum gl-cons)))
+  :rule-classes :linear)
+
+
+
+
+
+(defsection gl-args-split-ite-cond
+  (local (in-theory (enable gl-args-split-ite-cond)))
+
+  (defthm gl-args-split-ite-cond-correct
+    (b* (((mv then else)
+          (gl-args-split-ite-cond test args)))
+      (and (implies (generic-geval test env)
+                    (equal (generic-geval-list then env)
+                           (generic-geval-list args env)))
+           (implies (not (generic-geval test env))
+                    (equal (generic-geval-list else env)
+                           (generic-geval-list args env)))))
+    :hints (("goal" :induct (gl-args-split-ite-cond test args)
+             :expand ((generic-geval-list args env)
+                      (generic-geval-list nil env)
+                      (:free (a b) (generic-geval-list (cons a b) env))
+                      (:with generic-geval (generic-geval (car args)
+                                                                    env))))))
+
+  (defthm gobj-listp-gl-args-split-ite-cond
+    (b* (((mv then else)
+          (gl-args-split-ite-cond test args)))
+      (and (true-listp then)
+           (true-listp else))))
+
+  (defthm gobj-list-depends-on-of-gl-args-split-ite-cond
+    (b* (((mv then else)
+          (gl-args-split-ite-cond test args)))
+      (implies (not (gobj-list-depends-on k p args))
+               (and (not (gobj-list-depends-on k p then))
+                    (not (gobj-list-depends-on k p else)))))))
+
+(defsection gl-args-split-ite
+  (local (in-theory (enable gl-args-split-ite)))
+
+  (defthm gl-args-split-ite-correct
+    (b* (((mv has-ite test then else)
+          (gl-args-split-ite args)))
+      (implies has-ite
+               (and (implies (generic-geval test env)
+                             (equal (generic-geval-list then env)
+                                    (generic-geval-list args env)))
+                    (implies (not (generic-geval test env))
+                             (equal (generic-geval-list else env)
+                                    (generic-geval-list args env))))))
+    :hints (("goal"
+             :induct (gl-args-split-ite args)
+             :expand ((generic-geval-list args env)
+                      (generic-geval-list nil env)
+                      (:free (a b) (generic-geval-list (cons a b) env))
+                      (gobj-listp args)
+                      (:with generic-geval (generic-geval (car args) env))))))
+
+  (defthm gobj-listp-gl-args-split-ite
+    (b* (((mv ?has-ite ?test then else)
+          (gl-args-split-ite args)))
+      (and (true-listp then)
+           (true-listp else))))
+
+
+  (defthm gobj-list-depends-on-of-gl-args-split-ite
+    (b* (((mv ?has-if test then else)
+          (gl-args-split-ite args)))
+      (implies (not (gobj-list-depends-on k p args))
+               (and (not (gobj-depends-on k p test))
+                    (not (gobj-list-depends-on k p then))
+                    (not (gobj-list-depends-on k p else)))))))
+
+
+
+(defsection gl-fncall-split-ite
+  (defun debug-fncall-split-ite (fn args)
+    (declare (xargs :guard t)
+             (ignore fn args))
+    nil)
+
+  (defund gl-fncall-split-ite (fn args)
+    (declare (xargs :guard t
+                    :measure (g-ite-depth-sum args)))
+    (b* (((mv has-ite test then else)
+          (gl-args-split-ite args))
+         ((unless has-ite) (g-apply fn args)))
+      (debug-fncall-split-ite fn args)
+      (g-ite test
+             (gl-fncall-split-ite fn then)
+             (gl-fncall-split-ite fn else))))
+
+  (local (in-theory (enable gl-fncall-split-ite)))
+
+  (defthm gl-fncall-split-ite-correct
+    (equal (generic-geval (gl-fncall-split-ite fn args) env)
+           (generic-geval (g-apply fn args) env))
+    :hints(("Goal" :in-theory (enable generic-geval))))
+
+  (defthm gobj-depends-on-of-gl-args-split-ite
+    (implies (not (gobj-list-depends-on k p args))
+             (not (gobj-depends-on k p (gl-fncall-split-ite fn args))))))
+
+(defsection gl-cons-split-ite
+  (defun debug-cons-split-ite (car cdr)
+    (declare (xargs :guard t)
+             (ignore car cdr))
+    nil)
+  (defund gl-cons-split-ite (car cdr)
+    (declare (xargs :guard t
+                    :hints(("Goal" :in-theory (enable g-ite-depth-sum)))
+                    :measure (g-ite-depth-sum (list car cdr))))
+    (if (and (not (and (consp car) (eq (tag car) :g-ite)))
+             (not (and (consp cdr) (eq (tag cdr) :g-ite))))
+        (gl-cons car cdr)
+      (progn$
+       (debug-cons-split-ite car cdr)
+       ;; (break$)
+       (if (and (consp car) (eq (tag car) :g-ite))
+           (if (and (consp cdr)
+                    (eq (tag cdr) :g-ite)
+                    (hons-equal (g-ite->test cdr) (g-ite->test car)))
+               (g-ite (g-ite->test car)
+                      (gl-cons-split-ite (g-ite->then car)
+                                         (g-ite->then cdr))
+                      (gl-cons-split-ite (g-ite->else car)
+                                         (g-ite->else cdr)))
+             (g-ite (g-ite->test car)
+                    (gl-cons-split-ite (g-ite->then car) cdr)
+                    (gl-cons-split-ite (g-ite->else car) cdr)))
+         (g-ite (g-ite->test cdr)
+                (gl-cons-split-ite car (g-ite->then cdr))
+                (gl-cons-split-ite car (g-ite->else cdr)))))))
+
+  (local (in-theory (enable gl-cons-split-ite)))
+
+  (defthm gl-cons-split-ite-correct
+    (equal (generic-geval (gl-cons-split-ite car cdr) env)
+           (cons (generic-geval car env)
+                 (generic-geval cdr env)))
+    :hints(("Goal" :in-theory (e/d (generic-geval) (gl-cons)))))
+
+  (defthm gobj-depends-on-of-gl-cons-split-ite
+    (implies (and (not (gobj-depends-on k p car))
+                  (not (gobj-depends-on k p cdr)))
+             (not (gobj-depends-on k p (gl-cons-split-ite car cdr))))
+    :hints(("Goal" :in-theory (e/d () (gl-cons gobj-depends-on))))))
+
+
+(defsection gl-cons-maybe-split
+  (defund gl-cons-maybe-split (car cdr split-flg w)
+    (declare (xargs :guard (plist-worldp w)))
+    (if (and split-flg
+             (not (cdr (hons-assoc-equal 'cons (table-alist 'gl-if-opaque-fns w)))))
+        (gl-cons-split-ite car cdr)
+      (gl-cons car cdr)))
+
+  (local (in-theory (enable gl-cons-maybe-split)))
+
+  (defthm gl-cons-maybe-split-correct
+    (equal (generic-geval (gl-cons-maybe-split car cdr flg w) env)
+           (cons (generic-geval car env)
+                 (generic-geval cdr env)))
+    :hints(("Goal" :in-theory (e/d (generic-geval) (gl-cons)))))
+
+  (defthm gobj-depends-on-of-gl-cons-maybe-split
+    (implies (and (not (gobj-depends-on k p car))
+                  (not (gobj-depends-on k p cdr)))
+             (not (gobj-depends-on k p (gl-cons-maybe-split car cdr flg w))))
+    :hints(("Goal" :in-theory (e/d () (gl-cons gobj-depends-on))))))
+
+(defsection gl-fncall-maybe-split
+
+  (defund gl-fncall-maybe-split (fn args flg w)
+    (declare (xargs :guard (plist-worldp w)))
+    (if (and flg
+             (not (cdr (hons-assoc-equal 'fn (table-alist 'gl-if-opaque-fns w)))))
+        (gl-fncall-split-ite fn args)
+      (g-apply fn args)))
+
+  (local (in-theory (enable gl-fncall-maybe-split)))
+
+  (defthm gl-fncall-maybe-split-correct
+    (equal (generic-geval (gl-fncall-maybe-split fn args flg w) env)
+           (generic-geval (g-apply fn args) env))
+    :hints(("Goal" :in-theory (enable generic-geval))))
+
+  (defthm gobj-depends-on-of-gl-args-maybe-split
+    (implies (not (gobj-list-depends-on k p args))
+             (not (gobj-depends-on k p (gl-fncall-maybe-split fn args flg w))))))
+
diff -Nru acl2-6.2/books/centaur/gl/symbolic-arithmetic-fns.lisp acl2-6.3/books/centaur/gl/symbolic-arithmetic-fns.lisp
--- acl2-6.2/books/centaur/gl/symbolic-arithmetic-fns.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/symbolic-arithmetic-fns.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,388 +1,593 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
 (include-book "bvec-ite")
 (include-book "tools/mv-nth" :dir :system)
+(include-book "ihs/logops-definitions" :dir :system)
+
+(defund int-set-sign (negp i)
+  (declare (xargs :guard (integerp i)))
+  (let ((i (lifix i)))
+    (acl2::logapp (integer-length i) i (if negp -1 0))))
+
+(defthm sign-of-int-set-sign
+  (iff (< (int-set-sign negp i) 0)
+       negp)
+  :hints(("Goal" :in-theory (e/d* (int-set-sign)
+                                  (acl2::logapp
+                                   acl2::ifix-under-int-equiv)))))
+
+(defthm int-set-sign-integerp
+  (integerp (int-set-sign negp i))
+  :rule-classes :type-prescription)
+
+(defund non-int-fix (x)
+  (declare (xargs :guard t))
+  (and (not (integerp x)) x))
 
-                                          
-              
+(defthm non-int-fix-when-non-integer
+  (implies (not (integerp x))
+           (equal (non-int-fix x) x))
+  :hints(("Goal" :in-theory (enable non-int-fix)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defund maybe-integer (i x intp)
+  (declare (xargs :guard (integerp i)))
+  (if intp
+      (ifix i)
+    (non-int-fix x)))
+
+(defthm maybe-integer-t
+  (equal (maybe-integer i x t)
+         (ifix i))
+  :hints(("Goal" :in-theory (enable maybe-integer))))
+
+(defthm maybe-integer-nil
+  (equal (maybe-integer i x nil)
+         (non-int-fix x))
+  :hints(("Goal" :in-theory (enable maybe-integer))))
 
 
 
 
-;; equality of two unsigned bdd vectors
-(defund =-uu (a b)
+;; equality of two unsigned bool/bfr vectors
+;; (defund =-uu (a b)
+;;   (declare (xargs :guard t
+;;                   :measure (+ (len a) (len b))))
+;;   (if (and (atom a) (atom b))
+;;       t
+;;     (b* (((mv head1 tail1) (car/cdr a))
+;;          ((mv head2 tail2) (car/cdr b)))
+;;       (and (iff head1 head2)
+;;            (=-uu tail1 tail2)))))
+
+(defund bfr-=-uu (a b)
   (declare (xargs :guard t
                   :measure (+ (len a) (len b))))
   (if (and (atom a) (atom b))
       t
-    (b* (((mv head1 tail1)
-          (if (atom a) (mv nil nil) (mv (car a) (cdr a))))
-         ((mv head2 tail2)
-          (if (atom b) (mv nil nil) (mv (car b) (cdr b)))))
+    (b* (((mv head1 tail1) (car/cdr a))
+         ((mv head2 tail2) (car/cdr b)))
       (bfr-and (bfr-iff head1 head2)
-               (=-uu tail1 tail2)))))
+               (bfr-=-uu tail1 tail2)))))
+
+
 
-(defund =-ss (a b)
+;; (defund =-ss (a b)
+;;   (declare (xargs :guard t
+;;                   :measure (+ (len a) (len b))))
+;;   (b* (((mv head1 tail1 end1) (first/rest/end a))
+;;        ((mv head2 tail2 end2) (first/rest/end b)))
+;;     (if (and end1 end2)
+;;         (iff head1 head2)
+;;       (and (iff head1 head2)
+;;            (=-ss tail1 tail2)))))
+
+(defund bfr-=-ss (a b)
   (declare (xargs :guard t
                   :measure (+ (len a) (len b))))
-  (b* (((mv head1 tail1 end1)
-        (if (atom a)
-            (mv nil nil t)
-          (if (atom (cdr a))
-              (mv (car a) a t)
-            (mv (car a) (cdr a) nil))))
-       ((mv head2 tail2 end2)
-        (if (atom b)
-            (mv nil nil t)
-          (if (atom (cdr b))
-              (mv (car b) b t)
-            (mv (car b) (cdr b) nil)))))
+  (b* (((mv head1 tail1 end1) (first/rest/end a))
+       ((mv head2 tail2 end2) (first/rest/end b)))
     (if (and end1 end2)
         (bfr-iff head1 head2)
       (bfr-and (bfr-iff head1 head2)
-               (=-ss tail1 tail2)))))
+               (bfr-=-ss tail1 tail2)))))
 
 
 
 
 
-(defund s-nthcdr (place n)
+(defund logtail-ns (place n)
   (declare (xargs :guard (natp place)))
-  (if (or (zp place) (atom n) (atom (cdr n)))
+  (if (or (zp place) (s-endp n))
       n
-    (s-nthcdr (1- place) (cdr n))))
+    (logtail-ns (1- place) (scdr n))))
 
 (defund s-sign (x)
   (declare (xargs :guard t))
-  (if (atom x) nil (car (last x))))
+  (b* (((mv first rest endp) (first/rest/end x)))
+    (if endp
+        first
+      (s-sign rest))))
+
 
+;; (defund +-ss (c v1 v2)
+;;   (declare (xargs :measure (+ (len v1) (len v2))
+;;                   :guard t))
+;;   (b* (((mv head1 tail1 end1) (first/rest/end v1))
+;;        ((mv head2 tail2 end2) (first/rest/end v2))
+;;        (axorb (xor head1 head2))
+;;        (s (xor c axorb)))
+;;     (if (and end1 end2)
+;;         (let ((last (if axorb (not c) head1)))
+;;           (scons s (sterm last)))
+;;       (let* ((c (or (and c axorb)
+;;                     (and head1 head2)))
+;;              (rst (+-ss c tail1 tail2)))
+;;         (scons s rst)))))
 
-(defund +-ss (c v1 v2)
+(defund bfr-+-ss (c v1 v2)
   (declare (xargs :measure (+ (len v1) (len v2))
                   :guard t))
-  (b* (((mv head1 tail1 end1)
-        (if (atom v1)
-            (mv nil nil t)
-          (if (atom (cdr v1))
-              (mv (car v1) v1 t)
-            (mv (car v1) (cdr v1) nil))))
-       ((mv head2 tail2 end2)
-        (if (atom v2)
-            (mv nil nil t)
-          (if (atom (cdr v2))
-              (mv (car v2) v2 t)
-            (mv (car v2) (cdr v2) nil))))
+  (b* (((mv head1 tail1 end1) (first/rest/end v1))
+       ((mv head2 tail2 end2) (first/rest/end v2))
        (axorb (bfr-xor head1 head2))
        (s (bfr-xor c axorb)))
     (if (and end1 end2)
         (let ((last (bfr-ite axorb (bfr-not c) head1)))
-          (if (hqual s last)
-              (list s)
-            (list s last)))
+          (bfr-scons s (bfr-sterm last)))
       (let* ((c (bfr-or (bfr-and c axorb)
                         (bfr-and head1 head2)))
-             (rst (+-ss c tail1 tail2)))
-        (if (and (atom (cdr rst))
-                 (hqual s (car rst)))
-            rst
-          (cons s rst))))))
+             (rst (bfr-+-ss c tail1 tail2)))
+        (bfr-scons s rst)))))
 
+(defthm not-s-endp-compound-recognizer
+  (implies (not (s-endp x))
+           (consp x))
+  :hints(("Goal" :in-theory (enable s-endp)))
+  :rule-classes :compound-recognizer)
+
+;; (defund lognot-s (x)
+;;   (declare (xargs :guard t))
+;;   (b* (((mv head tail end) (first/rest/end x)))
+;;     (if end
+;;         (sterm (not head))
+;;       (scons (not head)
+;;              (lognot-s tail)))))
+
+;; (defund lognot-bv (x)
+;;   (declare (xargs :guard t
+;;                   :measure (len x)))
+;;   (if (atom x)
+;;       nil
+;;     (cons (not (car x))
+;;           (lognot-bv (cdr x)))))
 
+(defund bfr-lognot-s (x)
+  (declare (xargs :guard t))
+  (b* (((mv head tail end) (first/rest/end x)))
+    (if end
+        (bfr-sterm (bfr-not head))
+      (bfr-scons (bfr-not head)
+                 (bfr-lognot-s tail)))))
+
+;; (defund unary-minus-s (x)
+;;   (declare (xargs :guard t))
+;;   (+-ss t nil (lognot-s x)))
 
-
-(defund lognot-bv (x)
-  (declare (xargs :guard t
-                  :measure (len x)))
-  (if (atom x)
-      nil
-    (prog2$
-     (acl2::last-chance-wash-memory)
-     (cons (bfr-not (car x))
-           (lognot-bv (cdr x))))))
-
-(defund unary-minus-s (x)
+(defund bfr-unary-minus-s (x)
   (declare (xargs :guard t))
-  (if (consp x)
-      (+-ss t nil (lognot-bv x))
-    nil))
+  (bfr-+-ss t nil (bfr-lognot-s x)))
+
+;; (defund *-ss (v1 v2)
+;;   (declare (xargs :guard t
+;;                   :measure (+ (len v1) (len v2))))
+;;   (b* (((mv dig1 rest end1) (first/rest/end v1)))
+;;     (if end1
+;;         (if dig1
+;;             (unary-minus-s v2)
+;;           nil)
+;;       (let ((rest (*-ss rest v2)))
+;;         (+-ss nil
+;;               (if dig1 v2 nil)
+;;               (scons nil rest))))))
 
 
-(defund *-ss (v1 v2)
+(defund bfr-*-ss (v1 v2)
   (declare (xargs :guard t
                   :measure (+ (len v1) (len v2))))
-  (b* (((mv dig1 end1)
-        (if (atom v1)
-            (mv nil t)
-          (if (atom (cdr v1))
-              (mv (car v1) t)
-            (mv (car v1) nil)))))
+  (b* (((mv dig1 rest end1) (first/rest/end v1)))
     (if end1
         (bfr-ite-bss dig1
-                     (unary-minus-s v2)
+                     (bfr-unary-minus-s v2)
                      nil)
-      (let ((rest (*-ss (cdr v1) v2)))
-        (+-ss nil
+      (let ((rest (bfr-*-ss rest v2)))
+        (bfr-+-ss nil
               (bfr-ite-bss dig1 v2 nil)
-              (cons nil rest))))))
+              (bfr-scons nil rest))))))
 
-(defund <-=-ss (a b)
+;; (defund <-=-ss (a b)
+;;   (declare (xargs :guard t
+;;                   :measure (+ (len a) (len b))))
+;;   (b* (((mv head1 tail1 end1) (first/rest/end a))
+;;        ((mv head2 tail2 end2) (first/rest/end b)))
+;;     (if (and end1 end2)
+;;         (mv (and head1 (not head2))
+;;             (iff head1 head2))
+;;       (mv-let (rst< rst=)
+;;         (<-=-ss tail1 tail2)
+;;         (mv (or rst< (and rst= head2 (not head1)))
+;;             (and rst= (iff head1 head2)))))))
+
+(defund bfr-<-=-ss (a b)
   (declare (xargs :guard t
                   :measure (+ (len a) (len b))))
-  (b* (((mv head1 tail1 end1)
-        (if (atom a)
-            (mv nil nil t)
-          (if (atom (cdr a))
-              (mv (car a) a t)
-            (mv (car a) (cdr a) nil))))
-       ((mv head2 tail2 end2)
-        (if (atom b)
-            (mv nil nil t)
-          (if (atom (cdr b))
-              (mv (car b) b t)
-            (mv (car b) (cdr b) nil)))))
+  (b* (((mv head1 tail1 end1) (first/rest/end a))
+       ((mv head2 tail2 end2) (first/rest/end b)))
     (if (and end1 end2)
         (mv (bfr-and head1 (bfr-not head2))
             (bfr-iff head1 head2))
       (mv-let (rst< rst=)
-        (<-=-ss tail1 tail2)
+        (bfr-<-=-ss tail1 tail2)
         (mv (bfr-or rst< (bfr-and rst= head2 (bfr-not head1)))
             (bfr-and rst= (bfr-iff head1 head2)))))))
 
-(defund <-ss (a b)
+
+;; (defund <-ss (a b)
+;;   (declare (xargs :guard t))
+;;   (b* (((mv head1 tail1 end1) (first/rest/end a))
+;;        ((mv head2 tail2 end2) (first/rest/end b)))
+;;     (if (and end1 end2)
+;;         (and head1 (not head2))
+;;       (mv-let (rst< rst=)
+;;         (<-=-ss tail1 tail2)
+;;         (or rst< (and rst= head2 (not head1)))))))
+
+(defund bfr-<-ss (a b)
   (declare (xargs :guard t))
-  (b* (((mv head1 tail1 end1)
-        (if (atom a)
-            (mv nil nil t)
-          (if (atom (cdr a))
-              (mv (car a) a t)
-            (mv (car a) (cdr a) nil))))
-       ((mv head2 tail2 end2)
-        (if (atom b)
-            (mv nil nil t)
-          (if (atom (cdr b))
-              (mv (car b) b t)
-            (mv (car b) (cdr b) nil)))))
+  (b* (((mv head1 tail1 end1) (first/rest/end a))
+       ((mv head2 tail2 end2) (first/rest/end b)))
     (if (and end1 end2)
         (bfr-and head1 (bfr-not head2))
       (mv-let (rst< rst=)
-        (<-=-ss tail1 tail2)
+        (bfr-<-=-ss tail1 tail2)
         (bfr-or rst< (bfr-and rst= head2 (bfr-not head1)))))))
 
 
+;; (defund logapp-nss (n a b)
+;;   (declare (xargs :guard (natp n)))
+;;   (if (zp n)
+;;       b
+;;     (b* (((mv first rest &) (first/rest/end a)))
+;;       (scons first (logapp-nss (1- n) rest b)))))
+
+(defund bfr-logapp-nss (n a b)
+  (declare (xargs :guard (natp n)))
+  (if (zp n)
+      b
+    (b* (((mv first rest &) (first/rest/end a)))
+      (bfr-scons first (bfr-logapp-nss (1- n) rest b)))))
+
+(defund bfr-logapp-nus (n a b)
+  (declare (xargs :guard (natp n)))
+  (if (zp n)
+      b
+    (b* (((mv first rest) (car/cdr a)))
+      (bfr-scons first (bfr-logapp-nus (1- n) rest b)))))
+
+;; (defund ash-ss (place n shamt)
+;;   (declare (xargs :guard (posp place)
+;;                   :measure (len shamt)))
+;;   (b* (((mv shdig shrst shend) (first/rest/end shamt)))
+;;     (if shend
+;;         (if shdig
+;;             (logtail-ns 1 n)
+;;           (logapp-nss (1- place) nil n))
+;;       (let ((rst (ash-ss (* 2 place) n shrst)))
+;;         (if shdig
+;;             rst
+;;           (logtail-ns place rst))))))
 
-
-
-(defund ash-ss (place n shamt)
+(defund bfr-ash-ss (place n shamt)
   (declare (xargs :guard (posp place)
                   :measure (len shamt)))
-  (b* (((mv shdig shrst shend)
-        (if (atom shamt)
-            (mv nil nil t)
-          (if (atom (cdr shamt))
-              (mv (car shamt) shamt t)
-            (mv (car shamt) (cdr shamt) nil)))))
+  (b* (((mv shdig shrst shend) (first/rest/end shamt)))
     (if shend
         (bfr-ite-bss shdig
-                     (s-nthcdr 1 n)
-                     (make-list-ac (1- place) nil n))
-      (let ((rst (ash-ss (* 2 place) n shrst)))
+                     (logtail-ns 1 n)
+                     (bfr-logapp-nss (1- place) nil n))
+      (let ((rst (bfr-ash-ss (* 2 place) n shrst)))
         (bfr-ite-bss shdig
                      rst
-                     (s-nthcdr place rst))))))
+                     (logtail-ns place rst))))))
 
+;; (defund logbitp-n2v (place digit n)
+;;   (declare (xargs :guard (natp place)
+;;                   :hints (("goal" :in-theory (enable len)))
+;;                   ;; :guard-hints ('(:in-theory (e/d (ash) (floor))))
+;;                   :measure (len digit)))
+;;   (b* (((mv first & end) (first/rest/end n)))
+;;     (if (or (atom digit) end)
+;;         first
+;;       (if (car digit)
+;;           (logbitp-n2v (* 2 place) (cdr digit) (logtail-ns place n))
+;;         (logbitp-n2v (* 2 place) (cdr digit) n)))))
 
 
-(defund logbitp-n2v (place digit n)
+(defund bfr-logbitp-n2v (place digit n)
   (declare (xargs :guard (natp place)
                   :hints (("goal" :in-theory (enable len)))
                   :guard-hints ('(:in-theory (enable ash)))
                   :measure (len digit)))
-  (if (atom n)
-      nil
-    (if (or (atom digit) (atom (cdr n)))
-        (car n)
+  (b* (((mv first & end) (first/rest/end n)))
+    (if (or (atom digit) end)
+        first
       (bfr-ite (car digit)
-               (logbitp-n2v (ash place 1) (cdr digit) (s-nthcdr place n))
-               (logbitp-n2v (ash place 1) (cdr digit) n)))))
+               (bfr-logbitp-n2v (* 2 place) (cdr digit) (logtail-ns place n))
+               (bfr-logbitp-n2v (* 2 place) (cdr digit) n)))))
 
-(defund integer-length-s1 (offset x)
+
+;; (defund integer-length-s1 (offset x)
+;;   (declare (xargs :guard (natp offset)
+;;                   :measure (len x)))
+;;   (b* (((mv first rest end) (first/rest/end x)))
+;;     (if end
+;;         (mv nil nil)
+;;       (mv-let (changed res)
+;;         (integer-length-s1 (1+ offset) rest)
+;;         (if (eq changed t)
+;;             (mv t res)
+;;           (let ((change (xor first (car rest))))
+;;             (mv (or changed change)
+;;                 (if changed
+;;                     res
+;;                   (if change
+;;                       (i2v offset)
+;;                     nil)))))))))
+
+(defund bfr-integer-length-s1 (offset x)
   (declare (xargs :guard (natp offset)
                   :measure (len x)))
-  (if (or (atom x) (atom (cdr x)))
-      (mv nil nil)
-    (mv-let (changed res)
-      (integer-length-s1 (1+ offset) (cdr x))
-      (if (eq changed t)
-          (mv t res)
-        (let ((change (bfr-xor (car x) (cadr x))))
-          (mv (bfr-or changed change)
-              (bfr-ite-bss changed
-                           res
-                           (bfr-ite-bss change
-                                        (i2v offset)
-                                        nil))))))))
+  (b* (((mv first rest end) (first/rest/end x)))
+    (if end
+        (mv nil nil)
+      (mv-let (changed res)
+        (bfr-integer-length-s1 (1+ offset) rest)
+        (if (eq changed t)
+            (mv t res)
+          (let ((change (bfr-xor first (car rest))))
+            (mv (bfr-or changed change)
+                (bfr-ite-bss changed
+                             res
+                             (bfr-ite-bss change
+                                          (i2v offset)
+                                          nil)))))))))
+
+;; (defund integer-length-s (x)
+;;   (declare (xargs :guard t))
+;;   (mv-let (ign res)
+;;     (integer-length-s1 1 x)
+;;     (declare (ignore ign))
+;;     res))
 
-(defund integer-length-s (x)
+(defund bfr-integer-length-s (x)
   (declare (xargs :guard t))
   (mv-let (ign res)
-    (integer-length-s1 1 x)
+    (bfr-integer-length-s1 1 x)
     (declare (ignore ign))
     res))
 
 
 
-(defund logand-ss (a b)
+;; (defund logand-ss (a b)
+;;   (declare (xargs :guard t
+;;                   :measure (+ (len a) (len b))))
+;;   (b* (((mv af ar aend) (first/rest/end a))
+;;        ((mv bf br bend) (first/rest/end b)))
+;;     (if (and aend bend)
+;;         (sterm (and af bf))
+;;       (b* ((c (and af bf))
+;;            (r (logand-ss ar br)))
+;;         (scons c r)))))
+
+(defund bfr-logand-ss (a b)
   (declare (xargs :guard t
                   :measure (+ (len a) (len b))))
-  (b* (((mv af ar aend)
-        (if (atom a)
-            (mv nil nil t)
-          (if (atom (cdr a))
-              (mv (car a) a t)
-            (mv (car a) (cdr a) nil))))
-       ((mv bf br bend)
-        (if (atom b)
-            (mv nil nil t)
-          (if (atom (cdr b))
-              (mv (car b) b t)
-            (mv (car b) (cdr b) nil)))))
+  (b* (((mv af ar aend) (first/rest/end a))
+       ((mv bf br bend) (first/rest/end b)))
     (if (and aend bend)
-        (list (bfr-and af bf))
+        (bfr-sterm (bfr-and af bf))
       (b* ((c (bfr-and af bf))
-           (r (logand-ss ar br)))
-        (if (and (atom (cdr r))
-                 (hqual (car r) c))
-            r
-          (cons c r))))))
+           (r (bfr-logand-ss ar br)))
+        (bfr-scons c r)))))
 
 
-;; Symbolically computes the FLOOR and MOD for positive divisor B (when MINUS-B
-;; is the negation of B.)
-(defund floor-mod-ss (a b minus-b)
+;; ;; Symbolically computes the FLOOR and MOD for positive divisor B (when MINUS-B
+;; ;; is the negation of B.)
+;; (defund floor-mod-ss (a b minus-b)
+;;   (declare (xargs :guard t
+;;                   :measure (len a)))
+;;   (b* (((mv first rest endp) (first/rest/end a)))
+;;     (if endp
+;;         (mv (sterm first)
+;;             (if first
+;;                 (+-ss nil '(t) b) ;; (mod -1 b) = b-1 with b > 0
+;;               '(nil))) ;; (mod  0  b) = 0
+;;       (b* (((mv rf rm)
+;;             (floor-mod-ss rest b minus-b))
+;;            (rm (scons first rm))
+;;            (less (<-ss rm b))
+;;            (rf (scons nil rf)))
+;;         (mv (if less
+;;                 rf
+;;               (+-ss t nil rf))
+;;             (if less
+;;                 rm
+;;               (+-ss nil minus-b rm)))))))
+
+(defund bfr-floor-mod-ss (a b minus-b)
   (declare (xargs :guard t
                   :measure (len a)))
-  (b* (((mv digit endp)
-        (if (atom a)
-            (mv nil t)
-          (if (atom (cdr a))
-              (mv (car a) t)
-            (mv (car a) nil)))))
+  (b* (((mv first rest endp) (first/rest/end a)))
     (if endp
-        (mv (bfr-ite-bss
-             digit
-             '(t) ;; (floor -1  b) = -1 with b > 0
-             '(nil)) ;; (floor  0  b) = 0
+        (mv (bfr-sterm first) ;; (floor  0  b) = 0
             (bfr-ite-bss
-             digit
-             (+-ss nil '(t) b) ;; (mod -1 b) = b-1 with b > 0
+             first
+             (bfr-+-ss nil '(t) b) ;; (mod -1 b) = b-1 with b > 0
              '(nil))) ;; (mod  0  b) = 0
       (b* (((mv rf rm)
-            (floor-mod-ss (cdr a) b minus-b))
-           (rm (cons (car a) (if (atom rm) '(nil) rm)))
-           (less (<-ss rm b))
-           (rf (cons nil rf)))
+            (bfr-floor-mod-ss rest b minus-b))
+           (rm (bfr-scons first rm))
+           (less (bfr-<-ss rm b))
+           (rf (bfr-scons nil rf)))
         (mv (bfr-ite-bss
              less
              rf
-             (+-ss t nil rf))
+             (bfr-+-ss t nil rf))
             (bfr-ite-bss
              less rm
-             (+-ss nil minus-b rm)))))))
+             (bfr-+-ss nil minus-b rm)))))))
+
 
-(defund floor-ss (a b)
+;; ;; (mv (sign b) (- b) (abs b) (- (abs b)))
+;; (defund sign-abs-neg-s (x)
+;;   (declare (xargs :guard t))
+;;   (b* ((sign (s-sign x))
+;;        (minus (unary-minus-s x)))
+;;     (if sign
+;;         (mv sign minus minus x)
+;;       (mv sign minus x minus))))
+
+
+(defund bfr-sign-abs-neg-s (x)
+  (declare (xargs :guard t))
+  (b* ((sign (s-sign x))
+       (minus (bfr-unary-minus-s x))
+       (abs (bfr-ite-bss sign minus x))
+       (neg (bfr-ite-bss sign x minus)))
+    (mv sign minus abs neg)))
+
+
+;; (defund floor-ss (a b)
+;;   (declare (xargs :guard t))
+;;   (if (=-ss b nil)
+;;       nil
+;;     (b* (((mv bsign & babs bneg) (sign-abs-neg-s b))
+;;          (anorm (if bsign (unary-minus-s a) a))
+;;          ((mv f &) (floor-mod-ss anorm babs bneg)))
+;;       f)))
+
+(defund bfr-floor-ss (a b)
   (declare (xargs :guard t))
-  (bfr-ite-bss (=-ss b nil)
+  (bfr-ite-bss (bfr-=-ss b nil)
                nil
-               (b* ((bsign (s-sign b))
-                    (babs (bfr-ite-bss bsign (unary-minus-s b) b))
-                    (anorm (bfr-ite-bss bsign (unary-minus-s a) a))
-                    (bneg (unary-minus-s babs))
-                    ((mv f &) (floor-mod-ss anorm babs bneg)))
+               (b* (((mv bsign & babs bneg) (bfr-sign-abs-neg-s b))
+                    (anorm (bfr-ite-bss bsign (bfr-unary-minus-s a) a))
+                    ((mv f &) (bfr-floor-mod-ss anorm babs bneg)))
                  f)))
 
-(defund mod-ss (a b)
+;; (defund mod-ss (a b)
+;;   (declare (xargs :guard t))
+;;   (if (=-ss b nil)
+;;       a
+;;     (b* (((mv bsign & babs bneg) (sign-abs-neg-s b))
+;;          (anorm (if bsign (unary-minus-s a) a))
+;;          ((mv & m) (floor-mod-ss anorm babs bneg)))
+;;       (if bsign (unary-minus-s m) m))))
+
+(defund bfr-mod-ss (a b)
   (declare (xargs :guard t))
-  (bfr-ite-bss (=-ss b nil)
+  (bfr-ite-bss (bfr-=-ss b nil)
                a
-               (b* ((bsign (s-sign b))
-                    (babs (bfr-ite-bss bsign (unary-minus-s b) b))
-                    (anorm (bfr-ite-bss bsign (unary-minus-s a) a))
-                    (bneg (unary-minus-s babs))
-                    ((mv & m) (floor-mod-ss anorm babs bneg)))
-                 (bfr-ite-bss bsign (unary-minus-s m) m))))
+               (b* (((mv bsign & babs bneg) (bfr-sign-abs-neg-s b))
+                    (anorm (bfr-ite-bss bsign (bfr-unary-minus-s a) a))
+                    ((mv & m) (bfr-floor-mod-ss anorm babs bneg)))
+                 (bfr-ite-bss bsign (bfr-unary-minus-s m) m))))
+
+
+;; (defund truncate-ss (a b)
+;;   (declare (xargs :guard t))
+;;   (if (=-ss b nil)
+;;       nil
+;;     (b* (((mv bsign & babs bneg) (sign-abs-neg-s b))
+;;          ((mv asign & aabs &) (sign-abs-neg-s a))
+;;          ((mv f &) (floor-mod-ss aabs babs bneg)))
+;;       (if (xor bsign asign)
+;;           (unary-minus-s f)
+;;         f))))
 
-(defund truncate-ss (a b)
+(defund bfr-truncate-ss (a b)
   (declare (xargs :guard t))
-  (bfr-ite-bss (=-ss b nil)
+  (bfr-ite-bss (bfr-=-ss b nil)
                nil
-               (b* ((bsign (s-sign b))
-                    (asign (s-sign a))
-                    (babs (bfr-ite-bss bsign (unary-minus-s b) b))
-                    (aabs (bfr-ite-bss asign (unary-minus-s a) a))
-                    (bneg (unary-minus-s babs))
-                    ((mv f &) (floor-mod-ss aabs babs bneg)))
+               (b* (((mv bsign & babs bneg) (bfr-sign-abs-neg-s b))
+                    ((mv asign & aabs &) (bfr-sign-abs-neg-s a))
+                    ((mv f &) (bfr-floor-mod-ss aabs babs bneg)))
                  (bfr-ite-bss (bfr-xor bsign asign)
-                              (unary-minus-s f) f))))
+                              (bfr-unary-minus-s f) f))))
+
 
 
+;; (defund rem-ss (a b)
+;;   (declare (xargs :guard t))
+;;   (if (=-ss b nil)
+;;       a
+;;     (b* (((mv & & babs bneg) (sign-abs-neg-s b))
+;;          ((mv asign & aabs &) (sign-abs-neg-s a))
+;;          ((mv & m) (floor-mod-ss aabs babs bneg)))
+;;       (if asign (unary-minus-s m) m))))
 
 
-(defund rem-ss (a b)
+(defund bfr-rem-ss (a b)
   (declare (xargs :guard t))
-  (bfr-ite-bss (=-ss b nil)
+  (bfr-ite-bss (bfr-=-ss b nil)
                a
-               (b* ((bsign (s-sign b))
-                    (asign (s-sign a))
-                    (babs (bfr-ite-bss bsign (unary-minus-s b) b))
-                    (aabs (bfr-ite-bss asign (unary-minus-s a) a))
-                    (bneg (unary-minus-s babs))
-                    ((mv & m) (floor-mod-ss aabs babs bneg)))
-                 (bfr-ite-bss asign (unary-minus-s m) m))))
+               (b* (((mv & & babs bneg) (bfr-sign-abs-neg-s b))
+                    ((mv asign & aabs &) (bfr-sign-abs-neg-s a))
+                    ((mv & m) (bfr-floor-mod-ss aabs babs bneg)))
+                 (bfr-ite-bss asign (bfr-unary-minus-s m) m))))
+
+
+;; (defund logior-ss (a b)
+;;   (declare (xargs :guard t
+;;                   :measure (+ (len a) (len b))))
+;;   (b* (((mv af ar aend) (first/rest/end a))
+;;        ((mv bf br bend) (first/rest/end b)))
+;;     (if (and aend bend)
+;;         (sterm (or af bf))
+;;       (b* ((c (or af bf))
+;;            (r (logior-ss ar br)))
+;;         (scons c r)))))
 
-
-
-
-
-
-(defund lognot-s (a)
-  (declare (xargs :guard t
-                  :measure (len a)))
-  (b* (((mv a1 aend)
-        (if (atom a)
-            (mv nil t)
-          (if (atom (cdr a))
-              (mv (car a) t)
-            (mv (car a) nil)))))
-    (if aend
-        (list (bfr-not a1))
-      (cons (bfr-not a1) (lognot-s (cdr a))))))
-
-
-(defund logior-ss (a b)
+(defund bfr-logior-ss (a b)
   (declare (xargs :guard t
                   :measure (+ (len a) (len b))))
-  (b* (((mv af ar aend)
-        (if (atom a)
-            (mv nil nil t)
-          (if (atom (cdr a))
-              (mv (car a) a t)
-            (mv (car a) (cdr a) nil))))
-       ((mv bf br bend)
-        (if (atom b)
-            (mv nil nil t)
-          (if (atom (cdr b))
-              (mv (car b) b t)
-            (mv (car b) (cdr b) nil)))))
+  (b* (((mv af ar aend) (first/rest/end a))
+       ((mv bf br bend) (first/rest/end b)))
     (if (and aend bend)
-        (list (bfr-or af bf))
+        (bfr-sterm (bfr-or af bf))
       (b* ((c (bfr-or af bf))
-           (r (logior-ss ar br)))
-        (if (and (atom (cdr r))
-                 (hqual (car r) c))
-            r
-          (cons c r))))))
+           (r (bfr-logior-ss ar br)))
+        (bfr-scons c r)))))
+
+
 
 
diff -Nru acl2-6.2/books/centaur/gl/symbolic-arithmetic.lisp acl2-6.3/books/centaur/gl/symbolic-arithmetic.lisp
--- acl2-6.2/books/centaur/gl/symbolic-arithmetic.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/symbolic-arithmetic.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,13 +1,27 @@
-
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "GL")
-
-
 (include-book "symbolic-arithmetic-fns")
-
-;; (include-book "tools/with-arith5-help" :dir :system)
-;; (local (allow-arith5-help))
-
+(local (include-book "clause-processors/find-subterms" :dir :system))
+(local (include-book "centaur/bitops/ihs-extensions" :dir :system))
 (local (include-book "arithmetic/top-with-meta" :dir :system))
 
 
@@ -21,949 +35,1295 @@
   :hints (("goal" :use ((:instance realpart-imagpart-elim)))))
 
 
-(local (include-book "ihs/logops-lemmas" :dir :system))
-
-(local (in-theory (disable acl2::logapp acl2::logcar acl2::logcdr acl2::logtail
-                           acl2::logtail-identity
-                           acl2::logapp-0
-                           bfr-ite-bss-fn)))
-
-(local
- (progn
-   (defthm logapp-0-n-m
-     (implies (and (integerp m)
-                   (integerp n))
-              (equal (acl2::logapp 0 m n)
-                     n))
-     :hints(("Goal" :in-theory (enable acl2::logapp*))))
-
-   (defthm logapp-1-0
-     (implies (integerp n)
-              (equal (acl2::logapp 1 0 n)
-                     (* 2 n)))
-     :hints(("Goal" :in-theory (enable acl2::logapp-0))))
-
-
-   (local (defthm minus-norm-to-*-minus-one
-            (equal (- x) (* -1 x))))
-
-   (local (in-theory (disable acl2::functional-commutativity-of-minus-*-left)))
-
-   (defun ash*-ind (n sh)
-     (if (zip sh)
-         n
-       (if (< sh 0)
-           (ash*-ind (acl2::logcdr n) (1+ sh))
-         (ash*-ind n (1- sh)))))
-
-   (defthm logcar-possibilities
-     (or (equal (acl2::logcar n) 0)
-         (equal (acl2::logcar n) 1))
-     :hints (("goal" :in-theory (e/d (acl2::logcar) (mod))
-              :use ((:instance acl2::bitp-mod-2 (i (ifix n))))))
-     :rule-classes nil)
-
-   (defthm logcdr-logcar
-     (equal (acl2::logcdr (acl2::logcar n)) 0)
-     :hints(("Goal"
-             :use logcar-possibilities)))
-
-   (defthm acl2::logcdr-logapp
-     (implies (and (integerp sz)
-                   (integerp n)
-                   (integerp m)
-                   (< 0 sz))
-              (equal (acl2::logcdr (acl2::logapp sz n m))
-                     (acl2::logapp (1- sz) (acl2::logcdr n) m)))
-     :hints(("Goal" :in-theory (enable acl2::logapp*))))
-
-   (defthm ash-pos-to-logapp
-     (implies (and (integerp n)
-                   (integerp sh)
-                   (<= 0 sh))
-              (equal (ash n sh)
-                     (acl2::logapp sh 0 n)))
-     :hints(("Goal" :in-theory (e/d (acl2::ash* acl2::logapp*)
-                                    (ash acl2::logapp
-                                         acl2::logcons
-                                         acl2::logapp-0
-                                         acl2::logcdr))
-             :induct (ash*-ind n sh))))
-
-   (defthm ash-neg-to-logtail
-     (implies (and (integerp n)
-                   (integerp sh)
-                   (<= sh 0))
-              (equal (ash n sh)
-                     (acl2::logtail (- sh) n)))
-     :hints (("goal" :in-theory (e/d (acl2::ash* acl2::logtail*)
-                                     (ash acl2::logtail
-                                          acl2::logcdr))
-              :expand ((:with acl2::ash* (ash n sh))
-                       (:with acl2::logtail* (acl2::logtail (- sh) n)))
-              :induct (ash*-ind n sh))))
-
-
-
-
-   (defthmd n2v-nonzero
-     (implies (and (integerp x) (< 0 x))
-              (n2v x))
-     :hints(("Goal" :in-theory (enable (:induction n2v))
-             :expand ((n2v x)))))
-
-
-
-   (defthm n2v-when-nonzero
-     (implies (and (integerp x)
-                   (< 0 x))
-              (n2v x))
-     :hints(("Goal" :in-theory (enable n2v))))
-
-   (defthm right-shift-nonzero
-     (implies (and (integerp x)
-                   (< 1 x))
-              (< 0 (acl2::logtail 1 x)))
-     :hints(("Goal" :in-theory (e/d (acl2::logtail*)))))))
-
-(defthm |equal-n2v-(t)|
-  (equal (equal (n2v x) '(t))
-         (equal x 1))
-  :hints(("Goal" :induct (n2v x)
-          :expand ((n2v x))
-          :in-theory
-          (e/d ((:induction n2v)
-                n2v-nonzero)))))
-
-
-
-
-(defthm =-uu-correct
-  (equal (bfr-eval (=-uu a b) env)
-         (equal (v2n (bfr-eval-list a env))
-                (v2n (bfr-eval-list b env))))
-  :hints(("Goal" :in-theory (e/d (v2n bfr-eval-list =-uu)))))
-
-
-
-
-
-
-(defthm =-ss-correct
-  (equal (bfr-eval (=-ss a b) env)
-         (equal (v2i (bfr-eval-list a env))
-                (v2i (bfr-eval-list b env))))
-  :hints(("Goal" :in-theory (enable bfr-eval-list v2i
-                                    =-ss))))
-
-
-
-
-
-
-(defthm rationalp-complex
-  (equal (rationalp (complex a b))
-         (equal (rfix b) 0)))
-
-
-(defthm realpart-rationalp
-  (implies (rationalp x)
-           (equal (realpart x) x)))
-
-(defthm realpart-complex-completion
-  (equal (realpart (complex a b))
-         (rfix a))
-  :hints (("goal" :cases ((rationalp b)))))
-
-(defthm imagpart-complex-completion
-  (equal (imagpart (complex a b))
-         (rfix b))
-  :hints (("goal" :cases ((rationalp a)))))
-
-
-
-
-(local
- (progn
-   (in-theory (enable s-nthcdr))
-
-   (defun logtail*-ind (pos i)
-     (cond
-      ((zp pos) i)
-      (t (logtail*-ind (1- pos) (acl2::logcdr i)))))
-
-   (defthm logtail-minus-one
-     (implies (natp n)
-              (equal (acl2::logtail n -1) -1))
-     :hints(("Goal" :expand ((:with acl2::logtail* (acl2::logtail n -1)))
-             :induct (logtail*-ind n -1))))))
-
-(defthm s-nthcdr-correct
-  (implies (natp place)
-           (equal (v2i (bfr-eval-list (s-nthcdr place n) env))
-                  (ash (v2i (bfr-eval-list n env)) (- place))))
-  :hints(("Goal" :in-theory (e/d (bfr-eval-list v2i s-nthcdr)
-                                 ((:definition s-nthcdr)))
-          :induct (s-nthcdr place n)
-          :expand ((:free (n) (s-nthcdr place n))
-                   (:free (place) (s-nthcdr place n))
-                   (:free (n) (acl2::logtail place n))))))
-
-
-
-(defthm s-nthcdr-0
-  (equal (s-nthcdr 0 n) n))
-
-(local (in-theory (disable s-nthcdr)))
-
-
-(defthm s-sign-correct
-  (equal (bfr-eval (s-sign x) env)
-         (< (v2i (bfr-eval-list x env)) 0))
-  :hints(("Goal" :in-theory (enable v2i bfr-eval-list last s-sign))))
-
-
-(defthm v2n-is-v2i-when-sign-nil
-  (implies (not (bfr-eval (s-sign x) env))
-           (equal (v2n (bfr-eval-list x env))
-                  (v2i (bfr-eval-list x env))))
-  :hints(("Goal" :in-theory (enable v2i v2n bfr-eval-list s-sign last))))
-
-
-
-;; (defthm bfr-listp-bfr-p-car
-;;   (implies (and (consp x)
-;;                 (bfr-listp x))
-;;            (bfr-p (car x)))
-;;   :rule-classes ((:rewrite :backchain-limit-lst 0)))
-
-
+(local (in-theory (disable bfr-ite-bss-fn)))
 
-;; ------------------ +-ss -------------------------------
-
-
-(local (bfr-reasoning-mode t))
-(local (in-theory (disable (force))))
-
-(defthm +-ss-correct
-  (equal (v2i (bfr-eval-list (+-ss c v1 v2) env))
-         (+ (if (bfr-eval c env) 1 0)
-            (v2i (bfr-eval-list v1 env))
-            (v2i (bfr-eval-list v2 env))))
-  :hints (("Goal"
-           :in-theory (enable (:induction +-ss))
-           :induct (+-ss c v1 v2)
-           :expand ((+-ss c v1 v2)
-                    (:free (a b) (v2i (cons a b)))
-                    (:free (a b) (bfr-eval-list (cons a b) env))
-                    (bfr-eval-list v1 env)
-                    (bfr-eval-list v2 env)))))
-
-(local (bfr-reasoning-mode nil))
-
-(defthm boolean-listp-+-ss-v2i-bind-env-car-env
-  (implies (and (bind-free '((env . (car env))) (env))
-;                 (bfr-p c) (bfr-listp v1) (bfr-listp v2)
-                (boolean-listp (+-ss c v1 v2)))
-           (equal (v2i (+-ss c v1 v2))
-                  (+ (if (bfr-eval c env) 1 0)
-                     (v2i (bfr-eval-list v1 env))
-                     (v2i (bfr-eval-list v2 env)))))
-  :hints (("goal" :use ((:instance bfr-eval-list-consts
-                                   (x (+-ss c v1 v2)))
-                        +-ss-correct)
-           :in-theory (disable +-ss +-ss-correct
-                               bfr-eval-list-consts))))
-
-;; ------------------ unary-minus-s ------------------------
-
-(local (in-theory (enable lognot-bv unary-minus-s)))
-
-(defthm v2i-lognot-bv
-  (implies (consp x)
-           (equal (v2i (bfr-eval-list (lognot-bv x) env))
-                  (+ -1 (- (v2i (bfr-eval-list x env))))))
-  :hints(("Goal" :in-theory (enable bfr-eval-list v2i))))
-
-(local (in-theory (disable lognot-bv +-ss)))
-
-
-
-(defthm v2i-unary-minus-s
-  (equal (v2i (bfr-eval-list (unary-minus-s x) env))
-         (- (v2i (bfr-eval-list x env)))))
-
-(local (in-theory (disable unary-minus-s)))
-
-;; ------------------ *-ss ------------------------
-
-(local (in-theory (enable *-ss)))
-
-(encapsulate nil
- (local (in-theory (disable bfr-ite-bss-fn v2i 
-                            (:definition *-ss))))
- (local (bfr-reasoning-mode t))
- (defthm *-ss-correct
-   (equal (v2i (bfr-eval-list (*-ss v1 v2) env))
-          (* (v2i (bfr-eval-list v1 env))
-             (v2i (bfr-eval-list v2 env))))
-   :hints(("Goal" :induct (*-ss v1 v2)
-           :expand ((*-ss v1 v2)
-                    (*-ss nil v2)
-                    (:free (a b) (v2i (cons a b))))))))
-
-
-(defthm boolean-listp-*-ss-v2i-bind-env-car-env
-  (implies (and (bind-free '((env . (car env))) (env))
-                (boolean-listp (*-ss v1 v2)))
-           (equal (v2i (*-ss v1 v2))
-                  (* (v2i (bfr-eval-list v1 env))
-                     (v2i (bfr-eval-list v2 env)))))
-  :hints (("goal" :use ((:instance bfr-eval-list-consts
-                                   (x (*-ss v1 v2)))
-                        *-ss-correct)
-           :in-theory (disable *-ss *-ss-correct
-                               bfr-eval-list-consts))))
-
-(local (in-theory (disable *-ss)))
-
-
-
-
-
-;; ------------------- <-=-ss ----------------------------
-
-(local (in-theory (enable <-=-ss <-ss)))
-
-(defthm complex-<-1
-  (equal (< (complex a b) c)
-         (or (< (rfix a) (realpart c))
-             (and (equal (rfix a) (realpart c))
-                  (< (rfix b) (imagpart c)))))
-  :hints (("goal" :use ((:instance completion-of-<
-                                   (x (complex a b)) (y c))))))
-
-(defthm complex-<-2
-  (equal (< a (complex b c))
-         (or (< (realpart a) (rfix b))
-             (and (equal (realpart a) (rfix b))
-                  (< (imagpart a) (rfix c)))))
-  :hints (("goal" :use ((:instance completion-of-<
-                                   (x a) (y (complex b c)))))))
-
-
-(encapsulate nil
- (local (in-theory (disable v2i bfr-eval-list
-                            (:definition <-=-ss))))
- (defthm <-=-ss-correct
-   (and (equal (bfr-eval (mv-nth 0 (<-=-ss a b)) env)
-               (< (v2i (bfr-eval-list a env))
-                  (v2i (bfr-eval-list b env))))
-        (equal (bfr-eval (mv-nth 1 (<-=-ss a b)) env)
-               (equal (v2i (bfr-eval-list a env))
-                      (v2i (bfr-eval-list b env)))))
-   :hints(("Goal"
-           :induct (<-=-ss a b)
-           :expand ((<-=-ss a b)
-                    (:free (a b) (v2i (cons a b)))
-                    (:free (a b) (bfr-eval-list (cons a b) env))
-                    (bfr-eval-list a env)
-                    (bfr-eval-list b env))))))
-
-(local (in-theory (disable <-=-ss)))
-
-
-
-(defthm <-ss-correct
-  (equal (bfr-eval (<-ss a b) env)
-         (< (v2i (bfr-eval-list a env))
-            (v2i (bfr-eval-list b env))))
-  :hints(("Goal" :in-theory (e/d ())
-          :expand ((bfr-eval-list a env)
-                   (bfr-eval-list b env)
-                   (:free (a b) (v2i (cons a b))))
-          :do-not-induct t)))
-
-(local (in-theory (disable <-ss)))
-
-
-;; ------------------ ash-ss ------------------------
-
-(local (in-theory (enable ash-ss)))
-
-
-
-(local
- (progn
-   (defthm make-list-ac-nil-v2i-eval
-     (equal (v2i (bfr-eval-list (make-list-ac n nil m) env))
-            (acl2::logapp (nfix n) 0 (v2i (bfr-eval-list m env))))
-     :hints(("Goal" :in-theory (enable bfr-eval-list v2i acl2::logapp-0))))
-
-   (defthm make-list-ac-nil-v2i-eval
-     (equal (v2i (bfr-eval-list (make-list-ac n nil m) env))
-            (acl2::logapp (nfix n) 0 (v2i (bfr-eval-list m env))))
-     :hints(("Goal" :in-theory (enable make-list-ac))))))
-
-
-(local
- (defthm reverse-distrib-1
-   (and (equal (+ n n) (* 2 n))
-        (implies (syntaxp (quotep k))
-                 (equal (+ n (* k n)) (* (+ 1 k) n)))
-        (implies (syntaxp (and (quotep a) (quotep b)))
-                 (equal (+ (* a n) (* b n)) (* (+ a b) n)))
-        (equal (+ n n m) (+ (* 2 n) m))
-        (implies (syntaxp (quotep k))
-                 (equal (+ n (* k n) m) (+ (* (+ 1 k) n) m)))
-        (implies (syntaxp (and (quotep a) (quotep b)))
-                 (equal (+ (* a n) (* b n) m) (+ (* (+ a b) n) m))))))
-
-
-
-
-(encapsulate nil
-  (local (in-theory (disable acl2::logtail-identity
-                             bfr-ite-bss-fn
-                             equal-of-booleans-rewrite)))
-  (local (bfr-reasoning-mode t))
-  (defthm ash-ss-correct
-    (implies (and 
-                  (posp place))
-             (equal (v2i (bfr-eval-list (ash-ss place n shamt) env))
-                    (ash (v2i (bfr-eval-list n env))
-                         (+ -1 place (* place (v2i (bfr-eval-list shamt env)))))))
-    :hints (("goal" :induct (ash-ss place n shamt)
-             :in-theory (e/d (logapp-1-0) ((:definition ash-ss)))
-             :expand ((ash-ss place n shamt)
-                      (ash-ss place n nil)
-                      (bfr-eval-list shamt env)
-                      (:free (a b) (v2i (cons a b)))))
-            (and stable-under-simplificationp
-                 '(:cases ((<= 0 (+ -1 PLACE
-                                    (* 2 PLACE
-                                       (V2I (BFR-EVAL-LIST (CDR SHAMT)
-                                                           ENV))))))))
-            (and stable-under-simplificationp
-                 '(:cases ((<= 0 (+ -1 (* 2 PLACE)
-                                    (* 2 PLACE
-                                       (V2I (BFR-EVAL-LIST (CDR SHAMT) ENV)))))))))))
-                 
-(local (in-theory (disable ash-ss)))
-
-
-
-
-;; ------------------ logbitp-n2v -------------------------------
-
-(local (in-theory (enable logbitp-n2v)))
-
-(local
- (progn
-   (defun logbitp*-ind (pos i)
-     (cond ((zp pos) (equal (acl2::logcar i) 1))
-           (t (logbitp*-ind (1- pos) (acl2::logcdr i)))))
-
-   (encapsulate nil
-     (local (defthm logbitp-0-natp
-              (implies (natp n)
-                       (equal (logbitp n 0) nil))
-              :hints(("Goal" 
-                      :expand ((:with acl2::logbitp* (logbitp n 0)))
-                      :induct (logbitp*-ind n 0)))
-              :rule-classes nil))
-     (defthm logbitp-0
-       (equal (logbitp n 0) nil)
-       :hints (("goal" :use ((:instance logbitp-0-natp (n (nfix n))))
-                :in-theory (enable logbitp))))
-
-     (local (defthm logbitp-minus-1-natp
-              (implies (natp n)
-                       (equal (logbitp n -1) t))
-              :hints(("Goal" 
-                      :expand ((:with acl2::logbitp* (logbitp n -1)))
-                      :induct (logbitp*-ind n -1)))))
-
-     (defthm logbitp-minus-1
-       (equal (logbitp n -1) t)
-       :hints (("goal" :use ((:instance logbitp-minus-1-natp (n (nfix n))))
-                :in-theory (enable logbitp)))))
-
-   (defthm logbitp-to-logcar-logtail
-     (implies (and (natp n) (integerp i))
-              (equal (logbitp n i)
-                     (equal (acl2::logcar (acl2::logtail n i)) 1)))
-     :hints (("goal" :induct (logtail*-ind n i)
-              :expand ((:with acl2::logbitp* (:free (n) (logbitp n i)))
-                       (:with acl2::logtail* (acl2::logtail n i))))))))
-
-
-(defthm logbitp-n2v-correct
-    (implies (and
-                  (posp place))
-             (equal (bfr-eval (logbitp-n2v place digit n) env)
-                    (logbitp (* place (v2n (bfr-eval-list digit env)))
-                             (v2i (bfr-eval-list n env)))))
-    :hints(("Goal" :in-theory (e/d (bfr-eval-list logapp-1-0)
-                                   ((:definition logbitp-n2v) floor
+(local (defun cdr3-ind (a e b)
+         (declare (xargs :measure (+ (len a) (len e) (len b))))
+         (if (and (atom a) (atom e) (atom b))
+             (list a e b)
+           (cdr3-ind (cdr a) (cdr e) (cdr b)))))
+
+(local (defun scdr2-ind (a e)
+         (declare (xargs :measure (+ (len a) (len e))))
+         (if (and (s-endp a) (s-endp e))
+             (list a e)
+           (scdr2-ind (scdr a) (scdr e)))))
+
+(local (defun scdr3-ind (a e b)
+         (declare (xargs :measure (+ (len a) (len e) (len b))))
+         (if (and (s-endp a) (s-endp e) (s-endp b))
+             (list a e b)
+           (scdr3-ind (scdr a) (scdr e) (scdr b)))))
+
+
+
+(defsection =-uu
+
+  (local (in-theory (enable bfr-=-uu)))
+
+  ;; (defcong uv-equiv equal (=-uu a b) 1
+  ;;   :hints(("Goal" :in-theory (e/d (uv-equiv-implies-cars-equiv)
+  ;;                                  (uv-equiv))
+  ;;           :induct (cdr3-ind a a-equiv b))))
+  ;; (defcong uv-equiv equal (=-uu a b) 2
+  ;;   :hints(("Goal" :in-theory (e/d (uv-equiv-implies-cars-equiv)
+  ;;                                  (uv-equiv))
+  ;;           :induct (cdr3-ind a b b-equiv))))
+
+  (defthm bfr-=-uu-correct
+    (equal (bfr-eval (bfr-=-uu a b) env)
+           (= (bfr-list->u a env) (bfr-list->u b env))))
+
+  (defthm pbfr-depends-on-of-bfr-=-uu
+    (implies (and (not (pbfr-list-depends-on n p a))
+                  (not (pbfr-list-depends-on n p b)))
+             (not (pbfr-depends-on n p (bfr-=-uu a b))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on)))))
+
+(defsection =-ss
+
+  (local (in-theory (enable bfr-=-ss)))
+
+  ;; (defcong sv-equiv equal (=-ss a b) 1
+  ;;   :hints(("Goal" :in-theory (e/d (scdr-when-equiv-to-endp)
+  ;;                                  (sv-equiv))
+  ;;           :induct (scdr3-ind a a-equiv b))))
+  ;; (defcong sv-equiv equal (=-ss a b) 2
+  ;;   :hints(("Goal" :in-theory (e/d (scdr-when-equiv-to-endp)
+  ;;                                  (sv-equiv))
+  ;;           :induct (scdr3-ind a b b-equiv))))
+
+  (defthm bfr-=-ss-correct
+    (equal (bfr-eval (bfr-=-ss a b) env)
+           (= (bfr-list->s a env)
+              (bfr-list->s b env)))
+    :hints (("goal" :induct (scdr2-ind a b))))
+
+  (defthm pbfr-depends-on-of-bfr-=-ss
+    (implies (and (not (pbfr-list-depends-on n p a))
+                  (not (pbfr-list-depends-on n p b)))
+             (not (pbfr-depends-on n p (bfr-=-ss a b))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on)))))
+
+(defsection logtail-ns
+
+  (local (in-theory (enable logtail-ns)))
+
+  ;; (local (defun scdr2/count-ind (n x y)
+  ;;          (declare (xargs :measure (nfix n)))
+  ;;          (if (or (zp n) (s-endp x) (s-endp y))
+  ;;              (list n x y)
+  ;;            (scdr2/count-ind (1- (nfix n)) (scdr x) (scdr y)))))
+
+  ;; (local (defthm logtail-of-equiv-to-endp
+  ;;          (IMPLIES (AND (S-ENDP X-EQUIV)
+  ;;                        (SV-EQUIV X X-EQUIV))
+  ;;                   (SV-EQUIV (LOGTAIL-NS N X)
+  ;;                             X))
+  ;;          :hints (("goal" :induct (LOGTAIL-NS N X)
+  ;;                   :in-theory (e/d (scdr-when-equiv-to-endp)
+  ;;                                   (sv-equiv))))))
+
+  ;; (defcong sv-equiv sv-equiv (logtail-ns n x) 2
+  ;;   :hints(("Goal" :in-theory (e/d (scdr-when-equiv-to-endp)
+  ;;                                  (sv-equiv))
+  ;;           :induct (scdr2/count-ind n x x-equiv)
+  ;;           :expand ((:free (x) (logtail-ns n x))))))
+
+  (defthm bfr-logtail-ns-correct
+    (equal (bfr-list->s (logtail-ns place n) env)
+           (logtail place (bfr-list->s n env)))
+    :hints(("Goal" :in-theory (enable acl2::logtail**))))
+
+  (defthm pbfr-list-depends-on-of-logtail-ns
+    (implies (not (pbfr-list-depends-on k p n))
+             (not (pbfr-list-depends-on k p (logtail-ns place n))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on)))))
+
+  ;; (defthm logtail-ns-correct
+  ;;   (equal (v2i (logtail-ns place n))
+  ;;          (logtail place (v2i n)))
+  ;;   :hints(("Goal" :in-theory (e/d (bfr-eval-list v2i acl2::logtail**))))))
+
+
+(defsection s-sign
+  (local (in-theory (enable s-sign)))
+
+  ;; (defcong sv-equiv iff (s-sign x) 1
+  ;;   :hints(("Goal" :in-theory (e/d (scdr-when-equiv-to-endp)
+  ;;                                  (sv-equiv))
+  ;;           :induct (scdr2-ind x x-equiv))))
+
+  (defthm bfr-s-sign-correct
+    (equal (bfr-eval (s-sign x) env)
+           (< (bfr-list->s x env) 0)))
+
+  (defthm pbfr-depends-on-of-s-sign
+    (implies (not (pbfr-list-depends-on k p n))
+             (not (pbfr-depends-on k p (s-sign n))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on)))))
+
+  ;; (defthm s-sign-correct
+  ;;   (iff (s-sign x)
+  ;;        (< (v2i x) 0))
+  ;;   :hints(("Goal" :in-theory (enable v2i last s-sign)))))
+
+
+(defsection +-ss
+
+  ;; (local (defthm consp-cdr-sfix
+  ;;          (implies (not (consp (cdr x)))
+  ;;                   (not (consp (cdr (sfix x)))))))
+
+  ;; (local (in-theory (enable car-of-sfix)))
+
+  (local (in-theory (enable bfr-+-ss)))
+
+  (defthm bfr-+-ss-correct
+    (equal (bfr-list->s (bfr-+-ss c v1 v2) env)
+           (+ (acl2::bool->bit (bfr-eval c env))
+              (bfr-list->s v1 env)
+              (bfr-list->s v2 env)))
+    :hints(("Goal" :in-theory (e/d (logcons)
+                                   ((:d bfr-+-ss)))
+            :induct (bfr-+-ss c v1 v2)
+            :expand ((bfr-+-ss c v1 v2)
+                     ;; (:free (a b) (bfr-eval-list (cons a b) env))
+                     ;; (bfr-eval-list nil env)
+                     ))))
+
+
+  (defthm pbfr-list-depends-on-of-bfr-+-ss
+    (implies (and (not (pbfr-depends-on n p c))
+                  (not (pbfr-list-depends-on n p v1))
+                  (not (pbfr-list-depends-on n p v2)))
+             (not (pbfr-list-depends-on n p (bfr-+-ss c v1 v2))))
+    :hints(("Goal" :in-theory (e/d (pbfr-list-depends-on)
+                                   ((pbfr-list-depends-on)
+                                    (pbfr-depends-on)
+                                    (:d bfr-+-ss)))
+            :induct (bfr-+-ss c v1 v2)
+            :expand ((bfr-+-ss c v1 v2)))))
+)
+ ;;           (and stable-under-simplificationp
+;;                 (let ((call (acl2::find-call '+-ss (caddr (car (last clause))))))
+;;                   (and call
+;;                        (let ((res `(:expand (,call
+;;                                              (bfr-+-ss c v1 v2)
+;;                                              (:free (a b) (sfix (cons a b)))
+;;                                              ;; (:free (a b) (bfr-eval-list (cons a b) env))
+;;                                              ;; (bfr-eval-list nil env)
+;;                                              )
+;;                                     :use ((:instance
+;;                                            bfr-eval-list-when-not-s-endp
+;;                                            (x v1))
+;;                                           (:instance
+;;                                            bfr-eval-list-when-not-s-endp
+;;                                            (x v2))))))
+;; ;                         (or (cw "expand: ~x0~%" res)
+;;                          res))))
+;;            (bfr-reasoning)))
+
+;;   ;; (defcong iff sv-equiv (+-ss c a b) 1)
+
+
+;;   ;; (defthm +-ss-correct
+;;   ;;   (equal (v2i (+-ss c v1 v2))
+;;   ;;          (+ (acl2::bool->bit c)
+;;   ;;             (v2i v1) (v2i v2)))
+;;   ;;   :hints(("Goal" :in-theory (enable v2i +-ss logcons xor (:t v2i)))))
+
+
+;;   ;; (defcong sv-equiv sv-equiv (+-ss c a b) 2
+;;   ;;   :hints (("goal" :use ((:instance i2v-v2i
+;;   ;;                          (v (+-ss c a b)))
+;;   ;;                         (:instance i2v-v2i
+;;   ;;                          (v (+-ss c a-equiv b))))
+;;   ;;            :in-theory (disable sv-equiv)
+;;   ;;            :do-not-induct t)
+;;   ;;           (and stable-under-simplificationp
+;;   ;;                '(:in-theory (enable sv-equiv)))))
+
+;;   ;; (defcong sv-equiv sv-equiv (+-ss c a b) 3
+;;   ;;   :hints (("goal" :use ((:instance i2v-v2i
+;;   ;;                          (v (+-ss c a b)))
+;;   ;;                         (:instance i2v-v2i
+;;   ;;                          (v (+-ss c a b-equiv))))
+;;   ;;            :in-theory (disable sv-equiv)
+;;   ;;            :do-not-induct t)
+;;   ;;           (and stable-under-simplificationp
+;;   ;;                '(:in-theory (enable sv-equiv)))))
+
+
+;;   ;; (local (defthm sv-equiv-sterm
+;;   ;;          (implies (and (sv-equiv a b)
+;;   ;;                        (s-endp b))
+;;   ;;                   (and (equal (sv-equiv a (sterm c))
+;;   ;;                               (iff (car b) c))
+;;   ;;                        (equal (sv-equiv (sterm c) a)
+;;   ;;                               (iff (car b) c))))
+;;   ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;;   ;; (local (defthmd sv-equiv-+-ss-endp
+;;   ;;          (implies (and (sv-equiv a a-equiv)
+;;   ;;                        (s-endp a-equiv)
+;;   ;;                        (s-endp b))
+;;   ;;                   (sv-equiv (+-ss c a b)
+;;   ;;                             ;; (scons (xor c (xor (car a-equiv) (car b)))
+;;   ;;                             ;;        (sterm (if (xor (car a-equiv) (car b))
+;;   ;;                             ;;                   c
+;;   ;;                             ;;                 (car a-equiv))))))
+;;   ;;                             (+-ss c a-equiv b)))
+;;   ;;          :hints (("goal" :induct (+-ss c a b)
+;;   ;;                   :expand ((:free (c b) (+-ss c a b))
+;;   ;;                            (:free (c b) (+-ss c a-equiv b)))
+;;   ;;                   :in-theory (e/d (sv-equiv-of-scons)
+;;   ;;                                   (sv-equiv (:d +-ss) (sterm)))))))
+
+;;   ;; ;; (local (defthm sv-equiv-+-ss-endp2
+;;   ;; ;;          (implies (and (sv-equiv a a-equiv)
+;;   ;; ;;                        (s-endp a-equiv)
+;;   ;; ;;                        (s-endp b))
+;;   ;; ;;                   (sv-equiv (+-ss c a b)
+;;   ;; ;;                             (scons (xor c (xor (car a-equiv) (car b)))
+;;   ;; ;;                                    (sterm (if (xor (car a-equiv) (car b))
+;;   ;; ;;                                               (not c)
+;;   ;; ;;                                             (car a-equiv))))))
+;;   ;; ;;          :hints (("goal" :use sv-equiv-+-ss-endp
+;;   ;; ;;                   :in-theory (disable sv-equiv)
+;;   ;; ;;                   :do-not-induct t))))
+
+
+;;   ;; ;; (local (defthm sv-equiv-sterm-2
+;;   ;; ;;          (implies (sv-equiv (scdr a) (sterm c))
+;;   ;; ;;                   (and (equal (sv-equiv a (sterm c))
+;;   ;; ;;                               (iff (car a) c))
+;;   ;; ;;                        (equal (sv-equiv (sterm c) a)
+;;   ;; ;;                               (iff (car a) c))))
+;;   ;; ;;          :hints(("Goal" :in-theory (e/d (scons sterm))))
+;;   ;; ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;;   ;; (local (defthm sv-equiv-of-scons-2
+;;   ;;          (equal (sv-equiv c (scons a b))
+;;   ;;                 (and (iff (car c) a)
+;;   ;;                      (sv-equiv (scdr c) b)))
+;;   ;;          :hints (("goal" :in-theory (disable sv-equiv-of-scons)
+;;   ;;                   :use sv-equiv-of-scons))))
+
+;;   ;; ;; (local (defthm sv-equiv-of-singleton-2
+;;   ;; ;;          (implies (and (sv-equiv a b)
+;;   ;; ;;                        (s-endp b))
+;;   ;; ;;                   (equal (sv-equiv (list c) a)
+;;   ;; ;;                          (iff (car b) c)))
+;;   ;; ;;          :hints(("Goal" :in-theory (enable sfix s-endp)))
+;;   ;; ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;;   ;; (local (defun-nx +-ss-cong-ind (c a b e)
+;;   ;;          (declare (xargs :measure (+ (len a) (len b) (len e))))
+;;   ;;          (b* (((mv heada taila enda) (first/rest/end a))
+;;   ;;               ((mv headb tailb endb) (first/rest/end b))
+;;   ;;               ((mv ?heade taile ende) (first/rest/end e))
+;;   ;;               (axorb (xor heada headb)))
+;;   ;;            (if (and enda endb ende)
+;;   ;;                (list c a b e)
+;;   ;;              (+-ss-cong-ind (or (and c axorb)
+;;   ;;                                 (and heada headb))
+;;   ;;                             taila tailb taile)))))
+
+
+;;   ;; (defcong sv-equiv sv-equiv (+-ss c a b) 2
+;;   ;;   :hints (("goal" :induct (+-ss-cong-ind c a b a-equiv)
+;;   ;;            :expand ((:free (c) (+-ss c a b))
+;;   ;;                     (:free (c) (+-ss c a-equiv b)))
+;;   ;;            :in-theory (e/d (scdr-when-equiv-to-endp
+;;   ;;                             ;; sv-equiv-of-scons
+;;   ;;                             )
+;;   ;;                            (sv-equiv (sterm)
+;;   ;;                                      ; sterm-when-s-endp
+;;   ;;                                      ;; (:d +-ss)
+;;   ;;                                      )))
+;;   ;;           (and stable-under-simplificationp
+;;   ;;                '(:use ((:instance sv-equiv-+-ss-endp))))))
+
+;;   ;; (defthmd +-ss-commutes
+;;   ;;   (sv-equiv (+-ss c a b)
+;;   ;;             (+-ss c b a))
+;;   ;;   :hints (("goal" :induct t :do-not-induct t
+;;   ;;            :in-theory (disable sv-equiv))))
+
+;;   ;; (defcong sv-equiv sv-equiv (+-ss c a b) 3
+;;   ;;   :hints (("goal" :do-not-induct t
+;;   ;;            :in-theory (disable sv-equiv)
+;;   ;;            :use ((:instance +-ss-commutes)
+;;   ;;                  (:instance +-ss-commutes (b b-equiv))))))
+
+;;   ;; (defthmd bfr-eval-list-when-not-s-endp
+;;   ;;   (implies (not (s-endp x))
+;;   ;;            (sv-equiv (bfr-eval-list x env)
+;;   ;;                      (scons (bfr-eval (car x) env)
+;;   ;;                             (bfr-eval-list (scdr x) env))))
+;;   ;;   :hints(("Goal" :in-theory (enable s-endp scdr scons))))
+
+;;   ;; ;; (local (defthm v2i-when-empty
+;;   ;; ;;          (implies (not (consp (cdr x)))
+;;   ;; ;;                   (equal (v2i x)
+;;   ;; ;;                          (if (car x) -1 0)))
+;;   ;; ;;          :hints(("Goal" :in-theory (enable v2i)))
+;;   ;; ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;;   ;; (local (in-theory (disable (:t acl2::logcons-negp)
+;;   ;;                            (:t acl2::logcons-posp-2)
+;;   ;;                            (:t acl2::logcons-natp)
+;;   ;;                            (:t acl2::logcons-posp-1)
+;;   ;;                            (:t natp)
+;;   ;;                            (:t acl2::negp)
+;;   ;;                            (:t posp)
+;;   ;;                            (:t bfr-eval)
+;;   ;;                            (:t bfr-+-ss)
+;;   ;;                            (:t +-ss)
+;;   ;;                            (:t v2i)
+;;   ;;                            (:t acl2::logcons-type)
+;;   ;;                            iff xor not
+;;   ;;                            equal-of-booleans-rewrite
+;;   ;;                            sets::double-containment
+;;   ;;                            boolean-list-bfr-eval-list-const)))
+
+;;   ;; (local (defthm open-+-ss-rec
+;;   ;;          (implies (or (consp (cdr v1))
+;;   ;;                       (consp (cdr v2)))
+;;   ;;                   (equal (+-ss c v1 v2)
+;;   ;;                          (B* (((MV HEAD1 TAIL1 ?END1)
+;;   ;;                                (FIRST/REST/END V1))
+;;   ;;                               ((MV HEAD2 TAIL2 ?END2)
+;;   ;;                                (FIRST/REST/END V2))
+;;   ;;                               (AXORB (XOR HEAD1 HEAD2))
+;;   ;;                               (S (XOR C AXORB)))
+;;   ;;                            (LET* ((C (OR (AND C AXORB) (AND HEAD1 HEAD2)))
+;;   ;;                                   (RST (+-SS C TAIL1 TAIL2)))
+;;   ;;                                  (IF (AND (ATOM (CDR RST)) (IFF S (CAR RST)))
+;;   ;;                                      RST (CONS S RST))))))
+;;   ;;          :rule-classes ((:rewrite :backchain-limit-lst 1))))
+
+;;   ;; (local (defthm consp-of-bfr-eval-list
+;;   ;;          (equal (consp (bfr-eval-list x env))
+;;   ;;                 (consp x))
+;;   ;;          :hints(("Goal" :in-theory (enable bfr-eval-list)))))
+
+;;   ;; (local (defthm open-+-ss-base
+;;   ;;          (implies (and (not (consp (cdr v1)))
+;;   ;;                        (not (consp (cdr v2))))
+;;   ;;                   (equal (+-ss c v1 v2)
+;;   ;;                          (B* (((MV HEAD1 ?TAIL1 ?END1)
+;;   ;;                                (FIRST/REST/END V1))
+;;   ;;                               ((MV HEAD2 ?TAIL2 ?END2)
+;;   ;;                                (FIRST/REST/END V2))
+;;   ;;                               (AXORB (XOR HEAD1 HEAD2))
+;;   ;;                               (S (XOR C AXORB)))
+;;   ;;                            (LET ((LAST (IF AXORB (NOT C) HEAD1)))
+;;   ;;                                 (IF (IFF S LAST)
+;;   ;;                                     (LIST S)
+;;   ;;                                     (LIST S LAST))))))
+;;   ;;          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+;;   (local (in-theory (e/d (;; bfr-eval-list-when-not-s-endp
+;;                           )
+;;                          (bfr-eval-list-of-scdr))))
+
+;;   (defthm s-endp-of-scons
+;;     (equal (s-endp (scons b x))
+;;            (and (s-endp x)
+;;                 (iff b (car x))))
+;;     :hints(("Goal" :in-theory (enable s-endp scons))))
+
+;;   ;; (defthm sterm-of-bfr-eval-of-car
+;;   ;;   (implies (s-endp x)
+;;   ;;            (equal (sterm (bfr-eval (car x) env))
+;;   ;;                   (bfr-eval-list x env)))
+;;   ;;   :hints(("Goal" :in-theory (enable s-endp sterm)
+
+;;   (defthm bfr-+-ss-correct
+;;     (sv-equiv (bfr-eval-list (bfr-+-ss c v1 v2) env)
+;;               (+-ss (bfr-eval c env)
+;;                     (bfr-eval-list v1 env)
+;;                     (bfr-eval-list v2 env)))
+;;     :hints(("Goal" :in-theory (e/d ()
+;;                                    ((:d bfr-+-ss) sv-equiv (sterm)))
+;;             :induct (bfr-+-ss c v1 v2)
+;;             :expand ((bfr-+-ss c v1 v2)
+;;                      (:free (a b) (sfix (cons a b)))
+;;                      ;; (:free (a b) (bfr-eval-list (cons a b) env))
+;;                      ;; (bfr-eval-list nil env)
+;;                      ))
+;;            (and stable-under-simplificationp
+;;                 (let ((call (acl2::find-call '+-ss (caddr (car (last clause))))))
+;;                   (and call
+;;                        (let ((res `(:expand (,call
+;;                                              (bfr-+-ss c v1 v2)
+;;                                              (:free (a b) (sfix (cons a b)))
+;;                                              ;; (:free (a b) (bfr-eval-list (cons a b) env))
+;;                                              ;; (bfr-eval-list nil env)
+;;                                              )
+;;                                     :use ((:instance
+;;                                            bfr-eval-list-when-not-s-endp
+;;                                            (x v1))
+;;                                           (:instance
+;;                                            bfr-eval-list-when-not-s-endp
+;;                                            (x v2))))))
+;; ;                         (or (cw "expand: ~x0~%" res)
+;;                              res))))
+;;            (bfr-reasoning)))
+
+;; )
+
+
+(defsection lognot-s
+  (local (in-theory (enable bfr-lognot-s)))
+
+  (defthm bfr-lognot-s-correct
+    (equal (bfr-list->s (bfr-lognot-s x) env)
+           (lognot (bfr-list->s x env))))
+
+  (defthm pbfr-list-depends-on-of-bfr-lognot-s
+    (implies (not (pbfr-list-depends-on k p x))
+             (not (pbfr-list-depends-on k p (bfr-lognot-s x))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on)))))
+
+  ;; (defthm lognot-s-correct
+  ;;   (equal (v2i (lognot-s x))
+  ;;          (lognot (v2i x)))
+  ;;   :hints(("Goal" :in-theory (enable v2i)))))
+
+
+(defsection unary-minus-s
+  (local (in-theory (enable bfr-unary-minus-s)))
+
+  (defthm bfr-unary-minus-s-correct
+    (equal (bfr-list->s (bfr-unary-minus-s x) env)
+           (- (bfr-list->s x env)))
+    :hints(("Goal" :in-theory (enable logcons lognot))))
+
+  (defthm pbfr-list-depends-on-of-bfr-unary-minus-s
+    (implies (not (pbfr-list-depends-on n p x))
+             (not (pbfr-list-depends-on n p (bfr-unary-minus-s x))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on)))))
+
+  ;; (defthm unary-minus-s-correct
+  ;;   (equal (v2i (unary-minus-s x))
+  ;;          (- (v2i x)))
+  ;;   :hints(("Goal" :in-theory (enable v2i lognot)))))
+
+(defsection *-ss
+
+  (local (in-theory (enable bfr-*-ss)))
+
+  (defthm bfr-*-ss-correct
+    (equal (bfr-list->s (bfr-*-ss v1 v2) env)
+           (* (bfr-list->s v1 env)
+              (bfr-list->s v2 env)))
+    :hints(("Goal" :induct (bfr-*-ss v1 v2)
+            :in-theory (enable bfr-*-ss logcons)
+            :expand ((bfr-*-ss v1 v2)
+                     (bfr-*-ss nil v2)))))
+
+  (defthm pbfr-list-depends-on-of-bfr-*-ss
+    (implies (and (not (pbfr-list-depends-on n p v1))
+                  (not (pbfr-list-depends-on n p v2)))
+             (not (pbfr-list-depends-on n p (bfr-*-ss v1 v2))))
+    :hints(("Goal" :in-theory (e/d (pbfr-list-depends-on)
+                                   ((pbfr-list-depends-on)
+                                    (pbfr-depends-on)
+                                    (:d bfr-*-ss)))
+            :induct (bfr-*-ss v1 v2)
+            :expand ((bfr-*-ss v1 v2))))))
+
+  ;; (local (defthm +-double-minus
+  ;;          (equal (+ x (- (* 2 x)))
+  ;;                 (- x))))
+
+  ;; (local (defthm +-double-minus-s
+  ;;          (sv-equiv (+-ss nil v2 (scons nil (unary-minus-s v2)))
+  ;;                    (unary-minus-s v2))
+  ;;          :hints (("goal" :use ((:instance i2v-v2i
+  ;;                                 (v (+-ss nil v2 (scons nil (unary-minus-s
+  ;;                                                             v2)))))
+  ;;                                (:instance i2v-v2i
+  ;;                                 (v (unary-minus-s v2))))
+  ;;                   :in-theory (enable logcons)))))
+
+  ;; (local (defthmd *-ss-equiv-when-end
+  ;;          (implies (and (sv-equiv v1 v1-equiv)
+  ;;                        (s-endp v1-equiv))
+  ;;                   (sv-equiv (*-ss v1 v2)
+  ;;                             (*-ss v1-equiv v2)))
+  ;;          :hints (("goal" :induct (*-ss v1 v2)
+  ;;                   :in-theory (disable sv-equiv)))))
+
+  ;; ;; (local (defun *-ss-cong-ind-1 (v1 v1e)
+  ;; ;;          (b* (((mv dig1 rest1 end1) (first/rest/end v1))
+  ;; ;;               ((mv ?dige reste ende) (first/rest/end v1e)))
+  ;; ;;            (if (and end1 ende)
+  ;; ;;                (list v1 v1e)
+  ;; ;;              (*-ss-cong-ind-1 rest1 reste)))))
+
+  ;; (defcong sv-equiv sv-equiv (*-ss x y) 1
+  ;;   :hints (("goal" :induct (scdr2-ind x x-equiv)
+  ;;            :in-theory (disable sv-equiv)))))
+
+  ;; (local (in-theory (disable bfr-ite-bss-fn v2i
+  ;;                            (:definition bfr-*-ss))))
+
+  ;; (defthm bfr-*-ss-correct
+  ;;   (
+
+
+
+  ;; (local (bfr-reasoning-mode t))
+
+
+
+  ;; )
+
+
+(defsection <-=-ss
+  (local (in-theory (enable bfr-<-=-ss)))
+
+  (defthm bfr-<-=-ss-correct
+    (b* (((mv less equal) (bfr-<-=-ss a b)))
+      (and (equal (bfr-eval less env)
+                  (< (bfr-list->s a env)
+                     (bfr-list->s b env)))
+           (equal (bfr-eval equal env)
+                  (= (bfr-list->s a env)
+                     (bfr-list->s b env)))))
+    :hints(("Goal" :in-theory (e/d () ((:d bfr-<-=-ss)))
+            :induct (bfr-<-=-ss a b)
+            :expand ((bfr-<-=-ss a b)))))
+
+  (defthm pbfr-depends-on-of-bfr-<-=-ss
+    (b* (((mv less equal) (bfr-<-=-ss a b)))
+      (implies (and (not (pbfr-list-depends-on n p a))
+                    (not (pbfr-list-depends-on n p b)))
+               (and (not (pbfr-depends-on n p less))
+                    (not (pbfr-depends-on n p equal)))))))
+
+
+(defsection bfr-<-ss
+
+  (local (in-theory (enable bfr-<-ss)))
+
+  (defthm bfr-<-ss-correct
+    (equal (bfr-eval (bfr-<-ss a b) env)
+           (< (bfr-list->s a env)
+              (bfr-list->s b env))))
+
+  (defthm pbfr-depends-on-of-bfr-<-ss
+    (implies (and (not (pbfr-list-depends-on n p a))
+                  (not (pbfr-list-depends-on n p b)))
+             (not (pbfr-depends-on n p (bfr-<-ss a b))))))
+
+
+(defsection bfr-logapp-nss
+  (local (in-theory (enable bfr-logapp-nss)))
+
+  (defthm bfr-logapp-nss-correct
+    (equal (bfr-list->s (bfr-logapp-nss n a b) env)
+           (logapp n (bfr-list->s a env)
+                   (bfr-list->s b env)))
+    :hints(("Goal" :in-theory (enable acl2::logapp** acl2::ash**))))
+
+  (defthm pbfr-list-depends-on-of-bfr-logapp-nss
+    (implies (and (not (pbfr-list-depends-on n p a))
+                  (not (pbfr-list-depends-on n p b)))
+             (not (pbfr-list-depends-on n p (bfr-logapp-nss m a b))))))
+
+(defsection bfr-logapp-nus
+  (local (in-theory (enable bfr-logapp-nus)))
+
+  (defthm bfr-logapp-nus-correct
+    (equal (bfr-list->s (bfr-logapp-nus n a b) env)
+           (logapp n (bfr-list->u a env)
+                   (bfr-list->s b env)))
+    :hints(("Goal" :in-theory (enable acl2::logapp**
+                                      acl2::ash**
+                                      acl2::loghead**))))
+
+  (defthm pbfr-list-depends-on-of-bfr-logapp-nus
+    (implies (and (not (pbfr-list-depends-on n p a))
+                  (not (pbfr-list-depends-on n p b)))
+             (not (pbfr-list-depends-on n p (bfr-logapp-nus m a b))))))
+
+(defsection bfr-ash-ss
+
+  (local (in-theory (enable bfr-ash-ss)))
+
+  (local
+   (defthm reverse-distrib-1
+     (and (equal (+ n n) (* 2 n))
+          (implies (syntaxp (quotep k))
+                   (equal (+ n (* k n)) (* (+ 1 k) n)))
+          (implies (syntaxp (quotep k))
+                   (equal (+ (- n) (* k n)) (* (+ -1 k) n)))
+          (implies (syntaxp (quotep k))
+                   (equal (+ (- n) (* k n) m) (+ (* (+ -1 k) n) m)))
+          (implies (syntaxp (and (quotep a) (quotep b)))
+                   (equal (+ (* a n) (* b n)) (* (+ a b) n)))
+          (equal (+ n n m) (+ (* 2 n) m))
+          (implies (syntaxp (quotep k))
+                   (equal (+ n (* k n) m) (+ (* (+ 1 k) n) m)))
+          (implies (syntaxp (and (quotep a) (quotep b)))
+                   (equal (+ (* a n) (* b n) m) (+ (* (+ a b) n) m)))
+          (equal (+ n (- (* 2 n)) m)
+                 (+ (- n) m))
+          )))
+
+  (defthm bfr-ash-ss-correct
+    (implies (posp place)
+             (equal (bfr-list->s (bfr-ash-ss place n shamt) env)
+                    (ash (bfr-list->s n env)
+                         (+ -1 place (* place (bfr-list->s shamt env))))))
+    :hints(("Goal" :in-theory (e/d (acl2::ash**) ((:d bfr-ash-ss)))
+            :induct (bfr-ash-ss place n shamt)
+            :expand ((bfr-ash-ss place n shamt)
+                     (:free (b) (logcons b (bfr-list->s (scdr shamt) env)))))))
+
+  (defthm pbfr-list-depends-on-of-bfr-ash-ss
+    (implies (and (not (pbfr-list-depends-on n p a))
+                  (not (pbfr-list-depends-on n p b)))
+             (not (pbfr-list-depends-on n p (bfr-ash-ss place a b))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on)))))
+
+;; (encapsulate nil
+;;   (local (defthm ash-of-logcons-0
+;;            (implies (<= 0 (ifix m))
+;;                     (equal (ash (logcons 0 n) m)
+;;                            (logcons 0 (ash n m))))
+;;            :hints(("Goal" :in-theory (enable* acl2::ihsext-inductions
+;;                                               acl2::ihsext-recursive-redefs)))))
+
+;;   (local
+;;    (defthm make-list-ac-nil-v2i-eval
+;;      (equal (v2i (bfr-eval-list (make-list-ac n nil m) env))
+;;             (acl2::logapp (nfix n) 0 (v2i (bfr-eval-list m env))))
+;;      :hints(("Goal" :in-theory (enable bfr-eval-list v2i acl2::ash**)))))
+
+;;   (local (in-theory (disable acl2::logtail-identity
+;;                              bfr-ite-bss-fn
+;;                              equal-of-booleans-rewrite)))
+;;   (local (in-theory (enable bfr-ash-ss logcons)))
+
+;;   (local (defthm logtail-of-logtail-free
+;;            (implies (equal y (logtail m z))
+;;                     (equal (logtail n y)
+;;                            (logtail (+ (nfix m) (nfix n)) z)))))
+
+
+;;   ;; (local (bfr-reasoning-mode t))
+;;   (defthm bfr-ash-ss-correct
+;;     (implies (and
+;;               (posp place))
+;;              (equal (v2i (bfr-eval-list (bfr-ash-ss place n shamt) env))
+;;                     (ash (v2i (bfr-eval-list n env))
+;;                          (+ -1 place (* place (v2i (bfr-eval-list shamt env)))))))
+;;     :hints (("goal" :induct (bfr-ash-ss place n shamt)
+;;              :in-theory (e/d () ((:definition bfr-ash-ss)))
+;;              :expand ((bfr-ash-ss place n shamt)
+;;                       (bfr-ash-ss place n nil)
+;;                       (bfr-eval-list shamt env)
+;;                       (:free (a b) (v2i (cons a b)))))
+;;             (and stable-under-simplificationp
+;;                  '(:cases ((<= 0 (+ -1 PLACE
+;;                                     (* 2 PLACE
+;;                                        (V2I (BFR-EVAL-LIST (CDR SHAMT)
+;;                                                            ENV))))))))
+;;             (and stable-under-simplificationp
+;;                  '(:cases ((<= 0 (+ -1 (* 2 PLACE)
+;;                                     (* 2 PLACE
+;;                                        (V2I (BFR-EVAL-LIST (CDR SHAMT)
+;;                                        ENV)))))))))))
+
+(defsection bfr-logbitp-n2v
+  (local (in-theory (enable bfr-logbitp-n2v)))
+
+  (defthm bfr-logbitp-n2v-correct
+    (implies (posp place)
+             (equal (bfr-eval (bfr-logbitp-n2v place digit n) env)
+                    (logbitp (* place (bfr-list->u digit env))
+                             (bfr-list->s n env))))
+    :hints(("Goal" :in-theory (e/d (acl2::logbitp** logcons acl2::bool->bit)
+                                   ((:d bfr-logbitp-n2v) floor
                                     boolean-listp))
-            :induct (logbitp-n2v place digit n)
-            :expand ((logbitp-n2v place digit n)
-                     (logbitp-n2v place nil n)
-                     (logbitp-n2v place digit nil)
-                     (:free (a b) (v2i (cons a b)))
-                     (:free (a b) (v2n (cons a b)))))))
-
-(local (in-theory (disable logbitp-n2v)))
-
+            :induct (bfr-logbitp-n2v place digit n)
+            :expand ((bfr-logbitp-n2v place digit n)))))
 
+  (defthm pbfr-list-depends-on-of-bfr-logbitp-n2v
+    (implies (and (not (pbfr-list-depends-on n p digit))
+                  (not (pbfr-list-depends-on n p x)))
+             (not (pbfr-depends-on n p (bfr-logbitp-n2v place digit x))))))
+
+;; (encapsulate nil
+;;   (local (in-theory (enable bfr-logbitp-n2v logcons acl2::ash**)))
+
+;;   (defthm bfr-logbitp-n2v-correct
+;;     (implies (and
+;;               (posp place))
+;;              (equal (bfr-eval (bfr-logbitp-n2v place digit n) env)
+;;                     (logbitp (* place (v2n (bfr-eval-list digit env)))
+;;                              (v2i (bfr-eval-list n env)))))
+;;     :hints(("Goal" :in-theory (e/d (bfr-eval-list acl2::bool->bit)
+;;                                    ((:definition bfr-logbitp-n2v) floor
+;;                                     boolean-listp))
+;;             :induct (bfr-logbitp-n2v place digit n)
+;;             :expand ((bfr-logbitp-n2v place digit n)
+;;                      (bfr-logbitp-n2v place nil n)
+;;                      (bfr-logbitp-n2v place digit nil)
+;;                      (:free (n) (logbitp 0 n))
+;;                      (:free (a b) (v2i (cons a b)))
+;;                      (:free (a b) (v2n (cons a b))))))))
+
+(defsection bfr-integer-length
+  (local (defthm bfr-eval-of-car-when-bfr-list->s
+           (implies (and (equal (bfr-list->s x env) c)
+                         (syntaxp (quotep c)))
+                    (equal (bfr-eval (car x) env)
+                           (equal 1 (logcar c))))))
+
+  (defthm bfr-integer-length-s1-correct1
+    (b* (((mv done ilen) (bfr-integer-length-s1 offset x))
+         (xval (bfr-list->s x env)))
+      (implies (posp offset)
+               (and (equal (bfr-eval done env)
+                           (and (not (equal xval 0))
+                                (not (equal xval -1))))
+                    (equal (bfr-list->s ilen env)
+                           (if (or (equal xval 0)
+                                   (equal xval -1))
+                               0
+                             (+ -1 offset (integer-length xval)))))))
+    :hints(("Goal" :induct (bfr-integer-length-s1 offset x)
+            :in-theory (enable (:i bfr-integer-length-s1)
+                               acl2::integer-length**)
+            ;; :in-theory (enable v2i-of-list-implies-car)
+            :expand ((bfr-integer-length-s1 offset x)))
+           (bfr-reasoning)))
+
+  (defthm pbfr-depends-on-of-bfr-integer-length-s1-rw
+    (b* (((mv done ilen) (bfr-integer-length-s1 offset x)))
+      (implies (not (pbfr-list-depends-on n p x))
+               (and (not (pbfr-depends-on n p done))
+                    (not (pbfr-list-depends-on n p ilen)))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on
+                                      bfr-integer-length-s1))))
+
+  (defthm bfr-integer-length-s-correct
+    (equal (bfr-list->s (bfr-integer-length-s x) env)
+           (integer-length (bfr-list->s x env)))
+    :hints(("Goal" :in-theory (enable bfr-integer-length-s))))
+
+  (defthm pbfr-depends-on-of-bfr-integer-length-s
+    (implies (not (pbfr-list-depends-on n p x))
+             (not (pbfr-list-depends-on n p (bfr-integer-length-s x))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on
+                                      bfr-integer-length-s)))))
+
+
+
+;; (encapsulate nil
+;;   (local (in-theory (enable bfr-integer-length-s1 bfr-integer-length-s)))
+;;   (local (bfr-reasoning-mode t))
+;;   (local (defthm bfr-integer-length-s1-correct1
+;;            (implies (posp offset)
+;;                     (and (equal (bfr-eval (mv-nth 0 (bfr-integer-length-s1 offset x)) env)
+;;                                 (not (or (equal (v2i (bfr-eval-list x env)) 0)
+;;                                          (equal (v2i (bfr-eval-list x env)) -1))))
+;;                          (equal (v2i (bfr-eval-list (mv-nth 1 (bfr-integer-length-s1 offset
+;;                                                                                  x))
+;;                                                     env))
+;;                                 (if (or (equal (v2i (bfr-eval-list x env)) 0)
+;;                                         (equal (v2i (bfr-eval-list x env)) -1))
+;;                                     0
+;;                                   (+ -1 offset (integer-length (v2i (bfr-eval-list x env))))))))
+;;            :hints(("Goal" :induct (bfr-integer-length-s1 offset x)
+;;                    :in-theory (enable acl2::integer-length**)
+;;                    ;; :in-theory (enable v2i-of-list-implies-car)
+;;                    :expand ((bfr-integer-length-s1 offset x)
+;;                             (bfr-integer-length-s1 offset nil)
+;;                             (bfr-eval-list x env)
+;;                             (:free (a b) (v2i (cons a b)))
+;;                             (:free (a B) (bfr-eval-list (cons a b) env)))))))
+
+
+;;   (defthm bfr-integer-length-s-correct
+;;     (equal (v2i (bfr-eval-list (bfr-integer-length-s x) env))
+;;            (integer-length (v2i (bfr-eval-list x env))))
+;;     :hints(("Goal" :in-theory (disable bfr-integer-length-s1)))))
+
+(defsection bfr-logand-ss
+  (defthm bfr-logand-ss-correct
+    (equal (bfr-list->s (bfr-logand-ss a b) env)
+           (logand (bfr-list->s a env)
+                   (bfr-list->s b env)))
+    :hints(("Goal"
+            :induct (scdr2-ind a b)
+            :in-theory (e/d (acl2::logand**))
+            :expand ((bfr-logand-ss a b)))))
+
+  (defthm pbfr-list-depends-on-of-bfr-logand-ss
+    (implies (and (not (pbfr-list-depends-on n p v1))
+                  (not (pbfr-list-depends-on n p v2)))
+             (not (pbfr-list-depends-on n p (bfr-logand-ss v1 v2))))
+    :hints(("Goal" :in-theory (e/d (pbfr-list-depends-on bfr-logand-ss)
+                                   ((pbfr-list-depends-on)
+                                    (pbfr-depends-on)
+                                    (:d bfr-logand-ss)))
+            :induct (bfr-logand-ss v1 v2)
+            :expand ((bfr-logand-ss v1 v2))))))
+
+(defsection bfr-logior-ss
+  (defthm bfr-logior-ss-correct
+    (equal (bfr-list->s (bfr-logior-ss a b) env)
+           (logior (bfr-list->s a env)
+                   (bfr-list->s b env)))
+    :hints(("Goal"
+            :induct (scdr2-ind a b)
+            :in-theory (e/d (acl2::logior**))
+            :expand ((bfr-logior-ss a b)))))
+
+  (defthm pbfr-list-depends-on-of-bfr-logior-ss
+    (implies (and (not (pbfr-list-depends-on n p v1))
+                  (not (pbfr-list-depends-on n p v2)))
+             (not (pbfr-list-depends-on n p (bfr-logior-ss v1 v2))))
+    :hints(("Goal" :in-theory (e/d (pbfr-list-depends-on bfr-logior-ss)
+                                   ((pbfr-list-depends-on)
+                                    (pbfr-depends-on)
+                                    (:d bfr-logior-ss)))
+            :induct (bfr-logior-ss v1 v2)
+            :expand ((bfr-logior-ss v1 v2))))))
+
+
+;; ------
+
+
+
+
+;; (defthmd logtail-ns-0
+;;   (equal (logtail-ns 0 n) n)
+;;   :hints(("Goal" :in-theory (enable logtail-ns))))
+
+
+
+;; (defthmd boolean-listp-bfr-+-ss-v2i-bind-env-car-env
+;;   (implies (and (bind-free '((env . (car env))) (env))
+;; ;                 (bfr-p c) (bfr-listp v1) (bfr-listp v2)
+;;                 (boolean-listp (bfr-+-ss c v1 v2)))
+;;            (equal (v2i (bfr-+-ss c v1 v2))
+;;                   (+ (if (bfr-eval c env) 1 0)
+;;                      (v2i (bfr-eval-list v1 env))
+;;                      (v2i (bfr-eval-list v2 env)))))
+;;   :hints (("goal" :use ((:instance bfr-eval-list-consts
+;;                                    (x (bfr-+-ss c v1 v2)))
+;;                         bfr-+-ss-correct)
+;;            :in-theory (disable bfr-+-ss bfr-+-ss-correct
+;;                                bfr-eval-list-consts))))
+
+
+;; (defthmd boolean-listp-bfr-*-ss-v2i-bind-env-car-env
+;;   (implies (and (bind-free '((env . (car env))) (env))
+;;                 (boolean-listp (bfr-*-ss v1 v2)))
+;;            (equal (v2i (bfr-*-ss v1 v2))
+;;                   (* (v2i (bfr-eval-list v1 env))
+;;                      (v2i (bfr-eval-list v2 env)))))
+;;   :hints (("goal" :use ((:instance bfr-eval-list-consts
+;;                                    (x (bfr-*-ss v1 v2)))
+;;                         bfr-*-ss-correct)
+;;            :in-theory (disable bfr-*-ss bfr-*-ss-correct
+;;                                bfr-eval-list-consts))))
 
 
-;; ---------------- integer-length-s -----------------
 
-(local (in-theory (enable integer-length-s1 integer-length-s)))
 
-(local
- (progn
 
-   (encapsulate nil
-     (local (defthm equal-by-evenp
-              (implies (not (equal (evenp x) (evenp y)))
-                       (not (equal x y)))))
-
-     (defthmd v2i-of-list-implies-car
-       (implies (and (equal (v2i (bfr-eval-list x env)) n)
-                     (syntaxp (quotep n)))
-                (equal (bfr-eval (car x) env) (logbitp 0 n)))
-       :hints (("goal" :expand ((bfr-eval-list x env)
-                                (:free (a b) (v2i (cons a b))))))))))
-
-(local (bfr-reasoning-mode t))
-(local (defthm integer-length-s1-correct1
-         (implies (and 
-                       (posp offset))
-                  (and (equal (bfr-eval (mv-nth 0 (integer-length-s1 offset x)) env)
-                              (not (or (equal (v2i (bfr-eval-list x env)) 0)
-                                       (equal (v2i (bfr-eval-list x env)) -1))))
-                       (equal (v2i (bfr-eval-list (mv-nth 1 (integer-length-s1 offset
-                                                                               x))
-                                                  env))
-                              (if (or (equal (v2i (bfr-eval-list x env)) 0)
-                                      (equal (v2i (bfr-eval-list x env)) -1))
-                                  0
-                                (+ -1 offset (integer-length (v2i (bfr-eval-list x env))))))))
-         :hints(("Goal" :induct (integer-length-s1 offset x)
-                 :in-theory (enable v2i-of-list-implies-car)
-                 :expand ((integer-length-s1 offset x)
-                          (integer-length-s1 offset nil)
-                          (bfr-eval-list x env)
-                          (:free (a b) (v2i (cons a b)))
-                          (:free (a B) (bfr-eval-list (cons a b) env))
-                          (:free (x) (:with acl2::integer-length* (integer-length (* 2 x))))
-                          (:free (x) (:with acl2::integer-length*
-                                            (integer-length (+ 1 (* 2 x))))))))))
-
-
-(defthm integer-length-s-correct
-  (equal (v2i (bfr-eval-list (integer-length-s x) env))
-         (integer-length (v2i (bfr-eval-list x env))))
-  :hints(("Goal" :in-theory (disable integer-length-s1))))
-
-
-(local
- (defthm not-integerp-integer-length-s1-1
-   (not (integerp (mv-nth 1 (integer-length-s1 offs x))))
-   :hints(("Goal" :in-theory (enable integer-length-s1)))))
-
-(local (in-theory (disable integer-length-s1)))
-
-
-(defthm not-integerp-integer-length-s
-  (not (integerp (integer-length-s x)))
-  :hints(("Goal" :in-theory (enable integer-length-s))))
-
-(local (in-theory (disable integer-length-s)))
 
 
 
+;; ---------------- bfr-floor-mod-ss ---------------------
 
+(defsection bfr-floor-mod-ss
 
+  (local (include-book "ihs/quotient-remainder-lemmas" :dir :system)) ;
 
+  (local
+   (encapsulate nil
+     (local
+      (progn
+        (defthm floor-between-b-and-2b
+          (implies (and (integerp a)
+                        (integerp b)
+                        (< 0 b)
+                        (<= b a)
+                        (< a (* 2 b)))
+                   (equal (floor a b) 1))
+          :hints(("Goal" :in-theory (disable floor acl2::floor-bounds
+                                             acl2::<-*-/-left)
+                  :use ((:instance acl2::floor-bounds
+                         (x a) (y b))
+                        (:theorem (implies (and (integerp a)
+                                                (integerp b)
+                                                (< 0 b)
+                                                (< a (* 2 b)))
+                                           (< (* a (/ b)) 2)))))
+                 (and stable-under-simplificationp
+                      '(:in-theory (disable floor)))))
+
+        (defthm floor-less-than-b
+          (implies (and (integerp a)
+                        (integerp b)
+                        (< 0 b)
+                        (<= 0 a)
+                        (< a b))
+                   (equal (floor a b) 0))
+          :hints(("Goal" :in-theory (disable floor acl2::floor-bounds
+                                             acl2::<-*-/-left)
+                  :use ((:instance acl2::floor-bounds
+                         (x a) (y b))
+                        (:theorem (implies (and (integerp a)
+                                                (integerp b)
+                                                (< 0 b)
+                                                (< a b))
+                                           (< (* a (/ b)) 1)))))
+                 (and stable-under-simplificationp
+                      '(:in-theory (disable floor)))))
+
+        (defthm mod-between-b-and-2-b
+          (implies (and (integerp a)
+                        (integerp b)
+                        (< 0 b)
+                        (<= b a)
+                        (< a (* 2 b)))
+                   (equal (mod a b) (- a b)))
+          :hints(("Goal" :in-theory (e/d (mod)
+                                         (floor acl2::floor-bounds
+                                                acl2::<-*-/-left))
+                  :use ((:instance acl2::floor-bounds
+                         (x a) (y b))
+                        (:theorem (implies (and (integerp a)
+                                                (integerp b)
+                                                (< 0 b)
+                                                (< a (* 2 b)))
+                                           (< (* a (/ b)) 2)))))
+                 (and stable-under-simplificationp
+                      '(:in-theory (disable floor)))))
+
+        (defthm mod-less-than-b
+          (implies (and (integerp a)
+                        (integerp b)
+                        (< 0 b)
+                        (<= 0 a)
+                        (< a b))
+                   (equal (mod a b) a))
+          :hints(("Goal" :in-theory (disable floor acl2::floor-bounds
+                                             acl2::<-*-/-left)
+                  :use ((:instance acl2::floor-bounds
+                         (x a) (y b))
+                        (:theorem (implies (and (integerp a)
+                                                (integerp b)
+                                                (< 0 b)
+                                                (< a (* 2 b)))
+                                           (< (* a (/ b)) 2)))))
+                 (and stable-under-simplificationp
+                      '(:in-theory (disable floor)))))))
+
+
+     ;; (defthm floor-rewrite-+-1-*-2-a
+     ;;   (implies (and (integerp a) (integerp b)
+     ;;                 (< 0 b))
+     ;;            (equal (floor (+ 1 (* 2 a)) b)
+     ;;                   (if (<= b (+ 1 (* 2 (mod a b))))
+     ;;                       (+ 1 (* 2 (floor a b)))
+     ;;                     (* 2 (floor a b)))))
+     ;;   :hints(("Goal" :in-theory (disable floor))))
+
+     ;; (defthm floor-rewrite-*-2-a
+     ;;   (implies (and (integerp a) (integerp b)
+     ;;                 (< 0 b))
+     ;;            (equal (floor (* 2 a) b)
+     ;;                   (if (<= b (* 2 (mod a b)))
+     ;;                       (+ 1 (* 2 (floor a b)))
+     ;;                     (* 2 (floor a b)))))
+     ;;   :hints(("Goal" :in-theory (disable floor))))
+
+     (defthm floor-rewrite-+-bit-*-2-a
+       (implies (and (integerp a) (integerp b)
+                     (< 0 b))
+                (equal (floor (logcons c a) b)
+                       (if (<= b (logcons c (mod a b)))
+                           (logcons 1 (floor a b))
+                         (logcons 0 (floor a b)))))
+       :hints(("Goal" :in-theory (e/d (logcons bfix) (floor)))))
+
+     ;; (defthm mod-rewrite-*-2-a
+     ;;   (implies (and (integerp a) (integerp b)
+     ;;                 (< 0 b))
+     ;;            (equal (mod (* 2 a) b)
+     ;;                   (if (<= b (* 2 (mod a b)))
+     ;;                       (+ (* -1  b)
+     ;;                          (* 2 (mod a b)))
+     ;;                     (* 2 (mod a b)))))
+     ;;   :hints (("goal" :in-theory (disable mod))))
+
+     ;; (defthm mod-rewrite-+-1-*-2-a
+     ;;   (implies (and (integerp a) (integerp b)
+     ;;                 (< 0 b))
+     ;;            (equal (mod (+ 1 (* 2 a)) b)
+     ;;                   (if (<= b (+ 1 (* 2 (mod a b))))
+     ;;                       (+ 1 (* -1  b)
+     ;;                          (* 2 (mod a b)))
+     ;;                     (+ 1 (* 2 (mod a b))))))
+     ;;   :hints (("goal" :in-theory (e/d (mod) (floor)))))
+
+     (defthm mod-rewrite-+-bit-*-2-a
+       (implies (and (integerp a) (integerp b)
+                     (< 0 b))
+                (equal (mod (logcons c a) b)
+                       (if (<= b (logcons c (mod a b)))
+                           (+ (- b)
+                              (logcons c (mod a b)))
+                         (logcons c (mod a b)))))
+       :hints (("goal" :in-theory (e/d (logcons bfix mod) (floor)))))
+
+
+
+     ;; (in-theory (disable mod-between-b-and-2-b
+     ;;                     mod-less-than-b
+     ;;                     floor-between-b-and-2b
+     ;;                     floor-less-than-b))
+
+     (defthm denominator-of-unary-/
+       (implies (and (integerp n) (< 0 n))
+                (equal (denominator (/ n)) n))
+       :hints (("goal" :use ((:instance rational-implies2
+                              (x (/ n)))))))
+
+     (defthm <-1-not-integer-recip
+       (implies (and (integerp n)
+                     (< 1 n))
+                (not (integerp (/ n))))
+       :hints (("goal"
+                :use ((:instance denominator-of-unary-/))
+                :in-theory (disable denominator-of-unary-/))))
+
+     (defthm integer-and-integer-recip
+       (implies (and (integerp n)
+                     (< 0 n))
+                (equal (integerp (/ n))
+                       (equal n 1))))))
+
+  (local (add-bfr-pat (bfr-<-ss . &)))
+
+  (local (defthm +-1-logcons-0
+           (equal (+ 1 (logcons 0 a))
+                  (logcons 1 a))
+           :hints(("Goal" :in-theory (enable logcons)))))
+
+  (defthm bfr-floor-mod-ss-correct
+    (b* (((mv floor mod) (bfr-floor-mod-ss a b bminus))
+         (a (bfr-list->s a env))
+         (b (bfr-list->s b env))
+         (bminus (bfr-list->s bminus env)))
+      (implies
+       (and (< 0 b)
+            (equal bminus (- b)))
+       (and (equal (bfr-list->s floor env)
+                   (floor a b))
+            (equal (bfr-list->s mod env)
+                   (mod a b)))))
+    :hints (("goal" :induct (bfr-floor-mod-ss a b bminus)
+             :in-theory (e/d* ((:i bfr-floor-mod-ss))
+                              (floor mod
+                                     bfr-eval-list
+                                     equal-of-booleans-rewrite
+                                     (:definition bfr-floor-mod-ss)
+                                     acl2::mod-type
+                                     acl2::floor-type-3 acl2::floor-type-1
+                                     acl2::logcons-posp-1 acl2::logcons-posp-2
+                                     acl2::logcons-negp
+                                     acl2::rationalp-mod (:t floor) (:t mod)))
+             :do-not-induct t
+             :expand ((bfr-floor-mod-ss a b bminus)
+                      (bfr-floor-mod-ss nil b bminus)))
+            (bfr-reasoning)))
+
+  (defthm pbfr-list-depends-on-of-bfr-floor-mod-ss
+    (b* (((mv floor mod) (bfr-floor-mod-ss a b bminus)))
+      (implies (and (not (pbfr-list-depends-on n p a))
+                    (not (pbfr-list-depends-on n p b))
+                    (not (pbfr-list-depends-on n p bminus)))
+               (and (not (pbfr-list-depends-on n p floor))
+                    (not (pbfr-list-depends-on n p mod)))))
+    :hints(("Goal" :in-theory (enable bfr-floor-mod-ss pbfr-list-depends-on)))))
+
+(defsection bfr-sign-abs-neg-s
+
+  (local (in-theory (enable bfr-sign-abs-neg-s)))
+  (local (add-bfr-pat (s-sign . &)))
+
+  (defthm bfr-sign-abs-neg-s-correct
+    (b* (((mv sign minus abs neg) (bfr-sign-abs-neg-s x))
+         (x (bfr-list->s x env)))
+      (and (equal (bfr-eval sign env)
+                  (< x 0))
+           (equal (bfr-list->s minus env)
+                  (- x))
+           (equal (bfr-list->s abs env)
+                  (abs x))
+           (equal (bfr-list->s neg env)
+                  (- (abs x)))))
+    :hints ((bfr-reasoning)))
+
+  (defthm pbfr-list-depends-on-of-bfr-sign-abs-neg-s-rw
+    (b* (((mv sign minus abs neg) (bfr-sign-abs-neg-s x)))
+      (implies (not (pbfr-list-depends-on n p x))
+               (and (not (pbfr-depends-on n p sign))
+                    (not (pbfr-list-depends-on n p minus))
+                    (not (pbfr-list-depends-on n p abs))
+                    (not (pbfr-list-depends-on n p neg)))))))
+
+
+(defsection bfr-floor-ss
+
+  (local (add-bfr-pat (bfr-=-ss . &)))
+  (local (add-bfr-pat (mv-nth 0 (bfr-sign-abs-neg-s . &))))
+
+  (local (defthm floor-negative
+           (equal (floor x (- y))
+                  (floor (- x) y))
+           :hints(("Goal" :in-theory (enable floor)))))
+
+  (defthm bfr-floor-ss-correct
+    (equal (bfr-list->s (bfr-floor-ss a b) env)
+           (floor (bfr-list->s a env)
+                  (bfr-list->s b env)))
+    :hints (("goal" :do-not-induct t
+             :in-theory (enable bfr-floor-ss))
+            (bfr-reasoning)))
+
+  (defthm pbfr-list-depends-on-of-bfr-floor-ss
+      (implies (and (not (pbfr-list-depends-on n p a))
+                    (not (pbfr-list-depends-on n p b)))
+               (not (pbfr-list-depends-on n p (bfr-floor-ss a b))))
+    :hints(("Goal" :in-theory (enable bfr-floor-ss
+                                      pbfr-list-depends-on)))))
+
+(defsection bfr-mod-ss
+
+  (local (add-bfr-pat (bfr-=-ss . &)))
+  (local (add-bfr-pat (mv-nth 0 (bfr-sign-abs-neg-s . &))))
+
+  (local (defthm floor-negative
+           (equal (floor x (- y))
+                  (floor (- x) y))
+           :hints(("Goal" :in-theory (enable floor)))))
+
+  (local (defthm mod-negative
+           (equal (mod x (- y))
+                  (- (mod (- x) y)))
+           :hints(("Goal" :in-theory (enable mod)))))
+
+  (defthm bfr-mod-ss-correct
+    (equal (bfr-list->s (bfr-mod-ss a b) env)
+           (mod (bfr-list->s a env)
+                  (bfr-list->s b env)))
+    :hints (("goal" :do-not-induct t
+             :in-theory (enable bfr-mod-ss))
+            (bfr-reasoning)))
+
+  (defthm pbfr-list-depends-on-of-bfr-mod-ss
+      (implies (and (not (pbfr-list-depends-on n p a))
+                    (not (pbfr-list-depends-on n p b)))
+               (not (pbfr-list-depends-on n p (bfr-mod-ss a b))))
+    :hints(("Goal" :in-theory (enable bfr-mod-ss
+                                      pbfr-list-depends-on)))))
 
-;; ---------------- logand-ss ------------------------
-
-(local (in-theory (enable logand-ss)))
-
-(local (in-theory (disable acl2::logmaskp integer-length)))
-
-(defthm logand-ss-correct
-   (equal (v2i (bfr-eval-list (logand-ss a b) env))
-          (logand (v2i (bfr-eval-list a env))
-                  (v2i (bfr-eval-list b env))))
-   :hints(("Goal"
-           :in-theory (disable binary-logand)
-           :expand ((logand-ss a b)
-                    (:free (a b) (v2i (cons a b)))
-                    (bfr-eval-list a env)
-                    (bfr-eval-list b env)
-                    (bfr-eval-list nil env)
-                    (:free (a b) (bfr-eval-list (cons a b) env))
-                    (:with acl2::logand*
-                           (:free (x y) (logand (* 2 x) (* 2 y))))
-                    (:with acl2::logand*
-                           (:free (x y) (logand (* 2 x) (+ 1 (* 2 y)))))
-                    (:with acl2::logand*
-                           (:free (x y) (logand (+ 1 (* 2 x)) (* 2 y))))
-                    (:with acl2::logand*
-                           (:free (x y) (logand (+ 1 (* 2 x)) (+ 1 (* 2 y))))))
-           :induct (logand-ss a b))
-          (and stable-under-simplificationp
-               '(:in-theory (e/d (bfr-eval-list) (binary-logand))))))
-
-
-(local (in-theory (disable logand-ss)))
+(defsection bfr-truncate-ss
 
+  (local (add-bfr-pat (bfr-=-ss . &)))
+  (local (add-bfr-pat (mv-nth 0 (bfr-sign-abs-neg-s . &))))
 
+  (local
+   (defthm truncate-is-floor
+     (implies (and (integerp a) (integerp b)
+                   (not (equal b 0)))
+              (equal (truncate a b)
+                     (if (acl2::xor (< a 0) (< b 0))
+                         (- (floor (abs a) (abs b)))
+                       (floor (abs a) (abs b)))))
+     :hints(("Goal" :in-theory (enable truncate floor)))))
 
 
+  (local (defthm truncate-0
+           (equal (truncate x 0) 0)
+           :hints(("Goal" :in-theory (enable truncate)))))
 
-;; ---------------- floor-mod-ss ---------------------
-
-(local (in-theory (enable floor-mod-ss floor-ss mod-ss truncate-ss rem-ss)))
+  (local (in-theory (disable truncate)))
 
 
+  (defthm bfr-truncate-ss-correct
+    (equal (bfr-list->s (bfr-truncate-ss a b) env)
+           (truncate (bfr-list->s a env)
+                     (bfr-list->s b env)))
+    :hints (("goal" :do-not-induct t
+             :in-theory (enable bfr-truncate-ss))
+            (bfr-reasoning))
+    :otf-flg t)
 
+  (defthm pbfr-list-depends-on-of-bfr-truncate-ss
+      (implies (and (not (pbfr-list-depends-on n p a))
+                    (not (pbfr-list-depends-on n p b)))
+               (not (pbfr-list-depends-on n p (bfr-truncate-ss a b))))
+    :hints(("Goal" :in-theory (enable bfr-truncate-ss
+                                      pbfr-list-depends-on)))))
 
+(defsection bfr-rem-ss
 
-(local
- (defthm car-last-when-nonnegative
-   (equal (bfr-eval (car (last b)) env)
-          (< (v2i (bfr-eval-list b env)) 0))
-   :hints(("Goal" :in-theory (enable v2i)))))
-
-
-
-(local (include-book "ihs/quotient-remainder-lemmas" :dir :system))
-
-(local
- (progn
-   (defthm floor-between-b-and-2b
-     (implies (and (integerp a)
-                   (integerp b)
-                   (< 0 b)
-                   (<= b a)
-                   (< a (* 2 b)))
-              (equal (floor a b) 1))
-     :hints(("Goal" :in-theory (disable floor acl2::floor-bounds
-                                        acl2::<-*-/-left)
-             :use ((:instance acl2::floor-bounds
-                              (x a) (y b))
-                   (:theorem (implies (and (integerp a)
-                                           (integerp b)
-                                           (< 0 b)
-                                           (< a (* 2 b)))
-                                      (< (* a (/ b)) 2)))))
-            (and stable-under-simplificationp
-                 '(:in-theory (disable floor)))))
-
-   (defthm floor-less-than-b
-     (implies (and (integerp a)
-                   (integerp b)
-                   (< 0 b)
-                   (<= 0 a)
-                   (< a b))
-              (equal (floor a b) 0))
-     :hints(("Goal" :in-theory (disable floor acl2::floor-bounds
-                                        acl2::<-*-/-left)
-             :use ((:instance acl2::floor-bounds
-                              (x a) (y b))
-                   (:theorem (implies (and (integerp a)
-                                           (integerp b)
-                                           (< 0 b)
-                                           (< a b))
-                                      (< (* a (/ b)) 1)))))
-            (and stable-under-simplificationp
-                 '(:in-theory (disable floor)))))
-
-   (defthm mod-between-b-and-2-b
-     (implies (and (integerp a)
-                   (integerp b)
-                   (< 0 b)
-                   (<= b a)
-                   (< a (* 2 b)))
-              (equal (mod a b) (- a b)))
-     :hints(("Goal" :in-theory (disable floor acl2::floor-bounds
-                                        acl2::<-*-/-left)
-             :use ((:instance acl2::floor-bounds
-                              (x a) (y b))
-                   (:theorem (implies (and (integerp a)
-                                           (integerp b)
-                                           (< 0 b)
-                                           (< a (* 2 b)))
-                                      (< (* a (/ b)) 2)))))
-            (and stable-under-simplificationp
-                 '(:in-theory (disable floor)))))
-
-   (defthm mod-less-than-b
-     (implies (and (integerp a)
-                   (integerp b)
-                   (< 0 b)
-                   (<= 0 a)
-                   (< a b))
-              (equal (mod a b) a))
-     :hints(("Goal" :in-theory (disable floor acl2::floor-bounds
-                                        acl2::<-*-/-left)
-             :use ((:instance acl2::floor-bounds
-                              (x a) (y b))
-                   (:theorem (implies (and (integerp a)
-                                           (integerp b)
-                                           (< 0 b)
-                                           (< a (* 2 b)))
-                                      (< (* a (/ b)) 2)))))
-            (and stable-under-simplificationp
-                 '(:in-theory (disable floor)))))
+  (local (add-bfr-pat (bfr-=-ss . &)))
+  (local (add-bfr-pat (mv-nth 0 (bfr-sign-abs-neg-s . &))))
 
-   (defthm mod-rewrite-+-1-*-2-a
-     (implies (and (integerp a) (integerp b)
-                   (< 0 b))
-              (equal (mod (+ 1 (* 2 a)) b)
-                     (if (<= b (+ 1 (* 2 (mod a b))))
-                         (+ 1 (* -1  b)
-                            (* 2 (mod a b)))
-                       (+ 1 (* 2 (mod a b))))))
-     :hints (("goal" :in-theory (disable mod))))
+  (local (defthm rem-0
+           (equal (rem x 0) (fix x))))
 
-   (defthm mod-rewrite-*-2-a
-     (implies (and (integerp a) (integerp b)
-                   (< 0 b))
-              (equal (mod (* 2 a) b)
-                     (if (<= b (* 2 (mod a b)))
-                         (+ (* -1  b)
-                            (* 2 (mod a b)))
-                       (* 2 (mod a b)))))
-     :hints (("goal" :in-theory (disable mod))))
 
-   (defthm floor-rewrite-+-1-*-2-a
+  (local
+   (defthm truncate-is-floor
      (implies (and (integerp a) (integerp b)
-                   (< 0 b))
-              (equal (floor (+ 1 (* 2 a)) b)
-                     (if (<= b (+ 1 (* 2 (mod a b))))
-                         (+ 1 (* 2 (floor a b)))
-                       (* 2 (floor a b)))))
-     :hints(("Goal" :in-theory (disable floor))))
+                   (not (equal b 0)))
+              (equal (truncate a b)
+                     (if (acl2::xor (< a 0) (< b 0))
+                         (- (floor (abs a) (abs b)))
+                       (floor (abs a) (abs b)))))
+     :hints(("Goal" :in-theory (enable truncate floor)))))
 
-   (defthm floor-rewrite-*-2-a
+  (local
+   (defthm rem-is-mod
      (implies (and (integerp a) (integerp b)
-                   (< 0 b))
-              (equal (floor (* 2 a) b)
-                     (if (<= b (* 2 (mod a b)))
-                         (+ 1 (* 2 (floor a b)))
-                       (* 2 (floor a b)))))
-     :hints(("Goal" :in-theory (disable floor))))
-
-   (in-theory (disable mod-between-b-and-2-b
-                       mod-less-than-b
-                       floor-between-b-and-2b
-                       floor-less-than-b))
-
-   (defthm denominator-of-unary-/
-     (implies (and (integerp n) (< 0 n))
-              (equal (denominator (/ n)) n))
-     :hints (("goal" :use ((:instance rational-implies2
-                                      (x (/ n)))))))
-
-   (defthm <-1-not-integer-recip
-     (implies (and (integerp n)
-                   (< 1 n))
-              (not (integerp (/ n))))
-     :hints (("goal"
-              :use ((:instance denominator-of-unary-/))
-              :in-theory (disable denominator-of-unary-/))))
-
-   (defthm integer-and-integer-recip
-     (implies (and (integerp n)
-                   (< 0 n))
-              (equal (integerp (/ n))
-                     (equal n 1))))))
-
-(local (bfr-reasoning-mode t))
-(local (add-bfr-pat (<-ss . &)))
-(local (add-bfr-pat (bfr-fix . &)))
-
-(local
- (defthm floor-mod-ss-correct
-   (implies
-    (and
-         (< 0 (v2i (bfr-eval-list b env))))
-    (and (equal (v2i (bfr-eval-list
-                      (mv-nth 0 (floor-mod-ss
-                                 a b (unary-minus-s b)))
-                      env))
-                (floor (v2i (bfr-eval-list a env))
-                       (v2i (bfr-eval-list b env))))
-         (equal (v2i (bfr-eval-list
-                      (mv-nth 1 (floor-mod-ss a b (unary-minus-s b)))
-                      env))
-                (mod (v2i (bfr-eval-list a env))
-                     (v2i (bfr-eval-list b env))))))
-   :hints (("goal" :induct (floor-mod-ss a b (unary-minus-s b))
-            :in-theory (disable floor mod
-                                equal-of-booleans-rewrite
-                                (:definition floor-mod-ss)
-                                (:type-prescription acl2::floor-type-3 . 2))
-            :do-not-induct t
-            :expand ((floor-mod-ss a b (unary-minus-s b))
-                     (floor-mod-ss nil b (unary-minus-s b))
-                     (:free (a b) (v2i (cons a b)))
-                     (:free (a b) (bfr-eval-list (cons a b) env))
-                     (bfr-eval-list a env))))))
-
-(local (bfr-reasoning-mode nil))
-
-
-(local (in-theory (disable floor-mod-ss)))
-
-(local (bfr-reasoning-mode t))
-(local (add-bfr-pat (=-ss . &)))
-(local (add-bfr-pat (s-sign . &)))
-
-(local (in-theory (disable floor mod truncate rem)))
-
-(local (defthm floor-0
-         (equal (floor i 0) 0)
-         :hints(("Goal" :in-theory (enable floor)))))
-
-(defthm floor-ss-correct
-  (equal (v2i (bfr-eval-list (floor-ss a b) env))
-         (floor (v2i (bfr-eval-list a env))
-                (v2i (bfr-eval-list b env))))
-   :hints (("goal" :do-not-induct t)))
-
-
-
-(defthm mod-ss-correct
-  (equal (v2i (bfr-eval-list (mod-ss a b) env))
-         (mod (v2i (bfr-eval-list a env))
-              (v2i (bfr-eval-list b env))))
-  :hints (("goal" :do-not-induct t)))
-
-(local (in-theory (disable floor-ss mod-ss)))
-
-(local (bfr-reasoning-mode nil))
-
-
-
-(local
- (defthm truncate-is-floor
-   (implies (and (integerp a) (integerp b)
-                 (not (equal b 0)))
-            (equal (truncate a b)
-                   (if (acl2::xor (< a 0) (< b 0))
-                       (- (floor (abs a) (abs b)))
-                     (floor (abs a) (abs b)))))
-   :hints(("Goal" :in-theory (disable truncate floor)))))
-
-(local (bfr-reasoning-mode t))
-
-(local (defthm truncate-0
-         (equal (truncate x 0) 0)
-         :hints(("Goal" :in-theory (enable truncate)))))
-
-(local (Defthm truncate-0-x
-         (equal (truncate 0 x) 0)
-         :hints(("Goal" :in-theory (enable truncate)))))
-
-(defthm truncate-ss-correct
-  (equal (v2i (bfr-eval-list (truncate-ss a b) env))
-         (truncate (v2i (bfr-eval-list a env))
-                   (v2i (bfr-eval-list b env))))
-  :hints (("goal" :do-not-induct t
-           :in-theory (disable floor truncate bfr-eval-list))))
-
-
-
-(local
- (defthm rem-is-mod
-   (implies (and (integerp a) (integerp b)
-                 (not (equal b 0)))
-            (equal (rem a b)
-                   (if (< a 0)
-                       (- (mod (abs a) (abs b)))
-                     (mod (abs a) (abs b)))))
-   :hints(("Goal" :in-theory (e/d (rem mod) (floor truncate))))))
-
-
-(local (bfr-reasoning-mode t))
-(local (defthm rem-0
-         (implies (acl2-numberp x) (equal (rem x 0) x))
-         :hints(("Goal" :in-theory (enable rem)))))
-(local (defthm rem-0-x
-         (equal (rem 0 x) 0)
-         :hints(("Goal" :in-theory (enable rem)))))
-
-(defthm rem-ss-correct
-  (equal (v2i (bfr-eval-list (rem-ss a b) env))
-         (rem (v2i (bfr-eval-list a env))
-              (v2i (bfr-eval-list b env))))
-  :hints (("goal" :do-not-induct t
-           :in-theory (disable mod rem))))
-
-(local (in-theory (disable truncate-ss rem-ss)))
-
-
-
-
-;; ---------------- lognot-s -------------------------
-
-(local (in-theory (enable lognot-s)))
-
-(defthm lognot-s-correct
-   (equal (v2i (bfr-eval-list (lognot-s a) env))
-          (lognot (v2i (bfr-eval-list a env))))
- :hints (("goal" :in-theory (e/d (v2i bfr-eval-list lognot)
-                                 (boolean-list-bfr-eval-list
-                                  (:definition lognot-s)))
-          :induct (lognot-s a)
-          :expand ((lognot-s a)))))
-
-
-(local (in-theory (disable lognot-s)))
-
-;; ---------------- logior-ss ------------------------
-
-(local (in-theory (enable logior-ss)))
-
-(local (add-bfr-pat (car (logior-ss . &) . &)))
-
-(local
- (defthm bfr-eval-list-not-consp-cdr
-   (implies (and (not (consp (cdr lst)))
-                 (consp lst))
-            (equal (bfr-eval-list lst env)
-                   (list (bfr-eval (car lst) env))))
-   :hints(("Goal" :expand ((bfr-eval-list lst env))))
-   :rule-classes ((:rewrite :backchain-limit-lst 0))))
-
-(defthm logior-ss-correct
-  (equal (v2i (bfr-eval-list (logior-ss a b) env))
-         (logior (v2i (bfr-eval-list a env))
-                 (v2i (bfr-eval-list b env))))
-  :hints(("Goal" :in-theory (e/d () (logior (:definition logior-ss)))
-          :induct (logior-ss a b)
-          :expand ((logior-ss a b)
-                   (:free (a b) (v2i (cons a b)))
-                   (bfr-eval-list a env)
-                   (bfr-eval-list b env)
-                   (bfr-eval-list nil env)
-                   (:free (x y) (:with acl2::logior*
-                                       (logior (* 2 x) (* 2 y))))
-                   (:free (x y) (:with acl2::logior*
-                                       (logior (* 2 x) (+ 1 (* 2 y)))))
-                   (:free (x y) (:with acl2::logior*
-                                       (logior (+ 1 (* 2 x)) (* 2 y))))
-                   (:free (x y) (:with acl2::logior*
-                                       (logior (+ 1 (* 2 x)) (+ 1 (* 2 y)))))))))
-
-
-(local (in-theory (disable logior-ss)))
-
+                   (not (equal b 0)))
+              (equal (rem a b)
+                     (if (< a 0)
+                         (- (mod (abs a) (abs b)))
+                       (mod (abs a) (abs b)))))
+     :hints(("Goal" :in-theory (e/d (rem mod) (floor truncate))))))
+
+  (local (in-theory (disable rem)))
+
+  (defthm bfr-rem-ss-correct
+    (equal (bfr-list->s (bfr-rem-ss a b) env)
+           (rem (bfr-list->s a env)
+                  (bfr-list->s b env)))
+    :hints (("goal" :do-not-induct t
+             :in-theory (enable bfr-rem-ss))
+            (bfr-reasoning)))
+
+  (defthm pbfr-list-depends-on-of-bfr-rem-ss
+      (implies (and (not (pbfr-list-depends-on n p a))
+                    (not (pbfr-list-depends-on n p b)))
+               (not (pbfr-list-depends-on n p (bfr-rem-ss a b))))
+    :hints(("Goal" :in-theory (enable bfr-rem-ss
+                                      pbfr-list-depends-on)))))
diff -Nru acl2-6.2/books/centaur/gl/try-gl.lisp acl2-6.3/books/centaur/gl/try-gl.lisp
--- acl2-6.2/books/centaur/gl/try-gl.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/gl/try-gl.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,4 +1,5 @@
-; Copyright (C) 2013 Centaur Technology
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -102,31 +103,88 @@
 (include-book "gl-generic-clause-proc")
 (include-book "centaur/misc/numlist" :dir :system)
 (include-book "shape-spec")
-
-(defun uniquify-nat-list (x next-idx)
-  (declare (xargs :guard (natp next-idx)))
-  (mv (numlist next-idx 1 (len x))
-      (+ (lnfix next-idx) (len x))))
+(include-book "str/natstr" :dir :system)
+(include-book "str/strnatless" :dir :system)
+(include-book "defsort/duplicated-members" :dir :system)
+
+(defun uniquify-nat-list (x next-idx used-idxs)
+  (declare (xargs :guard (and (nat-listp x)
+                              (natp next-idx))
+                  :guard-hints ('(:in-theory (enable nat-listp)))))
+  (if (atom x)
+      (mv nil (lnfix next-idx))
+    (b* ((xx (lnfix (car x)))
+         (usedp (hons-get xx used-idxs))
+         ((mv rest-lst rest-next)
+          (uniquify-nat-list
+           (cdr x) (if usedp (+ 1 (lnfix next-idx)) next-idx) used-idxs)))
+      (mv (cons (if usedp (lnfix next-idx) xx) rest-lst)
+          rest-next))))
 
 (defthm natp-next-idx-of-uniquify-nat-list
-  (natp (mv-nth 1 (uniquify-nat-list x next-idx))))
+  (natp (mv-nth 1 (uniquify-nat-list x next-idx used-idxs))))
 
-(defun uniquify-number-spec (x next-idx)
-  (declare (xargs :guard (natp next-idx)))
+(defun nat-list-listp (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      (eq x nil)
+    (and (nat-listp (car x))
+         (nat-list-listp (cdr x)))))
+
+(local (defthm nat-list-listp-when-number-specp
+         (implies (number-specp x)
+                  (nat-list-listp x))
+         :hints(("Goal" :in-theory (enable nat-list-listp
+                                           number-specp)))))
+
+(defun uniquify-number-spec (x next-idx used-idxs)
+  (declare (xargs :guard (and (nat-list-listp x)
+                              (natp next-idx))))
   (if (atom x)
       (mv nil (lnfix next-idx))
     (b* (((mv field next-idx)
-          (uniquify-nat-list (car x) next-idx))
+          (uniquify-nat-list (car x) next-idx used-idxs))
          ((mv rest next-idx)
-          (uniquify-number-spec (cdr X) next-idx)))
+          (uniquify-number-spec (cdr X) next-idx used-idxs)))
       (mv (cons field rest) next-idx))))
 
 (defthm natp-next-idx-of-uniquify-number-spec
-  (natp (mv-nth 1 (uniquify-number-spec x next-idx))))
+  (natp (mv-nth 1 (uniquify-number-spec x next-idx used-idxs))))
+
+(defun to-symb (n)
+  (declare (xargs :guard (natp n)))
+  (intern$
+   (concatenate 'string "X" (str::natstr n))
+   "ACL2"))
+
+(defun max-xn-sym (syms)
+  (declare (xargs :guard t
+                  :verify-guards nil))
+  (b* (((when (atom syms))
+        0)
+       (sym (car syms))
+       ((unless (symbolp sym)) (max-xn-sym (cdr syms)))
+       (str (symbol-name sym))
+       (len (length str))
+       ((unless (and (< 1 len)
+                     (eql (char str 0) #\X)
+                     (str::digit-string-p-aux str 1 len)
+                     ;; not generally correct but there arent any XN symbols in
+                     ;; ACL2's package imports
+                     (equal (symbol-package-name sym) "ACL2")))
+        (max-xn-sym (cdr syms)))
+       ((mv val &) (str::parse-nat-from-string str 0 0 1 len)))
+    (max (+ 1 val) (max-xn-sym (cdr syms)))))
+
+(defthm natp-max-xn-sym
+  (natp (max-xn-sym syms))
+  :rule-classes :type-prescription)
+
+(verify-guards max-xn-sym)
 
 ;; Transforms a shape spec so that all bit indices and var names are unique;
 ;; they'll just be sequentially numbered.
-(defun uniquify-shape-spec (x next-idx next-var)
+(defun uniquify-shape-spec (x next-idx next-var used-idxs used-vars)
   (declare (xargs :guard (and (shape-specp x)
                               (natp next-idx)
                               (natp next-var))
@@ -135,41 +193,82 @@
       (mv x (lnfix next-idx) (lnfix next-var))
     (case (tag x)
       (:g-number (mv-let (numspec next-idx)
-                   (uniquify-number-spec (g-number->num x) next-idx)
+                   (uniquify-number-spec (g-number->num x) next-idx used-idxs)
                    (mv (g-number numspec) next-idx (lnfix next-var))))
-      (:g-boolean (mv (g-boolean next-idx) (+ 1 (lnfix next-idx)) (lnfix next-var)))
+      (:g-integer (b* ((sign next-idx)
+                       ((mv bits next-idx)
+                        (uniquify-nat-list (g-integer->bits x)
+                                           (+ 1 (lnfix next-idx))
+                                           used-idxs))
+                       (var next-var))
+                    (mv (g-integer sign bits var)
+                        next-idx (+ 1 (lnfix next-var)))))
+      (:g-integer? (b* ((intp next-idx)
+                        (sign (+ 1 (lnfix next-idx)))
+                        ((mv bits next-idx)
+                         (uniquify-nat-list (g-integer?->bits x)
+                                            (+ 2 (lnfix next-idx))
+                                            used-idxs))
+                        (var next-var))
+                     (mv (g-integer? sign bits var intp)
+                         next-idx (+ 1 (lnfix next-var)))))
+      (:g-boolean (if (hons-get (g-boolean->bool x) used-idxs)
+                      (mv (g-boolean next-idx) (+ 1 (lnfix next-idx)) (lnfix next-var))
+                    (mv x (lnfix next-idx) (lnfix next-var))))
       (:g-concrete (mv x (lnfix next-idx) (lnfix next-var)))
-      (:g-var (mv (g-var next-var) (lnfix next-idx) (1+ (lnfix next-var))))
+      (:g-var (b* ((v (g-var->name x)))
+                (if (and (symbolp v)
+                         (not (hons-get v used-vars)))
+                    (mv x (lnfix next-idx) (lnfix next-var))
+                  (mv (g-var (to-symb next-var)) (lnfix next-idx) (1+ (lnfix next-var))))))
       (:g-ite
        (b* (((mv test next-idx next-var)
-             (uniquify-shape-spec (g-ite->test x) next-idx next-var))
+             (uniquify-shape-spec (g-ite->test x) next-idx next-var used-idxs used-vars))
             ((mv then next-idx next-var)
-             (uniquify-shape-spec (g-ite->then x) next-idx next-var))
+             (uniquify-shape-spec (g-ite->then x) next-idx next-var used-idxs used-vars))
             ((mv else next-idx next-var)
-             (uniquify-shape-spec (g-ite->else x) next-idx next-var)))
+             (uniquify-shape-spec (g-ite->else x) next-idx next-var used-idxs used-vars)))
          (mv (g-ite test then else) next-idx next-var)))
+      (:g-call
+       (b* (((mv args next-idx next-var)
+             (uniquify-shape-spec (g-call->args x) next-idx next-var used-idxs used-vars)))
+         (mv (g-call (g-call->fn x) args
+                     (g-call->inverse x))
+             next-idx next-var)))
       (otherwise
        (b* (((mv car next-idx next-var)
-             (uniquify-shape-spec (car x) next-idx next-var))
+             (uniquify-shape-spec (car x) next-idx next-var used-idxs used-vars))
             ((mv cdr next-idx next-var)
-             (uniquify-shape-spec (cdr x) next-idx next-var)))
+             (uniquify-shape-spec (cdr x) next-idx next-var used-idxs used-vars)))
          (mv (cons car cdr) next-idx next-var))))))
 
 (defthm natp-next-idx-of-uniquify-shape-spec
-  (natp (mv-nth 1 (uniquify-shape-spec x next-idx next-var)))
+  (natp (mv-nth 1 (uniquify-shape-spec x next-idx next-var used-idxs used-vars)))
   :rule-classes (:rewrite :type-prescription))
 
 (defthm natp-next-var-of-uniquify-shape-spec
-  (natp (mv-nth 2 (uniquify-shape-spec x next-idx next-var)))
+  (natp (mv-nth 2 (uniquify-shape-spec x next-idx next-var used-idxs used-vars)))
   :rule-classes (:rewrite :type-prescription))
 
 (verify-guards uniquify-shape-spec
   :hints(("Goal" :in-theory (enable shape-specp))))
 
+(defun integer-with-nbitsp (n x)
+  (declare (xargs :guard t)
+           (ignore n))
+  (integerp x))
+
+(defun integer?-with-nbitsp (n x)
+  (declare (xargs :guard t)
+           (ignore n x))
+  t)
+
 (defconst *default-symobj-generators*
   '(((booleanp x) (g-boolean 0))
     ((unsigned-byte-p n x) (g-number (list (numlist 0 1 (+ 1 n)))))
-    ((signed-byte-p n x) (g-number (list (numlist 0 1 n))))))
+    ((signed-byte-p n x) (g-number (list (numlist 0 1 n))))
+    ((integer-with-nbitsp n x) (g-integer 0 (numlist 0 1 n) 0))
+    ((integer?-with-nbitsp n x) (g-integer? 0 (numlist 0 1 n) 0 0))))
 
 (defun translate-term-alist (gens wrld state-vars)
   (declare (xargs :mode :program))
@@ -381,7 +480,7 @@
 (defthm disjoin-of-intersection
   (implies (not (add-hyps-ev (disjoin clause) a))
            (not (add-hyps-ev (disjoin (intersection-equal x clause)) a)))
-  :hints(("Goal" :in-theory (enable intersection-equal))))
+  :hints(("Goal" :in-theory (enable member-equal intersection-equal))))
 
 (defthm group-list-cp-rec-correct
   (implies (not (add-hyps-ev (disjoin clause) a))
@@ -411,11 +510,20 @@
                                                   (acl2::term-vars-list clause)))))))
 
 
-(defun gl-auto-hint-step2 (clause g-bindings state)
+(defun maybe-print-clause-fn (print pr-name message clause state)
+  (declare (xargs :mode :program :stobjs state))
+  (and (or (eq print :all)
+           (member :all print)
+           (member pr-name print))
+       (cw message (acl2::prettyify-clause clause t (w state)))))
+
+(defmacro maybe-print-clause (pr-name message)
+  `(maybe-print-clause-fn print ,pr-name ,message clause state))
+
+(defun gl-auto-hint-step2 (clause g-bindings print state)
   (declare (xargs :mode :program :stobjs state))
   (b* ((gl-clause-proc (latest-gl-clause-proc))
-       (- (cw "using GL on clause: ~x0~%"
-              (acl2::prettyify-clause clause nil (w state))))
+       (- (maybe-print-clause :final-clause "using GL on clause: ~x0~%"))
        (config (make-glcp-config))
        (cov-hints (glcp-coverage-hints nil nil nil nil))
        (hyp (car clause))
@@ -431,21 +539,32 @@
     (glcp-combine-hints call cov-hints nil nil nil)))
 
 
-(defun gl-auto-hint-fn (clause type-gens bad-subterms state)
+(defun gl-auto-hint-fn (clause type-gens bad-subterms print state)
   (declare (xargs :mode :program :stobjs state))
-  (b* ((- (cw "before filtering: ~x0~%"
-              (acl2::prettyify-clause clause nil (w state))))
+  (b* ((- (maybe-print-clause :before-filtering "before filtering: ~x0~%"))
        (clause (filter-bad-subterms clause bad-subterms))
        ((mv bindings hyp-lits nonhyp-lits)
         (type-gen-collect-bindings clause type-gens state))
        (bindings (fast-alist-free (hons-shrink-alist bindings nil)))
-       ((mv g-bindings & &) (uniquify-shape-spec bindings 0 0))
+       (indices (shape-spec-indices bindings))
+       (vars (shape-spec-vars bindings))
+       (next-idx (+ 1 (max-list indices)))
+       (next-var (max-xn-sym vars))
+       (used-idxs (pairlis$ (acl2::duplicated-members indices) nil))
+       (used-vars (pairlis$ (acl2::duplicated-members vars) nil))
+       ((acl2::with-fast used-idxs used-vars))
+       ((mv g-bindings & &)
+        (uniquify-shape-spec bindings next-idx next-var used-idxs used-vars))
        (vars (strip-cars g-bindings))
        (concl-lits (filter-nonhyp-lits nonhyp-lits vars)))
     `(:computed-hint-replacement
       ((run-let-abstraction-cp clause)
-       (gl-auto-hint-step2 clause ',g-bindings state))
-      :clause-processor (group-lits-cp clause ',(list hyp-lits concl-lits)))))
+       (gl-auto-hint-step2 clause ',g-bindings ',print state))
+      :clause-processor (group-lits-cp clause ',(list (append hyp-lits (butlast concl-lits 1))
+                                                      (last concl-lits))))))
+
+
+
 
 
 (defun get-fixup-alist (clause fixups)
@@ -480,14 +599,21 @@
   :rule-classes :clause-processor)
 
 
-
+(defun remove-variables (x)
+  (if (atom x)
+      nil
+    (if (and (symbolp (car x))
+             (car x))
+        (remove-variables (cdr x))
+      (cons (car x) (remove-variables (cdr x))))))
+    
 
     
-(defun try-gl-hint-fn (clause stablep fixups subterms-types type-gens bad-subterms state)
+(defun try-gl-hint-fn (clause stablep fixups subterms-types type-gens
+                              bad-subterms print state)
   (declare (xargs :mode :program :stobjs state))
   (b* (((unless stablep) nil)
-       (- (cw "original clause: ~x0~%"
-              (acl2::prettyify-clause clause nil (w state))))
+       (- (maybe-print-clause :original-clause "original clause: ~x0~%"))
 
        ;; translate all the terms in the various arguments
        (state-vars (acl2::default-state-vars t))
@@ -513,13 +639,12 @@
                        clause))
 
        (- (and fixup-subst
-               (cw "fixed-up clause: ~x0~%"
-                   (acl2::prettyify-clause fixup-clause nil (w state)))))
+               (maybe-print-clause :fixed-up-clause "fixed-up clause: ~x0~%")))
 
        ;; collect the subterms that we'll generalize away and their type hyps
        ((mv subterms type-hyps)
         (collect-subterm-types fixup-clause subterms-types))
-       (subterms (remove-duplicates-equal subterms))
+       (subterms (remove-variables (remove-duplicates-equal subterms)))
        (type-hyps (remove-duplicates-equal type-hyps))
        (clause-vars (acl2::term-vars-list fixup-clause))
        (fresh-vars (make-n-vars (len subterms) 'x 0 clause-vars))
@@ -530,12 +655,14 @@
           (try-gl-add-hyps-cp
            clause '(,type-hyps
                     ((progn$
-                      (cw "before generalization: ~x0~%"
-                          (acl2::prettyify-clause clause nil (w state)))
+                      (let ((print ',print))
+                        (maybe-print-clause :before-generalization
+                                            "before generalization: ~x0~%"))
                       (cw "Variable mapping: ~x0~%"
                           ',(pairlis$ fresh-vars (pairlis$ subterms nil)))
                       '(:computed-hint-replacement
-                        ((gl-auto-hint-fn clause ',type-gens ',bad-subterms state))
+                        ((gl-auto-hint-fn clause ',type-gens ',bad-subterms
+                                          ',print state))
                         :clause-processor
                         (acl2::simple-generalize-cp
                          clause ',(pairlis$ subterms fresh-vars))))))))))
@@ -550,10 +677,11 @@
       add-hyps-hint)))
 
 
-(defmacro try-gl (&key fixes subterms-types type-gens bad-subterms)
+(defmacro try-gl (&key fixes subterms-types type-gens bad-subterms
+                       print)
   `(try-gl-hint-fn
     clause stable-under-simplificationp
-    ',fixes ',subterms-types ',type-gens ',bad-subterms state))
+    ',fixes ',subterms-types ',type-gens ',bad-subterms ',print state))
 
 
 ;; (include-book "gl")
diff -Nru acl2-6.2/books/centaur/gl/tutorial.lisp acl2-6.3/books/centaur/gl/tutorial.lisp
--- acl2-6.2/books/centaur/gl/tutorial.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/tutorial.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,676 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; tutorial.lisp
+;
+; Original authors: Sol Swords <sswords@centtech.com>
+;                   Jared Davis <jared@centtech.com>
+
+(in-package "GL")
+(include-book "xdoc/top" :dir :system)
+
+(defxdoc basic-tutorial
+  :parents (gl)
+  :short "An introductory guide, recommended for new users of @(see GL)."
+
+  :long "<p>This is a tutorial introduction to using GL to prove ACL2 theorems.
+We recommend going through the entire tutorial before beginning to use GL.</p>
+
+<p>You can think of this tutorial as a quick-start guide.  By the time you're
+done with it, you should have a good understanding of how GL works, and be able
+to use GL to easily prove many theorems.</p>
+
+<p>We don't try to cover more advanced topics, like @(see optimization) and
+@(see term-level-reasoning).  You'll probably want to get some practice using
+GL before exploring these topics.</p>")
+
+
+(defxdoc |1. An Example GL Proof|
+  :parents (basic-tutorial)
+  :long "
+
+<p>The usual way to load GL is to start with</p>
+@({
+    (include-book \"centaur/gl/gl\" :dir :system)
+})
+
+<p>Let's use GL to prove a theorem.  The following C code, from Sean
+Anderson <a href='http://graphics.stanford.edu/~seander/bithacks.html'>Bit
+Twiddling Hacks</a> page, is a fast way to count how many bits are set in a
+32-bit integer.</p>
+
+@({
+     v = v - ((v >> 1) & 0x55555555);
+     v = (v & 0x33333333) + ((v >> 2) & 0x33333333);
+     c = ((v + (v >> 4) & 0xF0F0F0F) * 0x1010101) >> 24;
+})
+
+<p>We can model this in ACL2 as follows.  It turns out that using
+arbitrary-precision addition and subtraction does not affect the result, but we
+must take care to use a 32-bit multiply to match the C code.</p>
+
+@({
+    (defun 32* (x y)
+      (logand (* x y) (1- (expt 2 32))))
+
+    (defun fast-logcount-32 (v)
+      (let* ((v (- v (logand (ash v -1) #x55555555)))
+             (v (+ (logand v #x33333333)
+                   (logand (ash v -2) #x33333333))))
+        (ash (32* (logand (+ v (ash v -4)) #xF0F0F0F)
+                  #x1010101)
+             -24)))
+})
+
+<p>We can then use GL to prove @('fast-logcount-32') computes the same
+result as ACL2's built-in @('logcount') function for all unsigned 32-bit
+inputs.</p>
+
+@({
+    (def-gl-thm fast-logcount-32-correct
+      :hyp   (unsigned-byte-p 32 x)
+      :concl (equal (fast-logcount-32 x)
+                    (logcount x))
+      :g-bindings `((x ,(g-int 0 1 33))))
+})
+
+<p>The @(':g-bindings') form is the only help GL needs from the user.  It tells
+GL how to construct a symbolic object that can represent every value for @('x')
+that satisfies the hypothesis (we'll cover this shortly).  No arithmetic books
+or lemmas are required&mdash;we actually don't even know why this algorithm
+works.  The proof completes in 0.09 seconds and results in the following ACL2
+theorem.</p>
+
+@({
+    (defthm fast-logcount-32-correct
+      (implies (unsigned-byte-p 32 x)
+               (equal (fast-logcount-32 x)
+                      (logcount x)))
+      :hints ((gl-hint ...)))
+})
+
+<p>GL can generate counterexamples to non-theorems.  At first, we didn't
+realize we needed to use a 32-bit multiply in @('fast-logcount-32'), and we
+just used an arbitrary-precision multiply instead.  The function still worked
+for test cases like @('0'), @('1') @('#b111'), and @('#b10111'), but when we
+tried to prove its correctness, GL showed us three counterexamples:
+@('#x80000000'), @('#xFFFFFFFF'), and @('#x9448C263').  By default, GL
+generates a first counterexample by setting bits to 0 wherever possible, a
+second by setting bits to 1, and a third with random bit settings.</p>")
+
+(defxdoc |2. Symbolic Objects|
+  :parents (basic-tutorial)
+  :long "
+
+<p>At its heart, GL works by manipulating Boolean expressions.  There are
+many ways to represent Boolean expressions.  GL currently supports a hons-based
+<see topic='@(url ubdds)'>BDD package</see> and also has support for using a
+hons-based @(see aig) representation.</p>
+
+<p>For any particular proof, you can choose which representation to use by
+picking one of the available proof @(see modes).  Each representation has
+strengths and weaknesses, and the choice of representation can significantly
+impact performance.  We give some advice about choosing these modes in @(see
+modes).</p>
+
+<p>The GL user does not need to know how BDDs and AIGs are represented; in this
+documentation we will just adopt a conventional syntax to describe Boolean
+expressions, e.g., @('true'), @('false'), @('A & B'), @('~C'), etc.</p>
+
+<p>GL groups Boolean expressions into <b>symbolic objects</b>.  Much like a
+Boolean expression can be evaluated to obtain a Boolean value, a symbolic
+object can be evaluated to produce an ACL2 object.  There are several kinds of
+symbolic objects, but numbers are a good start.  GL represents symbolic, signed
+integers as</p>
+
+@({
+    (:g-number <lsb-bits>)
+})
+
+<p>Where @('lsb-bits') is a list of Boolean expressions that represent the
+two's complement bits of the number.  The bits are in lsb-first order, and the
+last, most significant bit is the sign bit.  For instance, if @('p') is the
+following @(':g-number'),</p>
+
+@({
+    p = (:g-number (true   false   A & B   false))
+})
+
+<p>Then @('p') represents a 4-bit, signed integer whose value is either 1 or 5,
+depending on the value of @('A & B').</p>
+
+<p>GL uses another kind of symbolic object to represent ACL2 Booleans.
+In particular,</p>
+
+@({
+    (:g-boolean . <val>)
+})
+
+<p>represents @('t') or @('nil'), depending on the Boolean expression
+@('<val>').  For example,</p>
+
+@({
+     (:g-boolean . ~(A & B))
+})
+
+<p>is a symbolic object whose value is @('t') when @('p') has value 1, and
+@('nil') when @('p') has value 5.</p>
+
+<p>GL has a few other kinds of symbolic objects that are also tagged with
+keywords, such as @(':g-var') and @(':g-apply').  But an ACL2 object
+that does not have any of these special keywords within it is <i>also</i>
+considered to be a symbolic object, and just represents itself.  Furthermore, a
+cons of two symbolic objects represents the cons of the two objects they
+represent.  For instance,</p>
+
+@({
+    (1 . (:g-boolean .  A & B))
+})
+
+<p>represents either @('(1 . t)') or @('(1 . nil)').  Together, these
+conventions allow GL to avoid lots of tagging as symbolic objects are
+manipulated.</p>
+
+<p>One last kind of symbolic object we will mention represents an if-then-else
+among other symbolic objects.  Its syntax is:</p>
+
+@({
+     (:g-ite  <test>  <then>  .  <else>)
+})
+
+<p>where @('<test>'), @('<then>'), and @('<else>') are themselves symbolic
+objects.  The value of a @(':g-ite') is either the value of @('<then>') or
+of @('<else>'), depending on the value of @('<test>').  For example,</p>
+
+@({
+     (:g-ite  (:g-boolean . A)
+              (:g-number (B  A  false))
+              . #\\C)
+})
+
+<p>represents either 2, 3, or the character @('C').</p>
+
+<p>GL doesn't have a special symbolic object format for ACL2 objects other than
+numbers and Booleans.  But it is still possible to create symbolic objects that
+take any finite range of values among ACL2 objects, by using a nesting of
+@(':g-ite')s where the tests are @(':g-boolean')s.</p>")
+
+
+(defxdoc |3. Computing with Symbolic Objects|
+  :parents (basic-tutorial)
+  :long "
+
+<p>Once we have a representation for symbolic objects, we can perform symbolic
+executions on those objects.  For instance, recall the symbolic number @('p')
+which can have value 1 or 5,</p>
+
+@({
+    p = (:g-number (true   false   A & B   false))
+})
+
+<p>We might symbolically add 1 to @('p') to obtain a new symbolic number, say
+@('q'),</p>
+
+@({
+    q = (:g-number (false   true    A & B   false))
+})
+
+<p>which represents either 2 or 6.  Suppose @('r') is another symbolic number,</p>
+
+@({
+    r = (:g-number (A   false   true   false))
+})
+
+<p>which represents either 4 or 5.  We might add @('q') and @('r') to obtain
+@('s'),</p>
+
+@({
+    s = (:g-number (A    true    ~(A & B)    (A & B)    false))
+})
+
+<p>whose value can be 6, 7, or 11.</p>
+
+<p>Why can't @('s') be 10 if @('q') can be 6 and @('r') can be 4?  This
+combination isn't possible because @('q') and @('r') involve the same
+expression, @('A').  The only way for @('r') to be 4 is for @('A') to be false,
+but then @('q') must be 2.</p>
+
+<p>The underlying algorithm GL uses for symbolic additions is just a
+ripple-carry addition on the Boolean expressions making up the bits of the two
+numbers.  Performing a symbolic addition, then, means constructing new @(see
+ubdds) or @(see aig)s, depending on which mode is being used.</p>
+
+<p>GL has built-in support for symbolically executing most ACL2 primitives.
+Generally, this is done by cases on the types of the symbolic objects being
+passed in as arguments.  For instance, if we want to symbolically execute @(see
+consp) on @('s'), then we are asking whether a @(':g-number') may ever
+represent a cons, so the answer is simply @('nil').  Similarly, if we ever try
+to add a @(':g-boolean') to a @(':g-number'), by the ACL2 axioms the
+@(':g-boolean') is simply treated as 0.</p>
+
+<p>Beyond these primitives, GL provides what is essentially a <a
+href='http://www-formal.stanford.edu/jmc/recursive.pdf'>McCarthy-style
+interpreter</a> for symbolically executing terms.  By default, it expands
+function definitions until it reaches primitives, with some special handling
+for @(see if).  For better performance, its interpretation scheme can be
+customized with more efficient definitions and other @(see optimization)s.</p>
+")
+
+(defxdoc |4. Proving Theorems by Symbolic Execution|
+  :parents (basic-tutorial)
+  :long "
+
+<p>To see how symbolic execution can be used to prove theorems, let's return to
+the bit-counting example, where our goal was to prove</p>
+
+@({
+    (implies (unsigned-byte-p 32 x)
+             (equal (fast-logcount-32 x)
+                    (logcount x)))
+})
+
+<p>The basic idea is to first symbolically execute the above formula, and then
+check whether it can ever evaluate to @('nil').  But to do this symbolic
+execution, we need some symbolic object to represent @('x').</p>
+
+<p>We want our symbolic execution to cover all the cases necessary for proving
+the theorem, namely all @('x') for which the hypothesis @('(unsigned-byte-p 32
+x)') holds.  In other words, the symbolic object we choose needs to be able to
+represent any integer from 0 to @('2^32 - 1').</p>
+
+<p>Many symbolic objects cover this range.  As notation, let @('b0, b1, ...')
+represent independent Boolean variables in our Boolean expression
+representation.  Then, one suitable object is:</p>
+
+@({
+    Xinit = (:g-number (b0 b1 ... b31 b32)).
+})
+
+<p>Why does this have 33 variables?  The final bit, @('b32'), represents the
+sign, so this object covers the integers from @('-2^32') to @('2^32 - 1').  We
+could instead use a 34-bit integer, or a 35-bit integer, or some esoteric
+creation involving @(':g-ite') forms.  But perhaps the best object to use would
+be:</p>
+
+@({
+   Xbest = (:g-number (b0 b1 ... b31 false)).
+})
+
+<p>since it covers exactly the desired range using the simplest possible
+Boolean expressions.</p>
+
+<p>Suppose we choose @('Xbest') to stand for @('x') We can now symbolically
+execute the goal formula on that object.</p>
+
+<p>What does this involve?  First, @('(unsigned-byte-p 32 x)') produces the
+symbolic result @('t'), since it is always true of the possible values of
+@('Xbest').  It would have been equally valid for this to produce
+@('(:g-boolean . true)'), but GL prefers to produce constants when
+possible.</p>
+
+<p>Next, the @('(fast-logcount-32 x)') and @('(logcount x)') forms each yield
+@(':g-number') objects whose bits are Boolean expressions in the variables
+@('b0, ..., b31').  For example, the least significant bit will be an
+expression representing the XOR of all these variables.</p>
+
+<p>Finally, we symbolically execute @(see equal) on these two results.  This
+compares the Boolean expressions for their bits to determine if they are
+equivalent, and produces a symbolic object representing the answer.</p>
+
+<p>So far we have basically ignored the differences between using @(see ubdds)
+or @(see aig)s as our Boolean expression representation.  But here, the two
+approaches produce very different answers:</p>
+
+<ul>
+<li>Since UBDDs are canonical, the expressions for the bits of the two numbers
+  are syntactically equal, and the result from @(see equal) is simply @('t').</li>
+
+<li>With AIGs, the expressions for the bits are semantically equivalent but not
+  syntactically equal.  The result is therefore @('(:g-boolean . phi)'), where
+  @('phi') is a large Boolean expression in the variables @('b0, ..., b31').
+  The fact that @('phi') always evaluates to @('t') is not obvious just from
+  its syntax.</li>
+</ul>
+
+<p>At this point we have completed the symbolic execution of our goal formula,
+obtaining either @('t') in BDD mode, or this @(':g-boolean') object in AIG
+mode.  Recall that to prove theorems using symbolic execution, the idea is to
+symbolically execute the goal formula and then check whether its symbolic
+result can represent @('nil').  If we are using BDDs, it is obvious that @('t')
+cannot represent @('nil').  With AIGs, we simply ask a SAT solver whether
+@('phi') can evaluate to @('false'), and find that it cannot.  This completes
+the proof.</p>
+
+<p>GL automates this proof strategy, taking care of many of the details
+relating to creating symbolic objects, ensuring that they cover all the
+possible cases, and ensuring that @('nil') cannot be represented by the
+symbolic result.  When GL is asked to prove a non-theorem, it can generate
+counterexamples by finding assignments to the Boolean variables that cause the
+result to become @('nil').</p>")
+
+
+(defxdoc |5. Using def-gl-thm|
+  :parents (basic-tutorial)
+  :long "
+
+<p>The @(see def-gl-thm) command is the main interface for using GL to prove
+theorems.  Here is the command we used in the bit-counting example from @(csee
+|1. An Example GL Proof|):</p>
+
+@({
+    (def-gl-thm fast-logcount-32-correct
+      :hyp   (unsigned-byte-p 32 x)
+      :concl (equal (fast-logcount-32 x)
+                    (logcount x))
+      :g-bindings `((x ,(g-int 0 1 33))))
+})
+
+<p>Unlike an ordinary @(see defthm) command, @(see def-gl-thm) takes separate
+hypothesis and conclusion terms (its @('hyp') and @(':concl') arguments).  This
+separation allows GL to use the hypothesis to limit the scope of the symbolic
+execution it will perform.  You also have to provide GL with @(':g-bindings')
+that describe the symbolic objects to use for each free variable in the
+theorem.</p>
+
+<p>What are these bindings?  In the @('fast-logcount-32-correct') theorem, we
+used a convenient function, @('g-int'), to construct the @(':g-bindings').
+Expanding this away, here are the actual bindings:</p>
+
+@({
+   ((x (:g-number (0 1 2 ... 32))))
+})
+
+<p>The @(':g-bindings') argument uses a slight modification of the symbolic
+object format where the Boolean expressions are replaced by distinct natural
+numbers, each representing a Boolean variable.  In this case, our binding for
+@('x') stands for the following symbolic object:</p>
+
+@({
+    Xinit = (:g-number (b0 b1 ... b31 b32))
+})
+
+<p>Note that @('Xinit') is not the same object as @('Xbest') from @(see
+|4. Proving Theorems by Symbolic Execution|)&mdash;its sign bit is @('b32')
+instead of @('false'), so @('Xinit') can represent any 33-bit signed integer
+whereas @('Xbest') only represents 32-bit unsigned values.  In fact, the
+@(':g-bindings') syntax does not even allow us to describe objects like
+@('Xbest'), which has the constant @('false') instead of a variable as one of
+its bits.</p>
+
+<p>There is a good reason for this restriction.  One of the steps in our proof
+strategy is to prove <b>coverage</b>: we need to show the symbolic objects we
+are starting out with have a sufficient range of values to cover all cases for
+which the hypothesis holds; more on this in @(see |7. Proving Coverage|).  The
+restricted syntax permitted by @(':g-bindings') ensures that the range of
+values represented by each symbolic object is easy to determine.  Because of
+this, coverage proofs are usually automatic.</p>
+
+<p>Despite these restrictions, GL will still end up using @('Xbest') to carry
+out the symbolic execution.  GL optimizes the original symbolic objects
+inferred from the @(':g-bindings') by using the hypothesis to reduce the space
+of objects that are represented.  In BDD mode this optimization uses <a
+href='http://dx.doi.org/10.1145/309847.309968'>BDD parametrization</a>, which
+restricts the symbolic objects so they cover exactly the inputs recognized by
+the hypothesis.  In AIG mode we use a lighter-weight transformation that
+replaces variables with constants when the hypothesis sufficiently restricts
+them.  In this example, either optimization transforms @('Xinit') into
+@('Xbest').</p>")
+
+(defxdoc |6. Writing :g-bindings forms|
+  :parents (basic-tutorial)
+  :long "
+
+<p>In a typical @(see def-gl-thm) command, the @(':g-bindings') should have an
+entry for every free variable in the theorem.  Here is an example that shows
+some typical bindings.</p>
+
+@({
+    :g-bindings '((flag   (:g-boolean . 0))
+                  (a-bus  (:g-number (1 3 5 7 9)))
+                  (b-bus  (:g-number (2 4 6 8 10)))
+                  (mode   (:g-ite (:g-boolean . 11) exact . fast))
+                  (opcode #b0010100))
+})
+
+<p>These bindings allow @('flag') to take an arbitrary Boolean value,
+@('a-bus') and @('b-bus') any five-bit signed integer values, @('mode') either
+the symbol @('exact') or @('fast'), and @('opcode') only the value 20.</p>
+
+<p>(Aside: Note that since @('#b0010100') is not within a @(':g-boolean') or
+@(':g-number') form, it is <b>not</b> the index of a Boolean variable.
+Instead, like the symbols @('exact') and @('fast'), it is just an ordinary ACL2
+constant that stands for itself, i.e., 20.)</p>
+
+<p>These @(':g-boolean') and @(':g-number') are called @(see shape-specs).
+They are similar to the symbolic objects GL uses to compute with, except that
+natural number indices take the places of Boolean expressions.  The indices
+used throughout all of the bindings must be distinct, and represent free,
+independent Boolean variables.</p>
+
+<p>In BDD mode, these indices have additional meaning: they specify the BDD
+variable ordering, with smaller indices coming first in the order.  This
+ordering can greatly affect performance.  In AIG mode the choice of indices has
+no particular bearing on efficiency.</p>
+
+<p>How do you choose a good BDD ordering?  It is often good to interleave the
+bits of data buses that are going to be combined in some way.  It is also
+typically a good idea to put any important control signals such as opcodes and
+mode settings before the data buses.</p>
+
+<p>Often the same @(':g-bindings') can be used throughout several theorems,
+either verbatim or with only small changes.  In practice, we almost always
+generate the @(':g-bindings') forms by calling functions or macros.  One
+convenient function is</p>
+
+@({(g-int start by n)})
+
+<p>which generates a @(':g-number') form with @('n') bits, using
+indices that start at @('start') and increment by @('by').  This is
+particularly useful for interleaving the bits of numbers, as we did for the
+@('a-bus') and @('b-bus') bindings above:</p>
+
+@({
+     (g-int 1 2 5)  ---> (:g-number (1 3 5 7 9))
+     (g-int 2 2 5)  ---> (:g-number (2 4 6 8 10))
+})
+
+<p>Writing out @(':g-bindings') and getting all the indices can be tedious.
+See @(see auto-bindings) for a convenient macro that helps ensure that all the
+indices are different.</p>")
+
+
+(defxdoc |7. Proving Coverage|
+  :parents (basic-tutorial)
+  :long "
+
+<p>There are really two parts to any GL theorem.  First, we need to
+symbolically execute the goal formula and ensure it cannot evaluate to
+@('nil').  But in addition to this, we must ensure that the objects we use to
+represent the variables of the theorem cover all the cases that satisfy the
+hypothesis.  This part of the proof is called the <b>coverage
+obligation</b>.</p>
+
+<p>For @('fast-logcount-32-correct'), the coverage obligation is to show that
+our binding for @('x') is able to represent every integer from 0 to @('2^32 -
+1').  This is true of @('Xinit'), and the coverage proof goes through
+automatically.</p>
+
+<p>But suppose we forget that @(':g-number')s use a signed representation, and
+attempt to prove @('fast-logcount-32-correct') using the following (incorrect)
+g-bindings.</p>
+
+@({
+    :g-bindings `((x ,(g-int 0 1 32)))
+})
+
+<p>This looks like a 32-bit integer, but because of the sign bit it does not cover
+the intended unsigned range.  If we submit the @(see def-gl-thm) command
+with these bindings, the symbolic execution part of the proof is still successful.
+But this execution has only really shown the goal holds for 31-bit unsigned
+integers, so @(see def-gl-thm) prints the message</p>
+
+@({
+     ERROR: Coverage proof appears to have failed.
+})
+
+<p>and leaves us with a failed subgoal,</p>
+
+@({
+    (implies (and (integerp x)
+                  (<= 0 x)
+                  (< x 4294967296))
+             (< x 2147483648))
+})
+
+<p>This goal is clearly not provable: we are trying to show @('x') must be less
+than @('2^31') (from our @(':g-bindings')) whenever it is less than
+@('2^32') (from the hypothesis).</p>
+
+<p>Usually when the @(':g-bindings') are correct, the coverage proof will be
+automatic, so if you see that a coverage proof has failed, the first thing to
+do is check whether your bindings are really sufficient.</p>
+
+<p>On the other hand, proving coverage is undecidable in principle, so
+sometimes GL will fail to prove coverage even though the bindings are
+appropriate.  For these cases, there are some keyword arguments to @(see
+def-gl-thm) that may help coverage proofs succeed.</p>
+
+<p>First, as a practical matter, GL does the symbolic execution part of the
+proof <b>before</b> trying to prove coverage.  This can get in the way of
+debugging coverage proofs when the symbolic execution takes a long time.  You
+can use @(':test-side-goals t') to have GL skip the symbolic execution and go
+straight to the coverage proof.  Of course, no @(see defthm) is produced when
+this option is used.</p>
+
+<p>By default, our coverage proof strategy uses a restricted set of rules and
+ignores the current theory.  It heuristically expands functions in the
+hypothesis and throws away terms that seem irrelevant.  When this strategy
+fails, it is usually for one of two reasons.</p>
+
+<ol>
+
+<li>The heuristics expand too many terms and overwhelm ACL2.  GL tries to avoid
+this by throwing away irrelevant terms, but sometimes this approach is
+insufficient.  It may be helpful to disable the expansion of functions that are
+not important for proving coverage.  The @(':do-not-expand') argument allows
+you to list functions that should not be expanded.</li>
+
+<li>The heuristics throw away a necessary hypothesis, leading to unprovable
+goals.  GL's coverage proof strategy tries to show that the binding for each
+variable is sufficient, one variable at a time.  During this process it throws
+away hypotheses that do not mention the variable, but in some cases this can be
+inappropriate.  For instance, suppose the following is a coverage goal for
+@('b'):
+
+@({
+    (implies (and (natp a)
+                  (natp b)
+                  (< a (expt 2 15))
+                  (< b a))
+             (< b (expt 2 15)))
+})
+
+Here, throwing away the terms that don't mention @('b') will cause the proof to
+fail.  A good way to avoid this problem is to separate type and size hypotheses
+from more complicated assumptions that are not important for proving coverage,
+along these lines:
+
+@({
+    (def-gl-thm my-theorem
+      :hyp (and (type-assms-1 x)
+                (type-assms-2 y)
+                (type-assms-3 z)
+                (complicated-non-type-assms x y z))
+      :concl ...
+      :g-bindings ...
+      :do-not-expand '(complicated-non-type-assms))
+})
+
+</li>
+</ol>
+
+<p>For more control, you can also use the @(':cov-theory-add') argument to
+enable additional rules during the coverage proof, e.g., @(':cov-theory-add
+'(type-rule1 type-rule2)').</p>")
+
+
+(defxdoc |8. Exercises|
+  :parents (basic-tutorial)
+  :long "<p>Here are some exercises you can use to get some experience with
+using GL.</p>
+
+<p>These exercises will get you into some rough spots, so that you can learn
+how to get out.  If you get stuck, you can see our solutions in the file
+@('centaur/gl/solutions.lisp').</p>
+
+<p>We recommend trying to carry out these exercises in a new file.  You will
+probably want to start your file with:</p>
+
+@({
+    (in-package \"ACL2\")
+    (include-book \"centaur/gl/gl\" :dir :system)
+})
+
+<p>At certain points in the exercises, we assume your computer has at least
+<b>8 GB</b> of memory.</p>
+
+
+<h3>Arithmetic Exercises</h3>
+
+<p><b>1a.</b> Use GL to prove that addition commutes for 4-bit unsigned
+numbers:</p>
+
+@({
+     (implies (and (unsigned-byte-p 4 x)
+                   (unsigned-byte-p 4 y))
+              (equal (+ x y) (+ y x)))
+})
+
+<p><b>1b.</b> Carry out the same proof as in 1a, but construct your
+G-bindings:</p>
+
+<ul>
+ <li>Using @(see auto-bindings)</li>
+ <li>Using @(see g-int)</li>
+ <li>\"Manually\", without using either of these.</li>
+</ul>
+
+<p>Hints: you may want to consult @(see |6. Writing :g-bindings forms|) and
+@(see shape-specs).</p>
+
+
+<p><b>1c.</b> Extend your proof from 1a to 20-bit numbers.  How long does the
+proof take?  How much memory did it use?  Try the @(see hons-summary) command
+get a sense of the memory usage.</p>
+
+
+<p><b>1d.</b> In the same ACL2 session, unto your proof of 1c and submit it
+again.  How long did it take this time?  Can you explain what happened?</p>
+
+
+<p><b>1e.</b> Figure out how to optimize your G-bindings to make the proof in
+1c go through quickly.  For reliable timings, use @(see clear-memoize-tables)
+and @(see hons-clear) before each proof attempt.  Implement your solution using
+both @(see g-int) and @(see auto-bindings).</p>
+
+
+<p><b>1f.</b> Use GL to prove that addition commutes up to 3,000 bits.
+Hint: the @(see debugging) section might be able to help you.</p>
+
+
+")
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/gl/var-bounds.lisp acl2-6.3/books/centaur/gl/var-bounds.lisp
--- acl2-6.2/books/centaur/gl/var-bounds.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/gl/var-bounds.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,791 @@
+; GL - A Symbolic Simulation Framework for ACL2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; tutorial.lisp
+;
+; Original authors: Sol Swords <sswords@centtech.com>
+;                   Jared Davis <jared@centtech.com>
+
+(in-package "GL")
+(include-book "gtypes")
+(include-book "bvar-db")
+(include-book "param")
+(local (include-book "centaur/misc/arith-equivs" :dir :system))
+
+(defsection bfr-vars-bounded
+  (defun-sk bfr-vars-bounded (n x)
+    (forall m
+            (implies (<= (nfix n) (nfix m))
+                     (not (bfr-depends-on m x))))
+    :rewrite :direct)
+
+  (in-theory (disable bfr-vars-bounded))
+
+  (defthm bfr-vars-bounded-incr
+    (implies (and (bfr-vars-bounded m x)
+                  (<= (nfix m) (nfix n)))
+             (bfr-vars-bounded n x))
+    :hints ((and stable-under-simplificationp
+                 `(:expand (,(car (last clause)))))))
+
+  (local (in-theory (enable* acl2::arith-equiv-forwarding)))
+
+  (local (defthm bfr-eval-of-set-non-dep-cong
+           (implies (and (not (bfr-depends-on k x))
+                         (acl2::nat-equiv k k-equiv))
+                    (equal (bfr-eval x (bfr-set-var k-equiv v env))
+                           (bfr-eval x env)))))
+
+  (encapsulate nil
+    (local (defthm bfr-semantic-depends-on-of-set-var-equiv
+             (implies (and (not (bfr-semantic-depends-on k1 x))
+                           (acl2::nat-equiv k1 k2))
+                      (equal (bfr-eval x (bfr-set-var k2 v env))
+                             (bfr-eval x env)))))
+
+    (defcong acl2::nat-equiv equal (bfr-semantic-depends-on k x) 1
+      :hints(("Goal" :cases ((bfr-semantic-depends-on k x))
+              :in-theory (e/d (bfr-depends-on)
+                              (acl2::nat-equiv)))
+             (and stable-under-simplificationp
+                  (if (eq (caar clause) 'not)
+                      `(:expand (,(cadar clause)))
+                    `(:expand (,(cadar (last clause)))))))))
+
+  (defcong acl2::nat-equiv equal (bfr-depends-on k x) 1
+    :hints(("Goal" :cases ((bfr-depends-on k x))
+            :in-theory (enable bfr-depends-on))))
+
+  (defcong acl2::nat-equiv equal (bfr-vars-bounded n x) 1
+    :hints(("Goal"
+            :use ((:instance bfr-vars-bounded-necc
+                   (m (bfr-vars-bounded-witness acl2::n-equiv x)))
+                  (:instance bfr-vars-bounded-necc
+                   (n acl2::n-equiv)
+                   (m (bfr-vars-bounded-witness n x))))
+            :in-theory (e/d (bfr-vars-bounded)
+                            (bfr-vars-bounded-necc)))))
+
+  (defthm bfr-vars-bounded-of-consts
+    (and (bfr-vars-bounded k t)
+         (bfr-vars-bounded k nil))
+    :hints(("Goal" :in-theory (enable bfr-vars-bounded)))))
+
+(defsection bfr-list-vars-bounded
+  (defund bfr-list-vars-bounded (n x)
+    (if (atom x)
+        t
+      (and (bfr-vars-bounded n (car x))
+           (bfr-list-vars-bounded n (cdr x)))))
+
+  (local (in-theory (enable bfr-list-vars-bounded)))
+
+  (defthm bfr-list-vars-bounded-incr
+    (implies (and (bfr-list-vars-bounded m x)
+                  (<= (nfix m) (nfix n)))
+             (bfr-list-vars-bounded n x))
+    :hints ((and stable-under-simplificationp
+                 `(:expand (,(car (last clause)))))))
+
+  (defcong acl2::nat-equiv equal (bfr-list-vars-bounded n x) 1)
+
+  (defthm bfr-list-vars-bounded-of-cons
+    (equal (bfr-list-vars-bounded n (cons x y))
+           (and (bfr-vars-bounded n x)
+                (bfr-list-vars-bounded n y))))
+
+  (defthm bfr-list-vars-bounded-of-atom
+    (implies (not (consp x))
+             (equal (bfr-list-vars-bounded n x) t))
+    :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+
+(defsection pbfr-vars-bounded
+
+  (defun-sk pbfr-vars-bounded (n p x)
+    (forall m
+            (implies (<= (nfix n) (nfix m))
+                     (not (pbfr-depends-on m p x))))
+    :rewrite :direct)
+
+  (in-theory (disable pbfr-vars-bounded))
+
+  (defthm pbfr-vars-bounded-incr
+    (implies (and (pbfr-vars-bounded m p x)
+                  (<= (nfix m) (nfix n)))
+             (pbfr-vars-bounded n p x))
+    :hints ((and stable-under-simplificationp
+                 `(:expand (,(car (last clause)))))))
+
+  (local (in-theory (enable* acl2::arith-equiv-forwarding)))
+
+  (local (defthm pbfr-eval-of-set-non-dep-cong
+           (implies (and (not (pbfr-depends-on k p x))
+                         (acl2::nat-equiv k k-equiv)
+                         (bfr-eval p env)
+                         (bfr-eval p (bfr-set-var k-equiv v env)))
+                    (equal (bfr-eval x (bfr-param-env p (bfr-set-var k-equiv v env)))
+                           (bfr-eval x (bfr-param-env p env))))))
+
+  (encapsulate nil
+    (local (defthm pbfr-semantic-depends-on-of-set-var-equiv
+             (implies (and (not (pbfr-semantic-depends-on k1 p x))
+                           (acl2::nat-equiv k1 k2)
+                           (bfr-eval p env)
+                           (bfr-eval p (bfr-set-var k2 v env)))
+                      (equal (bfr-eval x
+                                       (bfr-param-env p (bfr-set-var k2 v env)))
+                             (bfr-eval x (bfr-param-env p env))))))
+    
+
+    (defcong acl2::nat-equiv equal (pbfr-semantic-depends-on k p x) 1
+      :hints(("Goal" :cases ((pbfr-semantic-depends-on k p x))
+              :in-theory (disable acl2::nat-equiv))
+             (and stable-under-simplificationp
+                  (if (eq (caar clause) 'not)
+                      `(:expand (,(cadar clause)))
+                    `(:expand (,(cadar (last clause)))))))))
+
+  (defcong acl2::nat-equiv equal (pbfr-depends-on k p x) 1
+    :hints(("Goal" :in-theory (enable pbfr-depends-on))))
+
+  (defcong acl2::nat-equiv equal (pbfr-vars-bounded n p x) 1
+    :hints(("Goal"
+            :use ((:instance pbfr-vars-bounded-necc
+                   (m (pbfr-vars-bounded-witness acl2::n-equiv p x)))
+                  (:instance pbfr-vars-bounded-necc
+                   (n acl2::n-equiv)
+                   (m (pbfr-vars-bounded-witness n p x))))
+            :in-theory (e/d (pbfr-vars-bounded)
+                            (pbfr-vars-bounded-necc)))))
+
+  (defthm pbfr-vars-bounded-of-consts
+    (and (pbfr-vars-bounded k p t)
+         (pbfr-vars-bounded k p nil))
+    :hints(("Goal" :in-theory (enable pbfr-vars-bounded))))
+
+  (defthm bfr-param-env-t
+    (equal (bfr-param-env t env)
+           env)
+    :hints(("Goal" :in-theory (enable bfr-param-env bfr-lookup))))
+
+  (defthm bfr-unparam-env-t
+    (equal (bfr-unparam-env t env) env)
+    :hints(("Goal" :in-theory (enable bfr-unparam-env))))
+
+
+  (defthm pbfr-semantic-depends-on-t
+    (implies (not (pbfr-semantic-depends-on k t x))
+             (not (bfr-semantic-depends-on k x)))
+    :hints (("goal" :expand ((bfr-semantic-depends-on k x))
+             :use ((:instance pbfr-semantic-depends-on-suff
+                    (p t)
+                    (v (mv-nth 1 (bfr-semantic-depends-on-witness k x)))
+                    (env (mv-nth 0 (bfr-semantic-depends-on-witness k x)))))
+             :in-theory (disable pbfr-semantic-depends-on-suff))))
+
+  (defthm pbfr-depends-on-t
+    (implies (not (pbfr-depends-on k t x))
+             (not (bfr-depends-on k x)))
+    :hints(("Goal" :in-theory (enable pbfr-depends-on bfr-depends-on
+                                      bfr-from-param-space))))
+
+  (defthm pbfr-semantic-depends-on-of-bfr-to-param-space
+    (implies (not (pbfr-semantic-depends-on k t x))
+             (not (pbfr-semantic-depends-on k p (bfr-to-param-space p x))))
+    :hints (("goal" :expand ((pbfr-semantic-depends-on k p (bfr-to-param-space p x)))
+             :use ((:instance pbfr-semantic-depends-on-suff
+                    (p t)
+                    (env (mv-nth 0 (pbfr-semantic-depends-on-witness k p (bfr-to-param-space p x))))
+                    (v (mv-nth 1 (pbfr-semantic-depends-on-witness k p (bfr-to-param-space p x))))))
+             :in-theory (disable pbfr-semantic-depends-on-suff
+                                 pbfr-eval-of-set-non-dep))))
+
+  (defthm pbfr-depends-on-of-bfr-to-param-space
+    (implies (not (pbfr-depends-on k t x))
+             (not (pbfr-depends-on k p (bfr-to-param-space p x))))
+    :hints(("Goal" :in-theory (enable pbfr-depends-on))
+           (and stable-under-simplificationp
+                '(:in-theory (enable bfr-to-param-space bfr-from-param-space
+                                     bfr-depends-on)))))
+
+  (defthm pbfr-vars-bounded-t
+    (implies (pbfr-vars-bounded k t x)
+             (bfr-vars-bounded k x))
+    :hints (("goal" :expand ((bfr-vars-bounded k x))
+             :use ((:instance pbfr-vars-bounded-necc
+                    (n k)
+                    (p t) (m (bfr-vars-bounded-witness k x))))
+             :in-theory (disable pbfr-vars-bounded-necc))))
+
+  (defthm pbfr-vars-bounded-of-bfr-to-param-space
+    (implies (pbfr-vars-bounded k t x)
+             (pbfr-vars-bounded k p (bfr-to-param-space p x)))
+    :hints (("goal" :expand ((pbfr-vars-bounded k p (bfr-to-param-space p x)))))))
+
+(defsection pbfr-list-depends-on
+  (local (in-theory (enable pbfr-list-depends-on)))
+
+  (defthm pbfr-list-depends-on-of-cons
+    (equal (pbfr-list-depends-on k p (cons x y))
+           (or (pbfr-depends-on k p x)
+               (pbfr-list-depends-on k p y))))
+
+  (defthm pbfr-list-depends-on-of-atom
+    (implies (not (consp x))
+             (equal (pbfr-list-depends-on k p x)
+                    nil))
+    :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+
+(defsection pbfr-list-vars-bounded
+  (defund pbfr-list-vars-bounded (n p x)
+    (if (atom x)
+        t
+      (and (pbfr-vars-bounded n p (car x))
+           (pbfr-list-vars-bounded n p (cdr x)))))
+
+  (defun pbfr-list-vars-bounded-witness (n p x)
+    (if (atom x)
+        nil
+      (or (and (not (pbfr-vars-bounded n p (car x)))
+               (nfix (pbfr-vars-bounded-witness n p (car x))))
+          (pbfr-list-vars-bounded-witness n p (cdr x)))))
+
+  (local (in-theory (enable pbfr-list-vars-bounded)))
+
+
+
+  (defthm pbfr-list-vars-bounded-implies-not-depends-on
+    (implies (and (pbfr-list-vars-bounded n p x)
+                  (<= (nfix n) (nfix m)))
+             (not (pbfr-list-depends-on m p x)))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on))))
+
+  (defthm pbfr-list-vars-bounded-incr
+    (implies (and (pbfr-list-vars-bounded m p x)
+                  (<= (nfix m) (nfix n)))
+             (pbfr-list-vars-bounded n p x))
+    :hints ((and stable-under-simplificationp
+                 `(:expand (,(car (last clause)))))))
+
+  (defcong acl2::nat-equiv equal (pbfr-list-vars-bounded n p x) 1)
+
+  (defthmd pbfr-list-vars-bounded-in-terms-of-witness
+    (implies (acl2::rewriting-positive-literal
+              `(pbfr-list-vars-bounded ,n ,p ,x))
+             (equal (pbfr-list-vars-bounded n p x)
+                    (let ((m (pbfr-list-vars-bounded-witness n p x)))
+                      (or (< (nfix m) (nfix n))
+                          (not (pbfr-list-depends-on m p x))))))
+    :hints(("Goal" :in-theory (enable pbfr-list-depends-on)
+            :induct t)
+           (and stable-under-simplificationp
+                '(:expand ((pbfr-vars-bounded n p (car x))
+                           (:free (n) (pbfr-list-depends-on n p x)))))))
+
+  (defthmd pbfr-list-vars-bounded-witness-under-iff
+    (iff (pbfr-list-vars-bounded-witness n p x)
+         (not (pbfr-list-vars-bounded n p x))))
+
+  (defthm pbfr-list-vars-bounded-of-cons
+    (equal (pbfr-list-vars-bounded n p (cons x y))
+           (and (pbfr-vars-bounded n p x)
+                (pbfr-list-vars-bounded n p y))))
+
+  (defthm pbfr-list-vars-bounded-of-atom
+    (implies (not (consp x))
+             (equal (pbfr-list-vars-bounded n p x) t))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm pbfr-list-vars-bounded-t
+    (implies (pbfr-list-vars-bounded k t x)
+             (bfr-list-vars-bounded k x)))
+
+  (defthm pbfr-list-vars-bounded-of-bfr-to-param-space
+    (implies (pbfr-list-vars-bounded k t x)
+             (pbfr-list-vars-bounded k p (bfr-list-to-param-space p x)))
+    :hints(("Goal" :in-theory (enable bfr-list-to-param-space)))))
+
+
+
+
+
+
+(defsection gobj-alist-depends-on
+
+  (defun gobj-alist-depends-on (k p x)
+    (if (atom x)
+        nil
+      (or (and (consp (car x))
+               (gobj-depends-on k p (cdar x)))
+          (gobj-alist-depends-on k p (cdr x)))))
+
+
+  (defthm gobj-alist-depends-on-of-pairlis$
+    (implies (not (gobj-list-depends-on k p x))
+             (not (gobj-alist-depends-on k p (pairlis$ keys x)))))
+
+  (defthm gobj-depends-on-of-alist-lookup
+    (implies (not (gobj-alist-depends-on k p alist))
+             (not (gobj-depends-on k p (cdr (hons-assoc-equal x alist)))))))
+
+
+
+(defsection gobj-vars-bounded
+
+  (mutual-recursion
+   (defun gobj-vars-bounded (k p x)
+     (if (atom x)
+         t
+       (pattern-match x
+         ((g-boolean b) (pbfr-vars-bounded k p b))
+         ((g-number n)
+          (b* (((mv rn rd in id) (break-g-number n)))
+            (and (pbfr-list-vars-bounded k p rn)
+                 (pbfr-list-vars-bounded k p rd)
+                 (pbfr-list-vars-bounded k p in)
+                 (pbfr-list-vars-bounded k p id))))
+         ((g-ite test then else)
+          (and (gobj-vars-bounded k p test)
+               (gobj-vars-bounded k p then)
+               (gobj-vars-bounded k p else)))
+         ((g-concrete &) t)
+         ((g-var &) t)
+         ((g-apply & args) (gobj-list-vars-bounded k p args))
+         (& (and (gobj-vars-bounded k p (car x))
+                 (gobj-vars-bounded k p (cdr x)))))))
+   (defun gobj-list-vars-bounded (k p x)
+     (if (atom x)
+         t
+       (and (gobj-vars-bounded k p (car x))
+            (gobj-list-vars-bounded k p (cdr x))))))
+
+  (mutual-recursion
+   (defun gobj-vars-bounded-witness (k p x)
+     (if (atom x)
+         nil
+       (pattern-match x
+         ((g-boolean b) (and (not (pbfr-vars-bounded k p b))
+                             (nfix (pbfr-vars-bounded-witness k p b))))
+         ((g-number n)
+          (b* (((mv rn rd in id) (break-g-number n)))
+            (or (pbfr-list-vars-bounded-witness k p rn)
+                (pbfr-list-vars-bounded-witness k p rd)
+                (pbfr-list-vars-bounded-witness k p in)
+                (pbfr-list-vars-bounded-witness k p id))))
+         ((g-ite test then else)
+          (or (gobj-vars-bounded-witness k p test)
+              (gobj-vars-bounded-witness k p then)
+              (gobj-vars-bounded-witness k p else)))
+         ((g-concrete &) nil)
+         ((g-var &) nil)
+         ((g-apply & args) (gobj-list-vars-bounded-witness k p args))
+         (& (or (gobj-vars-bounded-witness k p (car x))
+                (gobj-vars-bounded-witness k p (cdr x)))))))
+   (defun gobj-list-vars-bounded-witness (k p x)
+     (if (atom x)
+         nil
+       (or (gobj-vars-bounded-witness k p (car x))
+           (gobj-list-vars-bounded-witness k p (cdr x))))))
+
+  (in-theory (disable gobj-vars-bounded gobj-list-vars-bounded))
+  (local (in-theory (enable gobj-vars-bounded gobj-list-vars-bounded)))
+
+  (defthm-gobj-flag
+    (defthm gobj-vars-bounded-implies-not-depends-on
+      (implies (and (gobj-vars-bounded k p x)
+                    (<= (nfix k) (nfix n)))
+               (not (gobj-depends-on n p x)))
+      :flag gobj)
+    (defthm gobj-list-vars-bounded-implies-not-depends-on
+      (implies (and (gobj-list-vars-bounded k p x)
+                    (<= (nfix k) (nfix n)))
+               (not (gobj-list-depends-on n p x)))
+      :flag list))
+
+
+  (defthm-gobj-flag
+    (defthm gobj-vars-bounded-incr
+      (implies (and (gobj-vars-bounded k p x)
+                    (<= (nfix k) (nfix n)))
+               (gobj-vars-bounded n p x))
+      :flag gobj)
+    (defthm gobj-list-vars-bounded-incr
+      (implies (and (gobj-list-vars-bounded k p x)
+                    (<= (nfix k) (nfix n)))
+               (gobj-list-vars-bounded n p x))
+      :flag list))
+
+  (defthm-gobj-flag
+    (defthm gobj-vars-bounded-witness-under-iff
+      (iff (gobj-vars-bounded-witness k p x)
+           (not (gobj-vars-bounded k p x)))
+      :hints('(:in-theory (enable pbfr-list-vars-bounded-witness-under-iff)))
+      :flag gobj)
+    (defthm gobj-list-vars-bounded-witness-under-iff
+      (iff (gobj-list-vars-bounded-witness k p x)
+           (not (gobj-list-vars-bounded k p x)))
+      :flag list))
+
+  (defthm-gobj-flag
+    (defthm gobj-vars-bounded-in-terms-of-witness
+      (implies (acl2::rewriting-positive-literal
+                `(gobj-vars-bounded ,k ,p ,x))
+               (equal (gobj-vars-bounded k p x)
+                      (let ((n (gobj-vars-bounded-witness k p x)))
+                        (or (< (nfix n) (nfix k))
+                            (not (gobj-depends-on n p x))))))
+      :hints ('(:expand ((gobj-vars-bounded k p x)
+                         (gobj-vars-bounded-witness k p x)))
+              (and stable-under-simplificationp
+                   `(:expand ((PBFR-VARS-BOUNDED K P (G-BOOLEAN->BOOL X))))))
+      :flag gobj)
+    (defthm gobj-list-vars-bounded-in-terms-of-witness
+      (implies (acl2::rewriting-positive-literal
+                `(gobj-list-vars-bounded ,k ,p ,x))
+               (equal (gobj-list-vars-bounded k p x)
+                      (let ((n (gobj-list-vars-bounded-witness k p x)))
+                        (or (< (nfix n) (nfix k))
+                            (not (gobj-list-depends-on n p x))))))
+      :flag list)
+    :hints (("goal" :in-theory (e/d (pbfr-list-vars-bounded-in-terms-of-witness
+                                     pbfr-list-vars-bounded-witness-under-iff)
+                                    (gobj-vars-bounded gobj-vars-bounded-witness)))))
+
+  (in-theory (disable gobj-vars-bounded-in-terms-of-witness
+                      gobj-list-vars-bounded-in-terms-of-witness))
+
+  (defthm gobj-list-vars-bounded-of-g-apply->args
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-apply))
+             (gobj-list-vars-bounded k p (g-apply->args x))))
+
+  (defthm gobj-vars-bounded-of-g-ite->test
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-ite))
+             (gobj-vars-bounded k p (g-ite->test x))))
+
+  (defthm gobj-vars-bounded-of-g-ite->then
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-ite))
+             (gobj-vars-bounded k p (g-ite->then x))))
+
+  (defthm gobj-vars-bounded-of-g-ite->else
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-ite))
+             (gobj-vars-bounded k p (g-ite->else x))))
+
+  (defthm gobj-vars-bounded-car-of-gobj-list
+    (implies (gobj-list-vars-bounded k p x)
+             (gobj-vars-bounded k p (car x))))
+
+  (defthm gobj-list-vars-bounded-cdr-of-gobj-list
+    (implies (gobj-list-vars-bounded k p x)
+             (gobj-list-vars-bounded k p (cdr x))))
+
+  (defthm gobj-list-vars-bounded-of-cons
+    (equal (gobj-list-vars-bounded k p (cons a b))
+           (and (gobj-vars-bounded k p a)
+                (gobj-list-vars-bounded k p b))))
+
+  (defthm gobj-list-vars-bounded-of-atom
+    (implies (not (consp x))
+             (equal (gobj-list-vars-bounded k p x) t))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gobj-vars-bounded-car-of-gobj
+    (implies (and (gobj-vars-bounded k p x)
+                  (NOT (EQUAL (TAG X) :G-CONCRETE))
+                  (NOT (EQUAL (TAG X) :G-BOOLEAN))
+                  (NOT (EQUAL (TAG X) :G-NUMBER))
+                  (NOT (EQUAL (TAG X) :G-ITE))
+                  (NOT (EQUAL (TAG X) :G-VAR))
+                  (NOT (EQUAL (TAG X) :G-APPLY)))
+             (gobj-vars-bounded k p (car x))))
+
+  (defthm gobj-vars-bounded-cdr-of-gobj
+    (implies (and (gobj-vars-bounded k p x)
+                  (NOT (EQUAL (TAG X) :G-CONCRETE))
+                  (NOT (EQUAL (TAG X) :G-BOOLEAN))
+                  (NOT (EQUAL (TAG X) :G-NUMBER))
+                  (NOT (EQUAL (TAG X) :G-ITE))
+                  (NOT (EQUAL (TAG X) :G-VAR))
+                  (NOT (EQUAL (TAG X) :G-APPLY)))
+             (gobj-vars-bounded k p (cdr x))))
+
+  (defthm gobj-vars-bounded-of-g-boolean->bool
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-boolean))
+             (pbfr-vars-bounded k p (g-boolean->bool x))))
+
+  (defthm gobj-vars-bounded-of-g-number->num-0
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-number))
+             (pbfr-list-vars-bounded k p (mv-nth 0 (break-g-number (g-number->num x))))))
+
+  (defthm gobj-vars-bounded-of-g-number->num-1
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-number))
+             (pbfr-list-vars-bounded k p (mv-nth 1 (break-g-number (g-number->num x))))))
+
+  (defthm gobj-vars-bounded-of-g-number->num-2
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-number))
+             (pbfr-list-vars-bounded k p (mv-nth 2 (break-g-number (g-number->num x))))))
+
+  (defthm gobj-vars-bounded-of-g-number->num-3
+    (implies (and (gobj-vars-bounded k p x)
+                  (eq (tag x) :g-number))
+             (pbfr-list-vars-bounded k p (mv-nth 3 (break-g-number (g-number->num x))))))
+
+  (defthm-gobj-flag
+    (defthm generic-geval-of-set-var-when-gobj-vars-bounded
+      (implies (and (gobj-vars-bounded m p x)
+                    (<= (nfix m) (nfix k))
+                    (bfr-eval p env)
+                    (bfr-eval p (bfr-set-var k v env)))
+               (equal (generic-geval x (cons (bfr-param-env p (bfr-set-var k v env))
+                                             var-env))
+                      (generic-geval x (cons (bfr-param-env p env)
+                                             var-env))))
+      :hints ('(:expand ((:free (env) (:with generic-geval (generic-geval x env))))))
+      :flag gobj)
+    (defthm generic-geval-list-of-set-var-when-gobj-vars-bounded
+      (implies (and (gobj-list-vars-bounded m p x)
+                    (<= (nfix m) (nfix k))
+                    (bfr-eval p env)
+                    (bfr-eval p (bfr-set-var k v env)))
+               (equal (generic-geval-list x (cons (bfr-param-env p (bfr-set-var k v env))
+                                                  var-env))
+                      (generic-geval-list x (cons (bfr-param-env p env)
+                                                  var-env))))
+      :hints ('(:expand ((:free (env) (generic-geval-list x env)))))
+      :flag list))
+
+  (defthm gobj-vars-bounded-of-atom
+    (implies (not (consp x))
+             (gobj-vars-bounded k p x))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gobj-vars-bounded-of-gl-cons
+    (equal (gobj-vars-bounded k p (gl-cons a b))
+           (and (gobj-vars-bounded k p a)
+                (gobj-vars-bounded k p b)))
+    :hints(("Goal" :in-theory (enable gl-cons g-keyword-symbolp))))
+
+  (defthm gobj-vars-bounded-of-cons
+    (implies (not (g-keyword-symbolp x))
+             (equal (gobj-vars-bounded k p (cons x y))
+                    (and (gobj-vars-bounded k p x)
+                         (gobj-vars-bounded k p y))))
+    :hints(("Goal" :in-theory (enable g-keyword-symbolp))))
+
+
+
+  (defthm gobj-vars-bounded-of-g-apply
+    (equal (gobj-vars-bounded k p (g-apply fn args))
+           (gobj-list-vars-bounded k p args)))
+
+  (defthm gobj-vars-bounded-of-g-ite
+    (equal (gobj-vars-bounded k p (g-ite test then else))
+           (and (gobj-vars-bounded k p test)
+                (gobj-vars-bounded k p then)
+                (gobj-vars-bounded k p else))))
+
+  (defthm gobj-vars-bounded-of-g-number
+    (equal (gobj-vars-bounded k p (g-number num))
+           (b* (((mv rn rd in id) (break-g-number num)))
+             (and (pbfr-list-vars-bounded k p rn)
+                  (pbfr-list-vars-bounded k p rd)
+                  (pbfr-list-vars-bounded k p in)
+                  (pbfr-list-vars-bounded k p id)))))
+
+  (defthm gobj-vars-bounded-of-g-boolean
+    (equal (gobj-vars-bounded k p (g-boolean bool))
+           (pbfr-vars-bounded k p bool)))
+
+  (defthm gobj-vars-bounded-of-g-concrete
+    (equal (gobj-vars-bounded k p (g-concrete val)) t))
+
+  (defthm gobj-vars-bounded-of-g-var
+    (equal (gobj-vars-bounded k p (g-var val)) t))
+
+
+  (defthm gobj-vars-bounded-when-g-concrete
+    (implies (equal (tag x) :g-concrete)
+             (equal (gobj-vars-bounded k p x) t))
+    :hints (("goal" :expand ((gobj-vars-bounded k p x))))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gobj-vars-bounded-when-g-var
+    (implies (equal (tag x) :g-var)
+             (equal (gobj-vars-bounded k p x) t))
+    :hints (("goal" :expand ((gobj-vars-bounded k p x))))
+    :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(defsection gobj-vars-bounded-of-gobj-to-param-space
+
+  (defthmd pbfr-list-vars-bounded-of-boolean-list
+    (implies (boolean-listp x)
+             (pbfr-list-vars-bounded k p x))
+    :hints(("Goal" :in-theory (enable bfr-list-vars-bounded boolean-listp))))
+
+  (local (in-theory (enable pbfr-list-vars-bounded-of-boolean-list)))
+
+  (local (defthm boolean-listp-i2v
+           (boolean-listp (i2v n))
+           :hints(("Goal" :in-theory (e/d (bfr-scons) (logcar logcdr))))))
+
+  (local (defthm boolean-listp-n2v
+           (boolean-listp (n2v n))
+           :hints(("Goal" :in-theory (e/d (bfr-ucons) (logcar logcdr))))))
+
+  (defthm gobj-vars-bounded-of-mk-g-number
+    (implies (and (pbfr-list-vars-bounded k p rn)
+                  (pbfr-list-vars-bounded k p rd)
+                  (pbfr-list-vars-bounded k p in)
+                  (pbfr-list-vars-bounded k p id))
+             (gobj-vars-bounded k p (mk-g-number rn rd in id)))
+    :hints(("Goal" :in-theory (e/d (mk-g-number-fn)
+                                   (i2v n2v
+                                        equal-of-booleans-rewrite
+                                        sets::double-containment)))))
+
+  (defthm-gobj-flag
+    (defthm gobj-vars-bounded-of-gobj-to-param-space
+      (implies (gobj-vars-bounded k t x)
+               (gobj-vars-bounded
+                k p (gobj-to-param-space x p)))
+      :hints ('(:expand ((gobj-to-param-space x p)
+                         (gobj-vars-bounded k t x))
+                :in-theory (enable mk-g-ite
+                                   mk-g-boolean
+                                   ; mk-g-number
+                                   gnumber-to-param-space)))
+      :flag gobj)
+    (defthm gobj-list-vars-bounded-of-gobj-list-to-param-space
+      (implies (gobj-list-vars-bounded k t x)
+               (gobj-list-vars-bounded
+                k p (gobj-list-to-param-space x p)))
+      :hints ('(:expand ((gobj-list-to-param-space x p))))
+      :flag list)))
+
+
+(defsection gobj-alist-vars-bounded
+  (defund gobj-alist-vars-bounded (k p x)
+    (if (atom x)
+        t
+      (and (or (atom (car x))
+               (gobj-vars-bounded k p (cdar x)))
+           (gobj-alist-vars-bounded k p (cdr x)))))
+
+  (defund gobj-alist-vars-bounded-witness (k p x)
+    (if (atom x)
+        nil
+      (or (and (consp (car x))
+               (gobj-vars-bounded-witness k p (cdar x)))
+          (gobj-alist-vars-bounded-witness k p (cdr x)))))
+
+  (local (in-theory (enable gobj-alist-vars-bounded
+                            gobj-alist-vars-bounded-witness)))
+
+  (defthm gobj-alist-vars-bounded-implies-not-depends-on
+    (implies (and (gobj-alist-vars-bounded k p x)
+                  (<= (nfix k) (nfix n)))
+             (not (gobj-alist-depends-on n p x)))
+    :hints(("Goal" :in-theory (enable gobj-alist-depends-on))))
+
+  (defthm gobj-alist-vars-bounded-of-pairlis$
+    (implies (gobj-list-vars-bounded k p x)
+             (gobj-alist-vars-bounded k p (pairlis$ keys x))))
+
+  (defthm gobj-vars-bounded-of-alist-lookup
+    (implies (gobj-alist-vars-bounded k p alist)
+             (gobj-vars-bounded k p (cdr (hons-assoc-equal x alist)))))
+
+  (defthm gobj-alist-vars-bounded-incr
+    (implies (and (gobj-alist-vars-bounded m p x)
+                  (<= (nfix m) (nfix n)))
+             (gobj-alist-vars-bounded n p x))
+    :hints ((and stable-under-simplificationp
+                 `(:expand (,(car (last clause)))))))
+
+  (defthm gobj-alist-vars-bounded-witness-under-iff
+    (iff (gobj-alist-vars-bounded-witness k p x)
+         (not (gobj-alist-vars-bounded k p x))))
+
+  (defthmd gobj-alist-vars-bounded-in-terms-of-witness
+    (implies (acl2::rewriting-positive-literal
+              `(gobj-alist-vars-bounded ,k ,p ,x))
+             (equal (gobj-alist-vars-bounded k p x)
+                    (let ((n (gobj-alist-vars-bounded-witness k p x)))
+                      (or (< (nfix n) (nfix k))
+                          (not (gobj-alist-depends-on n p x))))))
+    :hints(("Goal" :in-theory (enable gobj-alist-depends-on
+                                      gobj-vars-bounded-in-terms-of-witness))))
+
+  (defthm gobj-alist-vars-bounded-of-cons
+    (equal (gobj-alist-vars-bounded k p (cons a b))
+           (and (or (atom a)
+                    (gobj-vars-bounded k p (cdr a)))
+                (gobj-alist-vars-bounded k p b))))
+
+  (defthm gobj-alist-vars-bounded-of-atom
+    (implies (not (consp x))
+             (equal (gobj-alist-vars-bounded k p x) t))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm gobj-alist-vars-bounded-of-gobj-alist-to-param-space
+    (implies (gobj-alist-vars-bounded k t x)
+             (gobj-alist-vars-bounded
+              k p (gobj-alist-to-param-space x p)))))
+
+
+(defsection bvar-db-orderedp
+
+  (defun-sk bvar-db-orderedp (p bvar-db)
+    (forall n
+            (implies (and (natp n)
+                          (<= (base-bvar$a bvar-db) n)
+                          (< n (next-bvar$a bvar-db)))
+                     (gobj-vars-bounded n p (get-bvar->term$a n bvar-db))))
+    :rewrite :direct)
+
+  (in-theory (disable bvar-db-orderedp))
+
+  (defthm gobj-vars-bounded-of-get-bvar->term-when-bvar-db-orderedp
+    (implies (and (bvar-db-orderedp p bvar-db)
+                  (<= (base-bvar$a bvar-db) (nfix m))
+                  (<= (nfix m) (nfix n))
+                  (< (nfix m) (next-bvar$a bvar-db)))
+             (gobj-vars-bounded n p (get-bvar->term$a m bvar-db)))
+    :hints (("goal" :use ((:instance bvar-db-orderedp-necc
+                           (n (nfix m))))
+             :in-theory (disable bvar-db-orderedp-necc))))
+
+  (defthm bvar-db-orderedp-of-parametrize-bvar-db
+    (implies (bvar-db-orderedp t bvar-db)
+             (bvar-db-orderedp p (parametrize-bvar-db p bvar-db bvar-db1)))
+    :hints (("goal" :expand ((bvar-db-orderedp p (parametrize-bvar-db p bvar-db nil)))
+             :in-theory (disable parametrize-bvar-db))))
+
+  (defthm bvar-db-orderedp-of-init-bvar-db
+    (bvar-db-orderedp p (init-bvar-db$a base bvar-db))
+    :hints(("Goal" :in-theory (enable bvar-db-orderedp)))))
+
diff -Nru acl2-6.2/books/centaur/jared-customization.lsp acl2-6.3/books/centaur/jared-customization.lsp
--- acl2-6.2/books/centaur/jared-customization.lsp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/jared-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -108,8 +108,6 @@
 
 #!ACL2
 (progn
-  (add-untranslate-pattern (coerce ?x 'list)
-                           (chars ?x))
 
   (add-untranslate-pattern (car ?x)
                            (first ?x))
@@ -223,6 +221,10 @@
  (if (not (boundp-global :suppress-preload-xdoc state))
      `(progn
         (include-book "xdoc/top" :dir :system)
+        (include-book "xdoc/debug" :dir :system)
         (xdoc::colon-xdoc-init))
    `(value-triple nil)))
 
+
+; maybe actually report correct times
+(assign get-internal-time-as-realtime t)
diff -Nru acl2-6.2/books/centaur/misc/1d-arr.lisp acl2-6.3/books/centaur/misc/1d-arr.lisp
--- acl2-6.2/books/centaur/misc/1d-arr.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/1d-arr.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -40,6 +40,8 @@
       (progn
         (include-book "data-structures/list-defthms" :dir :system)
         (in-theory (enable nth update-nth resize-list))
+        (local (in-theory (disable RESIZE-LIST-WHEN-EMPTY)))
+
         (:@ :fix
          (def-universal-equiv 1d-arr-tmp-equiv
            :equiv-terms ((equal (_fix_ x)))))
@@ -47,15 +49,15 @@
         (def-universal-equiv 1d-arr-tmp-list-equiv
           :qvars (i)
           :equiv-terms ((1d-arr-tmp-equiv (nth i x))))
-        
+
         (defcong 1d-arr-tmp-list-equiv 1d-arr-tmp-equiv (nth i x) 2
           :hints(("Goal" :in-theory (e/d (1d-arr-tmp-list-equiv-necc)
                                          (1d-arr-tmp-equiv)))))
-        
+
         (defcong 1d-arr-tmp-list-equiv 1d-arr-tmp-list-equiv (update-nth i v x) 3
           :hints((and stable-under-simplificationp
                       `(:expand (,(car (last clause)))))))
-        
+
         (defcong 1d-arr-tmp-equiv 1d-arr-tmp-list-equiv (update-nth i v x) 2
           :hints((and stable-under-simplificationp
                       `(:expand (,(car (last clause)))))))
@@ -81,7 +83,8 @@
          (defthm 1d-arr-tmp-listp-of-resize-list
            (implies (and (1d-arr-tmp-listp x)
                          (_pred_ default))
-                    (1d-arr-tmp-listp (resize-list x n default)))))))
+                    (1d-arr-tmp-listp (resize-list x n default))))
+           )))
 
      (defstobj _arrname_$c
        (_slotname_s$c :type (array _type-decl_
@@ -200,12 +203,13 @@
   :short "Defines a stobj containing an array of objects of a certain type, and
 a convenient abstraction so that logically operations on it are just list
 manipulations"
-  :long "
- <p>Def-1d-arr produces an abstract stobj whose accessors/updaters are
+
+  :long "<p>Def-1d-arr produces an abstract stobj whose accessors/updaters are
 list operations in the logic, but use fast array accesses to execute.</p>
 
 <h2>Usage</h2>
-<p>Example:
+
+<p>Example:</p>
 @({
  (def-1d-arr :arrname swidgarr
       :slotname swidg
@@ -216,11 +220,13 @@
       :pkg-sym xdoc::asdfs)
 })
 
-The possible arguments are as follows:
+<p>The possible arguments are as follows:</p>
 <ul>
+
  <li>@(':arrname') is the name of the abstract stobj that will be produced.  It
   defaults to @('<slotname>arr'), and @(':slotname') must be provided if
   @(':arrname') is not.</li>
+
  <li>@(':slotname') is the base for the names of the accessor functions.  It
   defaults to @('<arrname>val').  In this case, with slotname @('swidg'), the
   accessor functions will be:
@@ -230,25 +236,27 @@
    <li>@('set-swidg')</li>
    <li>@('resize-swidgs')</li>
   </ul></li>
+
  <li>@(':pred') is a predicate recognizing elements of the desired type.  It
   defaults to @('nil'), in which case any object is accepted.</li>
+
  <li>@(':fix') is a fixing function of the desired type.  This may only be
 supplied if @(':pred') is also given.  When the fixing function is supplied,
 the logical definition of e.g. @('get-swidg') is @('(swidg-fix (nth i
 swidgarr))'), which makes it trivial to show that array accesses always produce
 elements of the correct type.</li>
+
   <li>@(':type-decl') is the type declaration that will be put on the base
 stobj, primarily affecting performance.</li>
+
   <li>@(':default-val') gives the default array element for resizing (the
    @(':initially') argument to the stobj).</li>
+
   <li>@(':pkg-sym'), if given, determines the package in which any newly
 created symbols will be interned.  If not given, @(':arrname') or
 @(':slotname') are used instead.</li>
-</ul>
-
-</p>
 
-")
+</ul>")
 
 
 (deffunmac def-1d-arr (&key arrname
@@ -292,7 +300,7 @@
       tmpl)))
 
 
-                              
+
 
 
 
diff -Nru acl2-6.2/books/centaur/misc/2d-arr.lisp acl2-6.3/books/centaur/misc/2d-arr.lisp
--- acl2-6.2/books/centaur/misc/2d-arr.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/2d-arr.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -120,7 +120,8 @@
                               arith-equiv-forwarding)
                              (nth-with-large-index
                               len-update-nth
-                              nth update-nth))))
+                              nth update-nth
+                              ))))
 
      (defstobj _prefix_e-arr2
        (_prefix_e-nrows :type (unsigned-byte 60) :initially 0)
diff -Nru acl2-6.2/books/centaur/misc/arith-equiv-defs.lisp acl2-6.3/books/centaur/misc/arith-equiv-defs.lisp
--- acl2-6.2/books/centaur/misc/arith-equiv-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/misc/arith-equiv-defs.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,104 @@
+; Centaur Miscellaneous Books
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>, Sol Swords <sswords@centtech.com>
+
+; arith-equivs.lisp -- congruence reasoning about integers/naturals/bits
+
+
+;; Note: To use this book at full strength, do:
+;; (local (in-theory (enable* arith-equiv-forwarding)))
+
+(in-package "ACL2")
+(include-book "ihs/basic-definitions" :dir :system)
+(include-book "tools/rulesets" :dir :system)
+
+(defthm bitp-compound-recognizer
+  ;; Questionable given the bitp-forward rule.  But I think we may still want
+  ;; this.
+  (implies (bitp x)
+           (natp x))
+  :rule-classes :compound-recognizer)
+
+;; (defthm bitp-when-under-2
+;;   ;; questionable to bring arithmetic into it
+;;   (implies (< x 2)
+;;            (equal (bitp x)
+;;                   (natp x))))
+
+;; (defthm bitp-when-over-1
+;;   (implies (< 1 x)
+;;            (not (bitp x))))
+
+(defun int-equiv (a b)
+  (declare (xargs :guard t))
+  (equal (ifix a) (ifix b)))
+
+(defun nat-equiv (a b)
+  (declare (xargs :guard t))
+  (equal (nfix a) (nfix b)))
+
+(defun bit-equiv (x y)
+  (declare (xargs :guard t))
+  (equal (bfix x) (bfix y)))
+
+(local (in-theory (enable int-equiv nat-equiv bit-equiv)))
+
+(defequiv int-equiv)
+(defequiv nat-equiv)
+(defequiv bit-equiv)
+
+(defrefinement int-equiv nat-equiv)
+(defrefinement nat-equiv bit-equiv)
+;; (defrefinement int-equiv bit-equiv) ;; already known
+
+(defcong int-equiv equal (ifix a) 1)
+(defcong nat-equiv equal (nfix a) 1)
+(defcong bit-equiv equal (bfix a) 1)
+
+(defthm ifix-under-int-equiv
+  (int-equiv (ifix a) a))
+
+(defthm nfix-under-nat-equiv
+  (nat-equiv (nfix a) a))
+
+(defthm bfix-under-bit-equiv
+  (bit-equiv (bfix a) a))
+
+(defcong int-equiv equal (zip a) 1)
+(defcong nat-equiv equal (zp a)  1)
+(defcong bit-equiv equal (zbp a) 1)
+
+(defund-inline bool->bit (x)
+  (declare (xargs :guard t))
+  (if x 1 0))
+
+(defund negp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (< x 0)))
+
+(defthm negp-compound-recognizer
+  (equal (negp x)
+         (and (integerp x)
+              (< x 0)))
+  :hints(("Goal" :in-theory (enable negp)))
+  :rule-classes :compound-recognizer)
+
+
+
diff -Nru acl2-6.2/books/centaur/misc/arith-equivs.lisp acl2-6.3/books/centaur/misc/arith-equivs.lisp
--- acl2-6.2/books/centaur/misc/arith-equivs.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/arith-equivs.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -25,65 +25,9 @@
 ;; (local (in-theory (enable* arith-equiv-forwarding)))
 
 (in-package "ACL2")
-(include-book "ihs/basic-definitions" :dir :system)
-(include-book "tools/rulesets" :dir :system)
+(include-book "arith-equiv-defs")
 (include-book "std/lists/mfc-utils" :dir :system)
 
-(defthm bitp-compound-recognizer
-  ;; Questionable given the bitp-forward rule.  But I think we may still want
-  ;; this.
-  (implies (bitp x)
-           (natp x))
-  :rule-classes :compound-recognizer)
-
-;; (defthm bitp-when-under-2
-;;   ;; questionable to bring arithmetic into it
-;;   (implies (< x 2)
-;;            (equal (bitp x)
-;;                   (natp x))))
-
-;; (defthm bitp-when-over-1
-;;   (implies (< 1 x)
-;;            (not (bitp x))))
-
-(defun int-equiv (a b)
-  (declare (xargs :guard t))
-  (equal (ifix a) (ifix b)))
-
-(defun nat-equiv (a b)
-  (declare (xargs :guard t))
-  (equal (nfix a) (nfix b)))
-
-(defun bit-equiv (x y)
-  (declare (xargs :guard t))
-  (equal (bfix x) (bfix y)))
-
-(local (in-theory (enable int-equiv nat-equiv bit-equiv)))
-
-(defequiv int-equiv)
-(defequiv nat-equiv)
-(defequiv bit-equiv)
-
-(defrefinement int-equiv nat-equiv)
-(defrefinement nat-equiv bit-equiv)
-;; (defrefinement int-equiv bit-equiv) ;; already known
-
-(defcong int-equiv equal (ifix a) 1)
-(defcong nat-equiv equal (nfix a) 1)
-(defcong bit-equiv equal (bfix a) 1)
-
-(defthm ifix-under-int-equiv
-  (int-equiv (ifix a) a))
-
-(defthm nfix-under-nat-equiv
-  (nat-equiv (nfix a) a))
-
-(defthm bfix-under-bit-equiv
-  (bit-equiv (bfix a) a))
-
-(defcong int-equiv equal (zip a) 1)
-(defcong nat-equiv equal (zp a)  1)
-(defcong bit-equiv equal (zbp a) 1)
 
 (defthm posp-redefinition
   (equal (posp x) (not (zp x))))
@@ -201,19 +145,8 @@
 
 
 
-(defund negp (x)
-  (declare (xargs :guard t))
-  (and (integerp x)
-       (< x 0)))
-
 (local (in-theory (enable negp)))
 
-(defthm negp-compound-recognizer
-  (equal (negp x)
-         (and (integerp x)
-              (< x 0)))
-  :rule-classes :compound-recognizer)
-
 (defthm negp-when-integerp
   (implies (integerp x)
            (equal (negp x)
@@ -661,10 +594,6 @@
 (encapsulate
   ()
 
-  (defund-inline bool->bit (x)
-    (declare (xargs :guard t))
-    (if x 1 0))
-
   (local (in-theory (enable bool->bit)))
 
   ;; (bit->bool x) would just be the same as (equal x 1).  So we just use this
diff -Nru acl2-6.2/books/centaur/misc/beta-reduce-full.acl2 acl2-6.3/books/centaur/misc/beta-reduce-full.acl2
--- acl2-6.2/books/centaur/misc/beta-reduce-full.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/misc/beta-reduce-full.acl2	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,2 @@
+
+(ld "tools/flag-package.lsp" :dir :system)
diff -Nru acl2-6.2/books/centaur/misc/beta-reduce-full.lisp acl2-6.3/books/centaur/misc/beta-reduce-full.lisp
--- acl2-6.2/books/centaur/misc/beta-reduce-full.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/misc/beta-reduce-full.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,171 @@
+; Centaur Miscellaneous Books
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; beta-reduce-full.lisp
+;
+; Original authors: Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+
+(include-book "tools/bstar" :dir :system)
+(include-book "tools/flag" :dir :system)
+
+
+;; note: intended to be compatible (redundant) with misc/beta-reduce.lisp
+(defevaluator beta-eval beta-eval-list nil)
+
+(mutual-recursion
+ (defun beta-reduce-full-rec (x alist)
+   (declare (xargs :guard (and (pseudo-termp x)
+                               (symbol-alistp alist))
+                   :verify-guards nil))
+   (b* (((when (null x)) nil)
+        ((when (variablep x)) (cdr (assoc x alist)))
+        ((when (fquotep x)) x)
+        (args (beta-reduce-full-rec-list (fargs x) alist))
+        (fn (ffn-symb x))
+        ((when (atom fn)) (cons fn args))
+        (formals (lambda-formals fn))
+        (body (lambda-body fn)))
+     (beta-reduce-full-rec body (pairlis$ formals args))))
+ (defun beta-reduce-full-rec-list (x alist)
+   (declare (xargs :guard (and (pseudo-term-listp x)
+                               (symbol-alistp alist))))
+   (if (endp x)
+       nil
+     (cons (beta-reduce-full-rec (car x) alist)
+           (beta-reduce-full-rec-list (cdr x) alist)))))
+
+(flag::make-flag beta-reduce-flg beta-reduce-full-rec
+                 :flag-mapping ((beta-reduce-full-rec . term)
+                                (beta-reduce-full-rec-list . list)))
+
+(defthm len-of-beta-reduce-full-rec-list
+  (equal (len (beta-reduce-full-rec-list x alist))
+         (len x)))
+
+(defthm true-listp-of-beta-reduce-full-rec-list
+  (true-listp (beta-reduce-full-rec-list x alist))
+  :hints (("goal" :induct (len x))))
+
+(defthm symbol-alistp-pairlis
+  (implies (symbol-listp keys)
+           (symbol-alistp (pairlis$ keys vals))))
+
+(verify-guards beta-reduce-full-rec)
+
+(defun beta-eval-alist (x a)
+  (if (atom x)
+      nil
+    (cons (cons (caar x) (beta-eval (cdar x) a))
+          (beta-eval-alist (cdr x) a))))
+
+(defthm beta-eval-alist-of-pairlis
+  (equal (beta-eval-alist (pairlis$ keys vals) a)
+         (pairlis$ keys (beta-eval-list vals a))))
+
+(defthm lookup-in-beta-eval-alist
+  (implies k
+           (equal (assoc k (beta-eval-alist x a))
+                  (and (assoc k x)
+                       (cons k (beta-eval (cdr (assoc k x)) a))))))
+
+(local
+ (defthm strip-cdrs-of-pairlis
+   (implies (and (true-listp vals)
+                 (equal (len keys) (len vals)))
+            (equal (strip-cdrs (pairlis$ keys valS))
+                   vals))))
+
+(defthm-beta-reduce-flg
+  (defthm pseudo-termp-of-beta-reduce-full-rec
+    (implies (and (pseudo-termp x)
+                  (pseudo-term-listp (strip-cdrs alist)))
+             (pseudo-termp (beta-reduce-full-rec x alist)))
+    :flag term)
+  (defthm pseudo-term-listp-of-beta-reduce-full-rec-list
+    (implies (and (pseudo-term-listp x)
+                  (pseudo-term-listp (strip-cdrs alist)))
+             (pseudo-term-listp (beta-reduce-full-rec-list x alist)))
+    :flag list))
+
+(defthm-beta-reduce-flg
+  (defthm beta-reduce-full-rec-correct
+    (implies (pseudo-termp x)
+             (equal (beta-eval (beta-reduce-full-rec x alist) a)
+                    (beta-eval x (beta-eval-alist alist a))))
+    :hints ('(:in-theory (enable beta-eval-constraint-0)))
+    :flag term)
+  (defthm beta-reduce-full-rec-list-correct
+    (implies (pseudo-term-listp x)
+             (equal (beta-eval-list (beta-reduce-full-rec-list x alist) a)
+                    (beta-eval-list x (beta-eval-alist alist a))))
+    :flag list))
+
+
+(mutual-recursion
+ (defun beta-reduce-full (x)
+   (declare (xargs :guard (pseudo-termp x)))
+   (b* (((when (or (variablep x)
+                   (fquotep x))) x)
+        (args (beta-reduce-full-list (fargs x)))
+        (fn (ffn-symb x))
+        ((when (atom fn)) (cons fn args))
+        (formals (lambda-formals fn))
+        (body (lambda-body fn)))
+     (beta-reduce-full-rec body (pairlis$ formals args))))
+ (defun beta-reduce-full-list (x)
+   (declare (xargs :guard (pseudo-term-listp x)))
+   (if (endp x)
+       nil
+     (cons (beta-reduce-full (car x))
+           (beta-reduce-full-list (cdr x))))))
+
+(defthm len-of-beta-reduce-full-list
+  (equal (len (beta-reduce-full-list x))
+         (len x)))
+
+(defthm true-listp-of-beta-reduce-full-list
+  (true-listp (beta-reduce-full-list x))
+  :hints (("goal" :induct (len x))))
+
+
+(defthm-beta-reduce-flg
+  (defthm pseudo-termp-of-beta-reduce-full
+    (implies (pseudo-termp x)
+             (pseudo-termp (beta-reduce-full x)))
+    :flag term)
+  (defthm pseudo-term-listp-of-beta-reduce-full-list
+    (implies (pseudo-term-listp x)
+             (pseudo-term-listp (beta-reduce-full-list x)))
+    :flag list))
+
+(defthm-beta-reduce-flg
+  (defthm beta-reduce-full-correct
+    (implies (pseudo-termp x)
+             (equal (beta-eval (beta-reduce-full x) a)
+                    (beta-eval x a)))
+    :hints ('(:in-theory (enable beta-eval-constraint-0)))
+    :flag term)
+  (defthm beta-reduce-full-list-correct
+    (implies (pseudo-term-listp x)
+             (equal (beta-eval-list (beta-reduce-full-list x) a)
+                    (beta-eval-list x a)))
+    :flag list))
+
+
diff -Nru acl2-6.2/books/centaur/misc/context-rw.lisp acl2-6.3/books/centaur/misc/context-rw.lisp
--- acl2-6.2/books/centaur/misc/context-rw.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/context-rw.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -34,6 +34,7 @@
                            all-keys-bound)))
 
 (defxdoc contextual-rewriting
+  :parents (proof-automation)
   :short "A meta-rule system that lets the ACL2 rewriter pass around contextual
 information.  Similar to Dave Greve's NARY.  This extends ACL2's notion of
 congruence-based rewriting."
diff -Nru acl2-6.2/books/centaur/misc/defapply.lisp acl2-6.3/books/centaur/misc/defapply.lisp
--- acl2-6.2/books/centaur/misc/defapply.lisp	2013-06-07 03:12:14.000000000 +0000
+++ acl2-6.3/books/centaur/misc/defapply.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -337,7 +337,8 @@
 
 (defun reduce-identities (term fn)
   (case-match term
-    ((!fn . &) term)
+    ((!fn) term)
+    ((!fn ('nth . &) . &) term)
     (('mv-list & sub . &) (reduce-identities sub fn))
     (('return-last & & sub) (reduce-identities sub fn))
     (& term)))
@@ -718,7 +719,8 @@
         :off :all :on (error)
         (make-event
          `(defevaluator-fast _name_-ev _name_-ev-lst
-            ,(mk-defeval-entries '_fnsyms_ (w state)))))
+            ,(mk-defeval-entries '_fnsyms_ (w state))
+            :namedp t)))
        (def-ruleset _name_-ev-rules
          (set-difference-theories
           (current-theory :here)
@@ -841,7 +843,7 @@
                                    car-to-nth-meta-correct
                                    ;; _name_-ev-rules
                                    kwote nfix
-                                   _name_-ev-constraint-0
+                                   _name_-ev-of-fncall-args
                                    (cons) (equal) (member-equal) (eql)
                                    car-cons cdr-cons _name_-eval-nth-kwote-lst
                                    list-fix-when-true-listp
diff -Nru acl2-6.2/books/centaur/misc/equal-by-nths.lisp acl2-6.3/books/centaur/misc/equal-by-nths.lisp
--- acl2-6.2/books/centaur/misc/equal-by-nths.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/equal-by-nths.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -20,87 +20,6 @@
 
 (in-package "ACL2")
 
-(include-book "tools/bstar" :dir :system)
-
-(encapsulate
- (((equal-by-nths-hyp) => *)
-  ((equal-by-nths-lhs) => *)
-  ((equal-by-nths-rhs) => *))
- (local (defun equal-by-nths-hyp () nil))
- (local (defun equal-by-nths-lhs () nil))
- (local (defun equal-by-nths-rhs () nil))
- (defthmd equal-by-nths-constraint
-   (implies (and (equal-by-nths-hyp)
-                 (natp n)
-                 (< n (len (equal-by-nths-lhs))))
-            (equal (nth n (equal-by-nths-lhs))
-                   (nth n (equal-by-nths-rhs))))))
-
-
-(local (defun nth-badguy (x y)
-         (cond ((or (not (consp x))
-                    (not (consp y)))
-                0)
-               ((equal (car x) (car y))
-                (+ 1 (nth-badguy (cdr x) (cdr y))))
-               (t
-                0))))
-
-(local (defthm nth-badguy-bounded
-         (<= (nth-badguy x y) (len x))
-         :rule-classes :linear))
-
-(local (defthm nth-badguy-is-bad
-         (implies (and (equal (len x) (len y))
-                       (not (equal (nth-badguy x y) (len x))))
-                  (not (equal (nth (nth-badguy x y) x)
-                              (nth (nth-badguy x y) y))))))
-
-(local (defthm nth-badguy-is-equality
-         (implies (and (equal (len x) (len y))
-                       (true-listp x)
-                       (true-listp y))
-                  (equal (equal (nth-badguy x y) (len x))
-                         (equal x y)))))
-
-(local (in-theory (disable nth-badguy-is-equality
-                           nth-badguy-is-bad
-                           nth-badguy)))
-
-(defthm equal-by-nths
-  (implies (and (equal-by-nths-hyp)
-                (true-listp (equal-by-nths-lhs))
-                (true-listp (equal-by-nths-rhs)))
-           (equal (equal (equal-by-nths-lhs) (equal-by-nths-rhs))
-                  (equal (len (equal-by-nths-lhs)) (len (equal-by-nths-rhs)))))
-  :hints(("Goal"
-          :use ((:instance nth-badguy-is-equality
-                           (x (equal-by-nths-lhs))
-                           (y (equal-by-nths-rhs)))
-                (:instance nth-badguy-is-bad
-                           (x (equal-by-nths-lhs))
-                           (y (equal-by-nths-rhs)))
-                (:instance equal-by-nths-constraint
-                           (n (nth-badguy (equal-by-nths-lhs) (equal-by-nths-rhs))))))))
-
-
-;; Computed hint.  For now we'll assume that we're trying to prove an equality
-;; which is the conclusion of the goal, and that the rest of the goal is hyps
-;; that we might need.
-(defun equal-by-nths-hint-fn (clause)
-  (declare (xargs :mode :program))
-  (b* ((lit (car (last clause)))
-       ((unless (and (consp lit)
-                     (eq (car lit) 'equal)))
-        nil)
-       (hyps (dumb-negate-lit-lst (butlast clause 1)))
-       ((list x y) (cdr lit)))
-    `(:use ((:functional-instance
-             equal-by-nths
-             (equal-by-nths-lhs (lambda () ,x))
-             (equal-by-nths-rhs (lambda () ,y))
-             (equal-by-nths-hyp (lambda () (and . ,hyps))))))))
-
-(defmacro equal-by-nths-hint ()
-  '(equal-by-nths-hint-fn clause))
+; cert_param: (reloc_stub)
+(include-book "std/lists/nth" :dir :system)
 
diff -Nru acl2-6.2/books/centaur/misc/equal-sets.acl2 acl2-6.3/books/centaur/misc/equal-sets.acl2
--- acl2-6.2/books/centaur/misc/equal-sets.acl2	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/equal-sets.acl2	2013-09-30 17:53:11.000000000 +0000
@@ -19,6 +19,6 @@
 ; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
-(ld "finite-set-theory/osets/sets.defpkg" :dir :system)
+(include-book "std/osets/portcullis" :dir :system)
 ; cert-flags: ? t :ttags :all
-(certify-book "equal-sets" ? t :ttags :all)
+
diff -Nru acl2-6.2/books/centaur/misc/equal-sets.lisp acl2-6.3/books/centaur/misc/equal-sets.lisp
--- acl2-6.2/books/centaur/misc/equal-sets.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/equal-sets.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -21,7 +21,7 @@
 (in-package "ACL2")
 
 ;; BOZO we could consider removing osets now...
-(include-book "finite-set-theory/osets/sets" :dir :system)
+(include-book "std/osets/top" :dir :system)
 (include-book "std/lists/sets" :dir :system)
 (include-book "witness-cp")
 
diff -Nru acl2-6.2/books/centaur/misc/fast-alists.lisp acl2-6.3/books/centaur/misc/fast-alists.lisp
--- acl2-6.2/books/centaur/misc/fast-alists.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/fast-alists.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -106,7 +106,7 @@
 (defthm alist-keys-hons-put-list
   (set-equiv (alist-keys (hons-put-list vars vals rest))
              (union-equal vars (alist-keys rest)))
-  :hints (("goal" :in-theory (enable alist-keys))
+  :hints (("goal" :in-theory (enable alist-keys append))
           (set-reasoning)))
 
 
diff -Nru acl2-6.2/books/centaur/misc/hons-alphorder-merge.lisp acl2-6.3/books/centaur/misc/hons-alphorder-merge.lisp
--- acl2-6.2/books/centaur/misc/hons-alphorder-merge.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/hons-alphorder-merge.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -22,6 +22,7 @@
 (in-package "ACL2")
 (include-book "misc/total-order" :dir :system)
 (include-book "equal-sets")
+(local (include-book "std/typed-lists/atom-listp" :dir :system))
 
 
 ; Abuse of atom-listp on ordered sets
@@ -37,8 +38,9 @@
   :hints(("Goal" :in-theory (enable* (:ruleset sets::primitive-rules)))))
 
 (defthm atom-listp-of-sfix
-  (implies (atom-listp x)
-           (atom-listp (sets::sfix x)))
+  (implies (atom-listp (double-rewrite x))
+           (equal (atom-listp (sets::sfix x))
+                  t))
   :hints(("Goal" :in-theory (enable* (:ruleset sets::primitive-rules)))))
 
 (defthm atom-listp-of-insert
@@ -48,9 +50,9 @@
   :hints(("Goal" :in-theory (enable* (:ruleset sets::primitive-rules) sets::insert))))
 
 (defthm atom-listp-of-union
-  (implies (and (atom-listp x)
-                (atom-listp y))
-           (atom-listp (sets::union x y))))
+  (equal (atom-listp (sets::union x y))
+         (and (atom-listp (sets::sfix x))
+              (atom-listp (sets::sfix y)))))
 
 
 
diff -Nru acl2-6.2/books/centaur/misc/intern-debugging-raw.lsp acl2-6.3/books/centaur/misc/intern-debugging-raw.lsp
--- acl2-6.2/books/centaur/misc/intern-debugging-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/misc/intern-debugging-raw.lsp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,75 @@
+; Intern Debugging
+; Copyright (C) 2010 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+#+Clozure
+(progn
+
+; Accessors for symbol hash tables.
+; Per nfasload.lisp, symbol hash tables are (htvec . (htcount . hlimit))
+
+  (defmacro ccl-htvec (tbl)
+    `(the simple-vector (car ,tbl)))
+
+  (defmacro ccl-htcount (tbl)
+    `(the fixnum (cadr ,tbl)))
+
+  (defmacro ccl-htlimit (tbl)
+    `(the fixnum (cddr ,tbl)))
+
+; Basic way to inspect packages, which we make available to the logic.
+
+  (defun inspect-package (name)
+    (let* ((pkg (or (find-package name)
+                    (er hard? 'inspect-package "package ~x0 not found." name)))
+           (tab (ccl::pkg.itab pkg)))
+      (format t "; - Current count: ~:D~%" (ccl-htcount tab))
+      (format t "; - Current limit: ~:D~%" (ccl-htlimit tab))
+      nil))
+
+  (setq ccl::*warn-if-redefine-kernel* nil)
+
+  (defun intern (str &optional (package *package*))
+    ;; (format t "Debugging intern is being called.~%")
+    (let* ((pkg (ccl::pkg-arg package))
+           (tab (ccl::pkg.itab pkg)))
+      (when (and (= (ccl-htcount tab)
+                    (the fixnum (1- (ccl-htlimit tab))))
+                 ;; Don't bother reporting on very small packages resizing.
+                 ;; This helps avoid package-size messages when including
+                 ;; books, for instance.
+                 (< 10000 (ccl-htcount tab)))
+        (let ((name (package-name pkg)))
+          (format t "~%; Note: we may be about to resize the ~a package.~%" name)
+          (format t "; Before interning ~a:~%" str)
+          (inspect-package name)
+          (let ((ret (time (ccl::%intern str pkg))))
+            (format t "; After interning ~a:~%" str)
+            (inspect-package name))
+          (format t "~%")
+          ret))
+      (ccl::%intern str pkg)))
+
+  (defun ccl::%pkg-ref-intern (str ref)
+    ;; It seems necessary to also redefine this to get compiled functions with
+    ;; interns in them to call our new intern.
+    (intern str (or (ccl::package-ref.pkg ref)
+                    (ccl::%kernel-restart ccl::$xnopkg (ccl::package-ref.name ref)))))
+
+  (setq ccl::*warn-if-redefine-kernel* t))
diff -Nru acl2-6.2/books/centaur/misc/intern-debugging.lisp acl2-6.3/books/centaur/misc/intern-debugging.lisp
--- acl2-6.2/books/centaur/misc/intern-debugging.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/misc/intern-debugging.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,161 @@
+; Intern Debugging
+; Copyright (C) 2010 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "tools/include-raw" :dir :system)
+; (depends-on "intern-debugging-raw.lsp")
+
+
+(defxdoc intern-debugging
+  :parents (intern-in-package-of-symbol intern$)
+  :short "A debugger that can warn you about slow @('intern')ing. (CCL only)"
+
+  :long "<p>Jared once spent many hours trying to figure out why some
+computation was slow, only to discover that he was getting bitten by repeatedly
+growing a package by small amounts.  This performance problem is hard to debug
+because it is hard to reproduce (once the package has been grown, the same
+computation you are debugging suddenly runs much faster), and also because it
+is unusual: you would generally expect @('intern') to be a constant-time, cheap
+operation.</p>
+
+<p>The book @('centaur/misc/intern-debugging') is a debugger that can notice
+and report on slow calls of @('intern') due to package growth.  It only works
+on CCL.</p>
+
+<p>The book redefines the primitive Common Lisp function @('intern') so that
+some debugging messages are printed when the package is resized.  Obviously
+this requires a ttag.  Redefining core Common Lisp functions like @('intern')
+is slightly insane, and we might run into trouble if CCL is changed.  But this
+is a really valuable debugging message to have, so it seems worthwhile.</p>
+
+<p>Note that the debugger slows down interning by some small amount (on the
+order of 1.5 to 5%).</p>
+
+<p>If you find out that slow interning is the cause of your problems, consider
+tweaking the @('ACL2_SIZE') parameter you use when you build ACL2 (which can
+help for symbols interned in the ACL2 package only).</p>")
+
+
+(defsection inspect-package
+  :parents (intern-debugging)
+  :short "Print some basic information about a package. (CCL only)"
+  :long "<p>@(call ccl-inspect-package) is given the name of a package, e.g.,
+@('\"ACL2\"') or @('\"VL\"').  It prints out some low-level information about
+the current number of symbols that are in the package and how many will fit
+before it needs to be resized.  This is occasionally useful for figuring out
+whether your packages are large enough, but usually the passive @(see
+intern-debugging) monitoring is more useful.</p>"
+
+  (defun inspect-package (name)
+    (declare (xargs :guard (stringp name))
+             (ignorable name))
+    (cw "inspect-package not yet redefined.~%")))
+
+(defttag intern-debugging)
+
+(include-raw "intern-debugging-raw.lsp")
+
+
+
+#|
+; These tests were with ACL2_SIZE = 3,000,000.
+
+(include-book
+ "intern-debugging")
+
+(include-book
+ "str/top" :dir :system)
+
+
+
+; Performance test.  The extra expensive of debugging should be most severe
+; when we're interning an already-interned symbol (and hence don't need to
+; actually insert anything into the hash table).
+
+(time (loop for i from 1 to 10000000 do   ;; test 1: repeated symbols
+            (intern "FOO" "ACL2")))
+
+(defconst *strs*
+  (loop for i from 1 to 1000000 collect (str::cat "foo_" (str::natstr i))))
+
+(time (loop for str in *strs* do (intern str "ACL2"))) ;; test 2: fresh symbols
+
+
+; TEST1: about 5% slowdown
+;   - Without intern-debugging:  3.140 seconds
+;   - With intern-debugging:     3.303 seconds
+;
+; TEST2: about 1.5% slowdown
+;   - Without intern-debugging, .879 seconds
+;   - With intern-debugging: .893 seconds
+
+
+; Functionality test.  Okay, so does it work?  I set ACL2_SIZE to 3 million,
+; but actually its size seems to be around 2.65 million.  Since the following
+; loop requires the interning of 3 million new symbols, it will need at least a
+; resize.
+
+(defconst *strs*
+  (loop for i from 1 to 3000000 collect (str::cat "foo_" (str::natstr i))))
+
+(time (loop for str in *strs* do (intern str "ACL2")))
+
+
+; Without intern-debugging, in a fresh session, this loop takes 64 seconds (246
+; MB) and doesn't give you any idea that the reason this is taking so long is
+; that the package is being resized.
+
+; With intern-debugging, in a fresh session, the loop again takes 64 seconds
+; and 246 MB, so the performance hasn't really changed, but it prints several
+; useful messages that warn you the package is being resized.  You can see that
+; there are two resizes which collectively cost 17 seconds of execution time.
+
+; Note: we may be about to resize the ACL2 package.
+; Before interning foo_2611853:
+; - Current count: 2,625,000
+; - Current limit: 2,625,001
+(CCL::%INTERN STR
+              PKG) took 10,066,616 microseconds (10.066616 seconds) to run 
+                    with 8 available CPU cores.
+During that period, 10,036,474 microseconds (10.036474 seconds) were spent in user mode
+                    26,996 microseconds (0.026996 seconds) were spent in system mode
+ 26,249,968 bytes of memory allocated.
+ 12,878 minor page faults, 0 major page faults, 0 swaps.
+; After interning foo_2611853:
+; - Current count: 2,624,987
+; - Current limit: 2,871,083
+
+
+; Note: we may be about to resize the ACL2 package.
+; Before interning foo_2857949:
+; - Current count: 2,871,082
+; - Current limit: 2,871,083
+(CCL::%INTERN STR
+              PKG) took 7,238,270 microseconds (7.238270 seconds) to run 
+                    with 8 available CPU cores.
+During that period, 7,223,902 microseconds (7.223902 seconds) were spent in user mode
+                    13,998 microseconds (0.013998 seconds) were spent in system mode
+ 28,710,928 bytes of memory allocated.
+ 14,019 minor page faults, 0 major page faults, 0 swaps.
+; After interning foo_2857949:
+; - Current count: 2,871,083
+; - Current limit: 3,140,250
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/misc/introduce-var.lisp acl2-6.3/books/centaur/misc/introduce-var.lisp
--- acl2-6.2/books/centaur/misc/introduce-var.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/introduce-var.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -25,7 +25,7 @@
 (in-package "ACL2")
 (include-book "clause-processors/generalize" :dir :system)
 (include-book "centaur/vl/util/namedb" :dir :system)
-
+(include-book "beta-reduce-full")
 
 ; We introduce the INTRODUCE-VARS clause processor.  To use this clause
 ; processor you should just do this:
@@ -74,12 +74,88 @@
 ; And will replace it with something like IDX, IDX_1, etc., as appropriate to
 ; avoid name clashes.
 
+
+
+(local
+ (defthm beta-reduce-full-correct-for-gen-eval
+   (implies (pseudo-termp x)
+            (equal (gen-eval (beta-reduce-full x) a)
+                   (gen-eval x a)))
+   :hints (("goal" :use ((:functional-instance
+                          beta-reduce-full-correct
+                          (beta-eval gen-eval)
+                          (beta-eval-list gen-eval-lst)))
+            :in-theory (enable gen-eval-constraint-0)))))
+
+(local
+ (defthm beta-reduce-full-list-correct-for-gen-eval
+   (implies (pseudo-term-listp x)
+            (equal (gen-eval-lst (beta-reduce-full-list x) a)
+                   (gen-eval-lst x a)))
+   :hints (("goal" :use ((:functional-instance
+                          beta-reduce-full-list-correct
+                          (beta-eval gen-eval)
+                          (beta-eval-list gen-eval-lst)))
+            :in-theory (enable gen-eval-constraint-0)))))
+
+
+
 (defund introduce-var (name term)
   (declare (xargs :guard t)
            (ignore name))
   term)
 
 
+;; Note: We've seen problems where sometimes two apparently-identical terms get
+;; generalized to two different variables because they differ in something like
+;; the order of lambda formals, e.g. one is
+;; (hide ((lambda (a b) (list a b)) aa bb))
+;; and the other is
+;; (hide ((lambda (b a) (list a b)) bb aa)).
+;; So we normalize these (and also differences in bound variable names)
+;; by fully beta-reducing introduce-var terms.
+(mutual-recursion
+ (defun beta-reduce-introduce-vars (x)
+   (declare (xargs :guard (pseudo-termp x)))
+   (b* (((when (or (variablep x) (fquotep x))) x)
+        (fn (ffn-symb x))
+        ((when (eq fn 'introduce-var))
+         (beta-reduce-full x)))
+     (cons fn (beta-reduce-introduce-vars-list (fargs x)))))
+ (defun beta-reduce-introduce-vars-list (x)
+   (declare (xargs :guard (pseudo-term-listp x)))
+   (if (atom x)
+       nil
+     (cons (beta-reduce-introduce-vars (car x))
+           (beta-reduce-introduce-vars-list (cdr x))))))
+
+(defthm len-of-beta-reduce-introduce-vars-list
+  (equal (len (beta-reduce-introduce-vars-list x))
+         (len x)))
+
+(defthm-beta-reduce-flg
+  (defthm beta-reduce-introduce-vars-correct
+    (implies (pseudo-termp x)
+             (equal (gen-eval (beta-reduce-introduce-vars x) a)
+                    (gen-eval x a)))
+    :hints ('(:in-theory (enable gen-eval-constraint-0)))
+    :flag term)
+  (defthm beta-reduce-introduce-vars-list-correct
+    (implies (pseudo-term-listp x)
+             (equal (gen-eval-lst (beta-reduce-introduce-vars-list x) a)
+                    (gen-eval-lst x a)))
+    :flag list))
+
+(defthm-beta-reduce-flg
+  (defthm pseudo-termp-beta-reduce-introduce-vars
+    (implies (pseudo-termp x)
+             (pseudo-termp (beta-reduce-introduce-vars x)))
+    :flag term)
+  (defthm pseudo-term-listp-beta-reduce-introduce-vars-list
+    (implies (pseudo-term-listp x)
+             (pseudo-term-listp (beta-reduce-introduce-vars-list x)))
+    :flag list))
+
 (mutual-recursion
 
 ; These scanning functions look for occurrences of (INTRODUCE-VAR 'VAR TERM)
@@ -202,12 +278,52 @@
     (vl::vl-free-namedb namedb)
     fresh-alist))
 
+(defun introduce-vars-cp (clause pkg)
+  (declare (xargs :guard (pseudo-term-listp clause)))
+  (let* ((clause (beta-reduce-introduce-vars-list clause))
+         (al (mbe :logic (scan-for-introduce-var pkg clause)
+                  :exec (if (and (stringp pkg)
+                                 (not (equal pkg "")))
+                            (scan-for-introduce-var pkg clause)
+                          (ec-call (scan-for-introduce-var pkg clause))))))
+    (ec-call (simple-generalize-cp clause al))))
+
+(defthm eval-disjoin-of-beta-reduce-introduce-vars-list
+  (implies (pseudo-term-listp clause)
+           (iff (gen-eval (disjoin (beta-reduce-introduce-vars-list clause)) a)
+                (gen-eval (disjoin clause) a)))
+  :hints (("goal" :induct (len clause)
+           :in-theory (enable gen-eval-disjoin-when-consp))))
+
+(defthm introduce-vars-cp-correct
+  (implies (and (pseudo-term-listp clause)
+                (alistp a)
+                (gen-eval (conjoin-clauses (introduce-vars-cp clause pkg))
+                          (alist-for-simple-generalize-cp
+                           (beta-reduce-introduce-vars-list clause)
+                           (scan-for-introduce-var
+                            pkg (beta-reduce-introduce-vars-list clause))
+                           a)))
+           (gen-eval (disjoin clause) a))
+  :hints (("goal" :use ((:instance simple-generalize-cp-correct
+                         (clause (beta-reduce-introduce-vars-list clause))
+                         (env a)
+                         (alist (scan-for-introduce-var
+                                 pkg (beta-reduce-introduce-vars-list clause)))))
+           :in-theory (disable simple-generalize-cp
+                               alist-for-simple-generalize-cp)))
+  :rule-classes :clause-processor)
+
 (defmacro introduce-vars ()
-  '(let ((al (scan-for-introduce-var (current-package state) clause)))
-     (and al
+  '(let* ((pkg (current-package state))
+          (al (scan-for-introduce-var pkg clause)))
+     (and al ;; this just tells us whether we have any before we go ahead and
+          ;; run the clause-processor
           `(:computed-hint-replacement
             t
-            :clause-processor (simple-generalize-cp clause ',al)))))
+            :clause-processor (introduce-vars-cp clause ',pkg)))))
+  
+
 
 #||
 
diff -Nru acl2-6.2/books/centaur/misc/iter.lisp acl2-6.3/books/centaur/misc/iter.lisp
--- acl2-6.2/books/centaur/misc/iter.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/iter.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -408,6 +408,7 @@
                           ;; are the same
      :guard-hints ...     ;; for defining the step function
      :package foo)        ;; package witness symbol, default is function-name
+~ev[]
 ~/~/
 "
   ;; args contains:
@@ -687,6 +688,7 @@
      :length  (bar x y)     ;; final index
      :index idx-var       ;; counter variable, default N
     ... defiteration args ...)
+~ev[]
 ~/~/
 "
   ;; args contains:
diff -Nru acl2-6.2/books/centaur/misc/load-stobj.lisp acl2-6.3/books/centaur/misc/load-stobj.lisp
--- acl2-6.2/books/centaur/misc/load-stobj.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/load-stobj.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -25,7 +25,7 @@
 (local (include-book "data-structures/list-defthms" :dir :system))
 ;;(local (include-book "unicode/take" :dir :system))
 ;;(local (include-book "unicode/nthcdr" :dir :system))
-(local (include-book "equal-by-nths"))
+(local (include-book "std/lists/nth" :dir :system))
 (local (include-book "tools/do-not" :dir :system))
 (local (do-not generalize fertilize))
 
@@ -108,10 +108,11 @@
                   nil))
          :hints(("Goal" :in-theory (enable xfirstn)))))
 
-(local (defthm nth-of-list-fix
-         (equal (nth n (list-fix a))
-                (nth n a))
-         :hints(("Goal" :in-theory (enable nth list-fix)))))
+;; part of std/lists now
+;; (local (defthm nth-of-list-fix
+;;          (equal (nth n (list-fix a))
+;;                 (nth n a))
+;;          :hints(("Goal" :in-theory (enable nth list-fix)))))
 
 
 
diff -Nru acl2-6.2/books/centaur/misc/memory-mgmt-raw.lisp acl2-6.3/books/centaur/misc/memory-mgmt-raw.lisp
--- acl2-6.2/books/centaur/misc/memory-mgmt-raw.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/memory-mgmt-raw.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-(in-package "ACL2")
-
-;; cert_param: (reloc_stub)
-
-(include-book "memory-mgmt")
diff -Nru acl2-6.2/books/centaur/misc/nat-list-duplicates.lisp acl2-6.3/books/centaur/misc/nat-list-duplicates.lisp
--- acl2-6.2/books/centaur/misc/nat-list-duplicates.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/nat-list-duplicates.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -28,6 +28,7 @@
 (include-book "arithmetic/nat-listp" :dir :system)
 (local (include-book "arithmetic/top-with-meta" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
+(local (include-book "std/lists/resize-list" :dir :system))
 
 
 (defsection nat-list-remove-duplicates
@@ -114,16 +115,7 @@
 
    (defthm acl2-numberp-when-integerp
      (implies (integerp x)
-              (acl2-numberp x)))
-
-   (defthm len-zero
-     (equal (equal 0 (len x))
-            (atom x)))
-
-   (defthm len-of-resize-list
-     (equal (len (resize-list lst n default-value))
-            (nfix n)))))
-
+              (acl2-numberp x)))))
 
 (local (in-theory (enable nat-listp)))
 
@@ -349,21 +341,6 @@
      (equal (nat-remove-dups-arr-length (create-nat-remove-dups-stobj))
             0))
 
-   (local (defun my-induct (key n lst)
-            (if (zp n)
-                (list key n lst)
-              (my-induct (- key 1) (- n 1) (if (atom lst) lst (cdr lst))))))
-
-   (local (defthm nth-of-resize-list
-            (implies (and (natp key)
-                          (natp n)
-                          (< key n))
-                     (equal (nth key (resize-list lst n default-value))
-                            (if (< key (len lst))
-                                (nth key lst)
-                              default-value)))
-            :hints(("Goal" :induct (my-induct key n lst)))))
-
    (defthm nat-remove-dups-arri-of-resize-nat-remove-dups-arr
      (implies (and (force (natp key))
                    (force (natp max))
diff -Nru acl2-6.2/books/centaur/misc/nth-equiv.lisp acl2-6.3/books/centaur/misc/nth-equiv.lisp
--- acl2-6.2/books/centaur/misc/nth-equiv.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/nth-equiv.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -37,3 +37,50 @@
   (nth-equiv (update-nth n (nth n x) x)
              x)
   :hints(("Goal" :in-theory (enable nth-equiv))))
+
+(local (defthm +-cancel-consts
+         (implies (syntaxp (and (quotep x) (quotep y)))
+                  (equal (+ x y z) (+ (+ x y) z)))))
+
+(defcong nth-equiv equal (car x) 1
+  :hints (("goal" :use ((:instance nth-equiv-necc
+                         (n 0) (y x-equiv)))
+           :in-theory (e/d (nth) (nth-equiv-implies-equal-nth-2)))))
+
+(defcong nth-equiv nth-equiv (cdr x) 1
+  :hints (("goal" :use ((:instance nth-equiv-necc
+                         (n (+ 1 (nfix (nth-equiv-witness (cdr x) (cdr
+                                                                   x-equiv)))))
+                         (y x-equiv)))
+           :expand ((nth-equiv (cdr x) (cdr x-equiv))
+                    (nth-equiv (cdr x) nil)
+                    (nth-equiv nil (cdr x-equiv)))
+           :in-theory (disable nth-equiv-implies-equal-nth-2))))
+
+(defthmd nth-equiv-recursive
+  (equal (nth-equiv x y)
+         (or (and (atom x) (atom y))
+             (and (equal (car x) (car y))
+                  (nth-equiv (cdr x) (cdr y)))))
+  :hints ((and stable-under-simplificationp
+               '(:cases ((nth-equiv x y))))
+          (and stable-under-simplificationp
+               (cond ((equal (car clause) '(nth-equiv x y))
+                      '(:expand ((nth-equiv x y)
+                                 (:free (n) (nth n x))
+                                 (:free (n) (nth n y))))))))
+  :rule-classes ((:definition :install-body nil
+                  :clique (nth-equiv)
+                  :controller-alist ((nth-equiv t t)))))
+
+(defun cdr2-ind (x y)
+  (declare (xargs :measure (+ (acl2-count x) (acl2-count y))))
+  (if (and (atom x) (atom y))
+      nil
+    (cdr2-ind (cdr x) (cdr y))))
+
+(defthmd nth-equiv-ind
+  t
+  :rule-classes ((:induction
+                  :pattern (nth-equiv x y)
+                  :scheme (cdr2-ind x y))))
diff -Nru acl2-6.2/books/centaur/misc/osets-witnessing.acl2 acl2-6.3/books/centaur/misc/osets-witnessing.acl2
--- acl2-6.2/books/centaur/misc/osets-witnessing.acl2	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/osets-witnessing.acl2	2013-09-30 17:53:11.000000000 +0000
@@ -1,5 +1,5 @@
 (in-package "ACL2")
-(include-book "finite-set-theory/osets/portcullis" :dir :system)
+(include-book "std/osets/portcullis" :dir :system)
 ; cert-flags: ? t :ttags :all
 (certify-book "osets-witnessing" ? t :ttags :all)
 
diff -Nru acl2-6.2/books/centaur/misc/osets-witnessing.lisp acl2-6.3/books/centaur/misc/osets-witnessing.lisp
--- acl2-6.2/books/centaur/misc/osets-witnessing.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/osets-witnessing.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -153,7 +153,7 @@
 ;; prove.
 
 
-(include-book "finite-set-theory/osets/sets" :dir :system)
+(include-book "std/osets/top" :dir :system)
 (include-book "witness-cp")
 (include-book "tools/rulesets" :dir :system)
 
diff -Nru acl2-6.2/books/centaur/misc/resize-list.lisp acl2-6.3/books/centaur/misc/resize-list.lisp
--- acl2-6.2/books/centaur/misc/resize-list.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/resize-list.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -20,30 +20,5 @@
 
 (in-package "ACL2")
 
-; Basic lemmas about resize-list.
-
-(local (defun my-induct (n m lst)
-         (if (zp n)
-             (list lst)
-           (if (zp m)
-               nil
-             (my-induct (- n 1) (- m 1)
-                        (if (atom lst)
-                            lst
-                          (cdr lst)))))))
-
-(defthm nth-of-resize-list
-  (equal (nth n (resize-list lst m default-value))
-         (let ((n (nfix n))
-               (m (nfix m)))
-           (and (< n m)
-                (if (< n (len lst))
-                    (nth n lst)
-                  default-value))))
-  :hints(("Goal"
-          :expand (resize-list lst m default-value)
-          :induct (my-induct n m lst))))
-
-(defthm len-of-resize-list
-  (equal (len (resize-list lst m default))
-         (nfix m)))
+; cert_param: (reloc_stub)
+(include-book "std/lists/resize-list" :dir :system)
diff -Nru acl2-6.2/books/centaur/misc/rewrite-rule.lisp acl2-6.3/books/centaur/misc/rewrite-rule.lisp
--- acl2-6.2/books/centaur/misc/rewrite-rule.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/misc/rewrite-rule.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,133 @@
+; Dumb Rewriter
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>
+;                   Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+(include-book "cutil/define" :dir :system)
+
+;; Accessors for rewrite rules, since otherwise the proof obligations become
+;; giant cadaddrpillars.
+
+(define rewrite-rule->rune ((rule weak-rewrite-rule-p))
+  :inline t
+  (access rewrite-rule rule :rune))
+
+(define rewrite-rule->hyps ((rule weak-rewrite-rule-p))
+  :inline t
+  (access rewrite-rule rule :hyps))
+
+(define rewrite-rule->lhs ((rule weak-rewrite-rule-p))
+  :inline t
+  (access rewrite-rule rule :lhs))
+
+(define rewrite-rule->rhs ((rule weak-rewrite-rule-p))
+  :inline t
+  (access rewrite-rule rule :rhs))
+
+(define rewrite-rule->equiv ((rule weak-rewrite-rule-p))
+  :inline t
+  (access rewrite-rule rule :equiv))
+
+(define rewrite-rule->subclass ((rule weak-rewrite-rule-p))
+  :inline t
+  (access rewrite-rule rule :subclass))
+
+(define rewrite-rule->heuristic-info ((rule weak-rewrite-rule-p))
+  :inline t
+  (access rewrite-rule rule :heuristic-info))
+
+
+(define drw-get-rules ((fn symbolp)
+                       (world plist-worldp))
+  :returns rules
+  (fgetprop fn 'lemmas nil world))
+
+
+(defmacro make-rewrite-rule (&key rune nume hyps equiv lhs rhs subclass
+                                  heuristic-info backchain-limit-lst
+                                  var-info match-free)
+  `(make-rewrite-rule-fn ,rune ,nume ,hyps ,equiv ,lhs ,rhs ,subclass
+                         ,heuristic-info ,backchain-limit-lst
+                         ,var-info ,match-free))
+
+(define make-rewrite-rule-fn (rune nume hyps equiv lhs rhs subclass
+                                   heuristic-info backchain-limit-lst
+                                   var-info match-free)
+  :inline t
+  (make rewrite-rule :rune rune :nume nume :hyps hyps :equiv equiv :lhs lhs
+        :rhs rhs :subclass subclass :heuristic-info heuristic-info
+        :backchain-limit-lst backchain-limit-lst :var-info var-info :match-free
+        match-free)
+  ///
+  (defthm weak-rewrite-rule-p-of-make-rewrite-rule-fn
+    (weak-rewrite-rule-p (make-rewrite-rule-fn
+                          rune nume hyps equiv lhs rhs subclass
+                          heuristic-info backchain-limit-lst
+                          var-info match-free)))
+  (defthm rewrite-rule->hyps-of-make-rewrite-rule-fn
+    (equal (rewrite-rule->hyps (make-rewrite-rule-fn
+                                rune nume hyps equiv lhs rhs subclass
+                                heuristic-info backchain-limit-lst
+                                var-info match-free))
+           hyps)
+    :hints(("Goal" :in-theory (enable rewrite-rule->hyps))))
+  (defthm rewrite-rule->lhs-of-make-rewrite-rule-fn
+    (equal (rewrite-rule->lhs (make-rewrite-rule-fn
+                                rune nume hyps equiv lhs rhs subclass
+                                heuristic-info backchain-limit-lst
+                                var-info match-free))
+           lhs)
+    :hints(("Goal" :in-theory (enable rewrite-rule->lhs))))
+  (defthm rewrite-rule->rhs-of-make-rewrite-rule-fn
+    (equal (rewrite-rule->rhs (make-rewrite-rule-fn
+                                rune nume hyps equiv lhs rhs subclass
+                                heuristic-info backchain-limit-lst
+                                var-info match-free))
+           rhs)
+    :hints(("Goal" :in-theory (enable rewrite-rule->rhs))))
+  (defthm rewrite-rule->equiv-of-make-rewrite-rule-fn
+    (equal (rewrite-rule->equiv (make-rewrite-rule-fn
+                                rune nume hyps equiv lhs rhs subclass
+                                heuristic-info backchain-limit-lst
+                                var-info match-free))
+           equiv)
+    :hints(("Goal" :in-theory (enable rewrite-rule->equiv))))
+  (defthm rewrite-rule->subclass-of-make-rewrite-rule-fn
+    (equal (rewrite-rule->subclass (make-rewrite-rule-fn
+                                rune nume hyps equiv lhs rhs subclass
+                                heuristic-info backchain-limit-lst
+                                var-info match-free))
+           subclass)
+    :hints(("Goal" :in-theory (enable rewrite-rule->subclass))))
+  (defthm rewrite-rule->heuristic-info-of-make-rewrite-rule-fn
+    (equal (rewrite-rule->heuristic-info (make-rewrite-rule-fn
+                                rune nume hyps equiv lhs rhs subclass
+                                heuristic-info backchain-limit-lst
+                                var-info match-free))
+           heuristic-info)
+    :hints(("Goal" :in-theory (enable rewrite-rule->heuristic-info))))
+  (defthm rewrite-rule->rune-of-make-rewrite-rule-fn
+    (equal (rewrite-rule->rune (make-rewrite-rule-fn
+                                rune nume hyps equiv lhs rhs subclass
+                                heuristic-info backchain-limit-lst
+                                var-info match-free))
+           rune)
+    :hints(("Goal" :in-theory (enable rewrite-rule->rune)))))
+
diff -Nru acl2-6.2/books/centaur/misc/seed-random.lisp acl2-6.3/books/centaur/misc/seed-random.lisp
--- acl2-6.2/books/centaur/misc/seed-random.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/seed-random.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -26,7 +26,7 @@
   nil)
 
 (defmacro seed-random$ (name &key (freshp 't))
-  ":Doc-Section Programming
+  ":Doc-Section random$
 Influence the random numbers produced by ~ilc[random$]~/
 
 General form:
diff -Nru acl2-6.2/books/centaur/misc/sneaky-load.lisp acl2-6.3/books/centaur/misc/sneaky-load.lisp
--- acl2-6.2/books/centaur/misc/sneaky-load.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/sneaky-load.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -22,7 +22,7 @@
 (in-package "ACL2")
 
 (include-book "tools/bstar" :dir :system)
-
+(include-book "tools/include-raw" :dir :system)
 (defttag sneaky-load)
 
 (remove-untouchable 'read-acl2-oracle t)
@@ -144,67 +144,8 @@
         (mv (cons val rest)
             state)))))
 
-(progn!
- (set-raw-mode t)
-
- (defvar *sneaky-state*
-   (make-hash-table))
-
- ;; (defun sneaky-save (name what)
- ;;   (setf (gethash name *sneaky-load-table*) what)
- ;;   nil)
-
- ;; (defun sneaky-push (name what)
- ;;   (let ((val (gethash name *sneaky-load-table*)))
- ;;     (setf (gethash name *sneaky-load-table*)
- ;;           (cons what val)))
- ;;   nil)
-
- ;; (defun sneaky-incf-fn (name amount)
- ;;   (setf (gethash name *sneaky-load-table*)
- ;;         (+ (fix (gethash name *sneaky-load-table*))
- ;;            amount))
- ;;   nil)
-
- (defun sneaky-load (name state)
-   (unless (live-state-p state)
-     (er hard? 'sneaky-load "sneaky-load should only be used on live states"))
-   (let ((val (gethash name *sneaky-state*)))
-     (mv val state)))
-
- (defun sneaky-alist (state)
-   (unless (live-state-p state)
-     (er hard? 'sneaky-load "sneaky-load should only be used on live states"))
-   (let (al)
-     (maphash (lambda (k v)
-                (push (cons k v) al))
-              *sneaky-state*)
-     (mv al state)))
-
-
- (defun sneaky-mutate (fnname get-keys user-arg)
-   (b* ((st *the-live-state*)
-        (world (w st))
-        (stobjs-in (fgetprop fnname 'stobjs-in :none world))
-        (stobjs-out (fgetprop fnname 'stobjs-out :none world))
-        ((when (not (equal stobjs-in '(nil nil))))
-         (er hard 'sneaky-mutate
-             "FNNAME must be an ACL2 function symbol of 2 non-stobj args; ~x0 is not~%"
-             fnname))
-        ((when (not (equal stobjs-out '(nil))))
-         (er hard 'sneaky-mutate
-             "FNNAME must be an ACL2 function symbol that returns a single value; ~x0 is not~%"
-             fnname))
-        (get-ins (loop for key in get-keys collect
-                       (gethash key *sneaky-state*)))
-        (starfn (*1*-symbol fnname))
-        (result (funcall starfn get-ins user-arg)))
-     (loop while (consp result) do
-           (b* ((head (car result)))
-             (when (consp head)
-               (setf (gethash (car head) *sneaky-state*) (cdr head)))
-             (setq result (cdr result))))
-     nil)))
+; (depends-on "sneaky-raw.lsp")
+(include-raw "sneaky-raw.lsp")
 
 
 
diff -Nru acl2-6.2/books/centaur/misc/sneaky-raw.lsp acl2-6.3/books/centaur/misc/sneaky-raw.lsp
--- acl2-6.2/books/centaur/misc/sneaky-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/misc/sneaky-raw.lsp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,58 @@
+(defvar *sneaky-state*
+  (make-hash-table))
+
+;; (defun sneaky-save (name what)
+;;   (setf (gethash name *sneaky-load-table*) what)
+;;   nil)
+
+;; (defun sneaky-push (name what)
+;;   (let ((val (gethash name *sneaky-load-table*)))
+;;     (setf (gethash name *sneaky-load-table*)
+;;           (cons what val)))
+;;   nil)
+
+;; (defun sneaky-incf-fn (name amount)
+;;   (setf (gethash name *sneaky-load-table*)
+;;         (+ (fix (gethash name *sneaky-load-table*))
+;;            amount))
+;;   nil)
+
+(defun sneaky-load (name state)
+  (unless (live-state-p state)
+    (er hard? 'sneaky-load "sneaky-load should only be used on live states"))
+  (let ((val (gethash name *sneaky-state*)))
+    (mv val state)))
+
+(defun sneaky-alist (state)
+  (unless (live-state-p state)
+    (er hard? 'sneaky-load "sneaky-load should only be used on live states"))
+  (let (al)
+    (maphash (lambda (k v)
+               (push (cons k v) al))
+             *sneaky-state*)
+    (mv al state)))
+
+
+(defun sneaky-mutate (fnname get-keys user-arg)
+  (b* ((st *the-live-state*)
+       (world (w st))
+       (stobjs-in (fgetprop fnname 'stobjs-in :none world))
+       (stobjs-out (fgetprop fnname 'stobjs-out :none world))
+       ((when (not (equal stobjs-in '(nil nil))))
+        (er hard 'sneaky-mutate
+            "FNNAME must be an ACL2 function symbol of 2 non-stobj args; ~x0 is not~%"
+            fnname))
+       ((when (not (equal stobjs-out '(nil))))
+        (er hard 'sneaky-mutate
+            "FNNAME must be an ACL2 function symbol that returns a single value; ~x0 is not~%"
+            fnname))
+       (get-ins (loop for key in get-keys collect
+                      (gethash key *sneaky-state*)))
+       (starfn (*1*-symbol fnname))
+       (result (funcall starfn get-ins user-arg)))
+    (loop while (consp result) do
+          (b* ((head (car result)))
+            (when (consp head)
+              (setf (gethash (car head) *sneaky-state*) (cdr head)))
+            (setq result (cdr result))))
+    nil))
diff -Nru acl2-6.2/books/centaur/misc/sparsemap-impl.lisp acl2-6.3/books/centaur/misc/sparsemap-impl.lisp
--- acl2-6.2/books/centaur/misc/sparsemap-impl.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/sparsemap-impl.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -19,7 +19,7 @@
 ; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "ACL2")
-(include-book "resize-list")
+(include-book "std/lists/resize-list" :dir :system)
 (include-book "count-up")
 (include-book "remove-assoc")
 (include-book "arith-equivs")
diff -Nru acl2-6.2/books/centaur/misc/top.lisp acl2-6.3/books/centaur/misc/top.lisp
--- acl2-6.2/books/centaur/misc/top.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/top.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -29,7 +29,7 @@
 (include-book "ap")
 (include-book "defapply")
 (include-book "dfs-measure")
-(include-book "equal-by-nths")
+(include-book "std/lists/nth" :dir :system)
 (include-book "equal-sets")
 (include-book "evaluator-metatheorems")
 (include-book "fal-graphs")
diff -Nru acl2-6.2/books/centaur/misc/tshell-raw.lsp acl2-6.3/books/centaur/misc/tshell-raw.lsp
--- acl2-6.2/books/centaur/misc/tshell-raw.lsp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/tshell-raw.lsp	2013-09-30 17:53:11.000000000 +0000
@@ -19,12 +19,11 @@
 ; Tshell
 ; Original author: Jared Davis <jared@centtech.com>
 
-
 (in-package "ACL2")
 
 ; NOTE: This file requires that str/strprefixp has been loaded.
 
-(defparameter *tshell-debug*
+(defvar *tshell-debug*
   ;; Change this to T for verbose debugging information.
   nil)
 
@@ -35,31 +34,35 @@
 ; We look for certain strings to know when the program's output ends.  This is
 ; gross, but in practice it should work.
 
-(defparameter *tshell-exit-line*   "HORRIBLE_STRING_TO_DETECT_END_OF_TSHELL_COMMAND")
-(defparameter *tshell-status-line* "HORRIBLE_STRING_TO_DETECT_TSHELL_EXIT_STATUS")
-(defparameter *tshell-pid-line*    "TSHELL_PID")
+(defvar *tshell-exit-line*   "HORRIBLE_STRING_TO_DETECT_END_OF_TSHELL_COMMAND")
+(defvar *tshell-status-line* "HORRIBLE_STRING_TO_DETECT_TSHELL_EXIT_STATUS")
+(defvar *tshell-pid-line*    "TSHELL_PID")
 
 
 ; We actually use two bash processes.  *tshell* runs the programs.
 ; *tshell-killer* is only used to kill programs that *tshell* is running.
 
-(defvar *tshell*)
-(defvar *tshell-killer*)
+; Bug fix 2013-09-17: these were formerly uninitialized defvars, but Matt
+; pointed out that tshell-ensure is assuming they are initialized, so set
+; them to nil.
+
+(defvar *tshell* nil)
+(defvar *tshell-killer* nil)
 
 ; I added another bash process for background jobs.  This seems easier than
 ; running them with *tshell*.
 
-(defvar *tshell-bg*)
+(defvar *tshell-bg* nil)
 
 
 (defun tshell-stop ()
   ;; Stops any tshell processes that are running.
 
-  #-Clozure
+  #-(and Clozure (not mswindows))
   ;; BOZO maybe eventually add support for other Lisps
   nil
 
-  #+Clozure
+  #+(and Clozure (not mswindows))
   (progn (ignore-errors
            (when *tshell*
              (tshell-debug "TSHELL-STOP: stopping *tshell*~%")
@@ -80,11 +83,11 @@
 (defun tshell-start ()
   ;; Stops any tshell processes and starts new ones.
 
-  #-Clozure
+  #-(and Clozure (not mswindows))
   ;; BOZO maybe eventually add support for other Lisps
   nil
 
-  #+Clozure
+  #+(and Clozure (not mswindows))
   (progn (tshell-debug "TSHELL-START: killing old processes~%")
          (tshell-stop)
          (tshell-debug "TSHELL-START: starting *tshell*~%")
@@ -108,9 +111,9 @@
          nil))
 
 (defun tshell-check ()
-  #-Clozure
+  #-(and Clozure (not mswindows))
   t
-  #+Clozure
+  #+(and Clozure (not mswindows))
   (and (ccl::external-process-p *tshell*)
        (ccl::external-process-p *tshell-killer*)
        (ccl::external-process-p *tshell-bg*)
@@ -120,10 +123,10 @@
 
 (defun tshell-ensure ()
   ;; Stops any tshell processes and starts new ones.
-  #-Clozure
+  #-(and Clozure (not mswindows))
   ;; BOZO eventually add support for other Lisps
   nil
-  #+Clozure
+  #+(and Clozure (not mswindows))
   (unless (tshell-check)
     (tshell-debug "TSHELL-START: starting *tshell*~%")
     (setf *tshell* (ccl::run-program "/bin/bash" nil
@@ -164,7 +167,7 @@
     (declare (ignore pos))
     val))
 
-#+Clozure
+#+(and Clozure (not mswindows))
 (defun tshell-kill (pid)
   ;; Use the tshell-killer process to try to kill process PID.
   (tshell-debug "TSHELL-KILL: killing ~a.~%" pid)
@@ -203,46 +206,16 @@
 
 
 
-(defun tshell (cmd &key (print 't) (save 't))
-
-; (TSHELL CMD :PRINT [t/nil] :SAVE [t/nil]) --> (FINISHEDP STATUS LINES)
-;
-; Inputs:
-;
-;    CMD should be an ordinary shell command that takes no input and does not
-;    attempt to do any I/O redirection.  It can have arguments, e.g., you can
-;    write something like "echo hello" here.
-;
-;    :PRINT says whether to print the lines produced by CMD as they are
-;    produced.  The default is T.
-;
-;    :SAVE says whether to buffer the lines produced by CMD and return them as
-;    LINES.  The default is T.  You can set :SAVE NIL if you want to use less
-;    memory and don't care about inspecting the lines programmatically.
-;
-;    Note that :SAVE and :PRINT are independent from one another.  You can
-;    print without saving, save without printing, or do both.
-;
-; Outputs:
-;
-;    FINISHEDP is T if the command completed execution normally, or is NIL if
-;    the command was aborted via interrupting.
-;
-;    STATUS is the exit status code of the command (e.g., typically 0 means
-;    success and some non-0 value means failure).  It is only meaningful if
-;    FINISHEDP is T.
-;
-;    LINES are a list of strings which represent the output of the command,
-;    (both to standard output and standard error.)  Note that LINES will just
-;    be NIL when you set :SAVE NIL.
+(defun tshell-call-fn (cmd print save)
+  ;; See the documentation in tshell.lisp.
 
   (unless (tshell-check)
     (error "Invalid *tshell*, *tshell-killer*, or *tshell-bg* -- did you call (tshell-start)?"))
 
-  #-Clozure
+  #-(and Clozure (not mswindows))
   (error "Oops, TSHELL isn't implemented for this Lisp.")
 
-  #+Clozure
+  #+(and Clozure (not mswindows))
   (let* ((tshell-in     (ccl::external-process-input-stream *tshell*))
          (tshell-out    (ccl::external-process-output-stream *tshell*))
          (tshell-err    (ccl::external-process-error-stream *tshell*))
@@ -359,10 +332,10 @@
   (unless (tshell-check)
     (error "Invalid *tshell*, *tshell-killer*, or *tshell-bg* -- did you call (tshell-start)?"))
 
-  #-Clozure
+  #-(and Clozure (not mswindows))
   (error "Oops, TSHELL isn't implemented on this Lisp.")
 
-  #+Clozure
+  #+(and Clozure (not mswindows))
   (let* ((tshell-bg-in (ccl::external-process-input-stream *tshell*))
          (nl  (coerce (list #\Newline) 'string))
          (cmd (concatenate 'string "(" cmd ") &" nl)))
diff -Nru acl2-6.2/books/centaur/misc/tshell-tests.lisp acl2-6.3/books/centaur/misc/tshell-tests.lisp
--- acl2-6.2/books/centaur/misc/tshell-tests.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/misc/tshell-tests.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -0,0 +1,90 @@
+; Centaur Miscellaneous Books
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "tshell")
+
+; Well, this is pretty pathetic.  But it's hard to test much here, e.g., how
+; can we emulate interrupts, etc.?
+
+(value-triple (tshell-ensure))
+
+(defmacro test-tshell (&key cmd save print okp lines)
+  (declare (ignorable cmd save print okp lines))
+  #-(and Clozure (not mswindows))
+  `(value-triple :invisible)
+  #+(and Clozure (not mswindows))
+  `(make-event
+    (b* (((mv $finishedp $status $lines)
+          (tshell-call ,cmd :save ,save :print ,print)))
+      (and (or (equal $finishedp t)
+               (er hard? 'test-tshell "Error: finished was ~x0~%" $finishedp))
+           (or (equal (equal $status 0) ,okp)
+               (er hard? 'test-tshell "Error: status was ~x0~%" $status))
+           (or (equal ,lines :skip)
+               (equal $lines ,lines)
+               (er hard? 'test-tshell "Error: lines were ~x0~%" $lines)))
+      '(value-triple :success))))
+
+(test-tshell :cmd "echo hello"
+             :save t
+             :print t
+             :okp t
+             :lines '("hello"))
+
+(test-tshell :cmd "echo hello"
+             :save t
+             :print nil
+             :okp t
+             :lines '("hello"))
+
+(test-tshell :cmd "echo hello"
+             :save nil
+             :print nil
+             :okp t
+             :lines nil)
+
+(test-tshell :cmd "ls -1 tshell-tests.lisp"
+             :save t
+             :print t
+             :okp t
+             :lines '("tshell-tests.lisp"))
+
+; Matt K., 8/11/2013: Commenting out the following test, at Jared's suggestion,
+; since it is failing on a Mac.
+#||
+(test-tshell :cmd "ls -1 tshell.lisp tshell-tests.lisp"
+             :save t
+             :print t
+             :okp t
+             :lines '("tshell.lisp" "tshell-tests.lisp"))
+||#
+
+(test-tshell :cmd "ls file-that-should-not-exist.txt"
+             :save t
+             :print t
+             :okp nil
+             :lines :skip)
+
+(test-tshell :cmd "ls file-that-should-not-exist.txt"
+             :save nil
+             :print t
+             :okp nil
+             :lines nil)
diff -Nru acl2-6.2/books/centaur/misc/tshell.lisp acl2-6.3/books/centaur/misc/tshell.lisp
--- acl2-6.2/books/centaur/misc/tshell.lisp	2013-06-06 17:11:45.000000000 +0000
+++ acl2-6.3/books/centaur/misc/tshell.lisp	2013-09-30 17:53:11.000000000 +0000
@@ -19,84 +19,230 @@
 ; Tshell
 ; Original author: Jared Davis <jared@centtech.com>
 
+(in-package "ACL2")
+(include-book "tools/include-raw" :dir :system)
+(include-book "cutil/define" :dir :system)
+(include-book "str/strprefixp" :dir :system) ;; used in the raw code
+;; (depends-on "tshell-raw.lsp")
 
-; TSHELL is an alternative to things like sys-call and run-program.  It is
-; similar to the CSH and SH commands in hons-raw.lisp, and like CSH and SH it
-; does not require a "fork" for every external program invocation.  Instead, we
-; start up a single BASH process with (TSHELL-START) ahead of time, then use
-; this process to issue every command.  Forking is often problematic when many
-; gigabytes of memory are allocated, so the basic idea is to call TSHELL-START
-; The basic idea is to call TSHELL-START early in the life of the Lisp image,
-; before much memory allocation is done.
-;
-; Here are TSHELL's features that are not in CSH or SH:
-;
-;   (1) You can have the program's output printed at runtime, but still capture
-;       its output as a list of strings.
-;
-;   (2) You can get the exit code from the program.
-;
-;   (3) If you interrupt, :continue will let you keep running the program, but
-;       if you :q then a KILL signal will be sent.
-;
-; The third feature was particularly important to me for AIGPU, because we
-; don't want some runaway AIGPU process on prime getting in the way and
-; stopping us from doing other tautology checking.
+(defxdoc tshell
+  :parents (interfacing-tools sys-call)
+  :short "A fancy alternative to @(see sys-call) that features output streaming
+and capture, exit-code capture, interruption, and better control over when
+forking occurs. (CCL only)"
 
+  :long "<p><b>Tshell</b> is an alternative to things like ACL2's @(see
+sys-call) or Lisp-specific tools like CCL's @('run-program') that offers
+some nice features:</p>
 
-; This file defines the ACL2 interface for tshell; see tshell-raw.lsp for the
-; implementation.
+<ul>
 
-(in-package "ACL2")
+<li><i>Output streaming and capture</i>.  You can (optionally) have the
+program's output printed at runtime, but still (optionally) capture its output
+as a strings list.  This makes it easy to show a user a long-running
+sub-program's output as it's being created, but also parse and analyze the
+program's output with your ACL2 code.</li>
 
-(include-book "tools/include-raw" :dir :system)
-(include-book "str/strprefixp" :dir :system)
+<li><i>Exit code.</i> Yep, you get it.</li>
+
+<li><i>Interruption.</i> Interrupts are handled gracefully.  After you
+interrupt (e.g., Control C), you can @(':continue') to keep running the
+program, or @(':q') to send the sub-program a KILL signal.</li>
+
+<li><i>Forking.</i> Sub-programs are launched with a separate shell, so you can
+avoid <a
+href='http://en.wikipedia.org/wiki/Fork_%28operating_system%29'>forking</a>
+your ACL2 image when you have dozens of GB allocated.  (Trying to do so
+typically results in ACL2 being killed, despite the wonders of copy-on-write
+pages.)</li>
+
+<li><i>Background jobs.</i> You can optionally launch programs in the
+background.  We use this, e.g., to launch waveform viewers which the user can
+then interact with independently from ACL2.</li>
+
+</ul>
+
+<h3>Usage</h3>
+
+<p>Note that Tshell requires a trust tag because its implementation requires
+some raw Lisp code.  The book to load is:</p>
+
+@({
+ (include-book \"centaur/misc/tshell\" :dir :system)
+})
+
+<p>After loading this book, the first step is then to launch a tshell,
+e.g.,</p>
+
+@({
+ (value-triple (tshell-ensure))
+})
+
+<p>This will launch the subsidiary bash shell that tshell will use to run
+programs (actually three bash shells: one to launch programs, one to kill them,
+and one for background jobs).  This step requires forking ACL2 itself, so you
+typically want to do this early in your ACL2 session, before you have allocated
+tons of memory.</p>
+
+<p>After that, you can start launching programs using @(see tshell-call) or
+@(see tshell-run-background).  For instance,</p>
+
+@({
+    ACL2 !>(tshell-call \"echo hello\")
+    (tshell-call \"echo hello\")
+    hello             ;; <-- output from subprogram, streamed
+    (T 0 (\"hello\"))   ;; <-- finished ok, exit code 0, output lines
+})")
+
+
+(define tshell-stop ()
+  :parents (tshell)
+  :short "Stop any subsidiary bash processes that tshell is running."
+  :returns (nil)
+  :long "<p>You could call this when you're done using tshell.  We typically
+don't bother, since the shells get closed when ACL2 exits anyway.</p>"
+
+  (cw "Warning: under-the-hood definition of ~s0 not installed?"
+      __function__))
+
+
+(define tshell-start ()
+  :parents (tshell)
+  :short "Stop any subsidiary bash processes that tshell is running, then
+start new ones. (always forks ACL2)"
+  :returns (nil)
+  :long "<p>We usually instead use @(see tshell-ensure), which only starts up
+new bash processes if they aren't already running.</p>
+
+<p>If you want to use this in a book, you can wrap it in a @(see value-triple),
+e.g.,</p>
+
+@({ (value-triple (tshell-start)) })"
+
+  (cw "Warning: under-the-hood definition of ~s0 not installed?"
+      __function__))
+
+
+(define tshell-ensure ()
+  :parents (tshell)
+  :short "Starts up the subsidiary bash processes for tshell, but only if they
+are not already running. (sometimes forks ACL2)"
+  :returns (nil)
+  :long "<p>If you want to use this in a book, you can wrap it in a @(see
+value-triple), e.g.,</p>
+
+@({ (value-triple (tshell-ensure)) })
+
+<p>It's also typically useful to put this before calls of @(see tshell-call) or
+@(see tshell-run-background), to start up the shells if the user hadn't already
+gotten them started earlier.</p>"
+
+  (cw "Warning: under-the-hood definition of ~s0 not installed?"
+      __function__))
 
-;; (depends-on "tshell-raw.lsp")
 
-(defun tshell-start ()
-  (declare (xargs :guard t))
-  (cw "Warning: tshell-start not redefined."))
-
-(defun tshell-stop ()
-  (declare (xargs :guard t))
-  (cw "Warning: tshell-stop not redefined."))
-
-(defun tshell-ensure ()
-  (declare (xargs :guard t))
-  (cw "Warning: tshell-ensure not redefined."))
-
-(defun tshell-run-background (cmd)
-  (declare (xargs :guard t)
-           (ignorable cmd))
-  (cw "Warning: tshell-run-background not redefined."))
 
 (defun tshell-useless-clauseproc (clause)
   (list clause))
 
 (defttag tshell)
 
-(acl2::define-trusted-clause-processor
-  tshell-useless-clauseproc
-  (tshell-call-fn1)
-  :partial-theory
-  (encapsulate
-    (((tshell-call-fn1 * * *) => (mv * * *)))
-
-    (local (defun tshell-call-fn1 (x y z)
-             (declare (ignorable x y z))
-             (mv nil nil nil)))))
-
-(defun tshell-call-fn (cmd print save)
-  (declare (xargs :guard t))
-  (tshell-call-fn1 cmd print save))
-
-(defmacro tshell-call (cmd &key (print 't) (save 't))
-  `(tshell-call-fn ,cmd ,print ,save))
-
-(acl2::include-raw "tshell-raw.lsp")
-
-(acl2::progn!
- (set-raw-mode t)
- (defun tshell-call-fn (cmd print save)
-   (tshell cmd :print print :save save)))
+(defsection tshell-call-fn1
+  :parents (tshell)
+  :short "Logical story for @(see tshell-call)."
+  :long "<p>We use the @(':partial-theory') feature of @(see
+define-trusted-clause-processor) to introduce a function, @('tshell-call-fn1'),
+about which we assume nothing.</p>
+
+<p>BOZO this probably isn't sound.  Don't we get the equality axioms for
+tshell-call-fn1?  But those aren't necessarily satisfied by command-line
+programs.  We should probably be using oracle reads instead, but then we'll
+need to involve state.</p>"
+
+  (acl2::define-trusted-clause-processor
+   tshell-useless-clauseproc
+   (tshell-call-fn1)
+   :partial-theory
+   (encapsulate
+     (((tshell-call-fn1 * * *) => (mv * * *)))
+
+     (local (defun tshell-call-fn1 (x y z)
+              (declare (ignorable x y z))
+              (mv nil 0 nil)))
+
+     (defthm return-type-of-tshell-call-fn1
+       (b* (((mv finishedp status lines)
+             (tshell-call-fn1 cmd print save)))
+         (and (booleanp finishedp)
+              (natp status)
+              (string-listp lines)))))))
+
+(define tshell-call
+  :parents (tshell)
+  :short "Use tshell to run a sub-program and wait for it to finish.  (never
+forks ACL2)."
+
+  ((cmd stringp
+        "This should be an ordinary shell command that takes no input and does
+         not attempt to do any I/O redirection.  It can have arguments, e.g.,
+         you can write something like @('\"echo hello\"') here.  But it won't
+         work to do something like @('\"echo < foo.txt\"').")
+   &key
+
+   ((print booleanp
+           "This says whether we should print the lines produced by @('cmd') as
+            they are produced.")
+    't)
+
+   ((save booleanp
+          "This says whether we should capture the output lines produced by
+           @('cmd') and return them as the @('lines') output.  If you aren't
+           going to analyze the program's output, you might want to set this
+           to @('nil') to cut down on memory usage.")
+    't))
+
+  :returns
+  (mv (finishedp booleanp :rule-classes :type-prescription
+                 "This will be @('t') if the command completed normally, or
+                  @('nil') if the command was interrupted.")
+
+      (exit-status natp :rule-classes :type-prescription
+                   "The exit code from the command.  Typically 0 means success
+                    and any non-zero value means failure.  This is only
+                    sensible if @('finishedp') is @('t').")
+
+      (lines string-listp
+             "The output from the command (from both standard output and
+              standard error.)  Note that @('lines') will always just be
+              @('nil') if you're using @(':save nil')."))
+
+  :long "<p>Before using @('tshell-call') you need to make sure that the bash
+processes for tshell have been started; see @(see tshell-start) and @(see
+tshell-ensure).</p>
+
+<p>Note that @(':save') and @(':print') are independent from one-another; you
+can print without saving, save without printing, save and print, or do neither
+and just get the exit code.</p>"
+
+  (progn$
+   (cw "Warning: under-the-hood definition of ~s0 not installed?"
+       __function__)
+   (tshell-call-fn1 cmd print save)))
+
+(define tshell-run-background
+  :parents (tshell)
+  :short "Use tshell to run a sub-program in the background; don't wait for it
+to finish and don't get any output from it. (never forks ACL2)."
+
+ ((cmd stringp "The command to give to the shell.  It had better be
+                well-formed.  It can probably use input/output redirection
+                without problems.  We're basically going to run: @('(cmd) &')."))
+ :returns (nil)
+ :ignore-ok t
+ (cw "Warning: under-the-hood definition of ~s0 not installed?"
+     __function__))
+
+(include-raw "tshell-raw.lsp")
+
+
+
diff -Nru acl2-6.2/books/centaur/quicklisp/Makefile acl2-6.3/books/centaur/quicklisp/Makefile
--- acl2-6.2/books/centaur/quicklisp/Makefile	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/quicklisp/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,38 +0,0 @@
-# Quicklisp setup for Centaur books
-# Copyright (C) 2008-2012 Centaur Technology
-#
-# Contact:
-#   Centaur Technology Formal Verification Group
-#   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-#   http://www.centtech.com/
-#
-# This program is free software; you can redistribute it and/or modify it under
-# the terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.  This program is distributed in the hope that it will be useful but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-# more details.  You should have received a copy of the GNU General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-#
-# Original author: Jared Davis <jared@centtech.com>
-
-STARTJOB ?= $(SHELL)
-ACL2 ?= acl2
-
-all: top.cert
-
-quicklisp.lisp:
-	curl -O http://beta.quicklisp.org/quicklisp.lisp
-
-setup.lisp: quicklisp.lisp install.lsp
-	$(STARTJOB) -c "$(ACL2) < install.lsp &> install.out"
-
-clean:
-	rm -rf setup.lisp quicklisp.lisp asdf.lisp cache dists local-projects \
-	       tmp install.out quicklisp *.cert.out *.cert.time *.lx64fsl \
-               Makefile-tmp *.cert
-
-top.cert: setup.lisp
-	cert.pl top.cert
diff -Nru acl2-6.2/books/centaur/quicklisp/README acl2-6.3/books/centaur/quicklisp/README
--- acl2-6.2/books/centaur/quicklisp/README	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/quicklisp/README	2013-09-30 17:53:14.000000000 +0000
@@ -1,3 +1,8 @@
-Note: you need to run "make" in this directory before you can certify top.cert.
+Note: You can't just certify these books with cert.pl.  The proper way to
+build them is, e.g.,:
 
-See books/centaur/README.html for detailed instructions about building the Centaur books.
+   cd acl2-sources/books
+   make USE_QUICKLISP=1
+
+Or similar.  See books/centaur/README.html for detailed instructions about
+building the Centaur books.
diff -Nru acl2-6.2/books/centaur/quicklisp/cert.acl2 acl2-6.3/books/centaur/quicklisp/cert.acl2
--- acl2-6.2/books/centaur/quicklisp/cert.acl2	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/quicklisp/cert.acl2	2013-09-30 17:53:14.000000000 +0000
@@ -1 +1,23 @@
+; Quicklisp setup for Centaur books
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "xdoc/portcullis" :dir :system)
 ; cert-flags: ? t :ttags :all
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/quicklisp/top.lisp acl2-6.3/books/centaur/quicklisp/top.lisp
--- acl2-6.2/books/centaur/quicklisp/top.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/quicklisp/top.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1,5 +1,5 @@
 ; Quicklisp setup for Centaur books
-; Copyright (C) 2008-2012 Centaur Technology
+; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -22,18 +22,114 @@
 (include-book "tools/include-raw" :dir :system)
 ; (depends-on "setup.lisp")
 
+(defsection quicklisp
+  :parents (acl2::interfacing-tools)
+  :short "An ACL2 wrapper for the <a
+href='http://www.quicklisp.org'>Quicklisp</a> system for installing Lisp
+libraries."
 
-; Quicklisp (www.quicklisp.org) is a tool for installing Common Lisp libraries,
-; somewhat like CPAN for Perl, GEMS for Ruby.
-;
-; This file is a way to get Quicklisp loaded in an ACL2 session.  It doesn't
-; load anything beyond Quicklisp itself, so, e.g., to load an actual Quicklisp
-; package, you'll need to do something like:
-;
-;   (ql:quickload "cl-json")
-;
-; In your own ACL2 book.  Obviously doing this will require a ttag.  For that
-; matter, even loading this Quicklisp book requires a ttag.
+  :long "<h3>About Quicklisp</h3>
+
+<p>Quicklisp is a Common Lisp equivalent to tools like <a
+href='http://www.cpan.org/'>CPAN</a> for <a
+href='http://www.perl.org/'>Perl</a>, or <a
+href='http://rubygems.org/'>RubyGems</a> for <a
+href='http://www.ruby-lang.org/'>Ruby</a>.  It lets you to easily install and
+load the latest versions of Common Lisp libraries (and their dependencies).</p>
+
+<p>If you don't know much about Quicklisp and are wanting to find out about the
+available libraries, the following may be useful:</p>
+
+<ul>
+
+<li><a href='http://www.cliki.net/'>CLiki</a> is a Common Lisp wiki.  See
+especially the page about <a
+href='http://www.cliki.net/Current%20recommended%20libraries'>recommended
+libraries</a>.</li>
+
+<li><a href='http://quickdocs.org/'>Quickdocs</a> purports to provide
+documentation for all of the libraries in Quicklisp.</li>
+
+</ul>
+
+
+<h3>The ACL2 Quicklisp Book</h3>
+
+<p>To make it easy to use Quicklisp from ACL2, we have wrapper book, which of
+course requires a <see topic='@(url defttag)'>trust tag</see>:</p>
+
+@({
+    (include-book \"centaur/quicklisp/top\" :dir :system)
+})
+
+<p><b>NOTE:</b> this book isn't automatically certified when you just run
+@('make') in the acl2-books directory.  You have to explicitly tell @('make')
+that you want to use Quicklisp&mdash;e.g.,</p>
+
+@({
+    cd [...]/acl2-sources/books
+    make USE_QUICKLISP=1
+})
+
+<p>The Quicklisp book really is just a way to get Quicklisp itself loaded into
+an ACL2 session.  It doesn't load anything libraries.</p>
+
+
+<h3>Practical Howto</h3>
+
+<p>So how do you actually use the Quicklisp book to gain access to a Common
+Lisp library?  For instance, say we want to make use of the <a
+href='http://common-lisp.net/project/cl-json/'>CL-JSON</a> library.</p>
+
+<p>Normally you would do something like this:</p>
+
+@({
+    ; ** my-book.lisp
+    (in-package \"MY-PKG\")
+
+    ; ** Load Quicklisp, tell cert.pl this book needs Quicklisp support
+    (include-book \"centaur/quicklisp/top\" :dir :system)
+    ;; cert_param: (uses-quicklisp)
+
+    ; ** [OPTIONAL] develop a logical story so you can use the
+    ; ** library from proper ACL2 functions...
+    (defun foo (x y z)
+      (declare (xargs :guard ...))
+      (progn$
+       (er hard? 'foo \"Raw lisp definition not installed?\")
+       (logical-story-of-foo x y z)))
+
+    ; ** Add a ttag since we're going to use include-raw
+    (defttag :my-book)
+
+    ; ** Tell cert.pl that we're going to be loading raw Lisp code
+    ;; (depends-on \"my-book-raw.lsp\")
+
+    ; ** Actually include the raw Lisp code for our book
+    (include-raw \"my-book-raw.lsp\"
+                 :do-not-compile t
+                 :host-readtable t)
+})
+
+<p>You usually need to use the @(':host-readtable') option because real Common
+Lisp libraries will use things (packages, floats, etc.) that ACL2's reader will
+reject.  You usually need to use @(':do-not-compile') because BOZO why?  I
+don't know, but it never *!@$! works if you try to compile it.</p>
+
+<p>The corresponding raw file, then would look something like this:</p>
+
+@({
+    ; ** my-book-raw.lsp
+    (in-package \"MY-PKG\")
+
+    ; ** Tell Quicklisp we want to use the CL-JSON library
+    (ql:quickload \"cl-json\")
+
+    ; ** Redefine our interface functions, freely using cl-json
+    ; ** functionality
+    (defun foo (x y z)
+      ...)
+})")
 
 (defttag :quicklisp)
 
@@ -52,4 +148,6 @@
 ***********************************************************************~%~
 ~%"))
 
-(include-raw "setup.lisp" :do-not-compile t :host-readtable t)
\ No newline at end of file
+(include-raw "setup.lisp"
+             :do-not-compile t
+             :host-readtable t)
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/regression/add.lisp acl2-6.3/books/centaur/regression/add.lisp
--- acl2-6.2/books/centaur/regression/add.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/add.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,92 @@
+; Copyright David Rager, 2013
+
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+;; cert_param: (uses-glucose)
+
+(in-package "ACL2")
+
+(include-book "common")
+
+(defmodules *add-modules*
+  (vl::make-vl-loadconfig
+   :start-files (list "add.v")))
+
+(defmacro add-thm (n)
+  (let* ((n-str (str::natstr n))
+
+         (constant-name ;;; defining a constant is a bit silly, but having this
+                        ;;; intermediate artifact to view
+          (intern$ (str::cat "*ADD-" n-str "-MODULE*")
+                   "ACL2"))
+
+         (thm-name
+          (intern$ (str::cat "ADD-" n-str "-CORRECT")
+                   "ACL2"))
+
+        (module-name (str::cat "add" n-str))
+
+        (test-vector-name
+         (intern$ (str::cat "ADD-" n-str "-TEST-VECTOR")
+                  "ACL2"))
+
+        (test-vector-autohyps-name
+          (intern$ (str::cat (symbol-name test-vector-name)
+                             "-AUTOHYPS")
+
+                   "ACL2"))
+
+        (test-vector-autoins-name
+          (intern$ (str::cat (symbol-name test-vector-name)
+                             "-AUTOINS")
+
+                   "ACL2"))
+
+        (g-bindings
+         `(gl::auto-bindings (:mix (:nat a ,n)
+                                   (:nat b ,n)))))
+
+    `(progn
+       (defconst ,constant-name
+         (vl::vl-module->esim
+          (vl::vl-find-module ,module-name (vl::vl-translation->mods *add-modules*))))
+
+
+
+       (defstv ,test-vector-name
+         :mod ,constant-name
+         :inputs
+         '(("abus"   a)
+           ("bbus"   b))
+         :outputs
+         '(("out"    res)))
+
+       (def-gl-thm ,thm-name
+         :hyp (,test-vector-autohyps-name)
+         :concl (equal (let* ((in-alist  (,test-vector-autoins-name))
+                              (out-alist (stv-run (,test-vector-name) in-alist))
+                              (res       (cdr (assoc 'res out-alist))))
+                         res)
+                       (mod (+ a b) (expt 2 ,n)))
+         :g-bindings ,g-bindings))))
+
+
+(add-thm 1)
+(add-thm 2)
+(add-thm 3)
+(add-thm 4)
+(add-thm 8)
+(add-thm 16)
+(add-thm 32)
+(add-thm 64)
+(add-thm 128)
+(add-thm 256) ; took 6.98 seconds (with glucose 2.2)
+; (add-thm 512) ; took 26.33 seconds (with glucose 2.2)
diff -Nru acl2-6.2/books/centaur/regression/add.v acl2-6.3/books/centaur/regression/add.v
--- acl2-6.2/books/centaur/regression/add.v	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/add.v	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,109 @@
+/*
+
+
+Copyright (C) 2013 David L. Rager
+
+*/
+
+
+
+// add.v
+//
+// These are simple adders.
+
+module add1 (
+  output [0:0] out,
+  input [0:0] abus,
+  input [0:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add2 (
+  output [1:0] out,
+  input [1:0] abus,
+  input [1:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add3 (
+  output [2:0] out,
+  input [2:0] abus,
+  input [2:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add4 (
+  output [3:0] out,
+  input [3:0] abus,
+  input [3:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add8 (
+  output [7:0] out,
+  input [7:0] abus,
+  input [7:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add16 (
+  output [15:0] out,
+  input [15:0] abus,
+  input [15:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add32 (
+  output [31:0] out,
+  input [31:0] abus,
+  input [31:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add64 (
+  output [63:0] out,
+  input [63:0] abus,
+  input [63:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add128 (
+  output [127:0] out,
+  input [127:0] abus,
+  input [127:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add256 (
+  output [255:0] out,
+  input [255:0] abus,
+  input [255:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add512 (
+  output [511:0] out,
+  input [511:0] abus,
+  input [511:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
+module add1024 (
+  output [1023:0] out,
+  input [1023:0] abus,
+  input [1023:0] bbus
+);
+assign out = abus + bbus;
+endmodule
+
diff -Nru acl2-6.2/books/centaur/regression/cert.acl2 acl2-6.3/books/centaur/regression/cert.acl2
--- acl2-6.2/books/centaur/regression/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/cert.acl2	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,9 @@
+; cert.acl2
+; Just loads relevant packages
+
+(in-package "ACL2")
+(include-book "centaur/vl/portcullis" :dir :system)
+(include-book "centaur/gl/portcullis" :dir :system)
+(include-book "centaur/esim/portcullis" :dir :system)
+(include-book "centaur/aig/portcullis" :dir :system)
+; cert-flags: ? t :ttags :all
diff -Nru acl2-6.2/books/centaur/regression/common.lisp acl2-6.3/books/centaur/regression/common.lisp
--- acl2-6.2/books/centaur/regression/common.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/common.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,62 @@
+; Copyright David Rager, 2013
+
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+(in-package "ACL2")
+
+(include-book "centaur/vl/top" :dir :system)
+(include-book "centaur/gl/gl" :dir :system)
+(include-book "centaur/aig/g-aig-eval" :dir :system)
+(include-book "centaur/esim/stv/stv-top" :dir :system)
+(include-book "centaur/esim/stv/stv-debug" :dir :system)
+(include-book "centaur/4v-sexpr/top" :dir :system)
+(include-book "tools/plev-ccl" :dir :system)
+(include-book "centaur/misc/memory-mgmt" :dir :system)
+(include-book "str/top" :dir :system)
+
+(set-waterfall-parallelism nil) ; for below call of def-gl-clause-processor
+
+; I'm unsure why the below is critical, but the "GL Clock" runs out without it.
+; It introduces a GL clause processor that can natively execute at least the
+; functions from the above books that get marked with add-clause-proc-exec-fns.
+
+(def-gl-clause-processor my-glcp)
+
+(include-book "centaur/gl/bfr-satlink" :dir :system)
+
+(make-event (prog2$ (tshell-ensure)
+                    '(value-triple :invisible))
+            :check-expansion t)
+
+(gl::gl-satlink-mode)
+
+(defun my-glucose-config ()
+  (declare (xargs :guard t))
+  (satlink::make-config :cmdline "glucose"
+                        :verbose t
+                        :mintime 1/2
+                        :remove-temps t))
+
+(defattach gl::gl-satlink-config my-glucose-config)
+
+(local (defthm unsigned-byte-p-re-redef
+         (equal (unsigned-byte-p bits x)
+                (AND (INTEGERP BITS)
+                     (<= 0 BITS)
+                     (INTEGER-RANGE-P 0 (EXPT 2 BITS) X)))
+         :hints(("Goal" :in-theory (enable unsigned-byte-p)))
+         :rule-classes :definition))
+
+(defxdoc verilog-regression-tests
+  :parents (ACL2::VL)
+  :short "Regression tests for @(see vl) and @(see esim)."
+  :long "Regression tests for the ACL2 verilog system can be found in
+         books/centaur/regression.")
diff -Nru acl2-6.2/books/centaur/regression/divide.lisp acl2-6.3/books/centaur/regression/divide.lisp
--- acl2-6.2/books/centaur/regression/divide.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/divide.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,99 @@
+; Copyright David Rager, 2013
+
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+;; cert_param: (uses-glucose)
+
+(in-package "ACL2")
+
+(include-book "common")
+
+(defmodules *divide-modules*
+  (vl::make-vl-loadconfig
+   :start-files (list "divide.v")))
+
+(defmacro divide-thm (n)
+  (let* ((n-str (str::natstr n))
+
+         (constant-name ;;; defining a constant is a bit silly, but having this
+                        ;;; intermediate artifact to view
+          (intern$ (str::cat "*DIVIDE-" n-str "-MODULE*")
+                   "ACL2"))
+
+         (thm-name
+          (intern$ (str::cat "DIVIDE-" n-str "-CORRECT")
+                   "ACL2"))
+
+         (module-name (str::cat "divide" n-str))
+
+         (test-vector-name
+          (intern$ (str::cat "DIVIDE-" n-str "-TEST-VECTOR")
+                   "ACL2"))
+
+
+         (test-vector-autohyps-name
+          (intern$ (str::cat (symbol-name test-vector-name)
+                             "-AUTOHYPS")
+                   "ACL2"))
+
+         (test-vector-autoins-name
+          (intern$ (str::cat (symbol-name test-vector-name)
+                             "-AUTOINS")
+                   "ACL2"))
+
+         (g-bindings
+          `(gl::auto-bindings (:mix (:nat a ,n)
+                                    (:nat b ,n)))))
+
+    `(progn
+       (defconst ,constant-name
+         (vl::vl-module->esim
+          (vl::vl-find-module ,module-name (vl::vl-translation->mods *divide-modules*))))
+
+
+
+       (defstv ,test-vector-name
+         :mod ,constant-name
+         :inputs
+         '(("abus"   a)
+           ("bbus"   b))
+         :outputs
+         '(("out"    res)))
+
+       (def-gl-thm ,thm-name
+         :hyp (and (,test-vector-autohyps-name))
+         :concl (equal (let* ((in-alist  (,test-vector-autoins-name))
+                              (out-alist (stv-run (,test-vector-name) in-alist))
+                              (res       (cdr (assoc 'res out-alist))))
+                         res)
+                       (if (equal b 0) 'X (floor a b)))
+         :g-bindings ,g-bindings))))
+
+
+(divide-thm 1)
+(divide-thm 2)
+(divide-thm 3)
+(divide-thm 4)
+(divide-thm 8)
+(divide-thm 10) ; took 2.79 seconds with glucose 2.2 on modern, yet slow, laptop
+; (divide-thm 12) ; ; took 14.59 seconds with glucose 2.2 on modern, yet slow, laptop
+
+#|
+
+; These are left as benchmarks for the future
+
+(divide-thm 16)
+(divide-thm 32)
+(divide-thm 64)
+(divide-thm 128)
+(divide-thm 256)
+(divide-thm 512)
+|#
diff -Nru acl2-6.2/books/centaur/regression/divide.v acl2-6.3/books/centaur/regression/divide.v
--- acl2-6.2/books/centaur/regression/divide.v	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/divide.v	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,127 @@
+/*
+
+
+Copyright (C) 2013 David L. Rager
+
+*/
+
+
+
+// divide.v
+//
+// These are simple dividers.
+
+module divide1 (
+  output [0:0] out,
+  input [0:0] abus,
+  input [0:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide2 (
+  output [1:0] out,
+  input [1:0] abus,
+  input [1:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide3 (
+  output [2:0] out,
+  input [2:0] abus,
+  input [2:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide4 (
+  output [3:0] out,
+  input [3:0] abus,
+  input [3:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide8 (
+  output [7:0] out,
+  input [7:0] abus,
+  input [7:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide10 (
+  output [9:0] out,
+  input [9:0] abus,
+  input [9:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide12 (
+  output [11:0] out,
+  input [11:0] abus,
+  input [11:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide16 (
+  output [15:0] out,
+  input [15:0] abus,
+  input [15:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide32 (
+  output [31:0] out,
+  input [31:0] abus,
+  input [31:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide64 (
+  output [63:0] out,
+  input [63:0] abus,
+  input [63:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+/*
+ module divide128 (
+  output [127:0] out,
+  input [127:0] abus,
+  input [127:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide256 (
+  output [255:0] out,
+  input [255:0] abus,
+  input [255:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide512 (
+  output [511:0] out,
+  input [511:0] abus,
+  input [511:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+module divide1024 (
+  output [1023:0] out,
+  input [1023:0] abus,
+  input [1023:0] bbus
+);
+assign out = abus / bbus;
+endmodule
+
+*/
diff -Nru acl2-6.2/books/centaur/regression/idiv.lisp acl2-6.3/books/centaur/regression/idiv.lisp
--- acl2-6.2/books/centaur/regression/idiv.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/idiv.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,72 @@
+; Copyright David Rager, 2013
+
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+; cert_param: (uses-glucose)
+
+(in-package "ACL2")
+
+(include-book "common")
+
+(defmodules *divide-modules*
+  (vl::make-vl-loadconfig
+   :start-files (list "idiv.v")))
+
+(defconst *divide-translation*
+  (VL::VL-TRANSLATION->MODS *DIVIDE-MODULES*))
+
+; (vl::vl-modulelist-flat-warnings
+;  (vl::vl-translation->failmods *divide-modules*))
+
+(defconst *divide-module*
+  (vl::vl-module->esim
+   (vl::vl-find-module "udivider_v5"
+                       *divide-translation*)))
+
+(defstv divide-test-vector
+  :mod *divide-module*
+  :inputs '(("iDIVIDEND" dividend) ("iDIVISOR" divisor) ("iDIVVLD" divvld)
+            ("iRESET" reset) ("CLK" clk))
+  :outputs '(("oQUOTIENT" quot) ("oREMAINDER" rem) ("oDONE" done)))
+
+(def-gl-thm divide-resets-quotient
+  :hyp (and (divide-test-vector-autohyps)
+            (equal reset -1))
+  :concl (equal (let* ((in-alist (divide-test-vector-autoins))
+                       (out-alist (stv-run (divide-test-vector)
+                                           in-alist))
+                       (quot (cdr (assoc 'quot out-alist))))
+                  quot)
+                0)
+  :g-bindings '((dividend (:g-number (11 12 13 14 15 16 17 18 19)))
+                (divisor (:g-number (6 7 8 9 10)))
+                (divvld (:g-number (0 1)))
+                (clk (:g-number (2 3)))
+                (reset (:g-number (4 5)))))
+
+(def-gl-thm divide-resets-everything
+  :hyp (and (divide-test-vector-autohyps)
+            (equal reset -1))
+  :concl (let* ((in-alist (divide-test-vector-autoins))
+                       (out-alist (stv-run (divide-test-vector) in-alist))
+                       (quot (cdr (assoc 'quot out-alist)))
+                       (rem (cdr (assoc 'rem out-alist)))
+                       (done (cdr (assoc 'done out-alist))))
+           (and (equal quot 0)
+                (equal rem 0)
+                (equal done 0)))
+
+  :g-bindings '((dividend (:g-number (11 12 13 14 15 16 17 18 19)))
+                (divisor (:g-number (6 7 8 9 10)))
+                (divvld (:g-number (0 1)))
+                (clk (:g-number (2 3)))
+                (reset (:g-number (4 5)))))
+
diff -Nru acl2-6.2/books/centaur/regression/idiv.v acl2-6.3/books/centaur/regression/idiv.v
--- acl2-6.2/books/centaur/regression/idiv.v	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/idiv.v	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,417 @@
+/*
+
+Copyright (C) 2013 David L. Rager
+
+A derived work from the following, which has no specific license:
+  http://commdspfpga.blogspot.com/2012/09/unsiged-integer-divider-in-verilog.html
+
+
+The module below divides an eight bit number by a four bit number.  We
+use both "output"s and "reg"s for the outputs, because VL doesn't yet
+support "output reg"s.
+
+As of August 6, 2013, I have proved that resetting the divider resets
+the outputs.  Correctness of the output under non-reset conditions
+remains to be done.
+
+Something else I'd like to do is reinstate the parameters, as opposed
+to hard coded "8" and "4" values.  This may require further improving
+VL.
+
+*/
+
+//=================================================
+//`timescale 1ns / 1ps
+
+/*********************************************************************************/
+/* Unsigned Integer Divider Module                   */
+/*********************************************************************************/
+module udivider_v5
+(
+ input [8-1:0] iDIVIDEND,   // 0 ~ 2**(8)-1
+ input [4-1:0] iDIVISOR,   // 1 ~ 2**(4)-1
+ input        iDIVVLD,
+ input        iRESET,
+ input        CLK,
+ output /*reg*/ [8-1:0] oQUOTIENT,
+ output /*reg*/ [4-1:0] oREMAINDER,
+ output /*reg*/         oDONE
+);
+/*********************************************************************************/
+/* Derived Parameters                    */
+/*********************************************************************************/
+// parameter EXT_8 = 4 + 8;
+/*********************************************************************************/
+/* Generate rVIVVLD_D1, rDIVVLD_D2, rSTART_D1, rSTART_D1, based on iDIVVLD   */
+/*********************************************************************************/
+wire wSTART;
+reg rSTART_D1;
+reg rDIVVLD_D1;
+reg rDIVVLD_D2;
+reg [8-1:0] oQUOTIENT;
+reg [4-1:0] oREMAINDER;
+reg 		oDONE;
+
+
+always @ (posedge CLK)
+begin
+ if (iRESET)
+  begin
+  rDIVVLD_D1 <= 0;
+  end else
+  begin
+  rDIVVLD_D1 <= iDIVVLD;
+  end
+end
+
+always @ (posedge CLK)
+begin
+ if (iRESET)
+  begin
+  rDIVVLD_D2 <= 0;
+  end else
+  begin
+  rDIVVLD_D2 <= rDIVVLD_D1;
+  end
+end
+
+always @ (posedge CLK)
+begin
+ if (iRESET)
+  begin
+  rSTART_D1 <= 0;
+  end else
+  begin
+  rSTART_D1 <= wSTART;
+  end
+end
+
+assign wSTART = rDIVVLD_D1 && ~rDIVVLD_D2;
+/*********************************************************************************/
+/* Latch iDIVISOR and iDIVIDEND on rSTART_D1             */
+/*********************************************************************************/
+reg [4:0] rDIVISOR_POS;
+reg [4:0] rDIVISOR_NEG;
+always @ (posedge CLK)
+begin
+ if (iRESET)
+ begin
+  rDIVISOR_POS <= 0;
+ end else if (wSTART)
+ begin
+  rDIVISOR_POS <= {1'b0, iDIVISOR};
+ end
+end
+
+always @ (posedge CLK)
+begin
+ if (iRESET)
+ begin
+  rDIVISOR_NEG <= 0;
+ end else if (wSTART)
+ begin
+  rDIVISOR_NEG <= {1'b1, ~iDIVISOR + 1};
+ end
+end
+
+wire [4:0] wEXTZEROS;
+assign wEXTZEROS = 0;
+/*********************************************************************************/
+/* Select between rDIVISOR_POS and rDIVISOR_NEG             */
+/* based on subtract result                  */
+/*********************************************************************************/
+reg  [4:0]  rDIVISOR_TC;
+reg [4:0] rREMAINDER;
+wire [4:0] wREMAINDER_1;
+always @ (posedge CLK)
+ begin
+ if (iRESET || wSTART)
+ begin
+ rDIVISOR_TC <= 0;
+  //rDIVISOR_TC <= rDIVISOR_NEG;
+ end else if (wREMAINDER_1[4])
+ begin
+  rDIVISOR_TC <= rDIVISOR_POS;
+ end else if (~wREMAINDER_1[4])
+ begin
+  rDIVISOR_TC <= rDIVISOR_NEG;
+ end
+end
+/*********************************************************************************/
+/* Initialize rREMAINDER at rSTART_D1               */
+/* Load and Left Shift rREMAINDER at each rLSHIFT cycle         */
+/*********************************************************************************/
+reg rLSHIFT;
+reg [8-1:0] rQUOTIENT;
+reg [7:0] rCOUNT; // 8
+always @ (posedge CLK)
+begin
+ if (iRESET || wSTART)
+ begin
+  rREMAINDER <= 0;
+ end else if (rSTART_D1)
+ begin
+  // rREMAINDER <= { wEXTZEROS[4-1:1], iDIVIDEND[8-1] };
+  rREMAINDER <= { { (4-1){1'b0}}, iDIVIDEND[8-1] };
+  // Extend 4 zeros to iDIVIDEND, so that iDIVISOR > rREMAINDER
+ end else if (rLSHIFT)
+ begin
+  rREMAINDER <= { wREMAINDER_1[4-1:0], rQUOTIENT[8-1] };
+  // Left shift rREMAINDER by 1 bit, shift rQUOTIENT[8-1] to
+  // rREMAINDER[0]
+ end
+end
+/*********************************************************************************/
+/* Compute wREMAINDER_1 as rDIVISOR_TC + rREMAINDER          */
+/*********************************************************************************/
+assign wREMAINDER_1 = rDIVISOR_TC + rREMAINDER;
+/*********************************************************************************/
+/* Iniitalize rQUOTIENT at rSTART_D1               */
+/* Left Shift rQUOTIENT at rLSHIFT cycle              */
+/*********************************************************************************/
+always @ (posedge CLK)
+begin
+ if (iRESET || wSTART )
+ begin
+  rQUOTIENT <= 0;
+ end else if (rSTART_D1 )
+ begin
+  rQUOTIENT <=  {iDIVIDEND[8-2:0], 1'b0};
+  // Initialize rQUOTIENT
+ end else if (rLSHIFT)
+ begin
+  rQUOTIENT <= { rQUOTIENT[8-2:0], ~wREMAINDER_1[4] };
+  // Left shift rQUOTIENT by 1 bit, shift ~wREMAINDER_1[4] to
+  // rQUOTIENT[0]
+ end
+end
+/*********************************************************************************/
+/* Restore the remainder at last iteration by adding rDIVISOR_POS if a 0 Quotient*/
+/*********************************************************************************/
+reg [4-1:0] rRESTORE;
+always @ (posedge CLK)
+begin
+ if (iRESET || wSTART)
+ begin
+  rRESTORE <= 0;
+ end else if (rCOUNT == 8-1 && wREMAINDER_1[4])
+ begin
+  rRESTORE <= wREMAINDER_1 + rDIVISOR_POS;
+ end else if (rCOUNT == 8-1 && ~wREMAINDER_1[4])
+ begin
+  rRESTORE <= wREMAINDER_1;
+ end
+end
+/*********************************************************************************/
+/* rLSHIFT and DONE signals generation based on iDONE          */
+/*********************************************************************************/
+//reg rLSHIFT;
+reg rDONE;
+always @ ( posedge CLK)
+begin
+ if (iRESET || rCOUNT == 8-1)
+ begin
+  rLSHIFT <= 0;
+ end else if (rSTART_D1)
+ begin
+  rLSHIFT <= 1;
+ end
+end
+
+always @ ( posedge CLK)
+begin
+ if (iRESET || rSTART_D1 || rCOUNT == 8-1)
+ begin
+  rCOUNT <= 0;
+ end else if (rLSHIFT)
+ begin
+  rCOUNT <= rCOUNT + 1;
+ end
+end
+
+always @ ( posedge CLK)
+begin
+ if (iRESET || rSTART_D1 || rDONE)
+ begin
+  rDONE <= 0;
+ end else if ( rCOUNT == 8-1)
+ begin
+  rDONE <= 1;
+ end
+end
+/*********************************************************************************/
+/* output registers                     */
+/*********************************************************************************/
+always @ (posedge CLK)
+begin
+ if (iRESET || rSTART_D1)
+ begin
+  oQUOTIENT <= 0;
+ end else if (rDONE)
+ begin
+  oQUOTIENT <= rQUOTIENT;
+ end
+end
+
+always @ (posedge CLK)
+begin
+ if (iRESET || rSTART_D1)
+ begin
+  oREMAINDER <= 0;
+ end else if (rDONE)
+ begin
+  oREMAINDER <= rRESTORE;
+ end
+end
+
+
+always @ (posedge CLK)
+begin
+ if (iRESET || rSTART_D1)
+ begin
+  oDONE <= 0;
+ end else
+ begin
+  oDONE <= rDONE;
+ end
+end
+endmodule
+
+/*********************************************************************************/
+/* End of Unsigned Divider Module                */
+/*********************************************************************************/
+
+/*
+Running Results:
+
+#
+#  X =        254,   D =          1,    Q =        254   R=          0
+#  X       =11111110,   D =0001,    Q =11111110   R=0000
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =          2,    Q =        127   R=          0
+#  X       =11111110,   D =0010,    Q =01111111   R=0000
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =          3,    Q =         84   R=          2
+#  X       =11111110,   D =0011,    Q =01010100   R=0010
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =          4,    Q =         63   R=          2
+#  X       =11111110,   D =0100,    Q =00111111   R=0010
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =          5,    Q =         50   R=          4
+#  X       =11111110,   D =0101,    Q =00110010   R=0100
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =          6,    Q =         42   R=          2
+#  X       =11111110,   D =0110,    Q =00101010   R=0010
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =          7,    Q =         36   R=          2
+#  X       =11111110,   D =0111,    Q =00100100   R=0010
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =          8,    Q =         31   R=          6
+#  X       =11111110,   D =1000,    Q =00011111   R=0110
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =          9,    Q =         28   R=          2
+#  X       =11111110,   D =1001,    Q =00011100   R=0010
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =         10,    Q =         25   R=          4
+#  X       =11111110,   D =1010,    Q =00011001   R=0100
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =         11,    Q =         23   R=          1
+#  X       =11111110,   D =1011,    Q =00010111   R=0001
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =         12,    Q =         21   R=          2
+#  X       =11111110,   D =1100,    Q =00010101   R=0010
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =         13,    Q =         19   R=          7
+#  X       =11111110,   D =1101,    Q =00010011   R=0111
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =         14,    Q =         18   R=          2
+#  X       =11111110,   D =1110,    Q =00010010   R=0010
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        254,   D =         15,    Q =         16   R=         14
+#  X       =11111110,   D =1111,    Q =00010000   R=1110
+#  rPRODUCT=11111110,         rPASS=1   rERRCOUNT=   0
+#
+#
+#
+#  X =        255,   D =          1,    Q =        255   R=          0
+#  X       =11111111,   D =0001,    Q =11111111   R=0000
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =          2,    Q =        127   R=          1
+#  X       =11111111,   D =0010,    Q =01111111   R=0001
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =          3,    Q =         85   R=          0
+#  X       =11111111,   D =0011,    Q =01010101   R=0000
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =          4,    Q =         63   R=          3
+#  X       =11111111,   D =0100,    Q =00111111   R=0011
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =          5,    Q =         51   R=          0
+#  X       =11111111,   D =0101,    Q =00110011   R=0000
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =          6,    Q =         42   R=          3
+#  X       =11111111,   D =0110,    Q =00101010   R=0011
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =          7,    Q =         36   R=          3
+#  X       =11111111,   D =0111,    Q =00100100   R=0011
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =          8,    Q =         31   R=          7
+#  X       =11111111,   D =1000,    Q =00011111   R=0111
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =          9,    Q =         28   R=          3
+#  X       =11111111,   D =1001,    Q =00011100   R=0011
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =         10,    Q =         25   R=          5
+#  X       =11111111,   D =1010,    Q =00011001   R=0101
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =         11,    Q =         23   R=          2
+#  X       =11111111,   D =1011,    Q =00010111   R=0010
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =         12,    Q =         21   R=          3
+#  X       =11111111,   D =1100,    Q =00010101   R=0011
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =         13,    Q =         19   R=          8
+#  X       =11111111,   D =1101,    Q =00010011   R=1000
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =         14,    Q =         18   R=          3
+#  X       =11111111,   D =1110,    Q =00010010   R=0011
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#  X =        255,   D =         15,    Q =         17   R=          0
+#  X       =11111111,   D =1111,    Q =00010001   R=0000
+#  rPRODUCT=11111111,         rPASS=1   rERRCOUNT=   0
+#
+#
+#
+# X ranges from           0 to         255.
+# D ranges from           1 to          15.
+#           0
+# Expected Number of Cases: (2**8)*( (2**4) - 1) =        3840.
+# Total        3840 cases examined. Number of Erros:    0
+*/
diff -Nru acl2-6.2/books/centaur/regression/multiply.lisp acl2-6.3/books/centaur/regression/multiply.lisp
--- acl2-6.2/books/centaur/regression/multiply.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/multiply.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,99 @@
+; Copyright David Rager, 2013
+
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+;; cert_param: (uses-glucose)
+
+(in-package "ACL2")
+
+(include-book "common")
+
+(defmodules *multiply-modules*
+  (vl::make-vl-loadconfig
+   :start-files (list "multiply.v")))
+
+(defmacro multiply-thm (n)
+  (let* ((n-str (str::natstr n))
+
+         (constant-name ;;; defining a constant is a bit silly, but having this
+                        ;;; intermediate artifact to view
+          (intern$ (str::cat "*MULTIPLY-" n-str "-MODULE*")
+                   "ACL2"))
+
+         (thm-name
+          (intern$ (str::cat "MULTIPLY-" n-str "-CORRECT")
+                   "ACL2"))
+
+         (module-name (str::cat "multiply" n-str))
+
+         (test-vector-name
+          (intern$ (str::cat "MULTIPLY-" n-str "-TEST-VECTOR")
+                   "ACL2"))
+
+
+         (test-vector-autohyps-name
+          (intern$ (str::cat (symbol-name test-vector-name)
+                             "-AUTOHYPS")
+                   "ACL2"))
+
+         (test-vector-autoins-name
+          (intern$ (str::cat (symbol-name test-vector-name)
+                             "-AUTOINS")
+                   "ACL2"))
+
+         (g-bindings
+          `(gl::auto-bindings (:mix (:nat a ,n)
+                                    (:nat b ,n)))))
+
+    `(progn
+       (defconst ,constant-name
+         (vl::vl-module->esim
+          (vl::vl-find-module ,module-name (vl::vl-translation->mods *multiply-modules*))))
+
+
+
+       (defstv ,test-vector-name
+         :mod ,constant-name
+         :inputs
+         '(("abus"   a)
+           ("bbus"   b))
+         :outputs
+         '(("out"    res)))
+
+       (def-gl-thm ,thm-name
+         :hyp (,test-vector-autohyps-name)
+         :concl (equal (let* ((in-alist  (,test-vector-autoins-name))
+                              (out-alist (stv-run (,test-vector-name) in-alist))
+                              (res       (cdr (assoc 'res out-alist))))
+                         res)
+                       (mod (* a b) (expt 2 ,n)))
+         :g-bindings ,g-bindings))))
+
+
+(multiply-thm 1)
+(multiply-thm 2)
+(multiply-thm 3)
+(multiply-thm 4)
+(multiply-thm 8) ; took 1.57 seconds with glucose 2.2 on modern, yet slow, laptop
+; (multiply-thm 10) ; took 86.11 seconds with glucose 2.2 on modern, yet slow, laptop
+
+#|
+
+; These are left as benchmarks for the future
+
+(multiply-thm 12)
+(multiply-thm 16)
+(multiply-thm 32)
+(multiply-thm 64)
+(multiply-thm 128)
+(multiply-thm 256)
+(multiply-thm 512)
+|#
diff -Nru acl2-6.2/books/centaur/regression/multiply.v acl2-6.3/books/centaur/regression/multiply.v
--- acl2-6.2/books/centaur/regression/multiply.v	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/multiply.v	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,127 @@
+/*
+
+
+Copyright (C) 2013 David L. Rager
+
+*/
+
+
+
+// multiply.v
+//
+// These are simple multipliers.
+
+module multiply1 (
+  output [0:0] out,
+  input [0:0] abus,
+  input [0:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply2 (
+  output [1:0] out,
+  input [1:0] abus,
+  input [1:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply3 (
+  output [2:0] out,
+  input [2:0] abus,
+  input [2:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply4 (
+  output [3:0] out,
+  input [3:0] abus,
+  input [3:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply8 (
+  output [7:0] out,
+  input [7:0] abus,
+  input [7:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply10 (
+  output [9:0] out,
+  input [9:0] abus,
+  input [9:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply12 (
+  output [11:0] out,
+  input [11:0] abus,
+  input [11:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply16 (
+  output [15:0] out,
+  input [15:0] abus,
+  input [15:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply32 (
+  output [31:0] out,
+  input [31:0] abus,
+  input [31:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply64 (
+  output [63:0] out,
+  input [63:0] abus,
+  input [63:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+/*
+ module multiply128 (
+  output [127:0] out,
+  input [127:0] abus,
+  input [127:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply256 (
+  output [255:0] out,
+  input [255:0] abus,
+  input [255:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply512 (
+  output [511:0] out,
+  input [511:0] abus,
+  input [511:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+module multiply1024 (
+  output [1023:0] out,
+  input [1023:0] abus,
+  input [1023:0] bbus
+);
+assign out = abus * bbus;
+endmodule
+
+*/
diff -Nru acl2-6.2/books/centaur/regression/subtract.lisp acl2-6.3/books/centaur/regression/subtract.lisp
--- acl2-6.2/books/centaur/regression/subtract.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/subtract.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,94 @@
+; Copyright David Rager, 2013
+
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+;; cert_param: (uses-glucose)
+
+(in-package "ACL2")
+
+(include-book "common")
+
+(defmodules *subtract-modules*
+  (vl::make-vl-loadconfig
+   :start-files (list "subtract.v")))
+
+(defmacro subtract-thm (n)
+  (let* ((n-str (str::natstr n))
+
+         (constant-name ;;; defining a constant is a bit silly, but having this
+                        ;;; intermediate artifact to view
+          (intern$ (str::cat "*SUBTRACT-" n-str "-MODULE*")
+
+                   "ACL2"))
+
+         (thm-name
+          (intern$ (str::cat "SUBTRACT-" n-str "-CORRECT")
+
+                   "ACL2"))
+
+         (module-name (str::cat "subtract" n-str))
+
+         (test-vector-name
+          (intern$ (str::cat "SUBTRACT-" n-str "-TEST-VECTOR")
+                   "ACL2"))
+
+         (test-vector-autohyps-name
+          (intern$ (str::cat (symbol-name test-vector-name)
+                             "-AUTOHYPS")
+
+                   "ACL2"))
+
+         (test-vector-autoins-name
+          (intern$ (str::cat (symbol-name test-vector-name)
+                             "-AUTOINS")
+
+                   "ACL2"))
+
+         (g-bindings
+         `(gl::auto-bindings (:mix (:nat a ,n)
+                                   (:nat b ,n)))))
+
+    `(progn
+       (defconst ,constant-name
+         (vl::vl-module->esim
+          (vl::vl-find-module ,module-name (vl::vl-translation->mods *subtract-modules*))))
+
+
+
+       (defstv ,test-vector-name
+         :mod ,constant-name
+         :inputs
+         '(("abus"   a)
+           ("bbus"   b))
+         :outputs
+         '(("out"    res)))
+
+       (def-gl-thm ,thm-name
+         :hyp (,test-vector-autohyps-name)
+         :concl (equal (let* ((in-alist  (,test-vector-autoins-name))
+                              (out-alist (stv-run (,test-vector-name) in-alist))
+                              (res       (cdr (assoc 'res out-alist))))
+                         res)
+                       (mod (- a b) (expt 2 ,n)))
+         :g-bindings ,g-bindings))))
+
+
+(subtract-thm 1)
+(subtract-thm 2)
+(subtract-thm 3)
+(subtract-thm 4)
+(subtract-thm 8)
+(subtract-thm 16)
+(subtract-thm 32)
+(subtract-thm 64)
+(subtract-thm 128)
+(subtract-thm 256) ; took 7.82 seconds (with glucose 2.2)
+; (subtract-thm 512) ; took 29.34 seconds (with glucose 2.2)
diff -Nru acl2-6.2/books/centaur/regression/subtract.v acl2-6.3/books/centaur/regression/subtract.v
--- acl2-6.2/books/centaur/regression/subtract.v	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/regression/subtract.v	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,109 @@
+/*
+
+
+Copyright (C) 2013 David L. Rager
+
+*/
+
+
+
+// subtract.v
+//
+// These are simple subtracters.
+
+module subtract1 (
+  output [0:0] out,
+  input [0:0] abus,
+  input [0:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract2 (
+  output [1:0] out,
+  input [1:0] abus,
+  input [1:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract3 (
+  output [2:0] out,
+  input [2:0] abus,
+  input [2:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract4 (
+  output [3:0] out,
+  input [3:0] abus,
+  input [3:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract8 (
+  output [7:0] out,
+  input [7:0] abus,
+  input [7:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract16 (
+  output [15:0] out,
+  input [15:0] abus,
+  input [15:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract32 (
+  output [31:0] out,
+  input [31:0] abus,
+  input [31:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract64 (
+  output [63:0] out,
+  input [63:0] abus,
+  input [63:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract128 (
+  output [127:0] out,
+  input [127:0] abus,
+  input [127:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract256 (
+  output [255:0] out,
+  input [255:0] abus,
+  input [255:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract512 (
+  output [511:0] out,
+  input [511:0] abus,
+  input [511:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
+module subtract1024 (
+  output [1023:0] out,
+  input [1023:0] abus,
+  input [1023:0] bbus
+);
+assign out = abus - bbus;
+endmodule
+
diff -Nru acl2-6.2/books/centaur/satlink/cnf.lisp acl2-6.3/books/centaur/satlink/cnf.lisp
--- acl2-6.2/books/centaur/satlink/cnf.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/satlink/cnf.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -29,8 +29,13 @@
 (include-book "centaur/misc/bitarr" :dir :system)
 (local (include-book "data-structures/list-defthms" :dir :system))
 
-(defstobj-clone env$ bitarr
-  :exports (env$-length env$-get env$-set env$-resize))
+
+(defsection env$
+  :parents (cnf)
+  :short "A bit array that serves as the environment for @(see eval-formula)."
+
+  (defstobj-clone env$ bitarr
+    :exports (env$-length env$-get env$-set env$-resize)))
 
 (local (defthm equal-1-when-bitp
          (implies (bitp x)
@@ -40,26 +45,33 @@
 
 (defxdoc cnf
   :parents (satlink)
-  :short "Representation of CNF formulas."
+  :short "Our representation (syntax and semantics) for <a
+href='http://en.wikipedia.org/wiki/Conjunctive_normal_form'>conjunctive normal
+form</a> formulas."
+
+  :long "<p>To express what it means to call a SAT solver, we need a
+representation and a semantics for Boolean formulas in conjunctive normal form.
+Our syntax is as follows:</p>
 
-  :long "<ul>
+<ul>
 
-<li>A <b>VARIABLE</b> is a natural number.  To help keep variables separate
+<li>A <b>variable</b> is a natural number.  To help keep variables separate
 from literals, we represent them @(see varp)s, instead of @(see natp)s.</li>
 
-<li>A <b>LITERAL</b> represents either a variable or a negated variable.  We
+<li>A <b>literal</b> represents either a variable or a negated variable.  We
 represent these using a typical numeric encoding: the least significant bit is
 the negated bit, and the remaining bits are the variable.  See @(see
 litp).</li>
 
-<li>A <b>CLAUSE</b> is a disjunction of literals.  We represent these as
+<li>A <b>clause</b> is a disjunction of literals.  We represent these as
 ordinary lists of literals.  See @(see lit-listp).</li>
 
-<li>A <b>FORMULA</b> is a conjunction of clauses.  We represent these using
+<li>A <b>formula</b> is a conjunction of clauses.  We represent these using
 @(see lit-list-listp).</li>
 
-</ul>")
+</ul>
 
+<p>The semantics of these formulas are given by @(see eval-formula).</p>")
 
 (defsection eval-formula
   :parents (cnf)
@@ -68,9 +80,10 @@
   :long "<p>We define a simple evaluator for CNF formulas that uses an
 environment to assign values to the identifiers.</p>
 
-<p>The environment is represented as a bit array.  Our evaluators produce a
-<b>BIT</b> (i.e., 0 or 1) instead of a BOOL (i.e., T or NIL) to make it
-directly compatible with the bitarr stobj.</p>"
+<p>The environment, @(see env$), is an abstract stobj that implements a simple
+bit array.  Our evaluators produce a <b>BIT</b> (i.e., 0 or 1) instead of a
+BOOL (i.e., T or NIL) to make it directly compatible with the bitarr
+stobj.</p>"
 
   (define eval-var ((var varp) env$)
     :returns (bit bitp)
diff -Nru acl2-6.2/books/centaur/satlink/dimacs.lisp acl2-6.3/books/centaur/satlink/dimacs.lisp
--- acl2-6.2/books/centaur/satlink/dimacs.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/satlink/dimacs.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -26,6 +26,7 @@
 (include-book "str/natstr" :dir :system)
 (include-book "str/strnatless" :dir :system)
 (include-book "std/io/base" :dir :system)
+(include-book "std/typed-lists/character-listp" :dir :system)
 
 (defsection dimacs
   :parents (satlink)
@@ -99,11 +100,17 @@
 that conform to these more stringent requirements, since otherwise a SAT solver
 that believes it can make these assumptions may make a mistake.  We may
 eventually add a cleaning phase to our SAT integration, to ensure that we only
-call the SAT solver on \"clean\" formulas.</p>"
+call the SAT solver on \"clean\" formulas.</p>")
 
-; Basic idea: ACC is a character list with the output we have "printed" in
-; reverse order.  This means (cons char acc) is the same as printing a char,
-; (str::revappend-chars str acc) is the same as printing str, etc.
+(defsection dimacs-export
+  :parents (dimacs)
+  :short "Writer to translate @(see cnf) formulas into DIMACS files."
+
+  :long "<p>The basic idea here is that @('acc') is a character list with the
+output we have printed in reverse order.  This means @('(cons char acc)') is
+the same as printing a char, @('(str::revappend-chars str acc)') is the same as
+printing @('str'), etc.  See @(see str::revappend-chars) for more background
+about this basic approach.</p>"
 
   (define dimacs-write-lit ((lit litp) (acc character-listp))
     :returns (acc character-listp :hyp :guard)
diff -Nru acl2-6.2/books/centaur/satlink/package.lsp acl2-6.3/books/centaur/satlink/package.lsp
--- acl2-6.2/books/centaur/satlink/package.lsp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/satlink/package.lsp	2013-09-30 17:53:14.000000000 +0000
@@ -21,9 +21,9 @@
 
 (in-package "ACL2")
 
-(ld "cutil/package.lsp" :dir :system)
+(include-book "cutil/portcullis" :dir :system)
 (ld "tools/flag-package.lsp" :dir :system)
-(ld "oslib/package.lsp" :dir :system)
+(include-book "oslib/portcullis" :dir :system)
 
 (defpkg "SATLINK"
   (union-eq *acl2-exports*
@@ -60,5 +60,6 @@
               bitarr get-bit set-bit bits-length resize-bits bits-equiv
               natarr get-nat set-nat nats-length resize-nats nats-equiv
               tshell-call tshell-start tshell-stop tshell-ensure
+              satlink boolean-reasoning
               )))
 
diff -Nru acl2-6.2/books/centaur/satlink/top.lisp acl2-6.3/books/centaur/satlink/top.lisp
--- acl2-6.2/books/centaur/satlink/top.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/satlink/top.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -29,40 +29,113 @@
 (include-book "oslib/tempfile" :dir :system)
 (include-book "centaur/misc/tshell" :dir :system)
 (include-book "config")
+(local (include-book "std/lists/nthcdr" :dir :system))
 
 (defxdoc satlink
-  :short "A way to call SAT solvers from within ACL2, and trust what they say."
-
-  :long "<p>SATLINK is a basic connection to SAT solvers from within ACL2.  At
-a high level, it provides:</p>
+  :parents (acl2::boolean-reasoning)
+  :short "A simple representation for Boolean formulas in <see topic='@(url
+cnf)'>conjunctive normal form</see>, and a mechanism for calling SAT solvers
+from within ACL2 and trusting what they say. (CCL Only)"
+
+  :long "<p>SAT solvers are programs that can solve the <a
+href='https://en.wikipedia.org/wiki/Boolean_satisfiability_problem'>Boolean
+satisfiability problem</a>.  Modern solvers implement clever algorithms in fast
+languages like C and C++, so they can quickly solve many large problems.
+Developing faster SAT solvers is an active area of research with frequent <a
+href='http://www.satcompetition.org/'>competitions</a>.</p>
+
+<p>SAT solvers are useful because many problems can be recast as SAT problems.
+For instance, the @(see gl::gl) framework can translate many ACL2 proof goals,
+e.g., bounded arithmetic problems, into SAT problems.  This allows for a large
+class of theorems to be solved quickly and automatically by the SAT solver.
+This is especially useful in @(see acl2::hardware-verification).</p>
+
+<p><b>Satlink</b> is an interfacing library that allows ACL2 to make use of
+off-the-shelf SAT solvers like <a
+href='http://fmv.jku.at/lingeling/'>lingeling</a>, <a
+href='https://www.lri.fr/~simon/?page=glucose'>glucose</a>, and so on.  It
+provides:</p>
 
 <ul>
 
-<li>A (trivial) representation and semantics for Boolean formulas in <a
-href='http://en.wikipedia.org/wiki/Conjunctive_normal_form'>conjunctive normal
-form</a>; see @(see cnf).</li>
+<li>A (trivial) representation and semantics for Boolean formulas in
+conjunctive normal form; see @(see cnf).</li>
+
+<li>A function, @(see sat), that can invoke a SAT solver on a formula and
+interpret its output.  This is done via @(see acl2::tshell), so the integration
+is very smooth, e.g., you can interrupt the SAT solver.</li>
+
+<li>A @(see logical-story) that allows us to <color rgb='#ff0000'><b>assume,
+using a <see topic='@(url defttag)'>trust tag</see></b></color>, that when the
+SAT solver claims the formula is unsatisfiable, it's correct.</li>
+
+</ul>
+
+<p>We don't have to assume anything when the SAT solver claims that a formula
+is satisfiable, since we can just check the alleged satisfying assignment it
+produces.</p>
+
+
+<h3>Loading the Library</h3>
+
+<p>Satlink is a low-level library.  It would be a bit weird to want to use it
+directly.  Instead, it is typically used indirectly through other tools, such
+as the @(see gl::gl) framework, or @(see acl2::aig-sat), or the @(see
+aignet::aignet-cnf) translation.  These other approaches are likely to be more
+convenient than using Satlink directly.</p>
+
+<p>If you want to include Satlink directly for some reason, the book to include
+is:</p>
+
+@({
+ (include-book \"centaur/satlink/top\" :dir :system)
+})
+
+<p>Once you load this book, you generally need to construct your input @(see
+cnf) formula in some way, and then call @(see sat).</p>
+
+
+
 
-<li>A function, @(see sat), that can call an off-the-shelf SAT solver (e.g., <a
-href='http://fmv.jku.at/lingeling/'>lingeling</a>) on a formula, and interpret
-its output.</li>
+<h3>Copyright Information</h3>
 
-<li>A logical story that allows us to assume, using a <see topic='@(see
-defttag)'>trust tag</see>, that the SAT solver only claims that formulas are
-unsatisfiable when this is indeed the case.  (When the SAT solver claims that a
-formula is satisfiable, we can just check the alleged satisfying assignment it
-produces.)</li>
+<p>Satlink &mdash; Link from ACL2 to SAT Solvers<br/>
+Copyright (C) 2013 <a href=\"http://www.centtech.com\">Centaur Technology</a>.</p>
 
-</ul>")
+<p>Contact:</p>
+@({
+Centaur Technology Formal Verification Group
+7600-C N. Capital of Texas Highway, Suite 300
+Austin, TX 78731, USA.
+})
 
+<p>Satlink is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation; either version 2 of the License, or (at your option) any later
+version.</p>
 
-; Parser for reading DIMACS output from the SAT solver...
+<p>This program is distributed in the hope that it will be useful but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+details.</p>
 
-(define satlink-skip-ws ((x stringp)
-                         (n natp)
-                         (xl (equal xl (length x))))
+<p>You should have received a copy of the GNU General Public License along with
+this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
+Street, Suite 500, Boston, MA 02110-1335, USA.</p>")
+
+
+(defsection dimacs-interp
+  :parents (dimacs)
+  :short "How we interpret the DIMACS formatted output from the SAT solver.")
+
+(define satlink-skip-ws
+  :parents (dimacs-interp)
+  ((x  stringp               "String we're processing")
+   (n  natp                  "Current position in @('x').")
+   (xl (equal xl (length x)) "Pre-computed length of @('x')."))
   :guard (<= n xl)
+  :returns (new-n natp "New position after skipping whitespace.")
   :measure (nfix (- (nfix xl) (nfix n)))
-  :returns (new-n natp)
   (b* (((when (mbe :logic (zp (- (nfix xl) (nfix n)))
                    :exec (int= xl n) ;; It's *really* fast
                    ))
@@ -88,15 +161,17 @@
     :rule-classes ((:rewrite) (:linear))))
 
 (define satlink-parse-variable-line
-  ((x stringp)
-   (n natp "current position")
-   (xl (equal xl (length x)))
-   saw-zero-p
-   env$)
+  :parents (dimacs-interp)
+  ((x          stringp                "String we're processing.")
+   (n          natp                   "Current position in @('x').")
+   (xl         (equal xl (length x))  "Pre-computed length of @('x').")
+   (saw-zero-p booleanp               "Have we seen a 0 yet?")
+   (env$                              "Satisfying assignment we're populating."))
   :guard (<= n xl)
-  :returns (mv error saw-zero-p env$)
+  :returns (mv (error      "True if there is an error parsing this line.")
+               (saw-zero-p "Did we ever see 0?  (checked later).")
+               (env$       "Updated satisfying assignment."))
   :measure (nfix (- (nfix xl) (nfix n)))
-
   (b* ((n (satlink-skip-ws x n xl))
        ((when (mbe :logic (zp (- (nfix xl) n))
                    :exec  (int= xl n)))
@@ -125,17 +200,17 @@
                     (set-bit index (if minus-p 0 1) env$))
                    (t
                     (prog2$
-                     (er hard? __function__ "Assignment to out-of-bounds variable: ~x0" index)
+                     (raise "Assignment to out-of-bounds variable: ~x0" index)
                      env$)))))
     (satlink-parse-variable-line x (+ n len) xl saw-zero-p env$)))
 
 (define satlink-handle-line
+  :parents (dimacs-interp)
   ((line        "one line of sat solver output" stringp)
    (saw-unsat-p "have we seen an 's UNSATISFIABLE' line?")
    (saw-sat-p   "have we seen an 's SATISFIABLE' line?")
    (saw-zero-p  "have we seen a 0 in a 'v' line?")
    (env$        "evolving variable bindings"))
-
   :returns
   (mv (error-p "did we see something we don't understand?")
       saw-unsat-p
@@ -162,6 +237,9 @@
                (prog2$
                 (cw "SATLINK: Don't recognize this line: ~s0~%" line)
                 (mv t saw-unsat-p saw-sat-p saw-zero-p env$)))))
+       ((when (str::strprefixp "Solved by" line))
+        ;; Ignore glucose 2.2 feature
+        (mv nil saw-unsat-p saw-sat-p saw-zero-p env$))
        ((unless (eql char #\v))
         (cw "SATLINK: Don't recognize this line: ~s0~%" line)
         (mv t saw-unsat-p saw-sat-p saw-zero-p env$))
@@ -174,6 +252,7 @@
     (mv error saw-unsat-p saw-sat-p saw-zero-p env$)))
 
 (define satlink-handle-lines
+  :parents (dimacs-interp)
   ((lines string-listp)
    (saw-unsat-p "have we seen an 's UNSATISFIABLE' line?")
    (saw-sat-p   "have we seen an 's SATISFIABLE' line?")
@@ -194,8 +273,9 @@
     (satlink-handle-lines (cdr lines) saw-unsat-p saw-sat-p saw-zero-p env$)))
 
 (define satlink-parse-output
-  ((out  string-listp)
-   (env$ "empty env to populate, should be sized already."))
+  :parents (dimacs-interp)
+  ((out  string-listp "output lines from the SAT solver.")
+   (env$              "empty env to populate, should be sized already."))
   :returns (mv (status "Either :failed, :sat, or :unsat")
                (env$   "Variable assignment, in the :sat case."))
   (b* (((mv error-p saw-unsat-p saw-sat-p saw-zero-p env$)
@@ -218,16 +298,22 @@
     (mv :sat env$)))
 
 
-; Core function to use to run the SAT solver.
-
-(define satlink-run-impl ((config config-p)
-                          (cnf    lit-list-listp)
-                          (env$   "empty env to populate, will usually be resized")
-                          &key
-                          (state 'state))
-  :returns (mv status
+(define satlink-run-impl
+  :parents (logical-story)
+  :short "Core function used to run the SAT solver."
+  ((config config-p       "Which solver to call, etc.")
+   (cnf    lit-list-listp "The formula to solve.")
+   (env$   "Empty env to populate, will usually be resized")
+   &key
+   (state 'state))
+  :returns (mv (status ":sat, :unsat, or :failed")
                (env$ "Variable assignment, in the :sat case.")
                (state state-p1 :hyp (state-p1 state)))
+  :long "<p>This function actually runs the SAT solver: it exports the formula
+into a @(see dimacs) file, invokes the SAT solver on it, and interprets the
+answer.  This function is typically never used directly; instead see @(see
+satlink-run).</p>"
+
   (b* (((config config) config)
 
        ((mv filename state) (oslib::tempfile "satlink"))
@@ -274,7 +360,90 @@
     (mv status env$ state)))
 
 
-; Logical Story
+(defsection logical-story
+  :parents (satlink)
+  :short "How we logically assume that the SAT solver's claims of unsat are
+correct."
+
+  :long "<p>The whole point of Satlink is to be able to call an external SAT
+solver, written in C or C++, and trust its results.  Here, we explain exactly
+how we do that.</p>
+
+<p>Our assumptions about the SAT solver will be expressed as constraints about
+a new function, @('satlink-run-fn').  Informally, the idea behind this function
+is that it will have the following signature:</p>
+
+<code>
+ (satlink-run-fn config formula env$) &rarr; (status env$)
+</code>
+
+<dl>
+
+<dt>Inputs</dt>
+
+<dd>@('config') is a @(see config-p) that says which SAT solver to run and how
+to run it.</dd>
+
+<dd>@('formula') is the @(see cnf) formula to solve.</dd>
+
+<dd>@('env$') is @(see env$), a bit array that will be used to store the
+satisfying assignment from the SAT solver, in the SAT case.</dd>
+
+<dt>Outputs</dt>
+
+<dd>@('status') is the answer we get back from the SAT solver; in practice it
+will either be @(':sat') or @(':unsat'), or perhaps @(':failed') if we run into
+some kind of gross error&mdash;for instance, perhaps the SAT solver produces
+output that we weren't expecting, like \"Segmentation fault\" or
+\"Killed\".</dd>
+
+<dd>@('env$') is the updated @(see env$) bit array; in the @(':sat') case it
+should contain the satisfying assignment.</dd>
+
+</dl>
+
+<h3>Axiomatization</h3>
+
+<p>We use ACL2's @(see define-trusted-clause-processor) @(':partial-theory')
+feature to assume that the function satisfies certain constraints.</p>
+
+<p>To make our story as tight as possible, we would like to assume very little
+about @('satlink-run-fn').  It turns out we only need three constraints, with
+the first two constraints just saying that the function returns two values:</p>
+
+@(thm true-listp-of-satlink-run-fn)
+@(thm len-of-satlink-run-fn)
+
+<p>The final constraint is the real one.  The idea here is to express:</p>
+
+<box><p>
+   if @('satlink-run-fn') returns @(':unsat'),<br/>
+   then the formula evaluates to false under every environment.
+</p></box>
+
+<p>But the quantification here isn't quite right for a rewrite rule, so
+instead we assume the contrapositive:</p>
+
+<box><p>
+   if NOT(the formula evaluates to false under every environment),<br/>
+   then NOT( @('satlink-run-fn') returns @(':unsat') )
+</p></box>
+
+<p>Which simplifies down to:</p>
+
+<box><p>
+   if the formula evaluates to true under any environment,<br/>
+   then @('satlink-run-fn') does not return @(':unsat')
+</p></box>
+
+<p>So the real constraint looks like this:</p>
+
+@(thm satlink-run-fn-unsat-claim)
+
+
+<p>And that's it.  We don't need to assume anything about what happens in the
+@(':sat') case, because our top-level @(see sat) wrapper can just check any
+@(':sat') answers.</p>")
 
 (defun satlink-useless-clauseproc (clause)
   (list clause))
@@ -307,33 +476,51 @@
                (not (equal (mv-nth 0 (satlink-run-fn config formula env$))
                            :unsat))))))
 
-(defun satlink-run (config formula env$)
-  "Returns (MV STATUS ENV$)"
-  (declare (xargs :stobjs env$
-                  :guard (and (config-p config)
-                              (lit-list-listp formula))))
-  (satlink-run-fn config formula env$))
-
-(progn!
- (set-raw-mode t)
- (defun satlink-run (config formula env$)
-   (b* ((state acl2::*the-live-state*)
-        (prev-okp            (f-get-global 'acl2::writes-okp state))
-        (state               (f-put-global 'acl2::writes-okp t state))
-        ((mv res env$ state) (satlink-run-impl config formula env$))
-        (?state              (f-put-global 'acl2::writes-okp prev-okp state)))
-     (mv res env$))))
-
-(define sat ((formula "A CNF formula to solve." lit-list-listp)
-             (env$    "Environment to populate with a satisfying assignment,
-                       in the case of SAT.  Will be emptied, in any case.")
-             &key
-             ((config "Configuration for running a SAT solver." config-p)
-              '*default-config*))
+(defsection satlink-run
+  :parents (logical-story)
+  :short "Connection between the implementation and the logical story."
+
+  :long "<p>In the logic, this function does nothing more than call
+@('satlink-run-fn'), the constrained function that is the basis of our @(see
+logical-story).</p>
+
+<p>Under the hood, through a trust tag, we smash its definition and have it
+invoke @(see satlink-run-impl), which actually calls the SAT solver.</p>"
+
+  (defun satlink-run (config formula env$)
+    "Returns (MV STATUS ENV$)"
+    (declare (xargs :stobjs env$
+                    :guard (and (config-p config)
+                                (lit-list-listp formula))))
+    (satlink-run-fn config formula env$))
+
+  (progn!
+   (set-raw-mode t)
+   (defun satlink-run (config formula env$)
+     (b* ((state acl2::*the-live-state*)
+          (prev-okp            (f-get-global 'acl2::writes-okp state))
+          (state               (f-put-global 'acl2::writes-okp t state))
+          ((mv res env$ state) (satlink-run-impl config formula env$))
+          (?state              (f-put-global 'acl2::writes-okp prev-okp state)))
+       (mv res env$)))))
+
+(define sat
   :parents (satlink)
   :short "Top-level function for running a SAT solver."
+
+  ((formula "A @(see cnf) formula to solve." lit-list-listp)
+   (env$    "Environment to populate with a satisfying assignment, in the case
+             of SAT.  Will be emptied, in any case.")
+   &key
+   ((config "Configuration for running a SAT solver." config-p)
+    '*default-config*))
   :returns (mv (status "@(':sat'), @(':unsat'), or @(':failed').")
                (env$   "Satisfying assignment, in the case of @(':sat')."))
+
+  :long "<p>This is the top-level wrapper for calling SAT.  It handles the
+details of clearing out the @(see env$) and checking the SAT solver's answers
+in the SAT case.</p>"
+
   (b* (((config config) config)
        (env$ (mbe :logic (non-exec nil) :exec (resize-bits 0 env$)))
        ((mv status env$)
@@ -353,12 +540,16 @@
     (implies (syntaxp (not (equal env$ ''nil)))
              (equal (sat formula env$ :config config)
                     (sat formula nil :config config))))
+
   (defthm sat-when-sat
-    (implies (eq (mv-nth 0 (sat formula env$ :config config)) :sat)
-             (equal (eval-formula formula (mv-nth 1 (sat formula env$ :config config))) 1)))
+    (b* (((mv status new-env$) (sat formula env$ :config config)))
+      (implies (equal status :sat)
+               (equal (eval-formula formula new-env$) 1))))
+
   (defthm sat-when-unsat
-    (implies (equal (eval-formula formula env) 1)
-             (not (equal (mv-nth 0 (sat formula env$ :config config)) :unsat)))
+    (b* (((mv status &) (sat formula env$ :config config)))
+      (implies (equal (eval-formula formula env) 1)
+               (not (equal status :unsat))))
     :hints (("goal" :use ((:instance satlink-run-fn-unsat-claim
                                      (env$ nil)))))))
 
@@ -374,4 +565,4 @@
  (b* (((mv ans env$) (sat '((1 2)) env$)))
    (mv nil `(value-triple ,ans) state env$)))
 
-||#
\ No newline at end of file
+||#
diff -Nru acl2-6.2/books/centaur/tutorial/booth-support.lisp acl2-6.3/books/centaur/tutorial/booth-support.lisp
--- acl2-6.2/books/centaur/tutorial/booth-support.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/tutorial/booth-support.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,268 @@
+; Centaur Hardware Verification Tutorial
+; Copyright (C) 2012 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+;                  Jared Davis <jared@centtech.com>
+
+
+(in-package "ACL2")
+
+(local (include-book "centaur/bitops/ihs-extensions" :dir :System))
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+(include-book "ihs/basic-definitions" :dir :system)
+(include-book "tools/bstar" :dir :system)
+
+(defun booth-enc-one (a b)
+  (+ (if (logbitp 0 a) b        0)
+     (if (logbitp 1 a) b        0)
+     (if (logbitp 2 a) (* -2 b) 0)))
+
+(local
+ (progn
+   (defund booth-enc-coeff (a)
+     (+ (logcar a)
+        (logext 2 (logcdr a))))
+
+   (defthm booth-enc-one-redef
+     (equal (booth-enc-one a b)
+            (* (booth-enc-coeff a)
+               b))
+     :hints(("Goal" :expand ((:free (n a) (logext n a))
+                             (:free (n a) (logbitp n a)))
+             :in-theory (enable booth-enc-coeff))))
+
+
+
+
+   (defthmd booth-enc-one-impl
+     (implies (integerp b)
+              (equal (booth-enc-one a b)
+                     (b* ((bsign (if (logbitp 2 a) (- b) b))
+                          (shft (iff (logbitp 0 a) (logbitp 1 a)))
+                          (zro (and shft (iff (logbitp 1 a) (logbitp 2 a))))
+                          (res1 (if zro 0 bsign)))
+                       (if shft (* 2 res1) res1))))
+     :hints(("Goal" :in-theory (disable booth-enc-one-redef))))
+   
+
+   (local (in-theory (disable booth-enc-one)))
+
+   (defun booth-sum (n a b)
+     (if (zp n)
+         0
+       (+ (booth-enc-one a b)
+          (* 4 (booth-sum (1- n) (logtail 2 a) b)))))
+
+
+   (local
+    (progn
+      (encapsulate nil
+        (local (defthm floor-1
+                 (implies (integerp x)
+                          (equal (floor x 1) x))
+                 :hints(("Goal" :in-theory (enable floor)))))
+        (local (defthm logcar-of-ash-2
+                 (equal (logcar (ash n 2)) 0)
+                 :hints(("Goal" :in-theory (enable ash**)))))
+        (defthm logcar-of-*-4
+          (implies (integerp n)
+                   (equal (logcar (* 4 n)) 0))
+          :hints (("goal" :use logcar-of-ash-2
+                   :in-theory (enable ash))))
+
+        (local (defthm logcdr-of-ash-2
+                 (equal (logcdr (ash n 2)) (ash n 1))
+                 :hints(("Goal" :in-theory (enable ash**)))))
+        (defthm logcdr-of-*-4
+          (implies (integerp n)
+                   (equal (logcdr (* 4 n))
+                          (* 2 n)))
+          :hints (("goal" :use logcdr-of-ash-2
+                   :in-theory (enable ash)))))
+
+      (defthm logcar-of-logext
+        (equal (logcar (logext n a))
+               (logcar a))
+        :hints(("Goal" :in-theory (enable* ihsext-inductions
+                                           ihsext-recursive-redefs))))
+
+      (defthm sum-negative-prods
+        (implies (syntaxp (and (quotep a) (quotep b)))
+                 (equal (+ (- (* a n)) (* b n) c)
+                        (+ (* (- b a) n) c))))))
+
+   (local (in-theory (disable logext-identity
+                              logtail-identity)))
+
+   (defthm booth-sum-is-multiply
+     (implies (integerp b)
+              (equal (booth-sum n a b)
+                     (let ((m (logext (+ 1 (* 2 (nfix n))) a)))
+                       (* (+ (logcdr m) (logcar m)) b))))
+     :hints(("Goal" :in-theory (e/d* (logcons booth-enc-coeff)
+                                     ((:d booth-sum)))
+             :induct (booth-sum n a b)
+             :expand ((booth-sum n a b)
+                      (:free (a) (logext 1 a))
+                      (:free (a) (logext 2 a))
+                      (:free (a) (logext (* 2 n) a))
+                      (:free (a) (logext (+ 1 (* 2 n)) a))
+                      (:free (a) (logbitp 0 a))
+                      (:free (a) (logbitp 1 a))
+                      (:free (a) (logbitp 2 a))
+                      (:free (a) (logtail 0 a))
+                      (:free (a) (logtail 1 a))
+                      (:free (a) (logtail 2 a))))
+            (and stable-under-simplificationp
+                 `(:use ((:instance logcar-logcdr-elim
+                          (i (logext (+ -1 (* 2 n)) (logcdr (logcdr a))))))))))
+
+
+
+   (defund booth-sum-impl1 (n i a b)
+     (if (zp n)
+         0
+       (+ (ash (booth-enc-one (ash a (- 1 (* 2 i))) b) (* 2 i))
+          (booth-sum-impl1 (1- n) (+ 1 i) a b))))
+
+   (local (defthm integerp-expt-when-not-negp
+            (implies (and (not (negp i))
+                          (integerp b))
+                     (integerp (expt b i)))
+            :hints(("Goal" :in-theory (enable expt)))
+            :rule-classes :type-prescription))
+
+   (local (defthm floor-1-when-integer
+            (implies (integerp i)
+                     (equal (floor i 1) i))
+            :hints(("Goal" :in-theory (enable floor)))))
+
+   (local (defthmd left-shift-to-expt
+            (implies (not (negp shift))
+                     (equal (ash i shift)
+                            (* (ifix i) (expt 2 shift))))
+            :hints(("Goal" :in-theory (enable ash)))))
+
+   (defthm booth-enc-one-integerp
+     (implies (integerp b)
+              (integerp (booth-enc-one a b)))
+     :hints(("Goal" :in-theory (enable booth-enc-one)))
+     :rule-classes :type-prescription)
+
+   (defthm booth-sum-integerp
+     (implies (integerp b)
+              (integerp (booth-sum n a b)))
+     :hints(("Goal" :in-theory (enable booth-sum)))
+     :rule-classes :type-prescription)
+
+   (defthm booth-sum-impl1-is-booth-sum
+     (implies (and (natp i)
+                   (integerp b))
+              (equal (booth-sum-impl1 n i a b)
+                     (ash (booth-sum n (ash a (- 1 (* 2 i))) b) (* 2 i))))
+     :hints(("Goal" :in-theory (e/d (booth-sum booth-sum-impl1 logcons)
+                                    (booth-enc-one-redef
+                                     booth-sum-is-multiply))
+             :induct (booth-sum-impl1 n i a b)
+             :expand ((:free (a) (booth-sum n a b))))
+            (and stable-under-simplificationp
+                 '(:in-theory (e/d (left-shift-to-expt)
+                                   (booth-enc-one-redef
+                                    booth-sum-is-multiply))))))
+
+
+
+   (defthm logext-of-loghead-when-signed-byte-p
+     (implies (signed-byte-p n x)
+              (equal (logext n (loghead n x))
+                     x))
+     :hints(("Goal" :in-theory (e/d* (ihsext-recursive-redefs
+                                      ihsext-inductions)
+                                     (signed-byte-p)))))
+
+   (defthm booth-enc-coeff-lower-bound
+     (<= -2 (booth-enc-coeff a))
+     :hints(("Goal" :in-theory (enable booth-enc-coeff logcons)
+             :expand ((:free (a) (logext 2 a))
+                      (:free (a) (logext 1 a))
+                      (:free (a) (logext 0 a)))))
+     :rule-classes :linear)
+
+   (defthm booth-enc-coeff-upper-bound
+     (<= (booth-enc-coeff a) 2)
+     :hints(("Goal" :in-theory (enable booth-enc-coeff logcons)
+             :expand ((:free (a) (logext 2 a))
+                      (:free (a) (logext 1 a))
+                      (:free (a) (logext 0 a)))))
+     :rule-classes :linear)
+
+
+
+   (local (defthmd minus-of-*
+            (implies (syntaxp (quotep a))
+                     (equal (- (* a b))
+                            (* (- a) b)))))
+
+   (defthm signed-byte-p-of-booth-enc-one
+     (implies (signed-byte-p (+ -2 n) b)
+              (signed-byte-p n (booth-enc-one a b)))
+     :hints(("Goal" :in-theory (e/d (booth-enc-one-redef)
+                                    (booth-enc-one
+                                     exponents-add))
+             :expand ((expt 2 (+ -1 n))
+                      (expt 2 (+ -2 n)))
+             :do-not-induct t)
+            (and stable-under-simplificationp
+                 '(:cases ((equal (booth-enc-coeff a) -2)
+                           (equal (booth-enc-coeff a) -1)
+                           (equal (booth-enc-coeff a) 0)
+                           (equal (booth-enc-coeff a) 1)
+                           (equal (booth-enc-coeff a) 2))))))
+
+   ))
+
+(defund boothmul-pp-spec (sz i a b)
+  (loghead (+ 2 sz) (booth-enc-one (ash a (- 1 (* 2 i)))
+                                   (logext sz b))))
+
+(defund booth-sum-impl (n i a b sz)
+  (if (zp n)
+      0
+    (+ (ash (logext (+ 2 sz) (boothmul-pp-spec sz i a b)) (* 2 i))
+       (booth-sum-impl (1- n) (+ 1 i) a b sz))))
+
+(local
+ (defthm booth-sum-impl-is-booth-sum-impl1
+   (implies (posp sz)
+            (equal (booth-sum-impl n i a b sz)
+                   (booth-sum-impl1 n i a (logext sz b))))
+   :hints(("Goal" :in-theory (e/d* (booth-sum-impl
+                                    boothmul-pp-spec
+                                    booth-sum-impl1)
+                                   (booth-sum-impl1-is-booth-sum
+                                    booth-enc-one-redef
+                                    booth-enc-one
+                                    signed-byte-p))))))
+
+(defthm booth-sum-impl-is-multiply
+  (implies (and (integerp b)
+                (posp sz)
+                (posp n))
+           (equal (booth-sum-impl n 0 a b sz)
+                  (* (logext sz b) (logext (* 2 n) a))))
+  :hints (("goal" :expand ((LOGEXT (+ 1 (* 2 N)) (ASH A 1))))))
diff -Nru acl2-6.2/books/centaur/tutorial/boothmul.lisp acl2-6.3/books/centaur/tutorial/boothmul.lisp
--- acl2-6.2/books/centaur/tutorial/boothmul.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/tutorial/boothmul.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,255 @@
+; Centaur Hardware Verification Tutorial
+; Copyright (C) 2012 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Sol Swords <sswords@centtech.com>
+;                  Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "intro")
+(include-book "centaur/gl/bfr-satlink" :dir :system)
+(include-book "booth-support")
+(value-triple (set-max-mem (* 3 (expt 2 30))))
+(value-triple (tshell-ensure))
+; cert_param: (hons-only)
+
+(make-event
+
+; Disabling waterfall parallelism for unknown reasons other than that
+; certification stalls out with it enabled.
+
+ (if (and (hons-enabledp state)
+          (f-get-global 'parallel-execution-enabled state))
+     (er-progn (set-waterfall-parallelism nil)
+               (value '(value-triple nil)))
+   (value '(value-triple nil))))
+
+; (depends-on "boothmul.v")
+(defmodules *boothmul-translation*
+  (vl::make-vl-loadconfig
+   :start-files (list "boothmul.v")))
+
+(defconst *boothmul*
+  (b* ((mods  (vl::vl-translation->mods *boothmul-translation*))
+       (boothmul (vl::vl-find-module "boothmul" mods))
+       ((unless boothmul)
+        (er hard? '*boothmul* "Failed to translate boothmul?"))
+       (esim  (vl::vl-module->esim boothmul))
+       ((unless (good-esim-modulep esim))
+        (er hard? '*boothmul* "Failed to produce a good esim module")))
+    esim))
+
+(defstv boothmul-direct
+  :mod *boothmul*
+  :inputs '(("a"   a)
+            ("b"   b))
+  :outputs '(("o"    o))
+  :parents (esim-tutorial) ;; xdoc stuff, not needed
+  )
+
+;; This is becoming UNTENABLE
+;; (def-gl-thm boothmul-correct-direct
+;;   :hyp (boothmul-direct-autohyps)
+;;   :concl (b* ((in-alist  (boothmul-direct-autoins))
+;;               (out-alist (stv-run (boothmul-direct) in-alist))
+;;               (o         (cdr (assoc 'o out-alist))))
+;;            (equal o (* a b)))
+;;   :g-bindings (boothmul-direct-autobinds)
+;;   :rule-classes nil)
+
+;; (stv-run (boothmul-direct) (list (cons 'a 3)
+;;                             (cons 'b 5)))
+
+
+(gl::gl-satlink-mode)
+
+(defstv boothmul-decomp
+  :mod *boothmul*
+  :inputs '(("a"   a)
+            ("b"   b))
+  :outputs '(("o"    o))
+  :internals '(("minusb" minusb)
+               ("temp_1" temp1))
+  :overrides '(("pp0" pp0)
+               ("pp1" pp1)
+               ("pp2" pp2)
+               ("pp3" pp3)
+               ("pp4" pp4)
+               ("pp5" pp5)
+               ("pp6" pp6)
+               ("pp7" pp7))
+  :parents (esim-tutorial) ;; xdoc stuff, not needed
+  )
+
+
+(defun hexify-nums (x)
+  (if (atom x)
+      (if (natp x)
+          (str::hexify x)
+        x)
+    (cons (hexify-nums (car x))
+          (hexify-nums (cdr x)))))
+
+
+(local
+ (progn
+   (defun my-glucose-config ()
+     (declare (xargs :guard t))
+     (satlink::make-config :cmdline "glucose"
+                           :verbose t
+                           :mintime 1/2
+                           :remove-temps t))
+
+   (defattach gl::gl-satlink-config my-glucose-config)))
+; cert_param: (uses-glucose)        
+
+
+(def-gl-thm boothmul-pp-correct
+  :hyp (boothmul-decomp-autohyps)
+  :concl (b* ((in-alist  (boothmul-decomp-autoins))
+              (out-alist (stv-run (boothmul-decomp) in-alist)))
+           (and (equal (cdr (assoc 'pp0 out-alist)) (boothmul-pp-spec 16 #x0 a b))
+                (equal (cdr (assoc 'pp1 out-alist)) (boothmul-pp-spec 16 #x1 a b))
+                (equal (cdr (assoc 'pp2 out-alist)) (boothmul-pp-spec 16 #x2 a b))
+                (equal (cdr (assoc 'pp3 out-alist)) (boothmul-pp-spec 16 #x3 a b))
+                (equal (cdr (assoc 'pp4 out-alist)) (boothmul-pp-spec 16 #x4 a b))
+                (equal (cdr (assoc 'pp5 out-alist)) (boothmul-pp-spec 16 #x5 a b))
+                (equal (cdr (assoc 'pp6 out-alist)) (boothmul-pp-spec 16 #x6 a b))
+                (equal (cdr (assoc 'pp7 out-alist)) (boothmul-pp-spec 16 #x7 a b))
+                ))
+  :g-bindings (boothmul-decomp-autobinds))
+
+(def-gl-thm boothmul-sum-correct
+  :hyp (boothmul-decomp-autohyps)
+  :concl (b* ((in-alist  (boothmul-decomp-autoins))
+              (out-alist (stv-run (boothmul-decomp) in-alist))
+              (o (cdr (assoc 'o out-alist)))
+              (- (cw "o: ~s0~%" (str::hexify o)))
+              (res (loghead 32
+                            (+ (ash (logext 18 pp0) #x0)
+                               (ash (logext 18 pp1) #x2)
+                               (ash (logext 18 pp2) #x4)
+                               (ash (logext 18 pp3) #x6)
+                               (ash (logext 18 pp4) #x8)
+                               (ash (logext 18 pp5) #xa)
+                               (ash (logext 18 pp6) #xc)
+                               (ash (logext 18 pp7) #xe))))
+              (- (cw "res: ~s0~%" (str::hexify res))))
+           (equal o res))
+  :g-bindings (boothmul-decomp-autobinds))
+
+
+;; these actually slow down the proof below, but cause it to show explicitly
+;; how booth-sum-impl is expanded into the sum of partial-products that we need
+;; below in booth-sum-of-products-correct.
+(local (defund unhide (x) x))
+(local (defthm unhide-hide
+         (equal (unhide (hide x)) x)
+         :hints (("goal" :in-theory (enable unhide)
+                  :expand ((:free (x) (hide x)))))))
+(local (defthm booth-sum-impl-redef
+         (equal (booth-sum-impl n i a b sz)
+                (IF (ZP N)
+                    0
+                    (+ (ASH (LOGEXT (+ 2 SZ)
+                                    (BOOTHMUL-PP-SPEC SZ I A B))
+                            (* 2 I))
+                       (unhide (hide (BOOTH-SUM-IMPL (1- N)
+                                                     (+ 1 I)
+                                                     A B SZ))))))
+         :hints(("Goal" :in-theory (enable booth-sum-impl)))))
+
+;; this wouldn't be a GL theorem, typically, at least for large N
+;; left as a fun arithmetical exercise
+(defthm booth-sum-of-products-correct
+  (implies (boothmul-direct-autohyps)
+           (let ((pp0 (boothmul-pp-spec 16 #x0 a b))
+                 (pp1 (boothmul-pp-spec 16 #x1 a b))
+                 (pp2 (boothmul-pp-spec 16 #x2 a b))
+                 (pp3 (boothmul-pp-spec 16 #x3 a b))
+                 (pp4 (boothmul-pp-spec 16 #x4 a b))
+                 (pp5 (boothmul-pp-spec 16 #x5 a b))
+                 (pp6 (boothmul-pp-spec 16 #x6 a b))
+                 (pp7 (boothmul-pp-spec 16 #x7 a b)))
+             (equal (+ (ash (logext 18 pp0) #x0)
+                       (ash (logext 18 pp1) #x2)
+                       (ash (logext 18 pp2) #x4)
+                       (ash (logext 18 pp3) #x6)
+                       (ash (logext 18 pp4) #x8)
+                       (ash (logext 18 pp5) #xa)
+                       (ash (logext 18 pp6) #xc)
+                       (ash (logext 18 pp7) #xe))
+                    (* (logext 16 a)
+                       (logext 16 b)))))
+  :hints (("goal" :use ((:instance booth-sum-impl-is-multiply
+                         (n 8) (sz 16)))
+           :in-theory (e/d ()
+                           (booth-sum-impl-is-multiply
+                            ash
+                            signed-byte-p
+                            boothmul-pp-spec)))))
+
+
+;; ideally we'd do this as a theorem solely about sexpr composition, but AIG
+;; mode works pretty well too and is easier
+(def-gl-thm boothmul-decomp-is-boothmul
+  :hyp (boothmul-decomp-autohyps)
+  :concl (b* ((in-alist1 (boothmul-decomp-autoins))
+              (out-alist1 (stv-run (boothmul-decomp) in-alist1))
+              ((assocs pp0
+                       pp1
+                       pp2
+                       pp3
+                       pp4
+                       pp5
+                       pp6
+                       pp7) out-alist1)
+              (in-alist2 (boothmul-decomp-autoins))
+              (out-alist2 (stv-run (boothmul-decomp) in-alist2))
+              (orig-in-alist (boothmul-direct-autoins))
+              (orig-out-alist (stv-run (boothmul-direct) orig-in-alist)))
+           (equal (cdr (assoc 'o out-alist2))
+                  (cdr (assoc 'o orig-out-alist))))
+  :g-bindings (boothmul-decomp-autobinds))
+
+
+(defthm boothmul-pp-spec-bound
+  (< (boothmul-pp-spec 16 i a b) (expt 2 18))
+  :hints(("Goal" :in-theory (enable boothmul-pp-spec)))
+  :rule-classes :linear)
+
+(defthm boothmul-correct
+  (implies (boothmul-direct-autohyps)
+           (b* ((in-alist  (boothmul-direct-autoins))
+                (out-alist (stv-run (boothmul-direct) in-alist))
+                (o         (cdr (assoc 'o out-alist))))
+             (equal o (loghead 32 (* (logext 16 a) (logext 16 b))))))
+  :hints (("goal" :in-theory (disable stv-run
+                                      (boothmul-direct) boothmul-direct
+                                      (boothmul-decomp) boothmul-decomp
+                                      boothmul-decomp-is-boothmul
+                                      ash-of-n-0
+                                      right-shift-to-logtail)
+           :use ((:instance boothmul-decomp-is-boothmul
+                            (pp0 0)
+                            (pp1 0)
+                            (pp2 0)
+                            (pp3 0)
+                            (pp4 0)
+                            (pp5 0)
+                            (pp6 0)
+                            (pp7 0))))))
diff -Nru acl2-6.2/books/centaur/tutorial/boothmul.v acl2-6.3/books/centaur/tutorial/boothmul.v
--- acl2-6.2/books/centaur/tutorial/boothmul.v	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/tutorial/boothmul.v	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,89 @@
+/*
+
+Centaur Hardware Verification Tutorial
+Copyright (C) 2012-2013 Centaur Technology
+
+Contact:
+  Centaur Technology Formal Verification Group
+  7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+  http://www.centtech.com/
+
+This program is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free Software
+Foundation; either version 2 of the License, or (at your option) any later
+version.  This program is distributed in the hope that it will be useful but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+details.  You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software Foundation, Inc.,
+51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+Original authors: Sol Swords <sswords@centtech.com>
+                  Jared Davis <jared@centtech.com>
+
+*/
+
+
+// assumes minusb = - b.
+// computes pp = b * (signed(abits[2:1]) + abits[0]).
+module boothenc (pp, abits, b, minusb);
+  output [17:0] pp;
+  input [2:0] abits;
+  input [15:0] b;
+  input [16:0] minusb;
+
+  wire [16:0] bsign = abits[2] ? minusb : { b[15], b };
+
+   // is it shifted?
+  wire shft = abits[0] ~^ abits[1];
+
+   // is it zero? (all abits same)
+  wire zro = shft & (abits[2] ~^ abits[1]);
+
+   // result without the shift
+  wire [16:0] res1 = zro ? 16'b0 : bsign;
+
+   // final shift
+  wire [17:0] pp = shft ? { res1, 1'b0 } : { res1[16], res1 };
+
+endmodule
+
+   
+
+module boothmul (o, a, b);
+
+  output [31:0] o;
+  input [15:0] a, b;
+
+  wire [16:0] minusb = 17'b1 + ~{ b[15], b };
+
+  wire [17:0] pp0;
+  wire [17:0] pp1;
+  wire [17:0] pp2;
+  wire [17:0] pp3;
+  wire [17:0] pp4;
+  wire [17:0] pp5;
+  wire [17:0] pp6;
+  wire [17:0] pp7;
+
+   boothenc booth0 (pp0, { a[1:0], 1'b0 }, b, minusb);
+   boothenc booth1 (pp1, a[3:1], b, minusb);
+   boothenc booth2 (pp2, a[5:3], b, minusb);
+   boothenc booth3 (pp3, a[7:5], b, minusb);
+   boothenc booth4 (pp4, a[9:7], b, minusb);
+   boothenc booth5 (pp5, a[11:9], b, minusb);
+   boothenc booth6 (pp6, a[13:11], b, minusb);
+   boothenc booth7 (pp7, a[15:13], b, minusb);
+
+   assign o = { {14{pp0[17]}}, pp0 }
+	      + { {12{pp1[17]}}, pp1, 2'b0 }
+	      + { {10{pp2[17]}}, pp2, 4'b0 }
+	      + { {8{pp3[17]}}, pp3, 6'b0 }
+	      + { {6{pp4[17]}}, pp4, 8'b0 }
+	      + { {4{pp5[17]}}, pp5, 10'b0 }
+	      + { {2{pp6[17]}}, pp6, 12'b0 }
+	      + { pp7, 14'b0 };
+
+endmodule
+
+
diff -Nru acl2-6.2/books/centaur/tutorial/counter.lisp acl2-6.3/books/centaur/tutorial/counter.lisp
--- acl2-6.2/books/centaur/tutorial/counter.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/tutorial/counter.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -61,13 +61,9 @@
   (vl::vl-module->esim *counter-vl*))
 
 
-
 (defstv counter-run         ;; name for this test vector
   :mod *counter*            ;; the module this vector pertains to
 
-  :initial
-  '(("out"    init))  ; initial value for the counter
-
   :inputs
   '(("clk"    0 ~)  ; clk will toggle
 
@@ -88,8 +84,12 @@
    ;           v   .   v   .   v   .   v   .   v
   '(("out"    o0   _  o1   _  o2   _  o3   _  o4 _))   ; extract out before each posedge
 
+  :overrides
+  '(("out"    init _))  ; initial value for the counter
+
+
   ;; I'll use this as a chance to also show off the documentation features.
-  :labels '(c0  c1 c1  c2 c2  c3 c3  c4 c4)
+  :labels '(c0  c1 c1  c2 c2  c3 c3  c4 c4  c5)
   :parents (esim-tutorial)
   :short "Running the counter module"
   :long "<p>This is a demo of the defstv documentation stuff.  You can see what
@@ -97,8 +97,6 @@
 centaur/README.html if you don't know where to look.</p>")
 
 
-
-
 ; Some basic examples of running the counter.
 
 #||
diff -Nru acl2-6.2/books/centaur/tutorial/sat.lsp acl2-6.3/books/centaur/tutorial/sat.lsp
--- acl2-6.2/books/centaur/tutorial/sat.lsp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/tutorial/sat.lsp	2013-09-30 17:53:14.000000000 +0000
@@ -109,6 +109,8 @@
 ;
 ;    Glucose version 2.1
 ;       https://www.lri.fr/~simon/?page=glucose
+;       Some packages Rager needed in order to build glocuse included:
+;       g++ and libc6-dev-i386
 ;
 ; But probably most any solver that is part of the SAT Competition should work,
 ; modulo a few concerns about the input format (see :xdoc satlink::dimacs).
@@ -121,10 +123,10 @@
 
 
 ; The particular SAT solver that SATLINK will call, and other options about,
-; e.g., what kind of debugging information will printed, whether temporary
+; e.g., what kind of debugging information will be printed, whether temporary
 ; files should be removed, etc., are governed by a configuration object.  For
-; details, see :XDOC satlink::config-p.  GL will use whatever configuration
-; is returned by:
+; details, see :XDOC satlink::config-p.  GL will use whatever configuration is
+; returned by:
 
 (gl::gl-satlink-config)
 
@@ -186,7 +188,9 @@
   '(("opcode" op)           ;; verilog name --> inputs we are going to supply
     ("abus"   a)            ;;                  at each phase
     ("bbus"   b))           ;; we only have one phase, so we'll just supply a
-                            ;; variable for each vector.
+                            ;; variable for each vector (note that we do not
+                            ;; yet need to specify anything related to the
+                            ;; length of the vectors).
 
   :outputs                  ;; verilog name --> variable names we will use
   '(("out"    res)))
diff -Nru acl2-6.2/books/centaur/ubdds/core.lisp acl2-6.3/books/centaur/ubdds/core.lisp
--- acl2-6.2/books/centaur/ubdds/core.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/ubdds/core.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -28,7 +28,10 @@
 (include-book "xdoc/top" :dir :system)
 
 (defxdoc ubdds
-  :short "A BDD package implemented with @(see hons-and-memoization)."
+  :parents (boolean-reasoning)
+  :short "A @(see hons)-based, unlabeled <a
+href='http://en.wikipedia.org/wiki/Binary_decision_diagram'>Binary Decision
+Diagram</a> (bdd) representation of Boolean functions."
 
   :long "<p>UBDDs (\"unlabeled bdds\") are a concise and efficient
 implementation of binary decision diagrams.  Unlike most BDD packages, our
diff -Nru acl2-6.2/books/centaur/ubdds/deps.lisp acl2-6.3/books/centaur/ubdds/deps.lisp
--- acl2-6.2/books/centaur/ubdds/deps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/ubdds/deps.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -0,0 +1,220 @@
+; UBDD Library
+; Copyright (C) 2008-2011 Warren Hunt and Bob Boyer
+; Significantly revised in 2008 by Jared Davis and Sol Swords.
+; Now maintained by Centaur Technology.
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+; deps.lisp - tracking variable dependencies of BDDs
+
+(in-package "ACL2")
+(include-book "extra-operations")
+
+
+;; UBDD-DEPS: Produce a list of Ts and NILs indicating which variables the input
+;; BDD depends on.
+
+(defn or-lists (x y)
+  (if (atom x)
+      y
+    (if (atom y) x
+      (cons (or (car x) (car y))
+            (or-lists (cdr x) (cdr y))))))
+
+(defthm nth-of-or-lists
+  (equal (nth n (or-lists x y))
+         (or (nth n x) (nth n y))))
+
+(in-theory (disable or-lists))
+
+
+(defn ubdd-deps (x)
+  (if (atom x)
+      nil
+    (cons (not (hons-equal (car x) (cdr x)))
+          (or-lists (ubdd-deps (car x)) (ubdd-deps (cdr x))))))
+
+(memoize 'ubdd-deps :condition '(consp x))
+
+(in-theory (disable ubdd-deps))
+
+(local (defun eval-ubdd-deps-ind (x n env)
+         (if (atom x)
+             (list n env)
+           (if (car env)
+               (eval-ubdd-deps-ind (car x) (1- n) (cdr env))
+             (eval-ubdd-deps-ind (cdr x) (1- n) (cdr env))))))
+
+(defthm eval-bdd-of-update-when-not-dependent
+  (implies (not (nth n (ubdd-deps x)))
+           (equal (eval-bdd x (update-nth n v env))
+                  (eval-bdd x env)))
+  :hints (("goal" :induct (eval-ubdd-deps-ind x n env)
+           :in-theory (enable (:i eval-bdd))
+           :expand ((:free (env) (eval-bdd x env))
+                    (ubdd-deps x)
+                    (:free (a b) (nth n (cons a b)))))))
+
+(local (defun bdd-deps-ind (x n)
+         (if (zp n)
+             x
+           (list (bdd-deps-ind (car x) (1- n))
+                 (bdd-deps-ind (cdr x) (1- n))))))
+
+(local (defun 2bdd-deps-ind (x y n)
+         (if (zp n)
+             (list x y)
+           (list (2bdd-deps-ind (car x) (car y) (1- n))
+                 (2bdd-deps-ind (cdr x) (cdr y) (1- n))))))
+
+(local (defun q-ite-deps-ind (x y z n)
+         (declare (xargs :measure (nfix n)))
+         (if (zp n)
+             (list x y z)
+           (list (q-ite-deps-ind (car x)
+                                 (if (hons-equal x y) t (qcar y))
+                                 (if (hons-equal x z) nil (qcar z))
+                                 (1- n))
+                 (q-ite-deps-ind (cdr x)
+                                 (if (hons-equal x y) t (qcdr y))
+                                 (if (hons-equal x z) nil (qcdr z))
+                                 (1- n))))))
+
+
+(local (in-theory (disable equal-of-booleans-rewrite)))
+
+(local (defthm nth-ubdd-deps-of-qcons
+         (equal (nth n (ubdd-deps (qcons x y)))
+                (if (zp n)
+                    (not (equal x y))
+                  (nth (1- n) (or-lists (ubdd-deps x) (ubdd-deps y)))))
+         :hints(("Goal" :in-theory (enable ubdd-deps)))))
+
+(local (defthm nth-ubdd-deps-of-cons
+         (equal (nth n (ubdd-deps (cons x y)))
+                (if (zp n)
+                    (not (equal x y))
+                  (nth (1- n) (or-lists (ubdd-deps x) (ubdd-deps y)))))
+         :hints(("Goal" :in-theory (enable ubdd-deps)))))
+
+(local (defthm nth-of-ubdd-deps-when-zp
+         (implies (and (syntaxp (symbolp x))
+                       (zp n))
+                  (equal (nth n (ubdd-deps x))
+                         (not (equal (car x) (cdr x)))))
+         :hints(("Goal" :in-theory (enable ubdd-deps)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(local (defthm nth-of-ubdd-deps-when-not-zp
+         (implies (and (syntaxp (symbolp x))
+                       (not (zp n)))
+                  (equal (nth n (ubdd-deps x))
+                         (nth (1- n) (or-lists
+                                      (ubdd-deps (car x))
+                                      (ubdd-deps (cdr x))))))
+         :hints(("Goal" :in-theory (enable ubdd-deps)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+  
+
+(local (in-theory (disable qcons nth)))
+
+(local (defthm nth-of-nil
+         (not (nth n nil))
+         :hints(("Goal" :in-theory (enable nth)))))
+
+(local (defthm or-lists-identical
+         (equal (or-lists x x)
+                x)
+         :hints(("Goal" :in-theory (enable or-lists)))))
+
+(defthm ubdd-deps-of-qv
+  (equal (ubdd-deps (qv n))
+         (update-nth n t nil))
+  :hints(("Goal" :in-theory (enable (:i qv))
+          :induct (qv n)
+          :expand ((qv n)
+                   (:free (x y) (ubdd-deps (cons x y)))))))
+
+;; BOZO may also prove that if (nth n (ubdd-deps x)) and (ubddp x), then there
+;; exists some env, v under which
+;; (eval-bdd x env) != (eval-bdd x (update-nth n v env)).
+
+;; Stronger theorems may be proved provided X is ubddp.  At the moment I'll
+;; just prove simple conservative stuff.
+
+(defthm q-not-no-new-deps
+  (implies (not (nth n (ubdd-deps x)))
+           (not (nth n (ubdd-deps (q-not x)))))
+  :hints (("goal" :induct (bdd-deps-ind x n))))
+
+
+(defthm q-and-no-new-deps
+  (implies (and (not (nth n (ubdd-deps x)))
+                (not (nth n (ubdd-deps y))))
+           (not (nth n (ubdd-deps (q-binary-and x y)))))
+  :hints (("goal" :induct (2bdd-deps-ind x y n)
+           :in-theory (disable (force))
+           :expand ((q-binary-and x y)))))
+
+(defthm q-or-no-new-deps
+  (implies (and (not (nth n (ubdd-deps x)))
+                (not (nth n (ubdd-deps y))))
+           (not (nth n (ubdd-deps (q-binary-or x y)))))
+  :hints (("goal" :induct (2bdd-deps-ind x y n)
+           :in-theory (disable (force))
+           :expand ((q-binary-or x y)))))
+
+
+(defthm q-xor-no-new-deps
+  (implies (and (not (nth n (ubdd-deps x)))
+                (not (nth n (ubdd-deps y))))
+           (not (nth n (ubdd-deps (q-binary-xor x y)))))
+  :hints (("goal" :induct (2bdd-deps-ind x y n)
+           :in-theory (disable (force))
+           :expand ((q-binary-xor x y)))))
+
+(defthm q-iff-no-new-deps
+  (implies (and (not (nth n (ubdd-deps x)))
+                (not (nth n (ubdd-deps y))))
+           (not (nth n (ubdd-deps (q-binary-iff x y)))))
+  :hints (("goal" :induct (2bdd-deps-ind x y n)
+           :in-theory (disable (force))
+           :expand ((q-binary-iff x y)))))
+
+(defthm ubdd-deps-of-atom
+  (implies (not (consp x))
+           (equal (ubdd-deps x) nil))
+  :hints(("Goal" :in-theory (enable ubdd-deps)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+; Added by Matt K., 9/28/2013, to get around ACL2(hp) error such as:
+;   Error:  Not owner of hash table #<HASH-TABLE :TEST EQL size 3/62 #x30200BB9920D>
+; David Rager points out (email, 9/28/2013) that "memoization is known
+; not to be thread-safe"; Jared Davis says this too.  (Perhaps this will be
+; addressed in the future.)
+(local (unmemoize 'ubdd-deps))
+
+(defthm q-ite-no-new-deps
+  (implies (and (not (nth n (ubdd-deps x)))
+                (not (nth n (ubdd-deps y)))
+                (not (nth n (ubdd-deps z))))
+           (not (nth n (ubdd-deps (q-ite-fn x y z)))))
+  :hints (("goal" :induct (q-ite-deps-ind x y z n)
+           :in-theory (disable (force))
+           :expand ((q-ite-fn x y z)
+                    (:free (a b) (nth n (cons a b)))))))
+
+
diff -Nru acl2-6.2/books/centaur/ubdds/extra-operations.lisp acl2-6.3/books/centaur/ubdds/extra-operations.lisp
--- acl2-6.2/books/centaur/ubdds/extra-operations.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/ubdds/extra-operations.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -1498,6 +1498,8 @@
 
   (local (in-theory (enable ubdd-fix)))
 
+  (memoize 'ubdd-fix :condition '(consp x))
+
   (defthm ubddp-ubdd-fix
     (ubddp (ubdd-fix x))
     :hints(("Goal" :in-theory (enable ubddp))))
diff -Nru acl2-6.2/books/centaur/ubdds/param.lisp acl2-6.3/books/centaur/ubdds/param.lisp
--- acl2-6.2/books/centaur/ubdds/param.lisp	2013-06-06 17:11:47.000000000 +0000
+++ acl2-6.3/books/centaur/ubdds/param.lisp	2013-09-30 17:53:14.000000000 +0000
@@ -29,14 +29,14 @@
 
 (local (include-book "arithmetic/top" :dir :system))
 
-(in-theory (disable* default-car default-cdr ;; blp-implies-t
-                     default-+-2 default-+-1 default-<-2 default-<-1
-                     (:ruleset canonicalize-to-q-ite)
-                     equal-by-eval-bdds
-                     ))
+(local (in-theory (disable* default-car default-cdr ;; blp-implies-t
+                            default-+-2 default-+-1 default-<-2 default-<-1
+                            (:ruleset canonicalize-to-q-ite)
+                            equal-by-eval-bdds
+                            )))
 
-(in-theory (enable eval-bdd eval-bdd-list ubddp ubdd-listp
-                   q-compose q-compose-list))
+(local (in-theory (enable eval-bdd eval-bdd-list ubddp ubdd-listp
+                          q-compose q-compose-list)))
 
 (make-event
 
@@ -147,8 +147,7 @@
 ;; more.  2) only holds for variable assignments of length NVARS.
 (defn q-param (x nvars)
   (cond ((zp (nfix nvars)) nil)
-        ((atom x) (if x (qv-list 0 1 nvars)
-                    (make-list-ac nvars nil nil)))
+        ((atom x) (qv-list 0 1 nvars))
         ((not (car x))
          (cons nil (q-param (cdr x) (1- nvars))))
         ((not (cdr x))
@@ -709,7 +708,7 @@
 (memoize 'from-param-space :condition '(or (consp p) (consp y)))
 
 (defn to-param-space (p y)
-  (cond ((atom p) (if p y nil))
+  (cond ((atom p) y)
         ((atom y) y)
         ((eq (car p) nil)
          (to-param-space (cdr p) (cdr y)))
@@ -734,8 +733,8 @@
 
 (defun param-env (p env)
   (declare (xargs :guard t))
-  (cond ((atom env) nil)
-        ((atom p) env)
+  (cond ((atom p) env)
+        ((atom env) nil)
         ((eq (car p) nil) (param-env (cdr p) (cdr env)))
         ((eq (cdr p) nil) (param-env (car p) (cdr env)))
         ((car env) (cons t (param-env (car p) (cdr env))))
@@ -759,10 +758,35 @@
              (cons car (unparam-env (if car (car p) (cdr p))
                                     cdr))))))
 
+
+(encapsulate
+  nil
+  (local (defun ind (x p env)
+           (if (consp x)
+               (if (consp p)
+                   (if (car p)
+                       (if (cdr p)
+                           (if (car env)
+                               (ind (car x) (car p) (cdr env))
+                             (ind (cdr x) (cdr p) (cdr env)))
+                         (ind x (car p) env))
+                     (ind x (cdr p) env))
+                 x)
+             env)))
+
+  (defthm eval-param-env-of-unparam-env
+    (equal (eval-bdd x (param-env p (unparam-env p env)))
+           (eval-bdd x env))
+    :hints (("goal" :induct (ind x p env)
+             :in-theory (enable default-car default-cdr))
+            (and stable-under-simplificationp
+                 '(:expand ((:free (env) (eval-bdd x env))))))))
+
 (defthm eval-with-unparam-env
   (implies (and p (ubddp p))
            (eval-bdd p (unparam-env p env))))
 
+
 (defun unparam-env-ind (x p env)
   (cond ((atom p) (list x env))
         ((eq (car p) nil) (unparam-env-ind (cdr x) (cdr p) env))
@@ -772,15 +796,20 @@
                             (cdr env)))))
 
 (defthmd unparam-env-to-param-space
-  (implies (and p (ubddp p))
-           (equal (eval-bdd (to-param-space p x) env)
-                  (eval-bdd x (unparam-env p env))))
+  (equal (eval-bdd (to-param-space p x) env)
+         (eval-bdd x (unparam-env p env)))
   :hints (("goal" :induct (unparam-env-ind x p env)
            :expand ((:free (env) (eval-bdd x env))
                     (:free (env) (unparam-env p env)))
            :in-theory (enable default-car default-cdr))))
 
-
+(defthm unparam-env-of-param-env
+  (implies (eval-bdd p env)
+           (equal (eval-bdd x (unparam-env p (param-env p env)))
+                  (eval-bdd x env)))
+  :hints (("goal" :use ((:instance param-env-to-param-space)
+                        (:instance unparam-env-to-param-space
+                         (env (param-env p env)))))))
 
 (defn to-param-space-list (p list)
   (if (atom list)
@@ -912,6 +941,47 @@
   :hints (("goal" :induct (to-param-space p x)
            :in-theory (e/d (q-and) (ubddp)))))
 
+(defthm eval-bdd-of-qcons
+  (equal (eval-bdd (qcons x y) env)
+         (if (car env)
+             (eval-bdd x (cdr env))
+           (eval-bdd y (cdr env)))))
+
+(defun to-from-ind (p x env)
+  (if (consp p)
+      (cond ((eq (car p) nil)
+             (and (not (car env))
+                  (to-from-ind (cdr p) (cdr x) (cdr env))))
+            ((eq (cdr p) nil)
+             (and (car env)
+                  (to-from-ind (car p) (car x) (cdr env))))
+            (t (list (to-from-ind (car p) (car x) (cdr env))
+                     (to-from-ind (cdr p) (cdr x) (cdr env)))))
+    (list p x env)))
+    
+
+(defthm from-param-space-of-qcons
+  (implies (and (car p) (cdr p))
+           (equal (from-param-space p (qcons x y))
+                  (if (atom (qcons x y))
+                      (and x p)
+                    (qcons (from-param-space (car p) x)
+                           (from-param-space (cdr p) y)))))
+  :otf-flg t)
+
+(defthm consp-qcons
+  (equal (consp (qcons x y))
+         (not (and (booleanp x)
+                   (equal x y)))))
+
+(defthm to-from-param-space-eval
+  (equal (eval-bdd (from-param-space p (to-param-space p x)) env)
+         (and (eval-bdd p env)
+              (eval-bdd x env)))
+  :hints (("goal" :induct (to-from-ind p x env)
+           :in-theory (disable qcons))))
+
+
 (defthm to-param-space-self
   (implies (and (ubddp p) p)
            (equal (to-param-space p p) t))
@@ -924,3 +994,23 @@
                   x))
   :hints (("goal" :induct (from-param-space p x)
            :in-theory (e/d (q-and) (ubddp)))))
+
+
+
+(defun param-env-ind (x p env)
+  (cond ((atom p) (list x env))
+        ((eq (car p) nil) (param-env-ind x (cdr p) (cdr env)))
+        ((eq (cdr p) nil) (param-env-ind x (car p) (cdr env)))
+        ((car env) (cons t (param-env-ind (car x) (car p) (cdr env))))
+        (t       (cons nil (param-env-ind (cdr x) (cdr p) (cdr env))))))
+
+(defthm eval-of-from-param-space
+  (implies (eval-bdd p env)
+           (equal (eval-bdd (from-param-space p x)
+                            env)
+                  (eval-bdd x (param-env p env))))
+  :hints (("goal" :induct (param-env-ind x p env)
+           :expand ((from-param-space p x)
+                    (unparam-env p env)
+                    (:free (env) (eval-bdd x env))
+                    (eval-bdd p env)))))
diff -Nru acl2-6.2/books/centaur/vcd/esim-snapshot.lisp acl2-6.3/books/centaur/vcd/esim-snapshot.lisp
--- acl2-6.2/books/centaur/vcd/esim-snapshot.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/vcd/esim-snapshot.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -56,7 +56,7 @@
 ;
 ; If you want to directly use the resulting alist in a VCD dump, you'll have to
 ; make sure your values are valid for VCD-DUMP, e.g., they can be concrete
-; FAIGS like *4f*, S-expressions like *4vf*, or results from OT like the
+; FAIGS like (faig-f), S-expressions like *4vf*, or results from OT like the
 ; symbols T, NIL, X, or U.
 ;
 ; However, MOD-VCD-SNAPSHOT doesn't care what values are being used, so for
diff -Nru acl2-6.2/books/centaur/vcd/vcd-impl.lisp acl2-6.3/books/centaur/vcd/vcd-impl.lisp
--- acl2-6.2/books/centaur/vcd/vcd-impl.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/centaur/vcd/vcd-impl.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -22,7 +22,7 @@
 (include-book "vcd-stub")
 (include-book "oslib/date" :dir :system)
 (include-book "centaur/misc/tshell" :dir :system)
-(include-book "centaur/aig/three-four" :dir :system)
+(include-book "centaur/aig/faig-constructors" :dir :system)
 (include-book "centaur/misc/hons-extra" :dir :system)
 (include-book "centaur/vl/util/print" :dir :system)
 (include-book "centaur/vl/toe/toe-emodwire" :dir :system)
@@ -71,7 +71,7 @@
 ; The VALUE bound to each name may be:
 ;
 ;    - Concrete FAIGs
-;          i.e., *4f*, *4t*, *4x*, or *4z*
+;          i.e., (faig-f), (faig-t), (faig-x), or (faig-z)
 ;
 ;    - Concrete S-Expression Results
 ;          i.e., *4vf*, *4vt*, *4vx*, or *4vz*   ('F, 'T, 'X, 'Z)
@@ -147,7 +147,7 @@
      (implies (string-listp x)
               (iff (first (last x))
                    (consp x)))
-     :hints(("Goal" :in-theory (disable (force)))))
+     :hints(("Goal" :in-theory (e/d (last) ((force))))))
 
    (defthm stringp-of-car-when-string-listp
      (implies (string-listp x)
@@ -306,10 +306,10 @@
   (defund vcd-value-p (x)
     (declare (xargs :guard t))
     (if (consp x)
-        (or (equal x acl2::*4f*)
-            (equal x acl2::*4t*)
-            (equal x acl2::*4x*)
-            (equal x acl2::*4z*))
+        (or (equal x (acl2::faig-f))
+            (equal x (acl2::faig-t))
+            (equal x (acl2::faig-x))
+            (equal x (acl2::faig-z)))
       (or (eq x nil)
           (eq x 'acl2::f)
           (eq x t)
@@ -323,10 +323,10 @@
           (er hard? 'vcd-value->char "Not a vcd-value-p: ~x0." x)
           #\x)
          ((when (consp x))
-          (cond ((equal x acl2::*4f*) #\0)
-                ((equal x acl2::*4t*) #\1)
-                ((equal x acl2::*4z*) #\z)
-                (t                    #\x))))
+          (cond ((equal x (acl2::faig-f)) #\0)
+                ((equal x (acl2::faig-t)) #\1)
+                ((equal x (acl2::faig-z)) #\z)
+                (t                        #\x))))
       (case x
         ((nil acl2::f) #\0)
         ((t)           #\1)
@@ -341,10 +341,10 @@
      (assert! (equal (vcd-value->char 'acl2::x) #\x))
      (assert! (equal (vcd-value->char 'acl2::z) #\z))
      (assert! (equal (vcd-value->char 'acl2::u) #\z))
-     (assert! (equal (vcd-value->char acl2::*4f*) #\0))
-     (assert! (equal (vcd-value->char acl2::*4t*) #\1))
-     (assert! (equal (vcd-value->char acl2::*4x*) #\x))
-     (assert! (equal (vcd-value->char acl2::*4z*) #\z)))))
+     (assert! (equal (vcd-value->char (acl2::faig-f)) #\0))
+     (assert! (equal (vcd-value->char (acl2::faig-t)) #\1))
+     (assert! (equal (vcd-value->char (acl2::faig-x)) #\x))
+     (assert! (equal (vcd-value->char (acl2::faig-z)) #\z)))))
 
 
 (defsection vcd-valuelist-p
@@ -1826,4 +1826,4 @@
 (progn!
  (set-raw-mode t)
  (defun vcd-dump-fn (filename snapshots viewer emap state)
-   (vcd-dump-fn-real filename snapshots viewer emap state)))
\ No newline at end of file
+   (vcd-dump-fn-real filename snapshots viewer emap state)))
diff -Nru acl2-6.2/books/centaur/vl/Makefile acl2-6.3/books/centaur/vl/Makefile
--- acl2-6.2/books/centaur/vl/Makefile	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-# ACL2 ?= ../../acl2/saved_acl2
-# include ../../acl2/books/Makefile-generic
-#
-# # Dependencies:
-#
-# BOOKS := $(filter-out acl2-customization,$(BOOKS))
-# ACL2_COMPILE_FLG := t :ttags :all :skip-proofs-okp t
-#
-# LISPFILES = $(wildcard *.lisp)
-# LSPFILES = $(wildcard *.lsp)
-# ACL2FILES = $(wildcard *.acl2)
-#
-# TAGS: $(LISPFILES)
-# 	etags *.lisp
-#
-# -include Makefile-deps
-
-
-.PHONY: all full clean TAGS
-
-all:
-	@echo "Use cert.pl to build"
-	@echo "Or use 'make full', which runs 'cert.pl -j 8' to build VL."
-	@echo ""
-
-allbooks:
-	cert.pl -j 8 top.cert lint/lint.cert
-
-full: allbooks
-
-TAGS:
-	@echo "Building TAGS"
-	etags `find . -name "*.lisp"` `find . -name "*.lsp"` `find . -name "*.acl2"`
-
-CLEANFILES := *.cert *.lx64fsl *.out *.time *~
-
-clean:
-	rm -f $(CLEANFILES) TAGS 
-	cd loader; rm -f $(CLEANFILES)
-	cd util; rm -f $(CLEANFILES)
-	cd transforms; rm -f $(CLEANFILES)
-	cd transforms/occform; rm -f $(CLEANFILES)
-	cd checkers; rm -f $(CLEANFILES)
-	cd mlib; rm -f $(CLEANFILES)
-	cd lint -f $(CLEANFILES)
-
diff -Nru acl2-6.2/books/centaur/vl/README acl2-6.3/books/centaur/vl/README
--- acl2-6.2/books/centaur/vl/README	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/README	2013-09-30 17:53:10.000000000 +0000
@@ -90,13 +90,18 @@
   * provides the defmodules command
 
 
+vl/kit/           -- VL as a command-line program
+
+  * this is where the "vl" program gets generated from
+
+vl/bin
 
 
 MISCELLANEOUS STUFF
 
 vl/lint/           -- a basic Verilog linter
 
-vl/doc/            -- a couple of (old) presentations about VL
+vl/talks/          -- some old talks about VL
 
-vl/wf-*.lisp       -- well-formedness checks
+vl/wf-*.lisp       -- well-formedness checks (mostly old)
 
diff -Nru acl2-6.2/books/centaur/vl/checkers/condcheck.lisp acl2-6.3/books/centaur/vl/checkers/condcheck.lisp
--- acl2-6.2/books/centaur/vl/checkers/condcheck.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/checkers/condcheck.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -320,8 +320,8 @@
 (define vl-exprctxalist-condcheck ((x vl-exprctxalist-p))
   :returns (warnings vl-warninglist-p)
   :parents (condcheck)
-  :short "@(call vl-exprctxalist-condcheck) extends @(see
-vl-expr-condcheck-check) across an @(see vl-exprctxalist-p)."
+  :short "@(call vl-exprctxalist-condcheck) extends @(see vl-expr-condcheck)
+across an @(see vl-exprctxalist-p)."
 
   (if (atom x)
       nil
diff -Nru acl2-6.2/books/centaur/vl/checkers/dupeinst-check.lisp acl2-6.3/books/centaur/vl/checkers/dupeinst-check.lisp
--- acl2-6.2/books/centaur/vl/checkers/dupeinst-check.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/checkers/dupeinst-check.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -1,5 +1,5 @@
 ; VL Verilog Toolkit
-; Copyright (C) 2008-2011 Centaur Technology
+; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -23,6 +23,7 @@
 (include-book "duplicate-detect")
 (local (include-book "../util/arithmetic"))
 
+
 (defxdoc dupeinst-check
   :parents (checkers)
   :short "Check for module instances that are driving wires in identical ways."
@@ -46,46 +47,47 @@
 want to identify and eliminate.  For instance, it's especially useful to
 eliminate redundant registers, to improve power usage.</p>")
 
+
 (defaggregate vl-dupeinst-key
-  (modname inputs)
-  :tag :vl-dupeinst-key
-  :require ((vl-exprlist-p-of-vl-dupeinst-key->inputs
-             (vl-exprlist-p inputs))
-            (stringp-of-vl-dupeinst-key->modname
-             (stringp modname)
-             :rule-classes :type-prescription))
   :parents (dupeinst-check)
   :short "Keys used to determine if module instances have the same inputs."
 
+  ((modname stringp :rule-classes :type-prescription
+            "Name of the submodule being instantiated.  We need to know the
+             name of each instance so that we don't get confused by things
+             like
+
+             @({
+                 mymod1 m1 (o1, a, b);
+                 mymod2 m2 (o2, a, b);
+             })
+
+             which, despite having the same arguments, are presumably very
+             different things.")
+
+   (inputs  vl-exprlist-p
+            "Inputs (not outputs or inouts) to the submodule instance.  We
+             expect instances to be argresolved so that these are already in
+             some canonical order.  We just keep the expressions because we
+             don't care about port names, directions, etc.  We also expect all
+             of these expressions to be fixed so that attributes are
+             ignored."))
+
   :long "<p>We generate a key from each modinst.  Modinsts with the same keys
 are regarded as having the same inputs.  That is, the whole point of the
 dupeinst check is to find modinsts with the same key.</p>
 
-<p>The keys we use have to know the modname so we don't get confused by things
-like</p>
-
-@({
-  mymod1 m1 (o1, a, b);
-  mymod2 m2 (o2, a, b);
-})
-
-<p>Which presumably have the same inputs but are very different things.</p>
-
-<p>They also include the expressions for the inputs.  We expect instances to be
-argresolved so that these are already in some canonical order.  We just keep
-the expressions because we don't care about port names, directions, etc.  We
-also expect all of these expressions to be fixed so that attributes are
-ignored.</p>
-
-<p>Our keys should arguably include the params.  But if the inputs are the
-same, then the params should probably be the same or, at any rate, seem
-basically compatible?  Well, whatever.  It's questionable, but probably doesn't
-matter much at all in practice.</p>
+<p>Our keys should arguably include the parameter arguments.  But if the inputs
+are the same, then the parameters should probably be the same or, at any rate,
+seem basically compatible?  Well, whatever.  It probably doesn't matter much at
+all in practice.</p>
 
 <p>We always hons keys because we're going to use them as fast alist keys.</p>"
 
+  :tag :vl-dupeinst-key
   :hons t)
 
+
 (defalist vl-dupeinst-alistp (x)
   :key (vl-dupeinst-key-p x)
   :val (vl-modinstlist-p x)
@@ -97,90 +99,61 @@
 @(def vl-dupeinst-alistp)")
 
 
-(defsection vl-make-dupeinst-alist
-  :parents (dupeinst-check)
-  :short "Builds the @(see vl-dupeinst-alistp) for a list of assignments."
-
-  (defund vl-make-dupeinst-alist-aux (x alist)
-    (declare (xargs :guard (and (vl-modinstlist-p x)
-                                (vl-dupeinst-alistp alist))))
-    (b* (((when (atom x))
-          alist)
-         (x1 (car x))
-         ((vl-modinst x1) x1)
-
-         ((when (vl-arguments->namedp x1.portargs))
-          ;; Args not resolved, skip it
-          (vl-make-dupeinst-alist-aux (cdr x) alist))
-
-         ((mv inputs ?outputs inouts unknowns)
-          (vl-partition-plainargs (vl-arguments->args x1.portargs) nil nil nil nil))
-
-         ((unless (and (atom inouts)
-                       (atom unknowns)))
-          ;; Too hard, skip it
-          (vl-make-dupeinst-alist-aux (cdr x) alist))
-
-         (ins    (vl-plainarglist->exprs inputs))
-         ((when (member nil ins))
-          ;; Blanks?  screw it, skip it.
-          (vl-make-dupeinst-alist-aux (cdr x) alist))
-         (ins    (vl-exprlist-fix ins))
-         (key    (make-vl-dupeinst-key :modname x1.modname :inputs ins))
-         (look   (hons-get key alist))
-         (alist  (hons-acons key (cons x1 (cdr look)) alist)))
-      (vl-make-dupeinst-alist-aux (cdr x) alist)))
-
-  (local (in-theory (enable vl-make-dupeinst-alist-aux)))
-
-  (defthm vl-dupeinst-alistp-of-vl-make-dupeinst-alist-aux
-    (implies (and (vl-modinstlist-p x)
-                  (vl-dupeinst-alistp alist))
-             (vl-dupeinst-alistp (vl-make-dupeinst-alist-aux x alist))))
-
-  (defund vl-make-dupeinst-alist (x)
-    "Returns a slow alist."
-    (declare (xargs :guard (vl-modinstlist-p x)))
-    (b* ((alist (len x))
-         (alist (vl-make-dupeinst-alist-aux x alist))
-         (ans   (hons-shrink-alist alist nil)))
-      (fast-alist-free alist)
-      (fast-alist-free ans)
-      ans))
-
-  (local (in-theory (enable vl-make-dupeinst-alist)))
-
-  (defthm vl-dupeinst-alistp-of-vl-make-dupeinst-alist
-    (implies (force (vl-modinstlist-p x))
-             (vl-dupeinst-alistp (vl-make-dupeinst-alist x)))))
-
-
+(define vl-make-dupeinst-alist-aux
+  ((x     vl-modinstlist-p)
+   (alist vl-dupeinst-alistp))
+  :returns (new-alist vl-dupeinst-alistp :hyp :fguard)
+  :parents (vl-make-dupeinst-alist)
+  (b* (((when (atom x))
+        alist)
+       (x1 (car x))
+       ((vl-modinst x1) x1)
+
+       ((when (vl-arguments->namedp x1.portargs))
+        ;; Args not resolved, skip it
+        (vl-make-dupeinst-alist-aux (cdr x) alist))
+
+       ((mv inputs ?outputs inouts unknowns)
+        (vl-partition-plainargs (vl-arguments->args x1.portargs) nil nil nil nil))
+
+       ((unless (and (atom inouts)
+                     (atom unknowns)))
+        ;; Too hard, skip it
+        (vl-make-dupeinst-alist-aux (cdr x) alist))
+
+       (ins    (vl-plainarglist->exprs inputs))
+       ((when (member nil ins))
+        ;; Blanks?  screw it, skip it.
+        (vl-make-dupeinst-alist-aux (cdr x) alist))
+       (ins    (vl-exprlist-fix ins))
+       (key    (make-vl-dupeinst-key :modname x1.modname :inputs ins))
+       (look   (hons-get key alist))
+       (alist  (hons-acons key (cons x1 (cdr look)) alist)))
+    (vl-make-dupeinst-alist-aux (cdr x) alist)))
 
-(defsection vl-maybe-warn-dupeinst
+(define vl-make-dupeinst-alist ((x vl-modinstlist-p))
+  :returns (alist vl-dupeinst-alistp :hyp :fguard)
   :parents (dupeinst-check)
-  :short "Possibly add warnings about a group of module instances."
-  :long "<p><b>Signature:</b> @(call vl-maybe-warn-dupeinst) returns
-@('warnings'').</p>
-
-<ul>
+  :short "Builds a (slow) @(see vl-dupeinst-alistp) for a list of assignments."
 
-<li>@('key') is the shared @(see vl-dupeinst-key-p) for a group of
-modinsts.</li>
+  (b* ((alist (len x))
+       (alist (vl-make-dupeinst-alist-aux x alist))
+       (ans   (hons-shrink-alist alist nil)))
+    (fast-alist-free alist)
+    (fast-alist-free ans)
+    ans))
 
-<li>@('modinsts') are the modinsts that share this key.</li>
 
-<li>@('warnings') is the @(see warnings) accumulator to extend.</li>
-
-</ul>
+(defsection vl-dupeinst-trivial-p
+  :parents (dupeinst-check)
+  :short "Customizable filter for duplicate module instances."
 
-<p>Modinsts might not have multiple entries, in which case there is nothing to
-do and we just return @('warnings') unchanged.  Otherwise, we issue a warning
-about the modules.</p>
+  :long "<p>By default, all duplicated modules are considered worth warning
+about.  But you can configure which modules are considered trivial/okay to
+duplicate by attaching a function to @('vl-dupeinst-trivial-p').  These will be
+filtered out into minor warnings.</p>
 
-<p>By default, all duplicated modules are considered worth warning about.  But
-you can configure which modules are considered trivial/okay to duplicate by
-attaching a function to @('vl-dupeinst-trivial-p').  These will be filtered out
-into minor warnings.</p>"
+@(def vl-dupeinst-trivial-p)"
 
   (encapsulate
     (((vl-dupeinst-trivial-p *) => *
@@ -197,125 +170,107 @@
              (ignore modname))
     nil)
 
-  (defattach vl-dupeinst-trivial-p vl-dupeinst-trivial-p-default)
+  (defattach vl-dupeinst-trivial-p vl-dupeinst-trivial-p-default))
 
-  (defun vl-modinstlist-fixed-up-outs (x)
-    (declare (xargs :guard (vl-modinstlist-p x)))
-    (b* (((when (atom x))
-          nil)
-         ((vl-modinst x1) (car x))
-         ((when (vl-arguments->namedp x1.portargs))
-          (er hard? 'vl-modinstlist-fixed-up-outs "expected resolved args"))
-         ((mv ?inputs outputs ?inouts ?unknowns)
-          (vl-partition-plainargs (vl-arguments->args x1.portargs) nil nil nil nil))
-         (outexprs (vl-plainarglist->exprs outputs))
-         (fixed-outexprs (if (member nil outexprs)
-                             ;; Can't fix them up because there are blanks.  Well, who
-                             ;; cares.  We'll just leave them unfixed.
-                             outexprs
-                           (vl-exprlist-fix outexprs))))
-      (cons fixed-outexprs
-            (vl-modinstlist-fixed-up-outs (cdr x)))))
-
-  (defund vl-maybe-warn-dupeinst (key modinsts warnings)
-    "Returns WARNINGS'"
-    (declare (xargs :guard (and (vl-dupeinst-key-p key)
-                                (vl-modinstlist-p modinsts)
-                                (vl-warninglist-p warnings)))
-             (ignorable key))
-    (b* (((when (or (atom modinsts)
-                    (atom (cdr modinsts))))
-          ;; Nothing to do -- there isn't more than one assignment for this RHS.
-          warnings)
-
-         ;; BOZO maybe filter some of this stuff?
-
-         (fixed-up-outs (vl-modinstlist-fixed-up-outs modinsts))
-         (dupes         (duplicated-members fixed-up-outs))
-
-         (modname (vl-dupeinst-key->modname key))
-         (minor-p (vl-dupeinst-trivial-p modname))
-
-         (w (make-vl-warning
-             :type (if (consp dupes)
-                       (if minor-p :vl-warn-same-ports-minor :vl-warn-same-ports)
-                     (if minor-p :vl-warn-same-inputs-minor :vl-warn-same-inputs))
-             :msg "Found instances of the same module with ~s0:~%~%~s1"
-             :args (list (if (consp dupes)
-                             "the same arguments"
-                           "the same inputs (but different outputs)")
-                         (str::prefix-lines (with-local-ps
-                                             ;; may help avoid unnecessary line wrapping
-                                             (vl-ps-update-autowrap-col 200)
-                                             (vl-pp-modinstlist modinsts nil nil))
-                                            "     ")
-                         ;; These aren't printed, but we include them in the
-                         ;; warning so our suppression mechanism can be
-                         ;; applied.
-                         modinsts)
-             :fatalp nil
-             :fn 'vl-maybe-warn-dupeinst)))
-      (cons w warnings)))
-
-  (local (in-theory (enable vl-maybe-warn-dupeinst)))
-
-  (defthm vl-warninglist-p-of-vl-maybe-warn-dupeinst
-    (implies (force (vl-warninglist-p warnings))
-             (vl-warninglist-p (vl-maybe-warn-dupeinst rhs modinsts warnings)))))
 
 
-(defsection vl-warnings-for-dupeinst-alist
+(define vl-modinstlist-fixed-up-outs ((x vl-modinstlist-p))
+  :parents (vl-maybe-warn-dupeinst)
+  :short "Extract the @(see vl-expr-fix)ed outputs from each module instance."
+  (b* (((when (atom x))
+        nil)
+       ((vl-modinst x1) (car x))
+       ((when (vl-arguments->namedp x1.portargs))
+        (raise "expected resolved args"))
+       ((mv ?inputs outputs ?inouts ?unknowns)
+        (vl-partition-plainargs (vl-arguments->args x1.portargs) nil nil nil nil))
+       (outexprs (vl-plainarglist->exprs outputs))
+       (fixed-outexprs (if (member nil outexprs)
+                           ;; Can't fix them up because there are blanks.
+                           ;; Well, who cares.  We'll just leave them unfixed.
+                           outexprs
+                         (vl-exprlist-fix outexprs))))
+    (cons fixed-outexprs
+          (vl-modinstlist-fixed-up-outs (cdr x)))))
+
+(define vl-maybe-warn-dupeinst
+  ((key      vl-dupeinst-key-p "The shared key for a group of modinsts.")
+   (modinsts vl-modinstlist-p  "The modinsts that share this key.")
+   (warnings vl-warninglist-p  "The @(see warnings) accumulator to extend."))
+  :returns (new-warnings vl-warninglist-p
+                         :hyp (force (vl-warninglist-p warnings)))
   :parents (dupeinst-check)
-
-  (defund vl-warnings-for-dupeinst-alist (alist warnings)
-    (declare (xargs :guard (and (vl-dupeinst-alistp alist)
-                                (vl-warninglist-p warnings))))
-    (b* (((when (atom alist))
-          warnings)
-         (rhs      (caar alist))
-         (assigns  (cdar alist))
-         (warnings (vl-maybe-warn-dupeinst rhs assigns warnings)))
-      (vl-warnings-for-dupeinst-alist (cdr alist) warnings)))
-
-  (local (in-theory (enable vl-warnings-for-dupeinst-alist)))
-
-  (defthm vl-warninglist-p-of-vl-warnings-for-dupeinst-alist
-    (implies (force (vl-warninglist-p warnings))
-             (vl-warninglist-p (vl-warnings-for-dupeinst-alist alist warnings)))))
-
-
-(defsection vl-module-dupeinst-check
+  :short "Possibly add warnings about a group of module instances."
+  :long "<p>Modinsts might not have multiple entries, in which case there is
+nothing to do and we just return @('warnings') unchanged.  Otherwise, we issue
+a warning about the modules.</p>"
+
+  (b* (((when (or (atom modinsts)
+                  (atom (cdr modinsts))))
+        ;; Nothing to do -- there isn't more than one assignment for this RHS.
+        warnings)
+
+       ;; BOZO maybe filter some of this stuff?
+
+       (fixed-up-outs (vl-modinstlist-fixed-up-outs modinsts))
+       (dupes         (duplicated-members fixed-up-outs))
+
+       (modname (vl-dupeinst-key->modname key))
+       (minor-p (vl-dupeinst-trivial-p modname))
+
+       (w (make-vl-warning
+           :type (if (consp dupes)
+                     (if minor-p :vl-warn-same-ports-minor :vl-warn-same-ports)
+                   (if minor-p :vl-warn-same-inputs-minor :vl-warn-same-inputs))
+           :msg "Found instances of the same module with ~s0:~%~%~s1"
+           :args (list (if (consp dupes)
+                           "the same arguments"
+                         "the same inputs (but different outputs)")
+                       (str::prefix-lines (with-local-ps
+                                           ;; may help avoid unnecessary line wrapping
+                                           (vl-ps-update-autowrap-col 200)
+                                           (vl-pp-modinstlist modinsts nil nil))
+                                          "     ")
+                       ;; These aren't printed, but we include them in the
+                       ;; warning so our suppression mechanism can be
+                       ;; applied.
+                       modinsts)
+           :fatalp nil
+           :fn 'vl-maybe-warn-dupeinst)))
+    (cons w warnings)))
+
+
+(define vl-warnings-for-dupeinst-alist ((alist    vl-dupeinst-alistp)
+                                        (warnings vl-warninglist-p))
+  :returns (new-warnings vl-warninglist-p
+                         :hyp (force (vl-warninglist-p warnings)))
   :parents (dupeinst-check)
+  (b* (((when (atom alist))
+        warnings)
+       (rhs      (caar alist))
+       (assigns  (cdar alist))
+       (warnings (vl-maybe-warn-dupeinst rhs assigns warnings)))
+    (vl-warnings-for-dupeinst-alist (cdr alist) warnings)))
 
-  (defund vl-module-dupeinst-check (x)
-    (declare (xargs :guard (vl-module-p x)))
-    (b* (((vl-module x) x)
-         (alist    (vl-make-dupeinst-alist x.modinsts))
-         (warnings (vl-warnings-for-dupeinst-alist alist x.warnings)))
-      (change-vl-module x :warnings warnings)))
-
-  (local (in-theory (enable vl-module-dupeinst-check)))
-
-  (defthm vl-module-p-of-vl-module-dupeinst-check
-    (implies (force (vl-module-p x))
-             (vl-module-p (vl-module-dupeinst-check x))))
 
+(define vl-module-dupeinst-check ((x vl-module-p))
+  :parents (dupeinst-check)
+  :returns (new-x vl-module-p :hyp :fguard)
+  (b* (((vl-module x) x)
+       (alist    (vl-make-dupeinst-alist x.modinsts))
+       (warnings (vl-warnings-for-dupeinst-alist alist x.warnings)))
+    (change-vl-module x :warnings warnings))
+  ///
   (defthm vl-module->name-of-vl-module-dupeinst-check
     (equal (vl-module->name (vl-module-dupeinst-check x))
            (vl-module->name x))))
 
-
-(defsection vl-modulelist-dupeinst-check
+(defprojection vl-modulelist-dupeinst-check (x)
+  (vl-module-dupeinst-check x)
+  :guard (vl-modulelist-p x)
+  :result-type vl-modulelist-p
   :parents (dupeinst-check)
-
-  (defprojection vl-modulelist-dupeinst-check (x)
-    (vl-module-dupeinst-check x)
-    :guard (vl-modulelist-p x)
-    :result-type vl-modulelist-p
-    :parents (dupeinst-check))
-
-  (defthm vl-modulelist->names-of-vl-modulelist-dupeinst-check
-    (equal (vl-modulelist->names (vl-modulelist-dupeinst-check x))
-           (vl-modulelist->names x))
-    :hints(("Goal" :induct (len x)))))
+  :rest ((defthm vl-modulelist->names-of-vl-modulelist-dupeinst-check
+           (equal (vl-modulelist->names (vl-modulelist-dupeinst-check x))
+                  (vl-modulelist->names x)))))
 
diff -Nru acl2-6.2/books/centaur/vl/checkers/duperhs.lisp acl2-6.3/books/centaur/vl/checkers/duperhs.lisp
--- acl2-6.2/books/centaur/vl/checkers/duperhs.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/checkers/duperhs.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -45,169 +45,149 @@
   :valp-of-nil t
   :parents (duperhs-check))
 
+(define vl-make-duperhs-alist-aux ((x     vl-assignlist-p)
+                                   (alist vl-duperhs-alistp))
+  :returns (new-alist vl-duperhs-alistp :hyp :guard)
+  :parents (duperhs-check)
+  (b* (((when (atom x))
+        alist)
+       (x1 (car x))
+       ((vl-assign x1) x1)
+       (rhs1 (hons-copy (vl-expr-fix x1.expr)))
+       (look (hons-get rhs1 alist))
+       ;; It doesn't matter if it exists or not, just add it in.
+       (alist (hons-acons rhs1 (cons x1 (cdr look)) alist)))
+    (vl-make-duperhs-alist-aux (cdr x) alist)))
 
-(defsection vl-make-duperhs-alist
+(define vl-make-duperhs-alist ((x vl-assignlist-p))
+  :returns (alist "A slow alist."vl-duperhs-alistp :hyp :fguard)
   :parents (duperhs-check)
   :short "Builds the @(see vl-duperhs-alistp) for a list of assignments."
+  (b* ((alist (len x))
+       (alist (vl-make-duperhs-alist-aux x alist))
+       (ans   (hons-shrink-alist alist nil)))
+    (fast-alist-free alist)
+    (fast-alist-free ans)
+    ans))
+
+(define vl-duperhs-too-trivial-p
+  ((rhs vl-expr-p "The rhs shared by some list of assignments."))
+  :returns (trivial-p "Is this too trivial to warn about?"
+                      booleanp :rule-classes :type-prescription)
+  :parents (duperhs-check)
+  :short "Heuristic to avoid warning about assigning simple, common right-hand
+sides to multiple wires."
+
+  :long "<p>It seems fine to assign a constant, weirdint, real, or string to
+multiple wires; this is especially frequent for things like 0 and 1, so we
+don't want to warn in these cases.</p>
+
+<p>We'll just suppress warnings for any atoms other than identifiers.  This
+will allow us to still flag situations like:</p>
+
+@({
+     assign wire1 = wirefoo;
+     assign wire2 = wirefoo;
+})
+
+<p>I later decided I wanted to extend this, and additionally not cause warnings
+for odd but innocuous things like @('~ 1'b0') and @('{1'b0}').</p>"
+
+  (b* (((when (vl-fast-atom-p rhs))
+        (not (vl-fast-id-p (vl-atom->guts rhs))))
+       ((vl-nonatom rhs) rhs))
+    (and (or (eq rhs.op :vl-unary-bitnot)
+             (eq rhs.op :vl-concat))
+         (tuplep 1 rhs.args)
+         (vl-fast-atom-p (first rhs.args))
+         (not (vl-fast-id-p (vl-atom->guts (first rhs.args)))))))
+
+(define vl-maybe-warn-duperhs
+  :parents (duperhs-check)
+  :short "Create warnings for assignments that share some RHS."
+  ((rhs      vl-expr-p        "The shared RHS among all these assignments")
+   (assigns  vl-assignlist-p  "A list of assignments that share this RHS.")
+   (warnings vl-warninglist-p "A warnings accumulator to extend."))
+  :returns (new-warnings vl-warninglist-p
+                         :hyp (force (vl-warninglist-p warnings)))
+  (b* (((when (or (atom assigns)
+                  (atom (cdr assigns))))
+        ;; Nothing to do -- there isn't more than one assignment for this RHS.
+        warnings)
+
+       ((when (vl-duperhs-too-trivial-p rhs))
+        warnings)
+
+       (rhs-names (vl-expr-names rhs))
+       (special-names (append (str::collect-strs-with-isubstr "ph1" rhs-names)
+                              (str::collect-strs-with-isubstr "reset" rhs-names)
+                              (str::collect-strs-with-isubstr "clear" rhs-names)
+                              (str::collect-strs-with-isubstr "enable" rhs-names)
+                              (str::collect-strs-with-isubstr "clken" rhs-names)
+                              (str::collect-strs-with-isubstr "valid" rhs-names)
+                              ))
+       ((when (consp special-names))
+        ;; It's common for the same expression to be used multiple times for
+        ;; clock enables and for a clock to go multiple places, so try to
+        ;; filter this out.
+        warnings)
+
+       ;; BOZO maybe filter out other things? (reset, done, clear, stuff like
+       ;; that, by name?)
+       (w (make-vl-warning
+           :type :vl-warn-same-rhs
+           :msg "Found assignments that have exactly the same right-hand ~
+                 side, which might indicate a copy/paste error:~%~s0"
+           :args (list (str::prefix-lines (with-local-ps
+                                           ;; may help avoid unnecessary line wrapping
+                                           (vl-ps-update-autowrap-col 200)
+                                           (vl-pp-assignlist assigns))
+                                          "     ")
+                       ;; These aren't printed, but we include them in the
+                       ;; warning so our warning-suppression mechanism can be
+                       ;; applied.
+                       assigns)
+           :fatalp nil
+           :fn 'vl-maybe-warn-duperhs)))
+    (cons w warnings)))
 
-  (defund vl-make-duperhs-alist-aux (x alist)
-    (declare (xargs :guard (and (vl-assignlist-p x)
-                                (vl-duperhs-alistp alist))))
-    (b* (((when (atom x))
-          alist)
-         (x1 (car x))
-         ((vl-assign x1) x1)
-         (rhs1 (hons-copy (vl-expr-fix x1.expr)))
-         (look (hons-get rhs1 alist))
-         ;; It doesn't matter if it exists or not, just add it in.
-         (alist (hons-acons rhs1 (cons x1 (cdr look)) alist)))
-      (vl-make-duperhs-alist-aux (cdr x) alist)))
-
-  (local (in-theory (enable vl-make-duperhs-alist-aux)))
-
-  (defthm vl-duperhs-alistp-of-vl-make-duperhs-alist-aux
-    (implies (and (vl-assignlist-p x)
-                  (vl-duperhs-alistp alist))
-             (vl-duperhs-alistp (vl-make-duperhs-alist-aux x alist))))
-
-  (defund vl-make-duperhs-alist (x)
-    "Returns a slow alist."
-    (declare (xargs :guard (vl-assignlist-p x)))
-    (b* ((alist (len x))
-         (alist (vl-make-duperhs-alist-aux x alist))
-         (ans   (hons-shrink-alist alist nil)))
-      (fast-alist-free alist)
-      (fast-alist-free ans)
-      ans))
-
-  (local (in-theory (enable vl-make-duperhs-alist)))
-
-  (defthm vl-duperhs-alistp-of-vl-make-duperhs-alist
-    (implies (force (vl-assignlist-p x))
-             (vl-duperhs-alistp (vl-make-duperhs-alist x)))))
-
-
-(defsection vl-maybe-warn-duperhs
-  :parents (duperhs-check)
-
-  (defund vl-maybe-warn-duperhs
-    (rhs      ;; The shared RHS among all these assignments
-     assigns  ;; A list of assignments that share this RHS.
-     warnings ;; Warnings accumulator to extend
-     )
-    "Returns WARNINGS'"
-    (declare (xargs :guard (and (vl-expr-p rhs)
-                                (vl-assignlist-p assigns))))
-    (b* (((when (or (atom assigns)
-                    (atom (cdr assigns))))
-          ;; Nothing to do -- there isn't more than one assignment for this RHS.
-          warnings)
-
-         ((when (and (vl-fast-atom-p rhs)
-                     (not (vl-fast-id-p (vl-atom->guts rhs)))))
-          ;; It seems fine to assign a constant, weirdint, real, or string to
-          ;; multiple wires; this is especially frequent for things like 0 and
-          ;; 1, so don't warn in these cases.  However, note that we explicitly
-          ;; exclude identifiers here, so if we have a situation like:
-          ;;   assign wire1 = wirefoo;
-          ;;   assign wire2 = wirefoo;
-          ;; Then we'll still flag it, it might be a copy/paste error.
-          warnings)
-
-         (rhs-names (vl-expr-names rhs))
-         (special-names (append (str::collect-strs-with-isubstr "ph1" rhs-names)
-                                (str::collect-strs-with-isubstr "reset" rhs-names)
-                                (str::collect-strs-with-isubstr "clear" rhs-names)
-                                (str::collect-strs-with-isubstr "enable" rhs-names)
-                                (str::collect-strs-with-isubstr "clken" rhs-names)
-                                (str::collect-strs-with-isubstr "valid" rhs-names)
-                                ))
-         ((when (consp special-names))
-          ;; It's common for the same expression to be used multiple times for clock
-          ;; enables and for a clock to go multiple places, so try to filter this out.
-          warnings)
-
-         ;; BOZO maybe filter out other things? (reset, done, clear, stuff like
-         ;; that, by name?)
-         (w (make-vl-warning
-             :type :vl-warn-same-rhs
-             :msg "Found assignments that have exactly the same right-hand ~
-                   side, which might indicate a copy/paste error:~%~s0"
-             :args (list (str::prefix-lines (with-local-ps
-                                             ;; may help avoid unnecessary line wrapping
-                                             (vl-ps-update-autowrap-col 200)
-                                             (vl-pp-assignlist assigns))
-                                            "     ")
-                         ;; These aren't printed, but we include them in the
-                         ;; warning so our suppression mechanism can be
-                         ;; applied.
-                         assigns)
-             :fatalp nil
-             :fn 'vl-maybe-warn-duperhs)))
-      (cons w warnings)))
-
-  (local (in-theory (enable vl-maybe-warn-duperhs)))
-
-  (defthm vl-warninglist-p-of-vl-maybe-warn-duperhs
-    (implies (force (vl-warninglist-p warnings))
-             (vl-warninglist-p (vl-maybe-warn-duperhs rhs assigns warnings)))))
-
-
-(defsection vl-warnings-for-duperhs-alist
-  :parents (duperhs-check)
-
-  (defund vl-warnings-for-duperhs-alist (alist warnings)
-    (declare (xargs :guard (and (vl-duperhs-alistp alist)
-                                (vl-warninglist-p warnings))))
-    (b* (((when (atom alist))
-          warnings)
-         (rhs      (caar alist))
-         (assigns  (cdar alist))
-         (warnings (vl-maybe-warn-duperhs rhs assigns warnings)))
-      (vl-warnings-for-duperhs-alist (cdr alist) warnings)))
-
-  (local (in-theory (enable vl-warnings-for-duperhs-alist)))
-
-  (defthm vl-warninglist-p-of-vl-warnings-for-duperhs-alist
-    (implies (force (vl-warninglist-p warnings))
-             (vl-warninglist-p (vl-warnings-for-duperhs-alist alist warnings)))))
-
-
-
-(defsection vl-module-duperhs-check
-  :parents (duperhs-check)
-
-  (defund vl-module-duperhs-check (x)
-    (declare (xargs :guard (vl-module-p x)))
-    (b* (((vl-module x) x)
-         (alist    (vl-make-duperhs-alist x.assigns))
-;         (- (cw "Alist has ~x0 entries.~%" (len alist)))
-         (warnings (vl-warnings-for-duperhs-alist alist x.warnings)))
-      (change-vl-module x :warnings warnings)))
-
-  (local (in-theory (enable vl-module-duperhs-check)))
-
-  (defthm vl-module-p-of-vl-module-duperhs-check
-    (implies (force (vl-module-p x))
-             (vl-module-p (vl-module-duperhs-check x))))
 
+(define vl-warnings-for-duperhs-alist
+  :parents (duperhs-check)
+  ((alist    vl-duperhs-alistp  "The duperhs alist we've built for some module.")
+   (warnings vl-warninglist-p   "A warnings accumulator to extend."))
+  :returns (new-warnings vl-warninglist-p
+                         :hyp (force (vl-warninglist-p warnings)))
+  (b* (((when (atom alist))
+        warnings)
+       (rhs      (caar alist))
+       (assigns  (cdar alist))
+       (warnings (vl-maybe-warn-duperhs rhs assigns warnings)))
+    (vl-warnings-for-duperhs-alist (cdr alist) warnings)))
+
+
+(define vl-module-duperhs-check ((x vl-module-p))
+  :parents (duperhs-check)
+  :short "Look for duplicated rhses in a module, and add warnings about them."
+  :returns (new-x "A copy of X, perhaps extended with new warnings."
+                  vl-module-p :hyp :fguard)
+  (b* (((vl-module x) x)
+       (alist    (vl-make-duperhs-alist x.assigns))
+       (warnings (vl-warnings-for-duperhs-alist alist x.warnings)))
+    (change-vl-module x :warnings warnings))
+  ///
   (defthm vl-module->name-of-vl-module-duperhs-check
     (equal (vl-module->name (vl-module-duperhs-check x))
            (vl-module->name x))))
 
 
-(defsection vl-modulelist-duperhs-check
+(defprojection vl-modulelist-duperhs-check (x)
+  (vl-module-duperhs-check x)
+  :guard (vl-modulelist-p x)
+  :result-type vl-modulelist-p
   :parents (duperhs-check)
-
-  (defprojection vl-modulelist-duperhs-check (x)
-    (vl-module-duperhs-check x)
-    :guard (vl-modulelist-p x)
-    :result-type vl-modulelist-p
-    :parents (duperhs-check))
-
-  (defthm vl-modulelist->names-of-vl-modulelist-duperhs-check
-    (equal (vl-modulelist->names (vl-modulelist-duperhs-check x))
-           (vl-modulelist->names x))
-    :hints(("Goal" :induct (len x)))))
+  :rest ((defthm vl-modulelist->names-of-vl-modulelist-duperhs-check
+           (equal (vl-modulelist->names (vl-modulelist-duperhs-check x))
+                  (vl-modulelist->names x)))))
 
 
diff -Nru acl2-6.2/books/centaur/vl/checkers/duplicate-detect.lisp acl2-6.3/books/centaur/vl/checkers/duplicate-detect.lisp
--- acl2-6.2/books/centaur/vl/checkers/duplicate-detect.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/checkers/duplicate-detect.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -25,6 +25,7 @@
 
 
 (defsection vl-atom-fix
+  :parents (vl-expr-fix)
 
   (local (in-theory (enable vl-atom-p
                             vl-atom
@@ -53,6 +54,11 @@
 
 
 (defsection vl-expr-fix
+  :parents (vl-expr-p)
+  :short "Throw away attributes and widths, keeping just the core of an expression."
+  :long "<p>This is often useful when writing heuristic checks where you want
+to look for particular expressions, where attributes and differing sizes are of
+no concern.</p>"
 
 ;; BOZO consider optimizing to avoid reconsing already-fixed expressions
 
diff -Nru acl2-6.2/books/centaur/vl/checkers/qmarksize-check.lisp acl2-6.3/books/centaur/vl/checkers/qmarksize-check.lisp
--- acl2-6.2/books/centaur/vl/checkers/qmarksize-check.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/checkers/qmarksize-check.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -122,7 +122,27 @@
 
           (test-expr (first args))
           (test-size (vl-qmark-test-size test-expr))
-          ((unless (equal test-size 1))
+          ((unless (or (equal test-size 1)
+                       ;; Historically we didn't have this extra exclusion for
+                       ;; nil test sizes.  I later discovered that, e.g., due
+                       ;; to using arrays or other things that VL doesn't
+                       ;; support, we could run into a case like:
+                       ;;
+                       ;;    wire [2:0] foo;
+                       ;;    wire bar;
+                       ;;
+                       ;;    assign foo = bar ? bad-expression : 3'b0;
+                       ;;
+                       ;; Here BAR is a perfectly good expression, but due to
+                       ;; the bad-expression, our sizing code will fail to
+                       ;; assign any size to BAR.
+                       ;;
+                       ;; In this case, the warning we produced was very
+                       ;; confusing because the condition is obviously just a
+                       ;; single bit.  I think it just doesn't make sense to
+                       ;; try to create a warning in this case, so now we will
+                       ;; suppress these.
+                       (not test-size)))
            (cons (make-vl-warning :type :vl-warn-qmark-width
                                   :msg "~a0: ~x1-bit wide \"test\" expression for ?: operator, ~a2."
                                   :args (list ctx test-size test-expr)
diff -Nru acl2-6.2/books/centaur/vl/checkers/typo-detect.lisp acl2-6.3/books/centaur/vl/checkers/typo-detect.lisp
--- acl2-6.2/books/centaur/vl/checkers/typo-detect.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/checkers/typo-detect.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -216,7 +216,7 @@
 
 
 (defconst *typo-special-substrings-chars*
-  (coerce-to-chars-list *typo-special-substrings*))
+  (explode-list *typo-special-substrings*))
 
 (defsection typo-read-special
 
@@ -496,7 +496,7 @@
     (if (atom x)
         nil
       (cons (cons (car x)
-                  (typo-partition (coerce (car x) 'list)))
+                  (typo-partition (explode (car x))))
             (typo-partitioning-alist (cdr x)))))
 
   (local (in-theory (enable typo-partitioning-alist)))
@@ -689,7 +689,7 @@
     (if (atom strs)
         nil
       (let* ((name1      (car strs))
-             (partition1 (typo-partition (coerce name1 'list)))
+             (partition1 (typo-partition (explode name1)))
              (typos1     (typo-find-plausible-typos1 partition1 alist)))
         (if typos1
             (cons (cons name1 typos1)
diff -Nru acl2-6.2/books/centaur/vl/checkers/use-set-report.lisp acl2-6.3/books/centaur/vl/checkers/use-set-report.lisp
--- acl2-6.2/books/centaur/vl/checkers/use-set-report.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/checkers/use-set-report.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -98,7 +98,7 @@
 (define vl-star-names-of-warning-wires ((x             string-listp)
                                         (warning-wires string-listp))
   :returns (new-x string-listp :hyp (force (string-listp x)))
-  :parents (useset)
+  :parents (use-set)
   :short "Change names in @('x') by putting a @('*') in front of any name that
 is among the @('warning-wires')."
   (cond ((atom x)
diff -Nru acl2-6.2/books/centaur/vl/kit/acl2-customization.lsp acl2-6.3/books/centaur/vl/kit/acl2-customization.lsp
--- acl2-6.2/books/centaur/vl/kit/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/acl2-customization.lsp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,22 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(ld "../acl2-customization.lsp")
+(in-package "VL")
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/vl/kit/cert.acl2 acl2-6.3/books/centaur/vl/kit/cert.acl2
--- acl2-6.2/books/centaur/vl/kit/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/cert.acl2	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,27 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+#+gcl (acl2::value :q)
+#+gcl (setq si::*optimize-maximum-pages* nil)
+#+gcl (acl2::lp)
+(include-book "../portcullis")
+; cert-flags: ? t :ttags :all
+
diff -Nru acl2-6.2/books/centaur/vl/kit/json.lisp acl2-6.3/books/centaur/vl/kit/json.lisp
--- acl2-6.2/books/centaur/vl/kit/json.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/json.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,153 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "VL")
+(include-book "../loader/loader")
+(include-book "../mlib/json")
+(include-book "centaur/getopt/top" :dir :system)
+(include-book "std/io/read-file-characters" :dir :system)
+(include-book "progutils")
+(local (include-book "../util/arithmetic"))
+
+(defoptions vl-json-opts
+  :parents (vl-json)
+  :short "Options for running @('vl json')."
+  :tag :vl-json-opts
+
+  ((help        booleanp
+                "Show a brief usage message and exit."
+                :rule-classes :type-prescription
+                :alias #\h)
+
+   (readme      booleanp
+                "Show a more elaborate README and exit."
+                :rule-classes :type-prescription)
+
+   (outfile     (stringp outfile)
+                :argname "FILE"
+                :alias #\o
+                "Write output to FILE.  Default: \"foo.v.json\", where
+                 \"foo.v\" is the first Verilog file provided."
+                :rule-classes :type-prescription
+                :default "")
+
+   (search-path string-listp
+                :longname "search"
+                :alias #\s
+                :argname "DIR"
+                "Search path for finding modules.  You can give this switch
+                 multiple times, to set up multiple search paths in priority
+                 order."
+                :parser getopt::parse-string
+                :merge acl2::rcons)
+
+   (separate    booleanp
+                "Write modules as separate, independent JSON objects instead of
+                 as a single, monolithic object."
+                :rule-classes :type-prescription)
+
+   (mem         posp
+                :alias #\m
+                :argname "GB"
+                "How much memory to try to use.  Default: 4 GB.  Raising this
+                 may improve performance by avoiding garbage collection.  To
+                 avoid swapping, keep this below (physical_memory - 2 GB)."
+                :default 4
+                :rule-classes :type-prescription)
+
+   (debug       booleanp
+                "Print extra information for debugging."
+                :rule-classes :type-prescription)))
+
+(defconst *vl-json-help* (str::cat "
+vl json:  Converts Verilog into JSON, a format that can be easily loaded into
+          scripting languages like Ruby, Perl, etc.
+
+Example:  vl json engine.v wrapper.v core.v \\
+              --search ./simlibs \\
+              --search ./baselibs
+
+Usage:    vl json [OPTIONS] file.v [file2.v ...]
+
+Options:" *nls* *nls* *vl-json-opts-usage* *nls*))
+
+(defconsts (*vl-json-readme* state)
+  (b* (((mv contents state) (acl2::read-file-characters "json.readme" state))
+       ((when (stringp contents))
+        (raise contents)
+        (mv "" state)))
+    (mv (implode contents) state)))
+
+(define vl-json ((cmdargs string-listp) &optional (state 'state))
+  :parents (kit)
+  :short "The @('vl json') command."
+
+  (b* (((mv errmsg opts start-files)
+        (parse-vl-json-opts cmdargs))
+       ((when errmsg)
+        (die "~@0~%" errmsg)
+        state)
+
+       ((vl-json-opts opts) opts)
+       (- (acl2::set-max-mem ;; newline to appease cert.pl's scanner
+           (* (expt 2 30) opts.mem)))
+
+       ((when opts.help)
+        (vl-cw-ps-seq (vl-print *vl-json-help*))
+        (exit-ok)
+        state)
+
+       ((when opts.readme)
+        (vl-cw-ps-seq (vl-print *vl-json-readme*))
+        (exit-ok)
+        state)
+
+       ((unless (consp start-files))
+        (die "No files to process.")
+        state)
+       (outfile (if (equal opts.outfile "")
+                    (cat (car start-files) ".json")
+                  opts.outfile))
+
+       (- (or (not opts.debug)
+              (cw "vl json options: ~x0~%" opts)))
+
+       (state (must-be-regular-files! start-files))
+       (state (must-be-directories! opts.search-path))
+
+       (- (cw "Parsing Verilog sources...~%"))
+       ((mv (vl-loadresult res) state)
+        (cwtime (vl-load (make-vl-loadconfig :start-files start-files
+                                             :search-path opts.search-path
+                                             :filemapp nil))))
+
+       (- (cw "JSON-Encoding Modules...~%"))
+       (state
+        (cwtime
+         (with-ps-file outfile
+                       (vl-ps-update-autowrap-col 120)
+                       (vl-ps-update-autowrap-ind 10)
+                       (cwtime (if opts.separate
+                                   (vl-jp-individual-modules res.mods)
+                                 (vl-jp-modalist (vl-modalist res.mods)))
+                               :name vl-json-encode))
+         :name vl-json-export)))
+    (exit-ok)
+    state))
diff -Nru acl2-6.2/books/centaur/vl/kit/json.readme acl2-6.3/books/centaur/vl/kit/json.readme
--- acl2-6.2/books/centaur/vl/kit/json.readme	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/json.readme	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,219 @@
+------------------------------------------------------------------------------
+
+                              VL JSON README
+
+------------------------------------------------------------------------------
+
+You can use VL's "json" tool to write programs that process Verilog code
+
+  - in many languages (Ruby, Perl, Python, ...)
+  - without writing a robust Verilog parser yourself
+  - without using some half-assed "grep"-based parser
+  - with a minimum of fuss
+
+The basic flow is (e.g., for Ruby):
+
+ +----------+   (1)   +------+    (2)    +------------+   (3)   +---------+
+ | Verilog  | ------> | JSON | --------> | Ruby Data  | ------> | Results |
+ |  Files   | vl2json | File | ruby json | (hashes,   |  your   |         |
+ |          |         |      |  parser   |  arrays)   | program |         |
+ +----------+         +------+           +------------+         +---------+
+
+The remainder of this README has:
+
+  1. How to run "vl json" to get the JSON file      (step 1 above)
+
+  2. How to load the JSON file into your program    (step 2 above)
+      - Example scripts for Ruby, Perl, and Python
+      - Performance comparisons of JSON libraries
+
+  3. How to write your program                      (step 3 above)
+      - Documentation for the JSON data format
+
+  4. Notes
+      - How "vl json" might be adapted to better fit your program
+
+------------------------------------------------------------------------------
+
+                    STEP 1.  GENERATING THE JSON FILE.
+
+To see the available command-line options, just run:
+
+    vl help json
+
+A typical invocation might look like this:
+
+    time vl json my_mod.v \         <-- starting files to load
+            -s libs/my_lib1 \       <-- search paths for finding
+            -s libs/my_lib2              additional modules
+
+If all goes well, this should load my_mod.v and any supporting libraries, then
+translate them all into a JSON file named, e.g., my_mod.v.json.
+
+Note: the JSON-encoded, parsed Verilog is quite verbose!  For instance, a 39 MB
+Verilog test file (plus its libraries, which I didn't try to measure) produced
+a 628 MB output file!
+
+------------------------------------------------------------------------------
+
+                     STEP 2.  PARSING THE JSON FILE.
+
+JSON libraries are available for almost any popular programming language.
+
+  - Ruby, Perl, and Python are discussed below.
+  - For other languages, see http://www.json.org/ or try googling
+
+RUBY.
+
+  Loading JSON data into Ruby is mostly a matter of installing the right gem.
+  Here are some tips:
+
+  The 'json' gem seems really slow.  I also had to add a :max_nesting=>false
+  option to the JSON.parse command, or it would die with an error.  It took a
+  little over 4 minutes to load my test file's JSON encoding.  Example code:
+
+      require 'json'
+      file = File.open("my_file.v.json")
+      text = file.read
+      file.close
+      parsed = JSON.parse(text, :max_nesting=>false)
+
+  I also tried the 'yajl-ruby' gem, but it also seems slow.
+
+  Fortunately, the 'oj' gem seems much faster!  It takes about 50 seconds to
+  load the test file using the following code.  Using :symbol_keys seems to
+  make things about 15% faster, but might not be what you want.  Example code:
+
+      require 'oj'
+      file = File.open("my_file.v.json")
+      text = file.read
+      file.close
+      design = Oj.load(text, :symbol_keys=>true)
+
+  Note that the above are with Ruby 1.9.3p0, which may be slightly old now.
+  Perhaps newer versions of Ruby are faster?
+
+PERL.
+
+  The plain 'JSON' module seems horribly slow (for my test file, I killed the
+  job after it had run for over 90 minutes without finishing).
+
+  The JSON::XS module is extremely fast!  It takes only 30 seconds to run the
+  example script that loads my test file.  Example code:
+
+    use JSON::XS;
+
+    sub read_whole_file {
+      my $filename = shift;
+      open (my $fh, "<", $filename) or die("Can't open $filename: $!\n");
+      local $/ = undef;
+      my $ret = <$fh>;
+      close($fh);
+      return $ret;
+    }
+
+    sub read_json_file {
+      my $filename = shift;
+      my $text = read_whole_file($filename);
+      my $json = new JSON::XS;
+      $json->max_depth(20000);
+      my $ret = $json->decode($text);
+      return $ret;
+    }
+
+    my $design = read_json_file('my_file.v.json');
+
+
+PYTHON.
+
+  The built-in JSON importer is not super fast, but can parse my test file in
+  about 2 minutes.  I did have to up the recursion limit in python to avoid a
+  stack overflow.  Example code:
+
+    import json
+    import sys
+    # Upping the recursion limit seems necessary for reading large designs
+    sys.setrecursionlimit(20000)
+
+    def read_json(filename):
+	with open(filename, 'r') as file:
+	    content = file.read()
+	    return json.loads(content)
+
+    design = read_json("my_file.v.json")
+
+  There's apparently something called ultrajson for Python that makes JSON
+  loading much faster.  I haven't tried it out yet, though.
+
+
+------------------------------------------------------------------------------
+
+                     STEP 3.  WRITING YOUR PROGRAM.
+
+Once you get the Verilog modules loaded into your program, to do anything with
+them you need to know something about the data format.
+
+The top-level JSON object is just a mapping from
+
+    module name --> module body
+
+Each module body is a JSON structure corresponding to the internal module
+representation used by VL (a Verilog Library for the ACL2 theorem prover).  You
+can find lots of documentation about the data format here:
+
+    http://fv.centtech.com/acl2/latest/doc/frames2.html?topic=VL____MODULES
+
+  +------------------------------------------------------------------------+
+  |                                                                        |
+  | TIP:                                                                   |
+  |   - Click on the yellow + sign next to "VL" on the left frame, then    |
+  |   - Click on the + sign next to "VL::modules".                         |
+  |                                                                        |
+  | Now you have a menu with all the different structures!                 |
+  |                                                                        |
+  +------------------------------------------------------------------------+
+
+Most structures are very straightforward.  But some others (e.g., expressions
+and statements) are perhaps a bit weird.  If you want to deal with these, you
+may want to read the documentation carefully to understand how they work.
+
+
+------------------------------------------------------------------------------
+
+                            MISCELLANEOUS NOTES
+
+Today, "vl json" just parses in the Verilog modules and then writes out their
+internal VL representation into JSON.  This is straightforward, and may be
+perfectly fine for writing many kinds of programs.
+
+But if you want to write a program that involves some deeper understanding of
+the Verilog, then you may still be facing a lot of work.  For instance, suppose
+your program wants to follow wires into submodules.  Well, to really do it right,
+you may need to handle both named and position-based argument lists, e.g.,
+
+   my_adder adder1 (.o(o), .a(a), .b(b));
+   my_adder adder2 (o, a, b);
+
+And you might also need to handle port expressions on the submodule side, e.g.,
+
+   module my_adder (o, a({ahigh, alow}), b);
+     input [3:0] ahigh;
+     input [3:0] alow;
+     ...
+   endmodule
+
+And maybe you even need to know the sizes of wires, etc.  The point is,
+something that sounds simple can be hard to do in a robust way because of all
+the different forms that Verilog can be written in.
+
+If you want to do something tricky like this, the easiest approach may just be
+to extend "vl json" to simplify the modules before you process them.
+
+VL has a large number of Verilog-to-Verilog transforms that we can run on the
+modules before writing them.  These may be able to really reduce the variety of
+structures that your program will need to handle.  To get a rough sense of the
+sorts of things VL can do, you might glance through this list of transforms:
+
+    http://fv.centtech.com/acl2/latest/doc/frames2.html?topic=VL____TRANSFORMS
+
+------------------------------------------------------------------------------
diff -Nru acl2-6.2/books/centaur/vl/kit/lint.lisp acl2-6.3/books/centaur/vl/kit/lint.lisp
--- acl2-6.2/books/centaur/vl/kit/lint.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/lint.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,1110 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "VL")
+
+(make-event
+
+; Disabling waterfall parallelism because this book allegedly uses memoization
+; while performing its proofs.
+
+ (if (and (ACL2::hons-enabledp state)
+          (f-get-global 'ACL2::parallel-execution-enabled state))
+     (er-progn (set-waterfall-parallelism nil)
+               (value '(value-triple nil)))
+   (value '(value-triple nil))))
+
+(include-book "../loader/loader")
+
+(include-book "../lint/bit-use-set")
+(include-book "../lint/check-case")
+(include-book "../lint/check-namespace")
+(include-book "../lint/disconnected")
+(include-book "../lint/xf-drop-missing-submodules")
+(include-book "../lint/xf-drop-user-submodules")
+(include-book "../lint/xf-lint-stmt-rewrite")
+(include-book "../lint/xf-remove-toohard")
+(include-book "../lint/xf-undefined-names")
+(include-book "../lint/xf-suppress-warnings")
+
+(include-book "../checkers/condcheck")
+(include-book "../checkers/duplicate-detect")
+(include-book "../checkers/dupeinst-check")
+(include-book "../checkers/duperhs")
+(include-book "../checkers/leftright")
+(include-book "../checkers/multidrive-detect")
+(include-book "../checkers/oddexpr")
+(include-book "../checkers/portcheck")
+(include-book "../checkers/qmarksize-check")
+(include-book "../checkers/selfassigns")
+(include-book "../checkers/skip-detect")
+
+(include-book "../transforms/cn-hooks")
+(include-book "../transforms/xf-argresolve")
+(include-book "../transforms/xf-array-indexing")
+(include-book "../transforms/xf-assign-trunc")
+(include-book "../transforms/xf-blankargs")
+(include-book "../transforms/xf-clean-params")
+(include-book "../transforms/xf-drop-blankports")
+(include-book "../transforms/xf-expr-split")
+(include-book "../transforms/xf-expand-functions")
+(include-book "../transforms/xf-follow-hids")
+(include-book "../transforms/xf-hid-elim")
+(include-book "../transforms/xf-orig")
+(include-book "../transforms/xf-oprewrite")
+(include-book "../transforms/xf-portdecl-sign")
+(include-book "../transforms/xf-resolve-ranges")
+(include-book "../transforms/xf-replicate-insts")
+(include-book "../transforms/xf-sizing")
+(include-book "../transforms/xf-unparameterize")
+(include-book "../transforms/xf-unused-reg")
+
+(include-book "../../misc/sneaky-load")
+
+(include-book "../mlib/json")
+(local (include-book "../mlib/modname-sets"))
+(local (include-book "../util/arithmetic"))
+(local (include-book "../util/osets"))
+
+(include-book "centaur/getopt/top" :dir :system)
+(include-book "std/io/read-file-characters" :dir :system)
+(include-book "progutils")
+
+
+(defsection lint
+  :parents (vl)
+  :short "A linting tool for Verilog."
+
+  :long "<p>A <a
+href='http://en.wikipedia.org/wiki/Lint_%28software%29'>linter</a> is a tool
+that looks for possible bugs in a program.  We now implement such a linter for
+Verilog, reusing much of @(see vl).</p>")
+
+
+(defoptions vl-lintconfig
+  :parents (lint)
+  :short "Command-line options for running @('vl lint')."
+  :tag :vl-lint-opts
+
+  ((start-files string-listp
+                "The list of files to process."
+                :hide t)
+
+   (help        booleanp
+                "Show a brief usage message and exit."
+                :rule-classes :type-prescription
+                :alias #\h)
+
+   (readme      booleanp
+                "Show a more elaborate README and exit."
+                :rule-classes :type-prescription)
+
+   (search-path string-listp
+                :longname "search"
+                :alias #\s
+                :argname "DIR"
+                "Control the search path for finding modules.  You can give
+                 this switch multiple times, to set up multiple search paths in
+                 priority order."
+                :parser getopt::parse-string
+                :merge acl2::rcons)
+
+   (search-exts string-listp
+                :longname "searchext"
+                :argname "EXT"
+                "Control the search extensions for finding modules.  You can
+                 give this switch multiple times.  By default we just look for
+                 files named \"foo.v\" in the --search directories.  But if you
+                 have Verilog files with different extensions, this won't work,
+                 so you can add these extensions here.  EXT should not include
+                 the period, e.g., use \"--searchext vv\" to consider files
+                 like \"foo.vv\", etc."
+                :parser getopt::parse-string
+                :merge acl2::rcons
+                :default '("v"))
+
+   (topmods    string-listp
+               :longname "topmod"
+               :argname "MOD"
+               "Limit the scope of the report to MOD.  By default we include
+                all warnings for any module we encounter.  But if you say
+                \"--topmod foo\", we suppress all warnings for modules that foo
+                does not depend on.  You can give this switch multiple times,
+                e.g., \"--topmod foo --topmod bar\" means: only show warnings
+                for foo, bar, and modules that they depend on."
+               :parser getopt::parse-string
+               :merge cons)
+
+   (quiet      string-listp
+               :alias #\q
+               :argname "MOD"
+               "Suppress all warnings that about MOD.  You can give this switch
+                multiple times, e.g., \"-q foo -q bar\" will hide the warnings
+                about modules foo and bar."
+               :parser getopt::parse-string
+               :merge cons)
+
+   (dropmods   string-listp
+               :longname "drop"
+               :alias #\d
+               :argname "MOD"
+               "Delete MOD from the module hierarchy before doing any linting
+                at all.  This is a gross (but effective) way to work through
+                any bugs in the linter that are triggered by certain modules.
+                The dropped modules are removed from the module list without
+                destroying modules above them.  This may occasionally lead to
+                false warnings about the modules above (e.g., it may think some
+                wires are unused, because the module that uses them has been
+                removed.)"
+               :parser getopt::parse-string
+               :merge cons)
+
+   (ignore     string-listp
+               :alias #\i
+               :argname "TYPE"
+               "Ignore warnings of this TYPE.  For instance, \"--ignore
+                oddexpr\" will suppress VL_WARN_ODDEXPR warnings.  Note that
+                there are much finer-grained ways to suppress warnings; see
+                \"vl lint --readme\" for more information."
+                :parser getopt::parse-string
+                :merge cons)
+
+   (mem         posp
+                :alias #\m
+                :argname "GB"
+                "How much memory to try to use.  Default: 4 GB.  Raising this
+                 may improve performance by avoiding garbage collection.  To
+                 avoid swapping, keep this below (physical_memory - 2 GB)."
+                :default 4
+                :rule-classes :type-prescription)
+
+   (debug       booleanp
+                "Print extra information for debugging."
+                :rule-classes :type-prescription)))
+
+(defsection *vl-lint-help*
+  :parents (lint)
+  :short "Usage message for vl lint."
+  :long "@(def *vl-lint-help*)"
+
+  (defconsts *vl-lint-help* (str::cat "
+vl lint:  A linting tool for Verilog.  Scans your Verilog files for things
+          that look like bugs (size mismatches, unused wires, etc.)
+
+Example:  vl lint engine.v wrapper.v core.v \\
+            --search ./simlibs \\
+            --search ./baselibs
+
+Usage:    vl lint [OPTIONS] file.v [file2.v ...]
+
+Options:" *nls* *nls* *vl-lintconfig-usage* *nls*)))
+
+
+(define vl-filter-mods-with-good-paramdecls
+  ((x    vl-modulelist-p "List of modules to filter.")
+   (good vl-modulelist-p "Accumulator for good modules.")
+   (bad  vl-modulelist-p "Accumulator for bad modules."))
+  :returns (mv (good vl-modulelist-p :hyp :fguard)
+               (bad  vl-modulelist-p :hyp :fguard))
+  :parents (lint)
+  :short "(unsound transform) Throw away modules with too-complex parameter
+declarations. "
+
+  :long "<p>@(csee unparameterization) requires that the module list is
+complete and that all modules have good parameters.  In our ordinary
+translation process (e.g., @(see vl-simplify)), we throw away any modules with
+bad parameters, any then transitively throw away any modules with instances of
+missing modules.  But for linting, we'd like to try to carry out
+unparameterization with as little damage as possible.</p>
+
+<p>As a pre-unparameterization step, in this transform we throw away any
+modules with bad parameters and then throw away any instances of missing
+modules.  This is obviously unsound, so it should never be used in our ordinary
+translation process.</p>"
+
+  (cond ((atom x)
+         (mv good bad))
+        ((vl-good-paramdecllist-p (vl-module->paramdecls (car x)))
+         (vl-filter-mods-with-good-paramdecls (cdr x)
+                                              (cons (car x) good)
+                                              bad))
+        (t
+         (vl-filter-mods-with-good-paramdecls (cdr x)
+                                              good
+                                              (cons (car x) bad)))))
+
+
+(define vl-print-certain-warnings
+  ((mods vl-modulelist-p "Modules to print warnings for.")
+   (show symbol-listp    "Types of warnings to show.")
+   (hide symbol-listp    "Types of warnings to hide."))
+  :parents (lint)
+  :short "Print warnings of interest to standard output, while hiding other
+warnings."
+
+  :long "<p>You can use this to print just a few warnings you are interested in
+while hiding other warnings you know you are not interested in.  If there are
+warnings of other types (that you haven't said to show or hide), they too will
+be hidden but you'll at least get a message saying that they aren't being
+shown.</p>"
+
+  (b* ((warnings (vl-modulelist-flat-warnings-exec mods nil))
+       (types    (mergesort (vl-warninglist->types-exec warnings nil)))
+       (hide     (if hide
+                     (mergesort hide)
+                   types))
+       (show     (mergesort show))
+       ;; Misc is all the warning types that we aren't told to show, but aren't
+       ;; told to ignore.  We'll print a note that these warnings exist but
+       ;; that we weren't told to show or hide them.
+       (misc     (difference types (union show hide)))
+       (warnings (vl-keep-warnings show warnings)))
+    (vl-cw-ps-seq
+     (vl-ps-update-autowrap-col 65)
+     (vl-print-warnings warnings)
+     (vl-println "")
+     (if (not misc)
+         ps
+       (vl-ps-seq
+        (vl-cw "Note: not showing ~&0 warnings.~%" misc)
+        (vl-println ""))))))
+
+
+(defaggregate vl-lintresult
+  :parents (lint)
+  :short "Results from running the linter."
+  :tag :vl-lintresult
+  ((mods      vl-modulelist-p
+              "Final, transformed list of modules.  Typically this isn't very
+               interesting or relevant to anything.")
+
+   (mods0     vl-modulelist-p
+              "Almost: the initial, pre-transformed modules.  The only twist is
+               that we have already removed modules that are unnecessary or
+               that we wanted to drop; see, e.g., the @('topmods') and
+               @('ignore') options of @(see vl-lintconfig-p).  This is used for
+               @(see skip-detection), for instance.")
+
+   (mwalist   vl-modwarningalist-p
+              "The main result: binds \"original\" (pre-unparameterization)
+               module names to their warnings.")
+
+   (sd-probs  sd-problemlist-p
+              "Possible problems noticed by @(see skip-detection).  These are
+               in a different format than ordinary @(see warnings), so they
+               aren't included in the @('mwalist').")
+
+   (dalist    us-dbalist-p
+              "Use-set database alist, mapping module names to use-set databases.
+               Might actually not be used for anything.")))
+
+
+(define vl-delete-sd-problems-for-modnames-aux
+  ((fal "Fast alist binding names to T or whatever")
+   (x   sd-problemlist-p))
+  :returns (new-x sd-problemlist-p :hyp :fguard)
+  (b* (((when (atom x))
+        nil)
+       ((sd-problem x1) (car x))
+       ((vl-context x1.ctx) x1.ctx)
+       ((when (hons-get x1.ctx.mod fal))
+        (vl-delete-sd-problems-for-modnames-aux fal (cdr x))))
+    (cons (car x)
+          (vl-delete-sd-problems-for-modnames-aux fal (cdr x)))))
+
+(define vl-delete-sd-problems-for-modnames ((names string-listp)
+                                            (probs sd-problemlist-p))
+  :returns (new-x sd-problemlist-p
+                  :hyp (force (sd-problemlist-p probs)))
+  (b* ((fal (make-lookup-alist names))
+       (ret (vl-delete-sd-problems-for-modnames-aux fal probs)))
+    (fast-alist-free fal)
+    ret))
+
+
+(local (defthm no-duplicatesp-when-setp
+         (implies (setp x)
+                  (no-duplicatesp x))))
+
+(local (defthm VL-MODULELIST-P-OF-APPEND-fast
+         (implies (and (force (vl-modulelist-p x))
+                       (force (vl-modulelist-p y)))
+                  (vl-modulelist-p (append x y)))))
+
+(local (in-theory (disable
+                   NO-DUPLICATESP-EQUAL-WHEN-SAME-LENGTH-MERGESORT
+                   SUBSETP-EQUAL-OF-VL-MODINSTLIST->MODNAMESS-WHEN-SUBSETP-EQUAL
+                   CDR-OF-VL-MODULELIST-DUPERHS-CHECK
+                   CDR-OF-VL-MODULELIST-ORIGEXPRS
+                   CDR-OF-VL-MODULELIST-MAKE-ARRAY-INDEXING
+                   vl-modulelist-p-of-append
+                   NO-DUPLICATESP-EQUAL-OF-APPEND
+                   acl2::no-duplicatesp-equal-append-iff
+                   mergesort)))
+
+(define run-vl-lint-main ((mods     (and (vl-modulelist-p mods)
+                                         (uniquep (vl-modulelist->names mods))))
+                          (config   vl-lintconfig-p))
+  :returns (result vl-lintresult-p :hyp :fguard)
+
+  (b* (((vl-lintconfig config) config)
+
+       (mods (vl-modulelist-drop-user-submodules mods config.dropmods))
+
+       ;; You might expect that we'd immediately throw out modules that we
+       ;; don't need for topmods.  Historically we did that.  But then we found
+       ;; that we'd get a bunch of complaints in other modules about
+       ;; hierarchical identifiers that pointed into the modules we'd just
+       ;; thrown away!  So now we deal with this stuff after HID resolution.
+       ;; Except that for skip-detection, we also need to remove them from
+       ;; mods0, so do that now:
+       (mods0 (if (not config.topmods)
+                  mods
+                (vl-remove-unnecessary-modules (mergesort config.topmods)
+                                               (mergesort mods))))
+
+
+       (- (cw "~%vl-lint: initial processing...~%"))
+       (mods (cwtime (vl-modulelist-portcheck mods)))
+       (mods (cwtime (vl-modulelist-check-case mods)))
+       (mods (cwtime (vl-modulelist-duperhs-check mods)))
+       (mods (cwtime (vl-modulelist-duplicate-detect mods)))
+       (mods (cwtime (vl-modulelist-condcheck mods)))
+       (mods (cwtime (vl-modulelist-leftright-check mods)))
+       (mods (cwtime (vl-modulelist-drop-missing-submodules mods)))
+       ;; BOZO reinstate this??
+       ;; (mods (cwtime (vl-modulelist-add-undefined-names mods)))
+       (mods (cwtime (vl-modulelist-portdecl-sign mods)))
+       (mods (cwtime (vl-modulelist-make-array-indexing mods)))
+       (mods (cwtime (vl-modulelist-origexprs mods)))
+       (mods (cwtime (vl-modulelist-check-namespace mods)))
+
+       (- (cw "~%vl-lint: processing arguments, parameters...~%"))
+       (mods (cwtime (vl-modulelist-elim-unused-regs mods)))
+       (mods (cwtime (vl-modulelist-argresolve mods)))
+       (mods (cwtime (vl-modulelist-dupeinst-check mods)))
+
+       ;; BOZO not exactly sure where this should go, maybe this will work.
+       (mods (cwtime (vl-modulelist-expand-functions mods)))
+
+       ;; BOZO we need to do something to throw away instances with unresolved
+       ;; arguments to avoid programming-errors in drop-blankports... and actually
+       ;; we hit errors like that later, too.
+       (mods (cwtime (vl-modulelist-drop-blankports mods)))
+       (mods (cwtime (mp-verror-transform-hook mods)))
+       (mods (cwtime (vl-modulelist-follow-hids mods)))
+       (mods (cwtime (vl-modulelist-clean-params mods)))
+       (mods (cwtime (vl-modulelist-check-good-paramdecls mods)))
+
+       ((mv mods bad)
+        (vl-filter-mods-with-good-paramdecls mods nil nil))
+       (- (or (not bad)
+              (progn$
+               (cw "~%~%Note: deleting ~x0 module~s1 because they include ~
+                    unsupported parameter declarations.~%~%~
+                    Module~s1 being deleted: ~&2~%~%~
+                    Details:~%~%"
+                   (len bad)
+                   (if (= (len bad) 1) "" "s")
+                   (mergesort (vl-modulelist->names bad)))
+               (vl-print-certain-warnings bad
+                                          (list :vl-bad-paramdecl
+                                                :vl-bad-paramdecls)
+                                          nil))))
+       (mods (cwtime (vl-modulelist-drop-missing-submodules mods)))
+       (mods (if (and (uniquep (vl-modulelist->names mods))
+                      (vl-modulelist-complete-p mods mods)
+                      (vl-good-paramdecllist-list-p-of-vl-modulelist->paramdecls mods))
+                 mods
+               (er hard? 'vl-lint
+                   "Programming error.  Expected modules to be complete ~
+                    and to have good parameters, but this is not the case. ~
+                    Please tell Jared about this failure.")))
+       ((mv mods failmods) (cwtime (vl-unparameterize mods 30)))
+       (mods (append mods failmods))
+       (- (vl-gc))
+
+       (mods (if (uniquep (vl-modulelist->names mods))
+                 mods
+               (progn$
+                (sneaky-save :bad-names mods)
+                (er hard? 'vl-lint
+                    "Programming error.  Expected modules to have unique ~
+                      names after vl-unparameterize, but found duplicate ~
+                      modules named ~x0.  Please tell Jared."
+                    (duplicated-members (vl-modulelist->names mods))))))
+
+
+       (- (cw "~%vl-lint: processing ranges, statements...~%"))
+       (mods (cwtime (vl-modulelist-rangeresolve mods)))
+       (mods (cwtime (vl-modulelist-selresolve mods)))
+       (mods (cwtime (vl-modulelist-check-selfassigns mods)))
+       (mods (cwtime (vl-modulelist-lint-stmt-rewrite mods)))
+       (mods (cwtime (vl-modulelist-stmtrewrite mods 1000)))
+       (mods (cwtime (vl-modulelist-hid-elim mods)))
+
+       (mods (if (uniquep (vl-modulelist->names mods))
+                 mods
+               (progn$
+                (sneaky-save :bad-names mods)
+                (er hard? 'vl-lint
+                    "Programming error.  Expected modules to have unique ~
+                    names after vl-modulelist-hid-elim, but found duplicate ~
+                    modules named ~x0.  Please tell Jared."
+                    (duplicated-members (vl-modulelist->names mods))))))
+
+       ;; Now that HIDs are gone, we can throw away any modules we don't care
+       ;; about, if we have been given any topmods.
+       (mods (if (not config.topmods)
+                 mods
+               (vl-remove-unnecessary-modules (mergesort config.topmods)
+                                              (mergesort mods))))
+
+
+       ;; BOZO it seems sort of legitimate to do this before sizing, which
+       ;; might be nice.  Of course, a more rigorous use/set analysis will
+       ;; need to be post-sizing.
+       (- (cw "~%vl-lint: finding disconnected wires...~%"))
+       (mods (cwtime (vl-modulelist-remove-toohard mods)))
+       (mods (cwtime (vl-modulelist-find-disconnected mods)))
+
+       (- (cw "~%vl-lint: processing expressions...~%"))
+       (mods (cwtime (vl-modulelist-oddexpr-check mods)))
+       (mods (cwtime (vl-modulelist-oprewrite mods)))
+       (mods (cwtime (vl-modulelist-exprsize mods)))
+       (mods (cwtime (vl-modulelist-qmarksize-check mods)))
+
+       (- (cw "~%vl-lint: finding unused/unset wires...~%"))
+       ;; BOZO this probably doesn't quite work here due to replicate not having been done
+       ((mv mods dalist) (cwtime (us-analyze-mods mods)))
+       (- (vl-gc))
+
+       (- (cw "~%vl-lint: processing assignments...~%"))
+       (mods (cwtime (vl-modulelist-split mods)))
+       (mods (cwtime (vl-modulelist-replicate mods)))
+       (mods (cwtime (vl-modulelist-blankargs mods)))
+       (mods (cwtime (vl-modulelist-trunc mods)))
+
+       (- (cw "~%vl-lint: finding skipped and multiply driven wires...~%"))
+       ;; NOTE: use mods0, not mods, if you ever want this to finish. :)
+       (sd-probs (cwtime (sd-analyze-modulelist mods0)))
+       (mods     (cwtime (vl-modulelist-multidrive-detect mods)))
+
+       (- (cw "~%vl-lint: cleaning up...~%"))
+       (mods     (cwtime (vl-modulelist-clean-warnings mods)))
+       (mods     (cwtime (vl-modulelist-suppress-lint-warnings mods)))
+       (mods     (cwtime (vl-modulelist-lint-ignoreall mods config.ignore)))
+       (mods     (cwtime (vl-delete-modules config.quiet mods)))
+       (sd-probs (cwtime (vl-delete-sd-problems-for-modnames config.quiet sd-probs)))
+       (mwalist  (cwtime (vl-origname-modwarningalist mods))))
+
+    (make-vl-lintresult :mods mods
+                        :mods0 mods0
+                        :mwalist mwalist
+                        :sd-probs sd-probs
+                        :dalist dalist)))
+
+
+(define run-vl-lint ((config vl-lintconfig-p) &key (state 'state))
+  :returns (mv (res vl-lintresult-p :hyp :fguard)
+               (state state-p1 :hyp (state-p1 state)))
+  (b* ((- (cw "Starting VL-Lint~%"))
+       ((vl-lintconfig config) config)
+       (- (or (not config.debug)
+              (cw "Lint configuration: ~x0~%" config)))
+
+       (loadconfig (make-vl-loadconfig
+                    :start-files   config.start-files
+                    :search-path   config.search-path
+                    :search-exts   config.search-exts))
+       (- (or (not config.debug)
+              (cw "Load configuration: ~x0~%" loadconfig)))
+
+       (- (cw "~%vl-lint: loading modules...~%"))
+       ((mv loadres state) (cwtime (vl-load loadconfig)))
+
+       (lintres
+        (cwtime (run-vl-lint-main (vl-loadresult->mods loadres)
+                                  config))))
+    (mv lintres state)))
+
+
+(defund sd-problem-major-p (x)
+  (declare (xargs :guard (sd-problem-p x)))
+  (b* (((sd-problem x) x))
+    (or (>= x.priority 10)
+        (and (>= x.priority 6) (>= x.groupsize 4))
+        (>= (sd-problem-score x) 8))))
+
+(defsection sd-filter-problems
+
+  (defund sd-filter-problems (x major minor)
+    "Returns (MV MAJOR MINOR)"
+    (declare (xargs :guard (sd-problemlist-p x)))
+    (cond ((atom x)
+           (mv major minor))
+          ((sd-problem-major-p (car x))
+           (sd-filter-problems (cdr x) (cons (car x) major) minor))
+          (t
+           (sd-filter-problems (cdr x) major (cons (car x) minor)))))
+
+  (local (in-theory (enable sd-filter-problems)))
+
+  (defthm sd-problemlist-p-of-sd-filter-problems
+    (and (implies (and (sd-problemlist-p x)
+                       (sd-problemlist-p major))
+                  (sd-problemlist-p (mv-nth 0 (sd-filter-problems x major minor))))
+         (implies (and (sd-problemlist-p x)
+                       (sd-problemlist-p minor))
+                  (sd-problemlist-p (mv-nth 1 (sd-filter-problems x major minor))))))
+
+  (defthm true-listp-sd-filter-problems
+    (and (implies (true-listp major)
+                  (true-listp (mv-nth 0 (sd-filter-problems x major minor))))
+         (implies (true-listp minor)
+                  (true-listp (mv-nth 1 (sd-filter-problems x major minor)))))))
+
+
+
+(defthm symbol-listp-of-vl-warninglist->types
+  (implies (force (vl-warninglist-p x))
+           (symbol-listp (vl-warninglist->types x)))
+  :hints(("Goal" :induct (len x))))
+
+
+(define vl-modwarningalist-types ((x vl-modwarningalist-p))
+  (if (atom x)
+      nil
+    (append (vl-warninglist->types (cdar x))
+            (vl-modwarningalist-types (cdr x))))
+  ///
+  (defthm symbol-listp-of-vl-modwarningalist-types
+    (implies (force (vl-modwarningalist-p x))
+             (symbol-listp (vl-modwarningalist-types x)))))
+
+
+(defund vl-keep-from-modwarningalist (types x)
+  ;; Returns a new fast alist.
+  (declare (xargs :guard (and (symbol-listp types)
+                              (vl-modwarningalist-p x))))
+  (if (atom x)
+      nil
+    (b* ((name1     (caar x))
+         (warnings1 (cdar x))
+         (keep1     (vl-keep-warnings types warnings1))
+         (rest      (vl-keep-from-modwarningalist types (cdr x))))
+      (if keep1
+          (hons-acons name1 keep1 rest)
+        rest))))
+
+(defthm vl-modwarningalist-p-of-vl-keep-from-modwarningalist
+  (implies (and (force (symbol-listp types))
+                (force (vl-modwarningalist-p x)))
+           (vl-modwarningalist-p (vl-keep-from-modwarningalist types x)))
+  :hints(("Goal" :in-theory (enable vl-keep-from-modwarningalist))))
+
+
+(define vl-lint-print-warnings ((filename stringp)
+                                (label    stringp)
+                                (types    symbol-listp)
+                                (walist   vl-modwarningalist-p)
+                                &key (ps 'ps))
+  (b* ((walist (vl-keep-from-modwarningalist types walist))
+       (walist (vl-clean-modwarningalist walist))
+       (count  (length (append-domains walist)))
+       (-      (cond ((int= count 0)
+                      (cw "~s0: No ~s1 Warnings.~%" filename label))
+                     ((int= count 1)
+                      (cw "~s0: One ~s1 Warning.~%" filename label))
+                     (t
+                      (cw "~s0: ~x1 ~s2 Warnings.~%" filename count label)))))
+    (vl-ps-seq
+     (cond ((int= count 0)
+            (vl-cw "No ~s0 Warnings.~%~%" label))
+           ((int= count 1)
+            (vl-cw "One ~s0 Warning:~%~%" label))
+           (t
+            (vl-cw "~x0 ~s1 Warnings:~%~%" count label)))
+     (vl-print-modwarningalist walist))))
+
+
+(define vl-jp-modwarningalist-aux ((x vl-modwarningalist-p) &key (ps 'ps))
+  (b* (((when (atom x))
+        ps)
+       ((cons modname warnings) (car x)))
+    (vl-ps-seq (vl-indent 1)
+               (jp-str modname)
+               (vl-print ":")
+               (vl-jp-warninglist warnings)
+               (if (atom (cdr x))
+                   ps
+                 (vl-println ","))
+               (vl-jp-modwarningalist-aux (cdr x)))))
+
+(define vl-jp-modwarningalist ((x vl-modwarningalist-p) &key (ps 'ps))
+  (vl-ps-seq (vl-print "{")
+             (vl-jp-modwarningalist-aux x)
+             (vl-println "}")))
+
+(defconst *use-set-warnings*
+  (list :use-set-fudging
+        :use-set-trainwreck
+        :use-set-future-trainwreck
+        :use-set-warn-1-unset
+        :use-set-warn-1-unset-tricky
+        :use-set-warn-2-unused
+        :use-set-warn-2-unused-tricky
+        :use-set-warn-3-spurious
+        :use-set-warn-3-spurious-tricky
+        :use-set-syntax-error
+        :vl-collect-wires-approx
+        :vl-collect-wires-fail
+        :vl-dropped-always
+        :vl-dropped-assign
+        :vl-dropped-initial
+        :vl-dropped-insts
+        :vl-dropped-modinst
+        :vl-warn-function
+        :vl-warn-taskdecl
+        :vl-unsupported-block))
+
+(defconst *basic-warnings*
+  (list :bad-mp-verror
+        :vl-bad-range
+        :vl-warn-duplicates
+        :vl-bad-instance
+        :vl-unresolved-hid
+        :vl-warn-unused-reg
+        :vl-warn-blank
+        :vl-undefined-names
+        :vl-port-mismatch))
+
+(defconst *trunc-warnings*
+  (list :vl-warn-extension
+        :vl-warn-truncation
+        :vl-warn-integer-size))
+
+(defconst *trunc-minor-warnings*
+  (list :vl-warn-extension-minor
+        :vl-warn-truncation-minor
+        :vl-warn-integer-size-minor
+        :vl-warn-vague-spec))
+
+(defconst *disconnected-warnings*
+  (list :vl-warn-disconnected
+        :vl-warn-disconnected-interesting
+        ;; Caveats that could make the analysis wrong
+        :vl-collect-wires-fail
+        :vl-collect-wires-approx
+        :vl-dropped-always
+        :vl-dropped-assign
+        :vl-dropped-initial
+        :vl-dropped-insts
+        :vl-dropped-modinst
+        :vl-warn-function
+        :vl-warn-taskdecl
+        :vl-unsupported-block))
+
+(defconst *smell-warnings*
+  (list :vl-warn-qmark-width
+        :vl-warn-qmark-const
+        :vl-warn-leftright
+        :vl-warn-selfassign
+        :vl-warn-instances-same
+        :vl-warn-case-sensitive-names
+        :vl-warn-same-rhs))
+
+(defconst *smell-minor-warnings*
+  (list :vl-warn-partselect-same
+        :vl-warn-instances-same-minor))
+
+(defconst *multidrive-warnings*
+  (list :vl-warn-multidrive))
+
+(defconst *multidrive-minor-warnings*
+  (list :vl-warn-multidrive-minor))
+
+(defconst *fussy-size-warnings*
+  (list :vl-fussy-size-warning-1
+        :vl-fussy-size-warning-2
+        :vl-fussy-size-warning-3
+        :vl-fussy-size-warning-1-const-toobig
+        :vl-fussy-size-warning-2-const-toobig
+        :vl-fussy-size-warning-3-const-toobig
+        :vl-fussy-size-warning-1-complex
+        :vl-fussy-size-warning-2-complex
+        :vl-fussy-size-warning-3-complex
+        ))
+
+(defconst *same-ports-warnings*
+  (list :vl-warn-same-ports
+        :vl-warn-same-inputs))
+
+(defconst *same-ports-minor-warnings*
+  (list :vl-warn-same-ports-minor
+        :vl-warn-same-inputs-minor))
+
+(defconst *fussy-size-minor-warnings*
+  (list :vl-fussy-size-warning-1-minor
+        :vl-fussy-size-warning-2-minor
+        :vl-fussy-size-warning-3-minor))
+
+
+
+
+(defconst *warnings-covered*
+
+  ;; Warnings that are covered by our regular reports.  Other warnings besides
+  ;; these will get put into vl-other.txt
+
+  (append *use-set-warnings*
+          *basic-warnings*
+          *trunc-warnings*
+          *trunc-minor-warnings*
+          *disconnected-warnings*
+          *smell-warnings*
+          *smell-minor-warnings*
+          *multidrive-warnings*
+          *multidrive-minor-warnings*
+          *fussy-size-warnings*
+          *fussy-size-minor-warnings*
+          *same-ports-warnings*
+          *same-ports-minor-warnings*
+          ))
+
+(defconst *warnings-ignored*
+
+  ;; Warnings that aren't covered but which we don't want to put into vl-other.txt
+  ;; anyway.
+
+  (list
+   :vl-warn-taskdecl
+   :vl-warn-function
+
+   ))
+
+(local (in-theory (disable sets::in sets::in-tail
+                           sets::difference sets::mergesort)))
+
+(defun vl-lint-report (lintresult state)
+  (declare (xargs :guard (vl-lintresult-p lintresult)
+                  :stobjs state))
+
+  (b* (((vl-lintresult lintresult) lintresult)
+       (walist   lintresult.mwalist)
+       (sd-probs lintresult.sd-probs)
+
+       ((mv major minor)
+        (cwtime (sd-filter-problems sd-probs nil nil)))
+       (major (reverse major))
+       (minor (reverse minor))
+
+       (- (cw "~%vl-lint: saving results...~%~%"))
+
+       (othertypes  (difference (mergesort (vl-modwarningalist-types walist))
+                                (mergesort (append *warnings-covered*
+                                                   *warnings-ignored*))))
+
+       (state
+        (with-ps-file
+         "vl-basic.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-basic.txt" "Basic" *basic-warnings* walist)))
+
+       (state
+        (with-ps-file
+         "vl-trunc.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-print "
+NOTE: see the bottom of this file for an explanation of what these warnings
+mean and how to avoid them.
+
+")
+
+         (vl-lint-print-warnings "vl-trunc.txt" "Truncation/Extension" *trunc-warnings* walist)
+
+         (vl-print "
+
+UNDERSTANDING THESE WARNINGS.
+
+1. VL-WARN-TRUNCATION warnings are issued when the left-hand side of an
+assignment statement is not as wide as the right-hand side.
+
+False positives here can typically be suppressed by using part-selects to make
+the intended truncations explicit.  For instance:
+
+    wire [47:0] foo ;
+    wire [63:0] bar ;
+
+    assign foo = bar ;        // implicit truncation, causes warning
+    assign foo = bar[47:0] ;  // explicit truncation, no warning
+
+    assign foo = condition ? bar : 0 ;      // implicit truncation, causes warning
+    assign foo = condition ? bar[47:0] : 0; // explicit truncation, no warning
+
+
+2. VL-WARN-EXTENSION warnings are the opposite: they are issued when the
+left-hand side is wider than the right-hand side would have been on its own.
+
+False-positives can again typically be suppressed by explicitly concatenting in
+zeroes, or by using part-selects to cut the left-hand side to the right size.
+For instance:
+
+    wire [47:0] foo ;
+    wire [63:0] bar ;
+
+    assign bar = foo ;             // implicit extension, causes warning
+    assign bar = { 16'b0, foo } ;  // explicit extension, no warning
+    assign bar[47:0] = foo;        // no extension, no warning
+
+
+Note that we consider certain truncation and extension warnings to be \"minor\"
+and do not report them here.  Such warnings are unlikely to be a problem, but
+you can see \"vl-trunc-minor.txt\" to review them.")))
+
+       (state
+        (with-ps-file
+         "vl-fussy.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-fussy.txt" "Fussy Size Warnings" *fussy-size-warnings* walist)))
+
+       (state
+        (with-ps-file
+         "vl-fussy-minor.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-fussy-minor.txt" "Minor Fussy Size Warnings" *fussy-size-minor-warnings* walist)))
+
+       (state
+        (with-ps-file
+         "vl-disconnected.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-disconnected.txt" "Disconnected Wire" *disconnected-warnings* walist)))
+
+       (state
+        (with-ps-file
+         "vl-multi.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-multi.txt" "Multidrive" *multidrive-warnings* walist)))
+
+       (state
+        (if (not major)
+            (progn$
+             (cw "; No Skip-Detect Warnings.~%")
+             state)
+          (progn$
+           (cw "vl-skipdet.txt: ~x0 Skip-Detect Warnings.~%" (len major))
+           (with-ps-file "vl-skipdet.txt"
+                         (vl-ps-update-autowrap-col 68)
+                         (vl-cw "Skip-Detect Warnings.~%~%")
+                         (sd-pp-problemlist-long major)))))
+
+       (state
+        (with-ps-file
+         "vl-trunc-minor.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-print "
+NOTE: see the bottom of this file for an explanation of what these warnings
+mean and how to avoid them.
+
+")
+         (vl-lint-print-warnings "vl-trunc-minor.txt" "Minor Truncation/Extension" *trunc-minor-warnings* walist)
+         (vl-print "
+
+UNDERSTANDING THESE WARNINGS.
+
+1.  VL-WARN-TRUNCATION-32 warnings are generated for any assignments that are
+being truncated and whose right-hand sides are 32-bits wide.  This is a minor
+warning because it typically arises from assignments where plain integers are
+involved, e.g., if foo and bar are 10 bits wide, then a truncation-32 warning
+will be generated for:
+
+    assign foo = bar ^ 5;
+
+This is because \"5\" has an implementation-dependent width (of at least 32
+bits), and in VL-Lint we treat it as being 32-bits wide.  So, the above
+describes a 32-bit XOR that is then truncated down to 10 bits.  Fixing these
+warnings is usually easy: just explicitly specify the sizes of the numbers
+involved, e.g., a \"corrected\" version might be:
+
+    assign foo = bar ^ 10'd 5;
+
+This is generally a good idea since it avoids any implementation-dependent
+sizing (which can occasionally affect the results of expressions).
+
+
+2.  VL-WARN-EXTENSION-MINOR warnings are generated for any assignments where
+the width of the left-hand side is used to size the expression, and where the
+right-hand side involves only addition operations.  For instance, given:
+
+    wire [9:0] foo;
+    wire [9:0] bar;
+    wire [9:0] sum;
+    wire carry;
+
+Then an assignment like this:
+
+    assign { carry, sum } = foo + bar;
+
+would result in a minor extension warning.  These warnings are typically quite
+minor since you frequently want to get the carry out of a sum.  But you could
+suppress them by writing something like this:
+
+    Variant 1: assign {carry, sum} = {1'b0,foo} + bar;
+    Variant 2: assign {carry, sum} = foo + bar + 11'b0;
+
+or similar, to make explicit on the right-hand side that you want an 11-bit
+wide addition instead of a 10-bit wide addition.")))
+
+       (state
+        (with-ps-file
+         "vl-multi-minor.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-multi-minor.txt" "Minor Multidrive" *multidrive-minor-warnings* walist)))
+
+       (state
+        (if (not minor)
+            (prog2$
+             (cw "; No Minor Skip-Detect Warnings.~%")
+             state)
+          (prog2$
+           (cw "vl-skipdet-minor.txt: ~x0 Minor Skip-Detect Warnings.~%" (len minor))
+           (with-ps-file "vl-skipdet-minor.txt"
+                         (vl-ps-update-autowrap-col 68)
+                         (vl-cw "Minor Skip-Detect Warnings.~%~%")
+                         (sd-pp-problemlist-long minor)))))
+
+
+       (state
+        (with-ps-file
+         "vl-use-set.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-use-set.txt"
+                                 "Unused/Unset Wire Warnings"
+                                 *use-set-warnings*
+                                 walist)))
+
+
+       (state
+        (with-ps-file
+         "vl-smells.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-smells.txt" "Code-Smell Warnings" *smell-warnings* walist)))
+
+       (state
+        (with-ps-file
+         "vl-smells-minor.txt"
+         (vl-ps-update-autowrap-col 68)
+         (vl-lint-print-warnings "vl-smells-minor.txt" "Minor Code-Smell Warnings" *smell-minor-warnings* walist)))
+
+
+      (state
+       (with-ps-file "vl-same-ports.txt"
+                     (vl-ps-update-autowrap-col 68)
+                     (vl-lint-print-warnings "vl-same-ports.txt"
+                                             "Same-ports Warnings"
+                                             *same-ports-warnings*
+                                             walist)))
+      (state
+       (with-ps-file "vl-same-ports-minor.txt"
+                     (vl-ps-update-autowrap-col 68)
+                     (vl-lint-print-warnings "vl-same-ports-minor.txt"
+                                             "Minor same-ports Warnings"
+                                             *same-ports-minor-warnings*
+                                             walist)))
+
+      (state
+       (with-ps-file
+        "vl-other.txt"
+        (vl-ps-update-autowrap-col 68)
+        (vl-lint-print-warnings "vl-other.txt" "Other/Unclassified" othertypes walist)))
+
+      (- (cw "~%"))
+
+      (state
+       (cwtime
+        (with-ps-file "vl-warnings.json"
+                      (vl-print "{\"warnings\":")
+                      (vl-jp-modwarningalist walist)
+                      (vl-println "}"))
+        :name write-warnings-json)))
+
+    state))
+
+
+(defconsts (*vl-lint-readme* state)
+  (b* (((mv contents state) (acl2::read-file-characters "lint.readme" state))
+       ((when (stringp contents))
+        (raise contents)
+        (mv "" state)))
+    (mv (implode contents) state)))
+
+(define vl-lint ((args string-listp) &key (state 'state))
+  :parents (kit lint)
+  :short "The @('vl lint') command."
+
+  (b* (((mv errmsg config start-files)
+        (parse-vl-lintconfig args))
+       ((when errmsg)
+        (die "~@0~%" errmsg)
+        state)
+       (config
+        (change-vl-lintconfig config
+                              :start-files start-files))
+       ((vl-lintconfig config) config)
+
+       (- (acl2::set-max-mem ;; newline to appease cert.pl
+           (* (expt 2 30) config.mem)))
+
+       ((when config.help)
+        (vl-cw-ps-seq (vl-print *vl-lint-help*))
+        (exit-ok)
+        state)
+
+       ((when config.readme)
+        (vl-cw-ps-seq (vl-print *vl-lint-readme*))
+        (exit-ok)
+        state)
+
+       (- (or (not config.debug)
+              (vl-cw-ps-seq
+               (vl-cw "Raw args: ~x0~%" args)
+               (vl-cw "Start-files: ~x0~%" start-files))))
+
+       ((unless (consp config.start-files))
+        (die "No files to process.")
+        state)
+
+       (state (must-be-regular-files! config.start-files))
+       (state (must-be-directories! config.search-path))
+
+       ((mv result state)
+        (cwtime (run-vl-lint config)
+                :name vl-lint))
+       (state
+        (cwtime (vl-lint-report result state))))
+    (exit-ok)
+    state))
+
+
+#||
+
+(vl-lint (list "
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/vl/kit/lint.readme acl2-6.3/books/centaur/vl/kit/lint.readme
--- acl2-6.2/books/centaur/vl/kit/lint.readme	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/lint.readme	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,85 @@
+------------------------------------------------------------------------------
+
+                              VL LINT README
+
+------------------------------------------------------------------------------
+
+You can use VL's "lint" tool to identify potential problems in Verilog code.
+
+It can warn you about things like:
+
+ - Duplicate module elements
+ - Wires driven by multiple sources
+ - Implicit truncations and extensions in assignments
+ - Unused and unset parts of wires
+ - Possible problems with operator precedence
+ - Strange statements that sometimes indicate copy/paste errors
+ - Potentially skipped wires in expressions like:
+       assign bar = (foo0 & foo1 & foo2 & foo4 & foo5)
+                                         ^^ where is foo3?
+
+
+------------------------------------------------------------------------------
+
+                           Running the Linter
+
+To see the available command-line options, just run
+
+   vl help lint
+
+A typical invocation might look like this:
+
+   vl lint my_mod1.v my_mod2.v \     <-- starting files to load
+            -s libs/my_lib1 \        <-- search paths for finding
+            -s libs/my_lib2               additional modules
+
+The linter will print some progress messages, then writes several text files
+containing its report.  (It generally produces too much output, so to try to
+filter this out and let you focus on the most likely errors, we split the
+output into several files).
+
+Here is a summary:
+
+Generic warnings: (probably the most interesting)
+  vl-basic.txt - basic warnings
+
+Multiply driven wires: (sometimes interesting)
+  vl-multi.txt - more likely to be problems
+  vl-multi-minor.txt - unlikely to be problems
+
+Truncation/Extension warnings: (sometimes interesting)
+  vl-trunc.txt - more likely to be problems
+  vl-trunc-minor.txt - unlikely to be problems
+
+Fussy size warnings: (sometimes interesting)
+  vl-fussy.txt - like truncation warnings on stroids
+  vl-fussy-minor.txt - unlikely to be problems
+
+Unconnected wires: (useful when cleaning up)
+  vl-disconnected.txt - wires that aren't connected at all
+  vl-use-set.txt - wires that seem to be undriven/unused (sometimes wrong)
+
+Skip detection: (only occasionally useful)
+  vl-skipdet.txt - high-scoring expressions, more likely to be problems
+  vl-skipdet-minor.txt - low-scoring expressions, unlikely to be problems
+
+
+------------------------------------------------------------------------------
+
+                      Suppressing False Positives
+
+You can tell the linter to ignore certain things by adding comments to your
+Verilog source files.  For instance:
+
+  //@VL LINT_IGNORE_TRUNCATION     // to suppress the truncation warning
+  assign foo[3:0] = bar[5:0];
+
+  //@VL LINT_IGNORE                // to suppress all warnings
+  assign foo[3:0] = bar[5:0];
+
+This feature is probably fancier than anyone needs.  There are also some
+command-line options to suppress all warnings for particular modules, or all
+warnings of particular types, etc.  See "vl help lint" for details.
+
+
+------------------------------------------------------------------------------
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/vl/kit/model.lisp acl2-6.3/books/centaur/vl/kit/model.lisp
--- acl2-6.2/books/centaur/vl/kit/model.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/model.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,270 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "VL")
+(include-book "../top")
+(include-book "centaur/getopt/top" :dir :system)
+(include-book "std/io/read-file-characters" :dir :system)
+(include-book "progutils")
+(include-book "oslib/catpath" :dir :system)
+(local (include-book "../util/arithmetic"))
+(local (include-book "../util/osets"))
+
+
+; I don't think we care about emaps anymore.  It looks like they still may be
+; supported in the VCD dumping code, but I'm pretty sure we don't actually use
+; them.  So, I'm not going to build them in here.
+
+(defoptions vl-model-opts
+  :parents (vl-model)
+  :short "Options for running @('vl model')."
+  :tag :vl-model-opts
+
+  ((help        booleanp
+                :alias #\h
+                "Show a brief usage message and exit."
+                :rule-classes :type-prescription)
+
+   (readme      booleanp
+                "Show a more elaborate README and exit."
+                :rule-classes :type-prescription)
+
+   (outdir      stringp
+                :argname "DIR"
+                "Default is \".\".  Controls where the translation files should
+                 be written."
+                :default "."
+                :rule-classes :type-prescription)
+
+   (model-file  stringp
+                :argname "NAME"
+                :default "model.sao"
+                "Default is \"model.sao\".  Contains the main vl-translation-p
+                 object with E modules as well as copious other information
+                 about from the translation.  See the readme for details.  To
+                 avoid writing this file, you can use the empty string, i.e.,
+                 --model-file ''."
+                :rule-classes :type-prescription)
+
+   (esims-file  stringp
+                :argname "NAME"
+                :default "esims.sao"
+                "Default is \"esims.sao\".  Contains just the E modules, and is
+                 typically much smaller than model.sao.  To avoid writing this
+                 file, you can use the empty string, i.e., --esims-file ''."
+                :rule-classes :type-prescription)
+
+   (start-files string-listp
+                "The list of files to parse. (Not options; this is the rest of
+                 the command line, hence :hide t)"
+                :hide t)
+
+   (search-path string-listp
+                :longname "search"
+                :alias #\s
+                :argname "DIR"
+                "Control the search path for finding modules.  You can give
+                 this switch multiple times, to set up multiple search paths in
+                 priority order."
+                :parser getopt::parse-string
+                :merge acl2::rcons)
+
+   (search-exts string-listp
+                :longname "searchext"
+                :argname "EXT"
+                "Control the search extensions for finding modules.  You can
+                 give this switch multiple times.  By default we just look for
+                 files named \"foo.v\" in the --search directories.  But if you
+                 have Verilog files with different extensions, this won't work,
+                 so you can add these extensions here.  EXT should not include
+                 the period, e.g., use \"--searchext vv\" to consider files
+                 like \"foo.vv\", etc."
+                :parser getopt::parse-string
+                :merge acl2::rcons
+                :default '("v"))
+
+   (overrides   string-listp
+                :longname "override"
+                :argname "DIR"
+                "(Advanced) Set up VL override directories.  You can give this
+                 switch multiple times.  By default there are no override
+                 directories.  See the VL documentation on overrides (under
+                 loader) for more information."
+                :parser getopt::parse-string
+                :merge acl2::rcons)
+
+   (defines     string-listp
+                :longname "define"
+                :alias #\D
+                :argname "VAR"
+                "Set up definitions to use before parsing begins.  Equivalent
+                 to putting `define VAR 1 at the top of your Verilog file.
+                 You can give this option multiple times."
+                :parser getopt::parse-string
+                :merge acl2::cons)
+
+   (unroll-limit natp
+                 :longname "unroll"
+                 :argname "LIMIT"
+                 "Set the maximum number of times to unroll loops to LIMIT.
+                  Default: 100."
+                 :default 100)
+
+   (dropmods   string-listp
+               :longname "drop"
+               :argname "MOD"
+               "Delete MOD from the module hierarchy before doing any simplification.
+                This is a gross (but effective) way to work through any bugs in
+                VL that cause hard errors and are triggered by certain modules.
+                We will fail to model anything that depends on the dropped
+                modules."
+               :parser getopt::parse-string
+               :merge cons)
+
+   (mem         posp
+                :alias #\m
+                :argname "GB"
+                "How much memory to try to use.  Default: 4 GB.  Raising this
+                 may improve performance by avoiding garbage collection.  To
+                 avoid swapping, keep this below (physical_memory - 2 GB)."
+                :default 4
+                :rule-classes :type-prescription)
+   ))
+
+
+(defconst *vl-model-help* (str::cat "
+vl model:  Make an ACL2 model of a Verilog design.
+
+Example:  vl model engine.v wrapper.v core.v \\
+              --search ./simlibs \\
+              --search ./baselibs
+
+Usage:    vl model [OPTIONS] file.v [file2.v ...]
+
+Options:" *nls* *nls* *vl-model-opts-usage* *nls*))
+
+
+(define vl-model-main ((opts vl-model-opts-p)
+                       &key (state 'state))
+
+  (b* (((vl-model-opts opts) opts)
+
+       (want-translation-p (not (equal opts.model-file "")))
+
+       (loadconfig (make-vl-loadconfig
+                    :override-dirs opts.overrides
+                    :start-files   opts.start-files
+                    :search-path   opts.search-path
+                    :search-exts   opts.search-exts
+                    :defines       (vl-make-initial-defines opts.defines)
+                    :filemapp      want-translation-p))
+
+       (simpconfig (make-vl-simpconfig
+                    :problem-mods opts.dropmods
+                    :unroll-limit opts.unroll-limit
+                    :compress-p   want-translation-p))
+
+       ((mv translation state)
+        (defmodules-fn loadconfig simpconfig))
+
+       (state
+        (if (equal opts.model-file "")
+            state
+          (serialize-write (oslib::catpath opts.outdir opts.model-file)
+                           translation
+                           :verbosep t)))
+
+       (state
+        (if (equal opts.esims-file "")
+            state
+          (serialize-write (oslib::catpath opts.outdir opts.esims-file)
+                           (vl-modulelist->esims (vl-translation->mods translation))
+                           :verbosep t))))
+    state))
+
+(defconsts (*vl-model-readme* state)
+  (b* (((mv contents state) (acl2::read-file-characters "model.readme" state))
+       ((when (stringp contents))
+        (raise contents)
+        (mv "" state)))
+    (mv (implode contents) state)))
+
+
+(define vl-model ((argv string-listp) &key (state 'state))
+  :parents (kit lint)
+  :short "The @('vl model') command."
+  (b* (((mv errmsg opts start-files)
+        (parse-vl-model-opts argv))
+       ((when errmsg)
+        (die "~@0~%" errmsg)
+        state)
+       (opts (change-vl-model-opts opts
+                                   :start-files start-files))
+       ((vl-model-opts opts) opts) 
+
+       ((when opts.help)
+        (vl-cw-ps-seq (vl-print *vl-model-help*))
+        (exit-ok)
+        state)
+
+       ((when opts.readme)
+        (vl-cw-ps-seq (vl-print *vl-model-readme*))
+        (exit-ok)
+        state)
+
+       ((unless (consp opts.start-files))
+        (die "No files to process.")
+        state)
+
+       (- (cw "Building ACL2 model for:~%"))
+
+       (- (cw " - start files: ~x0~%" opts.start-files))
+       (state (must-be-regular-files! opts.start-files))
+
+       (- (cw " - search path: ~x0~%" opts.search-path))
+       (state (must-be-directories! opts.search-path))
+
+       (- (and opts.overrides
+               (cw " - overrides: ~x0~%" opts.overrides)))
+       (state (must-be-directories! opts.overrides))
+
+       (- (and opts.defines (cw "; defines: ~x0~%" opts.defines)))
+
+       (- (cw "Writing output to ~x0:~%" opts.outdir))
+       (state (must-be-directories! (list opts.outdir)))
+
+       ((when (and (equal opts.model-file "")
+                   (equal opts.esims-file "")))
+        (die "No model file or esims file, so nothing to do?")
+        state)
+
+       (- (or (equal opts.model-file "")
+              (cw " - model file: ~x0" opts.model-file)))
+
+       (- (or (equal opts.esims-file "")
+              (cw " - esims file: ~x0" opts.esims-file)))
+
+       (- (cw "Soft heap size ceiling: ~x0 GB~%" opts.mem))
+       (- (acl2::set-max-mem ;; newline to appease cert.pl's scanner
+           (* (expt 2 30) opts.mem)))
+
+       (state (vl-model-main opts)))
+    (exit-ok)
+    state))
diff -Nru acl2-6.2/books/centaur/vl/kit/model.readme acl2-6.3/books/centaur/vl/kit/model.readme
--- acl2-6.2/books/centaur/vl/kit/model.readme	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/model.readme	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,77 @@
+------------------------------------------------------------------------------
+
+                              VL MODEL README
+
+------------------------------------------------------------------------------
+
+You can use VL's "model" tool to translate Verilog designs into formal models
+that can be analyzed by the ACL2 theorem prover.
+
+
+                              PREREQUISITES
+
+  To get any use out of this, you would typically need to know how to use ACL2.
+  For basic information about the theorem prover, see its homepage:
+
+    http://www.cs.utexas.edu/users/moore/acl2/
+
+  VL itself is an ACL2 library for processing Verilog files.  It is distributed
+  as part of the ACL2 Community Books project, see the centaur/vl directory:
+
+    http://acl2-books.googlecode.com/
+
+  VL has considerable documentation.  The documentation corresponding to the
+  latest ACL2 release is found at:
+
+   http://fv.centtech.com/acl2/latest/doc/frames2.html?topic=ACL2____VL
+
+  More bleeding-edge documentation can be generated from the sources (which you
+  can get from the acl2-books project, above).
+
+  After getting a copy of VL and glancing through its documentation, you should
+  probably complete the small Centaur Hardware Verification Tutorial.  The
+  starting point is:
+
+    acl2-books/centaur/tutorial/intro.lisp
+
+
+                             THE VL MODEL TOOL
+
+  The "vl model" command is really nothing more than a command-line interface
+  to the DEFMODULES command.  It lets you parse Verilog files and translate
+  them into E modules directly, without, for instance, having to load the VL
+  books into ACL2 (which can take as long as a minute).
+
+  "vl model" can convert Verilog designs into two .sao files.
+
+     (The extension .sao stands for "Serialized ACL2 Object."  These files can
+      be quickly read into ACL2 using serialize-read.  For more information,
+      see:
+        http://fv.centtech.com/acl2/latest/doc/frames2.html?topic=ACL2____SERIALIZE)
+
+
+    model.sao -- This is just the serialized VL-TRANSLATION-P object produced
+                 by DEFMODULES.  It contains a lot of information, including
+                 for instance
+
+                   - the original source code that was read in,
+                   - the original, parsed versions of your Verilog modules,
+                   - the final, "fully simplified" versions of your modules,
+                   - the corresponding E modules for successful modules,
+                   - warnings that were encountered,
+                   - etc., etc.
+
+                 All of this stuff tends to make model.sao rather large, but
+                 can be very useful for exploring a translation.  (We use it
+                 as the basis for a web-based Verilog browsing tool.)
+
+
+
+    esims.sao -- This is a much smaller file that includes only the final
+                 E modules for successfully translated modules.
+
+                 Since this is much smaller than model.sao, it can be loaded
+                 more quickly.  We usually use this file as the basis for our
+                 ACL2 proofs.
+
+------------------------------------------------------------------------------
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/vl/kit/progutils.lisp acl2-6.3/books/centaur/vl/kit/progutils.lisp
--- acl2-6.2/books/centaur/vl/kit/progutils.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/progutils.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,97 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "VL")
+(include-book "oslib/file-types" :dir :system)
+(include-book "../util/defs")
+(local (include-book "../util/arithmetic"))
+(local (include-book "../util/osets"))
+
+(in-theory (disable (:executable-counterpart acl2::good-bye-fn)))
+
+(define exit-ok ()
+  (exit 0))
+
+(define exit-fail ()
+  (exit 1))
+
+(in-theory (disable (:executable-counterpart exit-ok)
+                    (:executable-counterpart exit-fail)))
+
+(defmacro die (&rest args)
+  `(progn$ (cw . ,args)
+           (exit-fail)))
+
+
+(define must-be-regular-files! ((files string-listp) &key (state 'state))
+  :returns (state state-p1 :hyp (force (state-p1 state)))
+  (b* ((files (mergesort files))
+       ((mv err missing-files state) (oslib::missing-paths files))
+       ((when err)
+        (die "Error checking existence of ~&0:~%~@1~%" files err)
+        state)
+       (missing-files (mergesort missing-files))
+       ((when missing-files)
+        (die "File~s0 not found: ~&1~%"
+             (if (vl-plural-p missing-files) "s" "")
+             missing-files)
+        state)
+       ((mv err regular-files state) (oslib::regular-files files))
+       ((when err)
+        (die "Error checking file types of ~&0:~%~@1~%" files err)
+        state)
+       (irregular-files (difference files (mergesort regular-files)))
+       ((when irregular-files)
+        (die "File~s0 not regular: ~&1~%"
+             (if (vl-plural-p irregular-files) "s are" " is")
+             irregular-files)
+        state))
+    state))
+
+
+(define must-be-directories! ((dirs string-listp) &key (state 'state))
+  :returns (state state-p1 :hyp (force (state-p1 state)))
+  (b* ((dirs (mergesort dirs))
+       ((mv err missing-dirs state) (oslib::missing-paths dirs))
+       ((when err)
+        (die "Error checking existence of ~&0:~%~@1~%" dirs err)
+        state)
+       (missing-dirs (mergesort missing-dirs))
+       ((when missing-dirs)
+        (die "~s0 not found: ~&1~%"
+             (if (vl-plural-p missing-dirs) "Directories" "Directory")
+             missing-dirs)
+        state)
+       ((mv err regular-dirs state) (oslib::directories dirs))
+       ((when err)
+        (die "Error checking file types of ~&0:~%~@1~%" dirs err)
+        state)
+       (irregular-dirs (difference dirs (mergesort regular-dirs)))
+       ((when irregular-dirs)
+        (die "~s0: ~&1~%"
+             (if (vl-plural-p irregular-dirs)
+                 "Paths are not directories"
+               "Path is not a directory")
+             irregular-dirs)
+        state))
+    state))
+
+
+
diff -Nru acl2-6.2/books/centaur/vl/kit/save.lsp acl2-6.3/books/centaur/vl/kit/save.lsp
--- acl2-6.2/books/centaur/vl/kit/save.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/save.lsp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,38 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(ld "cert.acl2")
+(in-package "VL")
+(include-book "top")
+(set-deferred-ttag-notes t state)
+(set-gag-mode :goals)
+
+:q
+
+;; Set up our program to not print a bunch of ACL2 banners.
+(setq *print-startup-banner* nil)
+
+;; Set up our program NOT try to read the any customization files.
+(defun initial-customization-filename () :none)
+
+(save-exec "../bin/vl" "VL Verilog Toolkit"
+           :inert-args ""
+           :return-from-lp '(vl::vl-main))
diff -Nru acl2-6.2/books/centaur/vl/kit/shell-raw.lsp acl2-6.3/books/centaur/vl/kit/shell-raw.lsp
--- acl2-6.2/books/centaur/vl/kit/shell-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/shell-raw.lsp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,54 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+
+(defun vl::vl-shell-fn (argv state)
+  (declare (ignore argv))
+  (format t "VL Verilog Toolkit
+Copyright (C) 2008-2013 Centaur Technology <http://www.centtech.com>
+
+  This program is free software; you can redistribute it and/or modify it under
+  the terms of the GNU General Public License as published by the Free Software
+  Foundation; either version 2 of the License, or (at your option) any later
+  version.  This program is distributed in the hope that it will be useful, but
+  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+  more details.  You should have received a copy of the GNU General Public
+  License along with this program; if not, write to the Free Software
+  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+  USA.
+
+,-------------------------,
+|  VL Interactive Shell   |     This is an interactive ACL2 shell with VL pre-
+|     (for experts)       |     loaded.  To learn about ACL2 (and hence how to
+|                         |     use this shell) see the ACL2 homepage:
+|   Type :quit to quit    |      http://www.cs.utexas.edu/users/moore/acl2
+`-------------------------'
+
+")
+
+  (f-put-global 'ld-verbose nil state)
+  ;; well, this doesn't seem to actually work and get us into an interactive
+  ;; LP shell.  But at least we get into a raw-lisp shell, which is probably
+  ;; fine for now.
+  (lp)
+  state)
+
diff -Nru acl2-6.2/books/centaur/vl/kit/shell.lisp acl2-6.3/books/centaur/vl/kit/shell.lisp
--- acl2-6.2/books/centaur/vl/kit/shell.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/shell.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,49 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "VL")
+(include-book "progutils")
+(include-book "tools/include-raw" :dir :system)
+(include-book "cutil/define" :dir :system)
+; (depends-on "shell-raw.lsp")
+
+(defconst *vl-shell-help* "
+vl shell:  Starts an interactive VL command loop (for experts).
+
+Usage:     vl shell    (there are no options)
+
+VL is built atop the ACL2 theorem prover.  The VL shell gives you access to the
+ACL2 command loop, with all of the VL functions already built in.
+
+This is mainly useful for VL developers who want to debug problems or explore
+adding new functionality.
+
+")
+
+(define vl-shell ((argv string-listp) &key (state 'state))
+  :returns state
+  :ignore-ok t
+  (progn$ (die "Raw lisp definition not installed?")
+          state))
+
+
+(defttag :vl-shell)
+(acl2::include-raw "shell-raw.lsp")
+
diff -Nru acl2-6.2/books/centaur/vl/kit/top.lisp acl2-6.3/books/centaur/vl/kit/top.lisp
--- acl2-6.2/books/centaur/vl/kit/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/kit/top.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,204 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "VL")
+(include-book "json")
+(include-book "lint")
+(include-book "model")
+(include-book "shell")
+(include-book "oslib/argv" :dir :system)
+(include-book "centaur/misc/intern-debugging" :dir :system)
+(include-book "centaur/misc/memory-mgmt" :dir :system)
+(local (include-book "../util/arithmetic"))
+(local (include-book "../util/osets"))
+
+(defconst *vl-generic-help*
+  "VL Verilog Toolkit
+Copyright (C) 2008-2013 Centaur Technology <http://www.centtech.com>
+
+Usage: vl <command> [arguments]
+
+Commands:
+
+  help    Print this message, or get help on a particular VL command
+  json    Convert Verilog designs into JSON files (for easy parsing)
+  lint    Find potential bugs in a Verilog design
+  model   Translate Verilog designs for the ACL2 theorem prover
+  shell   Interactive VL shell (for experts)
+
+Use 'vl help <command>' for help on a specific command.
+")
+
+(make-event
+ `(defsection kit
+    :parents (vl)
+    :short "A command-line program for using VL in basic ways."
+
+    :long ,(cat "<p>@(see VL) is mainly an ACL2 library, and a lot of its
+functionality and features are available only from within ACL2.  However, to
+make VL more widely approachable, we have bundled up certain pieces of it into
+a command line program, which we call the Kit.</p>
+
+<p>The kit is ordinarily built by running @('make vl') in the @('acl2/books')
+directory.  The source files are found in @('acl2/books/centaur/vl/kit') but
+the resulting executable is put into @('acl2/books/centaur/vl/bin') and is
+simply named @('vl').</p>
+
+<p>This @('vl') program is really just a wrapper for several sub-commands:</p>
+
+@({" *vl-generic-help* " })")))
+
+
+(defsection vl-toolkit-help-message
+  :parents (vl-help)
+  :short "Look up the help message for a VL kit program."
+  :long "<p>This is attachable so advanced users can add additional
+commands.</p>
+
+@(def *vl-help-messages*)
+@(def vl-toolkit-help-message)"
+
+  (defconst *vl-help-messages*
+    (list (cons "help"  *vl-generic-help*)
+          (cons "json"  *vl-json-help*)
+          (cons "lint"  *vl-lint-help*)
+          (cons "model" *vl-model-help*)
+          (cons "shell" *vl-shell-help*)))
+
+  (encapsulate
+    (((vl-toolkit-help-message *) => *
+      :formals (command)
+      :guard (stringp command)))
+    (local (defun vl-toolkit-help-message (command)
+             (declare (ignore command))
+             nil))
+    (defthm vl-toolkit-help-message-constraint
+      (or (not (vl-toolkit-help-message command))
+          (stringp (vl-toolkit-help-message command)))
+      :rule-classes :type-prescription)))
+
+
+(define vl-toolkit-help-message-default ((command stringp))
+  :parents (vl-toolkit-help-message)
+  :returns (help (or (not help)
+                     (stringp help))
+                 :rule-classes :type-prescription)
+  (cdr (assoc-equal command *vl-help-messages*))
+  ///
+  (defattach vl-toolkit-help-message vl-toolkit-help-message-default))
+
+
+(define vl-help ((args string-listp) &key (state 'state))
+  :parents (kit)
+  :short "The @('vl help') command."
+
+  (b* (((unless (or (atom args)
+                    (atom (cdr args))))
+        (die "Usage: vl help <command>~%")
+        state)
+       (command (if (atom args)
+                    "help"
+                  (car args)))
+       (help    (vl-toolkit-help-message command))
+       ((unless help)
+        (die "Unknown command ~s0." command)
+        state))
+    (vl-cw-ps-seq (vl-print help))
+    state))
+
+
+(defsection vl-toolkit-other-command
+  :parents (kit)
+  :short "Handler for additional vl toolkit commands."
+
+  :long "<p>By default this just dies with an error message that says the
+command is unknown.  But it is attachable, so advanced users can extend the
+toolkit with their own commands.</p>
+
+@(def vl-toolkit-other-command)"
+
+  (encapsulate
+    (((vl-toolkit-other-command * * state) => state
+      :formals (command args state)
+      :guard (and (stringp command)
+                  (string-listp args)
+                  (state-p1 state))))
+    (local (defun vl-toolkit-other-command (command args state)
+             (declare (ignore command args)
+                      (xargs :stobjs state))
+             state))))
+
+
+(define vl-toolkit-other-command-default ((command stringp)
+                                          (args string-listp)
+                                          state)
+  :parents (vl-toolkit-other-command)
+  :ignore-ok t
+  (progn$
+   (die "Unknown command ~s0.~%" command)
+   state)
+  ///
+  (defattach vl-toolkit-other-command vl-toolkit-other-command-default))
+
+
+(define vl-main (&key (state 'state))
+  :parents (kit)
+  :short "The top-level @('vl') meta-command."
+
+  (b* (((mv argv state) (oslib::argv))
+
+       ((unless (consp argv))
+        (b* ((state (vl-help '("help"))))
+          (exit-fail)
+          state))
+
+       ((cons cmd args) argv)
+
+       ((when (or (equal cmd "help")
+                  (equal cmd "-h")
+                  (equal cmd "--help")))
+        (b* ((state (vl-help args)))
+          (exit-ok)
+          state))
+
+       ((when (equal cmd "json"))
+        (b* ((state (vl-json args)))
+          (exit-ok)
+          state))
+
+       ((when (equal cmd "lint"))
+        (b* ((state (vl-lint args)))
+          (exit-ok)
+          state))
+
+       ((when (equal cmd "model"))
+        (b* ((state (vl-model args)))
+          (exit-ok)
+          state))
+
+       ((when (equal cmd "shell"))
+        (b* ((state (vl-shell args)))
+          ;; Do NOT exit here.  If you do, commands like :q quit entirely
+          ;; instead of dropping you into raw Lisp.
+          state))
+       )
+
+    (vl-toolkit-other-command cmd args state)))
+
diff -Nru acl2-6.2/books/centaur/vl/lint/bit-use-set.lisp acl2-6.3/books/centaur/vl/lint/bit-use-set.lisp
--- acl2-6.2/books/centaur/vl/lint/bit-use-set.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/lint/bit-use-set.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -269,8 +269,8 @@
                   :vl-inout))
   :hints(("Goal"
           :in-theory (e/d (vl-direction-p)
-                          (vl-direction-p-of-vl-portdecl->dir))
-          :use ((:instance vl-direction-p-of-vl-portdecl->dir)))))
+                          (return-type-of-vl-portdecl->dir))
+          :use ((:instance return-type-of-vl-portdecl->dir)))))
 
 ;; (defthm vl-compounstmt->ctrl-when-timingstmt
 ;;   ;; BOZO move to stmt tools
@@ -2705,7 +2705,7 @@
                          (cons (make-vl-warning
                                 :type :use-set-fudging
                                 :msg "~a0: No wires for this net?"
-                                :args (list x)
+                                :args (list (car x))
                                 :fatalp nil
                                 :fn 'vl-netdecllist-wires)
                                warnings)))
diff -Nru acl2-6.2/books/centaur/vl/lint/lint.acl2 acl2-6.3/books/centaur/vl/lint/lint.acl2
--- acl2-6.2/books/centaur/vl/lint/lint.acl2	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/lint/lint.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,7 +0,0 @@
-(in-package "ACL2")
-#+gcl (acl2::value :q)
-#+gcl (setq si::*optimize-maximum-pages* nil)
-#+gcl (acl2::lp)
-(include-book "../portcullis")
-; cert-flags: ? t :ttags :all
-(certify-book "lint" ? t :ttags :all)
diff -Nru acl2-6.2/books/centaur/vl/lint/lint.lisp acl2-6.3/books/centaur/vl/lint/lint.lisp
--- acl2-6.2/books/centaur/vl/lint/lint.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/lint/lint.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,912 +0,0 @@
-; VL Verilog Toolkit
-; Copyright (C) 2008-2013 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "VL")
-
-(include-book "bit-use-set")
-(include-book "check-case")
-(include-book "check-namespace")
-(include-book "disconnected")
-(include-book "xf-drop-missing-submodules")
-(include-book "xf-drop-user-submodules")
-(include-book "xf-lint-stmt-rewrite")
-(include-book "xf-remove-toohard")
-(include-book "xf-undefined-names")
-(include-book "xf-suppress-warnings")
-
-(include-book "../checkers/condcheck")
-(include-book "../checkers/duplicate-detect")
-(include-book "../checkers/dupeinst-check")
-(include-book "../checkers/duperhs")
-(include-book "../checkers/leftright")
-(include-book "../checkers/multidrive-detect")
-(include-book "../checkers/oddexpr")
-(include-book "../checkers/portcheck")
-(include-book "../checkers/qmarksize-check")
-(include-book "../checkers/selfassigns")
-(include-book "../checkers/skip-detect")
-
-(include-book "../loader/loader")
-(include-book "../transforms/cn-hooks")
-(include-book "../transforms/xf-argresolve")
-(include-book "../transforms/xf-array-indexing")
-(include-book "../transforms/xf-assign-trunc")
-(include-book "../transforms/xf-blankargs")
-(include-book "../transforms/xf-clean-params")
-(include-book "../transforms/xf-drop-blankports")
-(include-book "../transforms/xf-expr-split")
-(include-book "../transforms/xf-expand-functions")
-(include-book "../transforms/xf-follow-hids")
-(include-book "../transforms/xf-hid-elim")
-(include-book "../transforms/xf-orig")
-(include-book "../transforms/xf-oprewrite")
-(include-book "../transforms/xf-portdecl-sign")
-(include-book "../transforms/xf-resolve-ranges")
-(include-book "../transforms/xf-replicate-insts")
-(include-book "../transforms/xf-sizing")
-(include-book "../transforms/xf-unparameterize")
-(include-book "../transforms/xf-unused-reg")
-
-(include-book "../../misc/sneaky-load")
-
-(local (include-book "../mlib/modname-sets"))
-(local (include-book "../util/arithmetic"))
-(local (include-book "../util/osets"))
-
-(make-event
-
-; Disabling waterfall parallelism because this book allegedly uses memoization
-; while performing its proofs.
-
- (if (and (ACL2::hons-enabledp state)
-          (f-get-global 'ACL2::parallel-execution-enabled state))
-     (er-progn (set-waterfall-parallelism nil)
-               (value '(value-triple nil)))
-   (value '(value-triple nil))))
-
-
-(defsection lint
-  :parents (vl)
-  :short "A linting tool for Verilog."
-  :long "<p>A <a
-href='http://en.wikipedia.org/wiki/Lint_%28software%29'>linter</a> is a tool
-that looks for possible bugs in a program.  We now implement such a linter for
-Verilog, reusing much of @(see vl).</p>")
-
-
-(define vl-filter-mods-with-good-paramdecls
-  ((x    vl-modulelist-p "List of modules to filter.")
-   (good vl-modulelist-p "Accumulator for good modules.")
-   (bad  vl-modulelist-p "Accumulator for bad modules."))
-  :returns (mv (good vl-modulelist-p :hyp :fguard)
-               (bad  vl-modulelist-p :hyp :fguard))
-  :parents (lint)
-  :short "(unsound transform) Throw away modules with too-complex parameter
-declarations. "
-
-  :long "<p>@(csee unparameterization) requires that the module list is
-complete and that all modules have good parameters.  In our ordinary
-translation process (e.g., @(see vl-simplify)), we throw away any modules with
-bad parameters, any then transitively throw away any modules with instances of
-missing modules.  But for linting, we'd like to try to carry out
-unparameterization with as little damage as possible.</p>
-
-<p>As a pre-unparameterization step, in this transform we throw away any
-modules with bad parameters and then throw away any instances of missing
-modules.  This is obviously unsound, so it should never be used in our ordinary
-translation process.</p>"
-
-  (cond ((atom x)
-         (mv good bad))
-        ((vl-good-paramdecllist-p (vl-module->paramdecls (car x)))
-         (vl-filter-mods-with-good-paramdecls (cdr x)
-                                              (cons (car x) good)
-                                              bad))
-        (t
-         (vl-filter-mods-with-good-paramdecls (cdr x)
-                                              good
-                                              (cons (car x) bad)))))
-
-
-(define vl-print-certain-warnings
-  ((mods vl-modulelist-p "Modules to print warnings for.")
-   (show symbol-listp    "Types of warnings to show.")
-   (hide symbol-listp    "Types of warnings to hide."))
-  :parents (lint)
-  :short "Print warnings of interest to standard output, while hiding other
-warnings."
-
-  :long "<p>You can use this to print just a few warnings you are interested in
-while hiding other warnings you know you are not interested in.  If there are
-warnings of other types (that you haven't said to show or hide), they too will
-be hidden but you'll at least get a message saying that they aren't being
-shown.</p>"
-
-  (b* ((warnings (vl-modulelist-flat-warnings-exec mods nil))
-       (types    (mergesort (vl-warninglist->types-exec warnings nil)))
-       (hide     (if hide
-                     (mergesort hide)
-                   types))
-       (show     (mergesort show))
-       ;; Misc is all the warning types that we aren't told to show, but aren't
-       ;; told to ignore.  We'll print a note that these warnings exist but
-       ;; that we weren't told to show or hide them.
-       (misc     (difference types (union show hide)))
-       (warnings (vl-keep-warnings show warnings)))
-    (vl-cw-ps-seq
-     (vl-ps-update-autowrap-col 65)
-     (vl-print-warnings warnings)
-     (vl-println "")
-     (if (not misc)
-         ps
-       (vl-ps-seq
-        (vl-cw "Note: not showing ~&0 warnings.~%" misc)
-        (vl-println ""))))))
-
-
-(defaggregate vl-lintconfig
-  :parents (lint)
-  :short "Options for running the linter."
-  :tag :vl-lintconfig
-  ((loadconfig vl-loadconfig-p
-               "Configuration for @(see vl-load); says what files to load, what
-                search paths to use, etc.")
-
-   (topmods    string-listp
-               "This is a way to filter the report to exclude modules you do
-                not care about.  If @('nil'), no filtering is done and we
-                include warnings for every module.  Otherwise, we throw out any
-                modules that aren't necessary for some module in
-                @('topmods').")
-
-   (dropmods   string-listp
-               "This is a way to explicitly drop modules that are problematic
-                for whatever reason.  The dropped modules are removed from the
-                module list without destroying modules above them.  This is
-                obviously unsound, but can be useful.")
-
-   (ignore     string-listp
-               ;; BOZO xdoc for how this stuff works
-               "Ignore warnings of certain types, e.g., if this list includes
-                the string \"oddexpr\" then we will suppress warnings such as
-                @(':VL-WARN-ODDEXPR).  See @('xf-suppress-warnings.lisp') for
-                details.")))
-
-(defaggregate vl-lintresult
-  :parents (lint)
-  :short "Results from running the linter."
-  :tag :vl-lintresult
-  ((mods      vl-modulelist-p
-              "Final, transformed list of modules.  Typically this isn't very
-               interesting or relevant to anything.")
-
-   (mods0     vl-modulelist-p
-              "Almost: the initial, pre-transformed modules.  The only twist is
-               that we have already removed modules that are unnecessary or
-               that we wanted to drop; see, e.g., the @('topmods') and
-               @('ignore') options of @(see vl-lintconfig-p).  This is used for
-               @(see skip-detection), for instance.")
-
-   (mwalist   vl-modwarningalist-p
-              "The main result: binds \"original\" (pre-unparameterization)
-               module names to their warnings.")
-
-   (sd-probs  sd-problemlist-p
-              "Possible problems noticed by @(see skip-detection).  These are
-               in a different format than ordinary @(see warnings), so they
-               aren't included in the @('mwalist').")
-
-   (dalist    us-dbalist-p
-              "Use-set database alist, mapping module names to use-set databases.
-               Might actually not be used for anything.")))
-
-(define run-vl-lint-main ((mods     (and (vl-modulelist-p mods)
-                                         (uniquep (vl-modulelist->names mods))))
-                          (config   vl-lintconfig-p))
-  :returns (result vl-lintresult-p :hyp :fguard)
-
-  (b* (((vl-lintconfig config) config)
-
-       (mods (vl-modulelist-drop-user-submodules mods config.dropmods))
-
-       ;; You might expect that we'd immediately throw out modules that we
-       ;; don't need for topmods.  Historically we did that.  But then we found
-       ;; that we'd get a bunch of complaints in other modules about
-       ;; hierarchical identifiers that pointed into the modules we'd just
-       ;; thrown away!  So now we deal with this stuff after HID resolution.
-       ;; Except that for skip-detection, we also need to remove them from
-       ;; mods0, so do that now:
-       (mods0 (if (not config.topmods)
-                  mods
-                (vl-remove-unnecessary-modules (mergesort config.topmods)
-                                               (mergesort mods))))
-
-
-       (- (cw "~%vl-lint: initial processing...~%"))
-       (mods (cwtime (vl-modulelist-portcheck mods)))
-       (mods (cwtime (vl-modulelist-check-case mods)))
-       (mods (cwtime (vl-modulelist-duperhs-check mods)))
-       (mods (cwtime (vl-modulelist-duplicate-detect mods)))
-       (mods (cwtime (vl-modulelist-condcheck mods)))
-       (mods (cwtime (vl-modulelist-leftright-check mods)))
-       (mods (cwtime (vl-modulelist-drop-missing-submodules mods)))
-       ;; BOZO reinstate this??
-       ;; (mods (cwtime (vl-modulelist-add-undefined-names mods)))
-       (mods (cwtime (vl-modulelist-portdecl-sign mods)))
-       (mods (cwtime (vl-modulelist-make-array-indexing mods)))
-       (mods (cwtime (vl-modulelist-origexprs mods)))
-       (mods (cwtime (vl-modulelist-check-namespace mods)))
-
-       (- (cw "~%vl-lint: processing arguments, parameters...~%"))
-       (mods (cwtime (vl-modulelist-elim-unused-regs mods)))
-       (mods (cwtime (vl-modulelist-argresolve mods)))
-       (mods (cwtime (vl-modulelist-dupeinst-check mods)))
-
-       ;; BOZO not exactly sure where this should go, maybe this will work.
-       (mods (cwtime (vl-modulelist-expand-functions mods)))
-
-       ;; BOZO we need to do something to throw away instances with unresolved
-       ;; arguments to avoid programming-errors in drop-blankports... and actually
-       ;; we hit errors like that later, too.
-       (mods (cwtime (vl-modulelist-drop-blankports mods)))
-       (mods (cwtime (mp-verror-transform-hook mods)))
-       (mods (cwtime (vl-modulelist-follow-hids mods)))
-       (mods (cwtime (vl-modulelist-clean-params mods)))
-       (mods (cwtime (vl-modulelist-check-good-paramdecls mods)))
-
-       ((mv mods bad)
-        (vl-filter-mods-with-good-paramdecls mods nil nil))
-       (- (or (not bad)
-              (progn$
-               (cw "~%~%Note: deleting ~x0 module~s1 because they include ~
-                    unsupported parameter declarations.~%~%~
-                    Module~s1 being deleted: ~&2~%~%~
-                    Details:~%~%"
-                   (len bad)
-                   (if (= (len bad) 1) "" "s")
-                   (mergesort (vl-modulelist->names bad)))
-               (vl-print-certain-warnings bad
-                                          (list :vl-bad-paramdecl
-                                                :vl-bad-paramdecls)
-                                          nil))))
-       (mods (cwtime (vl-modulelist-drop-missing-submodules mods)))
-       (mods (if (and (uniquep (vl-modulelist->names mods))
-                      (vl-modulelist-complete-p mods mods)
-                      (vl-good-paramdecllist-list-p-of-vl-modulelist->paramdecls mods))
-                 mods
-               (er hard? 'vl-lint
-                   "Programming error.  Expected modules to be complete ~
-                    and to have good parameters, but this is not the case. ~
-                    Please tell Jared about this failure.")))
-       ((mv mods failmods) (cwtime (vl-unparameterize mods 30)))
-       (mods (append mods failmods))
-       (- (vl-gc))
-
-       (mods (if (uniquep (vl-modulelist->names mods))
-                 mods
-               (progn$
-                (sneaky-save :bad-names mods)
-                (er hard? 'vl-lint
-                    "Programming error.  Expected modules to have unique ~
-                      names after vl-unparameterize, but found duplicate ~
-                      modules named ~x0.  Please tell Jared."
-                    (duplicated-members (vl-modulelist->names mods))))))
-
-
-       (- (cw "~%vl-lint: processing ranges, statements...~%"))
-       (mods (cwtime (vl-modulelist-rangeresolve mods)))
-       (mods (cwtime (vl-modulelist-selresolve mods)))
-       (mods (cwtime (vl-modulelist-check-selfassigns mods)))
-       (mods (cwtime (vl-modulelist-lint-stmt-rewrite mods)))
-       (mods (cwtime (vl-modulelist-stmtrewrite mods 1000)))
-       (mods (cwtime (vl-modulelist-hid-elim mods)))
-
-       (mods (if (uniquep (vl-modulelist->names mods))
-                 mods
-               (progn$
-                (sneaky-save :bad-names mods)
-                (er hard? 'vl-lint
-                    "Programming error.  Expected modules to have unique ~
-                    names after vl-modulelist-hid-elim, but found duplicate ~
-                    modules named ~x0.  Please tell Jared."
-                    (duplicated-members (vl-modulelist->names mods))))))
-
-       ;; Now that HIDs are gone, we can throw away any modules we don't care
-       ;; about, if we have been given any topmods.
-       (mods (if (not config.topmods)
-                 mods
-               (vl-remove-unnecessary-modules (mergesort config.topmods)
-                                              (mergesort mods))))
-
-
-       ;; BOZO it seems sort of legitimate to do this before sizing, which
-       ;; might be nice.  Of course, a more rigorous use/set analysis will
-       ;; need to be post-sizing.
-       (- (cw "~%vl-lint: finding disconnected wires...~%"))
-       (mods (cwtime (vl-modulelist-remove-toohard mods)))
-       (mods (cwtime (vl-modulelist-find-disconnected mods)))
-
-       (- (cw "~%vl-lint: processing expressions...~%"))
-       (mods (cwtime (vl-modulelist-oddexpr-check mods)))
-       (mods (cwtime (vl-modulelist-oprewrite mods)))
-       (mods (cwtime (vl-modulelist-exprsize mods)))
-       (mods (cwtime (vl-modulelist-qmarksize-check mods)))
-
-       (- (cw "~%vl-lint: finding unused/unset wires...~%"))
-       ;; BOZO this probably doesn't quite work here due to replicate not having been done
-       ((mv mods dalist) (cwtime (us-analyze-mods mods)))
-       (- (vl-gc))
-
-       (- (cw "~%vl-lint: processing assignments...~%"))
-       (mods (cwtime (vl-modulelist-split mods)))
-       (mods (cwtime (vl-modulelist-replicate mods)))
-       (mods (cwtime (vl-modulelist-blankargs mods)))
-       (mods (cwtime (vl-modulelist-trunc mods)))
-
-       (- (cw "~%vl-lint: finding skipped and multiply driven wires...~%"))
-       ;; NOTE: use mods0, not mods, if you ever want this to finish. :)
-       (sd-probs (cwtime (sd-analyze-modulelist mods0)))
-       (mods     (cwtime (vl-modulelist-multidrive-detect mods)))
-
-       (- (cw "~%vl-lint: cleaning up...~%"))
-       (mods    (cwtime (vl-modulelist-clean-warnings mods)))
-       (mods    (cwtime (vl-modulelist-suppress-lint-warnings mods)))
-       (mods    (cwtime (vl-modulelist-lint-ignoreall mods config.ignore)))
-       (mwalist (cwtime (vl-origname-modwarningalist mods))))
-
-    (make-vl-lintresult :mods mods
-                        :mods0 mods0
-                        :mwalist mwalist
-                        :sd-probs sd-probs
-                        :dalist dalist)))
-
-
-(define run-vl-lint
-  (&key (start-files string-listp)
-        (search-path string-listp)
-        (search-exts string-listp)
-        (topmods     string-listp)
-        (dropmods    string-listp)
-        (ignore      string-listp)
-        (state       'state))
-  :returns (mv (res vl-lintresult-p :hyp :fguard)
-               (state state-p1 :hyp (state-p1 state)))
-  (b* ((- (cw "Starting VL-Lint~%"))
-       (loadconfig (make-vl-loadconfig
-                    :start-files   start-files
-                    :search-path   search-path
-                    :search-exts   search-exts))
-       (lintconfig (make-vl-lintconfig
-                    :loadconfig loadconfig
-                    :topmods    topmods
-                    :dropmods   dropmods
-                    :ignore     ignore))
-       (- (cw "~%vl-lint: loading modules...~%"))
-       ((mv loadres state) (cwtime (vl-load loadconfig)))
-
-       (lintres
-        (cwtime (run-vl-lint-main (vl-loadresult->mods loadres)
-                                  lintconfig))))
-    (mv lintres state)))
-
-
-(defund sd-problem-major-p (x)
-  (declare (xargs :guard (sd-problem-p x)))
-  (b* (((sd-problem x) x))
-    (or (>= x.priority 10)
-        (and (>= x.priority 6) (>= x.groupsize 4))
-        (>= (sd-problem-score x) 8))))
-
-(defsection sd-filter-problems
-
-  (defund sd-filter-problems (x major minor)
-    "Returns (MV MAJOR MINOR)"
-    (declare (xargs :guard (sd-problemlist-p x)))
-    (cond ((atom x)
-           (mv major minor))
-          ((sd-problem-major-p (car x))
-           (sd-filter-problems (cdr x) (cons (car x) major) minor))
-          (t
-           (sd-filter-problems (cdr x) major (cons (car x) minor)))))
-
-  (local (in-theory (enable sd-filter-problems)))
-
-  (defthm sd-problemlist-p-of-sd-filter-problems
-    (and (implies (and (sd-problemlist-p x)
-                       (sd-problemlist-p major))
-                  (sd-problemlist-p (mv-nth 0 (sd-filter-problems x major minor))))
-         (implies (and (sd-problemlist-p x)
-                       (sd-problemlist-p minor))
-                  (sd-problemlist-p (mv-nth 1 (sd-filter-problems x major minor)))))))
-
-
-
-
-
-
-(defund vl-modwarningalist-types (x)
-  (declare (xargs :guard (vl-modwarningalist-p x)))
-  (if (atom x)
-      nil
-    (append (vl-warninglist->types (cdar x))
-            (vl-modwarningalist-types (cdr x)))))
-
-
-(defund vl-keep-from-modwarningalist (types x)
-  ;; Returns a new fast alist.
-  (declare (xargs :guard (and (symbol-listp types)
-                              (vl-modwarningalist-p x))))
-  (if (atom x)
-      nil
-    (b* ((name1     (caar x))
-         (warnings1 (cdar x))
-         (keep1     (vl-keep-warnings types warnings1))
-         (rest      (vl-keep-from-modwarningalist types (cdr x))))
-      (if keep1
-          (hons-acons name1 keep1 rest)
-        rest))))
-
-(defthm vl-modwarningalist-p-of-vl-keep-from-modwarningalist
-  (implies (and (force (symbol-listp types))
-                (force (vl-modwarningalist-p x)))
-           (vl-modwarningalist-p (vl-keep-from-modwarningalist types x)))
-  :hints(("Goal" :in-theory (enable vl-keep-from-modwarningalist))))
-
-
-(define vl-lint-print-warnings ((filename stringp)
-                                (label    stringp)
-                                (types    symbol-listp)
-                                (walist   vl-modwarningalist-p)
-                                &key (ps 'ps))
-  (b* ((walist (vl-keep-from-modwarningalist types walist))
-       (walist (vl-clean-modwarningalist walist))
-       (count  (length (append-domains walist)))
-       (-      (cond ((int= count 0)
-                      (cw "~s0: No ~s1 Warnings.~%" filename label))
-                     ((int= count 1)
-                      (cw "~s0: One ~s1 Warning.~%" filename label))
-                     (t
-                      (cw "~s0: ~x1 ~s2 Warnings.~%" filename count label)))))
-    (vl-ps-seq
-     (cond ((int= count 0)
-            (vl-cw "No ~s0 Warnings.~%~%" label))
-           ((int= count 1)
-            (vl-cw "One ~s0 Warning:~%~%" label))
-           (t
-            (vl-cw "~x0 ~s1 Warnings:~%~%" count label)))
-     (vl-print-modwarningalist walist))))
-
-
-
-(defconst *use-set-warnings*
-  (list :use-set-fudging
-        :use-set-trainwreck
-        :use-set-future-trainwreck
-        :use-set-warn-1-unset
-        :use-set-warn-1-unset-tricky
-        :use-set-warn-2-unused
-        :use-set-warn-2-unused-tricky
-        :use-set-warn-3-spurious
-        :use-set-warn-3-spurious-tricky
-        :use-set-syntax-error
-        :vl-collect-wires-approx
-        :vl-collect-wires-fail
-        :vl-dropped-always
-        :vl-dropped-assign
-        :vl-dropped-initial
-        :vl-dropped-insts
-        :vl-dropped-modinst
-        :vl-warn-function
-        :vl-warn-taskdecl
-        :vl-unsupported-block))
-
-(defconst *basic-warnings*
-  (list :bad-mp-verror
-        :vl-bad-range
-        :vl-warn-duplicates
-        :vl-bad-instance
-        :vl-unresolved-hid
-        :vl-warn-unused-reg
-        :vl-warn-blank
-        :vl-undefined-names
-        :vl-port-mismatch))
-
-(defconst *trunc-warnings*
-  (list :vl-warn-extension
-        :vl-warn-truncation
-        :vl-warn-integer-size))
-
-(defconst *trunc-minor-warnings*
-  (list :vl-warn-extension-minor
-        :vl-warn-truncation-minor
-        :vl-warn-integer-size-minor
-        :vl-warn-vague-spec))
-
-(defconst *disconnected-warnings*
-  (list :vl-warn-disconnected
-        :vl-warn-disconnected-interesting
-        ;; Caveats that could make the analysis wrong
-        :vl-collect-wires-fail
-        :vl-collect-wires-approx
-        :vl-dropped-always
-        :vl-dropped-assign
-        :vl-dropped-initial
-        :vl-dropped-insts
-        :vl-dropped-modinst
-        :vl-warn-function
-        :vl-warn-taskdecl
-        :vl-unsupported-block))
-
-(defconst *smell-warnings*
-  (list :vl-warn-qmark-width
-        :vl-warn-qmark-const
-        :vl-warn-leftright
-        :vl-warn-selfassign
-        :vl-warn-instances-same
-        :vl-warn-case-sensitive-names
-        :vl-warn-same-rhs))
-
-(defconst *smell-minor-warnings*
-  (list :vl-warn-partselect-same
-        :vl-warn-instances-same-minor))
-
-(defconst *multidrive-warnings*
-  (list :vl-warn-multidrive))
-
-(defconst *multidrive-minor-warnings*
-  (list :vl-warn-multidrive-minor))
-
-(defconst *fussy-size-warnings*
-  (list :vl-fussy-size-warning-1
-        :vl-fussy-size-warning-2
-        :vl-fussy-size-warning-3
-        :vl-fussy-size-warning-1-const-toobig
-        :vl-fussy-size-warning-2-const-toobig
-        :vl-fussy-size-warning-3-const-toobig
-        :vl-fussy-size-warning-1-complex
-        :vl-fussy-size-warning-2-complex
-        :vl-fussy-size-warning-3-complex
-        ))
-
-(defconst *same-ports-warnings*
-  (list :vl-warn-same-ports
-        :vl-warn-same-inputs))
-
-(defconst *same-ports-minor-warnings*
-  (list :vl-warn-same-ports-minor
-        :vl-warn-same-inputs-minor))
-
-(defconst *fussy-size-minor-warnings*
-  (list :vl-fussy-size-warning-1-minor
-        :vl-fussy-size-warning-2-minor
-        :vl-fussy-size-warning-3-minor))
-
-
-
-
-(defconst *warnings-covered*
-
-  ;; Warnings that are covered by our regular reports.  Other warnings besides
-  ;; these will get put into vl-other.txt
-
-  (append *use-set-warnings*
-          *basic-warnings*
-          *trunc-warnings*
-          *trunc-minor-warnings*
-          *disconnected-warnings*
-          *smell-warnings*
-          *smell-minor-warnings*
-          *multidrive-warnings*
-          *multidrive-minor-warnings*
-          *fussy-size-warnings*
-          *fussy-size-minor-warnings*
-          *same-ports-warnings*
-          *same-ports-minor-warnings*
-          ))
-
-(defconst *warnings-ignored*
-
-  ;; Warnings that aren't covered but which we don't want to put into vl-other.txt
-  ;; anyway.
-
-  (list
-   :vl-warn-taskdecl
-   :vl-warn-function
-
-   ))
-
-(defun vl-lint-report (lintresult state)
-  (declare (xargs :guard (vl-lintresult-p lintresult)
-                  :mode :program
-                  :stobjs state))
-
-  (b* (((vl-lintresult lintresult) lintresult)
-       (walist   lintresult.mwalist)
-       (sd-probs lintresult.sd-probs)
-
-       ((mv major minor)
-        (cwtime (sd-filter-problems sd-probs nil nil)))
-       (major (reverse major))
-       (minor (reverse minor))
-
-       (- (cw "~%vl-lint: saving results...~%~%"))
-
-       (othertypes  (difference (mergesort (vl-modwarningalist-types walist))
-                                (mergesort (append *warnings-covered*
-                                                   *warnings-ignored*))))
-
-       (state
-        (with-ps-file
-         "vl-basic.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-basic.txt" "Basic" *basic-warnings* walist)))
-
-       (state
-        (with-ps-file
-         "vl-trunc.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-print "
-NOTE: see the bottom of this file for an explanation of what these warnings
-mean and how to avoid them.
-
-")
-
-         (vl-lint-print-warnings "vl-trunc.txt" "Truncation/Extension" *trunc-warnings* walist)
-
-         (vl-print "
-
-UNDERSTANDING THESE WARNINGS.
-
-1. VL-WARN-TRUNCATION warnings are issued when the left-hand side of an
-assignment statement is not as wide as the right-hand side.
-
-False positives here can typically be suppressed by using part-selects to make
-the intended truncations explicit.  For instance:
-
-    wire [47:0] foo ;
-    wire [63:0] bar ;
-
-    assign foo = bar ;        // implicit truncation, causes warning
-    assign foo = bar[47:0] ;  // explicit truncation, no warning
-
-    assign foo = condition ? bar : 0 ;      // implicit truncation, causes warning
-    assign foo = condition ? bar[47:0] : 0; // explicit truncation, no warning
-
-
-2. VL-WARN-EXTENSION warnings are the opposite: they are issued when the
-left-hand side is wider than the right-hand side would have been on its own.
-
-False-positives can again typically be suppressed by explicitly concatenting in
-zeroes, or by using part-selects to cut the left-hand side to the right size.
-For instance:
-
-    wire [47:0] foo ;
-    wire [63:0] bar ;
-
-    assign bar = foo ;             // implicit extension, causes warning
-    assign bar = { 16'b0, foo } ;  // explicit extension, no warning
-    assign bar[47:0] = foo;        // no extension, no warning
-
-
-Note that we consider certain truncation and extension warnings to be \"minor\"
-and do not report them here.  Such warnings are unlikely to be a problem, but
-you can see \"vl-trunc-minor.txt\" to review them.")))
-
-       (state
-        (with-ps-file
-         "vl-fussy.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-fussy.txt" "Fussy Size Warnings" *fussy-size-warnings* walist)))
-
-       (state
-        (with-ps-file
-         "vl-fussy-minor.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-fussy-minor.txt" "Minor Fussy Size Warnings" *fussy-size-minor-warnings* walist)))
-
-       (state
-        (with-ps-file
-         "vl-disconnected.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-disconnected.txt" "Disconnected Wire" *disconnected-warnings* walist)))
-
-       (state
-        (with-ps-file
-         "vl-multi.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-multi.txt" "Multidrive" *multidrive-warnings* walist)))
-
-       (state
-        (if (not major)
-            (progn$
-             (cw "; No Skip-Detect Warnings.~%")
-             state)
-          (progn$
-           (cw "vl-skipdet.txt: ~x0 Skip-Detect Warnings.~%" (len major))
-           (with-ps-file "vl-skipdet.txt"
-                         (vl-ps-update-autowrap-col 68)
-                         (vl-cw "Skip-Detect Warnings.~%~%")
-                         (sd-pp-problemlist-long major)))))
-
-       (state
-        (with-ps-file
-         "vl-trunc-minor.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-print "
-NOTE: see the bottom of this file for an explanation of what these warnings
-mean and how to avoid them.
-
-")
-         (vl-lint-print-warnings "vl-trunc-minor.txt" "Minor Truncation/Extension" *trunc-minor-warnings* walist)
-         (vl-print "
-
-UNDERSTANDING THESE WARNINGS.
-
-1.  VL-WARN-TRUNCATION-32 warnings are generated for any assignments that are
-being truncated and whose right-hand sides are 32-bits wide.  This is a minor
-warning because it typically arises from assignments where plain integers are
-involved, e.g., if foo and bar are 10 bits wide, then a truncation-32 warning
-will be generated for:
-
-    assign foo = bar ^ 5;
-
-This is because \"5\" has an implementation-dependent width (of at least 32
-bits), and in VL-Lint we treat it as being 32-bits wide.  So, the above
-describes a 32-bit XOR that is then truncated down to 10 bits.  Fixing these
-warnings is usually easy: just explicitly specify the sizes of the numbers
-involved, e.g., a \"corrected\" version might be:
-
-    assign foo = bar ^ 10'd 5;
-
-This is generally a good idea since it avoids any implementation-dependent
-sizing (which can occasionally affect the results of expressions).
-
-
-2.  VL-WARN-EXTENSION-MINOR warnings are generated for any assignments where
-the width of the left-hand side is used to size the expression, and where the
-right-hand side involves only addition operations.  For instance, given:
-
-    wire [9:0] foo;
-    wire [9:0] bar;
-    wire [9:0] sum;
-    wire carry;
-
-Then an assignment like this:
-
-    assign { carry, sum } = foo + bar;
-
-would result in a minor extension warning.  These warnings are typically quite
-minor since you frequently want to get the carry out of a sum.  But you could
-suppress them by writing something like this:
-
-    Variant 1: assign {carry, sum} = {1'b0,foo} + bar;
-    Variant 2: assign {carry, sum} = foo + bar + 11'b0;
-
-or similar, to make explicit on the right-hand side that you want an 11-bit
-wide addition instead of a 10-bit wide addition.")))
-
-       (state
-        (with-ps-file
-         "vl-multi-minor.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-multi-minor.txt" "Minor Multidrive" *multidrive-minor-warnings* walist)))
-
-       (state
-        (if (not minor)
-            (prog2$
-             (cw "; No Minor Skip-Detect Warnings.~%")
-             state)
-          (prog2$
-           (cw "vl-skipdet-minor.txt: ~x0 Minor Skip-Detect Warnings.~%" (len minor))
-           (with-ps-file "vl-skipdet-minor.txt"
-                         (vl-ps-update-autowrap-col 68)
-                         (vl-cw "Minor Skip-Detect Warnings.~%~%")
-                         (sd-pp-problemlist-long minor)))))
-
-
-       (state
-        (with-ps-file
-         "vl-use-set.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-use-set.txt"
-                                 "Unused/Unset Wire Warnings"
-                                 *use-set-warnings*
-                                 walist)))
-
-
-       (state
-        (with-ps-file
-         "vl-smells.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-smells.txt" "Code-Smell Warnings" *smell-warnings* walist)))
-
-       (state
-        (with-ps-file
-         "vl-smells-minor.txt"
-         (vl-ps-update-autowrap-col 68)
-         (vl-lint-print-warnings "vl-smells-minor.txt" "Minor Code-Smell Warnings" *smell-minor-warnings* walist)))
-
-
-      (state
-       (with-ps-file "vl-same-ports.txt"
-                     (vl-ps-update-autowrap-col 68)
-                     (vl-lint-print-warnings "vl-same-ports.txt"
-                                             "Same-ports Warnings"
-                                             *same-ports-warnings*
-                                             walist)))
-      (state
-       (with-ps-file "vl-same-ports-minor.txt"
-                     (vl-ps-update-autowrap-col 68)
-                     (vl-lint-print-warnings "vl-same-ports-minor.txt"
-                                             "Minor same-ports Warnings"
-                                             *same-ports-minor-warnings*
-                                             walist)))
-
-      (state
-       (with-ps-file
-        "vl-other.txt"
-        (vl-ps-update-autowrap-col 68)
-        (vl-lint-print-warnings "vl-other.txt" "Other/Unclassified" othertypes walist)))
-
-       (- (cw "~%")))
-
-    state))
-
-
-(encapsulate
-  ()
-  (defttag vl-lint)
-  (remove-untouchable acl2::writes-okp nil))
-
-(defun vl-lint-report-wrapper (result state)
-  (declare (xargs :mode :program :stobjs state))
-  (vl-lint-report result state))
-
-(defmacro vl-lint (&key start-files
-                        search-path
-                        (search-exts ''("v"))
-                        topmods
-                        dropmods
-                        ignore
-                        ;; gross yucky thing; acl2-suppress defaults to all
-                        ;; ACL2 output, but for debugging use :acl2-suppress
-                        ;; nil to be able to see what is wrong.
-                        (acl2-suppress ':all))
-  `(with-output
-    :off ,(or acl2-suppress 'proof-tree)
-    (make-event
-     (b* ((- (acl2::set-max-mem (* 12 (expt 2 30))))
-          (- (acl2::hons-resize :str-ht 1000000))
-          ((mv & & state)
-           ;; For some reason we have to assign to this here, inside the
-           ;; make-event code, rather than ahead of time.
-           (assign acl2::writes-okp t))
-          ((mv result state)
-           (cwtime (run-vl-lint :start-files ,start-files
-                                :search-path ,search-path
-                                :search-exts ,search-exts
-                                :topmods ,topmods
-                                :dropmods ,dropmods
-                                :ignore ,ignore)
-                   :name vl-lint))
-          (state
-           (cwtime (vl-lint-report-wrapper result state))))
-       (value `(defconst *lint-result* ',result))))))
-
diff -Nru acl2-6.2/books/centaur/vl/lint/use-set-ignore.lisp acl2-6.3/books/centaur/vl/lint/use-set-ignore.lisp
--- acl2-6.2/books/centaur/vl/lint/use-set-ignore.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/lint/use-set-ignore.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -147,7 +147,7 @@
 (defsection vl-warninglist-change-types
   :parents (warnings)
   :short "@(call vl-warninglist-change-types) changes the @('type') of every
-warning in @(see x) to @('new-type')."
+warning in the list @('x') to @('new-type')."
 
   (defund vl-warninglist-change-types (new-type x)
     (declare (xargs :guard (and (symbolp new-type)
diff -Nru acl2-6.2/books/centaur/vl/lint/xf-remove-toohard.lisp acl2-6.3/books/centaur/vl/lint/xf-remove-toohard.lisp
--- acl2-6.2/books/centaur/vl/lint/xf-remove-toohard.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/lint/xf-remove-toohard.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -23,19 +23,20 @@
 (include-book "../mlib/allexprs")
 (local (include-book "../util/arithmetic"))
 
+(defsection remove-toohard
+  :parents (lint)
+  :short "(Unsound transform).  Remove from each module any assignments,
+instances, or inital/always blocks that have any \"toohard\" expressions in
+them, such as unresolved hierarchical identifiers, strings, function calls,
+system functions, and similar."
+
+  :long "<p>This is obviously unsound and should never be used in the ordinary
+transformation process.  We use it in our @(see lint)ing tool to prepare
+modules for sizing for the linter.</p>")
 
-; VL-Lint Only.
-;
-; (VL-MODULELIST-REMOVE-TOOHARD X) removes from each module any assignments,
-; instances, or inital/always blocks that have any "toohard" expressions in
-; them, such as unresolved hierarchical identifiers, strings, function calls,
-; system functions, and similar.
-;
-; This is obviously unsound and should never be used in the ordinary
-; transformation process.  We use it to prepare modules for sizing.
-
-(defsection vl-expr-toohard-subexpr
-
+(defsection vl-atom-toohard
+  :parents (remove-toohard)
+  
   (defund vl-atom-toohard (x)
     ;; Returns NIL if the atom is okay, or X otherwise.
     (declare (xargs :guard (vl-atom-p x)))
@@ -53,7 +54,10 @@
                     (if (vl-atom-toohard x)
                         t
                       nil)))
-    :hints(("Goal" :in-theory (enable vl-atom-toohard))))
+    :hints(("Goal" :in-theory (enable vl-atom-toohard)))))
+
+(defsection vl-expr-toohard-subexpr
+  :parents (remove-toohard)
 
   (defconst *not-toohard-ops*
     (list :VL-UNARY-PLUS :VL-UNARY-MINUS :VL-UNARY-LOGNOT
@@ -142,6 +146,7 @@
 
 
 (defsection vl-assignlist-remove-toohard
+  :parents (remove-toohard)
 
   (defund vl-assignlist-remove-toohard (x warnings)
     "Returns (MV WARNINGS X-PRIME)"
@@ -180,6 +185,7 @@
 
 
 (defsection vl-modinstlist-remove-toohard
+  :parents (remove-toohard)
 
   (defund vl-modinstlist-remove-toohard (x warnings)
     "Returns (MV WARNINGS X-PRIME)"
@@ -218,6 +224,7 @@
 
 
 (defsection vl-gateinstlist-remove-toohard
+  :parents (remove-toohard)
 
   (defund vl-gateinstlist-remove-toohard (x warnings)
     "Returns (MV WARNINGS X-PRIME)"
@@ -256,6 +263,7 @@
 
 
 (defsection vl-initiallist-remove-toohard
+  :parents (remove-toohard)
 
   (defund vl-initiallist-remove-toohard (x warnings)
     "Returns (MV WARNINGS X-PRIME)"
@@ -294,6 +302,7 @@
 
 
 (defsection vl-alwayslist-remove-toohard
+  :parents (remove-toohard)
 
   (defund vl-alwayslist-remove-toohard (x warnings)
     "Returns (MV WARNINGS X-PRIME)"
@@ -332,6 +341,7 @@
 
 
 (defsection vl-module-remove-toohard
+  :parents (remove-toohard)
 
   (defund vl-module-remove-toohard (x)
     "Returns X-PRIME"
@@ -362,18 +372,14 @@
            (vl-module->name x))))
 
 
-(defsection vl-modulelist-remove-toohard
-
-  (defprojection vl-modulelist-remove-toohard (x)
-    (vl-module-remove-toohard x)
-    :guard (vl-modulelist-p x)
-    :result-type vl-modulelist-p)
-
-  (local (in-theory (enable vl-modulelist-remove-toohard)))
-
-  (defthm vl-modulelist->names-of-vl-modulelist-remove-toohard
-    (equal (vl-modulelist->names (vl-modulelist-remove-toohard x))
-           (vl-modulelist->names x))))
+(defprojection vl-modulelist-remove-toohard (x)
+  (vl-module-remove-toohard x)
+  :guard (vl-modulelist-p x)
+  :result-type vl-modulelist-p
+  :parents (remove-toohard)
+  :rest ((defthm vl-modulelist->names-of-vl-modulelist-remove-toohard
+           (equal (vl-modulelist->names (vl-modulelist-remove-toohard x))
+                  (vl-modulelist->names x)))))
 
 
 #||
diff -Nru acl2-6.2/books/centaur/vl/lint/xf-suppress-warnings.lisp acl2-6.3/books/centaur/vl/lint/xf-suppress-warnings.lisp
--- acl2-6.2/books/centaur/vl/lint/xf-suppress-warnings.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/lint/xf-suppress-warnings.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -22,30 +22,37 @@
 (include-book "../parsetree")
 (local (include-book "../util/arithmetic"))
 
-; VL Warning Suppression
-;
-; This is quick and dirty, but probably is actually a pretty effective and
-; reasonable way to deal with suppressing unwanted warnings from VL-Lint.
-;
-; The basic idea is to stick attributes such as (* LINT_IGNORE *) into the
-; source code, which with our comment syntax can be done using the form //@VL
-; LINT_IGNORE, or similar.  We then look for these attributes to decide whether
-; to suppress a warning.
-;
-; For convenience we treat LINT_IGNORE directives in a case-insensitive way and
-; treat _ interchangeably with -.  This is useful because the Verilog user has
-; to use _ since these are attribute names and hence must be valid identifiers.
-;
-; We let the user write things like LINT_IGNORE_VL_WARN_ODDEXPR, or, more
-; conveniently, LINT_IGNORE_ODDEXPR, by just "mashing" the tail of what they
-; write by throwing away any leading VL_ or VL_WARN_ part.  By convention a
-; plain LINT_IGNORE with no further information means just ignore all warnings.
+(defsection lint-warning-suppression
+  :parents (lint warnings)
+  :short "An attribute- mechanism for suppressing particular @(see warnings)
+when using @(see lint)."
+
+  :long "<p>This is quick and dirty, but probably is actually a pretty
+effective and reasonable way to deal with suppressing unwanted warnings from
+VL-Lint.</p>
+
+<p>The basic idea is to stick attributes such as @('(* LINT_IGNORE *)') into
+the source code, which with our comment syntax can be done using the form
+@('//@VL LINT_IGNORE'), or similar.  We then look for these attributes to
+decide whether to suppress a warning.</p>
+
+<p>For convenience we treat @('LINT_IGNORE') directives in a case-insensitive
+way and treat _ interchangeably with -.  This is useful because the Verilog
+user typically has to use _ since these are attribute names and hence must be
+valid identifiers.</p>
+
+<p>We let the user write things like @('LINT_IGNORE_VL_WARN_ODDEXPR'), or, more
+conveniently, @('LINT_IGNORE_ODDEXPR'), by just \"mashing\" the tail of what
+they write by throwing away any leading @('VL_') or @('VL_WARN_') part.  By
+convention a plain @('LINT_IGNORE') with no further information means just
+ignore all warnings.</p>")
 
-(defsection vl-mash-warning-string
 
-; do basic string mashing to allow the user to refer to warnings in either
-; upper or lower case, treating - and _ as equivalent, and with or without
-; vl_warn_ prefixes.
+(defsection vl-mash-warning-string
+  :parents (lint-warning-suppression)
+  :short "Do basic string mashing to allow the user to refer to warnings in
+either upper or lower case, treating - and _ as equivalent, and with or without
+@('vl_warn_') prefixes."
 
   (defund vl-mash-warning-string (x)
     (declare (xargs :guard (stringp x)))
@@ -69,15 +76,13 @@
     :rule-classes :type-prescription))
 
 
-(defsection vl-mash-warning-strings
-
-  (defprojection vl-mash-warning-strings (x)
-    (vl-mash-warning-string x)
-    :guard (string-listp x))
-
-  (defthm string-listp-of-vl-mash-warning-strings
-    (string-listp (vl-mash-warning-strings x))
-    :hints(("Goal" :induct (len x)))))
+(defprojection vl-mash-warning-strings (x)
+  (vl-mash-warning-string x)
+  :guard (string-listp x)
+  :parents (lint-warning-suppression)
+  :rest ((defthm string-listp-of-vl-mash-warning-strings
+           (string-listp (vl-mash-warning-strings x))
+           :hints(("Goal" :induct (len x))))))
 
 
 
@@ -89,6 +94,7 @@
 
 
 (defsection vl-lint-ignore-att-mash
+  :parents (lint-warning-suppression)
 
   (defund vl-lint-ignore-att-mash (x)
     (declare (xargs :guard (and (stringp x)
@@ -103,6 +109,7 @@
 
 
 (defsection vl-warning-type-mash
+  :parents (lint-warning-suppression)
 
   (defund vl-warning-type-mash (x)
     (declare (xargs :guard (symbolp x)))
@@ -207,6 +214,7 @@
 
 
 (defsection vl-lint-suppress-warnings
+  :parents (lint-warning-suppression)
 
   (defund vl-lint-suppress-warnings (x)
     (declare (xargs :guard (vl-warninglist-p x)))
@@ -226,6 +234,7 @@
 
 
 (defsection vl-module-suppress-lint-warnings
+  :parents (lint-warning-suppression)
 
   (defund vl-module-suppress-lint-warnings (x)
     (declare (xargs :guard (vl-module-p x)))
@@ -244,6 +253,7 @@
 
 
 (defsection vl-modulelist-suppress-lint-warnings
+  :parents (lint-warning-suppression)
 
   (defprojection vl-modulelist-suppress-lint-warnings (x)
     (vl-module-suppress-lint-warnings x)
@@ -260,6 +270,7 @@
 ; We'll also allow you to globally suppress warnings.
 
 (defsection vl-warninglist-lint-ignoreall
+  :parents (lint-warning-suppression)
 
   (defund vl-warninglist-lint-ignoreall (x mashed-ignore-list)
     (declare (xargs :guard (and (vl-warninglist-p x)
@@ -281,6 +292,7 @@
 
 
 (defsection vl-module-lint-ignoreall
+  :parents (lint-warning-suppression)
 
   (defund vl-module-lint-ignoreall (x mashed-ignore-list)
     (declare (xargs :guard (and (vl-module-p x)
@@ -301,6 +313,7 @@
 
 
 (defsection vl-modulelist-lint-ignoreall-aux
+  :parents (lint-warning-suppression)
 
   (defprojection vl-modulelist-lint-ignoreall-aux (x mashed-ignore-list)
     (vl-module-lint-ignoreall x mashed-ignore-list)
@@ -315,6 +328,7 @@
 
 
 (defsection vl-modulelist-lint-ignoreall
+  :parents (lint-warning-suppression)
 
 ; The user-ignore-list here is just a list of user-level ignore strings.  That
 ; is, we'll mash them all first.  The user can say all kinds of things, like
diff -Nru acl2-6.2/books/centaur/vl/loader/filemap.lisp acl2-6.3/books/centaur/vl/loader/filemap.lisp
--- acl2-6.2/books/centaur/vl/loader/filemap.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/filemap.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -198,7 +198,7 @@
   (defthm bounds-of-vl-string-findloc
     (implies (stringp x)
              (and (<= 0 (vl-string-findloc x loc))
-                  (<= (vl-string-findloc x loc) (len (coerce x 'list)))))
+                  (<= (vl-string-findloc x loc) (len (explode x)))))
     :rule-classes :linear))
 
 
diff -Nru acl2-6.2/books/centaur/vl/loader/find-file.lisp acl2-6.3/books/centaur/vl/loader/find-file.lisp
--- acl2-6.2/books/centaur/vl/loader/find-file.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/find-file.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -42,7 +42,7 @@
     (cat dir
          (if (vl-ends-with-directory-separatorp dir)
              ""
-           (coerce (list ACL2::*directory-separator*) 'string))
+           (implode (list ACL2::*directory-separator*)))
          filename))
 
   (defthm stringp-of-vl-extend-pathname
diff -Nru acl2-6.2/books/centaur/vl/loader/inject-comments.lisp acl2-6.3/books/centaur/vl/loader/inject-comments.lisp
--- acl2-6.2/books/centaur/vl/loader/inject-comments.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/inject-comments.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -327,7 +327,7 @@
         (vl-gather-comments-fal-aux minl maxl (- n 1) min max fal acc))))
 
   (verify-guards vl-gather-comments-fal-aux
-                 :hints(("goal" :use ((:instance posp-of-vl-location->line
+                 :hints(("goal" :use ((:instance return-type-of-vl-location->line
                                                  (x min))))))
 
   (defthm vl-commentmap-p-of-vl-gather-comments-fal-aux
diff -Nru acl2-6.2/books/centaur/vl/loader/lexer-tests.lisp acl2-6.3/books/centaur/vl/loader/lexer-tests.lisp
--- acl2-6.2/books/centaur/vl/loader/lexer-tests.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/lexer-tests.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -194,14 +194,14 @@
 (vl-lex-string-testcase :input "\"crazy \\7\""
                         :successp t
                         :expansion (cat "crazy "
-                                        (coerce (list (code-char 7)) 'string)))
+                                        (implode (list (code-char 7)))))
 
 (vl-lex-string-testcase :input "\"\\\\ another \\n basic \\t escape \\\" test\""
                         :successp t
                         :expansion (cat "\\ another "
-                                        (coerce (list #\Newline) 'string)
+                                        (implode (list #\Newline))
                                         " basic "
-                                        (coerce (list #\Tab) 'string)
+                                        (implode (list #\Tab))
                                         " escape \" test"))
 
 ;; Should fail string tests
@@ -436,7 +436,7 @@
                          :signedp nil
                          :value nil
                          :wasunsized t
-                         :bits (coerce (repeat #\X 32) 'string)
+                         :bits (implode (repeat #\X 32))
                          :nwarnings 1)
 
 (vl-lex-integer-testcase :input "'hxxx"
@@ -446,7 +446,7 @@
                          :signedp nil
                          :value nil
                          :wasunsized t
-                         :bits (coerce (repeat #\X 32) 'string)
+                         :bits (implode (repeat #\X 32))
                          :nwarnings 1)
 
 (vl-lex-integer-testcase :input "'bz"
@@ -456,7 +456,7 @@
                          :signedp nil
                          :value nil
                          :wasunsized t
-                         :bits (coerce (repeat #\Z 32) 'string)
+                         :bits (implode (repeat #\Z 32))
                          :nwarnings 1)
 
 (vl-lex-integer-testcase :input "'o zzz"
@@ -466,7 +466,7 @@
                          :signedp nil
                          :value nil
                          :wasunsized t
-                         :bits (coerce (repeat #\Z 32) 'string)
+                         :bits (implode (repeat #\Z 32))
                          :nwarnings 1)
 
 (vl-lex-integer-testcase :input "'bx1"
@@ -476,7 +476,7 @@
                          :signedp nil
                          :value nil
                          :wasunsized t
-                         :bits (coerce (append (repeat #\X 31) (list #\1)) 'string)
+                         :bits (implode (append (repeat #\X 31) (list #\1)))
                          :nwarnings 1)
 
 
diff -Nru acl2-6.2/books/centaur/vl/loader/lexer-utils.lisp acl2-6.3/books/centaur/vl/loader/lexer-utils.lisp
--- acl2-6.2/books/centaur/vl/loader/lexer-utils.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/lexer-utils.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -119,7 +119,7 @@
 @('echars').  More exactly, it computes:</p>
 
 @({
- (prefixp (coerce string 'list)
+ (prefixp (explode string)
           (vl-echarlist->chars echars))
 })
 
@@ -150,7 +150,7 @@
              (xargs :guard (and (not (equal string ""))
                                 (vl-echarlist-p echars))
                     :verify-guards nil))
-    (mbe :logic (prefixp (coerce (string-fix string) 'list) (vl-echarlist->chars echars))
+    (mbe :logic (prefixp (explode (string-fix string)) (vl-echarlist->chars echars))
          :exec (vl-matches-string-p-impl string 0 (length string) echars)))
 
   (local (defthm lemma
@@ -160,7 +160,8 @@
                          (equal len (length string))
                          (vl-echarlist-p echars))
                     (equal (vl-matches-string-p-impl string i len echars)
-                           (prefixp (nthcdr i (coerce string 'list)) (vl-echarlist->chars echars))))
+                           (prefixp (nthcdr i (explode string))
+                                    (vl-echarlist->chars echars))))
            :hints(("Goal" :in-theory (enable vl-matches-string-p-impl)))))
 
   (verify-guards vl-matches-string-p$inline)
@@ -169,7 +170,7 @@
 
   (defthm len-when-vl-matches-string-p-fc
     (implies (vl-matches-string-p string echars)
-             (<= (len (coerce string 'list))
+             (<= (len (explode string))
                  (len echars)))
     :rule-classes ((:forward-chaining)
                    (:linear)))
@@ -223,7 +224,7 @@
     (implies (and (mv-nth 0 (vl-read-literal string echars))
                   (force (vl-echarlist-p echars)))
              (equal (vl-echarlist->chars (mv-nth 0 (vl-read-literal string echars)))
-                    (coerce (string-fix string) 'list)))
+                    (explode (string-fix string))))
     :hints(("Goal" :in-theory (enable vl-matches-string-p))))
 
   (defthm vl-echarlist->string-of-prefix-of-vl-read-literal
@@ -338,7 +339,7 @@
 
   (defthm len-of-vl-read-until-literal
     (implies (mv-nth 0 (vl-read-until-literal string echars))
-             (<= (len (coerce string 'list))
+             (<= (len (explode string))
                  (len (mv-nth 2 (vl-read-until-literal string echars)))))
     :rule-classes ((:rewrite) (:linear)))
 
diff -Nru acl2-6.2/books/centaur/vl/loader/lexer.lisp acl2-6.3/books/centaur/vl/loader/lexer.lisp
--- acl2-6.2/books/centaur/vl/loader/lexer.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/lexer.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -773,7 +773,7 @@
                         (vl-location-string (vl-echar->loc (car echars)))
                         err)
                     nil echars)
-              (mv (reverse (coerce vacc 'string))
+              (mv (str::rchars-to-string vacc)
                   (cons (car echars) (reverse eacc))
                   remainder))))
 
@@ -1386,7 +1386,7 @@
      ;; Basic extension test with a fixed width
      (assert! (b* (((mv warn bits)
                     (vl-correct-bitlist *vl-fakeloc*
-                                        (vl-binary-digits-to-bitlist (coerce "0111" 'list))
+                                        (vl-binary-digits-to-bitlist (explode "0111"))
                                         8
                                         nil)))
                 (and (not warn)
@@ -1394,7 +1394,7 @@
 
      (assert! (b* (((mv warn bits)
                     (vl-correct-bitlist *vl-fakeloc*
-                                        (vl-binary-digits-to-bitlist (coerce "1111" 'list))
+                                        (vl-binary-digits-to-bitlist (explode "1111"))
                                         8
                                         nil)))
                 (and (not warn)
@@ -1402,7 +1402,7 @@
 
      (assert! (b* (((mv warn bits)
                     (vl-correct-bitlist *vl-fakeloc*
-                                        (vl-binary-digits-to-bitlist (coerce "x111" 'list))
+                                        (vl-binary-digits-to-bitlist (explode "x111"))
                                         8
                                         nil)))
                 (and (not warn)
@@ -1410,7 +1410,7 @@
 
      (assert! (b* (((mv warn bits)
                     (vl-correct-bitlist *vl-fakeloc*
-                                        (vl-binary-digits-to-bitlist (coerce "z111" 'list))
+                                        (vl-binary-digits-to-bitlist (explode "z111"))
                                         8
                                         nil)))
                 (and (not warn)
@@ -1419,7 +1419,7 @@
 
      (assert! (b* (((mv warn bits)
                     (vl-correct-bitlist *vl-fakeloc*
-                                        (vl-binary-digits-to-bitlist (coerce "110111" 'list))
+                                        (vl-binary-digits-to-bitlist (explode "110111"))
                                         4
                                         nil)))
                 (and (consp warn)
@@ -1427,25 +1427,23 @@
 
      (assert! (b* (((mv warn ?bits)
                     (vl-correct-bitlist *vl-fakeloc*
-                                        (vl-binary-digits-to-bitlist (coerce "0111" 'list))
+                                        (vl-binary-digits-to-bitlist (explode "0111"))
                                         nil
                                         nil)))
                 (and (not warn)
                      (equal (vl-bitlist->string bits)
-                            (coerce (append (repeat #\0 29)
-                                            (repeat #\1 3))
-                                    'string)))))
+                            (implode (append (repeat #\0 29)
+                                             (repeat #\1 3)))))))
 
      (assert! (b* (((mv warn ?bits)
                     (vl-correct-bitlist *vl-fakeloc*
-                                        (vl-binary-digits-to-bitlist (coerce "Z111" 'list))
+                                        (vl-binary-digits-to-bitlist (explode "Z111"))
                                         nil
                                         nil)))
                 (and (consp warn)
                      (equal (vl-bitlist->string bits)
-                            (coerce (append (repeat #\Z 29)
-                                            (repeat #\1 3))
-                                    'string))))))))
+                            (implode (append (repeat #\Z 29)
+                                             (repeat #\1 3))))))))))
 
 
 
diff -Nru acl2-6.2/books/centaur/vl/loader/loader.lisp acl2-6.3/books/centaur/vl/loader/loader.lisp
--- acl2-6.2/books/centaur/vl/loader/loader.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/loader.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -56,8 +56,8 @@
 
 </ul>
 
-<p>Our top-level function for loading Verilog files, @(see vl-load), implements
-such a scheme.  It has various <see topic='@(url
+<p>Our top-level function for loading Verilog files, @(see vl-load),
+implements such a scheme.  It has various <see topic='@(url
 vl-loadconfig-p)'>options</see> that allow you to specify the search paths and
 extensions to use when looking for files, etc.  It also features an @(see
 overrides) mechanism that can be used to \"safely\" use alternate definitions
@@ -295,7 +295,7 @@
   :returns (mv (merged   (vl-modulelist-p merged) :hyp :fguard)
                (modalist (equal modalist (vl-modalist merged)) :hyp :fguard)
                (walist   vl-modwarningalist-p :hyp :fguard))
-  :parents (vl-load)
+  :parents (loader)
   :short "Merge newly found Verilog modules with previously loaded modules,
 warning about multiply defined modules."
 
@@ -342,7 +342,7 @@
                       state)
   :returns (mv (st    vl-loadstate-p :hyp :fguard)
                (state state-p1       :hyp (force (state-p1 state))))
-  :parents (vl-load)
+  :parents (loader)
   :short "Main function for loading a single Verilog file."
 
   :long "<p>Even loading a single file is a multi-step process:</p>
@@ -504,7 +504,7 @@
                        state)
   :returns (mv (st       vl-loadstate-p :hyp :fguard)
                (state    state-p1       :hyp (force (state-p1 state))))
-  :parents (vl-load)
+  :parents (loader)
   :short "Load a list of files."
   (b* (((when (atom filenames))
         (mv st state))
@@ -518,7 +518,7 @@
                         state)
   :returns (mv (st    vl-loadstate-p :hyp :fguard)
                (state state-p1       :hyp (force (state-p1 state))))
-  :parents (vl-load)
+  :parents (loader)
   :short "Try to load a module from the search path."
 
   (b* (((vl-loadstate st) st)
@@ -545,7 +545,7 @@
                          state)
   :returns (mv (st    vl-loadstate-p :hyp :fguard)
                (state state-p1       :hyp (force (state-p1 state))))
-  :parents (vl-load)
+  :parents (loader)
   :short "Extend @(see vl-load-module) to try to load a list of modules."
 
   (b* (((when (atom modnames))
@@ -557,7 +557,7 @@
 
 (define vl-modules-left-to-load ((st vl-loadstate-p))
   :returns (names string-listp :hyp :fguard)
-  :parents (vl-load)
+  :parents (loader)
   :short "Determine which modules we still need to load."
 
   :long "<p>For loading to be completely done, we want to have:</p>
@@ -598,7 +598,7 @@
   :returns (mv (st    vl-loadstate-p :hyp :fguard)
                (state state-p1       :hyp (force (state-p1 state))
                       :hints(("Goal" :in-theory (disable (force))))))
-  :parents (vl-load)
+  :parents (loader)
   :short "Attempt to find and load any missing modules."
 
   :long "<p>After some initial files have been loaded, it is generally
@@ -705,7 +705,7 @@
                       state)
   :returns (mv (result vl-loadresult-p :hyp :fguard)
                (state  state-p1        :hyp (force (state-p1 state))))
-  :parents (vl-load)
+  :parents (loader)
   :short "Top level interface for loading Verilog sources."
 
   (b* ((config
@@ -775,7 +775,8 @@
 
        (result (make-vl-loadresult :mods mods
                                    :filemap st.filemap
-                                   :warnings st.warnings)))
+                                   :warnings st.warnings
+                                   :defines st.defines)))
 
     (fast-alist-free overrides)
     (fast-alist-free (vl-loadstate->modalist st))
@@ -784,7 +785,7 @@
 
 
 (defsection vl-load-summary
-  :parents (vl-load)
+  :parents (loader)
   :short "Print summary information (e.g., warnings, numbers of modules loaded,
 etc.) after modules have been loaded."
 
@@ -846,6 +847,13 @@
 (define vl-load ((config vl-loadconfig-p)
                  &key
                  (state 'state))
+  :parents (loader)
+  :short "Wrapper for @(see vl-load-main) that also reports errors or (with
+some configuration) can print other information."
+
+  :long "<p>This is very similar to @(see vl-load-main), but calls @(see
+vl-load-summary) afterwards.</p>"
+
   :returns (mv (result vl-loadresult-p :hyp :fguard)
                (state  state-p1        :hyp (force (state-p1 state))))
   (b* (((vl-loadconfig config) config)
diff -Nru acl2-6.2/books/centaur/vl/loader/overrides.lisp acl2-6.3/books/centaur/vl/loader/overrides.lisp
--- acl2-6.2/books/centaur/vl/loader/overrides.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/overrides.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -565,10 +565,10 @@
 
 (defsection vl-read-override-file
   :parents (overrides)
-  :short "Load an override file into a @(see vl-override-alistp)."
+  :short "Load an override file into a @(see vl-overridelist-p)."
 
   :long "<p>Signature: @(call vl-read-override-file) returns @('(mv successp
-override-alist filemap defines' comment-map' walist' state)').</p>"
+overridelist filemap defines' comment-map' walist' state)').</p>"
 
   (defund vl-read-override-file (path modname defines comment-map walist filemapp state)
     "Returns (MV SUCCESSP OVERRIDE-LIST FILEMAP DEFINES' COMMENT-MAP' WALIST' STATE)"
diff -Nru acl2-6.2/books/centaur/vl/loader/parse-nets.lisp acl2-6.3/books/centaur/vl/loader/parse-nets.lisp
--- acl2-6.2/books/centaur/vl/loader/parse-nets.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/parse-nets.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -27,6 +27,7 @@
 
 ;; BOZO some of these are expensive; consider backchain limits.
 (local (in-theory (disable acl2::consp-under-iff-when-true-listp
+                           consp-when-member-equal-of-cons-listp
                            member-equal-when-member-equal-of-cdr-under-iff
                            default-car
                            default-cdr)))
diff -Nru acl2-6.2/books/centaur/vl/loader/parse-statements-def.lisp acl2-6.3/books/centaur/vl/loader/parse-statements-def.lisp
--- acl2-6.2/books/centaur/vl/loader/parse-statements-def.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/parse-statements-def.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -526,7 +526,7 @@
            (:= (vl-match-token :vl-colon))
            (id := (vl-match-token :vl-idtoken))
            (items :w= (vl-parse-0+-block-item-declarations)))
-         (stmts := (vl-parse-statements-until-end))
+         (stmts := (vl-parse-statements-until-join))
          (:= (vl-match-token :vl-kwd-join))
          (return (make-vl-blockstmt :sequentialp nil
                                     :name (and id (vl-idtoken->name id))
@@ -686,6 +686,17 @@
          (ret := (vl-parse-statement-aux atts))
          (return ret)))
 
+ (defparser vl-parse-statements-until-join (tokens warnings)
+   (declare (xargs :measure (two-nats-measure (acl2-count tokens) 3)))
+   ;; Returns a list of vl-stmt-p's.
+   ;; Tries to read until the keyword "join"
+   (seqw tokens warnings
+         (when (vl-is-token? :vl-kwd-join)
+           (return nil))
+         (first :s= (vl-parse-statement))
+         (rest := (vl-parse-statements-until-join))
+         (return (cons first rest))))
+
  (defparser vl-parse-statements-until-end (tokens warnings)
    (declare (xargs :measure (two-nats-measure (acl2-count tokens) 3)))
    ;; Returns a list of vl-stmt-p's.
diff -Nru acl2-6.2/books/centaur/vl/loader/parse-statements-error.lisp acl2-6.3/books/centaur/vl/loader/parse-statements-error.lisp
--- acl2-6.2/books/centaur/vl/loader/parse-statements-error.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/parse-statements-error.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -82,6 +82,7 @@
      ,(vl-val-when-error-claim vl-parse-statement-fn)
      ,(vl-val-when-error-claim vl-parse-statement-or-null-fn)
      ,(vl-val-when-error-claim vl-parse-statements-until-end-fn)
+     ,(vl-val-when-error-claim vl-parse-statements-until-join-fn)
      :hints(("Goal" :induct (vl-flag-parse-statement flag atts tokens warnings))
             '(:do-not '(simplify))
             (flag::expand-calls-computed-hint
diff -Nru acl2-6.2/books/centaur/vl/loader/parse-statements-progress.lisp acl2-6.3/books/centaur/vl/loader/parse-statements-progress.lisp
--- acl2-6.2/books/centaur/vl/loader/parse-statements-progress.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/parse-statements-progress.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -79,6 +79,7 @@
                          :extra-args (atts))
      ,(vl-progress-claim vl-parse-statement-fn)
      ,(vl-progress-claim vl-parse-statement-or-null-fn)
+
      (vl-parse-statements-until-end-fn
       (and (<= (acl2-count (mv-nth 2 (vl-parse-statements-until-end-fn tokens warnings)))
                (acl2-count tokens))
@@ -88,6 +89,17 @@
                     (< (acl2-count (mv-nth 2 (vl-parse-statements-until-end-fn tokens warnings)))
                        (acl2-count tokens))))
       :rule-classes ((:rewrite) (:linear)))
+
+     (vl-parse-statements-until-join-fn
+      (and (<= (acl2-count (mv-nth 2 (vl-parse-statements-until-join-fn tokens warnings)))
+               (acl2-count tokens))
+           (implies (and (not (mv-nth 0 (vl-parse-statements-until-join-fn
+                                         tokens warnings)))
+                         (mv-nth 1 (vl-parse-statements-until-join-fn tokens warnings)))
+                    (< (acl2-count (mv-nth 2 (vl-parse-statements-until-join-fn tokens warnings)))
+                       (acl2-count tokens))))
+      :rule-classes ((:rewrite) (:linear)))
+
      :hints(("Goal" :induct (vl-flag-parse-statement flag atts tokens warnings))
             '(:do-not '(simplify))
             (flag::expand-calls-computed-hint
diff -Nru acl2-6.2/books/centaur/vl/loader/parse-statements-result.lisp acl2-6.3/books/centaur/vl/loader/parse-statements-result.lisp
--- acl2-6.2/books/centaur/vl/loader/parse-statements-result.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/parse-statements-result.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -125,6 +125,9 @@
      ,(vl-stmt-claim vl-parse-statements-until-end-fn
                      (vl-stmtlist-p val)
                      :true-listp t)
+     ,(vl-stmt-claim vl-parse-statements-until-join-fn
+                     (vl-stmtlist-p val)
+                     :true-listp t)
      :hints(("Goal" :induct (vl-flag-parse-statement flag atts tokens warnings))
             (and acl2::stable-under-simplificationp
                  (flag::expand-calls-computed-hint
diff -Nru acl2-6.2/books/centaur/vl/loader/parse-statements-tokenlist.lisp acl2-6.3/books/centaur/vl/loader/parse-statements-tokenlist.lisp
--- acl2-6.2/books/centaur/vl/loader/parse-statements-tokenlist.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/parse-statements-tokenlist.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -85,6 +85,7 @@
      ,(vl-tokenlist-claim vl-parse-statement-fn)
      ,(vl-tokenlist-claim vl-parse-statement-or-null-fn)
      ,(vl-tokenlist-claim vl-parse-statements-until-end-fn)
+     ,(vl-tokenlist-claim vl-parse-statements-until-join-fn)
      :hints(("Goal" :induct (vl-flag-parse-statement flag atts tokens warnings))
             (and acl2::stable-under-simplificationp
                  (flag::expand-calls-computed-hint
diff -Nru acl2-6.2/books/centaur/vl/loader/parse-statements-warninglist.lisp acl2-6.3/books/centaur/vl/loader/parse-statements-warninglist.lisp
--- acl2-6.2/books/centaur/vl/loader/parse-statements-warninglist.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/loader/parse-statements-warninglist.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -47,6 +47,7 @@
      ,(vl-warninglist-claim vl-parse-statement-fn)
      ,(vl-warninglist-claim vl-parse-statement-or-null-fn)
      ,(vl-warninglist-claim vl-parse-statements-until-end-fn)
+     ,(vl-warninglist-claim vl-parse-statements-until-join-fn)
      :hints(("Goal" :induct (vl-flag-parse-statement flag atts tokens warnings))
             (and acl2::stable-under-simplificationp
                  (flag::expand-calls-computed-hint
diff -Nru acl2-6.2/books/centaur/vl/mlib/comment-writer.lisp acl2-6.3/books/centaur/vl/mlib/comment-writer.lisp
--- acl2-6.2/books/centaur/vl/mlib/comment-writer.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/mlib/comment-writer.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -129,6 +129,20 @@
       (vl-vardecllist-ppmap (cdr x)
                             (acons (vl-vardecl->loc (car x)) str alist)))))
 
+(define vl-eventdecllist-ppmap ((x     vl-eventdecllist-p)
+                                (alist vl-commentmap-p)
+                                &key (ps 'ps))
+  :returns (mv (alist vl-commentmap-p
+                      :hyp (and (force (vl-eventdecllist-p x))
+                                (force (vl-commentmap-p alist))))
+               (ps))
+  (if (atom x)
+      (mv alist ps)
+    (mv-let (str ps)
+      (with-semilocal-ps (vl-pp-eventdecl (car x)))
+      (vl-eventdecllist-ppmap (cdr x)
+                              (acons (vl-eventdecl->loc (car x)) str alist)))))
+
 (define vl-modinstlist-ppmap ((x        vl-modinstlist-p)
                               (mods     vl-modulelist-p)
                               (modalist (equal modalist (vl-modalist mods)))
@@ -327,6 +341,7 @@
        ((mv imap ps) (vl-portdecllist-ppmap x.portdecls imap))
        ((mv imap ps) (vl-regdecllist-ppmap x.regdecls imap))
        ((mv imap ps) (vl-vardecllist-ppmap x.vardecls imap))
+       ((mv imap ps) (vl-eventdecllist-ppmap x.eventdecls imap))
        ((mv imap ps) (vl-netdecllist-ppmap x.netdecls imap))
        ((mv imap ps) (vl-fundecllist-ppmap x.fundecls imap))
        ((mv imap ps) (vl-taskdecllist-ppmap x.taskdecls imap))
@@ -387,11 +402,6 @@
                (vl-print " (")
                (vl-pp-portlist x.ports)
                (vl-println ");")
-
-               (if (not x.eventdecls)
-                   ps
-                 (vl-println "// BOZO implement eventdecl printing"))
-
                (vl-pp-encoded-commentmap guts)
                (vl-ps-span "vl_key" (vl-println "endmodule"))
                (vl-println "")
diff -Nru acl2-6.2/books/centaur/vl/mlib/ctxexprs.lisp acl2-6.3/books/centaur/vl/mlib/ctxexprs.lisp
--- acl2-6.2/books/centaur/vl/mlib/ctxexprs.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/mlib/ctxexprs.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -106,6 +106,7 @@
          (type-thm (mksym 'vl-exprctxalist-p-of- collect))
          (true-thm (mksym 'true-listp-of- collect)))
     `(defsection ,collect
+       :parents (ctxexprs)
 
        (defund ,collect (mod x)
          (declare (xargs :guard (and (stringp mod)
@@ -136,6 +137,7 @@
        (,collect-elem mod x)
        :guard (and (stringp mod)
                    (,list-type-p x))
+       :parents (ctxexprs)
        :rest
        ((defthm ,type-thm
           (implies (and (force (stringp mod))
@@ -173,6 +175,7 @@
 (def-vl-ctxexprs-list :element vl-initial   :list vl-initiallist)
 
 (defsection vl-module-ctxexprs
+  :parents (ctxexprs)
 
   (defund vl-module-ctxexprs (x)
     (declare (xargs :guard (vl-module-p x)))
diff -Nru acl2-6.2/books/centaur/vl/mlib/expr-slice.lisp acl2-6.3/books/centaur/vl/mlib/expr-slice.lisp
--- acl2-6.2/books/centaur/vl/mlib/expr-slice.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/mlib/expr-slice.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -835,6 +835,7 @@
                   (repeat (vl-expr->finalwidth a) n))
            :hints(("Goal" :in-theory (enable repeat)))))
 
+  (local (in-theory (disable car-of-vl-exprlist->finalwidths)))
   (local (defthm vl-expr->finalwidth-of-first
            (equal (vl-expr->finalwidth (first x))
                   (first (vl-exprlist->finalwidths x)))))
@@ -855,12 +856,12 @@
                (equal (vl-exprlist->finalwidths (mv-nth 2 ret))
                       (repeat 1 (vl-atom->finalwidth x))))))
 
-
   (local (defthm vl-exprlist->finaltypes-of-repeat
            (equal (vl-exprlist->finaltypes (repeat a n))
                   (repeat (vl-expr->finaltype a) n))
            :hints(("Goal" :in-theory (enable repeat)))))
 
+  (local (in-theory (disable car-of-vl-exprlist->finaltypes)))
   (local (defthm vl-expr->finaltype-of-first
            (equal (vl-expr->finaltype (first x))
                   (first (vl-exprlist->finaltypes x)))))
diff -Nru acl2-6.2/books/centaur/vl/mlib/hid-tools.lisp acl2-6.3/books/centaur/vl/mlib/hid-tools.lisp
--- acl2-6.2/books/centaur/vl/mlib/hid-tools.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/mlib/hid-tools.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -568,7 +568,7 @@
            ;; natural number.
            (cat (vl-hidpiece->name (vl-atom->guts (first args)))
                 "["
-                (coerce (explode-atom (vl-resolved->val (second args)) 10) 'string)
+                (implode (explode-atom (vl-resolved->val (second args)) 10))
                 "]"
                 (vl-flatten-hidexpr (third args))))
 
diff -Nru acl2-6.2/books/centaur/vl/mlib/hierarchy.lisp acl2-6.3/books/centaur/vl/mlib/hierarchy.lisp
--- acl2-6.2/books/centaur/vl/mlib/hierarchy.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/mlib/hierarchy.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -583,7 +583,7 @@
   @(thm correctness-of-vl-depalist)
 
 <p>This alist is useful in dependency computations such as @(see
-vl-dependent-module).  It satisfies @(see alistp), @(see vl-depalist-p), and
+vl-dependent-modules).  It satisfies @(see alistp), @(see vl-depalist-p), and
 @(see vl-set-values-p).</p>"
 
   (defund vl-depalist (x)
@@ -1600,7 +1600,7 @@
 (defsection vl-maximal-deporder
   :parents (vl-deporder)
   :short "@(call vl-maximal-deporder) returns the maximum level for any module
-in @('names'), according to the @(see vl-deporder-alist)."
+in @('names'), according to a @(see vl-deporder-alistp)."
 
   (defund vl-maximal-deporder (names alist)
     (declare (xargs :guard (and (true-listp names)
@@ -1626,7 +1626,7 @@
 
 (defsection vl-deporder-pass
   :parents (vl-deporder)
-  :short "@(call vl-deporder-pass) extends a partial @(see vl-deporder-alist)
+  :short "@(call vl-deporder-pass) extends a partial @(see vl-deporder-alistp)
 with entries for the modules whose level is now apparent."
 
   :long "<p>@('mods') are a list of modules, @('alist') is a partial
diff -Nru acl2-6.2/books/centaur/vl/mlib/json.lisp acl2-6.3/books/centaur/vl/mlib/json.lisp
--- acl2-6.2/books/centaur/vl/mlib/json.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/mlib/json.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -0,0 +1,983 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "VL")
+(include-book "fmt")
+(include-book "find-module")
+(include-book "centaur/bridge/to-json" :dir :system)
+(local (include-book "../util/arithmetic"))
+
+
+(defsection json-printing
+  :parents (printer)
+  :short "Routines for encoding various ACL2 structures into <a
+href='http://www.json.org/'>JSON</a> format."
+
+  :long "<p>This is a collection of printing routines for translating ACL2
+structures into JSON format.  These routines are mainly meant to make it easy
+to convert @(see vl) @(see modules) into nice JSON data, but are somewhat
+flexible and may be useful for other applications.</p>")
+
+
+(defsection json-encoders
+  :parents (json-printing)
+  :short "A table of JSON encoders to use for for different kinds of data."
+  :long "<p>A JSON encoder is a function of the following signature:</p>
+
+@({ encode-foo : foo * ps --> ps })
+
+<p>Where @('foo') is expected to be an object of some type @('foop'), and
+@('ps') is the @(see vl) @(see printer) state stobj, @(see ps).  Each such
+routine is responsible for printing a JSON encoding of its @('foop') argument.
+Each such function may assume that @(see ps) is set to text mode.</p>
+
+<p>The encoder table is a simple association of @('foop') to @('encode-foo')
+functions.  We can use it to automatically generate encoders for, e.g., @(see
+defaggregate) structures.</p>"
+
+  (table vl-json)
+  (table vl-json 'encoders
+         ;; Alist binding each recognizer foop to its JSON encoder, vl-jp-foo
+         )
+
+  (defun get-json-encoders (world)
+    "Look up the current alist of json encoders."
+    (declare (xargs :mode :program))
+    (cdr (assoc 'encoders (table-alist 'vl-json world))))
+
+  (defmacro add-json-encoder (foop encoder-fn)
+    (declare (xargs :guard (and (symbolp foop)
+                                (symbolp encoder-fn))))
+    `(table vl-json 'encoders
+            (cons (cons ',foop ',encoder-fn)
+                  (get-json-encoders world))))
+
+  (defun get-json-encoder (foop world)
+    (declare (xargs :mode :program))
+    (let ((entry (assoc foop (get-json-encoders world))))
+      (if entry
+          (cdr entry)
+        (er hard? 'get-json-encoder
+            "No json encoder defined for ~x0.~%" foop)))))
+
+
+#||
+(get-json-encoders (w state))
+(add-json-encoder barp vl-enc-bar)
+(get-json-encoders (w state))
+(get-json-encoder 'barp (w state)) ;; vl-enc-bar
+(get-json-encoder 'foop (w state)) ;; fail, no encoder defined
+||#
+
+
+(define jp-bool ((x booleanp) &key (ps 'ps))
+  :parents (json-encoders)
+  :short "Encode a @(see booleanp) into JSON as @('true') or @('false')."
+  (if x
+      (vl-print-str "true")
+    (vl-print-str "false")))
+
+(add-json-encoder booleanp jp-bool)
+
+
+
+(define jp-col-after-printing-string-aux
+  ((col natp    "Current column we're at.")
+   (x   stringp "String we're about to print, not yet reversed.")
+   (n   natp    "Current position in X.")
+   (xl  natp    "Pre-computed length of X."))
+  :returns (new-col natp :rule-classes :type-prescription)
+  :parents (jp-str)
+  :short "Fast way to figure out the new column after printing a JSON string
+with proper encoding."
+  :guard (and (<= n xl)
+              (= xl (length x)))
+  :measure (nfix (- (nfix xl) (nfix n)))
+  (declare (type (integer 0 *) col n xl)
+           (type string x))
+  (b* (((when (mbe :logic (zp (- (nfix xl) (nfix n)))
+                   :exec (= n xl)))
+        (lnfix col))
+       ((the (unsigned-byte 8) code) (char-code (char x n)))
+       ((when (or (<= code 31)
+                  (>= code 127)))
+        ;; This is a "json weird char."  Our encoder will turn it into
+        ;; \uXXXX.  The length of \uXXXX is 6.
+        (jp-col-after-printing-string-aux (+ 6 col) x (+ 1 (lnfix n)) xl)))
+    ;; Else there is only one character.
+    (jp-col-after-printing-string-aux (+ 1 col) x (+ 1 (lnfix n)) xl)))
+
+(define jp-str ((x :type string) &key (ps 'ps))
+  :parents (json-encoders)
+  :short "Print the JSON encoding of a string, handling all escaping correctly
+and including the surrounding quotes."
+  :long "<p>We go to some effort to make this fast.</p>"
+  (b* ((rchars  (vl-ps->rchars))
+       (col     (vl-ps->col))
+       (xl      (length x))
+       (rchars  (cons #\" (bridge::json-encode-str-aux x 0 xl (cons #\" rchars))))
+       (col     (+ 2 (jp-col-after-printing-string-aux col x 0 xl))))
+    (vl-ps-seq
+     (vl-ps-update-rchars rchars)
+     (vl-ps-update-col col)))
+  :prepwork
+  ((local (defthm l0
+            (implies (and (vl-printedlist-p acc)
+                          (character-listp x))
+                     (vl-printedlist-p (bridge::json-encode-chars x acc)))
+            :hints(("Goal"
+                    :in-theory (enable bridge::json-encode-chars
+                                       bridge::json-encode-char
+                                       bridge::json-encode-weird-char)))))))
+
+(add-json-encoder stringp jp-str)
+
+(define jp-maybe-string ((x vl-maybe-string-p) &key (ps 'ps))
+  :parents (json-encoders)
+  (if x
+      (jp-str x)
+    (vl-print "null")))
+
+(add-json-encoder vl-maybe-string-p jp-maybe-string)
+
+
+
+(define jp-bignat ((x natp) &key (ps 'ps))
+  :parents (json-encoders)
+  :short "Encode a potentially large natural number as a JSON string."
+  (vl-print-str (str::natstr x)))
+
+(define jp-nat ((x natp) &key (ps 'ps))
+  :parents (json-encoders)
+  :short "Encode a probably small natural number as a JSON number."
+  :long "<p>We require that the integer is at most 2^31, which we think is the
+minimum reasonable size for a JSON implementation to support.</p>"
+  (b* (((unless (<= x (expt 2 31)))
+        (raise "Scarily trying to JSON-encode large natural: ~x0." x)
+        ps))
+    (vl-print-nat x)))
+
+(define jp-maybe-nat ((x vl-maybe-natp) &key (ps 'ps))
+  :parents (json-encoders)
+  (if x
+      (jp-nat x)
+    (vl-print-str "null")))
+
+(add-json-encoder natp jp-nat)
+(add-json-encoder posp jp-nat)
+(add-json-encoder vl-maybe-natp jp-maybe-nat)
+(add-json-encoder vl-maybe-posp jp-maybe-nat)
+
+
+
+(define jp-sym-main ((x symbolp) &key (ps 'ps))
+  :parents (json-encoders)
+  :short "Encode a simple symbol as a JSON string, including the surrounding
+quotes."
+
+  :long "<p>We assume that @('x') has a simple enough name to print without any
+encoding.  This is generally true for keyword constants used as tags and in
+basic enumerations like @(see vl-exprtype-p).  We print only the symbol name,
+in lower-case.</p>"
+
+  (vl-ps-seq (vl-print "\"")
+             (vl-print-str (str::downcase-string (symbol-name x)))
+             (vl-print "\"")))
+
+(defsection jp-sym
+  :parents (json-encoders)
+  :short "Optimized version of @(see jp-sym-main)."
+  :long "<p>This is a simple macro that is meant to be the same as @(see
+jp-sym-main).  The only difference is that if we are given a literal symbol,
+e.g., @(':foo'), we can do the string manipulation at compile time.</p>"
+
+  (defmacro jp-sym (x &key (ps 'ps))
+    (if (or (keywordp x)
+            (booleanp x)
+            (and (quotep x)
+                 (symbolp (acl2::unquote x))))
+        ;; Yes, want to optimize.
+        (let* ((guts (if (quotep x) (acl2::unquote x) x))
+               (ans  (str::cat "\""
+                               (str::downcase-string (symbol-name guts))
+                              "\"")))
+          `(vl-print-str ,ans :ps ,ps))
+      `(jp-sym-main ,x :ps ,ps))))
+
+#||
+(top-level (vl-cw-ps-seq (jp-sym :foo))) ;; "foo"
+(top-level (vl-cw-ps-seq (jp-sym t)))    ;; "t"
+(top-level (vl-cw-ps-seq (jp-sym nil)))  ;; "nil"
+(top-level (vl-cw-ps-seq (jp-sym 'bar))) ;; "bar"
+(top-level (let ((x 'baz))
+             (vl-cw-ps-seq (jp-sym x)))) ;; "baz"
+||#
+
+
+
+(defsection jp-object
+  :parents (json-encoders)
+  :short "Utility for printing JSON <i>objects</i>, which in some other
+languages might be called alists, dictionaries, hashes, records, etc."
+  :long "<p>Syntax Example:</p>
+
+@({
+  (jp-object :tag  (vl-print \"loc\")
+             :file (vl-print x.filename)
+             :line (vl-print x.line)
+             :col  (vl-print x.col))
+   --->
+  { \"tag\": \"loc\", \"file\": ... }
+})
+
+<p>The arguments to @('jp-object') should be an alternating list of literal
+keywords, which (for better performance) we assume are so simple they do not
+need to be encoded, and printing expressions which should handle any necessary
+encoding.</p>"
+
+  :autodoc nil
+
+  (defun jp-object-aux (forms)
+    (declare (xargs :guard t))
+    (b* (((when (atom forms))
+          nil)
+         ((unless (keywordp (car forms)))
+          (er hard? 'jp-object "Expected alternating keywords and values."))
+         ((unless (consp (cdr forms)))
+          (er hard? 'jp-object "No argument found after ~x0." (car forms)))
+         ;; Suppose the keyword is :foo.
+         ;; We create the string: "foo":
+         ;; We can create this at macroexpansion time.
+         (name1       (str::downcase-string (symbol-name (car forms))))
+         (name1-colon (str::cat "\"" name1 "\": ")))
+      (list* `(vl-print-str ,name1-colon)
+             (second forms)
+             (if (atom (cddr forms))
+                 nil
+               (cons `(vl-println? ", ")
+                     (jp-object-aux (cddr forms)))))))
+
+  (defmacro jp-object (&rest forms)
+    `(vl-ps-seq (vl-print "{")
+                ,@(jp-object-aux forms)
+                (vl-println? "}"))))
+
+
+
+; Fancy automatic json encoding of cutil structures
+
+(program)
+
+(define make-json-encoder-alist
+  (efields   ;; A proper cutil::formallist-p for this structure's fields
+   omit      ;; A list of any fields to omit from the encoded output
+   overrides ;; An alist of (fieldname . encoder-to-use-instead-of-default)
+   world     ;; For looking up default encoders
+   )
+  ;; Returns an alist of the form (fieldname . encoder-to-use)
+  (b* (((when (atom efields))
+        nil)
+       ((cutil::formal e1) (car efields))
+       (- (cw "Determining encoder for ~x0... " e1.name))
+
+       ;; Are we supposed to omit it?
+       ((when (member e1.name omit))
+        (cw "omitting it.~%")
+        (make-json-encoder-alist (cdr efields) omit overrides world))
+
+       ;; Are we supposed to override it?
+       (look (assoc e1.name overrides))
+       ((when look)
+        (cw "overriding with ~x0.~%" (cdr look))
+        (cons (cons e1.name (cdr look))
+              (make-json-encoder-alist (cdr efields) omit overrides world)))
+
+       ((unless (and (tuplep 2 e1.guard)
+                     (equal (second e1.guard) e1.name)))
+        (raise "Guard ~x0 too complex.~%" e1.guard))
+
+       (predicate (first e1.guard))
+       (encoder   (get-json-encoder predicate world)))
+    (cw "defaulting to ~x0~%" encoder)
+    (cons (cons e1.name encoder)
+          (make-json-encoder-alist (cdr efields) omit overrides world))))
+
+(define encoder-alist-main-actions
+  (basename ;; base name for aggregate, e.g., 'vl-location
+   alist    ;; alist of fields->encoder to use
+   newlines ;; NIL means don't auto-newline between elements; any number means
+            ;; newline and indent to that many places between lines
+   )
+  (b* (((when (atom alist))
+        nil)
+       ((cons fieldname encoder) (car alist))
+       (foo->bar                 (cutil::da-accessor-name basename fieldname))
+       ;; Suppose the fieldname is foo.  We create the string ["foo":].  We can
+       ;; create this at macroexpansion time.
+       (name1       (str::downcase-string (symbol-name fieldname)))
+       (name1-colon (str::cat "\"" name1 "\": ")))
+    (list* `(vl-print-str ,name1-colon)
+           `(,encoder (,foo->bar x))
+           (if (atom (cdr alist))
+               nil
+             (cons (if newlines
+                       `(vl-ps-seq (vl-println ", ")
+                                   (vl-indent ,newlines))
+                     `(vl-println? ", "))
+                   (encoder-alist-main-actions basename (cdr alist) newlines))))))
+
+(define def-vl-jp-aggregate-fn (type omit overrides long newlines world)
+  (b* ((mksym-package-symbol 'vl::foo)
+       (elem-print     (mksym 'vl-jp- type))
+       (elem           (mksym 'vl- type))
+       (elem-p         (mksym 'vl- type '-p))
+       (elem-p-str     (symbol-name elem-p))
+
+       ((cutil::agginfo agg) (cutil::get-aggregate elem world))
+       ((unless (cutil::formallist-p agg.efields))
+        (raise "Expected :efields for ~x0 to be a valid formallist, found ~x1."
+               elem agg.efields))
+       (enc-alist (make-json-encoder-alist agg.efields omit overrides world))
+       ((unless (consp enc-alist))
+        (raise "Expected at least one field to encode."))
+       (main      (encoder-alist-main-actions elem enc-alist newlines)))
+
+    `(define ,elem-print ((x ,elem-p) &key (ps 'ps))
+       :parents (json-encoders)
+       :short ,(cat "Print the JSON encoding of a @(see " elem-p-str
+                    ") to @(see ps).")
+       :long ,long
+       (vl-ps-seq
+        (vl-print "{\"tag\": ")
+        (jp-sym ,agg.tag)
+        ,(if newlines
+             `(vl-ps-seq (vl-println ", ")
+                         (vl-indent ,newlines))
+           `(vl-print ", "))
+        ,@main
+        (vl-println? "}"))
+       ///
+       (add-json-encoder ,elem-p ,elem-print))))
+
+#|
+(def-vl-jp-aggregate-fn
+  'location
+  '(col)
+  '((filename . blah))
+  "long"
+  (w state))
+|#
+
+(defmacro def-vl-jp-aggregate (type &key omit override newlines
+                                    (long '""))
+  (declare (xargs :guard (vl-maybe-natp newlines)))
+  `(make-event
+    (let ((form (def-vl-jp-aggregate-fn ',type ',omit ',override ',long ',newlines
+                  (w state))))
+      (value form))))
+
+(logic)
+
+
+(defmacro def-vl-jp-list (type &key newlines)
+  (declare (xargs :guard (vl-maybe-natp newlines)))
+  (b* ((mksym-package-symbol 'vl::foo)
+       (list-p         (mksym 'vl- type 'list-p))
+       (elem-print     (mksym 'vl-jp- type))
+       (list-print-aux (mksym 'vl-jp- type 'list-aux))
+       (list-print     (mksym 'vl-jp- type 'list))
+       (list-p-str     (symbol-name list-p)))
+    `(encapsulate ()
+       (define ,list-print-aux ((x ,list-p) &key (ps 'ps))
+         :parents (,list-print)
+         :short ,(cat "Prints out the elements of a @(see " list-p-str
+                      ") without the enclosing brackets.")
+         (if (atom x)
+             ps
+           (vl-ps-seq (,elem-print (car x))
+                      (if (atom (cdr x))
+                          ps
+                        ,(if newlines
+                             `(vl-ps-seq (vl-println ",")
+                                         (vl-indent ,newlines))
+                           `(vl-println? ", ")))
+                      (,list-print-aux (cdr x)))))
+       (define ,list-print ((x ,list-p) &key (ps 'ps))
+         :parents (json-encoders)
+         :short ,(cat "Prints out the elements of a @(see " list-p-str
+                      ") with the enclosing brackets.")
+         (vl-ps-seq (vl-print "[")
+                    (,list-print-aux x)
+                    (vl-println? "]")))
+       (add-json-encoder ,list-p ,list-print))))
+
+
+
+;; Real Verilog JSON Encoding
+
+(define vl-jp-exprtype ((x vl-exprtype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-cstrength ((x vl-cstrength-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-dstrength ((x vl-dstrength-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-direction ((x vl-direction-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-gatetype ((x vl-gatetype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-evatomtype ((x vl-evatomtype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-assign-type ((x vl-assign-type-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-deassign-type ((x vl-deassign-type-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-casetype ((x vl-casetype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-netdecltype ((x vl-netdecltype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-taskporttype ((x vl-taskporttype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-vardecltype ((x vl-vardecltype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-paramdecltype ((x vl-paramdecltype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(define vl-jp-compoundstmttype ((x vl-compoundstmttype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (jp-sym x))
+
+(add-json-encoder vl-exprtype-p         vl-jp-exprtype)
+(add-json-encoder vl-cstrength-p        vl-jp-cstrength)
+(add-json-encoder vl-dstrength-p        vl-jp-dstrength)
+(add-json-encoder vl-direction-p        vl-jp-direction)
+(add-json-encoder vl-gatetype-p         vl-jp-gatetype)
+(add-json-encoder vl-evatomtype-p       vl-jp-evatomtype)
+(add-json-encoder vl-assign-type-p      vl-jp-assign-type)
+(add-json-encoder vl-deassign-type-p    vl-jp-deassign-type)
+(add-json-encoder vl-casetype-p         vl-jp-casetype)
+(add-json-encoder vl-netdecltype-p      vl-jp-netdecltype)
+(add-json-encoder vl-taskporttype-p     vl-jp-taskporttype)
+(add-json-encoder vl-vardecltype-p      vl-jp-vardecltype)
+(add-json-encoder vl-paramdecltype-p    vl-jp-paramdecltype)
+(add-json-encoder vl-compoundstmttype-p vl-jp-compoundstmttype)
+
+
+(define vl-jp-maybe-exprtype ((x vl-maybe-exprtype-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (if x
+      (vl-jp-exprtype x)
+    (vl-print "null")))
+
+(define vl-jp-maybe-cstrength ((x vl-maybe-cstrength-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (if x
+      (vl-jp-cstrength x)
+    (vl-print "null")))
+
+(define vl-jp-maybe-direction ((x vl-maybe-direction-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :inline t
+  (if x
+      (vl-jp-direction x)
+    (vl-print "null")))
+
+(add-json-encoder vl-maybe-exprtype-p  vl-jp-maybe-exprtype)
+(add-json-encoder vl-maybe-cstrength-p vl-jp-maybe-cstrength)
+(add-json-encoder vl-maybe-direction-p vl-jp-maybe-direction)
+
+(def-vl-jp-aggregate location)
+
+#||
+(top-level
+ (vl-cw-ps-seq (vl-jp-location *vl-fakeloc*)))
+||#
+
+
+
+(def-vl-jp-aggregate constint
+  :override ((value . jp-bignat))
+  :long "<p>Note that we always encode the value as a string.  This is
+because it is quite common for Verilog constants to run into the hundreds
+of bits, but the JSON standard doesn't really ever say how big of numbers
+must be supported and JSON implementations often use machine integers
+which could not hold such large values.</p>")
+
+(define jp-bitlist ((x vl-bitlist-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :short "Encode a @(see vl-bitlist-p) as a JSON string."
+  (jp-str (vl-bitlist->string x)))
+
+(add-json-encoder vl-bitlist-p jp-bitlist)
+
+(def-vl-jp-aggregate weirdint)
+(def-vl-jp-aggregate string)
+(def-vl-jp-aggregate real)
+(def-vl-jp-aggregate id)
+(def-vl-jp-aggregate hidpiece)
+(def-vl-jp-aggregate sysfunname)
+(def-vl-jp-aggregate funname)
+
+(define vl-jp-atomguts ((x vl-atomguts-p) &key (ps 'ps))
+  :parents (vl-jp-expr vl-atomguts-p)
+  :guard-hints (("Goal" :in-theory (enable vl-atomguts-p)))
+  (case (tag x)
+    (:vl-id         (vl-jp-id x))
+    (:vl-constint   (vl-jp-constint x))
+    (:vl-weirdint   (vl-jp-weirdint x))
+    (:vl-string     (vl-jp-string x))
+    (:vl-real       (vl-jp-real x))
+    (:vl-hidpiece   (vl-jp-hidpiece x))
+    (:vl-funname    (vl-jp-funname x))
+    (otherwise      (vl-jp-sysfunname x))))
+
+(add-json-encoder vl-atomguts-p vl-jp-atomguts)
+
+(def-vl-jp-aggregate atom)
+
+(defsection vl-jp-expr
+  :parents (json-encoders)
+
+  (defmacro vl-jp-expr (x &key (ps 'ps))
+    `(vl-jp-expr-fn ,x ,ps))
+
+  (defmacro vl-jp-atts (x &key (ps 'ps))
+    `(vl-jp-atts-fn ,x ,ps))
+
+  (defmacro vl-jp-atts-aux (x &key (ps 'ps))
+    `(vl-jp-atts-aux-fn ,x ,ps))
+
+  (defmacro vl-jp-exprlist (x &key (ps 'ps))
+    `(vl-jp-exprlist-fn ,x ,ps))
+
+  (defmacro vl-jp-exprlist-aux (x &key (ps 'ps))
+    `(vl-jp-exprlist-aux-fn ,x ,ps))
+
+  (mutual-recursion
+   (defund vl-jp-expr-fn (x ps)
+     (declare (xargs :guard (vl-expr-p x)
+                     :stobjs ps
+                     :measure (two-nats-measure (acl2-count x) 2)))
+     (b* (((when (vl-fast-atom-p x))
+           (vl-jp-atom x))
+          ((vl-nonatom x) x))
+       (jp-object :tag        (jp-sym :vl-nonatom)
+                  :atts       (vl-jp-atts x.atts)
+                  :args       (vl-jp-exprlist x.args)
+                  :finalwidth (jp-maybe-nat x.finalwidth)
+                  :finaltype  (vl-jp-maybe-exprtype x.finaltype))))
+
+   (defund vl-jp-atts-fn (x ps)
+     ;; Atts are a string->maybe-expr alist, so turn them into a JSON object
+     ;; binding keys to values...
+     (declare (xargs :guard (vl-atts-p x)
+                     :stobjs ps
+                     :measure (two-nats-measure (acl2-count x) 1)))
+     (vl-ps-seq (vl-print "{")
+                (vl-jp-atts-aux x)
+                (vl-println? "}")))
+
+   (defund vl-jp-atts-aux-fn (x ps)
+     (declare (xargs :guard (vl-atts-p x)
+                     :stobjs ps
+                     :measure (two-nats-measure (acl2-count x) 0)))
+     (b* (((when (atom x))
+           ps)
+          ((cons name1 val1) (car x)))
+       (vl-ps-seq (jp-str name1)
+                  (vl-print ": ")
+                  (if val1
+                      (vl-jp-expr val1)
+                    (vl-print "null"))
+                  (if (atom (cdr x))
+                      ps
+                    (vl-println? ", "))
+                  (vl-jp-atts-aux (cdr x)))))
+
+   (defund vl-jp-exprlist-fn (x ps)
+     ;; Print the expressions as a JSON array with brackets.
+     (declare (xargs :guard (vl-exprlist-p x)
+                     :stobjs ps
+                     :measure (two-nats-measure (acl2-count x) 1)))
+     (vl-ps-seq (vl-print "[")
+                (vl-jp-exprlist-aux x)
+                (vl-println? "]")))
+
+   (defund vl-jp-exprlist-aux-fn (x ps)
+     (declare (xargs :guard (vl-exprlist-p x)
+                     :stobjs ps
+                     :measure (two-nats-measure (acl2-count x) 0)))
+     (b* (((when (atom x))
+           ps))
+       (vl-ps-seq (vl-jp-expr (car x))
+                  (if (atom (cdr x))
+                      ps
+                    (vl-println? ", "))
+                  (vl-jp-exprlist-aux (cdr x)))))))
+
+(define vl-jp-maybe-expr ((x vl-maybe-expr-p) &key (ps 'ps))
+  (if x
+      (vl-jp-expr x)
+    (vl-print "null")))
+
+(add-json-encoder vl-expr-p       vl-jp-expr)
+(add-json-encoder vl-exprlist-p   vl-jp-exprlist)
+(add-json-encoder vl-atts-p       vl-jp-atts)
+(add-json-encoder vl-maybe-expr-p vl-jp-maybe-expr)
+
+(def-vl-jp-aggregate range)
+(def-vl-jp-list range)
+
+(define vl-jp-maybe-range ((x vl-maybe-range-p) &key (ps 'ps))
+  (if x
+      (vl-jp-range x)
+    (vl-print "null")))
+
+(add-json-encoder vl-maybe-range-p vl-jp-maybe-range)
+
+(def-vl-jp-aggregate port)
+(def-vl-jp-list port :newlines 4)
+
+
+(def-vl-jp-aggregate gatedelay)
+
+(define vl-jp-maybe-gatedelay ((x vl-maybe-gatedelay-p) &key (ps 'ps))
+  :parents (json-encoders vl-maybe-gatedelay-p)
+  (if x
+      (vl-jp-gatedelay x)
+    (vl-print "null")))
+
+(add-json-encoder vl-maybe-gatedelay-p vl-jp-maybe-gatedelay)
+
+(def-vl-jp-aggregate netdecl)
+(def-vl-jp-list netdecl :newlines 4)
+
+(def-vl-jp-aggregate regdecl)
+(def-vl-jp-list regdecl :newlines 4)
+
+(def-vl-jp-aggregate plainarg)
+(def-vl-jp-list plainarg :newlines 4)
+
+(def-vl-jp-aggregate namedarg)
+(def-vl-jp-list namedarg :newlines 4)
+
+(def-vl-jp-aggregate vardecl)
+(def-vl-jp-list vardecl :newlines 4)
+
+(def-vl-jp-aggregate eventdecl)
+(def-vl-jp-list eventdecl :newlines 4)
+
+(def-vl-jp-aggregate paramdecl)
+(def-vl-jp-list paramdecl :newlines 4)
+
+(define vl-jp-blockitem ((x vl-blockitem-p) &key (ps 'ps))
+  :guard-hints (("Goal" :in-theory (enable vl-blockitem-p)))
+  (mbe :logic
+       (cond ((vl-regdecl-p x)    (vl-jp-regdecl x))
+             ((vl-vardecl-p x)    (vl-jp-vardecl x))
+             ((vl-eventdecl-p x)  (vl-jp-eventdecl x))
+             (t                   (vl-jp-paramdecl x)))
+       :exec
+       (case (tag x)
+         (:vl-regdecl   (vl-jp-regdecl x))
+         (:vl-vardecl   (vl-jp-vardecl x))
+         (:vl-eventdecl (vl-jp-eventdecl x))
+         (otherwise     (vl-jp-paramdecl x)))))
+
+(add-json-encoder vl-blockitem-p vl-jp-blockitem)
+(def-vl-jp-list blockitem)
+
+(define vl-jp-arguments ((x vl-arguments-p) &key (ps 'ps))
+  :parents (json-encoders vl-arguments-p)
+  (b* (((vl-arguments x) x))
+    (jp-object :tag    (jp-sym :vl-arguments)
+               :namedp (jp-bool x.namedp)
+               :args   (if x.namedp
+                           (vl-jp-namedarglist x.args)
+                         (vl-jp-plainarglist x.args)))))
+
+(add-json-encoder vl-arguments-p vl-jp-arguments)
+
+(def-vl-jp-aggregate gatestrength)
+
+(define vl-jp-maybe-gatestrength ((x vl-maybe-gatestrength-p) &key (ps 'ps))
+  (if x
+      (vl-jp-gatestrength x)
+    (vl-print "null")))
+
+(add-json-encoder vl-maybe-gatestrength-p vl-jp-maybe-gatestrength)
+
+(def-vl-jp-aggregate modinst)
+(def-vl-jp-list modinst)
+
+(def-vl-jp-aggregate gateinst)
+(def-vl-jp-list gateinst)
+
+(def-vl-jp-aggregate delaycontrol)
+(def-vl-jp-aggregate evatom)
+(def-vl-jp-list evatom)
+
+(def-vl-jp-aggregate eventcontrol)
+(def-vl-jp-aggregate repeateventcontrol)
+
+
+(define vl-jp-delayoreventcontrol ((x vl-delayoreventcontrol-p) &key (ps 'ps))
+  :guard-hints (("Goal" :in-theory (enable vl-delayoreventcontrol-p)))
+  (cond ((vl-delaycontrol-p x) (vl-jp-delaycontrol x))
+        ((vl-eventcontrol-p x) (vl-jp-eventcontrol x))
+        (t                     (vl-jp-repeateventcontrol x))))
+
+(add-json-encoder vl-delayoreventcontrol-p vl-jp-delayoreventcontrol)
+
+(define vl-jp-maybe-delayoreventcontrol ((x vl-maybe-delayoreventcontrol-p)
+                                         &key (ps 'ps))
+  (if x
+      (vl-jp-delayoreventcontrol x)
+    (vl-print "null")))
+
+(add-json-encoder vl-maybe-delayoreventcontrol-p vl-jp-maybe-delayoreventcontrol)
+
+(def-vl-jp-aggregate assignstmt)
+(def-vl-jp-aggregate nullstmt)
+(def-vl-jp-aggregate enablestmt)
+(def-vl-jp-aggregate deassignstmt)
+(def-vl-jp-aggregate disablestmt)
+(def-vl-jp-aggregate eventtriggerstmt)
+
+(define vl-jp-atomicstmt ((x vl-atomicstmt-p) &key (ps 'ps))
+  :guard-hints (("Goal" :in-theory (enable vl-atomicstmt-p)))
+  (mbe :logic
+       (cond ((vl-nullstmt-p x)          (vl-jp-nullstmt x))
+             ((vl-assignstmt-p x)        (vl-jp-assignstmt x))
+             ((vl-deassignstmt-p x)      (vl-jp-deassignstmt x))
+             ((vl-enablestmt-p x)        (vl-jp-enablestmt x))
+             ((vl-disablestmt-p x)       (vl-jp-disablestmt x))
+             (t                          (vl-jp-eventtriggerstmt x)))
+       :exec
+       (case (tag x)
+         (:vl-nullstmt           (vl-jp-nullstmt x))
+         (:vl-assignstmt         (vl-jp-assignstmt x))
+         (:vl-deassignstmt       (vl-jp-deassignstmt x))
+         (:vl-enablestmt         (vl-jp-enablestmt x))
+         (:vl-disablestmt        (vl-jp-disablestmt x))
+         (otherwise              (vl-jp-eventtriggerstmt x)))))
+
+
+(defmacro vl-jp-stmt (x)
+  `(vl-jp-stmt-fn ,x ps))
+
+(defmacro vl-jp-stmtlist (x)
+  `(vl-jp-stmtlist-fn ,x ps))
+
+(defmacro vl-jp-stmtlist-aux (x)
+  `(vl-jp-stmtlist-aux-fn ,x ps))
+
+(mutual-recursion
+
+ (defund vl-jp-stmt-fn (x ps)
+   (declare (xargs :guard (vl-stmt-p x)
+                   :stobjs ps
+                   :measure (two-nats-measure (acl2-count x) 2)))
+   (b* (((when (vl-fast-atomicstmt-p x))
+         (vl-jp-atomicstmt x))
+        ((vl-compoundstmt x) x))
+     (jp-object :tag         (jp-sym :vl-compoundstmt)
+                :type        (vl-jp-compoundstmttype x.type)
+                :exprs       (vl-jp-exprlist x.exprs)
+                :stmts       (vl-jp-stmtlist x.stmts)
+                :name        (jp-maybe-string x.name)
+                :decls       (vl-jp-blockitemlist x.decls)
+                :ctrl        (vl-jp-maybe-delayoreventcontrol x.ctrl)
+                :sequentialp (jp-bool x.sequentialp)
+                :casetype    (vl-jp-casetype x.casetype)
+                :atts        (vl-jp-atts x.atts))))
+
+ (defund vl-jp-stmtlist-fn (x ps)
+   ;; Print the stmtessions as a JSON array with brackets.
+   (declare (xargs :guard (vl-stmtlist-p x)
+                   :stobjs ps
+                   :measure (two-nats-measure (acl2-count x) 1)))
+   (vl-ps-seq (vl-print "[")
+              (vl-jp-stmtlist-aux x)
+              (vl-println? "]")))
+
+ (defund vl-jp-stmtlist-aux-fn (x ps)
+   (declare (xargs :guard (vl-stmtlist-p x)
+                   :stobjs ps
+                   :measure (two-nats-measure (acl2-count x) 0)))
+   (b* (((when (atom x))
+         ps))
+     (vl-ps-seq (vl-jp-stmt (car x))
+                (if (atom (cdr x))
+                    ps
+                  (vl-println? ", "))
+                (vl-jp-stmtlist-aux (cdr x))))))
+
+(add-json-encoder vl-stmt-p vl-jp-stmt)
+(add-json-encoder vl-stmtlist-p vl-jp-stmtlist)
+
+
+(def-vl-jp-aggregate always)
+(def-vl-jp-list always :newlines 4)
+
+(def-vl-jp-aggregate initial)
+(def-vl-jp-list initial :newlines 4)
+
+(def-vl-jp-aggregate taskport)
+(def-vl-jp-list taskport :newlines 4)
+
+(def-vl-jp-aggregate fundecl)
+(def-vl-jp-list fundecl :newlines 4)
+
+(def-vl-jp-aggregate taskdecl)
+(def-vl-jp-list taskdecl :newlines 4)
+
+(def-vl-jp-aggregate portdecl)
+(def-vl-jp-list portdecl :newlines 4)
+
+(def-vl-jp-aggregate assign)
+(def-vl-jp-list assign :newlines 4)
+
+
+
+
+(define vl-jp-warning ((x vl-warning-p) &key (ps 'ps))
+  :parents (json-encoders)
+  :short "Special, custom JSON encoder for warnings."
+
+  :long "<p>We probably don't want to use the ordinary aggregate-encoding stuff
+to print @(see vl-warning-p) objects, since the types in the @(':args') field
+are dynamic and, besides, who wants to reimplement @(see vl-cw) in other
+languages.  Instead, it's probably more convenient to just go ahead and convert
+the warning into a printed message here.  We'll include both HTML and plain
+TEXT versions of the message.</p>"
+
+  (b* (((vl-warning x) x)
+       (text (with-local-ps (vl-cw-obj x.msg x.args)))
+       (html (with-local-ps (vl-ps-update-htmlp t)
+                            (vl-cw-obj x.msg x.args))))
+    (jp-object :tag    (vl-print "\"warning\"")
+               :fatalp (jp-bool x.fatalp)
+               :type   (jp-str (symbol-name x.type))
+               :fn     (jp-str (symbol-name x.fn))
+               :text   (jp-str text)
+               :html   (jp-str html))))
+
+(add-json-encoder vl-warning-p jp-warning)
+
+(def-vl-jp-list warning :newlines 4)
+
+
+
+
+(define vl-jp-commentmap-aux ((x vl-commentmap-p) &key (ps 'ps))
+  (b* (((when (atom x))
+        ps))
+    (vl-ps-seq (vl-print "{\"loc\": ")
+               (vl-jp-location (caar x))
+               (vl-println? ", \"comment\": ")
+               (jp-str (cdar x))
+               (vl-print "}")
+               (if (atom (cdr x))
+                   ps
+                 (vl-println? ", "))
+               (vl-jp-commentmap-aux (cdr x)))))
+
+(define vl-jp-commentmap ((x vl-commentmap-p) &key (ps 'ps))
+  (vl-ps-seq (vl-print "[")
+             (vl-jp-commentmap-aux x)
+             (vl-println? "]")))
+
+(add-json-encoder vl-commentmap-p vl-jp-commentmap)
+
+(def-vl-jp-aggregate module
+  :omit (params esim)
+  :newlines 2)
+
+(def-vl-jp-list module
+  :newlines 1)
+
+(define vl-jp-modalist-aux ((x vl-modalist-p) &key (ps 'ps))
+  (b* (((when (atom x))
+        ps))
+    (vl-ps-seq (jp-str (caar x))
+               (vl-print ": ")
+               (vl-jp-module (cdar x))
+               (if (atom (cdr x))
+                   ps
+                 (vl-println ", "))
+               (vl-jp-modalist-aux (cdr x)))))
+
+(define vl-jp-modalist ((x vl-modalist-p) &key (ps 'ps))
+  (vl-ps-seq (vl-print "{")
+             (vl-jp-modalist-aux x)
+             (vl-println "}")))
+
+
+(define vl-jp-individual-modules ((x vl-modulelist-p) &key (ps 'ps))
+  ;; This doesn't print a single valid JSON object.  Instead, it prints a whole
+  ;; list of JSON objects separated by newlines.
+  (if (atom x)
+      ps
+    (vl-ps-seq (vl-jp-module (car x))
+               (vl-print "
+
+")
+               (vl-jp-individual-modules (cdr x)))))
diff -Nru acl2-6.2/books/centaur/vl/mlib/writer.lisp acl2-6.3/books/centaur/vl/mlib/writer.lisp
--- acl2-6.2/books/centaur/vl/mlib/writer.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/mlib/writer.lisp	2013-09-30 17:53:06.000000000 +0000
@@ -84,19 +84,19 @@
        ((when (zp len))
         (raise "Empty identifier")
         "")
+       ;; BOZO it'd be really good to avoid this coerce
+       (chars (explode x))
        ((when (and (vl-simple-id-head-p (char x 0))
                    (vl-simple-id-tail-string-p x 1 len)
-                   (not (member #\$ (coerce x 'list)))))
+                   (not (member #\$ chars))))
         ;; A simple identifier, nothing to add.
         (string-fix x))
        ;; Escaped identifier.  This isn't efficient but this should be pretty
        ;; unusual.
-       (chars (coerce x 'list))
        ((when (member #\Space chars))
         (raise "Identifier name has spaces?  ~x0" x)
         ""))
-    (coerce (cons #\\ (append chars (list #\Space)))
-            'string)))
+    (implode (cons #\\ (append chars (list #\Space))))))
 
 (define vl-print-modname ((x stringp) &key (ps 'ps))
   :parents (verilog-printing)
@@ -1086,6 +1086,72 @@
     (vl-ps-seq (vl-pp-vardecl (car x))
                (vl-pp-vardecllist (cdr x)))))
 
+(define vl-pp-eventdecl ((x vl-eventdecl-p) &key (ps 'ps))
+  (b* (((vl-eventdecl x) x))
+    (vl-ps-seq
+     (if x.atts (vl-pp-atts x.atts) ps)
+     (vl-ps-span "vl_key" (vl-print "  event "))
+     (vl-print-wirename x.name)
+     (if x.arrdims
+         (vl-pp-rangelist x.arrdims)
+       ps)
+     (vl-println " ;"))))
+
+(define vl-pp-eventdecllist ((x vl-eventdecllist-p) &key (ps 'ps))
+  (if (atom x)
+      ps
+    (vl-ps-seq (vl-pp-eventdecl (car x))
+               (vl-pp-eventdecllist (cdr x)))))
+
+(define vl-pp-paramdecl ((x vl-paramdecl-p) &key (ps 'ps))
+  (b* (((vl-paramdecl x) x))
+    (vl-ps-seq (vl-print "  ")
+               (if x.atts
+                   (vl-ps-seq (vl-pp-atts x.atts)
+                              (vl-print " "))
+                 ps)
+               (vl-ps-span "vl_key"
+                           (if x.localp
+                               (vl-print "localparam ")
+                             (vl-print "parameter "))
+                           (case x.type
+                             (:vl-signed (vl-print "signed "))
+                             (:vl-integer (vl-print "integer "))
+                             (:vl-real (vl-print "real "))
+                             (:vl-time (vl-print "time "))
+                             (:vl-realtime (vl-print "realtime "))
+                             (otherwise ps)))
+               (if x.range
+                   (vl-ps-seq (vl-pp-range x.range)
+                              (vl-print " "))
+                 ps)
+               (vl-print-wirename x.name)
+               (vl-print " = ")
+               (vl-pp-expr x.expr)
+               (vl-println ";"))))
+
+(define vl-pp-paramdecllist ((x vl-paramdecllist-p) &key (ps 'ps))
+  (if (atom x)
+      ps
+    (vl-ps-seq (vl-pp-paramdecl (car x))
+               (vl-pp-paramdecllist (cdr x)))))
+
+(define vl-pp-blockitem ((x vl-blockitem-p) &key (ps 'ps))
+  (case (tag x)
+    (:vl-regdecl   (vl-pp-regdecl x))
+    (:vl-vardecl   (vl-pp-vardecl x))
+    (:vl-eventdecl (vl-pp-eventdecl x))
+    (:vl-paramdecl (vl-pp-paramdecl x))
+    (otherwise     (progn$ (impossible) ps))))
+
+(define vl-pp-blockitemlist ((x vl-blockitemlist-p) &key (ps 'ps))
+  (if (atom x)
+      ps
+    (vl-ps-seq (vl-pp-blockitem (car x))
+               (vl-pp-blockitemlist (cdr x)))))
+
+
+
 (define vl-pp-gatedelay ((x vl-gatedelay-p) &key (ps 'ps))
   (b* (((vl-gatedelay x) x))
     (cond
@@ -1099,8 +1165,16 @@
        (vl-ps-span "vl_int"
                    (vl-print-nat (vl-constint->value (vl-atom->guts x.rise))))))
 
+     ((and (hide (equal x.rise x.fall))
+           (hide (equal x.fall x.high)))
+      ;; Print #(a,a,a) just as #(a)
+      (vl-ps-seq
+       (vl-print "#(")
+       (vl-pp-expr x.rise)
+       (vl-print ")")))
+
      (x.high
-      ;; All three specified
+      ;; All three specified, and not equal...
       (vl-ps-seq (vl-print "#(")
                  (vl-pp-expr x.rise)
                  (vl-println? ", ")
@@ -1535,7 +1609,7 @@
     (:vl-bufif0   "bufif0")
     (:vl-bufif1   "bufif1")
     (:vl-notif0   "notif0")
-    (:vl-notif1   "notif")
+    (:vl-notif1   "notif1")
     (:vl-nmos     "nmos")
     (:vl-pmos     "pmos")
     (:vl-rnmos    "rnmos")
@@ -1697,6 +1771,13 @@
           (ps (vl-ps-update-autowrap-ind _pp_stmt_autowrap_ind_)))
      ps))
 
+(define vl-pp-blockitemlist-indented ((x vl-blockitemlist-p) &key (ps 'ps))
+  (if (atom x)
+      ps
+    (vl-ps-seq
+     (vl-pp-stmt-indented (vl-pp-blockitem (car x)))
+     (vl-pp-blockitemlist-indented (cdr x)))))
+
 (define vl-pp-assignstmt ((x vl-assignstmt-p) &key (ps 'ps))
   (b* (((vl-assignstmt x) x))
     (vl-ps-seq (vl-pp-stmt-autoindent)
@@ -1739,18 +1820,54 @@
                  ps)
                (vl-println " ;"))))
 
+(define vl-pp-disablestmt ((x vl-disablestmt-p) &key (ps 'ps))
+  (b* (((vl-disablestmt x) x))
+    (vl-ps-seq (vl-pp-stmt-autoindent)
+               (if x.atts (vl-pp-atts x.atts) ps)
+               (vl-ps-span "vl_key"
+                           (vl-print "disable "))
+               (vl-pp-expr x.id)
+               (vl-println " ;"))))
+
+(define vl-pp-deassignstmt ((x vl-deassignstmt-p) &key (ps 'ps))
+  (b* (((vl-deassignstmt x) x))
+    (vl-ps-seq (vl-pp-stmt-autoindent)
+               (if x.atts (vl-pp-atts x.atts) ps)
+               (vl-ps-span "vl_key"
+                           (case x.type
+                             (:vl-deassign (vl-print "deassign "))
+                             (:vl-release  (vl-print "release "))
+                             (otherwise    (progn$ (impossible) ps))))
+               (vl-pp-expr x.lvalue)
+               (vl-println " ;"))))
+
+(define vl-pp-eventtriggerstmt ((x vl-eventtriggerstmt-p) &key (ps 'ps))
+  (b* (((vl-eventtriggerstmt x) x))
+    (vl-ps-seq (vl-pp-stmt-autoindent)
+               (if x.atts (vl-pp-atts x.atts) ps)
+               (vl-print "-> ")
+               (vl-pp-expr x.id)
+               (vl-println " ;"))))
+
 (define vl-pp-atomicstmt ((x vl-atomicstmt-p) &key (ps 'ps))
-  (cond ((vl-fast-nullstmt-p x)
-         (vl-pp-nullstmt x))
-        ((vl-fast-assignstmt-p x)
-         (vl-pp-assignstmt x))
-        ((vl-fast-enablestmt-p x)
-         (vl-pp-enablestmt x))
-        (t
-         (vl-ps-seq
-          (vl-print "// OOPS, IMPLEMENT ")
-          (vl-println (symbol-name (tag x)))
-          ps))))
+  :guard-hints(("Goal" :in-theory (enable vl-atomicstmt-p)))
+  (mbe :logic
+       (cond ((vl-nullstmt-p x)         (vl-pp-nullstmt x))
+             ((vl-assignstmt-p x)       (vl-pp-assignstmt x))
+             ((vl-deassignstmt-p x)     (vl-pp-deassignstmt x))
+             ((vl-enablestmt-p x)       (vl-pp-enablestmt x))
+             ((vl-disablestmt-p x)      (vl-pp-disablestmt x))
+             ((vl-eventtriggerstmt-p x) (vl-pp-eventtriggerstmt x))
+             (t
+              (progn$ (impossible) ps)))
+       :exec
+       (case (tag x)
+         (:vl-nullstmt      (vl-pp-nullstmt x))
+         (:vl-assignstmt    (vl-pp-assignstmt x))
+         (:vl-deassignstmt  (vl-pp-deassignstmt x))
+         (:vl-enablestmt    (vl-pp-enablestmt x))
+         (:vl-disablestmt   (vl-pp-disablestmt x))
+         (otherwise         (vl-pp-eventtriggerstmt x)))))
 
 (define vl-casetype-string ((x vl-casetype-p))
   :returns (str stringp :rule-classes :type-prescription)
@@ -1813,17 +1930,16 @@
              (vl-ps-span "vl_key"
                          (vl-print (if x.sequentialp "begin " "fork ")))
              (if (not x.name)
-                 ps
+                 (vl-println "")
                (vl-ps-seq
                 (vl-print " : ")
                 (vl-ps-span "vl_id"
                             (vl-print-str (vl-maybe-escape-identifier x.name)))
                 (if (not x.decls)
-                    ps
-                  (vl-ps-span
-                   "vl_cmt"
-                   (vl-print "// BOZO implement vl-pp-stmt for block with decls")))))
-             (vl-println "")
+                    (vl-println "")
+                  (vl-ps-seq
+                   (vl-println "")
+                   (vl-pp-blockitemlist-indented x.decls)))))
              (vl-pp-stmt-indented (vl-pp-stmtlist x.stmts))
              (vl-pp-stmt-autoindent)
              (vl-ps-span "vl_key" (vl-print-str (if x.sequentialp "end" "join")))
@@ -1869,13 +1985,74 @@
                        (vl-ps-span "vl_key" (vl-print "endcase"))
                        (vl-println ""))))
 
-         (otherwise
-          ;; :vl-forstmt :vl-foreverstmt
-          ;; :vl-waitstmt :vl-repeatstmt :vl-whilestmt
-          (vl-ps-span "vl_cmt"
-                      (vl-pp-stmt-autoindent)
-                      (vl-print "// BOZO implement vl-pp-stmt for ")
-                      (vl-println (symbol-name type)))))))))
+         ((:vl-foreverstmt)
+          (b* (((vl-foreverstmt x) x))
+            (vl-ps-seq (vl-pp-stmt-autoindent)
+                       (if atts (vl-pp-atts atts) ps)
+                       (vl-ps-span "vl_key" (vl-println "forever"))
+                       (vl-pp-stmt-indented (vl-pp-stmt x.body))
+                       ;; no ending semicolon, the body prints one
+                       )))
+
+         ((:vl-repeatstmt)
+          (b* (((vl-repeatstmt x) x))
+            (vl-ps-seq (vl-pp-stmt-autoindent)
+                       (if atts (vl-pp-atts atts) ps)
+                       (vl-ps-span "vl_key" (vl-print "repeat"))
+                       (vl-print " (")
+                       (vl-pp-expr x.condition)
+                       (vl-println ")")
+                       (vl-pp-stmt-indented (vl-pp-stmt x.body))
+                       ;; no ending semicolon, the body prints one
+                       )))
+
+         ((:vl-waitstmt)
+          (b* (((vl-waitstmt x) x))
+            (vl-ps-seq (vl-pp-stmt-autoindent)
+                       (if atts (vl-pp-atts atts) ps)
+                       (vl-ps-span "vl_key" (vl-print "wait"))
+                       (vl-print " (")
+                       (vl-pp-expr x.condition)
+                       (vl-println ")")
+                       (vl-pp-stmt-indented (vl-pp-stmt x.body))
+                       ;; no ending semicolon, the body prints one
+                       )))
+
+         ((:vl-whilestmt)
+          (b* (((vl-whilestmt x) x))
+            (vl-ps-seq (vl-pp-stmt-autoindent)
+                       (if atts (vl-pp-atts atts) ps)
+                       (vl-ps-span "vl_key" (vl-print "while"))
+                       (vl-print " (")
+                       (vl-pp-expr x.condition)
+                       (vl-println ")")
+                       (vl-pp-stmt-indented (vl-pp-stmt x.body))
+                       ;; no ending semicolon, the body prints one
+                       )))
+
+         ((:vl-forstmt)
+          (b* (((vl-forstmt x) x))
+            (vl-ps-seq (vl-pp-stmt-autoindent)
+                       (if atts (vl-pp-atts atts) ps)
+                       (vl-ps-span "vl_key" (vl-print "for "))
+                       (vl-print "(")
+                       (vl-pp-expr x.initlhs)
+                       (vl-print " = ")
+                       (vl-pp-expr x.initrhs)
+                       (vl-print "; ")
+                       (vl-pp-expr x.test)
+                       (vl-print "; ")
+                       (vl-pp-expr x.nextlhs)
+                       (vl-print " = ")
+                       (vl-pp-expr x.nextrhs)
+                       (vl-println ")")
+                       (vl-pp-stmt-indented (vl-pp-stmt x.body))
+                       ;; no ending semicolon, the body prints one
+                       )))
+
+         (otherwise (progn$
+                     (impossible)
+                     ps)))))))
 
  (defund vl-pp-stmtlist-fn (x ps)
    (declare (xargs :guard (vl-stmtlist-p x)
@@ -1913,7 +2090,10 @@
                                 (vl-pp-stmtlist-fn . list)
                                 (vl-pp-cases-fn . case)))
 
-(verify-guards vl-pp-stmt-fn)
+(verify-guards vl-pp-stmt-fn
+  :hints(("Goal"
+          :in-theory (disable double-containment
+                              member-equal-when-member-equal-of-cdr-under-iff))))
 
 (define vl-pp-always ((x vl-always-p) &key (ps 'ps))
   (b* (((vl-always x) x))
@@ -1944,52 +2124,6 @@
                (vl-println "")
                (vl-pp-initiallist (cdr x)))))
 
-(define vl-pp-paramdecl ((x vl-paramdecl-p) &key (ps 'ps))
-  (b* (((vl-paramdecl x) x))
-    (vl-ps-seq (vl-print "  ")
-               (if x.atts
-                   (vl-ps-seq (vl-pp-atts x.atts)
-                              (vl-print " "))
-                 ps)
-               (vl-ps-span "vl_key"
-                           (if x.localp
-                               (vl-print "localparam ")
-                             (vl-print "parameter "))
-                           (case x.type
-                             (:vl-signed (vl-print "signed "))
-                             (:vl-integer (vl-print "integer "))
-                             (:vl-real (vl-print "real "))
-                             (:vl-time (vl-print "time "))
-                             (:vl-realtime (vl-print "realtime "))
-                             (otherwise ps)))
-               (if x.range
-                   (vl-ps-seq (vl-pp-range x.range)
-                              (vl-print " "))
-                 ps)
-               (vl-print-wirename x.name)
-               (vl-print " = ")
-               (vl-pp-expr x.expr)
-               (vl-println ";"))))
-
-(define vl-pp-paramdecllist ((x vl-paramdecllist-p) &key (ps 'ps))
-  (if (atom x)
-      ps
-    (vl-ps-seq (vl-pp-paramdecl (car x))
-               (vl-pp-paramdecllist (cdr x)))))
-
-(define vl-pp-blockitem ((x vl-blockitem-p) &key (ps 'ps))
-  (case (tag x)
-    (:vl-regdecl   (vl-pp-regdecl x))
-    (:vl-vardecl   (vl-pp-vardecl x))
-    (:vl-eventdecl (vl-println "// BOZO implement eventdecl printing"))
-    (:vl-paramdecl (vl-pp-paramdecl x))
-    (otherwise     (progn$ (impossible) ps))))
-
-(define vl-pp-blockitemlist ((x vl-blockitemlist-p) &key (ps 'ps))
-  (if (atom x)
-      ps
-    (vl-ps-seq (vl-pp-blockitem (car x))
-               (vl-pp-blockitemlist (cdr x)))))
 
 (define vl-taskporttype-string ((x vl-taskporttype-p))
   :returns (str stringp :rule-classes :type-prescription)
@@ -2134,9 +2268,7 @@
                (vl-pp-regdecllist x.regdecls)
                (vl-pp-netdecllist x.netdecls)
                (vl-pp-vardecllist x.vardecls)
-               (if (not x.eventdecls)
-                   ps
-                 (vl-println "// BOZO implement eventdecl printing"))
+               (vl-pp-eventdecllist x.eventdecls)
                (vl-pp-fundecllist x.fundecls) ;; put them here, so they can refer to declared wires
                (vl-pp-taskdecllist x.taskdecls)
                (vl-pp-assignlist x.assigns)
diff -Nru acl2-6.2/books/centaur/vl/onehot.lisp acl2-6.3/books/centaur/vl/onehot.lisp
--- acl2-6.2/books/centaur/vl/onehot.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/onehot.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -208,7 +208,7 @@
          (submodules (append sub-A sub-B))
 
          ;; module VL_N_BIT_ONEHOT (out, in);
-         (name (hons-copy (cat "VL_" (coerce (explode-atom n 10) 'string) "_BIT_ONEHOT")))
+         (name (hons-copy (cat "VL_" (natstr n) "_BIT_ONEHOT")))
 
          ((mv out-expr out-port out-portdecl out-netdecl) (vl-occform-mkport "out" :vl-output 1))
          ((mv in-expr in-port in-portdecl in-netdecl)     (vl-occform-mkport "in"  :vl-input  n))
diff -Nru acl2-6.2/books/centaur/vl/other-packages.lsp acl2-6.3/books/centaur/vl/other-packages.lsp
--- acl2-6.2/books/centaur/vl/other-packages.lsp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/other-packages.lsp	2013-09-30 17:53:10.000000000 +0000
@@ -27,3 +27,4 @@
 (ld "str/package.lsp" :dir :system)
 (ld "xdoc/package.lsp" :dir :system)
 (ld "cowles/packages.lsp" :dir :system)
+(ld "centaur/getopt/package.lsp" :dir :system)
\ No newline at end of file
diff -Nru acl2-6.2/books/centaur/vl/package.lsp acl2-6.3/books/centaur/vl/package.lsp
--- acl2-6.2/books/centaur/vl/package.lsp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/package.lsp	2013-09-30 17:53:10.000000000 +0000
@@ -20,13 +20,11 @@
 
 (in-package "ACL2")
 
-;; Must be included here for sets:: functions
-(ld "finite-set-theory/osets/sets.defpkg" :dir :system)
-
-;; Must be included here for cutil:: functions
-(ld "cutil/package.lsp" :dir :system)
-
-(ld "oslib/package.lsp" :dir :system)
+(include-book "std/osets/portcullis" :dir :system)
+(include-book "cutil/portcullis" :dir :system)
+(include-book "oslib/portcullis" :dir :system)
+(include-book "centaur/bridge/portcullis" :dir :system)
+(include-book "centaur/getopt/portcullis" :dir :system)
 
 (defmacro multi-union-eq (x y &rest rst)
   (xxxjoin 'union-eq (list* x y rst)))
@@ -36,6 +34,7 @@
    ;; Things to add:
    (multi-union-eq
     cutil::*cutil-exports*
+    getopt::*getopt-exports*
     sets::*sets-exports*
     acl2::*acl2-exports*
     acl2::*common-lisp-symbols-from-main-lisp-package*
@@ -171,17 +170,21 @@
 
       str::cat
       str::natstr
-
+      str::implode
+      str::explode
 
       ;; To make VL::VL show up as just VL in the ACL2 package, e.g., to
       ;; make the XDOC index prettier.
       vl
-
+      hardware-verification
+      esim
 
       ;; acl2-customization file stuff
       why
       with-redef
 
+
+
       ))
 
    ;; Things to remove:
diff -Nru acl2-6.2/books/centaur/vl/parsetree.lisp acl2-6.3/books/centaur/vl/parsetree.lisp
--- acl2-6.2/books/centaur/vl/parsetree.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/parsetree.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -281,9 +281,8 @@
   :parents (vl-expr-p)
   :short "Recognizer for an @(see vl-exprtype-p) or @('nil')."
 
-  :long "<p>As with @(see vl-maybe-exprwidth-p), we use this for the @('sign')
-fields in our expressions, which allows us to represent expressions whose signs
-have not yet been computed.</p>"
+  :long "<p>We use this for the @('sign') fields in our expressions.  It allows
+us to represent expressions whose signs have not yet been computed.</p>"
 
   (or (not x)
       (vl-exprtype-p x))
@@ -307,53 +306,60 @@
 
 
 (defaggregate vl-constint
-  (origwidth origtype value wasunsized)
+  :parents (vl-expr-p)
+  :short "Representation for constant integer literals with no X or Z bits."
   :tag :vl-constint
   :hons t
   :legiblep nil
+
+  ((value      natp
+               :rule-classes :type-prescription
+               "The most important part of a constant integer.  Even
+                immediately upon parsing the value has already been determined
+                and is available to you as an ordinary natural number.")
+
+   (origwidth  posp
+               :rule-classes :type-prescription
+               "Subtle; generally should <b>not be used</b>; see below.")
+
+   (origtype   vl-exprtype-p
+               :rule-classes
+               ((:rewrite)
+                (:type-prescription
+                 :corollary
+                 (implies (force (vl-constint-p x))
+                          (and (symbolp (vl-constint->origtype x))
+                               (not (equal (vl-constint->origtype x) nil))
+                               (not (equal (vl-constint->origtype x) t))))))
+               "Subtle; generally should <b>not be used</b>; see below.")
+
+   (wasunsized booleanp
+               :rule-classes :type-prescription
+               "Set to @('t') by the parser for unsized constants like @('5')
+                and @(''b0101'), but not for sized ones like @('4'b0101')."))
+
   :require
-  ((posp-of-vl-constint->origwidth
-    (posp origwidth)
-    :rule-classes :type-prescription)
-   (vl-exprtype-p-of-vl-constint->origtype
-    (vl-exprtype-p origtype)
-    :rule-classes ((:rewrite)
-                   (:type-prescription
-                    :corollary (implies (force (vl-constint-p x))
-                                        (and (symbolp (vl-constint->origtype x))
-                                             (not (equal (vl-constint->origtype x) nil))
-                                             (not (equal (vl-constint->origtype x) t)))))))
-   (natp-of-vl-constint->value
-    (natp value)
-    :rule-classes :type-prescription)
-   (upper-bound-of-vl-constint->value
+  ((upper-bound-of-vl-constint->value
     (< value (expt '2 origwidth))
-    :rule-classes ((:rewrite) (:linear)))
-   (booleanp-of-vl-constint->wasunsized
-    (booleanp wasunsized)
-    :rule-classes :type-prescription))
-  :parents (vl-expr-p)
-  :short "Representation for constant integer literals with no X or Z bits."
+    :rule-classes ((:rewrite) (:linear))))
 
   :long "<p>Constant integers are produced from source code constructs like
 @('5'), @('4'b0010'), and @('3'h0').</p>
 
-<p>The most important part of a constant integer is its @('value'), which even
-immediately upon parsing has already been determined and is available to you as
-an ordinary natural number.  Note that the value of a constant integer is never
-negative.  In Verilog there are no negative literals; instead, an expression
-like @('-5') is basically parsed the same as @('-(5)'), so the negative sign is
-not part of the literal.  See Section 3.5.1 of the spec.</p>
-
-<p>The @('origwidth') and @('origtype') fields are subtle and should generally
-<b>not be used</b> unless you think you know what you are doing.  These fields
-indicate the <i>original</i> width and signedness of the literal as specified
-in the source code, e.g., if the source code contains @('8'sd 65'), then the
-origwidth will be 8 and the origtype will be @(':vl-signed.') These fields are
-subtle because expression sizing will generally alter the widths and types of
-subexpressions, so these may not represent the final widths and types used in
-expressions.  Instead, the preferred way to determine a constint's final width
-and sign is to inspect the @('vl-atom-p') that contains it.</p>
+<p>Note that the value of a constant integer is never negative.  In Verilog
+there are no negative literals; instead, an expression like @('-5') is
+basically parsed the same as @('-(5)'), so the negative sign is not part of the
+literal.  See Section 3.5.1 of the spec.</p>
+
+<p>The @('origwidth') and @('origtype') fields are subtle.  They indicate the
+<i>original</i> width and signedness of the literal as specified in the source
+code, e.g., if the source code contains @('8'sd 65'), then the origwidth will
+be 8 and the origtype will be @(':vl-signed.')  These fields are subtle because
+@(see expression-sizing) generally alters the widths and types of
+subexpressions, so these may not represent the final widths and types of these
+constants in the context of the larger expression.  Instead, the preferred way
+to determine a constint's final width and sign is to inspect the @('vl-atom-p')
+that contains it.</p>
 
 <p>We insist that @('0 <= value <= 2^origwidth') for every constant integer.
 If our @(see lexer) encounters something ill-formed like @('3'b 1111'), it
@@ -368,135 +374,133 @@
 conveniently makes the width of a constant integer just a positive number.  On
 the other hand, some expressions may produce different results on 32-bit
 versus, say, 64-bit implementations.  Because of this, we added the
-@('wasunsized') attribute so that we might later statically check for
-problematic uses of unsized constants.  This attribute will be set for unsized
-constants like @('5') and @(''b0101'), but not for sized constants like
-@('4'b0101').</p>
+@('wasunsized') field so that we might later statically check for problematic
+uses of unsized constants.</p>
 
 <p>All constints are automatically created with @(see hons).  This is probably
 pretty trivial, but it seems nice.  For instance, the constant integers from
 0-32 are probably used thousands of times throughout a design for bit-selects
 and wire ranges, so sharing their memory may be useful.</p>")
 
+
 (defaggregate vl-weirdint
-  (origwidth origtype bits wasunsized)
+  :parents (vl-expr-p)
+  :short "Representation for constant integer literals with X or Z bits."
   :tag :vl-weirdint
   :hons t
   :legiblep nil
+
+  ((bits        vl-bitlist-p
+                "An MSB-first list of the four-valued Verilog bits making up
+                 this constant's value; see @(see vl-bit-p).")
+
+   (origwidth   posp
+                :rule-classes :type-prescription
+                "Subtle; generally should <b>not be used</b>; see below.")
+
+   (origtype    vl-exprtype-p
+                :rule-classes
+                ((:rewrite)
+                 (:type-prescription
+                  :corollary
+                  (implies (force (vl-weirdint-p x))
+                           (and (symbolp (vl-weirdint->origtype x))
+                                (not (equal (vl-weirdint->origtype x) nil))
+                                (not (equal (vl-weirdint->origtype x) t))))))
+                "Subtle; generally should <b>not be used</b>; see below.")
+
+   (wasunsized  booleanp
+                :rule-classes :type-prescription
+                "Did this constant have an explicit size?"))
+
   :require
-  ((posp-of-vl-weirdint->origwidth
-    (posp origwidth)
-    :rule-classes :type-prescription)
-   (vl-exprtype-p-of-vl-weirdint->origtype
-    (vl-exprtype-p origtype)
-    :rule-classes ((:rewrite)
-                   (:type-prescription
-                    :corollary (implies (force (vl-weirdint-p x))
-                                        (and (symbolp (vl-weirdint->origtype x))
-                                             (not (equal (vl-weirdint->origtype x) nil))
-                                             (not (equal (vl-weirdint->origtype x) t)))))))
-   (vl-bitlist-p-of-vl-weirdint->bits
-    (vl-bitlist-p bits))
-   (len-of-vl-weirdint->bits
+  ((len-of-vl-weirdint->bits
     (equal (len bits) origwidth)
     :rule-classes ((:rewrite)
                    (:type-prescription
                     :corollary (implies (force (vl-weirdint-p x))
                                         (consp (vl-weirdint->bits x)))))))
-  :parents (vl-expr-p)
-  :short "Representation for constant integer literals with X or Z bits."
 
   :long "<p>Weird integers are produced by source code constructs like
 @('1'bz'), @('3'b0X1'), and so on.</p>
 
 <p>The @('origwidth'), @('origtype'), and @('wasunsized') fields are analogous
-to those from @(see vl-constint-p); see the discussion there for details.</p>
-
-<p>Unlike a constint, a weirdint does not have a @('value') but instead has a
-list of @('bits'), stored in MSB-first order as a @(see vl-bitlist-p) of the
-appropriate width.</p>
+to those from @(see vl-constint-p); see the discussion there for details.  But
+unlike a constint, a weirdint does not have a natural-number @('value').
+Instead it has a list of four-valued @('bits') that may include X and Z
+values.</p>
 
 <p>Like constinsts, all weirdints are automatically constructed with @(see
 hons).  This may not be worthwhile since there are probably usually not too
 many weirdints, but by the same reasoning it shouldn't be too harmful.</p>")
 
 
-
 (defaggregate vl-string
-  (value)
-  :tag :vl-string
-  :legiblep nil
-  :require ((stringp-of-vl-string->value
-             (stringp value)
-             :rule-classes :type-prescription))
   :parents (vl-expr-p)
   :short "Representation for string literals."
+  :tag :vl-string
+  :legiblep nil
 
-  :long "<p>The @('value') of a string literal is an ordinary ACL2 string,
-where special sequences like @('\\n') and @('\\t') have been replaced with
-actual newline and tab characters, etc.</p>")
-
+  ((value stringp
+          :rule-classes :type-prescription
+          "An ordinary ACL2 string where, e.g., special sequences like @('\\n')
+           and @('\\t') have been resolved into real newline and tab
+           characters, etc.")))
 
 
 (defaggregate vl-real
-  (value)
-  :tag :vl-real
-  :legiblep nil
-  :require ((stringp-of-vl-real->value
-             (stringp value)
-             :rule-classes :type-prescription))
   :parents (vl-expr-p)
   :short "Representation of real (floating point) literals."
+  :tag :vl-real
+  :legiblep nil
 
-  :long "<p>We currently provide virtually no support for working with real
-numbers.  The @('value') field simply stores the actual characters found in the
-source code, i.e., it might be a string such as @('\"3.41e+12\"').  Do not rely
-on this representation; we will almost certainly want to change it as soon as
-we want to do anything with real numbers.</p>")
-
+  ((value   stringp
+            :rule-classes :type-prescription
+            "The actual characters found in the source code, i.e., it might be
+             a string such as @('\"3.41e+12\"')."))
+
+  :long "<p>We have almost no support for working with real numbers.  You
+should probably not rely on our current representation, since q we will almost
+certainly want to change it as soon as we want to do anything with real
+numbers.</p>")
 
 
 (defaggregate vl-id
-  (name)
+  :parents (vl-expr-p)
+  :short "Representation for simple identifiers."
   :tag :vl-id
   :hons t
   :legiblep nil
-  :require ((stringp-of-vl-id->name
-             (stringp name)
-             :rule-classes :type-prescription))
-  :parents (vl-expr-p)
-  :short "Representation for simple identifiers."
+
+  ((name stringp
+         :rule-classes :type-prescription
+         "This identifier's name.  Our structure only requires that this is an
+          ACL2 string; in practice the name can include <b>any character</b>
+          besides whitespace and should be non-empty.  Note that for escaped
+          identifiers like @('\\foo '), the @('\\') and trailing space are not
+          included in the name; see @(see vl-read-escaped-identifier)."))
 
   :long "<p>@('vl-id-p') objects are used to represent identifiers used in
-expressions, which might be the names of wires, ports, parameters, registers,
-and so on.  The @('name') of the identifier is a string, which should generally
-correspond to one of these items.</p>
+expressions which might be the names of wires, ports, parameters, registers,
+and so on.</p>
 
 <p>A wonderful feature of our representation @('vl-id-p') atoms are guaranteed
 to not be part of any hierarchical identifier, nor are they the names of
 functions or system functions.  See the discussion in @(see vl-hidpiece-p) for
 more information.</p>
 
-<p>Note that names created at parse time may include <b>any character</b>
-except for whitespace, and will not be empty.  One might eventually add these
-restrictions to vl-id tokens, and in other places such as port names, but we
-have not done so since this is all relatively obscure.</p>
-
 <p>Like @(see vl-constint-p)s, we automatically create these structures with
 @(see hons).  This seems quite nice, since the same names may be used many
 times throughout all the expressions in a design.</p>")
 
 
-
 (defaggregate vl-hidpiece
-  (name)
-  :tag :vl-hidpiece
-  :legiblep nil
-  :require ((stringp-of-vl-hidpiece->name
-             (stringp name)
-             :rule-classes :type-prescription))
   :parents (vl-expr-p)
   :short "Represents one piece of a hierarchical identifier."
+  :tag :vl-hidpiece
+  :legiblep nil
+
+  ((name stringp :rule-classes :type-prescription))
 
   :long "<p>We represent hierarchical identifiers like
 @('top.processor[2].reset') as non-atomic expressions.  To represent this
@@ -511,8 +515,8 @@
 hierarchical identifier, and @(':vl-hid-arraydot') is used when instance arrays
 are accessed.</p>
 
-<p>To add slightly more precision, our representation is really more like
-the following:</p>
+<p>To add slightly more precision, our representation is really more like the
+following:</p>
 
 @({
  (:vl-hid-dot (hidpiece \"top\")
@@ -531,38 +535,30 @@
 identifier.</p>")
 
 
-
 (defaggregate vl-sysfunname
-  (name)
-  :tag :vl-sysfunname
-  :legiblep nil
-  :require ((stringp-of-vl-sysfunname->name
-             (stringp name)
-             :rule-classes :type-prescription))
   :parents (vl-expr-p)
   :short "Represents a system function name."
+  :tag :vl-sysfunname
+  :legiblep nil
+
+  ((name stringp :rule-classes :type-prescription))
 
   :long "<p>We use a custom representation for the names of system functions,
 so that we do not confuse them with ordinary @(see vl-id-p) objects.</p>")
 
 
-
 (defaggregate vl-funname
-  (name)
-  :tag :vl-funname
-  :legiblep nil
-  :require ((stringp-of-vl-funname->name
-             (stringp name)
-             :rule-classes :type-prescription))
   :parents (vl-expr-p)
   :short "Represents a (non-system) function name."
+  :tag :vl-funname
+  :legiblep nil
+
+  ((name stringp :rule-classes :type-prescription))
 
   :long "<p>We use a custom representation for the names of functions, so that
 we do not confuse them with ordinary @(see vl-id-p) objects.</p>")
 
 
-
-
 (define vl-atomguts-p (x)
   :parents (vl-expr-p)
   :short "The main contents of a @(see vl-atom-p)."
@@ -570,6 +566,8 @@
   :long "<p>The guts of an atom are its main contents.  See @(see vl-expr-p)
 for a discussion of the valid types.</p>"
 
+  ;; BOZO some kind of defsum macro could eliminate a lot of this boilerplate
+
   (mbe :logic (or (vl-constint-p x)
                   (vl-weirdint-p x)
                   (vl-string-p x)
@@ -747,25 +745,25 @@
 
 
 (defaggregate vl-atom
-  (guts finalwidth finaltype)
-  :tag :vl-atom
-  :legiblep nil
-  :require
-  ((vl-atomguts-p-of-vl-atom->guts
-    (vl-atomguts-p guts))
-   (vl-maybe-natp-of-vl-atom->finalwidth
-    (vl-maybe-natp finalwidth)
-    :rule-classes :type-prescription)
-   (vl-maybe-exprtype-p-of-vl-atom->finaltype
-    (vl-maybe-exprtype-p finaltype)
-    :rule-classes ((:rewrite)
-                   (:type-prescription
-                    :corollary (implies (force (vl-atom-p x))
-                                        (and (symbolp (vl-atom->finaltype x))
-                                             (not (equal (vl-atom->finaltype x) t))))))))
   :parents (vl-expr-p)
   :short "Representation of atomic expressions."
-  :long "<p>See the discussion in @(see vl-expr-p).</p>")
+  :long "<p>See the discussion in @(see vl-expr-p).</p>"
+  :tag :vl-atom
+  :legiblep nil
+
+  ((guts       vl-atomguts-p)
+
+   (finalwidth vl-maybe-natp
+               :rule-classes :type-prescription)
+
+   (finaltype  vl-maybe-exprtype-p
+               :rule-classes
+               ((:rewrite)
+                (:type-prescription
+                 :corollary
+                 (implies (force (vl-atom-p x))
+                          (and (symbolp (vl-atom->finaltype x))
+                               (not (equal (vl-atom->finaltype x) t)))))))))
 
 (deflist vl-atomlist-p (x)
   (vl-atom-p x)
@@ -775,36 +773,41 @@
 
 
 (defaggregate vl-nonatom
-  (op atts args finalwidth finaltype)
-  :tag :vl-nonatom
-  :legiblep nil
-  :require
-  ((vl-op-p-of-vl-nonatom->op
-    (vl-op-p op)
-    :rule-classes ((:rewrite)
-                   (:type-prescription
-                    ;; I previously forced this, but it got irritating because it
-                    ;; kept screwing up termination proofs.  Consider case-split?
-                    :corollary (implies (vl-nonatom-p x)
-                                        (and (symbolp (vl-nonatom->op x))
-                                             (not (equal (vl-nonatom->op x) t))
-                                             (not (equal (vl-nonatom->op x) nil)))))))
-   (vl-maybe-natp-of-vl-nonatom->finalwidth
-    (vl-maybe-natp finalwidth)
-    :rule-classes :type-prescription)
-   (vl-maybe-exprtype-p-of-vl-nonatom->finaltype
-    (vl-maybe-exprtype-p finaltype)
-    :rule-classes ((:rewrite)
-                   (:type-prescription
-                    ;; I previously forced this, but maybe that's a bad idea for
-                    ;; the same reasons as vl-op-p-of-vl-nonatom->op?
-                    :corollary (implies (vl-nonatom-p x)
-                                        (and (symbolp (vl-nonatom->finaltype x))
-                                             (not (equal (vl-nonatom->finaltype x) t))))))))
   :parents (vl-expr-p)
   :short "Structural validity of non-atomic expressions."
   :long "<p>This is only a simple structural check, and does not imply
 @('vl-expr-p').  See @(see vl-expr-p) for details.</p>"
+  :tag :vl-nonatom
+  :legiblep nil
+
+  ((op   vl-op-p
+         :rule-classes
+         ((:rewrite)
+          (:type-prescription
+           :corollary
+           ;; I previously forced the hyp, but it got irritating because it
+           ;; kept screwing up termination proofs.  Consider case-split?
+           (implies (vl-nonatom-p x)
+                    (and (symbolp (vl-nonatom->op x))
+                         (not (equal (vl-nonatom->op x) t))
+                         (not (equal (vl-nonatom->op x) nil)))))))
+
+   (atts "No requirements (yet) due to mutual recursion.")
+   (args "No requirements (yet) due to mutual recursion.")
+
+   (finalwidth vl-maybe-natp
+               :rule-classes :type-prescription)
+
+   (finaltype  vl-maybe-exprtype-p
+               :rule-classes
+               ((:rewrite)
+                (:type-prescription
+                 :corollary
+                 ;; I previously forced this, but maybe that's a bad idea for
+                 ;; the same reasons as vl-op-p-of-vl-nonatom->op?
+                 (implies (vl-nonatom-p x)
+                          (and (symbolp (vl-nonatom->finaltype x))
+                               (not (equal (vl-nonatom->finaltype x) t))))))))
 
   :rest
   ((defthm acl2-count-of-vl-nonatom->args
@@ -835,7 +838,6 @@
 
 
 
-
 (defsection vl-expr-p
   :parents (modules)
   :short "Representation of Verilog expressions."
@@ -882,7 +884,7 @@
 
 <ul>
 
-<li>@('finalwidth'), which is a @(see vl-maybe-natp-p), and</li>
+<li>@('finalwidth'), which is a @(see vl-maybe-natp), and</li>
 
 <li>@('finaltype'), which is a @(see vl-maybe-exprtype-p).</li>
 
@@ -1032,7 +1034,7 @@
   :parents (vl-expr-p)
   :short "Get the @('finalwidth') from an expression."
   :long "<p>See @(see vl-expr-p) for a discussion of widths.  The result is a
-@(see vl-maybe-exprwidth-p).</p>"
+@(see vl-maybe-natp).</p>"
   (if (eq (tag x) :vl-atom)
       (vl-atom->finalwidth x)
     (vl-nonatom->finalwidth x))
@@ -1128,7 +1130,7 @@
 version\" of the expression before simplification has taken place.</dd>
 
 <dd>@('VL_ZERO_EXTENSION') is added when we create certain zero-extension
-expressions, mainly to pad operands during @(see ctxsize).</dd>
+expressions, mainly to pad operands during @(see expression-sizing).</dd>
 
 
 <dt>Net Declarations</dt>
@@ -1139,7 +1141,7 @@
 
 <dd>@('VL_PORT_IMPLICIT'), with no value, is given to wires that are declared
 to be ports (i.e., @('input a;')) but which are not also declared to be
-wires (i.e., @('wire a;')) by @(see make-port-wires)</dd>
+wires (i.e., @('wire a;')) by @(see make-implicit-wires)</dd>
 
 <dd>@('VL_UNUSED') and @('VL_MAYBE_UNUSED') may be added by @(see use-set) when
 a wire appears to be unused.</dd>
@@ -1453,14 +1455,14 @@
 
 
 (defaggregate vl-range
-  (msb lsb)
-  :tag :vl-range
-  :legiblep nil
-  :require ((vl-expr-p-of-vl-range->msb (vl-expr-p msb))
-            (vl-expr-p-of-vl-range->lsb (vl-expr-p lsb)))
   :parents (modules)
   :short "Representation of ranges on wire declarations, instance array
 declarations, and so forth."
+  :tag :vl-range
+  :legiblep nil
+
+  ((msb vl-expr-p)
+   (lsb vl-expr-p))
 
   :long "<p>Ranges are discussed in Section 7.1.5.</p>
 
@@ -1522,33 +1524,35 @@
   :parents (modules))
 
 
-
 (defaggregate vl-port
-  (name expr loc)
-  :tag :vl-port
-  :require ((vl-maybe-string-p-of-vl-port->name
-             (vl-maybe-string-p name)
-             :rule-classes
-             ((:type-prescription)
-              (:rewrite :corollary
-                        ;; BOZO horrible gross stupid hack because type rule isn't forcing
-                        (implies (force (vl-port-p x))
-                                 (equal (stringp (vl-port->name x))
-                                        (if (vl-port->name x)
-                                            t
-                                          nil))))))
-            (vl-maybe-expr-p-of-vl-port->expr
-             (vl-maybe-expr-p expr))
-            (vl-location-p-of-vl-port->loc
-             (vl-location-p loc)))
-  :legiblep nil
   :parents (modules)
   :short "Representation of a single Verilog port."
+  :tag :vl-port
+  :legiblep nil
+
+  ((name vl-maybe-string-p
+         :rule-classes
+         ((:type-prescription)
+          (:rewrite :corollary
+                    ;; BOZO horrible gross stupid hack because type rule isn't forcing
+                    (implies (force (vl-port-p x))
+                             (equal (stringp (vl-port->name x))
+                                    (if (vl-port->name x)
+                                        t
+                                      nil)))))
+         "The \"externally visible\" name of this port, for use in named module
+          instances.  Usually it is best to avoid this; see below.")
+
+   (expr vl-maybe-expr-p
+         "How the port is wired internally within the module.  Most of the time,
+          this is a simple identifier expression that is just @('name').  But
+          it can also be more complex; see below.")
 
-  :long "<h3>Introduction to Ports</h3>
+   (loc  vl-location-p
+         "Where this port came from in the Verilog source code."))
 
-<p>Ports are described in Section 12.3 of the standard.  In simple cases, a
-module's ports look like this:</p>
+  :long "<p>Ports are described in Section 12.3 of the standard.  In simple
+cases, a module's ports look like this:</p>
 
 @({
 module mod(a,b,c) ;  <-- ports are a, b, and c
@@ -1580,33 +1584,20 @@
 endmodule
 })
 
-
-<h3>Representation of Ports</h3>
-
-<p>The @('name') of every port is a @(see vl-maybe-string-p).  We think of this
-name as the \"externally visible\" name of the port.</p>
-
-<p>The @('expr') of every port is a @(see vl-maybe-expr-p) that determines how
-the port is wired internally within the module.</p>
-
-<p>The @('loc') for each port is a @(see vl-location-p) that says where the
-port came from in the Verilog source code.</p>
-
-<p>For instance, in the \"complex\" example above, the names of the ports would
-be represented, respectively, as: @('\"a\"'), @('\"b\"'), @('nil') (i.e., this
-port has no externally visible name), and @('\"d\"').  Meanwhile, the first two
-ports are internally wired to @('a') and @('w'), respectively, while the third
-and fourth ports collectively specify the bits of @('c').</p>
-
+<p>In this example, the @('name')s of these ports would be, respectively:
+@('\"a\"'), @('\"b\"'), @('nil') (because this port has no externally visible
+name), and @('\"d\"').  Meanwhile, the first two ports are internally wired to
+@('a') and @('w'), respectively, while the third and fourth ports collectively
+specify the bits of @('c').</p>
 
 <h3>Using Ports</h3>
 
 <p>It is generally best to <b>avoid using port names</b> except perhaps for
 things like error messages.  Why?  As shown above, some ports might not have
 names, and even when a port does have a name, it does not necessarily
-correspond to any wires in the module.  Since these cases are exotic, code
+correspond to any wires in the module.  But these cases are exotic, so code
 based on port names is likely to work for simple test cases and then fail later
-when more complex examples are encountered.</p>
+when more complex examples are encountered!</p>
 
 <p>Usually you should not need to deal with port names.  The @(see argresolve)
 transform converts module instances that use named arguments into their plain
@@ -1632,8 +1623,8 @@
 implement a comprehensive approach to detecting and dealing with backflow.</p>
 
 <p>The width of a port can be determined after expression sizing has been
-performed by examining the width of the port expression.  See @(see selfsize)
-and @(see ctxsize) for details.</p>")
+performed by examining the width of the port expression.  See @(see
+expression-sizing) for details.</p>")
 
 (deflist vl-portlist-p (x)
   (vl-port-p x)
@@ -1701,28 +1692,47 @@
 
 
 (defaggregate vl-portdecl
-  (name dir signedp range loc atts)
-  :tag :vl-portdecl
-  :legiblep nil
-  :require ((stringp-of-vl-portdecl->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (vl-direction-p-of-vl-portdecl->dir
-             (vl-direction-p dir))
-            (booleanp-of-vl-portdecl->signedp
-             (booleanp signedp)
-             :rule-classes :type-prescription)
-            (vl-maybe-range-p-of-vl-portdecl->range
-             (vl-maybe-range-p range))
-            (vl-location-p-vl-portdecl->loc
-             (vl-location-p loc))
-            (vl-atts-p-of-vl-portdecl->atts
-             (vl-atts-p atts)))
   :parents (modules)
   :short "Representation of Verilog port declarations."
+  :tag :vl-portdecl
+  :legiblep nil
 
-  :long "<p>Port declarations ascribe certain properties (direction,
-signedness, size, and so on) to the ports of a module.  Here is an example:</p>
+  ((name     stringp
+             :rule-classes :type-prescription
+             "An ordinary string that should agree with some identifier used in
+              the \"internal\" wiring expressions from some port(s) in the
+              module.")
+
+   (dir      vl-direction-p
+             "Says whether this port is an input, output, or bidirectional
+              (inout) port.")
+
+   (signedp  booleanp
+             :rule-classes :type-prescription
+             "Whether the @('signed') keyword was present in the declaration;
+              but <b>warning</b>: per page 175, port declarations and net/reg
+              declarations must be checked against one another: if either
+              declaration includes the @('signed') keyword, then both are to be
+              considered signed.  The @(see loader) DOES NOT do this
+              cross-referencing automatically; instead the @(see portdecl-sign)
+              transformation needs to be run.")
+
+   (range    vl-maybe-range-p
+             "Indicates whether the input is a vector and, if so, how large the
+              input is.  Per page 174, if there is also a net declaration, then
+              the range must agree.  This is checked in @(see
+              vl-overlap-compatible-p) as part of our notion of @(see
+              reasonable) modules.")
+
+   (atts     vl-atts-p
+             "Any attributes associated with this declaration.")
+
+   (loc      vl-location-p
+             "Where the port was declared in the source code."))
+
+  :long "<p>Port declarations, described in Section 12.3.3 of the
+specification, ascribe certain properties (direction, signedness, size, and so
+on) to the ports of a module.  Here is an example:</p>
 
 @({
 module m(a, b) ;
@@ -1736,35 +1746,6 @@
 separate @('vl-portdecl-p') objects for each port.  Because of this, every
 @('vl-portdecl-p') has only a single name.</p>
 
-<p>Port declarations are described in Section 12.3.3 of the specification.</p>
-
-<p>The @('name') of the port is an ordinary string, which should agree with the
-name of some port in the module.  (<b>BOZO</b> Is that the external or internal
-name?  Oh my God...)</p>
-
-<p>The @('direction') of the port is a @(see vl-direction-p) that says whether
-this port is an input, output, or bidirectional port.</p>
-
-<p>The @('signedp') flag indicates whether the @('signed') keyword was present
-in the declaration.</p>
-
-<p><b>Warning</b>: Note that per page 175, port declarations and net/reg
-declarations must be checked against one another: if either declaration
-includes the @('signed') keyword, then both are to be considered signed.  The
-parser DOES NOT do this cross-referencing automatically; instead the @(see
-portdecl-sign) transformation needs to be run.</p>
-
-<p>The @('range') indicates how whether the input is a vector and, if so, how
-large the input is.  Per page 174, if there is also a net declaration then the
-range must agree.  This is checked in @(see vl-overlap-compatible-p) as part of
-our notion of @(see reasonable) modules.</p>
-
-<p>The @('loc') is a @(see vl-location-p) that describes where the port was
-declared in the source code.</p>
-
-<p>The @('atts') are any attribute (see @(see vl-atts-p)) associated with this
-declaration.</p>
-
 <h4>A Note about Port Types</h4>
 
 <p>If you look at the grammar for port declarations, you will see that you
@@ -1790,20 +1771,25 @@
 
 
 (defaggregate vl-gatedelay
-  (rise fall high)
-  :tag :vl-gatedelay
-  :legiblep nil
-  :require ((vl-expr-p-of-vl-gatedelay->rise       (vl-expr-p rise))
-            (vl-expr-p-of-vl-gatedelay->fall       (vl-expr-p fall))
-            (vl-maybe-expr-p-of-vl-gatedelay->high (vl-maybe-expr-p high)))
   :parents (modules)
   :short "Representation of delay expressions."
+  :tag :vl-gatedelay
+  :legiblep nil
+
+  ((rise vl-expr-p
+         "Rising delay.")
+
+   (fall vl-expr-p
+         "Falling delay.")
+
+   (high vl-maybe-expr-p
+         "High-impedence delay or charge decay time." ))
 
   :long "<p><b>WARNING</b>.  We have not paid much attention to delays, and our
 transformations probably do not handle them properly.</p>
 
-<p>Delays are mainly discussed in 7.14 and 5.3, with some other
-discussion in 6.13 and the earlier parts of Section 7.  In short:</p>
+<p>Delays are mainly discussed in 7.14 and 5.3, with some other discussion in
+6.13 and the earlier parts of Section 7.  In short:</p>
 
 <ul>
 <li>A \"delay expression\" can be an arbitrary expression.  Of particular note,
@@ -1866,17 +1852,14 @@
 
 
 (defaggregate vl-gatestrength
-  (zero one)
-  :tag :vl-gatestrength
   :parents (modules)
-  :legiblep nil
-  :require ((vl-dstrength-p-of-vl-gatestrength->zero
-             (vl-dstrength-p zero))
-            (vl-dstrength-p-of-vl-gatestrength->one
-             (vl-dstrength-p one)))
-
   :short "Representation of strengths for a assignment statements, gate
 instances, and module instances."
+  :tag :vl-gatestrength
+  :legiblep nil
+
+  ((zero vl-dstrength-p "Drive strength toward logical zero.")
+   (one  vl-dstrength-p "Drive strength toward logical one."))
 
   :long "<p><b>WARNING</b>.  We have not paid much attention to strengths, and
 our transformations probably do not handle them properly.</p>
@@ -1957,23 +1940,19 @@
 
 
 (defaggregate vl-assign
-  (lvalue expr strength delay loc atts)
-  :tag :vl-assign
-  :legiblep nil
-  :require ((vl-expr-p-of-vl-assign->lvalue
-             (vl-expr-p lvalue))
-            (vl-expr-p-of-vl-assign->expr
-             (vl-expr-p expr))
-            (vl-maybe-gatedelay-p-of-vl-assign->delay
-             (vl-maybe-gatedelay-p delay))
-            (vl-maybe-gatestrength-p-of-vl-assign->strength
-             (vl-maybe-gatestrength-p strength))
-            (vl-location-p-of-vl-assign->loc
-             (vl-location-p loc))
-            (vl-atts-p-of-vl-assign->atts
-             (vl-atts-p atts)))
   :parents (modules)
   :short "Representation of a continuous assignment statement."
+  :tag :vl-assign
+  :legiblep nil
+
+  ((lvalue   vl-expr-p "The location being assigned to.")
+   (expr     vl-expr-p "The right-hand side.")
+   (strength vl-maybe-gatestrength-p)
+   (delay    vl-maybe-gatedelay-p)
+   (atts     vl-atts-p
+             "Any attributes associated with this assignment.")
+   (loc      vl-location-p
+             "Where the assignment was found in the source code."))
 
   :long "<p>In the Verilog sources, continuous assignment statements can take
 two forms, as illustrated below.</p>
@@ -2067,16 +2046,7 @@
 
 <p><b>Warning:</b> Although the parser is careful to handle the strength
 correctly, we are generally uninterested in strengths and our transforms may not
-properly preserve them.</p>
-
-<h4>Loc, Atts</h4>
-
-<p>The @('loc') is the location of this continuous assignment in the source
-code, and is useful for producing error messages; see @(see vl-location-p).</p>
-
-<p>The @('atts') are any Verilog-2005 style attributes associated with this
-assignment; see @(see vl-atts-p).  We mostly ignore attributes, but we may
-sometimes add them as annotations.</p>")
+properly preserve them.</p>")
 
 (deflist vl-assignlist-p (x)
   (vl-assign-p x)
@@ -2146,37 +2116,48 @@
 
 
 (defaggregate vl-netdecl
-  (name type range arrdims atts vectoredp scalaredp signedp delay cstrength loc)
-  :tag :vl-netdecl
-  :legiblep nil
-  :require ((stringp-of-vl-netdecl->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (vl-netdecltype-p-of-vl-netdecl->type
-             (vl-netdecltype-p type))
-            (vl-maybe-range-p-of-vl-netdecl->range
-             (vl-maybe-range-p range))
-            (vl-rangelist-p-of-vl-netdecl->arrdims
-             (vl-rangelist-p arrdims))
-            (vl-atts-p-of-vl-netdecl->atts
-             (vl-atts-p atts))
-            (booleanp-of-vl-netdecl->vectoredp
-             (booleanp vectoredp)
-             :rule-classes :type-prescription)
-            (booleanp-of-vl-netdecl->scalaredp
-             (booleanp scalaredp)
-             :rule-classes :type-prescription)
-            (booleanp-of-vl-netdecl->signedp
-             (booleanp signedp)
-             :rule-classes :type-prescription)
-            (vl-maybe-gatedelay-p-of-vl-netdecl->delay
-             (vl-maybe-gatedelay-p delay))
-            (vl-maybe-cstrength-p-of-vl-netdecl->cstrength
-             (vl-maybe-cstrength-p cstrength))
-            (vl-location-p-of-vl-netdecl->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of net (wire) declarations."
+  :tag :vl-netdecl
+  :legiblep nil
+  ((name       stringp
+               :rule-classes :type-prescription
+               "Name of the wire being declared.")
+
+   (type       vl-netdecltype-p
+               "Wire type, e.g., @('wire'), @('supply1'), etc.")
+
+   (range      vl-maybe-range-p
+               "A single, optional range that preceeds the wire name; this
+                ordinarily governs the \"size\" of a wire.")
+
+   (arrdims    vl-rangelist-p
+               "Used for arrays like memories; see below.")
+
+   (vectoredp  booleanp
+               :rule-classes :type-prescription
+               "True if the @('vectored') keyword was explicitly provided.")
+
+   (scalaredp  booleanp
+               :rule-classes :type-prescription
+               "True if the @('scalared') keyword was explicitly provided.")
+
+   (signedp    booleanp
+               :rule-classes :type-prescription
+               "Indicates whether the @('signed') keyword was supplied on this
+                declaration.  But <b>warning</b>: per page 175, port
+                declarations and net/reg declarations must be checked against
+                one another: if either declaration includes the @('signed')
+                keyword, then both are to be considered signed.  The parser
+                DOES NOT do this cross-referencing automatically; instead the
+                @(see portdecl-sign) transformation needs to be run.")
+
+   (delay      vl-maybe-gatedelay-p)
+   (cstrength  vl-maybe-cstrength-p)
+   (atts       vl-atts-p
+               "Any attributes associated with this declaration.")
+   (loc        vl-location-p
+               "Where the declaration was found in the source code."))
 
   :long "<p>Net declarations introduce new wires with certain properties (type,
 signedness, size, and so on).  Here are some examples of basic net
@@ -2214,24 +2195,19 @@
 and truly only represents a declaration.</p>
 
 
-<h4>Basic Fields</h4>
-
-<p>The @('name'), @('type'), @('atts'), and @('loc') fields should be
-self-explanatory after reading the descriptions of @(see vl-netdecltype-p),
-@(see vl-atts-p), and @(see vl-location-p).</p>
+<h4>Arrays</h4>
 
-
-<h4>Arrays and Vectors</h4>
-
-<p>The @('range') and @('arrdims') fields deal with vectors and arrays.  In
-particular, @('range') is a single, optional range that preceeds the wire name.
-For instance, the range of @('w') is @('[4:0]') in the following
-declaration:</p>
+<p>The @('arrdims') fields is for arrays.  Normally, you do not encounter
+these.  For instance, a wide wire declaration like this is <b>not</b> an
+array:</p>
 
 @({
   wire [4:0] w;
 })
 
+<p>Instead, the @('[4:0]') part here is the @('range') of the wire and its
+@('arrdims') are just @('nil').</p>
+
 <p>In contrast, the @('arrdims') are a list of ranges, also optional, which
 follow the wire name.  For instance, the arrdims of @('v') below is a singleton
 list with the range @('[4:0]').</p>
@@ -2252,7 +2228,7 @@
 wire [4:0] a [10:0];
 })
 
-<p>declares @('a') to be an 11-element array of five bit wires.  The @('range')
+<p>declares @('a') to be an 11-element array of five-bit wires.  The @('range')
 for @('a') is @('[4:0]'), and the arrdims are a list with one entry, namely the
 range @('[10:0]').</p>
 
@@ -2262,23 +2238,18 @@
 
 <h4>Vectorness and Signedness</h4>
 
-<p>The @('signedp') flag indicates whether the @('signed') keyword was supplied
-on this declaration.  <b>Warning</b>: Note that per page 175, port declarations
-and net/reg declarations must be checked against one another: if either
-declaration includes the @('signed') keyword, then both are to be considered
-signed.  The parser DOES NOT do this cross-referencing automatically; instead
-the @(see portdecl-sign) transformation needs to be run.</p>
-
-<p>The @('vectoredp') and @('scalaredp') fields are booleans, which are set to
-@('t') when, respectively, the Verilog keywords @('vectored') and @('scalared')
-are provided.  In other words, these fields might both be @('nil').  I do not
-know what these keywords are supposed to mean; the Verilog specification says
-almost nothing about it, and does not even say what the default is.  According
-to some random guy on the internet, it's supposed to be a syntax error to try
-to bit- or part-select from a vectored net.  Maybe I can find a more definitive
-explanation somewhere.  Hey, in 6.1.3 there are some differences mentioned
-w.r.t. how delays go to scalared and vectored nets.  4.3.2 has a little bit
-more.</p>
+<p>These are only set to @('t') when the keywords @('vectored') or
+@('scalared') are explicitly provided; i.e., they may both be @('nil').</p>
+
+<p>I do not know what these keywords are supposed to mean; the Verilog
+specification says almost nothing about it, and does not even say what the
+default is.</p>
+
+<p>According to some random guy on the internet, it's supposed to be a syntax
+error to try to bit- or part-select from a vectored net.  Maybe I can find a
+more definitive explanation somewhere.  Hey, in 6.1.3 there are some
+differences mentioned w.r.t. how delays go to scalared and vectored nets.
+4.3.2 has a little bit more.</p>
 
 
 <h4>Delay</h4>
@@ -2329,27 +2300,36 @@
 
 
 (defaggregate vl-plainarg
-  (expr atts portname dir)
-  :tag :vl-plainarg
-  :legiblep nil
-  :require
-  ((vl-maybe-expr-p-of-vl-plainarg->expr
-    (vl-maybe-expr-p expr))
-   (vl-atts-p-of-vl-plainarg->atts
-    (vl-atts-p atts))
-   (vl-maybe-string-p-of-vl-plainarg->portname
-    (vl-maybe-string-p portname)
-    :rule-classes ((:type-prescription)
-                   (:rewrite
-                    :corollary (implies (force (vl-plainarg-p x))
-                                        (equal (stringp (vl-plainarg->portname x))
-                                               (if (vl-plainarg->portname x)
-                                                   t
-                                                 nil))))))
-   (vl-maybe-direction-p-of-vl-plainarg->dir
-    (vl-maybe-direction-p dir)))
   :parents (modules vl-arguments-p)
   :short "Representation of a single argument in a plain argument list."
+  :tag :vl-plainarg
+  :legiblep nil
+
+  ((expr     vl-maybe-expr-p
+             "Expression being connected to the port.  In programming languages
+              parlance, this is the <i>actual</i>.  Note that this may be
+              @('nil') because Verilog allows expressions to be \"blank\", in
+              which case they represent an unconnected wire.")
+
+   (portname vl-maybe-string-p
+             :rule-classes
+             ((:type-prescription)
+              (:rewrite
+               :corollary (implies (force (vl-plainarg-p x))
+                                   (equal (stringp (vl-plainarg->portname x))
+                                          (if (vl-plainarg->portname x)
+                                              t
+                                            nil)))))
+             "Not part of the Verilog syntax.  This <b>may</b> indicate the
+              name of the port (i.e., the <i>formal</i>) that this expression
+              is connected to; see below.")
+
+   (dir      vl-maybe-direction-p
+             "Not part of the Verilog syntax.  This <b>may</b> indicate the
+              direction of this port; see below.")
+
+   (atts     vl-atts-p
+             "Any attributes associated with this argument."))
 
   :long "<p>There are two kinds of argument lists for module instantiations,
 which we call <i>plain</i> and <i>named</i> arguments.</p>
@@ -2362,35 +2342,24 @@
 <p>A @('vl-plainarg-p') represents a single argument in a plain argument
 list.</p>
 
-<p>The @('expr') is the expression being connected to this port; in programming
-languages parlance, the @('expr') is an <i>actual</i>.  Note that @('expr') is
-only a @(see vl-maybe-expr-p), and may be @('nil').  This is because Verilog
-allows expressions to be \"blank\", in which case they represent an unconnected
-wire.  This seems to be used only very rarely, but is supported.</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with this
-argument.</p>
-
-<p>The @('dir') is an @(see vl-maybe-direction-p) object.  This is <b>not</b>
-part of the Verilog syntax, but may sometimes be added by the @(see argresolve)
-transformation to indicate whether this port for this argument is an input,
-output, or inout for the module or gate being instantiated.</p>
-
-<p>Note that after @(see argresolve), all well-formed gate instances will have
-their direction information computed.  You may rely upon the @('dir') field for
-gate instances.</p>
-
-<p>However, for module instances the direction of a port may not be apparent;
-see @(see vl-port-direction) for details.  So even after @(see argresolve) some
-arguments to module instances may not have a @('dir') annotation, and so the
-@('dir') field should generally not be relied upon for module instances.</p>
-
-<p>The @('portname') is also not part of the Verilog syntax, but may sometimes
-be added by the @(see argresolve) transformation as a convenience for error
-message generation.  This field should <b>never</b> be used for anything that
-is semantically important.  Note that no argument to a gate instance will ever
-have a portname.  Also note that since not every @(see vl-port-p) has a name,
-some arguments to module instances may also not be given portnames.</p>")
+<p>The @('dir') is initially @('nil') but may get filled in by the @(see
+argresolve) transformation to indicate whether this port for this argument is
+an input, output, or inout for the module or gate being instantiated.  After
+@(see argresolve), all well-formed <b>gate</b> instances will have their
+direction information computed and so you may rely upon the @('dir') field for
+gate instances.  <b>HOWEVER</b>, for <b>module</b> instances the direction of a
+port may not be apparent; see @(see vl-port-direction) for details.  So even
+after @(see argresolve) some arguments to module instances may not have a
+@('dir') annotation, and you should generally not rely on the @('dir') field
+for module instances.</p>
+
+<p>The @('portname') is similar.  The @(see argresolve) transformation may
+sometimes be able to fill in the name of the port, but this is meant only as a
+convenience for error message generation.  This field should <b>never</b> be
+used for anything that is semantically important.  No argument to a gate
+instance will ever have a portname.  Also, since not every @(see vl-port-p) has
+a name, some arguments to module instances may also not be given
+portnames.</p>")
 
 (deflist vl-plainarglist-p (x)
   (vl-plainarg-p x)
@@ -2429,34 +2398,26 @@
 
 
 (defaggregate vl-namedarg
-  (name expr atts)
-  :tag :vl-namedarg
-  :legiblep nil
-  :require ((stringp-of-vl-namedarg->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (vl-maybe-expr-p-of-vl-namedarg->expr
-             (vl-maybe-expr-p expr))
-            (vl-atts-p-of-vl-namedarg->atts
-             (vl-atts-p atts)))
   :parents (modules)
   :short "Representation of a single argument in a named argument list."
+  :tag :vl-namedarg
+  :legiblep nil
 
-  :long "<p>See @(see vl-plainarg-p) for a general discussion of arguments.
-Each @('vl-namedarg-p') represents a single argument in a named argument list.
-Its fields include:</p>
-
-<ul>
-
-<li>@('name'), a string, e.g., @('foo') in @('.foo(3)'),</li>
-
-<li>@('expr'), a @(see vl-maybe-expr-p) which is the actual for this port, and
-may be @('nil') for blank ports as described in @(see vl-plainarg-p), and</li>
+  ((name stringp
+         :rule-classes :type-prescription
+         "Name of the port being connected to, e.g., @('foo') in
+          @('.foo(3)')")
+
+   (expr vl-maybe-expr-p
+         "The <i>actual</i> being connected to this port; may be
+          @('nil') for blank ports.")
 
-<li>@('atts'), any attributes (see @(see vl-atts-p)) associated with this
-argument.</li>
+   (atts vl-atts-p
+         "Any attributes associated with this argument."))
 
-</ul>
+  :long "<p>See @(see vl-plainarg-p) for a general discussion of arguments.
+Each @('vl-namedarg-p') represents a single argument in a named argument
+list.</p>
 
 <p>Unlike plain arguments, our named arguments do not have a direction field.
 Our basic transformation strategy is to quickly eliminate named arguments and
@@ -2594,38 +2555,54 @@
 
 
 (defaggregate vl-modinst
-  (instname modname range paramargs portargs str delay atts loc)
-  :tag :vl-modinst
-  :legiblep nil
-  :require ((vl-maybe-string-p-of-vl-modinst->instname
-             (vl-maybe-string-p instname)
-             :rule-classes ((:type-prescription)
-                            (:rewrite :corollary
-                                      (implies (force (vl-modinst-p x))
-                                               (equal (stringp (vl-modinst->instname x))
-                                                      (if (vl-modinst->instname x)
-                                                          t
-                                                        nil))))))
-            (stringp-of-vl-modinst->modname
-             (stringp modname)
-             :rule-classes :type-prescription)
-            (vl-maybe-range-p-of-vl-modinst->range
-             (vl-maybe-range-p range))
-            (vl-arguments-p-of-vl-modinst->paramargs
-             (vl-arguments-p paramargs))
-            (vl-arguments-p-of-vl-modinst->portargs
-             (vl-arguments-p portargs))
-            (vl-maybe-gatestrength-p-of-vl-modinst->str
-             (vl-maybe-gatestrength-p str))
-            (vl-maybe-gatedelay-p-of-vl-modinst->delay
-             (vl-maybe-gatedelay-p delay))
-            (vl-atts-p-of-vl-modinst->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-modinst->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a single module (or user-defined primitive)
 instance."
+  :tag :vl-modinst
+  :legiblep nil
+
+  ((instname  vl-maybe-string-p
+              :rule-classes
+              ((:type-prescription)
+               (:rewrite :corollary
+                         (implies (force (vl-modinst-p x))
+                                  (equal (stringp (vl-modinst->instname x))
+                                         (if (vl-modinst->instname x)
+                                             t
+                                           nil)))))
+              "Either the name of this instance or @('nil') if the instance has
+               no name.  See also the @(see addinstnames) transform.")
+
+   (modname   stringp
+              :rule-classes :type-prescription
+              "Name of the module or user-defined primitive that is being
+               instantiated.")
+
+   (range     vl-maybe-range-p
+              "When present, indicates that this is an array of instances,
+               instead of a single instance.")
+
+   (paramargs vl-arguments-p
+              "Values to use for module parameters, e.g., this might specify
+               the width to use for an adder module, etc.")
+
+   (portargs  vl-arguments-p
+              "Connections to use for the submodule's input, output, and inout
+               ports.")
+
+   (str       vl-maybe-gatestrength-p
+              "Strength for user-defined primitive instances.  Does not make
+               sense for module instances.  VL mostly ignores this.")
+
+   (delay     vl-maybe-gatedelay-p
+              "Delay for user-defined primitive instances.  Does not make sense
+               for module instances.  VL mostly ignores this.")
+
+   (atts      vl-atts-p
+              "Any attributes associated with this instance.")
+
+   (loc       vl-location-p
+              "Where the instance was found in the source code."))
 
   :long "<p>We represent module and user-defined primitive instances in a
 uniform manner with @('vl-modinst-p') structures.  Because of this, certain
@@ -2638,33 +2615,7 @@
 <p>As with variables, nets, etc., we split up combined instantiations such as
 @('modname inst1 (...), inst2 (...)') into separate, individual structures, one
 for @('inst1'), and one for @('inst2'), so that each @('vl-modinst-p')
-represents exactly one instance (or instance array).</p>
-
-<p>The @('modname') is the name of the module or user-defined primitive that is
-being instantiated, and @('instname') is either the name of this instance or
-@('nil') if the instance has no name.</p>
-
-<p>If present, the @('range') indicates that this is an array of instances,
-instead of a single instance.</p>
-
-<p>The @('paramargs') field is a @(see vl-arguments-p) that gives the values
-for the module parameters.  (E.g., in an instance of a parameterized adder
-module, this list might include the @('width') of the adder being
-instantiated.)</p>
-
-<p>The @('portargs') field is a @(see vl-arguments-p) that gives the values for
-the module's ports.  (E.g., in an instance of an adder module, this list would
-contain the expressions for the inputs and outputs.)</p>
-
-<p>The @('gatestrength') and @('gatedelay') should only be used for
-user-defined primitives.  <b>Warning:</b> we have generally ignored these
-fields and our transforms may not handle them correctly.</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with this
-module instance.</p>
-
-<p>The @('loc') is a @(see vl-location-p) that says where in the source code
-this module instance was introduced, and is useful for error messages.</p>")
+represents exactly one instance (or instance array).</p>")
 
 (deflist vl-modinstlist-p (x)
   (vl-modinst-p x)
@@ -2705,34 +2656,68 @@
 recognized by @(call vl-gatetype-p).</p>")
 
 (defaggregate vl-gateinst
-  (type name range strength delay args atts loc)
-  :tag :vl-gateinst
-  :legiblep nil
-  :require ((vl-gatetype-p-of-vl-gateinst->type
-             (vl-gatetype-p type))
-            (vl-maybe-string-p-of-vl-gateinst->name
-             (vl-maybe-string-p name)
-             :rule-classes ((:type-prescription)
-                            (:rewrite :corollary
-                                      (implies (force (vl-gateinst-p x))
-                                               (equal (stringp (vl-gateinst->name x))
-                                                      (if (vl-gateinst->name x)
-                                                          t
-                                                        nil))))))
-            (vl-maybe-range-p-of-vl-gateinst->range
-             (vl-maybe-range-p range))
-            (vl-maybe-gatestrength-p-of-vl-gateinst->strength
-             (vl-maybe-gatestrength-p strength))
-            (vl-maybe-gatedelay-p-of-vl-gateinst->delay
-             (vl-maybe-gatedelay-p delay))
-            (vl-plainarglist-p-of-vl-gateinst->args
-             (vl-plainarglist-p args))
-            (vl-atts-p-of-vl-gateinst->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-gateinst->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a single gate instantiation."
+  :tag :vl-gateinst
+  :legiblep nil
+  ((type     vl-gatetype-p
+             "What kind of gate this is, e.g., @('and'), @('xor'), @('rnmos'),
+              etc."
+             :rule-classes
+             ((:rewrite)
+              (:type-prescription
+               :corollary
+               ;; BOZO may not want to force this
+               (implies (force (vl-gateinst-p x))
+                        (and (symbolp (vl-gateinst->type x))
+                             (not (equal (vl-gateinst->type x) t))
+                             (not (equal (vl-gateinst->type x) nil)))))))
+
+   (name     vl-maybe-string-p
+             :rule-classes
+             ((:type-prescription)
+              (:rewrite :corollary
+                        (implies (force (vl-gateinst-p x))
+                                 (equal (stringp (vl-gateinst->name x))
+                                        (if (vl-gateinst->name x)
+                                            t
+                                          nil)))))
+             "The name of this gate instance, or @('nil') if it has no name;
+              see also the @(see addinstnames) transform.")
+
+   (range    vl-maybe-range-p
+             "When present, indicates that this is an array of instances
+              instead of a single instance.")
+
+   (strength vl-maybe-gatestrength-p
+             "The parser leaves this as @('nil') unless it is explicitly provided.
+              Note from Section 7.8 that pullup and pulldown gates are special
+              in that the strength0 from a pullup source and the strength1 on a
+              pulldown source are supposed to be ignored.  <b>Warning:</b> in
+              general we have not paid much attention to strengths, so we may
+              not handle them correctly in our various transforms.")
+
+   (delay    vl-maybe-gatedelay-p
+             "The parser leaves this as @('nil') unless it is explicitly provided.
+              Certain gates (tran, rtran, pullup, and pulldown) never have
+              delays according to the Verilog grammar, but this is only
+              enforced by the parser, and is not part of our @('vl-gateinst-p')
+              definition.  <b>Warning:</b> as with strengths, we have not paid
+              much attention to delays, and our transforms may not handle them
+              correctly.")
+
+   (args     vl-plainarglist-p
+             "Arguments to the gate instance.  Note that this differs from
+              module instances where @(see vl-arguments-p) structures are used,
+              because gate arguments are never named.  The grammar restricts
+              how many arguments certain gates can have, but we do not enforce
+              these restrictions in the definition of @('vl-gateinst-p').")
+
+   (atts     vl-atts-p
+             "Any attributes associated with this gate instance.")
+
+   (loc      vl-location-p
+             "Where the gate instance was found in the source code."))
 
   :long "<p>@('vl-gateinst-p') is our representation for any single gate
 instance (or instance array).</p>
@@ -2742,53 +2727,7 @@
 Verilog grammar restricts the list of expressions in certain cases, e.g., for
 an @('and') gate, the first expression must be an lvalue.  Although our parser
 enforces these restrictions, we do not encode them into the definition of
-@('vl-gateinst-p').</p>
-
-<p>The @('type') of the gate is an @(see vl-gatetype-p) and says what kind of
-gate this is, (e.g., rmos, nand, xor, ...).</p>
-
-<p>The @('name') may be a string that names this instance, or may be @('nil')
-when the instance has no name.</p>
-
-<p>If provided, the @('range') indicates that this is an array of instances
-instead of a single instance.</p>
-
-<p>The @('strength') is represented by a @(see vl-maybe-gatestrength-p).  The
-parser leaves this as @('nil') unless it is explicitly provided.  Note from
-Section 7.8 that pullup and pulldown gates are special in that the strength0
-from a pullup source and the strength1 on a pulldown source are supposed to be
-ignored.  <b>Warning:</b> in general we have not paid much attention to
-strengths, so we may not handle them correctly in our various transforms.</p>
-
-<p>The @('delay') is represented by a @(see vl-maybe-gatedelay-p), and is also
-left as @('nil') unless it is explicitly provided.  Note that certain
-gates (tran, rtran, pullup, and pulldown) never have delays according to the
-Verilog grammar, but this is not enforced in our @('vl-gateinst-p') definition,
-only by the parser.  <b>Warning:</b> as with strengths, we have not paid much
-attention to delays, and our transforms may not handle them correctly.</p>
-
-<p>The @('args') are a list of @(see vl-plainarg-p) structures.  Note that this
-differs from module instances where @(see vl-arguments-p) structures are used,
-because gate arguments are never named.  The grammar restricts how many
-arguments certain gates can have, but we do not enforce these restrictions in
-the definition of @('vl-gateinst-p').</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with this
-module instance.</p>
-
-<p>The @('loc') is a @(see vl-location-p) that says where in the source code
-this module instance was introduced, and is useful for error messages.</p>"
-
-  :rest
-  ((defthm symbolp-of-vl-gateinst->type
-     (implies (force (vl-gateinst-p x))
-              (and (symbolp (vl-gateinst->type x))
-                   (not (equal (vl-gateinst->type x) t))
-                   (not (equal (vl-gateinst->type x) nil))))
-     :hints(("Goal"
-             :use ((:instance vl-gatetype-p-of-vl-gateinst->type))
-             :in-theory (e/d (vl-gatetype-p)
-                             (vl-gatetype-p-of-vl-gateinst->type)))))))
+@('vl-gateinst-p').</p>")
 
 (deflist vl-gateinstlist-p (x)
   (vl-gateinst-p x)
@@ -2810,117 +2749,104 @@
 <p><b>BOZO</b> consider consolidating variable and register declarations into a
 single parse tree element by adding an extra reg type to vl-vardecl-p.</p>")
 
+
 (defaggregate vl-vardecl
-  (name type arrdims initval atts loc)
-  :tag :vl-vardecl
-  :legiblep nil
-  :require ((stringp-of-vl-vardecl->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (vl-vardecltype-p-of-vl-vardecl->type
-             (vl-vardecltype-p type))
-            (vl-rangelist-p-of-vl-vardecl->arrdims
-             (vl-rangelist-p arrdims))
-            (vl-maybe-expr-p-of-vl-vardecl->initval
-             (vl-maybe-expr-p initval))
-            (vl-atts-p-of-vl-vardecl->atts
-             (vl-atts-p atts))
-            (vl-location-p-vl-vardecl->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a single variable declaration."
-  :long "<p>@('vl-vardecl-p') is our representation for a single variable
-declaration, and is used for @('integer'), @('real'), @('time'), and
-@('realtime') variable declarations.  As with nets and ports, our parser splits
-up combined declarations such as \"integer a, b\" into multiple, individual
-declarations, so each @('vl-vardecl-p') represents only one declaration.</p>
-
-<p>The @('name') is an ordinary ACL2 string which contains the name of this
-variable.</p>
-
-<p>The @('type') is a @(see vl-vardecltype-p) that says whether this is an
-integer, real, time, or realtime variable.</p>
-
-<p>The @('arrdims') are a list of @(see vl-range-p) objects that give the
-dimensions for arrays of variables.</p>
-
-<p>The @('initval') is used when the declaration inclues an initial value for
-the variable, e.g., if one writes @('integer i = 3;'), then the @('initval')
-will be a @(see vl-expr-p) that represents @('3').</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with this
-declaration.</p>
-
-<p>The @('loc') is a @(see vl-location-p) that identifies where this
-declaration comes from in the source code.</p>")
+  :tag :vl-vardecl
+  :legiblep nil
 
+  ((name    stringp
+            :rule-classes :type-prescription
+            "Name of the variable being declared.")
+
+   (type    vl-vardecltype-p
+            "Kind of variable, e.g., integer, real, etc.")
+
+   (arrdims vl-rangelist-p
+            "A list of array dimensions; empty unless this is an array or
+             multi-dimensional array of variables.")
+
+   (initval vl-maybe-expr-p
+            ;; BOZO eliminate initval and replace with an initial statement.
+            ;; Update the docs for vl-initial-p and also below when this is
+            ;; done.
+            "When present, indicates the initial value for the variable, e.g.,
+             if one writes @('integer i = 3;'), then the @('initval') will be
+             the @(see vl-expr-p) for @('3').")
+
+   (atts    vl-atts-p
+            "Any attributes associated with this declaration.")
+
+   (loc     vl-location-p
+            "Where the declaration was found in the source code."))
+
+  :long "<p>We use @('vl-vardecl-p')s to represent @('integer'), @('real'),
+@('time'), and @('realtime') variable declarations.  As with nets and ports,
+our parser splits up combined declarations such as \"integer a, b\" into
+multiple, individual declarations, so each @('vl-vardecl-p') represents only
+one declaration.</p>")
 
 
 (defaggregate vl-regdecl
-  (name signedp range arrdims initval atts loc)
-  :tag :vl-regdecl
-  :legiblep nil
-  :require ((stringp-of-vl-regdecl->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (booleanp-of-vl-regdecl->signedp
-             (booleanp signedp)
-             :rule-classes :type-prescription)
-            (vl-maybe-range-p-of-vl-regdecl->range
-             (vl-maybe-range-p range))
-            (vl-rangelist-p-of-vl-regdecl->arrdims
-             (vl-rangelist-p arrdims))
-
-; BOZO eliminate initval and replace with an initial statement.  Update the
-; docs for vl-initial-p and also below when this is done.
-
-            (vl-maybe-expr-p-of-vl-regdecl->initval
-             (vl-maybe-expr-p initval))
-            (vl-atts-p-of-vl-regdecl->atts
-             (vl-atts-p atts))
-            (vl-location-p-vl-regdecl->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a single @('reg') declaration."
-  :long "<p>@('vl-regdecl-p') is our representation for a single
-@('reg') declaration.  Our parser splits up combined declarations such as
-\"reg a, b\" into multiple, individual declarations, so each
-@('vl-regdecl-p') represents only one declaration.</p>
-
-<p>The @('name') is the name of this register as an ordinary ACL2 string.</p>
-
-<p>The @('signedp') flag indicates whether they keyword @('signed') was used in
-the declaration of the register.  (By default, registers are unsigned.)</p>
-
-<p>The @('range') and @('arrdims') are used for multi-bit regs and arrays of
-regs.  More discussion is available in @(see vl-netdecl-p).</p>
-
-<p>The @('initval') is an expression that provides an initial value to this
-register, if one was provided.</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with this
-declaration.</p>
-
-<p>The @('loc') is a @(see vl-location-p) that identifies where this
-declaration comes from in the source code.</p>")
+  :tag :vl-regdecl
+  :legiblep nil
+  ((name    stringp
+            :rule-classes :type-prescription
+            "Name of the register being declared.")
+
+   (signedp booleanp
+            :rule-classes :type-prescription
+            "Indicates whether they keyword @('signed') was used in the
+             declaration of the register.  By default, registers are
+             unsigned.")
+
+   (range   vl-maybe-range-p
+            "Size for wide registers; see also @(see vl-netdecl-p) for
+             more discussion of @('range') versus @('arrdims').")
+
+   (arrdims vl-rangelist-p
+            "Array dimensions for arrays of registers; see @(see
+             vl-netdecl-p) for more discussion.")
+
+   (initval vl-maybe-expr-p
+            ;; BOZO eliminate initval and replace with an initial statement.
+            ;; Update the docs for vl-initial-p and also below when this is
+            ;; done.
+            "When present, indicates the initial value for this register.")
+
+   (atts    vl-atts-p
+            "Any attributes associated with this declaration.")
+
+   (loc     vl-location-p
+            "Where the declaration was found in the source code."))
+
+  :long "<p>@('vl-regdecl-p') is our representation for a single @('reg')
+declaration.  Our parser splits up combined declarations such as \"reg a, b\"
+into multiple, individual declarations, so each @('vl-regdecl-p') represents
+only one declaration.</p>")
 
 
 (defaggregate vl-eventdecl
-  (name arrdims atts loc)
-  :tag :vl-eventdecl
-  :legiblep nil
-  :require ((stringp-of-vl-eventdecl->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (vl-rangelist-p-of-vl-eventdecl->arrdims
-             (vl-rangelist-p arrdims))
-            (vl-atts-p-of-vl-eventdecl->atts
-             (vl-atts-p atts))
-            (vl-location-p-vl-eventdecl->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a single event declaration."
-  :long "<p>BOZO document this</p>")
+  :tag :vl-eventdecl
+  :legiblep nil
+
+  ((name    stringp
+            :rule-classes :type-prescription
+            "Name of the event being declared.")
+   (arrdims vl-rangelist-p
+            "Indicates that this is an array of events?  Because that makes
+             sense?")
+   (atts    vl-atts-p
+            "Any attributes associated with this declaration.")
+   (loc     vl-location-p
+            "Where the declaration was found in the source code."))
+
+  :long "<p>BOZO document event declarations.</p>")
 
 
 (defenum vl-paramdecltype-p
@@ -2966,28 +2892,43 @@
 </ul>")
 
 (defaggregate vl-paramdecl
-  (name expr type localp range atts loc)
-  :tag :vl-paramdecl
-  :legiblep nil
-  :require ((stringp-of-vl-paramdecl->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (vl-expr-p-of-vl-paramdecl->expr
-             (vl-expr-p expr))
-            (vl-paramdecltype-p-of-vl-paramdecl->type
-             (vl-paramdecltype-p type))
-            (booleanp-of-vl-paramdecl->localp
-             (booleanp localp)
-             :rule-classes :type-prescription)
-            (vl-maybe-range-p-of-vl-paramdecl->range
-             (vl-maybe-range-p range))
-            (vl-atts-p-of-vl-paramdecl->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-paramdecl->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a single @('parameter') or @('localparam')
 declaration."
+  :tag :vl-paramdecl
+  :legiblep nil
+
+  ((name   stringp
+           :rule-classes :type-prescription
+           "Name of the parameter being declared.")
+
+   (expr   vl-expr-p
+           "Default value for this parameter.")
+
+   (type   vl-paramdecltype-p
+           "Indicates the type of the parameter, e.g., @('signed'), @('integer'),
+            @('realtime'), etc.")
+
+   (localp booleanp
+           :rule-classes :type-prescription
+           "True for @('localparam') declarations, @('nil') for @('parameter')
+            declarations.  The difference is apparently that @('localparam')s
+            such as @('TWICE_WIDTH') below cannot be overridden from outside
+            the module, except insofar as that they depend upon non-local
+            parameters.  (These @('localparam') declarations are a way to
+            introduce named constants without polluting the @('`define')
+            namespace.)")
+
+   (range  vl-maybe-range-p
+           "Some ridiculous thing allowed by the grammar and who knows what it
+            means.  Some description of it in 12.2.")
+
+   (atts   vl-atts-p
+           "Any attributes associated with this declaration.")
+
+   (loc    vl-location-p
+           "Where the declaration was found in the source code."))
+
   :long "<p>Parameters are discussed in 12.2.  Some examples of parameter
 declarations include:</p>
 
@@ -2997,29 +2938,7 @@
   localparam TWICE_WIDTH = 2 * WIDTH;
   ...
 endmodule
-})
-
-<p>The @('name') of the parameter is an ordinary ACL2 @('stringp'), e.g.,
-@('WIDTH') or @('TWICE_WIDTH') in the examples above.</p>
-
-<p>The @('expr') is the default value for this expression.</p>
-
-<p>The @('type') is a @(see vl-paramdecltype-p) that might indicate the
-parameter is a signed or has a particular type (e.g., integer, realtime).</p>
-
-<p>The @('localp') flag is @('t') if this delaration was made with
-@('localparam'), or @('nil') if the declaration was made with @('parameter').
-The difference is apparently that @('localparam')s such as @('TWICE_WIDTH')
-cannot be overridden from outside the module, except insofar as that they
-depend upon other, non-local parameters.  Apparently the use of @('localparam')
-may be useful for introducing named constants without polluting the
-@('`define') namespace.</p>
-
-<p>The @('range') is some ridiculous thing allowed by the grammar and who knows
-what it means.  Some description of it in 12.2.</p>
-
-<p>The @('atts') and @('loc') should be obvious; see @(see vl-atts-p) and @(see
-vl-location-p).</p>")
+})")
 
 (deflist vl-vardecllist-p (x)
   (vl-vardecl-p x)
@@ -3154,25 +3073,23 @@
 atoms like @('a') and @('b') in @('always @@(a or b)').</p>")
 
 (defaggregate vl-evatom
-  (type expr)
-  :tag :vl-evatom
-  :legiblep nil
-  :require ((vl-evatomtype-p-of-vl-evatom->type
-             (vl-evatomtype-p type))
-            (vl-expr-p-of-vl-evatom->expr
-             (vl-expr-p expr)))
   :parents (modules)
   :short "A single item in an event control list."
+  :tag :vl-evatom
+  :legiblep nil
+
+  ((type vl-evatomtype-p
+         "Kind of atom, e.g., posedge, negedge, or plain.")
+
+   (expr vl-expr-p
+         "Associated expression, e.g., @('foo') for @('posedge foo')."))
+
   :long "<p>Event expressions and controls are described in Section 9.7.</p>
 
 <p>We represent the expressions for an event control (see @(see
 vl-eventcontrol-p)) as a list of @('vl-evatom-p') structures.  Each individual
 evatom is either a plain Verilog expression, or is @('posedge') or @('negedge')
-applied to a Verilog expression.</p>
-
-<p>The @('type') is the type of edge; see @(see vl-evatomtype-p).</p>
-
-<p>The @('expr') is the associated expression.</p>")
+applied to a Verilog expression.</p>")
 
 (deflist vl-evatomlist-p (x)
   (vl-evatom-p x)
@@ -3182,73 +3099,66 @@
 
 
 (defaggregate vl-eventcontrol
-  (starp atoms)
-  :tag :vl-eventcontrol
-  :legiblep nil
-  :require ((booleanp-of-vl-eventcontrol->star
-             (booleanp starp)
-             :rule-classes :type-prescription)
-            (vl-evatomlist-p-of-vl-eventcontrol->atoms
-             (vl-evatomlist-p atoms)))
   :parents (modules)
   :short "Representation of an event controller like @('@@(posedge clk)') or
 @('@@(a or b)')."
+  :tag :vl-eventcontrol
+  :legiblep nil
 
-  :long "<p>Event controls are described in Section 9.7.  We represent each
-event controller as a @('vl-eventcontrol-p') aggregates.</p>
-
-<p>If the @('starp') flag is @('T'), then this event control represents
-@('@@(*)').</p>
+  ((starp booleanp
+          :rule-classes :type-prescription
+          "True to represent @('@(*)'), or @('nil') for any other kind of
+           event controller.")
+
+   (atoms vl-evatomlist-p
+          "A list of @(see vl-evatom-p)s that describe the various
+           events. Verilog allows two kinds of syntax for these lists, e.g.,
+           one can write @('@(a or b)') or @('@(a, b)').  The meaning is
+           identical in either case, so we just use a list of atoms."))
 
-<p>Otherwise, @('atoms') contains a list of @(see vl-evatom-p) structures that
-describe the various events.  Verilog allows two kinds of syntax for these
-lists, e.g., one can write @('@@(a or b)') or @('@@(a, b)').  The meaning is
-identical in either case, so we just use a list of atoms.</p>")
+  :long "<p>Event controls are described in Section 9.7.  We represent each
+event controller as a @('vl-eventcontrol-p') aggregates.</p>")
 
 (defaggregate vl-delaycontrol
-  (value)
-  :tag :vl-delaycontrol
-  :legiblep nil
-  :require ((vl-expr-p-of-vl-delaycontrol->value
-             (vl-expr-p value)))
   :parents (modules)
   :short "Representation of a delay controller like @('#6')."
+  :tag :vl-delaycontrol
+  :legiblep nil
+  ((value vl-expr-p "The expression that governs the delay amount."))
+
   :long "<p>Delay controls are described in Section 9.7.  An example is</p>
 
 @({
   #10 foo = 1;   <-- The #10 is a delay control
-})
-
-<p>The @('expr') is an expression that represents the delay.</p>")
+})")
 
 (defaggregate vl-repeateventcontrol
-  (expr ctrl)
-  :tag :vl-repeat-eventcontrol
-  :legiblep nil
-  :require ((vl-expr-p-of-vl-repeateventcontrol->expr
-             (vl-expr-p expr))
-            (vl-eventcontrol-p-of-vl-repeateventcontrol->ctrl
-             (vl-eventcontrol-p ctrl)))
   :parents (modules)
   :short "Representation of @('repeat') constructs in intra-assignment delays."
+  :tag :vl-repeat-eventcontrol
+  :legiblep nil
+  ((expr vl-expr-p
+         "The number of times to repeat the control, e.g., @('3') in the below
+          example.")
+
+   (ctrl vl-eventcontrol-p
+         "Says which event to wait for, e.g., @('@(posedge clk)') in the below
+          example."))
+
   :long "<p>See Section 9.7.7.  These are used to represent special
 intra-assignment delays, where the assignment should not occur until some
 number of occurrences of an event.  For instance:</p>
 
 @({
-   a = repeat(3) @@(posedge clk) b;
+   a = repeat(3) @(posedge clk)   <-- repeat expr ctrl
+         b;                       <-- statement to repeat
 })
 
-<p>The @('expr') indicates how many times to repeat, e.g., @('3') in the above
-example.  The @('ctrl') is an @(see vl-eventcontrol-p) that says which event is
-being waited for.</p>
-
 <p><b>BOZO</b> Consider consolidating all of these different kinds of
 controls into a single, unified representation.  E.g., you could at
 least extend eventcontrol with a maybe-expr that is its count, and get
 rid of repeateventcontrol.</p>")
 
-
 (define vl-delayoreventcontrol-p (x)
   :parents (modules)
   :short "BOZO document this."
@@ -3331,23 +3241,41 @@
 respectivley.</p>")
 
 (defaggregate vl-assignstmt
-  (type lvalue expr ctrl atts loc)
-  :tag :vl-assignstmt
-  :legiblep nil
-  :require ((vl-assign-type-p-of-vl-assignstmt->type
-             (vl-assign-type-p type))
-            (vl-expr-p-of-vl-assignstmt->lvalue
-             (vl-expr-p lvalue))
-            (vl-expr-p-of-vl-assignstmt->expr
-             (vl-expr-p expr))
-            (vl-maybe-delayoreventcontrol-p-of-vl-assignstmt->ctrl
-             (vl-maybe-delayoreventcontrol-p ctrl))
-            (vl-atts-p-of-vl-assignstmt->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-assignstmt->loc
-             (vl-location-p loc)))
   :parents (vl-stmt-p)
   :short "Representation of an assignment statement."
+  :tag :vl-assignstmt
+  :legiblep nil
+
+  ((type   vl-assign-type-p
+           "Kind of assignment statement, e.g., blocking, nonblocking, etc.")
+
+   (lvalue vl-expr-p
+           "Location being assigned to.  Note that the specification places
+            various restrictions on lvalues, e.g., for a procedural assignment
+            the lvalue may contain only plain variables, and bit-selects,
+            part-selects, memory words, and nested concatenations of these
+            things.  We do not enforce these restrictions in
+            @('vl-assignstmt-p'), but only require that the lvalue is an
+            expression.")
+
+   (expr   vl-expr-p
+           "The right-hand side expression that should be assigned to the
+            lvalue.")
+
+   (ctrl   vl-maybe-delayoreventcontrol-p
+           "Control that affects when the assignment is done, if any.  These
+            controls can be a delay like @('#(6)') or an event control like
+            @('@@(posedge clk)').  The rules for this are covered in Section
+            9.2 and appear to perhaps be different depending upon the type of
+            assignment.  Further coverage seems to be available in Section
+            9.7.7.")
+
+   (atts   vl-atts-p
+           "Any attributes associated with this statement.")
+
+   (loc    vl-location-p
+           "Where the statement was found in the source code."))
+
   :long "<p>Assignment statements are covered in Section 9.2.  There are two
 major types of assignment statements.</p>
 
@@ -3380,34 +3308,7 @@
 })
 
 <p>We represent all of these kinds of assignment statements uniformly as
-@('vl-assignstmt-p') objects.</p>
-
-<p>The @('type') of the object is a @(see vl-assign-type-p) that says what kind
-of assignment this is.</p>
-
-<p>The @('lvalue') is the location being assigned to.  Note that the
-specification places various restrictions on lvalues, e.g., for a procedural
-assignment the lvalue may contain only plain variables, and bit-selects,
-part-selects, memory words, and nested concatenations of these things.  These
-restrictions are not enforced by @('vl-assignstmt-p'), where we only require
-that the lvalue is an expression.</p>
-
-<p>The @('expr') is the right-hand side expression that is being assigned to
-this lvalue.</p>
-
-<p>All forms of assignment may have a @('ctrl') associated with them.  This
-control may be a delay control such as @('#(6)') an event control like
-@('@@(posedge clk)'), which can affect when the assignment is done.  The rules
-for this are covered in Section 9.2 and appear to perhaps be different
-depending upon the type of assignment.  Further coverage seems to be available
-in Section 9.7.7.</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with the
-assignment.</p>
-
-<p>The @('loc') is a @(see vl-location-p) describing the origin of this
-assignment in the original Verilog sources.</p>")
-
+@('vl-assignstmt-p') objects.</p>")
 
 (defenum vl-deassign-type-p
   (:vl-deassign :vl-release)
@@ -3415,64 +3316,50 @@
   :short "Type of an deassignment statement.")
 
 (defaggregate vl-deassignstmt
-  (type lvalue atts)
-  :tag :vl-deassignstmt
-  :legiblep nil
-  :require ((vl-deassign-type-p-of-vl-deassignstmt->type
-             (vl-deassign-type-p type))
-            (vl-expr-p-of-vl-deassignstmt->lvalue
-             (vl-expr-p lvalue))
-            (vl-atts-p-of-vl-deassignstmt->atts
-             (vl-atts-p atts)))
   :parents (vl-stmt-p)
   :short "Representation of a deassign or release statement."
+  :tag :vl-deassignstmt
+  :legiblep nil
+  ((type   vl-deassign-type-p)
+   (lvalue vl-expr-p)
+   (atts   vl-atts-p "Any attributes associated with this statement."))
   :long "<p>Deassign and release statements are described in Section 9.3.1 and
 9.3.2.</p>")
 
 (defaggregate vl-enablestmt
-  (id args atts)
-  :tag :vl-enablestmt
-  :legiblep nil
-  :require ((vl-expr-p-of-vl-enablestmt->id
-             (vl-expr-p id))
-            (vl-exprlist-p-of-vl-enablestmt->args
-             (vl-exprlist-p args))
-            (vl-atts-p-of-vl-enablestmt->atts
-             (vl-atts-p atts)))
   :parents (vl-stmt-p)
   :short "Representation of an enable statement."
-
+  :tag :vl-enablestmt
+  :legiblep nil
+  ((id   vl-expr-p)
+   (args vl-exprlist-p)
+   (atts vl-atts-p "Any attributes associated with this statement."))
   :long "<p>Enable statements have an identifier (which should be either a
 hierarchial identifier or a system identifier), which we represent as an
 expression.  They also have a list of arguments, which are expressions.</p>")
 
 (defaggregate vl-disablestmt
-  (id atts)
-  :tag :vl-disablestmt
-  :legiblep nil
-  :require ((vl-expr-p-of-vl-disablestmt->id
-             (vl-expr-p id))
-            (vl-atts-p-of-vl-disablestmt->atts
-             (vl-atts-p atts)))
   :parents (vl-stmt-p)
   :short "Representation of a disable statement."
-
+  :tag :vl-disablestmt
+  :legiblep nil
+  ((id   vl-expr-p)
+   (atts vl-atts-p "Any attributes associated with this statement."))
   :long "<p>Disable statements are simpler and just have a hierarchial
 identifier.  Apparently there are no disable statements for system
 identifiers.</p>")
 
-
-
 (defaggregate vl-eventtriggerstmt
-  (id atts)
-  :tag :vl-eventtriggerstmt
-  :legiblep nil
-  :require ((vl-expr-p-of-vl-eventtriggerstmt->id
-             (vl-expr-p id))
-            (vl-atts-p-of-vl-eventtriggerstmt->atts
-             (vl-atts-p atts)))
   :parents (vl-stmt-p)
   :short "Representation of an event trigger."
+  :tag :vl-eventtriggerstmt
+  :legiblep nil
+  ((id   vl-expr-p
+         "Typically a name like @('foo') and @('bar'), but may instead be a
+          hierarchical identifier.")
+   (atts vl-atts-p
+         "Any attributes associated with this statement."))
+
   :long "<p>Event trigger statements are used to explicitly trigger named
 events.  They are discussed in Section 9.7.3 and looks like this:</p>
 
@@ -3481,32 +3368,20 @@
  -> bar[1][2][3];  // I think?
 })
 
-<p>The @('id') for an event trigger are the names such as @('foo') and @('bar')
-above, and may be a hierarchical identifier.  We represent the @('id') as an
-expression.</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with the
-statement.</p>
-
 <p><b>BOZO</b> are we handling the syntax correctly?  What about the
 expressions that can follow the trigger?  Maybe they just become part of the
 @('id')?</p>")
 
-
 (defaggregate vl-nullstmt
-  (atts)
-  :tag :vl-nullstmt
-  :legiblep nil
-  :require ((vl-atts-p-of-vl-nullstmt->atts
-             (vl-atts-p atts)))
   :parents (vl-stmt-p)
   :short "Representation of an empty statement."
-
+  :tag :vl-nullstmt
+  :legiblep nil
+  ((atts vl-atts-p "Any attributes associated with this statement."))
   :long "<p>We allow explicit null statements.  This allows us to canonicalize
 @('if') expressions so that any missing branches are turned into null
 statements.</p>")
 
-
 (define vl-atomicstmt-p (x)
   :parents (vl-stmt-p)
   :short "Representation of an atomic statement."
@@ -3740,46 +3615,73 @@
 
 
 (defaggregate vl-compoundstmt
-  (type exprs stmts name decls ctrl sequentialp casetype atts)
+  :parents (vl-stmt-p)
+  :short "Representation of a compound statement."
   :tag :vl-compoundstmt
   :legiblep nil
-  :require ((vl-compoundstmttype-p-of-vl-compoundstmt->type
-             (vl-compoundstmttype-p type))
-            (vl-exprlist-p-of-vl-compoundstmt->exprs
-             (vl-exprlist-p exprs))
-            ;; no requirements on stmts due to mutual recursion
-            (vl-maybe-string-p-of-vl-compoundstmt->name
-             (vl-maybe-string-p name)
-             :rule-classes ((:type-prescription)
-                            (:rewrite :corollary
-                                      (implies (force (vl-compoundstmt-p x))
-                                               (equal (stringp (vl-compoundstmt->name x))
-                                                      (if (vl-compoundstmt->name x)
-                                                          t
-                                                        nil))))))
-            (vl-blockitemlist-p-of-vl-compoundstmt->decls
-             (vl-blockitemlist-p decls))
-            (vl-maybe-delayoreventcontrol-p-of-vl-compoundstmt->ctrl
-             (vl-maybe-delayoreventcontrol-p ctrl)
-             :rule-classes ((:rewrite)
-                            (:rewrite
-                             :corollary
-                             (implies (force (vl-compoundstmt-p x))
-                                      (iff (vl-delayoreventcontrol-p (vl-compoundstmt->ctrl x))
-                                           (vl-compoundstmt->ctrl x))))))
-            (booleanp-of-vl-compoundstmt->sequentialp
-             (booleanp sequentialp)
-             :rule-classes :type-prescription)
-            (vl-casetype-p-of-vl-compoundstmt->casetype
-             (vl-casetype-p casetype))
-            (vl-atts-p-of-vl-compoundstmt->atts
-             (vl-atts-p atts))
-            (vl-compoundstmt-basic-checksp-of-vl-compoundstmt
-             (vl-compoundstmt-basic-checksp type exprs stmts name decls
-                                            ctrl sequentialp casetype)))
-  :parents (vl-stmt-p)
+  ((type        vl-compoundstmttype-p
+                "Keyword symbol that says what kind of statement this is,
+                 e.g., an @('if') statement, @('while') loop, etc.")
+
+   (exprs       vl-exprlist-p
+                "A list of expressions associated with the statement. Some
+                 statements (e.g., @('begin ... end') blocks) have no
+                 expressions, but other statements, such as @('if'),
+                 @('while'), and @('case') statements, may have one or many.")
+
+   (stmts       "Any sub-statements that are associated with the statement.
+                 Every kind of compound statement may have sub-statements,
+                 since otherwise it would be an atomic statement.  Note that
+                 there is no restriction on @('stmts') in
+                 @('vl-compoundstmt-p') itself due to mutual recursion; see
+                 @(see vl-stmt-p).")
+
+   (name        vl-maybe-string-p
+                :rule-classes
+                ((:type-prescription)
+                 (:rewrite :corollary
+                           (implies (force (vl-compoundstmt-p x))
+                                    (equal (stringp (vl-compoundstmt->name x))
+                                           (if (vl-compoundstmt->name x)
+                                               t
+                                             nil)))))
+                "Only valid on block statements (i.e., @('begin ... end') and
+                 @('fork ... join') statements).  If present, it is a string
+                 that names this block.")
+
+   (decls       vl-blockitemlist-p
+                "Only valid on block statements.  Contains any declarations for
+                 the block; see @(see vl-blockitem-p).")
+
+   (ctrl        vl-maybe-delayoreventcontrol-p
+                :rule-classes
+                ((:rewrite)
+                 (:rewrite
+                  :corollary
+                  (implies (force (vl-compoundstmt-p x))
+                           (iff (vl-delayoreventcontrol-p (vl-compoundstmt->ctrl x))
+                                (vl-compoundstmt->ctrl x)))))
+                "Only valid on procedural timing control statements like
+                 @('@(posedge clk) substmt') or @('#6 substmt').  If present,
+                 describes what to wait for, e.g., this is the @('@(posedge
+                 clk)') or @('#6') part.")
+
+   (sequentialp booleanp
+                :rule-classes :type-prescription
+                "Only valid on block statements.  This is @('t') for a
+                 @('begin/end') block, or @('nil') if this is a @('fork/join')
+                 block.")
+
+   (casetype    vl-casetype-p
+                "Only valid on case statements.  Indicates whether this is a
+                 @('case'), @('casex'), or @('casez') statement.")
 
-  :short "Representation of a compound statement."
+   (atts        vl-atts-p
+                "Any attributes associated with this statement."))
+  :require
+  ((vl-compoundstmt-basic-checksp-of-vl-compoundstmt
+    (vl-compoundstmt-basic-checksp type exprs stmts name decls
+                                   ctrl sequentialp casetype)))
 
   :long "<h3>Introduction</h3>
 
@@ -3801,45 +3703,6 @@
 together is that we can recur over statements while largely ignoring their
 actual types, etc., making the mutually recursive scheme much simpler.</p>
 
-<h3>Field Descriptions</h3>
-
-<p>The @('type') is keyword symbol that says what kind of statement this is,
-e.g., an @('if') or @('casez') statement.  The @('type') must be one of the
-types recognized by @(see vl-compoundstmttype-p).</p>
-
-<p>The @('exprs') are a list of expressions associated with the statement.
-Some statements (e.g., @('begin ... end') blocks) have no expressions, but
-other statements, such as @('if'), @('while'), and @('case') statements, may
-have one or many.</p>
-
-<p>The @('stmts') are any sub-statements that are associated with the
-statement.  Every kind of compound statement may have sub-statements, since
-otherwise it would be an atomic statement.</p>
-
-<p>The @('name') is only valid on block statements (i.e., @('begin ... end')
-and @('fork ... join') statements).  If present, it is a string that names this
-block.</p>
-
-<p>The @('decls') are only valid on block statements, and includes any
-declarations for the block; see @(see vl-blockitem-p).</p>
-
-<p>The @('sequentialp') flag is only valid on block statements, and is @('t')
-if this is a @('begin/end') block, or @('nil') if this is a @('fork/join')
-block.</p>
-
-<p>The @('casetype') is only valid on case statements, and indicates whether
-this is a @('case'), @('casex'), or @('casez') statement; see @(see
-vl-casetype-p).</p>
-
-<p>The @('ctrl') is only valid on procedural timing control statements such as
-@('@@(posedge clk) substmt') or @('#6 substmt').  If present, it should be
-either a @(see vl-eventcontrol-p) that describes what event to wait for, e.g.,
-\"@('posedge clk')\", or a @(see vl-delaycontrol-p) that says how long to
-delay, e.g., \"@('#6')\".</p>
-
-<p>The @('atts') are any <see topic=\"@(url vl-atts-p)\">attributes</see>
-associated with the statement.</p>
-
 <h3>Basic Well-Formedness Checks</h3>
 
 <p>A \"problem\" with using a combined representation is that, for instance, an
@@ -3915,9 +3778,9 @@
               (vl-stmtlist-p (cdr x)))
        t)))
 
-  ;; I'm not exactly sure what to put here, and what to put in mu-stmt-tools.
-  ;; I'm going to try to keep most stuff in mu-stmt-tools, and just leave a
-  ;; few basics here.
+  ;; I'm not exactly sure what to put here, and what to put in mlib/stmt-tools.
+  ;; I'm going to try to keep most stuff in stmt-tools, and just leave a few
+  ;; basics here.
 
   (FLAG::make-flag vl-flag-stmt-p
                    vl-stmt-p
@@ -4041,7 +3904,6 @@
   (mbe :logic (vl-enablestmt-p x)
        :exec (eq (tag x) :vl-enablestmt)))
 
-
 (define vl-atomicstmt->atts ((x vl-atomicstmt-p))
   :returns (atts vl-atts-p :hyp :fguard)
   :parents (vl-atomicstmt-p vl-stmt->atts)
@@ -4079,17 +3941,19 @@
 ; attributes.
 
 (defaggregate vl-initial
-  (stmt atts loc)
-  :tag :vl-initial
-  :legiblep nil
-  :require ((vl-stmt-p-of-vl-initial->stmt
-             (vl-stmt-p stmt))
-            (vl-atts-p-of-vl-initial->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-initial->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of an initial statement."
+  :tag :vl-initial
+  :legiblep nil
+
+  ((stmt vl-stmt-p
+         "Represents the actual statement, e.g., @('r = 0') below.")
+
+   (atts vl-atts-p
+         "Any attributes associated with this @('initial') block.")
+
+   (loc  vl-location-p
+         "Where the initial block was found in the source code."))
 
   :long "<p>Initial statements in Verilog are used to set up initial values for
 simulation.  For instance,</p>
@@ -4101,51 +3965,27 @@
 endmodule
 })
 
-<ul>
-
-<li>The @('stmt') is a @(see vl-stmt-p) that represents the actual statement,
-e.g., @('r = 0') above.  Such a statement is frequently a sequential block
-statement (i.e., @('begin ... end')), but as shown above it can be
-anything.</li>
-
-<li>The @('atts') are any attribute (see @(see vl-atts-p)) associated with this
-initial statement.</li>
-
-<li>The @('loc') is a @(see vl-location-p) that describes where this initial
-statement was read from in the source code.</li>
-
-</ul>
-
 <p><b>BOZO</b> Our plan is to eventually generate @('initial') statements from
 register and variable declarations with initial values, i.e., @('reg r =
-0;').</p>"
-
-  :rest
-  (
-   ;; (defthm acl2-count-of-vl-initial->stmt
-   ;;   (and (<= (acl2-count (vl-initial->stmt x))
-   ;;            (acl2-count x))
-   ;;        (implies (consp x)
-   ;;                 (< (acl2-count (vl-initial->stmt x))
-   ;;                    (acl2-count x))))
-   ;;   :hints(("Goal" :in-theory (enable vl-initial->stmt)))
-   ;;   :rule-classes ((:rewrite) (:linear)))
-   ))
-
+0;').</p>")
 
 
 (defaggregate vl-always
-  (stmt atts loc)
-  :tag :vl-always
-  :legiblep nil
-  :require ((vl-stmt-p-of-vl-always->stmt
-             (vl-stmt-p stmt))
-            (vl-atts-p-of-vl-always->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-always->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of an always statement."
+  :tag :vl-always
+  :legiblep nil
+
+  ((stmt vl-stmt-p
+         "The actual statement, e.g., @('@(posedge clk) myreg <= in')
+          below. The statement does not have to include a timing control like
+          @('@(posedge clk)') or @('@(a or b or c)'), but often does.")
+
+   (atts vl-atts-p
+         "Any attributes associated with this @('always') block.")
+
+   (loc  vl-location-p
+         "Where the always block was found in the source code."))
 
   :long "<p>Always statements in Verilog are often used to model latches and
 flops, and to set up other simulation events.  A simple example would be:</p>
@@ -4154,34 +3994,7 @@
 module mymod (a, b, ...) ;
   always @@(posedge clk) myreg <= in;
 endmodule
-})
-
-<ul>
-
-<li>The @('stmt') is a @(see vl-stmt-p) that represents the actual statement,
-e.g., @('@@(posedge clk) myreg <= in') above.  Such a statement need not have a
-timing control such as @('@@(posedge clk)') or @('@@(a or b or c)'), but often
-does.</li>
-
-<li>The @('atts') are any attribute (see @(see vl-atts-p)) associated with this
-always statement.</li>
-
-<li>The @('loc') is a @(see vl-location-p) that describes where this always
-statement was read from in the source code.</li>
-
-</ul>"
-
-  :rest
-  (
-   ;; (defthm acl2-count-of-vl-always->stmt
-   ;;   (and (<= (acl2-count (vl-always->stmt x))
-   ;;            (acl2-count x))
-   ;;        (implies (consp x)
-   ;;                 (< (acl2-count (vl-always->stmt x))
-   ;;                    (acl2-count x))))
-   ;;   :hints(("Goal" :in-theory (enable vl-always->stmt)))
-   ;;   :rule-classes ((:rewrite) (:linear))))
-  ))
+})")
 
 (deflist vl-initiallist-p (x)
   (vl-initial-p x)
@@ -4235,26 +4048,51 @@
 <p>Likewise, the inputs to Verilog functions use these same kinds of
 types.</p>")
 
-
 (defaggregate vl-taskport
-  (name dir type range atts loc)
-  :tag :vl-taskport
-  :legiblep nil
-  :require ((stringp-of-vl-taskport->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (vl-direction-p-of-vl-taskport->dir
-             (vl-direction-p dir))
-            (vl-taskporttype-p-of-vl-taskport->type
-             (vl-taskporttype-p type))
-            (vl-maybe-range-p-of-vl-taskport->range
-             (vl-maybe-range-p range))
-            (vl-atts-p-of-vl-taskport->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-taskport->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a task port or a function input."
+  :tag :vl-taskport
+  :legiblep nil
+
+  ((name  stringp
+          :rule-classes :type-prescription
+          "The name of this task port.")
+
+   (dir   vl-direction-p
+          :rule-classes
+          ((:rewrite)
+           (:type-prescription
+            :corollary
+            (implies (force (vl-taskport-p x))
+                     (and (symbolp (vl-taskport->dir x))
+                          (not (equal (vl-taskport->dir x) t))
+                          (not (equal (vl-taskport->dir x) nil))))))
+          "Says whether this is an input, output, or inout port.  Note that
+           tasks can have all three kinds of ports, but functions only have
+           inputs.")
+
+   (type  vl-taskporttype-p
+          :rule-classes
+          ((:rewrite)
+           (:type-prescription
+            :corollary
+            (implies (force (vl-taskport-p x))
+                     (and (symbolp (vl-taskport->type x))
+                          (not (equal (vl-taskport->type x) t))
+                          (not (equal (vl-taskport->type x) nil))))))
+          "Says what kind of port this is, i.e., @('integer'), @('real'),
+          etc.")
+
+   (range vl-maybe-range-p
+          "The size of this input.  A range only makes sense when the type is
+           @(':vl-unsigned') or @(':vl-signed').  It should be @('nil') when
+           other types are used.")
+
+   (atts  vl-atts-p
+          "Any attributes associated with this input.")
+
+   (loc   vl-location-p
+          "Where this input was found in the source code."))
 
   :long "<p>Verilog tasks have ports that are similar to the ports of a module.
 We represent these ports with their own @('vl-taskport-p') structures, rather
@@ -4263,43 +4101,7 @@
 
 <p>While Verilog functions don't have @('output') or @('inout') ports, they do
 have input ports that are very similar to task ports.  So, we reuse
-@('vl-taskport-p') structures for function inputs.</p>
-
-<p>The @('name') is just a string that is the name of this port.</p>
-
-<p>The @('dir') is a @(see vl-direction-p) that says whether this port is an
-input, output, or inout port.  Note that tasks can have all three kinds of
-ports, but functions only have inputs.</p>
-
-<p>The @('type') is a @(see vl-taskporttype-p) that gives the type for this
-input.</p>
-
-<p>The @('range') is a @(see vl-maybe-range-p) that gives the size of this
-input.  This only makes sense when the type is @(':vl-unsigned') or
-@(':vl-signed'), and is @('nil') when other types are used.</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with this
-input.  Syntactically, the attributes come before the @('input') keyword.</p>
-
-<p>The @('loc') is the @(see vl-location-p) where the @('name') of the function
-was found in the source code.  We use this location, instead of the location of
-the input keyword, because a list of inputs can be declared using the same
-input keyword.</p>"
-
-  :rest
-  ((defthm type-of-vl-taskport->dir
-     (implies (force (vl-taskport-p x))
-              (and (symbolp (vl-taskport->dir x))
-                   (not (equal (vl-taskport->dir x) t))
-                   (not (equal (vl-taskport->dir x) nil))))
-     :rule-classes :type-prescription)
-
-   (defthm type-of-vl-taskport->type
-     (implies (force (vl-taskport-p x))
-              (and (symbolp (vl-taskport->type x))
-                   (not (equal (vl-taskport->type x) t))
-                   (not (equal (vl-taskport->type x) nil))))
-     :rule-classes :type-prescription)))
+@('vl-taskport-p') structures for function inputs.</p>")
 
 (deflist vl-taskportlist-p (x)
   (vl-taskport-p x)
@@ -4315,31 +4117,64 @@
 
 
 (defaggregate vl-fundecl
-  (name automaticp rtype rrange inputs decls body atts loc)
-  :tag :vl-fundecl
-  :legiblep nil
-  :require ((stringp-of-vl-fundecl->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (booleanp-of-vl-fundecl->automaticp
-             (booleanp automaticp)
-             :rule-classes :type-prescription)
-            (vl-taskporttype-p-of-vl-fundecl->rtype
-             (vl-taskporttype-p rtype))
-            (vl-maybe-range-p-of-vl-fundecl->rrange
-             (vl-maybe-range-p rrange))
-            (vl-taskportlist-p-of-vl-fundecl->inputs
-             (vl-taskportlist-p inputs))
-            (vl-blockitemlist-p-of-vl-fundecl->decls
-             (vl-blockitemlist-p decls))
-            (vl-stmt-p-of-vl-fundecl->body
-             (vl-stmt-p body))
-            (vl-atts-p-of-vl-fundecl->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-fundecl->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a single Verilog function."
+  :tag :vl-fundecl
+  :legiblep nil
+
+  ((name       stringp
+               :rule-classes :type-prescription
+               "Name of this function, e.g., @('lower_bits') below.")
+
+   (automaticp booleanp
+               :rule-classes :type-prescription
+               "Says whether the @('automatic') keyword was provided.  This
+                keyword indicates that the function should be reentrant and
+                have its local parameters dynamically allocated for each
+                function call, with various consequences.")
+
+   (rtype      vl-taskporttype-p
+               "Return type of the function, e.g., a function might return an
+                ordinary unsigned or signed result of some width, or might
+                return a @('real') value, etc.  For instance, the return type
+                of @('lower_bits') below is @(':vl-unsigned').")
+
+   (rrange     vl-maybe-range-p
+               "Range for the function's return value.  This only makes sense
+                when the @('rtype') is @(':vl-unsigned') or @(':vl-signed').
+                For instance, the return range of @('lower_bits') below is
+                @('[7:0]').")
+
+   (inputs     vl-taskportlist-p
+               "The arguments to the function, e.g., @('input [7:0] a') below.
+                Functions must have at least one input.  We check this in our
+                parser, but we don't syntactically enforce this requirement in
+                the @('vl-fundecl-p') structure.  Furthermore, functions may
+                only have inputs (i.e., they can't have outputs or inouts), but
+                our @(see vl-taskport-p) structures have a direction.  This
+                direction should always be @(':vl-input') for a function's
+                input; we again check this in our parser, but not in the
+                @('vl-fundecl-p') structure itself.")
+
+   (decls      vl-blockitemlist-p
+               "Any local variable declarations for the function, e.g., the
+                declarations of @('lowest_pair') and @('next_lowest_pair')
+                below.  We represent the declarations as an ordinary @(see
+                vl-blockitemlist-p), and it appears that it may even contain
+                event declarations, parameter declarations, etc., which seems
+                pretty absurd.")
+
+   (body       vl-stmt-p
+               "The body of the function.  We represent this as an ordinary statement,
+                but it must follow certain rules as outlined in 10.4.4, e.g.,
+                it cannot have any time controls, cannot enable tasks, cannot
+                have non-blocking assignments, etc.")
+
+   (atts       vl-atts-p
+               "Any attributes associated with this function declaration.")
+
+   (loc        vl-location-p
+               "Where this declaration was found in the source code."))
 
   :long "<p>Functions are described in Section 10.4 of the standard.  An
 example of a function is:</p>
@@ -4358,72 +4193,7 @@
 })
 
 <p>Note that functions don't have any inout or output ports.  Instead, you
-assign to a function's name to indicate its return value.</p>
-
-<h3>Representation of Functions</h3>
-
-<p>The @('name') is a string that names the function, e.g.,
-@('\"lower_bits\"').</p>
-
-<p>The @('automaticp') flag says whether the @('automatic') keyword was
-provided.  This keyword indicates that the function should be reentrant and
-have its local parameters dynamically allocated for each function call, with
-various consequences.</p>
-
-<p>The @('rtype') is a @(see vl-taskporttype-p) that describes the return type
-of the function, e.g., a function might return an ordinary unsigned or signed
-result of some width, or might return a @('real') value, etc.  For instance,
-the return type of @('lower_bits') is @(':vl-unsigned').</p>
-
-<p>The @('rrange') is a @(see vl-maybe-range-p) that describes the width of the
-function's result.  This only makes sense when the @('rtype') is
-@(':vl-unsigned') or @(':vl-signed').  For instance, the return range of
-@('lower_bits') is @('[7:0]').</p>
-
-<p>The @('inputs') are the arguments to the function, e.g., @('input [7:0] a')
-above.  We represent these inputs as an @(see vl-taskportlist-p).  There are a
-couple of things to note here:</p>
-
-<ul>
-
-<li>Functions must have at least one input.  We check this in our parser, but
-we don't syntactically enforce this requirement in the @('vl-fundecl-p')
-structure.</li>
-
-<li>Functions only have inputs (i.e., they don't have outputs or inouts), but
-our @(see vl-taskport-p) structures have a direction.  This direction should
-always be @(':vl-input') for a function's input.  We again check this in our
-parser, but not in the @('vl-fundecl-p') structure itself.</li>
-
-</ul>
-
-<p>The @('decls') are the local variable declarations for the function, e.g.,
-the declarations of @('lowest_pair') and @('next_lowest_pair') above.  We
-represent the declarations as an ordinary @(see vl-blockitemlist-p), and it
-appears that it may even contain event declarations, parameter declarations,
-etc., which seems pretty absurd.</p>
-
-<p>The @('body') is a @(see vl-stmt-p) that gives the body of the function.  We
-represent this as an ordinary statement, but it must follow certain rules as
-outlined in 10.4.4, e.g., it cannot have any time controls, cannot enable
-tasks, cannot have non-blocking assignments, etc.</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with this
-function.  The attributes come before the @('function') keyword.</p>
-
-<p>The @('loc') is the @(see vl-location-p) where the @('function') keyword was
-found in the source code.</p>"
-
-  ;; :rest
-  ;; ((defthm acl2-count-of-vl-fundecl->body
-  ;;    (and (<= (acl2-count (vl-fundecl->body x))
-  ;;             (acl2-count x))
-  ;;         (implies (consp x)
-  ;;                  (< (acl2-count (vl-fundecl->body x))
-  ;;                     (acl2-count x))))
-  ;;    :hints(("Goal" :in-theory (enable vl-fundecl->body)))
-  ;;    :rule-classes ((:rewrite) (:linear)))))
-  )
+assign to a function's name to indicate its return value.</p>")
 
 (deflist vl-fundecllist-p (x)
   (vl-fundecl-p x)
@@ -4439,27 +4209,41 @@
 
 
 (defaggregate vl-taskdecl
-  (name automaticp ports decls body atts loc)
-  :tag :vl-taskdecl
-  :legiblep nil
-  :require ((stringp-of-vl-taskdecl->name
-             (stringp name)
-             :rule-classes :type-prescription)
-            (booleanp-of-vl-taskdecl->automaticp
-             (booleanp automaticp)
-             :rule-classes :type-prescription)
-            (vl-taskportlist-p-of-vl-taskdecl->ports
-             (vl-taskportlist-p ports))
-            (vl-blockitemlist-p-of-vl-taskdecl->decls
-             (vl-blockitemlist-p decls))
-            (vl-stmt-p-of-vl-taskdecl->body
-             (vl-stmt-p body))
-            (vl-atts-p-of-vl-taskdecl->atts
-             (vl-atts-p atts))
-            (vl-location-p-of-vl-taskdecl->loc
-             (vl-location-p loc)))
   :parents (modules)
   :short "Representation of a single Verilog task."
+  :tag :vl-taskdecl
+  :legiblep nil
+
+  ((name       stringp
+               :rule-classes :type-prescription
+               "The name of this task.")
+
+   (automaticp booleanp
+               :rule-classes :type-prescription
+               "Says whether the @('automatic') keyword was provided.  This
+                keyword indicates that each invocation of the task has its own
+                copy of its variables.  For instance, the task below had
+                probably better be automatic if it there are going to be
+                concurrent instances of it running, since otherwise @('temp')
+                could be corrupted by the other task.")
+
+   (ports      vl-taskportlist-p
+               "The input, output, and inout ports for the task.")
+
+   (decls      vl-blockitemlist-p
+               "Any local declarations for the task, e.g., for the task below,
+                the declaration of @('temp') would be found here.")
+
+   (body       vl-stmt-p
+               "The statement that gives the actions for this task, i.e., the
+                entire @('begin/end') statement in the below task.")
+
+   (atts       vl-atts-p
+               "Any attributes associated with this task declaration.")
+
+   (loc        vl-location-p
+               "Where this task was found in the source code."))
+
   :long "<p>Tasks are described in Section 10.2 of the standard.  An example
 of a task is:</p>
 
@@ -4483,33 +4267,7 @@
 
 <p>Tasks are somewhat like <see topic='@(url vl-fundecl-p)'>functions</see>,
 but they can have fewer restrictions, e.g., they can have multiple outputs, can
-include delays, etc.</p>
-
-<h3>Representation of Tasks</h3>
-
-<p>The @('name') is a string that names the function, e.g.,
-@('\"dostuff\"').</p>
-
-<p>The @('automaticp') flag says whether the @('automatic') keyword was
-provided.  This keyword indicates that each invocation of the task has its own
-copy of its variables.  For instance, the task above had probably better be
-automatic if it there are going to be concurrent instances of it running, or
-else @('temp') could be corrupted by the other task.</p>
-
-<p>The @('ports') of the task are a @(see vl-taskportlist-p) that says what the
-inputs, outputs, and inouts of the task are.</p>
-
-<p>The @('decls') are a @(see vl-blockitemlist-p) with the local declarations
-for the task, e.g., the declaration of @('temp') would be found here.</p>
-
-<p>The @('body') is a @(see vl-stmt-p) that gives the body of the function.  We
-represent this as an ordinary statement.</p>
-
-<p>The @('atts') are any attributes (see @(see vl-atts-p)) associated with this
-task.  The attributes come before the @('task') keyword.</p>
-
-<p>The @('loc') is the @(see vl-location-p) where the @('task') keyword was
-found in the source code.</p>")
+include delays, etc.</p>")
 
 (deflist vl-taskdecllist-p (x)
   (vl-taskdecl-p x)
@@ -4525,178 +4283,111 @@
 
 
 (defaggregate vl-module
-  (name
-   params
-   ports
-   portdecls
-   assigns
-   netdecls
-   vardecls
-   regdecls
-   eventdecls
-   paramdecls
-   fundecls
-   taskdecls
-   modinsts
-   gateinsts
-   alwayses
-   initials
-   atts
-   minloc
-   maxloc
-   origname
-   warnings
-   comments
-   esim
-   )
-  :tag :vl-module
-  :legiblep nil
-  :require
-  ((stringp-of-vl-module->name
-    (stringp name)
-    :rule-classes :type-prescription)
-
-   ;; BOZO add params?
-   (vl-portlist-p-of-vl-module->ports           (vl-portlist-p ports))
-   (vl-portdecllist-p-of-vl-module->portdecls   (vl-portdecllist-p portdecls))
-   (vl-assignlist-p-of-vl-module->assigns       (vl-assignlist-p assigns))
-   (vl-netdecllist-p-of-vl-module->netdecls     (vl-netdecllist-p netdecls))
-   (vl-vardecllist-p-of-vl-module->vardecls     (vl-vardecllist-p vardecls))
-   (vl-regdecllist-p-of-vl-module->regdecls     (vl-regdecllist-p regdecls))
-   (vl-eventdecllist-p-of-vl-module->eventdecls (vl-eventdecllist-p eventdecls))
-   (vl-paramdecllist-p-of-vl-module->paramdecls (vl-paramdecllist-p paramdecls))
-   (vl-fundecllist-p-of-vl-module->fundecls     (vl-fundecllist-p fundecls))
-   (vl-taskdecllist-p-of-vl-module->taskdecls   (vl-taskdecllist-p taskdecls))
-   (vl-modinstlist-p-of-vl-module->modinsts     (vl-modinstlist-p modinsts))
-   (vl-gateinstlist-p-of-vl-module->gateinsts   (vl-gateinstlist-p gateinsts))
-   (vl-alwayslist-p-of-vl-module->alwayses      (vl-alwayslist-p alwayses))
-   (vl-initiallist-p-of-vl-module->initials     (vl-initiallist-p initials))
-   (vl-atts-p-of-vl-module->atts                (vl-atts-p atts))
-   (vl-location-p-of-vl-module->minloc          (vl-location-p minloc))
-   (vl-location-p-of-vl-module->maxloc          (vl-location-p maxloc))
-
-   (stringp-of-vl-module->origname
-    (stringp origname)
-    :rule-classes :type-prescription)
-
-   (vl-warninglist-p-of-vl-module->warnings     (vl-warninglist-p warnings))
-   (vl-commentmap-p-of-vl-module->comments      (vl-commentmap-p comments))
-   )
   :parents (modules)
   :short "Representation of a single module."
+  :tag :vl-module
+  :legiblep nil
 
-  :long "<p>This is our representation for a single module.  There are
-many fields.</p>
-
-<h4>Semantically Meaningful Fields</h4>
-
-<p>The @('name') is the name of this module as a string.  The name is used to
-instantiate this module, so generally we require that modules in our list have
-unique names.  A module's name is initially set when it is parsed, but is not
-guaranteed to remain fixed throughout simplification.  In particular, it is
-currently changed during @(see unparameterization), e.g., a module named
-@('adder') may be renamed to @('adder$size=12').  We may also wish to change
-module names it in other, future transformations.</p>
-
-<h5>Ports and Parameters</h5>
-
-<p>The @('ports') are a list of @(see vl-port-p) objects that describe the
-module's ports, i.e., @('a'), @('b'), and @('c') in @('module
-mod(a,b,c);').</p>
-
-<p>The @('portdecls') are a list of @(see vl-portdecl-p) objects that describe
-the input, output, and inout declarations for this module, e.g., @('input [3:0]
-a;').</p>
-
-<p>The @('paramdecls') are a list of @(see vl-paramdecl-p) objects that
-describe all of the parameter declarations for this module, e.g., @('parameter
-width = 1;').</p>
-
-
-<h5>Other Declarations</h5>
-
-<p>The @('netdecls') are a list of @(see vl-netdecl-p) objects that describe
-all of the wire declarations such as @('wire [3:0] w;') and @('tri v;').  Note
-that registers and variables (integer, real, ...)  are kept separately.</p>
-
-<p>The @('regdecls') are a list of @(see vl-regdecl-p) objects that describe
-all register declarations like @('reg [3:0] r;').</p>
-
-<p>The @('vardecls') are a list of @(see vl-vardecl-p) objects that describe
-all variable declarations like @('integer i;') and @('real foo;').</p>
-
-<p>The @('eventdecls') are a list of @(see vl-eventdecl-p) objects that
-describe any events for the module.</p>
-
-<p>The @('fundecls') are a list of @(see vl-fundecl-p) objects that describe
-any functions for the module.</p>
-
-
-
-<h5>Assignments and Instances</h5>
-
-<p>The @('assigns') are a list of @(see vl-assign-p) objects that describe the
-continuous assignments in this module, e.g., @('assign lhs = rhs;').</p>
-
-<p>The @('modinsts') are a list of @(see vl-modinst-p) objects that describe
-all submodule (or user-defined primitive) instances in this module, e.g.,
-@('adder my_adder1 (...);').</p>
-
-<p>The @('gateinsts') are a list of @(see vl-gateinst-p) objects that describe
-any primitive gate instances in this module, e.g., @('and (o, a, b);').</p>
-
-
-<h5>Statements</h5>
-
-<p>The @('alwayses') are a list of @(see vl-always-p) objects that describe any
-@('always') statements found in the module.</p>
-
-<p>The @('initials') are a list of @(see vl-initial-p) objects that describe
-any @('initial') statements found in the module.</p>
-
-
-<h5>Miscellaneous</h5>
-
-<p>The @('params') are any @('defparam') statements found in the module.  BOZO
-eventually provide better support for this and document the structure of these
-defparams.</p>
-
-<p>The @('warnings') for a module is an @(see warnings) accumulator that stores
-any problems we have with this module.  Warnings are semantically meaningful
-only in that any <i>fatal</i> warning indicates the module is invalid and
-should not be discarded.  The list of warnings may be extended by any
-transformation or well-formedness check.</p>
-
-
-<h4>Semantically Irrelevant Fields</h4>
-
-<p>The @('origname') of a module is its original name in the source code (a
-string).  It is set at parse-time, and is expected to remain fixed throughout
-all simplifications.  That is, while a module named @('adder') might be renamed
-to @('adder$size=12') during unparameterization, its origname will always be
-@('adder').  The @('origname') is only intended to be used for display purposes
-such as hyperlinking.</p>
-
-<p>The @('minloc') and @('maxloc') fields are @(see vl-location-p) objects that
-describe the locations of the @('module') and @('endmodule') keywords that we
-encountered when parsing this module.  These fields remain fixed throughout the
-simplification process, and are mainly useful for displaying the module.</p>
-
-<p>The @('atts') are a @(see vl-atts-p) object for any @('(* ... *)')-style
-attributes associated with this module.  This list is initially set at parse
-time, and may be consulted or extended by transformations.</p>
-
-<p>The @('comments') field is a @(see vl-commentmap-p) that maps locations to
-source-code comments that occurred in this module.  We expect that comments are
-never consulted for any semantic content, and this field is mainly intended for
-displaying the transformed module with comments preserved.</p>
-
-
-<h4>Fields for E Translation</h4>
-
-<p>The @('esim') field is a temporary/historic artifact used in the translation
-to @(see esim).  This is in flux so I'm not going to document it right
-now.</p>")
+  ((name       stringp
+               :rule-classes :type-prescription
+               "The name of this module as a string.  The name is used to
+                instantiate this module, so generally we require that modules
+                in our list have unique names.  A module's name is initially
+                set when it is parsed, but it may not remain fixed throughout
+                simplification.  For instance, during @(see unparameterization)
+                a module named @('adder') might become @('adder$size=12').")
+
+   (params     "Any @('defparam') statements for this module.  BOZO these are
+                bad form anyway, but eventually we should provide better
+                support for them and proper structures.")
+
+   (ports      vl-portlist-p
+               "The module's ports list, i.e., @('a'), @('b'), and @('c') in
+                @('module mod(a,b,c);').")
+
+   (portdecls  vl-portdecllist-p
+               "The input, output, and inout declarations for this module,
+                e.g., @('input [3:0] a;').")
+
+   (netdecls   vl-netdecllist-p
+               "Wire declarations like @('wire [3:0] w;') and @('tri v;').
+                Does not include registers and variables (integer, real,
+                ...).")
+
+   (vardecls   vl-vardecllist-p
+               "Variable declarations like @('integer i;') and @('real
+               foo;').")
+
+   (regdecls   vl-regdecllist-p
+               "Register declarations like @('reg [3:0] r;').")
+
+   (eventdecls vl-eventdecllist-p
+               "Event declarations like @('event foo ...')")
+
+   (paramdecls vl-paramdecllist-p
+               "The parameter declarations for this module, e.g., @('parameter
+                width = 1;').")
+
+   (fundecls   vl-fundecllist-p
+               "Function declarations like @('function f ...').")
+
+   (taskdecls  vl-taskdecllist-p
+               "Task declarations, e.g., @('task foo ...').")
+
+   (assigns    vl-assignlist-p
+               "Top-level continuous assignments like @('assign lhs = rhs;').")
+
+   (modinsts   vl-modinstlist-p
+               "Instances of modules and user-defined primitives, e.g.,
+                @('adder my_adder1 (...);').")
+
+   (gateinsts  vl-gateinstlist-p
+               "Instances of primitive gates, e.g., @('and (o, a, b);').")
+
+   (alwayses   vl-alwayslist-p
+               "Always blocks like @('always @(posedge clk) ...').")
+
+   (initials   vl-initiallist-p
+               "Initial blocks like @('initial begin ...').")
+
+   (atts       vl-atts-p
+               "Any attributes associated with this top-level module.")
+
+   (minloc     vl-location-p
+               "Where we found the @('module') keyword for this module, i.e.,
+                the start of this module's source code.")
+
+   (maxloc     vl-location-p
+               "Where we found the @('endmodule') keyword for this module, i.e.,
+                the end of this module's source code.")
+
+   (origname   stringp
+               :rule-classes :type-prescription
+               "Original name of the module from parse time.  Unlike the
+                module's @('name'), this is meant to remain fixed throughout
+                all simplifications.  That is, while a module named @('adder')
+                might be renamed to @('adder$size=12') during @(see
+                unparameterization), its origname will always be @('adder').
+                The @('origname') is only intended to be used for display
+                purposes such as hyperlinking.")
+
+   (warnings   vl-warninglist-p
+               "A @(see warnings) accumulator that stores any problems we have
+                with this module.  Warnings are semantically meaningful only in
+                that any <i>fatal</i> warning indicates the module is invalid
+                and should not be discarded.  The list of warnings may be
+                extended by any transformation or well-formedness check.")
+
+   (comments   vl-commentmap-p
+               "A map from locations to source-code comments that occurred in
+                this module.  We expect that comments are never consulted for
+                any semantic meaning.  This field is mainly intended for
+                displaying the transformed module with comments preserved,
+                e.g., see @(see vl-ppc-module).")
+
+   (esim       "This is meant to be @('nil') until @(see esim) conversion, at
+                which point it becomes the E module corresponding to this
+                VL module.")))
 
 (deflist vl-modulelist-p (x)
   (vl-module-p x)
@@ -4704,7 +4395,7 @@
   :parents (modules))
 
 (defthm vl-module-identity
-  ;; This is occaisonally useful when we want to prove that some optimized
+  ;; This is occasionally useful when we want to prove that some optimized
   ;; version of a transform, that doesn't re-cons the module, is equivalent to
   ;; the naive version that does.
   (implies (vl-module-p x)
@@ -4716,8 +4407,9 @@
           :in-theory (union-theories
                       (union-theories (current-theory :here)
                                       '(vl-module-p vl-module))
-                      (b* ((fields (cutil::get-aggregate-fields 'vl-module world)))
-                        (cutil::da-accessor-names 'vl-module fields))))))
+                      (b* (((cutil::agginfo agg)
+                            (cutil::get-aggregate 'vl-module world)))
+                          (cutil::da-accessor-names 'vl-module agg.fields))))))
 
 (define vl-module->hands-offp ((x vl-module-p))
   :inline t
diff -Nru acl2-6.2/books/centaur/vl/portcullis.acl2 acl2-6.3/books/centaur/vl/portcullis.acl2
--- acl2-6.2/books/centaur/vl/portcullis.acl2	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/portcullis.acl2	2013-09-30 17:53:10.000000000 +0000
@@ -20,6 +20,11 @@
 
 (in-package "ACL2")
 (ld "package.lsp")
-(ld "other-packages.lsp")
+(ld "data-structures/define-u-package.lsp" :dir :system)
+(ld "tools/flag-package.lsp" :dir :system)
+(ld "cowles/packages.lsp" :dir :system)
+(include-book "str/portcullis" :dir :system)
+(include-book "xdoc/portcullis" :dir :system)
+(include-book "centaur/getopt/portcullis" :dir :system)
 ; cert-flags: ? t :ttags :all
-(certify-book "portcullis" ? t :ttags :all)
+
diff -Nru acl2-6.2/books/centaur/vl/portcullis.lisp acl2-6.3/books/centaur/vl/portcullis.lisp
--- acl2-6.2/books/centaur/vl/portcullis.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/portcullis.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -26,7 +26,6 @@
 
 (include-book "tools/safe-case" :dir :system)
 (include-book "xdoc/top" :dir :system)
-(include-book "clause-processors/autohide" :dir :system)
 (include-book "tools/rulesets" :dir :system)
 
 (defmacro VL::case (&rest args)
diff -Nru acl2-6.2/books/centaur/vl/primitives.lisp acl2-6.3/books/centaur/vl/primitives.lisp
--- acl2-6.2/books/centaur/vl/primitives.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/primitives.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -362,8 +362,8 @@
 endmodule
 })
 
-<p>VL takes this as a primitive.  It is used by our @(see assigndelays)
-transform to separate delays from assignment statements.</p>
+<p>VL takes this as a primitive.  It is used by our @(see delayredux) transform
+to separate delays from assignment statements.</p>
 
 <p>The corresponding @(see esim) primitive is @(see acl2::*esim-del*), but note
 that esim really has no notion of delays and this ends up being equivalent to
@@ -766,9 +766,9 @@
    1     z    |    z           z     z    |    x
 })
 
-<p>The corresponding @(see esim) primitive is @(see *esim-tri*), which drives
-its output to @('(tristate sel a)'); see @(see 4v-tristate).  This matches the
-Verilog truth table exactly.</p>")
+<p>The corresponding @(see esim) primitive is @(see acl2::*esim-tri*), which
+drives its output to @('(tristate sel a)'); see @(see acl2::4v-tristate).  This
+matches the Verilog truth table exactly.</p>")
 
 (defconsts *vl-1-bit-zmux*
   (b* ((name "VL_1_BIT_ZMUX")
@@ -1102,4 +1102,4 @@
 (vl-pps-module *vl-1-bit-resolve-wire*)
 (vl-pps-module *vl-1-bit-resolve-wor*)
 
-||#
\ No newline at end of file
+||#
diff -Nru acl2-6.2/books/centaur/vl/simpconfig.lisp acl2-6.3/books/centaur/vl/simpconfig.lisp
--- acl2-6.2/books/centaur/vl/simpconfig.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/simpconfig.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -26,7 +26,11 @@
   :short "Options for how to simplify Verilog modules."
   :tag :vl-simpconfig
 
-  ((problem-mods string-listp
+  ((compress-p   booleanp
+                 "Hons the modules at various points.  This takes some time,
+                  but can produce smaller translation files.")
+
+   (problem-mods string-listp
                  "Names of modules that should thrown out, perhaps because they
                   cause some kind of problems."
                  :default nil)
diff -Nru acl2-6.2/books/centaur/vl/toe/toe-add-res-modules.lisp acl2-6.3/books/centaur/vl/toe/toe-add-res-modules.lisp
--- acl2-6.2/books/centaur/vl/toe/toe-add-res-modules.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/toe/toe-add-res-modules.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -260,11 +260,12 @@
 
 (defsection vl-make-res-sexpr
   :parents (vl-make-res-occs)
-  :short "Generate a @(see 4v-res) expression to resolve a list of emodwires."
+  :short "Generate a @(see acl2::4v-res) expression to resolve a list of
+emodwires."
 
   :long "<p>@(call vl-make-res-sexpr) generates a <see topic='@(url
-4v-sexprs)'>4v-sexpr</see> that joins together all of its arguments with @(url
-4v-res) operations.</p>
+acl2::4v-sexprs)'>4v-sexpr</see> that joins together all of its arguments with
+@(see acl2::4v-res) operations.</p>
 
 <p>Note that the RES operation is commutative and associative, so any nest of
 RES operations is equivalent.  So, we just resolve the arguments in a
diff -Nru acl2-6.2/books/centaur/vl/toe/toe-emodwire.lisp acl2-6.3/books/centaur/vl/toe/toe-emodwire.lisp
--- acl2-6.2/books/centaur/vl/toe/toe-emodwire.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/toe/toe-emodwire.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -64,17 +64,16 @@
 on the expression-slicing code.</p>")
 
 
-#!ACL2
 (local (defthm equal-of-string-and-nil-string
          (implies (force (stringp str))
                   (equal (equal str "NIL")
-                         (equal (coerce str 'list)
+                         (equal (explode str)
                                 '(#\N #\I #\L))))
          :hints(("Goal"
-                 :in-theory (disable equal-of-coerce-lists)
-                 :use ((:instance equal-of-coerce-lists
-                                  (x str)
-                                  (y "NIL")))))))
+                 :in-theory (disable str::equal-of-explodes)
+                 :use ((:instance str::equal-of-explodes
+                                  (acl2::x str)
+                                  (acl2::y "NIL")))))))
 
 #!ACL2
 (local (defthm intern-in-package-of-symbol-not-nil
@@ -94,9 +93,9 @@
                   (member-equal a (make-character-list chars)))
          :hints(("Goal" :in-theory (enable make-character-list)))))
 
-(local (defthm coerce-is-not-nil-bracket-char
+(local (defthm implode-is-not-nil-bracket-char
          (implies (member #\[ chars)
-                  (not (equal (coerce chars 'string) "NIL")))
+                  (not (equal (implode chars) "NIL")))
          :hints(("Goal"
                  :in-theory (disable member-of-make-character-list)
                  :use ((:instance member-of-make-character-list
@@ -126,9 +125,9 @@
             :hints(("Goal" :in-theory (enable str::natchars)))))
 
    (defthm no-specials-in-natstr
-     (and (not (member-equal #\! (coerce (natstr x) 'list)))
-          (not (member-equal #\. (coerce (natstr x) 'list)))
-          (not (member-equal #\/ (coerce (natstr x) 'list))))
+     (and (not (member-equal #\! (explode (natstr x))))
+          (not (member-equal #\. (explode (natstr x))))
+          (not (member-equal #\/ (explode (natstr x)))))
      :hints(("Goal" :in-theory (enable natstr))))))
 
 
@@ -405,18 +404,18 @@
     ;; this in a separate function to minimize expansion from inlining the main
     ;; function.
     (declare (type string x))
-    (b* ((chars   (coerce x 'list))
+    (b* ((chars   (explode x))
          (encoded (vl-emodwire-encode-chars chars)))
-      (coerce encoded 'string)))
+      (implode encoded)))
 
   (defund vl-emodwire-decode-aux (x)
     ;; Slow. We don't expect this to ever really be called in practice.  We keep
     ;; this in a separate function to minimize expansion from inlining the main
     ;; function.
     (declare (type string x))
-    (b* ((chars   (coerce x 'list))
+    (b* ((chars   (explode x))
          (decoded (vl-emodwire-decode-chars chars)))
-      (coerce decoded 'string)))
+      (implode decoded)))
 
   (local (in-theory (enable vl-emodwire-encode-aux
                             vl-emodwire-decode-aux)))
@@ -565,17 +564,16 @@
 
 (defsection vl-emodwire-encode-nil
 
-  #!ACL2
   (local (defthm l0
            (implies (force (stringp str))
                     (equal (equal str "NIL")
-                           (equal (coerce str 'list)
+                           (equal (explode str)
                                   '(#\N #\I #\L))))
            :hints(("Goal"
-                   :in-theory (disable equal-of-coerce-lists)
-                   :use ((:instance equal-of-coerce-lists
-                                    (x str)
-                                    (y "NIL")))))))
+                   :in-theory (disable str::equal-of-explodes)
+                   :use ((:instance str::equal-of-explodes
+                                    (acl2::x str)
+                                    (acl2::y "NIL")))))))
 
   (defthm vl-emodwire-encode-nil
     (implies (stringp x)
@@ -587,7 +585,7 @@
 
   (defthm vl-emodwire-encode-nil-alt
     (implies (stringp x)
-             (equal (equal (coerce (vl-emodwire-encode x) 'list) '(#\N #\I #\L))
+             (equal (equal (explode (vl-emodwire-encode x)) '(#\N #\I #\L))
                     (equal x "NIL")))
     :hints(("Goal"
             :in-theory (enable vl-emodwire-encode
@@ -777,7 +775,7 @@
           (vl-emodwire-scan name))
          ((when (or illegal
                     (and escape
-                         (not (vl-emodwire-encoding-valid-p (coerce name 'list))))))
+                         (not (vl-emodwire-encoding-valid-p (explode name))))))
           ;; Improper escaping
           nil)
          ((when (and (not open) (not close)))
@@ -1143,11 +1141,11 @@
        :hints(("Goal" :in-theory (enable vl-emodwire-p
                                          vl-emodwire->basename-without-decoding))))
 
-     (local (defthm equal-with-coerce-string
+     (local (defthm equal-with-implode
               (implies (and (stringp x)
                             (character-listp y))
-                       (equal (equal x (coerce y 'string))
-                              (equal (coerce x 'list) y)))))
+                       (equal (equal x (implode y))
+                              (equal (explode x) y)))))
 
      (local (defthm equal-with-append-take-self
               (equal (equal x (append (take n x) y))
@@ -1183,7 +1181,7 @@
                                 len
                                 nth)
                                (acl2::consp-under-iff-when-true-listp
-                                acl2::coerce-list-under-iff)))))))
+                                str::explode-under-iff)))))))
 
 ; Reduction 3.  Because of the restrictions made in vl-emodwire-p on the name,
 ; there aren't any special characters except perhaps for { in the basename
@@ -1222,7 +1220,7 @@
         (defthm f2
           (implies (vl-emodwire-p x)
                    (vl-emodwire-encoding-valid-p
-                    (coerce (vl-emodwire->basename-without-decoding x) 'list)))
+                    (explode (vl-emodwire->basename-without-decoding x))))
           :hints(("Goal" :in-theory (enable vl-emodwire-p
                                             vl-emodwire->basename-without-decoding
                                             subseq subseq-list))))))
@@ -1232,7 +1230,7 @@
      (local
       (defthm f3
         (implies (vl-emodwire-p x)
-                 (let ((start (coerce (vl-emodwire->basename-without-decoding x) 'list)))
+                 (let ((start (explode (vl-emodwire->basename-without-decoding x))))
                    (and (not (member-equal #\[ start))
                         (not (member-equal #\] start))
                         (not (member-equal #\. start))
@@ -1257,8 +1255,8 @@
                                 vl-emodwire-decode-chars-identity
                                 equal-of-vl-emodwire-decode-chars))
                :use ((:instance equal-of-vl-emodwire-decode-chars
-                                (x (coerce (vl-emodwire->basename-without-decoding x) 'list))
-                                (y (coerce (vl-emodwire->basename-without-decoding y) 'list)))))))))
+                                (x (explode (vl-emodwire->basename-without-decoding x)))
+                                (y (explode (vl-emodwire->basename-without-decoding y))))))))))
 
 
 ; Chaining it all together we see that emodwires are equal when when their
diff -Nru acl2-6.2/books/centaur/vl/toe/toe-wirealist.lisp acl2-6.3/books/centaur/vl/toe/toe-wirealist.lisp
--- acl2-6.2/books/centaur/vl/toe/toe-wirealist.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/toe/toe-wirealist.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -243,7 +243,7 @@
 true and false functions.  These wires no longer have a special meaning in
 ESIM, but throughout VL our notion of emodwires still assumes that T and F
 stand for constant true and false, and, e.g., we still rely on this in @(see
-make-esim).  We might eventually get away from this by using a transform
+e-conversion).  We might eventually get away from this by using a transform
 analagous to @(see weirdint-elim) to introduce T/F wires and eliminate
 constants.</p>
 
@@ -277,11 +277,11 @@
                          (stringp name))
                     (equal (equal x name)
                            (and (stringp x)
-                                (equal (coerce x 'list) (coerce name 'list)))))
+                                (equal (explode x) (explode name)))))
            :hints(("Goal"
-                   :in-theory (disable acl2::coerce-inverse-2)
-                   :use ((:instance acl2::coerce-inverse-2 (acl2::x x))
-                         (:instance acl2::coerce-inverse-2 (acl2::x name)))))))
+                   :in-theory (disable str::implode-of-explode)
+                   :use ((:instance str::implode-of-explode (str::x x))
+                         (:instance str::implode-of-explode (str::x name)))))))
 
   (local (defthm open-equal-len
            (implies (syntaxp (quotep n))
@@ -304,7 +304,8 @@
   (local (in-theory (enable len)))
 
   (definlined vl-plain-wire-name (name)
-    (declare (xargs :guard (stringp name)))
+    (declare (xargs :guard (stringp name)
+                    :guard-hints(("Goal" :in-theory (disable str::explode-under-iff)))))
     (mbe :logic
          (cond ((equal name "T")
                 (make-vl-emodwire :basename "T" :index 0))
@@ -1312,7 +1313,8 @@
   (defthm true-listp-of-vl-msb-constint-bitlist-1
     (implies (true-listp warnings)
              (true-listp (mv-nth 1 (vl-msb-constint-bitlist x warnings))))
-    :rule-classes :type-prescription)
+    :rule-classes :type-prescription
+    :hints(("Goal" :in-theory (disable (force)))))
 
   (local (defthm vl-emodwirelist-p-of-make-list-ac
            (implies (and (vl-emodwirelist-p ac)
diff -Nru acl2-6.2/books/centaur/vl/top.lisp acl2-6.3/books/centaur/vl/top.lisp
--- acl2-6.2/books/centaur/vl/top.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/top.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -98,7 +98,13 @@
 
 
 (defxdoc vl
-  :short "VL Verilog Toolkit."
+  :parents (hardware-verification)
+  :short "The VL Verilog Toolkit is a large ACL2 library for working with <a
+href='http://en.wikipedia.org/wiki/Verilog'>Verilog</a> source code, developed
+by <a href='http://www.centtech.com/'>Centaur Technology</a>.  It includes a
+Verilog loader and many functions for inspecting and transforming modules, and
+serves as a frontend for many Verilog tools."
+
   :long "<box><p><b>Note</b>: this documentation is mainly a reference manual.
 If you are new to VL, please see @(see getting-started) first.</p></box>")
 
@@ -108,26 +114,26 @@
 
   :long "<h3>Introduction</h3>
 
-<p><b>VL</b> is an <a
-href=\"http://www.cs.utexas.edu/users/moore/acl2/\">ACL2</a> library for
-working with Verilog source code.  It includes:</p>
+<p><b>VL</b> is an @(see acl2::acl2) library for working with <a
+href='http://en.wikipedia.org/wiki/Verilog'>Verilog</a> source code.  It
+includes:</p>
 
 <ul>
  <li>A representation for Verilog @(see modules),</li>
  <li>A @(see loader) for parsing Verilog source code into this representation,</li>
  <li>Utilities for inspecting and analyzing these modules,</li>
- <li>Various transforms that can simplify these modules, and</li>
+ <li>Various @(see transforms) that can simplify these modules, and</li>
  <li>Pretty-printing and other report-generation functions.</li>
 </ul>
 
 <p>The original (and still primary) purpose of VL is to translate Verilog
 modules into E-language modules for formal verification.  E is a comparatively
-simple, hierarchical, register-transfer level hardware description language.
-Because E is still under active development we have not yet released it, but an
-early version is described in the following paper:</p>
+simple, hierarchical, register-transfer level hardware description language;
+see @(see esim).  An early version of E is described in:</p>
 
-<p>Warren A. Hunt, Jr. and Sol Swords.  \"Centaur technology media unit
-verification.  Case study: Floating point addition.\" in Computer Aided
+<p>Warren A. Hunt, Jr. and Sol Swords.  <a
+href='http://dx.doi.org/10.1007/978-3-642-02658-4_28'>Centaur technology media
+unit verification.  Case study: Floating point addition.</a> in Computer Aided
 Verification (CAV '09), June 2009.</p>
 
 <p>Our overall approach to E translation is to apply several Verilog-to-Verilog
@@ -141,21 +147,30 @@
 
 <ul>
 
-<li>We have used it to developed linting tools like @(see use-set) and a more
-powerful linter which is available in @('vl/lint') but is not yet
-documented.</li>
+<li>The publicly available VL @(see kit) is a command-line executable built on
+top of ACL2 and VL, which includes commands for @(see lint)ing Verilog designs,
+converting Verilog modules into a JSON format, and other commands.</li>
 
 <li>We have implemented an equivalence checking tool (which is not yet
-released) that has a unit-based timing model and handles transistor-level
+released) that has a tick-based timing model and handles transistor-level
 constructs.  This tool uses the same parser and most of VL's transforms, but
 also has a couple of additional transformation steps.</li>
 
-<li>We have also used it to implement a web-based \"module browser\" (which
+<li>We have used it to implement a web-based \"module browser\" (which
 will probably not be released since it is very Centaur specific) that lets
 users see the original and translated source code for our modules, and has
 several nice features (e.g., hyperlinks for navigating between wires and
 following wires, and integrated linting and warning/error reporting).</li>
 
+<li>We have used it to implement <i>VL-Mangle</i>, a web-based refactoring
+tool (which will probably not be released because it is hard to distribute).
+To support this tool we also developed the @(see acl2::bridge).  A paper
+describing this tool can be found in: Jared Davis. <a
+href='http://www.cs.utexas.edu/users/jared/publications/2013-doform-embedding/embedding.pdf'>Embedding
+ACL Models in End-User Applications</a>.  In <a
+href='http://www.cs.bham.ac.uk/research/projects/formare/events/aisb2013/'>Do-Form
+2013</a>.  April, 2013, Exeter, UK.</li>
+
 </ul>
 
 <p>We imagine that other users of VL may wish to use it:</p>
@@ -176,9 +191,11 @@
 
 <p>Verilog is a huge language, and VL supports only part of it.</p>
 
-<p>VL is based on our reading of the Verilog-2005 standard, IEEE Std 1364-2005.
-Page and section numbers given throughout the VL documentation are in reference
-to this document.  VL does not have any support for SystemVerilog.</p>
+<p>VL is based on our reading of the <a
+href='http://standards.ieee.org/findstds/standard/1364-2005.html'>Verilog-2005
+standard, IEEE Std 1364-2005</a>.  Page and section numbers given throughout
+the VL documentation are in reference to this document.  VL does not have any
+support for SystemVerilog.</p>
 
 <p>VL's @(see preprocessor) is somewhat incomplete.  It basically just supports
 @('`define') and @('`ifdef')-related stuff and can @('`include') files in the
@@ -885,12 +902,14 @@
   (defmvtypes vl-simplify-main (true-listp true-listp nil)))
 
 
+
 (define vl-simplify
   ((mods "parsed Verilog modules, typically from @(see vl-load)."
          (and (vl-modulelist-p mods)
               (uniquep (vl-modulelist->names mods))))
    (config "various options that govern how to simplify the modules."
            vl-simpconfig-p))
+  :guard-debug t
   :returns
   (mv (mods "modules that we simplified successfully"
             :hyp :fguard
@@ -905,7 +924,29 @@
   :long "<p>This is a high-level routine that applies our @(see transforms) in
 a suitable order to simplify Verilog modules and to produce E modules.</p>"
 
-  (vl-simplify-main (vl-annotate-mods mods) config)
+  (mbe :logic
+       (b* (((mv mods failmods use-set-report)
+             (vl-simplify-main (vl-annotate-mods mods) config)))
+         (mv mods failmods use-set-report))
+       :exec
+       (b* (((vl-simpconfig config) config)
+            (mods (vl-annotate-mods mods))
+            (mods (if config.compress-p
+                      (cwtime (hons-copy mods)
+                              :name compress-annotated-mods)
+                    mods))
+            ((mv mods failmods use-set-report)
+             (vl-simplify-main mods config))
+            (mods (if config.compress-p
+                      (cwtime (hons-copy mods)
+                              :name compress-simplified-mods)
+                    mods))
+            (failmods (if config.compress-p
+                          (cwtime (hons-copy failmods)
+                                  :name compress-failed-mods)
+                        failmods)))
+         (vl-gc)
+         (mv mods failmods use-set-report)))
   ///
   (defmvtypes vl-simplify (true-listp true-listp nil)))
 
@@ -923,7 +964,12 @@
   (b* (((mv loadresult state)
         (cwtime (vl-load loadconfig)))
 
-       ((vl-loadresult loadresult) loadresult)
+       ((vl-loadresult loadresult)
+        (if (vl-simpconfig->compress-p simpconfig)
+            (cwtime (change-vl-loadresult
+                     loadresult :mods (hons-copy (vl-loadresult->mods loadresult)))
+                    :name compress-original-mods)
+          loadresult))
 
        ((mv mods failmods use-set-report)
         (cwtime (vl-simplify loadresult.mods simpconfig)))
@@ -949,6 +995,7 @@
 
        (result (make-vl-translation :mods          mods
                                     :failmods      failmods
+                                    :origmods      loadresult.mods
                                     :filemap       loadresult.filemap
                                     :defines       loadresult.defines
                                     :loadwarnings  loadresult.warnings
@@ -1027,7 +1074,7 @@
                     :name defmodules-fn)))
         (value
          `(with-output
-            :off (summary)
+            :off (summary event)
             (progn (defconst ,name ',translation)
                    (value-triple ',name))))))))
 
diff -Nru acl2-6.2/books/centaur/vl/transforms/cn-hooks.lisp acl2-6.3/books/centaur/vl/transforms/cn-hooks.lisp
--- acl2-6.2/books/centaur/vl/transforms/cn-hooks.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/cn-hooks.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -54,47 +54,6 @@
 
 
 (encapsulate
-  (((vl-modulelist-drop-vcovers-hook *) => *
-    :formals (x)
-    :guard (vl-modulelist-p x)))
-
-  (local (defun vl-modulelist-drop-vcovers-hook (x) x))
-
-  (defthm vl-modulelist-p-of-vl-modulelist-drop-vcovers-hook
-    (implies (force (vl-modulelist-p x))
-             (vl-modulelist-p (vl-modulelist-drop-vcovers-hook x))))
-
-  (defthm vl-modulelist->names-of-vl-modulelist-drop-vcovers-hook
-    (equal (vl-modulelist->names (vl-modulelist-drop-vcovers-hook x))
-           (vl-modulelist->names x))))
-
-(defattach vl-modulelist-drop-vcovers-hook identity)
-
-
-
-
-(encapsulate
-  (((vl-modulelist-verrors-to-guarantees-hook *) => *
-    :formals (x)
-    :guard (vl-modulelist-p x)))
-
-  (local (defun vl-modulelist-verrors-to-guarantees-hook (x) x))
-
-  (defthm vl-modulelist-p-of-vl-modulelist-verrors-to-guarantees-hook
-    (implies (force (vl-modulelist-p x))
-             (vl-modulelist-p (vl-modulelist-verrors-to-guarantees-hook x))))
-
-  (defthm no-duplicatesp-equal-of-vl-modulelist->names-of-vl-modulelist-verrors-to-guarantees-hook
-    (implies (force (no-duplicatesp-equal (vl-modulelist->names x)))
-             (no-duplicatesp-equal
-              (vl-modulelist->names (vl-modulelist-verrors-to-guarantees-hook x))))))
-
-(defattach vl-modulelist-verrors-to-guarantees-hook identity)
-
-
-
-
-(encapsulate
   (((vl-modulelist-pre-toe-hook *) => *
     :formals (x)
     :guard (and (vl-modulelist-p x)
@@ -113,23 +72,3 @@
 (defattach vl-modulelist-pre-toe-hook identity)
 
 
-
-;; (encapsulate
-;;   (((vl-modulelist-esim-trans-hook *) => *
-;;     :formals (x)
-;;     :guard (vl-modulelist-p x)))
-
-;;   (local (defun vl-modulelist-esim-trans-hook (x) x))
-
-;;   (defthm vl-modulelist-p-of-vl-modulelist-esim-trans-hook
-;;     (implies (force (vl-modulelist-p x))
-;;              (vl-modulelist-p (vl-modulelist-esim-trans-hook x))))
-
-;;   (defthm vl-modulelist->names-of-vl-modulelist-esim-trans-hook
-;;     (equal (vl-modulelist->names (vl-modulelist-esim-trans-hook x))
-;;            (vl-modulelist->names x))))
-
-;; (defattach vl-modulelist-esim-trans-hook identity)
-
-
-
diff -Nru acl2-6.2/books/centaur/vl/transforms/occform/add.lisp acl2-6.3/books/centaur/vl/transforms/occform/add.lisp
--- acl2-6.2/books/centaur/vl/transforms/occform/add.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/occform/add.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -105,7 +105,7 @@
 })
 
 <p>This is a basic ripple-carry adder formed by chaining together several
-full-adders; see @(see *vl-1-bit-adder-core*) and @(see vl-make-full-adders).</p>
+full-adders; see @(see *vl-1-bit-adder-core*).</p>
 
 <p>This module does NOT correspond to a full addition in Verilog.  It computes
 something akin to @('assign {cout, sum} = a + b + cin'), but it does not handle
diff -Nru acl2-6.2/books/centaur/vl/transforms/occform/div.lisp acl2-6.3/books/centaur/vl/transforms/occform/div.lisp
--- acl2-6.2/books/centaur/vl/transforms/occform/div.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/occform/div.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -265,7 +265,7 @@
 
 <p>The core modules we produce here do <b>not</b> properly handle zero divides
 or detect X/Z values on the dividend and divisor.  To see how we correct for
-these cases, see @(see vl-make-n-bit-div).</p>
+these cases, see @(see vl-make-n-bit-div-rem).</p>
 
 <p>Aside from these special cases, the core module does produce the right
 answer by chaining together N division steps; for details about these steps and
diff -Nru acl2-6.2/books/centaur/vl/transforms/occform/mul.lisp acl2-6.3/books/centaur/vl/transforms/occform/mul.lisp
--- acl2-6.2/books/centaur/vl/transforms/occform/mul.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/occform/mul.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -128,7 +128,8 @@
 (local (defthm l0
          (implies (vl-exprlist-p x)
                   (iff (car (last x))
-                       (consp x)))))
+                       (consp x)))
+         :hints(("Goal" :in-theory (enable last)))))
 
 (def-vl-modgen vl-make-n-bit-mult (n)
   :short "Generate an multiplier module."
@@ -156,7 +157,7 @@
   :guard (posp n)
   :body
   (b* (((when (= n 1))
-        (list *vl-1-bit-mult*))
+        (list *vl-1-bit-mult* *vl-1-bit-and* *vl-1-bit-xor*))
        (name  (hons-copy (cat "VL_" (natstr n) "_BIT_MULT")))
 
        ((mv o-expr o-port o-portdecl o-netdecl) (vl-occform-mkport "o" :vl-output n))
@@ -206,10 +207,12 @@
                             :minloc    *vl-fakeloc*
                             :maxloc    *vl-fakeloc*)))
 
-    (list* mod (append adder-mods xprop-modules))))
+    (list* mod
+           (cons *vl-1-bit-buf* ;; used in partprod-insts
+                 (append adder-mods xprop-modules)))))
 
 
 #||
 (vl-pps-module *vl-1-bit-mult*)
 (vl-pps-modulelist (vl-make-n-bit-mult 3))
-||#
\ No newline at end of file
+||#
diff -Nru acl2-6.2/books/centaur/vl/transforms/occform/shl.lisp acl2-6.3/books/centaur/vl/transforms/occform/shl.lisp
--- acl2-6.2/books/centaur/vl/transforms/occform/shl.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/occform/shl.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -202,7 +202,8 @@
 (local (defthm l0
          (implies (vl-exprlist-p x)
                   (iff (car (last x))
-                       (consp x)))))
+                       (consp x)))
+         :hints(("Goal" :in-theory (enable last)))))
 
 (local (defthm l1
          (implies (vl-exprlist-p x)
diff -Nru acl2-6.2/books/centaur/vl/transforms/occform/shr.lisp acl2-6.3/books/centaur/vl/transforms/occform/shr.lisp
--- acl2-6.2/books/centaur/vl/transforms/occform/shr.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/occform/shr.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -150,7 +150,8 @@
 (local (defthm l0
          (implies (vl-exprlist-p x)
                   (iff (car (last x))
-                       (consp x)))))
+                       (consp x)))
+         :hints(("Goal" :in-theory (enable last)))))
 
 (local (defthm l1
          (implies (vl-exprlist-p x)
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-argresolve.lisp acl2-6.3/books/centaur/vl/transforms/xf-argresolve.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-argresolve.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-argresolve.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -710,8 +710,8 @@
   (verify-guards vl-gateinst-dirassign
                  :hints(("Goal"
                          :in-theory (e/d (vl-gatetype-p)
-                                         (vl-gatetype-p-of-vl-gateinst->type))
-                         :use ((:instance vl-gatetype-p-of-vl-gateinst->type)))))
+                                         (return-type-of-vl-gateinst->type))
+                         :use ((:instance return-type-of-vl-gateinst->type)))))
 
   (defthm vl-warninglist-p-of-vl-gateinst-dirassign
     (implies (force (vl-warninglist-p warnings))
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-array-indexing.lisp acl2-6.3/books/centaur/vl/transforms/xf-array-indexing.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-array-indexing.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-array-indexing.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -662,24 +662,27 @@
 
 
 
-(defund vl-module-make-array-indexing (x)
-  (declare (xargs :guard (vl-module-p x)))
-  (b* (((vl-module x) x)
-       ((when (vl-module->hands-offp x))
-        x)
-       (names (append (vl-regdecllist-collect-array-names x.regdecls)
-                      (vl-netdecllist-collect-array-names x.netdecls)))
-       ((unless names)
-        x)
-       (fal      (make-lookup-alist names))
-       (warnings x.warnings)
-       ((mv warnings ports)     (vl-portlist-make-array-indexing     x.ports names fal warnings))
-       ((mv warnings assigns)   (vl-assignlist-make-array-indexing   x.assigns names fal warnings))
-       ((mv warnings modinsts)  (vl-modinstlist-make-array-indexing  x.modinsts names fal warnings))
-       ((mv warnings gateinsts) (vl-gateinstlist-make-array-indexing x.gateinsts names fal warnings))
-       ((mv warnings alwayses)  (vl-alwayslist-make-array-indexing   x.alwayses names fal warnings))
-       ((mv warnings initials)  (vl-initiallist-make-array-indexing  x.initials names fal warnings))
-       (- (fast-alist-free fal)))
+(defsection vl-module-make-array-indexing
+  :parents (array-indexing)
+
+  (defund vl-module-make-array-indexing (x)
+    (declare (xargs :guard (vl-module-p x)))
+    (b* (((vl-module x) x)
+         ((when (vl-module->hands-offp x))
+          x)
+         (names (append (vl-regdecllist-collect-array-names x.regdecls)
+                        (vl-netdecllist-collect-array-names x.netdecls)))
+         ((unless names)
+          x)
+         (fal      (make-lookup-alist names))
+         (warnings x.warnings)
+         ((mv warnings ports)     (vl-portlist-make-array-indexing     x.ports names fal warnings))
+         ((mv warnings assigns)   (vl-assignlist-make-array-indexing   x.assigns names fal warnings))
+         ((mv warnings modinsts)  (vl-modinstlist-make-array-indexing  x.modinsts names fal warnings))
+         ((mv warnings gateinsts) (vl-gateinstlist-make-array-indexing x.gateinsts names fal warnings))
+         ((mv warnings alwayses)  (vl-alwayslist-make-array-indexing   x.alwayses names fal warnings))
+         ((mv warnings initials)  (vl-initiallist-make-array-indexing  x.initials names fal warnings))
+         (- (fast-alist-free fal)))
 
       (change-vl-module x
                         :ports ports
@@ -690,16 +693,15 @@
                         :initials initials
                         :warnings warnings)))
 
-(defthm vl-module-p-of-vl-module-make-array-indexing
-  (implies (force (vl-module-p x))
-           (vl-module-p (vl-module-make-array-indexing x)))
-  :hints(("Goal" :in-theory (enable vl-module-make-array-indexing))))
-
-(defthm vl-module->name-of-vl-module-make-array-indexing
-  (equal (vl-module->name (vl-module-make-array-indexing x))
-         (vl-module->name x))
-  :hints(("Goal" :in-theory (enable vl-module-make-array-indexing))))
+  (local (in-theory (enable vl-module-make-array-indexing)))
 
+  (defthm vl-module-p-of-vl-module-make-array-indexing
+    (implies (force (vl-module-p x))
+             (vl-module-p (vl-module-make-array-indexing x))))
+
+  (defthm vl-module->name-of-vl-module-make-array-indexing
+    (equal (vl-module->name (vl-module-make-array-indexing x))
+           (vl-module->name x))))
 
 
 (defprojection vl-modulelist-make-array-indexing (x)
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-blankargs.lisp acl2-6.3/books/centaur/vl/transforms/xf-blankargs.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-blankargs.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-blankargs.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -51,9 +51,9 @@
 
 <p>Unlike @(see drop-blankports) which can be applied at any time after @(see
 argresolve), the blankargs transformation requires that expression sizes have
-been computed (see @(see selfsize) and @(see ctxsize)) since the new wires need
-to have the appropriate size.  We also expect that the @(see replicate) transform
-has been run to ensure that no instances have ranges.</p>")
+been computed (see @(see expression-sizing)) since the new wires need to have
+the appropriate size.  We also expect that the @(see replicate) transform has
+been run to ensure that no instances have ranges.</p>")
 
 
 
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-clean-selects.lisp acl2-6.3/books/centaur/vl/transforms/xf-clean-selects.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-clean-selects.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-clean-selects.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -187,6 +187,7 @@
 
 
 (defsection vl-stmt-clean-selects
+  :parents (clean-selects)
 
   (mutual-recursion
 
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-gate-elim.lisp acl2-6.3/books/centaur/vl/transforms/xf-gate-elim.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-gate-elim.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-gate-elim.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -37,7 +37,7 @@
 
 <p>Ordering notes.  This transform should typically be run after @(see
 gatesplit) and @(see gateredux), and also after other transforms like @(see
-blankargs), @(see expr-sizing), and @(see replicate).</p>
+blankargs), @(see expression-sizing), and @(see replicate).</p>
 
 <p>We only try to deal with non-array instances of gates, with the usual
 arities (i.e., 2 arguments to a NOT or BUF, and 3 arguments to AND, OR, ...).
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-gateredux.lisp acl2-6.3/books/centaur/vl/transforms/xf-gateredux.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-gateredux.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-gateredux.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -425,9 +425,9 @@
    :off :all
    (verify-guards vl-gateinst-gateredux
                   :hints(("Goal"
-                          :use ((:instance VL-GATETYPE-P-OF-VL-GATEINST->TYPE))
+                          :use ((:instance return-type-OF-VL-GATEINST->TYPE))
                           :in-theory (e/d (vl-gatetype-p)
-                                          (VL-GATETYPE-P-OF-VL-GATEINST->TYPE))))))
+                                          (return-type-OF-VL-GATEINST->TYPE))))))
 
   (defthm vl-warninglist-p-of-vl-gateinst-gateredux
     (implies (force (vl-warninglist-p warnings))
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-orig.lisp acl2-6.3/books/centaur/vl/transforms/xf-orig.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-orig.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-orig.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -28,7 +28,7 @@
   :short "Add @('VL_ORIG_EXPR') annotations to some expressions."
 
   :long "<p>In this transformation, we annotate many expressions with their
-@('VL_ORIG_EXPR') attribute (see @(see attributes)).  The idea is to associate
+@('VL_ORIG_EXPR') attribute (see @(see vl-atts-p)).  The idea is to associate
 each expression with its \"original version,\" as it was read from the source
 file, before any simplification has taken place.</p>
 
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-propagate-help.lisp acl2-6.3/books/centaur/vl/transforms/xf-propagate-help.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-propagate-help.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-propagate-help.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -0,0 +1,229 @@
+; VL Verilog Toolkit
+; Copyright (C) 2008-2012 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "VL")
+(include-book "../mlib/find-item")
+(include-book "../mlib/expr-tools")
+(include-book "../mlib/expr-building")
+(include-book "../mlib/expr-slice")
+(local (include-book "../util/arithmetic"))
+
+(defxdoc propagate-help
+  :parents (transforms)
+  :short "Split up assignments to concatenations to assist with @(see propagate)."
+
+  :long "<p>The @(see propagate) transform can get rid of assignments to
+\"intermediate\" wires, but only deals with assignments whose left-hand sides
+are simple identifiers.  This limitation means that, in practice, it can fail
+to carry out the desired propagation when there are assignments like this:</p>
+
+@({
+assign {net0413_4, net0413_3, net0413_2, net0413_1, net0413_0} = spb ;
+})
+
+<p>This is a helper transform that is meant to be run before propagate, in order
+to split up assignments like the above into a form that propagate can process.  The
+idea is to replace assignments like the above with sequences of assignments, e.g.,</p>
+
+@({
+assign net0413_4 = spb[4];
+assign net0413_3 = spb[3];
+assign net0413_2 = spb[2];
+assign net0413_1 = spb[1];
+assign net0413_0 = spb[0];
+})
+
+<p>After this, propagate can presumably eliminate these intermediate nets.</p>
+
+<p>Prerequisites: expressions need to be sized and ranges resolved.  To keep
+things as safe as possible, we only simplify assignments wehre the widths work
+out exactly.</p>")
+
+(local (in-theory (disable all-equalp)))
+
+(local (defthm nat-listp-when-pos-listp
+         ;; BOZO this is probably fine as a tau system rule, find it a home
+         ;; and make it non-local.
+         (implies (pos-listp x)
+                  (nat-listp x))
+         :rule-classes :tau-system
+         :hints(("Goal" :induct (len x)))))
+
+
+(define vl-prophelp-split
+  ((lhs-wires "individual wires from the left-hand side's concatenation"
+              (and (vl-exprlist-p lhs-wires)
+                   (vl-idexprlist-p lhs-wires)
+                   (pos-listp (vl-exprlist->finalwidths lhs-wires))))
+   (rhs-bits  "exploded bits from the right-hand side expression"
+              (and (true-listp rhs-bits)
+                   (vl-exprlist-p rhs-bits)
+                   (all-equalp 1 (vl-exprlist->finalwidths rhs-bits))))
+   (loc       vl-location-p))
+  :guard (equal (sum-nats (vl-exprlist->finalwidths lhs-wires))
+                (len rhs-bits))
+  :returns (assigns vl-assignlist-p :hyp :fguard)
+  :parents (propagate-help)
+  :short "Create an assignment for each individual wire on the left-hand side
+to its associated bits from the right-hand side."
+
+  (b* (((when (atom lhs-wires))
+        nil)
+       (lhs1   (car lhs-wires))
+       (width1 (vl-expr->finalwidth lhs1))
+       (bits1  (take width1 rhs-bits))
+       (rhs1   (make-vl-nonatom :op :vl-concat
+                                :args bits1
+                                :finaltype :vl-unsigned
+                                :finalwidth width1)))
+    (cons (make-vl-assign :lvalue lhs1
+                          :expr rhs1
+                          :loc loc)
+          (vl-prophelp-split (cdr lhs-wires)
+                             (nthcdr width1 rhs-bits)
+                             loc)))
+  :prepwork
+  ((local (defthm l0
+            (implies (all-equalp a (vl-exprlist->finalwidths x))
+                     (all-equalp a (vl-exprlist->finalwidths (nthcdr n x))))
+            :hints(("Goal" :in-theory (enable nthcdr)))))))
+
+
+
+(define vl-prophelp-assign
+  ((x        "assignment to be split up, if it has the right form."
+             vl-assign-p)
+   (mod      "module the assignment occurs in, so we can slice up the rhs."
+             vl-module-p)
+   (ialist   (equal ialist (vl-moditem-alist mod)))
+   (warnings vl-warninglist-p))
+  :returns (mv (warnings vl-warninglist-p :hyp :fguard)
+               (new-x vl-assignlist-p :hyp :fguard))
+  :parents (propagate-help)
+  :short "Maybe split up an assignment."
+  (b* (((vl-assign x) x)
+
+       ((when (vl-fast-atom-p x.lvalue))
+        ;; Not applicable (assigning to an atom, not a concat)
+        (mv warnings (list x)))
+
+       ((vl-nonatom x.lvalue) x.lvalue)
+       ((unless (and (eq x.lvalue.op :vl-concat)
+                     (vl-idexprlist-p x.lvalue.args)
+                     (vl-expr-sliceable-p x.expr)))
+        ;; Not applicable (not a concat, or too hard)
+        (mv warnings (list x)))
+
+       (widths (vl-exprlist->finalwidths x.lvalue.args))
+       ((unless (pos-listp widths))
+        ;; Some width isn't computed, so how would we split it up?  Give up.
+        (mv (warn :type :vl-prophelp-fail
+                  :msg  "~a0: not splitting up assignment because the lhs ~
+                         width is not determined!"
+                  :args (list x))
+            (list x)))
+
+       (lhs-width (sum-nats widths))
+       (rhs-width (vl-expr->finalwidth x.expr))
+       ((unless (eql lhs-width rhs-width))
+        ;; Widths don't agree, so give up; I don't want to think about how to
+        ;; properly do truncations/extensions here.
+        (mv (warn :type :vl-prophelp-fail
+                  :msg "~a0: not splitting up assignment because the lhs/rhs ~
+                        do not have the same width.  Lhs width is ~x1, rhs ~
+                        width is ~x2."
+                  :args (list x lhs-width rhs-width))
+            (list x)))
+
+       ((unless (and (vl-expr-welltyped-p x.lvalue)
+                     (vl-expr-welltyped-p x.expr)))
+        (mv (warn :type :vl-prophelp-fail
+                  :msg "~a0: not splitting up assignment because lhs or rhs ~
+                        is not well-typed."
+                  :args (list x))
+            (list x)))
+
+       ((mv okp warnings rhs-bits)
+        (vl-msb-bitslice-expr x.expr mod ialist warnings))
+       ((unless okp)
+        ;; Somehow failed to split up RHS?  Don't do anything.
+        (mv (warn :type :vl-prophelp-fail
+                  :msg "~a0: not splitting up assignment because we somehow ~
+                        failed to slice its rhs into bits."
+                  :args (list x))
+            (list x)))
+
+       ;; Otherwise, this is looking good.
+       (new-assigns (vl-prophelp-split x.lvalue.args rhs-bits x.loc)))
+    (mv warnings new-assigns))
+  ///
+  (defmvtypes vl-prophelp-assign (nil true-listp)))
+
+
+(define vl-prophelp-assignlist
+  ((x        vl-assignlist-p)
+   (mod      vl-module-p)
+   (ialist   (equal ialist (vl-moditem-alist mod)))
+   (warnings vl-warninglist-p))
+  :returns (mv (warnings vl-warninglist-p :hyp :fguard)
+               (new-x vl-assignlist-p :hyp :fguard))
+  :parents (propagate-help)
+  (b* (((when (atom x))
+        (mv warnings nil))
+       ((mv warnings car) (vl-prophelp-assign (car x) mod ialist warnings))
+       ((mv warnings cdr) (vl-prophelp-assignlist (cdr x) mod ialist warnings)))
+    (mv warnings (append car cdr)))
+  ///
+  (defmvtypes vl-prophelp-assign (nil true-listp)))
+
+
+(define vl-prophelp-module ((x vl-module-p))
+  :returns (new-x vl-module-p :hyp :fguard)
+  :parents (propagate-help)
+  (b* (((vl-module x) x)
+       ((when (vl-module->hands-offp x))
+        x)
+       ((unless x.assigns)
+        ;; Optimization: don't even build the moditem alist unless there are
+        ;; assignments.  We could do better here, i.e., check for an assignment
+        ;; with a concatenation on the lhs, but this is probably good enough.
+        x)
+       (ialist (vl-moditem-alist x))
+       ((mv warnings assigns)
+        (vl-prophelp-assignlist x.assigns x ialist x.warnings)))
+    (fast-alist-free ialist)
+    (change-vl-module x
+                      :assigns assigns
+                      :warnings warnings))
+  ///
+  (defthm vl-module->name-of-vl-prophelp-module
+    (equal (vl-module->name (vl-prophelp-module x))
+           (vl-module->name x))))
+
+(defprojection vl-prophelp-modulelist (x)
+  (vl-prophelp-module x)
+  :guard (vl-modulelist-p x)
+  :result-type vl-modulelist-p)
+
+(defthm vl-modulelist->names-of-vl-prophelp-modulelist
+  (equal (vl-modulelist->names (vl-prophelp-modulelist x))
+         (vl-modulelist->names x))
+  :hints(("Goal" :induct (len x))))
+
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-propagate.lisp acl2-6.3/books/centaur/vl/transforms/xf-propagate.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-propagate.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-propagate.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -181,7 +181,7 @@
   :hints(("Goal" :induct (len x))))
 
 
-(defsection vl-maybe-driven-by-modinsts
+(defsection vl-maybe-driven-by-modinst
   :parents (propagate)
   :short "Approxpimately the wires driven by a module instance (unsound)."
 
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-replicate-insts.lisp acl2-6.3/books/centaur/vl/transforms/xf-replicate-insts.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-replicate-insts.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-replicate-insts.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -610,8 +610,8 @@
 first.</p>
 
 <p>We might fail with a fatal warning if there is some problem with the actual;
-we expect the actual to be already sized, <see url='@(url
-vl-expr-welltyped-p)'>well-typed</see>, and <see url='@(url
+we expect the actual to be already sized, <see topic='@(url
+vl-expr-welltyped-p)'>well-typed</see>, and <see topic='@(url
 expr-slicing)'>sliceable</see>), and its width must be compatible with the
 width of the port, as described in @(see argument-partitioning).</p>"
 
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-sizing.lisp acl2-6.3/books/centaur/vl/transforms/xf-sizing.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-sizing.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-sizing.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -24,6 +24,7 @@
 (include-book "../mlib/context")
 (include-book "../mlib/welltyped")
 (include-book "../mlib/lvalues")
+(local (include-book "clause-processors/autohide" :dir :system))
 (local (include-book "../util/arithmetic"))
 
 
@@ -700,9 +701,9 @@
 
   (verify-guards vl-expr-interesting-size-atoms
     :hints(("Goal"
-            :use ((:instance vl-op-p-of-vl-nonatom->op (x x)))
+            :use ((:instance return-type-of-vl-nonatom->op (x x)))
             :in-theory (e/d (vl-op-p vl-op-arity)
-                            (vl-op-p-of-vl-nonatom->op)))))
+                            (return-type-of-vl-nonatom->op)))))
 
   (defthm-vl-flag-expr-interesting-size-atoms
     (defthm vl-atomlist-p-of-vl-expr-interesting-size-atoms
@@ -1883,12 +1884,12 @@
 
   (encapsulate
     ()
-    (local (in-theory (disable vl-op-p-of-vl-nonatom->op
+    (local (in-theory (disable return-type-of-vl-nonatom->op
                                default-car
                                default-cdr)))
     (verify-guards vl-expr-typedecide-aux
       :hints(("Goal"
-              :use ((:instance vl-op-p-of-vl-nonatom->op)))
+              :use ((:instance return-type-of-vl-nonatom->op)))
              (and stable-under-simplificationp
                   '(:in-theory (enable vl-op-arity vl-op-p)))))))
 
@@ -4282,8 +4283,8 @@
     :hints((and stable-under-simplificationp
                 '(:in-theory (e/d (vl-op-p vl-maybe-natp
                                    (:ruleset basic-arithmetic-rules))
-                                  (vl-op-p-of-vl-nonatom->op))
-                             :use ((:instance vl-op-p-of-vl-nonatom->op)))))))
+                                  (return-type-of-vl-nonatom->op))
+                             :use ((:instance return-type-of-vl-nonatom->op)))))))
 
 
 
diff -Nru acl2-6.2/books/centaur/vl/transforms/xf-unparameterize.lisp acl2-6.3/books/centaur/vl/transforms/xf-unparameterize.lisp
--- acl2-6.2/books/centaur/vl/transforms/xf-unparameterize.lisp	2013-06-06 17:11:41.000000000 +0000
+++ acl2-6.3/books/centaur/vl/transforms/xf-unparameterize.lisp	2013-09-30 17:53:07.000000000 +0000
@@ -1625,6 +1625,8 @@
 
              (progn$
               (cw "; vl-unparameterize: counter exhausted before fixed point reached.~%")
+              (cw "; modules that still have parameters: ~&0"
+                  (vl-modulelist->names withparams))
               (vl-handle-unparam-fail mods)))
 
 
@@ -1636,6 +1638,8 @@
                      (progn$
                       (cw "; vl-unparameterize: fixed point reached with n = ~x0, but ~
                            there are still modules with parameters: ~%" n)
+                      (cw "; modules that still have parameters: ~&0"
+                          (vl-modulelist->names withparams))
                       (vl-handle-unparam-fail mods))
 
                    (mv-let (success-rest fail-rest)
diff -Nru acl2-6.2/books/centaur/vl/translation.lisp acl2-6.3/books/centaur/vl/translation.lisp
--- acl2-6.2/books/centaur/vl/translation.lisp	2013-06-06 17:11:43.000000000 +0000
+++ acl2-6.3/books/centaur/vl/translation.lisp	2013-09-30 17:53:10.000000000 +0000
@@ -40,10 +40,15 @@
                    could not be fully simplified.  Typically each module here
                    will have fatal @(see warnings).")
 
+   (origmods      vl-modulelist-p
+                  "The raw list of unsimplified modules that were found
+                   immediately after parsing.  This can be useful for
+                   pretty-printing and understanding modules.")
+
    (filemap       vl-filemap-p
-                  "Contains the actual Verilog source code that was
-                   read. Occasionally this is useful for understanding warnings
-                   that refer to particular file locations.")
+                  "The actual Verilog source code that was read. Occasionally
+                   this is useful for understanding warnings that refer to
+                   particular file locations.")
 
    (defines       vl-defines-p
                   "Records all of the @('`define') directives that were
@@ -73,7 +78,7 @@
 
 (define vl-translation-has-module ((modname stringp)
                                    (x       vl-translation-p))
-  :parents (translation-p)
+  :parents (vl-translation-p)
   :short "Check whether a module was successfully translated."
 
   :long "<p>The @('modname') should be the desired module's name as a string,
diff -Nru acl2-6.2/books/centaur/vl/util/arithmetic.lisp acl2-6.3/books/centaur/vl/util/arithmetic.lisp
--- acl2-6.2/books/centaur/vl/util/arithmetic.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/arithmetic.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -85,7 +85,7 @@
 (include-book "std/alists/top" :dir :system)
 (include-book "std/typed-lists/top" :dir :system)
 
-(include-book "std/misc/explode-atom" :dir :system)
+(include-book "str/explode-atom" :dir :system)
 
 
 (defun dec-dec-induct (k n)
diff -Nru acl2-6.2/books/centaur/vl/util/bits.lisp acl2-6.3/books/centaur/vl/util/bits.lisp
--- acl2-6.2/books/centaur/vl/util/bits.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/bits.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -82,7 +82,7 @@
   :parents (vl-weirdint-p)
   :short "Get the string corresponding to a @(see vl-bitlist-p)."
 
-  (coerce (vl-bitlist->charlist x) 'string)
+  (implode (vl-bitlist->charlist x))
 
   ///
 
diff -Nru acl2-6.2/books/centaur/vl/util/character-list-listp.lisp acl2-6.3/books/centaur/vl/util/character-list-listp.lisp
--- acl2-6.2/books/centaur/vl/util/character-list-listp.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/character-list-listp.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -73,27 +73,27 @@
 
 
 
-(define coerce-to-chars-list ((x string-listp))
+(define explode-list ((x string-listp))
   :parents (utilities)
   :short "Coerce a list of strings into a @(see character-list-listp)."
 
   (if (atom x)
       nil
-    (cons (coerce (car x) 'list)
-          (coerce-to-chars-list (cdr x))))
+    (cons (explode (car x))
+          (explode-list (cdr x))))
 
   :returns (ans character-list-listp)
 
   ///
 
-  (defthm coerce-to-chars-list-when-atom
+  (defthm explode-list-when-atom
     (implies (atom x)
-             (equal (coerce-to-chars-list x)
+             (equal (explode-list x)
                     nil)))
 
-  (defthm coerce-to-chars-list-of-cons
-    (equal (coerce-to-chars-list (cons a x))
-           (cons (coerce a 'list)
-                 (coerce-to-chars-list x)))))
+  (defthm explode-list-of-cons
+    (equal (explode-list (cons a x))
+           (cons (explode a)
+                 (explode-list x)))))
 
 
diff -Nru acl2-6.2/books/centaur/vl/util/cw-unformatted-raw.lsp acl2-6.3/books/centaur/vl/util/cw-unformatted-raw.lsp
--- acl2-6.2/books/centaur/vl/util/cw-unformatted-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/cw-unformatted-raw.lsp	2013-09-30 17:53:08.000000000 +0000
@@ -0,0 +1,15 @@
+
+(defun cw-unformatted (x)
+  (let ((stream (get-output-stream-from-channel *standard-co*)))
+    (write-string x stream)
+
+; [Jared] We added finish-output to make this work better with file streams
+; that we were wanting to monitor.  Unfortunately this turned out to be
+; horribly slow when writing to an NFS-mounted file system.  (Which can happen,
+; for instance, if you are running ACL2 and redirecting output to a file from
+; the shell, or using with-stdout, or similar.)  It seems that using
+; force-output is much, much faster, and at least tries to accomplish something
+; similar, so now we'll just use it.
+
+    (force-output stream))
+  nil)
diff -Nru acl2-6.2/books/centaur/vl/util/cw-unformatted.lisp acl2-6.3/books/centaur/vl/util/cw-unformatted.lisp
--- acl2-6.2/books/centaur/vl/util/cw-unformatted.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/cw-unformatted.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -20,6 +20,8 @@
 
 (in-package "ACL2")
 
+(include-book "tools/include-raw" :dir :system)
+
 ; There doesn't seem to be any mechanism for just printing the contents of a
 ; string without any formatting using cw.  Using ~s mostly works, but it will
 ; insert its own line breaks.  Using ~f fixes that, but puts quotes around the
@@ -33,22 +35,10 @@
   (er hard? 'cw-unformatted "Raw lisp definition not installed?"))
 
 (defttag cw-unformatted)
-(progn!
- (set-raw-mode t)
- (defun cw-unformatted (x)
-   (let ((stream (get-output-stream-from-channel *standard-co*)))
-     (write-string x stream)
-
-; [Jared] We added finish-output to make this work better with file streams
-; that we were wanting to monitor.  Unfortunately this turned out to be
-; horribly slow when writing to an NFS-mounted file system.  (Which can happen,
-; for instance, if you are running ACL2 and redirecting output to a file from
-; the shell, or using with-stdout, or similar.)  It seems that using
-; force-output is much, much faster, and at least tries to accomplish something
-; similar, so now we'll just use it.
 
-     (force-output stream))
-   nil))
+; (depends-on "cw-unformatted-raw.lsp")
+(include-raw "cw-unformatted-raw.lsp")
+
 (defttag nil)
 
 
diff -Nru acl2-6.2/books/centaur/vl/util/defs.lisp acl2-6.3/books/centaur/vl/util/defs.lisp
--- acl2-6.2/books/centaur/vl/util/defs.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/defs.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -64,7 +64,7 @@
   :short "A string consisting of a newline character."
 
   (defconst *nls*
-    (coerce (list #\Newline) 'string)))
+    (implode (list #\Newline))))
 
 
 
@@ -778,7 +778,7 @@
   :long "<p>Such names are the convention for naming modules in E.</p>"
 
   (intern-in-package-of-symbol
-   (coerce (cons #\* (str::append-chars name (list #\*))) 'string)
+   (implode (cons #\* (str::append-chars name (list #\*))))
    'ACL2::foo)
 
   ///
diff -Nru acl2-6.2/books/centaur/vl/util/echars.lisp acl2-6.3/books/centaur/vl/util/echars.lisp
--- acl2-6.2/books/centaur/vl/util/echars.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/echars.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -39,20 +39,15 @@
 
 
 (defaggregate vl-location
-  (filename line col)
-  :tag :vl-location
-  :legiblep nil
-  :require ((stringp-of-vl-location->filename
-             (stringp filename)
-             :rule-classes :type-prescription)
-            (posp-of-vl-location->line
-             (posp line)
-             :rule-classes :type-prescription)
-            (natp-of-vl-location->col
-             (natp col)
-             :rule-classes :type-prescription))
   :parents (extended-characters)
   :short "Representation of a point in a source file."
+  :tag :vl-location
+  :legiblep nil
+
+  ((filename stringp :rule-classes :type-prescription)
+   (line     posp    :rule-classes :type-prescription)
+   (col      natp    :rule-classes :type-prescription))
+
   :long "<p>Each vl-location-p represents some location in a source code file.
 These locations are attached to characters and module items to provide context
 during error reporting.</p>")
@@ -463,7 +458,7 @@
 notably saves a lot of memory when we build @(see vl-filemap-p)s.</p>"
 
   :enabled t
-  (coerce (vl-echarlist->chars x) 'string)
+  (implode (vl-echarlist->chars x))
 
   ///
 
@@ -707,9 +702,9 @@
 
   (defthm vl-echarlist-from-str-nice-correct
     (implies (force (stringp x))
-             (equal (vl-echarlist-from-str-nice x n (len (coerce x 'list))
+             (equal (vl-echarlist-from-str-nice x n (len (explode x))
                                                 filename line col)
-                    (vl-echarlist-from-chars-fn (nthcdr n (coerce x 'list))
+                    (vl-echarlist-from-chars-fn (nthcdr n (explode x))
                                                 filename line col)))
     :hints(("Goal" :in-theory (enable vl-echarlist-from-str-nice
                                       vl-echarlist-from-chars-fn))))
@@ -721,8 +716,9 @@
                                 (natp col)))
              (type string x filename)
              (type integer line col))
-    (mbe :logic (vl-echarlist-from-chars-fn (coerce x 'list) filename line col)
-         :exec (vl-echarlist-from-str-nice x 0 (length (the string x))
+    (mbe :logic (vl-echarlist-from-chars-fn (explode x) filename line col)
+         :exec (vl-echarlist-from-str-nice x 0
+                                           (length (the string x))
                                            filename line col)))
 
   (defmacro vl-echarlist-from-str (x &key
diff -Nru acl2-6.2/books/centaur/vl/util/namedb.lisp acl2-6.3/books/centaur/vl/util/namedb.lisp
--- acl2-6.2/books/centaur/vl/util/namedb.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/namedb.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -729,7 +729,8 @@
     (declare (xargs :guard (and (stringp name)
                                 (vl-namedb-p db))
                     :verify-guards nil))
-    (b* ((names   (vl-namedb->names db))
+    (b* ((name    (string-fix name))
+         (names   (vl-namedb->names db))
          (pset    (vl-namedb->pset db))
 
          ((when (hons-get name names))
@@ -757,8 +758,7 @@
   (verify-guards vl-namedb-plain-name)
 
   (defthm stringp-of-vl-namedb-plain-name
-    (implies (force (stringp name))
-             (stringp (mv-nth 0 (vl-namedb-plain-name name db))))
+    (stringp (mv-nth 0 (vl-namedb-plain-name name db)))
     :hints(("Goal" :in-theory (disable vl-namedb->pset-under-set-equiv)))
     :rule-classes :type-prescription)
 
diff -Nru acl2-6.2/books/centaur/vl/util/position.lisp acl2-6.3/books/centaur/vl/util/position.lisp
--- acl2-6.2/books/centaur/vl/util/position.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/position.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -52,7 +52,7 @@
 (defthm position-equal-under-iff-when-stringp
   (implies (stringp string)
            (iff (position-equal char string)
-                (member-equal char (coerce string 'list))))
+                (member-equal char (explode string))))
   :hints(("Goal" :in-theory (enable position-equal))))
 
 (encapsulate
@@ -112,22 +112,23 @@
                        lst)
                   item))
   :hints(("Goal"
-          :in-theory (enable position-equal-ac)
+          :in-theory (e/d (position-equal-ac)
+                          (acl2::position-equal-ac-is-index-of-aux))
           :do-not '(generalize fertilize)
           :induct (position-equal-ac item lst acc))))
 
-(defthm nth-of-position-equal-of-coerce-when-stringp
+(defthm nth-of-position-equal-of-explode-when-stringp
   (implies (and (position-equal char string)
                 (stringp string))
            (equal (nth (position-equal char string)
-                       (coerce string 'list))
+                       (explode string))
                   char))
   :hints(("Goal"
           :in-theory (e/d (position-equal)
                           (nth-of-position-equal-ac))
           :use ((:instance nth-of-position-equal-ac
                            (item char)
-                           (lst (coerce string 'list))
+                           (lst (explode string))
                            (acc 0))))))
 
 (defthm acl2-numberp-of-position-equal
@@ -171,7 +172,8 @@
                          (<= n (- (position-equal-ac item lst acc) acc)))
                     (not (member-equal item (take n lst))))
            :hints(("Goal"
-                   :in-theory (enable position-equal-ac)
+                   :in-theory (e/d (position-equal-ac)
+                                   (acl2::position-equal-ac-is-index-of-aux))
                    :induct (my-induct item n lst acc)))))
 
   (local (defthm l1
@@ -188,29 +190,29 @@
   (defthm member-equal-of-subseq-chars-impossible-1
     (implies (and (not (position-equal a x))
                   (<= (nfix end) (length x)))
-             (not (member-equal a (coerce (subseq x 0 end) 'list)))))
+             (not (member-equal a (explode (subseq x 0 end))))))
 
   (defthm member-equal-of-subseq-chars-impossible-2
     (implies (and (<= end (position-equal a x))
                   (position-equal a x)
                   (natp end))
-             (not (member-equal a (coerce (subseq x 0 end) 'list))))
+             (not (member-equal a (explode (subseq x 0 end)))))
     :hints(("Goal"
             :in-theory (disable member-equal-of-subseq-chars-impossible-1 l1)
             :use ((:instance member-equal-of-subseq-chars-impossible-1)
-                  (:instance l1 (item a) (lst (coerce x 'list)) (n end)))))))
+                  (:instance l1 (item a) (lst (explode x)) (n end)))))))
 
 
 
-(defthm position-equal-of-coerce-to-string
+(defthm position-equal-of-implode
   (implies (character-listp x)
-           (equal (position-equal a (coerce x 'string))
+           (equal (position-equal a (implode x))
                   (position-equal a x)))
   :hints(("Goal" :in-theory (enable position-equal))))
 
-(defthm position-equal-of-coerce-to-list
+(defthm position-equal-of-explode
   (implies (stringp x)
-           (equal (position-equal a (coerce x 'list))
+           (equal (position-equal a (explode x))
                   (position-equal a x)))
   :hints(("Goal" :in-theory (enable position-equal))))
 
@@ -252,4 +254,5 @@
                         0
                       (and (position-equal a x)
                            (+ 1 (position-equal a x))))))
-    :hints(("Goal" :in-theory (enable position-equal)))))
+    :hints(("Goal" :in-theory (e/d (position-equal)
+                                   (acl2::position-equal-ac-is-index-of-aux))))))
diff -Nru acl2-6.2/books/centaur/vl/util/print-htmlencode.lisp acl2-6.3/books/centaur/vl/util/print-htmlencode.lisp
--- acl2-6.2/books/centaur/vl/util/print-htmlencode.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/print-htmlencode.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -19,7 +19,7 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "VL")
-(include-book "tools/bstar" :dir :system)
+(include-book "str/cat" :dir :system)
 (local (include-book "misc/assert" :dir :system))
 (local (include-book "arithmetic"))
 
@@ -38,12 +38,12 @@
 ; not be the desired behavior in certain applications, but is very convenient
 ; for what we are trying to accomplish in VL.
 
-(defconst *vl-html-&nbsp*   (coerce "&nbsp;" 'list))
-(defconst *vl-html-newline* (append (coerce "<br/>" 'list) (list #\Newline)))
-(defconst *vl-html-&lt*     (coerce "&lt;"   'list))
-(defconst *vl-html-&gt*     (coerce "&gt;"   'list))
-(defconst *vl-html-&amp*    (coerce "&amp;"  'list))
-(defconst *vl-html-&quot*   (coerce "&quot;" 'list))
+(defconst *vl-html-&nbsp*   (explode "&nbsp;"))
+(defconst *vl-html-newline* (append (explode "<br/>") (list #\Newline)))
+(defconst *vl-html-&lt*     (explode "&lt;"))
+(defconst *vl-html-&gt*     (explode "&gt;"))
+(defconst *vl-html-&amp*    (explode "&amp;"))
+(defconst *vl-html-&quot*   (explode "&quot;"))
 
 
 (defund repeated-revappend (n x y)
@@ -170,8 +170,8 @@
                      ((mv str-col str-ans)
                       (vl-html-encode-string-aux x 0 (length x) 0 8 nil))
                      ((mv char-col char-ans)
-                      (vl-html-encode-chars-aux (coerce x 'list) 0 8 nil))
-                     (- (cw "~s0~%" (coerce (reverse str-ans) 'string))))
+                      (vl-html-encode-chars-aux (explode x) 0 8 nil))
+                     (- (cw "~s0~%" (str::rchars-to-string str-ans))))
                     (and (equal str-col char-col)
                          (equal str-ans char-ans)))))
 
@@ -213,19 +213,10 @@
   (mv-let (col acc)
           (vl-html-encode-string-aux x 0 (length x) 0 tabsize nil)
           (declare (ignore col))
-          (reverse (coerce acc 'string))))
+          (str::rchars-to-string acc)))
 
 (defthm stringp-of-vl-html-encode-string
   (stringp (vl-html-encode-string x tabsize))
   :rule-classes :type-prescription
   :hints(("Goal" :in-theory (enable vl-html-encode-string))))
 
-(defttag vl-optimize)
-(never-memoize vl-html-encode-string-aux)
-(progn! (set-raw-mode t)
-        (defun vl-html-encode-string (x tabsize)
-          (mv-let (col acc)
-            (vl-html-encode-string-aux x 0 (length x) 0 tabsize nil)
-            (declare (ignore col))
-            (nreverse (coerce acc 'string)))))
-(defttag nil)
diff -Nru acl2-6.2/books/centaur/vl/util/print-urlencode.lisp acl2-6.3/books/centaur/vl/util/print-urlencode.lisp
--- acl2-6.2/books/centaur/vl/util/print-urlencode.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/print-urlencode.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -19,8 +19,7 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "VL")
-(include-book "xdoc/top" :dir :system)
-(include-book "misc/definline" :dir :system)
+(include-book "str/cat" :dir :system)
 (local (include-book "misc/assert" :dir :system))
 (local (include-book "arithmetic"))
 
@@ -60,9 +59,9 @@
 
   (local
    (progn
-     (assert! (equal (coerce (vl-url-encode-char #\a) 'string)           "a"))
-     (assert! (equal (coerce (vl-url-encode-char #\Space) 'string)       "%20"))
-     (assert! (equal (coerce (vl-url-encode-char (code-char 0)) 'string) "%00"))))
+     (assert! (equal (implode (vl-url-encode-char #\a))           "a"))
+     (assert! (equal (implode (vl-url-encode-char #\Space))       "%20"))
+     (assert! (equal (implode (vl-url-encode-char (code-char 0))) "%00"))))
 
   (local (in-theory (enable vl-url-encode-char)))
 
@@ -201,7 +200,8 @@
 
   (defund vl-url-encode-string (x)
     (declare (xargs :guard (stringp x)))
-    (reverse (coerce (vl-url-encode-string-aux x 0 (length x) nil) 'string)))
+    (str::rchars-to-string
+     (vl-url-encode-string-aux x 0 (length x) nil)))
 
   (local (in-theory (enable vl-url-encode-string)))
 
@@ -213,4 +213,4 @@
 (local (assert!
         (let ((x "foo123$%20 blah !==[]{}7&*^!@&*^&*)($"))
           (equal (vl-url-encode-string x)
-                 (coerce (vl-url-encode-chars (coerce x 'list)) 'string)))))
+                 (implode (vl-url-encode-chars (explode x)))))))
diff -Nru acl2-6.2/books/centaur/vl/util/print.lisp acl2-6.3/books/centaur/vl/util/print.lisp
--- acl2-6.2/books/centaur/vl/util/print.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/print.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -170,8 +170,8 @@
   :short "Fixed version of ACL2's @(see acl2::print-base-p) function that
 returns a Boolean."
   :long "<p>ACL2's built-in version of this just calls @(see member) and hence
-can return a non-Boolean.  That makes it incompatible with @(see stobj) field
-@('satisfies') types, so we have to introduce our own version.</p>"
+can return a non-Boolean.  That makes it incompatible with @(see acl2::stobj)
+field @('satisfies') types, so we have to introduce our own version.</p>"
   (if (acl2::print-base-p x)
       t
     nil))
@@ -736,9 +736,9 @@
   :parents (accessing-printed-output)
   :short "@('(vl-ps->string)') returns the printed characters as a string in
 the proper, non-reversed, printed order."
-  :long "<p>This is logically just @('(coerce (vl-ps->chars) 'string)'), but we
+  :long "<p>This is logically just @('(implode (vl-ps->chars))'), but we
 install a more efficient definition under the hood in raw Lisp.</p>"
-  (coerce (vl-ps->chars) 'string)
+  (implode (vl-ps->chars))
   ///
   (defttag vl-optimize)
   (progn!
@@ -910,9 +910,10 @@
   :parents (basic-printing)
   :short "Print to standard-out using @(see ps)"
 
-  :long "<p>@('(vl-cw-ps-seq ...)') expands to @('(cw-unformatted (@(see
-with-local-ps) ...))').  Due to the use of @(see with-local-ps), this macro can
-only be used within functions, and cannot be called from the top level.</p>"
+  :long "<p>@('(vl-cw-ps-seq ...)') expands to
+@('(cw-unformatted (with-local-ps ...))').  Due to the use of @(see
+with-local-ps), this macro can only be used within functions, and cannot be
+called from the top level.</p>"
 
   (defmacro vl-cw-ps-seq (&rest args)
     `(cw-unformatted (with-local-ps ,@args))))
@@ -1064,7 +1065,7 @@
                   (<= n xl)
                   (= xl (length x)))
              (equal (vl-col-after-printing-string-aux col x n xl)
-                    (vl-col-after-printing-chars col (nthcdr n (coerce x 'list)))))
+                    (vl-col-after-printing-chars col (nthcdr n (explode x)))))
     :hints(("Goal"
             :induct (vl-col-after-printing-string-aux col x n xl)
             :in-theory (enable vl-col-after-printing-string-aux
@@ -1079,7 +1080,7 @@
   :inline t
   (declare (type integer col)
            (type string string))
-  (mbe :logic (vl-col-after-printing-chars col (coerce string 'list))
+  (mbe :logic (vl-col-after-printing-chars col (explode string))
        :exec (vl-col-after-printing-string-aux col string 0 (length string))))
 
 (define vl-indent ((n natp) &key (ps 'ps))
@@ -1662,7 +1663,7 @@
               (= xl (length x)))
   :returns (mv (col-prime natp :rule-classes :type-prescription)
                (acc-prime))
-  :parents (vl-stupid-ppr1)
+  :parents (vl-basic-fmt)
   :short "This is basically like acl2::prin1-with-slashes, but we put the
 characters into the accumulator in reverse order instead of printing them."
   :measure (nfix (- (nfix xl) (nfix n)))
@@ -1704,6 +1705,7 @@
 
 
 (defsection vl-ppr-explode-symbol-aux
+  :parents (vl-basic-fmt)
 
   (local (in-theory (disable acl2::may-need-slashes-fn)))
 
@@ -1745,6 +1747,7 @@
 
 
 (defsection vl-ppr-explode-symbol
+  :parents (vl-basic-fmt)
 
   (defund vl-ppr-explode-symbol (x pkg col acc)
     "Returns (MV COL-PRIME ACC-PRIME)"
@@ -1794,6 +1797,7 @@
 
 
 (defsection vl-ppr-explode-string
+  :parents (vl-basic-fmt)
 
   (defund vl-ppr-explode-string (x col acc)
     "Returns (MV COL-PRIME ACC-PRIME)"
@@ -1827,6 +1831,7 @@
 
 
 (defsection vl-ppr-explode-atom
+  :parents (vl-basic-fmt)
 
   (defund vl-ppr-explode-atom (x pkg base col acc)
     "Returns (MV COL-PRIME ACC-PRIME)"
@@ -1882,6 +1887,7 @@
 
 
 (defsection vl-stupid-ppr1
+  :parents (vl-basic-fmt)
 
   (defund vl-stupid-ppr1 (x pkg base rmargin in-listp col acc)
     "Returns (MV COL-PRIME ACC-PRIME)"
@@ -1958,6 +1964,7 @@
 
 
 (defsection vl-skip-ws
+  :parents (vl-basic-fmt)
 
 ; X is the string we are parsing and XL is its length.  N is our current
 ; position.  We return the index of the first non-whitespace character at or
@@ -1998,6 +2005,7 @@
 
 
 (defsection vl-basic-fmt-parse-tilde
+  :parents (vl-basic-fmt)
 
   (local (in-theory (enable len)))
 
@@ -2050,7 +2058,7 @@
           (prog2$ (er hard? 'vl-basic-fmt-parse-tilde
                       "The format string ~x0 ends with ~x1, but this directive needs argument."
                       x
-                      (coerce (list char1 char2) 'string))
+                      (implode (list char1 char2)))
                   (mv :normal char1 (+ n 1))))
 
          (char3 (char x (+ n 2))))
@@ -2086,6 +2094,7 @@
                   (true-listp x))))
 
 (define vl-fmt-tilde-x (x &key (ps 'ps))
+  :parents (vl-basic-fmt)
   (b* ((rchars  (vl-ps->rchars))
        (col     (vl-ps->col))
        (pkg     (vl-ps->package))
@@ -2113,12 +2122,14 @@
        (vl-ps-update-rchars rchars))))
 
 (define vl-fmt-tilde-s (x &key (ps 'ps))
+  :parents (vl-basic-fmt)
   (cond ((stringp x)
          (vl-print x))
         (t
          (vl-fmt-tilde-x x))))
 
 (define vl-fmt-tilde-& (x &key (ps 'ps))
+  :parents (vl-basic-fmt)
   (if (atom x)
       ps
     (vl-ps-seq
@@ -2155,6 +2166,8 @@
 
 
 (define vl-fmt-print-space (&key (ps 'ps))
+  :parents (vl-basic-fmt)
+
   ;; Prints spaces encountered in the format string itself, maybe word-wrapping
   ;; if necessary.
   (if (vl-ps->htmlp)
@@ -2176,6 +2189,7 @@
          (vl-ps-update-col indent)))))
 
 (define vl-fmt-print-normal ((x :type character) &key (ps 'ps))
+  :parents (vl-basic-fmt)
   (cond ((eql x #\-)
          (vl-println? x))
         ((eql x #\Space)
@@ -2184,6 +2198,7 @@
          (vl-print x))))
 
 (defsection vl-basic-fmt-aux-fn
+  :parents (vl-basic-fmt)
 
   (defmacro vl-basic-fmt-aux (x n xl alist)
     `(vl-basic-fmt-aux-fn ,x ,n ,xl ,alist ps))
diff -Nru acl2-6.2/books/centaur/vl/util/subsetp-equal.lisp acl2-6.3/books/centaur/vl/util/subsetp-equal.lisp
--- acl2-6.2/books/centaur/vl/util/subsetp-equal.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/subsetp-equal.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -26,7 +26,7 @@
 
 (include-book "cutil/defrule" :dir :system)
 (include-book "centaur/misc/equal-sets" :dir :system)
-(include-book "finite-set-theory/osets/sets" :dir :system)
+(include-book "std/osets/top" :dir :system)
 (include-book "std/lists/list-fix" :dir :system)
 (include-book "std/lists/take" :dir :system)
 (include-book "defsort/duplicated-members" :dir :system)
diff -Nru acl2-6.2/books/centaur/vl/util/warnings.lisp acl2-6.3/books/centaur/vl/util/warnings.lisp
--- acl2-6.2/books/centaur/vl/util/warnings.lisp	2013-06-06 17:11:42.000000000 +0000
+++ acl2-6.3/books/centaur/vl/util/warnings.lisp	2013-09-30 17:53:08.000000000 +0000
@@ -117,7 +117,11 @@
 
 <p>After carrying out some transformation, we can scan the list of modules for
 any fatal warnings, and these modules (and their dependents) can be easily
-thrown out using @(see vl-propagate-errors).</p>")
+thrown out using @(see vl-propagate-errors).</p>
+
+<h3>Printing Warnings</h3>
+
+See @(see vl::printer) for information on printing warnings.")
 
 
 (defaggregate vl-warning
@@ -161,7 +165,7 @@
 
 <p>The @('fatalp') flag indicates whether this error is so severe that the
 module ought to be thrown away and not subjected to further translation.  See
-the general discussion in @(see warning) for more information on how this is
+the general discussion in @(see warnings) for more information on how this is
 used.</p>
 
 <p>The @('fn') is supposed to be the name of the function that caused the
diff -Nru acl2-6.2/books/cert.pl acl2-6.3/books/cert.pl
--- acl2-6.2/books/cert.pl	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/cert.pl	2013-09-30 17:53:32.000000000 +0000
@@ -54,6 +54,10 @@
 (do "$RealBin/certlib.pl") or die ("Error loading $RealBin/certlib.pl:\n!: $!\n\@: $@\n");
 (do "$RealBin/paths.pl") or die ("Error loading $RealBin/paths.pl:\n!: $!\n\@: $@\n");
 
+my %reqparams = ("hons-only" => "HONS_ONLY",
+		 "uses-glucose" => "USES_GLUCOSE",
+		 "uses-quicklisp" => "USES_QUICKLISP",
+    );
 
 # use lib "/usr/lib64/perl5/5.8.8/x86_64-linux-thread-multi/Devel";
 # use Devel::DProf;
@@ -83,7 +87,7 @@
 my %certlib_opts = ( "debugging" => 0,
 		     "clean_certs" => 0,
 		     "print_deps" => 0,
-		     "all_deps" => 0,
+		     "all_deps" => 1,
                      "believe_cache" => 0 );
 my $cache_file = 0;
 my $bin_dir = $ENV{'CERT_PL_BIN_DIR'};
@@ -189,8 +193,10 @@
 
    --all-deps
    -d
-           Write out dependency information for all targets
-           encountered, including ones which don\'t need updating.
+           Toggles writing out dependency information for all targets
+           encountered, including ones which don\'t need updating.  This is
+           done by default, so using -d or --all-deps actually means that
+           only targets that need updating are written to the makefile.
 
    --acl2 <cmd>
    -a <cmd>
@@ -237,7 +243,7 @@
 
    --static-makefile <makefile-name>
    -s <makefile-name>
-           Equivalent to -d -m -o <makefile-name>.  Useful for
+           Equivalent to -m -o <makefile-name>.  Useful for
            building a static makefile for your targets, which will
            suffice for certifying them as long as the dependencies
            between source files don\'t change.
@@ -303,7 +309,7 @@
            Run the following command on each source file.  The actual
            command line is created by replacing the string {} with the
            target file in the command string.  For example:
-               cert.pl top.lisp -n -d --source-cmd "echo {}; wc {}"
+               cert.pl top.lisp -n --source-cmd "echo {}; wc {}"
            Any number of --source-cmd directives may be given; the
            commands will then be run in the order in which they are given.
 
@@ -378,7 +384,7 @@
 	    "no-boilerplate"       => \$no_boilerplate,
 	    "var-prefix=s"         => \$var_prefix,
 	    "o=s"                  => \$mf_name,
-	    "all-deps|d"           => \$certlib_opts{"all_deps"},
+	    "all-deps|d"           => sub { $certlib_opts{"all_deps"} = !$certlib_opts{"all_deps"}; },
 	    "static-makefile|s=s"  => sub {shift;
 					   $mf_name = shift;
 					   $certlib_opts{"all_deps"} = 1;
@@ -665,18 +671,21 @@
 
     # Write out the list of hons-only certs
     # Propagate the hons-only requirement:
-    my %visited = ();
-    foreach my $cert (@certs) {
-	propagate_reqparam($cert, "hons-only", \%visited, \%depmap);
-    }
-    print $mf "${var_prefix}_HONS_ONLY :=";
-    foreach my $cert (@certs) {
-	if (cert_get_param($cert, \%depmap, "hons-only")) {
-	    print $mf " \\\n     $cert ";
+    my %visited;
+    foreach my $reqparam (keys %reqparams) {
+	%visited = ();
+	foreach my $cert (@certs) {
+	    propagate_reqparam($cert, $reqparam, \%visited, \%depmap);
 	}
-    }
-    print $mf "\n\n";
 
+	print $mf "${var_prefix}_${reqparams{$reqparam}} :=";
+	foreach my $cert (@certs) {
+	    if (cert_get_param($cert, \%depmap, $reqparam)) {
+		print $mf " \\\n     $cert ";
+	    }
+	}
+	print $mf "\n\n";
+    }
     # If there are labels, write out the sources and certs for those
     foreach my $label (sort(keys %labels)) {
 	my @topcerts = @{$labels{$label}};
diff -Nru acl2-6.2/books/certlib.pl acl2-6.3/books/certlib.pl
--- acl2-6.2/books/certlib.pl	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/certlib.pl	2013-09-30 17:53:32.000000000 +0000
@@ -31,7 +31,7 @@
 use Storable qw(nstore retrieve);
 use Cwd 'abs_path';
 
-my $cache_version_code = 3;
+my $cache_version_code = 5;
 
 # Note: for debugging you can enable this use and then print an error message
 # using
@@ -84,7 +84,12 @@
 sub abs_canonical_path {
     my $path = shift;
     # print "path: $path\n";
-    my $abspath = File::Spec->rel2abs($path);
+    my $abspath;
+    if (File::Spec->file_name_is_absolute($path)) {
+	$abspath = $path;
+    } else {
+	$abspath = File::Spec->rel2abs($path);
+    }
     # print "abspath: $abspath\n";
     my ($vol, $dir, $file) = File::Spec->splitpath($abspath);
     # print "path: $path vol: $vol dir: $dir file: $file\n";
@@ -885,7 +890,7 @@
 sub get_cert_param {
     my ($base,$the_line,$events) = @_;
 
-    my $regexp = "cert[-_]param:[\\s]*\\(?([^)]*)\\)?";
+    my $regexp = "cert[-_]param:?[\\s]*\\(?([^)]*)\\)?";
     my @match = $the_line =~ m/$regexp/;
     if (@match) {
 	debug_print_event($base, "cert_param", \@match);
@@ -918,6 +923,8 @@
     return 0;
 }
 
+# (check-hons-enabled (:book
+# cert_param (hons-only)
 
 
 
diff -Nru acl2-6.2/books/cgen/Makefile acl2-6.3/books/cgen/Makefile
--- acl2-6.2/books/cgen/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/Makefile	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,3 @@
+ACL2_COMPILE_FLG := t :ttags :all
+include ../Makefile-generic
+-include Makefile-deps
diff -Nru acl2-6.2/books/cgen/Readme.lsp acl2-6.3/books/cgen/Readme.lsp
--- acl2-6.2/books/cgen/Readme.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/Readme.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,196 @@
+((:FILES "
+.:
+acl2-customization.lsp
+acl2s-parameter.lisp
+base.lisp
+basis.lisp
+cert.acl2
+certify-book.sh
+data.lisp
+graph.lisp
+library-support.lisp
+main.lisp
+Makefile
+mv-proof.lisp
+num-list-fns.lisp
+num-list-thms.lisp
+package.lsp
+portcullis.acl2
+portcullis.lisp
+random.lisp
+random-state-basis1.lisp
+random-state.lisp
+Readme.lsp
+rem-and-floor.lisp
+scratchpad.lsp
+simple-graph-array.lisp
+splitnat.lisp
+switchnat.lisp
+testing-regression.lsp
+top.lisp
+type.lisp
+utilities.lisp
+with-timeout.lisp
+with-timeout-raw.lsp
+"
+)
+ (:TITLE    "Counterexample Generation")
+ (:AUTHOR/S "Harsh Raju Chamarthi, Peter C. Dillinger") ; With help from Matt Kaufmann and Panagiotis Manolios
+ (:KEYWORDS ; non-empty list of keywords, case-insensitive
+   "book contributions" "contributed books"
+   "testing" "counterexamples" "witnesses" "executable"
+   "models" "random testing" "bounded-exhaustive testing"
+   "theorem-proving" "dpll" "backtracking search"
+   )
+ (:ABSTRACT
+"We provide support for counterexample generation and provide a
+defdata framework which forms the basis for using 'testing' to find
+counterexamples. 
+
+We use simple and incremental search strategies in our quest to find
+counterexamples.
+
+At a high-level, the idea of 'simple search' is simple: Given any
+conjecture, infer type information about free variables from the
+hypotheses, generate/sample values of these types (value sampling can
+be random, bounded exhaustive or mixed), instantiate all variables and
+evaluate to get either T or NIL. The value assignment resulting in NIL
+is a counterexample (other cases are witness and vacuous). The type
+information is stored in ACL2 tables and is usually created using
+'defdata' which automatically generates the value enumerator for that
+type. All base types have been lifted to the defdata framework i.e we
+manually defined all enumerators and subtype relationships among the
+ground ACL2 types.
+
+Theorem proving and domain-specific libraries often help in
+substantially shrinking the space of free variables that we need to
+search, improving our chances of finding a counterexample if one
+exists. We do this by using override and backtrack hints to search for
+counterexamples to all checkpoints of a conjecture under
+thm/defthm/test?.
+
+'incremental search' is a DPLL like algorithm that selects an
+appropriate variable, assigns it, propagates this information using
+ACL2 itself to obtain a partially concretized formula, which is then
+tested using 'simple search'. If we ever hit the stopping
+condition (usually 3 counterexamples and witnesses), we abort the
+search. If not, we continue with the select, assign, propagate
+loop. Of course if propagating a value assignment results in a
+contradiction in the hypotheses (i.e inconsistency), we backtrack.
+
+Instructions for usage are in top.lisp.
+
+See the essay in main.lisp for high-level pseudocode of the test driver.
+")
+ (:PERMISSION ; author/s permission for distribution and copying:
+"Copyright (C) 2011 Harsh Raju Chamarthi, Peter C. Dillinger
+                    and Northeastern University
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+as published by the Free Software Foundation; either version 2
+of the License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA."))
+#|
+
+   
+
+
+These books were developed as part of ACL2s: "The ACL2 Sedan."
+
+To certify books, do the foll at the shell prompt (in the current directory):
+$ export ACL2=<path to your  saved_acl2>
+$ make
+
+Note: You need java to be installed on your machine and in PATH.
+      acl2-lib.jar automatically generates .acl2 files.
+
+Books:
+
+top.lisp 
+   top-level entry book with some customizations.
+
+acl2s-parameter.lisp
+   All ACL2s testing/counterexample-generation related configuration parameters
+   are set here. It provides a macro to add a new parameter, producing
+   getters setters and doc items.
+
+base.lisp
+   Builds up the type metadata and type relationship data structures for base
+   ACL2 theory
+
+basis.lisp
+   defines macros for defining functions that ease guard verification
+   (type-checking), and provide facilities for writing concise code. Note that
+   this book is in progress and some features I would like to
+   incorporate in the future are yet unimplemented. 
+
+mv-proof.lisp
+rem-and-floor.lisp
+num-list-fns.lisp
+num-list-thms.lisp
+   Support books for defdata
+
+splitnat.lisp
+   Given a natural number seed s and another number n, it provides the
+   function split-nat returns an n-tuple which is bijective to s.
+   It is used to generate enumerators for product types.
+
+switchnat.lisp
+   Given a natural number seed s and another number n, it provides the
+   function switch-nat returns an pair (c,s') which is bijective to s.
+   This is used to generate enumerators for union types.
+
+data.lisp 
+   The previous books implement the data definition framework.
+   In particular, it provides the defdata macro which the user can use
+   to introduce 
+
+graph.lisp
+   Provides graph utility functions for DFS, SCC and transitive
+   closure. Possibly buggy, will be replaces by simple-graph-array book.
+ 
+library-support.lisp
+   Some theorems for using misc/records book in our context.
+
+main.lisp
+   The top-level book which implements the main driver functions that
+   orchestrate the testing+theorem-proving synergistic combination.
+   It provides the test? macro and the test-checkpoint function which
+   is used as an override-hint to search for counterexamples at all
+   checkpoints. For more information on implementation look at the
+   essay headed "Main Idea".
+
+random-state-basis1.lisp
+   See below
+random-state.lisp
+   Provides pseudogeometric natural number distribution.
+
+testing-regression.lsp
+   Examples, testcases and in general a book that you can refer to for
+   quick application of counterexample generation.
+
+simple-graph-array.lisp
+   Simple implementation of DFS and SCC (and topological sort)
+
+type.lisp 
+   Provides functions to convert ACL2 type set into defdata types and
+   also the meet operation over the subtype (lattice) defdata graph
+
+utilities.lisp
+   Some utility functions used across the books in this directory.
+
+with-timeout.lisp
+   Nested timeouts.
+
+
+|#
diff -Nru acl2-6.2/books/cgen/acl2-customization.lsp acl2-6.3/books/cgen/acl2-customization.lsp
--- acl2-6.2/books/cgen/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/acl2-customization.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1 @@
+(ld "package.lsp")
\ No newline at end of file
diff -Nru acl2-6.2/books/cgen/acl2s-parameter.lisp acl2-6.3/books/cgen/acl2s-parameter.lisp
--- acl2-6.2/books/cgen/acl2s-parameter.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/acl2s-parameter.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,623 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book t :ttags :all);$ACL2s-Preamble$|#
+
+(in-package "ACL2")
+(include-book "utilities")
+
+
+;;; Keep the following defconst synced with all the acl2s parameters
+(defconst *acl2s-parameters* '(num-trials
+                               verbosity-level
+                               num-counterexamples
+                               num-witnesses
+                               ;show-top-level-counterexample
+                               sampling-method
+                               backtrack-limit
+                               search-strategy
+                               testing-enabled
+                               stopping-condition
+                               subgoal-timeout
+                               ))
+
+;All user-defined parameters are stored here
+(table acl2s-defaults-table)
+
+(defrec acl2s-param-info% (value guard setter) NIL)
+
+(defmacro add-acl2s-parameter (name default
+                                    &key 
+                                    (setter 'nil)
+                                    (doc-string 'nil)
+                                    (guard 't))
+  "Add a new user-defined parameter.
+   Put it in the acl2s-defaults-table as a key,
+   using the value of :default. 
+:guard is a term that checks for legal values of the
+   parameter (It uses symbol 'value for variable capture).
+getter and setter specify macro names that will be used by
+the actual getter/setter mechanism to delegate its function.
+Note that setter should be a macro that expands to a state changing
+embedded event form, this this is called from inside an make-event.
+You have to see the code in acl2s-defaults to understand whats going
+on with getter and setter, the situation is assymmetric and I am
+being lazy about documentation.
+:doc-string is a string that is used to specify the defdoc. 
+For internal flags dont use a doc-string"
+  
+  (b* (((unless (symbolp name))
+        (er hard 'add-acl2s-parameter
+            "Name must be a symbol, but is ~x0." name))
+       ;; ((unless (pseudo-termp guard))
+       ;;  (er hard 'add-acl2s-parameter 
+       ;;      ":guard must be a term, but is ~x0." guard))
+       );*b
+
+    `(progn 
+       (table acl2s-defaults-table 
+              ',name
+              ',(acl2::make acl2s-param-info%
+                 :guard guard ;store guard too
+                 :value default
+                 :setter setter)
+              :put)
+       ,@(and doc-string
+              `((defdoc ,name ,doc-string))))))
+
+
+  
+
+
+(defdoc ACL2::TESTING
+  ":Doc-Section ACL2::TESTING
+  
+  A counterexample generation framework for ACL2 ~/
+                                 
+  Test formulas before and during a proof attempt, to find
+  counterexamples and witnesses potentially saving time and
+  effort and providing more intuition into the conjecture under
+  scrutiny.  The testing framework is tightly coupled with the
+  data definition (See ~ilc[DATA-DEFINITIONS]) framework.
+  
+  ~t[test?] guarantees printing counterexamples in
+  terms of the top goals variables. See ~ilc[test?]
+  for more details and examples.
+  
+  The framework can be configured via a bunch of parameters
+  whose documention you will find below. In particular, see
+  ~ilc[num-trials], ~ilc[verbosity-level], ~ilc[testing-enabled].~/ 
+  
+  To understand more about how testing works,
+  please refer to the following paper
+  ~url[http://www.ccs.neu.edu/home/harshrc/ITaITP.pdf]
+  ")
+
+(defdoc ACL2::acl2s-defaults
+  ":Doc-Section ACL2::acl2-sedan
+  
+  Getting and setting defaults for various parameters in ACL2 Sedan~/
+                                 
+  ~/ 
+  
+  ")
+
+(add-acl2s-parameter 
+ num-trials 1000
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+  
+  Max number of tries to find counterexamples~/~/
+
+  Maximum number of tries (attempts) to construct 
+  counterexamples and witnesses.
+  By default this parameter is set to 1000. Can be set to
+  any natural number ~t[n]. If set to 0, it has the same
+  effect as setting testing-enabled parameter to ~t[nil].
+  ~bv[]
+   Usage:
+   (acl2s-defaults :set num-trials 1000)
+   (acl2s-defaults :get num-trials)
+   :doc num-trials
+   ~ev[]"
+ :guard (and (natp value) 
+             (< value 1000000000)))
+
+(add-acl2s-parameter 
+ verbosity-level 1
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+  
+ Control verbosity of Testing~/~/
+
+ Control amount of output printed by random-testing
+   Currently 3 verbosity levels are implemented:
+   0 - All testing output is turned off
+   1 - Normal verbosity level (default)
+   2 - More verbose.
+   3 - For Debug by normal users
+   4 and above - System level debug by developers
+  ~bv[]
+    Usage:
+    (acl2s-defaults :set verbosity-level 1)
+    (acl2s-defaults :get verbosity-level)
+    :doc verbosity-level
+  ~ev[]"
+ :guard (natp value))
+
+
+(add-acl2s-parameter 
+  num-counterexamples 3
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+ 
+  Number of Counterexamples to be shown~/~/
+ 
+  Set the number of counterexamples desired to be shown
+  By default this parameter is set to 3. Can be set to
+  any natural number n. Setting this number to 0 implies
+  the user is not interested in seeing counterexamples, and
+  thus none will be printed in the testing output.
+  
+  ~bv[]
+  Usage:
+  (acl2s-defaults :set num-counterexamples 3)
+  (acl2s-defaults :get num-counterexamples)
+  :doc num-counterexamples
+  ~ev[]"
+   :guard (natp value))
+
+
+(add-acl2s-parameter 
+  num-witnesses 3
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+  
+  Number of Witnesses to be shown~/~/
+  
+  Set the number of witnesses desired to be shown
+  By default this parameter is set to 3. Can be set to
+  any natural number. Setting this number to 0 implies
+  the user is not interested in seeing witnesses, and
+  thus none will be printed in the testing output.
+  
+  ~bv[]
+  Usage:
+  (acl2s-defaults :set num-witnesses 3)
+  (acl2s-defaults :get num-witnesses)
+  :doc num-witnesses
+  ~ev[]"
+   :guard (natp value))
+
+;DEPRECATED
+;; (add-acl2s-parameter 
+;;  show-top-level-counterexample t
+;;  :doc-string ":Doc-Section ACL2::TESTING
+;;  Show Counterexamples to the top-level <i>goal</i>" 
+;;  Show Counterexamples to the top-level <i>goal</i>
+;;    instead of to the <i>subgoals</i>.
+;;    By default this parameter is set to <tt>t</tt>. 
+;;    If set to <tt>nil</tt>, then counterexamples are simply
+;;    instances falsifying the respective subgoals.
+;;    ~bv[]
+;;    Usage:
+;;    (acl2s-defaults :set show-top-level-counterexample t)
+;;    (acl2s-defaults :get show-top-level-counterexample)
+;;    :doc show-top-level-counterexample 
+;;    ~ev[]
+;;    "
+;;  :guard (booleanp value))
+
+;; use test enumerator for user-level controlled testing
+(defconst *default-rt-use-test-enum* t)
+
+(defmacro set-acl2s-random-testing-use-test-enumerator (v)
+;:Doc-Section RANDOM-TESTING  
+ "Set the flag to use test-enumerator if it exists~/
+  By default this parameter is set to nil.
+  ~bv[]
+  Usage:
+  (set-acl2s-random-testing-use-test-enumerator nil)
+  ~ev[]~/
+  "
+ `(assign acl2s-rt-use-test-enum ,v))
+
+(defun get-acl2s-random-testing-use-test-enumerator-fn (state)
+  (declare (xargs :stobjs (state)))
+  (let ((nt (f-boundp-global 'acl2s-rt-use-test-enum state)))
+    (if nt
+     (f-get-global 'acl2s-rt-use-test-enum state)
+      *default-rt-use-test-enum*)))
+
+
+(defmacro get-acl2s-random-testing-use-test-enumerator ()
+;:Doc-Section RANDOM-TESTING  
+ "Get the current setting for use of test-enumerator~/
+  ~bv[]
+  Usage:
+  (get-acl2s-random-testing-use-test-enumerator)
+  ~ev[]~/
+  "
+ '(get-acl2s-random-testing-use-test-enumerator-fn state))
+
+
+(add-acl2s-parameter 
+ search-strategy :simple
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+  
+  Specify the search strategy to be used ~/~/
+ 
+  Specify which of the following strategies to
+  use for instantiating free variables of the conjecture
+  under test: ~t[:simple] or  ~t[:incremental]
+  or  ~t[:hybrid] (untested).
+  ~t[:incremental] uses a dpll-like algorithm to search
+  for counterexamples.
+  By default this parameter is set to the symbol ~t[:simple].
+   ~bv[]
+    Usage:
+    (acl2s-defaults :set search-strategy :simple)
+    (acl2s-defaults :get search-strategy)
+    :doc search-strategy
+   ~ev[]
+   "
+ :guard (member-eq value '(:simple :incremental :hybrid)))
+;; Use natural seeds or random tree of natural numbers 
+
+(add-acl2s-parameter 
+ sampling-method :random
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+ 
+  Specify sampling method to be used to instantiate variables ~/~/
+ 
+  Specify which of the following methods to
+  use for instantiating free variables of the conjecture
+  under test: ~t[:be] or ~t[:random] or ~t[:uniform-random] or ~t[:mixed]
+  By default this parameter is set to the symbol ~t[:random]
+   ~bv[]
+    Usage:
+    (acl2s-defaults :set sampling-method :random)
+    (acl2s-defaults :get sampling-method)
+    :doc sampling-method
+   ~ev[]
+   "
+ :guard (member-eq value '(:be :uniform-random :random :mixed)))
+
+;; (add-acl2s-parameter 
+;;  flatten-defdata nil
+;;  :doc-string ":Doc-Section ACL2::TESTING
+;;  Flatten defdata instances during sampling"
+;;  Flatten defdata enumerator expressions which stand for
+;;    instances of the particular defdata type. Basically if you
+;;    have a type triple <tt>(defdata triple (list pos pos pos))</tt>,
+;;    then an instance of triple is generated (sampled) by a call to the 
+;;    enumerator expression <tt>(nth-triple n)</tt>, where <tt>n</tt>
+;;    is some natural number. Alternatively we could flatten the 
+;;    defdata instance by representing it with the enumerator 
+;;    expression <tt>(list (nth-pos n1) (nth-pos n2) (nth-pos n3))</tt>
+;;    which consists purely of instances of primitive and custom types. 
+;;    This has the nice property of distribution invariance, 
+;;    i.e. a field of a particular type has the same distribution, 
+;;    regardless of its position in the body of a complex defdata type.
+;;    By default the value of parameter is <tt>nil</tt>.
+;;    ~bv[]
+;;     Usage:
+;;     (acl2s-defaults :set flatten-defdata-instance nil)
+;;     (acl2s-defaults :get flatten-defdata-instance)
+;;     :doc flatten-defdata-instance
+;;    ~ev[]
+;;    "
+;;  :guard (booleanp value))
+
+(add-acl2s-parameter 
+ backtrack-limit 3
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+ 
+  Maximum number of backtracks allowed (per variable)~/~/
+ 
+  Maximum number of backtracks allowed by a variable.
+   The default backtrack limit is set to 3. Setting this 
+   parameter to 0, means that backtracking is disabled.
+   ~bv[]
+    Usage:
+    (acl2s-defaults :set backtrack-limit 3)
+    (acl2s-defaults :get backtrack-limit)
+    :doc backtrack-limit
+   ~ev[]
+   "
+ :guard (natp value))
+        
+
+(add-acl2s-parameter 
+ subgoal-timeout 10
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+ 
+  Testing timeout (in seconds) per subgoal~/~/
+ 
+  Maximum allowed time (in seconds) to test any 
+  subgoal or top-level form.
+  The default timeout limit is set to 10 sec.
+  Setting this parameter to 0 amounts to disabling
+  the timeout mechanism, i.e. its a no-op.
+   ~bv[]
+    Usage:
+    (acl2s-defaults :set subgoal-timeout 10)
+    (acl2s-defaults :get subgoal-timeout)
+    :doc subgoal-timeout
+   ~ev[]
+   "
+ :guard (natp value))
+
+(add-acl2s-parameter 
+ testing-enabled :naive
+ :doc-string 
+ ":Doc-Section ACL2::TESTING
+ 
+  Testing enable/disable flag~/~/
+ 
+  Testing can be enabled or disabled
+  using this parameter.
+  The default value is  ~t[:naive] (unless you are in
+  the usual ACL2 Sedan session modes, where default is ~t[t]).
+  Setting this parameter to ~t[nil] amounts to disabling
+  the testing mechanism. Setting this parameter
+  to ~t[:naive] leads to top-level testing without any
+  theorem prover support.
+  ~bv[]
+   Usage:
+   (acl2s-defaults :set testing-enabled :naive)
+   (acl2s-defaults :get testing-enabled)
+   :doc testing-enabled
+  ~ev[]
+   "
+ :guard (member-eq value '(T NIL :naive))
+ :setter set-acl2s-random-testing-enabled)
+
+(defun mem-tree (x tree)
+  (declare (xargs :guard (symbolp x)))
+  (if (atom tree)
+    (eq x tree)
+    (or (mem-tree x (car tree))
+        (mem-tree x (cdr tree)))))
+
+(defun get-acl2s-random-testing-hints-flag-fn ( state)
+  (declare (xargs :mode :program
+                  :stobjs (state)))
+  ;; bugfix 30 April '12: I had changed the name of test-each-checkpoint
+  ;; to test-checkpoint and forgot the update the fact here. Bad bad bad!
+  (and (mem-tree 'TEST-CHECKPOINT ;check if random testing is enabled
+                 (override-hints (w state)))
+       T))
+      
+
+(defdoc get-acl2s-random-testing-hints-enabled
+  ":Doc-Section ACL2::TESTING
+  
+   Get current setting for random-testing-hints-enabled~/~/
+  
+   Get current setting for random-testing-hints-enabled.
+   Returns ~t[nil] if ~t[thm] and ~t[defthm] do not make use of random-testing
+   in their proof attempts, and ~t[t] otherwise.
+   
+   ~bv[]
+    Usage:
+    (get-acl2s-random-testing-hints-enabled)
+   ~ev[]
+   ")
+
+;top-level exported macro to know wether random testing is enabled or not
+(defmacro get-acl2s-random-testing-hints-enabled ()
+ 
+ `(get-acl2s-random-testing-hints-flag-fn state))
+
+(defun set-acl2s-random-testing-flag-fn (flg mode state)
+  (declare (xargs :mode :program
+                  :stobjs (state)))
+;check if random testing is enabled by searching for the testing hint
+  (let ((flg (if (eq flg :naive) NIL flg)))
+  (if (get-acl2s-random-testing-hints-enabled)
+      ;;; TESTING hint is currently ENABLED
+    (if flg ;if enabled and user wants to set it then no-op
+      '(value-triple :REDUNDANT)
+;if enabled and user wants to turn it off
+      (if (eq mode :program)
+          '(progn ; Feb 13 2012 bug. Testing-hint cant be disabled
+             ;; in program mode. Found by Pete while using defunc.
+             ;; Reason: local forms are ignored in program mode.
+             (logic)
+             (disable-acl2s-random-testing)
+             (program))
+        '(disable-acl2s-random-testing)))
+    ;;; TESTING hint is currently disabled
+    (if flg ;if disabled and user wants to set it to t
+        (if (eq mode :program)
+            '(progn
+               (logic)
+               (enable-acl2s-random-testing)
+               (program))
+          '(enable-acl2s-random-testing))
+;if testing-hint is disabled and user wants to turn it off its no-op
+      '(value-triple :REDUNDANT)))))
+
+
+;top-level exported macro to know enable random testing
+(defmacro set-acl2s-random-testing-enabled (v forms)
+  (declare (xargs :guard (member-eq v '(T NIL :naive))))
+  `(make-event
+     (let ((mode (cdr (assoc-eq :defun-mode 
+                                (table-alist
+                                 'acl2::acl2-defaults-table 
+                                 (w state))))))
+       (let ((forms ',forms))
+          (value `(progn
+                    ,(set-acl2s-random-testing-flag-fn ,v mode state)
+                    ,@forms))))))
+
+(defmacro acl2s-defaults (&rest rst)
+  (b* (((unless (consp (cdr rst)));atleast 2 elems
+        (er hard 'acl2s-defaults
+            "~|At least 2 arguments, but given ~x0~%" rst))
+       (param (second rst))
+       (op (car rst))
+       ((unless (or (eq :get op) 
+                    (and (eq :set op)
+                         (consp (cddr rst));value
+                         )))
+        (er hard 'acl2s-defaults;TODO be more informative
+            "~|Invalid arguments supplied, given ~x0~%" rst)))
+    (if (eq :get op)
+;get the value at the point of call (runtime)
+        `(b* ((param-rec-pair
+                 (assoc-eq ',param 
+                           (table-alist 'acl2s-defaults-table 
+                                        (w state))))
+              ((unless (consp param-rec-pair))
+                 (er hard 'acl2s-defaults 
+                     "~|Parameter ~x0 not found in acl2s-defaults!~%"
+                     ',param))
+              (r (cdr param-rec-pair))
+              (val (access acl2s-param-info% r :value)))
+          val)
+
+;get the guard and value at the runtime
+;since we need access to state
+;and set the new value v
+     `(with-output
+       :off summary
+       (make-event
+        (b* ((param-rec-pair
+             (assoc-eq ',param 
+                      (table-alist 
+                       'acl2s-defaults-table (w state))))
+             ((unless (consp param-rec-pair))
+                 (er hard 'acl2s-defaults 
+                     "~|Parameter ~x0 not found in acl2s-defaults!~%"
+                     ',param))
+;guard is fixed once it is initialized INVARIANT
+             (r (cdr param-rec-pair))
+             (guard (access acl2s-param-info% r :guard))
+             (setter (access acl2s-param-info% r :setter))
+             (v (third ',rst)))
+        `(make-event ;state changing event 
+           (if (not ,(subst v 'value guard))
+               (er soft 'acl2s-defaults-table
+                 "Guard ~x0 for ~x1 in table failed for VALUE ~x2" 
+                 ',guard ',',param ',v)
+             (if ',setter
+                 (let ((table-update-form
+                        `(table acl2s-defaults-table 
+                                  ',',',param 
+                                  ',(change acl2s-param-info% ',r :value ',v))))
+;;; setter is a macro, so dont quote the args to it whereas the above
+;;; table macro needs quoted args because its 3rd parameter is &rest rst
+                  (value `(,',setter ,',v (,table-update-form));embedded event
+                        ))
+                           
+             (value `(progn
+                      (table acl2s-defaults-table 
+                             ',',',param 
+                             ',(change acl2s-param-info% ',r :value ',v))
+                      (value-triple ',',v))))))))))))
+
+
+
+;;; copied from main.lisp, since these functions are only called by
+;;; set-acl2s-random-testing-enabled, which is defined here
+
+
+;;; add no-op override hints that test each checkpoint.  The reason
+;;; why we need backtrack hint is not that we need clause-list
+;;; (children goals of clause), but because we need to do testing only
+;;; on checkpoints, and only backtrack hints have access to processor,
+;;; if this were not the case, we could have used ":no-op
+;;; '(test-each-goal ...)" as an override hint which has no effect but
+;;; to test each goal.  Another reason is that because computed-hints
+;;; with :COMPUTED-HINT-REPLACEMENT t is not additive like
+;;; override-hints it can cause a hint to be not selected otherwise.
+(defmacro enable-acl2s-random-testing ()
+;; this has to be a makevent because enable-acl2s-random-testing is the
+;; expansion result of the make-event in set-acl2s-random-testing-enabled
+`(make-event  
+  '(progn 
+     (acl2::add-override-hints 
+      '((list* :backtrack 
+;take parent pspv and hist, not the ones returned by clause-processor
+
+             `(test-checkpoint acl2::id 
+                                    acl2::clause
+                                    acl2::clause-list
+                                    acl2::processor
+;TODO:ask Matt about sending parent pspv and hist
+                                    ',acl2::pspv 
+                                    ',acl2::hist
+                                    acl2::ctx
+                                    state
+                                    )
+
+             ;; `(mv-let (erp tval state)
+             ;;          (trans-eval
+             ;;           `(test-each-checkpoint ',acl2::id 
+             ;;                                  ',acl2::clause 
+             ;;                                  ',acl2::processor 
+             ;;                                  ',',acl2::pspv 
+             ;;                                  ',',acl2::hist state
+             ;;                                  ts$)
+             ;;           'acl2s-testing ; ctx
+             ;;           state
+             ;;           t ; aok
+             ;;           )
+             ;;          (declare (ignorable erp))
+             ;;          (mv (cadr tval) (caddr tval) state))
+
+;`(test-each-checkpoint acl2::id acl2::clause acl2::processor ',acl2::pspv ',acl2::hist state)
+             acl2::keyword-alist)))
+     )))
+
+(defmacro disable-acl2s-random-testing ()
+`(make-event  
+     '(progn
+        (acl2::remove-override-hints 
+         '((list* :backtrack 
+                `(test-checkpoint acl2::id 
+                                       acl2::clause 
+                                       acl2::clause-list
+                                       acl2::processor 
+                                       ',acl2::pspv 
+                                       ',acl2::hist
+                                       acl2::ctx
+                                       state
+                                      )
+;take parent pspv and hist, not the ones returned by clause-processor
+                 ;; `(mv-let (erp tval state)
+                 ;;      (trans-eval
+                 ;;       `(test-each-checkpoint ',acl2::id 
+                 ;;                              ',acl2::clause 
+                 ;;                              ',acl2::processor 
+                 ;;                              ',',acl2::pspv 
+                 ;;                              ',',acl2::hist state
+                 ;;                              ts$)
+                 ;;       'acl2s-testing ; ctx
+                 ;;       state
+                 ;;       t ; aok
+                 ;;       )
+                 ;;      (declare (ignorable erp))
+                 ;;      (mv (cadr tval) (caddr tval) state))
+;`(test-each-checkpoint acl2::id acl2::clause acl2::processor ',acl2::pspv ',acl2::hist state)
+                acl2::keyword-alist)))
+        )))
+
+
+
+; Internal flags
+(add-acl2s-parameter 
+;show pts at the end of subgoal?
+  acl2s-pts-subgoalp NIL
+ :guard (booleanp value))
+
+
+#|ACL2s-ToDo-Line|#
+
diff -Nru acl2-6.2/books/cgen/base.lisp acl2-6.3/books/cgen/base.lisp
--- acl2-6.2/books/cgen/base.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/base.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,1140 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book t :ttags :all);$ACL2s-Preamble$|#
+
+
+(in-package "ACL2")
+
+;Data has separate package namespace 'defdata' and which implements
+;custom data definitions, type constructors(product and union)
+(include-book "defdata" :load-compiled-file :comp)
+(include-book "splitnat" :load-compiled-file :comp)
+(include-book "switchnat" :load-compiled-file :comp)
+(include-book "graph-tc" :ttags ((:hash-stobjs) (:redef+)))
+(include-book "library-support" :load-compiled-file :comp)
+(include-book "random-state" :load-compiled-file :comp)
+
+;TODO.NOTE: constructors are now stored in globals and it 
+;seems that include-book does not carry globals?? is it true?
+
+(defun allp (x)
+  (declare (xargs :mode :logic
+                  :guard t)
+           (ignore x))
+  t)
+
+(defthm allp-is-tau-predicate
+  (booleanp (allp x))
+  :rule-classes :tau-system)
+
+(defthm allp-is-t
+  (equal (allp x) t)
+  :rule-classes (:rewrite))
+
+(in-theory (disable allp))
+
+;; NOTE: ALL should not be used in subtype/disjoint relations
+;; because of a caveat in tau
+
+;;type constructors == product types
+;;rational number constructor
+;;pair constructor
+(register-data-constructor (consp cons)
+                           ((allp car) (allp cdr))
+                           :proper t)
+
+;;jared's oset implementation
+(defun sets::non-empty-setp (x)
+  (declare (xargs :guard t))
+  (and (sets::setp x)
+       (not (sets::empty x))))
+
+(register-data-constructor (SETS::non-empty-setp SETS::insert)
+                           ((allp SETS::head) (sets::setp SETS::tail))
+                           :proper nil)
+
+
+
+
+
+;;symbols
+(register-data-constructor (symbolp intern$)
+                           ((stringp symbol-name) (stringp symbol-package-name)))
+
+
+(register-data-constructor (rationalp /)
+                           ((integerp numerator) (posp denominator))
+                           :proper nil)
+
+
+ 
+;;associated key-value pairs
+(defun aconsp (x)
+  (declare (xargs :guard t))
+  (and (consp x) (consp (car x))))
+
+(register-data-constructor (aconsp acons)
+                           (caar cdar cdr)
+                           :proper t
+                           :rule-classes nil;(:rewrite)
+                           :forcep t) 
+
+;;complex number type
+(register-data-constructor (acl2-numberp complex)
+                           ((rationalp realpart) (rationalp imagpart))
+                           :proper t)
+
+#||
+;;natural numbers
+(defexec succ (x)
+  (declare (xargs :guard (natp x)))
+  (mbe :logic
+       (if (natp x)
+         (1+ x)
+         1)
+       :exec (1+ x)))
+
+(defun pred (x)
+  (declare (xargs :guard (natp x)))
+  (if (zp x)
+    0
+    (1- x)))
+
+(defthm succ-pred
+  (implies (posp x)
+           (equal (succ (pred x)) x)))
+
+(register-data-constructor (posp succ)
+                           (pred))
+||#
+
+
+;;characters
+
+(defconst *character-values* '(
+           #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j
+           #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t
+           #\u #\v #\w #\x #\y #\z                    
+           #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+           #\A #\B
+           #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L
+           #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V
+           #\W #\X #\Y #\Z 
+           ))
+
+
+(defthm integerp-mod
+    (implies (and (integerp m)
+                  (integerp n))
+	     (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription))
+
+
+(encapsulate 
+ nil
+ (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
+ 
+ (defthm mod-nonnegative-integer-args
+   (implies (and (integerp x)
+                 (integerp y)
+                 (< 0 y))
+            (<= 0 (mod x y)))
+   :rule-classes ((:rewrite :backchain-limit-lst 1)
+                  (:type-prescription)))
+ 
+
+(defun get-character-list-from-positions (l)
+  (declare (xargs :guard (naturals-listp l)))
+                  ;:verify-guards nil))
+  (if (endp l)
+    nil
+    (let* ((pos (mod (car l) (len *character-values*)))
+           (char (nth pos *character-values*)))
+      (cons char (get-character-list-from-positions (cdr l))))))
+
+(defun get-standard-char-list-from-positions (l)
+  (declare (xargs :guard (naturals-listp l)))
+  (if (endp l)
+    nil
+    (let* ((pos (mod (car l) (len *standard-chars*)))
+           (char (nth pos *standard-chars*)))
+      (cons char (get-standard-char-list-from-positions (cdr l))))))
+
+(defthm get-character-list-from-positions--character-listp
+  (implies (naturals-listp l)
+           (and (character-listp (get-character-list-from-positions l))
+                (standard-char-listp (get-standard-char-list-from-positions l))))
+  :hints (("goal" :in-theory (enable standard-char-listp))))
+
+)
+(in-theory (disable mod))
+;;booleans
+(define-enumeration-type boolean '(t nil))
+
+
+
+;-------- define some enumerators --------;
+
+(defun nth-nat (n)
+  (declare (xargs :guard (natp n)))
+  n)
+
+(defun nat-index (n)
+  (declare (xargs :guard (natp n)))
+  n)
+
+(defthm nth-nat-index
+  (equal (nat-index (nth-nat n))
+         n))
+
+(defthm nat-index-nth
+  (equal (nth-nat (nat-index n))
+         n))
+
+
+(defexec nth-pos (n)
+  (declare (xargs :guard (natp n)))
+  (mbe :logic
+       (if (natp n)
+         (1+ n)
+         n)
+       :exec (1+ n)))
+
+(defexec pos-index (i)
+  (declare (xargs :guard (posp i)))
+  (mbe :logic
+       (if (posp i)
+         (1- i)
+         i)
+       :exec (1- i)))
+
+(defthm nth-pos-index
+  (equal (pos-index (nth-pos n))
+         n))
+
+(defthm pos-index-nth
+  (implies (and (integerp i)
+                (>= i 1))
+           (equal (nth-pos (pos-index i))
+                  i)))
+
+
+(defun pos-multiple-of-threep (v)
+  (if (posp v)
+    (equal 0 (mod v 3))
+    nil)) 
+(defun nth-pos-multiple-of-three (n)
+ (if (natp n) 
+   (* 3 (1+ n))
+   3))
+
+(defun pos-multiple-of-three-index (i)
+  (if (pos-multiple-of-threep i)
+         (1- (floor i 3))
+         i))
+
+;;integers
+(defun nth-integer (n)
+  (declare (xargs :guard (natp n)))
+  (let* (;(n (mod n 1000))
+         (mag (floor n 2))
+        (sign (rem n 2)))
+    (if (= sign 0)
+      mag
+      (- -1 mag))))
+
+(defun nth-integer-between (n lo hi)
+  (declare (xargs :guard (and (natp n)
+                              (integerp lo)
+                              (integerp hi))))
+  (let ((range (nfix (- hi lo))))
+    (+ lo (mod n (1+ range)))))
+
+(defun integer-index (i)
+  (declare (xargs :guard (integerp i)))
+  (if (< i 0)
+    (1+ (* (- (1+ i)) 2))
+    (* i 2)))
+#||
+(encapsulate nil
+  (local 
+   (include-book "arithmetic-5/top" :dir :system))
+
+  (defthm nth-pos-multiple-three-type
+    (pos-multiple-of-threep (nth-pos-multiple-of-three n)))
+  
+  
+  (defthm nth-pos-multiple-of-three-index
+    (implies (natp n)
+             (equal (pos-multiple-of-three-index (nth-pos-multiple-of-three n))
+                    n)))
+  
+  (defthm pos-multiple-of-three-index-nth
+    (implies (pos-multiple-of-threep i)
+             (equal (nth-pos-multiple-of-three (pos-multiple-of-three-index i))
+                    i)))    
+
+  
+  (defthm nth-integer-index
+    (implies 
+     (and (integerp n)
+          (>= n 0))
+     (equal (integer-index (nth-integer n))
+            n)))
+  (defthm integer-index-nth
+    (implies 
+     (integerp i)
+     (equal (nth-integer (integer-index i))
+            i))))
+||#
+
+
+;;only strings upto len 1 to 8
+(defun nth-string (n)
+  (declare (xargs :guard (natp n)))
+                  ;:verify-guards nil))
+  (let* ((str-len (1+ (mod n 7)))
+         (char-pos-list (defdata::split-nat str-len n))
+         (charlist (get-character-list-from-positions char-pos-list)))
+    (coerce charlist 'string)))
+
+(defun standard-stringp (x)
+  (declare (xargs :guard t))
+  (and (stringp x)
+       (standard-char-listp (coerce x 'list))))
+
+(defun nth-standard-string (n)
+  (declare (xargs :guard (natp n)))
+                  ;:verify-guards nil))
+  (let* ((str-len (1+ (mod n 7)))
+         (char-pos-list (defdata::split-nat str-len n))
+         (charlist (get-standard-char-list-from-positions char-pos-list)))
+    (coerce charlist 'string)))
+
+;; 
+(defun nth-symbol (n)
+  (declare (xargs :guard (natp n)))
+                 ;:verify-guards nil)) 
+  (intern-in-package-of-symbol (nth-string n) 'acl2::acl2-pkg-witness))
+
+
+(defun positive-ratiop (x)
+  (declare (xargs :guard t))
+  (and (rationalp x)
+       (not (integerp x))
+       (> x 0)
+       ))
+
+(defun nth-positive-ratio (n)
+  (declare (xargs :guard (natp n)))
+  (mbe :logic (if (natp n)
+                 (let* ((two-n-list (defdata::split-nat 2 n))
+                        (alpha  (car two-n-list))
+                        (beta (cadr two-n-list))
+                        (den (+ 2 alpha))
+                        (num (+ (floor beta den) beta)))
+                   (/ num den))
+                 (/ 1 2))
+       :exec (let* ((two-n-list (defdata::split-nat 2 n))
+                    (alpha  (car two-n-list))
+                    (beta (cadr two-n-list))
+                    (den (+ 2 alpha))
+                    (num (+ (floor beta den) beta)))
+               (/ num den))))
+
+
+
+(defun negative-ratiop (x)
+  (declare (xargs :guard t))
+  (and (rationalp x)
+       (not (integerp x))
+       (< x 0)
+       ))
+
+
+(defun nth-negative-ratio (n)
+  (declare (xargs :guard (natp n)))
+  (let* ((two-n-list (defdata::split-nat 2 n))
+         (alpha  (car two-n-list))
+         (beta (cadr two-n-list))
+         (den (+ 2 alpha))
+         (num (+ (floor beta den) beta)))
+    (- 0 (/ num den))))
+
+
+;(defdata rat (oneof 0 positive-ratio negative-ratio))
+;DOESNT WORK so positive/negative ratio are not consistent types ;TODO
+;(local (include-book "arithmetic-5/top" :dir :system))
+;(thm (nat-listp (defdata::split-nat 2 n)))
+;(thm (positive-ratiop (nth-positive-ratio n)))
+
+
+(defun negp (x)
+  (declare (xargs :guard t))
+  (and (integerp x) 
+       (< x 0)
+       ))
+(defun nth-neg (n)
+  (declare (xargs :guard (natp n)))
+  (- -1 n))
+ 
+#|
+(defdata int (oneof 0 pos neg))
+(thm (iff (integerp x) (intp x)))
+|#
+
+(defun nth-positive-rational (n)
+  (declare (xargs :guard (natp n)))
+  (let* ((two-n-list (defdata::split-nat 2 n))
+         (num (nth-pos (car two-n-list)))
+         (den (nth-pos (cadr two-n-list))))
+    (/ num den)))
+
+(defun nth-negative-rational (n)
+  (declare (xargs :guard (natp n)))
+  (let* ((two-n-list (defdata::split-nat 2 n))
+         (num (nth-neg (car two-n-list)))
+         (den (nth-pos (cadr two-n-list))))
+    (/ num den)))
+(defun positive-rationalp (x)
+  (declare (xargs :guard t))
+  (and (rationalp x) 
+       (> x 0)
+       ))
+(defun negative-rationalp (x)
+  (declare (xargs :guard t))
+  (and (rationalp x) 
+       (< x 0)
+       ))
+
+;(defdata rational (oneof 0 positive-rational negative-rational))
+(defun nth-rational (n)
+  (declare (xargs :guard (natp n)))
+  (let* ((two-n-list (defdata::split-nat 2 n))
+         (num (nth-integer (car two-n-list)))
+         (den (nth-pos (cadr two-n-list))))
+    (/ num den)))
+
+ ;lo included, hi included
+    
+  
+(defun nth-rational-between (n lo hi);inclusive
+  (declare (xargs :guard (and (natp n)
+                              (rationalp lo)
+                              (rationalp hi))))
+
+  (let* ((two-n-list (defdata::split-nat 2 n))
+         (den (nth-pos (car two-n-list)))
+         (num (nth-integer-between (cadr two-n-list) 0 (1+ den)))
+         (range (- hi lo)))
+    (+ lo (* (/ num den) range))))       
+
+
+(defun nth-complex-rational (n)
+  (declare (xargs :guard (natp n)))
+  (let* ((two-n-list (defdata::split-nat 2 n))
+         (rpart (nth-rational (defdata::nfixg (car two-n-list))))
+         (ipart (nth-rational (defdata::nfixg (cadr two-n-list)))))
+    (complex rpart ipart)))
+
+(defun nth-acl2-number (n)
+  (declare (xargs :guard (natp n)))
+  (b* (((mv choice seed)
+        (defdata::switch-nat 4 n)))
+    (case choice
+          (0 (nth-nat seed))
+          (1 (nth-integer seed))
+          (2 (nth-rational seed))
+          (t (nth-complex-rational seed)))))
+
+;(defdata character-list (listof character))
+;;only strings upto len 1 to 8
+(defun nth-character-list (n)
+  (declare (xargs :guard (natp n)))
+                  ;:verify-guards nil))
+  (let* ((str-len (1+ (mod n 7)))
+         (char-pos-list (defdata::split-nat str-len n))
+         (charlist (get-character-list-from-positions char-pos-list)))
+    charlist))
+
+(defun nth-standard-char-list (n)
+  (declare (xargs :guard (natp n)))
+                  ;:verify-guards nil))
+  (let* ((str-len (1+ (mod n 7)))
+         (char-pos-list (defdata::split-nat str-len n))
+         (charlist (get-standard-char-list-from-positions char-pos-list)))
+    charlist))
+
+#||
+(defconst *base-types* '((BOOLEAN 2 *BOOLEAN-VALUES* . BOOLEANP)
+                         (CHARACTER-LIST T NTH-CHARACTER-LIST . CHARACTER-LISTP)
+                         (SYMBOL T NTH-SYMBOL . SYMBOLP)
+                         (STRING T NTH-STRING . STRINGP)
+                         (CHARACTER 62 *CHARACTER-VALUES* . CHARACTERP)
+                         (ACL2-NUMBER T NTH-ACL2-NUMBER . ACL2-NUMBERP)
+                         (COMPLEX-RATIONAL T NTH-COMPLEX-RATIONAL . COMPLEX-RATIONALP)
+                         (RATIONAL T NTH-RATIONAL . RATIONALP)
+                         (POS T NTH-POS . POSP)
+                         (NAT T NTH-NAT . NATP)
+                         (INTEGER T NTH-INTEGER . INTEGERP)))
+(defun nth-all (n)
+  (declare (xargs :guard (natp n))
+                  :verify-guards nil)
+  (let* ((num-types (len *base-types*))
+         (two-n-list (defdata::split-nat 2 n))
+         (choice (mod (car two-n-list) num-types))
+         (seed (cadr two-n-list))
+         (type-info (cdr (nth choice *base-types*)))
+         (type-size (car type-info))
+         (type-enum (cadr type-info)))
+    (if (eq type-size 't) ;inf
+      `(,type-enum ,seed)
+      `(nth ,(mod seed type-size) ,type-enum))))||#
+
+
+;ADDED restricted testing enumerators for all number types
+(defun nth-nat-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-nat n-small)))
+(defun nth-pos-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-pos n-small)))
+(defun nth-neg-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-neg n-small)))
+
+(defun nth-integer-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-integer n-small)))
+
+(defun nth-positive-ratio-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-positive-ratio n-small)))
+(defun nth-negative-ratio-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-negative-ratio n-small)))
+(defun nth-rational-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-rational n-small)))
+(defun nth-positive-rational-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-positive-rational n-small)))
+(defun nth-negative-rational-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-negative-rational n-small)))
+(defun nth-acl2-number-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-acl2-number n-small)))
+(defun nth-complex-rational-testing (n)
+  (declare (xargs :guard (natp n)))
+  (let ((n-small (mod n 1000)))
+    (nth-complex-rational n-small)))
+
+
+
+(defun atomp (v)
+  (declare (xargs :guard t))
+  (atom v))
+
+(defun nth-atom (n)
+  (declare (xargs :guard (natp n)))
+  (b* (((mv choice seed) 
+        (defdata::weighted-switch-nat 
+          '(1  ;nil
+            1  ;t
+            3  ;nat
+            1  ;sym
+            1  ;string
+            2  ;char
+            2  ;acl2-num
+            10 ;rational
+            10 ;pos
+            20 ;0
+            30 ;integer
+            ) n)))
+        
+    (case choice
+          (0 'nil)
+          (1 't)
+          (2 (nth-nat-testing seed));smaller numbers
+          (3 (nth-symbol seed))
+          (4 (nth-string seed))
+          (5 (nth (mod seed (len *character-values*)) *character-values*))
+          (6 (nth-acl2-number seed))
+          (7 (nth-rational seed))
+          (8 (nth-pos-testing seed))
+          (9 0)
+          (t (nth-integer-testing seed)))))
+
+;(defdata atom (oneof acl2-number character symbol string))
+
+
+;atoms
+;register-custom-type does two things:
+;1. Stores type information (predicate, enum, size) in a table types-info-table
+;2. Add the types in the data-type graphs that capture subtype/disjoint relations
+;3. TODO:Note it does not prove that type is sound neither that is is complete
+;Note:
+;By Type Soundness i mean (thm (implies (natp n) (Tp (nth-T n)))
+;By Type Completeness i mean (thm (implies (Tp x)
+;                                          (equal x (nth-T (T-index x)))) 
+;                                   where (nth-T (T-index x)) = x
+(register-custom-type nat t nth-nat natp)
+(register-custom-type pos t nth-pos  posp )
+(register-custom-type neg t nth-neg negp )
+(register-custom-type integer t nth-integer integerp )
+(register-custom-type positive-ratio t nth-positive-ratio  positive-ratiop)
+(register-custom-type negative-ratio t nth-negative-ratio  negative-ratiop )
+(register-custom-type positive-rational t nth-positive-rational  positive-rationalp )
+(register-custom-type negative-rational t nth-negative-rational  negative-rationalp )
+(register-custom-type rational t nth-rational  rationalp )
+(register-custom-type complex-rational t nth-complex-rational  complex-rationalp )
+(register-custom-type acl2-number t nth-acl2-number  acl2-numberp )
+;(register-custom-type boolean 2 *boolean-values*  booleanp );taken care of by define-enumeration-type
+(register-custom-type symbol t nth-symbol  symbolp)
+
+;MAKE SURE THIS IS ALWAYS SYNCED, if you change character-values then change here too!
+;(len *character-values*) = 62
+(defun nth-character (n)
+  (declare (xargs :guard (natp n)))
+  (nth (mod n 62) *character-values*))
+
+(defun nth-character-uniform (m seed)
+    (declare (ignorable m))
+     (declare (type (unsigned-byte 31) seed))
+     (declare (xargs :guard (and (natp m)
+                                 (unsigned-byte-p 31 seed))))
+     (mv-let (n seed)
+             (defdata::random-natural-seed seed)
+             (mv (nth-character n) (the (unsigned-byte 31) seed))))
+   
+(register-custom-type character 62 *character-values* characterp :enum-uniform nth-character-uniform)
+
+(define-enumeration-type standard-char *standard-chars*)
+;; (register-custom-type standard-char 96 *standard-chars*  standard-char-p)
+(register-custom-type string t nth-string stringp)
+(register-custom-type standard-string t nth-standard-string standard-stringp)
+(register-custom-type atom t nth-atom atom);instead of atomp Exception
+
+;added the above atom primitive types in the data-type graph using register-custom-type
+
+;custom type
+(defconst *z-values* '(0 -1 "a" 1/3 :a)) ;for zp
+(defun nth-z (n)
+  (declare (xargs :guard (natp n)))
+  (nth (mod n 5) *z-values*))
+(defun nth-z-uniform (m seed)
+    (declare (ignorable m))
+     (declare (type (unsigned-byte 31) seed))
+     (declare (xargs :guard (and (natp m)
+                                 (unsigned-byte-p 31 seed))))
+     (mv-let (n seed)
+             (defdata::random-natural-seed seed)
+             (mv (nth-z n) (the (unsigned-byte 31) seed))))
+(register-custom-type z t nth-z zp :enum-uniform nth-z-uniform)
+
+
+;Subtype relations betweem the above
+;pos is a subtype of nat (Note the direction)
+(defdata-subtype pos nat)
+
+;nat is a subtype of integer
+(defdata-subtype nat integer)
+(defdata-subtype neg integer)
+(defdata-subtype integer rational)
+(defdata-subtype positive-ratio rational)
+(defdata-subtype positive-rational rational) ;Aug 18 2011
+(defdata-subtype negative-ratio rational)
+(defdata-subtype negative-rational rational) ;Aug 18 2011
+(defdata-subtype complex-rational acl2-number)
+(defdata-subtype rational acl2-number)
+(defdata-subtype acl2-number atom)
+(defdata-subtype boolean symbol)
+(defdata-subtype character atom)
+(defdata-subtype string atom)
+(defdata-subtype symbol atom)
+
+(defdata ratio (oneof positive-ratio negative-ratio) :declare-guards t)
+(defdata-subtype ratio rational) 
+
+;added 26th Sep '13
+(defdata-subtype neg negative-rational)
+(defdata-subtype pos positive-rational) 
+(defdata-subtype negative-rational z)
+(defdata-subtype ratio z)
+(defdata-subtype complex-rational z)
+(defdata-subtype symbol z)
+(defdata-subtype character z)
+(defdata-subtype string z)
+(defdata-disjoint pos z)
+
+;(assign make-event-debug t)
+;(set-acl2s-defdata-verbose t)
+
+;Disjoint relations between the above types
+(defdata-disjoint acl2-number character)
+(defdata-disjoint acl2-number symbol)
+(defdata-disjoint character string)
+(defdata-disjoint character symbol)
+(defdata-disjoint string symbol)
+
+;(assign make-event-debug t)
+;lists of atoms
+(defthm termination-tree-enum-cdr
+  (implies (consp x)
+           (and (< (acl2-count (cdr x))
+                   (acl2-count x))
+                (< (acl2-count (car x))
+                   (acl2-count x)))))
+(defthm termination-tree-enum-dec
+  (implies (< (acl2-count x1) (acl2-count x2))
+           (and (< (acl2-count (car x1)) (acl2-count x2))
+                (< (acl2-count (cdr x1)) (acl2-count x2)))))
+(defthm terminination-tree-enum-nth
+  (<= (acl2-count (nth i x))
+              (acl2-count x))
+  :rule-classes (:rewrite :linear))
+
+(defthm termination-tree-enum-dec2
+  (implies (< (acl2-count x1) (acl2-count x2))
+           (< (acl2-count (nth i x1)) (acl2-count x2)))
+  :hints (("Goal" :in-theory (disable nth))))
+
+
+; harshrc Sep 3rd 2012
+; declare-guards T means that enumerators will be generated with
+; :guard (natp x). Note that now on, all predicates generated have
+; :guard T 
+
+
+(defdata nat-list (listof nat) :declare-guards t) 
+(verify-termination pos-listp) ; pos-listp is in program mode, so we need this.
+(verify-guards pos-listp)
+(defdata    pos-list (listof pos) :declare-guards t)
+(defdata    integer-list (listof integer) :declare-guards t)
+(defdata    rational-list (listof rational) :declare-guards t)
+(defdata    complex-rational-list (listof complex-rational) :declare-guards t)
+(defdata acl2-number-list (listof acl2-number) :declare-guards t)
+(defdata boolean-list (listof boolean) :declare-guards t)
+(defdata symbol-list    (listof symbol) :declare-guards t)
+(register-custom-type character-list t nth-character-list  character-listp)
+(register-custom-type standard-char-list t nth-standard-char-list  standard-char-listp)
+(defdata string-list (listof string) :declare-guards t)
+(verify-termination atom-listp)
+(defdata atom-list (listof atom) :declare-guards t)
+
+(defdata-subtype pos-list nat-list)
+(defdata-subtype nat-list integer-list)
+(defdata-subtype integer-list rational-list)
+(defdata-subtype complex-rational-list acl2-number-list)
+(defdata-subtype rational-list acl2-number-list )
+(defdata-subtype acl2-number-list atom-list)
+(defdata-subtype boolean-list symbol-list)
+(defdata-subtype character-list atom-list)
+(defdata-subtype string-list atom-list)
+(defdata-subtype symbol-list atom-list)
+
+
+;cons
+(defdata cons-atom (cons atom atom) :declare-guards t)
+(defdata-disjoint cons-atom atom)
+
+
+(defdata cons-ca-ca (cons cons-atom cons-atom) :declare-guards t)           
+(defdata cons-cca-cca (cons cons-ca-ca cons-ca-ca) :declare-guards t)
+
+;TODO.NOTE: Note that all the enumerators defined below are purely heuristic and 
+;are not consistent/complete with their respective predicates.
+
+(defun nth-all (n)
+  (declare (xargs :guard (natp n) ))
+                  ;;:verify-guards nil))
+  (b* (((mv choice seed)
+        (defdata::weighted-switch-nat 
+          '(1  ;nil
+            1  ;t
+            1 ;0
+            1 ;integer
+            1  ;bool
+            1  ;charlist
+            1  ;sym
+            1  ;string
+            2  ;char
+            1  ;acl2-num
+            5 ;rational
+            5 ;nat
+            5 ;pos
+            5  ;rational-list
+            2  ;sym-list
+            20 ;cons-atom
+            5  ;nat-list
+            10  ;cons-cons-atom
+            1  ;stringlist
+            10  ;atom-list
+            ) n)))
+      
+    (case choice
+          (0 'nil)
+          (1 't)
+          (2 0)
+          (3 (nth-integer-testing seed))
+          (4 (nth (mod seed 2) *boolean-values*))
+          (5 (nth-nat-list seed))
+          (6 (nth-symbol seed))
+          (7 (nth-string seed))
+          (8 (nth (mod seed (len *character-values*)) *character-values*))
+          (9 (nth-acl2-number seed))
+          (10 (nth-rational seed))
+          (11 (nth-nat-testing seed))
+          (12 (nth-pos-testing seed))
+          (13 (nth-rational-list seed))
+          (14 (nth-symbol-list seed))
+          (15 (nth-cons-atom seed))
+          (16 (nth-character-list seed))
+          (17 (nth-cons-ca-ca seed))
+          (18 (nth-string-list seed))
+          (19 (nth-atom-list seed))
+          (t 'nil)))) ;this case should not come up
+
+
+(register-custom-type all t nth-all  allp)
+
+
+;We will also name a special type, the empty type, which has no elements in its typeset.
+(defconst *empty-values* '())
+(defun nth-empty (x)
+  (declare (ignore x) (xargs :guard (natp x)))
+  (er hard? 'nth-empty "~| Empty enumerator~%"))
+;TODO - if type is already registered, then we should be able to pick the predicate
+;from the table instead of syntactically from the type.
+(defun emptyp (x)
+  (declare (ignore x) (xargs :guard t))
+  nil)
+
+(defthm emptyp-is-tau-predicate 
+    (booleanp (emptyp x))
+  :rule-classes :tau-system)
+
+(register-custom-type empty 0 *empty-values*  emptyp)
+;NOTE: empty is a special type, so we treat it specially and seperately, rather than the
+;usual way of going through the data type graph, and it might lead to inconsistency
+;with the ACL2 axioms about datatypes.
+
+(defdata cons (cons all all) :declare-guards t)
+(defdata acons (cons (cons all all) all) :declare-guards t)
+(defdata list (oneof cons nil) :declare-guards t)
+
+(DEFUNS (NTH-TRUE-LIST
+               (X)
+               (DECLARE (XARGS :guard (natp x) 
+                               :MEASURE (NFIX X)))
+               (IF (OR (NOT (INTEGERP X)) (< X 1))
+                   'NIL
+                   (LET ((X (- X 1)))
+                        (LET ((INFXLST (DEFDATA::SPLIT-NAT 2 X)))
+                             (CONS (LET ((X (NTH 0 INFXLST))) (NTH-ALL X))
+                                   (LET ((X (NTH 1 INFXLST)))
+                                        (NTH-TRUE-LIST X))))))))
+
+(register-custom-type true-list t nth-true-list true-listp)
+
+(defdata alist (listof (cons all all)) :declare-guards t)
+(defdata symbol-alist (listof (cons symbol all)) :declare-guards t)
+(verify-termination character-alistp)
+(defdata character-alist (listof (cons character all)) :declare-guards t)
+(defdata r-symbol-alist (listof (cons all symbol)) :declare-guards t)
+(defdata standard-string-alist (listof (cons standard-string all)) :declare-guards t)
+(defdata-subtype symbol-alist alist)
+(defdata-subtype character-alist alist)
+(defdata-subtype r-symbol-alist alist)
+(defdata-subtype standard-string-alist alist)
+
+(verify-guards nth-true-list)
+(defdata true-list-list (listof true-list) :declare-guards t)
+(defdata-subtype true-list-list true-list)
+
+
+(defdata-subtype acons cons)
+(defdata-subtype cons all)
+(defdata-subtype atom all)
+(defdata-subtype atom-list true-list)
+(defdata-subtype alist true-list)
+(defdata-subtype list all)
+(defdata-subtype true-list list)
+
+;added 26th Sep '13
+(defdata-subtype cons z)
+(defdata-subtype list z)
+
+
+(defun all-but-zero-nil-tp (x)
+  (declare (xargs :guard t))
+  (and (not (equal x 0))
+       (not (equal x 't))
+       (not (equal x 'nil))))
+            
+(defun nth-all-but-zero-nil-t (n)
+  (declare (xargs :guard (natp n)))
+  (b* (((mv choice seed)
+          (defdata::weighted-switch-nat 
+            '(1 ;integer
+              1  ;charlist
+              1  ;sym
+              1  ;string
+              2  ;char
+              1  ;pos
+              5 ;positive-ratio
+              5 ;negative-ratio
+              5 ;complex-rational
+              5  ;rational-list
+              2  ;sym-list
+              20 ;cons-atom
+              5  ;nat-list
+              10  ;cons-cons-atom
+              1  ;stringlist
+              10  ;atom-list
+              ) n)))
+    
+    (case choice
+          (0 (nth-integer-testing seed))
+          (1 (nth-character-list seed))
+          (2 (nth-symbol seed))
+          (3 (nth-string seed))
+          (4 (nth (mod seed (len *character-values*)) *character-values*))
+          (5 (nth-pos-testing seed))
+          (6 (nth-positive-ratio seed))
+          (7 (nth-negative-ratio seed))
+          (8 (nth-complex-rational seed))
+          (9 (nth-rational-list seed))
+          (10 (nth-symbol-list seed))
+          (11 (nth-cons-atom seed))
+          (12 (nth-nat-list seed))
+          (13 (nth-cons-ca-ca seed))
+          (14 (nth-string-list seed))
+          (15 (nth-atom-list seed))
+          (t 1))))
+
+(register-custom-type all-but-zero-nil-t t nth-all-but-zero-nil-t  all-but-zero-nil-tp)
+
+            
+(defun nth-wf-key (n) ;;since nth-all-but-zero-nil-t has strings of length less than 8, it cannot include the ill-formed-key
+  (declare (xargs :guard (natp n)))
+  (nth-all-but-zero-nil-t n))
+
+(register-custom-type wf-key t nth-wf-key  wf-keyp)
+
+;; (register-data-constructor (good-map mset)
+;;                            ((wf-keyp caar) (allp cdar) (good-map cdr))
+;;                            :proper nil)
+(PROGN (DEFTHM MSET-CONSTRUCTOR-PRED
+                (IMPLIES (AND (WF-KEYP CAAR)
+                              (ALLP CDAR)
+                              (GOOD-MAP CDR))
+                         (GOOD-MAP (MSET CAAR CDAR CDR)))
+                :HINTS NIL
+                :RULE-CLASSES NIL)
+        ;; (DEFTHM MSET-CONSTRUCTOR-ELIM-RULE
+        ;;         (IMPLIES (GOOD-MAP X)
+        ;;                  (EQUAL (MSET (CAAR X) (CDAR X) (CDR X))
+        ;;                         X))
+        ;;         :HINTS NIL
+        ;;         :RULE-CLASSES NIL)
+        (DEFTHM MSET-CONSTRUCTOR-DESTRUCTORS
+          (IMPLIES (GOOD-MAP X)
+                         (AND (WF-KEYP (CAAR X))
+                              (ALLP (CDAR X))
+                              (GOOD-MAP (CDR X))))
+                :RULE-CLASSES NIL
+                :HINTS NIL)
+        (TABLE DATA-CONSTRUCTORS 'MSET
+               '(NIL GOOD-MAP
+                     ((CAAR . WF-KEYP)
+                      (CDAR . ALLP)
+                      (CDR . GOOD-MAP))
+                     . DEFDATA::NONE)
+               :PUT)
+        (VALUE-TRIPLE (LIST '(GOOD-MAP MSET)
+                            '((WF-KEYP CAAR)
+                              (ALLP CDAR)
+                              (GOOD-MAP CDR)))))
+
+(defdata-subtype all-but-zero-nil-t all)
+
+(defdata cons-cccca-cccca (cons cons-cca-cca cons-cca-cca) :declare-guards t)
+(defdata cons-a-ca (cons atom cons-atom) :declare-guards t)
+(defdata cons-a-cca (cons atom cons-ca-ca) :declare-guards t)
+(defdata cons-a-cccca (cons atom cons-cca-cca) :declare-guards t)
+(defdata cons-ca-cca (cons cons-atom cons-ca-ca) :declare-guards t)
+(defdata cons-ca-cccca (cons cons-atom cons-cca-cca) :declare-guards t)
+;(verify-guards allp)
+(defdata cons-all-all-but-zero-nil-t (cons all all-but-zero-nil-t) :declare-guards t)
+
+(defun nth-improper-cons (n)
+  (declare (xargs :guard (natp n)))
+                  
+  (b* (((mv choice seed)
+        (defdata::weighted-switch-nat 
+          '(
+            1  ;cons-all-all-but-zero-nil-t
+            1  ;cons-ca-ca
+            1  ;cons-a-ca
+            1  ;cons-a-cca
+            1  ;cons-a-cccca
+            1  ;cons-cccca-cccca
+            1  ;cons-ca-cca
+            1  ;cons-ca-cccca
+            ) n)))
+    
+    (case choice
+      (0 (nth-cons-all-all-but-zero-nil-t seed))
+      (1 (nth-cons-ca-ca seed))
+      (2 (nth-cons-a-ca seed))
+      (3 (nth-cons-a-cca seed))
+      (4 (nth-cons-a-cccca seed))
+      (5 (nth-cons-cccca-cccca seed))
+      (6 (nth-cons-ca-cca seed))
+      (7 (nth-cons-ca-cccca seed))
+      (t '(1 . 2)))))
+
+(register-custom-type improper-cons t nth-improper-cons  improper-consp)
+
+(defdata-subtype improper-cons cons)
+
+(defdata list-aaaall (list atom atom atom all) :declare-guards t)
+
+(defdata list-a-ca (list atom cons-atom) :declare-guards t)
+(defdata list-aa-ca (list atom atom atom cons-atom) :declare-guards t)
+(defdata list-aa-cca (list atom atom cons-ca-ca) :declare-guards t)
+(defdata list-aaaa-cccca (list cons-atom cons-cca-cca) :declare-guards t)
+(defdata list-ca-cca (list cons-atom cons-ca-ca) :declare-guards t)
+(defdata list-ca-cccca (list cons-atom cons-cca-cca) :declare-guards t)
+(defdata list-cccca-cccca (list cons-cca-cca cons-cca-cca) :declare-guards t)
+
+;MAJOR CHANGE June 6th 2010, now we have no guards in any enumerators
+(defun nth-proper-cons (n)
+  (declare (xargs :guard (natp n)))
+                  
+  (b* (((mv choice seed)
+        (defdata::weighted-switch-nat 
+          '(
+            1  ;list-aaaall
+            1  ;list-a-ca
+            1  ;list-aa-ca 
+            1  ;list-aa-cca
+            1  ;list-aaaa-cccca
+            1  ;list-ca-cca
+            1  ;list-ca-cccca
+            1  ;list-cccca-cccca
+            ) n)))
+
+    (case choice
+      (0 (nth-list-aaaall seed))
+      (1 (nth-list-a-ca seed))
+      (2 (nth-list-aa-ca  seed))
+      (3 (nth-list-aa-cca seed))
+      (4 (nth-list-aaaa-cccca seed))
+      (5 (nth-list-ca-cca seed))
+      (6 (nth-list-ca-cccca seed))
+      (7 (nth-list-cccca-cccca seed))
+      (t '(1  2)))))
+
+(register-custom-type proper-cons t nth-proper-cons  proper-consp)
+(defdata-subtype proper-cons cons)
+
+;this was missing before and so we werent inferring proper-consp when
+;type-alist knew both true-listp and proper-consp, and this is common in ACL2
+(defdata-subtype proper-cons  true-list)
+
+(defdata-disjoint proper-cons improper-cons)
+(defdata-disjoint atom cons)
+
+
+
+;new exports
+(defmacro disjoint-p (T1 T2)
+   ":Doc-Section DATA-DEFINITIONS
+  top-level query wether two types are disjoint~/
+  ~c[(disjoint-p T1 T2)] asks the question
+  are T1, T2 disjoint? This call makes a quick
+  lookup into the internal data type graph where
+  disjoint relation information provided by the user
+  in the past is stored and used to compute the
+  disjoint relation closure. If they are pairwise
+  disjoint (according to the computed information)
+  then we get back an affirmative , i.e ~c[t]. otherwise
+  it returns ~c[nil].
+  
+  ~bv[]
+  Examples:
+  (disjoint-p cons list)
+  (disjoint-p pos acl2-number)
+  (disjoint-p integer complex)
+  ~ev[]                      
+  ~bv[]
+  Usage:
+  (disjoint-p <Type-name1> <Type-name2>)
+  ~ev[]~/
+  "
+   `(trans-eval '(is-disjoint$$ ',t1 ',t2 R$ types-ht$) 'is-disjoint state nil))
+;  `(is-disjoint ',T1 ',T2 R$ types-ht$))
+
+
+(defmacro show-acl2s-defdata-all-types ()
+  `(table-alist 'defdata::types-info-table (w state)))
+
+(defmacro subtype-p (T1 T2)
+   ":Doc-Section DATA-DEFINITIONS
+  top-level query wether two types are disjoint~/
+  ~c[(subtype-p T1 T2)] asks the question
+  is T1 a subtype of T2? This call makes a quick
+  lookup into the internal data type graph where
+  subtype relation information provided by the user
+  in the past is stored and used to compute the
+  subtype relation closure. If T1 is indeed a subtype
+  of T2 (according to the computed information)
+  then we get back an affirmative , i.e ~c[t]. otherwise
+  it returns ~c[nil].
+  
+  ~bv[]
+  Examples:
+  (subtype-p boolean atom)
+  (subtype-p character string)
+  (subtype-p list cons)
+  ~ev[]                      
+  ~bv[]
+  Usage:
+  (subtype-p <Type-name1> <Type-name2>)
+  ~ev[]~/
+  "
+   `(trans-eval '(is-subtype$$ ',t1 ',t2 R$ types-ht$) 'is-subtype state nil))
+  ;`(is-subtype$$ ',T1 ',T2 R$ types-ht$))
+
+;; (defun is-subtype (t1 t2 state)
+;;   (declare (xargs :guard (and (symbolp t1)
+;;                               (symbolp t2))
+;;                   :mode :program
+;;                   :stobjs (state)))
+;;   (trans-eval `(is-subtype$$ ',t1 ',t2 R$ types-ht$) 'is-subtype state nil))
+
+;; (defun is-disjoint (t1 t2 state)
+;;   (declare (xargs :guard (and (symbolp t1)
+;;                               (symbolp t2))
+;;                   :mode :program
+;;                   :stobjs (state)))
+;;   (trans-eval `(is-disjoint$$ ',t1 ',t2 R$ types-ht$) 'is-disjoint state nil))                              
+
+
+(defun map-identity (x) 
+  "for map elim rules -- dummy destructor"
+  x)
\ No newline at end of file
diff -Nru acl2-6.2/books/cgen/basis.lisp acl2-6.3/books/cgen/basis.lisp
--- acl2-6.2/books/cgen/basis.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/basis.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,649 @@
+#|$ACL2s-Preamble$;
+
+
+;;;;naming convention (only for readability):
+;;;;  function: end with $ for each stobj updating/creating function
+;;;;            end with % for each defrec updating/creating function
+;;;;            end with . for each update, action-object naming with each
+;;;;                argument (except stobjs) thats updated ending with a dot
+;;;;            end with -p for bool-returning fns (except defdata type pred which end in p)
+;;;;            use object-property/attribute naming convention for Read-only
+;;;;  variable: end with $ is a stobj.
+;;;;            end with % is a defrec.
+;;;;            i,j,k are integers or naturals
+;;;;            m,n,idx,ctr are naturals or pos
+;;;;            f,g,h are functions
+;;;;            e,x,y,z,s,t are elements of lists/sets
+;;;;            L,X,Y,Z,xs,ys,zs,S,T are lists/sets
+;;;;            P,Q,R is a alist (pairs alist)
+;;;;            A,B,C are doublet-lists (2 element lists)
+;;;;            G is a graph adj list
+;;;;            D,H is a dictionary/hashtable
+;;;;            K is keyword value list
+;;;;            suffix A_1 indicates A1 is the first argument
+;;;;            A~ is sometimes used to denote a modified A, but
+;;;;              sometimes I use A1, A2, ideally I would like to use
+;;;;              A', A'', to denote such things, but Sedan doesnt
+;;;;              like this syntax, I shud check CLTL
+
+;;;; Discipline/Style:
+;;;;    1. return signatures: * > (mv fixnum *) > (mv * *) > (mv erp * state)
+;;;;       > (mv erp * state stobj_1 stobj_2 stobj_3 ...)
+;;;;       and so on where stobj_i were introduced in chronological order
+;;;;    2. integers are always fixnumed if possible
+;;;;    3. guards carry atleast type information and are stored
+;;;;    4. return types also stored for each function.
+;;;;    5. try to provide (declare (type ...)) automatically
+;;;;    6. if state appears, then wrld shud be the name of the arg
+;;;;    preceding it and shud be the current-acl2-world at the point
+;;;;    of call.
+;;;;    7. Use defattach to hide a decision and provide flexibility
+;;;;  X 8. Use defattach to hide implementation and versions, this way
+;;;;       I can release a new version of ACL2s without requiring a new
+;;;;       ACL2 build, which will be required once these books are moved
+;;;;       to acl2-books repository.
+;;;;    9. Maintain a table with signatures of each function
+;;;;       introduced and if possible of those ACL2 functions (primitives)
+;;;;       used by the introduced functions.
+;;;;    10. Use list comprehension syntax and function arguments " as "
+;;;;        syntax using || trick.
+;;;;    11. Use nested helper functions with f* syntax (note that f*
+;;;;        is not a macro).
+;;;;    12. Use anonymous functions only inside list comprehensions and
+;;;;        all maps and filters are to be used only via LC syntax.
+;;;;    13. All the above fancy stuff is to be done within the def
+;;;;        macro, dont modify b* which can be nested. Thus we are
+;;;;        assured of the top-level variable-free scope in which we
+;;;;        apply our synatx customization.
+
+;;;;debug/print,trace,stats/log
+
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book t);$ACL2s-Preamble$|#
+
+(in-package "DEFDATA")
+
+(include-book "tools/bstar" :dir :system)
+
+;========================Function Metadata table <=======================
+; This table stores metadata about the functions introduced using def in
+; our testing framework. We will also populate the data for each ACL2
+; function the framework uses. This table stores properties of the
+; introduced functions just like world, so perhaps this too will be folded
+; into the acl2 world. The following defrec will explain these properties.
+
+; input-arg-types is a list of types (monadic predicates). Ideally,
+; they will be found in defdata::types-table.
+; output-arg-type is either a type or a list of types starting with mv
+(defrec type-sig% (input-arg-types . output-arg-type) T)
+
+(defun type-sig%-p (v)
+  (declare (xargs :guard T))
+  (case-match v
+    ((input-arg-typs . output-arg-type) (and (symbol-listp input-arg-typs)
+                                             (or (symbolp output-arg-type)
+                                                 ;; or mv type
+                                                 (and (consp output-arg-type)
+                                                      (eq 'mv (car output-arg-type))
+                                                      (symbol-listp output-arg-type)))))))
+
+(defrec def-metadata% 
+  (actual-name  ;name of currently attached  actual defun
+                ; of type: symbolp (UNUSED)
+   call-name    ;subtitute key (visible name) with this name
+                ; when calling this function (UNUSED)
+                ; of type: symbolp
+   ;mult         ;multiplicity i.e. number of arguments of the actual defun
+   type-sig     ;type signature of the actual function
+                ; of type: (type-sigp x)
+   mode         ;of type: (in :program :logic)
+   inline?      ;of type: Boolean
+   trace        
+;;; nil  -> this function wont be traced
+;;; t    -> this function will be traced on system-debug flag
+;;; spec -> see trace$ for form of spec, fun will be traced on system-debug
+;;; 
+   )
+  T);unTAGGED defrec
+
+(defun def-metadata%-p (v)
+  (declare (xargs :guard T))
+  (case-match v
+    ((an cn tsig m inline? trace)  (and (symbolp an)
+                                        (symbolp cn)
+                                        (type-sig%-p tsig)
+                                        (member-eq m '(:program :logic))
+                                        (booleanp inline?)
+;TODO - extend to trace specs
+                                        (booleanp trace)))))
+
+
+                                 
+  
+
+; A table storing properties associated with a def (key)
+; Keys are the visible names of the def functions
+; Values are of shape def-metadata record defined above
+; The table is populated at compile time, i.e at the time when def events
+; are submitted to acl2. Once all def events have been submitted, this
+; table is read-only.
+(table def-metadata-table nil nil :guard (and (symbolp key)
+                                              (def-metadata%-p val)))
+
+;========================Function Metadata table >=======================
+
+
+(defmacro def  (&rest def)     `(make-event (defs-fn (list ',def) 
+                                              '() '()  'def (w state) state)))
+
+(defmacro defs (&rest def-lst) `(make-event (defs-fn ',def-lst
+                                              '() '()  'defs (w state) state)))
+
+(defun triplelis$ (xs ys zs)
+  "similar to pairlis$, except now we have 3 lists to zip
+  == [(cons x (cons y z)) | x in xs, y in ys, z in zs]"
+  (declare (xargs :guard (and (true-listp xs)
+                              (true-listp ys)
+                              (true-listp zs)
+                              (= (len xs) (len ys))
+                              (= (len xs) (len zs)))))
+  (if (endp xs)
+      '()
+    (cons (cons (car xs)
+                (cons (car ys)
+                      (car zs)))
+          (triplelis$ (cdr xs) (cdr ys) (cdr zs)))))
+
+(defun str/sym-listp (x)
+  (declare (xargs :guard T))
+  (if (atom x)
+    (null x)
+    (and (or (stringp (car x)) (symbolp (car x)))
+         (str/sym-listp (cdr x)))))
+    
+  
+;;; foll 2 funs adapted from cutil/deflist.lisp 
+(defun concatenate-names (x)
+  (declare (xargs :guard (str/sym-listp x)))
+  (if (consp x)
+      (acl2::concatenate 'string
+                         (if (symbolp (car x))
+                             (symbol-name (car x))
+                           (car x))
+                         (concatenate-names (cdr x)))
+    ""))
+(defthm concatenate-names-is-stringp
+  (stringp (concatenate-names x)))
+
+(in-theory (disable concatenate-names))
+
+;;; mksym-package-symbol will be captured by calling lexical environment
+(defmacro mksym (&rest args)
+  "given a sequence of symbols or strings as args, 
+   it returns the concatenated symbol"
+  `(intern-in-package-of-symbol
+    (concatenate-names (list ,@args))
+    mksym-ps));mksym-package-symbol
+
+;;-- create a new symbol with prefix or suffix appended
+;;-- if its a common-lisp symbol then attach acl2 package name to it
+;;-- example:
+;;-- (modify-symbol "NTH-" 'bool "") ==> NTH-BOOL
+;;-- (modify-symbol "NTH-" 'boolean "") ==> ACL2::NTH-BOOLEAN
+(defun modify-symbol (prefix sym postfix)
+  (declare (xargs :guard (and (symbolp sym)
+                              (stringp postfix)
+                              (stringp prefix))))
+  (let* ((name (symbol-name sym))
+         (name (string-append prefix name))
+         (name (string-append name postfix)))
+    (if (member-eq sym *common-lisp-symbols-from-main-lisp-package*)
+      (intern-in-package-of-symbol name 'acl2::acl2-pkg-witness)
+      (intern-in-package-of-symbol name sym))))
+
+(defun modify-symbol-lst (prefix syms postfix)
+  (declare (xargs :guard (and (symbol-listp syms)
+                              (stringp prefix)
+                             (stringp postfix))))
+  (if (endp syms)
+    nil
+    (cons (modify-symbol prefix (car syms) postfix)
+          (modify-symbol-lst prefix (cdr syms) postfix))))
+
+
+(defthm modified-symbol-satisfies-symbolp
+         (implies (and (symbolp sym)
+                       (stringp pre)
+                      (stringp post))
+                  (symbolp (modify-symbol pre sym post)))
+         :rule-classes :type-prescription)
+
+(in-theory (disable modify-symbol))
+(defthm modified-symbol-lst-satisfies-symbol-listp
+         (implies (and (symbol-listp syms)
+                      (stringp pre)
+                       (stringp post))
+                  (symbol-listp (modify-symbol-lst pre syms post)))
+         :rule-classes (:rewrite :type-prescription))
+(defthm modified-symbol-lst-len
+  (= (len (modify-symbol-lst pre syms post))
+     (len syms)))
+   
+(in-theory (disable modify-symbol-lst))
+
+
+;; ;most functions are taken from either the COI books or rtl radix book
+;; (defthm character-listp-explode-nonnegative-integerp                            
+;;   (implies
+;;    (character-listp list)
+;;    (character-listp (explode-nonnegative-integer number 10 list))))
+
+;; ;Convert a string|symbol|integer to a string, all other are coerced to ""
+;; (defund to-string (entry)
+;;   (declare (type t entry))
+;;   (cond
+;;    ((symbolp entry) (symbol-name entry))
+;;    ((integerp entry)
+;;     (if (<= 0 entry)
+;;         (coerce (explode-nonnegative-integer entry 10 nil) 'acl2::string)
+;;       (acl2::concatenate 'acl2::string "-"
+;;                    (coerce (explode-nonnegative-integer (- entry) 10 nil) 'acl2::string))))
+;;    ((stringp entry) entry)
+;;    (t "")))
+
+
+(defun fn-p (x)
+  (declare (xargs :guard t))
+  (and (consp x)
+       (symbolp (first x))
+       (consp (cdr x))
+       (symbol-listp (second x))
+       (consp (cddr x))))
+
+(defun fn-list-p (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+    (and (fn-p (car x))
+         (fn-list-p (cdr x)))
+    (equal x '())))
+   
+(defthm strip-cars-doesnt-change-length
+  (implies (true-listp xs)
+           (= (len (strip-cars xs))
+                   (len xs))))
+
+(defthm strip-cdrs-doesnt-change-length
+   (implies (true-listp xs)
+            (= (len (strip-cdrs xs))
+               (len xs))))
+        
+;; this shud be taken care automatically by some type-relationship inference algo
+(defthm fn-list-p-implies-alistp
+  (implies (fn-list-p fns)
+           (alistp fns))
+  :rule-classes :forward-chaining)
+
+(defthm fn-list-p-strip-cars-is-symbol-listp
+  (implies (fn-list-p fns)
+           (symbol-listp (strip-cars fns)))
+  :rule-classes (:rewrite :forward-chaining))
+
+(defthm true-listp-of-make-list-ac
+  (equal (true-listp (make-list-ac n val ac))
+         (true-listp ac))
+  :rule-classes ((:rewrite)
+                 (:type-prescription
+                  :corollary
+                  (implies (true-listp ac)
+                           (true-listp (make-list-ac n val ac))))))
+(defthm len-of-make-list-ac
+  (implies (natp n)
+           (equal (len (make-list-ac n val ac))
+                  (+ n (len ac)))))
+
+(defthm pairlis$-eqlable-symbol-lists
+  (implies (and (symbol-listp xs)
+                (symbol-listp ys))
+           (eqlable-alistp (pairlis$ xs ys))))
+  ;:rule-classes :forward-chaining)
+(in-theory (disable pairlis$))
+#| add to test regression, there is a bug in the following guard conjecture
+(IMPLIES
+ (AND (SYMBOLP NM) (FN-LIST-P FNS))
+ (LET
+  ((MKSYM-PS NM))
+  (AND
+   (STR/SYM-LISTP (LIST "_" NM))
+   (SYMBOLP MKSYM-PS)
+   (LET
+    ((PREFIX (INTERN-IN-PACKAGE-OF-SYMBOL (CONCATENATE-NAMES (LIST "_" NM))
+                                          MKSYM-PS)))
+    (AND
+     (ALISTP FNS)
+     (LET
+      ((OLD-NAMES (STRIP-CARS FNS)))
+      (AND
+       (SYMBOL-LISTP OLD-NAMES)
+       (STRINGP PREFIX)
+       (LET
+        ((NEW-NAMES (MODIFY-SYMBOL-LST PREFIX OLD-NAMES "")))
+        (AND
+         (INTEGERP (LEN FNS))
+         (<= 0 (LEN FNS))
+         (ALISTP FNS)
+         (EQUAL (LEN (MAKE-LIST-AC (LEN FNS) 'DEFABBREV NIL))
+                (LEN (STRIP-CDRS FNS)))
+         (TRUE-LISTP (STRIP-CDRS FNS))
+         (TRUE-LISTP NEW-NAMES)
+         (EQUAL (LEN (MAKE-LIST-AC (LEN FNS) 'DEFABBREV NIL))
+                (LEN NEW-NAMES))
+         (LET
+             NIL
+             (AND (TRUE-LISTP OLD-NAMES)
+                  (TRUE-LISTP NEW-NAMES)
+                  (EQLABLE-ALISTP (PAIRLIS$ OLD-NAMES NEW-NAMES)))))))))))))
+|#
+
+(defun mk-f*-events (fns nm)
+  "for given functions return defabbrev events and a substitution
+   mapping original names to inlined actual defabbrev names"
+  (declare (xargs :guard (and (fn-list-p fns)
+                              (symbolp nm))))
+  ;;we need to satisfy some invariants for avoiding bugs (especially
+  ;;unwanted variable capture - TODO
+  (b*  ((mksym-ps    nm) ;for use in macro mksym
+        (prefix      (mksym "_" nm))
+        (old-names   (strip-cars fns))
+        (new-names   (modify-symbol-lst (symbol-name prefix) old-names ""))
+        (def-events  (triplelis$ (make-list (len fns) 
+                                   :initial-element 'defabbrev)
+                                 new-names
+                                 (strip-cdrs fns)))
+        (P           (pairlis$ old-names new-names))
+        (def-events~ (sublis P def-events))) ;possible variable capture
+   ;;in
+   (mv def-events~ P)))
+                        
+
+(defconst *stobjs* '(state R$ types-ht$)) ;ACHTUNG: Keep in sync!
+    
+(defun mk-declare (K)
+  (declare (xargs :guard (and (keyword-value-listp K)
+                              ;;phew how ugly is this guard. u make code pretty with b* and u lose with guards
+                              (assoc-keyword :sig K)
+                              (equal :sig (car (assoc-keyword :sig K)))
+                              (true-listp (cadr (assoc-keyword :sig K)))
+                              (= 3 (len (cadr (assoc-keyword :sig K))))
+                              (true-listp (caadr (assoc-keyword :sig K))))))
+  "?: make a declare form from the fields of decl keyword value list "
+  (b* (
+       ((list & mode)     (or (assoc-keyword :mode K)
+                                    '(:mode :logic)))
+;:sig ((state ts$) -> (mv erp (oneof -1 boolean) state ts$)))
+      (`(:sig (,in & &)) (assoc-keyword :sig K))
+       (stobjs           (intersection-eq *stobjs* in)))
+  `(declare (xargs :mode ,mode
+                   :stobjs ,stobjs))))
+              
+(set-verify-guards-eagerness 0) 
+
+
+(defun trans-body (B nm)
+  "translate body, by making defun events for each f* binding"  
+  (declare (xargs :guard (and (symbolp nm)
+                             )))
+  #||
+  (f* ((double (x) (* 2 x))
+         (sq (y) (* y y))
+         (ntimes (x) (* n x))) ;capture n from surrounding context
+    body)
+  ==>
+  (mv 
+   ((defabbrev _nm-double (x) (* 2 x))
+    (defabbrev _nm-sq (y) (* y y))
+    (defabbrev _nm-ntimes (x) (* n x)))
+   body')
+  where body' = body[subst real names of introduced inline functions]
+||#
+  
+  (case-match B 
+    (('f* fns body)   (b* (((mv evts P) (mk-f*-events fns nm))
+                             (body~       (sublis P body)))
+                         (mv evts body~)))
+    ;;ignore otherwise
+    (&                  (mv nil B))))
+
+           
+  
+(defun trans-arglist (A )
+  (declare (xargs :guard (and (true-listp A)
+                             
+                              )))
+  "not implemented at the moment i.e noop"
+; (|x as (list a b ...)| x2 x3 
+;  |ts$ as {curr-subgoal-idx, cur-run-idx, ...}|)
+;  =>
+;  (mv (X X2 X3 TS$)
+;      (((list a b . &) x)
+;       (curr-run-idx (cur-run-idx ts$))
+;       (curr-subgoal-idx (curr-subgoal-idx ts$)))
+  (mv A nil))
+
+(deflabel f*)
+
+
+
+(defconst   *acl2s-version* "1.0.2.1")
+
+(defun def-fn1 (name arglist decl-kv-list decls body ctx wrld state)
+  (declare (ignorable wrld state))
+  (declare (xargs :stobjs (state)
+                  :guard (and (symbolp name)
+                              (symbolp ctx)
+                              (true-listp arglist)
+                              (keyword-value-listp decl-kv-list)
+                              (true-listp decls)
+                              (plist-worldp wrld))))
+  
+  (let ((K decl-kv-list)
+        (A arglist)
+        (B body))
+  ;;in
+   (b* (((unless (keyword-value-listp K))
+        (er hard ctx "~|~x0 is not a keyword value list.~%" K))
+       ((unless (assoc-keyword :sig K))
+        (er hard ctx "~|:sig not found in ~x0.~%" K))
+; make a declaration form
+       (decl (mk-declare K)) 
+; get doc string
+       ((list & doc) (or (assoc-keyword :doc K) '(:doc "n/a")))
+       
+; translate arglist to get the actual arglist and a list of b* bindings
+       ((mv A1 b*-bindings) (trans-arglist A))
+; translate body to get events for nested defuns and actual body
+       ((mv aux-events B~)  (trans-body B name))
+       (B~1 (if b*-bindings
+                `(b* ,b*-bindings B~)
+              B~)))
+    ;;in
+    (list aux-events `(,name ,A1 ,doc ,@(cons decl decls) ,B~1)))))
+ 
+(defun def-fn (def ctx wrld state)
+  (declare (ignorable wrld state))
+  (declare (xargs :stobjs (state)
+                  :guard (and (symbolp ctx)
+                              (plist-worldp wrld))))
+  (case-match def
+    ((nm A ('decl . K) ('declare . ds) B)
+     ;; =>
+     (def-fn1 nm A K (list (cons 'declare ds)) B ctx wrld state))
+    
+    ((nm A ('decl . K) B)
+     ;; =>
+     (def-fn1 nm A K '() B ctx wrld state))
+    
+    (& (er hard ctx "~|Ill-formed def form. ~
+General form: ~
+(def name arglist decl [declare] body)~%"))))
+
+(defun defs-fn (def-lst aux-events. defuns-tuples. ctx wrld state)
+  "my own defun for storing type metadata for later type-checking.
+1. possible nested (local) defuns
+2. list comprehensions
+3. destructuring arg list"
+;;; accumulate the list of event forms to be submitted in ans. parameter
+  (declare (xargs :stobjs (state)
+                  :guard (and (true-listp def-lst)
+                              (true-listp aux-events.)
+                              (symbolp ctx)
+                              (plist-worldp wrld))))
+  (if (endp def-lst)
+      `(progn ,@aux-events. 
+              ,(if (null (cdr defuns-tuples.));singleton
+                   `(defun . ,(car defuns-tuples.))
+                 `(defuns . ,defuns-tuples.)))
+    ;;else
+    (b* (((list ae def-tuple);ae: aux-events
+           (def-fn (first def-lst) ctx wrld state)))
+     
+      (defs-fn (rest def-lst)
+               (append ae aux-events.)
+               (append defuns-tuples. (list def-tuple)) ctx wrld state))))
+
+
+(defconst   *primitives*
+  '(+f   *f   |1+f|   =  |1-f|   -f   /=  <=  <  >  >=
+    plus-mod-m31 double-mod-m31 times-expt-2-16-mod-m31 times-mod-m31
+    mod mod^ floor floor^ expt expt^
+    min min^ max max^
+    logand logand^ logior logior^
+    lognot lognot^ logxor logxor^
+    ash ash^
+    mask^ mv mv^ my-fixnum the-fixnum
+    er er0 prog2$ cw ev-fncall-w
+    fn-count-evg lexorder
+    if not implies and or iff
+    acl2-numberp rationalp integerp consp 
+    characterp symbolp stringp
+    booleanp termp keywordp
+    true-listp symbol-listp
+    cons null atom endp list list* push-lemma
+    car cdr caar cdar cadr cddr cadar
+    first second third fourth fifth
+    sixth seventh eighth ninth tenth
+    rest last butlast nth nthcdr update-nth
+    append length reverse revappend string-append
+    acons assoc assoc-eq assoc-equal assoc-keyword
+    strip-cars strip-cdrs
+    numerator denominator realpart imagpart
+    char-code char code-char
+    symbol-name symbol-package-name
+    intern intern-in-package-of-symbol
+    symbol-append bozo
+    equal eql eq
+    member-eq member member-equal
+
+    list-lis ffnnamep subsequencep
+    legal-variable-or-constant-namep genvar collect-non-x
+    arglistp cons-term match-tests-and-binding
+    er-hard-val the-fixnum! the-signed-byte! xxxjoin xxxjoin-fixnum
+    number-of-digits lambda-body flambdap  make-lambda  make-let
+    flambda-applicationp
+    doubleton-list-p singleton-list-p ascii-code!
+    formals arity def-body program-termp equivalence-relationp
+    >=-len all->=-len strip-cadrs strip-cddrs sublis-var subcor-var
+    new-namep global-symbol symbol-doublet-listp remove1-eq pair-lis$
+    add-to-set-eq pseudo-termp all-vars ffn-symb fargs
+    translate-and-test intersectp check-vars-not-free position
+    collect-cdrs-when-car-eq restrict-alist substitute sublis
+    delete-assoc function-symbolp the 32-bit-integerp
+    32-bit-integer-listp with-live-state state-global-let*
+    integer-range-p signed-byte-p unsigned-byte-p boole$
+    make-var-lst the-mv nth-aliases fix-true-list 
+    duplicates evens odds resize-list conjoin2
+    conjoin-untranslated-terms search count our-multiple-value-prog1
+    all-calls filter-atoms unprettyify variantp free-vars-in-hyps
+    destructors  alist-to-keyword-alist
+    ;other-processes.lisp
+    sublis-expr generate-variable
+    ; tau.lisp
+    subst-var subst-var-lst
+    ))
+
+(defconst   *special-forms* 
+  '(b* let mv-let cond case case-match defabbrev defun defmacro
+    ))
+
+
+
+
+; NOTE on what is stored in the acl2 world for 
+; Functions
+; in Raw lisp do the following
+#||
+(get 'acl2::binary-append *current-acl2-world-key*)
+==>
+((COARSENINGS NIL) 
+ 
+ (RUNIC-MAPPING-PAIRS ((620 :DEFINITION BINARY-APPEND) 
+                       (621 :EXECUTABLE-COUNTERPART BINARY-APPEND)
+                       (622 :TYPE-PRESCRIPTION BINARY-APPEND)
+                       (623 :INDUCTION BINARY-APPEND))) 
+ (DEF-BODIES (((620 NIL IF (CONSP X) (CONS (CAR X) (BINARY-APPEND (CDR X) Y)) Y) 
+               (BINARY-APPEND)
+               (X Y)
+               (:DEFINITION BINARY-APPEND) 
+               (BINARY-APPEND T NIL)))) 
+(TYPE-PRESCRIPTIONS ...) 
+
+(CONGRUENCES NIL) 
+
+(SYMBOL-CLASS :COMMON-LISP-COMPLIANT :COMMON-LISP-COMPLIANT 
+              :ACL2-PROPERTY-UNBOUND :PROGRAM :PROGRAM) 
+
+(LEMMAS  ...)
+ 
+(STOBJS-OUT (NIL) :ACL2-PROPERTY-UNBOUND (NIL)) 
+
+(FORMALS (X Y) :ACL2-PROPERTY-UNBOUND (X Y)) 
+
+(PRIMITIVE-RECURSIVE-DEFUNP T) 
+
+(LEVEL-NO 1) 
+
+(UNNORMALIZED-BODY (IF (ENDP X) Y (CONS (CAR X) (BINARY-APPEND (CDR X) Y)))) 
+
+(QUICK-BLOCK-INFO (SELF-REFLEXIVE UNCHANGING)) 
+
+(JUSTIFICATION (JUSTIFICATION (X) (NIL O-P . O<) 
+                              ((ACL2-COUNT X) MV-LIST RETURN-LAST)))
+ 
+(INDUCTION-MACHINE ((TESTS-AND-CALLS ((ENDP X))) 
+                    (TESTS-AND-CALLS ((NOT (ENDP X))) 
+                                     (BINARY-APPEND (CDR X) Y)))) 
+(RECURSIVEP (BINARY-APPEND)) 
+
+(REDEFINED (:RECLASSIFYING-OVERWRITE BINARY-APPEND (X Y) (NIL NIL) (NIL))) 
+
+(ABSOLUTE-EVENT-NUMBER 6858 :ACL2-PROPERTY-UNBOUND 227) 
+(PREDEFINED T T) 
+(GUARD (TRUE-LISTP X) :ACL2-PROPERTY-UNBOUND (TRUE-LISTP X)) 
+
+(STOBJS-IN (NIL NIL) :ACL2-PROPERTY-UNBOUND (NIL NIL)))
+||#
+
+;Macros:
+#||
+(get 'acl2::append *current-acl2-world-key*)
+==>
+
+((MACRO-BODY (IF (NULL RST) 
+                 'NIL 
+                 (IF (NULL (CDR RST)) 
+                     (CAR RST) 
+                     (XXXJOIN 'BINARY-APPEND RST)))) 
+ (ABSOLUTE-EVENT-NUMBER 228) 
+ (PREDEFINED T) 
+ (MACRO-ARGS (&REST RST)))
+||#
diff -Nru acl2-6.2/books/cgen/cert.acl2 acl2-6.3/books/cgen/cert.acl2
--- acl2-6.2/books/cgen/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/cert.acl2	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,10 @@
+(ld "package.lsp")
+(include-book "std/osets/portcullis" :dir :system)
+
+; Added by Matt K., 9/28/2013, because defdata ultimately invokes
+; with-local-state, which an error message says is disallowed with
+; parallelism enabled.
+(set-parallel-execution nil)
+
+; Added by Jared, justified by ACL2_COMPILE_FLG setting in Makefile
+; cert-flags: ? t :ttags :all
diff -Nru acl2-6.2/books/cgen/defdata.lisp acl2-6.3/books/cgen/defdata.lisp
--- acl2-6.2/books/cgen/defdata.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/defdata.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,5219 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+
+;;;;Main Author: Peter Dillinger
+;;;;Extended by Harsh Raju C
+;;;;Data definition Framework (ACL2 Sedan)
+;;;;It can be used independently, but is primarily intended
+;;;;to support the CGEN/TESTING framework!!
+
+(acl2::begin-book t :ttags ((:hash-stobjs) (:redef+)));$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+
+(include-book "utilities")
+(include-book "basis")
+(include-book "acl2s-parameter")
+(include-book "splitnat")
+(include-book "switchnat")
+(include-book "graph-tc" :ttags ((:hash-stobjs) (:redef+)));transtive closure and subtype relation
+
+(set-verify-guards-eagerness 2)
+
+;Introduce data definitions conveniently in ACL2
+(defdoc acl2::DATA-DEFINITIONS
+  ":Doc-Section DATA-DEFINITIONS
+  
+  A Data Definition Framework for ACL2~/
+                                
+  The Data Definition Framework supports ground ACL2
+  ~em[types] and any custom ~em[types] introduced by
+  a user. It also helps the user conveniently construct
+  enumerated, union, record and list ~em[types]. 
+  The framework is integrated with our random testing
+  framework. It also provides ways to specify subtype
+  and disjoint relations among the supported ~em[types].~/
+  
+  The ACL2 value universe is broadly divided into 5 kinds of data
+  objects. They are Numbers, Characters, Strings, Symbols and Conses
+  (Ordered Pairs). These disjoint sets serve as types for our purposes;
+  we shall call them ground data types. Although ACL2 is an ~em[untyped]
+  logic, it uses type information internally to deduce types.
+  ACL2 users provide the prover with type information by specifying
+  type  hypotheses on variables in a conjecture.
+  Note again that ACL2 is syntactically ~em[untyped], but that 
+  doesn't prevent us from having and using a notion of a type.
+  One ~st[cannot create] new ~em[types] in ACL2, in the sense
+  that one cannot create a new non-empty set of values that
+  provably extends the ACL2 value universe.  Rather, one
+  typically partitions the existing universe in potentially
+  new ways to form 'new' sets. These sets (``types'') are
+  presently characterized by just a type predicate. 
+  ~nl[]
+  The task of specifying user-defined data definitions (``types'') and supporting
+  random testing is elegantly solved by characterizing 'type' using both a 
+  type predicate and a type enumerator. 
+  ~nl[]
+  ~nl[]
+  What is a ~em[type] in our data definition framwork?
+  We say that ~c[foo] is a 'type' if there exists a predicate
+  function ~c[foop] and either a constant list of values 
+  ~c[*foo-values*] (if it's finite) or an enumerator function 
+  ~c[nth-foo] (if it's infinite) that maps natural numbers to data
+  objects that satisfy ~c[foop].  If ~em[foo] is ~st[supported]
+  by our framework, i.e. the forementioned conditions are met, then
+  the name ~em[foo] can be used in defining other types using
+  ~c[defdata].
+  ~nl[]
+  The framework supports all the ground data types and the common
+  data types present in the initial(ground) ACL2 world.
+  The framework also treats each data object in the ACL2 universe as a
+  singleton 'type', i.e. a set with just one element, the data object
+  itself. The type which represents all of the ACL2 universe is 
+  called ~c[all]; every 'type' is thus a subset of ~c[all].
+  ~nl[]
+  
+  Sophisticated users may want to define custom
+  types manually, for example to define a type which represents
+  positive multiples of 3. In ACL2 we can define such a type by the
+  following predicate:
+
+ ~bv[]
+ (defun pos-multiple-of-threep (v)
+  (if (posp v)
+    (equal 0 (mod v 3))
+    nil))
+ ~ev[]
+ In order to ~st[support] this type within our framework, all one needs to do
+ is to define its enumerator, which is a bijection from the set of natural numbers
+ to the set of positive multiples of 3:
+ ~bv[]
+ (defun nth-pos-multiple-of-three (n)
+  (if (natp n) 
+   (* 3 (1+ n))
+   3))
+  ~ev[]
+  
+  The framework provides a macro ~c[defdata] to specify combinations of
+  supported 'types', thus relieving the user of the trouble of
+  defining predicates and enumerators by hand. 'Types' allow users
+  to refer to them by name in these data definitions. One can also
+  use ~c[register-data-constructor] to introduce custom notions of
+  product data. ~c[defdata-subtype] and ~c[defdata-disjoint] are 
+  used to specify relations among supported 'types'.
+  
+  We illustrate some uses of the framework:
+  ~bv[]
+                               
+  (register-data-constructor (consp cons)
+                             ((allp car) (allp cdr))
+                             :proper t)
+                             
+  (register-custom-type nat (t nth-nat . natp))
+  
+  (defdata loi (oneof 'nil
+                      (cons integer loi)))
+                                          
+  (defdata-subtype nat rational)
+  
+  (defdata-disjoint symbol string)
+  ~ev[]
+  For more details on data-definitions framework refer ___.
+  ")
+
+
+;set verbose and printstats & only-counterexample flags
+(defmacro set-acl2s-defdata-verbose (v)
+   ":Doc-Section ACL2::DATA-DEFINITIONS
+   Control amount of output printed by defdata~/
+   By default this parameter is set to ~c[nil]. 
+   If set to ~c[t], you will see all of the output
+   generated by ACL2 and the defdata macro.
+   Recommend ~em[not] setting it, unless you want to debug
+   or want to peek into whats happening below the hood.
+   ~bv[]
+   Usage:
+   (set-acl2s-defdata-verbose nil)
+   ~ev[]~/
+   "
+ `(assign acl2s-defdata-verbose ,v))
+
+;internal debug flag
+(defmacro set-acl2s-defdata-debug (v)
+ `(assign acl2s-defdata-debug ,v))
+(defun get-acl2s-defdata-debug-fn (state)
+  (declare (xargs :stobjs (state)))
+  (let ((b (acl2::f-boundp-global 'acl2s-defdata-debug state)))
+    (if b
+      (acl2::f-get-global 'acl2s-defdata-debug state)
+      nil)))
+(defmacro get-acl2s-defdata-debug ()
+ `(get-acl2s-defdata-debug-fn state))
+;end of internal debug flag
+
+(defconst *default-defdata-verbose* nil)
+
+(defun get-acl2s-defdata-verbose-fn (state)
+  (declare (xargs :stobjs (state)))
+  (let ((b (acl2::f-boundp-global 'acl2s-defdata-verbose state)))
+    (if b
+      (acl2::f-get-global 'acl2s-defdata-verbose state)
+      *default-defdata-verbose*)))
+
+(defmacro get-acl2s-defdata-verbose ()
+   ":Doc-Section ACL2::DATA-DEFINITIONS
+   Get the current verbosity for output printed by defdata~/
+   Returns ~c[t] if verbosity is turned on, ~c[nil] otherwise.
+   ~bv[]
+   Usage:
+   (get-acl2s-defdata-verbose)
+   ~ev[]~/
+   "
+ `(get-acl2s-defdata-verbose-fn state))
+
+(defconst *default-defdata-use-guards* nil);Sep 3rd 2012
+
+(defun get-acl2s-defdata-use-guards-fn (state)
+  (declare (xargs :stobjs (state)))
+  (let ((b (acl2::f-boundp-global 'acl2s-defdata-use-guards state)))
+    (if b
+      (acl2::f-get-global 'acl2s-defdata-use-guards state)
+      *default-defdata-use-guards*)))
+
+(defmacro get-acl2s-defdata-use-guards ()
+   ":Doc-Section ACL2::DATA-DEFINITIONS
+   Get the setting for use of guards in functions generated by defdata~/
+   Returns ~c[t] if use of guards is turned on, ~c[nil] otherwise.
+   ~bv[]
+   Usage:
+   (get-acl2s-defdata-use-guards)
+   ~ev[]~/
+   "
+ `(get-acl2s-defdata-use-guards-fn state))
+
+(defmacro set-acl2s-defdata-use-guards (v)
+   ":Doc-Section ACL2::DATA-DEFINITIONS
+   Use(and verify) guards in functions generated by defdata~/
+   By default this parameter is set to ~c[t]. 
+   ~bv[]
+   Usage:
+   (set-acl2s-defdata-use-guards t)
+   ~ev[]~/
+   "
+ `(assign acl2s-defdata-use-guards ,v))
+
+(set-state-ok t)
+
+;------- define some useful constructors -------;
+
+#||
+(defun find-elim-rules (wrld)
+  (declare (xargs :guard (plist-worldp wrld)))
+  (if (endp wrld)
+    nil
+    (let ((trip (car wrld)))
+      (if (eq (second trip) 'eliminate-destructors-rule)
+        (cons trip (find-elim-rules (cdr wrld)))
+        (find-elim-rules (cdr wrld))))))
+
+||#
+
+(defun get-constructor-predicate-and-destructors (fn wrld)
+  (declare (xargs :guard (and (symbolp fn)
+                              (plist-worldp wrld))))
+  (if (endp wrld)
+    nil
+    (let ((trip (car wrld)))
+      (if (and (eq (second trip) 'eliminate-destructors-rule)
+               (>= (len trip) 6))
+        (let ((info (fifth trip))
+              (foo (sixth trip)))
+           (if (and (consp foo)
+                    (consp (car foo))
+                    (eq (caar foo) fn)
+                    (alistp (cdar foo)))
+             (cons
+              (if (and (consp info)
+                       (consp (car info))
+                       (consp (caar info))
+                       (symbolp (caaar info)))
+                (caaar info)
+                'allp)
+              (strip-cars (cdar foo)))
+             (get-constructor-predicate-and-destructors fn (cdr wrld))))
+        (get-constructor-predicate-and-destructors fn (cdr wrld))))))
+
+
+
+; TODO: what about well-foundedness?
+#|
+(thm (implies (consp x)
+              (and (o< (acl2-count (car x)) (acl2-count x))
+                   (o< (acl2-count (cdr x)) (acl2-count x)))))
+(default-well-founded-relation (w state))
+|#
+; nah.  doesn't imply compositions well-founded. ASK Peter!!
+
+;;-- stores information about data contructors
+;;--i.e. constructor name, cons predicate and (pred destructor) pairs, measure-fn and the foll:
+;;--flags :proper ((:proper) for proper constructors and nil otherwise)
+;eg :
+; (/    ( () rationalp ((numerator . integerp) ( denominator . posp)) . acl2-count))
+; (cons ( (:proper) consp ((car . allp) ( cdr . allp)) . acl2-count))
+;;--
+;;--completely modifed by harshrc on 27-Aug-2009 from a table to a global
+;;--CHANGED BACK to TABLE
+
+(table data-constructors nil nil :guard
+       (and ;; len >= 3 ;;--modified by harshrc
+            (consp val)
+            (consp (cdr val))
+            (consp (cddr val))
+            (let ((flags (car val))
+                  (predicate (cadr val))
+                  (dlst (caddr val))
+                  (msr-fn (cdddr val)));;--modifed by harshrc 
+              (and
+               ;; list of flags
+               (keyword-listp flags)
+               ;; predicate function (allp for all) for image of constructor
+               (symbolp predicate)
+               (plausible-predicate-functionp predicate world)
+               (symbolp msr-fn)
+               (or (allows-arity msr-fn 1 world)
+                   (eq msr-fn 'none));;-- msr a one-param fn?? -harshrc
+               ;; (dfn . pfn) alist in parameter order where
+               ;; dfn names destructor
+               ;; pfn intended domain predicate function (allp for all)
+               (alistp dlst)
+               (allows-arity key (len dlst) world)
+               (allow-arity-lst (strip-cars dlst) 1 world)
+               (plausible-predicate-function-listp (strip-cdrs dlst)
+                                                   world)))))
+       
+
+
+
+            
+       
+
+;auto-generated constructors have only synctatic guards
+(table record-constructors nil nil :guard
+       (and
+         (consp val)
+         (consp (cdr val))
+         (consp (cddr val))
+         (let ((flags (car val))
+               (predicate (cadr val))
+               (dlst (caddr val))
+               (msr-fn (cdddr val))) 
+           (and
+            ;; list of flags
+            (keyword-listp flags)
+            (symbolp predicate)
+            (symbolp msr-fn)
+            (symbol-alistp dlst)))))
+
+
+
+
+#|
+;auto-generated constructors have only synctatic guards
+(defun add-to-record-constructors-global (constructor cons-info ctx state)
+  (declare (xargs :stobjs (state) :mode :program                  
+                  :guard (and (symbolp constructor)
+                              (consp cons-info))))
+  (let ((key constructor)
+        (val cons-info))
+        
+    (if (and
+         (consp val)
+         (consp (cdr val))
+         (consp (cddr val))
+         (let ((flags (car val))
+               (predicate (cadr val))
+               (dlst (caddr val))
+               (msr-fn (cdddr val))) 
+           (and
+            ;; list of flags
+            (keyword-listp flags)
+            (symbolp predicate)
+            (symbolp msr-fn)
+            (symbol-alistp dlst))))
+      (let* ((data-cons-alst (get-data-constructors-global))
+            (cons-entry (assoc-eq key data-cons-alst)))
+            
+        (if (consp cons-entry)
+          (if (not (equal (cdr cons-entry) cons-info))
+            (er soft ctx "~x0 already present in the global record-constructors table! Illegal to modify it!!~%" key)
+            (value '(value-triple :redundant)))
+          (let ((data-cons-alst (acons key val data-cons-alst)))
+            (er-progn
+             (set-record-constructors-global data-cons-alst)
+             (value `(value-triple ,(cons key val)))))))
+      (er soft ctx "Constructor ~x0 and its Info ~x1 are invalid, and cannot be added to generated-constructor table!~%" key val))))
+
+|#
+
+
+;selectors for the above constructors stored in the *-constructor tables, use them only.
+(defun cons-name-entry (constructor-table-entry)
+  (declare (xargs :guard (and (consp constructor-table-entry)
+                              (consp (cdr constructor-table-entry))
+                              (consp (cddr constructor-table-entry))
+                              (consp (cdddr constructor-table-entry)))))
+  (car constructor-table-entry))
+(defun predicate-name-entry (constructor-table-entry)
+  (declare (xargs :guard (and (consp constructor-table-entry)
+                              (consp (cdr constructor-table-entry))
+                              (consp (cddr constructor-table-entry))
+                              (consp (cdddr constructor-table-entry)))))
+  (caddr constructor-table-entry))
+(defun dex-pairs-entry (constructor-table-entry)
+  (declare (xargs :guard (and (consp constructor-table-entry)
+                              (consp (cdr constructor-table-entry))
+                              (consp (cddr constructor-table-entry))
+                              (consp (cdddr constructor-table-entry)))))
+  (cadddr constructor-table-entry))
+(defun measure-fn-entry (constructor-table-entry)
+  (declare (xargs :guard (and (consp constructor-table-entry)
+                              (consp (cdr constructor-table-entry))
+                              (consp (cddr constructor-table-entry))
+                              (consp (cdddr constructor-table-entry)))))
+  (cddddr constructor-table-entry))
+
+
+
+;;--normalise a constructor/destructor form
+;;-- sfn => (sfn . allp)
+;;-- (sfn . pfn) ==> (sfn . pfn)
+;;-- (pfn sfn) ==> (sfn . pfn) where sfn is constructor/destructor? and pfn is pred
+(defun fix-structor-and-pred (p ctx)
+  (cond ((symbolp p)
+         (cons p 'allp))
+        ((and (consp p)
+              (symbolp (car p))
+              (symbolp (cdr p))) ; (sfn . pfn)
+         p)
+        ((and (consp p)
+              (symbolp (car p))
+              (consp (cdr p))
+              (symbolp (cadr p))
+              (null (cddr p)))   ; (pfn sfn)
+         (cons (cadr p) (car p)))
+        (t
+         (er hard? ctx
+             "Invalid function with predicate: ~x0"
+             p))))
+
+;;-- returns list of form ((numerator . rationalp) ...)
+(defun fix-structor-and-pred-lst (lst ctx)
+  (declare (xargs :guard (and (true-listp lst) (symbolp ctx))))
+  (if (endp lst)
+    nil
+    (cons (fix-structor-and-pred (car lst) ctx)
+          (fix-structor-and-pred-lst (cdr lst) ctx))))
+
+;;--return a list of single argument(x) calls
+;;--(apply-to-x-lst '(ap bp cp))
+;;-- ==> ((AP X) (BP X) (CP X))
+(defun apply-to-x-lst (fns)
+  (declare (xargs :guard (true-listp fns)))
+  (if (endp fns)
+    nil
+    (cons (list (car fns) 'x)
+          (apply-to-x-lst (cdr fns)))))
+
+(defun apply-mget-to-x-lst (fields quotep)
+  (declare (xargs :guard (and (booleanp quotep)
+                              (symbol-listp fields))))
+  (if (endp fields)
+    nil
+    (let ((d-keyword-name (intern (symbol-name (car fields)) "KEYWORD")))
+      (cons (list 'acl2::mget (if quotep (kwote d-keyword-name) d-keyword-name) 'x)
+            (apply-mget-to-x-lst (cdr fields) quotep)))))
+
+;;--eg:(get-proper-dex-theorems 'cons '(car cdr))
+;;--         ==>
+;;--((EQUAL (CAR (CONS CAR CDR)) CAR)
+;;-- (EQUAL (CDR (CONS CAR CDR)) CDR))
+(defun get-proper-dex-theorems1 (conx-name dex-names rem-dex-names recordp)
+  (declare (xargs :guard (and (symbol-listp dex-names)
+                              (booleanp recordp)
+                              (symbol-listp rem-dex-names))))
+  (if (endp rem-dex-names)
+    nil
+    (if recordp
+      (let ((d-keyword-name (intern (symbol-name (car rem-dex-names)) "KEYWORD")))
+        (cons `(equal (mget ,d-keyword-name (,conx-name . ,dex-names))
+                      ,(car rem-dex-names))
+              (get-proper-dex-theorems1 conx-name dex-names
+                                      (cdr rem-dex-names) recordp)))
+      (cons `(equal (,(car rem-dex-names) (,conx-name . ,dex-names))
+                    ,(car rem-dex-names))
+            (get-proper-dex-theorems1 conx-name dex-names
+                                      (cdr rem-dex-names) recordp)))))
+
+(defun get-proper-dex-theorems (conx-name dex-names recordp)
+  (declare (xargs :guard (and (booleanp recordp) (symbol-listp dex-names))))
+  (get-proper-dex-theorems1 conx-name dex-names dex-names recordp))
+
+;;-- (get-improper-dex-theorems 'rational '(numerator denominator) '(integerp posp))
+;;-- gives
+;;-- ((INTEGERP (NUMERATOR (RATIONAL NUMERATOR DENOMINATOR)))
+;;-- (POSP (DENOMINATOR (RATIONAL NUMERATOR DENOMINATOR))))
+(defun get-improper-dex-theorems1 (conx-name dex-names
+                                             rem-dex-names 
+                                             rem-dex-prexs
+                                             recordp)
+  (declare (xargs :guard (and (symbol-listp dex-names)
+                              (symbol-listp rem-dex-names)
+                              (booleanp recordp);records
+                              (symbol-listp rem-dex-prexs))))
+  (if (endp rem-dex-names)
+    nil
+    (if recordp
+      (let ((d-keyword-name (intern (symbol-name (car rem-dex-names)) "KEYWORD")))
+        (cons `(,(car rem-dex-prexs) (mget ,d-keyword-name (,conx-name . ,dex-names)))
+          (get-improper-dex-theorems1 conx-name dex-names
+                                      (cdr rem-dex-names)
+                                      (cdr rem-dex-prexs) recordp)))
+
+      (cons `(,(car rem-dex-prexs) (,(car rem-dex-names) (,conx-name . ,dex-names)))
+            (get-improper-dex-theorems1 conx-name dex-names
+                                        (cdr rem-dex-names)
+                                        (cdr rem-dex-prexs) recordp)))))
+
+(defun get-improper-dex-theorems (conx-name dex-names dex-prexs recordp)
+  (declare (xargs :guard (and (symbol-listp dex-names)
+                              (booleanp recordp);records
+                              (symbol-listp dex-prexs))))
+  (get-improper-dex-theorems1 conx-name dex-names
+                              dex-names dex-prexs recordp))
+
+(defun build-one-param-calls-forcep (fns params forcep)
+  (declare (xargs :guard (and (true-listp fns)
+                              (true-listp params)
+                              (booleanp forcep)
+                              (= (len fns) (len params)))))
+  (if (endp fns)
+    nil
+    (cons (if forcep
+              (list 'acl2::force (list (car fns) (car params)))
+              (list (car fns) (car params)))
+          (build-one-param-calls-forcep (cdr fns) (cdr params) forcep))))
+
+(defun build-one-param-calls (fns params)
+  (declare (xargs :guard (and (true-listp fns)
+                              (true-listp params)
+                              (= (len fns) (len params)))))
+  (if (endp fns)
+    nil
+    (cons (list (car fns) (car params))
+          (build-one-param-calls (cdr fns) (cdr params)))))
+
+
+;(o< (acl2-count (car x)) (acl2-count x))
+;(o< (acl2-count (cdr x)) (acl2-count x))
+(defun build-measure-calls (dex-names)
+  (declare (xargs :guard (true-listp dex-names)))
+  (if (endp dex-names)
+    nil
+    (cons `(o< (acl2-count (,(car dex-names) x)) (acl2-count x))
+          (build-measure-calls (cdr dex-names)))))
+
+;;--added measure-fn flag with default 'none
+(defmacro register-data-constructor (constructor destructor-lst
+                                                 &key 
+                                                 hints proper
+                                                 measure-fn ;added by harshrc
+                                                 rule-classes
+                                                 forcep ;force typ hyps
+                                                 )
+  
+  ":Doc-Section DATA-DEFINITIONS
+  Register a data constructor to be used in data definitions(FOR ADVANCED USERS)~/
+  This is an advanced macro to be used only by power users and people who
+  would like to add their own custom notions of product data. 
+  It can be used to register a data-constructor like ~c[cons]
+  with the data-definition framework, so that ~em[product datatypes] 
+  can be specified using ~c[defdata]. 
+  For example ~em[cons] is already registered for you:
+  ~bv[]
+  (register-data-constructor (consp cons)
+                             ((allp car) (allp cdr))
+                             :proper t)
+  ~ev[]                           
+  It says that ~c[cons] is a constructor and anything that satisfies
+  ~c[consp] can be constructed with this constructor, like ~c[(cons nat pos)].
+  The destructor ~c[car] tells what the first argument to ~c[cons] was, and
+  anything specifying ~c[allp] can be given in that argument position. The
+  destructor ~c[cdr] tells what the second argument to ~c[cons] was, and
+  anything satisfying ~c[allp] can be given in that argument position. The
+  proper keyword specifies that any product data that was formed using 
+  ~c[cons] can be uniquely destructed back to its original arguments. For
+  e.g ~c[(car (cons 1 3))] gives you 1. Compare this with an improper constructor
+  ~c[/] which is shown in the examples below, where ~c[(denominator (/ 6 42))]
+  gives back 7 instead of 42.
+  
+  
+  ~bv[]
+  Examples(These are already registered(like all ground acl2 constructors)):
+  (register-data-constructor (acl2-numberp complex)
+                             ((rationalp realpart) (rationalp imagpart))
+                             :proper t)
+  
+  ;an improper constructor                           
+  (register-data-constructor (rationalp /)
+                             ((integerp numerator) (posp denominator)))
+  ~ev[]                      
+  ~bv[]
+  Usage:
+  (register-data-constructor (<constructor-predicate> <constructor>)
+                             ((<destructor-predicate> <destructor>) ...)
+                             [:proper <boolean>]
+                             [:hints hints]
+                             [:rule-classes rule-classes]
+                             [:forcep <boolean>]
+                             )
+  ~ev[]~/
+  "
+  (declare (xargs :guard (and (true-listp destructor-lst)
+                              (booleanp proper)
+                              (booleanp forcep))))
+  (let* ((ctx 'register-data-constructor)
+         (conx-pair (fix-structor-and-pred constructor ctx))
+         (dex-pairs (fix-structor-and-pred-lst destructor-lst ctx))
+         (conx-name (car conx-pair))
+         (conx-prex (cdr conx-pair))
+         (dex-names (strip-cars dex-pairs))
+         (dex-prexs (strip-cdrs dex-pairs))
+         (table-name 'data-constructors)
+         (msr-fn  measure-fn))
+       ;(thm (implies (consp x)
+       ;      (and (o< (acl2-count (car x)) (acl2-count x))
+       ;           (o< (acl2-count (cdr x)) (acl2-count x)))))
+       ; (local (defthm ,(modify-symbol nil conx-name "-MEASURE-FN-VALID")
+       ;          (and (o-p (,msr-fn x))
+       ;               (implies (,conx-prex x)
+       ;                        (and . ,(build-measure-calls dex-names) )))))
+        
+    `(progn
+       (defthm ,(modify-symbol "" conx-name "-CONSTRUCTOR-PRED")
+         (implies (and . ,(build-one-param-calls-forcep dex-prexs dex-names forcep))
+                  (,conx-prex (,conx-name . ,dex-names)))
+         :hints ,hints
+         :rule-classes ,rule-classes)
+                      
+       (defthm ,(modify-symbol "" conx-name "-CONSTRUCTOR-ELIM-RULE")
+         (implies (,conx-prex x)
+                  (equal (,conx-name . ,(apply-to-x-lst dex-names))
+                         x))
+         :hints ,hints
+         :rule-classes ,(if rule-classes '(:elim) 'nil))
+       
+       (defthm ,(modify-symbol "" conx-name "-CONSTRUCTOR-DESTRUCTORS")
+         (implies (and . ,(build-one-param-calls-forcep dex-prexs dex-names forcep))
+                  (and . ,(if proper
+                              (append (get-proper-dex-theorems conx-name dex-names nil)
+                                      (get-improper-dex-theorems conx-name dex-names dex-prexs nil))
+                            (get-improper-dex-theorems conx-name dex-names dex-prexs nil))))
+         :rule-classes ,rule-classes
+         :hints ,hints)
+      
+      (table
+       ,table-name
+       ',conx-name
+       ',(list* (if proper '(:proper) '())
+                conx-prex dex-pairs 
+                (if msr-fn msr-fn 'none))
+       :put)
+      
+      (value-triple (list ',constructor ',destructor-lst)))))
+  
+
+(table record-elim-table nil nil 
+       :guard (consp val)) ;elim-rule-p
+
+(table map-elim-table nil nil 
+       :guard (consp val))
+
+(defun get-elim-rule (nume term destructor-term)
+  "see add-elim-rule in defthms.lisp"
+  (declare (xargs :mode :program))
+  (let* ((lst (acl2::unprettyify term))
+         (hyps (caar lst))
+         (equiv (acl2::ffn-symb (cdar lst)))
+         (lhs (acl2::fargn (cdar lst) 1))
+         (rhs (acl2::fargn (cdar lst) 2))
+         (dests (cdr lhs))
+         (rule (acl2::make acl2::elim-rule
+                     :rune -1 ;dummy
+                     :nume nume
+                     :hyps hyps
+                     :equiv equiv
+                     :lhs lhs
+                     :rhs rhs
+                     :crucial-position 1 ;(mget :fieldname x) or (mget a x)
+                     :destructor-term destructor-term
+                     :destructor-terms dests)))
+    rule))
+ 
+(defun record-gen-theorem-conclusions (rem-dex-names rem-dex-prexs)
+  (declare (xargs :guard (and (symbol-listp rem-dex-names)
+                              (symbol-listp rem-dex-prexs))))
+  (if (endp rem-dex-names)
+    nil
+    (let ((d-keyword-name (intern (symbol-name (car rem-dex-names)) "KEYWORD"))) ;term
+      (cons `(,(car rem-dex-prexs) (mget ,d-keyword-name x)) 
+            (record-gen-theorem-conclusions (cdr rem-dex-names)
+                                            (cdr rem-dex-prexs))))))
+
+      
+
+(defun make-generalize-rules-for-records (conx-prex dex-names concls hints)
+  (declare (xargs :guard (and (symbol-listp dex-names)
+                              (true-listp concls)
+                              (symbolp conx-prex))))
+  (if (endp concls)
+      '()
+    (cons `(defthm ,(modify-symbol (string-append (symbol-name (car dex-names)) "-") conx-prex "-RECORD-ELIM-GENERALIZE")
+             (implies (,conx-prex x)
+                      ,(car concls))
+                      :rule-classes :generalize
+                      :hints ,hints)
+          (make-generalize-rules-for-records conx-prex (cdr dex-names) (cdr concls) hints))))
+
+(defmacro register-record-constructor (constructor destructor-lst
+                                                   &key 
+                                                   hints
+                                                   (rule-classes '(:rewrite :tau-system))
+                                                   forcep ;force typ hyps
+                                                   measure-fn
+                                                   )
+  
+  (declare (xargs :guard (and (true-listp destructor-lst)
+                              (booleanp forcep))))
+  (let* ((ctx 'register-record-constructor)
+         (conx-pair (fix-structor-and-pred constructor ctx))
+         (dex-pairs destructor-lst)
+         (conx-name (car conx-pair))
+         (conx-prex (cdr conx-pair))
+         (dex-names (strip-cars dex-pairs))
+         (dex-prexs (strip-cdrs dex-pairs))
+         (msr-fn  measure-fn)
+         (elim-rule-name (modify-symbol "" conx-name "-RECORD-ELIM-RULE"))
+         (nume (list :elim elim-rule-name))
+         (elim-term `(implies (,conx-prex x)
+                              (equal (,conx-name
+                                      . ,(apply-mget-to-x-lst dex-names t))
+                                     x)))
+         (elim-rule (get-elim-rule nume elim-term '?))
+         (gen-concls (record-gen-theorem-conclusions dex-names dex-prexs))
+         (generalize-rules (make-generalize-rules-for-records conx-prex dex-names gen-concls hints)))
+    
+        
+    `(progn
+       (defthm ,(modify-symbol "" conx-name "-RECORD-PRED")
+         (implies (and . ,(build-one-param-calls-forcep dex-prexs dex-names forcep))
+                  (,conx-prex (,conx-name . ,dex-names)))
+         :hints ,hints
+         :rule-classes ,rule-classes)
+                       
+       (defthm ,elim-rule-name
+         (implies (,conx-prex x)
+                  (equal (,conx-name
+                          . ,(apply-mget-to-x-lst dex-names nil))
+                         x))
+         :hints ,hints
+         :rule-classes nil) ;elim form not satisfied TODO
+
+       (defthm ,(modify-symbol "" conx-name "-RECORD-DESTRUCTORS")
+         (implies (and . ,(build-one-param-calls-forcep dex-prexs dex-names forcep))
+                  
+                  (and . ,(append (get-proper-dex-theorems conx-name dex-names t)
+                                  (get-improper-dex-theorems conx-name dex-names dex-prexs t))))
+         :rule-classes nil ;subsumed by record theorems
+         :hints ,hints)
+
+       ,@generalize-rules
+
+      (table record-constructors
+             ',conx-name
+             ',(list* '(:generated :proper)
+                      conx-prex dex-pairs 
+                      (if msr-fn msr-fn 'none))
+             :put)
+
+      (table record-elim-table ',conx-name ',elim-rule :put)
+      
+      (value-triple (list ',constructor ',destructor-lst)))))
+
+
+;;--(get-enumerator-symbol 'int) ==> NTH-INT
+(defun get-enumerator-symbol (sym)
+  (declare (xargs :guard (symbolp sym)))
+  (modify-symbol "NTH-" sym ""))
+
+(defun get-enumerator-symbol-lst (syms)
+  (declare (xargs :guard (symbol-listp syms)))
+  (if (endp syms)
+    nil
+    (cons (get-enumerator-symbol (car syms))
+          (get-enumerator-symbol-lst (cdr syms)))))
+
+(defun get-uniform-enumerator-symbol (sym)
+  (declare (xargs :guard (symbolp sym)))
+  (modify-symbol "NTH-" sym "-UNIFORM"))
+
+(defun get-uniform-enumerator-symbol-lst (syms)
+  (declare (xargs :guard (symbol-listp syms)))
+  (if (endp syms)
+    nil
+    (cons (get-uniform-enumerator-symbol (car syms))
+          (get-uniform-enumerator-symbol-lst (cdr syms)))))
+
+
+;;--(get-values-symbol 'foo) ==> *FOO-VALUES*
+(defun get-values-symbol (sym)
+  (declare (xargs :guard (symbolp sym)))
+  (modify-symbol "*" sym "-VALUES*"))
+
+(defun get-values-symbol-lst (syms)
+  (declare (xargs :guard (symbol-listp syms)))
+  (if (endp syms)
+    nil
+    (cons (get-values-symbol (car syms))
+          (get-values-symbol-lst (cdr syms)))))
+
+
+
+(defun get-predicate-testthm-symbol (sym)
+  (declare (xargs :guard (symbolp sym)))
+  (modify-symbol "" sym "P-TESTTHM"))
+
+(defun get-predicate-def-thm-symbol (sym)
+  (declare (xargs :guard (symbolp sym)))
+  (modify-symbol "" sym "P-DEFINITION-THM"))
+
+(defun get-predicate-def-thm-symbol-lst (syms)
+  (declare (xargs :guard (symbol-listp syms)))
+  (if (endp syms)
+    nil
+    (cons (get-predicate-def-thm-symbol (car syms))
+          (get-predicate-def-thm-symbol-lst (cdr syms)))))
+
+(defun get-predicate-testthm-symbol-lst (syms)
+  (declare (xargs :guard (symbol-listp syms)))
+  (if (endp syms)
+    nil
+    (cons (get-predicate-testthm-symbol (car syms))
+          (get-predicate-testthm-symbol-lst (cdr syms)))))
+
+;;--add enumeration events maintaining consistency with history
+(defun compute-define-enumeration-type-events (nm psym vsym tsym values wrld)
+  (declare (xargs :mode :program))
+  (let ((len-v (len values)))
+  (list (if (decode-logical-name vsym wrld)
+          `(assert-event (set-equalp-equal ',values ,vsym))
+          `(progn 
+             (defconst ,vsym ',values)
+             (defun ,(get-enumerator-symbol nm) (n)
+               (declare (xargs :guard (natp n)))
+               (nth (mod n ,len-v) ,vsym))))
+        (if (decode-logical-name psym wrld)
+          `(local (defthm ,tsym
+                    (iff (member-equal x ,vsym)
+                         (,psym x))
+                    :rule-classes nil))
+          `(defun ,psym (x)
+             (declare (xargs :guard t))
+             (if (member-equal x ,vsym) t nil)))
+        `(register-custom-type ,nm ,len-v ,vsym ,psym 
+                               :type-class enum))))
+
+;--TODO: Instead of guards, the syntax check should be explicit!
+(defmacro define-enumeration-type (name values)
+  (declare (xargs :guard (and (symbolp name))))
+                              ;(true-listp values)))) ;can pass a defconst name too
+  `(make-event
+    (cons 'progn
+          (append
+            (compute-define-enumeration-type-events 
+               ',name
+               (get-predicate-symbol ',name)
+               (get-values-symbol ',name)
+               (get-predicate-testthm-symbol ',name)
+               ,values
+               (w state))
+            `((value-triple ',',name))))))
+
+
+#|;Test code
+(define-enumeration-type boolean '(t nil))
+(define-enumeration-type zero '(0))
+(define-enumeration-type asdf '(a s d f))
+;|#
+
+
+; a symbol FOO is a "type" if
+;   - FOOP is a recognizer for it and
+;   either -NTH-FOO is an enumerator for it (infinite)
+;          -*FOO-VALUES* is the set of values for it (finite)
+
+
+
+; a "type operator" is, for now, ONEOF or ANYOF (for now, the same)
+(deflabel oneof)
+(deflabel anyof)
+
+; got rid of LISTOF because it's hard to do implicit recursion
+; plus it's pedagogically dubious
+;-- got it back in view of its usability --modified by --harshrc
+(deflabel listof)
+(deflabel record)
+(deflabel map);ADDED 3rd May 2011 and again on 17 July '13
+(deflabel set)
+(deflabel enum)
+
+
+; a "constructor" is registered as above, with proper arity
+; or a macro which expands to function(s) that are constructors
+
+
+
+;;--eg:(build-dex-exprs '((car . allp) (cdr . allp)) '(cons x y))
+;;-- ==> ((CAR (CONS X Y)) (CDR (CONS X Y))) 
+(defun build-dex-exprs (dex-info expr)
+  (declare (xargs :mode :program
+                  :guard (alistp dex-info)))
+  (if (endp dex-info)
+    nil
+    (cons `(,(caar dex-info) ,expr)
+          (build-dex-exprs (cdr dex-info) expr))))
+
+
+
+
+;; syntax-directed translation of data definition
+;; to obtain predicate expression list
+(mutual-recursion
+ (defun er-trans-datadef-as-predicate-lst (defbody-lst new-preds expr-lst
+                                            new-constructors ctx wrld state)
+   (declare (xargs :mode :program
+                   :guard (and (symbol-listp new-preds)
+                               (true-listp expr-lst)
+                               (= (len expr-lst) (len defbody-lst))
+                               (symbol-alistp new-constructors)
+                               (symbolp ctx)
+                               (plist-worldp wrld))))
+   (if (atom defbody-lst)
+       (if (null defbody-lst)
+           (value nil)
+         (er soft ctx "Expecting a true list but last cdr is ~x0" defbody-lst))
+     (er-let* ((car-pred
+                (er-trans-datadef-as-predicate (car defbody-lst)
+                                               new-preds (car expr-lst)
+                                               new-constructors
+                                               ctx wrld state))
+               (cdr-pred-lst
+                (er-trans-datadef-as-predicate-lst (cdr defbody-lst)
+                                                   new-preds (cdr expr-lst)
+                                                   new-constructors
+                                                   ctx wrld state)))
+      
+      (value (cons car-pred cdr-pred-lst)))))
+
+;;-- translate type-expression(defbody) to obtain a predicate expression body
+;;-- for a predicate function with argument 'expr', lets say the [[expr]] = v
+;;-- cases defbody := 
+;;--       1. constant value 'val' => (eq val v) 
+;;--       2. predicate symbol(new/in-history) => (pred v)
+;;--       3. (oneof ...) => (or ...)
+;;--       4. (cons texp1 texp2)  => (and (consp v)
+;;--                                      (pred1 (car v))
+;;--                                      (pred2 (cdr v)))
+;;--       5. new constructor: (node t1 t2 t2) => (nodep v)
+;;--       6. macro calls are expanded, then recurse on result
+  
+ (defun er-trans-datadef-as-predicate (defbody new-preds expr 
+                                        new-constructors
+                                        ctx wrld state)
+   (declare (xargs :guard (and (symbol-listp new-preds)
+                               (symbol-alistp new-constructors)
+                               (symbolp ctx)
+                               (plist-worldp wrld))))
+   (cond ((possible-constant-valuep defbody)
+          (er-let* ((val (er-get-constant-value defbody ctx wrld state)))
+           (let ((comparison (cond ((symbolp val) 'eq)
+                                   ((eqlablep val) 'eql)
+                                   (t 'equal))))
+            (value `(,comparison ,expr ',val)))))
+         
+         ((symbolp defbody)
+          (if (member-eq (get-predicate-symbol defbody) new-preds)
+              (let* ((pred (get-predicate-symbol defbody)))
+                (value `(,pred ,expr)))
+            (er-let* ((pred (er-get-predicate defbody ctx wrld state)))
+             (value `(,pred ,expr)))))
+         
+; should be a cons if we get here
+         (t
+          (let ((comb (car defbody)))
+           (cond 
+            ((or (eq comb 'oneof)
+                 (eq comb 'anyof))
+             (er-let* ((rst (er-trans-datadef-as-predicate-lst
+                             (cdr defbody) new-preds
+                             (make-list (len (cdr defbody))
+                                        :initial-element expr)
+                             new-constructors
+                             ctx wrld state)))
+              (value `(or . ,rst))))
+
+            
+            (t ; look up as constructor, then as macro
+             (let* ((registered-conx-info 
+                     (or (assoc-eq comb (table-alist 'data-constructors wrld))
+                         (assoc-eq comb (table-alist 'record-constructors wrld))))
+                    (to-be-created-conx-info (assoc-eq comb new-constructors))
+                    (conx-info (or registered-conx-info to-be-created-conx-info)))
+               (if conx-info
+                   (let ((conx-pred (predicate-name-entry conx-info))
+                         (dex-info (dex-pairs-entry conx-info)))
+                    (if registered-conx-info
+                        (er-let* ((rst (er-trans-datadef-as-predicate-lst
+                                        (cdr defbody) new-preds
+                                        (build-dex-exprs dex-info expr)
+                                        new-constructors
+                                        ctx wrld state)))
+                         (value `(and (,conx-pred ,expr)
+                                      . ,rst)))
+;harshrc: The reason why the following is different from the
+;registered-conx-info, is that one can have a (cons string int), where
+;the string and int are stronger requirements than allp of cons
+;requires. But when we are constructing a new record on the fly, say
+;(oneof 'Leaf (node (key . int) (left . tree) (right . tree))), the
+;requirements are tight and hence there is no reason to recur on the
+;components, since their type constraints are reflected in nodep itself.
+                      (value (list conx-pred expr))))
+                 (if (true-listp (acl2-getprop comb 'macro-args wrld
+                                               :default :undefined))
+                     
+                     ;; attempt macro expansion
+                     (er-let* ((newdefbody (macroexpand1 defbody ctx state)))
+                      (er-trans-datadef-as-predicate newdefbody new-preds expr
+                                                     new-constructors
+                                                     ctx wrld state))
+                   ;; otherwise, illegal
+                   (er soft ctx "~x0 is not a recognized constructor or ~
+                                 type combinator." comb))))))))))
+)
+
+;;--If all arguments are constant values, then the constructor calls can be
+;;--evaluated/combined using the following functions to obtain constant values.
+;;e.g:
+#||
+(EVAL-FN-COMBINE-ARG-LSTS 'cons
+                             '((a b) ("g" ((12) . c) ((x "no") . ok)))
+                             'top-level state)
+ ((A . "g")
+  (B . "g")
+  (A (12) . C)
+  (B (12) . C)
+  (A (X "no") . OK)
+  (B (X "no") . OK))
+||#
+
+(defun eval-fn-combine-arg-lsts0 (fn arglst-sofar rev-arglsts ctx state)
+  (declare (xargs :mode :program))
+  (cond ((endp rev-arglsts)
+         (er-let* ((v (trans-eval-single-value (cons fn arglst-sofar) ctx state)))
+           (value (list v))))
+        ((endp (car rev-arglsts))
+         (value nil))
+        (t
+         (er-let*
+           ((values1 (eval-fn-combine-arg-lsts0 fn
+                                                (cons (list 'quote (caar rev-arglsts))
+                                                      arglst-sofar)
+                                                (cdr rev-arglsts)
+                                                ctx state))
+            (values2 (eval-fn-combine-arg-lsts0 fn
+                                                arglst-sofar
+                                                (cons (cdar rev-arglsts)
+                                                      (cdr rev-arglsts))
+                                                ctx state)))
+           (value (union-equal values1 values2))))))
+
+(defun eval-fn-combine-arg-lsts (fn arglsts ctx state)
+  (declare (xargs :mode :program))
+  (eval-fn-combine-arg-lsts0 fn nil (reverse arglsts) ctx state))
+
+
+
+
+;static analysis of data-definitions to get finite data defs:
+;fixed point iteration over data def structure.
+(mutual-recursion
+ (defun er-get-finite-data-def-lst (defbody-lst finite-defs 
+                                     new-constructors
+                                     ctx wrld state)
+   (declare (xargs :mode :program
+                   :guard (and (true-listp defbody-lst)
+                               (symbol-alistp finite-defs)
+                               (symbol-alistp new-constructors)
+                               (symbolp ctx)
+                               (plist-worldp wrld))))
+   (if (endp defbody-lst)
+       (value nil)
+     (er-let* ((fst (er-get-finite-data-def (car defbody-lst) finite-defs
+                                            new-constructors ctx wrld state))
+               (rst (er-get-finite-data-def-lst (cdr defbody-lst) finite-defs
+                                                new-constructors ctx wrld state)))
+      (value (cons fst rst)))))  
+
+ ;; (value nil) if infinite or (value <list of values>) if finite 
+ (defun er-get-finite-data-def (defbody finite-defs new-constructors ctx wrld state)
+   (declare (xargs :guard (and (symbol-alistp finite-defs)
+                               (symbol-alistp new-constructors)
+                               (symbolp ctx)
+                               (plist-worldp wrld))))
+   (cond ((possible-constant-valuep defbody);is a constant(singleton type)
+          (er-let* ((val (er-get-constant-value defbody ctx wrld state)))
+           (value (list val))))
+         ((symbolp defbody) ;is a symbol (typename)
+          (if (assoc-eq defbody finite-defs)
+              (value (cdr (assoc-eq defbody finite-defs)))
+            (let* ((vsym (get-values-symbol defbody))
+                   (quoted-values (acl2-getprop vsym 'const wrld)))
+              ;; assume infinite if values not available
+              (if quoted-values
+                  (value (cadr quoted-values)) ; unquote
+                (value nil)))))
+         ;; should be a cons if we get here
+         (t ; either a product or union type expression or a macro call
+          (let ((comb (car defbody)))
+           (cond 
+            ((or (eq comb 'oneof)
+                 (eq comb 'anyof)) ;UNION
+             (er-let* ((rst (er-get-finite-data-def-lst
+                             (cdr defbody) finite-defs
+                             new-constructors
+                             ctx wrld state)))
+              (if (member-eq nil rst) ; at least one infinite branch
+                  (value nil)
+                (value (union-lsts rst)))))
+            (t ; look up as constructor(registered or new), then as macro
+             (let* ((reg-conx-info 
+                     (or (assoc-eq comb (table-alist 'data-constructors wrld))
+                         (assoc-eq comb (table-alist 'record-constructors wrld))))
+                    (to-be-created-conx-info (assoc-eq comb new-constructors))
+                    (conx-info (or reg-conx-info 
+                                   to-be-created-conx-info)))
+                    
+                    ;;--conx-info e.g: (cons (:proper)
+                    ;;--                 consp (car . allp) (cdr . allp))
+                    ;;-- what if its a macro? say list, will it already be
+                    ;;-- expanded when it reaches here? No, it gets expanded here only.
+               (if conx-info ;PRODUCT TYPE EXPRESSION
+                   (er-let* ((rst (er-get-finite-data-def-lst
+                                   (cdr defbody) finite-defs
+                                   new-constructors
+                                   ctx wrld state)))
+                    (if (or (member-eq nil rst) ; at least one infinite branch
+
+; added the following condition to fix BUG below (June 26th '13), but this
+; breaks the invariant that this function returns nil only for
+; infinite types (ACHTUNG)
+                            to-be-created-conx-info) ;records
+                        (value nil)
+                      (eval-fn-combine-arg-lsts 
+; harshrc 28th Aug '12: TODO - check if list* is a mistake or not. (BUG)
+; 26th June '13 - list* is wrong, records are implemented differently now.
+                       comb ;(if reg-conx-info comb 'list*) 
+                       rst ctx state)))
+                 (if (true-listp (acl2-getprop comb 'macro-args wrld 
+                                               :default :undefined))
+;MACRO CALL
+                     ;; attempt macro expansion
+                     (er-let* ((newdefbody (macroexpand1 defbody ctx state)))
+                      (er-get-finite-data-def newdefbody finite-defs
+                                              new-constructors
+                                              ctx wrld state))
+                   ;; otherwise, illegal
+                   (er soft ctx "~x0 is not a recognized constructor or ~
+                                  type combinator." comb))))))))))
+)
+
+; step in iteration
+ (defun er-get-finite-data-defs1 (defs finite-defs new-constructors ctx wrld state)
+   (declare (xargs :mode :program
+                   :guard (and (symbol-alistp defs)
+                               (symbol-alistp finite-defs)
+                               (symbol-alistp new-constructors)
+                               (symbolp ctx)
+                               (plist-worldp wrld))))
+   (cond ((endp defs)
+          (value finite-defs))
+         ((assoc-eq (caar defs) finite-defs)
+          (er-get-finite-data-defs1 (cdr defs) finite-defs new-constructors ctx wrld state))
+         (t
+          (er-let* ((new-def (er-get-finite-data-def (cadar defs) finite-defs
+                                                     new-constructors
+                                                     ctx wrld state)))
+           (er-get-finite-data-defs1 (cdr defs)
+                                     (if new-def ; finite (nil -> infinite)
+                                         (cons (cons (caar defs)
+                                                     new-def)
+                                               finite-defs)
+                                       finite-defs)
+                                     new-constructors 
+                                     ctx wrld state)))))
+
+
+             
+
+; iterate until fixed point
+ (defun er-get-finite-data-defs0 (defs finite-defs new-constructors ctx wrld state)
+   (declare (xargs :mode :program
+                   :guard (and (symbol-alistp defs)
+                               (symbol-alistp finite-defs)
+                               (symbol-alistp new-constructors)
+                               (symbolp ctx)
+                               (plist-worldp wrld))))
+   (er-let* ((new-finite-defs (er-get-finite-data-defs1 defs finite-defs
+                                                        new-constructors
+                                                        ctx wrld state)))
+    (if (equal finite-defs new-finite-defs)
+        (value new-finite-defs)
+      (er-get-finite-data-defs0 defs new-finite-defs new-constructors ctx wrld state))))
+    
+; Start fix-point iteration
+(defun er-get-finite-data-defs (defs new-constructors ctx wrld state)
+  (declare (xargs :mode :program
+                  :guard (and (symbol-alistp defs)
+                              (symbolp ctx)
+                              (symbol-alistp new-constructors)
+                              (plist-worldp wrld))))
+  (er-get-finite-data-defs0 defs nil new-constructors ctx wrld state))
+
+
+
+#|| ;test code
+
+(define-enumeration-type boolean '(t nil))
+(register-data-constructor (consp cons)
+                           ((allp car) (allp cdr))
+                           :proper t)
+
+
+; harshrc Jun 26 '13: why would anyone define such a type clique?
+(er-get-finite-data-defs '((foo (oneof 42 (cons boolean baz)))
+                           (bar (oneof nil
+                                       (cons foo bar)))
+                           (moo nil)
+                           (baz (cons boolean moo)))
+                         nil
+                         'top-level (w state) state)
+||#
+
+
+
+;;-- gives back enumerator information
+;;-- e.g:
+;;-- (er-get-enumeration-info 'integer 'x nil '(acl2::nth-integer acl2::nth-rational) 'top-level (w state) state)
+;;-- ==> (T ACL2::NTH-INTEGER X)
+;;-- if nth-integer is already defined in current world then:
+;;-- (er-get-enumeration-info 'integer 'x nil nil 'top-level (w state) state)
+;;-- ==> (T ACL2::NTH-INTEGER X)
+;;-- (er-get-enumeration-info 'boolean 'x nil nil 'top-level (w state) state)
+;;-- ==> (2 NTH X *BOOLEAN-VALUES*)
+ 
+(defun er-get-enumeration-info (type-name expr finite-defs inf-enum-syms uniform? ctx wrld state)
+"returns (cons size enumcall), where size is the size of type-name and enumcall is
+formed from expr and the enumerator associated with type-name."
+  (declare (xargs :mode :program
+                  :guard (and (symbolp type-name)
+                              (symbol-alistp finite-defs)
+                              (symbol-listp inf-enum-syms)
+                              (symbolp ctx)
+                              (booleanp uniform?)
+                              (plist-worldp wrld))))
+  (let* ((vsym (get-values-symbol type-name))
+         (values (or (second (acl2-getprop vsym 'const wrld))
+                     (cdr (assoc-eq vsym finite-defs)))))
+    (if values
+      (let ((len-v (len values)))
+        (value (cons len-v
+                     (if (= len-v 1)  
+                       (if uniform?
+                           `(mv ',(car values) seed)
+                         `',(car values))
+                       (if uniform?
+                           `(mv (nth (mod seed ,len-v) ,vsym) seed)
+                         `(nth ,expr ,vsym))))))
+      (let* ((esym (if uniform? 
+                       (get-uniform-enumerator-symbol type-name)
+                     (get-enumerator-symbol type-name))))
+             
+        ;;-check if arity matches(implicit check if enum is defined in wrld)
+        (cond ((allows-arity esym (if uniform? 2 1) wrld)
+               (if uniform? 
+                   (value (cons t `(,esym m seed)))
+                 (value (cons t `(,esym ,expr)))))
+              ((member-eq esym inf-enum-syms)
+               (if uniform? 
+;14 July 2013
+;every recursive call is given a probably different measure argument
+; 21 July - due to termination issues in mutual-recursive defs, lets simply do a 1-/zp recursion. todo hack 
+                   (value (cons t ;(mv-let (m seed) (random-index-seed m seed) 
+                                           `(,esym m seed)))
+                   (value (cons t `(,esym ,expr)))))
+              (t       
+               (er soft ctx
+                   "Type specifier ~x0 is invalid. To be valid, it needs a valid ~
+                    enumerator ~x1 or a valid list of values ~x2."
+                   type-name esym vsym)))))))
+
+#||
+(define-enumeration-type boolean '(t nil))
+
+(register-data-constructor (consp cons)
+                           ((allp car) (allp cdr))
+                           :proper t)
+
+(defconst *foo-values* '(1 2 3))
+(defconst *bar-values* '(a))
+(er-get-enumeration-info 'foo 'x nil nil nil 'top-level (w state) state)
+(er-get-enumeration-info 'bar 'x nil nil nil 'top-level (w state) state)
+||#
+
+(defun get-inf-enum-infos (l)
+  (declare (xargs :guard (true-listp l)))
+  (cond ((endp l)
+         l)
+        ((and (consp (car l))
+              (eq 't (caar l)))
+         (cons (car l)
+               (get-inf-enum-infos (cdr l))))
+        (t
+         (get-inf-enum-infos (cdr l)))))
+
+; finite size = 1 i.e.  singleton values)
+(defun get-singleton-enum-infos (l)
+  (declare (xargs :guard (true-listp l)))
+  (cond ((endp l)
+         l)
+        ((and (consp (car l))
+              (equal 1 (caar l));size 1
+              ;(possible-constant-valuep (cdar l)) ;Comes from trusted code, so no need.
+              );singleton value
+         (cons (car l)
+               (get-singleton-enum-infos (cdr l))))
+        (t
+         (get-singleton-enum-infos (cdr l)))))
+
+; fin = finite size > 1 (i.e. finite but not singleton values)
+(defun get-fin-enum-infos (l)
+  (declare (xargs :guard (true-listp l)))
+  (cond ((endp l)
+         l)
+        ((and (consp (car l))
+              (natp (caar l))
+              (not (and (equal 1 (caar l))
+                        ;(possible-constant-valuep (cdar l)) ;Comes from trusted code, so no need.
+                   )));not singleton value
+                    
+         (cons (car l)
+               (get-fin-enum-infos (cdr l))))
+        (t
+         (get-fin-enum-infos (cdr l)))))
+
+
+
+(defun +-cars0 (l acc)
+  (declare (xargs :mode :program))
+  (if (endp l)
+      acc
+    (+-cars0 (cdr l) (+ acc (caar l)))))
+
+(defun +-cars (l)
+  (declare (xargs :mode :program))
+  (+-cars0 l 0))
+
+(defun *-cars0 (l acc)
+  (declare (xargs :mode :program))
+  (if (endp l)
+      acc
+    (*-cars0 (cdr l) (* acc (caar l)))))
+
+(defun *-cars (l)
+  (declare (xargs :mode :program))
+  (*-cars0 l 1))
+
+
+
+;NOTE: enum-info-lst that the following 2 functions
+;gets as arguments is a sorted one, with singleton enums
+; finite-enums occurring before the inf-enums in the lst
+;enum-info-lst is of form : (size/magnitude . (enumerator call)) or (1 . constant-value)
+
+;build union expressions for generating enumerator functions
+(defun build-inf-choices-enum-n (enum-info-lst n)
+  (declare (xargs :mode :program))
+  (cond ((not (consp enum-info-lst))
+         ':error)
+        ((not (consp (cdr enum-info-lst)))
+         (cdar enum-info-lst))
+        (t
+         `(if (= n ,n)
+              ,(cdar enum-info-lst)
+            ,(build-inf-choices-enum-n (cdr enum-info-lst) (1+ n))))))
+
+; enum-info-lst should always be a cons
+(defun build-choice-enum1 (enum-info-lst)
+  (declare (xargs :mode :program))
+  (cond ((not (consp enum-info-lst))
+         ':error);should not get here
+        ((not (consp (cdr enum-info-lst)))
+         (cdar enum-info-lst));the last choice
+;remaining have atleast 2 choices
+        ((natp (caar enum-info-lst)) ; finite
+         `(if (< x ,(caar enum-info-lst)) ;pushed the (not integerp) call to build-choice-enum
+              ,(cdar enum-info-lst)
+            ,(if (and (not (consp (cddr enum-info-lst))) ;if the next choice is the last one
+                      (equal 1 (caadr enum-info-lst))) ;and is a singleton
+                 (build-choice-enum1 (cdr enum-info-lst));dont do a let
+               `(let ((x (- x ,(caar enum-info-lst))))
+                  ,(build-choice-enum1 (cdr enum-info-lst))))))
+        (t ; assume all remaining are infinite
+         (let ((nchoices (len enum-info-lst)))
+           `(mv-let 
+             (n x)
+             (switch-nat ,nchoices (nfix x)) ;nfix helps termination
+             ,(build-inf-choices-enum-n enum-info-lst 0))))))
+
+
+;harshrc: we dont need repeated (or (not (integerp x) ..) calls, once in the
+;beginning is enough. This improves readability of generated enums
+
+(defun build-choice-enum (enum-info-lst)
+  (declare (xargs :mode :program))
+  (cond ((not (consp enum-info-lst))
+         ':error)
+        ((not (consp (cdr enum-info-lst)))
+         (cdar enum-info-lst)) ;no need to change here anything(cos this is a top-level call only)
+        ((natp (caar enum-info-lst)) ; finite
+         `(if (or (not (integerp x));top-level check for non-integers
+                  (< x ,(caar enum-info-lst)))
+              ,(cdar enum-info-lst)
+            ;;if the next choice is the last one
+            ,(if (and (not (consp (cddr enum-info-lst)))
+                      (equal 1 (caadr enum-info-lst))) ;and is a singleton
+                 (build-choice-enum1 (cdr enum-info-lst));dont do a let
+               `(let ((x (- x ,(caar enum-info-lst))))
+                  ,(build-choice-enum1 (cdr enum-info-lst))))))
+        (t ; assume all remaining are infinite
+         (let ((nchoices (len enum-info-lst)))
+           `(mv-let (n x)
+                    (switch-nat ,nchoices  (nfix x));nfix helps termination
+                    ,(build-inf-choices-enum-n enum-info-lst 0))))))
+
+#||
+(build-choice-enum '((5 nth x *blah5*)
+                     (7 nth x *blah7*)
+                     (1 quote nil)
+                     (t nth-whatever x)
+                     (t nth-moo x)))
+
+(build-choice-enum '((1 quote nil)
+                     (1 quote pl)
+                     (5 nth x *blah5*)
+                     (7 nth x *blah7*)
+                     (t nth-whatever x)
+                     (t nth-moo x)
+                     ))
+                     
+||#
+
+(defun build-case-clauses-enum-uniform (enum-info-lst i)
+  (declare (xargs :verify-guards nil
+                  :guard (and (true-listp enum-info-lst)
+                              (implies (consp enum-info-lst) (consp (car enum-info-lst)))
+                              (natp i))))
+  (if (endp enum-info-lst)
+      '()
+    (if (endp (cdr enum-info-lst))
+        `((otherwise ,(cdar enum-info-lst)))
+    (b* ((enum-call (cdar enum-info-lst)))
+      (cons `(,i ,enum-call)
+            (build-case-clauses-enum-uniform (cdr enum-info-lst) (1+ i)))))))
+         
+
+
+(defun build-choice-enum-uniform-nonrec (nonrec-eil len-nonrec)
+  (declare (xargs :verify-guards nil));(consp nonrec-eil)
+  (if (<= len-nonrec 1)
+      (cdar nonrec-eil)
+    `(mv-let (n seed)
+             (random-index-seed ,len-nonrec seed)
+             (case n ,@(build-case-clauses-enum-uniform nonrec-eil 0)))))
+
+(defun build-choice-enum-uniform (nonrec-eil rec-eil)
+  (declare (xargs :verify-guards nil)) ;(consp nonrec-eil)
+  (b* ((len-nonrec (len nonrec-eil))
+       (len-rec (len rec-eil)))
+    (if (consp rec-eil)
+        `(if (or (zp m)
+                 (not (unsigned-byte-p 31 seed))) ;for termination proofs
+             ,(build-choice-enum-uniform-nonrec nonrec-eil len-nonrec)
+           ,(if (<= len-rec 1)
+                `(let ((m (1- m))) ;to ensure termination
+                   ,(cdar rec-eil))
+              `(let ((m (1- m))) ;to ensure termination
+                 (mv-let (n seed)
+                         (random-index-seed ,len-rec seed)
+                         (case n ,@(build-case-clauses-enum-uniform rec-eil 0))))))
+      (build-choice-enum-uniform-nonrec nonrec-eil len-nonrec))))
+      
+
+
+;build up product expressions for enumerator functions to be generated
+;order is maintained while generating values
+;enum-info-lst is of form : (size/magnitude . (enumerator call)) or (1 . constant-value)
+(defun build-product-comb-enum-actuals (enum-info-lst fin-n inf-n)
+  (declare (xargs :mode :program))
+  (cond ((endp enum-info-lst)
+         nil)
+        ((equal 1 (caar enum-info-lst));singleton
+         (cons (cdar enum-info-lst)
+               (build-product-comb-enum-actuals (cdr enum-info-lst) fin-n inf-n)))
+        ((natp (caar enum-info-lst)) ; finite enum info
+         (cons `(let ((x (nth ,fin-n finxlst)))
+                  ,(cdar enum-info-lst))
+               (build-product-comb-enum-actuals (cdr enum-info-lst) (1+ fin-n) inf-n)))
+        (t                           ; infinite
+         (cons `(let ((x (nth ,inf-n infxlst)))
+                  ,(cdar enum-info-lst))
+               (build-product-comb-enum-actuals (cdr enum-info-lst) fin-n (1+ inf-n))))))
+
+(defun get-fin-and-sing-enum-infos (l)
+  (declare (xargs :guard (true-listp l)))
+  (cond ((endp l)
+         l)
+        ((and (consp (car l))
+              (natp (caar l)))
+         (cons (car l)
+               (get-fin-and-sing-enum-infos (cdr l))))
+        (t
+         (get-fin-and-sing-enum-infos (cdr l)))))
+
+
+(defun build-product-comb-enum (enum-info-lst conx)
+  (declare (xargs :mode :program))
+  (let* ((fin-info-lst (get-fin-and-sing-enum-infos enum-info-lst))
+         (fin-info-lst1 (get-fin-enum-infos enum-info-lst))
+         (inf-info-lst (get-inf-enum-infos enum-info-lst))
+         (call (cons conx (build-product-comb-enum-actuals enum-info-lst 0 0)))
+         (expr1 (if (consp inf-info-lst)
+                    (if (null (cdr inf-info-lst)) ;len=1
+                        `(let ((infxlst (list (nfix x))));29 Apr 2011 fix termination of mut-rec enum-fns
+                           ,call)
+                      `(let ((infxlst (split-nat ,(len inf-info-lst) (nfix x))));29 Apr 2011 fix termination of mut-rec enum-fns
+                         ,call))
+                  call))
+         (expr2 (if fin-info-lst1 ;only if there are choices to be made(in singleton theres no choice)
+                    (if inf-info-lst
+                        `(mv-let 
+                          (finxlst x)
+                          (multiple-switch-nat ',(strip-cars fin-info-lst)
+                                               (nfix x));nfix helps termination
+                          ;;pass on the seed if there are inf enums ahead
+                          ,expr1)
+                      `(mv-let 
+                        (finxlst x)
+                        (multiple-switch-nat ',(strip-cars fin-info-lst)
+                                             (nfix x));nfix helps termination
+                        (declare (acl2::ignorable x))
+                        ;;dont pass on seed if no inf enums ahead
+                        ,expr1))
+                  ;;else
+                  expr1)))
+    expr2))
+
+(program)
+(defun make-name-with-pos-suffix (expr i ans)
+  (if (zp i)
+      ans
+    (make-name-with-pos-suffix expr (1- i) 
+                               (cons (modify-symbol "" expr (to-string i)) ans))))
+
+(defun build-product-comb-enum-uniform1 (enum-info-lst expr i body)
+  (if (endp enum-info-lst)
+      body
+    `(mv-let (,(modify-symbol "" expr (to-string i)) seed)
+             ,(cdar enum-info-lst)
+             ,(build-product-comb-enum-uniform1 (cdr enum-info-lst) 
+                                                     expr (1+ i) body))))
+
+(defun build-product-comb-enum-uniform (enum-info-lst comb)
+  (let ((expr 'val))
+    (build-product-comb-enum-uniform1 
+     enum-info-lst expr  1 
+     `(mv (,comb ,@(make-name-with-pos-suffix expr (len enum-info-lst) '())) 
+          (the (unsigned-byte 31) seed)))))
+    
+(logic)
+
+#||
+(build-product-comb-enum '((t nth-whatever x)
+                           (1  quote nil)
+                           (5 nth x *blah5*)
+                           (7 nth x *blah7*)
+                           (t nth-moo x)
+                           )
+                 'list)
+(build-product-comb-enum '((1  quote nil)
+                           (1  quote 1)
+                           (1 .  2)
+                           (t nth-what x)
+                           (t nth-moo x))
+                 'woo)
+
+||#
+
+
+
+;2 funs added by harshrc
+(defun found-recursive-enum-call (inf-enum-call inf-enum-syms)
+  (declare (xargs :guard (true-listp inf-enum-syms)))
+  (if (endp inf-enum-syms)
+      nil
+    (if (mem1 (car inf-enum-syms) (flatten inf-enum-call nil)) 
+;if found a inf-enum in the call its recursive return immediately
+        t 
+      (found-recursive-enum-call inf-enum-call (cdr inf-enum-syms)))))
+    
+(local (defthm append-of-2-lists-is-true-list
+         (implies (and (true-listp x1)
+                       (true-listp x2))
+              (true-listp (append x1 x2)))
+         :rule-classes :type-prescription))
+     
+;partition enums by those which are base cases first, ie non-recursive
+;This fun fixes a bug where theres a recursive defdata and the sequence is
+;such that in the oneof the recursive case comes first than the base case
+;BUG-FIX: This sorting function is not stable i.e it changes the order
+;of those enums with the same size.
+(defun partition-inf-enum-infos (inf-enum-infos inf-enum-syms non-rec-ans rec-ans)
+  (declare (xargs :verify-guards nil
+                  :guard (and (true-listp inf-enum-syms)
+                              (true-listp rec-ans)
+                              (true-listp non-rec-ans))))
+  (if (endp inf-enum-infos)
+      (mv non-rec-ans rec-ans)
+    (if (found-recursive-enum-call (cdr (car inf-enum-infos)) inf-enum-syms)
+        (partition-inf-enum-infos (cdr inf-enum-infos) 
+                                  inf-enum-syms
+                                  non-rec-ans
+                                  ;;add to rec-ans in order
+                                  (append rec-ans (list (car inf-enum-infos))))
+      (partition-inf-enum-infos (cdr inf-enum-infos) 
+                                inf-enum-syms
+                                ;;add to non-rec-ans in order
+                                (append non-rec-ans (list (car inf-enum-infos)))
+                                rec-ans))))
+                
+                           
+                           
+         
+  
+;; (sort-inf-enum-infos '( (T LET ((INFXLST (SPLIT-NAT 2 X)))
+;;                            (CONS (LET ((X (NTH 0 INFXLST)))
+;;                                       (ACL2::NTH-INTEGER X))
+;;                                  (LET ((X (NTH 1 INFXLST)))
+;;                                       (NTH-FOO X))))
+;;                        (T ACL2::NTH-INTEGER X)) '(nth-foo) nil)
+
+
+;;; the following clique builds enumerators of product and union types
+;;; inf <- inf * inf - use split-nat to get two naturals
+;;; inf <- inf * fin - use switch-nat to get one natural and one bounded val
+;;; inf <- inf + inf - use switch-nat with 2 possibilies to determine which
+;;;                    possibility to choose and the natural number to give it
+;;; inf <- inf + fin - if < #finite posibilities, use that.  otherwise,
+;;;                    subtract #finite possibilities to get natural
+;;; split-nat : bijection from N -> N * N (takes a Nat and returns two Nat)
+;;; switch-nat: takes a number of possibilities and another natural number
+;;; and returns a value from 0 to possibilities-1 and a natural number.
+(mutual-recursion
+(defun er-trans-datadef-as-enumerator-lst (defbody-lst finite-defs 
+                                            inf-enum-syms uniform?
+                                             new-constructors ctx wrld state)
+   (declare (xargs :mode :program 
+                   :guard (and (symbol-alistp finite-defs)
+                               (symbol-listp inf-enum-syms)
+                               (symbol-alistp new-constructors)
+                               (symbolp ctx)
+                               (booleanp uniform?)
+                               (plist-worldp wrld))))
+   (if (atom defbody-lst)
+       (if (null defbody-lst)
+           (value nil)
+         (er soft ctx "Expecting a true list but last cdr is ~x0" defbody-lst))
+     (er-let* ((car-stuff
+                (er-trans-datadef-as-enumerator (car defbody-lst)
+                                                finite-defs inf-enum-syms
+                                                uniform? new-constructors
+                                                ctx wrld state))
+               (cdr-stuff-lst
+                (er-trans-datadef-as-enumerator-lst (cdr defbody-lst)
+                                                    finite-defs inf-enum-syms
+                                                    uniform? new-constructors
+                                                    ctx wrld state)))
+       (value (cons car-stuff cdr-stuff-lst)))))
+
+(defun er-trans-datadef-as-enumerator (defbody finite-defs inf-enum-syms
+                                         uniform? new-constructors ctx wrld state)
+   (declare (xargs :guard (and (symbol-alistp finite-defs)
+                               (symbol-listp inf-enum-syms)
+                               (symbol-alistp new-constructors)
+                               (symbolp ctx)
+                               (booleanp uniform?)
+                               (plist-worldp wrld))))
+   (cond ((possible-constant-valuep defbody)
+          (er-let* ((val (er-get-constant-value defbody ctx wrld state)))
+           (value (cons 1 (if uniform? 
+                              `(mv ',val seed)
+                            `',val)))))
+         ((symbolp defbody)
+          (er-get-enumeration-info defbody 'x
+                                   finite-defs inf-enum-syms uniform?
+                                   ctx wrld state)) ;the only place finite-defs is used
+; should be a cons if we get here
+         (t
+          (let ((comb (car defbody)))
+           (cond 
+            ((or (eq comb 'oneof)
+                 (eq comb 'anyof))
+             (if (atom (cdr defbody))
+                 (er soft ctx "~x0 must be given at least one argument." comb)
+               (er-let* ((rst (er-trans-datadef-as-enumerator-lst
+                               (cdr defbody) finite-defs inf-enum-syms
+                               uniform? new-constructors
+                               ctx wrld state)))
+                 (b* ((singleton-rst (get-singleton-enum-infos rst))
+                      (fin-rst (get-fin-enum-infos rst))
+                      (inf-rst (get-inf-enum-infos rst))
+                      ((mv nonrec-inf-rst rec-inf-rst) 
+                       (partition-inf-enum-infos inf-rst inf-enum-syms nil nil))
+;finite values enumerated first and in inf case, base case come first
+;by base case i mean non-recursive enums --harshrc (this fixes a bug)
+                      (new-rst (append singleton-rst 
+                                       fin-rst
+                                       nonrec-inf-rst
+                                       rec-inf-rst)) 
+;build union enum expression
+                      (enumerator (if uniform?
+                                      (build-choice-enum-uniform (append singleton-rst fin-rst nonrec-inf-rst) 
+                                                                 rec-inf-rst)
+                                    (build-choice-enum new-rst)))
+                      (magnitude (or (consp inf-rst) 
+;add finite sizes if no inf exists
+                                     (+ (len singleton-rst)
+                                        (+-cars fin-rst)))))
+                  (value (cons magnitude enumerator))))))
+
+            (t 
+; look up as constructor(registered or new), then as macro
+             (b* ((registered-conx-info (or (assoc-eq comb (table-alist 'data-constructors wrld))
+                                            (assoc-eq comb (table-alist 'record-constructors wrld))))
+                  (to-be-created-conx-info (assoc-eq comb new-constructors))
+                  ((unless (or registered-conx-info 
+                               to-be-created-conx-info
+                               (true-listp (acl2-getprop comb 'macro-args wrld
+                                               :default :undefined))))
+                   ;; illegal
+                   (er soft ctx "~|~x0 is not a type combinator, a recognized constructor or a macro expanding to one.~|" comb)))
+                   
+                    
+               (er-let* ((rst (er-trans-datadef-as-enumerator-lst
+                               (cdr defbody) finite-defs inf-enum-syms
+                               uniform? new-constructors
+                               ctx wrld state)))
+                 (let* (;(singleton-rst (get-singleton-enum-infos rst)) ;No need to multiple below by 1
+                        (fin-rst (get-fin-enum-infos rst))
+;build product enum expression
+                        (inf-rst (get-inf-enum-infos rst)) 
+                        (enumerator (if uniform? 
+                                        (build-product-comb-enum-uniform rst comb) 
+                                      (build-product-comb-enum rst comb))) ; order matters
+                        (magnitude (or (consp inf-rst) 
+;multiply finite sizes if no inf exists
+                                       (*-cars fin-rst))))
+                   (value (cons magnitude enumerator))))
+                     ;; ;; attempt macro expansion -- 12 July 2013 - no need to do this here like in trans-predicate
+                     ;; (er-let* ((newdefbody (macroexpand1 defbody ctx state)))
+                     ;;  (er-trans-datadef-as-enumerator newdefbody
+                     ;;                                  finite-defs 
+                     ;;                                  inf-enum-syms
+                     ;;                                  uniform?
+                     ;;                                  new-constructors 
+                     ;;                                  ctx wrld state))
+                   )))))))
+)
+
+
+#||
+(define-enumeration-type boolean '(t nil))
+(register-data-constructor (consp cons)
+                           ((allp car) (allp cdr))
+                           :proper t)
+;(defconst *foo-values* '(1 2 3))
+(er-trans-datadef-as-enumerator-lst
+ '((oneof (cons integer
+                foo)
+          integer))
+ nil
+ '(nth-foo acl2::nth-integer) ;;-- changed from foo
+ nil
+ 'top-level
+ (w state)
+ state)
+||#
+
+
+(defun cons-up-names-decls-lls-bodies (names decls lls bodies)
+  (declare (xargs :guard (and (true-listp names)
+                              (true-listp decls)
+                              (true-listp lls)
+                              (true-listp bodies))))
+  (if (endp names)
+    nil
+    (cons (if (consp decls);not null (only include declare if its not empty)
+            (list (car names) (car lls) (car decls) (car bodies))
+            (list (car names) (car lls) (car bodies)))
+          (cons-up-names-decls-lls-bodies (cdr names)
+                                    (cdr decls)
+                                    (cdr lls)
+                                    (cdr bodies)))))
+
+
+(defun collect-with-plausible-pred-fns (lst wrld)
+  (declare (xargs :guard (and (symbol-listp lst)
+                              (plist-worldp wrld))))
+  (if (endp lst)
+    nil
+    (if (plausible-predicate-functionp (get-predicate-symbol (car lst)) wrld)
+      (cons (car lst)
+            (collect-with-plausible-pred-fns (cdr lst) wrld))
+      (collect-with-plausible-pred-fns (cdr lst) wrld))))
+
+
+;;Record types
+;;1. make constructor, its predicate, and the destructors
+;;2. register the above using register-data-constructor
+#|
+(defdata tree (oneof nil
+                     (node (val . symbol) (left . tree) (right . tree))))
+
+==>
+(defdata tree (oneof nil
+                     (node symbol tree tree))) ;just like peters version
+X:tree = (node 'a (node 'b nil nil) nil)
+X:tree = (node (val . 'a) (left . (node (val . 'b) (left . nil) (right . nil))) (right . nil)) 
+
+(defdata cons (record (car . all) (cdr . all)))
+
+X:cons = (record (car . '("sd" 2 3)) (cdr . 'abc))
+X:cons = (cons '("sd 2 3) 'abc)
+
+(defdata triple (record (fst . all) (scd . all) (thd . all)))
+X:triple = (record (fst . 1) (scd . "hello") (thd . '(+ 23 45))) ;can be recog, cos destr are unique
+X:triple = (triple 1 "hello" '(+ 23 45))
+
+
+(defdata hyperlink (record (protocol . string)
+                           (address . string)
+                           (display . string)))
+X:hyperlink = (record (protocol . "httpx") (display . "my site") (address . "192.168.1.10"))
+==>
+X:hyperlink = (hyperlink "httpx" "my site" "192.168.1.10")
+|#
+
+
+(defun build-dex-recordImpl-bindings (dex-names dex-var-names rec-expr)
+  (declare (xargs :guard (and (symbol-listp dex-names)
+                              (symbol-listp dex-var-names)
+                              (= (len dex-var-names)
+                                 (len dex-names)))))
+  (if (endp dex-names)
+    nil
+    (let* ((dname (car dex-names))
+           (dname-var (car dex-var-names))
+           (d-keyword-name (intern (symbol-name dname) "KEYWORD")))
+      (cons (list dname-var (list 'mget d-keyword-name rec-expr))
+            (build-dex-recordImpl-bindings (cdr dex-names) (cdr dex-var-names) rec-expr)))))
+
+(defthm build-dex-recordImpl-bindings-sig1
+  (acl2::all->=-len (build-dex-recordImpl-bindings dex-names dex-var-names rec-expr)
+                    2))
+
+(defun build-dex-alist (dex-names dex-var-names)
+  (declare (xargs :guard (and (symbol-listp dex-names)
+                              (symbol-listp dex-var-names)
+                                 )))
+                  
+  (if (endp dex-names)
+    nil
+    (let* ((dname (car dex-names))
+           (dvar-name (car dex-var-names))
+           (d-keyword-name (intern (symbol-name dname) "KEYWORD")))
+      `(mset ,d-keyword-name ,dvar-name
+          ,(build-dex-alist (cdr dex-names) (cdr dex-var-names))))))
+
+;;make a constructor defun and corresponding predicate
+(defun make-constructor-predicate (conx-name dex-pairs)
+  (declare (xargs :guard (and (symbolp conx-name)
+                              (symbol-alistp dex-pairs))))
+                  ;:guard-hints (("Goal" :in-theory (disable modify-symbol string-append)))))
+  (let* ((dex-orig-names (strip-cars dex-pairs))
+         (prefix (string-append (symbol-name conx-name) "-"))
+         (dex-names (modify-symbol-lst prefix dex-orig-names "")) ;make new prefixed destr names
+         (dex-preds (strip-cdrs dex-pairs))
+         (dex-var-names (modify-symbol-lst "Var" dex-names ""))
+         (dex-prex-calls (build-one-param-calls dex-preds dex-var-names))
+         (dex-alist (build-dex-alist dex-orig-names dex-var-names))
+         (dex-bindings  (build-dex-recordImpl-bindings dex-orig-names dex-var-names 'v))
+        
+         (conx-pred (get-predicate-symbol conx-name)))
+    `((defund ,conx-pred (v) ;disabled def
+        (declare (xargs :guard t))
+        (if (not (acl2::good-map v));for guards and termination (CCG)
+          nil
+          (let ,dex-bindings 
+            (and  (equal v (mset 'constructor ',conx-name ,dex-alist))
+                  ,@dex-prex-calls 
+                  )))))))
+  
+
+;cons-up calls of above function
+(defun cons-up-conx-prex-ev (conx-names dex-pairs-lst)
+  (declare (xargs :guard (and (symbol-listp conx-names)
+                              (true-list-symbol-alistp dex-pairs-lst)
+                              (= (len conx-names) (len dex-pairs-lst)))))
+  (if (endp conx-names)
+    nil
+    (append (make-constructor-predicate (car conx-names) (car dex-pairs-lst))
+            (cons-up-conx-prex-ev (cdr conx-names) (cdr dex-pairs-lst)))))
+
+
+
+
+
+;guard verif thm
+(defthm symbol-alistp-strip-cars-is-symbol-listp
+  (implies (symbol-alistp P)
+           (symbol-listp (strip-cars P)))
+  :rule-classes :tau-system)
+           
+
+;make the event for defining constructor
+(defun make-constructor (conx-name dex-pairs)
+  (declare (xargs :guard (and (symbolp conx-name)
+                              (symbol-alistp dex-pairs))))
+  (let* ((dex-orig-names (strip-cars dex-pairs))
+         (prefix (string-append (symbol-name conx-name) "-"))
+         (dex-names (modify-symbol-lst prefix dex-orig-names "")) ;make new prefixed destr names
+         (dex-prex (strip-cdrs dex-pairs))
+         (dex-var-names (modify-symbol-lst "Var" dex-names ""))
+         (dex-prex-calls (build-one-param-calls dex-prex dex-var-names))
+         (dex-alist (build-dex-alist dex-orig-names dex-var-names)))
+    `((defun ,conx-name ,dex-var-names
+        (declare (xargs :guard (and . ,dex-prex-calls))) ;guards not working with new record impl
+                        ;:verify-guards nil))
+        (mset 'constructor ',conx-name ,dex-alist)))))
+
+;cons-up calls of above function
+(defun cons-up-conx-ev (conx-names dex-pairs-lst)
+  (declare (xargs :guard (and (symbol-listp conx-names)
+                              (true-list-symbol-alistp dex-pairs-lst)
+                              (= (len conx-names) (len dex-pairs-lst)))))
+  (if (endp conx-names)
+    nil
+    (append (make-constructor (car conx-names) (car dex-pairs-lst));append instead of cons
+          (cons-up-conx-ev (cdr conx-names) (cdr dex-pairs-lst)))));bcos (append (X) Y) = (cons X Y)
+
+(defun make-measure-fn (conx-name dex-pairs)
+  (declare (xargs :mode :program
+                  :guard (and (symbolp conx-name)
+                              (symbol-alistp dex-pairs))))
+  (let* ((dex-names (strip-cars dex-pairs))
+         (prefix (string-append (symbol-name conx-name) "-"))
+         (dex-names (modify-symbol-lst prefix dex-names "")) ;make new prefixed destr names
+         ;(dex-prex (strip-cdrs dex-pairs))
+         (conx-pred (get-predicate-symbol conx-name))
+         (msr-fn (modify-symbol "" conx-name "-COUNT")))
+    `((defun ,msr-fn (v)
+        (if (,conx-pred v)
+          (+ 1  . ,(list-up-lists
+                    (make-list (len dex-names) :initial-element msr-fn)
+                    (build-one-param-calls dex-names 
+                                           (make-list (len dex-names)
+                                                      :initial-element 'v))))
+          0)))))
+
+
+;cons up events that define destructor functions
+(defun cons-up-dex-defuns (conx-pred selector-fn-names dex-names)
+  (declare ;(ignore conx-pred)
+           (xargs :guard (and (symbol-listp selector-fn-names)
+                              (symbol-listp dex-names)
+                              (equal conx-pred conx-pred))))
+  (if (endp dex-names)
+    nil
+    (let* ((sel-fn-name (car selector-fn-names))
+           (dname (car dex-names))
+           (d-keyword-name (intern (symbol-name dname) "KEYWORD")))
+    (cons `(defun ,sel-fn-name (v)
+             (declare (xargs :guard (,conx-pred v))) ;not working with new record impl
+                             ;:verify-guards nil))
+             (mget ,d-keyword-name v))
+          (cons-up-dex-defuns conx-pred
+                              (cdr selector-fn-names)
+                              (cdr dex-names))))))
+                              
+;top level call for the previous function, basically generate code for destrs
+(defun make-destructors (conx-name dex-pairs)
+  (declare (xargs :guard (and (symbolp conx-name)
+                              (symbol-alistp dex-pairs))))
+  (let* ((dex-names (strip-cars dex-pairs))
+         (prefix (string-append (symbol-name conx-name) "-"))
+         (selector-fn-names (modify-symbol-lst prefix dex-names "")) ;make new prefixed destr names
+         (conx-pred (get-predicate-symbol conx-name)))
+    (cons-up-dex-defuns conx-pred selector-fn-names dex-names)))
+
+;do the above for more than one constructors defined during a datadef
+(defun append-up-dex-ev (conx-names dex-pairs-lst)
+  (declare (xargs :guard (and (symbol-listp conx-names)
+                              (true-list-symbol-alistp dex-pairs-lst)
+                              (= (len conx-names) (len dex-pairs-lst))
+                              )))
+  (if (endp conx-names)
+    nil
+    (append (make-destructors (car conx-names) (car dex-pairs-lst))
+            (append-up-dex-ev (cdr conx-names) (cdr dex-pairs-lst)))))
+
+
+(defun compute-reg-conx-dex (conx-name dex-pairs)   
+  (declare (xargs :guard (and (symbolp conx-name)
+                              (symbol-alistp dex-pairs))))
+  (let* ((conx-pred (get-predicate-symbol conx-name))
+         (dex-names (strip-cars dex-pairs))
+         ;(prefix (string-append (symbol-name conx-name) "-"))
+         ;(dex-names (modify-symbol-lst prefix dex-names nil));make new prefixed destr names
+         (dex-prex (strip-cdrs dex-pairs))
+         (dex-pairs (cons-up-lists dex-names dex-prex))
+        ;(msr-fn (modify-symbol nil conx-name "-COUNT"))
+        (conx-pair (cons conx-name conx-pred)))
+    `((register-record-constructor ,conx-pair 
+                                   ,dex-pairs
+                                   :hints (("Goal" :in-theory (enable ,conx-pred)))))))
+
+(defun cons-up-reg-conx-dex-ev (conx-names dex-pairs-lst)
+  (declare (xargs :guard (and (symbol-listp conx-names)
+                              (true-list-symbol-alistp dex-pairs-lst)
+                              (= (len conx-names) (len dex-pairs-lst)))))
+  (if (endp conx-names)
+    nil
+    (append (compute-reg-conx-dex (car conx-names) (car dex-pairs-lst))
+            (cons-up-reg-conx-dex-ev (cdr conx-names) (cdr dex-pairs-lst)))))
+
+
+;;Enumerated types should not occur in mutually rec defs
+#|
+Enum types:
+(defdata boolean (enum '(t nil))
+(defdata rgbcolors (enum '(red blue green)))
+(defdata suit (enum '(spades hearts diamonds clubs)))
+X:suit = spades
+X:rgbcolors = blue
+|#
+;;process enum form : compute enumeration events
+;;Return value-triple nil if not of form enum
+;;Returns a define-enumeration-type event form otherwise
+
+(defun process-enum-form (defs ctx wrld)
+  (declare (xargs :mode :program))
+; 08/28/12 refactoring using b*
+  (b* (((when (> (len defs) 1)) ;;mutually recursive
+        (let ((defbodies (strip-cadrs defs)))
+         (if (and (true-list-listp defbodies)
+                  (member-eq 'enum (strip-cars defbodies)))
+             (er hard? ctx 
+"Syntax error in use of enum: Enumerated type cannot appear ~
+                     in mutually recursive definitions.~%")
+           nil)))
+       (def (car defs)) ;;single def
+       (name (car def))
+       (enumbody (cadr def))
+       (enumlen (len enumbody))
+       ((unless (consp enumbody)) nil)
+       ((unless (eq 'enum (car enumbody))) nil)
+       ((unless (= enumlen 2))
+        (er hard? ctx 
+"Syntax error in enum: Enum ~x0 should be of following form: ~
+     (defdata <id> (enum <list-of-values>)) or ~
+     (defdata <id> (enum <val1> ...)) .~%" enumbody))
+       (values (cadr enumbody))
+       ((unless (true-listp values))
+        (er hard? ctx 
+"Syntax error in enum: ~x0 must evaluate to a list of values.~%" values)))
+   (append
+    (compute-define-enumeration-type-events name
+                                            (get-predicate-symbol name)
+                                            (get-values-symbol name)
+                                            (get-predicate-testthm-symbol name)
+                                            values wrld)
+    `((value-triple ',name)))))
+       
+
+;;check for empty defs
+(defun found-empty-defp (defs)
+  (declare (xargs :guard (true-listp defs)))
+  (if (endp defs)
+    nil
+    (let ((def (car defs)))
+      (if (< (len def) 2)
+        t
+        (if (and (= (len def) 2)
+                 (consp (cadr def))
+                 (and (= (len (cadr def)) 1)
+                      (or (eq (caadr def) 'oneof)
+                          (eq (caadr def) 'anyof)
+                          (eq (caadr def) 'listof)
+                          (eq (caadr def) 'record)
+                          (eq (caadr def) 'map)
+                          (eq (caadr def) 'set)
+                          (eq (caadr def) 'enum))))
+          t
+          (found-empty-defp (cdr defs)))))))
+
+(defun type-class-simple-p (x)
+  (mem-eq x '(:undefined 
+                  acl2::union acl2::product 
+                  acl2::singleton acl2::alias acl2::custom
+                  enum record map set listof)))
+(defthm type-class-simple-p-is-tau-pred
+  (booleanp (type-class-simple-p x))
+  :rule-classes :tau-system)
+
+(defun type-class-simple-lst-p (xs)
+  (if (atom xs)
+      (null xs)
+    (and (type-class-simple-p (car xs))
+         (type-class-simple-lst-p (cdr xs)))))
+
+(defun type-class-p (x)
+  (if (atom x)
+      (type-class-simple-p x)
+    (and (eq (car x) 'acl2::mutually-recursive)
+         (symbol-alistp (cdr x))
+         (type-class-simple-lst-p (strip-cdrs (cdr x))))))
+
+(defthm type-class-p-is-tau-pred
+  (booleanp (type-class-p x))
+  :rule-classes :tau-system)
+      
+(defun len-values-enum (values-enum wrld)
+  (declare (xargs :mode :program))
+  (if (and (symbolp values-enum)
+           (quotep (acl2-getprop values-enum 'const wrld)))
+      (len (cadr (acl2-getprop values-enum 'const wrld)))
+    nil))
+
+
+;;; Utility functions copied back from utilities.lisp
+
+(defun is-a-constant-symbolp (x)
+  (or (keywordp x);a keyword
+      (booleanp x);t or nil
+      (legal-constantp x)));ACL2::CONSTANT
+
+;Sig: Any -> Bool
+;check if x can be used as an identifier, i.e. has not been previously defined
+(defun is-a-identifier (x wrld)
+  (declare (xargs :mode :program))
+  (if (and (is-a-variablep x)
+           (acl2::new-namep x wrld))
+    x
+    nil))
+
+
+;--------------------------TYPE Metadata Table----------------------------------------------
+(defrec types-info%
+  (size enumerator predicate test-enumerator enum-uniform
+        recursivep derivedp
+        type-class defs) NIL)
+
+(defun types-info%-p (v)
+  (declare (xargs :guard T))
+  (case-match v
+    (
+     ('types-info% size enumerator predicate test-enumerator enum-uniform
+            recursivep derivedp
+            typeclass defs)
+     (declare (ignorable enumerator test-enumerator defs))
+     (and (or (natp size)
+              (eq 't size))
+          (symbolp predicate)
+          (symbolp enum-uniform)
+          (booleanp recursivep)
+          (booleanp derivedp)
+          (type-class-p typeclass)))))
+  
+(defun tau-predicate-p (pred world)
+  (declare (xargs :mode :program))
+  (b* ((td (acl2::tau-data-fn pred world))
+       ((unless (consp td)) nil)
+       (entry (assoc-eq 'acl2::recognizer-index (cdr td)))
+       ((unless (and (consp entry) (consp (cdr entry)))) nil))
+    (natp (cadr entry))))
+
+;;-- stores information about types introduced using defdata
+;;-- (key val)
+;;;--Modified Oct2-2009 added test enumerator
+;;-- (type-name (type-size type-enum . predicate))
+;;-- (rational (t nth-rational rationalp nth-rational-test)) 
+;;-- type-size is t for infinite type and a natural number if finite
+;;-- type-enum can be either NTH-type-name or *type-name-VALUES* 
+;;--Note: predicate still can be such that name restriction is not there,
+;;--for example we add atom in base.lisp. But for enum its strictly followed
+;;Modified Jun 26 2011 harshrc
+;;Use a records data structure for values in the table for easy
+;;extensibility
+;; Modified Aug 28 '12 to cutil record utility
+;; 7th April 2013 - predicate constrained to be a tau predicate
+;; 12 July 2013 - added uniform enumerator field
+(table types-info-table nil nil :guard
+       (and 
+        (types-info%-p val)
+        (b* ((TI.predicate (acl2::access types-info%  val :predicate))
+             (TI.size (acl2::access types-info%  val :size))
+             (TI.enumerator (acl2::access types-info%  val
+                                          :enumerator))
+             (TI.enum-uniform (acl2::access types-info%  val
+                                            :enum-uniform))
+             (TI.test-enumerator (acl2::access types-info%  val
+                                          :test-enumerator))
+             
+          
+             ;;(plausible-predicate-functionp TI.predicate world)
+             ;; April 5th 2013 - should be a tau predicate
+             ((unless (tau-predicate-p TI.predicate world))
+              (prog2$ 
+               (cw "~|~x0 is not a tau predicate. .
+~|Possible debugging leads:
+~| 1. (tau-data ~x0) is probably nil.
+~| 2. Is ~x0 a everywhere constant function?
+~| 3. Its not obvious that ~x0 is a predicate in which case, 
+~| submit the followingas a :tau-system rule:
+~|   (booleanp ~x0) ~|" TI.predicate)
+               nil))
+
+             ((unless (if (is-a-variablep TI.test-enumerator) 
+                          (or (allows-arity TI.test-enumerator 1 world)
+                              (quotep (acl2-getprop TI.test-enumerator 'const world)))
+                        t))
+              (prog2$
+               (cw "~|~x0 is not a valid test enumerator.~|" TI.test-enumerator)
+               nil))
+             ((unless (and (eq TI.enum-uniform (get-uniform-enumerator-symbol key))
+                           (allows-arity TI.enum-uniform 2 world)))
+              (prog2$ 
+               (cw "~|~x0 is not a valid uniform enumerator.~|" TI.enum-uniform)
+               nil))
+             ((unless (if (eq TI.size 't)
+                          (and (eq TI.enumerator (get-enumerator-symbol key))
+                               (allows-arity TI.enumerator 1 world))
+                        (or (and (eql 1 TI.size)
+                                 (possible-constant-valuep TI.enumerator));singleton
+                            (and (natp TI.size) ;added a empty type (although it shudnt be allowed in normal defdata)
+;(eq TI.enumerator (get-values-symbol key))
+                                 (eql TI.size (len-values-enum TI.enumerator world))))))
+              (prog2$ 
+               (cw "~|~x0 is not a valid enumerator.~|" TI.enumerator)
+               nil)))
+          t)))
+
+
+
+;TYPES
+;check if fn-name is a type-pred by checking for corresponding typ pres rule
+;; (defun has-type-prescription-rule (fn-name wrld)
+;;   (declare (xargs :guard (and (symbolp fn-name)
+;;                               (plist-worldp wrld))))
+;;   (acl2-getprop fn-name 'acl2::type-prescriptions wrld))
+                  
+
+;if true then returns the type name (not the predicate)
+;is true is Tp is a predicate and nth-T or *T-values* is defined in world
+;Sig: Sym * World -> Sym
+(defun is-custom-type-predicate (pred wrld)
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbolp pred)
+                              (plist-worldp wrld)
+                              )))
+(let* ((typ (get-typesymbol-from-pred-P-naming-convention pred))
+       (values (modify-symbol "*"  typ "-VALUES*"))
+       (enum   (modify-symbol "NTH-" typ "")))
+  (if (plausible-predicate-functionp pred wrld)
+    (if (or (allows-arity enum 1 wrld) ;is enum defined in wrld
+            (acl2-getprop values 'acl2::const wrld) 
+;;or is values defined in wrld
+            )
+      typ ;THIS CAN BE NIL, if pred doesnt follow naming convention, works out well in any case
+      nil)
+    nil)))
+
+;;is a predicate explicitly recognized in the defdata framework? 
+;;if true then returns the corresponding type
+;; BUG here, with every change of type table, you might have to change this function
+(defun is-datadef-type-predicate (fn-name typtable-alst)
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbolp fn-name)
+                              (symbol-alistp typtable-alst))))
+  (if (endp typtable-alst)
+    nil
+    (b* (((cons typ info%) (car typtable-alst)))
+      (if (eq fn-name (acl2::access types-info% info% :predicate)) ;TODO: here for multiple pred aliases
+          typ
+        (is-datadef-type-predicate fn-name (cdr typtable-alst))))))
+
+
+
+;is a possible type (ASK:should we also pick compound recognizers?)
+;is either custom type pred or datadef pred
+;if true then returns the type name (not the predicate)
+;Sig: Sym * World -> Sym
+(defun is-type-predicate-current (fn-name wrld)
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbolp fn-name)
+                              (plist-worldp wrld))))
+  (or (is-datadef-type-predicate fn-name (table-alist 'types-info-table wrld));is in types table
+      (is-custom-type-predicate fn-name wrld)));is a custom type in the current world
+
+(defun is-type-predicate-gv (fn w)
+  (ec-call (is-type-predicate-current fn w)))
+
+(defattach is-type-predicate is-type-predicate-gv)
+
+;Sig: Sym * State -> bool
+;purpose: Check wether id is an identifier, which has not been previously defined as a type
+(defun is-a-typeId-p (id wrld)
+  (declare (xargs :verify-guards nil
+                  :guard (plist-worldp wrld)))
+  (and (is-a-variablep id)
+       (let ((typ-alst (table-alist 'types-info-table wrld))
+             (pred (get-predicate-symbol id)))
+         (and (not (assoc-eq id typ-alst))
+              (not (is-custom-type-predicate pred wrld))))))
+
+;Sig: Sym * World -> Sym (typename)
+;type has been defined using register-custom-type
+(defun is-a-registered-custom-type (type wrld)
+  (declare (xargs :verify-guards nil))
+  (if (is-a-variablep type);shud be a variable symbol
+    (let* ((typ-alst (table-alist 'types-info-table wrld))
+          (typ-entry (assoc-eq type typ-alst))) 
+      (if (and (consp typ-entry)
+               (not (acl2::access types-info% (cdr typ-entry) :derivedp)))
+        type ;if not derived by defdata but in the type table return type
+        nil))
+    nil))
+
+;type has been defined using the defdata form
+(defun is-a-defdata-type (type wrld)
+  (declare (xargs :verify-guards nil))
+  (if (is-a-variablep type);shud be a variable symbol
+    (let* ((typ-alst (table-alist 'types-info-table wrld))
+          (typ-entry (assoc-eq type typ-alst))) 
+      (if (and (consp typ-entry)
+               (acl2::access types-info% (cdr typ-entry) :derivedp))
+        type ;if derived by defdata return type
+        nil))
+    nil))
+
+;purpose: Check wether argument has been previously defined as a type
+;using defdata or is clearly recognized by the defdata framework,
+;i.e. it could also be a custom type which has been added into the
+;types-info-table using register-custom-type.  could also have been
+;implemented in terms of is-datadef-type-predicate
+(defun is-registered (type wrld)
+  (declare (xargs :verify-guards nil))
+  (if (is-a-variablep type);shud be a variable symbol
+    (let* ((typ-alst (table-alist 'types-info-table wrld))
+          (typ-entry (assoc-eq type typ-alst))) 
+      (if (consp typ-entry)
+          type
+        nil))
+    nil))
+
+;Sig: Sym * World -> Sym (typename)
+;purpose: Check wether argument is a custom defined type and not a
+;defdata pred
+(defun is-a-custom-type-current (type wrld)
+  (declare (xargs :verify-guards nil))
+  (if (is-a-variablep type);shud be a variable symbol
+    (if (is-registered type wrld)
+      nil
+      (let ((pred (get-predicate-symbol type)))
+        (if (is-custom-type-predicate pred wrld) ;or is a custom type
+          type
+          nil)))
+    nil))
+
+(defun is-a-custom-type-gv (type wrld)
+  (ec-call (is-a-custom-type-current type wrld)))
+
+(defattach is-a-custom-type is-a-custom-type-gv)
+
+
+
+;is either a defdata defined type or a custom typename
+(defun is-a-typeName-current (type wrld)
+  (declare (xargs :verify-guards nil))
+  (or (is-registered type wrld)
+      (is-a-custom-type type wrld)))
+
+(defun is-a-typeName-gv (type wrld)
+  (ec-call (is-a-typeName-current type wrld)))
+
+(defattach is-a-typeName is-a-typeName-gv)
+
+;------------------------------------------------------------------------
+
+
+
+;User-controlled testing
+;;;Per type syntax:
+;;;(defdata-testing <type-name>
+;;;                 :test-enumerator <enum-fn>
+;;;                 :filter <filter-fn>
+;;;                 ...)                              
+;register the type by adding it into the types info table
+ (defmacro defdata-testing  (typename &key test-enumerator)
+   ":Doc-Section acl2::DATA-DEFINITIONS
+  Specify a custom testing enumerator for a type~/
+  ~c[(defdata-testing T1 :test-enumerator nth-T1-testing)]
+  adds a user-specified enumerator to be used for randomly
+  generating values for type ~c[T1]. This can be used
+  to restrict the testing domain of any type for the
+  purposes of random testing.
+  
+  ~bv[]
+  Examples:
+  (defdata-testing nat :test-enumerator nth-nat-small-values)
+  (defdata-testing list :test-enumerator nth-list-test-small-lists) ;to test small lists
+  (defdata-testing character :test-enumerator *special-chars-only*) ;to test special chars
+  (defdata-testing foo :test-enumerator 999) ;restrict domain of foo to a singleton value
+  ~ev[]                      
+  ~bv[]
+  Usage:
+  (defdata-testing <Type-name1> :test-enumerator <test-enum>)
+  ~ev[]~/
+  "
+  `(with-output
+       :stack :push
+       :off (warning warning! observation prove 
+                     proof-checker event expansion
+                     summary proof-tree)
+
+       (make-event
+        (er-let* ((type-info (table defdata::types-info-table ',typename)))
+          (if type-info
+              (value `(progn
+                        ,@(and ',test-enumerator
+                               (make-enum-uniform-defun-ev 
+                                (modify-symbol "" ',test-enumerator "-UNIFORM")
+                                ',test-enumerator))
+                        (table defdata::types-info-table 
+                               ',',typename 
+                               (acl2::change types-info% ',type-info
+                                             :test-enumerator
+                                             ',',test-enumerator))
+                        (value-triple (list ',',typename ',',test-enumerator))))
+               (er soft 'defdata-testing "~x0 is not a registered type. Use register-custom-type to register it.~%" ',typename))))))
+ 
+(defun make-enum-uniform-defun-ev (name enum)
+  (declare (xargs :guard (symbolp enum)))
+  `((defund ,name (m seed)
+     (declare (ignorable m))
+     (declare (type (unsigned-byte 31) seed))
+     (declare (xargs :verify-guards nil ;todo
+                     :guard (and (natp m)
+                                 (unsigned-byte-p 31 seed))))
+; 12 July 2013 - adding uniform random seed distribution to cgen enum
+; we will take advantage of the recent addition for an uniform
+; interface to both infinite and finite enum (defconsts)
+     (mv-let (n seed)
+             (random-natural-seed seed)
+             (mv (,enum n) (the (unsigned-byte 31) seed))))))
+     
+     
+     
+ ;register the type by adding it into the types-info-table
+ (defmacro register-custom-type  (typename typesize enum pred 
+                                           &key test-enum
+                                                enum-uniform
+                                                (type-class 'acl2::custom))
+   "Usage: (register-custom-type foo t nth-foo foop :test-enum my-nth-foo :type-class custom)
+    Purpose: add foo to type metadata table 'types-info-table'. 
+    Second argument is t if foo is infinite, and a positive number o.w., in which case the
+    standard naming convention for the third arg (enumerator) is *foo-values*.
+    keyword args are optional."
+  `(with-output
+    :stack :push
+    :off (warning warning! observation prove 
+                  proof-checker event expansion
+                  summary proof-tree)
+
+    (make-event
+     '(progn
+        (in-theory (disable ,(get-enumerator-symbol typename)))
+        ,@(and (not enum-uniform)
+               (make-enum-uniform-defun-ev 
+                (get-uniform-enumerator-symbol typename)
+                (get-enumerator-symbol typename)))
+        ,@(and test-enum
+             (make-enum-uniform-defun-ev
+              (get-uniform-enumerator-symbol test-enum) test-enum))
+        (table defdata::types-info-table ',typename 
+               ',(acl2::make types-info%
+                  :size typesize 
+                  :enumerator enum
+                  :predicate pred
+                  :test-enumerator test-enum
+                  :enum-uniform (if enum-uniform 
+                                    enum-uniform 
+                                  ;; shudnt be empty
+                                  (get-uniform-enumerator-symbol typename))
+                  :defs nil
+                  :derivedp nil
+                  :recursivep nil
+                  :type-class type-class))
+        (make-event 
+         (er-progn 
+          (trans-eval `(add-vertex$$ ',',typename R$ types-ht$)
+                      'register-custom-type state t)
+          (value '(value-triple :invisible)))
+         :check-expansion t)
+;        (add-datatype-node-batch ,typename)
+;        (sync-globals-for-dtg) ;sync globals with SCC and TC 
+        (value-triple (list ',typename 
+                            ',(list typesize enum pred test-enum 
+                                    nil nil type-class)))
+        ))))
+
+ #|
+ (defconst *foo1-values* '(1 2 3))
+ (defun foop (x)
+   (and (posp x)
+        (< x 4)))
+ (defconst *foo1-values-testing* '(1 2))
+ (include-book ;; fool dependency scanners
+   "graph")
+(register-custom-type foo1 3 *foo1-values* foop nil)
+(defdata-testing foo1 :test-enumerator *foo1-values-testing*)
+ |#
+
+
+
+;is a new constuctor Id
+(defun is-a-newconsId (id n wrld)
+  (declare (xargs :mode :program
+                  :guard (and (symbolp id)
+                              (natp n)
+                              (plist-worldp wrld))))
+  (let ((conx-pred (get-predicate-symbol id)))
+    (if (and (is-a-identifier id wrld) ;this makes the following check redundant
+             (not (allows-arity id n wrld));not a predefined function or macro
+             (not (allows-arity conx-pred 1 wrld)));the corresponding pred is also not predefined
+             
+      id
+      nil)))
+
+
+;is a already existing constructor
+(defun is-a-consId (id n wrld)
+  (declare (xargs :mode :program
+                  :guard (and (symbolp id)
+                              (natp n)
+                              (plist-worldp wrld))))
+  (if (and (is-a-variablep id)
+           (allows-arity id n wrld));is a predefined constructor function with correct arity
+    id
+    nil))
+
+
+(defrec supp-lemmas%
+  (set listof record oneof map)
+  NIL)
+
+(defun supp-lemmas%-p (v)
+  (declare (xargs :guard T))
+  (case-match v
+    (
+     ('supp-lemmas% set listof record oneof map)
+     (and (true-listp set)
+          (true-listp listof)
+          (true-listp record)
+          (true-listp oneof)
+          (true-listp map)))))
+
+
+(defconst *initial-supp-lemmas*
+  (acl2::make supp-lemmas%
+   :set '() 
+   :listof '() 
+   :record '()
+   :map '()
+   :oneof '()))
+
+
+
+;defdata temp storage
+(defstobj ds$
+  (defdata-world :type T :initially nil)
+  (newconstructors :type T :initially nil);list
+  (support-lemmas :type T;(satisfies supp-lemmas%-p)
+                  :initially nil);*initial-supp-lemmas*)
+;(struct (set . list) (listof . list) (record . list) (oneof . list))
+  (custom-types :type T :initially nil)
+  (defdata-debug :type (satisfies booleanp) :initially nil)
+  (type-class :type (satisfies type-class-p) :initially :undefined)
+  (record-constituents :type T :initially nil)
+  (product-constituents :type T :initially nil)
+  (union-constituents :type T :initially nil)
+  (is-recursive :type (satisfies booleanp) :initially nil)
+  )
+  
+;Ideally write a macro to generate these forms
+(defmacro add-record-constituent-types-to-ds$ (type)
+`(update-record-constituents (cons ,type (record-constituents ds$)) ds$))
+
+(defmacro add-product-constituent-types-to-ds$ (type)
+`(update-product-constituents (cons ,type (product-constituents ds$)) ds$))
+
+(defmacro add-union-constituent-types-to-ds$ (type)
+`(update-union-constituents (cons ,type (union-constituents ds$)) ds$))
+  
+(defmacro add-custom-types-to-ds$ (type)
+`(update-custom-types (cons ,type (custom-types ds$)) ds$))
+
+;add generated constructor information in a record to a temporary
+;global variable changed pred-body-lst to pred-lst since only
+;typenames are allowed not type expressions.
+;July 8 2010, this was checked with the datadef syntax document
+;June 26 2011, changed to ds$ transient/temp storage stobj for defdata
+(defun add-newconstructor-to-ds$ (newconsid dex pred-lst ds$)
+  (declare (xargs :mode :program 
+                  :stobjs (ds$)))
+  (let ((new-constructor-info 
+         (cons newconsid (list* (list ':generated ':proper)
+                                (get-predicate-symbol newconsid)
+                                (cons-up-lists dex pred-lst)
+                                'none)))
+        (newconstructors-alreadyseen-lst (newconstructors ds$)))
+    (update-newconstructors (cons new-constructor-info
+                                  newconstructors-alreadyseen-lst) ds$)))
+
+(defun update-type-class-top-level$ (tc nm ds$)
+  (declare (xargs :guard (and (type-class-p tc)
+                              (symbolp nm)
+                              (ds$p ds$))
+                  :verify-guards nil
+                  :stobjs (ds$)))
+  (declare (ignorable nm))
+  (let ((current-tc (type-class ds$)))
+    (cond ((eq current-tc :undefined)
+           (let ((ds$ (update-type-class tc ds$)))
+             ds$))
+          ((and (consp current-tc)
+                (eq (car current-tc) 'acl2::mutually-recursive))
+           (b* ((alst (cdr current-tc))
+                (entry (assoc-eq nm alst))
+                (ctx 'update-type-class-top-level$)
+                ((when (null entry)) (prog2$ (er hard ctx "~| ~x0 not found in ~x1~|" nm alst) ds$))
+                ((unless (and (consp entry)
+                              (eq (cdr entry) :undefined))) ds$)
+                (alst~ (put-assoc-eq nm tc alst))
+                (ds$ (update-type-class (cons 'acl2::mutually-recursive alst~) ds$)))
+             ds$))
+        (t ds$))))
+
+(program)
+
+
+;is dexpair a destructor type declaration
+(defun trans-dest-type-decl (conx-name dexpair tnames ctx ds$)
+  (declare (xargs :stobjs (ds$)))
+  (b* (((unless (consp dexpair))
+        (prog2$
+         (er hard ctx "~x0 destructor type decl should be a cons. ~%" dexpair)
+         (mv t nil ds$)))
+       (conx-prefix-str (string-append (symbol-name conx-name) "-"))
+       (id-name (modify-symbol conx-prefix-str (car dexpair) ""))
+       (id (is-a-identifier id-name (defdata-world ds$)))
+       (dte (cdr dexpair))
+      ((unless id)
+       (prog2$
+         (er hard ctx "~x0 is a bad choice for a field name in ~x1.~ 
+Choose something different~%" (car dexpair) dexpair)
+         (mv t nil ds$)))
+;strip away the destructor information for uniform product data treatment
+      ((when (is-registered dte (defdata-world ds$)))
+       (let ((ds$ (if (not (eq 'acl2::union (type-class ds$)))
+;check if we are not inside union
+                      (add-record-constituent-types-to-ds$ dte)
+                    ds$)))
+         (mv nil dte ds$)))
+      ((when (mem1 dte tnames))
+       (let ((ds$ (update-is-recursive 't ds$)))
+         (mv nil dte ds$)));recursive type reference
+      ((unless (is-a-custom-type dte (defdata-world ds$)))
+       (prog2$
+        (er hard ctx "~x0 should be a type name. ~%" dte)
+        (mv t nil ds$)))
+;Custom type (only remaining case)
+;add custom types used in defdata form to be validated later  
+      (ds$ (if (not (eq 'acl2::union (type-class ds$)))
+;check if we are not inside union
+               (add-record-constituent-types-to-ds$ dte)
+             ds$))
+;July 9 2011
+;TODO NOTE: I do add the constituents, but I generate the
+;disjoint theorems only when the original expression is a
+;purely product expression and I have an handle on its names!!
+;So this is fluff code for the moment, if we are inside a union
+      (ds$ (add-custom-types-to-ds$ dte)))
+    (mv nil dte ds$)))
+          
+  
+;check and construct(stripping away destructors) dex-pair list      
+ (defun trans-dest-typ-decl-lst (conx-name dex-pairs tnames ctx ds$)
+   (declare (xargs :stobjs (ds$)))
+   (if (symbol-alistp dex-pairs)
+     (if (endp dex-pairs)
+         (mv nil nil ds$)
+       (b* (((mv erp dest-decl ds$)
+             (trans-dest-type-decl conx-name (car dex-pairs) tnames ctx ds$))
+            ((when erp)
+             (prog2$ 
+              (er hard ctx "Bad ~x0~%" (car dex-pairs))
+              (mv t nil ds$)))
+            ((mv & dest-decl-lst ds$) 
+             (trans-dest-typ-decl-lst conx-name (cdr dex-pairs) tnames ctx ds$))
+            )
+         (mv nil (cons dest-decl dest-decl-lst) ds$)))
+      (prog2$ 
+       (er hard ctx 
+           "Destructor type decl list ~x0 should be a symbol-alist. ~%"
+           dex-pairs)
+       (mv t nil ds$))))
+       
+       
+(mutual-recursion
+;; checks wether texp is a constituent type: 
+;; Either typeName | SingletonType | Union-or-Prod-type
+;; if it isnt then give syntax error. 
+;; The reason why its a soft syntax error? (not the case anymore)
+;;  rather than a nil is
+;; that all calls to this function occur from inside 
+;; either a union or prod function which occurs last
+;; in the series of syntax check and so if its not a 
+;; union or prod then its not legal syntax.
+ (defun trans-constituent-type (texp typid tnames ctx ds$)
+   (declare (xargs :stobjs (ds$)))
+   (b* (((when (is-singleton-type-p texp))
+         (mv nil texp ds$))
+        ((when (is-registered texp (defdata-world ds$)))
+          (let ((ds$ 
+                 (case (type-class ds$)
+                   ('acl2::product (add-product-constituent-types-to-ds$ texp))
+                   ('record (add-record-constituent-types-to-ds$ texp))
+;might be buggy, right now im not supporting union constituents
+                   (otherwise (add-union-constituent-types-to-ds$ texp)))))
+            (mv nil texp ds$)))
+        ((when (is-a-custom-type texp (defdata-world ds$)))
+         (let* ((ds$ (add-custom-types-to-ds$ texp))
+                (ds$ 
+                 (case (type-class ds$)
+                   ('acl2::product (add-product-constituent-types-to-ds$ texp))
+                   ('record (add-record-constituent-types-to-ds$ texp))
+;might be buggy, right now im not supporting union constituents
+                  (otherwise (add-union-constituent-types-to-ds$ texp)))))
+           (mv nil texp ds$)))
+        ((when (mem1 texp tnames)) 
+         (let ((ds$ (update-is-recursive 't ds$)))
+           (mv nil texp ds$)));is a recursive type reference
+        ((unless (consp texp))
+         (prog2$
+          (er hard ctx "~x0 is an illegal Constituent type expression,
+expecting either previously ~ 
+defined typeName, Singleton or Union/Product type here~%" texp )
+          (mv t nil ds$)))
+        ((mv erp texp1 ds$)
+         (trans-prod-or-union-type texp typid tnames ctx ds$))
+        ((unless (and (not erp) texp1))
+         (prog2$ 
+          (er hard ctx "~x0 is an illegal Constituent type expression, expecting either ~ 
+previously defined typeName, Singleton or Union/Product type here~%" texp )
+          (mv t nil ds$))))
+       (mv nil texp1 ds$)))
+       
+ ;check and construct the constituent type list
+ (defun trans-constituent-type-lst (texp-lst typid tnames ctx ds$)
+   (declare (xargs :stobjs (ds$)))
+   (if (endp texp-lst)
+         (mv nil nil ds$)
+       (b* (((mv erp1 ctype1 ds$)
+;ignore errors since they will already be caught. Hard errors!! save typing
+             (trans-constituent-type (car texp-lst) typid tnames ctx ds$))
+            ((mv erp2 ctype-lst1 ds$)
+             (trans-constituent-type-lst (cdr texp-lst) typid tnames ctx ds$))) 
+         (mv (or erp1 erp2) (cons ctype1 ctype-lst1) ds$))))
+    
+
+;;; if texp is a union expression then check and preprocess 
+;;; the argument constituent type expressions 
+;;; otherwise give nil, dont give any errors, cos we still 
+;;; have product expression in the sequential check left
+ (defun trans-union-type-exp (texp typid tnames ctx ds$)
+   (declare (xargs :guard (consp texp)
+                   :stobjs (ds$)))
+   (b* (((unless (and (consp texp)
+                      (or (eq (car texp) 'oneof) 
+                          (eq (car texp) 'anyof))))
+         (mv nil nil ds$))
+;it is a union expression
+        ((unless (> (len (cdr texp)) 1))
+         (prog2$
+          (er hard ctx "Union type expression ~x0 should have at least 2 constituent types~%" texp)
+          (mv t nil ds$)))
+        (ds$ (update-type-class-top-level$ 'acl2::union typid ds$))
+            
+        ((mv erp texp-lst1 ds$)
+         (trans-constituent-type-lst (cdr texp) typid tnames ctx ds$)))
+     (mv erp (cons (car texp) texp-lst1) ds$))) ;reconstruct
+ 
+ 
+ (defun trans-product-type-exp (texp typid tnames ctx ds$)
+   (declare (xargs :guard (consp texp)
+                   :stobjs (ds$)))
+   (b* (((when (and (consp texp)
+                    (or (eq (car texp) 'oneof) 
+                        (eq (car texp) 'anyof))))
+;is an union, so return nil (indicating not a product)
+         (mv nil nil ds$))
+        (consid (is-a-consId (car texp) (len (cdr texp)) 
+                             (defdata-world ds$)))
+        ((when consid)
+         (mv-let (erp ctype-lst1 ds$)
+                 (let ((ds$ (update-type-class-top-level$ 'acl2::product typid ds$)))
+;only updates if top-level-call from translate-defbody
+                                
+                   (trans-constituent-type-lst (cdr texp) typid tnames ctx ds$))
+                 (mv erp (cons consid ctype-lst1) ds$))) ;reconstruct
+
+
+        (newconsid (is-a-newconsId (car texp) (len (cdr texp)) 
+                                   (defdata-world ds$)))
+        ((unless newconsid)
+         (prog2$
+            (er hard ctx "~|~x0 is an illegal Constructor id~|" (car texp))
+            (mv t nil ds$)))
+        (dest-decl-lst (cdr texp)) 
+        (dex (strip-cars dest-decl-lst))
+        (dex-types (strip-cdrs dest-decl-lst))
+        (pred-lst (get-predicate-symbol-lst dex-types))
+;only update if top-level call
+        (ds$ (update-type-class-top-level$ 'record typid ds$))
+            
+        ((mv erp ct-lst1 ds$)
+;get stripped constituent types
+         (trans-dest-typ-decl-lst newconsid dest-decl-lst tnames ctx ds$))
+        ((unless (not erp))
+          (prog2$
+            (er hard ctx "Malformed destructor declarations~%")
+            (mv t nil ds$)))
+        (ds$ (add-newconstructor-to-ds$ newconsid dex pred-lst ds$)))
+     
+     (mv nil (cons newconsid ct-lst1) ds$)))
+         
+ (defun trans-prod-or-union-type (texp typid tnames ctx ds$)
+;returns (mv erp trans-texp ds$)
+    (declare (xargs :guard (consp texp)
+                    :stobjs (ds$)))
+   (b* (((mv erp un-texp ds$)
+         (trans-union-type-exp texp typid tnames ctx ds$)))
+     (if (and (not erp)
+              un-texp)
+         (mv nil un-texp ds$)
+;SOLVED BUG: order is important
+       (trans-product-type-exp texp typid tnames ctx ds$)))) 
+ 
+)
+
+;;check well-foundedness (dead code now 04/07/2013)
+(mutual-recursion
+ (defun WF-constituent-type (texp tnames rpath ctx)
+   (cond ((is-singleton-type-p texp) 't);singleton type exp is well-founded
+         ((symbolp texp) 't);previosly defined types are well-founded
+         ((mem1 texp tnames) 
+          (if (mem1 'P rpath)
+            'nil;is a recursive type reference, i.e. not well-founded
+            ;but if this reference occurs inside a union type expression, that is illegal, raise error!
+            (er hard? ctx "Not Well-formed: Recursive reference ~x0 should occur within a outer Product type expression~%" texp)))
+         (t (WF-prod-or-union-type texp tnames rpath ctx ))))
+              
+ 
+ (defun WF-product-constituent-type-lst (texp-lst tnames rpath ctx )
+   (if (endp texp-lst)
+       't
+       (and (WF-constituent-type (car texp-lst) tnames rpath ctx )
+            (WF-product-constituent-type-lst (cdr texp-lst) tnames rpath ctx ))))
+ 
+ (defun WF-union-constituent-type-lst (texp-lst tnames rpath ctx )
+   (if (endp texp-lst)
+       'nil
+       (or (WF-constituent-type (car texp-lst) tnames rpath ctx )
+           (WF-product-constituent-type-lst (cdr texp-lst) tnames rpath ctx )))) 
+         
+(defun WF-dest-type-decl (dexpair tnames rpath ctx )
+   (WF-constituent-type (cdr dexpair) tnames rpath ctx ))
+   
+  
+ (defun WF-dest-typ-decl-lst (dex-pairs tnames rpath ctx )
+   (if (endp dex-pairs)
+     't
+     (and (WF-dest-type-decl (car dex-pairs) tnames rpath ctx )
+          (WF-dest-typ-decl-lst (cdr dex-pairs) tnames rpath ctx ))))
+ 
+(defun WF-union-type-exp (texp tnames rpath ctx )
+   (if (or (eq (car texp) 'oneof) (eq (car texp) 'anyof))
+     (WF-union-constituent-type-lst (cdr texp) tnames (cons 'U rpath) ctx )
+     nil))
+ 
+ 
+ (defun WF-product-type-exp (texp tnames rpath ctx )
+   (if (symbolp (car texp));cons-id
+       (WF-product-constituent-type-lst (cdr texp) tnames (cons 'P rpath) ctx )
+       (WF-dest-typ-decl-lst (cdr texp) tnames (cons 'P rpath) ctx )))
+          
+ 
+ (defun WF-prod-or-union-type (texp tnames rpath ctx )
+   (or (WF-union-type-exp texp tnames rpath ctx )
+       (WF-product-type-exp texp tnames rpath ctx )))
+ 
+)
+
+;preprocessing
+;(enum <expr-evals-to-a-list-of-constants>)
+(defun is-enum-type (texp ctx w)
+;returns trans-enum, where trans-enum is nil if texp is 
+;not an enum type expression
+  (declare (xargs :guard (plist-worldp w)))
+  (b* (((unless (and (consp texp)
+                     (eq (car texp) 'enum)))
+        nil)
+;Is an enum
+       ((unless (and (= 2 (len texp))
+                     (possible-constant-value-expressionp (cadr texp))))
+        (er hard ctx "Enum should be of form (enum <list-expr>) where ~
+list-expr is a constant value expression evaluating to a list of objects.~%"))
+       ((mv erp list-val) 
+        (trans-my-ev-w (cadr texp) ctx w nil))
+       ((when erp)
+        (er hard ctx "Evaluating list expression ~x0 failed!~%" (cadr texp)))
+       ((unless (true-listp list-val))
+        (er hard ctx "Enum ~x0 expected a (true-) list expression.~%" texp)))
+    (list 'enum list-val)))
+
+#|
+(defmacro define-map-list-lambda-fn (nm lambda-fn &key guard)
+ `(make-event
+   (defun ,nm
+     ,@(if guard 
+          '((declare (xargs :guard guard)))
+         nil)
+     (if (endp lst)
+         nil
+       (cons 
+|#
+   
+(defun map-get-field-name (dnames)
+  (declare (xargs :guard (symbol-listp dnames)))
+  (if (endp dnames)
+      nil
+    (cons (intern (symbol-name (car dnames)) "KEYWORD")
+          (map-get-field-name (cdr dnames)))))
+
+
+
+(defun get-typesymbol-from-pred (sym wrld)
+  (b* ((typ (get-typesymbol-from-pred-P-naming-convention sym))
+       (types-info-table (table-alist 'types-info-table wrld))
+       (entry (assoc-eq typ types-info-table))
+       (naming-consistent? (and (consp entry)
+                                (eq sym (acl2::access types-info% (cdr entry) :predicate))))
+       ((when naming-consistent?) typ)
+       (ans (is-datadef-type-predicate sym types-info-table)))
+    (if ans
+        ans
+      (er hard 'get-typesymbol-from-pred "~x0 doesnt follow our convention of predicates ending with 'p'.~%" sym))))
+    
+
+(defun len-<-0-syms (syms)
+  (declare (xargs :guard (symbol-listp syms)))
+                  ;:VERIFY-GUARDS NIL))
+  (if (endp syms)
+    't
+    (and (if (symbolp (car syms)) 't 'nil)
+         (< 0 (length (symbol-name (car syms))))
+         (len-<-0-syms (cdr syms)))))
+
+(defun get-typesymbol-from-pred-lst (syms wrld)
+  (declare (xargs :guard (and (symbol-listp syms)
+                              (len-<-0-syms syms))))
+                         
+  (if (endp syms)
+    nil
+    (let ((type (get-typesymbol-from-pred (car syms) wrld)))
+      (if type ;it might be NIL (Ideally it shud be an ERROR??)
+        (cons type
+              (get-typesymbol-from-pred-lst (cdr syms) wrld))
+        (get-typesymbol-from-pred-lst (cdr syms) wrld)))))
+
+;TODO: wherever you use get-predicate-symbol, you should check for
+;the non-syntactic restricted version from names-info-table
+
+(defun runes-to-be-disabled1 (names wrld ans)
+  (if (endp names)
+      ans
+  (b* ((name (car names)))
+               
+    (if (acl2::rule-name-designatorp name nil wrld);filter runes
+        (runes-to-be-disabled1 (cdr names) wrld (cons name ans))
+      (runes-to-be-disabled1 (cdr names) wrld ans)))))
+
+(defun runes-to-be-disabled (names wrld)
+  (remove-duplicates (runes-to-be-disabled1 names wrld '())))
+
+(defun make-generic-record-implies-consp/good-map-ev (conx-name dex-pairs wrld)
+  (declare (xargs :guard (and (symbolp conx-name)
+                              (symbol-alistp dex-pairs))))
+  (b* ((dex-orig-names (strip-cars dex-pairs))
+       (prefix (string-append (symbol-name conx-name) "-"))
+       (dex-names (modify-symbol-lst prefix dex-orig-names "")) ;make new prefixed destr names
+       (dex-preds (strip-cdrs dex-pairs))
+       (dex-var-names (modify-symbol-lst "VAR" dex-names ""))
+       (dex-bindings  (build-dex-recordImpl-bindings dex-orig-names dex-var-names 'v))
+       (conx-pred (get-predicate-symbol conx-name))
+       (disabled (runes-to-be-disabled dex-preds wrld)))
+       
+    `((encapsulate
+      ()
+      (local
+       (progn
+         (value-triple 
+          (prog2$ 
+           (time-tracker :defdata-generic-record-lemmas :start)
+           :invisible))
+         (in-theory (enable ,conx-pred))
+         (defthm ,(modify-symbol "" conx-name "-IMPLIES1-LEMMA")
+           (implies (,conx-pred v)
+                    (equal (EQUAL v ,(cons conx-name (strip-cadrs dex-bindings)));(mget :key x) (mget :LEVEL x) (mget :LEFT x)  (mget :RIGHT x)))
+                           t))
+           :hints (("Goal" :in-theory (disable . ,disabled)))
+           :rule-classes (:forward-chaining))
+         
+         (defthm ,(modify-symbol "" conx-name "-IMPLIES2-LEMMA")
+           (implies (EQUAL x ,(cons conx-name dex-names));AA-KEY  AA-LEVEL AA-LEFT AA-RIGHT))
+                    (mget 'DEFDATA::CONSTRUCTOR x)))
+         
+         (defthm ,(modify-symbol "" conx-name "-IS-CONSP-LEMMA");node-is-consp-lemma
+           (implies (,conx-pred x)
+                    (mget 'DEFDATA::CONSTRUCTOR x))
+           :hints (("goal" :in-theory (e/d () (,@disabled))))
+           :rule-classes (:forward-chaining))
+
+         (in-theory (disable ,conx-pred))))
+
+      (value-triple 
+          (prog2$ 
+           (time-tracker :defdata-generic-record-lemmas :print?)
+           :invisible))
+
+      (defthm ,(modify-symbol "" conx-name "-UNIQUE-TAG")
+        (implies (,conx-pred x)
+                 (equal (mget 'defdata::constructor x) ',conx-name))
+        :hints (("goal" :expand ((,conx-pred x))
+                        :in-theory (e/d () (,@disabled))))
+        :rule-classes ((:rewrite :backchain-limit-lst 1)
+                       :forward-chaining :type-prescription))
+
+      (defthm ,(modify-symbol "" conx-name "-IMPLIES-CONSP")
+        (implies (,conx-pred x)
+                 (consp x))
+        :rule-classes ((:rewrite :backchain-limit-lst 1)
+                       :forward-chaining :compound-recognizer))
+
+      (defthm ,(modify-symbol "" conx-name "-IMPLIES-GOOD-MAP")
+        (implies (,conx-pred x)
+                 (acl2::good-map x))
+        :hints (("goal" :in-theory (e/d (,conx-pred))))
+        :rule-classes ((:rewrite :backchain-limit-lst 1) 
+                       (:forward-chaining)))
+      
+      (defthm ,(modify-symbol "" conx-name "-EXCLUDES-ATOM-LIST")
+        (implies (,conx-pred x)
+                 (not (atom-listp x)))
+        :hints (("goal" :in-theory (e/d (,conx-pred) (,@disabled))))
+        :rule-classes (:tau-system))
+
+      (value-triple 
+       (progn$ 
+       (time-tracker :defdata-generic-record-lemmas :print?)
+       (time-tracker :defdata-generic-record-lemmas :stop)
+       :invisible))
+      ;; (defthm ,(modify-symbol "" conx-name "-IMPLIES-PROPER-CONS/ALIST")
+      ;;   (implies (,conx-pred x)
+      ;;            (and (proper-consp x)
+      ;;                 (alistp x)))
+      ;;   :hints (("goal" :in-theory (e/d (,conx-pred))))
+      ;;   :rule-classes (:tau-system))
+
+      ))))
+
+;cons-up calls of above function
+(defun cons-up-record-implies-consp/good-map-ev (conx-names dex-pairs-lst wrld)
+  (declare (xargs :guard (and (symbol-listp conx-names)
+                              (true-list-symbol-alistp dex-pairs-lst)
+                              (= (len conx-names) (len dex-pairs-lst)))))
+  (if (endp conx-names)
+    nil
+    (append (make-generic-record-implies-consp/good-map-ev (car conx-names) (car dex-pairs-lst) wrld)
+            (cons-up-record-implies-consp/good-map-ev (cdr conx-names) (cdr dex-pairs-lst) wrld))))
+
+(defun record-selector-lemmas (nms tpred fnames dprex disabled)
+  (if (endp fnames)
+      (list '(value-triple 
+              (prog2$ 
+               (time-tracker :defdata-record-lemmas :print?)
+               :invisible)))
+              
+    (cons
+     `(defthm ,(car nms)
+          (implies (,tpred x)
+                   (,(car dprex) (mget ,(car fnames) x)))
+          :hints (("Goal" :in-theory (e/d (,tpred) (,@disabled))))
+          :rule-classes (:rewrite 
+                         (:forward-chaining
+                          :trigger-terms ((mget ,(car fnames) x)))))
+     (record-selector-lemmas (cdr nms) tpred (cdr fnames) (cdr dprex) disabled))))
+
+(defun record-modifier-lemmas (nms tpred fnames dprex disabled)
+  (if (endp fnames)
+      (list '(value-triple 
+              (prog2$ 
+               (time-tracker :defdata-record-lemmas :print?)
+               :invisible)))
+    (cons 
+     `(defthm ,(car nms)
+        (implies (and (,tpred x)
+                      (,(car dprex) v))
+                 (,tpred (mset ,(car fnames) v x)))
+        :hints (("Goal" :in-theory (e/d (,tpred) (,@disabled))))
+        :rule-classes (:rewrite 
+                       (:forward-chaining
+                        :trigger-terms ((mset ,(car fnames) v x)))))
+     (record-modifier-lemmas (cdr nms) tpred (cdr fnames) (cdr dprex) disabled))))
+
+
+
+(defun is-subtype (T1 T2 R$ types-ht$)
+  "conservative subtype check, return false if T1 or T2 are not present in graph"
+  (declare (xargs :guard (and (R$p R$)
+                              (types-ht$p types-ht$))
+                  :stobjs (R$ types-ht$)))
+    (cond ((eq T2 'acl2::all) t)
+        ((eq T1 'acl2::empty) t)
+;ASSUMPTION: Types equivalent to all and empty should be recognized
+;separately. In this function, we simply return nil, so we can have false
+;positives.
+        ((eq T2 'acl2::empty) nil)
+        ((eq T1 'acl2::all) nil)
+        (t 
+         (if (and (vertex-ht-valid-p T1 (rgraph-length R$) types-ht$)
+                  (vertex-ht-valid-p T2 (rgraph-length R$) types-ht$))
+             (is-subtype$$ T1 T2 R$ types-ht$)
+           nil))))
+
+
+(defun is-alias (T1 T2 R$ types-ht$)
+  (declare (xargs :guard (and (R$p R$)
+                              (types-ht$p types-ht$))
+                  :stobjs (R$ types-ht$)))
+  (and (is-subtype T1 T2 R$ types-ht$)
+       (is-subtype T2 T1 R$ types-ht$)))
+
+
+; 13 July 2013 -- equiv enum and oneof defs of Lett dont work
+; equivalently for disjoint lemmas:
+#||
+(defdata Lett (enum '(a b c d)) :type-lemmas t)
+(defdata Lett1 (oneof 'a 'b 'c 'd) :type-lemmas t)
+(LETTP (RECOGNIZER-INDEX 330)
+       (POS-IMPLICANTS (AND (LETTP V) (NOT (RECP V))))
+       (NEG-IMPLICANTS (NOT (LETTP V)))
+       (SIGNATURES (BOOLEANP (LETTP V)))
+       (BIG-SWITCH? :NO)
+       (MV-NTH-SYNONYM? :NO))
+||#
+; both have same tau-data, but defdata rec works in second def but not
+; not first. the disjoint lemma fails.
+; Q: How does tau-system discharge the obligation in one case and
+; not the other?
+(defun record-disjoint-constituent-lemmas (nms tpred dex-types R$ types-ht$)
+  (declare (xargs :stobjs (R$ types-ht$)))
+  (if (endp nms)
+      (list '(value-triple 
+              (prog2$ 
+               (time-tracker :defdata-record-lemmas :print?)
+               :invisible)))
+    (append 
+     (b* ((dex-type (car dex-types))
+          (dpred (get-predicate-symbol dex-type))
+; bugfix defdata-record-all-field-bug
+          ((when (or (is-alias dex-type 'acl2::all R$ types-ht$)
+                     (is-alias dex-type 'acl2::cons R$ types-ht$) 
+                     (is-alias dex-type 'acl2::list R$ types-ht$)
+                     (is-alias dex-type 'acl2::alist R$ types-ht$)
+                     (is-alias dex-type 'acl2::acons R$ types-ht$) 
+                     (is-alias dex-type 'acl2::true-list R$ types-ht$)
+                     ;; TODO
+                     ;; 16 July 2013 - due to example from mitesh
+                     ;; the disjoint lemma generation is nowhere near
+                     ;; complete
+                     (is-subtype dex-type 'acl2::true-list R$ types-ht$)))
+
+           '()))
+       `((defthm ,(car nms)
+          (implies (,tpred x)
+                   (not (,dpred x)))
+
+          :hints (("Goal" :in-theory (e/d (,dpred) (,tpred ))))))) 
+     (record-disjoint-constituent-lemmas (cdr nms) tpred (cdr dex-types) R$ types-ht$))))
+
+(defun record-constructor-lemma (nm cname tpred dprex vnames disabled)
+  `(defthm ,nm ;TODO: of no use if cname is not disabled!
+     (implies (and ,@(build-one-param-calls dprex vnames))
+              (,tpred (,cname . ,vnames)))
+     :hints (("Goal" :in-theory (e/d (,tpred ,cname) (,@disabled))))))
+       
+
+;find recursive records
+(defun find-recursive-record (pred new-constructors)
+  (declare (xargs :mode :program
+                  :guard (and (symbolp pred)
+                              (symbol-alistp new-constructors))))
+  (if (endp new-constructors)
+    nil
+    (let* ((conx-info (car new-constructors))
+           (dex-pairs (dex-pairs-entry conx-info)))
+    (if (member-eq pred (flatten (strip-cdrs dex-pairs) '()));TODO.BUG: simple trick, but may give false positives
+      (cons conx-info (find-recursive-record pred (cdr new-constructors)))
+      (find-recursive-record pred (cdr new-constructors))))))
+;TODO::Check if a mutually recursive record is possible and test it.
+(defun find-recursive-records (preds new-constructors)
+  (declare (xargs :mode :program
+                  :guard (and (symbol-listp preds)
+                              (symbol-alistp new-constructors))))
+  (if (endp preds)
+    nil
+    (let ((rrecs  (find-recursive-record (car preds) new-constructors)))
+      (if rrecs
+        (union-equal rrecs
+                     (find-recursive-records (cdr preds) new-constructors))
+        (find-recursive-records (cdr preds) new-constructors)))))
+              
+
+(defun add-record-type-support-lemmas-to-ds$ (typid dnames dex-types ds$ R$ types-ht$)
+  (declare (xargs :stobjs (ds$ R$ types-ht$)))
+  (b* ((tpred (get-predicate-symbol typid))
+       (dprex (get-predicate-symbol-lst dex-types))
+       (s-lemm (support-lemmas ds$))
+       (fnames (map-get-field-name dnames))
+       (snms (modify-symbol-lst (string-append (symbol-name tpred) "-")
+                                     dnames "-SELECTOR-LEMMA"))
+       (mnms (modify-symbol-lst (string-append (symbol-name tpred) "-")
+                                     dnames "-MODIFIER-LEMMA"))
+       (wrld (defdata-world ds$))
+       (disabled (runes-to-be-disabled dprex wrld))
+       (selector-lemmas (record-selector-lemmas snms tpred fnames dprex disabled))
+       
+       (modifier-lemmas (record-modifier-lemmas mnms tpred fnames dprex disabled))
+       (vs (modify-symbol-lst "VAR-" dnames ""))
+       (cnm (modify-symbol "" tpred "-CONSTRUCTOR-LEMMA"))
+       (constructor-lemma (record-constructor-lemma cnm typid tpred dprex vs disabled))
+       (dnms (modify-symbol-lst (string-append (symbol-name tpred) "-")
+                                dprex "-DISJOINT-LEMMA"))
+       (disjoint-lemmas 
+        (record-disjoint-constituent-lemmas dnms tpred dex-types R$ types-ht$))
+                         
+       (record-lemmas (append disjoint-lemmas
+                              (cons constructor-lemma
+                                    (append selector-lemmas modifier-lemmas)))))
+    
+    (update-support-lemmas
+     (acl2::change supp-lemmas%
+      s-lemm
+      :record
+      (append record-lemmas (acl2::access supp-lemmas% s-lemm :record)))
+     ds$)))
+      
+(defun is-record-type (texp typId ctx ds$ R$ types-ht$)
+;returns (mv trans-record-def ds$) where trans-record-def is nil if texp is
+;not a record
+  (declare (xargs :stobjs (ds$ R$ types-ht$)))
+  (b* (((unless (and (consp texp)
+                    (eq (car texp) 'record)))
+        (mv nil ds$))
+       ((unless (>= (len (cdr texp)) 1))
+        (prog2$
+         (er hard ctx "~|Record ~x0 should have atleast 1 constituent.~%" texp )
+         (mv nil ds$)))
+;definitely a record (and right now anonymous records cant be nested)
+       (ds$ (update-type-class-top-level$ 'record typId ds$))
+       (dest-decl-lst (cdr texp))
+       (dnames (strip-cars dest-decl-lst))
+       (dex-types (strip-cdrs dest-decl-lst))
+       (dprex (get-predicate-symbol-lst dex-types))
+       ((mv erp dest-decl-lst1 ds$)
+        (trans-dest-typ-decl-lst typId dest-decl-lst nil ctx ds$))
+       ((when erp)
+        (prog2$
+         (er hard ctx 
+             "~|Record ~x0 has malformed destructor declarations.~%"
+             texp)
+         (mv nil ds$)))
+       (ds$ (add-newconstructor-to-ds$ typId dnames dprex ds$))
+       (ds$ (add-record-type-support-lemmas-to-ds$ typId dnames dex-types ds$ R$ types-ht$))
+       )
+;just use the product-datadef function, so record is just syntactic
+;sugar. TODO: But you dont generate record lemmas for this desugared
+;version.
+    (mv (cons typId dest-decl-lst1) ds$)))
+        
+
+
+(defun add-map-type-support-lemmas-to-ds$ (typid t1 t2 ds$)
+  (declare (xargs :stobjs (ds$)))
+  (b* ((tpred (get-predicate-symbol typid))
+       (t1p (get-predicate-symbol t1))
+       (t2p (get-predicate-symbol t2))
+       (s-lemm (support-lemmas ds$))
+       (s-nm (modify-symbol "" tpred "-SELECTOR-LEMMA"))
+       (m-nm (modify-symbol "" tpred "-MODIFIER-LEMMA"))
+       (d-nm1 (modify-symbol "DISJOINT-" tpred 
+                             (string-append "-" (symbol-name t1p))))
+       (d-nm2 (modify-symbol "DISJOINT-" tpred 
+                             (string-append "-" (symbol-name t2p))))
+
+       (elim-rule-name (modify-symbol "" typid "-MAP-ELIM-RULE"))
+       (nume (list :elim elim-rule-name))
+       (elim-term `(implies (if (,tpred x) ;x is important in elim-rule representation
+                                (mget a x)
+                              'nil)
+                            (equal (mset a (mget a x) (acl2::map-identity x))
+                                   x)))
+       (elim-rule (get-elim-rule nume elim-term '(mget a x)))
+
+       (generic-lemmas
+        `((defthm ,(modify-symbol "" tpred "-IMPLIES-GOOD-MAP")
+            (implies (,tpred x)
+                     (acl2::good-map x))
+            :hints (("goal" :in-theory (e/d (,tpred))))
+            :rule-classes ((:rewrite :backchain-limit-lst 1) 
+                           (:forward-chaining)))
+          
+          (defthm ,(modify-symbol "" typid "-EXCLUDES-ATOM-LIST")
+            (implies (and (,tpred x)
+                          (consp x))
+                     (not (atom-listp x)))
+            :hints (("goal" :in-theory (e/d (,tpred) )))
+            :rule-classes (:tau-system))
+          (defthm ,(modify-symbol "" typid "-MAP-IDENTITY-GENERALIZE")
+            (implies (,tpred x)
+                     (,tpred (acl2::map-identity x)))
+            :rule-classes (:generalize))))
+       
+
+       
+
+       (disjoint-lemma1
+        `(defthm ,d-nm1
+           (implies (,tpred x)
+                    (not (,t1p x)))
+           :hints (("Goal" :in-theory (e/d (,tpred ,t1p))))))
+       
+       (?disjoint-lemma2
+        `(defthm ,d-nm2
+           (implies (,tpred x)
+                    (not (,t2p x)))
+           :hints (("Goal" :in-theory (e/d (,tpred ,t2p))))))
+       
+       (wf-key-lemma
+        `(defthm ,(modify-symbol "" t1p "-IS-WELL-FORMED")
+           (implies (,t1p x)
+                    (acl2::wf-keyp x))
+           :rule-classes ((:rewrite :backchain-limit-lst 1)
+                          (:forward-chaining))))
+       
+       (address-in-domain-lemma 
+        `(defthm ,(modify-symbol "" tpred "-DOMAIN-LEMMA")
+           (implies (and (,tpred x)
+                         (mget a x))
+                    (,t1p a))
+           :hints (("Goal" :in-theory (e/d 
+                                       (,tpred mget acl2::acl2->map)
+                                       (,t1p))))
+           :rule-classes ((:rewrite :backchain-limit-lst 1)
+                          :forward-chaining :generalize)))
+
+       (selector-lemma 
+        `(defthm ,s-nm
+           (implies (and (,tpred x)
+                         (mget acl2::a x))
+                    (,t2p (mget acl2::a x)))
+           :hints (("Goal" :in-theory (e/d 
+                                       (,tpred mget acl2::acl2->map)
+                                       (,t1p ,t2p))))
+           :rule-classes (:rewrite :generalize)))
+
+       (modifier-lemma
+        `(defthm ,m-nm
+           (implies (and (,tpred x)
+                         (,t1p acl2::a)
+                         (,t2p v))
+                    (,tpred (mset acl2::a v x)))
+           :hints (("Goal" :in-theory 
+                    (e/d (,tpred mset acl2::mset-wf
+                                 acl2::acl2->map acl2::map->acl2)
+                         (,t1p ,t2p acl2::wf-keyp))))
+           :rule-classes (:rewrite :generalize)))
+       
+       (map-elim-put-table-event       
+        `(table map-elim-table ',typid ',elim-rule :put))
+
+       (map-lemmas (append generic-lemmas
+                           (list disjoint-lemma1
+;disjoint-lemma2 ;TODO
+                                 address-in-domain-lemma
+                                 selector-lemma 
+                                 wf-key-lemma
+                                 modifier-lemma
+                                 map-elim-put-table-event
+                                 ))))
+                          
+    (update-support-lemmas
+     (acl2::change supp-lemmas%
+      s-lemm
+      :map
+      (append map-lemmas (acl2::access supp-lemmas% s-lemm :map)))
+     ds$)))
+
+
+(defun is-map-type (texp typId ctx ds$)
+;returns (mv trans-map ds$) trans-map is nil if not a map
+  (declare (xargs :stobjs (ds$)))
+  (b* (((unless (and (consp texp)
+                     (eq (car texp) 'map)))
+        (mv nil ds$))
+      ;Is a map
+       ((unless (= (len (cdr texp)) 2))
+        (prog2$
+         (er hard ctx "Map should be of form (map typeId1 typeId2), ~
+ but given ~x0.~%" texp)
+         (mv nil ds$)))
+       (lpair (cdr texp))
+       (keyT (car lpair))
+       (valT (cadr lpair))
+       (w (defdata-world ds$))
+       ((unless (and (is-registered keyT w)
+                     (is-registered valT w)))
+        (prog2$
+         (er hard ctx "~x0 and ~x1 should be predefined types.~%" keyT valT)
+         (mv nil ds$)))
+       (ds$ (add-map-type-support-lemmas-to-ds$ typId keyT valT ds$)))
+;map is just syntactic sugar
+    (mv `(oneof nil (mset ,keyT ,valT ,typId)) ds$)))
+
+
+;add generated set type lemmas to a temporary global variable
+;For each type only one set type is added
+(defun add-set-type-support-lemmas-to-ds$ (typid ds$)
+  (declare (xargs :stobjs (ds$)))
+  (let ((tpred (get-predicate-symbol typid))
+        (s-lemm (support-lemmas ds$)))
+  (update-support-lemmas
+   (acl2::change supp-lemmas%
+    s-lemm
+    :set
+    (cons `(defthm ,(modify-symbol "" tpred "-SETP")
+             (implies (,tpred x)
+                      (SETS::setp x))
+             :rule-classes ((:forward-chaining)
+                            (:rewrite :backchain-limit-lst 1)
+                            ))
+          (acl2::access supp-lemmas%  s-lemm :set)))
+   ds$)))
+
+
+  
+;add generated list type lemmas to a temporary global variable
+;For each type only one list type is added
+(defun add-list-type-support-lemmas-to-ds$ (typid ctype1 ds$ R$ types-ht$)
+  (declare (xargs :stobjs (ds$ R$ types-ht$)))
+  (b* ((tpred (get-predicate-symbol typid))
+       (s-lemm (support-lemmas ds$))
+        (atom-list-subtypep (and (symbolp ctype1)
+                                 (is-subtype ctype1 'acl2::atom R$ types-ht$)))
+       
+       (tlp-forms `((defthm ,(modify-symbol "" tpred "-IMPLIES-TLP")
+                      (implies (,tpred x)
+                               (true-listp x))
+                      :rule-classes ((:forward-chaining)
+                                     (:compound-recognizer)
+                                     (:rewrite :backchain-limit-lst 1)))
+                    (defthm ,(modify-symbol "" tpred "-TLP-APPEND")
+                      (implies (and (,tpred x)
+                                    (,tpred acl2::y))
+                               (,tpred (acl2::append x acl2::y))) ;July 11th v941 - why is induction on binary-append disabled? ans: coi/lists/basic
+                      :hints (("Goal" :induct (true-listp x)))
+                      :rule-classes ((:rewrite :backchain-limit-lst 1)))
+                    ))
+       
+       (tlp-ctype1-forms (if (is-a-typeName ctype1 (defdata-world ds$))
+                             (let ((ctype1-pred (get-predicate-symbol ctype1)))
+                               `((defthm ,(modify-symbol "" tpred "-TLP-CONS")
+                                   (implies (and (,ctype1-pred x)
+                                                 (,tpred acl2::y))
+                                            (,tpred (cons x acl2::y)))
+                                   :rule-classes :tau-system)
+                                 (defthm ,(modify-symbol "" tpred "-TLP-DESTR")
+                                   (implies (and (,tpred l) 
+                                                 (not (equal l nil)))
+                                            (and (,ctype1-pred (car l))
+                                                 (,tpred (cdr l))))
+                                   :rule-classes :tau-system)
+                                 ))
+                           '()))
+       (atom-list-subtype-form
+        `(defthm ,(modify-symbol "" tpred "-SUBTYPE-OF-ATOM-LIST")
+                    (implies (,tpred x)
+                             (atom-listp x))
+                    :rule-classes :tau-system))
+       (ev-forms (append tlp-ctype1-forms tlp-forms))
+       (ev-forms (if atom-list-subtypep
+                    (cons atom-list-subtype-form ev-forms)
+                  ev-forms)))
+       
+
+   
+  (update-support-lemmas
+   (acl2::change supp-lemmas%
+    s-lemm
+    :listof
+    (append ev-forms
+            (acl2::access supp-lemmas% s-lemm :listof)))
+   ds$)))
+
+;;PETE: Should we get rid of the compound recognizer rule above?
+;;It can be dangerous, eg, Harsh had the rule (tlp x) => (tlp x)
+;;as a compound recognizer and it slowed down proofs *a lot*, but
+;;maybe we just need to avoid this case and it will work out
+;;fine. With the bad rule disabled, a proof went through in 13
+;;seconds that previously took 205 seconds. More experiments are
+;;needed. I did more experiments. The rule is fine as is. Just
+;;make sure not to screw up with the above rules.
+
+(defun is-list-type (texp typid tnames ctx ds$ R$ types-ht$)
+  (declare (xargs :stobjs (ds$ R$ types-ht$)))
+;return (mv constituentTypeExpr|nil ds$)
+  (b* (((unless (and (consp texp)
+                     (eq (car texp) 'listof)))
+        (mv nil ds$))
+      ;Is a list type
+      ((unless (= (len (cdr texp)) 1))
+       (prog2$
+        (er hard ctx "~|listof should be of form (listof typeExpr) but ~x0 if not.~%" texp)
+        (mv nil ds$)))
+      (ds$ (update-type-class-top-level$ 'listof typid ds$))
+      ((mv & ctype1 ds$)
+       (trans-constituent-type (cadr texp) typid tnames ctx ds$))
+      ;;skipped error check.
+      (ds$ (add-list-type-support-lemmas-to-ds$ typid ctype1 ds$ R$ types-ht$)))
+    (mv `(oneof nil (cons ,ctype1 ,typid)) ds$)))
+       
+(defun is-set-type (texp typid tnames ctx ds$)
+;returns (mv trans-list|nil ds$)
+  (declare (xargs :stobjs (ds$)))
+ (b* (((unless (and (consp texp)
+                     (eq (car texp) 'set)))
+        (mv nil ds$))
+      ;Is a set type
+      ((unless (= (len (cdr texp)) 1))
+       (prog2$
+        (er hard ctx "set should be of form (set typeId) ~
+but ~x0 if not.~%" texp)
+        (mv nil ds$)))
+      (ds$ (update-type-class-top-level$ 'set typid ds$))
+      ((mv & ctype1 ds$)
+       (trans-constituent-type (cadr texp) typid tnames ctx ds$))
+      ;;skipped error check.
+      (ds$ (add-set-type-support-lemmas-to-ds$ typid ds$)))
+   (mv `(oneof nil (SETS::insert ,ctype1 ,typid)) ds$)))
+ 
+;gives back pre-processed data-type-exp or error
+;Sig: Any * Sym * Sym-List * Sym * State -> (mv erp trans-dtexp ds$) 
+;dtexp : TypeName | Singleton | Enum | Map | Record | List | Set | Prod-Union-type
+;record, list, map, set have been normalized (converted
+;to constituentTypeExpr) in trans-dtexp
+(defun translate-defbody (dtexp typId tnames ctx ds$ R$ types-ht$)
+  (declare (xargs :stobjs (ds$ R$ types-ht$)))
+;returns (mv erp trans-defbody ds$)
+  (b* (((when (is-singleton-type-p dtexp))
+        (let ((ds$ (update-type-class-top-level$ 'acl2::singleton typId ds$)))
+          (mv nil dtexp ds$)));constant expression or constant value?
+       ((when (is-a-typeName dtexp (defdata-world ds$)))
+        (let ((ds$ (update-type-class-top-level$ 'acl2::alias typId ds$)))
+          (mv nil dtexp ds$)))
+       ((unless (consp dtexp))
+        (prog2$
+          (er hard ctx "~x0 is an atom, but is neither a singleton-type ~ 
+nor a predefined typename~%" dtexp)
+          (mv t dtexp ds$)))
+;is a data type expression (either union or product or some syntactic sugar
+       (is-enum 
+;preprocessing and eval called inside enum
+         (is-enum-type dtexp ctx (defdata-world ds$)))
+       ((when is-enum) 
+         (let ((ds$ (update-type-class-top-level$ 'enum typId ds$)))
+           (mv nil is-enum ds$)))
+       ((mv is-map ds$) (is-map-type dtexp typId ctx ds$))
+       ((when is-map)     
+        (let ((ds$ (update-type-class-top-level$ 'map typId ds$)))
+          (mv nil is-map ds$))) ;ADDED 3rd May 2011 REMOVED 28th Aug '12 ADDED 17 July '13
+       ((mv is-record ds$) (is-record-type dtexp typId ctx ds$ R$ types-ht$))
+;type class of record also gets update on successful entry and not here
+       ((when is-record) 
+           (prog2$
+            (cw? (defdata-debug ds$)
+                          "record support lemmas: ~x0~%" (support-lemmas ds$))
+            (mv nil is-record ds$)))
+       ((mv is-list ds$) (is-list-type dtexp typId tnames ctx ds$ R$ types-ht$))
+       ((when is-list) (mv nil is-list ds$))
+       ((mv is-set ds$) (is-set-type dtexp typId tnames ctx ds$))
+       ((when is-set) (mv nil is-set ds$))
+       ((mv erp is-un ds$)
+         (trans-union-type-exp dtexp typId tnames ctx ds$))
+;For product and union  we update type class in the top-level call
+;of trans-product-type-exp and trans-union-type-exp respectively
+       ((when is-un)
+        (mv erp is-un ds$))
+       ((mv erp is-prod ds$)
+        (trans-product-type-exp dtexp typId tnames ctx ds$))
+       ((when is-prod)
+        (mv erp is-prod ds$))
+       ((when erp)
+        (prog2$
+         (er hard ctx "Error in translating type expression ~x0~%" dtexp)
+         (mv t nil ds$))))
+    (prog2$
+     (er hard ctx 
+         "Illegal DataType Expression ~x0.~
+               Should be either: typename, singletonType, enum, set~
+               record, listof, oneof (union), product type. ~%" dtexp )
+     (mv t nil ds$))))
+
+        
+;do the foll checks:
+;1. Def is a true-list and is of form (typeId dataTypeExp [:hints ])
+;2. typeId is a symbol TODO: We should check if its not already defined
+;3. dataTypeExp is a legal data type expression
+;4. keyword-list [:hints ...] TODO: should it be defined per mut-rec def or for defdata whole?
+;5. dataTypeExp is also pre-processed 
+(defun translate-defs0 (def tnames ctx ds$ R$ types-ht$)
+;return (trans-def ds$) or aborts on error
+  (declare (xargs :stobjs (ds$ R$ types-ht$)))
+  (b* (((unless (and (true-listp def)
+                     (>= (len def) 2)))
+        (prog2$
+         (er hard ctx "Definition ~x0 incorrectly formed.~%" def)
+         (mv nil ds$)))
+       (typId (car def))
+       (dataTypExp (cadr def))
+       ((unless (is-a-typeId-p typId (defdata-world ds$)))
+        (prog2$
+         (er hard ctx "~x0 is not a valid Type Identifier .~%" typId)
+         (mv nil ds$)))
+       ((mv erp dtexp ds$) 
+        (translate-defbody dataTypExp typId tnames ctx ds$ R$ types-ht$))
+       ((unless (not erp))
+        (prog2$
+         (er hard ctx "Could not translate defdata body ~x0~%" dataTypExp)
+         (mv nil ds$)))
+       (rst (cddr def)) ;hints etc keyword list
+       ((unless (acl2::keyword-value-listp rst)) ;check for hints
+        (prog2$
+         (er hard ctx "Expecting :hints but found ~x0.~%" rst)
+         (mv nil ds$))))
+;reconstruct. cddr may be hints
+       (mv (append (list typId dtexp) rst) ds$))) 
+
+        
+(defun translate-defs0-lst (defs tnames ctx ds$ R$ types-ht$ ans)
+  (declare (xargs :stobjs (ds$ R$ types-ht$)))
+  (if (endp defs)
+    (mv ans ds$)
+    (b* ((def (car defs))
+;check for errors in syntax and also preprocess (translate)
+         ((mv cdef ds$) (translate-defs0 def tnames ctx ds$ R$ types-ht$)))
+      (translate-defs0-lst (cdr defs) 
+                           tnames 
+                           ctx ds$ R$ types-ht$
+                           (append ans (list cdef))))))
+                                                                                 
+    
+;;; normalise single and mutually-recursive defs 
+;;; into (defdata (typeId dataTypeExp)+ )
+;;; and then call check-syntax-defs on resulting normalised form
+;;; Additionaly check for empty definitions and 
+;;; empty enum/oneof/anyof/record/listof(Not required i guess, redundant)
+(defun translate-defs (defs ctx ds$ R$ types-ht$)
+;returns (mv trans-defs ds$) or aborts on error
+  (declare (xargs :stobjs (ds$ R$ types-ht$)
+                  :mode :program))
+
+  (b* (((unless (and (consp defs) 
+                     (true-listp defs)))
+        (prog2$
+         (er hard ctx "Empty form not allowed.~%")
+         (mv nil ds$)))
+       ((when (and (not (symbolp (car defs)));not single def
+                   (found-empty-defp defs))) 
+;check for empty defs and empty enum/oneof/record/anyof/listof
+        (prog2$
+         (er hard ctx 
+             "Empty definition or Empty body in ~x0 not allowed.~%"
+             defs)
+         (mv nil ds$)))
+       ((when (and (not (symbolp (car defs)))
+                   (consp (cdr defs)))) ;atleast 2 types
+        ;;should i name this in acl2 package (mut-rec)?
+        (let* ((tnames (strip-cars defs))
+               (undef-lst (make-list (len tnames) :initial-element :undefined))
+               (ds$ (if (eq (type-class ds$) :undefined)
+                         (update-type-class (cons 'acl2::mutually-recursive 
+                                                  (pairlis$ tnames undef-lst)) ds$)
+                       ds$)))
+          (translate-defs0-lst defs tnames ctx ds$ R$ types-ht$ nil)))
+;single defn to be normalised
+       (def (if (symbolp (car defs)) defs (car defs))) 
+;rename defs to def to avoid confusion, def is the single definition
+       ((unless (> (len def) 1))
+        (prog2$
+         (er hard ctx "Syntax Error in defdata: Empty definition.~%" )
+         (mv nil ds$)))
+       ((unless (acl2::keyword-value-listp (cddr def)))
+;check for hints
+        (prog2$
+         (er hard ctx "Definitions that are not mutually-recursive should be ~
+                      of form (defdata <id> <type-definition> [:hints <hints>
+                     ...]).~%" )
+         (mv nil ds$)))
+       ((when (found-empty-defp (list def)))
+        (prog2$
+         (er hard ctx "Found empty definition or Empty body in ~x0.~%"
+             def)
+         (mv nil ds$))))
+    (translate-defs0-lst (list def) (list (car def)) ctx ds$ R$ types-ht$ nil)))
+         
+ 
+
+(logic)    
+
+; See first issue in acl2s-issues. 5 July '13
+; common interface for enumerators (both inf and fin)
+; TODO: what if names enum-sym and values-sym are already in history
+(defun cons-up-defconsts (names lens vals)
+  (declare (xargs :guard (and (symbol-listp names)
+                              (nat-listp lens)
+                              (true-listp vals))))
+  (if (endp names)
+    nil
+    (b* ((name (car names))
+         (values-sym (get-values-symbol name))
+         (enum-sym (get-enumerator-symbol name))
+         (enum-uniform-sym (get-uniform-enumerator-symbol name)))
+    (append (list* `(defconst ,values-sym ',(car vals))
+                   `(defun ,enum-sym (n)
+                      (declare (xargs :guard (natp n)))
+                      (nth (mod n ,(car lens)) ,values-sym))
+                   (make-enum-uniform-defun-ev enum-uniform-sym enum-sym))
+            (cons-up-defconsts (cdr names)
+                               (cdr lens)
+                               (cdr vals))))))
+
+(defun cons-up-pred-defthms (tnames pnames bodies rsts)
+   (declare (xargs :guard (and (true-listp tnames)
+                               (true-listp bodies)
+                               (true-listp pnames)
+                               (true-listp rsts))))
+                               
+  (if (endp tnames)
+    nil
+    (cons `(defthm ,(car tnames)
+             (equal (,(car pnames) v)
+                    ,(car bodies))
+             :rule-classes nil
+             . ,(car rsts))
+          (cons-up-pred-defthms (cdr tnames)
+                                (cdr pnames)
+                                (cdr bodies)
+                                (cdr rsts)))))
+
+(defun cons-up-non-recursive-pred-definition-defthms (tnames pnames bodies)
+   (declare (xargs :guard (and (true-listp tnames)
+                               (true-listp bodies)
+                               (true-listp pnames))))
+                               
+  (if (endp tnames)
+    nil
+    (cons `(defthm ,(car tnames)
+             (equal (,(car pnames) v)
+                    ,(car bodies))
+             :hints (("Goal" :in-theory (enable ,(car pnames)))))
+          (cons-up-non-recursive-pred-definition-defthms (cdr tnames)
+                                                         (cdr pnames)
+                                                         (cdr bodies)))))
+
+
+(defun lens (l)
+  (declare (xargs :guard (true-list-listp l)))
+  (if (endp l)
+    nil
+    (cons (len (car l))
+          (lens (cdr l)))))
+
+(defun cons-up-register-custom-type-ev (tnames)
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbol-listp tnames))))
+                              
+  (if (endp tnames)
+      '()
+    (cons `(register-custom-type ,(car tnames)
+                                 t 
+                                 ,(get-enumerator-symbol (car tnames))
+                                 ,(get-predicate-symbol (car tnames)))
+          (cons-up-register-custom-type-ev (cdr tnames)))))
+               
+(defun cons-up-add-type-info-calls 
+  (tsizes tnames tpreds tenums ttestenums defs 
+          recursive-tnames type-class)
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbol-listp tnames)
+                              (true-listp tsizes)
+                              (implies (consp tsizes)
+                                       (or (equal (car tsizes) t)
+                                           (natp (car tsizes))))
+                              (symbol-listp recursive-tnames)
+                              (symbol-listp tpreds)
+                              (symbol-listp tenums)
+                              (symbol-listp ttestenums)
+;(alistp defs)
+                              (type-class-p type-class))))
+
+                              
+  (if (endp tnames)
+    nil
+    (cons `(table
+            defdata::types-info-table
+             ',(car tnames)
+             ',(acl2::make types-info%
+                  :size (car tsizes) 
+                  :enumerator (car tenums)
+                  :predicate (car tpreds)
+                  :test-enumerator (car ttestenums)
+                  :enum-uniform (get-uniform-enumerator-symbol (car tnames))
+                  :defs defs
+                  :derivedp t;defdata == derived data-type
+                  :recursivep (if (member-equal (car tnames)
+                                                recursive-tnames)
+                                  t
+                                nil)
+                  :type-class type-class)
+             :put)
+          (cons-up-add-type-info-calls (cdr tsizes)
+                                       (cdr tnames)
+                                       (cdr tpreds)
+                                       (cdr tenums)
+                                       (cdr ttestenums)
+                                       defs 
+                                       recursive-tnames
+                                       type-class
+                                       ))))
+
+;generate add-datatype-node-dtg-batch calls for each tname in tnames
+(defun cons-up-add-datatype-node-dtg-calls1 (tnames)
+  (declare (xargs :guard (symbol-listp tnames)))
+  (if (endp tnames)
+    nil 
+    (cons `(trans-eval `(add-vertex$$ ',',(car tnames) R$ types-ht$) 
+                       'add-vertices-to-type-graph-event state t)
+;`(add-datatype-node-batch ,(car tnames)) ;macro call, so dont quote like elsewhere
+     
+          (cons-up-add-datatype-node-dtg-calls1 (cdr tnames)))))
+
+(defun add-vertices-to-type-graph-event (tnames)
+  (declare (xargs :guard (symbol-listp tnames)))
+  (b* ((calls (cons-up-add-datatype-node-dtg-calls1 tnames)))
+    `(make-event 
+      (er-progn 
+       ,@calls
+       (value '(value-triple :invisible)))
+      :check-expansion t)))
+
+;filter typ-exps which are typenames
+(defun filter-typeName (texp-lst tnames state)
+  (declare (xargs :stobjs (state)
+                  :mode :program
+                  :guard (and (true-listp texp-lst)
+                              (symbol-listp tnames))))
+  (if (endp texp-lst)
+    nil
+    (let* ((texp (car texp-lst))
+           (istype  (or (is-a-typeName texp (w state))
+                        (mem1 texp tnames))))
+      (if istype
+        (cons texp (filter-typeName (cdr texp-lst) tnames state))
+        (filter-typeName (cdr texp-lst) tnames state)))))
+
+(program)
+;list together calls that add a edge in the subtype graph for each
+;constituent-type -> union-type
+; TODO - not general, doesnt treat product constituents
+(mutual-recursion
+ (defun collect-defdata-oneof-subtype-event (dtexp typ tnames w)
+   (let* ((T1p (get-predicate-symbol typ)))
+     (cond ((is-singleton-type-p dtexp)
+            (b* ((ev-form-print `(defthm ,(modify-symbol "EVAL-" T1p (string-append "-TAU-RULE-EQUAL-"(to-string dtexp)))
+                                   (,T1p ,dtexp) :rule-classes :tau-system))
+                 (ev-forms `((value-triple (cw? (get-acl2s-defdata-verbose) "~|Submitting ~x0~|" ',ev-form-print))
+                             ,ev-form-print)))
+              ev-forms))
+            ((or (member-eq dtexp tnames) (is-a-typeName dtexp w))
+             `((defdata-subtype ,dtexp ,typ)))
+            ((and (consp dtexp)
+                  (or (eq (car dtexp) 'oneof) (eq (car dtexp) 'anyof)))
+             (collect-defdata-oneof-subtype-events (cdr dtexp) typ tnames w))
+            (t '()))))
+            
+ (defun collect-defdata-oneof-subtype-events (c-typexp-lst typ tnames w)
+   (declare (xargs :guard (and (true-listp c-typexp-lst)
+                               (symbolp typ)
+                               (symbol-listp tnames)
+                               (plist-worldp w))))
+   
+   (if (endp c-typexp-lst)
+       '()
+     (append (collect-defdata-oneof-subtype-event (car c-typexp-lst) typ tnames w)
+             (collect-defdata-oneof-subtype-events (cdr c-typexp-lst) typ tnames w))))
+)
+
+; generate subtype edge calls for each tname in tnames (not recursive
+; types are also dealt uniformly)
+(defun constituent-types-oneof-subtype-events (defs tnames w)
+  (declare (xargs :mode :program
+                  :guard (and (true-listp defs)
+                              (symbol-listp tnames)
+                              (plist-worldp w))))
+  (if (endp defs)
+      '()
+    (let* ((def (car defs))
+          (nm (car def))
+          (tbody (cadr def)))
+      (if (and (consp tbody) ;not a singleton or typename
+               (or (eq (car tbody) 'oneof) ;is a union type expression
+                   (eq (car tbody) 'anyof)))
+          (append (collect-defdata-oneof-subtype-events (cdr tbody) nm tnames w)
+                  (constituent-types-oneof-subtype-events (cdr defs) tnames w))
+        (constituent-types-oneof-subtype-events (cdr defs) tnames w)))))
+
+(logic)                            
+
+(defun defsp (x)
+  (if (atom x)
+    (equal x nil)
+    (and (= 2 (len (car x)))
+         (symbolp (first (car x)))
+         (defbodyp (second (car x)))
+         (defsp (cdr x)))))
+
+        
+(defthm rec-type-defbody-type
+  (implies (defsp defs)
+           (defbodyp (second (assoc-eq typ defs)))))
+
+
+
+
+
+;TODO singleton types not yet dealt with
+(defun make-subtype-events1 (tc defs)
+"defs are all defs of type-class tc. generate defdata-subtype events for each def"
+  (declare (xargs :guard (and (defsp defs))))
+  (if (endp defs)
+      '()
+    (let* ((def (car defs))
+          (nm (car def));shud be a symbol
+          (tbody (cadr def)))
+      (case tc
+        (acl2::alias (append (list (list 'defdata-subtype nm tbody)
+                                   (list 'defdata-subtype tbody nm))
+                             (make-subtype-events1 tc (cdr defs))))
+        (listof (cons (list 'defdata-subtype nm 'acl2::true-list)
+                      (make-subtype-events1 tc (cdr defs))))
+        (map (cons (list 'defdata-subtype nm 'acl2::alist)
+                   (make-subtype-events1 tc (cdr defs))))
+        (otherwise (make-subtype-events1 tc (cdr defs)))))))
+
+
+(local
+ (defthm filter-defs-guard1
+   (implies (and (symbol-alistp x)
+                 (not (consp x)))
+            (equal x nil))
+   :rule-classes :tau-system))
+            
+
+(defun filter-defs (tc defs alst)
+  "filter out defs of type-class tc"
+   (declare (xargs :verify-guards nil
+                   :guard (and (type-class-simple-p tc)
+                               (defsp defs)
+                               (symbol-alistp alst))))
+  (if (endp defs)
+      '()
+    (let ((entry (assoc-eq (caar defs) alst)))
+      (if (and (consp entry)
+               (eq tc (cdr entry)))
+          (cons (car defs)
+                (filter-defs tc (cdr defs) alst))
+        (filter-defs tc (cdr defs) alst)))))
+
+(local (defthm filter-defs-guard2
+         (implies (and (type-class-simple-p tc)
+                       (defsp x))
+                  (defsp (filter-defs tc x y)))
+         :rule-classes :tau-system))
+
+(verify-guards filter-defs)
+
+
+(defun make-subtype-events (tc defs)
+  (declare (xargs :guard (and (defsp defs)
+                              (type-class-p tc))))
+  (cond ((eq tc 'acl2::alias) (make-subtype-events1 tc defs))
+        ((and (consp tc) (eq (car tc) 'acl2::mutually-recursive))
+         (append (make-subtype-events1 'acl2::alias (filter-defs 'acl2::alias defs (cdr tc)))
+                 (make-subtype-events1 'listof (filter-defs 'listof defs (cdr tc))))) ;can map be in clique?
+        ((member-eq tc '(listof map)) (make-subtype-events1 tc defs))
+        (t '())))
+
+
+(defun make-boolean-tau-rule-event (typs)
+  (declare (xargs :guard (and (symbol-listp typs))))
+                  
+  (if (endp typs)
+      '()
+    (let ((pred (get-predicate-symbol (car typs))))
+    (cons `(defthm ,(modify-symbol "" pred "-IS-BOOLEAN-TAU")
+             (booleanp (,pred x))
+             :rule-classes :tau-system
+             :hints (("goal" :in-theory (enable ,pred))))
+          (make-boolean-tau-rule-event (cdr typs))))))
+
+;; (defun record-tau-subtype-events (preds P)
+;;   (declare (xargs :guard (and (symbol-listp preds)
+;;                               (symbolp P))))
+;;   (if (endp preds)
+;;       '()
+;;     (cons `(defthm ,(modify-symbol "" (car preds) (string-append "-SUBTYPE-OF-" (symbol-name P)))
+;;              (implies (,(car preds) x) (,P x))
+;;              :rule-classes (:tau-system)
+;;              :hints (("goal" :in-theory (enable ,(car preds)))))
+;;           (record-tau-subtype-events (cdr preds) P))))
+          
+;; (defun record-defdata-subtype-events (typs P)
+;;   (declare (xargs :guard (and (symbol-listp typs)
+;;                               (symbolp P))))
+;;   (if (endp typs)
+;;       '()
+;;     (cons `(defdata-subtype ,(car typs) ,P 
+;;              :hints (("goal" :in-theory (enable ,(get-predicate-symbol (car typs)) ))))
+;;           (record-defdata-subtype-events (cdr typs) P))))
+
+;extract destructor-predicate pairs
+(defun strip-dex-pairx (new-constructors)
+  (declare (xargs :mode :program
+                  :guard (alistp new-constructors)))
+  (if (endp new-constructors)
+    nil
+    (cons (dex-pairs-entry (car new-constructors))
+          (strip-dex-pairx (cdr new-constructors)))))
+
+;extract predicates
+(defun strip-preds (new-constructors)
+  (declare (xargs :mode :program
+                  :guard (alistp new-constructors)))
+  (if (endp new-constructors)
+    nil
+    (cons (predicate-name-entry (car new-constructors))
+          (strip-preds (cdr new-constructors)))))
+
+
+
+;ADD this to the syntactic check!!! TODO. THis gives some false positives
+(mutual-recursion
+;Is typename defined in a (defdata (tname1 ...) ...) a recursive type?
+;Implicit contract: (in typename tnames)
+(defun is-recursive-type-lst (typename tnames defbody-lst)
+  (declare (xargs :guard (and (symbolp typename)
+                              (symbol-listp tnames)
+                              (defbody-listp defbody-lst))))
+                  ;:verify-guards nil))
+  (if (endp defbody-lst)
+    nil
+  (or (is-recursive-type typename tnames (car defbody-lst))
+      (is-recursive-type-lst typename tnames (cdr defbody-lst)))))
+
+(defun is-recursive-type (typename tnames defbody)
+  (declare (xargs :guard (and (symbolp typename)
+                              (symbol-listp tnames)
+                              (defbodyp defbody))))
+  (cond ((possible-constant-valuep defbody) nil)
+        ((symbolp defbody) (mem1 defbody tnames))
+        (t (is-recursive-type-lst typename tnames (cdr defbody)))))
+)
+           
+(defthm rec-type-consp-defbody-type
+  (implies (and (consp defbody)
+                (defbodyp defbody)
+                (is-recursive-type typename tnames defbody))
+           (defbody-listp (cdr defbody))))
+
+(defun get-recursive-typenames (types defs tnames)
+  (declare (xargs ;:mode :program 
+                  :guard-hints (("Goal" :in-theory (disable is-recursive-type)))
+                  :guard (and (symbol-listp types)
+                              (symbol-listp tnames)
+                              (defsp defs))))
+  (if (endp types)
+    nil
+    (let ((typename (car types)))
+      (if  (is-recursive-type typename tnames (second (assoc-eq typename defs)))
+        (cons typename
+              (get-recursive-typenames (cdr types) defs tnames))
+        (get-recursive-typenames (cdr types) defs tnames)))))
+
+(defun my-append (Xs Ys)
+  (declare (xargs :guard (and (true-listp Xs)
+                              (true-listp Ys))))
+                  
+  (append Xs Ys));for debugging
+
+;;make type consistency check event for all types in arg
+;;Generate the foll form:
+;; (thm (implies (natp x) (Tp (nth-T x)))) or
+;; (thm (implies (< n (len *T-values*)) (Tp (nth n *T-values*))))
+;; TODO.Note: *T-values* might be very big list in that case, there must be a cleaner/efficient way.
+(defun cons-up-type-consistent-thm-ev (tnames wrld)
+  (declare (xargs :mode :program
+                  :guard (symbol-listp tnames)))
+  (if (endp tnames)
+    nil
+    (let* ((tname (car tnames))
+           (tpred (get-predicate-symbol tname))
+           (tenum (get-enumerator-symbol tname))
+           (tvalues (get-values-symbol tname))
+           (tpred-lst (modify-symbol "" tpred "-LST-AUTO-GENERATED"))) 
+      (append (if (allows-arity tenum 1 wrld)
+                (list `(thm (implies (natp n) (,tpred (,tenum n)))
+                            :hints (("Goal" :in-theory (e/d (,tpred ,tenum))))))
+                (list `(defun ,tpred-lst (xs) 
+                         (if (endp xs)
+                           t
+                           (and (,tpred (car xs))
+                                (,tpred-lst (cdr xs)))))
+                      `(thm (,tpred-lst ,tvalues))))
+              (cons-up-type-consistent-thm-ev (cdr tnames) wrld)))))
+
+  
+
+
+;this function takes care of records, where the constructor name is the
+;same as the name of the type and hence to avoid a bad redefinition\
+;we collect only that preds that need predicates , excluding
+;the constructor predicate which is generated anyway!
+(defun names-need-predicates (nms nms-with-pred new-constructors)
+  (declare (xargs :guard (and (symbol-listp nms)
+                              (symbol-listp nms-with-pred)
+                              (symbol-alistp new-constructors))))
+  
+  (let* ((nms-need (set-difference-eq nms nms-with-pred))
+         (new-names (strip-cars new-constructors)))
+    (set-difference-eq nms-need new-names)))
+          
+
+;;harshrc: changed name of the main function (from compute-defdata)
+;; defs - ((typeid . constituentTypeExpr) ...)
+(defun compute-typecombs (defs kwd-options-lst 
+                           new-record-constructors 
+                           support-lemmas custom-types
+                           type-class
+                           ctx wrld state R$ types-ht$)
+  (declare (xargs :mode :program
+                  :stobjs (state R$ types-ht$)))
+  (b* ((names (strip-cars defs))
+       (?verbose (get-acl2s-defdata-verbose))
+;(defbodies (strip-cadrs defs))
+       (pred-syms (get-predicate-symbol-lst names))
+       
+;with predicates already defined --ASK: what if its defined inconsistently??BUG?
+       (names-with-preds (collect-with-plausible-pred-fns names wrld))
+       (defs-with-preds (assoc-lst names-with-preds defs))
+       (defbodies-with-preds (strip-cadrs defs-with-preds))
+       (rsts-with-preds (acl2::strip-cddrs defs-with-preds))
+       (pred-syms-with-preds (get-predicate-symbol-lst names-with-preds))
+       (thm-syms-with-preds (get-predicate-testthm-symbol-lst names-with-preds))
+       
+;predicates need to be defined
+       (names-need-preds (names-need-predicates names names-with-preds new-record-constructors))
+       (pred-syms-need-preds (get-predicate-symbol-lst names-need-preds))
+       
+       (defs-need-preds (assoc-lst names-need-preds defs))
+       (defbodies-need-preds (strip-cadrs defs-need-preds))
+       
+;non recursive predicates(from names that need preds) need to be treated separately
+       (recursive-names (get-recursive-typenames names-need-preds defs names))
+       (non-recursive-names (set-difference-eq names-need-preds recursive-names))
+       (?non-recursive-pred-syms (get-predicate-symbol-lst non-recursive-names))
+       (defs-non-recursive (assoc-lst non-recursive-names defs))
+       (defbodies-non-recursive (strip-cadrs defs-non-recursive))
+       
+       ;;events from new constructors (records)
+       (conx-names (strip-cars new-record-constructors))
+       (conx-recursive-alst (find-recursive-records pred-syms-need-preds new-record-constructors))
+       (conx-non-recur-alst (set-difference-eq new-record-constructors conx-recursive-alst))
+       (conx-recur-names (strip-cars conx-recursive-alst))
+       (conx-non-recur-names (set-difference-eq conx-names conx-recur-names)) 
+       (dex-pairs-non-recur-lst (strip-dex-pairx conx-non-recur-alst))
+       (dex-pairs-lst (strip-dex-pairx new-record-constructors))
+       (dex-pairs-recur-lst (strip-dex-pairx conx-recursive-alst))
+       (conx-pred-recur-events (cons-up-conx-prex-ev conx-recur-names dex-pairs-recur-lst))
+       (conx-pred-recur-defun-cdrs (strip-cdrs conx-pred-recur-events));strip defun
+       (conx-pred-recur-names (strip-cadrs conx-pred-recur-events))
+       (conx-pred-non-recur-events (cons-up-conx-prex-ev conx-non-recur-names dex-pairs-non-recur-lst))
+       (?conx-pred-non-recur-names (strip-cadrs conx-pred-non-recur-events))
+;(dex-events (append-up-dex-ev conx-names dex-pairs-lst))
+       (conx-events (cons-up-conx-ev conx-names dex-pairs-lst))
+       (register-conx-dex-events (cons-up-reg-conx-dex-ev conx-names dex-pairs-lst))
+       
+       ;; generating supporting lemmas
+       (gen-lemmasp (if (mem1 :type-lemmas kwd-options-lst)
+                        (get-value-from-keyword-value-list :type-lemmas kwd-options-lst)
+                      t)) ;changed default for project 11th april '13
+       (record-implies-consp/good-map-lemmas (cons-up-record-implies-consp/good-map-ev conx-names dex-pairs-lst wrld))
+;lemmas for syntactic sugar
+       (list-type-support-lemmas (acl2::access supp-lemmas%
+                                               support-lemmas :listof))
+       (set-type-support-lemmas (acl2::access supp-lemmas%
+                                              support-lemmas :set))
+       (record-type-support-lemmas (and gen-lemmasp
+                                        (acl2::access supp-lemmas%
+                                                      support-lemmas :record)))
+       (map-type-support-lemmas (and gen-lemmasp
+                                     (acl2::access supp-lemmas%
+                                                      support-lemmas :map)))
+; lemmas for base union-product type lemmas
+;(base-type-support-lemmas (g :base support-lemmas))
+;(verbose (get-acl2s-defdata-verbose))
+       (generate-allp-alias-boolean-tau-rule-p (and (eq type-class 'acl2::alias)
+                                                    (is-subtype 'ACL2::ALL (cadr (car defs)) R$ types-ht$))) ;TODO, new graph book doesnt support this.
+                                         
+       )
+    (if (not (no-duplicatesp names))
+        (er soft ctx "Duplicate found in the names being defined: ~x0" names)
+      (b* (((er pred-bodies-with) (er-trans-datadef-as-predicate-lst
+                                   defbodies-with-preds
+                                   pred-syms
+                                   (make-list (len defbodies-with-preds)
+                                              :initial-element 'v)
+                                   new-record-constructors
+                                   ctx wrld state))
+           ;;-- pred-bodies-need e.g:
+           ;;-- ((OR (EQ V 'NIL)
+           ;;-- (AND (CONSP V)
+           ;;--   (FOOP (CAR V))
+           ;;--   (BARP (CDR V)))))
+           ((er pred-bodies-need) (er-trans-datadef-as-predicate-lst
+                                   defbodies-need-preds
+                                   pred-syms
+                                   (make-list (len defbodies-need-preds)
+                                              :initial-element 'v)
+                                   new-record-constructors
+                                   ctx wrld state))
+           ((er ?non-recur-pred-bodies-need) (er-trans-datadef-as-predicate-lst
+                                             defbodies-non-recursive
+                                             pred-syms
+;TODO:Possible bug, shudnt it be non-recursive preds only
+                                             (make-list (len defbodies-non-recursive)
+                                                        :initial-element 'v)
+                                             new-record-constructors
+                                             ctx wrld state))
+
+
+           ;;-- fin-binds e.g =
+           ;;--((FOO 42 (T T) (NIL T) (T NIL) (NIL NIL))
+           ;;-- (BAZ (T) (NIL))
+           ;;-- (MOO NIL))
+           ((er fin-binds) (er-get-finite-data-defs defs new-record-constructors ctx wrld state))
+           (fin-names (strip-cars fin-binds))
+           (fin-enum-syms (get-values-symbol-lst fin-names))
+           (fin-values (strip-cdrs fin-binds))
+           (fin-lens (lens fin-values))
+           (fin-defs  (cons-up-lists fin-enum-syms fin-values))
+           (inf-names (set-difference-eq names fin-names))
+           (inf-enum-syms (get-enumerator-symbol-lst inf-names))
+;CHANGED by harshrc Jan 24 2011(earlier hack on Jun 6 2010)
+           (declare-guardsp (if (mem1 :declare-guards kwd-options-lst)
+                                (get-value-from-keyword-value-list :declare-guards kwd-options-lst)
+                              (get-acl2s-defdata-use-guards)))
+           (inf-bodies (strip-cadrs (assoc-lst inf-names defs)))
+           ((er inf-enums) (er-trans-datadef-as-enumerator-lst
+                            inf-bodies
+                            fin-defs
+                            inf-enum-syms
+                            nil
+                            new-record-constructors
+                            ctx wrld state))
+           (?inf-uniform-enum-syms (get-uniform-enumerator-symbol-lst inf-names))
+           ((er inf-uniform-enums) (er-trans-datadef-as-enumerator-lst
+                                    inf-bodies
+                                    fin-defs
+                                    (append (get-uniform-enumerator-symbol-lst custom-types) inf-uniform-enum-syms)
+                                    t
+                                    new-record-constructors
+                                    ctx wrld state))
+           (testing-enabled (acl2s-defaults :get testing-enabled))
+           (acl2-defaults-tbl (table-alist 'acl2::acl2-defaults-table wrld))
+           (current-termination-method-entry (assoc :termination-method acl2-defaults-tbl))
+           );*b
+;in
+        (value `
+         (progn
+           ;; (set-internal-acl2s-inside-defdata-flag t)
+           
+           (acl2s-defaults :set testing-enabled nil)
+           ,@(and 
+              conx-pred-non-recur-names
+              `((value-triple
+                 (cw? t
+                      "Submitting (non-recursive) record predicate functions ~x0.~%"
+                      ',conx-pred-non-recur-names))))
+           
+           ,@conx-pred-non-recur-events
+
+           ,@(and 
+              (append pred-syms-need-preds
+                      conx-pred-recur-names)
+              `((value-triple
+                 (cw? t
+                      "Submitting predicate functions ~x0.~%"
+                      ',(append pred-syms-need-preds
+                                conx-pred-recur-names)))))
+           ,@(and 
+              pred-syms-need-preds
+              `((defuns . ,(append 
+                            conx-pred-recur-defun-cdrs
+                            (cons-up-names-decls-lls-bodies
+                             pred-syms-need-preds
+                             (if T;declare-guardsp  
+;harshrc Sep 3rd 2012 -- OK, predicates need their guards to be
+;verified. I hope this wont break anything, since this change though
+;it reduces flexibility it does not change the behavior of
+;declare-guardsp for now, since the default value for it was T anyway.
+                                 (make-list (len pred-syms-need-preds) 
+                                            :initial-element 
+                                            '(declare (xargs :guard t
+                                                             :ruler-extenders :all
+                                                             )))
+                               (make-list (len pred-syms-need-preds) 
+                                          :initial-element 
+                                          '(declare (xargs :ruler-extenders :all)))
+                               );end of if , this gives the declare form for the predicate
+                             (make-list (len pred-syms-need-preds)
+                                        :initial-element '(v))
+                             pred-bodies-need)))))
+           ;; ,@(and 
+           ;;    (or non-recursive-pred-syms conx-pred-non-recur-names)
+           ;;    `((in-theory (disable ,@(union-eq non-recursive-pred-syms 
+           ;;                                      conx-pred-non-recur-names)))))
+           
+           ,@conx-events
+           
+; 10th April 2013 - Generate record=>consp/good-map for all records
+; (earlier only recursive records were getting these lemmas)
+           
+           ,@(and conx-names
+                  `((value-triple
+                     (progn$
+                      (time-tracker :defdata-generic-record-lemmas :end)
+                      (time-tracker :defdata-generic-record-lemmas :init
+                                    :times '(2 7)
+                                    :interval 5
+                                    :msg "Elapsed runtime in generic lemma proofs for records is ~st secs;~|~%")
+                      (cw? t
+                           "Submitting generic record lemmas... ~%")
+                      (cw? t;,verbose
+                           "~x0~%" ',record-implies-consp/good-map-lemmas)))))
+           ,@(and conx-names record-implies-consp/good-map-lemmas)
+           
+;,@ dex-events (Jan25 2011 No need, mget handles it)
+           ,@register-conx-dex-events
+; TODO: check if the fin and enum names of fin-names are fresh!
+           ,@(cons-up-defconsts fin-names ;fin-enum-syms -- 5 july '13 add defuns too
+                                fin-lens
+                                fin-values)
+           ,@(cons-up-pred-defthms thm-syms-with-preds
+                                   pred-syms-with-preds
+                                   pred-bodies-with
+                                   rsts-with-preds)
+
+                 ,@(and inf-enums
+                  `((value-triple
+                     (cw? t
+                          "Submitting enumerator functions ~x0.~%"
+                          ',inf-enum-syms))))
+           
+           
+           ,@(and 
+              inf-enums
+              `((defuns . 
+                  ,(cons-up-names-decls-lls-bodies
+                    inf-enum-syms
+                    (if declare-guardsp
+                        (make-list (len inf-enums)
+                                   :initial-element 
+                                   (if current-termination-method-entry
+                                       '(declare (xargs :consider-only-ccms ((nfix x))
+                                                        :guard (natp x)))
+                                     '(declare (xargs :measure (nfix x)
+                                                      :guard (natp x) ))
+                                     
+                                     ))
+                      (make-list (len inf-enums)
+                                 :initial-element 
+                                 (if current-termination-method-entry
+                                     '(declare (xargs :consider-only-ccms ((nfix x))))
+                                   '(declare (xargs :measure (nfix x))))
+                                 )
+                      );end of if , this gives the declare form for the enum
+                    (make-list (len inf-enums)
+                               :initial-element '(x))
+                    (strip-cdrs inf-enums)))))
+           (in-theory (disable ,@inf-enum-syms))
+           ,@(cons-up-register-custom-type-ev custom-types)
+           
+           ;;hack
+           ,@(and current-termination-method-entry
+                  '((acl2::set-termination-method :measure)))
+                
+           ,@(and 
+              inf-uniform-enums
+              `((defuns . 
+                  ,(cons-up-names-decls-lls-bodies
+                    inf-uniform-enum-syms
+                    (make-list (len inf-uniform-enums)
+                               :initial-element 
+                               `(declare (ignorable m)
+                                         (type (unsigned-byte 31) seed)
+                                         (xargs ,@(if nil;current-termination-method-entry 
+                                                      '(:consider-only-ccms ((nfix m)))
+                                                    '(:measure (nfix m)))
+                                                :verify-guards nil
+                                                :guard (and (natp m)
+                                                            (unsigned-byte-p 31 seed))))
+                               )
+                    (make-list (len inf-uniform-enums)
+                               :initial-element '(m seed))
+                    (strip-cdrs inf-uniform-enums)))))
+           ;;hack
+           ,@(and current-termination-method-entry
+                  `((acl2::set-termination-method ,(cdr current-termination-method-entry))))
+
+           (in-theory (disable ,@inf-uniform-enum-syms))
+           
+
+           
+           (value-triple
+            (cw? t
+                 "Updating defdata type table (type-class ~x0).~%" ',type-class))
+           
+           ,@(and generate-allp-alias-boolean-tau-rule-p ;TODO HACK, shud i do this for all names?
+                  (make-boolean-tau-rule-event names))
+           
+;add fin and inf type information to types-table 
+;(but seperately because we have to do this outside make-event)
+           ,@(cons-up-add-type-info-calls 
+              fin-lens
+              fin-names (get-predicate-symbol-lst fin-names)
+              fin-enum-syms nil defs
+              nil type-class);test-enums=nil, recursive-names=nil
+;Question: How can u have multiple finite types? Multiple type defs 
+;invariably mean mutually-recursive!! Put an assert?
+           ,@(cons-up-add-type-info-calls 
+              (make-list (len inf-enums) :initial-element 't)
+              inf-names (get-predicate-symbol-lst inf-names)
+              inf-enum-syms nil defs;test-enums = nil
+              (get-recursive-typenames names defs names)
+              type-class)
+           
+           (value-triple
+            (cw? t
+                 "Adding ~x0 to the type relation graphs.~%" ',names))
+           
+; test-enums will only be explicitly provided by the user and added to the table
+           ,(add-vertices-to-type-graph-event names) ;add the noded to datatype-graph
+ 
+           (value-triple
+            (cw? ,gen-lemmasp
+                 "Updating defdata subtype/disjoint graphs.~%"))
+
+
+; Record type relations with following events. Finally completely characterize the defdata def using tau rules. TODO
+           ,@(and gen-lemmasp 
+                  (let* ((ev-forms0 (constituent-types-oneof-subtype-events defs names (w state)))
+                         (ev-forms1 ;hack 16 July '13
+                          (cond ((and (eq type-class 'acl2::listof)
+                                      (is-registered 'acl2::true-list wrld))
+                                 (make-subtype-events type-class defs))
+;assumption: there are no mutual-recursive types in base.lisp where true-list is still undefined.
+                                ((member-eq type-class '(acl2::mutually-recursive acl2::alias map)) 
+                                 (make-subtype-events type-class defs))
+                                (t '()))))
+                    (append ev-forms1 ev-forms0)))
+           
+                ,@(and list-type-support-lemmas
+                  `((value-triple
+                     (progn$
+                      (cw? t
+                           "Submitting list type lemmas... ~%")
+                      (cw? t;,verbose
+                          "~x0~%" ',list-type-support-lemmas)))))
+           ,@list-type-support-lemmas   
+           
+           ,@(and set-type-support-lemmas
+                  `((value-triple
+                     (cw? t
+                          "Submitting set type lemmas... ~%"))))
+           ,@set-type-support-lemmas
+
+           ,@(and record-type-support-lemmas
+                  `((value-triple
+                     (progn$
+                      (time-tracker :defdata-record-lemmas :end)
+                      (time-tracker :defdata-record-lemmas :init
+                                    :times '(2 7)
+                                    :interval 5
+                                    :msg "Elapsed runtime in type proofs for records is ~st secs;~|~%")
+                      (time-tracker :defdata-record-lemmas :start)
+                      
+                     (cw? t
+                          "Submitting record type lemmas... ~%")
+                     (cw? t;,verbose
+                          "~x0~%" ',record-type-support-lemmas)))))
+           ,@record-type-support-lemmas
+           ,@(and record-type-support-lemmas
+                  '((value-triple (prog2$
+                                   (time-tracker :defdata-record-lemmas :stop)
+                                   :invisible))))
+            
+           
+           ,@ (and map-type-support-lemmas
+                   `((value-triple
+                      (cw? t
+                                    "Submitting map type lemmas... ~%"))))
+           ,@ map-type-support-lemmas
+
+           ;; ;,@ base-type-support-lemmas
+      
+
+           (acl2s-defaults :set testing-enabled ,testing-enabled)
+           (value-triple ',names)
+           ;; (set-internal-acl2s-inside-defdata-flag nil)
+           ))
+         
+         ))))
+
+;defs-ans is accumlated defs to be extracted
+(defun get-defs-and-keyword-list (args defs-ans)
+  (declare (xargs :guard (and (true-listp args)
+                              (true-listp defs-ans))))
+  (if (endp args)
+    (mv defs-ans nil)
+    (if (keyword-value-listp args);not null
+      (mv defs-ans args) ;abort and give back answer
+      (get-defs-and-keyword-list (cdr args) 
+                                 (append defs-ans (list (car args)))))))
+
+(defun initialize-ds$ (debug wrld ds$)
+  (declare (xargs :stobjs (ds$)
+                  :guard (and (booleanp debug)
+                              (ds$p ds$))))
+                 
+  (b* ((ds$ (update-defdata-world wrld ds$))
+       (ds$ (update-newconstructors nil ds$))
+       (ds$ (update-custom-types nil ds$))
+       (ds$ (update-support-lemmas *initial-supp-lemmas* ds$))
+       (ds$ (update-defdata-debug debug ds$)))
+      ds$))
+  
+;;process enums and normalise listof/record/set etc
+(defun compute-defdata (args debug-flag ctx wrld state R$ types-ht$)
+  (declare (xargs :mode :program
+                  :stobjs (state R$ types-ht$)))
+  (acl2::state-global-let*
+   ((acl2::guard-checking-on :all))
+  (b* (((mv defs0 kwd-options-lst)
+         (get-defs-and-keyword-list args nil)))
+    (acl2::with-local-stobj
+     ds$
+     (mv-let 
+      (erp result state ds$)
+      (b* ((ds$ (initialize-ds$ debug-flag wrld ds$))
+           ((mv defs1 ds$) (translate-defs defs0 ctx ds$ R$ types-ht$))
+           (enum-event (process-enum-form defs1 ctx wrld)))
+        (if enum-event
+;submit enumeration event form
+            (mv nil `(progn ,@enum-event) state ds$) 
+          (let* ((cust-types (custom-types ds$))
+                 (validate-type-consistency-ev 
+                  (cons-up-type-consistent-thm-ev cust-types wrld))
+                (mk-ev-form
+                 `(make-event
+                   (mv-let 
+                    (erp res state)
+                    (er-progn 
+                     (value (and ',validate-type-consistency-ev
+                                 (cw? t "~|Proving consistency of custom types ~x0...~%" ',cust-types)))
+                     ,@validate-type-consistency-ev
+                     (value ':Type-is-consistent))
+                     (declare (ignorable res))
+                     (if erp ;if error
+                         (prog2$
+                          (er hard ',ctx "~|One or more custom Types used in defdata form are not consistent, i.e. type predicate ~
+                               and corresponding type enumerator are not consistent. Here's the list of events that failed: ~
+                               ~x0 ~%" ',validate-type-consistency-ev)
+                          (mv t nil state))
+                                      
+                       (compute-typecombs ',defs1 ',kwd-options-lst 
+                                          ',(newconstructors ds$)
+                                          ',(support-lemmas ds$)
+                                          ',(custom-types ds$)
+                                          ',(type-class ds$)
+                                          ',ctx (w state) 
+                                          state R$ types-ht$)))
+                    ))) 
+            (mv nil mk-ev-form state ds$))))
+      (mv erp result state))))))
+
+
+#|
+(define-enumeration-type boolean '(t nil))
+(register-data-constructor (consp cons)
+                           ((allp car) (allp cdr))
+                           :proper t)
+
+;(trace$ er-trans-datadef-as-enumerator
+;        er-get-enumeration-info
+;        er-trans-datadef-as-enumerator-lst
+;        )
+
+
+(compute-defdata '((foo (oneof 42 (cons boolean baz)))
+                   (bar (oneof nil
+                               (cons foo bar)))
+                   (moo nil)
+                   (baz (cons boolean moo)))
+                 'top-level (w state) state)
+|#
+
+(defmacro defdata (&rest args)
+  (declare (xargs :guard (and (true-listp args)
+                              (>= (len args) 1)))) ;just (defdata) not allowed
+   ":Doc-Section DATA-DEFINITIONS
+  Specify a data definition ('type')~/
+  
+  The ~c[defdata] macro can be used to specify union and product
+  combinations of 'types'(See :doc data-definitions for what we mean 
+  by a 'type'). In addition to these it provides
+  syntactic sugar to conveniently specify enumeration types,
+  list types and record types. It also supports mutually-recursive
+  data definitions.
+  ~c[oneof] creates a union combination of constituent 'types'.
+  ~c[enum] creates an enumeration type, it can take as arguments
+  any number of acl2 constant expressions. Alternatively you can
+  give it one argument which can be any acl2 expression that
+  evaluates to a list of acl2 constants.
+  You can use any of the built-in constructors like ~c[cons],
+  ~c[/], ~c[complex], ~c[succ] etc, to create product type
+  combinations. See examples below.
+  ~c[record] is a syntactic sugar for the fore-mentioned 
+  product type combination. It creates a new constructor with the
+  same name as the type being defined and it 
+  also creates the destructor/selector functions for you in
+  addition to the predicate and enumerator as mentioned in :doc
+  data-definitions. 
+  ~c[(listof T)] is syntactic sugar for ~c[(oneof nil (cons T <typeId>))].
+  ~c[enum], ~c[record] and ~c[listof] cannot be nested and are normally
+  used seperately at the top-level. For complex nested type combinations
+  just use the regular union, product combination as described above.
+  Remember that each successful ~c[(defdata T ...)] will generate for you two
+  functions ~c[Tp] and either ~c[nth-T] or ~c[*T-values*] depending on 
+  wether ~c[T] is infinite or finite. As mentioned in :doc data-definitions
+  all acl2 data objects are treated as singleton 'types' and can be used
+  in any ~c[defdata] form. 
+  
+  ~bv[]
+  Examples:
+  (defdata (int integer))
+  (defdata foo (cons (cons (oneof boolean 'ok) (cons 2 'as))
+                     (oneof (cons int string) (oneof nat pos) 42)))
+  (defdata natural (oneof 0 
+                          (succ natural))
+                          
+  (defdata BorC (oneof boolean character))
+  (defdata foo (oneof (cons integer foo)
+                       integer)) 
+  (defdata loi (listof integer))
+  (defdata lop (listof (oneof (cons boolean nat) integer)))
+  (defdata RGB (enum 'red 'green 'blue))
+  (defdata RGBY (enum (list 'r 'g 'b 'y))
+  (defdata hyperlink (record (protocol . string)
+                             (address . string)
+                             (display . string)))
+  (defdata
+    (bexpr (oneof boolean
+                  (cons boolean bexpr-list)))
+    (bexpr-list (oneof nil
+                       (cons bexpr bexpr-list))))                           
+  (defdata tree (oneof 'Leaf
+                       (node (val . string) (left . tree) (right . tree))))  
+  ~ev[]                      
+  ~bv[]
+  Usage(EBNF format):
+  (defdata <typeId> <dataTypeExpression>)
+  (defdata (<typeId> <dataTypeExpression>)+ ) ;mutually-recursive types
+  where <typeId> := A new identifier/symbol thats not already defined in the world
+        <dataTypeExpression> := <enumTypeExp> | <recordTypeExp> | <listTypeExp> | <constituentTypeExp>
+        <constituentTypeExp> := <typeName> | <singletonTypeExp> | <typeCombinationExp>        
+        <typeName> := name of 'type' as described in :doc data-definitions
+        <singletonTypeExp> :=  acl2 constant expression as described in acl2 book
+        <typeCombinationExp> := <unionTypeExp> | <productTypeExp>
+        <unionTypeExp> := (oneof <constituentTypeExp> <constituentTypeExp>+)
+        <productTypeExp> := (<constructorId> <constituentTypeExp>*) |
+                            (<recordConstructorId> <destructorTypeDeclaration>*)
+        
+        <constructorId> := A defined constructor (see :doc register-data-constructor)                        
+        <recordConstructorId> := A new identifier/symbol thats not already defined in the world
+                                 or an already defined record constructor
+        <destructorTypeDeclaration> := (<destructorId> . <typeName>)
+        <destructorId> := A new identifier/symbol thats not already defined in the world
+                          or a destructor fn corresponding to the record constructor
+        <enumTypeExp> := (enum <singletonTypeExp>+ ) | (enum <acl2-enum-expr>)
+        <acl2-enum-expr> := Any acl2 expression which evaluates to a list of acl2 constants.
+        <listTypeExp> := (listof <constituentTypeExp>)
+        <recordTypeExp> := (record destructorTypeDeclaration*)
+  ~ev[]~/
+  "
+  
+  `(with-output
+    :stack :push
+    :off :all
+    (make-event
+    `(with-output
+      :stack :pop
+      :off ,(cond ((get-acl2s-defdata-debug)
+                    '(summary proof-checker))
+                   ((get-acl2s-defdata-verbose)
+                    '(summary warning! observation warning proof-checker expansion))
+                   (t 
+                    '(warning warning! observation prove 
+                              proof-checker event expansion
+                              summary proof-tree))
+               
+               )
+      :gag-mode ,(if (get-acl2s-defdata-debug) 'nil 't)
+      (make-event
+        (compute-defdata ',',args  ,(get-acl2s-defdata-debug)
+                         ','defdata (w state) state R$ types-ht$)))
+    )))
+
+
+(defun make-subsumes-relation-name (T1 T2)
+  (declare (xargs :guard (and (is-a-variablep T1)
+                              (is-a-variablep T2))))
+  (let* ((str1 (symbol-name T1))
+        (str2 (symbol-name T2))
+        (str11 (string-append str1 "-IS-SUBTYPE-OF-"))
+        (str (string-append str11 str2)))
+    (intern$ str "DEFDATA")))
+
+(defun make-disjoint-relation-name (T1 T2)
+  (declare (xargs :guard (and (is-a-variablep T1)
+                              (is-a-variablep T2))))
+  (let* ((str1 (symbol-name T1))
+         (str2 (symbol-name T2))
+         (str11 (string-append str1 "-IS-DISJOINT-WITH-"))
+         (str (string-append str11 str2)))
+    (intern$ str "DEFDATA")))
+
+#||
+(defun allp (x)
+  (or (atom x)
+      (consp x)))
+
+(defthm allp-is-tau-predicate
+  (booleanp (allp x))
+  :rule-classes :tau-system)
+
+;; (defthm allp-is-t
+;;   (equal (allp x) t)
+;;   :rule-classes (:rewrite))
+
+;; (in-theory (disable allp))
+
+(defun atomp (x) (atom x))
+
+(defthm atomp-is-tau-predicate
+  (booleanp (atomp x))
+  :rule-classes :tau-system)
+
+(DEFTHM ATOM-is-disjoint-with-CONS
+  (IMPLIES (ATOM X) (NOT (CONSP X)))
+  :rule-classes :tau-system)
+
+(defthm atom-subtype-all
+  (implies (atom x) (allp x))
+  :rule-classes :tau-system)
+
+(defthm cons-subtype-all
+  (implies (consp x) (allp x))
+  :rule-classes :tau-system)
+
+BUT replacing atom with atomp in last 3 defthms fails.
+
+Note that J specifically precludes predicates that are
+constant-everywhere in tau-system.
+||# 
+
+(defun compute-defdata-relation (T1 T2 hints rule-classes otf-flg doc ctx wrld R$ types-ht$)
+  (declare (xargs :mode :program :stobjs (R$ types-ht$)
+                  :guard (and (is-a-variablep T1)
+                              (is-a-variablep T2)
+                              (keyword-listp rule-classes)
+                              (R$p2 (rgraph-length R$) R$)
+                              (types-ht$p types-ht$)
+                              (vertex-ht-valid-p T1 (rgraph-length R$) types-ht$)
+                              (vertex-ht-valid-p T2 (rgraph-length R$) types-ht$)
+                              )))
+  (b* ((T1p (get-predicate-symbol T1))
+       (T2p (get-predicate-symbol T2))
+       ((unless (and (is-a-typeName T1 wrld)
+                     (is-a-typeName T2 wrld)))
+;if not existing typenames raise error
+        (er hard ctx  "~|One of ~x0 and ~x1 is not a defined type!~%" T1 T2))
+       
+;; ((when (and rule-classes
+;;                    (or (eq T1 'ACL2::ALL)
+;;                        (eq T2 'ACL2::ALL))))
+;; ;if not existing typenames raise error
+;;         (er hard ctx  "~|Subtype/disjoint relation not allowed on predicate ALL with non-empty rule-classes~%"))
+       (rule-classes (if (or (is-subtype$$ 'ACL2::ALL T1 R$ types-ht$)
+                             (is-subtype$$ 'ACL2::ALL T2 R$ types-ht$))
+                         '() 
+; force not to be a tau-rule bcos tau complains
+                          rule-classes))
+       ((when (or (and (eq ctx 'defdata-disjoint)
+                       (is-disjoint$$ T1 T2 R$ types-ht$))
+                  (and (eq ctx 'defdata-subtype)
+                       (is-subtype$$ T1 T2 R$ types-ht$))))
+          '(value-triple :redundant))
+       (form (if (eq ctx 'defdata-disjoint)
+                 `(implies (,T1p x) (not (,T2p x)))
+               `(implies (,T1p x) (,T2p x))))
+       (nm (if (eq ctx 'defdata-disjoint)
+               (make-disjoint-relation-name T1 T2)
+             (make-subsumes-relation-name T1 T2)))
+
+;27 june 13 - aborted a hack to enable non-rec preds
+       ;; (types-info-table (table-alist 'types-info-table wrld))
+       ;; (ti1 (cdr (assoc-eq T1 types-info-table)))
+       ;; (?non-recursive1? (and (acl2::access types-info% ti1 :derivedp)
+       ;;                       (not (acl2::access types-info% ti1 :recursivep))))
+       ;; (ti1 (cdr (assoc-eq T1 types-info-table)))
+       ;; (?non-recursive2? (and (acl2::access types-info% ti2 :derivedp)
+       ;;                       (not (acl2::access types-info% ti2 :recursivep))))
+       ;; (enable-names '())
+       ;; (enable-names (if non-recursive1? (cons T1p enable-names) enable-names))
+       ;; (enable-names (if non-recursive2? (cons T2p enable-names) enable-names))
+       ;; (hints (append `((:in-theory (enable (,(if 
+
+       (event-form `((defthm ,nm
+                       ,form
+                       :hints ,hints
+                       :rule-classes ,rule-classes
+                       :otf-flg ,otf-flg
+                       :doc ,doc)))
+       (ev-form-to-print `(defthm ,nm
+                            ,form 
+                            ,@(and hints
+                                   `((:hints ,hints)))
+                            ,@(and rule-classes
+                                  `((:rule-classes ,rule-classes)))))
+
+       (- (cw "~|Submitting ~x0~|" ev-form-to-print)))
+           
+      ;; `(make-event 
+      ;;   (er-progn
+      ;;    ,@ (and (null rule-classes)
+      ;;            event-form)
+      ;;       (let ((T1 ',T1)
+      ;;             (T2 ',T2)
+      ;;             (ctx ',ctx)
+      ;;             (rule-classes ',rule-classes)
+      ;;             (event-form ',event-form))
+      ;;       (value
+             `(progn
+;macros call so dont need quotes
+                ,@event-form
+                ,(if (eq ctx 'defdata::defdata-disjoint)
+                     ;`(add-edge-to-disjoint-graph-batch ,T1 ,T2)
+                     `(add-edge-event :disjoint ,T1 ,T2)
+                   ;`(add-edge-to-subtype-graph-batch ,T1 ,T2)
+                   `(add-edge-event :subtype ,T1 ,T2))
+        ;        (sync-globals-for-dtg)
+                (value-triple :success))))
+
+;; (defun compute-defdata-subtype (T1 T2 state rule-classes hints otf-flg doc)
+;;   (declare (xargs :stobjs (state)
+;;                   :mode :program
+;;                   :guard (and (is-a-variablep T1)
+;;                               (is-a-variablep T2)
+;;                               (keyword-listp rule-classes)
+;;                               )))
+;;   (let* ((T1p (get-predicate-symbol T1))
+;;          (T2p (get-predicate-symbol T2))
+;;          (rule-classes (union-eq rule-classes '(:tau-system)))
+;;          (name (make-subsumes-relation-name T1 T2)))
+;;     (if (and (is-a-typeName T1 (w state))
+;;              (is-a-typeName T2 (w state))) ;if not existing typenames raise error
+;;       (let ((form `(implies (,T1p x) (,T2p x))))
+;;         (mv-let (erp res state)
+;;                 (acl2::thm-fn form state hints otf-flg doc)
+;;                 (declare (ignore res))
+;;                 (if erp
+;;                   (er soft 'defdata-subtype "Failed to prove subtype relation: ~x0 ~%" form)
+;;                   (value `(progn
+;;                             (defthm ,name ,form
+;;                                  :rule-classes ,rule-classes
+;;                                  :hints ,hints 
+;;                                  :otf-flg ,otf-flg :doc ,doc)
+;;                             (add-edge-to-subtype-graph-batch ,T1 ,T2);macro calls so dont need quotes
+;;                             (sync-globals-for-dtg)
+;;                             (value-triple :defdata-subtype-success))))))
+;;       (er soft 'defdata-subtype "One of ~x0 and ~x1 is not a defined type!~%" T1 T2))))
+
+
+(defmacro defdata-subtype (T1 T2 
+                              &key (rule-classes '(:tau-system)) 
+                              hints otf-flg doc)
+  (declare (xargs :guard (and (is-a-variablep T1)
+                              (is-a-variablep T2))))
+  ":Doc-Section DATA-DEFINITIONS
+  Specify a subtype relation between two types~/
+  ~c[(defdata-subtype T1 T2)] tries to prove that the first
+  argument to it T1(which should be a ~st[supported type-name],
+  to check what we mean by that ~pl[data-definitions]) is
+  a subtype of the second argument T2. If the ACL2 is 
+  successful in proving the following conjecture using defthm:
+  ~c[(implies (T1p x) (T2p x))] then this information
+  is stored in a internal subtype data type graph, where
+  we perform closure of the subtype relation. Henceforth
+  one can just call ~c[(subtype-p T1 T2)] to get an 
+  affirmative which is just a lookup instead of calls
+  to the ACL2 theorem prover. And note that once you submit
+  ~c[(defdata-subtype boolean symbol)] and ~c[(defdata-subtype symbol atom)]
+  successfully, you can call ~c[(subtype-p boolean atom)] and because we
+  closed the subtype relation, we know that if T1 is a subtype
+  of T2 and T2 is a subtype of T3, then T1 is also a subtype of
+  T3 and we get back an affirmative answer, i.e ~c[t].
+  If the rule-classes is not explicitly given, the
+  default is to use (:tau-system).
+  ~bv[]
+   Examples:
+   (defdata-subtype boolean symbol)
+   (defdata-subtype pos nat)
+   (defdata-subtype integer acl2-number)
+  ~ev[]                      
+  ~bv[]
+   Usage:
+    (defdata-subtype <Type-name1> <Type-name2> 
+                     &key rule-classes hints otf-flag doc)
+  ~ev[]~/
+  "
+  
+  `(with-output
+    :stack :push
+    :off :all
+    (make-event
+     `(with-output
+       :stack :pop
+       :off ,(cond ((get-acl2s-defdata-debug)
+                    'acl2::proof-checker)
+                   ((get-acl2s-defdata-verbose)
+                    '(warning! observation warning acl2::proof-checker event acl2::expansion))
+                   (t 
+                    '(warning warning! observation prove acl2::proof-checker event acl2::expansion
+                             summary proof-tree))
+               
+               )
+       :gag-mode ,(if (get-acl2s-defdata-debug) 'nil 't)
+       (make-event
+        (compute-defdata-relation ',',T1 ',',T2  
+                                 ',',hints ',',rule-classes ',',otf-flg ',',doc
+                                 'defdata::defdata-subtype (w state) R$ types-ht$)
+        ))
+     )))
+        ;(compute-defdata-subtype ',',T1 ',',T2 state ',',hints ',',otf-flg ',',doc))))))
+
+  
+;Note: Its good practice to use ctx,  otherwise u make copy-paste mistakes
+
+ 
+ 
+(defmacro defdata-disjoint (T1 T2 
+                               &key (rule-classes '(:tau-system))
+                               hints otf-flg doc)
+  (declare (xargs :guard (and (is-a-variablep T1)
+                              (is-a-variablep T2)
+                              (keyword-listp rule-classes))))
+  ":Doc-Section DATA-DEFINITIONS
+  Specify a disjoint relation between two types~/
+  ~c[(defdata-disjoint T1 T2)] tries to prove that the first
+  argument to it T1(which should be a ~st[supported type-name],
+  to check what we mean by that ~pl[data-definitions]) is
+  disjoint with the second argument T2. If the ACL2 is 
+  successful in proving the conjecture using defthm:
+  ~c[(implies (T1p x) (not (T2p x)))] then this information is
+  stored in a internal disjoint data type graph, where
+  we perform closure of the disjoint relation. Henceforth
+  one can just call ~c[(disjoint-p T1 T2)] to get an 
+  affirmative which is just a lookup instead of calls
+  to the ACL2 theorem prover. And note that once you submit
+  ~c[(defdata-disjoint acl2-number symbol)] successfully,
+  you can call ~c[(disjoint-p nat boolean)] and because we
+  closed the disjoint relation, we know that all subtypes
+  of disjoint types are pairwise disjoint and we get back
+  an affirmative , i.e ~c[t]. 
+  If the rule-classes is not explicitly given, the
+  default is to use (:tau-system).
+  ~bv[]
+  Examples:
+  (defdata-disjoint cons atom)
+  (defdata-disjoint character string)
+  (defdata-disjoint integer complex :rule-classes nil)
+  ~ev[]                      
+  ~bv[]
+  Usage:
+  (defdata-disjoint <Type-name1> <Type-name2>
+                    &key rule-classes hints otf-flag doc)
+  ~ev[]~/
+  "
+  `(with-output
+    :stack :push
+    :off :all
+    (make-event
+     `(with-output
+       :stack :pop
+       :off ,(cond ((get-acl2s-defdata-debug)
+                    'proof-checker)
+                   ((get-acl2s-defdata-verbose)
+                    '(warning! observation warning 
+                               proof-checker event expansion))
+                   (t 
+                    '(warning warning! observation prove
+                              proof-checker event expansion
+                              summary proof-tree))
+               
+               )
+       :gag-mode ,(if (get-acl2s-defdata-debug) 'nil 't)
+       (make-event 
+        (compute-defdata-relation ',',T1 ',',T2  
+                                  ',',hints ',',rule-classes',',otf-flg ',',doc
+                                  'defdata::defdata-disjoint (w state) R$ types-ht$)
+        ))
+     )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;---------------------Debugging Space below ------------------------------------------; 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+#|
+;:set-ignore-ok t
+(logic)
+
+(trace$ list-calls-union-constituent-is-subtype-aux filter-typeName)
+(defdata::cons-up-add-edge-union-constituent-is-subtype 
+  '((UX (oneof (cons boolean nat)
+              nat
+              pos
+              (cons nat nat)
+              (oneof pos neg)))
+    (RX (oneof UX (cons boolean RX) string)))
+  '(UX RX) state)
+
+(defun acl2::nth-integer (n)
+  (declare (xargs :guard (natp n)))
+  (let ((mag (floor n 2))
+        (sign (rem n 2)))
+    (if (= sign 0)
+      mag
+      (- -1 mag))))
+
+(register-data-constructor (consp cons)
+                           ((allp car) (allp cdr))
+                           :proper t)
+
+
+(define-enumeration-type boolean '(t nil))
+
+(set-verify-guards-eagerness 0)
+
+(trace$ er-trans-datadef-as-enumerator-lst)
+
+
+(DEFDATA::COMPUTE-DEFDATA '(WOO (list (ONEOF BOOLEAN 'OK)
+                                      (CONS 2 'AS)
+                                      (ONEOF (CONS integer integer)
+                                             (ONEOF integer integer)
+                                             woo)
+                                                ))
+                          'DEFDATA
+                          (W STATE)
+                          STATE)                 
+(ER-TRANS-DATADEF-AS-ENUM-new-LST '((LIST (ONEOF BOOLEAN 'OK)
+                                              (CONS 2 'AS)
+                                              (ONEOF (CONS INTEGER INTEGER)
+                                                     (ONEOF INTEGER INTEGER)
+                                                     WOO)))
+                                       'NIL '(NTH-WOO)
+                                       0 'DEFDATA (w state)
+                                       state)
+
+
+
+
+;given (/ (numerator denominator) rationalp) is constructor
+;defs & theorems for this defdata:
+
+(thm
+ (implies (and (integerp i)
+                (posp p))
+          (and
+           (rationalp (/ i p))
+           (integerp (numerator (/ i p)))
+           (posp   (denominator (/ i p))))))
+           
+(defun my-rationalp (x)
+  (and (rationalp x)
+       (integerp (numerator x))
+       (posp (denominator x))))
+
+(defun nth-my-rational (n)
+  (let* ((pair (split-nat n))
+         (a (nth-integer (car pair)))
+         (b (nth-pos (cdr pair))))
+    (/ a b)))
+
+
+(defdata
+     (coo integer  
+             :hints (:in-theory (set-difference-theories (current-theory :here) '(assoc))
+                     :use ((:instance assoc-of-append (x a) (y b) (z c))))
+             :otf-flg t))
+
+      
+
+(defexec succ (x)
+  (declare (xargs :guard (natp x)))
+  (mbe :logic
+       (if (natp x)
+         (1+ x)
+         1)
+       :exec (1+ x)))
+
+(defun pred (x)
+  (declare (xargs :guard (natp x)))
+  (if (zp x)
+    0
+    (1- x)))
+
+(defthm succ-pred
+  (implies (posp x)
+           (equal (succ (pred x)) x)))
+
+(register-data-constructor (posp succ)
+
+
+
+(defdata
+  (my-rational (/ integer pos)))
+
+
+(defdata
+  (tm (listof
+       (cons all
+             (listof tm-action))))
+  (tm-action (list (field cursym all)
+                   (field nextstate all)
+                   (field newsym all)
+                   (field direction boolean))))
+|#
diff -Nru acl2-6.2/books/cgen/elim.lisp acl2-6.3/books/cgen/elim.lisp
--- acl2-6.2/books/cgen/elim.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/elim.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,206 @@
+#|$ACL2s-Preamble$;
+;;Author - Harsh Raju Chamarthi (harshrc)
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(begin-book t);$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+(include-book "tools/bstar" :dir :system)
+
+; On-demand dest-elim of record/map/list types
+
+; To each record/map/list type we will add its elim rule to a elim-table. This
+; is done in register-record-constructor. Instead of adding an elim rule for
+; each destructor fn we will add just one and change the :destructor-term field
+; in the call to get-record/list-elim-rule fn.
+
+; In test-checkpoint when we are at push-clause ledge, we will do one csearch
+; and if no cts were found, we will check if there is a variable which is of
+; type record, list, map etc. If yes, we will call
+; eliminate-destructors-clause1-noiter-cgen fn with this type and do on-demand
+; destructor elimination, getting back a new clause which we will csearch. We
+; will iterate till we find no more record types. List and map types need more
+; subtlety, since they can loop if we iterate in the above manner.
+
+;  Because the new dest-elimed clause has unsimplified hyps from
+;  generalize rules, we do simplify-hyps before calling
+;  cts-wts-search. This is important, because otherwise the type
+;  information for fields is not correctly restricted in hyps and we
+;  dont benefits of test data generation from defdata types.
+
+  
+(mutual-recursion
+(defun find-destructor-term (e eliminable destructor-fns)
+  (declare (xargs :guard (and (pseudo-termp e)
+                              (symbolp eliminable)
+                              (symbol-listp destructor-fns))))
+  (cond ((variablep e) nil)
+        ((fquotep e) nil)
+        (t (if (and (member-eq (ffn-symb e) destructor-fns)
+                    (eq eliminable (third e)))
+               e
+             (find-destructor-term-lst (fargs e) eliminable destructor-fns)))))
+
+(defun find-destructor-term-lst (es eliminable destructor-fns)
+  "find a subterm in clause thats a record destructor term (destr-fn field eliminable)"
+  (declare (xargs :guard (and (pseudo-term-listp es)
+                              (symbolp eliminable)
+                              (symbol-listp destructor-fns))))
+  (if (endp es)
+      nil
+    (b* ((s (find-destructor-term (car es) eliminable destructor-fns)))
+      (if s
+          s
+        (find-destructor-term-lst (cdr es) eliminable destructor-fns)))))
+)        
+
+;comparison shud be total. lesson!
+(defun order-two-eliminables (x1 x2 es)
+  "x1 <= x2 if dest-term of x1 occurs inside an dest-term of x2, or if neither occur in each other"
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbolp x1)
+                              (symbolp x2)
+                              (pseudo-term-listp es))))
+  (b* ((destructor-fns '(mget))
+       (dt2 (find-destructor-term-lst es x2 destructor-fns)))
+    (if dt2
+        (find-destructor-term (cadr dt2) x1 destructor-fns)
+      (b* ((dt1 (find-destructor-term-lst es x1 destructor-fns)))
+        (if dt1
+            (not (find-destructor-term (cadr dt1) x2 destructor-fns))
+            t)))))
+          
+
+(defun merge-car-order-elim (l1 l2 cl)
+  (declare (xargs :measure (+ (acl2-count l1) (acl2-count l2))))
+  ;; (declare (xargs :guard (and (symbol-alistp l1)
+  ;;                             (symbol-alistp l2)
+  ;;                             (pseudo-term-listp cl))))
+  (cond ((endp l1) l2)
+        ((endp l2) l1)
+        ((order-two-eliminables (car (car l1)) (car (car l2)) cl)
+         (cons (car l1)
+               (merge-car-order-elim (cdr l1) l2 cl)))
+        (t (cons (car l2)
+                 (merge-car-order-elim l1 (cdr l2) cl)))))
+
+(defthm acl2-count-evens-strong
+  (implies (and (consp x)
+                (consp (cdr x)))
+           (< (acl2-count (evens x)) (acl2-count x)))
+  :rule-classes :linear)
+
+(defthm acl2-count-evens-weak
+  (<= (acl2-count (evens x)) (acl2-count x))
+  :hints (("Goal" :induct (evens x)))
+  :rule-classes :linear)
+
+
+(defun merge-sort-eliminables-alst (E cl)
+  ;; (declare (xargs :guard (and (symbol-alistp E)
+  ;;                             (pseudo-term-listp cl))))
+  (if (or (endp E) (endp (cdr E)))
+      E
+    (merge-car-order-elim (merge-sort-eliminables-alst (evens E) cl)
+                          (merge-sort-eliminables-alst (odds E) cl)
+                          cl)))
+      
+        
+    
+
+(defun get-record/map-elim-rule (type eliminable clause wrld)
+  (declare (xargs :verify-guards nil
+                  :guard (and (pseudo-term-listp clause)
+                              (symbolp type)
+                              (symbolp eliminable)
+                              (plist-worldp wrld))))
+  (b* ((tbl (table-alist 'record-elim-table wrld))
+       (entry (assoc-equal type tbl)))
+    (if (consp entry)
+        (b* ((rule (cdr entry))
+             (dterm (find-destructor-term-lst clause eliminable '(acl2::mget)))
+             ((when (null dterm)) (mv nil nil))
+             (destructor-term (subst 'x eliminable dterm)))
+          (mv (acl2::change acl2::elim-rule rule :destructor-term destructor-term) dterm))
+      (b* ((tbl (table-alist 'map-elim-table wrld))
+           (entry (assoc-equal type tbl)))
+        (if (consp entry)
+            (b* ((rule (cdr entry))
+                 (dterm (find-destructor-term-lst clause eliminable '(acl2::mget)))
+                 ((when (null dterm)) (mv nil nil)))
+              (mv rule dterm))
+          (mv nil nil))))))
+
+
+       
+(defun delete-quoted-keys (alist)
+  (if (endp alist)
+      '()
+    (if (quotep (caar alist))
+        (delete-quoted-keys (cdr alist))
+      (cons (car alist) (delete-quoted-keys (cdr alist))))))
+
+(defun select-instantiated-elim-rule-cgen (type eliminable clause wrld)
+
+; type is the type of the variable eliminable that we wish to eliminate.
+; Clause is a clause to which we wish to apply destructor elimination.
+; Type-alist is the type-alist obtained by assuming all literals of cl nil.
+
+; Return an instantiated version of the elim-rule corresponding to dterm
+
+  (b* (((mv rule dterm) (get-record/map-elim-rule type eliminable clause wrld))
+       ((when (null rule)) nil)
+       (alist (pairlis$ (fargs (acl2::access acl2::elim-rule rule :destructor-term))
+                        (fargs dterm)))
+       (alist (delete-quoted-keys alist))
+       )
+    (acl2::change acl2::elim-rule rule
+                  :hyps (acl2::sublis-var-lst alist (acl2::access acl2::elim-rule rule :hyps))
+                  :lhs  (acl2::sublis-var alist (acl2::access acl2::elim-rule rule :lhs))
+                  :rhs  (acl2::sublis-var alist (acl2::access acl2::elim-rule rule :rhs))
+                  :destructor-term
+                  (acl2::sublis-var alist (acl2::access acl2::elim-rule rule :destructor-term))
+                  :destructor-terms
+                  (acl2::sublis-var-lst
+                   alist
+                   (acl2::access acl2::elim-rule rule :destructor-terms)))))
+
+(defun eliminate-destructors-clause1-cgen (eliminable type cl avoid-vars ens wrld)
+  (declare (xargs :mode :program))
+; Cl is a clause we are trying to prove. type is the type of the variable eliminable
+; on which we will permit a destructor elimination.  Avoid-vars is a list of
+; variable names we are to avoid when generating new names.  In addition, we
+; avoid the variables in cl. Given the eliminable destructor we get its
+; instantiated rule, apply the rule to cl to produce the "normal" elim case.
+
+
+; We return 4 things.  The first is the clauses to test instead of cl.
+; The second is the set of variable names introduced by this
+; destructor elimination step.  The third is an "elim-sequence" that
+; documents this step.  If the list is nil, it means we did
+; nothing. fourth is the elim-rule selected, which is null if none is
+; applicable
+
+; 20 July 2013 - returning the new clause instead of return-clauses!
+
+  (mv-let
+   (contradictionp type-alist ttree)
+   (acl2::type-alist-clause cl nil
+                       nil ; force-flg; see comment above
+                       nil ens wrld
+                       nil nil)
+   (declare (ignore ttree))
+   (if contradictionp 
+       (mv (list cl) nil nil nil)
+     (b* ((rule (select-instantiated-elim-rule-cgen type eliminable cl wrld))
+          )
+       (if (null rule) 
+           (mv (list cl) nil nil nil)
+         (b* (((mv new-clause new-vars ele)
+               (acl2::apply-instantiated-elim-rule rule cl type-alist avoid-vars ens wrld))
+              (?clauses1 (acl2::split-on-assumptions (acl2::access acl2::elim-rule rule :hyps)
+                                              new-clause nil))
+              (?return-clauses (acl2::conjoin-clause-sets clauses1 (list new-clause))))
+           (mv new-clause new-vars ele rule)))))))
+              
diff -Nru acl2-6.2/books/cgen/graph-tc.lisp acl2-6.3/books/cgen/graph-tc.lisp
--- acl2-6.2/books/cgen/graph-tc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/graph-tc.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,1204 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+
+(acl2::begin-book t :ttags ((:hash-stobjs) (:redef+)));$ACL2s-Preamble$|#
+
+(in-package "DEFDATA")
+
+(include-book "tools/bstar" :dir :system)
+
+(include-book "add-ons/hash-stobjs" :dir :system :ttags ((:hash-stobjs) (:redef+)))
+; key: type name (symbolp)
+; value: vertex
+;;   - vertex is the index of key into adjacency list array rgraph
+
+(defstobj types-ht$
+  (types-count :type (integer 0 *) :initially 0)
+  (type-vertex-ht :type (hash-table eql)) ;symbols
+  )
+
+
+;; (defdata aa-tree (oneof nil 
+;;                         (node (key . rational)
+;;                               (level . nat)
+;;                               (left . aa-tree)
+;;                               (right . aa-tree))))
+
+(include-book "library-support")
+
+(defun aa-treep (v)
+  (declare (xargs :guard T))
+  (if (atom v)
+      (null v)
+    (and (acl2::good-map v)
+         (rationalp (mget :key v))
+         (natp (mget :level v))
+         (aa-treep (mget :left v))
+         (aa-treep (mget :right v)))))
+
+(defun node (key level left right)
+  (declare (xargs :guard (and (rationalp key)
+                              (natp level)
+                              (aa-treep left)
+                              (aa-treep right))))
+  (mset :key key
+        (mset :level level
+              (mset :left left
+                    (mset :right right nil)))))
+
+;; (defthm node-sig
+;;   (implies (and (rationalp key)
+;;                 (natp level)
+;;                 (aa-treep left)
+;;                 (aa-treep right))
+;;            (aa-treep (node key level left right)))
+;;   :hints (("goal" :use 
+;;            ((:instance field-not-empty-implies-record-not-empty1
+;;                        (a :key) 
+;;                        (x (MSET :KEY KEY
+;;                                 (MSET :LEFT LEFT
+;;                                       (MSET :LEVEL
+;;                                             LEVEL (MSET :RIGHT RIGHT NIL))))))))))
+    
+;(in-theory (disable node))       
+
+(defthm aa-tree-fields-type
+  (implies (and (aa-treep v)
+                v)
+           (and (rationalp (mget :key v))
+                (natp (mget :level v))
+                (aa-treep (mget :left v))
+                (aa-treep (mget :right v))))
+  :rule-classes (:rewrite :forward-chaining))
+
+(defthm aa-tree-imples-good-map
+  (implies (aa-treep v)
+           (acl2::good-map v))
+  :rule-classes :forward-chaining)
+
+(defun wf-aa-treep (tree)
+  (declare (xargs :guard T))
+  (if (null tree)
+      t
+    (and (aa-treep tree)
+         (let ((n (mget :level tree))
+               (l (mget :left tree))
+               (r (mget :right tree)))
+           (if (null l)
+               (and (equal 1 n)
+                    (or (null r)
+                        (and (equal 1 (mget :level r))
+                             (null (mget :left r))
+                             (null (mget :right r)))))
+             (and (wf-aa-treep l)
+                  (wf-aa-treep r)
+                  (not (null r))
+                  (< (mget :level l) n)
+                  (<= (mget :level r) n)
+                  (mget :right r)
+                  (< (mget :level (mget :right r)) n)))))))
+
+(defun skew (tree)
+  (declare (xargs :guard (aa-treep tree)))
+  (if (null tree)
+    tree
+    (if (and (mget :left tree) ;guard
+             (= (mget :level (mget :left tree)) (mget :level tree)))
+      ;;rotate right
+      (let ((ltree (mget :left tree))
+            (rtree (mget :right tree)))
+        (node (mget :key ltree)
+              (mget :level ltree)
+              (mget :left ltree)
+              (node (mget :key tree)
+                    (mget :level tree)
+                    (mget :right ltree)
+                    rtree)))
+      tree)))
+
+(defun split (tree)
+  (declare (xargs :guard (aa-treep tree)))
+  (if (null tree)
+    tree
+    (if (and (mget :right tree) ;guard
+             (mget :right (mget :right tree)) ;guard
+             (<= (mget :level tree)
+                 (mget :level (mget :right (mget :right tree)))))
+      ;;rotate left
+      (let* ((rtree (mget :right tree))
+             (rrtree (mget :right rtree)))
+        (node (mget :key rtree)
+              (1+ (mget :level rtree))
+              (node (mget :key tree)
+                    (mget :level tree)
+                    (mget :left tree)
+                    (mget :left rtree))
+              rrtree))
+      tree)))
+
+(defthm skew-sig
+  (implies (aa-treep v)
+           (aa-treep (skew v))))
+
+(defthm skew-wf
+  (implies (and (aa-treep v)
+                (wf-aa-treep v))
+           (equal (skew v) v)))
+
+
+(defthm split-sig
+  (implies (aa-treep v)
+           (aa-treep (split v))))
+
+
+
+(defthm split-wf
+  (implies (and (aa-treep v)
+                (wf-aa-treep v))
+           (equal (split v) v)))
+
+(defun insert (e tree)
+  (declare (xargs :verify-guards nil
+                  :guard (and (rationalp e)
+                              (aa-treep tree))))
+  (if (or (null tree)
+          (not (aa-treep tree))) ;termination
+    (node e 1 nil nil)
+    (if (equal e (mget :key tree))
+      tree
+      (let ((newtree (if (< e (mget :key tree))
+                       (mset :left 
+                             (insert e (mget :left tree))
+                             tree)
+                       (mset :right
+                             (insert e (mget :right tree))
+                             tree))))
+        (split (skew newtree))))))
+
+
+
+;This took a few hours. Its strange that an extra hypothesis
+;was obstructing a proof. e.g (acl2::good-map v) was killing
+;(acl2::good-map (mset a x v)) because of mset-preserves-acl2::good-map
+(defthm insert-sig-supporting-lemma
+ (IMPLIES (AND (ACL2::GOOD-MAP V)
+               (not (equal a (acl2::ill-formed-key)))
+;(ACL2::GOOD-MAP (MSET a x V))
+               (MSET a x V))
+          (CONSP (MSET a x V)))
+ :hints (("goal" :cases ((ACL2::GOOD-MAP (MSET a x V))))
+         ("Subgoal 1'" :in-theory (e/d () (acl2::MSET-PRESERVES-GOOD-MAP)))))
+
+(in-theory (disable skew split)) 
+
+
+(defthm insert-sig-lemma2
+  (implies (and (aa-treep v)
+                (consp v)
+                (aa-treep x))
+           (and (aa-treep (mset :left x v))
+                (aa-treep (mset :right x v)))))
+
+(defthm insert-sig
+  (implies (and (rationalp e)
+                (aa-treep v))
+           (aa-treep (insert e v))))
+
+(verify-guards insert)
+
+(defun R-index-p (x N)
+  (declare (xargs :guard T))
+  (and (natp x)
+       (< x (nfix N))))
+
+(defun R-index-listp (x N)
+  (declare (xargs :guard T))
+  (if (atom x)
+      (null x)
+    (and (R-index-p (car x) N)
+         (R-index-listp (cdr x) (nfix N)))))
+
+(defthm R-index-listp-implies-true-listp
+  (implies (R-index-listp x N)
+           (true-listp x))
+  :rule-classes :forward-chaining)
+
+(defun aa-treep2 (v N)
+  (declare (xargs :guard T))
+  (if (atom v)
+      (null v)
+    (and (acl2::good-map v)
+         (R-index-p (mget :key v) N)
+         (natp (mget :level v))
+         (aa-treep2 (mget :left v) N)
+         (aa-treep2 (mget :right v) N))))
+
+(in-theory (enable skew split))
+
+(defthm skew-sig2
+  (implies (aa-treep2 v N)
+           (aa-treep2 (skew v) N)))
+
+
+(defthm split-sig2
+  (implies (aa-treep2 v N)
+           (aa-treep2 (split v) N)))
+
+(defthm insert-sig-lemma2-sp
+  (implies (and (aa-treep2 v N)
+                (consp v)
+                (aa-treep2 x N))
+           (and (aa-treep2 (mset :left x v) N)
+                (aa-treep2 (mset :right x v) N))))
+
+(in-theory (disable skew split))
+
+(defthm insert-sig-specialized
+  (implies (and (R-index-p e N)
+                (aa-treep2 v N))
+           (aa-treep2 (insert e v) N)))
+
+;; (defthm insert-wf-aa-tree
+;;   (implies (and (aa-treep tr);type hyp
+;;                 (rationalp n);type hyp
+;;                 (wf-aa-treep tr));constraint
+;;            (wf-aa-treep (insert n tr))))
+
+
+(defun insert-list (es tree)
+  (declare (xargs :guard (and (rational-listp es)
+                              (aa-treep tree))))
+  (if (endp es)
+      tree
+    (insert-list (cdr es)
+                 (insert (car es) tree))))
+
+(defthm insert-list-sig
+  (implies (and (rational-listp es)
+                (aa-treep v))
+           (aa-treep (insert-list es v))))
+
+(defthm insert-list-sig-specialized
+  (implies (and (R-index-listp es N)
+                (aa-treep2 v N))
+           (aa-treep2 (insert-list es v) N)))
+
+;what is its complexity?
+(defun aa-tree-to-list (tree)
+  "convert tree to sorted list"
+  (declare (xargs :guard (aa-treep tree)))
+  (if (endp tree)
+      nil
+    (b* ((L (aa-tree-to-list (mget :left tree)))
+         (R (aa-tree-to-list (mget :right tree)))
+         (key (mget :key tree)))
+      (append L (cons key R)))))
+         
+(defthm aa-tree-to-list-sig
+  (implies (aa-treep tree)
+           (rational-listp (aa-tree-to-list tree))))
+
+;parameterized types would help here
+(defthm append-R-index-listp
+  (implies (and (R-index-listp x N)
+                (R-index-listp y N))
+           (R-index-listp (append x y) N)))
+
+(defthm aa-tree-to-list-sig-specialized
+  (implies (aa-treep2 tree N)
+           (R-index-listp (aa-tree-to-list tree) N)))
+
+(defun bsearch (key tree)
+  (declare (xargs :guard (and (rationalp key)
+                              (aa-treep tree))))
+  (if (or (null tree)
+          (not (aa-treep tree))) ;termination
+      nil
+    (cond ((< key (mget :key tree)) (bsearch key (mget :left tree)))
+          ((> key (mget :key tree)) (bsearch key (mget :right tree)))
+          (t key))))
+
+
+#||
+(defrec+ rg%
+  ((reachable . unreachable) visited-code typename)
+  :sig (and (nat-listp reachable)
+            (nat-listp unreachable)
+            ;; (or (null representative)
+            ;;     (natp representative))
+            (unsigned-byte-p 32 visited-code)
+            (symbolp typename)
+            ))
+||#
+
+(defrec rg%
+  (visited-code reachable-set can-reach-set unreachable-set typename)
+  nil)
+
+(defconst *undefined-typename* :undef) ;'this-cannot-possibly-be-a-type-name-please-dont-even-think-of-it-no-nooooo)
+
+(defconst *initial-s-adj-val*
+  (acl2::make rg% 
+              :reachable-set nil
+              :can-reach-set nil
+              :unreachable-set nil
+              :visited-code 0
+              :typename *undefined-typename*
+              ))
+
+(defconst *max-unsigned-number* (1- (expt 2 32)))
+(defconst *initial-num-types* 2000)
+(defconst *block-num-types* 500)
+
+
+(defun rg%-p (v)
+  (declare (xargs :guard T))
+  (and 
+   (weak-rg%-p v)
+   (case-match v
+     (('rg% visited-code reachable-set can-reach-set 
+            unreachable-set typename)   
+      (and (natp visited-code)
+           (aa-treep reachable-set)
+           (aa-treep unreachable-set)
+           (aa-treep can-reach-set)
+           (symbolp typename))))))
+
+(defun change-rg% (u% field new)
+  (declare (xargs :guard 
+                  (and (rg%-p u%)
+                       (case field
+                         (:typename (symbolp new))
+                         (:reachable-set (aa-treep new))
+                         (:unreachable-set (aa-treep new))
+                         (:can-reach-set (aa-treep new))
+                         (:visited-code (natp new))
+                         (otherwise nil)))))
+  (mbe :logic
+       (case field
+         (:typename (if (symbolp new)
+                        (acl2::change rg% u% :typename new)
+                      (assert$ nil u%)))
+         (:reachable-set (if (aa-treep new)
+                             (acl2::change rg% u% :reachable-set new)
+                           (assert$ nil u%)))
+         (:unreachable-set (if (aa-treep new)
+                               (acl2::change rg% u% :unreachable-set new)
+                             (assert$ nil u%)))
+         (:can-reach-set (if (aa-treep new)
+                             (acl2::change rg% u% :can-reach-set new)
+                           (assert$ nil u%)))
+         (:visited-code (if (natp new)
+                            (acl2::change rg% u% :visited-code new)
+                          (assert$ nil u%)))
+         (otherwise (assert$ nil u%)))
+       :exec 
+       (case field
+         (:typename (acl2::change rg% u% :typename new))
+         (:reachable-set (acl2::change rg% u% :reachable-set new))
+         (:unreachable-set (acl2::change rg% u% :unreachable-set new))
+         (:can-reach-set (acl2::change rg% u% :can-reach-set new))
+         (:visited-code (acl2::change rg% u% :visited-code new))
+         (otherwise (assert$ nil u%)))))
+                                                 
+(defthm change-rg%-sig
+  (implies (rg%-p u%)
+           (rg%-p (change-rg% u% field new))))
+
+(in-theory (disable weak-rg%-p rg%-p change-rg%))
+              
+
+(defstobj R$
+  (unique-visited-code :type (integer 0 *) :initially 0)
+  (num-types :type (integer 0 *) :initially 0) 
+  (rgraph :type (array (satisfies rg%-p) (*initial-num-types*))
+          :initially (RG% 0 NIL NIL NIL :UNDEF) :resizable t))
+  
+
+
+(defthm rgraphp-implies-true-listp
+  (implies (rgraphp x)
+           (true-listp x))
+  :rule-classes :forward-chaining)
+
+(defthm rgraph-element-type-lemma
+  (implies (and (rgraphp x) 
+                (natp i) 
+                (< i (len x))) 
+           (rg%-p (nth i x))))
+
+(defthm rgraph-element-update-lemma
+  (implies (and (rgraphp x) 
+                (natp i) 
+                (< i (len x))
+                (rg%-p u%))
+           (rgraphp (update-nth i u% x))))
+
+;; (defthm rgraph-element-type
+;;   (implies (and (R$p R$) 
+;;                 (natp i) 
+;;                 (< i (rgraph-length R$))) 
+;;            (weak-rg%-p (rgraphi i R$))))
+
+
+(defthm resize-list-rgraph-sig
+  (implies (and (rgraphp x)
+                (natp n)
+                (rg%-p default))
+           (rgraphp (resize-list x n default))))
+
+;; (defthm resize-graph-sig
+;;   (implies (and (R$p R$) (natp n)) 
+;;            (R$p (resize-rgraph n r$))))
+
+;; (defthm update-numtypes-R$-sig
+;;   (implies (and (R$p R$) (natp n)) 
+;;            (R$p (update-num-types n r$))))
+
+;; (defthm update-numtypes-R$-length-remains-same
+;;   (implies (and (R$p R$) (natp n)) 
+;;            (equal (rgraph-length (update-num-types n r$))
+;;                   (rgraph-length R$))))
+
+
+  
+
+
+
+(defun add-vertex$ (name R$)
+  "Symbol* R$ -> (mv erp new-vertex R$).
+   add new vertex with typename name to graph. 
+   return new vertex u. post-condition (R-index-p u)"
+  (declare (xargs :stobjs (R$)
+                  :guard (and (symbolp name)
+                              (R$p R$))
+                  ;; :guard-hints (("goal" :in-theory 
+                  ;;                (disable rgraphi
+                  ;;                         rgraph-length
+                  ;;                         update-rgraphi
+                  ;;                         resize-rgraph
+                  ;;                         update-num-types
+                  ;;                         change-rg%)))))
+                  ))
+                 
+  (b* ((num-types (num-types R$))
+       (size (rgraph-length R$))
+       (new-num-types (1+ num-types)))
+    (if (< new-num-types size) ;no need to resize
+        (b* ((R$ (update-num-types new-num-types R$))
+             (u new-num-types)
+             (u% (rgraphi u R$))
+             (u% (change-rg% u% :typename name))
+             (R$ (update-rgraphi u u% R$)))
+          (mv nil u R$))
+  
+      (b* ((R$ (update-num-types new-num-types R$))
+           (R$ (resize-rgraph (+ size *block-num-types*) R$))
+           (u new-num-types)
+           ((unless (< u (rgraph-length R$))) (mv t u R$))
+           (u% (rgraphi u R$))
+           (u% (change-rg% u% :typename name))
+           (R$ (update-rgraphi u u% R$)))
+        (mv nil u R$)))))
+
+(in-theory (enable rg%-p))
+
+(defun access-rg% (u% field)
+  (declare (xargs :guard 
+                  (and (rg%-p u%)
+                       (member-eq field 
+                                  '(:typename :reachable-set 
+                                    :unreachable-set :can-reach-set 
+                                    :visited-code)))))
+                
+                         
+  (case field
+         (:typename (acl2::access rg% u% :typename))
+         (:reachable-set (acl2::access rg% u% :reachable-set ))
+         (:unreachable-set (acl2::access rg% u% :unreachable-set ))
+         (:can-reach-set (acl2::access rg% u% :can-reach-set ))
+         (:visited-code (acl2::access rg% u% :visited-code ))
+         (otherwise (assert$ nil field))))
+
+(defthm access-rg%-type
+  (implies (rg%-p u%)
+           (and (symbolp (access-rg% u% :typename))
+                (aa-treep (access-rg% u% :reachable-set))
+                (aa-treep (access-rg% u% :unreachable-set))
+                (aa-treep (access-rg% u% :can-reach-set))
+                (integerp (access-rg% u% :visited-code))
+                (<= 0 (access-rg% u% :visited-code)))))
+
+(in-theory (disable access-rg% rg%-p))
+           
+
+(defun is-subtype$ (u v R$)
+  (declare (xargs :guard (and (R$p R$) ;invariant below
+                              (R-index-p u (rgraph-length R$))
+                              (R-index-p v (rgraph-length R$)))
+                  :guard-hints (("goal" :in-theory (e/d (rg%-p) (rgraphp))))
+                  :stobjs (R$)))
+  ;; (decl :sig ((R-index-p R-index-p R$) -> boolean)
+  ;;       :doc "is v in reach-set of u?")
+  (b* (((when (int= u v)) t)
+       (u% (rgraphi u R$))
+       (u-reach-set (access-rg% u% :reachable-set)))
+    (bsearch v u-reach-set)))
+
+(defun is-disjoint$ (u v R$)
+  (declare (xargs :guard (and (R$p R$)
+                              (R-index-p u (rgraph-length R$))
+                              (R-index-p v (rgraph-length R$)))
+                  :stobjs (R$)))
+  ;; (decl :sig ((R-index-p R-index-p R$) -> boolean)
+  ;;       :doc "is v in unreachable-set of u?")
+  (b* (((when (int= u v)) nil)
+       (u% (rgraphi u R$))
+       (u-unreach-set (access-rg% u% :unreachable-set)))
+    (bsearch v u-unreach-set)))
+
+                   
+
+(defun set-rg%++ (vs field S R$)
+  "field[v] =+ S"
+  (declare (xargs :stobjs (R$)
+                  :guard (and (R$p R$)
+                              (R-index-listp vs (rgraph-length R$))
+                              (aa-treep S)
+                              (member-eq field 
+                                  '(:reachable-set 
+                                    :unreachable-set :can-reach-set 
+                                    )))))
+  (if (endp vs)
+      R$
+    (b* ((v (car vs))
+         (v% (rgraphi v R$))
+         (v-rs (access-rg% v% field))
+         (v-rs (insert-list (aa-tree-to-list S) v-rs))
+         (v% (change-rg% v% field v-rs))
+         (R$ (update-rgraphi v v% R$)))
+      (set-rg%++ (cdr vs) field S R$))))
+
+
+
+
+(defthm set-rg%++-sig1
+  (implies (and (R$p R$)
+                (R-index-listp vs (rgraph-length R$))
+                (aa-treep S))
+           (R$p (set-rg%++ vs field S R$))))
+
+(defthm set-rg%++-sig2
+  (implies (and (R$p R$)
+                (R-index-listp vs (rgraph-length R$))
+                (aa-treep S))
+           (equal (len (nth *rgraphi* (set-rg%++ vs field S R$)))
+                  (len (nth *rgraphi* R$)))))
+
+
+(defthm R-index-listp-implies-nat-listp
+  (implies (R-index-listp x N)
+           (nat-listp x))
+  :rule-classes :forward-chaining)
+
+; pre-cond: G is transitively-closed. 
+; algo: 
+;  for each w in can-reach-set[u] U {u}: reach-set[w] =+ {v} U reach-set[v]
+;  can-reach-set[v] =+ {u} U can-reach-set[u]
+; post-cond: G' is transitively-closed.
+       
+
+;need parameterized type theorem for aa-tree, r-index-p instead of
+;rationalp
+(defun rg%-p2 (v N)
+  (declare (xargs :guard T))
+  (and 
+   (weak-rg%-p v)
+   (case-match v
+     (('rg% visited-code reachable-set can-reach-set 
+            unreachable-set typename)   
+      (and (natp visited-code)
+           (aa-treep2 reachable-set N)
+           (aa-treep2 unreachable-set N)
+           (aa-treep2 can-reach-set N)
+           (symbolp typename))))))
+
+(in-theory (enable access-rg%))
+
+(defthm access-rg%-type2
+  (implies (rg%-p2 u% N)
+           (and (symbolp (access-rg% u% :typename))
+                (aa-treep2 (access-rg% u% :reachable-set) N)
+                (aa-treep2 (access-rg% u% :unreachable-set) N)
+                (aa-treep2 (access-rg% u% :can-reach-set) N)
+                (integerp (access-rg% u% :visited-code))
+                (<= 0 (access-rg% u% :visited-code)))))
+                
+(in-theory (disable access-rg% rg%-p2))
+
+(defun rgraphp2 (x N)
+  (declare (xargs :guard t :verify-guards t))
+  (if (atom x)
+      (equal x nil)
+    (and (rg%-p2 (car x) N)
+         (rgraphp2 (cdr x) N))))
+
+(defun rg%-p2-forall-i (m N R$)
+  (declare (xargs :guard (and (R$p R$)
+                              (natp m)
+                              (natp N)
+                              (<= m N)
+                              (<= N (rgraph-length R$)))
+                  :stobjs (R$)))
+  (if (zp m)
+      t
+    (and (rg%-p2 (rgraphi (1- m) R$) N)
+         (rg%-p2-forall-i (1- m) N R$))))
+
+(defthm rgraphp2-element-type
+  (implies (and (natp i)
+                (< i (len x)) ;if I add N and N<=(len x). fails! ??
+                (rgraphp2 x N)
+                )
+           (rg%-p2 (nth i x) N)))
+                
+                
+(defun take-first (n xs)
+  (declare (xargs :guard (and (natp n) (true-listp xs))))
+  (if (endp xs)
+      nil
+    (if (zp n)
+        nil
+      (cons (car xs)
+            (take-first (1- n) (cdr xs))))))
+
+(encapsulate
+ nil
+ (local (include-book "arithmetic/top" :dir :system))
+ (defthm take-all
+   (implies (true-listp x)
+            (equal (take-first (len x) x)
+                   x))))
+
+(encapsulate 
+ nil
+ (local
+  (progn
+    (defthm what11
+      (IMPLIES (AND (INTEGERP I)
+                    (< 0 I)
+                    (INTEGERP I0)
+                    (<= 0 I0)
+                    (NOT (ZP M))
+                    (<= M I)
+                    (<= 0 M)
+                    (RG%-P2 (NTH I0 (CONS L1 L2)) I)
+                    (RG%-P2 L1 I))
+               (EQUAL (RGRAPHP2 (TAKE-FIRST I0 (CONS L1 L2)) I)
+                      (RGRAPHP2 (TAKE-FIRST I0 L2) I)))
+      :hints (("goal" :cases ((zp i0)))))
+
+
+
+    (defthm what2211
+      (IMPLIES (AND ;(natp N)
+                (natp j)
+                (natp i)
+                (< j i)
+                (<= i (len L2))
+                (RGRAPHP2 (TAKE-FIRST I L2) N)) 
+               (RG%-P2 (NTH j L2) N)))
+
+;; (defthm what33
+;;   (IMPLIES (AND (natp i)
+;;                 (< j i)
+;;                 (natp j)
+;;                 (rg%-p2-forall-i i N R$))
+;;            (RG%-P2 (nth j (nth *rgraphi* R$)) N)))
+
+    (defthm what33-constrapositive
+      (IMPLIES (AND (natp i)
+                    (< j i)
+                    (natp j)
+                    (not (RG%-P2 (nth j (nth *rgraphi* R$)) N))
+                    )
+               (not (rg%-p2-forall-i i N R$))))
+
+    (defthm subgoal-*1/6.1
+      (IMPLIES (AND (CONSP (NTH *RGRAPHI* R$))
+                    (NOT (ZP M))
+                    (RGRAPHP2 (TAKE-FIRST (+ -1 M) (NTH *RGRAPHI* R$))
+                              (LEN (NTH *RGRAPHI* R$)))
+                    (R$P R$)
+                    (<= M (LEN (NTH *RGRAPHI* R$)))
+                    (<= 0 M)
+                    (RG%-P2 (NTH (+ -1 M) (NTH *RGRAPHI* R$))
+                            (LEN (NTH *RGRAPHI* R$)))
+                    (NOT (RG%-P2 (CAR (NTH *RGRAPHI* R$))
+                                 (LEN (NTH *RGRAPHI* R$)))))
+               (NOT (RG%-P2-FORALL-I (+ -1 M)
+                                     (LEN (NTH *RGRAPHI* R$))
+                                     R$)))
+      :hints (("goal" :cases ((zp (+ -1 M))))))
+  
+
+    (defthm what00
+      (IMPLIES (and (R$P R$)
+                    (NOt (CONSP (NTH *RGRAPHI* R$))))
+               (<= (len (NTH *RGRAPHI* R$)) 0))
+      :rule-classes :linear)
+    
+    
+    (defthm one-last-lemma-enabling-take-all
+      (implies (R$p R$)
+               (true-listp (nth *rgraphi* R$))))
+    
+    ))                
+
+    (defthm rg%-p2-forall-i<=>rgraphp2-main-inductive-strengthening
+      (implies (and (R$p R$)
+                    (<= m (len (nth *rgraphi* R$)))
+                    (natp m))
+               (equal (rg%-p2-forall-i m (len (nth *rgraphi* R$)) R$)
+                      (rgraphp2 (take-first m (nth *rgraphi* R$)) 
+                                (len (nth *rgraphi* R$)))))
+      :hints (("goal" :in-theory (disable R$p len))))
+    
+    (defthm rg%-p2-forall-i<=>rgraphp2
+      (implies (R$p R$)               
+               (equal (rg%-p2-forall-i (len (nth *rgraphi* R$)) (len (nth *rgraphi* R$)) R$)
+                      (rgraphp2 (nth *rgraphi* R$) (len (nth *rgraphi* R$)))))
+      :hints (("goal" :in-theory (disable R$p len))))
+               
+    )
+
+(defun R$p2 (N R$)
+  (declare (xargs :guard (and (R$p R$)
+                              (natp N)
+                              (<= N (rgraph-length R$)))
+                  :stobjs (R$)))
+  (and (R$p R$)
+       (rg%-p2-forall-i N N R$)))
+
+
+       
+
+;; (defthm R$p2-fc1
+;;   (implies (R$p2 R$)
+;;            (and (R$p R$)
+;;                 (rgraphp2 (nth *rgraphi* R$) (rgraph-length R$))))
+;;   :rule-classes :forward-chaining)
+
+(defun add-subtype-edge$ (u v R$)
+  "R-index * R-index * R$ -> R$.
+   add u->v to graph. Do incremental transitive closure."
+  (declare (xargs :stobjs (R$)
+                  :guard (and (R$p2 (rgraph-length R$) R$)
+                              (R-index-p u (rgraph-length R$))
+                              (R-index-p v (rgraph-length R$))
+                              )))
+  (b* (((when (is-subtype$ u v R$)) R$) 
+       (u% (rgraphi u R$))
+       (v% (rgraphi v R$))
+       (u-can-reach-set (access-rg% u% :can-reach-set))
+       (ws (aa-tree-to-list (insert u u-can-reach-set)))
+       (R$ (set-rg%++ ws :reachable-set (insert v (access-rg% v% :reachable-set)) R$))
+       (v% (change-rg% v% :can-reach-set
+                       (insert-list ws
+                                    (access-rg% v% :can-reach-set))))
+       (R$ (update-rgraphi v v% R$)))
+    R$))
+
+; pre-cond: G is transitively-closed. 
+; algo: 
+;  for each w in can-reach-set[u] U {u}: unreachable-set[w] =+ {v} U can-reach-set[v]
+;  for each w in can-reach-set[v] U {v}: unreachable-set[w] =+ {u} U can-reach-set[u]
+; post-cond: G' is transitively-closed.
+
+  
+(defun add-disjoint-edge$ (u v R$)
+  "R-index * R-index * R$ -> R$.
+   add u --- v to graph. Do incremental transitive closure."
+  (declare (xargs :stobjs (R$)
+                  :guard (and (R$p2 (rgraph-length R$) R$)
+                              (R-index-p u (rgraph-length R$))
+                              (R-index-p v (rgraph-length R$))
+                              )))
+  (b* (((when (is-disjoint$ u v R$)) R$)
+       (u% (rgraphi u R$))
+       (v% (rgraphi v R$))
+       (u-can-reach-set (access-rg% u% :can-reach-set))
+       (ws (aa-tree-to-list (insert u u-can-reach-set)))
+       (R$ (set-rg%++ ws :unreachable-set (insert v (access-rg% v% :can-reach-set)) R$))
+       (v-can-reach-set (access-rg% v% :can-reach-set))
+       (ws (aa-tree-to-list (insert v v-can-reach-set)))
+       (R$ (set-rg%++ ws :unreachable-set (insert u (access-rg% u% :can-reach-set)) R$)))
+    R$))
+       
+;Now top-level calls will be:
+;1. Is T1 a subtype of T2?
+;2. Are T1 and T2 disjoint?
+;3. Add vertex (type) to R$
+;4. Add a subtype edge 
+;5. Add disjoint edge
+
+;pre-cond: T1 should not be in types-ht$
+(defun add-vertex$$ (T1 R$ types-ht$)
+  (declare (xargs :guard (and (symbolp T1)
+                              (R$p R$)
+                              (types-ht$p types-ht$)
+                              (not (type-vertex-ht-boundp T1 types-ht$))
+                              (= (types-count types-ht$) (num-types R$)))
+                  :stobjs (R$ types-ht$)))
+  (b* ((types-count (types-count types-ht$))
+       (types-ht$ (update-types-count (1+ types-count) types-ht$))
+       ((mv erp u R$) (add-vertex$ T1 R$))
+       ((when erp) (mv erp R$ types-ht$))
+       (- (assert$ (not (type-vertex-ht-boundp T1 types-ht$)) nil))
+       (types-ht$ (type-vertex-ht-put T1 u types-ht$))
+       (- (assert$ (= (types-count types-ht$) (num-types R$)) nil)))
+    (mv nil R$ types-ht$)))
+ 
+(defun vertex-ht-valid-p (T1 N types-ht$)
+  (declare (xargs :guard (types-ht$p types-ht$)
+                  :stobjs (types-ht$)))
+  (and (symbolp T1)
+       (natp N)
+       (type-vertex-ht-boundp T1 types-ht$)
+       (R-index-p (type-vertex-ht-get T1 types-ht$) N)))
+                  
+
+;pre-cond: T1 and T2 are bound in types-ht$  
+(defun add-edge$$ (kind T1 T2 R$ types-ht$)
+  (declare (xargs :guard (and (R$p2 (rgraph-length R$) R$)
+                              (types-ht$p types-ht$)
+                              (vertex-ht-valid-p T1 (rgraph-length R$) types-ht$)
+                              (vertex-ht-valid-p T2 (rgraph-length R$) types-ht$)
+                              (or (eq kind :subtype)
+                                  (eq kind :disjoint)))
+                  :stobjs (R$ types-ht$)))
+
+  (b* ((u1 (type-vertex-ht-get T1 types-ht$))
+       (u2 (type-vertex-ht-get T2 types-ht$)))
+    (cond ((or (eq T1 'acl2::all) ;some cases impossible,
+               (eq T2 'acl2::all) ;others trivially true
+               (eq T1 'acl2::empty)
+               (eq T2 'acl2::empty)) R$) 
+          ((eq kind :subtype) (add-subtype-edge$ u1 u2 R$))
+          (t (add-disjoint-edge$ u1 u2 R$)))))
+
+
+(defmacro add-edge-event (kind T1 T2)
+  `(make-event
+    (er-progn
+     (trans-eval `(add-edge$$ ',',kind ',',T1 ',',T2 R$ types-ht$)
+                 'add-edge-event state t)
+     (value '(value-triple :invisible)))
+    :check-expansion t))
+
+
+(defun is-disjoint$$0 (T1 T2 R$ types-ht$)
+  (declare (xargs :guard (and (R$p R$)
+                              (types-ht$p types-ht$)
+                              (vertex-ht-valid-p T1 (rgraph-length R$) types-ht$)
+                              (vertex-ht-valid-p T2 (rgraph-length R$) types-ht$))
+                  :stobjs (R$ types-ht$)))
+  (b* ((u1 (type-vertex-ht-get T1 types-ht$))
+       (u2 (type-vertex-ht-get T2 types-ht$)))
+    (is-disjoint$ u1 u2 R$)))
+
+(defun is-disjoint$$ (T1 T2 R$ types-ht$)
+  (declare (xargs :guard (and (R$p R$)
+                              (types-ht$p types-ht$)
+                              (symbolp T1)
+                              (symbolp T2))
+                  :stobjs (R$ types-ht$)))
+  (cond ((or (eq T1 'acl2::all) (eq T2 'acl2::all)) nil)
+        ((or (eq T1 'acl2::empty) (eq T2 'acl2::empty)) t)
+        ((and (vertex-ht-valid-p T1 (rgraph-length R$) types-ht$)
+              (vertex-ht-valid-p T2 (rgraph-length R$) types-ht$))
+         (is-disjoint$$0 T1 T2 R$ types-ht$))
+        (t nil))) ;conservative
+
+
+(defun is-subtype$$0 (T1 T2 R$ types-ht$)
+  (declare (xargs :guard (and (R$p R$)
+                              (types-ht$p types-ht$)
+                              (vertex-ht-valid-p T1 (rgraph-length R$) types-ht$)
+                              (vertex-ht-valid-p T2 (rgraph-length R$) types-ht$))
+                  :stobjs (R$ types-ht$)))
+  (b* ((u1 (type-vertex-ht-get T1 types-ht$))
+       (u2 (type-vertex-ht-get T2 types-ht$)))
+    (is-subtype$ u1 u2 R$)))
+
+;relax it to take into accound singleton types (constants)
+(defun is-subtype$$ (T1 T2 R$ types-ht$)
+  (declare (xargs :guard (and (R$p R$)
+                              (types-ht$p types-ht$)
+                              (symbolp T1)
+                              (symbolp T2))
+                  :stobjs (R$ types-ht$)))
+  (cond ((eq T2 'acl2::all) t)
+        ((eq T1 'acl2::empty) t)
+;ASSUMPTION: Types equivalent to all and empty should be recognized
+;separately. In this function, we simply return nil, so we can have false
+;positives.
+        ((eq T2 'acl2::empty) nil)
+        ((eq T1 'acl2::all) nil)
+        ((and (vertex-ht-valid-p T1 (rgraph-length R$) types-ht$)
+              (vertex-ht-valid-p T2 (rgraph-length R$) types-ht$))
+         (is-subtype$$0 T1 T2 R$ types-ht$))
+        (t nil))) ;be conservative
+                              
+
+(defun is-alias$$ (T1 T2 R$ types-ht$)
+  (declare (xargs :guard (and (R$p R$)
+                              (types-ht$p types-ht$)
+                              (symbolp T1) 
+                              (symbolp T2))
+                  :stobjs (R$ types-ht$)))
+  (and (is-subtype$$ T1 T2 R$ types-ht$)
+       (is-subtype$$ T2 T1 R$ types-ht$)))
+
+  
+
+;; (defun is-subtype-gv (t1 t2 wrld)
+;;   (ec-call (is-subtype-current t1 t2 state)))
+
+;; (defun is-disjoint-gv (t1 t2 wrld)
+;;   (ec-call (is-disjoint-current t1 t2 state)))
+
+;; (defattach is-subtype is-subtype-gv)
+;; (defattach is-disjoint is-disjoint-gv)
+
+;; (defun is-alias-current (t1 t2 state)
+;;   (declare (xargs :mode :program
+;;                   :stobjs (state)
+;;                   :guard (and (symbolp t1)
+;;                               (symbolp t2))))
+;;   (b* (((er b1) (is-subtype t1 t2 state))
+;;        ((er b2) (is-subtype t2 t1 state)))
+;;     (value (and b1 b2))))
+
+;; (defun is-alias-gv (t1 t2 state)
+;;   (ec-call (is-alias-current t1 t2 state)))
+
+;; (defattach is-alias is-alias-gv)
+
+; pretty printing utilities
+
+(defabbrev vname$ (u)
+  (access-rg% (rgraphi u R$) :typename))
+  
+(defun vnames$ (us R$)
+  (declare (xargs :guard (R$p R$)
+                  :stobjs (R$)))
+  (if (atom us)
+      nil
+    (if (R-index-p (car us) (rgraph-length R$))
+        (cons (vname$ (car us))
+              (vnames$ (cdr us) R$))
+      (cw "~% ~x0 is not a valid vertex of R$~%" (car us)))))
+
+(defun display-R$ (u R$ field)
+  "display field for vertices less than u+"
+  (declare (xargs :guard (and (R$p R$)
+                               (natp u)
+                               (member-eq field '(:reachable-set :unreachable-set :can-reach-set)))
+                  :stobjs (R$)))
+  (if (zp u)
+      nil
+    (if (< u (rgraph-length R$))
+        (b* ((nm (vname$ u))
+             (u% (rgraphi u R$))
+             (fset (aa-tree-to-list (access-rg% u% field)))
+             (- (cw "~% ~x0 ~x1 : ~x2 " nm field (vnames$ fset R$))))
+          (display-R$ (1- u) R$ field))
+      (display-R$ (1- u) R$ field))))
+             
+  
+(defun display-subtype-graph (R$)
+  (declare (xargs :guard (R$p R$)
+                  :stobjs (R$)))
+  (b* ((num-types (num-types R$)))
+    (display-R$ num-types R$ :reachable-set)))
+
+
+
+
+
+
+
+
+
+
+;; alternative hash-table implementation - incomplete
+
+#||
+;from practice of programming. MULTIPLIER = 31 or 37
+/* hash: compute hash value of string */
+unsigned int hash(char *str)
+{
+   unsigned int h;
+   unsigned char *p;
+
+   h = 0;
+   for (p = (unsigned char*)str; *p != '\0'; p++)
+      h = MULTIPLIER * h + *p;
+   return h; // or, h % ARRAY_SIZE;
+}
+
+
+(defun mod-fast1 (x y)
+  (if (< x y)
+      x
+    (mod-fast1 (- x y) y)))
+
+(defstub mod-fast (* *) => *)
+(defattach mod-fast mod-fast1) ;or just attach it to mod
+
+(defconst *hash_prime* 1777)
+
+(def knuth-texbook-hash1. (cs ans)
+  (decl :sig ((character-listp natp) -> natp)
+        :doc "see #261, pg108 of TexBook.")
+  (if (endp cs)
+      (mod-fast ans *hash_prime*)
+    (b* ((code (char-code (car cs))))
+    (knuth-texbook-hash1. (cdr cs) (+ (* 2 ans) code)))))
+      
+(def knuth-texbook-hash. (a)
+  (decl :sig ((stringp) -> natp) ;non-empty string
+        :doc "given a non-empty string, return its hash value")
+  (b* ((cL (coerce a 'list))
+       (ctx 'knuth-texbook-hash.)
+       ((unless (consp cL))
+        (er hard ctx "~|CEgen/Error: Cannot pass an empty string!~|"))
+       ((when (consp (cdr cL))) (char-code (car cL))))
+    (knuth-texbook-hash1. (cdr cL) (char-code (car cL)))))
+
+; key: symbol name of type (stringp)
+; value: (list* key vertex next-index)
+;;   - if A is the array implementing the hash table, then next-index
+;;     is an index into it.
+;;   - vertex is the index of key into adjacency list array G
+(defstobj types-hash-table$
+  (types-count :type (integer 0 *) :initially 0)
+  (ht-array :type (array (unsigned-byte 32) (0))
+            :initially nil
+            :resizable t))
+||#
+
+
+#||
+
+; code which might be thrown, since now i have implemented incremental
+; transitive closure
+
+; we will maintain a global subtype graph, with following invariants
+; Let p = types-ht(P) be the vertex in subtype graph for type P.
+
+; I1 -- (defdata-subtype P Q) =>  q in s-adj(p).reachable-set
+;                                 p in s-adj(q).can-reach-set
+
+; I2 -- (defdata-disjoint P Q) => q in s-adj(p).unreachable-set and vice-versa
+
+; I3 -- q in s-adj(p).unreachable => (p,q) not in edges of reachability closure of s-adj
+
+; I4 -- forall i s-adj(i).reachable mutually disjoint with s-adj(i).unreachable
+
+; I5 -- lists reachable and unreachable are sorted (for binary search)
+
+; I6 -- at the beginning of a new graph traversal, the
+;       unique-visited-code is incremented by 1, so that old visited
+;       information is invalidated. 
+
+
+
+
+(mutual-recursion
+;returns -> (mv boolean R-index-listp R$)
+; simple DFS variant.
+(defun find-path-s$. (u R$ v N path.)
+  (declare (xargs :guard (and (natp N)
+                              (R-index-p u N)
+                              (R$p R$)
+                              (R-index-p v N)
+                              (R-index-listp path. N))
+                  :stobjs (R$)))
+  (declare (xargs :measure (nfix N)))
+; pre-conditions
+; - u has not been visited.
+; post-conditions
+; - (car result) = t => (car path.) = v && (last path.) = u
+  (if (zp N)
+      (mv nil '() R$)
+    (b* (((when (int= u v)) (mv t (cons u path.) R$))
+         (u-rg% (rgraphi u R$))
+         (u-rg% (acl2::change rg% u-rg% 
+                                     :visited-code (unique-visited-code R$)))
+         (R$ (update-rgraphi u u-rg% R$)) ;update visited info
+
+         (path. (cons u path.)) ; extend the path
+
+         (ws (acl2::access rg% u-rg% :reachable))
+         ((when (bsearch v ws)) ;found in adjacent, abort
+          (mv t (cons v path.) R$))
+
+         (disjoint-ws (acl2::access rg% u-rg% :unreachable))
+         ((when (bsearch v disjoint-ws)) ;cannot be subtype, abort
+          (mv nil '() R$)))
+
+      (find-path-s$-lst. ws R$ v (1- N) path.))))
+
+(defun find-path-s$-lst. (us R$ v N path.)
+  (declare (xargs :guard (and (natp N)
+                              (R-index-listp us N)
+                              (R$p R$)
+                              (R-index-p v N)
+                              (R-index-listp path. N))
+                  :stobjs (R$)))
+  (if (endp us)
+      (mv nil path. R$)
+    (b* ((u (car us))
+         (u-rg% (rgraphi u R$))
+         (u-visited-code (acl2::access rg% u-rg% :visited-code))
+         ((when (int= u-visited-code (unique-visited-code R$))) 
+          (find-path-s$-lst. (cdr us) R$ v path.)) ;already visited, move on
+         ((mv found-v? path1 R$) (find-path-s$. u R$ v N path.))
+         ((when found-v?) (mv t path1 R$))) ;abort with success
+      (find-path-s$-lst. (cdr us) R$ v path.)))))
+         
+
+(defun reset-visited-codes1 (n R$)
+  (declare (xargs :stobjs (R$)))
+  (if (zp n)
+      R$
+    (b* ((u (1- n))
+         (u% (rgraphi u R$))
+         (u% (acl2::change rg% u% :visited-code 0))
+         (R$ (update-rgraphi u u% R$)))
+      (reset-visited-codes1 (1- n) R$))))
+         
+        
+(defun reset-visited-codes (R$)
+  (declare (xargs :stobjs (R$)))
+  (b* ((R$ (update-unique-visited-code 0 R$))
+  (reset-visited-codes1 (num-types R$) R$))
+
+
+(def is-subtype-R$ (u v R$)
+  (decl :sig ((R-index-p R-index-p R$) -> (mv booleanp R$p))
+        :doc 
+"update visited-code for new traversal of R$. do DFS on u.")
+  (b* (((when (int= u v)) (mv t R$))
+       (R$ (if (< (unique-visited-code R$) *max-unsigned-number*)
+               R$
+             (reset-visited-codes R$)))
+       (R$ (update-unique-visited-code (1+ (unique-visited-code R$)) R$)) ;reset for new traversal
+;possible optimization: on every traversal, we obtain
+;valuable reachability information P. update R$ with it.
+       ((mv b ?path R$) (find-path-s$. u R$ v (num-types R$) '())))
+    (mv b R$)))
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/cgen/library-support.lisp acl2-6.3/books/cgen/library-support.lisp
--- acl2-6.2/books/cgen/library-support.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/library-support.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,118 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(begin-book);$ACL2s-Preamble$|#
+
+(in-package "ACL2")
+
+;record implementation
+(include-book "defexec/other-apps/records/records" :dir :system :load-compiled-file :comp)
+(include-book "finite-set-theory/osets/sets" :dir :system :load-compiled-file :comp)
+;(include-book "std/osets/top" :dir :system :load-compiled-file :comp)
+
+
+;GETTING RECORDS TO behave nicely here are some
+;;RECORDS THMS proven
+
+#|
+(thm (implies (and (not (ifmp v))
+                   (consp v))
+              (o< (acl2-count (mget x v))
+                  (acl2-count v)))
+     :hints (("goal" :induct (mget-wf x v))))
+|#
+(defthm records-lemma-acl2-count
+  (implies (and (ifmp v)
+                (acl2::well-formed-map v))
+           (< (acl2-count (acl2::mget-wf x v))
+              (acl2-count v)))
+  :hints (("goal" :in-theory (enable acl2::mset acl2::mget acl2::mset-wf acl2::mget-wf acl2::acl2->map)))
+  :rule-classes (:linear :rewrite))
+
+(defthm records-acl2-count
+  (implies (and (acl2::good-map v)
+                (consp v))
+           (< (acl2-count (acl2::mget x v))
+               (acl2-count v)))
+  :hints (("goal" :induct (acl2::mget-wf x v)
+                  :in-theory (enable acl2::mset acl2::mget acl2::mset-wf acl2::mget-wf acl2::acl2->map)))
+  :rule-classes (:linear :rewrite))
+
+(defthm records-acl2-count-linear-arith-<=
+  (<= (ACL2-COUNT (acl2::MGET k V))
+      (ACL2-COUNT V))
+  :hints (("goal" :in-theory (enable acl2::mset acl2::mget acl2::mset-wf acl2::mget-wf acl2::acl2->map)))
+  :rule-classes (:linear :rewrite))
+
+(defthm records-acl2-count-linear-arith-<
+  (implies (and (not (equal k (acl2::ill-formed-key)))
+                (acl2::MGET k V))
+           (< (ACL2-COUNT (acl2::MGET k V))
+              (ACL2-COUNT V)))
+  :hints (("goal" :in-theory (enable acl2::mset acl2::mget acl2::mset-wf acl2::mget-wf acl2::acl2->map)))
+  :rule-classes (:linear :rewrite))
+
+
+ (defthm records-acl2-count2
+  (implies (and (consp v)
+                (not (equal x (ill-formed-key))))
+           (< (acl2-count (mget x v))
+              (acl2-count v)))
+  :hints (("goal" :induct (mget-wf x v)
+                  :in-theory (enable mset mget mset-wf mget-wf acl2->map)))
+  :rule-classes ((:linear) (:rewrite)))
+
+ (defthm field-not-empty-implies-record-not-empty1
+   (implies (and (mget a x)
+                 (not (equal a (ill-formed-key))))
+            (consp x))
+   :hints (("goal" :in-theory (enable mset mget mset-wf mget-wf acl2->map)))
+   :rule-classes (:forward-chaining))
+   ;               (:rewrite :backchain-limit-lst 1)))
+ 
+(defthm field-not-empty-implies-record-not-empty2
+  (implies (and (mget a x)
+                ;(not (ifmp x))
+                (good-map x))
+           (consp x))
+  :hints (("goal" :in-theory (enable mset mget mset-wf mget-wf acl2->map)))
+  :rule-classes :forward-chaining) 
+
+;The following theorem was needed in alloy-comparision
+(defthm updating-empty-entry-with-nil-lemma
+  (implies (equal (mget a r) v)
+           (equal (mset a v r) r)))
+
+(defthm updating-empty-entry-with-nil
+  (implies (not (mget a r))
+           (equal (mset a nil r) r)))
+
+;This might be needed for termination arguments for SETS
+(defthm non-nil-=>-not-empty
+  (implies (and (sets::setp v)
+                (not (equal v nil)))
+           (not (sets::empty v)))
+  :hints (("Goal" :in-theory (enable sets::empty)))
+  :rule-classes :forward-chaining)
+
+(defthm good-map-implies-not-ifmp
+  (implies (good-map x) (and (not (ifmp x))
+                             (well-formed-map x)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)
+                 (:forward-chaining)))
+
+
+(local
+ (defthm mset-wf-key-non-nil-val-is-consp-lemma 
+   (IMPLIES (AND V
+                 (wf-keyp a)
+                 (not (IFMP X)))
+            (equal (IFMP (MSET-WF A V X)) nil))
+   :hints (("goal" :in-theory (enable extensible-records)))))
+               
+
+(defthm mset-wf-key-non-nil-val-is-consp
+ (IMPLIES (AND v
+               (wf-keyp a))
+          (consp (MSET A V x)))
+ :hints (("goal" :in-theory (enable map->acl2 acl2->map extensible-records))))
diff -Nru acl2-6.2/books/cgen/main.lisp acl2-6.3/books/cgen/main.lisp
--- acl2-6.2/books/cgen/main.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/main.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,4998 @@
+#|$ACL2s-Preamble$;
+;;Author - Harsh Raju Chamarthi (harshrc)
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(begin-book t :ttags :all);$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+
+;Useful Macros for concise/convenient code.
+(include-book "tools/bstar" :dir :system)
+(include-book "basis")
+(include-book "with-timeout" :ttags ((:acl2s-timeout)))
+(include-book "type")
+;(include-book "basis")
+;(include-book "testing-stobj")
+;; (include-book "base")
+(include-book "acl2s-parameter")
+(include-book "simple-graph-array")
+(include-book "graph-tc" :ttags ((:hash-stobjs) (:redef+)));transtive closure and subtype relation
+(include-book "random-state")
+;(include-book "tools/easy-simplify" :dir :system)
+(include-book "misc/expander" :dir :system)
+(include-book "elim")
+
+;For now TODO
+
+;;;======================================================================
+;;;============ Build enumerator expression code =================e=======
+;;;======================================================================
+
+;from the members of an union expression, get the constituents
+;that are non-recursive.
+(defthm flatten-is-true-list1 
+  (implies (true-listp lst)
+           (true-listp (defdata::flatten b lst)))
+  :hints (("Goal" :in-theory (enable defdata::flatten))))
+     
+
+
+;; chose 29 bits, because ACL2 uses signed 29 bits in its code!
+(defun unsigned-29bits-p (x)
+  (declare (xargs :guard T))
+  (acl2::unsigned-byte-p 29 x))
+
+(defun fixnump (x)
+  (declare (xargs :guard T))
+  (unsigned-29bits-p x))
+
+;;; Style of accessing/changing defrec objects. The name of the object is
+;;; always same as the name of the defrec, just like in stobjs. THis way we
+;;; can drop in stobjs in their place!
+(defmacro access (r a)
+  `(acl2::access ,r ,r ,(intern-in-package-of-symbol (symbol-name a) :key)))
+(defmacro change (r a val )
+  `(acl2::change ,r ,r ,(intern-in-package-of-symbol (symbol-name a) :key) ,val))
+
+
+(defrec enum-info% (size category expr expr2) NIL)
+(defun enum-info%-p (v)
+  (declare (xargs :guard T))
+  (case-match v
+    (('enum-info% size category expr expr2) 
+
+     (and (fixnump size)
+          (member-eq category
+                     '(:singleton :function :defconst :numeric-range :empty))
+          (pseudo-termp expr)
+          (pseudo-termp expr2)))))
+
+
+;redundant from data.lisp
+(defrec types-info%
+  (size enumerator predicate test-enumerator enum-uniform
+        recursivep derivedp
+        type-class defs) NIL)
+
+(verify-termination acl2::empty-tau-intervalp )
+(verify-termination acl2::singleton-tau-intervalp)
+
+(defun singleton-tau-intervalp (interval)
+  (b* ((lo (acl2::access acl2::tau-interval interval :lo))
+       (hi (acl2::access acl2::tau-interval interval :hi))
+       (lo-rel (acl2::access acl2::tau-interval interval :lo-rel))
+       (hi-rel (acl2::access acl2::tau-interval interval :hi-rel)))
+    (and (acl2::access acl2::tau-interval interval :domain) ;int,rat,num
+         (acl2::singleton-tau-intervalp lo-rel lo hi-rel hi))))
+
+(defun non-empty-non-universal-interval-p (interval)
+  (and interval
+       (acl2::tau-intervalp interval)
+       (acl2::access acl2::tau-interval interval :domain) ;either int,rat,num
+       (or (rationalp (acl2::access acl2::tau-interval interval :lo)) ;one of bounds should be a number
+           (rationalp (acl2::access acl2::tau-interval interval :hi)))
+       (b* ((lo (acl2::access acl2::tau-interval interval :lo))
+            (hi (acl2::access acl2::tau-interval interval :hi))
+            (lo-rel (acl2::access acl2::tau-interval interval :lo-rel))
+            (hi-rel (acl2::access acl2::tau-interval interval :hi-rel)))
+         (and (not (acl2::empty-tau-intervalp lo-rel lo hi-rel hi))
+              (not (acl2::singleton-tau-intervalp lo-rel lo hi-rel hi))))))
+          
+
+
+  
+
+(def make-range-enum-info% (domain interval)
+  (decl :sig ((symbolp non-empty-non-universal-interval-p) -> enum-info%-p)
+        :doc "given tau-interval interval construct an enum-info% rec with appropriate enum calls")
+  (b* ((lo (acl2::access acl2::tau-interval interval :lo))
+       (hi (acl2::access acl2::tau-interval interval :hi))
+       (lo-rel (acl2::access acl2::tau-interval interval :lo-rel))
+       (hi-rel (acl2::access acl2::tau-interval interval :hi-rel)))
+       
+  (case domain
+    (acl2::integer (let ((lo (and lo (if lo-rel (1+ lo) lo))) ;make both inclusive bounds
+                         (hi (and hi (if hi-rel (1- hi) hi))))
+                     (cond ((and lo hi)
+                            (acl2::make enum-info% 
+                                        :size 't ;(- hi lo)
+                                        :category :numeric-range 
+                                        :expr `(acl2::nth-integer-between r ,lo ,hi)
+                                        :expr2 `(random-int-between-seed ,lo ,hi seed.)))
+                           (lo ;hi is positive infinity
+                            (acl2::make enum-info% 
+                                        :size 't
+                                        :category :numeric-range 
+                                        :expr `(+ ,lo r)
+                                        :expr2 `(mv-let (r seed.)
+                                                        (random-natural-seed seed.)
+                                                        (mv (+ ,lo r) seed.))))
+                           
+                           ((posp hi) ;lo is neg infinity and hi is >=1
+                            (acl2::make enum-info% 
+                                        :size 't
+                                        :category :numeric-range 
+                                        :expr `(let ((i-ans (acl2::nth-integer r)))
+                                                 (if (> i-ans ,hi)
+                                                     (mod i-ans (1+ ,hi))
+                                                   i-ans));ans shud be less than or equal to hi
+                                                        
+                                        :expr2 `(mv-let (i-ans seed.)
+                                                        (random-integer-seed seed.)
+                                                        (mv (if (> i-ans ,hi) 
+                                                                (mod i-ans (1+ ,hi)) 
+                                                              i-ans) 
+                                                            seed.))))
+                           (t ;lo is neg inf, and hi is <= 0
+                            (acl2::make enum-info% 
+                                        :size 't
+                                        :category :numeric-range 
+                                        :expr `(- ,hi r) ;ans shud be less than or equal to hi
+                                        :expr2 `(mv-let (r seed.)
+                                                        (random-natural-seed seed.)
+                                                        (mv (- ,hi r) seed.)))))))
+    (otherwise  (cond ((and lo hi) ;ASSUME inclusive even when you have exclusive bounds
+                            (acl2::make enum-info% 
+                                        :size 't ;(- hi lo)
+                                        :category :numeric-range 
+                                        :expr `(acl2::nth-rational-between r ,lo ,hi)
+                                        :expr2 `(random-rational-between-seed ,lo ,hi seed.)))
+                         (lo ;hi is positive infinity
+                          (acl2::make enum-info% 
+                                      :size 't
+                                      :category :numeric-range 
+                                      :expr `(+ ,lo (acl2::nth-positive-rational r))
+                                      :expr2 `(mv-let (p seed.)
+                                                      (random-probability-seed seed.)
+                                                      (mv-let (r seed.)
+                                                              (random-natural-seed seed.)
+                                                              (mv (+ ,lo (* p r)) seed.)))))
+                         
+                         ((> hi 0) ;lo is neg infinity and hi is is >= 1
+                          (acl2::make enum-info% 
+                                        :size 't
+                                        :category :numeric-range 
+                                        :expr `(let ((rat-ans (acl2::nth-rational r)))
+                                                 (if (> rat-ans ,hi)
+                                                     (mod rat-ans (1+ ,hi))
+                                                   rat-ans));ans shud be less than or equal to hi
+                                                        
+                                        :expr2 `(mv-let (p seed.)
+                                                        (random-probability-seed seed.)
+                                                        (mv-let (r seed.)
+                                                                (random-integer-seed seed.)
+                                                                (let ((rat-ans (* p r)))
+                                                                  (mv (if (> rat-ans ,hi) 
+                                                                          (mod rat-ans (1+ ,hi)) 
+                                                                        rat-ans) 
+                                                                      seed.))))))
+
+                         (t;lo is neg infinity and hi is is <= 0
+                          (acl2::make enum-info% 
+                                      :size 't
+                                      :category :numeric-range 
+                                      :expr `(- ,hi (acl2::nth-positive-rational r))
+                                      :expr2 `(mv-let (p seed.)
+                                                      (random-probability-seed seed.)
+                                                      (mv-let (r seed.)
+                                                              (random-natural-seed seed.)
+                                                      (mv (- ,hi (* p r)) seed.))))))))))
+                   
+                          
+                         
+  
+;usage:
+
+;OLD COMMENT as of 10 March 2012;
+;MODIFIED: I had to change the order because it was picking
+;up *empty-values* as a constant value and hence
+;a singleton which is not working right. 
+;Come back to this point later.
+;;; harshrc 03/10/12 - updated it to defrec and def
+
+; 5 July '13 - Fixed bug. 2nd argument to 'nth' should be in bounds for finite types (-values* defconst).
+; 15 July '13 - added range support
+(def get-enum-info% (type range vl wrld R$ types-ht$)
+  (decl :sig ((possible-defdata-type-p tau-interval fixnum plist-world R$ types-ht$)
+              -> enum-info%-p)
+
+;TODO: union types
+        :doc "to fill")
+  (declare (xargs :verify-guards nil))
+; returns a well-formed enum-info defrec object
+; r is the free variable in the enum-expression which
+; is the place-holder for the random-seed or BE arg 
+  (if (possible-constant-valuep type)
+      (acl2::make enum-info% :size 1 :category :singleton :expr type :expr2 `(mv ',type seed.)) 
+;ALSO HANDLE SINGLETON TYPES DIRECTLY
+    
+    (let ((entry (assoc-eq type 
+                           (table-alist 'defdata::types-info-table wrld))))
+     
+    (if entry ;if we find enum-info from type-info-table then use it
+        (b* ((types-info% (cdr entry))
+              (TI.test-enumerator (access types-info% test-enumerator))
+              (TI.enumerator      (access types-info% enumerator))
+              (TI.enum-uniform    (access types-info% enum-uniform))
+              (TI.size            (access types-info% size))
+             ((unless (or (eq 't TI.size)
+                         (posp TI.size)))
+              (prog2$
+               (cw? (normal-output-flag vl)
+                    "~|CEgen/Error: size in type-info ~x0 should be posp.~%" (cdr entry))
+               (acl2::make enum-info% :size 0 :category :empty :expr nil :expr2 nil)))
+             
+; 15 July '13 added support for integer and rational ranges
+; (acl2-numberp ranges reduce to rational ranges) custom types dont
+; take ranges in hyps into account, since they are explicitly given by
+; user, the user is burdened with the resposibility of taking them
+; into account manually. In any case even defined defdata types play
+; well only for integers and rationals, but then you cannot define an
+; interesting numeric type, like 4divp, primep, arithmetic
+; progression, etc. But you can use / constructor to define some
+; interesting types, so I need to think about how to make this more general!! TODO
+             ((when (and (is-subtype$$ type 'acl2::integer R$ types-ht$)
+                         (non-empty-non-universal-interval-p range)))
+              (make-range-enum-info% 'acl2::integer range))
+                                     
+             ((when (and (is-subtype$$ type 'acl2::acl2-number R$ types-ht$)
+                         (non-empty-non-universal-interval-p range)))
+              (make-range-enum-info% 'acl2::rational range)))
+                                             
+              
+             ;first check for test-enum
+         (if TI.test-enumerator
+             (cond 
+              ((allows-arity TI.test-enumerator 1 wrld)
+;TODO. I am not checking if test enumerator is to be used or not
+               (acl2::make enum-info% :size 't
+                           :category :function
+                           :expr (list TI.test-enumerator 'r)
+                           :expr2 (list (modify-symbol "" TI.test-enumerator "-UNIFORM") 'm 'seed.)))
+              (t (prog2$
+                  (cw? (normal-output-flag vl)
+                       "~|CEgen/Error: ~x0 should be an enum function of arity 1.~%" TI.test-enumerator)
+                  (acl2::make enum-info% :size 0 :category :empty :expr nil :expr2 nil))))
+
+;common scenario: inf enumerator
+           (if (eq 't TI.size);inf or custom registered (assume)
+               (acl2::make enum-info% :size 't :category :function
+                           :expr (list TI.enumerator 'r)
+                           :expr2 (list TI.enum-uniform 'm 'seed.));inf or some enum fn
+             (let ((stored-defconst 
+                    (acl2-getprop TI.enumerator 'const wrld)))
+              
+              (if stored-defconst ;some finite set of values
+                  (b* ((values (second stored-defconst))
+                       (len-v (len values))
+                       ((unless (posp len-v))
+                        (prog2$
+                         (cw? (normal-output-flag vl)
+                              "~|CEgen/Error: stored-defconst ~x0 has 0 values~%" stored-defconst)
+                         (acl2::make enum-info% :size 0 :category :empty :expr nil :expr2 nil))))
+                   (acl2::make enum-info%
+                               :size len-v 
+                               :category (if (= len-v 1) 
+                                             :singleton
+                                           :defconst)
+                               :expr (if (= len-v 1)  
+                                         `',(car values)
+                                       `(nth (mod r ,len-v) ,TI.enumerator))
+                               :expr2 (if (= len-v 1)  
+                                         `(mv ',(car values) seed.) ;todo check random-natural
+                                       `(mv (nth (mod seed. ,len-v) ,TI.enumerator) seed.))))
+;uncommon scenario, finite enumerator function        
+                (if (allows-arity TI.enumerator 1 wrld) 
+                    (acl2::make enum-info% :size TI.size 
+                                :category :function
+                                :expr (list TI.enumerator 'r)
+                                :expr2 (list TI.enum-uniform 'm 'seed.));some enum fn
+                  
+                  (prog2$
+                     (cw? (normal-output-flag vl)
+                          "~|CEgen/Error: ~x0 is neither one of constant, an enum function or a values defconst.~%" TI.enumerator)
+                     (acl2::make enum-info% :size 0 :category :empty :expr nil :expr2 nil))))))))
+
+      ;;;o.w (possibly) custom 
+      (let* ((vsym (modify-symbol "*" type "-VALUES*"))
+             (values (second (acl2-getprop vsym 'const wrld))))
+                    
+        (if values
+            (let ((len-v (len values)))
+               (acl2::make enum-info%
+                        :size len-v 
+                        :category (if (= len-v 1) 
+                                      :singleton
+                                    :defconst)
+                        :expr (if (= len-v 1)  
+                                  `',(car values) 
+                                `(nth (mod r ,len-v) ,vsym))
+                        :expr2 (if (= len-v 1)  
+                                  `(mv ',(car values) seed.);see todo above 
+                                `(mv (nth (mod seed ,len-v) ,vsym) seed.))))
+          (let ((esym (modify-symbol "NTH-" type "")))
+                
+            ;;check if enum is defined in wrld
+            (cond ((allows-arity esym 1 wrld) 
+                   (acl2::make enum-info% 
+                             :size t 
+                             :category :function
+                             :expr `(,esym r)
+                             :expr2 `(mv-let (r seed.)
+                                             (random-natural-seed seed.)
+                                             (mv (,esym r) seed.))))
+                  (t 
+                   (prog2$
+                     (cw? (normal-output-flag vl)
+                          "~|CEgen/Error: ~x0 doesnt appear to be a type.~%" type)
+                     (acl2::make enum-info% :size 0 :category :empty :expr nil :expr2 nil)))))))))))
+              
+;May 8 2011
+;testing history data structure
+;; Maps variables to vtest-history 
+;; vtest-history: 
+;; (record (n . current test-run-number)
+;;         (rec-size . last recursion size chosen for this variable)
+;;         (strategy . :random :bounded)
+;;         (enum-expr . enumerator expression with holes)
+;;         (enum-arg-alist . special alist to fill in the above holes)
+;;         (i . determines X_i to be incremented in BE testing))
+;; enum-arg-alist:
+;; ((defdata::X  . (record (size . t | fin-size) (val . last val of X) ) ...)
+
+
+;identify (equal x y)
+(defun equiv-hyp? (hyp)
+  (and (= 3 (len hyp))
+       (member-eq (car hyp) '(equal = eq eql));TODO
+       (is-a-variablep (second hyp))
+       (is-a-variablep (third hyp))))
+
+;identify (equal 3 x) or (equal x 42)
+(defun constant-hyp? (hyp)
+  (and (= 3 (len hyp))
+       (member-eq (car hyp) '(equal = eq eql))
+       (or (and (is-a-variablep (second hyp))
+                (possible-constant-value-expressionp (third hyp)))
+           (and (is-a-variablep (third hyp))
+                (possible-constant-value-expressionp (second hyp))))))
+
+;chyp=(equal x <const>)
+;gives (mv x <const>)
+(defun destruct-simple-hyp (chyp)
+  (if (is-a-variablep (second chyp))
+      (mv (second chyp) (third chyp))
+    (mv (third chyp) (second chyp))))
+
+;identify (equal x expr) or (equal expr y) where expr is not a const expr
+;disjoint with constant-hyp? and equiv-hyp?
+;added an extra argument storing scc information about variable dependency.
+;avoid hyps which may lead to circular dependency
+
+; MODIFIED May 7 2011, if expr is (g a v) then return false, because we want it
+; to furthur get dest-elimed, since if we there is still a mget call around it
+; has to be a list/map mget call and we want the other variable to get mset
+; into the list/map variable rather than the x getting value from mget of
+; list/map variable .
+(defun simple-var-hyp? (hyp var-quotient-alst list-dest-fns)
+  (and (not (constant-hyp? hyp));not (= x c)
+       (not (equiv-hyp? hyp));not (= x y)
+       (= 3 (len hyp))
+       (mem-eq (car hyp) '(equal = eq eql))
+       (or (is-a-variablep (second hyp))
+           (is-a-variablep (third hyp)))
+       (mv-let (var expr)
+               (destruct-simple-hyp hyp)
+               (and 
+                ;;No cycles
+                (let* ((vquotient (get-val var var-quotient-alst))
+;get-free-vars1 only non-buggy for terms
+                       (dvars (get-free-vars1 expr nil))
+                       (dquotients (get-val-lst dvars var-quotient-alst)))
+                  (not (mem1 vquotient dquotients)))
+                ;;No top-level mget in expr
+                (not (member-eq (car expr) list-dest-fns))))))
+                    
+
+
+
+(defun directed-2-rel? (hyp)
+  ;(declare (xargs :guard (pseudo-termp hyp)))
+;is hyp a directed (computationally) binary relation term
+;hyp = (R x (f y)), where f should represent
+;some computation other than accessors
+;Assumption, hyp cannot be a constant hyp, since
+;this function is always called after constant-hyp?
+;in function build-vdependency-graph
+;TODO maintain a global list of common accessor functions
+  (and (= (len hyp) 3)
+       (let* ((t2 (second hyp))
+              (t3 (third hyp)))
+         (or (and (is-a-variablep t2) 
+                  (consp t3)
+                  (not (member-eq (car t3) 
+                           '(acl2::mget acl2::g g
+                                        acl2::nth acl2::car SETS::head
+                                        acl2::cdr SETS::head))))
+             (and (is-a-variablep t3) 
+                  (consp t3);copy paste bug
+                  (not (member-eq (car t3) 
+                           '(acl2::mget acl2::g g
+                                        acl2::nth acl2::car SETS::head
+                                        acl2::cdr SETS::head))))))))
+              
+(defun undirected-2-rel? (hyp)
+ ; (declare (xargs :guard t))
+;is hyp a undirected (computationally) binary relation term
+;hyp = (~ x y), where ~ should be one of 
+;(= eq equal eql subset-equal < <= > >=)
+;TODO maintain a global list of such functions
+
+  (and (= (len hyp) 3)
+       (let* ((t2 (second hyp))
+              (t3 (third hyp)))
+         (and (is-a-variablep t2) 
+              (is-a-variablep t3)
+              (member-eq (first hyp) ;Relation
+                  '(acl2::= acl2::equal acl2::eq acl2::eql
+                            acl2::< acl2::<= 
+                            acl2::> acl2::>=))))))
+
+;hyp is of form (R term1 term2 ... termn)
+;alst is basically the adjacency list rep of a graph
+;Assumption term-lst is a term-listp otherwise get-free-vars1
+;will not operate correctly
+(defun put-interdependency-edges-in-alst (term-lst all-terms alst)
+  #|(declare (xargs :guard (and (true-listp term-lst)
+                              (true-listp all-terms)
+                              (alistp alst))))|#
+  (if (endp term-lst)
+    alst
+    (let* ((term (car term-lst))
+           (vars (get-free-vars1 term nil))
+           (rest-terms (remove-equal term all-terms))
+           (rest-vars (get-free-vars1-lst rest-terms nil))
+           )
+      (put-interdependency-edges-in-alst 
+       (cdr term-lst) all-terms
+       (union-entries-in-adj-list vars ;sloppy, dont want self-edges
+                                  (set-difference-eq rest-vars vars)
+                                  alst)))))
+         
+;make a dependency graph of variables in a formula.
+;TODO: equal can be any equivalence relation
+;An edge from A to B means, A depends on B
+;Note: (equal x <constant-expr>) forces x to be a leaf!!
+
+;alst = ((var . (listof var)) ...) 
+;alst-C= ((var . nil)) ;constants are forced to be leaves
+;incoming = (map var (map symbol nat)) 
+;e.g  (x . ((= . 1) (R . 2) (< . 1)) YET to be IMPLEMENTED
+
+;PreCondition: hyp-lst is a term-list (IMPORTANT)
+(defun build-vdependency-graph (hyp-lst alst alst-C incoming)
+  (declare (ignorable incoming))
+  (declare (xargs :verify-guards nil
+                  :guard (and (pseudo-term-listp hyp-lst)
+                              (symbol-alistp alst);       TODO
+                              (symbol-alistp alst-C);     lost
+                              (symbol-alistp incoming))));type information
+ "return the dependency graph in alst, when all hypotheses have been 
+processed, the annotation of edges is also returned"
+  (if (endp hyp-lst)
+    (append alst alst-C) ;ques: shouldnt the order be the other way round?
+    (let ((hyp (car hyp-lst)))
+      (cond 
+       ((constant-hyp? hyp) ;(equal x (cons 1 2))
+        (b* (((mv var &) (destruct-simple-hyp hyp)))
+          (build-vdependency-graph (cdr hyp-lst)
+                                   (remove-entry var alst)
+;annotate the fact that var is assigned to a constant
+                                   (put-assoc-equal var nil alst-C)
+                                   incoming)))
+       
+       ((undirected-2-rel? hyp);(~ x  y)
+;dont draw an edge
+        (build-vdependency-graph (cdr hyp-lst) alst alst-C incoming))
+       ((directed-2-rel? hyp);(= x (f y))
+        (b* (((mv var term) (destruct-simple-hyp hyp))
+             (fvars (remove-equal ;sloppy code
+                     var (get-free-vars1 term nil))));buggy for non-terms
+          (build-vdependency-graph 
+           (cdr hyp-lst)
+;Q:shudnt we overwrite instead?
+;A:No, consider both (= x (f y)) (= x (g w)) in hyps
+;But does it matter either way? TODO
+           (union-entry-in-adj-list var fvars alst) 
+           alst-C
+           incoming)))
+       (t
+;(R term1 term2 ...termN) ==> add edges between x and y where x \in termI
+;and y \in termJ and I=!J and R is a N-ary relation
+        (let* 
+            ((vars (get-free-vars1 hyp nil));only non-buggy for terms
+             (num-vars (len vars)))
+          (if (<= num-vars 1);unchanged
+              (build-vdependency-graph (cdr hyp-lst) alst alst-C incoming)
+            (b* ((alst1 (put-interdependency-edges-in-alst 
+                         (cdr hyp) ;recurse (term1 ... termn)
+                         (cdr hyp) ;all-terms
+                         alst))) 
+              (build-vdependency-graph (cdr hyp-lst) 
+                                       alst1 alst-C incoming)))))))))
+
+
+(defun build-variable-dependency-graph (hyps vars)
+  (build-vdependency-graph hyps (make-empty-adj-list vars) nil nil))
+
+#|
+    (c nil ;dep-info record
+       :hyps hyps-new 
+       :concl concl-new 
+       :hyp-vars hyp-vars
+       :concl-vars concl-vars
+       :vars vars
+       :var-type-expr-alist new-var-te-alist
+       :var-dependency-adj-list dgraph
+       :var->ccnum var-quotient-alst
+       :connected-vertices-ordered-list connected-vs-lst)
+       ))
+|#
+            
+
+
+
+
+;;;; Main Idea
+;;;; Given any formula, we want to test it using test? or
+;;;; amidst a prove call.  By test it, I mean we search for an
+;;;; instantiation (or assignment) of the free variables in the
+;;;; formula *and* evaluate the ground formula resulting from
+;;;; substituting the assignment.  The way 'S2' (name of our
+;;;; implementation) works is as follows. We set up the type
+;;;; infrastructure, i.e we store type meta data in ACL2 tables for
+;;;; all primitive/basic types in ground ACL2 and provide the user
+;;;; with macros (defdata) to introduce new types. These macros
+;;;; automate maintenance of type meta data. The metadata henceforth
+;;;; called defdata tables, store the enumerators for each type
+;;;; predicate, and also capture the relationship (subtype and
+;;;; disjoint) among the different types. The latter are useful in
+;;;; finding the minimal (possible) type information for a variable
+;;;; constrained by multiple predicates/relations. When we say 'type',
+;;;; we refer to a name that characterizes a set in the ACL2
+;;;; Universe. This 'type' is characterized redundantly both with a
+;;;; monadic predicate and an monadic enumerator. When the user asks
+;;;; to test?/thm a conjecture, S2 queries the defdata tables to
+;;;; obtain the name of the corresponding enumerator for each variable
+;;;; constrained by a monadic predicate in the conjecture.  In
+;;;; practice what S2 derives is not an enumerator function but an
+;;;; enumerat(or/ing) expression with holes. When these holes are filled
+;;;; with random natural numbers, it will evaluate to a random value
+;;;; satisfying the type-like constraints of the concerned
+;;;; variable in the conjecture under test. Also in practice there is
+;;;; dependency among variables and naively instantiating all of them
+;;;; independently will lead to poor test data, since the full
+;;;; assignment might turn out to be vacuous (inconsistent hypotheses)
+;;;; many a time. (And this indeed is the main hurdle to be crossed).
+;;;; 
+;;;; Clearly to obtain the best results, we want to be able to do the
+;;;; following things.
+;;;; 1. Derive an enumerator expression for each variable that
+;;;; evaluates to a minimal set of values, the variable is allowed to
+;;;; take.
+;;;; 2. Derive an enumerator expression for each
+;;;; variable that takes into account its dependency on other
+;;;; variables. i.e If (= x (f y)) and (posp y), then enumerator
+;;;; expression call (enumcall) for y is (nth-pos n) and for x it is
+;;;; simply (f y). Thus x never evaluates to a value that would make
+;;;; its constraint inconsistent. Things are more complicated for
+;;;; mutually-dependent variables and for complex dependency
+;;;; relations. 
+;;;; 
+;;;; Feb 3 2012
+;;;; This is basically a constraint satisfaction problem and there exist
+;;;; naive backtracking algorithms for finite-domain variables. There also
+;;;; exists the notion of arc-consistency, which basically tells you if it
+;;;; is possible to extend an partial assignment without backtracking. So
+;;;; the "ideal scenario" is to construct the assignment without backtracking.
+
+;;;; Right now, in one search strategy, which is named "simple", we
+;;;; simply compute enumerator/type expressions for all free
+;;;; variables, taking into account "equality" dependencies and use
+;;;; this as a template code to plug in random natural numbers or
+;;;; bounded consecutive natural number tuples to obtain either random
+;;;; value assignment or a consecutive value assignment in the bounded
+;;;; value space of free variables. 
+
+;;;; Alternatively, in the DPLL-style search strategy, which we named
+;;;; as "incremental", we incrementally build the assignment, taking
+;;;; into account dependency, by selecting the least "dependent"
+;;;; variable in the dependency graph built from the conjecture. After
+;;;; every variable is assigned a new value (satisfying its local type
+;;;; constraints), this information is propagated using the theorem
+;;;; prover itself. If the resulting hypotheses of the partially
+;;;; instantiated conjecture are contradictory/inconsistent, then we
+;;;; backtrack to the last "decision" Assign. We stop when we either
+;;;; backtrack too many times, or we have obtained the full value
+;;;; assignment (called sigma hereafter).
+
+;;;; The following illustrates the top-level driver pseudocode
+
+;;;; Top-level test driver loop for Conjecture/Subgoal G
+;;;; ALl alists u see below have as keys the free variables of G.
+
+;;;; Initialization code:
+;;;; defattach conclusion-val/hypotheses-val for G
+;;;; T_naive := get naive type alist from defdata tables for G
+;;;; T_ACL2  := get ACL2 type alist for freevars(G)
+;;;; T_final := get type expression alist for freevars(G) using
+;;;;            T_naive, T_ACL2 and the dependency graph of G.
+;;;; E := get enumerator expression alist for G using T_final
+;;;; make defun next-sigma using E and random seed, be arg tuple
+;;;; defattach next-sigma to a fun computing assignments
+;;;;   
+;;;;
+;;;; Driver loop code:
+;;;; repeat *num-trial* times or till we meet stopping condition
+;;;; \sigma := (next-sigma ...)
+;;;;   if (hypotheses-val \sigma)
+;;;;      if (conclusion-val \sigma)
+;;;;         record witness 
+;;;;       record counterexample
+;;;;    record vacuous
+;;;; end
+;;;;
+;;;; conclusion-val and hypotheses-val are stub functions which
+;;;; are attached during the main search function.
+;;;; They take a substitution and apply it to G, returning a boolean.
+
+;;;;harshrc
+;;;;10th Jan 2012 (Tuesday)
+
+;;; Purpose: Given a value substitution, the following functions will
+;;; apply it to the hypotheses and conclusion of the conjecture under
+;;; test and compute the value of the resulting ground formula.
+;;; Sig: sigma -> boolean
+;;; where sigma is the let bindings or simply the binding of free variables to
+;;; values satisfying the "types" of the respective variables.
+;(defstub hypotheses-val (*) => *)
+(encapsulate
+  ((hypotheses-val
+    (A) t
+    :guard (symbol-doublet-listp A)))
+ 
+  (local (defun hypotheses-val (A) (list A))))
+;(defstub conclusion-val (*) => *)
+(encapsulate
+  ((conclusion-val
+    (A) t
+    :guard (symbol-doublet-listp A)))
+ 
+  (local (defun conclusion-val (A) (list A))))
+
+;;; Purpose: For the current ... , generate the next value-alist
+;;; (sigma) for the formula under test.  next-sigma : (sampling-method
+;;; seed tuple) ->  seed' * tuple' * A' Given the sampling method,
+;;; current random seed, the current nth-tuple (of nats), it computes
+;;; the full assignment (sigma) to be used in the upcoming test run
+;;; and also returns the updated seed and updated nth-tuple
+(defstub next-sigma (* * *) => (mv * * *))
+
+
+(def single-hypothesis (hyp-list)
+  (decl :sig ((pseudo-term-list) -> (oneof 'T pseudo-term))
+        :doc
+"?: Transform a list of hypotheses into an equivalent hypothesis
+ eg: (single-hypothesis '((posp x) (stringp s)) ==> (and (posp x) (stringp s))
+     (single-hypothesis '()) ==> T")
+  (if (endp hyp-list)
+    't
+    `(and ,@hyp-list)))
+
+
+
+
+
+(set-verify-guards-eagerness 2)
+
+(defun local-sampling-method-builtin (sampling-method i N)
+  (declare (xargs :guard (and (natp N)
+                              (natp i)
+                              (member-eq sampling-method '(:mixed :random :uniform-random :be))
+                              (<= i N))))
+  (b* (((unless (eq :mixed sampling-method))
+        sampling-method))
+
+    (cond ((zp N) :random)
+          ((< (/ i N) (/ 50 100))
+; first half do bounded-exhaustive testing, then switch to random testing
+           :be)
+          (t :random))))
+
+(encapsulate
+  ((local-sampling-method 
+    (s i N) t
+    :guard (and (member-eq s '(:mixed :random :uniform-random :be));(keywordp s)
+                (natp i) (natp N) (<= i N))))
+  
+  (local (defun local-sampling-method (s i N) (list s i N))))
+
+(defattach (local-sampling-method local-sampling-method-builtin))
+
+
+(defrec gcs% 
+; global-coverage-stats 
+; Only accumulates sound and top-reproducible cts/wts
+; i.e is not modified after a cross-fertilize ledge of the waterfall
+  ((total-runs dups . vacs)
+   (cts . wts) 
+   (cts-to-reach . wts-to-reach)
+   (start-time . end-time) 
+   all-bets-off? 
+   . (top-term top-vt-alist))
+  NIL) 
+
+
+(def initial-gcs% (nc nw start top-term top-vt-alist)
+  (decl :sig ((fixnump fixnump rationalp allp) -> gcs%-p)
+        :doc "reset/initialized global coverage stats record")
+  (acl2::make gcs% :cts 0 :wts 0 :cts-to-reach nc :wts-to-reach nw
+        :total-runs 0 :vacs 0 :dups 0 
+        :start-time start :end-time start
+        :all-bets-off? nil
+        :top-term top-term
+        :top-vt-alist top-vt-alist))
+
+(defun gcs%-p (v)
+  (declare (xargs :guard T))
+  (case-match v
+    (
+     ('gcs% (total-runs dups . vacs)
+            (cts . wts) 
+            (cts-to-reach . wts-to-reach)
+            (start-time . end-time) all-bets-off? . (& vt-al))
+     (and (unsigned-29bits-p cts)
+          (unsigned-29bits-p wts)
+          (unsigned-29bits-p cts-to-reach)
+          (unsigned-29bits-p wts-to-reach)
+          (rationalp start-time)
+          (rationalp end-time)
+          (unsigned-29bits-p total-runs)
+          (unsigned-29bits-p dups)
+          (unsigned-29bits-p vacs)
+          (booleanp all-bets-off?)
+          (symbol-alistp vt-al)
+          ))))
+
+(defmacro gcs-1+ (fld-nm)
+  `(change gcs% ,fld-nm
+             (acl2::|1+F| (access gcs% ,fld-nm))))
+
+
+(encapsulate
+  ((stopping-condition? 
+    (gcs%) t
+    :guard (gcs%-p gcs%)))
+  (local (defun stopping-condition? (gcs%) (list gcs%))))
+
+
+(defun stopping-condition?-builtin (gcs%)
+  (declare (xargs :guard (gcs%-p gcs%)))
+  (and (>= (access gcs% cts) (access gcs% cts-to-reach))
+       (>= (access gcs% wts) (access gcs% wts-to-reach))))
+
+(defattach stopping-condition? stopping-condition?-builtin)
+
+
+(set-verify-guards-eagerness 1)
+
+(def run-single-test. (sampling-method N i r. BE.)
+  (decl 
+        :sig ((keyword fixnum fixnum fixnum symbol-fixnum-alist) 
+              -> 
+              (mv keyword symbol-doublet-listp fixnum symbol-fixnum-alist))
+        :doc 
+"?:
+* Synopsis 
+Run single trial of search for cts/wts for the formula under test.
+
+* Input parameters 
+'N' stands for num-trials.  sampling-method is
+itself.  i is the current local-trial number.  'r.' is the current
+pseudo-random seed.  'BE.' is alist that holds previous
+bounded-exhaustive nat arg seeds used to compute sigma.
+
+* Return sig: (mv res A r. BE.)
+A is computed sigma (value binding) used to test this run
+res is :vacuous if the hypotheses were inconsistent under A
+res is :witness if both conclusion and hyps eval to T under A
+else is :counterexample
+r. is updated pseudo-random seed
+BE. is the updated bounded-exhaustive arg/seed alist.
+
+eg:n/a")
+  
+  (b* ((sm (local-sampling-method sampling-method i N))
+       ((mv A r. BE.) (next-sigma sm r. BE.))
+       (|not vacuous ?|  (hypotheses-val A)))
+;  in
+   (if |not vacuous ?|
+       ;; bugfix: why even try to evaluate conclusion when
+       ;; the hypotheses arnt satisfied, the whole form's value
+       ;; is simply true - May 2nd '12
+       (let ((res (if (conclusion-val A) :witness :counterexample)))
+        (mv res A r. BE.))
+     (mv :vacuous A r. BE.))))
+
+(defrec run-hist% 
+  ((|#cts| . cts) (|#wts| . wts) (|#vacs| . vacs) . |#dups|)
+; each test run statistics/results are accumulated in run-hist%
+  NIL)
+
+(defun run-hist%-p (v)
+  (declare (xargs :guard T))
+  (case-match v ;its a good thing I dont use case-match run-hist%
+    ;anywhere else. The internal layout of run-hist% is thus hidden.
+    (('run-hist% (|#cts| . cts) (|#wts| . wts) (|#vacs| . vacs) . |#dups|)
+              
+     (and (symbol-doublet-list-listp cts)
+          (symbol-doublet-list-listp wts)
+          (symbol-doublet-list-listp vacs)
+          (unsigned-29bits-p |#wts|)
+          (unsigned-29bits-p |#cts|)
+          (unsigned-29bits-p |#vacs|)
+          (unsigned-29bits-p |#dups|)))))
+          
+
+(defmacro run-hist-1+ (fld)
+"increments the number-valued fields of run-hist%"
+  (let* ((fld-dc (string-downcase (symbol-name fld)))
+         (fld-nm (intern-in-package-of-symbol 
+                  (concatenate-names (list "#" fld-dc)) 'run-hist%)))
+    `(change run-hist% ,fld-nm
+             (acl2::|1+F| (access run-hist% ,fld-nm)))))
+
+(defun merge-car-symbol-< (l1 l2)
+  (declare (xargs :measure (+ (acl2-count l1) (acl2-count l2))))
+                    (cond ((endp l1) l2)
+                          ((endp l2) l1)
+                          ((symbol-< (car (car l1)) (car (car l2)))
+                           (cons (car l1)
+                                 (merge-car-symbol-< (cdr l1) l2)))
+                          (t (cons (car l2)
+                                   (merge-car-symbol-< l1 (cdr l2))))))
+
+(defthm acl2-count-evens-strong
+  (implies (and (consp x)
+                (consp (cdr x)))
+           (< (acl2-count (evens x)) (acl2-count x)))
+  :rule-classes :linear)
+
+(defthm acl2-count-evens-weak
+  (<= (acl2-count (evens x)) (acl2-count x))
+  :hints (("Goal" :induct (evens x)))
+  :rule-classes :linear)
+
+
+(defun merge-sort-car-symbol-< (l)
+  (cond ((endp (cdr l)) l)
+        (t (merge-car-symbol-< (merge-sort-car-symbol-< (evens l))
+                               (merge-sort-car-symbol-< (odds l))))))
+
+;; (defun merge-sort-entry-car-symbol-< (l ans)
+;;   (if (endp l)
+;;       ans
+;;     (merge-sort-entry-car-symbol-< (cdr l)
+;;                                    (cons (merge-sort-car-symbol-< (car l)) ans))))
+
+(def record-testrun. (test-assignment-was A run-hist% gcs%)
+  (decl :sig ((keyword symbol-doublet-listp run-hist%-p gcs%-p)
+              ->
+              (mv run-hist%-p gcs%-p))
+        :doc 
+"?: records the diagnostics/results of a single test trial run ")
+  (b* ((num-wts (access gcs% wts-to-reach))
+       (num-cts (access gcs% cts-to-reach))
+       (A (merge-sort-car-symbol-< A))
+       (gcs% (gcs-1+ total-runs)))
+;   in
+    (case test-assignment-was
+      (:counterexample   (b* ((A-cts (access run-hist% cts))
+                             
+                             ((when (member-equal A A-cts))
+                              (mv (run-hist-1+ dups) (gcs-1+ dups)));ignore A
+                             
+                             (gcs% (gcs-1+ cts))
+                             (m    (access run-hist% |#cts|))
+                             (run-hist% ;TODO:per subgoal num-cts stored??
+                              (if (< m num-cts)
+                                  (change run-hist% cts (cons A A-cts) )
+                                run-hist%));dont store extra 
+                             (run-hist%   (run-hist-1+ cts)))
+;                              in
+                         (mv run-hist% gcs%)))
+
+
+      (:witness          (b* ((A-wts (access run-hist% wts))
+                             ((when (member-equal A A-wts))
+                              (mv (run-hist-1+ dups) (gcs-1+ dups)))
+                             (gcs% (gcs-1+ wts))
+                             (m    (access run-hist% |#wts|))
+                             (run-hist%   
+                              (if (< m num-wts)
+                                  (change run-hist% wts (cons A A-wts))
+                                run-hist%));dont store extra
+                             (run-hist%   (run-hist-1+ wts)))
+;                         in       
+                          (mv run-hist% gcs%)))
+
+                                             
+      (:vacuous          (b* ((A-vacs (access run-hist% vacs))
+                             ((when (member-equal A A-vacs))
+                              (mv ( run-hist-1+ dups) (gcs-1+ dups)))
+                             (gcs% (gcs-1+ vacs))
+                             (m    (access run-hist% |#vacs|))
+                             (run-hist%   
+                              (if (< m (acl2::+f num-wts num-cts))
+                                  (change run-hist% vacs (cons A A-vacs))
+                                run-hist%));dont store a lot of vacuouses
+                             (run-hist%   (run-hist-1+ vacs)))
+;                         in
+                          (mv run-hist% gcs%)))
+      (otherwise         (prog2$ (er hard 'test? "not possible") 
+                                 (mv run-hist% gcs%))))))
+
+
+(def run-n-tests. (n num-trials sm vl r. BE. run-hist% gcs%)
+  (decl :sig ((fixnum fixnum keyword fixnum fixnum symbol-fixnum-alist 
+                      run-hist% gcs%)
+              -> (mv boolean fixnum symbol-fixnum-alist 
+                     run-hist% gcs%))
+        :doc
+"?: 
+* Synopsis
+  Run 'n' number of trials on the formula under test
+
+* Input parameters 
+   n is num-trials minus current local-trial number.
+  'r.'  is the current pseudo-random seed.
+   BE. is the alist mapping variables to bounded-exhaustive seeds used in the last instantiation
+   num-trials is the current testing default
+   sm is sampling-method (the current testing default)
+   vl is verbosity-level.
+   run-hist% stores test run stats.
+   gcs% is the global (testing) coverage statistics which is used in determining stopping condition.
+
+* Returns: (mv stop? r. BE. run-hist% gcs%)
+stop? is T when stopping-condition? call is satisfied
+r. is updated pseudo-random seed
+BE. is the updated alist of bounded-exhaustive seeds
+run-hist% is the updated testrun history
+gcs% is the updated global coverage stats.
+
+")
+  (declare (ignorable vl))
+  (b* (((when (zpf n)) ;Oops, ran out of random trials
+        (mv NIL r. run-hist% gcs%))
+       ((when (stopping-condition? gcs%))
+;return, cos we have reached our goal  
+         (mv T r. run-hist% gcs%))
+
+       (local-trial-num  (acl2::|1+F| (acl2::-f num-trials n)))
+       ((mv res A r. BE.)
+;perform a random test run, the result quadruple
+;erp is a flag denoting error, res = value of test  A= value-bindings
+        (run-single-test. sm num-trials local-trial-num  r. BE.))
+       ((mv run-hist% gcs%) (record-testrun. res A run-hist% gcs%))
+       (- (cw? nil "~%test num ~x0 got A=~x1~|" n A)))
+;  in   
+   (run-n-tests. (acl2::|1-F| n) num-trials sm vl r. BE. run-hist% gcs%)))
+
+          
+
+(defmacro get-acl2s-default (param alist &optional default-value)
+  "get the default value of param as found in alist. if not found return default-value"
+  `(b* ((e (assoc-eq ,param ,alist)))
+     (if e
+         (cdr e)
+       ,default-value)))         
+
+
+
+;; Pre Condition: hypothesis-val, conclusion-val and next-sigma have been
+;; attached when this function is called!
+(def run-tests. (N sm vl fvars rseed. run-hist% gcs%)
+  (decl :sig ((fixnump keywordp fixnump symbol-listp 
+                       fixnump run-hist%-p gcs%-p) 
+              -> (mv fixnump run-hist%-p gcs%-p))
+        ;:trace T
+        :doc 
+"?: Run a bunch of simple random/bounded-exhaustive tests/trials to
+  find cts/wts for form under test")
+;do timeout wrapper here!        
+  (b* (((mv stop? rseed. run-hist% gcs%)
+        (run-n-tests. N N
+                      sm
+                      vl
+                      rseed. 
+                      (pairlis$ fvars 
+                                (make-list (len fvars) :initial-element 0))
+                      run-hist%
+                      gcs%
+                      ))
+       
+       (- (cw? (system-debug-flag vl) "~|run-hist: ~x0 ~|gcs%: ~x1~%"
+               run-hist% gcs%)))
+   ;;in
+    (mv stop? rseed. run-hist% gcs%)))
+         
+          
+(defun acl2s-defaults-fn. (defaults override-alist ans.)
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbol-alistp defaults)
+                              (symbol-alistp override-alist)
+                              (symbol-alistp ans.))))
+  (if (endp defaults)
+      ans.
+    (b* (((cons param rec-val) (car defaults))
+         (val (acl2::access acl2::acl2s-param-info% rec-val :value))
+         (override (assoc-eq param override-alist))
+         (val (if override (cdr override) val)))
+      (acl2s-defaults-fn. (cdr defaults) 
+                          override-alist 
+                          (cons (cons param val) ans.)))))
+
+(defmacro acl2s-defaults-alist (&optional override-alist)
+  "return alist mapping acl2s-parameters to their default values
+overridden by entries in override-alist"
+  `(acl2s-defaults-fn. (table-alist 'acl2::acl2s-defaults-table (w state))
+                      ,override-alist '()))
+         
+(def separate-const/simple-hyps. (ts wrld Hc. Hs. Ho.)
+  (decl :sig ((pseudo-term-list plist-world 
+               pseudo-term-list pseudo-term-list pseudo-term-list) 
+              -> (mv pseudo-term-list pseudo-term-list pseudo-term-list))
+        :doc "given a list of hyps, separate constant hyps, simple defdata-type hyps and others")
+  (f* ((add-others-and-recurse... () (separate-const/simple-hyps. 
+                                      rst wrld Hc. Hs. (cons hyp Ho.)))
+       (add-constant-and-recurse (h) (separate-const/simple-hyps.
+                                      rst wrld (cons h Hc.) Hs. Ho.)))
+  (if (endp ts)
+      (mv Hc. Hs. Ho.)
+    
+    (b* (((cons hyp rst) ts)) ;pattern matching in b*
+    (case-match hyp
+      ((P t1)     (if (and (symbolp t1)
+                           (is-type-predicate P wrld))
+                      (separate-const/simple-hyps. rst wrld 
+                                                   Hc. (cons hyp Hs.) Ho.)
+                    (add-others-and-recurse...)))
+                          
+      ((R t1 t2)  (if (acl2::equivalence-relationp R wrld)
+                      (cond ((and (symbolp t1) (quotep t2))
+                             (add-constant-and-recurse (list R t1 t2)))
+                            
+                            ((and (quotep t1) (symbolp t2))
+                             (add-constant-and-recurse (list R t2 t1)))
+                            
+                            (t (add-others-and-recurse...)))
+                    (add-others-and-recurse...)))
+      (&          (add-others-and-recurse...)))))))
+
+
+
+(def all-vars-lst (terms)
+  (decl :sig ((pseudo-term-listp) -> symbol-list)
+        :doc "all free variables in list of terms")
+  (all-vars1-lst terms '()))
+(verify-termination dumb-negate-lit)
+
+(def vars-in-dependency-order (hyps concl vl wrld)
+  (decl :sig ((pseudo-term-list pseudo-term fixnum plist-world) -> symbol-list)
+        :doc "return the free variables ordered according to the notion of
+  dependency that treats equality relation specially. See FMCAD paper for
+  details, but I have not completely implemented the improvements in the
+  paper. This is where I can use better heuristics. But with no hard examples
+  to work on, I am doing a naive job for now.")
+  (b* ((cterms (cons (dumb-negate-lit concl) hyps))
+; cterms names constraint terms
+       (vars (all-vars-lst cterms))
+       ((mv Hc Hs Ho) (separate-const/simple-hyps. cterms wrld '() '() '()))
+       
+       (dgraph (build-variable-dependency-graph Ho vars)) ;TODO rewrite
+       (ord-vs (rev (approximate-topological-sort dgraph (debug-flag vl))))
+       
+       (cvars (all-vars-lst Hc))
+       (svars (all-vars-lst Hs))
+; add only those svars that are not in ord-vs to front of ord-vs
+; cvars should always be in front, i.e they should be chosen first
+       (ord-vs (union-eq svars ord-vs)) ;NOT a set operation
+       (ord-vs (union-eq cvars 
+                         (set-difference-eq ord-vs cvars)))
+
+; 8th Jan 2013 Possible CCG bug
+; Overcaution: remove t and nil which escape pseudo-termp
+       (ord-vs (set-difference-eq  ord-vs '(t nil)))
+       )
+
+   ord-vs))
+       
+
+;;; Foll fun lifted from  type.lisp
+;; NOTE: In the following the type 'empty' has
+;; special status and treated seperately
+(def meet (typ1 typ2 vl wrld R$ types-ht$)
+  
+  (decl :sig ((symbol symbol vl plist-worldp R$ types-ht$) -> symbol)
+        :doc "find smaller type in subtype hierarchy/lattice")
+  (declare (xargs :verify-guards nil))
+  ;; (decl :sig ((possible-defdata-type-p possible-defdata-type-p
+;;                plist-world) -> possible-defdata-type-p)
+  (b* (((when (or (eq 'acl2::empty typ1)
+                  (eq 'acl2::empty typ2))) 'acl2::empty)
+       ((when (eq typ2 typ1)) typ2)
+       ((unless (and (defdata::is-a-typeName typ1 wrld)
+                     (defdata::is-a-typeName typ2 wrld)))
+        (prog2$
+         (cw? (verbose-stats-flag vl)
+              "~|CEgen/Note: ~x0 or ~x1 not a defdata type. ~ Meet returning universal type ALL.~|" typ1 typ2)
+         'acl2::all))
+       ((when (eq 'acl2::all typ1)) typ2)
+       ((when (eq 'acl2::all typ2)) typ1)
+       ((when (is-subtype$$ typ1 typ2 R$ types-ht$))   typ1)
+       ((when (is-subtype$$ typ2 typ1 R$ types-ht$))   typ2)
+       ((when (is-disjoint$$ typ2 typ1 R$ types-ht$))  'acl2::empty) ;Should we instead define the NULL type??? Modified: so Ans is YES instead of Ans: NO, the way its used now, this is right!
+;give preference to custom type
+       ((when (defdata::is-a-custom-type typ1 wrld)) typ1)
+       ((when (defdata::is-a-custom-type typ2 wrld)) typ2)
+
+; choose the one that was defined later (earlier in 
+; reverse chronological order)
+       (u1 (type-vertex-ht-get typ1 types-ht$))
+       (u2 (type-vertex-ht-get typ2 types-ht$)))
+   (if (< u1 u2) 
+       typ2 
+     typ1)))
+
+
+
+
+
+
+;;;; Collecting type and additional constraints
+
+;;; Given a list of hypotheses and a conclusion, we want to find the
+;;; type constraints on each free variable. We collect 3 categories of
+;;; constraints: 1. defdata type and spilled defdata types 2. equality
+;;; constraint 3. range constraints 4. additional constraints.
+
+;;; A defdata type has a type-predicate and a type-enumerator
+;;; associated with it.  Ideally we would like to compute the minimal
+;;; (best possible) defdata type information, but this can fail, due
+;;; to incomplete subtype type information.  So we end up also storing
+;;; spillover types, whose union/join is the conservative (superset)
+;;; type of the corresponding variable. We also store the equality
+;;; constraint, since its a very strong constraint and often comes up
+;;; in naive dependencies. Finally we also store additional
+;;; constraints, just so as to not throw away information that can
+;;; fruitfully be utilized to come up with the smallest set of
+;;; possible values the constrained variable can take.
+;;; range is just a tau-intervalp
+
+(defrec cs% (defdata-type spilled-types 
+              eq-constraint range additional-constraints) NIL)
+
+(defun possible-defdata-type-p (v)
+  (declare (xargs :guard T))
+  (or (is-singleton-type-p v)
+      (is-a-variablep v))) ;defdata type
+
+(defun possible-defdata-type-list-p (vs)
+  (declare (xargs :guard T))
+  (if (consp vs)
+      (and (possible-defdata-type-p (car vs))
+           (possible-defdata-type-list-p (cdr vs)))
+    T))
+
+(defun cs%-p (v)
+  (declare (xargs :guard T))
+  (case-match v
+    (('cs% dt st eqc int ac)   (and (possible-defdata-type-p dt) 
+                                (possible-defdata-type-list-p st)
+                                (or (pseudo-termp eqc)
+                                    (eq 'defdata::empty-eq-constraint eqc))
+                                (acl2::tau-intervalp int)
+                                (pseudo-term-listp ac)))))
+    
+
+(defun |is (symbol . cs%)| (v)
+  (declare (xargs :guard T))
+  (case-match v
+    ((x . y)      (and (symbolp x)
+                       (cs%-p y)))))
+
+(defun symbol-cs%-alistp (vs)
+  (declare (xargs :guard T))
+  (if (consp vs)
+      (and (|is (symbol . cs%)| (car vs))
+           (symbol-cs%-alistp (cdr vs)))
+    NIL))
+           
+
+  ;; (foldl (lambda (v acc) (and acc (|is a (symbol . type-constraints%)| v) ))
+  ;;        T vs)) 
+; Note: The above expression if implemented is not as efficient as 
+;; (defun _-list-p (xs) 
+;;   (if (endp x) T 
+;;     (and (_-p (car x))
+;;          (_-list-p (cdr x)))))
+  ;; (and (true-listp vs)
+  ;;      (null ([ x : x in vs : (not (|is a (symbol . type-constraints%)|)) ])))
+ 
+
+;; TODO: conclusion is not taken care of now. Only negated conclusion
+;; is treated, but we would like to be symmetric with respect to
+;; searching cts and wts. --harshrc 4th March 2012.
+
+(def put-additional-constraints. (vs term v-cs%-alst.)
+  (decl :sig ((symbol-list pseudo-term symbol-cs%-alist) 
+              -> symbol-cs%-alist)
+        :doc "put term in alist for all keys in vs")
+  (if (endp vs)
+      v-cs%-alst.
+    (b* (((cons v cs%) (assoc-eq (car vs) v-cs%-alst.))
+         (cs% (change cs% additional-constraints 
+                      (cons term (access cs% additional-constraints)))))
+    (put-additional-constraints. (cdr vs) term 
+                                 (put-assoc-eq v cs% v-cs%-alst.)))))
+
+;2 july '13 (type-info-lost-via-dest-elim issue)
+; TODO: check if check for cycles is correct!
+(def put-var-eq-constraint. (v1 v2 vl wrld R$ types-ht$ v-cs%-alst.)
+  (decl :sig ((symbol symbol vl plist-world R$ types-ht$ symbol-cs%-alist) 
+              -> symbol-cs%-alist)
+        :doc "put variable equality constraint in alist for key v")
+  (declare (xargs :verify-guards nil) (ignore wrld))
+  (b* (((cons & cs1%) (assoc-eq v1 v-cs%-alst.))
+       ((cons & cs2%) (assoc-eq v2 v-cs%-alst.))
+       (dt1 (acl2::access cs% cs1% :defdata-type))
+       (dt2 (acl2::access cs% cs2% :defdata-type))
+       ((mv v other-v cs% other-cs%) (if (is-subtype$$ dt2 dt1 R$ types-ht$) 
+                                         (mv v1 v2 cs1% cs2%) ;dt2 is better
+                                       (mv v2 v1 cs2% cs1%) 
+                                       ))
+       (eqc (acl2::access cs% cs% :eq-constraint))
+       (other-eqc (acl2::access cs% other-cs% :eq-constraint))
+       ((when (eq other-v eqc)) v-cs%-alst.) ;redundant
+       ((when (eq v other-eqc)) v-cs%-alst.) ;avoid cycle!!
+       (- (cw? (and (verbose-stats-flag vl)
+                    (not (eq 'defdata::empty-eq-constraint eqc))) 
+               "CEgen/Note: Overwriting eq-constraint for ~x0 with ~x1~|" v other-v))
+       (cs% (change cs% eq-constraint other-v)))
+   (put-assoc-eq v cs% v-cs%-alst.)))
+
+(def put-eq-constraint. (v term vl v-cs%-alst.)
+  (decl :sig ((symbol pseudo-term vl symbol-cs%-alist) 
+              -> symbol-cs%-alist)
+        :doc "put eq-constraint term in alist for key v")
+  (b* (((cons & cs%) (assoc-eq v v-cs%-alst.))
+       (eqc (access cs% eq-constraint))
+       (- (cw? (and (verbose-stats-flag vl)
+                    (not (eq 'defdata::empty-eq-constraint eqc)))
+               "CEgen/Note: Overwriting eq-constraint for ~x0 with ~x1~|" v term))
+       (cs% (change cs% eq-constraint term)))
+   (put-assoc-eq v cs% v-cs%-alst.)))
+
+(def put-defdata-type. (v typ vl v-cs%-alst.)
+  (decl :sig ((symbol possible-defdata-type-p fixnum symbol-cs%-alist) 
+              -> symbol-cs%-alist)
+        :doc "put defdata type typ in alist for key v")
+  (b* (((cons & cs%) (assoc-eq v v-cs%-alst.))
+       (dt (access cs% defdata-type))
+       (- (cw? (and (verbose-stats-flag vl) (not (eq 'acl2::all dt))) 
+"CEgen/Note: Overwriting defdata type for ~x0. ~x1 -> ~x2~|" v dt typ))
+       (cs% (change cs% defdata-type typ)))
+   (put-assoc-eq v cs% v-cs%-alst.)))
+
+
+
+(defs  ;;might be mut-rec, but right now I assume tht I wont encounter
+       ;;AND and OR like if expressions, and hence dont need the
+       ;;mutually-recursive counterpart of v-cs%-alist-from-term. TODO
+  (v-cs%-alist-from-term. (term vl wrld R$ types-ht$ ans.)
+  (decl :sig ((pseudo-term fixnum plist-world R$ types-ht$ symbol-cs%-alist)
+              ->
+              symbol-cs%-alist)
+        :doc "helper to collect-constraints")
+  (declare (xargs :verify-guards nil))
+;Invariant: ans. is an alist thats in the order given by dependency analysis
+  (f* ((add-constraints... () (put-additional-constraints. fvars term ans.))
+         
+       (add-eq-constraint... (t1) (if (acl2::equivalence-relationp R wrld)
+                                      (if (symbolp t1)
+                                          (put-var-eq-constraint. x t1 vl wrld R$ types-ht$ ans.)
+                                        (put-eq-constraint. x t1 vl ans.))
+                                    (add-constraints...))))
+     
+   (b* ((fvars (all-vars term)))
+           
+    (case-match term
+      
+;the following is a rare case (I found it when the conclusion is nil
+;and its negation is 'T
+      (('quote c) (declare (ignore c))  ans.) ;ignore quoted constant terms 
+
+;TODO possible field variable (i.e f is a getter/selector)
+; Note that term cannot have a lambda applicaton/let, so the car of the term is
+; always a function symbol if term is a consp.
+      ((P (f . &)) (declare (ignore P f))  (add-constraints...)) 
+
+;x has to be an atom below, otherwise, we would have caught that case above.
+      (('not x)      (put-eq-constraint. x ''nil vl ans.))
+      
+      ((P x)   (b* ((tname (is-type-predicate P wrld))
+                    ((cons & cs%) (assoc-eq x ans.))
+                    (curr-typ (access cs% defdata-type))
+                    (smaller-typ (meet tname curr-typ vl wrld R$ types-ht$)))
+                (if tname
+                    (if (not (eq smaller-typ curr-typ))
+                        (put-defdata-type. x smaller-typ vl ans.)
+                      ans.)
+                  (add-constraints...))))
+
+      ((R (f . &) (g . &)) (declare (ignore R f g)) (add-constraints...))
+
+;x has to be an atom below, otherwise, we would have caught that case
+;above.
+      ((R x ('quote c))    (add-eq-constraint... (kwote c)))
+      ((R ('quote c) x)    (add-eq-constraint... (kwote c)))
+      ((R x (f . args))    (add-eq-constraint... (acl2::cons-term f args)))
+      ((R (f . args) x)    (add-eq-constraint... (acl2::cons-term f args)))
+      ((R x y)             (add-eq-constraint... y))
+      
+      ;; has to be a (R t1 t2 ...) or atomic term
+      (&                   (add-constraints...)))))))
+                         
+  
+(def v-cs%-alist-from-terms. (terms vl wrld R$ types-ht$ ans.)
+  (decl :sig ((pseudo-term-listp fixnum plist-worldp R$ types-ht$ symbol-cs%-alist) 
+              -> symbol-cs%-alist)
+        :doc "helper to collect-constraints%")
+  (declare (xargs :verify-guards nil))
+  (if (endp terms)
+      ans.
+    (v-cs%-alist-from-terms. (cdr terms) vl wrld R$ types-ht$ 
+                             (v-cs%-alist-from-term. (car terms)
+                                                     vl wrld R$ types-ht$ ans.))))
+
+(def put-range-constraint. (v int v-cs%-alst.)
+  (decl :sig ((symbolp acl2::tau-intervalp symbol-cs%-alistp) 
+              -> symbol-cs%-alistp)
+        :doc "put interval int in alist for key v")
+  (b* (((cons & cs%) (assoc-eq v v-cs%-alst.))
+       (cs% (change cs% range int)))
+   (put-assoc-eq v cs% v-cs%-alst.)))
+
+(def range-is-alias-p (interval type wrld R$ types-ht$)
+  (decl :sig ((non-empty-non-universal-interval-p symbolp plist-worldp R$ types-ht$) -> boolean)
+        :doc "is interval an alias of type?")
+  (declare (xargs :verify-guards nil) (ignore wrld))
+  (b* ((lo (acl2::access acl2::tau-interval interval :lo))
+       (hi (acl2::access acl2::tau-interval interval :hi))
+       (lo-rel (acl2::access acl2::tau-interval interval :lo-rel))
+       (hi-rel (acl2::access acl2::tau-interval interval :hi-rel)))
+    (case (acl2::access acl2::tau-interval interval :domain)
+      (acl2::integerp (or (and (is-subtype$$ type 'acl2::nat R$ types-ht$) ;use the fact that integers are squeezed (weak inequalities)
+                               (equal lo 0)
+                               (null hi))
+                          (and (is-subtype$$ type 'acl2::pos R$ types-ht$) 
+                               (equal lo 1)
+                               (null hi))
+                          (and (is-subtype$$ type 'acl2::neg R$ types-ht$) 
+                               (null lo)
+                               (equal hi -1))))
+      (otherwise (or (and (is-subtype$$ type 'acl2::positive-rational R$ types-ht$)
+                          lo-rel ;strict
+                          (null hi)
+                          (equal lo 0))
+                     (and (is-subtype$$ type 'acl2::negative-rational R$ types-ht$) 
+                          hi-rel
+                          (null lo)
+                          (equal hi 0)))))))
+
+(def assimilate-apriori-type-information (vs type-alist tau-interval-alist vl wrld R$ types-ht$ ans.)
+  (decl :sig ((symbol-list symbol-alist symbol-alist fixnum plist-world R$ types-ht$ symbol-cs%-alist) 
+              -> symbol-cs%-alist)
+        :doc 
+"overwrite into v-cs%-alst. the type information in type-alist/tau-interval-alist.
+Put defdata symbol types into defdata-type field, but put constants
+into eq-constraint field, put interval into range constraint field")
+  (declare (xargs :verify-guards nil))
+; Aug 30 '12 -- This function fixes a bug in Pete's GE demo, where the
+; type=alist had 'NIL as the type, which is a singleton defdata type
+; and I was not taking it into consideration when trying to run MEET
+; on it, which cannot handle types which are not in the defdata graph,
+; and certainly constants are not part of the defdata graph.
+  (if (endp vs)
+      ans.
+    (b* ((x (car vs))
+         (prior-t (assoc-eq x type-alist)) ;prior-t is consp assert!
+;type-alist of of form (listof (cons var (listof defdata-type)))
+;where defdata-type is possible-defdata-type-p. listof represents unions.
+         (- 
+; TODO: Union types are ignored. Implement them.
+; But note that since we always get this through a meet-type-alist, we
+; throw away the union type information there itself.
+           (cw? (and (verbose-stats-flag vl)
+                     (consp prior-t)
+                     (consp (cdr prior-t)) 
+                     (not (null (cddr prior-t))))
+"~|CEgen/Warning: Ignoring rest of union types ~x0 ~|" (cddr prior-t)))
+         (typ-given (if (and (consp prior-t) (consp (cdr prior-t)))
+                        (cadr prior-t)
+                      'ACL2::ALL))
+         ((when (possible-constant-valuep typ-given))
+; is a singleton, then treat it as a eq-constraint
+; BOZO: meet-type-alist does it differently. (03/04/13)
+          (assimilate-apriori-type-information 
+           (cdr vs) type-alist tau-interval-alist vl wrld R$ types-ht$ 
+           (put-eq-constraint. x typ-given vl ans.)))
+         (int-entry (assoc-eq x tau-interval-alist))
+         (int (cdr int-entry)) ;possible type bug
+         ((when (singleton-tau-intervalp int))
+; is a singleton, then treat it as a eq-constraint
+          (assimilate-apriori-type-information 
+           (cdr vs) type-alist tau-interval-alist vl wrld R$ types-ht$ 
+           (put-eq-constraint. x (kwote (acl2::access acl2::tau-interval int :lo)) vl ans.)))
+         ((cons & cs%) (assoc-eq x ans.))
+         (curr-typ (access cs% defdata-type))
+         (final-typ (meet curr-typ typ-given vl wrld R$ types-ht$))
+         (ans. (if (and (non-empty-non-universal-interval-p int)
+                        (not (range-is-alias-p int final-typ wrld R$ types-ht$)))
+                   (put-range-constraint. x int ans.)
+                 ans.)))
+                   
+; update the current defdata type with the new type information (type-alist)
+     (assimilate-apriori-type-information 
+      (cdr vs) type-alist tau-interval-alist vl wrld R$ types-ht$
+      (put-defdata-type. x final-typ vl ans.)))))
+
+(defconst *empty-cs%*
+  (acl2::make cs%
+        :defdata-type 'acl2::all 
+        :spilled-types '()
+        :eq-constraint 'defdata::empty-eq-constraint
+        :range (acl2::make-tau-interval nil nil nil nil nil)
+        :additional-constraints '()))
+
+(def collect-constraints% (hyps ordered-vars type-alist tau-interval-alist vl wrld R$ types-ht$)
+  (decl :sig ((pseudo-term-listp symbol-listp symbol-alistp symbol-alistp
+                                 fixnum plist-worldp R$ types-ht$) -> symbol-cs%-alist)
+        :doc 
+" 
+* Synopsis 
+  For each free variable compute/infer both the simple defdata types
+  and additional constraints on it.
+
+* Input hyps is a usually a list of hypotheses of the conjecture under
+  query and is a term-listp ordered-vars is the free variables of
+  hyps, but in the variable dependency order as computed from the
+  dependency graphs of hyps.  type-alist is the type information
+  inferred from ACL2 usually (intersected with the top-level dumb type
+  inference), or it might be prior type knowledge we dont want to lose
+  i.e if the type inferred from hyps are weaker than in type-alist we
+  will keep the stronger type information.
+  
+
+* Output
+  An alist mapping free variables to cs% record
+")
+  (declare (xargs :verify-guards nil))
+  (f* ((unconstrained-v-cs%-alst 
+          (xs) 
+          (pairlis$ xs (make-list (len xs)
+                                  :initial-element 
+                                  *empty-cs%*))))
+      ;; initialize the alist
+    (b* ((v-cs%-alst  (unconstrained-v-cs%-alst ordered-vars))
+         (v-cs%-alst  (assimilate-apriori-type-information
+                       ordered-vars type-alist tau-interval-alist
+                       vl wrld R$ types-ht$ v-cs%-alst)))
+       
+     (v-cs%-alist-from-terms. hyps vl wrld R$ types-ht$ v-cs%-alst))))
+
+(defun symbol-unsigned-29bits-alistp (v)
+  (declare (xargs :guard T))
+  (if (atom v)
+      (null v)
+    (and (consp (car v))
+         (symbolp (caar v))
+         (unsigned-29bits-p (cdar v))
+         (symbol-unsigned-29bits-alistp (cdr v)))))
+
+(defthm symbol-unsigned-29bits-alistp-forwards-to-symbol-alistp
+  (implies (symbol-unsigned-29bits-alistp x)
+           (symbol-alistp x))
+  :rule-classes :forward-chaining)
+
+; (random-natural-seed seed.) => (mv random-nat new-seed)
+#||
+function to compute next BE seed tuple
+Precondition: BE. is a consp, i.e at least one free variable
+Here is the simple scheme:
+((x 0) (y 0) (z 0)) -> 
+((y 0) (z 0) (x 1)) -> 
+((z 0) (x 1) (z 1)) -> 
+((x 0) (y 0) (z 0)) -> 
+((x 0) (y 0) (z 0)) ->
+((x 0) (y 0) (z 0)) ->
+((x 0) (y 0) (z 0)) 
+
+The above algo is O(n) in num of free vars. but simple to implement.
+Arrays or a stobj can make this constant time operation.  
+
+Alternative algo: Traverse the enumeration tree in BFS order.  Hvent
+thought about how to implement it.
+||#
+
+;;; (symbol-unsigned-29bits-alistp) -> symbol-unsigned-29bits-alistp)
+;; update 29th April '12
+;; let cut the optimization to get guards to verify
+(defun |next BE args| (BE.)
+  "naive bounded exhaustive enumeration."
+  (declare (xargs :guard (and (true-listp BE.)
+                              (consp BE.)
+                              (symbol-alistp BE.))))
+                          
+  (b* (((cons v ;; (the (unsigned-byte 29)
+                  m) (car BE.))
+       (;; (the (unsigned-byte 29) 
+        m~ (;; acl2::|1+F|
+            1+  (nfix m))))
+   (append (cdr BE.) (list (cons v m~)))))
+            
+     
+(defconst *recursive-uniform-enum-measure* 8)
+
+
+(def make-next-sigma_mv-let (var-enumcalls-alist body)
+  (decl :sig ((symbol-alistp all) -> all)
+        :doc "helper function to make-next-sigma")
+  (f* ((_mv-value (v exp exp2) 
+          `(case sampling-method 
+             (:uniform-random (b* (((mv ?m seed.) 
+                                    (random-index-seed *recursive-uniform-enum-measure* seed.))
+                                   ((mv val seed.) ,exp2))
+                        (mv seed. BE. val)))
+             (:random 
+              (b* (((mv ?r seed.) (random-natural-seed seed.)))
+                (mv seed. BE. ,exp)))
+             ;; bugfix - It is possible that r is not in exp
+             ;; this is the case when exp is a eq-constraint
+             (:be (b* ((?r (cdr (assoc-eq ',v BE.))))
+                   (mv seed. (|next BE args| BE.) ,exp)))
+             (otherwise (mv seed. BE. '0)))))
+                           
+  (if (endp var-enumcalls-alist)
+      body
+    (b* (((cons var ecalls) (first var-enumcalls-alist)))
+;    in 
+     `(mv-let (seed. BE. ,var)
+              ,(_mv-value var (first ecalls) (second ecalls))
+            ,(make-next-sigma_mv-let (rest var-enumcalls-alist) body))))))
+
+(def make-guard-var-member-eq (vars alst)
+  (decl :sig ((symbol-alistp symbol) -> all)
+        :doc "helper function to make-next-sigma")
+  (if (endp vars)
+      nil
+    (cons `(member-eq ',(car vars) ,alst)
+          (make-guard-var-member-eq (cdr vars) alst))))
+  
+(def cs%-enumcalls (cs% vl wrld R$ types-ht$ computed-vars)
+  (decl :sig ((cs%-p fixnump plist-worldp R$ types-ht$ symbol-listp) 
+              -> (mv fixnum (cons pseudo-termp pseudo-termp)))
+        :doc "for each cs% record we translate it into the a (mv
+  size (list enumcall enumcall2)), where the enumcall is an expression
+  that when evaluated gives a value (with random distribution) of
+  correct type/constraint and size is the size of the type i.e the set
+  of value satisfied by the constraint. enumcall2 is a similar
+  expression but with the random seed accumulated/threaded
+  uniformly. Return value of (mv 0 nil) stands for an error and is
+  recognized by the caller function as such.")
+  (declare (xargs :verify-guards nil))
+;;; TODO: optimize/complete here using extra information in
+;;; spilled-types and additional-constraints
+  (case-match cs%
+;('cs% defdata-type spilled-types eq-constraint interval additional-constraints)
+    (('cs% defdata-type & 'defdata::empty-eq-constraint range &) 
+; ACHTUNG: cs% defrec exposed
+     (b* ((enum-info% (get-enum-info% defdata-type range vl wrld R$ types-ht$)))
+      (mv (access enum-info% size) (list (access enum-info% expr)
+                                         (access enum-info% expr2)))))
+
+; if we see a equality constraint, we give preference to it over a
+; defdata type, but only if the variables in the eq-constraint are
+; already computed i.e already have an enumcall in the final answer
+    (('cs% defdata-type & eq-constraint range &)    
+     (b* ((eq-vs (all-vars eq-constraint))
+          (remaining (set-difference-eq eq-vs computed-vars)))
+      (if remaining
+          (b* ((enum-info% (get-enum-info% defdata-type range vl wrld R$ types-ht$)))
+           (mv (access enum-info% size) (list (access enum-info% expr)
+                                              (access enum-info% expr2))))
+        (mv 1 (list eq-constraint (list 'mv eq-constraint 'seed.))))))
+    (& (prog2$ 
+        (cw? (normal-output-flag vl) "~|CEgen/Error: BAD record cs% passed to cs%-enumcalls")
+        (mv 0 NIL)))))
+               
+     
+
+(def make-enumerator-calls-alist (v-cs%-alst vl wrld R$ types-ht$ ans.)
+  (decl :sig ((symbol-cs%-alist fixnum plist-world R$ types-ht$ symbol-alist) 
+              -> (mv erp symbol-alist))
+        :doc 
+        "given an alist mapping variables to cs% records (in dependency order),
+  we walk down the alist, translating each type constraint to the corresponding
+enumerator call expression")
+  (declare (xargs :verify-guards nil))
+  (if (endp v-cs%-alst)
+      (mv nil (rev ans.)) ;dont change the original dependency order
+    (b* (((cons x cs%) (car v-cs%-alst))
+         ((mv size calls) (cs%-enumcalls cs% vl wrld R$ types-ht$ (strip-cars ans.)))
+;simple bug July 9 2013: below comparison, replaced int= with equal, this could have been caught by type-checking/guard-verif
+         ((when (equal size 0)) (mv t '()))) 
+;    in
+     (make-enumerator-calls-alist (cdr v-cs%-alst) vl wrld R$ types-ht$
+                                 ;; add in reverse order
+                                 (cons (cons x calls) ans.)))))
+    
+(defun displayed-range (interval)
+  (b* ((lo (acl2::access acl2::tau-interval interval :lo))
+       (hi (acl2::access acl2::tau-interval interval :hi))
+       (lo-rel (acl2::access acl2::tau-interval interval :lo-rel))
+       (hi-rel (acl2::access acl2::tau-interval interval :hi-rel)))
+    (cond ((and lo hi)
+           `(,lo ,(if lo-rel '< '<=) 'acl2::_  ,(if hi-rel '< '<=) ,hi))
+          (lo
+           `(,(if lo-rel '> '>=) ,lo))
+          (t `(,(if hi-rel '< '<=) ,hi)))))
+
+
+; DUPLICATION
+(def displayed-defdata-type/eq-constraint (cs% computed-vars)
+  (decl :sig ((cs%-p symbol-listp) 
+              -> (mv fixnum pseudo-termp))
+        :doc "for each cs% record we translate it to defdata-type or 
+equality constraint that will be used for enumeration. it shadows cs%-enumcall")
+  (case-match cs%
+;('cs% defdata-type spilled-types eq-constraint range additional-constraints)
+    (('cs% defdata-type & 'defdata::empty-eq-constraint range &) 
+; ACHTUNG: cs% defrec exposed
+     (if (non-empty-non-universal-interval-p range)
+         (list :type defdata-type :range (displayed-range range))
+       defdata-type))
+    (('cs% defdata-type & eq-constraint range &)    
+     (b* ((eq-vs (all-vars eq-constraint))
+          (remaining (set-difference-eq eq-vs computed-vars)))
+      (if remaining
+          (if (non-empty-non-universal-interval-p range)
+              (list :type defdata-type :range (displayed-range range))
+            defdata-type)
+        eq-constraint)))
+    (& 'bad-type)))
+
+(def displayed-enum-alist (v-cs%-alst ans.)
+  (decl :sig ((symbol-cs%-alist symbol-alist) 
+              -> symbol-alist)
+        :doc 
+        "given an alist mapping variables to cs% records (in dependency order),
+  we walk down the alist, translating each type constraint to the corresponding
+enumerator type/expr to be displayed in verbose mode")
+  (if (endp v-cs%-alst)
+      (rev ans.) ;dont change the original dependency order
+    (b* (((cons x cs%) (car v-cs%-alst))
+         (type (displayed-defdata-type/eq-constraint cs% (strip-cars ans.))))
+     
+     (displayed-enum-alist (cdr v-cs%-alst)
+                           ;; add in reverse order
+                           (cons (cons x type) ans.)))))
+
+;bugfix May 24 '12
+;partial-A needs to be quoted to avoid being confused with function app
+(def kwote-symbol-doublet-list (A)
+  (decl :sig ((symbol-doublet-listp) -> quoted-constantp))
+  (if (endp A)
+      nil
+    (cons (list 'list (kwote (caar A)) (cadar A))
+          (kwote-symbol-doublet-list (cdr A)))))
+
+(def make-next-sigma-defuns (hyps concl ord-vs 
+                                  partial-A type-alist tau-interval-alist
+                                  vl wrld R$ types-ht$)
+  (decl :sig ((pseudo-term-list pseudo-term symbol-list 
+                      symbol-doublet-listp symbol-alist symbol-alist
+                      fixnum plist-worldp R$ types-ht$) 
+              -> (mv erp all symbol-alist))
+        :doc "return the defun forms defining next-sigma function, given a
+        list of hypotheses and conclusion (terms). Also return the enum-alist to be displayed")
+  (declare (xargs :verify-guards nil))
+  (f* ((defun-forms ()
+         `((defun next-sigma-current (sampling-method seed. BE.)
+            "returns (mv A seed. BE.)"
+            (declare (ignorable sampling-method)) ;in case ord-vs is nil
+            (declare (type (unsigned-byte 31) seed.))
+            (declare (xargs :verify-guards nil
+                            :guard 
+                            (and (member-eq sampling-method
+                                            '(:random :uniform-random :be))
+                                 (unsigned-byte-p 31 seed.)
+                                 (symbol-unsigned-29bits-alistp BE.)
+                                 (consp BE.) ;precondition TODOcheck
+                                 (and ,@(make-guard-var-member-eq
+                                         (strip-cars var-enumcalls-alist)
+                                         'BE.)))
+                            :guard-hints 
+                            (("Goal" :in-theory (disable unsigned-byte-p)))))
+            ,(make-next-sigma_mv-let
+                var-enumcalls-alist
+; sigma will be output as a let-bindings i.e symbol-doublet-listp
+                `(mv ,(make-var-value-list-bindings 
+                       (strip-cars var-enumcalls-alist) 
+                       (kwote-symbol-doublet-list partial-A))
+                     seed. BE.)))
+           (defun next-sigma-current-gv (sampling-method seed. BE.)
+             (declare (xargs :guard T))
+             ;(declare (type (unsigned-byte 31) seed.))
+             (ec-call (next-sigma-current sampling-method seed. BE.))))))
+         
+       
+   (b* ((v-cs%-alst (collect-constraints% 
+                     (cons (dumb-negate-lit concl) hyps)
+                     ord-vs type-alist tau-interval-alist vl wrld R$ types-ht$))
+        ((mv erp var-enumcalls-alist)
+         (make-enumerator-calls-alist v-cs%-alst vl wrld R$ types-ht$ '()))
+        ((when erp) (mv erp '() '()))
+        )
+;   in
+    (mv nil (defun-forms) (displayed-enum-alist v-cs%-alst '())))))
+
+
+
+(defs 
+  (mv-list-ify (term mv-sig-alist)
+    (decl :sig ((pseudo-term symbol-list) -> pseudo-term)
+          :doc "wrap all mv fn calls with mv-list")
+    (if (variablep term)
+      term
+      (if (fquotep term)
+        term
+      (b* ((fn (ffn-symb term))
+           (args (fargs term))
+           (A mv-sig-alist)
+           (entry (assoc-eq fn A))
+           ((unless entry)
+            (acl2::cons-term fn
+                       (mv-list-ify-lst args A)))
+           ((cons fn m) entry)) 
+;m is output arity and should be greater than 1.
+        (acl2::cons-term 'acl2::mv-list
+                   (list (kwote m)
+                         (acl2::cons-term fn (mv-list-ify-lst args A))))))))
+
+  (mv-list-ify-lst (terms mv-sig-alist)
+   (decl :sig ((pseudo-term-list symbol-list) -> pseudo-term-list))
+   (if (endp terms)
+       '()
+     (cons (mv-list-ify (car terms) mv-sig-alist)
+           (mv-list-ify-lst (cdr terms) mv-sig-alist)))))
+         
+        
+
+(def make-let-binding-for-sigma (vs sigma-symbol)
+  (decl :sig ((symbol-list symbol) -> symbol-doublet-listp)
+        :doc 
+"(make-let-binding-for-sigma '(x y) 'A) => ((x (get-val x A))
+                                            (y (get-val y A)))
+")
+  (if (endp vs)
+      '()
+    (cons `(,(first vs) (cadr (assoc-eq ',(first vs) ,sigma-symbol)))
+          (make-let-binding-for-sigma (cdr vs) sigma-symbol))))
+
+(def make-hypotheses-val-defuns (terms ord-vars mv-sig-alist)
+  (decl :sig ((pseudo-term-list symbol-list symbol-alist) -> all)
+        :doc "make the defun forms for hypotheses-val defstub")
+  `((defun hypotheses-val-current (A)
+      (declare (ignorable A))
+      (declare (xargs :verify-guards nil :normalize nil
+                      :guard (symbol-doublet-listp A)))
+      (let ,(make-let-binding-for-sigma ord-vars 'A)
+        (declare (ignorable ,@ord-vars))
+          ,(mv-list-ify (single-hypothesis terms)
+                        mv-sig-alist)))
+    (defun hypotheses-val-current-gv (A)
+      (declare (xargs :guard T))
+      (ec-call (hypotheses-val-current A)))))
+
+(def make-conclusion-val-defuns (term ord-vars mv-sig-alist)
+  (decl :sig ((pseudo-term symbol-list symbol-alist) -> all)
+        :doc "make the defun forms for conclusion-val defstub")
+  `((defun conclusion-val-current (A)
+      (declare (ignorable A))
+      (declare (xargs :verify-guards nil :normalize nil
+                      :guard (symbol-doublet-listp A)))
+      (let ,(make-let-binding-for-sigma ord-vars 'A)
+        (declare (ignorable ,@ord-vars))
+          ,(mv-list-ify term mv-sig-alist)))
+    (defun conclusion-val-current-gv (A)
+      (declare (xargs :guard T))
+      (ec-call (conclusion-val-current A)))))
+
+;add the following for guard verif
+(defthm symbol-doublet-listp-=>-symbol-alistp
+  (implies (symbol-doublet-listp x)
+           (symbol-alistp x))
+  :rule-classes ((:forward-chaining)
+                 (:rewrite :backchain-limit-lst 1)
+                 ))
+
+
+;; records data that is later needed for printing stats/summary 
+(defrec s-hist-entry% (run-hist 
+                       (hyps vars . concl)
+                       (elide-map) ;printing top-level cts/wts
+                       (start-time . end-time) . name) NIL)
+
+(defun s-hist-entry%-p (v)
+  (declare (xargs :guard T))
+  (case-match v ;internal layout hidden
+    (('s-hist-entry% run-hist
+                     (hyps vars . concl)
+                     (elide-map)
+                     (start-time . end-time) . name)
+     (and (run-hist%-p run-hist)
+          (pseudo-term-listp hyps)
+          (pseudo-termp concl)
+          (symbol-listp vars)
+          (symbol-alistp elide-map) ;actually symbol term alist
+          (stringp name)
+          (rationalp start-time)
+          (rationalp end-time)))))
+          
+  
+(defun s-hist-p (v)
+"is a alist mapping strings to run-hist% records"
+  (declare (xargs :guard T))
+  (if (atom v)
+      (null v)
+    (and (consp (car v))
+         (stringp (caar v))
+         (s-hist-entry%-p (cdar v))
+         (s-hist-p (cdr v)))))
+
+(defun cgen-stats-p (v)
+;todo - probably inefficient
+  (declare (xargs :guard T))
+  (and (keyword-value-listp v)
+       ;(= (len v) 4) extensible
+       (assoc-keyword :gcs% v)
+       (assoc-keyword :s-hist v)))
+
+(defun cgen-stats-event-stackp (s)
+  (declare (xargs :guard T))
+  (if (atom s)
+      (null s)
+    (and (cgen-stats-p (car s))
+         (cgen-stats-event-stackp (cdr s)))))
+
+(defun valid-cgen-stats-event-stackp (s)
+  (declare (xargs :guard T))
+  "Should be a non-empty list whose member satisfies cgen-stats-event-stackp"
+  (and (cgen-stats-event-stackp s)
+       (consp s)))
+
+;; Feb 22 2013 Add a new global state variable which points to
+;; a stack of accumulated cgen recorded statistics. Its a stack
+;; because we can have nested events, but only the innermost
+;; member of the stack should ever be non-empty i.e only the top-level
+;; events like defthm/thm/test? should ever hold valid recorded data.
+;NOTE: interesting - I cant use defmacro instead of defabbrev
+(defabbrev get-gcs%-global () 
+  (if (f-boundp-global 'cgen-stats-event-stack state)
+    (b* ((cse-stack (@ cgen-stats-event-stack))
+         ((unless (valid-cgen-stats-event-stackp cse-stack))
+            (er hard? ctx "~|CEgen/Error: (get-gcs%) cgen-stats-event-stack is ill-formed~|"))
+         (gcs% (cadr (assoc-keyword :gcs% (car cse-stack)))))
+      (if (gcs%-p gcs%)
+          gcs%
+        (er hard? ctx "~|CEgen/Error: gcs% found in globals is of bad type~|")))
+    (er hard? ctx "~|CEgen/Error: cgen-stats-event-stack not found in globals ~|")))
+
+(defabbrev get-s-hist-global () 
+  (if (f-boundp-global 'cgen-stats-event-stack state)
+    (b* ((cse-stack (@ cgen-stats-event-stack))
+         ((unless (valid-cgen-stats-event-stackp cse-stack))
+          (er hard? ctx "~|CEgen/Error: (get-s-hist) cgen-stats-event-stack is ill-formed~|"))
+         (s-hist (cadr (assoc-keyword :s-hist (car cse-stack)))))
+      (if (s-hist-p s-hist)
+          s-hist
+        (er hard? ctx "~|CEgen/Error: hist found in globals is of bad type~|")))
+    (er hard? ctx "~|CEgen/Error: cgen-stats-event-stack not found in globals ~|")))
+
+(defabbrev put-gcs%-global (gcs%) 
+  (if (f-boundp-global 'cgen-stats-event-stack state)
+      (if (gcs%-p gcs%)
+          (b* ((cse-stack (@ cgen-stats-event-stack))
+               ((unless (valid-cgen-stats-event-stackp cse-stack))
+                  (prog2$ 
+                 (er hard? ctx "~|CEgen/Error: (put-gcs%) cgen-stats-event-stack is ill-formed~|")
+                 state))
+               (cse-stack (cons (list* :gcs% gcs% (acl2::remove-keyword :gcs% (car cse-stack))) 
+                                (cdr cse-stack)));update 
+               (- (assert$ (valid-cgen-stats-event-stackp cse-stack) 'put-gcs%-global)))
+          (f-put-global 'cgen-stats-event-stack cse-stack state))
+        (prog2$ 
+         (er hard? ctx "~|CEgen/Error: gcs% being put in globals is of bad type~|")
+         state))
+    (prog2$ (er hard? ctx "~|CEgen/Error: cgen-stats-event-stack not found in globals ~|")
+            state)))
+
+(defabbrev put-s-hist-global (s-hist) 
+  (if (f-boundp-global 'cgen-stats-event-stack state)
+      (if (s-hist-p s-hist)
+          (b* ((cse-stack (@ cgen-stats-event-stack))
+               ((unless (valid-cgen-stats-event-stackp cse-stack))
+                (prog2$ 
+                 (er hard? ctx "~|CEgen/Error: (put-s-hist) cgen-stats-event-stack is ill-formed~|")
+                 state))
+               (cse-stack (cons (list* :s-hist s-hist (acl2::remove-keyword :s-hist (car cse-stack))) 
+                                (cdr cse-stack)));update
+               (- (assert$ (valid-cgen-stats-event-stackp cse-stack) 'put-s-hist-global)))
+          (f-put-global 'cgen-stats-event-stack cse-stack state))
+        (progn$
+         (cw? (debug-flag vl) "~|BAD s-hist : ~x0~|" s-hist)
+         (er hard? ctx "~|CEgen/Error: hist being put in globals is of bad type~|")
+         state))
+    (prog2$ (er hard? ctx "~|CEgen/Error: cgen-stats-event-stack not found in globals ~|")
+            state)))
+
+
+(defconst *initial-run-hist%* 
+  (acl2::make run-hist% 
+              :cts '() :wts '() :vacs '() 
+              :|#wts| 0 :|#cts| 0 
+              :|#vacs| 0 :|#dups| 0))
+
+(def initial-s-hist-entry% (name hyps concl vars 
+                                 elide-map start)
+  (decl :sig ((string pseudo-term-list pseudo-term symbol-list 
+                      symbol-alist rational) 
+              -> s-hist-entry%)
+        :doc "make initial s-hist-entry% given args")
+  (acl2::make s-hist-entry% 
+              :name name :hyps hyps :concl concl :vars vars 
+              :elide-map elide-map
+              :start-time start :end-time start
+              :run-hist *initial-run-hist%*))
+          
+
+
+;The following 2 function only look at the outermost implies form
+;get hypothesis from acl2 term being proved.
+(defun get-hyp (form)
+  (declare (xargs :guard t))
+  (if (atom form)
+    t;no hyps is equivalent to true
+    (if (and (consp (cdr form))
+             (eq 'implies (first form)))
+      (second form)
+      t)));;no hyps is equivalent to true
+
+; use expand-assumptions-1 instead when you have a term
+(defun get-hyps (pform)
+  (declare (xargs :guard t))
+  (b* ((hyp (get-hyp pform))
+       ((when (eq hyp 't)) nil)
+       ((unless (and (consp hyp)
+                     (consp (cdr hyp))
+                     (eq (car hyp) 'and)))
+        (list hyp))
+       (rst (cdr hyp)))
+    rst))
+
+
+;get conclusion from acl2 term being proved
+(defun get-concl (form)
+  (declare (xargs :guard t))
+  (if (atom form)
+    form
+    (if (and (consp (cdr form))
+             (consp (cddr form))
+             (eq 'implies (first form)))
+      (third form)
+      form)))
+
+
+(defun collect-tau-alist (triples tau-alist type-alist pot-lst ens wrld)
+(declare (xargs :mode :program))
+
+  (if (endp triples)
+      tau-alist
+    (b* (((mv ?contradictionp ?mbt ?mbf tau-alist ?calist)
+          (acl2::tau-assume nil (caddr (car triples))
+                            tau-alist type-alist pot-lst
+                            ens wrld nil))
+         (- (cw? nil "~% *** tau-assume returned ~x0~%~%" tau-alist)))
+      (collect-tau-alist (cdr triples)
+                         tau-alist type-alist pot-lst ens wrld))))
+
+(defun tau-alist-clause (clause sign ens wrld state)
+  (declare (xargs :mode :program :stobjs (state)))
+;duplicated from tau-clausep in prove.lisp.
+(b* (((mv ?contradictionp type-alist pot-lst)
+      (acl2::cheap-type-alist-and-pot-lst clause ens wrld state))
+     (triples (acl2::merge-sort-car-<
+                (acl2::annotate-clause-with-key-numbers clause
+                                                        (len clause)
+                                                        0 wrld)))
+     (tau-alist (collect-tau-alist triples sign type-alist pot-lst
+                                   ens wrld)))
+  tau-alist))
+
+
+;; (defun tau-alist-clauses (clauses sign ens wrld state ans)
+;;   (declare (xargs :mode :program :stobjs (state)))
+;;   (if (endp clauses)
+;;       ans
+;;     (tau-alist-clauses (cdr clauses) sign ens wrld state
+;;                        (append (tau-alist-clause (car clauses) sign ens wrld state) ans))))
+      
+
+
+
+       
+(defun all-vals (key alist)
+  (declare (xargs :guard (and (symbolp key)
+                              (alistp alist))))
+  (if (endp alist)
+      '()
+    (if (eq key (caar alist))
+        (cons (cdar alist) (all-vals key (cdr alist)))
+      (all-vals key (cdr alist)))))
+
+(defun make-var-taus-alist (vars tau-alist)
+  (declare (xargs :guard (and (symbol-listp vars)
+                              (alistp tau-alist))))
+  (if (endp vars)
+      '()
+    (b* ((vals (all-vals (car vars) tau-alist)))
+      (cons (cons (car vars) vals)
+            (make-var-taus-alist (cdr vars) tau-alist)))))
+
+(defun conjoin-tau-interval-lst (taus ans)
+; [tau] * interval -> interval
+  (declare (xargs :mode :program))
+  (if (endp taus)
+      ans
+    (b* ((tau (car taus))
+           (interval (acl2::access acl2::tau tau :interval)))
+    (conjoin-tau-interval-lst (cdr taus) 
+                              (acl2::conjoin-intervals interval ans)))))
+  
+
+(defun tau-interval-alist (var-taus-alist)
+;[var . taus] -> [var . interval]
+  (declare (xargs :mode :program))
+  (if (endp var-taus-alist)
+      '()
+    (b* (((cons var taus) (car var-taus-alist))
+         (interval (conjoin-tau-interval-lst taus nil)) ;nil represents the universal interval 
+         )
+      (if (null interval) ;universal
+          (tau-interval-alist (cdr var-taus-alist))
+        (cons (cons var interval)
+              (tau-interval-alist (cdr var-taus-alist)))))))
+
+
+
+(defun tau-interval-alist-clause (cl name ens vl wrld state)
+    (declare (xargs :mode :program :stobjs (state)))
+    (b* ((tau-alist (tau-alist-clause cl nil ens wrld state))
+         (var-taus-alist (make-var-taus-alist (all-vars-lst cl) tau-alist))
+         (- (cw? (system-debug-flag vl)
+                 "~|CEgen/Debug: taus alist (~s0): ~x1~|" name var-taus-alist))
+         (tau-interval-alist (tau-interval-alist var-taus-alist))
+         (- (cw? (debug-flag vl)
+                 "~|CEgen/Debug: tau interval alist (~s0): ~x1~|" name tau-interval-alist)))
+      tau-interval-alist))
+     
+    
+(defun get-acl2-type-alist (cl name ens vl state)
+  (declare (xargs :mode :program
+                  :stobjs (state)))
+  (b* (((mv erp type-alist &)
+       (acl2::forward-chain cl
+                            (acl2::enumerate-elements cl 0)
+                            nil ; do not force
+                            nil ; do-not-reconsiderp
+                            (w state)
+                            ens
+                            (acl2::match-free-override (w state))
+                            state))
+;Use forward-chain ACL2 system function to build the context
+;This context, gives us the type-alist ACL2 inferred from the
+;the current subgoal i.e. cl
+       (vars (all-vars-lst cl))
+       (vt-acl2-alst (if erp ;contradiction
+                         (pairlis$ vars (make-list (len vars)
+                                                   :initial-element 
+                                                   (list 'ACL2::ALL)))
+                       (acl2::decode-acl2-type-alist type-alist vars)))
+       (- (cw? (debug-flag vl)
+"~|CEgen/Debug: ACL2 type-alist (~s0): ~x1~|" name vt-acl2-alst)))
+   vt-acl2-alst))
+
+
+(def dumb-type-alist-infer-from-term (term vl wrld R$ types-ht$ ans.)
+  (decl :sig ((pseudo-term-listp fixnum plist-worldp R$ types-ht$ symbol-alistp) 
+              -> symbol-alistp)
+        :doc "main aux function to infer type-alist from term")
+  (declare (xargs :verify-guards nil))
+; ans. is a type alist and has type
+; (symbol . (listof possible-defdata-type-p))
+  (f* ((add-eq-typ... (t1) (if (acl2::equivalence-relationp R wrld)
+                               (put-assoc x (list t1) ans.)
+                             ans.)))
+    
+; Copied from v-cs%-alist-from-term. Keep in sync!
+  (case-match term
+    
+;the following is a rare case (I found it when the conclusion is nil
+;and its negation is 'T
+    (('quote c) (declare (ignore c))  ans.) ;ignore quoted constant terms 
+
+;TODO possible field variable (i.e f is a getter/selector) Note that
+; term cannot have a lambda applicaton/let, so the car of the term is
+; always a function symbol if term is a consp.
+    ((P (f . &)) (declare (ignore P f))  ans.)
+
+;x has to be an atom below, otherwise, we would have caught that case above.
+    (('not x)      (put-assoc x (list ''nil) ans.))
+    
+    ((P x)   (b* ((tname (is-type-predicate P wrld))
+                  ((unless tname) ans.)
+                  (curr-typs-entry (assoc-eq x ans.))
+                  ((unless (and curr-typs-entry 
+                                (consp (cdr curr-typs-entry))))
+; no or invalid entry, though this is not possible, because we call it with
+; default type-alist of ((x . ('ALL)) ...)
+                   ans.)
+                  (curr-typs (cdr curr-typs-entry))
+                  (- (cw? (and (verbose-stats-flag vl) 
+                               (consp (cdr curr-typs)))
+                          "~|CEgen/Warning: Ignoring rest of union types ~x0 ~|" (cdr curr-typs)))
+                     
+                  (curr-typ (car curr-typs))
+                  ((when (possible-constant-valuep curr-typ)) ans.)
+                   
+                  (final-typ (meet tname curr-typ vl wrld R$ types-ht$)))
+               (put-assoc x (list final-typ) ans.)))
+
+    ((R (f . &) (g . &)) (declare (ignore R f g)) ans.) ;ignore
+
+;x has to be an atom below, otherwise, we would have caught that case
+;above.
+    ((R x ('quote c))    (add-eq-typ... (kwote c)))
+    ((R ('quote c) x)    (add-eq-typ... (kwote c)))
+    ;((R x (f . args))    (add-eq-constraint... (acl2::cons-term f args)))
+    ;((R (f . args) x)    (add-eq-constraint... (acl2::cons-term f args)))
+    
+    ;; has to be a (R t1 t2 ...) or atomic term
+    (&                   ans.))))
+
+(def dumb-type-alist-infer-from-terms (H vl wrld R$ types-ht$ ans.)
+  (decl :sig ((pseudo-term-listp fixnum plist-worldp R$ types-ht$ 
+                                 symbol-alistp) -> symbol-alistp)
+        :doc "aux function for dumb extraction of defdata types from terms in H")
+  (declare (xargs :verify-guards nil))
+  (if (endp H)
+      ans.
+    (b* ((term (car H))
+         (ans. (dumb-type-alist-infer-from-term term vl wrld R$ types-ht$ ans.)))
+      (dumb-type-alist-infer-from-terms (cdr H) vl wrld R$ types-ht$ ans.))))
+
+(def dumb-type-alist-infer (H vars vl wrld R$ types-ht$)
+  (decl :sig ((pseudo-term-listp symbol-listp fixnum plist-worldp R$ types-ht$) 
+              -> symbol-alistp)
+        :doc "dumb infer defdata types from terms in H")
+  (declare (xargs :verify-guards nil))
+  (dumb-type-alist-infer-from-terms 
+   H vl wrld R$ types-ht$
+   (pairlis$ vars (make-list (len vars)
+                             :initial-element 
+                             (list 'ACL2::ALL)))))
+
+
+(def meet-type-alist (A1 A2 vl wrld R$ types-ht$)
+  (decl :sig ((symbol-alistp symbol-alistp fixnum plist-world R$ types-ht$)
+              -> (mv erp symbol-alistp))
+        :mode :program ;ev-fncall-w
+        :doc "take intersection of types in the type alist")
+; no duplicate keys. A1's ordering is used, it has to contain all the
+; variables that the user wants in his final type-alist
+; A1 and A2 and the return value have type
+; (listof (cons symbolp (listof possible-defdata-type-p)))
+; TODO: if val has more than 1 type, then we treat it as (list 'ALL)
+
+; Usually its called with A1 as the acl2 type alist and A2 as the
+; top-level type alist. so it might contain
+; variables thats have been dest-elimed away
+  (f* ((get-type... (types) (if (and (consp types)
+                                     (null (cdr types)))
+                                (car types)
+                              (prog2$
+                               (cw? (verbose-stats-flag vl)
+                                    "~|CEGen/Warning: Ignoring rest of union types ~x0 ~|" (cdr types))
+                               (car types))))
+         (eval-and-get-meet (typ1 typ2) ;(quoted-constant sym)|(sym quoted-constant)
+                            (b* (((mv dt st) (if (is-a-variablep typ1)
+                                                 (mv typ1 typ2)
+                                               (mv typ2 typ1)))
+                                 (P (get-predicate-symbol dt))
+                                 ;; args to ev-fncall-w is a list of evaluated values.
+                                 ((mv erp res) (acl2::ev-fncall-w P (list (if (quotep st) ;possible bug caught, what if st is not quoted!
+                                                                              (acl2::unquote st)
+                                                                            st)) 
+                                                                  wrld nil nil t nil nil))
+                                 (- (cw? (and erp (debug-flag vl))
+                                         "~|CEgen/Error in ~x0: while calling ev-fncall-w on ~x1~|" ctx (cons P (list st))))
+                                 (- (cw? (and (not erp) (not res) (debug-flag vl))
+                                         "~|CEgen/Debug:: ~x0 evaluated to nil~|" (cons P (list st))))
+                                 ((when erp)
+                                  (mv t 'acl2::empty)))
+                              (if res (mv nil st) (mv nil 'acl2::empty)))))
+  (if (endp A1)
+      (mv nil '())
+    (b* (((cons var types1) (car A1))
+         (typ1 (get-type... types1))
+         (ctx 'meet-type-alist)
+         (types2-entry (assoc-eq var A2))
+         (types2 (if types2-entry (cdr types2-entry) '(ACL2::ALL)))
+         (typ2 (get-type... types2))
+         ((unless (and (possible-defdata-type-p typ1) 
+                       (possible-defdata-type-p typ2)))
+          (mv t '()))
+         ((mv erp rest) (meet-type-alist (cdr A1) A2 vl wrld R$ types-ht$))
+         ((when erp) (mv t '())))
+
+      (cond ((and (is-a-variablep typ1) (is-a-variablep typ2))
+             (mv nil (acons var (list (meet typ1 typ2 vl wrld R$ types-ht$)) rest)))
+
+            ((and (is-singleton-type-p typ1)
+                  (is-singleton-type-p typ2)
+                  (equal typ1 typ2))
+             (mv nil (acons var (list typ1) rest)))
+
+            ((and (is-singleton-type-p typ1)
+                  (is-singleton-type-p typ2))
+             (mv nil (acons var (list 'acl2::empty) rest)))
+
+            (t
+             (b* (((mv erp ans) (eval-and-get-meet typ1 typ2)))
+               (mv erp (acons var (list ans) rest)))))))))
+
+
+;; COPIED FROM acl2-sources/basis.lisp line 12607
+;; because it is program mode there, and verify-termination needed more effort
+;; than I could spare.
+(defun dumb-negate-lit-lst (lst)
+  (cond ((endp lst) nil)
+        (t (cons (dumb-negate-lit (car lst))
+                 (dumb-negate-lit-lst (cdr lst))))))
+
+(def clause-mv-hyps-concl (cl)
+  (decl :sig ((clause) 
+              -> (mv pseudo-term-list pseudo-term))
+        :doc "return (mv hyps concl) which are proper terms given a
+  clause cl. Adapted from prettyify-clause2 in other-processes.lisp")
+  (cond ((null cl) (mv '() ''NIL))
+        ((null (cdr cl)) (mv '() (car cl)))
+        ((null (cddr cl)) (mv (list (dumb-negate-lit (car cl)))
+                              (cadr cl)))
+        (t (mv (dumb-negate-lit-lst (butlast cl 1))
+               (car (last cl))))))
+
+(def clausify-hyps-concl (hyps concl)
+  (decl :sig ((pseudo-term-list pseudo-term)
+              -> clause)
+        :doc "given hyps concl which are proper terms return equivalent
+  clause cl. inverse of clause-mv-hyps-concl")
+  (cond ((and (endp hyps) (equal concl ''NIL)) 'NIL)
+        ((endp hyps) (list concl))
+        ((endp (cdr hyps)) (list (dumb-negate-lit (car hyps)) concl))
+        (t (append (dumb-negate-lit-lst hyps)
+                   (list concl)))))
+
+
+(def ss-stats (ss-temp-result old-run-hist%)
+  (decl :sig (((list booleanp run-hist% gcs%) run-hist%) -> all)
+        :doc "print some stats about this run of simple-search")
+  (b* (((list stop? run-hist% &) ss-temp-result)
+       (new-num-cts (access run-hist% |#cts|))
+       (old-num-cts (acl2::access run-hist% old-run-hist% :|#cts|))
+       (new-num-wts (access run-hist% |#wts|))
+       (old-num-wts (acl2::access run-hist% old-run-hist% :|#wts|))
+       (new-total (+ new-num-cts (access run-hist% |#vacs|) new-num-wts (access run-hist% |#dups|)))
+       (old-total (+ old-num-cts (acl2::access run-hist% old-run-hist% :|#vacs|) old-num-wts (acl2::access run-hist% old-run-hist% :|#dups|)))
+       (found-wts (- new-num-wts old-num-wts))
+       (found-cts (- new-num-cts old-num-cts))
+       (n (- new-total old-total))
+       (- (cw? t
+               "~|CEgen/Stats/simple-search: ~x0/~x1 cts/wts found in this run (~x2 tests)!~|" found-cts found-wts n))
+       (- (cw? t
+               "~|CEgen/Stats/simple-search: *END* Stopping condition: ~x0~%~%" stop?)))
+    nil))
+       
+
+;; 1st April 2013 Fix
+;; You cannot trust make-event to give the right result
+;; through trans-eval. Just use a state temp global.
+;; This bug manifests, when you use (skip-proofs ....)
+
+(def simple-search (name 
+                    hyps concl vars partial-A 
+                    type-alist tau-interval-alist mv-sig-alist
+                    run-hist% gcs%
+                    N vl sm programp incremental-flag?
+                    ctx wrld state)
+  (decl :sig ((string pseudo-term-list pseudo-term symbol-list symbol-doublet-listp
+                symbol-alist symbol-alist symbol-alist
+               run-hist% gcs% fixnum fixnum keyword boolean boolean
+               symbol plist-world state) 
+              -> (mv erp (list boolean run-hist% gcs%) state))
+        :mode :program
+        :doc 
+        "
+Use :simple search strategy to find counterexamples and witnesses.
+
+* What it does
+  1. if form has no free variables exit with appropriate return val o.w
+  2. make hypotheses-val conclusion-val,  attach them
+  3. take intersection of acl2 type-alist with top-level one from gcs%.
+  4. make next-sigma defun and attach it
+  5. call run-tests!.
+  6. store/record information (run-hist%,gcs%) and 
+     returns (list stop? run-hist% gcs%) where stop? is T when
+     stopping condition is satisfied.
+")
+  
+  (if (endp vars)
+      ;;dont even try trivial forms like constant expressions
+      (b* ((form  `(implies (and ,@hyps) ,concl))
+            ((mv erp c state)
+             (trans-eval-single-value form ctx state))
+            ((mv run-hist% gcs%)
+             (record-testrun. (if c :witness :counterexample)
+                              partial-A
+                              run-hist% gcs%)))
+
+;       in
+        (prog2$
+         (if partial-A
+             (cw? (verbose-flag vl)
+              "~%CEgen/Note: No point in searching ~x0; it evals to const ~x1 under ~x2~|" name c partial-A)
+             (cw? (verbose-flag vl)
+              "~%CEgen/Note: No point in searching ~x0; it evals to const ~x1~|" name c))
+         (mv erp (list NIL run-hist% gcs%) state)))
+
+;ELSE ATLEAST ONE VARIABLE
+  (b* ((- (assert$ (consp vars) 'simple-search))
+       (- (cw? (verbose-flag vl) "~%~%"))
+       (- (cw? (verbose-stats-flag vl) 
+               "~|CEgen/Stats/simple-search:: *START*~|"))
+       (hyp-val-defuns   (make-hypotheses-val-defuns hyps vars mv-sig-alist))
+       (concl-val-defuns (make-conclusion-val-defuns concl vars mv-sig-alist))
+       (- (cw? (system-debug-flag vl) 
+               "~%~%~x0 **SYSTEM-DEBUG** hyp/concl defuns: ~| ~x1 ~x2~|" 
+               name hyp-val-defuns concl-val-defuns))
+       (top-vt-alist (access gcs% top-vt-alist))
+
+       ((mv erp0 tr-res state)
+        (trans-eval `(mv-list 2 (meet-type-alist ',type-alist ',top-vt-alist ',vl ',wrld R$ types-ht$))
+                    ctx state t))
+       ((when erp0)
+        (mv t (list nil run-hist% gcs%) state))
+       ((list erp type-alist) (cdr tr-res))
+       ((when erp)
+        (prog2$
+         (cw? (normal-output-flag vl)
+              "~|CEgen/Error: Type intersection failed. Skip searching ~x0.~%" name)
+         (mv t (list NIL run-hist% gcs%) state)))
+
+       ((mv erp0 tr-res state) ;matt's tip
+        (trans-eval `(mv-list 3 
+                              (make-next-sigma-defuns ',hyps ',concl 
+                                                      ',vars ',partial-A 
+                                                      ',type-alist ',tau-interval-alist
+                                                      ',vl ',wrld R$ types-ht$))
+                    ctx state t))
+       ((when erp0)
+        (mv t (list nil run-hist% gcs%) state))
+       ((list erp next-sigma-defuns disp-enum-alist) (cdr tr-res))
+       ((when erp)
+        (prog2$ 
+           (cw? (normal-output-flag vl)
+                "~|CEgen/Error: Couldn't determine enumerators. Skip searching ~x0.~|" name)
+           (mv t (list nil run-hist% gcs%) state)))
+
+       (- (cw? (system-debug-flag vl) "~%*** next-sigma : ~| ~x0~|" next-sigma-defuns))
+       (rseed. (getseed state))
+       ;;initialize temp result
+       ((er &) (assign ss-temp-result (list nil run-hist% gcs%)))
+       
+       (- (cw? (verbose-flag vl) 
+"~|CEgen/Note: Enumerating ~x0 with ~x1~|" name disp-enum-alist))
+; print form if origin was :incremental
+       (cl (clausify-hyps-concl hyps concl))
+       (pform (acl2::prettyify-clause cl nil (w state)))
+       (- (cw? (and incremental-flag?
+                    (verbose-flag vl)) "~| incrementally on ~x0 under assignment ~x1~%" pform partial-A))
+
+       (call-form   
+        `(acl2::state-global-let*
+          ((acl2::guard-checking-on ,(if programp :none nil)))
+          (b* (((mv stop? rseed. run-hist% gcs%)
+                (run-tests. ,N ,sm ,vl ',vars
+                            ,rseed. ',run-hist% ',gcs%))
+               (state (putseed rseed. state)))
+           (er-progn 
+             (assign ss-temp-result (list stop? run-hist% gcs%))
+             (value '(value-triple :invisible))))))
+
+       );end b* bindings
+;  IN
+   (mv-let 
+    (erp trval state)
+    (trans-eval `(acl2::state-global-let*
+                  ((acl2::inhibit-output-lst
+                    ,(if (system-debug-flag vl)
+                         ''(summary)
+                       ;;shut everything except error
+                       ''(warning warning! observation prove
+                                  proof-checker event expansion
+                                  proof-tree summary)))) 
+                  (make-event
+                   (er-progn
+; dont even think of nested testing (nested waterfall call to test checkpoint)
+                    (acl2s-defaults :set testing-enabled nil)
+                    
+                    ;; added 2nd May '12. Why leave out program context
+                    
+                    ,@(and programp '((program)))
+                    
+                    ,@hyp-val-defuns
+                    ,@concl-val-defuns
+                    ,@next-sigma-defuns
+; Jan 8th 2013 - program mode doesnt work anymore since
+; we dont have trust tags and skip-checks in place, lets
+; fix it here.
+                    ,@(and programp '((defttag :testing)))
+; Note: all of these defuns are non-recursive and guards not verified, so
+; none of these events will cause a call to prove (we hope)
+; This is an important observation, since we rely on test-checkpoint
+; computed hint to do testing which will get called on every call to prover.
+; Thus we might pollute our globals (recorded testing information to print)
+; if we make unexpected (prove ...) calls. Update 09/28/12 the above call to
+; disable testing should guarantee that test-checkpoint will not be called
+; again.
+
+; Update Sep 27th 2012
+; Folllowing a helpful email by Matt, found a way to fool the function
+; to be guard verified, by wrapping its call in an ec-call
+; This way I also get rid of the trust tag .... Hurrah!!
+; Update Jan 8th 2013, but have to bring back the ttag and skip-checks for
+; program mode testing :((
+                    ,@(if programp
+                          '((defattach (hypotheses-val hypotheses-val-current-gv) :skip-checks t)
+                            (defattach (conclusion-val conclusion-val-current-gv) :skip-checks t)
+                            (defattach (next-sigma next-sigma-current-gv) :skip-checks t))
+                        '((defattach (hypotheses-val hypotheses-val-current-gv))
+                          (defattach (conclusion-val conclusion-val-current-gv))
+                          (defattach (next-sigma next-sigma-current-gv))))
+ 
+                   ,@(and programp '((defttag nil)))
+                    
+                    ,call-form))
+                  )
+                ctx state T)
+    (declare (ignore trval))
+    (prog2$
+     (and (verbose-stats-flag vl)
+          (ss-stats (@ ss-temp-result) run-hist%))
+     (mv erp (@ ss-temp-result) state))))))
+
+
+(def select (terms debug)
+  (decl :sig ((pseudo-term-list boolean) 
+              -> symbol)
+        :doc "choose the variable with least dependency. Build a dependency
+  graph, topologically sort it and return the first sink we find.")
+;PRECONDITION: (len vars) > 1
+;We have to build a dependency graph at each iteration, since the graph changes
+;as we incrementally concretize/instantiate variables.  
+;SELECT Ideal Situation:: No variable should be picked before the variable it
+;depends on has been selected and assigned
+
+  (b* ((vars (all-vars-lst terms))
+       (G (build-variable-dependency-graph terms vars))
+;TODO: among the variables of a component, we should vary
+;the order of selection of variables!!
+       (var (car (last (approximate-topological-sort G debug))))
+       (- (cw? debug "~|DPLL: Select var: ~x0~%" var)))
+   var))
+
+; May 14 '12: changed to v-cs%-alst parameter for optimization
+(def assign-value (x |#assigns| cs% partial-A sm vl ctx wrld state R$ types-ht$)
+  (decl :sig ((symbol fixnum cs% symbol-doublet-listp
+                      sampling-method fixnum symbol plist-world state R$ types-ht$)
+              -> (mv erp (list pseudo-term keyword fixnum) state))
+        :mode :program
+        :doc "assign a value to x. Infer type constraints from hyps, get the
+enumcall for x. trans-eval enumcall to get value to be assigned to x. quote it
+to obtain a term. return (mv val :decision i+1), if size of type attributed to
+x is greater than 1, otherwise return (mv val :implied i) where i= #assigns
+made to x already.")
+  (f* ((_eval-single-value (call)
+              (b* ((vexp (if partial-A 
+                             `(let ,partial-A 
+                                (declare (ignorable ,@bound-vars))
+                                  ,call) 
+                           call))
+                   (- (cw? (debug-flag vl) 
+                           "~|CEgen/Debug/incremental:  ASSIGN ~x0 := eval[~x1]~|" x  vexp)))
+                (trans-eval-single-value vexp ctx state))))
+
+  (b* ((- (assert$ (cs%-p cs%) 'assign-value))
+       (bound-vars (strip-cars partial-A))
+       ((mv size calls) (cs%-enumcalls cs% ctx wrld R$ types-ht$ bound-vars))
+       
+       (seed. (getseed state))
+       ((mv erp seed. ans state)
+        (case sm
+             (:uniform-random 
+              (b* (((mv m seed.) (random-index-seed *recursive-uniform-enum-measure* seed.))
+                   (call `(acl2::mv-list 2 ;arity -- pete caught this missing arity on 17 July '13
+                               (let ((seed. ,seed.))
+                                 ,(subst m 'm (second calls)))))
+                   ((mv erp ans2 state) (_eval-single-value call)))
+                (mv erp (cadr ans2) (car ans2) state)))
+                   
+             (otherwise
+              (b* (((mv r seed.) (random-natural-seed seed.))
+                   (call (subst r 'r (first calls)))
+                   ((mv erp ans state) (_eval-single-value call)))
+                (mv erp seed. ans state)))))
+       ((when (or erp (equal size 0))) (mv t nil state)) ;signal error
+        
+       (state (putseed seed. state))
+       (val-term       (kwote ans)))
+   (if (equal size 1) ;size=0 is not possible, also size can be T (inf)
+       (value (list val-term :implied |#assigns|))
+     (value (list val-term :decision (1+ |#assigns|)))))))
+
+;copied from tools/easy-simplify.lisp (by sol swords)
+(defun easy-simplify-term1-fn (term hyps hints equiv
+                              normalize rewrite
+                              repeat
+                              backchain-limit
+                              state)
+  (declare (XargS :mode :program :stobjs state))
+  (b* ((world (w state))
+       
+       ((er hint-settings)
+        (acl2::translate-hint-settings
+         'simp-term "Goal" hints 'easy-simplify-term world state))
+       (ens (acl2::ens state))
+       (base-rcnst
+        (acl2::change acl2::rewrite-constant
+                acl2::*empty-rewrite-constant*
+                :current-enabled-structure ens
+                :force-info t))
+       ((er rcnst)
+        (acl2::load-hint-settings-into-rcnst
+         hint-settings base-rcnst nil world 'easy-simplify-term state))
+       (ens (acl2::access acl2::rewrite-constant rcnst :current-enabled-structure))
+       ((mv flg hyps-type-alist ?ttree)
+        (acl2::hyps-type-alist hyps ens world state))
+       ((when flg)
+        (mv "Contradiction in the hypotheses"
+            nil state))
+       ((mv ?step-limit new-term ?new-ttree state)
+        (acl2::pc-rewrite*
+         term hyps-type-alist
+         (if (eq equiv 'acl2::equal)
+             nil
+           (list (acl2::make acl2::congruence-rule
+                       :rune acl2::*fake-rune-for-anonymous-enabled-rule*
+                       :nume nil
+                       :equiv equiv)))
+         (eq equiv 'acl2::iff)
+         world rcnst nil nil normalize rewrite ens state
+         repeat backchain-limit
+         (acl2::initial-step-limit world state))))
+    (value new-term)))
+
+(def simplify-term (term hyps hints state)
+  (decl :sig ((pseudo-term pseudo-term-list true-list state) 
+              -> (mv erp pseudo-term state))
+        :mode :program
+        :doc "simplify term under hyps. erp is T if hyps have a contradiction
+  in them. return the simplifed term in error triple")
+  (easy-simplify-term1-fn term hyps hints 'acl2::equal 't 't 1000 1000 state))
+
+
+
+; TODO: WHat will happen if some variable gets elided during this
+; simplifcation?  Then our code breaks, especially rem-vars logic and capturing
+; full assignment.
+
+(def simplify-hyps1-under-assignment (rem-hyps init-hyps x a hints ans. vl state)
+  (decl :sig ((pseudo-term-list pseudo-term-list symbol quoted-constant true-list pseudo-term-list bool state)
+              -> (mv erp pseudo-term state))
+        :mode :program
+        :doc "simplify each hyp in rem-hyps assuming init-hyps (minus
+  hyp), accumulate in ans. and return a value triple containing shyps
+  and an error triple if a contradiction is found in an syhp")
+  (if (endp rem-hyps)
+      (value ans.)
+    (b* ((hyp         (car rem-hyps))
+         (other-hyps  (remove1-equal hyp init-hyps))
+         ((er shyp)   (simplify-term hyp other-hyps hints state))
+         (simplified? (term-order shyp hyp))
+         ((when (equal shyp ''nil)) ;contradiction
+          (mv T ans. state))
+; 27th Aug '12. FIXED a bug in testing-regression.lsp. In incremental mode
+; the assert$ that x should not be in the free vars of the conjecture
+; was being violated because I was naively checking against term-order.
+; But in the case of small-posp, the type assumptions that could have been
+; brought to ACL2's attention using compound-recognizer rules were hidden
+; leading to a big IF term being generated in shyp.
+; SO now if the above happens(I should give a warning here), at the very
+;  least I subst the assignment in hyp.
+         (- (cw? (and (system-debug-flag vl) 
+                      (not simplified?))
+             "~|ACHTUNG: simplify-hyps result not less than hyp in term-order~|"))
+         (shyp (if simplified? shyp (subst a x hyp))))
+     
+      (simplify-hyps1-under-assignment 
+       (cdr rem-hyps) init-hyps x a hints
+       (if (equal shyp ''t) ans.
+         (append ans. (list shyp))) ;dont mess with order
+       vl state))))
+
+(def simplify-hyps-under-assignment (hyps x a vl state)
+  (decl :sig ((pseudo-term-list symbol quoted-constant boolean state) 
+              -> (mv erp pseudo-term-list state))
+        :mode :program
+        :doc "simplify hyps assuming x=a. return shyps in an error
+        triple. erp=T if contradiction found in shyps")
+  (b* ((eq-hyp (list 'acl2::equal x a)) ;variable comes first
+      ((er shyps1) (simplify-hyps1-under-assignment hyps (list eq-hyp) x a '() '() vl state)))
+;I do the above and then again simplify to get order-insensitive list of
+;simplified hypotheses i.e the order of the hyps in the argument should not
+;change the result of this function.
+   (simplify-hyps1-under-assignment shyps1 (cons eq-hyp shyps1) x a '() '() vl state)))
+                      
+(def propagate (x a hyps concl vl state)
+  (decl :sig ((symbol pseudo-term ;actually a quoted constant
+                      pseudo-term-list pseudo-term fixnum state)
+              -> (mv erp (list pseudo-term-list pseudo-term) state))
+        :mode :program
+        :doc "propagate the assignment of a to variable x by using a utility
+  function from tools/easy-simplify.lisp (earlier I was using
+  expander.lisp). return (mv erp (shyps sconcl) state) where erp might be T
+  indicating discovery of inconsistency/contradiction in the hypotheses")
+ (b* (((er shyps)  (simplify-hyps-under-assignment hyps x a vl state))
+;IMP: sconcl shud be a pseudo-term; not a term-list, or an IF
+      (- (cw? (debug-flag vl)
+"~|CEGen/Debug/Propagate: ~x0 ---~x1=~x2--> ~x3~|" hyps x a shyps))
+      (eq-hyp (list 'equal x a)) ;variable comes first
+      ((er sconcl) (simplify-term concl (cons eq-hyp shyps) nil state))
+      (- (cw? (debug-flag vl)
+"~|CEGen/Debug/Propagate: ~x0 ---~x1=~x2--> ~x3~|" concl x a sconcl))
+;TODO: this following check is causing problem in regression
+; May 13 '12
+      ;; ((when (or (pseudo-term-listp sconcl)))
+;;                  ;(eq (ffn-symb sconcl) 'IF)))
+;; ;IF is okay for an and in the conclusion. But will we ever get an IF from
+;; ;inside test-checkpoint??
+;;        (mv (prog2$ 
+;;             (cw? (normal-output-flag vl)
+;; "~|BAD: conclusion got reduced to something we dont want!!~|")
+;;             T)
+;;            (list shyps sconcl) state))
+      (vars (all-vars-lst (cons sconcl shyps))))
+  (assert$ (not (member-eq x vars)) (mv NIL (list vars shyps sconcl) state))))
+                  
+
+(defun put-val-A (name val dlist) ;use mset instead?
+  (declare (xargs :guard (symbol-doublet-listp dlist)))
+  (cond ((endp dlist) (list (list name val)))
+        ((equal name (caar dlist))
+         (cons (list name val) (cdr dlist)))
+        (t (cons (car dlist)
+                 (put-val-A name val (cdr dlist))))))
+
+;; (def update-A-after-propagate (x a new-vars old-vars A.)
+;;   (decl :sig ((symbol quoted-constant symbol-list symbol-list symbol-doublet-list) -> symbol-doublet-list)
+;;         :doc "A[x]:=a, for elimed-vars do y:='?." ;TODO: use bindings-lst from ttree like we do elsewhere.
+;;         )
+;;   (b* ((elimed-vars (remove-duplicates-eq (set-difference-eq old-vars (cons x new-vars))))
+;;        (A. (put-val-A x a A.)) ;use (mset x (list a) A) instead?
+;;        (rst (pairlis$ elimed-vars (make-list (len elimed-vars)
+;;                                              :initial-element 
+;;                                              (list (kwote 'ACL2::?))))))
+;;     (append rst A.)))
+    
+
+
+
+; a% represents the snapshot of the beginning of the dpll do-while loop
+(defrec a% ((hyps concl vars partial-A type-alist tau-interval-alist) ;args to simple search
+            ((var . cs) val kind i . inconsistent?) ;result of assign and propagate
+            ) 
+  NIL)
+;Take special note of field names: run-hist and gcs, % is intentionally not
+;used in these field names
+(defun a%-p (v)
+  (declare (xargs :guard T))
+  (case-match v
+    (('a% (hyps concl vars partial-A type-alist tau-interval-alist) 
+          ((var . cs) val kind i . inconsistent?))
+
+     ;==>
+     (and (symbol-listp vars)
+          (pseudo-term-listp hyps)
+          (pseudo-termp concl)
+          (symbol-doublet-listp partial-A)
+          (symbol-alistp type-alist)
+          (symbol-alistp tau-interval-alist)
+          (symbolp var)
+          (pseudo-termp val)
+          (member-eq kind (list :na :implied :decision))
+          (natp i)
+          (booleanp inconsistent?)
+          (or (null cs) (cs%-p cs))
+          ))))
+                                   
+(defun a%-listp (v) ;STACK
+  (declare (xargs :guard T))
+  (if (atom v)
+      (null v)
+    (and (a%-p (car v))
+         (a%-listp (cdr v)))))
+
+
+
+;TODO- prove a theorem that the above two fns are inverses
+
+
+; defabbrev was a BAD idea. I should make this a defun, to avoid variable
+; capture bugs. For example I was assigning .. :var x ... instead of :var x1
+; below, where x would have been the previously selected variable and unless I
+; tested carefully I would not have gotten hold of this simple programming err.
+; May 24th '12: making this into a defun
+; 18 July '13 -- modified to a simplified signature
+(def assign-propagate (a% name sm vl ctx wrld state R$ types-ht$)
+  (decl :sig ((a% string sampling-method 
+                  fixnum symbol plist-world state R$ types-ht$)
+              -> (mv erp (list pseudo-term-list pseudo-term symbol-list 
+                               symbol-doublet-list symbol-alist symbol-alist a%) state))
+        :mode :program
+        :doc "assign a value to a%.x and propagate this new info to obtain the updated a%")
+  (b* ((`(a% ,LV . &) a%)
+;ACHTUNG: a% defrec exposed
+        ((list H C vars partial-A type-alist tau-interval-alist) LV)
+        ((mv x i) (mv (access a% var) (access a% i)))
+        (cs% (or (access a% cs)
+                 (assert$ (member-eq x vars)
+                          (cdr (assoc-eq x (collect-constraints% 
+                                             H vars type-alist tau-interval-alist
+                                             vl wrld R$ types-ht$))))))
+;DESIGN decision: not taking into account type constraint from nconcl at the moment.
+       
+       ((mv erp ans state) (assign-value x i cs% partial-A sm vl ctx wrld state R$ types-ht$))
+       ((when erp)
+        (progn$
+         (cw? (normal-output-flag vl)
+              "~|CEGen/Error/incremental: assign-value failed (in ~s0).~|" name)
+         (cw? (verbose-stats-flag vl)
+              "~|CEGen/Stats: Call was (assign-value ~x0 ~x1 ~x2 ...)~|" x i cs%)
+         (mv erp nil state)))
+        
+       ((list a kind i) ans)
+
+       (a% (acl2::change a% a% :cs cs% :val a :kind kind :i i))
+       
+       ((mv erp res state) (propagate x a H C vl state))
+       (str (if erp "inconsistent" "consistent"))
+       (- (cw? (verbose-stats-flag vl)
+               "~%CEgen/Stats/incremental: Propagate ~x0 := ~x1 (i:~x3) was ~s2.~|" x a str i)))
+
+; But do update i in a% always, and partial-A when consistent
+   (if erp 
+       (value (list  '() ''t '() '() '() '() ;is it ok to give back empty alists?
+                 (acl2::change a% a% :inconsistent? T)))
+     ;else 
+     (b* (((list vars~ H~ C~) res)
+          (cl~ (clausify-hyps-concl H~ C~))
+          (ens (acl2::ens state))
+          (name~ (acl2::concatenate 'acl2::string name " incremental " (to-string x) " i=" (to-string i)))
+          (type-alist~ (get-acl2-type-alist cl~ name~ ens vl state))
+          (tau-interval-alist~ (tau-interval-alist-clause cl~ name~ ens vl wrld state))
+          (- (cw? nil "~% new ta = ~x0 and old ta = ~x1~%" type-alist~ type-alist))
+          (- (cw? nil "~% new tau-int-alist = ~x0 and old tau-int-alist = ~x1~%" tau-interval-alist~ tau-interval-alist))
+          (partial-A~  (put-val-A x a partial-A)) ; partial-A is a symbol-doublet-listp
+          )
+       
+
+       (value (list H~ C~ vars~ partial-A~ type-alist~ tau-interval-alist~
+                     (acl2::change a% a%
+                                   :inconsistent? NIL)))))))
+
+
+;mutually tail-recursive incremental (dpll) search prodecure
+(defs 
+  (incremental-search (a% A. 
+                          name  mv-sig-alist ;subgoal params
+                          run-hist% gcs%
+                          N vl sm blimit programp
+                          ctx wrld state)
+
+; INVARIANTS: 
+; - vars has at least 1 variable
+; - A. is a stack of consistent a% whose run-hist,gcs fields
+;   contain the sigma whose values agree with partial-A for
+;   the common variables
+;   
+
+; - a% is a snapshot. its occurs in 2 stages/forms. in the first stage
+;   it stores H,C,vars,partial-A, type-alist,tau-interval-alist
+;   and x just after a SELECT.
+;   It then gets updated by a consistent assign_propagate call.
+;   updated fields: a,kind,i,cs% and inconsistent? flag
+;   Finally the run-hist and gcs fields simply threaded through and through
+
+; - vars is disjoint with vars of partial-A stored in top of stack A.
+    (decl :sig ((a% a%-listp 
+                 string  symbol-alist
+                 run-hist%-p gcs%-p
+                 fixnump fixnump (in :random :uniform-random :be :mixed) fixnump booleanp
+                 symbolp plist-worldp state) -> 
+                (mv erp (list boolean run-hist% gcs%) state))
+        :mode :program
+        :doc "DPLL like algorithm that searches for a non-vacuous assignment to
+the form P (hyps /\ nconcl => nil).  This form returns (mv erp (list stop?
+run-hist% gcs%) state).  The search consists of a Select, Assign, Propagate
+loop.  Any inconsistency in P results in non-chronological backtracking to the
+last decision made in Assign. For more details refer to the FMCAD paper.")
+
+; here are abbreviations for functions with looooong arg lists
+; dont read them, go directly to the body of the function, refer to these
+; abbreviations while reading the main code.
+; NOTE: f* names have defun local scope and not across defuns/clique :(
+
+    (f* ((simple-search... () (simple-search name 
+                                             H C vars partial-A type-alist tau-interval-alist
+                                             mv-sig-alist
+                                             run-hist% gcs%
+                                             N vl sm programp t
+                                             ctx wrld state))
+         (backtrack... () (backtrack a% A.
+                                     name mv-sig-alist
+                                     run-hist% gcs%
+                                     N vl sm blimit programp
+                                     ctx wrld state))
+         
+         (recurse... () (incremental-search a% A.
+                                            name mv-sig-alist
+                                            run-hist% gcs%
+                                            (floor N (1+ (len A.))) ;geometrically decrease num of trials TODO revisit
+                                            vl sm blimit programp
+                                            ctx wrld state)))
+
+      (b* (((mv erp ap-res state) ;snapshot a% moves to second stage/form
+            (trans-eval `(assign-propagate ',a% ',name ',sm ',vl ',ctx ',wrld state R$ types-ht$)
+                        ctx state t))
+           ((when erp) ;error in assign value
+            (prog2$
+             (cw? (normal-output-flag vl)
+                  "~|CEGen/Error: Aborting incremental search!~|")
+             (mv T (list NIL run-hist% gcs%) state)))
+           ((list H C vars partial-A type-alist tau-interval-alist a%) (cadr (cdr ap-res))))
+      
+
+;       in
+        (if (not (access a% inconsistent?))
+           (b* (((mv erp (list stop? run-hist% gcs%) state)
+                 (simple-search...))
+                ((when (or erp stop?))
+; if theres an error or if we reach stopping condition, simply give up search
+                 (mv erp (list stop? run-hist% gcs%) state))
+
+                ((when (or (endp vars)
+                           (endp (cdr vars)))) 
+                 (backtrack...));no luck with :simple, lets backtrack and try again
+                 
+                (A. (cons a% A.))
+; ok lets set up a% for the next iteration
+                (x1 (select (cons (dumb-negate-lit C) H) (debug-flag vl)))
+                (a% (acl2::make a% 
+                                :vars vars :hyps H :concl C 
+                                :partial-A partial-A
+                                :type-alist type-alist
+                                :tau-interval-alist tau-interval-alist
+                                :inconsistent? nil :cs nil
+                                :var x1 :val ''? :kind :na :i 0)))
+;           in
+            (recurse...))
+
+
+;      ELSE inconsistent (i.e oops a contradiction found in hyps)
+         
+         (backtrack...)))))
+           
+ 
+; sibling procedure in clique
+  (backtrack (a% A. 
+                 name mv-sig-alist
+                 run-hist% gcs%
+                 N vl sm blimit programp
+                 ctx wrld state)
+; when called from incremental, either contradiction in hyps[x=a] or simple-search failed on P of zero/one variable
+    (decl :sig (( a%-p a%-listp 
+                 string symbol-alist
+                 run-hist%-p gcs%-p
+                 fixnum fixnum (in :random :uniform-random :be :mixed) fixnum boolean
+                 symbol plist-world state) 
+                -> (mv erp (list boolean run-hist% gcs%) state))
+         :mode :program
+         :doc "backtrack in dpll like search")
+   
+    (if (or (eq (access a% kind) :implied) 
+            (> (access a% i) blimit)) 
+        (if (null A.)
+;       THEN - error out if x0 exceeds blimit
+            (prog2$
+             (cw? (verbose-stats-flag vl)
+"~|CEGen/Note: Incremental search failed to even satisfy the hypotheses.~|")
+            (value (list NIL run-hist% gcs%)))
+;       ELSE throw away this a%
+          (b* ((a% (car A.))
+               (x (access a% var))
+               (- (cw? (verbose-stats-flag vl)
+"~|CEGen/Stats/incremental:  Backtrack to var : ~x0 -- i = ~x1~|" x (access a% i)))) 
+           (backtrack a% (cdr A.) ;pop stack
+                      name mv-sig-alist
+                      run-hist% gcs%
+                      N vl sm blimit programp
+                      ctx wrld state)))
+
+;     ELSE a% has a decision which has not reached its backtrack limit
+      (incremental-search a% A. 
+                          name mv-sig-alist
+                          run-hist% gcs%
+                          (floor N (1+ (len A.)))
+                          vl sm blimit programp
+                          ctx wrld state))))
+
+
+
+
+;;; The Main counterexample/witness generation function           
+(def cts-wts-search (name H C vars 
+                          type-alist tau-interval-alist mv-sig-alist
+                          programp defaults 
+                          run-hist% gcs%
+                          ctx wrld state)
+  (decl :sig ((string pseudo-term-list pseudo-term symbol-list
+                      symbol-alist symbol-alist symbol-alist
+                      boolean symbol-alist 
+                      run-hist%-p gcs%-p
+                      symbol plist-world state)
+              -> (mv erp (list boolean s-hist gcs%) state))
+        :mode :program
+        :doc 
+;Note: It does not update the global values @gcs% and @s-hist.
+"
+* Synopsis       
+  Local interface to subgoal-level counterexample and witness
+  search using either naive testing or incremental dpll
+  style search for counterexamples.
+
+* Input parameters
+  - first 8 params other than vars, see def csearch
+  - vars :: free variables of (H=>C) in dependency order
+  - run-hist% :: newly created run-hist% for this subgoal
+  - gcs% :: global gcs%
+  - rest see def csearch
+
+* Output signature 
+  - (mv erp (list stop? run-hist% gcs%) state) where erp is the error tag which is non-nil
+    when an error took place during evaluation of (search ...). 
+    stop? is T if we should abort our search, i.e our stopping
+    condition is satisfied (this value is given by run-tests), 
+    otherwise stop? is NIL (by default). run-hist% and gcs% are 
+    accumulated in the search for cts and wts in the current conjecture
+
+* What it does
+  1. retrieve the various search/testing parameters
+
+  2. call simple or incremental search
+     depending on the search-strategy set in defaults.
+  
+  3. return error triple with value (list stop? run-hist% gcs%)
+")
+
+  
+  (b* ((N (get-acl2s-default 'num-trials defaults 0)) ;shudnt it be 100?
+;Note: I dont need to provide the default arg 0 above, since we are
+;sure the defaults alist we get is complete i.e it would definitely
+;contain the key 'num-trials'. But I am envisioning a scenario, where
+;I might call this function on its own and not via test?, then this
+;functionality is useful for debugging.
+       (vl (get-acl2s-default 'verbosity-level defaults 1))
+       (sm (get-acl2s-default 'sampling-method defaults :random))
+       (ss (get-acl2s-default 'search-strategy defaults :simple))
+       (blimit (get-acl2s-default 'backtrack-limit defaults 2)))
+  
+;   in
+    (case ss ;search strategy
+      (:simple      (simple-search name 
+                                   H C vars '()
+                                   type-alist tau-interval-alist mv-sig-alist
+                                   run-hist% gcs% 
+                                   N vl sm programp nil
+                                   ctx wrld state))
+      
+
+      (:incremental (if (or (endp vars)
+                            (endp (cdr vars)))
+;bugfix 21 May '12 - if only one or zero var, call simple search
+                        (simple-search name
+                                       H C vars '()
+                                       type-alist tau-interval-alist mv-sig-alist
+                                       run-hist% gcs% 
+                                       N vl sm programp nil
+                                       ctx wrld state)
+                      
+                      (b* ((- (cw? (verbose-stats-flag vl) 
+                                   "~%~%CEgen/Note: Starting incremental (dpll) search~%"))
+                           (x0 (select (cons (dumb-negate-lit C) H) (debug-flag vl)))
+                           (a% (acl2::make a% ;initial snapshot
+                                           :vars vars :hyps H :concl C 
+                                           :partial-A '()
+                                           :type-alist type-alist
+                                           :tau-interval-alist tau-interval-alist
+                                           :inconsistent? nil :cs nil
+                                           :var x0 :val ''? :kind :na :i 0)))
+;                         in
+                        (incremental-search a% '() ;vars has at least 2
+                                            name mv-sig-alist
+                                            run-hist% gcs%
+                                            N vl sm blimit programp
+                                            ctx wrld state))))
+      
+      
+      (otherwise (prog2$ 
+                  (cw? (normal-output-flag vl)
+                       "~|CEgen/Error: Only simple & incremental search strategy are available~|")
+                  (mv T NIL state))))))
+
+   
+
+           
+  
+
+
+(def csearch (name H C 
+                   type-alist tau-interval-alist 
+                   mv-sig-alist elide-map 
+                   programp defaults 
+                   ctx wrld state)
+  (decl :sig ((string pseudo-term-list pseudo-term 
+                      symbol-alist symbol-alist 
+                      symbol-alist symbol-alist
+                      boolean symbol-alist
+                      symbol plist-world state)
+              -> (mv erp boolean state))
+        :mode :program
+        :doc 
+"
+* Synopsis       
+  Main Interface to searching for counterexamples (and witnesses)
+  in the conjecture (H => C)
+
+* Input parameters
+  - name :: name of subgoal or 'top if run from test?
+  - H :: hyps - the list of terms constraining the cts and wts search
+  - C :: conclusion
+  - type-alist :: types inferred by ACL2 forward-chain
+  - mv-sig-alist :: for each mv fn, stores its output arity
+  - elide-map :: elide-map[v] = term for each elided variable v
+  - programp :: T when form has a program mode fun or we are in :program
+                Its only use is for efficiency. We use guard-checking :none
+                for programp = T and nil otherwise, which is more efficient.
+  - defaults :: alist overiding the current acl2s-defaults
+  - ctx :: usually the top-level form which employed this procedure
+  - wrld :: current acl2 world
+  - state :: state
+
+* Output signature 
+  - (mv erp stop? state) where erp is the error tag which is non-nil
+    when an error took place during evaluation of (search ...). 
+    stop? is T if we should abort our search.
+
+* What it does
+  1. construct a new s-hist-entry% and call cts.wts.search fun
+     with globals @gcs, run-hist% and defaults
+  2. the return values of run-hist% (a field in s-hist-entry%), gcs% 
+     are recorded in globals @gcs and @s-hist.
+  3. return error triple containing stop? (described in simple-search)
+")
+
+  (f* ((update-cts-search-globals ()
+         (b* ((s-hist-entry% (change s-hist-entry% run-hist run-hist%))
+              ((mv end state) (acl2::read-run-time state))
+              (s-hist-entry% (change s-hist-entry% end-time end))
+              (s-hist (get-s-hist-global))
+;note that name is a string so we use equal instead of eq in put-assoc
+;put the pair (name . s-hist-entry%) in a list (looks like a stack)
+              (s-hist (put-assoc-equal name s-hist-entry% s-hist))
+              (state (put-s-hist-global s-hist))
+              (state (put-gcs%-global gcs%)))
+          state)))
+
+    (b* (((mv start state) (acl2::read-run-time state))
+         (vl (get-acl2s-default 'verbosity-level defaults 1))
+         (vars (vars-in-dependency-order H C vl wrld))
+         (s-hist-entry% (initial-s-hist-entry% name H C vars 
+                                               elide-map start))
+         (run-hist% (access s-hist-entry% run-hist))
+         (gcs% (get-gcs%-global))
+         ((mv erp res state)
+          (cts-wts-search name H C vars 
+                          type-alist tau-interval-alist mv-sig-alist
+                          programp defaults 
+                          run-hist% gcs%
+                          ctx wrld state))
+         ((unless (and (= 3 (len res))
+                       (booleanp (first res))
+                       (run-hist%-p (second res))
+                       (gcs%-p (third res))))
+          (prog2$ 
+           (cw? (verbose-flag vl)
+                "~|CEgen/Error : Bad result from main Cgen procedure!~|")
+           (mv T nil state)))
+         ((list stop? run-hist% gcs%) res)
+         (state (update-cts-search-globals)))
+      (mv erp stop? state))))
+       
+   
+(def csearch-with-timeout (name H C 
+                                type-alist tau-interval-alist 
+                                mv-sig-alist elide-map 
+                                programp defaults 
+                                ctx wrld state)
+  (decl :sig ((string pseudo-term-list pseudo-term 
+                      symbol-alist symbol-alist 
+                      symbol-alist symbol-alist
+                      boolean symbol-alist
+                      symbol plist-world state)
+              -> (mv erp boolean state))
+        :mode :program
+        :doc "wrap csearch with a timeout mechanism")
+  (acl2::with-timeout1
+   (acl2s-defaults :get subgoal-timeout)
+   (csearch name H C 
+            type-alist tau-interval-alist 
+            mv-sig-alist elide-map
+            programp defaults ctx wrld state)
+   (prog2$
+    (cw? (normal-output-flag 
+             (get-acl2s-default 'verbosity-level defaults 1))
+            "~|Search for counterexamples TIMED OUT! ~
+Use (acl2s-defaults :set subgoal-timeout 0) to disable timeout. ~
+For more information see :doc subgoal-timeout.~%")
+; error flag raised. stop? is set to NIL but it doesnt matter I guess.
+    (mv T NIL state)))) ;TODO im losing testing summary here!
+               
+  
+;;list comprehension syntax
+;; (and (true-listp vs)
+;;      (null |[x : x in vs :  (not (possible-defdata-type-p x))]|))
+ 
+;NOTE 
+#|(acl2::state-global-let*
+                    ((acl2::inhibit-output-lst
+                      ,(if (system-debug-flag vl)
+                          ''(summary)
+                        ;;shut everything except error
+                        ''(warning warning! observation prove
+                                  proof-checker event expansion
+                                  proof-tree summary)))) 
+                    
+doesnt work on an make-event
+|#
+
+
+(defun test-gen-checkpoint ()
+  (declare (xargs :mode :program))
+  `(:computed-hint-replacement
+     t
+     :backtrack
+     (cond
+      ((eq acl2::processor 'acl2::generalize-clause)
+       (er-let*
+         ((res (test-gen-clause (car clause-list)
+                            state)))
+         (value (cond (res
+                       '(:do-not '(acl2::generalize)
+                         :no-thanks t))
+                      (t nil)))))
+      (t (value nil)))))
+
+(defun initial-subseq-p (x y)
+  (declare (xargs :guard (true-listp x)))
+  (if (endp x)
+      t
+    (and (consp y)
+         (equal (car x) (car y))
+         (initial-subseq-p (cdr x) (cdr y)))))
+
+(defun cl-id-ancestor (parent child)
+  "Sig: clause-id * clause-id -> boolean
+   function: Is parent an ancestor of child in the ACL2 proof tree?"
+  (declare (xargs :mode :program))
+  (and (equal (acl2::access acl2::clause-id parent :forcing-round)
+              (acl2::access acl2::clause-id child :forcing-round))
+       (equal (acl2::access acl2::clause-id parent :pool-lst)
+              (acl2::access acl2::clause-id child :pool-lst))
+       (if (equal (acl2::access acl2::clause-id child :case-lst)
+                  (acl2::access acl2::clause-id parent :case-lst))
+           (or (null (acl2::access acl2::clause-id parent :primes))
+               (and (acl2::access acl2::clause-id child :primes)
+                    (< (acl2::access acl2::clause-id parent :primes)
+                       (acl2::access acl2::clause-id child :primes))))
+         (initial-subseq-p (acl2::access acl2::clause-id parent :case-lst)
+                           (acl2::access acl2::clause-id child :case-lst)))))
+
+        
+#||    
+; walk the table up to the parent and do intersection of the types
+; to find the smallest type
+; TODO - might be unsound - ASK Pete!
+(defun walk-to-parent-and-collect-type-info
+  (id goal-var-info-alst current-vars wrld ans)
+  (declare (xargs :mode :program))
+  (if (endp goal-var-info-alst)
+;ENd of walk(Base case 1), dead code!
+    ans
+    (let* ((curr-entry (car goal-var-info-alst))
+           (curr-id (car curr-entry)))
+;(Base case 2)
+;current subgoal is 'Top of "Goal", do intersection and return result
+      (if (or
+           ;;quickfix a possible bug in cl-id-ancestor 
+           (equal curr-id (acl2::parse-clause-id "Goal"))
+           ;;perhaps called from test? and thm? stop here              
+           (equal curr-id 'Top))
+        (let* ((var-info (cdr curr-entry)) 
+               (vt-alst var-info))
+          (union-vt-and ans vt-alst current-vars wrld))
+;current subgoal is the closest ancestor, do intersection and return result
+        (if (and (not (equal curr-id id))
+                 (cl-id-ancestor curr-id id))
+           ;is closest ancestor 
+          (let* ((var-info (cdr curr-entry)) 
+                 (vt-alst var-info))
+            (union-vt-and ans vt-alst current-vars wrld))
+;else Recursively walk up to the next ancestor
+          (walk-to-parent-and-collect-type-info id 
+                                                (cdr goal-var-info-alst)
+                                                current-vars wrld ans))))))
+||#
+
+;-- 2 functions by Matt, to get elided variable replaced term information --
+(defun get-dest-elim-replaced-terms (elim-sequence)
+  (if (endp elim-sequence)
+    nil
+    (let* ((elt (car elim-sequence))
+           (rhs (nth 1 elt))
+           (lhs (nth 2 elt)))
+      (cons (list rhs lhs)
+            (get-dest-elim-replaced-terms (cdr elim-sequence))))))
+
+
+(defun collect-replaced-terms (hist ans)
+  (declare (xargs :mode :program))
+  (if (endp hist)
+    ans
+    (b* ((H (car hist))
+         (ttree (acl2::access acl2::history-entry H :ttree))
+         (proc (acl2::access acl2::history-entry H :processor))
+         ;(- (cw "DEBUG: proc is ~x0~%" proc))
+         )
+      (cond ((eq proc 'acl2::generalize-clause)
+;Generalize
+             (let ((ans1 
+                    (list-up-lists 
+                     (acl2::tagged-object 'acl2::terms ttree)
+                     (acl2::tagged-object 'acl2::variables ttree))))
+               (collect-replaced-terms 
+                (cdr hist) (append ans1 ans))))
+            ((eq proc 'acl2::eliminate-destructors-clause)
+;Destructor elimination
+             (let* ((elim-sequence 
+                     (acl2::tagged-object 'acl2::elim-sequence ttree))
+                    (ans1 (get-dest-elim-replaced-terms elim-sequence)))
+               (collect-replaced-terms
+                (cdr hist) (append ans1 ans))))
+;Else (simplification and etc etc)
+            (t (let* ((binding-lst 
+                       (acl2::tagged-object 'acl2::binding-lst ttree))
+                      (ans1 (convert-conspairs-to-listpairs binding-lst)))
+                 (collect-replaced-terms
+                  (cdr hist) (append ans1 ans))))))))
+                 
+
+;; The following 2 functions need to be revisited and rewritten if necessary
+(defun let-binding->dep-graph-alst (vt-lst ans)
+  "Walk down the var-term list vt-lst and add edges. 
+   Build graph alist in ans"
+  (if (endp vt-lst)
+      ans
+    (b* (((list var term) (car vt-lst))
+         (fvars (get-free-vars1 term nil)));only non-buggy for terms
+   
+      (let-binding->dep-graph-alst 
+       (cdr vt-lst)
+       (union-entry-in-adj-list var fvars ans)))))
+
+
+(defun do-let*-ordering (vt-lst debug-flag)
+  (declare (xargs :guard (symbol-alistp vt-lst)
+                  :mode :program))
+  (b* ((vars (all-vars-in-var-term-alst vt-lst))
+       (dep-g (let-binding->dep-graph-alst vt-lst 
+                                           (make-empty-adj-list vars)))
+       (sorted-vars (approximate-topological-sort dep-g debug-flag)))
+    (get-ordered-alst (rev sorted-vars) vt-lst nil)))
+#||
+(do-let*-ordering '((X3 '+)
+                    (W1 (CONS W W2))
+                    (X (CONS X1 X2))
+                    (X2 (CONS X3 X4))
+                    (W2 (CONS W4 X3))
+                    (Z (CONS Y X3))
+                    (Y (CONS X X3))
+                    (W (CONS Z Y))) 
+                  nil)
+||#
+
+
+
+
+(set-verify-guards-eagerness 0)
+(verify-termination acl2::subcor-var1)      
+(verify-termination subcor-var)
+
+;expand-lambda : pseudo-termp -> pseudo-termp (without lambdas)
+(mutual-recursion
+ (defun expand-lambda (term)
+   (declare (xargs :guard (pseudo-termp term)))
+   (cond ((variablep term) term)
+         ((fquotep term) term)
+         ((eq (ffn-symb term) 'acl2::hide) term)
+         (t
+          (let* ((expanded-args (expand-lambda-lst (fargs term)))
+                 (fn (ffn-symb term)))
+               
+            (cond ((flambdap fn) ;get rid of the lambda application
+                   (subcor-var (lambda-formals fn)
+                               expanded-args 
+                               (expand-lambda (lambda-body fn))))
+                    
+                  (t (acl2::cons-term fn expanded-args)))))))
+
+(defun expand-lambda-lst (term-lst)
+  (declare (xargs :guard (pseudo-term-listp term-lst)))
+  (cond ((endp term-lst) '())
+        (t (cons (expand-lambda (car term-lst))
+                 (expand-lambda-lst (cdr term-lst))))))
+
+ )
+
+(def partition-hyps-concl (term str state)
+  (decl :mode :program
+        :sig ((pseudo-termp stringp state) -> (mv pseudo-term-listp pseudo-termp state))
+        :doc "expand lambdas, extracts hyps and concl from term") ;expensive operation
+  ;; get rid of lambdas i.e let/let*
+  (b* ((term  (expand-lambda term))
+       (wrld (w state))
+       (pform (acl2::prettyify-clause (list term) nil wrld))
+       ((mv phyps pconcl)  (mv (get-hyps pform) (get-concl pform)))
+       
+       ((er hyps) (acl2::translate-term-lst phyps 
+                                            t nil t str wrld state)) 
+       ((er concl) (acl2::translate pconcl t nil t str wrld state)))
+    (mv hyps concl state)))
+                      
+(defun get-var-tau-alist (term state)
+  (declare (xargs :mode :program :stobjs (state)))
+  (b* ((ens (acl2::ens state))
+       (wrld (w state))
+       ((er term) (acl2::translate term t nil t "get-tau-alist" wrld state))
+       ((mv hyps concl state) (partition-hyps-concl term "get-tau-alist" state))
+       (cl (clausify-hyps-concl hyps concl))
+       (tau-alist (tau-alist-clause cl nil ens wrld state))
+       (var-taus-alist (make-var-taus-alist (all-vars term) tau-alist)))
+    (mv nil  var-taus-alist state)))
+
+(defun get-tau-interval-alist (term name vl state)
+    (declare (xargs :mode :program :stobjs (state)))
+    (b* (((er var-taus-alist) (get-var-tau-alist term state))
+         (var-tau-interval-alist (tau-interval-alist var-taus-alist))
+         (- (cw? (debug-flag vl)
+                 "~|CEgen/Debug: tau interval alist (~s0): ~x1~|" name var-tau-interval-alist)))
+      (value var-tau-interval-alist)))
+
+
+;-------------------------PRINT----------------------------------
+;-------------------------start----------------------------------
+
+
+;; translating bindings in terms of original top goal free variables
+;; added  a flag indicating wether we are printing counterexamples or witnesses
+;; changed |dont care| to ? --Nov26th
+;; counteregp is a flag which tells us that bindings 
+;; that we found is for a counterexample
+;; and is for a witness otherwise. This helps us in checking if the
+;; top-goal bindings and the top-goal orig-clause are consistent 
+;; with the subgoal bindings result.
+;; Pre-condition var-term-alst is in proper let* order, o.w let*
+;; complains
+;; April 30 '12: Return to simple trans-eval with state
+;; we dont care about efficiency wrt ev-w because we only ever print
+;; a small number of cts/wts.
+;; May 13th '12 : better naming
+
+(program) ;; all print functions are program mode funs
+
+(set-verify-guards-eagerness 1)
+
+(defun get-top-level-assignment (A top-vars top-term 
+                                   elided-var-map counteregp state)
+  (declare (xargs :stobjs (state)
+                  :guard (and (symbol-alistp elided-var-map)
+                              (symbol-listp top-vars)
+                              (booleanp counteregp)
+                              (symbol-doublet-listp A))))
+  
+  (b* ((new+elim (all-vars `(list ,@(strip-cadrs elided-var-map))))
+       (bound (strip-cars (append A elided-var-map)))
+       (not-bound (set-difference-eq (union-eq new+elim top-vars) bound))
+       (nil-A (make-constant-value-let-bindings not-bound 'acl2::? nil))
+       (A (append nil-A A))
+       (A (quote-conses-and-symbols-in-bindings A))
+       (bound (strip-cars A))
+;filter out entries due to generalization and cross-fertilization
+       (elided-var-map (remove-entry-lst bound
+;if its already bound why bind it again
+                                         (filter-symbol-keys-in-alist 
+                                          elided-var-map)))
+       (A (append A elided-var-map))
+      
+;; ;TODO: ASK Matt, why is generalization not being captured.
+;; ;Maybe bug in my code!!? CHECK
+;; (thm (implies (true-listp x)
+;;               (equal (rev (rev x)) x))) 
+
+       ((mv ?er res state) 
+        (acl2::state-global-let*
+         ((acl2::guard-checking-on :none))
+         (trans-eval
+          `(let* ,A
+             (declare (ignorable ,@(strip-cars A)))
+             (list ,top-term
+; make list/let A (list `(var ,var) ...) 
+                   ,(make-var-value-list-bindings top-vars nil)))
+          'get-top-level-assignment state T))) ;defttach ok
+       ((list form-eval-res top-A) (cdr res)))
+
+;  in
+   (if (or (and counteregp (not form-eval-res)) 
+;check if its really a counter-example or really a witness
+           (and (not counteregp) form-eval-res)) 
+       (value (list t top-A))
+;only return A if its a true counterexample/witness
+     (value (list nil top-A)))));nil means inconsistent top-level A
+
+;; Print the random instantiations for a particular test run.
+;; Return value is a dummy error-triple. 
+;; This function is called for side-effect only(printing IO)
+;; Binding == (var val) 
+;; added a flag wether bindings are for a counter-example or not
+;; Sep 5th 2011 - removed state, and use cw?
+;; April 30 2012 - put back state!
+(defun print-assignment (A top-vars top-term elided-var-map
+                           vl counteregp state)
+  (declare (xargs :stobjs (state)
+                  :guard (and (symbol-doublet-listp A)
+                              (implies (consp A) (consp (car A)))
+                              (symbol-alistp elided-var-map)
+                              (symbol-listp top-vars)
+                              (booleanp counteregp))))
+                              
+;the usual, but filter the variables that are in the original output clause
+  (b* ((top-A (filter-alist-keys A top-vars))
+       ((unless elided-var-map) ;the simple case
+        (value (cw? (normal-output-flag vl)
+                    "~| -- ~&0~%" top-A)))
+  
+;show top goal, show counterexamples and witness in 
+;terms of the original free variables(of the top clause)
+       ((er (list consistent? top-A))
+        (get-top-level-assignment A top-vars top-term 
+                                  elided-var-map counteregp state))
+
+       ((when consistent?)
+        (value (cw? (normal-output-flag vl)
+                    "~| -- ~&0~%"  top-A))))
+    (if counteregp
+        (progn$
+         (cw? (normal-output-flag vl)
+              "~| -- ~&0~%"  top-A)
+         (cw? (normal-output-flag vl)
+"~|WARNING: The above counterexample is not consistent with top-level form. ~
+ This is most likely due to the application of an elim rule that generalized ~
+ its parent goal. If that is not what happened, then please report this ~
+ example to ACL2s authors.~%")
+         (value nil))
+      (progn$
+       (cw? (normal-output-flag vl)
+            "~| -- ~&0~%"  top-A)
+       (cw? (normal-output-flag vl)
+"~|NOTE: The above witness is not consistent with the top-level form. ~
+ Witnesses are only guaranteed to be consistent with subgoals.~%")
+       (value nil))
+       )))
+
+(defun naive-print-bindings (bindings orig-vars verbosity-level)
+  (declare (xargs :guard (and (symbol-doublet-listp bindings)
+                              (symbol-listp orig-vars)
+                              (natp verbosity-level)
+                              (implies (consp bindings)
+                                       (and (consp (car bindings))
+                                            (symbolp (caar bindings)))))))
+;the usual, but filter the variables that are in the original output clause
+  (b* ((out-bindings (acl2::restrict-alist orig-vars bindings ))
+       (vl verbosity-level))
+      (cw? (normal-output-flag vl)
+             "~| -- ~&0~%" out-bindings)))
+  
+
+
+;added a flag indicating wether we are printing counterexamples or witnesses
+(defun print-assignments (A-lst top-vars top-term 
+                               elided-var-map vl counteregp state)
+;perfix-A is assignments made incrementally in dpll search
+  (declare (xargs :stobjs (state)
+                  :guard (and (symbol-alist-listp A-lst)
+                              (symbol-listp top-vars)
+                              (natp vl)
+                              (symbol-alistp elided-var-map)
+                              (booleanp counteregp))))
+   (if (endp A-lst)
+     (value nil)
+     (er-progn
+      (print-assignment (car A-lst) top-vars top-term
+                        elided-var-map vl counteregp state)
+; (naive-print-bindings (convert-conspairs-to-listpairs (car bindings-lst))
+;                       orig-vars vl)
+      (print-assignments (cdr A-lst) top-vars top-term
+                          elided-var-map vl counteregp state))))
+(logic)
+
+
+; 30th Aug '12 keep global track of num of wts/cts to print
+(def print-cts/wts (s-hist cts-p nc nw top-vars top-term vl state)
+  (decl :mode :program
+        :sig ((s-hist-p booleanp symbol-listp all natp state) 
+              -> (mv erp all state))
+        :doc "print all cts/wts A (sigma) in s-hist subgoal testing
+        history alist")
+  (if (endp s-hist)
+      (value nil)
+    (b* (((cons name s-hist-entry%) (car s-hist))
+         (run-hist% (access s-hist-entry% run-hist))
+         (hyps      (access s-hist-entry% hyps))
+         (concl     (access s-hist-entry% concl))
+         ((when (and cts-p (zp nc)))
+; number of cts yet to be printed is zero, skip 
+          (value nil))
+         ((when (and (not cts-p) (zp nw))) 
+; number of wts yet to be printed is zero, skip 
+          (value nil))
+         
+         (A-lst (if cts-p 
+                    (access run-hist% cts)
+                  (access run-hist% wts)))
+         (elide-map (access s-hist-entry% elide-map))
+         (- (cw? (debug-flag vl) 
+"~|DEBUG/print-cts/wts: A-lst:~x0 top-vars:~x1 elide-map:~x2~|" 
+A-lst top-vars elide-map))
+         ((when (endp A-lst)) 
+; none found, so move on to the next subgoal
+          (print-cts/wts (cdr s-hist) cts-p 
+                         nc nw top-vars top-term vl state))
+         (nc (- nc (if cts-p (len A-lst) 0)))
+         (nw (- nw (if cts-p 0 (len A-lst))))
+         (- (cw? (normal-output-flag vl) "~| [found in : ~x0]~%" name))
+         (cl (clausify-hyps-concl hyps concl))
+         (pform (acl2::prettyify-clause cl nil (w state)))
+         (- (cw? (and (not (equal "top" name))
+                      cts-p
+                      (normal-output-flag vl)) "~x0~%" pform))
+         )
+     (er-progn
+      (print-assignments A-lst top-vars top-term elide-map vl cts-p state)
+      (print-cts/wts (cdr s-hist) cts-p nc nw top-vars top-term vl state)))))
+
+
+(def print-s-hist (s-hist printc? printw? nc nw 
+                          top-term top-vars vl state)
+;nc and nw are the number of cts/wts requested by user (acl2s defaults)
+  (decl :mode :program
+        :sig ((s-hist-p bool bool natp natp 
+                        pseudo-termp symbol-list fixnum state) 
+              -> (mv erp all state))
+        :doc "print counterexample and witnesses recorded in testing subgoal
+history s-hist.")
+  (b* (((er &) (if printc?
+                   (prog2$
+                    (cw? (normal-output-flag vl)
+"~|~%We falsified the conjecture. Here are counterexamples:~|")
+                    (print-cts/wts s-hist T nc nw top-vars top-term vl state))
+                 (value nil)))
+
+       ((er &) (if printw?
+                   (prog2$
+                    (cw? (normal-output-flag vl)
+"~|~%Cases in which the conjecture is true include:~|")
+                    (print-cts/wts s-hist NIL nc nw top-vars top-term vl state))
+                 (value nil))))
+    (value nil)))
+(logic)
+
+  
+;for trace$ debugging - remove when satisfied 
+(defun my+ (a b) (+ a b))
+(defun my- (a b) (- a b))
+
+(def total-time-spent-in-testing (s-hist)
+  (decl :sig ((s-hist-p) -> rationalp)
+        :doc "calculate testing time across subgoals")
+  (if (endp s-hist)
+      0
+    (b* (((cons & s-hist-entry%) (car s-hist)))
+     (my+ (my- (access s-hist-entry% end-time)
+               (access s-hist-entry% start-time))
+          (total-time-spent-in-testing (cdr s-hist))))))
+      
+  
+
+(defun print-testing-summary-fn (vl state)
+  (declare (xargs :mode :program
+                  :stobjs (state)))
+  (b* ((ctx 'print-testing-summary)
+;when testing errored out or timed out, theres no point of printing.
+       (s-hist (get-s-hist-global))
+       (gcs%   (get-gcs%-global))
+       (- (cw? (debug-flag vl) "~|testing summary - gcs% = ~x0~%" gcs%))
+       (- (cw? (debug-flag vl) "~|testing summary - s-hist = ~x0~%" s-hist))
+       ((unless (and (consp s-hist) (consp (car s-hist))
+                     (> (access gcs% total-runs) 0)))
+        (value (cw? (normal-output-flag vl) 
+"~|CEgen/Note: No testing summary to print~|")))
+                  
+       (num-subgoals (len s-hist))
+       
+       )
+   (case-match gcs%
+     (('gcs% (total dups . vacs) 
+             (num-cts . num-wts) 
+             (cts-to-reach . wts-to-reach) 
+             (start . end) & . &)
+;ACHTUNG: gcs% defrec exposed
+      (b* ((uniq-runs  (my+ num-wts num-cts))
+           (sat-runs (my- total (my+ vacs dups)))
+           (delta-t-total (my- end start))
+           (delta-testing-t-total (total-time-spent-in-testing s-hist))
+           (top-term (access gcs% top-term))
+           (top-vars (all-vars top-term))
+           (pform (acl2::prettyify-clause 
+                   (list top-term) nil (w state)))
+           ((unless (consp top-vars))
+            (b* ((res (if (> num-cts 0) nil t)))
+              (value (cw? (normal-output-flag vl) 
+"~% ~x0 evaluates to ~x1. Nothing to test!~%" pform res))))
+
+           
+           (-  (cw? (normal-output-flag vl) 
+                    "~%**Summary of testing**~%"))
+           (- (cw? (verbose-flag vl)
+                   "~x0~%" pform))
+           (- (cw? (normal-output-flag vl)
+               "~|We tested ~x0 examples across ~x1 subgoals, of which ~x2 (~x3 unique) satisfied the hypotheses, and found ~x4 counterexamples and ~x5 witnesses.~%"
+               total num-subgoals sat-runs uniq-runs num-cts num-wts))
+
+           (- (cw? (verbose-flag vl)
+               "~|The total time taken (incl. prover time) is "))
+; from Matt's save-time book
+           ((er &) (if (verbose-flag vl)
+                       (pprogn (print-rational-as-decimal delta-t-total
+                                                      (standard-co state)
+                                                      state)
+                           (princ$ " seconds" (standard-co state) state)
+                           (newline (standard-co state) state)
+                           (value :invisible))
+                     (value nil)))
+
+           (- (cw? (verbose-flag vl)
+               "~|The time taken by testing is "))
+           ((er &) (if (verbose-flag vl)
+                       (pprogn (print-rational-as-decimal delta-testing-t-total
+                                                      (standard-co state)
+                                                      state)
+                           (princ$ " seconds" (standard-co state) state)
+                           (newline (standard-co state) state)
+                           (value :invisible))
+                     (value nil)))
+           
+           ((er &)  (print-s-hist s-hist 
+                                  (> num-cts 0);print cts if true
+                                  (> num-wts 0);print wts if true
+                                  cts-to-reach wts-to-reach 
+                                  top-term top-vars
+                                  vl state)))
+       (value nil)))
+     (& (value (cw? (normal-output-flag vl) "~|CEgen/Error: BAD gcs% found in globals~|"))))))
+
+
+
+
+;----------------------------------------------------------------
+;                         PRINT end                             |
+;----------------------------------------------------------------
+
+   
+  
+(defun cts-wts-search-clause (cl name mv-sig-alist 
+                                 ens hist elim-elided-var-map
+                                 vl ctx wrld state)
+   "helper function for test-checkpoint. It basically sets up 
+   everything for the call to csearch."
+  (declare (xargs :stobjs (state) :mode :program))
+  (b* ((vt-acl2-alst (get-acl2-type-alist cl name ens vl state))
+       ((mv hyps concl) (clause-mv-hyps-concl cl))
+       (- (cw?  (verbose-stats-flag vl)
+              "~|CEgen/Verbose: Search clause with elide-map ~x0 ~ ~x1 ~|" 
+              elim-elided-var-map (acl2::prettyify-clause cl nil wrld)))
+       (elided-var-map (append (collect-replaced-terms hist nil)
+                               elim-elided-var-map))
+       ;; Ordering is necessary to avoid errors in printing top-level cts
+
+       (ord-elide-map (do-let*-ordering elided-var-map (debug-flag vl)))
+       (defaults (acl2s-defaults-alist))
+       (tau-interval-alist (tau-interval-alist-clause cl name ens vl wrld state))
+       ((mv erp stop? state)  (csearch name hyps concl 
+                                     vt-acl2-alst tau-interval-alist 
+                                     mv-sig-alist ord-elide-map 
+                                     NIL defaults ctx wrld state)))
+    (mv erp stop? state)))
+
+
+(defun cts-wts-search-clauses (clauses name mv-sig-alist 
+                                 ens hist elim-elided-var-map
+                                 vl ctx wrld state)
+"not used"
+  (declare (xargs :stobjs (state) :mode :program))
+  (if (endp clauses)
+      (mv nil nil state)
+    (b* (((mv erp stop? state)
+          (cts-wts-search-clause (car clauses) name mv-sig-alist
+                                 ens hist elim-elided-var-map 
+                                 vl ctx wrld state))
+         ((when (or erp stop?))
+          (mv erp stop? state)))
+      (cts-wts-search-clauses (cdr clauses) name mv-sig-alist
+                              ens hist elim-elided-var-map 
+                              vl ctx wrld state))))
+  
+
+
+
+      
+(def simplify/throw-hyps-elim1 (rem-hyps elim-hyps hints ans. vl state)
+  (decl :sig ((pseudo-term-list pseudo-term-list true-list pseudo-term-list fixnum state)
+              -> (mv erp pseudo-term-list state))
+        :mode :program
+        :doc "easy simplify each implicative hyp in rem-hyps assuming
+  elim-hyps, accumulate in ans., we just simplify the antecedent and
+  keep it if its simplified to true. if not we throw it, and return a
+  value triple containing shyps. return erp=T is found contradiction
+  in an shyp. order is preserved.")
+  (declare (ignorable vl))
+  (if (endp rem-hyps)
+      (value ans.)
+    (b* ((hyp         (car rem-hyps))
+         (implicative? (and (consp hyp)
+                            (eq 'acl2::implies (ffn-symb hyp)))))
+      (if implicative?
+         (b* (((er antecedent)   (simplify-term (second hyp) elim-hyps hints state))
+              (ans. (if (or (equal antecedent ''t)
+                            ;hack
+                            (member-equal antecedent elim-hyps))
+                        (append ans. (list (third hyp)))
+                      ans.)))
+           (simplify/throw-hyps-elim1 (cdr rem-hyps) elim-hyps hints
+                                      ans. vl state))
+        (b* (((er shyp)   (simplify-term hyp elim-hyps hints state))
+              (ans. (if (equal shyp ''t)
+                        ans.
+                      (if (term-order shyp hyp)
+                          (append ans. (list shyp))
+                        (append ans. (list hyp))))))
+          (simplify/throw-hyps-elim1 (cdr rem-hyps) elim-hyps hints
+                                     ans. vl state))))))
+
+(def simplify/throw-hyps-elim (hyps elim-hyps hints vl state)
+  (decl :sig ((pseudo-term-list pseudo-term-list true-list fixnum state)
+              -> (mv erp pseudo-term-list state))
+        :mode :program
+        :doc "see simplify/throw-hyps-elim1 doc")
+  (b* ((- (time-tracker :simplify-hyps-elim :start))
+       ((mv erp shyps state) (simplify/throw-hyps-elim1 hyps elim-hyps hints '() vl state))
+       (- (time-tracker :simplify-hyps-elim :stop))
+       (- (and (verbose-stats-flag vl)
+               (time-tracker :simplify-hyps-elim :print?))))
+    (mv erp shyps state)))
+  
+
+;eliminable-type-alist is (listof (cons var (list type type-class)))
+       
+;todo - order
+(defun record-eliminable-type-alist (def vars elt wrld ans)
+  (if (endp vars)
+      ans
+    (b* ((?rhs (nth 1 elt))
+         (lhs (nth 2 elt)) ;(list rhs lhs) (X (REC1 MT MT0))
+         (defbody (cadr def))
+         (i (position (car vars) lhs))
+         (field-type (nth i defbody))
+         (fentry (assoc-eq field-type (table-alist 'defdata::types-info-table wrld)))
+         (tc (and (consp fentry)
+                  (acl2::access types-info% (cdr fentry) :type-class))))
+      (if (equal tc 'record)
+          (record-eliminable-type-alist def (cdr vars) elt wrld (acons (car vars) (list field-type tc) ans))
+        (if (equal tc 'map) ;maps at the end, records in front
+            (record-eliminable-type-alist def (cdr vars) elt wrld (append ans (acons (car vars) (list field-type tc) '())))
+          (record-eliminable-type-alist def (cdr vars) elt wrld ans)))))) ;drop non-records
+         
+ 
+(defun map-eliminable-type-alist (type vars elt wrld)
+  (b* (((list a v x) vars)
+       (lhs (nth 2 elt)) ;(list rhs lhs) (X (MSET a v m))
+       (entry (assoc-eq type (table-alist 'defdata::types-info-table wrld)))
+       (def (car (acl2::access types-info% (cdr entry) :defs))) ;(map1 (oneof nil (mset pc data map1)))
+       (defbody (cadr def))
+       (`(oneof nil ,mset-def) defbody)
+       (ai (position a lhs))
+       (a-type (nth ai mset-def))
+       (a-entry (assoc-eq a-type (table-alist 'defdata::types-info-table wrld)))
+       (vi (position v lhs))
+       (v-type (nth vi mset-def))
+       (v-entry (assoc-eq v-type (table-alist 'defdata::types-info-table wrld)))
+       (a-tc (and (consp a-entry)
+                  (acl2::access types-info% (cdr a-entry) :type-class)))
+       (ans (acons x (list type 'map) '())) ;give back its rest for furthur map dest-elim
+       (ans (if (member-equal a-tc '(record map))
+                (acons a (list a-type a-tc) ans)
+              ans))
+       (v-tc (and (consp v-entry)
+                  (acl2::access types-info% (cdr v-entry) :type-class)))
+       (ans (if (member-equal v-tc '(record map))
+                (acons v (list v-type v-tc) ans)
+              ans)))
+    ans))
+       
+        
+
+       
+(defun new-eliminable-type-alist (type tc vars elt wrld)
+  (case tc
+    (record (b* ((entry (assoc-eq type (table-alist 'defdata::types-info-table wrld)))
+                 (def (car (acl2::access types-info% (cdr entry) :defs)))) ;(REC1 (REC1 REC0 RATIONAL))
+              (record-eliminable-type-alist def vars elt wrld '())))
+    (map (map-eliminable-type-alist type vars elt wrld))
+    (otherwise '())))
+
+
+
+(defun get-disabled-funs-elim-simp (type tc wrld)
+  (b* ((?record-conx (strip-cars (table-alist 'defdata::record-constructors wrld)))
+       (entry (assoc-eq type (table-alist 'defdata::types-info-table wrld))) ;definitely in the table
+       (def (car (acl2::access types-info% (cdr entry) :defs))) ;(REC1 (REC1 REC0 RATIONAL)) or ;(reg (oneof nil (mset nat data reg)))
+       (defbody (cadr def))
+       (field-types (cond ((equal tc 'record)
+                           (cdr defbody)) ;(REC1 REC0 RATIONAL)
+                          ((equal tc 'map)
+                           (cdr (third defbody)));(oneof nil (mset nat data reg))
+                          (t '())))
+                           
+       (field-preds (get-predicate-symbol-lst field-types)))
+    (append nil ;record-conx 
+            field-preds)))
+
+       
+(defun subst-equal-alist (alist tree)
+  (declare (xargs :guard (alistp alist)))
+  (if (endp alist)
+    tree
+    (subst-equal-alist
+      (cdr alist)
+      (subst-equal (cdar alist) (caar alist) tree))))
+
+#|
+(DEFDATA::GET-DEST-ELIM-REPLACED-TERMS
+        ((-1 MT1 (MSET MT9 MT10 MIY)
+             ((MT8 . MT9)
+              ((MGET MT8 MT1) . MT10)
+              ((MAP-IDENTITY MT1) . MIY)) . &)
+|#
+; NOTE: MT8 above needs to be captured in the elided-var-map (binding)
+; TODO: get-dest-elim-replaced-terms needs to be fixed for elim rules
+; that have extra variables than the eliminable variable
+(defun partition-symbol-keys (alist B rest)
+  (declare (xargs :guard (alistp alist)))
+  (if (endp alist)
+      (mv rest B)
+    (if (symbolp (caar alist))
+        (partition-symbol-keys (cdr alist) (cons (list (caar alist) (cdar alist)) B)  rest)
+      (partition-symbol-keys (cdr alist) B (cons (cons (caar alist) (cdar alist)) rest)))))
+
+(defun get-elim-hyps-and-symbol-elided-var-bindings (rule elt)
+  (b* ((`(& ,elim-var ,lhs ,dest-sub-alst . &) elt)
+       (hyps (acl2::access acl2::elim-rule rule :hyps))
+       (hyps (if (and (consp hyps)
+                      (eq 'acl2::and (ffn-symb hyps)))
+                 (cdr hyps)
+               hyps))
+       ((mv dest-sub-alst symbol-elided-var-map) (partition-symbol-keys dest-sub-alst '() '()))
+       (hyps (subst-equal-alist dest-sub-alst hyps)))
+    (mv (subst lhs elim-var hyps) symbol-elided-var-map)))
+       
+
+(defun cts-wts-search-clause-elim (cl name mv-sig-alist 
+                                           ens hist avoid-vars 
+                                           eliminable type tc 
+                                           elim-elided-var-map
+                                           vl ctx wrld state)
+  (declare (xargs :stobjs (state) :mode :program))
+  (b* (((mv new-clause new-vars elim-seq-element rule)
+        (eliminate-destructors-clause1-cgen eliminable type cl avoid-vars ens wrld))
+       ((when (null new-vars)) 
+        (prog2$ 
+         (cw? (verbose-stats-flag vl)
+              "~|CEgen/Stats: Dest elim on (~x0 ~x1) failed~|" eliminable type)
+         (mv nil nil cl '() elim-elided-var-map state)))
+       (- (cw? (verbose-stats-flag vl)
+              "~|CEgen/Stats: Dest elim on (~x0 ~x1) successful~|" eliminable type))
+       ;(new-clause (car (last clauses)))
+       ((mv hyps concl) (clause-mv-hyps-concl new-clause))
+       (disabled (get-disabled-funs-elim-simp type tc wrld))
+       (?hints `(:in-theory (disable ,@disabled))) ;dont lose precious type information
+       ((mv elim-hyps symbol-elided-bindings) (get-elim-hyps-and-symbol-elided-var-bindings rule elim-seq-element))
+       
+   
+       
+       ((mv ?erpp shyps state) (simplify/throw-hyps-elim hyps elim-hyps hints vl state))
+       ;(hints `(("Goal" :in-theory (disable ,@record-conx ,@field-preds))))
+       ;((mv ?erpp shyps state) (acl2::simp-hyps hyps state hints t nil :term-order))
+       (s-new-clause (clausify-hyps-concl shyps concl))
+       (name (concatenate 'string name " dest elim on " (symbol-name  eliminable)))
+       (elim-elided-var-map (append elim-elided-var-map ;accumulate prev dest elim rounds
+                                    (get-dest-elim-replaced-terms (list elim-seq-element))
+                                    symbol-elided-bindings))
+       (- (cw? (debug-flag vl)
+               "~|CEgen/Debug: Proceeding to search for cts in dest-elimed form ~x0 ~ 
+with elide-map ~x1~|" 
+              (acl2::prettyify-clause new-clause nil wrld) 
+              elim-elided-var-map))
+       
+       ((mv erp stop? state)
+        (cts-wts-search-clause s-new-clause name mv-sig-alist
+                               ens hist elim-elided-var-map 
+                               vl ctx wrld state))
+       (new-eliminables-alst (new-eliminable-type-alist type tc new-vars elim-seq-element wrld)))
+    (mv erp stop? s-new-clause new-eliminables-alst elim-elided-var-map state)))
+  
+
+    
+; 29th june '13 - added on-demand elim support.
+(defun cts-wts-search-clause-elim-iter (cl name mv-sig-alist 
+                                           ens hist avoid-vars 
+                                           eliminables-alst elim-elided-var-map
+                                           vl ctx wrld state)
+  "iter on eliminables-alst, return (mv erp stop? state)"
+  (declare (xargs :stobjs (state) :mode :program))
+  (if (endp eliminables-alst)
+      (mv nil nil state) ;stop? = nil
+  
+    (b* (((mv erp stop? cl new-eliminables-alst elim-elided-var-map state) ;cl is the new (dest-elimed) clause to be tested
+          (cts-wts-search-clause-elim cl name mv-sig-alist 
+                                      ens hist avoid-vars 
+                                      (caar eliminables-alst) ;eliminable
+                                      (first (cdar eliminables-alst)) ;type
+                                      (second (cdar eliminables-alst)) ;tc
+                                      elim-elided-var-map
+                                      vl ctx wrld state))
+          ((when stop?) (mv erp stop? state));abort
+          (new-eliminables-alst (merge-sort-eliminables-alst new-eliminables-alst cl))
+          (eliminables-alst (if (null new-eliminables-alst)  ;dfs elim
+                                (cdr eliminables-alst) 
+; appending is fine, since these two lists will be disjoint! more importantly we maintain order!
+                              (append new-eliminables-alst (cdr eliminables-alst)))))
+      (cts-wts-search-clause-elim-iter cl name mv-sig-alist 
+                                       ens hist (union-eq (all-vars-lst cl) avoid-vars)
+                                       eliminables-alst elim-elided-var-map
+                                       vl ctx wrld state))))
+          
+
+;todo - order shud be important
+(defun initial-eliminable-type-alist (type-alist wrld ans)
+  (if (endp type-alist)
+      ans
+  (b* ((types-info-table (table-alist 'types-info-table wrld))
+       ((cons var types) (car type-alist))
+       ((unless (and (consp types) (null (cdr types)))) ; not supported
+        (initial-eliminable-type-alist (cdr type-alist) wrld ans))
+       (type (car types))
+       (entry (assoc-eq type types-info-table))
+       (tc (and (consp entry)
+                (acl2::access types-info% (cdr entry) :type-class))))
+    (if (member-equal tc '(record map))
+        (initial-eliminable-type-alist (cdr type-alist) wrld (acons var (list type tc) ans))
+      (initial-eliminable-type-alist (cdr type-alist) wrld ans)))))
+
+(defun cts-wts-search-clause-main (cl name mv-sig-alist 
+                                      ens hist abo? processor
+                                      vl ctx wrld state)
+   "main helper function for cgen in test-checkpoint. 
+it checks if on-demain dest elim needs to be done"
+  (declare (xargs :stobjs (state) :mode :program))
+  
+  (b* (((when abo?) (mv nil nil state))
+        ;; if subgoal is not equivalid, dont even test it.
+        
+       ((mv erp stop? state)  (cts-wts-search-clause cl name mv-sig-alist
+                               ens hist '() vl ctx wrld state))
+       ((when stop?) (mv erp stop? state))
+       ((unless (eq processor 'acl2::push-clause)) ;only in this last ditch attempt
+        (mv erp stop? state))
+       ((mv hyps ?concl) (clause-mv-hyps-concl cl))
+       (vars (all-vars-lst hyps))
+       ((mv erp0 trval state) 
+        (trans-eval `(dumb-type-alist-infer ',hyps ',vars ',vl ',wrld R$ types-ht$)
+                    ctx state t))
+       (dumb-type-alist (if erp0 '() (cdr trval)));ASSUMPTION: trans-eval will not error out
+       (initial-elim-alst (initial-eliminable-type-alist dumb-type-alist wrld '()))
+       (initial-elim-alst (merge-sort-eliminables-alst initial-elim-alst cl))
+       (- (cw? (and (verbose-flag vl)
+                    (consp initial-elim-alst))
+               "~|CEgen/Note: No luck, lets try record/map dest elim on ~x0 and search again ...~|"
+               initial-elim-alst))
+       (- (time-tracker :simplify-hyps-elim :end))
+       (- (time-tracker :simplify-hyps-elim :init
+                        :times '(2 7)
+                        :interval 5
+                        :msg "~|CEgen/Stats: Elapsed runtime in simplify/throw-hyps-elim is ~st secs;~|~%"))
+                      
+       )
+       
+       
+       
+    (if (null initial-elim-alst)
+        (mv erp stop? state) ;nothin to elim
+      
+      (b* (((mv erp stop? state) 
+            (cts-wts-search-clause-elim-iter cl name mv-sig-alist 
+                                             ens hist vars 
+                                             initial-elim-alst '()
+                                             vl ctx wrld state))
+           (- (and (verbose-stats-flag vl)
+                   (time-tracker :simplify-hyps-elim :print?))))
+        (mv erp stop? state)))))
+       
+    
+
+
+
+#|     
+(defthm obvious1 
+  (implies (and (pseudo-termp s)
+                (not (variablep s))
+                (not (fquotep s))
+                (not (consp (ffn-symb s))))
+           (symbolp (ffn-symb s))))
+      
+(defthm obvious2
+  (implies (and (symbolp a)
+                (symbol-listp l))
+           (symbol-listp (add-to-set-eq a l))))
+|#
+
+(mutual-recursion
+(defun all-functions. (term ans.)
+  "gather all functions in term"
+  (declare (xargs :verify-guards nil
+                  :guard (and (pseudo-termp term)
+                              (symbol-listp ans.))))
+  (if (variablep term)
+      ans.
+    (if (fquotep term)
+        ans.
+      (let ((fn (ffn-symb term))
+            (args (fargs term)))
+        (if (consp fn) ;lambda
+            (all-functions-lst. args ans.)
+          (all-functions-lst. args (add-to-set-eq fn ans.)))))))
+
+(defun all-functions-lst. (terms ans.)
+  (declare (xargs :verify-guards nil
+                  :guard (and (pseudo-term-listp terms)
+                              (symbol-listp ans.))))
+  (if (endp terms)
+      ans.
+    (all-functions-lst.
+     (cdr terms) 
+     (union-eq (all-functions. (car terms) ans.) 
+               ans.)))))
+#|      
+(defthm all-functions.-type
+  (implies (and (symbol-listp a)
+                (pseudo-termp term))
+           (symbol-listp (all-functions. term a)))
+  :hints (("Goal" :induct (all-functions. term a))))
+Why is ACL2 not good at this?
+|#
+
+;(verify-guards all-functions.)
+
+(defun all-functions (term)
+  (all-functions. term '()))
+
+(defun all-functions-lst (terms)
+  (all-functions-lst. terms'()))
+
+(verify-termination acl2::logical-namep)
+
+(defun all-functions-definedp-lst (fns wrld)
+  "are all the functions used in fns executable?"
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbol-listp fns)
+                              (plist-worldp wrld))))
+  (if (endp fns)
+      T
+    (and (acl2::logical-namep (car fns) wrld)
+         (all-functions-definedp-lst (cdr fns) wrld))))
+
+
+;; 21th March 2013
+;; CHeck for multiple valued functions and functions having
+;; stobjs in their arguments and return values.
+
+(defun unsupported-fns (fns wrld)
+  "gather functions that 
+1. take stobjs as args
+2. constrained (encapsulate) and no attachment"
+  (if (endp fns)
+      nil
+    (let* ((fn (car fns))
+           (constrainedp (acl2-getprop fn 'acl2::constrainedp wrld :default nil))
+           (att (acl2-getprop fn 'acl2::attachment wrld :default nil)))
+          
+      (if (or (or-list (acl2::stobjs-in fn wrld))
+              (and constrainedp
+                   (null att)))
+          (cons fn (unsupported-fns (cdr fns) wrld))
+        (unsupported-fns (cdr fns) wrld)))))
+  
+
+;; collect output signature arity of all multi-valued fns
+(defun mv-sig-alist (fns wrld)
+  "for each fn with output arity n>1, the result alist
+   will have an entry (fn . n)"
+  (declare (xargs :guard (and (symbol-listp fns)
+                              (plist-worldp wrld))))
+                                    
+  (if (endp fns)
+      nil
+    (let* ((fn (car fns))
+           (stobjs-out ;(acl2::stobjs-out fn wrld))) program mode
+            (acl2-getprop fn 'acl2::stobjs-out wrld :default '(nil))))
+      (if (and (consp stobjs-out)
+               (consp (cdr stobjs-out))) ;(mv * ...)
+          (acons fn (len stobjs-out)
+                 (mv-sig-alist (cdr fns) wrld))
+        (mv-sig-alist (cdr fns) wrld)))))
+
+
+
+; Catch restrictions, warn and skip testing/csearch
+(defun cgen-exceptional-functions (terms vl wrld) ;clause is a list of terms
+  "return (mv all-execp unsupportedp mv-sig-alist)"
+  (declare (xargs :verify-guards nil
+                  :guard (pseudo-term-listp terms)))
+  (b* ((fns (all-functions-lst terms))
+       (all-execp (all-functions-definedp-lst fns wrld))
+       (- (cw? (and (not all-execp) (verbose-flag vl))
+"~|CEgen Note: Skipping testing completely, since not all
+functions in this conjecture are defined.~%"))
+       (unsupportedp (consp (unsupported-fns fns wrld)))
+       (- (cw? (and unsupportedp (verbose-flag vl))
+"~|CEgen Note: Skipping testing completely, since some
+functions in this conjecture either take stobj arguments 
+or are constrained without an attachment.~%")))
+    (mv all-execp unsupportedp (mv-sig-alist fns wrld))))
+       
+         
+
+(defun update-gcs%-top-level-fields (term vl ctx state R$ types-ht$)
+  (declare (xargs :mode :program 
+                   :stobjs (state R$ types-ht$)))
+
+  (b* ((cse-stack (@ cgen-stats-event-stack))
+       ((when ;(acl2::function-symbolp 'inside-test? (w state))
+            (and (consp cse-stack)
+                 (consp (cdr cse-stack))
+; if the second item is an inside-test? entry, then the first one would
+; be a copy of it, and we better not initialize our own globals
+                 (assoc-keyword :inside-test? (cadr cse-stack))))
+        state);dont overwrite initial work by test? i.e "top" entry
+
+       ;; update 
+       (gcs% (get-gcs%-global))
+       (gcs% (change gcs% top-term term))
+; ACHTUNG - get-hyps only looks at outermost implies.
+       ((mv hyp concl) (mv (get-hyp term) (get-concl term)))
+       (hyps (if (eq hyp 't) '() (acl2::expand-assumptions-1 hyp)))
+       (vars (vars-in-dependency-order hyps concl vl (w state)))
+       (d-type-al (dumb-type-alist-infer
+                   (cons (dumb-negate-lit concl) hyps) vars 
+                   vl (w state) R$ types-ht$))
+       (gcs% (change gcs% top-vt-alist d-type-al))
+       (- (cw? (system-debug-flag vl)
+               "~|DEBUG: update-top : ~x0 dumb top vt-alist: ~x1 ~|"
+               term d-type-al))
+       (state (put-gcs%-global gcs%)) ;in top of cse-stack
+       )
+;   in 
+    state))
+
+        
+;; The following function implements a callback function (computed hint)
+;; which calls the counterexample generation testing code. Thus the
+;; the so called "automated" combination of testing and theorem proving
+;; is enabled naturally by the computed hints feature in the
+;; engineering design of ACL2 theorem prover.
+;; If somebody reads this comment, I would be very interested in any other
+;; theorem-provers having a call-back mechanism in their implementation.
+(defun acl2::test-checkpoint (id cl cl-list processor pspv hist ctx state)
+  (declare (xargs :stobjs (state)
+                  :mode :program))
+
+;;   (decl :sig ((symbol clause symbol any any state) -> (mv erp boolean state))
+;;         :mode :program
+;;         :doc
+;; "?:
+;; This function uses override hint + backtrack no-op hint combination.
+;;  On SUBGOALS 
+;; that are not checkpoints does no-op. On checkpoints it calls the 
+;; cts search procedure. Note that this (observer) hint combination
+;; means that when this callback function is called, that particular
+;; processor had a HIT and resulted in one or more subgoals, each of
+;;  which will fall on top of the waterfall like in a Escher drawing.
+;; ")
+; RETURN either (mv t nil state) or (mv nil nil state) 
+; PRECONDITION -
+; INVARIANT - no new prove call is made during the computation of this
+; function (this is very important, but now I can relax this invariant,
+; with the introduction of post and pre functions at event level)
+  (acl2::with-timeout1 
+   (acl2s-defaults :get subgoal-timeout)
+   (b* (
+;TODObug: test? defaults should be the one to be used
+       (vl (acl2s-defaults :get verbosity-level))
+       ((mv all-execp unsupportedp mv-sig-alist) 
+        (cgen-exceptional-functions cl vl (w state)))
+;27 June 2012 - Fixed bug, in CCG, some lemmas are non-executable, since they
+;involve calling the very function being defined. We should avoid testing
+;anything that is not executable.
+       ((unless all-execp)
+        (value nil))
+; 21st March 2013 - catch stobj taking and constrained functions, skip testing.
+       ((when unsupportedp)
+        (value nil))
+;5 Sep 2013 ;satisfies precondition of (get-gcs%-global) below this
+; occurs since, prove/test-checkpoint can be called from a non-event
+; such as bash. We wont test such prove calls. TODO: allow
+; test-checkpoint only for thm/defthm/test?.
+       ((unless (and (f-boundp-global 'cgen-stats-event-stack state)
+                     (valid-cgen-stats-event-stackp (@ cgen-stats-event-stack))))
+        (value nil))
+       
+     
+       (- (cw? (debug-flag vl)
+"test-checkpoint : id=~x0 processor=~x1 ctx= ~x2 ~ formula=~x3 hist-len=~x4~|" 
+id processor ctx (acl2::prettyify-clause cl nil (w state)) (len hist)))
+ 
+       ((unless (member-eq processor
+                           '(;acl2::preprocess-clause
+                             ;;acl2::simplify-clause
+                             acl2::settled-down-clause 
+                             acl2::eliminate-destructors-clause
+                             acl2::fertilize-clause
+                             acl2::generalize-clause
+                             acl2::eliminate-irrelevance-clause
+                             acl2::push-clause)))  
+; NOTE: I can also use (f-get-global 'checkpoint-processors state)
+        (value nil));ignore backtrack hint
+       
+       (name (acl2::string-for-tilde-@-clause-id-phrase id))
+       (wrld (w state))
+       (gcs% (get-gcs%-global))
+       (top-level-term (acl2::access acl2::prove-spec-var 
+                                     pspv :user-supplied-term))
+       ((mv & & state) ;ASSUMPTION: trans-eval wont error out
+        (if (equal (ffn-symb (access gcs% top-term))
+                   'dummy-topform)
+            (trans-eval `(update-gcs%-top-level-fields ',top-level-term ',vl ',ctx state R$ types-ht$)
+                        ctx state t)
+          (value nil)))
+       
+       (- (cw? (verbose-stats-flag vl)
+"~%~%~|CEgen/Note: At checkpoint ~x0 ~x1~|" name processor))
+       (ens (acl2::access acl2::rewrite-constant
+                          (acl2::access 
+                           acl2::prove-spec-var pspv :rewrite-constant)
+                          :current-enabled-structure))
+       (abo? (access gcs% all-bets-off?))
+       ((mv & stop? state) 
+        (cts-wts-search-clause-main cl name mv-sig-alist
+                                    ens hist abo? processor
+                                    vl ctx wrld state))
+       (gcs% (get-gcs%-global)) ;gcs% updated by the above csearch
+       
+;;; Jan 10th 2013 - Not printing at subgoal TODO
+       ;; ((er &) (if (and (> (access gcs% cts) 0)
+;; ;1. only print summary if there is a counterexample
+;; ;2. dont bother with test?, since test? does give a summary at the end
+;;                         (not (acl2::function-symbolp 'inside-test? (w state)))
+;;                         (acl2s-defaults :get acl2::acl2s-pts-subgoalp))
+;;                    (print-testing-summary-fn vl state)
+;;                  ;; else (assign print-summary-user-flag T)
+;;                  (value nil)))
+       
+; Assumption Jan 6th 2013 (check with Matt)
+; We only arrive here with processor P, if it was a hit i.e if P
+; is fertilize-clause then cross-fertilization was successful and
+; potentially the generalization was unsound.
+       (all-bets-off? (member-eq processor
+                                 '(acl2::fertilize-clause
+                                   acl2::generalize-clause
+                                   acl2::eliminate-irrelevance-clause)))
+ ; Monotonic change from nil to t, so its okay if we repeat it.                        
+       (gcs% (if all-bets-off?
+                 (prog2$ 
+                  (cw? (verbose-stats-flag vl) 
+                       "~| All bets off ... ~x0 in ~x1~%" name ctx)
+                  (change gcs% all-bets-off? t))
+               gcs%))
+; update gcs% in globals. so gcs% and global gcs% are in sync
+       (state (put-gcs%-global gcs%))
+       )
+   
+   
+;  in  
+   (if (or stop?
+           (and (> (access gcs% cts) 0)
+                (or (access gcs% all-bets-off?)
+                    (eq processor 'acl2::push-clause))))
+; jan 6th 2013
+; why bother continuing with a generalized (possibly unsound) subgoal
+; or an induction when we already have found a counterexample.
+; simply abort!
+
+;Note: On abort, we *always* print the summary unless its a test? form!
+       (er-progn
+        (if (let ((cse-stack (@ cgen-stats-event-stack)))
+              (and (consp cse-stack)
+                   (consp (cdr cse-stack))
+                   (assoc-keyword :inside-test? (cadr cse-stack))))
+            ;(acl2::function-symbolp 'inside-test? (w state))
+            (value nil)
+; Lets update the global end time before printing. 18th March 2013
+; Note: end-time is not updated in case of no abort. But
+; thats fine, since the user has no way of asking cgen
+; to print testing summary after returning from a thm/test?. 
+          (b* (((mv end state) (acl2::read-run-time state))
+               (gcs%  (get-gcs%-global))
+               (gcs%  (change gcs% end-time end))
+               (state (put-gcs%-global gcs%)))
+            (print-testing-summary-fn vl state)))
+        (mv t nil state))
+
+; Check for false generalizations. TODO also do the same for
+; cross-fertilization and eliminate-irrelevance if its worth the trouble
+     (if (equal processor 'acl2::generalize-clause)
+         ;NOTE: this pspv is for the cl not for cl-list, so there
+         ;might be some inconsistency or wierdness here
+         (b* ((gen-cl (car cl-list))
+              (ens (acl2::ens state)) ;get current ens, not parent's.
+; 2nd April 2013 - the pspv and hist passed are the parent's (CHECK)
+              (type-alist (get-acl2-type-alist gen-cl name ens vl state))
+              ((mv H C) (clause-mv-hyps-concl gen-cl))
+              (vars (vars-in-dependency-order H C vl wrld))
+
+;TODO.now- check the type of vt-alist.
+              (vt-alist (pairlis$ vars (make-list (len vars)
+                                                  :initial-element 
+                                                  (list 'ACL2::ALL))))
+              (term (if (null H)
+                        C
+                        `(implies (and ,@H) ,C)))
+; the above is not really a term, but almost, we can assume AND is a function.
+; hopefully it will not affect any computation based on it, certainly will
+; not affect all-vars. CHECK! 20th March 2013
+
+              ((mv & & mv-sig-alist)
+; 21st March 2013 - Safe to assume that restricted funs will be caught
+; higher up in the waterfall.
+               (cgen-exceptional-functions gen-cl vl (w state)))
+              (tau-interval-alist (tau-interval-alist-clause gen-cl name ens vl wrld state))
+              ((mv erp (list & run-hist% &) state)
+               (cts-wts-search name H C vars
+                           type-alist tau-interval-alist mv-sig-alist NIL
+                           (acl2s-defaults-alist) 
+                           *initial-run-hist%* 
+; we dont care about witnesses and the start time and do no accumulation.
+                           (initial-gcs% 1 0 0 term vt-alist)
+                           ctx wrld state))
+              (num-cts-found (access run-hist% |#cts|)))
+          (value (if (and (not erp)
+                          (> num-cts-found 0))
+                     (progn$ 
+                      (cw? (normal-output-flag vl) "~| Generalized subgoal: ~x0~|" 
+                           (acl2::prettyify-clause gen-cl nil (w state)))
+                      (cw? (normal-output-flag vl)
+                           "~| Counterexample found: ~x0 ~|"
+                           (car (access run-hist% cts)))
+                      (cw? (normal-output-flag vl) "~| Backtracking...~|")
+                      '(:do-not '(acl2::generalize)
+                                :no-thanks t))
+                   nil)))
+;ignore errors in cts search function
+       (value nil))))
+   (prog2$
+    (cw? (normal-output-flag (acl2s-defaults :get verbosity-level))
+         "~| Subgoal counterexample search TIMED OUT!~%")
+    (value nil))
+   ))
+
+
+
+
+
+;Dont print the "Thanks" message:
+(defmacro dont-print-thanks-message-override-hint ()
+`(make-event  
+  '(acl2::add-override-hints 
+    '((cond ((or (null acl2::keyword-alist)
+                 (assoc-keyword :no-thanks acl2::keyword-alist))
+             acl2::keyword-alist)
+            (t
+             (append '(:no-thanks t) acl2::keyword-alist)))))))
+       
+
+
+
+
+     
+;Note on xdoc: <= or < cannot be used inside defxdoc!!
+
+(def test?-fn (form hints override-defaults dont-pts? ctx wrld state R$ types-ht$)
+; Jan 9th 2013, dont print summary unless there was a counterexample.
+  (decl :mode :program
+        :sig ((any true-list symbol-alist symbol plist-world state R$ types-ht$) 
+              -> (mv erp any state))
+        :doc "gives an error triple wrapping a form that will be ... ")
+  (f* ((check-syntax   (form logicp) 
+                       (acl2::state-global-let*
+                        ((acl2::inhibit-output-lst acl2::*valid-output-names*))
+                        (acl2::translate form  T logicp T 
+                                         "test? check" 
+                                         wrld state))))
+   (b* ((defaults (acl2s-defaults-alist override-defaults))
+        (testing-enabled (get-acl2s-default 'testing-enabled defaults))
+        (vl              (get-acl2s-default 'verbosity-level defaults))
+        ((when (eq testing-enabled NIL)) ;dont do any testing
+         (value '(value-triple :invisible))))
+    
+     (b* (((mv erp term state) (check-syntax form NIL))
+          ((when erp)          
+           (prog2$
+            (cw? (normal-output-flag vl) 
+                 "~|TEST?: The input form is ill-formed, see below:~%")
+;show error to user which was invisble earlier
+            (acl2::state-global-let*
+             ((acl2::inhibit-output-lst '(summary)))
+             (acl2::translate form  T NIL T 
+                              "test? check" 
+                              (w state) state))))
+
+          ((mv all-execp unsupportedp mv-sig-alist) 
+           (cgen-exceptional-functions (list term) vl (w state)))
+; 21st March 2013 - catch stobj taking and constrained functions, skip testing.
+          ((unless all-execp)  (value '(value-triple :invisible))) ;possible with test? ?
+          ((when unsupportedp) (value '(value-triple :invisible)))
+
+          
+          
+; No syntax error in input form, check for program-mode fns
+; Note: translate gives nil as the term if form has
+; a program-mode function, so we ignore it
+          ((mv pm? & state)    (check-syntax form T))
+          (programp            (or pm?
+                                   (eq (default-defun-mode (w state)) 
+                                       :program)))
+
+          (- (cw? (debug-flag vl)
+                  "~%~%CEgen/Debug: (pm? ~x0) ~x1~|" programp (cons 'test? form))) 
+
+          ((mv hyps concl state) (partition-hyps-concl term "test?" state))
+; initialize these per test?/thm/defthm globals that store information
+; across subgoals in a single thm event
+          ((mv start-top state) (acl2::read-run-time state))
+          
+          (cse-stack (@ cgen-stats-event-stack))
+          ((unless (cgen-stats-event-stackp cse-stack)) ;can be empty
+           (er soft ctx "~|CEgen/Error: cgen-stats-event-stack is ill-formed~|"))
+          (vars (all-vars term))
+          (d-type-al (dumb-type-alist-infer 
+                      (cons (dumb-negate-lit concl) hyps)
+                      vars vl (w state) R$ types-ht$))
+          (- (cw? (verbose-stats-flag vl) 
+                 "~|CEgen/Verbose/test?: dumb type-alist is ~x0~|" d-type-al))
+          (gcs%  (initial-gcs% 
+                  (get-acl2s-default 'num-counterexamples defaults)
+                  (get-acl2s-default 'num-witnesses defaults)
+                  start-top term d-type-al))
+; PUSH an entry March 7th 2013
+; I need to make sure, that I pop this at all exit points from now on.
+          (state (f-put-global 'cgen-stats-event-stack 
+                               (cons (list :gcs% gcs%
+                                           :s-hist '()
+                                           :inside-test? t) ;distinguishes a test? entry 
+                                     cse-stack)
+                               state))
+          
+          (vt-acl2-alst (if programp 
+                            (pairlis$ vars (make-list (len vars)
+                                                      :initial-element 
+                                                      (list 'ACL2::ALL)))
+                          (get-acl2-type-alist (list term) "top" 
+                                               (acl2::ens state) vl state)))
+             
+          ((mv & tau-interval-alist state) (get-tau-interval-alist term "top" vl state))
+          ((mv ?error-or-timeoutp ?stop? state) 
+           (csearch-with-timeout "top" hyps concl 
+                                 vt-acl2-alst tau-interval-alist 
+                                 mv-sig-alist '() 
+                                 programp defaults ctx wrld state))
+          
+; dont take theorem prover's help if 
+; 1. csearch errored out or timed out (TODO why not? 19 July '13)
+; 2. stopping condition has already been reached
+; 3. form contains a program-mode function or we are in program mode
+; 4. testing is set to :naive
+          (no-thm-help?  (or ;error-or-timeoutp ;19 July '13
+                             stop?
+                             programp
+                             (eq testing-enabled :naive)))
+
+; TODO: print something if erp is true i.e error in testing
+          
+; Else call ACL2 prover with a hint
+; that does random testing on every checkpoint.
+          (- (cw? (debug-flag vl) "~|CEgen/Debug: thm+testing OFF: ~x0~%" no-thm-help?))
+          
+          ((mv trans-erp thm-erp state) ;2 July '13 (bug: hard error reported as proof without induction)
+           (if no-thm-help? 
+               (mv nil t state) ;TODO: I am throwing information here!
+             (mv-let 
+              (erp trval state)
+              (acl2::state-global-let*
+               ((acl2::inhibit-output-lst 
+                 (if (system-debug-flag vl)
+                     '(summary)
+                   '(warning warning! observation prove
+                             proof-checker event expansion
+                             proof-tree summary))))
+               (trans-eval `(acl2::thm-fn ',form state
+                                         (or ',hints 
+;user-specified hints override default hints
+                                             '(("Goal"
+                                                :do-not-induct t 
+                                                :do-not '(acl2::generalize 
+                                                          acl2::fertilize))))
+;TODO: Matt's code doesnt work through induction and forcing rds
+;Also the OTF flag is set to true, to test all initial subgoals. 
+                                         t nil) 
+                          'test?-fn state T))
+              (prog2$
+               (cw? (and erp (normal-output-flag vl))
+                    "~|CEgen/Error: bad trans-eval call in test?-fn~|")
+               (mv erp (if erp t (cadr trval)) state)))))
+
+          
+; TODO: errors in print functions will abort the whole form
+          ((mv end state) (acl2::read-run-time state))
+          (gcs%  (get-gcs%-global))
+          (gcs%  (change gcs% end-time end))
+          (state (put-gcs%-global gcs%))
+          ((er &) (if (or error-or-timeoutp 
+                          trans-erp
+                          (and (<= (access gcs% cts) 0)
+                               dont-pts?))
+;no point in printing if error or timeout OR we specifically ask not
+;to print the testing summary here if no cts was found.  Sep 3rd 2012 -- modified Jan 9th 2013
+                      (value nil)
+                    (print-testing-summary-fn vl state)))
+
+          
+          ((mv cts-found? state)      
+; If testing found a counterexample, print so and abort.
+           (b* ((gcs% (get-gcs%-global))
+                (num-cts (access gcs% cts)))
+             (cond ((posp num-cts) (prog2$
+                                    (cw? (normal-output-flag vl)
+                                         "~%Test? found a counterexample.~%")
+                                    (mv T state)))
+                   (trans-erp (prog2$
+                               (cw? (normal-output-flag vl)
+                                    "~|CEgen/Note: test? did not work (probably due to a hard error)!~%")
+                               (mv nil state)))
+;Success means the prover actually proved the conjecture under consideration
+                   ((not thm-erp) (prog2$
+                                   (cw? (normal-output-flag vl)
+                                        "~%Test? proved the conjecture under consideration (without induction). ~
+ Therefore, no counterexamples exist. ~%")
+                                   (mv NIL state)))
+; either thm failed, or we didnt call thm. Either way if we didnt find a cts
+; then we say the test? succeeded!
+                   (thm-erp (prog2$
+                             (cw? (normal-output-flag vl)
+                                  "~%Test? succeeded. No counterexamples were found.~%")
+                             (mv NIL state)))
+
+                   (t (prog2$
+                       (cw? (normal-output-flag vl)
+                            "~|CEgen/Error: test?-fn: unreachable print option! Please report this to ACL2s maintainer.~%")
+                       (mv NIL state))))))
+
+; pop the cse-stack
+          (cse-stack (@ cgen-stats-event-stack))
+          (- (assert$ (valid-cgen-stats-event-stackp cse-stack) 'test?-fn))
+          (state (f-put-global 'cgen-stats-event-stack (cdr cse-stack) state)))
+
+      
+      (mv cts-found? '(value-triple :invisible) state )))))
+
+(defdoc test?
+  ":Doc-Section ACL2::TESTING
+
+  Random testing using the ACL2 prover,
+  generating counterexamples to top-level conjecture.~/
+
+  ~bv[]
+  Examples:
+  (test? (implies (and (posp (car x))
+                     (posp (cdr x)))
+                (= (cdr x) (len x))))
+  
+  (test? (equal (reverse (reverse x)) x))
+  
+  Usage:
+  (test? form :hints hints :override-defaults my-params)
+
+  ~ev[]
+  ~/
+  
+  ~t[test?] is a powerful random testing facility intended
+  to be used to increase confidence in the truth of a conjecture by
+  providing extensive testing in cases where there is not enough time
+  or resources for formal proofs.
+  
+  ~t[test?] combines random testing with the power of ACL2 and
+  our data definition framework. It guarantees than any
+  counterexamples generated are truly counterexamples to the original
+  conjecture. A counterexample is just a binding that maps the
+  variables in the original conjecture to values in the ACL2
+  universe. In cases where the value of variables are irrelevant, we
+  bind the variables to the symbol ~t[?] : these bindings still
+  provide counterexamples, but should raise alarms, since chances are
+  that there is a specification error.
+  
+  If no counterexample is found, there are three possibilities. First,
+  it is possible that the conjecture is false, in which case increasing
+  the amount of testing we do may lead to the discovery of a
+  counterexample.  Second, it is also possible that ACL2 proves that
+  the conjecture is true, in which case we print a message reporting
+  success.  Finally, the conjecture may be true, but ACL2 cannot prove
+  it.  For all of these three cases, we consider testing to have
+  succeeded, so ~t[test?] will report success.
+  
+  We note that in order to be able to generate counterexamples, we do
+  not allow ACL2 to use any of the following processes: induction,
+  generalization, and cross-fertilization. We do allow destructor-
+  elimination, though in rare cases, user defined elim rules may
+  generalize the conjecture. Such situations are recognized.  If you
+  want to enable the above processes, use ~t[thm] instead, but
+  note that counterexamples shown might not be of the top-level conjecture.
+
+    
+  ~bv[]
+  Examples:
+  (test? (implies (and (posp (car x))
+                     (posp (cdr x)))
+                (= (cdr x) (len x))))
+  
+  (test? (equal (reverse (reverse x)) x))
+
+  ~ev[]
+ 
+  Note is both these examples, counterexamples are generated for the
+  original goal, in case some variables are elided away(like y and by
+  equality z), we show ~t[?] as their instantiated values.
+
+  ~bv[]
+  (test? (implies (and (posp (car x))
+                     (equal y y)
+                     (equal z y)
+                     (posp (cdr x)))
+                (= (cdr x) (len x))))
+  
+  ~ev[]
+  "
+ )
+
+
+;; (defun print-summary-user-testing (state)
+;;   (declare (xargs :stobjs state))
+
+;;   (and 
+;;        (b* ((ctx 'print-summary-user)
+;;             ((unless (and (f-boundp-global 'print-summary-user-flag state)
+;;                           (@ print-summary-user-flag)))
+;;              nil)
+;;             (?er-str "~|BAD global-coverage-stats. ~
+;; Please report to ACL2s maintainer the context in which this happened!~|")
+;;             ((unless (f-boundp-global 'gcs% state))
+;;              nil)
+;;             (gcs% (get-gcs%-global))
+;;             ((unless (gcs%-p gcs%))
+;;              nil)
+;;             (num-wts (access gcs% wts))
+;;             (num-cts (access gcs% cts))
+;;             (vl 1) ;TODO
+;;             (- (cw? (normal-output-flag vl)
+;;                     "~|ACL2s found ~x0 counterexamples and ~x1 witnesses. ~
+;; To print the testing summary, do :pts~|"
+;;                     num-cts num-wts))
+;;             )
+;;         nil)))
+
+(defun initialize-event-user-cgen (ctx body state)
+  (declare (xargs :mode :logic 
+                  :stobjs state
+                  :verify-guards nil))
+  (declare (ignorable ctx body))
+  (b* (((unless (f-boundp-global 'cgen-stats-event-stack state))
+        state) ;ignore
+       (cse-stack (@ cgen-stats-event-stack))
+       (- (assert$ (cgen-stats-event-stackp cse-stack) 'initialize-event-user-cgen))
+       ((mv start state) (acl2::read-run-time state))
+       (init-gcs% (initial-gcs% (acl2s-defaults :get num-counterexamples)
+                                (acl2s-defaults :get num-witnesses)
+;dummy topform will replaced by the actual top-level form in
+;test-checkpoint where this information is obtained from pspv
+                                start '(dummy-topform dummy) '()))
+       
+       (vl (acl2s-defaults :get verbosity-level))
+
+; if the top entry is by a test?, then copy its
+; contents into the new entry to be pushed into stack
+       ((mv gcs% s-hist)
+        (if (and (consp cse-stack)
+                 (assoc-keyword :inside-test? (car cse-stack)))
+            (b* ((v (car cse-stack))
+                 (- (cw? (system-debug-flag vl)
+               "~|CEgen/Sysdebug: Pushing entry into cgen-stats-event-stack, ~
+but also copying the test? event stats into the new entry ~%")))
+              (mv (cadr (assoc-keyword :gcs% v)) (cadr (assoc-keyword :s-hist v))))
+          (prog2$
+           (cw? (system-debug-flag vl)
+                "~|CEgen/Sysdebug: Pushing entry into cgen-stats-event-stack ~%")
+           (mv init-gcs% '())))))
+       
+
+       (f-put-global 'cgen-stats-event-stack 
+                     (cons (list :gcs% gcs% :s-hist s-hist) cse-stack)
+                     state)))
+  
+(defun initialize-event-user-cgen-gv (ctx body state)
+  (declare (xargs :mode :logic 
+                  :stobjs state
+                  :guard T))
+  (ec-call (initialize-event-user-cgen ctx body state)))
+  
+                                          
+
+(defun finalize-event-user-cgen (ctx body state)
+  (declare (xargs :mode :logic :verify-guards nil :stobjs state))
+  (declare (ignore ctx body))
+  (b* (((unless (f-boundp-global 'cgen-stats-event-stack state))
+        state) ;ignore
+       (cse-stack (@ cgen-stats-event-stack))
+       ((unless (valid-cgen-stats-event-stackp cse-stack))
+; Design decision - Lets fix a bad stack here, without complaining.
+        (f-put-global 'cgen-stats-event-stack nil state))
+       (vl (acl2s-defaults :get verbosity-level))
+       
+       
+       (rest-stack (cdr cse-stack))
+
+; Fixed bug: There is a symmetry in initialize-event and finalize-event, that
+; was ignored by me, and hence the bug. Specifically, the cts and wts collected
+; inside thm-fn event are being thrown away, but test? needs to print these. So
+; just like in initialize-event we copy contents of test? entry into the new
+; entry, we need to copy the top entry into the test? entry, preserving the
+; symmetry that these functions ought to keep.
+; March 14th 2013.
+       (state (if (and (consp rest-stack)
+; NOTE: guards are really nice, it below caught the error, where i was
+; directly searching in rest-stack instead of car of it.
+                       (assoc-keyword :inside-test? (car rest-stack)))
+                  ;; copy
+                  (b* ((v (car cse-stack))
+                       ((mv gcs% s-hist)
+                        (mv (cadr (assoc-keyword :gcs% v)) (cadr (assoc-keyword :s-hist v))))
+                       (rest-stack~ (cons (list :gcs% gcs% 
+                                                :s-hist s-hist
+                                                :inside-test? t)
+                                          (cdr rest-stack)))
+                       (- (cw? (system-debug-flag vl)
+            "~|CEgen/Sysdebug: Popping entry in cgen-stats-event-stack, ~
+but copying its contents into the test? stats entry ~%")))
+                    (f-put-global 'cgen-stats-event-stack
+                                  rest-stack~ state))
+                (prog2$
+                 (cw? (system-debug-flag vl)
+            "~|CEgen/Sysdebug: Popping entry in cgen-stats-event-stack ~%")
+                (f-put-global 'cgen-stats-event-stack rest-stack state)))))
+           
+    (prog2$ 
+; (print-summary-user-testing state)
+     nil ; TODO add regression statistics code here
+     state)))
+
+(defun finalize-event-user-cgen-gv (ctx body state)
+  (declare (xargs :mode :logic 
+                  :guard T
+                  :stobjs state))
+  (ec-call (finalize-event-user-cgen ctx body state)))
+
+(defattach (acl2::initialize-event-user
+            initialize-event-user-cgen-gv))
+
+(defattach (acl2::finalize-event-user
+            finalize-event-user-cgen-gv))
+
+
+
+(defmacro test? (form &key hints override-defaults dont-print-summary)
+  (let* ((vl (get-acl2s-default 'verbosity-level 
+                                override-defaults))
+         (debug (and (natp vl)
+                     (system-debug-flag vl))))
+    `(with-output
+      :stack :push
+      ,(if debug :on :off) :all
+      :gag-mode ,(not debug)
+     (make-event
+      (test?-fn ',form ',hints 
+                ',override-defaults ',dont-print-summary
+                'test? (w state) state R$ types-ht$)))))
+
+   
+;Lets start with the canonical rev-rev example!
+;Does Reverse of Reverse give back the original.Is it a Theorem?
+;; (trace$ cts-wts-search)
+
+;; (include-book "acl2s-parameter")
+;; (acl2s-defaults :set verbosity-level 5)
+;; (acl2s-defaults :set acl2::testing-enabled t)
+;; (defttag t)
+;; (defthm ok (equal (rev (rev x)) x))
+
+;; (test? (equal (rev (rev x)) x) :override-defaults ((testing-enabled . T)))
+
+;;  USAGE and EXAMPLES
+;; (set-acl2s-random-testing-enabled t)
+
+;; ;no slow array warning if inline-book base, but gives warning otherwise(FIXED)
+;; (union-vt-and '((x pos nat) (y all))
+;;               '((x rational) (y symbol boolean))
+;;               (w state))
+
+
+;; ;TODO:limit test runs when all cases are exhausted for finite data values
+;; (test?
+;;  (implies (and (booleanp a) 
+;;                (booleanp b))
+;;           (equal (implies a b) (or (not a) b)))
+
+
+;; TODO: 
+;; 1. union-find algo in per variable counterexample store,
+;;    increasing probability of finding countereg.
+;; 2. a proof obligation testing type consistency is missing in register-type
+;; 3. what about intersection (and) of types/acl2-subsets?
+;; 5. Registered constructors - check if destructor arguments are
+;;     subtypes of dex-prex.
+;; 6. IMP: Analyse efficiency of union-vt-and, see if it can be faster,
+;;     although it shudnt matter as num of free-vars is normally small!
diff -Nru acl2-6.2/books/cgen/mv-proof.lisp acl2-6.3/books/cgen/mv-proof.lisp
--- acl2-6.2/books/cgen/mv-proof.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/mv-proof.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,34 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(begin-book t);$ACL2s-Preamble$|#
+
+(in-package "DEFDATA")
+
+(defun my-mv-nth (n v)
+  (declare (xargs :guard nil))
+  (if (zp n)
+    (car v)
+    (my-mv-nth (- n 1) (cdr v))))
+
+(defthm my-mv-nth--nil
+  (equal (my-mv-nth x nil)
+         nil))
+
+(defthm my-mv-nth--reduce1
+  (implies (and (syntaxp (integerp n))
+                (integerp n)
+                (< 0 n))
+           (equal (my-mv-nth n v)
+                  (my-mv-nth (- n 1) (cdr v)))))
+
+(defthm my-mv-nth--reduce2
+  (implies (or (not (integerp n))
+               (<= n 0))
+           (equal (my-mv-nth n v)
+                  (car v))))
+
+; not by default
+(defthmd mv-nth--to--my-mv-nth
+  (equal (mv-nth x y)
+         (my-mv-nth x y)))#|ACL2s-ToDo-Line|#
diff -Nru acl2-6.2/books/cgen/num-list-fns.lisp acl2-6.3/books/cgen/num-list-fns.lisp
--- acl2-6.2/books/cgen/num-list-fns.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/num-list-fns.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,178 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book);$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+
+(set-verify-guards-eagerness 2)
+
+
+(defun 2+-listp (x)
+  (if (atom x)
+    (null x)
+    (and (integerp (car x))
+         (<= 2 (car x))
+         (2+-listp (cdr x)))))
+
+; already in program mode:
+(DEFUN POS-LISTP (acl2::L)
+   (declare (xargs :guard t))
+  (COND ((ATOM acl2::L) (EQ acl2::L NIL))
+        (T (AND (POSP (CAR acl2::L))
+                (POS-LISTP (CDR acl2::L))))))
+
+
+(defthm 2+-listp-forward-to-pos-listp
+  (implies (2+-listp x)
+           (pos-listp x))
+  :rule-classes :forward-chaining)
+
+(defun naturals-listp (x)
+   (declare (xargs :guard t))
+  (if (atom x)
+    (null x)
+    (and (natp (car x))
+         (naturals-listp (cdr x)))))
+
+(defthm pos-listp-forward-to-naturals-listp
+  (implies (pos-listp x)
+           (naturals-listp x))
+  :rule-classes :forward-chaining)
+
+(defthm naturals-listp-forward-to-integer-listp
+  (implies (naturals-listp x)
+           (integer-listp x))
+  :rule-classes :forward-chaining)
+
+#| ; redundant
+(defthm integer-listp-forward-to-rational-listp
+  (implies (integer-listp x)
+           (rational-listp x))
+  :rule-classes :forward-chaining)
+|#
+
+; The definition of acl2-number-listp that was here has been omitted 12/4/2012
+; by Matt K., since it is now included in ACL2.
+
+(defthm rational-listp-forward-to-acl2-number-listp
+  (implies (rational-listp x)
+           (acl2-number-listp x))
+  :rule-classes :forward-chaining)
+
+(defthm acl2-number-listp-forward-to-true-listp
+  (implies (rational-listp x)
+           (acl2-number-listp x))
+  :rule-classes :forward-chaining)
+
+
+
+(defun sum-list (l)
+  (declare (xargs :guard (acl2-number-listp l)))
+  (if (endp l)
+    0
+    (+ (car l) (sum-list (cdr l)))))
+
+(defun product-list (l)
+  (declare (xargs :guard (acl2-number-listp l)))
+  (if (endp l)
+    1
+    (* (car l) (product-list (cdr l)))))
+
+(defun max-nat-list (l)
+  (declare (xargs :guard (rational-listp l)))
+  (if (endp l)
+    0
+    (max (car l)
+         (max-nat-list (cdr l)))))
+
+(defun scale (l x)
+  (declare (xargs :guard (and (acl2-number-listp l)
+                              (acl2-numberp x))))
+  (if (endp l)
+    nil
+    (cons (* (car l) x)
+          (scale (cdr l) x))))
+
+(defun shift (l x)
+  (declare (xargs :guard (and (acl2-number-listp l)
+                              (acl2-numberp x))))
+  (if (endp l)
+    nil
+    (cons (+ (car l) x)
+          (shift (cdr l) x))))
+
+#|
+(defun pow (l x)
+  (declare (xargs :guard (and (acl2-number-listp l)
+                              (natp x))))
+  (if (endp l)
+    nil
+    (cons (expt (car l) x)
+          (pow (cdr l) x))))
+|#
+
+(defun list-expt (base l)
+  (declare (xargs :guard (and (acl2-numberp base)
+                              (naturals-listp l))))
+  (if (endp l)
+    nil
+    (cons (expt base (car l))
+          (list-expt base (cdr l)))))
+
+(defun <=-lists (l1 l2)
+  (declare (xargs :guard (and (rational-listp l1)
+                              (rational-listp l2)
+                              (= (len l1) (len l2)))))
+  (if (mbe :logic (or (endp l1) (endp l2))
+           :exec (endp l1))
+    (mbe :logic (and (endp l1) (endp l2))
+         :exec t)
+    (and (<= (car l1) (car l2))
+         (<=-lists (cdr l1) (cdr l2)))))
+
+(defun all-<= (l v)
+  (declare (xargs :guard (and (rationalp v)
+                              (rational-listp l))))
+  (if (endp l)
+    t
+    (and (<= (car l) v)
+         (all-<= (cdr l) v))))
+
+(defun *-lists (l1 l2)
+  (declare (xargs :guard (and (rational-listp l1)
+                              (rational-listp l2)
+                              (= (len l1) (len l2)))))
+  (if (mbe :logic (or (endp l1) (endp l2))
+           :exec (endp l1))
+    nil
+    (cons (* (car l1) (car l2))
+          (*-lists (cdr l1) (cdr l2)))))
+
+(defun +-lists (l1 l2)
+  (declare (xargs :guard (and (rational-listp l1)
+                              (rational-listp l2)
+                              (= (len l1) (len l2)))))
+  (if (mbe :logic (or (endp l1) (endp l2))
+           :exec (endp l1))
+    nil
+    (cons (+ (car l1) (car l2))
+          (+-lists (cdr l1) (cdr l2)))))
+
+(defun make-list-logic (e size)
+  (declare (xargs :guard nil))
+  (if (zp size)
+    nil
+    (cons e
+          (make-list-logic e (- size 1)))))
+
+(defun pfix (x)
+  (if (posp x) x 1))
+
+(defun pos-list-fix (x)
+  (if (atom x)
+    nil
+    (cons (pfix (car x))
+          (pos-list-fix (cdr x)))))#|ACL2s-ToDo-Line|#
+
diff -Nru acl2-6.2/books/cgen/num-list-thms.lisp acl2-6.3/books/cgen/num-list-thms.lisp
--- acl2-6.2/books/cgen/num-list-thms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/num-list-thms.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,484 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book);$ACL2s-Preamble$|#
+
+(in-package "DEFDATA")
+
+(include-book "num-list-fns" :load-compiled-file :comp)
+
+(defthm pos-list--first
+  (implies (and (pos-listp l)
+                (consp l))
+           (< 0 (car l)))
+  :rule-classes (:linear :rewrite))
+
+(defthm sum-list-poses-type
+  (implies (and (pos-listp l)
+                (consp l))
+           (< 0 (sum-list l)))
+  :rule-classes (:linear :rewrite))
+
+(defthm sum-list-nats-type
+  (implies (naturals-listp l)
+           (<= 0 (sum-list l)))
+  :rule-classes (:linear :rewrite))
+
+(defthm sum-list-integers-type
+  (implies (integer-listp l)
+           (integerp (sum-list l)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm sum-list-rationals-type
+  (implies (rational-listp l)
+           (rationalp (sum-list l)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm sum-list>=element
+  (implies (and (naturals-listp l)
+                (consp l))
+           (>= (sum-list l) (car l)))
+  :rule-classes (:rewrite :linear))
+
+(defthm sum-list--append
+  (equal (sum-list (append x y))
+         (+ (sum-list x) (sum-list y))))
+
+
+(encapsulate nil
+  (local (include-book "arithmetic-5/top" :dir :system))
+
+  (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
+                               acl2::STABLE-UNDER-SIMPLIFICATIONP
+                               acl2::HIST 
+                               acl2::PSPV))))
+  
+  (defthm product-list-poses-type
+    (implies (pos-listp l)
+             (< 0 (product-list l)))
+    :rule-classes (:linear :rewrite))
+  
+  (defthm product-list-nats-type
+    (implies (naturals-listp l)
+             (<= 0 (product-list l)))
+    :rule-classes (:linear :rewrite))
+  
+  (defthm product-list-integers-type
+    (implies (integer-listp l)
+             (integerp (product-list l)))
+    :rule-classes (:rewrite :type-prescription))
+  
+  (defthm product-list-rationals-type
+    (implies (rational-listp l)
+             (rationalp (product-list l)))
+    :rule-classes (:rewrite :type-prescription))
+  
+  (defthm product-list>=element
+    (implies (and (pos-listp l)
+                  (consp l))
+             (>= (product-list l) (car l)))
+    :rule-classes (:rewrite :linear))
+
+  (defthm product-list--append
+    (equal (product-list (append x y))
+           (* (product-list x) (product-list y)))))
+
+
+(defthm max-nat-list<=sum-list
+  (implies (naturals-listp l)
+           (<= (max-nat-list l) (sum-list l)))
+  :rule-classes (:linear :rewrite))
+
+(defthm max-nat-list>=element
+  (implies (and (naturals-listp l)
+                (consp l))
+           (>= (max-nat-list l) (car l)))
+  :rule-classes (:linear :rewrite))
+
+(defthm max-nat-list--naturals-listp
+  (implies (naturals-listp l)
+           (integerp (max-nat-list l)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm max-nat-list--naturals-listp2
+  (implies (naturals-listp l)
+           (<= 0 (max-nat-list l)))
+  :rule-classes (:linear :rewrite))
+
+
+
+(defthm len=0--not-consp
+  (implies (equal (len x) 0)
+           (not (consp x))))
+
+
+(defthm scale--pos-list
+  (implies (and (pos-listp l)
+                (integerp x)
+                (< 0 x))
+           (pos-listp (scale l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm scale--nat-list
+  (implies (and (naturals-listp l)
+                (integerp x)
+                (<= 0 x))
+           (naturals-listp (scale l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm scale--integer-list
+  (implies (and (integer-listp l)
+                (integerp x))
+           (integer-listp (scale l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm scale--rational-list
+  (implies (and (rational-listp l)
+                (rationalp x))
+           (rational-listp (scale l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm scale--number-list
+  (implies (and (acl2-number-listp l)
+                (acl2-numberp x))
+           (acl2-number-listp (scale l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm scale--consp
+  (implies (consp l)
+           (consp (scale l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm scale--len
+  (equal (len (scale l x))
+         (len l)))
+
+
+(defthm shift--pos-list
+  (implies (and (pos-listp l)
+                (integerp x)
+                (< 0 x))
+           (pos-listp (shift l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm shift--nat-list
+  (implies (and (naturals-listp l)
+                (integerp x)
+                (<= 0 x))
+           (naturals-listp (shift l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm shift--integer-list
+  (implies (and (integer-listp l)
+                (integerp x))
+           (integer-listp (shift l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm shift--rational-list
+  (implies (and (rational-listp l)
+                (rationalp x))
+           (rational-listp (shift l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm shift--number-list
+  (implies (and (acl2-number-listp l)
+                (acl2-numberp x))
+           (acl2-number-listp (shift l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm shift--consp
+  (implies (consp l)
+           (consp (shift l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm shift--len
+  (equal (len (shift l x))
+         (len l)))
+
+#|
+(defthm pow--pos-list
+  (implies (and (pos-listp l)
+                (integerp x)
+                (<= 0 x))
+           (pos-listp (pow l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm pow--nat-list
+  (implies (and (naturals-listp l)
+                (integerp x)
+                (<= 0 x))
+           (naturals-listp (pow l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm pow--integer-list
+  (implies (and (integer-listp l)
+                (integerp x)
+                (<= 0 x))
+           (integer-listp (pow l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm pow--rational-list
+  (implies (and (rational-listp l)
+                (integerp x)
+                (<= 0 x))
+           (rational-listp (pow l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm pow--number-list
+  (implies (and (acl2-number-listp l)
+                (integerp x)
+                (<= 0 x))
+           (acl2-number-listp (pow l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm pow--consp
+  (implies (consp l)
+           (consp (pow l x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm pow--len
+  (equal (len (pow l x))
+         (len l)))
+|#
+
+(defthm list-expt--number-list
+  (implies (and (acl2-number-listp l)
+                (integerp x)
+                (<= 0 x))
+           (acl2-number-listp (list-expt x l)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm list-expt--consp
+  (implies (consp l)
+           (consp (list-expt x l)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm list-expt--len
+  (equal (len (list-expt x l))
+         (len l)))
+
+
+(defthm expt--integer
+  (implies (and (integerp x)
+                (integerp y)
+                (<= 0 y))
+           (integerp (expt x y))))
+
+(defthm expt-->=0
+  (implies (and (integerp x)
+                (< 0 x)
+                (integerp y)
+                (<= 0 y))
+           (< 0 (expt x y)))
+  :rule-classes (:rewrite :linear))
+
+(defthm expt--2
+  (implies (and (integerp x)
+                (<= 0 x)
+                (integerp y)
+                (< 0 y))
+           (<= 2 (expt 2 y))))
+
+(defthm <=-lists--transitive
+  (implies (and (<=-lists a b)
+                (<=-lists b c))
+           (<=-lists a c))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthm <=-lists--reflexive
+  (<=-lists x x))
+
+(defthm all-<=--<=
+  (implies (and (all-<= l a)
+                (<= a b))
+           (all-<= l b)))
+
+(defthm all-<=--nth-<=
+  (implies (and (all-<= l v)
+                (integerp i)
+                (<= 0 i)
+                (< i (len l)))
+           (<= (nth i l) v)))
+
+(defthm all-<=--car-<=
+  (implies (and (all-<= l v)
+                (consp l))
+           (<= (car l) v)))
+
+(defthm <=-lists--all-<=
+  (implies (and (all-<= b x)
+                (<=-lists a b))
+           (all-<= a x))
+  :rule-classes (:rewrite :forward-chaining))
+
+(defthm *-lists-poses-type
+  (implies (and (pos-listp l1)
+                (pos-listp l2))
+           (pos-listp (*-lists l1 l2)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm *-lists-nats-type
+  (implies (and (naturals-listp l1)
+                (naturals-listp l2))
+           (naturals-listp (*-lists l1 l2)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm *-lists-integers-type
+  (implies (and (integer-listp l1)
+                (integer-listp l2))
+           (integer-listp (*-lists l1 l2)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm *-lists-rationals-type
+  (implies (and (rational-listp l1)
+                (rational-listp l2))
+           (rational-listp (*-lists l1 l2)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm *-lists--len
+  (equal (len (*-lists l1 l2))
+         (min (len l1) (len l2))))
+
+(defthm +-lists-poses-type
+  (implies (and (pos-listp l1)
+                (pos-listp l2))
+           (pos-listp (+-lists l1 l2)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm +-lists-nats-type
+  (implies (and (naturals-listp l1)
+                (naturals-listp l2))
+           (naturals-listp (+-lists l1 l2)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm +-lists-integers-type
+  (implies (and (integer-listp l1)
+                (integer-listp l2))
+           (integer-listp (+-lists l1 l2)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm +-lists-rationals-type
+  (implies (and (rational-listp l1)
+                (rational-listp l2))
+           (rational-listp (+-lists l1 l2)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm +-lists--len
+  (equal (len (+-lists l1 l2))
+         (min (len l1) (len l2))))
+
+(defthm make-list-ac=make-list-logic--lemma
+  (equal (append (make-list-logic e n)
+                 (cons e l))
+         (cons e
+               (append (make-list-logic e n)
+                       l))))
+
+(defthm make-list-ac=make-list-logic-append
+  (equal (make-list-ac n e l)
+         (append (make-list-logic e n) l)))
+
+(defthm make-list-ac--to--make-list-logic
+  (equal (make-list-ac n e nil)
+         (make-list-logic e n)))
+
+(defthm make-list--len
+  (implies (and (integerp n)
+                (<= 0 n))
+           (equal (len (make-list-logic v n))
+                  n)))
+
+(defthm make-list--consp
+  (implies (and (integerp n)
+                (< 0 n))
+            (consp (make-list-logic v n)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Subgoal *1/3'" :expand ((make-list-logic v 1)))))
+
+(defthm make-list--nats
+  (implies (and (integerp v)
+                (<= 0 v))
+           (naturals-listp (make-list-logic v n)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm make-list--pos
+  (implies (and (integerp v)
+                (< 0 v))
+           (pos-listp (make-list-logic v n)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm car--make-list
+  (implies (and (integerp n)
+                (< 0 n))
+           (equal (car (make-list-logic v n))
+                  v))
+  :hints (("Subgoal *1/3'" :expand ((make-list-logic v 1)))))
+
+(defthm cdr--make-list
+  (implies (and (integerp n)
+                (< 0 n))
+           (equal (cdr (make-list-logic v n))
+                  (make-list-logic v (- n 1)))))
+
+(defthm all-<=--make-list
+  (equal (all-<= (make-list-logic x n)
+                 y)
+         (or (zp n)
+             (<= x y))))
+
+
+(defthm pfix--integerp
+  (integerp (pfix x))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm pfix>=1
+  (<= 1 (pfix x))
+  :rule-classes (:rewrite :linear))
+
+(defthm pfix=
+  (implies (and (integerp x)
+                (< 0 x))
+           (equal (pfix x)
+                  x)))
+
+(in-theory (disable pfix))
+
+(defthm pos-list-fix--pos-listp
+  (pos-listp (pos-list-fix x)))
+
+;unfortunate
+(defthm pos-list-fix--naturals-listp
+  (naturals-listp (pos-list-fix x)))
+
+;unfortunate
+(defthm pos-list-fix--integer-listp
+  (integer-listp (pos-list-fix x)))
+
+;unfortunate
+(defthm pos-list-fix--rational-listp
+  (rational-listp (pos-list-fix x)))
+
+
+(defthm pos-list-fix--pos-list
+  (implies (pos-listp x)
+           (equal (pos-list-fix x)
+                  x)))
+
+(defthm pos-list-fix--len
+  (equal (len (pos-list-fix x))
+         (len x)))
+
+(defthm pos-list-fix--cons
+  (implies (consp x)
+           (equal (car (pos-list-fix x))
+                  (pfix (car x)))))
+
+(defthm pos-list-fix--cdr
+  (equal (cdr (pos-list-fix x))
+         (pos-list-fix (cdr x))))
+
+(defthm pos-list-fix--consp
+  (equal (consp (pos-list-fix x))
+         (consp x)))
+
+(in-theory (disable pos-list-fix))#|ACL2s-ToDo-Line|#
diff -Nru acl2-6.2/books/cgen/package.lsp acl2-6.3/books/cgen/package.lsp
--- acl2-6.2/books/cgen/package.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/package.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,67 @@
+
+(defpkg "DEFDATA"
+  (append 
+   '(getprop key val formals macro-args const
+     decode-logical-name value legal-constantp er-let* b* 
+     macroexpand1 trans-eval simple-translate-and-eval
+     assert-event legal-variable-or-constant-namep
+     f-boundp-global f-get-global f-put-global
+     proof-checker expansion equivalence-relationp
+     |1+F| |1-F| +f -f
+     defxdoc current-acl2-world e/d unsigned-byte-p
+     defrec 
+     variablep fquotep ffn-symb flambdap fargs
+     lambda-body lambda-formals subcor-var
+     dumb-negate-lit
+     
+     ;from graph.lisp
+     is-subtype is-disjoint 
+     
+     ;utlities.lisp
+     nat-listp allp acl2-number-listp naturals-listp pos-listp
+     
+     ;; num-lists.lisp
+     ;acl2-number-listp naturals-listp pos-listp 2+-listp
+     ;sum-list product-list max-nat-list <=-lists all-<=
+     ;shift scale *-lists +-lists make-list-logic pow list-expt
+     ;pfix pos-list-fix
+     
+     ;; misc exports: (n-x and finxlst-x added by harshrc)
+     oneof anyof data-constructors 
+     x n v infxlst finxlst
+
+     ;;added by harshrc
+      listof enum record map set nfixg
+      set-acl2s-defdata-verbose
+      get-acl2s-defdata-verbose
+      mget mset c
+     
+     ;; function/macro exports:
+     register-data-constructor
+     define-enumeration-type
+     defdata-subtype defdata-disjoint register-custom-type
+     defdata defdata-testing
+     
+     ;acl2-check
+     test? top-level-test? acl2s-defaults
+     set-acl2s-random-testing-enabled
+     get-acl2s-random-testing-enabled
+     dont-print-thanks-message-override-hint
+   
+     ;acl2s-defaults parameters
+     num-trials verbosity-level show-testing-output 
+     num-witnesses num-counterexamples
+
+     show-top-level-counterexample sampling-method
+     backtrack-limit  subgoal-timeout search-strategy
+     stopping-condition testing-enabled
+
+     ;verbosity control 
+     system-debug-flag inhibit-output-flag normal-output-flag
+     verbose-flag debug-flag
+
+     )
+   
+   (union-eq *acl2-exports*
+             *common-lisp-symbols-from-main-lisp-package*)))#|ACL2s-ToDo-Line|#
+
diff -Nru acl2-6.2/books/cgen/portcullis.lsp acl2-6.3/books/cgen/portcullis.lsp
--- acl2-6.2/books/cgen/portcullis.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/portcullis.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,3 @@
+(ld "package.lsp")
+(ld "finite-set-theory/osets/sets.defpkg" :dir :system)
+;(ld "std/osets/package.lsp" :dir :system)
diff -Nru acl2-6.2/books/cgen/random-state-basis1.lisp acl2-6.3/books/cgen/random-state-basis1.lisp
--- acl2-6.2/books/cgen/random-state-basis1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/random-state-basis1.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,171 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book);$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+(set-verify-guards-eagerness 2)
+(include-book "tools/bstar" :dir :system)
+(local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
+
+(defconst *M31* 2147483647);1 less than 2^31
+(defconst *P1* 16807)
+
+(make-event
+ (er-progn
+  (assign random-seed 1382728371)
+  (value '(value-triple (@ random-seed))))
+ :check-expansion t)
+
+
+(defun getseed (state)
+  (declare (xargs :stobjs (state)))
+  (if (f-boundp-global 'random-seed state)
+    (b* ((s (@ random-seed)))
+      (if (unsigned-byte-p 31 s)
+        (the (unsigned-byte 31) s)
+        0))
+    0))
+
+(defthm getseed-unsigned-byte31 
+  (unsigned-byte-p 31 (getseed state))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm getseed-nat 
+  (natp (getseed state))
+  :rule-classes :type-prescription)
+
+(defthm getseed-<-*m31*
+  (<= (getseed state) *M31*)
+  :rule-classes :linear)
+
+(in-theory (disable getseed))
+ 
+(defun putseed (s state)
+  (declare (xargs :stobjs (state)
+                  :guard (unsigned-byte-p 31 s)))
+  (declare (type (unsigned-byte 31) s))
+  (acl2::f-put-global 'random-seed s state))
+
+
+(defun genrandom-seed (max seed.)
+  "generates a pseudo-random number less than max, given that the
+current random seed is seed. and also returns the new seed."
+  (declare (type (unsigned-byte 31) max)
+           (type (unsigned-byte 31) seed.))
+  (declare (xargs :guard (and (unsigned-byte-p 31 seed.)
+                              (unsigned-byte-p 31 max)
+                              (posp max))))
+  (mbe :logic (if (and (posp max)
+                       (unsigned-byte-p 31 seed.))
+                       
+                  (b* (((the (unsigned-byte 31) seed.) (mod (* *P1* seed.) *M31*)))
+                    (mv (the (unsigned-byte 31) (mod seed. max)) seed.))
+                (mv 0 seed.))
+       :exec (b* (((the (unsigned-byte 31) seed.) (mod (* *P1* seed.) *M31*)))
+               (mv (the (unsigned-byte 31) (mod seed. max)) (the (unsigned-byte 31) seed.)))))
+
+
+(defun genrandom-state (max state)
+  "generates a pseudo-random number less than max"
+  (declare (type (unsigned-byte 31) max))
+  (declare (xargs :stobjs (state)
+                  :guard (and  (unsigned-byte-p 31 max)
+                               (posp max))))
+  (b* (((the (unsigned-byte 31) old-seed) (getseed state))
+       ((the (unsigned-byte 31) new-seed) (mod (* *P1* old-seed) *M31*))
+       (state (acl2::f-put-global 'random-seed new-seed state)))
+    (mv (if (zp max)
+          0
+          (the (unsigned-byte 31) (mod new-seed max)))
+        state)))
+
+(encapsulate nil
+
+ (local (defthm lemma1
+   (IMPLIES (and (posp max)
+                 (natp x))
+              
+         (<= 0 (MOD x MAX)))
+   :rule-classes :linear))
+
+ 
+(local (defthm lemma2
+ (IMPLIES (AND (posp MAX)
+               (< MAX 2147483648)
+              (natp x))
+         (< (MOD x MAX)
+            2147483648))
+ :rule-classes :linear))
+ 
+(defthm genrandom-natural1
+  (implies (and (posp max)) ;(natp seed))
+           (and (integerp (car (genrandom-seed max seed)))
+                (>= (car (genrandom-seed max seed)) 0))
+           )
+   :rule-classes :type-prescription)
+
+(defthm genrandom-natural2-type
+  (implies (and (natp seed))
+           (and (integerp (mv-nth 1 (genrandom-seed max seed)))
+                (<= 0 (mv-nth 1 (genrandom-seed max seed)))))
+   :rule-classes :type-prescription)
+
+(defthm genrandom-ub31-1
+  (implies (and (<= 1 max)
+                (unsigned-byte-p 31 max) 
+                (natp seed))
+           (unsigned-byte-p 31 (car (genrandom-seed max seed))))
+   :rule-classes (:type-prescription))
+
+;; (defthm genrandom-ub31-2
+;;   (implies (and (natp seed))
+;;            (unsigned-byte-p 31 (mv-nth 1 (genrandom-seed max seed))))
+;;    :rule-classes :tau-system)
+ 
+(defthm genrandom-minimum1
+   (implies (and (posp max) (natp seed))
+            (<= 0 (car (genrandom-seed max seed))))
+   :rule-classes :linear)
+
+(defthm genrandom-minimum2
+   (implies (and (natp seed))
+            (<= 0 (mv-nth 1 (genrandom-seed max seed))))
+   :rule-classes :linear)
+
+ (defthm genrandom-maximum1
+   (implies (and (posp max))
+                 
+            (< (car (genrandom-seed max seed)) max))
+   :rule-classes (:linear))
+ 
+ (defthm genrandom-maximum2
+   (implies (and (posp max)
+                 (unsigned-byte-p 31 seed))
+            (< (mv-nth 1 (genrandom-seed max seed)) *M31*))
+   :rule-classes :linear)
+ 
+ 
+
+
+
+ (defthm genrandom-state-natural
+   (natp (car (genrandom-state max state)))
+   :rule-classes :type-prescription)
+
+ (defthm genrandom-state-minimum 
+   (<= 0 (car (genrandom-state max state)))
+   :rule-classes :linear)
+ 
+ (defthm genrandom-state-maximum
+   (implies (posp max)
+            (<= (car (genrandom-state max state)) (1- max)))
+   :rule-classes :linear)
+ 
+ )
+
+ 
+(in-theory (disable genrandom-seed genrandom-state))#|ACL2s-ToDo-Line|#
+
+
diff -Nru acl2-6.2/books/cgen/random-state.lisp acl2-6.3/books/cgen/random-state.lisp
--- acl2-6.2/books/cgen/random-state.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/random-state.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,1375 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(begin-book t);$ACL2s-Preamble$|#
+
+(in-package "DEFDATA")
+(set-verify-guards-eagerness 2)
+
+(include-book "random-state-basis1")
+;(include-book "num-list-fns") ;defines acl2-number-listp,pos-listp,naturals-listp
+
+;=====================================================================;
+; 
+; by Peter Dillinger &  Dimitris Vardoulakis
+; Last Major Updates: 7 February 2008
+; Tweaked:  11 November 2008
+; Tweaked:  24 November 2008 by harshrc
+; Modified: 10 March 2012 by harshrc -- type declarations
+;=====================================================================;
+
+(defun random-boolean (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (num state)
+          (genrandom-state 2 state)
+          (mv (= 1 num) state)))
+
+(defthm random-boolean-type
+  (booleanp (car (random-boolean r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-boolean))
+
+
+;generate naturals according to a pseudo-geometric distribution
+;added strong type declarations for faster code
+
+(defun random-natural-basemax1 (base maxdigits seed.)
+  (declare (type (integer 1 16) base)
+           (type (integer 0 9) maxdigits)
+           (type (unsigned-byte 31) seed.)
+           (xargs :guard (and (unsigned-byte-p 31 seed.)
+                              (posp base)
+                              (<= base 16) (> base 0) 
+                              (natp maxdigits)
+                              (< maxdigits 10) (>= maxdigits 0))))
+  (if (zp maxdigits)
+    (mv 0 seed.)
+    (b* (((mv (the (integer 0 32) v) 
+              (the (unsigned-byte 31) seed.))
+          (genrandom-seed (acl2::*f 2 base) seed.)))
+     (if (>= v base)
+         (b* (((mv v2 seed.); can do better type information here TODO
+                 (random-natural-basemax1 base 
+                                         (1- maxdigits) seed.)))
+             (mv (+ (- v base) 
+                    (* base (nfix v2))) 
+                 seed.))
+      
+       (mv v seed.)))))
+
+(defun random-natural-seed (seed.)
+  (declare (type (unsigned-byte 31) seed.))
+  (declare (xargs :guard (unsigned-byte-p 31 seed.)))
+  (mbe :logic (if (unsigned-byte-p 31 seed.)
+                    (random-natural-basemax1 10 6 seed.)
+                  (random-natural-basemax1 10 6 1382728371)) ;random seed in random-state-basis1
+       :exec  (random-natural-basemax1 10 6 seed.)))
+      
+(defmacro random-index-seed (max seed.)
+  `(genrandom-seed ,max ,seed.))
+
+
+(defthm random-natural-basemax1-type-car
+  (implies (and (posp b) (natp d) (natp r))
+           (and (integerp (car (random-natural-basemax1 b d r)))
+                (>= (car (random-natural-basemax1 b d r)) 0)))
+  
+  :rule-classes (:type-prescription))
+
+(defthm random-natural-basemax1-type-cadr
+  (implies (and (posp b) (natp d) (unsigned-byte-p 31 r))
+           (unsigned-byte-p 31 (mv-nth 1 (random-natural-basemax1 b d r))))
+  :rule-classes  :type-prescription)
+
+(defthm random-natural-basemax1-type-cadr-0
+  (implies (and (posp b) (natp d) (unsigned-byte-p 31 r))
+           (and (<= 0 (mv-nth 1 (random-natural-basemax1 b d r)))
+                (< (mv-nth 1 (random-natural-basemax1 b d r)) 2147483648)))
+  :rule-classes (:linear :type-prescription))
+
+(defthm random-natural-basemax1-type-cadr-type
+  (implies (and (posp b) (natp d) (natp r))
+           (and (integerp (mv-nth 1 (random-natural-basemax1 b d r)))
+                (>= (mv-nth 1 (random-natural-basemax1 b d r)) 0)))
+  :rule-classes (:type-prescription))
+
+(defthm random-natural-seed-type-car
+  (implies (unsigned-byte-p 31 r)
+           (natp (car (random-natural-seed r))))
+  :rule-classes (:type-prescription))
+
+(defthm random-natural-seed-type-car-type
+  (implies (natp r)
+           (and (integerp (car (random-natural-seed r)))
+                (>= (car (random-natural-seed r)) 0)))
+  :rule-classes :type-prescription)
+
+;; (defthm random-natural-seed-type-cadr
+;;   (implies (unsigned-byte-p 31 r)
+;;            (unsigned-byte-p 31 (mv-nth 1 (random-natural-seed r))))
+;;   :rule-classes (:type-prescription))
+
+(defthm random-natural-seed-type-cadr-linear
+;  (implies (unsigned-byte-p 31 r)
+  (and (<= 0 (mv-nth 1 (random-natural-seed r)))
+       (< (mv-nth 1 (random-natural-seed r)) 2147483648))
+;)
+  :rule-classes (:linear :tau-system))
+
+(defthm random-natural-seed-type-cadr-type
+;  (implies (natp r)
+           (and (integerp (mv-nth 1 (random-natural-seed r)))
+                (>= (mv-nth 1 (random-natural-seed r)) 0))
+;)
+  :rule-classes (:type-prescription))
+
+
+
+(in-theory (disable random-natural-basemax1
+                    random-natural-seed))
+
+
+; pseudo-uniform rational between 0 and 1 (inclusive)
+;optimize later (copied from below but simplified)
+(defun random-probability-seed (seed.)
+  (declare (type (unsigned-byte 31) seed.))
+  (declare (xargs :verify-guards nil ;TODO
+                  :guard (unsigned-byte-p 31 seed.)))
+  (mbe :logic (if (unsigned-byte-p 31 seed.)
+                  (mv-let (a seed.)
+                          (random-natural-seed seed.)
+                          ;; try to bias this to get more of small probabilities (close to 1)
+                          (let ((denom (if (int= a 0)
+                                           (1+ a)
+                                         a)))
+                            (mv-let (numer seed.)
+                                    (genrandom-seed (1+ denom) seed.)
+                                    (mv (/ numer denom) seed.))))
+                (mv 0 seed.))
+       :exec (mv-let (a seed.)
+                     (random-natural-seed seed.)
+                     (let ((denom (if (int= a 0)
+                                           (1+ a)
+                                         a)))
+                       (mv-let (numer seed.)
+                               (genrandom-seed (1+ denom) seed.)
+                               (mv (/ numer denom) seed.))))))
+                
+
+;optimize later (copied from below)
+(defun random-rational-between-seed (lo hi seed.)
+  (declare (type (unsigned-byte 31) seed.))
+  (declare (xargs :verify-guards nil
+                  :guard (unsigned-byte-p 31 seed.)))
+  (mv-let (p seed.)
+          (random-probability-seed seed.)
+          (mv (rfix (+ lo (* p (- hi lo)))) seed.)))
+
+
+(defun random-integer-seed (seed.)
+  (declare (type (unsigned-byte 31) seed.))
+  (declare (xargs :guard (unsigned-byte-p 31 seed.)))
+  (mv-let (num seed.)
+          (genrandom-seed 2 seed.)
+          (mv-let (nat seed.)
+                  (random-natural-seed seed.)
+                  (mv (if (int= num 0) nat (- nat))
+                      seed.))))
+
+(defun random-int-between-seed (lo hi seed.)
+  (declare (type (unsigned-byte 31) seed.)
+           (type (signed-byte 30) lo)
+           (type (signed-byte 30) hi))
+  (declare (xargs :guard (and (unsigned-byte-p 31 seed.)
+                              (integerp lo)
+                              (integerp hi)
+                              (signed-byte-p 30 lo)
+                              (signed-byte-p 30 hi)
+                              (posp (- hi lo)))))
+  (mv-let (num seed.)
+          (genrandom-seed (1+ (- hi lo)) seed.)
+          (mv (+ lo num) seed.)))
+
+
+
+
+;-----------------------------------state random functions -------------------------
+
+(defun random-natural-basemax (base maxdigits state)
+   (declare (type (integer 1 16) base)
+            (type (integer 0 9) maxdigits)
+            (xargs :stobjs (state)
+                  :guard (and (posp base)
+                              (<= base 16) (> base 0) 
+                              (natp maxdigits)
+                              (< maxdigits 10) (>= maxdigits 0))))
+   (b* (((mv n seed.) (random-natural-basemax1 base maxdigits (getseed state)))
+        (state (putseed seed. state)))
+       (mv n state)))
+                   
+;;pseudo-geometric distribution
+(defun random-natural (state)
+  (declare (xargs :stobjs (state)))
+  (random-natural-basemax 10 6 state))
+
+
+;;pseudo-geometric distribution but smaller numbers
+(defun random-small-natural (state)
+  (declare (xargs :stobjs (state)))
+  (random-natural-basemax 10 3 state))
+
+
+;;added to be consistent with naming of the types
+;; Type name = foo
+;; Type predicate = foop
+;; Type enum = nth-foo
+;; Random generator = random-foo
+(defun random-nat (state)
+  (declare (xargs :stobjs (state)))
+  (random-natural-basemax 10 6 state))
+
+(defun random-length (state)
+  (declare (xargs :stobjs (state)))
+  (random-natural-basemax 4 2 state))
+
+;create small lists upto length 4
+(defun random-small-length (state)
+  (declare (xargs :stobjs (state)))
+  (random-natural-basemax 2 2 state))
+
+(defthm random-natural-basemax-type
+  (implies (and (posp b) (natp d))
+  (natp (car (random-natural-basemax b d r))))
+  :rule-classes :type-prescription)
+
+(defthm random-natural-type
+  (natp (car (random-natural r)))
+  :rule-classes :type-prescription)
+
+(defthm random-nat-type
+  (natp (car (random-nat r)))
+  :rule-classes :type-prescription)
+
+(defthm random-length-type
+  (natp (car (random-length r)))
+  :rule-classes :type-prescription)
+
+(defthm random-small-length-type
+  (natp (car (random-small-length r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-small-length))
+(in-theory (disable random-natural-basemax
+                    random-natural
+                    random-nat
+                    random-length))
+
+
+
+
+; generate indices uniformly within a specified length 
+(defun random-index (len state)
+  (declare (type (unsigned-byte 29) len)
+           (xargs :stobjs (state)
+                  :guard (posp len)))
+  (genrandom-state len state))
+
+(defun random-elem (lst state)
+  (declare (xargs :stobjs (state)
+                  :guard (and (true-listp lst)
+                              (< (len lst) (expt 2 29)))))
+  (cond ((endp lst) (value nil))
+        ((endp (cdr lst)) (value (car lst)))
+        (t
+         (mv-let (ind state)
+                 (random-index (len lst) state)
+                 (value (nth ind lst))))))
+        
+             
+;generate integers according to a pseudo-geometric distribution
+(defun random-integer (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (sign state)
+          (random-boolean state)
+          (mv-let (nat state)
+                  (random-natural state)
+                  (mv (if sign nat (- nat))
+                      state))))
+
+(defthm random-integer-type
+  (integerp (car (random-integer r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-integer))#|ACL2s-ToDo-Line|#
+
+
+#| start commenting out code that is right now unnecessary for random-testing, refactor this later into a sep file
+;or generate integers with a uniform distribution, between i & j (incl.)
+(defun random-int-between (i j state)
+  (declare (xargs :stobjs (state)
+                  :guard (and (integerp i)
+                              (integerp j))))
+  (let ((low (ifix (min i j)))
+        (high (ifix (max i j))))
+    (mv-let
+     (num state)
+     (genrandom (1+ (- high low)) state)
+     (mv (+ low num) state))))
+
+(defthm random-int-between-type
+  (integerp (car (random-int-between i j r)))
+  :rule-classes :type-prescription)
+
+(defthm random-int-between-lower
+  (implies (and (integerp i)
+                (integerp j)
+                (<= i j))
+           (<= i (car (random-int-between i j r))))
+  :rule-classes :linear)
+
+(defthm random-int-between-upper
+  (implies (and (integerp i)
+                (integerp j)
+                (<= i j))
+           (>= j (car (random-int-between i j r))))
+  :rule-classes :linear)
+
+(in-theory (disable random-int-between))
+
+
+; generate a signed rational with pseudo-geometric numerator & denominator 
+(defun random-rational (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (numer state)
+          (random-integer state)
+          (mv-let (denom-1 state)
+                  (random-natural state)
+                  (mv (/ numer
+                         (+ 1 denom-1))
+                      state))))
+
+(defthm random-rational-type
+  (rationalp (car (random-rational r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-rational))
+
+
+; pseudo-uniform rational between 0 and 1 (inclusive)
+(defun random-probability (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (a state)
+          (random-natural state)
+          (mv-let (b state)
+                  (random-natural state)
+                  (let ((denom (* (1+ a) (1+ b))))
+                    (mv-let (numer state)
+                            (genrandom (1+ denom) state)
+                            (mv (/ numer denom) state))))))
+
+(defthm random-probability-type
+  (rationalp (car (random-probability r)))
+  :rule-classes :type-prescription)
+
+(defthm random-probability>=0
+  (<= 0 (car (random-probability r)))
+  :rule-classes (:linear :type-prescription)) 
+
+(encapsulate nil
+  (local (include-book "arithmetic/rationals" :dir :system))
+
+  #|
+  (local
+   (defthm numerator<=denominator-implies-<=1
+     (implies (and (natp n)
+                   (posp d)
+                   (<= n d))
+              (<= (* (/ d) n)
+                  1))))
+  |#
+  
+  (defthm random-probability<=1
+    (<= (car (random-probability r)) 1)
+    :rule-classes :linear))
+
+(in-theory (disable random-probability))
+
+
+;generate a random rational whose absolute value is lte x
+(defun random-rational-between (x y state)
+  (declare (xargs :stobjs (state)
+                  :guard (and (rationalp x)
+                              (rationalp y))))
+  (mv-let (p state)
+          (random-probability state)
+          (mv (rfix
+               (if (< x y)
+                 (+ x (* p (- y x)))
+                 (+ y (* p (- x y)))))
+              state)))
+
+(defthm random-rational-between-type
+  (rationalp (car (random-rational-between i j r)))
+  :rule-classes :type-prescription)
+
+(encapsulate nil
+  (local (include-book "arithmetic-3/top" :dir :system))
+  
+  (defthm random-rational-between-lower
+    (implies (and (rationalp i)
+                  (rationalp j)
+                  (<= i j))
+             (<= i (car (random-rational-between i j r))))
+    :rule-classes :linear)
+
+  (local (defthm random-rational-between-upper-lemma2
+           (implies (and (rationalp i)
+                         (rationalp j)
+                         (rationalp p)
+                         (<= 0 p)
+                         (<= p 1)
+                         (< i j))
+                    (<= (* i p)
+                        (* j p)))
+           :rule-classes nil))
+  
+  (local 
+   (defthm random-rational-between-upper-lemma
+     (implies (and (rationalp i)
+                   (rationalp j)
+                   (rationalp p)
+                   (<= 0 p)
+                   (<= p 1)
+                   (< i j))
+              (<= (+ i (* j p))
+                  (+ j (* i p))))
+     :hints (("Goal" :use (:instance
+                           random-rational-between-upper-lemma2
+                           (p (- 1 p)))))))
+
+  (defthm random-rational-between-upper
+    (implies (and (rationalp i)
+                  (rationalp j)
+                  (<= i j))
+             (<= (car (random-rational-between i j r)) j))
+    :rule-classes :linear))
+
+(in-theory (disable random-rational-between))
+
+
+
+;generate non-zero integers according to a pseudo-geometric distribution
+(defun random-nonzero-integer (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (sign state)
+          (random-boolean state)
+          (mv-let (nat state)
+                  (random-natural state)
+                  (mv (if sign (+ 1 nat) (- -1 nat))
+                      state))))
+
+(defthm random-nonzero-integer-type
+  (and (integerp (car (random-nonzero-integer r)))
+       (not (equal (car (random-nonzero-integer r)) 0)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-nonzero-integer))
+
+;;--added by harshrc
+;;--generate positive integers according to a pseudo-geometric distribution
+(defun random-pos (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (nat state)
+          (random-natural state)
+          (mv (+ 1 nat) state)))
+
+(defthm random-pos-type
+  (posp (car (random-pos r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-pos))
+
+
+
+; generate a signed rational with pseudo-geometric numerator & denominator 
+(defun random-nonzero-rational (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (numer state)
+          (random-nonzero-integer state)
+          (mv-let (denom-1 state)
+                  (random-natural state)
+                  (mv (/ numer
+                         (+ 1 denom-1))
+                      state))))
+
+(defthm random-nonzero-rational-type
+  (and (rationalp (car (random-nonzero-rational r)))
+       (not (equal (car (random-nonzero-rational r)) 0)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-nonzero-rational))
+
+
+; generate a (strictly) complex number from rationals
+(defun random-complex (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (rpart state)
+          (random-rational state)
+          (mv-let (ipart state)
+                  (random-nonzero-rational state)
+                  (mv (complex rpart ipart) state))))
+
+(defthm random-complex-type
+  (complex-rationalp (car (random-complex r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-complex))
+
+
+
+(defmacro random-element (lst rand-state)
+  `(mv-let (random-element-macro-idx state)
+           (random-index (length ,lst) ,rand-state)
+           (mv (nth random-element-macro-idx ,lst) state)))
+
+(defmacro random-element-len (lst len rand-state)
+  `(if (mbt (<= ,len (len ,lst)))
+     (mv-let (random-element-macro-idx state)
+             (random-index ,len ,rand-state)
+             (mv (nth random-element-macro-idx ,lst) state))
+     (mv (car ,lst) state)))
+
+
+
+(defconst *standard-chars-len*
+  (len *standard-chars*))
+
+;;--slight modification of name char to character --harshrc
+(defun random-character (state)
+  (declare (xargs :stobjs (state)))
+  (random-element-len *standard-chars*
+                      *standard-chars-len*
+                      state))
+
+(defthm random-character-type
+  (characterp (car (random-character r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-character))
+
+(defun random-character-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-character state)
+            (mv-let (lst state)
+                    (random-character-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defthm random-character-list-len-type
+  (character-listp (car (random-character-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-character-list-len))
+
+(defun random-character-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-length state)
+          (random-character-list-len len state)))
+
+(defthm random-character-list-type
+  (character-listp (car (random-character-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-character-list))
+
+
+(defun random-string-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (mv-let (lst state)
+          (random-character-list-len len state)
+          (mv (coerce lst 'string) state)))
+
+(defthm random-string-len-type
+  (stringp (car (random-string-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-string-len))
+
+
+;generate a random string of pseudogeometric length
+(defun random-string (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-length state)
+          (random-string-len len state)))
+
+(defthm random-string-type
+  (stringp (car (random-string r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-string))
+
+
+;generate a random symbol of pseudogeometric length
+(defun random-symbol-same-package (sym state)
+  (declare (xargs :stobjs (state)
+                  :guard (symbolp sym)))
+  (mv-let (str state)
+          (random-string state)
+          (mv (intern-in-package-of-symbol str sym) state)))
+
+(defthm random-symbol-same-package-type
+  (implies (symbolp sym)
+           (symbolp (car (random-symbol-same-package sym r))))
+  :rule-classes :type-prescription)
+
+(defthmd random-symbol-same-package_expand-package
+  (implies (symbolp sym)
+           (equal (car (random-symbol-same-package sym r))
+                  (intern-in-package-of-symbol
+                   (symbol-name (car (random-symbol-same-package sym r)))
+                   sym))))
+
+(defthmd random-symbol-same-package_suck-package
+  (implies (symbolp sym)
+           (equal (intern-in-package-of-symbol
+                   (symbol-name (car (random-symbol-same-package sym r)))
+                   sym)
+                  (car (random-symbol-same-package sym r)))))
+
+(in-theory (disable random-symbol-same-package))
+
+
+(defun random-keyword (state)
+  (declare (xargs :stobjs (state)))
+  (random-symbol-same-package :acl2-pkg-witness state))
+
+(defthm random-keyword-type
+  (symbolp (car (random-keyword r)))
+  :rule-classes :type-prescription)
+
+(local (defthm keyword-package-intern
+         (implies (and (stringp str)
+                       (keywordp key))
+                  (equal (symbol-package-name
+                          (intern-in-package-of-symbol str key))
+                         "KEYWORD"))
+         :hints (("Goal" :use (:instance keyword-package (x str) (y key))))))
+
+(defthm random-keyword-keyword
+  (equal (symbol-package-name (car (random-keyword r)))
+         "KEYWORD")
+  :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
+                        (sym :acl2-pkg-witness)))))
+
+(in-theory (disable random-keyword))
+
+
+
+
+
+
+;some composites
+
+(defun random-acl2-number (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (v state)
+          (random-index 4 state)
+          (case v
+                (0 (random-natural state))
+                (1 (random-integer state))
+                (2 (random-rational state))
+                (t (random-complex state)))))
+
+(defthm random-acl2-number-type
+  (acl2-numberp (car (random-acl2-number r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-acl2-number))
+
+
+(defconst *acl2-exports-len*
+  (len *acl2-exports*))
+(defconst *common-lisp-symbols-from-main-lisp-package-len*
+  (len *common-lisp-symbols-from-main-lisp-package*))
+
+(with-output
+ :off (prove observation event)
+ (defun random-symbol (state)
+   (declare (xargs :stobjs (state)))
+   (mv-let (v state)
+           (random-index 8 state)
+           (case
+            v
+            (0 (random-boolean state))
+            (1 (random-element-len
+                *acl2-exports*
+                *acl2-exports-len*
+                state))
+            (2 (random-element-len
+                *common-lisp-symbols-from-main-lisp-package*
+                *common-lisp-symbols-from-main-lisp-package-len*
+                state))
+            (3 (random-keyword state))
+            (4 (random-symbol-same-package 'acl2::acl2-pkg-witness state))
+            (5 (random-symbol-same-package 'acl2-user::acl2-pkg-witness state))
+            (6 (random-symbol-same-package 'common-lisp::acl2-pkg-witness state))
+            (t (random-symbol-same-package 'acl2-pc::acl2-pkg-witness state))))))
+
+(encapsulate nil
+  (local (defthm nth-symbol-list
+           (implies (force (symbol-listp l))
+                    (symbolp (nth i l)))))
+  
+  (with-output
+   :off (prove observation event)
+   (defthm random-symbol-type
+     (symbolp (car (random-symbol r)))
+     :rule-classes :type-prescription)))
+
+(in-theory (disable random-symbol))
+
+
+
+(with-output
+ :off (prove observation event)
+ (defun random-acl2-symbol (state)
+   (declare (xargs :stobjs (state)))
+   (mv-let (v state)
+           (random-index 5 state) ; skew toward generated symbols
+           (case
+            v
+            (0 (random-boolean state))
+            (1 (random-element-len
+                *acl2-exports*
+                *acl2-exports-len*
+                state))
+            (2 (random-element-len
+                *common-lisp-symbols-from-main-lisp-package*
+                *common-lisp-symbols-from-main-lisp-package-len*
+                state))
+            (t (random-symbol-same-package 'acl2::acl2-pkg-witness state))))))
+
+(encapsulate nil
+  (local (defthm nth-symbol-list
+           (implies (force (symbol-listp l))
+                    (symbolp (nth i l)))))
+  
+  (with-output
+   :off (prove observation event)
+   (defthm random-acl2-symbol-type
+     (symbolp (car (random-acl2-symbol r)))
+     :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
+                           (sym 'acl2::acl2-pkg-witness))))
+     :rule-classes :type-prescription)))
+
+(in-theory (disable random-acl2-symbol))
+
+
+
+(defun random-atom (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (v state)
+          (random-index 4 state)
+          (case
+           v
+           (0 (random-acl2-number state))
+           (1 (random-character state))
+           (2 (random-symbol state))
+           (t (random-string state)))))
+
+(defthm random-atom-type
+  (atom (car (random-atom r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-atom))
+
+;;---------------------------------------------------------------------------
+;;---------------------------------------------------------------------------
+;;--modifications by harshrc
+;;--add random-<atom>-list for each atom type of pseudo-geometric length upto 4
+;;--generate true list of <atom> (<atom recognizer> <atom type-set>)
+
+
+
+;;--generate true list of integers (integerp 11)
+(defun random-integer-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-integer state)
+            (mv-let (lst state)
+                    (random-integer-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defthm random-integer-list-len-type
+  (integer-listp (car (random-integer-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-integer-list-len))
+
+(defun random-integer-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-integer-list-len len state)))
+
+(defthm random-integer-list-type
+  (integer-listp (car (random-integer-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-integer-list))
+
+;;--generate true list of positive integers  (posp 2)
+(defun random-pos-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-pos state)
+            (mv-let (lst state)
+                    (random-pos-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defun pos-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l) (eq l nil))
+        (t (and (posp (car l))
+                (pos-listp (cdr l))))))
+
+
+(defthm random-pos-list-len-type
+  (pos-listp (car (random-pos-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-pos-list-len))
+
+(defun random-pos-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-pos-list-len len state)))
+
+(defthm random-pos-list-type
+  (pos-listp (car (random-pos-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-pos-list))
+
+
+
+
+;;--generate true list of natural (natp 3)
+(defun random-nat-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-nat state)
+            (mv-let (lst state)
+                    (random-nat-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+;;--just to be consistent with the naming
+;;--naturalp is otherwise same as natp
+;;--redefined in several books in acl2-sources, so commented out.
+(local
+(defun naturalp (x)
+  (declare (xargs :guard t :mode :logic))
+  (and (integerp x) (<= 0 x)))
+)
+
+(defun naturals-listp (x)
+  (if (atom x)
+    (null x)
+    (and (natp (car x))
+         (naturals-listp (cdr x)))))
+
+
+
+(defthm random-nat-list-len-type
+  (naturals-listp (car (random-nat-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-nat-list-len))
+
+(defun random-nat-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-nat-list-len len state)))
+
+(defthm random-nat-list-type
+  (naturals-listp (car (random-nat-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-nat-list))
+
+
+;;--generate true list of rational (rationalp 31)
+(defun random-rational-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-rational state)
+            (mv-let (lst state)
+                    (random-rational-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defthm random-rational-list-len-type
+  (rational-listp (car (random-rational-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-rational-list-len))
+
+(defun random-rational-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-rational-list-len len state)))
+
+(defthm random-rational-list-type
+  (rational-listp (car (random-rational-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-rational-list))
+
+
+;;--generate true list of complex  (complex-rationalp 32)
+(defun random-complex-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-complex state)
+            (mv-let (lst state)
+                    (random-complex-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defun complex-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l) (equal l nil))
+        (t (and (complex-rationalp (car l))
+                (complex-listp (cdr l))))))
+
+(defthm random-complex-list-len-type
+  (complex-listp (car (random-complex-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-complex-list-len))
+
+(defun random-complex-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-complex-list-len len state)))
+
+(defthm random-complex-list-type
+  (complex-listp (car (random-complex-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-complex-list))
+
+
+
+;;--generate true list of acl2-number (acl2-numberp 63)
+(defun random-acl2-number-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-acl2-number state)
+            (mv-let (lst state)
+                    (random-acl2-number-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+; Modified slightly 12/4/2012 by Matt K. to be redundant with new ACL2
+; definition.
+(defun acl2-number-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (eq l nil))
+        (t (and (acl2-numberp (car l))
+                (acl2-number-listp (cdr l))))))
+
+(defthm random-acl2-number-list-len-type
+  (acl2-number-listp (car (random-acl2-number-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-acl2-number-list-len))
+
+(defun random-acl2-number-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-acl2-number-list-len len state)))
+
+(defthm random-acl2-number-list-type
+  (acl2-number-listp (car (random-acl2-number-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-acl2-number-list))
+
+
+
+;;--generate true list of boolean (booleanp 192)
+(defun random-boolean-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-boolean state)
+            (mv-let (lst state)
+                    (random-boolean-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defthm random-boolean-list-len-type
+  (boolean-listp (car (random-boolean-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-boolean-list-len))
+
+(defun random-boolean-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-boolean-list-len len state)))
+
+(defthm random-boolean-list-type
+  (boolean-listp (car (random-boolean-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-boolean-list))
+
+;;--generate true list of symbol   (symbolp 448)
+(defun random-symbol-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-symbol state)
+            (mv-let (lst state)
+                    (random-symbol-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defthm random-symbol-list-len-type
+  (symbol-listp (car (random-symbol-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-symbol-list-len))
+
+(defun random-symbol-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-symbol-list-len len state)))
+
+(defthm random-symbol-list-type
+  (symbol-listp (car (random-symbol-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-symbol-list))
+
+
+;;--generate true list of string   (characterp 4096)
+(defun random-string-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-string state)
+            (mv-let (lst state)
+                    (random-string-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defthm random-string-list-len-type
+  (string-listp (car (random-string-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-string-list-len))
+
+(defun random-string-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-string-list-len len state)))
+
+(defthm random-string-list-type
+  (string-listp (car (random-string-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-string-list))
+
+
+;;--generate true list of atom   (atom -1537)
+(defun random-atom-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-atom state)
+            (mv-let (lst state)
+                    (random-atom-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+
+(defthm random-atom-list-len-type
+  (atom-listp (car (random-atom-list-len l r)))
+  :rule-classes :type-prescription)
+
+
+(defun random-atom-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-atom-list-len len state)))
+
+(defthm random-atom-list-type
+  (atom-listp (car (random-atom-list r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-atom-list-len
+                    random-atom-list))
+
+(defun random-atom-cons-dep (dep state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp dep)))
+  (if (zp dep)
+    (random-atom state)
+    (mv-let (cr state)
+            (random-atom-cons-dep (1- dep) state)
+            (mv-let (cdr state)
+                    (random-atom-cons-dep (1- dep) state)
+                    (mv (cons cr cdr) state)))))
+#|
+(defthm random-atom-cons-dep-type
+  (consp (car (random-atom-cons-dep d r)))
+  :rule-classes :type-prescription)
+|#
+
+(defun random-atom-cons (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (dep state)
+          (random-small-length state)
+          (random-atom-cons-dep (1+ dep) state)))
+#|
+(defthm random-atom-cons-type
+  (consp (car (random-atom-cons r)))
+  :rule-classes :type-prescription)
+|#
+(in-theory (disable random-atom-cons-dep
+                    random-atom-cons))
+
+(defun anyp (x)
+  (declare (xargs :mode :logic
+                  :guard t)
+           (ignore x))
+  t)
+
+(defun random-any (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (v state)
+          (random-index 10 state);skew towards atoms
+          (case
+           v
+           (0 (random-atom-cons state))
+           (1 (random-atom-list state))
+           (t (random-atom state)))))
+(defthm random-any-type
+  (anyp (car (random-any r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-any))
+
+(defun random-true-list-len (len state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp len)
+                  :measure len))
+  (if (zp len)
+    (mv nil state)
+    (mv-let (elem state)
+            (random-any state)
+            (mv-let (lst state)
+                    (random-atom-list-len (1- len) state)
+                    (mv (cons elem lst) state)))))
+#|
+(defthm random-true-list-len-type
+  (true-listp (car (random-true-list-len l r)))
+  :rule-classes :type-prescription)
+|#
+
+(defun random-true-list (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (len state)
+          (random-small-length state)
+          (random-true-list-len len state)))
+#|
+(defthm random-true-list-type
+  (true-listp (car (random-true-list r)))
+  :rule-classes :type-prescription)
+|#
+(in-theory (disable random-true-list-len
+                    random-true-list))
+
+(defun random-cons-dep (dep1 dep2 state)
+  (declare (xargs :stobjs (state)
+                  :guard (and (natp dep1)
+                              (natp dep2))))
+  (if (or (zp dep1) (zp dep2))
+    (random-any state)
+    (mv-let (cr state)
+            (random-atom-cons-dep (floor dep1 2) state)
+            (mv-let (cdr state)
+                    (random-atom-cons-dep (1- dep2) state)
+                    (mv (cons cr cdr) state)))))
+
+
+(defun random-cons (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (dep1 state)
+          (random-small-length state)
+          (mv-let (dep2 state)
+                  (random-small-length state)
+                  (random-cons-dep (1+ dep1) (1+ dep2) state))))
+
+(defthm random-cons-type
+  (consp (car (random-cons r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-cons-dep 
+                    random-cons))
+
+|# ;end commenting of all this code, refactor it into a seperate file later.
+
+
+#|
+(defun random-key-pair (key state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (cdr state)
+          (random-any state)
+          (mv (cons key cdr) state))) 
+;;random acons with keys as symbols (can it be parametrized without using macros?)
+(defun random-acons-dep (dep state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp dep)))
+  (if (zp dep)
+    (mv-let (key state)
+            (random-symbol state)
+            (random-key-pair key state))
+    (mv-let (cr state)
+            (random-acons-dep (1- dep) state)
+            (mv-let (cdr state)
+                    (random-acons-dep (1- dep) state)
+                    (mv (cons cr cdr) state)))))
+
+;;beware this function sometimes produces huge aconses. CHECK! exponential length..                  
+(defun random-acons (state)
+  (declare (xargs :stobjs (state)))
+  (mv-let (dep state)
+          (random-small-length state)
+          (random-acons-dep (1+ dep) state)))
+
+(defthm random-acons-type
+  (aconsp (car (random-acons r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-acons))
+|#
+
+;;---------------------------------------------------------------------------
+;;---------------------------------------------------------------------------
+
+
+#|
+
+(defun test-n-atoms (n state)
+  (declare (xargs :stobjs (state)
+                  :guard (natp n)))
+  (if (zp n)
+    (value t)
+    (mv-let (a state)
+            (random-atom state)
+            (if (consp a)
+              (value nil)
+              (test-n-atoms (1- n) state)))))
+
+(time$ (test-n-atoms 100000 state))
+
+; SBCL, basis1
+; (time$ (test-n-atoms 100000 state))
+; 0.69 sec
+
+; SBCL, basis2
+; (time$ (test-n-atoms 100000 state))
+; 0.60 sec
+
+; SBCL, basis3
+; (time$ (test-n-atoms 100000 state))
+; 0.45 sec
+
+
+;|#
+
+
+
+
+
+#|
+
+(defconst *atomic-value-types*
+  '(:atom       
+     :number     
+      :complex    
+       :rational   
+        :integer     
+         :natural      
+
+     :character 
+
+     :symbol    
+      :acl2-symbol
+       :boolean
+      :keyword    
+     
+     :string))  
+
+(defun random-value (spec state)
+  (declare (xargs :stobjs (state)))
+  (if (consp spec)
+    (if (symbolp (car spec))
+      (case (car spec)
+        (quote
+         (if (and (consp (cdr spec))
+                  (null (cddr spec)))
+           (mv (cadr spec) state)
+           (mv (er hard? 'random-value "Invalid quoted value: ~x0" spec)
+               state)))
+        (cons
+         (if (and (consp (cdr spec))
+                  (consp (cddr spec))
+                  (null (cdddr spec)))
+           (mv-let (carval state)
+                   (random-value (cadr spec) state)
+                   (mv-let (cdrval state)
+                           (random-value (caddr spec) state)
+                           (mv (cons carval cdrval) state)))
+           (mv (er hard? 'random-value "Cons should take two parameters, unlike in ~x0" spec)
+               state)))
+        (listof
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/cgen/random.lisp acl2-6.3/books/cgen/random.lisp
--- acl2-6.2/books/cgen/random.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/random.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,714 @@
+#|$ACL2s-Preamble$;
+(begin-book);$ACL2s-Preamble$|#
+
+
+#|
+
+  A Simple Random Number Generator              Version 0.1 
+  Jared Davis <jared@cs.utexas.edu>          February 25, 2004
+  
+  This file is in the public domain.  You can freely use it for any
+  purpose without restriction. 
+ 
+  This is just a basic pure multiplicative pseudorandom number gen-
+  erator.  *M31* is the 31st mersenne prime, and *P1* is 7^5 which
+  is a primitive root of *M31*, ensuring that our period is M31 - 1.
+  This idea is described in "Elementary Number Theory and its Appli-
+  cations" by Kenneth H. Rosen, Fourth Edition, Addison Wesley 1999,
+  in Chapter 10.1, pages 356-358.
+ 
+  The random number generator uses a stobj, rand, to store the seed.
+  You will want to use the following functions:
+
+    (genrandom <max> rand)
+       Returns (mv k rand) where 0 <= k < max.
+            
+    (update-seed <newseed> rand)
+       Manually switch to a new seed.  By default, a large messy num-
+       ber will be used.  You probably don't need to change it, but 
+       it might be good if you want to be able to reproduce your re-
+       sults in the future.
+ 
+  Normally we are not particularly interested in reasoning about ran-
+  dom numbers.  However, we can say that the number k generated is an
+  an integer, and that 0 <= k < max when max is a positive integer. 
+  See the theorems genrandom-minimum and genrandom-maximum. 
+
+  --
+  
+  Modified slightly by Peter Dillinger, 7 Feb 2008
+  With significant additions by Dimitris Vardoulakis & Peter Dillinger where
+    noted below.
+
+|#
+
+(in-package "ACL2")
+(set-verify-guards-eagerness 2)
+
+
+(defconst *M31* 2147483647)    
+(defconst *P1* 16807)          
+
+(defstobj rand
+  (seed :type integer :initially 1382728371))
+
+
+
+(defun getseed (rand)
+  (declare (xargs :stobjs (rand)))
+  (let ((s (seed rand)))
+    (if (and (integerp s) (<= 0 s))
+        s
+      0)))
+
+(local (defthm getseed-integer
+  (and (integerp (getseed rand))
+       (<= 0 (getseed rand)))
+  :rule-classes :type-prescription))
+
+(in-theory (disable getseed))
+
+(defun genrandom (max rand)
+  (declare (xargs :stobjs (rand)
+                  :guard (posp max)))
+  (let* ((new-seed (mod (* *P1* (getseed rand)) *M31*))
+         (rand (update-seed new-seed rand)))
+    (mv (if (zp max)
+          0
+          (mod new-seed max))
+        rand)))
+
+(encapsulate nil
+ (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
+
+ (defthm genrandom-natural
+   (natp (car (genrandom max rand)))
+   :rule-classes :type-prescription)
+
+ (defthm genrandom-minimum 
+   (<= 0 (car (genrandom max rand)))
+   :rule-classes :linear)
+ 
+ (defthm genrandom-maximum
+   (implies (posp max)
+            (<= (car (genrandom max rand)) (1- max)))
+   :rule-classes :linear))
+ 
+(in-theory (disable genrandom))
+
+
+
+;=====================================================================;
+; 
+; Begin additions by Peter Dillinger &  Dimitris Vardoulakis
+; Last modified 7 February 2008
+;
+;=====================================================================;
+
+(defun random-boolean (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (num rand)
+          (genrandom 2 rand)
+          (mv (= 1 num) rand)))
+
+(defthm random-boolean-type
+  (booleanp (car (random-boolean r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-boolean))
+
+;generate naturals according to a pseudo-geometric distribution
+(defun random-natural-basemax (base maxdigits rand)
+  (declare (xargs :stobjs (rand)
+                  :guard (and (posp base)
+                              (natp maxdigits))))
+  (if (or (zp maxdigits) (zp base))
+    (mv 0 rand)
+    (mv-let (v rand)
+            (genrandom (* 2 base) rand)
+            (if (>= v base)
+              (mv-let (v2 rand)
+                      (random-natural-basemax base (1- maxdigits) rand)
+                      (mv (+ (- v base) (* base (nfix v2))) rand))
+              (mv v rand)))))
+
+(defun random-natural (rand)
+  (declare (xargs :stobjs (rand)))
+  (random-natural-basemax 10 6 rand))
+
+(defun random-length (rand)
+  (declare (xargs :stobjs (rand)))
+  (random-natural-basemax 4 2 rand))
+
+(defthm random-natural-basemax-type
+  (natp (car (random-natural-basemax b d r)))
+  :rule-classes :type-prescription)
+
+(defthm random-natural-type
+  (natp (car (random-natural r)))
+  :rule-classes :type-prescription)
+
+(defthm random-length-type
+  (natp (car (random-length r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-natural-basemax
+                    random-natural
+                    random-length))
+
+
+
+
+; generate indices uniformly within a specified length 
+(defun random-index (len rand)
+  (declare (xargs :stobjs (rand)
+                  :guard (posp len)))
+  (genrandom len rand))
+
+             
+;generate integers according to a pseudo-geometric distribution
+(defun random-integer (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (sign rand)
+          (random-boolean rand)
+          (mv-let (nat rand)
+                  (random-natural rand)
+                  (mv (if sign nat (- nat))
+                      rand))))
+
+(defthm random-integer-type
+  (integerp (car (random-integer r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-integer))
+
+
+;or generate integers with a uniform distribution, between i & j (incl.)
+(defun random-int-between (i j rand)
+  (declare (xargs :stobjs (rand)
+                  :guard (and (integerp i)
+                              (integerp j))))
+  (let ((low (ifix (min i j)))
+        (high (ifix (max i j))))
+    (mv-let
+     (num rand)
+     (genrandom (1+ (- high low)) rand)
+     (mv (+ low num) rand))))
+
+(defthm random-int-between-type
+  (integerp (car (random-int-between i j r)))
+  :rule-classes :type-prescription)
+
+(defthm random-int-between-lower
+  (implies (and (integerp i)
+                (integerp j)
+                (<= i j))
+           (<= i (car (random-int-between i j r))))
+  :rule-classes :linear)
+
+(defthm random-int-between-upper
+  (implies (and (integerp i)
+                (integerp j)
+                (<= i j))
+           (>= j (car (random-int-between i j r))))
+  :rule-classes :linear)
+
+(in-theory (disable random-int-between))
+
+
+; generate a signed rational with pseudo-geometric numerator & denominator 
+(defun random-rational (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (numer rand)
+          (random-integer rand)
+          (mv-let (denom-1 rand)
+                  (random-natural rand)
+                  (mv (/ numer
+                         (+ 1 denom-1))
+                      rand))))
+
+(defthm random-rational-type
+  (rationalp (car (random-rational r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-rational))
+
+
+; pseudo-uniform rational between 0 and 1 (inclusive)
+(defun random-probability (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (a rand)
+          (random-natural rand)
+          (mv-let (b rand)
+                  (random-natural rand)
+                  (let ((denom (* (1+ a) (1+ b))))
+                    (mv-let (numer rand)
+                            (genrandom (1+ denom) rand)
+                            (mv (/ numer denom) rand))))))
+
+(defthm random-probability-type
+  (rationalp (car (random-probability r)))
+  :rule-classes :type-prescription)
+
+(defthm random-probability>=0
+  (<= 0 (car (random-probability r)))
+  :rule-classes (:linear :type-prescription)) 
+
+(encapsulate nil
+  (local (include-book "arithmetic/rationals" :dir :system))
+
+  #|
+  (local
+   (defthm numerator<=denominator-implies-<=1
+     (implies (and (natp n)
+                   (posp d)
+                   (<= n d))
+              (<= (* (/ d) n)
+                  1))))
+  |#
+  
+  (defthm random-probability<=1
+    (<= (car (random-probability r)) 1)
+    :rule-classes :linear))
+
+(in-theory (disable random-probability))
+
+
+;generate a random rational whose absolute value is lte x
+(defun random-rational-between (x y rand)
+  (declare (xargs :stobjs (rand)
+                  :guard (and (rationalp x)
+                              (rationalp y))))
+  (mv-let (p rand)
+          (random-probability rand)
+          (mv (rfix
+               (if (< x y)
+                 (+ x (* p (- y x)))
+                 (+ y (* p (- x y)))))
+              rand)))
+
+(defthm random-rational-between-type
+  (rationalp (car (random-rational-between i j r)))
+  :rule-classes :type-prescription)
+
+(encapsulate nil
+  (local (include-book "arithmetic-3/top" :dir :system))
+  
+  (defthm random-rational-between-lower
+    (implies (and (rationalp i)
+                  (rationalp j)
+                  (<= i j))
+             (<= i (car (random-rational-between i j r))))
+    :rule-classes :linear)
+
+  (local (defthm random-rational-between-upper-lemma2
+           (implies (and (rationalp i)
+                         (rationalp j)
+                         (rationalp p)
+                         (<= 0 p)
+                         (<= p 1)
+                         (< i j))
+                    (<= (* i p)
+                        (* j p)))
+           :rule-classes nil))
+  
+  (local 
+   (defthm random-rational-between-upper-lemma
+     (implies (and (rationalp i)
+                   (rationalp j)
+                   (rationalp p)
+                   (<= 0 p)
+                   (<= p 1)
+                   (< i j))
+              (<= (+ i (* j p))
+                  (+ j (* i p))))
+     :hints (("Goal" :use (:instance
+                           random-rational-between-upper-lemma2
+                           (p (- 1 p)))))))
+
+  (defthm random-rational-between-upper
+    (implies (and (rationalp i)
+                  (rationalp j)
+                  (<= i j))
+             (<= (car (random-rational-between i j r)) j))
+    :rule-classes :linear))
+
+(in-theory (disable random-rational-between))
+
+
+
+;generate non-zero integers according to a pseudo-geometric distribution
+(defun random-nonzero-integer (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (sign rand)
+          (random-boolean rand)
+          (mv-let (nat rand)
+                  (random-natural rand)
+                  (mv (if sign (+ 1 nat) (- -1 nat))
+                      rand))))
+
+(defthm random-nonzero-integer-type
+  (and (integerp (car (random-nonzero-integer r)))
+       (not (equal (car (random-nonzero-integer r)) 0)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-nonzero-integer))
+
+
+
+
+; generate a signed rational with pseudo-geometric numerator & denominator 
+(defun random-nonzero-rational (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (numer rand)
+          (random-nonzero-integer rand)
+          (mv-let (denom-1 rand)
+                  (random-natural rand)
+                  (mv (/ numer
+                         (+ 1 denom-1))
+                      rand))))
+
+(defthm random-nonzero-rational-type
+  (and (rationalp (car (random-nonzero-rational r)))
+       (not (equal (car (random-nonzero-rational r)) 0)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-nonzero-rational))
+
+
+; generate a (strictly) complex number from rationals
+(defun random-complex (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (rpart rand)
+          (random-rational rand)
+          (mv-let (ipart rand)
+                  (random-nonzero-rational rand)
+                  (mv (complex rpart ipart) rand))))
+
+(defthm random-complex-type
+  (complex-rationalp (car (random-complex r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-complex))
+
+
+
+
+(defmacro random-element (lst rand-rand)
+  `(mv-let (random-element-macro-idx rand)
+           (random-index (length ,lst) ,rand-rand)
+           (mv (nth random-element-macro-idx ,lst) rand)))
+
+(defmacro random-element-len (lst len rand-rand)
+  `(if (mbt (<= ,len (len ,lst)))
+     (mv-let (random-element-macro-idx rand)
+             (random-index ,len ,rand-rand)
+             (mv (nth random-element-macro-idx ,lst) rand))
+     (mv (car ,lst) rand)))
+
+
+
+(defconst *standard-chars-len*
+  (len *standard-chars*))
+
+(defun random-char (rand)
+  (declare (xargs :stobjs (rand)))
+  (random-element-len *standard-chars*
+                      *standard-chars-len*
+                      rand))
+
+(defthm random-char-type
+  (characterp (car (random-char r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-char))
+
+
+(defun random-char-list-len (len rand)
+  (declare (xargs :stobjs (rand)
+                  :guard (natp len)))
+  (if (zp len)
+    (mv nil rand)
+    (mv-let (c rand)
+            (random-char rand)
+            (mv-let (lst rand)
+                    (random-char-list-len (1- len) rand)
+                    (mv (cons c lst) rand)))))
+
+(defthm random-char-list-len-type
+  (character-listp (car (random-char-list-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-char-list-len))
+
+
+(defun random-string-len (len rand)
+  (declare (xargs :stobjs (rand)
+                  :guard (natp len)))
+  (mv-let (lst rand)
+          (random-char-list-len len rand)
+          (mv (coerce lst 'string) rand)))
+
+(defthm random-string-len-type
+  (stringp (car (random-string-len l r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-string-len))
+
+
+;generate a random string of pseudogeometric length
+(defun random-string (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (len rand)
+          (random-length rand)
+          (random-string-len len rand)))
+
+(defthm random-string-type
+  (stringp (car (random-string r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-string))
+
+
+;generate a random symbol of pseudogeometric length
+(defun random-symbol-same-package (sym rand)
+  (declare (xargs :stobjs (rand)
+                  :guard (symbolp sym)))
+  (mv-let (str rand)
+          (random-string rand)
+          (mv (intern-in-package-of-symbol str sym) rand)))
+
+(defthm random-symbol-same-package-type
+  (implies (symbolp sym)
+           (symbolp (car (random-symbol-same-package sym r))))
+  :rule-classes :type-prescription)
+
+(defthmd random-symbol-same-package_expand-package
+  (implies (symbolp sym)
+           (equal (car (random-symbol-same-package sym r))
+                  (intern-in-package-of-symbol
+                   (symbol-name (car (random-symbol-same-package sym r)))
+                   sym))))
+
+(defthmd random-symbol-same-package_suck-package
+  (implies (symbolp sym)
+           (equal (intern-in-package-of-symbol
+                   (symbol-name (car (random-symbol-same-package sym r)))
+                   sym)
+                  (car (random-symbol-same-package sym r)))))
+
+(in-theory (disable random-symbol-same-package))
+
+
+(defun random-keyword (rand)
+  (declare (xargs :stobjs (rand)))
+  (random-symbol-same-package :acl2-pkg-witness rand))
+
+(defthm random-keyword-type
+  (symbolp (car (random-keyword r)))
+  :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
+                        (sym :acl2-pkg-witness))))
+  :rule-classes :type-prescription)
+
+(encapsulate
+  ()
+
+; [Jared] Previously keyword-package-intern had the following hints:
+
+  ;; :hints (("Goal" :use (:instance keyword-package (x str) (y key))))))
+
+; But in my copy of ACL2 the keyword-package axiom doesn't seem to have any
+; variables, so I'm not sure what's going on.  I've fixed this up to work in
+; my copy, maybe this is right?
+
+  (local (defthm l0
+           (equal (member-symbol-name str nil)
+                  nil)
+           :hints(("Goal" :in-theory (enable member-symbol-name)))))
+
+  (local (defthm keyword-package-intern
+           (implies (and (stringp str)
+                         (keywordp key))
+                    (equal (symbol-package-name
+                            (intern-in-package-of-symbol str key))
+                           "KEYWORD"))
+           :hints(("Goal"
+                   :in-theory (disable keyword-package
+                                       SYMBOL-PACKAGE-NAME-INTERN-IN-PACKAGE-OF-SYMBOL)
+                   :use ((:instance keyword-package)
+                         (:instance SYMBOL-PACKAGE-NAME-INTERN-IN-PACKAGE-OF-SYMBOL
+                                    (x str)
+                                    (y key)))))
+           ))
+
+  (defthm random-keyword-keyword
+    (equal (symbol-package-name (car (random-keyword r)))
+           "KEYWORD")
+    :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
+                                    (sym :acl2-pkg-witness))))))
+
+(in-theory (disable random-keyword))
+
+
+
+
+;some composites
+
+(defun random-number (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (v rand)
+          (random-index 4 rand)
+          (case v
+                (0 (random-natural rand))
+                (1 (random-integer rand))
+                (2 (random-rational rand))
+                (t (random-complex rand)))))
+
+(defthm random-number-type
+  (acl2-numberp (car (random-number r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-number))
+
+
+(defconst *acl2-exports-len*
+  (len *acl2-exports*))
+(defconst *common-lisp-symbols-from-main-lisp-package-len*
+  (len *common-lisp-symbols-from-main-lisp-package*))
+
+(with-output
+ :off (prove observation event)
+ (defun random-symbol (rand)
+   (declare (xargs :stobjs (rand)))
+   (mv-let (v rand)
+           (random-index 8 rand)
+           (case
+            v
+            (0 (random-boolean rand))
+            (1 (random-element-len
+                *acl2-exports*
+                *acl2-exports-len*
+                rand))
+            (2 (random-element-len
+                *common-lisp-symbols-from-main-lisp-package*
+                *common-lisp-symbols-from-main-lisp-package-len*
+                rand))
+            (3 (random-keyword rand))
+            (4 (random-symbol-same-package 'acl2::acl2-pkg-witness rand))
+            (5 (random-symbol-same-package 'acl2-user::acl2-pkg-witness rand))
+            (6 (random-symbol-same-package 'common-lisp::acl2-pkg-witness rand))
+            (t (random-symbol-same-package 'acl2-pc::acl2-pkg-witness rand))))))
+
+(local (defthm nth-symbol-list
+         (implies (force (symbol-listp l))
+                  (symbolp (nth i l)))
+         :rule-classes :type-prescription))
+
+(with-output
+ :off (prove observation event)
+ (defthm random-symbol-type
+   (symbolp (car (random-symbol r)))
+   :rule-classes :type-prescription))
+
+(in-theory (disable random-symbol))
+
+
+
+(with-output
+ :off (prove observation event)
+ (defun random-acl2-symbol (rand)
+   (declare (xargs :stobjs (rand)))
+   (mv-let (v rand)
+           (random-index 5 rand) ; skew toward generated symbols
+           (case
+            v
+            (0 (random-boolean rand))
+            (1 (random-element-len
+                *acl2-exports*
+                *acl2-exports-len*
+                rand))
+            (2 (random-element-len
+                *common-lisp-symbols-from-main-lisp-package*
+                *common-lisp-symbols-from-main-lisp-package-len*
+                rand))
+            (t (random-symbol-same-package 'acl2::acl2-pkg-witness rand))))))
+
+(with-output
+ :off (prove observation event)
+ (defthm random-acl2-symbol-type
+   (symbolp (car (random-acl2-symbol r)))
+   :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
+                         (sym 'acl2::acl2-pkg-witness))))
+   :rule-classes :type-prescription))
+
+(in-theory (disable random-acl2-symbol))
+
+
+
+(defun random-atom (rand)
+  (declare (xargs :stobjs (rand)))
+  (mv-let (v rand)
+          (random-index 4 rand)
+          (case
+           v
+           (0 (random-number rand))
+           (1 (random-char rand))
+           (2 (random-symbol rand))
+           (t (random-string rand)))))
+
+(defthm random-atom-type
+  (atom (car (random-atom r)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable random-atom))#|ACL2s-ToDo-Line|#
+
+
+
+
+
+
+
+
+#|
+
+(defconst *atomic-value-types*
+  '(:atom
+     :number
+      :complex
+       :rational
+        :integer
+         :natural
+
+     :character
+
+     :symbol
+      :acl2-symbol
+       :boolean
+      :keyword
+     
+     :string))
+
+(defun random-value (spec rand)
+  (declare (xargs :stobjs (rand)))
+  (if (consp spec)
+    (if (symbolp (car spec))
+      (case (car spec)
+        (quote
+         (if (and (consp (cdr spec))
+                  (null (cddr spec)))
+           (mv (cadr spec) rand)
+           (mv (er hard? 'random-value "Invalid quoted value: ~x0" spec)
+               rand)))
+        (cons
+         (if (and (consp (cdr spec))
+                  (consp (cddr spec))
+                  (null (cdddr spec)))
+           (mv-let (carval rand)
+                   (random-value (cadr spec) rand)
+                   (mv-let (cdrval rand)
+                           (random-value (caddr spec) rand)
+                           (mv (cons carval cdrval) rand)))
+           (mv (er hard? 'random-value "Cons should take two parameters, unlike in ~x0" spec)
+               rand)))
+        (listof
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/cgen/rem-and-floor.lisp acl2-6.3/books/cgen/rem-and-floor.lisp
--- acl2-6.2/books/cgen/rem-and-floor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/rem-and-floor.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,98 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book);$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+
+(encapsulate nil
+  
+  ;; load in & build up some theory on integer division
+  
+  (local (include-book "arithmetic-5/top" :dir :system))
+  
+  (defthm floor-less
+    (implies (and (integerp x)
+                  (< 0 x)
+                  (integerp y)
+                  (<= 2 y))
+             (< (floor x y) x))
+    :rule-classes (:linear :rewrite))
+  
+  (defthm floor-0
+    (implies (equal x 0)
+             (equal (floor x y) x)))
+  
+  (defthm floor-less-eq
+    (implies (and (integerp x)
+                  (<= 0 x)
+                  (integerp y)
+                  (<= 2 y))
+             (<= (floor x y) x))
+    :hints (("Goal" :in-theory (disable floor)
+                    :cases ((< 0 x))))
+    :rule-classes (:linear :rewrite))
+
+  (defthm rem-floor-decomp
+    (implies (and (integerp x)
+                  (<= 0 x)
+                  (integerp y)
+                  (<= 0 y))
+             (equal (+ (rem x y)
+                       (* y
+                          (floor x y)))
+                    x)))
+  
+  (defthm rem-0
+    (equal (rem 0 x)
+           0))
+  
+  (defthm rem--0
+    (implies (acl2-numberp x)
+             (equal (rem x 0)
+                    x)))
+  
+  (defthm rem-integerp
+    (implies (and (integerp x)
+                  (integerp y))
+             (integerp (rem x y)))
+    :rule-classes (:rewrite :type-prescription))
+  
+  (defthm rem-upper-bound
+    (implies (and (integerp x) (<= 0 x)
+                  (integerp y) (< 0 y))
+             (<= (rem x y) x))
+    :rule-classes (:linear :rewrite))
+
+  (local (in-theory (disable rem)))
+  
+  (defthm rem-lower-bound2
+    (implies (and (integerp x) (<= 0 x) (integerp y) (<= 0 y))
+             (<= 0 (rem x y)))
+    :rule-classes (:linear :rewrite)
+    :hints (("Goal" :cases ((equal x 0)
+                            (equal y 0)))))
+  
+  (defthm rem-upper-bound2
+    (implies (and (integerp x) (<= 0 x) (integerp y) (< 0 y))
+             (< (rem x y) y))
+    :rule-classes (:linear :rewrite)
+    :hints (("Goal" :cases ((equal x 0)))))
+  
+  (defthm floor-integerp
+    (implies (and (integerp x)
+                  (integerp y))
+             (integerp (floor x y)))
+    :rule-classes (:rewrite :type-prescription))
+  
+  (defthm floor-nat
+    (implies (and (integerp x)
+                  (<= 0 x)
+                  (integerp y)
+                  (<= 0 y))
+             (<= 0 (floor x y)))
+    :rule-classes (:linear :rewrite)))
+
+(in-theory (disable rem floor))#|ACL2s-ToDo-Line|#
+
diff -Nru acl2-6.2/books/cgen/simple-graph-array.lisp acl2-6.3/books/cgen/simple-graph-array.lisp
--- acl2-6.2/books/cgen/simple-graph-array.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/simple-graph-array.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,437 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book t :ttags :all);$ACL2s-Preamble$|#
+
+;Author: Harsh Raju Chamarthi (harshrc)
+
+(in-package "DEFDATA")
+(include-book "utilities" :load-compiled-file :comp)
+(include-book "ordinals/lexicographic-ordering-without-arithmetic" :dir :system)
+
+(defun make-n-upto-list (size ans)
+;make a list of natural numbers upto (size-1)
+;(make-n-upto-list 3 nil) ==> (0 1 2)
+  (declare (xargs :guard (and (natp size)
+                              (nat-listp ans))))
+  (if (zp size)
+    ans
+    (make-n-upto-list  (1- size) (cons (1- size) ans))))  
+
+(set-verify-guards-eagerness 0)
+
+
+(defmacro in (a X) 
+  `(member-equal ,a ,X))
+
+(defun vertex-indexes (vs sym-lst)
+;returns a natural number which is associated with
+;v in mapping. vs is the original symbol-list
+;used to create mapping
+ (declare (xargs :guard (and (symbol-listp vs)
+                             (symbol-listp sym-lst)
+                             (subsetp vs sym-lst))))
+ (if (endp vs)
+     nil
+   (cons (position (car vs) sym-lst)
+         (vertex-indexes (cdr vs) sym-lst))))
+
+(defstobj g$
+  (adj-list-array :type (array T (0))
+                  :initially nil
+                  :resizable t)
+  :renaming ((adj-list-arrayi ai)
+             (update-adj-list-arrayi ui))
+  :doc "Graph represented as an adjacency list array.
+        Key is vertex-index.
+        Value is a record with the following fields:
+        :name - (symbol) name of the vertex
+        :adj - (nat-list) list of indexes of adjacent vertices
+        :seen - boolean (bit) indicating wether this vertex has been visited
+        :cc - (nat) indicating the connected component this vertex belongs to"
+  :inline t)
+
+(defrec vinfo%
+  (name adj seen cc)
+  NIL)
+
+
+(defmacro make-g$-array-value (name &key adj seen cc)
+ `(acl2::make vinfo%
+     :name ,name
+     :adj ,adj
+     :seen ,seen
+     :cc ,(or cc 0)))
+
+(defun symbol-alst->g$1 (alst vs g$)
+ (declare (xargs :stobjs (g$)
+                 :guard (and (symbol-alistp alst)
+                            (symbol-listp vs)
+                            (g$p g$)
+                            )))
+;transforms a symbol-alist graph adjacency list representation
+;to an g$ adjacency list representation.
+ (if (endp alst)
+     g$
+   (b* (((cons v adj-vs) (car alst))
+        ((list i) (vertex-indexes (list v) vs))
+        (adj-is (vertex-indexes adj-vs vs))
+        (g$ (ui i (make-g$-array-value v :adj adj-is) g$)))
+     (symbol-alst->g$1 (cdr alst) vs g$))))
+
+
+(defun init-g$1 (i vs g$)
+ (declare (xargs :stobjs (g$)
+                 :guard (and (symbol-listp vs)
+                             (g$p g$)
+                             )))
+;intializes a g$ to a graph with no edges
+ (if (endp vs)
+     g$
+     (let ((g$ (ui i (make-g$-array-value (car vs)) g$)))
+       (init-g$1 (1+ i) (cdr vs) g$))))
+
+(defun init-g$ (vs size g$)
+  ";intializes/resets a g$ to a graph with no edges"
+  (declare (xargs :stobjs (g$)
+                  :guard (and (symbol-listp vs)
+                              (= (len vs) size)
+                              (g$p g$)
+                              )))
+  (let ((g$ (resize-adj-list-array size g$)))
+    (init-g$1 0 vs g$)))
+#||
+(defun reset-g$-aux (l g$)
+  (if (zp l)
+      g$
+    (reset-g$-aux (1- l)
+                  ;;index corresponding to l is (1- l) which is the last
+                  ;;element initially
+                  (ui (1- l) nil g$))))
+
+(defun reset-g$ (g$)
+  "reset the information stored for each vertice"
+  (reset-g$-aux (adj-list-array-length g$) g$))
+||#
+
+(defun symbol-alist->g$ (alst g$)
+"top-level call to populate g$ with adj-list information obtained
+from alst. Assumption: (len alst) = number of vertices in graph and
+[strip-cars alst] has distinct vertices"
+ (declare (xargs :stobjs (g$)
+                 :guard (and (symbol-alistp alst)
+                             (g$p g$))))
+                 
+ (b* ((vs (strip-cars alst))
+      (size (len alst))
+      (g$ (init-g$ vs size g$)))
+   (symbol-alst->g$1 alst 
+                     vs ;find position (index)
+                     g$
+                     )))
+
+(set-well-founded-relation acl2::l<)
+
+
+
+;Dasgupta Algo
+;Vertices are natural numbers.
+(defun dfs-visit1 (g$ v n fin flag)
+"explore the graph g$ (adj-list array) starting at v.
+n is the number of vertices of g$ not seen,
+initially it is just the total number of vertices.
+fin is the list of finished vertices, with the
+(car fin) being the last finished vertice, i.e
+the vertice with the maximum post time."
+  (declare (xargs :stobjs (g$)
+                  :guard (and (g$p g$)
+                              (or (natp v);vertice
+                                  (nat-listp v));vertices
+                              (nat-listp fin)
+                              (natp n))
+                  :measure (list (nfix n) (acl2-count v))))
+  (if (zp n);visited all vertices
+      (mv g$ fin)
+    (if (equal 'dfs-visit flag)
+;DFS-VISIT
+        (b* ((v-entry (ai v g$))
+             (adj-vs (acl2::access vinfo% v-entry :adj))
+             (g$ (ui v (acl2::change vinfo% v-entry :seen t) g$));update/change seen
+             ((mv g$ fin!)
+              (dfs-visit1 g$ adj-vs (1- n) fin 'dfs-visit-lst)))
+          ;;update finished vertices
+          (mv g$ (cons v fin!)))
+;DFS-VISIT-LST
+      (if (endp v);visited all neighbours
+          (mv g$ fin)
+        (b* ((v-entry (ai (car v) g$))
+             ;(- (cw "dfs-visit-lst: v-entry for ~x0 is ~x1~%" (car v) v-entry))
+             )
+          (if (acl2::access vinfo% v-entry :seen);already seen
+              (dfs-visit1 g$ (cdr v) n fin 'dfs-visit-lst)
+            (b* (((mv g$ fin!)
+                  (dfs-visit1 g$ (car v) n fin 'dfs-visit)))
+              (dfs-visit1 g$ (cdr v) n fin! 'dfs-visit-lst))))))))
+        
+
+(defun dfs-all-vertices (g$ vs n fin cnum) 
+  "Do DFS over all vertices in vs"
+  (declare (xargs :stobjs (g$)
+                  :guard (and (g$p g$)
+                              (nat-listp vs);vertices
+                              (nat-listp fin)
+                              (natp cnum)
+                              (natp n))))
+ 
+  (if (endp vs);visited all neighbours
+      (mv g$ fin)
+      (b* ((v-entry (ai (car vs) g$)))
+           ;(- (cw "dfs-all: v-entry for ~x0 is ~x1~%" (car vs) v-entry)))
+        (if (acl2::access vinfo% v-entry :seen);already seen
+            (dfs-all-vertices g$ (cdr vs) n fin cnum)
+        (b* ((g$ (ui (car vs) 
+                     (acl2::change vinfo% v-entry :cc cnum)
+                     g$))
+             ((mv g$ fin!) 
+              (dfs-visit1 g$
+                          ;;update current component as part of pre 
+                          (car vs) n fin 
+                          'dfs-visit)))
+          (dfs-all-vertices g$ (cdr vs) n fin! (1+ cnum)))))))
+
+
+(defun dfs1 (g$ vs)
+;Depth First Search on adj list array g$ iterating
+;over the vertices in vs.
+  (declare (xargs :stobjs (g$)
+                  :guard (and (nat-listp vs)
+                              (g$p g$))))
+  (dfs-all-vertices g$ vs (adj-list-array-length g$) nil 0))
+
+;(defdata adjacency-list (map symbol symbol-list))
+(defun adjacency-list1p (v)
+  (if (null v)
+      t
+    (if (atom v)
+        nil
+      (let ((entry (car v)))
+      (and (symbolp (car entry))
+           (symbol-listp (cdr entry))
+           (no-duplicatesp (cdr entry))
+           (adjacency-list1p (cdr v)))))))
+
+(defun adjacency-listp (v)
+  (and (adjacency-list1p v)
+       (no-duplicatesp (strip-cars v))))
+
+(defun make-empty-adj-list (vars)
+  (declare (xargs :guard (and (symbol-listp vars)
+                              (no-duplicatesp vars))))
+  ;order important 
+  ;order of keys alst created is the same as order of vars
+  (if (endp vars)
+    nil
+    (cons (cons (car vars) nil)
+          (make-empty-adj-list (cdr vars)))))
+
+
+
+;fs means Functionaly dependent vars
+;ASSUMPTION: alst has all the variables as keys already
+;this function just updates the entries, doesnt insert
+;new entries.
+(defun union-entry-in-adj-list (var fvars alst)
+  (declare (xargs :guard (and (adjacency-listp alst)
+                              (true-listp fvars))))
+  (if (endp alst)
+      nil
+    (if (eq var (caar alst))
+      (cons (cons var (union-equal fvars 
+                                   (cdar alst)))
+            (cdr alst))
+      (cons (car alst)
+            (union-entry-in-adj-list var fvars (cdr alst))))))
+  
+  
+;recurse above fun over list of indices
+(defun union-entries-in-adj-list (is fis alst)
+ (declare (xargs :guard (and (adjacency-listp alst)
+                             (true-listp is)
+                             (true-listp fis))))
+ (if (endp is)
+    alst
+    (union-entries-in-adj-list 
+     (cdr is) fis (union-entry-in-adj-list (car is) fis alst))))
+
+  
+(defun transpose-alst1 (alst ans)
+;Scan G at index i and transpose the result corresponding to i in ans
+  (declare (xargs :guard (and (adjacency-listp alst)
+                              (adjacency-listp ans)
+                              )))
+  (if (endp alst)
+      ans
+    (b* (((cons v vs) (car alst)))
+      (transpose-alst1 (cdr alst)
+                       (union-entries-in-adj-list vs (list v) ans)))))
+  
+
+(defun transpose-alst (alst)
+;Return transpose/reverse of alst
+;INVARIANT: Order is very important
+  (declare (xargs :guard (adjacency-listp alst)))
+  (transpose-alst1 alst (make-empty-adj-list (strip-cars alst))))
+#|
+(defthm transpose-idempotent
+  (implies (adjacency-list1p x)
+           (equal (transpose-alst (transpose-alst x))
+                  x)))
+
+(defthm transpose-doesnt-change-order
+  (implies (adjacency-list1p x)
+           (equal (strip-cars (transpose-alst x))
+                  (strip-cars x))))
+|#
+
+
+
+
+(defun scc1 (alst g$)
+;Strongly Connected Components of adj list array G,
+;alst is the same adj-list, but in form of an alist
+  (declare (xargs :stobjs (g$)
+                  :guard (and (symbol-alistp alst)
+                              (adjacency-listp alst)
+                              (g$p g$))))
+  (b* ((r-alst (transpose-alst alst))
+       (g$ (symbol-alist->g$ r-alst g$))
+       (N (adj-list-array-length g$))
+       ((mv g$ fin) (dfs1 g$ (make-n-upto-list N nil)))
+       (g$ (symbol-alist->g$ alst g$))
+       ((mv g$ fin!) (dfs1 g$ fin)))
+    (mv g$ fin!)))
+
+
+(defun g$->var-quotient-alst1 (g$ i size ans)
+  "Given graph g$, where g$[v]=(record name adj-is seenBit ccnum), we will
+return, symbol alist, which maps each vertex (name), to its component
+number (ccnum). This is used in simple-var-hyp? for finding cycles."
+  (declare (xargs  :stobjs (g$)
+                   :measure (nfix (- size i))
+                   :guard (and (natp i) (natp size)
+                               (<= i size))))
+  (if (zp (- size i))
+      ans
+    (let ((v-entry (ai i g$)))
+      (g$->var-quotient-alst1 g$ (1+ i) size
+                             (acons (acl2::access vinfo% v-entry :name) 
+                                    (acl2::access vinfo% v-entry :cc)
+                                    ans)))))
+
+(defun g$->var-quotient-alst (g$)
+  (declare (xargs :stobjs (g$)))
+  (g$->var-quotient-alst1 g$ 0 (adj-list-array-length g$) nil))
+
+(defun vertex-names (is g$)
+  (declare (xargs :stobjs (g$)
+                  :guard (nat-listp is)))
+  (if (endp is)
+      nil
+    (cons (acl2::access vinfo% (ai (car is) g$) :name)
+          (vertex-names (cdr is) g$))))
+
+(defun g$->alst1 (g$ i size ans)
+  (declare (xargs  :stobjs (g$)
+                   :measure (nfix (- size i))
+                   :guard (and (natp i) (natp size)
+                               (<= i size))))
+  (if (zp (- size i))
+      ans
+    (let ((v-entry (ai i g$)))
+      (g$->alst1 g$ (1+ i) size
+                    (acons (acl2::access vinfo% v-entry :name) 
+                           (vertex-names (acl2::access vinfo% v-entry :adj) g$)
+                           ans)))))
+
+(defun g$->symbol-alist (g$)
+  (declare (xargs  :stobjs (g$)))
+  (g$->alst1 g$ 0 (adj-list-array-length g$) nil))
+
+
+(defun scc0 (alst g$)
+  (declare (xargs :stobjs (g$)
+                  :guard (symbol-alistp alst)))
+  (mv-let (g$ fin)
+          (scc1 alst g$)
+          (mv (g$->var-quotient-alst g$) 
+              (vertex-names fin g$)
+              (g$->symbol-alist g$)
+              g$)))
+
+(defun fix-adjacency-list (alst)
+  (declare (xargs :guard (adjacency-listp alst)))
+  "Fix an adjacency list to have in it keys all the vertices."
+  (b* ((adj-v-lst-lst (strip-cdrs alst))
+       (vs (strip-cars alst))
+       (adj-vs (union-lsts adj-v-lst-lst))
+       (missing-vs (set-difference-eq adj-vs vs))
+       (missing-alst (pairlis$ missing-vs nil)))
+    (append alst missing-alst)))
+
+(defun strongly-connected-components (alst debug-flag)
+   "Strongly Connected Components of adj list graph alst.
+Gives (mv map-ccnum finished-vertex-list) as result, where
+map-ccnum, maps each vertex to its component number. 
+finished-vertex-list gives the list of vertexes in decreasing
+post times."
+   (declare (xargs :guard (adjacency-listp alst)))
+    (b* ((alst! (fix-adjacency-list alst))
+         (- (cw? (and (not (equal alst alst!))
+                               debug-flag)
+            "CEgen/Note: SCC: Got Adjacency list : ~x0 Fixed to : ~x1~%" alst alst!)))
+      (acl2::with-local-stobj 
+       g$
+       
+       (mv-let (var-ccnum-alst decreasing-post-times-vertex-lst adj-alst g$)
+               (scc0 alst! g$)
+               (mv var-ccnum-alst 
+                   decreasing-post-times-vertex-lst
+                   adj-alst)))))
+   
+;to check simple soundness (g$->symbol-alist g$) = alst!
+  
+(defun approximate-topological-sort (alst debug-flag)
+;return vertices following the order ->, but
+;since alst might not be a dag, the order 
+;inside a component might be skewed, but we
+;are okay with it, since we choose arbitrarily
+;from within a component 
+  (declare (xargs :guard (adjacency-listp alst)))
+  (b* (((mv & fin-vs &) 
+        (strongly-connected-components alst debug-flag)))
+    fin-vs))
+       
+
+
+
+#|
+
+;example:
+;(untrace$ dfs dfs-visit dfs-all-vertices)
+(let* ((A '((a b)
+            (b e c d)
+            (c f)
+            (d)
+            (e b g f)
+            (f c h)
+            (g j h )
+            (h k)
+            (i g)
+            (j i)
+            (k l)
+            (l j))))
+  (approximate-topological-sort A))
+;ans:(A B E C F D G H K L J I)
+;ans by memories graph.lisp: (A B E C F D G H K L J I)
+|#  
+;What correctness theorems can we prove?
diff -Nru acl2-6.2/books/cgen/splitnat.lisp acl2-6.3/books/cgen/splitnat.lisp
--- acl2-6.2/books/cgen/splitnat.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/splitnat.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,866 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+
+(acl2::begin-book);$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+
+(set-verify-guards-eagerness 2)
+(set-state-ok t)
+
+(include-book "num-list-fns" :load-compiled-file :comp)
+
+(local (include-book "num-list-thms"))
+
+(local (include-book "rem-and-floor"))
+
+(defun weighted-split-nat-step (weights x old-results)
+  (declare (xargs :guard (and (2+-listp weights)
+                              (natp x)
+                              (naturals-listp old-results)
+                              (= (len weights) (len old-results)))))
+  (if (mbe :logic (or (endp weights)
+                      (endp old-results))
+           :exec (endp weights))
+    nil
+    (let ((weight (car weights)))
+      (cons (+ (* weight (car old-results))
+               (rem x weight))
+            (weighted-split-nat-step (cdr weights)
+                                     (floor x weight)
+                                     (cdr old-results))))))
+
+
+(local (defthm weighted-split-nat-step--true-listp
+         (true-listp (weighted-split-nat-step w x r))
+         :rule-classes (:type-prescription :rewrite)))
+
+(local (defthm weighted-split-nat-step--len
+         (equal (len (weighted-split-nat-step w x r))
+                (min (len w) (len r)))))
+
+(local (defthm weighted-split-nat-step--nat-listp
+         (implies (and (naturals-listp w)
+                       (integerp x)
+                       (<= 0 x)
+                       (naturals-listp r))
+                  (naturals-listp (weighted-split-nat-step w x r)))
+         :rule-classes (:type-prescription :rewrite)))
+
+(local (defthm weighted-split-nat-step--consp
+         (implies (and (consp w)
+                       (consp r))
+                  (consp (weighted-split-nat-step w x r)))
+         :rule-classes (:type-prescription :rewrite)))
+
+
+(local (defthm weighted-split-nat-step--bound-old
+         (implies (and (2+-listp w)
+                       (integerp x)
+                       (<= 0 x)
+                       (naturals-listp r)
+                       (equal (len w) (len r)))
+                  (<=-lists (weighted-split-nat-step w x r)
+                            (+-lists
+                             (*-lists r
+                                      w)
+                             w)))
+         :rule-classes (:rewrite)))
+
+
+(local
+ (encapsulate nil
+   (local (include-book "arithmetic-5/top" :dir :system))
+   
+   (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
+                                acl2::STABLE-UNDER-SIMPLIFICATIONP
+                                acl2::HIST
+                                acl2::PSPV))))
+
+  (defthm <=-lists--scale
+           (implies (and (rationalp v)
+                         (<= 0 v)
+                         (rationalp w)
+                         (<= v w)
+                         (naturals-listp l))
+                    (<=-lists (scale l v)
+                              (scale l w))))
+
+  (defthm <=-lists--scale2
+           (implies (and (<=-lists l1
+                                   (scale l2 v))
+                         (rationalp v)
+                         (<= 0 v)
+                         (rationalp w)
+                         (<= v w)
+                         (naturals-listp l2))
+                    (<=-lists l1
+                              (scale l2 w))))
+
+  (defthm <=-lists--scale3
+           (implies (and (rationalp v)
+                         (<= 0 v)
+                         (naturals-listp l1)
+                         (naturals-listp l2)
+                         (<=-lists l1 l2))
+                    (<=-lists (scale l1 v)
+                              (scale l2 v))))
+
+  (defthm <=-lists--scale4
+           (implies (and (rationalp v1)
+                         (<= 0 v1)
+                         (rationalp v2)
+                         (<= 0 v2)
+                         (naturals-listp l1)
+                         (naturals-listp l2)
+                         (<=-lists l1 l2)
+                         (<= v1 v2))
+                    (<=-lists (scale l1 v1)
+                              (scale l2 v2))))
+
+  
+  (defthm <=-lists--shift
+    (implies (and (rationalp v)
+                  (rationalp w)
+                  (<= v w)
+                  (rational-listp l))
+             (<=-lists (shift l v)
+                       (shift l w))))
+
+  (defthm <=-lists--shift2
+    (implies (and (<=-lists l1
+                            (shift l2 v))
+                  (rationalp v)
+                  (rationalp w)
+                  (<= v w)
+                  (rational-listp l2))
+             (<=-lists l1
+                       (shift l2 w))))
+
+  (defthm <=-lists--shift3
+           (implies (and (rationalp v)
+                         (rational-listp l1)
+                         (rational-listp l2)
+                         (<=-lists l1 l2))
+                    (<=-lists (shift l1 v)
+                              (shift l2 v))))
+
+  (defthm <=-lists--shift4
+           (implies (and (rationalp v1)
+                         (rationalp v2)
+                         (rational-listp l1)
+                         (rational-listp l2)
+                         (<=-lists l1 l2)
+                         (<= v1 v2))
+                    (<=-lists (shift l1 v1)
+                              (shift l2 v2))))
+  ))
+
+(local (defthm shift--<=
+         (equal (<=-lists (shift l v1)
+                          (shift l v2))
+                (or (endp l)
+                    (<= v1 v2)))))
+
+(local (defthm weighted-split-nat-step--bound
+         (implies (and (2+-listp w)
+                       (integerp x)
+                       (<= 0 x)
+                       (naturals-listp r)
+                       (equal (len w) (len r)))
+                  (<=-lists (weighted-split-nat-step w x r)
+                            (shift
+                             (*-lists r w)
+                             x)))))
+
+(local
+ (encapsulate nil
+   (local (include-book "arithmetic-5/top" :dir :system))
+   
+   (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
+                                acl2::STABLE-UNDER-SIMPLIFICATIONP
+                                acl2::HIST
+                                acl2::PSPV))))
+   
+   (defthm weighted-split-nat-step--bound2--lemma
+     (implies (and (naturals-listp r)
+                   (2+-listp w)
+                   (equal (len r) (len w)))
+              (<=-lists (*-lists r w)
+                        (scale r (product-list w)))))))
+
+
+(local
+ (encapsulate nil
+   (local (defthm <=-lists--transitive--force
+            (implies (and (<=-lists a b)
+                          (force (<=-lists b c)))
+                     (<=-lists a c))
+            :rule-classes ((:rewrite :match-free :all))))
+
+  (local (defthm <=-lists--scale4--force
+           (implies (and (rationalp v1)
+                         (<= 0 v1)
+                         (rationalp v2)
+                         (<= 0 v2)
+                         (naturals-listp l1)
+                         (naturals-listp l2)
+                         (force (<=-lists l1 l2))
+                         (force (<= v1 v2)))
+                    (<=-lists (scale l1 v1)
+                              (scale l2 v2)))))
+
+  (local (defthm <=-lists--shift4--force
+           (implies (and (rationalp v1)
+                         (rationalp v2)
+                         (rational-listp l1)
+                         (rational-listp l2)
+                         (force (<=-lists l1 l2))
+                         (force (<= v1 v2)))
+                    (<=-lists (shift l1 v1)
+                              (shift l2 v2)))))
+   
+  (local (include-book "arithmetic-5/top" :dir :system))
+  
+  (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
+                               acl2::STABLE-UNDER-SIMPLIFICATIONP
+                               acl2::HIST
+                               acl2::PSPV))))
+
+   (defthm weighted-split-nat-step--bound2
+     (implies (and (2+-listp w)
+                   (integerp x)
+                   (<= 0 x)
+                   (naturals-listp r)
+                   (equal (len w) (len r)))
+              (<=-lists (weighted-split-nat-step w x r)
+                        (shift
+                         (scale r (product-list w))
+                         x))))))
+
+
+(local
+ (defthm get-weights-factor-->=2
+   (implies (and (2+-listp x)
+                 (consp x))
+            (<= 2 (product-list x)))
+   :rule-classes (:linear :rewrite)))
+
+
+(defun rot-list (x)
+  (declare (xargs :guard (and (true-listp x)
+                              (consp x))))
+  (append (cdr x) (list (car x))))
+
+(local
+ (defthm rot-list--consp
+   (implies (consp x)
+            (consp (rot-list x)))
+   :rule-classes (:type-prescription :rewrite)))
+
+(local (defthm consp-cdr-append
+         (implies (and (consp x)
+                       (consp y))
+                  (consp (cdr (append x y))))))
+
+(local
+ (defthm rot-list--consp-cdr
+   (implies (and (consp x)
+                 (consp (cdr x)))
+            (consp (cdr (rot-list x))))
+   :rule-classes (:type-prescription :rewrite)))
+
+(local
+ (defthm len-append-single
+   (equal (len (append x (list y)))
+          (+ 1 (len x)))))
+
+(local
+ (defthm rot-list--len
+   (implies (consp x)
+            (equal (len (rot-list x))
+                   (len x)))))
+
+(local (defthm rot-list--nat-listp
+         (implies (and (naturals-listp x)
+                       (consp x))
+                  (naturals-listp (rot-list x)))))
+
+(local (defthm rot-list--2+-listp
+         (implies (and (2+-listp x)
+                       (consp x))
+                  (2+-listp (rot-list x)))))
+
+(local (defthm rot-list--product-list
+         (implies (consp x)
+                  (equal (product-list (rot-list x))
+                         (product-list x)))))
+
+(local (defthm all-<=--rot-list
+         (implies (consp l)
+                  (equal (all-<= (rot-list l)
+                                 x)
+                         (all-<= l
+                                 x)))))
+
+(local (in-theory (disable rot-list)))
+
+(defun weighted-split-nat1 (weights weights-factor x)
+  (declare (xargs :measure (nfix x)
+                  :verify-guards nil
+                  :guard (and (2+-listp weights)
+                              (equal weights-factor (product-list weights))
+                              (consp weights)
+                              (natp x))))
+  (if (mbe :logic (or (zp x)
+                      (endp weights)
+                      (not (equal weights-factor (product-list weights)))
+                      (not (2+-listp weights)))
+           :exec (zp x))
+    (make-list (len weights) :initial-element 0)
+    (weighted-split-nat-step weights
+                             (rem x weights-factor)
+                             (rot-list
+                              (weighted-split-nat1
+                               (rot-list weights)
+                               weights-factor
+                               (floor x weights-factor))))))
+
+(local
+ (defthm weighted-split-nat1--consp
+   (implies (consp weights)
+            (consp (weighted-split-nat1 weights weights-factor x)))))
+
+(local
+ (defthm weighted-split-nat1--len
+   (equal (len (weighted-split-nat1 weights weights-factor x))
+          (len weights))))
+
+(local
+ (defthm weighted-split-nat1--nat-listp
+   (implies (and (2+-listp weights)
+                 (consp weights)
+                 (equal weights-factor (product-list weights))
+                 (integerp x)
+                 (<= 0 x))
+            (naturals-listp (weighted-split-nat1 weights weights-factor x)))
+   :rule-classes ((:rewrite)
+                  (:rewrite :corollary
+                   (implies (and (2+-listp weights)
+                                 (consp weights)
+                                 (equal weights-factor (product-list weights))
+                                 (integerp x)
+                                 (<= 0 x))
+                            (true-listp (weighted-split-nat1 weights weights-factor x)))))))
+
+(verify-guards weighted-split-nat1)
+
+(local
+ (defthm weighted-split-nat1--<=-induction-step1
+   (implies (and (2+-listp weights)
+                 (consp weights)
+                 (integerp x)
+                 (<= 0 x))
+            (<=-lists (weighted-split-nat-step
+                       weights
+                       (rem x (product-list weights))
+                       (rot-list (weighted-split-nat1 (rot-list weights)
+                                                      (product-list weights)
+                                                      (floor x (product-list weights)))))
+                      (shift
+                       (scale (rot-list (weighted-split-nat1 (rot-list weights)
+                                                             (product-list weights)
+                                                             (floor x (product-list weights))))
+                              (product-list weights))
+                       (rem x (product-list weights)))))
+   :rule-classes nil))
+
+(local
+ (encapsulate nil
+   (local (include-book "arithmetic-3/top" :dir :system))
+   
+   (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
+                                acl2::STABLE-UNDER-SIMPLIFICATIONP
+                                acl2::HIST
+                                acl2::PSPV))))
+   
+   (local (defthm all-<=--shift
+            (equal (all-<= (shift l v)
+                           x)
+                   (all-<= l
+                           (- x v)))))
+   
+   (local (defthm all-<=--scale
+            (implies (and (rationalp v)
+                          (< 0 v))
+                     (equal (all-<= (scale l v)
+                                    x)
+                            (all-<= l
+                                    (/ x v))))))
+
+   (local (defthm blah
+            (implies (and (equal n (len l)) 
+                          (<=-lists l
+                                    (make-list-logic x n))
+                          (force (<= x y)))
+                     (all-<= l
+                             y))))
+
+   (defthm weighted-split-nat1--<=-induction-step2
+     (implies (and (2+-listp weights)
+                   (consp weights)
+                   (integerp x)
+                   (<= 0 x)
+                   (all-<= (weighted-split-nat1 (rot-list weights)
+                                                (product-list weights)
+                                                (floor x (product-list weights)))
+                           (floor x (product-list weights))))
+              (all-<= (shift
+                       (scale (rot-list (weighted-split-nat1 (rot-list weights)
+                                                             (product-list weights)
+                                                             (floor x (product-list weights))))
+                              (product-list weights))
+                       (rem x (product-list weights)))
+                      x))
+     :rule-classes nil)))
+
+(local
+ (defthm weighted-split-nat1--<=--consp
+   (implies (and (2+-listp weights)
+                 (consp weights)
+                 (equal weights-factor (product-list weights))
+                 (integerp x)
+                 (<= 0 x))
+            (all-<= (weighted-split-nat1 weights weights-factor x) x))
+   :hints (("Goal" :in-theory (disable len 2+-listp product-list)
+                   :do-not '(eliminate-destructors)
+                   :induct t)
+           ("Subgoal *1/2.1"
+            :use ((:instance weighted-split-nat1--<=-induction-step1)
+                  (:instance weighted-split-nat1--<=-induction-step2))))))
+
+(local
+ (defthm weighted-split-nat1--<=--endp
+   (implies (not (consp weights))
+            (all-<= (weighted-split-nat1 weights weights-factor x) x))))
+ 
+(local
+ (defthm weighted-split-nat1--<=
+   (implies (and (2+-listp weights)
+                 (equal weights-factor (product-list weights))
+                 (integerp x)
+                 (<= 0 x))
+            (all-<= (weighted-split-nat1 weights weights-factor x) x))
+   :hints (("Goal" :cases ((consp weights))))))
+
+#|
+(defun pos-list-fix (x)
+  (if (atom x)
+    nil
+    (cons
+     (if (posp (car x))
+       (car x)
+       1)
+     (pos-list-fix (cdr x)))))
+|#
+
+(defthm pos-listp--pos-list-fix
+  (pos-listp (pos-list-fix x))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm len--pos-list-fix
+  (equal (len (pos-list-fix x))
+         (len x)))
+
+(defthm pos-list-fix--shortcut
+  (implies (pos-listp x)
+           (equal (pos-list-fix x)
+                  x)))
+
+(defun non-empty-pos-list-fix (x)
+  (if (atom x)
+    (list 1)
+    (pos-list-fix x)))
+
+(defthm len--non-empty-pos-list-fix
+  (equal (len (non-empty-pos-list-fix x))
+         (max 1 (len x))))
+
+(defthm consp--non-empty-pos-list-fix
+  (consp (non-empty-pos-list-fix x))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm pos-listp--non-empty-pos-list-fix
+  (pos-listp (non-empty-pos-list-fix x))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm non-empty-pos-list-fix--shortcut
+  (implies (and (pos-listp x)
+                (consp x))
+           (equal (non-empty-pos-list-fix x)
+                  x)))
+
+(in-theory (disable non-empty-pos-list-fix))
+
+(defun weighted-split-nat (weights x)
+  (declare (xargs :measure (nfix x)
+                  :guard (and (pos-listp weights)
+                              (consp weights)
+                              (natp x))))
+  (mbe :exec
+       (let ((2+-weights (scale weights 2)))
+         (weighted-split-nat1 2+-weights (product-list 2+-weights) x))
+       :logic
+       (let* ((weights (non-empty-pos-list-fix weights))
+              (x (nfix x))
+              (2+-weights (scale weights 2)))
+         (weighted-split-nat1 2+-weights (product-list 2+-weights) x))))
+
+(local ; weighted-split-nat will later be automatically rewritten, so these
+       ; become useless 
+ (defthm weighted-split-nat--len
+   (equal (len (weighted-split-nat weights x))
+          (max 1 (len weights)))))
+
+(local
+ (defthm weighted-split-nat--consp
+   (consp (weighted-split-nat weights x))))
+
+
+ (defthm weighted-split-nat--nat-listp
+   (naturals-listp (weighted-split-nat weights x)))
+
+(local (defthm scale--pos-listp--2+-listp
+         (implies (pos-listp l)
+                  (2+-listp (scale l 2)))
+         :rule-classes (:forward-chaining :type-prescription)))
+
+(local
+ (defthm weighted-split-nat--bound
+   (implies (and (integerp x)
+                 (<= 0 x))
+            (all-<= (weighted-split-nat weights x) x))))
+
+(local
+ (defthm car--nat-list--integer
+   (implies (and (consp x)
+                 (naturals-listp x))
+            (integerp (car x)))))
+
+(local
+ (defthm weighted-split-nat--car-integer
+   (INTEGERP (CAR (WEIGHTED-SPLIT-NAT WEIGHTS X)))))
+
+(local
+ (defthm car--nat-list-->=0
+   (implies (and (consp x)
+                 (naturals-listp x))
+            (<= 0 (car x)))))
+
+(local
+ (defthm weighted-split-nat--car->=0
+   (<= 0 (CAR (WEIGHTED-SPLIT-NAT WEIGHTS X)))))
+
+(local
+(defthm not-nat-implies-weighted-split-nat-is-zero
+  (implies (and (not (natp x))
+                (pos-listp ws)
+                (>= (len ws) 1))
+           (equal (weighted-split-nat ws x)
+                  (make-list (len ws) :initial-element 0)))))
+
+
+(in-theory (disable weighted-split-nat))
+
+
+
+
+;(set-verify-guards-eagerness 0)
+(defun nth-weighted-split-nat (i weights x)
+  (declare (xargs :guard nil)) ; logic only
+  ;(declare (xargs :verify-guards nil))
+  (if (and (integerp i)
+           (<= 0 i)
+           (< i (len weights)))
+    (nth i (weighted-split-nat weights x))
+    (car (weighted-split-nat weights x))))
+
+(defun nthcdr-weighted-split-nat (i weights x)
+  (declare (xargs :guard nil)) ; logic only
+  ;(declare (xargs :verify-guards nil))
+  (nthcdr i (weighted-split-nat weights x)))
+
+
+
+(defthm nth-weighted-split-nat--bound
+  (implies (and (integerp x)
+                (<= 0 x))
+           (<= (nth-weighted-split-nat i weights x)
+               x))
+  ;:hints (("Goal" :cases ((all-<= (weighted-split-nat weights x) x))))
+  :rule-classes (:rewrite :linear))
+
+(defthm nat-listp--nth--integerp
+         (implies (and (naturals-listp l)
+                       (integerp i)
+                       (<= 0 i)
+                       (< i (len l)))
+                  (integerp (nth i l)))
+         :rule-classes (:rewrite :type-prescription))
+
+(defthm nth-weighted-split-nat--integerp
+  (integerp (nth-weighted-split-nat i weights x))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm nat-listp--nth-->=0
+         (implies (and (naturals-listp l)
+                       (integerp i)
+                       (<= 0 i)
+                       (< i (len l)))
+                  (<= 0 (nth i l)))
+         :rule-classes (:rewrite :linear))
+
+(defthm nth-weighted-split-nat-->=0
+  (<= 0 (nth-weighted-split-nat i weights x))
+  :rule-classes (:rewrite :linear))
+
+
+(local
+ (defthm nth--nthcdr--decomp
+   (implies (consp l)
+            (equal (cons (nth 0 l)
+                         (nthcdr 1 l))
+                   l))))
+
+(local
+ (defthm len--nthcdr--toobig
+   (implies (and (integerp i)
+                 (<= (len l) i))
+            (equal (len (nthcdr i l))
+                   0))))
+
+(local
+ (defthm len--nthcdr
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= i (len l)))
+            (equal (len (nthcdr i l))
+                   (- (len l) i)))))
+
+(defthm nthcdr-weighted-split-nat--len
+  (equal (len (nthcdr-weighted-split-nat i weights x))
+         (if (zp i)
+           (max 1 (len weights))
+           (if (<= i (len weights))
+             (- (len weights) i)
+             0))))
+
+(local
+ (defthm consp--nthcdr
+   (equal (consp (nthcdr i l))
+          (and (consp l)
+               (implies (integerp i)
+                        (< i (len l)))))))
+
+(defthm nthcdr-weighted-split-nat--consp
+           (equal (consp (nthcdr-weighted-split-nat i weights x))
+                  (implies (integerp i)
+                           (< i (max 1 (len weights))))))
+
+(local
+ (defthm naturals-listp--nthcdr
+   (implies (naturals-listp l)
+            (naturals-listp (nthcdr i l)))
+   :rule-classes (:rewrite :type-prescription)))
+
+(defthm nthcdr-weighted-split-nat--naturals-listp
+  (naturals-listp (nthcdr-weighted-split-nat i weights x)))
+
+
+(defthm weighted-split-nat--to--nthcdr-weighted-split-nat
+  (implies (and (pos-listp weights)
+                (consp weights)
+                (integerp x)
+                (<= 0 x))
+           (equal (weighted-split-nat weights x)
+                  (nthcdr-weighted-split-nat 0 weights x))))
+
+
+
+(local
+ (encapsulate nil
+   (local (include-book "arithmetic-5/top" :dir :system))
+
+   (local
+    (defthm nthcdr--cdr
+      (implies (and (integerp i)
+                    (<= 0 i))
+               (equal (nthcdr i (cdr l))
+                      (nthcdr (+ 1 i) l)))
+      :hints (("Goal" :expand (nthcdr (+ 1 i) l)))))
+
+   (defthm nth--nthcdr--decomp2
+     (implies (and (integerp i)
+                   (<= 0 i)
+                   (< i (len l)))
+              (equal (cons (nth i l)
+                           (nthcdr (+ 1 i) l))
+                     (nthcdr i l))))))
+
+(defthm nthcdr-weighted-split-nat--deflike
+  (implies (and (integerp i)
+                (<= 0 i)
+                (< i (len weights)))
+           (equal (nthcdr-weighted-split-nat i weights x)
+                  (cons (nth-weighted-split-nat i weights x)
+                        (nthcdr-weighted-split-nat (+ 1 i) weights x))))
+  :hints (("Goal" :in-theory (disable nth nthcdr)))
+  :rule-classes ((:definition :controller-alist ((nthcdr-weighted-split-nat t nil nil)))))
+
+(in-theory (disable nth-weighted-split-nat nthcdr-weighted-split-nat)) 
+
+(defthm nthcdr-weighted-split-nat--car
+  (implies (and (integerp i)
+                (<= 0 i)
+                (< i (len weights)))
+           (equal (car (nthcdr-weighted-split-nat i weights x))
+                  (nth-weighted-split-nat i weights x)))
+  :hints (("Goal" :expand (nthcdr-weighted-split-nat i weights x))))
+
+(defthm nthcdr-weighted-split-nat--cdr
+  (implies (and (integerp i)
+                (<= 0 i)
+                (< i (len weights)))
+           (equal (cdr (nthcdr-weighted-split-nat i weights x))
+                  (nthcdr-weighted-split-nat (+ 1 i) weights x)))
+  :hints (("Goal" :expand (nthcdr-weighted-split-nat i weights x))))
+
+(local
+ (defthm len-exceeding-return-nil
+   (implies (and (natp i)
+                 (<= (len l) i))
+            (equal (nth i l) nil))))
+(local 
+ (defthm make-list-logic-len
+   (implies (natp i)
+            (equal (len (make-list-logic a i))
+                   i))))
+
+(defun nth-returns-elem-of-make-list-ind-scheme (i x)
+  (declare (xargs :guard (and (natp i) (natp x))))
+  (if (or (zp i) (zp x))
+    0
+    (nth-returns-elem-of-make-list-ind-scheme (- i 1) (- x 1))))
+
+(local
+ (defthm nth-returns-elem-of-make-list
+   (implies (and (natp i)
+                 (natp x)
+                 (< i x))
+            (equal (nth i (make-list-logic a x)) a))
+ :hints (("Goal" :induct 
+                 (nth-returns-elem-of-make-list-ind-scheme i x)))))
+#|
+;Above lemmas should help prove this
+(defthm nth-i-split-nat-<=
+  (implies (and (pos-listp ws)
+                (>= (len ws) 1))
+       (<= (nth i (weighted-split-nat ws x)) (nfix x)))
+  :hints (("Goal" :cases ((< i (len ws)))))
+ :rule-classes (:rewrite :linear))
+|#
+
+;ADDED some hack defthms to help termination of recursive records with
+;more than 3 fields.
+(defthm nth-i-split-nat-3-<=
+ ;(implies (and (integerp x)
+ ;              (<= 0 x))
+          (<= (nth i (weighted-split-nat '(1 1 1) (nfix x))) (nfix x))
+ :rule-classes (:rewrite :linear))
+
+(defthm nth-i-split-nat-4-<=
+ ;(implies (and (integerp x)
+ ;              (<= 0 x))
+          (<= (nth i (weighted-split-nat '(1 1 1 1) (nfix x))) (nfix x))
+ :rule-classes (:rewrite :linear))
+
+(defthm nth-i-split-nat-5-<=
+ ;(implies (and (integerp x)
+ ;              (<= 0 x))
+          (<= (nth i (weighted-split-nat '(1 1 1 1 1) (nfix x))) (nfix x))
+ :rule-classes (:rewrite :linear))
+
+(defthm nth-i-split-nat-6-<=
+ ;(implies (and (integerp x)
+ ;              (<= 0 x))
+          (<= (nth i (weighted-split-nat '(1 1 1 1 1 1) (nfix x))) (nfix x))
+ :rule-classes (:rewrite :linear))
+
+; testing theorems
+
+#|
+(thm
+ (implies (natp x)
+          (natp (cadr (weighted-split-nat '(3 2 4) x)))))
+(thm
+ (implies (and (natp n) (natp x))
+          (<= (nth i (weighted-split-nat '(1 1 1) x)) x)))
+;|#
+
+; testing
+
+#|
+(defun weighted-split-nat-downfrom (weights n)
+  (declare (xargs :guard (and (pos-listp weights)
+                              (consp weights)
+                              (natp n))))
+  (if (zp n)
+    (list (list 0 '-> (weighted-split-nat weights 0)))
+    (cons (list n '-> (weighted-split-nat weights n))
+          (weighted-split-nat-downfrom weights (- n 1)))))
+
+(defun weighted-split-nat-upto (weights n)
+  (declare (xargs :guard (and (pos-listp weights)
+                              (consp weights)
+                              (natp n))))
+  (reverse (weighted-split-nat-downfrom weights n)))
+
+;(trace$ weighted-split-nat-step-tail)
+(weighted-split-nat-upto '(1 1) 33)
+
+;|#
+
+
+; alternative interface
+
+(defthm pos-listp--list-expt--2
+  (implies (naturals-listp l)
+           (pos-listp (list-expt 2 l)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defun pow-weighted-split-nat (pow-weights x)
+  (declare (xargs :guard (and (pos-listp pow-weights)
+                              (consp pow-weights)
+                              (natp x))))
+  (let ((2**weights (list-expt 2 pow-weights)))
+    (weighted-split-nat1 2**weights (product-list 2**weights) x)))
+
+(defun split-nat (nways x)
+  (declare (xargs :guard (and (posp nways)
+                              (natp x))))
+  (weighted-split-nat (make-list nways :initial-element 1) x))
+
+(defthm split-nat--naturals-listp
+  (naturals-listp (split-nat nways x))
+   :rule-classes :type-prescription)
+
+
+(defthm naturals-listp--true-listp
+  (implies (naturals-listp x)
+           (true-listp x))
+   :rule-classes (:rewrite :forward-chaining))#|ACL2s-ToDo-Line|#
+
+
+
diff -Nru acl2-6.2/books/cgen/switchnat.lisp acl2-6.3/books/cgen/switchnat.lisp
--- acl2-6.2/books/cgen/switchnat.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/switchnat.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,278 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(acl2::begin-book);$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+
+(set-verify-guards-eagerness 2)
+
+(include-book "num-list-fns" :load-compiled-file :comp)
+
+(local (include-book "num-list-thms"))
+(local (include-book "rem-and-floor"))
+(include-book "mv-proof")
+
+(defun weighted-switch-nat-find (rem-weights weights-idx rem-wchoice quotient-x)
+  (declare (xargs :guard (and (pos-listp rem-weights)
+                              (consp rem-weights) ; len >= 1
+                              (natp weights-idx)
+                              (integerp rem-wchoice)
+                              (<= 0 rem-wchoice)
+                              (< rem-wchoice (sum-list rem-weights))
+                              (natp quotient-x))))
+  (if (mbe :logic (or (endp rem-weights)
+                      (endp (cdr rem-weights))
+                      (< rem-wchoice (car rem-weights)))
+           :exec (< rem-wchoice (car rem-weights)))
+    (mv weights-idx (+ (* (car rem-weights) quotient-x) 
+;changed from mv to list
+;UPDATE: changed back to mv 9 July 2011
+                       rem-wchoice))
+    (weighted-switch-nat-find (cdr rem-weights) (1+ weights-idx)
+                              (- rem-wchoice (car rem-weights))
+                              quotient-x)))
+
+(local
+ (defthm weighted-switch-nat-find--car-integerp
+   (implies (integerp weights-idx)
+            (integerp (car (weighted-switch-nat-find rw weights-idx rwc qx))))
+   :rule-classes (:rewrite :type-prescription)))
+
+(local
+ (defthm weighted-switch-nat-find--car-non-neg
+   (implies (<= 0 weights-idx)
+            (<= 0 (car (weighted-switch-nat-find rw weights-idx rwc qx))))
+   :rule-classes (:rewrite :linear)))
+
+(local
+ (defthm weighted-switch-nat-find--car-bound
+   (<= (car (weighted-switch-nat-find rem-weights weights-idx rwc qx))
+       (+ weights-idx (len (cdr rem-weights))))
+   :rule-classes (:linear)))
+
+(local
+ (defthm weighted-switch-nat-find--car-bound2
+   (implies (consp rem-weights)
+            (< (car (weighted-switch-nat-find rem-weights weights-idx rwc qx))
+               (+ weights-idx (len rem-weights))))
+   :rule-classes (:linear)))
+
+(local
+ (defthm weighted-switch-nat-find--cadr-integerp
+   (implies (and (integer-listp rem-weights)
+                 (integerp rem-wchoice)
+                 (integerp quotient-x))
+            (integerp (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))))
+   :rule-classes (:rewrite :type-prescription)))
+
+(local
+ (defthm weighted-switch-nat-find--cadr-non-neg
+   (implies (and (pos-listp rem-weights)
+                 (<= 0 rem-wchoice)
+                 (integerp quotient-x)
+                 (<= 0 quotient-x))
+            (<= 0 (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))))
+   :rule-classes (:rewrite :linear)))
+
+(local
+ (encapsulate nil
+   (local (include-book "arithmetic-5/top" :dir :system))
+   
+   (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
+                                acl2::STABLE-UNDER-SIMPLIFICATIONP
+                                acl2::HIST acl2::PSPV))))
+   
+   (defthm weighted-switch-nat-find--cadr-loose-bound
+     (implies (and (pos-listp rem-weights)
+                   (<= 0 rem-wchoice)
+                   (integerp quotient-x)
+                   (<= 0 quotient-x)
+                   (rationalp bound)
+                   (<= (max-nat-list rem-weights) bound))
+              (<= (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))
+                  (+ rem-wchoice
+                     (* quotient-x bound))))
+     :rule-classes (:rewrite :linear))
+   
+   (defthm weighted-switch-nat-find--cadr-bound-pre
+     (implies (and (pos-listp rem-weights)
+                   (consp rem-weights)
+                   (consp (cdr rem-weights))
+                   (<= 0 rem-wchoice)
+                   (integerp quotient-x)
+                   (<= 0 quotient-x)
+                   (implies (= 0 quotient-x)
+                            (>= rem-wchoice (car rem-weights)))
+                   (rationalp bound)
+                   (<= (sum-list rem-weights) bound))
+              (< (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))
+                 (+ rem-wchoice
+                    (* quotient-x bound)))))
+   
+   (defthm weighted-switch-nat-find--cadr-bound
+     (implies (and (pos-listp rem-weights)
+                   (consp rem-weights)
+                   (consp (cdr rem-weights))
+                   (<= 0 rem-wchoice)
+                   (integerp quotient-x)
+                   (<= 0 quotient-x)
+                   (implies (= 0 quotient-x)
+                            (>= rem-wchoice (car rem-weights))))
+              (< (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))
+                 (+ rem-wchoice
+                    (* quotient-x (sum-list rem-weights)))))
+     :rule-classes (:rewrite :linear))))
+ 
+(defun weighted-switch-nat (weights x)
+  (declare (xargs :guard (and (pos-listp weights)
+                              (consp weights) ; len >= 1
+                              (integerp x)
+                              (<= 0 x))))
+  (let* ((weights (mbe :logic (pos-list-fix weights)
+                       :exec weights))
+         (x (mbe :logic (nfix x)
+                 :exec x))
+         (wtot (sum-list weights))
+         (wchoice (rem x wtot)))
+    (weighted-switch-nat-find weights 0 wchoice (floor x wtot))))
+
+(in-theory (disable weighted-switch-nat-find))
+
+(defthm weighted-switch-nat--car-integerp
+  (integerp (car (weighted-switch-nat weights x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm weighted-switch-nat--car-non-neg
+  (<= 0 (car (weighted-switch-nat weights x)))
+  :rule-classes (:linear :rewrite))
+
+(defthm weighted-switch-nat--car-bound
+  (<= (car (weighted-switch-nat weights x)) (len (cdr weights)))
+  :rule-classes (:linear :rewrite))
+
+(defthm weighted-switch-nat--car-bound2
+  (implies (consp weights)
+           (< (car (weighted-switch-nat weights x)) (len weights)))
+  :rule-classes (:linear :rewrite))
+
+
+(defthm weighted-switch-nat--cadr-integerp
+  (integerp (cadr (weighted-switch-nat weights x)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm weighted-switch-nat--cadr-non-neg
+  (<= 0 (cadr (weighted-switch-nat weights x)))
+  :rule-classes (:linear :rewrite))
+
+(defthm weighted-switch-nat--cadr-<=
+  (implies (and (integerp x)
+                (<= 0 x))
+           (<= (cadr (weighted-switch-nat weights x))
+               x))
+  :hints (("Goal" :use ((:instance weighted-switch-nat-find--cadr-loose-bound
+                         (rem-weights (pos-list-fix weights))
+                         (weights-idx 0)
+                         (rem-wchoice (rem x (sum-list (pos-list-fix weights))))
+                         (quotient-x (floor x (sum-list (pos-list-fix weights))))
+                         (bound (sum-list (pos-list-fix weights)))))))
+  :rule-classes (:linear :rewrite))
+
+(encapsulate nil
+
+  (local (in-theory (disable pos-listp sum-list)))
+  (local (in-theory (enable weighted-switch-nat-find)))
+  
+  (defthm weighted-switch-nat--cadr-less1
+    (implies (and (pos-listp weights)
+                  (consp weights)
+                  (consp (cdr weights))
+                  (integerp x)
+                  (<= (car weights) x))
+             (< (cadr (weighted-switch-nat weights x))
+                x))
+    :hints (("Goal'" :use ((:instance weighted-switch-nat-find--cadr-bound
+                            (rem-weights (pos-list-fix weights))
+                            (weights-idx 0)
+                            (rem-wchoice (rem x (sum-list (pos-list-fix weights))))
+                            (quotient-x (floor x (sum-list (pos-list-fix weights))))))))
+    :rule-classes (:linear :rewrite))
+
+  (local (defthm weighted-switch-nat--cadr-less2-lemma
+           (implies (and (pos-listp weights)
+                         (consp weights)
+                         (consp (cdr weights))
+                         (integerp x)
+                         (<= 0 x)
+                         (< 0 (car (weighted-switch-nat weights x))))
+                    (<= (car weights) x))
+           :rule-classes :forward-chaining))
+  
+  (local (in-theory (union-theories '(weighted-switch-nat--cadr-less2-lemma
+                                      weighted-switch-nat--cadr-less1)
+                                    (theory 'minimal-theory))))
+  
+  (defthm weighted-switch-nat--cadr-less2
+    (implies (and (pos-listp weights)
+                  (consp weights)
+                  (consp (cdr weights))
+                  (integerp x)
+                  (<= 0 x)
+                  (< 0 (car (weighted-switch-nat weights x))))
+             (< (cadr (weighted-switch-nat weights x))
+                x))
+    :rule-classes (:linear :rewrite)))
+
+(in-theory (disable weighted-switch-nat))
+
+(local
+ (defthm make-list-ac--pos
+   (implies (and (posp v)
+                 (pos-listp ac))
+            (pos-listp (make-list-ac n v ac)))
+   :rule-classes (:rewrite)))
+
+(defun switch-nat (nchoices x)
+  (declare (xargs :guard (and (posp nchoices)
+                              (natp x))))
+  (weighted-switch-nat (make-list nchoices :initial-element 1) x))
+
+(defun multiple-switch-nat (nchoices-lst x)
+  (declare (xargs :guard (and (pos-listp nchoices-lst)
+                              (consp nchoices-lst) ; len >= 1
+                              (natp x))))
+  (mv-let (choice x)
+          (switch-nat (car nchoices-lst) x)
+          (if (endp (cdr nchoices-lst))
+              (mv (list choice) x)
+            (mv-let (choice-lst x) 
+                    (multiple-switch-nat (cdr nchoices-lst)
+                                         (nfix x)) ; help guard verification
+                    
+                    (mv (cons choice choice-lst) x)))));switched back to mv
+
+(defthm mv-nth--to--my-mv-nth--weighted-switch-nat
+  (equal (mv-nth n (weighted-switch-nat y x))
+         (my-mv-nth n (weighted-switch-nat y x)))
+  :hints (("Goal" :in-theory (enable mv-nth--to--my-mv-nth))))
+
+
+
+
+(defun nfixg (x)
+  (declare (xargs :guard (natp x)))
+  (mbe :logic (if (natp x) x 0)
+       :exec x))#|ACL2s-ToDo-Line|#
+
+
+#| test:
+(defun nth-foo (x)
+  (declare (xargs :measure (nfix x)
+                  :guard (natp x)))
+    (mv-let (sw v)
+            (switch-nat 2 (nfixg x))
+            (if (= sw 0)
+              v
+              (cons 'x (nth-foo v)))))
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/cgen/testing-regression.lsp acl2-6.3/books/cgen/testing-regression.lsp
--- acl2-6.2/books/cgen/testing-regression.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/testing-regression.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,1773 @@
+; ****************** BEGIN INITIALIZATION FOR ACL2s MODE ****************** ;
+; (Nothing to see here!  Your actual file is after this initialization code);
+
+#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading the TRACE* book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
+; only load for interactive sessions: 
+#+acl2s-startup (include-book "trace-star" :uncertified-okp nil :dir :acl2s-modes :ttags ((:acl2s-interaction)) :load-compiled-file nil);v4.0 change
+
+#+acl2s-startup (assign evalable-printing-abstractions nil)
+
+;arithmetic book
+#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading arithmetic-5/top book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
+(include-book "arithmetic-5/top" :dir :system)
+
+;basic thms/lemmas about lists
+#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading coi/lists book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
+(include-book "coi/lists/basic" :dir :system)
+
+#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading ACL2's lexicographic-ordering-without-arithmetic book.~%This indicates that either your ACL2 installation is missing the standard books are they are not properly certified.") (value :invisible))
+(include-book "ordinals/lexicographic-ordering-without-arithmetic" :dir :system)
+
+#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading the CCG book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
+(include-book "ccg" :uncertified-okp nil :dir :acl2s-modes :ttags ((:ccg)) :load-compiled-file nil);v4.0 change
+
+#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading ACL2s customizations book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
+(include-book "custom" :dir :acl2s-modes :uncertified-okp nil :load-compiled-file :comp :ttags :all)
+
+#+acl2s-startup (er-progn (assign fmt-error-msg "Problem setting up ACL2s mode.") (value :invisible))
+
+;Settings common to all ACL2s modes
+(acl2s-common-settings)
+
+; Non-events:
+(set-guard-checking :none)
+
+
+; ******************* END INITIALIZATION FOR ACL2s MODE ******************* ;
+;$ACL2s-SMode$;ACL2s
+;$ACL2s-LMode$;Demo
+;; this regression file aims at testing the various features of 
+;; counterexample generation in ACL2 Sedan
+
+
+;(add-include-book-dir :acl2s-modes "../")
+;(ld "acl2s-mode.lsp" :dir :acl2s-modes)
+
+;(include-book "top")
+(acl2s-defaults :set sampling-method :uniform-random)
+(acl2s-defaults :set search-strategy :incremental)
+(acl2s-defaults :set verbosity-level 2)
+
+;++++++++++++++++testcase 1 [classic reverse example]++++++++++++++++++++++++++
+;Define Reverse function
+(defun rev1 (x)
+  (if (endp x)
+    nil
+    (append (rev1 (cdr x)) (list (car x)))))
+
+(acl2s-defaults :set verbosity-level 2)
+(test? (equal (rev1 (rev1 x)) x))
+
+(acl2s-defaults :set testing-enabled T)
+(thm (equal (rev1 (rev1 x)) x))
+(acl2s-defaults :set testing-enabled :naive)
+
+;Modify the conjecture, add the type hypothesis
+(test? (implies (true-listp x)
+                (equal (rev1 (rev1 x)) x)))
+;; Issues
+;; 1. If a function is not golden (guards not verified), then test?
+;; errors out. e.g above rev is not golden and above test? fails with:
+#|
+ACL2 Error in ( DEFUN DEFDATA::CONCLUSION-VAL-CURRENT ...):  The body
+for DEFDATA::CONCLUSION-VAL-CURRENT calls the function REV, the guards
+of which have not yet been verified.  See :DOC verify-guards.
+|#
+;; This happens for each conclusion-val, hypothesis-val and next-sigma
+;; This forced me to add (set-verify-guards-eagerness 0) to test?
+;; progn loop. But what about thm and defthm ?
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+;; testcase 2 (Shape of triangle - example from testing literature)
+(defdata triple (list pos pos pos))
+
+(defun trianglep (v)
+  (and (triplep v)
+       (< (third v) (+ (first v) (second v)))
+       (< (first v) (+ (second v) (third v)))
+       (< (second v) (+ (first v) (third v)))))
+
+(defun shape (v)
+  (if (trianglep v)
+      (cond ((equal (first v) (second v))
+             (if (equal (second v) (third v))
+                 "equilateral"
+               "isosceles"))
+            ((equal (second v) (third v)) "isosceles")
+            ((equal (first v) (third v)) "isosceles")
+            (t "scalene"))
+    "error"))
+
+(acl2s-defaults :set num-trials 1000000)
+(acl2s-defaults :set testing-enabled :naive)
+
+(time$
+; 27th Aug '12
+;Note: random is slightly less than twice as fast as BE
+; random - ; 4.95 seconds realtime, 4.96 seconds runtime
+;            (927,923,408 bytes allocated)
+; be -     ; 8.12 seconds realtime, 8.14 seconds runtime
+;            (1,902,023,552 bytes allocated).
+; Investigate this!
+(test? 
+ (implies (and (triplep x)
+               (trianglep x)
+               (> (third x) 256)
+               (= (third x)
+                  (* (second x) (first x))))
+          (not (equal "isosceles" (shape x))))))
+
+(acl2s-defaults :set num-trials 1000)
+;; fixed a bug where get-testing-enabled fn was giving wrong answer
+;; leading to backtrack hints being added twice when we eval the
+;; following form twice. Idempotency is very important.
+
+(acl2s-defaults :set testing-enabled T)
+
+;; whoa! Without arithmetic-5, I get nowhere with the
+;; below example. 
+;; 20th March 2013 - lets try arithmetic with meta
+;(include-book "arithmetic/top-with-meta" :dir :system)
+; But even without these books, now the following works fine,
+; but with the above book, it produces way more cts (201 vs 4)
+(test?
+ (implies (and (triplep x)
+               (trianglep x)
+               (> (third x) 256)
+               (= (third x)
+                  (* (second x) (first x))))
+          (not (equal "isosceles" (shape x)))))
+
+
+
+;; testcase 3 (memory updates dont commute)
+;NOTE: The following example too, 'simple' works good enough
+
+;another example demonstrating how having the ability to find
+;counterexamples helps in debugging conjectures
+;This also illustrates how data definition framework
+;and random testing work together
+
+;update: Address * Value * Memory -> Memory
+;If Address is found in Memory, update it, or else add it to the end
+;of the memory.
+(defdata memory (listof (cons nat integer)))
+;ISSUE: map not working due to guards
+
+;; (defdata memory (map nat integer))
+
+(nth-memory 9436794189)
+
+(defun update (address value memory)
+  (cond ((endp memory)
+         (acons address value nil))
+        ((equal address (caar memory))
+         (acons address value (cdr memory)))
+        ((< address (caar memory))
+         (acons address value memory))
+        (t (cons (car memory) (update address value (cdr memory))))))
+
+(defun make-ordered-list (n acc)
+  (if (zp n)
+    acc
+    (make-ordered-list (- n 1) (cons n acc))))
+
+(make-ordered-list 4 nil)
+
+(defun cons-up-lists (l1 l2)
+  (declare (xargs :guard (and (true-listp l1)
+                              (true-listp l2)
+                              (= (len l1)
+                                 (len l2)))))
+  (if (endp l1)
+    nil
+    (cons (cons (car l1) (car l2))
+          (cons-up-lists (cdr l1) (cdr l2)))))
+
+(defun nth-ordered-memory (n)
+  (let* ((m (nth-memory n))
+         (len (len m))
+         (vals (strip-cdrs m))
+         (keys (make-ordered-list len nil)))
+    (cons-up-lists keys vals)))
+
+;attach a custom test enumerator to a defdata type
+(defdata-testing memory :test-enumerator nth-ordered-memory)               
+
+;Conjecture - version#1
+(test?
+ (equal (update a1 v1 (update a2 v2 m))
+        (update a2 v2 (update a1 v1 m))))
+; NOTE: BE gets no counterexamples in the above for numtrials 1000!
+; Makes sense.
+
+
+; Conjecture - version 2
+
+(test?
+ (implies (and (memoryp m)
+               (natp a1)
+               ;(< a1 56) ;ranges
+               ;(< 4 a1)
+               (natp a2))
+          (equal (update a1 v1 (update a2 v2 m))
+                 (update a2 v2 (update a1 v1 m)))))
+; NOTE: BE gets no counterexamples in the above even for numtrials 100000!
+; This is not good. This is probably due to the faulty DEFDATA::|next BE args|
+; function which enumerates the variables in a naive way. See note after
+; testcase 5.
+; 1000000 timesout
+
+
+;Conjecture - version#3
+;TODO - I am not trying hard to refute conclusion in incremental
+(test?
+ (implies (and (memoryp m)
+               (natp a1)
+               (natp a2)
+               ;(or (in-memory a1 m) (in-memory a2 m))
+               (not (equal a1 a2)))
+          (equal (update a1 v1 (update a2 v2 m))
+                 (update a2 v2 (update a1 v1 m)))))
+
+;Testing didnt come up with any counterexamples, lets try to prove it.
+(thm
+ (implies (and (memoryp m)
+               (natp a1)
+               (natp a2)
+               ;(or (in-memory a1 m) (in-memory a2 m))
+               (not (equal a1 a2)))
+          (equal (update a1 v1 (update a2 v2 m))
+                 (update a2 v2 (update a1 v1 m)))))
+
+
+;; testcase 4 (Russinoff's example)
+(acl2s-defaults :set verbosity-level 3)
+(test? (implies (and (real/rationalp a)
+                     (real/rationalp b)
+                     (real/rationalp c)
+                     ;(<= 0 a)
+                     (<= a 1)
+                     (< 0 b)
+                     (< 0 c)
+                     (<= (expt a 2) (* b (+ c 1)))
+                     (<= b (* 4 c)))
+                (< (expt (- a 1) 2) (* b c))))
+
+;; TODO: C is being printed in quoted form in :incremental
+;; It seems the above has been fixed.
+
+;; TODO harshrc 27th Aug '12
+;; IMP NOTE: incremental does a bad job if the initial value for the first
+;; variable chosen is BAD. If it was good, it does an efficient job.
+;; WHich means, I need to look into how I am using num-trials,
+;; backtrack-limit and stopping condition in the case of incremental.
+;; I need to revisit the implementation design of incremental!!
+
+(thm (implies (and (real/rationalp a)
+                     (real/rationalp b)
+                     (real/rationalp c)
+                     (< 0 a)
+                     (< 0 b)
+                     (< 0 c)
+                     (<= (expt a 2) (* b (+ c 1)))
+                     (<= b (* 4 c)))
+                (< (expt (- a 1) 2) (* b c))))
+
+;not giving top-level counterexamples in :incremental
+(time$
+(test? (implies (and (real/rationalp a)
+                     (real/rationalp b)
+                     (real/rationalp c)
+                     (<= 1 a)
+                     (< 0 b)
+                     (< 0 c)
+                     (<= (expt a 2) (* b (+ c 1)))
+                     (<= b (* 4 c)))
+                (< (expt (- a 1) 2) (* b c)))))
+
+(thm (implies (and (real/rationalp a)
+                   (real/rationalp b)
+                   (real/rationalp c)
+                   (< 3/4 a)
+                   (<= (expt a 2) (* b (+ c 1)))
+                   (<= b (* 4 c)))
+              (< (expt (- a 1) 2) (* b c)))
+     :hints (("goal" :cases ((< 0 b)))))
+;08/22/12 ACL2 v5.0 The above thm no longer goes through
+
+
+;; testcase 5 (only finds cts if arithmetic-5 library is loaded)
+(test?
+ (implies (and (posp x)
+               (posp y)
+               (posp z)
+               (> z 16)
+               (<= (+ x y) (* 2 z)))
+          (or (> (* x y z) (* x y x))
+              (> (* x y z) (* x y y)))))
+; Aug 27th '12
+; Note: BE does exceptionally well in the above example. The reason is
+; to do with the faulty DEFDATA::|next BE args| function. In the above
+; example this is how BE enumerates X Y Z:
+; 0 0 0 -> 1 0 0 -> 1 1 0 -> 1 1 1 -> 2 1 1 -> 2 2 1 -> and so on
+; clearly such an enumeration will find cts easily for the above conjecture.
+
+
+;;testcase 6
+(test?
+ (implies (and (posp x)
+               (posp y)
+               (posp z)
+               ;Idea of introducing variables to help SELECT
+               ;(equal w (* z z))
+               (<= (acl2::+ x y) (acl2::* 2 z)))
+          (> (acl2::* z z) (acl2::* x y))))
+
+;; testcase 7 (from Harrison's book)
+(defdata formula (oneof pos
+                        (list 'not formula)
+                        (list 'and formula formula)
+                        (list 'or formula formula)
+                        (list 'implies formula formula)))
+;ISSUE: made defdata idempotent (redundant events)
+
+(defun simplify (f)
+  ;:input-contract (formulap f)
+  ;:output-contract (formulap (simplify f))
+  (cond ((posp f) f)
+        ((eq (first f) 'not) (list 'not (simplify (second f))))
+        ((eq (first f) 'and) (list 'and (simplify (second f)) (simplify (third f))))
+        ((eq (first f) 'or) (list 'or (simplify (second f)) (simplify (third f))))
+        ((eq (first f) 'implies) (list 'or (list 'not (simplify (second f))) (simplify (third f))))
+        (t f)))
+
+(defun is-simplified (f)
+  ;:input-contract (formulap f)
+  ;:output-contract (booleanp (is-simplified f))
+   (cond ((posp f) t)
+        ((eq (first f) 'not) (is-simplified (second f)))
+        ((eq (first f) 'and) (and (is-simplified (second f)) (is-simplified (third f))))
+        ((eq (first f) 'or) (and (is-simplified (second f)) (is-simplified (third f))))
+        ((eq (first f) 'implies) nil)
+        (t nil)))
+  
+(defthm simplify-is-stable
+  (equal (simplify (simplify f))
+         (simplify f)))
+
+(defun nnf (f)
+   (cond ((posp f) f)
+        ((and (eq (first f) 'not) (posp (second f))) f)
+        ((and (eq (first f) 'not) (eq 'not (first (second f))))
+         (nnf (second (second f))))
+        ((eq (first f) 'and) (list 'and (nnf (second f)) (nnf (third f))))
+        ((eq (first f) 'or) (list 'or (nnf (second f)) (nnf (third f))))
+        ((eq (first f) 'implies) (list 'implies (nnf (second f)) (nnf (third f))))
+        ((and (eq (first f) 'not)
+              (eq 'and (first (second f))))
+         (let* ((a (second f))
+                (lhs (second a))
+                (rhs (third a)))
+           (list 'or (nnf (list 'not lhs)) (nnf (list 'not rhs)))))
+        ((and (eq (first f) 'not)
+              (eq 'or (first (second f))))
+         (let* ((a (second f))
+                (lhs (second a))
+                (rhs (third a)))
+           (list 'and (nnf (list 'not lhs)) (nnf (list 'not rhs)))))     
+         ((and (eq (first f) 'not)
+              (eq 'implies (first (second f))))
+         (let* ((a (second f))
+                (lhs (second a))
+                (rhs (third a)))
+           (list 'and (nnf lhs) (nnf (list 'not rhs)))))
+        (t f)))
+
+(thm ;simp-nnf-commute
+  (implies (formulap f)
+  (equal (nnf (simplify f))
+         (simplify (nnf f)))))
+
+;; testcase 8 (Moore's example)
+(defun square-root1 (i ri)
+  (declare (xargs :mode :program))
+  (if (>= (floor i ri) ri)
+      ri
+      (square-root1 i (floor (+ ri (floor i ri)) 2))))
+
+(defun square-root (i)
+  (declare (xargs :mode :program))
+  (square-root1 i (floor i 2)))
+
+(defun square (x)
+   (* x x))
+ 
+ 
+(test?
+  (implies (natp i)
+           (and (<= (square (square-root i)) i)
+                (< i (square (1+ (square-root i)))))))
+
+
+;; testcase 9 (a thm in 2, but cts in 3 variables)
+(defdata small-pos (enum '(1 2 3 4 5 6 7 8 9)))
+
+(acl2s-defaults :set testing-enabled T)
+(acl2s-defaults :set num-trials 2500)
+;No luck without arithmetic-5.
+;Lets add arith-5 lib and see now. Still no luck
+; 19th March - I saw some counterexamples with (ld acl2s-mode.lsp)
+; 20th March 2013 - arithmetic/top-with-meta no luck.
+; 15 July 2013 - incremental finds it now in some subgoal!
+(test? 
+  (implies (and (integerp c1)
+                (integerp c2)
+                (integerp c3)
+                (posp x1)
+                (posp x2)
+                (posp x3)
+                (< x1 x2)
+                (< x2 x3)
+                (equal 0 (+ c1 c2 c3))
+                (equal 0 (+ (* c1 x1) (* c2 x2) (* c3 x3))))
+           (and (= 0 c1) (= 0 c2) (= 0 c3))))
+
+;;(total-runs/goals - cts/wts - totaltime/testing-time)
+;;(5004/4 - 4485/3 - 0.59/0.1) stats
+
+;TODO.bug - incremental is giving assert failure!
+; This is due to the way easy-simplify works and propagate
+; blindly throws away a simplification that is not smaller
+; in term-order than the original hyp.
+; 27th Aug '12, to get rid of the above error, one needs to
+; submit a compound recognizer rule as follows.
+; Additionally I also make sure that I dont break the invariant
+; that after propagating a X=const assignment, X will not appear
+; as a free variable in the resulting simplified hyp
+
+(defthm small-posp-is-a-posp
+  (implies (small-posp x)
+           (and (integerp x)
+                (< 0 x)))
+  :rule-classes :compound-recognizer)
+
+(test? 
+  (implies (and (integerp c1)
+                (integerp c2)
+                (integerp c3)
+                (small-posp x1)
+                (small-posp x2)
+                (small-posp x3)
+                (< x1 x2)
+                (< x2 x3)
+                (equal 0 (+ c1 c2 c3))
+                (equal 0 (+ (* c1 x1) (* c2 x2) (* c3 x3))))
+           (and (= 0 c1) (= 0 c2) (= 0 c3))))
+
+
+;; testcase 10 (Euler Counterexample)
+;fermat number: f(n) = 1 + 2^2^n
+(defun f (n)
+  (1+ (expt 2 (expt 2 n))))
+
+(f 5)
+
+;is k a factor of n other than 1 and n?
+(defun factor? (k n)
+  (and (< 1 k)
+       (< k n)
+       (natp (/ n k))))
+
+(test?
+ (implies (posp k)
+          (not (factor? k (f 5)))))
+
+
+;Euler Insight: All factors of f(n) should have the form k*2^{n+1} + 1
+;for some k. Someone improved on this, where all k are even, so:
+(defun fermat-factor (k n)
+  (1+ (* k (expt 2 (+ 1 n)))))
+
+;TODO: get rid of duplicate cts/wts across subgoals
+(test?
+ (implies (posp k)
+          (not (factor? (fermat-factor k 5) (f 5)))))
+
+;Lets generalize this, for any fermat number, but since these are
+;huge numbers we will restrict ourselves to n less than 15.
+(f 15) ;1000 digits long
+
+(test?
+ (implies (and (posp k)
+               (posp n)
+               (< n 15))
+          (not (factor? k (f n)))))
+
+(acl2s-defaults :set num-trials 100000)
+ ;Rerunning the following test 2-3 times will get you atleast two
+;counterexamples:
+;-- (K 14) and (N 12)
+;-- (K 10) and (N 5)
+
+
+;Note: incremental does a really bad job with this test?
+;(acl2s-defaults :set search-strategy :simple)
+(acl2s-defaults :set subgoal-timeout 15)
+;BOZO 20th March 2013 - arithmetic-5 caused the following to hang.
+;ADDENDUM 9 July 2013 - timeout does not work if prover hangs.
+(acl2s-defaults :set testing-enabled :naive)
+(test?
+ (implies (and (posp k)
+               (posp n)
+               (< n 15))
+          (not (factor? (fermat-factor k n) (f n)))))
+
+;09/28/12
+;wow i found for the above a brand new counterexample:
+;; We tested 71059 examples across 1 subgoals, of which 37635 (37635 unique)
+;; satisfied the hypotheses, and found 3 counterexamples and 37632 witnesses.
+;; The total time taken (incl. prover time) is 0.57 seconds
+;; The time taken by testing is 0.57 seconds
+
+;; We falsified the conjecture. Here are counterexamples:
+;;  [found in : "top"]
+;;  -- (K 238) and (N 11)
+;;  -- (K 14) and (N 12)
+;;  -- (K 10) and (N 5)
+
+;; 20th March 2013 - The above example does much better with
+;; arithmetic-5 loaded and that too in the acl2s-mode env.
+
+;The third case
+(acl2s-defaults :set num-trials 1000)
+(acl2s-defaults :set testing-enabled T)
+
+;; Fermats last theorem
+; No counterexamples and proof is probably out of ACL2's reach!
+; TODO: fix timeout issues. Here exponentiation probably causes problem
+
+
+
+(test?
+ (implies (and (posp a) (posp b) (posp c)
+               (natp n) (> n 2))
+          (not (equal (+ (expt a n) (expt b n))
+                      (expt c n)))))
+
+;; testcase 11
+(defund hash (k)
+  (let* ((m (expt 2 23))
+         (a 309017/500000)
+         (s (* k a))
+         (x (- s (floor s 1))))
+    (mod (floor (* m x) 1)
+         (expt 2 32))))
+
+(defun g (x y z)
+  (if (and (equal x (hash y))
+           (equal y (hash z)))
+      'error
+    0))
+
+(acl2s-defaults :set testing-enabled T) ;if simple, then only T works
+
+(test? (implies (and (integerp x)
+                     (integerp y)
+                     (integerp z))
+                (/= (g x y z) 'error)))
+
+(acl2s-defaults :set testing-enabled :naive) ;for incremental, naive works too
+; Actually :simple works too with naive.
+(test? (implies (and (integerp x)
+                     (integerp y)
+                     (integerp z)
+                     (equal x (hash y))
+                     (equal y (hash z)))
+                NIL))
+
+
+
+
+
+
+
+
+
+
+
+;========================OLD/SCRATCHPAD=================================
+
+:trans1 (defdata R (record (f1 . nat) (f2 . pos)))
+
+(defdata nats (set nat))
+
+
+;TODO FIXME
+(defdata i-or-loi (oneof integer (listof integer)))
+
+(defun rev (x)
+  (if (endp x)
+    nil
+    (append (rev (cdr x)) (list (car x)))))
+;(trace$ defdata::print-bindings defdata::run-tests-on-subgoal-and-summarise)
+;TODO: generalization and cross-fert still dont work well with
+;output printing
+(set-acl2s-random-testing-enabled t)
+;TODO: ASK Matt, why is generalization not being captured.
+;Maybe bug in my code!!? CHECK
+(thm (implies (true-listp x)
+              (equal (rev (rev x)) x))) 
+
+(program)
+(defun app1 (x y)
+  (if (endp x)
+    y
+    (cons (car x) (app1 (cdr x) y))))
+
+(logic)
+
+(test? (implies (and (true-listp x) (true-listp y))
+                (true-listp (app1 x y))))
+
+(defun divisible-by (x i)
+  (integerp (/ x i)))
+  
+(defun divisor<=p (x i)
+  (if (or (zp i)
+          (= i 1))
+    nil
+    (if (divisible-by x i)
+      t
+      (divisor<=p x (- i 1)))))
+
+; COUNT-DIVISORS<=: nat nat -> nat
+; (Helper for PRIMEP)
+; Counts the number of positive integer divisors of the first argument
+; that are less than or equal to the second argument.
+(defun count-divisors (x i)
+  (if (zp i)
+    0
+    (if (divisible-by x i)
+      (+ 1 (count-divisors x (- i 1)))
+      (count-divisors x (- i 1)))))
+
+; PRIMEP: nat -> boolean
+; Recognizer for prime numbers, which must have exactly two distinct
+; divisors (1 and itself).
+(defun primep (x)
+  (and (natp x)
+       (= (count-divisors x x) 2)))
+
+(defun prime-between2 (l u)
+  (declare (ignorable l u))
+  (if (zp (- u l))
+    2
+    (if (primep l)
+      l
+      (prime-between2 (+ l 1) u))))
+
+(defun prime-bet (l u)
+  (prime-between2 l u))
+
+(defun c-lg2-hlp (x i)
+  (declare (xargs :measure (acl2-count (- x (expt 2 i)))))
+  (cond ((or (not (natp i))
+             (zp x)
+             (<= x (expt 2 i))) 0)
+        ((and (> x (expt 2 i))
+              (<= x (expt 2 (+ i 1))))
+         (+ i 1))
+        (T (c-lg2-hlp x (+ i 1)))))
+
+;; Base-2 logarithm of natural number,
+;; rounding up to the nearest natural (returns 0 if x is 0)
+(defund c-lg2 (x)
+  (c-lg2-hlp x 0))
+
+(defun lb-pn4 (n)
+  (*  n (1- (c-lg2  n))))
+
+
+(defun nth-prime (n)
+  (nth n 
+       (sieve (upper-bound n))))
+  
+(defun nth-prime5 (n)
+  (if (zp n)
+    2
+    (let* ((ub (1+ (expt 2 n)))
+           (lb (nth-prime-lower-bound n))) 
+      (prime-bet lb ub))))
+    
+
+
+(encapsulate
+  (((ubsize ) => *))
+
+  (local (defun ubsize () 32))
+
+  (defthm ubsize-thm
+    (natp (ubsize))
+    :rule-classes ((:rewrite) (:type-prescription)))
+  )
+
+(defun usbvp (x)
+  (and (natp x)
+       (<= 0 x)
+       (< x (expt 2 (ubsize)))))
+(set-acl2s-random-testing-enabled nil)
+(encapsulate
+  (((whatever) => *))
+
+  (local (defun whatever () 0))
+
+  (defthm whatever-thm
+    (usbvp (whatever))
+    )
+  )
+
+(acl2s-defaults :set num-trials 1000)
+;GOOD EXAMPLE 
+(test? ;remove-once-perm
+  (implies (and (consp X)
+                (sets::in a Y))
+           (equal (defdata::permutation (sets::delete a X)
+                        (sets::delete a Y))
+                  (defdata::permutation X Y))))
+
+(defun perm (x y)
+  (if (endp x)
+      (endp y)
+    (and (member-equal (car x) y)
+         (perm (cdr x) (remove1-equal (car x) y)))))
+
+(defun forall-in (x y)
+  (if (endp x)
+      t
+    (and (member-equal (car x) y)
+         (forall-in (cdr x) y))))
+
+(test?
+ (implies (and (pos-listp x)
+               (pos-listp y)
+               )
+          (equal (perm x y)
+                 (and (= (len x) (len y))
+                      (forall-in x y)
+                      (forall-in y x)))))
+
+(test?
+ (implies (and (pos-listp x)
+               (pos-listp y))
+          (iff (perm x y)
+               (and (= (len x) (len y))
+                    (subsetp-equal x y)
+                    (subsetp-equal y x)))))
+ 
+;#|
+;air turbulence logic puzzle (Jim Steinberg gave me the link)
+;http://www.mysterymaster.com/puzzles/AirTurbulence.html
+(defdata officials (enum '(:M :DA :JP :DC)))
+(defdata grooming (enum '(:Beard :Manicure :Shampoo :TeethC)))
+(defdata runway-num (enum '(2 3 4 6)))
+
+(defdata off-mapping (map officials runway-num))
+
+;BUG: finite record is giving rise to *off-mapping-values*?!!
+(defdata grooming-map (map grooming runway-num))
+                              
+(defdata off-groom (map officials grooming))
+                           
+(defun unique-4map (alst)
+  (no-duplicatesp (strip-cdrs alst)))
+
+(acl2s-defaults :set num-trials 100)
+
+(test? ;constraint
+ (implies (and (off-mappingp O-R)
+               (grooming-mapp G-R)
+               
+               (off-groomp O-G)
+               (unique-4map O-R)
+               (equal (mget (mget :M  O-G) G-R) (mget :M O-R))
+               (equal (mget (mget :DA O-G) G-R) (mget :DA O-R))
+               (equal (mget (mget :JP O-G) G-R) (mget :JP O-R))
+               (equal (mget (mget :DC O-G) G-R) (mget :DC O-R))
+               (equal (mget :DA O-R) 3);1st constraint               
+               (equal (mget :Shampoo G-R) (1+ (mget :Manicure G-R)));second constraint
+               (> (mget :M O-R) (mget :DC O-R));third constraint
+               (equal (mget :JP O-R) (* 2 (mget :TeethC G-R)));fourth constraint
+               (equal (mget :DA O-G) :Beard));5th constraint
+          nil))
+
+;10 July 2011 (I dont know what I did, but we shud get some
+;counterexample here)
+;Okay got it(u have to be lucky for naive testing):
+#|
+We falsified the conjecture. Here is the counterexample:
+ -- (G-R ((:BEARD . 2) (:MANICURE . 2) (:SHAMPOO . 3) (:TEETHC . 2))),
+(O-R ((:DA . 3) (:DC . 2) (:JP . 4) (:M . 6))) and 
+(O-G ((:DA . :BEARD) (:DC . :BEARD) (:JP . :MANICURE) (:M . :SHAMPOO)))
+|# 
+(test? ;constraint
+ (implies (and (off-mappingp O-R)
+               (grooming-mapp G-R)
+               (off-groomp O-G)
+               (unique-4map O-R)
+               (equal (mget (mget :M  O-G) G-R) (mget :M O-R))
+               (equal (mget (mget :DA O-G) G-R) (mget :DA O-R))
+               (equal (mget (mget :JP O-G) G-R) (mget :JP O-R))
+               (equal (mget (mget :DC O-G) G-R) (mget :DC O-R))
+               (equal (mget :Shampoo G-R) (1+ (mget :Manicure G-R)))
+               (> (mget :M O-R) (mget :DC O-R))
+               (equal (mget :JP O-R) (* 2 (mget :TeethC G-R)))
+               (equal (mget :DA O-R) 3);1st constraint
+               (equal (mget :DA O-G) :Beard))
+          nil))
+;|#
+
+(defun hash (k)
+  (let* ((m (expt 2 23))
+         (a 309017/500000)
+         (s (* k a))
+         (x (- s (floor s 1))))
+    (mod (floor (* m x) 1)
+         (expt 2 32))))
+
+(in-theory (disable hash))
+
+
+(defun f1 (x y)
+  (if (equal x (hash y))
+    'error
+    0))
+
+(acl2s-defaults :set verbosity-level 4)
+(trace$ defdata::cts-wts-search defdata::assign-propagate (defdata::simple-search :entry (list :simple (first arglist) (second arglist) (third arglist) (fourth arglist)) :exit :b))
+(trace$ (defdata::incremental-search :entry (list :incremental (first arglist) (second arglist) (third arglist)) :exit :b)
+        (defdata::backtrack :entry (list :backtrack (first arglist)) :exit :b))
+(test? (/= (f1 x y) 'error))
+
+(test? ;(implies (and (integerp x) (integerp y))
+                (NOT (EQUAL X (HASH Y))))
+
+(set-acl2s-random-testing-enabled nil)
+(thm (implies (and (integerp x) (integerp y))
+                (/= (f1 x y) 'error)))
+
+(set-acl2s-random-testing-enabled t)
+
+(defun hash1 (x)
+  (mod (+ (* x (1- (expt 2 27)))
+          (1- (expt 2 19)))
+       (expt 2 32)))
+
+;simple 8.2sec
+;incr: 12.42 sec
+;10 July 2011: same times for both 9.7sec
+(acl2s-defaults :set instantiation-method :incremental)
+(time$
+(test?
+ (implies (and (integerp x)
+               (integerp y)
+               (integerp z)
+               (integerp w)
+               (equal x (hash1 y))
+               (equal y (hash1 z))
+               (equal w (max x y)))
+          (< w z))))
+
+(acl2s-defaults :set testing-enabled t) 
+;tests multiple dest-elim
+(test? (implies (AND (CONSP X)
+                (NOT (EQUAL (LEN X) 2))
+                (EQUAL (CADR X) '+))
+              (not (equal x x))))
+
+
+;TODO CHECK THIS OUT
+   (defdata::RUN-TESTS-AND-PRINT-SUMMARY
+    'RANDOMTESTING
+    '(IMPLIES (AND (CONSP X)
+                  (NOT (EQUAL (LEN X) 2))
+                  (EQUAL (CADR X) '+))
+             (NOT (EQUAL X X)))
+    '((X CONS))
+    2 :simple 'TEST? state)
+
+#|
+(local (include-book "arithmetic-5/top" :dir :system))
+(thm (implies (and (rationalp a)
+                  (rationalp b)
+                  (rationalp c)
+                  (< 0 a)
+                  (< 0 b)
+                  (< 0 c)
+                  (<= (expt a 2) (* b (+ c 1)))
+                  (<= b (* 4 c)))
+             (< (expt (- a 1) 2) (* b c))));(set-acl2s-random-testing-use-instantiation-method 'concrete)
+
+(local (set-default-hints
+        '((nonlinearp-default-hint stable-under-simplificationp
+                                   hist pspv))))
+ 
+ (defthm russinoff2
+  (implies (and (rationalp a)
+                (rationalp b)
+                (rationalp c)
+                (<= 1 a)
+                ;(< 0 b)
+                ;(< 0 c)
+                (<= (expt a 2) (* b (+ c 1)))
+                (<= b (* 4 c)))
+           (< (expt (- a 1) 2) (* b c)))
+  :hints (("goal" :cases ((<= 0 b)))))
+|#
+;(defdata poss (enum 1 2 3 4 5 6 7 8 9))
+(acl2s-defaults :set instantiation-method :simple)
+(time$
+(test? 
+  (implies (and (integerp c1)
+                (integerp c2)
+                (integerp c3)
+                (posp x1)
+                (posp x2)
+                (posp x3)
+                (< x1 x2)
+                (< x2 x3)
+                (< x3 10)
+                (equal 0 (+ c1 c2 c3))
+                (equal 0 (+ (* c1 x1) (* c2 x2) (* c3 x3))))
+           (and (= 0 c1) (= 0 c2) (= 0 c3)))))
+;simple: 2.82 sec
+;incr: 8.21 sec
+;10 July 2011: 100 trials incremental finds 3 wts and 3 cts: 56.78 sec
+;10 July 2011: 100 trials simple finds 0 wts and 0 cts: 2.47 sec
+
+(acl2s-defaults :set verbosity-level 1)
+(acl2s-defaults :set num-trials 100)
+(acl2s-defaults :set instantiation-method :simple)
+(test?
+ ;(let ((z 21) (y 22) (x 2))
+ (implies (and (posp x)
+               (posp y)
+               (posp z)
+               (> z 16)
+               (<= x y)
+               (>= (+ x y) z))
+          (>= (* x (* y z)) (* x (* x y)))))
+
+(acl2s-defaults :set instantiation-method :simple)
+;10July-11 incremental takes time but finds ctx consistently 
+(test?
+ (implies (and (posp x)
+               (posp y)
+               (posp z)
+               ;(> z 16)
+               (<= (+ x y) (* 2 z)))
+          (> (* z z) (* x y))))
+
+(acl2s-defaults :set instantiation-method :simple)
+(test?
+ (implies (and (posp x)
+               (posp y)
+               (posp z)
+               (> z 16)
+               (<= x z))
+          (> (* z z) (* x x))))
+
+(test?
+ (implies (and (posp x)
+               (posp y)
+               (posp z)
+               (> z 16)
+               (<= (+ x y) (* 2 z)))
+          (or (> (* x y z) (* x y x))
+              (> (* x y z) (* x y y)))))
+
+#|
+;(trace$ defdata::find-recursive-records)
+;TERMINATION ISSUES with records
+(defdata form (oneof pos
+                     (fnot (f . form))
+                     (fand (lhs . form) (rhs . form))
+                     (for (lhs . form) (rhs . form))
+                     (fimplies (lhs . form) (rhs . form))))
+
+(defdata formula (oneof pos
+                        (list 'not formula)
+                        (list 'and formula formula)
+                        (list 'or formula formula)
+                        (list 'implies formula formula)))
+;(untrace$)
+(defunc simplify (f)
+  :input-contract (formulap f)
+  :output-contract (formulap (simplify f))
+  (cond ((posp f) f)
+        ((eq (first f) 'not) (list 'not (simplify (second f))))
+        ((eq (first f) 'and) (list 'and (simplify (second f)) (simplify (third f))))
+        ((eq (first f) 'or) (list 'or (simplify (second f)) (simplify (third f))))
+        ((eq (first f) 'implies) (list 'or (list 'not (simplify (second f))) (simplify (third f))))
+        (t f)))
+
+(set-acl2s-random-testing-use-instantiation-method 'simple)
+(set-acl2s-random-testing-max-num-of-random-trials 10)
+(defunc simplifiedp (f)
+  :input-contract (formulap f)
+  :output-contract (booleanp (simplifiedp f))
+   (cond ((posp f) t)
+        ((eq (first f) 'not) (simplifiedp (second f)))
+        ((eq (first f) 'and) (and (simplifiedp (second f)) (simplifiedp (third f))))
+        ((eq (first f) 'or) (and (simplifiedp (second f)) (simplifiedp (third f))))
+        ((eq (first f) 'implies) nil)
+        (t nil)))
+  
+(defthm simplify-is-stable
+  (implies (formulap f)
+           (equal (simplify (simplify f))
+                  (simplify f))))
+
+(defunc nnf (f)
+  :input-contract (formulap f)
+  :output-contract (formulap (nnf f))
+   (cond ((posp f) f)
+        ((and (eq (first f) 'not) (posp (second f))) f)
+        ((and (eq (first f) 'not) (eq 'not (first (second f))))
+         (nnf (second (second f))))
+        ((eq (first f) 'and) (list 'and (nnf (second f)) (nnf (third f))))
+        ((eq (first f) 'or) (list 'or (nnf (second f)) (nnf (third f))))
+        ((eq (first f) 'implies) (list 'implies (nnf (second f)) (nnf (third f))))
+        ((and (eq (first f) 'not)
+              (eq 'and (first (second f))))
+         (let* ((a (second f))
+                (lhs (second a))
+                (rhs (third a)))
+           (list 'or (nnf (list 'not lhs)) (nnf (list 'not rhs)))))
+        ((and (eq (first f) 'not)
+              (eq 'or (first (second f))))
+         (let* ((a (second f))
+                (lhs (second a))
+                (rhs (third a)))
+           (list 'and (nnf (list 'not lhs)) (nnf (list 'not rhs)))))     
+         ((and (eq (first f) 'not)
+              (eq 'implies (first (second f))))
+         (let* ((a (second f))
+                (lhs (second a))
+                (rhs (third a)))
+           (list 'and (nnf lhs) (nnf (list 'not rhs)))))
+        (t f)))
+;(trace$ run-trials)
+
+(SET-ACL2S-RANDOM-TESTING-SEED-GENERATION-TYPE 'nat-tree)
+(er-let* ((tr (build-rand-tree-top 'formula state)))
+  (value (nth-formula tr)))
+;TODO BUG
+(SET-ACL2S-RANDOM-TESTING-SEED-GENERATION-TYPE 'nat)
+
+(top-level-test? ;simp-nnf-commute
+  (implies (formulap f)
+  (equal (nnf (simplify f))
+         (simplify (nnf f)))))
+
+|#
+(defdata file (cons nat string))
+(defdata dir (listof (cons string (oneof file dir))))
+;FIX TODO
+(defdata (dir1 (map string dir-entry1))
+         (dir-entry1 (oneof file dir1)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;fermat number
+(defun fermat (n)
+  (1+ (expt 2 (expt 2 (nfix n)))))
+
+;Euler: All factors of f(n) should have the form k*2^{n+1} + 1
+;Lucas: for all n > 1, factors of f(n) are of form k*2^{n+2} + 1
+(defun f-factor (k n)
+  (let ((k (nfix k))
+        (n (nfix n)))
+    (1+ (* k (expt 2 (+ 1 n))))))
+
+;is k a factor of n other than 1 and n?
+(defun factor (k n)
+  (and (< 1 k)
+       (< k n)
+       (natp (/ n k))))
+
+(test?
+ (implies (posp k)
+          (not (factor k (fermat 5)))))
+
+(test?
+ (implies (posp k)
+          (not (factor (f-factor k 5) (fermat 5)))))
+
+(acl2s-defaults :set num-witnesses 0)
+(acl2s-defaults :set num-trials 10000)
+
+(time$
+(top-level-test?
+ (implies (and (posp k)
+               (posp n)
+               (< n 15))
+          (not (factor k (fermat n)))))
+)
+(acl2s-defaults :set instantiation-method :simple)
+(acl2s-defaults :set num-trials 10000)
+;1000
+;incr: 44.88
+;simple: 0.11
+;10,000
+;simple: 1.07
+;incr: no patience to check
+(acl2s-defaults :set verbosity-level 1)
+(time$
+ (top-level-test?
+ (implies (and (posp k)
+               (posp n)
+               (< n 15))
+          (not (factor (f-factor k n) (fermat n)))))
+ )
+
+
+(test? (implies (true-listp x) (not (equal x (list y v w z)))))
+
+;; take : Nat * List-of-Int -> List-of-Int
+(defun take-n (n lst)
+  (if (endp lst)
+    nil
+    (if (zp n)
+      nil
+      (cons (car lst) (take-n (1- n) (cdr lst))))))
+
+;; drop : Nat * List-of-Int -> List-of-Int
+(defun drop-n (n lst)
+  (if (endp lst)
+    nil
+    (if (zp n)
+      lst
+      (drop-n (1- n) (cdr lst)))))
+
+;; Prove commutativity of take and drop
+(acl2s-defaults :set num-trials 100)
+
+(defthm take-drop-commute
+  (implies (and (integerp i)
+                (integerp j)
+                (integer-listp lst))
+           (equal
+            (take-n j (drop-n i lst))
+            (drop-n i (take-n (+ i j) lst)))))
+ 
+(top-level-test? 
+ (implies (and (posp (car x))
+               (posp (cdr x)))
+          (<= (cdr x) (len x)))
+ )
+;this checks that top goal counterexamples are printed
+;no longer works, as counterexample is found before ACL2 dest elims
+(acl2s-defaults :set num-witnesses 5)
+
+(test? (implies (and (posp (car x))
+                     (posp (cdr x)))
+                (<= (cdr x) (len x)))
+       )
+(defdata loi (listof integer))
+(test?
+ (implies (and (posp i)
+               (posp j)
+               (loip lst))
+          (equal
+           (take-n j (drop-n i lst))
+           (drop-n i (take-n j lst)))))
+
+(defun large-list (x)
+  (and  (or (character-listp x) (loip x))
+        (> (len x) 3)))
+
+(test?  (implies (large-list x) (> (len x) 6)))
+
+;old
+(thm (implies (large-list x) (> (len x) 6)));this gives an example where acl2check infers stronger than acl2 type-alist? YES!!
+;but note that acl2 does have that knowledge in the type context.
+
+(test? (implies (and (or (true-listp x)
+                             (stringp x))
+                         (not (equal x nil))
+                         (not (equal x "")))
+                    (> (len x) 0)))
+
+(test? (iff (implies p q) (or (not p) p)))
+
+;this checks that top goal counterexamples are printed
+;;this checks and also checks eliminated variables
+(test? (implies (and (posp (car x))
+                     (equal y y)
+                     (equal z y)
+                     (posp (cdr x)))
+                (<= (cdr x) (len x))))
+(acl2s-defaults :set verbosity-level 1)
+;;checking commutative property for take and drop
+(test? ;take-drop-commute
+ (implies (and (posp i) (posp j) (loip lst)) 
+  (equal
+   (take-n j (drop-n i lst))
+   (drop-n i (take-n j lst)))))
+
+;;Ahh counter-example ...lets modify the property
+(test? ;take-drop-commute-modified
+ (implies (and (natp i) (natp j) (loip lst )) 
+  (equal
+   (take-n j (drop-n i lst))
+   (drop-n i (take-n (+ i j) lst)))))
+
+;counterexample:
+ ;-- (Y 40/7) and (X 12)
+;hard
+(acl2s-defaults :set verbosity-level 1)
+(thm (IMPLIES (AND (RATIONALP X)
+                    (RATIONALP Y)
+                    (NOT (EQUAL Y 0))
+                    (<= 0 Y)
+                    (<= 0 X)
+                    (<= Y X)
+                    (INTEGERP (+ 1 (- X)))
+                    (< 1 X)
+                    (NOT (INTEGERP (+ 1 (- X) (* 2 Y))))
+                    (<= X (+ 1 (* 2 Y))))
+               (< X
+                  (+ 1 (DENOMINATOR (+ 1 (- X) (* 2 Y)))
+                     (NUMERATOR (+ 1 (- X) (* 2 Y)))))))
+
+(thm (IMPLIES (AND (RATIONALP X)
+              (RATIONALP Y)
+              (NOT (EQUAL Y 0))
+              (<= 0 Y)
+              (<= 0 X)
+              (<= Y X))
+         (O< (ACL2-COUNT (+ 1 0 (- (+ (+ X (- Y)) Y))))
+             (ACL2-COUNT (+ 1 Y (- (+ X (- Y))))))))
+(acl2s-defaults :set num-witnesses 2)
+(acl2s-defaults :set num-counterexamples 2)
+(thm 
+ (implies (and (natp i)
+               (natp x)
+               ;(> x 0);testting found
+               (<= i x))
+          (equal (nth i (cons a (defdata::make-list-logic a x)))
+                 (nth (- i 1) (defdata::make-list-logic a x)))))
+
+(test? 
+  (implies (and (integerp c1)
+                (integerp c2)
+                (posp x1)
+                (posp x2)
+                (< x1 x2)
+                (equal 0 (+ c1 c2))
+                (equal 0 (+ (* c1 x1) (* c2 x2))))
+           (and (= 0 c1) (= 0 c2))))
+
+;excellent, this never worked before
+;first example demontrating the superiority of
+; :incremental (DPLL) over :simple (naive random testing)
+(acl2s-defaults :set instantiation-method :incremental)
+(acl2s-defaults :set backtrack-limit 4)
+(time$
+ ;simple: 2.13 seconds no counterexample no witness
+;incr: 41.52 seconds blimit:4 cts:2 and wts:2
+;incr: 48.56 seconds blimit:0 cts:0 and wts:0
+;incr: 63.08 seconds blimit:3 cts:2 and wts:2
+;incr: 78.08 seconds blimit:3 cts:2 and wts:2
+;incr: 143.13 seconds blimit:2 cts:2 and wts:2
+;incr: 105.95 seconds blimit:2 cts:2 and wts:2
+;incr: 175.94 seconds blimit:1 cts:1 and wts:2 + 1
+(test? 
+  (implies (and (integerp c1)
+                (integerp c2)
+                (integerp c3)
+                (posp x1)
+                (posp x2)
+                (posp x3)
+                (< x1 x2)
+                (< x2 x3)
+                (equal 0 (+ c1 c2 c3))
+                (equal 0 (+ (* c1 x1) (* c2 x2) (* c3 x3))))
+           (and (= 0 c1) (= 0 c2) (= 0 c3))))
+)
+;IDEA: Need to create a rule manager (sorter) which will
+;manage the rule database looking for rules that will
+;give me almost linear variable dependency graph with
+;the edges mostly a relation like equality which will
+;propagate the decisions made at the source
+
+;MORE:
+;Can we store some output/input information on each
+;function/predicate, that might help glean more information
+;for dependency analysius````?
+
+#|
+We falsified the conjecture. Here are counterexamples:
+ -- (X3 8), (X2 7), (X1 6), (C3 -2), (C2 4) and (C1 -2)
+ -- (X3 6), (X2 4), (X1 3), (C3 1), (C2 -3) and (C1 2)
+ -- (X3 10), (X2 8), (X1 2), (C3 -3), (C2 4) and (C1 -1)
+|#
+
+;(defdata memory (listof (cons nat integer)))
+(defdata memory (map nat integer))
+
+(nth-memory 9436794189)
+
+(defun update (address value memory)
+  (cond ((endp memory)
+         (acons address value nil))
+        ((equal address (caar memory))
+         (acons address value (cdr memory)))
+        ((< address (caar memory))
+         (acons address value memory))
+        (t (cons (car memory) 
+                 (update address value (cdr memory))))))
+
+
+;Conjecture - version#1
+(test?
+ (equal (update a1 v1 (update a2 v2 m))
+        (update a2 v2 (update a1 v1 m))))
+(acl2s-defaults :set backtrack-limit 3)
+(acl2s-defaults :set instantiation-method :simple)
+; Conjecture - version 2
+(time$
+ ;10july incr:16.5 sec
+ ;10july simple:0.06 sec
+(test?
+ (implies (and (memoryp m)
+               (natp a1)
+               (natp a2))
+          (equal (update a1 v1 (update a2 v2 m))
+                 (update a2 v2 (update a1 v1 m))))))
+
+(defdata::build-enumcall-top 'memory state)
+
+(defun in-memory (a m)
+  (if (endp m)
+    nil
+    (or (equal a (caar m))
+        (in-memory a (cdr m)))))
+
+(acl2s-defaults :set instantiation-method :incremental)
+(acl2s-defaults :set backtrack-limit 2)
+;Conjecture - version#3
+(time$
+ ;10jul: incremental -> 21.58/12.44 (3) 8.21/11.73 (2)
+(test?
+ (implies (and (memoryp m)
+               (natp a1)
+               (natp a2)
+               (or (in-memory a1 m)
+                   (in-memory a2 m)))
+          (equal (update a1 v1 (update a2 v2 m))
+                 (update a2 v2 (update a1 v1 m))))))
+
+
+(acl2s-defaults :set instantiation-method :simple)
+;(acl2s-defaults :set backtrack-limit 4)
+;Conjecture - version#4
+;28.19 seconds with random testing incremental (blimit 3)
+;26.69 seconds with random testing incremental (blimit 2)
+;22.15 seconds with random testing incremental (blimit 1)
+;8.62 seconds with random testing incremental (blimit 0)
+;1.84 seconds with random testing simple
+;1.75 seconds with random testing disabled
+;50.5 seconds on July 10 2011 (incremental blimit 2)
+(thm
+ (implies (and (memoryp m)
+               (natp a1)
+               (natp a2)
+               (or (in-memory a1 m)
+                   (in-memory a2 m))
+               (not (equal a1 a2)))
+          (equal (update a1 v1 (update a2 v2 m))
+                 (update a2 v2 (update a1 v1 m)))))
+;23.36 seconds with random testing incremental (blimit 4 and 5)
+
+;AA Trees
+(defdata aa-tree (oneof 'Bottom 
+                        (node (key . pos)
+                              (level . nat)
+                              (left . aa-tree)
+                              (right . aa-tree))))
+
+;FIX TODO Both left and right trees are always of same size
+(defdata::build-enumcall-top 'aa-tree state)
+
+
+;Performance of Nat-tree vs Nat
+(defun run4-for-i (i type state)
+  (declare (xargs :mode :program :stobjs (state)))
+  (if (zp i)
+    (value nil)
+    (er-progn
+     (if (not (acl2s-defaults :get flatten-defdata))
+       (er-let* ((enum-info (defdata::get-enum-info type 'test (w state) state)))
+         (defdata::build-enumcall-from-enum-info type enum-info 'test state))
+       (defdata::build-enumcall-top type state))
+     (run4-for-i (1- i) type state))))
+
+(acl2s-defaults :set flatten-defdata t) 
+;stupid performance bug due to acl2::current-acl2-world package name
+(time$ (run4-for-i 100000 'aa-tree state))
+;something is slower (is it CCL/SBCL?) Jul 10 -> 1.41 vs 7.85
+;0.49 vs 4.89
+
+(defun skew (tree)
+  (if (eq 'Bottom tree)
+    tree
+    (if (= (mget :level (mget :left tree)) (mget :level tree))
+      ;;rotate right
+      (let ((ltree (mget :left tree))
+            (rtree (mget :right tree)))
+        (node (mget :key ltree)
+              (mget :level ltree)
+              (mget :left ltree)
+              (node (mget :key tree)
+                    (mget :level tree)
+                    (mget :right ltree)
+                    rtree)))
+      tree)))
+
+(defun split (tree)
+  (if (eq 'Bottom tree)
+    tree
+    (if (<= (mget :level tree)
+            (mget :level (mget :right (mget :right tree))))
+      ;;rotate left
+      (let* ((rtree (mget :right tree))
+             (rrtree (mget :right rtree)))
+        (node (mget :key rtree)
+              (1+ (mget :level rtree))
+              (node (mget :key tree)
+                    (mget :level tree)
+                    (mget :left tree)
+                    (mget :left rtree))
+              rrtree))
+      tree)))
+
+(set-acl2s-random-testing-enabled nil)
+(defun insert (data tree)
+  (if (or (eq 'Bottom tree) (not (aa-treep tree)))
+    (node data 1 'Bottom 'Bottom)
+    (if (equal data (mget :key tree))
+      tree
+      (let ((newtree (if (< data (mget :key tree))
+                       (mset :left 
+                             (insert data (mget :left tree))
+                             tree)
+                       (mset :right
+                             (insert data (mget :right tree))
+                             tree))))
+        (split
+         ;(skew
+          newtree)))))
+
+(defun wf-aa-treep (tree)
+  (if (not (aa-treep tree))
+    nil
+    (if (eq 'Bottom tree)
+      t
+      (let ((n (mget :level tree))
+            (l (mget :left tree))
+            (r (mget :right tree)))
+        (if (eq 'Bottom l)
+          (and (= 1 n)
+               (or (eq 'Bottom r)
+                   (and (= 1 (mget :level r))
+                        (eq 'Bottom (mget :left r))
+                        (eq 'Bottom (mget :right r)))))
+          (and (wf-aa-treep l)
+               (wf-aa-treep r)
+               (not (eq 'Bottom r))
+             (< (mget :level l) n)
+             (<= (mget :level r) n)
+             (< (mget :level (mget :right r)) n)))))))
+
+(defthm skew-wf
+  (implies (and (aa-treep v)
+                (wf-aa-treep v))
+           (equal (skew v) v)))
+
+(defthm split-wf
+  (implies (and (aa-treep v)
+                (wf-aa-treep v))
+           (equal (split v) v)))
+(set-acl2s-random-testing-enabled t)
+
+(acl2s-defaults :set flatten-defdata nil)
+(acl2s-defaults :set backtrack-limit 3)
+(acl2s-defaults :set verbosity-level 1)
+(acl2s-defaults :set instantiation-method :simple)
+(test? (implies (and (aa-treep tr);type hyp
+                     (posp n);type hyp
+                     (wf-aa-treep tr));constraint
+                (wf-aa-treep (insert n tr))))
+
+;#|
+;Experimenting:
+(set-acl2s-random-testing-enabled nil)
+(defun insert3 (data tree)
+  (if (or (eq 'Bottom tree) (not (aa-treep tree)))
+    (node data 1 'Bottom 'Bottom)
+    (if (equal data (mget :key tree))
+      tree
+      (let ((newtree (if (< data (mget :key tree))
+                       (mset :left 
+                             (insert3 data (mget :left tree))
+                             tree)
+                       (mset :right
+                             (insert3 data (mget :right tree))
+                             tree))))
+        ;(split
+         (skew
+          newtree)))))
+
+(acl2s-defaults :set flatten-defdata nil)
+
+(test? (implies (and (aa-treep tr);type hyp
+                   (posp n);type hyp
+                   (wf-aa-treep tr));constraint
+              (wf-aa-treep (insert3 n tr))))
+
+(top-level-test? (implies (and (aa-treep tr))
+                (wf-aa-treep tr)))
+
+(top-level-test? (implies (and (aa-treep tr))
+                (wf-aa-treep tr)))
+                   
+                
+(test? 
+ (implies (aa-treep tr)
+          (equal (split (split tr))
+                 (split tr))))
+ 
+
+
+(test?
+ (IMPLIES (AND (AA-TREEP TR)
+               (= N '(z x y z w r t y b d fg dfg dfg))
+               (WF-AA-TREEP TR)
+               ;(>>= N (MGET :KEY TR))
+               (NOT (EQUAL (MGET :LEVEL (MGET :LEFT TR))
+                           (MGET :LEVEL TR))))
+          (not (WF-AA-TREEP (MSET :RIGHT (INSERT3 N (MGET :RIGHT TR))
+                             TR)))))
+
+
+;---------interesting code for students
+;(defdata adjacency-list (map symbol symbol-list))
+(defun adjacency-list1p (v)
+  (if (null v)
+      t
+    (if (atom v)
+        nil
+      (let ((entry (car v)))
+      (and (symbolp (car entry))
+           (symbol-listp (cdr entry))
+           (no-duplicatesp (cdr entry))
+           (adjacency-list1p (cdr v)))))))
+
+(defun adjacency-listp (v)
+  (and (adjacency-list1p v)
+       (no-duplicatesp (strip-cars v))))
+
+(defun make-empty-adj-list (vars)
+  (declare (xargs :guard (and (symbol-listp vars)
+                              (no-duplicatesp vars))))
+  ;order important 
+  ;order of keys alst created is the same as order of vars
+  (if (endp vars)
+    nil
+    (cons (cons (car vars) nil)
+          (make-empty-adj-list (cdr vars)))))
+
+
+
+;fs means Functionaly dependent vars
+;ASSUMPTION: alst has all the variables as keys already
+;this function just updates the entries, doesnt insert
+;new entries.
+(defun union-entry-in-adj-list (var fvars alst)
+  (if (endp alst)
+      nil
+    (if (eq var (caar alst))
+      (cons (cons var (union-equal fvars 
+                                   (cdar alst)))
+            (cdr alst))
+      (cons (car alst)
+            (union-entry-in-adj-list var fvars (cdr alst))))))
+  
+  
+;recurse above fun over list of indices
+(defun union-entries-in-adj-list (is fis alst)
+ (if (endp is)
+    alst
+    (union-entries-in-adj-list 
+     (cdr is) fis (union-entry-in-adj-list (car is) fis alst))))
+
+  
+(defun transpose-alst1 (alst ans)
+;Scan G at index i and transpose the result corresponding to i in ans
+  (if (endp alst)
+      ans
+    (b* (((cons v vs) (car alst)))
+      (transpose-alst1 (cdr alst)
+                       (union-entries-in-adj-list vs (list v) ans)))))
+  
+
+(defun transpose-alst (alst)
+;Return transpose/reverse of alst
+;INVARIANT: Order is very important
+  (transpose-alst1 alst (make-empty-adj-list (strip-cars alst))))
+
+(defun non-empty-symbol-list1p (x)
+  (declare (xargs :guard t))
+  (and (consp x)
+       (symbol-listp x)))
+
+(defun nth-non-empty-symbol-list1 (n)
+  (nth-symbol-list (1+ n)))
+(register-custom-type 
+         non-empty-symbol-list1 t
+         nth-non-empty-symbol-list1
+         non-empty-symbol-list1p)
+(defun non-boolean-symbolp (x)
+  (declare (xargs :guard t))
+  (and (not (booleanp x))
+       (symbolp x)))
+(defun nth-non-boolean-symbol (n)
+  (if (eq nil (nth-symbol n))
+    'a
+    (nth-symbol n)))
+(register-custom-type 
+         non-boolean-symbol t
+         nth-non-boolean-symbol
+         non-boolean-symbolp)
+(defdata adjacency-list2 (map non-boolean-symbol non-empty-symbol-list1))
+
+(defthm transpose-idempotent
+  (implies (and (adjacency-list2p x)
+                (adjacency-listp x))
+           (equal (transpose-alst (transpose-alst x))
+                  x)))
+
+(defthm transpose-doesnt-change-order
+  (implies (and (adjacency-list2p x)
+                (adjacency-list1p x))
+           (equal (strip-cars (transpose-alst x))
+                  (strip-cars x))))
+
+;;; boyer alternating.events
+;;; Use these to automatically generate generators from predcates or do
+;;; mode-analysis etc --harshrc
+
+; Now on to my formalization.  We first define the six functions
+; needed in the statement of the theorem.  The main, all encompassing,
+; theorem is stated at the very end, and is named ``all''.
+
+; Intuitively, we imagine that cards are arbitrary objects, but
+; numbers are ``red'' and nonnumbers are ``black.''
+
+(defn opposite-color (x y)
+
+; This is the definition of ``opposite-color,'' which checks that its
+; two arguments, x and y, are of opposite color, in the intuitive
+; sense mentioned above.
+
+  (or (and (numberp x) (not (numberp y)))
+      (and (numberp y) (not (numberp x)))))
+
+(defn alternating-colors (x)  
+
+; This is the definition of ``alternating-colors,'' which checks that
+; its argument, x, is a list of objects whose colors alternate.  In the
+; base case, if the list is empty or the list has length one, then we
+; say it is indeed alternating.  In the inductive or recursive case,
+; we require that the first two elements be of opposite color and that
+; the ``rest,'' i.e., cdr, i.e., all but the first, of the list be
+; alternating.
+
+  (if (or (nlistp x)
+          (nlistp (cdr x)))
+      t
+    (and (opposite-color (car x) (cadr x))
+         (alternating-colors (cdr x)))))
+
+(defn paired-colors (x) 
+
+; This is the definition of ``paired-colors,'' which checks that its
+; argument, x, is a list such that if its elements are pealed off from
+; the front in pairs, the pairs are found to be of opposite color.  In
+; the base case, we say a list of length 0 or 1 is paired.  In the
+; inductive or recursive case, where the list has at least length 2,
+; we insist that the first and second elements be of opposite color,
+; and that the ``cddr,'' i.e., the rest of the list past the first two
+; elements, is paired.
+
+  (if (or (nlistp x)
+          (nlistp (cdr x)))
+      t
+    (and (opposite-color (car x) (cadr x))
+         (paired-colors (cddr x)))))
+
+
+
+(defn shufflep (x y z)
+
+; This is the definition of ``shufflep,'' which checks that its third
+; argument, z, is a ``merge'' or ``shuffling'' of its first two
+; arguments, x and y.  Shufflep also requires that x, y, and z all be
+; ``plistp''.
+
+; In the base case, where z is empty, we insist that x, y, and z all
+; be NIL.
+
+; In the ``almost'' base cases in which z is not empty, but either x
+; or y is empty, we insist that if x is empty, then x is NIL, y is
+; equal to z, and y is ``plistp'', whereas if x is not empty but y is,
+; we insist that y is NIL, x is equal to z, and x is ``plistp''.
+
+; In the fully inductive case, where none of x, y, or z, is empty, we
+; insist that either (a) the first element of x is the first element
+; of z and (cdr z) is a shuffle of (cdr x) and y, or (b) the first
+; element of y is the first element of z and (cdr z) is a shuffle of x
+; and (cdr y).
+
+  (if (nlistp z)
+      (and (equal x nil)
+           (equal y nil)
+           (equal z nil))
+    (if (nlistp x)
+        (and (equal x nil)
+             (equal y z)
+             (plistp y))
+      (if (nlistp y)
+          (and (equal y nil)
+               (equal x z)
+               (plistp x))
+        (or (and (equal (car x) (car z))
+                 (shufflep (cdr x) y (cdr z)))
+            (and (equal (car y) (car z))
+                 (shufflep x (cdr y) (cdr z))))))))
+
+(defn even-length (l)
+
+; This is the definition of ``even-length,'' which checks that the
+; length of its argument, l, is even.  In the base cases, if l is
+; empty we return true and if l has one element we return false.  In
+; the inductive or recursive case, we insist that (cddr l), i.e., the
+; rest of l after its second element, has even length.
+
+  (if (nlistp l)
+      t
+    (if (nlistp (cdr l))
+         f
+      (even-length (cddr l)))))
+
diff -Nru acl2-6.2/books/cgen/top.lisp acl2-6.3/books/cgen/top.lisp
--- acl2-6.2/books/cgen/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/top.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,68 @@
+#|$ACL2s-Preamble$;
+;;Author - Harsh Raju Chamarthi (harshrc)
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+(begin-book t :ttags :all);$ACL2s-Preamble$|#
+
+;; Note: I apologize for the use of ttags, but they are used for engineering
+;; purposes: for implementing timeouts. The above should in principle not
+;; affect ACL2's soundness. Usually you would include this book while
+;; developing/designing proofs and when you have all QEDs, simply remove this
+;; book.
+
+
+(in-package "ACL2")
+
+(include-book "acl2s-parameter")
+(include-book "main" :ttags :all)
+(include-book "base" :ttags :all)
+
+
+
+
+(make-event 
+ (er-progn
+  (assign defdata::cgen-stats-event-stack nil)
+  (value '(value-triple :invisible)))
+ :check-expansion t)
+
+; For now lets keep the nats not more than 1000 to avoid stack-overflow
+; on non-tail-recursive functions. If you dont like these, comment
+; them out, or write your own custom test enumerators and attach them
+(defdata-testing pos :test-enumerator nth-pos-testing)
+(defdata-testing integer :test-enumerator nth-integer-testing)
+(defdata-testing nat :test-enumerator nth-nat-testing)
+(defdata-testing neg :test-enumerator nth-neg-testing)
+
+
+; The following shows the various configuration parameters that you
+; can customize.
+; The usual format is (acl2s-defaults :get <param>) for getting the
+; current value of the parameter named <param>. The setter is similar
+; you can see examples below, where most useful parameters are set
+; with their default values. Copy and change what you want, these are
+; embedded events, so you can put them in books. To know more about
+; these parameters, simply do :doc <param> at the ACL2 prompt.
+
+;; (acl2s-defaults :set testing-enabled :naive) ;other values are T,NIL
+;; (acl2s-defaults :set verbosity-level 1) 
+;; (acl2s-defaults :set num-trials 1000)
+;; (acl2s-defaults :set num-counterexamples 3)
+;; (acl2s-defaults :set num-witnesses 3)
+;; (acl2s-defaults :set search-strategy :simple) ;other value is :incremental
+;; (acl2s-defaults :set sampling-method :random) 
+;; (acl2s-defaults :set subgoal-timeout 10) ;0 turns off timeout
+
+
+;; USAGE:
+;; Add (include-book "countereg-gen/top" :dir :system :ttags :all)
+;; Add (acl2s-defaults :set testing-enabled T) if you want to add
+;; full-blown testing+theorem-proving.
+;; Add (acl2s-defaults :set testing-enabled :naive) if you want to
+;; do simple testing without invoking the mighty theorem prover.
+
+;; EXAMPLES:
+;; Check our testing-regression.lsp
+
+;; NOTE: If you want to browse code, you might wonder what def, f* etc
+;; mean. You should then first read basis.lisp to understand what they do
\ No newline at end of file
diff -Nru acl2-6.2/books/cgen/type.lisp acl2-6.3/books/cgen/type.lisp
--- acl2-6.2/books/cgen/type.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/type.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,122 @@
+#|$ACL2s-Preamble$;
+(acl2::begin-book t);$ACL2s-Preamble$|#
+
+(in-package "ACL2")
+(include-book "tools/bstar" :dir :system)
+
+;;; For use by testing hints
+;;; Get the type information from the ACL2 type alist
+(mutual-recursion
+ (defun get-type-from-type-set-decoded (ts-decoded)
+   ;(declare (xargs :guard (symbolp ts-decoded)))
+   (cond   ;primitve types
+    ((eq ts-decoded '*TS-ZERO*)                  '(0) )
+    ((eq ts-decoded '*TS-POSITIVE-INTEGER*)      '(pos) )     ;;; positive integers
+    ((eq ts-decoded '*TS-POSITIVE-RATIO*)        '(positive-ratio) )     ;;; positive non-integer rationals
+    ((eq ts-decoded '*TS-NEGATIVE-INTEGER*)      '(neg) ) ;;; negative integers
+    ((eq ts-decoded '*TS-NEGATIVE-RATIO*)        '(negative-ratio) ) ;;; negative non-integer rationals
+    ((eq ts-decoded '*TS-COMPLEX-RATIONAL*)      '(complex-rational) );;; complex rationals
+    ((eq ts-decoded '*TS-NIL*)                   '('nil) );;; {nil}
+    ((eq ts-decoded '*TS-T*)                     '('t) );;; {t}
+    ((eq ts-decoded '*TS-NON-T-NON-NIL-SYMBOL*)  '(symbol) );;; symbols other than nil, t
+    ((eq ts-decoded '*TS-PROPER-CONS*)           '(proper-cons) );;; null-terminated non-empty lists
+    ((eq ts-decoded '*TS-IMPROPER-CONS*)         '(improper-cons) );;; conses that are not proper
+    ((eq ts-decoded '*TS-STRING*)                '(string) );;; strings
+    ((eq ts-decoded '*TS-CHARACTER*)             '(character) );;; characters
+    
+;non-primitive types but defined in ground acl2 theory and base.lisp
+    ((eq ts-decoded '*TS-UNKNOWN*)               '(all) );should give out error?
+    ((eq ts-decoded '*TS-NON-NIL* )              '(all) )
+    ((eq ts-decoded '*TS-ACL2-NUMBER*)           '(acl2-number) )
+    ((eq ts-decoded '*TS-RATIONAL-ACL2-NUMBER*)  '(acl2-number) )
+    ((eq ts-decoded '*TS-RATIONAL* )             '(rational) )
+    ((eq ts-decoded '*TS-TRUE-LIST-OR-STRING*)   '(true-list string)) 
+    ((eq ts-decoded '*TS-SYMBOL*   )             '(symbol) )
+    ((eq ts-decoded '*TS-INTEGER*   )            '(integer) )
+    ((eq ts-decoded '*TS-NON-POSITIVE-RATIONAL*) '(negative-rational 0))
+    ((eq ts-decoded '*TS-NON-NEGATIVE-RATIONAL*) '(positive-rational 0))
+    ((eq ts-decoded '*TS-NEGATIVE-RATIONAL* )    '(negative-rational) )
+    ((eq ts-decoded '*TS-POSITIVE-RATIONAL* )    '(positive-rational) )
+    ((eq ts-decoded '*TS-NON-NEGATIVE-INTEGER*)  '(nat));(0 pos)) 
+    ((eq ts-decoded '*TS-NON-POSITIVE-INTEGER*)  '(neg 0)) 
+    ((eq ts-decoded '*TS-RATIO*)                 '(ratio) )
+    ((eq ts-decoded '*TS-CONS*  )                '(cons) )
+    ((eq ts-decoded '*TS-BOOLEAN*)               '(boolean) )
+    ((eq ts-decoded '*TS-TRUE-LIST*)             '(true-list) )
+    
+    ((eq ts-decoded '*TS-EMPTY*)                 '(empty));is it possible?
+    (t  (if (consp ts-decoded)
+            (cond 
+             ((equal 'TS-UNION (car ts-decoded))
+              (get-types-from-type-set-decoded-lst (cdr ts-decoded) nil))
+             ((and (equal 'TS-COMPLEMENT (car ts-decoded))
+                   (equal (cadr ts-decoded) '*TS-CONS*))
+              '(atom))
+             (t '(all)))
+          '(all)))))
+ 
+(defun get-types-from-type-set-decoded-lst (ts-lst ans)
+   (if (endp ts-lst)
+     ans
+     (get-types-from-type-set-decoded-lst 
+      (cdr ts-lst) 
+      (append (get-type-from-type-set-decoded (car ts-lst))
+              ans))))
+ )
+
+(defun get-type-list-from-type-set (ts)
+  (declare (xargs :mode :program
+                  :guard (integerp ts)))
+  (let ((typ (get-type-from-type-set-decoded 
+              (acl2::decode-type-set ts))))
+    (if (proper-consp typ)
+      typ
+      (list typ))))
+
+(defun get-types-from-type-set-lst (ts-lst)
+  (declare (xargs :mode :program 
+                  :guard (integer-listp ts-lst)))
+  (if (endp ts-lst)
+    nil
+    (append (get-type-list-from-type-set (car ts-lst))
+            (get-types-from-type-set-lst (cdr ts-lst)))))
+
+
+
+; for each var in freevars, look into the type-alist
+; and build a no-dup vt-al(var-types-alist)
+; Note: we can get a list of types which means TS-UNION
+(defun get-var-types-from-type-alist (acl2-type-alist freevars ans)
+  (declare (xargs :mode :program
+                  :guard (and (alistp acl2-type-alist)
+                              (symbol-listp freevars))))
+  (if (endp freevars)
+      ans
+    (b* ((var (car freevars))
+; CHECK: Can acl2-type-alist have duplicate keys?
+         (ts-info (assoc-eq var acl2-type-alist))
+         (ts (if (consp ts-info) (cadr ts-info) nil)))
+     (if ts
+         (let ((types (get-type-list-from-type-set ts)))
+          (get-var-types-from-type-alist acl2-type-alist 
+                                          (cdr freevars) 
+                                          (acons var types ans)))
+       (get-var-types-from-type-alist acl2-type-alist 
+                                       (cdr freevars) ans)))))
+
+(defun decode-acl2-type-alist (acl2-type-alist freevars)
+  (declare (xargs :mode :program
+                  :guard (and (alistp acl2-type-alist)
+                              (symbol-listp freevars))))
+  (if (endp acl2-type-alist)
+      '()
+    (get-var-types-from-type-alist acl2-type-alist freevars '())))
+
+
+
+(set-verify-guards-eagerness 0)
+
+(verify-termination acl2::quote-listp)
+(verify-termination acl2::cons-term1)
+(verify-termination acl2::cons-term); ASK MATT to make these logic mode
+(set-verify-guards-eagerness 1)
diff -Nru acl2-6.2/books/cgen/utilities.lisp acl2-6.3/books/cgen/utilities.lisp
--- acl2-6.2/books/cgen/utilities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/utilities.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,1178 @@
+#|$ACL2s-Preamble$;
+(ld ;; Newline to fool ACL2/cert.pl dependency scanner
+ "portcullis.lsp")
+
+;;Bunch of utility functions for use by datadef and test?
+;;mostly copied from data.lisp and acl2-check.lisp
+
+(acl2::begin-book t);$ACL2s-Preamble$|#
+
+
+(in-package "DEFDATA")
+
+(set-verify-guards-eagerness 2)
+(include-book "tools/bstar" :dir :system)
+;(include-book "basis")
+
+;;-- create a new symbol with prefix or suffix appended
+;;-- if its a common-lisp symbol then attach acl2 package name to it
+;;-- example:
+;;-- (modify-symbol "NTH-" 'bool "") ==> NTH-BOOL
+;;-- (modify-symbol "NTH-" 'boolean "") ==> ACL2::NTH-BOOLEAN
+(defun modify-symbol (prefix sym postfix)
+  (declare (xargs :guard (and (symbolp sym)
+                              (stringp postfix)
+                              (stringp prefix))))
+  (let* ((name (symbol-name sym))
+         (name (string-append prefix name))
+         (name (string-append name postfix)))
+    (if (member-eq sym *common-lisp-symbols-from-main-lisp-package*)
+      (intern-in-package-of-symbol name 'acl2::acl2-pkg-witness)
+      (intern-in-package-of-symbol name sym))))
+
+(defun modify-symbol-lst (prefix syms postfix)
+  (declare (xargs :guard (and (symbol-listp syms)
+                              (stringp prefix)
+                             (stringp postfix))))
+  (if (endp syms)
+    nil
+    (cons (modify-symbol prefix (car syms) postfix)
+          (modify-symbol-lst prefix (cdr syms) postfix))))
+
+
+
+; utility fn to print if verbose flag is true 
+(defmacro cw? (verbose-flag &rest rst)
+  `(if ,verbose-flag
+     (cw ,@rst)
+     nil))
+
+
+
+
+(defmacro   debug-flag  (vl)
+  `(> ,vl 3))
+
+(defmacro   system-debug-flag ( vl)
+  `(> ,vl 4))
+
+(defmacro   verbose-stats-flag ( vl)
+  `(> ,vl 2)) 
+
+(defmacro   verbose-flag ( vl)
+  `(> ,vl 1))
+  
+
+(defmacro   inhibit-output-flag ( vl)
+  `(<= ,vl 0))
+  
+
+(defmacro   normal-output-flag ( vl)
+  `(> ,vl 0))
+
+
+
+(defmacro acl2-getprop (name prop w &key default)
+ `(getprop ,name ,prop ,default 'acl2::current-acl2-world ,w))
+
+
+;;-- Returns a symbol representing the predicate of the parameter sym which is normally a type
+;;-- (get-predicate-symbol 'integer) ==> INTEGERP
+(defun get-predicate-symbol (sym)
+  (declare (xargs :guard (symbolp sym)))
+  (modify-symbol "" sym "P"))
+
+;;-- (get-predicate-symbol-lst '(integer boolean rational)) ==> (INTEGERP BOOLEANP RATIONALP)
+(defun get-predicate-symbol-lst (syms)
+  (declare (xargs :guard (symbol-listp syms)))
+  (if (endp syms)
+    nil
+    (cons (get-predicate-symbol (car syms))
+          (get-predicate-symbol-lst (cdr syms)))))
+
+(local
+ (defthm valid-subseq-of-string-is-string
+   (implies (and (stringp pname)
+                 (< x (length pname))
+                 (< y (length pname))
+                 (<= x y))
+            (stringp (subseq pname x y)))
+   :rule-classes :type-prescription))
+
+;;inverse operation of the above --added by harshrc
+(defun get-typesymbol-from-pred-P-naming-convention (sym)
+  (declare (xargs :guard (and (symbolp sym))
+                  :guard-hints (("Goal" :in-theory (disable acl2::length acl2::subseq)))))
+
+  (let* ((pred-name (acl2::symbol-name sym))
+        (len-predname (acl2::length pred-name)))
+    (if (and
+         (< 1 len-predname) ;atleast have "p" and one more char
+         (equal #\P (acl2::char pred-name (1- len-predname)))) ;WTF, smallcase p wouldnt work
+      (let ((typename (acl2::subseq pred-name 0 (1- len-predname))));strip last char which is 'p'
+        (intern-in-package-of-symbol typename sym))
+      NIL))) ;TODO.Beware
+      ;(er hard 'get-typesymbol-from-pred "~x0 doesnt follow our convention of predicates ending with 'p'.~%" sym))))
+
+
+
+
+(defun or-list (lst)
+  (if (atom lst)
+    lst
+    (or (car lst)
+        (or-list (cdr lst)))))
+
+(defun to-symbol-in-package (sym pkg-name)
+  (declare (xargs :guard (and (symbolp sym)
+                              (not (equal pkg-name ""))
+                              (stringp pkg-name))))
+  (intern$ (symbol-name sym) pkg-name))
+
+(defun to-symbol-in-package-lst (sym-lst pkg)
+  (declare (xargs :guard (and (symbol-listp sym-lst)
+                              (not (equal pkg ""))
+                              (stringp pkg))))
+  (if (endp sym-lst)
+      nil
+    (cons (to-symbol-in-package (car sym-lst) pkg)
+          (to-symbol-in-package-lst (cdr sym-lst) pkg))))
+
+
+(defun cons-up-lists (l1 l2)
+  (declare (xargs :guard (and (true-listp l1)
+                              (true-listp l2)
+                              (= (len l1)
+                                 (len l2)))))
+  "same as pairlis$"
+  (if (endp l1)
+    nil
+    (cons (cons (car l1) (car l2))
+          (cons-up-lists (cdr l1) (cdr l2)))))
+
+
+;general
+(defun list-up-lists (l1 l2)
+  (declare (xargs :guard (and (true-listp l1)
+                              (true-listp l2)
+                              (= (len l1) (len l2)))))
+  "same as listlis"
+  (if (endp l1)
+    nil
+    (cons (list (car l1) (car l2))
+          (list-up-lists (cdr l1) (cdr l2)))))
+
+
+(verify-termination LEGAL-VARIABLE-OR-CONSTANT-NAMEP)
+(verify-termination legal-constantp)
+;;-- convert function lambda-keywordp from :program mode to :logic mode 
+(verify-termination acl2::lambda-keywordp)
+(verify-guards  acl2::lambda-keywordp)
+(verify-guards legal-constantp)
+
+
+
+;;--check arity of macro optional arguments 
+(defun optional-macro-args-allow-arity (margs n)
+  (declare (xargs :guard (and (true-listp margs) (integerp n))))
+  (cond ((<= n 0)
+         t)
+        ((endp margs)
+         nil)
+        ((member-eq (car margs) '(&rest &body))
+         t)
+        ((acl2::lambda-keywordp (car margs))
+         nil)
+        (t
+         (optional-macro-args-allow-arity (cdr margs) (1- n)))))
+
+;;-- check arity of a macro 
+(defun macro-args-allow-arity (margs n)
+  (declare (xargs :guard (and (true-listp margs) (integerp n))))
+  (cond ((< n 0)
+         nil)
+        ((endp margs)
+         (= n 0))
+        ((acl2::lambda-keywordp (car margs))
+         (cond ((eq (car margs) '&whole)
+                (macro-args-allow-arity (cdr margs) (1+ n)))
+               ((eq (car margs) '&optional)
+                (optional-macro-args-allow-arity (cdr margs) n))
+               ((member-eq (car margs) '(&rest &body))
+                t)
+               ((member-eq (car margs) '(&key &allow-other-keys))
+                (= n 0))
+               (t
+                nil)))
+        (t
+         (macro-args-allow-arity (cdr margs) (1- n)))))
+
+;;-- check arity of any function or macro
+(defun allows-arity (name n world)
+  (declare (xargs :guard (and (symbolp name)
+                              (natp n)
+                              (plist-worldp world))))
+  (if (function-symbolp name world)
+    (= n (len (acl2-getprop name 'formals world)))
+    (let ((margs (acl2-getprop name 'macro-args world
+                               :default :undefined)))
+      (and (true-listp margs)
+           (macro-args-allow-arity margs n)))))
+
+;EXTREMELY SLOW CALL because of getprop
+(defun defined-fun-or-macrop (name world)
+  (declare (xargs :guard (plist-worldp world)))
+  (and (symbolp name)
+       (or (function-symbolp name world)
+           (true-listp (acl2-getprop name 'macro-args world
+                                     :default :undefined)))))
+                                
+
+(defun allow-arity-lst (name-lst n world)
+  (declare (xargs :guard (and (symbol-listp name-lst)
+                              (natp n)
+                              (plist-worldp world))))
+  (or (endp name-lst)
+      (and (allows-arity    (car name-lst) n world)
+           (allow-arity-lst (cdr name-lst) n world))))
+
+;;--check if 'name' is a predicate function
+(defun plausible-predicate-functionp (name world)
+  (declare (xargs :guard (and (symbolp name)
+                              (plist-worldp world))))
+  (allows-arity name 1 world))
+
+(defun plausible-predicate-function-listp (name-lst world)
+  (declare (xargs :guard (and (symbol-listp name-lst)
+                              (plist-worldp world))))
+  (or (endp name-lst)
+      (and (plausible-predicate-functionp      (car name-lst) world)
+           (plausible-predicate-function-listp (cdr name-lst) world))))
+
+;;--check if x if a keyword list
+(defun keyword-listp (x)
+  (if (consp x)
+    (and (keywordp (car x))
+         (keyword-listp (cdr x)))
+    (null x)))
+
+(defun possible-constant-valuep (def)
+  (declare (xargs :guard t))
+  (if (consp def)
+    ;quoted constant
+    (and (eq 'quote (car def))
+         (consp (cdr def))
+         (null (cddr def)))
+    (or (not (symbolp def));either acl2-number character string
+        (keywordp def);a keyword
+        (booleanp def);t or nil
+        (legal-constantp def))))
+
+
+
+(mutual-recursion
+(defun constant-value-expressionp-lst (expr-lst wrld)
+  (declare (xargs :guard (plist-worldp wrld)))
+  (if (atom expr-lst)
+    t
+    (and (constant-value-expressionp (car expr-lst) wrld)
+         (constant-value-expressionp-lst (cdr expr-lst) wrld))))
+
+;very slow
+(defun constant-value-expressionp (expr wrld)
+   (declare (xargs :guard (plist-worldp wrld)))
+  (cond ((null expr) t)
+        ((possible-constant-valuep expr) t)
+        ((atom expr) (possible-constant-valuep expr))
+        ((not (defined-fun-or-macrop (car expr) wrld)) nil)
+        (t (constant-value-expressionp-lst (cdr expr) wrld)))
+    )
+)
+
+
+(mutual-recursion
+(defun possible-constant-value-expressionp-lst (expr-lst)
+  (if (atom expr-lst)
+    t
+    (and (possible-constant-value-expressionp (car expr-lst))
+         (possible-constant-value-expressionp-lst (cdr expr-lst)))))
+
+(defun possible-constant-value-expressionp (expr)
+   (cond ((null expr) t);if nil
+         ((possible-constant-valuep expr) t); if a constant
+         ((atom expr) (possible-constant-valuep expr));if an atom, it has to go through this
+         ((not (symbolp (car expr))) nil)
+         (t (possible-constant-value-expressionp-lst (cdr expr))))
+   )
+)
+
+; begin some auxilliary stuff for defdata
+
+;get the predicate function symbol for a type-name if it exists
+(defun er-get-predicate (type-name ctx wrld state)
+  (declare (xargs :mode :program
+                  :stobjs (state)
+            :guard (and (symbolp type-name)
+                              (symbolp ctx)
+                              (plist-worldp wrld))))
+  (let ((psym (get-predicate-symbol type-name)))
+    (if (plausible-predicate-functionp psym wrld)
+      (value psym)
+      (er soft ctx
+          "Predicate ~x0 for type ~x1 is not defined."
+          psym type-name))))
+
+;get the constant value associated with constant expression 'def'
+(defun er-get-constant-value (def ctx wrld state)
+  (declare (xargs :mode :program
+                  :stobjs (state)
+                  :guard (plist-worldp wrld)))
+  (cond ((and (consp def)
+             (eq 'quote (car def))
+             (consp (cdr def))
+             (null (cddr def)))
+         (value (cadr def)))
+        ((and (atom def)
+              (or (not (symbolp def))
+                  (keywordp def)
+                  (booleanp def)))
+         (value def))
+        (t 
+         (let ((p (acl2-getprop def 'const wrld)))
+                               
+           (if (and (symbolp def)
+                    (quotep p))
+               (value (cadr p))
+             (er soft ctx "Illegal/undefined constant value: ~x0" def))))))
+
+;;-- evaluates expr and returns its value if expr does not return a multi-value answer
+(defun trans-eval-single-value (expr ctx state)
+  (declare (xargs :mode :program
+                  :stobjs (state)))
+  (acl2::state-global-let*
+   ((acl2::guard-checking-on :none))
+   (er-let* ((ans (trans-eval expr ctx state t)));for now aok is t
+     (if (equal (car ans) '(nil))
+       (value (cdr ans))
+       (er soft ctx "Expected a single return value in evaluation of ~x0."
+           expr)))))
+
+(local (defthm union-true-lists
+         
+         (implies (and (true-listp l1)
+                       (true-listp l2))
+                  (true-listp (union-equal l1 l2)))))
+
+(defun union-lsts (lsts)
+  (declare (xargs :mode :logic
+                  :guard (true-list-listp lsts)))
+  (if (endp lsts)
+    nil
+    (union-equal (car lsts)
+                 (union-lsts (cdr lsts)))))
+ 
+(defun assoc-lst (keys alist)
+  (declare (xargs :guard (and (true-listp keys)
+                              (alistp alist))))
+  (if (endp keys)
+    nil
+    (cons (assoc-equal (car keys) alist)
+          (assoc-lst (cdr keys) alist))))
+
+(defun flatten (b lst&)
+  (declare (xargs :guard (true-listp lst&)))
+  (if (atom b)
+    (cons b lst&)
+    (flatten (car b) (flatten (cdr b) lst&))))
+
+(defun mem1 (atm lst)
+  (declare (xargs :guard (true-listp lst)))
+  (if (endp lst)
+    nil
+    (if (equal atm (car lst))
+      t
+      (mem1 atm (cdr lst)))))
+
+(defun mem-eq (v lst)
+  (declare (xargs :guard (or (and (symbolp v)
+                                  (true-listp lst))
+                             (symbol-listp lst))))
+  (if (endp lst)
+    nil
+    (if (eq v (car lst))
+      t
+      (mem-eq v (cdr lst)))))
+
+(mutual-recursion
+ (defun defbodyp (x)
+   (or (symbolp x)
+       (possible-constant-valuep x)
+       (defbody-listp (cdr x))))
+ (defun defbody-listp (xs)
+   (if (atom xs)
+     (equal xs nil)
+     (and (defbodyp (car xs))
+          (defbody-listp (cdr xs))))))
+
+(include-book "misc/total-order" :dir :system)
+
+(defun order-two-terms (t1 t2)
+  (declare (xargs :guard t))
+  (if (acl2::<< t1 t2);total order
+      (mv t1 t2)
+      (mv t2 t1)))
+
+(defthm flatten-is-true-list 
+  (implies (true-listp lst)
+           (true-listp (flatten b lst)))
+  :rule-classes :type-prescription)
+(in-theory (disable flatten)) 
+
+(defun true-list-alistp (x)
+  (declare (xargs :guard t))
+  (cond ((atom x) (eq x nil))
+        (t (and (alistp (car x))
+                (true-list-listp (cdr x))))))
+
+(defun true-list-symbol-alistp (x)
+  (declare (xargs :guard t))
+  (cond ((atom x) (eq x nil))
+        (t (and (symbol-alistp (car x))
+                (true-list-symbol-alistp (cdr x))))))
+
+         
+;;self-explanatory
+(defun symbol-doublet-list-listp (xs)
+  (declare (xargs :guard t))
+  (if (null xs)
+    t
+    (if (atom xs)
+      nil
+      (and (acl2::symbol-doublet-listp (car xs))
+           (symbol-doublet-list-listp (cdr xs))))))
+
+(defun symbol-alist-listp (x)
+  (declare (xargs :guard T))
+  (if (atom x)
+    (null x)
+    (and (symbol-alistp (car x))
+         (symbol-alist-listp (cdr x)))))
+
+
+
+(verify-termination ACL2::>=-LEN)
+(verify-termination ACL2::ALL->=-LEN)
+(verify-termination ACL2::>=-LEN ACL2::ALL->=-LEN)
+(defun strip-cadrs (x)
+  (declare (xargs :guard (acl2::all->=-len x 2)))
+  (cond ((atom x) nil)
+        (t (cons (cadar x)
+                 (strip-cadrs (cdr x))))))
+
+
+
+
+
+;utility funs
+;boolean-or: Expr * Expr * ... -> Bool
+(defun boolean-or-macro (lst)
+  (if (consp lst)
+    (list 'if
+          (car lst)
+          't
+          (boolean-or-macro (cdr lst)))
+    'nil))
+;boolean-or: Expr * Expr * ... -> Bool
+(defmacro boolean-or (&rest args)
+  (boolean-or-macro args))
+
+
+;; (defun is-simple-type-hyp (term wrld)
+;; ;is a simple type hypothesis, and if true returns
+;; ; the type-name (not the predicate itself)
+;;   (declare (xargs :verify-guards nil))
+;;   (and (consp term)
+;;        (eql (len term) 2)
+;;        (atom (cadr term))
+;;        (is-a-variablep (cadr term)) ;check wether its arg is sa variable 
+;;        (plausible-predicate-functionp (car term) wrld)
+;;        (is-type-predicate (car term) wrld))) ;check if its a type predicate
+
+
+;NEEDED BY EVERYONE:
+  
+; 12/4/2012, Matt K.: Omitting the definitions of nat-listp and
+; acl2-number-listp, which are being built into ACL2.
+
+(defun naturals-listp (x)
+   (declare (xargs :guard t))
+  (if (atom x)
+    (null x)
+    (and (natp (car x))
+         (naturals-listp (cdr x)))))
+
+; already in program mode:
+(DEFUN POS-LISTP (acl2::L)
+   (declare (xargs :guard t))
+  (COND ((ATOM acl2::L) (EQ acl2::L NIL))
+        (T (AND (POSP (CAR acl2::L))
+                (POS-LISTP (CDR acl2::L))))))
+
+;; del: All tlp -> tlp
+;; signature: (a X)
+;; removes the first occurrence of a from X
+(defun del (a X)
+  (declare (xargs :guard (true-listp X)))
+  (cond ((endp X) nil)
+        ((equal a (car X)) (cdr X))
+        (t (cons (car X) (del a (cdr X))))))
+
+(defun rev-acc (X acc)
+  (declare (xargs :guard (true-listp X)))
+  (if (endp X)
+    acc
+    (rev-acc (cdr X) (cons (car X) acc))))
+
+(defun rev (X)
+  (declare (xargs :guard (true-listp X)))
+  (rev-acc X nil))
+
+;is x permutation of y 
+(defun permutation (xs ys)
+  (declare (xargs :verify-guards nil))
+  (cond ((atom xs) (atom ys)) 
+        (t (and (mem1 (car xs) ys) (permutation (cdr xs) (del (car xs) ys)))))) 
+
+(defun get-value-from-keyword-value-list (key kv-lst)
+  (declare (xargs :guard (keyword-value-listp kv-lst)))
+  (second (assoc-keyword key kv-lst)))
+
+
+
+;Sig: Any -> Bool
+;check wether arg is a variable 
+(defun is-a-variablep (x)
+  (declare (xargs :guard t))
+  (and (symbolp x)
+       (not (or (keywordp x);a keyword
+                (booleanp x);t or nil
+                (legal-constantp x)))));ACL2::CONSTANT
+
+
+;NOTE PACKAGES are very IMP while assuming that symbols are all ACL2. Like
+;I just fixed a bug, where 'CONSTANT was assumed in ACL2 package, but due to
+;this book being in DEFDATA PACKAGE, the equality check is against the symbol
+;DEFDATA::CONSTANT which not same as ACL2::CONSTANT resulting in treating
+;t and nil as variables.
+
+;;list the free variables in a term
+(mutual-recursion
+;; code taken from structures.lisp in data-structures book.
+ (defun get-free-vars1 (term ans)
+    (declare (xargs :verify-guards nil
+                    :guard (and (or (atom term)
+                                    (true-listp term))
+                                (true-listp ans)
+                                )))
+   "A free variable is a symbol that is not a constant, i.e., it excludes T,
+    NIL, and *CONST*, and keywords"
+   (cond
+    ((atom term) (if (is-a-variablep term)
+                   (add-to-set-eq term ans)
+                   ans))
+    ((eq (car term) 'QUOTE) ans)
+    (t (get-free-vars1-lst (cdr term) ans))))
+ 
+ (defun get-free-vars1-lst (terms ans)
+    (declare (xargs :guard (and (true-listp terms)
+                                (or (atom (car terms))
+                                    (true-listp (car terms)))
+                                (true-listp ans)
+                                )))
+   (cond
+    ((endp terms) ans)
+    (t (get-free-vars1-lst (cdr terms) 
+                           (get-free-vars1 (car terms) ans))))))
+
+;auxiliary function for get-free-vars
+(defun get-free-vars0 (form state)
+  (declare (xargs :mode :program 
+                  :stobjs (state)))
+  (if (acl2::termp form (w state))
+; had a bug due to namespace change
+     (value (get-free-vars1 form '())) 
+; translate the form into a term
+     (er-let* ((term (acl2::translate form t nil t 
+                                'get-free-vars (w state) state))) 
+       (value (get-free-vars1 term '())))))
+    
+;get list of free variables in acl2 expression 'form'
+(defmacro get-free-vars (form)
+  `(get-free-vars0 ,form state)) 
+
+
+
+;filter typ-exps which are typenames
+(defun filter-alist-keys (alst wanted-keys)
+  (declare (xargs :guard (and (alistp alst)
+                              (true-listp wanted-keys))))
+  (if (endp alst)
+    nil
+    (let* ((key (caar alst))
+           (we-want-to-add  (mem1 key wanted-keys)))
+      (if we-want-to-add 
+        (cons (car alst);cons the wanted entry
+              (filter-alist-keys (cdr alst) wanted-keys))
+        (filter-alist-keys (cdr alst) wanted-keys)))))
+
+
+(defun remove-entry (key alist)
+  (declare (xargs  :guard (and (alistp alist))))
+  (if (endp alist)
+    nil
+    (if (equal key (caar alist))
+      (cdr alist)
+      (cons (car alist)
+            (remove-entry key (cdr alist))))))
+
+(defun remove-entry-lst (keys alist)
+  (declare (xargs  :guard (and (true-listp keys)
+                               (alistp alist))))
+  (if (endp keys)
+    alist
+    (remove-entry-lst (cdr keys) 
+                      (remove-entry (car keys) alist))))
+
+;get value of key in alist
+(defun get-val (key alist)
+  (declare (xargs  :guard (and (alistp alist))))
+  (if (endp alist)
+    nil
+    (if (equal key (caar alist))
+      (cdar alist)
+      (get-val key (cdr alist)))))
+
+;recurse on above
+(defun get-val-lst (keys alist)
+  (declare (xargs  :guard (and (true-listp keys)
+                               (alistp alist))))
+  (if (endp keys)
+      nil
+    (let ((found-val (get-val (car keys) alist)))
+      (if found-val
+        (cons found-val
+              (get-val-lst (cdr keys) alist))
+        (get-val-lst (cdr keys) alist)))))
+
+;if val is different, then add it at the very end,
+;do not update in place. Assumes unique entries
+(defun remove-and-add-at-end-entry (key val alist)
+  (declare (xargs  :guard (alistp alist)))
+  (if (endp alist)
+    (list (cons key val))
+    (let* ((curr-entry (car alist))
+           (curr-key (car curr-entry))
+           (curr-val (cdr curr-entry)))
+      (if (not (equal key curr-key))
+        (cons curr-entry
+              (remove-and-add-at-end-entry key val (cdr alist)))
+        (if (equal val curr-val)
+          alist;return unchanged
+          (remove-and-add-at-end-entry key val (cdr alist)))))))
+
+(defun remove-and-add-at-front-entry (key val alist)
+  (declare (xargs  :guard (alistp alist)))
+  (cons (cons key val)
+        (remove-entry key alist)))
+  
+;put the key val entry in alist(overwrite)
+;assumes unique entries
+(defun put-entry (key val alist)
+  (declare (xargs  :guard (alistp alist)))
+  (if (endp alist)
+    (list (cons key val))
+    (if (equal key (caar alist))
+      (cons (cons key val)
+            (cdr alist))
+      (cons (car alist)
+            (put-entry key val (cdr alist))))))
+
+
+  
+;get key having value val in alist
+(defun get-key (val alist)
+  (declare (xargs  :guard (alistp alist)))
+  (if (endp alist)
+      nil
+    (if (equal val (cdar alist))
+      (caar alist)
+      (get-key val (cdr alist)))))
+
+;recurse on above, in order of vals.
+(defun get-key-lst (vals alist)
+  (declare (xargs  :guard (and (true-listp vals)
+                               (alistp alist))))
+  (if (endp vals)
+    nil
+    (let ((found-key (get-key (car vals) alist)))
+      (if found-key
+        (cons found-key
+              (get-key-lst (cdr vals) alist))
+        (get-key-lst (cdr vals) alist)))))
+
+(defun get-var-from-i-or-is-lst (is var-i-alst)
+  (declare (xargs  :verify-guards nil))
+  (if (endp is)
+    nil
+    (let ((i (car is)))
+      (if (atom i)
+        (let ((found-key (get-key i var-i-alst)))
+          (if found-key
+            (cons found-key (get-var-from-i-or-is-lst (cdr is) var-i-alst))
+            (get-var-from-i-or-is-lst (cdr is) var-i-alst)))
+        ;else its a nat-listp
+        (let ((found-keys (get-key-lst i var-i-alst)))
+          (if found-keys
+            (cons found-keys (get-var-from-i-or-is-lst (cdr is) var-i-alst))
+            (get-var-from-i-or-is-lst (cdr is) var-i-alst)))))))
+              
+
+;returns list of all keys matching val
+(defun get-all-keys1 (val alist ans)
+  (declare (xargs  :guard (alistp alist)))
+  (if (endp alist)
+      ans;return answer
+    (let* ((entry (car alist))
+           (key (car entry))
+           (value (cdr entry)))
+      (if (equal val value)
+        (get-all-keys1 val (cdr alist) (cons key ans));accumulate keys and recurse
+      (get-all-keys1 val (cdr alist) ans)))));recurse
+
+(defun get-all-keys (val alist)
+  (declare (xargs  :guard (alistp alist)))
+  (get-all-keys1 val alist nil))
+
+;recurse on above, in order of vals.
+(defun get-all-keys-lst (vals alist)
+  (declare (xargs  :guard (and (true-listp vals)
+                               (alistp alist))))
+  (if (endp vals)
+    nil
+    (let ((found-keys (get-all-keys (car vals) alist)))
+      (if found-keys
+        (cons found-keys
+              (get-all-keys-lst (cdr vals) alist))
+        (get-all-keys-lst (cdr vals) alist)))))
+
+
+;from Matt ;TODO get rid of this
+(defun trans-eval2 (form ctx state)
+  (declare (xargs :mode :program :stobjs state))
+  (acl2::state-global-let*
+   ((acl2::guard-checking-on :none))
+   (mv-let
+    (erp trans bindings state)
+    (acl2::translate1 form
+                      t nil
+                      t
+                      'top-level (w state) state)
+    (declare (ignore bindings))
+    (cond
+     (erp (mv t nil state))
+     (t
+      (let ((vars (all-vars trans)))
+        (cond
+         ((acl2::non-stobjps vars t (w state)) ;;; known-stobjs = t
+          (er soft 'top-level
+              "Global variables, such as ~&0, are not allowed. See ~
+               :DOC ASSIGN and :DOC @."
+              (acl2::non-stobjps vars t (w state)))) ;;; known-stobjs = t
+         (t (acl2::ev-for-trans-eval trans vars nil ctx state t))))))))) 
+
+;returns (cdr (cons translated-term value)) == value of term under bindings
+(defun trans-eval-single-value-with-bindings (term bindings ctx state)
+  (declare (xargs :mode :program :stobjs state))
+  (acl2::state-global-let*
+   ((acl2::guard-checking-on :none))
+   (er-let* ((term-val (acl2::simple-translate-and-eval term bindings nil
+                                                        "" ctx (w state) state t)))
+     (value (cdr term-val)))))
+
+; this function basically creates in one go cons bindings 
+; for a list of variable names
+(defun make-var-value-cons-bindings (var-lst ans)
+  (declare (xargs :guard (and (symbol-listp var-lst)
+                              (true-listp ans))))
+  (if (endp var-lst)
+    (cons 'list ans)
+    (let ((var (car var-lst)))
+      (make-var-value-cons-bindings (cdr var-lst)
+                                    (append ans (list `(cons ',var ,var)))))))
+
+; this function basically creates in one go list bindings for 
+; a list of variable names
+(defun make-var-value-list-bindings (var-lst ans)
+  (declare (xargs :guard (and (symbol-listp var-lst)
+                              (true-listp ans))))
+  (if (endp var-lst)
+    (cons 'list ans)
+    (let ((var (car var-lst)))
+      (make-var-value-list-bindings 
+       (cdr var-lst)
+       (append ans (list `(list ',var ,var)))))));changed to mimic let binding
+
+; needed for simple-translate-and-eval only.
+; Not needed now!!
+(defun make-constant-value-cons-bindings (var-lst constant-val ans)
+  (declare (xargs :guard (and (symbol-listp var-lst)
+                              (true-listp ans))))
+  (if (endp var-lst)
+    (cons 'list ans)
+    (let ((var (car var-lst)))
+      (make-constant-value-cons-bindings 
+       (cdr var-lst)
+       constant-val
+       (append ans (list (cons var constant-val)))))))
+
+;needed for trans-eval
+(defun make-constant-value-let-bindings (var-lst constant-val ans)
+  (declare (xargs :guard (and (symbol-listp var-lst)
+                              (true-listp ans))))
+  (if (endp var-lst)
+    ans
+    (let ((var (car var-lst)))
+      (make-constant-value-let-bindings 
+       (cdr var-lst)
+       constant-val
+       (append ans (list (list var constant-val)))))))
+
+
+
+;;self-explanatory
+(defun convert-listpair-to-conspair-lst (listpairs)
+  (declare (xargs :guard (acl2::symbol-doublet-listp listpairs)))
+  (if (endp listpairs)
+    nil
+    (cons (let* ((lstpair (car listpairs))
+                 (fst (car lstpair))
+                 (snd (cadr lstpair)))
+            (cons fst snd))
+          (convert-listpair-to-conspair-lst (cdr listpairs)))))
+
+
+; self-explanatory
+; convert ((a . b) ...) to ((a b) ...)
+(defun convert-conspairs-to-listpairs (conspairs)
+  (declare (xargs :guard (symbol-alistp conspairs)))
+  (if (endp conspairs)
+    nil
+    (cons (let* ((conspair (car conspairs))
+                 (fst (car conspair))
+                 (snd (cdr conspair)))
+            (list fst snd))
+          (convert-conspairs-to-listpairs (cdr conspairs)))))
+
+(defthm convert-conspairs-to-listpairs-sig1
+  (implies (symbol-alistp P)
+           (symbol-doublet-listp (convert-conspairs-to-listpairs P)))
+  :rule-classes (:rewrite :type-prescription :forward-chaining))
+
+(defthm symbol-doublet-listp-implication1
+  (implies (and (symbol-doublet-listp A)
+                (consp A))
+           (and (consp (car A))
+                (symbolp (caar A))
+                (consp (cdr (car A)))
+                (null (cddr (car A)))))
+  :rule-classes (:forward-chaining :type-prescription))
+
+(defun count-occurrences (v lst)
+  (declare (xargs :guard (true-listp lst)))
+  (if (endp lst)
+    0
+    (if (equal v (car lst))
+      (1+ (count-occurrences v (cdr lst)))
+      (count-occurrences v (cdr lst)))))
+
+(defun sym-eq-lst (syms1 syms2)
+  (declare (xargs :guard (and (symbol-listp syms1)
+                              (symbol-listp syms2))))
+  "returns first symbol in syms2 which is in syms1 o.w nil"
+  (if (endp syms2)
+    nil
+    (if (mem1 (car syms2) syms1)
+      (car syms2)
+      (sym-eq-lst syms1 (cdr syms2)))))
+
+(defun insert-entry-after-key (entry k alst)
+  (declare (xargs :guard (and (symbolp k)
+                              (symbol-alistp alst))))
+  "insert entry immediately after the pair in alst having key k"
+  (if (endp alst)
+   (list entry)
+    (if (eq k (caar alst))
+      (cons (car alst)
+            (cons entry (cdr alst)))
+      (cons (car alst)
+           (insert-entry-after-key entry k (cdr alst)))))) 
+
+(defun get-ordered-alst (keys alst ans)
+  (declare (xargs :guard (and (true-listp keys) (alistp ans) (alistp alst))))
+  "accumulate entries of alist in ans in the order of keys"
+  (if (endp keys)
+    ans
+    (let ((at (assoc-equal (car keys) alst)))
+      (if at
+        (get-ordered-alst (cdr keys) alst (append ans (list at)))
+        (get-ordered-alst (cdr keys) alst ans)))))
+
+
+;filter all elements in lst that are IN in-lst
+(defun filter-in (lst in-lst)
+  (declare (xargs :guard (and (true-listp lst)
+                              (true-listp in-lst))))
+  (if (endp lst)
+      nil
+    (if (defdata::mem1 (car lst) in-lst)
+        (cons (car lst) (filter-in (cdr lst) in-lst))
+      (filter-in (cdr lst) in-lst))))
+;filter all elements in lst that are NOT IN in-lst 
+(defun filter-not-in (lst in-lst)
+  (declare (xargs :guard (and (true-listp lst)
+                              (true-listp in-lst))))
+  (if (endp lst)
+      nil
+    (if (not (defdata::mem1 (car lst) in-lst))
+        (cons (car lst) (filter-in (cdr lst) in-lst))
+      (filter-in (cdr lst) in-lst))))
+
+;self-explanatory code.
+;compose 2 finite functions basically
+(defun compose-two-alists (a-b-alst b-c-alst)
+  (declare (xargs :guard (and (alistp a-b-alst)
+                              (alistp b-c-alst))))
+   (if (endp a-b-alst)
+    nil
+    (let* ((a-b (car a-b-alst))
+           (a (car a-b))
+           (b (cdr a-b))
+           (c (defdata::get-val b b-c-alst))
+           (a-c (cons a c)))
+      (cons a-c
+            (compose-two-alists (cdr a-b-alst) b-c-alst)))))
+
+;just like subst, but uses equal for comparision.
+(defun subst-equal (new old tree)
+  (cond ((equal tree old) new)
+        ((atom tree) tree)
+        (t (cons (subst-equal new old (car tree))
+                 (subst-equal new old (cdr tree))))))
+
+
+(mutual-recursion
+;(ev-fncall-w FN ARGS W SAFE-MODE GC-OFF HARD-ERROR-RETURNS-NILP AOK)
+;I use sumners default values for
+;               nil    ; safe-mode
+;               t      ; gc-off
+;               nil    ; hard-error-returns-nilp
+;               nil    ; aok
+
+
+(defun my-ev-w (term alist ctx w hard-error-returns-nilp)
+"special eval function that does not need state and 
+cannot handle if, return-last,mv-list, stobjs, wormhole etc
+very restrictive
+Mainly to be used for evaluating enum lists "
+;Close to ev-rec in translate.lisp
+(declare (xargs :mode :program
+                :guard (and (acl2::termp term w)
+                            (plist-worldp w)
+                            (symbol-alistp alist)
+                            (booleanp hard-error-returns-nilp))))
+ 
+(b* (((when (acl2::variablep term))
+;variable expression
+      (let ((v (assoc-eq term alist))) ;bugfix (removed cdr).
+;(earlier, if term had a value NIL, we were errorneusly
+;crashing!!!
+        (if v ;not null 
+          (mv nil (cdr v))
+          (prog2$
+           (er hard ctx "Unbound variable ~x0.~%" term)
+           (mv t term)))))
+;quoted expression
+     ((when (acl2::fquotep term))
+      (mv nil (cadr term)))
+;if expression
+     ((when (eq (car term) 'if))
+      (prog2$ 
+       (er hard ctx "IF expressions not supported at the moment.~%")
+       (mv t term)))
+;function expression
+     ((mv args-er args)
+      (my-ev-w-lst (cdr term) alist ctx
+                   w hard-error-returns-nilp))
+     ((when args-er)
+      (prog2$ 
+       (er hard ctx "Eval args failed~%")
+       (mv t term)))
+     ((when (acl2::flambda-applicationp term))
+      (my-ev-w (acl2::lambda-body (car term))
+               (acl2::pairlis$ (acl2::lambda-formals (car term)) args)
+               ctx w hard-error-returns-nilp)))
+    (acl2::ev-fncall-w (car term) args w
+                       nil nil t hard-error-returns-nilp nil)))
+
+(defun my-ev-w-lst (term-lst alist 
+                             ctx w hard-error-returns-nilp)
+"special eval function that does not need state and 
+cannot handle return-last,mv-list, stobjs, wormhole etc
+very restrictive
+Mainly to be used for evaluating enum lists "
+;Close to ev-rec-lst in translate.lisp
+(declare (xargs :mode :program
+                :guard (and (acl2::term-listp term-lst w)
+                            (plist-worldp w)
+                            (symbol-alistp alist)
+                            (booleanp hard-error-returns-nilp))))
+(if (endp term-lst)
+    (mv nil nil)
+  (b* (((mv erp1 car-ans) 
+        (my-ev-w (car term-lst) alist 
+                 ctx w hard-error-returns-nilp))
+       ((when erp1) 
+        (prog2$ 
+         (er hard ctx "eval ~x0 failed~%" (car term-lst))
+         (mv t term-lst)))
+       ((mv erp2 cdr-ans) 
+        (my-ev-w-lst (cdr term-lst) alist 
+                     ctx w hard-error-returns-nilp))
+       ((when erp2) 
+        (prog2$ 
+         (er hard ctx "eval failed~%")
+         (mv t term-lst))))
+    (mv nil (cons car-ans cdr-ans)))))
+)
+  
+
+(defun trans-my-ev-w (form ctx w hard-error-returns-nilp)
+(declare (xargs :mode :program
+                :guard (and (plist-worldp w)
+                            (booleanp hard-error-returns-nilp))))
+
+  (mv-let 
+   (erp term x) 
+   (acl2::translate11 form nil nil nil nil nil
+                ctx w (acl2::default-state-vars nil))
+   (declare (ignore x))
+   (if erp
+       (if hard-error-returns-nilp
+           (mv erp form)
+         (prog2$ 
+          (er hard ctx "~x0 could not be translated.~%" form)
+          (mv erp form)))
+     (my-ev-w term nil ctx w hard-error-returns-nilp))))
+
+(defun all-vars-in-var-term-alst (alst)
+  (declare (xargs :guard (alistp alst)
+                  :verify-guards nil
+                              ))
+  ;key might be a term in case of generalization TODO.CHECK
+;value is always a term, so we gets free-vars from them 
+  (union-eq (get-free-vars1-lst (strip-cars alst) nil)
+            (get-free-vars1-lst (strip-cdrs alst) nil)))
+
+;collect matching key-value pairs in an alist
+;if var in 'vars' has a value in 'bindings', then collect it
+(defun occurring-var-bindings (bindings vars)
+  (declare (xargs :guard (and (true-listp vars)
+                              (symbol-alistp bindings))))
+  (if (endp vars)
+    nil
+    (let ((b (assoc-eq (car vars) bindings)))
+      (if b
+        (cons b (occurring-var-bindings bindings (cdr vars)))
+        (occurring-var-bindings bindings (cdr vars))))))
+
+
+; every cons(that is not quoted) and list in the value list 
+; bindings is quoted to avoid errors in evaluation
+(defun quote-conses-and-symbols-in-bindings (val-bs)
+;val-bs is kind of let binding
+  (declare (xargs :guard (symbol-doublet-listp val-bs)))
+  (if (endp val-bs)
+    nil
+    (b* (((list var val) (car val-bs)))
+      (if (or (symbolp val)
+              (and (consp val) (not (equal (car val) 'quote))))
+        (cons (list var (list 'quote val))
+              (quote-conses-and-symbols-in-bindings (cdr val-bs)))
+        (cons (list var val) 
+              (quote-conses-and-symbols-in-bindings (cdr val-bs)))))))
+
+(defun filter-symbol-keys-in-alist (alst)
+  "Given an alist, it filters the entries that have
+   symbols as the keys(first elem of cons)"
+  (declare (xargs :guard (alistp alst)))
+  (if (endp alst)
+    nil
+    (if (symbolp (caar alst))
+      (cons (car alst) (filter-symbol-keys-in-alist (cdr alst)))
+      (filter-symbol-keys-in-alist (cdr alst)))))#|ACL2s-ToDo-Line|#
+
+(defun symbol-list-listp (v)
+  (declare (xargs :guard T))
+  (if (atom v)
+      (null v)
+    (and (symbol-listp (car v))
+         (symbol-list-listp (cdr v)))))
+
+(defun order-var-te-alist. (A connected-vs-lst ans.)
+  "helper to order-var-te-alist"
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbol-alistp A)
+                              (symbol-list-listp connected-vs-lst)
+                              (symbol-alistp ans.))))
+  (if (endp connected-vs-lst)
+      ans.
+    (b* ((vs        (car connected-vs-lst))
+         (tes       (get-val-lst vs A))
+         (A-partial (cons-up-lists vs tes)))
+     (order-var-te-alist.  A (cdr connected-vs-lst)
+                            (append ans. A-partial)))))
+
+(defun order-var-te-alist (A connected-vs-lst)
+  "order var-type-expression-dlist using connected-vertices information"
+  (declare (xargs :verify-guards nil
+                  :guard (and (symbol-alistp A)
+                              (symbol-list-listp connected-vs-lst))))
+                            
+  (if (null connected-vs-lst)
+      A
+    (order-var-te-alist. A connected-vs-lst '() )))
+
+(defun to-string (x)
+  (declare (xargs :mode :program))
+  (coerce (cdr (coerce (fms-to-string "~x0" (list (cons #\0 x))) 'list)) 'string))
+
+;check this TODO
+(defun is-singleton-type-p (obj)
+  (possible-constant-valuep obj))
+
+(defun is-singleton-type-lst-p (obj-lst)
+  (declare (xargs :guard (true-listp obj-lst)))
+  (if (endp obj-lst)
+    t
+  (and (possible-constant-valuep (car obj-lst))
+       (is-singleton-type-lst-p (cdr obj-lst)))))
+
+
+
+;; (defstub is-disjoint (* * *) => *)
+;; (defstub is-subtype (* * *) => *)
+;; (defstub is-alias (* * *) => *)
+
+(defstub is-type-predicate (* *) => *)
+(defstub is-a-typeName (* *) => *)
+(defstub is-a-custom-type (* *) => *)
\ No newline at end of file
diff -Nru acl2-6.2/books/cgen/with-timeout-raw.lsp acl2-6.3/books/cgen/with-timeout-raw.lsp
--- acl2-6.2/books/cgen/with-timeout-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/with-timeout-raw.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,116 @@
+;Author: Harsh Raju Chamarthi, Matt Kaufmann
+;Acknowledgements: Thanks to Gary Byers, Gary Warren King, Bob Boyer,
+;David Rager
+;
+
+(in-package "ACL2")
+
+
+;; ;Taken from memoize-raw.lisp 
+;; #+Clozure
+;; (defun make-watchdog (duration)
+;; ;   Thanks to Gary Byers for this!
+
+;;    (let* ((done (ccl:make-semaphore))
+;;           (current ccl:*current-process*))
+;;       (ccl::process-run-function "watchdog"
+;;         (lambda ()
+;;           (or (ccl:timed-wait-on-semaphore done duration)
+;;               (ccl:process-interrupt
+;;                current #'timeout-hard-error 'with-timeout
+;;                                  '"Time exceeded"
+;;                                  'nil *the-live-state*))))
+;;       done)) 
+
+;; (defmacro with-timeout-raw (duration body) ;duration in seconds
+;; #+Clozure
+;; `(let* ((semaphore (make-watchdog ,duration)))
+;;    (unwind-protect
+;;        ,body
+;;      (ccl:signal-semaphore semaphore)))
+
+;; #+sb-thread ;Thanks to Gary Warren King for this!
+;;   `(handler-case 
+;;     (sb-ext:with-timeout ,duration ,body)
+;;     (sb-ext::timeout (c)
+;;                      (declare (ignore c))
+;;                      (timeout-hard-error 'with-timeout
+;;                              '"Time exceeded"
+;;                              'nil *the-live-state*)))
+
+;;)
+
+;harshrc: Thanks to Matt for the following email snippet whose ideas
+;I used to implement nested timeouts.
+
+;; I think you know how to write a function (timer n) that causes an
+;; error after n seconds.  Presumably you could write it so that instead
+;; of (er hard ...), it does (throw 'timeout-tag *timeout-val*).
+
+;i need `throw' to be be a function to be used in process-interrupt,
+;so had to define the following. Does that screw the semantics of
+;usage of macro throw?
+(defun throw1 (tag form)
+  (throw tag form))
+
+#+Clozure
+(defun make-watchdog (duration id)
+;   Thanks to Gary Byers for this! --adapted from memoize-raw.lisp
+
+   (let* ((done (ccl:make-semaphore))
+          (current ccl:*current-process*))
+      (ccl::process-run-function "watchdog"
+        (lambda ()
+          (or (ccl:timed-wait-on-semaphore done duration)
+              (ccl:process-interrupt
+               current #'throw1 id id))))
+      done))
+
+(defmacro with-timeout-raw (duration id body) ;duration
+
+; Note: all args are expressions that are expected to be evaluated.
+
+  ;; duration in seconds with
+  ;; id which is a unique timeout identifier
+  #+Clozure
+  `(let ((semaphore (make-watchdog ,duration ',id))
+;close the environment
+         ;(closure #'(lambda () ,body))
+         )
+     (unwind-protect
+         ;(funcall closure)
+         ,body
+       (ccl:signal-semaphore semaphore)))
+
+  #+sb-thread ;Thanks to Gary Warren King for this!
+  `(handler-case 
+    (sb-ext:with-timeout ,duration ,body)
+    (sb-ext::timeout (c)
+                     (declare (ignore c))
+                     (throw1 ',id ',id))))
+
+
+; For debugging
+#||
+(defmacro catch1 (tag arg)
+  `(progn (format t "Set up catcher: ~s~%" '(,tag ,arg))
+          (let ((vals (catch ,tag (multiple-value-list ,arg))))
+            (format t "Catcher worked:~%~s~%" vals)
+            vals)))
+||#
+
+(defmacro catch1 (tag arg)
+  `(catch ,tag (multiple-value-list ,arg)))
+
+(defmacro with-timeout-aux-raw (&whole whole duration/timeout-form body)
+  (case-match duration/timeout-form
+    (('quote (duration timeout-form))
+     (let ((timeout-id (acl2-gentemp "WITH-TIMEOUT$")))
+       `(let ((vals (catch1 ',timeout-id
+                            (with-timeout-raw ,duration
+                                              ,timeout-id
+                                              ,body))))
+          (cond ((eq vals ',timeout-id)
+                 ,timeout-form)
+                (t (values-list vals))))))
+    (& (error "Illegal call in with-timeout-aux-raw:~%~s~%" whole))))
diff -Nru acl2-6.2/books/cgen/with-timeout.lisp acl2-6.3/books/cgen/with-timeout.lisp
--- acl2-6.2/books/cgen/with-timeout.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cgen/with-timeout.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,147 @@
+#|$ACL2s-Preamble$;
+(begin-book t :ttags ((:acl2s-timeout)))
+;$ACL2s-Preamble$|#
+
+;Author: Harsh Raju Chamarthi
+;Acknowledgements: Many thanks to Matt Kaufmann.
+
+(in-package "ACL2")
+(include-book "xdoc/top" :dir :system)
+
+(defxdoc with-timeout
+  :parents (testing)
+  :short "Evaluate form with a timeout (in seconds)"
+  :long "Evaluate form with a timeout in seconds. The syntax of
+  this macro is (with-timeout <i>duration</i> <i>body</i>
+  <i>timeout-form</i>). 
+  A duration of 0 seconds disables the timeout mechanism, 
+  i.e its a no-op. Otherwise, if <i>duration</i> seconds elapse
+  during evaluation of <i>body</i> then the evaluation is
+  aborted and the value of <tt>timeout-form</tt> is returned,
+  otherwise returns the value of <tt>body</tt>. The signature of 
+  <tt>body</tt> and <tt>timeout-form</tt> should be the same.
+  
+  
+  Advanced Notes:
+  This form should be called either at the top-level or in an environment
+  where state is available and <tt>body</tt> has no free variables
+  other than state.
+  If the timeout-form is a long running computation, 
+  then the purpose of with-timeout is defeated.
+
+  <code>
+  Usage:
+  (with-timeout 5 (fibonacci 40) :timeout)
+   :doc with-timeout
+  </code>"
+  )
+
+(defttag :acl2s-timeout)
+
+
+(defun timeout-hard-error (ctx str alist state)
+  (declare (xargs :mode :program
+                  :stobjs (state)))
+  (er-progn
+   (assign acl2::timeout-error-occurred t)
+   (mv t (hard-error ctx str alist) state)))
+   
+
+(progn!
+ (set-raw-mode t)
+ (load (concatenate 'string (cbd) "with-timeout-raw.lsp")))
+
+
+(defmacro-last with-timeout-aux)
+
+;adapted from the macro top-level in other-events.lisp
+;TODO:  I do not believe this is not a general solution --Ask Matt!
+;A general solution might have to use trans-eval or ld explicitly
+;inside the function body, which sounds ugly
+(defmacro timed-eval-of-event (duration form timeout-form
+                                        submit-eventp debug)
+  "evaluate event form as a function body, so that with-timeout-aux doesnt
+   complain, but also do a macroexpand1 so that forms like
+  defun,defthm wont complain. Form should have no free 
+  variables (other than state), i.e it should be a top-level form"
+  `(with-output
+    :stack :push
+    :off :all
+    ;:on error
+    (make-event
+     (acl2::state-global-let*
+      ((acl2::inhibit-output-lst 
+        (and (not ,debug)
+             acl2::*valid-output-names*)))
+   
+        (mv-let 
+      (erp tform state)
+      (trans1-fn ',form state);do macroexpand1
+      (if erp
+          (er soft 'with-timeout-ev "~|Error in with-timeout-ev: To see, run ~x0~%"
+              '(trans1-fn ',form state))
+        (er-progn 
+         (ld `((defun top-level-fn (state)
+                 (declare (xargs :mode :program :stobjs state)
+                          (ignorable state))
+                 (with-timeout1 ,',duration ,tform ,',timeout-form))
+              ; (acl2s-defaults :set verbosity-level 0);turn off testing output
+;output here wjhen checking timeout
+               (with-output
+                :stack :pop
+                (top-level-fn state)))
+;Note: Suppose form is a defthm/defun, then obviously it will
+;never be registered in the world as an event. And so we have an
+;extra argument which specifies if the form you passed is to be submitted 
+             :ld-pre-eval-print nil
+             :ld-post-eval-print nil
+             :ld-error-action :error
+             :ld-verbose nil
+             :ld-prompt nil)
+;if everything went well, then obviously the form didnt timeout and
+;didnt error out, i.e was successful, either QED or termination, and so
+;we presume that a call without a timeout wrapper should be successful 
+;and we try it. This is a common scenario in defunc. But probably this
+;is not a clean way to do things
+         (value (if ,submit-eventp 
+                    `(with-output :stack :pop
+                                  ,',form) 
+                  '(value-triple :invisible))))))))))
+
+(defmacro with-timeout-ev (duration event-form timeout-form 
+                                    &key submit-eventp debug
+                                    )
+  `(if (zp ,duration) ;if 0 or not a int then timeout is disabled
+      ,event-form
+     (timed-eval-of-event ,duration ,event-form 
+                          ,timeout-form
+                          ,submit-eventp ,debug)))
+
+
+(defmacro with-timeout (duration form timeout-form)
+"can only be called at top-level, that too only forms that are allowed
+to be evaluated inside a function body. To eval defthm, use
+with-timeout-ev instead"
+`(if (zp ,duration) ;if 0 or not a int then timeout is disabled
+     ,form
+   (top-level (with-timeout1 ,duration ,form ,timeout-form))))
+
+
+;the following is for internal use only. I use it in timing out
+;top-level-test? form, where i manually make a function body
+;corresponding to the top-level-test?-fn, this way I dont have to
+;worry about capturing free variables
+
+(defmacro with-timeout1 (duration form timeout-form)
+"can only be used inside a function body, and if form has
+free variables other than state, then manually make a function
+which takes those free variables as arguments and at the calling
+context, pass the arguments, binding the free variables.
+See top-level-test? macro for an example"
+`(if (zp ,duration) ;if 0 or not a int then timeout is disabled
+    ,form
+  (with-timeout-aux '(,duration ,timeout-form) ,form)))
+
+(defttag nil) ; optional (books end with this implicitly)
+
+
diff -Nru acl2-6.2/books/clause-processors/constant-prop.acl2 acl2-6.3/books/clause-processors/constant-prop.acl2
--- acl2-6.2/books/clause-processors/constant-prop.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/clause-processors/constant-prop.acl2	2013-09-30 17:52:17.000000000 +0000
@@ -0,0 +1,3 @@
+
+(ld "tools/flag-package.lsp" :dir :system)
+(certify-book "constant-prop" ? t)
diff -Nru acl2-6.2/books/clause-processors/constant-prop.lisp acl2-6.3/books/clause-processors/constant-prop.lisp
--- acl2-6.2/books/clause-processors/constant-prop.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/clause-processors/constant-prop.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -0,0 +1,490 @@
+
+
+(in-package "ACL2")
+
+(include-book "sublis-var-meaning")
+(include-book "tools/bstar" :dir :system)
+(include-book "join-thms")
+
+(def-join-thms cterm-ev)
+
+(defun match-simple-equality-hyp (lit)
+  (declare (xargs :guard (pseudo-termp lit)))
+  (b* (((mv ok lhs rhs)
+        (case-match lit
+          (('not ('equal lhs rhs)) (mv t lhs rhs))
+          (& (mv nil nil nil))))
+       ((unless ok) (mv nil nil))
+       ((mv ok var val)
+        (cond ((and (symbolp lhs) lhs (quotep rhs))
+               (mv t lhs rhs))
+              ((and (symbolp rhs) rhs (quotep lhs))
+               (mv t rhs lhs))
+              (t (mv nil nil nil))))
+       ((unless ok) (mv nil nil)))
+    (mv t (cons var val))))
+
+(defthm match-simple-equality-hyp-correct
+  (b* (((mv ok (cons var val)) (match-simple-equality-hyp lit)))
+    (implies (and ok (not (cterm-ev lit a)))
+             (equal (cdr (assoc var a)) (cterm-ev val a)))))
+
+(defun collect-simple-equality-hyps (clause)
+  ;; returns (mv clause' subst-alist), where clause' is a subset of clause
+  (declare (xargs :guard (pseudo-term-listp clause)))
+  (b* (((when (atom clause)) nil)
+       (rest-subst
+        (collect-simple-equality-hyps (cdr clause)))
+       (lit (car clause))
+       ((mv matched pair) (match-simple-equality-hyp lit)))
+    (if matched
+        (cons pair rest-subst)
+      rest-subst)))
+
+(defun cterm-ev-subst-alistp (x a)
+  (or (atom x)
+      (and (consp (car x))
+           (caar x)
+           (symbolp (caar x))
+           (equal (cdr (assoc (caar x) a))
+                  (cterm-ev (cdar x) a))
+           (cterm-ev-subst-alistp (cdr x) a))))
+
+(defthm lookup-in-cterm-ev-subst-alistp
+  (implies (and (cterm-ev-subst-alistp b a)
+                (assoc k b))
+           (equal (cterm-ev (cdr (assoc k b)) a)
+                  (cterm-ev k a))))
+
+(mutual-recursion
+ (defun term-ind (x)
+   (cond ((atom x) x)
+         ((eq (car x) 'quote) x)
+         (t (termlist-ind (cdr x)))))
+ (defun termlist-ind (x)
+   (if (atom x)
+       nil
+     (cons (term-ind (car x))
+           (termlist-ind (cdr x))))))
+
+(flag::make-flag term-flg term-ind
+                 :flag-mapping ((term-ind . term)
+                                (termlist-ind . list)))
+
+(local (defthm assoc-append-when-key
+         (implies k
+                  (equal (assoc k (append a b))
+                         (or (assoc k a) (assoc k b))))))
+
+(defthm-term-flg
+  (defthm eval-under-append-cterm-ev-subst-alist
+    (implies (and (cterm-ev-subst-alistp b a)
+                  (pseudo-termp x))
+             (equal (cterm-ev x (append (cterm-ev-alist b a) a))
+                    (cterm-ev x a)))
+    :hints ('(:in-theory (enable cterm-ev-of-fncall-args)))
+    :flag term)
+  (defthm eval-list-under-append-cterm-ev-subst-alist
+    (implies (and (cterm-ev-subst-alistp b a)
+                  (pseudo-term-listp x))
+             (equal (cterm-ev-lst x (append (cterm-ev-alist b a) a))
+                    (cterm-ev-lst x a)))
+    :flag list))
+
+(defun normalize-formals/actuals (formals actuals seen-formals)
+  (declare (xargs :guard (and (symbol-listp formals)
+                              (symbol-listp seen-formals)
+                              (equal (len formals) (len actuals)))))
+  (if (atom formals)
+      (mv nil nil)
+    (if (or (member (car formals) seen-formals)
+            (not (car formals)))
+        (normalize-formals/actuals (cdr formals) (cdr actuals) seen-formals)
+      (mv-let (rest-f rest-a)
+        (normalize-formals/actuals (cdr formals) (cdr actuals)
+                                   (cons (car formals) seen-formals))
+        (mv (cons (car formals) rest-f)
+            (cons (car actuals) rest-a))))))
+
+(defthm normalize-formals/actuals-correct
+  (mv-let (nformals nactuals)
+    (normalize-formals/actuals formals actuals seen-formals)
+    (implies (and k (not (member k seen-formals)))
+             (equal (assoc k (pairlis$ nformals (cterm-ev-lst nactuals a)))
+                    (assoc k (pairlis$ formals (cterm-ev-lst actuals a)))))))
+
+(defthm-term-flg
+  (defthm eval-under-normalize-formals/actuals
+    (mv-let (nformals nactuals)
+      (normalize-formals/actuals formals actuals nil)
+      (implies (pseudo-termp x)
+               (equal (cterm-ev x (pairlis$ nformals (cterm-ev-lst nactuals a)))
+                      (cterm-ev x (pairlis$ formals (cterm-ev-lst actuals a))))))
+    :hints ('(:in-theory (enable cterm-ev-of-fncall-args)))
+    :flag term)
+  (defthm eval-list-under-normalize-formals/actuals
+    (mv-let (nformals nactuals)
+      (normalize-formals/actuals formals actuals nil)
+      (implies (pseudo-term-listp x)
+               (equal (cterm-ev-lst x (pairlis$ nformals (cterm-ev-lst nactuals a)))
+                      (cterm-ev-lst x (pairlis$ formals (cterm-ev-lst actuals a))))))
+    :flag list))
+
+(defthm normalize-formals/actuals-pseudo-term-listp
+  (implies (pseudo-term-listp actuals)
+           (pseudo-term-listp (mv-nth 1 (normalize-formals/actuals
+                                         formals actuals seen-formals)))))
+
+(defthm normalize-formals/actuals-symbol-listp
+  (implies (symbol-listp formals)
+           (symbol-listp (mv-nth 0 (normalize-formals/actuals
+                                    formals actuals seen-formals)))))
+
+(defthm normalize-formals/actuals-type-0
+  (true-listp (mv-nth 0 (normalize-formals/actuals formals actuals
+                                                   seen-formals)))
+  :rule-classes :type-prescription)
+
+(defthm normalize-formals/actuals-type-1
+  (true-listp (mv-nth 1 (normalize-formals/actuals formals actuals
+                                                   seen-formals)))
+  :rule-classes :type-prescription)
+
+(defthm len-of-normalize-formals/actuals
+  (equal (len (mv-nth 1 (normalize-formals/actuals formals actuals
+                                                   seen-formals)))
+         (len (mv-nth 0 (normalize-formals/actuals formals actuals
+                                                   seen-formals)))))
+
+(defthm normalize-formals/actuals-nonnil-symbols
+  (not (member nil (mv-nth 0 (normalize-formals/actuals formals actuals
+                                                        seen-formals)))))
+
+(defthmd normalize-formals/actuals-no-members-of-seen-formals
+  (implies (member k seen-formals)
+           (not (member k (mv-nth 0 (normalize-formals/actuals formals actuals
+                                                               seen-formals))))))
+
+(defthm normalize-formals/actuals-no-duplicate-vars
+  (no-duplicatesp-equal
+   (mv-nth 0 (normalize-formals/actuals formals actuals seen-formals)))
+  :hints(("Goal" :in-theory (enable normalize-formals/actuals-no-members-of-seen-formals))))
+
+(local (defthm collect-simple-equality-hyps-subst-correct
+         (b* ((subst (collect-simple-equality-hyps clause)))
+           (implies (not (cterm-ev (disjoin clause) a))
+                    (cterm-ev-subst-alistp subst a)))))
+
+;; (defthm collect-simple-equality-hyps-clause-correct
+;;   (b* (((mv ?new-clause ?subst) (collect-simple-equality-hyps clause)))
+;;     (implies (not (cterm-ev (disjoin clause) a))
+;;              (not (cterm-ev (disjoin new-clause) a)))))
+
+(defun bindings-to-const-alist (formals actuals)
+  (declare (xargs :guard (and (symbol-listp formals)
+                              (pseudo-term-listp actuals)
+                              (equal (len formals) (len actuals)))))
+  (if (atom formals)
+      nil
+    (if (and (car formals)
+             (not (member (car formals) (cdr formals)))
+             (quotep (car actuals)))
+        (cons (cons (car formals) (car actuals))
+              (bindings-to-const-alist (cdr formals) (cdr actuals)))
+      (bindings-to-const-alist (cdr formals) (cdr actuals)))))
+
+(defthm cterm-ev-subst-alistp-cons-non-key
+  (implies (and (cterm-ev-subst-alistp b a)
+                (quote-listp (strip-cdrs b))
+                (not (assoc k b)))
+           (cterm-ev-subst-alistp b (cons (cons k v) a))))
+
+(defthm quote-listp-strip-cdrs-of-bindings-to-const-alist
+  (quote-listp (strip-cdrs (bindings-to-const-alist formals actuals))))
+
+(defthm not-assoc-bindings-to-const-alist-when-not-member-formals
+  (implies (not (member k formals))
+           (not (assoc k (bindings-to-const-alist formals actuals)))))
+
+(defthm not-assoc-bindings-to-const-alist-nil
+  (not (assoc nil (bindings-to-const-alist formals actuals))))
+
+(defthm bindings-to-const-alist-correct
+  (implies (and (symbol-listp formals)
+                (no-duplicatesp-equal formals)
+                (not (member nil formals))
+                (pseudo-term-listp actuals)
+                (equal (len formals) (len actuals)))
+           (cterm-ev-subst-alistp
+            (bindings-to-const-alist formals actuals)
+            (pairlis$ formals (cterm-ev-lst actuals a)))))
+
+
+
+;; exists in several books...
+(defun pseudo-term-val-alistp (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      (eq x nil)
+    (and (consp (car x))
+         (pseudo-termp (cdar x))
+         (pseudo-term-val-alistp (cdr x)))))
+
+;; exists in several books...
+(defthm pseudo-termp-assoc
+  (implies (pseudo-term-val-alistp x)
+           (pseudo-termp (cdr (assoc-equal k x)))))
+
+;; exists in several books...
+(defthm pseudo-term-val-alistp-pairlis$
+  (implies (pseudo-term-listp x)
+           (pseudo-term-val-alistp (pairlis$ keys x))))
+
+
+(mutual-recursion
+ ;; returns (mv changedp x)
+ (defun deep-substitute-term (x subst)
+   (declare (xargs :guard (and (pseudo-termp x)
+                               (pseudo-term-val-alistp subst))
+                   :verify-guards nil))
+   (b* (((when (variablep x))
+         (if x
+             (b* ((look (assoc x subst)))
+               (if look
+                   (mv t (cdr look))
+                 (mv nil x)))
+           (mv nil nil)))
+        ((when (fquotep x)) (mv nil x))
+        ((mv args-changedp args) (deep-substitute-term-list (cdr x) subst))
+        (fn (car x))
+        ((unless (consp fn))
+         (b* (((when (quote-listp args)) (cons-term1-mv2 fn args x))
+              ((when (and (eq fn 'if)
+                          (eql (len args) 3)
+                          (quotep (car args))))
+               (if (unquote (car args))
+                   (mv t (cadr args))
+                 (mv t (caddr args))))
+              ((when args-changedp) (mv t (cons-term fn args))))
+           (mv nil x)))
+        ((mv formals actuals) (normalize-formals/actuals (cadr fn) args nil))
+        (subst1 (bindings-to-const-alist formals actuals))
+        ((mv body-changedp body) (if subst1
+                                     (deep-substitute-term (caddr fn) subst1)
+                                   (mv nil (caddr fn)))))
+     (if (or body-changedp args-changedp)
+         (mv t `((lambda ,formals ,body) . ,actuals))
+       (mv nil x))))
+
+ (defun deep-substitute-term-list (x subst)
+   (declare (xargs :guard (and (pseudo-term-listp x)
+                               (pseudo-term-val-alistp subst))))
+   (b* (((when (atom x))
+         (mbe :logic (if (eq x nil)
+                         (mv nil nil)
+                       (mv t nil))
+              :exec (mv nil nil)))
+        ((mv changedp1 a) (deep-substitute-term (car x) subst))
+        ((mv changedp2 b) (deep-substitute-term-list (cdr x) subst)))
+     (if (or changedp1 changedp2)
+         (mv t (cons a b))
+       (mv nil x)))))
+
+
+
+
+(flag::make-flag deep-substitute-flg deep-substitute-term
+                 :flag-mapping ((deep-substitute-term . term)
+                                (deep-substitute-term-list . list)))
+
+(defthm-deep-substitute-flg
+  (defthm true-listp-deep-substitute-term-list
+    (and (true-listp (mv-nth 1 (deep-substitute-term-list x subst)))
+         (implies (not (true-listp x))
+                  (mv-nth 0 (deep-substitute-term-list x subst))))
+    :rule-classes ((:type-prescription
+                    :corollary
+                    (true-listp (mv-nth 1 (deep-substitute-term-list x subst)))))
+    :flag list)
+  :skip-others t)
+
+(defthm-deep-substitute-flg
+  (defthm len-of-deep-substitute-term-list
+    (equal (len (mv-nth 1 (deep-substitute-term-list x subst)))
+           (len x))
+    :flag list)
+  :skip-others t)
+
+(defthm bindings-to-const-alist-pseudo-term-val-alistp
+  (implies (pseudo-term-listp actuals)
+           (pseudo-term-val-alistp (bindings-to-const-alist formals actuals))))
+
+(defthm pseudo-termp-of-cons-term1-mv2
+  (implies (and (symbolp fn) (not (eq fn 'quote))
+                (pseudo-term-listp args)
+                (pseudo-termp form))
+           (pseudo-termp (mv-nth 1 (cons-term1-mv2 fn args form))))
+  :hints(("Goal" :in-theory (enable cons-term1-mv2))))
+
+(defthm-deep-substitute-flg
+  (defthm pseudo-termp-deep-substitute-term
+    (implies (and (pseudo-termp x)
+                  (pseudo-term-val-alistp subst))
+             (pseudo-termp (mv-nth 1 (deep-substitute-term x subst))))
+    :flag term)
+  (defthm pseudo-term-listp-deep-substitute-term-list
+    (implies (and (pseudo-term-listp x)
+                  (pseudo-term-val-alistp subst))
+             (pseudo-term-listp (mv-nth 1 (deep-substitute-term-list x subst))))
+    :flag list))
+
+(local (defthm pseudo-term-val-alistp-impl-alistp
+         (implies (pseudo-term-val-alistp x)
+                  (alistp x))
+         :rule-classes :forward-chaining))
+
+(encapsulate nil
+  (local (defthm unquote-guard-when-pseudo-term-listp
+           (implies (and (pseudo-term-listp x)
+                         (equal (caar x) 'quote))
+                    (consp (cdar x)))))
+
+  (verify-guards deep-substitute-term))
+
+(encapsulate nil
+  (set-irrelevant-formals-ok t)
+  (mutual-recursion
+   ;; returns (mv changedp x)
+   (defun deep-substitute-term/alist (x subst alist)
+     (b* (((when (variablep x))
+           (if x
+               (b* ((look (assoc x subst)))
+                 (if look
+                     (mv t (cdr look))
+                   (mv nil x)))
+             (mv nil nil)))
+          ((when (fquotep x)) (mv nil x))
+          ((mv args-changedp args) (deep-substitute-term-list/alist (cdr x) subst alist))
+          (fn (car x))
+          ((unless (consp fn))
+           (b* (((when (quote-listp args)) (cons-term1-mv2 fn args x))
+                ((when (and (eq fn 'if)
+                            (eql (len args) 3)
+                            (quotep (car args))))
+                 (if (unquote (car args))
+                     (mv t (cadr args))
+                   (mv t (caddr args))))
+                ((when args-changedp) (mv t (cons-term fn args))))
+             (mv nil x)))
+          ((mv formals actuals) (normalize-formals/actuals (cadr fn) args nil))
+          (subst1 (bindings-to-const-alist formals actuals))
+          ((mv body-changedp body) (if subst1
+                                       (deep-substitute-term/alist
+                                        (caddr fn) subst1
+                                        (pairlis$ formals (cterm-ev-lst actuals alist)))
+                                     (mv nil (caddr fn)))))
+       (if (or body-changedp args-changedp)
+           (mv t `((lambda ,formals ,body) . ,actuals))
+         (mv nil x))))
+
+   (defun deep-substitute-term-list/alist (x subst alist)
+     (b* (((when (atom x))
+           (mbe :logic (if (eq x nil)
+                           (mv nil nil)
+                         (mv t nil))
+                :exec (mv nil nil)))
+          ((mv changedp1 a) (deep-substitute-term/alist (car x) subst alist))
+          ((mv changedp2 b) (deep-substitute-term-list/alist (cdr x) subst alist)))
+       (if (or changedp1 changedp2)
+           (mv t (cons a b))
+         (mv nil x))))))
+
+(flag::make-flag deep-substitute/alist-flg deep-substitute-term/alist
+                 :flag-mapping ((deep-substitute-term/alist . term)
+                                (deep-substitute-term-list/alist . list)))
+
+(local
+ (defthm-deep-substitute/alist-flg
+   (defthm deep-substitute-term/alist-correct
+     (equal (deep-substitute-term/alist x subst alist)
+            (deep-substitute-term x subst))
+     :flag term)
+   (defthm deep-substitute-term-list/alist-correct
+     (equal (deep-substitute-term-list/alist x subst alist)
+            (deep-substitute-term-list x subst))
+     :flag list)))
+
+(defthm-deep-substitute/alist-flg
+  (defthm deep-substitute-term-correct
+    (implies (and (pseudo-termp x)
+                  (pseudo-term-val-alistp subst)
+                  (cterm-ev-subst-alistp subst alist))
+             (equal (cterm-ev (mv-nth 1 (deep-substitute-term x subst)) alist)
+                    (cterm-ev x alist)))
+    :hints ('(:in-theory (enable cterm-ev-of-fncall-args)
+              :expand ((deep-substitute-term x subst))))
+    :flag term)
+  (defthm deep-substitute-term-list-correct
+    (implies (and (pseudo-term-listp x)
+                  (pseudo-term-val-alistp subst)
+                  (cterm-ev-subst-alistp subst alist))
+             (equal (cterm-ev-lst (mv-nth 1 (deep-substitute-term-list x subst)) alist)
+                    (cterm-ev-lst x alist)))
+    :hints ('(:expand ((deep-substitute-term-list x subst))))
+    :flag list))
+
+(defthm deep-substitute-term-disjoin-correct
+  (implies (and (pseudo-term-listp x)
+                (pseudo-term-val-alistp subst)
+                (cterm-ev-subst-alistp subst alist))
+           (iff (cterm-ev (disjoin (mv-nth 1 (deep-substitute-term-list x subst))) alist)
+                (cterm-ev (disjoin x) alist)))
+  :hints (("goal" :induct (len x)
+           :in-theory (enable cterm-ev-disjoin-when-consp))))
+
+
+(defthm pseudo-term-val-alistp-of-collect-simple-equality-hyps
+  (implies (pseudo-term-listp clause)
+           (pseudo-term-val-alistp (collect-simple-equality-hyps
+                                    clause))))
+
+;; (defthm pseudo-term-listp-of-collect-simple-equality-hyps
+;;   (implies (pseudo-term-listp clause)
+;;            (pseudo-term-listp (mv-nth 0 (collect-simple-equality-hyps clause)))))
+
+(defun constant-prop-non-equality-hyps (clause subst)
+  (declare (xargs :guard (and (pseudo-term-listp clause)
+                              (pseudo-term-val-alistp subst))))
+  (b* (((when (atom clause)) nil)
+       ((mv matched &) (match-simple-equality-hyp (car clause)))
+       ((when matched)
+        (cons (car clause)
+              (constant-prop-non-equality-hyps (cdr clause) subst)))
+       ((mv ?changedp lit)
+        (deep-substitute-term (car clause) subst)))
+    (cons lit
+          (constant-prop-non-equality-hyps (cdr clause) subst))))
+
+(defthm constant-prop-non-equality-hyps-correct
+  (implies (and (pseudo-term-listp clause)
+                (pseudo-term-val-alistp subst)
+                (cterm-ev-subst-alistp subst alist))
+           (iff (cterm-ev (disjoin (constant-prop-non-equality-hyps
+                                    clause subst))
+                          alist)
+                (cterm-ev (disjoin clause) alist)))
+  :hints(("Goal" :in-theory (disable deep-substitute-term match-simple-equality-hyp))))
+
+(defun constant-prop-cp (clause)
+  (declare (xargs :guard (pseudo-term-listp clause)))
+  (b* ((subst-alist (collect-simple-equality-hyps clause))
+       (new-clause
+        (constant-prop-non-equality-hyps clause subst-alist)))
+    (list new-clause)))
+
+(defthm constant-prop-cp-correct
+  (implies (and (pseudo-term-listp clause)
+                (alistp a)
+                (cterm-ev (conjoin-clauses (constant-prop-cp clause)) a))
+           (cterm-ev (disjoin clause) a))
+  :rule-classes :clause-processor)
diff -Nru acl2-6.2/books/clause-processors/find-matching.lisp acl2-6.3/books/clause-processors/find-matching.lisp
--- acl2-6.2/books/clause-processors/find-matching.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/clause-processors/find-matching.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -46,6 +46,18 @@
         ((when ok) (mv ok subterm)))
      (find-match-list pat (cdr x) initial-alist))))
 
+;; This variant finds a literal in the clause that matches
+(defun find-matching-literal-in-clause (pat clause initial-alist)
+  (declare (xargs :guard (and (pseudo-termp pat)
+                              (pseudo-term-listp clause)
+                              (alistp initial-alist))))
+  (b* (((when (atom clause)) (mv nil nil))
+       ((mv match ?alist) (simple-one-way-unify pat (car clause)
+                                                initial-alist))
+       ((when match) (mv t (car clause))))
+    (find-matching-literal-in-clause pat (cdr clause) initial-alist)))
+    
+
 
 
 ;; Find as many occurrences as exist; return the list of subterms.
diff -Nru acl2-6.2/books/clause-processors/just-expand.lisp acl2-6.3/books/clause-processors/just-expand.lisp
--- acl2-6.2/books/clause-processors/just-expand.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/clause-processors/just-expand.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -1,333 +1,1150 @@
 
 (in-package "ACL2")
 (include-book "unify-subst")
+(include-book "meta-extract-user")
 (include-book "tools/bstar" :dir :system)
 (include-book "ev-theoremp")
 (include-book "use-by-hint")
+(include-book "std/lists/butlast" :dir :system)
+
+(in-theory (disable butlast))
 
-;; This could be made much more sophisticated.  However, at the moment we just
-;; expand term with an EQUAL-based definition.
 
-(defun just-expand-cp-hint-get-rule (rule fn w)
-  (declare (xargs :mode :program))
-  (if (not rule)
-      (b* ((def (def-body fn w))
-           ((unless (and def (not (access def-body def :hyp))))
-            (er hard? 'just-expand-cp "couldn't find a hyp-free definition for ~x0"
-                fn)
-            nil))
-        (list (cons fn (access def-body def :formals)) ;; lhs
-              (access def-body def :concl)
-              (access def-body def :rune)))
-    (b* ((lemmas (getprop fn 'lemmas nil 'current-acl2-world w))
-         (lemma (if (symbolp rule)
-                    (find-named-lemma
-                     (deref-macro-name rule (macro-aliases w))
-                     lemmas t)
-                  (find-runed-lemma rule lemmas)))
-         ((unless (and lemma
-                       (not (access rewrite-rule lemma :hyps))
-                       (eq (access rewrite-rule lemma :equiv) 'equal)))
-          (er hard? 'just-expand-cp "the definition has hyps or is not EQUAL-based")
-          nil))
-      (list (access rewrite-rule lemma :lhs)
-            (access rewrite-rule lemma :rhs)
-            (access rewrite-rule lemma :rune)))))
-
-(defun just-expand-cp-finish-hint (rule vars term w)
-  (declare (xargs :mode :program))
-  (b* (((when (atom term))
-        (er hard? 'just-expand-cp "atom in term position in hints: ~x0~%" term)) ;; error
-       ((mv erp trans-term)
-        (translate-cmp term t nil nil 'just-expand-cp w 
-                       (default-state-vars nil)))
-       ((when erp)
-        (er hard? 'just-expand-cp "translate failed: ~@0~%" trans-term))
-       ((list lhs rhs rune) (just-expand-cp-hint-get-rule rule (car trans-term)
-                                                          w))
-       (trans-term-vars (simple-term-vars trans-term))
-       (nonfree-vars (set-difference-eq trans-term-vars vars)))
-    (cons trans-term `((lhs . ,lhs)
-                       (rhs . ,rhs)
-                       (rune . ,rune)
-                       (subst . ,(pairlis$ nonfree-vars nonfree-vars))))))
-
-(defun just-expand-cp-parse-hint (hint w)
-  (declare (xargs :mode :program))
-  (case-match hint
-    ((':with rule (':free vars term))
-     (just-expand-cp-finish-hint rule vars term w))
-    ((':free vars (':with rule term))
-     (just-expand-cp-finish-hint rule vars term w))
-    ((':free vars term)
-     (just-expand-cp-finish-hint nil vars term w))
-    ((':with rule term)
-     (just-expand-cp-finish-hint rule nil term w))
-    (& (just-expand-cp-finish-hint nil nil hint w))))
-       
-
-(defun just-expand-cp-parse-hints (hints w)
-  (declare (Xargs :mode :program))
-  (if (atom hints)
-      nil
-    (cons (just-expand-cp-parse-hint (car hints) w)
-          (just-expand-cp-parse-hints (cdr hints) w))))
+(defund expand-me (x)
+  (declare (xargs :Guard t))
+  x)
+(in-theory (disable (expand-me) (:t expand-me)))
 
+(defund expand-me-with (rule x)
+  (declare (xargs :guard t)
+           (ignore rule))
+  x)
+(in-theory (disable (expand-me-with) (:t expand-me-with)))
 
-(defevaluator expev expev-lst
+(defevaluator-fast expev expev-lst
   ((if a b c) (equal a b) (not a) (use-by-hint a)
-   (cons a b) (binary-+ a b)))
+   (cons a b) (binary-+ a b)
+   (typespec-check ts x)
+   (iff a b)
+   (implies a b)
+   (expand-me x)
+   (expand-me-with rule x))
+  :namedp t)
 
 (def-ev-theoremp expev)
+(def-meta-extract expev expev-lst)
+(def-unify expev expev-alist)
 
+(local (in-theory (disable w)))
 
-(defun hint-alist-okp (alist)
-  (declare (xargs :guard t))
-  (and (alistp alist)
-       (pseudo-termp (cdr (assoc 'lhs alist)))
-       (pseudo-termp (cdr (assoc 'rhs alist)))
-       (alistp (cdr (assoc 'subst alist)))))
-
-(defun hints-okp (hints)
-  (declare (xargs :guard t))
-  (or (atom hints)
-      (and (consp (car hints))
-           (pseudo-termp (caar hints))
-           (hint-alist-okp (cdar hints))
-           (hints-okp (cdr hints)))))
-
-(defun apply-expansion (term pattern alist)
-  (declare (xargs :guard (and (pseudo-termp term)
-                              (pseudo-termp pattern)
-                              (hint-alist-okp alist))))
-  (b* ((subst (cdr (assoc 'subst alist)))
-       ((mv pat-ok &) (simple-one-way-unify pattern term subst))
-       ((unless pat-ok) term)
-       (lhs (cdr (assoc 'lhs alist)))
-       ((mv lhs-ok subst) (simple-one-way-unify lhs term nil))
-       ((unless lhs-ok) term)
-       (rhs (cdr (assoc 'rhs alist))))
-    (substitute-into-term rhs subst)))
-
-(defund hint-alist-to-clause (alist)
-  (declare (xargs :guard (alistp alist)))
-  `((not (use-by-hint ',(cdr (assoc 'rune alist))))
-    (equal ,(cdr (assoc 'lhs alist))
-           ,(cdr (assoc 'rhs alist)))))
-
-(local (defthm hint-alist-to-clause-correct
-         (implies (expev-theoremp (disjoin (hint-alist-to-clause alist)))
-                  (equal (expev (cdr (assoc 'lhs alist)) a)
-                         (expev (cdr (assoc 'rhs alist)) a)))
-         :hints(("Goal" :in-theory (enable hint-alist-to-clause
-                                           use-by-hint)
-                 :use ((:instance expev-falsify
-                        (x (disjoin (hint-alist-to-clause alist)))
-                        (a a)))))))
-
-(def-unify expev expev-alist)
+(local (defthm expev-alist-of-pairlis$
+         (equal (expev-alist (pairlis$ x y) a)
+                (pairlis$ x (expev-lst y a)))))
+
+(defsection expand-this-term
+  (defund expand-this-term (x explicit-rule w)
+    "returns (mv successp x1)"
+    (declare (xargs :guard (and (pseudo-termp x)
+                                (symbolp explicit-rule)
+                                (plist-worldp w))))
+    (b* (((when (or (variablep x) (fquotep x))) x)
+         (fn (ffn-symb x))
+         ((when (flambdap fn))
+          ;; expand the lambda; why not
+          (b* ((formals (lambda-formals fn))
+               (body (lambda-body fn))
+               (args (fargs x)))
+            (substitute-into-term body (pairlis$ formals args))))
+         ;; x is a function call, fn is a symbol
+         (rule (or explicit-rule fn))
+         (formula (meta-extract-formula-w rule w))
+         ((unless (pseudo-termp formula)) x)
+         ((mv ok lhs rhs)
+          (case-match formula
+            (('equal lhs rhs)
+             (mv t lhs rhs))
+            (& (mv nil nil nil))))
+         ((unless ok) x)
+         ((mv match-ok subst) (simple-one-way-unify lhs x nil))
+         ((unless match-ok) x))
+      (substitute-into-term rhs subst)))
+
+  (local (in-theory (enable expand-this-term)))
+
+  (defthm expand-this-term-correct
+    (implies (and (expev-meta-extract-global-facts)
+                  (equal w (w state))
+                  (pseudo-termp x))
+             (equal (expev (expand-this-term x explicit-rule w) a)
+                    (expev x a)))
+    :hints (("goal" :use ((:instance expev-meta-extract-formula
+                           (name (or explicit-rule (car x)))
+                           (st state)
+                           (a (expev-alist
+                               (mv-nth 1 (simple-one-way-unify
+                                          (cadr (meta-extract-formula
+                                                 (or explicit-rule (car x)) state))
+                                          x nil))
+                               a))))
+             :in-theory (disable expev-meta-extract-formula))))
+
+  (defthm expand-this-term-pseudo-termp
+    (implies (pseudo-termp x)
+             (pseudo-termp (expand-this-term x explicit-rule w)))))
+
+
+(defsection expand-if-marked
+  
+
+  (defund expand-if-marked (fn args w)
+    (declare (xargs :guard (and (symbolp fn)
+                                (not (eq fn 'quote))
+                                (pseudo-term-listp args)
+                                (plist-worldp w))))
+    (b* (((when (eq fn 'expand-me))
+          (b* ((term (first args)))
+            (expand-this-term term nil w)))
+         ((when (and (eq fn 'expand-me-with)
+                     (quotep (first args))))
+          (b* ((rule (unquote (first args)))
+               (term (second args))
+               ((unless (or (symbol-listp rule) ;; rune
+                            (symbolp rule)))
+                term)
+               (rule (if (consp rule) (second rule) rule)))
+            (expand-this-term term rule w))))
+      (cons fn args)))
+
+  (local (in-theory (enable expand-if-marked expand-me expand-me-with)))
+
+  (defthm expand-if-marked-correct
+    (implies (and (expev-meta-extract-global-facts)
+                  (equal w (w state))
+                  (symbolp fn)
+                  (pseudo-term-listp args))
+             (equal (expev (expand-if-marked fn args w) a)
+                    (expev (cons fn args) a))))
+
+  (defthm expand-if-marked-pseudo-termp
+    (implies (and (symbolp fn)
+                  (not (eq fn 'quote))
+                  (pseudo-term-listp args))
+             (pseudo-termp (expand-if-marked fn args w))))
+
+  (defun expand-if-marked-meta (x mfc state)
+    (declare (xargs :stobjs state
+                    :guard (pseudo-termp x))
+             (ignorable mfc))
+    (b* (((when (variablep x)) x)
+         (fn (ffn-symb x))
+         ((when (eq fn 'quote)) x)
+         ((when (consp fn)) x)
+         (args (fargs x)))
+      (expand-if-marked fn args (w state))))
 
-(defthm apply-expansion-correct
-  (implies (and (expev-theoremp (disjoin (hint-alist-to-clause alist)))
-                (pseudo-termp term)
-                (pseudo-termp pattern)
-                (hint-alist-okp alist))
-           (equal (expev (apply-expansion term pattern alist) a)
-                  (expev term a)))
-  :hints (("goal" :do-not-induct t)))
-
-(defthm pseudo-termp-apply-expansion
-  (implies (and (pseudo-termp term)
-                (hint-alist-okp alist))
-           (pseudo-termp (apply-expansion term pattern alist))))
-
-(local (in-theory (disable apply-expansion hint-alist-okp)))
-
-
-(defun hint-alists-to-clauses (hints)
-  (declare (xargs :guard (hints-okp hints)
-                  :guard-hints(("Goal" :in-theory (enable hint-alist-okp)))))
-  (if (atom hints)
-      nil
-    (cons (hint-alist-to-clause (cdar hints))
-          (hint-alists-to-clauses (cdr hints)))))
-
-
-(defun apply-expansions (term hints)
-  (declare (xargs :guard (and (pseudo-termp term)
-                              (hints-okp hints))))
-  (if (atom hints)
-      term
-    (apply-expansions
-     (apply-expansion term (caar hints) (cdar hints))
-     (cdr hints))))
-
-(defthm apply-expansions-correct
-  (implies (and (expev-theoremp (conjoin-clauses (hint-alists-to-clauses hints)))
-                (hints-okp hints)
-                (pseudo-termp term))
-           (equal (expev (apply-expansions term hints) a)
-                  (expev term a))))
-
-(defthm pseudo-termp-apply-expansions
-  (implies (and (pseudo-termp term)
-                (hints-okp hints))
-           (pseudo-termp (apply-expansions term hints))))
-
-(in-theory (disable apply-expansions hints-okp))
-
-(mutual-recursion
- (defun term-apply-expansions (x hints)
-   (declare (xargs :guard (and (pseudo-termp x)
-                               (hints-okp hints))
-                   :verify-guards nil))
-   (if (or (variablep x)
-           (fquotep x))
-       x
-     (let ((args (termlist-apply-expansions (fargs x) hints))
-           (fn (ffn-symb x)))
-       (if (flambdap fn)
-           ;; NOTE: this is a little odd because it doesn't consider the lambda
-           ;; substitution.  Sound, but arguably expands the wrong terms (for
-           ;; some value of "wrong").
-           (let* ((body (term-apply-expansions (lambda-body fn) hints)))
-             (cons (make-lambda (lambda-formals fn) body)
-                   args))
-         (apply-expansions (cons fn args) hints)))))
- (defun termlist-apply-expansions (x hints)
-   (declare (xargs :guard (and (pseudo-term-listp x)
-                               (hints-okp hints))))
-   (if (atom x)
-       nil
-     (cons (term-apply-expansions (car x) hints)
-           (termlist-apply-expansions (cdr x) hints)))))
-
-(make-flag term-apply-expansions-flg term-apply-expansions
-           :flag-mapping ((term-apply-expansions . term)
-                          (termlist-apply-expansions . list)))
-
-(defthm len-of-termlist-apply-expansions
-  (equal (len (termlist-apply-expansions x hints))
-         (len x))
-  :hints (("goal" :induct (len x)
-           :expand (termlist-apply-expansions x hints))))
 
-(defthm-term-apply-expansions-flg
-  (defthm pseudo-termp-term-apply-expansions
+  ;; don't enable this now or the rest of the book will go crazy
+  (defthmd expand-marked-meta
     (implies (and (pseudo-termp x)
-                  (hints-okp hints))
-             (pseudo-termp (term-apply-expansions x hints)))
-    :hints ((and stable-under-simplificationp
-                 '(:expand ((:free (a b) (pseudo-termp (cons a b)))))))
-    :flag term)
-  (defthm pseudo-term-listp-termlist-apply-expansions
-    (implies (and (pseudo-term-listp x)
-                  (hints-okp hints))
-             (pseudo-term-listp (termlist-apply-expansions x hints)))
-    :flag list))
-
-(mutual-recursion
- (defun term-apply-expansions-correct-ind (x hints a)
-   (if (or (variablep x)
-           (fquotep x))
-       (list x a)
-     (let ((args (termlist-apply-expansions (fargs x) hints))
-           (ign (termlist-apply-expansions-correct-ind
-                 (fargs x) hints a))
-           (fn (ffn-symb x)))
-       (declare (ignore ign))
-       (if (flambdap fn)
-           (term-apply-expansions-correct-ind
-            (lambda-body fn) hints
-            (pairlis$ (lambda-formals fn)
-                      (expev-lst args a)))
-         (apply-expansions (cons fn args) hints)))))
- (defun termlist-apply-expansions-correct-ind (x hints a)
-   (if (atom x)
-       nil
-     (cons (term-apply-expansions-correct-ind (car x) hints a)
-           (termlist-apply-expansions-correct-ind (cdr x) hints a)))))
-
-(make-flag term-apply-expansions-correct-flg term-apply-expansions-correct-ind
-           :flag-mapping ((term-apply-expansions-correct-ind . term)
-                          (termlist-apply-expansions-correct-ind . list)))
+                  (expev-meta-extract-global-facts))
+             (equal (expev x a)
+                    (expev (expand-if-marked-meta x mfc state) a)))
+    :rule-classes ((:meta :trigger-fns (expand-me expand-me-with)))))
+
+
+(defsection term/alist-ind
+  (mutual-recursion
+   (defun expev-term/alist-ind (x al)
+     (b* (((when (variablep x)) al)
+          (fn (ffn-symb x))
+          ((when (eq fn 'quote)) al)
+          (?args (expev-termlist/alist-ind (fargs x) al))
+          ((when (consp fn))
+           (expev-term/alist-ind (lambda-body fn)
+                                 (pairlis$ (lambda-formals fn)
+                                           (expev-lst (fargs x) al)))))
+       al))
+   (defun expev-termlist/alist-ind (x al)
+     (if (atom x)
+         nil
+       (cons (expev-term/alist-ind (car x) al)
+             (expev-termlist/alist-ind (cdr x) al)))))
+
+  (make-flag expev-term/alist-flag expev-term/alist-ind
+             :flag-mapping ((expev-term/alist-ind . term)
+                            (expev-termlist/alist-ind . list))))
 
 
 
-(defthm-term-apply-expansions-correct-flg
-  (defthm term-apply-expansions-correct
-    (implies (and (pseudo-termp x)
-                  (hints-okp hints)
-                  (expev-theoremp (conjoin-clauses (hint-alists-to-clauses hints))))
-             (equal (expev (term-apply-expansions x hints) a)
-                    (expev x a)))
-    :hints ((and stable-under-simplificationp
-                 '(:in-theory (enable expev-constraint-0)
-                   :expand ((:free (a b) (pseudo-termp (cons a b)))))))
-    :flag term)
-  (defthm termlist-apply-expansions-correct
-    (implies (and (pseudo-term-listp x)
-                  (hints-okp hints)
-                  (expev-theoremp (conjoin-clauses (hint-alists-to-clauses hints))))
-             (equal (expev-lst (termlist-apply-expansions x hints) a)
-                    (expev-lst x a)))
-    :flag list))
-
-(verify-guards term-apply-expansions
-  :hints ((and stable-under-simplificationp
-               '(:expand ((:free (a b) (pseudo-termp (cons a b))))))))
-
-(in-theory (disable term-apply-expansions))
-
-(defthm expev-of-disjoin
-  (iff (expev (disjoin x) a)
-       (or-list (expev-lst x a)))
-  :hints(("Goal" :in-theory (enable or-list)
-          :induct (len x))))
-
-(defun just-expand-cp (clause hints)
-  (declare (xargs :guard (pseudo-term-listp clause)))
-  (b* (((unless (hints-okp hints))
-        (er hard? 'just-expand-cp "bad hints")
-        (list clause))
-       (hint-clauses (hint-alists-to-clauses hints))
-       (expanded-clause
-        (termlist-apply-expansions clause hints)))
-    (cons expanded-clause hint-clauses)))
-
-(defthm just-expand-cp-correct
-  (implies (and (pseudo-term-listp clause)
-                (alistp a)
-                (expev-theoremp
-                 (conjoin-clauses (just-expand-cp clause hints))))
-           (expev (disjoin clause) a))
-  :hints (("goal" :do-not-induct t
-           :use ((:instance expev-falsify
-                  (x (disjoin (car (just-expand-cp clause hints))))))))
-  :rule-classes :clause-processor)
+(defsection expand-marked-term
+
+  (mutual-recursion
+   (defun expand-marked-term (x w)
+     (declare (xargs :guard (and (pseudo-termp x)
+                                 (plist-worldp w))
+                     :verify-guards nil))
+     (b* (((when (variablep x)) x)
+          (fn (ffn-symb x))
+          ((when (eq fn 'quote)) x)
+          (args (expand-marked-list (fargs x) w))
+          ((when (flambdap fn))
+           `((lambda ,(lambda-formals fn)
+               ,(expand-marked-term (lambda-body fn) w))
+             . ,args)))
+       (expand-if-marked fn args w)))
+
+   (defun expand-marked-list (x w)
+     (declare (xargs :guard (and (pseudo-term-listp x)
+                                 (plist-worldp w))))
+     (if (atom x)
+         nil
+       (cons (expand-marked-term (car x) w)
+             (expand-marked-list (cdr x) w)))))
+
+
+
+  (in-theory (disable expand-marked-term
+                      expand-marked-list))
+
+  (defthm len-of-expand-marked-list
+    (equal (len (expand-marked-list x w))
+           (len x))
+    :hints(("Goal" :in-theory (enable expand-marked-list))))
+
+  (defthm-expev-term/alist-flag
+    (defthm expand-marked-term-pseudo-termp
+      (implies (pseudo-termp x)
+               (pseudo-termp (expand-marked-term x w)))
+      :hints ('(:expand ((expand-marked-term x w))))
+      :flag term)
+    (defthm expand-marked-list-pseudo-term-listp
+      (implies (pseudo-term-listp x)
+               (pseudo-term-listp (expand-marked-list x w)))
+      :hints ('(:expand ((expand-marked-list x w)
+                         (expand-marked-list nil w))))
+      :flag list))
+
+  (local (defthm pseudo-termp-car-when-pseudo-term-listp
+           (implies (pseudo-term-listp x)
+                    (pseudo-termp (car x)))))
+
+  (verify-guards expand-marked-term)
+
+  (defthm-expev-term/alist-flag
+    (defthm expand-marked-term-correct
+      (implies (and (expev-meta-extract-global-facts)
+                    (equal w (w state))
+                    (pseudo-termp x))
+               (equal (expev (expand-marked-term x w) al)
+                      (expev x al)))
+      :hints ('(:expand ((expand-marked-term x w))
+                :in-theory (enable expev-of-fncall-args)))
+      :flag term)
+    (defthm expand-marked-list-correct
+      (implies (and (expev-meta-extract-global-facts)
+                    (equal w (w state))
+                    (pseudo-term-listp x))
+               (equal (expev-lst (expand-marked-list x w) al)
+                      (expev-lst x al)))
+      :hints ('(:expand ((expand-marked-list x w)
+                         (expand-marked-list nil w))))
+      :flag list)))
+
+
+(defsection remove-expand-mes
+
+  (mutual-recursion
+   (defun remove-expand-mes (x)
+     (declare (xargs :guard (and (pseudo-termp x))
+                     :verify-guards nil))
+     (b* (((when (variablep x)) x)
+          (fn (ffn-symb x))
+          ((when (eq fn 'quote)) x)
+          (args (remove-expand-mes-list (fargs x)))
+          ((when (flambdap fn))
+           `((lambda ,(lambda-formals fn)
+               ,(remove-expand-mes (lambda-body fn)))
+             . ,args))
+          ((when (and (eq fn 'expand-me) (equal (len args) 1)))
+           (car args))
+          ((when (and (eq fn 'expand-me-with) (equal (len args) 2)))
+           (cadr args)))
+       (cons fn args)))
 
-(defmacro just-expand (expand-lst)
-  `(let ((hints (just-expand-cp-parse-hints ',expand-lst (w state))))
+   (defun remove-expand-mes-list (x)
+     (declare (xargs :guard (and (pseudo-term-listp x))))
+     (if (atom x)
+         nil
+       (cons (remove-expand-mes (car x))
+             (remove-expand-mes-list (cdr x))))))
+
+
+
+  (in-theory (disable remove-expand-mes
+                      remove-expand-mes-list))
+
+  (defthm len-of-remove-expand-mes-list
+    (equal (len (remove-expand-mes-list x))
+           (len x))
+    :hints(("Goal" :in-theory (enable remove-expand-mes-list))))
+
+  (defthm-expev-term/alist-flag
+    (defthm remove-expand-mes-pseudo-termp
+      (implies (pseudo-termp x)
+               (pseudo-termp (remove-expand-mes x)))
+      :hints ('(:expand ((remove-expand-mes x))))
+      :flag term)
+    (defthm remove-expand-mes-list-pseudo-term-listp
+      (implies (pseudo-term-listp x)
+               (pseudo-term-listp (remove-expand-mes-list x)))
+      :hints ('(:expand ((remove-expand-mes-list x)
+                         (remove-expand-mes-list nil))))
+      :flag list))
+
+  (local (defthm pseudo-termp-car-when-pseudo-term-listp
+           (implies (pseudo-term-listp x)
+                    (pseudo-termp (car x)))))
+
+  (verify-guards remove-expand-mes)
+
+  (defthm-expev-term/alist-flag
+    (defthm remove-expand-mes-correct
+      (implies (pseudo-termp x)
+               (equal (expev (remove-expand-mes x) al)
+                      (expev x al)))
+      :hints ('(:expand ((remove-expand-mes x))
+                :in-theory (enable expev-of-fncall-args
+                                   expand-me expand-me-with)))
+      :flag term)
+    (defthm remove-expand-mes-list-correct
+      (implies (pseudo-term-listp x)
+               (equal (expev-lst (remove-expand-mes-list x) al)
+                      (expev-lst x al)))
+      :hints ('(:expand ((remove-expand-mes-list x)
+                         (remove-expand-mes-list nil))))
+      :flag list)))
+  
+
+
+
+
+;; This could be made much more sophisticated.  However, at the moment we just
+;; expand term with an EQUAL-based definition.
+
+;; (defun just-expand-cp-hint-get-rule (rule fn w)
+;;   (declare (xargs :mode :program))
+;;   (if (not rule)
+;;       (b* ((def (def-body fn w))
+;;            ((unless (and def (not (access def-body def :hyp))))
+;;             (er hard? 'just-expand-cp "couldn't find a hyp-free definition for ~x0"
+;;                 fn)
+;;             nil))
+;;         (list (cons fn (access def-body def :formals)) ;; lhs
+;;               (access def-body def :concl)
+;;               (access def-body def :rune)))
+;;     (b* ((lemmas (getprop fn 'lemmas nil 'current-acl2-world w))
+;;          (lemma (if (symbolp rule)
+;;                     (find-named-lemma
+;;                      (deref-macro-name rule (macro-aliases w))
+;;                      lemmas t)
+;;                   (find-runed-lemma rule lemmas)))
+;;          ((unless (and lemma
+;;                        (not (access rewrite-rule lemma :hyps))
+;;                        (eq (access rewrite-rule lemma :equiv) 'equal)))
+;;           (er hard? 'just-expand-cp "the definition has hyps or is not EQUAL-based")
+;;           nil))
+;;       (list (access rewrite-rule lemma :lhs)
+;;             (access rewrite-rule lemma :rhs)
+;;             (access rewrite-rule lemma :rune)))))
+
+(defsection just-expand-cp-parse-hints
+
+  (defun just-expand-cp-finish-hint (rule vars term w)
+    (declare (xargs :mode :program))
+    (b* (((when (atom term))
+          (er hard? 'just-expand-cp "atom in term position in hints: ~x0~%" term)) ;; error
+         ((mv erp trans-term)
+          (translate-cmp term t nil nil 'just-expand-cp w 
+                         (default-state-vars nil)))
+         ((when erp)
+          (er hard? 'just-expand-cp "translate failed: ~@0~%" trans-term))
+         ;; ((list lhs rhs rune) (just-expand-cp-hint-get-rule rule (car trans-term)
+         ;;                                                    w))
+         (trans-term-vars (simple-term-vars trans-term))
+         (nonfree-vars (set-difference-eq trans-term-vars vars))
+         ((when (not (or (symbolp rule)
+                         (symbol-listp rule)))) ;; rune
+          (er hard? 'just-expand-cp "invalid rule: ~x0~%" rule))
+         (rule (if (consp rule) (cadr rule) rule)))
+      (cons trans-term `(;; (lhs . ,lhs)
+                         ;; (rhs . ,rhs)
+                         (rule . ,rule)
+                         (subst . ,(pairlis$ nonfree-vars nonfree-vars))))))
+
+  (defun just-expand-cp-parse-hint (hint w)
+    (declare (xargs :mode :program))
+    (case-match hint
+      ((':with rule (':free vars term))
+       (just-expand-cp-finish-hint rule vars term w))
+      ((':free vars (':with rule term))
+       (just-expand-cp-finish-hint rule vars term w))
+      ((':free vars term)
+       (just-expand-cp-finish-hint nil vars term w))
+      ((':with rule term)
+       (just-expand-cp-finish-hint rule nil term w))
+      (& (just-expand-cp-finish-hint nil nil hint w))))
+  
+
+  (defun just-expand-cp-parse-hints (hints w)
+    (declare (Xargs :mode :program))
+    (if (atom hints)
+        nil
+      (cons (just-expand-cp-parse-hint (car hints) w)
+            (just-expand-cp-parse-hints (cdr hints) w)))))
+
+
+(defsection just-exp-hints-okp
+
+  (defund just-exp-hint-alist-okp (alist)
+    (declare (xargs :guard t))
+    (and (alistp alist)
+         (symbolp (cdr (assoc 'rule alist)))
+         (alistp (cdr (assoc 'subst alist)))))
+
+  (defund just-exp-hints-okp (hints)
+    (declare (xargs :guard t))
+    (or (atom hints)
+        (and (consp (car hints))
+             (pseudo-termp (caar hints))
+             (just-exp-hint-alist-okp (cdar hints))
+             (just-exp-hints-okp (cdr hints))))))
+
+
+(defsection mark-expansion
+
+  (local (in-theory (enable just-exp-hint-alist-okp)))
+
+  (defund mark-expansion (term pattern alist)
+    (declare (xargs :guard (and (pseudo-termp term)
+                                (pseudo-termp pattern)
+                                (just-exp-hint-alist-okp alist))))
+    (b* ((subst (cdr (assoc 'subst alist)))
+         ((mv pat-ok &) (simple-one-way-unify pattern term subst))
+         ((unless pat-ok) term)
+         (rule (cdr (assoc 'rule alist))))
+      (if rule
+          `(expand-me-with ',rule ,term)
+        `(expand-me ,term))))
+
+  (local (in-theory (enable mark-expansion expand-me expand-me-with)))
+
+  (defthm mark-expansion-correct
+    (implies (and (pseudo-termp term)
+                  (pseudo-termp pattern)
+                  (just-exp-hint-alist-okp alist))
+             (equal (expev (mark-expansion term pattern alist) a)
+                    (expev term a)))
+    :hints (("goal" :do-not-induct t)))
+
+  (defthm pseudo-termp-mark-expansion
+    (implies (pseudo-termp term)
+             (pseudo-termp (mark-expansion term pattern alist)))))
+
+
+(defsection mark-expansions
+  (local (in-theory (enable just-exp-hints-okp)))
+
+  (defund mark-expansions (term hints)
+    (declare (xargs :guard (and (pseudo-termp term)
+                                (just-exp-hints-okp hints))))
+    (if (atom hints)
+        term
+      (mark-expansions
+       (mark-expansion term (caar hints) (cdar hints))
+       (cdr hints))))
+
+  (local (in-theory (enable mark-expansions)))
+
+
+  (defthm mark-expansions-correct
+    (implies (and (just-exp-hints-okp hints)
+                  (pseudo-termp term))
+             (equal (expev (mark-expansions term hints) a)
+                    (expev term a))))
+
+  (defthm pseudo-termp-mark-expansions
+    (implies (pseudo-termp term)
+             (pseudo-termp (mark-expansions term hints)))))
+
+
+
+
+(defsection mark-expands-with-hints
+
+  (mutual-recursion
+   (defun mark-expands-with-hints (x hints lambdasp)
+     (declare (xargs :guard (and (pseudo-termp x)
+                                 (just-exp-hints-okp hints))
+                     :verify-guards nil))
+     (b* (((when (variablep x)) x)
+          (fn (ffn-symb x))
+          ((when (eq fn 'quote)) x)
+          (args (mark-expands-with-hints-list (fargs x) hints lambdasp))
+          ((when (and lambdasp (flambdap fn)))
+           `((lambda ,(lambda-formals fn)
+               ;; NOTE: this is a little odd because it doesn't consider the lambda
+               ;; substitution.  Sound, but arguably expands the wrong terms (for
+               ;; some value of "wrong").
+               ,(mark-expands-with-hints (lambda-body fn) hints lambdasp))
+             . ,args)))
+       (mark-expansions (cons fn args) hints)))
+
+   (defun mark-expands-with-hints-list (x hints lambdasp)
+     (declare (xargs :guard (and (pseudo-term-listp x)
+                                 (just-exp-hints-okp hints))))
+     (if (atom x)
+         nil
+       (cons (mark-expands-with-hints (car x) hints lambdasp)
+             (mark-expands-with-hints-list (cdr x) hints lambdasp)))))
+
+  (in-theory (disable mark-expands-with-hints
+                      mark-expands-with-hints-list))
+
+  (defthm len-of-mark-expands-with-hints-list
+    (equal (len (mark-expands-with-hints-list x hints lambdasp))
+           (len x))
+    :hints(("Goal" :in-theory (enable mark-expands-with-hints-list))))
+
+  (defthm-expev-term/alist-flag
+    (defthm mark-expands-with-hints-pseudo-termp
+      (implies (pseudo-termp x)
+               (pseudo-termp (mark-expands-with-hints x hints lambdasp)))
+      :hints ('(:expand ((mark-expands-with-hints x hints lambdasp))))
+      :flag term)
+    (defthm mark-expands-with-hints-list-pseudo-term-listp
+      (implies (pseudo-term-listp x)
+               (pseudo-term-listp (mark-expands-with-hints-list x hints lambdasp)))
+      :hints ('(:expand ((mark-expands-with-hints-list x hints lambdasp)
+                         (mark-expands-with-hints-list nil hints lambdasp))))
+      :flag list))
+
+  (verify-guards mark-expands-with-hints
+    :hints (("goal" :expand ((:free (a b) (pseudo-termp (cons a b)))))))
+
+  (defthm-expev-term/alist-flag
+    (defthm mark-expands-with-hints-correct
+      (implies (and (just-exp-hints-okp hints)
+                    (pseudo-termp x))
+               (equal (expev (mark-expands-with-hints x hints lambdasp) al)
+                      (expev x al)))
+      :hints ('(:expand ((mark-expands-with-hints x hints lambdasp))
+                :in-theory (enable expev-of-fncall-args)))
+      :flag term)
+    (defthm mark-expands-with-hints-list-correct
+      (implies (and (just-exp-hints-okp hints)
+                    (pseudo-term-listp x))
+               (equal (expev-lst (mark-expands-with-hints-list x hints lambdasp) al)
+                      (expev-lst x al)))
+      :hints ('(:expand ((mark-expands-with-hints-list x hints lambdasp)
+                         (mark-expands-with-hints-list nil hints lambdasp))))
+      :flag list)))
+
+
+
+(defsection apply-expansion
+
+  (local (in-theory (enable just-exp-hint-alist-okp)))
+
+  (defund apply-expansion (term pattern alist w)
+    (declare (xargs :guard (and (pseudo-termp term)
+                                (pseudo-termp pattern)
+                                (just-exp-hint-alist-okp alist)
+                                (plist-worldp w))))
+    (b* ((subst (cdr (assoc 'subst alist)))
+         ((mv pat-ok &) (simple-one-way-unify pattern term subst))
+         ((unless pat-ok) term)
+         (rule (cdr (assoc 'rule alist))))
+      (expand-this-term term rule w)))
+
+  (local (in-theory (enable apply-expansion)))
+
+  (defthm apply-expansion-correct
+    (implies (and (expev-meta-extract-global-facts)
+                  (equal w (w state))
+                  (pseudo-termp term)
+                  (pseudo-termp pattern)
+                  (just-exp-hint-alist-okp alist))
+             (equal (expev (apply-expansion term pattern alist w) a)
+                    (expev term a)))
+    :hints (("goal" :do-not-induct t)))
+
+  (defthm pseudo-termp-apply-expansion
+    (implies (pseudo-termp term)
+             (pseudo-termp (apply-expansion term pattern alist w)))))
+
+(defsection apply-expansions
+  (local (in-theory (enable just-exp-hints-okp)))
+
+  (defund apply-expansions (term hints w)
+    (declare (xargs :guard (and (pseudo-termp term)
+                                (just-exp-hints-okp hints)
+                                (plist-worldp w))))
+    (if (atom hints)
+        term
+      (apply-expansions
+       (apply-expansion term (caar hints) (cdar hints) w)
+       (cdr hints) w)))
+
+  (local (in-theory (enable apply-expansions)))
+
+
+  (defthm apply-expansions-correct
+    (implies (and (expev-meta-extract-global-facts)
+                  (equal w (w state))
+                  (just-exp-hints-okp hints)
+                  (pseudo-termp term))
+             (equal (expev (apply-expansions term hints w) a)
+                    (expev term a))))
+
+  (defthm pseudo-termp-apply-expansions
+    (implies (pseudo-termp term)
+             (pseudo-termp (apply-expansions term hints w)))))
+
+
+(defsection expand-with-hints
+
+  (mutual-recursion
+   (defun expand-with-hints (x hints lambdasp w)
+     (declare (xargs :guard (and (pseudo-termp x)
+                                 (plist-worldp w)
+                                 (just-exp-hints-okp hints))
+                     :verify-guards nil))
+     (b* (((when (variablep x)) x)
+          (fn (ffn-symb x))
+          ((when (eq fn 'quote)) x)
+          (args (expand-with-hints-list (fargs x) hints lambdasp w))
+          ((when (and lambdasp (flambdap fn)))
+           `((lambda ,(lambda-formals fn)
+               ;; NOTE: this is a little odd because it doesn't consider the lambda
+               ;; substitution.  Sound, but arguably expands the wrong terms (for
+               ;; some value of "wrong").
+               ,(expand-with-hints (lambda-body fn) hints lambdasp w))
+             . ,args)))
+       (apply-expansions (cons fn args) hints w)))
+
+   (defun expand-with-hints-list (x hints lambdasp w)
+     (declare (xargs :guard (and (pseudo-term-listp x)
+                                 (just-exp-hints-okp hints)
+                                 (plist-worldp w))))
+     (if (atom x)
+         nil
+       (cons (expand-with-hints (car x) hints lambdasp w)
+             (expand-with-hints-list (cdr x) hints lambdasp w)))))
+
+  (in-theory (disable expand-with-hints
+                      expand-with-hints-list))
+
+  (defthm len-of-expand-with-hints-list
+    (equal (len (expand-with-hints-list x hints lambdasp w))
+           (len x))
+    :hints(("Goal" :in-theory (enable expand-with-hints-list))))
+
+  (defthm-expev-term/alist-flag
+    (defthm expand-with-hints-pseudo-termp
+      (implies (pseudo-termp x)
+               (pseudo-termp (expand-with-hints x hints lambdasp w)))
+      :hints ('(:expand ((expand-with-hints x hints lambdasp w))))
+      :flag term)
+    (defthm expand-with-hints-list-pseudo-term-listp
+      (implies (pseudo-term-listp x)
+               (pseudo-term-listp (expand-with-hints-list x hints lambdasp w)))
+      :hints ('(:expand ((expand-with-hints-list x hints lambdasp w)
+                         (expand-with-hints-list nil hints lambdasp w))))
+      :flag list))
+
+  (verify-guards expand-with-hints
+    :hints (("goal" :expand ((:free (a b) (pseudo-termp (cons a b)))))))
+
+  (defthm-expev-term/alist-flag
+    (defthm expand-with-hints-correct
+      (implies (and (expev-meta-extract-global-facts)
+                    (equal w (w state))
+                    (just-exp-hints-okp hints)
+                    (pseudo-termp x))
+               (equal (expev (expand-with-hints x hints lambdasp w) al)
+                      (expev x al)))
+      :hints ('(:expand ((expand-with-hints x hints lambdasp w))
+                :in-theory (enable expev-of-fncall-args)))
+      :flag term)
+    (defthm expand-with-hints-list-correct
+      (implies (and (expev-meta-extract-global-facts)
+                    (equal w (w state))
+                    (just-exp-hints-okp hints)
+                    (pseudo-term-listp x))
+               (equal (expev-lst (expand-with-hints-list x hints lambdasp w) al)
+                      (expev-lst x al)))
+      :hints ('(:expand ((expand-with-hints-list x hints lambdasp w)
+                         (expand-with-hints-list nil hints lambdasp w))))
+      :flag list)))
+
+
+
+
+
+
+;; (mutual-recursion
+;;  (defun term-apply-expansions (x hints lambdasp)
+;;    (declare (xargs :guard (and (pseudo-termp x)
+;;                                (just-exp-hints-okp hints))
+;;                    :verify-guards nil))
+;;    (if (or (variablep x)
+;;            (fquotep x))
+;;        x
+;;      (let ((args (termlist-apply-expansions (fargs x) hints lambdasp))
+;;            (fn (ffn-symb x)))
+;;        (if (and lambdasp (flambdap fn))
+;;            ;; NOTE: this is a little odd because it doesn't consider the lambda
+;;            ;; substitution.  Sound, but arguably expands the wrong terms (for
+;;            ;; some value of "wrong").
+;;            (let* ((body (term-apply-expansions (lambda-body fn) hints lambdasp)))
+;;              (cons (make-lambda (lambda-formals fn) body)
+;;                    args))
+;;          (apply-expansions (cons fn args) hints)))))
+;;  (defun termlist-apply-expansions (x hints lambdasp)
+;;    (declare (xargs :guard (and (pseudo-term-listp x)
+;;                                (just-exp-hints-okp hints))))
+;;    (if (atom x)
+;;        nil
+;;      (cons (term-apply-expansions (car x) hints lambdasp)
+;;            (termlist-apply-expansions (cdr x) hints lambdasp)))))
+
+;; (make-flag term-apply-expansions-flg term-apply-expansions
+;;            :flag-mapping ((term-apply-expansions . term)
+;;                           (termlist-apply-expansions . list)))
+
+;; (defthm len-of-termlist-apply-expansions
+;;   (equal (len (termlist-apply-expansions x hints lambdasp))
+;;          (len x))
+;;   :hints (("goal" :induct (len x)
+;;            :expand (termlist-apply-expansions x hints lambdasp))))
+
+;; (defthm-term-apply-expansions-flg
+;;   (defthm pseudo-termp-term-apply-expansions
+;;     (implies (and (pseudo-termp x)
+;;                   (just-exp-hints-okp hints))
+;;              (pseudo-termp (term-apply-expansions x hints lambdasp)))
+;;     :hints ((and stable-under-simplificationp
+;;                  '(:expand ((:free (a b) (pseudo-termp (cons a b)))))))
+;;     :flag term)
+;;   (defthm pseudo-term-listp-termlist-apply-expansions
+;;     (implies (and (pseudo-term-listp x)
+;;                   (just-exp-hints-okp hints))
+;;              (pseudo-term-listp (termlist-apply-expansions x hints lambdasp)))
+;;     :flag list))
+
+;; (mutual-recursion
+;;  (defun term-apply-expansions-correct-ind (x hints a lambdasp)
+;;    (if (or (variablep x)
+;;            (fquotep x))
+;;        (list x a)
+;;      (let ((args (termlist-apply-expansions (fargs x) hints lambdasp))
+;;            (ign (termlist-apply-expansions-correct-ind
+;;                  (fargs x) hints a lambdasp))
+;;            (fn (ffn-symb x)))
+;;        (declare (ignore ign))
+;;        (if (and lambdasp (flambdap fn))
+;;            (term-apply-expansions-correct-ind
+;;             (lambda-body fn) hints
+;;             (pairlis$ (lambda-formals fn)
+;;                       (expev-lst args a)) lambdasp)
+;;          (apply-expansions (cons fn args) hints)))))
+;;  (defun termlist-apply-expansions-correct-ind (x hints a lambdasp)
+;;    (if (atom x)
+;;        nil
+;;      (cons (term-apply-expansions-correct-ind (car x) hints a lambdasp)
+;;            (termlist-apply-expansions-correct-ind (cdr x) hints a lambdasp)))))
+
+;; (make-flag term-apply-expansions-correct-flg term-apply-expansions-correct-ind
+;;            :flag-mapping ((term-apply-expansions-correct-ind . term)
+;;                           (termlist-apply-expansions-correct-ind . list)))
+
+
+
+;; (defthm-term-apply-expansions-correct-flg
+;;   (defthm term-apply-expansions-correct
+;;     (implies (and (pseudo-termp x)
+;;                   (just-exp-hints-okp hints)
+;;                   (expev-theoremp (conjoin-clauses (hint-alists-to-clauses hints))))
+;;              (equal (expev (term-apply-expansions x hints lambdasp) a)
+;;                     (expev x a)))
+;;     :hints ((and stable-under-simplificationp
+;;                  '(:in-theory (enable expev-constraint-0)
+;;                    :expand ((:free (a b) (pseudo-termp (cons a b)))))))
+;;     :flag term)
+;;   (defthm termlist-apply-expansions-correct
+;;     (implies (and (pseudo-term-listp x)
+;;                   (just-exp-hints-okp hints)
+;;                   (expev-theoremp (conjoin-clauses (hint-alists-to-clauses hints))))
+;;              (equal (expev-lst (termlist-apply-expansions x hints lambdasp) a)
+;;                     (expev-lst x a)))
+;;     :flag list))
+
+;; (verify-guards term-apply-expansions
+;;   :hints ((and stable-under-simplificationp
+;;                '(:expand ((:free (a b) (pseudo-termp (cons a b))))))))
+
+;; (in-theory (disable term-apply-expansions))
+
+(local
+ (defsection butlast/last/append
+
+   (defthm expev-of-disjoin
+     (iff (expev (disjoin x) a)
+          (or-list (expev-lst x a)))
+     :hints(("Goal" :in-theory (enable or-list len)
+             :induct (len x))))
+
+   (defthm expev-lst-of-append
+     (equal (expev-lst (append x y) a)
+            (append (expev-lst x a)
+                    (expev-lst y a))))
+
+   (defthm len-of-expev-lst
+     (equal (len (expev-lst x a))
+            (len x)))
+
+   (defthm expev-lst-of-butlast
+     (equal (expev-lst (butlast clause n) a)
+            (butlast (expev-lst clause a) n))
+     :hints (("goal" :induct (butlast clause n))
+             '(:cases ((consp clause)))))
+
+   (defthm expev-lst-of-last
+     (equal (expev-lst (last x) a)
+            (last (expev-lst x a)))
+     :hints (("goal" :induct (last x)
+              :expand ((last x)
+                       (:free (b)
+                        (last (cons (expev (car x) a) b))))
+              :in-theory (disable (:d last)))
+             '(:cases ((consp x)))))
+
+   (defthm append-butlast-last
+     (equal (append (butlast x 1) (last x))
+            x))
+
+   (defthm pseudo-term-listp-of-last
+     (implies (pseudo-term-listp x)
+              (pseudo-term-listp (last x))))
+
+   (defthm pseudo-term-listp-of-butlast
+     (implies (pseudo-term-listp x)
+              (pseudo-term-listp (butlast x n))))
+
+   (defthm not-or-list-of-butlast-if-not-or-list
+     (implies (not (or-list x))
+              (not (or-list (butlast x n)))))
+
+   (defthm pseudo-term-listp-append
+     (implies (and (pseudo-term-listp x)
+                   (pseudo-term-listp y))
+              (pseudo-term-listp (append x y))))))
+
+(defsection just-expand-cp
+
+  (local (defthm true-listp-butlast
+           (true-listp (butlast lst n))))
+
+
+  (defund just-expand-cp (clause hints state)
+    (declare (xargs :guard (pseudo-term-listp clause)
+                    :stobjs state))
+    (b* (((unless (and (true-listp hints)
+                       (just-exp-hints-okp (caddr hints))))
+          (mv "bad hints" nil))
+         ((list last-only lambdasp hints) hints)
+         (clause
+          (if last-only
+              (append (butlast clause 1)
+                      (expand-with-hints-list
+                       (last clause) hints lambdasp (w state)))
+            (expand-with-hints-list
+             clause hints lambdasp (w state)))))
+      (mv nil (list clause))))
+
+  (local (in-theory (enable just-expand-cp)))
+  (local (in-theory (disable butlast-redefinition or-list last)))
+
+  (defthm just-expand-cp-correct
+    (implies (and (expev-meta-extract-global-facts)
+                  (pseudo-term-listp clause)
+                  (alistp a)
+                  (expev-theoremp
+                   (conjoin-clauses
+                    (clauses-result (just-expand-cp clause hints state)))))
+             (expev (disjoin clause) a))
+    :hints (("goal" :do-not-induct t
+             :use ((:instance expev-falsify
+                    (x (disjoin (car (mv-nth 1 (just-expand-cp clause hints state)))))))))
+    :rule-classes :clause-processor))
+
+
+(defsection expand-marked-cp
+
+  (local (defthm true-listp-butlast
+           (true-listp (butlast lst n))))
+
+
+  (defund expand-marked-cp (clause hints state)
+    (declare (xargs :guard (pseudo-term-listp clause)
+                    :stobjs state))
+    (b* (((unless (true-listp hints))
+          (mv "bad hints" nil))
+         ((list last-only) hints)
+         (clause
+          (if last-only
+              (append (remove-expand-mes-list (butlast clause 1))
+                      (expand-marked-list (last clause) (w state)))
+            (expand-marked-list clause (w state)))))
+
+      (mv nil (list clause))))
+
+  (local (in-theory (enable expand-marked-cp)))
+  (local (in-theory (disable butlast-redefinition or-list last)))
+
+  (defthm expand-marked-cp-correct
+    (implies (and (expev-meta-extract-global-facts)
+                  (pseudo-term-listp clause)
+                  (alistp a)
+                  (expev-theoremp
+                   (conjoin-clauses
+                    (clauses-result (expand-marked-cp clause hints state)))))
+             (expev (disjoin clause) a))
+    :hints (("goal" :do-not-induct t
+             :use ((:instance expev-falsify
+                    (x (disjoin (car (mv-nth 1 (expand-marked-cp clause hints state)))))))))
+    :rule-classes :clause-processor))
+
+(defsection remove-expand-marks-cp
+
+  (local (defthm true-listp-butlast
+           (true-listp (butlast lst n))))
+
+
+  (defund remove-expand-marks-cp (clause hints)
+    (declare (xargs :guard (pseudo-term-listp clause)))
+    (b* (((unless (true-listp hints))
+          (mv "bad hints" nil))
+         ((list butlast-only) hints)
+         (clause
+          (if butlast-only
+              (append (remove-expand-mes-list (butlast clause 1))
+                      (last clause))
+            (remove-expand-mes-list clause))))
+
+      (mv nil (list clause))))
+
+  (local (in-theory (enable remove-expand-marks-cp)))
+  (local (in-theory (disable butlast-redefinition or-list last)))
+
+  (defthm remove-expand-marks-cp-correct
+    (implies (and (expev-meta-extract-global-facts)
+                  (pseudo-term-listp clause)
+                  (alistp a)
+                  (expev-theoremp
+                   (conjoin-clauses
+                    (clauses-result (remove-expand-marks-cp clause hints)))))
+             (expev (disjoin clause) a))
+    :hints (("goal" :do-not-induct t
+             :use ((:instance expev-falsify
+                    (x (disjoin (car (mv-nth 1 (remove-expand-marks-cp clause hints)))))))))
+    :rule-classes :clause-processor))
+
+(defsection mark-expands-cp
+
+  (defund mark-expands-cp (clause hints)
+    (declare (xargs :guard (pseudo-term-listp clause)))
+    (b* (((unless (and (true-listp hints)
+                       (just-exp-hints-okp (caddr hints))))
+          (mv "bad hints" nil))
+         ((list last-only lambdasp hints) hints)
+         ; ((when (atom clause)) (mv nil (list nil)))
+         (new-clause
+          (if last-only
+              (append (butlast clause 1)
+                      (mark-expands-with-hints-list
+                       (last clause) hints lambdasp))
+            (mark-expands-with-hints-list
+             clause hints lambdasp))))
+      (mv nil (list new-clause))))
+
+  (local (in-theory (enable mark-expands-cp)))
+  (local (in-theory (disable butlast-redefinition or-list last)))
+
+  (defthm mark-expands-cp-correct
+    (implies (and (pseudo-term-listp clause)
+                  (alistp a)
+                  (expev-theoremp
+                   (conjoin-clauses
+                    (clauses-result (mark-expands-cp clause hints)))))
+             (expev (disjoin clause) a))
+    :hints (("goal" :do-not-induct t
+             :use ((:instance expev-falsify
+                    (x (disjoin (car (mv-nth 1 (mark-expands-cp clause hints)))))))))
+    :rule-classes :clause-processor))
+
+(defmacro just-expand (expand-lst &key lambdasp mark-only last-only)
+  `(let* ((hints (just-expand-cp-parse-hints ',expand-lst (w state)))
+          (cproc ,(if mark-only
+                      ``(mark-expands-cp clause '(,',last-only ,',lambdasp ,hints))
+                    ``(just-expand-cp clause '(,',last-only ,',lambdasp ,hints) state))))
      `(:computed-hint-replacement
        ((use-by-computed-hint clause))
-       :clause-processor (just-expand-cp clause ',hints))))
+       :clause-processor
+       ,cproc)))
+
+(defmacro expand-marked (&key last-only)
+  ``(:computed-hint-replacement
+     ((use-by-computed-hint clause))
+     :clause-processor
+     (expand-marked-cp clause (list ,',last-only) state)))
+
+(defmacro remove-expand-marks (&key butlast-only)
+  ``(:computed-hint-replacement
+     ((use-by-computed-hint clause))
+     :clause-processor
+     (remove-expand-marks-cp clause (list ,',butlast-only))))
+
 
 (local
- (defthm foo (implies (consp x)
-                      (equal (len x) (+ 1 (len (cdr x)))))
-   :hints (("goal" :do-not '(simplify preprocess eliminate-destructors))
-           (just-expand ((len x)))
-           '(:do-not nil))))
-
-(defmacro just-induct-and-expand (term &key expand-others)
-  `'(:computed-hint-replacement
-     ((and (equal (car id) '(0))
-           '(:induct ,term))
-      (and (equal (car id) '(0 1))
-           (just-expand (,term . ,expand-others)))
-      '(:do-not nil))
-     :do-not '(preprocess simplify)))
+ (encapsulate nil
+   (value-triple 1)
+   (local (defthm foo (implies (consp x)
+                               (equal (len x) (+ 1 (len (cdr x)))))
+            :hints (("goal" :do-not '(simplify preprocess eliminate-destructors)
+                     :in-theory (disable len))
+                    (let ((res (just-expand ((len x)))))
+                      (progn$ (cw "hint: ~x0~%" res)
+                              res))
+                    '(:do-not nil))
+            :rule-classes nil))))
 
+(local
+ (encapsulate nil
+   (value-triple 2)
+   (local (defthm foo (implies (consp x)
+                               (equal (len x) (+ 1 (len (cdr x)))))
+            :hints (("goal" :do-not '(simplify preprocess eliminate-destructors)
+                     :in-theory (disable len))
+                    (let ((res (just-expand ((len x)) :mark-only t)))
+                      (progn$ (cw "hint: ~x0~%" res)
+                              res))
+                    '(:do-not nil)
+                    (and stable-under-simplificationp
+                         '(:in-theory (e/d (expand-marked-meta) (len)))))
+            :rule-classes nil))))
+
+;; must use :lambdasp t or this won't work
+(local
+ (encapsulate nil
+   (value-triple 3)
+   (local (defthm foo (implies (consp x)
+                               (let ((x (list x x)))
+                                 (equal (len x) (+ 1 (len (cdr x))))))
+            :hints (("goal" :do-not '(simplify preprocess eliminate-destructors)
+                     :in-theory (disable len))
+                    (just-expand ((len x)) :lambdasp t)
+                    '(:do-not nil))))))
+
+(local
+ (encapsulate nil
+   (value-triple 4)
+   (local (defthm foo (implies (consp x)
+                               (equal (len x) (+ 1 (len (cdr x)))))
+            :hints (("goal" :do-not '(simplify preprocess eliminate-destructors)
+                     :in-theory (disable len))
+                    (let ((res (just-expand ((len x)) :mark-only t)))
+                      (progn$ (cw "hint: ~x0~%" res)
+                              res))
+                    '(:do-not nil)
+                    (and stable-under-simplificationp
+                         (expand-marked)))
+            :rule-classes nil))))
+
+(defsection clause-to-term
+
+  (verify-termination dumb-negate-lit)
+
+  ;; BOZO this is here because dumb-negate-lit-lst (built in) needs a
+  ;; pseudo-term-listp guard and doesn't have one
+  (defun dumb-negate-lit-list (lst)
+    (declare (xargs :guard (pseudo-term-listp lst)))
+    (cond ((endp lst) nil)
+          (t (cons (dumb-negate-lit (car lst))
+                   (dumb-negate-lit-list (cdr lst))))))
+
+  (local (defthm dumb-negate-lit-correct
+           (implies (pseudo-termp x)
+                    (iff (expev (dumb-negate-lit x) a)
+                         (not (expev x a))))))
+
+  (local (in-theory (disable dumb-negate-lit)))
+
+  (local (defthm dumb-negate-lit-list-conjoin-correct
+           (implies (pseudo-term-listp x)
+                    (iff (expev (conjoin (dumb-negate-lit-list x)) a)
+                         (not (expev (disjoin x) a))))))
+
+  (local (in-theory (disable dumb-negate-lit-list)))
+
+  (defund clause-to-term (clause)
+    (declare (xargs :guard (pseudo-term-listp clause)))
+    (list (list `(implies ,(conjoin (dumb-negate-lit-list
+                                     (butlast clause 1)))
+                          ,(car (last clause))))))
+
+
+  (local (in-theory (enable clause-to-term)))
+
+  (local (defthm expev-car-last
+           (implies (expev (car (last clause)) a)
+                    (or-list (expev-lst clause a)))
+           :hints (("goal" :induct (len clause)
+                    :in-theory (disable last)
+                    :expand ((last clause))))))
+
+  (defthm clause-to-term-correct
+    (implies (and (pseudo-term-listp clause)
+                  (alistp a)
+                  (expev (conjoin-clauses (clause-to-term clause)) a))
+             (expev (disjoin clause) a))
+    :rule-classes :clause-processor))
+
+
+
+;; (defmacro just-induct-and-expand (term &key expand-others lambdasp mark-only)
+;;   `'(:computed-hint-replacement
+;;      ((and (equal (car id) '(0))
+;;            '(:induct ,term))
+;;       (and (equal (car id) '(0 1))
+;;            (just-expand (,term . ,expand-others) :lambdasp ,lambdasp
+;;                         :last-only t
+;;                         :mark-only ,mark-only))
+;;       '(:do-not nil))
+;;      :clause-processor clause-to-term
+;;      :do-not '(preprocess simplify)))
+
+
+(defmacro just-induct-and-expand (term &key expand-others lambdasp)
+  `(if (equal (car id) '(0))
+       (b* ((hints (just-expand-cp-parse-hints (cons ',term ',expand-others) (w state)))
+            (cproc `(mark-expands-cp clause '(nil ,',lambdasp ,hints))))
+         `(:computed-hint-replacement
+           ((and (equal (car id) '(0)) '(:clause-processor clause-to-term))
+            (and (equal (car id) '(0)) '(:induct ,',term)))
+           :clause-processor ,cproc))
+     (and (equal (car id) '(0 1))
+          (expand-marked :last-only t))))
 
 (local
  (progn
@@ -349,9 +1166,26 @@
    ;;            :induct (ind x y z)
    ;;            :expand ((ind x y z)))))
 
-   (defthm true-listp-ind
-     (implies (true-listp z)
-              (true-listp (ind x y z)))
-     :hints (("goal" :in-theory (disable (:definition ind))
-              :do-not-induct t)
-             (just-induct-and-expand (ind x y z))))))
+   (encapsulate nil
+     (value-triple 'just-induct-test)
+     (local (in-theory (disable (:definition ind))))
+     (local
+      (defthm true-listp-ind
+        (implies (true-listp z)
+                 (true-listp (ind x y z)))
+        :hints (;; ("goal" :in-theory (disable (:definition ind))
+                ;;  :do-not-induct t)
+                (just-induct-and-expand (ind x y z))))))
+   (encapsulate nil
+     (value-triple 'just-induct-mark-only-test)
+     (local
+      (defthm true-listp-ind
+        (implies (true-listp z)
+                 (true-listp (ind x y z)))
+        :hints (;; ("goal" :in-theory (disable (:definition ind))
+                ;;  :do-not-induct t)
+                (just-induct-and-expand (ind x y z))
+                ;; (and stable-under-simplificationp
+                ;;      '(:in-theory (e/d (expand-marked-meta)
+                ;;                        (ind))))
+                ))))))
diff -Nru acl2-6.2/books/clause-processors/meta-cheat-ttag.acl2 acl2-6.3/books/clause-processors/meta-cheat-ttag.acl2
--- acl2-6.2/books/clause-processors/meta-cheat-ttag.acl2	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/clause-processors/meta-cheat-ttag.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-(in-package "ACL2")
-; cert-flags: ? t :ttags :all
-(certify-book "meta-cheat-ttag" ? t :ttags :all)
diff -Nru acl2-6.2/books/clause-processors/meta-cheat-user.acl2 acl2-6.3/books/clause-processors/meta-cheat-user.acl2
--- acl2-6.2/books/clause-processors/meta-cheat-user.acl2	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/clause-processors/meta-cheat-user.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-(in-package "ACL2")
-; cert-flags: ? t :ttags :all
-(certify-book "meta-cheat-user" ? t :ttags :all)
diff -Nru acl2-6.2/books/clause-processors/meta-extract-user.lisp acl2-6.3/books/clause-processors/meta-extract-user.lisp
--- acl2-6.2/books/clause-processors/meta-extract-user.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/clause-processors/meta-extract-user.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -227,7 +227,7 @@
 
 (defthm mextract-lemma-term
   (implies (and (mextract-ev-global-facts)
-                (member rule (getprop fn 'lemmas nil 'current-acl2-world (w st)))
+                (member rule (fgetprop fn 'lemmas nil (w st)))
                 (equal (w st) (w state)))
            (mextract-ev (rewrite-rule-term rule)
                       a))
@@ -244,7 +244,7 @@
 ;; symbol in the world is a correct rewrite rule.
 (defthm mextract-lemma
   (implies (and (mextract-ev-global-facts)
-                (member rule (getprop fn 'lemmas nil 'current-acl2-world (w st)))
+                (member rule (fgetprop fn 'lemmas nil (w st)))
                 (not (eq (access rewrite-rule rule :subclass) 'meta))
                 (mextract-ev (conjoin (access rewrite-rule rule :hyps)) a)
                 (equal (w st) (w state)))
@@ -579,8 +579,7 @@
                     '(evfn (CONS (CAR X)
                                  (KWOTE-LST (evlst-fn (CDR X) A)))
                            'NIL)
-                    (getprop 'evfn 'lemmas nil 'current-acl2-world (w
-                                                                    state)))))
+                    (getprop 'evfn 'lemmas nil 'current-acl2-world (w state)))))
          (prog2$
           (or rule
               (er hard? 'def-meta-extract
@@ -1063,6 +1062,11 @@
 
 
 
+(defthm plist-worldp-w-state
+  (implies (state-p1 state)
+           (plist-worldp (w state)))
+  :hints(("Goal" :in-theory (enable w))))
+
 ;; Allows use of meta-extract-formula with just the world.  You still need
 ;; state in the theorems (and to know that wrld = (w state)).
 (defund meta-extract-formula-w (name wrld)
diff -Nru acl2-6.2/books/clause-processors/replace-equalities.lisp acl2-6.3/books/clause-processors/replace-equalities.lisp
--- acl2-6.2/books/clause-processors/replace-equalities.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/clause-processors/replace-equalities.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -25,9 +25,13 @@
 (include-book "meta-extract-user")
 (include-book "unify-subst")
 
-; Added by Matt K.: at a minimum, we need that dumb-negate-lit is in :logic
-; mode (as required by the present book) when using an ACL2 image built with
-; ACL2_DEVEL=d.
+; (Matt K.) I've added the following verify-termination form so that
+; dumb-negate-lit is in :logic mode (as required by the present book) when
+; using an ACL2 image built with ACL2_DEVEL=d.  But Sol Swords asked if this is
+; actually necessary, and indeed it seems not to be: All that is required is to
+; be able to certify books under with ACL2_DEVEL=d that are keys of ACL2
+; constant *system-verify-guards-alist*.  However, at this point it seems
+; simplest to leave this form in place.
 (verify-termination dumb-negate-lit) ; and guards
 
 (local (in-theory (disable w)))
diff -Nru acl2-6.2/books/clause-processors/stobj-preservation.lisp acl2-6.3/books/clause-processors/stobj-preservation.lisp
--- acl2-6.2/books/clause-processors/stobj-preservation.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/clause-processors/stobj-preservation.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -7,6 +7,7 @@
 
 
 (defxdoc preservation-thms
+  :parents (stobj)
   :short "Automation for proving that stobj-modifying functions preserve
 certain properties"
   :long "
diff -Nru acl2-6.2/books/coi/bags/eric-meta.lisp acl2-6.3/books/coi/bags/eric-meta.lisp
--- acl2-6.2/books/coi/bags/eric-meta.lisp	2013-06-06 17:12:00.000000000 +0000
+++ acl2-6.3/books/coi/bags/eric-meta.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -207,7 +207,7 @@
 ;;
 
 ;needed for the guards to the ts- functions (perhaps prove the needed lemmas in a separate book?) (e.g., loganding the cadar of a type-alistp does such and such)
-(local (include-book "rtl/rel4/support/logand" :dir :system)) 
+(local (include-book "rtl/rel8/support/support/logand" :dir :system)) 
 
 ;Checks that TS represents a non-nil type.
 ;was a macro...
diff -Nru acl2-6.2/books/coi/gacc/ram.lisp acl2-6.3/books/coi/gacc/ram.lisp
--- acl2-6.2/books/coi/gacc/ram.lisp	2013-06-06 17:11:59.000000000 +0000
+++ acl2-6.3/books/coi/gacc/ram.lisp	2013-09-30 17:53:28.000000000 +0000
@@ -10,7 +10,7 @@
 
 (include-book "../bags/two-level-meta") ;we need this, because of mentions of "flat below"; move that stuff to a different book?
 
-(local (include-book "rtl/rel4/arithmetic/fl" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/fl" :dir :system))
 
 ;(local (include-book "../super-ihs/loglist")) ;bzo
 (local (include-book "../super-ihs/super-ihs")) ;bzo
diff -Nru acl2-6.2/books/coi/gacc/ram2.lisp acl2-6.3/books/coi/gacc/ram2.lisp
--- acl2-6.2/books/coi/gacc/ram2.lisp	2013-06-06 17:11:59.000000000 +0000
+++ acl2-6.3/books/coi/gacc/ram2.lisp	2013-09-30 17:53:28.000000000 +0000
@@ -8,7 +8,7 @@
 (include-book "list-ops-fast")
 (include-book "addr-range") ;bzo drop?
 (include-book "wrap")
-(local (include-book "rtl/rel4/arithmetic/fl" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/fl" :dir :system))
 
 ;(local (include-book "../super-ihs/loglist")) ;bzo
 (local (include-book "../super-ihs/super-ihs")) ;bzo
diff -Nru acl2-6.2/books/coi/gacc/ram2b.lisp acl2-6.3/books/coi/gacc/ram2b.lisp
--- acl2-6.2/books/coi/gacc/ram2b.lisp	2013-06-06 17:11:59.000000000 +0000
+++ acl2-6.3/books/coi/gacc/ram2b.lisp	2013-09-30 17:53:28.000000000 +0000
@@ -12,7 +12,7 @@
 
 (include-book "ram3") ;bzo move common stuff into a third book
 
-(local (include-book "rtl/rel4/arithmetic/fl" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/fl" :dir :system))
 
 ;(local (include-book "../super-ihs/loglist")) ;bzo
 (local (include-book "../super-ihs/super-ihs")) ;bzo
diff -Nru acl2-6.2/books/coi/gacc/ram3.lisp acl2-6.3/books/coi/gacc/ram3.lisp
--- acl2-6.2/books/coi/gacc/ram3.lisp	2013-06-06 17:11:59.000000000 +0000
+++ acl2-6.3/books/coi/gacc/ram3.lisp	2013-09-30 17:53:28.000000000 +0000
@@ -34,7 +34,7 @@
 ;;(include-book "list-ops")
 (include-book "wrap")
 
-(local (include-book "rtl/rel4/arithmetic/fl" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/fl" :dir :system))
 
 ;(local (include-book "../super-ihs/loglist")) ;bzo
 (local (include-book "../super-ihs/super-ihs")) ;bzo
diff -Nru acl2-6.2/books/coi/records/mem-domain.lisp acl2-6.3/books/coi/records/mem-domain.lisp
--- acl2-6.2/books/coi/records/mem-domain.lisp	2013-06-06 17:12:00.000000000 +0000
+++ acl2-6.3/books/coi/records/mem-domain.lisp	2013-09-30 17:53:28.000000000 +0000
@@ -191,7 +191,7 @@
 
 (encapsulate
  ()
- (local (include-book "rtl/rel5/arithmetic/top" :dir :system))
+ (local (include-book "rtl/rel8/arithmetic/top" :dir :system))
 
  (defthm _ADDRESS-P-of-floor
    (implies (MEM::|_ADDRESS-P| ADDR DEPTH)
@@ -605,7 +605,7 @@
 
 (encapsulate
  ()
- (local (include-book "rtl/rel5/arithmetic/top" :dir :system))
+ (local (include-book "rtl/rel8/arithmetic/top" :dir :system))
 
  (defthm test
   (implies (and (force (bit-listp rbl))
diff -Nru acl2-6.2/books/coi/records/records.lisp acl2-6.3/books/coi/records/records.lisp
--- acl2-6.2/books/coi/records/records.lisp	2013-06-06 17:12:00.000000000 +0000
+++ acl2-6.3/books/coi/records/records.lisp	2013-09-30 17:53:28.000000000 +0000
@@ -5,7 +5,7 @@
 #|===========================================================================|#
 (in-package "ACL2")
 
-;;This book is sort of a wrapper around misc/records.  It includes that booka
+;;This book is sort of a wrapper around misc/records.  It includes that book
 ;;and then defines and proves some more stuff about records.
 
 (local (include-book "../lists/basic")) ;trying with this local..
diff -Nru acl2-6.2/books/coi/super-ihs/arithmetic.lisp acl2-6.3/books/coi/super-ihs/arithmetic.lisp
--- acl2-6.2/books/coi/super-ihs/arithmetic.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/coi/super-ihs/arithmetic.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -160,8 +160,8 @@
 
 (encapsulate
  ()
- (local (include-book "rtl/rel4/arithmetic/floor" :dir :system))
- (local (include-book "rtl/rel4/arithmetic/fl" :dir :system))
+ (local (include-book "rtl/rel8/arithmetic/floor" :dir :system))
+ (local (include-book "rtl/rel8/arithmetic/fl" :dir :system))
 
     ;add to rtl?
     ;bzo loops
@@ -202,7 +202,7 @@
   (equal (+ (- x) (* 2 x) y)
          (+ x y)))
 
-(local (include-book "rtl/rel4/arithmetic/denominator" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/denominator" :dir :system))
 
 (defthm denominator-of-unary-/
  (implies (and (integerp x) ;generalize?
diff -Nru acl2-6.2/books/coi/super-ihs/eric.lisp acl2-6.3/books/coi/super-ihs/eric.lisp
--- acl2-6.2/books/coi/super-ihs/eric.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/coi/super-ihs/eric.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -22,9 +22,9 @@
            (ACL2::INTEGER-RANGE-P lower- upper x))
   :hints (("Goal" :in-theory (enable ACL2::INTEGER-RANGE-P))))
 
-(local (include-book "rtl/rel4/arithmetic/expo" :dir :system))
-(local (include-book "rtl/rel4/arithmetic/expt" :dir :system))
-(local (include-book "rtl/rel4/arithmetic/top" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/expo" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/expt" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/top" :dir :system))
 
 (local (in-theory (enable expt-split)))
 
diff -Nru acl2-6.2/books/coi/super-ihs/evenp.lisp acl2-6.3/books/coi/super-ihs/evenp.lisp
--- acl2-6.2/books/coi/super-ihs/evenp.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/coi/super-ihs/evenp.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -7,8 +7,8 @@
 
 ;We include arithmetic facts only locally to keep this book from enforcing an choice of arithmetic theories on its user.
 (local (include-book "arithmetic"))
-(local (include-book "rtl/rel4/arithmetic/even-odd" :dir :system)) ;bzo combine this included book with the present book?
-(local (include-book "rtl/rel4/arithmetic/integerp" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/even-odd" :dir :system)) ;bzo combine this included book with the present book?
+(local (include-book "rtl/rel8/arithmetic/integerp" :dir :system))
 
 (in-theory (disable evenp))
 
diff -Nru acl2-6.2/books/coi/super-ihs/from-rtl.lisp acl2-6.3/books/coi/super-ihs/from-rtl.lisp
--- acl2-6.2/books/coi/super-ihs/from-rtl.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/coi/super-ihs/from-rtl.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -7,10 +7,10 @@
 
 ;This book has a lot of good stuff about logand, etc. that is proved in books/rtl/.
 
-(local (include-book "rtl/rel4/support/logand" :dir :system))
-(local (include-book "rtl/rel4/support/logxor" :dir :system))
-(local (include-book "rtl/rel4/support/logior" :dir :system))
-(local (include-book "rtl/rel4/arithmetic/integerp" :dir :system))
+(local (include-book "rtl/rel8/support/support/logand" :dir :system))
+(local (include-book "rtl/rel8/support/support/logxor" :dir :system))
+(local (include-book "rtl/rel8/support/support/logior" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/integerp" :dir :system))
 
 
 
@@ -57,7 +57,7 @@
          (logior i j k)))
 
 
-(local (include-book "rtl/rel4/arithmetic/expt" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/expt" :dir :system))
 
 (defthm expt-2-positive-rational-type
   (and (rationalp (expt 2 i))
@@ -86,7 +86,7 @@
          (or (not (integerp n))
              (<= n 0))))
 
-(local (include-book "rtl/rel4/arithmetic/top" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/top" :dir :system))
 
 ;this is better than the one in RTL
 ;make a linear rule?
diff -Nru acl2-6.2/books/coi/super-ihs/super-ihs.lisp acl2-6.3/books/coi/super-ihs/super-ihs.lisp
--- acl2-6.2/books/coi/super-ihs/super-ihs.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/coi/super-ihs/super-ihs.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -557,7 +557,7 @@
  )
 
 ;bzo - why was this necessary in 2.9.2?
-(local (include-book "rtl/rel4/arithmetic/expo" :dir :system))
+(local (include-book "rtl/rel8/arithmetic/expo" :dir :system))
 (local (in-theory (disable expo-shift-general))) ;was looping!
 
 
diff -Nru acl2-6.2/books/countereg-gen/Makefile acl2-6.3/books/countereg-gen/Makefile
--- acl2-6.2/books/countereg-gen/Makefile	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-ACL2_COMPILE_FLG := t :ttags :all
-include ../Makefile-generic
--include Makefile-deps
diff -Nru acl2-6.2/books/countereg-gen/Readme.lsp acl2-6.3/books/countereg-gen/Readme.lsp
--- acl2-6.2/books/countereg-gen/Readme.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/Readme.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,196 +0,0 @@
-((:FILES "
-.:
-acl2-customization.lsp
-acl2s-parameter.lisp
-base.lisp
-basis.lisp
-cert.acl2
-certify-book.sh
-data.lisp
-graph.lisp
-library-support.lisp
-main.lisp
-Makefile
-mv-proof.lisp
-num-list-fns.lisp
-num-list-thms.lisp
-package.lsp
-portcullis.acl2
-portcullis.lisp
-random.lisp
-random-state-basis1.lisp
-random-state.lisp
-Readme.lsp
-rem-and-floor.lisp
-scratchpad.lsp
-simple-graph-array.lisp
-splitnat.lisp
-switchnat.lisp
-testing-regression.lsp
-top.lisp
-type.lisp
-utilities.lisp
-with-timeout.lisp
-with-timeout-raw.lsp
-"
-)
- (:TITLE    "Counterexample Generation")
- (:AUTHOR/S "Harsh Raju Chamarthi, Peter C. Dillinger") ; With help from Matt Kaufmann and Panagiotis Manolios
- (:KEYWORDS ; non-empty list of keywords, case-insensitive
-   "book contributions" "contributed books"
-   "testing" "counterexamples" "witnesses" "executable"
-   "models" "random testing" "bounded-exhaustive testing"
-   "theorem-proving" "dpll" "backtracking search"
-   )
- (:ABSTRACT
-"We provide support for counterexample generation and provide a
-defdata framework which forms the basis for using 'testing' to find
-counterexamples. 
-
-We use simple and incremental search strategies in our quest to find
-counterexamples.
-
-At a high-level, the idea of 'simple search' is simple: Given any
-conjecture, infer type information about free variables from the
-hypotheses, generate/sample values of these types (value sampling can
-be random, bounded exhaustive or mixed), instantiate all variables and
-evaluate to get either T or NIL. The value assignment resulting in NIL
-is a counterexample (other cases are witness and vacuous). The type
-information is stored in ACL2 tables and is usually created using
-'defdata' which automatically generates the value enumerator for that
-type. All base types have been lifted to the defdata framework i.e we
-manually defined all enumerators and subtype relationships among the
-ground ACL2 types.
-
-Theorem proving and domain-specific libraries often help in
-substantially shrinking the space of free variables that we need to
-search, improving our chances of finding a counterexample if one
-exists. We do this by using override and backtrack hints to search for
-counterexamples to all checkpoints of a conjecture under
-thm/defthm/test?.
-
-'incremental search' is a DPLL like algorithm that selects an
-appropriate variable, assigns it, propagates this information using
-ACL2 itself to obtain a partially concretized formula, which is then
-tested using 'simple search'. If we ever hit the stopping
-condition (usually 3 counterexamples and witnesses), we abort the
-search. If not, we continue with the select, assign, propagate
-loop. Of course if propagating a value assignment results in a
-contradiction in the hypotheses (i.e inconsistency), we backtrack.
-
-Instructions for usage are in top.lisp.
-
-See the essay in main.lisp for high-level pseudocode of the test driver.
-")
- (:PERMISSION ; author/s permission for distribution and copying:
-"Copyright (C) 2011 Harsh Raju Chamarthi, Peter C. Dillinger
-                    and Northeastern University
-
-This program is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public License
-as published by the Free Software Foundation; either version 2
-of the License, or (at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA."))
-#|
-
-   
-
-
-These books were developed as part of ACL2s: "The ACL2 Sedan."
-
-To certify books, do the foll at the shell prompt (in the current directory):
-$ export ACL2=<path to your  saved_acl2>
-$ make
-
-Note: You need java to be installed on your machine and in PATH.
-      acl2-lib.jar automatically generates .acl2 files.
-
-Books:
-
-top.lisp 
-   top-level entry book with some customizations.
-
-acl2s-parameter.lisp
-   All ACL2s testing/counterexample-generation related configuration parameters
-   are set here. It provides a macro to add a new parameter, producing
-   getters setters and doc items.
-
-base.lisp
-   Builds up the type metadata and type relationship data structures for base
-   ACL2 theory
-
-basis.lisp
-   defines macros for defining functions that ease guard verification
-   (type-checking), and provide facilities for writing concise code. Note that
-   this book is in progress and some features I would like to
-   incorporate in the future are yet unimplemented. 
-
-mv-proof.lisp
-rem-and-floor.lisp
-num-list-fns.lisp
-num-list-thms.lisp
-   Support books for defdata
-
-splitnat.lisp
-   Given a natural number seed s and another number n, it provides the
-   function split-nat returns an n-tuple which is bijective to s.
-   It is used to generate enumerators for product types.
-
-switchnat.lisp
-   Given a natural number seed s and another number n, it provides the
-   function switch-nat returns an pair (c,s') which is bijective to s.
-   This is used to generate enumerators for union types.
-
-data.lisp 
-   The previous books implement the data definition framework.
-   In particular, it provides the defdata macro which the user can use
-   to introduce 
-
-graph.lisp
-   Provides graph utility functions for DFS, SCC and transitive
-   closure. Possibly buggy, will be replaces by simple-graph-array book.
- 
-library-support.lisp
-   Some theorems for using misc/records book in our context.
-
-main.lisp
-   The top-level book which implements the main driver functions that
-   orchestrate the testing+theorem-proving synergistic combination.
-   It provides the test? macro and the test-checkpoint function which
-   is used as an override-hint to search for counterexamples at all
-   checkpoints. For more information on implementation look at the
-   essay headed "Main Idea".
-
-random-state-basis1.lisp
-   See below
-random-state.lisp
-   Provides pseudogeometric natural number distribution.
-
-testing-regression.lsp
-   Examples, testcases and in general a book that you can refer to for
-   quick application of counterexample generation.
-
-simple-graph-array.lisp
-   Simple implementation of DFS and SCC (and topological sort)
-
-type.lisp 
-   Provides functions to convert ACL2 type set into defdata types and
-   also the meet operation over the subtype (lattice) defdata graph
-
-utilities.lisp
-   Some utility functions used across the books in this directory.
-
-with-timeout.lisp
-   Nested timeouts.
-
-
-|#
diff -Nru acl2-6.2/books/countereg-gen/acl2-customization.lsp acl2-6.3/books/countereg-gen/acl2-customization.lsp
--- acl2-6.2/books/countereg-gen/acl2-customization.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1 +0,0 @@
-(ld "package.lsp")
\ No newline at end of file
diff -Nru acl2-6.2/books/countereg-gen/acl2s-parameter.lisp acl2-6.3/books/countereg-gen/acl2s-parameter.lisp
--- acl2-6.2/books/countereg-gen/acl2s-parameter.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/acl2s-parameter.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,629 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book t :ttags :all);$ACL2s-Preamble$|#
-
-(in-package "ACL2")
-(include-book "utilities")
-
-
-;;; Keep the following defconst synced with all the acl2s parameters
-(defconst *acl2s-parameters* '(num-trials
-                               verbosity-level
-                               num-counterexamples
-                               num-witnesses
-                               ;show-top-level-counterexample
-                               sampling-method
-                               backtrack-limit
-                               search-strategy
-                               testing-enabled
-                               stopping-condition
-                               subgoal-timeout
-                               ))
-
-;All user-defined parameters are stored here
-(table acl2s-defaults-table)
-
-(defrec acl2s-param-info% (value guard setter) NIL)
-
-(defmacro add-acl2s-parameter (name default
-                                    &key 
-                                    (setter 'nil)
-                                    (doc-string 'nil)
-                                    (guard 't))
-  "Add a new user-defined parameter.
-   Put it in the acl2s-defaults-table as a key,
-   using the value of :default. 
-:guard is a term that checks for legal values of the
-   parameter (It uses symbol 'value for variable capture).
-getter and setter specify macro names that will be used by
-the actual getter/setter mechanism to delegate its function.
-Note that setter should be a macro that expands to a state changing
-embedded event form, this this is called from inside an make-event.
-You have to see the code in acl2s-defaults to understand whats going
-on with getter and setter, the situation is assymmetric and I am
-being lazy about documentation.
-:doc-string is a string that is used to specify the defdoc. 
-For internal flags dont use a doc-string"
-  
-  (b* (((unless (symbolp name))
-        (er hard 'add-acl2s-parameter
-            "Name must be a symbol, but is ~x0." name))
-       ((unless (allp guard))
-        (er hard 'add-acl2s-parameter 
-            ":guard must be a term, but is ~x0." guard))
-       );*b
-
-    `(progn 
-       (table acl2s-defaults-table 
-              ',name
-              ',(acl2::make acl2s-param-info%
-                 :guard guard ;store guard too
-                 :value default
-                 :setter setter)
-              :put)
-       ,@(and doc-string
-              `((defdoc ,name ,doc-string))))))
-
-
-  
-
-
-(defdoc ACL2::TESTING
-  ":Doc-Section ACL2::TESTING
-  
-  A counterexample generation framework for ACL2 ~/
-                                 
-  Test formulas before and during a proof attempt, to find
-  counterexamples and witnesses potentially saving time and
-  effort and providing more intuition into the conjecture under
-  scrutiny.  The testing framework is tightly coupled with the
-  data definition (See ~ilc[DATA-DEFINITIONS]) framework.
-  
-  ~t[test?] guarantees printing counterexamples in
-  terms of the top goals variables. See ~ilc[test?]
-  for more details and examples.
-  
-  The framework can be configured via a bunch of parameters
-  whose documention you will find below. In particular, see
-  ~ilc[num-trials], ~ilc[verbosity-level], ~ilc[testing-enabled].~/ 
-  
-  To understand more about how testing works,
-  please refer to the following paper
-  ~url[http://www.ccs.neu.edu/home/harshrc/ITaITP.pdf]
-  ")
-
-
-(add-acl2s-parameter 
- num-trials 1000
- :doc-string 
- ":Doc-Section ACL2::TESTING
-  
-  Max number of tries to find counterexamples~/~/
-
-  Maximum number of tries (attempts) to construct 
-  counterexamples and witnesses.
-  By default this parameter is set to 1000. Can be set to
-  any natural number ~t[n]. If set to 0, it has the same
-  effect as setting testing-enabled parameter to ~t[nil].
-  ~bv[]
-   Usage:
-   (acl2s-defaults :set num-trials 1000)
-   (acl2s-defaults :get num-trials)
-   :doc num-trials
-   ~ev[]"
- :guard (and (natp value) 
-             (< value 1000000000)))
-
-(add-acl2s-parameter 
- verbosity-level 1
- :doc-string 
- ":Doc-Section ACL2::TESTING
-  
- Control verbosity of Testing~/~/
-
- Control amount of output printed by random-testing
-   Currently 3 verbosity levels are implemented:
-   0 - All testing output is turned off
-   1 - Normal verbosity level (default)
-   2 - More verbose.
-   3 - For Debug by normal users
-   4 and above - System level debug by developers
-  ~bv[]
-    Usage:
-    (acl2s-defaults :set verbosity-level 1)
-    (acl2s-defaults :get verbosity-level)
-    :doc verbosity-level
-  ~ev[]"
- :guard (natp value))
-
-
-(add-acl2s-parameter 
-  num-counterexamples 3
- :doc-string 
- ":Doc-Section ACL2::TESTING
- 
-  Number of Counterexamples to be shown~/~/
- 
-  Set the number of counterexamples desired to be shown
-  By default this parameter is set to 3. Can be set to
-  any natural number n. Setting this number to 0 implies
-  the user is not interested in seeing counterexamples, and
-  thus none will be printed in the testing output.
-  
-  ~bv[]
-  Usage:
-  (acl2s-defaults :set num-counterexamples 3)
-  (acl2s-defaults :get num-counterexamples)
-  :doc num-counterexamples
-  ~ev[]"
-   :guard (natp value))
-
-
-(add-acl2s-parameter 
-  num-witnesses 3
- :doc-string 
- ":Doc-Section ACL2::TESTING
-  
-  Number of Witnesses to be shown~/~/
-  
-  Set the number of witnesses desired to be shown
-  By default this parameter is set to 3. Can be set to
-  any natural number. Setting this number to 0 implies
-  the user is not interested in seeing witnesses, and
-  thus none will be printed in the testing output.
-  
-  ~bv[]
-  Usage:
-  (acl2s-defaults :set num-witnesses 3)
-  (acl2s-defaults :get num-witnesses)
-  :doc num-witnesses
-  ~ev[]"
-   :guard (natp value))
-
-;DEPRECATED
-;; (add-acl2s-parameter 
-;;  show-top-level-counterexample t
-;;  :doc-string ":Doc-Section ACL2::TESTING
-;;  Show Counterexamples to the top-level <i>goal</i>" 
-;;  Show Counterexamples to the top-level <i>goal</i>
-;;    instead of to the <i>subgoals</i>.
-;;    By default this parameter is set to <tt>t</tt>. 
-;;    If set to <tt>nil</tt>, then counterexamples are simply
-;;    instances falsifying the respective subgoals.
-;;    ~bv[]
-;;    Usage:
-;;    (acl2s-defaults :set show-top-level-counterexample t)
-;;    (acl2s-defaults :get show-top-level-counterexample)
-;;    :doc show-top-level-counterexample 
-;;    ~ev[]
-;;    "
-;;  :guard (booleanp value))
-
-;; use test enumerator for user-level controlled testing
-(defconst *default-rt-use-test-enum* t)
-
-(defmacro set-acl2s-random-testing-use-test-enumerator (v)
-;:Doc-Section RANDOM-TESTING  
- "Set the flag to use test-enumerator if it exists~/
-  By default this parameter is set to nil.
-  ~bv[]
-  Usage:
-  (set-acl2s-random-testing-use-test-enumerator nil)
-  ~ev[]~/
-  "
- `(assign acl2s-rt-use-test-enum ,v))
-
-(defun get-acl2s-random-testing-use-test-enumerator-fn (state)
-  (declare (xargs :stobjs (state)))
-  (let ((nt (f-boundp-global 'acl2s-rt-use-test-enum state)))
-    (if nt
-     (f-get-global 'acl2s-rt-use-test-enum state)
-      *default-rt-use-test-enum*)))
-
-
-(defmacro get-acl2s-random-testing-use-test-enumerator ()
-;:Doc-Section RANDOM-TESTING  
- "Get the current setting for use of test-enumerator~/
-  ~bv[]
-  Usage:
-  (get-acl2s-random-testing-use-test-enumerator)
-  ~ev[]~/
-  "
- '(get-acl2s-random-testing-use-test-enumerator-fn state))
-
-
-(add-acl2s-parameter 
- search-strategy :simple
- :doc-string 
- ":Doc-Section ACL2::TESTING
-  
-  Specify the search strategy to be used ~/~/
- 
-  Specify which of the following strategies to
-  use for instantiating free variables of the conjecture
-  under test: ~t[:simple] or  ~t[:incremental]
-  or  ~t[:hybrid] (untested).
-  ~t[:incremental] uses a dpll-like algorithm to search
-  for counterexamples.
-  By default this parameter is set to the symbol <tt>:simple</tt>.
-   ~bv[]
-    Usage:
-    (acl2s-defaults :set search-strategy :simple)
-    (acl2s-defaults :get search-strategy)
-    :doc search-strategy
-   ~ev[]
-   "
- :guard (member-eq value '(:simple :incremental :hybrid)))
-;; Use natural seeds or random tree of natural numbers 
-
-(add-acl2s-parameter 
- sampling-method :random
- :doc-string 
- ":Doc-Section ACL2::TESTING
- 
-  Specify sampling method to be used to instantiate variables ~/~/
- 
-  Specify which of the following methods to
-  use for instantiating free variables of the conjecture
-  under test: ~t[:be] or ~t[:random] or ~t[:mixed]
-  By default this parameter is set to the symbol ~t[:random]
-   ~bv[]
-    Usage:
-    (acl2s-defaults :set sampling-method :random)
-    (acl2s-defaults :get sampling-method)
-    :doc sampling-method
-   ~ev[]
-   "
- :guard (member-eq value '(:be :random :mixed)))
-
-;; (add-acl2s-parameter 
-;;  flatten-defdata nil
-;;  :doc-string ":Doc-Section ACL2::TESTING
-;;  Flatten defdata instances during sampling"
-;;  Flatten defdata enumerator expressions which stand for
-;;    instances of the particular defdata type. Basically if you
-;;    have a type triple <tt>(defdata triple (list pos pos pos))</tt>,
-;;    then an instance of triple is generated (sampled) by a call to the 
-;;    enumerator expression <tt>(nth-triple n)</tt>, where <tt>n</tt>
-;;    is some natural number. Alternatively we could flatten the 
-;;    defdata instance by representing it with the enumerator 
-;;    expression <tt>(list (nth-pos n1) (nth-pos n2) (nth-pos n3))</tt>
-;;    which consists purely of instances of primitive and custom types. 
-;;    This has the nice property of distribution invariance, 
-;;    i.e. a field of a particular type has the same distribution, 
-;;    regardless of its position in the body of a complex defdata type.
-;;    By default the value of parameter is <tt>nil</tt>.
-;;    ~bv[]
-;;     Usage:
-;;     (acl2s-defaults :set flatten-defdata-instance nil)
-;;     (acl2s-defaults :get flatten-defdata-instance)
-;;     :doc flatten-defdata-instance
-;;    ~ev[]
-;;    "
-;;  :guard (booleanp value))
-
-(add-acl2s-parameter 
- backtrack-limit 3
- :doc-string 
- ":Doc-Section ACL2::TESTING
- 
-  Maximum number of backtracks allowed (per variable)~/~/
- 
-  Maximum number of backtracks allowed by a variable.
-   The default backtrack limit is set to 3. Setting this 
-   parameter to 0, means that backtracking is disabled.
-   ~bv[]
-    Usage:
-    (acl2s-defaults :set backtrack-limit 3)
-    (acl2s-defaults :get backtrack-limit)
-    :doc backtrack-limit
-   ~ev[]
-   "
- :guard (natp value))
-        
-
-(add-acl2s-parameter 
- subgoal-timeout 10
- :doc-string 
- ":Doc-Section ACL2::TESTING
- 
-  Testing timeout (in seconds) per subgoal~/~/
- 
-  Maximum allowed time (in seconds) to test any 
-  subgoal or top-level form.
-  The default timeout limit is set to 10 sec.
-  Setting this parameter to 0 amounts to disabling
-  the timeout mechanism, i.e. its a no-op.
-   ~bv[]
-    Usage:
-    (acl2s-defaults :set subgoal-timeout 10)
-    (acl2s-defaults :get subgoal-timeout)
-    :doc subgoal-timeout
-   ~ev[]
-   "
- :guard (natp value))
-
-(add-acl2s-parameter 
- testing-enabled :naive
- :doc-string 
- ":Doc-Section ACL2::TESTING
- 
-  Testing enable/disable flag~/~/
- 
-  Testing can be enabled or disabled
-  using this parameter.
-  The default value is  ~t[:naive] (unless you are in
-  the usual ACL2 Sedan session modes, where default is ~t[t]).
-  Setting this parameter to ~t[nil] amounts to disabling
-  the testing mechanism. Setting this parameter
-  to ~t[:naive] leads to top-level testing without any
-  theorem prover support.
-  ~bv[]
-   Usage:
-   (acl2s-defaults :set testing-enabled :naive)
-   (acl2s-defaults :get testing-enabled)
-   :doc testing-enabled
-  ~ev[]
-   "
- :guard (member-eq value '(T NIL :naive))
- :setter set-acl2s-random-testing-enabled)
-
-(defun mem-tree (x tree)
-  (declare (xargs :guard (symbolp x)))
-  (if (atom tree)
-    (eq x tree)
-    (or (mem-tree x (car tree))
-        (mem-tree x (cdr tree)))))
-
-(defun get-acl2s-random-testing-hints-flag-fn ( state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-  ;; bugfix 30 April '12: I had changed the name of test-each-checkpoint
-  ;; to test-checkpoint and forgot the update the fact here. Bad bad bad!
-  (and (mem-tree 'TEST-CHECKPOINT ;check if random testing is enabled
-                 (override-hints (w state)))
-       T))
-      
-
-(defdoc get-acl2s-random-testing-hints-enabled
-  ":Doc-Section ACL2::TESTING
-  
-   Get current setting for random-testing-hints-enabled~/~/
-  
-   Get current setting for random-testing-hints-enabled.
-   Returns ~t[nil] if ~t[thm] and ~t[defthm] do not make use of random-testing
-   in their proof attempts, and ~t[t] otherwise.
-   
-   ~bv[]
-    Usage:
-    (get-acl2s-random-testing-hints-enabled)
-   ~ev[]
-   ")
-
-;top-level exported macro to know wether random testing is enabled or not
-(defmacro get-acl2s-random-testing-hints-enabled ()
- 
- `(get-acl2s-random-testing-hints-flag-fn state))
-
-(defun set-acl2s-random-testing-flag-fn (flg mode state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-;check if random testing is enabled by searching for the testing hint
-  (let ((flg (if (eq flg :naive) NIL flg)))
-  (if (get-acl2s-random-testing-hints-enabled)
-      ;;; TESTING hint is currently ENABLED
-    (if flg ;if enabled and user wants to set it then no-op
-      '(value-triple :REDUNDANT)
-;if enabled and user wants to turn it off
-      (if (eq mode :program)
-          '(progn ; Feb 13 2012 bug. Testing-hint cant be disabled
-             ;; in program mode. Found by Pete while using defunc.
-             ;; Reason: local forms are ignored in program mode.
-             (logic)
-             (disable-acl2s-random-testing)
-             (program))
-        '(disable-acl2s-random-testing)))
-    ;;; TESTING hint is currently disabled
-    (if flg ;if disabled and user wants to set it to t
-        (if (eq mode :program)
-            '(progn
-               (logic)
-               (enable-acl2s-random-testing)
-               (program))
-          '(enable-acl2s-random-testing))
-;if testing-hint is disabled and user wants to turn it off its no-op
-      '(value-triple :REDUNDANT)))))
-
-(defdoc set-acl2s-random-testing-enabled
-   ":Doc-Section ACL2::TESTING
-  
-   Control enabling/disabling testing hint~/~/
-  
-   Control enabling/disabling random-testing computed override-hint.
-   If set to ~t[nil], thm and defthm retain their default ACL2 behavior.
-   If set to ~t[t], then all theorem-proving (defthm, thm, function
-   termination, guard-verification) will use random-testing pervasively.
-   
-   ~bv[]
-    Usage:
-    (set-acl2s-random-testing-enabled nil)
-   ~ev[]" )
-
-;top-level exported macro to know enable random testing
-(defmacro set-acl2s-random-testing-enabled (v forms)
-  (declare (xargs :guard (member-eq v '(T NIL :naive))))
-  `(make-event
-     (let ((mode (cdr (assoc-eq :defun-mode 
-                                (table-alist
-                                 'acl2::acl2-defaults-table 
-                                 (w state))))))
-       (let ((forms ',forms))
-          (value `(progn
-                    ,(set-acl2s-random-testing-flag-fn ,v mode state)
-                    ,@forms))))))
-
-(defmacro acl2s-defaults (&rest rst)
-  (b* (((unless (consp (cdr rst)));atleast 2 elems
-        (er hard 'acl2s-defaults
-            "~|At least 2 arguments, but given ~x0~%" rst))
-       (param (second rst))
-       (op (car rst))
-       ((unless (or (eq :get op) 
-                    (and (eq :set op)
-                         (consp (cddr rst));value
-                         )))
-        (er hard 'acl2s-defaults;TODO be more informative
-            "~|Invalid arguments supplied, given ~x0~%" rst)))
-    (if (eq :get op)
-;get the value at the point of call (runtime)
-        `(b* ((param-rec-pair
-                 (assoc-eq ',param 
-                           (table-alist 'acl2s-defaults-table 
-                                        (w state))))
-              ((unless (consp param-rec-pair))
-                 (er hard 'acl2s-defaults 
-                     "~|Parameter ~x0 not found in acl2s-defaults!~%"
-                     ',param))
-              (r (cdr param-rec-pair))
-              (val (access acl2s-param-info% r :value)))
-          val)
-
-;get the guard and value at the runtime
-;since we need access to state
-;and set the new value v
-     `(with-output
-       :off summary
-       (make-event
-        (b* ((param-rec-pair
-             (assoc-eq ',param 
-                      (table-alist 
-                       'acl2s-defaults-table (w state))))
-             ((unless (consp param-rec-pair))
-                 (er hard 'acl2s-defaults 
-                     "~|Parameter ~x0 not found in acl2s-defaults!~%"
-                     ',param))
-;guard is fixed once it is initialized INVARIANT
-             (r (cdr param-rec-pair))
-             (guard (access acl2s-param-info% r :guard))
-             (setter (access acl2s-param-info% r :setter))
-             (v (third ',rst)))
-        `(make-event ;state changing event 
-           (if (not ,(subst v 'value guard))
-               (er soft 'acl2s-defaults-table
-                 "Guard ~x0 for ~x1 in table failed for VALUE ~x2" 
-                 ',guard ',',param ',v)
-             (if ',setter
-                 (let ((table-update-form
-                        `(table acl2s-defaults-table 
-                                  ',',',param 
-                                  ',(change acl2s-param-info% ',r :value ',v))))
-;;; setter is a macro, so dont quote the args to it whereas the above
-;;; table macro needs quoted args because its 3rd parameter is &rest rst
-                  (value `(,',setter ,',v (,table-update-form));embedded event
-                        ))
-                           
-             (value `(progn
-                      (table acl2s-defaults-table 
-                             ',',',param 
-                             ',(change acl2s-param-info% ',r :value ',v))
-                      (value-triple ',',v))))))))))))
-
-
-
-;;; copied from main.lisp, since these functions are only called by
-;;; set-acl2s-random-testing-enabled, which is defined here
-
-
-;;; add no-op override hints that test each checkpoint.  The reason
-;;; why we need backtrack hint is not that we need clause-list
-;;; (children goals of clause), but because we need to do testing only
-;;; on checkpoints, and only backtrack hints have access to processor,
-;;; if this were not the case, we could have used ":no-op
-;;; '(test-each-goal ...)" as an override hint which has no effect but
-;;; to test each goal.  Another reason is that because computed-hints
-;;; with :COMPUTED-HINT-REPLACEMENT t is not additive like
-;;; override-hints it can cause a hint to be not selected otherwise.
-(defmacro enable-acl2s-random-testing ()
-;; this has to be a makevent because enable-acl2s-random-testing is the
-;; expansion result of the make-event in set-acl2s-random-testing-enabled
-`(make-event  
-  '(progn 
-     (acl2::add-override-hints 
-      '((list* :backtrack 
-;take parent pspv and hist, not the ones returned by clause-processor
-
-             `(test-checkpoint acl2::id 
-                                    acl2::clause
-                                    acl2::clause-list
-                                    acl2::processor
-;TODO:ask Matt about sending parent pspv and hist
-                                    ',acl2::pspv 
-                                    ',acl2::hist
-                                    acl2::ctx
-                                    state
-                                    )
-
-             ;; `(mv-let (erp tval state)
-             ;;          (trans-eval
-             ;;           `(test-each-checkpoint ',acl2::id 
-             ;;                                  ',acl2::clause 
-             ;;                                  ',acl2::processor 
-             ;;                                  ',',acl2::pspv 
-             ;;                                  ',',acl2::hist state
-             ;;                                  ts$)
-             ;;           'acl2s-testing ; ctx
-             ;;           state
-             ;;           t ; aok
-             ;;           )
-             ;;          (declare (ignorable erp))
-             ;;          (mv (cadr tval) (caddr tval) state))
-
-;`(test-each-checkpoint acl2::id acl2::clause acl2::processor ',acl2::pspv ',acl2::hist state)
-             acl2::keyword-alist)))
-     )))
-
-(defmacro disable-acl2s-random-testing ()
-`(make-event  
-     '(progn
-        (acl2::remove-override-hints 
-         '((list* :backtrack 
-                `(test-checkpoint acl2::id 
-                                       acl2::clause 
-                                       acl2::clause-list
-                                       acl2::processor 
-                                       ',acl2::pspv 
-                                       ',acl2::hist
-                                       acl2::ctx
-                                       state
-                                      )
-;take parent pspv and hist, not the ones returned by clause-processor
-                 ;; `(mv-let (erp tval state)
-                 ;;      (trans-eval
-                 ;;       `(test-each-checkpoint ',acl2::id 
-                 ;;                              ',acl2::clause 
-                 ;;                              ',acl2::processor 
-                 ;;                              ',',acl2::pspv 
-                 ;;                              ',',acl2::hist state
-                 ;;                              ts$)
-                 ;;       'acl2s-testing ; ctx
-                 ;;       state
-                 ;;       t ; aok
-                 ;;       )
-                 ;;      (declare (ignorable erp))
-                 ;;      (mv (cadr tval) (caddr tval) state))
-;`(test-each-checkpoint acl2::id acl2::clause acl2::processor ',acl2::pspv ',acl2::hist state)
-                acl2::keyword-alist)))
-        )))
-
-
-
-; Internal flags
-(add-acl2s-parameter 
-;show pts at the end of subgoal?
-  acl2s-pts-subgoalp NIL
- :guard (booleanp value))
-
-
-#|ACL2s-ToDo-Line|#
-
diff -Nru acl2-6.2/books/countereg-gen/base.lisp acl2-6.3/books/countereg-gen/base.lisp
--- acl2-6.2/books/countereg-gen/base.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/base.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,896 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book t :ttags :all);$ACL2s-Preamble$|#
-
-
-(in-package "ACL2")
-
-;Data has separate package namespace 'defdata' and which implements
-;custom data definitions, type constructors(product and union)
-(include-book "data" :load-compiled-file :comp)
-(include-book "splitnat" :load-compiled-file :comp)
-(include-book "switchnat" :load-compiled-file :comp)
-(include-book "graph" :load-compiled-file :comp)
-(include-book "library-support" :load-compiled-file :comp)
-
-;TODO.NOTE: constructors are now stored in globals and it 
-;seems that include-book does not carry globals?? is it true?
-
-;;type constructors == product types
-;;rational number constructor
-;;pair constructor
-(register-data-constructor (consp cons)
-                           ((allp car) (allp cdr))
-                           :proper t)
-
-;;jared's oset implementation
-(register-data-constructor (SETS::setp SETS::insert)
-                           ((allp SETS::head) (allp SETS::tail))
-                           :proper nil)
-
-
-;;symbols
-(register-data-constructor (symbolp intern$)
-                           ((stringp symbol-name) (stringp symbol-package-name)))
-
-(register-data-constructor (rationalp /)
-                           ((integerp numerator) (posp denominator)))
-
-;;associated key-value pairs
-(defun aconsp (x)
-  (declare (xargs :guard t))
-  (and (consp x) (consp (car x))))
-
-(register-data-constructor (aconsp acons)
-                           (caar cdar cdr)
-                           :proper t) 
-;;complex number type
-(register-data-constructor (acl2-numberp complex)
-                           ((rationalp realpart) (rationalp imagpart))
-                           :proper t)
-;;natural numbers
-(defexec succ (x)
-  (declare (xargs :guard (natp x)))
-  (mbe :logic
-       (if (natp x)
-         (1+ x)
-         1)
-       :exec (1+ x)))
-
-(defun pred (x)
-  (declare (xargs :guard (natp x)))
-  (if (zp x)
-    0
-    (1- x)))
-
-(defthm succ-pred
-  (implies (posp x)
-           (equal (succ (pred x)) x)))
-
-(register-data-constructor (posp succ)
-                           (pred))
-
-
-;;booleans
-(define-enumeration-type boolean '(t nil))
-(define-enumeration-type zero '(0))
-
-;;characters
-
-(defconst *character-values* '(
-           #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j
-           #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t
-           #\u #\v #\w #\x #\y #\z                    
-           #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
-           #\A #\B
-           #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L
-           #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V
-           #\W #\X #\Y #\Z 
-           ))
-
-(defconst *z-values* '(0)) ;for zp
-
-
-;-------- define some enumerators --------;
-
-(defun nth-nat (n)
-  (declare (xargs :guard (natp n)))
-  n)
-
-(defun nat-index (n)
-  (declare (xargs :guard (natp n)))
-  n)
-
-(defthm nth-nat-index
-  (equal (nat-index (nth-nat n))
-         n))
-
-(defthm nat-index-nth
-  (equal (nth-nat (nat-index n))
-         n))
-
-
-(defexec nth-pos (n)
-  (declare (xargs :guard (natp n)))
-  (mbe :logic
-       (if (natp n)
-         (1+ n)
-         n)
-       :exec (1+ n)))
-
-(defexec pos-index (i)
-  (declare (xargs :guard (posp i)))
-  (mbe :logic
-       (if (posp i)
-         (1- i)
-         i)
-       :exec (1- i)))
-
-(defthm nth-pos-index
-  (equal (pos-index (nth-pos n))
-         n))
-
-(defthm pos-index-nth
-  (implies (and (integerp i)
-                (>= i 1))
-           (equal (nth-pos (pos-index i))
-                  i)))
-
-
-(defun pos-multiple-of-threep (v)
-  (if (posp v)
-    (equal 0 (mod v 3))
-    nil)) 
-(defun nth-pos-multiple-of-three (n)
- (if (natp n) 
-   (* 3 (1+ n))
-   3))
-
-(defun pos-multiple-of-three-index (i)
-  (if (pos-multiple-of-threep i)
-         (1- (floor i 3))
-         i))
-
-;;integers
-(defun nth-integer (n)
-  (declare (xargs :guard (natp n)))
-  (let* (;(n (mod n 1000))
-         (mag (floor n 2))
-        (sign (rem n 2)))
-    (if (= sign 0)
-      mag
-      (- -1 mag))))
-
-(defun integer-index (i)
-  (declare (xargs :guard (integerp i)))
-  (if (< i 0)
-    (1+ (* (- (1+ i)) 2))
-    (* i 2)))
-;#|
-(encapsulate nil
-  (local 
-   (include-book "arithmetic-5/top" :dir :system))
-
-  (defthm nth-pos-multiple-three-type
-    (pos-multiple-of-threep (nth-pos-multiple-of-three n)))
-  
-  
-  (defthm nth-pos-multiple-of-three-index
-    (implies (natp n)
-             (equal (pos-multiple-of-three-index (nth-pos-multiple-of-three n))
-                    n)))
-  
-  (defthm pos-multiple-of-three-index-nth
-    (implies (pos-multiple-of-threep i)
-             (equal (nth-pos-multiple-of-three (pos-multiple-of-three-index i))
-                    i)))    
-
-  
-  (defthm nth-integer-index
-    (implies 
-     (and (integerp n)
-          (>= n 0))
-     (equal (integer-index (nth-integer n))
-            n)))
-  (defthm integer-index-nth
-    (implies 
-     (integerp i)
-     (equal (nth-integer (integer-index i))
-            i))))
-
-;needed to get guard verification of character related functions
-(local (include-book "arithmetic-5/top" :dir :system ))
-       ;(include-book "rtl/rel5/arithmetic/mod-proofs" :dir :system ))
-
-(defun get-character-list-from-positions (l)
-  (declare (xargs :guard (naturals-listp l)))
-                  ;:verify-guards nil))
-  (if (endp l)
-    nil
-    (let* ((pos (mod (car l) (len *character-values*)))
-           (char (nth pos *character-values*)))
-      (cons char (get-character-list-from-positions (cdr l))))))
-
-(defun get-general-character-list-from-positions (l)
-  (declare (xargs :guard (naturals-listp l)))
-  (if (endp l)
-    nil
-    (let* ((pos (mod (car l) (len *standard-chars*)))
-           (char (nth pos *standard-chars*)))
-      (cons char (get-general-character-list-from-positions (cdr l))))))
-
-(defthm get-character-list-from-positions--character-listp
-  (implies (naturals-listp l)
-           (character-listp (get-character-list-from-positions l))))
-
-
-;;only strings upto len 1 to 8
-(defun nth-string (n)
-  (declare (xargs :guard (natp n)))
-                  ;:verify-guards nil))
-  (let* ((str-len (1+ (mod n 7)))
-         (char-pos-list (defdata::split-nat str-len n))
-         (charlist (get-character-list-from-positions char-pos-list)))
-    (coerce charlist 'string)))
-;; 
-(defun nth-symbol (n)
-  (declare (xargs :guard (natp n)))
-                 ;:verify-guards nil)) 
-  (intern-in-package-of-symbol (nth-string n) 'acl2::acl2-pkg-witness))
-
-
-(defun positive-ratiop (x)
-  (declare (xargs :guard t))
-  (and (rationalp x)
-       (not (integerp x))
-       (> x 0)
-       ))
-
-(defun nth-positive-ratio (n)
-  (declare (xargs :guard (natp n)))
-  (mbe :logic (if (natp n)
-                 (let* ((two-n-list (defdata::split-nat 2 n))
-                        (alpha  (car two-n-list))
-                        (beta (cadr two-n-list))
-                        (den (+ 2 alpha))
-                        (num (+ (floor beta den) beta)))
-                   (/ num den))
-                 (/ 1 2))
-       :exec (let* ((two-n-list (defdata::split-nat 2 n))
-                    (alpha  (car two-n-list))
-                    (beta (cadr two-n-list))
-                    (den (+ 2 alpha))
-                    (num (+ (floor beta den) beta)))
-               (/ num den))))
-
-
-
-(defun negative-ratiop (x)
-  (declare (xargs :guard t))
-  (and (rationalp x)
-       (not (integerp x))
-       (< x 0)
-       ))
-
-
-(defun nth-negative-ratio (n)
-  (declare (xargs :guard (natp n)))
-  (let* ((two-n-list (defdata::split-nat 2 n))
-         (alpha  (car two-n-list))
-         (beta (cadr two-n-list))
-         (den (+ 2 alpha))
-         (num (+ (floor beta den) beta)))
-    (- 0 (/ num den))))
-
-
-;(defdata rat (oneof 0 positive-ratio negative-ratio))
-;DOESNT WORK so positive/negative ratio are not consistent types ;TODO
-;(local (include-book "arithmetic-5/top" :dir :system))
-;(thm (nat-listp (defdata::split-nat 2 n)))
-;(thm (positive-ratiop (nth-positive-ratio n)))
-
-
-(defun negp (x)
-  (declare (xargs :guard t))
-  (and (integerp x) 
-       (< x 0)
-       ))
-(defun nth-neg (n)
-  (declare (xargs :guard (natp n)))
-  (- -1 n))
- 
-#|
-(defdata int (oneof 0 pos neg))
-(thm (iff (integerp x) (intp x)))
-|#
-
-(defun nth-positive-rational (n)
-  (declare (xargs :guard (natp n)))
-  (let* ((two-n-list (defdata::split-nat 2 n))
-         (num (nth-pos (car two-n-list)))
-         (den (nth-pos (cadr two-n-list))))
-    (/ num den)))
-
-(defun nth-negative-rational (n)
-  (declare (xargs :guard (natp n)))
-  (let* ((two-n-list (defdata::split-nat 2 n))
-         (num (nth-neg (car two-n-list)))
-         (den (nth-pos (cadr two-n-list))))
-    (/ num den)))
-(defun positive-rationalp (x)
-  (declare (xargs :guard t))
-  (and (rationalp x) 
-       (> x 0)
-       ))
-(defun negative-rationalp (x)
-  (declare (xargs :guard t))
-  (and (rationalp x) 
-       (< x 0)
-       ))
-
-;(defdata rational (oneof 0 positive-rational negative-rational))
-(defun nth-rational (n)
-  (declare (xargs :guard (natp n)))
-  (let* ((two-n-list (defdata::split-nat 2 n))
-         (num (nth-integer (car two-n-list)))
-         (den (nth-pos (cadr two-n-list))))
-    (/ num den)))
-
-(defun nth-complex-rational (n)
-  (declare (xargs :guard (natp n)))
-  (let* ((two-n-list (defdata::split-nat 2 n))
-         (rpart (nth-rational (defdata::nfixg (car two-n-list))))
-         (ipart (nth-rational (defdata::nfixg (cadr two-n-list)))))
-    (complex rpart ipart)))
-
-(defun nth-acl2-number (n)
-  (declare (xargs :guard (natp n)))
-  (b* (((mv choice seed)
-        (defdata::switch-nat 4 n)))
-    (case choice
-          (0 (nth-nat seed))
-          (1 (nth-integer seed))
-          (2 (nth-rational seed))
-          (t (nth-complex-rational seed)))))
-
-;(defdata character-list (listof character))
-;;only strings upto len 1 to 8
-(defun nth-character-list (n)
-  (declare (xargs :guard (natp n)))
-                  ;:verify-guards nil))
-  (let* ((str-len (1+ (mod n 7)))
-         (char-pos-list (defdata::split-nat str-len n))
-         (charlist (get-character-list-from-positions char-pos-list)))
-    charlist))
-
-
-#||
-(defconst *base-types* '((BOOLEAN 2 *BOOLEAN-VALUES* . BOOLEANP)
-                         (CHARACTER-LIST T NTH-CHARACTER-LIST . CHARACTER-LISTP)
-                         (SYMBOL T NTH-SYMBOL . SYMBOLP)
-                         (STRING T NTH-STRING . STRINGP)
-                         (CHARACTER 62 *CHARACTER-VALUES* . CHARACTERP)
-                         (ACL2-NUMBER T NTH-ACL2-NUMBER . ACL2-NUMBERP)
-                         (COMPLEX-RATIONAL T NTH-COMPLEX-RATIONAL . COMPLEX-RATIONALP)
-                         (RATIONAL T NTH-RATIONAL . RATIONALP)
-                         (POS T NTH-POS . POSP)
-                         (NAT T NTH-NAT . NATP)
-                         (INTEGER T NTH-INTEGER . INTEGERP)))
-(defun nth-all (n)
-  (declare (xargs :guard (natp n))
-                  :verify-guards nil)
-  (let* ((num-types (len *base-types*))
-         (two-n-list (defdata::split-nat 2 n))
-         (choice (mod (car two-n-list) num-types))
-         (seed (cadr two-n-list))
-         (type-info (cdr (nth choice *base-types*)))
-         (type-size (car type-info))
-         (type-enum (cadr type-info)))
-    (if (eq type-size 't) ;inf
-      `(,type-enum ,seed)
-      `(nth ,(mod seed type-size) ,type-enum))))||#
-
-
-;ADDED restricted testing enumerators for all number types
-(defun nth-nat-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-nat n-small)))
-(defun nth-pos-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-pos n-small)))
-(defun nth-neg-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-neg n-small)))
-
-(defun nth-integer-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-integer n-small)))
-
-(defun nth-positive-ratio-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-positive-ratio n-small)))
-(defun nth-negative-ratio-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-negative-ratio n-small)))
-(defun nth-rational-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-rational n-small)))
-(defun nth-positive-rational-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-positive-rational n-small)))
-(defun nth-negative-rational-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-negative-rational n-small)))
-(defun nth-acl2-number-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-acl2-number n-small)))
-(defun nth-complex-rational-testing (n)
-  (declare (xargs :guard (natp n)))
-  (let ((n-small (mod n 1000)))
-    (nth-complex-rational n-small)))
-
-
-
-(defun atomp (v)
-  (declare (xargs :guard t))
-  (atom v))
-
-(defun nth-atom (n)
-  (declare (xargs :guard (natp n)))
-  (b* (((mv choice seed) 
-        (defdata::weighted-switch-nat 
-          '(1  ;nil
-            1  ;t
-            3  ;nat
-            1  ;sym
-            1  ;string
-            2  ;char
-            2  ;acl2-num
-            10 ;rational
-            10 ;pos
-            20 ;0
-            30 ;integer
-            ) n)))
-        
-    (case choice
-          (0 'nil)
-          (1 't)
-          (2 (nth-nat-testing seed));smaller numbers
-          (3 (nth-symbol seed))
-          (4 (nth-string seed))
-          (5 (nth (mod seed (len *character-values*)) *character-values*))
-          (6 (nth-acl2-number seed))
-          (7 (nth-rational seed))
-          (8 (nth-pos-testing seed))
-          (9 0)
-          (t (nth-integer-testing seed)))))
-
-;(defdata atom (oneof acl2-number character symbol string))
-
-
-;atoms
-;register-custom-type does two things:
-;1. Stores type information (predicate, enum, size) in a table types-info-table
-;2. Add the types in the data-type graphs that capture subtype/disjoint relations
-;3. TODO:Note it does not prove that type is sound neither that is is complete
-;Note:
-;By Type Soundness i mean (thm (implies (natp n) (Tp (nth-T n)))
-;By Type Completeness i mean (thm (implies (Tp x)
-;                                          (equal x (nth-T (T-index x)))) 
-;                                   where (nth-T (T-index x)) = x
-(register-custom-type nat t nth-nat natp)
-(register-custom-type pos t nth-pos  posp )
-(register-custom-type neg t nth-neg negp )
-(register-custom-type integer t nth-integer integerp )
-(register-custom-type positive-ratio t nth-positive-ratio  positive-ratiop)
-(register-custom-type negative-ratio t nth-negative-ratio  negative-ratiop )
-(register-custom-type positive-rational t nth-positive-rational  positive-rationalp )
-(register-custom-type negative-rational t nth-negative-rational  negative-rationalp )
-(register-custom-type rational t nth-rational  rationalp )
-(register-custom-type complex-rational t nth-complex-rational  complex-rationalp )
-(register-custom-type acl2-number t nth-acl2-number  acl2-numberp )
-;(register-custom-type boolean 2 *boolean-values*  booleanp );taken care of by define-enumeration-type
-(register-custom-type symbol t nth-symbol  symbolp)
-
-;MAKE SURE THIS IS ALWAYS SYNCED, if you change character-values then change here too!
-;(len *character-values*) = 62
-(register-custom-type character 62 *character-values*  characterp )
-(register-custom-type string t nth-string stringp )
-(register-custom-type atom t nth-atom atom);instead of atomp Exception
-
-;added the above atom primitive types in the data-type graph using register-custom-type
-
-
-;Subtype relations betweem the above
-;pos is a subtype of nat (Note the direction)
-(defdata-subtype pos nat)
-
-;nat is a subtype of integer
-(defdata-subtype nat integer)
-(defdata-subtype neg integer)
-(defdata-subtype integer rational)
-(defdata-subtype positive-ratio rational)
-(defdata-subtype positive-rational rational) ;Aug 18 2011
-(defdata-subtype negative-ratio rational)
-(defdata-subtype negative-rational rational) ;Aug 18 2011
-(defdata-subtype complex-rational acl2-number)
-(defdata-subtype rational acl2-number)
-(defdata-subtype acl2-number atom)
-(defdata-subtype boolean symbol)
-(defdata-subtype character atom)
-(defdata-subtype string atom)
-(defdata-subtype symbol atom)
-
-;(assign make-event-debug t)
-;(set-acl2s-defdata-verbose t)
-
-;Disjoint relations between the above types
-(defdata-disjoint acl2-number character)
-(defdata-disjoint acl2-number symbol)
-(defdata-disjoint character string)
-(defdata-disjoint character symbol)
-(defdata-disjoint string symbol)
-
-;(assign make-event-debug t)
-;lists of atoms
-(defthm termination-tree-enum-cdr
-  (implies (consp x)
-           (and (< (acl2-count (cdr x))
-                   (acl2-count x))
-                (< (acl2-count (car x))
-                   (acl2-count x)))))
-(defthm termination-tree-enum-dec
-  (implies (< (acl2-count x1) (acl2-count x2))
-           (and (< (acl2-count (car x1)) (acl2-count x2))
-                (< (acl2-count (cdr x1)) (acl2-count x2)))))
-(defthm terminination-tree-enum-nth
-  (<= (acl2-count (nth i x))
-              (acl2-count x))
-  :rule-classes (:rewrite :linear))
-
-(defthm termination-tree-enum-dec2
-  (implies (< (acl2-count x1) (acl2-count x2))
-           (< (acl2-count (nth i x1)) (acl2-count x2)))
-  :hints (("Goal" :in-theory (disable nth))))
-
-
-; harshrc Sep 3rd 2012
-; declare-guards T means that enumerators will be generated with
-; :guard (natp x). Note that now on, all predicates generated have
-; :guard T 
-(defdata nat-list (listof nat) :declare-guards t) 
-(verify-termination pos-listp) ; pos-listp is in program mode, so we need this.
-(verify-guards pos-listp)
-(defdata    pos-list (listof pos) :declare-guards t)
-(defdata    integer-list (listof integer) :declare-guards t)
-(defdata    rational-list (listof rational) :declare-guards t)
-(defdata    complex-rational-list (listof complex-rational) :declare-guards t)
-(defdata acl2-number-list (listof acl2-number) :declare-guards t)
-(defdata boolean-list (listof boolean) :declare-guards t)
-(defdata symbol-list    (listof symbol) :declare-guards t)
-(register-custom-type character-list t nth-character-list  character-listp)
-(defdata string-list (listof string) :declare-guards t)
-(verify-termination atom-listp)
-(defdata atom-list (listof atom) :declare-guards t)
-
-(defdata-subtype pos-list nat-list)
-(defdata-subtype nat-list integer-list)
-(defdata-subtype integer-list rational-list)
-(defdata-subtype complex-rational-list acl2-number-list)
-(defdata-subtype rational-list acl2-number-list )
-(defdata-subtype acl2-number-list atom-list)
-(defdata-subtype boolean-list symbol-list)
-(defdata-subtype character-list atom-list)
-(defdata-subtype string-list atom-list)
-(defdata-subtype symbol-list atom-list)
-
-
-;cons
-(defdata cons-atom (cons atom atom) :declare-guards t)
-(defdata-disjoint cons-atom atom)
-
-
-(defdata cons-ca-ca (cons cons-atom cons-atom) :declare-guards t)           
-(defdata cons-cca-cca (cons cons-ca-ca cons-ca-ca) :declare-guards t)
-
-;TODO.NOTE: Note that all the enumerators defined below are purely heuristic and 
-;are not consistent/complete with their respective predicates.
-
-(defun nth-all (n)
-  (declare (xargs :guard (natp n) ))
-                  ;;:verify-guards nil))
-  (b* (((mv choice seed)
-        (defdata::weighted-switch-nat 
-          '(1  ;nil
-            1  ;t
-            1 ;0
-            1 ;integer
-            1  ;bool
-            1  ;charlist
-            1  ;sym
-            1  ;string
-            2  ;char
-            1  ;acl2-num
-            5 ;rational
-            5 ;nat
-            5 ;pos
-            5  ;rational-list
-            2  ;sym-list
-            20 ;cons-atom
-            5  ;nat-list
-            10  ;cons-cons-atom
-            1  ;stringlist
-            10  ;atom-list
-            ) n)))
-      
-    (case choice
-          (0 'nil)
-          (1 't)
-          (2 0)
-          (3 (nth-integer-testing seed))
-          (4 (nth (mod seed 2) *boolean-values*))
-          (5 (nth-character-list seed))
-          (6 (nth-symbol seed))
-          (7 (nth-string seed))
-          (8 (nth (mod seed (len *character-values*)) *character-values*))
-          (9 (nth-acl2-number seed))
-          (10 (nth-rational seed))
-          (11 (nth-nat-testing seed))
-          (12 (nth-pos-testing seed))
-          (13 (nth-rational-list seed))
-          (14 (nth-symbol-list seed))
-          (15 (nth-cons-atom seed))
-          (16 (nth-nat-list seed))
-          (17 (nth-cons-ca-ca seed))
-          (18 (nth-string-list seed))
-          (19 (nth-atom-list seed))
-          (t 'nil)))) ;this case should not come up
-
-
-(register-custom-type all t nth-all  allp)
-
-
-;We will also name a special type, the empty type, which has no elements in its typeset.
-(defconst *empty-values* '())
-;TODO - if type is already registered, then we should be able to pick the predicate
-;from the table instead of syntactically from the type.
-(defun emptyp (x)
-  (declare (ignore x) (xargs :guard t))
-  nil)
-(register-custom-type empty 0 *empty-values*  emptyp)
-;NOTE: empty is a special type, so we treat it specially and seperately, rather than the
-;usual way of going through the data type graph, and it might lead to inconsistency
-;with the ACL2 axioms about datatypes.
-
-(defdata cons (cons all all) :declare-guards t)
-(defdata list (oneof cons nil) :declare-guards t)
-
-(DEFUNS (NTH-TRUE-LIST
-               (X)
-               (DECLARE (XARGS :MEASURE (NFIX X)))
-               (IF (OR (NOT (INTEGERP X)) (< X 1))
-                   'NIL
-                   (LET ((X (- X 1)))
-                        (LET ((INFXLST (DEFDATA::SPLIT-NAT 2 X)))
-                             (CONS (LET ((X (NTH 0 INFXLST))) (NTH-ALL X))
-                                   (LET ((X (NTH 1 INFXLST)))
-                                        (NTH-TRUE-LIST X))))))))
-(register-custom-type true-list t nth-true-list true-listp)
-
-(defdata-subtype cons all)
-(defdata-subtype atom all)
-(defdata-subtype atom-list true-list)
-(defdata-subtype true-list all)
-(defdata-subtype list all)
-
-(defun all-but-zero-nil-tp (x)
-  (declare (xargs :guard t))
-  (and (not (equal x 0))
-       (not (equal x 't))
-       (not (equal x 'nil))))
-            
-(defun nth-all-but-zero-nil-t (n)
-  (declare (xargs :guard (natp n)))
-  (b* (((mv choice seed)
-          (defdata::weighted-switch-nat 
-            '(1 ;integer
-              1  ;charlist
-              1  ;sym
-              1  ;string
-              2  ;char
-              1  ;pos
-              5 ;positive-ratio
-              5 ;negative-ratio
-              5 ;complex-rational
-              5  ;rational-list
-              2  ;sym-list
-              20 ;cons-atom
-              5  ;nat-list
-              10  ;cons-cons-atom
-              1  ;stringlist
-              10  ;atom-list
-              ) n)))
-    
-    (case choice
-          (0 (nth-integer-testing seed))
-          (1 (nth-character-list seed))
-          (2 (nth-symbol seed))
-          (3 (nth-string seed))
-          (4 (nth (mod seed (len *character-values*)) *character-values*))
-          (5 (nth-pos-testing seed))
-          (6 (nth-positive-ratio seed))
-          (7 (nth-negative-ratio seed))
-          (8 (nth-complex-rational seed))
-          (9 (nth-rational-list seed))
-          (10 (nth-symbol-list seed))
-          (11 (nth-cons-atom seed))
-          (12 (nth-nat-list seed))
-          (13 (nth-cons-ca-ca seed))
-          (14 (nth-string-list seed))
-          (15 (nth-atom-list seed))
-          (t 1))))
-
-(register-custom-type all-but-zero-nil-t t nth-all-but-zero-nil-t  all-but-zero-nil-tp)
-
-(defdata-subtype all-but-zero-nil-t all)
-
-(defdata cons-cccca-cccca (cons cons-cca-cca cons-cca-cca) :declare-guards t)
-(defdata cons-a-ca (cons atom cons-atom) :declare-guards t)
-(defdata cons-a-cca (cons atom cons-ca-ca) :declare-guards t)
-(defdata cons-a-cccca (cons atom cons-cca-cca) :declare-guards t)
-(defdata cons-ca-cca (cons cons-atom cons-ca-ca) :declare-guards t)
-(defdata cons-ca-cccca (cons cons-atom cons-cca-cca) :declare-guards t)
-(verify-guards allp)
-(defdata cons-all-all-but-zero-nil-t (cons all all-but-zero-nil-t) :declare-guards t)
-
-(defun nth-improper-cons (n)
-  ;(declare (xargs :guard (natp n)))
-                  
-  (b* (((mv choice seed)
-        (defdata::weighted-switch-nat 
-          '(
-            1  ;cons-all-all-but-zero-nil-t
-            1  ;cons-ca-ca
-            1  ;cons-a-ca
-            1  ;cons-a-cca
-            1  ;cons-a-cccca
-            1  ;cons-cccca-cccca
-            1  ;cons-ca-cca
-            1  ;cons-ca-cccca
-            ) n)))
-    
-    (case choice
-      (0 (nth-cons-all-all-but-zero-nil-t seed))
-      (1 (nth-cons-ca-ca seed))
-      (2 (nth-cons-a-ca seed))
-      (3 (nth-cons-a-cca seed))
-      (4 (nth-cons-a-cccca seed))
-      (5 (nth-cons-cccca-cccca seed))
-      (6 (nth-cons-ca-cca seed))
-      (7 (nth-cons-ca-cccca seed))
-      (t '(1 . 2)))))
-
-(register-custom-type improper-cons t nth-improper-cons  improper-consp)
-
-(defdata-subtype improper-cons cons)
-
-(defdata list-aaaall (list atom atom atom all) :declare-guards t)
-
-(defdata list-a-ca (list atom cons-atom) :declare-guards t)
-(defdata list-aa-ca (list atom atom atom cons-atom) :declare-guards t)
-(defdata list-aa-cca (list atom atom cons-ca-ca) :declare-guards t)
-(defdata list-aaaa-cccca (list cons-atom cons-cca-cca) :declare-guards t)
-(defdata list-ca-cca (list cons-atom cons-ca-ca) :declare-guards t)
-(defdata list-ca-cccca (list cons-atom cons-cca-cca) :declare-guards t)
-(defdata list-cccca-cccca (list cons-cca-cca cons-cca-cca) :declare-guards t)
-
-;MAJOR CHANGE June 6th 2010, now we have no guards in any enumerators
-(defun nth-proper-cons (n)
-  ;(declare (xargs :guard (natp n)))
-                  
-  (b* (((mv choice seed)
-        (defdata::weighted-switch-nat 
-          '(
-            1  ;list-aaaall
-            1  ;list-a-ca
-            1  ;list-aa-ca 
-            1  ;list-aa-cca
-            1  ;list-aaaa-cccca
-            1  ;list-ca-cca
-            1  ;list-ca-cccca
-            1  ;list-cccca-cccca
-            ) n)))
-
-    (case choice
-      (0 (nth-list-aaaall seed))
-      (1 (nth-list-a-ca seed))
-      (2 (nth-list-aa-ca  seed))
-      (3 (nth-list-aa-cca seed))
-      (4 (nth-list-aaaa-cccca seed))
-      (5 (nth-list-ca-cca seed))
-      (6 (nth-list-ca-cccca seed))
-      (7 (nth-list-cccca-cccca seed))
-      (t '(1  2)))))
-
-(register-custom-type proper-cons t nth-proper-cons  proper-consp)
-(defdata-subtype proper-cons cons)
-
-;this was missing before and so we werent inferring proper-consp when
-;type-alist knew both true-listp and proper-consp, and this is common in ACL2
-(defdata-subtype proper-cons  true-list)
-
-(defdata ratio (oneof positive-ratio negative-ratio) :declare-guards t)
-
-(defdata-disjoint proper-cons improper-cons)
-(defdata-disjoint atom cons)
-(defdata-subtype ratio rational) 
-
-
-;new exports
-(defmacro disjoint-p (T1 T2)
-   ":Doc-Section DATA-DEFINITIONS
-  query wether two types are disjoint~/
-  ~c[(disjoint-p T1 T2)] asks the question
-  are T1, T2 disjoint? This call makes a quick
-  lookup into the internal data type graph where
-  disjoint relation information provided by the user
-  in the past is stored and used to compute the
-  disjoint relation closure. If they are pairwise
-  disjoint (according to the computed information)
-  then we get back an affirmative , i.e ~c[t]. otherwise
-  it returns ~c[nil].
-  
-  ~bv[]
-  Examples:
-  (disjoint-p cons list)
-  (disjoint-p pos acl2-number)
-  (disjoint-p integer complex)
-  ~ev[]                      
-  ~bv[]
-  Usage:
-  (disjoint-p <Type-name1> <Type-name2>)
-  ~ev[]~/
-  "
-  `(is-disjoint ',T1 ',T2 (w state)))
-
-
-(defmacro show-acl2s-defdata-all-types ()
-  `(table-alist 'defdata::types-info-table (w state)))
-
-(defmacro subtype-p (T1 T2)
-   ":Doc-Section DATA-DEFINITIONS
-  query wether two types are disjoint~/
-  ~c[(subtype-p T1 T2)] asks the question
-  is T1 a subtype of T2? This call makes a quick
-  lookup into the internal data type graph where
-  subtype relation information provided by the user
-  in the past is stored and used to compute the
-  subtype relation closure. If T1 is indeed a subtype
-  of T2 (according to the computed information)
-  then we get back an affirmative , i.e ~c[t]. otherwise
-  it returns ~c[nil].
-  
-  ~bv[]
-  Examples:
-  (subtype-p boolean atom)
-  (subtype-p character string)
-  (subtype-p list cons)
-  ~ev[]                      
-  ~bv[]
-  Usage:
-  (subtype-p <Type-name1> <Type-name2>)
-  ~ev[]~/
-  "
-  `(is-subtype ',T1 ',T2 (w state)))#|ACL2s-ToDo-Line|#
-
diff -Nru acl2-6.2/books/countereg-gen/basis.lisp acl2-6.3/books/countereg-gen/basis.lisp
--- acl2-6.2/books/countereg-gen/basis.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/basis.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,653 +0,0 @@
-#|$ACL2s-Preamble$;
-
-
-;;;;naming convention (only for readability):
-;;;;  function: end with $ for each stobj updating/creating function
-;;;;            end with % for each defrec updating/creating function
-;;;;            end with . for each update, action-object naming with each
-;;;;                argument (except stobjs) thats updated ending with a dot
-;;;;            end with -p for bool-returning fns (except defdata type pred which end in p)
-;;;;            use object-property/attribute naming convention for Read-only
-;;;;  variable: end with $ is a stobj.
-;;;;            end with % is a defrec.
-;;;;            i,j,k are integers or naturals
-;;;;            m,n,idx,ctr are naturals or pos
-;;;;            f,g,h are functions
-;;;;            e,x,y,z,s,t are elements of lists/sets
-;;;;            L,X,Y,Z,xs,ys,zs,S,T are lists/sets
-;;;;            P,Q,R is a alist (pairs alist)
-;;;;            A,B,C are doublet-lists (2 element lists)
-;;;;            G is a graph adj list
-;;;;            D,H is a dictionary/hashtable
-;;;;            K is keyword value list
-;;;;            suffix A_1 indicates A1 is the first argument
-;;;;            A~ is sometimes used to denote a modified A, but
-;;;;              sometimes I use A1, A2, ideally I would like to use
-;;;;              A', A'', to denote such things, but Sedan doesnt
-;;;;              like this syntax, I shud check CLTL
-
-;;;; Discipline/Style:
-;;;;    1. return signatures: * > (mv fixnum *) > (mv * *) > (mv erp * state)
-;;;;       > (mv erp * state stobj_1 stobj_2 stobj_3 ...)
-;;;;       and so on where stobj_i were introduced in chronological order
-;;;;    2. integers are always fixnumed if possible
-;;;;    3. guards carry atleast type information and are stored
-;;;;    4. return types also stored for each function.
-;;;;    5. try to provide (declare (type ...)) automatically
-;;;;    6. if state appears, then wrld shud be the name of the arg
-;;;;    preceding it and shud be the current-acl2-world at the point
-;;;;    of call.
-;;;;    7. Use defattach to hide a decision and provide flexibility
-;;;;  X 8. Use defattach to hide implementation and versions, this way
-;;;;       I can release a new version of ACL2s without requiring a new
-;;;;       ACL2 build, which will be required once these books are moved
-;;;;       to acl2-books repository.
-;;;;    9. Maintain a table with signatures of each function
-;;;;       introduced and if possible of those ACL2 functions (primitives)
-;;;;       used by the introduced functions.
-;;;;    10. Use list comprehension syntax and function arguments " as "
-;;;;        syntax using || trick.
-;;;;    11. Use nested helper functions with f* syntax (note that f*
-;;;;        is not a macro).
-;;;;    12. Use anonymous functions only inside list comprehensions and
-;;;;        all maps and filters are to be used only via LC syntax.
-;;;;    13. All the above fancy stuff is to be done within the def
-;;;;        macro, dont modify b* which can be nested. Thus we are
-;;;;        assured of the top-level variable-free scope in which we
-;;;;        apply our synatx customization.
-
-;;;;debug/print,trace,stats/log
-
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book t);$ACL2s-Preamble$|#
-
-(in-package "DEFDATA")
-
-(include-book "tools/bstar" :dir :system)
-
-;========================Function Metadata table <=======================
-; This table stores metadata about the functions introduced using def in
-; our testing framework. We will also populate the data for each ACL2
-; function the framework uses. Henceforth the testing framework will simply
-; be referred to as "mu-lam", which stands for "The model-theoritic (mu)
-; path/way (lam)" and is
-; to be used in conjunction or merged with "tau", the monadic predicate
-; "types" book written by J Moore. This table stores properties of the
-; introduced functions just like world, so perhaps this too will be folded
-; into the acl2 world. The following defrec will explain these properties.
-
-; input-arg-types is a list of types (monadic predicates). Ideally,
-; they will be found in defdata::types-table.
-; output-arg-type is either a type or a list of types starting with mv
-(defrec type-sig% (input-arg-types . output-arg-type) T)
-
-(defun type-sig%-p (v)
-  (declare (xargs :guard T))
-  (case-match v
-    ((input-arg-typs . output-arg-type) (and (symbol-listp input-arg-typs)
-                                             (or (symbolp output-arg-type)
-                                                 ;; or mv type
-                                                 (and (consp output-arg-type)
-                                                      (eq 'mv (car output-arg-type))
-                                                      (symbol-listp output-arg-type)))))))
-
-(defrec def-metadata% 
-  (actual-name  ;name of currently attached  actual defun
-                ; of type: symbolp (UNUSED)
-   call-name    ;subtitute key (visible name) with this name
-                ; when calling this function (UNUSED)
-                ; of type: symbolp
-   ;mult         ;multiplicity i.e. number of arguments of the actual defun
-   type-sig     ;type signature of the actual function
-                ; of type: (type-sigp x)
-   mode         ;of type: (in :program :logic)
-   inline?      ;of type: Boolean
-   trace        
-;;; nil  -> this function wont be traced
-;;; t    -> this function will be traced on system-debug flag
-;;; spec -> see trace$ for form of spec, fun will be traced on system-debug
-;;; 
-   )
-  T);unTAGGED defrec
-
-(defun def-metadata%-p (v)
-  (declare (xargs :guard T))
-  (case-match v
-    ((an cn tsig m inline? trace)  (and (symbolp an)
-                                        (symbolp cn)
-                                        (type-sig%-p tsig)
-                                        (member-eq m '(:program :logic))
-                                        (booleanp inline?)
-;TODO - extend to trace specs
-                                        (booleanp trace)))))
-
-
-                                 
-  
-
-; A table storing properties associated with a def (key)
-; Keys are the visible names of the def functions
-; Values are of shape def-metadata record defined above
-; The table is populated at compile time, i.e at the time when def events
-; are submitted to acl2. Once all def events have been submitted, this
-; table is read-only.
-(table def-metadata-table nil nil :guard (and (symbolp key)
-                                              (def-metadata%-p val)))
-
-;========================Function Metadata table >=======================
-
-
-(defmacro def  (&rest def)     `(make-event (defs-fn (list ',def) 
-                                              '() '()  'def (w state) state)))
-
-(defmacro defs (&rest def-lst) `(make-event (defs-fn ',def-lst
-                                              '() '()  'defs (w state) state)))
-
-(defun triplelis$ (xs ys zs)
-  "similar to pairlis$, except now we have 3 lists to zip
-  == [(cons x (cons y z)) | x in xs, y in ys, z in zs]"
-  (declare (xargs :guard (and (true-listp xs)
-                              (true-listp ys)
-                              (true-listp zs)
-                              (= (len xs) (len ys))
-                              (= (len xs) (len zs)))))
-  (if (endp xs)
-      '()
-    (cons (cons (car xs)
-                (cons (car ys)
-                      (car zs)))
-          (triplelis$ (cdr xs) (cdr ys) (cdr zs)))))
-
-(defun str/sym-listp (x)
-  (declare (xargs :guard T))
-  (if (atom x)
-    (null x)
-    (and (or (stringp (car x)) (symbolp (car x)))
-         (str/sym-listp (cdr x)))))
-    
-  
-;;; foll 2 funs adapted from cutil/deflist.lisp 
-(defun concatenate-names (x)
-  (declare (xargs :guard (str/sym-listp x)))
-  (if (consp x)
-      (acl2::concatenate 'string
-                         (if (symbolp (car x))
-                             (symbol-name (car x))
-                           (car x))
-                         (concatenate-names (cdr x)))
-    ""))
-(defthm concatenate-names-is-stringp
-  (stringp (concatenate-names x)))
-
-(in-theory (disable concatenate-names))
-
-;;; mksym-package-symbol will be captured by calling lexical environment
-(defmacro mksym (&rest args)
-  "given a sequence of symbols or strings as args, 
-   it returns the concatenated symbol"
-  `(intern-in-package-of-symbol
-    (concatenate-names (list ,@args))
-    mksym-ps));mksym-package-symbol
-
-;;-- create a new symbol with prefix or suffix appended
-;;-- if its a common-lisp symbol then attach acl2 package name to it
-;;-- example:
-;;-- (modify-symbol "NTH-" 'bool "") ==> NTH-BOOL
-;;-- (modify-symbol "NTH-" 'boolean "") ==> ACL2::NTH-BOOLEAN
-(defun modify-symbol (prefix sym postfix)
-  (declare (xargs :guard (and (symbolp sym)
-                              (stringp postfix)
-                              (stringp prefix))))
-  (let* ((name (symbol-name sym))
-         (name (string-append prefix name))
-         (name (string-append name postfix)))
-    (if (member-eq sym *common-lisp-symbols-from-main-lisp-package*)
-      (intern-in-package-of-symbol name 'acl2::acl2-pkg-witness)
-      (intern-in-package-of-symbol name sym))))
-
-(defun modify-symbol-lst (prefix syms postfix)
-  (declare (xargs :guard (and (symbol-listp syms)
-                              (stringp prefix)
-                             (stringp postfix))))
-  (if (endp syms)
-    nil
-    (cons (modify-symbol prefix (car syms) postfix)
-          (modify-symbol-lst prefix (cdr syms) postfix))))
-
-
-(defthm modified-symbol-satisfies-symbolp
-         (implies (and (symbolp sym)
-                       (stringp pre)
-                      (stringp post))
-                  (symbolp (modify-symbol pre sym post)))
-         :rule-classes :type-prescription)
-
-(in-theory (disable modify-symbol))
-(defthm modified-symbol-lst-satisfies-symbol-listp
-         (implies (and (symbol-listp syms)
-                      (stringp pre)
-                       (stringp post))
-                  (symbol-listp (modify-symbol-lst pre syms post)))
-         :rule-classes (:rewrite :type-prescription))
-(defthm modified-symbol-lst-len
-  (= (len (modify-symbol-lst pre syms post))
-     (len syms)))
-   
-(in-theory (disable modify-symbol-lst))
-
-
-;most functions are taken from either the COI books or rtl radix book
-(defthm character-listp-explode-nonnegative-integerp                            
-  (implies
-   (character-listp list)
-   (character-listp (explode-nonnegative-integer number 10 list))))
-
-;Convert a string|symbol|integer to a string, all other are coerced to ""
-(defund to-string (entry)
-  (declare (type t entry))
-  (cond
-   ((symbolp entry) (symbol-name entry))
-   ((integerp entry)
-    (if (<= 0 entry)
-        (coerce (explode-nonnegative-integer entry 10 nil) 'acl2::string)
-      (acl2::concatenate 'acl2::string "-"
-                   (coerce (explode-nonnegative-integer (- entry) 10 nil) 'acl2::string))))
-   ((stringp entry) entry)
-   (t "")))
-
-
-(defun fn-p (x)
-  (declare (xargs :guard t))
-  (and (consp x)
-       (symbolp (first x))
-       (consp (cdr x))
-       (symbol-listp (second x))
-       (consp (cddr x))))
-
-(defun fn-list-p (x)
-  (declare (xargs :guard t))
-  (if (consp x)
-    (and (fn-p (car x))
-         (fn-list-p (cdr x)))
-    (equal x '())))
-   
-(defthm strip-cars-doesnt-change-length
-  (implies (true-listp xs)
-           (= (len (strip-cars xs))
-                   (len xs))))
-
-(defthm strip-cdrs-doesnt-change-length
-   (implies (true-listp xs)
-            (= (len (strip-cdrs xs))
-               (len xs))))
-        
-;; this shud be taken care automatically by some type-relationship inference algo
-(defthm fn-list-p-implies-alistp
-  (implies (fn-list-p fns)
-           (alistp fns))
-  :rule-classes :forward-chaining)
-
-(defthm fn-list-p-strip-cars-is-symbol-listp
-  (implies (fn-list-p fns)
-           (symbol-listp (strip-cars fns)))
-  :rule-classes (:rewrite :forward-chaining))
-
-(defthm true-listp-of-make-list-ac
-  (equal (true-listp (make-list-ac n val ac))
-         (true-listp ac))
-  :rule-classes ((:rewrite)
-                 (:type-prescription
-                  :corollary
-                  (implies (true-listp ac)
-                           (true-listp (make-list-ac n val ac))))))
-(defthm len-of-make-list-ac
-  (implies (natp n)
-           (equal (len (make-list-ac n val ac))
-                  (+ n (len ac)))))
-
-(defthm pairlis$-eqlable-symbol-lists
-  (implies (and (symbol-listp xs)
-                (symbol-listp ys))
-           (eqlable-alistp (pairlis$ xs ys))))
-  ;:rule-classes :forward-chaining)
-(in-theory (disable pairlis$))
-#| add to test regression, there is a bug in the following guard conjecture
-(IMPLIES
- (AND (SYMBOLP NM) (FN-LIST-P FNS))
- (LET
-  ((MKSYM-PS NM))
-  (AND
-   (STR/SYM-LISTP (LIST "_" NM))
-   (SYMBOLP MKSYM-PS)
-   (LET
-    ((PREFIX (INTERN-IN-PACKAGE-OF-SYMBOL (CONCATENATE-NAMES (LIST "_" NM))
-                                          MKSYM-PS)))
-    (AND
-     (ALISTP FNS)
-     (LET
-      ((OLD-NAMES (STRIP-CARS FNS)))
-      (AND
-       (SYMBOL-LISTP OLD-NAMES)
-       (STRINGP PREFIX)
-       (LET
-        ((NEW-NAMES (MODIFY-SYMBOL-LST PREFIX OLD-NAMES "")))
-        (AND
-         (INTEGERP (LEN FNS))
-         (<= 0 (LEN FNS))
-         (ALISTP FNS)
-         (EQUAL (LEN (MAKE-LIST-AC (LEN FNS) 'DEFABBREV NIL))
-                (LEN (STRIP-CDRS FNS)))
-         (TRUE-LISTP (STRIP-CDRS FNS))
-         (TRUE-LISTP NEW-NAMES)
-         (EQUAL (LEN (MAKE-LIST-AC (LEN FNS) 'DEFABBREV NIL))
-                (LEN NEW-NAMES))
-         (LET
-             NIL
-             (AND (TRUE-LISTP OLD-NAMES)
-                  (TRUE-LISTP NEW-NAMES)
-                  (EQLABLE-ALISTP (PAIRLIS$ OLD-NAMES NEW-NAMES)))))))))))))
-|#
-
-(defun mk-f*-events (fns nm)
-  "for given functions return defabbrev events and a substitution
-   mapping original names to inlined actual defabbrev names"
-  (declare (xargs :guard (and (fn-list-p fns)
-                              (symbolp nm))))
-  ;;we need to satisfy some invariants for avoiding bugs (especially
-  ;;unwanted variable capture - TODO
-  (b*  ((mksym-ps    nm) ;for use in macro mksym
-        (prefix      (mksym "_" nm))
-        (old-names   (strip-cars fns))
-        (new-names   (modify-symbol-lst (symbol-name prefix) old-names ""))
-        (def-events  (triplelis$ (make-list (len fns) 
-                                   :initial-element 'defabbrev)
-                                 new-names
-                                 (strip-cdrs fns)))
-        (P           (pairlis$ old-names new-names))
-        (def-events~ (sublis P def-events))) ;possible variable capture
-   ;;in
-   (mv def-events~ P)))
-                        
-
-  (defconst   *stobjs* '(state ts$))            
-    
-(defun mk-declare (K)
-  (declare (xargs :guard (and (keyword-value-listp K)
-                              ;;phew how ugly is this guard. u make code pretty with b* and u lose with guards
-                              (assoc-keyword :sig K)
-                              (equal :sig (car (assoc-keyword :sig K)))
-                              (true-listp (cadr (assoc-keyword :sig K)))
-                              (= 3 (len (cadr (assoc-keyword :sig K))))
-                              (true-listp (caadr (assoc-keyword :sig K))))))
-  "?: make a declare form from the fields of decl keyword value list "
-  (b* (
-       ((list & mode)     (or (assoc-keyword :mode K)
-                                    '(:mode :logic)))
-;:sig ((state ts$) -> (mv erp (oneof -1 boolean) state ts$)))
-      (`(:sig (,in & &)) (assoc-keyword :sig K))
-       (stobjs           (intersection-eq *stobjs* in)))
-  `(declare (xargs :mode ,mode
-                   :stobjs ,stobjs))))
-              
-(set-verify-guards-eagerness 0) 
-
-
-(defun trans-body (B nm)
-  "translate body, by making defun events for each f* binding"  
-  (declare (xargs :guard (and (symbolp nm)
-                             )))
-  #||
-  (f* ((double (x) (* 2 x))
-         (sq (y) (* y y))
-         (ntimes (x) (* n x))) ;capture n from surrounding context
-    body)
-  ==>
-  (mv 
-   ((defabbrev _nm-double (x) (* 2 x))
-    (defabbrev _nm-sq (y) (* y y))
-    (defabbrev _nm-ntimes (x) (* n x)))
-   body')
-  where body' = body[subst real names of introduced inline functions]
-||#
-  
-  (case-match B 
-    (('f* fns body)   (b* (((mv evts P) (mk-f*-events fns nm))
-                             (body~       (sublis P body)))
-                         (mv evts body~)))
-    ;;ignore otherwise
-    (&                  (mv nil B))))
-
-           
-  
-(defun trans-arglist (A )
-  (declare (xargs :guard (and (true-listp A)
-                             
-                              )))
-  "not implemented at the moment i.e noop"
-; (|x as (list a b ...)| x2 x3 
-;  |ts$ as {curr-subgoal-idx, cur-run-idx, ...}|)
-;  =>
-;  (mv (X X2 X3 TS$)
-;      (((list a b . &) x)
-;       (curr-run-idx (cur-run-idx ts$))
-;       (curr-subgoal-idx (curr-subgoal-idx ts$)))
-  (mv A nil))
-
-(deflabel f*)
-
-
-
-(defconst   *acl2s-version* "1.0.2.1")
-
-(defun def-fn1 (name arglist decl-kv-list decls body ctx wrld state)
-  (declare (ignorable wrld state))
-  (declare (xargs :stobjs (state)
-                  :guard (and (symbolp name)
-                              (symbolp ctx)
-                              (true-listp arglist)
-                              (keyword-value-listp decl-kv-list)
-                              (true-listp decls)
-                              (plist-worldp wrld))))
-  
-  (let ((K decl-kv-list)
-        (A arglist)
-        (B body))
-  ;;in
-   (b* (((unless (keyword-value-listp K))
-        (er hard ctx "~|~x0 is not a keyword value list.~%" K))
-       ((unless (assoc-keyword :sig K))
-        (er hard ctx "~|:sig not found in ~x0.~%" K))
-; make a declaration form
-       (decl (mk-declare K)) 
-; get doc string
-       ((list & doc) (or (assoc-keyword :doc K) '(:doc "n/a")))
-       
-; translate arglist to get the actual arglist and a list of b* bindings
-       ((mv A1 b*-bindings) (trans-arglist A))
-; translate body to get events for nested defuns and actual body
-       ((mv aux-events B~)  (trans-body B name))
-       (B~1 (if b*-bindings
-                `(b* ,b*-bindings B~)
-              B~)))
-    ;;in
-    (list aux-events `(,name ,A1 ,doc ,@(cons decl decls) ,B~1)))))
- 
-(defun def-fn (def ctx wrld state)
-  (declare (ignorable wrld state))
-  (declare (xargs :stobjs (state)
-                  :guard (and (symbolp ctx)
-                              (plist-worldp wrld))))
-  (case-match def
-    ((nm A ('decl . K) ('declare . ds) B)
-     ;; =>
-     (def-fn1 nm A K (list (cons 'declare ds)) B ctx wrld state))
-    
-    ((nm A ('decl . K) B)
-     ;; =>
-     (def-fn1 nm A K '() B ctx wrld state))
-    
-    (& (er hard ctx "~|Ill-formed def form. ~
-General form: ~
-(def name arglist decl [decl] body)~%"))))
-
-(defun defs-fn (def-lst aux-events. defuns-tuples. ctx wrld state)
-  "my own defun for storing type metadata for later type-checking.
-1. possible nested (local) defuns
-2. list comprehensions
-3. destructuring arg list"
-;;; accumulate the list of event forms to be submitted in ans. parameter
-  (declare (xargs :stobjs (state)
-                  :guard (and (true-listp def-lst)
-                              (true-listp aux-events.)
-                              (symbolp ctx)
-                              (plist-worldp wrld))))
-  (if (endp def-lst)
-      `(progn ,@aux-events. 
-              ,(if (null (cdr defuns-tuples.));singleton
-                   `(defun . ,(car defuns-tuples.))
-                 `(defuns . ,defuns-tuples.)))
-    ;;else
-    (b* (((list ae def-tuple);ae: aux-events
-           (def-fn (first def-lst) ctx wrld state)))
-     
-      (defs-fn (rest def-lst)
-               (append ae aux-events.)
-               (append defuns-tuples. (list def-tuple)) ctx wrld state))))
-
-
-(defconst   *primitives*
-  '(+f   *f   |1+f|   =  |1-f|   -f   /=  <=  <  >  >=
-    plus-mod-m31 double-mod-m31 times-expt-2-16-mod-m31 times-mod-m31
-    mod mod^ floor floor^ expt expt^
-    min min^ max max^
-    logand logand^ logior logior^
-    lognot lognot^ logxor logxor^
-    ash ash^
-    mask^ mv mv^ my-fixnum the-fixnum
-    er er0 prog2$ cw ev-fncall-w
-    fn-count-evg lexorder
-    if not implies and or iff
-    acl2-numberp rationalp integerp consp 
-    characterp symbolp stringp
-    booleanp termp keywordp
-    true-listp symbol-listp
-    cons null atom endp list list* push-lemma
-    car cdr caar cdar cadr cddr cadar
-    first second third fourth fifth
-    sixth seventh eighth ninth tenth
-    rest last butlast nth nthcdr update-nth
-    append length reverse revappend string-append
-    acons assoc assoc-eq assoc-equal assoc-keyword
-    strip-cars strip-cdrs
-    numerator denominator realpart imagpart
-    char-code char code-char
-    symbol-name symbol-package-name
-    intern intern-in-package-of-symbol
-    symbol-append bozo
-    equal eql eq
-    member-eq member member-equal
-
-    list-lis ffnnamep subsequencep
-    legal-variable-or-constant-namep genvar collect-non-x
-    arglistp cons-term match-tests-and-binding
-    er-hard-val the-fixnum! the-signed-byte! xxxjoin xxxjoin-fixnum
-    number-of-digits lambda-body flambdap  make-lambda  make-let
-    flambda-applicationp
-    doubleton-list-p singleton-list-p ascii-code!
-    formals arity def-body program-termp equivalence-relationp
-    >=-len all->=-len strip-cadrs strip-cddrs sublis-var subcor-var
-    new-namep global-symbol symbol-doublet-listp remove1-eq pair-lis$
-    add-to-set-eq pseudo-termp all-vars ffn-symb fargs
-    translate-and-test intersectp check-vars-not-free position
-    collect-cdrs-when-car-eq restrict-alist substitute sublis
-    delete-assoc function-symbolp the 32-bit-integerp
-    32-bit-integer-listp with-live-state state-global-let*
-    integer-range-p signed-byte-p unsigned-byte-p boole$
-    make-var-lst the-mv nth-aliases fix-true-list 
-    duplicates evens odds resize-list conjoin2
-    conjoin-untranslated-terms search count our-multiple-value-prog1
-    all-calls filter-atoms unprettyify variantp free-vars-in-hyps
-    destructors  alist-to-keyword-alist
-    ;other-processes.lisp
-    sublis-expr generate-variable
-    ; tau.lisp
-    subst-var subst-var-lst
-    ))
-
-(defconst   *special-forms* 
-  '(b* let mv-let cond case case-match defabbrev defun defmacro
-    ))
-
-
-
-
-; NOTE on what is stored in the acl2 world for 
-; Functions
-; in Raw lisp do the following
-#||
-(get 'acl2::binary-append *current-acl2-world-key*)
-==>
-((COARSENINGS NIL) 
- 
- (RUNIC-MAPPING-PAIRS ((620 :DEFINITION BINARY-APPEND) 
-                       (621 :EXECUTABLE-COUNTERPART BINARY-APPEND)
-                       (622 :TYPE-PRESCRIPTION BINARY-APPEND)
-                       (623 :INDUCTION BINARY-APPEND))) 
- (DEF-BODIES (((620 NIL IF (CONSP X) (CONS (CAR X) (BINARY-APPEND (CDR X) Y)) Y) 
-               (BINARY-APPEND)
-               (X Y)
-               (:DEFINITION BINARY-APPEND) 
-               (BINARY-APPEND T NIL)))) 
-(TYPE-PRESCRIPTIONS ...) 
-
-(CONGRUENCES NIL) 
-
-(SYMBOL-CLASS :COMMON-LISP-COMPLIANT :COMMON-LISP-COMPLIANT 
-              :ACL2-PROPERTY-UNBOUND :PROGRAM :PROGRAM) 
-
-(LEMMAS  ...)
- 
-(STOBJS-OUT (NIL) :ACL2-PROPERTY-UNBOUND (NIL)) 
-
-(FORMALS (X Y) :ACL2-PROPERTY-UNBOUND (X Y)) 
-
-(PRIMITIVE-RECURSIVE-DEFUNP T) 
-
-(LEVEL-NO 1) 
-
-(UNNORMALIZED-BODY (IF (ENDP X) Y (CONS (CAR X) (BINARY-APPEND (CDR X) Y)))) 
-
-(QUICK-BLOCK-INFO (SELF-REFLEXIVE UNCHANGING)) 
-
-(JUSTIFICATION (JUSTIFICATION (X) (NIL O-P . O<) 
-                              ((ACL2-COUNT X) MV-LIST RETURN-LAST)))
- 
-(INDUCTION-MACHINE ((TESTS-AND-CALLS ((ENDP X))) 
-                    (TESTS-AND-CALLS ((NOT (ENDP X))) 
-                                     (BINARY-APPEND (CDR X) Y)))) 
-(RECURSIVEP (BINARY-APPEND)) 
-
-(REDEFINED (:RECLASSIFYING-OVERWRITE BINARY-APPEND (X Y) (NIL NIL) (NIL))) 
-
-(ABSOLUTE-EVENT-NUMBER 6858 :ACL2-PROPERTY-UNBOUND 227) 
-(PREDEFINED T T) 
-(GUARD (TRUE-LISTP X) :ACL2-PROPERTY-UNBOUND (TRUE-LISTP X)) 
-
-(STOBJS-IN (NIL NIL) :ACL2-PROPERTY-UNBOUND (NIL NIL)))
-||#
-
-;Macros:
-#||
-(get 'acl2::append *current-acl2-world-key*)
-==>
-
-((MACRO-BODY (IF (NULL RST) 
-                 'NIL 
-                 (IF (NULL (CDR RST)) 
-                     (CAR RST) 
-                     (XXXJOIN 'BINARY-APPEND RST)))) 
- (ABSOLUTE-EVENT-NUMBER 228) 
- (PREDEFINED T) 
- (MACRO-ARGS (&REST RST)))
-||#
diff -Nru acl2-6.2/books/countereg-gen/cert.acl2 acl2-6.3/books/countereg-gen/cert.acl2
--- acl2-6.2/books/countereg-gen/cert.acl2	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/cert.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,6 +0,0 @@
-(ld "package.lsp")
-(ld "finite-set-theory/osets/sets.defpkg" :dir :system)
-;(include-book "finite-set-theory/osets/portcullis" :dir :system)
-
-; Added by Jared, justified by ACL2_COMPILE_FLG setting in Makefile
-; cert-flags: ? t :ttags :all
diff -Nru acl2-6.2/books/countereg-gen/data.lisp acl2-6.3/books/countereg-gen/data.lisp
--- acl2-6.2/books/countereg-gen/data.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/data.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,4159 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-
-;;;;Main Author: Peter Dillinger
-;;;;Extended by Harsh Raju C
-;;;;Data definition Framework (ACL2 Sedan)
-;;;;It can be used independently, but is primarily intended
-;;;;to support the TESTING framework!!
-
-(acl2::begin-book t);$ACL2s-Preamble$|#
-
-
-(in-package "DEFDATA")
-
-(include-book "utilities" :load-compiled-file :comp)
-(include-book "basis")
-(include-book "acl2s-parameter")
-(include-book "splitnat")
-(include-book "switchnat")
-
-(set-verify-guards-eagerness 2)
-
-;Introduce data definitions conveniently in ACL2
-(defdoc acl2::DATA-DEFINITIONS
-  ":Doc-Section DATA-DEFINITIONS
-  
-  A Data Definition Framework for ACL2~/
-                                
-  The Data Definition Framework supports ground ACL2
-  ~em[types] and any custom ~em[types] introduced by
-  a user. It also helps the user conveniently construct
-  enumerated, union, record and list ~em[types]. 
-  The framework is integrated with our random testing
-  framework. It also provides ways to specify subtype
-  and disjoint relations among the supported ~em[types].~/
-  
-  The ACL2 value universe is broadly divided into 5 kinds of data
-  objects. They are Numbers, Characters, Strings, Symbols and Conses
-  (Ordered Pairs). These disjoint sets serve as types for our purposes;
-  we shall call them ground data types. Although ACL2 is an ~em[untyped]
-  logic, it uses type information internally to deduce types.
-  ACL2 users provide the prover with type information by specifying
-  type  hypotheses on variables in a conjecture.
-  Note again that ACL2 is syntactically ~em[untyped], but that 
-  doesn't prevent us from having and using a notion of a type.
-  One ~st[cannot create] new ~em[types] in ACL2, in the sense
-  that one cannot create a new non-empty set of values that
-  provably extends the ACL2 value universe.  Rather, one
-  typically partitions the existing universe in potentially
-  new ways to form 'new' sets. These sets (``types'') are
-  presently characterized by just a type predicate. 
-  ~nl[]
-  The task of specifying user-defined data definitions (``types'') and supporting
-  random testing is elegantly solved by characterizing 'type' using both a 
-  type predicate and a type enumerator. 
-  ~nl[]
-  ~nl[]
-  What is a ~em[type] in our data definition framwork?
-  We say that ~c[foo] is a 'type' if there exists a predicate
-  function ~c[foop] and either a constant list of values 
-  ~c[*foo-values*] (if it's finite) or an enumerator function 
-  ~c[nth-foo] (if it's infinite) that maps natural numbers to data
-  objects that satisfy ~c[foop].  If ~em[foo] is ~st[supported]
-  by our framework, i.e. the forementioned conditions are met, then
-  the name ~em[foo] can be used in defining other types using
-  ~c[defdata].
-  ~nl[]
-  The framework supports all the ground data types and the common
-  data types present in the initial(ground) ACL2 world.
-  The framework also treats each data object in the ACL2 universe as a
-  singleton 'type', i.e. a set with just one element, the data object
-  itself. The type which represents all of the ACL2 universe is 
-  called ~c[all]; every 'type' is thus a subset of ~c[all].
-  ~nl[]
-  
-  Sophisticated users may want to define custom
-  types manually, for example to define a type which represents
-  positive multiples of 3. In ACL2 we can define such a type by the
-  following predicate:
-
- ~bv[]
- (defun pos-multiple-of-threep (v)
-  (if (posp v)
-    (equal 0 (mod v 3))
-    nil))
- ~ev[]
- In order to ~st[support] this type within our framework, all one needs to do
- is to define its enumerator, which is a bijection from the set of natural numbers
- to the set of positive multiples of 3:
- ~bv[]
- (defun nth-pos-multiple-of-three (n)
-  (if (natp n) 
-   (* 3 (1+ n))
-   3))
-  ~ev[]
-  
-  The framework provides a macro ~c[defdata] to specify combinations of
-  supported 'types', thus relieving the user of the trouble of
-  defining predicates and enumerators by hand. 'Types' allow users
-  to refer to them by name in these data definitions. One can also
-  use ~c[register-data-constructor] to introduce custom notions of
-  product data. ~c[defdata-subtype] and ~c[defdata-disjoint] are 
-  used to specify relations among supported 'types'.
-  
-  We illustrate some uses of the framework:
-  ~bv[]
-                               
-  (register-data-constructor (consp cons)
-                             ((allp car) (allp cdr))
-                             :proper t)
-                             
-  (register-custom-type nat (t nth-nat . natp))
-  
-  (defdata loi (oneof 'nil
-                      (cons integer loi)))
-                                          
-  (defdata-subtype nat rational)
-  
-  (defdata-disjoint symbol string)
-  ~ev[]
-  For more details on data-definitions framework refer ___.
-  ")
-
-
-;set verbose and printstats & only-counterexample flags
-(defmacro set-acl2s-defdata-verbose (v)
-   ":Doc-Section ACL2::DATA-DEFINITIONS
-   Control amount of output printed by defdata~/
-   By default this parameter is set to ~c[nil]. 
-   If set to ~c[t], you will see all of the output
-   generated by ACL2 and the defdata macro.
-   Recommend ~em[not] setting it, unless you want to debug
-   or want to peek into whats happening below the hood.
-   ~bv[]
-   Usage:
-   (set-acl2s-defdata-verbose nil)
-   ~ev[]~/
-   "
- `(assign acl2s-defdata-verbose ,v))
-
-;internal debug flag
-(defmacro set-acl2s-defdata-debug (v)
- `(assign acl2s-defdata-debug ,v))
-(defun get-acl2s-defdata-debug-fn (state)
-  (declare (xargs :stobjs (state)))
-  (let ((b (acl2::f-boundp-global 'acl2s-defdata-debug state)))
-    (if b
-      (acl2::f-get-global 'acl2s-defdata-debug state)
-      nil)))
-(defmacro get-acl2s-defdata-debug ()
- `(get-acl2s-defdata-debug-fn state))
-;end of internal debug flag
-
-(defconst *default-defdata-verbose* nil)
-
-(defun get-acl2s-defdata-verbose-fn (state)
-  (declare (xargs :stobjs (state)))
-  (let ((b (acl2::f-boundp-global 'acl2s-defdata-verbose state)))
-    (if b
-      (acl2::f-get-global 'acl2s-defdata-verbose state)
-      *default-defdata-verbose*)))
-
-(defmacro get-acl2s-defdata-verbose ()
-   ":Doc-Section ACL2::DATA-DEFINITIONS
-   Get the current verbosity for output printed by defdata~/
-   Returns ~c[t] if verbosity is turned on, ~c[nil] otherwise.
-   ~bv[]
-   Usage:
-   (get-acl2s-defdata-verbose)
-   ~ev[]~/
-   "
- `(get-acl2s-defdata-verbose-fn state))
-
-(defconst *default-defdata-use-guards* nil);Sep 3rd 2012
-
-(defun get-acl2s-defdata-use-guards-fn (state)
-  (declare (xargs :stobjs (state)))
-  (let ((b (acl2::f-boundp-global 'acl2s-defdata-use-guards state)))
-    (if b
-      (acl2::f-get-global 'acl2s-defdata-use-guards state)
-      *default-defdata-use-guards*)))
-
-(defmacro get-acl2s-defdata-use-guards ()
-   ":Doc-Section ACL2::DATA-DEFINITIONS
-   Get the setting for use of guards in functions generated by defdata~/
-   Returns ~c[t] if use of guards is turned on, ~c[nil] otherwise.
-   ~bv[]
-   Usage:
-   (get-acl2s-defdata-use-guards)
-   ~ev[]~/
-   "
- `(get-acl2s-defdata-use-guards-fn state))
-
-(defmacro set-acl2s-defdata-use-guards (v)
-   ":Doc-Section ACL2::DATA-DEFINITIONS
-   Use(and verify) guards in functions generated by defdata~/
-   By default this parameter is set to ~c[t]. 
-   ~bv[]
-   Usage:
-   (set-acl2s-defdata-use-guards t)
-   ~ev[]~/
-   "
- `(assign acl2s-defdata-use-guards ,v))
-
-(set-state-ok t)
-
-;------- define some useful constructors -------;
-
-#|
-(defun find-elim-rules (wrld)
-  (declare (xargs :guard (plist-worldp wrld)))
-  (if (endp wrld)
-    nil
-    (let ((trip (car wrld)))
-      (if (eq (second trip) 'eliminate-destructors-rule)
-        (cons trip (find-elim-rules (cdr wrld)))
-        (find-elim-rules (cdr wrld))))))
-
-
-(defun get-constructor-predicate-and-destructors (fn wrld)
-  (declare (xargs :guard (and (symbolp fn)
-                              (plist-worldp wrld))))
-  (if (endp wrld)
-    nil
-    (let ((trip (car wrld)))
-      (if (and (eq (second trip) 'eliminate-destructors-rule)
-               (>= (len trip) 6))
-        (let ((info (fifth trip))
-              (foo (sixth trip)))
-           (if (and (consp foo)
-                    (consp (car foo))
-                    (eq (caar foo) fn)
-                    (alistp (cdar foo)))
-             (cons
-              (if (and (consp info)
-                       (consp (car info))
-                       (consp (caar info))
-                       (symbolp (caaar info)))
-                (caaar info)
-                'allp)
-              (strip-cars (cdar foo)))
-             (get-constructor-predicate-and-destructors fn (cdr wrld))))
-        (get-constructor-predicate-and-destructors fn (cdr wrld))))))
-|#
-
-
-
-; TODO: what about well-foundedness?
-#|
-(thm (implies (consp x)
-              (and (o< (acl2-count (car x)) (acl2-count x))
-                   (o< (acl2-count (cdr x)) (acl2-count x)))))
-(default-well-founded-relation (w state))
-|#
-; nah.  doesn't imply compositions well-founded. ASK Peter!!
-
-;;-- stores information about data contructors
-;;--i.e. constructor name, cons predicate and (pred destructor) pairs, measure-fn and the foll:
-;;--flags :proper ((:proper) for proper constructors and nil otherwise)
-;eg :
-; (/    ( () rationalp ((numerator . integerp) ( denominator . posp)) . acl2-count))
-; (cons ( (:proper) consp ((car . allp) ( cdr . allp)) . acl2-count))
-;;--
-;;--completely modifed by harshrc on 27-Aug-2009 from a table to a global
-;;--CHANGED BACK to TABLE
-
-(table data-constructors nil nil :guard
-       (and ;; len >= 3 ;;--modified by harshrc
-            (consp val)
-            (consp (cdr val))
-            (consp (cddr val))
-            (let ((flags (car val))
-                  (predicate (cadr val))
-                  (dlst (caddr val))
-                  (msr-fn (cdddr val)));;--modifed by harshrc 
-              (and
-               ;; list of flags
-               (keyword-listp flags)
-               ;; predicate function (allp for all) for image of constructor
-               (symbolp predicate)
-               (plausible-predicate-functionp predicate world)
-               (symbolp msr-fn)
-               (or (allows-arity msr-fn 1 world)
-                   (eq msr-fn 'none));;-- msr a one-param fn?? -harshrc
-               ;; (dfn . pfn) alist in parameter order where
-               ;; dfn names destructor
-               ;; pfn intended domain predicate function (allp for all)
-               (alistp dlst)
-               (allows-arity key (len dlst) world)
-               (allow-arity-lst (strip-cars dlst) 1 world)
-               (plausible-predicate-function-listp (strip-cdrs dlst)
-                                                   world)))))
-       
-
-
-;auto-generated constructors have only synctatic guards
-(table generated-constructors nil nil :guard
-       (and
-         (consp val)
-         (consp (cdr val))
-         (consp (cddr val))
-         (let ((flags (car val))
-               (predicate (cadr val))
-               (dlst (caddr val))
-               (msr-fn (cdddr val))) 
-           (and
-            ;; list of flags
-            (keyword-listp flags)
-            (symbolp predicate)
-            (symbolp msr-fn)
-            (symbol-alistp dlst)))))
-
-#|
-;auto-generated constructors have only synctatic guards
-(defun add-to-generated-constructors-global (constructor cons-info ctx state)
-  (declare (xargs :stobjs (state) :mode :program                  
-                  :guard (and (symbolp constructor)
-                              (consp cons-info))))
-  (let ((key constructor)
-        (val cons-info))
-        
-    (if (and
-         (consp val)
-         (consp (cdr val))
-         (consp (cddr val))
-         (let ((flags (car val))
-               (predicate (cadr val))
-               (dlst (caddr val))
-               (msr-fn (cdddr val))) 
-           (and
-            ;; list of flags
-            (keyword-listp flags)
-            (symbolp predicate)
-            (symbolp msr-fn)
-            (symbol-alistp dlst))))
-      (let* ((data-cons-alst (get-data-constructors-global))
-            (cons-entry (assoc-eq key data-cons-alst)))
-            
-        (if (consp cons-entry)
-          (if (not (equal (cdr cons-entry) cons-info))
-            (er soft ctx "~x0 already present in the global generated-constructors table! Illegal to modify it!!~%" key)
-            (value '(value-triple :redundant)))
-          (let ((data-cons-alst (acons key val data-cons-alst)))
-            (er-progn
-             (set-generated-constructors-global data-cons-alst)
-             (value `(value-triple ,(cons key val)))))))
-      (er soft ctx "Constructor ~x0 and its Info ~x1 are invalid, and cannot be added to generated-constructor table!~%" key val))))
-
-|#
-
-
-;selectors for the above constructors stored in the *-constructor tables, use them only.
-(defun cons-name-entry (constructor-table-entry)
-  (declare (xargs :guard (and (consp constructor-table-entry)
-                              (consp (cdr constructor-table-entry))
-                              (consp (cddr constructor-table-entry))
-                              (consp (cdddr constructor-table-entry)))))
-  (car constructor-table-entry))
-(defun predicate-name-entry (constructor-table-entry)
-  (declare (xargs :guard (and (consp constructor-table-entry)
-                              (consp (cdr constructor-table-entry))
-                              (consp (cddr constructor-table-entry))
-                              (consp (cdddr constructor-table-entry)))))
-  (caddr constructor-table-entry))
-(defun dex-pairs-entry (constructor-table-entry)
-  (declare (xargs :guard (and (consp constructor-table-entry)
-                              (consp (cdr constructor-table-entry))
-                              (consp (cddr constructor-table-entry))
-                              (consp (cdddr constructor-table-entry)))))
-  (cadddr constructor-table-entry))
-(defun measure-fn-entry (constructor-table-entry)
-  (declare (xargs :guard (and (consp constructor-table-entry)
-                              (consp (cdr constructor-table-entry))
-                              (consp (cddr constructor-table-entry))
-                              (consp (cdddr constructor-table-entry)))))
-  (cddddr constructor-table-entry))
-
-
-
-;;--normalise a constructor/destructor form
-;;-- sfn => (sfn . allp)
-;;-- (sfn . pfn) ==> (sfn . pfn)
-;;-- (pfn sfn) ==> (sfn . pfn) where sfn is constructor/destructor? and pfn is pred
-(defun fix-structor-and-pred (p ctx)
-  (cond ((symbolp p)
-         (cons p 'allp))
-        ((and (consp p)
-              (symbolp (car p))
-              (symbolp (cdr p))) ; (sfn . pfn)
-         p)
-        ((and (consp p)
-              (symbolp (car p))
-              (consp (cdr p))
-              (symbolp (cadr p))
-              (null (cddr p)))   ; (pfn sfn)
-         (cons (cadr p) (car p)))
-        (t
-         (er hard? ctx
-             "Invalid function with predicate: ~x0"
-             p))))
-
-;;-- returns list of form ((numerator . rationalp) ...)
-(defun fix-structor-and-pred-lst (lst ctx)
-  (declare (xargs :guard (and (true-listp lst) (symbolp ctx))))
-  (if (endp lst)
-    nil
-    (cons (fix-structor-and-pred (car lst) ctx)
-          (fix-structor-and-pred-lst (cdr lst) ctx))))
-
-;;--return a list of single argument(x) calls
-;;--(apply-to-x-lst '(ap bp cp))
-;;-- ==> ((AP X) (BP X) (CP X))
-(defun apply-to-x-lst (fns)
-  (declare (xargs :guard (true-listp fns)))
-  (if (endp fns)
-    nil
-    (cons (list (car fns) 'x)
-          (apply-to-x-lst (cdr fns)))))
-
-(defun apply-mget-to-x-lst (fields)
-  (declare (xargs :guard (symbol-listp fields)))
-  (if (endp fields)
-    nil
-    (let ((d-keyword-name (intern (symbol-name (car fields)) "KEYWORD")))
-      (cons (list 'acl2::mget d-keyword-name 'x)
-            (apply-mget-to-x-lst (cdr fields))))))
-
-;;--eg:(get-proper-dex-theorems 'cons '(car cdr))
-;;--         ==>
-;;--((EQUAL (CAR (CONS CAR CDR)) CAR)
-;;-- (EQUAL (CDR (CONS CAR CDR)) CDR))
-(defun get-proper-dex-theorems1 (conx-name dex-names rem-dex-names recordp)
-  (declare (xargs :guard (and (symbol-listp dex-names)
-                              (booleanp recordp)
-                              (symbol-listp rem-dex-names))))
-  (if (endp rem-dex-names)
-    nil
-    (if recordp
-      (let ((d-keyword-name (intern (symbol-name (car rem-dex-names)) "KEYWORD")))
-        (cons `(equal (mget ,d-keyword-name (,conx-name . ,dex-names))
-                      ,(car rem-dex-names))
-              (get-proper-dex-theorems1 conx-name dex-names
-                                      (cdr rem-dex-names) recordp)))
-      (cons `(equal (,(car rem-dex-names) (,conx-name . ,dex-names))
-                    ,(car rem-dex-names))
-            (get-proper-dex-theorems1 conx-name dex-names
-                                      (cdr rem-dex-names) recordp)))))
-
-(defun get-proper-dex-theorems (conx-name dex-names recordp)
-  (declare (xargs :guard (and (booleanp recordp) (symbol-listp dex-names))))
-  (get-proper-dex-theorems1 conx-name dex-names dex-names recordp))
-
-;;-- (get-improper-dex-theorems 'rational '(numerator denominator) '(integerp posp))
-;;-- gives
-;;-- ((INTEGERP (NUMERATOR (RATIONAL NUMERATOR DENOMINATOR)))
-;;-- (POSP (DENOMINATOR (RATIONAL NUMERATOR DENOMINATOR))))
-(defun get-improper-dex-theorems1 (conx-name dex-names
-                                             rem-dex-names 
-                                             rem-dex-prexs
-                                             recordp)
-  (declare (xargs :guard (and (symbol-listp dex-names)
-                              (symbol-listp rem-dex-names)
-                              (booleanp recordp);records
-                              (symbol-listp rem-dex-prexs))))
-  (if (endp rem-dex-names)
-    nil
-    (if recordp
-      (let ((d-keyword-name (intern (symbol-name (car rem-dex-names)) "KEYWORD")))
-        (cons `(,(car rem-dex-prexs) (mget ,d-keyword-name (,conx-name . ,dex-names)))
-          (get-improper-dex-theorems1 conx-name dex-names
-                                      (cdr rem-dex-names)
-                                      (cdr rem-dex-prexs) recordp)))
-
-      (cons `(,(car rem-dex-prexs) (,(car rem-dex-names) (,conx-name . ,dex-names)))
-            (get-improper-dex-theorems1 conx-name dex-names
-                                        (cdr rem-dex-names)
-                                        (cdr rem-dex-prexs) recordp)))))
-
-(defun get-improper-dex-theorems (conx-name dex-names dex-prexs recordp)
-  (declare (xargs :guard (and (symbol-listp dex-names)
-                              (booleanp recordp);records
-                              (symbol-listp dex-prexs))))
-  (get-improper-dex-theorems1 conx-name dex-names
-                              dex-names dex-prexs recordp))
-
-(defun build-one-param-calls (fns params)
-  (declare (xargs :guard (and (true-listp fns)
-                              (true-listp params)
-                              (= (len fns) (len params)))))
-  (if (endp fns)
-    nil
-    (cons (list (car fns) (car params))
-          (build-one-param-calls (cdr fns) (cdr params)))))
-
-;(o< (acl2-count (car x)) (acl2-count x))
-;(o< (acl2-count (cdr x)) (acl2-count x))
-(defun build-measure-calls (dex-names)
-  (declare (xargs :guard (true-listp dex-names)))
-  (if (endp dex-names)
-    nil
-    (cons `(o< (acl2-count (,(car dex-names) x)) (acl2-count x))
-          (build-measure-calls (cdr dex-names)))))
-
-;;--added measure-fn flag with default 'none
-(defmacro register-data-constructor (constructor destructor-lst
-                                                 &key 
-                                                 hints proper
-                                                 measure-fn ;added by harshrc
-                                                 generated ;added by harshrc
-                                                 )
-  
-  ":Doc-Section DATA-DEFINITIONS
-  Register a data constructor to be used in data definitions(FOR ADVANCED USERS)~/
-  This is an advanced macro to be used only by power users and people who
-  would like to add their own custom notions of product data. 
-  It can be used to register a data-constructor like ~c[cons]
-  with the data-definition framework, so that ~em[product datatypes] 
-  can be specified using ~c[defdata]. 
-  For example ~em[cons] is already registered for you:
-  ~bv[]
-  (register-data-constructor (consp cons)
-                             ((allp car) (allp cdr))
-                             :proper t)
-  ~ev[]                           
-  It says that ~c[cons] is a constructor and anything that satisfies
-  ~c[consp] can be constructed with this constructor, like ~c[(cons nat pos)].
-  The destructor ~c[car] tells what the first argument to ~c[cons] was, and
-  anything specifying ~c[allp] can be given in that argument position. The
-  destructor ~c[cdr] tells what the second argument to ~c[cons] was, and
-  anything satisfying ~c[allp] can be given in that argument position. The
-  proper keyword specifies that any product data that was formed using 
-  ~c[cons] can be uniquely destructed back to its original arguments. For
-  e.g ~c[(car (cons 1 3))] gives you 1. Compare this with an improper constructor
-  ~c[/] which is shown in the examples below, where ~c[(denominator (/ 6 42))]
-  gives back 7 instead of 42.
-  
-  
-  ~bv[]
-  Examples(These are already registered(like all ground acl2 constructors)):
-  (register-data-constructor (acl2-numberp complex)
-                             ((rationalp realpart) (rationalp imagpart))
-                             :proper t)
-  
-  ;an improper constructor                           
-  (register-data-constructor (rationalp /)
-                             ((integerp numerator) (posp denominator)))
-  ~ev[]                      
-  ~bv[]
-  Usage:
-  (register-data-constructor (<constructor-predicate> <constructor>)
-                             ((<destructor-predicate> <destructor>) ...)
-                             [:proper <boolean>])
-  ~ev[]~/
-  "
-  (declare (xargs :guard (and (true-listp destructor-lst)
-                              (booleanp proper)
-                              (booleanp generated))))
-  (let* ((conx-pair (fix-structor-and-pred constructor
-                                           'register-data-constructor))
-         
-         (dex-pairs (if generated ;if yes its already in good form
-                      destructor-lst
-                      (fix-structor-and-pred-lst destructor-lst
-                                                 'register-data-constructor)))
-         (conx-name (car conx-pair))
-         (conx-prex (cdr conx-pair))
-         (dex-names (strip-cars dex-pairs))
-         (dex-prexs (strip-cdrs dex-pairs))
-         (table-name (if generated 
-                              'generated-constructors
-                              'data-constructors))
-         (msr-fn  measure-fn))
-       ;(thm (implies (consp x)
-       ;      (and (o< (acl2-count (car x)) (acl2-count x))
-       ;           (o< (acl2-count (cdr x)) (acl2-count x)))))
-       ; (local (defthm ,(modify-symbol nil conx-name "-MEASURE-FN-VALID")
-       ;          (and (o-p (,msr-fn x))
-       ;               (implies (,conx-prex x)
-       ;                        (and . ,(build-measure-calls dex-names) )))))
-        
-    `(progn
-      (local
-       (defthm ,(modify-symbol "" conx-name "-CONSTRUCTOR-VALID")
-         (implies (and . ,;(if generated ;removed by harshrc on July 8 2010
-                            ;dex-prexs
-                            (build-one-param-calls dex-prexs dex-names))
-                  (and (,conx-prex (,conx-name . ,dex-names))
-                       
-                       . ,(if proper
-                            `((implies (,conx-prex x)
-                                       (equal (,conx-name
-                                               . ,(if generated
-                                                    (apply-mget-to-x-lst dex-names)
-                                                    (apply-to-x-lst dex-names)))
-                                              x))
-                              . ,(get-proper-dex-theorems conx-name
-                                                          dex-names generated))
-                            (get-improper-dex-theorems conx-name
-                                                       dex-names
-                                                       dex-prexs generated))))
-         :rule-classes nil
-         :hints ,hints))
-      
-      
-      (table
-       ,table-name
-       ',conx-name
-       ',(list* (if generated '(:generated :proper) (if proper '(:proper) '()))
-                conx-prex dex-pairs 
-                (if msr-fn msr-fn 'none))
-       :put)
-      
-      (value-triple (list ',constructor ',destructor-lst)))))
-  
-
-
-;;--(get-enumerator-symbol 'int) ==> NTH-INT
-(defun get-enumerator-symbol (sym)
-  (declare (xargs :guard (symbolp sym)))
-  (modify-symbol "NTH-" sym ""))
-
-(defun get-enumerator-symbol-lst (syms)
-  (declare (xargs :guard (symbol-listp syms)))
-  (if (endp syms)
-    nil
-    (cons (get-enumerator-symbol (car syms))
-          (get-enumerator-symbol-lst (cdr syms)))))
-
-;;--(get-values-symbol 'foo) ==> *FOO-VALUES*
-(defun get-values-symbol (sym)
-  (declare (xargs :guard (symbolp sym)))
-  (modify-symbol "*" sym "-VALUES*"))
-
-(defun get-values-symbol-lst (syms)
-  (declare (xargs :guard (symbol-listp syms)))
-  (if (endp syms)
-    nil
-    (cons (get-values-symbol (car syms))
-          (get-values-symbol-lst (cdr syms)))))
-
-
-
-(defun get-predicate-testthm-symbol (sym)
-  (declare (xargs :guard (symbolp sym)))
-  (modify-symbol "" sym "P-TESTTHM"))
-
-(defun get-predicate-def-thm-symbol (sym)
-  (declare (xargs :guard (symbolp sym)))
-  (modify-symbol "" sym "P-DEFINITION-THM"))
-
-(defun get-predicate-def-thm-symbol-lst (syms)
-  (declare (xargs :guard (symbol-listp syms)))
-  (if (endp syms)
-    nil
-    (cons (get-predicate-def-thm-symbol (car syms))
-          (get-predicate-def-thm-symbol-lst (cdr syms)))))
-
-(defun get-predicate-testthm-symbol-lst (syms)
-  (declare (xargs :guard (symbol-listp syms)))
-  (if (endp syms)
-    nil
-    (cons (get-predicate-testthm-symbol (car syms))
-          (get-predicate-testthm-symbol-lst (cdr syms)))))
-
-;;--add enumeration events maintaining consistency with history
-(defun compute-define-enumeration-type-events (nm psym vsym tsym values wrld)
-  (declare (xargs :mode :program))
-  (list (if (decode-logical-name vsym wrld)
-          `(assert-event (set-equalp-equal ',values ,vsym))
-          `(defconst ,vsym ',values))
-        (if (decode-logical-name psym wrld)
-          `(local (defthm ,tsym
-                    (iff (member-equal x ,vsym)
-                         (,psym x))
-                    :rule-classes nil))
-          `(defun ,psym (x)
-             (declare (xargs :guard t))
-             (if (member-equal x ,vsym) t nil)))
-        `(register-custom-type ,nm ,(len values) ,vsym ,psym 
-                               :type-class enum)))
-
-;--TODO: Instead of guards, the syntax check should be explicit!
-(defmacro define-enumeration-type (name values)
-  (declare (xargs :guard (and (symbolp name)
-                              (true-listp values)))) 
-  `(make-event
-    (cons 'progn
-          (append
-            (compute-define-enumeration-type-events 
-               ',name
-               (get-predicate-symbol ',name)
-               (get-values-symbol ',name)
-               (get-predicate-testthm-symbol ',name)
-               ,values
-               (w state))
-            `((value-triple ',',name))))))
-
-
-#|;Test code
-(define-enumeration-type boolean '(t nil))
-(define-enumeration-type zero '(0))
-(define-enumeration-type asdf '(a s d f))
-;|#
-
-
-; a symbol FOO is a "type" if
-;   - FOOP is a recognizer for it and
-;   either -NTH-FOO is an enumerator for it (infinite)
-;          -*FOO-VALUES* is the set of values for it (finite)
-
-
-
-; a "type operator" is, for now, ONEOF or ANYOF (for now, the same)
-(deflabel oneof)
-(deflabel anyof)
-
-; got rid of LISTOF because it's hard to do implicit recursion
-; plus it's pedagogically dubious
-;-- got it back in view of its usability --modified by --harshrc
-(deflabel listof)
-(deflabel record)
-;(deflabel map);ADDED 3rd May 2011
-(deflabel set)
-(deflabel enum)
-
-
-; a "constructor" is registered as above, with proper arity
-; or a macro which expands to function(s) that are constructors
-
-
-
-;;--eg:(build-dex-exprs '((car . allp) (cdr . allp)) '(cons x y))
-;;-- ==> ((CAR (CONS X Y)) (CDR (CONS X Y))) 
-(defun build-dex-exprs (dex-info expr)
-  (declare (xargs :mode :program
-                  :guard (alistp dex-info)))
-  (if (endp dex-info)
-    nil
-    (cons `(,(caar dex-info) ,expr)
-          (build-dex-exprs (cdr dex-info) expr))))
-
-
-
-
-;; syntax-directed translation of data definition
-;; to obtain predicate expression list
-(mutual-recursion
- (defun er-trans-datadef-as-predicate-lst (defbody-lst new-preds expr-lst
-                                            new-constructors ctx wrld state)
-   (declare (xargs :mode :program
-                   :guard (and (symbol-listp new-preds)
-                               (true-listp expr-lst)
-                               (= (len expr-lst) (len defbody-lst))
-                               (symbol-alistp new-constructors)
-                               (symbolp ctx)
-                               (plist-worldp wrld))))
-   (if (atom defbody-lst)
-       (if (null defbody-lst)
-           (value nil)
-         (er soft ctx "Expecting a true list but last cdr is ~x0" defbody-lst))
-     (er-let* ((car-pred
-                (er-trans-datadef-as-predicate (car defbody-lst)
-                                               new-preds (car expr-lst)
-                                               new-constructors
-                                               ctx wrld state))
-               (cdr-pred-lst
-                (er-trans-datadef-as-predicate-lst (cdr defbody-lst)
-                                                   new-preds (cdr expr-lst)
-                                                   new-constructors
-                                                   ctx wrld state)))
-      
-      (value (cons car-pred cdr-pred-lst)))))
-
-;;-- translate type-expression(defbody) to obtain a predicate expression body
-;;-- for a predicate function with argument 'expr', lets say the [[expr]] = v
-;;-- cases defbody := 
-;;--       1. constant value 'val' => return expr (eq val v) 
-;;--       2. predicate symbol(new OR in history) => return expr (pred v)
-;;--       3. (oneof ...) => return expr (or ...)
-;;--       4. (cons texp1 texp2), then return (and (consp v)
-;;--                                               (pred1 (car v))
-;;--                                               (pred2 (cdr v)))
-;;--       5. new constructor: (node t1 t2 t2), then return (nodep v)
-;;--       6. macro calls are expanded, then recurse on result
-  
- (defun er-trans-datadef-as-predicate (defbody new-preds expr 
-                                        new-constructors
-                                        ctx wrld state)
-   (declare (xargs :guard (and (symbol-listp new-preds)
-                               (symbol-alistp new-constructors)
-                               (symbolp ctx)
-                               (plist-worldp wrld))))
-   (cond ((possible-constant-valuep defbody)
-          (er-let* ((val (er-get-constant-value defbody ctx wrld state)))
-           (let ((comparison (cond ((symbolp val) 'eq)
-                                   ((eqlablep val) 'eql)
-                                   (t 'equal))))
-            (value `(,comparison ,expr ',val)))))
-         
-         ((symbolp defbody)
-          (if (member-eq (get-predicate-symbol defbody) new-preds)
-              (let* ((pred (get-predicate-symbol defbody)))
-                (value `(,pred ,expr)))
-            (er-let* ((pred (er-get-predicate defbody ctx wrld state)))
-             (value `(,pred ,expr)))))
-         
-; should be a cons if we get here
-         (t
-          (let ((comb (car defbody)))
-           (cond 
-            ((or (eq comb 'oneof)
-                 (eq comb 'anyof))
-             (er-let* ((rst (er-trans-datadef-as-predicate-lst
-                             (cdr defbody) new-preds
-                             (make-list (len (cdr defbody))
-                                        :initial-element expr)
-                             new-constructors
-                             ctx wrld state)))
-              (value `(or . ,rst))))
-
-            
-            (t ; look up as constructor, then as macro
-             (let* ((registered-conx-info 
-                     (or (assoc-eq comb (table-alist 'data-constructors wrld))
-                         (assoc-eq comb (table-alist 'generated-constructors wrld))))
-                    (to-be-created-conx-info (assoc-eq comb new-constructors))
-                    (conx-info (or registered-conx-info to-be-created-conx-info)))
-               (if conx-info
-                   (let ((conx-pred (predicate-name-entry conx-info))
-                         (dex-info (dex-pairs-entry conx-info)))
-                    (if registered-conx-info
-                        (er-let* ((rst (er-trans-datadef-as-predicate-lst
-                                        (cdr defbody) new-preds
-                                        (build-dex-exprs dex-info expr)
-                                        new-constructors
-                                        ctx wrld state)))
-                         (value `(and (,conx-pred ,expr)
-                                      . ,rst)))
-;harshrc: The reason why the following is different from the
-;registered-conx-info, is that one can have a (cons string int), where
-;the string and int are stronger requirements than allp of cons
-;requires. But when we are constructing a new record on the fly, say
-;(oneof 'Leaf (node (key . int) (left . tree) (right . tree))), the
-;requirements are tight and hence there is no reason to recur on the
-;components, since their type constraints are reflected in nodep itself.
-                      (value (list conx-pred expr))))
-                 (if (true-listp (acl2-getprop comb 'macro-args wrld
-                                               :default :undefined))
-                     
-                     ;; attempt macro expansion
-                     (er-let* ((newdefbody (macroexpand1 defbody ctx state)))
-                      (er-trans-datadef-as-predicate newdefbody new-preds expr
-                                                     new-constructors
-                                                     ctx wrld state))
-                   ;; otherwise, illegal
-                   (er soft ctx "~x0 is not a recognized constructor or ~
-                                 type combinator." comb))))))))))
-)
-
-;;--If all arguments are constant values, then the constructor calls can be
-;;--evaluated/combined using the following functions to obtain constant values.
-;;e.g:
-#|
-(EVAL-FN-COMBINE-ARG-LSTS 'cons
-                             '((a b) ("g" ((12) . c) ((x "no") . ok)))
-                             'top-level state)
- ((A . "g")
-  (B . "g")
-  (A (12) . C)
-  (B (12) . C)
-  (A (X "no") . OK)
-  (B (X "no") . OK))
-|#
-(defun eval-fn-combine-arg-lsts0 (fn arglst-sofar rev-arglsts ctx state)
-  (declare (xargs :mode :program))
-  (cond ((endp rev-arglsts)
-         (er-let* ((v (trans-eval-single-value (cons fn arglst-sofar) ctx state)))
-           (value (list v))))
-        ((endp (car rev-arglsts))
-         (value nil))
-        (t
-         (er-let*
-           ((values1 (eval-fn-combine-arg-lsts0 fn
-                                                (cons (list 'quote (caar rev-arglsts))
-                                                      arglst-sofar)
-                                                (cdr rev-arglsts)
-                                                ctx state))
-            (values2 (eval-fn-combine-arg-lsts0 fn
-                                                arglst-sofar
-                                                (cons (cdar rev-arglsts)
-                                                      (cdr rev-arglsts))
-                                                ctx state)))
-           (value (union-equal values1 values2))))))
-
-(defun eval-fn-combine-arg-lsts (fn arglsts ctx state)
-  (declare (xargs :mode :program))
-  (eval-fn-combine-arg-lsts0 fn nil (reverse arglsts) ctx state))
-
-
-
-
-;static analysis of data-definitions to get finite data defs:
-;fixed point iteration over data def structure.
-(mutual-recursion
- (defun er-get-finite-data-def-lst (defbody-lst finite-defs 
-                                     new-constructors
-                                     ctx wrld state)
-   (declare (xargs :mode :program
-                   :guard (and (true-listp defbody-lst)
-                               (symbol-alistp finite-defs)
-                               (symbol-alistp new-constructors)
-                               (symbolp ctx)
-                               (plist-worldp wrld))))
-   (if (endp defbody-lst)
-       (value nil)
-     (er-let* ((fst (er-get-finite-data-def (car defbody-lst) finite-defs
-                                            new-constructors ctx wrld state))
-               (rst (er-get-finite-data-def-lst (cdr defbody-lst) finite-defs
-                                                new-constructors ctx wrld state)))
-      (value (cons fst rst)))))  
-
- ;; (value nil) if infinite or (value <list of values>) if finite 
- (defun er-get-finite-data-def (defbody finite-defs new-constructors ctx wrld state)
-   (declare (xargs :guard (and (symbol-alistp finite-defs)
-                               (symbol-alistp new-constructors)
-                               (symbolp ctx)
-                               (plist-worldp wrld))))
-   (cond ((possible-constant-valuep defbody);is a constant(singleton type)
-          (er-let* ((val (er-get-constant-value defbody ctx wrld state)))
-           (value (list val))))
-         ((symbolp defbody) ;is a symbol (typename)
-          (if (assoc-eq defbody finite-defs)
-              (value (cdr (assoc-eq defbody finite-defs)))
-            (let* ((vsym (get-values-symbol defbody))
-                   (quoted-values (acl2-getprop vsym 'const wrld)))
-              ;; assume infinite if values not available
-              (if quoted-values
-                  (value (cadr quoted-values)) ; unquote
-                (value nil)))))
-         ;; should be a cons if we get here
-         (t ;(either a product or union type expression or a macro call
-          (let ((comb (car defbody)))
-           (cond 
-            ((or (eq comb 'oneof)
-                 (eq comb 'anyof)) ;UNION
-             (er-let* ((rst (er-get-finite-data-def-lst
-                             (cdr defbody) finite-defs
-                             new-constructors
-                             ctx wrld state)))
-              (if (member-eq nil rst) ; at least one infinite branch
-                  (value nil)
-                (value (union-lsts rst)))))
-            (t ; look up as constructor(registered or new), then as macro
-             (let* ((reg-conx-info 
-                     (or (assoc-eq comb (table-alist 'data-constructors wrld))
-                         (assoc-eq comb (table-alist 'generated-constructors wrld))))
-                    (to-be-created-conx-info (assoc-eq comb new-constructors))
-                    (conx-info (or reg-conx-info 
-                                   to-be-created-conx-info)))
-                    
-                    ;;--conx-info e.g: (cons (:proper)
-                    ;;--                 consp (car . allp) (cdr . allp))
-                    ;;-- what if its a macro? say list, will it already be
-                    ;;-- expanded when it reaches here? No, it gets expanded here only.
-               (if conx-info ;PRODUCT TYPE EXPRESSION
-                   (er-let* ((rst (er-get-finite-data-def-lst
-                                   (cdr defbody) finite-defs
-                                   new-constructors
-                                   ctx wrld state)))
-                    (if (member-eq nil rst) ; at least one infinite branch
-                        (value nil)
-                      (eval-fn-combine-arg-lsts 
-;harshrc 28th Aug '12: TODO - check if list* is a mistake or not.
-                       (if reg-conx-info comb 'list*) 
-                       rst ctx state)))
-                 (if (true-listp (acl2-getprop comb 'macro-args wrld 
-                                               :default :undefined))
-;MACRO CALL
-                     ;; attempt macro expansion
-                     (er-let* ((newdefbody (macroexpand1 defbody ctx state)))
-                      (er-get-finite-data-def newdefbody finite-defs
-                                              new-constructors
-                                              ctx wrld state))
-                   ;; otherwise, illegal
-                   (er soft ctx "~x0 is not a recognized constructor or ~
-                                  type combinator." comb))))))))))
-)
-
-; step in iteration
- (defun er-get-finite-data-defs1 (defs finite-defs new-constructors ctx wrld state)
-   (declare (xargs :mode :program
-                   :guard (and (symbol-alistp defs)
-                               (symbol-alistp finite-defs)
-                               (symbol-alistp new-constructors)
-                               (symbolp ctx)
-                               (plist-worldp wrld))))
-   (cond ((endp defs)
-          (value finite-defs))
-         ((assoc-eq (caar defs) finite-defs)
-          (er-get-finite-data-defs1 (cdr defs) finite-defs new-constructors ctx wrld state))
-         (t
-          (er-let* ((new-def (er-get-finite-data-def (cadar defs) finite-defs
-                                                     new-constructors
-                                                     ctx wrld state)))
-           (er-get-finite-data-defs1 (cdr defs)
-                                     (if new-def ; finite (nil -> infinite)
-                                         (cons (cons (caar defs)
-                                                     new-def)
-                                               finite-defs)
-                                       finite-defs)
-                                     new-constructors 
-                                     ctx wrld state)))))
-
-
-             
-
-; iterate until fixed point
- (defun er-get-finite-data-defs0 (defs finite-defs new-constructors ctx wrld state)
-   (declare (xargs :mode :program
-                   :guard (and (symbol-alistp defs)
-                               (symbol-alistp finite-defs)
-                               (symbol-alistp new-constructors)
-                               (symbolp ctx)
-                               (plist-worldp wrld))))
-   (er-let* ((new-finite-defs (er-get-finite-data-defs1 defs finite-defs
-                                                        new-constructors
-                                                        ctx wrld state)))
-    (if (equal finite-defs new-finite-defs)
-        (value new-finite-defs)
-      (er-get-finite-data-defs0 defs new-finite-defs new-constructors ctx wrld state))))
-    
-; Start fix-point iteration
-(defun er-get-finite-data-defs (defs new-constructors ctx wrld state)
-  (declare (xargs :mode :program
-                  :guard (and (symbol-alistp defs)
-                              (symbolp ctx)
-                              (symbol-alistp new-constructors)
-                              (plist-worldp wrld))))
-  (er-get-finite-data-defs0 defs nil new-constructors ctx wrld state))
-
-
-
-#| ;test code
-
-(define-enumeration-type boolean '(t nil))
-(register-data-constructor (consp cons)
-                           ((allp car) (allp cdr))
-                           :proper t)
-
-
-(er-get-finite-data-defs '((foo (oneof 42 (cons boolean baz)))
-                           (bar (oneof nil
-                                       (cons foo bar)))
-                           (moo nil)
-                           (baz (cons boolean moo)))
-                         nil
-                         'top-level (w state) state)
-|#
-
-
-
-;;-- gives back enumerator information
-;;-- e.g:
-;;-- (er-get-enumeration-info 'integer 'x nil '(acl2::nth-integer acl2::nth-rational) 'top-level (w state) state)
-;;-- ==> (T ACL2::NTH-INTEGER X)
-;;-- if nth-integer is already defined in current world then:
-;;-- (er-get-enumeration-info 'integer 'x nil nil 'top-level (w state) state)
-;;-- ==> (T ACL2::NTH-INTEGER X)
-;;-- (er-get-enumeration-info 'boolean 'x nil nil 'top-level (w state) state)
-;;-- ==> (2 NTH X *BOOLEAN-VALUES*)
- 
-(defun er-get-enumeration-info (type-name expr finite-defs inf-enum-syms ctx wrld state)
-  (declare (xargs :mode :program
-                  :guard (and (symbolp type-name)
-                              (symbol-alistp finite-defs)
-                              (symbol-listp inf-enum-syms)
-                              (symbolp ctx)
-                              (plist-worldp wrld))))
-  (let* ((vsym (get-values-symbol type-name))
-         (values (or (second (acl2-getprop vsym 'const wrld))
-                     (cdr (assoc-eq vsym finite-defs)))))
-    (if values
-      (let ((len-v (len values)))
-        (value (cons len-v
-                     (if (= len-v 1)  
-                       `',(car values) 
-                       `(nth ,expr ,vsym)))))
-      (let* ((esym (get-enumerator-symbol type-name)))
-             
-        ;;-check if arity matches(implicit check if enum is defined in wrld)
-        (cond ((allows-arity esym 1 wrld) 
-               (value (cons t `(,esym ,expr))))
-              ((member-eq esym inf-enum-syms)
-               (value (cons t `(,esym ,expr))))
-              (t       
-               (er soft ctx
-                   "Type specifier ~x0 is invalid. To be valid, it needs a valid ~
-                    enumerator ~x1 or a valid list of values ~x2."
-                   type-name esym vsym)))))))
-
-#|
-(define-enumeration-type boolean '(t nil))
-
-(register-data-constructor (consp cons)
-                           ((allp car) (allp cdr))
-                           :proper t)
-
-(defconst *foo-values* '(1 2 3))
-(defconst *bar-values* '(a))
-(er-get-enumeration-info 'foo 'x nil nil 'top-level (w state) state)
-(er-get-enumeration-info 'bar 'x nil nil 'top-level (w state) state)
-|#
-
-(defun get-inf-enum-infos (l)
-  (declare (xargs :guard (true-listp l)))
-  (cond ((endp l)
-         l)
-        ((and (consp (car l))
-              (eq 't (caar l)))
-         (cons (car l)
-               (get-inf-enum-infos (cdr l))))
-        (t
-         (get-inf-enum-infos (cdr l)))))
-
-; finite size = 1 i.e.  singleton values)
-(defun get-singleton-enum-infos (l)
-  (declare (xargs :guard (true-listp l)))
-  (cond ((endp l)
-         l)
-        ((and (consp (car l))
-              (equal 1 (caar l));size 1
-              ;(possible-constant-valuep (cdar l)) ;Comes from trusted code, so no need.
-              );singleton value
-         (cons (car l)
-               (get-singleton-enum-infos (cdr l))))
-        (t
-         (get-singleton-enum-infos (cdr l)))))
-
-; fin = finite size > 1 (i.e. finite but not singleton values)
-(defun get-fin-enum-infos (l)
-  (declare (xargs :guard (true-listp l)))
-  (cond ((endp l)
-         l)
-        ((and (consp (car l))
-              (natp (caar l))
-              (not (and (equal 1 (caar l))
-                        ;(possible-constant-valuep (cdar l)) ;Comes from trusted code, so no need.
-                   )));not singleton value
-                    
-         (cons (car l)
-               (get-fin-enum-infos (cdr l))))
-        (t
-         (get-fin-enum-infos (cdr l)))))
-
-
-
-(defun +-cars0 (l acc)
-  (declare (xargs :mode :program))
-  (if (endp l)
-      acc
-    (+-cars0 (cdr l) (+ acc (caar l)))))
-
-(defun +-cars (l)
-  (declare (xargs :mode :program))
-  (+-cars0 l 0))
-
-(defun *-cars0 (l acc)
-  (declare (xargs :mode :program))
-  (if (endp l)
-      acc
-    (*-cars0 (cdr l) (* acc (caar l)))))
-
-(defun *-cars (l)
-  (declare (xargs :mode :program))
-  (*-cars0 l 1))
-
-
-
-;NOTE: enum-info-lst that the following 2 functions
-;gets as arguments is a sorted one, with singleton enums
-; finite-enums occurring before the inf-enums in the lst
-
-;build union expressions for generating enumerator functions
-(defun build-inf-choices-enum-n (enum-info-lst n)
-  (declare (xargs :mode :program))
-  (cond ((not (consp enum-info-lst))
-         ':error)
-        ((not (consp (cdr enum-info-lst)))
-         (cdar enum-info-lst))
-        (t
-         `(if (= n ,n)
-            ,(cdar enum-info-lst)
-            ,(build-inf-choices-enum-n (cdr enum-info-lst) (1+ n))))))
-
-; enum-info-lst should always be a cons
-(defun build-choice-enum1 (enum-info-lst)
-  (declare (xargs :mode :program))
-  (cond ((not (consp enum-info-lst))
-         ':error);should not get here
-        ((not (consp (cdr enum-info-lst)))
-         (cdar enum-info-lst));the last choice
-        ;remaining have atleast 2 choices
-        ((natp (caar enum-info-lst)) ; finite
-         `(if (< x ,(caar enum-info-lst)) ;pushed the (not integerp) call to a build-choice-enum
-            ,(cdar enum-info-lst)
-            ,(if (and (not (consp (cddr enum-info-lst))) ;if the next choice is the last one
-                      (equal 1 (caadr enum-info-lst))) ;and is a singleton
-               (build-choice-enum1 (cdr enum-info-lst));dont do a let
-               `(let ((x (- x ,(caar enum-info-lst))))
-                 ,(build-choice-enum1 (cdr enum-info-lst))))))
-        (t ; assume all remaining are infinite
-         (let ((nchoices (len enum-info-lst)))
-           `(mv-let 
-             (n x)
-             (switch-nat ,nchoices (nfix x)) ;nfix helps termination
-             ,(build-inf-choices-enum-n enum-info-lst 0))))))
-
-;added by harshrc
-;we dont need repeated (or (not (integerp x) ..) calls, once in the
-;beginning is enough. This improves readability of generated enums
-
-(defun build-choice-enum (enum-info-lst)
-  (declare (xargs :mode :program))
-  (cond ((not (consp enum-info-lst))
-         ':error)
-        ((not (consp (cdr enum-info-lst)))
-         (cdar enum-info-lst)) ;no need to change here anything(cos this is a top-level call only)
-        ((natp (caar enum-info-lst)) ; finite
-         `(if (or (not (integerp x));top-level check for non-integers
-                  (< x ,(caar enum-info-lst)))
-            ,(cdar enum-info-lst)
-            ;;if the next choice is the last one
-            ,(if (and (not (consp (cddr enum-info-lst)))
-                      (equal 1 (caadr enum-info-lst))) ;and is a singleton
-               (build-choice-enum1 (cdr enum-info-lst));dont do a let
-               `(let ((x (- x ,(caar enum-info-lst))))
-                 ,(build-choice-enum1 (cdr enum-info-lst))))))
-        (t ; assume all remaining are infinite
-         (let ((nchoices (len enum-info-lst)))
-           `(mv-let (n x)
-                    (switch-nat ,nchoices  (nfix x));nfix helps termination
-                    ,(build-inf-choices-enum-n enum-info-lst 0))))))
-
-#|
-(build-choice-enum '((5 nth x *blah5*)
-                     (7 nth x *blah7*)
-                     (1 quote nil)
-                     (t nth-whatever x)
-                     (t nth-moo x)))
-
-(build-choice-enum '((1 quote nil)
-                     (1 quote pl)
-                     (5 nth x *blah5*)
-                     (7 nth x *blah7*)
-                     (t nth-whatever x)
-                     (t nth-moo x)
-                     ))
-                     
-|#
-
-;build up product expressions for enumerator functions to be generated
-;order is maintained while generating values
-;enum-info-lst is of form : (size/magnitude . (enumerator call)) or (1 . constant-value)
-(defun build-product-comb-enum-actuals (enum-info-lst fin-n inf-n)
-  (declare (xargs :mode :program))
-  (cond ((endp enum-info-lst)
-         nil)
-        ((equal 1 (caar enum-info-lst));singleton
-         (cons (cdar enum-info-lst)
-               (build-product-comb-enum-actuals (cdr enum-info-lst) fin-n inf-n)))
-        ((natp (caar enum-info-lst)) ; finite enum info
-         (cons `(let ((x (nth ,fin-n finxlst)))
-                  ,(cdar enum-info-lst))
-               (build-product-comb-enum-actuals (cdr enum-info-lst) (1+ fin-n) inf-n)))
-        (t                           ; infinite
-         (cons `(let ((x (nth ,inf-n infxlst)))
-                  ,(cdar enum-info-lst))
-               (build-product-comb-enum-actuals (cdr enum-info-lst) fin-n (1+ inf-n))))))
-
-
-(defun build-product-comb-enum (enum-info-lst conx)
-  (declare (xargs :mode :program))
-  (let* ((singleton-info-lst (get-singleton-enum-infos enum-info-lst))
-         (fin-info-lst1 (get-fin-enum-infos enum-info-lst))
-         (fin-info-lst (append singleton-info-lst fin-info-lst1))
-         (inf-info-lst (get-inf-enum-infos enum-info-lst))
-         (call (cons conx (build-product-comb-enum-actuals enum-info-lst 0 0)))
-         (expr1 (if (> (len inf-info-lst) 0)
-                  (if (= (len inf-info-lst) 1)
-                    `(let ((infxlst (list (nfix x))));29 Apr 2011 fix termination of mut-rec enum-fns
-                       ,call)
-                    `(let ((infxlst (split-nat ,(len inf-info-lst) (nfix x))));29 Apr 2011 fix termination of mut-rec enum-fns
-                       ,call))
-                 call))
-         (expr2 (if fin-info-lst1 ;only if there are choices to be made(in singleton theres no choice)
-                  (if inf-info-lst
-                    `(mv-let 
-                      (finxlst x)
-                      (multiple-switch-nat ',(strip-cars fin-info-lst)
-                                           (nfix x));nfix helps termination
-;pass on the seed if there are inf enums ahead
-                      ,expr1)
-                    `(mv-let 
-                      (finxlst x)
-                      (multiple-switch-nat ',(strip-cars fin-info-lst)
-                                           (nfix x));nfix helps termination
-                      (declare (acl2::ignorable x))
-;dont pass on seed if no inf enums ahead
-                      ,expr1))
-                  expr1)))
-    expr2))
-
-#|
-(build-product-comb-enum '((t nth-whatever x)
-                           (1  quote nil)
-                           (5 nth x *blah5*)
-                           (7 nth x *blah7*)
-                           (t nth-moo x)
-                           )
-                 'list)
-(build-product-comb-enum '((1  quote nil)
-                           (1  quote 1)
-                           (1 .  2)
-                           (t nth-what x)
-                           (t nth-moo x))
-                 'woo)
-
-|#
-
-;2 funs added by harshrc
-(defun found-recursive-enum-call (inf-enum-call inf-enum-syms)
-  (declare (xargs :guard (true-listp inf-enum-syms)))
-  (if (endp inf-enum-syms)
-      nil
-    (if (mem1 (car inf-enum-syms) (flatten inf-enum-call nil)) 
-;if found a inf-enum in the call its recursive return immediately
-        t 
-      (found-recursive-enum-call inf-enum-call (cdr inf-enum-syms)))))
-    
-(local (defthm append-of-2-lists-is-true-list
-         (implies (and (true-listp x1)
-                       (true-listp x2))
-              (true-listp (append x1 x2)))
-         :rule-classes :type-prescription))
-     
-;sort enums by those which are base cases first, ie non-recursive
-;This fun fixes a bug where theres a recursive defdata and the sequence is
-;such that in the oneof the recursive case comes first than the base case
-;BUG-FIX: This sorting function is not stable i.e it changes the order
-;of those enums with the same size.
-(defun sort-inf-enum-infos (inf-enum-infos inf-enum-syms non-rec-ans rec-ans)
-  (declare (xargs :verify-guards nil
-                  :guard (and (true-listp inf-enum-syms)
-                              (true-listp rec-ans)
-                              (true-listp non-rec-ans))))
-  (if (endp inf-enum-infos)
-    (append non-rec-ans rec-ans)
-    (if (found-recursive-enum-call
-         (cdr (car inf-enum-infos))
-         inf-enum-syms)
-      (sort-inf-enum-infos (cdr inf-enum-infos) 
-                           inf-enum-syms
-                           non-rec-ans
-                           ;;add to rec-ans in order
-                           (append rec-ans (list (car inf-enum-infos))))
-      (sort-inf-enum-infos (cdr inf-enum-infos) 
-                           inf-enum-syms
-                           ;;add to non-rec-ans in order
-                           (append non-rec-ans (list (car inf-enum-infos)))
-               rec-ans))))
-                
-                           
-                           
-         
-  
-;; (sort-inf-enum-infos '( (T LET ((INFXLST (SPLIT-NAT 2 X)))
-;;                            (CONS (LET ((X (NTH 0 INFXLST)))
-;;                                       (ACL2::NTH-INTEGER X))
-;;                                  (LET ((X (NTH 1 INFXLST)))
-;;                                       (NTH-FOO X))))
-;;                        (T ACL2::NTH-INTEGER X)) '(nth-foo) nil)
-
-
-;;; the following clique builds enumerators of product and union types
-;;; inf <- inf * inf - use split-nat to get two naturals
-;;; inf <- inf * fin - use switch-nat to get one natural and one bounded val
-;;; inf <- inf + inf - use switch-nat with 2 possibilies to determine which
-;;;                    possibility to choose and the natural number to give it
-;;; inf <- inf + fin - if < #finite posibilities, use that.  otherwise,
-;;;                    subtract #finite possibilities to get natural
-;;; split-nat : bijection from N -> N * N (takes a Nat and returns two Nat)
-;;; switch-nat: takes a number of possibilities and another natural number
-;;; and returns a value from 0 to possibilities-1 and a natural number.
-(mutual-recursion
- (defun er-trans-datadef-as-enumerator-lst (defbody-lst finite-defs inf-enum-syms
-                                             new-constructors ctx wrld state)
-   (declare (xargs :mode :program 
-                   :guard (and (symbol-alistp finite-defs)
-                               (symbol-listp inf-enum-syms)
-                               (symbol-alistp new-constructors)
-                               (symbolp ctx)
-                               (plist-worldp wrld))))
-   (if (atom defbody-lst)
-       (if (null defbody-lst)
-           (value nil)
-         (er soft ctx "Expecting a true list but last cdr is ~x0" defbody-lst))
-     (er-let* ((car-stuff
-                (er-trans-datadef-as-enumerator (car defbody-lst)
-                                                finite-defs inf-enum-syms
-                                                new-constructors
-                                                ctx wrld state))
-               (cdr-stuff-lst
-                (er-trans-datadef-as-enumerator-lst (cdr defbody-lst)
-                                                    finite-defs inf-enum-syms
-                                                    new-constructors
-                                                    ctx wrld state)))
-      (value (cons car-stuff cdr-stuff-lst)))))
-
- (defun er-trans-datadef-as-enumerator (defbody finite-defs inf-enum-syms
-                                         new-constructors ctx wrld state)
-   (declare (xargs :guard (and (symbol-alistp finite-defs)
-                               (symbol-listp inf-enum-syms)
-                               (symbol-alistp new-constructors)
-                               (symbolp ctx)
-                               (plist-worldp wrld))))
-   (cond ((possible-constant-valuep defbody)
-          (er-let* ((val (er-get-constant-value defbody ctx wrld state)))
-           (value (cons 1 (list 'quote val)))))
-         ((symbolp defbody)
-          (er-get-enumeration-info defbody 'x
-                                   finite-defs inf-enum-syms
-                                   ctx wrld state))
-; should be a cons if we get here
-         (t
-          (let ((comb (car defbody)))
-           (cond 
-            ((or (eq comb 'oneof)
-                 (eq comb 'anyof))
-             (if (atom (cdr defbody))
-                 (er soft ctx "~x0 must be given at least one argument." comb)
-               (er-let* ((rst (er-trans-datadef-as-enumerator-lst
-                               (cdr defbody) finite-defs inf-enum-syms
-                               new-constructors
-                               ctx wrld state)))
-                (let* ((singleton-rst (get-singleton-enum-infos rst))
-                       (fin-rst (get-fin-enum-infos rst))
-                       (inf-rst (get-inf-enum-infos rst))
-                       (sorted-inf-rst (sort-inf-enum-infos inf-rst 
-                                                            inf-enum-syms nil nil))
-;finite values enumerated first and in inf case, base case come first
-;by base case i mean non-recursive enums --harshrc (this fixes a bug)
-                       (new-rst (append singleton-rst 
-                                        fin-rst
-                                        sorted-inf-rst)) 
-;build union enum expression
-                       (enumerator (build-choice-enum new-rst))
-                       (magnitude (or (consp inf-rst) 
-;add finite sizes if no inf exists
-                                      (+ (len singleton-rst)
-                                         (+-cars fin-rst)))))
-                  (value (cons magnitude enumerator))))))
-
-            (t 
-; look up as constructor(registered or new), then as macro
-             (let* ((registered-conx-info (or (assoc-eq comb (table-alist 'data-constructors wrld))
-                                              (assoc-eq comb (table-alist 'generated-constructors wrld))))
-                    (to-be-created-conx-info (assoc-eq comb new-constructors))
-                    (conx-info (or registered-conx-info 
-                                   to-be-created-conx-info)))
-                    
-               (if conx-info 
-                   (er-let* ((rst (er-trans-datadef-as-enumerator-lst
-                                   (cdr defbody) finite-defs inf-enum-syms
-                                   new-constructors
-                                   ctx wrld state)))
-                    (let* (;(singleton-rst (get-singleton-enum-infos rst)) ;No need to multiple below by 1
-                           (fin-rst (get-fin-enum-infos rst))
-;build product enum expression
-                           (inf-rst (get-inf-enum-infos rst)) 
-                           (enumerator (build-product-comb-enum rst comb)) ; order matters
-                           (magnitude (or (consp inf-rst) 
-;multiply finite sizes if no inf exists
-                                          (*-cars fin-rst))))
-                      (value (cons magnitude enumerator))))
-                 (if (true-listp (acl2-getprop comb 'macro-args wrld
-                                               :default :undefined))
-                     
-                     ;; attempt macro expansion
-                     (er-let* ((newdefbody (macroexpand1 defbody ctx state)))
-                      (er-trans-datadef-as-enumerator newdefbody
-                                                      finite-defs 
-                                                      inf-enum-syms
-                                                      new-constructors 
-                                                      ctx wrld state))
-                   ;; otherwise, illegal
-                   (er soft ctx "~x0 is not a recognized constructor or ~
-                                 type combinator." comb))))))))))
-)
-
-
-#|
-(define-enumeration-type boolean '(t nil))
-(register-data-constructor (consp cons)
-                           ((allp car) (allp cdr))
-                           :proper t)
-;(defconst *foo-values* '(1 2 3))
-(er-trans-datadef-as-enumerator-lst
- '((oneof (cons integer
-                foo)
-          integer))
- nil
- '(nth-foo acl2::nth-integer) ;;-- changed from foo
- nil
- 'top-level
- (w state)
- state)
-|#
-
-
-(defun cons-up-names-decls-lls-bodies (names decls lls bodies)
-  (declare (xargs :guard (and (true-listp names)
-                              (true-listp decls)
-                              (true-listp lls)
-                              (true-listp bodies))))
-  (if (endp names)
-    nil
-    (cons (if (consp decls);not null (only include declare if its not empty)
-            (list (car names) (car lls) (car decls) (car bodies))
-            (list (car names) (car lls) (car bodies)))
-          (cons-up-names-decls-lls-bodies (cdr names)
-                                    (cdr decls)
-                                    (cdr lls)
-                                    (cdr bodies)))))
-
-(defun cons-up-defconsts (names vals)
-  (declare (xargs :guard (and (true-listp names)
-                              (true-listp vals))))
-  (if (endp names)
-    nil
-    (cons `(defconst ,(car names) ',(car vals))
-          (cons-up-defconsts (cdr names)
-                             (cdr vals)))))
-
-(defun cons-up-pred-defthms (tnames pnames bodies rsts)
-   (declare (xargs :guard (and (true-listp tnames)
-                               (true-listp bodies)
-                               (true-listp pnames)
-                               (true-listp rsts))))
-                               
-  (if (endp tnames)
-    nil
-    (cons `(defthm ,(car tnames)
-             (equal (,(car pnames) v)
-                    ,(car bodies))
-             :rule-classes nil
-             . ,(car rsts))
-          (cons-up-pred-defthms (cdr tnames)
-                                (cdr pnames)
-                                (cdr bodies)
-                                (cdr rsts)))))
-
-(defun cons-up-non-recursive-pred-definition-defthms (tnames pnames bodies)
-   (declare (xargs :guard (and (true-listp tnames)
-                               (true-listp bodies)
-                               (true-listp pnames))))
-                               
-  (if (endp tnames)
-    nil
-    (cons `(defthm ,(car tnames)
-             (equal (,(car pnames) v)
-                    ,(car bodies))
-             :hints (("Goal" :in-theory (enable ,(car pnames)))))
-          (cons-up-non-recursive-pred-definition-defthms (cdr tnames)
-                                                         (cdr pnames)
-                                                         (cdr bodies)))))
-
-(defun collect-with-plausible-pred-fns (lst wrld)
-  (declare (xargs :guard (and (symbol-listp lst)
-                              (plist-worldp wrld))))
-  (if (endp lst)
-    nil
-    (if (plausible-predicate-functionp (get-predicate-symbol (car lst)) wrld)
-      (cons (car lst)
-            (collect-with-plausible-pred-fns (cdr lst) wrld))
-      (collect-with-plausible-pred-fns (cdr lst) wrld))))
-
-
-;;Record types
-;;1. make constructor, its predicate, and the destructors
-;;2. register the above using register-data-constructor
-#|
-(defdata tree (oneof nil
-                     (node (val . symbol) (left . tree) (right . tree))))
-
-==>
-(defdata tree (oneof nil
-                     (node symbol tree tree))) ;just like peters version
-X:tree = (node 'a (node 'b nil nil) nil)
-X:tree = (node (val . 'a) (left . (node (val . 'b) (left . nil) (right . nil))) (right . nil)) 
-
-(defdata cons (record (car . all) (cdr . all)))
-
-X:cons = (record (car . '("sd" 2 3)) (cdr . 'abc))
-X:cons = (cons '("sd 2 3) 'abc)
-
-(defdata triple (record (fst . all) (scd . all) (thd . all)))
-X:triple = (record (fst . 1) (scd . "hello") (thd . '(+ 23 45))) ;can be recog, cos destr are unique
-X:triple = (triple 1 "hello" '(+ 23 45))
-
-
-(defdata hyperlink (record (protocol . string)
-                           (address . string)
-                           (display . string)))
-X:hyperlink = (record (protocol . "httpx") (display . "my site") (address . "192.168.1.10"))
-==>
-X:hyperlink = (hyperlink "httpx" "my site" "192.168.1.10")
-|#
-
-
-(defun build-dex-recordImpl-bindings (dex-names dex-var-names rec-expr)
-  (declare (xargs :guard (and (symbol-listp dex-names)
-                              (symbol-listp dex-var-names)
-                              (= (len dex-var-names)
-                                 (len dex-names)))))
-  (if (endp dex-names)
-    nil
-    (let* ((dname (car dex-names))
-           (dname-var (car dex-var-names))
-           (d-keyword-name (intern (symbol-name dname) "KEYWORD")))
-      (cons (list dname-var (list 'mget d-keyword-name rec-expr))
-            (build-dex-recordImpl-bindings (cdr dex-names) (cdr dex-var-names) rec-expr)))))
-
-(defthm build-dex-recordImpl-bindings-sig1
-  (acl2::all->=-len (build-dex-recordImpl-bindings dex-names dex-var-names rec-expr)
-                    2))
-
-(defun build-dex-alist (dex-names dex-var-names)
-  (declare (xargs :guard (and (symbol-listp dex-names)
-                              (symbol-listp dex-var-names)
-                                 )))
-                  
-  (if (endp dex-names)
-    nil
-    (let* ((dname (car dex-names))
-           (dvar-name (car dex-var-names))
-           (d-keyword-name (intern (symbol-name dname) "KEYWORD")))
-      `(mset ,d-keyword-name ,dvar-name
-          ,(build-dex-alist (cdr dex-names) (cdr dex-var-names))))))
-
-;;make a constructor defun and corresponding predicate
-(defun make-constructor-predicate (conx-name dex-pairs)
-  (declare (xargs :guard (and (symbolp conx-name)
-                              (symbol-alistp dex-pairs))))
-                  ;:guard-hints (("Goal" :in-theory (disable modify-symbol string-append)))))
-  (let* ((dex-orig-names (strip-cars dex-pairs))
-         (prefix (string-append (symbol-name conx-name) "-"))
-         (dex-names (modify-symbol-lst prefix dex-orig-names "")) ;make new prefixed destr names
-         (dex-preds (strip-cdrs dex-pairs))
-         (dex-var-names (modify-symbol-lst "Var" dex-names ""))
-         (dex-prex-calls (build-one-param-calls dex-preds dex-var-names))
-         (dex-alist (build-dex-alist dex-orig-names dex-var-names))
-         (dex-bindings  (build-dex-recordImpl-bindings dex-orig-names dex-var-names 'v))
-        
-         (conx-pred (get-predicate-symbol conx-name)))
-    `((defund ,conx-pred (v) ;disabled def
-        (declare (xargs :guard t))
-        (if (not (acl2::good-map v));for guards and termination (CCG)
-          nil
-          (let ,dex-bindings 
-            (and  (equal v (mset 'constructor ',conx-name ,dex-alist))
-                  ,@dex-prex-calls 
-                  )))))))
-  
-
-;cons-up calls of above function
-(defun cons-up-conx-prex-ev (conx-names dex-pairs-lst)
-  (declare (xargs :guard (and (symbol-listp conx-names)
-                              (true-list-symbol-alistp dex-pairs-lst)
-                              (= (len conx-names) (len dex-pairs-lst)))))
-  (if (endp conx-names)
-    nil
-    (append (make-constructor-predicate (car conx-names) (car dex-pairs-lst))
-            (cons-up-conx-prex-ev (cdr conx-names) (cdr dex-pairs-lst)))))
-
-(defun make-rec-record-conx-pred-implies-defthm (conx-name dex-pairs)
-  (declare (xargs :guard (and (symbolp conx-name)
-                              (symbol-alistp dex-pairs))))
-  (let* ((dex-orig-names (strip-cars dex-pairs))
-         (prefix (string-append (symbol-name conx-name) "-"))
-         (dex-names (modify-symbol-lst prefix dex-orig-names "")) ;make new prefixed destr names
-         (dex-preds (strip-cdrs dex-pairs))
-         (dex-var-names (modify-symbol-lst "Var" dex-names ""))
-         (dex-bindings  (build-dex-recordImpl-bindings dex-orig-names dex-var-names 'v))
-         (conx-pred (get-predicate-symbol conx-name)))
-`((local
- (progn
-  (in-theory (enable ,conx-pred))
-  (defthm ,(modify-symbol "" conx-name "-implies1")
-    (implies (,conx-pred v)
-             (equal (EQUAL v ,(cons conx-name (strip-cadrs dex-bindings)));(mget :key x) (mget :LEVEL x) (mget :LEFT x)  (mget :RIGHT x)))
-                    t))
-    :hints (("Goal" :in-theory (disable . ,dex-preds)))
-    :rule-classes (:forward-chaining))
-  
-  (defthm ,(modify-symbol "" conx-name "-implies2")
-    (implies (EQUAL x ,(cons conx-name dex-names));AA-KEY  AA-LEVEL AA-LEFT AA-RIGHT))
-             (mget 'DEFDATA::CONSTRUCTOR x)))
-  
-  (defthm ,(modify-symbol "" conx-name "-is-consp-lemma");node-is-consp-lemma
-    (implies (,conx-pred x)
-             (mget 'DEFDATA::CONSTRUCTOR x))
-    :rule-classes (:forward-chaining))))
-  
-  (defthm ,(modify-symbol "" conx-name "-implies-consp")
-    (implies (,conx-pred x)
-             (consp x)))
-  )))
-
-;cons-up calls of above function
-(defun cons-up-rec-record-conx-pred-defthm-ev (conx-names dex-pairs-lst)
-  (declare (xargs :guard (and (symbol-listp conx-names)
-                              (true-list-symbol-alistp dex-pairs-lst)
-                              (= (len conx-names) (len dex-pairs-lst)))))
-  (if (endp conx-names)
-    nil
-    (append (make-rec-record-conx-pred-implies-defthm (car conx-names) (car dex-pairs-lst))
-            (cons-up-rec-record-conx-pred-defthm-ev (cdr conx-names) (cdr dex-pairs-lst)))))
-
-;guard verif thm
-(defthm symbol-alistp-strip-cars-is-symbol-listp
-  (implies (symbol-alistp P)
-           (symbol-listp (strip-cars P))))
-
-;make the event for defining constructor
-(defun make-constructor (conx-name dex-pairs)
-  (declare (xargs :guard (and (symbolp conx-name)
-                              (symbol-alistp dex-pairs))))
-  (let* ((dex-orig-names (strip-cars dex-pairs))
-         (prefix (string-append (symbol-name conx-name) "-"))
-         (dex-names (modify-symbol-lst prefix dex-orig-names "")) ;make new prefixed destr names
-         (dex-prex (strip-cdrs dex-pairs))
-         (dex-var-names (modify-symbol-lst "Var" dex-names ""))
-         (dex-prex-calls (build-one-param-calls dex-prex dex-var-names))
-         (dex-alist (build-dex-alist dex-orig-names dex-var-names)))
-    `((defun ,conx-name ,dex-var-names
-        (declare (xargs :guard (and . ,dex-prex-calls))) ;guards not working with new record impl
-                        ;:verify-guards nil))
-        (mset 'constructor ',conx-name ,dex-alist)))))
-
-;cons-up calls of above function
-(defun cons-up-conx-ev (conx-names dex-pairs-lst)
-  (declare (xargs :guard (and (symbol-listp conx-names)
-                              (true-list-symbol-alistp dex-pairs-lst)
-                              (= (len conx-names) (len dex-pairs-lst)))))
-  (if (endp conx-names)
-    nil
-    (append (make-constructor (car conx-names) (car dex-pairs-lst));append instead of cons
-          (cons-up-conx-ev (cdr conx-names) (cdr dex-pairs-lst)))));bcos (append (X) Y) = (cons X Y)
-
-(defun make-measure-fn (conx-name dex-pairs)
-  (declare (xargs :mode :program
-                  :guard (and (symbolp conx-name)
-                              (symbol-alistp dex-pairs))))
-  (let* ((dex-names (strip-cars dex-pairs))
-         (prefix (string-append (symbol-name conx-name) "-"))
-         (dex-names (modify-symbol-lst prefix dex-names "")) ;make new prefixed destr names
-         ;(dex-prex (strip-cdrs dex-pairs))
-         (conx-pred (get-predicate-symbol conx-name))
-         (msr-fn (modify-symbol "" conx-name "-COUNT")))
-    `((defun ,msr-fn (v)
-        (if (,conx-pred v)
-          (+ 1  . ,(list-up-lists
-                    (make-list (len dex-names) :initial-element msr-fn)
-                    (build-one-param-calls dex-names 
-                                           (make-list (len dex-names)
-                                                      :initial-element 'v))))
-          0)))))
-
-
-;cons up events that define destructor functions
-(defun cons-up-dex-defuns (conx-pred selector-fn-names dex-names)
-  (declare ;(ignore conx-pred)
-           (xargs :guard (and (symbol-listp selector-fn-names)
-                              (symbol-listp dex-names)
-                              (equal conx-pred conx-pred))))
-  (if (endp dex-names)
-    nil
-    (let* ((sel-fn-name (car selector-fn-names))
-           (dname (car dex-names))
-           (d-keyword-name (intern (symbol-name dname) "KEYWORD")))
-    (cons `(defun ,sel-fn-name (v)
-             (declare (xargs :guard (,conx-pred v))) ;not working with new record impl
-                             ;:verify-guards nil))
-             (mget ,d-keyword-name v))
-          (cons-up-dex-defuns conx-pred
-                              (cdr selector-fn-names)
-                              (cdr dex-names)
-                              )))))
-                              
-;top level call for the previous function, basically generate code for destrs
-(defun make-destructors (conx-name dex-pairs)
-  (declare (xargs :guard (and (symbolp conx-name)
-                              (symbol-alistp dex-pairs))))
-  (let* ((dex-names (strip-cars dex-pairs))
-         (prefix (string-append (symbol-name conx-name) "-"))
-         (selector-fn-names (modify-symbol-lst prefix dex-names "")) ;make new prefixed destr names
-         (conx-pred (get-predicate-symbol conx-name)))
-    (cons-up-dex-defuns conx-pred selector-fn-names dex-names)))
-
-;do the above for more than one constructors defined during a datadef
-(defun append-up-dex-ev (conx-names dex-pairs-lst)
-  (declare (xargs :guard (and (symbol-listp conx-names)
-                              (true-list-symbol-alistp dex-pairs-lst)
-                              (= (len conx-names) (len dex-pairs-lst))
-                              )))
-  (if (endp conx-names)
-    nil
-    (append (make-destructors (car conx-names) (car dex-pairs-lst))
-            (append-up-dex-ev (cdr conx-names) (cdr dex-pairs-lst)))))
-
-
-(defun compute-reg-conx-dex (conx-name dex-pairs)   
-  (declare (xargs :guard (and (symbolp conx-name)
-                              (symbol-alistp dex-pairs))))
-  (let* ((conx-pred (get-predicate-symbol conx-name))
-         (dex-names (strip-cars dex-pairs))
-         ;(prefix (string-append (symbol-name conx-name) "-"))
-         ;(dex-names (modify-symbol-lst prefix dex-names nil));make new prefixed destr names
-         (dex-prex (strip-cdrs dex-pairs))
-         (dex-pairs (cons-up-lists dex-names dex-prex))
-        ;(msr-fn (modify-symbol nil conx-name "-COUNT"))
-        (msr-fn 'none)
-        (conx-pair (cons conx-name conx-pred)))
-    `((register-data-constructor ,conx-pair 
-                                 ,dex-pairs
-                                 :measure-fn ,msr-fn
-                                 :generated t
-                                 :proper t
-                                 :hints (("Goal" :in-theory (enable ,conx-pred)))))))
-
-(defun cons-up-reg-conx-dex-ev (conx-names dex-pairs-lst)
-  (declare (xargs :guard (and (symbol-listp conx-names)
-                              (true-list-symbol-alistp dex-pairs-lst)
-                              (= (len conx-names) (len dex-pairs-lst)))))
-  (if (endp conx-names)
-    nil
-    (append (compute-reg-conx-dex (car conx-names) (car dex-pairs-lst))
-          (cons-up-reg-conx-dex-ev (cdr conx-names) (cdr dex-pairs-lst)))))
-
-
-;;Enumerated types should not occur in mutually rec defs
-#|
-Enum types:
-(defdata boolean (enum '(t nil))
-(defdata rgbcolors (enum '(red blue green)))
-(defdata suit (enum '(spades hearts diamonds clubs)))
-X:suit = spades
-X:rgbcolors = blue
-|#
-;;process enum form : compute enumeration events
-;;Return value-triple nil if not of form enum
-;;Returns a define-enumeration-type event form otherwise
-
-(defun process-enum-form (defs ctx wrld)
-  (declare (xargs :mode :program))
-; 08/28/12 refactoring using b*
-  (b* (((when (> (len defs) 1)) ;;mutually recursive
-        (let ((defbodies (strip-cadrs defs)))
-         (if (and (true-list-listp defbodies)
-                  (member-eq 'enum (strip-cars defbodies)))
-             (er hard? ctx 
-"Syntax error in use of enum: Enumerated type cannot appear ~
-                     in mutually recursive definitions.~%")
-           nil)))
-       (def (car defs)) ;;single def
-       (name (car def))
-       (enumbody (cadr def))
-       (enumlen (len enumbody))
-       ((unless (consp enumbody)) nil)
-       ((unless (eq 'enum (car enumbody))) nil)
-       ((unless (= enumlen 2))
-        (er hard? ctx 
-"Syntax error in enum: Enum ~x0 should be of following form: ~
-     (defdata <id> (enum <list-of-values>)) or ~
-     (defdata <id> (enum <val1> ...)) .~%" enumbody))
-       (values (cadr enumbody))
-       ((unless (true-listp values))
-        (er hard? ctx 
-"Syntax error in enum: ~x0 must evaluate to a list of values.~%" values)))
-   (append
-    (compute-define-enumeration-type-events name
-                                            (get-predicate-symbol name)
-                                            (get-values-symbol name)
-                                            (get-predicate-testthm-symbol name)
-                                            values wrld)
-    `((value-triple ',name)))))
-       
-
-;;check for empty defs
-(defun found-empty-defp (defs)
-  (declare (xargs :guard (true-listp defs)))
-  (if (endp defs)
-    nil
-    (let ((def (car defs)))
-      (if (< (len def) 2)
-        t
-        (if (and (= (len def) 2)
-                 (consp (cadr def))
-                 (and (= (len (cadr def)) 1)
-                      (or (eq (caadr def) 'oneof)
-                          (eq (caadr def) 'anyof)
-                          (eq (caadr def) 'listof)
-                          (eq (caadr def) 'record)
-;                          (eq (caadr def) 'map)
-                          (eq (caadr def) 'set)
-                          (eq (caadr def) 'enum))))
-          t
-          (found-empty-defp (cdr defs)))))))
-
-(defun type-class-p (x)
-  (mem-eq x '(:undefined 
-              acl2::union acl2::product 
-              acl2::singleton acl2::alias acl2::custom
-              acl2::mutually-recursive 
-              enum record 
-;              map 
-              set listof)))
-
-      
-      
-(defun len-values-enum (values-enum wrld)
-  (declare (xargs :mode :program))
-  (if (and (symbolp values-enum)
-           (quotep (acl2-getprop values-enum 'const wrld)))
-      (len (cadr (acl2-getprop values-enum 'const wrld)))
-    nil))
-
-
-;;; Utility functions copied back from utilities.lisp
-
-(defun is-a-constant-symbolp (x)
-  (or (keywordp x);a keyword
-      (booleanp x);t or nil
-      (legal-constantp x)));ACL2::CONSTANT
-
-;Sig: Any -> Bool
-;check if x can be used as an identifier, i.e. has not been previously defined
-(defun is-a-identifier (x wrld)
-  (declare (xargs :mode :program))
-  (if (and (is-a-variablep x)
-           (acl2::new-namep x wrld))
-    x
-    nil))
-
-
-;--------------------------TYPE Metadata Table----------------------------------------------
-(defrec types-info%
-  (size enumerator predicate test-enumerator 
-        recursivep derivedp
-        type-class defs) NIL)
-
-(defun types-info%-p (v)
-  (declare (xargs :guard T))
-  (case-match v
-    (
-     ('types-info% size enumerator predicate test-enumerator 
-            recursivep derivedp
-            typeclass defs)
-     (declare (ignorable enumerator test-enumerator defs))
-     (and (or (natp size)
-              (eq 't size))
-          (symbolp predicate)
-          (booleanp recursivep)
-          (booleanp derivedp)
-          (type-class-p typeclass)))))
-  
-;;-- stores information about types introduced using defdata
-;;-- (key val)
-;;;--Modified Oct2-2009 added test enumerator
-;;-- (type-name (type-size type-enum . predicate))
-;;-- (rational (t nth-rational rationalp nth-rational-test)) 
-;;-- type-size is t for infinite type and a natural number if finite
-;;-- type-enum can be either NTH-type-name or *type-name-VALUES* 
-;;--Note: predicate still can be such that name restriction is not there,
-;;--for example we add atom in base.lisp. But for enum its strictly followed
-;;Modified Jun 26 2011 harshrc
-;;Use a records data structure for values in the table for easy
-;;extensibility
-;; Modified Aug 28 '12 to cutil record utility
-(table types-info-table nil nil :guard
-       (and 
-        (types-info%-p val)
-        (b* ((TI.predicate (acl2::access types-info%  val :predicate))
-             (TI.size (acl2::access types-info%  val :size))
-             (TI.enumerator (acl2::access types-info%  val
-                                          :enumerator))
-             (TI.test-enumerator (acl2::access types-info%  val
-                                          :test-enumerator)))
-             
-         (and 
-          (plausible-predicate-functionp TI.predicate world)
-          (if (is-a-variablep TI.test-enumerator) 
-              (or (allows-arity TI.test-enumerator 1 world)
-                  (quotep (acl2-getprop TI.test-enumerator 'const world)))
-            t)
-          (if (eq TI.size 't)
-              (and (eq TI.enumerator (get-enumerator-symbol key))
-                   (allows-arity TI.enumerator 1 world))
-            (or (and (eql 1 TI.size)
-                     (possible-constant-valuep TI.enumerator));singleton
-                (and (natp TI.size) ;added a empty type (although it shudnt be allowed in normal defdata)
-                     (eq TI.enumerator (get-values-symbol key))
-                     (eql TI.size (len-values-enum TI.enumerator world)))))))))
-
-
-;check this TODO
-(defun is-singleton-type-p (obj)
-  (possible-constant-valuep obj))
-
-(defun is-singleton-type-lst-p (obj-lst)
-  (declare (xargs :guard (true-listp obj-lst)))
-  (if (endp obj-lst)
-    t
-  (and (possible-constant-valuep (car obj-lst))
-       (is-singleton-type-lst-p (cdr obj-lst)))))
-
-;TYPES
-;check if fn-name is a type-pred by checking for corresponding typ pres rule
-;; (defun has-type-prescription-rule (fn-name wrld)
-;;   (declare (xargs :guard (and (symbolp fn-name)
-;;                               (plist-worldp wrld))))
-;;   (acl2-getprop fn-name 'acl2::type-prescriptions wrld))
-                  
-
-;if true then returns the type name (not the predicate)
-;is true is Tp is a predicate and nth-T or *T-values* is defined in world
-;Sig: Sym * World -> Sym
-(defun is-custom-type-predicate (pred wrld)
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbolp pred)
-                              (plist-worldp wrld)
-                              )))
-(let* ((typ (get-typesymbol-from-pred pred))
-       (values (modify-symbol "*"  typ "-VALUES*"))
-       (enum   (modify-symbol "NTH-" typ "")))
-  (if (plausible-predicate-functionp pred wrld)
-    (if (or (allows-arity enum 1 wrld) ;is enum defined in wrld
-            (acl2-getprop values 'acl2::const wrld) 
-;;or is values defined in wrld
-            )
-      typ ;THIS CAN BE NIL, if pred doesnt follow naming convention, works out well in any case
-      nil)
-    nil)))
-
-;;is a predicate explicitly recognized in the defdata framework? 
-;;if true then returns the corresponding type
-;; BUG here, with every change of type table, you might have to change this function
-(defun is-datadef-type-predicate (fn-name typtable-alst)
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbolp fn-name)
-                              (symbol-alistp typtable-alst))))
-  (if (endp typtable-alst)
-    nil
-    (b* (((cons typ info%) (car typtable-alst)))
-      (if (eq fn-name (acl2::access types-info% info% :predicate)) ;TODO: here for multiple pred aliases
-          typ
-        (is-datadef-type-predicate fn-name (cdr typtable-alst))))))
-
-
-
-;is a possible type (ASK:should we also pick compound recognizers?)
-;is either custom type pred or datadef pred
-;if true then returns the type name (not the predicate)
-;Sig: Sym * World -> Sym
-(defun is-type-predicate (fn-name wrld)
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbolp fn-name)
-                              (plist-worldp wrld))))
-  (or (is-datadef-type-predicate fn-name (table-alist 'types-info-table wrld));is in types table
-      (is-custom-type-predicate fn-name wrld)));is a custom type in the current world
-
-;Sig: Sym * State -> bool
-;purpose: Check wether id is an identifier, which has not been previously defined as a type
-(defun is-a-typeId-p (id wrld)
-  (declare (xargs :verify-guards nil
-                  :guard (plist-worldp wrld)))
-  (and (is-a-variablep id)
-       (let ((typ-alst (table-alist 'types-info-table wrld))
-             (pred (get-predicate-symbol id)))
-         (and (not (assoc-eq id typ-alst))
-              (not (is-custom-type-predicate pred wrld))))))
-
-;Sig: Sym * World -> Sym (typename)
-;type has been defined using register-custom-type
-(defun is-a-registered-custom-type (type wrld)
-  (declare (xargs :verify-guards nil))
-  (if (is-a-variablep type);shud be a variable symbol
-    (let* ((typ-alst (table-alist 'types-info-table wrld))
-          (typ-entry (assoc-eq type typ-alst))) 
-      (if (and typ-entry
-               (not (acl2::access types-info% (cdr typ-entry) :derivedp)))
-        type ;if not derived by defdata but in the type table return type
-        nil))
-    nil))
-
-;type has been defined using the defdata form
-(defun is-a-defdata-type (type wrld)
-  (declare (xargs :verify-guards nil))
-  (if (is-a-variablep type);shud be a variable symbol
-    (let* ((typ-alst (table-alist 'types-info-table wrld))
-          (typ-entry (assoc-eq type typ-alst))) 
-      (if (and typ-entry 
-               (acl2::access types-info% (cdr typ-entry) :derivedp))
-        type ;if derived by defdata return type
-        nil))
-    nil))
-
-;purpose: Check wether argument  has been previously defined as a type using defdata
-;or is clearly recognized by the defdata framework, i.e. it could also be a custom
-;type which has been added into the types-info-table using register-custom-type.
-;could also have been implemented in terms of is-datadef-type-predicate
-(defun is-a-predefined-typeName (type wrld)
-  (declare (xargs :verify-guards nil))
-  (or (is-a-registered-custom-type type wrld)
-      (is-a-defdata-type type wrld)))
-
-;Sig: Sym * World -> Sym (typename)
-;purpose: Check wether argument is a custom defined type and not a defdata pred
-(defun is-a-custom-type (type wrld)
-  (declare (xargs :verify-guards nil))
-  (if (is-a-variablep type);shud be a variable symbol
-    (if (is-a-predefined-typeName type wrld)
-      nil
-      (let ((pred (get-predicate-symbol type)))
-        (if (is-custom-type-predicate pred wrld) ;or is a custom type
-          type
-          nil)))
-    nil))
-
-;is either a defdata defined type or a custom typename
-(defun is-a-typeName (type wrld)
-  (declare (xargs :verify-guards nil))
-  (or (is-a-predefined-typeName type wrld)
-      (is-a-custom-type type wrld)))
-
-;------------------------------------------------------------------------
-
-
-;User-controlled testing
-;;;Per type syntax:
-;;;(defdata-testing <type-name>
-;;;                 :test-enumerator <enum-fn>
-;;;                 :filter <filter-fn>
-;;;                 ...)                              
-;register the type by adding it into the types info table
- (defmacro defdata-testing  (typename &key test-enumerator)
-   ":Doc-Section acl2::DATA-DEFINITIONS
-  Specify a custom testing enumerator for a type~/
-  ~c[(defdata-testing T1 :test-enumerator nth-T1-testing)]
-  adds a user-specified enumerator to be used for randomly
-  generating values for type ~c[T1]. This can be used
-  to restrict the testing domain of any type for the
-  purposes of random testing.
-  
-  ~bv[]
-  Examples:
-  (defdata-testing nat :test-enumerator nth-nat-small-values)
-  (defdata-testing list :test-enumerator nth-list-test-small-lists) ;to test small lists
-  (defdata-testing character :test-enumerator *special-chars-only*) ;to test special chars
-  (defdata-testing foo :test-enumerator 999) ;restrict domain of foo to a singleton value
-  ~ev[]                      
-  ~bv[]
-  Usage:
-  (defdata-testing <Type-name1> :test-enumerator <test-enum>)
-  ~ev[]~/
-  "
-  `(with-output
-       :stack :push
-       :off (warning warning! observation prove 
-                     proof-checker event expansion
-                     summary proof-tree)
-
-       (make-event
-        (er-let* ((type-info (table defdata::types-info-table ',typename)))
-          (if type-info
-               (value `(progn
-                        (table defdata::types-info-table 
-                               ',',typename 
-                               (acl2::change types-info% ',type-info
-                                                  :test-enumerator
-                                                  ',',test-enumerator))
-                        (value-triple (list ',',typename ',',test-enumerator))))
-               (er soft 'defdata-testing "~x0 is not a registered type. Use register-custom-type to register it.~%" ',typename))))))
-      
- ;register the type by adding it into the types-info-table
- (defmacro register-custom-type  (typename typesize enum pred 
-                                           &key test-enum
-                                                (type-class 'acl2::custom))
-   "Usage: (register-custom-type foo t nth-foo foop :test-enum my-nth-foo :type-class custom)
-    Purpose: add foo to type metadata table 'types-info-table'. 
-    Second argument is t if foo is infinite, and a positive number o.w., in which case the
-    standard naming convention for the third arg (enumerator) is *foo-values*.
-    keyword args are optional."
-  `(with-output
-    :stack :push
-    :off (warning warning! observation prove 
-                  proof-checker event expansion
-                  summary proof-tree)
-
-    (make-event
-     '(progn
-        (table defdata::types-info-table ',typename 
-               ',(acl2::make types-info%
-                  :size typesize 
-                  :enumerator enum
-                  :predicate pred
-                  :test-enumerator test-enum
-                  :defs nil
-                  :derivedp nil
-                  :recursivep nil
-                  :type-class type-class))
-        (add-datatype-node-batch ,typename)
-        (sync-globals-for-dtg) ;sync globals with SCC and TC 
-        (value-triple (list ',typename 
-                            ',(list typesize enum pred test-enum 
-                                    nil nil type-class)))
-        ))))
-
- #|
- (defconst *foo1-values* '(1 2 3))
- (defun foop (x)
-   (and (posp x)
-        (< x 4)))
- (defconst *foo1-values-testing* '(1 2))
- (include-book ;; fool dependency scanners
-   "graph")
-(register-custom-type foo1 3 *foo1-values* foop nil)
-(defdata-testing foo1 :test-enumerator *foo1-values-testing*)
- |#
-
-
-
-;is a new constuctor Id
-(defun is-a-newconsId (id n wrld)
-  (declare (xargs :mode :program
-                  :guard (and (symbolp id)
-                              (natp n)
-                              (plist-worldp wrld))))
-  (let ((conx-pred (get-predicate-symbol id)))
-    (if (and (is-a-identifier id wrld) ;this makes the following check redundant
-             (not (allows-arity id n wrld));not a predefined function or macro
-             (not (allows-arity conx-pred 1 wrld)));the corresponding pred is also not predefined
-             
-      id
-      nil)))
-
-
-;is a already existing constructor
-(defun is-a-consId (id n wrld)
-  (declare (xargs :mode :program
-                  :guard (and (symbolp id)
-                              (natp n)
-                              (plist-worldp wrld))))
-  (if (and (is-a-variablep id)
-           (allows-arity id n wrld));is a predefined constructor function with correct arity
-    id
-    nil))
-
-
-(defrec supp-lemmas%
-  (set listof record oneof map)
-  NIL)
-
-(defun supp-lemmas%-p (v)
-  (declare (xargs :guard T))
-  (case-match v
-    (
-     ('supp-lemmas% set listof record oneof map)
-     (and (true-listp set)
-          (true-listp listof)
-          (true-listp record)
-          (true-listp oneof)
-          (true-listp map)))))
-
-
-(defconst *initial-supp-lemmas*
-  (acl2::make supp-lemmas%
-   :set '() 
-   :listof '() 
-   :record '()
-   :map '()
-   :oneof '()))
-
-
-
-;defdata temp storage
-(defstobj ds$
-  (defdata-world :type T :initially nil)
-  (newconstructors :type T :initially nil);list
-  (support-lemmas :type T;(satisfies supp-lemmas%-p)
-                  :initially nil);*initial-supp-lemmas*)
-;(struct (set . list) (listof . list) (record . list) (oneof . list))
-  (custom-types :type T :initially nil)
-  (defdata-debug :type (satisfies booleanp) :initially nil)
-  (type-class :type (satisfies type-class-p) :initially :undefined)
-  (record-constituents :type T :initially nil)
-  (product-constituents :type T :initially nil)
-  (union-constituents :type T :initially nil)
-  (is-recursive :type (satisfies booleanp) :initially nil)
-  )
-  
-;Ideally write a macro to generate these forms
-(defmacro add-record-constituent-types-to-ds$ (type)
-`(update-record-constituents (cons ,type (record-constituents ds$)) ds$))
-
-(defmacro add-product-constituent-types-to-ds$ (type)
-`(update-product-constituents (cons ,type (product-constituents ds$)) ds$))
-
-(defmacro add-union-constituent-types-to-ds$ (type)
-`(update-union-constituents (cons ,type (union-constituents ds$)) ds$))
-  
-(defmacro add-custom-types-to-ds$ (type)
-`(update-custom-types (cons ,type (custom-types ds$)) ds$))
-
-;add generated constructor information in a record to a temporary
-;global variable changed pred-body-lst to pred-lst since only
-;typenames are allowed not type expressions.
-;July 8 2010, this was checked with the datadef syntax document
-;June 26 2011, changed to ds$ transient/temp storage stobj for defdata
-(defun add-newconstructor-to-ds$ (newconsid dex pred-lst ds$)
-  (declare (xargs :mode :program 
-                  :stobjs (ds$)))
-  (let ((new-constructor-info 
-         (cons newconsid (list* (list ':generated ':proper)
-                                (get-predicate-symbol newconsid)
-                                (cons-up-lists dex pred-lst)
-                                'none)))
-        (newconstructors-alreadyseen-lst (newconstructors ds$)))
-    (update-newconstructors (cons new-constructor-info
-                                  newconstructors-alreadyseen-lst) ds$)))
-
-
-(program)
-
-
-;is dexpair a destructor type declaration
-(defun trans-dest-type-decl (conx-name dexpair tnames ctx ds$)
-  (declare (xargs :stobjs (ds$)))
-  (b* (((unless (consp dexpair))
-        (prog2$
-         (er hard ctx "~x0 destructor type decl should be a cons. ~%" dexpair)
-         (mv t nil ds$)))
-       (conx-prefix-str (string-append (symbol-name conx-name) "-"))
-       (id-name (modify-symbol conx-prefix-str (car dexpair) ""))
-       (id (is-a-identifier id-name (defdata-world ds$)))
-       (dte (cdr dexpair))
-      ((unless id)
-       (prog2$
-         (er hard ctx "~x0 is an bad choice for a field name in ~x1.~ 
-Choose something different~%" (car dexpair) dexpair)
-         (mv t nil ds$)))
-;strip away the destructor information for uniform product data treatment
-      ((when (is-a-predefined-typeName dte (defdata-world ds$)))
-       (let ((ds$ (if (not (eq 'acl2::union (type-class ds$)))
-;check if we are not inside union
-                      (add-record-constituent-types-to-ds$ dte)
-                    ds$)))
-         (mv nil dte ds$)))
-      ((when (mem1 dte tnames))
-       (let ((ds$ (update-is-recursive 't ds$)))
-         (mv nil dte ds$)));recursive type reference
-      ((unless (is-a-custom-type dte (defdata-world ds$)))
-       (prog2$
-        (er hard ctx "~x0 should be a type name. ~%" dte)
-        (mv t nil ds$)))
-;Custom type (only remaining case)
-;add custom types used in defdata form to be validated later  
-      (ds$ (if (not (eq 'acl2::union (type-class ds$)))
-;check if we are not inside union
-               (add-record-constituent-types-to-ds$ dte)
-             ds$))
-;July 9 2011
-;TODO NOTE: I do add the constituents, but I generate the
-;disjoint theorems only when the original expression is a
-;purely product expression and I have an handle on its names!!
-;So this is fluff code for the moment, if we are inside a union
-      (ds$ (add-custom-types-to-ds$ dte)))
-    (mv nil dte ds$)))
-          
-  
-;check and construct(stripping away destructors) dex-pair list      
- (defun trans-dest-typ-decl-lst (conx-name dex-pairs tnames ctx ds$)
-   (declare (xargs :stobjs (ds$)))
-   (if (symbol-alistp dex-pairs)
-     (if (endp dex-pairs)
-         (mv nil nil ds$)
-       (b* (((mv erp dest-decl ds$)
-             (trans-dest-type-decl conx-name (car dex-pairs) tnames ctx ds$))
-            ((when erp)
-             (prog2$ 
-              (er hard ctx "Bad ~x0~%" (car dex-pairs))
-              (mv t nil ds$)))
-            ((mv & dest-decl-lst ds$) 
-             (trans-dest-typ-decl-lst conx-name (cdr dex-pairs) tnames ctx ds$))
-            )
-         (mv nil (cons dest-decl dest-decl-lst) ds$)))
-      (prog2$ 
-       (er hard ctx 
-           "Destructor type decl list ~x0 should be a symbol-alist. ~%"
-           dex-pairs)
-       (mv t nil ds$))))
-       
-       
-(mutual-recursion
-;; checks wether texp is a constituent type: 
-;; Either typeName | SingletonType | Union-or-Prod-type
-;; if it isnt then give syntax error. 
-;; The reason why its a soft syntax error? (not the case anymore)
-;;  rather than a nil is
-;; that all calls to this function occur from inside 
-;; either a union or prod function which occurs last
-;; in the series of syntax check and so if its not a 
-;; union or prod then its not legal syntax.
- (defun trans-constituent-type (texp tnames ctx ds$)
-   (declare (xargs :stobjs (ds$)))
-   (b* (((when (is-singleton-type-p texp))
-         (mv nil texp ds$))
-        ((when (is-a-predefined-typeName texp (defdata-world ds$)))
-          (let ((ds$ 
-                 (case (type-class ds$)
-                   ('acl2::product (add-product-constituent-types-to-ds$ texp))
-                   ('record (add-record-constituent-types-to-ds$ texp))
-;might be buggy, right now im not supporting union constituents
-                   (otherwise (add-union-constituent-types-to-ds$ texp)))))
-            (mv nil texp ds$)))
-        ((when (is-a-custom-type texp (defdata-world ds$)))
-         (let* ((ds$ (add-custom-types-to-ds$ texp))
-                (ds$ 
-                 (case (type-class ds$)
-                   ('acl2::product (add-product-constituent-types-to-ds$ texp))
-                   ('record (add-record-constituent-types-to-ds$ texp))
-;might be buggy, right now im not supporting union constituents
-                  (otherwise (add-union-constituent-types-to-ds$ texp)))))
-           (mv nil texp ds$)))
-        ((when (mem1 texp tnames)) 
-         (let ((ds$ (update-is-recursive 't ds$)))
-           (mv nil texp ds$)));is a recursive type reference
-        ((unless (consp texp))
-         (prog2$
-          (er hard ctx "~x0 is an illegal Constituent type expression,
-expecting either previously ~ 
-defined typeName, Singleton or Union/Product type here~%" texp )
-          (mv t nil ds$)))
-        ((mv erp texp1 ds$)
-         (trans-prod-or-union-type texp tnames ctx ds$))
-        ((unless (and (not erp) texp1))
-         (prog2$ 
-          (er hard ctx "~x0 is an illegal Constituent type expression, expecting either ~ 
-previously defined typeName, Singleton or Union/Product type here~%" texp )
-          (mv t nil ds$))))
-       (mv nil texp1 ds$)))
-       
- ;check and construct the constituent type list
- (defun trans-constituent-type-lst (texp-lst tnames ctx ds$)
-   (declare (xargs :stobjs (ds$)))
-   (if (endp texp-lst)
-         (mv nil nil ds$)
-       (b* (((mv erp1 ctype1 ds$)
-;ignore errors since they will already be caught. Hard errors!! save typing
-             (trans-constituent-type (car texp-lst) tnames ctx ds$))
-            ((mv erp2 ctype-lst1 ds$)
-             (trans-constituent-type-lst (cdr texp-lst) tnames ctx ds$))) 
-         (mv (or erp1 erp2) (cons ctype1 ctype-lst1) ds$))))
-    
-
-;;; if texp is a union expression then check and preprocess 
-;;; the argument constituent type expressions 
-;;; otherwise give nil, dont give any errors, cos we still 
-;;; have product expression in the sequential check left
- (defun trans-union-type-exp (texp tnames ctx ds$)
-   (declare (xargs :guard (consp texp)
-                   :stobjs (ds$)))
-   (b* (((unless (and (consp texp)
-                      (or (eq (car texp) 'oneof) 
-                          (eq (car texp) 'anyof))))
-         (mv nil nil ds$))
-;it is a union expression
-        ((unless (> (len (cdr texp)) 1))
-         (prog2$
-          (er hard ctx "Union type expression ~x0 should have at least 2 constituent types~%" texp)
-          (mv t nil ds$)))
-        (ds$ (if (eq :undefined (type-class ds$))
-;top-level-call from translate-defbody
-                 (update-type-class 'acl2::union ds$)
-               ds$))
-        ((mv erp texp-lst1 ds$)
-         (trans-constituent-type-lst (cdr texp) tnames ctx ds$)))
-     (mv erp (cons (car texp) texp-lst1) ds$))) ;reconstruct
- 
- 
- (defun trans-product-type-exp (texp tnames ctx ds$)
-   (declare (xargs :guard (consp texp)
-                   :stobjs (ds$)))
-   (b* (((when (and (consp texp)
-                    (or (eq (car texp) 'oneof) 
-                        (eq (car texp) 'anyof))))
-;is an union, so return nil (indicating not a product)
-         (mv nil nil ds$))
-        (consid (is-a-consId (car texp) (len (cdr texp)) 
-                             (defdata-world ds$)))
-        ((when consid)
-         (mv-let (erp ctype-lst1 ds$)
-                 (let ((ds$ (if (eq :undefined (type-class ds$))
-;top-level-call from translate-defbody
-                                (update-type-class 'acl2::product ds$)
-                              ds$)))
-                   (trans-constituent-type-lst (cdr texp) tnames ctx ds$))
-                 (mv erp (cons consid ctype-lst1) ds$))) ;reconstruct
-        (newconsid (is-a-newconsId (car texp) (len (cdr texp)) 
-                                   (defdata-world ds$)))
-        ((unless newconsid)
-         (prog2$
-            (er hard ctx "Either ~x0 is an illegal Constructor id, ~
-                         or ~x0 is an illegal New Constructor id" (car texp))
-            (mv t nil ds$)))
-        (dest-decl-lst (cdr texp)) 
-        (dex (strip-cars dest-decl-lst))
-        (dex-types (strip-cdrs dest-decl-lst))
-        (pred-lst (get-predicate-symbol-lst dex-types))
-;top-level call
-        (ds$ (if (eq :undefined (type-class ds$))
-                 (update-type-class 'record ds$)
-               ds$))
-        ((mv erp ct-lst1 ds$)
-;get stripped constituent types
-         (trans-dest-typ-decl-lst newconsid dest-decl-lst tnames ctx ds$))
-        ((unless (not erp))
-          (prog2$
-            (er hard ctx "Malformed destructor declarations~%")
-            (mv t nil ds$)))
-        (ds$ (add-newconstructor-to-ds$ newconsid dex pred-lst ds$)))
-     
-     (mv nil (cons newconsid ct-lst1) ds$)))
-         
- (defun trans-prod-or-union-type (texp tnames ctx ds$)
-;returns (mv erp trans-texp ds$)
-    (declare (xargs :guard (consp texp)
-                    :stobjs (ds$)))
-   (b* (((mv erp un-texp ds$)
-         (trans-union-type-exp texp tnames ctx ds$)))
-     (if (and (not erp)
-              un-texp)
-         (mv nil un-texp ds$)
-;SOLVED BUG: order is important
-       (trans-product-type-exp texp tnames ctx ds$)))) 
- 
-)
-;;check well-foundedness
-(mutual-recursion
- (defun WF-constituent-type (texp tnames rpath ctx)
-   (cond ((is-singleton-type-p texp) 't);singleton type exp is well-founded
-         ((symbolp texp) 't);previosly defined types are well-founded
-         ((mem1 texp tnames) 
-          (if (mem1 'P rpath)
-            'nil;is a recursive type reference, i.e. not well-founded
-            ;but if this reference occurs inside a union type expression, that is illegal, raise error!
-            (er hard? ctx "Not Well-formed: Recursive reference ~x0 should occur within a outer Product type expression~%" texp)))
-         (t (WF-prod-or-union-type texp tnames rpath ctx ))))
-              
- 
- (defun WF-product-constituent-type-lst (texp-lst tnames rpath ctx )
-   (if (endp texp-lst)
-       't
-       (and (WF-constituent-type (car texp-lst) tnames rpath ctx )
-            (WF-product-constituent-type-lst (cdr texp-lst) tnames rpath ctx ))))
- 
- (defun WF-union-constituent-type-lst (texp-lst tnames rpath ctx )
-   (if (endp texp-lst)
-       'nil
-       (or (WF-constituent-type (car texp-lst) tnames rpath ctx )
-           (WF-product-constituent-type-lst (cdr texp-lst) tnames rpath ctx )))) 
-         
-(defun WF-dest-type-decl (dexpair tnames rpath ctx )
-   (WF-constituent-type (cdr dexpair) tnames rpath ctx ))
-   
-  
- (defun WF-dest-typ-decl-lst (dex-pairs tnames rpath ctx )
-   (if (endp dex-pairs)
-     't
-     (and (WF-dest-type-decl (car dex-pairs) tnames rpath ctx )
-          (WF-dest-typ-decl-lst (cdr dex-pairs) tnames rpath ctx ))))
- 
-(defun WF-union-type-exp (texp tnames rpath ctx )
-   (if (or (eq (car texp) 'oneof) (eq (car texp) 'anyof))
-     (WF-union-constituent-type-lst (cdr texp) tnames (cons 'U rpath) ctx )
-     nil))
- 
- 
- (defun WF-product-type-exp (texp tnames rpath ctx )
-   (if (symbolp (car texp));cons-id
-       (WF-product-constituent-type-lst (cdr texp) tnames (cons 'P rpath) ctx )
-       (WF-dest-typ-decl-lst (cdr texp) tnames (cons 'P rpath) ctx )))
-          
- 
- (defun WF-prod-or-union-type (texp tnames rpath ctx )
-   (or (WF-union-type-exp texp tnames rpath ctx )
-       (WF-product-type-exp texp tnames rpath ctx )))
- 
-)
-
-;preprocessing
-;(enum <expr-evals-to-a-list-of-constants>)
-(defun is-enum-type (texp ctx w)
-;returns trans-enum, where trans-enum is nil if texp is 
-;not an enum type expression
-  (declare (xargs :guard (plist-worldp w)))
-  (b* (((unless (and (consp texp)
-                     (eq (car texp) 'enum)))
-        nil)
-;Is an enum
-       ((unless (and (= 2 (len texp))
-                     (possible-constant-value-expressionp (cadr texp))))
-        (er hard ctx "Enum should be of form (enum <list-expr>) where ~
-list-expr is a constant value expression evaluating to a list of objects.~%"))
-       ((mv erp list-val) 
-        (trans-my-ev-w (cadr texp) ctx w nil))
-       ((when erp)
-        (er hard ctx "Evaluating list expression ~x0 failed!~%" (cadr texp)))
-       ((unless (true-listp list-val))
-        (er hard ctx "Enum ~x0 expected a (true-) list expression.~%" texp)))
-    (list 'enum list-val)))
-
-#|
-(defmacro define-map-list-lambda-fn (nm lambda-fn &key guard)
- `(make-event
-   (defun ,nm
-     ,@(if guard 
-          '((declare (xargs :guard guard)))
-         nil)
-     (if (endp lst)
-         nil
-       (cons 
-|#
-   
-(defun map-get-field-name (dnames)
-  (declare (xargs :guard (symbol-listp dnames)))
-  (if (endp dnames)
-      nil
-    (cons (intern (symbol-name (car dnames)) "KEYWORD")
-          (map-get-field-name (cdr dnames)))))
-
-(defun record-selector-lemmas (nms tpred fnames dprex)
-  (if (endp fnames)
-      nil
-    (cons
-     `(defthm ,(car nms)
-        (implies (,tpred x)
-                 (,(car dprex) (mget ,(car fnames) x)))
-        :hints (("Goal" :in-theory (e/d (,tpred)))))
-     (record-selector-lemmas (cdr nms) tpred (cdr fnames) (cdr dprex)))))
-
-(defun record-modifier-lemmas (nms tpred fnames dprex)
-  (if (endp fnames)
-      nil
-    (cons 
-     `(defthm ,(car nms)
-        (implies (and (force (,tpred x))
-                      (,(car dprex) v))
-                 (,tpred (mset ,(car fnames) v x)))
-        :hints (("Goal" :in-theory (e/d (,tpred)))))
-     (record-modifier-lemmas (cdr nms) tpred (cdr fnames) (cdr dprex)))))
-
-(defun record-disjoint-constituent-lemmas (nms tpred dprex )
-  (if (endp nms)
-      nil
-    (cons 
-     (let ((dpred (car dprex)))
-       `(defthm ,(car nms)
-          (implies (,tpred x)
-                   (not (,dpred x)))
-          :hints (("Goal" :in-theory (e/d (,tpred ,dpred))))));check
-     (record-disjoint-constituent-lemmas (cdr nms) tpred  (cdr dprex)))))
-
-(defun record-constructor-lemma (nm cname tpred dprex vnames)
-  `(defthm ,nm
-     (implies (and ,@(build-one-param-calls dprex vnames))
-              (,tpred (,cname . ,vnames)))
-     :hints (("Goal" :in-theory (e/d (,tpred ,cname))))))
-       
-(defun add-record-type-support-lemmas-to-ds$ (typid dnames dprex ds$)
-  (declare (xargs :stobjs (ds$)))
-  (b* ((tpred (get-predicate-symbol typid))
-       (s-lemm (support-lemmas ds$))
-       (fnames (map-get-field-name dnames))
-       (snms (modify-symbol-lst (string-append (symbol-name tpred) "-")
-                                     dnames "-SELECTOR-LEMMA"))
-       (mnms (modify-symbol-lst (string-append (symbol-name tpred) "-")
-                                     dnames "-MODIFIER-LEMMA"))
-       (selector-lemmas (record-selector-lemmas snms tpred fnames dprex))
-       (modifier-lemmas (record-modifier-lemmas mnms tpred fnames dprex))
-       (vs (modify-symbol-lst "VAR-" dnames ""))
-       (cnm (modify-symbol "" tpred "-CONSTRUCTOR-LEMMA"))
-       (constructor-lemma (record-constructor-lemma cnm typid tpred dprex vs))
-       (dnms (modify-symbol-lst (string-append (symbol-name tpred) "-")
-                                dprex "-DISJOINT-LEMMA"))
-       (disjoint-lemmas 
-        (record-disjoint-constituent-lemmas dnms tpred dprex))
-                         
-       (record-lemmas (append disjoint-lemmas
-                              (cons constructor-lemma
-                                    (append selector-lemmas modifier-lemmas)))))
-    (update-support-lemmas
-     (acl2::change supp-lemmas%
-      s-lemm
-      :record
-      (append record-lemmas (acl2::access supp-lemmas% s-lemm :record)))
-     ds$)))
-      
-(defun is-record-type (texp typId ctx ds$)
-;returns (mv trans-record-def ds$) where trans-record-def is nil if texp is
-;not a record
-  (declare (xargs :stobjs (ds$)))
-  (b* (((unless (and (consp texp)
-                    (eq (car texp) 'record)))
-        (mv nil ds$))
-       ((unless (>= (len (cdr texp)) 1))
-        (prog2$
-         (er hard ctx "Record ~x0 should have atleast 1 constituent.~%" texp )
-         (mv nil ds$)))
-;definitely a record (and right now anonymous records cant be nested)
-       (ds$ (update-type-class 'record ds$))
-       (dest-decl-lst (cdr texp))
-       (dnames (strip-cars dest-decl-lst))
-       (dex-types (strip-cdrs dest-decl-lst))
-       (dprex (get-predicate-symbol-lst dex-types))
-       ((mv erp dest-decl-lst1 ds$)
-        (trans-dest-typ-decl-lst typId dest-decl-lst nil ctx ds$))
-       ((when erp)
-        (prog2$
-         (er hard ctx 
-             "Record ~x0 has malformed destructor declarations.~%"
-             texp)
-         (mv nil ds$)))
-       (ds$ (add-record-type-support-lemmas-to-ds$ typId dnames dprex ds$))
-       (ds$ (add-newconstructor-to-ds$ typId dnames dprex ds$)))
-;just use the product-datadef function, so record is just syntactic sugar
-       (mv (cons typId dest-decl-lst1) ds$)))
-        
-#||
-(defun add-map-type-support-lemmas-to-ds$ (typid t1 t2 ds$)
-  (declare (xargs :stobjs (ds$)))
-  (b* ((tpred (get-predicate-symbol typid))
-       (t1p (get-predicate-symbol t1))
-       (t2p (get-predicate-symbol t2))
-       (s-lemm (support-lemmas ds$))
-       (s-nm (modify-symbol "" tpred "-SELECTOR-LEMMA"))
-       (m-nm (modify-symbol "" tpred "-MODIFIER-LEMMA"))
-       (d-nm1 (modify-symbol "DISJOINT-" tpred 
-                             (string-append "-" (symbol-name t1p))))
-       (d-nm2 (modify-symbol "DISJOINT-" tpred 
-                             (string-append "-" (symbol-name t2p))))
-       (disjoint-lemma1
-        `(defthm ,d-nm1
-           (implies (,tpred x)
-                    (not (,t1p x)))
-           :hints (("Goal" :in-theory (e/d (,tpred ,t1p))))))
-       
-       (disjoint-lemma2
-        `(defthm ,d-nm2
-           (implies (,tpred x)
-                    (not (,t2p x)))
-           :hints (("Goal" :in-theory (e/d (,tpred ,t2p))))))
-       
-       (selector-lemma 
-        `(defthm ,s-nm
-           (implies (and (,tpred x)
-                         (mget a x))
-                    (and (,t1p a)
-                         (,t2p (mget a x))))
-           :hints (("Goal" :in-theory (e/d 
-                                       (,tpred acl2::mget acl2::acl2->map)
-                                       (,t1p ,t2p))))))
-       (modifier-lemma
-        `(defthm ,m-nm
-           (implies (and (force (,tpred x))
-                         (,t1p a)
-                         (,t2p v))
-                    (,tpred (mset a v x)))
-           :hints (("Goal" :in-theory 
-                    (e/d (,tpred acl2::mset
-                          acl2::acl2->map acl2::map->acl2)
-                         (,t1p ,t2p)
-                         )))))
-       (map-lemmas (list disjoint-lemma1
-                         disjoint-lemma2 
-                         selector-lemma 
-                         modifier-lemma)))
-                          
-    (update-support-lemmas
-     (acl2::change supp-lemmas%
-      s-lemm
-      :map
-      (append map-lemmas (acl2::access supp-lemmas% s-lemm :map)))
-     ds$)))
-
-
-(defun is-map-type (texp typId ctx ds$)
-;returns (mv trans-map ds$) trans-map is nil if not a map
-  (declare (xargs :stobjs (ds$)))
-  (b* (((unless (and (consp texp)
-                     (eq (car texp) 'map)))
-        (mv nil ds$))
-      ;Is a map
-       ((unless (= (len (cdr texp)) 2))
-        (prog2$
-         (er hard ctx "Map should be of form (map typeId1 typeId2), ~
- but given ~x0.~%" texp)
-         (mv nil ds$)))
-       (lpair (cdr texp))
-       (keyT (car lpair))
-       (valT (cadr lpair))
-       (w (defdata-world ds$))
-       ((unless (and (is-a-predefined-typeName keyT w)
-                     (is-a-predefined-typeName valT w)))
-        (prog2$
-         (er hard ctx "~x0 and ~x1 should be predefined types.~%" keyT valT)
-         (mv nil ds$)))
-       (ds$ (add-map-type-support-lemmas-to-ds$ typId keyT valT ds$)))
-;map is just syntactic sugar
-    (mv `(oneof nil (mset ,keyT ,valT ,typId)) ds$)))
-||#
-
-;add generated set type lemmas to a temporary global variable
-;For each type only one set type is added
-(defun add-set-type-support-lemmas-to-ds$ (typid ds$)
-  (declare (xargs :stobjs (ds$)))
-  (let ((tpred (get-predicate-symbol typid))
-        (s-lemm (support-lemmas ds$)))
-  (update-support-lemmas
-   (acl2::change supp-lemmas%
-    s-lemm
-    :set
-    (cons `(defthm ,(modify-symbol "" tpred "-SETP")
-             (implies (,tpred x)
-                      (SETS::setp x))
-             :rule-classes ((:forward-chaining)
-                            (:rewrite :backchain-limit-lst 1)
-                            ))
-          (acl2::access supp-lemmas%  s-lemm :set)))
-   ds$)))
-
-
-;add generated list type lemmas to a temporary global variable
-;For each type only one list type is added
-(defun add-list-type-support-lemmas-to-ds$ (typid ds$)
-  (declare (xargs :stobjs (ds$)))
-  (b* ((tpred (get-predicate-symbol typid))
-       (s-lemm (support-lemmas ds$)))
-
-   
-  (update-support-lemmas
-   (acl2::change supp-lemmas%
-    s-lemm
-    :listof
-    (cons `(defthm ,(modify-symbol "" tpred "-TLP")
-               (implies (,tpred x)
-                        (true-listp x))
-               :rule-classes ((:forward-chaining)(:compound-recognizer)
-                              (:rewrite :backchain-limit-lst 1)
-                              ))
-          (acl2::access supp-lemmas% s-lemm :listof)))
-   ds$)))
-
-;;PETE: Should we get rid of the compound recognizer rule above?
-;;It can be dangerous, eg, Harsh had the rule (tlp x) => (tlp x)
-;;as a compound recognizer and it slowed down proofs *a lot*, but
-;;maybe we just need to avoid this case and it will work out
-;;fine. With the bad rule disabled, a proof went through in 13
-;;seconds that previously took 205 seconds. More experiments are
-;;needed. I did more experiments. The rule is fine as is. Just
-;;make sure not to screw up with the above rules.
-
-(defun is-list-type (texp typid tnames ctx ds$)
-  (declare (xargs :stobjs (ds$)))
-;returns (mv trans-list|nil ds$)
-  (b* (((unless (and (consp texp)
-                     (eq (car texp) 'listof)))
-        (mv nil ds$))
-      ;Is a list type
-      ((unless (= (len (cdr texp)) 1))
-       (prog2$
-        (er hard ctx "listof should be of form (listof typeId) ~
-but ~x0 if not.~%" texp)
-        (mv nil ds$)))
-      ((mv & ctype1 ds$)
-       (trans-constituent-type (cadr texp) tnames ctx ds$))
-      ;;skipped error check.
-      (ds$ (add-list-type-support-lemmas-to-ds$ typid ds$)))
-    (mv `(oneof nil (cons ,ctype1 ,typid)) ds$)))
-       
-(defun is-set-type (texp typid tnames ctx ds$)
-;returns (mv trans-list|nil ds$)
-  (declare (xargs :stobjs (ds$)))
- (b* (((unless (and (consp texp)
-                     (eq (car texp) 'set)))
-        (mv nil ds$))
-      ;Is a set type
-      ((unless (= (len (cdr texp)) 1))
-       (prog2$
-        (er hard ctx "set should be of form (set typeId) ~
-but ~x0 if not.~%" texp)
-        (mv nil ds$)))
-      ((mv & ctype1 ds$)
-       (trans-constituent-type (cadr texp) tnames ctx ds$))
-      ;;skipped error check.
-      (ds$ (add-set-type-support-lemmas-to-ds$ typid ds$)))
-   (mv `(oneof nil (SETS::insert ,ctype1 ,typid)) ds$)))
- 
-;gives back pre-processed data-type-exp or error
-;Sig: Any * Sym * Sym-List * Sym * State -> (mv erp trans-dtexp ds$) 
-;is Either a TypeName | Singleton | Enum | Map | Record | List | Set | Prod-Union-type
-(defun translate-defbody (dtexp typId tnames ctx ds$)
-  (declare (xargs :stobjs (ds$)))
-;returns (mv erp trans-defbody ds$)
-  (b* (((when (is-singleton-type-p dtexp))
-        (let ((ds$ (update-type-class 'acl2::singleton ds$)))
-          (mv nil dtexp ds$)));constant expression or constant value?
-       ((when (is-a-typeName dtexp (defdata-world ds$)))
-        (let ((ds$ (update-type-class 'acl2::alias ds$)))
-          (mv nil dtexp ds$)))
-       ((unless (consp dtexp))
-        (prog2$
-          (er hard ctx "~x0 is an atom, but is neither a singleton-type ~ 
-nor a predefined typename~%" dtexp)
-          (mv t dtexp ds$)))
-;is a data type expression (either union or product or some syntactic sugar
-       (is-enum 
-;preprocessing and eval called inside enum
-         (is-enum-type dtexp ctx (defdata-world ds$)))
-       ((when is-enum) 
-         (let ((ds$ (update-type-class 'enum ds$)))
-           (mv nil is-enum ds$)))
-       ;; ((mv is-map ds$) (is-map-type dtexp typId ctx ds$))
-       ;; ((when is-map)     
-       ;;  (let ((ds$ (update-type-class 'map ds$)))
-       ;;    (mv nil is-map ds$))) ;ADDED 3rd May 2011 REMOVED 28th Aug '12
-       ((mv is-record ds$) (is-record-type dtexp typId ctx ds$))
-;type class of record also gets update on successful entry and not here
-       ((when is-record) 
-           (prog2$
-            (cw? (defdata-debug ds$)
-                          "record support lemmas: ~x0~%" (support-lemmas ds$))
-            (mv nil is-record ds$)))
-       ((mv is-list ds$) (is-list-type dtexp typId tnames ctx ds$))
-       ((when is-list)  
-         (let ((ds$ (update-type-class 'listof ds$)))
-           (mv nil is-list ds$)))
-       ((mv is-set ds$) (is-set-type dtexp typId tnames ctx ds$))
-       ((when is-set) 
-         (let ((ds$ (update-type-class 'set ds$)))
-           (mv nil is-set ds$)))
-       ((mv erp is-un ds$)
-         (trans-union-type-exp dtexp tnames ctx ds$))
-;For product and union  we update type class in the top-level call
-;of trans-product-type-exp and trans-union-type-exp respectively
-       ((when is-un)
-        (mv erp is-un ds$))
-       ((mv erp is-prod ds$)
-        (trans-product-type-exp dtexp tnames ctx ds$))
-       ((when is-prod)
-        (mv erp is-prod ds$))
-       ((when erp)
-        (prog2$
-         (er hard ctx "Error in translating type expression ~x0~%" dtexp)
-         (mv t nil ds$))))
-    (prog2$
-     (er hard ctx 
-         "Illegal DataType Expression ~x0.~
-               Should be either: typename, singletonType, enum, set~
-               record, listof, oneof (union), product type. ~%" dtexp )
-     (mv t nil ds$))))
-
-        
-;do the foll checks:
-;1. Def is a true-list and is of form (typeId dataTypeExp [:hints ])
-;2. typeId is a symbol TODO: We should check if its not already defined
-;3. dataTypeExp is a legal data type expression
-;4. keyword-list [:hints ...] TODO: should it be defined per mut-rec def or for defdata whole?
-;5. dataTypeExp is also pre-processed 
-(defun translate-defs0 (def tnames ctx ds$)
-;return (trans-def ds$) or aborts on error
-  (declare (xargs :stobjs (ds$)))
-  (b* (((unless (and (true-listp def)
-                     (>= (len def) 2)))
-        (prog2$
-         (er hard ctx "Definition ~x0 incorrectly formed.~%" def)
-         (mv nil ds$)))
-       (typId (car def))
-       (dataTypExp (cadr def))
-       ((unless (is-a-typeId-p typId (defdata-world ds$)))
-        (prog2$
-         (er hard ctx "~x0 is not a valid Type Identifier .~%" typId)
-         (mv nil ds$)))
-       ((mv erp dtexp ds$) 
-        (translate-defbody dataTypExp typId tnames ctx ds$))
-       ((unless (not erp))
-        (prog2$
-         (er hard ctx "Could not translate defdata body ~x0~%" dataTypExp)
-         (mv nil ds$)))
-       (rst (cddr def)) ;hints etc keyword list
-       ((unless (acl2::keyword-value-listp rst)) ;check for hints
-        (prog2$
-         (er hard ctx "Expecting :hints but found ~x0.~%" rst)
-         (mv nil ds$))))
-;reconstruct. cddr may be hints
-       (mv (append (list typId dtexp) rst) ds$))) 
-
-        
-(defun translate-defs0-lst (defs tnames ctx ds$ ans)
-  (declare (xargs :stobjs (ds$)))
-  (if (endp defs)
-    (mv ans ds$)
-    (b* ((def (car defs))
-;check for errors in syntax and also preprocess (translate)
-         ((mv cdef ds$) (translate-defs0 def tnames ctx ds$)))
-      (translate-defs0-lst (cdr defs) 
-                           tnames 
-                           ctx  ds$
-                           (append ans (list cdef))))))
-                                                                                 
-    
-;;; normalise single and mutually-recursive defs 
-;;; into (defdata (typeId dataTypeExp)+ )
-;;; and then call check-syntax-defs on resulting normalised form
-;;; Additionaly check for empty definitions and 
-;;; empty enum/oneof/anyof/record/listof(Not required i guess, redundant)
-(defun translate-defs (defs ctx ds$)
-;returns (mv trans-defs ds$) or aborts on error
-  (declare (xargs :stobjs (ds$)
-                  :mode :program))
-
-  (b* (((unless (and (consp defs) 
-                     (true-listp defs)))
-        (prog2$
-         (er hard ctx "Empty form not allowed.~%")
-         (mv nil ds$)))
-       ((when (and (not (symbolp (car defs)));not single def
-                   (found-empty-defp defs))) 
-;check for empty defs and empty enum/oneof/record/anyof/listof
-        (prog2$
-         (er hard ctx 
-             "Empty definition or Empty body in ~x0 not allowed.~%"
-             defs)
-         (mv nil ds$)))
-       ((unless (symbolp (car defs)))
-        ;;should i name this in acl2 package (mut-rec)?
-        (let ((ds$ (update-type-class 'acl2::mutually-recursive ds$)))
-          (translate-defs0-lst defs (strip-cars defs) ctx ds$ nil)))
-;single defn to be normalised
-       (def defs) 
-;rename defs to def to avoid confusion, def is the single definition
-       ((unless (> (len def) 1))
-        (prog2$
-         (er hard ctx "Syntax Error in defdata: Empty definition.~%" )
-         (mv nil ds$)))
-       ((unless (acl2::keyword-value-listp (cddr def)))
-;check for hints
-        (prog2$
-         (er hard ctx "Definitions that are not mutually-recursive should be ~
-                      of form (defdata <id> <type-definition> [:hints <hints>
-                     ...]).~%" )
-         (mv nil ds$)))
-       ((when (found-empty-defp (list def)))
-        (prog2$
-         (er hard ctx "Found empty definition or Empty body in ~x0.~%"
-             def)
-         (mv nil ds$))))
-    (translate-defs0-lst (list def) (list (car def)) ctx ds$ nil)))
-         
- 
-
-(logic)    
-
-(defun lens (l)
-  (declare (xargs :guard (true-list-listp l)))
-  (if (endp l)
-    nil
-    (cons (len (car l))
-          (lens (cdr l)))))
-               
-(defun cons-up-add-type-info-calls 
-  (tsizes tnames tpreds tenums ttestenums defs 
-          recursive-tnames type-class)
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbol-listp tnames)
-                              (true-listp tsizes)
-                              (implies (consp tsizes)
-                                       (or (equal (car tsizes) t)
-                                           (natp (car tsizes))))
-                              (symbol-listp recursive-tnames)
-                              (symbol-listp tpreds)
-                              (symbol-listp tenums)
-                              (symbol-listp ttestenums)
-;(alistp defs)
-                              (type-class-p type-class))))
-
-                              
-  (if (endp tnames)
-    nil
-    (cons `(table
-            defdata::types-info-table
-             ',(car tnames)
-             ',(acl2::make types-info%
-                  :size (car tsizes) 
-                  :enumerator (car tenums)
-                  :predicate (car tpreds)
-                  :test-enumerator (car ttestenums)
-                  :defs defs
-                  :derivedp t;defdata == derived data-type
-                  :recursivep (if (member-equal (car tnames)
-                                                recursive-tnames)
-                                  t
-                                nil)
-                  :type-class type-class)
-             :put)
-          (cons-up-add-type-info-calls (cdr tsizes)
-                                       (cdr tnames)
-                                       (cdr tpreds)
-                                       (cdr tenums)
-                                       (cdr ttestenums)
-                                       defs 
-                                       recursive-tnames
-                                       type-class
-                                       ))))
-;generate add-datatype-node-dtg-batch calls for each tname in tnames
-(defun cons-up-add-datatype-node-dtg-calls (tnames)
-  (declare (xargs :guard (symbol-listp tnames)))
-  (if (endp tnames)
-    nil 
-    (cons `(add-datatype-node-batch ,(car tnames)) ;macro call, so dont quote like elsewhere
-          (cons-up-add-datatype-node-dtg-calls (cdr tnames)))))
-
-;filter typ-exps which are typenames
-(defun filter-typeName (texp-lst tnames state)
-  (declare (xargs :stobjs (state)
-                  :mode :program
-                  :guard (and (true-listp texp-lst)
-                              (symbol-listp tnames))))
-  (if (endp texp-lst)
-    nil
-    (let* ((texp (car texp-lst))
-           (istype  (or (is-a-typeName texp (w state))
-                        (mem1 texp tnames))))
-      (if istype
-        (cons texp (filter-typeName (cdr texp-lst) tnames state))
-        (filter-typeName (cdr texp-lst) tnames state)))))
-
-;list together calls that add a edge in the subtype graph for each
-;constituent-type -> union-type
-(defun list-calls-union-constituent-is-subtype-aux (c-types un-type)
-  (declare (xargs :guard (and (symbol-listp c-types)
-                              (symbolp un-type))))
-  (if (endp c-types)
-    nil
-    (cons `(add-edge-to-subtype-graph-batch ,(car c-types) ,un-type)
-          (list-calls-union-constituent-is-subtype-aux (cdr c-types) un-type))))
-
-;generate subtype edge calls for each tname in tnames (not recursive
-;types are also dealt uniformly)
-(defun cons-up-add-edge-union-constituent-is-subtype (defs tnames state)
-  (declare (xargs :stobjs (state)
-                  :mode :program
-                  :guard (and (true-listp defs)
-                              (symbol-listp tnames))))
-                  
-  (if (endp defs)
-    nil
-    (let* ((def (car defs))
-          (tname (car def))
-          (tbody (cadr def)))
-      (if (and (consp tbody) ;not a singleton or typename
-               (or (eq (car tbody) 'oneof) ;is a union type expression
-                   (eq (car tbody) 'anyof)))
-        (let* ((c-typexp-lst (cdr tbody));constituent type list
-               (c-types (filter-typeName c-typexp-lst tnames state)));types (can also be recursive)
-          (append (list-calls-union-constituent-is-subtype-aux c-types tname)
-                  (cons-up-add-edge-union-constituent-is-subtype (cdr defs) tnames state)))
-        (cons-up-add-edge-union-constituent-is-subtype (cdr defs) tnames state)))))
-
-                             
-          
-;extract destructor-predicate pairs
-(defun strip-dex-pairx (new-constructors)
-  (declare (xargs :mode :program
-                  :guard (alistp new-constructors)))
-  (if (endp new-constructors)
-    nil
-    (cons (dex-pairs-entry (car new-constructors))
-          (strip-dex-pairx (cdr new-constructors)))))
-
-;extract predicates
-(defun strip-preds (new-constructors)
-  (declare (xargs :mode :program
-                  :guard (alistp new-constructors)))
-  (if (endp new-constructors)
-    nil
-    (cons (predicate-name-entry (car new-constructors))
-          (strip-preds (cdr new-constructors)))))
-
-
-;find recursive records
-(defun find-recursive-record (pred new-constructors)
-  (declare (xargs :mode :program
-                  :guard (and (symbolp pred)
-                              (symbol-alistp new-constructors))))
-  (if (endp new-constructors)
-    nil
-    (let* ((conx-info (car new-constructors))
-           (dex-pairs (dex-pairs-entry conx-info)))
-    (if (mem1 pred (flatten (strip-cdrs dex-pairs) nil));TODO.BUG: simple trick, but may give false positives
-      (cons conx-info (find-recursive-record pred (cdr new-constructors)))
-      (find-recursive-record pred (cdr new-constructors))))))
-;TODO::Check if a mutually recursive record is possible and test it.
-(defun find-recursive-records (preds new-constructors)
-  (declare (xargs :mode :program
-                  :guard (and (symbol-listp preds)
-                              (symbol-alistp new-constructors))))
-  (if (endp preds)
-    nil
-    (let ((rrecs  (find-recursive-record (car preds) new-constructors)))
-      (if rrecs
-        (union-equal rrecs
-                     (find-recursive-records (cdr preds) new-constructors))
-        (find-recursive-records (cdr preds) new-constructors)))))
-
-;ADD this to the syntactic check!!! TODO. THis gives some false positives
-(mutual-recursion
-;Is typename defined in a (defdata (tname1 ...) ...) a recursive type?
-;Implicit contract: (in typename tnames)
-(defun is-recursive-type-lst (typename tnames defbody-lst)
-  (declare (xargs :guard (and (symbolp typename)
-                              (symbol-listp tnames)
-                              (defbody-listp defbody-lst))))
-                  ;:verify-guards nil))
-  (if (endp defbody-lst)
-    nil
-  (or (is-recursive-type typename tnames (car defbody-lst))
-      (is-recursive-type-lst typename tnames (cdr defbody-lst)))))
-
-(defun is-recursive-type (typename tnames defbody)
-  (declare (xargs :guard (and (symbolp typename)
-                              (symbol-listp tnames)
-                              (defbodyp defbody))))
-  (cond ((possible-constant-valuep defbody) nil)
-        ((symbolp defbody) (mem1 defbody tnames))
-        (t (is-recursive-type-lst typename tnames (cdr defbody)))))
-)
-           
-(defun defsp (x)
-  (if (atom x)
-    (equal x nil)
-    (and (= 2 (len (car x)))
-         (symbolp (first (car x)))
-         (defbodyp (second (car x)))
-         (defsp (cdr x)))))
-
-        
-(defthm rec-type-defbody-type
-  (implies (defsp defs)
-           (defbodyp (second (assoc-eq typ defs))))
-  :rule-classes :type-prescription)
-
-(defthm rec-type-consp-defbody-type
-  (implies (and (consp defbody)
-                (defbodyp defbody)
-                (is-recursive-type typename tnames defbody))
-           (defbody-listp (cdr defbody)))
-  :rule-classes :type-prescription)
-
-
-(defun get-recursive-typenames (types defs tnames)
-  (declare (xargs ;:mode :program 
-                  :guard-hints (("Goal" :in-theory (disable is-recursive-type)))
-                  :guard (and (symbol-listp types)
-                              (symbol-listp tnames)
-                              (defsp defs))))
-  (if (endp types)
-    nil
-    (let ((typename (car types)))
-      (if  (is-recursive-type typename tnames (second (assoc-eq typename defs)))
-        (cons typename
-              (get-recursive-typenames (cdr types) defs tnames))
-        (get-recursive-typenames (cdr types) defs tnames)))))
-
-(defun my-append (Xs Ys)
-  (declare (xargs :guard (and (true-listp Xs)
-                              (true-listp Ys))))
-                  
-  (append Xs Ys));for debugging
-
-;;make type consistency check event for all types in arg
-;;Generate the foll form:
-;; (thm (implies (natp x) (Tp (nth-T x)))) or (thm (implies (< n (len *T-values*)) (Tp (nth n *T-values*))))
-;;TODO.Note: *T-values* might be very big list in that case, there must be a cleaner/efficient way.
-(defun cons-up-type-consistent-thm-ev (tnames wrld)
-  (declare (xargs :mode :program
-                  :guard (symbol-listp tnames)))
-  (if (endp tnames)
-    nil
-    (let* ((tname (car tnames))
-           (tpred (get-predicate-symbol tname))
-           (tenum (get-enumerator-symbol tname))
-           (tvalues (get-values-symbol tname))
-           (tpred-lst (modify-symbol "" tpred "-lst-auto-generated"))) 
-      (append (if (allows-arity tenum 1 wrld)
-                (list `(thm (implies (natp n) (,tpred (,tenum n)))
-                            :hints (("Goal" :in-theory (e/d (,tpred ,tenum))))))
-                (list `(defun ,tpred-lst (xs) 
-                         (if (endp xs)
-                           t
-                           (and (,tpred (car xs))
-                                (,tpred-lst (cdr xs)))))
-                      `(thm (,tpred-lst ,tvalues))))
-              (cons-up-type-consistent-thm-ev (cdr tnames) wrld)))))
-
-  
-
-;this function takes care of records, where the constructor name is the
-;same as the name of the type and hence to avoid a bad redefinition\
-;we collect only that preds that need predicates , excluding
-;the constructor predicate which is generated anyway!
-(defun names-need-predicates (nms nms-with-pred new-constructors)
-  (declare (xargs :guard (and (symbol-listp nms)
-                              (symbol-listp nms-with-pred)
-                              (symbol-alistp new-constructors))))
-  
-  (let* ((nms-need (set-difference-eq nms nms-with-pred))
-         (new-names (strip-cars new-constructors)))
-    (set-difference-eq nms-need new-names)))
-          
-
-;;--changed name of the main function
-(defun compute-typecombs (defs kwd-options-lst ctx 
-                           new-constructors support-lemmas type-class
-                           wrld state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-  (b* ((names (strip-cars defs))
-        ;(defbodies (strip-cadrs defs))
-         (pred-syms (get-predicate-symbol-lst names))
-         
-;with predicates already defined --ASK: what if its defined inconsistently??BUG?
-         (names-with-preds (collect-with-plausible-pred-fns names wrld))
-         (defs-with-preds (assoc-lst names-with-preds defs))
-         (defbodies-with-preds (strip-cadrs defs-with-preds))
-         (rsts-with-preds (acl2::strip-cddrs defs-with-preds))
-         (pred-syms-with-preds (get-predicate-symbol-lst names-with-preds))
-         (thm-syms-with-preds (get-predicate-testthm-symbol-lst names-with-preds))
-         
-         ;predicates need to be defined
-         (names-need-preds (names-need-predicates names names-with-preds new-constructors))
-         (pred-syms-need-preds (get-predicate-symbol-lst names-need-preds))
-         
-         (defs-need-preds (assoc-lst names-need-preds defs))
-         (defbodies-need-preds (strip-cadrs defs-need-preds))
-         
-         ;non recursive predicates(from names that need preds) need to be treated separately
-         (recursive-names (get-recursive-typenames names-need-preds defs names))
-         (non-recursive-names (set-difference-eq names-need-preds recursive-names))
-         (non-recursive-pred-syms (get-predicate-symbol-lst non-recursive-names))
-         (defs-non-recursive-names (assoc-lst non-recursive-names defs))
-         (defbodies-non-recursive-names (strip-cadrs defs-non-recursive-names))
-         (defthm-syms-non-rec-preds (get-predicate-def-thm-symbol-lst non-recursive-names))
-         
-         ;;events from new constructors(records)
-         (conx-names (strip-cars new-constructors))
-         (conx-recursive-alst (find-recursive-records pred-syms-need-preds new-constructors))
-         (conx-non-rec-alst (set-difference-eq new-constructors conx-recursive-alst))
-         (conx-rec-names (strip-cars conx-recursive-alst))
-         (conx-non-rec-names (set-difference-eq conx-names conx-rec-names)) 
-         (dex-pairs-non-rec-lst (strip-dex-pairx conx-non-rec-alst))
-         (dex-pairs-lst (strip-dex-pairx new-constructors))
-         (dex-pairs-rec-lst (strip-dex-pairx conx-recursive-alst))
-         (conx-pred-rec-events (cons-up-conx-prex-ev conx-rec-names dex-pairs-rec-lst))
-         (conx-pred-rec-bodies (strip-cdrs conx-pred-rec-events));strip defun
-         (conx-pred-rec-names (strip-cadrs conx-pred-rec-events))
-         (conx-pred-non-rec-events (cons-up-conx-prex-ev conx-non-rec-names dex-pairs-non-rec-lst))
-         (conx-pred-non-rec-names (strip-cadrs conx-pred-non-rec-events))
-         ;(dex-events (append-up-dex-ev conx-names dex-pairs-lst))
-         (conx-events (cons-up-conx-ev conx-names dex-pairs-lst))
-         (register-conx-dex-events (cons-up-reg-conx-dex-ev conx-names dex-pairs-lst))
-         
-         ;; generating supporting lemmas
-         (gen-lemmasp (if (mem1 :type-lemmas kwd-options-lst)
-                             (get-value-from-keyword-value-list :type-lemmas kwd-options-lst)
-                             nil))
-         (rec-record-support-lemmas (cons-up-rec-record-conx-pred-defthm-ev conx-names dex-pairs-lst))
-;lemmas for syntactic sugar
-         (list-type-support-lemmas (acl2::access supp-lemmas%
-                                                 support-lemmas :listof))
-         (set-type-support-lemmas (acl2::access supp-lemmas%
-                                                 support-lemmas :set))
-         (record-type-support-lemmas (and gen-lemmasp
-                                          (acl2::access supp-lemmas%
-                                                 support-lemmas :record)))
-;         (map-type-support-lemmas (and gen-lemmasp s-lemm.map))
-; lemmas for base union-product type lemmas
-         ;(base-type-support-lemmas (g :base support-lemmas))
-         ;(verbose (get-acl2s-defdata-verbose))
-         )
-    (if (not (no-duplicatesp names))
-      (er soft ctx "Duplicate found in the names being defined: ~x0" names)
-      (b* (((er pred-bodies-with) (er-trans-datadef-as-predicate-lst
-                                   defbodies-with-preds
-                                   pred-syms
-                                   (make-list (len defbodies-with-preds)
-                                              :initial-element 'v)
-                                   new-constructors
-                                   ctx wrld state))
-         ;;-- pred-bodies-need e.g:
-         ;;-- ((OR (EQ V 'NIL)
-         ;;-- (AND (CONSP V)
-         ;;--   (FOOP (CAR V))
-         ;;--   (BARP (CDR V)))))
-         ((er pred-bodies-need) (er-trans-datadef-as-predicate-lst
-                                 defbodies-need-preds
-                                 pred-syms
-                                 (make-list (len defbodies-need-preds)
-                                            :initial-element 'v)
-                                 new-constructors
-                                 ctx wrld state))
-         ((er non-recur-pred-bodies-need) (er-trans-datadef-as-predicate-lst
-                                           defbodies-non-recursive-names
-                                           pred-syms
-;TODO:Possible bug, shudnt it be non-recursive preds only
-                                           (make-list (len defbodies-non-recursive-names)
-                                                      :initial-element 'v)
-                                           new-constructors
-                                           ctx wrld state))
-         ;;-- fin-binds e.g =
-         ;;--((FOO 42 (T T) (NIL T) (T NIL) (NIL NIL))
-         ;;-- (BAZ (T) (NIL))
-         ;;-- (MOO NIL))
-         ((er fin-binds) (er-get-finite-data-defs defs new-constructors ctx wrld state))
-         (fin-names (strip-cars fin-binds))
-         (fin-enum-syms (get-values-symbol-lst fin-names))
-         (fin-defs  (cons-up-lists fin-enum-syms
-                                   (strip-cdrs fin-binds)))
-         (inf-names (set-difference-eq names fin-names))
-         (inf-enum-syms (get-enumerator-symbol-lst inf-names))
-;CHANGED by harshrc Jan 24 2011(earlier hack on Jun 6 2010)
-         (declare-guardsp (if (mem1 :declare-guards kwd-options-lst)
-                              (get-value-from-keyword-value-list :declare-guards kwd-options-lst)
-                            (get-acl2s-defdata-use-guards)))
-         (inf-bodies (strip-cadrs (assoc-lst inf-names defs)))
-         ((er inf-enums) (er-trans-datadef-as-enumerator-lst
-                          inf-bodies
-                          fin-defs
-                          inf-enum-syms
-                          new-constructors
-                          ctx wrld state))
-         (testing-enabled (acl2s-defaults :get testing-enabled))
-; 08/26/12 defdata avoids testing. the following is a patch to avoid
-; showing testing summary message in a defdata form that succeeds a test?.
-         ((er &) (assign print-summary-user-flag NIL))
-         );*b
-;in
-       (value `(progn
-                  ;; (set-internal-acl2s-inside-defdata-flag t)
-                  (acl2s-defaults :set testing-enabled nil)
-                  ,@ (and 
-                      conx-non-rec-names
-                      `((value-triple
-                         (cw? t
-                                       "Submitting record predicate functions ~x0.~%"
-                                       ',conx-non-rec-names))))
-                  
-                  ,@ conx-pred-non-rec-events
-                  ,@ (and 
-                      (append pred-syms-need-preds
-                              conx-pred-rec-names)
-                      `((value-triple
-                         (cw? t
-                                       "Submitting predicate functions ~x0.~%"
-                                       ',(append pred-syms-need-preds
-                                                 conx-pred-rec-names)))))
-                  ,@ (and 
-                      pred-syms-need-preds
-                      `((defuns . ,(append 
-                                    conx-pred-rec-bodies
-                                    (cons-up-names-decls-lls-bodies
-                                     pred-syms-need-preds
-                                     (if T;declare-guardsp  
-;harshrc Sep 3rd 2012 -- OK, predicates need their guards to be
-;verified. I hope this wont break anything, since this change though
-;it reduces flexibility it does not change the behavior of
-;declare-guardsp for now, since the default value for it was T anyway.
-                                         (make-list (len pred-syms-need-preds) 
-                                                    :initial-element 
-                                                    '(declare (xargs :guard t
-                                                                     :ruler-extenders :all
-                                                                     )))
-                                       (make-list (len pred-syms-need-preds) 
-                                                  :initial-element '(declare (xargs :ruler-extenders :all
-                                                                                    )))
-                                       );end of if , this gives the declare form for the predicate
-                                     (make-list (len pred-syms-need-preds)
-                                                :initial-element '(v))
-                                     pred-bodies-need)))))
-                  ,@ (and 
-                      (or non-recursive-pred-syms conx-pred-non-rec-names)
-                      `((in-theory (disable ,@ (append non-recursive-pred-syms conx-pred-non-rec-names)))))
-                     
-                  ,@ conx-events
-                  
-                  ,@ (and conx-pred-rec-names rec-record-support-lemmas)
-                                    
-;,@ dex-events (Jan25 2011 No need, mget handles it)
-                  ,@ register-conx-dex-events
-                  ,@ (cons-up-defconsts fin-enum-syms
-                                        (strip-cdrs fin-binds))
-                  ,@ (cons-up-pred-defthms thm-syms-with-preds
-                                           pred-syms-with-preds
-                                           pred-bodies-with
-                                           rsts-with-preds)
-                  ,@ (cons-up-non-recursive-pred-definition-defthms
-                                                 defthm-syms-non-rec-preds
-                                                 non-recursive-pred-syms
-                                                 non-recur-pred-bodies-need)
-                  
-                  ,@ (and list-type-support-lemmas
-                          `((value-triple
-                             (cw? t
-                                           "Submitting list type lemmas... ~%"))))
-                  ,@ list-type-support-lemmas   
-                          
-                  ,@ (and set-type-support-lemmas
-                          `((value-triple
-                             (cw? t
-                                           "Submitting set type lemmas... ~%"))))
-                  ,@ set-type-support-lemmas
-
-                  ,@ (and record-type-support-lemmas
-                          `((value-triple
-                             (cw? t
-                                           "Submitting record type lemmas... ~%"))))
-                  ,@ record-type-support-lemmas
-                  
-                  ;; ,@ (and map-type-support-lemmas
-                  ;;         `((value-triple
-                  ;;            (cw? t
-                  ;;                          "Submitting map type lemmas... ~%"))))
-                  ;; ,@ map-type-support-lemmas
-                  ;; ;,@ base-type-support-lemmas
-                  
-                  ,@ (and inf-enums
-                  `((value-triple
-                     (cw? t
-                                   "Submitting enumerator functions ~x0.~%"
-                                   ',inf-enum-syms))))
-                  ,@ (and 
-                      inf-enums
-                      `((defuns . ,(cons-up-names-decls-lls-bodies
-                                    inf-enum-syms
-                                    (if declare-guardsp
-                                        (make-list (len inf-enums)
-                                                   :initial-element 
-                                                   (if (assoc :termination-method 
-                                                              (table-alist 'acl2::acl2-defaults-table wrld))
-                                                       '(declare (xargs :consider-only-ccms ((nfix x))
-                                                                        :guard (natp x)))
-                                                     '(declare (xargs :measure (nfix x)
-                                                                      :guard (natp x) ))
-                                                     
-                                                     ))
-                                      (make-list (len inf-enums)
-                                                 :initial-element 
-                                                 (if (assoc :termination-method 
-                                                            (table-alist 'acl2::acl2-defaults-table wrld))
-                                                     '(declare (xargs :consider-only-ccms ((nfix x))))
-                                                   '(declare (xargs :measure (nfix x))))
-                                                 )
-                                      );end of if , this gives the declare form for the enum
-                                    (make-list (len inf-enums)
-                                               :initial-element '(x))
-                                    (strip-cdrs inf-enums)))))
-                  (value-triple
-                   (cw? t
-                                 "Updating the defdata type table.~%"))
-                  
-;add fin and inf type information to types-table 
-;(but seperately because we have to do this outside make-event)
-                  ,@ (cons-up-add-type-info-calls 
-                      (lens (strip-cdrs fin-binds))
-                      fin-names (get-predicate-symbol-lst fin-names)
-                      fin-enum-syms nil defs
-                      nil type-class);test-enums=nil, recursive-names=nil
-;Question: How can u have multiple finite types? Multiple type defs 
-;invariably mean mutually-recursive!! Put an assert?
-                  ,@ (cons-up-add-type-info-calls 
-                      (make-list (len inf-enums) :initial-element 't)
-                      inf-names (get-predicate-symbol-lst inf-names)
-                      inf-enum-syms nil defs;test-enums = nil
-                      (get-recursive-typenames names defs names)
-                      type-class)
-;test-enums will only be explicitly provided by the user and added to the table
-                  ,@ (cons-up-add-datatype-node-dtg-calls names) ;add the noded to datatype-graph
-                  ,@ (cons-up-add-edge-union-constituent-is-subtype 
-                      defs names state)
-;sync globals with SCC and TC graph algorithm calc
-                  (sync-globals-for-dtg) 
-                  
-                  (acl2s-defaults :set testing-enabled ,testing-enabled)
-                  (value-triple ',names)
-                  ;; (set-internal-acl2s-inside-defdata-flag nil)
-                  ))
-        
-        ))))
-
-;defs-ans is accumlated defs to be extracted
-(defun get-defs-and-keyword-list (args defs-ans)
-  (declare (xargs :guard (and (true-listp args)
-                              (true-listp defs-ans))))
-  (if (endp args)
-    (mv defs-ans nil)
-    (if (keyword-value-listp args);not null
-      (mv defs-ans args) ;abort and give back answer
-      (get-defs-and-keyword-list (cdr args) 
-                                 (append defs-ans (list (car args)))))))
-
-(defun initialize-ds$ (debug wrld ds$)
-  (declare (xargs :stobjs (ds$)
-                  :guard (and (booleanp debug)
-                              (ds$p ds$))))
-                 
-  (b* ((ds$ (update-defdata-world wrld ds$))
-       (ds$ (update-newconstructors nil ds$))
-       (ds$ (update-custom-types nil ds$))
-       (ds$ (update-support-lemmas *initial-supp-lemmas* ds$))
-       (ds$ (update-defdata-debug debug ds$)))
-      ds$))
-  
-;;process enums and normalise listof/record/set etc
-(defun compute-defdata (args debug-flag ctx wrld state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-  (b* (((mv defs0 kwd-options-lst)
-         (get-defs-and-keyword-list args nil)))
-    (acl2::with-local-stobj
-     ds$
-     (mv-let 
-      (erp result state ds$)
-      (b* ((ds$ (initialize-ds$ debug-flag wrld ds$))
-           ((mv defs1 ds$) (translate-defs defs0 ctx ds$))
-           (enum-event (process-enum-form defs1 ctx wrld)))
-        (if enum-event
-;submit enumeration event form
-            (mv nil `(progn ,@enum-event) state ds$) 
-          (let* ((cust-types (custom-types ds$))
-                 (validate-type-consistency-ev 
-                  (cons-up-type-consistent-thm-ev cust-types wrld))
-                (mk-ev-form
-                 `(make-event
-                   (mv-let 
-                    (erp res state)
-                    (er-progn 
-                     (value (and ',validate-type-consistency-ev
-                                 (cw? 
-                                  t "Proving consistency of custom types ~x0...~%" ',cust-types)))
-                     ,@validate-type-consistency-ev
-                     (value ':Type-is-consistent))
-                     (declare (ignorable res))
-                     (if erp ;if error
-                         (prog2$
-                          (er hard ',ctx "One or more custom Types used in defdata form are not consistent, i.e. Type predicate ~
-                               and corresponding type enumerator are not consistent. Here's list of events that failed: ~
-                               ~x0 ~%" ',validate-type-consistency-ev)
-                          (mv t nil state))
-                                      
-                       (compute-typecombs ',defs1 ',kwd-options-lst 
-                                          ',ctx
-                                          ',(newconstructors ds$)
-                                          ',(support-lemmas ds$)
-                                          ',(type-class ds$)
-                                          (w state) state))))))
-            (mv nil mk-ev-form state ds$))))
-      (mv erp result state)))))
-
-
-#|
-(define-enumeration-type boolean '(t nil))
-(register-data-constructor (consp cons)
-                           ((allp car) (allp cdr))
-                           :proper t)
-
-;(trace$ er-trans-datadef-as-enumerator
-;        er-get-enumeration-info
-;        er-trans-datadef-as-enumerator-lst
-;        )
-
-(compute-defdata '((foo (oneof 42 (cons boolean baz)))
-                   (bar (oneof nil
-                               (cons foo bar)))
-                   (moo nil)
-                   (baz (cons boolean moo)))
-                 'top-level (w state) state)
-;|#
-
-(defmacro defdata (&rest args)
-  (declare (xargs :guard (and (true-listp args)
-                              (>= (len args) 1)))) ;just (defdata) not allowed
-   ":Doc-Section DATA-DEFINITIONS
-  Specify a data definition ('type')~/
-  
-  The ~c[defdata] macro can be used to specify union and product
-  combinations of 'types'(See :doc data-definitions for what we mean 
-  by a 'type'). In addition to these it provides
-  syntactic sugar to conveniently specify enumeration types,
-  list types and record types. It also supports mutually-recursive
-  data definitions.
-  ~c[oneof] creates a union combination of constituent 'types'.
-  ~c[enum] creates an enumeration type, it can take as arguments
-  any number of acl2 constant expressions. Alternatively you can
-  give it one argument which can be any acl2 expression that
-  evaluates to a list of acl2 constants.
-  You can use any of the built-in constructors like ~c[cons],
-  ~c[/], ~c[complex], ~c[succ] etc, to create product type
-  combinations. See examples below.
-  ~c[record] is a syntactic sugar for the fore-mentioned 
-  product type combination. It creates a new constructor with the
-  same name as the type being defined and it 
-  also creates the destructor/selector functions for you in
-  addition to the predicate and enumerator as mentioned in :doc
-  data-definitions. 
-  ~c[(listof T)] is syntactic sugar for ~c[(oneof nil (cons T <typeId>))].
-  ~c[enum], ~c[record] and ~c[listof] cannot be nested and are normally
-  used seperately at the top-level. For complex nested type combinations
-  just use the regular union, product combination as described above.
-  Remember that each successful ~c[(defdata T ...)] will generate for you two
-  functions ~c[Tp] and either ~c[nth-T] or ~c[*T-values*] depending on 
-  wether ~c[T] is infinite or finite. As mentioned in :doc data-definitions
-  all acl2 data objects are treated as singleton 'types' and can be used
-  in any ~c[defdata] form. 
-  
-  ~bv[]
-  Examples:
-  (defdata (int integer))
-  (defdata foo (cons (cons (oneof boolean 'ok) (cons 2 'as))
-                     (oneof (cons int string) (oneof nat pos) 42)))
-  (defdata natural (oneof 0 
-                          (succ natural))
-                          
-  (defdata BorC (oneof boolean character))
-  (defdata foo (oneof (cons integer foo)
-                       integer)) 
-  (defdata loi (listof integer))
-  (defdata lop (listof (oneof (cons boolean nat) integer)))
-  (defdata RGB (enum 'red 'green 'blue))
-  (defdata RGBY (enum (list 'r 'g 'b 'y))
-  (defdata hyperlink (record (protocol . string)
-                             (address . string)
-                             (display . string)))
-  (defdata
-    (bexpr (oneof boolean
-                  (cons boolean bexpr-list)))
-    (bexpr-list (oneof nil
-                       (cons bexpr bexpr-list))))                           
-  (defdata tree (oneof 'Leaf
-                       (node (val . string) (left . tree) (right . tree))))  
-  ~ev[]                      
-  ~bv[]
-  Usage(EBNF format):
-  (defdata-subtype <typeId> <dataTypeExpression>)
-  (defdata-subtype (<typeId> <dataTypeExpression>)+ ) ;mutually-recursive types
-  where <typeId> := A new identifier/symbol thats not already defined in the world
-        <dataTypeExpression> := <typeName> | <singletonTypeExp> | <enumerationTypeExp> |
-                                <recordTypeExp> | <listTypeExp> | <typeCombinationExp>
-        <typeName> := name of 'type' as described in :doc data-definitions
-        <singletonTypeExp> :=  acl2 constant expression as described in acl2 book
-        <typeCombinationExp> := <unionTypeExp> | <productTypeExp>
-        <unionTypeExp> := (oneof <constituentTypeExp> <constituentTypeExp>+)
-        <productTypeExp> := (<constructorId> <constituentTypeExp>*) |
-                            (<newConstructorId> <destructorTypeDeclaration>*)
-        <constituentTypeExp> := <typeName> | <singletonTypeExp> |
-                                <unionTypeExp> | <productTypeExp>
-        <constructorId> := A defined constructor (see :doc register-data-constructor)                        
-        <newConstructorId> := A new identifier/symbol thats not already defined in the world
-        <destructorTypeDeclaration> := (<destructorId> . <typeName>)
-        <destructorId> := A new identifier/symbol thats not already defined in the world
-        <enumerationTypeExp> := (enum <singletonTypeExp>+ ) | (enum <acl2-enum-expr>)
-        <acl2-enum-expr> := Any acl2 expression which evaluates to a list of acl2 constants.
-        <listTypeExp> := (listof <constituentTypeExp>)
-        <recordTypeExp> := (record destructorTypeDeclaration*)
-  ~ev[]~/
-  "
-  
-  `(with-output
-    :stack :push
-    :off :all
-    (make-event
-    `(with-output
-      :stack :pop
-      :off ,(cond ((get-acl2s-defdata-debug)
-                    'acl2::proof-checker)
-                   ((get-acl2s-defdata-verbose)
-                    '(warning! observation warning proof-checker expansion))
-                   (t 
-                    '(warning warning! observation prove 
-                              proof-checker event expansion
-                              summary proof-tree))
-               
-               )
-      :gag-mode ,(if (get-acl2s-defdata-debug) 'nil 't)
-      (make-event
-        (compute-defdata ',',args  ,(get-acl2s-defdata-debug)
-                         ','defdata (w state) state))))))
-
-(defmacro set-internal-acl2s-inside-defdata-flag (b)
-  `(make-event
-    (er-progn
-     (assign internal-acl2s-inside-defdata-flg ,b)
-     (if ,b
-       (value '(value-triple nil));start
-       (value '(value-triple :defdata-success))))));end
-
-(defun get-internal-acl2s-inside-defdata-fn (state)
-  (declare (xargs :stobjs (state)))
-  (let ((nt (acl2::f-boundp-global 'internal-acl2s-inside-defdata-flg state)))
-    (if nt
-     (acl2::f-get-global 'internal-acl2s-inside-defdata-flg state)
-      nil)))
-
-(defmacro get-internal-acl2s-inside-defdata-flag ()
-  `(get-internal-acl2s-inside-defdata-fn state))
-      
-
-(defun make-subsumes-relation-name (T1 T2)
-  (declare (xargs :guard (and (is-a-variablep T1)
-                              (is-a-variablep T2))))
-  (let* ((str1 (symbol-name T1))
-        (str2 (symbol-name T2))
-        (str11 (string-append str1 "-is-subtype-of-"))
-        (str (string-append str11 str2)))
-    (intern$ str "DEFDATA")))
-
-(defun make-disjoint-relation-name (T1 T2)
-  (declare (xargs :guard (and (is-a-variablep T1)
-                              (is-a-variablep T2))))
-  (let* ((str1 (symbol-name T1))
-        (str2 (symbol-name T2))
-        (str11 (string-append str1 "-is-disjoint-with-"))
-        (str (string-append str11 str2)))
-    (intern$ str "DEFDATA")))
-
-(defun compute-defdata-subtype (T1 T2 state hints otf-flg doc)
-  (declare (xargs :stobjs (state)
-                  :mode :program
-                  :guard (and (is-a-variablep T1)
-                              (is-a-variablep T2)
-                              )))
-  (let* ((T1p (get-predicate-symbol T1))
-         (T2p (get-predicate-symbol T2)))
-    (if (and (is-a-typeName T1 (w state))
-             (is-a-typeName T2 (w state))) ;if not existing typenames raise error
-      (let ((form `(implies (,T1p x) (,T2p x))))
-        (mv-let (erp res state)
-                (acl2::thm-fn form state hints otf-flg doc)
-                (declare (ignore res))
-                (if erp
-                  (er soft 'defdata-subtype "Failed to prove subtype relation: ~x0 ~%" form)
-                  (value `(progn
-                           (add-edge-to-subtype-graph-batch ,T1 ,T2);macro calls so dont need quotes
-                           (sync-globals-for-dtg)
-                           (value-triple :defdata-subtype-success))))))
-      (er soft 'defdata-subtype "One of ~x0 and ~x1 is not a defined type!~%" T1 T2))))
-
-
-(defmacro defdata-subtype (T1 T2 &key hints otf-flg doc)
-  (declare (xargs :guard (and (is-a-variablep T1)
-                              (is-a-variablep T2))))
-  ":Doc-Section DATA-DEFINITIONS
-  Specify a subtype relation between two types~/
-  ~c[(defdata-subtype T1 T2)] tries to prove that the first
-  argument to it T1(which should be a ~st[supported type-name],
-  to check what we mean by that ~pl[data-definitions]) is
-  a subtype of the second argument T2. If the ACL2 is 
-  successful in proving the conjecture:
-  ~c[(implies (T1p x) (T2p x))] then this information
-  is stored in a internal subtype data type graph, where
-  we perform closure of the subtype relation. Henceforth
-  one can just call ~c[(subtype-p T1 T2)] to get an 
-  affirmative which is just a lookup instead of calls
-  to the ACL2 theorem prover. And note that once you submit
-  ~c[(defdata-subtype boolean symbol)] and ~c[(defdata-subtype symbol atom)]
-  successfully, you can call ~c[(subtype-p boolean atom)] and because we
-  closed the subtype relation, we know that if T1 is a subtype
-  of T2 and T2 is a subtype of T3, then T1 is also a subtype of
-  T3 and we get back an affirmative answer, i.e ~c[t].
-  ~bv[]
-  Examples:
-  (defdata-subtype boolean symbol)
-  (defdata-subtype pos nat)
-  (defdata-subtype integer acl2-number)
-  ~ev[]                      
-  ~bv[]
-  Usage:
-  (defdata-subtype <Type-name1> <Type-name2>)
-  ~ev[]~/
-  "
-  
-  `(with-output
-    :stack :push
-    :off :all
-    (make-event
-     `(with-output
-       :stack :pop
-       :off ,(cond ((get-acl2s-defdata-debug)
-                    'acl2::proof-checker)
-                   ((get-acl2s-defdata-verbose)
-                    '(warning! observation warning acl2::proof-checker event acl2::expansion))
-                   (t 
-                    '(warning warning! observation prove acl2::proof-checker event acl2::expansion
-                             summary proof-tree))
-               
-               )
-       :gag-mode ,(if (get-acl2s-defdata-debug) 'nil 't)
-       (make-event
-        (compute-defdata-subtype ',',T1 ',',T2 state ',',hints ',',otf-flg ',',doc))))))
-
-  
-(defun compute-defdata-disjoint (T1 T2 wrld hints rule-classes otf-flg doc)
-  (declare (xargs :mode :program
-                  :guard (and (is-a-variablep T1)
-                              (is-a-variablep T2)
-                              )))
-  (b* ((T1p (get-predicate-symbol T1))
-       (T2p (get-predicate-symbol T2))
-       ((unless (and (is-a-typeName T1 wrld)
-                     (is-a-typeName T2 wrld)))
-;if not existing typenames raise error
-        (er hard 'defdata-disjoint "One of ~x0 and ~x1 is not a defined type!~%" T1 T2))
-       (form `(implies (,T1p x) (not (,T2p x))))
-       (nm (modify-symbol "DISJOINT-" T1p 
-                                  (string-append "-" (symbol-name T2p))))
-       (event-form
-        (if rule-classes
-            `((defthm ,nm
-                ,form
-                  :hints ,hints
-                  :rule-classes ,rule-classes
-                  :otf-flg ,otf-flg
-                  :doc ,doc))
-           `((thm ,nm
-                ,form
-                  :hints ,hints
-                  :otf-flg ,otf-flg
-                  :doc ,doc)))))
-      `(make-event 
-        (er-progn
-         ,@ (and (null rule-classes)
-                 event-form)
-            (let ((T1 ',T1)
-                  (T2 ',T2)
-                  (rule-classes ',rule-classes)
-                  (event-form ',event-form))
-            (value `(progn
-;macros call so dont need quotes
-                      ,@ (and rule-classes
-                              event-form)
-                      (add-edge-to-disjoint-graph-batch ,T1 ,T2)
-                      (sync-globals-for-dtg)
-                      (value-triple :defdata-disjoint-success))))))))
-;Note: Its good practice to use ctx,  otherwise u make copy-paste mistakes
-
- 
- 
-(defmacro defdata-disjoint (T1 T2 
-                               &key (rule-classes ':rewrite)
-                               hints otf-flg doc)
-  ":Doc-Section DATA-DEFINITIONS
-  Specify a disjoint relation between two types~/
-  ~c[(defdata-disjoint T1 T2)] tries to prove that the first
-  argument to it T1(which should be a ~st[supported type-name],
-  to check what we mean by that ~pl[data-definitions]) is
-  disjoint with the second argument T2. If the ACL2 is 
-  successful in proving the conjecture using thm/defthm:
-  ~c[(implies (T1p x) (not (T2p x)))] then this information is
-  stored in a internal disjoint data type graph, where
-  we perform closure of the disjoint relation. Henceforth
-  one can just call ~c[(disjoint-p T1 T2)] to get an 
-  affirmative which is just a lookup instead of calls
-  to the ACL2 theorem prover. And note that once you submit
-  ~c[(defdata-disjoint acl2-number symbol)] successfully,
-  you can call ~c[(disjoint-p nat boolean)] and because we
-  closed the disjoint relation, we know that all subtypes
-  of disjoint types are pairwise disjoint and we get back
-  an affirmative , i.e ~c[t]. You can give it the same 
-  keywords as a defthm/thm. If rule-classes are specified
-  to be nil, then a thm is used to prove the conjecture.
-  
-  ~bv[]
-  Examples:
-  (defdata-disjoint cons atom)
-  (defdata-disjoint character string)
-  (defdata-disjoint integer complex :rule-classes nil)
-  ~ev[]                      
-  ~bv[]
-  Usage:
-  (defdata-disjoint <Type-name1> <Type-name2>)
-  ~ev[]~/
-  "
-  `(with-output
-    :stack :push
-    :off :all
-    (make-event
-     `(with-output
-       :stack :pop
-       :off ,(cond ((get-acl2s-defdata-debug)
-                    'proof-checker)
-                   ((get-acl2s-defdata-verbose)
-                    '(warning! observation warning 
-                               proof-checker event expansion))
-                   (t 
-                    '(warning warning! observation prove
-                              proof-checker event expansion
-                              summary proof-tree))
-               
-               )
-       :gag-mode ,(if (get-acl2s-defdata-debug) 'nil 't)
-       (make-event 
-        (compute-defdata-disjoint ',',T1 ',',T2 (w state) ',',hints 
-                                  ',',rule-classes',',otf-flg ',',doc))))))#|ACL2s-ToDo-Line|#
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;---------------------Debugging Space below ------------------------------------------; 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-#|
-;:set-ignore-ok t
-(logic)
-
-(trace$ list-calls-union-constituent-is-subtype-aux filter-typeName)
-(defdata::cons-up-add-edge-union-constituent-is-subtype 
-  '((UX (oneof (cons boolean nat)
-              nat
-              pos
-              (cons nat nat)
-              (oneof pos neg)))
-    (RX (oneof UX (cons boolean RX) string)))
-  '(UX RX) state)
-
-(defun acl2::nth-integer (n)
-  (declare (xargs :guard (natp n)))
-  (let ((mag (floor n 2))
-        (sign (rem n 2)))
-    (if (= sign 0)
-      mag
-      (- -1 mag))))
-
-(register-data-constructor (consp cons)
-                           ((allp car) (allp cdr))
-                           :proper t)
-
-
-(define-enumeration-type boolean '(t nil))
-
-(set-verify-guards-eagerness 0)
-
-(trace$ er-trans-datadef-as-enumerator-lst)
-
-
-(DEFDATA::COMPUTE-DEFDATA '(WOO (list (ONEOF BOOLEAN 'OK)
-                                      (CONS 2 'AS)
-                                      (ONEOF (CONS integer integer)
-                                             (ONEOF integer integer)
-                                             woo)
-                                                ))
-                          'DEFDATA
-                          (W STATE)
-                          STATE)                 
-(ER-TRANS-DATADEF-AS-ENUM-new-LST '((LIST (ONEOF BOOLEAN 'OK)
-                                              (CONS 2 'AS)
-                                              (ONEOF (CONS INTEGER INTEGER)
-                                                     (ONEOF INTEGER INTEGER)
-                                                     WOO)))
-                                       'NIL '(NTH-WOO)
-                                       0 'DEFDATA (w state)
-                                       state)
-
-
-
-
-;given (/ (numerator denominator) rationalp) is constructor
-;defs & theorems for this defdata:
-
-(thm
- (implies (and (integerp i)
-                (posp p))
-          (and
-           (rationalp (/ i p))
-           (integerp (numerator (/ i p)))
-           (posp   (denominator (/ i p))))))
-           
-(defun my-rationalp (x)
-  (and (rationalp x)
-       (integerp (numerator x))
-       (posp (denominator x))))
-
-(defun nth-my-rational (n)
-  (let* ((pair (split-nat n))
-         (a (nth-integer (car pair)))
-         (b (nth-pos (cdr pair))))
-    (/ a b)))
-
-
-(defdata
-     (coo integer  
-             :hints (:in-theory (set-difference-theories (current-theory :here) '(assoc))
-                     :use ((:instance assoc-of-append (x a) (y b) (z c))))
-             :otf-flg t))
-
-      
-
-(defexec succ (x)
-  (declare (xargs :guard (natp x)))
-  (mbe :logic
-       (if (natp x)
-         (1+ x)
-         1)
-       :exec (1+ x)))
-
-(defun pred (x)
-  (declare (xargs :guard (natp x)))
-  (if (zp x)
-    0
-    (1- x)))
-
-(defthm succ-pred
-  (implies (posp x)
-           (equal (succ (pred x)) x)))
-
-(register-data-constructor (posp succ)
-
-
-
-(defdata
-  (my-rational (/ integer pos)))
-
-
-(defdata
-  (tm (listof
-       (cons all
-             (listof tm-action))))
-  (tm-action (list (field cursym all)
-                   (field nextstate all)
-                   (field newsym all)
-                   (field direction boolean))))
-|#
diff -Nru acl2-6.2/books/countereg-gen/graph.lisp acl2-6.3/books/countereg-gen/graph.lisp
--- acl2-6.2/books/countereg-gen/graph.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/graph.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1778 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book);$ACL2s-Preamble$|#
-
-;Author: harshrc
-;Started: June09? In mostly Finished state: Sep 5th 09.
-
-(in-package "DEFDATA")
-(include-book "utilities" :load-compiled-file :comp)
-(include-book "data" :load-compiled-file :comp)
-
-;;;; harshrc --
-;;;; NOTE: This is an old graph book which will be replaced by the
-;;;; simpler simple-graph-array book.
-
-
-;*** START GLOBALS ***
-;changed stobj to globals (how to assert the types? like in stobjs)
-;dt1g stands for datatype 1dim array (adjacency list) graph implementation   (to store Explicit graph)
-;dt2g stands for datatype 2dim array (adjacency matrix) graph implementation (to store Implicit graph)
-;NOTE:we store the explicit (subtype and disjoint) graphs to record all the
-;user-defined events and the implicit graphs to store information implied/inferred by SCC and Closure algos.
-(make-event
- (er-progn
-  ;explicit-vertMap maps typenames(symbols) to natural numbers(indexes of explicit graphs)
-  (assign explicit-vertmap nil)
-  
-  ;implied-vertMap-arr maps indexes (of explicit graphs) to indexes(of implied graphs).
-  (assign explicit-implied-index-map nil)
-  
-  ;subtype-dtg-alst is the explicit subtype relation datatype graph (with AdjList ALIST representation)
-  (assign subtype-dtg-alst nil)
-  ;implied-subtype-dt2g is the implied subtype relation datatype graph (with AdjMatrix matrix representation)
-  (assign implied-subtype-dt2g nil)
-  
-  ;disjoint-dtg-alst is the explicit disjoint relation datatype graph (with AdjList ALIST representation)
-  (assign disjoint-dtg-alst nil)
-   ;implied-disjoint-dt2g is the implied disjoint relation datatype graph (with AdjMatrix matrix representation)
-  (assign implied-disjoint-dt2g nil)
-  
-  ;I dont think we now need the following, as explicit graph size will be exactly of live-size(May change)
-  ;(assign dtg-live-size 0)
-  (value '(value-triple :DTG-GLOBALS-INITIALIZED))))
-
-
-
-(defun get-explicit-vertmap (state)
-  (declare (xargs :stobjs (state)))
-  (if (f-boundp-global 'explicit-vertmap state)
-    (let ((m (@ explicit-vertmap)))
-      (if (symbol-alistp m)
-        m
-        nil))
-    nil))
-
-(defmacro set-explicit-vertmap (v)
- `(assign explicit-vertmap ,v))
-
-(defun get-explicit-implied-index-map (state)
-  (declare (xargs :stobjs (state)))
-  (if (f-boundp-global 'explicit-implied-index-map state)
-    (let ((m (@ explicit-implied-index-map)))
-      (if (array1p 's-explicit-implied-index-map m)
-        (cons 's-explicit-implied-index-map m) ;package the name with the array
-        nil))
-    nil))
-
-(defmacro set-explicit-implied-index-map (v)
- `(assign explicit-implied-index-map ,v))
-
-(defun nat-alistp (al)
-  (declare (xargs :guard t))
-  (if (null al)
-    t
-    (if (atom al)
-      nil
-      (and (consp (car al))
-           (natp (caar al))
-           (nat-alistp (cdr al))))))
-
-(defun get-subtype-dtg-alst (state)
-  (declare (xargs :stobjs (state)))
-  (if (f-boundp-global 'subtype-dtg-alst state)
-    (let ((g (@ subtype-dtg-alst)))
-      (if (nat-alistp g);stored as an alist (adjlist with vertexes stored as indexes)
-        g           ;we can easily get a 1-dim array graph from the alist rep using compress1
-        nil))
-    nil))
-
-(defmacro set-subtype-dtg-alst (v)
- `(assign subtype-dtg-alst ,v))
-
-(defun get-implied-subtype-dt2g (state)
-  (declare (xargs :stobjs (state)))
-  (if (f-boundp-global 'implied-subtype-dt2g state)
-    (let ((g (@ implied-subtype-dt2g)))
-      (if (array2p 'implied-subtype-dt2g g);same name as global ;CHECK
-        (cons 'implied-subtype-dt2g g) ;package the name with the array
-        nil))
-    nil))
-
-(defmacro set-implied-subtype-dt2g (v)
- `(assign implied-subtype-dt2g ,v))
-
-(defun get-disjoint-dtg-alst (state)
-  (declare (xargs :stobjs (state)))
-  (if (f-boundp-global 'disjoint-dtg-alst state)
-    (let ((g (@ disjoint-dtg-alst)))
-      (if (nat-alistp g);stored as an alist (adjlist with vertexes stored as indexes)
-        g
-        nil))
-    nil))
-
-(defmacro set-disjoint-dtg-alst (v)
- `(assign disjoint-dtg-alst ,v))
-
-(defun get-implied-disjoint-dt2g (state)
-  (declare (xargs :stobjs (state)))
-  (if (f-boundp-global 'implied-disjoint-dt2g state)
-    (let ((g (@ implied-disjoint-dt2g)))
-      (if (array2p 'implied-disjoint-dt2g g);same name as global ;CHECK
-        (cons 'implied-disjoint-dt2g g) ;package the name with the array
-        nil))
-    nil))
-
-(defmacro set-implied-disjoint-dt2g (v)
- `(assign implied-disjoint-dt2g ,v))
-;*** END GLOBALS ***
-
-;some utilities:
-;1dim array
-(defun defarray1 (name size initial-element)
-  (compress1 name
-             (cons (list :HEADER
-                         :DIMENSIONS (list  size)
-                         :MAXIMUM-LENGTH (1+ size)
-                         :DEFAULT initial-element
-                         )
-                   nil)))
-
-(defun alst-to-array1 (name size alst)
-  (compress1 name
-             (cons (list :HEADER
-                         :DIMENSIONS (list  size)
-                         :MAXIMUM-LENGTH (1+ size)
-                         )
-                   alst)))
-
-
-;Adjacency Matrix (Square matrix) ; Can have a NameClash, get a different name!
-(defun defarray2 (name size initial-element)
-  (compress2 name
-             (cons (list :HEADER
-                         :DIMENSIONS (list size size)
-                         :MAXIMUM-LENGTH (1+ (* size size))
-                         :DEFAULT initial-element
-                         )
-                   nil)))
-
-
-
-;copy-paste seq macro (taken from The ACL2 Book)
-;sequential processing of state returning functions
-(defmacro seq (stobj &rest rst)
-  (cond ((endp rst) stobj)
-        ((endp (cdr rst)) (car rst))
-        (t `(let ((,stobj ,(car rst)))
-             (seq ,stobj ,@(cdr rst))))))
-
-
-;****shift to TABLES *******
-(table explicit-vertex-index-map nil nil :guard
-       (and (symbolp key)
-            (natp val)
-            (is-a-typeName key world)
-            (<= val 999))) ;at the moment only 1000 types allowed because of colori
-
-;table stores exactly one value, a 1-dim array which maps explicit indices to implicit ones.
-;the key is the name of the 1-dim-array
- (table explicit-implicit-index-map nil nil :guard
-       (and (symbolp key)
-            (array1p key val)))
-                        
-;table storing the explicit(user-defined explicit information) subtype data-type graph
-;with key as explicit index and val as adjacent list of explicit vertex indices
- (table subtype-dtg-alst nil nil :guard
-       (and (natp key)
-            (nat-listp val)))
-;table storing the explicit(user-defined explicit information) disjoint data-type graph
-;with key as explicit index and val as adjacent list of explicit vertex indices
-(table disjoint-dtg-alst nil nil :guard
-       (and (natp key)
-            (nat-listp val)))
-
-(defun matrixp (nm g)
-  (declare (xargs :guard t))
-  (and (symbolp nm)
-       (array2p nm g)
-       (equal (car (dimensions nm g))
-              (cadr (dimensions nm g)))))
-
-;table stores exactly one value, a adjacency matrix graph which is a 2-dim array.
-;the key is the name of the graph. this 2-dim array stores the transitive closure
-;of the subtype relation obtained from the explicit adj-list stored above. Hence
-;it is aptly named implicit-subtype-dt2g. dt2g means data-type-2dim-graph.
-(table implied-subtype-dt2g nil nil :guard
-       (and (symbolp key)
-            (matrixp key val)))
-           
- 
-;table stores exactly one value, a adjacency matrix graph which is a 2-dim array.
-;the key is the name of the graph. this 2-dim array stores the transitive closure
-;of the disjoint relation obtained from the explicit adj-list stored above. 
-(table implied-disjoint-dt2g nil nil :guard
-       (and (symbolp key)
-           (matrixp key val)))
-            
- 
-;*** END TABLES ***
-
-
-
-;(set-verify-guards-eagerness 2)
-
-;make a list of natural numbers upto (size-1)
-;(make-n-upto-list 3 nil) ==> (0 1 2)
-(defun make-n-upto-list (size ans)
-  (declare (xargs :guard (and (natp size)
-                              (nat-listp ans))))
-  (if (zp size)
-    ans
-    (make-n-upto-list  (1- size) (cons (1- size) ans))))  
-
-
-
-(defun index1p (i nm g1)
-  (declare (xargs :guard t))
-  (if (array1p nm g1)
-    (and (natp i)
-         (< i (car (dimensions nm g1))))
-    nil))
-
-(defun index2p (i nm g2)
-  (declare (xargs :guard t))
-  (if (matrixp nm g2)
-    (and (natp i)
-         (< i (car (dimensions nm g2))))
-    nil))
-
-(defun index1-listp (x nm g1)
-  (declare (xargs :guard t))
-  (if (array1p nm g1)
-    (if (atom x)
-      (null x)
-      (and (index1p (car x) nm g1)
-           (index1-listp (cdr x) nm g1)))
-    nil))
-                              
-(defun index2-listp (x nm g2)
-  (declare (xargs :guard t))
-  (if (matrixp nm g2)
-    (if (atom x)
-      (null x)
-      (and (index2p (car x) nm g2)
-           (index2-listp (cdr x) nm g2)))
-    nil))
-
-;(in-theory (disable index2-listp index2p))
-
-(defthm index1-list-member-is-index1 
-  (implies 
-   (and (index1-listp x nm g1)
-        (consp x))
-   (and (index1p (car x) nm g1)
-        (index1-listp (cdr x) nm g1))))
-
-(defthm index2-list-member-is-index2 
-  (implies 
-   (and (index2-listp x nm g)
-        (consp x))
-   (and (index2p (car x) nm g)
-        (index2-listp (cdr x) nm g))))
-
-
-
-(defun g-2d-size (nm g)
-  (declare (xargs :guard (matrixp nm g))) 
-  (car (dimensions nm g)))
-
-(defun g-1d-size (nm g)
-  (declare (xargs :guard (array1p nm g))) 
-  (car (dimensions nm g)))
-
-(set-verify-guards-eagerness 0)
-;;Find adjacent vertices to the vertex 'u' in the 
-;;graph adj matrix 'g' of name 'name' and of size 'size'. 
-(defun adj-vertices-loop (u name g ctr size ans)
-  (declare (xargs :guard (and (matrixp name g) 
-                              (natp size)
-                              (natp ctr)
-                              (<= ctr size)
-                              (equal size (g-2d-size name g))
-                              (implies (not (zp ctr));base case
-                                       (let ((v (- size ctr)))
-                                         (index2p v name g)))
-                              (index2p u name g)
-                              (index2-listp ans name g))))
-  (if (zp ctr) ;reached end
-    ans        ;order is maintained
-    (let ((v (- size ctr)))
-      (adj-vertices-loop u name g (1- ctr) size (if (aref2 name g u v )
-                                                (append ans (list v))
-                                                ans)))))
-
-(defun adj-vertices (u nm g)
-  (declare (xargs :guard (and (matrixp nm g) 
-                              (index2p u nm g))))
-   (let ((size (g-2d-size nm g)))
-     (adj-vertices-loop u nm g size size nil)))
-
-(set-verify-guards-eagerness 2)
-
-;update 'new-g' with transposed entry in the adj matrix 'g'
-(defun transpose-g-entry (nm g new-nm new-g row col)
-  (declare (xargs :guard (and (matrixp nm g)
-                              (matrixp new-nm new-g)
-                              (equal (g-2d-size nm g)
-                                     (g-2d-size new-nm new-g))
-                              (index2p row nm g)
-                              (index2p col nm g)
-                              (index2p row new-nm new-g)
-                              (index2p col new-nm new-g))))
-                                       
-  (let ((entry (aref2 nm g row col)))
-    (aset2 new-nm new-g col row entry)))
-
-;helps guards
-(defun less-than (a b)
-  (declare (xargs :guard t))
-  (if (and (natp a)
-           (natp b))
-    (< a b)
-    nil))
-
-;if I could prove the foll theorem, a lot of the guard proofs will go through!
-#| 
-(defthm modify-graph-still-remains-graph
-  (implies (and (matrixp nm g)
-                (index2p row nm g)
-                (index2p col nm g))
-           (let ((new-g (aset2 nm g col row entry)))
-             (and (matrixp nm new-g)
-                  (index2p row nm new-g)
-                  (index2p col nm new-g)))))
-|#
-
-(defun up-counterp (ctr size)
-  (if (and (natp ctr) (natp size))
-    (cond ((= ctr size) t)
-          ((< ctr size) t)
-          (t nil))
-    nil))
-
-(defun index2-up-counterp (ctr size nm g)
-  (if (and (matrixp nm g)
-           (equal size (g-2d-size nm g))) 
-    (or (up-counterp ctr size)
-        (index2p ctr nm g))
-    nil))
-
-(defun down-counterp (ctr size)
-  (if (and (natp ctr) (natp size))
-    (cond ((= ctr size) t)
-          ((< ctr size) t)
-          (t nil))
-    nil))
-
-(set-verify-guards-eagerness 0)
-
-;*** START of transpose graph functions ***
-;Main function call: (transpose-adjmatrix-graph new-nm nm g)
-;Sig: Symbol * Symbol * Array2 -> Array2
-;It takes an existing 2-dim matrix graph 'g' of name 'nm' and builds a new
-;2-dim matrix graph of name 'new-nm'.
-
-;loop over colums
-(defun tg-loop-col (nm g new-nm new-g row col size)
-  (declare (xargs :measure (acl2-count (- size col))
-                  :guard (and (matrixp nm g)
-                              (matrixp new-nm new-g)
-                              (equal size (g-2d-size nm g))
-                              (equal size (g-2d-size new-nm new-g))
-                              (equal (g-2d-size nm g)
-                                     (g-2d-size new-nm new-g))
-                              (index2p row nm g)
-                              (index2-up-counterp col size nm g)
-                              (index2p row new-nm new-g)
-                              (index2-up-counterp col size new-nm new-g))))
-                              
-  (if (not (less-than col size))
-    new-g
-    (let ((new-g (transpose-g-entry nm g new-nm new-g row col)))
-      (tg-loop-col nm g new-nm new-g row (1+ col) size))))  
-
-
-;loop over rows.
-(defun tg-loop-row (nm g new-nm new-g row size)
-  (declare (xargs :measure (acl2-count (- size row))
-                  :guard (and (matrixp nm g)
-                              (matrixp new-nm new-g)
-                              (equal size (g-2d-size nm g))
-                              (equal size (g-2d-size new-nm new-g))
-                              (equal (g-2d-size nm g)
-                                     (g-2d-size new-nm new-g))
-                              (index2-up-counterp row size nm g)
-                              (index2-up-counterp row size new-nm new-g))))
-  (if (not (less-than row size))
-    new-g
-    (let ((new-g (tg-loop-col nm g new-nm new-g row 0 size)))
-      (tg-loop-row nm g new-nm new-g (1+ row) size))))  
-
-;transpose g to obtain new-g of same size
-(defun transpose-adjmatrix-graph (new-nm nm g)
-  (declare (xargs :guard (and (symbolp new-nm)
-                              (matrixp nm g))))
-                             
-  (let* ((size (g-2d-size nm g))
-         (new-g (defarray2 new-nm size nil)))
-    (tg-loop-row nm g new-nm new-g 0 size)))
-;*** END of transpose graph functions ***
-  
-
-;*** START functions for finding transpose of subtype-dtg adjlist graph ***
-;Fun call: (transpose-dt1g new-nm nm dt1g)
-;Sig: Symbol * Symbol * Array1 -> Array2
-;Take a 1-dim array (graph) 'dt1g' of name 'nm' and returns 
-;a 2-dim array (matrix) of name 'new-nm' of same size
-
-; Nat * Symbol * Array2 * Integer-list -> Array2
-;TODO:infinite loop while guard verification
-(defun transpose-adjvertices-2g (i new-nm new-g adj-vertices-lsti)
-  (declare (xargs :guard (and (symbolp new-nm)
-                              (matrixp new-nm new-g)
-                              (index2p i new-nm new-g)
-                              (index2-listp adj-vertices-lsti new-nm new-g))))
-  (if (endp adj-vertices-lsti)
-    new-g
-    (let* ((adj-verti (car adj-vertices-lsti))
-           (new-g (aset2 new-nm new-g adj-verti i 't)))
-      (transpose-adjvertices-2g i new-nm new-g (cdr adj-vertices-lsti)))))
-  
-;Symbol * Array2  * Subtype-dtg-st *  Nat -> Array2
-(defun transpose-dt1g-aux (new-nm new-2g nm dt1g size down-ctr)
-  (declare (xargs :guard (and (symbolp new-nm)
-                              (symbolp nm)
-                              (matrixp new-nm new-2g)
-                              (array1p nm dt1g)
-                              (natp down-ctr)
-                              (natp size)
-                              (equal size (g-2d-size new-nm new-2g))
-                              (equal size (g-1d-size nm dt1g))
-                              (<= down-ctr size))))
-  (if (zp down-ctr)
-    new-2g
-    (let* ((i (- size down-ctr))
-           (adj-vertices-lsti (aref1 nm dt1g i))  
-           (new-2g (transpose-adjvertices-2g i new-nm new-2g adj-vertices-lsti)))
-      (transpose-dt1g-aux new-nm new-2g nm dt1g size (1- down-ctr)))))
-          
- ;Return the reverse of the subtype-dtg adjlist graph passed
-(defun transpose-dt1g (new-nm nm dt1g)
-  (declare (xargs :guard (and (symbolp new-nm)
-                              (symbolp nm)
-                              (array1p nm dt1g)
-                              )))
-  (let* ((size (g-1d-size nm dt1g))
-         (rev-2g (defarray2 new-nm size nil)))
-    (transpose-dt1g-aux new-nm rev-2g nm dt1g size size)))
-;*** END functions for finding transpose of subtype-dtg adjlist graph ***  
-
-;This stobj collects intermediate imperative state information
-;about a graph traversal. In our case the DFS bookkeeping info.
-;TODO: (IMP) cant 1000 be a parameter? -this is causing a bug if number of types exceed 1000!!!!
-(defstobj g-visit-state
-  (timer :type (integer 0 *) :initially 0) ;initialise time to 0
-  (color :type (array t (1000)) :initially white :resizable t);initialize color
-  (finish-times-lst :type t :initially nil)
-  (vert-ft-lst :type t :initially nil) ;initialize decreasing finish times vertice list to be returned
-  (df-forest :type t :initially nil) ;initialize the depth-first forest to be returned by dfs
-  (dff-stub :type t :initially nil);temporary storage for answer returned by dfs-visit-lst/dfs-visit
-  :inline t)
-
-
-;DFS (from Cormen)
-(mutual-recursion
- (defun dfs-visit-lst (nm g vs g-visit-state)
-   (declare (xargs :stobjs (g-visit-state)
-                   :guard (and (index2-listp vs nm g)
-                               (matrixp nm g))
-                   :mode :program))
-   (if (endp vs) ;if not more vertices to visit, return book-keeping information
-     g-visit-state
-     (if (equal 'white (colori (car vs) g-visit-state))
-        ;if (car vs) not visited before, then visit it and update book-keeping info
-        (let* ((dff-tmp (dff-stub g-visit-state));store intermediate dff which might be reset in dfs-visit
-               (g-visit-state (dfs-visit nm g (car vs) g-visit-state))
-               (dft (dff-stub g-visit-state)));get dft tree(answer returned by dfs-visit)
-          (seq g-visit-state
-               (update-dff-stub (append dff-tmp (list dft)) g-visit-state) ;order important 
-               (dfs-visit-lst nm g (cdr vs) g-visit-state)))
-        (dfs-visit-lst nm g (cdr vs) g-visit-state ))
-          ))
-   
-;visit 'u' in a dfs of 'g', do book-keeping in g-visit-state  
- (defun dfs-visit (nm g u g-visit-state)
-   (declare (xargs :stobjs (g-visit-state) 
-                   :guard (and (index2p u nm g)
-                               (matrixp nm g))
-                   :mode :program))
-   (let ((adj-vs (adj-vertices u nm g))) ;get adjacent vertices
-        (seq g-visit-state
-             (update-colori u 'gray g-visit-state)                   ;update color of u to 'gray
-             (update-timer (1+ (timer g-visit-state)) g-visit-state) ;update time
-             (update-dff-stub nil g-visit-state)                     ;init dfs-forest as nil
-             (dfs-visit-lst nm g adj-vs g-visit-state)               ;visit adjacent vertices
-             (update-colori u 'black g-visit-state)                  ;update color of visited vertice
-             (update-timer (1+ (timer g-visit-state)) g-visit-state) ;update finishing time
-             (update-vert-ft-lst (cons u (vert-ft-lst g-visit-state)) 
-                                 g-visit-state)                      ;update last finished vertex list 
-             (update-finish-times-lst (cons (cons u (timer g-visit-state))
-                                            (finish-times-lst g-visit-state))
-                                      g-visit-state)                 ;update (vertex . finishing-time) alist
-             (update-dff-stub (cons u (dff-stub g-visit-state))
-                              g-visit-state))))                      ;update dfs forest stub to get dfs-tree
- 
- )
-
-  
-;loop over vertices in 'v-lst' in the graph 'g'
-(defun dfs-vertex-loop (nm g v-lst g-visit-state)
-  (declare (xargs :mode :program
-                  :stobjs (g-visit-state)
-                  :guard (and (matrixp nm g)
-                              (index2-listp v-lst nm g))))
-                              
-                              
-  (if (endp v-lst)
-    g-visit-state
-    (let ((curr-v (car v-lst)))
-      ;only do a dfs-visit of current vertice if it has not been visited before
-      ;i.e its color is 'white'.
-      (if (equal 'white (colori curr-v g-visit-state))
-        (let* ((dff-old (df-forest g-visit-state))
-               (g-visit-state (dfs-visit nm g curr-v g-visit-state))
-               (dft-stub (dff-stub g-visit-state)) ;get dfs-tree for the current vertice
-               (g-visit-state (update-df-forest (append dff-old (list dft-stub)) ;order important
-                                                g-visit-state))) ;update dfs forest 
-          (dfs-vertex-loop nm g (cdr v-lst) g-visit-state))
-        (dfs-vertex-loop nm g (cdr v-lst) g-visit-state)))))
-                        
-
-
-  
-;skeleton function calling dfs-vertex-loop
-(defun compute-dfs (nm g v-lst g-visit-state)
-  (declare (xargs :mode :program
-                  :stobjs (g-visit-state)
-                  :guard (and (matrixp nm g)
-                              (index2-listp v-lst nm g))))
-  (let* (;(g-visit-state (init-dfs nm g size g-visit-state))
-         (g-visit-state (dfs-vertex-loop nm g v-lst g-visit-state)))
-    (mv ;(finish-times-lst g-visit-state) 
-        (vert-ft-lst g-visit-state)
-        (df-forest g-visit-state)
-        g-visit-state)))
-
-;main dfs function using a local stobj to store book-keeping info   
-;Symbol * Array2 * Nat-list ->  (Nat-list(decreasing finish times) * DFS-FOREST)
-;Takes a matrix 'g' of name 'name' and ordered list of vertices 'v-lst' to visit
-;and returns a multiple value: (vertex-list in decreasing finish times order * DFS-FOREST)
-(defun dfs (name g v-lst)
-  (declare (xargs :mode :program 
-                  :guard (and (matrixp name g)
-                              (index2-listp v-lst name g))))
-  (acl2::with-local-stobj
-   g-visit-state
-     (mv-let (vert-ft-lst dfs-forest g-visit-state)
-             (compute-dfs name g v-lst g-visit-state)
-             (cons vert-ft-lst dfs-forest)))) 
-
-(defun add-entry-2g (i nm g adj-vertices-lsti)
-  (declare (xargs :guard (and (symbolp nm)
-                              (matrixp nm g)
-                              (index2p i nm g)
-                              (index2-listp adj-vertices-lsti nm g))))
-  (if (endp adj-vertices-lsti)
-    g
-    (let* ((adj-verti (car adj-vertices-lsti))
-           (g (aset2 nm g i adj-verti 't)))
-      (add-entry-2g i nm g (cdr adj-vertices-lsti)))))
-  
-
-
-;*** START functions for Build a 2-dim array (matrix) from a 1-dim array (adjlist) ***
-;Sym * Array2  * Subtype-dtg-st *  Nat -> Array2
-(defun make-dt2g-from-dt1g-aux (new-nm new-2g nm dt1g size n)
-  (declare (xargs :guard (and (matrixp new-nm new-2g)
-                              (array1p nm dt1g)
-                              (natp size)
-                              (equal size (g-1d-size nm dt1g))
-                              (equal size (g-2d-size new-nm new-2g))
-                              (down-counterp n size))))
-  (if (zp n)
-    new-2g
-    (let* ((i (- size n))
-           (adj-vertices-lsti (aref1 nm dt1g i))
-           (new-2g (add-entry-2g i new-nm new-2g adj-vertices-lsti)))
-      (make-dt2g-from-dt1g-aux new-nm new-2g nm dt1g size (1- n)))))
-
-;Symbol * Array1 -> Array2 (2d Array representation of adjlist subtype graph with name nm) 
-;Complexity same as Tranpose fn: O(|V|+|E|) 
-(defun make-dt2g-from-dt1g (new-nm nm dt1g)
-  (declare (xargs :guard (and (symbolp new-nm)
-                              (array1p nm dt1g))))
-  (let* ((size (g-1d-size nm dt1g))
-         (new-2g (defarray2 new-nm size nil)))
-    (make-dt2g-from-dt1g-aux new-nm new-2g nm dt1g size size)))
-;*** END functions for Build a 2-dim array (matrix) from a 1-dim array (adjlist) ***
-    
-
-(defun dfs-on-dt1g (nm dt1g)
-  (declare (xargs :mode :program
-                  :guard (and (symbolp nm)
-                              (array1p nm dt1g)
-                              )))
-  (let* ((size (g-1d-size nm dt1g))
-         (v-lst (make-n-upto-list size nil)) ;get vertices in a list
-         (new-nm 'subtype-dt2g)
-         (new-2g (make-dt2g-from-dt1g new-nm nm dt1g))) ;take 2d impl
-    (dfs new-nm new-2g v-lst)))
-
-;Compute SCC of the 1-dim array 'dt1g' (adjlist) of name 'nm'
-(defun scc(nm dt1g)
-  (declare (xargs :mode :program
-                  :guard (and (symbolp nm)
-                              (array1p nm dt1g)
-                              )))
-  (let* ((ord-vlist (car (dfs-on-dt1g nm dt1g)));get the vertices in order of decreasing finish times
-         (transpose-2g (transpose-dt1g 'dt2g-t nm dt1g)) ;take the 2d transpose of the original dt1g
-         (scc-ans (dfs 'dt2g-t transpose-2g ord-vlist))) ;get back a dfs forest
-    scc-ans)) ;return it
-
-;find strongly connected components for the subtype graph
-;the subtype adjlist graph alist is stored in the global 
-;state -> List of strongly connected components (DFS-FOREST)
-(defun scc-top-level (dt1g-alst)
-  (declare (xargs :mode :program
-                  :guard (alistp dt1g-alst)))
-  (if (null dt1g-alst)
-    nil
-    (let* ((nm 'subtype-dt1g-scc);name it
-           (len-dt1g (len dt1g-alst))
-           (dt1g (compress1 nm (cons (list :header
-                                           :dimensions (list len-dt1g)
-                                           :maximum-length (1+ len-dt1g)
-                                           :default nil
-                                           :name nm)
-                                     dt1g-alst))))
-      
-      (cdr (scc nm dt1g)))));discard the decreasing fin times vertex list and only give back the dfs-forest
-  
-(defun dfs-on-alst (nm alst)
-  (declare (xargs :mode :program
-                  :guard (and (symbolp nm)
-                              (alistp alst))))
-  (if (null alst)
-    nil
-    (let* ((len-dt1g (len alst))
-           (dt1g (compress1 nm (cons (list :header
-                                           :dimensions (list len-dt1g)
-                                           :maximum-length (1+ len-dt1g)
-                                           :default nil
-                                           :name nm)
-                                     alst)))
-           (nm2g (modify-symbol nil nm "-2G"))
-           (dt2g (make-dt2g-from-dt1g nm2g nm dt1g)) ;take 2d impl
-           (v-lst (strip-cars alst))) ;get vertices in alst
-      (dfs nm2g dt2g v-lst))))
-           
-           
-           
-      
-
-#|
-;(trace$ dfs)
-
-(set-guard-checking :all)
-(trace$  ADJ-VERTICES-LOOP)
-
-(let* ((nm 'subtype-dt1g)
-       (g (compress1 nm 
-                    (cons (list :HEADER
-                                 :DIMENSIONS (list 9)
-                                 :MAXIMUM-LENGTH 10
-                                 :DEFAULT nil
-                                 :NAME nm)
-                           '((0 . (1))
-                             (1 . (4 2 5))
-                             (2 . (3 6))
-                             (3 . (2 7))
-                             (4 . (0 5))
-                             (5 . (6))
-                             (6 . (5 7))
-                             (7 . (7))
-                             (8 . nil)))));sole point
-       (size (g-1d-size nm g))
-       (v-lst (make-n-upto-list size nil)) ;get vertices in a list
-       (new-nm 'subtype-dt2g)
-       (new-2g (make-dt2g-from-dt1g new-nm nm g)))
-  (dfs new-nm new-2g v-lst))
-
-
-(let* ((nm 'subtype-dt1g)
-       (g (compress1 nm 
-                    (cons (list :HEADER
-                                 :DIMENSIONS (list 9)
-                                 :MAXIMUM-LENGTH 10
-                                 :DEFAULT nil
-                                 :NAME nm)
-                           '((0 . (1))
-                             (1 . (4 2 5))
-                             (2 . (3 6))
-                             (3 . (2 7))
-                             (4 . (0 5))
-                             (5 . (6))
-                             (6 . (5 7))
-                             (7 . (7))
-                             (8 . nil))))));no outgoing edge
-    (scc nm g))
-    
-(let* ((nm 'subtype-dt1g)
-      (g (compress1 nm 
-                    (cons (list :HEADER
-                                 :DIMENSIONS (list 12)
-                                 :MAXIMUM-LENGTH 13
-                                 :DEFAULT nil
-                                 :NAME nm)
-                           '((0 . (1 4))
-                             (1 . (0))
-                             (2 . (3 6 7))
-                             (3 . (2 7))
-                             (4 . (0 8 9))
-                             (5 . ())
-                             (6 . (2 7 10))
-                             (7 . (2 3 6 10 11))
-                             (8 . (4 9))
-                             (9 . (4 8))
-                             (10 . (6 7))
-                             (11 . (7)))))))
-    (scc nm g 12))
-;==> ((0 1 4 9 8 5 2 7 3 10 6 11)
-;      . ( (2 (7 (11) (10 (6)) (3)))
-;          (5)
-;          (0 (4 (9 (8))) (1))))
-|#
-
-         
-
-(set-verify-guards-eagerness 0)
-
-;*** start of initialising a matrix rep from the adjlist rep ***
-;Fun call: (tc-init-dt2g-from-dt1g nmI M nmE s1g ctr size)
-;Sig: Symbol *  Matrix * Symbol * AdjList * Down-counter * Nat -> Matrix
-;Initialise the matrix 'M'(pre-initialised to 'inf) of name 'nmI' using the adjlist 's1g' of 
-;name 'nmE' with Down-counter 'ctr' starting from 'size' and size of
-;graphs 'size'.
-
-;init for loop for j
-(defun tc-init-dt2g-from-dt1g-entry (nmI M i adj-vlsti)
-  (declare (xargs :guard (and (matrixp nmI M)
-                              (index2p i nmI M)
-                              (index2-listp adj-vlsti nmI M))))
-  (if (endp adj-vlsti)
-    M
-    (let* ((M (aset2 nmI M i (car adj-vlsti) 1)) ;init d(i,j) = 1 if (i,j) is an Edge
-           (M (aset2 nmI M i i 0))) ;init d(i,i) = 0
-      (tc-init-dt2g-from-dt1g-entry nmI M i (cdr adj-vlsti)))))
-
-;init for loop for i
-(defun tc-init-dt2g-from-dt1g (nmI M nmE s1g ctr size)
-  (declare (xargs :guard (and (matrixp nmI M)
-                              (array1p nmE s1g)
-                              (down-counterp ctr size)
-                              (natp size)
-                              (equal size (g-1d-size nmE s1g))
-                              (equal size (g-2d-size nmI M)))))
-  (if (zp ctr)
-    M
-    (let* ((i (- size ctr))
-           (adj-vlsti (aref1 nmE s1g i))
-           (M (tc-init-dt2g-from-dt1g-entry nmI M i adj-vlsti)))
-      (tc-init-dt2g-from-dt1g nmI M nmE s1g (1- ctr) size))))
- ;*** end of initialising a matrix rep from the adjlist rep *** 
-
-(defun dist-min (d1 d2)
-  (cond ((equal d1 'inf) d2)
-        ((equal d2 'inf) d1)
-        (t (min d1 d2))))
-  
-(defun dist-add (d1 d2)
-  (cond ((equal d1 'inf) d1)
-        ((equal d2 'inf) d2)
-        (t (+ d1 d2))))
-
-;*** start Transitive closure for Subtype Graph ***
-;Fun call: (subtype-implied-closure implied-nm dag-nm subtype-dag)
-;Sig: Symbol * Symbol * Array1 -> Matrix
-;Take a 1-dim dag (after SCC ) 'subtype=dag' of name 'dag-nm' to
-;build transitive closure matrix of name 'implied-nm' of same size.
-
-;;triple nested loop to calculate closure(no subscript version of floyd-warshall algo)
-;nested for loop for j
-(defun tc-loop-i-col (nm M k i ctr size)
-  (declare (xargs :guard (and (matrixp nm M)
-                              (index2p k nm M)
-                              (index2p i nm M)
-                              (down-counterp ctr size)
-                              (natp size)
-                              (equal size (g-2d-size nm M))
-                              )))
-  (if (zp ctr)
-    M
-    (let* ((j (- size ctr))
-           (M (aset2 nm M i j (dist-min 
-                               (aref2 nm M i j)
-                               (dist-add (aref2 nm M i k)
-                                         (aref2 nm M k j))))))
-      (tc-loop-i-col nm M k i (1- ctr) size))))
-
-;nested for loop for i
-(defun tc-loop-i-row (nm M k ctr size)
-  (declare (xargs :guard (and (matrixp nm M)
-                              (index2p k nm M)
-                              (down-counterp ctr size)
-                              (equal size (g-2d-size nm M))
-                              (natp size))))
-  (if (zp ctr)
-    M
-    (let* ((row (- size ctr)) 
-           (M (tc-loop-i-col nm M k row size size)))
-      (tc-loop-i-row nm M k (1- ctr) size))))
-
-;for loop for k
-(defun tc-loop-intermediate (nm M ctr size)
-  (declare (xargs :guard (and (matrixp nm M)
-                              (down-counterp ctr size)
-                              (equal size (g-2d-size nm M))
-                              (natp size))))
-  (if (zp ctr)
-    M
-    (let* ((k (- size ctr)) 
-           (M (tc-loop-i-row nm M k size size)));calculate M(k)
-      (tc-loop-intermediate nm M (1- ctr) size))))
-
-
-;main function calculating transition closure in form of matrix (Tn)
-;note that subtype-1g with name nm is not the explicit subtype graph stored
-;in globals. It is the minimal dag obtained after doing scc.
-(defun subtype-implied-closure (implied-nm dag-nm subtype-dag)
-  (declare (xargs :guard (and (symbolp implied-nm)
-                              (array1p dag-nm subtype-dag))))
-  (let* ((size (g-1d-size dag-nm subtype-dag))
-         (implied-M (defarray2 implied-nm size 'inf));initialise with infinity
-         (implied-M (tc-init-dt2g-from-dt1g implied-nm implied-M dag-nm subtype-dag size size)));initialise
-    (tc-loop-intermediate implied-nm implied-M size size))) ;get closure
-;*** end Transitive closure for Subtype Graph ***
-
-#|
-;(trace$ tc-loop-intermediate)
-(let ((T0 (defarray2 't0 4 'inf))
-      (g (compress1 'dtg
-             (cons (list :HEADER
-                         :DIMENSIONS (list 4)
-                         :MAXIMUM-LENGTH 5
-                         :DEFAULT nil
-                         :NAME 'dtg)
-                   '((0 . (0)) 
-                     (1 . (1 2 3))
-                     (2 . (1 2))
-                     (3 . (0 2 3))
-                     ) 
-                     ))))
-  (compress2 't0 (tc-init-dt2g-from-dt1g 't0 T0 'dtg g 4 4)))
-
-(let ((g (compress1 'dtg
-             (cons (list :HEADER
-                         :DIMENSIONS (list 4)
-                         :MAXIMUM-LENGTH 5
-                         :DEFAULT nil
-                         :NAME 'dtg)
-                   '((0 . nil) 
-                     (1 . (2 3))
-                     (2 . (1))
-                     (3 . (0 2))
-                     ) 
-                     ))))
-  (subtype-implied-closure 'implied-dtg 'dtg g))
-  
-  (subtype-implied-closure
-           'implied-subtype-dt2g
-            'subtype-dag-dt1g
-            '((13)
-             (:header :dimensions (14)
-                      :maximum-length 15
-                      :default nil
-                      :name defdata::subtype-dag-dt1g)
-             (0 3)
-             (1 0)
-             (2 3)
-             (3 6)
-             (4 6)
-             (5 6)
-             (6 8)
-             (7 8)
-             (8 13)
-             (9 13)
-             (10 13)
-             (11 13)
-             (12 13)))
- |#         
-
-
-(set-verify-guards-eagerness 2)
-
-;is t1 a subtype of t2, i.e. does (t1, t2) edge exist in the implied subtype adj matrix
-(defun is-subtype-in-implied-graph (t1 t2 s-nmI s2gI)
-  (declare (xargs :guard (and (matrixp s-nmI s2gI)
-                              (index2p t1 s-nmI s2gI)
-                              (index2p t2 s-nmI s2gI))))
-  (natp (aref2 s-nmI s2gI t1 t2))) ;ofcourse t1 is its own subtype
-
-;collect subtypes of a particular vertex in s2gI
-;Fun call: (collect-subtypes s-nmI s2gI v1)
-;Sig: Symbol * Matrix * Index2 -> Index2-list
-;Takes a subtype implied matrix graph 's2gI' of name 's-nmI'
-;and a vertex 'v1' and return a list of subtypes of 'v1'.
-(defun collect-subtypes1 (s-nmI s2gI v1 ctr size ans)
- (declare (xargs :guard (and (matrixp s-nmI s2gI)
-                              (index2p v1 s-nmI s2gI)
-                              (natp ctr)
-                              (equal size (car (dimensions s-nmI s2gI))) 
-                              (<= ctr size)
-                              (index2-listp ans s-nmI s2gI))))
-  (if (zp ctr)
-    ans
-    (let* ((v3 (- size ctr))
-           ;is v3 a subtype of v1
-           (is-ST (is-subtype-in-implied-graph v3 v1 s-nmI s2gI))) ;ideally it shud be posp cos only self-edge has dist=0
-      (collect-subtypes1 s-nmI s2gI v1 (1- ctr) size (if is-ST (cons v3 ans) ans)))));if it is then collect v3
-
-;collect subtypes of index v1 using the implied subtype closure graph 's2gI'
-(defun collect-subtypes (s-nmI s2gI v1)
-  (declare (xargs :guard (and (matrixp s-nmI s2gI)
-                              (index2p v1 s-nmI s2gI))))
-  (let ((size (car (dimensions s-nmI s2gI))))
-    (collect-subtypes1 s-nmI s2gI v1 size size nil)))
-
-
-;*** START functions : Transitive closure of Disjoint graph
-;Disjointedness relation closure algorithm
-
-;aux fun to mark v3 and v4 disjoint in 'dis2gI' 
-(defun mark-disjoint-vertex-vertex (d-nmI dis2gI v3 v4)
-  (declare (xargs :guard (and (matrixp d-nmI dis2gI)
-                              (index2p v3 d-nmI dis2gI)
-                              (index2p v4 d-nmI dis2gI))))
-  (let ((dis2gI (aset2 d-nmI dis2gI v3 v4 't))) ;'t means v3 and v4 are disjoint
-    dis2gI))
-
-
-(set-verify-guards-eagerness 0)
-;aux fun to mark v3 and v4s disjoint in 'dis2gI' 
-(defun mark-disjoint-vertex-vertexlist (d-nmI dis2gI v3 v4s)
-  (declare (xargs :guard (and (matrixp d-nmI dis2gI)
-                              (index2p v3 d-nmI dis2gI)
-                              (index2-listp v4s d-nmI dis2gI)
-                              )))
-(if (endp v4s)
-    dis2gI
-    (let* ((dis2gI (mark-disjoint-vertex-vertex d-nmI dis2gI v3 (car v4s))))
-      (mark-disjoint-vertex-vertexlist d-nmI dis2gI v3 (cdr v4s)))))
-
-;mark v3s and v4s as pairwise disjoint in the implied disjoint matrix 'dis2gI'
-(defun mark-disjoint-vertex-lists (d-nmI dis2gI v3s v4s)
-  (declare (xargs :guard (and (matrixp d-nmI dis2gI)
-                              (index2-listp v3s d-nmI dis2gI)
-                              (index2-listp v4s d-nmI dis2gI))))
-  (if (endp v3s)
-    dis2gI
-    (let* ((dis2gI (mark-disjoint-vertex-vertexlist d-nmI dis2gI (car v3s) v4s)))
-      (mark-disjoint-vertex-lists d-nmI dis2gI (cdr v3s) v4s))))
-  
-;If v1 and v2 are disjoint in the disjoint dag then collect all their
-;subtypes using 's2gI' are pairwise mark them disjoint in 'dis2gI'
-(defun disjoint-implied-closure-aux2 (d-nmI dis2gI v1 v2 s-nmI s2gI)
-  (declare (xargs :guard (and (matrixp d-nmI dis2gI)
-                              (matrixp s-nmI s2gI)
-                              (index2p v1 s-nmI s2gI)
-                              (index2p v2 s-nmI s2gI)
-                              (index2p v1 d-nmI dis2gI)
-                              (index2p v2 d-nmI dis2gI))))
-                              
-  (let ((v3s (collect-subtypes s-nmI s2gI v1))
-        (v4s (collect-subtypes s-nmI s2gI v2)))
-    (mark-disjoint-vertex-lists d-nmI dis2gI v3s v4s))) ;mark v3s and v4s as pairwise disjoint
- 
-;Loop over all vertices disjoint with v1 and
-;1. mark them disjoint in 'dis2gI' 
-;2. call disjoint-implied-closure-aux2 to mark all subtypes of v1 and v2 as disjoint
-(defun disjoint-implied-closure-aux1 (d-nmI dis2gI s-nmI s2gI v1 adj-vlst-v1)
-  (declare (xargs :guard (and (matrixp d-nmI dis2gI)
-                              (matrixp s-nmI s2gI)
-                             (index2p v1 s-nmI s2gI)
-                             (index2p v1 d-nmI dis2gI)
-                             (index2-listp adj-vlst-v1 s-nmI s2gI)
-                             (index2-listp adj-vlst-v1  d-nmI dis2gI))))
-  (if (endp adj-vlst-v1)
-    dis2gI
-    (let* ((v2 (car adj-vlst-v1)) ;get fist vertex disjoint to v1
-           (dis2gI (aset2 d-nmI dis2gI v1 v2 't)) ;init disjoint(i,j) = 't if (i,j) is an Edge in disjoint-g
-           (dis2gI (disjoint-implied-closure-aux2 d-nmI dis2gI v1 v2 s-nmI s2gI)));all subtypes of v1, v2 mark as disjoint
-      (disjoint-implied-closure-aux1 d-nmI dis2gI s-nmI s2gI v1 (cdr adj-vlst-v1)))))
-
-;loop over all vertices in d1g
-(defun disjoint-implied-closure-aux (d-nmI dis2gI dag-nm dag-d1g s-nmI s2gI ctr size)
-  (declare (xargs :guard (and (matrixp d-nmI dis2gI)
-                              (matrixp s-nmI s2gI)
-                              (equal size (car (dimensions s-nmI s2gI))) 
-                              (equal size (car (dimensions d-nmI dis2gI))) 
-                              (array1p dag-nm dag-d1g)
-                              (natp ctr)
-                              (<= ctr size))))
-  (if (zp ctr)
-    dis2gI
-    (let* ((i (- size ctr)) ;current vertex in disjoint graph
-           (adj-vlsti (aref1 dag-nm dag-d1g i)) ;get all vertices disjoint to i
-           (dis2gI (disjoint-implied-closure-aux1 d-nmI dis2gI s-nmI s2gI i adj-vlsti)))
-      (disjoint-implied-closure-aux d-nmI dis2gI dag-nm dag-d1g s-nmI s2gI (1- ctr) size))))
-
-;note d-nm d1g is not the explicit disjoint graph stored in globals but
-;the dag obtained after performing scc analysis.
-(defun disjoint-implied-closure (d-nmI dag-nm dag-d1g s-nmI s2gI)  
-  (declare (xargs :guard (and (symbolp d-nmI)
-                              (matrixp s-nmI s2gI)
-                              (equal (g-1d-size dag-nm dag-d1g)
-                                     (g-2d-size s-nmI s2gI))
-                              (array1p dag-nm dag-d1g))))
-  (let* ((size (car (dimensions s-nmI s2gI)))
-         (dis2gI (defarray2 d-nmI size 'nil));init with nil (not disjoint)
-         (dis2gI (disjoint-implied-closure-aux d-nmI dis2gI dag-nm dag-d1g s-nmI s2gI size size)));close
-    dis2gI))
-;*** END functions : Transitive closure of Disjoint graph  
-#|
-(disjoint-implied-closure
-            'implied-disjoint-dt2g
-            'disjoint-dag-dt1g
-            (compress1 'disjoint-dag-dt1g
-                       '((13)
-                         (12 10)
-                         (:header :dimensions (14)
-                          :maximum-length 15
-                          :default nil
-                          :name disjoint-dag-dt1g)
-                         (8 9 11 12 10)
-                         (9 11 12 10)
-                         (11 12 10)
-                         (12 10)))
-            'implied-subtype-dt2g
-            (compress2 'implied-subtype-dt2g
-             '((:header :dimensions (14 14)
-                      :maximum-length 197
-                      :default inf
-                      :name implied-subtype-dt2g)
-               ((13 . 13) . inf)
-               ((0 . 0) . 0)
-               ((0 . 3) . 1)
-               ((0 . 6) . 2)
-               ((0 . 8) . 3)
-               ((0 . 13) . 4)
-               ((1 . 0) . 1)
-               ((1 . 1) . 0)
-               ((1 . 3) . 2)
-               ((1 . 6) . 3)
-               ((1 . 8) . 4)
-               ((1 . 13) . 5)
-               ((2 . 2) . 0)
-               ((2 . 3) . 1)
-               ((2 . 6) . 2)
-               ((2 . 8) . 3)
-               ((2 . 13) . 4)
-               ((3 . 3) . 0)
-               ((3 . 6) . 1)
-               ((3 . 8) . 2)
-               ((3 . 13) . 3)
-               ((4 . 4) . 0)
-               ((4 . 6) . 1)
-               ((4 . 8) . 2)
-               ((4 . 13) . 3)
-               ((5 . 5) . 0)
-               ((5 . 6) . 1)
-               ((5 . 8) . 2)
-               ((5 . 13) . 3)
-               ((6 . 6) . 0)
-               ((6 . 8) . 1)
-               ((6 . 13) . 2)
-               ((7 . 7) . 0)
-               ((7 . 8) . 1)
-               ((7 . 13) . 2)
-               ((8 . 8) . 0)
-               ((8 . 13) . 1)
-               ((9 . 9) . 0)
-               ((9 . 13) . 1)
-               ((10 . 10) . 0)
-               ((10 . 13) . 1)
-               ((11 . 11) . 0)
-               ((11 . 13) . 1)
-               ((12 . 12) . 0)
-               ((12 . 13) . 1))))
-|#
-
-(set-verify-guards-eagerness 2)
-
-(defun flatten-tree-tl (bt lst)
-  (if (null bt)
-    lst
-    (if (atom bt)
-      (cons bt lst)
-      (flatten-tree-tl (car bt) (flatten-tree-tl (cdr bt) lst)))))
-
-(defun flatten-tree (tree)
-  (flatten-tree-tl tree nil))
-
-(defun find-min-node-in-list-tl (lst min)
-  (declare (xargs :guard (and (natp min)
-                              (nat-listp lst))))
-  (if(endp lst)
-    min
-    (find-min-node-in-list-tl (cdr lst) (min (car lst) min))))
-
-(defun find-min-node-in-list (lst)
-  (declare (xargs :guard (nat-listp lst)))
-  (if (endp lst)
-    nil
-    (find-min-node-in-list-tl lst (car lst))))
-
-(defun find-min-node-and-flatten-tree (tree)
-  (declare (xargs :verify-guards nil))
-  (let* ((lst (flatten-tree tree))
-         (min (find-min-node-in-list lst)))
-    (mv min lst)))
-
-
-;keep 2 alists. Explicit Alist [TypeName . Explicit Number] and an SCC Alist [Explicit Number . Quotient Number]
-;After each SCC, update the SCC Alist, the SCC Alist will give the new dag, both its adjlist and adjmatrix rep, the
-;adjmatrix rep will be taken as the initial implicit closure graph.
-
-;Global Explicit Graph will be kept in Alist representation (24-Aug-09)
-
-;Complicated!
-;This is the first pass
-(defun fill-dag-and-make-mapping-from-explicit-graph-scc1 (scc-nm scc-arr 
-                                                          size-e e-g-alist
-                                                          up-ctr-dag dag-nm dag 
-                                                          e-i-map-nm e-i-map-arr)
-  (declare (xargs :verify-guards nil
-                  :guard (and (array1p scc-nm scc-arr)
-                              (array1p e-i-map-nm e-i-map-arr);explicit-implicit-map [explicit g index . implicit g index] same as dag-map-arr
-                              (alistp e-g-alist)              ;but named because implicit graphs are obtained after SCC anyway. 
-                              (array1p dag-nm dag)
-                              (equal size-e (g-1d-size scc-nm scc-arr))
-                              (equal size-e (g-1d-size e-i-map-nm e-i-map-arr))
-                              (<= up-ctr-dag (car (dimensions dag-nm dag)))
-                              (<= (g-1d-size dag-nm dag) size-e)
-                              )))
-  (if (endp e-g-alist)
-    (mv (compress1 dag-nm dag)  (compress1 e-i-map-nm e-i-map-arr))
-    (let* ((curr-entry (car e-g-alist)) ;current entry in explicit graph alist
-           (i (car curr-entry))
-           (eq-node (aref1 scc-nm scc-arr i));get equivalent node
-           (adj-vs-i  (cdr curr-entry))) ;get adjacent vertices to current index
-      (if (equal i eq-node) ;if i is same as eq node
-        ;no change
-        (let* ((dag (aset1 dag-nm dag up-ctr-dag adj-vs-i));fill dag with corresponding entry in explicit graph
-               (e-i-map-arr (aset1 e-i-map-nm e-i-map-arr i up-ctr-dag)))
-          (fill-dag-and-make-mapping-from-explicit-graph-scc1 scc-nm scc-arr 
-                                                             size-e  (cdr e-g-alist)
-                                                             (1+ up-ctr-dag) dag-nm dag 
-                                                             e-i-map-nm e-i-map-arr))
-        ;replace with equivalent node
-        ;no update in dag in this pass(because eq node already exists), we basically skip
-        ;one index(but later we make another pass to update edges)
-        ;Caught Bug, but we should append its adj vertices to the existing eq node.
-        ;Note: eq node will always be less than or equal to i(because we employ min) ;TODO.CHECK
-        (let* ((dag (aset1 dag-nm dag eq-node (union-equal adj-vs-i (aref1 dag-nm dag eq-node))))
-               (e-i-map-arr (aset1 e-i-map-nm e-i-map-arr i (aref1 e-i-map-nm e-i-map-arr eq-node))));update e-i-map
-          (fill-dag-and-make-mapping-from-explicit-graph-scc1 scc-nm scc-arr 
-                                                             size-e (cdr e-g-alist)
-                                                             up-ctr-dag dag-nm dag ;skip one index 
-                                                             e-i-map-nm e-i-map-arr))))))
-
-;update the adj-vertex-list in dag(which contained old explicit indexes) 
-;using dag-map which maps explicit indexes to new dag indexes
-;also remove duplicates
-(defun update-edges-using-dag-map (u adj-vs dag-map-nm dag-map-arr ans)
-  (declare (xargs :verify-guards nil
-                  :guard (and (natp u) ;u is an index in the new dag
-                              (index1-listp adj-vs dag-map-nm dag-map-arr);these are old indexes which are to be mapped
-                              (nat-listp ans);these are mapped indices in new dag
-                              (array1p dag-map-nm dag-map-arr)
-                              )))
-  (if (endp adj-vs)
-    ;;remove self-edges (these will arise when u collapse scc edges)
-    ;;and also remove duplicates
-    (remove1 u (remove-duplicates ans))
-    (let* ((v (car adj-vs))
-           (v-mapped (aref1 dag-map-nm dag-map-arr v))
-           (ans (append ans (list v-mapped)))) ;in order!
-      (update-edges-using-dag-map u (cdr adj-vs) dag-map-nm dag-map-arr ans))))
-           
-
-(defun fill-dag-from-dag-map-and-explicit-graph (down-ctr-dag size-dag 
-                                                   dag-first-pass-nm dag-first-pass-finished
-                                                   dag-nm dag 
-                                                   dag-map-nm dag-map-arr)
-   (declare (xargs :verify-guards nil
-                   :guard (and (equal size-dag (g-1d-size dag-nm dag))
-                               (down-counterp down-ctr-dag size-dag)
-                               (array1p dag-first-pass-nm dag-first-pass-finished)
-                               (array1p dag-map-nm dag-map-arr)
-                               (array1p dag-nm dag))))
-   (if (zp down-ctr-dag)
-     (compress1 dag-nm dag)
-     (let* ((i (- size-dag down-ctr-dag)) ;current index in dag graph
-           (adj-vs (aref1 dag-first-pass-nm dag-first-pass-finished i))
-           (adj-vs-updated (update-edges-using-dag-map i adj-vs dag-map-nm dag-map-arr nil))
-           (dag (aset1 dag-nm dag i adj-vs-updated)));populate new dag
-       ;walk down the one dim array
-       (fill-dag-from-dag-map-and-explicit-graph (1- down-ctr-dag) 
-                                                   size-dag
-                                                   dag-first-pass-nm dag-first-pass-finished
-                                                   dag-nm dag 
-                                                   dag-map-nm dag-map-arr))))   
-   
-  
-;dag-map-arr which maps explicit index to dag indexes
-(defun fill-dag-and-make-mapping-from-explicit-graph-scc (scc-nm scc-arr 
-                                                         size-e e-g-alist
-                                                         dag-first-pass-nm dag-first-pass size-dag  
-                                                         dag-nm
-                                                         dag-map-nm dag-map-arr)
-  (declare (xargs :verify-guards nil
-                  :guard (and (array1p scc-nm scc-arr)
-                              (array1p dag-map-nm dag-map-arr)
-                              (alistp e-g-alist)
-                              (array1p dag-first-pass-nm dag-first-pass)
-                              (equal (g-1d-size scc-nm scc-arr)
-                                     (g-1d-size dag-map-nm dag-map-arr)))))
-                              
-  (mv-let (dag-first-pass-finished dag-map-arr)
-   ;first pass: walk down explicit graph e-g and fill dag and also make dag-map
-          (fill-dag-and-make-mapping-from-explicit-graph-scc1 scc-nm scc-arr 
-                                                              size-e e-g-alist
-                                                              0 dag-first-pass-nm dag-first-pass 
-                                                              dag-map-nm dag-map-arr)
-   ;second pass, walk down the dag to update edges in dag using dag-map-arr
-          (let* ((dag (defarray1 dag-nm size-dag nil));init
-                 (dag (fill-dag-from-dag-map-and-explicit-graph 
-                       size-dag size-dag
-                       dag-first-pass-nm dag-first-pass-finished
-                       dag-nm dag 
-                       dag-map-nm dag-map-arr)))
-            (mv dag dag-map-arr))))
-                        
-
-;Make SCC alist from SCCs of the original explicit subtype dt1g stored in globals.
-; scc-alist is an alist storing: ((Explicit-index of node . Equivalent index of node) ...)
-(defun fill-scc-alist-from-scc-component (representative equivalent-nodes scc-alist)
-  (declare (xargs :verify-guards nil
-                  :guard (and (natp representative)
-                              (nat-listp equivalent-nodes)
-                              (alistp scc-alist))))
-  (if (endp equivalent-nodes)
-    scc-alist
-    (let ((scc-alist (acons (car equivalent-nodes) ;key
-                            representative ;val
-                            scc-alist)))
-      (fill-scc-alist-from-scc-component representative
-                                           (cdr equivalent-nodes)
-                                           scc-alist
-                                           ))))
-                              
-
-;FIll alist 'scc-alist' of name 'scc-nm'  using data from sccs
-;scc-alist maps nodes(in the explicit dt1g) to their eq node. 
-;'sccs' are just a dfs-forest, i.e a list of dfs-trees
-(defun fill-scc-alist-from-sccs (sccs scc-alist)
-  (declare (xargs :verify-guards nil
-                  :guard (and (alistp scc-alist)
-                              (true-listp sccs))))
-  (if (endp sccs)
-    scc-alist
-    (let* ((scc (car sccs)));take first dfs tree
-      (if (null scc)
-        (fill-scc-alist-from-sccs (cdr sccs) scc-alist);skip if null, shjouldnt occur ideally
-        (mv-let (representative equivalent-nodes)
-                (find-min-node-and-flatten-tree scc)
-                (let* ((scc-alist (fill-scc-alist-from-scc-component representative
-                                                                   equivalent-nodes
-                                                                   scc-alist)))
-                  
-                  (fill-scc-alist-from-sccs (cdr sccs) scc-alist)))))))
-
-;copied from symbol-btree.lisp                                                                                                          
-(progn
-(defun merge-nat-alist-< (l1 l2 acc)
-  (declare (xargs :guard (and (nat-alistp l1)
-                              (nat-alistp l2)
-                              (true-listp acc))
-                  :measure (+ (len l1) (len l2))))
-  (cond ((endp l1) (revappend acc l2))
-        ((endp l2) (revappend acc l1))
-        ((< (caar l1) (caar l2))
-         (merge-nat-alist-< (cdr l1) l2 (cons (car l1) acc)))
-        (t (merge-nat-alist-< l1 (cdr l2) (cons (car l2) acc)))))
-(local (defthm len-evens-<
-         (implies (consp (cdr x))
-                  (< (len (evens x))
-                     (len x)))
-         :hints (("Goal" :induct (evens x)))
-         :rule-classes :linear))
-
-(local (defthm len-evens-<=
-         (<= (len (evens x))
-             (len x))
-         :hints (("Goal" :induct (evens x)))
-         :rule-classes :linear))
-
-(defun merge-sort-nat-alist-< (l)
-  (declare (xargs :guard (nat-alistp l)
-                  :verify-guards nil
-                  :measure (len l)))
-  (cond ((endp (cdr l)) l)
-        (t (merge-nat-alist-< (merge-sort-nat-alist-< (evens l))
-                              (merge-sort-nat-alist-< (odds l))
-                              nil))))
-)
-;end of copy paste
-
-(defun make-dag-and-dag-map-from-explicit-graph-alist (sccs e-g-alist dag-nm dag-map-nm)
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbolp dag-nm)
-                              (symbolp dag-map-nm)
-                              (nat-alistp e-g-alist)
-                              (true-listp sccs))))
-  (let* ((size-e (len e-g-alist))
-         (size-dag (len sccs));number of dfs trees i.e number of distinct dag nodes
-         (dag-first-pass-nm 'dag-first-pass-tmp-name)
-         (dag-first-pass (defarray1 dag-first-pass-nm size-e nil));init
-         (scc-nm 'scc-maparr)
-         ;;maps nodes(in the explicit dt1g) to their eq node. 
-         (scc-alist (fill-scc-alist-from-sccs sccs nil))
-         ;;init dag-map-arr which maps explicit index to dag indexes
-         (dag-map-arr (defarray1 dag-map-nm size-e nil)))
-    (fill-dag-and-make-mapping-from-explicit-graph-scc scc-nm (alst-to-array1 scc-nm (len scc-alist) scc-alist)
-                                                       size-e  (merge-sort-nat-alist-< e-g-alist)
-                                                       dag-first-pass-nm dag-first-pass size-dag
-                                                       dag-nm
-                                                       dag-map-nm dag-map-arr)))
-#|
-(untrace$ fill-dag-and-make-mapping-from-explicit-graph-scc1  fill-scc-alist-from-sccs)
-
-(DEFDATA::MAKE-DAG-AND-DAG-MAP-FROM-EXPLICIT-GRAPH-ALIST
-          '((2 (3)) (0 (1 (4))))
-          '((0 1 4) (1 0 4) (2 3) (3 2) (4 0 1 4))
-          'DEP-DAG-NAME
-          'IND-QUOTIENT-MAP-NM)
-
-(DEFDATA::MAKE-DAG-AND-DAG-MAP-FROM-EXPLICIT-GRAPH-ALIST
-            '((6 (7)) (4 (5)) (3) (2) (1) (0))
-            '((0)
-             (1)
-             (2)
-             (3)
-             (4 5)
-             (5 4)
-             (6 7)
-             (7 6))
-            'DEP-DAG-NAME 'IND-QUOTIENT-MAP-NM)
-
-
-((ATOM . 13)
- (STRING . 12)
- (CHARACTER . 11)
- (SYMBOL . 10)
- (BOOLEAN . 9)
- (ACL2-NUMBER . 8)
- (COMPLEX-RATIONAL . 7)
- (RATIONAL . 6)
- (NEGATIVE-RATIO . 5)
- (POSITIVE-RATIO . 4)
- (INTEGER . 3)
- (NEG . 2)
- (POS . 1)
- (NAT . 0))
-
-
-(trace$ 
-        fill-dag-and-make-mapping-from-explicit-graph-scc
-        fill-dag-and-make-mapping-from-explicit-graph-scc1
-        update-dag-from-dag-map-and-explicit-graph)
-(MAKE-DAG-AND-DAG-MAP-FROM-EXPLICIT-GRAPH-ALIST
-            '((12)
-             (11)
-             (10)
-             (9)
-             (7)
-             (5)
-             (4)
-             (2)
-             (1)
-             (0)
-             (3)
-             (6)
-             (8)
-             (13))
-            
-            '((10 13)
-             (8 13)
-             (5 6)
-             (3 6)
-             (2 3)
-             (4 6)
-             (7 8)
-             (6 8)
-             (9 13)
-             (12 13)
-             (11 13)
-             (13)
-             (0 3)
-             (1 0))
-            'SUBTYPE-DAG-DT1G
-            'S-EXPLICIT-IMPLIED-INDEX-MAP)
-(MAKE-DAG-AND-DAG-MAP-FROM-EXPLICIT-GRAPH-ALIST
-        '((12)
-         (11)
-         (10)
-         (9)
-         (8)
-         (5)
-         (0 (4) (7 (3 (6))))
-         (2)
-         (1))
-        
-        '((0 7 4)
-         (1)
-         (2)
-         (3 7 6)
-         (4 0)
-         (5)
-         (6 7 3)
-         (7 1 2 0 6 7 3)
-         (8 7 3)
-         (9 7 4)
-         (10 7 6)
-         (11 3 4 5 6)
-         (12 8 9 10))
-        'DEP-DAG-NAME 'IND-QUOTIENT-MAP-NM)
-
-|#
- 
-
-;*** TOP-LEVEL CALLS ******
-
-;Now top-level calls will be:
-;1. Is T1 a subtype of T2?
-;2. Are T1 and T2 disjoint?
-;*3. Add an node (type) to both the graphs
-;*4. Add an edge to subtype-graph
-;*5. Add an edge to disjoint-graph
-
-;starred calls will compute scc using the explicit graphs stored in global
-;and then create a dag temporarily and then 'create' the closure graphs to be stored in globals.
-
-(defun is-disjoint-in-implied-graph (t1 t2 d-nmI d2gI)
-  (declare (xargs :guard (and (matrixp d-nmI d2gI)
-                              (index2p t1 d-nmI d2gI)
-                              (index2p t2 d-nmI d2gI))))
-  (or (aref2 d-nmI d2gI t1 t2)
-      (aref2 d-nmI d2gI t2 t1))) ;simulate undirected graph (Possible BUG)
-
-(defun is-disjoint (t1 t2 wrld)
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbolp t1)
-                              (symbolp t2)
-                              (plist-worldp wrld))))
-  (let* ((e-vert-map (table-alist 'explicit-vertex-index-map wrld)) ;get map
-         (t1-entry (assoc-eq t1 e-vert-map))
-         (t2-entry (assoc-eq t2 e-vert-map)))
-    (if (and e-vert-map t1-entry t2-entry) ;only bother if they exist
-      (let* ((t1-e-index (cdr t1-entry));get its explicit index
-             (e-i-map-nm-alst (table-alist 'explicit-implicit-index-map wrld)) ;get implicit index map
-             (e-i-map-nm (caar e-i-map-nm-alst)) ;get name of 1-dim array storing map
-             (e-i-map-arr (cdar e-i-map-nm-alst)) ;get the 1-dim array
-             (t1-index (aref1 e-i-map-nm e-i-map-arr t1-e-index)) ;get the implicit index
-             (t2-e-index (cdr t2-entry)) ;get second explicit index
-             (t2-index (aref1 e-i-map-nm e-i-map-arr t2-e-index)) ;get its implicit index
-             (nm-d2gI (table-alist 'implied-disjoint-dt2g wrld)) ;get implied disjoint dtg alst
-             (d-nmI (caar nm-d2gI)) ;get name of g
-             (d2gI (cdar nm-d2gI))) ;get implied g
-        (is-disjoint-in-implied-graph t1-index t2-index d-nmI d2gI))
-      nil))) ;safely say that they are not disjoint?? can result in BUG?
-
-;is t1 a subtype of t2 i.e is t1 < t2
-(defun is-subtype (t1 t2 wrld)
-  (declare (xargs :verify-guards nil
-                  :guard (and (plist-worldp wrld)
-                              (symbolp t1)
-                              (symbolp t2))))
-  (let* ((e-vert-map (table-alist 'explicit-vertex-index-map wrld)) ;get map
-        (t1-entry (assoc-eq t1 e-vert-map))
-        (t2-entry (assoc-eq t2 e-vert-map)))
-    (if (and e-vert-map t1-entry t2-entry) ;only bother if they exist
-      (let* ((t1-e-index (cdr t1-entry));get its explicit index
-             (e-i-map-nm-alst (table-alist 'explicit-implicit-index-map wrld)) ;get implicit index map
-             (e-i-map-nm (caar e-i-map-nm-alst));get name of 1-dim array storing map
-             (e-i-map-arr (cdar e-i-map-nm-alst));get the 1-dim array
-             (t1-index (aref1 e-i-map-nm e-i-map-arr t1-e-index));get the implicit index
-             (t2-e-index (cdr t2-entry)) ;get second explicit index
-             (t2-index (aref1 e-i-map-nm e-i-map-arr t2-e-index)) ;get its implicit index
-             (nm-s2gI (table-alist 'implied-subtype-dt2g wrld));get implied subtype dtg alst
-             (s-nmI (caar nm-s2gI));get name of implied subtype g storing TC
-             (s2gI (cdar nm-s2gI)));get implied s2g
-        (is-subtype-in-implied-graph t1-index t2-index s-nmI s2gI))
-      nil)))
-
-
-
-
-
-
-;WORLD CHANGING FUNCTION - EXTERNAL
-;Just add a node to both subtype and disjoint alist explicit graphs with nil adj-vertices
-;coding style adapted from 'using TABLES efficiently' doc entry
-(defmacro add-datatype-node-batch (T1)
-  (declare (xargs :guard (and (symbolp T1))))
-  `(make-event
-    (let* ((e-vert-map (table-alist 'explicit-vertex-index-map (w state))) ;get map
-           (index (len e-vert-map)) ;another way is to use last, but i guess this is faster?
-           (already-exists (assoc-eq ',T1 e-vert-map)))
-      (if already-exists
-        '(value-triple :Redundant-operation)
-        `(progn 
-          (table explicit-vertex-index-map ',',T1 ,index :put)
-          (table subtype-dtg-alst ,index nil :put)
-          (table disjoint-dtg-alst ,index nil :put))))))
-
-
-
-
-;append the entry of datatype graph alist at the t1-index with t2-index-lst
-;note that the ordering in the alist should not matter, because it will ultimately
-;be converted into 1-dim array using compress1, but will it pose any performance issue?
-;impl using tail-recursion
-;walk through dtg-alst, reconstructing it into ans, find t1-index,
-;add (union) the corresponding entry with t2-index-lst into ans, ordering is not maintained. BEWARE!
-;Recognize redundant ops, but is it helping things get faster? maybe!
-;NO LONGER USED
-(defun add-to-dtg-alist (t1-index t2-index-lst dtg-alst ans)
-  (declare (xargs :verify-guards nil
-                  :guard (and (natp t1-index)
-                              (alistp dtg-alst)
-                              (nat-listp t2-index-lst))))
-  (cond ((endp dtg-alst)
-         ans) ;return accumulated updated alist
-        ((eql t1-index (caar dtg-alst))
-         ;add the t1-index entry in ans and then append the remaining dtg-alst, because we know there are no duplicate keys!?
-         (append (acons t1-index 
-                        (if (equal (cdar dtg-alst) t2-index-lst)
-                          (union-equal (cdar dtg-alst) t2-index-lst)
-                          t2-index-lst)
-                        ans) 
-                 (cdr dtg-alst)))
-        (t (add-to-dtg-alist t1-index t2-index-lst (cdr dtg-alst) (cons (car dtg-alst) ans)))))
-
-
-;WORLD CHANGING FUNCTION - EXTERNAL
-;add edge from T1 to T2. T1 -> T2. hence T1 is a subtype of T2.
-(defmacro add-edge-to-subtype-graph-batch (T1 T2)
-  (declare (xargs :guard (and (symbolp T1)
-                              (symbolp T2))))
-  `(make-event
-    (let* ((wrld (w state))
-           (e-vert-map (table-alist 'explicit-vertex-index-map wrld)) ;get map
-           (t1-entry (assoc-eq ',t1 e-vert-map))
-           (t2-entry (assoc-eq ',t2 e-vert-map)))
-      (if (and e-vert-map t1-entry t2-entry) ;only bother if they exist
-        (let* ((t1-index (cdr t1-entry));assoc returns the whole (key . value) entry, we only need the val
-               (t2-index (cdr t2-entry))
-               (s-dtg-alst (table-alist 'subtype-dtg-alst wrld))
-               (t1-adj-is (cdr (assoc-equal t1-index s-dtg-alst))))
-          `(progn
-            (table subtype-dtg-alst ',t1-index ',(union-equal t1-adj-is (list t2-index)) :put)
-            (value-triple :EDGE-ADDED)))
-        '(value-triple :FAILED-TO-ADD-EDGE)))))
-
-;WORLD CHANGING FUNCTION - EXTERNAL
-(defmacro add-edge-to-disjoint-graph-batch (T1 T2)
-  (declare (xargs :guard (and (symbolp T1)
-                              (symbolp T2))))
-  `(make-event
-    (let* ((wrld (w state))
-           (e-vert-map (table-alist 'explicit-vertex-index-map wrld)) ;get map
-           (t1-entry (assoc-eq ',t1 e-vert-map))
-           (t2-entry (assoc-eq ',t2 e-vert-map)))
-      (if (and e-vert-map t1-entry t2-entry) ;only bother if they exist
-        (let* ((t1-index (cdr t1-entry))
-               (t2-index (cdr t2-entry))
-               (d-dtg-alst (table-alist 'disjoint-dtg-alst wrld))
-               (t1-adj-is (cdr (assoc-equal t1-index d-dtg-alst))))
-          `(progn
-            (table disjoint-dtg-alst ',t1-index ',(union-equal t1-adj-is (list t2-index)) :put)
-            (value-triple :EDGE-ADDED)))
-        '(value-triple :FAILED-TO-ADD-EDGE)))))
-
-(defun map-assoc-eq-only-value (keys alst)
-  (declare (xargs :guard (and (symbol-listp keys)
-                              (symbol-alistp alst))))
-  (if (endp keys)
-    nil
-    (cons (cdr (assoc-eq (car keys) alst))
-          (map-assoc-eq-only-value (cdr keys) alst))))
-
-
-;;WORLD CHANGING FUNCTION - EXTERNAL
-(defmacro add-edges-to-disjoint-graph-batch (T1 T2s)
-  (declare (xargs :guard (and (symbolp T1)
-                              (symbol-listp T2s))))
-  `(make-event
-    (let* ((wrld (w state))
-           (e-vert-map (table-alist 'explicit-vertex-index-map wrld)) ;get map
-           (t1-entry (assoc-eq ',t1 e-vert-map)))
-      (if (and e-vert-map t1-entry)
-        (let* ((t1-index (cdr t1-entry))
-               (t2-index-lst (map-assoc-eq-only-value ',T2s e-vert-map))
-               (d-dtg-alst (table-alist 'disjoint-dtg-alst wrld))
-               (t1-adj-is (cdr (assoc-equal t1-index d-dtg-alst))))
-           `(progn
-             (table disjoint-dtg-alst ',t1-index ',(union-equal t1-adj-is t2-index-lst) :put)
-             (value-triple :EDGES-ADDED)))
-        '(value-triple :FAILED-TO-ADD-EDGES))))) ;TODO: Should i show error (in red)??
-
-
-
-(defun maparr-equal1 (nm1 m1 nm2 m2 d-ctr len1)
-   (declare (xargs :guard (and (array1p nm1 m1)
-                               (array1p nm2 m2)
-                               (equal len1 (g-1d-size nm1 m1))
-                               (equal len1 (g-1d-size nm2 m2))
-                               (natp d-ctr)
-                               (<= d-ctr len1))))
-   (if (zp d-ctr)
-     t
-     (let ((i (- len1 d-ctr)))
-       (and (equal (aref1 nm1 m1 i)
-                   (aref1 nm2 m2 i))
-            (maparr-equal1 nm1 m1 nm2 m2 (1- d-ctr) len1)))))   
-
-(defun maparr-equal (nm1 m1 nm2 m2)
-  (declare (xargs :guard (and (array1p nm1 m1)
-                              (array1p nm2 m2))))
-  (if (equal (g-1d-size nm1 m1)
-             (g-1d-size nm2 m2))
-    (let ((len1 (g-1d-size nm1 m1)))
-      (maparr-equal1 nm1 m1 nm2 m2 len1 len1))
-    nil))
-               
-;for help in tracing
-(defun my-equal (x1 x2)
- (equal x1 x2))
-
-;;MAIN WORLD CHANGING FUNCTION - EXTERNAL
-;SYNC the implicit graphs with the explicit graphs by computing SCC and closure algorithms
-(defmacro sync-globals-for-dtg ()
-  `(make-event
-    (acl2::state-global-let*
-     ((acl2::guard-checking-on t));for fast code
-     (let* ((wrld (w state))
-           (s-e-i-map-nm-l 'explicit-implied-index-map-local);global, to be computed
-           (d-e-i-map-nm 'd-explicit-implied-index-map-local); to be computed
-           (s2gI-nm-l 'implied-subtype-dt2g-local);global, to be computed 
-           (d2gI-nm-l 'implied-disjoint-dt2g-local);global, to be computed
-           (s-e-i-map-nm 'explicit-implied-index-map);global, to be computed
-           (s2gI-nm 'implied-subtype-dt2g);global, to be computed 
-           (d2gI-nm 'implied-disjoint-dt2g);global, to be computed
-           (s1g-dag-nm 'subtype-dag-dt1g);to be created
-           (d1g-dag-nm 'disjoint-dag-dt1g);to be computed
-           (s-dtg-alst (table-alist 'subtype-dtg-alst wrld));global, to be used
-           (d-dtg-alst (table-alist 'disjoint-dtg-alst wrld));global, to be used
-           (sccs (scc-top-level s-dtg-alst)));Calculate SCCs of the subtype datatype graph
-      (mv-let 
-       (s1g-dag s-e-i-maparr) ;from scc create a dag and a explcit-to-implicit index map to reflect it
-       (make-dag-and-dag-map-from-explicit-graph-alist sccs s-dtg-alst s1g-dag-nm s-e-i-map-nm-l)
-       (mv-let
-        (d1g-dag d-e-i-maparr);from scc create a dag and a explcit-to-implicit index map to reflect it
-        (make-dag-and-dag-map-from-explicit-graph-alist sccs d-dtg-alst d1g-dag-nm d-e-i-map-nm)
-        (if (maparr-equal s-e-i-map-nm-l s-e-i-maparr d-e-i-map-nm d-e-i-maparr) ;they should be equal
-          (let* ((s-e-i-maparr (compress1 s-e-i-map-nm-l s-e-i-maparr)) ;BUG SOLVED due to this
-                 ;(s-e-i-maparr-old (cdar (table-alist 'explicit-implicit-index-map wrld)))
-                 ;(s-closure-old (cdar (table-alist 'implied-subtype-dt2g wrld)))
-                 ;(d-closure-old (cdar (table-alist 'implied-disjoint-dt2g wrld)))
-                 (s-closure (compress2 s2gI-nm-l (subtype-implied-closure s2gI-nm-l s1g-dag-nm s1g-dag)));helps output browsing
-                 (d-closure (compress2 d2gI-nm-l (disjoint-implied-closure d2gI-nm-l d1g-dag-nm d1g-dag s2gI-nm-l s-closure))))
-            (value 
-             `(progn  ;add the name and 1-dim array (but make sure you have them compressed, so we have fast arrays)
-;,(if (my-equal s-e-i-maparr-old s-e-i-maparr)
-;  '(value-triple :REDUNDANT-explicit-implicit-index-map)
-               (table explicit-implicit-index-map ',s-e-i-map-nm (compress1 ',s-e-i-map-nm ',s-e-i-maparr) :put)
-;)
-;,(if (my-equal s-closure-old s-closure)
-;  '(value-triple :REDUNDANT-implied-subtype-dt2g)
-               (table implied-subtype-dt2g ',s2gI-nm (compress2 ',s2gI-nm ',s-closure) :put) ;add/update the subtype datatype closure
-; )
-;,(if (my-equal d-closure-old d-closure)
-;  '(value-triple :REDUNDANT-implied-disjoint-dt2g)
-               (table implied-disjoint-dt2g ',d2gI-nm (compress2 ',d2gI-nm ',d-closure) :put) ;add/update the disjoint datatype closure
-;)
-               (value-triple :DTG-GLOBALS-ARE-IN-SYNC)))) ;Display success of the operation
-          (value '(value-triple :ERROR-explicit-implicit-index-mapping-not-same-for-disjoint-and-subtype-graphs)))))))))#|ACL2s-ToDo-Line|#
-
-
-#|
-;GLOBAL CHANGE FUNCTION - EXTERNAL
-(defun sync-globals-for-dtg-deprecated (state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-  (acl2::state-global-let*
-   ((guard-checking-on nil)) 
-   (let* ((s-e-i-map-nm 'explicit-implied-index-map);global, to be computed
-          (d-e-i-map-nm 'd-explicit-implied-index-map); to be computed
-          (s2gI-nm 'implied-subtype-dt2g);global, to be computed 
-          (d2gI-nm 'implied-disjoint-dt2g);global, to be computed
-          (s1g-dag-nm 'subtype-dag-dt1g);to be created
-          (d1g-dag-nm 'disjoint-dag-dt1g);to be computed
-          (s-dtg-alst (get-subtype-dtg-alst state));global, to be used
-          (d-dtg-alst (get-disjoint-dtg-alst state));global, to be used
-          (sccs (scc-top-level s-dtg-alst)));Calculate SCCs of the subtype datatype graph
-     (mv-let 
-      (s1g-dag s-e-i-maparr) ;from scc create a dag and a explcit-to-implicit index map to reflect it
-      (make-dag-and-dag-map-from-explicit-graph-alist sccs s-dtg-alst s1g-dag-nm s-e-i-map-nm)
-      (mv-let
-       (d1g-dag d-e-i-maparr);from scc create a dag and a explicit-to-implicit index map to reflect it
-       (make-dag-and-dag-map-from-explicit-graph-alist sccs d-dtg-alst d1g-dag-nm d-e-i-map-nm)
-       (if (maparr-equal s-e-i-map-nm s-e-i-maparr d-e-i-map-nm d-e-i-maparr) ;they should be equal
-         (let* ((s-closure (compress2 s2gI-nm (subtype-implied-closure s2gI-nm s1g-dag-nm s1g-dag)))
-                (d-closure (compress2 d2gI-nm (disjoint-implied-closure d2gI-nm d1g-dag-nm d1g-dag s2gI-nm s-closure))))
-           (er-progn 
-            (set-explicit-implied-index-map s-e-i-maparr);update the e-i-map array
-            (set-implied-subtype-dt2g  s-closure) ;update the subtype datatype closure
-            (set-implied-disjoint-dt2g  d-closure) ;update the disjoint datatype closure
-            (value ':DTG-GLOBALS-ARE-IN-SYNC))) ;Display success of the operation
-         (er soft 'sync-globals-for-dtg 
-             "The explicit-implicit index mapping should be same for disjoint and subtype graphs. BUG in code!")))))))
-  
-|#      
-         
-
-      
diff -Nru acl2-6.2/books/countereg-gen/library-support.lisp acl2-6.3/books/countereg-gen/library-support.lisp
--- acl2-6.2/books/countereg-gen/library-support.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/library-support.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,95 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(begin-book);$ACL2s-Preamble$|#
-
-(in-package "ACL2")
-
-;record implementation
-(include-book "defexec/other-apps/records/records" :dir :system :load-compiled-file :comp)
-(include-book "finite-set-theory/osets/sets" :dir :system :load-compiled-file :comp)
-
-
-;GETTING RECORDS TO behave nicely here are some
-;;RECORDS THMS proven
-
-#|
-(thm (implies (and (not (ifmp v))
-                   (consp v))
-              (o< (acl2-count (mget x v))
-                  (acl2-count v)))
-     :hints (("goal" :induct (mget-wf x v))))
-|#
-(defthm records-lemma-acl2-count
-  (implies (and (ifmp v)
-                (acl2::well-formed-map v))
-           (< (acl2-count (acl2::mget-wf x v))
-              (acl2-count v)))
-  :hints (("goal" :in-theory (enable acl2::mset acl2::mget acl2::mset-wf acl2::mget-wf acl2::acl2->map)))
-  :rule-classes (:linear :rewrite))
-
-(defthm records-acl2-count
-  (implies (and (acl2::good-map v)
-                (consp v))
-           (< (acl2-count (acl2::mget x v))
-               (acl2-count v)))
-  :hints (("goal" :induct (acl2::mget-wf x v)
-                  :in-theory (enable acl2::mset acl2::mget acl2::mset-wf acl2::mget-wf acl2::acl2->map)))
-  :rule-classes (:linear :rewrite))
-
-(defthm records-acl2-count-linear-arith-<=
-  (<= (ACL2-COUNT (acl2::MGET k V))
-      (ACL2-COUNT V))
-  :hints (("goal" :in-theory (enable acl2::mset acl2::mget acl2::mset-wf acl2::mget-wf acl2::acl2->map)))
-  :rule-classes (:linear :rewrite))
-
-(defthm records-acl2-count-linear-arith-<
-  (implies (and (not (equal k (acl2::ill-formed-key)))
-                (acl2::MGET k V))
-           (< (ACL2-COUNT (acl2::MGET k V))
-              (ACL2-COUNT V)))
-  :hints (("goal" :in-theory (enable acl2::mset acl2::mget acl2::mset-wf acl2::mget-wf acl2::acl2->map)))
-  :rule-classes (:linear :rewrite))
-
-
- (defthm records-acl2-count2
-  (implies (and (consp v)
-                (not (equal x (ill-formed-key))))
-           (< (acl2-count (mget x v))
-              (acl2-count v)))
-  :hints (("goal" :induct (mget-wf x v)
-                  :in-theory (enable mset mget mset-wf mget-wf acl2->map)))
-  :rule-classes ((:linear) (:rewrite)))
-
- (defthm field-not-empty-implies-record-not-empty1
-   (implies (and (mget a x)
-                 (not (equal a (ill-formed-key))))
-            (consp x))
-   :hints (("goal" :in-theory (enable mset mget mset-wf mget-wf acl2->map)))
-   :rule-classes :forward-chaining)
- 
-(defthm field-not-empty-implies-record-not-empty2
-  (implies (and (mget a x)
-                ;(not (ifmp x))
-                (good-map x))
-           (consp x))
-  :hints (("goal" :in-theory (enable mset mget mset-wf mget-wf acl2->map)))
-  :rule-classes :forward-chaining) 
-
-;The following theorem was needed in alloy-comparision
-(defthm updating-empty-entry-with-nil-lemma
-  (implies (equal (mget a r) v)
-           (equal (mset a v r) r)))
-
-(defthm updating-empty-entry-with-nil
-  (implies (not (mget a r))
-           (equal (mset a nil r) r)))
-
-;This might be needed for termination arguments for SETS
-(defthm non-nil-=>-not-empty
-  (implies (and (sets::setp v)
-                (not (equal v nil)))
-           (not (sets::empty v)))
-  :hints (("Goal" :in-theory (enable sets::empty)))
-  :rule-classes :forward-chaining)
-
diff -Nru acl2-6.2/books/countereg-gen/main.lisp acl2-6.3/books/countereg-gen/main.lisp
--- acl2-6.2/books/countereg-gen/main.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/main.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,3996 +0,0 @@
-#|$ACL2s-Preamble$;
-;;Author - Harsh Raju Chamarthi (harshrc)
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(begin-book t :ttags :all);$ACL2s-Preamble$|#
-
-
-(in-package "DEFDATA")
-
-;Useful Macros for concise/convenient code.
-(include-book "tools/bstar" :dir :system)
-(include-book "basis")
-(include-book "with-timeout" :ttags :all)
-(include-book "type")
-;(include-book "basis")
-;(include-book "testing-stobj")
-;; (include-book "base")
-(include-book "acl2s-parameter")
-(include-book "simple-graph-array")
-(include-book "random-state")
-(include-book "tools/easy-simplify" :dir :system)
-
-
-;For now TODO
-
-;;;======================================================================
-;;;============ Build enumerator expression code =================e=======
-;;;======================================================================
-
-;from the members of an union expression, get the constituents
-;that are non-recursive.
-(defthm flatten-is-true-list1 
-  (implies (true-listp lst)
-           (true-listp (defdata::flatten b lst)))
-  :hints (("Goal" :in-theory (enable defdata::flatten))))
-     
-
-
-(defrec enum-info% (size category expr) NIL)
-
-;; chose 29 bits, because ACL2 uses signed 29 bits in its code!
-(defun unsigned-29bits-p (x)
-  (declare (xargs :guard T))
-  (acl2::unsigned-byte-p 29 x))
-
-(defun fixnump (x)
-  (declare (xargs :guard T))
-  (unsigned-29bits-p x))
-
-;;; Style of accessing/changing defrec objects. The name of the object is
-;;; always same as the name of the defrec, just like in stobjs. THis way we
-;;; can drop in stobjs in their place!
-(defmacro access (r a)
-  `(acl2::access ,r ,r ,(intern-in-package-of-symbol (symbol-name a) :key)))
-(defmacro change (r a val )
-  `(acl2::change ,r ,r ,(intern-in-package-of-symbol (symbol-name a) :key) ,val))
-
-(defun enum-info%-p (v)
-  (declare (xargs :guard T))
-  (case-match v
-    (('enum-info% size category expr) 
-
-     (and (fixnump size)
-          (member-eq category
-                     '(:singleton :function :defconst))
-          (pseudo-termp expr)))))
-
-;usage:
-
-;OLD COMMENT as of 10 March 2012;
-;MODIFIED: I had to change the order because it was picking
-;up *empty-values* as a constant value and hence
-;a singleton which is not working right. 
-;Come back to this point later.
-;;; harshrc 03/10/12 - updated it to defrec and def
-
-(def get-enum-info% (type ctx wrld)
-  (decl :sig ((possible-defdata-type-p symbolp plist-worldp) 
-              -> enum-info%-p)
-;TODO: union types
-        :doc "to fill")
-; returns a well-formed enum-info defrec object
-; r is the free variable in the enum-expression which
-; is the place-holder for the random-seed or BE arg 
-  (if (possible-constant-valuep type)
-      (acl2::make enum-info% :size 1 :category :singleton :expr type) 
-;ALSO HANDLE SINGLETON TYPES DIRECTLY
-    
-    (let ((entry (assoc-eq type 
-                           (table-alist 'defdata::types-info-table wrld))))
-     
-    (if entry ;if we find enum-info from type-info-table then use it
-        (b* ((types-info% (cdr entry))
-              (TI.test-enumerator (access types-info% test-enumerator))
-              (TI.enumerator      (access types-info% enumerator))
-              (TI.size            (access types-info% size))
-             ((unless (or (eq 't TI.size)
-                         (posp TI.size)))
-              (er hard ctx 
-                  "size in type-info ~x0 should be posp.~%" (cdr entry))))
-             ;first check for test-enum
-         (if TI.test-enumerator
-             (cond 
-              ((allows-arity TI.test-enumerator 1 wrld)
-;TODO. I am not checking if test enumerator is to be used or not
-               (acl2::make enum-info% :size 't
-                           :category :function
-                           :expr (list TI.test-enumerator 'r)))
-;this is possible because a TI.test-enumerator can be a singleton
-              ((possible-constant-valuep TI.test-enumerator) 
-               (acl2::make enum-info% :size 1 
-                           :category :singleton :expr TI.test-enumerator)) ;singleton
-              (t (let ((stored-defconst 
-                        (acl2-getprop TI.test-enumerator 'const wrld)))
-                  
-                  (if stored-defconst ;some finite set of values
-                      (let* ((values (second stored-defconst))
-                             (len-v (len values)))
-                        (acl2::make enum-info%  
-                                    :size len-v 
-                                    :category (if (= len-v 1) 
-                                                  :singleton
-                                                :defconst)
-                                    :expr (if (= len-v 1)  
-                                              `',(car values)
-                                            `(nth r ,TI.test-enumerator))))
-                    (er hard ctx 
-                        "~x0 is neither one of constant, an enumerator function or a values defconst.~%" TI.test-enumerator)))))
-
-;common scenario: inf enumerator
-           (if (eq 't TI.size);inf or custom registered (assume)
-               (acl2::make enum-info% :size 't :category :function
-                           :expr (list TI.enumerator 'r));inf or some enum fn
-             (let ((stored-defconst 
-                    (acl2-getprop TI.enumerator 'const wrld)))
-              
-              (if stored-defconst ;some finite set of values
-                  (b* ((values (second stored-defconst))
-                       (len-v (len values))
-                       ((unless (posp len-v))
-                        (er hard ctx "stored-defconst ~x0 has 0 values~%" stored-defconst)))
-                   (acl2::make enum-info%
-                               :size len-v 
-                               :category (if (= len-v 1) 
-                                             :singleton
-                                           :defconst)
-                               :expr (if (= len-v 1)  
-                                         `',(car values)
-                                       `(nth r ,TI.enumerator))))
-;uncommon scenario, finite enumerator function        
-                (if (allows-arity TI.enumerator 1 wrld) 
-                    (acl2::make enum-info% :size TI.size 
-                                :category :function
-                                :expr (list TI.enumerator 'r));some enum fn
-                  
-                  (er hard ctx 
-                      "~x0 is neither one of constant, an enumerator function or a values defconst.~%" TI.enumerator)))))))
-      ;;;o.w we just call peter's fn
-      (let* ((vsym (modify-symbol "*" type "-VALUES*"))
-             (values (second (acl2-getprop vsym 'const wrld))))
-                    
-        (if values
-            (let ((len-v (len values)))
-               (acl2::make enum-info%
-                        :size len-v 
-                        :category (if (= len-v 1) 
-                                      :singleton
-                                    :defconst)
-                        :expr (if (= len-v 1)  
-                                  `',(car values) 
-                                `(nth r ,vsym))))
-          (let ((esym (modify-symbol "NTH-" type "")))
-            ;;check if enum is defined in wrld
-            (cond ((allows-arity esym 1 wrld) 
-                   (acl2::make enum-info% 
-                             :size t 
-                             :category :function
-                             :expr `(,esym r)))
-                  (t 
-                   (er hard ctx 
-                       "~x0 doesnt appear to be a type.~%" type))
-                       ))))))))
-              
-;May 8 2011
-;testing history data structure
-;; Maps variables to vtest-history 
-;; vtest-history: 
-;; (record (n . current test-run-number)
-;;         (rec-size . last recursion size chosen for this variable)
-;;         (strategy . :random :bounded)
-;;         (enum-expr . enumerator expression with holes)
-;;         (enum-arg-alist . special alist to fill in the above holes)
-;;         (i . determines X_i to be incremented in BE testing))
-;; enum-arg-alist:
-;; ((defdata::X  . (record (size . t | fin-size) (val . last val of X) ) ...)
-
-
-;identify (equal x y)
-(defun equiv-hyp? (hyp)
-  (and (= 3 (len hyp))
-       (member-eq (car hyp) '(equal = eq eql));TODO
-       (is-a-variablep (second hyp))
-       (is-a-variablep (third hyp))))
-
-;identify (equal 3 x) or (equal x 42)
-(defun constant-hyp? (hyp)
-  (and (= 3 (len hyp))
-       (member-eq (car hyp) '(equal = eq eql))
-       (or (and (is-a-variablep (second hyp))
-                (possible-constant-value-expressionp (third hyp)))
-           (and (is-a-variablep (third hyp))
-                (possible-constant-value-expressionp (second hyp))))))
-
-;chyp=(equal x <const>)
-;gives (mv x <const>)
-(defun destruct-simple-hyp (chyp)
-  (if (is-a-variablep (second chyp))
-      (mv (second chyp) (third chyp))
-    (mv (third chyp) (second chyp))))
-
-;identify (equal x expr) or (equal expr y) where expr is not a const expr
-;disjoint with constant-hyp? and equiv-hyp?
-;added an extra argument storing scc information about variable dependency.
-;avoid hyps which may lead to circular dependency
-
-; MODIFIED May 7 2011, if expr is (g a v) then return false, because we want it
-; to furthur get dest-elimed, since if we there is still a mget call around it
-; has to be a list/map mget call and we want the other variable to get mset
-; into the list/map variable rather than the x getting value from mget of
-; list/map variable .
-(defun simple-var-hyp? (hyp var-quotient-alst list-dest-fns)
-  (and (not (constant-hyp? hyp));not (= x c)
-       (not (equiv-hyp? hyp));not (= x y)
-       (= 3 (len hyp))
-       (mem-eq (car hyp) '(equal = eq eql))
-       (or (is-a-variablep (second hyp))
-           (is-a-variablep (third hyp)))
-       (mv-let (var expr)
-               (destruct-simple-hyp hyp)
-               (and 
-                ;;No cycles
-                (let* ((vquotient (get-val var var-quotient-alst))
-;get-free-vars1 only non-buggy for terms
-                       (dvars (get-free-vars1 expr nil))
-                       (dquotients (get-val-lst dvars var-quotient-alst)))
-                  (not (mem1 vquotient dquotients)))
-                ;;No top-level mget in expr
-                (not (member-eq (car expr) list-dest-fns))))))
-                    
-
-
-
-(defun directed-2-rel? (hyp)
-  ;(declare (xargs :guard (pseudo-termp hyp)))
-;is hyp a directed (computationally) binary relation term
-;hyp = (R x (f y)), where f should represent
-;some computation other than accessors
-;Assumption, hyp cannot be a constant hyp, since
-;this function is always called after constant-hyp?
-;in function build-vdependency-graph
-;TODO maintain a global list of common accessor functions
-  (and (= (len hyp) 3)
-       (let* ((t2 (second hyp))
-              (t3 (third hyp)))
-         (or (and (is-a-variablep t2) 
-                  (consp t3)
-                  (not (member-eq (car t3) 
-                           '(acl2::mget acl2::g g
-                                        acl2::nth acl2::car SETS::head
-                                        acl2::cdr SETS::head))))
-             (and (is-a-variablep t3) 
-                  (consp t3);copy paste bug
-                  (not (member-eq (car t3) 
-                           '(acl2::mget acl2::g g
-                                        acl2::nth acl2::car SETS::head
-                                        acl2::cdr SETS::head))))))))
-              
-(defun undirected-2-rel? (hyp)
- ; (declare (xargs :guard t))
-;is hyp a undirected (computationally) binary relation term
-;hyp = (~ x y), where ~ should be one of 
-;(= eq equal eql subset-equal < <= > >=)
-;TODO maintain a global list of such functions
-
-  (and (= (len hyp) 3)
-       (let* ((t2 (second hyp))
-              (t3 (third hyp)))
-         (and (is-a-variablep t2) 
-              (is-a-variablep t3)
-              (member-eq (first hyp) ;Relation
-                  '(acl2::= acl2::equal acl2::eq acl2::eql
-                            acl2::< acl2::<= 
-                            acl2::> acl2::>=))))))
-
-;hyp is of form (R term1 term2 ... termn)
-;alst is basically the adjacency list rep of a graph
-;Assumption term-lst is a term-listp otherwise get-free-vars1
-;will not operate correctly
-(defun put-interdependency-edges-in-alst (term-lst all-terms alst)
-  #|(declare (xargs :guard (and (true-listp term-lst)
-                              (true-listp all-terms)
-                              (alistp alst))))|#
-  (if (endp term-lst)
-    alst
-    (let* ((term (car term-lst))
-           (vars (get-free-vars1 term nil))
-           (rest-terms (remove-equal term all-terms))
-           (rest-vars (get-free-vars1-lst rest-terms nil))
-           )
-      (put-interdependency-edges-in-alst 
-       (cdr term-lst) all-terms
-       (union-entries-in-adj-list vars ;sloppy, dont want self-edges
-                                  (set-difference-eq rest-vars vars)
-                                  alst)))))
-         
-;make a dependency graph of variables in a formula.
-;TODO: equal can be any equivalence relation
-;An edge from A to B means, A depends on B
-;Note: (equal x <constant-expr>) forces x to be a leaf!!
-
-;alst = ((var . (listof var)) ...) 
-;alst-C= ((var . nil)) ;constants are forced to be leaves
-;incoming = (map var (map symbol nat)) 
-;e.g  (x . ((= . 1) (R . 2) (< . 1)) YET to be IMPLEMENTED
-
-;PreCondition: hyp-lst is a term-list (IMPORTANT)
-(defun build-vdependency-graph (hyp-lst alst alst-C incoming)
-  (declare (ignorable incoming))
-  (declare (xargs :verify-guards nil
-                  :guard (and (pseudo-term-listp hyp-lst)
-                              (symbol-alistp alst);       TODO
-                              (symbol-alistp alst-C);     lost
-                              (symbol-alistp incoming))));type information
- "return the dependency graph in alst, when all hypotheses have been 
-processed, the annotation of edges is also returned"
-  (if (endp hyp-lst)
-    (append alst alst-C) ;ques: shouldnt the order be the other way round?
-    (let ((hyp (car hyp-lst)))
-      (cond 
-       ((constant-hyp? hyp) ;(equal x (cons 1 2))
-        (b* (((mv var &) (destruct-simple-hyp hyp)))
-          (build-vdependency-graph (cdr hyp-lst)
-                                   (remove-entry var alst)
-;annotate the fact that var is assigned to a constant
-                                   (put-assoc-equal var nil alst-C)
-                                   incoming)))
-       
-       ((undirected-2-rel? hyp);(~ x  y)
-;dont draw an edge
-        (build-vdependency-graph (cdr hyp-lst) alst alst-C incoming))
-       ((directed-2-rel? hyp);(= x (f y))
-        (b* (((mv var term) (destruct-simple-hyp hyp))
-             (fvars (remove-equal ;sloppy code
-                     var (get-free-vars1 term nil))));buggy for non-terms
-          (build-vdependency-graph 
-           (cdr hyp-lst)
-;Q:shudnt we overwrite instead?
-;A:No, consider both (= x (f y)) (= x (g w)) in hyps
-;But does it matter either way? TODO
-           (union-entry-in-adj-list var fvars alst) 
-           alst-C
-           incoming)))
-       (t
-;(R term1 term2 ...termN) ==> add edges between x and y where x \in termI
-;and y \in termJ and I=!J and R is a N-ary relation
-        (let* 
-            ((vars (get-free-vars1 hyp nil));only non-buggy for terms
-             (num-vars (len vars)))
-          (if (<= num-vars 1);unchanged
-              (build-vdependency-graph (cdr hyp-lst) alst alst-C incoming)
-            (b* ((alst1 (put-interdependency-edges-in-alst 
-                         (cdr hyp) ;recurse (term1 ... termn)
-                         (cdr hyp) ;all-terms
-                         alst))) 
-              (build-vdependency-graph (cdr hyp-lst) 
-                                       alst1 alst-C incoming)))))))))
-
-
-(defun build-variable-dependency-graph (hyps vars)
-  (build-vdependency-graph hyps (make-empty-adj-list vars) nil nil))
-
-#|
-    (c nil ;dep-info record
-       :hyps hyps-new 
-       :concl concl-new 
-       :hyp-vars hyp-vars
-       :concl-vars concl-vars
-       :vars vars
-       :var-type-expr-alist new-var-te-alist
-       :var-dependency-adj-list dgraph
-       :var->ccnum var-quotient-alst
-       :connected-vertices-ordered-list connected-vs-lst)
-       ))
-|#
-            
-
-
-
-
-;;;; Main Idea
-;;;; Given any formula, we want to test it using test? or
-;;;; amidst a prove call.  By test it, I mean we search for an
-;;;; instantiation (or assignment) of the free variables in the
-;;;; formula *and* evaluate the ground formula resulting from
-;;;; substituting the assignment.  The way 'S2' (name of our
-;;;; implementation) works is as follows. We set up the type
-;;;; infrastructure, i.e we store type meta data in ACL2 tables for
-;;;; all primitive/basic types in ground ACL2 and provide the user
-;;;; with macros (defdata) to introduce new types. These macros
-;;;; automate maintenance of type meta data. The metadata henceforth
-;;;; called defdata tables, store the enumerators for each type
-;;;; predicate, and also capture the relationship (subtype and
-;;;; disjoint) among the different types. The latter are useful in
-;;;; finding the minimal (possible) type information for a variable
-;;;; constrained by multiple predicates/relations. When we say 'type',
-;;;; we refer to a name that characterizes a set in the ACL2
-;;;; Universe. This 'type' is characterized redundantly both with a
-;;;; monadic predicate and an monadic enumerator. When the user asks
-;;;; to test?/thm a conjecture, S2 queries the defdata tables to
-;;;; obtain the name of the corresponding enumerator for each variable
-;;;; constrained by a monadic predicate in the conjecture.  In
-;;;; practice what S2 derives is not an enumerator function but an
-;;;; enumerat(or/ing) expression with holes. When these holes are filled
-;;;; with random natural numbers, it will evaluate to a random value
-;;;; satisfying the type-like constraints of the concerned
-;;;; variable in the conjecture under test. Also in practice there is
-;;;; dependency among variables and naively instantiating all of them
-;;;; independently will lead to poor test data, since the full
-;;;; assignment might turn out to be vacuous (inconsistent hypotheses)
-;;;; many a time. (And this indeed is the main hurdle to be crossed).
-;;;; 
-;;;; Clearly to obtain the best results, we want to be able to do the
-;;;; following things.
-;;;; 1. Derive an enumerator expression for each variable that
-;;;; evaluates to a minimal set of values, the variable is allowed to
-;;;; take.
-;;;; 2. Derive an enumerator expression for each
-;;;; variable that takes into account its dependency on other
-;;;; variables. i.e If (= x (f y)) and (posp y), then enumerator
-;;;; expression call (enumcall) for y is (nth-pos n) and for x it is
-;;;; simply (f y). Thus x never evaluates to a value that would make
-;;;; its constraint inconsistent. Things are more complicated for
-;;;; mutually-dependent variables and for complex dependency
-;;;; relations. 
-;;;; 
-;;;; Feb 3 2012
-;;;; This is basically a constraint satisfaction problem and there exist
-;;;; naive backtracking algorithms for finite-domain variables. There also
-;;;; exists the notion of arc-consistency, which basically tells you if it
-;;;; is possible to extend an partial assignment without backtracking. So
-;;;; the "ideal scenario" is to construct the assignment without backtracking.
-
-;;;; Right now, in one search strategy, which is named "simple", we
-;;;; simply compute enumerator/type expressions for all free
-;;;; variables, taking into account "equality" dependencies and use
-;;;; this as a template code to plug in random natural numbers or
-;;;; bounded consecutive natural number tuples to obtain either random
-;;;; value assignment or a consecutive value assignment in the bounded
-;;;; value space of free variables. 
-
-;;;; Alternatively, in the DPLL-style search strategy, which we named
-;;;; as "incremental", we incrementally build the assignment, taking
-;;;; into account dependency, by selecting the least "dependent"
-;;;; variable in the dependency graph built from the conjecture. After
-;;;; every variable is assigned a new value (satisfying its local type
-;;;; constraints), this information is propagated using the theorem
-;;;; prover itself. If the resulting hypotheses of the partially
-;;;; instantiated conjecture are contradictory/inconsistent, then we
-;;;; backtrack to the last "decision" Assign. We stop when we either
-;;;; backtrack too many times, or we have obtained the full value
-;;;; assignment (called sigma hereafter).
-
-;;;; The following illustrates the top-level driver pseudocode
-
-;;;; Top-level test driver loop for Conjecture/Subgoal G
-;;;; ALl alists u see below have as keys the free variables of G.
-
-;;;; Initialization code:
-;;;; defattach conclusion-val/hypotheses-val for G
-;;;; T_naive := get naive type alist from defdata tables for G
-;;;; T_ACL2  := get ACL2 type alist for freevars(G)
-;;;; T_final := get type expression alist for freevars(G) using
-;;;;            T_naive, T_ACL2 and the dependency graph of G.
-;;;; E := get enumerator expression alist for G using T_final
-;;;; make defun next-sigma using E and random seed, be arg tuple
-;;;; defattach next-sigma to a fun computing assignments
-;;;;   
-;;;;
-;;;; Driver loop code:
-;;;; repeat *num-trial* times or till we meet stopping condition
-;;;; \sigma := (next-sigma ...)
-;;;;   if (hypotheses-val \sigma)
-;;;;      if (conclusion-val \sigma)
-;;;;         record witness 
-;;;;       record counterexample
-;;;;    record vacuous
-;;;; end
-;;;;
-;;;; conclusion-val and hypotheses-val are stub functions which
-;;;; are attached during the main search function.
-;;;; They take a substitution and apply it to G, returning a boolean.
-
-;;;;harshrc
-;;;;10th Jan 2012 (Tuesday)
-
-;;; Purpose: Given a value substitution, the following functions will
-;;; apply it to the hypotheses and conclusion of the conjecture under
-;;; test and compute the value of the resulting ground formula.
-;;; Sig: sigma -> boolean
-;;; where sigma is the let bindings or simply the binding of free variables to
-;;; values satisfying the "types" of the respective variables.
-;(defstub hypotheses-val (*) => *)
-(encapsulate
-  ((hypotheses-val
-    (A) t
-    :guard (symbol-doublet-listp A)))
- 
-  (local (defun hypotheses-val (A) (list A))))
-;(defstub conclusion-val (*) => *)
-(encapsulate
-  ((conclusion-val
-    (A) t
-    :guard (symbol-doublet-listp A)))
- 
-  (local (defun conclusion-val (A) (list A))))
-
-;;; Purpose: For the current ... , generate the next value-alist
-;;; (sigma) for the formula under test.  next-sigma : (sampling-method
-;;; seed tuple) ->  seed' * tuple' * A' Given the sampling method,
-;;; current random seed, the current nth-tuple (of nats), it computes
-;;; the full assignment (sigma) to be used in the upcoming test run
-;;; and also returns the updated seed and updated nth-tuple
-(defstub next-sigma (* * *) => (mv * * *))
-
-
-(def single-hypothesis (hyp-list)
-  (decl :sig ((pseudo-term-list) -> (oneof 'T pseudo-term))
-        :doc
-"?: Transform a list of hypotheses into an equivalent hypothesis
- eg: (single-hypothesis '((posp x) (stringp s)) ==> (and (posp x) (stringp s))
-     (single-hypothesis '()) ==> T")
-  (if (endp hyp-list)
-    't
-    `(and ,@hyp-list)))
-
-
-
-
-
-(set-verify-guards-eagerness 2)
-
-(defun local-sampling-method-builtin (sampling-method i N)
-  (declare (xargs :guard (and (natp N)
-                              (natp i)
-                              (member-eq sampling-method '(:mixed :random :be))
-                              (<= i N))))
-  (b* (((unless (eq :mixed sampling-method))
-        sampling-method))
-
-    (cond ((zp N) :random)
-          ((< (/ i N) (/ 50 100))
-; first half do bounded-exhaustive testing, then switch to random testing
-           :be)
-          (t :random))))
-
-(encapsulate
-  ((local-sampling-method 
-    (s i N) t
-    :guard (and (member-eq s '(:mixed :random :be));(keywordp s)
-                (natp i) (natp N) (<= i N))))
-  
-  (local (defun local-sampling-method (s i N) (list s i N))))
-
-(defattach (local-sampling-method local-sampling-method-builtin))
-
-
-(defrec gcs% 
-; global-coverage-stats 
-; Only accumulates sound and top-reproducible cts/wts
-; i.e is not modified after a cross-fertilize ledge of the waterfall
-  ((total-runs dups . vacs)
-   (cts . wts) 
-   (cts-to-reach . wts-to-reach)
-   (start-time . end-time) 
-   all-bets-off? 
-   . (top-term top-vt-alist))
-  NIL) 
-
-
-(def initial-gcs% (nc nw start top-term top-vt-alist)
-  (decl :sig ((fixnump fixnump rationalp allp) -> gcs%-p)
-        :doc "reset/initialized global coverage stats record")
-  (acl2::make gcs% :cts 0 :wts 0 :cts-to-reach nc :wts-to-reach nw
-        :total-runs 0 :vacs 0 :dups 0 
-        :start-time start :end-time start
-        :all-bets-off? nil
-        :top-term top-term
-        :top-vt-alist top-vt-alist))
-
-(defun gcs%-p (v)
-  (declare (xargs :guard T))
-  (case-match v
-    (
-     ('gcs% (total-runs dups . vacs)
-            (cts . wts) 
-            (cts-to-reach . wts-to-reach)
-            (start-time . end-time) all-bets-off? . (& vt-al))
-     (and (unsigned-29bits-p cts)
-          (unsigned-29bits-p wts)
-          (unsigned-29bits-p cts-to-reach)
-          (unsigned-29bits-p wts-to-reach)
-          (rationalp start-time)
-          (rationalp end-time)
-          (unsigned-29bits-p total-runs)
-          (unsigned-29bits-p dups)
-          (unsigned-29bits-p vacs)
-          (booleanp all-bets-off?)
-          (symbol-alistp vt-al)
-          ))))
-
-(defmacro gcs-1+ (fld-nm)
-  `(change gcs% ,fld-nm
-             (acl2::|1+F| (access gcs% ,fld-nm))))
-
-
-(encapsulate
-  ((stopping-condition? 
-    (gcs%) t
-    :guard (gcs%-p gcs%)))
-  (local (defun stopping-condition? (gcs%) (list gcs%))))
-
-
-(defun stopping-condition?-builtin (gcs%)
-  (declare (xargs :guard (gcs%-p gcs%)))
-  (and (>= (access gcs% cts) (access gcs% cts-to-reach))
-       (>= (access gcs% wts) (access gcs% wts-to-reach))))
-
-(defattach stopping-condition? stopping-condition?-builtin)
-
-
-(set-verify-guards-eagerness 1)
-
-(def run-single-test. (sampling-method N i r. BE.)
-  (decl 
-        :sig ((keyword fixnum fixnum fixnum symbol-fixnum-alist) 
-              -> 
-              (mv keyword symbol-doublet-listp fixnum symbol-fixnum-alist))
-        :doc 
-"?:
-* Synopsis 
-Run single trial of search for cts/wts for the formula under test.
-
-* Input parameters 
-'N' stands for num-trials.  sampling-method is
-itself.  i is the current local-trial number.  'r.' is the current
-pseudo-random seed.  'BE.' is alist that holds previous
-bounded-exhaustive nat arg seeds used to compute sigma.
-
-* Return sig: (mv res A r. BE.)
-A is computed sigma (value binding) used to test this run
-res is :vacuous if the hypotheses were inconsistent under A
-res is :witness if both conclusion and hyps eval to T under A
-else is :counterexample
-r. is updated pseudo-random seed
-BE. is the updated bounded-exhaustive arg/seed alist.
-
-eg:n/a")
-  
-  (b* ((sm (local-sampling-method sampling-method i N))
-       ((mv A r. BE.) (next-sigma sm r. BE.))
-       (|not vacuous ?|  (hypotheses-val A)))
-;  in
-   (if |not vacuous ?|
-       ;; bugfix: why even try to evaluate conclusion when
-       ;; the hypotheses arnt satisfied, the whole form's value
-       ;; is simply true - May 2nd '12
-       (let ((res (if (conclusion-val A) :witness :counterexample)))
-        (mv res A r. BE.))
-     (mv :vacuous A r. BE.))))
-
-(defrec run-hist% 
-  ((|#cts| . cts) (|#wts| . wts) (|#vacs| . vacs) . |#dups|)
-; each test run statistics/results are accumulated in run-hist%
-  NIL)
-
-(defun run-hist%-p (v)
-  (declare (xargs :guard T))
-  (case-match v ;its a good thing I dont use case-match run-hist%
-    ;anywhere else. The internal layout of run-hist% is thus hidden.
-    (('run-hist% (|#cts| . cts) (|#wts| . wts) (|#vacs| . vacs) . |#dups|)
-              
-     (and (symbol-doublet-list-listp cts)
-          (symbol-doublet-list-listp wts)
-          (symbol-doublet-list-listp vacs)
-          (unsigned-29bits-p |#wts|)
-          (unsigned-29bits-p |#cts|)
-          (unsigned-29bits-p |#vacs|)
-          (unsigned-29bits-p |#dups|)))))
-          
-
-(defmacro run-hist-1+ (fld)
-"increments the number-valued fields of run-hist%"
-  (let* ((fld-dc (string-downcase (symbol-name fld)))
-         (fld-nm (intern-in-package-of-symbol 
-                  (concatenate-names (list "#" fld-dc)) 'run-hist%)))
-    `(change run-hist% ,fld-nm
-             (acl2::|1+F| (access run-hist% ,fld-nm)))))
-
-(def record-testrun. (test-assignment-was A run-hist% gcs%)
-  (decl :sig ((keyword symbol-doublet-listp run-hist%-p gcs%-p)
-              ->
-              (mv run-hist%-p gcs%-p))
-        :doc 
-"?: records the diagnostics/results of a single test trial run ")
-
-  (b* ((num-wts (access gcs% wts-to-reach))
-       (num-cts (access gcs% cts-to-reach))
-       (gcs% (gcs-1+ total-runs)))
-;   in
-    (case test-assignment-was
-      (:counterexample   (b* ((A-cts (access run-hist% cts))
-                             
-                             ((when (member-equal A A-cts))
-                              (mv (run-hist-1+ dups) (gcs-1+ dups)));ignore A
-                             
-                             (gcs% (gcs-1+ cts))
-                             (m    (access run-hist% |#cts|))
-                             (run-hist% ;TODO:per subgoal num-cts stored??
-                              (if (< m num-cts)
-                                  (change run-hist% cts (cons A A-cts) )
-                                run-hist%));dont store extra 
-                             (run-hist%   (run-hist-1+ cts)))
-;                              in
-                         (mv run-hist% gcs%)))
-
-
-      (:witness          (b* ((A-wts (access run-hist% wts))
-                             ((when (member-equal A A-wts))
-                              (mv (run-hist-1+ dups) (gcs-1+ dups)))
-                             (gcs% (gcs-1+ wts))
-                             (m    (access run-hist% |#wts|))
-                             (run-hist%   
-                              (if (< m num-wts)
-                                  (change run-hist% wts (cons A A-wts))
-                                run-hist%));dont store extra
-                             (run-hist%   (run-hist-1+ wts)))
-;                         in       
-                          (mv run-hist% gcs%)))
-
-                                             
-      (:vacuous          (b* ((A-vacs (access run-hist% vacs))
-                             ((when (member-equal A A-vacs))
-                              (mv ( run-hist-1+ dups) (gcs-1+ dups)))
-                             (gcs% (gcs-1+ vacs))
-                             (m    (access run-hist% |#vacs|))
-                             (run-hist%   
-                              (if (< m (acl2::+f num-wts num-cts))
-                                  (change run-hist% vacs (cons A A-vacs))
-                                run-hist%));dont store a lot of vacuouses
-                             (run-hist%   (run-hist-1+ vacs)))
-;                         in
-                          (mv run-hist% gcs%)))
-      (otherwise         (prog2$ (er hard 'test? "not possible") 
-                                 (mv run-hist% gcs%))))))
-
-
-(def run-n-tests. (n num-trials sm vl r. BE. run-hist% gcs%)
-  (decl 
-        :sig ((fixnum fixnum keyword fixnum fixnum symbol-fixnum-alist 
-                      run-hist% gcs%)
-              -> (mv boolean fixnum symbol-fixnum-alist 
-                     run-hist% gcs%))
-        :doc
-"?: 
-* Synopsis
-  Run 'n' number of trials on the formula under test
-
-* Input parameters 
-   n is num-trials minus current local-trial number.
-  'r.'  is the current pseudo-random seed.
-   BE. is the alist mapping variables to bounded-exhaustive seeds used in the last instantiation
-   num-trials is the current testing default
-   sm is sampling-method (the current testing default)
-   vl is verbosity-level.
-   run-hist% stores test run stats.
-   gcs% is the global (testing) coverage statistics which is used in determining stopping condition.
-
-* Returns: (mv stop? r. BE. run-hist% gcs%)
-stop? is T when stopping-condition? call is satisfied
-r. is updated pseudo-random seed
-BE. is the updated alist of bounded-exhaustive seeds
-run-hist% is the updated testrun history
-gcs% is the updated global coverage stats.
-
-")
-  (b* (((when (zpf n)) ;Oops, ran out of random trials
-        (prog2$ 
-         (cw? (debug-flag vl)
-                       "~|Finished running ~x0 tests!~%" num-trials)
-         (mv NIL r. run-hist% gcs%)))
-   
-       ((when (stopping-condition? gcs%))
-;return, cos we have reached our goal  
-        (prog2$
-         (cw? (debug-flag vl) 
-"~|Stopping condition satisfied for gcs: ~x0~%" gcs%)
-         (mv T r. run-hist% gcs%)))
-       (local-trial-num  (acl2::|1+F| (acl2::-f num-trials n)))
-       ((mv res A r. BE.)
-;perform a random test run, the result quadruple
-;erp is a flag denoting error, res = value of test  A= value-bindings
-        (run-single-test. sm num-trials local-trial-num  r. BE.))
-       ((mv run-hist% gcs%) (record-testrun. res A run-hist% gcs%)))
-;  in   
-   (run-n-tests. (acl2::|1-F| n) num-trials sm vl r. BE. run-hist% gcs%)))
-
-          
-
-(defmacro get-acl2s-default (param alist &optional default-value)
-  "get the default value of param as found in alist. if not found return default-value"
-  `(b* ((e (assoc-eq ,param ,alist)))
-     (if e
-         (cdr e)
-       ,default-value)))         
-
-
-
-;; Pre Condition: hypothesis-val, conclusion-val and next-sigma have been
-;; attached when this function is called!
-(def run-tests. (N sm vl fvars rseed. run-hist% gcs%)
-  (decl :sig ((fixnump keywordp fixnump symbol-listp 
-                       fixnump run-hist%-p gcs%-p) 
-              -> (mv fixnump run-hist%-p gcs%-p))
-        ;:trace T
-        :doc 
-"?: Run a bunch of simple random/bounded-exhaustive tests/trials to
-  find cts/wts for form under test")
-;do timeout wrapper here!        
-  (b* (((mv stop? rseed. run-hist% gcs%)
-        (run-n-tests. N N
-                      sm
-                      vl
-                      rseed. 
-                      (pairlis$ fvars 
-                                (make-list (len fvars) :initial-element 0))
-                      run-hist%
-                      gcs%
-                      ))
-       
-       (- (cw? (system-debug-flag vl) "~|run-hist: ~x0 ~|gcs%: ~x1~%"
-               run-hist% gcs%)))
-   ;;in
-    (mv stop? rseed. run-hist% gcs%)))
-         
-          
-(defun acl2s-defaults-fn. (defaults override-alist ans.)
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbol-alistp defaults)
-                              (symbol-alistp override-alist)
-                              (symbol-alistp ans.))))
-  (if (endp defaults)
-      ans.
-    (b* (((cons param rec-val) (car defaults))
-         (val (acl2::access acl2::acl2s-param-info% rec-val :value))
-         (override (assoc-eq param override-alist))
-         (val (if override (cdr override) val)))
-      (acl2s-defaults-fn. (cdr defaults) 
-                          override-alist 
-                          (cons (cons param val) ans.)))))
-
-(defmacro acl2s-defaults-alist (&optional override-alist)
-  "return alist mapping acl2s-parameters to their default values
-overridden by entries in override-alist"
-  `(acl2s-defaults-fn. (table-alist 'acl2::acl2s-defaults-table (w state))
-                      ,override-alist '()))
-         
-(def separate-const/simple-hyps. (ts wrld Hc. Hs. Ho.)
-  (decl :sig ((pseudo-term-list plist-world 
-               pseudo-term-list pseudo-term-list pseudo-term-list) 
-              -> (mv pseudo-term-list pseudo-term-list pseudo-term-list))
-        :doc "given a list of hyps, separate constant hyps, simple defdata-type hyps and others")
-  (f* ((add-others-and-recurse... () (separate-const/simple-hyps. 
-                                      rst wrld Hc. Hs. (cons hyp Ho.)))
-       (add-constant-and-recurse (h) (separate-const/simple-hyps.
-                                      rst wrld (cons h Hc.) Hs. Ho.)))
-  (if (endp ts)
-      (mv Hc. Hs. Ho.)
-    
-    (b* (((cons hyp rst) ts)) ;pattern matching in b*
-    (case-match hyp
-      ((P t1)     (if (and (symbolp t1)
-                           (is-type-predicate P wrld))
-                      (separate-const/simple-hyps. rst wrld 
-                                                   Hc. (cons hyp Hs.) Ho.)
-                    (add-others-and-recurse...)))
-                          
-      ((R t1 t2)  (if (acl2::equivalence-relationp R wrld)
-                      (cond ((and (symbolp t1) (quotep t2))
-                             (add-constant-and-recurse (list R t1 t2)))
-                            
-                            ((and (quotep t1) (symbolp t2))
-                             (add-constant-and-recurse (list R t2 t1)))
-                            
-                            (t (add-others-and-recurse...)))
-                    (add-others-and-recurse...)))
-      (&          (add-others-and-recurse...)))))))
-
-
-
-(def all-vars-lst (terms)
-  (decl :sig ((pseudo-term-listp) -> symbol-list)
-        :doc "all free variables in list of terms")
-  (all-vars1-lst terms '()))
-(verify-termination dumb-negate-lit)
-
-(def vars-in-dependency-order (hyps concl vl wrld)
-  (decl :sig ((pseudo-term-list pseudo-term fixnum plist-world) -> symbol-list)
-        :doc "return the free variables ordered according to the notion of
-  dependency that treats equality relation specially. See FMCAD paper for
-  details, but I have not completely implemented the improvements in the
-  paper. This is where I can use better heuristics. But with no hard examples
-  to work on, I am doing a naive job for now.")
-  (b* ((cterms (cons (dumb-negate-lit concl) hyps))
-; cterms names constraint terms
-       (vars (all-vars-lst cterms))
-       ((mv Hc Hs Ho) (separate-const/simple-hyps. cterms wrld '() '() '()))
-       
-       (dgraph (build-variable-dependency-graph Ho vars)) ;TODO rewrite
-       (ord-vs (rev (approximate-topological-sort dgraph (debug-flag vl))))
-       
-       (cvars (all-vars-lst Hc))
-       (svars (all-vars-lst Hs))
-; add only those svars that are not in ord-vs to front of ord-vs
-; cvars should always be in front, i.e they should be chosen first
-       (ord-vs (union-eq svars ord-vs)) ;NOT a set operation
-       (ord-vs (union-eq cvars 
-                         (set-difference-eq ord-vs cvars)))
-
-; 8th Jan 2013 Possible CCG bug
-; Overcaution: remove t and nil which escape pseudo-termp
-       (ord-vs (set-difference-eq  ord-vs '(t nil)))
-       )
-
-   ord-vs))
-       
-;;;; Collecting type and additional constraints
-
-;;; Given a list of hypotheses and a conclusion, we want to find the
-;;; type constraints on each free variable. We collect 3 categories of
-;;; constraints: 1. defdata type and spilled defdata types 2. equality
-;;; constraint 3. additional constraints.  A defdata type has a
-;;; type-predicate and a type-enumerator associated with it.  Ideally
-;;; we would like to compute the minimal (best possible) defdata type
-;;; information, but this can fail, due to incomplete subtype type
-;;; information.  So we end up also storing spillover types, whose
-;;; union/join is the conservative (superset) type of the
-;;; corresponding variable. We also store the equality constraint,
-;;; since its a very strong constraint and often comes up in naive
-;;; dependencies. Finally we also store additional constraints, just
-;;; so as to not throw away information that can fruitfully be utilized
-;;; to come up with the smallest set of possible values the
-;;; constrained variable can take.
-
-(defrec cs% (defdata-type spilled-types 
-              eq-constraint additional-constraints) NIL)
-
-(defun possible-defdata-type-p (v)
-  (declare (xargs :guard T))
-  (or (is-singleton-type-p v)
-      (is-a-variablep v))) ;defdata type
-
-(defun possible-defdata-type-list-p (vs)
-  (declare (xargs :guard T))
-  (if (consp vs)
-      (and (possible-defdata-type-p (car vs))
-           (possible-defdata-type-list-p (cdr vs)))
-    T))
-
-(defun cs%-p (v)
-  (declare (xargs :guard T))
-  (case-match v
-    (('cs% dt st eqc ac)   (and (possible-defdata-type-p dt) 
-                                (possible-defdata-type-list-p st)
-                                (or (pseudo-termp eqc)
-                                    (eq 'defdata::empty-eq-constraint eqc))
-                                (pseudo-term-listp ac)))))
-    
-
-(defun |is (symbol . cs%)| (v)
-  (declare (xargs :guard T))
-  (case-match v
-    ((x . y)      (and (symbolp x)
-                       (cs%-p y)))))
-
-(defun symbol-cs%-alistp (vs)
-  (declare (xargs :guard T))
-  (if (consp vs)
-      (and (|is (symbol . cs%)| (car vs))
-           (symbol-cs%-alistp (cdr vs)))
-    NIL))
-           
-
-  ;; (foldl (lambda (v acc) (and acc (|is a (symbol . type-constraints%)| v) ))
-  ;;        T vs)) 
-; Note: The above expression if implemented is not as efficient as 
-;; (defun _-list-p (xs) 
-;;   (if (endp x) T 
-;;     (and (_-p (car x))
-;;          (_-list-p (cdr x)))))
-  ;; (and (true-listp vs)
-  ;;      (null ([ x : x in vs : (not (|is a (symbol . type-constraints%)|)) ])))
- 
-
-;; TODO: conclusion is not taken care of now. Only negated conclusion
-;; is treated, but we would like to be symmetric with respect to
-;; searching cts and wts. --harshrc 4th March 2012.
-
-(def put-additional-constraints. (vs term v-cs%-alst.)
-  (decl :sig ((symbol-list pseudo-term symbol-cs%-alist) 
-              -> symbol-cs%-alist)
-        :doc "put term in alist for all keys in vs")
-  (if (endp vs)
-      v-cs%-alst.
-    (b* (((cons v cs%) (assoc-eq (car vs) v-cs%-alst.))
-         (cs% (change cs% additional-constraints 
-                      (cons term (access cs% additional-constraints)))))
-    (put-additional-constraints. (cdr vs) term 
-                                 (put-assoc-eq v cs% v-cs%-alst.)))))
-
-(def put-eq-constraint. (v term v-cs%-alst.)
-  (decl :sig ((symbol pseudo-term symbol-cs%-alist) 
-              -> symbol-cs%-alist)
-        :doc "put eq-constraint term in alist for key v")
-  (b* (((cons & cs%) (assoc-eq v v-cs%-alst.))
-       (eqc (access cs% eq-constraint))
-       (- (cw? (not (null eqc)) "CEgen/Note: Overwriting eq-constraint for ~x0.~|" v))
-       (cs% (change cs% eq-constraint term)))
-   (put-assoc-eq v cs% v-cs%-alst.)))
-
-(def put-defdata-type. (v typ vl v-cs%-alst.)
-  (decl :sig ((symbol possible-defdata-type-p fixnum symbol-cs%-alist) 
-              -> symbol-cs%-alist)
-        :doc "put defdata type typ in alist for key v")
-  (b* (((cons & cs%) (assoc-eq v v-cs%-alst.))
-       (dt (access cs% defdata-type))
-       (- (cw? (and (debug-flag vl) (not (eq 'all dt))) 
-"CEgen/Note: Overwriting defdata type for ~x0. ~x1 -> ~x2~|" v dt typ))
-       (cs% (change cs% defdata-type typ)))
-   (put-assoc-eq v cs% v-cs%-alst.)))
-
-
-
-(defs  ;;might be mut-rec, but right now I assume tht I wont encounter
-       ;;AND and OR like if expressions, and hence dont need the
-       ;;mutually-recursive counterpart of v-cs%-alist-from-term. TODO
-  (v-cs%-alist-from-term. (term vl wrld ans.)
-  (decl :sig ((pseudo-term fixnum plist-world symbol-cs%-alist)
-              ->
-              symbol-cs%-alist)
-        :doc "helper to collect-constraints")
-;Invariant: ans. is an alist thats in the order given by dependency analysis
-  (f* ((add-constraints... () (put-additional-constraints. fvars term ans.))
-         
-       (add-eq-constraint... (t1) (if (acl2::equivalence-relationp R wrld)
-                                      (put-eq-constraint. x t1 ans.)
-                                    (add-constraints...))))
-     
-   (b* ((fvars (all-vars term)))
-           
-    (case-match term
-      
-;the following is a rare case (I found it when the conclusion is nil
-;and its negation is 'T
-      (('quote c) (declare (ignore c))  ans.) ;ignore quoted constant terms 
-
-;TODO possible field variable (i.e f is a getter/selector)
-; Note that term cannot have a lambda applicaton/let, so the car of the term is
-; always a function symbol if term is a consp.
-      ((P (f . &)) (declare (ignore P f))  (add-constraints...)) 
-
-;x has to be an atom below, otherwise, we would have caught that case above.
-      (('not x)      (put-eq-constraint. x ''nil ans.))
-      
-      ((P x)   (b* ((tname (is-type-predicate P wrld))
-                    ((cons & cs%) (assoc-eq x ans.))
-                    (curr-typ (access cs% defdata-type)))
-                (if tname
-                    (put-defdata-type. x 
-                                       (acl2::meet tname curr-typ wrld) vl ans.)
-                  (add-constraints...))))
-
-      ((R (f . &) (g . &)) (declare (ignore R f g)) (add-constraints...))
-
-;x has to be an atom below, otherwise, we would have caught that case
-;above.
-      ((R x ('quote c))    (add-eq-constraint... (kwote c)))
-      ((R ('quote c) x)    (add-eq-constraint... (kwote c)))
-      ((R x (f . args))    (add-eq-constraint... (acl2::cons-term f args)))
-      ((R (f . args) x)    (add-eq-constraint... (acl2::cons-term f args)))
-      
-      ;; has to be a (R t1 t2 ...) or atomic term
-      (&                   (add-constraints...)))))))
-                         
-  
-(def v-cs%-alist-from-terms. (terms vl wrld ans.)
-  (decl :sig ((pseudo-term-listp fixnum plist-worldp symbol-cs%-alist) 
-              -> symbol-cs%-alist)
-        :doc "helper to collect-constraints%")
-  (if (endp terms)
-      ans.
-    (v-cs%-alist-from-terms. (cdr terms) vl wrld 
-                             (v-cs%-alist-from-term. (car terms)
-                                                     vl wrld ans.))))
-
-(def assimilate-type-alist (vs type-alist vl wrld ans.)
-  (decl :sig ((symbol-list symbol-alist fixnum plist-world symbol-cs%-alist) 
-              -> symbol-cs%-alist)
-        :doc 
-"overwrite into v-cs%-alst. the type information in type-alist.
-Put defdata symbol types into defdata-type field, but put constants
-into eq-constraint field")
-; Aug 30 '12 -- This function fixes a bug in Pete's GE demo, where the
-; type=alist had 'NIL as the type, which is a singleton defdata type
-; and I was not taking it into consideration when trying to run MEET
-; on it, which cannot handle types which are not in the defdata graph,
-; and certainly constants are not part of the defdata graph.
-  (if (endp vs)
-      ans.
-    (b* ((x (car vs))
-         (prior-t (assoc-eq x type-alist))
-;type-alist of of form (listof (cons var (listof defdata-type)))
-;where defdata-type is possible-defdata-type-p. listof represents unions.
-         ((unless (and prior-t
-                       (consp (cdr prior-t))
-                       (null (cddr prior-t))))
-; TODO: Union types are ignored. Implement them.
-; But note that since we always get this through a meet-type-alist, we
-; throw away the union type information there itself.
-          (prog2$
-           (cw? (and (verbose-flag vl) 
-                     (consp (cdr prior-t)) 
-                     (not (null (cddr prior-t))))
-"~|CGEN WARNING: Ignoring union types ~x0 ~|" (cdr prior-t))
-           (assimilate-type-alist (cdr vs) type-alist vl wrld ans.)))
-         (typ-given (cadr prior-t))
-         ((when (possible-constant-valuep typ-given))
-; is a singleton, then treat it as a eq-constraint
-; BOZO: meet-type-alist does it differently. (03/04/13)
-          (assimilate-type-alist (cdr vs) type-alist vl wrld 
-                                 (put-eq-constraint. x typ-given ans.)))
-         ((cons & cs%) (assoc-eq x ans.))
-         (curr-typ (access cs% defdata-type))
-         (final-typ (acl2::meet curr-typ typ-given wrld)))
-; update the current defdata type with the new type information (type-alist)
-     (assimilate-type-alist (cdr vs) type-alist vl wrld
-                            (put-defdata-type. x final-typ vl ans.)))))
-
-(defconst *empty-cs%*
-  (acl2::make cs%
-        :defdata-type 'acl2::all 
-        :spilled-types '()
-        :eq-constraint 'defdata::empty-eq-constraint
-        :additional-constraints '()))
-
-(def collect-constraints% (hyps ordered-vars type-alist vl wrld)
-  (decl :sig ((pseudo-term-listp symbol-listp symbol-alistp 
-                                 fixnum plist-worldp) -> symbol-cs%-alist)
-        :doc 
-" 
-* Synopsis 
-  For each free variable compute/infer both the simple defdata types
-  and additional constraints on it.
-
-* Input
-  hyps is a usually a list of hypotheses of the conjecture under query
-  and is a term-listp
-  ordered-vars is the free variables of hyps, but in the variable
-  dependency order as computed from the dependency graphs of hyps.
-  type-alist is the type information inferred from ACL2 usually, or
-  it might be prior type knowledge we dont want to lose i.e if the
-  type inferred from hyps are weaker than in type-alist we will
-  keep the stronger type information.
-  
-
-* Output
-  An alist mapping free variables to cs% record
-")
-  (f* ((unconstrained-v-cs%-alst 
-          (xs) 
-          (pairlis$ xs (make-list (len xs)
-                                  :initial-element 
-                                  *empty-cs%*))))
-      ;; initialize the alist
-    (b* ((v-cs%-alst  (unconstrained-v-cs%-alst ordered-vars))
-         (v-cs%-alst  (assimilate-type-alist ordered-vars type-alist 
-                                             vl wrld v-cs%-alst)))
-       
-     (v-cs%-alist-from-terms. hyps vl wrld v-cs%-alst))))
-
-(defun symbol-unsigned-29bits-alistp (v)
-  (declare (xargs :guard T))
-  (if (atom v)
-      (null v)
-    (and (consp (car v))
-         (symbolp (caar v))
-         (unsigned-29bits-p (cdar v))
-         (symbol-unsigned-29bits-alistp (cdr v)))))
-
-(defthm symbol-unsigned-29bits-alistp-forwards-to-symbol-alistp
-  (implies (symbol-unsigned-29bits-alistp x)
-           (symbol-alistp x))
-  :rule-classes :forward-chaining)
-
-; (random-natural-seed seed.) => (mv random-nat new-seed)
-#||
-function to compute next BE seed tuple
-Precondition: BE. is a consp, i.e at least one free variable
-Here is the simple scheme:
-((x 0) (y 0) (z 0)) -> 
-((y 0) (z 0) (x 1)) -> 
-((z 0) (x 1) (z 1)) -> 
-((x 0) (y 0) (z 0)) -> 
-((x 0) (y 0) (z 0)) ->
-((x 0) (y 0) (z 0)) ->
-((x 0) (y 0) (z 0)) 
-
-The above algo is O(n) in num of free vars. but simple to implement.
-Arrays or a stobj can make this constant time operation.  
-
-Alternative algo: Traverse the enumeration tree in BFS order.  Hvent
-thought about how to implement it.
-||#
-
-;;; (symbol-unsigned-29bits-alistp) -> symbol-unsigned-29bits-alistp)
-;; update 29th April '12
-;; let cut the optimization to get guards to verify
-(defun |next BE args| (BE.)
-  "naive bounded exhaustive enumeration."
-  (declare (xargs :guard (and (true-listp BE.)
-                              (consp BE.)
-                              (symbol-alistp BE.))))
-                          
-  (b* (((cons v ;; (the (unsigned-byte 29)
-                  m) (car BE.))
-       (;; (the (unsigned-byte 29) 
-        m~ (;; acl2::|1+F|
-            1+  (nfix m))))
-   (append (cdr BE.) (list (cons v m~)))))
-            
-     
-
-
-
-(def make-next-sigma_mv-let (var-enumcall-alist body)
-  (decl :sig ((symbol-alistp all) -> all)
-        :doc "helper function to make-next-sigma")
-  (f* ((mv-value (v exp) 
-          `(case sampling-method 
-             (:random (b* (((mv ?m r.) (random-natural-seed r.)))
-                       (mv r. BE. ,(subst 'm 'r exp))))
-             ;; bugfix - It is possible that m is not in exp
-             ;; this is the case when exp is a eq-constraint
-             (:be (b* ((?m (cdr (assoc-eq ',v BE.))))
-                   (mv r. (|next BE args| BE.) ,(subst 'm 'r exp))))
-             (otherwise (mv r. BE. '0)))))
-                           
-  (if (endp var-enumcall-alist)
-      body
-    (b* (((cons var ecall) (first var-enumcall-alist)))
-;    in 
-     `(mv-let (r. BE. ,var)
-              ,(mv-value var ecall)
-            ,(make-next-sigma_mv-let (rest var-enumcall-alist) body))))))
-
-(def make-guard-var-member-eq (vars alst)
-  (decl :sig ((symbol-alistp symbol) -> all)
-        :doc "helper function to make-next-sigma")
-  (if (endp vars)
-      nil
-    (cons `(member-eq ',(car vars) ,alst)
-          (make-guard-var-member-eq (cdr vars) alst))))
-  
-(def cs%-enumcall (cs% ctx wrld computed-vars)
-  (decl :sig ((cs%-p symbolp plist-worldp symbol-listp) 
-              -> (mv fixnum pseudo-termp))
-        :doc "for each cs% record we translate it into the
-  a (mv size enumcall), where the enumcall is an expression that when evaluated
-  gives the value of correct type/constraint and size is the size of the type
-  i.e the set of value satisfied by the constraint")
-;;; TODO: optimize/complete here using extra information in
-;;; spilled-types and additional-constraints
-  (case-match cs%
-;('cs% defdata-type spilled-types eq-constraint additional-constraints)
-    (('cs% defdata-type & 'defdata::empty-eq-constraint &) 
-; ACHTUNG: cs% defrec exposed
-     (b* ((enum-info% (get-enum-info% defdata-type ctx wrld)))
-      (mv (access enum-info% size) (access enum-info% expr))))
-
-; if we see a equality constraint, we give preference to it over a
-; defdata type, but only if the variables in the eq-constraint are
-; already computed i.e already have an enumcall in the final answer
-    (('cs% defdata-type & eq-constraint &)    
-     (b* ((eq-vs (all-vars eq-constraint))
-          (remaining (set-difference-eq eq-vs computed-vars)))
-      (if remaining
-          (b* ((enum-info% (get-enum-info% defdata-type ctx wrld)))
-           (mv (access enum-info% size) (access enum-info% expr)))
-        (mv 1 eq-constraint))))
-    (& (prog2$ 
-        (er hard ctx "~|BAD record cs% passed to cs%-enumcall")
-        (mv 1 NIL)))))
-               
-     
-
-(def make-enumerator-call-alist (v-cs%-alst ctx wrld ans.)
-  (decl :sig ((symbol-cs%-alist symbol plist-world symbol-alist) 
-              -> symbol-alist)
-        :doc 
-        "given an alist mapping variables to cs% records (in dependency order),
-  we walk down the alist, translating each type constraint to the corresponding
-enumerator call expression")
-  (if (endp v-cs%-alst)
-      (rev ans.) ;dont change the original dependency order
-    (b* (((cons x cs%) (car v-cs%-alst))
-         ((mv & call) (cs%-enumcall cs% ctx wrld (strip-cars ans.))))
-     
-     (make-enumerator-call-alist (cdr v-cs%-alst) ctx wrld
-                                 ;; add in reverse order
-                                 (cons (cons x call) ans.)))))
-    
-
-;bugfix May 24 '12
-;partial-A needs to be quoted to avoid being confused with function app
-(def kwote-symbol-doublet-list (A)
-  (decl :sig ((symbol-doublet-listp) -> quoted-constantp))
-  (if (endp A)
-      nil
-    (cons (list 'list (kwote (caar A)) (cadar A))
-          (kwote-symbol-doublet-list (cdr A)))))
-
-(def make-next-sigma-defuns (name hyps concl ord-vs 
-                                  partial-A type-alist 
-                                  vl wrld ctx)
-  (decl :sig ((string pseudo-term-list pseudo-term symbol-list 
-                      symbol-doublet-listp symbol-alist
-                      fixnum plist-worldp symbol) 
-              -> all)
-        :doc "return the defun forms defining next-sigma function, given a
-        list of hypotheses and conclusion (terms)")
-  (f* ((defun-forms ()
-         `((defun next-sigma-current (sampling-method r. BE.)
-            "returns (mv A r. BE.)"
-            (declare (ignorable sampling-method)) ;in case ord-vs is nil
-            (declare (xargs :verify-guards nil
-                            :guard 
-                            (and (member-eq sampling-method
-                                            '(:random :be))
-                                 (unsigned-byte-p 31 r.)
-                                 (symbol-unsigned-29bits-alistp BE.)
-                                 (consp BE.) ;precondition TODOcheck
-                                 (and ,@(make-guard-var-member-eq
-                                         (strip-cars var-enumcall-alist)
-                                         'BE.)))
-                            :guard-hints 
-                            (("Goal" :in-theory (disable unsigned-byte-p)))))
-            ,(make-next-sigma_mv-let
-                var-enumcall-alist
-; sigma will be output as a let-bindings i.e symbol-doublet-listp
-                `(mv ,(make-var-value-list-bindings 
-                       (strip-cars var-enumcall-alist) 
-                       (kwote-symbol-doublet-list partial-A))
-                     r. BE.)))
-           (defun next-sigma-current-gv (sampling-method r. BE.)
-             (declare (xargs :guard T))
-             (ec-call (next-sigma-current sampling-method r. BE.))))))
-         
-       
-   (b* ((v-cs%-alst (collect-constraints% 
-                     (cons (dumb-negate-lit concl) hyps)
-                     ord-vs type-alist vl wrld))
-        (var-enumcall-alist 
-         (make-enumerator-call-alist v-cs%-alst ctx wrld '()))
-        (- (cw? (verbose-flag vl) 
-"~|CEgen/Note: Test data enumeration with ~x1~%" name var-enumcall-alist)))
-    (defun-forms))))
-
-
-
-(defs 
-  (mv-list-ify (term mv-sig-alist)
-    (decl :sig ((pseudo-term symbol-list) -> pseudo-term)
-          :doc "wrap all mv fn calls with mv-list")
-    (if (variablep term)
-      term
-      (if (fquotep term)
-        term
-      (b* ((fn (ffn-symb term))
-           (args (fargs term))
-           (A mv-sig-alist)
-           (entry (assoc-eq fn A))
-           ((unless entry)
-            (acl2::cons-term fn
-                       (mv-list-ify-lst args A)))
-           ((cons fn m) entry)) 
-;m is output arity and should be greater than 1.
-        (acl2::cons-term 'acl2::mv-list
-                   (list (kwote m)
-                         (acl2::cons-term fn (mv-list-ify-lst args A))))))))
-
-  (mv-list-ify-lst (terms mv-sig-alist)
-   (decl :sig ((pseudo-term-list symbol-list) -> pseudo-term-list))
-   (if (endp terms)
-       '()
-     (cons (mv-list-ify (car terms) mv-sig-alist)
-           (mv-list-ify-lst (cdr terms) mv-sig-alist)))))
-         
-        
-
-(def make-let-binding-for-sigma (vs sigma-symbol)
-  (decl :sig ((symbol-list symbol) -> symbol-doublet-listp)
-        :doc 
-"(make-let-binding-for-sigma '(x y) 'A) => ((x (get-val x A))
-                                            (y (get-val y A)))
-")
-  (if (endp vs)
-      '()
-    (cons `(,(first vs) (cadr (assoc-eq ',(first vs) ,sigma-symbol)))
-          (make-let-binding-for-sigma (cdr vs) sigma-symbol))))
-
-(def make-hypotheses-val-defuns (terms ord-vars mv-sig-alist)
-  (decl :sig ((pseudo-term-list symbol-list symbol-alist) -> all)
-        :doc "make the defun forms for hypotheses-val defstub")
-  `((defun hypotheses-val-current (A)
-      (declare (ignorable A))
-      (declare (xargs :verify-guards nil
-                      :guard (symbol-doublet-listp A)))
-      (let ,(make-let-binding-for-sigma ord-vars 'A)
-        (declare (ignorable ,@ord-vars))
-          ,(mv-list-ify (single-hypothesis terms)
-                        mv-sig-alist)))
-    (defun hypotheses-val-current-gv (A)
-      (declare (xargs :guard T))
-      (ec-call (hypotheses-val-current A)))))
-
-(def make-conclusion-val-defuns (term ord-vars mv-sig-alist)
-  (decl :sig ((pseudo-term symbol-list symbol-alist) -> all)
-        :doc "make the defun forms for conclusion-val defstub")
-  `((defun conclusion-val-current (A)
-      (declare (ignorable A))
-      (declare (xargs :verify-guards nil
-                      :guard (symbol-doublet-listp A)))
-      (let ,(make-let-binding-for-sigma ord-vars 'A)
-        (declare (ignorable ,@ord-vars))
-          ,(mv-list-ify term mv-sig-alist)))
-    (defun conclusion-val-current-gv (A)
-      (declare (xargs :guard T))
-      (ec-call (conclusion-val-current A)))))
-
-;add the following for guard verif
-(defthm symbol-doublet-listp-=>-symbol-alistp
-  (implies (symbol-doublet-listp x)
-           (symbol-alistp x))
-  :rule-classes ((:forward-chaining)
-                 (:rewrite :backchain-limit-lst 1)
-                 ))
-
-
-;; records data that is later needed for printing stats/summary 
-(defrec s-hist-entry% (run-hist 
-                       (hyps vars . concl)
-                       (elide-map) ;printing top-level cts/wts
-                       (start-time . end-time) . name) NIL)
-
-(defun s-hist-entry%-p (v)
-  (declare (xargs :guard T))
-  (case-match v ;internal layout hidden
-    (('s-hist-entry% run-hist
-                     (hyps vars . concl)
-                     (elide-map)
-                     (start-time . end-time) . name)
-     (and (run-hist%-p run-hist)
-          (pseudo-term-listp hyps)
-          (pseudo-termp concl)
-          (symbol-listp vars)
-          (symbol-alistp elide-map) ;actually symbol term alist
-          (stringp name)
-          (rationalp start-time)
-          (rationalp end-time)))))
-          
-  
-(defun s-hist-p (v)
-"is a alist mapping strings to run-hist% records"
-  (declare (xargs :guard T))
-  (if (atom v)
-      (null v)
-    (and (consp (car v))
-         (stringp (caar v))
-         (s-hist-entry%-p (cdar v))
-         (s-hist-p (cdr v)))))
-
-(defun cgen-stats-p (v)
-;todo - probably inefficient
-  (declare (xargs :guard T))
-  (and (keyword-value-listp v)
-       ;(= (len v) 4) extensible
-       (assoc-keyword :gcs% v)
-       (assoc-keyword :s-hist v)))
-
-(defun cgen-stats-event-stackp (s)
-  (declare (xargs :guard T))
-  (if (atom s)
-      (null s)
-    (and (cgen-stats-p (car s))
-         (cgen-stats-event-stackp (cdr s)))))
-
-(defun valid-cgen-stats-event-stackp (s)
-  (declare (xargs :guard T))
-  "Should be a non-empty list whose member satisfies cgen-stats-event-stackp"
-  (and (cgen-stats-event-stackp s)
-       (consp s)))
-
-;; Feb 22 2013 Add a new global state variable which points to
-;; a stack of accumulated cgen recorded statistics. Its a stack
-;; because we can have nested events, but only the innermost
-;; member of the stack should ever be non-empty i.e only the top-level
-;; events like defthm/thm/test? should ever hold valid recorded data.
-;NOTE: interesting - I cant use defmacro instead of defabbrev
-(defabbrev get-gcs%-global () 
-  (if (f-boundp-global 'cgen-stats-event-stack state)
-    (b* ((cse-stack (@ cgen-stats-event-stack))
-         ((unless (valid-cgen-stats-event-stackp cse-stack))
-            (er hard? ctx "~|cgen-stats-event-stack is ill-formed~|"))
-         (gcs% (cadr (assoc-keyword :gcs% (car cse-stack)))))
-      (if (gcs%-p gcs%)
-          gcs%
-        (er hard? ctx "~|gcs% found in globals is of bad type~|")))
-    (er hard? ctx "~|cgen-stats-event-stack not found in globals ~|")))
-
-(defabbrev get-s-hist-global () 
-  (if (f-boundp-global 'cgen-stats-event-stack state)
-    (b* ((cse-stack (@ cgen-stats-event-stack))
-         ((unless (valid-cgen-stats-event-stackp cse-stack))
-          (er hard? ctx "~|cgen-stats-event-stack is ill-formed~|"))
-         (s-hist (cadr (assoc-keyword :s-hist (car cse-stack)))))
-      (if (s-hist-p s-hist)
-          s-hist
-        (er hard? ctx "~|hist found in globals is of bad type~|")))
-    (er hard? ctx "~|cgen-stats-event-stack not found in globals ~|")))
-
-(defabbrev put-gcs%-global (gcs%) 
-  (if (f-boundp-global 'cgen-stats-event-stack state)
-      (if (gcs%-p gcs%)
-          (b* ((cse-stack (@ cgen-stats-event-stack))
-               ((unless (valid-cgen-stats-event-stackp cse-stack))
-                  (prog2$ 
-                 (er hard? ctx "~|cgen-stats-event-stack is ill-formed~|")
-                 state))
-               (cse-stack (cons (list* :gcs% gcs% (acl2::remove-keyword :gcs% (car cse-stack))) 
-                                (cdr cse-stack)));update 
-               (- (assert$ (valid-cgen-stats-event-stackp cse-stack) t)))
-          (f-put-global 'cgen-stats-event-stack cse-stack state))
-        (prog2$ 
-         (er hard? ctx "~|gcs% being put in globals is of bad type~|")
-         state))
-    (prog2$ (er hard? ctx "~|cgen-stats-event-stack not found in globals ~|")
-            state)))
-
-(defabbrev put-s-hist-global (s-hist) 
-  (if (f-boundp-global 'cgen-stats-event-stack state)
-      (if (s-hist-p s-hist)
-          (b* ((cse-stack (@ cgen-stats-event-stack))
-               ((unless (valid-cgen-stats-event-stackp cse-stack))
-                (prog2$ 
-                 (er hard? ctx "~|cgen-stats-event-stack is ill-formed~|")
-                 state))
-               (cse-stack (cons (list* :s-hist s-hist (acl2::remove-keyword :s-hist (car cse-stack))) 
-                                (cdr cse-stack)));update
-               (- (assert$ (valid-cgen-stats-event-stackp cse-stack) t)))
-          (f-put-global 'cgen-stats-event-stack cse-stack state))
-        (progn$
-         (cw? (debug-flag vl) "~|BAD s-hist : ~x0~|" s-hist)
-         (er hard? ctx "~|hist being put in globals is of bad type~|")
-         state))
-    (prog2$ (er hard? ctx "~|cgen-stats-event-stack not found in globals ~|")
-            state)))
-
-
-(defconst *initial-run-hist%* 
-  (acl2::make run-hist% 
-              :cts '() :wts '() :vacs '() 
-              :|#wts| 0 :|#cts| 0 
-              :|#vacs| 0 :|#dups| 0))
-
-(def initial-s-hist-entry% (name hyps concl vars 
-                                 elide-map start)
-  (decl :sig ((string pseudo-term-list pseudo-term symbol-list 
-                      symbol-alist rational) 
-              -> s-hist-entry%)
-        :doc "make initial s-hist-entry% given args")
-  (acl2::make s-hist-entry% 
-              :name name :hyps hyps :concl concl :vars vars 
-              :elide-map elide-map
-              :start-time start :end-time start
-              :run-hist *initial-run-hist%*))
-          
-;; 1st April 2013 Fix
-;; You cannot trust make-event to give the right result
-;; through trans-eval. Just use a state temp global.
-;; This bug manifests, when you use (skip-proofs ....)
-
-(def simple-search (name 
-                    hyps concl vars partial-A 
-                    type-alist mv-sig-alist
-                    run-hist% gcs%
-                    N vl sm programp
-                    ctx wrld state)
-  (decl :sig ((string pseudo-term-list pseudo-term symbol-list 
-               symbol-doublet-listp symbol-alist symbol-alist
-               run-hist% gcs% fixnum fixnum keyword boolean
-               symbol plist-world state) 
-              -> (mv erp (list boolean run-hist% gcs%) state))
-        :mode :program
-        :doc 
-"
-Use :simple search strategy to find counterexamples and witnesses.
-
-* PRE : conjecture has at least one free variable
-
-* What it does
-  1. make hypotheses-val conclusion-val,  attach them
-  2. make next-sigma defun and attach it
-  3. call run-tests!.
-  4. store/record information (run-hist%,gcs%) and 
-     returns (list stop? run-hist% gcs%) where stop? is T when
-     stopping condition is satisfied.
-")
-  (b* ((hyp-val-defuns   (make-hypotheses-val-defuns hyps vars mv-sig-alist))
-       (concl-val-defuns (make-conclusion-val-defuns concl vars mv-sig-alist))
-       (- (cw? (system-debug-flag vl) 
-               "~%~%~x0  hyp/concl defuns: ~| ~x1 ~x2~|" 
-               name hyp-val-defuns concl-val-defuns))
-       (next-sigma-defuns (make-next-sigma-defuns name hyps concl 
-                                                  vars partial-A type-alist
-                                                  vl wrld ctx))
-       (- (cw? (system-debug-flag vl) "next-sigma : ~| ~x0~|" next-sigma-defuns))
-       (rseed. (getseed state))
-       ;;initialize temp result
-       ((er &) (assign ss-temp-result (list nil run-hist% gcs%)))
-       
-       (call-form   
-        `(acl2::state-global-let*
-          ((acl2::guard-checking-on ,(if programp :none nil)))
-          (b* (((mv stop? rseed. run-hist% gcs%)
-                (run-tests. ,N ,sm ,vl ',vars
-                            ,rseed. ',run-hist% ',gcs%))
-               (state (putseed rseed. state)))
-           (prog2$ 
-            (cw? (and (debug-flag ,vl)
-                      stop?)
-                 "~| Search to be aborted, because we reached stopping condition.~|")
-            (er-progn 
-             (assign ss-temp-result (list stop? run-hist% gcs%))
-             (value '(value-triple :invisible)))))))
-
-       );end b* bindings
-;  IN
-   (mv-let 
-    (erp trval state)
-    (trans-eval `(acl2::state-global-let*
-                  ((acl2::inhibit-output-lst
-                    ,(if (system-debug-flag vl)
-                         ''(summary)
-                       ;;shut everything except error
-                       ''(warning warning! observation prove
-                                  proof-checker event expansion
-                                  proof-tree summary)))) 
-                  (make-event
-                   (er-progn
-; dont even think of nested testing (nested waterfall call to test checkpoint)
-                    (acl2s-defaults :set testing-enabled nil)
-                    
-                    ;; added 2nd May '12. Why leave out program context
-                    
-                    ,@(and programp '((program)))
-                    
-                    ,@hyp-val-defuns
-                    ,@concl-val-defuns
-                    ,@next-sigma-defuns
-; Jan 8th 2013 - program mode doesnt work anymore since
-; we dont have trust tags and skip-checks in place, lets
-; fix it here.
-                    ,@(and programp '((defttag :testing)))
-; Note: all of these defuns are non-recursive and guards not verified, so
-; none of these events will cause a call to prove (we hope)
-; This is an important observation, since we rely on test-checkpoint
-; computed hint to do testing which will get called on every call to prover.
-; Thus we might pollute our globals (recorded testing information to print)
-; if we make unexpected (prove ...) calls. Update 09/28/12 the above call to
-; disable testing should guarantee that test-checkpoint will not be called
-; again.
-
-; Update Sep 27th 2012
-; Folllowing a helpful email by Matt, found a way to fool the function
-; to be guard verified, by wrapping its call in an ec-call
-; This way I also get rid of the trust tag .... Hurrah!!
-; Update Jan 8th 2013, but have to bring back the ttag and skip-checks for
-; program mode testing :((
-                    ,@(if programp
-                          '((defattach (hypotheses-val hypotheses-val-current-gv) :skip-checks t)
-                            (defattach (conclusion-val conclusion-val-current-gv) :skip-checks t)
-                            (defattach (next-sigma next-sigma-current-gv) :skip-checks t))
-                        '((defattach (hypotheses-val hypotheses-val-current-gv))
-                          (defattach (conclusion-val conclusion-val-current-gv))
-                          (defattach (next-sigma next-sigma-current-gv))))
- 
-                   ,@(and programp '((defttag nil)))
-                    
-                    ,call-form))
-                  )
-                ctx state T)
-    (declare (ignore trval))
-
-    (mv erp (@ ss-temp-result) state))))
-
-
-(def select (terms debug)
-  (decl :sig ((pseudo-term-list boolean) 
-              -> symbol)
-        :doc "choose the variable with least dependency. Build a dependency
-  graph, topologically sort it and return the first sink we find.")
-;We have to build a dependency graph at each iteration, since the graph changes
-;as we incrementally concretize/instantiate variables.  
-;SELECT Ideal Situation:: No variable should be picked before the variable it
-;depends on has been selected and assigned
-
-  (b* ((vars (all-vars-lst terms))
-       (G (build-variable-dependency-graph terms vars))
-;TODO: among the variables of a component, we should vary
-;the order of selection of variables!!
-       (var (car (last (approximate-topological-sort G debug))))
-       (- (cw? debug "~|DPLL: Select var: ~x0~%" var)))
-   var))
-
-; May 14 '12: changed to v-cs%-alst parameter for optimization
-(def assign-value (x |#assigns| cs% partial-A vl ctx wrld state)
-  (decl :sig ((symbol fixnum cs% symbol-doublet-listp
-                      fixnum symbol plist-world state)
-              -> (mv erp (list pseudo-term keyword fixnum) state))
-        :mode :program
-        :doc "assign a value to x. Infer type constraints from hyps, get the
-enumcall for x. trans-eval enumcall to get value to be assigned to x. quote it
-to obtain a term. return (mv val :decision i+1), if size of type attributed to
-x is greater than 1, otherwise return (mv val :implied i) where i= #assigns
-made to x already.")
-
-  (b* ((- (assert$ (cs%-p cs%) 1))
-       (bound-vars (strip-cars partial-A))
-       ((mv size call) (cs%-enumcall cs% ctx wrld bound-vars))
-       
-       (r. (getseed state))
-       ((mv m r.) (random-natural-seed r.))
-       (call (subst m 'r call))
-       (state (putseed r. state))
-       (vexp (if partial-A 
-                 `(let ,partial-A 
-                   (declare (ignorable ,@bound-vars))
-                      ,call) 
-               call))
-       (- (cw? (debug-flag vl) 
-             "~|ASSIGN: x=~x0  eval[~x1]~|" x  vexp))
-       ((er ans)       (trans-eval-single-value vexp ctx state))
-       (val-term       (kwote ans)))
-   (if (equal size 1) ;size=0 is not possible, also size can be T (inf)
-       (value (list val-term :implied |#assigns|))
-     (value (list val-term :decision (1+ |#assigns|))))))
-
-(def simplify-term (term hyps state)
-  (decl :sig ((pseudo-term pseudo-term-list state) 
-              -> (mv erp pseudo-term state))
-        :mode :program
-        :doc "simplify term under hyps. erp is T if hyps have a contradiction
-  in them. return the simplifed term in error triple")
-  (acl2::easy-simplify-term1-fn term hyps '() 'equal 't 't 1000 1000 state))
-
-; TODO: WHat will happen if some variable gets elided during this
-; simplifcation?  Then our code breaks, especially rem-vars logic and capturing
-; full assignment.
-
-(def simplify-hyps1 (rem-hyps init-hyps eq-hyp ans. vl state)
-  (decl :sig ((pseudo-term-list pseudo-term-list pseudo-term-list bool state)
-              -> (mv erp pseudo-term state))
-        :mode :program
-        :doc "simplify each hyp in rem-hyps assuming init-hyps, accumulate in
-  ans. and return a value triple containing shyps.")
-  (if (endp rem-hyps)
-      (value ans.)
-    (b* ((hyp         (car rem-hyps))
-         (other-hyps  (remove1-equal hyp init-hyps))
-         ((er shyp)   (simplify-term hyp other-hyps state))
-         (simplified? (term-order shyp hyp))
-         ((when (equal shyp ''nil)) ;contradiction
-          (mv T ans. state))
-; 27th Aug '12. FIXED a bug in testing-regression.lsp. In incremental mode
-; the assert$ that x should not be in the free vars of the conjecture
-; was being violated because I was naively checking against term-order.
-; But in the case of small-posp, the type assumptions that could have been
-; brought to ACL2's attention using compound-recognizer rules were hidden
-; leading to a big IF term being generated in shyp.
-; SO now if the above happens(I should give a warning here), at the very
-;  least I subst the assignment in hyp.
-         ((list 'equal x a) eq-hyp)
-         (- (cw? (debug-flag vl) 
-             "ACHTUNG: simplify-hyps result not less than hyp in term-order"))
-         (shyp (if simplified? shyp (subst a x hyp))))
-     
-     (simplify-hyps1 (cdr rem-hyps) init-hyps eq-hyp
-                     (if (equal shyp ''t) ans.
-                       (append ans. (list shyp))) ;dont mess with order
-                     vl state))))
-
-(def simplify-hyps (hyps eq-hyp vl state)
-  (decl :sig ((pseudo-term-list pseudo-term boolean state) 
-              -> (mv erp pseudo-term-list state))
-        :mode :program
-        :doc "simplify hyps assuming equality eq-hyp. return shyps in an error
-        triple.")
-  (b* (((er shyps1) (simplify-hyps1 hyps (list eq-hyp) eq-hyp '() vl state)))
-;I do the above and then again simplify to get order-insensitive list of
-;simplified hypotheses i.e the order of the hyps in the argument should not
-;change the result of this function.
-   (simplify-hyps1 shyps1 (cons eq-hyp shyps1) eq-hyp '() vl state)))
-                      
-(def propagate (x a hyps concl vl state)
-  (decl :sig ((symbol pseudo-term ;actually a quoted constant
-                      pseudo-term-list pseudo-term fixnum state)
-              -> (mv erp (list pseudo-term-list pseudo-term) state))
-        :mode :program
-        :doc "propagate the assignment of a to variable x by using a utility
-  function from tools/easy-simplify.lisp (earlier I was using
-  expander.lisp). return (mv erp (shyps sconcl) state) where erp might be T
-  indicating discovery of inconsistency/contradiction in the hypotheses")
- (b* ((eq-hyp (list 'equal x a)) ;variable comes first
-      ((er shyps)  (simplify-hyps hyps eq-hyp vl state))
-;IMP: sconcl shud be a pseudo-term; not a term-list, or an IF
-      (- (cw? (system-debug-flag vl)
-"~|CEGen/DEBUG PROPAGATE: ~x0 ---~x1=~x2--> ~x3~|" hyps x a shyps))
-      ((er sconcl) (simplify-term concl (cons eq-hyp shyps) state))
-      (- (cw? (system-debug-flag vl)
-"~|CEGen/DEBUG PROPAGATE: ~x0 ---~x1=~x2--> ~x3~|" concl x a sconcl))
-;TODO: this following check is causing problem in regression
-; May 13 '12
-      ;; ((when (or (pseudo-term-listp sconcl)))
-;;                  ;(eq (ffn-symb sconcl) 'IF)))
-;; ;IF is okay for an and in the conclusion. But will we ever get an IF from
-;; ;inside test-checkpoint??
-;;        (mv (prog2$ 
-;;             (cw? (normal-output-flag vl)
-;; "~|BAD: conclusion got reduced to something we dont want!!~|")
-;;             T)
-;;            (list shyps sconcl) state))
-      (vars (all-vars-lst (cons sconcl shyps))))
-  (assert$ (not (member-eq x vars)) (mv NIL (list shyps sconcl) state))))
-                  
-
-(defun put-val-A (name val dlist)
-  (declare (xargs :guard (symbol-doublet-listp dlist)))
-  (cond ((endp dlist) (list (list name val)))
-        ((equal name (caar dlist))
-         (cons (list name val) (cdr dlist)))
-        (t (cons (car dlist)
-                 (put-val-A name val (cdr dlist))))))
-
-
-
-
-
-; a% represents the snapshot of the beginning of the dpll do-while loop
-(defrec a% (;partial-A is the list of assigns made till now
-            (hyps concl partial-A) ;args to simple search
-            (run-hist . gcs) ;accumulate in simple search
-            ((var . cs) val kind i . inconsistent?) 
-;result of assign and propagate
-            ) 
-  NIL)
-;Take special note of field names: run-hist and gcs, % is intentionally not
-;used in these field names
-(defun a%-p (v)
-  (declare (xargs :guard T))
-  (case-match v
-    (('a% run-hist 
-          (hyps concl partial-A) 
-          (run-hist . gcs) 
-          ((var . cs) val kind i . inconsistent?))
-
-     ;==>
-     (and (pseudo-term-listp hyps)
-          (pseudo-termp concl)
-          (symbol-doublet-listp partial-A)
-          (symbolp var)
-          (pseudo-termp val)
-          (member-eq kind (list :na :implied :decision))
-          (natp i)
-          (booleanp inconsistent?)
-          (cs%-p cs)
-          (run-hist%-p run-hist)
-          (gcs%-p gcs)))))
-                                   
-(defun a%-listp (v) ;STACK
-  (declare (xargs :guard T))
-  (if (atom v)
-      (null v)
-    (and (a%-p (car v))
-         (a%-listp (cdr v)))))
-
-
-; defabbrev was a BAD idea. I should make this a defun, to avoid variable
-; capture bugs. For example I was assigning .. :var x ... instead of :var x1
-; below, where x would have been the previously selected variable and unless I
-; tested carefully I would not have gotten hold of this simple programming err.
-; May 24th '12: making this into a defun
-(def assign-propagate (x1 i a%
-                          H C partial-A 
-                          run-hist% gcs%
-                          type-alist vl ctx wrld state)
-  (decl :sig ((symbol fixnum (oneof a% NIL)
-                      pseudo-term-list pseudo-term symbol-doublet-list
-                      run-hist% gcs% 
-                      symbol-alist fixnum symbol plist-world state)
-              -> (mv erp a% state))
-        :mode :program
-        :doc "assign a value to x1 and propagate this new info to obtain new a%
-if a% arg is NIL o.w obtain the updated a%")
-;NOTE: When assigning, I ignore nconcl constraint. This might change.
-  (b* ((vars (all-vars-lst (cons C H)))
-       (cs% (if a% (access a% cs)
-              (assert$ (member-eq x1 vars)
-                       (cdr (assoc-eq x1 (collect-constraints% 
-                                          H vars type-alist
-                                          vl wrld))))))
-;NOTE: I am not taking into account type constraint from nconcl at the moment.
-       
-       ((mv erp (list a kind i) state) (assign-value x1 i cs%
-                                                   partial-A vl 
-                                                   ctx wrld state))
-       (a% (or a% ;if null, we should make a new record
-               (acl2::make a% 
-                           :hyps H :concl C 
-                           :partial-A partial-A
-                           :run-hist run-hist% :gcs gcs%
-                           :inconsistent? erp :cs cs%
-                           :var x1 :val a :kind kind :i i)))
-       (- (and erp (cw? (normal-output-flag vl)
-"~|Error: assign-value failed!")))
-       ((mv erp (list H~ C~) state) (propagate x1 a H C vl state))
-       (partial-A~  (put-val-A x1 a partial-A));bugfix
-; partial-A is a symbol-doublet-listp
-       (str (if erp 'ACL2::BAD 'ACL2::GOOD))
-       (- (cw? (verbose-flag vl)
-"~|Observation: Propagate assignment was ~x0.~|" str)))
-; But do update i in a% always, and partial-A when consistent
-   (if erp 
-       (mv erp H~ C~ 
-           (acl2::change a% a% :inconsistent? T :i i) 
-           state)
-     (mv erp H~ C~ 
-         (acl2::change a% a%
-                       :inconsistent? NIL
-                       :partial-A partial-A~
-                       :val a :i i)
-         state))))
-
-; concise function call in at least 3 diff functions
-; But this still might be a bad idea, see the comment of (def assign-propagate )
-(defabbrev assign-propagate... (x i a%) 
-  (assign-propagate x i a%
-                    H C partial-A
-                    run-hist% gcs%
-                    type-alist 
-                    vl ctx wrld state))
-
-;mutually tail-recursive incremental (dpll) search prodecure
-(defs 
-  (incremental-search (rem-vars. H C a% A. 
-                                 name type-alist mv-sig-alist ;subgoal params
-                                 N vl sm blimit programp
-                                 ctx wrld state)
-
-; INVARIANTS: 
-; - rem-vars has at least one variable
-; - i in record a% is <= blimit
-; - a%.x is in rem-vars, only when we push a% into A., do we remove its x field
-; from rem-vars
-; - H and C are the result of x=a(a%) propagation
-; - A. stores a list of consistent a% whose run-hist,gcs fields
-;   contain the sigma whose values agree with partial-A for
-;   the common variables
-;   
-
-; - a% stores the most recent select-assign-propagate result
-;   It stores apart from x,a,kind,i and inconsistent?, the
-;   snapshot of run-hist% and gcs% just before x was assigned 'a'
-;   The run-hist and gcs fields are update to reflect the simple-search result
-;   just before pushing a% in A.
-;   a% holds H and C snapshots *before* x was assigned! partial-A though is
-;   updated if we notice a consistent assignment x=a, i.e x=a is at the top of
-;   the stack partial-A. if x=a was inconsistent, we dont put it in
-;   partial-A. partial-A is this just an optimization, instead of recreating it
-;   from A. I simply store the whole partial assignment in the top entry of
-;   A. itself.
-
-; - rem-vars. is disjoint with vars of partial-A stored in top of A.
-    (decl :sig (((and consp true-listp) 
-                 pseudo-term-list pseudo-term a%-p a%-listp 
-                 string symbol-alist symbol-alist
-                 fixnump fixnump (in :random :be :hybrid) fixnump booleanp
-                 symbolp plist-worldp state) -> 
-                (mv erp (list boolean run-hist% gcs%) state))
-        :mode :program
-        :doc "DPLL like algorithm that searches for a non-vacuous assignment to
-the form P (hyps /\ nconcl => nil).  This form returns (mv erp (list stop?
-run-hist% gcs%) state).  The search consists of a Select, Assign, Propagate
-loop.  Any inconsistency in P results in non-chronological backtracking to the
-last decision made in Assign. For more details refer to the FMCAD paper.")
-
-; here are abbreviations for functions with looooong arg lists
-; dont read them, go directly to the body of the function, refer to these
-; abbreviations while reading the main code.
-; NOTE: f* names have defun local scope and not across defuns/clique :(
-
-    (f* ((simple-search... () (simple-search name H C 
-                                             (all-vars-lst (cons C H))
-                                             (access a% partial-A)
-                                             type-alist mv-sig-alist
-                                             (access a% run-hist) 
-                                             (access a% gcs)
-                                             N vl sm programp 
-                                             ctx wrld state))
-         (backtrack... () (backtrack rem-vars. a% A.
-                                     name type-alist mv-sig-alist
-                                     N vl sm blimit programp
-                                     ctx wrld state))
-         
-         (recurse... (H C) (incremental-search rem-vars. H C a% A.
-                                               name type-alist mv-sig-alist
-                                               N vl sm blimit programp
-                                               ctx wrld state)))
-
-    (if (endp (cdr rem-vars.))
-; We have just one variable left in P, dont try anything fancy.
-; bugfix May 25 '12: AND backtrack if you are inconsistent!!
-        (if (access a% inconsistent?)
-            (backtrack...)
-        (simple-search...))
-
-;      in
-       (if (not (access a% inconsistent?))
-           (b* (((mv erp (list stop? run-hist% gcs%) state)
-                 (simple-search...))
-                ((when (or erp stop?))
-; if theres an error or if we reach stopping condition, simply give up search
-                 (mv erp (list stop? run-hist% gcs%) state))
-                ((mv x i) (mv (access a% var) (access a% i)))
-                (partial-A (access a% partial-A))
-                (- (cw? (verbose-flag vl)
-"~|DPLL: Consistent assign to ~x0 whose i = ~x1~|" x i)) 
-
-; keep in mind that we thread run-hist% and gcs% thru the assignments to a
-; single variable. update them now. (Invariant 3)
-                (a% (change a% run-hist run-hist%))
-                (a% (change a% gcs gcs%))
-                (rem-vars. (remove-eq x rem-vars.))
-                (A.        (cons a% A.))
-; ok lets set up variables for the next iteration
-                (P         (cons (dumb-negate-lit C) H))
-                (x1        (select P (debug-flag vl)))
-; TODO: ignoring errors in assign/propagate fun
-;BUGFIX May 24, stupid type bug. The order of a% was wrong below
-                ((mv & H~ C~ a% state) (assign-propagate... x1 0 NIL)))
-;           in
-            (recurse... H~ C~))
-
-
-;      ELSE inconsistent (i.e oops a contradiction found in hyps)
-         
-         (backtrack...)))))
-           
- 
-; sibling procedure in clique
-  (backtrack (rem-vars. a% A. 
-                        name type-alist mv-sig-alist
-                        N vl sm blimit programp
-                        ctx wrld state)
-;PREcondition: (or (eq kind :implied) (> i blimit))
-    (decl :sig (((and consp true-listp) a%-p a%-listp 
-                 string symbol-alist symbol-alist
-                 fixnum fixnum (in :random :be :hybrid) fixnum boolean
-                 symbol plist-world state) 
-                -> (mv erp (list boolean run-hist% gcs%) state))
-         :mode :program
-         :doc "backtrack in dpll like search")
-   
-    (if (or (eq (access a% kind) :implied) 
-            (> (access a% i) blimit)) ;then throw away this a%
-        (if (null A.)
-;       THEN - error out if x0 exceeds blimit
-            (prog2$
-             (cw? (verbose-flag vl)
-"~|Incremental search failed to even satisfy the hypotheses.~|")
-            (mv T (list NIL (access a% run-hist) (access a% gcs)) state))
-;       ELSE
-          (b* ((a% (car A.))
-               (x (access a% var))
-               (- (cw? (verbose-flag vl)
-"~|DPLL: BACKTRACK to x = ~x0 whose i = ~x1~|" x (access a% i)))) 
-           (backtrack (union-eq (list x) rem-vars.)
-                      a% (cdr A.) 
-                      name type-alist mv-sig-alist
-                      N vl sm blimit programp
-                      ctx wrld state)))
-
-;     ELSE a% has a decision which has not reached its backtrack limit
-; i.e  we have on our hands a variable assigned an inconsistent decision
-; that fortunately has not exceeded its backtrack limit yet
-      (b* ((`(a% ,LV & ((,x . &) & & ,i . &)) a%)
-;ACHTUNG: a% defrec exposed
-; H and C are the snapshot just before x was selected
-; partial-A though is the last consistent partial sigma
-           ((list H C partial-A) LV)
-           ((mv run-hist% gcs%) (mv (access a% run-hist) (access a% gcs)))
-           (- (cw? (verbose-flag vl)
-"~|DPLL: Repeat assign propagate: x = ~x0 whose current i = ~x1~|" x i))
-           ((mv & H~ C~ a% state) (assign-propagate... x i a%)))
-       (incremental-search rem-vars. H~ C~ a% A. 
-                           name type-alist mv-sig-alist
-                           N vl sm blimit programp
-                           ctx wrld state)))))
-
-
-(def meet-type-alist (A1 A2 vl wrld)
-  (decl :sig ((symbol-alistp symbol-alistp fixnum plist-world)
-              -> symbol-alistp)
-        :mode :program ;ev-fncall-w
-        :doc "take intersection of types in the type alist")
-; no duplicate keys. A1's ordering is used, it has to contain all the
-; variables that the user wants in his final type-alist
-; A1 and A2 and the return value have type
-; (listof (cons symbolp (listof possible-defdata-type-p)))
-; TODO: if val has more than 1 type, then we treat it as (list 'ALL)
-
-; Usually its called with A1 as the acl2 type alist and A2 as the
-; top-level type alist.
-    (f* ((get-type... (types) (if (and (consp types)
-                                     (null (cdr types)))
-                                (car types)
-                              (prog2$
-                               (cw? (verbose-flag vl)
-       "~|CGen/Warning: throwing type information ~x0 ~|" (cdr types))
-                               (car types))))
-         (eval-and-get-meet (typ1 typ2) ;(quoted-constant sym)|(sym quoted-constant)
-                            (b* (((mv dt st) (if (is-a-variablep typ1)
-                                                 (mv typ1 typ2)
-                                               (mv typ2 typ1)))
-                                 (P (get-predicate-symbol dt))
-                                 ;; args to ev-fncall-w is a list of evaluated values.
-                                 ((mv erp res) (acl2::ev-fncall-w P (list (acl2::unquote st))
-                                                                  wrld nil nil t nil nil))
-                                 (- (cw? (and (not erp) (not res) (debug-flag vl))
-                                         "~|CEgen/Debug:: ~x0 evaluated to nil~|" (cons P (list st))))
-                                 ((when erp)
-                                  (er hard ctx "~|CEgen/Error: ~x0 eval failed~|" (cons P (list st)))))
-                              (if res st 'acl2::empty))))
-  (if (endp A1)
-      nil
-    (b* (((cons var types1) (car A1))
-         (typ1 (get-type... types1))
-         (ctx 'meet-type-alist)
-         (types2-entry (assoc-eq var A2))
-         (types2 (if types2-entry (cdr types2-entry) '(ACL2::ALL)))
-         (typ2 (get-type... types2))
-         (- (assert$ (and (possible-defdata-type-p typ1) 
-                          (possible-defdata-type-p typ2)) t)))
-      (cond ((and (is-a-variablep typ1) (is-a-variablep typ2))
-             (acons var (list (acl2::meet typ1 typ2 wrld))
-                    (meet-type-alist (cdr A1) A2 vl wrld)))
-
-            ((and (is-singleton-type-p typ1)
-                  (is-singleton-type-p typ2)
-                  (equal typ1 typ2))
-             (acons var (list typ1) (meet-type-alist (cdr A1) A2 vl wrld)))
-
-            ((and (is-singleton-type-p typ1)
-                  (is-singleton-type-p typ2))
-             (acons var (list 'acl2::empty) (meet-type-alist (cdr A1) A2 vl wrld)))
-
-            (t
-             (acons var (list (eval-and-get-meet typ1 typ2)) 
-                    (meet-type-alist (cdr A1) A2 vl wrld))))))))
-            
-
-
-;;; The Main counterexample/witness generation function           
-(def cts-wts-search (name H C vars 
-                          type-alist mv-sig-alist
-                          programp defaults 
-                          run-hist% gcs%
-                          ctx wrld state)
-  (decl :sig ((string pseudo-term-list pseudo-term symbol-list
-                      symbol-alist symbol-alist
-                      boolean symbol-alist 
-                      run-hist%-p gcs%-p
-                      symbol plist-world state)
-              -> (mv erp (list boolean s-hist gcs%) state))
-        :mode :program
-        :doc 
-;Note: It does not update the global values @gcs% and @s-hist.
-"
-* Synopsis       
-  Local interface to subgoal-level counterexample and witness
-  search using either naive testing or incremental dpll
-  style search for counterexamples.
-
-* Input parameters
-  - first 8 params other than vars, see def csearch
-  - vars :: free variables of (H=>C) in dependency order
-  - run-hist% :: newly created run-hist% for this subgoal
-  - gcs% :: global gcs%
-  - rest see def csearch
-
-* Output signature 
-  - (mv erp (list stop? run-hist% gcs%) state) where erp is the error tag which is non-nil
-    when an error took place during evaluation of (search ...). 
-    stop? is T if we should abort our search, i.e our stopping
-    condition is satisfied (this value is given by run-tests), 
-    otherwise stop? is NIL (by default). run-hist% and gcs% are 
-    accumulated in the search for cts and wts in the current conjecture
-
-* What it does
-  0. retrieve the various search/testing parameters
-  1. take intersection of acl2 type-alist with top-level one from gcs%.
-  
-  2a. if form has no free variables exit with appropriate return val
-  2b. otherwise call simple or incremental search
-     depending on the search-strategy set in defaults.
-  
-  3. return error triple with value (list stop? run-hist% gcs%)
-")
-
-  
-  (b* ((N (get-acl2s-default 'num-trials defaults 0)) ;shudnt it be 100?
-;Note: I dont need to provide the default arg 0 above, since we are
-;sure the defaults alist we get is complete i.e it would definitely
-;contain the key 'num-trials'. But I am envisioning a scenario, where
-;I might call this function on its own and not via test?, then this
-;functionality is useful for debugging.
-       (vl (get-acl2s-default 'verbosity-level defaults 1))
-       (sm (get-acl2s-default 'sampling-method defaults :random))
-       (ss (get-acl2s-default 'search-strategy defaults :simple))
-       (blimit (get-acl2s-default 'backtrack-limit defaults 2))
-       (top-vt-alist (access gcs% top-vt-alist))
-       (type-alist (meet-type-alist type-alist top-vt-alist vl (w state)))
-         
-       (form  `(implies (and ,@H) ,C)))
-;  in
-   (if (endp (all-vars-lst (cons C H)));(constant-value-expressionp form wrld)
-       ;;dont even try trivial forms like constant expressions
-       (b* (((mv erp c state)
-             (trans-eval-single-value form ctx state))
-            ((mv run-hist% gcs%)
-             (record-testrun. (if c :witness :counterexample)
-                              '() ;CONSTANT
-                              run-hist% gcs%)))
-;       in
-        (prog2$
-         (cw? (verbose-flag vl)
-              "~|CEgen/Note: Stop testing ~x0, it evaluates to a constant ~x1.~%"  
-              name c)
-         (mv erp (list NIL run-hist% gcs%) state)))
-
-;ELSE ATLEAST ONE VARIABLE
-;     in
-      (case ss ;search strategy
-        (:simple      (simple-search name 
-                                     H C vars '()
-                                     type-alist mv-sig-alist
-                                     run-hist% gcs% 
-                                     N vl sm programp
-                                     ctx wrld state))
-                          
-
-        (:incremental (if (endp (cdr vars))
-;bugfix 21 May '12 - if only one var, call simple search
-                          (simple-search name
-                                         H C vars '()
-                                         type-alist mv-sig-alist
-                                         run-hist% gcs% 
-                                         N vl sm programp
-                                         ctx wrld state)
-                        
-                        (b* ((P  (cons (dumb-negate-lit C) H))
-                             (x0 (select P (debug-flag vl)))
-                             (partial-A '())
-                             ((mv & H~ C~ a% state) 
-                              (assign-propagate... x0 0 NIL)))
-;                              in
-                         (incremental-search vars H~ C~ a% '()
-                                             name type-alist mv-sig-alist
-                                             N vl sm blimit programp
-                                             ctx wrld state))))
-                           
-                       
-        (otherwise (prog2$ 
-                    (cw? (normal-output-flag vl)
-"~|CEgen/Error: Only simple & incremental search strategy are available~|")
-                    (mv T NIL state)))))))
-
-   
-
-           
-  
-
-
-(def csearch (name H C 
-                   type-alist mv-sig-alist 
-                   elide-map 
-                   programp defaults 
-                   ctx wrld state)
-  (decl :sig ((string pseudo-term-list pseudo-term 
-                      symbol-alist symbol-alist 
-                      symbol-alist
-                      boolean symbol-alist
-                      symbol plist-world state)
-              -> (mv erp boolean state))
-        :mode :program
-        :doc 
-"
-* Synopsis       
-  Main Interface to searching for counterexamples (and witnesses)
-  in the conjecture (H => C)
-
-* Input parameters
-  - name :: name of subgoal or 'top if run from test?
-  - H :: hyps - the list of terms constraining the cts and wts search
-  - C :: conclusion
-  - type-alist :: types inferred by ACL2 forward-chain
-  - mv-sig-alist :: for each mv fn, stores its output arity
-  - elide-map :: elide-map[v] = term for each elided variable v
-  - programp :: T when form has a program mode fun or we are in :program
-                Its only use is for efficiency. We use guard-checking :none
-                for programp = T and nil otherwise, which is more efficient.
-  - defaults :: alist overiding the current acl2s-defaults
-  - ctx :: usually the top-level form which employed this procedure
-  - wrld :: current acl2 world
-  - state :: state
-
-* Output signature 
-  - (mv erp stop? state) where erp is the error tag which is non-nil
-    when an error took place during evaluation of (search ...). 
-    stop? is T if we should abort our search.
-
-* What it does
-  1. construct a new s-hist-entry% and call cts-wts-search 
-     with globals @gcs, run-hist% and defaults
-  2. the return values of run-hist% (a field in s-hist-entry%), gcs% 
-     are recorded in globals @gcs and @s-hist.
-  3. return error triple containing stop? (described in simple-search)
-")
-
-  (f* ((update-cts-search-globals ()
-         (b* ((- (cw? (debug-flag vl)
-"~|DEBUG: Updating cts-search-globals in csearch~|"))
-              (s-hist-entry% (change s-hist-entry% run-hist run-hist%))
-              ((mv end state) (acl2::read-run-time state))
-              (s-hist-entry% (change s-hist-entry% end-time end))
-              (s-hist (get-s-hist-global))
-;note that name is a string so we use equal instead of eq in put-assoc
-;put the pair (name . s-hist-entry%) in a list (looks like a stack)
-              (s-hist (put-assoc-equal name s-hist-entry% s-hist))
-              (state (put-s-hist-global s-hist))
-              (state (put-gcs%-global gcs%)))
-          state)))
-
-    (b* (((mv start state) (acl2::read-run-time state))
-         (vl (get-acl2s-default 'verbosity-level defaults 1))
-         (vars (vars-in-dependency-order H C vl wrld))
-         (s-hist-entry% (initial-s-hist-entry% name H C vars 
-                                               elide-map start))
-         (run-hist% (access s-hist-entry% run-hist))
-         (gcs% (get-gcs%-global))
-         ((mv erp res state)
-          (cts-wts-search name H C vars 
-                          type-alist mv-sig-alist
-                          programp defaults 
-                          run-hist% gcs%
-                          ctx wrld state))
-         ((unless (and (= 3 (len res))
-                       (booleanp (first res))
-                       (run-hist%-p (second res))
-                       (gcs%-p (third res))))
-          (prog2$ 
-           (cw? (normal-output-flag vl)
-                "~|CEgen/Error : Bad result from cts-wts-search.~|")
-           (mv T nil state)))
-         ((list stop? run-hist% gcs%) res)
-         (state (update-cts-search-globals)))
-      (prog2$ 
-       (and erp
-            (cw? (normal-output-flag vl)
-                 "~|CEgen: Error occurred in call to cts-wts-search.~|"))
-       (mv erp stop? state)))))
-       
-   
-(def csearch-with-timeout (name H C 
-                                type-alist mv-sig-alist
-                                elide-map 
-                                programp defaults 
-                                ctx wrld state)
-  (decl :sig ((string pseudo-term-list pseudo-term 
-                      symbol-alist symbol-alist 
-                      symbol-alist
-                      boolean symbol-alist
-                      symbol plist-world state)
-              -> (mv erp boolean state))
-        :mode :program
-        :doc "wrap csearch with a timeout mechanism")
-  (acl2::with-timeout1
-   (acl2s-defaults :get subgoal-timeout)
-   (csearch name H C type-alist mv-sig-alist
-            elide-map programp defaults 
-            ctx wrld state)
-   (prog2$
-    (cw? (normal-output-flag 
-             (get-acl2s-default 'verbosity-level defaults 1))
-            "~|Search for counterexamples TIMED OUT! ~
-Use (acl2s-defaults :set subgoal-timeout 0) to disable timeout. ~
-For more information see :doc subgoal-timeout.~%")
-; error flag raised. stop? is set to NIL but it doesnt matter I guess.
-    (mv T NIL state))))
-               
-  
-;;list comprehension syntax
-;; (and (true-listp vs)
-;;      (null |[x : x in vs :  (not (possible-defdata-type-p x))]|))
- 
-;NOTE 
-#|(acl2::state-global-let*
-                    ((acl2::inhibit-output-lst
-                      ,(if (system-debug-flag vl)
-                          ''(summary)
-                        ;;shut everything except error
-                        ''(warning warning! observation prove
-                                  proof-checker event expansion
-                                  proof-tree summary)))) 
-                    
-doesnt work on an make-event
-|#
-
-
-(defun test-gen-checkpoint ()
-  (declare (xargs :mode :program))
-  `(:computed-hint-replacement
-     t
-     :backtrack
-     (cond
-      ((eq acl2::processor 'acl2::generalize-clause)
-       (er-let*
-         ((res (test-gen-clause (car clause-list)
-                            state)))
-         (value (cond (res
-                       '(:do-not '(acl2::generalize)
-                         :no-thanks t))
-                      (t nil)))))
-      (t (value nil)))))
-
-(defun initial-subseq-p (x y)
-  (declare (xargs :guard (true-listp x)))
-  (if (endp x)
-      t
-    (and (consp y)
-         (equal (car x) (car y))
-         (initial-subseq-p (cdr x) (cdr y)))))
-
-(defun cl-id-ancestor (parent child)
-  "Sig: clause-id * clause-id -> boolean
-   function: Is parent an ancestor of child in the ACL2 proof tree?"
-  (declare (xargs :mode :program))
-  (and (equal (acl2::access acl2::clause-id parent :forcing-round)
-              (acl2::access acl2::clause-id child :forcing-round))
-       (equal (acl2::access acl2::clause-id parent :pool-lst)
-              (acl2::access acl2::clause-id child :pool-lst))
-       (if (equal (acl2::access acl2::clause-id child :case-lst)
-                  (acl2::access acl2::clause-id parent :case-lst))
-           (or (null (acl2::access acl2::clause-id parent :primes))
-               (and (acl2::access acl2::clause-id child :primes)
-                    (< (acl2::access acl2::clause-id parent :primes)
-                       (acl2::access acl2::clause-id child :primes))))
-         (initial-subseq-p (acl2::access acl2::clause-id parent :case-lst)
-                           (acl2::access acl2::clause-id child :case-lst)))))
-
-        
-#||    
-; walk the table up to the parent and do intersection of the types
-; to find the smallest type
-; TODO - might be unsound - ASK Pete!
-(defun walk-to-parent-and-collect-type-info
-  (id goal-var-info-alst current-vars wrld ans)
-  (declare (xargs :mode :program))
-  (if (endp goal-var-info-alst)
-;ENd of walk(Base case 1), dead code!
-    ans
-    (let* ((curr-entry (car goal-var-info-alst))
-           (curr-id (car curr-entry)))
-;(Base case 2)
-;current subgoal is 'Top of "Goal", do intersection and return result
-      (if (or
-           ;;quickfix a possible bug in cl-id-ancestor 
-           (equal curr-id (acl2::parse-clause-id "Goal"))
-           ;;perhaps called from test? and thm? stop here              
-           (equal curr-id 'Top))
-        (let* ((var-info (cdr curr-entry)) 
-               (vt-alst var-info))
-          (union-vt-and ans vt-alst current-vars wrld))
-;current subgoal is the closest ancestor, do intersection and return result
-        (if (and (not (equal curr-id id))
-                 (cl-id-ancestor curr-id id))
-           ;is closest ancestor 
-          (let* ((var-info (cdr curr-entry)) 
-                 (vt-alst var-info))
-            (union-vt-and ans vt-alst current-vars wrld))
-;else Recursively walk up to the next ancestor
-          (walk-to-parent-and-collect-type-info id 
-                                                (cdr goal-var-info-alst)
-                                                current-vars wrld ans))))))
-||#
-
-;-- 2 functions by Matt, to get elided variable replaced term information --
-(defun get-dest-elim-replaced-terms (elim-sequence)
-  (if (endp elim-sequence)
-    nil
-    (let* ((elt (car elim-sequence))
-           (rhs (nth 1 elt))
-           (lhs (nth 2 elt)))
-      (cons (list rhs lhs)
-            (get-dest-elim-replaced-terms (cdr elim-sequence))))))
-
-
-(defun collect-replaced-terms (hist ans)
-  (declare (xargs :mode :program))
-  (if (endp hist)
-    ans
-    (b* ((H (car hist))
-         (ttree (acl2::access acl2::history-entry H :ttree))
-         (proc (acl2::access acl2::history-entry H :processor))
-         ;(- (cw "DEBUG: proc is ~x0~%" proc))
-         )
-      (cond ((eq proc 'acl2::generalize-clause)
-;Generalize
-             (let ((ans1 
-                    (list-up-lists 
-                     (acl2::tagged-object 'acl2::terms ttree)
-                     (acl2::tagged-object 'acl2::variables ttree))))
-               (collect-replaced-terms 
-                (cdr hist) (append ans1 ans))))
-            ((eq proc 'acl2::eliminate-destructors-clause)
-;Destructor elimination
-             (let* ((elim-sequence 
-                     (acl2::tagged-object 'acl2::elim-sequence ttree))
-                    (ans1 (get-dest-elim-replaced-terms elim-sequence)))
-               (collect-replaced-terms
-                (cdr hist) (append ans1 ans))))
-;Else (simplification and etc etc)
-            (t (let* ((binding-lst 
-                       (acl2::tagged-object 'acl2::binding-lst ttree))
-                      (ans1 (convert-conspairs-to-listpairs binding-lst)))
-                 (collect-replaced-terms
-                  (cdr hist) (append ans1 ans))))))))
-                 
-
-;; The following 2 functions need to be revisited and rewritten if necessary
-(defun let-binding->dep-graph-alst (vt-lst ans)
-  "Walk down the var-term list vt-lst and add edges. 
-   Build graph alist in ans"
-  (if (endp vt-lst)
-      ans
-    (b* (((list var term) (car vt-lst))
-         (fvars (get-free-vars1 term nil)));only non-buggy for terms
-   
-      (let-binding->dep-graph-alst 
-       (cdr vt-lst)
-       (union-entry-in-adj-list var fvars ans)))))
-
-
-(defun do-let*-ordering (vt-lst debug-flag)
-  (declare (xargs :guard (symbol-alistp vt-lst)
-                  :mode :program))
-  (b* ((vars (all-vars-in-var-term-alst vt-lst))
-       (dep-g (let-binding->dep-graph-alst vt-lst 
-                                           (make-empty-adj-list vars)))
-       (sorted-vars (approximate-topological-sort dep-g debug-flag)))
-    (get-ordered-alst (rev sorted-vars) vt-lst nil)))
-#||
-(do-let*-ordering '((X3 '+)
-                    (W1 (CONS W W2))
-                    (X (CONS X1 X2))
-                    (X2 (CONS X3 X4))
-                    (W2 (CONS W4 X3))
-                    (Z (CONS Y X3))
-                    (Y (CONS X X3))
-                    (W (CONS Z Y))) 
-                  nil)
-||#
-
-
-
-;; COPIED FROM acl2-sources/basis.lisp line 12607
-;; because it is program mode there, and verify-termination needed more effort
-;; than I could spare.
-(defun dumb-negate-lit-lst (lst)
-  (cond ((endp lst) nil)
-        (t (cons (dumb-negate-lit (car lst))
-                 (dumb-negate-lit-lst (cdr lst))))))
-
-(def clause-mv-hyps-concl (cl)
-  (decl :sig ((clause) 
-              -> (mv pseudo-term-list pseudo-term))
-        :doc "return (mv hyps concl) which are proper terms given a
-  clause cl. Adapted from prettyify-clause2 in other-processes.lisp")
-  (cond ((null cl) (mv '() ''NIL))
-        ((null (cdr cl)) (mv '() (car cl)))
-        ((null (cddr cl)) (mv (list (dumb-negate-lit (car cl)))
-                              (cadr cl)))
-        (t (mv (dumb-negate-lit-lst (butlast cl 1))
-               (car (last cl))))))
-
-(def clausify-hyps-concl (hyps concl)
-  (decl :sig ((pseudo-term-list pseudo-term)
-              -> clause)
-        :doc "given hyps concl which are proper terms return equivalent
-  clause cl. inverse of clause-mv-hyps-concl")
-  (cond ((and (endp hyps) (equal concl ''NIL)) 'NIL)
-        ((endp hyps) (list concl))
-        ((endp (cdr hyps)) (list (dumb-negate-lit (car hyps)) concl))
-        (t (append (dumb-negate-lit-lst hyps)
-                   (list concl)))))
-
-;TODO- prove a theorem that the above two fns are inverses
-
-(set-verify-guards-eagerness 0)
-(verify-termination acl2::subcor-var1)      
-(verify-termination subcor-var)
-
-;expand-lambda : pseudo-termp -> pseudo-termp (without lambdas)
-(mutual-recursion
- (defun expand-lambda (term)
-   (declare (xargs :guard (pseudo-termp term)))
-   (cond ((variablep term) term)
-         ((fquotep term) term)
-         ((eq (ffn-symb term) 'hide) term)
-         (t
-          (let* ((expanded-args (expand-lambda-lst (fargs term)))
-                 (fn (ffn-symb term)))
-               
-            (cond ((flambdap fn) ;get rid of the lambda application
-                   (subcor-var (lambda-formals fn)
-                               expanded-args 
-                               (expand-lambda (lambda-body fn))))
-                    
-                  (t (acl2::cons-term fn expanded-args)))))))
-
-(defun expand-lambda-lst (term-lst)
-  (declare (xargs :guard (pseudo-term-listp term-lst)))
-  (cond ((endp term-lst) '())
-        (t (cons (expand-lambda (car term-lst))
-                 (expand-lambda-lst (cdr term-lst))))))
-
- )
-
-                      
-
-
-;-------------------------PRINT----------------------------------
-;-------------------------start----------------------------------
-
-
-;; translating bindings in terms of original top goal free variables
-;; added  a flag indicating wether we are printing counterexamples or witnesses
-;; changed |dont care| to ? --Nov26th
-;; counteregp is a flag which tells us that bindings 
-;; that we found is for a counterexample
-;; and is for a witness otherwise. This helps us in checking if the
-;; top-goal bindings and the top-goal orig-clause are consistent 
-;; with the subgoal bindings result.
-;; Pre-condition var-term-alst is in proper let* order, o.w let*
-;; complains
-;; April 30 '12: Return to simple trans-eval with state
-;; we dont care about efficiency wrt ev-w because we only ever print
-;; a small number of cts/wts.
-;; May 13th '12 : better naming
-
-(program) ;; all print functions are program mode funs
-
-(set-verify-guards-eagerness 1)
-
-(defun get-top-level-assignment (A top-vars top-term 
-                                   elided-var-map counteregp state)
-  (declare (xargs :stobjs (state)
-                  :guard (and (symbol-alistp elided-var-map)
-                              (symbol-listp top-vars)
-                              (booleanp counteregp)
-                              (symbol-doublet-listp A))))
-  
-  (b* ((new+elim (all-vars `(list ,@(strip-cadrs elided-var-map))))
-       (bound (strip-cars (append A elided-var-map)))
-       (not-bound (set-difference-eq (union-eq new+elim top-vars) bound))
-       (nil-A (make-constant-value-let-bindings not-bound 'acl2::? nil))
-       (A (append nil-A A))
-       (A (quote-conses-and-symbols-in-bindings A))
-       (bound (strip-cars A))
-;filter out entries due to generalization and cross-fertilization
-       (elided-var-map (remove-entry-lst bound
-;if its already bound why bind it again
-                                         (filter-symbol-keys-in-alist 
-                                          elided-var-map)))
-       (A (append A elided-var-map))
-      
-;; ;TODO: ASK Matt, why is generalization not being captured.
-;; ;Maybe bug in my code!!? CHECK
-;; (thm (implies (true-listp x)
-;;               (equal (rev (rev x)) x))) 
-
-       ((mv ?er res state) 
-        (acl2::state-global-let*
-         ((acl2::guard-checking-on :none))
-         (trans-eval
-          `(let* ,A
-             (declare (ignorable ,@(strip-cars A)))
-             (list ,top-term
-; make list/let A (list `(var ,var) ...) 
-                   ,(make-var-value-list-bindings top-vars nil)))
-          'get-top-level-assignment state T))) ;defttach ok
-       ((list form-eval-res top-A) (cdr res)))
-
-;  in
-   (if (or (and counteregp (not form-eval-res)) 
-;check if its really a counter-example or really a witness
-           (and (not counteregp) form-eval-res)) 
-       (value (list t top-A))
-;only return A if its a true counterexample/witness
-     (value (list nil top-A)))));nil means inconsistent top-level A
-
-;; Print the random instantiations for a particular test run.
-;; Return value is a dummy error-triple. 
-;; This function is called for side-effect only(printing IO)
-;; Binding == (var val) 
-;; added a flag wether bindings are for a counter-example or not
-;; Sep 5th 2011 - removed state, and use cw?
-;; April 30 2012 - put back state!
-(defun print-assignment (A top-vars top-term elided-var-map
-                           vl counteregp state)
-  (declare (xargs :stobjs (state)
-                  :guard (and (symbol-doublet-listp A)
-                              (implies (consp A) (consp (car A)))
-                              (symbol-alistp elided-var-map)
-                              (symbol-listp top-vars)
-                              (booleanp counteregp))))
-                              
-;the usual, but filter the variables that are in the original output clause
-  (b* ((top-A (filter-alist-keys A top-vars))
-       ((unless elided-var-map) ;the simple case
-        (value (cw? (normal-output-flag vl)
-                    "~| -- ~&0~%" top-A)))
-  
-;show top goal, show counterexamples and witness in 
-;terms of the original free variables(of the top clause)
-       ((er (list consistent? top-A))
-        (get-top-level-assignment A top-vars top-term 
-                                  elided-var-map counteregp state))
-
-       ((when consistent?)
-        (value (cw? (normal-output-flag vl)
-                    "~| -- ~&0~%"  top-A))))
-    (if counteregp
-        (progn$
-         (cw? (normal-output-flag vl)
-              "~| -- ~&0~%"  top-A)
-         (cw? (normal-output-flag vl)
-"~|WARNING: The above counterexample is not consistent with top-level form. ~
- This is most likely due to the application of an elim rule that generalized ~
- its parent goal. If that is not what happened, then please report this ~
- example to ACL2s authors.~%")
-         (value nil))
-      (progn$
-       (cw? (normal-output-flag vl)
-            "~| -- ~&0~%"  top-A)
-       (cw? (normal-output-flag vl)
-"~|NOTE: The above witness is not consistent with the top-level form. ~
- Witnesses are only guaranteed to be consistent with subgoals.~%")
-       (value nil))
-       )))
-
-(defun naive-print-bindings (bindings orig-vars verbosity-level)
-  (declare (xargs :guard (and (symbol-doublet-listp bindings)
-                              (symbol-listp orig-vars)
-                              (natp verbosity-level)
-                              (implies (consp bindings)
-                                       (and (consp (car bindings))
-                                            (symbolp (caar bindings)))))))
-;the usual, but filter the variables that are in the original output clause
-  (b* ((out-bindings (acl2::restrict-alist orig-vars bindings ))
-       (vl verbosity-level))
-      (cw? (normal-output-flag vl)
-             "~| -- ~&0~%" out-bindings)))
-  
-
-
-;added a flag indicating wether we are printing counterexamples or witnesses
-(defun print-assignments (A-lst top-vars top-term 
-                               elided-var-map vl counteregp state)
-;perfix-A is assignments made incrementally in dpll search
-  (declare (xargs :stobjs (state)
-                  :guard (and (symbol-alist-listp A-lst)
-                              (symbol-listp top-vars)
-                              (natp vl)
-                              (symbol-alistp elided-var-map)
-                              (booleanp counteregp))))
-   (if (endp A-lst)
-     (value nil)
-     (er-progn
-      (print-assignment (car A-lst) top-vars top-term
-                        elided-var-map vl counteregp state)
-; (naive-print-bindings (convert-conspairs-to-listpairs (car bindings-lst))
-;                       orig-vars vl)
-      (print-assignments (cdr A-lst) top-vars top-term
-                          elided-var-map vl counteregp state))))
-(logic)
-
-
-; 30th Aug '12 keep global track of num of wts/cts to print
-(def print-cts/wts (s-hist cts-p nc nw top-vars top-term vl state)
-  (decl :mode :program
-        :sig ((s-hist-p booleanp symbol-listp all natp state) 
-              -> (mv erp all state))
-        :doc "print all cts/wts A (sigma) in s-hist subgoal testing
-        history alist")
-  (if (endp s-hist)
-      (value nil)
-    (b* (((cons name s-hist-entry%) (car s-hist))
-         (run-hist% (access s-hist-entry% run-hist))
-         (hyps      (access s-hist-entry% hyps))
-         (concl     (access s-hist-entry% concl))
-         ((when (and cts-p (zp nc)))
-; number of cts yet to be printed is zero, skip 
-          (value nil))
-         ((when (and (not cts-p) (zp nw))) 
-; number of wts yet to be printed is zero, skip 
-          (value nil))
-         
-         (A-lst (if cts-p 
-                    (access run-hist% cts)
-                  (access run-hist% wts)))
-         (elide-map (access s-hist-entry% elide-map))
-         (- (cw? (debug-flag vl) 
-"~|DEBUG/print-cts/wts: A-lst:~x0 top-vars:~x1 elide-map:~x2~|" 
-A-lst top-vars elide-map))
-         ((when (endp A-lst)) 
-; none found, so move on to the next subgoal
-          (print-cts/wts (cdr s-hist) cts-p 
-                         nc nw top-vars top-term vl state))
-         (nc (- nc (if cts-p (len A-lst) 0)))
-         (nw (- nw (if cts-p 0 (len A-lst))))
-         (- (cw? (normal-output-flag vl) "~| [found in : ~x0]~%" name))
-         (cl (clausify-hyps-concl hyps concl))
-         (pform (acl2::prettyify-clause cl nil (w state)))
-         (- (cw? (and (not (equal "top" name))
-                      cts-p
-                      (normal-output-flag vl)) "~x0~%" pform))
-         )
-     (er-progn
-      (print-assignments A-lst top-vars top-term elide-map vl cts-p state)
-      (print-cts/wts (cdr s-hist) cts-p nc nw top-vars top-term vl state)))))
-
-
-(def print-s-hist (s-hist printc? printw? nc nw 
-                          top-term top-vars vl state)
-;nc and nw are the number of cts/wts requested by user (acl2s defaults)
-  (decl :mode :program
-        :sig ((s-hist-p bool bool natp natp 
-                        pseudo-termp symbol-list fixnum state) 
-              -> (mv erp all state))
-        :doc "print counterexample and witnesses recorded in testing subgoal
-history s-hist.")
-  (b* (((er &) (if printc?
-                   (prog2$
-                    (cw? (normal-output-flag vl)
-"~|~%We falsified the conjecture. Here are counterexamples:~|")
-                    (print-cts/wts s-hist T nc nw top-vars top-term vl state))
-                 (value nil)))
-
-       ((er &) (if printw?
-                   (prog2$
-                    (cw? (normal-output-flag vl)
-"~|~%Cases in which the conjecture is true include:~|")
-                    (print-cts/wts s-hist NIL nc nw top-vars top-term vl state))
-                 (value nil))))
-    (value nil)))
-(logic)
-
-  
-;for trace$ debugging - remove when satisfied 
-(defun my+ (a b) (+ a b))
-(defun my- (a b) (- a b))
-
-(def total-time-spent-in-testing (s-hist)
-  (decl :sig ((s-hist-p) -> rationalp)
-        :doc "calculate testing time across subgoals")
-  (if (endp s-hist)
-      0
-    (b* (((cons & s-hist-entry%) (car s-hist)))
-     (my+ (my- (access s-hist-entry% end-time)
-               (access s-hist-entry% start-time))
-          (total-time-spent-in-testing (cdr s-hist))))))
-      
-  
-
-(defun print-testing-summary-fn (vl state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-  (b* ((ctx 'print-testing-summary)
-;when testing errored out or timed out, theres no point of printing.
-       (s-hist (get-s-hist-global))
-       (gcs%   (get-gcs%-global))
-       (- (cw? (debug-flag vl) "~|testing summary - gcs% = ~x0~%" gcs%))
-       (- (cw? (debug-flag vl) "~|testing summary - s-hist = ~x0~%" s-hist))
-       ((unless (and (consp s-hist) (consp (car s-hist))
-                     (> (access gcs% total-runs) 0)))
-        (value (cw? (normal-output-flag vl) 
-"~|No testing summary to print~|")))
-                  
-       (num-subgoals (len s-hist))
-       
-       )
-   (case-match gcs%
-     (('gcs% (total dups . vacs) 
-             (num-cts . num-wts) 
-             (cts-to-reach . wts-to-reach) 
-             (start . end) & . &)
-;ACHTUNG: gcs% defrec exposed
-      (b* ((uniq-runs  (my+ num-wts num-cts))
-           (sat-runs (my- total (my+ vacs dups)))
-           (delta-t-total (my- end start))
-           (delta-testing-t-total (total-time-spent-in-testing s-hist))
-           (-  (cw? (normal-output-flag vl) 
-                "~%**Summary of testing**~%"))
-           (top-term (access gcs% top-term))
-           (pform (acl2::prettyify-clause 
-                   (list top-term) nil (w state)))
-           (- (cw? (verbose-flag vl)
-                   "~x0~%" pform))
-           (- (cw? (normal-output-flag vl)
-               "~|We tested ~x0 examples across ~x1 subgoals, of which ~x2 (~x3 unique) satisfied the hypotheses, and found ~x4 counterexamples and ~x5 witnesses.~%"
-               total num-subgoals sat-runs uniq-runs num-cts num-wts))
-
-           (- (cw? (verbose-flag vl)
-               "~|The total time taken (incl. prover time) is "))
-; from Matt's save-time book
-           ((er &) (if (verbose-flag vl)
-                       (pprogn (print-rational-as-decimal delta-t-total
-                                                      (standard-co state)
-                                                      state)
-                           (princ$ " seconds" (standard-co state) state)
-                           (newline (standard-co state) state)
-                           (value :invisible))
-                     (value nil)))
-
-           (- (cw? (verbose-flag vl)
-               "~|The time taken by testing is "))
-           ((er &) (if (verbose-flag vl)
-                       (pprogn (print-rational-as-decimal delta-testing-t-total
-                                                      (standard-co state)
-                                                      state)
-                           (princ$ " seconds" (standard-co state) state)
-                           (newline (standard-co state) state)
-                           (value :invisible))
-                     (value nil)))
-           (top-vars (all-vars top-term))
-           ((er &)  (print-s-hist s-hist 
-                                  (> num-cts 0);print cts if true
-                                  (> num-wts 0);print wts if true
-                                  cts-to-reach wts-to-reach 
-                                  top-term top-vars
-                                  vl state)))
-       (value nil)))
-     (& (value (cw? (normal-output-flag vl) "~|BAD gcs% found in globals~|"))))))
-
-
-
-
-;----------------------------------------------------------------
-;                         PRINT end                             |
-;----------------------------------------------------------------
-
-;The following 2 function only look at the outermost implies form
-;get hypothesis from acl2 term being proved.
-(defun get-hyp (form)
-  (declare (xargs :guard t))
-  (if (atom form)
-    t;no hyps is equivalent to true
-    (if (and (consp (cdr form))
-             (eq 'implies (first form)))
-      (second form)
-      t)));;no hyps is equivalent to true
-
-; use expand-assumptions-1 instead when you have a term
-(defun get-hyps (pform)
-  (declare (xargs :guard t))
-  (b* ((hyp (get-hyp pform))
-       ((when (eq hyp 't)) nil)
-       ((unless (and (consp hyp)
-                     (consp (cdr hyp))
-                     (eq (car hyp) 'and)))
-        (list hyp))
-       (rst (cdr hyp)))
-    rst))
-
-
-;get conclusion from acl2 term being proved
-(defun get-concl (form)
-  (declare (xargs :guard t))
-  (if (atom form)
-    form
-    (if (and (consp (cdr form))
-             (consp (cddr form))
-             (eq 'implies (first form)))
-      (third form)
-      form)))
-
-
-
-(defun get-acl2-type-alist (cl name ens vl state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-  (b* (((mv erp type-alist &)
-       (acl2::forward-chain cl
-                            (acl2::enumerate-elements cl 0)
-                            nil ; do not force
-                            nil ; do-not-reconsiderp
-                            (w state)
-                            ens
-                            (acl2::match-free-override (w state))
-                            state))
-;Use forward-chain ACL2 system function to build the context
-;This context, gives us the type-alist ACL2 inferred from the
-;the current subgoal i.e. cl
-       (vars (all-vars-lst cl))
-       (vt-acl2-alst (if erp ;contradiction
-                         (pairlis$ vars (make-list (len vars)
-                                                   :initial-element 
-                                                   (list 'ACL2::ALL)))
-                       (acl2::decode-acl2-type-alist type-alist vars)))
-       (- (cw? (debug-flag vl) 
-"~|CEgen/Debug: ACL2 type-alist (~s0): ~x1~|" name vt-acl2-alst)))
-   vt-acl2-alst))
-   
-  
-
-(defun cts-wts-search-clause (cl name mv-sig-alist ens hist abo? 
-                                 vl ctx wrld state)
-  "helper function for test-checkpoint. It basically sets up 
-   everything for the call to csearch."
-  (declare (xargs :stobjs (state) :mode :program))
-                  
-  (b* (((when abo?) (mv nil nil state)) 
-        ;; if subgoal is not equivalid, dont even test it.
-        
-       (vt-acl2-alst (get-acl2-type-alist cl name ens vl state))
-       ((mv hyps concl) (clause-mv-hyps-concl cl))
-       
-       (elided-var-map (collect-replaced-terms hist nil))
-       ;; Ordering is necessary to avoid errors in printing top-level cts
-
-       (ord-elide-map (do-let*-ordering elided-var-map (debug-flag vl)))
-       (defaults (acl2s-defaults-alist)))
-;   in       
-    (csearch name hyps concl 
-             vt-acl2-alst mv-sig-alist
-             ord-elide-map 
-             NIL defaults 
-             ctx wrld state)))
-
-
-(def type-alist-infer-from-term (term vl wrld ans.)
-  (decl :sig ((pseudo-term-listp fixnum plist-worldp symbol-alistp) 
-              -> symbol-alistp)
-        :doc "main aux function to infer type-alist from term")
-; ans. is a type alist and has type
-; (symbol . (listof possible-defdata-type-p))
-  (f* ((add-eq-typ... (t1) (if (acl2::equivalence-relationp R wrld)
-                               (put-assoc x (list t1) ans.)
-                             ans.)))
-    
-; Copied from v-cs%-alist-from-term. Keep in sync!
-  (case-match term
-    
-;the following is a rare case (I found it when the conclusion is nil
-;and its negation is 'T
-    (('quote c) (declare (ignore c))  ans.) ;ignore quoted constant terms 
-
-;TODO possible field variable (i.e f is a getter/selector) Note that
-; term cannot have a lambda applicaton/let, so the car of the term is
-; always a function symbol if term is a consp.
-    ((P (f . &)) (declare (ignore P f))  ans.)
-
-;x has to be an atom below, otherwise, we would have caught that case above.
-    (('not x)      (put-assoc x (list ''nil) ans.))
-    
-    ((P x)   (b* ((tname (is-type-predicate P wrld))
-                  ((unless tname) ans.)
-                  (curr-typs-entry (assoc-eq x ans.))
-                  ((unless (and curr-typs-entry 
-                                (consp (cdr curr-typs-entry))))
-; no or invalid entry, though this is not possible, because we call it with
-; default type-alist of ((x . ('ALL)) ...)
-                   ans.)
-                  (curr-typs (cdr curr-typs-entry))
-                  (- (cw? (and (verbose-flag vl) 
-                               (consp (cdr curr-typs)))
-"~|CGen WARNING: Ignoring union types ~x0 ~|" curr-typs))
-                     
-                  (curr-typ (car curr-typs))
-                  ((when (possible-constant-valuep curr-typ)) ans.)
-                   
-                  (final-typ (acl2::meet tname curr-typ wrld)))
-               (put-assoc x (list final-typ) ans.)))
-
-    ((R (f . &) (g . &)) (declare (ignore R f g)) ans.) ;ignore
-
-;x has to be an atom below, otherwise, we would have caught that case
-;above.
-    ((R x ('quote c))    (add-eq-typ... (kwote c)))
-    ((R ('quote c) x)    (add-eq-typ... (kwote c)))
-    ;((R x (f . args))    (add-eq-constraint... (acl2::cons-term f args)))
-    ;((R (f . args) x)    (add-eq-constraint... (acl2::cons-term f args)))
-    
-    ;; has to be a (R t1 t2 ...) or atomic term
-    (&                   ans.))))
-
-(def type-alist-infer-from-terms (H vl wrld ans.)
-  (decl :sig ((pseudo-term-listp fixnum plist-worldp 
-                                 symbol-alistp) -> symbol-alistp)
-        :doc "aux function for dumb extraction of defdata types from terms in H")
-  (if (endp H)
-      ans.
-    (b* ((term (car H))
-         (ans. (type-alist-infer-from-term term vl wrld ans.)))
-      (type-alist-infer-from-terms (cdr H) vl wrld ans.))))
-
-(def dumb-type-alist-infer (H vars vl wrld)
-  (decl :sig ((pseudo-term-listp symbol-listp fixnum plist-worldp) 
-              -> symbol-alistp)
-        :doc "dumb infer defdata types from terms in H")
-  (type-alist-infer-from-terms 
-   H vl wrld (pairlis$ vars (make-list (len vars)
-                                       :initial-element 
-                                       (list 'ACL2::ALL)))))
-
-#|     
-(defthm obvious1 
-  (implies (and (pseudo-termp s)
-                (not (variablep s))
-                (not (fquotep s))
-                (not (consp (ffn-symb s))))
-           (symbolp (ffn-symb s))))
-      
-(defthm obvious2
-  (implies (and (symbolp a)
-                (symbol-listp l))
-           (symbol-listp (add-to-set-eq a l))))
-|#
-
-(mutual-recursion
-(defun all-functions. (term ans.)
-  "gather all functions in term"
-  (declare (xargs :verify-guards nil
-                  :guard (and (pseudo-termp term)
-                              (symbol-listp ans.))))
-  (if (variablep term)
-      ans.
-    (if (fquotep term)
-        ans.
-      (let ((fn (ffn-symb term))
-            (args (fargs term)))
-        (if (consp fn) ;lambda
-            (all-functions-lst. args ans.)
-          (all-functions-lst. args (add-to-set-eq fn ans.)))))))
-
-(defun all-functions-lst. (terms ans.)
-  (declare (xargs :verify-guards nil
-                  :guard (and (pseudo-term-listp terms)
-                              (symbol-listp ans.))))
-  (if (endp terms)
-      ans.
-    (all-functions-lst.
-     (cdr terms) 
-     (union-eq (all-functions. (car terms) ans.) 
-               ans.)))))
-#|      
-(defthm all-functions.-type
-  (implies (and (symbol-listp a)
-                (pseudo-termp term))
-           (symbol-listp (all-functions. term a)))
-  :hints (("Goal" :induct (all-functions. term a))))
-Why is ACL2 not good at this?
-|#
-
-;(verify-guards all-functions.)
-
-(defun all-functions (term)
-  (all-functions. term '()))
-
-(defun all-functions-lst (terms)
-  (all-functions-lst. terms'()))
-
-(verify-termination acl2::logical-namep)
-
-(defun all-functions-definedp-lst (fns wrld)
-  "are all the functions used in fns executable?"
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbol-listp fns)
-                              (plist-worldp wrld))))
-  (if (endp fns)
-      T
-    (and (acl2::logical-namep (car fns) wrld)
-         (all-functions-definedp-lst (cdr fns) wrld))))
-
-
-;; 21th March 2013
-;; CHeck for multiple valued functions and functions having
-;; stobjs in their arguments and return values.
-
-(defun unsupported-fns (fns wrld)
-  "gather functions that 
-1. take stobjs as args
-2. constrained (encapsulate) and no attachment"
-  (if (endp fns)
-      nil
-    (let* ((fn (car fns))
-           (constrainedp (acl2-getprop fn 'acl2::constrainedp wrld :default nil))
-           (att (acl2-getprop fn 'acl2::attachment wrld :default nil)))
-          
-      (if (or (or-list (acl2::stobjs-in fn wrld))
-              (and constrainedp
-                   (null att)))
-          (cons fn (unsupported-fns (cdr fns) wrld))
-        (unsupported-fns (cdr fns) wrld)))))
-  
-
-;; collect output signature arity of all multi-valued fns
-(defun mv-sig-alist (fns wrld)
-  "for each fn with output arity n>1, the result alist
-   will have an entry (fn . n)"
-  (declare (xargs :guard (and (symbol-listp fns)
-                              (plist-worldp wrld))))
-                                    
-  (if (endp fns)
-      nil
-    (let* ((fn (car fns))
-           (stobjs-out ;(acl2::stobjs-out fn wrld))) program mode
-            (acl2-getprop fn 'acl2::stobjs-out wrld :default '(nil))))
-      (if (and (consp stobjs-out)
-               (consp (cdr stobjs-out))) ;(mv * ...)
-          (acons fn (len stobjs-out)
-                 (mv-sig-alist (cdr fns) wrld))
-        (mv-sig-alist (cdr fns) wrld)))))
-
-
-
-; Catch restrictions, warn and skip testing/csearch
-(defun cgen-exceptional-functions (terms vl wrld) ;clause is a list of terms
-  "return (mv all-execp unsupportedp mv-sig-alist)"
-  (declare (xargs :verify-guards nil
-                  :guard (pseudo-term-listp terms)))
-  (b* ((fns (all-functions-lst terms))
-       (all-execp (all-functions-definedp-lst fns wrld))
-       (- (cw? (and (not all-execp) (verbose-flag vl))
-"~|CEgen Note: Skipping testing completely, since not all
-functions in this conjecture are defined.~%"))
-       (unsupportedp (consp (unsupported-fns fns wrld)))
-       (- (cw? (and unsupportedp (verbose-flag vl))
-"~|CEgen Note: Skipping testing completely, since some
-functions in this conjecture either take stobj arguments 
-or are constrained without an attachment.~%")))
-    (mv all-execp unsupportedp (mv-sig-alist fns wrld))))
-       
-         
-
-(defun update-gcs%-top-level-fields (term vl ctx state)
-  (declare (xargs :mode :program 
-                   :stobjs (state)))
-
-  (b* ((cse-stack (@ cgen-stats-event-stack))
-       ((when ;(acl2::function-symbolp 'inside-test? (w state))
-            (and (consp cse-stack)
-                 (consp (cdr cse-stack))
-; if the second item is an inside-test? entry, then the first one would
-; be a copy of it, and we better not initialize our own globals
-                 (assoc-keyword :inside-test? (cadr cse-stack))))
-        state);dont overwrite initial work by test? i.e "top" entry
-
-       ;; update 
-       (gcs% (get-gcs%-global))
-       (gcs% (change gcs% top-term term))
-; ACHTUNG - get-hyps only looks at outermost implies.
-       ((mv hyp concl) (mv (get-hyp term) (get-concl term)))
-       (hyps (if (eq hyp 't) '() (acl2::expand-assumptions-1 hyp)))
-       (vars (vars-in-dependency-order hyps concl vl (w state)))
-       (d-type-al (dumb-type-alist-infer
-                   (cons (dumb-negate-lit concl) hyps) vars vl (w state)))
-       (gcs% (change gcs% top-vt-alist d-type-al))
-       (- (cw? (debug-flag vl)
-               "~|INTERNAL: update-top : ~x0 dumb top vt-alist: ~x1 ~|"
-               term d-type-al))
-       (state (put-gcs%-global gcs%)) ;in top of cse-stack
-       )
-;   in 
-    state))
-
-        
-;; The following function implements a callback function (computed hint)
-;; which calls the counterexample generation testing code. Thus the
-;; the so called "automated" combination of testing and theorem proving
-;; is enabled naturally by the computed hints feature in the
-;; engineering design of ACL2 theorem prover.
-;; If somebody reads this comment, I would be very interested in any other
-;; theorem-provers having a call-back mechanism in their implementation.
-(defun acl2::test-checkpoint (id cl cl-list processor pspv hist ctx state)
-  (declare (xargs :stobjs (state)
-                  :mode :program))
-
-;;   (decl :sig ((symbol clause symbol any any state) -> (mv erp boolean state))
-;;         :mode :program
-;;         :doc
-;; "?:
-;; This function uses override hint + backtrack no-op hint combination.
-;;  On SUBGOALS 
-;; that are not checkpoints does no-op. On checkpoints it calls the 
-;; cts search procedure. Note that this (observer) hint combination
-;; means that when this callback function is called, that particular
-;; processor had a HIT and resulted in one or more subgoals, each of
-;;  which will fall on top of the waterfall like in a Escher drawing.
-;; ")
-; RETURN either (mv t nil state) or (mv nil nil state) 
-; PRECONDITION -
-; INVARIANT - no new prove call is made during the computation of this
-; function (this is very important, but now I can relax this invariant,
-; with the introduction of post and pre functions at event level)
-  (acl2::with-timeout1 
-   (acl2s-defaults :get subgoal-timeout)
-   (b* (
-;TODObug: test? defaults should be the one to be used
-       (vl (acl2s-defaults :get verbosity-level))
-       ((mv all-execp unsupportedp mv-sig-alist) 
-        (cgen-exceptional-functions cl vl (w state)))
-;27 June 2012 - Fixed bug, in CCG, some lemmas are non-executable, since they
-;involve calling the very function being defined. We should avoid testing
-;anything that is not executable.
-       ((unless all-execp)
-        (value nil))
-; 21st March 2013 - catch stobj taking and constrained functions, skip testing.
-       ((when unsupportedp)
-        (value nil))
-     
-
-
-       (- (cw? (debug-flag vl)
-"test-checkpoint : id=~x0 processor=~x1 ctx= ~x2 ~ formula=~x3 hist-len=~x4~|" 
-id processor ctx (acl2::prettyify-clause cl nil (w state)) (len hist)))
- 
-       ((unless (member-eq processor
-                           '(;acl2::preprocess-clause
-                             ;;acl2::simplify-clause
-                             acl2::settled-down-clause 
-                             acl2::eliminate-destructors-clause
-                             acl2::fertilize-clause
-                             acl2::generalize-clause
-                             acl2::eliminate-irrelevance-clause
-                             acl2::push-clause)))  
-; NOTE: I can also use (f-get-global 'checkpoint-processors state)
-        (value nil));ignore backtrack hint
-       
-       (name (acl2::string-for-tilde-@-clause-id-phrase id))
-       (wrld (w state))
-       (gcs% (get-gcs%-global))
-       (top-level-term (acl2::access acl2::prove-spec-var 
-                                     pspv :user-supplied-term))
-       (state (if (equal (ffn-symb (access gcs% top-term))
-                         'dummy-topform)
-                  (update-gcs%-top-level-fields top-level-term vl ctx state)
-                state))
-       
-       (- (cw? (verbose-flag vl)
-"~|CEgen/Note: At checkpoint ~x0 ~x1~|" name processor))
-       (ens (acl2::access acl2::rewrite-constant
-                          (acl2::access 
-                           acl2::prove-spec-var pspv :rewrite-constant)
-                          :current-enabled-structure))
-       
-       ((mv & stop? state) 
-        (cts-wts-search-clause cl name mv-sig-alist
-                               ens hist
-                               (access gcs% all-bets-off?)
-                               vl ctx wrld state))
-       (gcs% (get-gcs%-global)) ;gcs% updated by the above csearch
-       
-;;; Jan 10th 2013 - Not printing at subgoal TODO
-       ;; ((er &) (if (and (> (access gcs% cts) 0)
-;; ;1. only print summary if there is a counterexample
-;; ;2. dont bother with test?, since test? does give a summary at the end
-;;                         (not (acl2::function-symbolp 'inside-test? (w state)))
-;;                         (acl2s-defaults :get acl2::acl2s-pts-subgoalp))
-;;                    (print-testing-summary-fn vl state)
-;;                  ;; else (assign print-summary-user-flag T)
-;;                  (value nil)))
-       
-; Assumption Jan 6th 2013 (check with Matt)
-; We only arrive here with processor P, if it was a hit i.e if P
-; is fertilize-clause then cross-fertilization was successful and
-; potentially the generalization was unsound.
-       (all-bets-off? (member-eq processor
-                                 '(acl2::fertilize-clause
-                                   acl2::generalize-clause
-                                   acl2::eliminate-irrelevance-clause)))
- ; Monotonic change from nil to t, so its okay if we repeat it.                        
-       (gcs% (if all-bets-off?
-                 (prog2$ 
-                  (cw? (debug-flag vl) 
-                       "~| All bets off ... ~x0 in ~x1~%" name ctx)
-                  (change gcs% all-bets-off? t))
-               gcs%))
-; update gcs% in globals. so gcs% and global gcs% are in sync
-       (state (put-gcs%-global gcs%))
-       )
-   
-   
-;  in  
-   (if (or stop?
-           (and (> (access gcs% cts) 0)
-                (or (access gcs% all-bets-off?)
-                    (eq processor 'acl2::push-clause))))
-; jan 6th 2013
-; why bother continuing with a generalized (possibly unsound) subgoal
-; or an induction when we already have found a counterexample.
-; simply abort!
-
-;Note: On abort, we *always* print the summary unless its a test? form!
-       (er-progn
-        (if (let ((cse-stack (@ cgen-stats-event-stack)))
-              (and (consp cse-stack)
-                   (consp (cdr cse-stack))
-                   (assoc-keyword :inside-test? (cadr cse-stack))))
-            ;(acl2::function-symbolp 'inside-test? (w state))
-            (value nil)
-; Lets update the global end time before printing. 18th March 2013
-; Note: end-time is not updated in case of no abort. But
-; thats fine, since the user has no way of asking cgen
-; to print testing summary after returning from a thm/test?. 
-          (b* (((mv end state) (acl2::read-run-time state))
-               (gcs%  (get-gcs%-global))
-               (gcs%  (change gcs% end-time end))
-               (state (put-gcs%-global gcs%)))
-            (print-testing-summary-fn vl state)))
-        (mv t nil state))
-
-; Check for false generalizations. TODO also do the same for
-; cross-fertilization and eliminate-irrelevance if its worth the trouble
-     (if (equal processor 'acl2::generalize-clause)
-         ;NOTE: this pspv is for the cl not for cl-list, so there
-         ;might be some inconsistency or wierdness here
-         (b* ((gen-cl (car cl-list))
-              (ens (acl2::ens state)) ;get current ens, not parent's.
-; 2nd April 2013 - the pspv and hist passed are the parent's (CHECK)
-              (type-alist (get-acl2-type-alist gen-cl name ens vl state))
-              ((mv H C) (clause-mv-hyps-concl gen-cl))
-              (vars (vars-in-dependency-order H C vl wrld))
-
-;TODO.now- check the type of vt-alist.
-              (vt-alist (pairlis$ vars (make-list (len vars)
-                                                  :initial-element 
-                                                  (list 'ACL2::ALL))))
-              (term (if (null H)
-                        C
-                        `(implies (and ,@H) ,C)))
-; the above is not really a term, but almost, we can assume AND is a function.
-; hopefully it will not affect any computation based on it, certainly will
-; not affect all-vars. CHECK! 20th March 2013
-
-              ((mv & & mv-sig-alist)
-; 21st March 2013 - Safe to assume that restricted funs will be caught
-; higher up in the waterfall.
-               (cgen-exceptional-functions gen-cl vl (w state)))
-
-              ((mv erp (list & run-hist% &) state)
-               (cts-wts-search name H C vars
-                           type-alist mv-sig-alist NIL
-                           (acl2s-defaults-alist) 
-                           *initial-run-hist%* 
-; we dont care about witnesses and the start time and do no accumulation.
-                           (initial-gcs% 1 0 0 term vt-alist)
-                           ctx wrld state))
-              (num-cts-found (access run-hist% |#cts|)))
-          (value (if (and (not erp)
-                          (> num-cts-found 0))
-                     (progn$ 
-                      (cw? (normal-output-flag vl) "~| Generalized subgoal: ~x0~|" 
-                           (acl2::prettyify-clause gen-cl nil (w state)))
-                      (cw? (normal-output-flag vl)
-                           "~| Counterexample found: ~x0 ~|"
-                           (car (access run-hist% cts)))
-                      (cw? (normal-output-flag vl) "~| Backtracking...~|")
-                      '(:do-not '(acl2::generalize)
-                                :no-thanks t))
-                   nil)))
-;ignore errors in cts search function
-       (value nil))))
-   (prog2$
-    (cw? (normal-output-flag (acl2s-defaults :get verbosity-level))
-         "~| Subgoal counterexample search TIMED OUT!~%")
-    (value nil))
-   ))
-
-
-
-
-
-;Dont print the "Thanks" message:
-(defmacro dont-print-thanks-message-override-hint ()
-`(make-event  
-  '(acl2::add-override-hints 
-    '((cond ((or (null acl2::keyword-alist)
-                 (assoc-keyword :no-thanks acl2::keyword-alist))
-             acl2::keyword-alist)
-            (t
-             (append '(:no-thanks t) acl2::keyword-alist)))))))
-       
-
-     
-;Note on xdoc: <= or < cannot be used inside defxdoc!!
-
-(def test?-fn (form hints override-defaults dont-pts? ctx wrld state)
-; Jan 9th 2013, dont print summary unless there was a counterexample.
-  (decl :mode :program
-        :sig ((any true-list symbol-alist symbol plist-world state) 
-              -> (mv erp any state))
-        :doc "gives an error triple wrapping a form that will be ... ")
-  (f* ((check-syntax   (form logicp) (acl2::translate form  T logicp T 
-                                                      "test? check" 
-                                                      wrld state)))
-   (b* ((defaults (acl2s-defaults-alist override-defaults))
-        (testing-enabled (get-acl2s-default 'testing-enabled defaults))
-        (vl              (get-acl2s-default 'verbosity-level defaults))
-        ((when (eq testing-enabled NIL)) ;dont do any testing
-         (value '(value-triple :invisible))))
-    
-    (acl2::state-global-let*
-     ((acl2::inhibit-output-lst 
-       (if (system-debug-flag vl)
-           '(summary)
-         '(warning warning! observation prove
-                   proof-checker event expansion
-                   proof-tree summary))))
-
-     
-     (b* (((mv erp term state) (check-syntax form NIL))
-          ((when erp)          
-           (prog2$
-            (cw? (normal-output-flag vl) 
-                 "~|TEST?: The input form is ill-formed, see below:~%")
-;show error to user which was invisble earlier
-            (acl2::state-global-let*
-             ((acl2::inhibit-output-lst '(summary)))
-             (acl2::translate form  T NIL T 
-                              "test? check" 
-                              (w state) state))))
-
-          ((mv all-execp unsupportedp mv-sig-alist) 
-           (cgen-exceptional-functions (list term) vl (w state)))
-; 21st March 2013 - catch stobj taking and constrained functions, skip testing.
-          ((unless all-execp)  (value '(value-triple :invisible))) ;possible with test? ?
-          ((when unsupportedp) (value '(value-triple :invisible)))
-
-          
-          
-; No syntax error in input form, check for program-mode fns
-; Note: translate gives nil as the term if form has
-; a program-mode function, so we ignore it
-          ((mv pm? & state)    (check-syntax form T))
-          (programp            (or pm?
-                                   (eq (default-defun-mode (w state)) 
-                                       :program)))
-
-          (- (cw? (debug-flag vl)
-                  "~%~%CEgen/Debug: (pm? ~x0) ~x1~|" programp (cons 'test? form))) 
-
-          ;; get rid of lambdas i.e let/let*
-          (term  (expand-lambda term))
-          (pform (acl2::prettyify-clause (list term) nil wrld))
-          
-          ((mv phyps pconcl)  (mv (get-hyps pform) (get-concl pform)))
-          
-          ((er hyps) (acl2::translate-term-lst phyps 
-                                               t nil t "test?" wrld state)) 
-          ((er concl) (acl2::translate pconcl t nil t "test?" wrld state))
-
-; initialize these per test?/thm/defthm globals that store information
-; across subgoals in a single thm event
-          ((mv start-top state) (acl2::read-run-time state))
-          
-          (cse-stack (@ cgen-stats-event-stack))
-          ((unless (cgen-stats-event-stackp cse-stack)) ;can be empty
-           (er soft ctx "~|CEgen/Error: cgen-stats-event-stack is ill-formed~|"))
-          (vars (all-vars term))
-          (d-type-al (dumb-type-alist-infer 
-                      (cons (dumb-negate-lit concl) hyps)
-                      vars vl (w state)))
-          (- (cw? (debug-flag vl) 
-                 "~|CEgen/Debug: top-level type-alist = ~x0~|" d-type-al))
-          (gcs%  (initial-gcs% 
-                  (get-acl2s-default 'num-counterexamples defaults)
-                  (get-acl2s-default 'num-witnesses defaults)
-                  start-top term d-type-al))
-; PUSH an entry March 7th 2013
-; I need to make sure, that I pop this at all exit points from now on.
-          (state (f-put-global 'cgen-stats-event-stack 
-                               (cons (list :gcs% gcs%
-                                           :s-hist '()
-                                           :inside-test? t) ;distinguishes a test? entry 
-                                     cse-stack)
-                               state))
-          
-          (vt-acl2-alst (if programp 
-                            (pairlis$ vars (make-list (len vars)
-                                                      :initial-element 
-                                                      (list 'ACL2::ALL)))
-                          (get-acl2-type-alist (list term) "top" 
-                                               (acl2::ens state) vl state)))
-             
-                          
-          ((mv error-or-timeoutp ?stop? state) 
-           (csearch-with-timeout "top" hyps concl 
-                                 vt-acl2-alst mv-sig-alist '() 
-                                 programp defaults
-                                 ctx wrld state))
-          
-; dont take theorem prover's help if 
-; 1. csearch errored out or timed out
-; 2. stopping condition has already been reached
-; 3. form contains a program-mode function or we are in program mode
-; 4. testing is set to :naive
-          (no-thm-help?  (or error-or-timeoutp
-                             stop?
-                             programp
-                             (eq testing-enabled :naive)))
-          
-; TODO: print something if erp is true i.e error in testing
-          
-; Else call ACL2 prover with a hint
-; that does random testing on every checkpoint.
-          (- (cw? (debug-flag vl) "~|CEgen/Debug: thm+testing OFF: ~x0~%" no-thm-help?))
-          
-          ((mv thm-erp & state)
-           (if no-thm-help? 
-               (mv T '? state) ;TODO: I am throwing information here!
-             (mv-let 
-              (erp trval state)
-              (trans-eval `(acl2::thm-fn ',form state
-                                         (or ',hints 
-;user-specified hints override default hints
-                                             '(("Goal"
-                                                :do-not-induct t 
-                                                :do-not '(acl2::generalize 
-                                                          acl2::fertilize))))
-;TODO: Matt's code doesnt work through induction and forcing rds
-;Also the OTF flag is set to true, to test all initial subgoals. 
-                                         t nil) 
-                          'test?-fn state T)
-              (prog2$
-               (cw? (and erp (normal-output-flag vl))
-                    "~|CEgen/Error: bad trans-eval call in test?-fn~|")
-               (mv (cadr trval) '? state)))))
-
-          
-; TODO: errors in print functions will abort the whole form
-          ((mv end state) (acl2::read-run-time state))
-          (gcs%  (get-gcs%-global))
-          (gcs%  (change gcs% end-time end))
-          (state (put-gcs%-global gcs%))
-          ((er &) (if (or error-or-timeoutp 
-                          (and (<= (access gcs% cts) 0)
-                               dont-pts?))
-;no point in printing if error or timeout OR we specifically ask not
-;to print the testing summary here if no cts was found.  Sep 3rd 2012 -- modified Jan 9th 2013
-                      (value nil)
-                    (print-testing-summary-fn vl state)))
-
-          
-          ((mv cts-found? state)      
-; If testing found a counterexample, print so and abort.
-           (b* ((gcs% (get-gcs%-global))
-                (num-cts (access gcs% cts)))
-             (cond ((posp num-cts) (prog2$
-                                    (cw? (normal-output-flag vl)
-                                         "~%Test? found a counterexample.~%")
-                                    (mv T state)))
-; either thm failed, or we didnt call thm. Either way if we didnt find a cts
-; then we say the test? succeeded!
-                   (thm-erp  (prog2$
-                              (cw? (normal-output-flag vl)
-                                   "~%Test? succeeded. No counterexamples were found.~%")
-                              (mv NIL state)))
-;Success means the prover actually proved the conjecture under consideration
-                   (t  (prog2$
-                        (cw? (normal-output-flag vl)
-                             "~%Test? proved the conjecture under consideration (without induction). ~
- Therefore, no counterexamples exist. ~%" nil )
-                        (mv NIL state))))))
-
-; pop the cse-stack
-          (cse-stack (@ cgen-stats-event-stack))
-          (- (assert$ (valid-cgen-stats-event-stackp cse-stack) t))
-          (state (f-put-global 'cgen-stats-event-stack (cdr cse-stack) state)))
-
-      
-      (mv cts-found? '(value-triple :invisible) state ))))))
-
-(defdoc test?
-  ":Doc-Section ACL2::TESTING
-
-  Random testing using the ACL2 prover,
-  generating counterexamples to top-level conjecture.~/
-
-  ~bv[]
-  Examples:
-  (test? (implies (and (posp (car x))
-                     (posp (cdr x)))
-                (= (cdr x) (len x))))
-  
-  (test? (equal (reverse (reverse x)) x))
-  
-  Usage:
-  (test? form :hints hints :override-defaults my-params)
-
-  ~ev[]
-  ~/
-  
-  ~t[test?] is a powerful random testing facility intended
-  to be used to increase confidence in the truth of a conjecture by
-  providing extensive testing in cases where there is not enough time
-  or resources for formal proofs.
-  
-  ~t[test?] combines random testing with the power of ACL2 and
-  our data definition framework. It guarantees than any
-  counterexamples generated are truly counterexamples to the original
-  conjecture. A counterexample is just a binding that maps the
-  variables in the original conjecture to values in the ACL2
-  universe. In cases where the value of variables are irrelevant, we
-  bind the variables to the symbol ~t[?] : these bindings still
-  provide counterexamples, but should raise alarms, since chances are
-  that there is a specification error.
-  
-  If no counterexample is found, there are three possibilities. First,
-  it is possible that the conjecture is false, in which case increasing
-  the amount of testing we do may lead to the discovery of a
-  counterexample.  Second, it is also possible that ACL2 proves that
-  the conjecture is true, in which case we print a message reporting
-  success.  Finally, the conjecture may be true, but ACL2 cannot prove
-  it.  For all of these three cases, we consider testing to have
-  succeeded, so ~t[test?] will report success.
-  
-  We note that in order to be able to generate counterexamples, we do
-  not allow ACL2 to use any of the following processes: induction,
-  generalization, and cross-fertilization. We do allow destructor-
-  elimination, though in rare cases, user defined elim rules may
-  generalize the conjecture. Such situations are recognized.  If you
-  want to enable the above processes, use ~t[thm] instead, but
-  note that counterexamples shown might not be of the top-level conjecture.
-
-    
-  ~bv[]
-  Examples:
-  (test? (implies (and (posp (car x))
-                     (posp (cdr x)))
-                (= (cdr x) (len x))))
-  
-  (test? (equal (reverse (reverse x)) x))
-
-  ~ev[]
- 
-  Note is both these examples, counterexamples are generated for the
-  original goal, in case some variables are elided away(like y and by
-  equality z), we show ~t[?] as their instantiated values.
-
-  ~bv[]
-  (test? (implies (and (posp (car x))
-                     (equal y y)
-                     (equal z y)
-                     (posp (cdr x)))
-                (= (cdr x) (len x))))
-  
-  ~ev[]
-  "
- )
-
-
-;; (defun print-summary-user-testing (state)
-;;   (declare (xargs :stobjs state))
-
-;;   (and 
-;;        (b* ((ctx 'print-summary-user)
-;;             ((unless (and (f-boundp-global 'print-summary-user-flag state)
-;;                           (@ print-summary-user-flag)))
-;;              nil)
-;;             (?er-str "~|BAD global-coverage-stats. ~
-;; Please report to ACL2s maintainer the context in which this happened!~|")
-;;             ((unless (f-boundp-global 'gcs% state))
-;;              nil)
-;;             (gcs% (get-gcs%-global))
-;;             ((unless (gcs%-p gcs%))
-;;              nil)
-;;             (num-wts (access gcs% wts))
-;;             (num-cts (access gcs% cts))
-;;             (vl 1) ;TODO
-;;             (- (cw? (normal-output-flag vl)
-;;                     "~|ACL2s found ~x0 counterexamples and ~x1 witnesses. ~
-;; To print the testing summary, do :pts~|"
-;;                     num-cts num-wts))
-;;             )
-;;         nil)))
-
-(defun initialize-event-user-cgen (ctx body state)
-  (declare (xargs :mode :logic 
-                  :stobjs state
-                  :verify-guards nil)
-           (ignore ctx body))
-  (b* (((unless (f-boundp-global 'cgen-stats-event-stack state))
-        state) ;ignore
-       (cse-stack (@ cgen-stats-event-stack))
-       (- (assert$ (cgen-stats-event-stackp cse-stack) t))
-       ((mv start state) (acl2::read-run-time state))
-       (init-gcs% (initial-gcs% (acl2s-defaults :get num-counterexamples)
-                                (acl2s-defaults :get num-witnesses)
-;dummy topform will replaced by the actual top-level form in
-;test-checkpoint where this information is obtained from pspv
-                                start '(dummy-topform dummy) '()))
-       
-       (vl (acl2s-defaults :get verbosity-level))
-
-; if the top entry is by a test?, then copy its
-; contents into the new entry to be pushed into stack
-       ((mv gcs% s-hist)
-        (if (and (consp cse-stack)
-                 (assoc-keyword :inside-test? (car cse-stack)))
-            (b* ((v (car cse-stack))
-                 (- (cw? (system-debug-flag vl)
-               "~|CEgen/Sysdebug: Pushing entry into cgen-stats-event-stack, ~
-but also copying the test? event stats into the new entry ~%")))
-              (mv (cadr (assoc-keyword :gcs% v)) (cadr (assoc-keyword :s-hist v))))
-          (prog2$
-           (cw? (system-debug-flag vl)
-                "~|CEgen/Sysdebug: Pushing entry into cgen-stats-event-stack ~%")
-           (mv init-gcs% '())))))
-       
-
-       (f-put-global 'cgen-stats-event-stack 
-                     (cons (list :gcs% gcs% :s-hist s-hist) cse-stack)
-                     state)))
-  
-(defun initialize-event-user-cgen-gv (ctx body state)
-  (declare (xargs :mode :logic 
-                  :stobjs state
-                  :guard T))
-  (ec-call (initialize-event-user-cgen ctx body state)))
-  
-                                          
-
-(defun finalize-event-user-cgen (ctx body state)
-  (declare (xargs :mode :logic :verify-guards nil :stobjs state))
-  (declare (ignore ctx body))
-  (b* (((unless (f-boundp-global 'cgen-stats-event-stack state))
-        state) ;ignore
-       (cse-stack (@ cgen-stats-event-stack))
-       ((unless (valid-cgen-stats-event-stackp cse-stack))
-; Design decision - Lets fix a bad stack here, without complaining.
-        (f-put-global 'cgen-stats-event-stack nil state))
-       (vl (acl2s-defaults :get verbosity-level))
-       
-       
-       (rest-stack (cdr cse-stack))
-
-; Fixed bug: There is a symmetry in initialize-event and finalize-event, that
-; was ignored by me, and hence the bug. Specifically, the cts and wts collected
-; inside thm-fn event are being thrown away, but test? needs to print these. So
-; just like in initialize-event we copy contents of test? entry into the new
-; entry, we need to copy the top entry into the test? entry, preserving the
-; symmetry that these functions ought to keep.
-; March 14th 2013.
-       (state (if (and (consp rest-stack)
-; NOTE: guards are really nice, it below caught the error, where i was
-; directly searching in rest-stack instead of car of it.
-                       (assoc-keyword :inside-test? (car rest-stack)))
-                  ;; copy
-                  (b* ((v (car cse-stack))
-                       ((mv gcs% s-hist)
-                        (mv (cadr (assoc-keyword :gcs% v)) (cadr (assoc-keyword :s-hist v))))
-                       (rest-stack~ (cons (list :gcs% gcs% 
-                                                :s-hist s-hist
-                                                :inside-test? t)
-                                          (cdr rest-stack)))
-                       (- (cw? (system-debug-flag vl)
-            "~|CEgen/Sysdebug: Popping entry in cgen-stats-event-stack, ~
-but copying its contents into the test? stats entry ~%")))
-                    (f-put-global 'cgen-stats-event-stack
-                                  rest-stack~ state))
-                (prog2$
-                 (cw? (system-debug-flag vl)
-            "~|CEgen/Sysdebug: Popping entry in cgen-stats-event-stack ~%")
-                (f-put-global 'cgen-stats-event-stack rest-stack state)))))
-           
-    (prog2$ 
-; (print-summary-user-testing state)
-     nil ; TODO add regression statistics code here
-     state)))
-
-(defun finalize-event-user-cgen-gv (ctx body state)
-  (declare (xargs :mode :logic 
-                  :guard T
-                  :stobjs state))
-  (ec-call (finalize-event-user-cgen ctx body state)))
-
-(defattach (acl2::initialize-event-user
-            initialize-event-user-cgen-gv))
-
-(defattach (acl2::finalize-event-user
-            finalize-event-user-cgen-gv))
-
-
-
-(defmacro test? (form &key hints override-defaults dont-print-summary)
-  (let* ((vl (get-acl2s-default 'verbosity-level 
-                                override-defaults))
-         (debug (and (natp vl)
-                     (system-debug-flag vl))))
-    `(with-output
-      :stack :push
-      ,(if debug :on :off) :all
-      :gag-mode ,(not debug)
-     (make-event
-      (test?-fn ',form ',hints 
-                ',override-defaults ',dont-print-summary
-                'test? (w state) state)))))
-
-   
-;Lets start with the canonical rev-rev example!
-;Does Reverse of Reverse give back the original.Is it a Theorem?
-;; (trace$ cts-wts-search)
-
-;; (include-book "acl2s-parameter")
-;; (acl2s-defaults :set verbosity-level 5)
-;; (acl2s-defaults :set acl2::testing-enabled t)
-;; (defttag t)
-;; (defthm ok (equal (rev (rev x)) x))
-
-;; (test? (equal (rev (rev x)) x) :override-defaults ((testing-enabled . T)))
-
-;;  USAGE and EXAMPLES
-;; (set-acl2s-random-testing-enabled t)
-
-;; ;no slow array warning if inline-book base, but gives warning otherwise(FIXED)
-;; (union-vt-and '((x pos nat) (y all))
-;;               '((x rational) (y symbol boolean))
-;;               (w state))
-
-
-;; ;TODO:limit test runs when all cases are exhausted for finite data values
-;; (test?
-;;  (implies (and (booleanp a) 
-;;                (booleanp b))
-;;           (equal (implies a b) (or (not a) b)))
-
-
-;; TODO: 
-;; 1. union-find algo in per variable counterexample store,
-;;    increasing probability of finding countereg.
-;; 2. a proof obligation testing type consistency is missing in register-type
-;; 3. what about intersection (and) of types/acl2-subsets?
-;; 5. Registered constructors - check if destructor arguments are
-;;     subtypes of dex-prex.
-;; 6. IMP: Analyse efficiency of union-vt-and, see if it can be faster,
-;;     although it shudnt matter as num of free-vars is normally small!
diff -Nru acl2-6.2/books/countereg-gen/mv-proof.lisp acl2-6.3/books/countereg-gen/mv-proof.lisp
--- acl2-6.2/books/countereg-gen/mv-proof.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/mv-proof.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,34 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(begin-book t);$ACL2s-Preamble$|#
-
-(in-package "DEFDATA")
-
-(defun my-mv-nth (n v)
-  (declare (xargs :guard nil))
-  (if (zp n)
-    (car v)
-    (my-mv-nth (- n 1) (cdr v))))
-
-(defthm my-mv-nth--nil
-  (equal (my-mv-nth x nil)
-         nil))
-
-(defthm my-mv-nth--reduce1
-  (implies (and (syntaxp (integerp n))
-                (integerp n)
-                (< 0 n))
-           (equal (my-mv-nth n v)
-                  (my-mv-nth (- n 1) (cdr v)))))
-
-(defthm my-mv-nth--reduce2
-  (implies (or (not (integerp n))
-               (<= n 0))
-           (equal (my-mv-nth n v)
-                  (car v))))
-
-; not by default
-(defthmd mv-nth--to--my-mv-nth
-  (equal (mv-nth x y)
-         (my-mv-nth x y)))#|ACL2s-ToDo-Line|#
diff -Nru acl2-6.2/books/countereg-gen/num-list-fns.lisp acl2-6.3/books/countereg-gen/num-list-fns.lisp
--- acl2-6.2/books/countereg-gen/num-list-fns.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/num-list-fns.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,178 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book);$ACL2s-Preamble$|#
-
-
-(in-package "DEFDATA")
-
-(set-verify-guards-eagerness 2)
-
-
-(defun 2+-listp (x)
-  (if (atom x)
-    (null x)
-    (and (integerp (car x))
-         (<= 2 (car x))
-         (2+-listp (cdr x)))))
-
-; already in program mode:
-(DEFUN POS-LISTP (acl2::L)
-   (declare (xargs :guard t))
-  (COND ((ATOM acl2::L) (EQ acl2::L NIL))
-        (T (AND (POSP (CAR acl2::L))
-                (POS-LISTP (CDR acl2::L))))))
-
-
-(defthm 2+-listp-forward-to-pos-listp
-  (implies (2+-listp x)
-           (pos-listp x))
-  :rule-classes :forward-chaining)
-
-(defun naturals-listp (x)
-   (declare (xargs :guard t))
-  (if (atom x)
-    (null x)
-    (and (natp (car x))
-         (naturals-listp (cdr x)))))
-
-(defthm pos-listp-forward-to-naturals-listp
-  (implies (pos-listp x)
-           (naturals-listp x))
-  :rule-classes :forward-chaining)
-
-(defthm naturals-listp-forward-to-integer-listp
-  (implies (naturals-listp x)
-           (integer-listp x))
-  :rule-classes :forward-chaining)
-
-#| ; redundant
-(defthm integer-listp-forward-to-rational-listp
-  (implies (integer-listp x)
-           (rational-listp x))
-  :rule-classes :forward-chaining)
-|#
-
-; The definition of acl2-number-listp that was here has been omitted 12/4/2012
-; by Matt K., since it is now included in ACL2.
-
-(defthm rational-listp-forward-to-acl2-number-listp
-  (implies (rational-listp x)
-           (acl2-number-listp x))
-  :rule-classes :forward-chaining)
-
-(defthm acl2-number-listp-forward-to-true-listp
-  (implies (rational-listp x)
-           (acl2-number-listp x))
-  :rule-classes :forward-chaining)
-
-
-
-(defun sum-list (l)
-  (declare (xargs :guard (acl2-number-listp l)))
-  (if (endp l)
-    0
-    (+ (car l) (sum-list (cdr l)))))
-
-(defun product-list (l)
-  (declare (xargs :guard (acl2-number-listp l)))
-  (if (endp l)
-    1
-    (* (car l) (product-list (cdr l)))))
-
-(defun max-nat-list (l)
-  (declare (xargs :guard (rational-listp l)))
-  (if (endp l)
-    0
-    (max (car l)
-         (max-nat-list (cdr l)))))
-
-(defun scale (l x)
-  (declare (xargs :guard (and (acl2-number-listp l)
-                              (acl2-numberp x))))
-  (if (endp l)
-    nil
-    (cons (* (car l) x)
-          (scale (cdr l) x))))
-
-(defun shift (l x)
-  (declare (xargs :guard (and (acl2-number-listp l)
-                              (acl2-numberp x))))
-  (if (endp l)
-    nil
-    (cons (+ (car l) x)
-          (shift (cdr l) x))))
-
-#|
-(defun pow (l x)
-  (declare (xargs :guard (and (acl2-number-listp l)
-                              (natp x))))
-  (if (endp l)
-    nil
-    (cons (expt (car l) x)
-          (pow (cdr l) x))))
-|#
-
-(defun list-expt (base l)
-  (declare (xargs :guard (and (acl2-numberp base)
-                              (naturals-listp l))))
-  (if (endp l)
-    nil
-    (cons (expt base (car l))
-          (list-expt base (cdr l)))))
-
-(defun <=-lists (l1 l2)
-  (declare (xargs :guard (and (rational-listp l1)
-                              (rational-listp l2)
-                              (= (len l1) (len l2)))))
-  (if (mbe :logic (or (endp l1) (endp l2))
-           :exec (endp l1))
-    (mbe :logic (and (endp l1) (endp l2))
-         :exec t)
-    (and (<= (car l1) (car l2))
-         (<=-lists (cdr l1) (cdr l2)))))
-
-(defun all-<= (l v)
-  (declare (xargs :guard (and (rationalp v)
-                              (rational-listp l))))
-  (if (endp l)
-    t
-    (and (<= (car l) v)
-         (all-<= (cdr l) v))))
-
-(defun *-lists (l1 l2)
-  (declare (xargs :guard (and (rational-listp l1)
-                              (rational-listp l2)
-                              (= (len l1) (len l2)))))
-  (if (mbe :logic (or (endp l1) (endp l2))
-           :exec (endp l1))
-    nil
-    (cons (* (car l1) (car l2))
-          (*-lists (cdr l1) (cdr l2)))))
-
-(defun +-lists (l1 l2)
-  (declare (xargs :guard (and (rational-listp l1)
-                              (rational-listp l2)
-                              (= (len l1) (len l2)))))
-  (if (mbe :logic (or (endp l1) (endp l2))
-           :exec (endp l1))
-    nil
-    (cons (+ (car l1) (car l2))
-          (+-lists (cdr l1) (cdr l2)))))
-
-(defun make-list-logic (e size)
-  (declare (xargs :guard nil))
-  (if (zp size)
-    nil
-    (cons e
-          (make-list-logic e (- size 1)))))
-
-(defun pfix (x)
-  (if (posp x) x 1))
-
-(defun pos-list-fix (x)
-  (if (atom x)
-    nil
-    (cons (pfix (car x))
-          (pos-list-fix (cdr x)))))#|ACL2s-ToDo-Line|#
-
diff -Nru acl2-6.2/books/countereg-gen/num-list-thms.lisp acl2-6.3/books/countereg-gen/num-list-thms.lisp
--- acl2-6.2/books/countereg-gen/num-list-thms.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/num-list-thms.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,484 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book);$ACL2s-Preamble$|#
-
-(in-package "DEFDATA")
-
-(include-book "num-list-fns" :load-compiled-file :comp)
-
-(defthm pos-list--first
-  (implies (and (pos-listp l)
-                (consp l))
-           (< 0 (car l)))
-  :rule-classes (:linear :rewrite))
-
-(defthm sum-list-poses-type
-  (implies (and (pos-listp l)
-                (consp l))
-           (< 0 (sum-list l)))
-  :rule-classes (:linear :rewrite))
-
-(defthm sum-list-nats-type
-  (implies (naturals-listp l)
-           (<= 0 (sum-list l)))
-  :rule-classes (:linear :rewrite))
-
-(defthm sum-list-integers-type
-  (implies (integer-listp l)
-           (integerp (sum-list l)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm sum-list-rationals-type
-  (implies (rational-listp l)
-           (rationalp (sum-list l)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm sum-list>=element
-  (implies (and (naturals-listp l)
-                (consp l))
-           (>= (sum-list l) (car l)))
-  :rule-classes (:rewrite :linear))
-
-(defthm sum-list--append
-  (equal (sum-list (append x y))
-         (+ (sum-list x) (sum-list y))))
-
-
-(encapsulate nil
-  (local (include-book "arithmetic-5/top" :dir :system))
-
-  (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
-                               acl2::STABLE-UNDER-SIMPLIFICATIONP
-                               acl2::HIST 
-                               acl2::PSPV))))
-  
-  (defthm product-list-poses-type
-    (implies (pos-listp l)
-             (< 0 (product-list l)))
-    :rule-classes (:linear :rewrite))
-  
-  (defthm product-list-nats-type
-    (implies (naturals-listp l)
-             (<= 0 (product-list l)))
-    :rule-classes (:linear :rewrite))
-  
-  (defthm product-list-integers-type
-    (implies (integer-listp l)
-             (integerp (product-list l)))
-    :rule-classes (:rewrite :type-prescription))
-  
-  (defthm product-list-rationals-type
-    (implies (rational-listp l)
-             (rationalp (product-list l)))
-    :rule-classes (:rewrite :type-prescription))
-  
-  (defthm product-list>=element
-    (implies (and (pos-listp l)
-                  (consp l))
-             (>= (product-list l) (car l)))
-    :rule-classes (:rewrite :linear))
-
-  (defthm product-list--append
-    (equal (product-list (append x y))
-           (* (product-list x) (product-list y)))))
-
-
-(defthm max-nat-list<=sum-list
-  (implies (naturals-listp l)
-           (<= (max-nat-list l) (sum-list l)))
-  :rule-classes (:linear :rewrite))
-
-(defthm max-nat-list>=element
-  (implies (and (naturals-listp l)
-                (consp l))
-           (>= (max-nat-list l) (car l)))
-  :rule-classes (:linear :rewrite))
-
-(defthm max-nat-list--naturals-listp
-  (implies (naturals-listp l)
-           (integerp (max-nat-list l)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm max-nat-list--naturals-listp2
-  (implies (naturals-listp l)
-           (<= 0 (max-nat-list l)))
-  :rule-classes (:linear :rewrite))
-
-
-
-(defthm len=0--not-consp
-  (implies (equal (len x) 0)
-           (not (consp x))))
-
-
-(defthm scale--pos-list
-  (implies (and (pos-listp l)
-                (integerp x)
-                (< 0 x))
-           (pos-listp (scale l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm scale--nat-list
-  (implies (and (naturals-listp l)
-                (integerp x)
-                (<= 0 x))
-           (naturals-listp (scale l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm scale--integer-list
-  (implies (and (integer-listp l)
-                (integerp x))
-           (integer-listp (scale l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm scale--rational-list
-  (implies (and (rational-listp l)
-                (rationalp x))
-           (rational-listp (scale l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm scale--number-list
-  (implies (and (acl2-number-listp l)
-                (acl2-numberp x))
-           (acl2-number-listp (scale l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm scale--consp
-  (implies (consp l)
-           (consp (scale l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm scale--len
-  (equal (len (scale l x))
-         (len l)))
-
-
-(defthm shift--pos-list
-  (implies (and (pos-listp l)
-                (integerp x)
-                (< 0 x))
-           (pos-listp (shift l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm shift--nat-list
-  (implies (and (naturals-listp l)
-                (integerp x)
-                (<= 0 x))
-           (naturals-listp (shift l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm shift--integer-list
-  (implies (and (integer-listp l)
-                (integerp x))
-           (integer-listp (shift l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm shift--rational-list
-  (implies (and (rational-listp l)
-                (rationalp x))
-           (rational-listp (shift l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm shift--number-list
-  (implies (and (acl2-number-listp l)
-                (acl2-numberp x))
-           (acl2-number-listp (shift l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm shift--consp
-  (implies (consp l)
-           (consp (shift l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm shift--len
-  (equal (len (shift l x))
-         (len l)))
-
-#|
-(defthm pow--pos-list
-  (implies (and (pos-listp l)
-                (integerp x)
-                (<= 0 x))
-           (pos-listp (pow l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm pow--nat-list
-  (implies (and (naturals-listp l)
-                (integerp x)
-                (<= 0 x))
-           (naturals-listp (pow l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm pow--integer-list
-  (implies (and (integer-listp l)
-                (integerp x)
-                (<= 0 x))
-           (integer-listp (pow l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm pow--rational-list
-  (implies (and (rational-listp l)
-                (integerp x)
-                (<= 0 x))
-           (rational-listp (pow l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm pow--number-list
-  (implies (and (acl2-number-listp l)
-                (integerp x)
-                (<= 0 x))
-           (acl2-number-listp (pow l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm pow--consp
-  (implies (consp l)
-           (consp (pow l x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm pow--len
-  (equal (len (pow l x))
-         (len l)))
-|#
-
-(defthm list-expt--number-list
-  (implies (and (acl2-number-listp l)
-                (integerp x)
-                (<= 0 x))
-           (acl2-number-listp (list-expt x l)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm list-expt--consp
-  (implies (consp l)
-           (consp (list-expt x l)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm list-expt--len
-  (equal (len (list-expt x l))
-         (len l)))
-
-
-(defthm expt--integer
-  (implies (and (integerp x)
-                (integerp y)
-                (<= 0 y))
-           (integerp (expt x y))))
-
-(defthm expt-->=0
-  (implies (and (integerp x)
-                (< 0 x)
-                (integerp y)
-                (<= 0 y))
-           (< 0 (expt x y)))
-  :rule-classes (:rewrite :linear))
-
-(defthm expt--2
-  (implies (and (integerp x)
-                (<= 0 x)
-                (integerp y)
-                (< 0 y))
-           (<= 2 (expt 2 y))))
-
-(defthm <=-lists--transitive
-  (implies (and (<=-lists a b)
-                (<=-lists b c))
-           (<=-lists a c))
-  :rule-classes ((:rewrite :match-free :all)))
-
-(defthm <=-lists--reflexive
-  (<=-lists x x))
-
-(defthm all-<=--<=
-  (implies (and (all-<= l a)
-                (<= a b))
-           (all-<= l b)))
-
-(defthm all-<=--nth-<=
-  (implies (and (all-<= l v)
-                (integerp i)
-                (<= 0 i)
-                (< i (len l)))
-           (<= (nth i l) v)))
-
-(defthm all-<=--car-<=
-  (implies (and (all-<= l v)
-                (consp l))
-           (<= (car l) v)))
-
-(defthm <=-lists--all-<=
-  (implies (and (all-<= b x)
-                (<=-lists a b))
-           (all-<= a x))
-  :rule-classes (:rewrite :forward-chaining))
-
-(defthm *-lists-poses-type
-  (implies (and (pos-listp l1)
-                (pos-listp l2))
-           (pos-listp (*-lists l1 l2)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm *-lists-nats-type
-  (implies (and (naturals-listp l1)
-                (naturals-listp l2))
-           (naturals-listp (*-lists l1 l2)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm *-lists-integers-type
-  (implies (and (integer-listp l1)
-                (integer-listp l2))
-           (integer-listp (*-lists l1 l2)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm *-lists-rationals-type
-  (implies (and (rational-listp l1)
-                (rational-listp l2))
-           (rational-listp (*-lists l1 l2)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm *-lists--len
-  (equal (len (*-lists l1 l2))
-         (min (len l1) (len l2))))
-
-(defthm +-lists-poses-type
-  (implies (and (pos-listp l1)
-                (pos-listp l2))
-           (pos-listp (+-lists l1 l2)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm +-lists-nats-type
-  (implies (and (naturals-listp l1)
-                (naturals-listp l2))
-           (naturals-listp (+-lists l1 l2)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm +-lists-integers-type
-  (implies (and (integer-listp l1)
-                (integer-listp l2))
-           (integer-listp (+-lists l1 l2)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm +-lists-rationals-type
-  (implies (and (rational-listp l1)
-                (rational-listp l2))
-           (rational-listp (+-lists l1 l2)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm +-lists--len
-  (equal (len (+-lists l1 l2))
-         (min (len l1) (len l2))))
-
-(defthm make-list-ac=make-list-logic--lemma
-  (equal (append (make-list-logic e n)
-                 (cons e l))
-         (cons e
-               (append (make-list-logic e n)
-                       l))))
-
-(defthm make-list-ac=make-list-logic-append
-  (equal (make-list-ac n e l)
-         (append (make-list-logic e n) l)))
-
-(defthm make-list-ac--to--make-list-logic
-  (equal (make-list-ac n e nil)
-         (make-list-logic e n)))
-
-(defthm make-list--len
-  (implies (and (integerp n)
-                (<= 0 n))
-           (equal (len (make-list-logic v n))
-                  n)))
-
-(defthm make-list--consp
-  (implies (and (integerp n)
-                (< 0 n))
-            (consp (make-list-logic v n)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Subgoal *1/3'" :expand ((make-list-logic v 1)))))
-
-(defthm make-list--nats
-  (implies (and (integerp v)
-                (<= 0 v))
-           (naturals-listp (make-list-logic v n)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm make-list--pos
-  (implies (and (integerp v)
-                (< 0 v))
-           (pos-listp (make-list-logic v n)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm car--make-list
-  (implies (and (integerp n)
-                (< 0 n))
-           (equal (car (make-list-logic v n))
-                  v))
-  :hints (("Subgoal *1/3'" :expand ((make-list-logic v 1)))))
-
-(defthm cdr--make-list
-  (implies (and (integerp n)
-                (< 0 n))
-           (equal (cdr (make-list-logic v n))
-                  (make-list-logic v (- n 1)))))
-
-(defthm all-<=--make-list
-  (equal (all-<= (make-list-logic x n)
-                 y)
-         (or (zp n)
-             (<= x y))))
-
-
-(defthm pfix--integerp
-  (integerp (pfix x))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm pfix>=1
-  (<= 1 (pfix x))
-  :rule-classes (:rewrite :linear))
-
-(defthm pfix=
-  (implies (and (integerp x)
-                (< 0 x))
-           (equal (pfix x)
-                  x)))
-
-(in-theory (disable pfix))
-
-(defthm pos-list-fix--pos-listp
-  (pos-listp (pos-list-fix x)))
-
-;unfortunate
-(defthm pos-list-fix--naturals-listp
-  (naturals-listp (pos-list-fix x)))
-
-;unfortunate
-(defthm pos-list-fix--integer-listp
-  (integer-listp (pos-list-fix x)))
-
-;unfortunate
-(defthm pos-list-fix--rational-listp
-  (rational-listp (pos-list-fix x)))
-
-
-(defthm pos-list-fix--pos-list
-  (implies (pos-listp x)
-           (equal (pos-list-fix x)
-                  x)))
-
-(defthm pos-list-fix--len
-  (equal (len (pos-list-fix x))
-         (len x)))
-
-(defthm pos-list-fix--cons
-  (implies (consp x)
-           (equal (car (pos-list-fix x))
-                  (pfix (car x)))))
-
-(defthm pos-list-fix--cdr
-  (equal (cdr (pos-list-fix x))
-         (pos-list-fix (cdr x))))
-
-(defthm pos-list-fix--consp
-  (equal (consp (pos-list-fix x))
-         (consp x)))
-
-(in-theory (disable pos-list-fix))#|ACL2s-ToDo-Line|#
diff -Nru acl2-6.2/books/countereg-gen/package.lsp acl2-6.3/books/countereg-gen/package.lsp
--- acl2-6.2/books/countereg-gen/package.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/package.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,67 +0,0 @@
-
-(defpkg "DEFDATA"
-  (append 
-   '(getprop key val formals macro-args const
-     decode-logical-name value legal-constantp er-let* b* 
-     macroexpand1 trans-eval simple-translate-and-eval
-     assert-event legal-variable-or-constant-namep
-     f-boundp-global f-get-global f-put-global
-     proof-checker expansion equivalence-relationp
-     |1+F| |1-F| +f -f
-     defxdoc current-acl2-world e/d unsigned-byte-p
-     defrec 
-     variablep fquotep ffn-symb flambdap fargs
-     lambda-body lambda-formals subcor-var
-     dumb-negate-lit
-     
-     ;from graph.lisp
-     is-subtype is-disjoint 
-     
-     ;utlities.lisp
-     nat-listp allp acl2-number-listp naturals-listp pos-listp
-     
-     ;; num-lists.lisp
-     ;acl2-number-listp naturals-listp pos-listp 2+-listp
-     ;sum-list product-list max-nat-list <=-lists all-<=
-     ;shift scale *-lists +-lists make-list-logic pow list-expt
-     ;pfix pos-list-fix
-     
-     ;; misc exports: (n-x and finxlst-x added by harshrc)
-     oneof anyof data-constructors 
-     x n r a v infxlst finxlst
-
-     ;;added by harshrc
-      listof enum record map set nfixg
-      set-acl2s-defdata-verbose
-      get-acl2s-defdata-verbose
-      mget mset c
-     
-     ;; function/macro exports:
-     register-data-constructor
-     define-enumeration-type
-     defdata-subtype defdata-disjoint register-custom-type
-     defdata defdata-testing
-     
-     ;acl2-check
-     test? top-level-test? acl2s-defaults
-     set-acl2s-random-testing-enabled
-     get-acl2s-random-testing-enabled
-     dont-print-thanks-message-override-hint
-   
-     ;acl2s-defaults parameters
-     num-trials verbosity-level show-testing-output 
-     num-witnesses num-counterexamples
-
-     show-top-level-counterexample sampling-method
-     backtrack-limit  subgoal-timeout search-strategy
-     stopping-condition testing-enabled
-
-     ;verbosity control 
-     system-debug-flag inhibit-output-flag normal-output-flag
-     verbose-flag debug-flag
-
-     )
-   
-   (union-eq *acl2-exports*
-             *common-lisp-symbols-from-main-lisp-package*)))#|ACL2s-ToDo-Line|#
-
diff -Nru acl2-6.2/books/countereg-gen/portcullis.lsp acl2-6.3/books/countereg-gen/portcullis.lsp
--- acl2-6.2/books/countereg-gen/portcullis.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/portcullis.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-(ld "package.lsp")
-(ld "finite-set-theory/osets/sets.defpkg" :dir :system)
diff -Nru acl2-6.2/books/countereg-gen/random-state-basis1.lisp acl2-6.3/books/countereg-gen/random-state-basis1.lisp
--- acl2-6.2/books/countereg-gen/random-state-basis1.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/random-state-basis1.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,155 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book);$ACL2s-Preamble$|#
-
-
-(in-package "DEFDATA")
-(set-verify-guards-eagerness 2)
-(include-book "tools/bstar" :dir :system)
-(local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
-
-(defconst *M31* 2147483647);1 less than 2^31
-(defconst *P1* 16807)
-
-(make-event
- (er-progn
-  (assign random-seed 1382728371)
-  (value '(value-triple (@ random-seed))))
- :check-expansion t)
-
-
-(defun getseed (state)
-  (declare (xargs :stobjs (state)))
-  (if (f-boundp-global 'random-seed state)
-    (b* ((s (@ random-seed)))
-      (if (unsigned-byte-p 31 s)
-        (the (unsigned-byte 31) s)
-        0))
-    0))
-
-(defthm getseed-unsigned-byte31 
-  (unsigned-byte-p 31 (getseed state))
-  :rule-classes :type-prescription)
-
-(defthm getseed-nat 
-  (natp (getseed state))
-  :rule-classes :type-prescription)
-
-(defthm getseed-<-*m31*
-  (<= (getseed state) *M31*)
-  :rule-classes :linear)
-
-(in-theory (disable getseed))
- 
-(defun genrandom (max seed.)
-  "generates a pseudo-random number less than max, given that the
-current random seed is seed. and also returns the new seed."
-  (declare (type (unsigned-byte 31) max)
-           (type (unsigned-byte 31) seed.))
-  (declare (xargs :guard (and (unsigned-byte-p 31 seed.)
-                              (unsigned-byte-p 31 max)
-                              (posp max))))
-  (b* (((the (unsigned-byte 31) seed.) (mod (* *P1* seed.) *M31*)))
-   (mv (the (unsigned-byte 31) (mod seed. max)) seed.)))
-
-
-(defun genrandom-state (max state)
-  "generates a pseudo-random number less than max"
-  (declare (type (unsigned-byte 31) max))
-  (declare (xargs :stobjs (state)
-                  :guard (and  (unsigned-byte-p 31 max)
-                               (posp max))))
-  (b* (((the (unsigned-byte 31) old-seed) (getseed state))
-       ((the (unsigned-byte 31) new-seed) (mod (* *P1* old-seed) *M31*))
-       (state (acl2::f-put-global 'random-seed new-seed state)))
-    (mv (if (zp max)
-          0
-          (the (unsigned-byte 31) (mod new-seed max)))
-        state)))
-
-(encapsulate nil
-
- (defthm lemma1
-   (IMPLIES (and (posp max)
-                 (natp x))
-              
-         (<= 0 (MOD x MAX)))
-   :rule-classes :linear)
-
- 
-(defthm lemma2
- (IMPLIES (AND (posp MAX)
-               (< MAX 2147483648)
-              (natp x))
-         (< (MOD x MAX)
-            2147483648))
- :rule-classes :linear)
- 
-(defthm genrandom-natural1
-  (implies (and (posp max) (natp seed))
-           (natp (car (genrandom max seed)))
-           )
-   :rule-classes :type-prescription)
-
-(defthm genrandom-natural2
-  (implies (and (natp seed))
-           (natp (mv-nth 1 (genrandom max seed))))
-   :rule-classes :type-prescription)
-
-
-
-(defthm genrandom-ub31-1
-  (implies (and (<= 1 max)
-                (unsigned-byte-p 31 max) 
-                (natp seed))
-           (unsigned-byte-p 31 (car (genrandom max seed))))
-   :rule-classes :type-prescription)
-
-
-(defthm genrandom-ub31-2
-  (implies (and (natp seed))
-           (unsigned-byte-p 31 (mv-nth 1 (genrandom max seed))))
-   :rule-classes :type-prescription)
- 
-(defthm genrandom-minimum1
-   (implies (and (posp max) (natp seed))
-            (<= 0 (car (genrandom max seed))))
-   :rule-classes :linear)
-
-(defthm genrandom-minimum2
-   (implies (and (natp seed))
-            (<= 0 (mv-nth 1 (genrandom max seed))))
-   :rule-classes :linear)
-
- (defthm genrandom-maximum1
-   (implies (and (posp max)
-                 (natp seed))
-            (< (car (genrandom max seed)) max))
-   :rule-classes :linear)
- 
- (defthm genrandom-maximum2
-   (implies (and (natp seed))
-            (< (mv-nth 1 (genrandom max seed)) *M31*))
-   :rule-classes :linear)
- 
- 
- (defthm genrandom-state-natural
-   (natp (car (genrandom-state max state)))
-   :rule-classes :type-prescription)
-
- (defthm genrandom-state-minimum 
-   (<= 0 (car (genrandom-state max state)))
-   :rule-classes :linear)
- 
- (defthm genrandom-state-maximum
-   (implies (posp max)
-            (<= (car (genrandom-state max state)) (1- max)))
-   :rule-classes :linear)
- 
- )
-
- 
-(in-theory (disable genrandom genrandom-state))#|ACL2s-ToDo-Line|#
-
-
diff -Nru acl2-6.2/books/countereg-gen/random-state.lisp acl2-6.3/books/countereg-gen/random-state.lisp
--- acl2-6.2/books/countereg-gen/random-state.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/random-state.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1260 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(begin-book t);$ACL2s-Preamble$|#
-
-(in-package "DEFDATA")
-(set-verify-guards-eagerness 2)
-
-(include-book "random-state-basis1")
-;(include-book "num-list-fns") ;defines acl2-number-listp,pos-listp,naturals-listp
-
-;=====================================================================;
-; 
-; by Peter Dillinger &  Dimitris Vardoulakis
-; Last Major Updates: 7 February 2008
-; Tweaked:  11 November 2008
-; Tweaked:  24 November 2008 by harshrc
-; Modified: 10 March 2012 by harshrc -- type declarations
-;=====================================================================;
-
-(defun random-boolean (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (num state)
-          (genrandom-state 2 state)
-          (mv (= 1 num) state)))
-
-(defthm random-boolean-type
-  (booleanp (car (random-boolean r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-boolean))
-
-
-;generate naturals according to a pseudo-geometric distribution
-;added strong type declarations for faster code
-
-(defun random-natural-basemax1 (base maxdigits seed.)
-  (declare (type (integer 1 16) base)
-           (type (integer 0 9) maxdigits)
-           (type (unsigned-byte 31) seed.)
-           (xargs :guard (and (unsigned-byte-p 31 seed.)
-                              (posp base)
-                              (<= base 16) (> base 0) 
-                              (natp maxdigits)
-                              (< maxdigits 10) (>= maxdigits 0))))
-  (if (zp maxdigits)
-    (mv 0 seed.)
-    (b* (((mv (the (integer 0 32) v) 
-              (the (unsigned-byte 31) seed.))
-          (genrandom (acl2::*f 2 base) seed.)))
-     (if (>= v base)
-         (b* (((mv v2 seed.); can do better type information here TODO
-                 (random-natural-basemax1 base 
-                                         (1- maxdigits) seed.)))
-             (mv (+ (- v base) 
-                    (* base (nfix v2))) 
-                 seed.))
-      
-       (mv v seed.)))))
-
-(defun random-natural-seed (seed.)
-  (declare (type (unsigned-byte 31) seed.))
-  (declare (xargs :guard (unsigned-byte-p 31 seed.)))
-  (random-natural-basemax1 10 6 seed.))
-      
-(defthm random-natural-basemax1-type
-  (implies (and (posp b) (natp d) (unsigned-byte-p 31 r))
-           (natp (car (random-natural-basemax1 b d r))))
-  
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm random-natural-seed-type
-  (implies (unsigned-byte-p 31 r)
-           (natp (car (random-natural-seed r))))
-  :rule-classes :type-prescription)
-(in-theory (disable random-natural-basemax1
-                    random-natural-seed))
-(defun putseed (s state)
-  (declare (xargs :stobjs (state)))
-                  ;:guard (unsigned-byte-p 31 s)))
-  ;(declare (type (unsigned-byte 31) s))
-  (acl2::f-put-global 'random-seed s state))
-
-(defun random-natural-basemax (base maxdigits state)
-   (declare (type (integer 1 16) base)
-            (type (integer 0 9) maxdigits)
-            (xargs :stobjs (state)
-                  :guard (and (posp base)
-                              (<= base 16) (> base 0) 
-                              (natp maxdigits)
-                              (< maxdigits 10) (>= maxdigits 0))))
-   (b* (((mv n seed.) (random-natural-basemax1 base maxdigits (getseed state)))
-        (state (putseed seed. state)))
-       (mv n state)))
-                   
-;;pseudo-geometric distribution
-(defun random-natural (state)
-  (declare (xargs :stobjs (state)))
-  (random-natural-basemax 10 6 state))
-
-
-;;pseudo-geometric distribution but smaller numbers
-(defun random-small-natural (state)
-  (declare (xargs :stobjs (state)))
-  (random-natural-basemax 10 3 state))
-
-
-;;added to be consistent with naming of the types
-;; Type name = foo
-;; Type predicate = foop
-;; Type enum = nth-foo
-;; Random generator = random-foo
-(defun random-nat (state)
-  (declare (xargs :stobjs (state)))
-  (random-natural-basemax 10 6 state))
-
-(defun random-length (state)
-  (declare (xargs :stobjs (state)))
-  (random-natural-basemax 4 2 state))
-
-;create small lists upto length 4
-(defun random-small-length (state)
-  (declare (xargs :stobjs (state)))
-  (random-natural-basemax 2 2 state))
-
-(defthm random-natural-basemax-type
-  (implies (and (posp b) (natp d))
-  (natp (car (random-natural-basemax b d r))))
-  :rule-classes :type-prescription)
-
-(defthm random-natural-type
-  (natp (car (random-natural r)))
-  :rule-classes :type-prescription)
-
-(defthm random-nat-type
-  (natp (car (random-nat r)))
-  :rule-classes :type-prescription)
-
-(defthm random-length-type
-  (natp (car (random-length r)))
-  :rule-classes :type-prescription)
-
-(defthm random-small-length-type
-  (natp (car (random-small-length r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-small-length))
-(in-theory (disable random-natural-basemax
-                    random-natural
-                    random-nat
-                    random-length))
-
-
-
-
-; generate indices uniformly within a specified length 
-(defun random-index (len state)
-  (declare (type (unsigned-byte 29) len)
-           (xargs :stobjs (state)
-                  :guard (posp len)))
-  (genrandom-state len state))
-
-(defun random-elem (lst state)
-  (declare (xargs :stobjs (state)
-                  :guard (and (true-listp lst)
-                              (< (len lst) (expt 2 29)))))
-  (cond ((endp lst) (value nil))
-        ((endp (cdr lst)) (value (car lst)))
-        (t
-         (mv-let (ind state)
-                 (random-index (len lst) state)
-                 (value (nth ind lst))))))
-        
-             
-;generate integers according to a pseudo-geometric distribution
-(defun random-integer (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (sign state)
-          (random-boolean state)
-          (mv-let (nat state)
-                  (random-natural state)
-                  (mv (if sign nat (- nat))
-                      state))))
-
-(defthm random-integer-type
-  (integerp (car (random-integer r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-integer))#|ACL2s-ToDo-Line|#
-
-
-#| start commenting out code that is right now unnecessary for random-testing, refactor this later into a sep file
-;or generate integers with a uniform distribution, between i & j (incl.)
-(defun random-int-between (i j state)
-  (declare (xargs :stobjs (state)
-                  :guard (and (integerp i)
-                              (integerp j))))
-  (let ((low (ifix (min i j)))
-        (high (ifix (max i j))))
-    (mv-let
-     (num state)
-     (genrandom (1+ (- high low)) state)
-     (mv (+ low num) state))))
-
-(defthm random-int-between-type
-  (integerp (car (random-int-between i j r)))
-  :rule-classes :type-prescription)
-
-(defthm random-int-between-lower
-  (implies (and (integerp i)
-                (integerp j)
-                (<= i j))
-           (<= i (car (random-int-between i j r))))
-  :rule-classes :linear)
-
-(defthm random-int-between-upper
-  (implies (and (integerp i)
-                (integerp j)
-                (<= i j))
-           (>= j (car (random-int-between i j r))))
-  :rule-classes :linear)
-
-(in-theory (disable random-int-between))
-
-
-; generate a signed rational with pseudo-geometric numerator & denominator 
-(defun random-rational (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (numer state)
-          (random-integer state)
-          (mv-let (denom-1 state)
-                  (random-natural state)
-                  (mv (/ numer
-                         (+ 1 denom-1))
-                      state))))
-
-(defthm random-rational-type
-  (rationalp (car (random-rational r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-rational))
-
-
-; pseudo-uniform rational between 0 and 1 (inclusive)
-(defun random-probability (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (a state)
-          (random-natural state)
-          (mv-let (b state)
-                  (random-natural state)
-                  (let ((denom (* (1+ a) (1+ b))))
-                    (mv-let (numer state)
-                            (genrandom (1+ denom) state)
-                            (mv (/ numer denom) state))))))
-
-(defthm random-probability-type
-  (rationalp (car (random-probability r)))
-  :rule-classes :type-prescription)
-
-(defthm random-probability>=0
-  (<= 0 (car (random-probability r)))
-  :rule-classes (:linear :type-prescription)) 
-
-(encapsulate nil
-  (local (include-book "arithmetic/rationals" :dir :system))
-
-  #|
-  (local
-   (defthm numerator<=denominator-implies-<=1
-     (implies (and (natp n)
-                   (posp d)
-                   (<= n d))
-              (<= (* (/ d) n)
-                  1))))
-  |#
-  
-  (defthm random-probability<=1
-    (<= (car (random-probability r)) 1)
-    :rule-classes :linear))
-
-(in-theory (disable random-probability))
-
-
-;generate a random rational whose absolute value is lte x
-(defun random-rational-between (x y state)
-  (declare (xargs :stobjs (state)
-                  :guard (and (rationalp x)
-                              (rationalp y))))
-  (mv-let (p state)
-          (random-probability state)
-          (mv (rfix
-               (if (< x y)
-                 (+ x (* p (- y x)))
-                 (+ y (* p (- x y)))))
-              state)))
-
-(defthm random-rational-between-type
-  (rationalp (car (random-rational-between i j r)))
-  :rule-classes :type-prescription)
-
-(encapsulate nil
-  (local (include-book "arithmetic-3/top" :dir :system))
-  
-  (defthm random-rational-between-lower
-    (implies (and (rationalp i)
-                  (rationalp j)
-                  (<= i j))
-             (<= i (car (random-rational-between i j r))))
-    :rule-classes :linear)
-
-  (local (defthm random-rational-between-upper-lemma2
-           (implies (and (rationalp i)
-                         (rationalp j)
-                         (rationalp p)
-                         (<= 0 p)
-                         (<= p 1)
-                         (< i j))
-                    (<= (* i p)
-                        (* j p)))
-           :rule-classes nil))
-  
-  (local 
-   (defthm random-rational-between-upper-lemma
-     (implies (and (rationalp i)
-                   (rationalp j)
-                   (rationalp p)
-                   (<= 0 p)
-                   (<= p 1)
-                   (< i j))
-              (<= (+ i (* j p))
-                  (+ j (* i p))))
-     :hints (("Goal" :use (:instance
-                           random-rational-between-upper-lemma2
-                           (p (- 1 p)))))))
-
-  (defthm random-rational-between-upper
-    (implies (and (rationalp i)
-                  (rationalp j)
-                  (<= i j))
-             (<= (car (random-rational-between i j r)) j))
-    :rule-classes :linear))
-
-(in-theory (disable random-rational-between))
-
-
-
-;generate non-zero integers according to a pseudo-geometric distribution
-(defun random-nonzero-integer (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (sign state)
-          (random-boolean state)
-          (mv-let (nat state)
-                  (random-natural state)
-                  (mv (if sign (+ 1 nat) (- -1 nat))
-                      state))))
-
-(defthm random-nonzero-integer-type
-  (and (integerp (car (random-nonzero-integer r)))
-       (not (equal (car (random-nonzero-integer r)) 0)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-nonzero-integer))
-
-;;--added by harshrc
-;;--generate positive integers according to a pseudo-geometric distribution
-(defun random-pos (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (nat state)
-          (random-natural state)
-          (mv (+ 1 nat) state)))
-
-(defthm random-pos-type
-  (posp (car (random-pos r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-pos))
-
-
-
-; generate a signed rational with pseudo-geometric numerator & denominator 
-(defun random-nonzero-rational (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (numer state)
-          (random-nonzero-integer state)
-          (mv-let (denom-1 state)
-                  (random-natural state)
-                  (mv (/ numer
-                         (+ 1 denom-1))
-                      state))))
-
-(defthm random-nonzero-rational-type
-  (and (rationalp (car (random-nonzero-rational r)))
-       (not (equal (car (random-nonzero-rational r)) 0)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-nonzero-rational))
-
-
-; generate a (strictly) complex number from rationals
-(defun random-complex (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (rpart state)
-          (random-rational state)
-          (mv-let (ipart state)
-                  (random-nonzero-rational state)
-                  (mv (complex rpart ipart) state))))
-
-(defthm random-complex-type
-  (complex-rationalp (car (random-complex r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-complex))
-
-
-
-(defmacro random-element (lst rand-state)
-  `(mv-let (random-element-macro-idx state)
-           (random-index (length ,lst) ,rand-state)
-           (mv (nth random-element-macro-idx ,lst) state)))
-
-(defmacro random-element-len (lst len rand-state)
-  `(if (mbt (<= ,len (len ,lst)))
-     (mv-let (random-element-macro-idx state)
-             (random-index ,len ,rand-state)
-             (mv (nth random-element-macro-idx ,lst) state))
-     (mv (car ,lst) state)))
-
-
-
-(defconst *standard-chars-len*
-  (len *standard-chars*))
-
-;;--slight modification of name char to character --harshrc
-(defun random-character (state)
-  (declare (xargs :stobjs (state)))
-  (random-element-len *standard-chars*
-                      *standard-chars-len*
-                      state))
-
-(defthm random-character-type
-  (characterp (car (random-character r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-character))
-
-(defun random-character-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-character state)
-            (mv-let (lst state)
-                    (random-character-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defthm random-character-list-len-type
-  (character-listp (car (random-character-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-character-list-len))
-
-(defun random-character-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-length state)
-          (random-character-list-len len state)))
-
-(defthm random-character-list-type
-  (character-listp (car (random-character-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-character-list))
-
-
-(defun random-string-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (mv-let (lst state)
-          (random-character-list-len len state)
-          (mv (coerce lst 'string) state)))
-
-(defthm random-string-len-type
-  (stringp (car (random-string-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-string-len))
-
-
-;generate a random string of pseudogeometric length
-(defun random-string (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-length state)
-          (random-string-len len state)))
-
-(defthm random-string-type
-  (stringp (car (random-string r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-string))
-
-
-;generate a random symbol of pseudogeometric length
-(defun random-symbol-same-package (sym state)
-  (declare (xargs :stobjs (state)
-                  :guard (symbolp sym)))
-  (mv-let (str state)
-          (random-string state)
-          (mv (intern-in-package-of-symbol str sym) state)))
-
-(defthm random-symbol-same-package-type
-  (implies (symbolp sym)
-           (symbolp (car (random-symbol-same-package sym r))))
-  :rule-classes :type-prescription)
-
-(defthmd random-symbol-same-package_expand-package
-  (implies (symbolp sym)
-           (equal (car (random-symbol-same-package sym r))
-                  (intern-in-package-of-symbol
-                   (symbol-name (car (random-symbol-same-package sym r)))
-                   sym))))
-
-(defthmd random-symbol-same-package_suck-package
-  (implies (symbolp sym)
-           (equal (intern-in-package-of-symbol
-                   (symbol-name (car (random-symbol-same-package sym r)))
-                   sym)
-                  (car (random-symbol-same-package sym r)))))
-
-(in-theory (disable random-symbol-same-package))
-
-
-(defun random-keyword (state)
-  (declare (xargs :stobjs (state)))
-  (random-symbol-same-package :acl2-pkg-witness state))
-
-(defthm random-keyword-type
-  (symbolp (car (random-keyword r)))
-  :rule-classes :type-prescription)
-
-(local (defthm keyword-package-intern
-         (implies (and (stringp str)
-                       (keywordp key))
-                  (equal (symbol-package-name
-                          (intern-in-package-of-symbol str key))
-                         "KEYWORD"))
-         :hints (("Goal" :use (:instance keyword-package (x str) (y key))))))
-
-(defthm random-keyword-keyword
-  (equal (symbol-package-name (car (random-keyword r)))
-         "KEYWORD")
-  :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
-                        (sym :acl2-pkg-witness)))))
-
-(in-theory (disable random-keyword))
-
-
-
-
-
-
-;some composites
-
-(defun random-acl2-number (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (v state)
-          (random-index 4 state)
-          (case v
-                (0 (random-natural state))
-                (1 (random-integer state))
-                (2 (random-rational state))
-                (t (random-complex state)))))
-
-(defthm random-acl2-number-type
-  (acl2-numberp (car (random-acl2-number r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-acl2-number))
-
-
-(defconst *acl2-exports-len*
-  (len *acl2-exports*))
-(defconst *common-lisp-symbols-from-main-lisp-package-len*
-  (len *common-lisp-symbols-from-main-lisp-package*))
-
-(with-output
- :off (prove observation event)
- (defun random-symbol (state)
-   (declare (xargs :stobjs (state)))
-   (mv-let (v state)
-           (random-index 8 state)
-           (case
-            v
-            (0 (random-boolean state))
-            (1 (random-element-len
-                *acl2-exports*
-                *acl2-exports-len*
-                state))
-            (2 (random-element-len
-                *common-lisp-symbols-from-main-lisp-package*
-                *common-lisp-symbols-from-main-lisp-package-len*
-                state))
-            (3 (random-keyword state))
-            (4 (random-symbol-same-package 'acl2::acl2-pkg-witness state))
-            (5 (random-symbol-same-package 'acl2-user::acl2-pkg-witness state))
-            (6 (random-symbol-same-package 'common-lisp::acl2-pkg-witness state))
-            (t (random-symbol-same-package 'acl2-pc::acl2-pkg-witness state))))))
-
-(encapsulate nil
-  (local (defthm nth-symbol-list
-           (implies (force (symbol-listp l))
-                    (symbolp (nth i l)))))
-  
-  (with-output
-   :off (prove observation event)
-   (defthm random-symbol-type
-     (symbolp (car (random-symbol r)))
-     :rule-classes :type-prescription)))
-
-(in-theory (disable random-symbol))
-
-
-
-(with-output
- :off (prove observation event)
- (defun random-acl2-symbol (state)
-   (declare (xargs :stobjs (state)))
-   (mv-let (v state)
-           (random-index 5 state) ; skew toward generated symbols
-           (case
-            v
-            (0 (random-boolean state))
-            (1 (random-element-len
-                *acl2-exports*
-                *acl2-exports-len*
-                state))
-            (2 (random-element-len
-                *common-lisp-symbols-from-main-lisp-package*
-                *common-lisp-symbols-from-main-lisp-package-len*
-                state))
-            (t (random-symbol-same-package 'acl2::acl2-pkg-witness state))))))
-
-(encapsulate nil
-  (local (defthm nth-symbol-list
-           (implies (force (symbol-listp l))
-                    (symbolp (nth i l)))))
-  
-  (with-output
-   :off (prove observation event)
-   (defthm random-acl2-symbol-type
-     (symbolp (car (random-acl2-symbol r)))
-     :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
-                           (sym 'acl2::acl2-pkg-witness))))
-     :rule-classes :type-prescription)))
-
-(in-theory (disable random-acl2-symbol))
-
-
-
-(defun random-atom (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (v state)
-          (random-index 4 state)
-          (case
-           v
-           (0 (random-acl2-number state))
-           (1 (random-character state))
-           (2 (random-symbol state))
-           (t (random-string state)))))
-
-(defthm random-atom-type
-  (atom (car (random-atom r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-atom))
-
-;;---------------------------------------------------------------------------
-;;---------------------------------------------------------------------------
-;;--modifications by harshrc
-;;--add random-<atom>-list for each atom type of pseudo-geometric length upto 4
-;;--generate true list of <atom> (<atom recognizer> <atom type-set>)
-
-
-
-;;--generate true list of integers (integerp 11)
-(defun random-integer-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-integer state)
-            (mv-let (lst state)
-                    (random-integer-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defthm random-integer-list-len-type
-  (integer-listp (car (random-integer-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-integer-list-len))
-
-(defun random-integer-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-integer-list-len len state)))
-
-(defthm random-integer-list-type
-  (integer-listp (car (random-integer-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-integer-list))
-
-;;--generate true list of positive integers  (posp 2)
-(defun random-pos-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-pos state)
-            (mv-let (lst state)
-                    (random-pos-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defun pos-listp (l)
-  (declare (xargs :guard t))
-  (cond ((atom l) (eq l nil))
-        (t (and (posp (car l))
-                (pos-listp (cdr l))))))
-
-
-(defthm random-pos-list-len-type
-  (pos-listp (car (random-pos-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-pos-list-len))
-
-(defun random-pos-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-pos-list-len len state)))
-
-(defthm random-pos-list-type
-  (pos-listp (car (random-pos-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-pos-list))
-
-
-
-
-;;--generate true list of natural (natp 3)
-(defun random-nat-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-nat state)
-            (mv-let (lst state)
-                    (random-nat-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-;;--just to be consistent with the naming
-;;--naturalp is otherwise same as natp
-;;--redefined in several books in acl2-sources, so commented out.
-(local
-(defun naturalp (x)
-  (declare (xargs :guard t :mode :logic))
-  (and (integerp x) (<= 0 x)))
-)
-
-(defun naturals-listp (x)
-  (if (atom x)
-    (null x)
-    (and (natp (car x))
-         (naturals-listp (cdr x)))))
-
-
-
-(defthm random-nat-list-len-type
-  (naturals-listp (car (random-nat-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-nat-list-len))
-
-(defun random-nat-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-nat-list-len len state)))
-
-(defthm random-nat-list-type
-  (naturals-listp (car (random-nat-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-nat-list))
-
-
-;;--generate true list of rational (rationalp 31)
-(defun random-rational-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-rational state)
-            (mv-let (lst state)
-                    (random-rational-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defthm random-rational-list-len-type
-  (rational-listp (car (random-rational-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-rational-list-len))
-
-(defun random-rational-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-rational-list-len len state)))
-
-(defthm random-rational-list-type
-  (rational-listp (car (random-rational-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-rational-list))
-
-
-;;--generate true list of complex  (complex-rationalp 32)
-(defun random-complex-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-complex state)
-            (mv-let (lst state)
-                    (random-complex-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defun complex-listp (l)
-  (declare (xargs :guard t))
-  (cond ((atom l) (equal l nil))
-        (t (and (complex-rationalp (car l))
-                (complex-listp (cdr l))))))
-
-(defthm random-complex-list-len-type
-  (complex-listp (car (random-complex-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-complex-list-len))
-
-(defun random-complex-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-complex-list-len len state)))
-
-(defthm random-complex-list-type
-  (complex-listp (car (random-complex-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-complex-list))
-
-
-
-;;--generate true list of acl2-number (acl2-numberp 63)
-(defun random-acl2-number-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-acl2-number state)
-            (mv-let (lst state)
-                    (random-acl2-number-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-; Modified slightly 12/4/2012 by Matt K. to be redundant with new ACL2
-; definition.
-(defun acl2-number-listp (l)
-  (declare (xargs :guard t))
-  (cond ((atom l)
-         (eq l nil))
-        (t (and (acl2-numberp (car l))
-                (acl2-number-listp (cdr l))))))
-
-(defthm random-acl2-number-list-len-type
-  (acl2-number-listp (car (random-acl2-number-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-acl2-number-list-len))
-
-(defun random-acl2-number-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-acl2-number-list-len len state)))
-
-(defthm random-acl2-number-list-type
-  (acl2-number-listp (car (random-acl2-number-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-acl2-number-list))
-
-
-
-;;--generate true list of boolean (booleanp 192)
-(defun random-boolean-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-boolean state)
-            (mv-let (lst state)
-                    (random-boolean-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defthm random-boolean-list-len-type
-  (boolean-listp (car (random-boolean-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-boolean-list-len))
-
-(defun random-boolean-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-boolean-list-len len state)))
-
-(defthm random-boolean-list-type
-  (boolean-listp (car (random-boolean-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-boolean-list))
-
-;;--generate true list of symbol   (symbolp 448)
-(defun random-symbol-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-symbol state)
-            (mv-let (lst state)
-                    (random-symbol-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defthm random-symbol-list-len-type
-  (symbol-listp (car (random-symbol-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-symbol-list-len))
-
-(defun random-symbol-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-symbol-list-len len state)))
-
-(defthm random-symbol-list-type
-  (symbol-listp (car (random-symbol-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-symbol-list))
-
-
-;;--generate true list of string   (characterp 4096)
-(defun random-string-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-string state)
-            (mv-let (lst state)
-                    (random-string-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defthm random-string-list-len-type
-  (string-listp (car (random-string-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-string-list-len))
-
-(defun random-string-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-string-list-len len state)))
-
-(defthm random-string-list-type
-  (string-listp (car (random-string-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-string-list))
-
-
-;;--generate true list of atom   (atom -1537)
-(defun random-atom-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-atom state)
-            (mv-let (lst state)
-                    (random-atom-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-
-(defthm random-atom-list-len-type
-  (atom-listp (car (random-atom-list-len l r)))
-  :rule-classes :type-prescription)
-
-
-(defun random-atom-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-atom-list-len len state)))
-
-(defthm random-atom-list-type
-  (atom-listp (car (random-atom-list r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-atom-list-len
-                    random-atom-list))
-
-(defun random-atom-cons-dep (dep state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp dep)))
-  (if (zp dep)
-    (random-atom state)
-    (mv-let (cr state)
-            (random-atom-cons-dep (1- dep) state)
-            (mv-let (cdr state)
-                    (random-atom-cons-dep (1- dep) state)
-                    (mv (cons cr cdr) state)))))
-#|
-(defthm random-atom-cons-dep-type
-  (consp (car (random-atom-cons-dep d r)))
-  :rule-classes :type-prescription)
-|#
-
-(defun random-atom-cons (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (dep state)
-          (random-small-length state)
-          (random-atom-cons-dep (1+ dep) state)))
-#|
-(defthm random-atom-cons-type
-  (consp (car (random-atom-cons r)))
-  :rule-classes :type-prescription)
-|#
-(in-theory (disable random-atom-cons-dep
-                    random-atom-cons))
-
-(defun anyp (x)
-  (declare (xargs :mode :logic
-                  :guard t)
-           (ignore x))
-  t)
-
-(defun random-any (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (v state)
-          (random-index 10 state);skew towards atoms
-          (case
-           v
-           (0 (random-atom-cons state))
-           (1 (random-atom-list state))
-           (t (random-atom state)))))
-(defthm random-any-type
-  (anyp (car (random-any r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-any))
-
-(defun random-true-list-len (len state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp len)
-                  :measure len))
-  (if (zp len)
-    (mv nil state)
-    (mv-let (elem state)
-            (random-any state)
-            (mv-let (lst state)
-                    (random-atom-list-len (1- len) state)
-                    (mv (cons elem lst) state)))))
-#|
-(defthm random-true-list-len-type
-  (true-listp (car (random-true-list-len l r)))
-  :rule-classes :type-prescription)
-|#
-
-(defun random-true-list (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (len state)
-          (random-small-length state)
-          (random-true-list-len len state)))
-#|
-(defthm random-true-list-type
-  (true-listp (car (random-true-list r)))
-  :rule-classes :type-prescription)
-|#
-(in-theory (disable random-true-list-len
-                    random-true-list))
-
-(defun random-cons-dep (dep1 dep2 state)
-  (declare (xargs :stobjs (state)
-                  :guard (and (natp dep1)
-                              (natp dep2))))
-  (if (or (zp dep1) (zp dep2))
-    (random-any state)
-    (mv-let (cr state)
-            (random-atom-cons-dep (floor dep1 2) state)
-            (mv-let (cdr state)
-                    (random-atom-cons-dep (1- dep2) state)
-                    (mv (cons cr cdr) state)))))
-
-
-(defun random-cons (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (dep1 state)
-          (random-small-length state)
-          (mv-let (dep2 state)
-                  (random-small-length state)
-                  (random-cons-dep (1+ dep1) (1+ dep2) state))))
-
-(defthm random-cons-type
-  (consp (car (random-cons r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-cons-dep 
-                    random-cons))
-
-|# ;end commenting of all this code, refactor it into a seperate file later.
-
-
-#|
-(defun random-key-pair (key state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (cdr state)
-          (random-any state)
-          (mv (cons key cdr) state))) 
-;;random acons with keys as symbols (can it be parametrized without using macros?)
-(defun random-acons-dep (dep state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp dep)))
-  (if (zp dep)
-    (mv-let (key state)
-            (random-symbol state)
-            (random-key-pair key state))
-    (mv-let (cr state)
-            (random-acons-dep (1- dep) state)
-            (mv-let (cdr state)
-                    (random-acons-dep (1- dep) state)
-                    (mv (cons cr cdr) state)))))
-
-;;beware this function sometimes produces huge aconses. CHECK! exponential length..                  
-(defun random-acons (state)
-  (declare (xargs :stobjs (state)))
-  (mv-let (dep state)
-          (random-small-length state)
-          (random-acons-dep (1+ dep) state)))
-
-(defthm random-acons-type
-  (aconsp (car (random-acons r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-acons))
-|#
-
-;;---------------------------------------------------------------------------
-;;---------------------------------------------------------------------------
-
-
-#|
-
-(defun test-n-atoms (n state)
-  (declare (xargs :stobjs (state)
-                  :guard (natp n)))
-  (if (zp n)
-    (value t)
-    (mv-let (a state)
-            (random-atom state)
-            (if (consp a)
-              (value nil)
-              (test-n-atoms (1- n) state)))))
-
-(time$ (test-n-atoms 100000 state))
-
-; SBCL, basis1
-; (time$ (test-n-atoms 100000 state))
-; 0.69 sec
-
-; SBCL, basis2
-; (time$ (test-n-atoms 100000 state))
-; 0.60 sec
-
-; SBCL, basis3
-; (time$ (test-n-atoms 100000 state))
-; 0.45 sec
-
-
-;|#
-
-
-
-
-
-#|
-
-(defconst *atomic-value-types*
-  '(:atom       
-     :number     
-      :complex    
-       :rational   
-        :integer     
-         :natural      
-
-     :character 
-
-     :symbol    
-      :acl2-symbol
-       :boolean
-      :keyword    
-     
-     :string))  
-
-(defun random-value (spec state)
-  (declare (xargs :stobjs (state)))
-  (if (consp spec)
-    (if (symbolp (car spec))
-      (case (car spec)
-        (quote
-         (if (and (consp (cdr spec))
-                  (null (cddr spec)))
-           (mv (cadr spec) state)
-           (mv (er hard? 'random-value "Invalid quoted value: ~x0" spec)
-               state)))
-        (cons
-         (if (and (consp (cdr spec))
-                  (consp (cddr spec))
-                  (null (cdddr spec)))
-           (mv-let (carval state)
-                   (random-value (cadr spec) state)
-                   (mv-let (cdrval state)
-                           (random-value (caddr spec) state)
-                           (mv (cons carval cdrval) state)))
-           (mv (er hard? 'random-value "Cons should take two parameters, unlike in ~x0" spec)
-               state)))
-        (listof
-|#
\ No newline at end of file
diff -Nru acl2-6.2/books/countereg-gen/random.lisp acl2-6.3/books/countereg-gen/random.lisp
--- acl2-6.2/books/countereg-gen/random.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/random.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,714 +0,0 @@
-#|$ACL2s-Preamble$;
-(begin-book);$ACL2s-Preamble$|#
-
-
-#|
-
-  A Simple Random Number Generator              Version 0.1 
-  Jared Davis <jared@cs.utexas.edu>          February 25, 2004
-  
-  This file is in the public domain.  You can freely use it for any
-  purpose without restriction. 
- 
-  This is just a basic pure multiplicative pseudorandom number gen-
-  erator.  *M31* is the 31st mersenne prime, and *P1* is 7^5 which
-  is a primitive root of *M31*, ensuring that our period is M31 - 1.
-  This idea is described in "Elementary Number Theory and its Appli-
-  cations" by Kenneth H. Rosen, Fourth Edition, Addison Wesley 1999,
-  in Chapter 10.1, pages 356-358.
- 
-  The random number generator uses a stobj, rand, to store the seed.
-  You will want to use the following functions:
-
-    (genrandom <max> rand)
-       Returns (mv k rand) where 0 <= k < max.
-            
-    (update-seed <newseed> rand)
-       Manually switch to a new seed.  By default, a large messy num-
-       ber will be used.  You probably don't need to change it, but 
-       it might be good if you want to be able to reproduce your re-
-       sults in the future.
- 
-  Normally we are not particularly interested in reasoning about ran-
-  dom numbers.  However, we can say that the number k generated is an
-  an integer, and that 0 <= k < max when max is a positive integer. 
-  See the theorems genrandom-minimum and genrandom-maximum. 
-
-  --
-  
-  Modified slightly by Peter Dillinger, 7 Feb 2008
-  With significant additions by Dimitris Vardoulakis & Peter Dillinger where
-    noted below.
-
-|#
-
-(in-package "ACL2")
-(set-verify-guards-eagerness 2)
-
-
-(defconst *M31* 2147483647)    
-(defconst *P1* 16807)          
-
-(defstobj rand
-  (seed :type integer :initially 1382728371))
-
-
-
-(defun getseed (rand)
-  (declare (xargs :stobjs (rand)))
-  (let ((s (seed rand)))
-    (if (and (integerp s) (<= 0 s))
-        s
-      0)))
-
-(local (defthm getseed-integer
-  (and (integerp (getseed rand))
-       (<= 0 (getseed rand)))
-  :rule-classes :type-prescription))
-
-(in-theory (disable getseed))
-
-(defun genrandom (max rand)
-  (declare (xargs :stobjs (rand)
-                  :guard (posp max)))
-  (let* ((new-seed (mod (* *P1* (getseed rand)) *M31*))
-         (rand (update-seed new-seed rand)))
-    (mv (if (zp max)
-          0
-          (mod new-seed max))
-        rand)))
-
-(encapsulate nil
- (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
-
- (defthm genrandom-natural
-   (natp (car (genrandom max rand)))
-   :rule-classes :type-prescription)
-
- (defthm genrandom-minimum 
-   (<= 0 (car (genrandom max rand)))
-   :rule-classes :linear)
- 
- (defthm genrandom-maximum
-   (implies (posp max)
-            (<= (car (genrandom max rand)) (1- max)))
-   :rule-classes :linear))
- 
-(in-theory (disable genrandom))
-
-
-
-;=====================================================================;
-; 
-; Begin additions by Peter Dillinger &  Dimitris Vardoulakis
-; Last modified 7 February 2008
-;
-;=====================================================================;
-
-(defun random-boolean (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (num rand)
-          (genrandom 2 rand)
-          (mv (= 1 num) rand)))
-
-(defthm random-boolean-type
-  (booleanp (car (random-boolean r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-boolean))
-
-;generate naturals according to a pseudo-geometric distribution
-(defun random-natural-basemax (base maxdigits rand)
-  (declare (xargs :stobjs (rand)
-                  :guard (and (posp base)
-                              (natp maxdigits))))
-  (if (or (zp maxdigits) (zp base))
-    (mv 0 rand)
-    (mv-let (v rand)
-            (genrandom (* 2 base) rand)
-            (if (>= v base)
-              (mv-let (v2 rand)
-                      (random-natural-basemax base (1- maxdigits) rand)
-                      (mv (+ (- v base) (* base (nfix v2))) rand))
-              (mv v rand)))))
-
-(defun random-natural (rand)
-  (declare (xargs :stobjs (rand)))
-  (random-natural-basemax 10 6 rand))
-
-(defun random-length (rand)
-  (declare (xargs :stobjs (rand)))
-  (random-natural-basemax 4 2 rand))
-
-(defthm random-natural-basemax-type
-  (natp (car (random-natural-basemax b d r)))
-  :rule-classes :type-prescription)
-
-(defthm random-natural-type
-  (natp (car (random-natural r)))
-  :rule-classes :type-prescription)
-
-(defthm random-length-type
-  (natp (car (random-length r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-natural-basemax
-                    random-natural
-                    random-length))
-
-
-
-
-; generate indices uniformly within a specified length 
-(defun random-index (len rand)
-  (declare (xargs :stobjs (rand)
-                  :guard (posp len)))
-  (genrandom len rand))
-
-             
-;generate integers according to a pseudo-geometric distribution
-(defun random-integer (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (sign rand)
-          (random-boolean rand)
-          (mv-let (nat rand)
-                  (random-natural rand)
-                  (mv (if sign nat (- nat))
-                      rand))))
-
-(defthm random-integer-type
-  (integerp (car (random-integer r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-integer))
-
-
-;or generate integers with a uniform distribution, between i & j (incl.)
-(defun random-int-between (i j rand)
-  (declare (xargs :stobjs (rand)
-                  :guard (and (integerp i)
-                              (integerp j))))
-  (let ((low (ifix (min i j)))
-        (high (ifix (max i j))))
-    (mv-let
-     (num rand)
-     (genrandom (1+ (- high low)) rand)
-     (mv (+ low num) rand))))
-
-(defthm random-int-between-type
-  (integerp (car (random-int-between i j r)))
-  :rule-classes :type-prescription)
-
-(defthm random-int-between-lower
-  (implies (and (integerp i)
-                (integerp j)
-                (<= i j))
-           (<= i (car (random-int-between i j r))))
-  :rule-classes :linear)
-
-(defthm random-int-between-upper
-  (implies (and (integerp i)
-                (integerp j)
-                (<= i j))
-           (>= j (car (random-int-between i j r))))
-  :rule-classes :linear)
-
-(in-theory (disable random-int-between))
-
-
-; generate a signed rational with pseudo-geometric numerator & denominator 
-(defun random-rational (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (numer rand)
-          (random-integer rand)
-          (mv-let (denom-1 rand)
-                  (random-natural rand)
-                  (mv (/ numer
-                         (+ 1 denom-1))
-                      rand))))
-
-(defthm random-rational-type
-  (rationalp (car (random-rational r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-rational))
-
-
-; pseudo-uniform rational between 0 and 1 (inclusive)
-(defun random-probability (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (a rand)
-          (random-natural rand)
-          (mv-let (b rand)
-                  (random-natural rand)
-                  (let ((denom (* (1+ a) (1+ b))))
-                    (mv-let (numer rand)
-                            (genrandom (1+ denom) rand)
-                            (mv (/ numer denom) rand))))))
-
-(defthm random-probability-type
-  (rationalp (car (random-probability r)))
-  :rule-classes :type-prescription)
-
-(defthm random-probability>=0
-  (<= 0 (car (random-probability r)))
-  :rule-classes (:linear :type-prescription)) 
-
-(encapsulate nil
-  (local (include-book "arithmetic/rationals" :dir :system))
-
-  #|
-  (local
-   (defthm numerator<=denominator-implies-<=1
-     (implies (and (natp n)
-                   (posp d)
-                   (<= n d))
-              (<= (* (/ d) n)
-                  1))))
-  |#
-  
-  (defthm random-probability<=1
-    (<= (car (random-probability r)) 1)
-    :rule-classes :linear))
-
-(in-theory (disable random-probability))
-
-
-;generate a random rational whose absolute value is lte x
-(defun random-rational-between (x y rand)
-  (declare (xargs :stobjs (rand)
-                  :guard (and (rationalp x)
-                              (rationalp y))))
-  (mv-let (p rand)
-          (random-probability rand)
-          (mv (rfix
-               (if (< x y)
-                 (+ x (* p (- y x)))
-                 (+ y (* p (- x y)))))
-              rand)))
-
-(defthm random-rational-between-type
-  (rationalp (car (random-rational-between i j r)))
-  :rule-classes :type-prescription)
-
-(encapsulate nil
-  (local (include-book "arithmetic-3/top" :dir :system))
-  
-  (defthm random-rational-between-lower
-    (implies (and (rationalp i)
-                  (rationalp j)
-                  (<= i j))
-             (<= i (car (random-rational-between i j r))))
-    :rule-classes :linear)
-
-  (local (defthm random-rational-between-upper-lemma2
-           (implies (and (rationalp i)
-                         (rationalp j)
-                         (rationalp p)
-                         (<= 0 p)
-                         (<= p 1)
-                         (< i j))
-                    (<= (* i p)
-                        (* j p)))
-           :rule-classes nil))
-  
-  (local 
-   (defthm random-rational-between-upper-lemma
-     (implies (and (rationalp i)
-                   (rationalp j)
-                   (rationalp p)
-                   (<= 0 p)
-                   (<= p 1)
-                   (< i j))
-              (<= (+ i (* j p))
-                  (+ j (* i p))))
-     :hints (("Goal" :use (:instance
-                           random-rational-between-upper-lemma2
-                           (p (- 1 p)))))))
-
-  (defthm random-rational-between-upper
-    (implies (and (rationalp i)
-                  (rationalp j)
-                  (<= i j))
-             (<= (car (random-rational-between i j r)) j))
-    :rule-classes :linear))
-
-(in-theory (disable random-rational-between))
-
-
-
-;generate non-zero integers according to a pseudo-geometric distribution
-(defun random-nonzero-integer (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (sign rand)
-          (random-boolean rand)
-          (mv-let (nat rand)
-                  (random-natural rand)
-                  (mv (if sign (+ 1 nat) (- -1 nat))
-                      rand))))
-
-(defthm random-nonzero-integer-type
-  (and (integerp (car (random-nonzero-integer r)))
-       (not (equal (car (random-nonzero-integer r)) 0)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-nonzero-integer))
-
-
-
-
-; generate a signed rational with pseudo-geometric numerator & denominator 
-(defun random-nonzero-rational (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (numer rand)
-          (random-nonzero-integer rand)
-          (mv-let (denom-1 rand)
-                  (random-natural rand)
-                  (mv (/ numer
-                         (+ 1 denom-1))
-                      rand))))
-
-(defthm random-nonzero-rational-type
-  (and (rationalp (car (random-nonzero-rational r)))
-       (not (equal (car (random-nonzero-rational r)) 0)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-nonzero-rational))
-
-
-; generate a (strictly) complex number from rationals
-(defun random-complex (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (rpart rand)
-          (random-rational rand)
-          (mv-let (ipart rand)
-                  (random-nonzero-rational rand)
-                  (mv (complex rpart ipart) rand))))
-
-(defthm random-complex-type
-  (complex-rationalp (car (random-complex r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-complex))
-
-
-
-
-(defmacro random-element (lst rand-rand)
-  `(mv-let (random-element-macro-idx rand)
-           (random-index (length ,lst) ,rand-rand)
-           (mv (nth random-element-macro-idx ,lst) rand)))
-
-(defmacro random-element-len (lst len rand-rand)
-  `(if (mbt (<= ,len (len ,lst)))
-     (mv-let (random-element-macro-idx rand)
-             (random-index ,len ,rand-rand)
-             (mv (nth random-element-macro-idx ,lst) rand))
-     (mv (car ,lst) rand)))
-
-
-
-(defconst *standard-chars-len*
-  (len *standard-chars*))
-
-(defun random-char (rand)
-  (declare (xargs :stobjs (rand)))
-  (random-element-len *standard-chars*
-                      *standard-chars-len*
-                      rand))
-
-(defthm random-char-type
-  (characterp (car (random-char r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-char))
-
-
-(defun random-char-list-len (len rand)
-  (declare (xargs :stobjs (rand)
-                  :guard (natp len)))
-  (if (zp len)
-    (mv nil rand)
-    (mv-let (c rand)
-            (random-char rand)
-            (mv-let (lst rand)
-                    (random-char-list-len (1- len) rand)
-                    (mv (cons c lst) rand)))))
-
-(defthm random-char-list-len-type
-  (character-listp (car (random-char-list-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-char-list-len))
-
-
-(defun random-string-len (len rand)
-  (declare (xargs :stobjs (rand)
-                  :guard (natp len)))
-  (mv-let (lst rand)
-          (random-char-list-len len rand)
-          (mv (coerce lst 'string) rand)))
-
-(defthm random-string-len-type
-  (stringp (car (random-string-len l r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-string-len))
-
-
-;generate a random string of pseudogeometric length
-(defun random-string (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (len rand)
-          (random-length rand)
-          (random-string-len len rand)))
-
-(defthm random-string-type
-  (stringp (car (random-string r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-string))
-
-
-;generate a random symbol of pseudogeometric length
-(defun random-symbol-same-package (sym rand)
-  (declare (xargs :stobjs (rand)
-                  :guard (symbolp sym)))
-  (mv-let (str rand)
-          (random-string rand)
-          (mv (intern-in-package-of-symbol str sym) rand)))
-
-(defthm random-symbol-same-package-type
-  (implies (symbolp sym)
-           (symbolp (car (random-symbol-same-package sym r))))
-  :rule-classes :type-prescription)
-
-(defthmd random-symbol-same-package_expand-package
-  (implies (symbolp sym)
-           (equal (car (random-symbol-same-package sym r))
-                  (intern-in-package-of-symbol
-                   (symbol-name (car (random-symbol-same-package sym r)))
-                   sym))))
-
-(defthmd random-symbol-same-package_suck-package
-  (implies (symbolp sym)
-           (equal (intern-in-package-of-symbol
-                   (symbol-name (car (random-symbol-same-package sym r)))
-                   sym)
-                  (car (random-symbol-same-package sym r)))))
-
-(in-theory (disable random-symbol-same-package))
-
-
-(defun random-keyword (rand)
-  (declare (xargs :stobjs (rand)))
-  (random-symbol-same-package :acl2-pkg-witness rand))
-
-(defthm random-keyword-type
-  (symbolp (car (random-keyword r)))
-  :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
-                        (sym :acl2-pkg-witness))))
-  :rule-classes :type-prescription)
-
-(encapsulate
-  ()
-
-; [Jared] Previously keyword-package-intern had the following hints:
-
-  ;; :hints (("Goal" :use (:instance keyword-package (x str) (y key))))))
-
-; But in my copy of ACL2 the keyword-package axiom doesn't seem to have any
-; variables, so I'm not sure what's going on.  I've fixed this up to work in
-; my copy, maybe this is right?
-
-  (local (defthm l0
-           (equal (member-symbol-name str nil)
-                  nil)
-           :hints(("Goal" :in-theory (enable member-symbol-name)))))
-
-  (local (defthm keyword-package-intern
-           (implies (and (stringp str)
-                         (keywordp key))
-                    (equal (symbol-package-name
-                            (intern-in-package-of-symbol str key))
-                           "KEYWORD"))
-           :hints(("Goal"
-                   :in-theory (disable keyword-package
-                                       SYMBOL-PACKAGE-NAME-INTERN-IN-PACKAGE-OF-SYMBOL)
-                   :use ((:instance keyword-package)
-                         (:instance SYMBOL-PACKAGE-NAME-INTERN-IN-PACKAGE-OF-SYMBOL
-                                    (x str)
-                                    (y key)))))
-           ))
-
-  (defthm random-keyword-keyword
-    (equal (symbol-package-name (car (random-keyword r)))
-           "KEYWORD")
-    :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
-                                    (sym :acl2-pkg-witness))))))
-
-(in-theory (disable random-keyword))
-
-
-
-
-;some composites
-
-(defun random-number (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (v rand)
-          (random-index 4 rand)
-          (case v
-                (0 (random-natural rand))
-                (1 (random-integer rand))
-                (2 (random-rational rand))
-                (t (random-complex rand)))))
-
-(defthm random-number-type
-  (acl2-numberp (car (random-number r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-number))
-
-
-(defconst *acl2-exports-len*
-  (len *acl2-exports*))
-(defconst *common-lisp-symbols-from-main-lisp-package-len*
-  (len *common-lisp-symbols-from-main-lisp-package*))
-
-(with-output
- :off (prove observation event)
- (defun random-symbol (rand)
-   (declare (xargs :stobjs (rand)))
-   (mv-let (v rand)
-           (random-index 8 rand)
-           (case
-            v
-            (0 (random-boolean rand))
-            (1 (random-element-len
-                *acl2-exports*
-                *acl2-exports-len*
-                rand))
-            (2 (random-element-len
-                *common-lisp-symbols-from-main-lisp-package*
-                *common-lisp-symbols-from-main-lisp-package-len*
-                rand))
-            (3 (random-keyword rand))
-            (4 (random-symbol-same-package 'acl2::acl2-pkg-witness rand))
-            (5 (random-symbol-same-package 'acl2-user::acl2-pkg-witness rand))
-            (6 (random-symbol-same-package 'common-lisp::acl2-pkg-witness rand))
-            (t (random-symbol-same-package 'acl2-pc::acl2-pkg-witness rand))))))
-
-(local (defthm nth-symbol-list
-         (implies (force (symbol-listp l))
-                  (symbolp (nth i l)))
-         :rule-classes :type-prescription))
-
-(with-output
- :off (prove observation event)
- (defthm random-symbol-type
-   (symbolp (car (random-symbol r)))
-   :rule-classes :type-prescription))
-
-(in-theory (disable random-symbol))
-
-
-
-(with-output
- :off (prove observation event)
- (defun random-acl2-symbol (rand)
-   (declare (xargs :stobjs (rand)))
-   (mv-let (v rand)
-           (random-index 5 rand) ; skew toward generated symbols
-           (case
-            v
-            (0 (random-boolean rand))
-            (1 (random-element-len
-                *acl2-exports*
-                *acl2-exports-len*
-                rand))
-            (2 (random-element-len
-                *common-lisp-symbols-from-main-lisp-package*
-                *common-lisp-symbols-from-main-lisp-package-len*
-                rand))
-            (t (random-symbol-same-package 'acl2::acl2-pkg-witness rand))))))
-
-(with-output
- :off (prove observation event)
- (defthm random-acl2-symbol-type
-   (symbolp (car (random-acl2-symbol r)))
-   :hints (("Goal" :use (:instance random-symbol-same-package_expand-package 
-                         (sym 'acl2::acl2-pkg-witness))))
-   :rule-classes :type-prescription))
-
-(in-theory (disable random-acl2-symbol))
-
-
-
-(defun random-atom (rand)
-  (declare (xargs :stobjs (rand)))
-  (mv-let (v rand)
-          (random-index 4 rand)
-          (case
-           v
-           (0 (random-number rand))
-           (1 (random-char rand))
-           (2 (random-symbol rand))
-           (t (random-string rand)))))
-
-(defthm random-atom-type
-  (atom (car (random-atom r)))
-  :rule-classes :type-prescription)
-
-(in-theory (disable random-atom))#|ACL2s-ToDo-Line|#
-
-
-
-
-
-
-
-
-#|
-
-(defconst *atomic-value-types*
-  '(:atom
-     :number
-      :complex
-       :rational
-        :integer
-         :natural
-
-     :character
-
-     :symbol
-      :acl2-symbol
-       :boolean
-      :keyword
-     
-     :string))
-
-(defun random-value (spec rand)
-  (declare (xargs :stobjs (rand)))
-  (if (consp spec)
-    (if (symbolp (car spec))
-      (case (car spec)
-        (quote
-         (if (and (consp (cdr spec))
-                  (null (cddr spec)))
-           (mv (cadr spec) rand)
-           (mv (er hard? 'random-value "Invalid quoted value: ~x0" spec)
-               rand)))
-        (cons
-         (if (and (consp (cdr spec))
-                  (consp (cddr spec))
-                  (null (cdddr spec)))
-           (mv-let (carval rand)
-                   (random-value (cadr spec) rand)
-                   (mv-let (cdrval rand)
-                           (random-value (caddr spec) rand)
-                           (mv (cons carval cdrval) rand)))
-           (mv (er hard? 'random-value "Cons should take two parameters, unlike in ~x0" spec)
-               rand)))
-        (listof
-|#
\ No newline at end of file
diff -Nru acl2-6.2/books/countereg-gen/rem-and-floor.lisp acl2-6.3/books/countereg-gen/rem-and-floor.lisp
--- acl2-6.2/books/countereg-gen/rem-and-floor.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/rem-and-floor.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,98 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book);$ACL2s-Preamble$|#
-
-
-(in-package "DEFDATA")
-
-(encapsulate nil
-  
-  ;; load in & build up some theory on integer division
-  
-  (local (include-book "arithmetic-5/top" :dir :system))
-  
-  (defthm floor-less
-    (implies (and (integerp x)
-                  (< 0 x)
-                  (integerp y)
-                  (<= 2 y))
-             (< (floor x y) x))
-    :rule-classes (:linear :rewrite))
-  
-  (defthm floor-0
-    (implies (equal x 0)
-             (equal (floor x y) x)))
-  
-  (defthm floor-less-eq
-    (implies (and (integerp x)
-                  (<= 0 x)
-                  (integerp y)
-                  (<= 2 y))
-             (<= (floor x y) x))
-    :hints (("Goal" :in-theory (disable floor)
-                    :cases ((< 0 x))))
-    :rule-classes (:linear :rewrite))
-
-  (defthm rem-floor-decomp
-    (implies (and (integerp x)
-                  (<= 0 x)
-                  (integerp y)
-                  (<= 0 y))
-             (equal (+ (rem x y)
-                       (* y
-                          (floor x y)))
-                    x)))
-  
-  (defthm rem-0
-    (equal (rem 0 x)
-           0))
-  
-  (defthm rem--0
-    (implies (acl2-numberp x)
-             (equal (rem x 0)
-                    x)))
-  
-  (defthm rem-integerp
-    (implies (and (integerp x)
-                  (integerp y))
-             (integerp (rem x y)))
-    :rule-classes (:rewrite :type-prescription))
-  
-  (defthm rem-upper-bound
-    (implies (and (integerp x) (<= 0 x)
-                  (integerp y) (< 0 y))
-             (<= (rem x y) x))
-    :rule-classes (:linear :rewrite))
-
-  (local (in-theory (disable rem)))
-  
-  (defthm rem-lower-bound2
-    (implies (and (integerp x) (<= 0 x) (integerp y) (<= 0 y))
-             (<= 0 (rem x y)))
-    :rule-classes (:linear :rewrite)
-    :hints (("Goal" :cases ((equal x 0)
-                            (equal y 0)))))
-  
-  (defthm rem-upper-bound2
-    (implies (and (integerp x) (<= 0 x) (integerp y) (< 0 y))
-             (< (rem x y) y))
-    :rule-classes (:linear :rewrite)
-    :hints (("Goal" :cases ((equal x 0)))))
-  
-  (defthm floor-integerp
-    (implies (and (integerp x)
-                  (integerp y))
-             (integerp (floor x y)))
-    :rule-classes (:rewrite :type-prescription))
-  
-  (defthm floor-nat
-    (implies (and (integerp x)
-                  (<= 0 x)
-                  (integerp y)
-                  (<= 0 y))
-             (<= 0 (floor x y)))
-    :rule-classes (:linear :rewrite)))
-
-(in-theory (disable rem floor))#|ACL2s-ToDo-Line|#
-
diff -Nru acl2-6.2/books/countereg-gen/scratchpad.lsp acl2-6.3/books/countereg-gen/scratchpad.lsp
--- acl2-6.2/books/countereg-gen/scratchpad.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/scratchpad.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,2560 +0,0 @@
-; ****************** BEGIN INITIALIZATION FOR ACL2s MODE ****************** ;
-; (Nothing to see here!  Your actual file is after this initialization code);
-
-#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading the TRACE* book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
-; only load for interactive sessions: 
-#+acl2s-startup (include-book "trace-star" :uncertified-okp nil :dir :acl2s-modes :ttags ((:acl2s-interaction)) :load-compiled-file nil);v4.0 change
-
-#+acl2s-startup (assign evalable-printing-abstractions nil)
-
-;arithmetic book
-#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading arithmetic-5/top book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
-(include-book "arithmetic-5/top" :dir :system)
-
-;basic thms/lemmas about lists
-#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading coi/lists book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
-(include-book "coi/lists/basic" :dir :system)
-
-#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading ACL2's lexicographic-ordering-without-arithmetic book.~%This indicates that either your ACL2 installation is missing the standard books are they are not properly certified.") (value :invisible))
-(include-book "ordinals/lexicographic-ordering-without-arithmetic" :dir :system)
-
-#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading the CCG book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
-(include-book "ccg" :uncertified-okp nil :dir :acl2s-modes :ttags ((:ccg)) :load-compiled-file nil);v4.0 change
-
-#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading DataDef+RandomTesting book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
-(include-book "acl2-datadef/acl2-check" :uncertified-okp nil :dir :acl2s-modes :load-compiled-file :comp)
-
-#+acl2s-startup (er-progn (assign fmt-error-msg "Problem loading ACL2s customizations book.~%Please choose \"Recertify ACL2s system books\" under the ACL2s menu and retry after successful recertification.") (value :invisible))
-(include-book "custom" :dir :acl2s-modes :uncertified-okp nil :load-compiled-file :comp)
-
-#+acl2s-startup (er-progn (assign fmt-error-msg "Problem setting up ACL2s mode.") (value :invisible))
-
-;Settings common to all ACL2s modes
-(acl2s-common-settings)
-
-; Non-events:
-(set-guard-checking :none)
-
-;Settings for avoiding control stack errors for testing non-tail-recursive fns
-(defdata-testing pos :test-enumerator nth-pos-testing)
-(defdata-testing integer :test-enumerator nth-integer-testing)
-(defdata-testing nat :test-enumerator nth-nat-testing)
-(defdata-testing neg :test-enumerator nth-neg-testing)
-
-
-; ******************* END INITIALIZATION FOR ACL2s MODE ******************* ;
-;$ACL2s-SMode$;ACL2s
-;$ACL2s-LMode$;Demo
-
-(in-package "ACL2")
-
-
-(defdata reg nat)
-(defdata pc nat)
-(defdata register (map reg nat))
-(defdata dmemory (map nat integer))
-                      
-
-(defdata operation-code (enum '(add sub mul load loadi store bez jump)))
-
-       
-(defdata inst (record (opcode . operation-code)
-                      (rc . reg)
-                      (ra . reg)
-                      (rb . reg)))
-
-(defdata imemory (map pc inst))
-
-(defdata ISA (record 
-              (pc . pc)
-              (regs . register)
-              (imem . imemory)
-              (dmem . dmemory)))
-
- 
-(defdata latch1 (record (validp . boolean)
-                        (op . operation-code)
-                        (rc . reg)
-                        (ra . reg)
-                        (rb . reg)
-                        (pch . pc)))
-
-
-(defdata latch2 (record (validp . boolean)
-                        (op . operation-code)
-                        (rc . reg)
-                        (ra-val . nat)
-                        (rb-val . nat)
-                        (pch . pc)))
-
-  
-(defdata MAA (record  (pc . pc)
-                      (regs . register)
-                      (imem . imemory)
-                      (dmem . dmemory)
-                      (ltch1 . latch1)
-                      (ltch2 . latch2)))
-
-(acl2s-defaults :set num-trials 1)
-
-;:set-ignore-ok t
-;Here is one of the 3000 subgoals which failed:
-
-;(set-acl2s-random-testing-debug 1)
-
-;(trace$ process-dependencies do-let*-ordering conditional-eval)
-
-(test?
- (implies (and (maap w)
-               (equal (mget :pc w)
-                      (+ 1 (mget :pch (mget :ltch2 w))))
-               (equal t 
-                      (mget :validp (mget :ltch2 w)))
-               (equal (mget (mget :rb (mget (mget :pch (mget :ltch2 w))
-                                            (mget :imem w)))
-                            (mget :regs w))
-                      (mget :rb-val (mget :ltch2 w)))
-               (equal (mget :opcode (mget (mget :pch (mget :ltch2 w))
-                                          (mget :imem w)))
-                      'bez)
-               (equal 0
-                      (mget (mget :ra (mget (mget :pch (mget :ltch2 w))
-                                            (mget :imem w)))
-                            (mget :regs w)))
-               
-               (equal 0 (mget :ra-val (mget :ltch2 w)))
-               
-               )
-          (not (equal (mget :op (mget :ltch2 w)) 'bez))))
-
-(acl2s-defaults :set num-trials 100)
-
-(test? 
-       (IMPLIES (AND (MAap W)
-               (INTEGERP (MGET :PC W))
-               (EQUAL (+ 1 (MGET :PCH (MGET :LTCH2 W)))
-                      (MGET :PC W))
-               (EQUAL T (MGET :VALIDP (MGET :LTCH2 W)))
-               (EQUAL (MGET (MGET :RB (MGET (MGET :PCH (MGET :LTCH2 W))
-                                            (MGET :IMEM W)))
-                            (MGET :REGS W))
-                      (MGET :RB-VAL (MGET :LTCH2 W)))
-               (EQUAL (MGET :OPCODE (MGET (MGET :PCH (MGET :LTCH2 W))
-                                          (MGET :IMEM W)))
-                      'BEZ)
-               (EQUAL 0
-                      (MGET (MGET :RA (MGET (MGET :PCH (MGET :LTCH2 W))
-                                            (MGET :IMEM W)))
-                            (MGET :REGS W)))
-               (INTEGERP (+ (MGET :PCH (MGET :LTCH2 W))
-                            (MGET :RB-VAL (MGET :LTCH2 W))))
-               (NOT (MGET :VALIDP (MGET :LTCH1 W)))
-               (EQUAL (MGET :OP (MGET :LTCH2 W)) 'BEZ)
-               (EQUAL 0 (MGET :RA-VAL (MGET :LTCH2 W))))
-          
-          (NOT (INTEGERP (+ 1 (MGET :PCH (MGET :LTCH2 W))
-                            (MGET (MGET :RB (MGET (MGET :PCH (MGET :LTCH2 W))
-                                                  (MGET :IMEM W)))
-                                  (MGET :REGS W)))))))
-
-(test?
- (IMPLIES
- (AND
-  (MAaP W)
-  (EQUAL (MGET :OPCODE (MGET (MGET :PCH (MGET :ltch2 W))
-                             (MGET :IMEM W)))
-         'BEZ)
-  (ACL2-NUMBERP (MGET :PCH (MGET :ltch2 W)))
-  (EQUAL NIL (MGET :VALIDP (MGET :ltch1 W)))
-  (EQUAL (MGET :OP (MGET :ltch2 W)) 'BEZ)
-  (NOT (EQUAL 0 (MGET :RA-VAL (MGET :ltch2 W))))
-  
-  (INTEGERP (MGET :PC W))
-  (EQUAL (+ 1 (MGET :PCH (MGET :ltch2 W)))
-         (MGET :PC W))
-  (EQUAL T (MGET :VALIDP (MGET :ltch2 W)))
-  (EQUAL (MGET (MGET :RA (MGET (MGET :PCH (MGET :ltch2 W))
-                               (MGET :IMEM W)))
-               (MGET :REGS W))
-         (MGET :RA-VAL (MGET :ltch2 W))))
- (NOT (EQUAL (MGET (MGET :RB (MGET (MGET :PCH (MGET :ltch2 W))
-                                   (MGET :IMEM W)))
-                   (MGET :REGS W))
-             (MGET :RB-VAL (MGET :ltch2 W))))))
-
-
-
-
-(test?
- (IMPLIES
- (AND
-  (MAaP W)
-  (EQUAL (MGET :OPCODE (MGET (MGET :PCH (MGET :ltch2 W))
-                             (MGET :IMEM W)))
-         'BEZ)
-  (ACL2-NUMBERP (MGET :PCH (MGET :ltch2 W)))
-  (EQUAL NIL (MGET :VALIDP (MGET :ltch1 W)))
-  (EQUAL (MGET :OP (MGET :ltch2 W)) 'BEZ)
-  (NOT (EQUAL 0 (MGET :RA-VAL (MGET :ltch2 W))))
-  #|
-  (MAaP
-      (MSET :PC (+ 1 (MGET :PC W))
-            (MSET :DMEM (MGET :DMEM W)
-                  (MSET :IMEM (MGET :IMEM W)
-                        (MSET :REGS (MGET :REGS W)
-                              ;(MSET :TYPE 'MA
-                                    (MSET :ltch1
-                                          ;(MSET :TYPE 'LATCH1
-                                                (MSET :VALIDP NIL NIL)
-                                          (MSET :ltch2
-                                                ;(MSET :TYPE 'LATCH2
-                                                      (MSET :VALIDP NIL NIL)
-                                                NIL)))))))
-  |#
-  (INTEGERP (MGET :PC W))
-  (EQUAL (+ 1 (MGET :PCH (MGET :ltch2 W)))
-         (MGET :PC W))
-  (EQUAL T (MGET :VALIDP (MGET :ltch2 W)))
-  (EQUAL (MGET (MGET :RA (MGET (MGET :PCH (MGET :ltch2 W))
-                               (MGET :IMEM W)))
-               (MGET :REGS W))
-         (MGET :RA-VAL (MGET :ltch2 W))))
- (NOT (EQUAL (MGET (MGET :RB (MGET (MGET :PCH (MGET :ltch2 W))
-                                   (MGET :IMEM W)))
-                   (MGET :REGS W))
-             (MGET :RB-VAL (MGET :ltch2 W))))))
- 
-;Mitesh's bug (removed from stall1p the predicate (eqyal l1ra l2rc))
-(test?
-(IMPLIES
- (AND
-  (EQUAL (MGET :PC W)
-         (+ 1 (MGET :PCH (MGET :Ltch1 W))))
-  (MAAP W)
-  (EQUAL (MGET :OPCODE (MGET (MGET :PCH (MGET :Ltch2 W))
-                             (MGET :IMEM W)))
-         'LOADI)
-  (ACL2-NUMBERP (MGET :PCH (MGET :Ltch2 W)))
-  (EQUAL (MGET :OP (MGET :Ltch2 W))
-         'LOADI)
-  (NOT (EQUAL (MGET :OPCODE (MGET (MGET :PC W) (MGET :IMEM W)))
-              'JUMP))
-  (NOT (EQUAL (MGET :OPCODE (MGET (MGET :PC W) (MGET :IMEM W)))
-              'BEZ))
-  #|
-  (MAAP
-   (MSET
-    :PC (+ 1 (MGET :PC W))
-    (MSET
-     :DMEM (MGET :DMEM W)
-     (MSET
-      :IMEM (MGET :IMEM W)
-      (MSET
-       :REGS
-       (MSET (MGET :RC (MGET :Ltch2 W))
-             (MGET (MGET :RA-VAL (MGET :Ltch2 W))
-                   (MGET :DMEM W))
-             (MGET :REGS W))
-       ;(MSET
-        ;:TYPE 'MA
-        (MSET
-         :Ltch1
-         (MSET
-              :OP
-              (MGET :OPCODE (MGET (MGET :PC W) (MGET :IMEM W)))
-              (MSET :RA
-                    (MGET :RA (MGET (MGET :PC W) (MGET :IMEM W)))
-                    (MSET :RB
-                          (MGET :RB (MGET (MGET :PC W) (MGET :IMEM W)))
-                          (MSET :RC
-                                (MGET :RC (MGET (MGET :PC W) (MGET :IMEM W)))
-                                (MSET :PCH (MGET :PC W)
-                                      (MSET :TYPE 'Ltch1
-                                            (MSET :VALIDP T NIL)))))))
-         (MSET
-          :Ltch2
-          (MSET
-              :OP 'LOADI
-              (MSET :RC (MGET :RC (MGET :Ltch1 W))
-                    (MSET :PCH (MGET :PCH (MGET :Ltch1 W))
-                          (MSET :TYPE 'Ltch2
-                                (MSET :RA-VAL
-                                      (MGET (MGET :RA (MGET :Ltch1 W))
-                                            (MGET :REGS W))
-                                      (MSET :RB-VAL
-                                            (MGET (MGET :RB (MGET :Ltch1 W))
-                                                  (MGET :REGS W))
-                                            (MSET :VALIDP T NIL)))))))
-          NIL)))))))
-  |#
-  (INTEGERP (MGET :PC W))
-  (EQUAL (+ 2 (MGET :PCH (MGET :Ltch2 W)))
-         (MGET :PC W))
-  (EQUAL T (MGET :VALIDP (MGET :Ltch1 W)))
-  (EQUAL T (MGET :VALIDP (MGET :Ltch2 W)))
-  (EQUAL (MGET :OPCODE (MGET (MGET :PCH (MGET :Ltch1 W))
-                             (MGET :IMEM W)))
-         'LOADI)
-  (EQUAL (+ 1 (MGET :PCH (MGET :Ltch2 W)))
-         (MGET :PCH (MGET :Ltch1 W)))
-  (EQUAL (MGET :RA (MGET (MGET :PCH (MGET :Ltch1 W))
-                         (MGET :IMEM W)))
-         (MGET :RA (MGET :Ltch1 W)))
-  (EQUAL (MGET :RC (MGET (MGET :PCH (MGET :Ltch1 W))
-                         (MGET :IMEM W)))
-         (MGET :RC (MGET :Ltch1 W)))
-  (EQUAL (MGET (MGET :RA (MGET (MGET :PCH (MGET :Ltch2 W))
-                               (MGET :IMEM W)))
-               (MGET :REGS W))
-         (MGET :RA-VAL (MGET :Ltch2 W)))
-  (EQUAL (MGET :RC (MGET (MGET :PCH (MGET :Ltch2 W))
-                         (MGET :IMEM W)))
-         (MGET :RC (MGET :Ltch2 W)))
-  (EQUAL (MGET :OP (MGET :Ltch1 W))
-         'LOADI))
- ;conclusion
- (EQUAL (MGET (MGET :RA (MGET :Ltch1 W))
-              (MSET (MGET :RC (MGET :Ltch2 W))
-                    (MGET (MGET :RA-VAL (MGET :Ltch2 W))
-                          (MGET :DMEM W))
-                    (MGET :REGS W)))
-        (MGET (MGET :RA (MGET :Ltch1 W))
-              (MGET :REGS W)))))
-
-(mutual-recursion
- ;cons up calls
- (defun build-enumcall-rec-lst1 (te-lst typ defs sizes wrld state ans)
-    (declare (xargs :stobjs (state) :mode :program))
-   (if (endp te-lst)
-     (value ans)
-     (er-let* ((call 
-                (build-enumcall-rec1 (car te-lst) typ
-                                    defs sizes wrld state)))
-       (build-enumcall-rec-lst1 (cdr te-lst) typ
-                               defs sizes wrld state (append ans (list call)))))) 
-      
- (defun build-enumcall-rec1 (te typ defs size wrld state)
-   (declare (xargs :stobjs (state) :mode :program))
-   (cond 
-;constant values are returned unchanged
-    ((defdata::possible-constant-valuep te)
-     (value te));constant (singleton type)
-;primitive/custom/registered-custom types dont have definition bodies
-    ((or (defdata::is-a-registered-custom-type te wrld)
-         (defdata::is-a-custom-type te wrld))
-     (er-let* ((enum-info 
-                (get-enum-info te 'build-enumcall-rec wrld state)))
-       (build-enumcall-from-enum-info te enum-info 
-                                      'build-enumcall-rec state)))
-;defdata type has definition stored in types-info-table
-      ;; defdata mutually-recursive sibling type
-      ((and (symbolp te)
-            (not (eq te typ))
-            (assoc-eq te defs))
-       (build-enumcall-rec1 (car (defdata::get-val te defs))
-                            te defs (1- size) wrld state))
-      ;; defdata type other than typ (and also not a sibling mut-rec type)         
-      ((and (symbolp te)
-            (not (eq te typ))
-            (defdata::is-a-defdata-type te wrld))
-       (mv-let (size state);take new size just in case its recursive
-               (random-small-length state)
-               (let* ((tbl (table-alist 'defdata::types-info-table wrld))
-                      (defs (fifth (defdata::get-val te tbl)))
-                      (def (car (defdata::get-val te defs))))
-                 (er-let* ((call (build-enumcall-rec1 
-                                  def te defs size wrld state)))
-                   (value (list te :size size call)))))) 
-      ;; defdata type same as typ
-      ((eq te typ)
-       (build-enumcall-rec1 (car (defdata::get-val typ defs))
-                            typ defs (1- size) wrld state))
-      ((atom te) 
-       (er soft 'build-enum-rec "~x0 is an ill-formed type exp~%" te))
-;consp 
-;union type expression
-      ((defdata::mem1 (car te) '(oneof anyof))
-       (let ((bi-s (get-base-member-i-s (cdr te) 0 typ))
-             (ri-s (get-recursive-member-i-s (cdr te) 0 typ)))
-         (if (or (= size 0) (null ri-s))
-;Either non-recursive union expression or recursion size limit reached
-           (er-let* ((bi (random-elem bi-s state))
-;randomly pick a base member
-                     (call (build-enumcall-rec1 (nth bi (cdr te)) typ defs
-                                                size wrld state)))
-             (value (list :bindex bi (len bi-s) call)))
-;otherwise pick a recursive member and recurse
-           (er-let* ((ri (random-elem ri-s state))
-                     (call (build-enumcall-rec1 (nth ri (cdr te)) typ defs
-                                                size wrld state)))
-             (value (list :rindex ri (len ri-s) call))))))
-;macro-call/product-expression
-       (t (build-enumcall-rec-lst1 (cdr te)
-                                   typ defs
-                                   size wrld state (list (car te))))))
-
-)
-
-
-(defun coerce-well-formedness (alist)
-  (if (good-map alist)
-    alist
-    (if (endp alist)
-      nil
-      (if (wf-keyp (caar alist))
-        (s (caar alist) (cdar alist)
-           (coerce-well-formedness (cdr alist)))
-        (coerce-well-formedness (cdr alist))))))
-
-(defthm coerce-well-formedness-gives-good-map
-  (good-map (coerce-well-formedness r)))
-
-(defun val (x alist)
-  (cdr (assoc-equal x alist)))
-
-(defmacro defdata-map (tname texp1 texp2)
-  (let ((orig-pred (defdata::modify-symbol "IFR" tname "P"))
-        (ifr-name (defdata::modify-symbol "IFR" tname nil)) 
-        (pred (defdata::modify-symbol nil tname "P"))
-        (enum (defdata::modify-symbol "NTH-" tname nil)))
-    `(progn
-      (defdata ,ifr-name
-        (listof (cons ,texp1 ,texp2)))
-      (defun ,pred (v)
-        (declare (xargs :guard t))
-        (and (good-map v)
-             (,orig-pred v)))
-      (defun ,enum (n)
-        (coerce-well-formedness
-         (,(defdata::modify-symbol "NTH-IFR" tname nil) n)))
-      (table
-            defdata::types-info-table
-             ',tname 
-             '(t ,enum ,pred nil ((,tname ,ifr-name))
-                      t);defdata == derived data-type
-             :put))))
-
-
-;CCG example
-(defun nnf (f)
-   (cond ((posp f) f)
-        ((and (eq (first f) 'not) (posp (second f))) f)
-        ((and (eq (first f) 'not) (eq 'not (first (second f)))) (nnf f))
-        ((eq (first f) 'and) (list 'and (nnf (second f)) (nnf (third f))))
-        ((eq (first f) 'or) (list 'or (nnf (second f)) (nnf (third f))))
-        ((eq (first f) 'implies) (list 'implies (nnf (second f)) (nnf (third f))))
-        ((and (eq (first f) 'not)
-              (eq 'and (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'or (nnf (list 'not lhs)) (nnf (list 'not rhs)))))
-        ((and (eq (first f) 'not)
-              (eq 'or (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'and (nnf (list 'not lhs)) (nnf (list 'not rhs)))))     
-         ((and (eq (first f) 'not)
-              (eq 'implies (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'and (nnf lhs) (nnf (list 'not rhs)))))
-        (t f)))
-
-;GOOD EXAMPLE
-(defthm rel-count-stupid
-  (implies (rel (remove-el y A) (remove-el y B))
-           (equal (count-el x A)
-                  (count-el x B))))
-#|
-ACL2 Warning [Free] in ( DEFTHM REL-COUNT-STUPID ...):  A :REWRITE
-rule generated from REL-COUNT-STUPID contains the free variables B
-and Y.  These variables will be chosen by searching for an instance
-of (REL (REMOVE-EL Y A) (REMOVE-EL Y B)) in the context of the term
-being rewritten.  This is generally a severe restriction on the applicability
-of a :REWRITE rule.  See :DOC free-variables.
-
-
-<< Starting proof tree logging >>
-
-
-[Note: We now enable non-linear arithmetic.]
-
-
-[Note:  A hint was supplied for our processing of the goal above. 
-Thanks!]
-
-Random testing above formula with type-alist 
-((Y ALL) (A ALL) (B ALL) (X ALL))
-
-
-We falsified the conjecture. Here is the counterexample:
- -- (B (0 . T)), (A NIL), (Y 0) and (X 0)
-
-Cases in which the conjecture is true include:
- -- (B 3), (A #\a), (Y #\b) and (X (0 T T))
- -- (B 0), (A 0), (Y #\a) and (X NIL)
- -- (B T), (A 0), (Y T) and (X (0 . 0))
-
-We tried 100 random trials, 55 of which satisfied the hypotheses. Of
-these, one was a counterexample and 54 were witnesses.
-See :doc random-testing for more information.
-
-Summary
-Form:  ( DEFTHM REL-COUNT-STUPID ...)
-Rules: NIL
-Warnings:  Free
-Time:  15.44 seconds (prove: 15.44, print: 0.00, proof tree: 0.00, other: 0.00)
-
-ACL2 Error in ( DEFTHM REL-COUNT-STUPID ...):  See :DOC failure.
-
-******** FAILED ********
-|#
-
-(defun sum-n (n)
-  (if (zp n)
-    0
-    (+ (nfix n) (sum-n (- n 1)))))
-(defthm sum-less-than
-  (implies (and (natp x)
-                (natp y)
-                (< (sum-n x) (sum-n y)))
-           (< x y))
-  :rule-classes (:rewrite))
-#|
-(defthm whatman
-  (implies (and (natp y)
-                (natp p)
-                (< (sum-n y) (sum-n (+ 1 p)))
-                (<= p y))
-           (equal (equal y p) t)))
-|#
-
-(defun rev (x)
-  (if (consp x)
-      (append (rev (cdr x)) (cons (car x) nil))
-    x))
-
-;(thm (true-listp (rev (rev x))))
-
-
-#|
-(include-book "acl2-check")
-
-(set-acl2s-random-testing-num-of-witnesses-to-generate 10)
-(set-acl2s-random-testing-num-of-counterexamples-to-generate 10)
-(set-acl2s-random-testing-verbose t)
-(set-acl2s-random-testing-enabled t)
-(set-acl2s-random-testing-max-num-of-random-trials 100)
-(set-acl2s-random-testing-debug nil)
-|#
-;(set-acl2s-random-testing-enabled nil)
-
-
-;(thm (equal (rev (rev x)) x))
-
-(program)
-(DEFUN ROTATE-RIGHT (L)
-                    (DECLARE (XARGS :GUARD (TRUE-LISTP L)))
-                    (IF (ENDP L)
-                        NIL
-                        (CONS (CAR (LAST L)) (BUTLAST L 1))))
-(set-acl2s-random-testing-use-instantiation-method 'simple)
-(trace$ thm-fn translate)
-(test? (implies (true-listp l) (equal (len (rotate-right l)) (len l))))
-
-(logic)
-
-(defconst *colors* '(blue red yellow green fuchsia purple))
-
-(set-acl2s-random-testing-enabled t)
-
-;(assign make-event-debug t)
-
-(defdata color (enum *colors*))
-
-(assign make-event-debug t)
-
-(defdata row (listof color))
-(set-acl2s-defdata-verbose t)
-(set-acl2s-random-testing-enabled t)
-;(set-ccg-inhibit-output-lst *ccg-valid-output-names*)
-(set-ccg-print-proofs t)
-
-(defun canComposeRes (res-lst target-res acc-res)
-  (if (endp res-lst)
-    (if (equal target-res acc-res)
-      t
-      nil)
-    (or (canComposeRes (rest res-lst) target-res (compose-in-parallel acc-res (first res-lst)))
-        (canComposeRes (rest res-lst) target-res (compose-in-serial acc-res (first res-lst))))))
-    
-
-(defdata lon (listof nat))
-
-(test? (implies (true-listp n) (< (len n) 5)))
-
-(set-acl2s-random-testing-num-of-witnesses-to-generate 3)
-(set-acl2s-random-testing-num-of-counterexamples-to-generate 0)
-;(trace$ print-stats)
-(set-acl2s-random-testing-verbose nil)
-
-;(include-book "arithmetic/top" :dir :system)
-;(include-book "coi/lists/list-top" :dir :system)
-
-
-(set-acl2s-random-testing-max-num-of-random-trials 300)
-
-(thm (IMPLIES (AND (RATIONALP X)
-                    (RATIONALP Y)
-                    (NOT (EQUAL Y 0))
-                    (<= 0 Y)
-                    (<= 0 X)
-                    (<= Y X)
-                    (INTEGERP (+ 1 (- X)))
-                    (< 1 X)
-                    (NOT (INTEGERP (+ 1 (- X) (* 2 Y))))
-                    (<= X (+ 1 (* 2 Y))))
-               (< X
-                  (+ 1 (DENOMINATOR (+ 1 (- X) (* 2 Y)))
-                     (NUMERATOR (+ 1 (- X) (* 2 Y)))))))
-
-(thm? (implies (true-listp x)
-              (equal (reverse (reverse x)) x)))
-
-
-
-(test? (implies (and (posp (car x))
-                     (equal y y)
-                     (equal z y)
-                     (posp (cdr x)))
-                (<= (cdr x) (len x)))
-       )
-(test? (implies (and (posp (car x))
-              (posp (cdr x)))
-         (<= (cdr x) (len x)))
-              )
-
-(thm? (equal x (cons z y)))
-
-
-(thm? (equal x y))
-
-
-(thm (implies (true-listp x)
-              (equal (reverse (reverse x)) x)))
-
-(include-book "arithmetic-5/top" :dir :system)
-(defthm ok (IMPLIES (AND (RATIONALP X)
-                    (RATIONALP Y)
-                    (NOT (EQUAL Y 0))
-                    (<= 0 Y)
-                    (<= 0 X)
-                    (<= Y X)
-                    (INTEGERP (+ 1 (- X)))
-                    (< 1 X)
-                    (NOT (INTEGERP (+ 1 (- X) (* 2 Y))))
-                    (<= X (+ 1 (* 2 Y))))
-               (< X
-                  (+ 1 (DENOMINATOR (+ 1 (- X) (* 2 Y)))
-                     (NUMERATOR (+ 1 (- X) (* 2 Y)))))))
-
-(defun pascal (r c)
-  (if (or (zp r) (zp c) (>= c r))
-    1
-    (+ (pascal (- r 1) c)
-       (pascal (- r 1) (- c 1)))))
-
-(defun app (x y)
-  (if (endp x)
-    y
-    (cons (car x) (app (cdr x) y))))
-
-(test? (implies (and (true-listp x)
-                     (true-listp y))
-                (true-listp (app x y))))
-
-;(pascal 200 30)
-
-(defun fact (n)
-  (if (zp n)
-      1
-    (* n (fact (- n 1)))))
-
-(defun choose (n k)
-  (/ (fact n)
-     (* (fact k) (fact (- n k)))))
-
-
-(thm
- (implies (and (natp x) (natp y) (>= x y)
-               (or (zp x) (zp y) (>= y x)))
-          (= (pascal x y) (choose x y))))
-
-
-(thm
- (implies (and (natp x) (natp y) (>= x y)
-               (not (or (zp x) (zp y) (>= y x)))
-               (= (pascal (- x 1) y)
-                  (choose (- x 1) y))
-               (= (pascal (- x 1) (- y 1))
-                  (choose (- x 1) (- y 1))))
-          (= (pascal x y) (choose x y))))
-
-
-(test? (implies (rationalp x)
-                (not (equal x (/ 12312312 213712312445)))))
-
-
-
-(test? (implies (and (posp (car x))
-              (posp (cdr x)))
-         (<= (cdr x) (len x)))
-              )
-
-
-
-
-;(include-book "acl2-check")
-
-(defun app (x y)
-  (if (endp x)
-    y
-    (cons (car x) (app (cdr x) y))))
-
-(thm-fn '(implies (and (true-listp x)
-                                     (true-listp y))
-                                (true-listp (app x y)))
-         state 
-         '(("Goal"
-            ;:do-not-induct t 
-            :do-not '(generalize fertilize)))
-         nil nil)
-
-(test? (implies (and (true-listp x) (true-listp y))
-                (true-listp (app x y))))
-
-
-(defun split-list (x)
-  (cond ((atom x) (mv nil nil))
-        ((atom (cdr x)) (mv x nil))
-        (t (mv-let (a b)
-                   (split-list (cddr x))
-                   (mv (cons (car x) a) (cons (cadr x) b))))))
-
-
-
-
-(set-acl2s-random-testing-enabled nil)
-(defun wffp-flag (flag sexp)
-  (if (equal flag 'term)
-    (cond ((endp sexp) t)
-          ((or (equal (car sexp) 'or)
-               (equal (car sexp) 'and)) (and (> (length sexp) 2)
-                                             (wffp-flag 'list (cdr sexp))))
-          ((equal (car sexp) 'not) (and (= (length sexp) 2)
-                                        (wffp-flag 'term (cadr sexp))))
-          ((or (equal (car sexp) 'iff)
-               (equal (car sexp) 'xor)) (and (= (length sexp) 3)
-                                             (wffp-flag 'list (cdr sexp))))
-          ((equal (car sexp) 'ite) (and (= (length sexp) 4)
-                                        (wffp-flag 'list (cdr sexp))))
-          (t nil))
-    (cond ((endp sexp) t)
-          (t (and (wffp-flag 'term (car sexp))
-                  (wffp-flag 'list (cdr sexp)))))))
-(set-acl2s-random-testing-enabled t)
-(set-acl2s-random-testing-max-num-of-random-trials 20)
-(set-acl2s-random-testing-verbose nil)
-
-(defun maj (p q c)
-  (or (and p q)
-      (or (and p c)
-          (and q c))))
-
-(defun full-adder (p q c)
-  (mv (xor p (xor q c))
-      (maj p q c)))
-(set-guard-checking t)
-
-(defun serial-adder (a b c)
-  (cond ((and (endp a) (endp b))
-         (list c))
-        (t (mv-let (sum cout)
-                   (full-adder (first a) (first b) c)
-                   (cons sum (serial-adder (rest a) (rest b) cout))))))
-
-(set-acl2s-random-testing-verbose t)
-(set-acl2s-random-testing-enabled t)
-(set-acl2s-random-testing-max-num-of-random-trials 50)
-
-; utility function for making symbols
-(defun bvname (basename width count)
-  (cond ((zp width) nil)
-        (t (cons (intern (coerce
-                          (append (coerce basename 'list)
-                                  (list #\[)
-                                  (explode-nonnegative-integer count 10 nil)
-                                  (list #\]))
-                          'string)
-                         "ACL2")
-                 (bvname basename (1- width) (1+ count))))))
-
-;(defdata-testing pos :test-enumerator nth-pos-testing)
-;(defdata-testing integer :test-enumerator nth-integer-testing)
-;(defdata-testing nat :test-enumerator nth-nat-testing)
-;(defdata-testing neg :test-enumerator nth-neg-testing)
-;(set-acl2s-random-testing-use-test-enumerator t)
-
-(thm 
-     (implies (and (stringp bvaname)
-                   (posp n)
-                   (natp b))
-              (symbol-listp (bvname bvaname n b))))
-
-
-(set-acl2s-random-testing-enabled t)
-
-;this checks that top goal counterexamples are printed
-
-(test? (implies (and (posp (car x))
-              (posp (cdr x)))
-         (<= (cdr x) (len x)))
-              )
-
-
-
-
-(set-acl2s-random-testing-verbose t)
-
-(thm? (implies (and (or (true-listp x)
-                             (stringp x))
-                         (not (equal x nil))
-                         (not (equal x "")))
-                    (> (len x) 0)))
-
-;TODO: NIL causing problem above in bindings
-
-(thm (iff (implies p q) (or (not p) p)))
-
-(test? (implies (and (posp (car x))
-                     (equal y y)
-                     (equal z y)
-                     (posp (cdr x)))
-                (<= (cdr x) (len x)))
-       )
-
-(include-book "arithmetic/top" :dir :system)
-;(include-book "coi/lists/list-top" :dir :system)
-
-
-(set-acl2s-random-testing-max-num-of-random-trials 300)
-
-(thm? (IMPLIES (AND (RATIONALP X)
-                    (RATIONALP Y)
-                    (NOT (EQUAL Y 0))
-                    (<= 0 Y)
-                    (<= 0 X)
-                    (<= Y X)
-                    (INTEGERP (+ 1 (- X)))
-                    (< 1 X)
-                    (NOT (INTEGERP (+ 1 (- X) (* 2 Y))))
-                    (<= X (+ 1 (* 2 Y))))
-               (< X
-                  (+ 1 (DENOMINATOR (+ 1 (- X) (* 2 Y)))
-                     (NUMERATOR (+ 1 (- X) (* 2 Y)))))))
-(set-acl2s-random-testing-num-of-counterexamples-to-generate 10)
-(test? (implies (and (posp (car x))
-                     (equal y y)
-                     (equal z y)
-                     (posp (cdr x)))
-                (<= (cdr x) (len x)))
-       )
-
-(thm? (IMPLIES (AND (RATIONALP X)
-              (RATIONALP Y)
-              (NOT (EQUAL Y 0))
-              (<= 0 Y)
-              (<= 0 X)
-              (<= Y X))
-         (O< (ACL2-COUNT (+ 1 0 (- (+ (+ X (- Y)) Y))))
-             (ACL2-COUNT (+ 1 Y (- (+ X (- Y))))))))
-
-
-
-;----------------------------------------------------------------------------
-(defun s (alist key val)
-  (declare (xargs :guard (alistp alist)))
-  (cond ((endp alist) (cons (cons key val) nil))
-        ((equal (caar alist) key) (cons (cons key val) (cdr alist)))
-        (t (cons (car alist) (s (cdr alist) key val)))))
-
-(defun s-many (alist keys vals)
-  (declare (xargs :guard (and (alistp alist)
-                              (true-listp keys)
-                              (true-listp vals)
-                              (equal (length keys)
-                                     (length vals)))))
-  (if (or (endp keys) (endp vals))
-    alist
-    (s-many (s alist (car keys) (car vals)) (cdr keys) (cdr vals))))
-
-(defthm getseteq
-           (equal (assoc-equal key (s alist key val)) (cons key val)))
-
-(defthm set-persists
-  (assoc-equal key (s (s alist key val) key2 val2)))
-
-(defthm set-ow-vac
-  (implies (not (assoc-equal key (s alist key1 val1)))
-           (not (assoc-equal key alist))))
-
-(defthm set-many-no-delete
-  (implies (assoc-equal key alist)
-           (assoc-equal key (s-many alist keys vals))))
-
-(set-acl2s-random-testing-enabled nil)
-
-
-
-(defthm set-many-persists
-  (assoc-equal key (s-many (s alist key val) keys vals))
-   :hints (("Goal" :do-not '(generalize))))
-
-
-
-
-(defthm alist-no-overwrite
-  (implies (not (equal key1 key2))
-           (equal (assoc-equal key1 (s alist key2 val2)) (assoc-equal key1
-alist))))
-
-(defthm set-is-alist
-  (implies (alistp alist)
-           (alistp (s alist key val))))
-
-(defun distinctlistp (lst)
-  (equal lst (remove-duplicates-equal lst)))
-
-(defun list-in-alistp (lst alist)
-  (if (endp lst)
-      t
-    (and (assoc-equal (car lst) alist)
-         (list-in-alistp (cdr lst) alist))))
-
-(defthm s-no-overwrite
-  (assoc-equal a (s-many (s alist a v) keys vals)))
-
-
-;----------------------------------------------------------------------------
-
-
-;returns controller pocket
-(defun is-recursive-fn (nm wrld)
-  (declare (xargs :mode :program))
-  (if (and (not (symbolp nm))
-           (not (function-symbolp nm wrld)))
-    nil
-    (let ((rl (find-runed-lemma `(:definition ,nm)
-                                (getprop nm 'lemmas nil
-                                         'current-acl2-world wrld))))
-      (if rl
-        (let ((ctrl-pocket  (cdr (assoc-eq nm (cdr (access rewrite-rule
-                                                           rl
-                                                           :heuristic-info))))))
-          (if (defdata::mem1 'T ctrl-pocket)
-            ctrl-pocket
-            nil))
-        nil))))
-
-(trace$ extract-var-typ-alist-from-term)
-(defun how-many (e x)
-  (cond
-   ((endp x)
-    0)
-   ((equal e (car x))
-    (1+ (how-many e (cdr x))))
-   (t
-    (how-many e (cdr x)))))
-
-; We aim to prove that (perm x y) is the same as checking that for all e,
-; (how-many e x) is (how-many e y).  We can do that by defining the function
-; (perm-counter-example x y) -- the counterexample generator -- that finds an e that occurs a
-; different number of times in x than in y.
-
-; Thus, the following definition is modeled after the definition of perm.
-(defun rm (e x)
-  (if (consp x)
-      (if (equal e (car x))
-          (cdr x)
-          (cons (car x) (rm e (cdr x))))
-      nil))
-(defun tlfix (x)
-  (if (endp x)
-      nil
-    (cons (car x) (tlfix (cdr x)))))
-
-(defun memb (e x)
-  (if (consp x)
-      (or (equal e (car x))
-          (memb e (cdr x)))
-      nil))
-
-
-(defun perm-counter-example (x y)
-  (cond ((atom x)
-         (car y))
-        ((not (memb (car x) y))
-         (car x))
-        (t (perm-counter-example (cdr x) (rm (car x) y)))))
-(thm? (equal (perm-counter-example (tlfix x) y)
-         (perm-counter-example x y)))
-(set-guard-checking t)
-(thm? (implies (not (consp x))
-               (equal (perm-counter-example x (tlfix y))
-                      (perm-counter-example x y))))
-
-
-(test?
- (IMPLIES (NOT (CONSP X))
-          (EQUAL (< X (nFIX Y))
-                 (< X Y))))
-
-(thm 
-     (implies (and (stringp bvaname)
-                   (posp n)
-                   (natp b))
-              (symbol-listp (bvname bvaname n b))))
-
-
-(let ((name 'bvname))
-  (find-runed-lemma `(:definition ,name)
-                                       (getprop name 'lemmas nil
-                                                'current-acl2-world (w state))))
-
-
-
-(let ((name 'len))
-  (cdr (assoc-eq
-        name
-        (cdr (access rewrite-rule
-                     (find-runed-lemma `(:definition ,name)
-                                       (getprop name 'lemmas nil
-                                                'current-acl2-world (w state)))
-                     :heuristic-info)))))
-
-  
-
-
-
-
-(in-theory (disable bvname))
- (in-theory (enable bvname))   
-  
-  
-(mutual-recursion
-
- (defun collect-fns-from-term (term wrld acc)
-   (declare (xargs :mode :program
-                   :guard (and (symbol-listp acc)
-                               (plist-plist-worldp wrld)
-                               (termp term wrld))))
-
-   ;; Fns is a list of function symbols and term is an ACL2 term.
-   ;; We determine whether any fn in fns is used anywhere in term.
-
-   (cond ((or (variablep term)
-              (fquotep term)
-              (not (function-symbolp (ffn-symb term) wrld))) 
-              
-          acc)
-         ((flambda-applicationp term) 
-          (let ((fns (collect-fns-from-term (third (car term)) wrld nil)))
-            (collect-fns-from-term-lst (fargs term) wrld (append fns acc))))
-         ((defdata::mem1 (ffn-symb term) '(if equal not implies iff car cons cdr BINARY-+ UNARY--
-                                            mv mv-let and or))
-          (collect-fns-from-term-lst (cdr term) wrld acc));ignore these
-         ((not (find-runed-lemma `(:definition ,(ffn-symb term))
-                                (getprop (ffn-symb term) 'lemmas nil
-                                         'current-acl2-world wrld)))
-          (collect-fns-from-term-lst (fargs term) wrld acc));ignore boot-strap fns
-         (t
-          (collect-fns-from-term-lst (fargs term) wrld (cons (ffn-symb term) acc)))))
-
- (defun collect-fns-from-term-lst (terms wrld acc)
-   (declare (xargs :guard (and (plist-plist-worldp wrld)
-                               (symbol-listp acc)
-                               (term-listp terms wrld))))
-   (if (endp terms)
-       acc
-     (let ((fns (collect-fns-from-term (car terms) wrld nil)));start
-       (collect-fns-from-term-lst (cdr terms) wrld (append fns acc)))))
-
- )
-(defun collect-functions-from-term (term wrld)
-   (declare (xargs :mode :program
-                   :guard (and (plist-plist-worldp wrld)
-                               (termp term wrld))))
-   (remove-duplicates-eql (collect-fns-from-term term wrld nil)))
-  (defun get-matching-args (args bools)
-    (declare (xargs :guard (and (true-listp args)
-                                (boolean-listp bools)
-                                (equal (len args) (len bools)))))
-    (if (endp args)
-      nil
-      (if (car bools)
-        (cons (car args) (get-matching-args (cdr args) (cdr bools)))
-        (get-matching-args (cdr args) (cdr bools)))))
-              
-                    
- (defun get-controller-arguments-for-fun-call (fn-call wrld)
-  (declare (xargs :mode :program
-                  :guard (and (pseudo-termp fn-call)
-                              (function-symbolp (ffn-symb fn-call) wrld)
-                              (plist-plist-worldp wrld))))
-  (let ((ctlr-pocket (is-recursive-fn (ffn-symb fn-call) wrld)))
-    (if ctrlr-pocket 
-      (get-matching-args (fargs fn-call) ctrlr-pocket)
-      
-  
-(set-acl2s-random-testing-enabled nil)
-(thm 
-     (implies (and (stringp bvaname)
-                   (posp n)
-                   (natp b))
-              (symbol-listp (bvname bvaname n b))))
-
-(trace* prettyify-clause)
-(thm (iff (implies p q) (or (not p) p)))
-
-(test? (implies (and (posp (car x))
-                     (equal y y)
-                     (equal z y)
-                     (posp (cdr x)))
-                (<= (cdr x) (len x)))
-       )
-
-
-(defun rv3 (x)
-  (if (endp x)
-    nil
-    (if (endp (cdr x))
-      (list (car x))
-      (cons (car (rv3 (cdr x)))
-            (rv3 (cons (car x)
-                       (rv3 (cdr (rv3 (cdr x))))))))))
-(defun ack (x y)
-  (cond ((zp x) (1+ y))
-        ((zp y) (ack (1- x) 1))
-        (t (ack (1- x) (ack x (1- y))))))
-
-
-
-
-(include-book "switchnat")
-(include-book "splitnat")
-(defun nth-foo (x)
-  (declare (xargs :measure (nfix x)
-                  :guard (natp x)))
-    (let* ((sw-v (defdata::switch-nat 2 (defdata::nfixg x)))
-           (sw (first sw-v))
-           (v (second sw-v)))
-      (if (= sw 0)
-        v
-        (cons 'x (nth-foo v)))))
-(defun nth-nat (n)
-  (declare (xargs :guard (natp n)))
-  n)
-
-(defun nth-integer (n)
-  (declare (xargs :guard (natp n)))
-  (let* (;(n (mod n 1000))
-         (mag (floor n 2))
-        (sign (rem n 2)))
-    (if (= sign 0)
-      mag
-      (- -1 mag))))
-
-
-(DEFUN NTH-NOO (X)
-  (DECLARE (XARGS :MEASURE (NFIX X)))
-                 
-  (LET* ((N-X (defdata::SWITCH-NAT 2 (defdata::nfixg x)))
-         (N (first n-x))
-         (x (second n-x)))
-          (IF (= N 0)
-            (NTH-NAT X)
-            (LET ((INFXLST (defdata::SPLIT-NAT 2 x)))
-              (CONS (LET ((X (NTH 0 INFXLST)))
-                      (NTH-INTEGER X))
-                    (LET ((X (NTH 1 INFXLST)))
-                      (NTH-NOO X)))))))
-
-
-
-
-(include-book "acl2-check")
-
-(defdata
-  (bexpr (oneof boolean
-               (cons boolean bexpr-list)))
-  (bexpr-list (oneof nil
-                    (cons bexpr bexpr-list))))
-
-:trans1 (defdata
-     (koo (oneof (cons koo integer )
-                 integer
-                 ) 
-          :hints (("Goal" :do-not-induct t)))
-     )
-(defun nth-koo (x)
-  (declare (xargs :measure (nfix x)))
-  (let* ((n-and-x (defdata::switch-nat 2 (defdata::nfixg x)))
-         (n (first n-and-x))
-         (x (second n-and-x)))
-    (if (= n 0)
-      (nth-integer x)
-      (let ((infxlst (defdata::split-nat 2 x)))
-        (cons (let ((x (nth 0 infxlst))) (nth-koo x))
-              (let ((x (nth 1 infxlst)))
-                (nth-integer x))))
-      )))
-(thm
-(AND
- (O-P (NFIX X))
- (IMPLIES
-  (= (CAR (DEFDATA::SWITCH-NAT 2 (DEFDATA::NFIXG X)))
-          1)
-  (O<
-   (NFIX
-    (NTH
-     0
-     (DEFDATA::SPLIT-NAT 2
-                         (CADR (DEFDATA::SWITCH-NAT 2 (DEFDATA::NFIXG X))))))
-   (NFIX X)))))
-
-(thm
-(AND
- (O-P (NFIX X))
- (IMPLIES
-  (= (CAR (DEFDATA::SWITCH-NAT 2 (DEFDATA::NFIXG X)))
-     0)
-  (O<
-   (NFIX
-    (NTH
-     0
-     (DEFDATA::SPLIT-NAT 2
-                         (CADR (DEFDATA::SWITCH-NAT 2 (DEFDATA::NFIXG X))))))
-   (NFIX X)))))
-
-(defun nth-koo1 (x)
-  (declare (xargs :measure (nfix x)))
-  (let* ((n-and-x (defdata::switch-nat 2 (defdata::nfixg x)))
-         (n (first n-and-x))
-         (x (second n-and-x)))
-    (if (= n 0)
-      (let ((infxlst (defdata::split-nat 2 x)))
-        (cons (let ((x (nth 0 infxlst))) (nth-koo1 x))
-              (let ((x (nth 1 infxlst)))
-                (nth-integer x))))
-      (nth-integer x))))
-
-
-;(union-vt-and '((x pos nat) (y all)) '((x rational) (y symbol boolean)) (w state))
-(defdata::sync-globals-for-dtg)
-(aref1 'newnm (compress1 'newnm '((:HEADER :DIMENSIONS (10)
-                                   :MAXIMUM-LENGTH 11
-                                   :DEFAULT NIL
-                                   :NAME asdsadas
-                                   )
-                                  (0 . 52)
-                                  (1 . 51)
-                                  (2 . 50)
-                                  (3 . 49)
-                                  (4 . 48)
-                                  (5 . 47)
-                                  (6 . 46)
-                                  (7 . 45)
-                                  (8 . 44)
-                                  (9 . 43)
-                                  ))
-       2)
-(defdata::sync-globals-for-dtg)
-
-(DEFDATA::MY-EQUAL
-  '((:HEADER :DIMENSIONS (10)
-     :MAXIMUM-LENGTH 11
-     :DEFAULT NIL
-     :NAME DEFDATA::EXPLICIT-IMPLIED-INDEX-MAP)
-    (0 . 52)
-    (1 . 51)
-    (2 . 50)
-    (3 . 49)
-    (4 . 48)
-    (5 . 47)
-    (6 . 46)
-    (7 . 45)
-    (8 . 44)
-    (9 . 43)
-    )
-  '((:HEADER :DIMENSIONS (10)
-     :MAXIMUM-LENGTH 11
-     :DEFAULT NIL
-     :NAME DEFDATA::EXPLICIT-IMPLIED-INDEX-MAP)
-    (0 . 52)
-    (1 . 51)
-    (2 . 50)
-    (3 . 49)
-    (4 . 48)
-    (5 . 47)
-    (6 . 46)
-    (7 . 45)
-    (8 . 44)
-    (9 . 43)
-    
-    ))
-
-
-(DEFDATA::MY-EQUAL
-          
-  '(
-    (:HEADER :DIMENSIONS (9)
-     :MAXIMUM-LENGTH 10
-     :DEFAULT NIL
-     :NAME DEFDATA::EXPLICIT-IMPLIED-INDEX-MAP)
-    (0 . 0)
-    (1 . 1)
-    (2 . 2)
-    (3 . 3)
-    (4 . 4)
-    (5 . 5)
-    (6 . 6)
-    (7 . 7)
-    (8 . 8)
-    )
-          
-  '((:HEADER :DIMENSIONS (9)
-     :MAXIMUM-LENGTH 10
-     :DEFAULT NIL
-     :NAME DEFDATA::EXPLICIT-IMPLIED-INDEX-MAP)
-    (8 . 8)
-    (7 . 7)
-    (6 . 6)
-    (5 . 5)
-    (4 . 4)
-    (3 . 3)
-    (2 . 2)
-    (1 . 1)
-    (0 . 0)
-    ))
-
-
-
-
-
-
-
-
-
-
-
-;(assign make-event-debug t)
-
-(defdata lon (listof nat))
-
-
-
-(set-acl2s-random-testing-max-num-of-random-trials 50)
-
-
-(set-acl2s-random-testing-enabled t)
-
-
-(thm? (implies (and (or (true-listp x)
-                             (stringp x))
-                         (not (equal x nil))
-                         (not (equal x "")))
-                    (> (len x) 0)))
-
-(set-acl2s-random-testing-max-num-of-random-trials 100)
-
-(
-
-(test? (implies (and (posp (car x))
-                     (equal y y)
-                     (equal z y)
-                     (posp (cdr x)))
-                (<= (cdr x) (len x)))
-       )
-
-
-(include-book "arithmetic-3/top" :dir :system)
-;(include-book "coi/lists/list-top" :dir :system)
-
-(thm (IMPLIES (AND (RATIONALP X)
-                    (RATIONALP Y)
-                    (NOT (EQUAL Y 0))
-                    (<= 0 Y)
-                    (<= 0 X)
-                    (<= Y X)
-                    (INTEGERP (+ 1 (- X)))
-                    (< 1 X)
-                    (NOT (INTEGERP (+ 1 (- X) (* 2 Y))))
-                    (<= X (+ 1 (* 2 Y))))
-               (< X
-                  (+ 1 (DENOMINATOR (+ 1 (- X) (* 2 Y)))
-                     (NUMERATOR (+ 1 (- X) (* 2 Y)))))))
-
-
-(thm? (IMPLIES (AND (RATIONALP X)
-              (RATIONALP Y)
-              (NOT (EQUAL Y 0))
-              (<= 0 Y)
-              (<= 0 X)
-              (<= Y X))
-         (O< (ACL2-COUNT (+ 1 0 (- (+ (+ X (- Y)) Y))))
-             (ACL2-COUNT (+ 1 Y (- (+ X (- Y))))))))
-
-
-(test? (IMPLIES (AND (RATIONALP X)
-              (RATIONALP Y)
-              (NOT (EQUAL Y 0))
-              (<= 0 Y)
-              (<= 0 X)
-              (<= Y X))
-         (O< (ACL2-COUNT (+ 1 0 (- (+ (+ X (- Y)) Y))))
-             (ACL2-COUNT (+ 1 Y (- (+ X (- Y))))))))
-
-
-
-
-(thm (IMPLIES (AND (RATIONALP X)
-              (RATIONALP Y)
-              (NOT (EQUAL Y 0))
-              (<= 0 Y)
-              (<= 0 X)
-              (<= Y X))
-         (O< (ACL2-COUNT (+ 1 0 (- (+ (+ X (- Y)) Y))))
-             (ACL2-COUNT (+ 1 Y (- (+ X (- Y))))))))
-
-
-
-(thm? (IMPLIES (AND (RATIONALP X)
-                    (RATIONALP Y)
-                    (NOT (EQUAL Y 0))
-                    (<= 0 Y)
-                    (<= 0 X)
-                    (<= Y X)
-                    (INTEGERP (+ 1 (- X)))
-                    (< 1 X)
-                    (NOT (INTEGERP (+ 1 (- X) (* 2 Y))))
-                    (<= X (+ 1 (* 2 Y))))
-               (< X
-                  (+ 1 (DENOMINATOR (+ 1 (- X) (* 2 Y)))
-                     (NUMERATOR (+ 1 (- X) (* 2 Y)))))))
-
-
-
-
-
-
-
-
-
-
-(defrec person '(name addr age) 't)
-
-;example of proving tail-recursive and simple implementation equivalent
-(defun rev-s (x)
-  (if (endp x)
-    nil
-    (append (rev-s (cdr x)) (list (car x)))))
-
-(defun rev-t (x a)
-  (if (endp x)
-    a
-    (rev-t (cdr x) (cons (car x) a))))
-
-(defun rev (x)
-  (rev-t x nil))
-
-(defthm rev-t-rev-s
-  (equal (rev-t x a)
-         (append (rev-s x) a)))
-
-(defthm rev-rev-s
-  (equal (rev x)
-         (rev-s x)))
-
-(in-theory (disable rev rev-t))
-
-(thm (true-listp (rev x)))
-
-(defun xp (v)
-  (and (consp v)
-       (and (consp (car v))
-            (or (equal nil (caar v))
-                (xp (caar v)))
-            (and (consp (cadr v))
-                 (xp (cadar v))
-                 (xp (caddr v))))
-       (or (equal (cdr v) nil)
-           (and (consp (cdr v))
-                (posp (cdar v))
-                (xp (cddr v))))))
-(defun yp (v)
-  (and (consp v)
-       (yp (car v))
-       (yp (cdr v))))
-
-(defun possibleBooleanRange (expr wrld)
-  (cond ((booleanp expr)  t)
-        ((possible-predicate-fn expr wrld) t)
-        ((function-expressionp expr) 
-         (if (equal (first expr) 'if)
-           (and (possibleBooleanRange (third expr))
-                (possibleBooleanRange (fourth expr)))
-           (logicalp (car expr))))
-        (t 'nil)))
-        
-
-
-
-  (defun tree-count (x)
-  (case-match x
-   ('nil 0)
-   (('node v l . r)
-    (+ 1 (tree-count (val x))
-       (tree-count (left x))
-       (tree-count (right x))))
-   (& 0))) 
-  
-  (defun fixpt-iter-pull-nested-ifs (if-form)
-  (let ((new-form (pull-out-nested-ifs if-form)))
-    (if (equal new-form if-form)
-      new-form
-      (fixpt-iter-pull-nested-ifs new-form))))
-
-(trace$ fixpt-iter-pull-nested-ifs)
-
-(defun dumm (vars allvars n)
-  (if (zp n)
-    nil
-    (prog2$
-     (cw "~x0 the element of vars is ~x1 and first is ~x2 ~%" n (car vars) (car allvars))
-     (dumm (cdr vars) allvars (1- n)))))
-
-
-
-
-#|
-(DEFUNS (FOO0P (V) (EQUAL V '"halted")))
-
-(defuns (FOO1P (V)
-                 (AND (CONSP V)
-                      (BOOLEANP (CAR V))
-                      (AND (CONSP (CDR V))
-                           (INTEGERP (CAR (CDR V)))
-                           (EQ (CDR (CDR V)) 'NIL)))))
-
-(defuns (FOO2P (V) (OR (FOO0P V) (FOO1P V))))
-
-(defun pull-out-nested-if (nested-if if-then if-else)
-  `(if ,(second nested-if)
-     (if ,(third nested-if)
-       ,if-then
-       ,if-else)
-     (if ,(fourth nested-if)
-       ,if-then
-       ,if-else)))
-(defun ifp (form)
-  (if (not (consp form))
-    nil
-    (eq 'if (car form))))
-;;assume already translated if-form
-(defun pull-out-nested-ifs (if-form)
-  (if (not (ifp if-form))
-    if-form
-    (if (ifp (second if-form))
-      (pull-out-nested-if (second if-form) (third if-form) (fourth if-form))
-      (list 'if (second if-form) 
-            (pull-out-nested-ifs (third if-form))
-            (pull-out-nested-ifs (fourth if-form))))))
-(program)                     
-(defun fixpt-iter-pull-nested-ifs (if-form)
-  (let ((new-form (pull-out-nested-ifs if-form)))
-    (if (equal new-form if-form)
-      new-form
-      (fixpt-iter-pull-nested-ifs new-form))))
-(checkproperty test-pull-nested-ifs
-  ((A boolean) (B boolean) (C boolean) (X boolean) (Y boolean))
-  (equal (IF (IF (IF A A B) C NIL)
-            t
-            (IF X Y NIL))
-         (fixpt-iter-pull-nested-ifs  '(IF (IF (IF A A B) C NIL)
-                                          t
-                                          (IF X Y NIL)))))
-
-:set-ignore-ok t 
-(checkproperty test-pull-nested-ifs
-  ((A boolean) (B boolean) (C boolean) (X boolean) (Y boolean))
-  (equal (IF (IF (IF A A B) C NIL)
-            't
-            (IF X Y NIL)) 
-         (IF A
-           (IF A
-             (IF C 't (IF X Y NIL))
-             (IF NIL 't (IF X Y NIL)))
-           (IF B
-             (IF C 't (IF X Y NIL))
-             (IF NIL t (IF X Y NIL))))))
-
-(logic)
-
-(defun blah (x)
-(IF (CONSP X)
-    (IF (BLAH (CDR X)) T NIL)
-    (IF NIL T NIL)))
-(defun blah (x)
-    (if (if (consp x)
-        (blah (cdr x))
-        nil)
-    t
-    nil))
-  
-(defun blah (x)
-  (if (consp x)
-      (if  (blah (cdr x))
-        t
-        nil)
-      (if nil
-        t
-        nil))
-  )
-
-(DEFUN FOOP (V)
-                (if (EQ V 'NIL)
-                  t
-                  (if (CONSP V)
-                    (and (INTEGERP (CAR V))
-                         (FOOP (CDR V)))
-                    (if (CONSP V)
-                      (and (FOOP (CAR V))
-                           (NATP (CDR V)))
-                      nil))))
-
-(defun foop (x) (allp x))
-
-(defdata (koo int))
-
-(defdata (foo '(1 2 3)))
-
-;;works now -- list apparently is not such a nice data structure to prove things. use list*!(Pete)
-(DEFUN FOOP (V)
-                (if (EQ V 'NIL)
-                  t
-                  (if (CONSP V)
-                    (and (INTEGERP (CAR V))
-                         (FOOP (CDR V)))
-                    (if (CONSP V)
-                      (and (FOOP (CAR V))
-                           (NATP (CDR V)))
-                      nil))))
-
-(DEFUN FOOP (V)
-  (declare (xargs :measure (acl2-count v)))
-  (if (CONSP V)
-       (and (INTEGERP (CAR V))
-            (FOOP (CDR V)))
-      (INTEGERP V)))
-|#
-         
-
-
-
-
-(defun insert-after-pos (i new-entry alist)
-  (if (endp alist)
-    (list new-entry)
-    (if (zp i)
-      (cons (car alist) (cons new-entry (cdr alist)))
-      (cons (car alist)
-            (insert-after-pos (- i 1) new-entry (cdr alist))))))
-
-;Prove correctness TODO
-(defun find-pos-last-match (keys list len max)
-  (if (endp keys)
-    max
-    (let* ((pos-rev (position-equal (car keys) (reverse list)))
-          (pos (if pos-rev (- (1- len) pos-rev) pos-rev)))
-      (if pos
-        (if (> pos (nfix max))
-          (find-pos-last-match (cdr keys) list len pos)
-          (find-pos-last-match (cdr keys) list len (nfix max)))
-        (find-pos-last-match (cdr keys) list len max)))))
-
-
-
-
-;possibility of bug here CHECK TODO
-;since when records are dest-elim, the intra-dependencies might be circular
-(defun stich-up-dependencies (vte-alist vte-alist1 vte-alist2)
-  ;(declare 
-  (if (endp vte-alist)
-    (append vte-alist1 vte-alist2)
-    (let* ((restvars (strip-cars vte-alist2))
-          (restvarlen (len restvars))
-          (curr-elem (car vte-alist))
-          (currvar (car curr-elem))
-          (currval (cdr curr-elem)))
-      (cond ((and (symbolp currval) (not (defdata::mem1 currval restvars)));type or something else
-              (stich-up-dependencies (cdr vte-alist) vte-alist1 vte-alist2));ignore
-             (t 
-              (let* ((dvars  (defdata::get-free-vars1 currval nil));only non-buggy for terms
-                     (pos (find-pos-last-match dvars restvars restvarlen nil)))
-                (if pos ;found
-                  (stich-up-dependencies (cdr vte-alist)
-                                         (defdata::remove-entry currvar vte-alist1)
-                                         (insert-after-pos pos curr-elem vte-alist2))
-                  (stich-up-dependencies (cdr vte-alist) vte-alist1 vte-alist2))))))));ignore
-
-
-
-(defun pascal (i j)
-  (cond ((= j 0) 1)
-        ((= j i) 1)
-        (t (+ (pascal (1- i) (1- j)) (pascal (1- i) j)))))
-
-
-(defun depth7 (bt d)
-  (if (endp bt)
-    d
-    (let ((ldep (depth7 (car bt) (1+ d)))
-          (rdep (depth7 (cdr bt) (1+ d))))
-      (if (> ldep rdep)
-        ldep
-        rdep))))
-
-
-(defun rebuildtree (bt)
-  (if (atom bt)
-    bt
-    (cons (rebuildtree (car bt)) (rebuildtree (cdr bt)))))
-
-(defun flatten1 (bt)
-  (if (atom bt)
-    bt
-    (append (flatten1 (car bt)) (flatten1 (cdr bt)))))
-
-(defun flatten2 (bt)
-  (if (atom bt)
-    (list bt)
-    (append (flatten2 (car bt)) (flatten2 (cdr bt)))))
-
-(defun flatten3 (bt lst)
-  (if (atom bt)
-    (cons bt lst)
-    (flatten3 (car bt) (flatten3 (cdr bt) lst))))
-
-(defun mem (atm lst)
-  (if (endp lst)
-    nil
-    (if (equal atm (car lst))
-      t
-      (mem atm (cdr lst)))))
-
-(defun un (l1 l2)
-  (cond ((endp l1) l2)
-        ((endp l2) l1)
-        (t (if (mem (car l2) l1)
-            (un l1 (cdr l2))
-            (un (cons (car l2) l1) (cdr l2))))))
-(defun subset (A B)
-  (if (endp B)
-    t
-    (and (mem (car B) A)
-         (subset A (cdr B)))))
-
-(defun int (l1 l2)
-  (if (endp l1)
-    nil
-    (if (mem (car l1) l2)
-      (cons (car l1) (int (cdr l1) l2))
-      (int (cdr l1) l2))))
-
-(defun diff (l1 l2)
-  (if (endp l1)
-    nil
-    (if (mem (car l1) l2)
-      (diff (cdr l1) l2)
-      (cons (car l1) (diff (cdr l1) l2)))))
-
-(defun rv5 (l1)
-  (if (endp l1)
-    nil
-    (append (rv5 (cdr l1)) (list (car l1)))))
-
-(defun app (l1 l2 )
-  (if (endp l1)
-    l2
-    (cons (car l1) (app (cdr l1) l2))))
-
-(defun rv1 (l1)
-  (if (endp l1)
-    nil
-    (app (rv1 (cdr l1)) (list (car l1)))))
-
-(defun swaptree (bt)
-  (if (atom bt)
-    bt
-    (cons (swaptree (cdr bt)) (swaptree (car bt)))))
-
-(defun insert (sortedlst x)
-  (if (endp sortedlst)
-    (list x)
-    (if (< x (car sortedlst))
-      (cons x sortedlst)
-      (cons (car sortedlst) (insert (cdr sortedlst) x)))))
-(defun isort (L)
-  (if (endp L)
-    nil
-    (insert (isort (cdr L)) (car L))))
-
-
-(defun subtree (p bt)
-  (if (endp p)
-    bt
-    (cond ((equal (car p) 'A) (subtree (cdr p) (car bt)))
-          (t (subtree (cdr p) (cdr bt))))))
-
-(defun replsubtr (p new bt)
-  (if (endp p)
-    new
-    (if (eq (car p) 'A)
-      (cons (replsubtr (cdr p) new (car bt)) (cdr bt))
-      (cons (car bt) (replsubtr (cdr p) new (cdr bt))))))
-
-(defun deeptip (bt)
-  (if (atom bt)
-    bt
-    (if (> (depth7 (car bt) 1) (depth7 (cdr bt) 1))
-      (deeptip (car bt))
-      (deeptip (cdr bt)))))
-
-(defun dep (bt)
-  (if (atom bt);leaf
-    0
-    (let ((ld (dep (car bt)))
-          (rd (dep (cdr bt))))
-      (1+ (if (> ld rd) ld rd)))))
-
-(defun deeptip1 (bt h)
-  (if (atom bt)
-    (cons bt h)
-    (let ((lbth (deeptip1 (car bt) (1+ h)))
-          (rbth (deeptip1 (cdr bt) (1+ h))))
-      (if (> (cdr lbth)(cdr rbth))
-        lbth
-        rbth))))
-
-:logic
-
-
-
-(defun pascal23 (i j)
-  (cond ((zp j) 1)
-        ((zp i) 1)
-        ((= j i) 1)
-        ((> j i) -99)
-        (t (+ (pascal23 (1- i) (1- j)) (pascal23 (1- i) j)))))
-
-:logic
-
-(defun pascal1 (i j)
-  (cond ((zp j) 1)
-        ((zp i) 1)
-        ((= j i) 1)
-        ((> j i) -99)
-        (t (+ (pascal1 (1- i) (1- j)) (pascal1 (1- i) j)))))
-
-(defun pascal2 (i j)
-  (cond ((zp j) 1)
-        ((zp i) 1)
-        ((= j i) 1)
-        (t (+ (pascal2 (1- i) (1- j)) (pascal2 (1- i) j)))))
-
-(defun pascal3 (i j)
-  ;(declare (xargs :measure i))
-  (cond 
-   ((> j i) 0)
-   ((zp j) 1)
-        ((zp i) 1)
-        ((= j i) 1)
-        (t (+ (pascal3 (1- i) (1- j)) (pascal3 (1- i) j)))))
-
-
-
-(defun dumm (vars allvars n)
-  (if (zp n)
-    nil
-    (prog2$
-     (cw "~x0 the element of vars is ~x1 and first is ~x2 ~%" n (car vars) (car allvars))
-     (dumm (cdr vars) allvars (1- n)))))
-
-
-
-
-(defun pull-out-nested-if (nested-if if-then if-else)
-  `(if ,(second nested-if)
-     (if ,(third nested-if)
-       ,if-then
-       ,if-else)
-     (if ,(fourth nested-if)
-       ,if-then
-       ,if-else)))
-
-(defun ifp (form)
-  (eq 'if (car form)))
-
-(defun pull-out-nested-ifs (if-form)
-  (if (not (ifp if-form))
-    if-form
-    (if (ifp (second if-form))
-      (pull-out-nested-if (second if-form) (third if-form) (fourth if-form))
-      (list 'if (second if-form) 
-            (pull-out-nested-ifs (third if-form))
-            (pull-out-nested-ifs (fourth if-form))))))
-
-
-
-
-(defun type-term (var term state)
-  (declare (xargs :mode :program :stobjs state))
-  (let ((ens (ens state))
-    (wrld (w state)))
-    (cond ((or (variablep term)
-           (fquotep term)
-               (not (symbolp (ffn-symb term)))
-               (not (function-symbolp (ffn-symb term) wrld)))
-           (er hard 'type-term
-               "Cannot take type-term of ~x0"
-               term))
-          (t (mv-let (ts ttree)
-                     (type-set-implied-by-term
-                      var nil
-                      (guard (ffn-symb term) nil (w state))
-                      ens wrld nil)
-                     (mv-let (result ttree)
-                             (convert-type-set-to-term var ts ens wrld ttree)
-                             (declare (ignore ttree))
-                             result))))))
-
-(defconst *PII* (* 44/35  1/2  5))
-(defconst *atomic-value-types*
-  '(atom       
-     number     
-      complex    
-       rational   
-        integer
-         pos
-          natural      
-
-     character 
-
-     symbol    
-      acl2-symbol
-       boolean
-      
-     string))
-(defconst *value-types* (append '(cons true-list acons alist) *atomic-value-types*))
-(defun modify-symbol (prefix sym postfix)
-  (declare (xargs :guard (and (symbolp sym)
-                              (or (null prefix)
-                                  (stringp prefix))
-                              (or (null postfix)
-                                  (stringp postfix)))))
-  (let* ((name (symbol-name sym))
-         (name (if prefix
-                 (string-append prefix name)
-                 name))
-         (name (if postfix
-                 (string-append name postfix)
-                 name)))
-    (if (member-eq sym *common-lisp-symbols-from-main-lisp-package*)
-      (intern-in-package-of-symbol name 'acl2::acl2-pkg-witness)
-      (intern-in-package-of-symbol name sym))))
-(defun get-predicate-symbol (sym)
-  (declare (xargs :guard (symbolp sym)))
-  (modify-symbol nil sym "P"))
-
-#|
-(legal-variable-or-constant-namep 'x)
-VARIABLE
-ACL2 !>VALUE (legal-variable-or-constant-namep *standard-chars*)
-NIL
-ACL2 !>VALUE (legal-variable-or-constant-namep '*character-values*)
-CONSTANT
-
-(conjoin '(p1 p2 p3))
-(IF P1 (IF P2 P3 'NIL) 'NIL)
-ACL2 !>VALUE (disjoin '(p1 p2 p3))
-(IF P1 'T (IF P2 'T P3))
- (GETPROP 'fobp 'FORMALS T 'CURRENT-ACL2-WORLD (w state))
- (termp (IF X Y '123) (w state))
- 
- (convert-type-set-to-term 'x 201 (ens state) (w state) nil)
-((IF (IF (INTEGERP X) (NOT (< '0 X)) 'NIL)
-     'T
-     (IF (EQUAL X 'T) 'T (EQUAL X 'NIL)))
- NIL)
-ACL2 !>VALUE (type-set '(< x y) nil nil nil nil (ens state) (w state) nil nil nil)
-(192 NIL)
-ACL2 !>VALUE (type-set '(binary-+ x y) nil nil nil nil (ens state) (w state) nil nil nil)
-(63 ((LEMMA :FAKE-RUNE-FOR-TYPE-SET NIL)))
-
-
-(guard 'max nil (w state))
-(IF (RATIONALP X) (RATIONALP Y) 'NIL)
-
-(type-set-and-returned-formals '(binary-+ x y) nil (ens state) (w state) nil)
-(63 0 NIL
-    ((LEMMA :FAKE-RUNE-FOR-TYPE-SET NIL)))
-
-
-(getprop 'fodp 'type-prescriptions nil
-                  'current-acl2-world (w state))
-((192 (2542 FODP V)
-      NIL (NIL :TYPE-PRESCRIPTION FODP)
-      IF (EQUAL (FODP V) 'T)
-      'T
-      (EQUAL (FODP V) 'NIL)))
-ACL2 !>VALUE 
-(getprop 'fod1p 'type-prescriptions nil
-                  'current-acl2-world (w state))
-NIL
-
-(formals 'max (w state))
-(X Y)
-
-(most-recent-enabled-recog-tuple 'natp (global-val 'recognizer-alist (w state))
-                                             (ens state))
-(NATP (493 . 3)
-      (-4 . T)
-      :COMPOUND-RECOGNIZER NATP-COMPOUND-RECOGNIZER)
-ACL2 !>VALUE 
-(most-recent-enabled-recog-tuple 'rationalp (global-val 'recognizer-alist (w state))
-                                             (ens state))
-(RATIONALP (NIL . 31)
-           (-32 . T)
-           :FAKE-RUNE-FOR-ANONYMOUS-ENABLED-RULE NIL)
-
-
-|#
-
-(defun getListPredicateSymbol (sym)
-  (declare (xargs :guard (symbolp sym)))
-  (modify-symbol nil sym "LISTP"))
-
-(mutual-recursion
-;; code taken from structures.lisp in data-structures book.
- (defun freeVars1 (term ans)
-   "A free variable is a symbol that is not a constant, i.e., it excludes T,
-    NIL, and *CONST* etc."
-   (cond
-    ((atom term) (if (and (symbolp term)
-              (not (eq (legal-variable-or-constant-namep term)
-                   'CONSTANT)))
-             (add-to-set-eq term ans)
-           ans))
-    ((eq (car term) 'QUOTE) ans)
-    (t (freeVars1Lst (cdr term) ans))))
-
- (defun freeVars1Lst (terms ans)
-   (cond
-    ((atom terms) ans)
-    (t (freeVars1Lst (cdr terms) (freeVars1 (car terms) ans))))))
-
-(defun freeVars (term)
-  (freeVars1 term '()))
-
-;;get-recognizer : term * Listofvars * Ens * World
-;;Checks if the term is a fn application of form (type-recognizerp x)
-;;if yes then we return a pair (x . type-recognizerp) 
-;;we will do 2 kinds of checks
-;; 1. syntactic fargs len is 1
-;;    the sole farg is present in list of vars
-;; 2. Does it have a compound-recognizer or type-pres rule?
-;; TODO: Right now I am concentrating on getting this to work with
-;; only random-state book, later integrate Peter's defdata framework.
-(defun get-recognizer (guard-term vars ens wrld)
-  (declare (xargs :mode :program
-                  :guard (and (termp guard-term)
-                              (true-listp vars))))
-  (if (and (eq 1 (len (fargs guard-term)))
-           (mem (fargn guard-term 1) vars))
-      (let* ((fn (ffn-symb guard-term))
-             (var (fargn guard-term 1))
-             (recog-tuple (most-recent-enabled-recog-tuple
-                           fn
-                           (global-val 'recognizer-alist wrld)
-                           ens)))
-        (if recog-tuple
-            ;we have a primitive type perhaps!?
-            (cons var fn)
-            (if (getprop fn
-                         'type-prescriptions
-                         nil
-                         'current-acl2-world
-                         wrld)
-                ;;peter's generated type predicate!?
-                (cons var fn)
-                nil)))
-      nil))
-   
-;;SImple type extraction from guards.
-;;TODO: Assumption: Guards are either 'T, IF E1 E2 E3 or (type-recognizerp 'X)
-;;if there are more complicated guards then we need to cover those cases as well. TODO
-(defun infer-type-from-guard (guard-term vt-alist-acc ens wrld)
-  (if (or (fquotep guard-term)
-          (variablep guard-term)
-          (not (symbolp (ffn-symb guard-term)))
-          (not (function-symbolp (ffn-symb guard-term) wrld)))
-      vt-alist-acc
-      (if (ffn-symb guard-term 'if) ;add if cond true and then terms
-          (let ((vt-alist1 (infer-type-from-guard (fargn guard-term 1) vt-alist-acc ens wrld)))
-            (infer-type-from-guard (fargn guard-term 2) vt-alist1 ens wrld))
-          ;guard term is of type (f a1 ...)
-          (let* ((vars (strip-cars vt-alist-acc))
-                 (typ-recog (get-recognizer guard-term vars ens wrld))
-                 (typ-p (check-rand-generator-exists typ-recog))) ;;hack to be removed
-            (if typ-p ;if we get a typ recog we add it to our var typ alist
-                (union-add-alst-pair vt-alist-acc typ-recog)
-                vt-alist-acc))))) ;otherwise do nothing!?
-            
-
-;;TODO: Ques: How to find the smallest type in a conjoin/intersection
-
-;;infer-type-from-term : Term * var-typ-alist * TrueTerm * Ens * World * State -> var-types-alist 
-;;Term should be a translated term i.e (f a1 a2 ...) to
-;;be of relevance in inferring type of a  var. Return vt-alist-acc which stands for
-;;var-types-alist-accumlated. Initial it just has free vars as keys and empty type values.
-;;In the end if the returned vt-alist has some empty typ values then we fill them with
-;;the default ANY type value.
-;;TrueTerm can be used to obtain stronger information if the term we are trying to
-;;lies in a particular then-else branch in the body of the def. Right now I ignore it
-;;and only concentrate on guards. 
-;;Notes:
-;1. IF : Union of then and else types (if condition also gives guard information??)
-;2. (f a1 a2..): recurse on f's type rules!  
-;Look at type-set-and-returned-formals in defuns.lisp for a similar function!
-;Note: Lets look at the context where we will be calling this function.
-; We might need it in 2 situations:
-; 1. Prove edge does not exist
-; 2. Prove measure decreases across calls
-; Generic case seems to be unclear to me at the moment, lets get this thing
-; working for these special cases.
-; We will restrict our type inference to a weaker notion of collecting guards and
-; getting recognizers from that information only. If we are lucky we get types
-; for all our free variables in the term we are checking, if not we default the
-; type to ANY, that means we need a random-value generator which generates
-; a random cons , list or atom.
-(mutual-recursion
- (defun infer-type-from-term (term vt-alist-acc true-term ens wrld state)
-   (declare (xargs :mode :program 
-                   :stobjs state
-                   :guard (and (symbolp var)
-                               (alistp vt-alist-acc)
-                               (termp term))))
-   (cond
-  ;if term is a variable, a constant or if term is
-  ;a call of f which is not defined in the curr wrld we return with
-  ;whatever var-type-alist we accumulated adding no extra info.
-    ((or (variablep term)
-         (fquotep term)
-         (not (symbolp (ffn-symb term)))
-         (not (function-symbolp (ffn-symb term) wrld)))
-     vt-alist-acc)
-    ;;term == (if st-cond st-then st-else) st is abbrev for subterm
-    ((eq (ffn-symb term) 'if)
-     (let* ((st-cond (fargn term 1))
-            (st-then (fargn term 2))
-            (st-else (fargn term 3))
-            (vt-alst1 (infer-type-from-term st-cond vt-alist-acc true-term ens wrld state))
-            (vt-alst2 (infer-type-from-term st-then vt-alst1 true-term ens wrld state))
-            (vt-alst3 (infer-type-from-term st-else vt-alst1 true-term ens wrld state)))
-       (union-add-alst-lst vt-alst2 vt-alst3))) ;;union of types we gathered!?
-    ;;term == (f a1 a2 ...)
-    (t
-     (let* ((guard-term (guard (ffn-symb term) nil wrld))
-            (formals-term (formals (ffn-symb term) wrld))
-            (guard-term-subs (subcor-var formals-term (fargs term) guard-term))
-            (extracted-typ-alst (infer-type-from-guard guard-term-subs vt-alist-acc ens wrld))
-            (vt-alist1 (union-add-alst-lst vt-alist-acc extracted-typ-alst)))
-       (infer-type-from-termlist (fargs term) vt-alist1 true-term ens wrld state))))) 
- 
- (defun infer-type-from-termlist (termlst vt-alist-acc true-term ens wrld state)
-   (declare (xargs :mode :program
-                   :stobjs state
-                   :guard (true-listp termlst)))
-   (if (endp termlst)
-       ;then return accumulated var typ alist
-       vt-alist-acc
-       ;else recurse over list of terms
-       (let ((vt-alst1 (union-add-alst-lst  ;ASK: should be an intersection! 
-                        vt-alist-acc
-                      (infer-type-from-term (car termlst) vt-alist-acc true-term ens wrld state))))
-         (infer-type-from-termlist (cdr termlst) vt-alst1 ens wrld state)))))
-
-
-(defun append-last (list1 lst acc)
-  (if (endp (cdr list1))
-    (reverse (cons (append (car list1) (list lst))  acc))
-    (append-last (cdr list1) lst (cons (car list1) acc)))) 
-
-;this fun is difficult to do without in-place mutation
-;also tailrecursive sol is not trivial. keep this example for future
-(defun append-let (let-form subform)
-  (let ((body (caddr let-form)))
-    (if (or (endp body)
-            (not (equal (car body) 'let)))
-      (list (car let-form) 
-            (cadr let-form)
-            subform)
-      (list (car let-form)
-            (cadr let-form)
-            (append-let (caddr let-form) subform)))))
-;;get the outermost implies sub-form
-(defun implies-subform (form)
-  (declare (xargs :mode :program))
-  (if (endp form)
-    'NIL
-    (cond 
-     ((equal (car form) 'implies)
-      (cadr form))
-     ((equal (car form) 'let)
-      (implies-subform (caddr form)))))) 
-(defun let-adjusted-implies-subform (let-form)
-  (declare (xargs :mode :program))
-  (let ((impl (implies-subform let-form)))
-  (if (endp impl)
-    'NIL
-    (append-let let-form impl)))) 
-
-  (trace$ append-let)                               
-
-(implies-subform '(LET ((X (NTH-INTEGER 8)))
-     (LET ((Y (NTH-INTEGER 42659)))
-       (let ((z (nth-integer 34)))
-          (IMPLIES (<= X Y) (EQUAL (MAX X Y) Y))))))
-(let-adjusted-implies-subform '(LET ((X (NTH-INTEGER 8)))
-     (LET ((Y (NTH-INTEGER 42659)))
-       (let ((z (nth-integer 34)))
-          (IMPLIES (<= X Y) (EQUAL (MAX X Y) Y))))))
-
-(set-ignore-ok t)
-
-
-
-;DEPRECARED TYPES CODE from type.lisp 
-;;------------------------------------------------------------------
-;;---infer type hyps from hyps in thm forms-------------------------
-;;;TODO - Rewrite this code, its not satisfactory
-;;------------------------------------------------------------------
-
-(defun empty-vt-alist1 (freevars vt-alist)
-  (declare (xargs :guard (true-listp freevars)))
-  (if (endp freevars)
-    vt-alist
-    (empty-vt-alist1 (cdr freevars)
-                    (cons (cons (car freevars) (list 'ACL2::ALL)) 
-                          vt-alist))))
-
-;;initialise a var type alist with no type information to start with.
-;;i.e each variable starts with having the type 'ALL'
-(defun empty-vt-alist (freevars)
-  (declare (xargs :guard (true-listp freevars)))
-  (empty-vt-alist1 freevars '()))
-
-   
-;reset with type 'all'
-(defun reset-vt-alist-with-all (vt-al ans)
-  (declare (xargs :guard (symbol-alistp vt-al)))
-  (if (endp vt-al)
-    ans
-    (reset-vt-alist-with-all (cdr vt-al) (cons (cons (caar vt-al) (list 'all)) ans))))
-
-
-;TODO.Note: an elegant solution would be to collect type expressions from hyps and then use those
-;directly as type information.(but we will let ACL2 do this for us through case-splitting
-;and destructor-elimination)
-
-;;pull type information from type hypotheses
-(mutual-recursion       
- ;returns a list of var-typ pairs
- (defun pull-types-from-hyp (hyp wrld)
-   ;(declare (xargs :verify-guards nil))
-   (let ((typ (is-simple-type-hyp hyp wrld)))
-     (cond ((atom hyp)  nil) ;return unchanged 
-           ((eq (car hyp) 'not)
-            nil)
-            
-           (typ 
-            (list (cons (cadr hyp) (list typ)))) ;add the var-typ pair to list
-           ((eq (car hyp) 'equal) 
-            (let ((fst-arg (second hyp))
-                  (snd-arg (third hyp)))
-              (cond ((and (defdata::is-a-variablep fst-arg)
-                          (defdata::possible-constant-valuep snd-arg))
-                     (list (cons fst-arg (list snd-arg))))
-                    ((and (defdata::is-a-variablep snd-arg)
-                          (defdata::possible-constant-valuep fst-arg))
-                     (list (cons snd-arg (list fst-arg))))
-                    (t nil))))
-           ((eq (car hyp) 'and)
-            (pull-types-from-hyplst (cdr hyp) wrld))
-           ((eq (car hyp) 'or);this can be taken care of using oneof now TODO?
-            nil);return unchanged ...we dont know!
-           (t nil)))) ;TODO: what if it is a 'if' statement or suppose a custom and or like boolean-and?
-                      ;what about equal? ANS: equal is taken care of by process-dependencies!!
-     
- (defun pull-types-from-hyplst (hyps wrld)
-   ;(declare (xargs :verify-guards nil))
-   (if (endp hyps)
-     nil
-     (let ((vt-al (pull-types-from-hyp (car hyps) wrld)))
-       (if (null vt-al)
-         (pull-types-from-hyplst (cdr hyps) wrld)
-         (append vt-al 
-               (pull-types-from-hyplst (cdr hyps) wrld))))))
- )
-
-
-;in our case we only add the allp predicate, which always returns a 't
-;Make sure missing-hyps is a list
-(defun extend-hyp (hyp missing-hyps)
- ; (declare (xargs :guard (true-listp missing-hyps)))
-  (if (eq 't hyp);no hyp
-    (if (endp missing-hyps)
-      't
-      (if (= 1 (len missing-hyps))
-        (car missing-hyps) ;expand it
-      `(and . ,missing-hyps)))  ;add an and 
-    ;hyp is present
-    (if (endp missing-hyps) ;shud be a list of hyps to add
-      hyp
-      (if (and (consp hyp) (eq (car hyp) 'and)) ;top-level and
-        (cons 'and (append (cdr hyp) missing-hyps))
-        `(and ,hyp . ,missing-hyps)))))
-
-(defun extend-hyp-with-simple-negated-concl (hyp concl)
-  (if (and (consp concl)
-           (eq 'not (car concl)));(not some-formula)
-    (extend-hyp hyp (cdr concl));cdr makes sure that its a list i.e '(some-formula)
-    hyp));only extend if there is a not in the conclusion, since otherwise
-         ;;;its no use in inferring types from hyps
-
-
-
-;The following functions helps merge 2 var-type alists by finding
-;the smallest type-lists(OR of types) for each variable
-;THis is useful when you have a type-alist that acl2-check infers and
-;then we try to merge it with the type-alist that ACL2 computes from
-;the theorem proving context which can at times be more accurate.
-
-; NOTE in our vt-al, we can have either typenames or 
-; we can have singleton types ie constant expressions
-
-;we take the intersection of typ1 and typ2 and return the smaller of the
-;types. but if we dont know the subtype relation, we just choose arbitrarily
-;among the the two types. But if we know the two types are disjoint, then
-;we give back NIL, we goes nicely with the calling code.
-
-(set-verify-guards-eagerness 0);nope, no way i can prove guards for these fellows
-
-;NOTE: In the following 2 functions,the type 'empty' has special status and treated seperately
-(defun intersection-of-types (typ1 typ2 wrld)
-  (cond  
-   ((possible-constant-value-expressionp typ1) typ1) ;if lucky to have a singleton type, just return it
-   ((possible-constant-value-expressionp typ2) typ2) ;if lucky to have a singleton type, just return it
-   ((or (eq 'acl2::empty typ1) (eq 'acl2::empty typ2)) 'acl2::empty)
-   (t 
-    (if (and (is-a-typeName typ1 wrld)
-             (is-a-typeName typ2 wrld))
-      (cond ((is-subtype typ1 typ2 wrld)
-             typ1)
-            ((is-subtype typ2 typ1 wrld)
-             typ2)
-            ((is-disjoint typ2 typ1 wrld)
-             'empty) ;Should we instead define the NULL type??? Modified: so Ans is YES instead of Ans: NO, the way its used now, this is right!
-            ;give preference to custom type
-            ((defdata::is-a-custom-type typ1 wrld)
-             typ1)
-            ((defdata::is-a-custom-type typ2 wrld)
-             typ2)
-            ;;choose the one that was defined later(earlier in reverse chronological order)
-            (t (let* 
-                   ((types-in-wrld 
-                     (strip-cars (table-alist 
-                                  'defdata::types-info-table wrld)))
-                      (pos1 (position typ1 types-in-wrld))
-                      (pos2 (position typ2 types-in-wrld)))
-                 (if (< (nfix pos1) (nfix pos2)) typ1 typ2))));type table is already in reverse chrono order
-      nil))));This should never happen right!!?
-
-;gives back a list which represents the union of typ1 and typ2
-(defun union-of-types (typ1 typ2 wrld)
-  (cond  
-   ((equal typ1 typ2) (list typ1))
-   ((or (defdata::possible-constant-value-expressionp typ1)
-        (defdata::possible-constant-value-expressionp typ2))
-    (list typ1 typ2))
-   (t 
-    (if (and (defdata::is-a-typeName typ1 wrld)
-             (defdata::is-a-typeName typ2 wrld))
-      (cond ((eq 'empty typ1) (list typ2))
-            ((eq 'empty typ2) (list typ1))
-            ((is-subtype typ1 typ2 wrld)
-             (list typ2))
-            ((is-subtype typ2 typ1 wrld)
-             (list typ1))
-            (t ;(is-disjoint typ2 typ1 wrld)
-             (list typ1 typ2)))
-      nil))))
-      ;(er hard 'union-of-types "~x0 and ~x1 should be 'types' that have been defined~%" typ1 typ2)))))
-
-;takes a min-typ-or-lst and OR-merges it with a typ to give back a OR-type list which cannot be minimized furthur
-(defun merge-type-with-type-list-using-OR (typ min-typ-lst wrld)
-  (if (endp min-typ-lst)
-    (list typ)
-    (let ((un-lst (union-of-types typ (car min-typ-lst) wrld)))
-      (if (= 1 (len un-lst)) ;got merged
-          (merge-type-with-type-list-using-OR (car un-lst) (cdr min-typ-lst) wrld);merge with rest
-          (cons (car min-typ-lst)
-                (merge-type-with-type-list-using-OR typ (cdr min-typ-lst) wrld))))))
-
-;walk through the type list and accumulate the minimal 'or' representation e.g nat \/ pos = pos
-(defun collapse-or-type-list-aux (typ-lst wrld ans)
-  (if (endp typ-lst)
-    ans
-    (collapse-or-type-list-aux (cdr typ-lst) wrld
-                               (merge-type-with-type-list-using-OR (car typ-lst) ans wrld))))
-
-(defun collapse-or-type-list (typ-lst wrld)
-  (collapse-or-type-list-aux typ-lst wrld nil))
-
-; this function takes a type and a type-list and one by one returns a list
-;which is obtained by taking intersection of typ with each element of typ-lst
-(defun union-vt-and4 (typ typ-lst wrld)
-  (if (endp typ-lst)
-    nil
-    (let ((intersection-t (intersection-of-types typ (car typ-lst) wrld)))
-      (if intersection-t 
-        (cons intersection-t (union-vt-and4 typ (cdr typ-lst) wrld))
-        (union-vt-and4 typ (cdr typ-lst) wrld)))))
-                         
-;This function does something similar to:
-;(t1 \/ t2) /\ (t3 \/ t4) ==> (t1 /\ t3) \/ (t1 /\ t4) \/ (t2 /\ t3) \/ (t2 /\ t4) 
-;note that we wont get an empty list as a first call argument
-;Note that a type-list is nothing but an OR of the types
-(defun union-vt-and3 (typ-lst1 typ-lst2 wrld)
-  (declare (xargs :guard (and (true-listp typ-lst1)
-                              (plist-worldp wrld)
-                              (true-listp typ-lst2))))
-  (if (endp typ-lst1)
-    nil
-    (append (union-vt-and4 (car typ-lst1) typ-lst2 wrld)
-            (union-vt-and3 (cdr typ-lst1) typ-lst2 wrld))))
-    
- ;ok now 'nil' what does it stand for? for me I have taken 'nil' as a list containing type ALL, so
- ;we just return the other list. This function also compresses the type-lists with union-of-types
-;operation, so we save time done by opening up the OR operation with AND operations later:
-(defun union-vt-and2 (typ-lst1 typ-lst2 wrld)
-  (declare (xargs :guard (and (true-listp typ-lst1)
-                              (plist-worldp wrld)
-                              (true-listp typ-lst2))))
-  (cond ((endp typ-lst1) (collapse-or-type-list typ-lst2 wrld))
-        ((endp typ-lst2) (collapse-or-type-list typ-lst1 wrld))
-        (t (union-vt-and3 (collapse-or-type-list typ-lst1 wrld)
-                          (collapse-or-type-list typ-lst2 wrld)
-                          wrld))))
-
-;not tail-rec; assumption: vt-al2 has not repetetions
-;For each pair in vt-al2 check if it matches the variable and
-;then for the type-lists obtained from both, we try to and-merge them.
-;So we give back a modified vt-al which takes into account and-merging of
-;type-lists for the particular variable in vt-pair
-(defun union-vt-and1 (vt-pair vt-al2 wrld)
-  (if (endp vt-al2)
-    (list vt-pair) ;var not found in vt-al2, so just add it into the list returned
-    (let ((vt-pr2 (car vt-al2)))
-      (if (eq (car vt-pr2) (car vt-pair));if variables match, then do the foll
-        (cond ((equal (cdr vt-pair) '(all)) vt-al2);return unchanged (shortcircuit the recursion)
-              ((equal (cdr vt-pr2) (cdr vt-pair)) vt-al2)  ;shortcircuit, return unchanged 
-              ((equal (cdr vt-pr2) '(all)) (cons vt-pair (cdr vt-al2)));pick vt-pair and short-circuit
-              (t (cons (cons (car vt-pair) (union-vt-and2 (cdr vt-pr2) (cdr vt-pair) wrld)) (cdr vt-al2))));diff types than all
-        (cons vt-pr2 (union-vt-and1 vt-pair (cdr vt-al2) wrld))))));otherwise carry on to see if match found furthur down
-
-
-
-;tail-rec; assumption: vt-al2 has no repetetions
-(defun union-vt-and-aux (vt-al1 vt-al2 wrld)
-  (if (endp vt-al1)
-    vt-al2 ;return it if vt-al1 is empty 
-    (union-vt-and-aux (cdr vt-al1) 
-                      (union-vt-and1 (car vt-al1) vt-al2 wrld) wrld)))
-
-; The following function walks vt-al collapsing the dup var entries with
-; AND type-lists operation
-;;the answer is accumulated in vt-al2 arg of union-vt-and-aux
-(defun union-vt-al-collapse-and (vt-al wrld )
-  (union-vt-and-aux vt-al nil wrld))
-
-
-(defun union-vt-collapse-or-type-lists (vt-al wrld)
-  (if (endp vt-al)
-    nil
-    (cons (cons (caar vt-al) (collapse-or-type-list (cdar vt-al) wrld))
-          (union-vt-collapse-or-type-lists (cdr vt-al) wrld))))
-
-
-;TODO: calculate the time complexity of this function
-(defun union-vt-and (vt-al1 vt-al2 freevars wrld)
-
-  (let* (
-;filter relevant v-t pairs
-         (vt-al2-filtered (filter-alist-keys vt-al2 freevars))
-; collapse ors, i.e union types
-         (vt-al2-filtered1 (union-vt-collapse-or-type-lists vt-al2-filtered wrld))
-         (no-dup-vt-al2 (union-vt-al-collapse-and vt-al2-filtered1 wrld));first pass which ensures a no-dup backbone list
-         (vt-al1-filtered  (defdata::filter-alist-keys vt-al1 freevars))
-         (vt-al1-filtered1 (union-vt-collapse-or-type-lists vt-al1-filtered wrld));collapse ors
-         (vt-al (union-vt-and-aux vt-al1-filtered1 no-dup-vt-al2 wrld)));second pass  through our maze of calls above
-    (union-vt-collapse-or-type-lists vt-al wrld)));final pass, collapsing or-type-lists for each var across vt-al1 and vt-al2
-
-
-;; (union-vt-and '((a integer) (b pos) (b nat) (c all) (c character) (c 1))
-;;               '( (a rational) (a all) (c list) (c all) (b all)) (w state))
-;;  ===> ((A INTEGER) (C 1) (B POS))
-
-;; (union-vt-and 
-;; '((a integer) (b rational) (b string positive-rational) (c pos) (c 2))
-;; '( (a rational) (a all neg) (c 2 pos nat) ) (w state))
-
-
-; freevars argument is necessary because the term might not
-; be an acl2 term(not satisfy termp), its the responsibility
-; of the calling function to provide the free variables of term
-(defun extract-var-typ-alist-from-term (term freevars wrld)
- (let* ((v-all-lst (empty-vt-alist freevars))
-           (hyp (get-hyp term)) 
-           (concl (get-concl term))
-; as pete said, we try to extract info from simple negated conclusions like
-           ;;;(implies (xp a)
-           ;;;         (not (yp b)))
-           (hyp-neg-concl (extend-hyp-with-simple-negated-concl hyp concl))
-           (var-ty-al (pull-types-from-hyp hyp-neg-concl wrld))
-           (var-ty-alst (union-vt-and var-ty-al v-all-lst freevars wrld)))
-      var-ty-alst))
-
diff -Nru acl2-6.2/books/countereg-gen/simple-graph-array.lisp acl2-6.3/books/countereg-gen/simple-graph-array.lisp
--- acl2-6.2/books/countereg-gen/simple-graph-array.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/simple-graph-array.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,437 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book t :ttags :all);$ACL2s-Preamble$|#
-
-;Author: Harsh Raju Chamarthi (harshrc)
-
-(in-package "DEFDATA")
-(include-book "utilities" :load-compiled-file :comp)
-(include-book "ordinals/lexicographic-ordering-without-arithmetic" :dir :system)
-
-(defun make-n-upto-list (size ans)
-;make a list of natural numbers upto (size-1)
-;(make-n-upto-list 3 nil) ==> (0 1 2)
-  (declare (xargs :guard (and (natp size)
-                              (nat-listp ans))))
-  (if (zp size)
-    ans
-    (make-n-upto-list  (1- size) (cons (1- size) ans))))  
-
-(set-verify-guards-eagerness 0)
-
-
-(defmacro in (a X) 
-  `(member-equal ,a ,X))
-
-(defun vertex-indexes (vs sym-lst)
-;returns a natural number which is associated with
-;v in mapping. vs is the original symbol-list
-;used to create mapping
- (declare (xargs :guard (and (symbol-listp vs)
-                             (symbol-listp sym-lst)
-                             (subsetp vs sym-lst))))
- (if (endp vs)
-     nil
-   (cons (position (car vs) sym-lst)
-         (vertex-indexes (cdr vs) sym-lst))))
-
-(defstobj g$
-  (adj-list-array :type (array T (0))
-                  :initially nil
-                  :resizable t)
-  :renaming ((adj-list-arrayi ai)
-             (update-adj-list-arrayi ui))
-  :doc "Graph represented as an adjacency list array.
-        Key is vertex-index.
-        Value is a record with the following fields:
-        :name - (symbol) name of the vertex
-        :adj - (nat-list) list of indexes of adjacent vertices
-        :seen - boolean (bit) indicating wether this vertex has been visited
-        :cc - (nat) indicating the connected component this vertex belongs to"
-  :inline t)
-
-(defrec vinfo%
-  (name adj seen cc)
-  NIL)
-
-
-(defmacro make-g$-array-value (name &key adj seen cc)
- `(acl2::make vinfo%
-     :name ,name
-     :adj ,adj
-     :seen ,seen
-     :cc ,(or cc 0)))
-
-(defun symbol-alst->g$1 (alst vs g$)
- (declare (xargs :stobjs (g$)
-                 :guard (and (symbol-alistp alst)
-                            (symbol-listp vs)
-                            (g$p g$)
-                            )))
-;transforms a symbol-alist graph adjacency list representation
-;to an g$ adjacency list representation.
- (if (endp alst)
-     g$
-   (b* (((cons v adj-vs) (car alst))
-        ((list i) (vertex-indexes (list v) vs))
-        (adj-is (vertex-indexes adj-vs vs))
-        (g$ (ui i (make-g$-array-value v :adj adj-is) g$)))
-     (symbol-alst->g$1 (cdr alst) vs g$))))
-
-
-(defun init-g$1 (i vs g$)
- (declare (xargs :stobjs (g$)
-                 :guard (and (symbol-listp vs)
-                             (g$p g$)
-                             )))
-;intializes a g$ to a graph with no edges
- (if (endp vs)
-     g$
-     (let ((g$ (ui i (make-g$-array-value (car vs)) g$)))
-       (init-g$1 (1+ i) (cdr vs) g$))))
-
-(defun init-g$ (vs size g$)
-  ";intializes/resets a g$ to a graph with no edges"
-  (declare (xargs :stobjs (g$)
-                  :guard (and (symbol-listp vs)
-                              (= (len vs) size)
-                              (g$p g$)
-                              )))
-  (let ((g$ (resize-adj-list-array size g$)))
-    (init-g$1 0 vs g$)))
-#||
-(defun reset-g$-aux (l g$)
-  (if (zp l)
-      g$
-    (reset-g$-aux (1- l)
-                  ;;index corresponding to l is (1- l) which is the last
-                  ;;element initially
-                  (ui (1- l) nil g$))))
-
-(defun reset-g$ (g$)
-  "reset the information stored for each vertice"
-  (reset-g$-aux (adj-list-array-length g$) g$))
-||#
-
-(defun symbol-alist->g$ (alst g$)
-"top-level call to populate g$ with adj-list information obtained
-from alst. Assumption: (len alst) = number of vertices in graph and
-[strip-cars alst] has distinct vertices"
- (declare (xargs :stobjs (g$)
-                 :guard (and (symbol-alistp alst)
-                             (g$p g$))))
-                 
- (b* ((vs (strip-cars alst))
-      (size (len alst))
-      (g$ (init-g$ vs size g$)))
-   (symbol-alst->g$1 alst 
-                     vs ;find position (index)
-                     g$
-                     )))
-
-(set-well-founded-relation acl2::l<)
-
-
-
-;Dasgupta Algo
-;Vertices are natural numbers.
-(defun dfs-visit1 (g$ v n fin flag)
-"explore the graph g$ (adj-list array) starting at v.
-n is the number of vertices of g$ not seen,
-initially it is just the total number of vertices.
-fin is the list of finished vertices, with the
-(car fin) being the last finished vertice, i.e
-the vertice with the maximum post time."
-  (declare (xargs :stobjs (g$)
-                  :guard (and (g$p g$)
-                              (or (natp v);vertice
-                                  (nat-listp v));vertices
-                              (nat-listp fin)
-                              (natp n))
-                  :measure (list (nfix n) (acl2-count v))))
-  (if (zp n);visited all vertices
-      (mv g$ fin)
-    (if (equal 'dfs-visit flag)
-;DFS-VISIT
-        (b* ((v-entry (ai v g$))
-             (adj-vs (acl2::access vinfo% v-entry :adj))
-             (g$ (ui v (acl2::change vinfo% v-entry :seen t) g$));update/change seen
-             ((mv g$ fin!)
-              (dfs-visit1 g$ adj-vs (1- n) fin 'dfs-visit-lst)))
-          ;;update finished vertices
-          (mv g$ (cons v fin!)))
-;DFS-VISIT-LST
-      (if (endp v);visited all neighbours
-          (mv g$ fin)
-        (b* ((v-entry (ai (car v) g$))
-             ;(- (cw "dfs-visit-lst: v-entry for ~x0 is ~x1~%" (car v) v-entry))
-             )
-          (if (acl2::access vinfo% v-entry :seen);already seen
-              (dfs-visit1 g$ (cdr v) n fin 'dfs-visit-lst)
-            (b* (((mv g$ fin!)
-                  (dfs-visit1 g$ (car v) n fin 'dfs-visit)))
-              (dfs-visit1 g$ (cdr v) n fin! 'dfs-visit-lst))))))))
-        
-
-(defun dfs-all-vertices (g$ vs n fin cnum) 
-"Do DFS over all vertices in vs"
-  (declare (xargs :stobjs (g$)
-                  :guard (and (g$p g$)
-                              (nat-listp vs);vertices
-                              (nat-listp fin)
-                              (natp cnum)
-                              (natp n))))
- 
-  (if (endp vs);visited all neighbours
-      (mv g$ fin)
-      (b* ((v-entry (ai (car vs) g$)))
-           ;(- (cw "dfs-all: v-entry for ~x0 is ~x1~%" (car vs) v-entry)))
-        (if (acl2::access vinfo% v-entry :seen);already seen
-            (dfs-all-vertices g$ (cdr vs) n fin cnum)
-        (b* ((g$ (ui (car vs) 
-                     (acl2::change vinfo% v-entry :cc cnum)
-                     g$))
-             ((mv g$ fin!) 
-              (dfs-visit1 g$
-                          ;;update current component as part of pre 
-                          (car vs) n fin 
-                          'dfs-visit)))
-          (dfs-all-vertices g$ (cdr vs) n fin! (1+ cnum)))))))
-
-
-(defun dfs1 (g$ vs)
-;Depth First Search on adj list array g$ iterating
-;over the vertices in vs.
-  (declare (xargs :stobjs (g$)
-                  :guard (and (nat-listp vs)
-                              (g$p g$))))
-  (dfs-all-vertices g$ vs (adj-list-array-length g$) nil 0))
-
-;(defdata adjacency-list (map symbol symbol-list))
-(defun adjacency-list1p (v)
-  (if (null v)
-      t
-    (if (atom v)
-        nil
-      (let ((entry (car v)))
-      (and (symbolp (car entry))
-           (symbol-listp (cdr entry))
-           (no-duplicatesp (cdr entry))
-           (adjacency-list1p (cdr v)))))))
-
-(defun adjacency-listp (v)
-  (and (adjacency-list1p v)
-       (no-duplicatesp (strip-cars v))))
-
-(defun make-empty-adj-list (vars)
-  (declare (xargs :guard (and (symbol-listp vars)
-                              (no-duplicatesp vars))))
-  ;order important 
-  ;order of keys alst created is the same as order of vars
-  (if (endp vars)
-    nil
-    (cons (cons (car vars) nil)
-          (make-empty-adj-list (cdr vars)))))
-
-
-
-;fs means Functionaly dependent vars
-;ASSUMPTION: alst has all the variables as keys already
-;this function just updates the entries, doesnt insert
-;new entries.
-(defun union-entry-in-adj-list (var fvars alst)
-  (declare (xargs :guard (and (adjacency-listp alst)
-                              (true-listp fvars))))
-  (if (endp alst)
-      nil
-    (if (eq var (caar alst))
-      (cons (cons var (union-equal fvars 
-                                   (cdar alst)))
-            (cdr alst))
-      (cons (car alst)
-            (union-entry-in-adj-list var fvars (cdr alst))))))
-  
-  
-;recurse above fun over list of indices
-(defun union-entries-in-adj-list (is fis alst)
- (declare (xargs :guard (and (adjacency-listp alst)
-                             (true-listp is)
-                             (true-listp fis))))
- (if (endp is)
-    alst
-    (union-entries-in-adj-list 
-     (cdr is) fis (union-entry-in-adj-list (car is) fis alst))))
-
-  
-(defun transpose-alst1 (alst ans)
-;Scan G at index i and transpose the result corresponding to i in ans
-  (declare (xargs :guard (and (adjacency-listp alst)
-                              (adjacency-listp ans)
-                              )))
-  (if (endp alst)
-      ans
-    (b* (((cons v vs) (car alst)))
-      (transpose-alst1 (cdr alst)
-                       (union-entries-in-adj-list vs (list v) ans)))))
-  
-
-(defun transpose-alst (alst)
-;Return transpose/reverse of alst
-;INVARIANT: Order is very important
-  (declare (xargs :guard (adjacency-listp alst)))
-  (transpose-alst1 alst (make-empty-adj-list (strip-cars alst))))
-#|
-(defthm transpose-idempotent
-  (implies (adjacency-list1p x)
-           (equal (transpose-alst (transpose-alst x))
-                  x)))
-
-(defthm transpose-doesnt-change-order
-  (implies (adjacency-list1p x)
-           (equal (strip-cars (transpose-alst x))
-                  (strip-cars x))))
-|#
-
-
-
-
-(defun scc1 (alst g$)
-;Strongly Connected Components of adj list array G,
-;alst is the same adj-list, but in form of an alist
-  (declare (xargs :stobjs (g$)
-                  :guard (and (symbol-alistp alst)
-                              (adjacency-listp alst)
-                              (g$p g$))))
-  (b* ((r-alst (transpose-alst alst))
-       (g$ (symbol-alist->g$ r-alst g$))
-       (N (adj-list-array-length g$))
-       ((mv g$ fin) (dfs1 g$ (make-n-upto-list N nil)))
-       (g$ (symbol-alist->g$ alst g$))
-       ((mv g$ fin!) (dfs1 g$ fin)))
-    (mv g$ fin!)))
-
-
-(defun g$->var-quotient-alst1 (g$ i size ans)
-  "Given graph g$, where g$[v]=(record name adj-is seenBit ccnum), we will
-return, symbol alist, which maps each vertex (name), to its component
-number (ccnum). This is used in simple-var-hyp? for finding cycles."
-  (declare (xargs  :stobjs (g$)
-                   :measure (nfix (- size i))
-                   :guard (and (natp i) (natp size)
-                               (<= i size))))
-  (if (zp (- size i))
-      ans
-    (let ((v-entry (ai i g$)))
-      (g$->var-quotient-alst1 g$ (1+ i) size
-                             (acons (acl2::access vinfo% v-entry :name) 
-                                    (acl2::access vinfo% v-entry :cc)
-                                    ans)))))
-
-(defun g$->var-quotient-alst (g$)
-  (declare (xargs :stobjs (g$)))
-  (g$->var-quotient-alst1 g$ 0 (adj-list-array-length g$) nil))
-
-(defun vertex-names (is g$)
-  (declare (xargs :stobjs (g$)
-                  :guard (nat-listp is)))
-  (if (endp is)
-      nil
-    (cons (acl2::access vinfo% (ai (car is) g$) :name)
-          (vertex-names (cdr is) g$))))
-
-(defun g$->alst1 (g$ i size ans)
-  (declare (xargs  :stobjs (g$)
-                   :measure (nfix (- size i))
-                   :guard (and (natp i) (natp size)
-                               (<= i size))))
-  (if (zp (- size i))
-      ans
-    (let ((v-entry (ai i g$)))
-      (g$->alst1 g$ (1+ i) size
-                    (acons (acl2::access vinfo% v-entry :name) 
-                           (vertex-names (acl2::access vinfo% v-entry :adj) g$)
-                           ans)))))
-
-(defun g$->symbol-alist (g$)
-  (declare (xargs  :stobjs (g$)))
-  (g$->alst1 g$ 0 (adj-list-array-length g$) nil))
-
-
-(defun scc0 (alst g$)
-  (declare (xargs :stobjs (g$)
-                  :guard (symbol-alistp alst)))
-  (mv-let (g$ fin)
-          (scc1 alst g$)
-          (mv (g$->var-quotient-alst g$) 
-              (vertex-names fin g$)
-              (g$->symbol-alist g$)
-              g$)))
-
-(defun fix-adjacency-list (alst)
-  (declare (xargs :guard (adjacency-listp alst)))
-  "Fix an adjacency list to have in it keys all the vertices."
-  (b* ((adj-v-lst-lst (strip-cdrs alst))
-       (vs (strip-cars alst))
-       (adj-vs (union-lsts adj-v-lst-lst))
-       (missing-vs (set-difference-eq adj-vs vs))
-       (missing-alst (pairlis$ missing-vs nil)))
-    (append alst missing-alst)))
-
-(defun strongly-connected-components (alst debug-flag)
-   "Strongly Connected Components of adj list graph alst.
-Gives (mv map-ccnum finished-vertex-list) as result, where
-map-ccnum, maps each vertex to its component number. 
-finished-vertex-list gives the list of vertexes in decreasing
-post times."
-   (declare (xargs :guard (adjacency-listp alst)))
-    (b* ((alst! (fix-adjacency-list alst))
-         (- (cw? (and (not (equal alst alst!))
-                               debug-flag)
-            "SCC: Got Adjacency list : ~x0 Fixed to : ~x1~%" alst alst!)))
-      (acl2::with-local-stobj 
-       g$
-       
-       (mv-let (var-ccnum-alst decreasing-post-times-vertex-lst adj-alst g$)
-               (scc0 alst! g$)
-               (mv var-ccnum-alst 
-                   decreasing-post-times-vertex-lst
-                   adj-alst)))))
-   
-;to check simple soundness (g$->symbol-alist g$) = alst!
-  
-(defun approximate-topological-sort (alst debug-flag)
-;return vertices following the order ->, but
-;since alst might not be a dag, the order 
-;inside a component might be skewed, but we
-;are okay with it, since we choose arbitrarily
-;from within a component 
-  (declare (xargs :guard (adjacency-listp alst)))
-  (b* (((mv & fin-vs &) 
-        (strongly-connected-components alst debug-flag)))
-    fin-vs))
-       
-
-
-
-#|
-
-;example:
-;(untrace$ dfs dfs-visit dfs-all-vertices)
-(let* ((A '((a b)
-            (b e c d)
-            (c f)
-            (d)
-            (e b g f)
-            (f c h)
-            (g j h )
-            (h k)
-            (i g)
-            (j i)
-            (k l)
-            (l j))))
-  (approximate-topological-sort A))
-;ans:(A B E C F D G H K L J I)
-;ans by memories graph.lisp: (A B E C F D G H K L J I)
-|#  
-;What correctness theorems can we prove?
diff -Nru acl2-6.2/books/countereg-gen/splitnat.lisp acl2-6.3/books/countereg-gen/splitnat.lisp
--- acl2-6.2/books/countereg-gen/splitnat.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/splitnat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,866 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-
-(acl2::begin-book);$ACL2s-Preamble$|#
-
-
-(in-package "DEFDATA")
-
-(set-verify-guards-eagerness 2)
-(set-state-ok t)
-
-(include-book "num-list-fns" :load-compiled-file :comp)
-
-(local (include-book "num-list-thms"))
-
-(local (include-book "rem-and-floor"))
-
-(defun weighted-split-nat-step (weights x old-results)
-  (declare (xargs :guard (and (2+-listp weights)
-                              (natp x)
-                              (naturals-listp old-results)
-                              (= (len weights) (len old-results)))))
-  (if (mbe :logic (or (endp weights)
-                      (endp old-results))
-           :exec (endp weights))
-    nil
-    (let ((weight (car weights)))
-      (cons (+ (* weight (car old-results))
-               (rem x weight))
-            (weighted-split-nat-step (cdr weights)
-                                     (floor x weight)
-                                     (cdr old-results))))))
-
-
-(local (defthm weighted-split-nat-step--true-listp
-         (true-listp (weighted-split-nat-step w x r))
-         :rule-classes (:type-prescription :rewrite)))
-
-(local (defthm weighted-split-nat-step--len
-         (equal (len (weighted-split-nat-step w x r))
-                (min (len w) (len r)))))
-
-(local (defthm weighted-split-nat-step--nat-listp
-         (implies (and (naturals-listp w)
-                       (integerp x)
-                       (<= 0 x)
-                       (naturals-listp r))
-                  (naturals-listp (weighted-split-nat-step w x r)))
-         :rule-classes (:type-prescription :rewrite)))
-
-(local (defthm weighted-split-nat-step--consp
-         (implies (and (consp w)
-                       (consp r))
-                  (consp (weighted-split-nat-step w x r)))
-         :rule-classes (:type-prescription :rewrite)))
-
-
-(local (defthm weighted-split-nat-step--bound-old
-         (implies (and (2+-listp w)
-                       (integerp x)
-                       (<= 0 x)
-                       (naturals-listp r)
-                       (equal (len w) (len r)))
-                  (<=-lists (weighted-split-nat-step w x r)
-                            (+-lists
-                             (*-lists r
-                                      w)
-                             w)))
-         :rule-classes (:rewrite)))
-
-
-(local
- (encapsulate nil
-   (local (include-book "arithmetic-5/top" :dir :system))
-   
-   (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
-                                acl2::STABLE-UNDER-SIMPLIFICATIONP
-                                acl2::HIST
-                                acl2::PSPV))))
-
-  (defthm <=-lists--scale
-           (implies (and (rationalp v)
-                         (<= 0 v)
-                         (rationalp w)
-                         (<= v w)
-                         (naturals-listp l))
-                    (<=-lists (scale l v)
-                              (scale l w))))
-
-  (defthm <=-lists--scale2
-           (implies (and (<=-lists l1
-                                   (scale l2 v))
-                         (rationalp v)
-                         (<= 0 v)
-                         (rationalp w)
-                         (<= v w)
-                         (naturals-listp l2))
-                    (<=-lists l1
-                              (scale l2 w))))
-
-  (defthm <=-lists--scale3
-           (implies (and (rationalp v)
-                         (<= 0 v)
-                         (naturals-listp l1)
-                         (naturals-listp l2)
-                         (<=-lists l1 l2))
-                    (<=-lists (scale l1 v)
-                              (scale l2 v))))
-
-  (defthm <=-lists--scale4
-           (implies (and (rationalp v1)
-                         (<= 0 v1)
-                         (rationalp v2)
-                         (<= 0 v2)
-                         (naturals-listp l1)
-                         (naturals-listp l2)
-                         (<=-lists l1 l2)
-                         (<= v1 v2))
-                    (<=-lists (scale l1 v1)
-                              (scale l2 v2))))
-
-  
-  (defthm <=-lists--shift
-    (implies (and (rationalp v)
-                  (rationalp w)
-                  (<= v w)
-                  (rational-listp l))
-             (<=-lists (shift l v)
-                       (shift l w))))
-
-  (defthm <=-lists--shift2
-    (implies (and (<=-lists l1
-                            (shift l2 v))
-                  (rationalp v)
-                  (rationalp w)
-                  (<= v w)
-                  (rational-listp l2))
-             (<=-lists l1
-                       (shift l2 w))))
-
-  (defthm <=-lists--shift3
-           (implies (and (rationalp v)
-                         (rational-listp l1)
-                         (rational-listp l2)
-                         (<=-lists l1 l2))
-                    (<=-lists (shift l1 v)
-                              (shift l2 v))))
-
-  (defthm <=-lists--shift4
-           (implies (and (rationalp v1)
-                         (rationalp v2)
-                         (rational-listp l1)
-                         (rational-listp l2)
-                         (<=-lists l1 l2)
-                         (<= v1 v2))
-                    (<=-lists (shift l1 v1)
-                              (shift l2 v2))))
-  ))
-
-(local (defthm shift--<=
-         (equal (<=-lists (shift l v1)
-                          (shift l v2))
-                (or (endp l)
-                    (<= v1 v2)))))
-
-(local (defthm weighted-split-nat-step--bound
-         (implies (and (2+-listp w)
-                       (integerp x)
-                       (<= 0 x)
-                       (naturals-listp r)
-                       (equal (len w) (len r)))
-                  (<=-lists (weighted-split-nat-step w x r)
-                            (shift
-                             (*-lists r w)
-                             x)))))
-
-(local
- (encapsulate nil
-   (local (include-book "arithmetic-5/top" :dir :system))
-   
-   (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
-                                acl2::STABLE-UNDER-SIMPLIFICATIONP
-                                acl2::HIST
-                                acl2::PSPV))))
-   
-   (defthm weighted-split-nat-step--bound2--lemma
-     (implies (and (naturals-listp r)
-                   (2+-listp w)
-                   (equal (len r) (len w)))
-              (<=-lists (*-lists r w)
-                        (scale r (product-list w)))))))
-
-
-(local
- (encapsulate nil
-   (local (defthm <=-lists--transitive--force
-            (implies (and (<=-lists a b)
-                          (force (<=-lists b c)))
-                     (<=-lists a c))
-            :rule-classes ((:rewrite :match-free :all))))
-
-  (local (defthm <=-lists--scale4--force
-           (implies (and (rationalp v1)
-                         (<= 0 v1)
-                         (rationalp v2)
-                         (<= 0 v2)
-                         (naturals-listp l1)
-                         (naturals-listp l2)
-                         (force (<=-lists l1 l2))
-                         (force (<= v1 v2)))
-                    (<=-lists (scale l1 v1)
-                              (scale l2 v2)))))
-
-  (local (defthm <=-lists--shift4--force
-           (implies (and (rationalp v1)
-                         (rationalp v2)
-                         (rational-listp l1)
-                         (rational-listp l2)
-                         (force (<=-lists l1 l2))
-                         (force (<= v1 v2)))
-                    (<=-lists (shift l1 v1)
-                              (shift l2 v2)))))
-   
-  (local (include-book "arithmetic-5/top" :dir :system))
-  
-  (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
-                               acl2::STABLE-UNDER-SIMPLIFICATIONP
-                               acl2::HIST
-                               acl2::PSPV))))
-
-   (defthm weighted-split-nat-step--bound2
-     (implies (and (2+-listp w)
-                   (integerp x)
-                   (<= 0 x)
-                   (naturals-listp r)
-                   (equal (len w) (len r)))
-              (<=-lists (weighted-split-nat-step w x r)
-                        (shift
-                         (scale r (product-list w))
-                         x))))))
-
-
-(local
- (defthm get-weights-factor-->=2
-   (implies (and (2+-listp x)
-                 (consp x))
-            (<= 2 (product-list x)))
-   :rule-classes (:linear :rewrite)))
-
-
-(defun rot-list (x)
-  (declare (xargs :guard (and (true-listp x)
-                              (consp x))))
-  (append (cdr x) (list (car x))))
-
-(local
- (defthm rot-list--consp
-   (implies (consp x)
-            (consp (rot-list x)))
-   :rule-classes (:type-prescription :rewrite)))
-
-(local (defthm consp-cdr-append
-         (implies (and (consp x)
-                       (consp y))
-                  (consp (cdr (append x y))))))
-
-(local
- (defthm rot-list--consp-cdr
-   (implies (and (consp x)
-                 (consp (cdr x)))
-            (consp (cdr (rot-list x))))
-   :rule-classes (:type-prescription :rewrite)))
-
-(local
- (defthm len-append-single
-   (equal (len (append x (list y)))
-          (+ 1 (len x)))))
-
-(local
- (defthm rot-list--len
-   (implies (consp x)
-            (equal (len (rot-list x))
-                   (len x)))))
-
-(local (defthm rot-list--nat-listp
-         (implies (and (naturals-listp x)
-                       (consp x))
-                  (naturals-listp (rot-list x)))))
-
-(local (defthm rot-list--2+-listp
-         (implies (and (2+-listp x)
-                       (consp x))
-                  (2+-listp (rot-list x)))))
-
-(local (defthm rot-list--product-list
-         (implies (consp x)
-                  (equal (product-list (rot-list x))
-                         (product-list x)))))
-
-(local (defthm all-<=--rot-list
-         (implies (consp l)
-                  (equal (all-<= (rot-list l)
-                                 x)
-                         (all-<= l
-                                 x)))))
-
-(local (in-theory (disable rot-list)))
-
-(defun weighted-split-nat1 (weights weights-factor x)
-  (declare (xargs :measure (nfix x)
-                  :verify-guards nil
-                  :guard (and (2+-listp weights)
-                              (equal weights-factor (product-list weights))
-                              (consp weights)
-                              (natp x))))
-  (if (mbe :logic (or (zp x)
-                      (endp weights)
-                      (not (equal weights-factor (product-list weights)))
-                      (not (2+-listp weights)))
-           :exec (zp x))
-    (make-list (len weights) :initial-element 0)
-    (weighted-split-nat-step weights
-                             (rem x weights-factor)
-                             (rot-list
-                              (weighted-split-nat1
-                               (rot-list weights)
-                               weights-factor
-                               (floor x weights-factor))))))
-
-(local
- (defthm weighted-split-nat1--consp
-   (implies (consp weights)
-            (consp (weighted-split-nat1 weights weights-factor x)))))
-
-(local
- (defthm weighted-split-nat1--len
-   (equal (len (weighted-split-nat1 weights weights-factor x))
-          (len weights))))
-
-(local
- (defthm weighted-split-nat1--nat-listp
-   (implies (and (2+-listp weights)
-                 (consp weights)
-                 (equal weights-factor (product-list weights))
-                 (integerp x)
-                 (<= 0 x))
-            (naturals-listp (weighted-split-nat1 weights weights-factor x)))
-   :rule-classes ((:rewrite)
-                  (:rewrite :corollary
-                   (implies (and (2+-listp weights)
-                                 (consp weights)
-                                 (equal weights-factor (product-list weights))
-                                 (integerp x)
-                                 (<= 0 x))
-                            (true-listp (weighted-split-nat1 weights weights-factor x)))))))
-
-(verify-guards weighted-split-nat1)
-
-(local
- (defthm weighted-split-nat1--<=-induction-step1
-   (implies (and (2+-listp weights)
-                 (consp weights)
-                 (integerp x)
-                 (<= 0 x))
-            (<=-lists (weighted-split-nat-step
-                       weights
-                       (rem x (product-list weights))
-                       (rot-list (weighted-split-nat1 (rot-list weights)
-                                                      (product-list weights)
-                                                      (floor x (product-list weights)))))
-                      (shift
-                       (scale (rot-list (weighted-split-nat1 (rot-list weights)
-                                                             (product-list weights)
-                                                             (floor x (product-list weights))))
-                              (product-list weights))
-                       (rem x (product-list weights)))))
-   :rule-classes nil))
-
-(local
- (encapsulate nil
-   (local (include-book "arithmetic-3/top" :dir :system))
-   
-   (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
-                                acl2::STABLE-UNDER-SIMPLIFICATIONP
-                                acl2::HIST
-                                acl2::PSPV))))
-   
-   (local (defthm all-<=--shift
-            (equal (all-<= (shift l v)
-                           x)
-                   (all-<= l
-                           (- x v)))))
-   
-   (local (defthm all-<=--scale
-            (implies (and (rationalp v)
-                          (< 0 v))
-                     (equal (all-<= (scale l v)
-                                    x)
-                            (all-<= l
-                                    (/ x v))))))
-
-   (local (defthm blah
-            (implies (and (equal n (len l)) 
-                          (<=-lists l
-                                    (make-list-logic x n))
-                          (force (<= x y)))
-                     (all-<= l
-                             y))))
-
-   (defthm weighted-split-nat1--<=-induction-step2
-     (implies (and (2+-listp weights)
-                   (consp weights)
-                   (integerp x)
-                   (<= 0 x)
-                   (all-<= (weighted-split-nat1 (rot-list weights)
-                                                (product-list weights)
-                                                (floor x (product-list weights)))
-                           (floor x (product-list weights))))
-              (all-<= (shift
-                       (scale (rot-list (weighted-split-nat1 (rot-list weights)
-                                                             (product-list weights)
-                                                             (floor x (product-list weights))))
-                              (product-list weights))
-                       (rem x (product-list weights)))
-                      x))
-     :rule-classes nil)))
-
-(local
- (defthm weighted-split-nat1--<=--consp
-   (implies (and (2+-listp weights)
-                 (consp weights)
-                 (equal weights-factor (product-list weights))
-                 (integerp x)
-                 (<= 0 x))
-            (all-<= (weighted-split-nat1 weights weights-factor x) x))
-   :hints (("Goal" :in-theory (disable len 2+-listp product-list)
-                   :do-not '(eliminate-destructors)
-                   :induct t)
-           ("Subgoal *1/2.1"
-            :use ((:instance weighted-split-nat1--<=-induction-step1)
-                  (:instance weighted-split-nat1--<=-induction-step2))))))
-
-(local
- (defthm weighted-split-nat1--<=--endp
-   (implies (not (consp weights))
-            (all-<= (weighted-split-nat1 weights weights-factor x) x))))
- 
-(local
- (defthm weighted-split-nat1--<=
-   (implies (and (2+-listp weights)
-                 (equal weights-factor (product-list weights))
-                 (integerp x)
-                 (<= 0 x))
-            (all-<= (weighted-split-nat1 weights weights-factor x) x))
-   :hints (("Goal" :cases ((consp weights))))))
-
-#|
-(defun pos-list-fix (x)
-  (if (atom x)
-    nil
-    (cons
-     (if (posp (car x))
-       (car x)
-       1)
-     (pos-list-fix (cdr x)))))
-|#
-
-(defthm pos-listp--pos-list-fix
-  (pos-listp (pos-list-fix x))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm len--pos-list-fix
-  (equal (len (pos-list-fix x))
-         (len x)))
-
-(defthm pos-list-fix--shortcut
-  (implies (pos-listp x)
-           (equal (pos-list-fix x)
-                  x)))
-
-(defun non-empty-pos-list-fix (x)
-  (if (atom x)
-    (list 1)
-    (pos-list-fix x)))
-
-(defthm len--non-empty-pos-list-fix
-  (equal (len (non-empty-pos-list-fix x))
-         (max 1 (len x))))
-
-(defthm consp--non-empty-pos-list-fix
-  (consp (non-empty-pos-list-fix x))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm pos-listp--non-empty-pos-list-fix
-  (pos-listp (non-empty-pos-list-fix x))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm non-empty-pos-list-fix--shortcut
-  (implies (and (pos-listp x)
-                (consp x))
-           (equal (non-empty-pos-list-fix x)
-                  x)))
-
-(in-theory (disable non-empty-pos-list-fix))
-
-(defun weighted-split-nat (weights x)
-  (declare (xargs :measure (nfix x)
-                  :guard (and (pos-listp weights)
-                              (consp weights)
-                              (natp x))))
-  (mbe :exec
-       (let ((2+-weights (scale weights 2)))
-         (weighted-split-nat1 2+-weights (product-list 2+-weights) x))
-       :logic
-       (let* ((weights (non-empty-pos-list-fix weights))
-              (x (nfix x))
-              (2+-weights (scale weights 2)))
-         (weighted-split-nat1 2+-weights (product-list 2+-weights) x))))
-
-(local ; weighted-split-nat will later be automatically rewritten, so these
-       ; become useless 
- (defthm weighted-split-nat--len
-   (equal (len (weighted-split-nat weights x))
-          (max 1 (len weights)))))
-
-(local
- (defthm weighted-split-nat--consp
-   (consp (weighted-split-nat weights x))))
-
-
- (defthm weighted-split-nat--nat-listp
-   (naturals-listp (weighted-split-nat weights x)))
-
-(local (defthm scale--pos-listp--2+-listp
-         (implies (pos-listp l)
-                  (2+-listp (scale l 2)))
-         :rule-classes (:forward-chaining :type-prescription)))
-
-(local
- (defthm weighted-split-nat--bound
-   (implies (and (integerp x)
-                 (<= 0 x))
-            (all-<= (weighted-split-nat weights x) x))))
-
-(local
- (defthm car--nat-list--integer
-   (implies (and (consp x)
-                 (naturals-listp x))
-            (integerp (car x)))))
-
-(local
- (defthm weighted-split-nat--car-integer
-   (INTEGERP (CAR (WEIGHTED-SPLIT-NAT WEIGHTS X)))))
-
-(local
- (defthm car--nat-list-->=0
-   (implies (and (consp x)
-                 (naturals-listp x))
-            (<= 0 (car x)))))
-
-(local
- (defthm weighted-split-nat--car->=0
-   (<= 0 (CAR (WEIGHTED-SPLIT-NAT WEIGHTS X)))))
-
-(local
-(defthm not-nat-implies-weighted-split-nat-is-zero
-  (implies (and (not (natp x))
-                (pos-listp ws)
-                (>= (len ws) 1))
-           (equal (weighted-split-nat ws x)
-                  (make-list (len ws) :initial-element 0)))))
-
-
-(in-theory (disable weighted-split-nat))
-
-
-
-
-;(set-verify-guards-eagerness 0)
-(defun nth-weighted-split-nat (i weights x)
-  (declare (xargs :guard nil)) ; logic only
-  ;(declare (xargs :verify-guards nil))
-  (if (and (integerp i)
-           (<= 0 i)
-           (< i (len weights)))
-    (nth i (weighted-split-nat weights x))
-    (car (weighted-split-nat weights x))))
-
-(defun nthcdr-weighted-split-nat (i weights x)
-  (declare (xargs :guard nil)) ; logic only
-  ;(declare (xargs :verify-guards nil))
-  (nthcdr i (weighted-split-nat weights x)))
-
-
-
-(defthm nth-weighted-split-nat--bound
-  (implies (and (integerp x)
-                (<= 0 x))
-           (<= (nth-weighted-split-nat i weights x)
-               x))
-  ;:hints (("Goal" :cases ((all-<= (weighted-split-nat weights x) x))))
-  :rule-classes (:rewrite :linear))
-
-(defthm nat-listp--nth--integerp
-         (implies (and (naturals-listp l)
-                       (integerp i)
-                       (<= 0 i)
-                       (< i (len l)))
-                  (integerp (nth i l)))
-         :rule-classes (:rewrite :type-prescription))
-
-(defthm nth-weighted-split-nat--integerp
-  (integerp (nth-weighted-split-nat i weights x))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm nat-listp--nth-->=0
-         (implies (and (naturals-listp l)
-                       (integerp i)
-                       (<= 0 i)
-                       (< i (len l)))
-                  (<= 0 (nth i l)))
-         :rule-classes (:rewrite :linear))
-
-(defthm nth-weighted-split-nat-->=0
-  (<= 0 (nth-weighted-split-nat i weights x))
-  :rule-classes (:rewrite :linear))
-
-
-(local
- (defthm nth--nthcdr--decomp
-   (implies (consp l)
-            (equal (cons (nth 0 l)
-                         (nthcdr 1 l))
-                   l))))
-
-(local
- (defthm len--nthcdr--toobig
-   (implies (and (integerp i)
-                 (<= (len l) i))
-            (equal (len (nthcdr i l))
-                   0))))
-
-(local
- (defthm len--nthcdr
-   (implies (and (integerp i)
-                 (<= 0 i)
-                 (<= i (len l)))
-            (equal (len (nthcdr i l))
-                   (- (len l) i)))))
-
-(defthm nthcdr-weighted-split-nat--len
-  (equal (len (nthcdr-weighted-split-nat i weights x))
-         (if (zp i)
-           (max 1 (len weights))
-           (if (<= i (len weights))
-             (- (len weights) i)
-             0))))
-
-(local
- (defthm consp--nthcdr
-   (equal (consp (nthcdr i l))
-          (and (consp l)
-               (implies (integerp i)
-                        (< i (len l)))))))
-
-(defthm nthcdr-weighted-split-nat--consp
-           (equal (consp (nthcdr-weighted-split-nat i weights x))
-                  (implies (integerp i)
-                           (< i (max 1 (len weights))))))
-
-(local
- (defthm naturals-listp--nthcdr
-   (implies (naturals-listp l)
-            (naturals-listp (nthcdr i l)))
-   :rule-classes (:rewrite :type-prescription)))
-
-(defthm nthcdr-weighted-split-nat--naturals-listp
-  (naturals-listp (nthcdr-weighted-split-nat i weights x)))
-
-
-(defthm weighted-split-nat--to--nthcdr-weighted-split-nat
-  (implies (and (pos-listp weights)
-                (consp weights)
-                (integerp x)
-                (<= 0 x))
-           (equal (weighted-split-nat weights x)
-                  (nthcdr-weighted-split-nat 0 weights x))))
-
-
-
-(local
- (encapsulate nil
-   (local (include-book "arithmetic-5/top" :dir :system))
-
-   (local
-    (defthm nthcdr--cdr
-      (implies (and (integerp i)
-                    (<= 0 i))
-               (equal (nthcdr i (cdr l))
-                      (nthcdr (+ 1 i) l)))
-      :hints (("Goal" :expand (nthcdr (+ 1 i) l)))))
-
-   (defthm nth--nthcdr--decomp2
-     (implies (and (integerp i)
-                   (<= 0 i)
-                   (< i (len l)))
-              (equal (cons (nth i l)
-                           (nthcdr (+ 1 i) l))
-                     (nthcdr i l))))))
-
-(defthm nthcdr-weighted-split-nat--deflike
-  (implies (and (integerp i)
-                (<= 0 i)
-                (< i (len weights)))
-           (equal (nthcdr-weighted-split-nat i weights x)
-                  (cons (nth-weighted-split-nat i weights x)
-                        (nthcdr-weighted-split-nat (+ 1 i) weights x))))
-  :hints (("Goal" :in-theory (disable nth nthcdr)))
-  :rule-classes ((:definition :controller-alist ((nthcdr-weighted-split-nat t nil nil)))))
-
-(in-theory (disable nth-weighted-split-nat nthcdr-weighted-split-nat)) 
-
-(defthm nthcdr-weighted-split-nat--car
-  (implies (and (integerp i)
-                (<= 0 i)
-                (< i (len weights)))
-           (equal (car (nthcdr-weighted-split-nat i weights x))
-                  (nth-weighted-split-nat i weights x)))
-  :hints (("Goal" :expand (nthcdr-weighted-split-nat i weights x))))
-
-(defthm nthcdr-weighted-split-nat--cdr
-  (implies (and (integerp i)
-                (<= 0 i)
-                (< i (len weights)))
-           (equal (cdr (nthcdr-weighted-split-nat i weights x))
-                  (nthcdr-weighted-split-nat (+ 1 i) weights x)))
-  :hints (("Goal" :expand (nthcdr-weighted-split-nat i weights x))))
-
-(local
- (defthm len-exceeding-return-nil
-   (implies (and (natp i)
-                 (<= (len l) i))
-            (equal (nth i l) nil))))
-(local 
- (defthm make-list-logic-len
-   (implies (natp i)
-            (equal (len (make-list-logic a i))
-                   i))))
-
-(defun nth-returns-elem-of-make-list-ind-scheme (i x)
-  (declare (xargs :guard (and (natp i) (natp x))))
-  (if (or (zp i) (zp x))
-    0
-    (nth-returns-elem-of-make-list-ind-scheme (- i 1) (- x 1))))
-
-(local
- (defthm nth-returns-elem-of-make-list
-   (implies (and (natp i)
-                 (natp x)
-                 (< i x))
-            (equal (nth i (make-list-logic a x)) a))
- :hints (("Goal" :induct 
-                 (nth-returns-elem-of-make-list-ind-scheme i x)))))
-#|
-;Above lemmas should help prove this
-(defthm nth-i-split-nat-<=
-  (implies (and (pos-listp ws)
-                (>= (len ws) 1))
-       (<= (nth i (weighted-split-nat ws x)) (nfix x)))
-  :hints (("Goal" :cases ((< i (len ws)))))
- :rule-classes (:rewrite :linear))
-|#
-
-;ADDED some hack defthms to help termination of recursive records with
-;more than 3 fields.
-(defthm nth-i-split-nat-3-<=
- ;(implies (and (integerp x)
- ;              (<= 0 x))
-          (<= (nth i (weighted-split-nat '(1 1 1) (nfix x))) (nfix x))
- :rule-classes (:rewrite :linear))
-
-(defthm nth-i-split-nat-4-<=
- ;(implies (and (integerp x)
- ;              (<= 0 x))
-          (<= (nth i (weighted-split-nat '(1 1 1 1) (nfix x))) (nfix x))
- :rule-classes (:rewrite :linear))
-
-(defthm nth-i-split-nat-5-<=
- ;(implies (and (integerp x)
- ;              (<= 0 x))
-          (<= (nth i (weighted-split-nat '(1 1 1 1 1) (nfix x))) (nfix x))
- :rule-classes (:rewrite :linear))
-
-(defthm nth-i-split-nat-6-<=
- ;(implies (and (integerp x)
- ;              (<= 0 x))
-          (<= (nth i (weighted-split-nat '(1 1 1 1 1 1) (nfix x))) (nfix x))
- :rule-classes (:rewrite :linear))
-
-; testing theorems
-
-#|
-(thm
- (implies (natp x)
-          (natp (cadr (weighted-split-nat '(3 2 4) x)))))
-(thm
- (implies (and (natp n) (natp x))
-          (<= (nth i (weighted-split-nat '(1 1 1) x)) x)))
-;|#
-
-; testing
-
-#|
-(defun weighted-split-nat-downfrom (weights n)
-  (declare (xargs :guard (and (pos-listp weights)
-                              (consp weights)
-                              (natp n))))
-  (if (zp n)
-    (list (list 0 '-> (weighted-split-nat weights 0)))
-    (cons (list n '-> (weighted-split-nat weights n))
-          (weighted-split-nat-downfrom weights (- n 1)))))
-
-(defun weighted-split-nat-upto (weights n)
-  (declare (xargs :guard (and (pos-listp weights)
-                              (consp weights)
-                              (natp n))))
-  (reverse (weighted-split-nat-downfrom weights n)))
-
-;(trace$ weighted-split-nat-step-tail)
-(weighted-split-nat-upto '(1 1) 33)
-
-;|#
-
-
-; alternative interface
-
-(defthm pos-listp--list-expt--2
-  (implies (naturals-listp l)
-           (pos-listp (list-expt 2 l)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defun pow-weighted-split-nat (pow-weights x)
-  (declare (xargs :guard (and (pos-listp pow-weights)
-                              (consp pow-weights)
-                              (natp x))))
-  (let ((2**weights (list-expt 2 pow-weights)))
-    (weighted-split-nat1 2**weights (product-list 2**weights) x)))
-
-(defun split-nat (nways x)
-  (declare (xargs :guard (and (posp nways)
-                              (natp x))))
-  (weighted-split-nat (make-list nways :initial-element 1) x))
-
-(defthm split-nat--naturals-listp
-  (naturals-listp (split-nat nways x))
-   :rule-classes :type-prescription)
-
-
-(defthm naturals-listp--true-listp
-  (implies (naturals-listp x)
-           (true-listp x))
-   :rule-classes (:rewrite :forward-chaining))#|ACL2s-ToDo-Line|#
-
-
-
diff -Nru acl2-6.2/books/countereg-gen/switchnat.lisp acl2-6.3/books/countereg-gen/switchnat.lisp
--- acl2-6.2/books/countereg-gen/switchnat.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/switchnat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,278 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book);$ACL2s-Preamble$|#
-
-
-(in-package "DEFDATA")
-
-(set-verify-guards-eagerness 2)
-
-(include-book "num-list-fns" :load-compiled-file :comp)
-
-(local (include-book "num-list-thms"))
-(local (include-book "rem-and-floor"))
-(include-book "mv-proof")
-
-(defun weighted-switch-nat-find (rem-weights weights-idx rem-wchoice quotient-x)
-  (declare (xargs :guard (and (pos-listp rem-weights)
-                              (consp rem-weights) ; len >= 1
-                              (natp weights-idx)
-                              (integerp rem-wchoice)
-                              (<= 0 rem-wchoice)
-                              (< rem-wchoice (sum-list rem-weights))
-                              (natp quotient-x))))
-  (if (mbe :logic (or (endp rem-weights)
-                      (endp (cdr rem-weights))
-                      (< rem-wchoice (car rem-weights)))
-           :exec (< rem-wchoice (car rem-weights)))
-    (mv weights-idx (+ (* (car rem-weights) quotient-x) 
-;changed from mv to list
-;UPDATE: changed back to mv 9 July 2011
-                       rem-wchoice))
-    (weighted-switch-nat-find (cdr rem-weights) (1+ weights-idx)
-                              (- rem-wchoice (car rem-weights))
-                              quotient-x)))
-
-(local
- (defthm weighted-switch-nat-find--car-integerp
-   (implies (integerp weights-idx)
-            (integerp (car (weighted-switch-nat-find rw weights-idx rwc qx))))
-   :rule-classes (:rewrite :type-prescription)))
-
-(local
- (defthm weighted-switch-nat-find--car-non-neg
-   (implies (<= 0 weights-idx)
-            (<= 0 (car (weighted-switch-nat-find rw weights-idx rwc qx))))
-   :rule-classes (:rewrite :linear)))
-
-(local
- (defthm weighted-switch-nat-find--car-bound
-   (<= (car (weighted-switch-nat-find rem-weights weights-idx rwc qx))
-       (+ weights-idx (len (cdr rem-weights))))
-   :rule-classes (:linear)))
-
-(local
- (defthm weighted-switch-nat-find--car-bound2
-   (implies (consp rem-weights)
-            (< (car (weighted-switch-nat-find rem-weights weights-idx rwc qx))
-               (+ weights-idx (len rem-weights))))
-   :rule-classes (:linear)))
-
-(local
- (defthm weighted-switch-nat-find--cadr-integerp
-   (implies (and (integer-listp rem-weights)
-                 (integerp rem-wchoice)
-                 (integerp quotient-x))
-            (integerp (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))))
-   :rule-classes (:rewrite :type-prescription)))
-
-(local
- (defthm weighted-switch-nat-find--cadr-non-neg
-   (implies (and (pos-listp rem-weights)
-                 (<= 0 rem-wchoice)
-                 (integerp quotient-x)
-                 (<= 0 quotient-x))
-            (<= 0 (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))))
-   :rule-classes (:rewrite :linear)))
-
-(local
- (encapsulate nil
-   (local (include-book "arithmetic-5/top" :dir :system))
-   
-   (local (SET-DEFAULT-HINTS '((acl2::NONLINEARP-DEFAULT-HINT
-                                acl2::STABLE-UNDER-SIMPLIFICATIONP
-                                acl2::HIST acl2::PSPV))))
-   
-   (defthm weighted-switch-nat-find--cadr-loose-bound
-     (implies (and (pos-listp rem-weights)
-                   (<= 0 rem-wchoice)
-                   (integerp quotient-x)
-                   (<= 0 quotient-x)
-                   (rationalp bound)
-                   (<= (max-nat-list rem-weights) bound))
-              (<= (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))
-                  (+ rem-wchoice
-                     (* quotient-x bound))))
-     :rule-classes (:rewrite :linear))
-   
-   (defthm weighted-switch-nat-find--cadr-bound-pre
-     (implies (and (pos-listp rem-weights)
-                   (consp rem-weights)
-                   (consp (cdr rem-weights))
-                   (<= 0 rem-wchoice)
-                   (integerp quotient-x)
-                   (<= 0 quotient-x)
-                   (implies (= 0 quotient-x)
-                            (>= rem-wchoice (car rem-weights)))
-                   (rationalp bound)
-                   (<= (sum-list rem-weights) bound))
-              (< (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))
-                 (+ rem-wchoice
-                    (* quotient-x bound)))))
-   
-   (defthm weighted-switch-nat-find--cadr-bound
-     (implies (and (pos-listp rem-weights)
-                   (consp rem-weights)
-                   (consp (cdr rem-weights))
-                   (<= 0 rem-wchoice)
-                   (integerp quotient-x)
-                   (<= 0 quotient-x)
-                   (implies (= 0 quotient-x)
-                            (>= rem-wchoice (car rem-weights))))
-              (< (cadr (weighted-switch-nat-find rem-weights weights-idx rem-wchoice quotient-x))
-                 (+ rem-wchoice
-                    (* quotient-x (sum-list rem-weights)))))
-     :rule-classes (:rewrite :linear))))
- 
-(defun weighted-switch-nat (weights x)
-  (declare (xargs :guard (and (pos-listp weights)
-                              (consp weights) ; len >= 1
-                              (integerp x)
-                              (<= 0 x))))
-  (let* ((weights (mbe :logic (pos-list-fix weights)
-                       :exec weights))
-         (x (mbe :logic (nfix x)
-                 :exec x))
-         (wtot (sum-list weights))
-         (wchoice (rem x wtot)))
-    (weighted-switch-nat-find weights 0 wchoice (floor x wtot))))
-
-(in-theory (disable weighted-switch-nat-find))
-
-(defthm weighted-switch-nat--car-integerp
-  (integerp (car (weighted-switch-nat weights x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm weighted-switch-nat--car-non-neg
-  (<= 0 (car (weighted-switch-nat weights x)))
-  :rule-classes (:linear :rewrite))
-
-(defthm weighted-switch-nat--car-bound
-  (<= (car (weighted-switch-nat weights x)) (len (cdr weights)))
-  :rule-classes (:linear :rewrite))
-
-(defthm weighted-switch-nat--car-bound2
-  (implies (consp weights)
-           (< (car (weighted-switch-nat weights x)) (len weights)))
-  :rule-classes (:linear :rewrite))
-
-
-(defthm weighted-switch-nat--cadr-integerp
-  (integerp (cadr (weighted-switch-nat weights x)))
-  :rule-classes (:type-prescription :rewrite))
-
-(defthm weighted-switch-nat--cadr-non-neg
-  (<= 0 (cadr (weighted-switch-nat weights x)))
-  :rule-classes (:linear :rewrite))
-
-(defthm weighted-switch-nat--cadr-<=
-  (implies (and (integerp x)
-                (<= 0 x))
-           (<= (cadr (weighted-switch-nat weights x))
-               x))
-  :hints (("Goal" :use ((:instance weighted-switch-nat-find--cadr-loose-bound
-                         (rem-weights (pos-list-fix weights))
-                         (weights-idx 0)
-                         (rem-wchoice (rem x (sum-list (pos-list-fix weights))))
-                         (quotient-x (floor x (sum-list (pos-list-fix weights))))
-                         (bound (sum-list (pos-list-fix weights)))))))
-  :rule-classes (:linear :rewrite))
-
-(encapsulate nil
-
-  (local (in-theory (disable pos-listp sum-list)))
-  (local (in-theory (enable weighted-switch-nat-find)))
-  
-  (defthm weighted-switch-nat--cadr-less1
-    (implies (and (pos-listp weights)
-                  (consp weights)
-                  (consp (cdr weights))
-                  (integerp x)
-                  (<= (car weights) x))
-             (< (cadr (weighted-switch-nat weights x))
-                x))
-    :hints (("Goal'" :use ((:instance weighted-switch-nat-find--cadr-bound
-                            (rem-weights (pos-list-fix weights))
-                            (weights-idx 0)
-                            (rem-wchoice (rem x (sum-list (pos-list-fix weights))))
-                            (quotient-x (floor x (sum-list (pos-list-fix weights))))))))
-    :rule-classes (:linear :rewrite))
-
-  (local (defthm weighted-switch-nat--cadr-less2-lemma
-           (implies (and (pos-listp weights)
-                         (consp weights)
-                         (consp (cdr weights))
-                         (integerp x)
-                         (<= 0 x)
-                         (< 0 (car (weighted-switch-nat weights x))))
-                    (<= (car weights) x))
-           :rule-classes :forward-chaining))
-  
-  (local (in-theory (union-theories '(weighted-switch-nat--cadr-less2-lemma
-                                      weighted-switch-nat--cadr-less1)
-                                    (theory 'minimal-theory))))
-  
-  (defthm weighted-switch-nat--cadr-less2
-    (implies (and (pos-listp weights)
-                  (consp weights)
-                  (consp (cdr weights))
-                  (integerp x)
-                  (<= 0 x)
-                  (< 0 (car (weighted-switch-nat weights x))))
-             (< (cadr (weighted-switch-nat weights x))
-                x))
-    :rule-classes (:linear :rewrite)))
-
-(in-theory (disable weighted-switch-nat))
-
-(local
- (defthm make-list-ac--pos
-   (implies (and (posp v)
-                 (pos-listp ac))
-            (pos-listp (make-list-ac n v ac)))
-   :rule-classes (:rewrite)))
-
-(defun switch-nat (nchoices x)
-  (declare (xargs :guard (and (posp nchoices)
-                              (natp x))))
-  (weighted-switch-nat (make-list nchoices :initial-element 1) x))
-
-(defun multiple-switch-nat (nchoices-lst x)
-  (declare (xargs :guard (and (pos-listp nchoices-lst)
-                              (consp nchoices-lst) ; len >= 1
-                              (natp x))))
-  (mv-let (choice x)
-          (switch-nat (car nchoices-lst) x)
-          (if (endp (cdr nchoices-lst))
-              (mv (list choice) x)
-            (mv-let (choice-lst x) 
-                    (multiple-switch-nat (cdr nchoices-lst)
-                                         (nfix x)) ; help guard verification
-                    
-                    (mv (cons choice choice-lst) x)))));switched back to mv
-
-(defthm mv-nth--to--my-mv-nth--weighted-switch-nat
-  (equal (mv-nth n (weighted-switch-nat y x))
-         (my-mv-nth n (weighted-switch-nat y x)))
-  :hints (("Goal" :in-theory (enable mv-nth--to--my-mv-nth))))
-
-
-
-
-(defun nfixg (x)
-  (declare (xargs :guard (natp x)))
-  (mbe :logic (if (natp x) x 0)
-       :exec x))#|ACL2s-ToDo-Line|#
-
-
-#| test:
-(defun nth-foo (x)
-  (declare (xargs :measure (nfix x)
-                  :guard (natp x)))
-    (mv-let (sw v)
-            (switch-nat 2 (nfixg x))
-            (if (= sw 0)
-              v
-              (cons 'x (nth-foo v)))))
-|#
\ No newline at end of file
diff -Nru acl2-6.2/books/countereg-gen/testing-regression.lsp acl2-6.3/books/countereg-gen/testing-regression.lsp
--- acl2-6.2/books/countereg-gen/testing-regression.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/testing-regression.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1683 +0,0 @@
-;; this regression file aims at testing the various features of 
-;; counterexample generation in ACL2 Sedan
-
-(include-book "countereg-gen/top" :dir :system)
-
-;++++++++++++++++testcase 1 [classic reverse example]++++++++++++++++++++++++++
-;Define Reverse function
-(defun rev (x)
-  (if (endp x)
-    nil
-    (append (rev (cdr x)) (list (car x)))))
-
-(acl2s-defaults :set verbosity-level 2)
-(test? (equal (rev (rev x)) x))
-
-(acl2s-defaults :set testing-enabled T)
-(thm (equal (rev (rev x)) x))
-(acl2s-defaults :set testing-enabled :naive)
-
-;Modify the conjecture, add the type hypothesis
-(test? (implies (true-listp x)
-                (equal (rev (rev x)) x)))
-;; Issues
-;; 1. If a function is not golden (guards not verified), then test?
-;; errors out. e.g above rev is not golden and above test? fails with:
-#|
-ACL2 Error in ( DEFUN DEFDATA::CONCLUSION-VAL-CURRENT ...):  The body
-for DEFDATA::CONCLUSION-VAL-CURRENT calls the function REV, the guards
-of which have not yet been verified.  See :DOC verify-guards.
-|#
-;; This happens for each conclusion-val, hypothesis-val and next-sigma
-;; This forced me to add (set-verify-guards-eagerness 0) to test?
-;; progn loop. But what about thm and defthm ?
-;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-;; testcase 2 (Shape of triangle - example from testing literature)
-(defdata triple (list pos pos pos))
-
-(defun trianglep (v)
-  (and (triplep v)
-       (< (third v) (+ (first v) (second v)))
-       (< (first v) (+ (second v) (third v)))
-       (< (second v) (+ (first v) (third v)))))
-
-(defun shape (v)
-  (if (trianglep v)
-      (cond ((equal (first v) (second v))
-             (if (equal (second v) (third v))
-                 "equilateral"
-               "isosceles"))
-            ((equal (second v) (third v)) "isosceles")
-            ((equal (first v) (third v)) "isosceles")
-            (t "scalene"))
-    "error"))
-
-(acl2s-defaults :set num-trials 1000000)
-(acl2s-defaults :set testing-enabled :naive)
-
-(time$
-; 27th Aug '12
-;Note: random is slightly less than twice as fast as BE
-; random - ; 4.95 seconds realtime, 4.96 seconds runtime
-;            (927,923,408 bytes allocated)
-; be -     ; 8.12 seconds realtime, 8.14 seconds runtime
-;            (1,902,023,552 bytes allocated).
-; Investigate this!
-(test? 
- (implies (and (triplep x)
-               (trianglep x)
-               (> (third x) 256)
-               (= (third x)
-                  (* (second x) (first x))))
-          (not (equal "isosceles" (shape x)))))
-)
-
-(acl2s-defaults :set num-trials 1000)
-;; fixed a bug where get-testing-enabled fn was giving wrong answer
-;; leading to backtrack hints being added twice when we eval the
-;; following form twice. Idempotency is very important.
-
-(acl2s-defaults :set testing-enabled T)
-
-;; whoa! Without arithmetic-5, I get nowhere with the
-;; below example. 
-(include-book "arithmetic-5/top" :dir :system)
-
-(test?
- (implies (and (triplep x)
-               (trianglep x)
-               (> (third x) 256)
-               (= (third x)
-                  (* (second x) (first x))))
-          (not (equal "isosceles" (shape x)))))
-
-
-
-;; testcase 3 (memory updates dont commute)
-;NOTE: The following example too, 'simple' works good enough
-
-;another example demonstrating how having the ability to find
-;counterexamples helps in debugging conjectures
-;This also illustrates how data definition framework
-;and random testing work together
-
-;update: Address * Value * Memory -> Memory
-;If Address is found in Memory, update it, or else add it to the end
-;of the memory.
-(defdata memory (listof (cons nat integer))) 
-;ISSUE: map not working due to guards
-
-;; (defdata memory (map nat integer))
-
-(nth-memory 9436794189)
-
-(defun update (address value memory)
-  (cond ((endp memory)
-         (acons address value nil))
-        ((equal address (caar memory))
-         (acons address value (cdr memory)))
-        ((< address (caar memory))
-         (acons address value memory))
-        (t (cons (car memory) (update address value (cdr memory))))))
-
-(defun make-ordered-list (n acc)
-  (if (zp n)
-    acc
-    (make-ordered-list (- n 1) (cons n acc))))
-
-(make-ordered-list 4 nil)
-
-(defun cons-up-lists (l1 l2)
-  (declare (xargs :guard (and (true-listp l1)
-                              (true-listp l2)
-                              (= (len l1)
-                                 (len l2)))))
-  (if (endp l1)
-    nil
-    (cons (cons (car l1) (car l2))
-          (cons-up-lists (cdr l1) (cdr l2)))))
-
-(defun nth-ordered-memory (n)
-  (let* ((m (nth-memory n))
-         (len (len m))
-         (vals (strip-cdrs m))
-         (keys (make-ordered-list len nil)))
-    (cons-up-lists keys vals)))
-
-;attach a custom test enumerator to a defdata type
-(defdata-testing memory :test-enumerator nth-ordered-memory)               
-
-;Conjecture - version#1
-(test?
- (equal (update a1 v1 (update a2 v2 m))
-        (update a2 v2 (update a1 v1 m))))
-; NOTE: BE gets no counterexamples in the above for numtrials 1000!
-; Makes sense.
-
-
-; Conjecture - version 2
-
-(test?
- (implies (and (memoryp m)
-               (natp a1)
-               (natp a2))
-          (equal (update a1 v1 (update a2 v2 m))
-                 (update a2 v2 (update a1 v1 m)))))
-; NOTE: BE gets no counterexamples in the above even for numtrials 100000!
-; This is not good. This is probably due to the faulty DEFDATA::|next BE args|
-; function which enumerates the variables in a naive way. See note after
-; testcase 5.
-; 1000000 timesout
-
-
-;Conjecture - version#3
-;TODO - I am not trying hard to refute conclusion in incremental
-(test?
- (implies (and (memoryp m)
-               (natp a1)
-               (natp a2)
-               ;(or (in-memory a1 m) (in-memory a2 m))
-               (not (equal a1 a2)))
-          (equal (update a1 v1 (update a2 v2 m))
-                 (update a2 v2 (update a1 v1 m)))))
-
-;Testing didnt come up with any counterexamples, lets try to prove it.
-(thm
- (implies (and (memoryp m)
-               (natp a1)
-               (natp a2)
-               ;(or (in-memory a1 m) (in-memory a2 m))
-               (not (equal a1 a2)))
-          (equal (update a1 v1 (update a2 v2 m))
-                 (update a2 v2 (update a1 v1 m)))))
-
-
-;; testcase 4 (Russinoff's example)
-
-(test? (implies (and (real/rationalp a)
-                     (real/rationalp b)
-                     (real/rationalp c)
-                     (< 0 a)
-                     (< 0 b)
-                     (< 0 c)
-                     (<= (expt a 2) (* b (+ c 1)))
-                     (<= b (* 4 c)))
-                (< (expt (- a 1) 2) (* b c))))
-
-;; TODO: C is being printed in quoted form in :incremental
-;; It seems the above has been fixed.
-
-;; TODO harshrc 27th Aug '12
-;; IMP NOTE: incremental does a bad job if the initial value for the first
-;; variable chosen is BAD. If it was good, it does an efficient job.
-;; WHich means, I need to look into how I am using num-trials,
-;; backtrack-limit and stopping condition in the case of incremental.
-;; I need to revisit the implementation design of incremental!!
-
-(thm (implies (and (real/rationalp a)
-                     (real/rationalp b)
-                     (real/rationalp c)
-                     (< 0 a)
-                     (< 0 b)
-                     (< 0 c)
-                     (<= (expt a 2) (* b (+ c 1)))
-                     (<= b (* 4 c)))
-                (< (expt (- a 1) 2) (* b c))))
-
-;not giving top-level counterexamples in :incremental
-(time$
-(test? (implies (and (real/rationalp a)
-                     (real/rationalp b)
-                     (real/rationalp c)
-                     (<= 1 a)
-                     (< 0 b)
-                     (< 0 c)
-                     (<= (expt a 2) (* b (+ c 1)))
-                     (<= b (* 4 c)))
-                (< (expt (- a 1) 2) (* b c)))))
-
-(thm (implies (and (real/rationalp a)
-                   (real/rationalp b)
-                   (real/rationalp c)
-                   (< 3/4 a)
-                   (<= (expt a 2) (* b (+ c 1)))
-                   (<= b (* 4 c)))
-              (< (expt (- a 1) 2) (* b c)))
-     :hints (("goal" :cases ((< 0 b)))))
-;08/22/12 ACL2 v5.0 The above thm no longer goes through
-
-
-;; testcase 5 (only finds cts if arithmetic-5 library is loaded)
-(test?
- (implies (and (posp x)
-               (posp y)
-               (posp z)
-               (> z 16)
-               (<= (+ x y) (* 2 z)))
-          (or (> (* x y z) (* x y x))
-              (> (* x y z) (* x y y)))))
-; Aug 27th '12
-; Note: BE does exceptionally well in the above example. The reason is
-; to do with the faulty DEFDATA::|next BE args| function. In the above
-; example this is how BE enumerates X Y Z:
-; 0 0 0 -> 1 0 0 -> 1 1 0 -> 1 1 1 -> 2 1 1 -> 2 2 1 -> and so on
-; clearly such an enumeration will find cts easily for the above conjecture.
-
-
-;;testcase 6
-(test?
- (implies (and (posp x)
-               (posp y)
-               (posp z)
-               ;Idea of introducing variables to help SELECT
-               ;(equal w (* z z))
-               (<= (+ x y) (* 2 z)))
-          (> (* z z) (* x y))))
-
-;; testcase 7 (from Harrison's book)
-(defdata formula (oneof pos
-                        (list 'not formula)
-                        (list 'and formula formula)
-                        (list 'or formula formula)
-                        (list 'implies formula formula)))
-;ISSUE: made defdata idempotent (redundant events)
-
-(defun simplify (f)
-  ;:input-contract (formulap f)
-  ;:output-contract (formulap (simplify f))
-  (cond ((posp f) f)
-        ((eq (first f) 'not) (list 'not (simplify (second f))))
-        ((eq (first f) 'and) (list 'and (simplify (second f)) (simplify (third f))))
-        ((eq (first f) 'or) (list 'or (simplify (second f)) (simplify (third f))))
-        ((eq (first f) 'implies) (list 'or (list 'not (simplify (second f))) (simplify (third f))))
-        (t f)))
-
-(defun is-simplified (f)
-  ;:input-contract (formulap f)
-  ;:output-contract (booleanp (is-simplified f))
-   (cond ((posp f) t)
-        ((eq (first f) 'not) (is-simplified (second f)))
-        ((eq (first f) 'and) (and (is-simplified (second f)) (is-simplified (third f))))
-        ((eq (first f) 'or) (and (is-simplified (second f)) (is-simplified (third f))))
-        ((eq (first f) 'implies) nil)
-        (t nil)))
-  
-(defthm simplify-is-stable
-  (equal (simplify (simplify f))
-         (simplify f)))
-
-(defun nnf (f)
-   (cond ((posp f) f)
-        ((and (eq (first f) 'not) (posp (second f))) f)
-        ((and (eq (first f) 'not) (eq 'not (first (second f))))
-         (nnf (second (second f))))
-        ((eq (first f) 'and) (list 'and (nnf (second f)) (nnf (third f))))
-        ((eq (first f) 'or) (list 'or (nnf (second f)) (nnf (third f))))
-        ((eq (first f) 'implies) (list 'implies (nnf (second f)) (nnf (third f))))
-        ((and (eq (first f) 'not)
-              (eq 'and (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'or (nnf (list 'not lhs)) (nnf (list 'not rhs)))))
-        ((and (eq (first f) 'not)
-              (eq 'or (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'and (nnf (list 'not lhs)) (nnf (list 'not rhs)))))     
-         ((and (eq (first f) 'not)
-              (eq 'implies (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'and (nnf lhs) (nnf (list 'not rhs)))))
-        (t f)))
-
-(thm ;simp-nnf-commute
-  (implies (formulap f)
-  (equal (nnf (simplify f))
-         (simplify (nnf f)))))
-
-; TODO: print-testing-summary should not appear after the summary when a new
-;form is called.
-
-;; testcase 8 (Moore's example)
-(defun square-root1 (i ri)
-  (declare (xargs :mode :program))
-  (if (>= (floor i ri) ri)
-      ri
-      (square-root1 i (floor (+ ri (floor i ri)) 2))))
-
-(defun square-root (i)
-  (declare (xargs :mode :program))
-  (square-root1 i (floor i 2)))
-
-(defun square (x)
-   (* x x))
- 
- 
-(test?
-  (implies (natp i)
-           (and (<= (square (square-root i)) i)
-                (< i (square (1+ (square-root i)))))))
-
-
-;; testcase 9 (a thm in 2, but cts in 3 variables)
-(defdata small-pos (enum '(1 2 3 4 5 6 7 8 9)))
-
-(acl2s-defaults :set testing-enabled T)
-(acl2s-defaults :set num-trials 2500)
-;No luck without arithmetic-5.
-;Lets add arith-5 lib and see now. Still no luck
-
-(test? 
-  (implies (and (integerp c1)
-                (integerp c2)
-                (integerp c3)
-                (posp x1)
-                (posp x2)
-                (posp x3)
-                (< x1 x2)
-                (< x2 x3)
-                (equal 0 (+ c1 c2 c3))
-                (equal 0 (+ (* c1 x1) (* c2 x2) (* c3 x3))))
-           (and (= 0 c1) (= 0 c2) (= 0 c3))))
-
-;;(total-runs/goals - cts/wts - totaltime/testing-time)
-;;(5004/4 - 4485/3 - 0.59/0.1) stats
-
-;TODO.bug - incremental is giving assert failure!
-; This is due to the way easy-simplify works and propagate
-; blindly throws away a simplification that is not smaller
-; in term-order than the original hyp.
-; 27th Aug '12, to get rid of the above error, one needs to
-; submit a compound recognizer rule as follows.
-; Additionally I also make sure that I dont break the invariant
-; that after propagating a X=const assignment, X will not appear
-; as a free variable in the resulting simplified hyp
-
-(defthm small-posp-is-a-posp
-  (implies (small-posp x)
-           (and (integerp x)
-                (< 0 x)))
-  :rule-classes :compound-recognizer)
-
-(test? 
-  (implies (and (integerp c1)
-                (integerp c2)
-                (integerp c3)
-                (small-posp x1)
-                (small-posp x2)
-                (small-posp x3)
-                (< x1 x2)
-                (< x2 x3)
-                (equal 0 (+ c1 c2 c3))
-                (equal 0 (+ (* c1 x1) (* c2 x2) (* c3 x3))))
-           (and (= 0 c1) (= 0 c2) (= 0 c3))))
-
-
-;; testcase 10 (Euler Counterexample)
-;fermat number: f(n) = 1 + 2^2^n
-(defun f (n)
-  (1+ (expt 2 (expt 2 n))))
-
-(f 5)
-
-;is k a factor of n other than 1 and n?
-(defun factor? (k n)
-  (and (< 1 k)
-       (< k n)
-       (natp (/ n k))))
-
-(test?
- (implies (posp k)
-          (not (factor? k (f 5)))))
-
-
-;Euler Insight: All factors of f(n) should have the form k*2^{n+1} + 1
-;for some k. Someone improved on this, where all k are even, so:
-(defun fermat-factor (k n)
-  (1+ (* k (expt 2 (+ 1 n)))))
-
-;TODO: get rid of duplicate cts/wts across subgoals
-(test?
- (implies (posp k)
-          (not (factor? (fermat-factor k 5) (f 5)))))
-
-;Lets generalize this, for any fermat number, but since these are
-;huge numbers we will restrict ourselves to n less than 15.
-(f 15) ;1000 digits long
-
-(test?
- (implies (and (posp k)
-               (posp n)
-               (< n 15))
-          (not (factor? k (f n)))))
-
-(acl2s-defaults :set num-trials 100000)
- ;Rerunning the following test 2-3 times will get you atleast two
-;counterexamples:
-;-- (K 14) and (N 12)
-;-- (K 10) and (N 5)
-
-
-;Note: incremental does a really bad job with this test?
-(acl2s-defaults :set search-strategy :simple)
-(test? 
- (implies (and (posp k)
-               (posp n)
-               (< n 15))
-          (not (factor? (fermat-factor k n) (f n)))))
-
-;09/28/12
-;wow i found for the above a brand new counterexample:
-;; We tested 71059 examples across 1 subgoals, of which 37635 (37635 unique)
-;; satisfied the hypotheses, and found 3 counterexamples and 37632 witnesses.
-;; The total time taken (incl. prover time) is 0.57 seconds
-;; The time taken by testing is 0.57 seconds
-
-;; We falsified the conjecture. Here are counterexamples:
-;;  [found in : "top"]
-;;  -- (K 238) and (N 11)
-;;  -- (K 14) and (N 12)
-;;  -- (K 10) and (N 5)
-
-
-;The third case
-(acl2s-defaults :set num-trials 1000)
-;; Fermats last theorem
-; No counterexamples and proof is probably out of ACL2's reach!
-; TODO: fix timeout issues. Here exponentiation probably causes problem
-
-
-
-(test?
- (implies (and (posp a) (posp b) (posp c)
-               (natp n) (> n 2))
-          (not (equal (+ (expt a n) (expt b n))
-                      (expt c n)))))
-
-;; testcase 11
-(defund hash (k)
-  (let* ((m (expt 2 23))
-         (a 309017/500000)
-         (s (* k a))
-         (x (- s (floor s 1))))
-    (mod (floor (* m x) 1)
-         (expt 2 32))))
-
-(defun g (x y z)
-  (if (and (equal x (hash y))
-           (equal y (hash z)))
-      'error
-    0))
-
-(acl2s-defaults :set testing-enabled T) ;if simple, then only T works
-
-(test? (implies (and (integerp x)
-                     (integerp y)
-                     (integerp z))
-                (/= (g x y z) 'error)))
-
-(acl2s-defaults :set testing-enabled :naive) ;for incremental, naive works too
-; Actually :simple works too with naive.
-(test? (implies (and (integerp x)
-                     (integerp y)
-                     (integerp z)
-                     (equal x (hash y))
-                     (equal y (hash z)))
-                NIL))
-
-
-
-
-
-
-
-
-
-
-
-;========================OLD/SCRATCHPAD=================================
-
-:trans1 (defdata R (record (f1 . nat) (f2 . pos)))
-
-(defdata nats (set nat))
-
-
-;TODO FIXME
-(defdata i-or-loi (oneof integer (listof integer)))
-
-(defun rev (x)
-  (if (endp x)
-    nil
-    (append (rev (cdr x)) (list (car x)))))
-;(trace$ defdata::print-bindings defdata::run-tests-on-subgoal-and-summarise)
-;TODO: generalization and cross-fert still dont work well with
-;output printing
-(set-acl2s-random-testing-enabled t)
-;TODO: ASK Matt, why is generalization not being captured.
-;Maybe bug in my code!!? CHECK
-(thm (implies (true-listp x)
-              (equal (rev (rev x)) x))) 
-
-(program)
-(defun app1 (x y)
-  (if (endp x)
-    y
-    (cons (car x) (app1 (cdr x) y))))
-
-(logic)
-
-(test? (implies (and (true-listp x) (true-listp y))
-                (true-listp (app1 x y))))
-
-(defun divisible-by (x i)
-  (integerp (/ x i)))
-  
-(defun divisor<=p (x i)
-  (if (or (zp i)
-          (= i 1))
-    nil
-    (if (divisible-by x i)
-      t
-      (divisor<=p x (- i 1)))))
-
-; COUNT-DIVISORS<=: nat nat -> nat
-; (Helper for PRIMEP)
-; Counts the number of positive integer divisors of the first argument
-; that are less than or equal to the second argument.
-(defun count-divisors (x i)
-  (if (zp i)
-    0
-    (if (divisible-by x i)
-      (+ 1 (count-divisors x (- i 1)))
-      (count-divisors x (- i 1)))))
-
-; PRIMEP: nat -> boolean
-; Recognizer for prime numbers, which must have exactly two distinct
-; divisors (1 and itself).
-(defun primep (x)
-  (and (natp x)
-       (= (count-divisors x x) 2)))
-
-(defun prime-between2 (l u)
-  (declare (ignorable l u))
-  (if (zp (- u l))
-    2
-    (if (primep l)
-      l
-      (prime-between2 (+ l 1) u))))
-
-(defun prime-bet (l u)
-  (prime-between2 l u))
-
-(defun c-lg2-hlp (x i)
-  (declare (xargs :measure (acl2-count (- x (expt 2 i)))))
-  (cond ((or (not (natp i))
-             (zp x)
-             (<= x (expt 2 i))) 0)
-        ((and (> x (expt 2 i))
-              (<= x (expt 2 (+ i 1))))
-         (+ i 1))
-        (T (c-lg2-hlp x (+ i 1)))))
-
-;; Base-2 logarithm of natural number,
-;; rounding up to the nearest natural (returns 0 if x is 0)
-(defund c-lg2 (x)
-  (c-lg2-hlp x 0))
-
-(defun lb-pn4 (n)
-  (*  n (1- (c-lg2  n))))
-
-
-(defun nth-prime (n)
-  (nth n 
-       (sieve (upper-bound n))))
-  
-(defun nth-prime5 (n)
-  (if (zp n)
-    2
-    (let* ((ub (1+ (expt 2 n)))
-           (lb (nth-prime-lower-bound n))) 
-      (prime-bet lb ub))))
-    
-
-
-(encapsulate
-  (((ubsize ) => *))
-
-  (local (defun ubsize () 32))
-
-  (defthm ubsize-thm
-    (natp (ubsize))
-    :rule-classes ((:rewrite) (:type-prescription)))
-  )
-
-(defun usbvp (x)
-  (and (natp x)
-       (<= 0 x)
-       (< x (expt 2 (ubsize)))))
-(set-acl2s-random-testing-enabled nil)
-(encapsulate
-  (((whatever) => *))
-
-  (local (defun whatever () 0))
-
-  (defthm whatever-thm
-    (usbvp (whatever))
-    )
-  )
-
-(acl2s-defaults :set num-trials 1000)
-;GOOD EXAMPLE 
-(test? ;remove-once-perm
-  (implies (and (consp X)
-                (sets::in a Y))
-           (equal (defdata::permutation (sets::delete a X)
-                        (sets::delete a Y))
-                  (defdata::permutation X Y))))
- 
-;#|
-;air turbulence logic puzzle (Jim Steinberg gave me the link)
-;http://www.mysterymaster.com/puzzles/AirTurbulence.html
-(defdata officials (enum '(:M :DA :JP :DC)))
-(defdata grooming (enum '(:Beard :Manicure :Shampoo :TeethC)))
-(defdata runway-num (enum '(2 3 4 6)))
-
-(defdata off-mapping (map officials runway-num))
-
-;BUG: finite record is giving rise to *off-mapping-values*?!!
-(defdata grooming-map (map grooming runway-num))
-                              
-(defdata off-groom (map officials grooming))
-                           
-(defun unique-4map (alst)
-  (no-duplicatesp (strip-cdrs alst)))
-
-(acl2s-defaults :set num-trials 100)
-
-(test? ;constraint
- (implies (and (off-mappingp O-R)
-               (grooming-mapp G-R)
-               
-               (off-groomp O-G)
-               (unique-4map O-R)
-               (equal (mget (mget :M  O-G) G-R) (mget :M O-R))
-               (equal (mget (mget :DA O-G) G-R) (mget :DA O-R))
-               (equal (mget (mget :JP O-G) G-R) (mget :JP O-R))
-               (equal (mget (mget :DC O-G) G-R) (mget :DC O-R))
-               (equal (mget :DA O-R) 3);1st constraint               
-               (equal (mget :Shampoo G-R) (1+ (mget :Manicure G-R)));second constraint
-               (> (mget :M O-R) (mget :DC O-R));third constraint
-               (equal (mget :JP O-R) (* 2 (mget :TeethC G-R)));fourth constraint
-               (equal (mget :DA O-G) :Beard));5th constraint
-          nil))
-
-;10 July 2011 (I dont know what I did, but we shud get some
-;counterexample here)
-;Okay got it(u have to be lucky for naive testing):
-#|
-We falsified the conjecture. Here is the counterexample:
- -- (G-R ((:BEARD . 2) (:MANICURE . 2) (:SHAMPOO . 3) (:TEETHC . 2))),
-(O-R ((:DA . 3) (:DC . 2) (:JP . 4) (:M . 6))) and 
-(O-G ((:DA . :BEARD) (:DC . :BEARD) (:JP . :MANICURE) (:M . :SHAMPOO)))
-|# 
-(test? ;constraint
- (implies (and (off-mappingp O-R)
-               (grooming-mapp G-R)
-               (off-groomp O-G)
-               (unique-4map O-R)
-               (equal (mget (mget :M  O-G) G-R) (mget :M O-R))
-               (equal (mget (mget :DA O-G) G-R) (mget :DA O-R))
-               (equal (mget (mget :JP O-G) G-R) (mget :JP O-R))
-               (equal (mget (mget :DC O-G) G-R) (mget :DC O-R))
-               (equal (mget :Shampoo G-R) (1+ (mget :Manicure G-R)))
-               (> (mget :M O-R) (mget :DC O-R))
-               (equal (mget :JP O-R) (* 2 (mget :TeethC G-R)))
-               (equal (mget :DA O-R) 3);1st constraint
-               (equal (mget :DA O-G) :Beard))
-          nil))
-;|#
-
-(defun hash (k)
-  (let* ((m (expt 2 23))
-         (a 309017/500000)
-         (s (* k a))
-         (x (- s (floor s 1))))
-    (mod (floor (* m x) 1)
-         (expt 2 32))))
-
-(in-theory (disable hash))
-
-
-(defun f (x y)
-  (if (equal x (hash y))
-    'error
-    0))
-(acl2s-defaults :set instantiation-method :incremental)
-(test? (/= (f x y) 'error))
-
-(test? ;(implies (and (integerp x) (integerp y))
-                (NOT (EQUAL X (HASH Y))))
-
-(set-acl2s-random-testing-enabled nil)
-(thm (implies (and (integerp x) (integerp y))
-                (/= (f x y) 'error)))
-
-(set-acl2s-random-testing-enabled t)
-
-(defun hash1 (x)
-  (mod (+ (* x (1- (expt 2 27)))
-          (1- (expt 2 19)))
-       (expt 2 32)))
-
-;simple 8.2sec
-;incr: 12.42 sec
-;10 July 2011: same times for both 9.7sec
-(acl2s-defaults :set instantiation-method :incremental)
-(time$
-(test?
- (implies (and (integerp x)
-               (integerp y)
-               (integerp z)
-               (integerp w)
-               (equal x (hash1 y))
-               (equal y (hash1 z))
-               (equal w (max x y)))
-          (< w z))))
-
-;tests multiple dest-elim
-(test? (implies (AND (CONSP X)
-                (NOT (EQUAL (LEN X) 2))
-                (EQUAL (CADR X) '+))
-              (not (equal x x))))
-
-
-;TODO CHECK THIS OUT
-   (defdata::RUN-TESTS-AND-PRINT-SUMMARY
-    'RANDOMTESTING
-    '(IMPLIES (AND (CONSP X)
-                  (NOT (EQUAL (LEN X) 2))
-                  (EQUAL (CADR X) '+))
-             (NOT (EQUAL X X)))
-    '((X CONS))
-    2 :simple 'TEST? state)
-
-#|
-(local (include-book "arithmetic-5/top" :dir :system))
-(thm (implies (and (rationalp a)
-                  (rationalp b)
-                  (rationalp c)
-                  (< 0 a)
-                  (< 0 b)
-                  (< 0 c)
-                  (<= (expt a 2) (* b (+ c 1)))
-                  (<= b (* 4 c)))
-             (< (expt (- a 1) 2) (* b c))));(set-acl2s-random-testing-use-instantiation-method 'concrete)
-
-(local (set-default-hints
-        '((nonlinearp-default-hint stable-under-simplificationp
-                                   hist pspv))))
- 
- (defthm russinoff2
-  (implies (and (rationalp a)
-                (rationalp b)
-                (rationalp c)
-                (<= 1 a)
-                ;(< 0 b)
-                ;(< 0 c)
-                (<= (expt a 2) (* b (+ c 1)))
-                (<= b (* 4 c)))
-           (< (expt (- a 1) 2) (* b c)))
-  :hints (("goal" :cases ((<= 0 b)))))
-|#
-;(defdata poss (enum 1 2 3 4 5 6 7 8 9))
-(acl2s-defaults :set instantiation-method :simple)
-(time$
-(test? 
-  (implies (and (integerp c1)
-                (integerp c2)
-                (integerp c3)
-                (posp x1)
-                (posp x2)
-                (posp x3)
-                (< x1 x2)
-                (< x2 x3)
-                (< x3 10)
-                (equal 0 (+ c1 c2 c3))
-                (equal 0 (+ (* c1 x1) (* c2 x2) (* c3 x3))))
-           (and (= 0 c1) (= 0 c2) (= 0 c3)))))
-;simple: 2.82 sec
-;incr: 8.21 sec
-;10 July 2011: 100 trials incremental finds 3 wts and 3 cts: 56.78 sec
-;10 July 2011: 100 trials simple finds 0 wts and 0 cts: 2.47 sec
-
-(acl2s-defaults :set verbosity-level 1)
-(acl2s-defaults :set num-trials 100)
-(acl2s-defaults :set instantiation-method :simple)
-(test?
- ;(let ((z 21) (y 22) (x 2))
- (implies (and (posp x)
-               (posp y)
-               (posp z)
-               (> z 16)
-               (<= x y)
-               (>= (+ x y) z))
-          (>= (* x (* y z)) (* x (* x y)))))
-
-(acl2s-defaults :set instantiation-method :simple)
-;10July-11 incremental takes time but finds ctx consistently 
-(test?
- (implies (and (posp x)
-               (posp y)
-               (posp z)
-               ;(> z 16)
-               (<= (+ x y) (* 2 z)))
-          (> (* z z) (* x y))))
-
-(acl2s-defaults :set instantiation-method :simple)
-(test?
- (implies (and (posp x)
-               (posp y)
-               (posp z)
-               (> z 16)
-               (<= x z))
-          (> (* z z) (* x x))))
-
-(test?
- (implies (and (posp x)
-               (posp y)
-               (posp z)
-               (> z 16)
-               (<= (+ x y) (* 2 z)))
-          (or (> (* x y z) (* x y x))
-              (> (* x y z) (* x y y)))))
-
-#|
-;(trace$ defdata::find-recursive-records)
-;TERMINATION ISSUES with records
-(defdata form (oneof pos
-                     (fnot (f . form))
-                     (fand (lhs . form) (rhs . form))
-                     (for (lhs . form) (rhs . form))
-                     (fimplies (lhs . form) (rhs . form))))
-
-(defdata formula (oneof pos
-                        (list 'not formula)
-                        (list 'and formula formula)
-                        (list 'or formula formula)
-                        (list 'implies formula formula)))
-;(untrace$)
-(defunc simplify (f)
-  :input-contract (formulap f)
-  :output-contract (formulap (simplify f))
-  (cond ((posp f) f)
-        ((eq (first f) 'not) (list 'not (simplify (second f))))
-        ((eq (first f) 'and) (list 'and (simplify (second f)) (simplify (third f))))
-        ((eq (first f) 'or) (list 'or (simplify (second f)) (simplify (third f))))
-        ((eq (first f) 'implies) (list 'or (list 'not (simplify (second f))) (simplify (third f))))
-        (t f)))
-
-(set-acl2s-random-testing-use-instantiation-method 'simple)
-(set-acl2s-random-testing-max-num-of-random-trials 10)
-(defunc simplifiedp (f)
-  :input-contract (formulap f)
-  :output-contract (booleanp (simplifiedp f))
-   (cond ((posp f) t)
-        ((eq (first f) 'not) (simplifiedp (second f)))
-        ((eq (first f) 'and) (and (simplifiedp (second f)) (simplifiedp (third f))))
-        ((eq (first f) 'or) (and (simplifiedp (second f)) (simplifiedp (third f))))
-        ((eq (first f) 'implies) nil)
-        (t nil)))
-  
-(defthm simplify-is-stable
-  (implies (formulap f)
-           (equal (simplify (simplify f))
-                  (simplify f))))
-
-(defunc nnf (f)
-  :input-contract (formulap f)
-  :output-contract (formulap (nnf f))
-   (cond ((posp f) f)
-        ((and (eq (first f) 'not) (posp (second f))) f)
-        ((and (eq (first f) 'not) (eq 'not (first (second f))))
-         (nnf (second (second f))))
-        ((eq (first f) 'and) (list 'and (nnf (second f)) (nnf (third f))))
-        ((eq (first f) 'or) (list 'or (nnf (second f)) (nnf (third f))))
-        ((eq (first f) 'implies) (list 'implies (nnf (second f)) (nnf (third f))))
-        ((and (eq (first f) 'not)
-              (eq 'and (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'or (nnf (list 'not lhs)) (nnf (list 'not rhs)))))
-        ((and (eq (first f) 'not)
-              (eq 'or (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'and (nnf (list 'not lhs)) (nnf (list 'not rhs)))))     
-         ((and (eq (first f) 'not)
-              (eq 'implies (first (second f))))
-         (let* ((a (second f))
-                (lhs (second a))
-                (rhs (third a)))
-           (list 'and (nnf lhs) (nnf (list 'not rhs)))))
-        (t f)))
-;(trace$ run-trials)
-
-(SET-ACL2S-RANDOM-TESTING-SEED-GENERATION-TYPE 'nat-tree)
-(er-let* ((tr (build-rand-tree-top 'formula state)))
-  (value (nth-formula tr)))
-;TODO BUG
-(SET-ACL2S-RANDOM-TESTING-SEED-GENERATION-TYPE 'nat)
-
-(top-level-test? ;simp-nnf-commute
-  (implies (formulap f)
-  (equal (nnf (simplify f))
-         (simplify (nnf f)))))
-
-|#
-(defdata file (cons nat string))
-(defdata dir (listof (cons string (oneof file dir))))
-;FIX TODO
-(defdata (dir1 (map string dir-entry1))
-         (dir-entry1 (oneof file dir1)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;fermat number
-(defun fermat (n)
-  (1+ (expt 2 (expt 2 (nfix n)))))
-
-;Euler: All factors of f(n) should have the form k*2^{n+1} + 1
-;Lucas: for all n > 1, factors of f(n) are of form k*2^{n+2} + 1
-(defun f-factor (k n)
-  (let ((k (nfix k))
-        (n (nfix n)))
-    (1+ (* k (expt 2 (+ 1 n))))))
-
-;is k a factor of n other than 1 and n?
-(defun factor (k n)
-  (and (< 1 k)
-       (< k n)
-       (natp (/ n k))))
-
-(test?
- (implies (posp k)
-          (not (factor k (fermat 5)))))
-
-(test?
- (implies (posp k)
-          (not (factor (f-factor k 5) (fermat 5)))))
-
-(acl2s-defaults :set num-witnesses 0)
-(acl2s-defaults :set num-trials 10000)
-
-(time$
-(top-level-test?
- (implies (and (posp k)
-               (posp n)
-               (< n 15))
-          (not (factor k (fermat n)))))
-)
-(acl2s-defaults :set instantiation-method :simple)
-(acl2s-defaults :set num-trials 10000)
-;1000
-;incr: 44.88
-;simple: 0.11
-;10,000
-;simple: 1.07
-;incr: no patience to check
-(acl2s-defaults :set verbosity-level 1)
-(time$
- (top-level-test?
- (implies (and (posp k)
-               (posp n)
-               (< n 15))
-          (not (factor (f-factor k n) (fermat n)))))
- )
-
-
-(test? (implies (true-listp x) (not (equal x (list y v w z)))))
-
-;; take : Nat * List-of-Int -> List-of-Int
-(defun take-n (n lst)
-  (if (endp lst)
-    nil
-    (if (zp n)
-      nil
-      (cons (car lst) (take-n (1- n) (cdr lst))))))
-
-;; drop : Nat * List-of-Int -> List-of-Int
-(defun drop-n (n lst)
-  (if (endp lst)
-    nil
-    (if (zp n)
-      lst
-      (drop-n (1- n) (cdr lst)))))
-
-;; Prove commutativity of take and drop
-(acl2s-defaults :set num-trials 100)
-
-(defthm take-drop-commute
-  (implies (and (integerp i)
-                (integerp j)
-                (integer-listp lst))
-           (equal
-            (take-n j (drop-n i lst))
-            (drop-n i (take-n (+ i j) lst)))))
- 
-(top-level-test? 
- (implies (and (posp (car x))
-               (posp (cdr x)))
-          (<= (cdr x) (len x)))
- )
-;this checks that top goal counterexamples are printed
-;no longer works, as counterexample is found before ACL2 dest elims
-(acl2s-defaults :set num-witnesses 5)
-
-(test? (implies (and (posp (car x))
-                     (posp (cdr x)))
-                (<= (cdr x) (len x)))
-       )
-(defdata loi (listof integer))
-(test?
- (implies (and (posp i)
-               (posp j)
-               (loip lst))
-          (equal
-           (take-n j (drop-n i lst))
-           (drop-n i (take-n j lst)))))
-
-(defun large-list (x)
-  (and  (or (character-listp x) (loip x))
-        (> (len x) 3)))
-
-(test?  (implies (large-list x) (> (len x) 6)))
-
-;old
-(thm (implies (large-list x) (> (len x) 6)));this gives an example where acl2check infers stronger than acl2 type-alist? YES!!
-;but note that acl2 does have that knowledge in the type context.
-
-(test? (implies (and (or (true-listp x)
-                             (stringp x))
-                         (not (equal x nil))
-                         (not (equal x "")))
-                    (> (len x) 0)))
-
-(test? (iff (implies p q) (or (not p) p)))
-
-;this checks that top goal counterexamples are printed
-;;this checks and also checks eliminated variables
-(test? (implies (and (posp (car x))
-                     (equal y y)
-                     (equal z y)
-                     (posp (cdr x)))
-                (<= (cdr x) (len x))))
-(acl2s-defaults :set verbosity-level 1)
-;;checking commutative property for take and drop
-(test? ;take-drop-commute
- (implies (and (posp i) (posp j) (loip lst)) 
-  (equal
-   (take-n j (drop-n i lst))
-   (drop-n i (take-n j lst)))))
-
-;;Ahh counter-example ...lets modify the property
-(test? ;take-drop-commute-modified
- (implies (and (natp i) (natp j) (loip lst )) 
-  (equal
-   (take-n j (drop-n i lst))
-   (drop-n i (take-n (+ i j) lst)))))
-
-;counterexample:
- ;-- (Y 40/7) and (X 12)
-;hard
-(acl2s-defaults :set verbosity-level 1)
-(thm (IMPLIES (AND (RATIONALP X)
-                    (RATIONALP Y)
-                    (NOT (EQUAL Y 0))
-                    (<= 0 Y)
-                    (<= 0 X)
-                    (<= Y X)
-                    (INTEGERP (+ 1 (- X)))
-                    (< 1 X)
-                    (NOT (INTEGERP (+ 1 (- X) (* 2 Y))))
-                    (<= X (+ 1 (* 2 Y))))
-               (< X
-                  (+ 1 (DENOMINATOR (+ 1 (- X) (* 2 Y)))
-                     (NUMERATOR (+ 1 (- X) (* 2 Y)))))))
-
-(thm (IMPLIES (AND (RATIONALP X)
-              (RATIONALP Y)
-              (NOT (EQUAL Y 0))
-              (<= 0 Y)
-              (<= 0 X)
-              (<= Y X))
-         (O< (ACL2-COUNT (+ 1 0 (- (+ (+ X (- Y)) Y))))
-             (ACL2-COUNT (+ 1 Y (- (+ X (- Y))))))))
-(acl2s-defaults :set num-witnesses 2)
-(acl2s-defaults :set num-counterexamples 2)
-(thm 
- (implies (and (natp i)
-               (natp x)
-               ;(> x 0);testting found
-               (<= i x))
-          (equal (nth i (cons a (defdata::make-list-logic a x)))
-                 (nth (- i 1) (defdata::make-list-logic a x)))))
-
-(test? 
-  (implies (and (integerp c1)
-                (integerp c2)
-                (posp x1)
-                (posp x2)
-                (< x1 x2)
-                (equal 0 (+ c1 c2))
-                (equal 0 (+ (* c1 x1) (* c2 x2))))
-           (and (= 0 c1) (= 0 c2))))
-
-;excellent, this never worked before
-;first example demontrating the superiority of
-; :incremental (DPLL) over :simple (naive random testing)
-(acl2s-defaults :set instantiation-method :incremental)
-(acl2s-defaults :set backtrack-limit 4)
-(time$
- ;simple: 2.13 seconds no counterexample no witness
-;incr: 41.52 seconds blimit:4 cts:2 and wts:2
-;incr: 48.56 seconds blimit:0 cts:0 and wts:0
-;incr: 63.08 seconds blimit:3 cts:2 and wts:2
-;incr: 78.08 seconds blimit:3 cts:2 and wts:2
-;incr: 143.13 seconds blimit:2 cts:2 and wts:2
-;incr: 105.95 seconds blimit:2 cts:2 and wts:2
-;incr: 175.94 seconds blimit:1 cts:1 and wts:2 + 1
-(test? 
-  (implies (and (integerp c1)
-                (integerp c2)
-                (integerp c3)
-                (posp x1)
-                (posp x2)
-                (posp x3)
-                (< x1 x2)
-                (< x2 x3)
-                (equal 0 (+ c1 c2 c3))
-                (equal 0 (+ (* c1 x1) (* c2 x2) (* c3 x3))))
-           (and (= 0 c1) (= 0 c2) (= 0 c3))))
-)
-;IDEA: Need to create a rule manager (sorter) which will
-;manage the rule database looking for rules that will
-;give me almost linear variable dependency graph with
-;the edges mostly a relation like equality which will
-;propagate the decisions made at the source
-
-;MORE:
-;Can we store some output/input information on each
-;function/predicate, that might help glean more information
-;for dependency analysius````?
-
-#|
-We falsified the conjecture. Here are counterexamples:
- -- (X3 8), (X2 7), (X1 6), (C3 -2), (C2 4) and (C1 -2)
- -- (X3 6), (X2 4), (X1 3), (C3 1), (C2 -3) and (C1 2)
- -- (X3 10), (X2 8), (X1 2), (C3 -3), (C2 4) and (C1 -1)
-|#
-
-;(defdata memory (listof (cons nat integer)))
-(defdata memory (map nat integer))
-
-(nth-memory 9436794189)
-
-(defun update (address value memory)
-  (cond ((endp memory)
-         (acons address value nil))
-        ((equal address (caar memory))
-         (acons address value (cdr memory)))
-        ((< address (caar memory))
-         (acons address value memory))
-        (t (cons (car memory) 
-                 (update address value (cdr memory))))))
-
-
-;Conjecture - version#1
-(test?
- (equal (update a1 v1 (update a2 v2 m))
-        (update a2 v2 (update a1 v1 m))))
-(acl2s-defaults :set backtrack-limit 3)
-(acl2s-defaults :set instantiation-method :simple)
-; Conjecture - version 2
-(time$
- ;10july incr:16.5 sec
- ;10july simple:0.06 sec
-(test?
- (implies (and (memoryp m)
-               (natp a1)
-               (natp a2))
-          (equal (update a1 v1 (update a2 v2 m))
-                 (update a2 v2 (update a1 v1 m))))))
-
-(defdata::build-enumcall-top 'memory state)
-
-(defun in-memory (a m)
-  (if (endp m)
-    nil
-    (or (equal a (caar m))
-        (in-memory a (cdr m)))))
-
-(acl2s-defaults :set instantiation-method :incremental)
-(acl2s-defaults :set backtrack-limit 2)
-;Conjecture - version#3
-(time$
- ;10jul: incremental -> 21.58/12.44 (3) 8.21/11.73 (2)
-(test?
- (implies (and (memoryp m)
-               (natp a1)
-               (natp a2)
-               (or (in-memory a1 m)
-                   (in-memory a2 m)))
-          (equal (update a1 v1 (update a2 v2 m))
-                 (update a2 v2 (update a1 v1 m))))))
-
-
-(acl2s-defaults :set instantiation-method :simple)
-;(acl2s-defaults :set backtrack-limit 4)
-;Conjecture - version#4
-;28.19 seconds with random testing incremental (blimit 3)
-;26.69 seconds with random testing incremental (blimit 2)
-;22.15 seconds with random testing incremental (blimit 1)
-;8.62 seconds with random testing incremental (blimit 0)
-;1.84 seconds with random testing simple
-;1.75 seconds with random testing disabled
-;50.5 seconds on July 10 2011 (incremental blimit 2)
-(thm
- (implies (and (memoryp m)
-               (natp a1)
-               (natp a2)
-               (or (in-memory a1 m)
-                   (in-memory a2 m))
-               (not (equal a1 a2)))
-          (equal (update a1 v1 (update a2 v2 m))
-                 (update a2 v2 (update a1 v1 m)))))
-;23.36 seconds with random testing incremental (blimit 4 and 5)
-
-;AA Trees
-(defdata aa-tree (oneof 'Bottom 
-                        (node (key . pos)
-                              (level . nat)
-                              (left . aa-tree)
-                              (right . aa-tree))))
-
-;FIX TODO Both left and right trees are always of same size
-(defdata::build-enumcall-top 'aa-tree state)
-
-
-;Performance of Nat-tree vs Nat
-(defun run4-for-i (i type state)
-  (declare (xargs :mode :program :stobjs (state)))
-  (if (zp i)
-    (value nil)
-    (er-progn
-     (if (not (acl2s-defaults :get flatten-defdata))
-       (er-let* ((enum-info (defdata::get-enum-info type 'test (w state) state)))
-         (defdata::build-enumcall-from-enum-info type enum-info 'test state))
-       (defdata::build-enumcall-top type state))
-     (run4-for-i (1- i) type state))))
-
-(acl2s-defaults :set flatten-defdata t) 
-;stupid performance bug due to acl2::current-acl2-world package name
-(time$ (run4-for-i 100000 'aa-tree state))
-;something is slower (is it CCL/SBCL?) Jul 10 -> 1.41 vs 7.85
-;0.49 vs 4.89
-
-(defun skew (tree)
-  (if (eq 'Bottom tree)
-    tree
-    (if (= (mget :level (mget :left tree)) (mget :level tree))
-      ;;rotate right
-      (let ((ltree (mget :left tree))
-            (rtree (mget :right tree)))
-        (node (mget :key ltree)
-              (mget :level ltree)
-              (mget :left ltree)
-              (node (mget :key tree)
-                    (mget :level tree)
-                    (mget :right ltree)
-                    rtree)))
-      tree)))
-
-(defun split (tree)
-  (if (eq 'Bottom tree)
-    tree
-    (if (<= (mget :level tree)
-            (mget :level (mget :right (mget :right tree))))
-      ;;rotate left
-      (let* ((rtree (mget :right tree))
-             (rrtree (mget :right rtree)))
-        (node (mget :key rtree)
-              (1+ (mget :level rtree))
-              (node (mget :key tree)
-                    (mget :level tree)
-                    (mget :left tree)
-                    (mget :left rtree))
-              rrtree))
-      tree)))
-
-(set-acl2s-random-testing-enabled nil)
-(defun insert (data tree)
-  (if (or (eq 'Bottom tree) (not (aa-treep tree)))
-    (node data 1 'Bottom 'Bottom)
-    (if (equal data (mget :key tree))
-      tree
-      (let ((newtree (if (< data (mget :key tree))
-                       (mset :left 
-                             (insert data (mget :left tree))
-                             tree)
-                       (mset :right
-                             (insert data (mget :right tree))
-                             tree))))
-        (split
-         ;(skew
-          newtree)))))
-
-(defun wf-aa-treep (tree)
-  (if (not (aa-treep tree))
-    nil
-    (if (eq 'Bottom tree)
-      t
-      (let ((n (mget :level tree))
-            (l (mget :left tree))
-            (r (mget :right tree)))
-        (if (eq 'Bottom l)
-          (and (= 1 n)
-               (or (eq 'Bottom r)
-                   (and (= 1 (mget :level r))
-                        (eq 'Bottom (mget :left r))
-                        (eq 'Bottom (mget :right r)))))
-          (and (wf-aa-treep l)
-               (wf-aa-treep r)
-               (not (eq 'Bottom r))
-             (< (mget :level l) n)
-             (<= (mget :level r) n)
-             (< (mget :level (mget :right r)) n)))))))
-
-(defthm skew-wf
-  (implies (and (aa-treep v)
-                (wf-aa-treep v))
-           (equal (skew v) v)))
-
-(defthm split-wf
-  (implies (and (aa-treep v)
-                (wf-aa-treep v))
-           (equal (split v) v)))
-(set-acl2s-random-testing-enabled t)
-
-(acl2s-defaults :set flatten-defdata nil)
-(acl2s-defaults :set backtrack-limit 3)
-(acl2s-defaults :set verbosity-level 1)
-(acl2s-defaults :set instantiation-method :simple)
-(test? (implies (and (aa-treep tr);type hyp
-                     (posp n);type hyp
-                     (wf-aa-treep tr));constraint
-                (wf-aa-treep (insert n tr))))
-
-;#|
-;Experimenting:
-(set-acl2s-random-testing-enabled nil)
-(defun insert3 (data tree)
-  (if (or (eq 'Bottom tree) (not (aa-treep tree)))
-    (node data 1 'Bottom 'Bottom)
-    (if (equal data (mget :key tree))
-      tree
-      (let ((newtree (if (< data (mget :key tree))
-                       (mset :left 
-                             (insert3 data (mget :left tree))
-                             tree)
-                       (mset :right
-                             (insert3 data (mget :right tree))
-                             tree))))
-        ;(split
-         (skew
-          newtree)))))
-
-(acl2s-defaults :set flatten-defdata nil)
-
-(test? (implies (and (aa-treep tr);type hyp
-                   (posp n);type hyp
-                   (wf-aa-treep tr));constraint
-              (wf-aa-treep (insert3 n tr))))
-
-(top-level-test? (implies (and (aa-treep tr))
-                (wf-aa-treep tr)))
-
-(top-level-test? (implies (and (aa-treep tr))
-                (wf-aa-treep tr)))
-                   
-                
-(test? 
- (implies (aa-treep tr)
-          (equal (split (split tr))
-                 (split tr))))
- 
-
-
-(test?
- (IMPLIES (AND (AA-TREEP TR)
-               (= N '(z x y z w r t y b d fg dfg dfg))
-               (WF-AA-TREEP TR)
-               ;(>>= N (MGET :KEY TR))
-               (NOT (EQUAL (MGET :LEVEL (MGET :LEFT TR))
-                           (MGET :LEVEL TR))))
-          (not (WF-AA-TREEP (MSET :RIGHT (INSERT3 N (MGET :RIGHT TR))
-                             TR)))))
-
-
-;---------interesting code for students
-;(defdata adjacency-list (map symbol symbol-list))
-(defun adjacency-list1p (v)
-  (if (null v)
-      t
-    (if (atom v)
-        nil
-      (let ((entry (car v)))
-      (and (symbolp (car entry))
-           (symbol-listp (cdr entry))
-           (no-duplicatesp (cdr entry))
-           (adjacency-list1p (cdr v)))))))
-
-(defun adjacency-listp (v)
-  (and (adjacency-list1p v)
-       (no-duplicatesp (strip-cars v))))
-
-(defun make-empty-adj-list (vars)
-  (declare (xargs :guard (and (symbol-listp vars)
-                              (no-duplicatesp vars))))
-  ;order important 
-  ;order of keys alst created is the same as order of vars
-  (if (endp vars)
-    nil
-    (cons (cons (car vars) nil)
-          (make-empty-adj-list (cdr vars)))))
-
-
-
-;fs means Functionaly dependent vars
-;ASSUMPTION: alst has all the variables as keys already
-;this function just updates the entries, doesnt insert
-;new entries.
-(defun union-entry-in-adj-list (var fvars alst)
-  (if (endp alst)
-      nil
-    (if (eq var (caar alst))
-      (cons (cons var (union-equal fvars 
-                                   (cdar alst)))
-            (cdr alst))
-      (cons (car alst)
-            (union-entry-in-adj-list var fvars (cdr alst))))))
-  
-  
-;recurse above fun over list of indices
-(defun union-entries-in-adj-list (is fis alst)
- (if (endp is)
-    alst
-    (union-entries-in-adj-list 
-     (cdr is) fis (union-entry-in-adj-list (car is) fis alst))))
-
-  
-(defun transpose-alst1 (alst ans)
-;Scan G at index i and transpose the result corresponding to i in ans
-  (if (endp alst)
-      ans
-    (b* (((cons v vs) (car alst)))
-      (transpose-alst1 (cdr alst)
-                       (union-entries-in-adj-list vs (list v) ans)))))
-  
-
-(defun transpose-alst (alst)
-;Return transpose/reverse of alst
-;INVARIANT: Order is very important
-  (transpose-alst1 alst (make-empty-adj-list (strip-cars alst))))
-
-(defun non-empty-symbol-list1p (x)
-  (declare (xargs :guard t))
-  (and (consp x)
-       (symbol-listp x)))
-
-(defun nth-non-empty-symbol-list1 (n)
-  (nth-symbol-list (1+ n)))
-(register-custom-type 
-         non-empty-symbol-list1 t
-         nth-non-empty-symbol-list1
-         non-empty-symbol-list1p)
-(defun non-boolean-symbolp (x)
-  (declare (xargs :guard t))
-  (and (not (booleanp x))
-       (symbolp x)))
-(defun nth-non-boolean-symbol (n)
-  (if (eq nil (nth-symbol n))
-    'a
-    (nth-symbol n)))
-(register-custom-type 
-         non-boolean-symbol t
-         nth-non-boolean-symbol
-         non-boolean-symbolp)
-(defdata adjacency-list2 (map non-boolean-symbol non-empty-symbol-list1))
-
-(defthm transpose-idempotent
-  (implies (and (adjacency-list2p x)
-                (adjacency-listp x))
-           (equal (transpose-alst (transpose-alst x))
-                  x)))
-
-(defthm transpose-doesnt-change-order
-  (implies (and (adjacency-list2p x)
-                (adjacency-list1p x))
-           (equal (strip-cars (transpose-alst x))
-                  (strip-cars x))))
-
-;;; boyer alternating.events
-;;; Use these to automatically generate generators from predcates or do
-;;; mode-analysis etc --harshrc
-
-; Now on to my formalization.  We first define the six functions
-; needed in the statement of the theorem.  The main, all encompassing,
-; theorem is stated at the very end, and is named ``all''.
-
-; Intuitively, we imagine that cards are arbitrary objects, but
-; numbers are ``red'' and nonnumbers are ``black.''
-
-(defn opposite-color (x y)
-
-; This is the definition of ``opposite-color,'' which checks that its
-; two arguments, x and y, are of opposite color, in the intuitive
-; sense mentioned above.
-
-  (or (and (numberp x) (not (numberp y)))
-      (and (numberp y) (not (numberp x)))))
-
-(defn alternating-colors (x)  
-
-; This is the definition of ``alternating-colors,'' which checks that
-; its argument, x, is a list of objects whose colors alternate.  In the
-; base case, if the list is empty or the list has length one, then we
-; say it is indeed alternating.  In the inductive or recursive case,
-; we require that the first two elements be of opposite color and that
-; the ``rest,'' i.e., cdr, i.e., all but the first, of the list be
-; alternating.
-
-  (if (or (nlistp x)
-          (nlistp (cdr x)))
-      t
-    (and (opposite-color (car x) (cadr x))
-         (alternating-colors (cdr x)))))
-
-(defn paired-colors (x) 
-
-; This is the definition of ``paired-colors,'' which checks that its
-; argument, x, is a list such that if its elements are pealed off from
-; the front in pairs, the pairs are found to be of opposite color.  In
-; the base case, we say a list of length 0 or 1 is paired.  In the
-; inductive or recursive case, where the list has at least length 2,
-; we insist that the first and second elements be of opposite color,
-; and that the ``cddr,'' i.e., the rest of the list past the first two
-; elements, is paired.
-
-  (if (or (nlistp x)
-          (nlistp (cdr x)))
-      t
-    (and (opposite-color (car x) (cadr x))
-         (paired-colors (cddr x)))))
-
-
-
-(defn shufflep (x y z)
-
-; This is the definition of ``shufflep,'' which checks that its third
-; argument, z, is a ``merge'' or ``shuffling'' of its first two
-; arguments, x and y.  Shufflep also requires that x, y, and z all be
-; ``plistp''.
-
-; In the base case, where z is empty, we insist that x, y, and z all
-; be NIL.
-
-; In the ``almost'' base cases in which z is not empty, but either x
-; or y is empty, we insist that if x is empty, then x is NIL, y is
-; equal to z, and y is ``plistp'', whereas if x is not empty but y is,
-; we insist that y is NIL, x is equal to z, and x is ``plistp''.
-
-; In the fully inductive case, where none of x, y, or z, is empty, we
-; insist that either (a) the first element of x is the first element
-; of z and (cdr z) is a shuffle of (cdr x) and y, or (b) the first
-; element of y is the first element of z and (cdr z) is a shuffle of x
-; and (cdr y).
-
-  (if (nlistp z)
-      (and (equal x nil)
-           (equal y nil)
-           (equal z nil))
-    (if (nlistp x)
-        (and (equal x nil)
-             (equal y z)
-             (plistp y))
-      (if (nlistp y)
-          (and (equal y nil)
-               (equal x z)
-               (plistp x))
-        (or (and (equal (car x) (car z))
-                 (shufflep (cdr x) y (cdr z)))
-            (and (equal (car y) (car z))
-                 (shufflep x (cdr y) (cdr z))))))))
-
-(defn even-length (l)
-
-; This is the definition of ``even-length,'' which checks that the
-; length of its argument, l, is even.  In the base cases, if l is
-; empty we return true and if l has one element we return false.  In
-; the inductive or recursive case, we insist that (cddr l), i.e., the
-; rest of l after its second element, has even length.
-
-  (if (nlistp l)
-      t
-    (if (nlistp (cdr l))
-         f
-      (even-length (cddr l)))))
-
diff -Nru acl2-6.2/books/countereg-gen/top.lisp acl2-6.3/books/countereg-gen/top.lisp
--- acl2-6.2/books/countereg-gen/top.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/top.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,67 +0,0 @@
-#|$ACL2s-Preamble$;
-;;Author - Harsh Raju Chamarthi (harshrc)
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(begin-book t :ttags :all);$ACL2s-Preamble$|#
-
-;; Note: I apologize for the use of ttags, but they are used for engineering
-;; purposes: for implementing timeouts. The above should in principle not
-;; affect ACL2's soundness. Usually you would include this book while
-;; developing/designing proofs and when you have all QEDs, simply remove this
-;; book.
-
-
-(in-package "ACL2")
-
-(include-book "acl2s-parameter")
-(include-book "base")
-(include-book "main" :ttags :all)
-
-
-
-(make-event 
- (er-progn
-  (assign defdata::cgen-stats-event-stack nil)
-  (value '(value-triple :invisible)))
- :check-expansion t)
-
-; For now lets keep the nats not more than 1000 to avoid stack-overflow
-; on non-tail-recursive functions. If you dont like these, comment
-; them out, or write your own custom test enumerators and attach them
-(defdata-testing pos :test-enumerator nth-pos-testing)
-(defdata-testing integer :test-enumerator nth-integer-testing)
-(defdata-testing nat :test-enumerator nth-nat-testing)
-(defdata-testing neg :test-enumerator nth-neg-testing)
-
-
-; The following shows the various configuration parameters that you
-; can customize.
-; The usual format is (acl2s-defaults :get <param>) for getting the
-; current value of the parameter named <param>. The setter is similar
-; you can see examples below, where most useful parameters are set
-; with their default values. Copy and change what you want, these are
-; embedded events, so you can put them in books. To know more about
-; these parameters, simply do :doc <param> at the ACL2 prompt.
-
-;; (acl2s-defaults :set testing-enabled :naive) ;other values are T,NIL
-;; (acl2s-defaults :set verbosity-level 1) 
-;; (acl2s-defaults :set num-trials 1000)
-;; (acl2s-defaults :set num-counterexamples 3)
-;; (acl2s-defaults :set num-witnesses 3)
-;; (acl2s-defaults :set search-strategy :simple) ;other value is :incremental
-;; (acl2s-defaults :set sampling-method :random) 
-;; (acl2s-defaults :set subgoal-timeout 10) ;0 turns off timeout
-
-
-;; USAGE:
-;; Add (include-book "countereg-gen/top" :dir :system :ttags :all)
-;; Add (acl2s-defaults :set testing-enabled T) if you want to add
-;; full-blown testing+theorem-proving.
-;; Add (acl2s-defaults :set testing-enabled :naive) if you want to
-;; do simple testing without invoking the mighty theorem prover.
-
-;; EXAMPLES:
-;; Check our testing-regression.lsp
-
-;; NOTE: If you want to browse code, you might wonder what def, f* etc
-;; mean. You should then first read basis.lisp to understand what they do
\ No newline at end of file
diff -Nru acl2-6.2/books/countereg-gen/type.lisp acl2-6.3/books/countereg-gen/type.lisp
--- acl2-6.2/books/countereg-gen/type.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/type.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,166 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-(acl2::begin-book t);$ACL2s-Preamble$|#
-
-(in-package "ACL2")
-(include-book "graph")
-
-;;; For use by testing hints
-;;; Get the type information from the ACL2 type alist
-(mutual-recursion
- (defun get-type-from-type-set-decoded (ts-decoded)
-   ;(declare (xargs :guard (symbolp ts-decoded)))
-   (cond   ;primitve types
-    ((eq ts-decoded '*TS-ZERO*)                  '(0) )
-    ((eq ts-decoded '*TS-POSITIVE-INTEGER*)      '(pos) )     ;;; positive integers
-    ((eq ts-decoded '*TS-POSITIVE-RATIO*)        '(positive-ratio) )     ;;; positive non-integer rationals
-    ((eq ts-decoded '*TS-NEGATIVE-INTEGER*)      '(neg) ) ;;; negative integers
-    ((eq ts-decoded '*TS-NEGATIVE-RATIO*)        '(negative-ratio) ) ;;; negative non-integer rationals
-    ((eq ts-decoded '*TS-COMPLEX-RATIONAL*)      '(complex-rational) );;; complex rationals
-    ((eq ts-decoded '*TS-NIL*)                   '('nil) );;; {nil}
-    ((eq ts-decoded '*TS-T*)                     '('t) );;; {t}
-    ((eq ts-decoded '*TS-NON-T-NON-NIL-SYMBOL*)  '(symbol) );;; symbols other than nil, t
-    ((eq ts-decoded '*TS-PROPER-CONS*)           '(proper-cons) );;; null-terminated non-empty lists
-    ((eq ts-decoded '*TS-IMPROPER-CONS*)         '(improper-cons) );;; conses that are not proper
-    ((eq ts-decoded '*TS-STRING*)                '(string) );;; strings
-    ((eq ts-decoded '*TS-CHARACTER*)             '(character) );;; characters
-    
-;non-primitive types but defined in ground acl2 theory and base.lisp
-    ((eq ts-decoded '*TS-UNKNOWN*)               '(all) );should give out error?
-    ((eq ts-decoded '*TS-NON-NIL* )              '(all) )
-    ((eq ts-decoded '*TS-ACL2-NUMBER*)           '(acl2-number) )
-    ((eq ts-decoded '*TS-RATIONAL-ACL2-NUMBER*)  '(acl2-number) )
-    ((eq ts-decoded '*TS-RATIONAL* )             '(rational) )
-    ((eq ts-decoded '*TS-TRUE-LIST-OR-STRING*)   '(true-list string)) 
-    ((eq ts-decoded '*TS-SYMBOL*   )             '(symbol) )
-    ((eq ts-decoded '*TS-INTEGER*   )            '(integer) )
-    ((eq ts-decoded '*TS-NON-POSITIVE-RATIONAL*) '(negative-rational 0))
-    ((eq ts-decoded '*TS-NON-NEGATIVE-RATIONAL*) '(positive-rational 0))
-    ((eq ts-decoded '*TS-NEGATIVE-RATIONAL* )    '(negative-rational) )
-    ((eq ts-decoded '*TS-POSITIVE-RATIONAL* )    '(positive-rational) )
-    ((eq ts-decoded '*TS-NON-NEGATIVE-INTEGER*)  '(nat));(0 pos)) 
-    ((eq ts-decoded '*TS-NON-POSITIVE-INTEGER*)  '(neg 0)) 
-    ((eq ts-decoded '*TS-RATIO*)                 '(ratio) )
-    ((eq ts-decoded '*TS-CONS*  )                '(cons) )
-    ((eq ts-decoded '*TS-BOOLEAN*)               '(boolean) )
-    ((eq ts-decoded '*TS-TRUE-LIST*)             '(true-list) )
-    
-    ((eq ts-decoded '*TS-EMPTY*)                 '(empty));is it possible?
-    (t  (if (consp ts-decoded)
-            (cond 
-             ((equal 'TS-UNION (car ts-decoded))
-              (get-types-from-type-set-decoded-lst (cdr ts-decoded) nil))
-             ((and (equal 'TS-COMPLEMENT (car ts-decoded))
-                   (equal (cadr ts-decoded) '*TS-CONS*))
-              '(atom))
-             (t '(all)))
-          '(all)))))
- 
-(defun get-types-from-type-set-decoded-lst (ts-lst ans)
-   (if (endp ts-lst)
-     ans
-     (get-types-from-type-set-decoded-lst 
-      (cdr ts-lst) 
-      (append (get-type-from-type-set-decoded (car ts-lst))
-              ans))))
- )
-
-(defun get-type-list-from-type-set (ts)
-  (declare (xargs :mode :program
-                  :guard (integerp ts)))
-  (let ((typ (get-type-from-type-set-decoded 
-              (acl2::decode-type-set ts))))
-    (if (proper-consp typ)
-      typ
-      (list typ))))
-
-(defun get-types-from-type-set-lst (ts-lst)
-  (declare (xargs :mode :program 
-                  :guard (integer-listp ts-lst)))
-  (if (endp ts-lst)
-    nil
-    (append (get-type-list-from-type-set (car ts-lst))
-            (get-types-from-type-set-lst (cdr ts-lst)))))
-
-
-
-; for each var in freevars, look into the type-alist
-; and build a no-dup vt-al(var-types-alist)
-; Note: we can get a list of types which means TS-UNION
-(defun get-var-types-from-type-alist (acl2-type-alist freevars ans)
-  (declare (xargs :mode :program
-                  :guard (and (alistp acl2-type-alist)
-                              (symbol-listp freevars))))
-  (if (endp freevars)
-      ans
-    (b* ((var (car freevars))
-; CHECK: Can acl2-type-alist have duplicate keys?
-         (ts-info (assoc-eq var acl2-type-alist))
-         (ts (if (consp ts-info) (cadr ts-info) nil)))
-     (if ts
-         (let ((types (get-type-list-from-type-set ts)))
-          (get-var-types-from-type-alist acl2-type-alist 
-                                          (cdr freevars) 
-                                          (acons var types ans)))
-       (get-var-types-from-type-alist acl2-type-alist 
-                                       (cdr freevars) ans)))))
-
-(defun decode-acl2-type-alist (acl2-type-alist freevars)
-  (declare (xargs :mode :program
-                  :guard (and (alistp acl2-type-alist)
-                              (symbol-listp freevars))))
-  (if (endp acl2-type-alist)
-      '()
-    (get-var-types-from-type-alist acl2-type-alist freevars '())))
-
-
-
-
-;;; Foll fun lifted from intersection-of-types in type.lisp
-;; NOTE: In the following the type 'empty' has
-;; special status and treated seperately
-(defun meet (typ1 typ2 wrld)
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbolp typ1)
-                              (symbolp typ2)
-                              (plist-worldp wrld))))
-  ;; (decl :sig ((possible-defdata-type-p possible-defdata-type-p
-;;                                        plist-world)
-;;               -> possible-defdata-type-p)
-;;         :doc "naive implementation of meet operation of the lattice of
-;; defdata types")
-  (b* (((when (or (eq 'acl2::empty typ1)
-                  (eq 'acl2::empty typ2))) 'acl2::empty)
-       ((when (eq typ2 typ1)) typ2)
-       ((unless (and (defdata::is-a-typeName typ1 wrld)
-                     (defdata::is-a-typeName typ2 wrld)))
-        (er hard 'meet "~x0 or ~x1 is not a defdata type.~|" typ1 typ2))
-       ((when (eq 'acl2::all typ1)) typ2)
-       ((when (eq 'acl2::all typ2)) typ1)
-       ((when (defdata::is-subtype typ1 typ2 wrld))   typ1)
-       ((when (defdata::is-subtype typ2 typ1 wrld))   typ2)
-       ((when (defdata::is-disjoint typ2 typ1 wrld))  'acl2::empty) ;Should we instead define the NULL type??? Modified: so Ans is YES instead of Ans: NO, the way its used now, this is right!
-;give preference to custom type
-       ((when (defdata::is-a-custom-type typ1 wrld)) typ1)
-       ((when (defdata::is-a-custom-type typ2 wrld)) typ2)
-
-; choose the one that was defined later (earlier in 
-; reverse chronological order)
-       (types-in-wrld (strip-cars (table-alist 
-                                   'defdata::types-info-table wrld)))
-       (pos1 (position typ1 types-in-wrld))
-       (pos2 (position typ2 types-in-wrld)))
-   (if (< (nfix pos1) (nfix pos2)) 
-       typ1 
-     typ2)));type table is already in reverse chrono order
-
-  
-
-
-(set-verify-guards-eagerness 0)
-
-(verify-termination quote-listp)
-(verify-termination cons-term1)
-(verify-termination cons-term); ASK MATT to make these logic mode
-(set-verify-guards-eagerness 1)
diff -Nru acl2-6.2/books/countereg-gen/utilities.lisp acl2-6.3/books/countereg-gen/utilities.lisp
--- acl2-6.2/books/countereg-gen/utilities.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/utilities.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1175 +0,0 @@
-#|$ACL2s-Preamble$;
-(ld ;; Newline to fool ACL2/cert.pl dependency scanner
- "portcullis.lsp")
-
-;;Bunch of utility functions for use by datadef and test?
-;;mostly copied from data.lisp and acl2-check.lisp
-
-(acl2::begin-book t);$ACL2s-Preamble$|#
-
-
-(in-package "DEFDATA")
-
-(set-verify-guards-eagerness 2)
-(include-book "tools/bstar" :dir :system)
-;(include-book "basis")
-
-;;-- create a new symbol with prefix or suffix appended
-;;-- if its a common-lisp symbol then attach acl2 package name to it
-;;-- example:
-;;-- (modify-symbol "NTH-" 'bool "") ==> NTH-BOOL
-;;-- (modify-symbol "NTH-" 'boolean "") ==> ACL2::NTH-BOOLEAN
-(defun modify-symbol (prefix sym postfix)
-  (declare (xargs :guard (and (symbolp sym)
-                              (stringp postfix)
-                              (stringp prefix))))
-  (let* ((name (symbol-name sym))
-         (name (string-append prefix name))
-         (name (string-append name postfix)))
-    (if (member-eq sym *common-lisp-symbols-from-main-lisp-package*)
-      (intern-in-package-of-symbol name 'acl2::acl2-pkg-witness)
-      (intern-in-package-of-symbol name sym))))
-
-(defun modify-symbol-lst (prefix syms postfix)
-  (declare (xargs :guard (and (symbol-listp syms)
-                              (stringp prefix)
-                             (stringp postfix))))
-  (if (endp syms)
-    nil
-    (cons (modify-symbol prefix (car syms) postfix)
-          (modify-symbol-lst prefix (cdr syms) postfix))))
-
-
-
-; utility fn to print if verbose flag is true 
-(defmacro cw? (verbose-flag &rest rst)
-  `(if ,verbose-flag
-     (cw ,@rst)
-     nil))
-
-
-(defun allp (x)
-  (declare (xargs :mode :logic
-                  :guard t)
-           (ignore x))
-  t)
-
-
-(defmacro   debug-flag  (vl)
-  `(> ,vl 2))
-
-(defmacro   system-debug-flag ( vl)
-  `(> ,vl 3))
- 
-
-(defmacro   verbose-flag ( vl)
-  `(> ,vl 1))
-  
-
-(defmacro   inhibit-output-flag ( vl)
-  `(<= ,vl 0))
-  
-
-(defmacro   normal-output-flag ( vl)
-  `(> ,vl 0))
-
-
-
-(defmacro acl2-getprop (name prop w &key default)
- `(getprop ,name ,prop ,default 'acl2::current-acl2-world ,w))
-
-
-;;-- Returns a symbol representing the predicate of the parameter sym which is normally a type
-;;-- (get-predicate-symbol 'integer) ==> INTEGERP
-(defun get-predicate-symbol (sym)
-  (declare (xargs :guard (symbolp sym)))
-  (modify-symbol "" sym "P"))
-
-;;-- (get-predicate-symbol-lst '(integer boolean rational)) ==> (INTEGERP BOOLEANP RATIONALP)
-(defun get-predicate-symbol-lst (syms)
-  (declare (xargs :guard (symbol-listp syms)))
-  (if (endp syms)
-    nil
-    (cons (get-predicate-symbol (car syms))
-          (get-predicate-symbol-lst (cdr syms)))))
-
-(local
- (defthm valid-subseq-of-string-is-string
-   (implies (and (stringp pname)
-                 (< x (length pname))
-                 (< y (length pname))
-                 (<= x y))
-            (stringp (subseq pname x y)))
-   :rule-classes :type-prescription))
-
-
-
-;;inverse operation of the above --added by harshrc
-(defun get-typesymbol-from-pred (sym)
-  (declare (xargs :guard (and (symbolp sym))
-                  :guard-hints (("Goal" :in-theory (disable acl2::length acl2::subseq)))))
-
-  (let* ((pred-name (acl2::symbol-name sym))
-        (len-predname (acl2::length pred-name)))
-    (if (and
-         (< 1 len-predname) ;atleast have "p" and one more char
-         (equal #\P (acl2::char pred-name (1- len-predname)))) ;WTF, smallcase p wouldnt work
-      (let ((typename (acl2::subseq pred-name 0 (1- len-predname))));strip last char which is 'p'
-        (intern-in-package-of-symbol typename sym))
-      NIL))) ;TODO.Beware
-      ;(er hard 'get-typesymbol-from-pred "~x0 doesnt follow our convention of predicates ending with 'p'.~%" sym))))
-
-(defun len-<-0-syms (syms)
-  (declare (xargs :guard (symbol-listp syms)))
-                  ;:VERIFY-GUARDS NIL))
-  (if (endp syms)
-    't
-    (and (if (symbolp (car syms)) 't 'nil)
-         (< 0 (length (symbol-name (car syms))))
-         (len-<-0-syms (cdr syms)))))
-
-(defun get-typesymbol-from-pred-lst (syms)
-  (declare (xargs :guard (and (symbol-listp syms)
-                              (len-<-0-syms syms))))
-                         
-  (if (endp syms)
-    nil
-    (let ((type (get-typesymbol-from-pred (car syms))))
-      (if type ;it might be NIL (Ideally it shud be an ERROR??)
-        (cons type
-              (get-typesymbol-from-pred-lst (cdr syms)))
-        (get-typesymbol-from-pred-lst (cdr syms))))))
-
-(defun or-list (lst)
-  (if (atom lst)
-    lst
-    (or (car lst)
-        (or-list (cdr lst)))))
-
-(defun to-symbol-in-package (sym pkg-name)
-  (declare (xargs :guard (and (symbolp sym)
-                              (not (equal pkg-name ""))
-                              (stringp pkg-name))))
-  (intern$ (symbol-name sym) pkg-name))
-
-(defun to-symbol-in-package-lst (sym-lst pkg)
-  (declare (xargs :guard (and (symbol-listp sym-lst)
-                              (not (equal pkg ""))
-                              (stringp pkg))))
-  (if (endp sym-lst)
-      nil
-    (cons (to-symbol-in-package (car sym-lst) pkg)
-          (to-symbol-in-package-lst (cdr sym-lst) pkg))))
-
-
-(defun cons-up-lists (l1 l2)
-  (declare (xargs :guard (and (true-listp l1)
-                              (true-listp l2)
-                              (= (len l1)
-                                 (len l2)))))
-  "same as pairlis$"
-  (if (endp l1)
-    nil
-    (cons (cons (car l1) (car l2))
-          (cons-up-lists (cdr l1) (cdr l2)))))
-
-
-;general
-(defun list-up-lists (l1 l2)
-  (declare (xargs :guard (and (true-listp l1)
-                              (true-listp l2)
-                              (= (len l1) (len l2)))))
-  "same as listlis"
-  (if (endp l1)
-    nil
-    (cons (list (car l1) (car l2))
-          (list-up-lists (cdr l1) (cdr l2)))))
-
-
-(verify-termination LEGAL-VARIABLE-OR-CONSTANT-NAMEP)
-(verify-termination legal-constantp)
-;;-- convert function lambda-keywordp from :program mode to :logic mode 
-(verify-termination acl2::lambda-keywordp)
-(verify-guards  acl2::lambda-keywordp)
-(verify-guards legal-constantp)
-
-
-
-;;--check arity of macro optional arguments 
-(defun optional-macro-args-allow-arity (margs n)
-  (declare (xargs :guard (and (true-listp margs) (integerp n))))
-  (cond ((<= n 0)
-         t)
-        ((endp margs)
-         nil)
-        ((member-eq (car margs) '(&rest &body))
-         t)
-        ((acl2::lambda-keywordp (car margs))
-         nil)
-        (t
-         (optional-macro-args-allow-arity (cdr margs) (1- n)))))
-
-;;-- check arity of a macro 
-(defun macro-args-allow-arity (margs n)
-  (declare (xargs :guard (and (true-listp margs) (integerp n))))
-  (cond ((< n 0)
-         nil)
-        ((endp margs)
-         (= n 0))
-        ((acl2::lambda-keywordp (car margs))
-         (cond ((eq (car margs) '&whole)
-                (macro-args-allow-arity (cdr margs) (1+ n)))
-               ((eq (car margs) '&optional)
-                (optional-macro-args-allow-arity (cdr margs) n))
-               ((member-eq (car margs) '(&rest &body))
-                t)
-               ((member-eq (car margs) '(&key &allow-other-keys))
-                (= n 0))
-               (t
-                nil)))
-        (t
-         (macro-args-allow-arity (cdr margs) (1- n)))))
-
-;;-- check arity of any function or macro
-(defun allows-arity (name n world)
-  (declare (xargs :guard (and (symbolp name)
-                              (natp n)
-                              (plist-worldp world))))
-  (if (function-symbolp name world)
-    (= n (len (acl2-getprop name 'formals world)))
-    (let ((margs (acl2-getprop name 'macro-args world
-                               :default :undefined)))
-      (and (true-listp margs)
-           (macro-args-allow-arity margs n)))))
-
-;EXTREMELY SLOW CALL because of getprop
-(defun defined-fun-or-macrop (name world)
-  (declare (xargs :guard (plist-worldp world)))
-  (and (symbolp name)
-       (or (function-symbolp name world)
-           (true-listp (acl2-getprop name 'macro-args world
-                                     :default :undefined)))))
-                                
-
-(defun allow-arity-lst (name-lst n world)
-  (declare (xargs :guard (and (symbol-listp name-lst)
-                              (natp n)
-                              (plist-worldp world))))
-  (or (endp name-lst)
-      (and (allows-arity    (car name-lst) n world)
-           (allow-arity-lst (cdr name-lst) n world))))
-
-;;--check if 'name' is a predicate function
-(defun plausible-predicate-functionp (name world)
-  (declare (xargs :guard (and (symbolp name)
-                              (plist-worldp world))))
-  (allows-arity name 1 world))
-
-(defun plausible-predicate-function-listp (name-lst world)
-  (declare (xargs :guard (and (symbol-listp name-lst)
-                              (plist-worldp world))))
-  (or (endp name-lst)
-      (and (plausible-predicate-functionp      (car name-lst) world)
-           (plausible-predicate-function-listp (cdr name-lst) world))))
-
-;;--check if x if a keyword list
-(defun keyword-listp (x)
-  (if (consp x)
-    (and (keywordp (car x))
-         (keyword-listp (cdr x)))
-    (null x)))
-
-(defun possible-constant-valuep (def)
-  (declare (xargs :guard t))
-  (if (consp def)
-    ;quoted constant
-    (and (eq 'quote (car def))
-         (consp (cdr def))
-         (null (cddr def)))
-    (or (not (symbolp def));either acl2-number character string
-        (keywordp def);a keyword
-        (booleanp def);t or nil
-        (legal-constantp def))))
-
-
-
-(mutual-recursion
-(defun constant-value-expressionp-lst (expr-lst wrld)
-  (declare (xargs :guard (plist-worldp wrld)))
-  (if (atom expr-lst)
-    t
-    (and (constant-value-expressionp (car expr-lst) wrld)
-         (constant-value-expressionp-lst (cdr expr-lst) wrld))))
-
-;very slow
-(defun constant-value-expressionp (expr wrld)
-   (declare (xargs :guard (plist-worldp wrld)))
-  (cond ((null expr) t)
-        ((possible-constant-valuep expr) t)
-        ((atom expr) (possible-constant-valuep expr))
-        ((not (defined-fun-or-macrop (car expr) wrld)) nil)
-        (t (constant-value-expressionp-lst (cdr expr) wrld)))
-    )
-)
-
-
-(mutual-recursion
-(defun possible-constant-value-expressionp-lst (expr-lst)
-  (if (atom expr-lst)
-    t
-    (and (possible-constant-value-expressionp (car expr-lst))
-         (possible-constant-value-expressionp-lst (cdr expr-lst)))))
-
-(defun possible-constant-value-expressionp (expr)
-   (cond ((null expr) t);if nil
-         ((possible-constant-valuep expr) t); if a constant
-         ((atom expr) (possible-constant-valuep expr));if an atom, it has to go through this
-         ((not (symbolp (car expr))) nil)
-         (t (possible-constant-value-expressionp-lst (cdr expr))))
-   )
-)
-
-; begin some auxilliary stuff for defdata
-
-;get the predicate function symbol for a type-name if it exists
-(defun er-get-predicate (type-name ctx wrld state)
-  (declare (xargs :mode :program
-                  :stobjs (state)
-            :guard (and (symbolp type-name)
-                              (symbolp ctx)
-                              (plist-worldp wrld))))
-  (let ((psym (get-predicate-symbol type-name)))
-    (if (plausible-predicate-functionp psym wrld)
-      (value psym)
-      (er soft ctx
-          "Predicate ~x0 for type ~x1 is not defined."
-          psym type-name))))
-
-;get the constant value associated with constant expression 'def'
-(defun er-get-constant-value (def ctx wrld state)
-  (declare (xargs :mode :program
-                  :stobjs (state)
-                  :guard (plist-worldp wrld)))
-  (cond ((and (consp def)
-             (eq 'quote (car def))
-             (consp (cdr def))
-             (null (cddr def)))
-         (value (cadr def)))
-        ((and (atom def)
-              (or (not (symbolp def))
-                  (keywordp def)
-                  (booleanp def)))
-         (value def))
-        (t 
-         (let ((p (acl2-getprop def 'const wrld)))
-                               
-           (if (and (symbolp def)
-                    (quotep p))
-               (value (cadr p))
-             (er soft ctx "Illegal/undefined constant value: ~x0" def))))))
-
-;;-- evaluates expr and returns its value if expr does not return a multi-value answer
-(defun trans-eval-single-value (expr ctx state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-  (acl2::state-global-let*
-   ((acl2::guard-checking-on :none))
-   (er-let* ((ans (trans-eval expr ctx state t)));for now aok is t
-     (if (equal (car ans) '(nil))
-       (value (cdr ans))
-       (er soft ctx "Expected a single return value in evaluation of ~x0."
-           expr)))))
-
-(local (defthm union-true-lists
-         
-         (implies (and (true-listp l1)
-                       (true-listp l2))
-                  (true-listp (union-equal l1 l2)))))
-
-(defun union-lsts (lsts)
-  (declare (xargs :mode :logic
-                  :guard (true-list-listp lsts)))
-  (if (endp lsts)
-    nil
-    (union-equal (car lsts)
-                 (union-lsts (cdr lsts)))))
- 
-(defun assoc-lst (keys alist)
-  (declare (xargs :guard (and (true-listp keys)
-                              (alistp alist))))
-  (if (endp keys)
-    nil
-    (cons (assoc-equal (car keys) alist)
-          (assoc-lst (cdr keys) alist))))
-
-(defun flatten (b lst&)
-  (declare (xargs :guard (true-listp lst&)))
-  (if (atom b)
-    (cons b lst&)
-    (flatten (car b) (flatten (cdr b) lst&))))
-
-(defun mem1 (atm lst)
-  (declare (xargs :guard (true-listp lst)))
-  (if (endp lst)
-    nil
-    (if (equal atm (car lst))
-      t
-      (mem1 atm (cdr lst)))))
-
-(defun mem-eq (v lst)
-  (declare (xargs :guard (or (and (symbolp v)
-                                  (true-listp lst))
-                             (symbol-listp lst))))
-  (if (endp lst)
-    nil
-    (if (eq v (car lst))
-      t
-      (mem-eq v (cdr lst)))))
-
-(mutual-recursion
- (defun defbodyp (x)
-   (or (symbolp x)
-       (possible-constant-valuep x)
-       (defbody-listp (cdr x))))
- (defun defbody-listp (xs)
-   (if (atom xs)
-     (equal xs nil)
-     (and (defbodyp (car xs))
-          (defbody-listp (cdr xs))))))
-
-(include-book "misc/total-order" :dir :system)
-
-(defun order-two-terms (t1 t2)
-  (declare (xargs :guard t))
-  (if (acl2::<< t1 t2);total order
-      (mv t1 t2)
-      (mv t2 t1)))
-
-(defthm flatten-is-true-list 
-  (implies (true-listp lst)
-           (true-listp (flatten b lst)))
-  :rule-classes :type-prescription)
-(in-theory (disable flatten)) 
-
-(defun true-list-alistp (x)
-  (declare (xargs :guard t))
-  (cond ((atom x) (eq x nil))
-        (t (and (alistp (car x))
-                (true-list-listp (cdr x))))))
-
-(defun true-list-symbol-alistp (x)
-  (declare (xargs :guard t))
-  (cond ((atom x) (eq x nil))
-        (t (and (symbol-alistp (car x))
-                (true-list-symbol-alistp (cdr x))))))
-
-         
-;;self-explanatory
-(defun symbol-doublet-list-listp (xs)
-  (declare (xargs :guard t))
-  (if (null xs)
-    t
-    (if (atom xs)
-      nil
-      (and (acl2::symbol-doublet-listp (car xs))
-           (symbol-doublet-list-listp (cdr xs))))))
-
-(defun symbol-alist-listp (x)
-  (declare (xargs :guard T))
-  (if (atom x)
-    (null x)
-    (and (symbol-alistp (car x))
-         (symbol-alist-listp (cdr x)))))
-
-
-
-(verify-termination ACL2::>=-LEN)
-(verify-termination ACL2::ALL->=-LEN)
-(verify-termination ACL2::>=-LEN ACL2::ALL->=-LEN)
-(defun strip-cadrs (x)
-  (declare (xargs :guard (acl2::all->=-len x 2)))
-  (cond ((atom x) nil)
-        (t (cons (cadar x)
-                 (strip-cadrs (cdr x))))))
-
-
-
-
-
-;utility funs
-;boolean-or: Expr * Expr * ... -> Bool
-(defun boolean-or-macro (lst)
-  (if (consp lst)
-    (list 'if
-          (car lst)
-          't
-          (boolean-or-macro (cdr lst)))
-    'nil))
-;boolean-or: Expr * Expr * ... -> Bool
-(defmacro boolean-or (&rest args)
-  (boolean-or-macro args))
-
-
-;; (defun is-simple-type-hyp (term wrld)
-;; ;is a simple type hypothesis, and if true returns
-;; ; the type-name (not the predicate itself)
-;;   (declare (xargs :verify-guards nil))
-;;   (and (consp term)
-;;        (eql (len term) 2)
-;;        (atom (cadr term))
-;;        (is-a-variablep (cadr term)) ;check wether its arg is sa variable 
-;;        (plausible-predicate-functionp (car term) wrld)
-;;        (is-type-predicate (car term) wrld))) ;check if its a type predicate
-
-
-;NEEDED BY EVERYONE:
-  
-; 12/4/2012, Matt K.: Omitting the definitions of nat-listp and
-; acl2-number-listp, which are being built into ACL2.
-
-(defun naturals-listp (x)
-   (declare (xargs :guard t))
-  (if (atom x)
-    (null x)
-    (and (natp (car x))
-         (naturals-listp (cdr x)))))
-
-; already in program mode:
-(DEFUN POS-LISTP (acl2::L)
-   (declare (xargs :guard t))
-  (COND ((ATOM acl2::L) (EQ acl2::L NIL))
-        (T (AND (POSP (CAR acl2::L))
-                (POS-LISTP (CDR acl2::L))))))
-
-;; del: All tlp -> tlp
-;; signature: (a X)
-;; removes the first occurrence of a from X
-(defun del (a X)
-  (declare (xargs :guard (true-listp X)))
-  (cond ((endp X) nil)
-        ((equal a (car X)) (cdr X))
-        (t (cons (car X) (del a (cdr X))))))
-
-(defun rev-acc (X acc)
-  (declare (xargs :guard (true-listp X)))
-  (if (endp X)
-    acc
-    (rev-acc (cdr X) (cons (car X) acc))))
-
-(defun rev (X)
-  (declare (xargs :guard (true-listp X)))
-  (rev-acc X nil))
-
-;is x permutation of y 
-(defun permutation (xs ys)
-  (declare (xargs :verify-guards nil))
-  (cond ((atom xs) (atom ys)) 
-        (t (and (mem1 (car xs) ys) (permutation (cdr xs) (del (car xs) ys)))))) 
-
-(defun get-value-from-keyword-value-list (key kv-lst)
-  (declare (xargs :guard (keyword-value-listp kv-lst)))
-  (second (assoc-keyword key kv-lst)))
-
-
-
-;Sig: Any -> Bool
-;check wether arg is a variable 
-(defun is-a-variablep (x)
-  (declare (xargs :guard t))
-  (and (symbolp x)
-       (not (or (keywordp x);a keyword
-                (booleanp x);t or nil
-                (legal-constantp x)))));ACL2::CONSTANT
-
-
-;NOTE PACKAGES are very IMP while assuming that symbols are all ACL2. Like
-;I just fixed a bug, where 'CONSTANT was assumed in ACL2 package, but due to
-;this book being in DEFDATA PACKAGE, the equality check is against the symbol
-;DEFDATA::CONSTANT which not same as ACL2::CONSTANT resulting in treating
-;t and nil as variables.
-
-;;list the free variables in a term
-(mutual-recursion
-;; code taken from structures.lisp in data-structures book.
- (defun get-free-vars1 (term ans)
-    (declare (xargs :verify-guards nil
-                    :guard (and (or (atom term)
-                                    (true-listp term))
-                                (true-listp ans)
-                                )))
-   "A free variable is a symbol that is not a constant, i.e., it excludes T,
-    NIL, and *CONST*, and keywords"
-   (cond
-    ((atom term) (if (is-a-variablep term)
-                   (add-to-set-eq term ans)
-                   ans))
-    ((eq (car term) 'QUOTE) ans)
-    (t (get-free-vars1-lst (cdr term) ans))))
- 
- (defun get-free-vars1-lst (terms ans)
-    (declare (xargs :guard (and (true-listp terms)
-                                (or (atom (car terms))
-                                    (true-listp (car terms)))
-                                (true-listp ans)
-                                )))
-   (cond
-    ((endp terms) ans)
-    (t (get-free-vars1-lst (cdr terms) 
-                           (get-free-vars1 (car terms) ans))))))
-
-;auxiliary function for get-free-vars
-(defun get-free-vars0 (form state)
-  (declare (xargs :mode :program 
-                  :stobjs (state)))
-  (if (acl2::termp form (w state))
-; had a bug due to namespace change
-     (value (get-free-vars1 form '())) 
-; translate the form into a term
-     (er-let* ((term (acl2::translate form t nil t 
-                                'get-free-vars (w state) state))) 
-       (value (get-free-vars1 term '())))))
-    
-;get list of free variables in acl2 expression 'form'
-(defmacro get-free-vars (form)
-  `(get-free-vars0 ,form state)) 
-
-
-
-;filter typ-exps which are typenames
-(defun filter-alist-keys (alst wanted-keys)
-  (declare (xargs :guard (and (alistp alst)
-                              (true-listp wanted-keys))))
-  (if (endp alst)
-    nil
-    (let* ((key (caar alst))
-           (we-want-to-add  (mem1 key wanted-keys)))
-      (if we-want-to-add 
-        (cons (car alst);cons the wanted entry
-              (filter-alist-keys (cdr alst) wanted-keys))
-        (filter-alist-keys (cdr alst) wanted-keys)))))
-
-
-(defun remove-entry (key alist)
-  (declare (xargs  :guard (and (alistp alist))))
-  (if (endp alist)
-    nil
-    (if (equal key (caar alist))
-      (cdr alist)
-      (cons (car alist)
-            (remove-entry key (cdr alist))))))
-
-(defun remove-entry-lst (keys alist)
-  (declare (xargs  :guard (and (true-listp keys)
-                               (alistp alist))))
-  (if (endp keys)
-    alist
-    (remove-entry-lst (cdr keys) 
-                      (remove-entry (car keys) alist))))
-
-;get value of key in alist
-(defun get-val (key alist)
-  (declare (xargs  :guard (and (alistp alist))))
-  (if (endp alist)
-    nil
-    (if (equal key (caar alist))
-      (cdar alist)
-      (get-val key (cdr alist)))))
-
-;recurse on above
-(defun get-val-lst (keys alist)
-  (declare (xargs  :guard (and (true-listp keys)
-                               (alistp alist))))
-  (if (endp keys)
-      nil
-    (let ((found-val (get-val (car keys) alist)))
-      (if found-val
-        (cons found-val
-              (get-val-lst (cdr keys) alist))
-        (get-val-lst (cdr keys) alist)))))
-
-;if val is different, then add it at the very end,
-;do not update in place. Assumes unique entries
-(defun remove-and-add-at-end-entry (key val alist)
-  (declare (xargs  :guard (alistp alist)))
-  (if (endp alist)
-    (list (cons key val))
-    (let* ((curr-entry (car alist))
-           (curr-key (car curr-entry))
-           (curr-val (cdr curr-entry)))
-      (if (not (equal key curr-key))
-        (cons curr-entry
-              (remove-and-add-at-end-entry key val (cdr alist)))
-        (if (equal val curr-val)
-          alist;return unchanged
-          (remove-and-add-at-end-entry key val (cdr alist)))))))
-
-(defun remove-and-add-at-front-entry (key val alist)
-  (declare (xargs  :guard (alistp alist)))
-  (cons (cons key val)
-        (remove-entry key alist)))
-  
-;put the key val entry in alist(overwrite)
-;assumes unique entries
-(defun put-entry (key val alist)
-  (declare (xargs  :guard (alistp alist)))
-  (if (endp alist)
-    (list (cons key val))
-    (if (equal key (caar alist))
-      (cons (cons key val)
-            (cdr alist))
-      (cons (car alist)
-            (put-entry key val (cdr alist))))))
-
-
-  
-;get key having value val in alist
-(defun get-key (val alist)
-  (declare (xargs  :guard (alistp alist)))
-  (if (endp alist)
-      nil
-    (if (equal val (cdar alist))
-      (caar alist)
-      (get-key val (cdr alist)))))
-
-;recurse on above, in order of vals.
-(defun get-key-lst (vals alist)
-  (declare (xargs  :guard (and (true-listp vals)
-                               (alistp alist))))
-  (if (endp vals)
-    nil
-    (let ((found-key (get-key (car vals) alist)))
-      (if found-key
-        (cons found-key
-              (get-key-lst (cdr vals) alist))
-        (get-key-lst (cdr vals) alist)))))
-
-(defun get-var-from-i-or-is-lst (is var-i-alst)
-  (declare (xargs  :verify-guards nil))
-  (if (endp is)
-    nil
-    (let ((i (car is)))
-      (if (atom i)
-        (let ((found-key (get-key i var-i-alst)))
-          (if found-key
-            (cons found-key (get-var-from-i-or-is-lst (cdr is) var-i-alst))
-            (get-var-from-i-or-is-lst (cdr is) var-i-alst)))
-        ;else its a nat-listp
-        (let ((found-keys (get-key-lst i var-i-alst)))
-          (if found-keys
-            (cons found-keys (get-var-from-i-or-is-lst (cdr is) var-i-alst))
-            (get-var-from-i-or-is-lst (cdr is) var-i-alst)))))))
-              
-
-;returns list of all keys matching val
-(defun get-all-keys1 (val alist ans)
-  (declare (xargs  :guard (alistp alist)))
-  (if (endp alist)
-      ans;return answer
-    (let* ((entry (car alist))
-           (key (car entry))
-           (value (cdr entry)))
-      (if (equal val value)
-        (get-all-keys1 val (cdr alist) (cons key ans));accumulate keys and recurse
-      (get-all-keys1 val (cdr alist) ans)))));recurse
-
-(defun get-all-keys (val alist)
-  (declare (xargs  :guard (alistp alist)))
-  (get-all-keys1 val alist nil))
-
-;recurse on above, in order of vals.
-(defun get-all-keys-lst (vals alist)
-  (declare (xargs  :guard (and (true-listp vals)
-                               (alistp alist))))
-  (if (endp vals)
-    nil
-    (let ((found-keys (get-all-keys (car vals) alist)))
-      (if found-keys
-        (cons found-keys
-              (get-all-keys-lst (cdr vals) alist))
-        (get-all-keys-lst (cdr vals) alist)))))
-
-
-;from Matt ;TODO get rid of this
-(defun trans-eval2 (form ctx state)
-  (declare (xargs :mode :program :stobjs state))
-  (acl2::state-global-let*
-   ((acl2::guard-checking-on :none))
-   (mv-let
-    (erp trans bindings state)
-    (acl2::translate1 form
-                      t nil
-                      t
-                      'top-level (w state) state)
-    (declare (ignore bindings))
-    (cond
-     (erp (mv t nil state))
-     (t
-      (let ((vars (all-vars trans)))
-        (cond
-         ((acl2::non-stobjps vars t (w state)) ;;; known-stobjs = t
-          (er soft 'top-level
-              "Global variables, such as ~&0, are not allowed. See ~
-               :DOC ASSIGN and :DOC @."
-              (acl2::non-stobjps vars t (w state)))) ;;; known-stobjs = t
-         (t (acl2::ev-for-trans-eval trans vars nil ctx state t))))))))) 
-
-;returns (cdr (cons translated-term value)) == value of term under bindings
-(defun trans-eval-single-value-with-bindings (term bindings ctx state)
-  (declare (xargs :mode :program :stobjs state))
-  (acl2::state-global-let*
-   ((acl2::guard-checking-on :none))
-   (er-let* ((term-val (acl2::simple-translate-and-eval term bindings nil
-                                                        "" ctx (w state) state t)))
-     (value (cdr term-val)))))
-
-; this function basically creates in one go cons bindings 
-; for a list of variable names
-(defun make-var-value-cons-bindings (var-lst ans)
-  (declare (xargs :guard (and (symbol-listp var-lst)
-                              (true-listp ans))))
-  (if (endp var-lst)
-    (cons 'list ans)
-    (let ((var (car var-lst)))
-      (make-var-value-cons-bindings (cdr var-lst)
-                                    (append ans (list `(cons ',var ,var)))))))
-
-; this function basically creates in one go list bindings for 
-; a list of variable names
-(defun make-var-value-list-bindings (var-lst ans)
-  (declare (xargs :guard (and (symbol-listp var-lst)
-                              (true-listp ans))))
-  (if (endp var-lst)
-    (cons 'list ans)
-    (let ((var (car var-lst)))
-      (make-var-value-list-bindings 
-       (cdr var-lst)
-       (append ans (list `(list ',var ,var)))))));changed to mimic let binding
-
-; needed for simple-translate-and-eval only.
-; Not needed now!!
-(defun make-constant-value-cons-bindings (var-lst constant-val ans)
-  (declare (xargs :guard (and (symbol-listp var-lst)
-                              (true-listp ans))))
-  (if (endp var-lst)
-    (cons 'list ans)
-    (let ((var (car var-lst)))
-      (make-constant-value-cons-bindings 
-       (cdr var-lst)
-       constant-val
-       (append ans (list (cons var constant-val)))))))
-
-;needed for trans-eval
-(defun make-constant-value-let-bindings (var-lst constant-val ans)
-  (declare (xargs :guard (and (symbol-listp var-lst)
-                              (true-listp ans))))
-  (if (endp var-lst)
-    ans
-    (let ((var (car var-lst)))
-      (make-constant-value-let-bindings 
-       (cdr var-lst)
-       constant-val
-       (append ans (list (list var constant-val)))))))
-
-
-
-;;self-explanatory
-(defun convert-listpair-to-conspair-lst (listpairs)
-  (declare (xargs :guard (acl2::symbol-doublet-listp listpairs)))
-  (if (endp listpairs)
-    nil
-    (cons (let* ((lstpair (car listpairs))
-                 (fst (car lstpair))
-                 (snd (cadr lstpair)))
-            (cons fst snd))
-          (convert-listpair-to-conspair-lst (cdr listpairs)))))
-
-
-; self-explanatory
-; convert ((a . b) ...) to ((a b) ...)
-(defun convert-conspairs-to-listpairs (conspairs)
-  (declare (xargs :guard (symbol-alistp conspairs)))
-  (if (endp conspairs)
-    nil
-    (cons (let* ((conspair (car conspairs))
-                 (fst (car conspair))
-                 (snd (cdr conspair)))
-            (list fst snd))
-          (convert-conspairs-to-listpairs (cdr conspairs)))))
-
-(defthm convert-conspairs-to-listpairs-sig1
-  (implies (symbol-alistp P)
-           (symbol-doublet-listp (convert-conspairs-to-listpairs P)))
-  :rule-classes (:rewrite :type-prescription :forward-chaining))
-
-(defthm symbol-doublet-listp-implication1
-  (implies (and (symbol-doublet-listp A)
-                (consp A))
-           (and (consp (car A))
-                (symbolp (caar A))
-                (consp (cdr (car A)))
-                (null (cddr (car A)))))
-  :rule-classes (:forward-chaining :type-prescription))
-
-(defun count-occurrences (v lst)
-  (declare (xargs :guard (true-listp lst)))
-  (if (endp lst)
-    0
-    (if (equal v (car lst))
-      (1+ (count-occurrences v (cdr lst)))
-      (count-occurrences v (cdr lst)))))
-
-(defun sym-eq-lst (syms1 syms2)
-  (declare (xargs :guard (and (symbol-listp syms1)
-                              (symbol-listp syms2))))
-  "returns first symbol in syms2 which is in syms1 o.w nil"
-  (if (endp syms2)
-    nil
-    (if (mem1 (car syms2) syms1)
-      (car syms2)
-      (sym-eq-lst syms1 (cdr syms2)))))
-
-(defun insert-entry-after-key (entry k alst)
-  (declare (xargs :guard (and (symbolp k)
-                              (symbol-alistp alst))))
-  "insert entry immediately after the pair in alst having key k"
-  (if (endp alst)
-   (list entry)
-    (if (eq k (caar alst))
-      (cons (car alst)
-            (cons entry (cdr alst)))
-      (cons (car alst)
-           (insert-entry-after-key entry k (cdr alst)))))) 
-
-(defun get-ordered-alst (keys alst ans)
-  (declare (xargs :guard (and (true-listp keys) (alistp ans) (alistp alst))))
-  "accumulate entries of alist in ans in the order of keys"
-  (if (endp keys)
-    ans
-    (let ((at (assoc-equal (car keys) alst)))
-      (if at
-        (get-ordered-alst (cdr keys) alst (append ans (list at)))
-        (get-ordered-alst (cdr keys) alst ans)))))
-
-
-;filter all elements in lst that are IN in-lst
-(defun filter-in (lst in-lst)
-  (declare (xargs :guard (and (true-listp lst)
-                              (true-listp in-lst))))
-  (if (endp lst)
-      nil
-    (if (defdata::mem1 (car lst) in-lst)
-        (cons (car lst) (filter-in (cdr lst) in-lst))
-      (filter-in (cdr lst) in-lst))))
-;filter all elements in lst that are NOT IN in-lst 
-(defun filter-not-in (lst in-lst)
-  (declare (xargs :guard (and (true-listp lst)
-                              (true-listp in-lst))))
-  (if (endp lst)
-      nil
-    (if (not (defdata::mem1 (car lst) in-lst))
-        (cons (car lst) (filter-in (cdr lst) in-lst))
-      (filter-in (cdr lst) in-lst))))
-
-;self-explanatory code.
-;compose 2 finite functions basically
-(defun compose-two-alists (a-b-alst b-c-alst)
-  (declare (xargs :guard (and (alistp a-b-alst)
-                              (alistp b-c-alst))))
-   (if (endp a-b-alst)
-    nil
-    (let* ((a-b (car a-b-alst))
-           (a (car a-b))
-           (b (cdr a-b))
-           (c (defdata::get-val b b-c-alst))
-           (a-c (cons a c)))
-      (cons a-c
-            (compose-two-alists (cdr a-b-alst) b-c-alst)))))
-
-;just like subst, but uses equal for comparision.
-(defun subst-equal (new old tree)
-  (cond ((equal tree old) new)
-        ((atom tree) tree)
-        (t (cons (subst-equal new old (car tree))
-                 (subst-equal new old (cdr tree))))))
-
-(mutual-recursion
-;(ev-fncall-w FN ARGS W SAFE-MODE GC-OFF HARD-ERROR-RETURNS-NILP AOK)
-;I use sumners default values for
-;               nil    ; safe-mode
-;               t      ; gc-off
-;               nil    ; hard-error-returns-nilp
-;               nil    ; aok
-
-
-(defun my-ev-w (term alist ctx w hard-error-returns-nilp)
-"special eval function that does not need state and 
-cannot handle if, return-last,mv-list, stobjs, wormhole etc
-very restrictive
-Mainly to be used for evaluating enum lists "
-;Close to ev-rec in translate.lisp
-(declare (xargs :mode :program
-                :guard (and (acl2::termp term w)
-                            (plist-worldp w)
-                            (symbol-alistp alist)
-                            (booleanp hard-error-returns-nilp))))
- 
-(b* (((when (acl2::variablep term))
-;variable expression
-      (let ((v (assoc-eq term alist))) ;bugfix (removed cdr).
-;(earlier, if term had a value NIL, we were errorneusly
-;crashing!!!
-        (if v ;not null 
-          (mv nil (cdr v))
-          (prog2$
-           (er hard ctx "Unbound variable ~x0.~%" term)
-           (mv t term)))))
-;quoted expression
-     ((when (acl2::fquotep term))
-      (mv nil (cadr term)))
-;if expression
-     ((when (eq (car term) 'if))
-      (prog2$ 
-       (er hard ctx "IF expressions not supported at the moment.~%")
-       (mv t term)))
-;function expression
-     ((mv args-er args)
-      (my-ev-w-lst (cdr term) alist ctx
-                   w hard-error-returns-nilp))
-     ((when args-er)
-      (prog2$ 
-       (er hard ctx "Eval args failed~%")
-       (mv t term)))
-     ((when (acl2::flambda-applicationp term))
-      (my-ev-w (acl2::lambda-body (car term))
-               (acl2::pairlis$ (acl2::lambda-formals (car term)) args)
-               ctx w hard-error-returns-nilp)))
-    (acl2::ev-fncall-w (car term) args w
-                       nil nil t hard-error-returns-nilp nil)))
-
-(defun my-ev-w-lst (term-lst alist 
-                             ctx w hard-error-returns-nilp)
-"special eval function that does not need state and 
-cannot handle return-last,mv-list, stobjs, wormhole etc
-very restrictive
-Mainly to be used for evaluating enum lists "
-;Close to ev-rec-lst in translate.lisp
-(declare (xargs :mode :program
-                :guard (and (acl2::term-listp term-lst w)
-                            (plist-worldp w)
-                            (symbol-alistp alist)
-                            (booleanp hard-error-returns-nilp))))
-(if (endp term-lst)
-    (mv nil nil)
-  (b* (((mv erp1 car-ans) 
-        (my-ev-w (car term-lst) alist 
-                 ctx w hard-error-returns-nilp))
-       ((when erp1) 
-        (prog2$ 
-         (er hard ctx "eval ~x0 failed~%" (car term-lst))
-         (mv t term-lst)))
-       ((mv erp2 cdr-ans) 
-        (my-ev-w-lst (cdr term-lst) alist 
-                     ctx w hard-error-returns-nilp))
-       ((when erp2) 
-        (prog2$ 
-         (er hard ctx "eval failed~%")
-         (mv t term-lst))))
-    (mv nil (cons car-ans cdr-ans)))))
-)
-  
-
-(defun trans-my-ev-w (form ctx w hard-error-returns-nilp)
-(declare (xargs :mode :program
-                :guard (and (plist-worldp w)
-                            (booleanp hard-error-returns-nilp))))
-
-  (mv-let 
-   (erp term x) 
-   (acl2::translate11 form nil nil nil nil nil
-                ctx w (acl2::default-state-vars nil))
-   (declare (ignore x))
-   (if erp
-       (if hard-error-returns-nilp
-           (mv erp form)
-         (prog2$ 
-          (er hard ctx "~x0 could not be translated.~%" form)
-          (mv erp form)))
-     (my-ev-w term nil ctx w hard-error-returns-nilp))))
-
-(defun all-vars-in-var-term-alst (alst)
-  (declare (xargs :guard (alistp alst)
-                  :verify-guards nil
-                              ))
-  ;key might be a term in case of generalization TODO.CHECK
-;value is always a term, so we gets free-vars from them 
-  (union-eq (get-free-vars1-lst (strip-cars alst) nil)
-            (get-free-vars1-lst (strip-cdrs alst) nil)))
-
-;collect matching key-value pairs in an alist
-;if var in 'vars' has a value in 'bindings', then collect it
-(defun occurring-var-bindings (bindings vars)
-  (declare (xargs :guard (and (true-listp vars)
-                              (symbol-alistp bindings))))
-  (if (endp vars)
-    nil
-    (let ((b (assoc-eq (car vars) bindings)))
-      (if b
-        (cons b (occurring-var-bindings bindings (cdr vars)))
-        (occurring-var-bindings bindings (cdr vars))))))
-
-
-; every cons(that is not quoted) and list in the value list 
-; bindings is quoted to avoid errors in evaluation
-(defun quote-conses-and-symbols-in-bindings (val-bs)
-;val-bs is kind of let binding
-  (declare (xargs :guard (symbol-doublet-listp val-bs)))
-  (if (endp val-bs)
-    nil
-    (b* (((list var val) (car val-bs)))
-      (if (or (symbolp val)
-              (and (consp val) (not (equal (car val) 'quote))))
-        (cons (list var (list 'quote val))
-              (quote-conses-and-symbols-in-bindings (cdr val-bs)))
-        (cons (list var val) 
-              (quote-conses-and-symbols-in-bindings (cdr val-bs)))))))
-
-(defun filter-symbol-keys-in-alist (alst)
-  "Given an alist, it filters the entries that have
-   symbols as the keys(first elem of cons)"
-  (declare (xargs :guard (alistp alst)))
-  (if (endp alst)
-    nil
-    (if (symbolp (caar alst))
-      (cons (car alst) (filter-symbol-keys-in-alist (cdr alst)))
-      (filter-symbol-keys-in-alist (cdr alst)))))#|ACL2s-ToDo-Line|#
-
-(defun symbol-list-listp (v)
-  (declare (xargs :guard T))
-  (if (atom v)
-      (null v)
-    (and (symbol-listp (car v))
-         (symbol-list-listp (cdr v)))))
-
-(defun order-var-te-alist. (A connected-vs-lst ans.)
-  "helper to order-var-te-alist"
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbol-alistp A)
-                              (symbol-list-listp connected-vs-lst)
-                              (symbol-alistp ans.))))
-  (if (endp connected-vs-lst)
-      ans.
-    (b* ((vs        (car connected-vs-lst))
-         (tes       (get-val-lst vs A))
-         (A-partial (cons-up-lists vs tes)))
-     (order-var-te-alist.  A (cdr connected-vs-lst)
-                            (append ans. A-partial)))))
-
-(defun order-var-te-alist (A connected-vs-lst)
-  "order var-type-expression-dlist using connected-vertices information"
-  (declare (xargs :verify-guards nil
-                  :guard (and (symbol-alistp A)
-                              (symbol-list-listp connected-vs-lst))))
-                            
-  (if (null connected-vs-lst)
-      A
-    (order-var-te-alist. A connected-vs-lst '() )))
diff -Nru acl2-6.2/books/countereg-gen/with-timeout-raw.lsp acl2-6.3/books/countereg-gen/with-timeout-raw.lsp
--- acl2-6.2/books/countereg-gen/with-timeout-raw.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/with-timeout-raw.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,116 +0,0 @@
-;Author: Harsh Raju Chamarthi, Matt Kaufmann
-;Acknowledgements: Thanks to Gary Byers, Gary Warren King, Bob Boyer,
-;David Rager
-;
-
-(in-package "ACL2")
-
-
-;; ;Taken from memoize-raw.lisp 
-;; #+Clozure
-;; (defun make-watchdog (duration)
-;; ;   Thanks to Gary Byers for this!
-
-;;    (let* ((done (ccl:make-semaphore))
-;;           (current ccl:*current-process*))
-;;       (ccl::process-run-function "watchdog"
-;;         (lambda ()
-;;           (or (ccl:timed-wait-on-semaphore done duration)
-;;               (ccl:process-interrupt
-;;                current #'timeout-hard-error 'with-timeout
-;;                                  '"Time exceeded"
-;;                                  'nil *the-live-state*))))
-;;       done)) 
-
-;; (defmacro with-timeout-raw (duration body) ;duration in seconds
-;; #+Clozure
-;; `(let* ((semaphore (make-watchdog ,duration)))
-;;    (unwind-protect
-;;        ,body
-;;      (ccl:signal-semaphore semaphore)))
-
-;; #+sb-thread ;Thanks to Gary Warren King for this!
-;;   `(handler-case 
-;;     (sb-ext:with-timeout ,duration ,body)
-;;     (sb-ext::timeout (c)
-;;                      (declare (ignore c))
-;;                      (timeout-hard-error 'with-timeout
-;;                              '"Time exceeded"
-;;                              'nil *the-live-state*)))
-
-;;)
-
-;harshrc: Thanks to Matt for the following email snippet whose ideas
-;I used to implement nested timeouts.
-
-;; I think you know how to write a function (timer n) that causes an
-;; error after n seconds.  Presumably you could write it so that instead
-;; of (er hard ...), it does (throw 'timeout-tag *timeout-val*).
-
-;i need `throw' to be be a function to be used in process-interrupt,
-;so had to define the following. Does that screw the semantics of
-;usage of macro throw?
-(defun throw1 (tag form)
-  (throw tag form))
-
-#+Clozure
-(defun make-watchdog (duration id)
-;   Thanks to Gary Byers for this! --adapted from memoize-raw.lisp
-
-   (let* ((done (ccl:make-semaphore))
-          (current ccl:*current-process*))
-      (ccl::process-run-function "watchdog"
-        (lambda ()
-          (or (ccl:timed-wait-on-semaphore done duration)
-              (ccl:process-interrupt
-               current #'throw1 id id))))
-      done))
-
-(defmacro with-timeout-raw (duration id body) ;duration
-
-; Note: all args are expressions that are expected to be evaluated.
-
-  ;; duration in seconds with
-  ;; id which is a unique timeout identifier
-  #+Clozure
-  `(let ((semaphore (make-watchdog ,duration ',id))
-;close the environment
-         ;(closure #'(lambda () ,body))
-         )
-     (unwind-protect
-         ;(funcall closure)
-         ,body
-       (ccl:signal-semaphore semaphore)))
-
-  #+sb-thread ;Thanks to Gary Warren King for this!
-  `(handler-case 
-    (sb-ext:with-timeout ,duration ,body)
-    (sb-ext::timeout (c)
-                     (declare (ignore c))
-                     (throw1 ',id ',id))))
-
-
-; For debugging
-#||
-(defmacro catch1 (tag arg)
-  `(progn (format t "Set up catcher: ~s~%" '(,tag ,arg))
-          (let ((vals (catch ,tag (multiple-value-list ,arg))))
-            (format t "Catcher worked:~%~s~%" vals)
-            vals)))
-||#
-
-(defmacro catch1 (tag arg)
-  `(catch ,tag (multiple-value-list ,arg)))
-
-(defmacro with-timeout-aux-raw (&whole whole duration/timeout-form body)
-  (case-match duration/timeout-form
-    (('quote (duration timeout-form))
-     (let ((timeout-id (acl2-gentemp "WITH-TIMEOUT$")))
-       `(let ((vals (catch1 ',timeout-id
-                            (with-timeout-raw ,duration
-                                              ,timeout-id
-                                              ,body))))
-          (cond ((eq vals ',timeout-id)
-                 ,timeout-form)
-                (t (values-list vals))))))
-    (& (error "Illegal call in with-timeout-aux-raw:~%~s~%" whole))))
diff -Nru acl2-6.2/books/countereg-gen/with-timeout.lisp acl2-6.3/books/countereg-gen/with-timeout.lisp
--- acl2-6.2/books/countereg-gen/with-timeout.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/countereg-gen/with-timeout.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,146 +0,0 @@
-#|$ACL2s-Preamble$;
-(begin-book t :ttags ((:acl2s-timeout)))
-;$ACL2s-Preamble$|#
-
-;Author: Harsh Raju Chamarthi
-;Acknowledgements: Many thanks to Matt Kaufmann.
-
-(in-package "ACL2")
-(include-book "xdoc/top" :dir :system)
-
-(defxdoc with-timeout
-  :short "Evaluate form with a timeout (in seconds)"
-  :long "Evaluate form with a timeout in seconds. The syntax of
-  this macro is (with-timeout <i>duration</i> <i>body</i>
-  <i>timeout-form</i>). 
-  A duration of 0 seconds disables the timeout mechanism, 
-  i.e its a no-op. Otherwise, if <i>duration</i> seconds elapse
-  during evaluation of <i>body</i> then the evaluation is
-  aborted and the value of <tt>timeout-form</tt> is returned,
-  otherwise returns the value of <tt>body</tt>. The signature of 
-  <tt>body</tt> and <tt>timeout-form</tt> should be the same.
-  
-  
-  Advanced Notes:
-  This form should be called either at the top-level or in an environment
-  where state is available and <tt>body</tt> has no free variables
-  other than state.
-  If the timeout-form is a long running computation, 
-  then the purpose of with-timeout is defeated.
-
-  <code>
-  Usage:
-  (with-timeout 5 (fibonacci 40) :timeout)
-   :doc with-timeout
-  </code>"
-  )
-
-(defttag :acl2s-timeout)
-
-
-(defun timeout-hard-error (ctx str alist state)
-  (declare (xargs :mode :program
-                  :stobjs (state)))
-  (er-progn
-   (assign acl2::timeout-error-occurred t)
-   (mv t (hard-error ctx str alist) state)))
-   
-
-(progn!
- (set-raw-mode t)
- (load (concatenate 'string (cbd) "with-timeout-raw.lsp")))
-
-
-(defmacro-last with-timeout-aux)
-
-;adapted from the macro top-level in other-events.lisp
-;TODO:  I do not believe this is not a general solution --Ask Matt!
-;A general solution might have to use trans-eval or ld explicitly
-;inside the function body, which sounds ugly
-(defmacro timed-eval-of-event (duration form timeout-form
-                                        submit-eventp debug)
-  "evaluate event form as a function body, so that with-timeout-aux doesnt
-   complain, but also do a macroexpand1 so that forms like
-  defun,defthm wont complain. Form should have no free 
-  variables (other than state), i.e it should be a top-level form"
-  `(with-output
-    :stack :push
-    :off :all
-    ;:on error
-    (make-event
-     (acl2::state-global-let*
-      ((acl2::inhibit-output-lst 
-        (and (not ,debug)
-             acl2::*valid-output-names*)))
-   
-        (mv-let 
-      (erp tform state)
-      (trans1-fn ',form state);do macroexpand1
-      (if erp
-          (er soft 'with-timeout-ev "~|Error in with-timeout-ev: To see, run ~x0~%"
-              '(trans1-fn ',form state))
-        (er-progn 
-         (ld `((defun top-level-fn (state)
-                 (declare (xargs :mode :program :stobjs state)
-                          (ignorable state))
-                 (with-timeout1 ,',duration ,tform ,',timeout-form))
-              ; (acl2s-defaults :set verbosity-level 0);turn off testing output
-;output here wjhen checking timeout
-               (with-output
-                :stack :pop
-                (top-level-fn state)))
-;Note: Suppose form is a defthm/defun, then obviously it will
-;never be registered in the world as an event. And so we have an
-;extra argument which specifies if the form you passed is to be submitted 
-             :ld-pre-eval-print nil
-             :ld-post-eval-print nil
-             :ld-error-action :error
-             :ld-verbose nil
-             :ld-prompt nil)
-;if everything went well, then obviously the form didnt timeout and
-;didnt error out, i.e was successful, either QED or termination, and so
-;we presume that a call without a timeout wrapper should be successful 
-;and we try it. This is a common scenario in defunc. But probably this
-;is not a clean way to do things
-         (value (if ,submit-eventp 
-                    `(with-output :stack :pop
-                                  ,',form) 
-                  '(value-triple :invisible))))))))))
-
-(defmacro with-timeout-ev (duration event-form timeout-form 
-                                    &key submit-eventp debug
-                                    )
-  `(if (zp ,duration) ;if 0 or not a int then timeout is disabled
-      ,event-form
-     (timed-eval-of-event ,duration ,event-form 
-                          ,timeout-form
-                          ,submit-eventp ,debug)))
-
-
-(defmacro with-timeout (duration form timeout-form)
-"can only be called at top-level, that too only forms that are allowed
-to be evaluated inside a function body. To eval defthm, use
-with-timeout-ev instead"
-`(if (zp ,duration) ;if 0 or not a int then timeout is disabled
-     ,form
-   (top-level (with-timeout1 ,duration ,form ,timeout-form))))
-
-
-;the following is for internal use only. I use it in timing out
-;top-level-test? form, where i manually make a function body
-;corresponding to the top-level-test?-fn, this way I dont have to
-;worry about capturing free variables
-
-(defmacro with-timeout1 (duration form timeout-form)
-"can only be used inside a function body, and if form has
-free variables other than state, then manually make a function
-which takes those free variables as arguments and at the calling
-context, pass the arguments, binding the free variables.
-See top-level-test? macro for an example"
-`(if (zp ,duration) ;if 0 or not a int then timeout is disabled
-    ,form
-  (with-timeout-aux '(,duration ,timeout-form) ,form)))
-
-(defttag nil) ; optional (books end with this implicitly)
-
-
diff -Nru acl2-6.2/books/cowles/LICENSE acl2-6.3/books/cowles/LICENSE
--- acl2-6.2/books/cowles/LICENSE	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cowles/LICENSE	2013-09-30 17:52:18.000000000 +0000
@@ -0,0 +1,35 @@
+ACL2 Community Books directory cowles/
+Author: John Cowles
+
+Note: The license below is based on the template at:
+http://opensource.org/licenses/BSD-3-Clause
+
+Copyright (C) 2013, University of Wyoming
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+o Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+o Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+
+o Neither the name of the University of Texas, Austin nor the names of
+  its contributors may be used to endorse or promote products derived
+  from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff -Nru acl2-6.2/books/cowles/acl2-agp.lisp acl2-6.3/books/cowles/acl2-agp.lisp
--- acl2-6.2/books/cowles/acl2-agp.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/cowles/acl2-agp.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,6 @@
+; Written by John Cowles
+; Copyright/License: See the LICENSE file in this directory.
+
 #| This is the .lisp file for the Abelian Group book.
 
    John Cowles, University of Wyoming, Summer 1993
diff -Nru acl2-6.2/books/cowles/acl2-asg.lisp acl2-6.3/books/cowles/acl2-asg.lisp
--- acl2-6.2/books/cowles/acl2-asg.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/cowles/acl2-asg.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,6 @@
+; Written by John Cowles
+; Copyright/License: See the LICENSE file in this directory.
+
 #| This is the .lisp file for the Abelian SemiGroup book.
 
    John Cowles, University of Wyoming, Summer 1993
diff -Nru acl2-6.2/books/cowles/acl2-crg.lisp acl2-6.3/books/cowles/acl2-crg.lisp
--- acl2-6.2/books/cowles/acl2-crg.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/cowles/acl2-crg.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,6 @@
+; Written by John Cowles
+; Copyright/License: See the LICENSE file in this directory.
+
 #| This is the .lisp file for the Commutative Ring book.
 
    John Cowles, University of Wyoming, Summer 1993
diff -Nru acl2-6.2/books/cowles/cert.acl2 acl2-6.3/books/cowles/cert.acl2
--- acl2-6.2/books/cowles/cert.acl2	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/cowles/cert.acl2	2013-09-30 17:52:18.000000000 +0000
@@ -1 +1,4 @@
+; Written by John Cowles
+; Copyright/License: See the LICENSE file in this directory.
+
 (ld "packages.lsp")
\ No newline at end of file
diff -Nru acl2-6.2/books/cowles/packages.lsp acl2-6.3/books/cowles/packages.lsp
--- acl2-6.2/books/cowles/packages.lsp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/cowles/packages.lsp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,6 @@
+; Written by John Cowles
+; Copyright/License: See the LICENSE file in this directory.
+
 (defpkg 
   "ACL2-CRG"
   (set-difference-equal
diff -Nru acl2-6.2/books/cutil/da-base.lisp acl2-6.3/books/cutil/da-base.lisp
--- acl2-6.2/books/cutil/da-base.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/da-base.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -52,6 +52,20 @@
     :rule-classes :forward-chaining
     :hints(("Goal" :in-theory (enable tag)))))
 
+(deftheory defaggregate-basic-theory
+  (union-theories
+   '(tag
+     car-cons
+     cdr-cons
+     alistp
+     assoc-equal
+     hons
+     booleanp
+     booleanp-compound-recognizer
+     tag)
+   (theory 'minimal-theory)))
+
+
 (program)
 
 ; NAME GENERATION.  We introduce some functions to generate the names of
@@ -270,7 +284,24 @@
   ;; inline accessors.
   (let ((foo (da-constructor-name basename)))
     `(defund ,foo ,fields
-       (declare (xargs :guard ,guard))
+       (declare (xargs :guard ,guard
+                       :guard-hints
+                       (("Goal" :in-theory (theory 'minimal-theory))
+                        (and stable-under-simplificationp
+                             ;; I hadn't expected to need to do this, because
+                             ;; the constructor is just consing something
+                             ;; together, so how could it have guard
+                             ;; obligations?
+                             ;;
+                             ;; But it turns out that it CAN have other guard
+                             ;; obligations, since the ,guard above can be
+                             ;; arbitrarily complicated.  So, we will rely on
+                             ;; the user to provide a theory that can satisfy
+                             ;; these obligations.
+                             ;;
+                             ;; This looks like it does nothing, but really it
+                             ;; "undoes" the in-theory event above.
+                             '(:in-theory (enable ))))))
        ,(da-pack-fields honsp legiblep tag fields))))
 
 (defun da-make-honsed-constructor-raw (basename tag fields guard legiblep)
@@ -278,7 +309,14 @@
         (honsed-foo (da-honsed-constructor-name basename)))
     `(defun ,honsed-foo ,fields
        (declare (xargs :guard ,guard
-                       :guard-hints(("Goal" :in-theory (enable ,foo)))))
+                       ;; Same hints as for the ordinary constructor
+                       :guard-hints
+                       (("Goal"
+                         :in-theory (union-theories
+                                     '(,foo)
+                                     (theory 'minimal-theory)))
+                        (and stable-under-simplificationp
+                             '(:in-theory (enable ))))))
        (mbe :logic (,foo . ,fields)
             :exec ,(da-pack-fields t legiblep tag fields)))))
 
@@ -294,7 +332,25 @@
          (fields-map (da-fields-map basename tag legiblep fields))
          (let-binds  (da-fields-map-let-bindings fields-map)))
   `(defund ,foo-p (,x)
-     (declare (xargs :guard t))
+     (declare (xargs :guard t
+                     :guard-hints
+                     (("Goal"
+                       :in-theory (union-theories
+                                   '((:executable-counterpart acl2::eqlablep)
+                                     acl2::consp-assoc-equal
+                                     acl2::assoc-eql-exec-is-assoc-equal)
+                                   (theory 'defaggregate-basic-theory)))
+                      (and stable-under-simplificationp
+                           ;; This looks like it does nothing, but the basic
+                           ;; effect is to undo the "goal" theory and go back
+                           ;; into the default theory.
+                           ;;
+                           ;; This is sometimes necessary because the later
+                           ;; requirements might have guards that depend on the
+                           ;; previous requirements.  The user needs to provide
+                           ;; a theory that is adequate to show this is the
+                           ;; case.
+                           '(:in-theory (enable ))))))
      (and ,@(if tag
                 `((consp ,x)
                   (eq (car ,x) ,tag))
@@ -315,7 +371,17 @@
         (body     (cdr (assoc field map))))
   `(defund-inline ,foo->bar (,x)
      (declare (xargs :guard (,foo-p ,x)
-                     :guard-hints (("Goal" :in-theory (enable ,foo-p)))))
+                     :guard-hints (("Goal"
+                                    ;; expand hint sometimes needed due to mutual
+                                    ;; recursions
+                                    :expand (,foo-p ,x)
+                                    :in-theory
+                                    (union-theories
+                                     '(,foo-p
+                                       (:executable-counterpart acl2::eqlablep)
+                                       acl2::consp-assoc-equal
+                                       acl2::assoc-eql-exec-is-assoc-equal)
+                                     (theory 'defaggregate-basic-theory))))))
      ,body)))
 
 #||
@@ -347,7 +413,11 @@
              basename)
      (equal (,foo->bar (,foo . ,all-fields))
             ,field)
-     :hints(("Goal" :in-theory (enable ,foo->bar ,foo))))))
+     :hints(("Goal"
+             :in-theory
+             (union-theories
+              '(,foo->bar ,foo)
+              (theory 'defaggregate-basic-theory)))))))
 
 (defun da-make-accessors-of-constructor-aux (basename fields all-fields)
   (if (consp fields)
@@ -474,46 +544,35 @@
 
 (defun da-patbind-make-field-vars-alist (var fields)
   ;; Given var = 'foo and fields = '(a b c),
-  ;; Constructs '((a . foo.a) (b . foo.b) (c . foo.c))
+  ;; Constructs '(("FOO.A" . a) ("FOO.B" . b) ("FOO.C" . c))
   (if (atom fields)
       nil
-    (acons (car fields)
-           (intern-in-package-of-symbol
-            (concatenate 'string (symbol-name var) "." (symbol-name (car fields)))
-            var)
-          (da-patbind-make-field-vars-alist var (cdr fields)))))
-
-(defun da-patbind-find-unused-vars (form vars)
-  ;; Return all vars not used in form.  We do this completely stupidly, not
-  ;; even avoiding quoted constants.  We can try to improve this if it's a
-  ;; problem, but at some level what we're trying to do is inherently broken
-  ;; anyway -- we just hope it's useful most of the time anyway.
+    (acons (concatenate 'string (symbol-name var) "." (symbol-name (car fields)))
+           (car fields)
+           (da-patbind-make-field-vars-alist var (cdr fields)))))
+
+(defun da-patbind-find-used-vars (form varstrs acc)
+  ;; Varstrs is a list of strings such as "X.FOO" "X.BAR" etc.
+  ;; Acc accumulates (uniquely) all the symbols in FORM for which the
+  ;; symbol-name is in varstrs.
   (if (atom form)
-      (if (symbolp form)
-          (remove1 form vars)
-        vars)
-    (da-patbind-find-unused-vars (car form)
-                                 (da-patbind-find-unused-vars (cdr form) vars))))
-
-;; (da-patbind-find-unused-vars '(foo (+ 1 a) c) '(a b c d)) --> '(b d)
+      (if (and (symbolp form)
+               (member-equal (symbol-name form) varstrs)
+               (not (member-eq form acc)))
+          (cons form acc)
+        acc)
+    (da-patbind-find-used-vars (car form) varstrs
+                               (da-patbind-find-used-vars (cdr form) varstrs acc))))
 
-(defun da-patbind-remove-unused-vars (valist unused)
-  (cond ((atom valist)
-         nil)
-        ((member (cdar valist) unused)
-         (da-patbind-remove-unused-vars (cdr valist) unused))
-        (t
-         (cons (car valist)
-               (da-patbind-remove-unused-vars (cdr valist) unused)))))
-
-(defun da-patbind-alist-to-bindings (name valist target)
-  (if (atom valist)
+(defun da-patbind-alist-to-bindings (name vars valist target)
+  (if (atom vars)
       nil
-    (let* ((accessor (da-accessor-name name (caar valist)))
+    (let* ((fldname (cdr (assoc-equal (symbol-name (car vars)) valist)))
+           (accessor (da-accessor-name name fldname))
            (call     (list accessor target))     ;; (taco->shell foo)
-           (binding  (list (cdar valist) call))) ;; (x.foo (taco->shell foo))
+           (binding  (list (car vars) call))) ;; (x.foo (taco->shell foo))
       (cons binding
-            (da-patbind-alist-to-bindings name (cdr valist) target)))))
+            (da-patbind-alist-to-bindings name (cdr vars) valist target)))))
 
 
 (defun da-patbind-fn (name fields args forms rest-expr)
@@ -529,10 +588,9 @@
 
        (var             (car args))
        (full-vars-alist (da-patbind-make-field-vars-alist var fields))
-       (field-vars      (strip-cdrs full-vars-alist))
-       (unused-vars     (da-patbind-find-unused-vars rest-expr field-vars))
-       (vars-alist      (da-patbind-remove-unused-vars full-vars-alist unused-vars))
-       ((unless vars-alist)
+       (field-vars      (strip-cars full-vars-alist))
+       (used-vars       (da-patbind-find-used-vars rest-expr field-vars nil))
+       ((unless used-vars)
         (progn$
          (cw "Note: not introducing any ~x0 field bindings for ~x1, since ~
               none of its fields appear to be used.~%" name var)
@@ -549,7 +607,7 @@
        (binding  (if forms (car forms) var))
        (evaledp  (or (atom binding) (eq (car binding) 'quote)))
        (target   (if evaledp binding (acl2::pack binding)))
-       (bindings (da-patbind-alist-to-bindings name vars-alist target))
+       (bindings (da-patbind-alist-to-bindings name used-vars full-vars-alist target))
 
        ;;(- (cw "Binding is ~x0.~%" var))
        ;;(- (cw "Evaledp is ~x0.~%" var))
@@ -602,4 +660,4 @@
      ((employee emp) emp))
   emp.name)
 
-||#
\ No newline at end of file
+||#
diff -Nru acl2-6.2/books/cutil/defaggregate.lisp acl2-6.3/books/cutil/defaggregate.lisp
--- acl2-6.2/books/cutil/defaggregate.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/defaggregate.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -25,11 +25,12 @@
 (in-package "CUTIL")
 (include-book "da-base")
 (include-book "formals")
-(include-book "xdoc-impl/fmt-to-str" :dir :system)
+(include-book "xdoc/fmt-to-str" :dir :system)
 (include-book "tools/rulesets" :dir :system)
 (include-book "xdoc/names" :dir :system)
 (include-book "str/cat" :dir :system)
 (set-state-ok t)
+
 (program)
 
 (def-ruleset tag-reasoning nil)
@@ -261,6 +262,14 @@
 will follow some automatically generated documentation that describes the
 fields of the aggregate.</dd>
 
+<dt>:extra-field-keywords</dt>
+
+<dd>Advanced option for people who are writing extensions of @('defaggregate').
+This tells defaggregate to tolerate (and ignore) certain additional keywords in
+its fields.  The very advanced user can then inspect these fields after
+submitting the aggregate, and perhaps use them to generate additional
+events.</dd>
+
 <dt>:require</dt>
 
 <dd>This option is deprecated.  Please use the new fields syntax, instead.</dd>
@@ -374,49 +383,60 @@
 ;; defined predicate can be called many times, even during proofs, so the use of
 ;; @(':debugp') can result in a large amount of extra output.</p>
 
-
-
 ;; The remainder of this file just introduces the defaggregate macro.  We never
 ;; care about reasoning about these functions, so we go ahead and implement
 ;; them in program mode.
 
 
+; AGGREGATES TABLE ------------------------------------------------------------
+;
+; We save some information about each aggregate that is defined into the table
+; below.  A sufficiently advanced user can exploit this table to do various
+; kinds of macro magic.
+
+(def-primitive-aggregate agginfo
+  (tag     ;; The :tag for the aggregate, a symbol
+   name    ;; The base name for the aggregate
+   fields  ;; The field names with no extra info, a symbol-list
+   efields ;; The parsed formallist-p that has basic type requirements.
+   ;; It'd be easy to add additional fields later on.
+   )
+  :tag :agginfo)
 
 (table defaggregate)
-(table defaggregate 'aggregates
-       ;; An alist binding NAME -> INFO structures, see DA-EXTEND-TABLE
-       )
+(table defaggregate 'aggregates) ;; Alist of NAME -> AGGINFO structures
 
 (defun get-aggregates (world)
   "Look up the current alist of defined aggregates."
   (cdr (assoc 'aggregates (table-alist 'defaggregate world))))
 
-(defmacro da-extend-table (name fields)
-  ;; For now an INFO structure will just have the fields, but we can extend
-  ;; this later if desired.
+(defun get-aggregate (name world)
+  "NAME is the name of the aggregate, e.g., FOO for (defaggregate foo ...).
+   Look up its AGGINFO or return NIL if no such aggregate is defined."
+  (cdr (assoc name (get-aggregates world))))
+
+(defmacro da-extend-agginfo-table (agginfo)
   `(table defaggregate 'aggregates
-          (cons (cons ,name (list (cons :fields ,fields)))
+          (cons (cons (agginfo->name ,agginfo) ,agginfo)
                 (get-aggregates world))))
 
-(defun get-aggregate-fields (name world)
-  "Return the field names for an aggregate."
-  (b* ((alist (get-aggregates world))
-       (entry (assoc name alist))
-       ((unless entry)
-        (er hard? 'get-aggregate-fields
-            "~x0 was not found in the aggregates alist." name))
-       (info (cdr entry))
-       (look (and (alistp info)
-                  (assoc :fields info)))
-       ((unless look)
-        (er hard? 'get-aggregate-fields
-            "~x0 has a malformed entry in the aggregates alist." name)))
-    (cdr look)))
-
-;(da-extend-table 'buffalo '(horns face body legs hooves))
-;(da-extend-table 'cat '(eyes ears teeth claws fur))
-;(get-aggregate-fields 'buffalo (w state))
-;(get-aggregate-fields 'cat (w state))
+#||
+
+(da-extend-agginfo-table 'buffalo
+                         (make-agginfo :tag :buffalo
+                                       :name 'buffalo
+                                       :fields '(horns face body legs hooves)))
+
+(da-extend-agginfo-table 'cat
+                         (make-agginfo :tag :cat
+                                       :name 'cat
+                                       :fields '(eyes ears teeth claws fur)))
+
+(get-aggregate 'buffalo (w state))
+(get-aggregate 'cat     (w state))
+(get-aggregate 'lizard  (w state))
+
+||#
 
 
 
@@ -595,7 +615,11 @@
        (implies (force (,(da-recognizer-name name) ,(da-x name)))
                 ,(ACL2::sublis map (second require)))
        :rule-classes ,rule-classes
-       :hints(("Goal" :in-theory (enable ,(da-recognizer-name name) ,@accnames))))))
+       :hints(("Goal"
+               :in-theory
+               (union-theories
+                '(,(da-recognizer-name name) . ,accnames)
+                (theory 'defaggregate-basic-theory)))))))
 
 (defun da-make-requirements-of-recognizer-aux (name require map accnames)
   (if (consp require)
@@ -715,13 +739,226 @@
             (da-fields-autodoc name (cdr fields)))
     nil))
 
-(defun da-autodoc (name fields parents short long base-pkg state)
+(defun da-ctor-optional-fields (fields)
+  (declare (xargs :guard (formallist-p fields)))
+  (b* (((when (atom fields))
+        nil)
+       (name1 (xdoc::name-low (symbol-name (formal->name (car fields)))))
+       (len1  (length name1))
+       (acc   nil)
+       (acc   (str::revappend-chars "[:" acc))
+       (acc   (xdoc::simple-html-encode-str name1 0 len1 acc))
+       (acc   (str::revappend-chars " &lt;" acc))
+       (acc   (xdoc::simple-html-encode-str name1 0 len1 acc))
+       (acc   (str::revappend-chars "&gt;]" acc)))
+    (cons (str::rchars-to-string acc)
+          (da-ctor-optional-fields (cdr fields)))))
+
+(defconst *nl* (str::implode (list #\Newline)))
+
+(defun da-ctor-optional-call (name        ; e.g., make-honsed-foo
+                              field-strs  ; e.g., ("[:field1 <field1>]" "[field2 <field2>"])
+                              )
+  (declare (xargs :guard (and (symbolp name)
+                              (string-listp field-strs))))
+  (b* ((ctor-name (xdoc::name-low (symbol-name name)))
+       ;; +2 to account for the leading paren and trailing space after ctor-name 
+       (len       (+ 2 (length ctor-name)))
+       (pad       (str::implode (cons #\Newline (repeat #\Space len))))
+       (args      (str::join field-strs pad)))
+    (str::cat "<code>" *nl* "(" ctor-name " " args ")" *nl* "</code>")))
+
+#||
+
+(da-ctor-optional-call 'make-honsed-foo
+                       '("[:lettuce <lettuce>]"
+                         "[:cheese <cheese>]"
+                         "[:meat <meat>]"))
+
+(da-ctor-optional-call 'change-honsed-foo
+                       '("x"
+                         "[:lettuce <lettuce>]"
+                         "[:cheese <cheese>]"
+                         "[:meat <meat>]"))
+||#
+
+(defun da-ctor-autodoc (name fields honsp)
+  (declare (xargs :guard (and (symbolp name)
+                              (formallist-p fields))))
+  (b* ((foo                (da-constructor-name name))
+       (foo-p              (da-recognizer-name name))
+       (honsed-foo         (da-honsed-constructor-name name))
+       (make-foo-fn        (da-maker-fn-name name))
+       (make-foo           (da-maker-name name))
+       (make-honsed-foo    (da-honsed-maker-name name))
+       (make-honsed-foo-fn (da-honsed-maker-fn-name name))
+       (change-foo-fn      (da-changer-fn-name name))
+       (change-foo         (da-changer-name name))
+
+       (see-foo-p           (xdoc::see foo-p))
+       (plain-foo-p         (str::cat "<tt>" (xdoc::name-low (symbol-name foo-p)) "</tt>"))
+       (see-foo             (xdoc::see foo))
+       (see-honsed-foo      (xdoc::see honsed-foo))
+       (see-make-foo        (xdoc::see make-foo))
+       (see-make-honsed-foo (xdoc::see make-honsed-foo))
+       (see-change-foo      (xdoc::see change-foo))
+
+       (pkg               (symbol-package-name name))
+       (call-foo          (str::cat "@(ccall " pkg "::" (symbol-name foo) ")"))
+       (call-honsed-foo   (str::cat "@(ccall " pkg "::" (symbol-name honsed-foo) ")"))
+
+       ;; For make-foo, change-foo, etc., it's nicer to present a list of [:fld <fld>] options
+       ;; rather than just saying &rest args, which is what @(call ...) would do.
+       (opt-fields           (da-ctor-optional-fields fields))
+       (call-make-foo        (da-ctor-optional-call make-foo opt-fields))
+       (call-make-honsed-foo (da-ctor-optional-call make-honsed-foo opt-fields))
+       (call-change-foo      (da-ctor-optional-call change-foo (cons "x" opt-fields)))
+
+       (def-foo           (str::cat "@(def " pkg "::" (symbol-name foo) ")"))
+       (def-honsed-foo    (str::cat "@(def " pkg "::" (symbol-name honsed-foo) ")"))
+       (def-make-foo-fn   (str::cat "@(def " pkg "::" (symbol-name make-foo-fn) ")"))
+       (def-make-foo      (str::cat "@(def " pkg "::" (symbol-name make-foo) ")"))
+       (def-make-honsed-foo-fn (str::cat "@(def " pkg "::" (symbol-name make-honsed-foo-fn) ")"))
+       (def-make-honsed-foo    (str::cat "@(def " pkg "::" (symbol-name make-honsed-foo) ")"))
+       (def-change-foo-fn (str::cat "@(def " pkg "::" (symbol-name change-foo-fn) ")"))
+       (def-change-foo    (str::cat "@(def " pkg "::" (symbol-name change-foo) ")")))
+
+    (list
+     `(defxdoc ,foo
+        :parents (,foo-p)
+        :short ,(str::cat "Raw constructor for " see-foo-p " structures.")
+        :long ,(str::cat
+                "<p>Syntax:</p>" call-foo
+
+                "<p>This is the lowest-level constructor for " see-foo-p
+                " structures.  It simply conses together a structure with the
+                specified fields.</p>
+
+                <p><b>Note:</b> It's generally better to use macros like "
+                see-make-foo " or " see-change-foo " instead.  These macros
+                lead to more readable and robust code, because you don't have
+                to remember the order of the fields.</p>"
+
+                (if honsp
+                    (str::cat "<p>Note that we always use @(see acl2::hons) when
+                               creating " plain-foo-p " structures.</p>")
+                  (str::cat "<p>The " plain-foo-p " structures we create here
+                             are just constructed with ordinary @(see acl2::cons).
+                             If you want to create @(see acl2::hons)ed structures,
+                             see " see-honsed-foo " instead.</p>"))
+
+                "<h3>Definition</h3>
+
+                <p>This is an ordinary constructor function introduced by @(see
+                cutil::defaggregate).</p>"
+
+                def-foo))
+
+     `(defxdoc ,honsed-foo
+        :parents (,foo-p)
+        :short ,(str::cat "Raw constructor for @(see acl2::hons)ed " see-foo-p
+                          " structures.")
+        :long ,(str::cat
+                "<p>Syntax:</p> " call-honsed-foo
+
+                (if honsp
+                    (str::cat "<p>Since " see-foo-p " structures are always
+                              honsed, this is identical to " see-foo ".  We
+                              introduce it mainly for consistency with other
+                              @(see cutil::defaggregate) style structures.</p>")
+                  (str::cat "<p>This is identical to " see-foo ", except that
+                            we @(see acl2::hons) the structure we are
+                            creating.</p>"))
+
+                "<h3>Definition</h3>
+
+                <p>This is an ordinary honsing constructor introduced by @(see
+                cutil::defaggregate).</p>"
+
+                def-honsed-foo))
+
+     `(defxdoc ,make-foo
+        :parents (,foo-p)
+        :short ,(str::cat "Constructor macro for " see-foo-p " structures.")
+        :long ,(str::cat
+                "<p>Syntax:</p>" call-make-foo
+
+                "<p>This is our preferred way to construct " see-foo-p
+                " structures.  It simply conses together a structure with the
+                specified fields.</p>
+
+                <p>This macro generates a new " plain-foo-p " structure from
+                scratch.  See also " see-change-foo ", which can \"change\" an
+                existing structure, instead.</p>"
+
+                (if honsp
+                    (str::cat "<p>Note that we always use @(see acl2::hons) when
+                               creating " plain-foo-p " structures.</p>")
+                  (str::cat "<p>The " plain-foo-p " structures we create here
+                             are just constructed with ordinary @(see acl2::cons).
+                             If you want to create @(see acl2::hons)ed structures,
+                             see " see-make-honsed-foo " instead.</p>"))
+
+                "<h3>Definition</h3>
+
+                <p>This is an ordinary @('make-') macro introduced by @(see
+                cutil::defaggregate).</p>"
+
+                def-make-foo
+                def-make-foo-fn))
+
+     `(defxdoc ,make-honsed-foo
+        :parents (,foo-p)
+        :short ,(str::cat "Constructor macro for @(see acl2::hons)ed " see-foo-p
+                          " structures.")
+        :long ,(str::cat
+                "<p>Syntax:</p>" call-make-honsed-foo
+
+                (if honsp
+                    (str::cat "<p>Since " see-foo-p " structures are always
+                              honsed, this is identical to " see-make-foo ".
+                              We introduce it mainly for consistency with other
+                              @(see cutil::defaggregate)s.</p>")
+                  (str::cat "<p>This is identical to " see-make-foo ", except
+                            that we @(see acl2::hons) the structure we are
+                            creating.</p>"))
+
+                "<h3>Definition</h3>
+
+                <p>This is an ordinary honsing @('make-') macro introduced by
+                @(see cutil::defaggregate).</p>"
+
+                def-make-honsed-foo
+                def-make-honsed-foo-fn))
+
+     `(defxdoc ,change-foo
+        :parents (,foo-p)
+        :short ,(str::cat "A copying macro that lets you create new "
+                          see-foo-p " structures, based on existing structures.")
+        :long ,(str::cat
+                "<p>Syntax:</p>" call-change-foo
+
+                "<p>This is a sometimes useful alternative to " see-make-foo ".
+                It constructs a new " see-foo-p " structure that is a copy of
+                @('x'), except that you can explicitly change some particular
+                fields.  Any fields you don't mention just keep their values
+                from @('x').</p>
+
+                <h3>Definition</h3>
+
+                <p>This is an ordinary @('change-') macro introduced by @(see
+                cutil::defaggregate).</p>"
+
+                def-change-foo
+                def-change-foo-fn)))))
+
+(defun da-autodoc (name fields honsp parents short long base-pkg state)
   (declare (xargs :guard (formallist-p fields)))
   (b* (((mv main state)
         (da-main-autodoc name fields parents short long base-pkg state))
+       (ctors     (da-ctor-autodoc name fields honsp))
        (accessors (da-fields-autodoc name fields)))
-    (mv (cons main accessors) state)))
-
+    (mv (cons main (append ctors accessors)) state)))
 
 (defconst *da-valid-keywords*
   '(:tag
@@ -732,6 +969,7 @@
     :short
     :long
     :already-definedp
+    :extra-field-keywords
     ;; deprecated options
     :require
     :rest))
@@ -747,6 +985,8 @@
     (cons (formal->default (car x))
           (formallist->defaults (cdr x)))))
 
+
+#!CUTIL
 (defun defaggregate-fn (name rest state)
   (b* ((__function__ 'defaggregate)
 
@@ -760,11 +1000,14 @@
        ((mv kwd-alist field-specs)
         (extract-keywords ctx *da-valid-keywords* main-stuff nil))
 
+       (extra-field-keywords (cdr (assoc :extra-field-keywords kwd-alist)))
        ((unless (consp field-specs))
         (mv (raise "~x0: No fields given." name) state))
        ((unless (tuplep 1 field-specs))
         (mv (raise "~x0: Too many field specifiers: ~x1" name field-specs) state))
-       (efields     (parse-formals ctx (car field-specs) '(:rule-classes :default)))
+       (efields     (parse-formals ctx (car field-specs)
+                                   (append '(:rule-classes :default)
+                                           extra-field-keywords)))
        (field-names (formallist->names efields))
        (field-defaults (formallist->defaults efields))
        ((unless (no-duplicatesp field-names))
@@ -834,11 +1077,29 @@
                                                (symbol-name make-foo))
                                      name))
        ((mv doc-events state)
-        (da-autodoc name efields parents short long base-pkg state))
+        (da-autodoc name efields honsp parents short long base-pkg state))
+
+       (agginfo (make-agginfo :name    name
+                              :tag     tag
+                              :fields  field-names
+                              :efields efields))
+
+       (booleanp-of-foop (intern-in-package-of-symbol
+                          (concatenate 'string "BOOLEANP-OF-" (symbol-name foop))
+                          name))
 
        (event
         `(progn
-           (da-extend-table ',name ',field-names)
+
+; Note: the theory stuff here a bit ugly for performance.  Using progn instead
+; of encapsulate means we don't have a local scope to work with.  Just using
+; encapsulate instead slowed down vl/parsetree by 4 seconds, and when I added
+; ordinary, local theory forms, it slowed down the book from 40 seconds to 70
+; seconds!  So that was pretty horrible.  At any rate, the union-theory stuff
+; here is ugly, but at least it's fast.
+
+           (set-inhibit-warnings "theory") ;; implicitly local
+           (da-extend-agginfo-table ',agginfo)
            ,@doc-events
 
            ,(if (eq mode :logic)
@@ -855,7 +1116,6 @@
            ,@(and
               (eq mode :logic)
               `(
-
                 ;; (defthm ,(intern-in-package-of-symbol
                 ;;           (concatenate 'string (symbol-name make-foo) "-UNDER-IFF")
                 ;;           name)
@@ -871,23 +1131,25 @@
                   :rule-classes :type-prescription
                   :hints(("Goal" :in-theory (enable ,make-foo))))
 
-                (defthm ,(intern-in-package-of-symbol
-                          (concatenate 'string "BOOLEANP-OF-" (symbol-name foop))
-                          name)
+                (defthm ,booleanp-of-foop
                   (booleanp (,foop ,x))
                   :rule-classes :type-prescription
                   :hints(("Goal" :in-theory (enable ,foop))))
 
-                ,(if (consp require)
-                     `(defthm ,foop-of-make-foo
-                        (implies (force (and ,@(strip-cadrs require)))
+                (defthm ,foop-of-make-foo
+                  ,(if (consp require)
+                       `(implies (force (and ,@(strip-cadrs require)))
                                  (equal (,foop (,make-foo ,@field-names))
                                         t))
-                        :hints(("Goal" :in-theory (enable ,foop ,make-foo))))
-                   `(defthm ,foop-of-make-foo
-                      (equal (,foop (,make-foo ,@field-names))
-                             t)
-                      :hints(("Goal" :in-theory (enable ,foop ,make-foo)))))
+                     `(equal (,foop (,make-foo ,@field-names))
+                             t))
+                  :hints(("Goal"
+                          :in-theory
+                          (union-theories
+                           '(,foop ,make-foo)
+                           (theory 'defaggregate-basic-theory))
+                          :use ((:instance ,booleanp-of-foop
+                                           (,x (,make-foo ,@field-names)))))))
 
                 ,@(and tag
                        `((defthm ,(intern-in-package-of-symbol
@@ -895,7 +1157,11 @@
                                    name)
                            (equal (tag (,make-foo ,@field-names))
                                   ,tag)
-                           :hints(("Goal" :in-theory (enable tag ,make-foo))))
+                           :hints(("Goal"
+                                   :in-theory
+                                   (union-theories
+                                    '(,make-foo)
+                                    (theory 'defaggregate-basic-theory)))))
 
                          (defthm ,(intern-in-package-of-symbol
                                    (str::cat "TAG-WHEN-" (symbol-name foop))
@@ -905,7 +1171,11 @@
                                            ,tag))
                            :rule-classes ((:rewrite :backchain-limit-lst 0)
                                           (:forward-chaining))
-                           :hints(("Goal" :in-theory (enable tag ,foop))))
+                           :hints(("Goal"
+                                   :in-theory
+                                   (union-theories
+                                    '(,foop)
+                                    (theory 'defaggregate-basic-theory)))))
 
                          (defthm ,(intern-in-package-of-symbol
                                    (str::cat (symbol-name foop) "-WHEN-WRONG-TAG")
@@ -913,7 +1183,12 @@
                            (implies (not (equal (tag ,x) ,tag))
                                     (equal (,foop ,x)
                                            nil))
-                           :rule-classes ((:rewrite :backchain-limit-lst 1)))
+                           :rule-classes ((:rewrite :backchain-limit-lst 1))
+                           :hints(("Goal"
+                                   :in-theory
+                                   (union-theories
+                                    '(,foop)
+                                    (theory 'defaggregate-basic-theory)))))
 
                          (add-to-ruleset tag-reasoning
                                          '(,(intern-in-package-of-symbol
@@ -929,7 +1204,10 @@
                   (implies (,foop ,x)
                            (consp ,x))
                   :rule-classes :compound-recognizer
-                  :hints(("Goal" :in-theory (enable ,foop))))
+                  :hints(("Goal"
+                          :in-theory
+                          (union-theories '(,foop)
+                                          (theory 'defaggregate-basic-theory)))))
 
                 ,@(da-make-accessors-of-constructor name field-names)
                 ,@(da-make-requirements-of-recognizer name require field-names)))
@@ -945,8 +1223,17 @@
            ,(da-make-honsed-maker-fn name field-names field-defaults)
            ,(da-make-honsed-maker name field-names)
 
-           . ,other-events)))
-    (mv event state)))
+           (with-output :stack :pop
+             (progn . ,other-events))
+
+           (value-triple '(defaggregate ,name)))))
+    (mv `(with-output
+           :stack :push
+           :gag-mode t
+           :off (acl2::summary acl2::observation acl2::prove acl2::proof-tree
+                               acl2::event)
+           ,event)
+        state)))
 
 (defmacro defaggregate (name &rest args)
   `(make-event
diff -Nru acl2-6.2/books/cutil/defalist.lisp acl2-6.3/books/cutil/defalist.lisp
--- acl2-6.2/books/cutil/defalist.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/defalist.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -24,19 +24,39 @@
 
 (defxdoc defalist
   :parents (cutil)
-  :short "Introduce a recognizer for a typed alist."
+  :short "Introduce a recognizer for a typed association list (alist)."
 
   :long "<p>Defalist allows you to quickly introduce a recognizer for a typed
 association list (e.g., @('string-nat-alistp')) and proves basic theorems about
 it.</p>
 
 <p>Unlike many ACL2 alist recognizers, the recognizers introduced by defalist
-do not, by default, imply @('(alistp x)'), but they do imply something like
-@('(cons-listp x)').  That is, we require that each element is a cons, but we
-do not require the alists to be nil-terminated.  This is sometimes unfortunate
-when you want to use functions like @('strip-cars') or @('strip-cdrs') that
-expect their argument to be a true-list.  But it means you can use size hints,
-names, etc., for fast alists.</p>
+<b>do not</b>, by default, imply @('(alistp x)'), but they do imply something
+like @('(cons-listp x)').  That is,</p>
+
+<ul>
+<li>We require that each element is a cons, but</li>
+<li>We do not require the alists to be nil-terminated.</li>
+</ul>
+
+<p>Not requiring @('nil') termination has some advantages.  It plays well with
+@(see acl2::equivalence) relations like @(see list-equiv) and @(see
+acl2::alist-equiv).  It also allows you to use features of @(see
+acl2::fast-alists) such as \"size hints\" and \"alist names\" (see @(see
+hons-acons) for details).</p>
+
+<p>But there is also a disadvantage.  Namely, it may be difficult to operate on
+a defalist using traditional alist functions, whose @(see guard)s require @(see
+alistp).  Fortunately, there are generally good alternatives to these
+traditional functions with no such requirement, e.g.,:</p>
+
+<ul>
+<li>@(see acons) &rarr; @(see hons-acons) or ordinary @(see cons)es.</li>
+<li>@(see assoc) &rarr; @(see hons-get) for fast alists, or @(see hons-assoc-equal)
+    for ordinary alists</li>
+<li>@(see strip-cars) &rarr; @(see alist-keys)</li>
+<li>@(see strip-cdrs) &rarr; @(see alist-vals)</li>
+</ul>
 
 <p>General form:</p>
 
@@ -179,14 +199,17 @@
 
        (short (or short
                   (and parents
-                       (str::cat "@(call " (symbol-name name) ") recognizes
-association lists where every key satisfies @(see " (symbol-name keyp) ") and
-each value satisfies @(see " (symbol-name valp) ")."))))
+                       (str::cat "@(call " (symbol-package-name
+name) "::" (symbol-name name) ") recognizes association lists where every key
+satisfies @(see " (symbol-package-name keyp) "::" (symbol-name keyp) ") and
+each value satisfies @(see " (symbol-package-name valp) "::" (symbol-name
+valp) ")."))))
 
        (long (or long
                  (and parents
-                      (str::cat "<p>This is an ordinary @(see defalist).</p>"
-                                "@(def " (symbol-name name) ")"))))
+                      (str::cat "<p>This is an ordinary @(see cutil::defalist).</p>"
+                                "@(def " (symbol-package-name
+                                name) "::" (symbol-name name) ")"))))
 
        (doc (if (or parents short long)
                 `((defxdoc ,name :parents ,parents :short ,short :long ,long))
diff -Nru acl2-6.2/books/cutil/define-tests.lisp acl2-6.3/books/cutil/define-tests.lisp
--- acl2-6.2/books/cutil/define-tests.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/define-tests.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -27,4 +27,77 @@
 (define foo7
   :parents (|look ma, parents before formals, even!|)
   (x)
-  (consp x))
\ No newline at end of file
+  (consp x))
+
+(encapsulate
+  ()
+  (logic)
+  (define foo8 (x)
+    :mode :program
+    (+ 1 x)))
+
+(encapsulate
+  ()
+  (logic)
+  (define foo9 (x)
+    (declare (xargs :mode :program))
+    (+ 2 x)))
+
+(encapsulate
+  ()
+  (program)
+  (define foo10 ((x natp))
+    (declare (xargs :mode :logic))
+    (+ 2 x)))
+
+(encapsulate
+  ()
+  (program)
+  (define foo11 (x)
+    (declare (xargs :mode :program))
+    (+ 3 x)))
+
+(encapsulate
+  ()
+  (program)
+  (define foo12 (x)
+    :mode :program
+    (+ 3 x)))
+
+
+
+
+(encapsulate
+  ()
+  (logic)
+  (define bar8 (x &optional y)
+    :mode :program
+    (+ 1 x y)))
+
+(encapsulate
+  ()
+  (logic)
+  (define bar9 (x &optional y)
+    (declare (xargs :mode :program))
+    (+ 2 x y)))
+
+(encapsulate
+  ()
+  (program)
+  (define bar10 ((x natp) &optional (y natp))
+    (declare (xargs :mode :logic))
+    (+ 2 x y)))
+
+(encapsulate
+  ()
+  (program)
+  (define bar11 (x &optional y)
+    (declare (xargs :mode :program))
+    (+ 3 x y)))
+
+(encapsulate
+  ()
+  (program)
+  (define bar12 (x &optional y)
+    :mode :program
+    (+ 3 x y)))
diff -Nru acl2-6.2/books/cutil/define.lisp acl2-6.3/books/cutil/define.lisp
--- acl2-6.2/books/cutil/define.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/define.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -23,7 +23,7 @@
 (in-package "CUTIL")
 (include-book "formals")
 (include-book "returnspecs")
-(include-book "xdoc-impl/fmt-to-str" :dir :system)
+(include-book "xdoc/fmt-to-str" :dir :system)
 (include-book "tools/mv-nth" :dir :system)
 (include-book "str/cat" :dir :system)
 (set-state-ok t)
@@ -42,7 +42,7 @@
 <ul>
 
 <li>Richer @('formals') lists that permit keyword/optional arguments, embedded
-guards and documentation, automatically infer @(see stobj) declarations,
+guards and documentation, automatically infer @(see acl2::stobj) declarations,
 etc.</li>
 
 <li>A more concise @(see xargs) syntax that also adds control over other
@@ -76,7 +76,7 @@
 
 <p>The formal have many features; see @(see extended-formals).  Besides the
 ordinary extended-formals utilities, they can also include @(':type')
-declarations; see @(see type-spec).  For instance:</p>
+declarations; see @(see acl2::type-spec).  For instance:</p>
 
 @({
   (x oddp :type integer)
@@ -763,7 +763,11 @@
                               :returns ',returnspecs
                               :formals ',formals)
 
-         (local (in-theory (enable ,fnname)))
+         (local
+          (make-event
+           (if (logic-mode-p ',fnname-fn (w state))
+               '(in-theory (enable ,fnname))
+             '(value-triple :invisible))))
 
          (make-event
           (let* ((world (w state))
diff -Nru acl2-6.2/books/cutil/deflist-aux.lisp acl2-6.3/books/cutil/deflist-aux.lisp
--- acl2-6.2/books/cutil/deflist-aux.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/deflist-aux.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -19,7 +19,7 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "CUTIL")
-(include-book "finite-set-theory/osets/sets" :dir :system)
+(include-book "std/osets/top" :dir :system)
 
 ; This should not be included directly.  It is just a helper book for deflist,
 ; and I reserve the right to eliminate and/or change it.
diff -Nru acl2-6.2/books/cutil/deflist-tests.lisp acl2-6.3/books/cutil/deflist-tests.lisp
--- acl2-6.2/books/cutil/deflist-tests.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/deflist-tests.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -24,11 +24,17 @@
 
 (in-package "CUTIL")
 (include-book "deflist")
-(local (include-book "str/top" :dir :system))
-(local (include-book "misc/assert" :dir :system))
+(include-book "str/top" :dir :system)
+(include-book "misc/assert" :dir :system)
+
+(make-event
+ (prog2$
+  (cw "~%~%~%WARNING!  PRINTER ON FIRE!~%You are loading ~
+       cutil/deflist-tests! Don't do that!~%~%")
+  '(value-triple :invisible))
+ :check-expansion t)
 
 
-(local (progn
 
 (in-theory
  ;; This is awful and you should generally never do it.  But here, the idea is
@@ -260,8 +266,6 @@
    (str::isubstrp "@(def |CUTIL|::|RATLIST-IS-RATIONAL-LISTP|)"
                   (cdr (assoc :long topic)))))
 
-))
-
 
 
 
@@ -317,3 +321,21 @@
                   :elementp-of-nil t))))
 
 
+
+
+(deflist atom-listp (acl2::x)
+  ;; This is an especially hard case because ACL2 knows so much about
+  ;; ATOM and CONSP.
+  (atom acl2::x)
+  :true-listp t
+  :elementp-of-nil t
+  :already-definedp t)
+
+(deflist alistp (acl2::x)
+  ;; This is an especially hard case because ACL2 knows so much about
+  ;; ATOM and CONSP.
+  (consp acl2::x)
+  :true-listp t
+  :elementp-of-nil nil
+  :already-definedp t)
+
diff -Nru acl2-6.2/books/cutil/deflist.lisp acl2-6.3/books/cutil/deflist.lisp
--- acl2-6.2/books/cutil/deflist.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/deflist.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -26,7 +26,7 @@
 (include-book "xdoc/top" :dir :system)
 (include-book "tools/bstar" :dir :system)
 (include-book "str/cat" :dir :system)
-(include-book "finite-set-theory/osets/sets" :dir :system)
+(include-book "std/osets/top" :dir :system)
 (include-book "defsort/duplicated-members" :dir :system)
 (include-book "std/lists/sets" :dir :system)
 (include-book "std/lists/list-fix" :dir :system)
@@ -266,7 +266,7 @@
   ;; Deflist does most of its work in a very minimal theory.  These are a few
   ;; lemmas that we enable so that it will work.
 
-  (local (include-book "finite-set-theory/osets/under-set-equiv" :dir :system))
+  (local (include-book "std/osets/under-set-equiv" :dir :system))
 
   (defthmd deflist-lemma-member-of-car
     (iff (member-equal (car x) x)
@@ -448,7 +448,8 @@
     acl2::set-equiv-implies-equal-subsetp-2
     acl2::subsetp-refl
     acl2::list-fix-under-list-equiv
-    sets::mergesort-under-set-equiv))
+    sets::mergesort-under-set-equiv
+    acl2::binary-append-without-guard))
 
 
 
@@ -572,7 +573,6 @@
           ;; We start with the basic requirements about elementp.  Note that these
           ;; theorems are done in the user's current theory.  It's up to the user
           ;; to be able to prove these.
-
           (local (defthm deflist-local-booleanp-element-thm
                    (or (equal ,element t)
                        (equal ,element nil))
@@ -704,7 +704,20 @@
             :hints(("Goal"
                     :induct (len ,x)
                     :in-theory (enable subsetp-equal ,name)
-                    :expand (true-listp ,x))))
+                    :expand (true-listp ,x)
+                    :do-not '(eliminate-destructors))
+
+                   ;; Horrible, horrible hack.  I found that I couldn't get
+                   ;; deflist to process ATOM-LISTP because ACL2 knows too much
+                   ;; about ATOM, so the member-equal rule above ends up being
+                   ;; no good because it tries to target ATOM instead of CONSP,
+                   ;; and we get nowhere.  Solution: try to explicitly use the
+                   ;; member rule if we get stuck.
+                   (and stable-under-simplificationp
+                        '(:use ((:instance
+                                 ,(mksym elementp '-when-member-equal-of- name)
+                                 (,a (car ,x))
+                                 (,x ,y)))))))
 
           ,@(and (not true-listp)
                  ;; Awesome set congruence rule for loose recognizers, but not
@@ -906,6 +919,16 @@
                             t))
             :hints(("Goal" :do-not-induct t)))
 
+          (defthm ,(mksym name '-of-rcons)
+            (equal (,name ,@(subst `(rcons ,a ,x) x formals))
+                   (and ,(if negatedp
+                             `(not (,elementp ,@(subst a x elem-formals)))
+                           `(,elementp ,@(subst a x elem-formals)))
+                        (,name ,@(if true-listp
+                                     (subst `(list-fix ,x) x formals)
+                                   formals))))
+            :hints(("Goal" :in-theory (enable rcons))))
+
           (defthm ,(mksym name '-of-duplicated-members)
             (implies (,name ,@(subst `(double-rewrite ,x) x formals))
                      (equal (,name ,@(subst `(duplicated-members ,x) x formals))
@@ -1017,14 +1040,15 @@
        ,@(and parents `(:parents ,parents))
        ,@(and short   `(:short ,short))
        ,@(and long    `(:long ,long))
-       . ,(if (not rest)
-              events
-            `(;; keep all our deflist theory stuff bottled up
-              (encapsulate () . ,events)
-              ;; now do the rest of the events with name enabled, so they get
-              ;; included in the section
-              (local (in-theory (enable ,name)))
-              . ,rest)))))
+       ;; keep all our deflist theory stuff bottled up.  BOZO encapsulate is
+       ;; slow, better to use a progn here
+       (encapsulate ()
+         . ,events)
+       ;; now do the rest of the events with name enabled, so they get included
+       ;; in the section
+       . ,(and rest
+               `((local (in-theory (enable ,name)))
+                 . ,rest)))))
 
 
 (defmacro deflist (name formals element
diff -Nru acl2-6.2/books/cutil/defprojection-tests.acl2 acl2-6.3/books/cutil/defprojection-tests.acl2
--- acl2-6.2/books/cutil/defprojection-tests.acl2	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/defprojection-tests.acl2	2013-09-30 17:52:17.000000000 +0000
@@ -20,4 +20,3 @@
 
 (include-book "portcullis")
 ; cert-flags: ? t :ttags :all
-(certify-book "defprojection-tests" ? t :ttags :all)
\ No newline at end of file
diff -Nru acl2-6.2/books/cutil/defprojection-tests.lisp acl2-6.3/books/cutil/defprojection-tests.lisp
--- acl2-6.2/books/cutil/defprojection-tests.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/defprojection-tests.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -20,120 +20,175 @@
 
 (in-package "CUTIL")
 (include-book "defprojection")
-(local (include-book "misc/assert" :dir :system))
+(include-book "misc/assert" :dir :system)
+
+(make-event
+ (prog2$
+  (cw "~%~%~%WARNING!  PRINTER ON FIRE!~%You are loading ~
+       cutil/defprojection-tests! Don't do that!~%~%")
+  '(value-triple :invisible))
+ :check-expansion t)
+
+(in-theory
+ ;; This is awful and you should generally never do it.  But here, the idea is
+ ;; to show that all of these deflists will succeed even in a crippled theory.
+ nil)
+
+; Dupe is nice because it has a guard of T.
+
+(defun dupe (x)
+  (declare (xargs :guard t))
+  (cons x x))
+
+(defprojection dupe-list (x)
+  (dupe x)
+  :optimize nil)
+
+(defprojection dupe-list2 (x)
+  (dupe x)
+  :optimize t)
+
+(defprojection dupe-list3 (x)
+  (dupe x)
+  :verify-guards nil)
+
+(defprojection dupe-list4 (x)
+  (dupe x)
+  :mode :program)
+
+
+; Square adds some tests of guard handling.  For the guards to verify the
+; user's theory needs to know something about integer-listp.
+
+(local (in-theory (enable integer-listp)))
+
+(defund square (x)
+  (declare (xargs :guard (integerp x)))
+  (* x x))
+
+(defprojection slow-square-list (x)
+  (square x)
+  :guard (integer-listp x)
+  :optimize nil)
+
+(defprojection square-list (x)
+  (square x)
+  :guard (integer-listp x))
+
+(defprojection program-square-list (x)
+  (square x)
+  :guard (integer-listp x)
+  :mode :program)
+
+
+(assert! (let ((x '(1 2 3 4 5 6 7 8 9 10)))
+           (and (equal (square-list x)
+                       (slow-square-list x))
+                (equal (square-list x)
+                       (program-square-list x)))))
+
+
+; For result-type theorems the user's theory needs to be slightly more sane.
+
+(local (in-theory (enable car-cons
+                          cdr-cons
+                          car-cdr-elim)))
+
+(defthm integerp-of-square
+  (implies (integerp x)
+           (integerp (square x)))
+  :hints(("Goal" :in-theory (enable square))))
+
+(defprojection square-list-r (x)
+  (square x)
+  :guard (integer-listp x)
+  :result-type integer-listp
+  :optimize nil)
+
+(defprojection square-list-r2 (x)
+  (square x)
+  :guard (integer-listp x)
+  :result-type integer-listp
+  :optimize nil
+  :parallelize t)
 
-(local
- (encapsulate
-  ()
-
-  (defund square (x)
-    (declare (xargs :guard (integerp x)))
-    (* x x))
-
-  (defprojection slow-square-list (x)
-    (square x)
-    :guard (integer-listp x)
-    :optimize nil)
-
-  (defprojection square-list (x)
-    (square x)
-    :guard (integer-listp x))
-
-  (defprojection program-square-list (x)
-    (square x)
-    :guard (integer-listp x)
-    :mode :program)
-
-  (assert! (let ((x '(1 2 3 4 5 6 7 8 9 10)))
-             (and (equal (square-list x)
-                         (slow-square-list x))
-                  (equal (square-list x)
-                         (program-square-list x)))))
-
-  (defthm integerp-of-square
-    (implies (integerp x)
-             (integerp (square x)))
-    :hints(("Goal" :in-theory (enable square))))
-
-  (defprojection slow-square-list-with-result-type (x)
-    (square x)
-    :guard (integer-listp x)
-    :result-type integer-listp
-    :optimize nil)
-
-  (defprojection slow-square-list-with-result-type-and-parallelism (x)
-    (square x)
-    :guard (integer-listp x)
-    :result-type integer-listp
-    :optimize nil
-    :parallelize t)
 
 
   ;; Some tests with constants...
 
-  (defprojection add1-list (x)
-    (+ 1 x)
-    :guard (integer-listp x)
-    :parents (foo)
-    :rest
-    ((defthm add1-list-integer-list
-       (implies (integer-listp x)
-                (integer-listp (add1-list x))))))
-
-  (defprojection symbol-<-foo-list (x)
-    (symbol-< :foo x)
-    :guard (symbol-listp x))
-
-  (defprojection symbol-<-bar-list (x)
-    (symbol-< 'bar x)
-    :guard (symbol-listp x))
+(defprojection add1-list (x)
+  ;; Well, this won't work if it's nil-preservingp, but if someone complains
+  ;; about they can go yell at Matt to fix maybe-defthm-as-rewrite.
+  (+ 1 x)
+  :guard (integer-listp x)
+  :parents (foo)
+  :rest
+  ((defthm add1-list-integer-list
+     (implies (integer-listp x)
+              (integer-listp (add1-list x))))))
+
+(local (in-theory (enable symbol-listp)))
+
+(defprojection symbol-<-foo-list (x)
+  (symbol-< :foo x)
+  :guard (symbol-listp x))
+
+(defprojection symbol-<-bar-list (x)
+  (symbol-< 'bar x)
+  :guard (symbol-listp x))
 
-  ))
 
 
+(local (in-theory (enable alistp)))
 
+(defprojection my-strip-cars (x)
+  (car x)
+  :nil-preservingp t
+  :guard (alistp x))
 
 
+(defund f (x)
+  (declare (xargs :guard (consp x)))
+  (car x))
+
+(defprojection my-strip-cars2 (x)
+  (f x)
+  :nil-preservingp t
+  :guard (alistp x))
 
 
 #||
 
-;; Test for includeed book.  (Unlocalize the encapsulate above, first.)  It
-;; seems to work just fine.
+(include-book ;; newline to appease cert.pl
+ "defprojection-tests")
 
-(in-package "VL")
-(include-book ;; fool dependency scanner
- "util-defprojection")
 :q
 
 (defparameter *test* (loop for i from 1 to 1000 collect i))
 
-(equal (vl::square-list *test*)
-       (vl::slow-square-list *test*))
+(equal (cutil::square-list *test*)
+       (cutil::slow-square-list *test*))
 
 ;; .76 seconds, 320 MB
 (progn
     (gc$)
     (time (loop for i from 1 to 10000
                 do
-                (consp (vl::slow-square-list *test*)))))
+                (consp (cutil::slow-square-list *test*)))))
 
 ;; .43 seconds, 160 MB
 (progn
     (gc$)
     (time (loop for i from 1 to 10000
                 do
-                (consp (vl::square-list *test*)))))
+                (consp (cutil::square-list *test*)))))
 
 ;; .43 seconds, 160 MB
 (progn
     (gc$)
     (time (loop for i from 1 to 10000
                 do
-                (consp (vl::program-square-list *test*)))))
-
-
+                (consp (cutil::program-square-list *test*)))))
 
-  ))
 
 ||#
\ No newline at end of file
diff -Nru acl2-6.2/books/cutil/defprojection.lisp acl2-6.3/books/cutil/defprojection.lisp
--- acl2-6.2/books/cutil/defprojection.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/defprojection.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -24,6 +24,29 @@
 
 (in-package "CUTIL")
 (include-book "deflist")
+(include-book "std/lists/append" :dir :system)
+
+(defun variable-or-constant-listp (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      t
+    (and (or (symbolp (car x))
+             (quotep (car x))
+             ;; things that quote to themselves
+             (acl2-numberp (car x))
+             (stringp (car x))
+             (characterp (car x)))
+         (variable-or-constant-listp (cdr x)))))
+
+(defun collect-vars (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      nil
+    (if (and (symbolp (car x))
+             (not (keywordp (car x))))
+        (cons (car x) (collect-vars (cdr x)))
+      (collect-vars (cdr x)))))
+
 
 (defxdoc defprojection
   :parents (cutil)
@@ -121,35 +144,24 @@
 If you don't like this documentation, you can supply your own @(':short')
 and/or @(':long') to override it.</p>
 
-<p>The optional @(':parallelize') keyword should be set to non-@('nil') when
-the user wishes to parallelize the execution of the defined function.</p>")
-
-(defthmd defprojection-append-of-nil
-  (implies (true-listp a)
-           (equal (append a nil) a)))
-
-(defthmd defprojection-associativity-of-append
-  (equal (append (append x y) z)
-         (append x (append y z))))
-
-(defun variable-or-constant-listp (x)
-  (if (atom x)
-      t
-    (and (or (symbolp (car x))
-             (quotep (car x))
-             ;; things that quote to themselves
-             (acl2-numberp (car x))
-             (stringp (car x))
-             (characterp (car x)))
-         (variable-or-constant-listp (cdr x)))))
+<p>The optional @(':parallelize') keyword can be set to @('t') if you want to
+try to speed up the execution of new function using parallelism.  This is
+experimental and will only work with ACL2(p).  Note that we don't do anything
+smart to split the work up into large chunks, and you lose tail-recursion when
+you use this.</p>")
+
+(deftheory defprojection-theory
+  (union-theories '(acl2::append-to-nil
+                    acl2::append-when-not-consp
+                    acl2::append-of-cons
+                    acl2::associativity-of-append
+                    acl2::rev-of-cons
+                    acl2::rev-when-not-consp
+                    acl2::revappend-removal
+                    acl2::reverse-removal)
+                  (union-theories (theory 'minimal-theory)
+                                  (theory 'deflist-support-lemmas))))
 
-(defun collect-vars (x)
-  (if (atom x)
-      nil
-    (if (and (symbolp (car x))
-             (not (keywordp (car x))))
-        (cons (car x) (collect-vars (cdr x)))
-      (collect-vars (cdr x)))))
 
 (defun defprojection-fn (name formals element
                               nil-preservingp already-definedp
@@ -247,7 +259,8 @@
        (short (or short
                   (and parents
                        (str::cat "@(call " (symbol-name list-fn) ") maps "
-                                 "@(see " (symbol-name elem-fn) ") across a list."))))
+                                 "@(see " (symbol-package-name elem-fn)
+                                 "::" (symbol-name elem-fn) ") across a list."))))
 
        (long (or long
                  (and parents
@@ -255,7 +268,7 @@
 
        (def  (if already-definedp
                  nil
-               `((defun ,exec-fn (,@list-args ,acc)
+               `((defund ,exec-fn (,@list-args ,acc)
                    (declare (xargs :guard
                                    ;; Previously we required that acc was a
                                    ;; true-listp in the guard.  But on reflection,
@@ -283,7 +296,7 @@
                                        ,acc))
                      ,acc))
 
-                 (defun ,list-fn (,@list-args)
+                 (defund ,list-fn (,@list-args)
                    (declare (xargs :guard ,guard
                                    :mode ,mode
                                    ;; we tell ACL2 not to normalize because
@@ -309,23 +322,24 @@
        (ndef      `(defun ,list-fn (,@list-args)
                      (nreverse (,exec-fn ,@list-args nil))))
 
-       (opt       (if (or already-definedp (not optimize))
-                      nil
-                    `((progn
-                        (make-event
-                         (if (acl2::global-val 'acl2::include-book-path (w state))
-                             ;; We're in an include book.  Don't print.
-                             (value '(value-triple :invisible))
-                           (value '(value-triple
-                                    (cw "~|~%Optimizing definition of ~s0:~%  ~p1~%~%"
-                                        ',list-fn ',ndef)))))
-                        (defttag cutil-optimize)
-                        ;; To justify nreverse, exec-fn must never be memoized
-                        (never-memoize ,exec-fn)
-                        (progn!
-                         (set-raw-mode t)
-                         ,ndef)
-                        (defttag nil)))))
+       (opt       (and optimize
+                       (not already-definedp)
+                       `((progn
+                           (make-event
+                            (if (acl2::global-val
+                                 'acl2::include-book-path (w state))
+                                ;; We're in an include book.  Don't print.
+                                (value '(value-triple :invisible))
+                              (value
+                               '(value-triple
+                                 (cw "~|~%Optimizing definition of ~s0:~%  ~p1~%~%"
+                                     ',list-fn ',ndef)))))
+                           (defttag cutil-optimize)
+                           ;; To justify nreverse, exec-fn must never be memoized
+                           (never-memoize ,exec-fn)
+                           (progn! (set-raw-mode t)
+                                   ,ndef)
+                           (defttag nil)))))
 
        ((when (eq mode :program))
         `(defsection ,name
@@ -337,43 +351,80 @@
            ,@opt
            ,@rest))
 
-       (events
-        `((logic)
-          ,@def
-
-          ,@(if already-definedp
-                nil
-              `((in-theory (disable ,list-fn ,exec-fn))))
-
-          (local (in-theory (enable defprojection-append-of-nil
-                                    defprojection-associativity-of-append)))
+       (listp-when-not-consp  (mksym list-fn '-when-not-consp))
+       (listp-of-cons         (mksym list-fn '-of-cons))
+       (listp-nil-preservingp (mksym list-fn '-nil-preservingp-lemma))
+
+       (main-thms
+        `(,@(and nil-preservingp
+                 `((local (maybe-defthm-as-rewrite
+                           ,listp-nil-preservingp
+                           (equal (,elem-fn ,@(subst ''nil x elem-args))
+                                  nil)
+                           ;; We just rely on the user to be able to prove this
+                           ;; in their current theory.
+                           ))))
+
+          (local (make-event
+                  ;; Bllalaaaaah... This sucks so bad.  I just want to have a
+                  ;; rule with this name, whatever it is.
+                  (if (is-theorem-p ',listp-nil-preservingp (w state))
+                      (value '(value-triple :invisible))
+                    (value '(defthm ,listp-nil-preservingp
+                              (or (equal (alistp x) t)
+                                  (equal (alistp x) nil))
+                              :rule-classes :type-prescription
+                              :hints(("Goal"
+                                      :in-theory
+                                      '((:type-prescription alistp)))))))))
 
-          (defthm ,(mksym list-fn '-when-not-consp)
+          (defthm ,listp-when-not-consp
             (implies (not (consp ,x))
                      (equal (,list-fn ,@list-args)
                             nil))
-            :hints(("Goal" :in-theory (enable ,list-fn))))
+            :hints(("Goal"
+                    :in-theory
+                    (union-theories '(,list-fn)
+                                    (theory 'defprojection-theory)))))
 
-          (defthm ,(mksym list-fn '-of-cons)
+          (defthm ,listp-of-cons
             (equal (,list-fn ,@(subst `(cons ,a ,x) x list-args))
                    (cons (,elem-fn ,@(subst a x elem-args))
                          (,list-fn ,@list-args)))
-            :hints(("Goal" :in-theory (enable ,list-fn))))
+            :hints(("Goal"
+                    :in-theory
+                    (union-theories '(,list-fn)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym 'true-listp-of- list-fn)
             (equal (true-listp (,list-fn ,@list-args))
                    t)
-            :hints(("Goal" :induct (len ,x))))
+            :hints(("Goal"
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym 'len-of- list-fn)
             (equal (len (,list-fn ,@list-args))
                    (len ,x))
-            :hints(("Goal" :induct (len ,x))))
+            :hints(("Goal"
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym 'consp-of- list-fn)
             (equal (consp (,list-fn ,@list-args))
                    (consp ,x))
-            :hints(("Goal" :induct (len ,x))))
+            :hints(("Goal"
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym 'car-of- list-fn)
             (equal (car (,list-fn ,@list-args))
@@ -381,59 +432,115 @@
                         `(,elem-fn ,@(subst `(car ,x) x elem-args))
                       `(if (consp ,x)
                            (,elem-fn ,@(subst `(car ,x) x elem-args))
-                         nil))))
+                         nil)))
+            :hints(("Goal"
+                    :in-theory
+                    (union-theories '(,listp-when-not-consp
+                                      ,listp-of-cons
+                                      . ,(and nil-preservingp
+                                              `(,listp-nil-preservingp
+                                                acl2::default-car)))
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym 'cdr-of- list-fn)
             (equal (cdr (,list-fn ,@list-args))
-                   (,list-fn ,@(subst `(cdr ,x) x list-args))))
+                   (,list-fn ,@(subst `(cdr ,x) x list-args)))
+            :hints(("Goal"
+                    :in-theory
+                    (union-theories '(,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
+
 
           (defthm ,(mksym list-fn '-under-iff)
             (iff (,list-fn ,@list-args)
                  (consp ,x))
-            :hints(("Goal" :induct (len ,x))))
+            :hints(("Goal"
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym list-fn '-of-list-fix)
             (equal (,list-fn ,@(subst `(list-fix ,x) x list-args))
                    (,list-fn ,@list-args))
-            :hints(("Goal" :induct (len ,x))))
+            :hints(("Goal"
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym list-fn '-of-append)
             (equal (,list-fn ,@(subst `(append ,x ,y) x list-args))
                    (append (,list-fn ,@list-args)
                            (,list-fn ,@(subst y x list-args))))
-            :hints(("Goal" :induct (len ,x))))
+            :hints(("Goal"
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym list-fn '-of-rev)
             (equal (,list-fn ,@(subst `(rev ,x) x list-args))
                    (rev (,list-fn ,@list-args)))
-            :hints(("Goal" :induct (len ,x))))
+            :hints(("Goal"
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(,(mksym list-fn '-of-append)
+                                      ,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym list-fn '-of-revappend)
             (equal (,list-fn ,@(subst `(revappend ,x ,y) x list-args))
                    (revappend (,list-fn ,@list-args)
-                              (,list-fn ,@(subst y x list-args)))))
+                              (,list-fn ,@(subst y x list-args))))
+            :hints(("Goal" :in-theory
+                    (union-theories '(,(mksym list-fn '-of-append)
+                                      ,(mksym list-fn '-of-rev))
+                                    (theory 'defprojection-theory)))))
 
           ,@(if nil-preservingp
                 `((defthm ,(mksym 'take-of- list-fn)
                     (equal (take ,n (,list-fn ,@list-args))
                            (,list-fn ,@(subst `(take ,n ,x) x list-args)))
                     :hints(("Goal"
-                            :in-theory (enable acl2::take-redefinition)
-                            :induct (take ,n ,x)))))
+                            :induct (take ,n ,x)
+                            :in-theory
+                            (union-theories '(acl2::take-redefinition
+                                              ,listp-when-not-consp
+                                              ,listp-of-cons
+                                              . ,(and nil-preservingp
+                                                      `(,listp-nil-preservingp
+                                                        acl2::default-car)))
+                                            (theory 'defprojection-theory))))))
               nil)
 
           (defthm ,(mksym 'nthcdr-of- list-fn)
             (equal (nthcdr ,n (,list-fn ,@list-args))
                    (,list-fn ,@(subst `(nthcdr ,n ,x) x list-args)))
             :hints(("Goal"
-                    :in-theory (enable nthcdr)
-                    :induct (nthcdr ,n ,x))))
+                    :induct (nthcdr ,n ,x)
+                    :in-theory
+                    (union-theories '(nthcdr
+                                      ,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym 'member-equal-of- elem-fn '-in- list-fn '-when-member-equal)
             (implies (member-equal ,a (double-rewrite ,x))
                      (member-equal (,elem-fn ,@(subst a x elem-args))
                                    (,list-fn ,@list-args)))
-            :hints(("Goal" :induct (len ,x))))
+            :hints(("Goal"
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(member-equal
+                                      ,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           (defthm ,(mksym 'subsetp-equal-of- list-fn 's-when-subsetp-equal)
             (implies (subsetp-equal (double-rewrite ,x)
@@ -441,17 +548,29 @@
                      (subsetp-equal (,list-fn ,@list-args)
                                     (,list-fn ,@(subst y x list-args))))
             :hints(("Goal"
-                    ;; bleh
-                    :in-theory (enable subsetp-equal)
-                    :induct (len ,x))))
+                    :induct (len ,x)
+                    :in-theory
+                    (union-theories '(subsetp-equal
+                                      ,(mksym 'member-equal-of- elem-fn
+                                              '-in- list-fn '-when-member-equal)
+                                      ,listp-when-not-consp
+                                      ,listp-of-cons)
+                                    (theory 'defprojection-theory)))))
 
           ,@(if nil-preservingp
                 `((defthm ,(mksym 'nth-of- list-fn)
                     (equal (nth ,n (,list-fn ,@list-args))
                            (,elem-fn ,@(subst `(nth ,n ,x) x elem-args)))
                     :hints(("Goal"
-                            :in-theory (enable nth)
-                            :induct (nth ,n ,x)))))
+                            :induct (nth ,n ,x)
+                            :in-theory
+                            (union-theories '(nth
+                                              ,listp-when-not-consp
+                                              ,listp-of-cons
+                                              . ,(and nil-preservingp
+                                                      `(,listp-nil-preservingp
+                                                        acl2::default-car)))
+                                            (theory 'defprojection-theory))))))
               nil)
 
           ,@(if already-definedp
@@ -460,39 +579,61 @@
                   ;; we don't need the hyp... (implies (force (true-listp ,acc))
                   (equal (,exec-fn ,@list-args ,acc)
                          (revappend (,list-fn ,@list-args) ,acc))
-                  :hints(("Goal" :in-theory (enable ,exec-fn))))
+                  :hints(("Goal"
+                          :induct (,exec-fn ,@list-args ,acc)
+                          :in-theory
+                          (union-theories '(,exec-fn
+                                            ,listp-when-not-consp
+                                            ,listp-of-cons)
+                                          (theory 'defprojection-theory)))))))
 
-                ,@(if verify-guards
-                      `((verify-guards ,exec-fn)
-                        (verify-guards ,list-fn))
-                    nil)))
-
-          ,@(and result-type
-                 `((defthm ,(mksym result-type '-of- list-fn)
-                     ,(if (eq guard t)
-                          `(,result-type (,list-fn ,@list-args))
-                        `(implies (force ,guard)
-                                  (,result-type (,list-fn ,@list-args))))
-                     :hints(("Goal"
-                             :induct (len ,x)
-                             :in-theory (enable (:induction len)))))))
 
-          . ,opt)))
+          )))
 
     `(defsection ,name
        ,@(and parents `(:parents ,parents))
        ,@(and short   `(:short ,short))
        ,@(and long    `(:long ,long))
-       . ,(if (not rest)
-              events
-            `((encapsulate ()
-                ;; keep all our deflist theory stuff bottled up
-                . ,events)
-
-              ;; now do the rest of the events with name enabled, so they get
-              ;; included in the section
-              (local (in-theory (enable ,name)))
-              . ,rest)))))
+       (logic)
+       ,@def
+       (set-inhibit-warnings "disable") ;; implicitly local
+       ,@main-thms
+       ,@(and (not already-definedp)
+              verify-guards
+              `((verify-guards ,exec-fn
+                  :hints(("Goal"
+                          :in-theory
+                          (union-theories '(,exec-fn)
+                                          (theory 'defprojection-theory)))
+                         (and stable-under-simplificationp
+                              '(:in-theory (enable )))))
+                (verify-guards ,list-fn
+                  :hints(("Goal"
+                          :in-theory
+                          (union-theories '(,list-fn
+                                            ,(mksym exec-fn '-removal)
+                                            ,(mksym 'true-listp-of- list-fn)
+                                            acl2::reverse-removal
+                                            acl2::revappend-removal
+                                            acl2::rev-of-append
+                                            acl2::rev-of-rev)
+                                          (theory 'defprojection-theory)))
+                         (and stable-under-simplificationp
+                              '(:in-theory (enable )))))))
+       ,@opt
+       (local (in-theory (enable ,list-fn
+                                 ,listp-when-not-consp
+                                 ,listp-of-cons)))
+       ,@(and result-type
+              `((defthm ,(mksym result-type '-of- list-fn)
+                  ,(if (eq guard t)
+                       `(,result-type (,list-fn ,@list-args))
+                     `(implies (force ,guard)
+                               (,result-type (,list-fn ,@list-args))))
+                  :hints(("Goal"
+                          :induct (len ,x)
+                          :in-theory (enable (:induction len)))))))
+       . ,rest)))
 
 (defmacro defprojection (name formals element &key nil-preservingp already-definedp
                               (optimize 't)
diff -Nru acl2-6.2/books/cutil/defredundant-tests.lisp acl2-6.3/books/cutil/defredundant-tests.lisp
--- acl2-6.2/books/cutil/defredundant-tests.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cutil/defredundant-tests.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -0,0 +1,134 @@
+; CUTIL - Centaur Basic Utilities
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "CUTIL")
+(include-book "defredundant")
+(include-book "misc/definline" :dir :system)
+(include-book "misc/assert" :dir :system)
+
+(encapsulate
+ ()
+
+(local (progn   ;; some events that we'll redundantly introduce
+
+(defun f1 (x)
+  (declare (xargs :normalize nil))
+  (+ 1 x))
+
+(defthm natp-of-f1
+  (implies (natp x)
+           (natp (f1 x))))
+
+(defund f2 (x)
+  (declare (xargs :verify-guards nil))
+  (+ 1 x))
+
+(defthmd natp-of-f2
+  (implies (natp x)
+           (natp (f2 x)))
+  :rule-classes :type-prescription
+  :hints(("Goal" :in-theory (enable f2))))
+
+(defun f3 (x)
+  (declare (xargs :guard (natp x)
+                  :verify-guards t))
+  (+ 1 x))
+
+(in-theory (disable (:e f3)))
+
+(mutual-recursion
+ (defun f4-term (x)
+   (declare (xargs :guard (pseudo-termp x)))
+   (if (atom x)
+       1
+     (if (quotep x)
+         2
+       (cons (car x) (f4-list (cdr x))))))
+ (defun f4-list (x)
+   (declare (xargs :guard (pseudo-term-listp x)))
+   (if (atom x)
+       nil
+     (cons (f4-term (car x))
+           (f4-list (cdr x))))))
+
+(definline f5 (x)
+  (declare (xargs :guard t))
+  x)
+
+(definlined f6 (x)
+  (declare (xargs :guard (natp x)))
+  (+ 1 x))
+
+(defun f7 (x)
+  (declare (xargs :mode :program))
+  (+ 1 x))
+
+(definline f8 (x)
+  (declare (xargs :mode :program :guard (natp x)))
+  (+ 1 x))
+
+(defun m (x y)
+  (+ (acl2-count x) (acl2-count y)))
+
+(defund f9 (x y)
+  (declare (xargs :measure (m x y)))
+  (if (and (atom x)
+           (atom y))
+      0
+    (+ (f9 (cdr x) (cdr y)))))
+
+))
+
+
+(defredundant  ;; redundantly introduce the above
+  f1
+  natp-of-f1
+  f2
+  natp-of-f2
+  f3
+  f9))
+
+
+;; basic unit tests to make sure things are working right
+
+(defmacro assert-enabled (rune enabled-p)
+  `(make-event 
+    (b* ((rune      ',rune)
+         (acl2::ens (acl2::ens state))
+         (actual    (if (acl2::active-runep rune) t nil))
+         ((when (equal actual ',enabled-p))
+          (value '(value-triple :success))))
+      (er soft 'assert-enabled "Expected (active-runep ~x0) to be ~x1, found ~x2.~%"
+          rune ',enabled-p actual))))
+
+(assert-enabled (:definition f1) t)
+(assert-enabled (:definition f2) nil)
+(assert-enabled (:definition f3) t)
+(assert-enabled (:definition f9) nil)
+
+(assert-enabled (:rewrite natp-of-f1) t)
+(assert-enabled (:type-prescription natp-of-f2) nil)
+
+(assert-enabled (:executable-counterpart f1) t)
+(assert-enabled (:executable-counterpart f2) t)
+(assert-enabled (:executable-counterpart f3) nil)
+(assert-enabled (:executable-counterpart f9) t)
+
+
diff -Nru acl2-6.2/books/cutil/defredundant.lisp acl2-6.3/books/cutil/defredundant.lisp
--- acl2-6.2/books/cutil/defredundant.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/cutil/defredundant.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -0,0 +1,253 @@
+; CUTIL - Centaur Basic Utilities
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "CUTIL")
+(include-book "support")
+(set-state-ok t)
+(program)
+
+(defxdoc defredundant
+  :parents (cutil)
+  :short "A macro for automatically introducing @(see acl2::redundant-events),
+which is useful for developing \"interface\" books and otherwise avoiding
+copying and pasting code.")
+
+(defun get-event-tuple (name world)
+  (b* ((?__function__ 'get-event-tuple)
+       (ev-world (acl2::decode-logical-name name world))
+       ((unless (consp ev-world))
+        (raise "Not a logical name: ~x0." name))
+       (landmark (car ev-world))
+       ((unless (and (consp landmark)
+                     (eq (first landmark) 'acl2::event-landmark)
+                     (eq (second landmark) 'acl2::global-value)))
+        (raise "Expected (EVENT-LANDMARK GLOBAL-VALUE . <event-tuple>) but found ~x0."
+               landmark)))
+    (cddr landmark)))
+
+(defun runes-to-e/ds (runes enables disables state)
+  (b* (((when (atom runes))
+        (mv enables disables))
+       (rune1     (car runes))
+       (acl2::ens (acl2::ens state))
+       (enabled1  (acl2::active-runep rune1))
+       ((when enabled1)
+        (runes-to-e/ds (cdr runes) (cons rune1 enables) disables state)))
+    (runes-to-e/ds (cdr runes) enables (cons rune1 disables) state)))
+
+(defun name-to-e/ds (name state)
+  (b* ((runic-mapping-pairs
+        (getprop name 'acl2::runic-mapping-pairs
+                 nil 'acl2::current-acl2-world (acl2::w state)))
+       (runes (strip-cdrs runic-mapping-pairs)))
+    (runes-to-e/ds runes nil nil state)))
+
+(defun redundant-clean-up-xargs
+  (x ;; e.g., (:guard (natp x) :measure (acl2-count x) ...)
+   )
+  ;; strip out various mode/guard/measure/hint related stuff
+  (b* ((?__function__ 'redundant-clean-up-xargs)
+       ((when (atom x))
+        nil)
+       ((when (atom (cdr x)))
+        (raise "Invalid xargs... ~x0" x))
+       ((list* kwd val rest) x)
+       ((when (member kwd '(:measure :mode :verify-guards
+                                     :guard-debug :guard-hints 
+                                     :hints :otf-flg)))
+        (redundant-clean-up-xargs rest)))
+    (list* kwd val
+           (redundant-clean-up-xargs rest))))
+
+(defun redundant-clean-up-decl-args
+  (x ;; the "..." part of a (declare . ...); i.e., ((type ...) (xargs ...) (ignore ...))
+   )
+  ;; strip out any measure/mode declarations
+  (b* ((?__function__ 'redundant-clean-up-decl-args)
+       ((when (atom x))
+        nil)
+       ((cons arg1 rest) x)
+       ((unless (consp arg1))
+        (raise "Bad form in declare: ~x0" x))
+       ((when (or (eq (car arg1) 'type)
+                  (eq (car arg1) 'ignore)
+                  (eq (car arg1) 'ignorable)))
+        (cons arg1
+              (redundant-clean-up-decl-args rest)))
+       ((when (eq (car arg1) 'xargs))
+        (cons (cons 'xargs
+                    (redundant-clean-up-xargs (cdr arg1)))
+              (redundant-clean-up-decl-args rest))))
+    (raise "Bad form in declare: ~x0" x)))
+
+(defun redundant-clean-up-decls 
+  (x ;; list of traditional doc strings and (declare ...) forms
+   )
+  ;; strip out all measure/mode decls and doc strings
+  (b* ((?__function__ 'redundant-clean-up-decls)
+       ((when (atom x))
+        nil)
+       ((cons decl1 rest) x)
+       ((when (stringp decl1))
+        ;; Drop any documentation strings since they may refer to doc-sections
+        ;; that aren't going to be present anymore.
+        (redundant-clean-up-decls rest))
+       ((unless (and (consp decl1)
+                     (eq (car decl1) 'declare)))
+        (raise "Bad declaration ~x0" x))
+       (decl1-args (cdr decl1)))
+    (cons (cons 'declare (redundant-clean-up-decl-args decl1-args))
+          (redundant-clean-up-decls rest))))
+
+(defun redundant-defun (event-tuple state)
+  (b* ((?__function__ 'redundant-defun)
+       (world (w state))
+       (form  (acl2::access-event-tuple-form event-tuple))
+       ((unless (and (consp form)
+                     (eq (car form) 'defun)))
+        (raise "Called redundant-defun on ~x0?" event-tuple))
+       (fn      (second form))
+       (formals (third form))
+       (decls   (redundant-clean-up-decls (butlast (cdddr form) 1)))
+       (body    (car (last form)))
+
+       (world-formals (getprop fn 'acl2::formals :bad 'acl2::current-acl2-world world))
+       ((unless (equal world-formals formals))
+        (raise "Problem with formals for ~x0?" event-tuple))
+
+       ;; elide measure in case it's not been redundantly introduced
+       (just (getprop fn 'acl2::justification nil 'acl2::current-acl2-world world))
+       (decls (if (not just)
+                  decls
+                (cons `(declare (xargs :measure (:? . ,(acl2::access acl2::justification just :subset))))
+                      decls)))
+
+       ;; figure out the correct :mode and :verify-guards, based on current state
+       (symbol-class (getprop fn 'acl2::symbol-class nil 'acl2::current-acl2-world world))
+       (decls (cond ((eq symbol-class :program)
+                     (cons `(declare (xargs :mode :program))
+                           decls))
+                    ((eq symbol-class :ideal)
+                     (cons `(declare (xargs :mode :logic :verify-guards nil))
+                           decls))
+                    ((eq symbol-class :common-lisp-compliant)
+                     (cons `(declare (xargs :mode :logic :verify-guards t))
+                           decls))
+                    (t
+                     (raise "Expected valid symbol-class for ~x0, found ~x1."
+                            event-tuple symbol-class))))
+
+       ;; figure out if the function and its executable-counterpart are
+       ;; enabled.  we won't do anything with type-prescriptions since they're
+       ;; completely broken anyway (e.g., the TP you get is based on your
+       ;; current theory, not the theory at the DEFUN time anyway.)
+       ((mv enables disables) (name-to-e/ds fn state)))
+    `((defun ,fn ,formals ,@decls ,body)
+      (in-theory (e/d ,enables ,disables)))))
+
+(defun redundant-clean-defthm-kwdargs (kwdargs)
+  (b* ((?__function__ 'redundant-clean-defthm-kwdargs)
+       ((when (atom kwdargs))
+        nil)
+       ((when (atom (cdr kwdargs)))
+        (raise "odd number of elements in (:kwd val) list?"))
+       ((list* kwd val rest) kwdargs)
+       ((when (or (eq kwd :otf-flg)
+                  (eq kwd :doc)
+                  (eq kwd :hints)
+                  (eq kwd :instructions)))
+        (redundant-clean-defthm-kwdargs rest)))
+    (list* kwd val (redundant-clean-defthm-kwdargs rest))))
+
+(defun redundant-defthm (event-tuple state)
+  (declare (ignorable state))
+  (b* ((?__function__ 'redundant-defthm)
+       (form  (acl2::access-event-tuple-form event-tuple))
+       ((unless (and (consp form)
+                     (eq (car form) 'defthm)))
+        (raise "Called redundant-defthm on ~x0?" event-tuple))
+       (name    (second form))
+       (formula (third form))
+       (kwdargs (redundant-clean-defthm-kwdargs (nthcdr 3 form)))
+       ((mv enables disables) (name-to-e/ds name state)))
+    `((defthm ,name ,formula . ,kwdargs)
+      (in-theory (e/d ,enables ,disables)))))
+
+(defun redundant-defmacro (event-tuple state)
+  (declare (ignorable state))
+  (b* ((?__function__ 'redundant-defmacro)
+       (form  (acl2::access-event-tuple-form event-tuple))
+       ((unless (and (consp form)
+                     (eq (car form) 'defmacro)))
+        (raise "Called redundant-defmacro on ~x0?" event-tuple))
+       (name    (second form))
+       (formals (third form))
+       (decls   (redundant-clean-up-decls (butlast (nthcdr 3 form) 1)))
+       (body    (car (last form)))
+       ;; BOZO how about macro-aliases
+       ;; BOZO how about binop-table
+       ;; BOZO how about untranslate-patterns
+       )
+    `((defmacro  ,name ,formals ,@decls ,body))))
+
+(defun redundant-defconst (event-tuple state)
+  (declare (ignorable state))
+  (b* ((?__function__ 'redundant-defmacro)
+       (form  (acl2::access-event-tuple-form event-tuple))
+       ((unless (and (consp form)
+                     (eq (car form) 'defconst)))
+        (raise "Called redundant-defconst on ~x0?" event-tuple))
+       (name    (second form))
+       (value   (third form))
+       (?doc    (fourth form)))
+    `((defconst ,name ,value))))
+
+(defun redundant-event (name state)
+  (b* ((?__function__ 'redundant-event)
+       (world       (w state))
+       (event-tuple (get-event-tuple name world))
+       (form        (acl2::access-event-tuple-form event-tuple))
+       ((unless (consp form))
+        (raise "For ~x0: expected a valid event form, but found ~x1." name form))
+       (type (car form))
+       ((when (eq type 'defun))    (redundant-defun event-tuple state))
+       ((when (eq type 'defthm))   (redundant-defthm event-tuple state))
+       ((when (eq type 'defmacro)) (redundant-defmacro event-tuple state))
+       ((when (eq type 'defconst)) (redundant-defconst event-tuple state))
+       )
+    (raise "For ~x0: unsupported event type: ~x1" name type)))
+
+(defun redundant-events (names state)
+  (if (atom names)
+      nil
+    (append (redundant-event (car names) state)
+            (redundant-events (cdr names) state))))
+
+(defun defredundant-fn (names state)
+  (let ((events (redundant-events names state)))
+    `(encapsulate
+      ()
+      (set-enforce-redundancy t)
+      (logic)
+      . ,events)))
+
+(defmacro defredundant (&rest names)
+  `(make-event (defredundant-fn ',names state)))
+
diff -Nru acl2-6.2/books/cutil/defrule.lisp acl2-6.3/books/cutil/defrule.lisp
--- acl2-6.2/books/cutil/defrule.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/defrule.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -35,7 +35,8 @@
 
 <ul>
 
-<li>A more concise syntax for @(see hints) that target @('\"Goal\").</li>
+<li>A more concise syntax for @(see acl2::hints) that target
+@('\"Goal\"').</li>
 
 <li>A very concise syntax for
 @({
@@ -43,7 +44,7 @@
     (local (in-theory (e/d ...)))
     (defthm ...))
 })
-with @(see rulesets) integration.</li>
+with @(see acl2::rulesets) integration.</li>
 
 <li>Integration with @(see xdoc).  You can give @(':parents'), @(':short'), and
 @(':long') documentation right at the top level of the @('defrule').</li>
@@ -83,8 +84,8 @@
 they're part of the theory that is inherited by all subgoals.</p>
 
 <p>To make @(':enable'), @(':disable'), and @(':e/d') slightly more powerful,
-they are actually integrated with the @(see rulesets) book.  In particular,
-these keywords are always translated into an @(see e/d*).</p>
+they are actually integrated with the @(see acl2::rulesets) book.  In
+particular, these keywords are always translated into an @(see acl2::e/d*).</p>
 
 <p>Some examples:</p>
 
diff -Nru acl2-6.2/books/cutil/defsection.lisp acl2-6.3/books/cutil/defsection.lisp
--- acl2-6.2/books/cutil/defsection.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/defsection.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-; CUTIL - Centaur Basic Utilities
-; Copyright (C) 2008-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "CUTIL")
-
-;; cert_param: (reloc_stub)
-(include-book "xdoc/top" :dir :system)
-(include-book "tools/bstar" :dir :system)
-
-;; Legacy book for compatibility -- use xdoc/defsection instead.
diff -Nru acl2-6.2/books/cutil/formals.lisp acl2-6.3/books/cutil/formals.lisp
--- acl2-6.2/books/cutil/formals.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/formals.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -78,7 +78,7 @@
 <ul>
 <li>A function, @('name-fn'),</li>
 <li>A wrapper macro, @('name'),</li>
-<li>A <see topic='@(url macro-aliases-table)'>macro alias</see> associating
+<li>A <see topic='@(url acl2::macro-aliases-table)'>macro alias</see> associating
 @('name-fn') with @('name')</li>
 </ul>
 
@@ -139,13 +139,13 @@
 <p>Some other features of extended formals are not evident in their syntax.</p>
 
 <p>We generally expect macros that take extended formals to automatically
-recognize @(see stobj)s and insert appropriate @('(declare (xargs :stobjs
+recognize @(see acl2::stobj)s and insert appropriate @('(declare (xargs :stobjs
 ...))') forms.</p>
 
 <p>Future work (not yet implemented): certain guards like @('stringp') and
-@('(unsigned-byte-p 32 x)'), are recognized as @(see type-spec)s and result in
-@(see type) declarations for the Lisp compiler.  This may occasionally improve
-efficiency.</p>")
+@('(unsigned-byte-p 32 x)'), are recognized as @(see acl2::type-spec)s and
+result in @(see type) declarations for the Lisp compiler.  This may
+occasionally improve efficiency.</p>")
 
 ; Internal representation for extended formals
 
diff -Nru acl2-6.2/books/cutil/look-up.lisp acl2-6.3/books/cutil/look-up.lisp
--- acl2-6.2/books/cutil/look-up.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/look-up.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -26,7 +26,7 @@
 (defsection var-is-stobj-p
   :parents (support)
   :short "@(call var-is-stobj-p) checks whether @('var') is currently the name
-of a @(see stobj)."
+of a @(see acl2::stobj)."
 
   (defund var-is-stobj-p (var world)
     (declare (xargs :guard (and (symbolp var)
@@ -98,7 +98,7 @@
 (defsection look-up-return-vals
   :parents (support)
   :short "@(call look-up-return-vals) returns the @('stobjs-out') property for
-@('fn').  This is a list that may contain @('nil')s and @(see stobj) names,
+@('fn').  This is a list that may contain @('nil')s and @(see acl2::stobj) names,
 with the same length as the number of return vals for @('fn')."
 
   (defund look-up-return-vals (fn world)
@@ -164,3 +164,40 @@
      (assert! (equal (look-up-wrapper-args 'f3 (w state))
                      '(x y &key (c '5) (d '7)))))))
 
+
+
+(defsection logic-mode-p
+  :parents (support)
+  :short "@(call logic-mode-p) looks up the function @('fn') and returns
+@('t') if @('fn') is in logic mode, or @('nil') otherwise.  It causes a
+hard error if @('fn') isn't a function."
+
+  (defund logic-mode-p (fn world)
+    (declare (xargs :guard (and (symbolp fn)
+                                (plist-worldp world))))
+    (b* ((__function__ 'logic-mode-p)
+         (look (getprop fn 'acl2::formals :bad 'acl2::current-acl2-world world))
+         ((when (eq look :bad))
+          (raise "Can't look up the formals for ~x0!" fn))
+         (symbol-class (getprop fn 'acl2::symbol-class nil 'acl2::current-acl2-world world))
+         ((unless (member symbol-class '(:common-lisp-compliant
+                                         :ideal
+                                         :program)))
+          (raise "Unexpected symbol-class for ~x0: ~x1." fn symbol-class)))
+      (not (eq symbol-class :program))))
+
+  (local (in-theory (enable logic-mode-p)))
+
+  (defthm booleanp-of-look-up-formals
+    (or (equal (logic-mode-p fn world) t)
+        (equal (logic-mode-p fn world) nil))
+    :rule-classes :type-prescription)
+
+  (local
+   (progn
+     (defun f (x) (declare (xargs :mode :program)) x)
+     (defun g (x) x)
+     (defun h (x) (declare (xargs :verify-guards t)) x)
+     (assert! (logic-mode-p 'g (w state)))
+     (assert! (logic-mode-p 'h (w state)))
+     (assert! (not (logic-mode-p 'f (w state)))))))
diff -Nru acl2-6.2/books/cutil/package.lsp acl2-6.3/books/cutil/package.lsp
--- acl2-6.2/books/cutil/package.lsp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/package.lsp	2013-09-30 17:52:17.000000000 +0000
@@ -21,9 +21,9 @@
 (in-package "ACL2")
 
 ; We load these here now so we can import their symbols into cutil as desired.
-(ld "str/package.lsp" :dir :system)
-(ld "xdoc/package.lsp" :dir :system)
-(ld "finite-set-theory/osets/sets.defpkg" :dir :system)
+(include-book "str/portcullis" :dir :system)
+(include-book "xdoc/portcullis" :dir :system)
+(include-book "std/osets/portcullis" :dir :system)
 
 (defpkg "CUTIL"
   (set-difference-eq
@@ -71,6 +71,7 @@
                repeat
                list-fix
                rev
+               rcons
                revappend-without-guard
                value
                two-nats-measure
diff -Nru acl2-6.2/books/cutil/returnspecs.lisp acl2-6.3/books/cutil/returnspecs.lisp
--- acl2-6.2/books/cutil/returnspecs.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/returnspecs.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -119,7 +119,7 @@
 
 <dd>This option only makes sense when there is a return-type term.  By default,
 the return-type theorem is added as a @(':rewrite') rule.  If you want to use
-other @(see rule-classes), then you will want to override this default.</dd>
+other @(see acl2::rule-classes), then you will want to override this default.</dd>
 
 </dl>")
 
diff -Nru acl2-6.2/books/cutil/support.lisp acl2-6.3/books/cutil/support.lisp
--- acl2-6.2/books/cutil/support.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/support.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -68,10 +68,11 @@
   :short "Shorthand for causing hard errors."
 
   :long "<p>@(call raise) is equivalent to @('(er hard? ...)'), but it
-automatically fills in the function name using @('__function__').  This only
-works in contexts where @('__function__') is bound, e.g., the body of a @(see
-define) or within a @(see defconsts) form.  In these contexts, rather than
-write something like:</p>
+automatically fills in the function name using @('__function__').</p>
+
+<p>This only works in contexts where @('__function__') is bound, e.g., the body
+of a @(see define) or within a @(see defconsts) form.  In these contexts,
+rather than write something like:</p>
 
 @({
  (er hard? __function__ \"bad input value ~x0~%\" x)
diff -Nru acl2-6.2/books/cutil/top.lisp acl2-6.3/books/cutil/top.lisp
--- acl2-6.2/books/cutil/top.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/cutil/top.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -28,9 +28,13 @@
 (include-book "defprojection")
 (include-book "define")
 (include-book "defrule")
+(include-book "defredundant")
 
 (defxdoc cutil
-  :short "Centaur Utility Library"
+  :parents (acl2::macro-libraries)
+  :short "The Centaur Utility Library&mdash;automates defining types,
+introducing typed functions, mapping over lists, and other boilerplate stuff,
+with good integration with the @(see acl2::std) libraries."
 
   :long "<p>We provide macros for</p>
 
diff -Nru acl2-6.2/books/data-structures/utilities.lisp acl2-6.3/books/data-structures/utilities.lisp
--- acl2-6.2/books/data-structures/utilities.lisp	2013-06-06 17:11:05.000000000 +0000
+++ acl2-6.3/books/data-structures/utilities.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -100,7 +100,7 @@
 ; intern-in-package-of-symbol
 ; keyword-value-listp
 ; member-equal
-  msg
+; msg
 ; program
   translate-declaration-to-guard-var-lst
 ; true-listp
diff -Nru acl2-6.2/books/defsort/duplicity.lisp acl2-6.3/books/defsort/duplicity.lisp
--- acl2-6.2/books/defsort/duplicity.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/defsort/duplicity.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,6 +0,0 @@
-
-(in-package "ACL2")
-
-;; cert_param: (reloc_stub)
-
-(include-book "std/lists/duplicity" :dir :system)
diff -Nru acl2-6.2/books/demos/modeling/nested-stobj-toy-isa.acl2 acl2-6.3/books/demos/modeling/nested-stobj-toy-isa.acl2
--- acl2-6.2/books/demos/modeling/nested-stobj-toy-isa.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/demos/modeling/nested-stobj-toy-isa.acl2	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,7 @@
+; Matt Kaufmann
+; Copyright (C) 2013, Regents of the University of Texas
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
+; This file is necessary only to avoid dependence on cert.acl2.
+
+(certify-book "nested-stobj-toy-isa" 0 t)
diff -Nru acl2-6.2/books/finite-set-theory/osets/CHANGES.html acl2-6.3/books/finite-set-theory/osets/CHANGES.html
--- acl2-6.2/books/finite-set-theory/osets/CHANGES.html	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/CHANGES.html	1970-01-01 00:00:00.000000000 +0000
@@ -1,250 +0,0 @@
-<html>
-<head>
-<title>Osets Change Log</title>
-<link rel="stylesheet" href="http://www.cs.utexas.edu/users/jared/style.css"
-      type="text/css"/>
-</head>
-<body>
-
-<table border="0" width="100%" bgcolor="#f0f0f0" class="logo"
-       cellpadding="8">
-<tr>
-<td align="center" class="logoText">
-Finite Set Theory based on Fully Ordered Lists<br/>
-</td>
-</tr>
-</table>
-
-<h3>Change Log</h3>
-
-<h4>Changes Since 0.91</h4>
-
-<p><em>Added intersectp function</em>.  This is like intersect, but does not
-   bother to construct the list.  As a result, it may allow you to avoid
-   consing when you are only concerned with whether sets intersect.</p>
-
-<p><em>Redesigned split-list</em>.  The mergesort now uses a new split-list
-   function which involves about half the consing.</p>
-
-<p><em>Mergesort's guard is improved.</em>  Mergesort no longer requires your
-   input to be a true-listp.</p>
-
-<p><em>Various efficiency tweaks.</em>  Mostly inlining of set primtiives with
-  MBE to avoid function call overhead.  This is actually fairly significant in
-  some cases.</p>
-
-<p><em>Changed the set order.</em>  I now use <tt>&lt;&lt;</tt> directly from
-  the <tt>misc/total-order</tt> book instead of
-  defining <tt>sets::&lt;&lt;</tt> as a distinct function.</p>
-
-<p><em>Slightly changed empty-set handling.</em>  In some cases I now expose
-  the fact that <tt>nil</tt> is the empty set.</p>
-
-<p><em>Eliminated in-list function.</em>  I now just use ACL2's built in member
-  stuff, which seems better than introducing yet another member function.</p>
-
-<p><em>Revamped the strategy for doing fast functions.</em>  I now try to push
-  everything down to list primitives instead of pushing some things up to set
-  primitives.  This simplifies fast.lisp, removing lots of ugly use hints.</p>
-
-<p><em>Cleaned up set-order theories.</em>  I now use
-  the <tt>tools/rulesets</tt> book to handle set-order theories, and put these
-  rulesets right into <tt>sets.lisp</tt> instead of in a separate book.</p>
-
-
-
-<h4>Version 0.91, January 28, 2006</h4>
-
-<p>This is a relatively minor release for efficiency improvements and minor
-tweaks to the reasoning strategy.</p>
-
-<p><em>Certain operations are now tail recursive.</em> Previously, functions
-   such as <tt>fast-union</tt>, <tt>fast-intersect</tt>,
-   <tt>fast-difference</tt>, were not implemented tail recursively.  This could
-   cause overflows on very large lists.  Thanks to David Rager for identifying
-   this problem and for submitting patches to make these functions tail
-   recursive, eliminating the problem.  Also made <tt>split-list</tt> tail
-   recursive, at David Rager's suggestion.
-   </p>
-
-<p><em>Cardinality has been given a speed boost.</em> The executable version
-   of cardinality now calls <tt>length</tt> instead of <tt>len</tt>.
-   </p>
-
-<p><em>Subset is now enabled.</em> Disabling the subset function was causing
-   some problems in finishing pick a point proofs.  It is now enabled by
-   default.
-   </p>
-
-<p><em>Added <tt>:built-in-clause</tt> rules about the <tt>acl2-count</tt> of
-   <tt>head</tt> and <tt>tail</tt>.</em></p>
-
-<p><em>Added the rule <tt>in-head</tt>, rewriting <tt>(in (head X) X)</tt> to 
-   <tt>(not (empty X))</tt>.</em></p>
-
-
-<h4>Version 0.9, October 22, 2004</h4>
-
-<p>This is a major release.</p>
-
-  <p><em>The library now requires ACL2 2.9.</em></p>
-
-  <p><em>The set order has been changed.</em> We now use the same
-  <tt>&lt;&lt;</tt> as the total-order book.  Effectively, we make
-  fewer assumptions about the set order, no longer requiring that nil
-  be the greatest element.  This change might allow us to consider
-  custom set orders in the future.  This was a bit of an undertaking.
-  Many proofs in <tt>membership.lisp</tt> and <tt>fast.lisp</tt> have
-  been changed to avoid relying on <tt>nil</tt>'s maximality.  There
-  are also some changes in other low level theorems, such as
-  <tt>head-insert</tt>.  There should be little or no impact on user
-  theorems, unless you were reasoning "from first principles", e.g.,
-  for "fast" functions defined using <tt>cons</tt> and so forth.</p>
-
-  <p><em>Computed hints are now automatically managed.</em>
-  Previously, the macros <tt>enable/disable-set-reasoning</tt> were
-  used to turn on the computed hint for conducting pick-a-point
-  proofs.  These macros have been removed and are no longer necessary,
-  and pick-a-point proofs are automatically enabled.  (To disable
-  them, disable the "tagging" theorem,
-  <tt>pick-a-point-subset-strategy</tt>, instead.)  Thanks to Matt
-  Kaufmann for modifying ACL2 to permit this change.</p>
-
-  <p><em><tt>Membership.lisp</tt> has been cleaned up.</em> The
-  support for computed hints have been separated out and put into its
-  own package, <tt>COMPUTED-HINTS</tt>.  The encapsulate event which
-  the pick-a-point subset strategy was based on is now more general
-  and can be used with the new extensions in this release.  The
-  pick-a-point method is now developed earlier in the membership.lisp
-  file, and is used in order to prove many of the theorems which used
-  to be based on induction arguments, e.g., <tt>subset-reflexive</tt>.
-  </p>
-
-  <p><em>A new package, <tt>INSTANCE</tt>, has been added to support
-  the new extensions.</em>  Users should not need to use this package
-  directly.</p>
-
-  <p><em>New extension: constructive quantification.</em> This
-  extension (in <tt>quantify.lisp</tt>) completely replaces typed sets
-  with a more general and powerful theory of constructive
-  quantification.  Given a k-ary (k > 1) predicate <tt>P</tt>, you can
-  now quickly introduce a theory of quantification for that predicate
-  over sets and lists.</p>
- 
-  <p><em>New extension: mappings.</em> Building off the base provided
-  by constructive quantification, mappings allow you to discuss the
-  images of sets under some arbitrary k-ary function, F, where (k > 1).
-  As with constructive quantification, an elaborate rewriting strategy
-  is also introduced for reasoning about mappings.  Mappings are also
-  implemented more efficiently (via MBE) than the naive implementation 
-  using repeated insertion.</p>
-
-  <p><em>Mergesort is easier to reason about.</em> <tt>Mergesort</tt>
-  now has a new logical definition via MBE, so that you can reason
-  about it as if it were a simple, recursive insert sort.  Of course,
-  it still acts as an efficient mergesort under the hood.  Thanks to
-  Serita Nelesen for pointing out the deficiencies with the previous 
-  approach.  I've also done away with the use of <tt>member-equal</tt>,
-  and instead a new <tt>in-list</tt> function has been added which 
-  returns a boolean instead of part of the list.</p>
-
-  <p><em>Cardinality reasoning has been improved.</em> This is
-  particularly true with regards to the cardinalities of
-  intersections.  Added theorems <tt>cardinality-zero-empty</tt>,
-  <tt>intersect-cardinality-non-subset</tt>,
-  <tt>intersect-cardinality-subset-2</tt>, and
-  <tt>intersect-cardinality-non-subset-2</tt>.  Also changed
-  <tt>intersect-cardinality-subset</tt> to also be a :rewrite rule in
-  addition to being :linear.  Thanks to Robert Krug and Hanbing Liu
-  for their input in these changes.</p>
-
-  <p><em>Subset reasoning has been improved.</em> Added the theorem
-  <tt>subset-tail</tt> at Hanbing Liu's suggestion, which is useful
-  for induction-style proofs of subset.  Also, the theorems
-  <tt>difference-preserves-subset</tt> and <tt>subset-delete</tt>,
-  have been added at Omar El-Domeiri's suggestion.  Finally,
-  <tt>subset-insert</tt> has been added, and parallels
-  <tt>subset-delete</tt>.</p>
-
-
-<h4>Version 0.81, March 23, 2004</h4>
-
-<p>This is a minor release to merge the library with ACL2.</p>
-
-  <p><em>Matt Kaufmann has integreated the library with ACL2.</em> The
-  library will now be part of the standard books released with ACL2.
-  The build system has been modified to work nicely with ACL2's
-  makefiles, changed the computed hints functions to be program mode
-  in order to fix some problems with the new, more stringent guard
-  checking in ACL2 2.8.  He has also updated the README to be more
-  accurate about what is built, and cleaned up the stray parentheses
-  in membership.lisp.  Thanks, Matt!</p>
-
-
-<h4>Version 0.8, March 18, 2004</h4>
-
-<p>This is a significant release, involving significant cleanup work
-and a few new theorems.</p>
-
-  <p><em>The build system has been significantly improved.</em> A file
-  <tt>package.lisp</tt> has been added, and now contains the defpkg
-  event for the set theory books, so you can now simply "ld" this file
-  to get the set theory package.  The <tt>.acl2</tt> have been changed
-  so that they do not contain include-book events, and
-  <tt>sets.lisp</tt> now includes the other books locally and then
-  redefines events from those books.  This approach makes loading
-  <tt>sets.lisp</tt> faster, allows us to export events in a better
-  order, and hides all of the local proofs.  These changes have all
-  been made at the suggestion of Eric Smith.  Thanks!
-  </p>
-
-  <p><em>A mergesort has been added.</em> This allows you to quickly
-  create a set from an unordered list which may contain duplicates, 
-  and its performance seems quite good.</p>
-
-  <p><em>Optional set order reasoning is now available.</em> The file
-  <tt>set-order.lisp</tt> has been added and can be optionally
-  included to help with reasoning about the set order.  Of course,
-  this should only be done if you are arguing from "first principles"
-  that your functions create sets, and should otherwise generally be
-  avoided.</p>
-
-  <p><em>Double containment is now a rewrite rule.</em>  A new theorem,
-  double-containment, has been added in order to explicitly rewrite 
-  equalities between sets into mutual subset statements.  The computed
-  hints which previously performed double containment proofs have been
-  removed.  
-
-  <p><em>Computed hints can now be easily disabled.</em> The macro
-  <tt>disable-set-reasoning</tt> has been added, and can be used to
-  turn off the pick-a-point proofs that enable-set-reasoning turns
-  on.</p>
-
-  <p><em>Some new theorems help fill out the rewriting strategy.</em>
-  In particular, the theorems <tt>difference-insert-X/Y</tt> and
-  <tt>difference-delete-X/Y</tt> were added.</p>
-
-
-<h4>Version 0.7, Feb 19, 2004</h4>
-
-<p>This is a minor release, mainly introducing a new extension.</p>
-
-  <p><em>A new induction scheme is now used for insert.</em> This
-  induction scheme rephrases insert's operation in terms of membership
-  rather than the set order, allowing inductive proofs over the
-  definition of insert to avoid introducing the set order into
-  proofs.</p>
- 
-  <p><em>New extension: typed sets.</em> This extension allows you to
-  introduce a theory about sets which contain elements of a fixed
-  type, e.g., <tt>integerp</tt>.</p>
-
-
-
-<h4>Version 0.6, Feb 1, 2004</h4>
-
-<p>This is the first publically available version of the set theory
-library.</p>
-
-</body>
-</html>
diff -Nru acl2-6.2/books/finite-set-theory/osets/COPYING acl2-6.3/books/finite-set-theory/osets/COPYING
--- acl2-6.2/books/finite-set-theory/osets/COPYING	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/COPYING	1970-01-01 00:00:00.000000000 +0000
@@ -1,340 +0,0 @@
-		    GNU GENERAL PUBLIC LICENSE
-		       Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
-                       59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-			    Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users.  This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it.  (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.)  You can apply it to
-your programs, too.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
-  To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
-  For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have.  You must make sure that they, too, receive or can get the
-source code.  And you must show them these terms so they know their
-rights.
-
-  We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
-  Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software.  If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
-  Finally, any free program is threatened constantly by software
-patents.  We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary.  To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-		    GNU GENERAL PUBLIC LICENSE
-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-  0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License.  The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language.  (Hereinafter, translation is included without limitation in
-the term "modification".)  Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope.  The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
-  1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
-  2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
-    a) You must cause the modified files to carry prominent notices
-    stating that you changed the files and the date of any change.
-
-    b) You must cause any work that you distribute or publish, that in
-    whole or in part contains or is derived from the Program or any
-    part thereof, to be licensed as a whole at no charge to all third
-    parties under the terms of this License.
-
-    c) If the modified program normally reads commands interactively
-    when run, you must cause it, when started running for such
-    interactive use in the most ordinary way, to print or display an
-    announcement including an appropriate copyright notice and a
-    notice that there is no warranty (or else, saying that you provide
-    a warranty) and that users may redistribute the program under
-    these conditions, and telling the user how to view a copy of this
-    License.  (Exception: if the Program itself is interactive but
-    does not normally print such an announcement, your work based on
-    the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole.  If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works.  But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
-  3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
-    a) Accompany it with the complete corresponding machine-readable
-    source code, which must be distributed under the terms of Sections
-    1 and 2 above on a medium customarily used for software interchange; or,
-
-    b) Accompany it with a written offer, valid for at least three
-    years, to give any third party, for a charge no more than your
-    cost of physically performing source distribution, a complete
-    machine-readable copy of the corresponding source code, to be
-    distributed under the terms of Sections 1 and 2 above on a medium
-    customarily used for software interchange; or,
-
-    c) Accompany it with the information you received as to the offer
-    to distribute corresponding source code.  (This alternative is
-    allowed only for noncommercial distribution and only if you
-    received the program in object code or executable form with such
-    an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it.  For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable.  However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
-  4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License.  Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
-  5. You are not required to accept this License, since you have not
-signed it.  However, nothing else grants you permission to modify or
-distribute the Program or its derivative works.  These actions are
-prohibited by law if you do not accept this License.  Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
-  6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions.  You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
-  7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all.  For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices.  Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
-  8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded.  In such case, this License incorporates
-the limitation as if written in the body of this License.
-
-  9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time.  Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number.  If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation.  If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
-  10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission.  For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this.  Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
-			    NO WARRANTY
-
-  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
-  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
-		     END OF TERMS AND CONDITIONS
-
-	    How to Apply These Terms to Your New Programs
-
-  If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
-  To do so, attach the following notices to the program.  It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the program's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
-    Gnomovision version 69, Copyright (C) year name of author
-    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
-    This is free software, and you are welcome to redistribute it
-    under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License.  Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary.  Here is a sample; alter the names:
-
-  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
-  `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
-  <signature of Ty Coon>, 1 April 1989
-  Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs.  If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library.  If this is what you want to do, use the GNU Library General
-Public License instead of this License.
diff -Nru acl2-6.2/books/finite-set-theory/osets/Makefile acl2-6.3/books/finite-set-theory/osets/Makefile
--- acl2-6.2/books/finite-set-theory/osets/Makefile	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-include ../../Makefile-generic
--include Makefile-deps
diff -Nru acl2-6.2/books/finite-set-theory/osets/README acl2-6.3/books/finite-set-theory/osets/README
--- acl2-6.2/books/finite-set-theory/osets/README	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/README	1970-01-01 00:00:00.000000000 +0000
@@ -1,52 +0,0 @@
-_____________________________________________________________________
-
-                 Fully Ordered Finite Sets for ACL2
-               Copyright (C) 2003, 2004 by Jared Davis
-
-                       Version 0.91 - README
-_____________________________________________________________________
-
-
-  About
-
-    This is a finite set theory library for ACL2.
-
-       ACL2 Home Page:
-        - http://www.cs.utexas.edu/users/moore/acl2/
-
-       Ordered Sets Home Page:
-        - http://www.cs.utexas.edu/users/jared/osets/
-
-    The home page includes documentation and information on the 
-    latest and upcoming versions, and you should check to make
-    sure you have a recent copy.
-  
-    This library is licensed under the GNU General Public License,
-    see the file COPYING for more information.
-  
-
-
-  Build Instructions
-
-    NOTE: You may already have a current copy of the library installed!
-    Check your ACL2 distribution, under finite-set-theory/osets,
-    to see what version of the library came with your copy of ACL2.
-    Otherwise, here is how to build the library:
-
-    1. Edit the makefile.
-
-       - Change "include [...]/Makefile-generic" to point to the 
-         file Makefile-generic in your acl2-sources/books 
-         directory.
-
-       - Change "ACL2 = acl2" to point to your ACL2 executable or
-         script, typically "[...]/acl2-sources/saved_acl2"
-
-    2. Run "make" to build the library.
-
-       - Check to make sure that the following files were created:
-         sets.cert, quantify.cert, set-order.cert, and map.cert.  
-         If there was a problem, please send a report to 
-         jared@cs.utexas.edu.
-
-  All usage instructions are on the web page.
diff -Nru acl2-6.2/books/finite-set-theory/osets/acl2-customization.lsp acl2-6.3/books/finite-set-theory/osets/acl2-customization.lsp
--- acl2-6.2/books/finite-set-theory/osets/acl2-customization.lsp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,20 +0,0 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-#!ACL2
-(in-package "ACL2")
-
-(ld "~/acl2-customization.lsp" :ld-missing-input-ok t)
-(ld "sets.defpkg")
-(include-book "portcullis")
-(in-package "SETS")
diff -Nru acl2-6.2/books/finite-set-theory/osets/cardinality.lisp acl2-6.3/books/finite-set-theory/osets/cardinality.lisp
--- acl2-6.2/books/finite-set-theory/osets/cardinality.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/cardinality.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,141 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "SETS")
-(include-book "delete")
-(set-verify-guards-eagerness 2)
-
-(defsection cardinality
-  :parents (osets)
-  :short "@(call cardinality) computes the number of elements in @('X')."
-
-  :long "<p>This is like @(see length), but respects the non-set convention and
-always returns 0 for ill-formed sets.</p>"
-
-  (defun cardinality (X)
-    (declare (xargs :guard (setp X)
-                    :verify-guards nil))
-    (mbe :logic (if (empty X)
-                    0
-                  (1+ (cardinality (tail X))))
-         :exec  (length (the list X))))
-
-  (verify-guards cardinality
-    ;; Normally we would never want to enable the primitives theory.  However,
-    ;; here we need to show that cardinality is equal to length, and for this
-    ;; we need to be able to reason about tail and empty.  Think of this as a
-    ;; tiny extension of "fast.lisp"
-    :hints(("Goal" :in-theory (enable (:ruleset primitive-rules)))))
-
-  (defthm cardinality-type
-    (and (integerp (cardinality X))
-         (<= 0 (cardinality X)))
-    :rule-classes :type-prescription)
-
-  (defthm cardinality-zero-empty
-    (equal (equal (cardinality x) 0)
-           (empty x)))
-
-  (defthm cardinality-sfix-cancel
-    (equal (cardinality (sfix X)) (cardinality X)))
-
-  (encapsulate ()
-
-    (local (defthm cardinality-insert-empty
-             (implies (empty X)
-                      (equal (cardinality (insert a X)) 1))
-             :hints(("Goal" :use (:instance cardinality (x (insert a nil)))))))
-
-    (defthm insert-cardinality
-      (equal (cardinality (insert a X))
-             (if (in a X)
-                 (cardinality X)
-               (1+ (cardinality X))))))
-
-  (defthm delete-cardinality
-    (equal (cardinality (delete a X))
-           (if (in a X)
-               (1- (cardinality X))
-             (cardinality X))))
-
-; Now that we have the delete function, we can prove an interesting
-; theorem, namely that if (subset X Y) and |X| = |Y|, then X = Y.  In
-; order to do this, we need to induct by deleting elements from both
-; X and Y.  This is a little ugly, but along the way we will show the
-; nice theorem, subset-cardinality.
-
-  (local (defun double-delete-induction (X Y)
-           (declare (xargs :guard (and (setp X) (setp Y))))
-           (if (or (empty X) (empty Y))
-               (list X Y)
-             (double-delete-induction (delete (head X) X)
-                                      (delete (head X) Y)))))
-
-  (local (defthmd subset-double-delete
-           (implies (subset X Y)
-                    (subset (delete a X) (delete a Y)))
-           :hints(("Goal" :in-theory (disable delete-nonmember-cancel
-                                              in-tail-or-head)))))
-
-  (encapsulate
-    ()
-    (local (defthm subset-cardinality-lemma
-             (implies (and (not (or (empty x) (empty y)))
-                           (implies (subset (delete (head x) x)
-                                            (delete (head x) y))
-                                    (<= (cardinality (delete (head x) x))
-                                        (cardinality (delete (head x) y)))))
-                      (implies (subset x y)
-                               (<= (cardinality x) (cardinality y))))
-             :hints(("goal" :use ((:instance subset-double-delete
-                                             (a (head x))
-                                             (x x)
-                                             (y y)))))))
-
-    (defthm subset-cardinality
-      (implies (subset X Y)
-               (<= (cardinality X) (cardinality Y)))
-      :hints(("Goal" :induct (double-delete-induction X Y)))
-      :rule-classes (:rewrite :linear)))
-
-  (defthmd equal-cardinality-subset-is-equality
-    (implies (and (setp X)
-                  (setp Y)
-                  (subset X Y)
-                  (equal (cardinality X) (cardinality Y)))
-             (equal (equal X Y) t))
-    :hints(("Goal" :induct (double-delete-induction X Y))
-           ("Subgoal *1/2"
-            :use ((:instance subset-double-delete
-                             (a (head X))
-                             (X X)
-                             (Y Y))
-                  (:instance (:theorem
-                              (implies (equal X Y)
-                                       (equal (insert a X) (insert a Y))))
-                             (a (head X))
-                             (X (tail X))
-                             (Y (delete (head X) Y)))))))
-
-  (defthm proper-subset-cardinality
-    (implies (and (subset X Y)
-                  (not (subset Y X)))
-             (< (cardinality X) (cardinality Y)))
-    :rule-classes (:rewrite :linear)
-    :hints(("Goal"
-            :in-theory (disable pick-a-point-subset-strategy)
-            :use ((:instance equal-cardinality-subset-is-equality
-                             (X (sfix x))
-                             (Y (sfix y))))))))
-
-
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/cardinality" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/cert.acl2 acl2-6.3/books/finite-set-theory/osets/cert.acl2
--- acl2-6.2/books/finite-set-theory/osets/cert.acl2	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/cert.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,16 +0,0 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(value :q)
-(lp)
-(include-book "portcullis")
diff -Nru acl2-6.2/books/finite-set-theory/osets/computed-hints.lisp acl2-6.3/books/finite-set-theory/osets/computed-hints.lisp
--- acl2-6.2/books/finite-set-theory/osets/computed-hints.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/computed-hints.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,405 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; computed-hints.lisp
-;
-; We provide support for the development of "pick a point" style proofs through
-; computed hints.
-
-
-(in-package "COMPUTED-HINTS")
-
-; Introduction
-;
-; Suppose we have some predicate, P, of any number of arguments.  A natural
-; operation is to extend this predicate to every element of a list, set, or
-; other collection.  In other words, we would like to know if every element in
-; the set, list, tree, or whatever has the property when applied to arguments.
-;
-; For example, we might have the predicate:
-;
-;  (defun integer-lessp (a b)
-;    (and (integerp a)
-;         (< a b)))
-;
-; We could now extend this concept to an entire list, to ask if every element
-; in the list was an integer that is less than b.  The function might be
-; written as:
-;
-;  (defun list-integer-lessp (a-list b)
-;    (declare (xargs :guard (true-listp a-list)))
-;    (or (endp a-list)
-;        (and (integer-lessp (car a-list) b)
-;             (list-integer-lessp (cdr a-list) b))))
-;
-; Similarly, we might want to map the function across sets or other types of
-; collections.
-;
-; Take an abstract mathematical view for a moment.  Given some predicate P,
-; what we would really like to do is be able to express the idea that given
-; some collection x, every element of x satisfies P.  In other words, we want
-; to define:
-;
-;  (collection-P x [args]) = forall a in x, (P x [args])
-;
-; And indeed, it would be nice to be working with this very abstract
-; mathematical definition, for which we will not need to make inductive
-; arguments.  Unfortunately, because all variables in ACL2's rewrite rules are
-; implicitly universally quantified, we cannot express the above as a rewrite
-; rule.
-;
-; However, through the use of constrained function symbols and functional
-; instantiation, we can effectively accomplish the above reduction when it
-; suits our purposes.  And, the process can be automated through the use of
-; computed hints.  Overall, this is not as nice as working with a pure rewrite
-; rule, and in fact has some unfortunate limitations.  However, it does turn
-; out to be very broadly applicable and invaluable for reasoning about set
-; theoretic concepts, where concepts such as "subset" are really nothing more
-; than the extension of the predicate "in" across a set.
-;
-; Moreover, the reduction that we set out to achieve will reduce (collection-P
-; x [args]) to the following implication:
-;
-;   (implies (in a x)
-;            (P a [args]))
-;
-; I call this a "pick a point" reduction, because it is similar to and takes
-; its inspiration from the well known set theoretic technique of picking an
-; arbitrary element (or point) in one set, then showing it is also a member of
-; another set.
-
-
-
-; Preliminaries
-;
-; We will make minor use of the rewriting system developed in instance.lisp.
-; We also enter program mode, because we are not interested in reasoning about
-; these functions.
-
-(include-book "instance")
-(program)
-
-
-; Tagging
-;
-; Suppose that we have (collection-P x a0 a1 ... an) to a simpler argument.  We
-; begin by defining a synonym for collection-P, e.g.,
-;
-; (defun collection-P-tag (x a0 a1 ... an)
-;   (collection-P x a0 a1 ... an))
-;
-; Now we instruct the theorem prover to rewrite instances of conclusion into
-; conclusion-tag, as long as we are not backchaining and as long as conclusion
-; occurs as the goal.  For example,
-;
-; (defthm tagging-theorem
-;   (implies
-;     (and (syntaxp (rewriting-goal-lit mfc state))
-;          (syntaxp (rewriting-conc-lit `(collection-P ,x ,a0 ... ,an)
-;                                       mfc state)))
-;            (equal (collection-P x a0 ... an)
-;                   (collection-P-tag x a0 ... an))))
-;
-; This theorem is trivial to prove, since collection-P-tag is merely a synonym
-; for collection-P.  After the theorem is proven, collection-P-tag should be
-; disabled.
-
-(defun rewriting-goal-lit (mfc state)
-  (declare (xargs :stobjs state)
-	   (ignore state))
-  (null (mfc-ancestors mfc)))
-
-(defun rewriting-conc-lit (term mfc state)
-  (declare (xargs :stobjs state)
-	   (ignore state))
-  (let ((clause (mfc-clause mfc)))
-    (member-equal term (last clause))))
-
-
-
-
-; Computing a Hint
-;
-; Now, what we are going to do next is create a computed hint that will look
-; for instances of a trigger, and if it sees one, we will try to provide a
-; functional instantiation hint.  This takes some work.  Our computed hint
-; function is called as ACL2 is working to simplify terms, and it is allowed to
-; examine the current clause.  The current clause will be a a disjunction of
-; literals.  For example,
-;
-;   (a ^ b ^ ...) => P  is  (~a v ~b v ... v P)
-;   (a v b v ...) => P  is  subgoal1: (~a v P), sg2: (~b v P), ...
-;
-; Our first step is to see if our computed hint should even be applied to this
-; clause.  We only allow the hint to be applied if the current clause is stable
-; under simplification, i.e., if other attempts to prove it have failed.  At
-; that point, we check the clause to see if our trigger occurs as a term within
-; it.  If so, the tagging theorem has applied and thinks we should try to use
-; our computed hint!
-;
-; We check for the existence of our trigger using the following function,
-; (harvest-trigger clause trigger-fn), which extracts all the terms from clause
-; whose function symbol is trigger-fn, and returns them as a list.
-;
-; Now, our intention is to functionally instantiate the theorem in question.
-; To do this, we need to provide values for the hypotheses and arguments a0
-; ... an.
-;
-; In order to recover the hypotheses, we first remove from the clause all of
-; our trigger terms.  We then negate each of the remaining literals as they
-; occur in the clause.  And, if there are more than one of them, we are going
-; to AND their negations together.  This is done by the functions
-; others-to-negated-list, and others-to-hyps.
-;
-; For example, if we originally had the conjecture (a ^ b ^ ...) => P Then this
-; became the clause: (~a v ~b v ... v P), which is represented by the list
-; ((not a) (not b) ... P).  Suppose that P was our trigger term.  We remove P
-; from the clause, yielding ((not a) (not b) ...), and then we negate all of
-; these literals, creating the list (a b ...).  We now and these together,
-; creating the the term (and a b ...), which was our original hypotheses!
-
-(defun harvest-trigger (clause trigger-fn)
-  (if (endp clause)
-      nil
-    (if (eq (caar clause) trigger-fn)
-        (cons (car clause) (harvest-trigger (cdr clause) trigger-fn))
-      (harvest-trigger (cdr clause) trigger-fn))))
-
-(defun others-to-negated-list (others)
-  (if (endp others)
-      nil
-    (if (equal (caar others) 'not)  ; don't create ugly double not's
-        (cons (second (car others))
-              (others-to-negated-list (cdr others)))
-      (cons (list 'not (car others))
-            (others-to-negated-list (cdr others))))))
-
-(defun others-to-hyps (others)
-  (if (endp others)
-      t
-    (let ((negated (others-to-negated-list others)))
-      (if (endp (cdr negated))  ; don't wrap single literals in and's
-          (car negated)
-        (cons 'and (others-to-negated-list others))))))
-
-
-
-; Absolute Restrictions:
-;
-; Collection predicate must have a first argument which is the collection to
-; traverse!!
-;
-; Need to be able to create hint for predicate as well.
-
-
-
-; Building Hints
-;
-; Our ultimate goal now is to be able to create functional instantiation hints
-; for each trigger which was found.  In other words, we now have a set of
-; triggers which look like the following:
-;
-;  ((collection-P-tag col1 [extra-args1])
-;   (collection-P-tag col2 [extra-args2])
-;    ...)
-;
-; We want to instantiate generic theorems of the form:
-;
-;   (defthm generic-theorem
-;     (implies (hyps)
-;              (collection-P-tag (collection) [extra-args])))
-;
-; Where we have the following generic constraint:
-;
-;   (implies (hyps)
-;            (implies (in a (collection))
-;                     (predicate a)))
-;
-; So, the functional instantiation hints we want to create will look like the
-; following:
-;
-;  (:functional-instance generic-theorem
-;    (hyps         (lambda ()  [substitution for hyps]))
-;    (collection   (lambda ()  [substitution for collection]))
-;    (predicate    (lambda (x) [substitution for predicate]))
-;    (collection-P (lambda (x) [substitution for collection-P])))
-;
-; Lets consider how we can build these substitutions for some trigger =
-; (collection-P-tag col1 [extra-args1]).  Some of this is easy:
-;
-;   The substitution for hyps is actually built using the process described
-;   above, e.g., they are extracted from the clause and eventually restored to
-;   normal using others-to-hyps, so I will not spend any time on them.
-;
-;   The collection is simply (second trigger), since we require that the
-;   collection predicate has the collection as its first argument.
-;
-;   The substitution for collection-P is also fairly easy.  Since we require
-;   that the collection function's first argument is the collection under
-;   examination, we simply need to write (lambda (?x) (actual-collection-P ?x
-;   [extra-args])), where the extra arguments are taken from the trigger we are
-;   looking at.
-;
-;   This leaves us with predicate.  The substitution for predicate is
-;   difficult, because we want to support very flexible predicates involving
-;   many arguments and various weird terms.  To do this, we will allow the user
-;   to provide a rewrite rule that says how to handle the predicate.
-;
-;   In other words, given the trigger (trigger-term col a0 a1 a2 ... an) we
-;   will create the following "base predicate" to rewrite:
-;
-;     (predicate ?x a0 a1 a2 ... an)
-;
-;   Where "predicate" is literally the name of the generic predicate.  The user
-;   can then provide a substitution such as:
-;
-;     (predicate ?x ?y) -> (not (integer-lessp ?x ?y))
-;
-;   And this will transform the above into the desired result.
-
-
-(defun build-hint (trigger                ; list, the actual trigger to use
-		   generic-theorem        ; symbol, the name of generic-theorem
-		   generic-hyps           ; symbol, the name of (hyps)
-		   generic-collection     ; symbol, the name of (collection)
-		   generic-predicate      ; symbol, the name of predicate
-		   generic-collection-P   ; symbol, the name of collection-P
-		   collection-P-sub       ; symbol, name of actual collection-P
-		   hyps-sub               ; the computed substitution for hyps
-		   predicate-rewrite)     ; rewrite rule for predicate
-  (let* ((base-pred (cons generic-predicate (cons '?x (cddr trigger))))
-	 (pred-sub  (instance-rewrite base-pred predicate-rewrite)))
-    `(:functional-instance
-      ,generic-theorem
-      (,generic-hyps
-       (lambda () ,hyps-sub))
-      (,generic-collection
-       (lambda () ,(second trigger)))
-      (,generic-collection-P
-       (lambda (?x) ,(cons collection-P-sub (cons '?x (cddr trigger)))))
-      (,generic-predicate
-       (lambda (?x) ,pred-sub)))))
-
-(defun build-hints (triggers
-		    generic-theorem
-		    generic-hyps
-		    generic-collection
-		    generic-predicate
-		    generic-collection-P
-		    collection-P-sub
-		    hyps-sub
-		    predicate-rewrite)
-  (if (endp triggers)
-      nil
-    (cons (build-hint (car triggers)
-		      generic-theorem
-		      generic-hyps
-		      generic-collection
-		      generic-predicate
-		      generic-collection-P
-		      collection-P-sub
-		      hyps-sub
-		      predicate-rewrite)
-	  (build-hints (cdr triggers)
-		       generic-theorem
-		       generic-hyps
-		       generic-collection
-		       generic-predicate
-		       generic-collection-P
-		       collection-P-sub
-		       hyps-sub
-		       predicate-rewrite))))
-
-
-(defconst *message*
- "~|~%We suspect this conjecture sould be proven by functional ~
-  instantiation of ~x0.  This suspicion is caused by ~x2, so ~
-  if this is not what you want to do, then you should disable ~
-  ~x2.  Accordingly, we suggest the following hint: ~
-  ~%~%~x1~%")
-
-
-
-; Of course, some of those hints can be computed.  Here we write a function to
-; actually provide these hints and install the computed hint function.
-
-(defun automate-instantiation-fn (new-hint-name
-				  generic-theorem
-				  generic-hyps
-				  generic-collection
-				  generic-predicate
-				  generic-collection-P
-				  collection-P-sub
-				  predicate-rewrite
-				  trigger-symbol
-				  tagging-theorem)
-  `(encapsulate ()
-
-     (defun ,new-hint-name (id clause world stable)
-       (declare (xargs :mode :program)
-	        (ignore world))
-       (if (not stable)
-	   nil
-	 (let ((triggers (harvest-trigger clause ,trigger-symbol)))
-	   (if (not triggers)
-	       nil
-	     (let* ((others   (set-difference-equal clause triggers))
-		    (hyps     (others-to-hyps others))
-		    (phrase   (string-for-tilde-@-clause-id-phrase id))
-		    (fi-hints (build-hints triggers
-					   ,generic-theorem
-					   ,generic-hyps
-					   ,generic-collection
-					   ,generic-predicate
-					   ,generic-collection-P
-					   ,collection-P-sub
-					   hyps
-					   ,predicate-rewrite))
-		    (hints    (list :use fi-hints
-				    :expand triggers)))
-	       (prog2$ (cw *message*
-			   ,generic-theorem
-			   (list phrase hints)
-			   ,tagging-theorem)
-		       hints))))))
-
-     (add-default-hints!
-      '((,new-hint-name id clause world stable-under-simplificationp)))
-
-     ))
-
-
-
-
-(defmacro automate-instantiation (&key new-hint-name
-				       generic-theorem
-                                       generic-hyps
-				       generic-collection
-				       generic-predicate
-				       generic-collection-predicate
-				       actual-collection-predicate
-				       predicate-rewrite
-				       actual-trigger
-				       tagging-theorem)
-  (automate-instantiation-fn new-hint-name
-			     (list 'quote generic-theorem)
-			     (list 'quote generic-hyps)
-			     (list 'quote generic-collection)
-			     (list 'quote generic-predicate)
-			     (list 'quote generic-collection-predicate)
-			     (list 'quote actual-collection-predicate)
-			     (list 'quote predicate-rewrite)
-			     (list 'quote actual-trigger)
-			     (list 'quote tagging-theorem)))
-
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/computed-hints" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/delete.lisp acl2-6.3/books/finite-set-theory/osets/delete.lisp
--- acl2-6.2/books/finite-set-theory/osets/delete.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/delete.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,86 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "SETS")
-(include-book "membership")
-(set-verify-guards-eagerness 2)
-
-
-(defsection delete
-  :parents (osets)
-  :short "@(call delete) removes the element @('a') from the set @('X')."
-
-  :long "<p>If @('a') is not a member of @('X'), then the result is just @('X')
-itself.</p>
-
-<p>Efficiency note.  Delete is @('O(n)').  It is very inefficient to call it
-repeatedly.  Instead, consider removing multiple elements with @(see
-difference) or @(see intersect).</p>
-
-<p>The theorem @('delete-in') is the essential correctness property for
-@('delete').</p>"
-
-  (defun delete (a X)
-    (declare (xargs :guard (setp X)
-                    :verify-guards nil))
-    (mbe :logic
-         (cond ((empty X) nil)
-               ((equal a (head X)) (tail X))
-               (t (insert (head X) (delete a (tail X)))))
-         :exec
-         (cond ((endp X) nil)
-               ((equal a (car X)) (cdr X))
-               (t (insert (car X) (delete a (cdr X)))))))
-
-  (defthm delete-set
-    (setp (delete a X)))
-
-  (verify-guards delete
-    :hints(("Goal" :in-theory (enable (:ruleset primitive-rules)))))
-
-  (defthm delete-preserves-empty
-    (implies (empty X)
-             (empty (delete a X))))
-
-  (defthm delete-in
-    (equal (in a (delete b X))
-           (and (in a X)
-                (not (equal a b)))))
-
-  (defthm delete-sfix-cancel
-    (equal (delete a (sfix X))
-           (delete a X)))
-
-  (defthm delete-nonmember-cancel
-    (implies (not (in a X))
-             (equal (delete a X) (sfix X))))
-
-  (defthm delete-delete
-    (equal (delete a (delete b X))
-           (delete b (delete a X)))
-    :rule-classes ((:rewrite :loop-stopper ((a b)))))
-
-  (defthm repeated-delete
-    (equal (delete a (delete a X))
-           (delete a X)))
-
-  (defthm delete-insert-cancel
-    (equal (delete a (insert a X))
-           (delete a X)))
-
-  (defthm insert-delete-cancel
-    (equal (insert a (delete a X))
-           (insert a X)))
-
-  (defthm subset-delete
-    (subset (delete a X) X)))
\ No newline at end of file
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/delete" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/difference.lisp acl2-6.3/books/finite-set-theory/osets/difference.lisp
--- acl2-6.2/books/finite-set-theory/osets/difference.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/difference.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,219 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "SETS")
-(include-book "membership")
-(set-verify-guards-eagerness 2)
-
-
-; Fast Difference
-;
-; As before, we want to show that difference always creates a set and that the
-; produced set has the expected membership properties.  Also as before, these
-; proofs are ugly.
-
-; PATCH (0.91): David Rager noticed that as of v0.9, fast-difference was not
-; tail recursive, and submitted an updated version.  The original
-; fast-difference has been renamed to fast-difference-old, and the new
-; fast-difference replaces it.
-
-(defun fast-difference-old (X Y)
-  (declare (xargs :measure (fast-measure X Y)
-                  :guard (and (setp X) (setp Y))
-                  :verify-guards nil))
-  (cond ((endp X) nil)
-        ((endp Y) X)
-        ((equal (car X) (car Y))
-         (fast-difference-old (cdr X) (cdr Y)))
-        ((mbe :logic (<< (car X) (car Y))
-              :exec (fast-lexorder (car X) (car Y)))
-         (cons (car X) (fast-difference-old (cdr X) Y)))
-        (t
-         (fast-difference-old X (cdr Y)))))
-
-(verify-guards fast-difference-old
-  :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-(local
- (encapsulate ()
-
-   (local (defthm l0
-            (implies (and (consp (fast-difference-old x y))
-                          (or (atom x) (<< a (car x)))
-                          (setp x))
-                     (<< a (car (fast-difference-old x y))))
-            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
-
-   (defthm fast-difference-old-set
-     (implies (and (setp X) (setp Y))
-              (setp (fast-difference-old X Y)))
-     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-   (local (defthm l1
-            (implies (and (member a x)
-                          (not (member a y))
-                          (setp x)
-                          (setp y))
-                     (member a (fast-difference-old x y)))
-            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
-
-   (local (defthm l2
-            (implies (and (member a (fast-difference-old x y))
-                          (setp x)
-                          (setp y))
-                     (and (member a x)
-                          (not (member a y))))
-            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
-
-   (local (defthm member-of-fast-difference-old
-            (implies (and (setp x)
-                          (setp y))
-                     (iff (member a (fast-difference-old x y))
-                          (and (member a x)
-                               (not (member a y)))))))
-
-   (defthm fast-difference-old-membership
-     (implies (and (setp X) (setp Y))
-              (equal (in a (fast-difference-old X Y))
-                     (and (in a X)
-                          (not (in a Y)))))
-     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))))
-
-
-(defun fast-difference (X Y acc)
-  (declare (xargs :measure (fast-measure X Y)
-                  :guard (and (setp X)
-                              (setp Y)
-                              (true-listp acc))
-                  :verify-guards nil))
-  (cond ((endp X) (revappend acc nil))
-        ((endp Y) (revappend acc X))
-        ((equal (car X) (car Y))
-         (fast-difference (cdr X) (cdr Y) acc))
-        ((mbe :logic (<< (car X) (car Y))
-              :exec (fast-lexorder (car X) (car Y)))
-         (fast-difference (cdr X) Y (cons (car X) acc)))
-        (t
-         (fast-difference X (cdr Y) acc))))
-
-(verify-guards fast-difference
-  :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-(encapsulate
-  ()
-  (local (defthm lemma
-           (implies (true-listp acc)
-                    (equal (fast-difference x y acc)
-                           (revappend acc (fast-difference-old x y))))))
-
-  (local (defthm lemma2
-           (equal (fast-difference x y nil)
-                  (fast-difference-old x y))))
-
-  (defthm fast-difference-set
-    (implies (and (force (setp X))
-                  (force (setp Y)))
-             (setp (fast-difference X Y nil))))
-
-  (defthm fast-difference-membership
-    (implies (and (setp X) (setp Y))
-             (equal (in a (fast-difference X Y nil))
-                    (and (in a X)
-                         (not (in a Y))))))
-
-  (in-theory (disable fast-difference
-                      fast-difference-set
-                      fast-difference-membership)))
-
-
-
-(defsection difference
-  :parents (osets)
-  :short "@(call difference) removes all members of @('Y') from @('X')."
-
-  :long "<p>The logical definition is very simple, and the essential
-correctness property is given by @('difference-in').</p>
-
-<p>The execution uses a better, O(n) algorithm to remove the elements by
-exploiting the set order.</p>"
-
-  (defun difference (X Y)
-    (declare (xargs :guard (and (setp X) (setp Y))
-                    :verify-guards nil))
-    (mbe :logic (cond ((empty X) (sfix X))
-                      ((in (head X) Y) (difference (tail X) Y))
-                      (t (insert (head X) (difference (tail X) Y))))
-         :exec (fast-difference X Y nil)))
-
-  (defthm difference-set
-    (setp (difference X Y)))
-
-  (defthm difference-sfix-X
-    (equal (difference (sfix X) Y) (difference X Y)))
-
-  (defthm difference-sfix-Y
-    (equal (difference X (sfix Y)) (difference X Y)))
-
-  (defthm difference-empty-X
-    (implies (empty X)
-             (equal (difference X Y) (sfix X))))
-
-  (defthm difference-empty-Y
-    (implies (empty Y)
-             (equal (difference X Y) (sfix X))))
-
-  (encapsulate ()
-
-    (local (defthm difference-in-X
-             (implies (in a (difference X Y))
-                      (in a X))))
-
-    (local (defthm difference-in-Y
-             (implies (in a (difference X Y))
-                      (not (in a Y)))))
-
-    (defthm difference-in
-      (equal (in a (difference X Y))
-             (and (in a X)
-                  (not (in a Y))))))
-
-  (encapsulate
-    ()
-    ;; bozo shouldn't really need this
-    (local (defthm l0
-             (implies (and (setp y) (setp x) (empty x))
-                      (not (fast-difference x y nil)))
-             :hints(("Goal" :in-theory (enable fast-difference
-                                               (:ruleset low-level-rules))))))
-
-    (verify-guards difference
-      :hints(("Goal" :in-theory (enable fast-difference-set
-                                        fast-difference-membership)))))
-
-  (defthm difference-subset-X
-    (subset (difference X Y) X))
-
-  (defthm subset-difference
-    (equal (empty (difference X Y))
-           (subset X Y)))
-
-  (defthm difference-insert-X
-    (equal (difference (insert a X) Y)
-           (if (in a Y)
-               (difference X Y)
-             (insert a (difference X Y)))))
-
-  (defthm difference-preserves-subset
-    (implies (subset X Y)
-             (subset (difference X Z)
-                     (difference Y Z)))))
\ No newline at end of file
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/difference" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/instance.lisp acl2-6.3/books/finite-set-theory/osets/instance.lisp
--- acl2-6.2/books/finite-set-theory/osets/instance.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/instance.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,644 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; instance.lisp
-;
-; This is a system for dynamically instantiating ACL2 "theories" (which are
-; represented as constants) to create new, concrete "theories".
-
-; BOZO this whole file is probably subsumed by something better, in the
-; make-event era.
-
-(in-package "INSTANCE")
-
-
-; Everything in this file is in program mode.  We do not intend to reason about
-; these functions -- instead, we intend to use these functions to create new
-; functions, which the user will reason about.
-
-(program)
-
-
-; Introduction
-;
-;
-; The following work has been motivated by my work with quantification over
-; sets.  When I started on this file, I had roughly 2000 lines of complicted
-; macros in order to be able to instantiate generic and concrete theories for
-; this work, and it was just becoming unmanageable.  My hope was that rewriting
-; the definitions and theorems into concrete forms would provide a more concise
-; way of instantiating the theory, and make it easier to keep everything
-; consistent.
-;
-; Originally, I wanted to extract the definitions for generic functions from
-; ACL2's state (well, actually from the current world).  But, to do so becomes
-; very complicated, because of the restrictions on macros that they cannot take
-; state as a parameter.  So, the best that I could ever accomplish that way
-; would be to display a list of events, which a user could copy into a file.
-; But, that is wholly unsatisfying, because it would mean that the resulting
-; theories could never be "automagically" updated when new theorems are added
-; to the generic theory.
-;
-; So, instead of doing things that way, I now simply store events in constants.
-; These constants can then be rewritten to create new but related theories.
-;
-; A first step towards this is to introduce a simple rewriter.  Originally I
-; had based my rewriter on the built in one-way-unify function in ACL2, but it
-; operates only on pseudo-terms, and pseudo-terms cannot contain atoms other
-; than symbols.  This gave me serious trouble when trying to rewrite theorems
-; involving constants, e.g., to say that something was an integerp and greater
-; than zero.  So, instead of using one-way-unify, I introduce a simple
-; unification algorithm which has been adapted from Warren Hunt's work.
-
-; The system treats all symbols beginning with a ? as variables, and all other
-; atoms as literals.
-
-(defun instance-variablep (x)
-  (and (symbolp x)
-       (equal (car (explode-atom x 10)) #\?)))
-
-
-
-; We return two values: a boolean flag which indicates if we are successful in
-; finding a match, and a list of substitutions of the form (variable . value).
-; This is all be fairly standard stuff.
-;
-; For example:
-;
-;    (instance-unify-term '(predicate ?x) '(predicate (car a)) nil)
-;    ==>
-;    (t ((?x . (car a))))
-
-(mutual-recursion
-
-  (defun instance-unify-term (pattern term sublist)
-    (if (atom pattern)
-	(if (instance-variablep pattern)
-	    (let ((value (assoc pattern sublist)))
-	      (if (consp value)
-		  (if (equal term (cdr value))
-		      (mv t sublist)
-		    (mv nil nil))
-		(mv t (acons pattern term sublist))))
-	  (if (equal term pattern)
-	      (mv t sublist)
-	    (mv nil nil)))
-      (if (or (atom term)
-	      (not (eq (car term) (car pattern))))
-	  (mv nil nil)
-	(if (or (eq (car term) 'quote)
-		(eq (car pattern) 'quote))
-	    (if (equal term pattern)
-		(mv t sublist)
-	      (mv nil nil))
-	  (instance-unify-list (cdr pattern) (cdr term) sublist)))))
-
-  (defun instance-unify-list (pattern-list term-list sublist)
-    (if (or (atom term-list)
-	    (atom pattern-list))
-	(if (and (atom term-list)
-		 (atom pattern-list))
-	    (mv t sublist)
-	  (mv nil nil))
-      (mv-let (successp new-sublist)
-	      (instance-unify-term (car pattern-list)
-				   (car term-list)
-				   sublist)
-	      (if successp
-		  (instance-unify-list (cdr pattern-list)
-				       (cdr term-list)
-				       new-sublist)
-		(mv nil nil)))))
-)
-
-
-; After a list of substitutions has been generated, we typically want to apply
-; them to a term.  We recur over the list of substitutions, simply calling
-; subst to do our work throughout a term.
-;
-; For example:
-;
-;   (instance-substitute '((?x . (car a))) '(not (predicate ?x)))
-;   ==>
-;   (not (predicate (car a)))
-
-(defun instance-substitute (sublist term)
-  (if (endp sublist)
-      term
-    (let* ((old (car (car sublist)))
-           (new (cdr (car sublist)))
-	   (result (subst new old term)))
-      (instance-substitute (cdr sublist) result))))
-
-
-
-; We now introduce our actual rewriter.  We take three arguments: pat is the
-; pattern to look for throughout the term, e.g., (predicate ?x), repl is the
-; replacement to use, e.g., (not (predicate ?x)), and term is the term to match
-; the pattern against in order to get the substitutions.
-;
-; For Example:
-;
-;   (instance-rewrite1 '(predicate ?x)
-;                      '(not (predicate ?x))
-;                      '(if (predicate (car x)) t nil))
-;   =>
-;   (if (not (predicate (car x))) t nil)
-
-(mutual-recursion
-
-  (defun instance-rewrite1 (pat repl term)
-    (mv-let (successful sublist)
-            (instance-unify-term pat term nil)
-	    (if successful
-		(instance-substitute sublist repl)
-	      (if (atom term)
-		  term
-		(cons (instance-rewrite1 pat repl (car term))
-		      (instance-rewrite-lst1 pat repl (cdr term)))))))
-
-  (defun instance-rewrite-lst1 (pat repl lst)
-    (if (endp lst)
-        nil
-      (cons (instance-rewrite1 pat repl (car lst))
-            (instance-rewrite-lst1 pat repl (cdr lst)))))
-)
-
-
-
-; Finally, given that we can apply a rewrite a term with a single replacement,
-; we go ahead and extend this notion to multiple replacements.  In other words,
-; we walk through a list of substitutions, sequentially rewriting the term
-; using each substitution.
-
-(defun instance-rewrite (term subs)
-  (if (endp subs)
-      term
-    (let ((first-sub (car subs)))
-      (instance-rewrite (instance-rewrite1 (first first-sub)
-					   (second first-sub)
-					   term)
-			(cdr subs)))))
-
-
-
-
-; Instantiating Defuns
-;
-;
-; Theories consist mainly of definitions and theorems.  Given generic theorems,
-; we will want to rewrite them so that they perform different functions.  For
-; example, a generic "all" function might need to be rewritten so that its
-; calls to (predicate x) are replaced with calls to (not (predicate x)) for all
-; x.
-;
-; To begin, we instantiate the function's declarations (e.g., comment strings,
-; xargs, ignores, and so forth).  We simply duplicate comment strings, but for
-; declare forms we allow rewriting to occur.
-
-(defun instance-decls (decls subs)
-  (if (endp decls)
-      nil
-    (if (pseudo-termp (car decls))
-	(cons (instance-rewrite (car decls) subs)
-	      (instance-decls (cdr decls) subs))
-      (cons (car decls)
-	    (instance-decls (cdr decls) subs)))))
-
-
-; For the defun itself, we retain the same defun symbol (e.g., defun or
-; defund), but we change the name and args of the function by first creating
-; the list '(oldname oldarg1 oldarg2 ...) then applying our substitutions to
-; the new function.
-;
-; As a trivial example,
-;  (instance-defun '(defun f (x) (+ x 1)) '(((f x) (g x))))
-;    =>
-;  (defun g (x) (+ x 1))
-
-(defun instance-defun (defun subs)
-  (let* ((defun-symbol  (first defun))
- 	 (defun-name    (second defun))
-	 (defun-args    (third defun))
-         (defun-decls   (butlast (cdddr defun) 1))
-	 (defun-body    (car (last defun)))
-	 (name/args     (cons defun-name defun-args))
-	 (new-body      (instance-rewrite defun-body subs))
-	 (new-name/args (instance-rewrite name/args subs))
-	 (new-decls     (instance-decls defun-decls subs))
-	 (new-name      (car new-name/args))
-	 (new-args      (cdr new-name/args)))
-    `(,defun-symbol
-       ,new-name ,new-args
-       ,@new-decls
-       ,new-body)))
-
-; We also provide a convenience function that allows you to instance a list of
-; defuns.
-
-(defun instance-defuns (defun-list subs)
-  (if (endp defun-list)
-      nil
-    (cons (instance-defun (car defun-list) subs)
-	  (instance-defuns (cdr defun-list) subs))))
-
-
-
-; Renaming theorems
-
-(defun defthm-names (event-list)
-  (if (endp event-list)
-      nil
-    (let* ((first-event (car event-list))
-	   (event-type  (first first-event)))
-      (cond ((or (eq event-type 'defthm)
-		 (eq event-type 'defthmd))
-	     (cons (second first-event)
-		   (defthm-names (cdr event-list))))
-	    ((eq event-type 'encapsulate)
-	     (append (defthm-names (cddr first-event))
-		     (defthm-names (cdr event-list))))
-	    (t (defthm-names (cdr event-list)))))))
-
-(defun create-new-names (name-list suffix)
-  (if (endp name-list)
-      nil
-    (acons (car name-list)
-	   (intern-in-package-of-symbol (string-append (symbol-name (car name-list))
-						       (symbol-name suffix))
-					suffix)
-	   (create-new-names (cdr name-list) suffix))))
-
-(defun rename-defthms (event-list suffix)
-  (sublis (create-new-names (defthm-names event-list) suffix)
-	  event-list))
-
-
-
-; Instantiating Theorems
-;
-;
-; To instantiate defthms, we will want to be able to provide functional
-; instantiations of the generic theory.  This is much more complicated than
-; instancing definitions, and involves:
-;
-;   a) determining what functional substitutions to make
-;   b) determining the theory in which to conduct the proofs
-;   c) handling rule classes and other optional components
-;   d) generating the actual defthm event
-;
-; My idea is essentially that if a substitution list can be used for
-; functionally instantiating theorems, then it can also be used for creating
-; the new theorem.
-;
-; (a) Determining what functional substitutions to make.
-;
-; I pass in a list of substitutions of the following form.
-;
-;   (((predicate ?x)  (not (in ?x y)))
-;    ((all ?x)        (all-not-in ?x y))
-;    ((exists ?x)     (exists-not-in ?x y)))
-;
-; From this list we can generate the functional instantiation hints.  So, for
-; example, we simply convert ((predicate ?x) (not (in ?x y))) into the
-; substitution:
-;
-;   (predicate (lambda (?x) (not (in ?x y))))
-;
-; This is easy to do with the following functions:
-
-(defun sub-to-lambda (sub)
-  (let ((term (first sub))
-	(repl (second sub)))
-    (let ((function-symbol (car term))
-	  (lambda-args (cdr term)))
-      `(,function-symbol (lambda ,lambda-args ,repl)))))
-
-(defun subs-to-lambdas (subs)
-  (if (endp subs)
-      nil
-    (cons (sub-to-lambda (car subs))
-	  (subs-to-lambdas (cdr subs)))))
-
-
-; (b) Determining the theory in which to conduct the proofs.
-;
-; When we prove the functional instantiation constraints, ideally we should
-; work in an environment where the only definitions that are enabled are the
-; definitions used in the functional instantiation hints.
-;
-; Well, the definitions we need are (almost) simply all of the function symbols
-; in the right-hand side of the substitution list.  In other words, for the
-; above substitutions, I would want to have the definitions of not, in,
-; all-not-in, and exists-not-in available.
-;
-; Now, the problem with this approach is, what if those symbols don't have
-; definitions?  This can occur if, for example, we are using a constrained
-; function in the substitution list.  This is actually useful, e.g., for
-; substituting (predicate ?x) -> (not (predicate ?x)).
-;
-; My solution is a stupid hack.  We simply pass in the names of the generic
-; functions for which we do not want to generate definitions along with the
-; substitutinos.
-;
-; To begin, the following function will extract all function symbols that occur
-; within a term.
-
-(mutual-recursion
-
-  (defun term-functions (term)
-    (if (atom term)
-        nil
-      (cons (car term)
-	    (term-list-functions (cdr term)))))
-
-  (defun term-list-functions (list)
-    (if (endp list)
-	nil
-      (append (term-functions (car list))
-	      (term-list-functions (cdr list)))))
-)
-
-; Next, I wrote the following function, which walks over the substitution list
-; and extracts the function symbols from each right hand side, using
-; term-functions.  The net result is the list of all functions that were used
-; in replacements.
-
-(defun subs-repl-functions (subs)
-  (if (endp subs)
-      nil
-    (let* ((sub1 (car subs))
-	   (repl (second sub1)))
-      (append (term-functions repl)
-	      (subs-repl-functions (cdr subs))))))
-
-; Given the above, we could then convert the list of function symbols into a
-; list of (:definition f)'s with the following function.
-
-(defun function-list-to-definitions (funcs)
-  (if (endp funcs)
-      nil
-    (cons `(:definition ,(car funcs))
-	  (function-list-to-definitions (cdr funcs)))))
-
-; And finally, here is a function that does "all of the work", calling
-; function-list-to-definitions for all of the functions found in the
-; substitution list, minus all of the generic functions that we don't want to
-; generate :definition hints for.
-
-(defun subs-to-defs (subs generics)
-  (let* ((all-fns (subs-repl-functions subs))
-	 (real-fns (set-difference-eq all-fns generics)))
-    (function-list-to-definitions real-fns)))
-
-
-; (c) Handling rule classes and other optional components.
-;
-; We are interested in several parts of a defthm.  In addition to the
-; conjecture itself, we need to consider the rule-classes used by the theorem,
-; and the other optional attributes such as the :hints, :doc, :otf-flg, etc.
-; We parse these attributes into a five-tuple of pairs of the form (present
-; . value), where present is a boolean that says whether or not the flag has
-; been seen, value is its value, and the order of the elements is rule-classes,
-; instructions, hints, otf-flg, and finally doc.  We parse these options with
-; the following code:
-
-(defconst *default-parse-values*
-  '((nil . nil) (nil . nil) (nil . nil) (nil . nil) (nil . nil)))
-
-(defun parse-defthm-option (option return-value)
-  (cond ((equal (first option) :rule-classes)
-         (update-nth 0 (list t (second option)) return-value))
-	((equal (first option) :instructions)
-	 (update-nth 1 (list t (second option)) return-value))
-	((equal (first option) :hints)
-	 (update-nth 2 (list t (second option)) return-value))
-	((equal (first option) :otf-flg)
-	 (update-nth 3 (list t (second option)) return-value))
-	((equal (first option) :doc)
-	 (update-nth 4 (list t (second option)) return-value))
-	(t (er hard "Unknown flag in defthm options ~x0." (first option)))))
-
-(defun parse-defthm-options (options return-value)
-  (if (endp options)
-      return-value
-    (parse-defthm-options (cddr options)
-			  (parse-defthm-option options return-value))))
-
-
-; (d) Generating the actual defthm event.
-;
-; When we are ready to instance a defthm event, we combine the above work with
-; a few new things.  First of all, we need the original theorem event, a new
-; name to use, the substitutions to use, and the list of generic function
-; symbols in use so that we do not create (:definition f) entries for them.
-;
-; We begin by making our substitutions in the body of the theorem.  We then
-; parse the optional components of the defthm, but we only are interested in
-; the rule-classes.  (Hints, instructions, and otf-flg will not be needed,
-; because we will be proving this via functional instantiation.  Doc we ignore
-; for no good reason.)  We construct a new theorem that has our new name and
-; body, replicating the rule classes if necessary.  We also provide a
-; functional instantiation hint of the generic theorem's name, along with a
-; list of lambda substitutions to make.
-
-(defun instance-defthm (event new-name subs generics extra-defs)
-  (let* ((defthm-symbol (first event))
-	 (defthm-name   (second event))
-	 (defthm-body   (third event))
-	 (new-body      (instance-rewrite defthm-body subs))
-	 (options       (parse-defthm-options (cdddr event)
-					      *default-parse-values*))
-	 (rc-opt        (first options)))
-    `(,defthm-symbol ,new-name
-       ,new-body
-       :hints(("Goal"
-	       :use (:functional-instance ,defthm-name
-					  ,@(subs-to-lambdas subs))
-	       :in-theory (union-theories (theory 'minimal-theory)
-			   (union-theories ',extra-defs
-					   ',(subs-to-defs subs generics)))))
-       ,@(if (car rc-opt) `(:rule-classes ,(cdr rc-opt)) nil))))
-
-
-
-; Instantiating Encapsulates
-;
-;
-; There are two reasons that I typically use encapsulation.  The first is as a
-; purely structural/organizational purpose, where I am trying to prove some
-; theorem is true, but I need some lemmas to do so.  In this case I use an
-; (encapsulate nil ...) and wrap my lemmas in local forms.  The other reason is
-; to actually go ahead and introduce constrained functions.
-;
-; Two strategies will be necessary for handling these situations.  In
-; particular, if we are in an encapsulate which has no constrained function
-; symbols, we will want to skip all local events and only add the non-local
-; events (using functional instantiation to create the theorems).  On the other
-; hand, for the case when we are introducing constrained functions, we will
-; want to introduce new constrained functions based on the encapsulate.
-;
-; So, encapsulates are handled separately based on whether or not any functions
-; are constrained.
-;
-; Within an (encapsulate nil ...), local events will be skipped and defthm
-; events will be proven using the functional instantiation of their generic
-; counterparts.
-;
-; Within an (encapsulate (...) ...), local events will not be skipped but will
-; instead be reintroduced with new names.  Further, defthm events will be
-; copied using new names and will not be proven using functional instantiation.
-;
-; The only "extra" thing we really need for handling encapsulates is a system
-; to make the substitutions within the signatures.  We do that here by simple
-; rewriting.  Note that we do not allow the number of return values to change.
-; I don't really think of this as a major limitation, since almost always my
-; constrained functions return a single value.  If you have an example of where
-; this would be useful, it would be interesting to see it.
-
-(defun instance-signature (signature subs)
-  (let ((name (first signature))
-	(rest (rest signature)))
-    (cons (instance-rewrite subs name) rest)))
-
-(defun instance-signatures (signatures subs)
-  (if (endp signatures)
-      nil
-    (cons (instance-signature (car signatures) subs)
-	  (instance-signatures (cdr signatures) subs))))
-
-; Because encapsulates can contain many events within them, it is natural to
-; make them mutually recursive with the main event list handler, which we are
-; now ready to introduce.
-
-
-
-
-
-; Instantiating Entire Theories
-;
-;
-; We are now ready to introduce the functions which will walk through a theory
-; and call the appropriate instancing functions on each of the forms we
-; encounter.  To support encapsulation, our functions here are all mutually
-; recursive.
-;
-; The arguments that we pass around are the following:
-;
-;   - The event or event list to instantiate
-;
-;   - The global list of substitutions used to derive the instance
-;
-;   - A suffix which will be appended to generate new names
-;
-;   - A list of generic functions which have no definitions
-;
-;   - A mode, which is either 'constrained to indicate that the nearest
-;     encapsulate event has constrained functions, or is nil to indicate that
-;     the nearest encapsulate is merely a structural wrapper for local lemmas.
-;
-; Finally, we overload our behavior based on suffix, so that if no suffix is
-; given, we simply replicate the generic theory instead of instantiating a
-; concrete instance of it.
-
-
-(mutual-recursion
-
-  (defun instance-event (event subs suffix generics mode extra-defs)
-    (if (null suffix)
-	event
-      (cond ((or (eq (car event) 'defun)
-		 (eq (car event) 'defund))
-	     (instance-defun event subs))
-	    ((or (eq (car event) 'defthm)
-		 (eq (car event) 'defthmd))
-	     (let* ((name (second event))
-		    (new-name (intern-in-package-of-symbol
-			       (string-upcase
-				(concatenate 'string
-					     (symbol-name name)
-					     (symbol-name suffix)))
-			       suffix)))
-	       (instance-defthm event new-name subs generics extra-defs)))
-	    ((equal (car event) 'local)
-	     (if (eq mode 'constrained)
-		 (instance-event (second event) subs suffix generics mode extra-defs)
-	       nil))
-	    ((equal (car event) 'encapsulate)
-	     (instance-encapsulate event subs suffix generics mode extra-defs))
-	    (t (er hard "Don't know how to handle ~x0" (car event))))))
-
-  (defun instance-event-list (events subs suffix generics mode extra-defs)
-    (if (endp events)
-	nil
-      (let ((first (instance-event (car events) subs suffix generics mode extra-defs))
-	    (rest  (instance-event-list (cdr events) subs suffix generics mode extra-defs)))
-	(if first
-	    (cons first rest)
-	  rest))))
-
-  (defun instance-encapsulate (event subs suffix generics mode extra-defs)
-    (declare (ignore mode))
-    (let* ((signatures (second event))
-	   (new-sigs   (if signatures
-			   (instance-signatures subs signatures)
-			 nil))
-	   (new-events (instance-event-list (cddr event) subs suffix generics
-					    (if signatures
-						'constrained
-					      nil)
-					    extra-defs)))
-      `(encapsulate ,new-sigs ,@new-events)))
-
-)
-
-
-; To be able to actually introduce the events, we need to emit a macro that can
-; be used to actually perform substitutions.
-
-(defmacro instance (theory)
-  (let ((macro-name (intern-in-package-of-symbol
-		     (string-upcase (concatenate 'string
-						 "instance-" (string theory)))
-		     theory)))
-    `(defmacro ,macro-name (&key subs suffix generics extra-defs)
-       (list* 'encapsulate
-	      nil
-	      (instance-event-list ,theory subs suffix generics nil extra-defs)))))
-
-
-
-
-; Some thoughts
-;
-; A fundamental issue seems to be that a function and its arguments are not
-; always used in a consistent manner.  For example, say we want to rewrite (all
-; ?x) to (all-foo ?x y) and we want to rewrite (predicate ?x) to (not (foo ?x
-; y)).  How can we accurately say just what it is that we want to rewrite in
-; each case?
-;
-; Right now our substitutions are based on
-;  ( (predicate ?x)  (not (foo ?x y)) )
-;  ( (all ?x)        (all-foo ?x y) )
-;
-; We can easily pick out and say "all" is replaced by "all-foo", but if we try
-; to just use the car of the term as its symbol replacement, then "predicate"
-; would be "not".
-;
-; OK, so we could do some kind of preprocessing step where we fill in argument
-; guards.  The "generics" list right now is a big huge hack that allows us to
-; ignore the fact that :predicate doens't have a definition.  Really the issue
-; that this is trying to solve is to tell us how to build our :in-theory event.
-; Right now the :in-theory event is just a hack that we don't really
-; understand.
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/instance" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/intersect.lisp acl2-6.3/books/finite-set-theory/osets/intersect.lisp
--- acl2-6.2/books/finite-set-theory/osets/intersect.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/intersect.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,311 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "SETS")
-(include-book "membership")
-(set-verify-guards-eagerness 2)
-
-
-
-; Fast Intersect
-;
-; Again we are only interested in showing that fast-intersect creates sets and
-; has the expected membership property.
-
-(defun fast-intersectp (X Y)
-  (declare (xargs :guard (and (setp X)
-                              (setp Y))
-                  :measure (fast-measure X Y)
-                  :verify-guards nil))
-  (cond ((endp X) nil)
-        ((endp Y) nil)
-        ((equal (car X) (car Y))
-         t)
-        ((mbe :logic (<< (car X) (car y))
-              :exec (fast-lexorder (car X) (car Y)))
-         (fast-intersectp (cdr X) Y))
-        (t
-         (fast-intersectp X (cdr Y)))))
-
-(verify-guards fast-intersectp
-  :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-
-;; PATCH (0.91): David Rager noticed that as of v0.9, fast-intersect was not
-;; tail recursive, and submitted an updated version.  The original
-;; fast-intersect has been renamed to fast-intersect-old, and the new
-;; fast-intersect replaces it.
-
-(local
- (encapsulate
-   ()
-
-   (defun fast-intersect-old (X Y)
-     (declare (xargs :measure (fast-measure X Y)
-                     :guard (and (setp X) (setp Y))
-                     :verify-guards nil))
-     (cond ((endp X) nil)
-           ((endp Y) nil)
-           ((equal (car X) (car Y))
-            (cons (car X) (fast-intersect-old (cdr X) (cdr Y))))
-           ((mbe :logic (<< (car X) (car Y))
-                 :exec (fast-lexorder (car X) (car Y)))
-            (fast-intersect-old (cdr X) Y))
-           (t
-            (fast-intersect-old X (cdr Y)))))
-
-   (verify-guards fast-intersect-old
-     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-   (local (defthm l0
-            (implies (and (consp (fast-intersect-old x y))
-                          (or (atom x) (<< a (car x)))
-                          (or (atom y) (<< a (car y)))
-                          (setp x)
-                          (setp y))
-                     (<< a (car (fast-intersect-old x y))))
-            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
-
-   (defthm setp-of-fast-intersect-old
-     (implies (and (setp x)
-                   (setp y))
-              (setp (fast-intersect-old x y)))
-     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-   (local (defthm l1
-            (implies (and (member a x)
-                          (member a y)
-                          (setp x)
-                          (setp y))
-                     (member a (fast-intersect-old x y)))
-            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
-
-   (local (defthm l2
-            (implies (member a (fast-intersect-old x y))
-                     (and (member a x)
-                          (member a y)))
-            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
-
-   (local (defthm member-of-fast-intersect-old
-            (implies (and (setp x)
-                          (setp y))
-                     (iff (member a (fast-intersect-old x y))
-                          (and (member a x)
-                               (member a y))))))
-
-   (defthm in-fast-intersect-old
-     (implies (and (setp x)
-                   (setp y))
-              (equal (in a (fast-intersect-old x y))
-                     (and (in a x)
-                          (in a y))))
-     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-
-
-   (local (defthm l4
-            (equal (fast-intersectp X Y)
-                   (consp (fast-intersect-old X Y)))
-            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
-
-   (defthm fast-intersectp-correct-lemma
-     (implies (and (setp X)
-                   (setp Y))
-              (equal (fast-intersectp X Y)
-                     (not (empty (fast-intersect-old X Y)))))
-     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))))
-
-
-(defun fast-intersect (X Y acc)
-  (declare (xargs :measure (fast-measure X Y)
-                  :guard (and (setp X)
-                              (setp Y)
-                              (true-listp acc))
-                  :verify-guards nil))
-  (cond ((endp X) (revappend acc nil))
-        ((endp Y) (revappend acc nil))
-        ((equal (car X) (car Y))
-         (fast-intersect (cdr X) (cdr Y) (cons (car X) acc)))
-        ((mbe :logic (<< (car X) (car Y))
-              :exec (fast-lexorder (car X) (car Y)))
-         (fast-intersect (cdr X) Y acc))
-        (t
-         (fast-intersect X (cdr Y) acc))))
-
-(verify-guards fast-intersect
-  :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-(encapsulate
-  ()
-  (local (defthm lemma
-           (implies (true-listp acc)
-                    (equal (fast-intersect x y acc)
-                           (revappend acc (fast-intersect-old x y))))))
-
-  (local (defthm lemma2
-           (equal (fast-intersect x y nil)
-                  (fast-intersect-old x y))))
-
-  (defthm fast-intersect-set
-    (implies (and (force (setp X))
-                  (force (setp Y)))
-             (setp (fast-intersect X Y nil))))
-
-  (defthm fast-intersect-membership
-    (implies (and (setp X) (setp Y))
-             (equal (in a (fast-intersect X Y nil))
-                    (and (in a X) (in a Y)))))
-
-  (defthm fast-intersectp-correct
-    (implies (and (setp X) (setp Y))
-             (equal (fast-intersectp X Y)
-                    (not (empty (fast-intersect X Y nil))))))
-
-  (in-theory (disable fast-intersect
-                      fast-intersect-set
-                      fast-intersect-membership
-                      fast-intersectp
-                      fast-intersectp-correct)))
-
-
-
-(defsection intersect
-  :parents (osets)
-  :short "@(call intersect) constructs the intersection of @('X') and @('Y')."
-
-  :long "<p>The logical definition is very simple, and the essential
-correctness property is given by @('intersect-in').</p>
-
-<p>The execution uses a better, O(n) algorithm to intersect the sets by
-exploiting the set order.</p>
-
-<p>See also @(see intersectp), which doesn't construct a new set but just tells
-you whether the sets have any overlap.  It's potentially faster if you don't
-care about constructing the set, because it doesn't have to do any
-consing.</p>"
-
-  (defun intersect (X Y)
-    (declare (xargs :guard (and (setp X) (setp Y))
-                    :verify-guards nil))
-    (mbe :logic (cond ((empty X) (sfix X))
-                      ((in (head X) Y)
-                       (insert (head X) (intersect (tail X) Y)))
-                      (t (intersect (tail X) Y)))
-         :exec (fast-intersect X Y nil)))
-
-  (defthm intersect-set
-    (setp (intersect X Y)))
-
-  (defthm intersect-sfix-cancel-X
-    (equal (intersect (sfix X) Y) (intersect X Y)))
-
-  (defthm intersect-sfix-cancel-Y
-    (equal (intersect X (sfix Y)) (intersect X Y)))
-
-  (defthm intersect-empty-X
-    (implies (empty X) (empty (intersect X Y))))
-
-  (defthm intersect-empty-Y
-    (implies (empty Y) (empty (intersect X Y))))
-
-  (encapsulate ()
-
-    (local (defthm intersect-in-Y
-             (implies (not (in a Y))
-                      (not (in a (intersect X Y))))))
-
-    (local (defthm intersect-in-X
-             (implies (not (in a X))
-                      (not (in a (intersect X Y))))))
-
-    (defthm intersect-in
-      (equal (in a (intersect X Y))
-             (and (in a Y) (in a X)))))
-
-  (defthm intersect-symmetric
-    (equal (intersect X Y) (intersect Y X))
-    :rule-classes ((:rewrite :loop-stopper ((X Y)))))
-
-  (defthm intersect-subset-X
-    (subset (intersect X Y) X))
-
-  (defthm intersect-subset-Y
-    (subset (intersect X Y) Y))
-
-  (defthm intersect-insert-X
-    (implies (not (in a Y))
-             (equal (intersect (insert a X) Y)
-                    (intersect X Y))))
-
-  (defthm intersect-insert-Y
-    (implies (not (in a X))
-             (equal (intersect X (insert a Y))
-                    (intersect X Y))))
-
-
-  (defthm intersect-with-subset-left
-    (implies (subset X Y)
-             (equal (intersect X Y)
-                    (sfix X)))
-    :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-  (defthm intersect-with-subset-right
-    (implies (subset X Y)
-             (equal (intersect Y X)
-                    (sfix X)))
-    :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-  (defthm intersect-self
-    (equal (intersect X X) (sfix X)))
-
-  (defthm intersect-associative
-    (equal (intersect (intersect X Y) Z)
-           (intersect X (intersect Y Z))))
-
-  (defthm intersect-commutative
-    (equal (intersect X (intersect Y Z))
-           (intersect Y (intersect X Z)))
-    :rule-classes ((:rewrite :loop-stopper ((X Y)))))
-
-  (defthm intersect-outer-cancel
-    (equal (intersect X (intersect X Z))
-           (intersect X Z))))
-
-
-(local (defthm fast-intersect-correct
-         (implies (and (setp X)
-                       (setp Y))
-                  (equal (fast-intersect X Y nil)
-                         (intersect X Y)))
-         :hints(("Goal" :in-theory (enable fast-intersect-set
-                                           fast-intersect-membership)))))
-
-(verify-guards intersect)
-
-
-(defsection intersectp
-  :parents (osets)
-  :short "@(call intersectp) checks whether @('X') and @('Y') have any common
-members."
-
-  :long "<p>Logically we just check whether the @(see intersect) of @('X') and
-@('Y') is @(see empty).</p>
-
-<p>In the execution, we use a faster function that checks for any common
-members and doesn't build any new sets.</p>"
-
-  (defun intersectp (X Y)
-    (declare (xargs :guard (and (setp X) (setp Y))
-                    :guard-hints(("Goal" :in-theory (enable fast-intersectp-correct)))))
-    (mbe :logic (not (empty (intersect X Y)))
-         :exec (fast-intersectp X Y))))
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/intersect" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/map-tests.lisp acl2-6.3/books/finite-set-theory/osets/map-tests.lisp
--- acl2-6.2/books/finite-set-theory/osets/map-tests.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/map-tests.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,85 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; map-tests.lisp
-;
-; This book should not normally be included; it only exists to make sure that
-; the map macro is working.
-
 (in-package "ACL2")
-(include-book "map")
-(include-book "misc/assert" :dir :system)
-(set-verify-guards-eagerness 2)
-
-
-
-(SETS::map-function (integerp x))
-
-(assert! (equal (SETS::map<integerp> '(1 2 3)) '(t)))
-
-(assert! (equal (SETS::map-list<integerp> '(1 a 2 b))
-                '(t nil t nil)))
-
-
-(defun square (x)
-  (declare (xargs :guard t))
-  (* (rfix x) (rfix x)))
-
-(SETS::map-function (square x))
-
-(assert! (equal (SETS::map<square> '(1 2 3)) '(1 4 9)))
-(assert! (equal (SETS::map<square> '(a b c)) '(0)))
-
-
-; Make sure packages in-package works
-
-(SETS::map-function (square x)
-                    :in-package-of instance::foo)
-
-
-; Multi-input test
-
-(defun square-then-add (input offset)
-  (declare (xargs :guard t))
-  (+ (* (rfix input) (rfix input))
-     (rfix offset)))
-
-
-(SETS::map-function (square-then-add input offset)
-                    :in-package-of computed-hints::foo)
-
-(assert! (equal (COMPUTED-HINTS::map<square-then-add> '(1 2 3) 5)
-                '(6 9 14)))
-
-
-
-
-(defun plus (x y)
-  (declare (xargs :guard (and (integerp x) (rationalp y))))
-  (+ x y))
-
-(sets::quantify-predicate (integerp x)
-                          :in-package-of defthm)
-
-(sets::map-function (plus arg1 arg2)
-                    :in-package-of defthm
-                    :set-guard ((all<integerp> ?set))        ; set's name must be ?set
-                    :list-guard ((all-list<integerp> ?list)) ; list's name must be ?list
-                    :element-guard ((integerp a))            ; element's name must be a
-                    :arg-guard ((rationalp arg2)))           ; extra arg names specified above
-
-(assert! (equal (MAP<plus> '(1 2 3) 1) '(2 3 4)))
-
-
-
+; cert_param: (reloc_stub)
+(include-book "std/osets/map-tests" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/map.lisp acl2-6.3/books/finite-set-theory/osets/map.lisp
--- acl2-6.2/books/finite-set-theory/osets/map.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/map.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,439 +1,4 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; map.lisp
-;
-; This is an optional extension of the sets library, and is not included by
-; default when you run (include-book "sets").
-;
-; We introduce a macro map-function, which is somewhat like the higher-order
-; function "map" in other functional languages.  Given a particular
-; transformation function, this macro produces:
-;
-;      map<function>
-;      map-list<function>
-;
-; In addition to introducing these functions, a large rewriting strategy is
-; developed for reasoning about the new mapping functions.
-;
-;
-; Introductory Examples.
-;
-; Here are some simple examples.  These transformation functions have only a
-; single argument, and are guarded to operate on any inputs.
-;
-;     (SETS::map-function (integerp x))
-;       - (SETS::map<integerp> '(1 2 3)) = (t)
-;       - (SETS::map-list<integerp> '(1 a 2 b)) = (t nil t nil)
-;
-;     (defun square (x)
-;       (declare (xargs :guard t))
-;       (* (rfix x) (rfix x)))
-;
-;     (SETS::map-function (square x))
-;       - (SETS::map<square> '(1 2 3)) = (1 4 9)
-;       - (SETS::map<square> '(a b c)) = (0)
-;
-; Note that you can't use macros, e.g., real/rationalp cannot be used since it
-; is not a function.
-;
-;
-; Controlling Packages.
-;
-; As you can see, the new map<f> functions are added to the SETS package by
-; default.  If you would like them to be in a new place, you can use the
-; :in-package-of argument to map-function.  For example, since defthm is in the
-; ACL2 package, we can run:
-;
-;     (SETS::map-function (square x)
-;       :in-package-of defthm)
-;
-; And map<square> will be created in the ACL2 package instead of the sets
-; package.
-;
-;
-; Multi-Argument Transformation Functions.
-;
-; You can also introduce transformations with multiple arguments.  As an
-; example, we introduce the function square-then-add, which first squares its
-; input and then adds some offset to it.
-;
-;     (defun square-then-add (input offset)
-;       (declare (xargs :guard t))
-;       (+ (* (rfix input) (rfix input))
-;          (rfix offset)))
-;
-;     (SETS::map-function (square-then-add input offset)
-;        :in-package-of defthm)
-;
-;     (map<square-then-add> '(1 2 3) 5) => (6 9 14)
-;
-;
-; Supporting Guards.
-;
-; We can support transformation functions that require guards by sending extra
-; arguments to the map-function macro.  As an example, we consider what it
-; would require to write a mapping function for the function below.
-;
-;   (defun plus (x y)
-;     (declare (xargs :guard (and (integerp x) (rationalp y))))
-;     (+ x y))
-;
-;   (quantify-predicate (integerp x))   ; see quantify.lisp for explanation
-;
-;   (map-function (plus arg1 arg2)
-;     :set-guard ((all<integerp> ?set))        ; set's name must be ?set
-;     :list-guard ((all-list<integerp> ?list)) ; list's name must be ?list
-;     :element-guard ((integerp a))            ; element's name must be a
-;     :arg-guard ((rationalp arg2)))           ; extra arg names specified above
-;
-;
-; These examples can be found and run in map-tests.lisp.
-
-(in-package "SETS")
-(include-book "quantify")
-(set-verify-guards-eagerness 2)
-
-
-; BOZO ugly extra theorems we probably shouldn't need
-
-(defthm map-subset-helper
-  (implies (in (head X) Y)
-	   (equal (subset (tail X) Y)
-		  (subset X Y)))
-  :hints(("Goal" :expand (subset X Y))))
-
-(defthm map-subset-helper-2
-  (implies (not (in (head X) Y))
-           (equal (subset X Y)
-                  (empty X))))
-
-
-; We will map an arbitrary transformation function across the set.  We don't
-; assume anything about transform.
-
-(encapsulate
-  (((transform *) => *))
-  (local (defun transform (x) x)))
-
-
-; Now we introduce our mapping functions.  We allow the transform to be mapped
-; across a list or a set.  Under the hood, we use MBE to ensure that we first
-; transform every element of the set, and then mergesort the results.  This
-; gives O(n) + O(n log n) performance intead of the O(n^2) required for
-; repeated insertion.  We introduce these functions as a constant, so we can
-; rewrite it later to actually create maps.
-
-(defconst *map-functions* '(
-
-  (defun map-list (x)
-    (declare (xargs :guard (true-listp x)))
-    (if (endp x)
-	nil
-      (cons (transform (car X))
-	    (map-list (cdr X)))))
-
-  (defun map (X)
-    (declare (xargs :guard (setp X)))
-    (declare (xargs :verify-guards nil))
-    (mbe :logic (if (empty X)
-		    nil
-		  (insert (transform (head X))
-			  (map (tail X))))
-	 :exec (mergesort (map-list X))))
-
-; A crucial component of our reasoning is the notion of the inverse of the
-; transform.  We define the relation (inversep a b), which is true if and only
-; if a is an inverse of b under transform -- that is, (inversep a b) is true
-; when (transform a) = b.
-
-  (defun inversep (a b)
-    (declare (xargs :guard t))
-    (equal (transform a) b))))
-
-(INSTANCE::instance *map-functions*)
-(instance-*map-functions*)
-
-
-; We now quantify over the predicate inversep, allowing us to talk
-; about the existence of inverses in sets.
-
-(quantify-predicate (inversep a b))
-
-
-
-; Again we begin introducing theorems as a constant, so that we can
-; instantiate concrete theories of mapping by rewriting.
-
-(defconst *map-theorems* '(
-
-  (defthm map-setp
-    (setp (map X)))
-
-  (defthm map-sfix
-    (equal (map (sfix X))
-	   (map X)))
-
-
-; The ordered sets library works really well when you can provide a
-; concise statement about membership for your new functions.  Here, we
-; use the idea of inverses in order to explain what it means to be a
-; member in a map.  Basically, (in a (map X)) is exactly equal to
-; (exists<inversep> X a), i.e., if there is an inverse of a in x.  We
-; then manually apply our "exists elimination" to make this theorem a
-; little more direct.
-
-  (defthm map-in
-    (equal (in a (map X))
-	   (not (all<not-inversep> X a))))
-
-
-; With this notion of membership in play, we can now use the
-; properties of all<not-inversep> in order to prove many interesting
-; theorems about mappings through standard membership arguments.
-
-  (defthm map-subset
-    (implies (subset X Y)
-	     (subset (map X) (map Y))))
-
-  (defthm map-insert
-    (equal (map (insert a X))
-	   (insert (transform a) (map X))))
-
-  (defthm map-delete
-    (subset (delete (transform a) (map X))
-	    (map (delete a X))))
-
-  (defthm map-union
-    (equal (map (union X Y))
-	   (union (map X) (map Y))))
-
-  (defthm map-intersect
-    (subset (map (intersect X Y))
-	    (intersect (map X) (map Y))))
-
-  (defthm map-difference
-    (subset (difference (map X) (map Y))
-	    (map (difference X Y))))
-
-  (defthm map-cardinality
-    (<= (cardinality (map X))
-	(cardinality X))
-    :rule-classes :linear)
-
-
-
-; We now provide some theorems about mapping over lists.  These are
-; somewhat nice in and of themselves, but also allow us to prove our
-; mbe equivalence so that our mapping operations are more efficient.
-; To begin, we prove the characteristic list membership theorem for
-; mapping over lists.
-
-  (defthm member-of-map-list
-    (iff (member a (map-list X))
-         (exists-list<inversep> X a)))
-
-  (defthm map-mergesort
-    (equal (map (mergesort X))
-	   (mergesort (map-list X))))
-
-
-
-; And finally we prove this theorem, which will be useful for
-; verifying the guards of map.
-
-  (defthm map-mbe-equivalence
-    (implies (setp X)
-	     (equal (mergesort (map-list X))
-		    (map X))))
-
-
-; We finish up our theory with some more, basic theorems about
-; mapping over lists.
-
-  (defthm map-list-cons
-    (equal (map-list (cons a x))
-	   (cons (transform a)
-		 (map-list x))))
-
-  (defthm map-list-append
-    (equal (map-list (append x y))
-	   (append (map-list x)
-		   (map-list y))))
-
-  (defthm map-list-nth
-    (implies (and (integerp n)
-		  (<= 0 n)
-		  (< n (len x)))
-	     (equal (nth n (map-list x))
-		    (transform (nth n x)))))
-
-  (defthm map-list-revappend
-    (equal (map-list (revappend x acc))
-	   (revappend (map-list x)
-		      (map-list acc))))
-
-  (defthm map-list-reverse
-    (equal (map-list (reverse x))
-	   (reverse (map-list x))))
-
-))
-
-(INSTANCE::instance *map-theorems*)
-(instance-*map-theorems*)
-
-(verify-guards map)
-
-
-
-; This is a nice generic theory, but to be useful, we will need to be
-; able to instantiate concrete theories based on it.  We do this with
-; the following function, for which we introduce a corresponding
-; macro.
-
-(defun map-function-fn (function in-package
-				 set-guard
-				 list-guard
-				 element-guard
-				 arg-guard)
-
-  (declare (xargs :mode :program))
-
-  (let* ((name          (car function))
-	 (extra-args    (cddr function))
-	 (wrap          (app "<" (app (symbol-name name) ">")))
-
-	 ;; First we build up all the symbols that we will use.
-
-	 (map<f>                   (mksym (app "map" wrap) in-package))
-	 (map-list<f>              (mksym (app "map-list" wrap) in-package))
-	 (inversep                 (app "inversep" wrap))
-	 (ipw                      (app "<" (app inversep ">")))
-	 (not-ipw                  (app "<not-" (app inversep ">")))
-	 (inversep<f>              (mksym inversep in-package))
-
-	 (all<inversep<f>>     (mksym (app "all" ipw) in-package))
-	 (exists<inversep<f>>  (mksym (app "exists" ipw) in-package))
-	 (find<inversep<f>>    (mksym (app "find" ipw) in-package))
-	 (filter<inversep<f>>  (mksym (app "filter" ipw) in-package))
-	 (all-list<inversep<f>>     (mksym (app "all-list" ipw) in-package))
-	 (exists-list<inversep<f>>  (mksym (app "exists-list" ipw) in-package))
-	 (find-list<inversep<f>>    (mksym (app "find-list" ipw) in-package))
-	 (filter-list<inversep<f>>  (mksym (app "filter-list" ipw) in-package))
-
-	 (all<not-inversep<f>>     (mksym (app "all" not-ipw) in-package))
-	 (exists<not-inversep<f>>  (mksym (app "exists" not-ipw) in-package))
-	 (find<not-inversep<f>>    (mksym (app "find" not-ipw) in-package))
-	 (filter<not-inversep<f>>  (mksym (app "filter" not-ipw) in-package))
-	 (all-list<not-inversep<f>>     (mksym (app "all-list" not-ipw) in-package))
-	 (exists-list<not-inversep<f>>  (mksym (app "exists-list" not-ipw) in-package))
-	 (find-list<not-inversep<f>>    (mksym (app "find-list" not-ipw) in-package))
-	 (filter-list<not-inversep<f>>  (mksym (app "filter-list" not-ipw) in-package))
-
-
-	 (subs `(((transform ?x) (,name ?x ,@extra-args))
-		 ((map ?x) (,map<f> ?x ,@extra-args))
-		 ((map-list ?x) (,map-list<f> ?x ,@extra-args))
-		 ((inversep ?a ?b) (,inversep<f> ?a ?b ,@extra-args))
-
-		 ((all<inversep> ?a ?b)    (,all<inversep<f>> ?a ?b ,@extra-args))
-		 ((exists<inversep> ?a ?b) (,exists<inversep<f>> ?a ?b ,@extra-args))
-		 ((find<inversep> ?a ?b)   (,find<inversep<f>> ?a ?b ,@extra-args))
-		 ((filter<inversep> ?a ?b) (,filter<inversep<f>> ?a ?b ,@extra-args))
-
-		 ((all-list<inversep> ?a ?b)    (,all-list<inversep<f>> ?a ?b ,@extra-args))
-		 ((exists-list<inversep> ?a ?b) (,exists-list<inversep<f>> ?a ?b ,@extra-args))
-		 ((find-list<inversep> ?a ?b)   (,find-list<inversep<f>> ?a ?b ,@extra-args))
-		 ((filter-list<inversep> ?a ?b) (,filter-list<inversep<f>> ?a ?b ,@extra-args))
-
-		 ((all<not-inversep> ?a ?b)    (,all<not-inversep<f>> ?a ?b ,@extra-args))
-		 ((exists<not-inversep> ?a ?b) (,exists<not-inversep<f>> ?a ?b ,@extra-args))
-		 ((find<not-inversep> ?a ?b)   (,find<not-inversep<f>> ?a ?b ,@extra-args))
-		 ((filter<not-inversep> ?a ?b) (,filter<not-inversep<f>> ?a ?b ,@extra-args))
-
-		 ((all-list<not-inversep> ?a ?b)    (,all-list<not-inversep<f>> ?a ?b ,@extra-args))
-		 ((exists-list<not-inversep> ?a ?b) (,exists-list<not-inversep<f>> ?a ?b ,@extra-args))
-		 ((find-list<not-inversep> ?a ?b)   (,find-list<not-inversep<f>> ?a ?b ,@extra-args))
-		 ((filter-list<not-inversep> ?a ?b) (,filter-list<not-inversep<f>> ?a ?b ,@extra-args))
-	 ))
-
-	 (theory<f>         (mksym (app "map-theory" wrap) in-package))
-	 (suffix            (mksym wrap in-package))
-	 (thm-names         (INSTANCE::defthm-names *map-theorems*))
-	 (thm-name-map      (INSTANCE::create-new-names thm-names suffix))
-	 (theory<f>-defthms (sublis thm-name-map thm-names))
-	 )
-
-  `(encapsulate ()
-
-		(instance-*map-functions*
-		 :subs ,(list* `((declare (xargs :guard (setp ?set)))
-				 (declare (xargs :guard (and (setp ?set)
-							     ,@set-guard
-							     ,@arg-guard))))
-			       `((declare (xargs :guard (true-listp ?list)))
-				 (declare (xargs :guard (and (true-listp ?list)
-							     ,@list-guard
-							     ,@arg-guard))))
-			       `((declare (xargs :guard t))
-				 (declare (xargs :guard (and ,@element-guard
-							     ,@arg-guard))))
-			       subs)
-		 :suffix ,name)
-
-		(quantify-predicate (,inversep<f> a b ,@extra-args)
-		 :in-package-of ,in-package
-		 :set-guard ,set-guard
-		 :list-guard ,list-guard
-		 :arg-guard ,arg-guard)
-
-		(instance-*map-theorems*
-		 :subs ,subs
-		 :suffix ,(mksym wrap in-package))
-
-		(verify-guards ,map<f>)
-
-		(deftheory ,theory<f>
-		  (union-theories
-		   (theory ',(mksym (app "theory" ipw) in-package))
-		   '(,map<f> ,map-list<f> ,inversep<f>
-	             ,@theory<f>-defthms)))
-
-		)))
-
-
-(defmacro map-function (function &key in-package-of
-				      set-guard
-				      list-guard
-				      element-guard
-				      arg-guard)
-  (map-function-fn function
-		   (if in-package-of in-package-of 'in)
-		   (standardize-to-package "?SET" '?set set-guard)
-		   (standardize-to-package "?LIST" '?list list-guard)
-		   (standardize-to-package "A" 'a element-guard)
-		   arg-guard
-		   ))
-
-
-(deftheory generic-map-theory
-  (union-theories (theory 'theory<inversep>)
-		  `(,@(INSTANCE::defthm-names *map-theorems*)
-		      map
-		      map-list
-		      inversep)))
-
-(in-theory (disable generic-map-theory))
-
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/map" :dir :system)
 
diff -Nru acl2-6.2/books/finite-set-theory/osets/membership.lisp acl2-6.3/books/finite-set-theory/osets/membership.lisp
--- acl2-6.2/books/finite-set-theory/osets/membership.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/membership.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,882 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; membership.lisp
-;
-; This file introduces the notions of set membership and subset.  We also go
-; into an abstract argument which will form the basis for quantification, and
-; especially for pick-a-point and double containment proofs.
-;
-; At the end of this file, we will disable all of the theorems that pertain to
-; the order of elements, providing an entirely membership-based reasoning
-; environment for the outer level.
-
-(in-package "SETS")
-(include-book "primitives")
-(include-book "computed-hints")
-(set-verify-guards-eagerness 2)
-
-
-(defsection in
-  :parents (osets)
-  :short "@(call in) determines if @('a') is a member of the set @('X')."
-
-  :long "<p>The logical definition of @('in') makes no mention of the set
-order, except implicitly by the use of the set @(see primitives) like @(see
-head) and @(see tail).</p>
-
-<p>The :exec version just inlines the set primitives and does one level of loop
-unrolling.  On CCL, it seems to run about 2.6x faster on the following
-loop:</p>
-
-@({
- ;; 4.703 sec logic, 1.811 sec exec
- (let ((big-set (loop for i from 1 to 100000 collect i)))
-   (gc$)
-   (time (loop for i fixnum from 1 to 30000 do (sets::in i big-set))))
-})
-
-<p>There are other ways we could optimize @('in').  Since the set is ordered,
-we could try to use the set order @(see <<) to stop early when we ran into an
-element that is larger than the one we are looking for.  For instance, when
-looking for 1 in the set '(2 3 4), we know that since @('1 << 2') that @('1')
-cannot be a member of this set.</p>
-
-<p>The simplest way to do this is to use @('<<') at every element.  But set
-order comparisons can be very expensive, especially when sets contain large
-cons structures.  So while it is easy to contrive situations where exploiting
-the order would be advantageous, like</p>
-
-@({
- (in 1 '(2 3 4 .... 100000))
-})
-
-<p>where we could return instantly, there are also times where it would be
-slower.  For instance, on</p>
-
-@({
- (in 100001 '(1 2 3 4 ... 100000))
-})
-
-<p>we would incur the extra cost of 100,000 calls to @('<<').</p>
-
-<p>For this reason, we do not currently implement any short-circuiting.  The
-reasoning is:</p>
-
-<ul>
-
-<li>it is not clear which would be faster in all cases,</li>
-
-<li>it is not clear what the typical usage behavior of @('in') is, so even if
-we wanted to benchmark alternate implementations, it may be hard to come up
-with the right benchmarking suite</li>
-
-<li>both solutions are O(n) anyway, and @('in') isn't a function that should
-probably be used in any kind of loop so its performance shouldn't be especially
-critical to anything</li>
-
-<li>the current method is arguably no less efficient than an unordered
-implementation.</li>
-
-</ul>
-
-<p>Future note.  In principle membership in an ordered list might be done in
-@('O(log_2 n)').  We are considering using a <i>galloping</i> membership check
-in the future to obtain something along these lines.</p>"
-
-  (defun in (a X)
-    (declare (xargs :guard (setp X)
-                    :verify-guards nil))
-    (mbe :logic
-         (and (not (empty X))
-              (or (equal a (head X))
-                  (in a (tail X))))
-         :exec
-         (and x
-              (or (equal a (car x))
-                  (and (cdr x)
-                       (or (equal a (cadr x))
-                           (in a (cddr x))))))))
-
-  (verify-guards in
-    :hints(("Goal" :in-theory (enable (:ruleset primitive-rules)))))
-
-  (defthm in-type
-    (or (equal (in a X) t)
-        (equal (in a X) nil))
-    :rule-classes :type-prescription)
-
-  (encapsulate ()
-
-    (local (defthm head-not-whole
-             (implies (not (empty X))
-                      (not (equal (head X) X)))
-             :hints(("Goal" :in-theory (enable (:ruleset primitive-rules))))))
-
-    (local (defthm lemma
-             (implies (> (acl2-count x) (acl2-count y))
-                      (not (in x y)))))
-
-    (defthm not-in-self
-      (not (in x x))))
-
-  (defthm in-sfix-cancel
-    (equal (in a (sfix X))
-           (in a X)))
-
-  (defthm never-in-empty
-    (implies (empty X)
-             (not (in a X))))
-
-  (defthm in-set
-    (implies (in a X)
-             (setp X)))
-
-  (defthm in-tail
-    (implies (in a (tail X))
-             (in a X)))
-
-  (defthm in-tail-or-head
-    (implies (and (in a X)
-                  (not (in a (tail X))))
-             (equal (head X) a)))
-
-  (defthm in-head
-    ;; BOZO seems redundant with never-in-empty
-    (equal (in (head X) X)
-           (not (empty X)))))
-
-
-; We now begin to move away from set order.
-
-(defsection head-unique
-  :extension head
-
-  (local (defthm lemma
-	   (implies (and (not (empty X))
-			 (not (equal a (head X)))
-			 (not (<< a (head (tail X))))
-			 (<< a (head X)))
-		    (not (in a X)))
-	   :hints(("Goal"
-		   :in-theory (enable (:ruleset order-rules))
-		   :cases ((empty (tail X)))))))
-
-  (defthm head-minimal
-    (implies (<< a (head X))
-	     (not (in a X)))
-    :hints(("Goal"
-	    :in-theory (enable (:ruleset order-rules)))))
-
-  (defthm head-minimal-2
-    (implies (in a X)
-	     (not (<< a (head X)))))
-
-  (add-to-ruleset order-rules '(head-minimal head-minimal-2))
-
-
-  (local (defthm lemma2
-	   (implies (empty (tail X))
-		    (not (in (head X) (tail X))))))
-
-  (local (defthm lemma3
-	   (implies (not (empty (tail X)))
-		    (not (in (head X) (tail X))))
-	   :hints(("Goal" :in-theory (enable (:ruleset order-rules))))))
-
-  ;; This is an interesting theorem, which gives us a concept of uniqueness
-  ;; without using the set order to state it!
-
-  (defthm head-unique
-    (not (in (head X) (tail X)))
-    :hints(("Goal"
-	    :use ((:instance lemma2)
-		  (:instance lemma3))))))
-
-
-
-(defsection in-insert
-  :extension insert
-
-  (defthm insert-identity
-    (implies (in a X)
-             (equal (insert a X) X))
-    :hints(("Goal"
-            :in-theory (enable head-tail-same
-                               (:ruleset order-rules)))))
-
-  (defthm in-insert
-    (equal (in a (insert b X))
-           (or (in a X)
-               (equal a b)))
-    :hints(("Goal"
-            :in-theory (enable (:ruleset order-rules))
-            :induct (insert b X)))))
-
-
-
-(defsection weak-insert-induction
-  :parents (insert)
-  :short "Inducting over insert without exposing the set order."
-
-  :long "<p>When we want to insert an element into an ordered set, the set
-order obviously has to be involved so that we can decide where to put the new
-element.  Accordingly, the set order plays a role in the induction scheme that
-we get from @(see insert)'s definition.  This makes insert somewhat different
-than other set operations (membership, union, cardinality, etc.) that just use
-a simple @(see tail)-based induction, where the set order is already hidden by
-@('tail').</p>
-
-<p>When we are proving theorems about sets, we generally want to avoid thinking
-about the set order, but we sometimes need to induct over @('insert').  So,
-here we introduce a new induction scheme that allows us to induct over insert
-but hides the set order.  We disable the ordinary induction scheme that insert
-uses, and set up an induction hint so that @('weak-insert-induction') will
-automatically be used instead.</p>"
-
-  (defthm weak-insert-induction-helper-1
-    (implies (and (not (in a X))
-                  (not (equal (head (insert a X)) a)))
-             (equal (head (insert a X))
-                    (head X)))
-    :hints(("Goal" :in-theory (enable (:ruleset order-rules)))))
-
-  (defthm weak-insert-induction-helper-2
-    (implies (and (not (in a X))
-                  (not (equal (head (insert a X)) a)))
-             (equal (tail (insert a X))
-                    (insert a (tail X))))
-    :hints(("Goal" :in-theory (enable (:ruleset order-rules)))))
-
-  (defthm weak-insert-induction-helper-3
-    (implies (and (not (in a X))
-                  (equal (head (insert a X)) a))
-             (equal (tail (insert a X))
-                    (sfix X)))
-    :hints(("Goal" :in-theory (enable (:ruleset order-rules)))))
-
-  (defun weak-insert-induction (a X)
-    (declare (xargs :guard (setp X)))
-    (cond ((empty X) nil)
-          ((in a X) nil)
-          ((equal (head (insert a X)) a) nil)
-          (t (list (weak-insert-induction a (tail X))))))
-
-  (in-theory (disable (:induction insert)))
-
-  (defthm use-weak-insert-induction t
-    :rule-classes ((:induction
-                    :pattern (insert a X)
-                    :scheme (weak-insert-induction a X)))))
-
-
-
-(defsection subset
-  :parents (osets)
-  :short "@(call subset) determines if @('X') is a subset of @('Y')."
-
-  :long "<p>We use a logically simple definition, but using MBE we exploit the
-set order to implement a tail-recursive, linear subset check.</p>
-
-<p>The :exec version of fast-subset just inlines the set primitives and tweaks
-the way the order check is done.  It is about 3x faster than the :logic version
-of fast-subset on the following loop:</p>
-
-@({
- ;; 3.83 sec logic, 1.24 seconds exec
- (let ((x (loop for i from 1 to 1000 collect i)))
-   (gc$)
-   (time$ (loop for i fixnum from 1 to 100000 do (sets::subset x x))))
-})
-
-<p>In the future we may investigate developing a faster subset check based on
-galloping.</p>"
-
-  (defun fast-subset (X Y)
-    (declare (xargs :guard (and (setp X) (setp Y))
-                    :guard-hints(("Goal" :in-theory (enable (:ruleset primitive-rules) <<)))))
-    (mbe :logic
-         (cond ((empty X) t)
-               ((empty Y) nil)
-               ((<< (head X) (head Y)) nil)
-               ((equal (head X) (head Y)) (fast-subset (tail X) (tail Y)))
-               (t (fast-subset X (tail Y))))
-         :exec
-         (cond ((null X) t)
-               ((null Y) nil)
-               ((fast-lexorder (car X) (car Y))
-                (and (equal (car X) (car Y))
-                     (fast-subset (cdr X) (cdr Y))))
-               (t
-                (fast-subset X (cdr Y))))))
-
-  (defun subset (X Y)
-    (declare (xargs :guard (and (setp X) (setp Y))
-                    :verify-guards nil))
-    (mbe :logic
-         (if (empty X)
-                    t
-                  (and (in (head X) Y)
-                       (subset (tail X) Y)))
-         :exec (fast-subset X Y)))
-
-  (defthm subset-type
-    (or (equal (subset X Y) t)
-        (equal (subset X Y) nil))
-    :rule-classes :type-prescription)
-
-  (encapsulate ()
-
-    (local (defthmd lemma
-             (implies (not (in (head Y) X))
-                      (equal (subset X Y)
-                             (subset X (tail Y))))))
-
-    (local (defthm case-1
-             (implies (and (not (empty X))
-                           (not (empty Y))
-                           (not (<< (head X) (head Y)))
-                           (not (equal (head X) (head Y)))
-                           (implies (and (setp X) (setp (tail Y)))
-                                    (equal (fast-subset X (tail Y))
-                                           (subset X (tail Y)))))
-                      (implies (and (setp X) (setp Y))
-                               (equal (fast-subset X Y)
-                                      (subset X Y))))
-             :hints(("Goal" :in-theory (enable (:ruleset order-rules))
-                     :use (:instance lemma)))))
-
-    (local (defthm case-2
-             (implies (and (not (empty x))
-                           (not (empty y))
-                           (not (<< (head x) (head y)))
-                           (equal (head x) (head y))
-                           (implies (and (setp (tail x)) (setp (tail y)))
-                                    (equal (fast-subset (tail x) (tail y))
-                                           (subset (tail x) (tail y)))))
-                      (implies (and (setp x) (setp y))
-                               (equal (fast-subset x y)
-                                      (subset x y))))
-             :hints(("Goal" :in-theory (enable (:ruleset order-rules))
-                     :use (:instance lemma (X (tail X)))))))
-
-    (local (defthm fast-subset-equivalence
-             (implies (and (setp X) (setp Y))
-                      (equal (fast-subset X Y)
-                             (subset X Y)))
-             :hints(("Goal" :in-theory (enable (:ruleset order-rules))
-                     :induct (fast-subset X Y)))))
-
-    (verify-guards subset)))
-
-
-
-(defsection all-by-membership
-  :parents (osets)
-  :short "A way to quantify over sets."
-
-  :long "<p>@('all-by-membership') is a generic theorem that can be used to
-prove that a property holds of a set by showing that a related property holds
-of the set elements.</p>
-
-<p>The most important role of @('all-by-membership') is to allow for
-pick-a-point proofs of @(see subset).  That is, it allows us to show that
-@('(subset X Y)') holds by showing that every element of X satisfies @('(in a
-Y)').</p>
-
-<p>More generally, we could show that a set satisfies a predicate like
-@('integer-setp') because each of its elements satisfies @('integerp').</p>
-
-
-<h3>Pick-a-Point Proofs in ACL2</h3>
-
-<p>We begin by explaining how pick-a-point proofs of subset can be carried out.
-In traditional mathematics, @(see subset) is defined using quantification over
-members, e.g., as follows:</p>
-
-@({
-  (equal (subset X Y)
-         (forall a (implies (in a X) (in a Y))))
-})
-
-<p>This definition is very useful for <b>pick-a-point</b> proofs that some set
-@('X') is a subset of @('Y').  Such a proof begins by picking an arbitrary
-point @('a') that is a member of @('X').  Then, if we can show that @('a') must
-be a member of @('Y'), we have established @('(subset X Y)').</p>
-
-<p>These kinds of arguments are extremely useful, and we would like to be able
-to carry them out in ACL2 about osets.  But since ACL2 does not have explicit
-quantifiers, we cannot even write a theorem like this:</p>
-
-@({
- (implies (forall a (implies (in a X) (in a Y)))
-          (subset X Y))
-})
-
-<p>But consider the contrapositive of this theorem:</p>
-
-@({
- (implies (not (subset X Y))
-          (exists a (and (in a X) (not (in a Y)))))
-})
-
-<p>We <i>can</i> prove something like this, by writing an explicit function to
-search for an element of @('X') that is not an element of @('Y').  That is, we
-can prove:</p>
-
-@({
- (implies (not (subset X Y))
-          (let ((a (find-witness X Y)))
-            (and (in a X)
-                 (not (in a Y)))))
-})
-
-<p>Once we prove the above, we still need to be able to \"reduce\" a proof of
-@('(subset X Y)') to a proof of @('(implies (in a X) (in a Y))').  While we
-can't do this with a direct rewrite rule, we can sort of fake it using
-functional instantiation.  As groundwork:</p>
-
-<ul>
-
-<li>Using @(see encapsulate), we introduce functions @('sub') and @('super')
-with the constraint that @({
- (implies (in a (sub))
-          (in a (super)))
-})</li>
-
-<li>Using this constraint, we prove the generic theorem:
-@({
- (subset (sub) (super))
-})</li>
-
-</ul>
-
-<p>Then, when we want to prove @('(subset X Y)') for some particular @('X') and
-@('Y'), we can functionally instantiate the generic theorem with</p>
-
-@({
-   sub   <-- (lambda () X)
-   super <-- (lambda () Y)
-})
-
-<p>And this allows us to prove @('(subset X Y)') as long as we can relieve the
-constraint, i.e., @('(implies (in a X) (in a Y))').</p>
-
-
-<h3>Generalizing Pick-a-Point Proofs</h3>
-
-<p>In earlier versions of the osets library, we used an explicit argument to
-reduce subset proofs to pick-a-point style membership arguments.  But we later
-generalized the approach to arbitrary predicates instead.</p>
-
-<p>First, notice that if you let the predicate @('(P a)') be defined as @('(in
-a Y)'), then @('(subset X Y)') is just</p>
-
-@({
- (forall a, (implies (in a X) (P a)))
-})
-
-<p>Our generalization basically lets you reduce a proof of @('(P-setp X)') to a
-proof of @('(implies (in a X) (P a))'), for an arbitrary predicate @('P').
-This can be used to prove subset by just chooisng @('P') as described above,
-but it can also be used for many other ideas by just changing the meaning of
-@('P').  For instance, if @('P') is @(see integerp), then we can show that
-@('X') is an @('integer-setp') or similar.</p>
-
-<p>The mechanism is just an adaptation of that described in the previous
-section.</p>
-
-<ul>
-
-<li>We begin by introducing a completely arbitrary @('predicate').</li>
-
-<li>Based on @('predicate'), we introduce a new function, @('all'), which
-checks to see if every member in a set satisfies @('predicate').</li>
-
-<li>We set up an encapsulate which allows us to assume that some hypotheses are
-true and that any member of some set satisfies @('predicate').</li>
-
-</ul>
-
-<p>Finally, we prove @('all-by-membership'), which shows that under these
-assumptions, the set satisfies @('all').  This theorem can be functionally
-instantiated to reduce a proof of @('(all X)') to a proof of</p>
-
-@({
-  (implies (in a X) (P a))
-})"
-
-  (encapsulate
-    (((predicate *) => *))
-    (local (defun predicate (x) x)))
-
-  (defun all (set-for-all-reduction)
-    (declare (xargs :guard (setp set-for-all-reduction)))
-    (if (empty set-for-all-reduction)
-        t
-      (and (predicate (head set-for-all-reduction))
-           (all (tail set-for-all-reduction)))))
-
-  (encapsulate
-    (((all-hyps) => *)
-     ((all-set) => *))
-
-    (local (defun all-hyps () nil))
-    (local (defun all-set () nil))
-
-    (defthmd membership-constraint
-      (implies (all-hyps)
-               (implies (in arbitrary-element (all-set))
-                        (predicate arbitrary-element)))))
-
-  (local (defun find-not (X)
-           (declare (xargs :guard (setp X)))
-           (cond ((empty X) nil)
-                 ((not (predicate (head X))) (head X))
-                 (t (find-not (tail X))))))
-
-  (local (defthm lemma-find-not-is-a-witness
-           (implies (not (all x))
-                    (and (in (find-not x) x)
-                         (not (predicate (find-not x)))))))
-
-  (defthmd all-by-membership
-    (implies (all-hyps)
-             (all (all-set)))
-    :hints(("Goal"
-            :use (:instance membership-constraint
-                            (arbitrary-element (find-not (all-set))))))))
-
-
-
-(defsection pick-a-point-subset-strategy
-  :parents (osets)
-  :short "Automatic pick-a-point proofs of @(see subset)."
-
-  :long "<p>The rewrite rule @('pick-a-point-subset-strategy') tries to
-automatically reduce proof goals such as:</p>
-
-@({
- (implies hyps
-          (subset X Y))
-})
-
-<p>To proofs of:</p>
-
-@({
- (implies (and hyps (in a X))
-          (in a Y))
-})
-
-<p>The mechanism for doing this is somewhat elaborate: the rewrite rule
-replaces the @('(subset X Y)') with @('(subset-trigger X Y)').  This trigger is
-recognized by a computed hint, which then suggest proving the theorem via
-functional instantiation of @(see all-by-membership).</p>
-
-<p>The pick-a-point method is often a good way to prove subset relations.  On
-the other hand, this rule is very heavy-handed, and you may need to disable it
-if you do not want to use the pick-a-point method to solve your goal.</p>"
-
-  (defun subset-trigger (X Y)
-    (declare (xargs :guard (and (setp X) (setp Y))))
-    (subset X Y))
-
-  (defthm pick-a-point-subset-strategy
-    (implies (and (syntaxp (rewriting-goal-lit mfc state))
-                  (syntaxp (rewriting-conc-lit `(subset ,X ,Y) mfc state)))
-             (equal (subset X Y)
-                    (subset-trigger X Y))))
-
-  (in-theory (disable subset-trigger))
-
-  ;; BOZO replace all this stuff with witness-cp?
-  (COMPUTED-HINTS::automate-instantiation
-   :new-hint-name pick-a-point-subset-hint
-   :generic-theorem all-by-membership
-   :generic-predicate predicate
-   :generic-hyps all-hyps
-   :generic-collection all-set
-   :generic-collection-predicate all
-   :actual-collection-predicate subset
-   :actual-trigger subset-trigger
-   :predicate-rewrite (((predicate ?x ?y) (in ?x ?y)))
-   :tagging-theorem pick-a-point-subset-strategy))
-
-
-
-
-(defsection subset-theorems
-  :extension subset
-
-  (defthm subset-sfix-cancel-X
-    (equal (subset (sfix X) Y)
-           (subset X Y)))
-
-  (defthm subset-sfix-cancel-Y
-    (equal (subset X (sfix Y))
-           (subset X Y)))
-
-  (defthm empty-subset
-    (implies (empty X)
-             (subset X Y)))
-
-  (defthm empty-subset-2
-    (implies (empty Y)
-             (equal (subset X Y)
-                    (empty X))))
-
-  (defthm subset-in
-    (and (implies (and (subset X Y)
-                       (in a X))
-                  (in a Y))
-         (implies (and (in a X)
-                       (subset X Y))
-                  (in a Y))))
-
-  (defthm subset-in-2
-    (and (implies (and (subset X Y)
-                       (not (in a Y)))
-                  (not (in a X)))
-         (implies (and (not (in a Y))
-                       (subset X Y))
-                  (not (in a X)))))
-
-  (encapsulate
-    ()
-    (local (defthm l0
-             (equal (subset (insert a nil) Y)
-                    (in a Y))
-             :hints(("Goal" :in-theory (enable (:ruleset primitive-rules))))))
-
-    (defthm subset-insert-X
-      (equal (subset (insert a X) Y)
-             (and (subset X Y)
-                  (in a Y)))
-      :hints(("Goal" :induct (insert a X)))))
-
-  (defthm subset-reflexive
-    (subset X X))
-
-  (defthm subset-transitive
-    (and (implies (and (subset X Y)
-                       (subset Y Z))
-                  (subset X Z))
-         (implies (and (subset Y Z)
-                       (subset X Y))
-                  (subset X Z))))
-
-  (defthm subset-membership-tail
-    (implies (and (subset X Y)
-                  (in a (tail X)))
-             (in a (tail Y)))
-    :hints(("Goal" :in-theory (enable (:ruleset order-rules)))))
-
-  (defthm subset-membership-tail-2
-    (implies (and (subset X Y)
-                  (not (in a (tail Y))))
-             (not (in a (tail X))))
-    :hints(("Goal" :in-theory (disable subset-membership-tail)
-            :use (:instance subset-membership-tail))))
-
-  (defthm subset-insert
-    (subset X (insert a X)))
-
-  (defthm subset-tail
-    (subset (tail X) X)
-    :rule-classes ((:rewrite)
-                   (:forward-chaining :trigger-terms ((tail x))))))
-
-
-
-
-(defsection double-containment
-  :parents (osets)
-  :short "A strategy for proving sets are equal because they are subsets
-of one another."
-
-  :long "<p>Double containment can be a good way to prove that two sets are
-equal to one another.</p>
-
-<p>Unfortunately, because this rule targets @('equal') it can get quite
-expensive.  You may sometimes wish to disable it to speed up your proofs, as
-directed by @(see accumulated-persistence).</p>"
-
-; The general argument is the following:
-;
-; Suppose that we have two sets which are subsets of one another, i.e. (subset
-; X Y) and (subset Y X) are true.  First, we will show that (head X) = (head
-; Y).  Next we will show that (in a (tail X)) implies that (in a (tail Y)).
-; This fact is then used for a sub- set by membership argument to show that
-; (tail X) = (tail Y).  Now, (head X) = (head Y) and (tail X) = (tail Y) can be
-; used together to show that X = Y (see primitives.lisp, head-tail-same) so we
-; are done.
-
-; Here are the details.  First we show that the heads are the same:
-
-  (local (defthmd double-containment-lemma-head
-	   (implies (and (subset X Y)
-			 (subset Y X))
-		    (equal (head X) (head Y)))
-	   :hints(("Goal" :in-theory (enable (:ruleset order-rules))))))
-
-
-; Next we show that (tail X) is a subset of (tail Y), using a subset by
-; membership argument:
-
-  (local (defthmd in-tail-expand
-	   (equal (in a (tail X))
-		  (and (in a X)
-		       (not (equal a (head X)))))))
-
-  (local (defthmd double-containment-lemma-in-tail
-	   (implies (and (subset X Y)
-			 (subset Y X))
-		    (implies (in a (tail X))   ; could be "equal" instead,
-			     (in a (tail Y)))) ; but that makes loops.
-	   :hints(("Goal"
-		   :in-theory (enable (:ruleset order-rules))
-		   :use ((:instance in-tail-expand (a a) (X X))
-			 (:instance in-tail-expand (a a) (X Y)))))))
-
-  (local (defthmd double-containment-lemma-tail
-	   (implies (and (subset X Y)
-			 (subset Y X))
-		    (subset (tail X) (tail Y)))
-	   :hints(("Goal" :in-theory (enable double-containment-lemma-in-tail)))))
-
-; Finally, we are ready to show that double containment is equality.  To do
-; this, we need to induct in such a way that we consider the tails of X and Y.
-; Then, we will use our fact that about the tails being subsets of one another
-; in the inductive case.
-
-  (local (defun double-tail-induction (X Y)
-	   (declare (xargs :guard (and (setp X) (setp Y))))
-	   (if (or (empty X) (empty Y))
-	       (list X Y)
-	     (double-tail-induction (tail X) (tail Y)))))
-
-  (local (defthm double-containment-is-equality-lemma
-	   (IMPLIES (AND (NOT (OR (EMPTY X) (EMPTY Y)))
-			 (IMPLIES (AND (SUBSET (TAIL X) (TAIL Y))
-				       (SUBSET (TAIL Y) (TAIL X)))
-				  (EQUAL (EQUAL (TAIL X) (TAIL Y)) T))
-			 (SETP X)
-			 (SETP Y)
-			 (SUBSET X Y)
-			 (SUBSET Y X))
-		    (EQUAL (EQUAL X Y) T))
-	   :hints(("Goal"
-                   :in-theory (enable head-tail-same)
-		   :use ((:instance double-containment-lemma-tail
-				    (X X) (Y Y))
-			 (:instance double-containment-lemma-tail
-				    (X Y) (Y X))
-			 (:instance double-containment-lemma-head
-				    (X X) (Y Y)))))))
-
-  (local (defthmd double-containment-is-equality
-	   (implies (and (setp X)
-			 (setp Y)
-			 (subset X Y)
-			 (subset Y X))
-		    (equal (equal X Y) t))
-	   :hints(("Goal"
-                   :in-theory (enable head-tail-same)
-                   :induct (double-tail-induction X Y)))))
-
-  (defthm double-containment
-    ;; I added backchain limits to this because targetting equal is so expensive.
-    ;; Even so it is possibly very expensive.
-    (implies (and (setp X)
-		  (setp Y))
-	     (equal (equal X Y)
-		    (and (subset X Y)
-			 (subset Y X))))
-    :rule-classes ((:rewrite :backchain-limit-lst 1))
-    :hints(("Goal" :use (:instance double-containment-is-equality)))))
-
-
-; We are now done with the membership level.  We disable all of the order based
-; reasoning that we introduced here.
-
-(in-theory (disable head-minimal head-minimal-2))
-
-
-
-
-
-
-;; [Jared] I moved a few things here from what used to be fast.lisp, so they can
-;; be shared across the new union/intersection/difference files
-
-; I've tried various approaches to exposing the set order.  My current strategy
-; is to open all primitives, convert IN to MEMBER, and convert SUBSET to
-; SUBSETP (list subset).  BOZO discuss the other, lifting approach.
-
-(encapsulate
-  ()
-  (local (in-theory (enable (:ruleset primitive-rules)
-                            (:ruleset order-rules))))
-
-  (defthm setp-of-cons
-    (equal (setp (cons a X))
-           (and (setp X)
-                (or (<< a (head X))
-                    (empty X)))))
-
-  (defthm in-to-member
-    (implies (setp X)
-             (equal (in a X)
-                    (if (member a x)
-                        t
-                      nil))))
-
-  (defthm not-member-when-smaller
-    (implies (and (<< a (car x))
-                  (setp x))
-             (not (member a x))))
-
-  (defthm subset-to-subsetp
-    (implies (and (setp x)
-                  (setp y))
-             (equal (subset x y)
-                    (subsetp x y))))
-
-  (defthm lexorder-<<-equiv
-    ;; This lets us optimize << into just lexorder when we've already
-    ;; checked equality.
-    (implies (not (equal a b))
-             (equal (equal (<< a b) (lexorder a b))
-                    t))
-    :hints(("Goal" :in-theory (enable <<)))))
-
-(def-ruleset low-level-rules
-  '(setp-of-cons
-    in-to-member
-    not-member-when-smaller
-    subset-to-subsetp
-    lexorder-<<-equiv
-    (:ruleset primitive-rules)
-    (:ruleset order-rules)))
-
-(in-theory (disable (:ruleset low-level-rules)))
-
-
-
-; These fast versions recur on one or both of their arguments, but not always
-; the same argument.  Hence, we need to introduce a more flexible measure to
-; prove that they terminate.  Fortunately, this is still relatively simple:
-
-(defun fast-measure (X Y)
-  (+ (acl2-count X) (acl2-count Y)))
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/membership" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/outer.lisp acl2-6.3/books/finite-set-theory/osets/outer.lisp
--- acl2-6.2/books/finite-set-theory/osets/outer.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/outer.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,130 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; outer.lisp
-;
-; Theorems relating the more complicated set operations (union, intersect,
-; etc.)  to one another.
-
-(in-package "SETS")
-(include-book "delete")
-(include-book "union")
-(include-book "intersect")
-(include-book "difference")
-(include-book "cardinality")
-(set-verify-guards-eagerness 2)
-
-
-(defthm union-delete-X
-    (equal (union (delete a X) Y)
-           (if (in a Y)
-               (union X Y)
-             (delete a (union X Y)))))
-
-(defthm union-delete-Y
-    (equal (union X (delete a Y))
-           (if (in a X)
-               (union X Y)
-             (delete a (union X Y)))))
-
-
-(defthm intersect-delete-X
-  (equal (intersect (delete a X) Y)
-         (delete a (intersect X Y))))
-
-(defthm intersect-delete-Y
-  (equal (intersect X (delete a Y))
-         (delete a (intersect X Y))))
-
-(defthm union-over-intersect
-  (equal (union X (intersect Y Z))
-         (intersect (union X Y) (union X Z))))
-
-(defthm intersect-over-union
-  (equal (intersect X (union Y Z))
-         (union (intersect X Y) (intersect X Z))))
-
-
-(defthm difference-over-union
-  (equal (difference X (union Y Z))
-         (intersect (difference X Y) (difference X Z))))
-
-(defthm difference-over-intersect
-  (equal (difference X (intersect Y Z))
-         (union (difference X Y) (difference X Z))))
-
-(defthm difference-delete-X
-  (equal (difference (delete a X) Y)
-         (delete a (difference X Y))))
-
-(defthm difference-delete-Y
-  (equal (difference X (delete a Y))
-         (if (in a X)
-             (insert a (difference X Y))
-           (difference X Y))))
-
-(defthm difference-insert-Y
-  (equal (difference X (insert a Y))
-         (delete a (difference X Y))))
-
-
-(defthm intersect-cardinality-X
-  (<= (cardinality (intersect X Y))
-      (cardinality X))
-  :rule-classes (:rewrite :linear))
-
-(defthm intersect-cardinality-Y
-  (<= (cardinality (intersect X Y))
-      (cardinality Y))
-  :rule-classes (:rewrite :linear))
-
-
-; There are also some interesting properties about cardinality which are more
-; precise.
-
-(defthm expand-cardinality-of-union
-  ;; This is pretty questionable -- it used to also be a :linear rule, but that was
-  ;; really expensive.
-  (equal (cardinality (union X Y))
-         (- (+ (cardinality X) (cardinality Y))
-            (cardinality (intersect X Y)))))
-
-(defthm expand-cardinality-of-difference
-  ;; Also questionable, also used to be :linear
-  (equal (cardinality (difference X Y))
-         (- (cardinality X)
-            (cardinality (intersect X Y)))))
-
-;; We used to have this rule, but it was silly -- (intersect X Y) can just rewrite to
-;; (SFIX X) when X is a subset of Y.
-;; (defthm intersect-cardinality-subset
-;;     (implies (subset X Y)
-;;              (equal (cardinality (intersect X Y))
-;;                     (cardinality X))))
-
-(defthmd intersect-cardinality-non-subset
-  (implies (not (subset x y))
-           (< (cardinality (intersect x y))
-              (cardinality x)))
-  :rule-classes (:rewrite :linear))
-
-(defthmd intersect-cardinality-subset-2
-  (equal (equal (cardinality (intersect X Y))
-                (cardinality X))
-         (subset X Y)))
-
-(defthmd intersect-cardinality-non-subset-2
-  (equal (< (cardinality (intersect x y))
-            (cardinality x))
-         (not (subset x y))))
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/outer" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/portcullis.acl2 acl2-6.3/books/finite-set-theory/osets/portcullis.acl2
--- acl2-6.2/books/finite-set-theory/osets/portcullis.acl2	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/portcullis.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,16 +0,0 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-(ld "sets.defpkg")
-(certify-book "portcullis" ? t)
diff -Nru acl2-6.2/books/finite-set-theory/osets/portcullis.lisp acl2-6.3/books/finite-set-theory/osets/portcullis.lisp
--- acl2-6.2/books/finite-set-theory/osets/portcullis.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/portcullis.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,27 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "SETS")
-
-; These allow SETS:: versions of enable, disable, and e/d to use rulesets
-; natively.
-
-(defmacro enable (&rest args)
-  `(acl2::enable* . ,args))
-
-(defmacro disable (&rest args)
-  `(acl2::disable* . ,args))
-
-(defmacro e/d (&rest args)
-  `(acl2::e/d* . ,args))
-
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/portcullis" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/primitives.lisp acl2-6.3/books/finite-set-theory/osets/primitives.lisp
--- acl2-6.2/books/finite-set-theory/osets/primitives.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/primitives.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,543 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; primitives.lisp - setp, sfix, head, tail, etc.
-
-(in-package "SETS")
-(include-book "misc/total-order" :dir :system)
-(include-book "tools/rulesets" :dir :system)
-(include-book "xdoc/top" :dir :system)
-(set-verify-guards-eagerness 2)
-
-
-(defxdoc primitives
-  :parents (osets)
-  :short "Replacements for @('car'), @('cdr'), etc., that respect the
-<i>non-set convention</i>."
-
-  :long "<p>Since the osets library uses ordered lists as the underlying
-representation of sets, at some point we have to use <b>list
-primitives</b> (car, cdr, endp, cons) to operate on sets.  A problem with using
-these functions directly is that they do not follow the non-set convention.</p>
-
-<p>The <b>non-set convention</b> is: set operations should treat improper
-sets (i.e., non-@('nil') atoms and lists that have duplicated or mis-ordered
-elements) as the empty set.  We adopt this convention throughout the library.
-It allows most of our rewrite rules to have no @(see setp) hypotheses.</p>
-
-<p>The primitive list functions do follow the non-set convention.  For
-instance:</p>
-
-<ul>
- <li>@('(car '(1 1 1)) = 1'),            but @('(car nil) = nil')</li>
- <li>@('(cdr '(1 1 1)) = (1 1)'),        but @('(cdr nil) = nil')</li>
- <li>@('(cons 1 '(1 1 1)) = (1 1 1 1)'), but @('(cons 1 nil) = (1)')</li>
- <li>@('(endp '(1 1 1)) = nil'),         but @('(endp nil) = t')</li>
-</ul>
-
-<p>These behaviors make it harder to reason about set operations that are
-written directly in terms of the list primitives.  When we try to do so, we
-usually have to do lots of work to consider all the cases about whether the
-inputs are ordered, etc.</p>
-
-<p>To solve lots of these problems, we introduce new <b>set primitives</b> that
-are mostly like the list primitives, except that they follow the non-set
-convention.  These primitives are:</p>
-
-<ul>
- <li>@('(head X)') - the first element of a set, nil for non/empty sets</li>
- <li>@('(tail X)') - all rest of the set, nil for non/empty sets</li>
- <li>@('(insert a X)') - ordered insert of @('a') into @('X')</li>
- <li>@('(empty X)') - recognizer for non/empty sets.</li>
-</ul>
-
-<p>The general idea is that set operations should be written in terms of these
-set primitives instead of the list primitives, and the definitions of the set
-primitives should be kept disabled to avoid having to reason about the low
-level structure of sets.</p>")
-
-
-(defsection setp
-  :parents (primitives)
-  :short "@(call setp) recognizes well-formed ordered sets."
-
-  :long "<p>A proper ordered set is a @(see true-listp) whose elements are
-fully ordered under @(see <<).  Note that this implicitly means that sets have
-no duplicate elements.</p>
-
-<p>Testing @('setp') is necessarily somewhat slow: we have to check that the
-elements are in order.  Its cost is linear in the size of @('n').</p>"
-
-  (defun setp (X)
-    (declare (xargs :guard t :verify-guards nil))
-    (if (atom X)
-        (null X)
-      (or (null (cdr X))
-          (and (consp (cdr X))
-               (fast-<< (car X) (cadr X))
-               (setp (cdr X))))))
-
-  (verify-guards setp
-    :hints(("Goal" :in-theory (enable <<))))
-
-  (defthm setp-type
-    (or (equal (setp X) t)
-        (equal (setp X) nil))
-    :rule-classes :type-prescription)
-
-  (defthm sets-are-true-lists
-    (implies (setp X)
-             (true-listp X))
-    :rule-classes ((:rewrite) (:compound-recognizer))))
-
-
-
-(defsection empty
-  :parents (primitives)
-  :short "@(call empty) recognizes empty sets."
-
-  :long "<p>This function is like @(see endp) for lists, but it respects the
-non-set convention and always returns true for ill-formed sets.</p>"
-
-  (defun empty (X)
-    (declare (xargs :guard (setp X)))
-    (mbe :logic (or (null X)
-                    (not (setp X)))
-         :exec  (null X)))
-
-  (defthm empty-type
-    (or (equal (empty X) t)
-        (equal (empty X) nil))
-    :rule-classes :type-prescription)
-
-  (defthm nonempty-means-set
-    (implies (not (empty X))
-             (setp X))))
-
-(defthm empty-set-unique
-  ;; BOZO probably expensive.  We don't export this from sets.lisp, and we keep
-  ;; it out of the docs above.
-  (implies (and (setp X)
-                (setp Y)
-                (empty X)
-                (empty Y))
-           (equal (equal X Y)
-                  t)))
-
-
-
-(defsection sfix
-  :parents (primitives)
-  :short "@(call sfix) is a fixing function for sets."
-
-  :long "<p>We return any proper @(see setp) unchanged, but coerce any
-non-@(see setp) into the empty set.</p>
-
-<p>This does for sets what functions like @(see nfix) or @(see rfix) do for
-numbers.  It is often useful to use @('sfix') in the base case of a set
-operation to ensure that an ordered set is always produced.</p>"
-
-  (defun sfix (X)
-    (declare (xargs :guard (setp X)))
-    (mbe :logic (if (empty X) nil X)
-         :exec  X))
-
-  (defthm sfix-produces-set
-    (setp (sfix X)))
-
-  (defthm sfix-set-identity
-    (implies (setp X)
-             (equal (sfix X)
-                    X)))
-
-  ;; I historically did this instead of sfix-when-empty, but now I think just
-  ;; rewriting it to NIL is a lot nicer.
-  ;;
-  ;; (defthm sfix-empty-same
-  ;;   (implies (and (empty X)
-  ;;                 (empty Y))
-  ;;            (equal (equal (sfix X) (sfix Y))
-  ;;                   t)))
-
-  (defthm sfix-when-empty
-    (implies (empty X)
-             (equal (sfix X)
-                    nil))))
-
-
-(defthm empty-sfix-cancel
-  (equal (empty (sfix X))
-         (empty X)))
-
-(xdoc::xdoc-extend empty "@(def empty-sfix-cancel)")
-
-
-
-(defsection head
-  :parents (primitives)
-  :short "@(call head) returns the smallest element in a set."
-
-  :long "<p>This is like @(see car), but respects the non-set convention and
-always returns @('nil') for ill-formed sets.</p>"
-
-  (defun head (X)
-    (declare (xargs :guard (and (setp X)
-                                (not (empty X)))))
-    (mbe :logic (car (sfix X))
-         :exec  (car X)))
-
-  (defthm head-count
-    (implies (not (empty X))
-             (< (acl2-count (head X)) (acl2-count X)))
-    :rule-classes ((:rewrite) (:linear)))
-
-  (defthm head-count-built-in
-    ;; BOZO probably should remove this
-    (implies (not (empty X))
-             (o< (acl2-count (head X)) (acl2-count X)))
-    :rule-classes :built-in-clause)
-
-  ;; I historically did this instead of head-when-empty, but now I think just
-  ;; rewriting it to NIL is a lot nicer.
-  ;;
-  ;; (defthm head-empty-same
-  ;;   (implies (and (empty X)
-  ;;                 (empty Y))
-  ;;            (equal (equal (head X) (head Y))
-  ;;                   t)))
-
-  (defthm head-when-empty
-    (implies (empty X)
-             (equal (head X)
-                    nil)))
-
-  (defthm head-sfix-cancel
-    (equal (head (sfix X))
-           (head X))))
-
-
-
-(defsection tail
-  :parents (primitives)
-  :short "@(call tail) returns the remainder of a set after removing its @(see
-head)."
-
-  :long "<p>This is like @(see cdr), but respects the non-set convention and
-always returns @('nil') for ill-formed sets.</p>"
-
-  (defun tail (X)
-    (declare (xargs :guard (and (setp X)
-                                (not (empty X)))))
-    (mbe :logic (cdr (sfix X))
-         :exec  (cdr X)))
-
-  (defthm tail-count
-    (implies (not (empty X))
-             (< (acl2-count (tail X)) (acl2-count X)))
-    :rule-classes ((:rewrite) (:linear)))
-
-  (defthm tail-count-built-in
-    ;; BOZO probably should remove this
-    (implies (not (empty X))
-             (o< (acl2-count (tail X)) (acl2-count X)))
-    :rule-classes :built-in-clause)
-
-  (defthm tail-produces-set
-    (setp (tail X)))
-
-  ;; I historically did this instead of tail-when-empty, but now I think just
-  ;; rewriting it to NIL is a lot nicer.
-  ;;
-  ;; (defthm tail-empty-same
-  ;;   (implies (and (empty X)
-  ;;                 (empty Y))
-  ;;            (equal (equal (tail X) (tail Y))
-  ;;                   t)))
-
-  ;; This was also subsumed by tail-when-empty:
-  ;;
-  ;; (defthm tail-preserves-empty
-  ;;   (implies (empty X)
-  ;;            (empty (tail X))))
-
-  (defthm tail-when-empty
-    (implies (empty X)
-             (equal (tail X)
-                    nil)))
-
-  (defthm tail-sfix-cancel
-    (equal (tail (sfix X))
-           (tail X))))
-
-
-(defthmd head-tail-same
-  ;; BOZO probably expensive
-  (implies (and (equal (head X) (head Y))
-                (equal (tail X) (tail Y))
-                (not (empty X))
-                (not (empty Y)))
-           (equal (equal X Y)
-                  t)))
-
-(defsection insert
-  :parents (primitives)
-  :short "@(call insert) adds the element @('a') to the set @('X')."
-
-  :long "<p>This is the fundamental set constructor.  It is similar to @(see
-cons) for lists, but of course performs an ordered insertion.  It respects the
-non-set convention and treats any ill-formed input as the empty set.</p>
-
-<p>Efficiency note.  Insert is @('O(n)').  It is very inefficient to call it
-repeatedly.  Instead, consider building sets with @(see mergesort) or out of
-other sets using @(see union).</p>
-
-<p>The :exec version just inlines the set primitives and does one level of loop
-unrolling.  On CCL, it runs about 1.65x faster than the :logic version on the
-following loop:</p>
-
-@({
- ;; 1.92 seconds :logic, 1.16 seconds :exec
- (let ((acc nil))
-  (gc$)
-  (time$ (loop for i fixnum from 1 to 10000 do
-               (setq acc (sets::insert i acc)))))
-})"
-
-  (local (in-theory (disable nonempty-means-set
-                             empty-set-unique
-                             head-when-empty
-                             tail-when-empty
-                             sfix-when-empty
-                             default-car
-                             default-cdr
-                             )))
-
-  (defun insert (a X)
-    (declare (xargs :guard (setp X)
-                    :verify-guards nil))
-    (mbe :logic
-         (cond ((empty X) (list a))
-               ((equal (head X) a) X)
-               ((<< a (head X)) (cons a X))
-               (t (cons (head X) (insert a (tail X)))))
-         :exec
-         (cond ((null X) (cons a nil))
-               ((equal (car X) a) X)
-               ((fast-lexorder a (car X)) (cons a X))
-               ((null (cdr X)) (cons (car X) (cons a nil)))
-               ((equal (cadr x) a) X)
-               ((fast-lexorder a (cadr X)) (cons (car X) (cons a (cdr X))))
-               (t (cons (car X) (cons (cadr X) (insert a (cddr X))))))))
-
-  (verify-guards insert
-    :hints(("Goal" :in-theory (e/d (<<)
-                                   (<<-trichotomy
-                                    <<-implies-lexorder)))))
-
-  (defthm insert-produces-set
-    (setp (insert a X)))
-
-  (defthm insert-sfix-cancel
-    (equal (insert a (sfix X))
-           (insert a X)))
-
-  (defthm insert-never-empty
-    (not (empty (insert a X))))
-
-  ;; I historically did this instead of insert-when-empty, but now I think that
-  ;; canonicalizing bad inserts into (insert a NIL) seems nicer.
-  ;;
-  ;; (defthm insert-empty-same
-  ;;   (implies (and (empty X)
-  ;;                 (empty Y))
-  ;;            (equal (equal (insert a X) (insert a Y))
-  ;;                   t)))
-
-  ;; The following also became unnecessary after switching to (insert a NIL).
-  ;;
-  ;; (defthm head-insert-empty
-  ;;   (implies (empty X)
-  ;;            (equal (head (insert a X)) a)))
-  ;;
-  ;; (defthm tail-insert-empty
-  ;;   (implies (empty X)
-  ;;  	      (empty (tail (insert a X)))))
-
-  (defthm insert-when-empty
-    (implies (and (syntaxp (not (equal X ''nil)))
-                  (empty X))
-             (equal (insert a X)
-                    (insert a nil))))
-
-  ;; These special cases can come up after insert-when-empty applies, so it's
-  ;; nice to have rules to target them.
-
-  (defthm head-of-insert-a-nil
-    (equal (head (insert a nil))
-           a))
-
-  (defthm tail-of-insert-a-nil
-    (equal (tail (insert a nil))
-           nil))
-
-  ;; Historic Note: We used to require that nil was "greater than" everything else
-  ;; in our order.  This had the advantage that the following theorems could have
-  ;; a combined case for (empty X) and (<< a (head X)).  Starting in Version 0.9,
-  ;; we remove this restriction in order to be more flexible about our order.
-
-  (defthm head-insert
-    (equal (head (insert a X))
-           (cond ((empty X) a)
-                 ((<< a (head X)) a)
-                 (t (head X)))))
-
-  (defthm tail-insert
-    (equal (tail (insert a X))
-           (cond ((empty X) (sfix X))
-                 ((<< a (head X)) (sfix X))
-                 ((equal a (head X)) (tail X))
-                 (t (insert a (tail X))))))
-
-  (encapsulate
-    ()
-    (local (defthm l0
-             (IMPLIES (AND (NOT (<< ACL2::Y ACL2::X))
-                           (NOT (EQUAL ACL2::X ACL2::Y)))
-                      (<< ACL2::X ACL2::Y))
-             :rule-classes ((:rewrite :backchain-limit-lst 0))))
-
-    (local (defthm l1
-             (IMPLIES (<< x y)
-                      (not (<< y x)))
-             :rule-classes ((:rewrite :backchain-limit-lst 0))))
-
-    (local (in-theory (disable sfix-set-identity
-                               insert-when-empty
-                               (:definition insert)
-                               <<-trichotomy
-                               <<-asymmetric)))
-
-    (local (defthm l2
-             (implies (and (<< b (car x))
-                           (setp x))
-                      (equal (cons b (insert (car x) x))
-                             (insert b (insert (car x) x))))
-             :rule-classes ((:rewrite :backchain-limit-lst 0))
-             :hints(("Goal" :expand ((:free (x) (insert b x)))))))
-
-    (local (defthm l3
-             (implies (and (<< b (car l))
-                           (not (equal b a))
-                           (not (<< a b)))
-                      (<< b (car (insert a l))))
-             :rule-classes ((:rewrite :backchain-limit-lst 0))
-             :hints(("goal" :expand (insert a l)))))
-
-    (local (in-theory (disable head-insert
-                               tail-insert)))
-
-    (defthm repeated-insert
-      (equal (insert a (insert a X))
-             (insert a X))
-      :hints(("Goal"
-              :induct t
-              :expand ((insert a nil)
-                       (insert a x)
-                       (insert (car x) x)
-                       (:free (k1 k2) (insert a (cons k1 k2)))))))
-
-    (defthm insert-insert
-      (equal (insert a (insert b X))
-             (insert b (insert a X)))
-      :rule-classes ((:rewrite :loop-stopper ((a b))))
-      :hints(("Goal"
-              :induct t
-              :expand ((insert a x)
-                       (insert b x)
-                       (:free (k1) (insert k1 nil))
-                       (:free (k1 k2 k3) (insert k1 (cons k2 k3))))))))
-
-  (defthm insert-head
-    (implies (not (empty X))
-             (equal (insert (head X) X)
-                    X)))
-
-  (defthm insert-head-tail
-    (implies (not (empty X))
-             (equal (insert (head X) (tail X))
-                    X)))
-
-
-
-  ;; Insert can be reasoned about in terms of induction, but its inductive case
-  ;; contains a call to "cons", and we cannot let that escape into the wild.
-  ;; Instead, we write a theorem to rephrase this cons into an insert.
-
-  (defthm insert-induction-case
-    (implies (and (not (<< a (head X)))
-                  (not (equal a (head X)))
-                  (not (empty X)))
-             (equal (insert (head X) (insert a (tail X)))
-                    (insert a X)))))
-
-
-
-;; The last thing we really need to do is reason about element order.  The
-;; following theorems are crucial for proofs in the membership level, which
-;; must stricly use induction and arguments about the set elements' order for
-;; proofs.  Since we are disabling all of the functions at the end of this
-;; book, these are the only facts which membership.lisp will be able to use.
-
-(defthm head-tail-order
-  (implies (not (empty (tail X)))
-           (<< (head X) (head (tail X)))))
-
-(defthm head-tail-order-contrapositive
-  (implies (not (<< (head X) (head (tail X))))
-           (empty (tail X))))
-
-(defthm head-not-head-tail
-  (implies (not (empty (tail X)))
-           (not (equal (head X) (head (tail X))))))
-
-
-
-; And that concludes the theorems we need about the primitive set functions.
-; Now we are interested in setting up theories and in disabling most of the
-; potentially bad issues that might arise.
-;
-; You should never need to use primitive-theory unless you are using non-set
-; functions, e.g. cons, to build sets.
-;
-; The primitive order theory is intended to be disabled for typical reasoning,
-; but is needed for some theorems in the membership level.
-
-(def-ruleset primitive-rules
-  '(setp empty head tail sfix insert))
-
-(def-ruleset order-rules
-  '(<<-irreflexive
-    <<-transitive
-    <<-asymmetric
-    <<-trichotomy
-    <<-implies-lexorder
-    (:induction insert)
-    insert-induction-case
-    head-insert
-    tail-insert
-    head-tail-order
-    head-tail-order-contrapositive))
-
-(in-theory (disable (:ruleset primitive-rules)
-                    (:ruleset order-rules)))
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/primitives" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/quantify.lisp acl2-6.3/books/finite-set-theory/osets/quantify.lisp
--- acl2-6.2/books/finite-set-theory/osets/quantify.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/quantify.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,947 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; quantify.lisp
-;
-; This is an optional extension of the sets library, and is not included by
-; default when you run (include-book "sets").
-;
-;
-; Constructive Quantification over Sets and Lists.
-;
-; We create the macro, quantify-predicate, which introduces the following
-; functions for any arbitrary predicate.
-;
-;     all<predicate>           all<not-predicate>
-;     exists<predicate>        exists<not-predicate>
-;     find<predicate>          find<not-predicate>
-;     filter<predicate>        filter<not-predicate>
-;
-;     all-list<predicate>      all-list<not-predicate>
-;     exists-list<predicate>   exists-list<not-predicate>
-;     find-list<predicate>     find-list<not-predicate>
-;     filter-list<predicate>   filter-list<not-predicate>
-;
-; In addition to introducing these functions, an entire rewriting strategy is
-; introduced for reasoning about these functions with respect to sets and
-; lists.
-;
-;
-; Introductory Examples.
-;
-; Here are some of the most simple examples.  All of these predicates have only
-; a single argument, and their guard is "t".
-;
-;     (SETS::quantify-predicate (integerp x))
-;     (SETS::quantify-predicate (symbolp x))
-;     (SETS::quantify-predicate (rationalp x))
-;     (SETS::quantify-predicate (natp x))
-;
-; Notice that you cannot use macros here.  For example, the following is an
-; error: (quantify-predicate (real/rationalp x)).  Once you have done the
-; above, you can now run these functions, e.g.,
-;
-;     (SETS::all<integerp> '(1 2 3)) = t
-;     (SETS::all<not-integerp> '(a b c)) = t
-;     (SETS::find<symbolp> '(1 2 3 a b c)) = a
-;
-;
-; Controlling Packages.
-;
-; As you can see, all of these functions are introduced in the SETS package by
-; default.  If you'd like them to be in a different place instead, you can
-; specify the :in-package-of argument and provide a symbol from some other
-; package.  For example, since defthm is in the ACL2 package, we might write:
-;
-;     (SETS::quantify-predicate (eqlablep x)
-;       :in-package-of defthm)
-;
-; And then the functions all<integerp>, all<not-integerp>, and so forth will be
-; in the ACL2 package instead of the LISTS package.
-;
-;
-; Multi-Argument Predicates.
-;
-; You can also quantify over predicates with many arguments.  As an example, we
-; introduce the function lessp as follows:
-;
-;     (defun lessp (a b)
-;       (declare (xargs :guard t))
-;       (< (rfix a) (rfix b)))
-;
-;     (quantify-predicate (lessp a b))
-;
-; We could now ask, is every element in a set less than some maximum value?
-; For example:
-;
-;     (all<lessp> '(1 2 3) 6) = t
-;     (all<lessp> '(1 2 3) 2) = nil
-;
-;
-; Supporting Guards.
-;
-; If efficiency is important, our predicate may have guards and we may want to
-; put guards on the introduced functions.  For example, we might write
-; fast-lessp below:
-;
-;     (defun fast-lessp (a b)
-;       (declare (xargs :guard (and (rationalp a)
-;                                   (rationalp b))))
-;       (< a b))
-;
-; Now we need to supply an extra :guard argument so that the guards of
-; all<fast-lessp>, exists<fast-lessp>, and so forth can be verified.
-;
-; When writing this guard, the list which all-list<fast-lessp> and so forth are
-; iterating over will be called ?list, and the set that all<fast-lessp> and so
-; forth are iterating over will be called ?set.  The other arguments will all
-; be named with whatever names you gave them when you ran quantify-predicate.
-; For example, below we name fast-lessp's second argument "max", so it will be
-; named "max" in our guards as well.
-;
-; Here's an example:
-;
-;     (in-package "ACL2")
-;
-;     (SETS::quantify-predicate (rationalp x)
-;       :in-package-of defthm)
-;
-;     (SETS::quantify-predicate (fast-lessp x max)
-;       :set-guard  ((all<rationalp> ?set))
-;       :list-guard ((all-list<rationalp> ?list))
-;       :arg-guard  ((rationalp max))
-;       :in-package-of defthm)
-;
-;
-;
-; Disabling the theory.
-;
-; Calling quantify-predicate will result in a lot of theorems being introduced.
-; You can disable all of these theorems by using the deftheory event
-; theory<predicate>.  For example,
-;
-;     (in-theory (disable theory<integerp>))
-;     (in-theory (disable theory<fast-lessp>))
-;
-; And so forth.
-
-(in-package "SETS")
-(include-book "sets")
-(set-verify-guards-eagerness 2)
-
-
-
-; We introduce our theory as a constant so that we can derive new instances of
-; it for concrete predicates
-
-(defconst *positive-functions* '(
-
-; We introduce "list versions" of the functions so that we can reason through
-; mergesorts.
-
-  (defun all-list (x)
-    (declare (xargs :guard (true-listp x)))
-    (if (endp x)
-	t
-      (and (predicate (car x))
-	   (all-list (cdr x)))))
-
-  (defun exists-list (x)
-    (declare (xargs :guard (true-listp x)))
-    (cond ((endp x) nil)
-	  ((predicate (car x)) t)
-	  (t (exists-list (cdr x)))))
-
-  (defun find-list (x)
-    (declare (xargs :guard (true-listp x)))
-    (cond ((endp x) nil)
-	  ((predicate (car x)) (car x))
-	  (t (find-list (cdr x)))))
-
-  (defun filter-list (x)
-    (declare (xargs :guard (true-listp x)))
-    (cond ((endp x) nil)
-	  ((predicate (car x))
-	   (cons (car x) (filter-list (cdr x))))
-	  (t (filter-list (cdr x)))))
-
-
-; We also introduce "set versions" of the functions, so that we can reason
-; about sets.
-
-  (defun all (set-for-all-reduction)
-    (declare (xargs :guard (setp set-for-all-reduction)))
-    (if (empty set-for-all-reduction)
-	t
-      (and (predicate (head set-for-all-reduction))
-	   (all (tail set-for-all-reduction)))))
-
-  (defun exists (X)
-    (declare (xargs :guard (setp X)))
-    (cond ((empty X) nil)
-	  ((predicate (head X)) t)
-	  (t (exists (tail X)))))
-
-  (defun find (X)
-    (declare (xargs :guard (setp X)))
-    (cond ((empty X) nil)
-	  ((predicate (head X)) (head X))
-	  (t (find (tail X)))))
-
-  (defun filter (X)
-    (declare (xargs :guard (setp X)))
-    (declare (xargs :verify-guards nil))
-    (cond ((empty X) (sfix X))
-	  ((predicate (head X))
-	   (insert (head X) (filter (tail X))))
-	  (t (filter (tail X)))))
-
-  ))
-
-; We then create "negative" versions of the above functions by performing a set
-; of substitutions on the constants.
-
-(defconst *negative-functions*
-  (INSTANCE::instance-defuns *positive-functions*
-     '(((predicate ?x)   (not (predicate ?x)))
-       ((all ?x)         (all<not> ?x))
-       ((exists ?x)      (exists<not> ?x))
-       ((find ?x)        (find<not> ?x))
-       ((filter ?x)      (filter<not> ?x))
-       ((all-list ?x)    (all-list<not> ?x))
-       ((exists-list ?x) (exists-list<not> ?x))
-       ((find-list ?x)   (find-list<not> ?x))
-       ((filter-list ?x) (filter-list<not> ?x)))))
-
-
-; And then we smash together the positive and negative functions to create a
-; single function list which can be instantiated later.
-
-(defconst *functions*
-  (append *positive-functions* *negative-functions*))
-
-
-; Now we create the instance-*functions* macro which will allow us to actually
-; derive an instance of all of the functions
-
-(INSTANCE::instance *functions*)
-
-
-; And we call the macro with no arguments, to introduce a verbatim copy of the
-; theory.  In other words, we introduce the generic theory itself here.
-
-(instance-*functions*)
-
-
-(defconst *positive-theorems* '(
-
-; List Theory Reasoning
-;
-; We begin with several theorems about the "list versions" of the above
-; functions.
-
-  (defthm all-list-type
-    (or (equal (all-list x) t)
-	(equal (all-list x) nil))
-    :rule-classes :type-prescription)
-
-  (defthm all-list-cdr
-    (implies (all-list x)
-	     (all-list (cdr x))))
-
-  (defthm all-list-endp
-    (implies (endp x)
-	     (all-list x)))
-
-  (defthm all-list-member
-    (implies (and (all-list x)
-		  (member a x))
-	     (predicate a)))
-
-  (defthm all-list-in-2
-    (implies (and (all-list x)
-		  (not (predicate a)))
-	     (not (member a x))))
-
-  (defthm all-list-cons
-    (equal (all-list (cons a x))
-	   (and (predicate a)
-		(all-list x))))
-
-  (defthm all-list-append
-    (equal (all-list (append x y))
-	   (and (all-list x)
-		(all-list y))))
-
-  (defthm all-list-nth
-    (implies (and (all-list x)
-		  (<= 0 n)
-		  (< n (len x)))
-	     (predicate (nth n x))))
-
-  (encapsulate nil
-
-    (local (defthm lemma1
-	     (implies (and (all-list acc)
-			   (all-list x))
-		      (all-list (revappend x acc)))))
-
-    (local (defthm lemma2
-	     (implies (not (all-list acc))
-		      (not (all-list (revappend x acc))))))
-
-    (local (defthm lemma3
-	     (implies (and (all-list acc)
-			   (not (all-list x)))
-		      (not (all-list (revappend x acc))))))
-
-    (defthm all-list-revappend
-      (equal (all-list (revappend x acc))
-	     (and (all-list x)
-		  (all-list acc))))
-  )
-
-  (defthm all-list-reverse
-    (equal (all-list (reverse x))
-	   (all-list x)))
-
-  (defthm exists-list-elimination
-    (equal (exists-list x)
-	   (not (all-list<not> x))))
-
-  (defthm filter-list-true-list
-    (true-listp (filter-list x))
-    :rule-classes :type-prescription)
-
-  (defthm filter-list-membership
-    (iff (member a (filter-list x))
-         (and (predicate a)
-              (member a x))))
-
-  (defthm filter-list-all-list
-    (all-list (filter-list x)))
-
-
-
-
-
-
-; Set Theory Reasoning
-;
-; Of course, really we are more interested in reasoning about sets than lists.
-; We write several theorems about our set functions.
-
-  (defthm all-type
-    (or (equal (all X) t)
-	(equal (all X) nil))
-    :rule-classes :type-prescription)
-
-  (defthm all-sfix
-    (equal (all (sfix X))
-	   (all X)))
-
-  ;; TODO: extend to forward chaining.
-
-  (defthm all-tail
-    (implies (all X)
-	     (all (tail X))))
-
-  (defthm all-empty
-    (implies (empty X)
-	     (all X)))
-
-  (defthm all-in
-    (implies (and (all X)
-		  (in a X))
-	     (predicate a)))
-
-  (defthm all-in-2
-    (implies (and (all X)
-		  (not (predicate a)))
-	     (not (in a X))))
-
-  (defthm all-insert
-    (equal (all (insert a X))
-	   (and (predicate a)
-		(all X)))
-    :hints(("Goal" :induct (insert a X))))
-
-  (defthm all-delete
-    (implies (all X)
-	     (all (delete a X))))
-
-  (defthm all-delete-2
-    (implies (predicate a)
-	     (equal (all (delete a X))
-		    (all X))))
-
-  (defthm all-union
-    (equal (all (union X Y))
-	   (and (all X)
-		(all Y))))
-
-  (defthm all-intersect-X
-    (implies (all X)
-	     (all (intersect X Y))))
-
-  (defthm all-intersect-Y
-    (implies (all X)
-	     (all (intersect Y X))))
-
-  (defthm all-difference
-    (implies (all X)
-	     (all (difference X Y))))
-
-  (defthm all-difference-2
-    (implies (all Y)
-	     (equal (all (difference X Y))
-		    (all X))))
-
-
-  (defthm exists-elimination
-    (equal (exists X)
-	   (not (all<not> X))))
-
-
-  (defthm find-sfix
-    (equal (find (sfix X))
-	   (find X)))
-
-  (defthm find-witness
-    (implies (not (all X))
-	     (and (in (find<not> X) X)
-		  (not (predicate (find<not> X)))))
-    :rule-classes :forward-chaining)
-
-
-  (defthm filter-set
-    (setp (filter X)))
-
-  (defthm filter-sfix
-    (equal (filter (sfix X))
-	   (filter X)))
-
-  (defthm filter-in
-    (equal (in a (filter X))
-	   (and (predicate a)
-		(in a X)))
-    :hints(("Goal" :induct (filter X))))
-
-  (defthm filter-subset
-    (subset (filter X) X))
-
-  (defthm filter-all
-    (all (filter X)))
-
-  (defthm filter-all-2
-    (implies (all X)
-	     (equal (filter X) (sfix X)))
-    :hints(("Goal" :in-theory (disable double-containment))))
-
-
-
-
-; In order to reason past a mergesort, we need to provide some theorems that
-; tie together our list and set theories.  We begin this here.
-
-  (defthm all-mergesort
-    (equal (all (mergesort X))
-	   (all-list X)))
-
-  (defthm all-list-applied-to-set
-    (implies (setp X)
-	     (equal (all-list X)
-		    (all X)))
-    :hints(("Goal" :in-theory (enable setp empty sfix head tail))))
-
-))
-
-
-
-; Notice that the positive functions and the negative functions are symmetric.
-; We now invert the above theorem to create the corresponding theorems for the
-; negative functions.
-
-(defconst *negative-theorems*
-  (INSTANCE::instance-rewrite *positive-theorems*
-
-    ;; we first replace calls to "positive" functions with calls to temporary
-    ;; symbols, which simply acts as placeholders.
-
-   '(((predicate ?x)   (predicate-temp ?x))
-     ((all ?x)         (all-temp ?x))
-     ((exists ?x)      (exists-temp ?x))
-     ((find ?x)        (find-temp ?x))
-     ((filter ?x)      (filter-temp ?x))
-     ((all-list ?x)    (all-list-temp ?x))
-     ((exists-list ?x) (exists-list-temp ?x))
-     ((find-list ?x)   (find-list-temp ?x))
-     ((filter-list ?x) (filter-list-temp ?x))
-
-     ;; now we replace calls to "negative" functions with calls to positive
-     ;; functions.
-
-     ((not (predicate ?x))  (predicate ?x))
-     ((all<not> ?x)         (all ?x))
-     ((exists<not> ?x)      (exists ?x))
-     ((find<not> ?x)        (find ?x))
-     ((filter<not> ?x)      (filter ?x))
-     ((all-list<not> ?x)    (all-list ?x))
-     ((exists-list<not> ?x) (exists-list ?x))
-     ((find-list<not> ?x)   (find-list ?x))
-     ((filter-list<not> ?x) (filter-list ?x))
-
-     ;; and finally we replace our temporary placeholder symbols with calls to
-     ;; the actual negative functions.
-
-     ((predicate-temp ?x)   (not (predicate ?x)))
-     ((all-temp ?x)         (all<not> ?x))
-     ((exists-temp ?x)      (exists<not> ?x))
-     ((find-temp ?x)        (find<not> ?x))
-     ((filter-temp ?x)      (filter<not> ?x))
-     ((all-list-temp ?x)    (all-list<not> ?x))
-     ((exists-list-temp ?x) (exists-list<not> ?x))
-     ((find-list-temp ?x)   (find-list<not> ?x))
-     ((filter-list-temp ?x) (filter-list<not> ?x))
-)))
-
-
-; We now smash together the positive and negative theorems to form a single,
-; complete theory.  Note that we have to rename all of the defthms in
-; *negative-theorems* so that their names will not collide with the theorems in
-; *theorems*.
-
-(defconst *theorems*
-  (append *positive-theorems*
-	  (INSTANCE::rename-defthms *negative-theorems* '-not)))
-
-
-; As with the functions, we create a new macro which will allow us to derive
-; new instances of our theorems.
-
-(INSTANCE::instance *theorems*)
-
-
-; And as before, we call the resulting macro with no arguments, which gives us
-; a verbatim copy of the positive and negative theorems.
-
-(instance-*theorems*)
-
-
-
-
-
-
-
-; We already have an all-by-membership theorem set up for sets.  But, we would
-; like to have a corresponding theorem to use with lists.  We create that here.
-
-(encapsulate
-  (((all-list-hyps) => *)
-   ((all-list-list) => *))
-
-  (local (defun all-list-hyps () nil))
-  (local (defun all-list-list () nil))
-
-  (defthmd list-membership-constraint
-    (implies (all-list-hyps)
-             (implies (member arbitrary-element (all-list-list))
-                      (predicate arbitrary-element)))))
-
-(encapsulate ()
-
-  (local (defthm witness-lemma
-	   (implies (not (all-list x))
-		    (and (member (find-list<not> x) x)
-			 (not (predicate (find-list<not> x)))))))
-
-  (defthmd all-list-by-membership
-    (implies (all-list-hyps)
-	     (all-list (all-list-list)))
-    :hints(("Goal"
-	    :use (:instance list-membership-constraint
-		  (arbitrary-element (find-list<not> (all-list-list)))))))
-)
-
-
-
-(defconst *final-theorems* '(
-
-  (defthm cardinality-filter
-    (equal (cardinality X)
-	   (+ (cardinality (filter X))
-	      (cardinality (filter<not> X))))
-    :rule-classes :linear)
-
-  (defthm all-subset
-    (implies (and (all Y)
-		  (subset X Y))
-	     (all X))
-    :hints(("Goal"
-	    :use (:functional-instance all-by-membership
-		  (all-hyps (lambda () (and (all Y)
-					    (subset X Y))))
-		  (all-set  (lambda () X))))))
-
-  (defthm all-subset-not
-    (implies (and (all<not> Y)
-		  (subset X Y))
-	     (all<not> X))
-    :hints(("Goal"
-	    :use (:functional-instance all-by-membership
-		  (all-hyps  (lambda () (and (all<not> Y)
-				 	     (subset X Y))))
-		  (all-set   (lambda () X))
-		  (predicate (lambda (x) (not (predicate x))))
-		  (all       (lambda (x) (all<not> x)))))))
-
-))
-
-(INSTANCE::instance *final-theorems*)
-(instance-*final-theorems*)
-
-(verify-guards filter)
-(verify-guards filter<not>)
-
-
-
-
-; -------------------------------------------------------------------
-;
-;                   Instancing Concrete Theories
-;
-; -------------------------------------------------------------------
-
-; Each concrete theory we instantiate will require the introduction of 16 new
-; functions and a wealth of theorems.  We don't want to overburden the user
-; with having to instantiate all of these and give them names, so we adopt a
-; naming convention where the predicate's name is used to generate the names of
-; the new functions.  Of course, we still have to generate the new names.
-
-(defun mksym (name sym)
-  (declare (xargs :mode :program))
-  (intern-in-package-of-symbol (string-upcase name) sym))
-
-(defun app (x y)
-  (declare (xargs :mode :program))
-  (string-append x y))
-
-(defun ?ify (args)
-  (declare (xargs :mode :program))
-  (if (endp args)
-      nil
-    (cons (mksym (app "?" (symbol-name (car args)))
-		 (car args))
-	  (?ify (cdr args)))))
-
-(defun standardize-to-package (symbol-name replacement term)
-  (declare (xargs :mode :program))
-  (if (atom term)
-      (if (and (symbolp term)
-	       (equal (symbol-name term) symbol-name))
-	  replacement
-	term)
-    (cons (standardize-to-package symbol-name replacement (car term))
-	  (standardize-to-package symbol-name replacement (cdr term)))))
-
-
-(defun quantify-simple-predicate (predicate in-package
-			          set-guard list-guard arg-guard)
-  (declare (xargs :guard (symbolp in-package)
-		  :mode :program))
-  (let* ((name          (car predicate))
-	 (args          (cons '?x (cddr predicate)))
-	 (wrap          (app "<" (app (symbol-name name) ">")))
-	 (not-wrap      (app "<" (app "not-" (app (symbol-name name) ">"))))
-
-	 ;; First we build up all the symbols that we will use.
-
-	 (all<p>             (mksym (app "all" wrap) in-package))
-	 (exists<p>          (mksym (app "exists" wrap) in-package))
-	 (find<p>            (mksym (app "find" wrap) in-package))
-	 (filter<p>          (mksym (app "filter" wrap) in-package))
-	 (all<not-p>         (mksym (app "all" not-wrap) in-package))
-	 (exists<not-p>      (mksym (app "exists" not-wrap) in-package))
-	 (find<not-p>        (mksym (app "find" not-wrap) in-package))
-	 (filter<not-p>      (mksym (app "filter" not-wrap) in-package))
-	 (all-list<p>        (mksym (app "all-list" wrap) in-package))
-	 (exists-list<p>     (mksym (app "exists-list" wrap) in-package))
-	 (find-list<p>       (mksym (app "find-list" wrap) in-package))
-	 (filter-list<p>     (mksym (app "filter-list" wrap) in-package))
-	 (all-list<not-p>    (mksym (app "all-list" not-wrap) in-package))
-	 (exists-list<not-p> (mksym (app "exists-list" not-wrap) in-package))
-	 (find-list<not-p>   (mksym (app "find-list" not-wrap) in-package))
-	 (filter-list<not-p> (mksym (app "filter-list" not-wrap) in-package))
-
-	 ;; And we create a substitution list, to instantiate the generic
-	 ;; theory/functions with their new, concrete values.
-
-	 (subs `(((predicate ?x)        (,name ,@args))
-		 ((all ?x)              (,all<p> ,@args))
-		 ((exists ?x)           (,exists<p> ,@args))
-		 ((find ?x)             (,find<p> ,@args))
-		 ((filter ?x)           (,filter<p> ,@args))
-		 ((all<not> ?x)         (,all<not-p> ,@args))
-		 ((exists<not> ?x)      (,exists<not-p> ,@args))
-		 ((find<not> ?x)        (,find<not-p> ,@args))
-		 ((filter<not> ?x)      (,filter<not-p> ,@args))
-		 ((all-list ?x)         (,all-list<p> ,@args))
-		 ((exists-list ?x)      (,exists-list<p> ,@args))
-		 ((find-list ?x)        (,find-list<p> ,@args))
-		 ((filter-list ?x)      (,filter-list<p> ,@args))
-		 ((all-list<not> ?x)    (,all-list<not-p> ,@args))
-		 ((exists-list<not> ?x) (,exists-list<not-p> ,@args))
-		 ((find-list<not> ?x)   (,find-list<not-p> ,@args))
-		 ((filter-list<not> ?x) (,filter-list<not-p> ,@args))))
-
-	 ;; We use this hack to support alternate guards.  We basically use our
-	 ;; rewriter to inject the extra guards into the function's existing
-	 ;; guards.
-
-	 (fn-subs
-	  (list* `((declare (xargs :guard (true-listp ?list)))
-		   (declare (xargs :guard (and (true-listp ?list)
-					       ,@list-guard
-					       ,@arg-guard))))
-		 `((declare (xargs :guard (setp ?set)))
-		   (declare (xargs :guard (and (setp ?set)
-					       ,@set-guard
-					       ,@arg-guard))))
-		 subs))
-
-
-	 ;; And we make some symbols for use in automating the
-	 ;; all-by-membership strategy with computed hints.
-
-	 (all-trigger<p>           (mksym (app "all-trigger" wrap) in-package))
-	 (all-trigger<not-p>       (mksym (app "all-trigger" not-wrap) in-package))
-	 (all-strategy<p>          (mksym (app "all-strategy" wrap) in-package))
-	 (all-strategy<not-p>      (mksym (app "all-strategy" not-wrap) in-package))
-	 (all-list-trigger<p>      (mksym (app "all-list-trigger" wrap) in-package))
-	 (all-list-trigger<not-p>  (mksym (app "all-list-trigger" not-wrap) in-package))
-	 (all-list-strategy<p>     (mksym (app "all-list-strategy" wrap) in-package))
-	 (all-list-strategy<not-p> (mksym (app "all-list-strategy" not-wrap) in-package))
-
-	 ;; We finally make a deftheory event with the following name, which
-	 ;; holds all of these theorems:
-
-	 (theory<p>         (mksym (app "theory" wrap) in-package))
-	 (suffix            (mksym wrap in-package))
-	 (thm-names         (append (INSTANCE::defthm-names *theorems*)
-				    (INSTANCE::defthm-names *final-theorems*)))
-	 (thm-name-map      (INSTANCE::create-new-names thm-names suffix))
-	 (theory<p>-defthms (sublis thm-name-map thm-names))
-
-	 )
-
-    `(encapsulate ()
-
-	;; It's now quite easy to instantiate all of our functions.
-
-	(instance-*functions*
-	 :subs ,fn-subs
-	 :suffix ,name)
-
-	;; And similarly we can instantiate all of the theorems.
-
-	(instance-*theorems*
-	 :subs ,subs
-	 :suffix ,(mksym wrap in-package))
-	 ;:extra-defs (empty))
-
-
-	;; Automating the computed hints is a pain in the ass.  We
-	;; first need triggers as aliases for all<p>, all<not-p>, etc.
-
-	(defund ,all-trigger<p> (,@args)
-          (declare (xargs :verify-guards nil))
-	  (,all<p> ,@args))
-
-	(defund ,all-trigger<not-p> (,@args)
-          (declare (xargs :verify-guards nil))
-	  (,all<not-p> ,@args))
-
-	(defund ,all-list-trigger<p> (,@args)
-	  (declare (xargs :verify-guards nil))
-	  (,all-list<p> ,@args))
-
-	(defund ,all-list-trigger<not-p> (,@args)
-	  (declare (xargs :verify-guards nil))
-	  (,all-list<not-p> ,@args))
-
-
-	;; Now we need "tagging theorems" that instruct the rewriter
-	;; to tag the appropriate terms.
-
-	(defthm ,all-strategy<p>
-	  (implies (and (syntaxp (rewriting-goal-lit mfc state))
-			(syntaxp (rewriting-conc-lit (list ',all<p> ,@args)
-				  mfc state)))
-		   (equal (,all<p> ,@args)
-			  (,all-trigger<p> ,@args)))
-	  :hints(("Goal"
-		  :in-theory (union-theories
-			      (theory 'minimal-theory)
-			      '((:definition ,all-trigger<p>))))))
-
-	(defthm ,all-strategy<not-p>
-	  (implies (and (syntaxp (rewriting-goal-lit mfc state))
-			(syntaxp (rewriting-conc-lit (list ',all<not-p> ,@args)
-				  mfc state)))
-		   (equal (,all<not-p> ,@args)
-			  (,all-trigger<not-p> ,@args)))
-	  :hints(("Goal"
-		  :in-theory (union-theories
-			      (theory 'minimal-theory)
-			      '((:definition ,all-trigger<not-p>))))))
-
-	(defthm ,all-list-strategy<p>
-	  (implies (and (syntaxp (rewriting-goal-lit mfc state))
-			(syntaxp (rewriting-conc-lit (list ',all-list<p> ,@args)
-				  mfc state)))
-		   (equal (,all-list<p> ,@args)
-			  (,all-list-trigger<p> ,@args)))
-	  :hints(("Goal"
-		  :in-theory (union-theories
-			      (theory 'minimal-theory)
-			      '((:definition ,all-list-trigger<p>))))))
-
-	(defthm ,all-list-strategy<not-p>
-	  (implies (and (syntaxp (rewriting-goal-lit mfc state))
-			(syntaxp (rewriting-conc-lit (list ',all-list<not-p> ,@args)
-				  mfc state)))
-		   (equal (,all-list<not-p> ,@args)
-			  (,all-list-trigger<not-p> ,@args)))
-	  :hints(("Goal"
-		  :in-theory (union-theories
-			      (theory 'minimal-theory)
-			      '((:definition ,all-list-trigger<not-p>))))))
-
-
-	;; And then we call upon our computed hints routines to generate a
-	;; computed hint for us to use, and add it to the default hints.
-
-	(COMPUTED-HINTS::automate-instantiation
-	  :new-hint-name ,(mksym (app "all-by-membership-hint" wrap) in-package)
-	  :generic-theorem all-by-membership
-	  :generic-predicate predicate
-	  :generic-hyps all-hyps
-	  :generic-collection all-set
-	  :generic-collection-predicate all
-	  :actual-collection-predicate ,all<p>
-	  :actual-trigger ,all-trigger<p>
-	  :predicate-rewrite (((predicate ,@(?ify args))
-			       (,name ,@(?ify args))))
-	  :tagging-theorem ,all-strategy<p>
-	)
-
-	(COMPUTED-HINTS::automate-instantiation
-	  :new-hint-name ,(mksym (app "all-by-membership-hint" not-wrap) in-package)
-	  :generic-theorem all-by-membership
-	  :generic-predicate predicate
-	  :generic-hyps all-hyps
-	  :generic-collection all-set
-	  :generic-collection-predicate all
-	  :actual-collection-predicate ,all<not-p>
-	  :actual-trigger ,all-trigger<not-p>
-	  :predicate-rewrite (((predicate ,@(?ify args))
-			       (not (,name ,@(?ify args)))))
-	  :tagging-theorem ,all-strategy<not-p>
-	)
-
-	(COMPUTED-HINTS::automate-instantiation
-	  :new-hint-name ,(mksym (app "all-list-by-membership-hint" wrap) in-package)
-	  :generic-theorem all-list-by-membership
-	  :generic-predicate predicate
-	  :generic-hyps all-list-hyps
-	  :generic-collection all-list-list
-	  :generic-collection-predicate all-list
-	  :actual-collection-predicate ,all-list<p>
-	  :actual-trigger ,all-list-trigger<p>
-	  :predicate-rewrite (((predicate ,@(?ify args))
-			       (,name ,@(?ify args))))
-	  :tagging-theorem ,all-list-strategy<p>
-	)
-
-	(COMPUTED-HINTS::automate-instantiation
-	  :new-hint-name ,(mksym (app "all-list-by-membership-hint" not-wrap) in-package)
-	  :generic-theorem all-list-by-membership
-	  :generic-predicate predicate
-	  :generic-hyps all-list-hyps
-	  :generic-collection all-list-list
-	  :generic-collection-predicate all-list
-	  :actual-collection-predicate ,all-list<not-p>
-	  :actual-trigger ,all-list-trigger<not-p>
-	  :predicate-rewrite (((predicate ,@(?ify args))
-			       (not (,name ,@(?ify args)))))
-	  :tagging-theorem ,all-list-strategy<not-p>
-	)
-
-
-	(instance-*final-theorems*
-	 :subs ,subs
-	 :suffix ,(mksym wrap in-package))
-	 ;:extra-defs (empty))
-
-
-	(verify-guards ,filter<p>)
-	(verify-guards ,filter<not-p>)
-
-	;; In the end, we want to create a deftheory event so that you can
-	;; easily turn off the reasoning about these functions when you don't
-	;; need it.  We do that with the following event:
-
-	(deftheory ,theory<p> '(,@theory<p>-defthms
-				,all<p>              ,all-list<p>
-				,exists<p>           ,exists-list<p>
-				,find<p>             ,find-list<p>
-				,filter<p>           ,filter-list<p>
-				,all<not-p>          ,all-list<not-p>
-				,exists<not-p>       ,exists-list<not-p>
-				,find<not-p>         ,find-list<not-p>
-				,filter<not-p>       ,filter-list<not-p>
-				,all-trigger<p>      ,all-list-trigger<p>
-				,all-trigger<not-p>  ,all-list-trigger<not-p>
-				,all-strategy<p>     ,all-list-strategy<p>
-				,all-strategy<not-p> ,all-list-strategy<not-p>
-				))
-	)))
-
-
-(defmacro quantify-predicate (predicate
-			      &key in-package-of
-			           set-guard list-guard arg-guard)
-  (quantify-simple-predicate predicate
-			     (if in-package-of in-package-of 'in)
-			     (standardize-to-package "?SET" '?set set-guard)
-			     (standardize-to-package "?LIST" '?list list-guard)
-			     arg-guard))
-
-
-
-; We don't want to keep all these generic theorems around, because many of them
-; are rewrite rules with targets that are actual functions.  For example, if a
-; rule concludes with (in a X), we don't want to start backchaining on it if
-; its hypothese include generic rules.
-
-(deftheory generic-quantification-theory
-  `(,@(INSTANCE::defthm-names *theorems*)
-    ,@(INSTANCE::defthm-names *final-theorems*)
-    all exists find filter
-    all-list exists-list find-list filter-list
-    all<not> exists<not> find<not> filter<not>
-    all-list<not> exists-list<not> find-list<not> filter-list<not>))
-
-(in-theory (disable generic-quantification-theory))
-
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/quantify" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/sets.defpkg acl2-6.3/books/finite-set-theory/osets/sets.defpkg
--- acl2-6.2/books/finite-set-theory/osets/sets.defpkg	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/sets.defpkg	1970-01-01 00:00:00.000000000 +0000
@@ -1,94 +0,0 @@
-; -*- mode: lisp -*-
-
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; sets.defpkg
-;
-; This just has the defpackage events for the set theory library.
-
-(in-package "ACL2")
-
-(ld "xdoc/package.lsp" :dir :system)
-
-(defpkg "INSTANCE"
-  (union-eq *acl2-exports*
-            *common-lisp-symbols-from-main-lisp-package*))
-
-
-(defpkg "COMPUTED-HINTS"
-  (union-eq '(mfc-ancestors
-	      mfc-clause
-	      string-for-tilde-@-clause-id-phrase
-	      INSTANCE::instance-rewrite)
-            *acl2-exports*
-            *common-lisp-symbols-from-main-lisp-package*))
-
-(defpkg "SETS"
-  (set-difference-equal
-   (union-eq '(defsection
-               defxdoc
-               definline
-               definlined
-               lexorder
-               lnfix
-               <<
-               <<-irreflexive
-               <<-transitive
-               <<-asymmetric
-               <<-trichotomy
-               <<-implies-lexorder
-               fast-<<
-               fast-lexorder
-               COMPUTED-HINTS::rewriting-goal-lit
-               COMPUTED-HINTS::rewriting-conc-lit
-               def-ruleset
-               def-ruleset!
-               add-to-ruleset
-               ;; To make Sets::Osets print as just Osets in the XDOC index
-               osets)
-             *acl2-exports*
-             *common-lisp-symbols-from-main-lisp-package*)
-
-; [Changed by Matt K. to handle changes to member, assoc, etc. after ACL2 4.2
-;  (intersectp was added to *acl2-exports*).]
-
-   '(union delete find map intersectp
-           enable disable e/d)))
-
-#!SETS
-(defconst *sets-exports*
-  ;; This just contains the user-level set functions, and a couple of theroems
-  ;; that frequently need to be enabled/disabled.
-  '(<<
-    setp
-    empty
-    sfix
-    head
-    tail
-    insert
-    in
-    subset
-    delete
-    union
-    intersect
-    ;; intersectp -- we leave this out because of the existing ACL2 function
-    ;; called intersectp.
-    difference
-    cardinality
-    mergesort
-    ;; A couple of theorems that frequently need to be enabled/disabled.
-    double-containment
-    pick-a-point-subset-strategy
-    ))
\ No newline at end of file
diff -Nru acl2-6.2/books/finite-set-theory/osets/sets.lisp acl2-6.3/books/finite-set-theory/osets/sets.lisp
--- acl2-6.2/books/finite-set-theory/osets/sets.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/sets.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,1154 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; sets.lisp
-;
-; This is the top level file, which you should include to use the ordered set
-; theory library.  Note that it does NOT include:
-;
-;   - The quantification extension for quantifying predicates over sets (i.e.,
-;     for defining "typed" sets); see quantify.lisp instead, or
-;
-;   - The map extension for mapping/projecting a function across a set; see
-;     map.lisp instead.
-;
-; The definitions in this file are redundant from the local include books.
-; This approach has several advantages.
-;
-;  - it gives a better event order than simply including the books one by one
-;
-;  - this file is also faster to include than all of the local books below, and
-;    allows the "ugliness" of auxilliary lemmas to be hidden away
-;
-;  - it makes clear that these theorems are public, and entirely prevents the
-;    use of "internal" lemmas and theorems.
-
-(in-package "SETS")
-(set-verify-guards-eagerness 2)
-
-; We now directly use the total order from misc/total-order.
-(include-book "misc/total-order" :dir :system)
-(include-book "tools/rulesets" :dir :system)
-(include-book "std/lists/list-defuns" :dir :system)
-
-; We need some program-mode definitions which are used in order to automate the
-; pick-a-point strategies.
-(include-book "computed-hints")
-
-(local
- ;; xdoc hack part 1: throw away all current xdoc
- (table xdoc::xdoc 'xdoc::doc nil))
-
-(local (include-book "primitives"))
-(local (include-book "membership"))
-(local (include-book "outer"))
-(local (include-book "sort"))
-(local (include-book "under-set-equiv"))
-
-(make-event
- ;; xdoc hack part 2: take all the docs we got from the local includes and
- ;; stick them onto the proper doc
- (let ((slurped-docs (xdoc::get-xdoc-table (w state))))
-   (acl2::value `(table xdoc::xdoc 'xdoc::doc
-                        (append ',slurped-docs (xdoc::get-xdoc-table acl2::world))))))
-
-(defxdoc osets
-  :short "ACL2 Ordered Sets Library."
-
-  :long "<p>This is a finite set theory implementation for ACL2 based on fully
-ordered lists.  Some nice features of this approach are that set equality is
-just @(see equal), and set operations like @(see union), @(see intersect), and
-so forth have O(n) implementations.</p>
-
-<p>Osets mostly hides the fact that sets are represented as ordered lists.  You
-should not have to reason about the set order unless you are trying to exploit
-it to make some function faster.  Instead, we generally try to reason about
-sets with a membership-based approach, via @(see in) and @(see subset).</p>
-
-<p>The library offers some automation for pick-a-point style reasoning, see for
-instance @(see all-by-membership), @(see pick-a-point-subset-strategy), and
-@(see double-containment).</p>
-
-<p>You can load the library with:</p>
-@({
- (include-book \"finite-set-theory/osets/sets\" :dir :system)
-})
-
-<p>Besides this @(see xdoc::xdoc) documentation, you may be interested in the
-2004 ACL2 workshop paper, <a
-href='http://www.cs.utexas.edu/users/jared/publications/2004-acl2-osets/set-theory.pdf'>Finite
-Set Theory based on Fully Ordered Lists</a>, and see also the <a
-href='http://www.cs.utexas.edu/users/jared/osets/Slides/2004-02-seminar-slides.pdf'>slides</a>
-from the accompanying talk.</p>")
-
-; We begin with the definitions of the set theory functions and a few trivial
-; type prescriptions.
-
-(defund setp (X)
-  (declare (xargs :guard t))
-  (if (atom X)
-      (null X)
-    (or (null (cdr X))
-        (and (consp (cdr X))
-             (fast-<< (car X) (cadr X))
-             (setp (cdr X))))))
-
-(defthm setp-type
-  (or (equal (setp X) t)
-      (equal (setp X) nil))
-  :rule-classes :type-prescription)
-
-(defund empty (X)
-  (declare (xargs :guard (setp X)))
-  (mbe :logic (or (null X)
-                  (not (setp X)))
-       :exec  (null X)))
-
-(defthm empty-type
-  (or (equal (empty X) t)
-      (equal (empty X) nil))
-  :rule-classes :type-prescription)
-
-(defund sfix (X)
-  (declare (xargs :guard (setp X)))
-  (mbe :logic (if (empty X) nil X)
-       :exec  X))
-
-(defund head (X)
-  (declare (xargs :guard (and (setp X)
-                              (not (empty X)))))
-  (mbe :logic (car (sfix X))
-       :exec  (car X)))
-
-(defund tail (X)
-  (declare (xargs :guard (and (setp X)
-                              (not (empty X)))))
-  (mbe :logic (cdr (sfix X))
-       :exec  (cdr X)))
-
-(defund insert (a X)
-  (declare (xargs :guard (setp X)))
-  (mbe :logic (cond ((empty X) (list a))
-                    ((equal (head X) a) X)
-                    ((<< a (head X)) (cons a X))
-                    (t (cons (head X) (insert a (tail X)))))
-       :exec
-       (cond ((null X) (cons a nil))
-             ((equal (car X) a) X)
-             ((fast-lexorder a (car X)) (cons a X))
-             ((null (cdr X)) (cons (car X) (cons a nil)))
-             ((equal (cadr x) a) X)
-             ((fast-lexorder a (cadr X)) (cons (car X) (cons a (cdr X))))
-             (t (cons (car X) (cons (cadr X) (insert a (cddr X))))))))
-
-(defun in (a X)
-  (declare (xargs :guard (setp X)))
-  (mbe :logic
-       (and (not (empty X))
-            (or (equal a (head X))
-                (in a (tail X))))
-       :exec
-       (and x
-            (or (equal a (car x))
-                (and (cdr x)
-                     (or (equal a (cadr x))
-                         (in a (cddr x))))))))
-
-(defthm in-type
-  (or (equal (in a X) t)
-      (equal (in a X) nil))
-  :rule-classes :type-prescription)
-
-(defund fast-subset (X Y)
-  (declare (xargs :guard (and (setp X) (setp Y))))
-  (mbe :logic
-       (cond ((empty X) t)
-             ((empty Y) nil)
-             ((<< (head X) (head Y)) nil)
-             ((equal (head X) (head Y)) (fast-subset (tail X) (tail Y)))
-             (t (fast-subset X (tail Y))))
-       :exec
-       (cond ((null X) t)
-             ((null Y) nil)
-             ((fast-lexorder (car X) (car Y))
-              (and (equal (car X) (car Y))
-                   (fast-subset (cdr X) (cdr Y))))
-             (t
-              (fast-subset X (cdr Y))))))
-
-(defun subset (X Y)
-  (declare (xargs :guard (and (setp X) (setp Y))))
-  (mbe :logic (if (empty X)
-		  t
-		(and (in (head X) Y)
-		     (subset (tail X) Y)))
-       :exec (fast-subset X Y)))
-
-(defthm subset-type
-  (or (equal (subset X Y) t)
-      (equal (subset X Y) nil))
-  :rule-classes :type-prescription)
-
-(defund fast-measure (X Y)
-  (+ (acl2-count X) (acl2-count Y)))
-
-(defun fast-union (x y acc)
-  (declare (xargs :measure (fast-measure X Y)
-                  :guard (and (setp x)
-                              (setp y)
-                              (true-listp acc))))
-  (cond ((endp x) (revappend acc y))
-        ((endp y) (revappend acc x))
-        ((equal (car x) (car y))
-         (fast-union (cdr x) (cdr y) (cons (car x) acc)))
-        ((mbe :logic (<< (car x) (car y))
-              :exec (fast-lexorder (car x) (car y)))
-         (fast-union (cdr x) y (cons (car x) acc)))
-        (t
-         (fast-union x (cdr y) (cons (car y) acc)))))
-
-(defun fast-intersect (X Y acc)
-  (declare (xargs :measure (fast-measure X Y)
-                  :guard (and (setp X)
-                              (setp Y)
-                              (true-listp acc))))
-  (cond ((endp X) (revappend acc nil))
-        ((endp Y) (revappend acc nil))
-        ((equal (car X) (car Y))
-         (fast-intersect (cdr X) (cdr Y) (cons (car X) acc)))
-        ((mbe :logic (<< (car X) (car Y))
-              :exec (fast-lexorder (car X) (car Y)))
-         (fast-intersect (cdr X) Y acc))
-        (t
-         (fast-intersect X (cdr Y) acc))))
-
-(defun fast-intersectp (X Y)
-  (declare (xargs :guard (and (setp X)
-                              (setp Y))
-                  :measure (fast-measure X Y)))
-  (cond ((endp X) nil)
-        ((endp Y) nil)
-        ((equal (car X) (car Y))
-         t)
-        ((mbe :logic (<< (car X) (car y))
-              :exec (fast-lexorder (car X) (car Y)))
-         (fast-intersectp (cdr X) Y))
-        (t
-         (fast-intersectp X (cdr Y)))))
-
-(defun fast-difference (X Y acc)
-  (declare (xargs :measure (fast-measure X Y)
-                  :guard (and (setp X)
-                              (setp Y)
-                              (true-listp acc))))
-  (cond ((endp X) (revappend acc nil))
-        ((endp Y) (revappend acc X))
-        ((equal (car X) (car Y))
-         (fast-difference (cdr X) (cdr Y) acc))
-        ((mbe :logic (<< (car X) (car Y))
-              :exec (fast-lexorder (car X) (car Y)))
-         (fast-difference (cdr X) Y (cons (car X) acc)))
-        (t
-         (fast-difference X (cdr Y) acc))))
-
-(defun delete (a X)
-  (declare (xargs :guard (setp X)))
-  (mbe :logic
-       (cond ((empty X) nil)
-             ((equal a (head X)) (tail X))
-             (t (insert (head X) (delete a (tail X)))))
-       :exec
-       (cond ((endp X) nil)
-             ((equal a (car X)) (cdr X))
-             (t (insert (car X) (delete a (cdr X)))))))
-
-(defun union (X Y)
-  (declare (xargs :guard (and (setp X) (setp Y))))
-  (mbe :logic (if (empty X)
-                  (sfix Y)
-                (insert (head X) (union (tail X) Y)))
-       :exec  (fast-union X Y nil)))
-
-(defun intersect (X Y)
-  (declare (xargs :guard (and (setp X) (setp Y))))
-  (mbe :logic (cond ((empty X) (sfix X))
-                    ((in (head X) Y)
-                     (insert (head X) (intersect (tail X) Y)))
-                    (t (intersect (tail X) Y)))
-       :exec (fast-intersect X Y nil)))
-
-(defun intersectp (X Y)
-  (declare (xargs :guard (and (setp X) (setp Y))))
-  (mbe :logic (not (empty (intersect X Y)))
-       :exec (fast-intersectp X Y)))
-
-(defun difference (X Y)
-  (declare (xargs :guard (and (setp X) (setp Y))))
-  (mbe :logic (cond ((empty X) (sfix X))
-                    ((in (head X) Y) (difference (tail X) Y))
-                    (t (insert (head X) (difference (tail X) Y))))
-       :exec (fast-difference X Y nil)))
-
-(defun cardinality (X)
-  (declare (xargs :guard (setp X)))
-  (mbe :logic (if (empty X)
-                  0
-                (1+ (cardinality (tail X))))
-       :exec  (length (the list X))))
-
-(defund halve-list-aux (mid x acc)
-  (declare (xargs :guard (<= (len x) (len mid))))
-  (if (or (atom x)
-          (atom (cdr x)))
-      (mv acc mid)
-    (halve-list-aux (cdr mid)
-                    (cdr (cdr x))
-                    (cons (car mid) acc))))
-
-(defund halve-list (x)
-  (declare (xargs :guard t))
-  (halve-list-aux x x nil))
-
-(defun mergesort-exec (x)
-  (declare (xargs :guard t
-                  :measure (len x)))
-  (cond ((atom x) nil)
-        ((atom (cdr x))
-         (mbe :logic (insert (car x) nil)
-              :exec (list (car x))))
-        (t (mv-let (part1 part2)
-                   (halve-list x)
-                   (fast-union (mergesort-exec part1)
-                               (mergesort-exec part2)
-                               nil)))))
-
-(defun mergesort (x)
-  (declare (xargs :guard t))
-  (mbe :logic (if (endp x)
-		  nil
-		(insert (car x)
-			(mergesort (cdr x))))
-       :exec (mergesort-exec x)))
-
-
-
-; "High Powered" Strategies
-;
-;   We put these at the beginning of the file so that they are tried
-;   as a last resort when simple methods have failed.
-
-(encapsulate
- (((predicate *) => *))
-  (local (defun predicate (x) x)))
-
-(defun all (set-for-all-reduction)
-  (declare (xargs :guard (setp set-for-all-reduction)))
-  (if (empty set-for-all-reduction)
-      t
-    (and (predicate (head set-for-all-reduction))
-	 (all (tail set-for-all-reduction)))))
-
-(encapsulate
- (((all-hyps) => *)
-  ((all-set) => *))
-
- (local (defun all-hyps () nil))
- (local (defun all-set () nil))
-
- (defthmd membership-constraint
-   (implies (all-hyps)
-	    (implies (in arbitrary-element (all-set))
-		     (predicate arbitrary-element)))))
-
-(defthmd all-by-membership
-  (implies (all-hyps)
-	   (all (all-set))))
-
-(defund subset-trigger (X Y)
-  (declare (xargs :guard (and (setp X) (setp Y))))
-  (subset X Y))
-
-(defthm pick-a-point-subset-strategy
-  (implies (and (syntaxp (rewriting-goal-lit mfc state))
-		(syntaxp (rewriting-conc-lit `(subset ,X ,Y) mfc state)))
-	   (equal (subset X Y)
-		  (subset-trigger X Y))))
-
-(COMPUTED-HINTS::automate-instantiation
-  :new-hint-name pick-a-point-subset-hint
-  :generic-theorem all-by-membership
-  :generic-predicate predicate
-  :generic-hyps all-hyps
-  :generic-collection all-set
-  :generic-collection-predicate all
-  :actual-collection-predicate subset
-  :actual-trigger subset-trigger
-  :predicate-rewrite (((predicate ?x ?y) (in ?x ?y)))
-  :tagging-theorem pick-a-point-subset-strategy)
-
-(defthm double-containment
-  (implies (and (setp X)
-                (setp Y))
-           (equal (equal X Y)
-                  (and (subset X Y)
-                       (subset Y X))))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-
-
-; -------------------------------------------------------------------
-; Primitive Level Theorems
-
-(defthm sets-are-true-lists
-  (implies (setp X)
-	   (true-listp X))
-  :rule-classes ((:rewrite) (:compound-recognizer)))
-
-(defthm tail-count
-  (implies (not (empty X))
-           (< (acl2-count (tail X)) (acl2-count X)))
-  :rule-classes ((:rewrite) (:linear)))
-
-(defthm head-count
-  (implies (not (empty X))
-           (< (acl2-count (head X)) (acl2-count X)))
-  :rule-classes ((:rewrite) (:linear)))
-
-(defthm tail-count-built-in
-  (implies (not (empty X))
-           (o< (acl2-count (tail X)) (acl2-count X)))
-  :rule-classes :built-in-clause)
-
-(defthm head-count-built-in
-  (implies (not (empty X))
-           (o< (acl2-count (head X)) (acl2-count X)))
-  :rule-classes :built-in-clause)
-
-(defthm insert-insert
-  (equal (insert a (insert b X))
-         (insert b (insert a X)))
-  :rule-classes ((:rewrite :loop-stopper ((a b)))))
-
-(defthm sfix-produces-set
-  (setp (sfix X)))
-
-(defthm tail-produces-set
-  (setp (tail X)))
-
-(defthm insert-produces-set
-  (setp (insert a X)))
-
-(defthm insert-never-empty
-  (not (empty (insert a X))))
-
-(defthm nonempty-means-set
-  (implies (not (empty X))
-           (setp X)))
-
-(defthm sfix-set-identity
-  (implies (setp X)
-           (equal (sfix X)
-                  X)))
-
-(defthm empty-sfix-cancel
-  (equal (empty (sfix X))
-         (empty X)))
-
-(defthm head-sfix-cancel
-  (equal (head (sfix X))
-         (head X)))
-
-(defthm tail-sfix-cancel
-  (equal (tail (sfix X))
-         (tail X)))
-
-(defthm insert-head
-  (implies (not (empty X))
-           (equal (insert (head X) X)
-                  X)))
-
-(defthm insert-head-tail
-  (implies (not (empty X))
-           (equal (insert (head X) (tail X))
-                  X)))
-
-(defthm repeated-insert
-  (equal (insert a (insert a X))
-         (insert a X)))
-
-(defthm insert-sfix-cancel
-  (equal (insert a (sfix X))
-         (insert a X)))
-
-(defthm head-when-empty
-  (implies (empty X)
-           (equal (head X)
-                  nil)))
-
-(defthm tail-when-empty
-  (implies (empty X)
-           (equal (tail X)
-                  nil)))
-
-(defthm insert-when-empty
-  (implies (and (syntaxp (not (equal X ''nil)))
-                (empty X))
-           (equal (insert a X)
-                  (insert a nil))))
-
-(defthm head-of-insert-a-nil
-  (equal (head (insert a nil))
-         a))
-
-(defthm tail-of-insert-a-nil
-  (equal (tail (insert a nil))
-         nil))
-
-(defthm sfix-when-empty
-  (implies (empty X)
-           (equal (sfix X)
-                  nil)))
-
-
-; -------------------------------------------------------------------
-; Membership Level Theorems
-
-(defthm subset-membership-tail
-  (implies (and (subset X Y)
-                (in a (tail X)))
-           (in a (tail Y))))
-
-(defthm subset-membership-tail-2
-  (implies (and (subset X Y)
-                (not (in a (tail Y))))
-           (not (in a (tail X)))))
-
-(defthm not-in-self
-  (not (in x x)))
-
-(defthm in-sfix-cancel
-  (equal (in a (sfix X))
-         (in a X)))
-
-(defthm never-in-empty
-  (implies (empty X)
-           (not (in a X))))
-
-(defthm in-set
-  (implies (in a X)
-           (setp X)))
-
-(defthm in-tail
-  (implies (in a (tail X))
-           (in a X)))
-
-(defthm in-tail-or-head
-  (implies (and (in a X)
-                (not (in a (tail X))))
-           (equal (head X)
-                  a)))
-
-(defthm in-head
-  (equal (in (head X) X)
-         (not (empty X))))
-
-(defthm head-unique
-  (not (in (head X) (tail X))))
-
-(defthm insert-identity
-  (implies (in a X)
-           (equal (insert a X)
-                  X)))
-
-(defthm in-insert
-  (equal (in a (insert b X))
-         (or (in a X)
-             (equal a b))))
-
-(defthm subset-transitive
-  (and (implies (and (subset X Y)
-                     (subset Y Z))
-                (subset X Z))
-       (implies (and (subset Y Z)
-                     (subset X Y))
-                (subset X Z))))
-
-(defthm subset-insert-X
-  (equal (subset (insert a X) Y)
-         (and (subset X Y)
-              (in a Y))))
-
-(defthm subset-sfix-cancel-X
-  (equal (subset (sfix X) Y)
-         (subset X Y)))
-
-(defthm subset-sfix-cancel-Y
-  (equal (subset X (sfix Y))
-         (subset X Y)))
-
-(defthm subset-in
-  (and (implies (and (subset X Y)
-                     (in a X))
-                (in a Y))
-       (implies (and (in a X)
-                     (subset X Y))
-                (in a Y))))
-
-(defthm subset-in-2
-  (and (implies (and (subset X Y)
-                     (not (in a Y)))
-                (not (in a X)))
-       (implies (and (not (in a Y))
-                     (subset X Y))
-                (not (in a X)))))
-
-(defthm empty-subset
-  (implies (empty X)
-           (subset X Y)))
-
-(defthm empty-subset-2
-  (implies (empty Y)
-	   (equal (subset X Y)
-                  (empty X))))
-
-(defthm subset-reflexive
-  (subset X X))
-
-(defthm subset-insert
-  (subset X (insert a X)))
-
-(defthm subset-tail
-  (subset (tail X) X)
-  :rule-classes ((:rewrite)
-		 (:forward-chaining :trigger-terms ((tail x)))))
-
-
-
-; -------------------------------------------------------------------
-; Weakly Inducting over Insertions
-
-(defthm weak-insert-induction-helper-1
-  (implies (and (not (in a X))
-                (not (equal (head (insert a X)) a)))
-           (equal (head (insert a X)) (head X))))
-
-(defthm weak-insert-induction-helper-2
-  (implies (and (not (in a X))
-                (not (equal (head (insert a X)) a)))
-           (equal (tail (insert a X)) (insert a (tail X)))))
-
-(defthm weak-insert-induction-helper-3
-  (implies (and (not (in a X))
-                (equal (head (insert a X)) a))
-           (equal (tail (insert a X)) (sfix X))))
-
-(defun weak-insert-induction (a X)
-  (declare (xargs :guard (setp X)))
-  (cond ((empty X) nil)
-        ((in a X) nil)
-        ((equal (head (insert a X)) a) nil)
-        (t (list (weak-insert-induction a (tail X))))))
-
-(defthm use-weak-insert-induction t
-  :rule-classes ((:induction
-                  :pattern (insert a X)
-                  :scheme (weak-insert-induction a X))))
-
-
-
-
-; -------------------------------------------------------------------
-; Outer Level Theorems
-
-(defthm delete-delete
-  (equal (delete a (delete b X))
-         (delete b (delete a X)))
-  :rule-classes ((:rewrite :loop-stopper ((a b)))))
-
-(defthm delete-set
-  (setp (delete a X)))
-
-(defthm delete-preserves-empty
-  (implies (empty X)
-           (empty (delete a X))))
-
-(defthm delete-in
-  (equal (in a (delete b X))
-         (and (in a X)
-              (not (equal a b)))))
-
-(defthm delete-sfix-cancel
-  (equal (delete a (sfix X))
-         (delete a X)))
-
-(defthm delete-nonmember-cancel
-  (implies (not (in a X))
-           (equal (delete a X) (sfix X))))
-
-(defthm repeated-delete
-  (equal (delete a (delete a X))
-         (delete a X)))
-
-(defthm delete-insert-cancel
-  (equal (delete a (insert a X))
-         (delete a X)))
-
-(defthm insert-delete-cancel
-  (equal (insert a (delete a X))
-         (insert a X)))
-
-(defthm subset-delete
-  (subset (delete a X) X))
-
-
-
-(defthm union-symmetric
-  (equal (union X Y) (union Y X))
-  :rule-classes ((:rewrite :loop-stopper ((X Y)))))
-
-(defthm union-commutative
-  (equal (union X (union Y Z))
-         (union Y (union X Z)))
-  :rule-classes ((:rewrite :loop-stopper ((X Y)))))
-
-(defthm union-insert-X
-  (equal (union (insert a X) Y)
-         (insert a (union X Y))))
-
-(defthm union-insert-Y
-  (equal (union X (insert a Y))
-         (insert a (union X Y))))
-
-(defthm union-delete-X
-  (equal (union (delete a X) Y)
-         (if (in a Y)
-             (union X Y)
-           (delete a (union X Y)))))
-
-(defthm union-delete-Y
-  (equal (union X (delete a Y))
-         (if (in a X)
-             (union X Y)
-           (delete a (union X Y)))))
-
-(defthm union-set
-  (setp (union X Y)))
-
-(defthm union-sfix-cancel-X
-  (equal (union (sfix X) Y) (union X Y)))
-
-(defthm union-sfix-cancel-Y
-  (equal (union X (sfix Y)) (union X Y)))
-
-(defthm union-empty-X
-  (implies (empty X)
-           (equal (union X Y) (sfix Y))))
-
-(defthm union-empty-Y
-  (implies (empty Y)
-           (equal (union X Y) (sfix X))))
-
-(defthm union-empty
-  (equal (empty (union X Y))
-         (and (empty X) (empty Y))))
-
-(defthm union-in
-  (equal (in a (union X Y))
-         (or (in a X) (in a Y))))
-
-(defthm union-subset-X
-  (subset X (union X Y)))
-
-(defthm union-subset-Y
-  (subset Y (union X Y)))
-
-(defthm union-with-subset-left
-  (implies (subset X Y)
-           (equal (union X Y)
-                  (sfix Y)))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-(defthm union-with-subset-right
-  (implies (subset X Y)
-           (equal (union Y X)
-                  (sfix Y)))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-(defthm union-self
-  (equal (union X X) (sfix X)))
-
-(defthm union-associative
-  (equal (union (union X Y) Z)
-         (union X (union Y Z))))
-
-(defthm union-outer-cancel
-  (equal (union X (union X Z))
-         (union X Z)))
-
-
-
-(defthm intersect-symmetric
-  (equal (intersect X Y) (intersect Y X))
-  :rule-classes ((:rewrite :loop-stopper ((X Y)))))
-
-(defthm intersect-insert-X
-  (implies (not (in a Y))
-           (equal (intersect (insert a X) Y)
-                  (intersect X Y))))
-
-(defthm intersect-insert-Y
-  (implies (not (in a X))
-           (equal (intersect X (insert a Y))
-                  (intersect X Y))))
-
-(defthm intersect-delete-X
-  (equal (intersect (delete a X) Y)
-         (delete a (intersect X Y))))
-
-(defthm intersect-delete-Y
-  (equal (intersect X (delete a Y))
-         (delete a (intersect X Y))))
-
-(defthm intersect-set
-  (setp (intersect X Y)))
-
-(defthm intersect-sfix-cancel-X
-  (equal (intersect (sfix X) Y) (intersect X Y)))
-
-(defthm intersect-sfix-cancel-Y
-  (equal (intersect X (sfix Y)) (intersect X Y)))
-
-(defthm intersect-empty-X
-  (implies (empty X) (empty (intersect X Y))))
-
-(defthm intersect-empty-Y
-  (implies (empty Y) (empty (intersect X Y))))
-
-(defthm intersect-in
-  (equal (in a (intersect X Y))
-         (and (in a Y) (in a X))))
-
-(defthm intersect-subset-X
-  (subset (intersect X Y) X))
-
-(defthm intersect-subset-Y
-  (subset (intersect X Y) Y))
-
-(defthm intersect-with-subset-left
-  (implies (subset X Y)
-           (equal (intersect X Y)
-                  (sfix X)))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-(defthm intersect-with-subset-right
-  (implies (subset X Y)
-           (equal (intersect Y X)
-                  (sfix X)))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-(defthm intersect-self
-  (equal (intersect X X) (sfix X)))
-
-(defthm intersect-associative
-  (equal (intersect (intersect X Y) Z)
-         (intersect X (intersect Y Z))))
-
-(defthmd union-over-intersect
-  (equal (union X (intersect Y Z))
-         (intersect (union X Y) (union X Z))))
-
-(defthm intersect-over-union
-  (equal (intersect X (union Y Z))
-         (union (intersect X Y) (intersect X Z))))
-
-(defthm intersect-commutative
-  (equal (intersect X (intersect Y Z))
-         (intersect Y (intersect X Z)))
-  :rule-classes ((:rewrite :loop-stopper ((X Y)))))
-
-(defthm intersect-outer-cancel
-  (equal (intersect X (intersect X Z))
-         (intersect X Z)))
-
-
-
-(defthm difference-set
-  (setp (difference X Y)))
-
-(defthm difference-sfix-X
-  (equal (difference (sfix X) Y) (difference X Y)))
-
-(defthm difference-sfix-Y
-  (equal (difference X (sfix Y)) (difference X Y)))
-
-(defthm difference-empty-X
-  (implies (empty X)
-           (equal (difference X Y) (sfix X))))
-
-(defthm difference-empty-Y
-  (implies (empty Y)
-           (equal (difference X Y) (sfix X))))
-
-(defthm difference-in
-  (equal (in a (difference X Y))
-         (and (in a X)
-              (not (in a Y)))))
-
-(defthm difference-subset-X
-  (subset (difference X Y) X))
-
-(defthm subset-difference
-  (equal (empty (difference X Y))
-         (subset X Y)))
-
-(defthm difference-over-union
-  (equal (difference X (union Y Z))
-         (intersect (difference X Y) (difference X Z))))
-
-(defthm difference-over-intersect
-  (equal (difference X (intersect Y Z))
-         (union (difference X Y) (difference X Z))))
-
-(defthm difference-insert-X
-  (equal (difference (insert a X) Y)
-         (if (in a Y)
-             (difference X Y)
-           (insert a (difference X Y)))))
-
-(defthm difference-insert-Y
-  (equal (difference X (insert a Y))
-         (delete a (difference X Y))))
-
-(defthm difference-delete-X
-  (equal (difference (delete a X) Y)
-         (delete a (difference X Y))))
-
-(defthm difference-delete-Y
-  (equal (difference X (delete a Y))
-         (if (in a X)
-             (insert a (difference X Y))
-           (difference X Y))))
-
-(defthm difference-preserves-subset
-  (implies (subset X Y)
-	   (subset (difference X Z)
-		   (difference Y Z))))
-
-
-(defthm cardinality-type
-  (and (integerp (cardinality X))
-       (<= 0 (cardinality X)))
-  :rule-classes :type-prescription)
-
-(defthm cardinality-zero-empty
-  (equal (equal (cardinality x) 0)
-	 (empty x)))
-
-(defthm cardinality-sfix-cancel
-  (equal (cardinality (sfix X))
-         (cardinality X)))
-
-(defthm insert-cardinality
-  (equal (cardinality (insert a X))
-         (if (in a X)
-             (cardinality X)
-           (1+ (cardinality X)))))
-
-(defthm delete-cardinality
-  (equal (cardinality (delete a X))
-         (if (in a X)
-             (1- (cardinality X))
-           (cardinality X))))
-
-(defthm subset-cardinality
-  (implies (subset X Y)
-           (<= (cardinality X) (cardinality Y)))
-  :rule-classes (:rewrite :linear))
-
-(defthm proper-subset-cardinality
-  (implies (and (subset X Y)
-                (not (subset Y X)))
-           (< (cardinality X) (cardinality Y)))
-  :rule-classes (:rewrite :linear))
-
-(defthmd equal-cardinality-subset-is-equality
-  (implies (and (setp X)
-                (setp Y)
-                (subset X Y)
-                (equal (cardinality X) (cardinality Y)))
-           (equal (equal X Y) t)))
-
-(defthm intersect-cardinality-X
-  (<= (cardinality (intersect X Y))
-      (cardinality X))
-  :rule-classes (:rewrite :linear))
-
-(defthm intersect-cardinality-Y
-  (<= (cardinality (intersect X Y))
-      (cardinality Y))
-  :rule-classes (:rewrite :linear))
-
-(defthm expand-cardinality-of-union
-  (equal (cardinality (union X Y))
-         (- (+ (cardinality X) (cardinality Y))
-            (cardinality (intersect X Y)))))
-
-(defthm expand-cardinality-of-difference
-  (equal (cardinality (difference X Y))
-         (- (cardinality X)
-            (cardinality (intersect X Y)))))
-
-(defthm intersect-cardinality-non-subset
-  (implies (not (subset x y))
-           (< (cardinality (intersect x y))
-              (cardinality x)))
-  :rule-classes (:rewrite :linear))
-
-(defthm intersect-cardinality-subset-2
-  (equal (equal (cardinality (intersect X Y)) (cardinality X))
-	 (subset X Y)))
-
-(defthm intersect-cardinality-non-subset-2
-  (equal (< (cardinality (intersect x y)) (cardinality x))
-	 (not (subset x y))))
-
-
-
-; -------------------------------------------------------------------
-; Mergesort Theorems
-
-(defthm mergesort-set
-  (setp (mergesort x)))
-
-(defthm in-mergesort
-  (equal (in a (mergesort x))
-         (if (member a x)
-             t
-           nil)))
-
-(defthm mergesort-set-identity
-  (implies (setp X)
-	   (equal (mergesort X) X)))
-
-
-
-; -------------------------------------------------------------------
-; Rulesets for low level reasoning, generally not needed
-
-(defthmd insert-induction-case
-  (implies (and (not (<< a (head X)))
-                (not (equal a (head X)))
-                (not (empty X)))
-           (equal (insert (head X) (insert a (tail X)))
-                  (insert a X))))
-
-(defthmd head-insert
-  (equal (head (insert a X))
-	 (cond ((empty X) a)
-	       ((<< a (head X)) a)
-	       (t (head X)))))
-
-(defthmd tail-insert
-  (equal (tail (insert a X))
-	 (cond ((empty X) (sfix X))
-	       ((<< a (head X)) (sfix X))
-               ((equal a (head X)) (tail X))
-               (t (insert a (tail X))))))
-
-(defthmd head-tail-order
-  (implies (not (empty (tail X)))
-           (<< (head X) (head (tail X)))))
-
-(defthmd head-tail-order-contrapositive
-  (implies (not (<< (head X) (head (tail X))))
-           (empty (tail X))))
-
-(defthmd head-minimal
-  (implies (<< a (head X))
-           (not (in a X))))
-
-(defthmd head-minimal-2
-  (implies (in a X)
-           (not (<< a (head X)))))
-
-(defthmd setp-of-cons
-  (equal (setp (cons a X))
-         (and (setp X)
-              (or (<< a (head X))
-                  (empty X)))))
-
-(defthmd in-to-member
-  (implies (setp X)
-           (equal (in a X)
-                  (if (member a x)
-                      t
-                    nil))))
-
-(defthmd not-member-when-smaller
-  (implies (and (<< a (car x))
-                (setp x))
-           (not (member a x))))
-
-(defthmd subset-to-subsetp
-  (implies (and (setp x)
-                (setp y))
-           (equal (subset x y)
-                  (subsetp x y))))
-
-(defthmd lexorder-<<-equiv
-  (implies (not (equal a b))
-           (equal (equal (<< a b) (lexorder a b))
-                  t)))
-
-(make-event
- (let* ((primitive-rules (acl2::get-ruleset 'primitive-rules (w state)))
-        (order-rules     (acl2::get-ruleset 'order-rules (w state)))
-        (low-level-rules (acl2::get-ruleset 'low-level-rules (w state))))
-   (acl2::value `(progn
-                   (def-ruleset! primitive-rules ',primitive-rules)
-                   (def-ruleset! order-rules ',order-rules)
-                   (def-ruleset! low-level-rules ',low-level-rules)))))
-
-
-
-
-; -------------------------------------------------------------------
-; Relation to acl2::set-equiv, for lightweight use of sets
-
-(defthm insert-under-set-equiv
-  (acl2::set-equiv (insert a x)
-                   (cons a (sfix x))))
-
-(defthm delete-under-set-equiv
-  (acl2::set-equiv (delete a x)
-                   (remove-equal a (sfix x))))
-
-(defthm union-under-set-equiv
-  (acl2::set-equiv (union x y)
-                   (append (sfix x) (sfix y))))
-
-(defthm intersect-under-set-equiv
-  (acl2::set-equiv (intersect x y)
-                   (intersection-equal (sfix x) (sfix y))))
-
-(defthm difference-under-set-equiv
-  (acl2::set-equiv (difference x y)
-                   (set-difference-equal (sfix x) (sfix y))))
-
-(defthm mergesort-under-set-equiv
-  (acl2::set-equiv (mergesort x)
-                   x))
-
-(defcong acl2::set-equiv equal (mergesort x) 1
-  :event-name set-equiv-implies-equal-mergesort-1)
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/top" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/sort.lisp acl2-6.3/books/finite-set-theory/osets/sort.lisp
--- acl2-6.2/books/finite-set-theory/osets/sort.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/sort.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,283 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-; sort.lisp -- a mergesort for constructing sets
-
-(in-package "SETS")
-(include-book "union")
-(local (include-book "std/lists/append" :dir :system))
-(local (include-book "std/lists/rev" :dir :system))
-(local (include-book "tools/mv-nth" :dir :system))
-(set-verify-guards-eagerness 2)
-
-(local (defthm member-of-append
-         (iff (member a (append x y))
-              (or (member a x)
-                  (member a y)))))
-
-(local (defthm member-of-list-fix
-         (iff (member a (acl2::list-fix x))
-              (member a x))))
-
-(local (defthm member-of-rev
-         (iff (member a (acl2::rev x))
-              (member a x))))
-
-(local (defthm append-assoc
-         (equal (append (append x y) z)
-                (append x (append y z)))))
-
-(defsection halve-list
-  :parents (mergesort)
-  :short "How we split the list for mergesort."
-
-  :long "<p>Originally I used the following function to split the list.</p>
-
-@({
-  (defun split-list-old (x)
-    (declare (xargs :guard (true-listp x)))
-    (cond ((endp x) (mv nil nil))
-          ((endp (cdr x)) (mv (list (car x)) nil))
-          (t (mv-let (part1 part2)
-                     (split-list-old (cddr x))
-                     (mv (cons (car x) part1)
-                         (cons (cadr x) part2)))))))
-})
-
-<p>But David Rager noted that this was not tail recursive, and accordingly it
-ran into trouble on large data sets.  Accordingly, in Version 0.91, I rewrote
-this to be tail recursive:</p>
-
-@({
- (defun split-list (x acc acc2)
-   (declare (xargs :guard (true-listp x)))
-   (cond ((endp x)
-          (mv acc acc2))
-         ((endp (cdr x))
-          (mv (cons (car x) acc) acc2))
-         (t (split-list (cddr x)
-                        (cons (car x) acc)
-                        (cons (cadr x) acc2)))))
-})
-
-<p>Since then, I wrote the @('defsort/defsort') library, which uses some tricks
-to provide a faster mergesort.  One key optimization is to take the first and
-second halves of the list, rather than splitting the list in terms of evens and
-odds.  This allows you to split the list with half as much consing.</p>
-
-<p>Defsort's approach uses a lot of arithmetic optimization.  I later wrote a
-mergesort for Milawa, where arithmetic is expensive.  Here, I implemented
-split-list by walking down \"one cdr\" and \"two cdrs\" at a time.  I now use
-this same strategy in osets.</p>
-
-<p>BOZO this strategy is still stupidly re-consing up half the list, when
-really we could avoid that by just being a bit smarter, like in defsort.</p>"
-
-  (defund halve-list-aux (mid x acc)
-    (declare (xargs :guard (<= (len x) (len mid))))
-
-; We split the list by walking down it in a funny way; see halve-list.
-; Initially, mid and x both point to the front of the list.  We walk down x
-; taking two steps for every one step we take for mid; hence mid stays at the
-; middle of the list.  As we traverse mid, we puts its members into acc, and
-; when x runs out we return both acc and the rest of mid.  This effectively
-; lets us split the list in two (1) without doing any arithmetic, which can be
-; expensive since we can't use fixnum declarations, and (2) while consing only
-; (1/2)n times, where n is the length of the list.  This splitting function
-; performs well, handily beating the old osets split-list implementation on a
-; large list of symbols which we used to test it.
-
-    (if (or (atom x)
-            (atom (cdr x)))
-        (mv acc mid)
-      (halve-list-aux (cdr mid)
-                      (cdr (cdr x))
-                      (cons (car mid) acc))))
-
-  (defund halve-list (x)
-    (declare (xargs :guard t))
-    (halve-list-aux x x nil))
-
-  (local (in-theory (enable halve-list-aux)))
-
-  (local (defthm halve-list-aux-when-not-consp
-           (implies (not (consp x))
-                    (equal (halve-list-aux mid x acc)
-                           (list acc mid)))))
-
-  (local (defthm halve-list-aux-when-not-consp-of-cdr
-           (implies (not (consp (cdr x)))
-                    (equal (halve-list-aux mid x acc)
-                           (list acc mid)))))
-
-  (local (defthm halve-list-aux-len-1
-           (implies (and (<= (len x) (len mid))
-                         (consp x)
-                         (consp (cdr x)))
-                    (< (len (mv-nth 0 (halve-list-aux mid x acc)))
-                       (+ (len mid) (len acc))))
-           :rule-classes ((:rewrite) (:linear))))
-
-  (local (defthm halve-list-aux-len-2
-           (implies (and (<= (len x) (len mid))
-                         (consp x)
-                         (consp (cdr x)))
-                    (< (len (mv-nth 1 (halve-list-aux mid x acc)))
-                       (len mid)))
-           :rule-classes ((:rewrite) (:linear))))
-
-  (local (defthm halve-list-aux-append-property
-           (implies (<= (len x) (len mid))
-                    (equal (append (acl2::rev (mv-nth 0 (halve-list-aux mid x acc)))
-                                   (mv-nth 1 (halve-list-aux mid x acc)))
-                           (append (acl2::rev acc)
-                                   mid)))
-           :hints(("Goal" :do-not '(generalize fertilize)))))
-
-  (local (defthm halve-list-correct
-           (equal (append (acl2::rev (mv-nth 0 (halve-list x)))
-                          (mv-nth 1 (halve-list x)))
-                  x)
-           :hints(("Goal" :in-theory (enable halve-list)))))
-
-  (defthm halve-list-len-1
-    (implies (and (consp x)
-                  (consp (cdr x)))
-             (< (len (mv-nth 0 (halve-list x)))
-                (len x)))
-    :hints(("Goal"
-            :in-theory (e/d (halve-list)
-                            (halve-list-aux-len-1))
-            :use ((:instance halve-list-aux-len-1
-                             (mid x) (x x) (acc nil))))))
-
-  (defthm halve-list-len-2
-    (implies (and (consp x)
-                  (consp (cdr x)))
-             (< (len (mv-nth 1 (halve-list x)))
-                (len x)))
-    :hints(("Goal" :in-theory (enable halve-list))))
-
-  (defthm halve-list-membership-property
-    (iff (member a x)
-         (or (member a (mv-nth 0 (halve-list x)))
-             (member a (mv-nth 1 (halve-list x)))))
-    :rule-classes nil
-    :hints(("Goal"
-            :do-not-induct t
-            :in-theory (disable member-of-append)
-            :use ((:instance member-of-append
-                             (x (acl2::rev (mv-nth 0 (halve-list x))))
-                             (y (mv-nth 1 (halve-list x)))))))))
-
-
-(defsection mergesort-exec
-  :parents (mergesort)
-  :short "The implementation of mergesort."
-
-  (defun mergesort-exec (x)
-    (declare (xargs :guard t
-                    :measure (len x)
-                    :hints(("Goal"
-                            :use ((:instance halve-list-len-1)
-                                  (:instance halve-list-len-2))))
-                    :verify-guards nil))
-    (cond ((atom x) nil)
-          ((atom (cdr x))
-           (mbe :logic (insert (car x) nil)
-                :exec (list (car x))))
-          (t (mv-let (part1 part2)
-               (halve-list x)
-               (fast-union (mergesort-exec part1)
-                           (mergesort-exec part2)
-                           nil)))))
-
-  (local (in-theory (enable fast-union-set
-                            fast-union-membership)))
-
-  (defthm mergesort-exec-set
-    (setp (mergesort-exec x)))
-
-  (local (defthm mergesort-membership-2
-           (implies (member a x)
-                    (in a (mergesort-exec x)))
-           :hints(("Subgoal *1/3" :use (:instance halve-list-membership-property)))))
-
-  (local (defthm mergesort-membership-1
-           (implies (in a (mergesort-exec x))
-                    (member a x))
-           :hints(("Subgoal *1/6" :use (:instance halve-list-membership-property))
-                  ("Subgoal *1/5" :use (:instance halve-list-membership-property))
-                  ("Subgoal *1/4" :use (:instance halve-list-membership-property)))))
-
-  (defthm mergesort-exec-membership
-    (iff (in a (mergesort-exec x))
-         (member a x)))
-
-  (verify-guards mergesort-exec
-    :hints(("Goal" :in-theory (e/d ((:ruleset primitive-rules))
-                                   (mv-nth))))))
-
-
-(defsection mergesort
-  :parents (osets)
-  :short "@(call mergesort) converts the list @('X') into an ordered set."
-
-  :long "<p>Logically, @('(mergesort x)') is exactly the same as repeated
-insertion, so it is fairly easy to reason about.  But in the execution,
-mergesort is implemented with a reasonably efficient sort with O(n log n)
-performance instead of O(n^2) like repeated insertion.</p>
-
-<p>Our implementation is probably not blisteringly fast.  Folklore says we
-should switch to using a bubblesort when we get down to some threshold, say 40
-elements.  I'm not going to bother with any of that.  If you find that the
-mergesort's performance is inadequate, which is unlikely, you can work on
-making it faster.</p>
-
-<p>There are a few points of interest.  If you look at the actual sort code,
-@(see mergesort-exec), you will see that it is actually using the set library's
-own @(see union) function to perform the union.  This is pretty slick because
-union is linear complexity, and yet is easy to reason about since we have
-already got a lot of theory in place about it.</p>
-
-<p>In any case, our strategy for proving the equality of this mergesort with a
-simple insertion sort is the exact same trick we use everywhere else in the
-sets library.  We begin by showing that both produce sets, and then show that
-membership in either is true exactly when an element is @(see member-equal) in
-the original list.</p>"
-
-  (defun mergesort (x)
-    (declare (xargs :guard t
-                    :verify-guards nil))
-    (mbe :logic (if (endp x)
-                    nil
-                  (insert (car x)
-                          (mergesort (cdr x))))
-         :exec (mergesort-exec x)))
-
-  (defthm mergesort-set
-    (setp (mergesort x)))
-
-  (defthm in-mergesort
-    (equal (in a (mergesort x))
-           (if (member a x)
-               t
-             nil)))
-
-  (verify-guards mergesort)
-
-  (defthm mergesort-set-identity
-    (implies (setp X)
-             (equal (mergesort X) X))
-    :hints(("Goal" :in-theory (enable (:ruleset primitive-rules))))))
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/sort" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/under-set-equiv.lisp acl2-6.3/books/finite-set-theory/osets/under-set-equiv.lisp
--- acl2-6.2/books/finite-set-theory/osets/under-set-equiv.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/under-set-equiv.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,161 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2013 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "SETS")
-(include-book "outer")
-(include-book "sort")
-(include-book "std/lists/sets" :dir :system)
-
-(defun all-list (x)
-  (declare (xargs :guard (true-listp x)))
-  (if (endp x)
-      t
-    (and (predicate (car x))
-         (all-list (cdr x)))))
-
-(encapsulate
-  (((all-list-hyps) => *)
-   ((all-list-list) => *))
-
-  (local (defun all-list-hyps () nil))
-  (local (defun all-list-list () nil))
-
-  (defthmd list-membership-constraint
-    (implies (all-list-hyps)
-             (implies (member arbitrary-element (all-list-list))
-                      (predicate arbitrary-element)))))
-
-(encapsulate
-  ()
-  (local (defun all-list-badguy (x)
-           (if (consp x)
-               (if (predicate (car x))
-                   (all-list-badguy (cdr x))
-                 (list (car x)))
-             nil)))
-
-  (local (defthmd all-list-badguy-membership-property
-           (implies (all-list-badguy x)
-                    (and (member-equal (car (all-list-badguy x)) x)
-                         (not (predicate (car (all-list-badguy x))))))
-           :hints(("Goal" :induct (all-list-badguy x)))))
-
-  (local (defthm all-list-badguy-under-iff
-           (iff (all-list-badguy x)
-                (not (all-list x)))
-           :hints(("Goal" :in-theory (enable all-list)))))
-
-  (defthmd all-list-by-membership
-    (implies (all-list-hyps)
-             (all-list (all-list-list)))
-    :hints(("Goal"
-            :in-theory (enable list-membership-constraint)
-            :use ((:instance all-list-badguy-membership-property
-                             (x (all-list-list))))))))
-
-(defund subsetp-equal-trigger (x y)
-  (declare (xargs :guard (and (true-listp x)
-                              (true-listp y))))
-  (subsetp-equal x y))
-
-(defthm pick-a-point-subsetp-equal-strategy
-  (implies (and (syntaxp (rewriting-goal-lit mfc state))
-                (syntaxp (rewriting-conc-lit `(subsetp-equal ,x ,y) mfc state)))
-           (equal (subsetp-equal x y)
-                  (subsetp-equal-trigger x y)))
-  :hints(("Goal" :in-theory (enable subsetp-equal-trigger))))
-
-(COMPUTED-HINTS::automate-instantiation
- :new-hint-name pick-a-point-subsetp-equal-hint
- :generic-theorem all-list-by-membership
- :generic-predicate predicate
- :generic-hyps all-list-hyps
- :generic-collection all-list-list
- :generic-collection-predicate all-list
- :actual-collection-predicate subsetp-equal
- :actual-trigger subsetp-equal-trigger
- :predicate-rewrite (((predicate ?x ?y) (member-equal ?x ?y)))
- :tagging-theorem pick-a-point-subsetp-equal-strategy)
-
-
-
-;; BOZO talk to sol about whether these should become defwitness nonsense
-
-(local (defthm promote-member-to-in
-         (implies (setp x)
-                  (iff (member a x)
-                       (in a x)))
-         :hints(("Goal" :in-theory (enable in-to-member)))))
-
-(local (in-theory (enable acl2::set-equiv)))
-
-(defthm insert-under-set-equiv
-  (acl2::set-equiv (insert a x)
-                   (cons a (sfix x)))
-  :hints(("Goal" :do-not-induct t)))
-
-(defthm delete-under-set-equiv
-  (acl2::set-equiv (delete a x)
-                   (remove-equal a (sfix x))))
-
-(encapsulate
-  ()
-  (local (defthm l0
-           (subsetp (union x y)
-                    (append (sfix x) (sfix y)))))
-
-  (local (defthm l1
-           (subsetp (append (sfix x) (sfix y))
-                    (union x y))))
-
-  (defthm union-under-set-equiv
-    (acl2::set-equiv (union x y)
-                     (append (sfix x) (sfix y)))
-    :hints(("Goal" :do-not-induct t))))
-
-
-(defthm intersect-under-set-equiv
-  (acl2::set-equiv (intersect x y)
-                   (intersection-equal (sfix x) (sfix y)))
-  :hints(("Goal" :do-not-induct t)))
-
-(defthm difference-under-set-equiv
-  (acl2::set-equiv (difference x y)
-                   (set-difference-equal (sfix x) (sfix y)))
-  :hints(("Goal" :do-not-induct t)))
-
-(defthm mergesort-under-set-equiv
-  (acl2::set-equiv (mergesort x)
-                   x)
-  :hints(("Goal" :do-not-induct t)))
-
-(encapsulate
-  ()
-  (local (defthm l0
-           (implies (acl2::set-equiv x y)
-                    (subsetp (mergesort x) (mergesort y)))))
-
-  (local (defthm l1
-           (implies (and (subsetp x y)
-                         (member a x))
-                    (member a y))))
-
-  (defcong acl2::set-equiv equal (mergesort x) 1
-    :event-name set-equiv-implies-equal-mergesort-1
-    :hints(("Goal"
-            :do-not-induct t
-            :do-not '(generalize fertilize)
-            :in-theory (enable acl2::set-equiv)))))
-
-
-
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/under-set-equiv" :dir :system)
diff -Nru acl2-6.2/books/finite-set-theory/osets/union.lisp acl2-6.3/books/finite-set-theory/osets/union.lisp
--- acl2-6.2/books/finite-set-theory/osets/union.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/finite-set-theory/osets/union.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,208 +1,3 @@
-; Fully Ordered Finite Sets
-; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public Lic-
-; ense along with this program; if not, write to the Free Soft- ware
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "SETS")
-(include-book "membership")
-(set-verify-guards-eagerness 2)
-
-
-; Fast Union
-;
-; We want to show that fast union always produces a set, and has the expected
-; membership property.
-
-
-; PATCH (0.91): David Rager noticed that as of v0.9, fast-union was not tail
-; recursive, and submitted an updated version.  The original fast-union has
-; been renamed to fast-union-old, and the new fast-union replaces it.
-
-(local
- (encapsulate ()
-
-   (defun fast-union-old (X Y)
-     (declare (xargs :measure (fast-measure X Y)
-                     :guard (and (setp X) (setp Y))
-                     :verify-guards nil))
-     (cond ((endp X) Y)
-           ((endp Y) X)
-           ((equal (car X) (car Y))
-            (cons (car X) (fast-union-old (cdr X) (cdr Y))))
-           ((fast-<< (car X) (car Y))
-            (cons (car X) (fast-union-old (cdr X) Y)))
-           (t
-            (cons (car Y) (fast-union-old X (cdr Y))))))
-
-   (defthm fast-union-old-set
-     (implies (and (setp X) (setp Y))
-              (setp (fast-union-old X Y)))
-     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
-
-   (defthm member-of-fast-union-old
-     (iff (member a (fast-union-old x y))
-          (or (member a x)
-              (member a y))))
-
-   (defthm fast-union-old-membership
-     (implies (and (setp X) (setp Y))
-              (equal (in a (fast-union-old X Y))
-                     (or (in a X) (in a Y))))
-     :hints(("Goal"
-             :do-not '(generalize fertilize)
-             :in-theory (enable (:ruleset low-level-rules)))))
-
-   (verify-guards fast-union-old
-     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))))
-
-
-(defun fast-union (x y acc)
-  (declare (xargs :measure (fast-measure X Y)
-                  :guard (and (setp x)
-                              (setp y)
-                              (true-listp acc))
-                  :verify-guards nil))
-  (cond ((endp x) (revappend acc y))
-        ((endp y) (revappend acc x))
-        ((equal (car x) (car y))
-         (fast-union (cdr x) (cdr y) (cons (car x) acc)))
-        ((mbe :logic (<< (car x) (car y))
-              :exec (fast-lexorder (car x) (car y)))
-         (fast-union (cdr x) y (cons (car x) acc)))
-        (t
-         (fast-union x (cdr y) (cons (car y) acc)))))
-
-(verify-guards fast-union
-  :hints(("Goal"
-          :do-not '(generalize fertilize)
-          :in-theory (enable (:ruleset low-level-rules)))))
-
-(encapsulate
-  ()
-  (local (defthm lemma
-           (equal (fast-union x y acc)
-                  (revappend acc (fast-union-old x y)))
-           :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
-
-  (local (defthm lemma2
-           (equal (fast-union x y nil)
-                  (fast-union-old x y))))
-
-  (defthm fast-union-set
-    (implies (and (force (setp X))
-                  (force (setp Y)))
-             (setp (fast-union X Y nil))))
-
-  (defthm fast-union-membership
-    (implies (and (setp X) (setp Y))
-             (equal (in a (fast-union X Y nil))
-                    (or (in a X) (in a Y)))))
-
-  (in-theory (disable fast-union
-                      fast-union-set
-                      fast-union-membership)))
-
-
-
-
-(defsection union
-  :parents (osets)
-  :short "@(call union) constructs the union of @('X') and @('Y')."
-
-  :long "<p>The logical definition is very simple, and the essential
-correctness property is given by @('union-in').</p>
-
-<p>The execution uses a better, O(n) algorithm to merge the sets by exploiting
-the set order.</p>"
-
-  (defun union (X Y)
-    (declare (xargs :guard (and (setp X) (setp Y))
-                    :verify-guards nil))
-    (mbe :logic (if (empty X)
-                    (sfix Y)
-                  (insert (head X) (union (tail X) Y)))
-         :exec  (fast-union X Y nil)))
-
-  (defthm union-set
-    (setp (union X Y)))
-
-  (defthm union-sfix-cancel-X
-    (equal (union (sfix X) Y) (union X Y)))
-
-  (defthm union-sfix-cancel-Y
-    (equal (union X (sfix Y)) (union X Y)))
-
-  (defthm union-empty-X
-    (implies (empty X)
-             (equal (union X Y) (sfix Y))))
-
-  (defthm union-empty-Y
-    (implies (empty Y)
-             (equal (union X Y) (sfix X))))
-
-  (defthm union-empty
-    (equal (empty (union X Y))
-           (and (empty X) (empty Y))))
-
-  (defthm union-in
-    (equal (in a (union X Y))
-           (or (in a X) (in a Y))))
-
-  (verify-guards union
-    :hints(("Goal" :in-theory (enable fast-union-set
-                                      fast-union-membership))))
-
-
-  (defthm union-symmetric
-    (equal (union X Y) (union Y X))
-    :rule-classes ((:rewrite :loop-stopper ((X Y)))))
-
-  (defthm union-subset-X
-    (subset X (union X Y)))
-
-  (defthm union-subset-Y
-    (subset Y (union X Y)))
-
-  (defthm union-insert-X
-    (equal (union (insert a X) Y)
-           (insert a (union X Y))))
-
-  (defthm union-insert-Y
-    (equal (union X (insert a Y))
-           (insert a (union X Y))))
-
-  (defthm union-with-subset-left
-    (implies (subset X Y)
-             (equal (union X Y)
-                    (sfix Y)))
-    :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-  (defthm union-with-subset-right
-    (implies (subset X Y)
-             (equal (union Y X)
-                    (sfix Y)))
-    :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-  (defthm union-self
-    (equal (union X X) (sfix X)))
-
-  (defthm union-associative
-    (equal (union (union X Y) Z)
-           (union X (union Y Z))))
-
-  (defthm union-commutative
-    (equal (union X (union Y Z))
-           (union Y (union X Z)))
-    :rule-classes ((:rewrite :loop-stopper ((X Y)))))
-
-  (defthm union-outer-cancel
-    (equal (union X (union X Z))
-           (union X Z))))
\ No newline at end of file
+(in-package "ACL2")
+; cert_param: (reloc_stub)
+(include-book "std/osets/union" :dir :system)
diff -Nru acl2-6.2/books/hacking/dynamic-make-event.lisp acl2-6.3/books/hacking/dynamic-make-event.lisp
--- acl2-6.2/books/hacking/dynamic-make-event.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/hacking/dynamic-make-event.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -32,6 +32,7 @@
   (make-event-fn `',body
                  nil
                  nil
+                 nil
                  event-form
                  state))
 
diff -Nru acl2-6.2/books/hacking/raw.lisp acl2-6.3/books/hacking/raw.lisp
--- acl2-6.2/books/hacking/raw.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/hacking/raw.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -2,7 +2,7 @@
 
 ; Modification by Matt K. after v4-3: Removed :load-compiled-file :comp, which
 ; was part of the include-book forms just below, in support of provisional
-; certification.  Presumably the indicate books have already been compiled by
+; certification.  Presumably the indicated books have already been compiled by
 ; now, anyhow.
 (include-book "defstruct-parsing"); was in portcullis
 
diff -Nru acl2-6.2/books/hints/Readme.lsp acl2-6.3/books/hints/Readme.lsp
--- acl2-6.2/books/hints/Readme.lsp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/hints/Readme.lsp	2013-09-30 17:52:14.000000000 +0000
@@ -12,6 +12,7 @@
 consider-hint-tests.lisp
 consider-hint.lisp
 huet-lang-algorithm-tests.lisp
+huet-lang-algorithm.pdf
 huet-lang-algorithm.lisp
 merge-hint.lisp
 ")
diff -Nru acl2-6.2/books/hints/basic-tests.acl2 acl2-6.3/books/hints/basic-tests.acl2
--- acl2-6.2/books/hints/basic-tests.acl2	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/hints/basic-tests.acl2	2013-09-30 17:52:14.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 ; Enable proof output.
diff -Nru acl2-6.2/books/hints/basic-tests.lisp acl2-6.3/books/hints/basic-tests.lisp
--- acl2-6.2/books/hints/basic-tests.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/hints/basic-tests.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This file contains some basic tests of various hint mechanisms.
 
 ; Note that because of must-fail, REBUILD doesn't work for this book.
diff -Nru acl2-6.2/books/hints/consider-hint-tests.lisp acl2-6.3/books/hints/consider-hint-tests.lisp
--- acl2-6.2/books/hints/consider-hint-tests.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/hints/consider-hint-tests.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (include-book "consider-hint")
diff -Nru acl2-6.2/books/hints/consider-hint.lisp acl2-6.3/books/hints/consider-hint.lisp
--- acl2-6.2/books/hints/consider-hint.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/hints/consider-hint.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 (include-book "huet-lang-algorithm")
 (include-book "merge-hint")
diff -Nru acl2-6.2/books/hints/huet-lang-algorithm-tests.lisp acl2-6.3/books/hints/huet-lang-algorithm-tests.lisp
--- acl2-6.2/books/hints/huet-lang-algorithm-tests.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/hints/huet-lang-algorithm-tests.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (include-book "huet-lang-algorithm")
diff -Nru acl2-6.2/books/hints/huet-lang-algorithm.lisp acl2-6.3/books/hints/huet-lang-algorithm.lisp
--- acl2-6.2/books/hints/huet-lang-algorithm.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/hints/huet-lang-algorithm.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,11 +1,12 @@
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore, December, 2003 (revised July, 2007)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; I have marked with (i-am-here) various questions worthy of
 ; additional work.
 
 ; Second-Order Matching Under a Set of Rewriting Rules
 
-; J Strother Moore
-; December, 2003 (revised July, 2007)
-
 ; I implement the second-order matching algorithm of Huet and Lang and
 ; then couple it with a search strategy that generates and tests ``all
 ; possible rewrites'' under a particular set of rewrite rules.  The
@@ -45,8 +46,11 @@
 
 ; We start by developing the Huet-Lang algorithm.
 
-; For a description of the basic algorithm, see huet-lang-algorithm.ps,
-; which is my rendition of G. Huet and B. Lang, ``Proving and applying
+; For a description of the basic algorithm, see "Automatically
+; Computing Functional Instantiations," in Proceedings of the ACL2
+; Workshop 2009(eds. D. Russinoff and S. Ray), Boston, 2009, URL
+; http://www.cs.utexas.edu/users/moore/publications/moore-09a.pdf .
+; That is my rendition of G. Huet and B. Lang, ``Proving and applying
 ; program transformations expressed with second-order patterns,'' Acta
 ; Informatica, 11, pp 31--55, 1997.
 
diff -Nru acl2-6.2/books/hints/merge-hint.lisp acl2-6.3/books/hints/merge-hint.lisp
--- acl2-6.2/books/hints/merge-hint.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/hints/merge-hint.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (program)
diff -Nru acl2-6.2/books/ihs/ihs-doc-topic.lisp acl2-6.3/books/ihs/ihs-doc-topic.lisp
--- acl2-6.2/books/ihs/ihs-doc-topic.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/ihs/ihs-doc-topic.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -23,7 +23,20 @@
 
 (defdoc ihs
   ":Doc-Section ihs
-Integer Hardware Specification (IHS) library.~/
+The Integer Hardware Specification (IHS) library is a collection of
+arithmetic books, mainly geared toward bit-vector arithmetic.~/
+
+This is a classic ACL2 arithmetic library wherein bit-vectors are represented
+as ordinary ACL2 integers, which has some nice efficiency properties.
+
+Despite the underlying integer-based representation, the library allows you to
+easily treat integers akin to lsb-first lists of bits, with the functions
+~ilc[logcar] and ~ilc[logcdr] acting as analogues for ~ilc[car] and ~ilc[cdr].
+
+To help you make use of this view, the library introduces alternate,
+list-style, recursive definitions for operations like ~ilc[logand].  Once you
+understand how to induct in the right way to use these definitions, it becomes
+an extremely useful way to prove theorems about these bit functions.
 
 The IHS library is found in:
 ~bv[]
diff -Nru acl2-6.2/books/interface/infix/acl2-formatting.lisp acl2-6.3/books/interface/infix/acl2-formatting.lisp
--- acl2-6.2/books/interface/infix/acl2-formatting.lisp	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/interface/infix/acl2-formatting.lisp	2013-09-30 17:53:31.000000000 +0000
@@ -120,7 +120,7 @@
 
 (defun keyword-command-arg-number (key state)
   (declare (xargs :mode :program))
-  (let ((temp (assoc-eq key (f-get-global 'ld-keyword-aliases state))))
+  (let ((temp (assoc-eq key (ld-keyword-aliases state))))
     (cond (temp (cadr temp))
 	  ((eq key :q) 0)
 	  (t
diff -Nru acl2-6.2/books/interface/infix/infix.lisp acl2-6.3/books/interface/infix/infix.lisp
--- acl2-6.2/books/interface/infix/infix.lisp	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/interface/infix/infix.lisp	2013-09-30 17:53:31.000000000 +0000
@@ -3309,7 +3309,7 @@
 (defun ld-printer (term)
   (let ((keys (extract-keywords term '(:standard-co :proofs-co :current-package
 				       :ld-skip-proofsp :ld-redefinition-action
-				       :ld-prompt :ld-keyword-aliases :ld-pre-eval-filter
+				       :ld-prompt :ld-pre-eval-filter
 				       :ld-pre-eval-print :ld-post-eval-print :ld-evisc-tuple
 				       :ld-error-triples :ld-error-action
 				       :ld-query-control-alist :ld-verbose)))) 
@@ -3320,7 +3320,7 @@
     (if keys
 	(let ((pairs (pairlis '(:standard-co :proofs-co :current-package
 			        :ld-skip-proofsp :ld-redefinition-action
-				:ld-prompt :ld-keyword-aliases :ld-pre-eval-filter
+				:ld-prompt :ld-pre-eval-filter
 				:ld-pre-eval-print :ld-post-eval-print :ld-evisc-tuple
 				:ld-error-triples :ld-error-action
 				:ld-query-control-alist :ld-verbose)
@@ -4199,23 +4199,6 @@
 	(t
 	 (ppformat " prompt function = ~a" (cdr pair)))))
 
-(defun ld-keyword-aliases-keyword-printer (pair)
-  ;; pair = (:ld-keyword-aliases '((:q 0 q-fn) (:e 0 exit-acl2-macro)))
-  (let ((x (cdr pair)))
-    (if (equal (car x) 'quote)
-	(setq x (cadr x)))
-    (ppformat " define keyword aliases (")
-    (sloop for tail on x do
-	   (cond ((cddr tail)
-		  (ppformat "~s = ~a of arity ~d, "
-			    (car (car tail)) (caddr (car tail)) (cadr (car tail))))
-		 ((cdr tail)
-		  (ppformat "~s = ~a of arity ~d and "
-			    (car (car tail)) (caddr (car tail)) (cadr (car tail))))
-		 (t (ppformat "~s = ~a of arity ~d"
-			      (car (car tail)) (caddr (car tail)) (cadr (car tail))))))
-    (ppformat ")")))
-
 (defun ld-pre-eval-filter-keyword-printer (pair)
   ;; :all
   (cond ((null (cdr pair)))
@@ -4305,7 +4288,6 @@
 	(list ':ld-skip-proofsp (function ld-skip-proofsp-keyword-printer))
 	(list ':ld-redefinition-action (function ld-redefinition-action-keyword-printer))
 	(list ':ld-prompt (function ld-prompt-keyword-printer))
-	(list ':ld-keyword-aliases (function ld-keyword-aliases-keyword-printer))
 	(list ':ld-pre-eval-filter (function ld-pre-eval-filter-keyword-printer))
 	(list ':ld-pre-eval-print (function ld-pre-eval-print-keyword-printer))
 	(list ':ld-post-eval-print (function ld-post-eval-print-keyword-printer))
diff -Nru acl2-6.2/books/make-event/assert-check-include-1.acl2 acl2-6.3/books/make-event/assert-check-include-1.acl2
--- acl2-6.2/books/make-event/assert-check-include-1.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/assert-check-include-1.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 (include-book "../misc/eval")
 
diff -Nru acl2-6.2/books/make-event/assert-check-include-1.lisp acl2-6.3/books/make-event/assert-check-include-1.lisp
--- acl2-6.2/books/make-event/assert-check-include-1.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/assert-check-include-1.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; (Comment from Matt K. August 2011: I no longer know what this test is
 ; intended to accomplish, and the comment on the next line looks misguided.)
 ; Here we make sure that we can include assert-check.
diff -Nru acl2-6.2/books/make-event/assert-check.lisp acl2-6.3/books/make-event/assert-check.lisp
--- acl2-6.2/books/make-event/assert-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/assert-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This variant of assert.lisp runs assertions at all times, rather than
 ; skipping them during include-book and the second pass of encapsulate.  The
 ; comment below "Specific to this file", below, describes the interesting
diff -Nru acl2-6.2/books/make-event/assert-include.acl2 acl2-6.3/books/make-event/assert-include.acl2
--- acl2-6.2/books/make-event/assert-include.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/assert-include.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (defun bar (x) x)
 
 (certify-book "assert-include" ? t)
diff -Nru acl2-6.2/books/make-event/assert-include.lisp acl2-6.3/books/make-event/assert-include.lisp
--- acl2-6.2/books/make-event/assert-include.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/assert-include.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Here we make sure that we can include assert, which is particularly
 ; interesting in light of the comment before the last form in assert.lisp about
 ; the expansion checking that the latest command is (exit-boot-strap-mode).
diff -Nru acl2-6.2/books/make-event/basic-check.lisp acl2-6.3/books/make-event/basic-check.lisp
--- acl2-6.2/books/make-event/basic-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/basic-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This variant of basic.lisp uses :check-expansion t.  If you care to look in
 ; basic-check.cert, you'll see that the expansions saved for test1 (position 1
 ; in this file) and test2 (position 2 in this file) are of the form
diff -Nru acl2-6.2/books/make-event/basic-pkg-check.acl2 acl2-6.3/books/make-event/basic-pkg-check.acl2
--- acl2-6.2/books/make-event/basic-pkg-check.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/basic-pkg-check.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (defpkg "FOO"
   (union-eq '(make-event value)
 	     (union-eq *acl2-exports*
diff -Nru acl2-6.2/books/make-event/basic-pkg-check.lisp acl2-6.3/books/make-event/basic-pkg-check.lisp
--- acl2-6.2/books/make-event/basic-pkg-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/basic-pkg-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This is similar to basic-pkg.lisp, but with :check-expansion t (just as
 ; basic-check.lisp is related to basic.lisp).
 
diff -Nru acl2-6.2/books/make-event/basic-pkg.acl2 acl2-6.3/books/make-event/basic-pkg.acl2
--- acl2-6.2/books/make-event/basic-pkg.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/basic-pkg.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (defpkg "FOO"
   (union-eq '(value)
 	     (union-eq *acl2-exports*
diff -Nru acl2-6.2/books/make-event/basic-pkg.lisp acl2-6.3/books/make-event/basic-pkg.lisp
--- acl2-6.2/books/make-event/basic-pkg.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/basic-pkg.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This book is similar to (part of) basic.lisp, but is in package "FOO" and
 ; hence must be certified in a world where package "FOO" has been defined (see
 ; basic-pkg.acl2).
diff -Nru acl2-6.2/books/make-event/basic.lisp acl2-6.3/books/make-event/basic.lisp
--- acl2-6.2/books/make-event/basic.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/basic.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Here are some simple examples intended to illustrate the basics of
 ; make-event, with a focus on make-event-debug.
 
diff -Nru acl2-6.2/books/make-event/defconst-fast-examples.lisp acl2-6.3/books/make-event/defconst-fast-examples.lisp
--- acl2-6.2/books/make-event/defconst-fast-examples.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/defconst-fast-examples.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Here we illustrate the defconst-fast macro, defined in defconst-fast.lisp.
 ; An interesting experiment, after certifying this book, is as follows:
 
diff -Nru acl2-6.2/books/make-event/defconst-fast.lisp acl2-6.3/books/make-event/defconst-fast.lisp
--- acl2-6.2/books/make-event/defconst-fast.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/defconst-fast.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This macro, defconst-fast, is based on a conversation with Warren Hunt.  A
 ; defconst in a book has the unfortunate property that its form is evaluated
 ; not only when that book is certified, but also (again) when that book is
diff -Nru acl2-6.2/books/make-event/defrule.lisp acl2-6.3/books/make-event/defrule.lisp
--- acl2-6.2/books/make-event/defrule.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/defrule.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,5 +1,6 @@
-; Matt Kaufmann
-; October, 2010
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, October, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; This book introduces a macro, DEFRULE.  DEFRULE behaves just like defthm,
 ; except that its intended use is to generate rewrite rules from formulas that
diff -Nru acl2-6.2/books/make-event/defspec.lisp acl2-6.3/books/make-event/defspec.lisp
--- acl2-6.2/books/make-event/defspec.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/defspec.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Sandip Ray and Matt Kaufmann, October, 2006
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 #|
diff -Nru acl2-6.2/books/make-event/double-cert-test-1.acl2 acl2-6.3/books/make-event/double-cert-test-1.acl2
--- acl2-6.2/books/make-event/double-cert-test-1.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/double-cert-test-1.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 (make-event '(defun h1 (x) x))
 ; cert-flags: ? t :acl2x t :ttagsx :all :ttags nil
diff -Nru acl2-6.2/books/make-event/double-cert-test-1.lisp acl2-6.3/books/make-event/double-cert-test-1.lisp
--- acl2-6.2/books/make-event/double-cert-test-1.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/double-cert-test-1.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (make-event
diff -Nru acl2-6.2/books/make-event/eval-check-tests.lisp acl2-6.3/books/make-event/eval-check-tests.lisp
--- acl2-6.2/books/make-event/eval-check-tests.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/eval-check-tests.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (sometime before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This is a variant of eval-tests.lisp that includes eval-check.lisp, which
 ; employs :check-expansion t, instead of
 ; eval.lisp.  See below for the main change, marked with "New comment for
diff -Nru acl2-6.2/books/make-event/eval-check.lisp acl2-6.3/books/make-event/eval-check.lisp
--- acl2-6.2/books/make-event/eval-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/eval-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,11 +1,17 @@
-; This is a modification of eval.lisp that uses :check-expansion t.
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (sometime before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
+; This is a modification of community book misc/eval.lisp that uses
+; :check-expansion t.
 
 (in-package "ACL2")
 
 (defmacro must-eval-to (&whole must-eval-to-form
                                form expr)
 
-; Warning: Keep this in sync with the definition of must-eval-to in eval.lisp.
+; Warning: Keep this in sync with the definition of must-eval-to in community
+; book misc/eval.lisp.
 
 ; Form should evaluate to an error triple (mv erp form-val state).  If erp is
 ; nil and expr-val is the value of expr then (must-eval-to form expr) expands
diff -Nru acl2-6.2/books/make-event/eval-tests.lisp acl2-6.3/books/make-event/eval-tests.lisp
--- acl2-6.2/books/make-event/eval-tests.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/eval-tests.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (sometime before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Here we illustrate the must-succeed and must-fail macros, which use
 ; make-event to check that a form evaluates as expected.
 
diff -Nru acl2-6.2/books/make-event/gen-defthm-check.lisp acl2-6.3/books/make-event/gen-defthm-check.lisp
--- acl2-6.2/books/make-event/gen-defthm-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/gen-defthm-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Same as gen-defthm.lisp, except for :check-expansion t.
 
 (in-package "ACL2")
diff -Nru acl2-6.2/books/make-event/gen-defthm.lisp acl2-6.3/books/make-event/gen-defthm.lisp
--- acl2-6.2/books/make-event/gen-defthm.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/gen-defthm.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This file shows how the expansion phase can modify state to generate events.
 ; The macro defthm! below is similar to the macro defthm? from the distributed
 ; book misc/expander.  But defthm? modifies state in a way that cannot be done
diff -Nru acl2-6.2/books/make-event/gen-defun-check.lisp acl2-6.3/books/make-event/gen-defun-check.lisp
--- acl2-6.2/books/make-event/gen-defun-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/gen-defun-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; See gen-defun.lisp.  The only difference here is that we use :check-expansion
 ; t (see comment on that below).
 
diff -Nru acl2-6.2/books/make-event/gen-defun.lisp acl2-6.3/books/make-event/gen-defun.lisp
--- acl2-6.2/books/make-event/gen-defun.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/gen-defun.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This file illustrates how to generate events and event names based on the
 ; current logical world, using make-event.
 
diff -Nru acl2-6.2/books/make-event/local-elided-include.lisp acl2-6.3/books/make-event/local-elided-include.lisp
--- acl2-6.2/books/make-event/local-elided-include.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/local-elided-include.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This book checks that expansions are stored as expected.  The constant below
 ; is what we expect to find for the :expansion-alist field of
 ; local-elided.cert.  The last form in this file shows how we can do useful
diff -Nru acl2-6.2/books/make-event/local-elided.lisp acl2-6.3/books/make-event/local-elided.lisp
--- acl2-6.2/books/make-event/local-elided.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/local-elided.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 ;; [Jared and Sol]: we want to make sure this book gets provisionally certified
diff -Nru acl2-6.2/books/make-event/local-requires-skip-check-include.lisp acl2-6.3/books/make-event/local-requires-skip-check-include.lisp
--- acl2-6.2/books/make-event/local-requires-skip-check-include.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/local-requires-skip-check-include.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Check part of the certificate's :expansion-alist for
 ; local-requires-skip-check.lisp.
 
diff -Nru acl2-6.2/books/make-event/local-requires-skip-check.lisp acl2-6.3/books/make-event/local-requires-skip-check.lisp
--- acl2-6.2/books/make-event/local-requires-skip-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/local-requires-skip-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This book should certify in spite of the fact that identity-macro is not
 ; around on the include-book pass of certify-book, yet we are supplying
 ; :check-expansion arguments.  (We omit some :check-expansion arguments too,
diff -Nru acl2-6.2/books/make-event/macros-skip-proofs-include.acl2 acl2-6.3/books/make-event/macros-skip-proofs-include.acl2
--- acl2-6.2/books/make-event/macros-skip-proofs-include.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/macros-skip-proofs-include.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 ; cert-flags: ? t :skip-proofs-okp t
 (certify-book "macros-skip-proofs-include" ? t :skip-proofs-okp t)
diff -Nru acl2-6.2/books/make-event/macros-skip-proofs-include.lisp acl2-6.3/books/make-event/macros-skip-proofs-include.lisp
--- acl2-6.2/books/make-event/macros-skip-proofs-include.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/macros-skip-proofs-include.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; See macros-skip-proofs.lisp.
 
 (in-package "ACL2")
diff -Nru acl2-6.2/books/make-event/macros-skip-proofs.acl2 acl2-6.3/books/make-event/macros-skip-proofs.acl2
--- acl2-6.2/books/make-event/macros-skip-proofs.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/macros-skip-proofs.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 ; cert-flags: ? t :skip-proofs-okp t
 (certify-book "macros-skip-proofs" ? t :skip-proofs-okp t)
diff -Nru acl2-6.2/books/make-event/macros-skip-proofs.lisp acl2-6.3/books/make-event/macros-skip-proofs.lisp
--- acl2-6.2/books/make-event/macros-skip-proofs.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/macros-skip-proofs.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This is just a little variation macros.lisp that uses skip-proofs.  We check
 ; the expansions in macros-skip-proofs-include.lisp, much as we check
 ; expansions from macros.lisp in macros-include.lisp.
diff -Nru acl2-6.2/books/make-event/macros.lisp acl2-6.3/books/make-event/macros.lisp
--- acl2-6.2/books/make-event/macros.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/macros.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Here are some tests involving macros.  See macros-include.lisp for expected
 ; expansion results.  Each form below is labeled with its position [p] in the
 ; resulting expansion-alist.
diff -Nru acl2-6.2/books/make-event/make-event-keywords-or-exp-check.lisp acl2-6.3/books/make-event/make-event-keywords-or-exp-check.lisp
--- acl2-6.2/books/make-event/make-event-keywords-or-exp-check.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/make-event/make-event-keywords-or-exp-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,178 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, August, 2013
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
+; See make-event-keywords-or-exp.lisp.  We check here that the expansions are
+; stored as expected.
+
+(in-package "ACL2")
+
+(include-book "make-event-keywords-or-exp") ; establishes dependency
+
+(make-event
+ (er-let* ((forms (read-file "make-event-keywords-or-exp.cert" state)))
+   (cond
+    ((equal
+      (cadr (member-eq :expansion-alist forms))
+      '((7 RECORD-EXPANSION
+           (DEFUN-MEASURES F1 (X0 X1 X2 X3)
+             (IF (CONSP X0)
+                 (IF (CONSP X1)
+                     (IF (CONSP X2)
+                         (IF (CONSP X3)
+                             (F1 (CONS X0 X0)
+                                 (CONS X1 X1)
+                                 (CDR X2)
+                                 (CDR X3))
+                             X3)
+                         X2)
+                     X1)
+                 X0))
+           (DEFUN F1 (X0 X1 X2 X3)
+             (DECLARE (XARGS :MEASURE (ACL2-COUNT X2)))
+             (IF (CONSP X0)
+                 (IF (CONSP X1)
+                     (IF (CONSP X2)
+                         (IF (CONSP X3)
+                             (F1 (CONS X0 X0)
+                                 (CONS X1 X1)
+                                 (CDR X2)
+                                 (CDR X3))
+                             X3)
+                         X2)
+                     X1)
+                 X0)))
+        (8
+         RECORD-EXPANSION
+         (DEFUN-MEASURES-CHECK F1C (X0 X1 X2 X3)
+           (IF (CONSP X0)
+               (IF (CONSP X1)
+                   (IF (CONSP X2)
+                       (IF (CONSP X3)
+                           (F1C (CONS X0 X0)
+                                (CONS X1 X1)
+                                (CDR X2)
+                                (CDR X3))
+                           X3)
+                       X2)
+                   X1)
+               X0))
+         (MAKE-EVENT
+          '(:OR (:DO-PROOFS (DEFUN F1C (X0 X1 X2 X3)
+                              (DECLARE (XARGS :MEASURE (ACL2-COUNT X0)))
+                              (IF (CONSP X0)
+                                  (IF (CONSP X1)
+                                      (IF (CONSP X2)
+                                          (IF (CONSP X3)
+                                              (F1C (CONS X0 X0)
+                                                   (CONS X1 X1)
+                                                   (CDR X2)
+                                                   (CDR X3))
+                                              X3)
+                                          X2)
+                                      X1)
+                                  X0)))
+                (:DO-PROOFS (DEFUN F1C (X0 X1 X2 X3)
+                              (DECLARE (XARGS :MEASURE (ACL2-COUNT X1)))
+                              (IF (CONSP X0)
+                                  (IF (CONSP X1)
+                                      (IF (CONSP X2)
+                                          (IF (CONSP X3)
+                                              (F1C (CONS X0 X0)
+                                                   (CONS X1 X1)
+                                                   (CDR X2)
+                                                   (CDR X3))
+                                              X3)
+                                          X2)
+                                      X1)
+                                  X0)))
+                (:DO-PROOFS (DEFUN F1C (X0 X1 X2 X3)
+                              (DECLARE (XARGS :MEASURE (ACL2-COUNT X2)))
+                              (IF (CONSP X0)
+                                  (IF (CONSP X1)
+                                      (IF (CONSP X2)
+                                          (IF (CONSP X3)
+                                              (F1C (CONS X0 X0)
+                                                   (CONS X1 X1)
+                                                   (CDR X2)
+                                                   (CDR X3))
+                                              X3)
+                                          X2)
+                                      X1)
+                                  X0)))
+                (:DO-PROOFS (DEFUN F1C (X0 X1 X2 X3)
+                              (DECLARE (XARGS :MEASURE (ACL2-COUNT X3)))
+                              (IF (CONSP X0)
+                                  (IF (CONSP X1)
+                                      (IF (CONSP X2)
+                                          (IF (CONSP X3)
+                                              (F1C (CONS X0 X0)
+                                                   (CONS X1 X1)
+                                                   (CDR X2)
+                                                   (CDR X3))
+                                              X3)
+                                          X2)
+                                      X1)
+                                  X0))))
+          :CHECK-EXPANSION (DEFUN F1C (X0 X1 X2 X3)
+                             (DECLARE (XARGS :MEASURE (ACL2-COUNT X2)))
+                             (IF (CONSP X0)
+                                 (IF (CONSP X1)
+                                     (IF (CONSP X2)
+                                         (IF (CONSP X3)
+                                             (F1C (CONS X0 X0)
+                                                  (CONS X1 X1)
+                                                  (CDR X2)
+                                                  (CDR X3))
+                                             X3)
+                                         X2)
+                                     X1)
+                                 X0))))
+        (16 RECORD-EXPANSION (VERIFY-GUARDS+ M1)
+            (VERIFY-GUARDS G1))
+        (19 RECORD-EXPANSION
+            (MAKE-EVENT (ER-PROGN (ASSIGN MAKE-EVENT-DEBUG T)
+                                  (VALUE '(VALUE-TRIPLE NIL))))
+            (VALUE-TRIPLE NIL))
+        (20 RECORD-EXPANSION
+            (MAKE-EVENT '(:OR (LOCAL (DEFUN FOO1 (X) X))
+                              (DEFUN NOOP (X) X)))
+            (LOCAL (VALUE-TRIPLE :ELIDED)))
+        (21 RECORD-EXPANSION
+            (MAKE-EVENT
+             (ER-PROGN (VALUE (CW "Here I'm computing with state...~%"))
+                       (VALUE '(MAKE-EVENT '(:OR (LOCAL (DEFUN FOO2 (X) X))
+                                                 (DEFUN NOOP (X) X)))))
+             :EXPANSION? (DEFUN FOO2 (X) X))
+            (LOCAL (VALUE-TRIPLE :ELIDED)))
+        (22 RECORD-EXPANSION
+            (MAKE-EVENT
+             (ER-PROGN (VALUE (CW "Here I'm computing with state...~%"))
+                       (VALUE '(MAKE-EVENT '(:OR (LOCAL (DEFUN FOO3 (X) X))
+                                                 (DEFUN NOOP (X) X))
+                                           :EXPANSION? (DEFUN FOO3 (X) X))))
+             :EXPANSION? (DEFUN FOO3 (X) X))
+            (LOCAL (VALUE-TRIPLE :ELIDED)))
+        (26 RECORD-EXPANSION
+            (MAKE-EVENT '(:OR (DEFUN FOO7 (X) X)
+                              (DEFUN NOOP (X) X))
+                        :EXPANSION? (DEFUN WRONG (X) X)
+                        :CHECK-EXPANSION T)
+            (MAKE-EVENT '(:OR (DEFUN FOO7 (X) X)
+                              (DEFUN NOOP (X) X))
+                        :CHECK-EXPANSION (DEFUN FOO7 (X) X)))
+        (28 RECORD-EXPANSION
+            (MAKE-EVENT '(LOCAL (DEFUN FOO8 (X) X))
+                        :EXPANSION? (DEFUN WRONG (X) X)
+                        :CHECK-EXPANSION T)
+            (MAKE-EVENT '(LOCAL (DEFUN FOO8 (X) X))
+                        :CHECK-EXPANSION (LOCAL (DEFUN FOO8 (X) X))))
+        (29 RECORD-EXPANSION
+            (MAKE-EVENT '(LOCAL (DEFUN FOO8 (X) X))
+                        :EXPANSION? NIL
+                        :CHECK-EXPANSION T)
+            (MAKE-EVENT '(LOCAL (DEFUN FOO8 (X) X))
+                        :CHECK-EXPANSION (LOCAL (DEFUN FOO8 (X) X))))))
+          (value '(value-triple nil)))
+         (t (er soft 'top
+                "Unexpected form in make-event-keywords-or-exp.cert!")))))
diff -Nru acl2-6.2/books/make-event/make-event-keywords-or-exp.lisp acl2-6.3/books/make-event/make-event-keywords-or-exp.lisp
--- acl2-6.2/books/make-event/make-event-keywords-or-exp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/make-event/make-event-keywords-or-exp.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,249 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, August, 2013
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
+; This small, pedagogical example shows how to use the :OR feature of
+; make-event.  The macros defun-measures computes a trivial list of measures
+; for a defun and keeps the first one that works.  A more serious such utility
+; would compute more interesting measures, do much more thorough
+; error-checking, work for defund and defun-nx, perhaps try different
+; :ruler-extenders, and consider what happens when a measure is already
+; provided.  We present a variant, defun-measures-check, to illustrate how one
+; can arrange to check the result at include-book time.  Actually there's
+; no reason I can see to do so in this case, but we illustrate how
+; keyword :check-expansion interacts with keyword :expansion?.
+
+(in-package "ACL2")
+
+(include-book "misc/eval" :dir :system)
+
+(defun add-measures1 (vars name formals rest)
+  (declare (xargs :mode :program))
+  (cond ((endp vars)
+         nil)
+        (t (cons `(defun ,name ,formals
+                    (declare (xargs :measure (acl2-count ,(car vars))))
+                    ,@rest)
+                 (add-measures1 (cdr vars) name formals rest)))))
+
+(defun add-measures (event)
+  (declare (xargs :mode :program))
+  (case-match event
+    (('defun name formals . rest)
+     (add-measures1 formals name formals rest))
+    (& (er hard 'compute-measures
+           "Not a well-formed defun: ~x0"
+           event))))
+
+(defn cons-to-all (a lst)
+  (cond ((atom lst) lst)
+        (t (cons (cons a (car lst))
+                 (cons-to-all a (cdr lst))))))
+
+(defmacro defun-measures (name formals &rest rest)
+
+; The use of :expansion? avoids storing an expansion in the .cert file, in the
+; case that the first event specified with :or turns out to be the expansion.
+
+  (let ((defs (add-measures `(defun ,name ,formals ,@rest))))
+    `(make-event '(:or ,@defs)
+                 :expansion? ,(car defs))))
+
+(defmacro defun-measures-check (name formals &rest rest)
+
+; See also defun-measures.  Here, we add :check-expansion t, to illustrate how
+; we can check expansions.  Notice that we replace each argument of :or, E, by
+; (:do-proofs E), so that when we check the expansion we get the right one.
+; Otherwise, when including a book and checking the expansion, we would be
+; skipping proofs and the first measure would always be the expansion, causing
+; an error in the case that a later measure had instead generated the expansion
+; (which is saved in the .cert file, to check against the expansion recomputed
+; at include-book time).
+
+  (let ((defs (add-measures `(defun ,name ,formals ,@rest))))
+    `(make-event '(:or ,@(cons-to-all :do-proofs (pairlis$ defs nil)))
+                 :expansion? ,(car defs)
+                 :check-expansion t)))
+
+; Here are examples illustrating usage of the above macros.
+
+; The following example generates an expansion that stores the first measure
+; that works, namely, (acl2-count x2).  This shows up in the .cert file; see
+; make-event-keywords-or-exp-check.lisp.
+(defun-measures f1 (x0 x1 x2 x3)
+  (if (consp x0)
+      (if (consp x1)
+          (if (consp x2)
+              (if (consp x3)
+                  (f1 (cons x0 x0) (cons x1 x1) (cdr x2) (cdr x3))
+                x3)
+            x2)
+        x1)
+    x0))
+
+; The next example uses :expansion? as well as :check-expansion t.  The
+; expansion turns out not to match what is specified by :expansion?, so a
+; make-event form is constructed with a cons for :check-expansion and without
+; :expansion?.  See make-event-keywords-or-exp-check.lisp.
+(defun-measures-check f1c (x0 x1 x2 x3)
+  (if (consp x0)
+      (if (consp x1)
+          (if (consp x2)
+              (if (consp x3)
+                  (f1c (cons x0 x0) (cons x1 x1) (cdr x2) (cdr x3))
+                x3)
+            x2)
+        x1)
+    x0))
+
+; Unlike f1, the following example's expansion matches the value of
+; :expansion?.  Therefore no expansion is generated in the .cert file (as
+; checked in make-event-keywords-or-exp-check.lisp).
+(defun-measures f2 (x0 x1 x2 x3)
+  (if (consp x0)
+      (if (consp x1)
+          (if (consp x2)
+              (if (consp x3)
+                  (f2 (cdr x0) (cons x1 x1) (cdr x2) (cdr x3))
+                x3)
+            x2)
+        x1)
+    x0))
+
+; Unlike f1c, the following example's expansion matches the value of
+; :expansion?.  Normally, in the case of original keyword value
+; :check-expansion t, the recorded expansion is stored in the value of
+; :check-expansion.  But that isn't necessary, and isn't done, when the value
+; of :expansion? equals the expansion.  So even though :check-expansion t is
+; specified, no expansion is generated in the .cert file (as checked in
+; make-event-keywords-or-exp-check.lisp).
+(defun-measures-check f2c (x0 x1 x2 x3)
+  (if (consp x0)
+      (if (consp x1)
+          (if (consp x2)
+              (if (consp x3)
+                  (f2c (cdr x0) (cons x1 x1) (cdr x2) (cdr x3))
+                x3)
+            x2)
+        x1)
+    x0))
+
+; Testing verify-guards+
+
+(defun g0 (x)
+  x)
+
+(verify-guards+ g0)
+
+(defun g1 (x)
+  x)
+
+(defmacro m1 (x)
+  x)
+
+(add-macro-alias m1 g1)
+
+(verify-guards+ m1)
+
+(assert-event (eq (symbol-class 'g0 (w state))
+                  :COMMON-LISP-COMPLIANT))
+
+(assert-event (eq (symbol-class 'g1 (w state))
+                  :COMMON-LISP-COMPLIANT))
+
+; Finally, here are some random additional tests to show what is stored in the
+; expansion-alist of the certificate (see also
+; make-event-keywords-or-exp-check.lisp).
+
+; Turn on debugging in case we want to take a look:
+(make-event
+ (er-progn (assign make-event-debug t)
+           (value '(value-triple nil))))
+
+; The next few store an expansion of (LOCAL (VALUE-TRIPLE :ELIDED)).
+
+(make-event
+ '(:or (local (defun foo1 (x) x))
+       (defun noop (x) x)))
+
+(make-event
+ (er-progn
+  (value (cw "Here I'm computing with state...~%"))
+  (value '(make-event
+           '(:or (local (defun foo2 (x) x))
+                 (defun noop (x) x))
+           )))
+ :expansion?
+ (defun foo2 (x) x))
+
+(make-event
+ (er-progn
+  (value (cw "Here I'm computing with state...~%"))
+  (value '(make-event
+           '(:or (local (defun foo3 (x) x))
+                 (defun noop (x) x))
+           :expansion?
+           (defun foo3 (x) x))))
+ :expansion?
+ (defun foo3 (x) x))
+
+; Now let's see what's stored for non-local expansions.
+
+; Nothing stored: :expansion? propagates upward.
+(make-event
+ (er-progn
+  (value (cw "Here I'm computing with state...~%"))
+  (value '(make-event
+           '(:or (defun foo4 (x) x)
+                 (defun noop (x) x))
+           :expansion?
+           (defun foo4 (x) x))))
+ :expansion?
+ (defun foo4 (x) x))
+
+; Nothing stored: :expansion? is correct.
+(make-event
+ '(:or (local (defun foo5 (x) x))
+       (defun noop (x) x))
+ :expansion?
+ (local (defun foo5 (x) x)))
+
+; Nothing stored: :expansion? is correct.
+(make-event
+ '(:or (defun foo6 (x) x)
+       (defun noop (x) x))
+ :expansion?
+ (defun foo6 (x) x)
+ :check-expansion t)
+
+; Expansion is stored with :check-expansion replaced by actual expansoin, since
+; :expansion? is not correct.
+(make-event
+ '(:or (defun foo7 (x) x)
+       (defun noop (x) x))
+ :expansion?
+ (defun wrong (x) x)
+ :check-expansion t)
+
+; Let's try stressing the system by using local events that we might expect to
+; be elided, and yet using :check-expansion to ensure that an expansion is
+; done.  We'll try that sort of thing three times: once with :expansion? right,
+; once with :expansion wrong, and once without :expansion.
+
+(make-event
+ '(local (defun foo8 (x) x))
+ :expansion? ; right
+ (local (defun foo8 (x) x))
+ :check-expansion t)
+
+(make-event
+ '(local (defun foo8 (x) x))
+ :expansion? ; wrong
+ (defun wrong (x) x)
+ :check-expansion t)
+
+(make-event
+ '(local (defun foo8 (x) x))
+ :expansion? ; missing
+ nil
+ :check-expansion t)
diff -Nru acl2-6.2/books/make-event/nested-check.lisp acl2-6.3/books/make-event/nested-check.lisp
--- acl2-6.2/books/make-event/nested-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/nested-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Tests of nesting make-event forms: macros, local, skip-proofs, with-output,
 ; and recursive make-event.
 
diff -Nru acl2-6.2/books/make-event/nested.lisp acl2-6.3/books/make-event/nested.lisp
--- acl2-6.2/books/make-event/nested.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/nested.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Here are some tests for nesting of make-event forms: macros, local,
 ; skip-proofs, with-output, and recursive make-event.
 
diff -Nru acl2-6.2/books/make-event/portcullis-expansion-include.acl2 acl2-6.3/books/make-event/portcullis-expansion-include.acl2
--- acl2-6.2/books/make-event/portcullis-expansion-include.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/portcullis-expansion-include.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (encapsulate
diff -Nru acl2-6.2/books/make-event/portcullis-expansion-include.lisp acl2-6.3/books/make-event/portcullis-expansion-include.lisp
--- acl2-6.2/books/make-event/portcullis-expansion-include.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/portcullis-expansion-include.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Do more testing of redundancy for encapsulate.
 
 (in-package "ACL2")
diff -Nru acl2-6.2/books/make-event/portcullis-expansion.acl2 acl2-6.3/books/make-event/portcullis-expansion.acl2
--- acl2-6.2/books/make-event/portcullis-expansion.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/portcullis-expansion.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (make-event
diff -Nru acl2-6.2/books/make-event/portcullis-expansion.lisp acl2-6.3/books/make-event/portcullis-expansion.lisp
--- acl2-6.2/books/make-event/portcullis-expansion.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/portcullis-expansion.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Here we do a bunch of tests that have generally already been recorded in the
 ; certification world.
 
diff -Nru acl2-6.2/books/make-event/proof-by-arith.lisp acl2-6.3/books/make-event/proof-by-arith.lisp
--- acl2-6.2/books/make-event/proof-by-arith.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/proof-by-arith.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -32,7 +32,9 @@
 (include-book "arithmetic/top-with-meta" :dir :system)
 (include-book "arithmetic-3/top" :dir :system)
 (include-book "rtl/rel8/arithmetic/top" :dir :system)
-(include-book "rtl/rel5/arithmetic/top" :dir :system)
+
+;; [Jared] trying to remove rtl/rel5
+;; (include-book "rtl/rel5/arithmetic/top" :dir :system)
 (include-book "arithmetic-5/top" :dir :system)
 ||#
 
@@ -70,38 +72,25 @@
         hist
         nil))))))
 
-(defun proof-by-arith-1 (event book-alist ctx state)
-  (declare (xargs :mode :program :stobjs state))
+(defun proof-by-arith-1 (event book-alist inh)
+  (declare (xargs :guard (true-list-listp book-alist)))
   (cond
    ((endp book-alist)
-    (silent-error state)) ; (mv t nil state), a soft error
-   (t (let* ((pair (car book-alist))
-             (book (car pair))
-             (extra-events (cdr pair))
-             (in-certify-book (f-get-global 'certify-book-info state))
-             (encap-event
-              `(encapsulate
-                ()
-                (local (include-book ,book :dir :system))
-                ,@extra-events
-                ,event))
-             (final-encap-event
-              (cond (in-certify-book encap-event)
-                    (t `(encapsulate
-                         ()
-                         (local (include-book ,book :dir :system))
-                         (set-inhibit-warnings "Skip-proofs")
-                         (skip-proofs
-                          (encapsulate
-                           ()
-                           ,@extra-events
-                           ,event)))))))
-        (mv-let (erp trans-ans state) ; trans-ans is (cons stobjs-out values)
-                (trans-eval encap-event ctx state t)
-                (cond ((or erp
-                           (car (cdr trans-ans))) ; erp from trans-ans
-                       (proof-by-arith-1 event (cdr book-alist) ctx state))
-                      (t (value final-encap-event))))))))
+    nil)
+   (t (cons (let* ((pair (car book-alist))
+                   (book (car pair))
+                   (extra-events (cdr pair))
+                   (encap `(encapsulate
+                            ()
+                            (local (include-book ,book :dir :system))
+                            ,@extra-events
+                            ,event)))
+              (if inh
+                  `(with-output
+                    :off ,inh
+                    ,encap)
+                encap))
+            (proof-by-arith-1 event (cdr book-alist) inh)))))
 
 (defmacro proof-by-arith (&whole whole-form
                                  event &optional quietp arith-book-alist)
@@ -111,30 +100,16 @@
 ; Note that all of the arguments are taken literally, i.e., none should be
 ; quoted.
 
-  (let ((body `(proof-by-arith-1 ',event
-                                 ,(if arith-book-alist
-                                      (list 'quote arith-book-alist)
-                                    '*default-arith-book-alist*)
-                                 'proof-by-arith
-                                 state)))
-    `(make-event
-      (state-global-let*
-       ((ld-skip-proofsp (if (eq (cert-op state) :write-acl2xu)
-
-; We are doing provisional certification, so we need to save the correct
-; expansion in the .acl2x file.  Normally we do a successful proof twice using
-; proof-by-arith, and that will still hold in this case: once when generating
-; the .acl2x file, and once when generating the .pcert file.
-
-                             nil
-                           (f-get-global 'ld-skip-proofsp state))))
-       ,(if quietp
-            `(er-progn (set-inhibit-output-lst '(prove proof-tree warning
-                                                       observation event
-                                                       expansion summary))
-                       ,body)
-          body))
-      :on-behalf-of ,whole-form)))
+  `(make-event
+    (cons :or (proof-by-arith-1 ',event
+                                ,(if arith-book-alist
+                                     (list 'quote arith-book-alist)
+                                   '*default-arith-book-alist*)
+                                ',(and quietp
+                                       '(prove proof-tree warning
+                                               observation event
+                                               expansion summary))))
+    :on-behalf-of ,whole-form))
 
 ; From John Erickson's email to acl2-help, 4/19/06.
 (proof-by-arith
@@ -173,7 +148,8 @@
        stable-under-simplificationp
        hist
        pspv))))
-  ("rtl/rel5/arithmetic/top")
+  ;; [Jared]: trying to remove rtl/rel5
+  ("rtl/rel8/arithmetic/top")
   ("arithmetic-3/bind-free/top"
    (set-default-hints
     '((nonlinearp-default-hint
diff -Nru acl2-6.2/books/make-event/read-from-file.lisp acl2-6.3/books/make-event/read-from-file.lisp
--- acl2-6.2/books/make-event/read-from-file.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/read-from-file.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; The following example shows how to create events by reading a file.  It was
 ; constructed in response to a potential application suggested by David Rager
 ; and Sandip Ray.
diff -Nru acl2-6.2/books/make-event/stobj-test.acl2 acl2-6.3/books/make-event/stobj-test.acl2
--- acl2-6.2/books/make-event/stobj-test.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/stobj-test.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 ; cert-flags: ? t :acl2x t
 ; cert_param: (acl2x)
diff -Nru acl2-6.2/books/make-event/stobj-test.lisp acl2-6.3/books/make-event/stobj-test.lisp
--- acl2-6.2/books/make-event/stobj-test.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/stobj-test.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This book tests the interaction of make-event with stobjs.  Up through ACL2
 ; 3.0.1 this book failed to certify, as explained in the "Technical remark"
 ; below.
diff -Nru acl2-6.2/books/make-event/test-case-check.lisp acl2-6.3/books/make-event/test-case-check.lisp
--- acl2-6.2/books/make-event/test-case-check.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/test-case-check.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This is like test-case.lisp, except it uses assert!! (which uses
 ; :check-expansion t) rather than assert!.
 
diff -Nru acl2-6.2/books/make-event/test-case.lisp acl2-6.3/books/make-event/test-case.lisp
--- acl2-6.2/books/make-event/test-case.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/make-event/test-case.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Sandip Ray suggested that we might want to be able to evaluate arbitrary
 ; forms, but in this file, test-case should be applied to forms that return a
 ; single non-stobj value.
diff -Nru acl2-6.2/books/make-targets acl2-6.3/books/make-targets
--- acl2-6.2/books/make-targets	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/make-targets	1970-01-01 00:00:00.000000000 +0000
@@ -1,1710 +0,0 @@
-# This file is a list of certificate files generated by building the
-# ACL2 system books; it was created by running:
-# make clean
-# make all-plus
-# find . -name '*.cert' | sort > make-targets".
-
-# This file provides the list of targets to be built by cert.pl, a
-# build system for ACL2 books.  Cert.pl requires a list of targets to
-# be built; it generates the dependencies for these targets and,
-# recursively, any other books they depend on.  So this list of files
-# could be pruned, potentially, to only the "top level" books in each
-# library.  To allow new libraries to be built with cert.pl using this
-# list, only the top-level books of these libraries need to be added.
-
-# In order to make this work with cert.pl, we have commented out
-# certain lines corresponding to files whose dependencies couldn't be
-# correctly determined (i.e., their certification failed when we
-# attempted one of the commands below.) Also, any directory containing
-# a file named cert_pl_exclude is excluded even if targets within that
-# directory are listed here.  Some notes on the excluded files and
-# directories are below.
-
-# To certify the books listed here cert.pl, you can run:
-
-# ./cert.pl -j <number of processes>       \
-#           --targets make-targets   \
-#           --acl2 <acl2 executable>
-
-# To do this without stopping on errors, you can pass the --keep-going
-# argument to make by adding "--make-args --keep-going" to the above
-# command line.
-
-
-# To create a static stand-alone makefile (usable in systems without
-# Perl) for these targets, you can run:
-
-# ./cert.pl -s <makefile-name>             \
-#           --targets make-targets   \
-#           --acl2 <acl2 executable>
-
-# or to create a static makefile that only contains dependency
-# information and omits everything else, e.g. the rule for making a
-# cert file, run:
-
-# ./cert.pl -s <makefile-name>             \
-#           --targets make-targets   \
-#           --no-boilerplate
-
-# The file created by this command contains a list of the certificate
-# files to be created (stored in variable CERT_PL_CERTS) and their
-# dependencies.  This is suitable for inclusion in some other makefile
-# that includes the necessary rules and perhaps additional targets.
-# (Usually cert.pl creates a makefile that includes the file
-# make_cert, which provides a rule to make cert files, and defines the
-# "all" target as the entire list of certificates.)  If the additional
-# option --collect-sources is provided, the list of all source files
-# necessary for making the certificates is stored in variable
-# CERT_PL_SOURCES.
-
-
-# Excluded files:
-# benchmarks.lisp is a generated file, evidently:
-# ./bdd/benchmarks.cert
-
-# Excluded directories:
-# fix-cert:  Uses a custom makefile that moves some certificates
-#            around, among other things.
-
-#    Files omitted due to excluded directories:
-# ./fix-cert/fix-cert.cert
-# ./fix-cert/moved/test1.cert
-# ./fix-cert/moved/test1b.cert
-# ./fix-cert/moved/test1bb.cert
-# ./fix-cert/moved/test1bp.cert
-# ./fix-cert/moved/test1p.cert
-# ./fix-cert/moved/test1pb.cert
-# ./fix-cert/moved/test1pp.cert
-# ./fix-cert/moved/test2.cert
-# ./fix-cert/test-fix-cert0.cert
-# ./fix-cert/test-fix-cert1.cert
-# ./fix-cert/test-fix-cert2.cert
-# ./fix-cert/test1.cert
-# ./fix-cert/test1b.cert
-# ./fix-cert/test1bb.cert
-# ./fix-cert/test1bp.cert
-# ./fix-cert/test1p.cert
-# ./fix-cert/test1pb.cert
-# ./fix-cert/test1pp.cert
-# ./fix-cert/test2.cert
-
-
-# Now the list of certificates:
-
-./arithmetic-2/floor-mod/floor-mod-helper.cert
-./arithmetic-2/floor-mod/floor-mod.cert
-./arithmetic-2/meta/cancel-terms-helper.cert
-./arithmetic-2/meta/cancel-terms-meta.cert
-./arithmetic-2/meta/collect-terms-meta.cert
-./arithmetic-2/meta/common-meta.cert
-./arithmetic-2/meta/expt-helper.cert
-./arithmetic-2/meta/expt.cert
-./arithmetic-2/meta/integerp-meta.cert
-./arithmetic-2/meta/integerp.cert
-./arithmetic-2/meta/mini-theories.cert
-./arithmetic-2/meta/non-linear.cert
-./arithmetic-2/meta/numerator-and-denominator.cert
-./arithmetic-2/meta/post.cert
-./arithmetic-2/meta/pre.cert
-./arithmetic-2/meta/top.cert
-./arithmetic-2/pass1/basic-arithmetic-helper.cert
-./arithmetic-2/pass1/basic-arithmetic.cert
-./arithmetic-2/pass1/expt-helper.cert
-./arithmetic-2/pass1/expt.cert
-./arithmetic-2/pass1/inequalities.cert
-./arithmetic-2/pass1/mini-theories.cert
-./arithmetic-2/pass1/numerator-and-denominator-helper.cert
-./arithmetic-2/pass1/numerator-and-denominator.cert
-./arithmetic-2/pass1/prefer-times.cert
-./arithmetic-2/pass1/top.cert
-./arithmetic-3/bind-free/arithmetic-theory.cert
-./arithmetic-3/bind-free/banner.cert
-./arithmetic-3/bind-free/basic-helper.cert
-./arithmetic-3/bind-free/basic.cert
-./arithmetic-3/bind-free/building-blocks.cert
-./arithmetic-3/bind-free/collect.cert
-./arithmetic-3/bind-free/common.cert
-./arithmetic-3/bind-free/default-hint.cert
-./arithmetic-3/bind-free/integerp-meta.cert
-./arithmetic-3/bind-free/integerp.cert
-./arithmetic-3/bind-free/mini-theories-helper.cert
-./arithmetic-3/bind-free/mini-theories.cert
-./arithmetic-3/bind-free/normalize.cert
-./arithmetic-3/bind-free/numerator-and-denominator.cert
-./arithmetic-3/bind-free/remove-weak-inequalities.cert
-./arithmetic-3/bind-free/simplify-helper.cert
-./arithmetic-3/bind-free/simplify.cert
-./arithmetic-3/bind-free/top.cert
-./arithmetic-3/extra/ext.cert
-./arithmetic-3/extra/top-ext.cert
-./arithmetic-3/floor-mod/floor-mod.cert
-./arithmetic-3/floor-mod/mod-expt-fast.cert
-./arithmetic-3/pass1/basic-arithmetic-helper.cert
-./arithmetic-3/pass1/basic-arithmetic.cert
-./arithmetic-3/pass1/expt-helper.cert
-./arithmetic-3/pass1/expt.cert
-./arithmetic-3/pass1/inequalities.cert
-./arithmetic-3/pass1/mini-theories.cert
-./arithmetic-3/pass1/non-linear.cert
-./arithmetic-3/pass1/num-and-denom-helper.cert
-./arithmetic-3/pass1/numerator-and-denominator.cert
-./arithmetic-3/pass1/prefer-times.cert
-./arithmetic-3/pass1/top.cert
-./arithmetic-3/top.cert
-./arithmetic-5/lib/basic-ops/arithmetic-theory.cert
-./arithmetic-5/lib/basic-ops/banner.cert
-./arithmetic-5/lib/basic-ops/basic.cert
-./arithmetic-5/lib/basic-ops/building-blocks-helper.cert
-./arithmetic-5/lib/basic-ops/building-blocks.cert
-./arithmetic-5/lib/basic-ops/collect.cert
-./arithmetic-5/lib/basic-ops/common.cert
-./arithmetic-5/lib/basic-ops/default-hint.cert
-./arithmetic-5/lib/basic-ops/distributivity.cert
-./arithmetic-5/lib/basic-ops/dynamic-e-d.cert
-./arithmetic-5/lib/basic-ops/elim-hint.cert
-./arithmetic-5/lib/basic-ops/expt-helper.cert
-./arithmetic-5/lib/basic-ops/expt.cert
-./arithmetic-5/lib/basic-ops/forcing-types.cert
-./arithmetic-5/lib/basic-ops/if-normalization.cert
-./arithmetic-5/lib/basic-ops/integerp-helper.cert
-./arithmetic-5/lib/basic-ops/integerp-meta.cert
-./arithmetic-5/lib/basic-ops/integerp.cert
-./arithmetic-5/lib/basic-ops/mini-theories.cert
-./arithmetic-5/lib/basic-ops/natp-posp.cert
-./arithmetic-5/lib/basic-ops/normalize.cert
-./arithmetic-5/lib/basic-ops/numerator-and-denominator.cert
-./arithmetic-5/lib/basic-ops/remove-weak-inequalities.cert
-./arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.cert
-./arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert
-./arithmetic-5/lib/basic-ops/simplify-helper.cert
-./arithmetic-5/lib/basic-ops/simplify.cert
-./arithmetic-5/lib/basic-ops/top.cert
-./arithmetic-5/lib/basic-ops/types-helper.cert
-./arithmetic-5/lib/basic-ops/types.cert
-./arithmetic-5/lib/basic-ops/we-are-here.cert
-./arithmetic-5/lib/floor-mod/floor-mod-basic-helper.cert
-./arithmetic-5/lib/floor-mod/floor-mod-basic.cert
-./arithmetic-5/lib/floor-mod/floor-mod-helper.cert
-./arithmetic-5/lib/floor-mod/floor-mod.cert
-./arithmetic-5/lib/floor-mod/forcing-types.cert
-./arithmetic-5/lib/floor-mod/if-normalization.cert
-./arithmetic-5/lib/floor-mod/logand-helper.cert
-./arithmetic-5/lib/floor-mod/logand.cert
-./arithmetic-5/lib/floor-mod/mod-expt-fast.cert
-./arithmetic-5/lib/floor-mod/more-floor-mod.cert
-./arithmetic-5/lib/floor-mod/top.cert
-./arithmetic-5/lib/floor-mod/truncate-rem.cert
-./arithmetic-5/support/basic-arithmetic-helper.cert
-./arithmetic-5/support/basic-arithmetic.cert
-./arithmetic-5/support/expt-helper.cert
-./arithmetic-5/support/expt.cert
-./arithmetic-5/support/inequalities.cert
-./arithmetic-5/support/mini-theories.cert
-./arithmetic-5/support/non-linear.cert
-./arithmetic-5/support/num-and-denom-helper.cert
-./arithmetic-5/support/numerator-and-denominator.cert
-./arithmetic-5/support/prefer-times.cert
-./arithmetic-5/support/top.cert
-./arithmetic-5/top.cert
-./arithmetic/abs.cert
-./arithmetic/binomial.cert
-./arithmetic/equalities.cert
-./arithmetic/factorial.cert
-./arithmetic/idiv.cert
-./arithmetic/inequalities.cert
-./arithmetic/mod-gcd.cert
-./arithmetic/natp-posp.cert
-./arithmetic/rational-listp.cert
-./arithmetic/rationals.cert
-./arithmetic/sumlist.cert
-./arithmetic/top-with-meta.cert
-./arithmetic/top.cert
-./bdd/alu-proofs.cert
-./bdd/alu.cert
-./bdd/bdd-primitives.cert
-./bdd/bool-ops.cert
-./bdd/cbf.cert
-./bdd/hamming.cert
-./bdd/pg-theory.cert
-./clause-processors/basic-examples.cert
-./clause-processors/bv-add-common.cert
-./clause-processors/bv-add-tests.cert
-./clause-processors/bv-add.cert
-./clause-processors/decomp-hint.cert
-./clause-processors/equality.cert
-./clause-processors/generalize.cert
-./clause-processors/join-thms.cert
-./clause-processors/multi-env-trick.cert
-./clause-processors/null-fail-hints.cert
-./clause-processors/nvalues-thms.cert
-./clause-processors/replace-defined-consts.cert
-./clause-processors/replace-impl.cert
-./clause-processors/use-by-hint.cert
-./coi/adviser/adviser-pkg.cert
-./coi/adviser/adviser.cert
-./coi/adviser/test.cert
-./coi/alists/alist-pkg.cert
-./coi/alists/bindequiv.cert
-./coi/alists/clearkey.cert
-./coi/alists/deshadow.cert
-./coi/alists/equiv.cert
-./coi/alists/keyquiv.cert
-./coi/alists/preimage.cert
-./coi/alists/strip.cert
-./coi/alists/subkeyquiv.cert
-./coi/alists/top.cert
-./coi/bags/basic.cert
-./coi/bags/bind-free-rules.cert
-./coi/bags/cons.cert
-./coi/bags/eric-meta.cert
-./coi/bags/extras.cert
-./coi/bags/meta.cert
-./coi/bags/neq.cert
-./coi/bags/pick-a-point.cert
-./coi/bags/top.cert
-./coi/bags/two-level-meta.cert
-./coi/bags/two-level.cert
-./coi/defpun/ack.cert
-./coi/defpun/defminterm.cert
-./coi/defpun/defpun.cert
-./coi/defpun/defxch.cert
-./coi/defstructure/defstructure-pkg.cert
-./coi/defstructure/defstructure.cert
-./coi/dtrees/base.cert
-./coi/dtrees/child.cert
-./coi/dtrees/deps.cert
-./coi/dtrees/equiv.cert
-./coi/dtrees/erase.cert
-./coi/dtrees/leafp.cert
-./coi/dtrees/raw.cert
-./coi/dtrees/royalp.cert
-./coi/dtrees/set.cert
-./coi/dtrees/top.cert
-./coi/gacc/abstract-gacc.cert
-./coi/gacc/addr-range.cert
-./coi/gacc/bits.cert
-./coi/gacc/block.cert
-./coi/gacc/finite.cert
-./coi/gacc/fr-path-connection.cert
-./coi/gacc/gacc-exports.cert
-./coi/gacc/gacc-pkg.cert
-./coi/gacc/gacc.cert
-./coi/gacc/gacc2.cert
-./coi/gacc/gacc3.cert
-./coi/gacc/gax.cert
-./coi/gacc/list-ops-common.cert
-./coi/gacc/list-ops-fast.cert
-./coi/gacc/list-ops.cert
-./coi/gacc/mem-fast.cert
-./coi/gacc/mem.cert
-./coi/gacc/ram.cert
-./coi/gacc/ram0.cert
-./coi/gacc/ram2.cert
-./coi/gacc/ram2b.cert
-./coi/gacc/ram3.cert
-./coi/gacc/top.cert
-./coi/gacc/tr-path-connection.cert
-./coi/gacc/wrap.cert
-./coi/lists/acl2-count.cert
-./coi/lists/basic.cert
-./coi/lists/disjoint.cert
-./coi/lists/find-index.cert
-./coi/lists/list-top.cert
-./coi/lists/listset-induction.cert
-./coi/lists/map-cons.cert
-./coi/lists/memberp.cert
-./coi/lists/mixed.cert
-./coi/lists/mv-nth.cert
-./coi/lists/nth-and-update-nth.cert
-./coi/lists/nth-meta.cert
-./coi/lists/nth-meta2.cert
-./coi/lists/remove-induction.cert
-./coi/lists/remove.cert
-./coi/lists/repeat.cert
-./coi/lists/set.cert
-./coi/lists/subsetp.cert
-./coi/lists/update-nth-array.cert
-./coi/maps/aliases.cert
-./coi/maps/maps.cert
-./coi/maps/typed-maps.cert
-./coi/nary/example.cert
-./coi/nary/nary.cert
-./coi/nary/nth-rules.cert
-./coi/nary/ordinal-order.cert
-./coi/nary/rewrite-equal-hint.cert
-./coi/osets/computed-hints.cert
-./coi/osets/conversions.cert
-./coi/osets/extras.cert
-./coi/osets/fast.cert
-./coi/osets/instance.cert
-./coi/osets/listsets.cert
-./coi/osets/map.cert
-./coi/osets/membership.cert
-./coi/osets/multiappend.cert
-./coi/osets/multicons.cert
-./coi/osets/outer.cert
-./coi/osets/primitives.cert
-./coi/osets/quantify.cert
-./coi/osets/set-order.cert
-./coi/osets/set-processor.cert
-./coi/osets/sets.cert
-./coi/osets/sort.cert
-./coi/paths/compatibility.cert
-./coi/paths/cp-set.cert
-./coi/paths/defs.cert
-./coi/paths/diverge.cert
-./coi/paths/dominates.cert
-./coi/paths/equiv.cert
-./coi/paths/hints.cert
-./coi/paths/list-path-connection.cert
-./coi/paths/meta.cert
-./coi/paths/path.cert
-./coi/paths/pm.cert
-./coi/records/defarray.cert
-./coi/records/defrecord-fast.cert
-./coi/records/defrecord.cert
-./coi/records/domain.cert
-./coi/records/fixedpoint.cert
-./coi/records/mem-domain.cert
-./coi/records/memory.cert
-./coi/records/record-exports.cert
-./coi/records/records.cert
-./coi/records/set-domain.cert
-./coi/super-ihs/arithmetic.cert
-./coi/super-ihs/ash.cert
-./coi/super-ihs/basics.cert
-./coi/super-ihs/bit-functions.cert
-./coi/super-ihs/bit-twiddling-logops.cert
-./coi/super-ihs/byte-p.cert
-./coi/super-ihs/c-functions.cert
-./coi/super-ihs/carry.cert
-./coi/super-ihs/eric.cert
-./coi/super-ihs/evenp.cert
-./coi/super-ihs/fast.cert
-./coi/super-ihs/from-rtl.cert
-./coi/super-ihs/hacks.cert
-./coi/super-ihs/inductions.cert
-./coi/super-ihs/iter-sqrt.cert
-./coi/super-ihs/logapp.cert
-./coi/super-ihs/logbit.cert
-./coi/super-ihs/logbitp.cert
-./coi/super-ihs/logcar.cert
-./coi/super-ihs/logcdr.cert
-./coi/super-ihs/logcons.cert
-./coi/super-ihs/logext.cert
-./coi/super-ihs/loghead.cert
-./coi/super-ihs/logical-logops.cert
-./coi/super-ihs/logior-logapp-crock.cert
-./coi/super-ihs/loglist.cert
-./coi/super-ihs/logpair.cert
-./coi/super-ihs/logtail.cert
-./coi/super-ihs/lshu.cert
-./coi/super-ihs/meta.cert
-./coi/super-ihs/min-max.cert
-./coi/super-ihs/plus-logapp-suck.cert
-./coi/super-ihs/signed-byte-p-overflow.cert
-./coi/super-ihs/super-ihs.cert
-./coi/super-ihs/unsigned-byte-p.cert
-./coi/symbol-fns/symbol-fns-exports.cert
-./coi/symbol-fns/symbol-fns.cert
-./coi/syntax/auxilary.cert
-./coi/syntax/defbinding.cert
-./coi/syntax/defevaluator.cert
-./coi/syntax/quine.cert
-./coi/syntax/syn-pkg.cert
-./coi/syntax/syntax-extensions.cert
-./coi/syntax/syntax.cert
-./coi/util/clause-processor.cert
-./coi/util/debug.cert
-./coi/util/defbinding.cert
-./coi/util/defdoc.cert
-./coi/util/deffix.cert
-./coi/util/defsubtype.cert
-./coi/util/defun-support.cert
-./coi/util/defun.cert
-./coi/util/extra-info-test.cert
-./coi/util/extra-info.cert
-./coi/util/fixequiv.cert
-./coi/util/good-rewrite-order.cert
-./coi/util/ifdef.cert
-./coi/util/iff.cert
-./coi/util/ifixequiv.cert
-./coi/util/implies.cert
-./coi/util/in-conclusion.cert
-./coi/util/ith.cert
-./coi/util/mv-nth.cert
-./coi/util/nfixequiv.cert
-./coi/util/ordinal-order.cert
-./coi/util/pseudo-translate.cert
-./coi/util/recursion-support.cert
-./coi/util/rewrite-equiv.cert
-./coi/util/rule-sets-documentation.cert
-./coi/util/rule-sets-support.cert
-./coi/util/rule-sets.cert
-./coi/util/skip-rewrite.cert
-./coi/util/syntaxp.cert
-./coi/util/table.cert
-./concurrent-programs/bakery/apply-total-order.cert
-./concurrent-programs/bakery/fairenv.cert
-./concurrent-programs/bakery/final-theorems.cert
-./concurrent-programs/bakery/initial-state.cert
-./concurrent-programs/bakery/inv-persists.cert
-./concurrent-programs/bakery/inv-sufficient.cert
-./concurrent-programs/bakery/labels.cert
-./concurrent-programs/bakery/lexicographic-pos.cert
-./concurrent-programs/bakery/lexicographic.cert
-./concurrent-programs/bakery/measures.cert
-./concurrent-programs/bakery/pos-temp.cert
-./concurrent-programs/bakery/programs.cert
-./concurrent-programs/bakery/properties-of-sets.cert
-./concurrent-programs/bakery/properties.cert
-./concurrent-programs/bakery/records.cert
-./concurrent-programs/bakery/stutter1-match.cert
-./concurrent-programs/bakery/stutter2.cert
-./concurrent-programs/bakery/variables.cert
-./concurrent-programs/german-protocol/german.cert
-./cowles/acl2-agp.cert
-./cowles/acl2-asg.cert
-./cowles/acl2-crg.cert
-./data-structures/alist-defthms.cert
-./data-structures/alist-defuns.cert
-./data-structures/alist-theory.cert
-./data-structures/array1.cert
-./data-structures/defalist.cert
-./data-structures/deflist.cert
-./data-structures/list-defthms.cert
-./data-structures/list-defuns.cert
-./data-structures/list-theory.cert
-./data-structures/memories/log2.cert
-./data-structures/memories/memory-impl.cert
-./data-structures/memories/memory.cert
-./data-structures/memories/memtree.cert
-./data-structures/memories/private.cert
-./data-structures/number-list-defthms.cert
-./data-structures/number-list-defuns.cert
-./data-structures/number-list-theory.cert
-./data-structures/set-defthms.cert
-./data-structures/set-defuns.cert
-./data-structures/set-theory.cert
-./data-structures/structures.cert
-./data-structures/utilities.cert
-./deduction/passmore/bewijs.cert
-./deduction/passmore/general.cert
-./deduction/passmore/paramod.cert
-./deduction/passmore/prover.cert
-./deduction/passmore/resolution.cert
-./deduction/passmore/unification.cert
-./deduction/passmore/weighting.cert
-./defexec/dag-unification/basic.cert
-./defexec/dag-unification/dag-unification-l.cert
-./defexec/dag-unification/dag-unification-rules.cert
-./defexec/dag-unification/dag-unification-st.cert
-./defexec/dag-unification/dags.cert
-./defexec/dag-unification/list-unification-rules.cert
-./defexec/dag-unification/matching.cert
-./defexec/dag-unification/subsumption-subst.cert
-./defexec/dag-unification/subsumption.cert
-./defexec/dag-unification/terms-as-dag.cert
-./defexec/dag-unification/terms-dag-stobj.cert
-./defexec/dag-unification/terms.cert
-./defexec/defpun-exec/defpun-exec.cert
-./defexec/find-path/fpst.cert
-./defexec/find-path/graph/find-path1.cert
-./defexec/find-path/graph/find-path2.cert
-./defexec/find-path/graph/find-path3.cert
-./defexec/find-path/graph/helpers.cert
-./defexec/find-path/graph/linear-find-path.cert
-./defexec/find-path/run-fpst.cert
-./defexec/ordinals/supporting-ordinals.cert
-./defexec/other-apps/misc/memos.cert
-./defexec/other-apps/misc/stobjsim.cert
-./defexec/other-apps/qsort/extraction.cert
-./defexec/other-apps/qsort/final-theorem.cert
-./defexec/other-apps/qsort/first-last.cert
-./defexec/other-apps/qsort/intermediate-program.cert
-./defexec/other-apps/qsort/intermediate-to-spec.cert
-./defexec/other-apps/qsort/load-extract.cert
-./defexec/other-apps/qsort/merge-intermediate.cert
-./defexec/other-apps/qsort/nth-update-nth.cert
-./defexec/other-apps/qsort/permutations.cert
-./defexec/other-apps/qsort/programs.cert
-./defexec/other-apps/qsort/sort-qs-properties.cert
-./defexec/other-apps/qsort/spec-properties.cert
-./defexec/other-apps/qsort/split-qs-properties.cert
-./defexec/other-apps/qsort/total-order.cert
-./defexec/other-apps/records/inline.cert
-./defexec/other-apps/records/records.cert
-./defexec/other-apps/records/recordsim.cert
-./defexec/reflexive/reflexive.cert
-./defsort/defsort.cert
-./defsort/duplicated-members.cert
-./defsort/duplicity.cert
-./defsort/examples.cert
-./defsort/generic-impl.cert
-./defsort/generic.cert
-./defsort/remove-dups.cert
-./defsort/uniquep.cert
-./finite-set-theory/osets/computed-hints.cert
-./finite-set-theory/osets/fast.cert
-./finite-set-theory/osets/instance.cert
-./finite-set-theory/osets/map.cert
-./finite-set-theory/osets/membership.cert
-./finite-set-theory/osets/outer.cert
-./finite-set-theory/osets/primitives.cert
-./finite-set-theory/osets/quantify.cert
-./finite-set-theory/osets/set-order.cert
-./finite-set-theory/osets/sets.cert
-./finite-set-theory/osets/sort.cert
-./finite-set-theory/set-theory.cert
-./finite-set-theory/total-ordering.cert
-./fix-cert/fix-cert.cert
-./fix-cert/moved/test1.cert
-./fix-cert/moved/test1b.cert
-./fix-cert/moved/test1bb.cert
-./fix-cert/moved/test1bp.cert
-./fix-cert/moved/test1p.cert
-./fix-cert/moved/test1pb.cert
-./fix-cert/moved/test1pp.cert
-./fix-cert/moved/test2.cert
-./fix-cert/test-fix-cert0.cert
-./fix-cert/test-fix-cert1.cert
-./fix-cert/test-fix-cert2.cert
-./fix-cert/test1.cert
-./fix-cert/test1b.cert
-./fix-cert/test1bb.cert
-./fix-cert/test1bp.cert
-./fix-cert/test1p.cert
-./fix-cert/test1pb.cert
-./fix-cert/test1pp.cert
-./fix-cert/test2.cert
-./hacking/all.cert
-./hacking/bridge.cert
-./hacking/defcode.cert
-./hacking/defstruct-parsing.cert
-./hacking/dynamic-make-event-test.cert
-./hacking/dynamic-make-event.cert
-./hacking/evalable-ld-printing.cert
-./hacking/hacker.cert
-./hacking/progn-bang-enh.cert
-./hacking/raw.cert
-./hacking/redefun.cert
-./hacking/rewrite-code.cert
-./hacking/subsumption.cert
-./hacking/table-guard.cert
-./hints/basic-tests.cert
-./hints/consider-hint-tests.cert
-./hints/consider-hint.cert
-./hints/huet-lang-algorithm-tests.cert
-./hints/huet-lang-algorithm.cert
-./hints/merge-hint.cert
-./hons-archive/hons-archive.cert
-./ihs/@logops.cert
-./ihs/ihs-definitions.cert
-./ihs/ihs-init.cert
-./ihs/ihs-lemmas.cert
-./ihs/ihs-theories.cert
-./ihs/logops-definitions.cert
-./ihs/logops-lemmas.cert
-./ihs/math-lemmas.cert
-./ihs/quotient-remainder-lemmas.cert
-./make-event/assert-check-include-1.cert
-./make-event/assert-check-include.cert
-./make-event/assert-check.cert
-./make-event/assert-include.cert
-./make-event/assert.cert
-./make-event/basic-check.cert
-./make-event/basic-pkg-check.cert
-./make-event/basic-pkg.cert
-./make-event/basic.cert
-./make-event/defconst-fast-examples.cert
-./make-event/defconst-fast.cert
-./make-event/defrefine.cert
-./make-event/defspec.cert
-./make-event/dotimes.cert
-./make-event/embeddable-event-forms.cert
-./make-event/eval-check-tests.cert
-./make-event/eval-check.cert
-./make-event/eval-tests.cert
-./make-event/eval.cert
-./make-event/gen-defthm-check.cert
-./make-event/gen-defthm.cert
-./make-event/gen-defun-check.cert
-./make-event/gen-defun.cert
-./make-event/inline-book.cert
-./make-event/local-elided-include.cert
-./make-event/local-elided.cert
-./make-event/local-requires-skip-check-include.cert
-./make-event/local-requires-skip-check.cert
-./make-event/logical-tangent.cert
-./make-event/macros-include.cert
-./make-event/macros-skip-proofs-include.cert
-./make-event/macros-skip-proofs.cert
-./make-event/macros.cert
-./make-event/make-redundant.cert
-./make-event/nested-check.cert
-./make-event/nested.cert
-./make-event/portcullis-expansion-include.cert
-./make-event/portcullis-expansion.cert
-./make-event/proof-by-arith.cert
-./make-event/read-from-file.cert
-./make-event/require-book.cert
-./make-event/stobj-test.cert
-./make-event/test-case-check.cert
-./make-event/test-case.cert
-./meta/meta-plus-equal.cert
-./meta/meta-plus-lessp.cert
-./meta/meta-times-equal.cert
-./meta/meta.cert
-./meta/pseudo-termp-lemmas.cert
-./meta/term-defuns.cert
-./meta/term-lemmas.cert
-./misc/bash.cert
-./misc/beta-reduce.cert
-./misc/book-thms.cert
-./misc/computed-hint-rewrite.cert
-./misc/computed-hint.cert
-./misc/csort.cert
-./misc/definline.cert
-./misc/defmac.cert
-./misc/defopener.cert
-./misc/defp.cert
-./misc/defpun.cert
-./misc/dft-ex.cert
-./misc/dft.cert
-./misc/dump-events.cert
-./misc/evalable-printing.cert
-./misc/expander.cert
-./misc/fast-coerce.cert
-./misc/fibonacci.cert
-./misc/file-io.cert
-./misc/find-lemmas.cert
-./misc/gentle.cert
-./misc/getprop.cert
-./misc/goodstein.cert
-./misc/grcd.cert
-./misc/hanoi.cert
-./misc/hons-help.cert
-./misc/hons-help2.cert
-./misc/hons-tests.cert
-./misc/how-to-prove-thms.cert
-./misc/int-division.cert
-./misc/integer-type-set-test.cert
-./misc/invariants.cert
-./misc/meta-lemmas.cert
-./misc/misc2/defpun-exec-domain-example.cert
-./misc/misc2/misc.cert
-./misc/misc2/reverse-by-separation.cert
-./misc/misc2/ruler-extenders-tests.cert
-./misc/mult.cert
-./misc/oprof.cert
-./misc/priorities.cert
-./misc/problem13.cert
-./misc/process-book-readme.cert
-./misc/qi-correct.cert
-./misc/qi.cert
-./misc/radix.cert
-./misc/random.cert
-./misc/records.cert
-./misc/records0.cert
-./misc/redef-pkg.cert
-./misc/rtl-untranslate.cert
-./misc/seq.cert
-./misc/seqw.cert
-./misc/simplify-defuns.cert
-./misc/simplify-thm.cert
-./misc/sin-cos.cert
-./misc/sort-symbols.cert
-./misc/sticky-disable.cert
-./misc/symbol-btree.cert
-./misc/total-order.cert
-./misc/trace-star.cert
-./misc/trace1.cert
-./misc/transfinite.cert
-./misc/untranslate-patterns.cert
-./misc/wet.cert
-./models/jvm/m5/apprentice-state.cert
-./models/jvm/m5/demo.cert
-./models/jvm/m5/idemo.cert
-./models/jvm/m5/infinite-fair-schedule.cert
-./models/jvm/m5/isort.cert
-./models/jvm/m5/jvm-fact-setup.cert
-./models/jvm/m5/m5.cert
-./models/jvm/m5/partial.cert
-./models/jvm/m5/perm.cert
-./models/jvm/m5/universal-never-returns.cert
-./models/jvm/m5/universal.cert
-./models/jvm/m5/utilities.cert
-./ordinals/e0-ordinal.cert
-./ordinals/lexicographic-ordering.cert
-./ordinals/limits.cert
-./ordinals/ordinal-addition.cert
-./ordinals/ordinal-basic-thms.cert
-./ordinals/ordinal-counter-examples.cert
-./ordinals/ordinal-definitions.cert
-./ordinals/ordinal-exponentiation.cert
-./ordinals/ordinal-isomorphism.cert
-./ordinals/ordinal-multiplication.cert
-./ordinals/ordinal-total-order.cert
-./ordinals/ordinals-without-arithmetic.cert
-./ordinals/ordinals.cert
-./ordinals/proof-of-well-foundedness.cert
-./ordinals/top-with-meta.cert
-./paco/database.cert
-./paco/elim-dest.cert
-./paco/foundations.cert
-./paco/induct.cert
-./paco/output-module.cert
-./paco/paco.cert
-./paco/prove.cert
-./paco/rewrite.cert
-./paco/simplify.cert
-./paco/type-set.cert
-./paco/utilities.cert
-./parallel/fibonacci.cert
-./parallel/matrix-multiplication-parallel.cert
-./parallel/matrix-multiplication-serial.cert
-./parallel/matrix-multiplication-setup.cert
-./parallel/syntax-tests.cert
-./powerlists/algebra.cert
-./powerlists/batcher-sort.cert
-./powerlists/bitonic-sort.cert
-./powerlists/cla-adder.cert
-./powerlists/gray-code.cert
-./powerlists/merge-sort.cert
-./powerlists/prefix-sum.cert
-./powerlists/simple.cert
-./powerlists/sort.cert
-./proofstyles/completeness/assertions-partial.cert
-./proofstyles/completeness/assertions-total.cert
-./proofstyles/completeness/clock-partial.cert
-./proofstyles/completeness/clock-total.cert
-./proofstyles/completeness/generic-partial.cert
-./proofstyles/completeness/generic-total.cert
-./proofstyles/completeness/stepwise-invariants-partial.cert
-./proofstyles/completeness/stepwise-invariants-total.cert
-./proofstyles/counterexamples/halt-flg.cert
-./proofstyles/counterexamples/memory-clearing.cert
-./proofstyles/counterexamples/realistic.cert
-./proofstyles/invclock/c2i/c2i-partial.cert
-./proofstyles/invclock/c2i/c2i-total.cert
-./proofstyles/invclock/c2i/clock-to-inv.cert
-./proofstyles/invclock/compose/compose-c-c-partial.cert
-./proofstyles/invclock/compose/compose-c-c-total.cert
-./proofstyles/invclock/i2c/i2c-partial.cert
-./proofstyles/invclock/i2c/i2c-total.cert
-./proofstyles/invclock/i2c/inv-to-clock.cert
-./proofstyles/soundness/assertions-partial.cert
-./proofstyles/soundness/assertions-total.cert
-./proofstyles/soundness/clock-partial.cert
-./proofstyles/soundness/clock-total.cert
-./proofstyles/soundness/stepwise-invariants-partial.cert
-./proofstyles/soundness/stepwise-invariants-total.cert
-./quadratic-reciprocity/eisenstein.cert
-./quadratic-reciprocity/euclid.cert
-./quadratic-reciprocity/euler.cert
-./quadratic-reciprocity/fermat.cert
-./quadratic-reciprocity/gauss.cert
-./quadratic-reciprocity/mersenne.cert
-./regex/defset-encapsulates.cert
-./regex/defset-macros.cert
-./regex/equal-based-set.cert
-./regex/grep-command-line.cert
-./regex/input-list.cert
-./regex/regex-chartrans.cert
-./regex/regex-defs.cert
-./regex/regex-exec.cert
-./regex/regex-fileio.cert
-./regex/regex-parse-brace.cert
-./regex/regex-parse-bracket.cert
-./regex/regex-parse.cert
-./regex/regex-tests.cert
-./rtl/rel1/lib1/basic.cert
-./rtl/rel1/lib1/bits.cert
-./rtl/rel1/lib1/brat.cert
-./rtl/rel1/lib1/float.cert
-./rtl/rel1/lib1/reps.cert
-./rtl/rel1/lib1/round.cert
-./rtl/rel1/lib1/top.cert
-./rtl/rel1/lib3/basic.cert
-./rtl/rel1/lib3/bits.cert
-./rtl/rel1/lib3/brat.cert
-./rtl/rel1/lib3/fadd.cert
-./rtl/rel1/lib3/float.cert
-./rtl/rel1/lib3/reps.cert
-./rtl/rel1/lib3/round.cert
-./rtl/rel1/lib3/top.cert
-./rtl/rel1/support/add.cert
-./rtl/rel1/support/away.cert
-./rtl/rel1/support/basic.cert
-./rtl/rel1/support/divsqrt.cert
-./rtl/rel1/support/fadd/add3.cert
-./rtl/rel1/support/fadd/lop1.cert
-./rtl/rel1/support/fadd/lop2.cert
-./rtl/rel1/support/fadd/lop3.cert
-./rtl/rel1/support/fadd/stick.cert
-./rtl/rel1/support/fadd/top.cert
-./rtl/rel1/support/float.cert
-./rtl/rel1/support/floor.cert
-./rtl/rel1/support/fp.cert
-./rtl/rel1/support/logdefs.cert
-./rtl/rel1/support/loglemmas.cert
-./rtl/rel1/support/logxor-def.cert
-./rtl/rel1/support/logxor-lemmas.cert
-./rtl/rel1/support/merge.cert
-./rtl/rel1/support/near.cert
-./rtl/rel1/support/odd.cert
-./rtl/rel1/support/proofs.cert
-./rtl/rel1/support/reps.cert
-./rtl/rel1/support/rewrite-theory.cert
-./rtl/rel1/support/rnd.cert
-./rtl/rel1/support/sticky.cert
-./rtl/rel1/support/trunc.cert
-./rtl/rel1/support/x-2xx.cert
-./rtl/rel4/arithmetic/arith.cert
-./rtl/rel4/arithmetic/arith2.cert
-./rtl/rel4/arithmetic/basic.cert
-./rtl/rel4/arithmetic/cg.cert
-./rtl/rel4/arithmetic/common-factor-defuns.cert
-./rtl/rel4/arithmetic/common-factor.cert
-./rtl/rel4/arithmetic/complex-rationalp.cert
-./rtl/rel4/arithmetic/denominator.cert
-./rtl/rel4/arithmetic/even-odd.cert
-./rtl/rel4/arithmetic/even-odd2-proofs.cert
-./rtl/rel4/arithmetic/even-odd2.cert
-./rtl/rel4/arithmetic/expo-proofs.cert
-./rtl/rel4/arithmetic/expo.cert
-./rtl/rel4/arithmetic/expt-proofs.cert
-./rtl/rel4/arithmetic/expt.cert
-./rtl/rel4/arithmetic/extra-rules.cert
-./rtl/rel4/arithmetic/fl-expt.cert
-./rtl/rel4/arithmetic/fl-hacks.cert
-./rtl/rel4/arithmetic/fl-proofs.cert
-./rtl/rel4/arithmetic/fl.cert
-./rtl/rel4/arithmetic/floor-proofs.cert
-./rtl/rel4/arithmetic/floor.cert
-./rtl/rel4/arithmetic/fp.cert
-./rtl/rel4/arithmetic/fp2.cert
-./rtl/rel4/arithmetic/ground-zero.cert
-./rtl/rel4/arithmetic/hacks.cert
-./rtl/rel4/arithmetic/induct.cert
-./rtl/rel4/arithmetic/integerp.cert
-./rtl/rel4/arithmetic/inverted-factor.cert
-./rtl/rel4/arithmetic/mod-expt.cert
-./rtl/rel4/arithmetic/mod-proofs.cert
-./rtl/rel4/arithmetic/mod.cert
-./rtl/rel4/arithmetic/negative-syntaxp.cert
-./rtl/rel4/arithmetic/nniq.cert
-./rtl/rel4/arithmetic/numerator.cert
-./rtl/rel4/arithmetic/power2p.cert
-./rtl/rel4/arithmetic/predicate.cert
-./rtl/rel4/arithmetic/product-proofs.cert
-./rtl/rel4/arithmetic/product.cert
-./rtl/rel4/arithmetic/rationalp.cert
-./rtl/rel4/arithmetic/top.cert
-./rtl/rel4/arithmetic/unary-divide.cert
-./rtl/rel4/arithmetic/x-2xx.cert
-./rtl/rel4/lib/arith.cert
-./rtl/rel4/lib/basic.cert
-./rtl/rel4/lib/bits.cert
-./rtl/rel4/lib/bvecp-helpers.cert
-./rtl/rel4/lib/bvecp-raw-helpers.cert
-./rtl/rel4/lib/clocks.cert
-./rtl/rel4/lib/fadd.cert
-./rtl/rel4/lib/float.cert
-./rtl/rel4/lib/openers.cert
-./rtl/rel4/lib/package-defs.cert
-./rtl/rel4/lib/reps.cert
-./rtl/rel4/lib/rom-helpers.cert
-./rtl/rel4/lib/round.cert
-./rtl/rel4/lib/rtl.cert
-./rtl/rel4/lib/rtlarr.cert
-./rtl/rel4/lib/simple-loop-helpers.cert
-./rtl/rel4/lib/simplify-model-helpers.cert
-./rtl/rel4/lib/top.cert
-./rtl/rel4/lib/util.cert
-./rtl/rel4/support/add3-proofs.cert
-./rtl/rel4/support/add3.cert
-./rtl/rel4/support/all-ones.cert
-./rtl/rel4/support/ash.cert
-./rtl/rel4/support/away-proofs.cert
-./rtl/rel4/support/away.cert
-./rtl/rel4/support/badguys.cert
-./rtl/rel4/support/bias-proofs.cert
-./rtl/rel4/support/bias.cert
-./rtl/rel4/support/bitn-proofs.cert
-./rtl/rel4/support/bitn.cert
-./rtl/rel4/support/bits-extra.cert
-./rtl/rel4/support/bits-proofs.cert
-./rtl/rel4/support/bits-trunc-proofs.cert
-./rtl/rel4/support/bits-trunc.cert
-./rtl/rel4/support/bits.cert
-./rtl/rel4/support/bvecp-helpers.cert
-./rtl/rel4/support/bvecp-lemmas.cert
-./rtl/rel4/support/bvecp-proofs.cert
-./rtl/rel4/support/bvecp.cert
-./rtl/rel4/support/cat-def.cert
-./rtl/rel4/support/cat-proofs.cert
-./rtl/rel4/support/cat.cert
-./rtl/rel4/support/clocks.cert
-./rtl/rel4/support/decode-proofs.cert
-./rtl/rel4/support/decode.cert
-./rtl/rel4/support/drnd.cert
-./rtl/rel4/support/encode.cert
-./rtl/rel4/support/ereps-proofs.cert
-./rtl/rel4/support/ereps.cert
-./rtl/rel4/support/fadd.cert
-./rtl/rel4/support/fast-and.cert
-./rtl/rel4/support/float.cert
-./rtl/rel4/support/ground-zero.cert
-./rtl/rel4/support/guards.cert
-./rtl/rel4/support/ireps.cert
-./rtl/rel4/support/land-proofs.cert
-./rtl/rel4/support/land.cert
-./rtl/rel4/support/lextra-proofs.cert
-./rtl/rel4/support/lextra.cert
-./rtl/rel4/support/lior-proofs.cert
-./rtl/rel4/support/lior.cert
-./rtl/rel4/support/lnot-proofs.cert
-./rtl/rel4/support/lnot.cert
-./rtl/rel4/support/log-equal.cert
-./rtl/rel4/support/log-proofs.cert
-./rtl/rel4/support/log.cert
-./rtl/rel4/support/logand-proofs.cert
-./rtl/rel4/support/logand.cert
-./rtl/rel4/support/logeqv.cert
-./rtl/rel4/support/logior-proofs.cert
-./rtl/rel4/support/logior.cert
-./rtl/rel4/support/logior1-proofs.cert
-./rtl/rel4/support/logior1.cert
-./rtl/rel4/support/lognot.cert
-./rtl/rel4/support/logorc1.cert
-./rtl/rel4/support/logs.cert
-./rtl/rel4/support/logxor.cert
-./rtl/rel4/support/lop1-proofs.cert
-./rtl/rel4/support/lop1.cert
-./rtl/rel4/support/lop2-proofs.cert
-./rtl/rel4/support/lop2.cert
-./rtl/rel4/support/lop3-proofs.cert
-./rtl/rel4/support/lop3.cert
-./rtl/rel4/support/lxor-proofs.cert
-./rtl/rel4/support/lxor.cert
-./rtl/rel4/support/merge.cert
-./rtl/rel4/support/merge2.cert
-./rtl/rel4/support/mod4.cert
-./rtl/rel4/support/model-helpers.cert
-./rtl/rel4/support/mulcat-proofs.cert
-./rtl/rel4/support/mulcat.cert
-./rtl/rel4/support/near+-proofs.cert
-./rtl/rel4/support/near+.cert
-./rtl/rel4/support/near-proofs.cert
-./rtl/rel4/support/near.cert
-./rtl/rel4/support/ocat.cert
-./rtl/rel4/support/oddr-proofs.cert
-./rtl/rel4/support/oddr.cert
-./rtl/rel4/support/openers.cert
-./rtl/rel4/support/package-defs.cert
-./rtl/rel4/support/rewrite-theory.cert
-./rtl/rel4/support/rnd.cert
-./rtl/rel4/support/rom-helpers.cert
-./rtl/rel4/support/rtl.cert
-./rtl/rel4/support/rtlarr.cert
-./rtl/rel4/support/setbitn-proofs.cert
-./rtl/rel4/support/setbitn.cert
-./rtl/rel4/support/setbits-proofs.cert
-./rtl/rel4/support/setbits.cert
-./rtl/rel4/support/sgn.cert
-./rtl/rel4/support/shft.cert
-./rtl/rel4/support/simple-loop-helpers.cert
-./rtl/rel4/support/simplify-model-helpers.cert
-./rtl/rel4/support/stick-proofs.cert
-./rtl/rel4/support/stick.cert
-./rtl/rel4/support/sticky-proofs.cert
-./rtl/rel4/support/sticky.cert
-./rtl/rel4/support/sumbits.cert
-./rtl/rel4/support/top.cert
-./rtl/rel4/support/top1.cert
-./rtl/rel4/support/trunc-proofs.cert
-./rtl/rel4/support/trunc.cert
-./rtl/rel4/support/util.cert
-./rtl/rel4/user/away.cert
-./rtl/rel4/user/bias.cert
-./rtl/rel4/user/bitn.cert
-./rtl/rel4/user/bits-trunc.cert
-./rtl/rel4/user/bits.cert
-./rtl/rel4/user/brat.cert
-./rtl/rel4/user/bvecp.cert
-./rtl/rel4/user/cat.cert
-./rtl/rel4/user/decode.cert
-./rtl/rel4/user/ereps.cert
-./rtl/rel4/user/land.cert
-./rtl/rel4/user/lextra.cert
-./rtl/rel4/user/lior.cert
-./rtl/rel4/user/lnot.cert
-./rtl/rel4/user/logior1.cert
-./rtl/rel4/user/lxor.cert
-./rtl/rel4/user/mulcat.cert
-./rtl/rel4/user/near.cert
-./rtl/rel4/user/setbitn.cert
-./rtl/rel4/user/setbits.cert
-./rtl/rel4/user/stick.cert
-./rtl/rel4/user/sumbits.cert
-./rtl/rel4/user/top.cert
-./rtl/rel4/user/trunc.cert
-./rtl/rel5/arithmetic/arith.cert
-./rtl/rel5/arithmetic/arith2.cert
-./rtl/rel5/arithmetic/basic.cert
-./rtl/rel5/arithmetic/cg.cert
-./rtl/rel5/arithmetic/common-factor-defuns.cert
-./rtl/rel5/arithmetic/common-factor.cert
-./rtl/rel5/arithmetic/complex-rationalp.cert
-./rtl/rel5/arithmetic/denominator.cert
-./rtl/rel5/arithmetic/even-odd.cert
-./rtl/rel5/arithmetic/even-odd2-proofs.cert
-./rtl/rel5/arithmetic/even-odd2.cert
-./rtl/rel5/arithmetic/expo-proofs.cert
-./rtl/rel5/arithmetic/expo.cert
-./rtl/rel5/arithmetic/expt-proofs.cert
-./rtl/rel5/arithmetic/expt.cert
-./rtl/rel5/arithmetic/extra-rules.cert
-./rtl/rel5/arithmetic/fl-expt.cert
-./rtl/rel5/arithmetic/fl-hacks.cert
-./rtl/rel5/arithmetic/fl-proofs.cert
-./rtl/rel5/arithmetic/fl.cert
-./rtl/rel5/arithmetic/floor-proofs.cert
-./rtl/rel5/arithmetic/floor.cert
-./rtl/rel5/arithmetic/fp.cert
-./rtl/rel5/arithmetic/fp2.cert
-./rtl/rel5/arithmetic/ground-zero.cert
-./rtl/rel5/arithmetic/hacks.cert
-./rtl/rel5/arithmetic/induct.cert
-./rtl/rel5/arithmetic/integerp.cert
-./rtl/rel5/arithmetic/inverted-factor.cert
-./rtl/rel5/arithmetic/mod-expt.cert
-./rtl/rel5/arithmetic/mod-proofs.cert
-./rtl/rel5/arithmetic/mod.cert
-./rtl/rel5/arithmetic/negative-syntaxp.cert
-./rtl/rel5/arithmetic/nniq.cert
-./rtl/rel5/arithmetic/numerator.cert
-./rtl/rel5/arithmetic/power2p.cert
-./rtl/rel5/arithmetic/predicate.cert
-./rtl/rel5/arithmetic/product-proofs.cert
-./rtl/rel5/arithmetic/product.cert
-./rtl/rel5/arithmetic/rationalp.cert
-./rtl/rel5/arithmetic/top.cert
-./rtl/rel5/arithmetic/unary-divide.cert
-./rtl/rel5/arithmetic/x-2xx.cert
-./rtl/rel5/lib/add.cert
-./rtl/rel5/lib/arith.cert
-./rtl/rel5/lib/basic.cert
-./rtl/rel5/lib/bits.cert
-./rtl/rel5/lib/bvecp-helpers.cert
-./rtl/rel5/lib/bvecp-raw-helpers.cert
-./rtl/rel5/lib/clocks.cert
-./rtl/rel5/lib/float.cert
-./rtl/rel5/lib/log.cert
-./rtl/rel5/lib/openers.cert
-./rtl/rel5/lib/package-defs.cert
-./rtl/rel5/lib/reps.cert
-./rtl/rel5/lib/rom-helpers.cert
-./rtl/rel5/lib/round.cert
-./rtl/rel5/lib/rtl.cert
-./rtl/rel5/lib/rtlarr.cert
-./rtl/rel5/lib/simple-loop-helpers.cert
-./rtl/rel5/lib/simplify-model-helpers.cert
-./rtl/rel5/lib/top.cert
-./rtl/rel5/lib/util.cert
-./rtl/rel5/support/add3-proofs.cert
-./rtl/rel5/support/add3.cert
-./rtl/rel5/support/all-ones.cert
-./rtl/rel5/support/ash.cert
-./rtl/rel5/support/away-proofs.cert
-./rtl/rel5/support/away.cert
-./rtl/rel5/support/badguys.cert
-./rtl/rel5/support/bias-proofs.cert
-./rtl/rel5/support/bias.cert
-./rtl/rel5/support/bitn-proofs.cert
-./rtl/rel5/support/bitn.cert
-./rtl/rel5/support/bits-proofs.cert
-./rtl/rel5/support/bits-trunc-proofs.cert
-./rtl/rel5/support/bits-trunc.cert
-./rtl/rel5/support/bits.cert
-./rtl/rel5/support/bvecp-helpers.cert
-./rtl/rel5/support/bvecp-lemmas.cert
-./rtl/rel5/support/bvecp-proofs.cert
-./rtl/rel5/support/bvecp.cert
-./rtl/rel5/support/cat-def.cert
-./rtl/rel5/support/cat-proofs.cert
-./rtl/rel5/support/cat.cert
-./rtl/rel5/support/clocks.cert
-./rtl/rel5/support/decode-proofs.cert
-./rtl/rel5/support/decode.cert
-./rtl/rel5/support/drnd.cert
-./rtl/rel5/support/encode.cert
-./rtl/rel5/support/ereps-proofs.cert
-./rtl/rel5/support/ereps.cert
-./rtl/rel5/support/fadd-extra.cert
-./rtl/rel5/support/fadd-extra0.cert
-./rtl/rel5/support/fadd.cert
-./rtl/rel5/support/fast-and.cert
-./rtl/rel5/support/float-extra.cert
-./rtl/rel5/support/float.cert
-./rtl/rel5/support/ground-zero.cert
-./rtl/rel5/support/guards.cert
-./rtl/rel5/support/ireps.cert
-./rtl/rel5/support/land.cert
-./rtl/rel5/support/land0-proofs.cert
-./rtl/rel5/support/land0.cert
-./rtl/rel5/support/lextra-proofs.cert
-./rtl/rel5/support/lextra.cert
-./rtl/rel5/support/lextra0.cert
-./rtl/rel5/support/lior.cert
-./rtl/rel5/support/lior0-proofs.cert
-./rtl/rel5/support/lior0.cert
-./rtl/rel5/support/lnot-proofs.cert
-./rtl/rel5/support/lnot.cert
-./rtl/rel5/support/log-equal.cert
-./rtl/rel5/support/log-proofs.cert
-./rtl/rel5/support/log.cert
-./rtl/rel5/support/logand-proofs.cert
-./rtl/rel5/support/logand.cert
-./rtl/rel5/support/logeqv.cert
-./rtl/rel5/support/logior-proofs.cert
-./rtl/rel5/support/logior.cert
-./rtl/rel5/support/logior1-proofs.cert
-./rtl/rel5/support/logior1.cert
-./rtl/rel5/support/lognot.cert
-./rtl/rel5/support/logorc1.cert
-./rtl/rel5/support/logs.cert
-./rtl/rel5/support/logxor.cert
-./rtl/rel5/support/lop1-proofs.cert
-./rtl/rel5/support/lop1.cert
-./rtl/rel5/support/lop2-proofs.cert
-./rtl/rel5/support/lop2.cert
-./rtl/rel5/support/lop3-proofs.cert
-./rtl/rel5/support/lop3.cert
-./rtl/rel5/support/lxor.cert
-./rtl/rel5/support/lxor0-proofs.cert
-./rtl/rel5/support/lxor0.cert
-./rtl/rel5/support/merge.cert
-./rtl/rel5/support/merge2.cert
-./rtl/rel5/support/mod4.cert
-./rtl/rel5/support/model-helpers.cert
-./rtl/rel5/support/mulcat-proofs.cert
-./rtl/rel5/support/mulcat.cert
-./rtl/rel5/support/near+-proofs.cert
-./rtl/rel5/support/near+.cert
-./rtl/rel5/support/near-proofs.cert
-./rtl/rel5/support/near.cert
-./rtl/rel5/support/ocat.cert
-./rtl/rel5/support/oddr-proofs.cert
-./rtl/rel5/support/oddr.cert
-./rtl/rel5/support/openers.cert
-./rtl/rel5/support/package-defs.cert
-./rtl/rel5/support/rewrite-theory.cert
-./rtl/rel5/support/rnd.cert
-./rtl/rel5/support/rom-helpers.cert
-./rtl/rel5/support/round-extra.cert
-./rtl/rel5/support/rtl.cert
-./rtl/rel5/support/rtlarr.cert
-./rtl/rel5/support/setbitn-proofs.cert
-./rtl/rel5/support/setbitn.cert
-./rtl/rel5/support/setbits-proofs.cert
-./rtl/rel5/support/setbits.cert
-./rtl/rel5/support/sgn.cert
-./rtl/rel5/support/shft.cert
-./rtl/rel5/support/simple-loop-helpers.cert
-./rtl/rel5/support/simplify-model-helpers.cert
-./rtl/rel5/support/stick-proofs.cert
-./rtl/rel5/support/stick.cert
-./rtl/rel5/support/sticky-proofs.cert
-./rtl/rel5/support/sticky.cert
-./rtl/rel5/support/sumbits.cert
-./rtl/rel5/support/top.cert
-./rtl/rel5/support/top1.cert
-./rtl/rel5/support/trunc-proofs.cert
-./rtl/rel5/support/trunc.cert
-./rtl/rel5/support/util.cert
-./rtl/rel5/user/away.cert
-./rtl/rel5/user/bias.cert
-./rtl/rel5/user/bitn.cert
-./rtl/rel5/user/bits-trunc.cert
-./rtl/rel5/user/bits.cert
-./rtl/rel5/user/brat.cert
-./rtl/rel5/user/bvecp.cert
-./rtl/rel5/user/cat.cert
-./rtl/rel5/user/decode.cert
-./rtl/rel5/user/ereps.cert
-./rtl/rel5/user/land.cert
-./rtl/rel5/user/lextra.cert
-./rtl/rel5/user/lior.cert
-./rtl/rel5/user/lnot.cert
-./rtl/rel5/user/logior1.cert
-./rtl/rel5/user/lxor.cert
-./rtl/rel5/user/mulcat.cert
-./rtl/rel5/user/near.cert
-./rtl/rel5/user/setbitn.cert
-./rtl/rel5/user/setbits.cert
-./rtl/rel5/user/stick.cert
-./rtl/rel5/user/sumbits.cert
-./rtl/rel5/user/top.cert
-./rtl/rel5/user/trunc.cert
-./rtl/rel8/arithmetic/arith.cert
-./rtl/rel8/arithmetic/arith2.cert
-./rtl/rel8/arithmetic/basic.cert
-./rtl/rel8/arithmetic/cg.cert
-./rtl/rel8/arithmetic/common-factor-defuns.cert
-./rtl/rel8/arithmetic/common-factor.cert
-./rtl/rel8/arithmetic/complex-rationalp.cert
-./rtl/rel8/arithmetic/denominator.cert
-./rtl/rel8/arithmetic/even-odd.cert
-./rtl/rel8/arithmetic/even-odd2-proofs.cert
-./rtl/rel8/arithmetic/even-odd2.cert
-./rtl/rel8/arithmetic/expo-proofs.cert
-./rtl/rel8/arithmetic/expo.cert
-./rtl/rel8/arithmetic/expt-proofs.cert
-./rtl/rel8/arithmetic/expt.cert
-./rtl/rel8/arithmetic/extra-rules.cert
-./rtl/rel8/arithmetic/fl-expt.cert
-./rtl/rel8/arithmetic/fl-hacks.cert
-./rtl/rel8/arithmetic/fl-proofs.cert
-./rtl/rel8/arithmetic/fl.cert
-./rtl/rel8/arithmetic/floor-proofs.cert
-./rtl/rel8/arithmetic/floor.cert
-./rtl/rel8/arithmetic/fp.cert
-./rtl/rel8/arithmetic/fp2.cert
-./rtl/rel8/arithmetic/ground-zero.cert
-./rtl/rel8/arithmetic/hacks.cert
-./rtl/rel8/arithmetic/induct.cert
-./rtl/rel8/arithmetic/integerp.cert
-./rtl/rel8/arithmetic/inverted-factor.cert
-./rtl/rel8/arithmetic/mod-expt.cert
-./rtl/rel8/arithmetic/mod-proofs.cert
-./rtl/rel8/arithmetic/mod.cert
-./rtl/rel8/arithmetic/negative-syntaxp.cert
-./rtl/rel8/arithmetic/nniq.cert
-./rtl/rel8/arithmetic/numerator.cert
-./rtl/rel8/arithmetic/power2p.cert
-./rtl/rel8/arithmetic/predicate.cert
-./rtl/rel8/arithmetic/product-proofs.cert
-./rtl/rel8/arithmetic/product.cert
-./rtl/rel8/arithmetic/rationalp.cert
-./rtl/rel8/arithmetic/top.cert
-./rtl/rel8/arithmetic/unary-divide.cert
-./rtl/rel8/arithmetic/x-2xx.cert
-./rtl/rel8/lib/add.cert
-./rtl/rel8/lib/arith.cert
-./rtl/rel8/lib/basic.cert
-./rtl/rel8/lib/bits.cert
-./rtl/rel8/lib/bvecp-helpers.cert
-./rtl/rel8/lib/bvecp-raw-helpers.cert
-./rtl/rel8/lib/clocks.cert
-./rtl/rel8/lib/float.cert
-./rtl/rel8/lib/log.cert
-./rtl/rel8/lib/logn.cert
-./rtl/rel8/lib/logn2log.cert
-./rtl/rel8/lib/mult.cert
-./rtl/rel8/lib/openers.cert
-./rtl/rel8/lib/package-defs.cert
-./rtl/rel8/lib/reps.cert
-./rtl/rel8/lib/rom-helpers.cert
-./rtl/rel8/lib/round.cert
-./rtl/rel8/lib/rtl.cert
-./rtl/rel8/lib/rtlarr.cert
-./rtl/rel8/lib/simple-loop-helpers.cert
-./rtl/rel8/lib/simplify-model-helpers.cert
-./rtl/rel8/lib/top.cert
-./rtl/rel8/lib/util.cert
-./rtl/rel8/support/lib1.delta1/arith-extra.cert
-./rtl/rel8/support/lib1.delta1/arith.cert
-./rtl/rel8/support/lib1.delta1/basic-extra.cert
-./rtl/rel8/support/lib1.delta1/basic.cert
-./rtl/rel8/support/lib1.delta1/bits-extra.cert
-./rtl/rel8/support/lib1.delta1/bits.cert
-./rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.cert
-./rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.cert
-./rtl/rel8/support/lib1.delta1/float-extra2.cert
-./rtl/rel8/support/lib1.delta1/float.cert
-./rtl/rel8/support/lib1.delta1/mult-proofs.cert
-./rtl/rel8/support/lib1.delta1/mult.cert
-./rtl/rel8/support/lib1.delta1/round-extra2.cert
-./rtl/rel8/support/lib1.delta1/round.cert
-./rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.cert
-./rtl/rel8/support/lib1.delta1/simple-loop-helpers.cert
-./rtl/rel8/support/lib1.delta2/float-extra.cert
-./rtl/rel8/support/lib1.delta2/float.cert
-./rtl/rel8/support/lib1/add.cert
-./rtl/rel8/support/lib1/arith.cert
-./rtl/rel8/support/lib1/basic.cert
-./rtl/rel8/support/lib1/bits.cert
-./rtl/rel8/support/lib1/bvecp-helpers.cert
-./rtl/rel8/support/lib1/bvecp-raw-helpers.cert
-./rtl/rel8/support/lib1/clocks.cert
-./rtl/rel8/support/lib1/float.cert
-./rtl/rel8/support/lib1/log.cert
-./rtl/rel8/support/lib1/openers.cert
-./rtl/rel8/support/lib1/package-defs.cert
-./rtl/rel8/support/lib1/reps.cert
-./rtl/rel8/support/lib1/rom-helpers.cert
-./rtl/rel8/support/lib1/round.cert
-./rtl/rel8/support/lib1/rtl.cert
-./rtl/rel8/support/lib1/rtlarr.cert
-./rtl/rel8/support/lib1/simple-loop-helpers.cert
-./rtl/rel8/support/lib1/simplify-model-helpers.cert
-./rtl/rel8/support/lib1/top.cert
-./rtl/rel8/support/lib1/util.cert
-./rtl/rel8/support/lib2.delta1/add-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/add-new.cert
-./rtl/rel8/support/lib2.delta1/add-proofs.cert
-./rtl/rel8/support/lib2.delta1/add.cert
-./rtl/rel8/support/lib2.delta1/arith.cert
-./rtl/rel8/support/lib2.delta1/bits-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/bits-new.cert
-./rtl/rel8/support/lib2.delta1/bits-proofs.cert
-./rtl/rel8/support/lib2.delta1/bits.cert
-./rtl/rel8/support/lib2.delta1/bvecp-helpers.cert
-./rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.cert
-./rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert
-./rtl/rel8/support/lib2.delta1/float-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/float-new.cert
-./rtl/rel8/support/lib2.delta1/float-proofs.cert
-./rtl/rel8/support/lib2.delta1/float.cert
-./rtl/rel8/support/lib2.delta1/log-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/log-new.cert
-./rtl/rel8/support/lib2.delta1/log-proofs.cert
-./rtl/rel8/support/lib2.delta1/log-support-proofs.cert
-./rtl/rel8/support/lib2.delta1/log-support.cert
-./rtl/rel8/support/lib2.delta1/log.cert
-./rtl/rel8/support/lib2.delta1/logn-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/logn-new.cert
-./rtl/rel8/support/lib2.delta1/logn-proofs.cert
-./rtl/rel8/support/lib2.delta1/logn.cert
-./rtl/rel8/support/lib2.delta1/logn2log-proofs.cert
-./rtl/rel8/support/lib2.delta1/logn2log.cert
-./rtl/rel8/support/lib2.delta1/mult-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/mult-new.cert
-./rtl/rel8/support/lib2.delta1/mult-proofs.cert
-./rtl/rel8/support/lib2.delta1/mult.cert
-./rtl/rel8/support/lib2.delta1/reps-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/reps-new.cert
-./rtl/rel8/support/lib2.delta1/reps-proofs.cert
-./rtl/rel8/support/lib2.delta1/reps.cert
-./rtl/rel8/support/lib2.delta1/round-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/round-new.cert
-./rtl/rel8/support/lib2.delta1/round-proofs.cert
-./rtl/rel8/support/lib2.delta1/round.cert
-./rtl/rel8/support/lib2.delta1/rtl-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/rtl-new.cert
-./rtl/rel8/support/lib2.delta1/rtl-proofs.cert
-./rtl/rel8/support/lib2.delta1/rtl.cert
-./rtl/rel8/support/lib2.delta1/rtlarr-new.cert
-./rtl/rel8/support/lib2.delta1/rtlarr.cert
-./rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.cert
-./rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert
-./rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.cert
-./rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.cert
-./rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert
-./rtl/rel8/support/lib2.delta1/top.cert
-./rtl/rel8/support/lib2.delta1/util.cert
-./rtl/rel8/support/lib2.delta2/add-lib.cert
-./rtl/rel8/support/lib2.delta2/add.cert
-./rtl/rel8/support/lib2.delta2/base.cert
-./rtl/rel8/support/lib2.delta2/bits.cert
-./rtl/rel8/support/lib2.delta2/log.cert
-./rtl/rel8/support/lib2/add.cert
-./rtl/rel8/support/lib2/arith.cert
-./rtl/rel8/support/lib2/base.cert
-./rtl/rel8/support/lib2/basic.cert
-./rtl/rel8/support/lib2/bits.cert
-./rtl/rel8/support/lib2/bvecp-helpers.cert
-./rtl/rel8/support/lib2/bvecp-raw-helpers.cert
-./rtl/rel8/support/lib2/clocks.cert
-./rtl/rel8/support/lib2/float.cert
-./rtl/rel8/support/lib2/log.cert
-./rtl/rel8/support/lib2/mult.cert
-./rtl/rel8/support/lib2/openers.cert
-./rtl/rel8/support/lib2/package-defs.cert
-./rtl/rel8/support/lib2/reps.cert
-./rtl/rel8/support/lib2/rom-helpers.cert
-./rtl/rel8/support/lib2/round.cert
-./rtl/rel8/support/lib2/rtl.cert
-./rtl/rel8/support/lib2/rtlarr.cert
-./rtl/rel8/support/lib2/simple-loop-helpers.cert
-./rtl/rel8/support/lib2/simplify-model-helpers.cert
-./rtl/rel8/support/lib2/top.cert
-./rtl/rel8/support/lib2/util.cert
-./rtl/rel8/support/support/add3-proofs.cert
-./rtl/rel8/support/support/add3.cert
-./rtl/rel8/support/support/all-ones.cert
-./rtl/rel8/support/support/ash.cert
-./rtl/rel8/support/support/away-proofs.cert
-./rtl/rel8/support/support/away.cert
-./rtl/rel8/support/support/badguys.cert
-./rtl/rel8/support/support/bias-proofs.cert
-./rtl/rel8/support/support/bias.cert
-./rtl/rel8/support/support/bitn-proofs.cert
-./rtl/rel8/support/support/bitn.cert
-./rtl/rel8/support/support/bits-proofs.cert
-./rtl/rel8/support/support/bits-trunc-proofs.cert
-./rtl/rel8/support/support/bits-trunc.cert
-./rtl/rel8/support/support/bits.cert
-./rtl/rel8/support/support/bvecp-helpers.cert
-./rtl/rel8/support/support/bvecp-lemmas.cert
-./rtl/rel8/support/support/bvecp-proofs.cert
-./rtl/rel8/support/support/bvecp.cert
-./rtl/rel8/support/support/cat-def.cert
-./rtl/rel8/support/support/cat-proofs.cert
-./rtl/rel8/support/support/cat.cert
-./rtl/rel8/support/support/clocks.cert
-./rtl/rel8/support/support/decode-proofs.cert
-./rtl/rel8/support/support/decode.cert
-./rtl/rel8/support/support/drnd-original.cert
-./rtl/rel8/support/support/encode.cert
-./rtl/rel8/support/support/ereps-proofs.cert
-./rtl/rel8/support/support/ereps.cert
-./rtl/rel8/support/support/fadd-extra.cert
-./rtl/rel8/support/support/fadd-extra0.cert
-./rtl/rel8/support/support/fadd.cert
-./rtl/rel8/support/support/fast-and.cert
-./rtl/rel8/support/support/float-extra.cert
-./rtl/rel8/support/support/float.cert
-./rtl/rel8/support/support/ground-zero.cert
-./rtl/rel8/support/support/guards.cert
-./rtl/rel8/support/support/ireps.cert
-./rtl/rel8/support/support/land.cert
-./rtl/rel8/support/support/land0-proofs.cert
-./rtl/rel8/support/support/land0.cert
-./rtl/rel8/support/support/lextra-proofs.cert
-./rtl/rel8/support/support/lextra.cert
-./rtl/rel8/support/support/lextra0.cert
-./rtl/rel8/support/support/lior.cert
-./rtl/rel8/support/support/lior0-proofs.cert
-./rtl/rel8/support/support/lior0.cert
-./rtl/rel8/support/support/lnot-proofs.cert
-./rtl/rel8/support/support/lnot.cert
-./rtl/rel8/support/support/log-equal.cert
-./rtl/rel8/support/support/log-proofs.cert
-./rtl/rel8/support/support/log.cert
-./rtl/rel8/support/support/logand-proofs.cert
-./rtl/rel8/support/support/logand.cert
-./rtl/rel8/support/support/logeqv.cert
-./rtl/rel8/support/support/logior-proofs.cert
-./rtl/rel8/support/support/logior.cert
-./rtl/rel8/support/support/logior1-proofs.cert
-./rtl/rel8/support/support/logior1.cert
-./rtl/rel8/support/support/lognot.cert
-./rtl/rel8/support/support/logorc1.cert
-./rtl/rel8/support/support/logs.cert
-./rtl/rel8/support/support/logxor.cert
-./rtl/rel8/support/support/lop1-proofs.cert
-./rtl/rel8/support/support/lop1.cert
-./rtl/rel8/support/support/lop2-proofs.cert
-./rtl/rel8/support/support/lop2.cert
-./rtl/rel8/support/support/lop3-proofs.cert
-./rtl/rel8/support/support/lop3.cert
-./rtl/rel8/support/support/lxor.cert
-./rtl/rel8/support/support/lxor0-proofs.cert
-./rtl/rel8/support/support/lxor0.cert
-./rtl/rel8/support/support/merge.cert
-./rtl/rel8/support/support/merge2.cert
-./rtl/rel8/support/support/mod4.cert
-./rtl/rel8/support/support/model-helpers.cert
-./rtl/rel8/support/support/mulcat-proofs.cert
-./rtl/rel8/support/support/mulcat.cert
-./rtl/rel8/support/support/near+-proofs.cert
-./rtl/rel8/support/support/near+.cert
-./rtl/rel8/support/support/near-proofs.cert
-./rtl/rel8/support/support/near.cert
-./rtl/rel8/support/support/ocat.cert
-./rtl/rel8/support/support/oddr-proofs.cert
-./rtl/rel8/support/support/oddr.cert
-./rtl/rel8/support/support/openers.cert
-./rtl/rel8/support/support/package-defs.cert
-./rtl/rel8/support/support/rewrite-theory.cert
-./rtl/rel8/support/support/rnd.cert
-./rtl/rel8/support/support/rom-helpers.cert
-./rtl/rel8/support/support/round-extra.cert
-./rtl/rel8/support/support/rtl.cert
-./rtl/rel8/support/support/rtlarr.cert
-./rtl/rel8/support/support/setbitn-proofs.cert
-./rtl/rel8/support/support/setbitn.cert
-./rtl/rel8/support/support/setbits-proofs.cert
-./rtl/rel8/support/support/setbits.cert
-./rtl/rel8/support/support/sgn.cert
-./rtl/rel8/support/support/shft.cert
-./rtl/rel8/support/support/simple-loop-helpers.cert
-./rtl/rel8/support/support/simplify-model-helpers.cert
-./rtl/rel8/support/support/stick-proofs.cert
-./rtl/rel8/support/support/stick.cert
-./rtl/rel8/support/support/sticky-proofs.cert
-./rtl/rel8/support/support/sticky.cert
-./rtl/rel8/support/support/sumbits.cert
-./rtl/rel8/support/support/top.cert
-./rtl/rel8/support/support/top1.cert
-./rtl/rel8/support/support/trunc-proofs.cert
-./rtl/rel8/support/support/trunc.cert
-./rtl/rel8/support/support/util.cert
-./rtl/rel8/support/top/top.cert
-./security/jfkr/diffie-helman.cert
-./security/jfkr/encryption.cert
-./security/jfkr/jfkr.cert
-./security/jfkr/random.cert
-./serialize/serialize-tests.cert
-./serialize/serialize.cert
-./serialize/unsound-read.cert
-./sorting/bsort.cert
-./sorting/convert-perm-to-how-many.cert
-./sorting/equisort.cert
-./sorting/equisort2.cert
-./sorting/equisort3.cert
-./sorting/isort.cert
-./sorting/msort.cert
-./sorting/no-dups-qsort.cert
-./sorting/ordered-perms.cert
-./sorting/perm.cert
-./sorting/qsort.cert
-./sorting/sorts-equivalent.cert
-./sorting/sorts-equivalent2.cert
-./sorting/sorts-equivalent3.cert
-./str/abbrevs.cert
-./str/arithmetic.cert
-./str/cat.cert
-./str/char-support.cert
-./str/digitp.cert
-./str/doc.cert
-./str/eqv.cert
-./str/firstn-chars.cert
-./str/html-encode.cert
-./str/ieqv.cert
-./str/iless.cert
-./str/iprefixp.cert
-./str/isort.cert
-./str/istrpos.cert
-./str/istrprefixp.cert
-./str/isubstrp.cert
-./str/natstr.cert
-./str/pad.cert
-./str/strnatless.cert
-./str/strpos.cert
-./str/strprefixp.cert
-./str/strsplit.cert
-./str/substrp.cert
-./str/top.cert
-./symbolic/generic/assertions.cert
-./symbolic/generic/defsimulate.cert
-./symbolic/generic/factorial-jvm-correct.cert
-./symbolic/generic/measures.cert
-./symbolic/generic/partial-correctness.cert
-./symbolic/generic/tiny-fib-correct.cert
-./symbolic/generic/total-correctness.cert
-./symbolic/m5/demo.cert
-./symbolic/m5/utilities.cert
-./symbolic/tiny-fib/defstobj+.cert
-./symbolic/tiny-fib/fib-def.cert
-./symbolic/tiny-fib/tiny-rewrites.cert
-./symbolic/tiny-fib/tiny.cert
-./symbolic/tiny-triangle/tiny-triangle-correct.cert
-./symbolic/tiny-triangle/triangle-def.cert
-./system/pseudo-good-worldp.cert
-./system/worldp-check.cert
-./textbook/chap10/ac-example.cert
-./textbook/chap10/adder.cert
-./textbook/chap10/compiler.cert
-./textbook/chap10/fact.cert
-./textbook/chap10/insertion-sort.cert
-./textbook/chap10/tree.cert
-./textbook/chap11/compress.cert
-./textbook/chap11/encap.cert
-./textbook/chap11/finite-sets.cert
-./textbook/chap11/how-many-soln1.cert
-./textbook/chap11/how-many-soln2.cert
-./textbook/chap11/mergesort.cert
-./textbook/chap11/perm-append.cert
-./textbook/chap11/perm.cert
-./textbook/chap11/qsort.cert
-./textbook/chap11/starters.cert
-./textbook/chap11/summations-book.cert
-./textbook/chap11/summations.cert
-./textbook/chap11/tautology.cert
-./textbook/chap11/xtr.cert
-./textbook/chap11/xtr2.cert
-./textbook/chap3/programs.cert
-./textbook/chap4/solutions-logic-mode.cert
-./textbook/chap4/solutions-program-mode.cert
-./textbook/chap5/solutions.cert
-./textbook/chap6/selected-solutions.cert
-./tools/bstar.cert
-./tools/cws.cert
-./tools/defevaluator-fast.cert
-./tools/defined-const.cert
-./tools/defsum.cert
-./tools/deftuple.cert
-./tools/flag.cert
-./tools/mv-nth.cert
-./tools/pack.cert
-./tools/pattern-match.cert
-./tools/progndollar.cert
-./tools/rulesets.cert
-./tools/safe-case.cert
-./tools/saved-errors.cert
-./tools/stobj-help.cert
-./tools/theory-tools.cert
-./tools/types-misc.cert
-./tools/with-arith5-help.cert
-./tools/with-quoted-forms.cert
-./tutorial-problems/introductory-challenge-problem-4-athena.cert
-./tutorial-problems/introductory-challenge-problem-4.cert
-./unicode/app.cert
-./unicode/append.cert
-./unicode/base10-digit-charp.cert
-./unicode/close-input-channel.cert
-./unicode/coerce.cert
-./unicode/combine.cert
-./unicode/consless-listp.cert
-./unicode/explode-atom.cert
-./unicode/explode-nonnegative-integer.cert
-./unicode/file-measure.cert
-./unicode/flatten.cert
-./unicode/intern-in-package-of-symbol.cert
-./unicode/list-defuns.cert
-./unicode/list-fix.cert
-./unicode/nat-listp.cert
-./unicode/nthcdr-bytes.cert
-./unicode/nthcdr.cert
-./unicode/open-input-channel.cert
-./unicode/open-input-channels.cert
-./unicode/partition.cert
-./unicode/peek-char.cert
-./unicode/prefixp.cert
-./unicode/read-byte.cert
-./unicode/read-char.cert
-./unicode/read-file-bytes.cert
-./unicode/read-file-characters.cert
-./unicode/read-file-objects.cert
-./unicode/read-ints.cert
-./unicode/read-object.cert
-./unicode/read-utf8.cert
-./unicode/repeat.cert
-./unicode/rev.cert
-./unicode/revappend.cert
-./unicode/reverse.cert
-./unicode/sign-byte.cert
-./unicode/signed-byte-listp.cert
-./unicode/string-append.cert
-./unicode/sum-list.cert
-./unicode/take-bytes.cert
-./unicode/take.cert
-./unicode/two-nats-measure.cert
-./unicode/uchar.cert
-./unicode/unsigned-byte-listp.cert
-./unicode/update-state.cert
-./unicode/utf8-decode.cert
-./unicode/utf8-encode.cert
-./unicode/utf8-table35.cert
-./unicode/utf8-table36.cert
-./unicode/z-listp.cert
-./xdoc/defxdoc.cert
-./xdoc/names.cert
-./xdoc/portcullis.cert
-./xdoc/save.cert
-./xdoc/top.cert
diff -Nru acl2-6.2/books/make_cert_help.pl acl2-6.3/books/make_cert_help.pl
--- acl2-6.2/books/make_cert_help.pl	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/make_cert_help.pl	2013-09-30 17:53:32.000000000 +0000
@@ -545,6 +545,7 @@
     }
 
     $shinsts .= "EXITCODE=\$?\n";
+    $shinsts .= "echo Exit code from ACL2 is \$EXITCODE >> $outfile\n";
     $shinsts .= "ls -l $goal >> $outfile || echo $goal seems to be missing >> $outfile\n";
     $shinsts .= "exit \$EXITCODE\n";
 
diff -Nru acl2-6.2/books/memoize/old/profile-raw.lsp acl2-6.3/books/memoize/old/profile-raw.lsp
--- acl2-6.2/books/memoize/old/profile-raw.lsp	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/memoize/old/profile-raw.lsp	2013-09-30 17:53:31.000000000 +0000
@@ -1087,6 +1087,7 @@
   user should feel free to set *PROFILE-REJECT-HT* ad lib, at any
   time.")
 
+(declaim (hash-table *profile-reject-ht*))
 
 (defun-one-output dubious-to-profile (fn)
   (cond ((not (symbolp fn)) "not a symbol.")
@@ -1114,8 +1115,8 @@
                continue."))
         ((eq fn 'return-last)
          "the function RETURN-LAST.")
-        ((gethash fn *never-profile-ht*)
-         (ofn "~%;~10tin *NEVER-PROFILE-HT*."))
+        ((gethash fn *never-memoize-ht*)
+         (ofn "~%;~10tin *NEVER-MEMOIZE-HT*."))
         ((gethash fn *profile-reject-ht*)
          (ofn "in~%;~10t*PROFILE-REJECT-HT*.  Override with~
                ~%;~10t(REMHASH '~a *PROFILE-REJECT-HT*)."
@@ -1142,6 +1143,12 @@
         ((null (number-of-arguments fn))
          (input-output-number-warning fn))))
 
+(declaim (ftype (function (t) (values t)) event-number))
+
+(defun event-number (fn)
+  (cond ((symbolp fn)
+         (fgetprop fn 'absolute-event-number t (w *the-live-state*)))
+        (t (error "EVENT-NUMBER: ** ~a is not a symbol." fn))))
 
 (defun profile-acl2 (&key (start 0)
                           trace
diff -Nru acl2-6.2/books/memoize/tests-raw.lsp acl2-6.3/books/memoize/tests-raw.lsp
--- acl2-6.2/books/memoize/tests-raw.lsp	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/memoize/tests-raw.lsp	2013-09-30 17:53:31.000000000 +0000
@@ -64,6 +64,10 @@
 
 ;; basic time measurement accuracy
 
+#||
+
+commenting out this check for now, since it sometimes fails on certain machines.
+
 (assert
  (let* ((start (ticks))
         (wait  (sleep 3))
@@ -91,3 +95,4 @@
    (and (<= 0.9 secs)
         (<= secs 1.1))))
 
+||#
diff -Nru acl2-6.2/books/milawa/ACL2/Makefile acl2-6.3/books/milawa/ACL2/Makefile
--- acl2-6.2/books/milawa/ACL2/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/Makefile	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,243 @@
+# Milawa Makefile
+# Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.  This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.  You should have received a copy of the GNU General Public
+# License along with this program (see the file COPYING); if not, write to the
+# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+
+all:
+
+STARTJOB ?= $(SHELL)
+PWD := $(shell pwd)
+
+PATH := $(PWD)/acl2-images:$(PATH)
+WAIT := $(PWD)/wait.pl
+
+
+# We really only need to tell cert.pl about the high level books we care about.
+# This is a little haphazard, but basically we don't want to include the
+# bootstrap/ dir or use some find command since it might be slow.
+FILES_FOR_CERTPL := \
+  levels/*.lisp rewrite/*.lisp interface/*.lisp \
+  tactics/*.lisp clauses/*.lisp build/*.lisp
+
+FILES_FOR_PCERTSCAN := \
+  bootstrap/utilities/top \
+  bootstrap/logic/top \
+  bootstrap/level2/level2 \
+  bootstrap/level3/level3 \
+  bootstrap/level4/level4 \
+  bootstrap/level5/level5 \
+  bootstrap/level6/level6 \
+  bootstrap/level7/level7 \
+  bootstrap/level8/level8 \
+  bootstrap/level9/level9 \
+  bootstrap/level10/level10 \
+  bootstrap/level11/level11 \
+  bootstrap/user/multiply
+
+$(info Calculating cert dependencies...)
+DO_CERT_DEPS := $(shell ../../cert.pl $(FILES_FOR_CERTPL) \
+           --quiet \
+           --static-makefile Makefile-deps \
+           --var-prefix BOOKS_TOP \
+           --cache Makefile-cache \
+	   --bin `pwd`/acl2-images)
+$(info Calculating pcert dependencies...)
+DO_PCERT_DEPS := $(shell ./pcert-scan.pl $(FILES_FOR_PCERTSCAN) &> Makefile-pdeps)
+$(info Done with dependencies.)
+include Makefile-deps
+include Makefile-pdeps
+
+
+# I renamed .pcert files to .mpcert after ACL2 added provisional certification
+# support.
+%.mpcert: %.lisp
+	@echo "Making $*.mpcert"
+	@$(STARTJOB) -c "./pcert.pl $*.lisp &> $*.out"
+	@$(WAIT) $*.mpcert
+	@ls -l $*.mpcert
+
+
+.PHONY: all clean clean_proofs
+
+all: $(BOOKS_TOP_CERTS)
+
+# We could use cert.pl to clean up the certs, but it misses a few because of
+# images; this once led me to be pretty confused because an old cert was being
+# inappropriately included, leading to a strange error.  So I think it's better
+# to just aggressively remove certs here.
+clean:
+	@echo "Cleaning ACL2 directory (certificates, ACL2 images, etc.)"
+	@echo "Note: this doesn't clean up ../Proofs, which contains the saved"
+	@echo "      proofs for bootstrapping.  To also clean these files, "
+	@echo "      run 'make clean clean_proofs'."
+	@../../clean.pl
+	@rm -f `find . -name "*.mpcert"`
+	@rm -f `find . -name "*.out"`
+	@rm -f `find . -name "*.time"`
+	@rm -f `find . -name "*.port"`
+	@rm -f `find . -name "*.lx64fsl"`
+	@rm -f `find . -name "*.ccl"`
+	@rm -f `find . -name "*.proof"`
+	@rm -f acl2-images/*-acl2 acl2-images/*-symmetry
+	@rm -f acl2-images/*-acl2.* acl2-images/*-symmetry.*
+	@rm -f Makefile-deps Makefile-cache
+	@rm -f logic/autodoc/*.tex
+	@rm -f build/autodoc/*.tex
+	@rm -f rewrite/assms/autodoc/*.tex
+	@rm -f rewrite/traces/autodoc/*.tex
+	@rm -f rewrite/autodoc/*.tex
+	@rm -f clauses/autodoc/*.tex
+	@rm -f clauses/if-lifting/autodoc/*.tex
+	@rm -f classic/autodoc/*.tex
+	@rm -f tactics/autodoc/*.tex
+	@rm -f bootstrap/*/autodoc/*.tex
+	@rm -f Makefile-cache Makefile-deps Makefile-pdeps TAGS
+
+clean_proofs:
+	@echo "Cleaning ../Proofs directory."
+	cd ../Proofs; ./clean-proofs.sh
+
+acl2-images/tactics-acl2: rewrite/fast-crewrite-clause.cert \
+                  rewrite/traces/trace-arities.cert \
+                  rewrite/theory-arities.cert \
+                  rewrite/urewrite-clause.cert \
+                  clauses/split-bldr.cert \
+                  clauses/compiler.cert \
+                  clauses/disjoined-update-clause-bldr.cert \
+                  rewrite/gather.cert
+	@echo "Making $@"
+	@cd tactics; $(STARTJOB) -c \
+	  "$(ACL2) < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/interface-acl2: acl2-images/tactics-acl2 \
+	                    levels/level11.cert
+	@echo "Making $@"
+	@cd interface; $(STARTJOB) -c \
+	  "../acl2-images/tactics-acl2 < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+
+acl2-images/utilities-symmetry: acl2-images/interface-acl2 \
+	                        interface/top.cert
+	@echo "Making $@"
+	@cd bootstrap/utilities; $(STARTJOB) -c \
+	   "../../acl2-images/interface-acl2 < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/logic-symmetry: acl2-images/utilities-symmetry \
+                            $(PCDEPS_FOR_bootstrap__utilities__top)
+	@echo "Making $@"
+	@cd bootstrap/logic; $(STARTJOB) -c \
+	   "../../acl2-images/utilities-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level2-symmetry: acl2-images/logic-symmetry \
+                             $(PCDEPS_FOR_bootstrap__logic__top)
+	@echo "Making $@"
+	@cd bootstrap/level2; $(STARTJOB) -c \
+	  "../../acl2-images/logic-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level3-symmetry: acl2-images/level2-symmetry \
+                           $(PCDEPS_FOR_bootstrap__level2__level2)
+	@echo "Making $@"
+	@cd bootstrap/level3; $(STARTJOB) -c \
+	  "../../acl2-images/level2-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level4-symmetry: acl2-images/level3-symmetry \
+                           $(PCDEPS_FOR_bootstrap__level3__level3)
+	@echo "Making $@"
+	@cd bootstrap/level4; $(STARTJOB) -c \
+	  "../../acl2-images/level3-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level5-symmetry: acl2-images/level4-symmetry \
+                           $(PCDEPS_FOR_bootstrap__level4__level4)
+	@echo "Making $@"
+	@cd bootstrap/level5; $(STARTJOB) -c \
+	  "../../acl2-images/level4-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level6-symmetry: acl2-images/level5-symmetry \
+                           $(PCDEPS_FOR_bootstrap__level5__level5)
+	@echo "Making $@"
+	@cd bootstrap/level6; $(STARTJOB) -c \
+	  "../../acl2-images/level5-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level7-symmetry: acl2-images/level6-symmetry \
+                           $(PCDEPS_FOR_bootstrap__level6__level6)
+	@echo "Making $@"
+	@cd bootstrap/level7; $(STARTJOB) -c \
+	  "../../acl2-images/level6-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level8-symmetry: acl2-images/level7-symmetry \
+                           $(PCDEPS_FOR_bootstrap__level7__level7)
+	@echo "Making $@"
+	@cd bootstrap/level8; $(STARTJOB) -c \
+	  "../../acl2-images/level7-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level9-symmetry: acl2-images/level8-symmetry \
+                           $(PCDEPS_FOR_bootstrap__level8__level8)
+	@echo "Making $@"
+	@cd bootstrap/level9; $(STARTJOB) -c \
+	  "../../acl2-images/level8-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level10-symmetry: acl2-images/level9-symmetry \
+                            $(PCDEPS_FOR_bootstrap__level9__level9)
+	@echo "Making $@"
+	@cd bootstrap/level10; $(STARTJOB) -c \
+	  "../../acl2-images/level9-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/level11-symmetry: acl2-images/level10-symmetry \
+                            $(PCDEPS_FOR_bootstrap__level10__level10)
+	@echo "Making $@"
+	@cd bootstrap/level11; $(STARTJOB) -c \
+	  "../../acl2-images/level10-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+acl2-images/user-symmetry: acl2-images/level11-symmetry \
+                         $(PCDEPS_FOR_bootstrap__level11__level11)
+	@echo "Making $@"
+	@cd bootstrap/user; $(STARTJOB) -c \
+	  "../../acl2-images/level11-symmetry < make-image.lsp &> make-image.out"
+	@$(WAIT) "$@"
+	@ls -l "$@"*
+
+all: acl2-images/user-symmetry
+
+all: $(ALL_PCERTS)
+
+
+TAGS: $(BOOKS_TOP_SOURCES)
+	@echo "Making $@"
+	@etags $(BOOKS_TOP_SOURCES)
diff -Nru acl2-6.2/books/milawa/ACL2/README acl2-6.3/books/milawa/ACL2/README
--- acl2-6.2/books/milawa/ACL2/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/README	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,75 @@
+Milawa/Sources/ACL2 Directory
+
+This directory contains most everything in Milawa.
+
+Files:
+
+   package.lsp
+     -- Definition of the Milawa package, used to create modified-acl2.
+
+   patches.lsp
+     -- Fixes, generally from Matt Kaufmann, for things that are wrong with
+        ACL2.  Sometimes this file is empty, sometimes it has stuff.
+
+   modified-acl2
+     -- A modified ACL2 image that includes the Milawa package pre-loaded
+        and any patches we want to apply to ACL2.  This is the ACL2 image
+        we use to build everything else.
+
+Directories:
+
+   Sources/ACL2/acl2-hacks/
+     -- Low-level ACL2 patches and macros for things like our MILAWA::defun,
+        MILAWA::defthm, MILAWA::force, macro expansion stuff, computed hints
+        to disable forcing and generalization, inlining, string manipulation,
+        etc.
+
+   Sources/ACL2/bootstrap/
+     -- Contains the code to translate the ACL2 proofs to Milawa, the progression
+        of proof checkers, and so on.
+
+   Sources/ACL2/build/
+     -- ACL2 definitions for build.modus-ponens, build.commute-pequal, and other
+        simple proof-building functions, and ACL2 proofs of their correctness
+
+   Sources/ACL2/classic/
+     -- Not too important.  Some of this may be outdated and/or broken.  This
+        was for "classic" derived rules of inference such as tautology checking,
+        equivalence substitution, the deduction law, etc., which might be of
+        some minor interest to logicians but are not particularly useful for
+        heuristic theorem proving.
+
+   Sources/ACL2/clauses/
+     -- ACL2 definitions to introduce clauses, clause cleaning, clause updating,
+        if-lifting, case splitting, and so on, and all of the ACL2 proofs about
+        these things.
+
+   Sources/ACL2/defderiv/
+     -- The very useful defderiv and deftheorem macros, contexts, latex output
+        for derivations, etc.
+
+   Sources/ACL2/interface/
+     -- ACL2 macros which make up the Milawa user interface, which is sometimes
+        called "symmetry".  This is used by all the bootstrapping stuff.
+
+   Sources/ACL2/logic/
+     -- ACL2 definitions for functions in the Milawa logic.  Introduces terms,
+        formulas, proofs, substitutions and matching, base evaluation, macro
+        translation, and so on.  Also contains all the ACL2 proofs about these
+        definitions.
+
+   Sources/ACL2/rewrite/
+     -- ACL2 definitions and proofs for everything having to do with rewriting,
+        including the assumptions system, traces, trace compilation, evaluation,
+        definition of rules, theories, and control structures, and caches.
+        Includes our unconditional, conditional, and fast rewriters.
+
+   Sources/ACL2/tactics/
+     -- ACL2 definitions and proofs for our tactic application and validation
+        functions.  Also includes worlds and the skeleton compiler.
+
+   Sources/ACL2/utilities/
+     -- This is where we introduce rules about arithmetic, simple functions like
+        len and app, and macros like deflist and defprojection.  This is pretty
+        much the simplest ACL2 stuff you can imagine.
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-customization.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,38 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(include-book "portcullis")
+(set-inhibit-warnings "theory" "double-rewrite")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/acl2-hacks/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/assume.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/assume.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/assume.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/assume.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,205 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+;; assume.lisp
+;;
+;; We introduce a utility for sharing assumptions across theorems.
+;;
+;; BOZO this file should be submitted to the ACL2 distribution and removed from
+;; our sources.  It should become a "misc" book.
+
+(defdoc assume
+  ":Doc-Section Events
+
+   a system for sharing assumptions across many theorems~/
+
+   We provide a simple table-based system for reusable assumptions.  To the
+   user, this system takes on the following interface:
+   ~bv[]
+     (assume <term>)
+        adds term to the local assumptions
+
+     (unassume <term>)
+        removes <term> from the local assumptions
+
+     (conclude <name> <thm> :hints ... :rule-classes ...)
+        like defth, but proves <thm> under the current assumptions
+   ~ev[]
+
+   For example, consider the following ACL2 rules:
+   ~bv[]
+     (defthm natp-of-plus
+       (implies (and (natp x)
+                     (natp y))
+                (natp (+ x y))))
+
+     (defthm natp-of-minus
+       (implies (and (natp x)
+                     (natp y)
+                     (< y x))
+                (natp (- x y))))
+   ~ev[]
+
+   We can convert these into the assume/conclude style as follows:
+   ~ev[]
+     (assume (natp x))
+     (assume (natp y))
+     (conclude natp-of-plus (natp (+ x y)))
+     (conclude natp-of-minus (implies (< y x) (natp (- x y))))
+   ~ev[]~/
+
+   The ~c[assume] and ~c[unassume] commands are implicitly ~il[local], so you
+   can use ~il[encapsulate] in addition to ~c[unassume] to limit the scope of
+   your assumptions.
+
+   The ~c[conclude] command recognizes ~c[thm]s of the following forms:
+   ~bv[]
+      (implies (and hyp1 ... hypN) concl)
+      (implies hyp1 concl)
+      concl
+   ~ev[]
+
+   It augments the <thm> by injecting the current assumptions after the last
+   hyp.  That is, we produce:
+   ~bv[]
+     (implies (and hyp1 ... hypN assm1 ... assmK) concl)
+     (implies (and hyp1 assm1 ... assmK) concl)
+     (implies (and assm1 ... assmK) concl)
+   ~ev[]
+
+   We expect this to be appropriate most of the time, since shared hyps tend to
+   be ``common'' sorts of things, e.g., type constraints, etc.  Meanwhile, the
+   unshared hyps should tend to be more complicated and unusual, so we place
+   them at the front of the rule in an effort to make ``fast failing'' rules.")
+
+
+(table assume.table 'assumptions nil)
+
+(defun assume.get-assumptions (world)
+  (declare (xargs :mode :program))
+  (cdr (assoc-eq 'assumptions (table-alist 'assume.table world))))
+
+(defun assume.assume-fn (assm)
+  `(local (table assume.table 'assumptions
+                 (cons ',assm (assume.get-assumptions world)))))
+
+(defmacro assume (assm)
+  (assume.assume-fn assm))
+
+
+(defun assume.unassume-fn (assm)
+  (declare (xargs :mode :program))
+  `(local (table assume.table 'assumptions
+                 (remove-equal ',assm (assume.get-assumptions world)))))
+
+(defmacro unassume (assm)
+  (assume.unassume-fn assm))
+
+
+(defun assume.conclude-fn (name thm extra-args world)
+  (declare (xargs :mode :program))
+  (cond ((and (consp thm)
+              (equal (first thm) 'implies)
+              (consp (second thm))
+              (equal (first (second thm)) 'and))
+         ;; Thm has the form (implies (and hyp1 ... hypN) concl)
+         (let ((hyps  (cdr (second thm)))
+               (concl (third thm)))
+           `(defthm ,name
+              (implies (and ,@(append hyps (assume.get-assumptions world)))
+                       ,concl)
+              ,@extra-args)))
+        ((and (consp thm)
+              (equal (first thm) 'implies))
+         ;; Thm has the form (implies hyp1 concl)
+         (let ((hyps  (list (second thm)))
+               (concl (third thm)))
+           `(defthm ,name
+              (implies (and ,@(append hyps (assume.get-assumptions world)))
+                       ,concl)
+              ,@extra-args)))
+        (t
+         ;; Thm has the form concl
+         `(defthm ,name
+            (implies (and ,@(assume.get-assumptions world))
+                     ,thm)
+            ,@extra-args))))
+
+(defmacro conclude (name thm &rest extra-args)
+  `(make-event (assume.conclude-fn ',name ',thm ',extra-args (w state))))
+
+
+
+
+
+(defmacro MILAWA::assume (&rest args)
+  `(ACL2::assume ,@args))
+
+(defmacro MILAWA::unassume (&rest args)
+  `(ACL2::unassume ,@args))
+
+(defun milawa-conclude-fn (name thm extra-args world)
+  (declare (xargs :mode :program))
+  (cond ((and (consp thm)
+              (equal (first thm) 'implies)
+              (consp (second thm))
+              (equal (first (second thm)) 'and))
+         ;; Thm has the form (implies (and hyp1 ... hypN) concl)
+         (let ((hyps  (cdr (second thm)))
+               (concl (third thm)))
+           `(MILAWA::defthm ,name
+              (implies (and ,@(ACL2::append hyps (ACL2::assume.get-assumptions world)))
+                       ,concl)
+              ,@extra-args)))
+        ((and (consp thm)
+              (equal (first thm) 'implies))
+         ;; Thm has the form (implies hyp1 concl)
+         (let ((hyps  (list (second thm)))
+               (concl (third thm)))
+           `(MILAWA::defthm ,name
+              (implies (and ,@(ACL2::append hyps (ACL2::assume.get-assumptions world)))
+                       ,concl)
+              ,@extra-args)))
+        (t
+         ;; Thm has the form concl
+         `(MILAWA::defthm ,name
+            (implies (and ,@(ACL2::assume.get-assumptions world))
+                     ,thm)
+            ,@extra-args))))
+
+(defmacro MILAWA::conclude (name thm &rest extra-args)
+  `(ACL2::make-event (milawa-conclude-fn ',name ',thm ',extra-args (ACL2::w ACL2::state))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/car-cdr-untranslate.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/car-cdr-untranslate.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/car-cdr-untranslate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/car-cdr-untranslate.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,119 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; car-cdr-untranslate.lisp
+;;
+;; This file just sets up some "untranslate patterns" which trick ACL2 into
+;; printing (second x), (third x), (fourth x), etc., instead of (cadr x),
+;; (caddr x), and (cadddr x) during proof attempts.  This yields much more
+;; readable output, in my opinion.
+;;
+;; BOZO I thought about submitting this book to the ACL2 distribution as a
+;; "misc" book, but even if we do that we won't be able to just include it
+;; because we need to use MILAWA::first instead of ACL2::first, etc.
+
+(in-package "MILAWA")
+
+(include-book "misc/untranslate-patterns" :dir :system)
+
+(ACL2::add-untranslate-pattern (car ?x)
+                               (first ?x))
+
+(ACL2::add-untranslate-pattern (car (car ?x))
+                               (first (first ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr ?x))
+                               (second ?x))
+
+(ACL2::add-untranslate-pattern (car (car (cdr ?x)))
+                               (first (second ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (car (cdr ?x))))
+                               (second (second ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (car ?x)))
+                               (second (first ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr ?x)))
+                               (third ?x))
+
+(ACL2::add-untranslate-pattern (car (car (cdr (cdr ?x))))
+                               (first (third ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (car (cdr (cdr ?x)))))
+                               (second (third ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (car (cdr (cdr ?x))))))
+                               (second (third ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (car (cdr ?x)))))
+                               (third (second ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (car ?x))))
+                               (third (first ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (cdr ?x))))
+                               (fourth ?x))
+
+(ACL2::add-untranslate-pattern (car (car (cdr (cdr (cdr ?x)))))
+                               (first (fourth ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (car (cdr (cdr (cdr ?x))))))
+                               (second (fourth ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (car (cdr (cdr (cdr ?x)))))))
+                               (third (fourth ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (cdr (car (cdr (cdr (cdr ?x))))))))
+                               (fourth (fourth ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (cdr (car (cdr (cdr ?x)))))))
+                               (fourth (third ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (cdr (car (cdr ?x))))))
+                               (fourth (second ?x)))
+
+(ACL2::add-untranslate-pattern (car (cdr (cdr (cdr (car ?x)))))
+                               (fourth (first ?x)))
+
+(ACL2::add-untranslate-pattern (first (cdr ?x))
+                               (second ?x))
+
+(ACL2::add-untranslate-pattern (first (cdr (cdr ?x)))
+                               (third ?x))
+
+(ACL2::add-untranslate-pattern (first (cdr (cdr (cdr ?x))))
+                               (fourth ?x))
+
+(ACL2::optimize-untranslate-patterns)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/cert.acl2 acl2-6.3/books/milawa/ACL2/acl2-hacks/cert.acl2
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/cert.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/debug-guards.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/debug-guards.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/debug-guards.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/debug-guards.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,132 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+(defun kwote-list (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (cons (kwote (car x))
+            (kwote-list (cdr x)))
+    nil))
+
+(mutual-recursion
+ (defun add-tracing (term)
+   (declare (xargs :mode :program))
+   (cond ((variablep term)
+          term)
+         ((fquotep term)
+          term)
+         ((not (consp term))
+          term)
+         (t
+          (let* ((fn (ffn-symb term))
+                 (args (fargs term))
+                 (traced-args (add-tracing-list args)))
+            `(prog2$ (cw "~x0 ==> ~x1~%"
+                         ',term
+                         ,(cons fn traced-args))
+                     ,term)))))
+ (defun add-tracing-list (term-list)
+   (declare (xargs :mode :program))
+   (if (consp term-list)
+       (cons (add-tracing (car term-list))
+             (add-tracing-list (cdr term-list)))
+     nil)))
+
+(defun debug-guards-fn (term world)
+  (declare (xargs :mode :program))
+  (let* ((fn                (car term))
+         (actuals           (kwote-list (cdr term)))
+         (formals           (formals fn world))
+         (guard             (guard fn nil world))
+         (sigma             (pairlis$ formals actuals))
+         (guard-sub         (sublis-expr sigma guard))
+         (guard-sub-untrans (untranslate guard-sub nil world)))
+    (add-tracing guard-sub-untrans)))
+
+(defmacro debug-guards (form)
+  ":Doc-Section Miscellaneous
+
+  identify the cause of a guard violation. ~/
+
+  If a function has an elaborate guard, it may be difficult to tell which
+  part of the guard is being violated when a guard violation occurs.  The
+  ~c[debug-guards] function may be useful in identifying the problem. ~/
+
+  Below is a trivial example.  We define a function with several inputs
+  and require that each input be a natural.
+
+  ~bv[]
+    ACL2 !> (defun f (a b c d e)
+              (declare (xargs :guard (and (natp a)
+                                          (natp b)
+                                          (natp c)
+                                          (natp d)
+                                          (natp e))))
+              (list a b c d e))
+  ~ev[]
+
+  We can now use debug-guards to see what would happen when we try to
+  run this function on various arguments.  For example, perhaps we do
+  not realize that the symbol d is not a natural.  Then, debug-guards
+  will show us why this function call will fail:
+
+  ~bv[]
+    ACL2 !> (debug-guards '(f 1 2 3 d 5))
+    (NATP 1) ==> T
+    (NATP 2) ==> T
+    (NATP 3) ==> T
+    (NATP 'D) ==> NIL
+    (AND (NATP 1) (NATP 2) (NATP 3) (NATP 'D) (NATP 5)) ==> NIL
+  ~ev[]
+
+  The argument to debug-guards should be a quoted function call, but
+  you can also perform evaluation ahead of time, e.g., using ~c[list]
+  as follows:
+
+  ~bv[]
+    ACL2 !> (defconst *d* 'd)
+
+    ACL2 !> (debug-guards (list 'f 1 2 3 *d* 5))
+    (NATP 1) ==> T
+    (NATP 2) ==> T
+    (NATP 3) ==> T
+    (NATP 'D) ==> NIL
+    (AND (NATP 1) (NATP 2) (NATP 3) (NATP 'D) (NATP 5)) ==> NIL
+  ~ev[]
+  ~/"
+  `(let ((dbg-form (debug-guards-fn ,form (w state))))
+     (er-progn (trans-eval dbg-form 'debug-guards state)
+	       (value :invisible))))
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/defthm.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/defthm.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/defthm.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/defthm.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,95 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+#|
+
+;; this isn't needed anymore because we have no-fertilize.lisp instead.
+;; we have added defthm and defthmd to the milawa package now.
+
+(defund mangle-hints2 (x)
+  ;; X should be a list of instructions to attach to a specific goal, i.e., X
+  ;; might be (:in-theory ... :induct ... :do-not ...).  If no :do-not key is
+  ;; provided, we add :do-not '(generalize fertilize).
+  (declare (xargs :guard (true-listp x)))
+  (if (member :do-not x)
+      x
+    (list* :do-not ''(generalize fertilize) x)))
+
+(defund mangle-hints1 (x)
+  ;; X should be a list of hints such as (("Goal" ...) ("Subgoal 1" ...)).  We
+  ;; find the goal hint and mangle2 it by adding :do-not '(generalize
+  ;; fertilize).  If no goal hint exists, we insert one.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (and (consp (car x))
+               (stringp (car (car x)))
+               (standard-char-listp (coerce (car (car x)) 'list))
+               (equal (string-downcase (car (car x))) "goal")
+               (true-listp (car x)))
+          (cons (cons "Goal" (mangle-hints2 (cdr (car x)))) (cdr x))
+        (cons (car x) (mangle-hints1 (cdr x))))
+    (cons (cons "Goal" (mangle-hints2 nil))
+          nil)))
+
+(defund mangle-hints (x)
+  ;; X should be an argument list given to defthm, e.g., something like
+  ;; ((implies hyps concl) :rule-classes ... :hints ... :otf-flg t).  We find
+  ;; the :hints argument and augment it with our :do-not instruction, or if
+  ;; there are no hints we insert our do-not hint on "Goal".
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (and (equal (car x) :hints)
+               (consp (cdr x)))
+          (list* :hints
+                 (mangle-hints1 (second x))
+                 (cddr x))
+        (cons (car x) (mangle-hints (cdr x))))
+    (list* :hints
+           (mangle-hints1 nil)
+           nil)))
+
+(defmacro MILAWA::thm (&rest args)
+  `(ACL2::thm ,@(mangle-hints args)))
+
+(defmacro MILAWA::defthm (&rest args)
+  `(ACL2::defthm ,@(mangle-hints args)))
+
+(defmacro MILAWA::defthmd (&rest args)
+  `(ACL2::defthmd ,@(mangle-hints args)))
+
+
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/defthms-flag.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/defthms-flag.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/defthms-flag.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/defthms-flag.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,301 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(include-book "mksym")
+
+;; The defthms-flag macro
+;;
+;; We now introduce a macro which helps prove theorems about mutually recursive
+;; functions using a flag function.  The general form is:
+;;
+;;   (defthms-flag
+;;     :shared-hyp (and hyp1 ... hypK)
+;;     :thms ((flag1 name1 thm1) ... (flagN nameN thmN) (t nameElse thmElse))
+;;     :flag-var var
+;;     :hints (("Goal" ...)))
+;;
+;; Calling this will introduce an encapsulate event which essentially has
+;; the following shape:
+;;
+;;    (encapsulate
+;;     ()
+;;     (local (defthm lemma
+;;              (implies shared-hyp
+;;                       (cond ((equal var 'flag1)
+;;                              thm1)
+;;                             ((equal var 'flag2)
+;;                              thm2)
+;;                             ...
+;;                             ((equal var 'flagN)
+;;                              thmN)
+;;                             (t
+;;                              thmElse)))
+;;              :rule-classes nil
+;;              :hints (("Goal" ...))))
+;;
+;;     (defthm name1
+;;       (implies shared-hyp
+;;                thm1)
+;;       :hints(("Goal" :use ((:instance lemma (flag 'flag1))))))
+;;
+;;     ...
+;;
+;;     (defthm nameN
+;;       (implies shared-hyp
+;;                thmN)
+;;       :hints(("Goal" :use ((:instance lemma (flag 'flagN))))))
+;;
+;;     (defthm nameElse
+;;       (implies shared-hyp
+;;                thmElse)
+;;       :hints(("Goal" :use ((:instance lemma (flag 'defthms-flag-otherwise)))))))
+;;
+;; By default, flag-var is set to "flag" and shared-hyp is set to t.
+;;
+;; The flags in the (flag name thm) triples need not be distinct; all such
+;; triples with the same flags will be merged together in the cond.
+
+(defun flag-triplep (x)
+  (declare (xargs :mode :program))
+  (and (or (and (true-listp x)
+                (equal (length x) 3))
+           (er hard 'flag-triplep "Expected ~x0 to be a (flag name thm) triple.~%" x))
+       (or (symbolp (first x))
+           (er hard 'flag-triplep "Expected the flag, ~x0, to be a symbol.~%" x))
+       (or (symbolp (second x))
+           (er hard 'flag-triplep "Expected the name, ~x0, to be a symbol.~%" x))
+       ;; No checking of the theorem.
+       ))
+
+(defun flag-triple-listp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (flag-triplep (car x))
+           (flag-triple-listp (cdr x)))
+    t))
+
+
+;; We sort the flag-triple we're given into buckets by their flag.  Each bucket
+;; has the form (flag <flag-triple-list>)
+
+(defun add-flag-triple-to-proper-bucket (flag-triple buckets)
+  (declare (xargs :mode :program))
+  (if (consp buckets)
+      (let* ((bucket1         (car buckets))
+             (bucket1-flag    (first bucket1))
+             (bucket1-triples (second bucket1)))
+        (if (equal bucket1-flag (car flag-triple))
+            (let ((new-bucket1 (list bucket1-flag (cons flag-triple bucket1-triples))))
+              (cons new-bucket1 (cdr buckets)))
+          (cons bucket1 (add-flag-triple-to-proper-bucket flag-triple (cdr buckets)))))
+    (let* ((new-bucket-tag     (car flag-triple))
+           (new-bucket-triples (list flag-triple))
+           (new-bucket         (list new-bucket-tag new-bucket-triples)))
+      (list new-bucket))))
+
+(defun assign-flag-triples-to-buckets (flag-triples buckets)
+  (declare (xargs :mode :program))
+  (if (consp flag-triples)
+      (assign-flag-triples-to-buckets (cdr flag-triples)
+                                      (add-flag-triple-to-proper-bucket (car flag-triples) buckets))
+    buckets))
+
+
+;; We also hyps the hyps that are shared on a per-flag basis.
+
+(defun eliminate-all-forcing (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (member-equal (car x) '(force MILAWA::force))
+          (eliminate-all-forcing (cadr x))
+        (cons (eliminate-all-forcing (car x))
+              (eliminate-all-forcing (cdr x))))
+    x))
+
+(defun split-into-hyps-and-conclusions (thms)
+  (declare (xargs :mode :program))
+  ;; Thms are a list we want to prove, which share a particular flag.
+  ;; We recognize theorems of three forms:
+  ;;   1. (implies (and hyp1 ... hypN) concl)
+  ;;   2. (implies hyp concl)
+  ;;   3. concl
+  ;; We create a new list whose entries are pairs of the form (hyp-list . concl)
+  (if (consp thms)
+      (cons (let ((thm1 (car thms)))
+              (if (and (consp thm1)
+                       (equal (first thm1) 'implies)
+                       (equal (length thm1) 3))
+                  (let ((antecedent (second thm1))
+                        (consequent (third thm1)))
+                    (if (and (consp antecedent)
+                             (equal (first antecedent) 'and))
+                        ;; (implies (and hyp1 ... hypN) concl)
+                        (cons (cdr antecedent) consequent)
+                      ;; (implies hyp1 concl)
+                      (cons (list antecedent) consequent)))
+                ;; concl
+                (cons nil thm1)))
+            (split-into-hyps-and-conclusions (cdr thms)))
+    nil))
+
+;; We compute the intersection of these hyp-lists to identify the shared hyps.
+
+(defun intersect (x y)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (member-equal (car x) y)
+          (cons (car x) (intersect (cdr x) y))
+        (intersect (cdr x) y))
+    nil))
+
+(defun intersect-list (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (consp (cdr x))
+          (intersect (car x) (intersect-list (cdr x)))
+        (car x))
+    nil))
+
+
+;; We then alter the (hyp-list . concl)-pairs list by removing all the shared
+;; hyps from each hyp-list.
+
+(defun aux-consolidate-theorems (thms shared-hyps)
+  ;; thms is a list of (hyp-list . concl) pairs.  We turn it into a list of
+  ;; (implies remaining-hyps concl) where the remaining-hyps are the original
+  ;; hyps, minus the shared hyps.
+  (declare (xargs :mode :program))
+  (if (consp thms)
+      (let* ((thm1       (car thms))
+             (thm1-hyps  (car thm1))
+             (thm1-concl (cdr thm1))
+             (new-hyps   (set-difference-equal thm1-hyps shared-hyps)))
+        (cons (cond ((and (consp new-hyps)
+                          (consp (cdr new-hyps)))
+                     `(if (and ,@new-hyps) ,thm1-concl t))
+                    ((consp new-hyps)
+                     `(if ,(car new-hyps) ,thm1-concl t))
+                    (t
+                     thm1-concl))
+              (aux-consolidate-theorems (cdr thms) shared-hyps)))
+    nil))
+
+(defun consolidate-theorems (thms)
+  (declare (xargs :mode :program))
+  ;; Thms are the ACL2-style theorems for a single flag.  We compute the shared
+  ;; hyps and create the best theorem we can.
+  (if (atom (cdr thms))
+      ;; Only one theorem.  Don't bother consolidating anything.
+      (car thms)
+    ;; More than one theorem.  Try to consolidate.
+    (let* ((hyp/conc-list (split-into-hyps-and-conclusions thms))
+           (shared-hyps   (intersect-list (strip-cars hyp/conc-list)))
+           (tweaked-thms  (aux-consolidate-theorems hyp/conc-list shared-hyps)))
+      (cond ((and (consp shared-hyps)
+                  (consp (cdr shared-hyps)))
+             `(implies (and ,@shared-hyps)
+                       (and ,@tweaked-thms)))
+            ((consp shared-hyps)
+             `(implies ,(car shared-hyps)
+                       (and ,@tweaked-thms)))
+            (t
+             `(and ,@tweaked-thms))))))
+
+(defun create-cond-pairs-from-buckets1 (flag-var buckets)
+  (declare (xargs :mode :program))
+  (if (consp buckets)
+      (let* ((bucket1         (car buckets))
+             (bucket1-flag    (first bucket1))
+             (bucket1-triples (second bucket1))
+             (bucket1-thms    (strip-caddrs bucket1-triples)))
+        (cons `(,(if (equal bucket1-flag t)
+                     t
+                   `(equal ,flag-var ',bucket1-flag))
+                ,(consolidate-theorems (eliminate-all-forcing bucket1-thms)))
+              (create-cond-pairs-from-buckets1 flag-var (cdr buckets))))
+    nil))
+
+(defun create-cond-pairs-from-buckets (flag-var buckets)
+  (declare (xargs :mode :program))
+  (let ((main-cond-pairs (create-cond-pairs-from-buckets1 flag-var buckets)))
+    (if (assoc t buckets)
+        ;; Some bucket has t as its flag, so we don't need to bother with a
+        ;; phony case.
+        main-cond-pairs
+      (append main-cond-pairs `((t t))))))
+
+(defun create-named-theorem-from-triple (flag-triple shared-hyp flag-var atp lemma-name)
+  (declare (xargs :mode :program))
+  (let* ((flag  (first flag-triple))
+         (name  (second flag-triple))
+         (thm   (third flag-triple))
+         (event (if atp 'MILAWA::defthm@ 'MILAWA::defthm))
+         (thm*  (if (equal shared-hyp t)
+                    thm
+                  `(implies ,shared-hyp ,thm))))
+    `(,event ,name
+             ,thm*
+             :hints(("Goal" :use ((:instance ,lemma-name (,flag-var ',(if (equal flag t)
+                                                                          'MILAWA::defthms-flag-otherwise
+                                                                        flag)))))))))
+
+(defun create-named-theorems-from-triples (flag-triples shared-hyp flag-var atp lemma-name)
+  (declare (xargs :mode :program))
+  (if (consp flag-triples)
+      (cons (create-named-theorem-from-triple (car flag-triples) shared-hyp flag-var atp lemma-name)
+            (create-named-theorems-from-triples (cdr flag-triples) shared-hyp flag-var atp lemma-name))
+    nil))
+
+(defun defthms-flag-fn (triples shared-hyp flag-var hints atp)
+  (declare (xargs :mode :program))
+  (and (flag-triple-listp triples)
+       (let* ((buckets    (assign-flag-triples-to-buckets triples nil))
+              (event      (if atp 'MILAWA::defthm@ 'MILAWA::defthm))
+              (lemma-name (mksym 'lemma-for- (second (car triples))))
+              (flag-thm   (if (equal shared-hyp t)
+                              `(cond ,@(create-cond-pairs-from-buckets flag-var buckets))
+                            `(implies ,shared-hyp
+                                      (cond ,@(create-cond-pairs-from-buckets flag-var buckets))))))
+         `(encapsulate
+           ()
+           (,event ,lemma-name
+                   ,flag-thm
+                   :rule-classes nil
+                   :hints ,hints)
+           ,@(create-named-theorems-from-triples triples shared-hyp flag-var atp lemma-name)))))
+
+(defmacro MILAWA::defthms-flag (&key (shared-hyp 't) thms (flag-var 'MILAWA::flag) @contextp hints)
+  (defthms-flag-fn thms shared-hyp flag-var hints @contextp))
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/defun.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/defun.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/defun.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/defun.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,401 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(include-book "misc/hons-help2" :dir :system)
+
+;; WHY WE NO LONGER INLINE
+;;
+;; Until inlining support was added to ACL2 proper, we used the misc/definline
+;; book to which supported it via a ttag.  But now that inlining is "properly"
+;; supported, ACL2 changes the names of functions into things like foo$inline.
+;;
+;; I got this mostly working for the ACL2 side of things, e.g., by using the
+;; new :e instead of :executable-counterpart, and by patching verify-guards to
+;; do a macro dereference.  So as far as the ACL2 stuff goes, this isn't too
+;; horrible, although it's still pretty ugly to have to think about this.
+;;
+;; But when it comes to bootstrapping, the whole $inline versus not $inline
+;; thing is a real pain in the ass, because we want to just take the ACL2
+;; definitions and turn them into Milawa definitions, but then suddenly our
+;; function bodies are no longer calling the "right" functions, etc.
+;;
+;; Rather than make Milawa's functions have ugly names like nfix$inline, it
+;; seems best to just not bother with inlining in ACL2.  This is a somewhat
+;; significant speed hit to bootstrapping, but, well, it's ACL2's fault for
+;; implementing inlining in this terrible way.
+;;
+;; (include-book "misc/definline" :dir :system :ttags '(definline))
+
+(include-book "io" :ttags :all)
+(include-book "half-translate")
+
+
+;; Our defun macro.
+;;
+;; We implement several features not found in the regular defun event.
+;;
+;;   - If :skip-guards is on the features-list, we strip out all the guards
+;;     specified by any function and set verify-guards to nil.
+;;
+;;   - We disable any :type-prescription rules that are generated.
+;;
+;;   - We write out a LaTeX file in autodoc/defun-foo.tex which includes
+;;     the definition of foo.
+;;
+;;   - We add an entry to the syntax-defuns table, which is used as part of
+;;     the bootstrapping phase.
+
+(defun aux-get-xarg (key x)
+  ;; X should be a list of keywords and values given to xargs.  We return the
+  ;; pair (key . value), unless key does not occur in xargs in which case we
+  ;; return nil.
+  (declare (xargs :guard t))
+  (if (and (consp x)
+           (consp (cdr x)))
+      (if (equal (car x) key)
+          (cons (first x) (second x))
+        (aux-get-xarg key (cddr x)))
+    nil))
+
+(defun get-xarg (key x)
+  ;; We look for any occurrences of (xargs ...) within x, then look up the key
+  ;; in the first occurrence we find.  We return the (key . value) pair if key
+  ;; occurs among the xargs, or nil otherwise.
+  (declare (xargs :guard t))
+  (cond ((atom x)
+         nil)
+        ((equal (car x) 'quote)
+         nil)
+        ((equal (car x) 'xargs)
+         (aux-get-xarg key (cdr x)))
+        (t
+         (or (get-xarg key (car x))
+             (get-xarg key (cdr x))))))
+
+(defun aux-remove-xarg (key x)
+  ;; X should be a list of keywords and values given to xargs.  We remove any
+  ;; instances of the specified key and its value.
+  (declare (xargs :guard t))
+  (if (and (consp x)
+           (consp (cdr x)))
+      (if (equal (car x) key)
+          (aux-remove-xarg key (cddr x))
+        (cons (first x)
+              (cons (second x)
+                    (aux-remove-xarg key (cddr x)))))
+    nil))
+
+(defun remove-xarg (key x)
+  ;; We look for any occurrences of (xargs ...) within x, then remove the
+  ;; specified key and its value from these xargs.
+  (declare (xargs :guard t))
+  (cond ((atom x)
+         x)
+        ((equal (car x) 'quote)
+         x)
+        ((equal (car x) 'xargs)
+         (cons 'xargs (aux-remove-xarg key (cdr x))))
+        (t
+         (cons (remove-xarg key (car x))
+               (remove-xarg key (cdr x))))))
+
+(defun set-xarg (key value x)
+  ;; We look for any occurrences of (xargs ...) within x.  If key occurs among
+  ;; these xargs, we erase it.  Then, we add the new key and value.
+  (declare (xargs :guard t))
+  (cond ((atom x)
+         x)
+        ((equal (car x) 'quote)
+         x)
+        ((equal (car x) 'xargs)
+         (cons 'xargs (list* key value (aux-remove-xarg key (cdr x)))))
+        (t
+         (cons (set-xarg key value (car x))
+               (set-xarg key value (cdr x))))))
+
+(defun remove-milawa-xargs (x)
+  ;; We look for occurrences of (xargs ...) within x and remove any occurrences
+  ;; of milawa-specific xargs.
+  (declare (xargs :guard t))
+  (remove-xarg :export x))
+
+(defun remove-guards (x)
+  ;; X should be the arguments given to a defun.  We erase any :guard xargs and
+  ;; set :verify-guards to nil.
+  (declare (xargs :guard t))
+  (set-xarg :verify-guards nil (remove-xarg :guard x)))
+
+(defmacro MILAWA::verify-guards (name &rest args)
+  ;; In guard-skipping mode, we ignore any verify-guards events and turn them
+  ;; into value-triples (i.e., no-ops).  Otherwise, we just turn them into
+  ;; ACL2::verify-guards commands.
+  #+skip-guards
+  `(value-triple '(ignoring-guards ,name . ,args))
+  #-skip-guards
+  ;; Fancy make-event stuff to deal with new $inline crap in ACL2 6.2,
+  ;; suggested by Matt Kaufmann
+  `(make-event
+    (let ((fn (deref-macro-name ',name (macro-aliases (w state)))))
+      (list* 'verify-guards fn ',args))))
+
+
+
+(defun defun-to-latex (defun-args state)
+  ;; We write autodoc/defun-foo.tex, so that the definition of foo can be kept
+  ;; current in latex documentation.
+  (declare (xargs :mode :program :stobjs state))
+  (let* ((name     (first defun-args))
+         (args     (second defun-args))
+         (body     (car (last defun-args)))
+         (filename (concatenate 'string "autodoc/defun-"
+                                (mangle-filename (string-downcase (symbol-name name)))
+                                ".tex")))
+    ;; This command changed in v3-5.  We still want to support 3-4, so we check
+    ;; for it explicitly.
+    (let* ((state #+v3-4 (set-acl2-print-case :downcase)
+                  #-v3-4 (set-print-case :downcase state))
+           (state (set-fmt-hard-right-margin 80 state))
+           (state (set-fmt-soft-right-margin 75 state)))
+      (mv-let
+       (channel state)
+       (open-output-channel$ filename :character state)
+       (let ((state (fms "\\begin{acl2}~%~q0~t1$=$~%~q2\\end{acl2}"
+                         (list (cons #\0 (cons name args))
+                               (cons #\1 2)
+                               (cons #\2 body))
+                         channel state nil)))
+         (close-output-channel channel state))))))
+
+(table milawa 'syntax-defun-entries nil)
+(table milawa 'acl2-defun-entries nil)
+
+(defun get-syntax-defun-entries (world)
+  (cdr (assoc 'syntax-defun-entries (table-alist 'milawa world))))
+
+(defun get-acl2-defun-entries (world)
+  (cdr (assoc 'acl2-defun-entries (table-alist 'milawa world))))
+
+(defun clean-up-body (x)
+  ;; When we "export" definitions to Milawa, we strip away a custom ACL2
+  ;; things.
+  (if (consp x)
+      (cond ((and (equal (car x) 'quote)
+                  (equal (len x) 2))
+             ;; Do not descend into quoted constants
+             x)
+            ((and (equal (car x) 'ACL2::time$)
+                  (equal (len x) 2))
+             ;; Simplify (ACL2::time$ x) to x
+             (clean-up-body (second x)))
+            ((and (equal (car x) 'ACL2::prog2$)
+                  (equal (len x) 3))
+             ;; Simplify (ACL2::prog2$ x y) to y
+             (clean-up-body (third x)))
+            ((and (equal (car x) 'ACL2::prog1$)
+                  (equal (len x) 3))
+             ;; Simplify (ACL2::prog1$ x y) to x
+             (clean-up-body (second x)))
+            ((equal (car x) 'ACL2::ec-call)
+             ;; Simplify (ACL2::ec-call x) to x
+             (clean-up-body (second x)))
+            ((or (equal (car x) 'ACL2::cw)
+                 (equal (car x) 'ACL2::cw!))
+             ;; Simplify (ACL2::cw ...) and (ACL2::cw! ...) to nil
+             nil)
+            ((equal (car x) 'ACL2::hist)
+             ;; Simplify (ACL2::hist x y ...) to (ACL2::list x y ...)
+             (cons 'ACL2::list
+                   (clean-up-body (cdr x))))
+            ((and (equal (car x) 'ACL2::hons)
+                  (equal (len x) 3))
+             ;; Simplify (ACL2::hons x y) to (ACL2::cons x y)
+             (list 'ACL2::cons
+                   (clean-up-body (second x))
+                   (clean-up-body (third x))))
+            ((and (or (equal (car x) 'let)
+                      (equal (car x) 'let*))
+                  (equal (len x) 4)
+                  (consp (third x))
+                  (equal (car (third x)) 'declare))
+             ;; Simplify (let ((blah)) (declare ...) body) to (let ((blah)) body)
+             (list (first x)
+                   (clean-up-body (second x))
+                   (clean-up-body (fourth x))))
+            (t
+             (cons (clean-up-body (car x))
+                   (clean-up-body (cdr x)))))
+    x))
+
+(defun defun-to-syntax-table-entry (defun-args state)
+  (declare (xargs :mode :program :stobjs state))
+  (let ((export (get-xarg :export defun-args))
+        (mode   (get-xarg :mode defun-args)))
+    (cond ((and (consp export)
+                (not (cdr export)))
+           ;; Found (:export nil) -- We are to skip this %SYNTAX-DEFUN.
+           (mv nil `(value-triple :invisible) state))
+          ((and (consp mode)
+                (equal (cdr mode) :program))
+           ;; Program mode function -- We are to skip this %SYNTAX-DEFUN
+           (mv nil `(value-triple :invisible) state))
+          (t
+           (let* ((name (first defun-args))
+                  (args (second defun-args)))
+             (mv-let (erp body state)
+                     (if (consp export)
+                         ;; Found (:export ...) -- We pretend that the
+                         ;; function's body is "..." and don't do any cleaning
+                         (mv nil (cdr export) state)
+                       ;; No (:export ...) -- We use the real body, half-translated
+                       ;; and cleaned up.
+                       (half-translate (clean-up-body (car (last defun-args))) state))
+                     (if erp
+                         (mv erp body state)
+                       (mv nil
+                           `(table milawa 'syntax-defun-entries
+                                   (cons '(MILAWA::%syntax-defun ,name ,args ,body)
+                                         (get-syntax-defun-entries ACL2::world)))
+                           state))))))))
+
+(defun MILAWA::defun-fn (type args)
+  (declare (xargs :mode :program))
+  ;; In guard-skipping mode, we strip out guards from the xargs and insert an
+  ;; explicit :verify-guards nil command.  Otherwise, we just turn them into
+  ;; ACL2::defun's and disable any type prescription generated.
+  `(encapsulate
+    ()
+    ;; Submit the defun with or without guards as necessary
+    #+skip-guards
+    (,type ,@(remove-guards (remove-milawa-xargs args)))
+    #-skip-guards
+    (,type ,@(remove-milawa-xargs args))
+    ;; Disable the type prescription, if one exists
+    (make-event
+     (let* ((fn ',(car args))
+            (props (getprops fn 'current-acl2-world (w state)))
+            (symbol-class (cdr (assoc 'symbol-class props))))
+       (if (equal symbol-class :program)
+           `(value-triple :invisible)
+         (prog2$
+          (cw "~%Note: Disabling type prescription for ~s0.~%" fn)
+          `(in-theory (disable (:t ,fn)))))))
+    ;; Write out a LaTeX file for the function
+    ;; BOZO disabling this because of stupid fucking OpenMCL .tem file bug ruining all my builds
+    (local (make-event ;; (let ((state (defun-to-latex ',args state)))
+                         (ACL2::mv nil `(value-triple :invisible) state))) ;; )
+    ;; Add the syntax-defun if necessary
+    (make-event (defun-to-syntax-table-entry ',args state))
+    ;; Add the acl2-defun entry
+    (table milawa 'acl2-defun-entries
+           (cons ',args (get-acl2-defun-entries world)))))
+
+(defmacro MILAWA::defun (&rest args)
+  (MILAWA::defun-fn 'ACL2::defun args))
+
+(defmacro MILAWA::defund (&rest args)
+  (MILAWA::defun-fn 'ACL2::defund args))
+
+
+
+(ACL2::table milawa 'functions-to-inline nil)
+
+(defun get-functions-to-inline (world)
+  (cdr (assoc 'functions-to-inline (ACL2::table-alist 'milawa world))))
+
+(defmacro MILAWA::definline (&rest args)
+  ;; Same as defun, but also indicates that the introduced function should be
+  ;; inlined.  We haven't yet implemented inlining in ACL2 yet.
+  `(ACL2::progn
+    ,(MILAWA::defun-fn
+      ;; This was formerly 'acl2::definline, but see WHY WE NO LONGER INLINE,
+      ;; above.
+      'ACL2::defun
+      args)
+    (ACL2::table milawa 'functions-to-inline
+                 (cons ',(first args)
+                       (get-functions-to-inline ACL2::world)))))
+
+(defmacro MILAWA::definlined (&rest args)
+  ;; Same as defund, but also indicates that the introduced function should be
+  ;; inlined.  We haven't implemented inlining in ACL2 yet.
+  `(ACL2::progn
+    ,(MILAWA::defun-fn
+      ;; This was formerly 'acl2::definline, but see WHY WE NO LONGER INLINE,
+      ;; above.
+      'ACL2::defund
+      args)
+    (ACL2::table milawa 'functions-to-inline
+                 (cons ',(first args)
+                       (get-functions-to-inline ACL2::world)))))
+
+
+(defun create-type-prescriptions (x)
+  ;; Given a list of names, we produce a list of (:type-prescription name1),
+  ;; ..., (:type-prescription nameN).
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (list :t (car x))
+            (create-type-prescriptions (cdr x)))
+    nil))
+
+(defmacro MILAWA::mutual-recursion (&rest args)
+  ;; ACL2::mutual-recursion is messy because ACL2 insists only ACL2::defun(d)s
+  ;; appear within it.  We change any MILAWA::defun(d)s to ACL2::defun(d)s.  If
+  ;; we are in guard-skipping mode, we also strip out guards and insert
+  ;; ":verify-guards nil" as appropriate.
+  `(ACL2::progn
+    (ACL2::mutual-recursion
+     ,@(subst 'ACL2::defun 'MILAWA::defun
+              (subst 'ACL2::defund 'MILAWA::defund
+                     #+skip-guards
+                     (remove-guards args)
+                     #-skip-guards
+                     args)))
+    (make-event
+     (if (not ',args)
+         `(value-triple :invisible)
+       (let* ((names (strip-cadrs ',args))
+              (props1 (getprops (car names) 'current-acl2-world (w state)))
+              (class1 (cdr (assoc 'symbol-class props1))))
+         (if (equal class1 :program)
+             ;; ALL functions are program mode.  Nothing to disable.
+             `(value-triple :invisible)
+           ;; ALL functions are logic mode.  Disable all type prescriptions.
+           ;; Defund's are handled by acl2's defund.
+           (prog2$
+            (cw "~%Note: Disabling type prescriptions for ~&0.~%" names)
+            (let ((disables (create-type-prescriptions names)))
+              `(in-theory (disable ,@disables))))))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/force.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/force.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/force.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/force.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,64 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+;; I like to write (force (and hyp1 ... hypN)).  I have found that most of the
+;; time, this works just fine and has the same behavior as (and (force HYP1)
+;; ... (force HYPN)).  However, I have also discovered a case where it does not
+;; behave the same, and it caused a proof to fail.  So I redefine force as a
+;; macro which expands (force (and hyp1 ... hypn)) into (and (force hyp1)
+;; ... (force hypn)).
+
+(defun aux-force-fn (hyps)
+  (declare (xargs :mode :program))
+  (if (consp hyps)
+      (cons `(MILAWA::force ,(car hyps))
+            (aux-force-fn (cdr hyps)))
+    nil))
+
+(defun jareds-force-fn (hyp)
+  ;; Produce the expansion for (force hyp)
+  (declare (xargs :mode :program))
+  (cond ((and (consp hyp)
+              (equal (car hyp) 'AND))
+         `(AND ,@(aux-force-fn (cdr hyp))))
+        ((and (consp hyp)
+              (equal (car hyp) 'MILAWA::force))
+         hyp)
+        (t
+         `(ACL2::force ,hyp))))
+
+(defmacro MILAWA::force (hyp)
+  (jareds-force-fn hyp))
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/half-translate.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/half-translate.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/half-translate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/half-translate.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,243 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+;; We introduce the function half-translate, which expands away any ACL2 macros
+;; we don't know how to handle, but leaves in tact the Milawa-supported macros
+;; such as let, let*, and, or, etc.
+;;
+;; We do this in a stupid and straightforward way.
+;;
+;;  1. We rewrite the macros we recognize into "wrappers" that ACL2 will not touch.
+;;  2. We use ACL2's translator to get rid of ACL2-specific macros
+;;  3. We finally unrewrite the "wrappers" back into their macro form.
+
+(defun tuplep (n x)
+  (declare (xargs :mode :program))
+  (if (zp n)
+      (equal x nil)
+    (and (consp x)
+         (tuplep (- n 1) (cdr x)))))
+
+(defun tuple-listp (n x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (tuplep n (car x))
+           (tuple-listp n (cdr x)))
+    t))
+
+(defun list2-list (x y)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (cons (list (car x) (car y))
+            (list2-list (cdr x) (cdr y)))
+    nil))
+
+(defun and-wrapper (x) x)
+(defun or-wrapper (x) x)
+(defun list-wrapper (x) x)
+(defun cond-wrapper (x y) (list x y))
+(defun let-wrapper (a b c d) (list a b c d))
+(defun let*-wrapper (a b c d) (list a b c d))
+(defun lambda-wrapper (x y z) (list x y z))
+(defun first-wrapper (x) x)
+(defun second-wrapper (x) x)
+(defun third-wrapper (x) x)
+(defun fourth-wrapper (x) x)
+(defun fifth-wrapper (x) x)
+
+
+
+
+(mutual-recursion
+
+ (defun half-translate-rw (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (cond ((equal (car x) 'quote)
+              ;; Don't descend into quoted terms
+              x)
+             ((equal (car x) 'MILAWA::first)
+              `(first-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'MILAWA::second)
+              `(second-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'MILAWA::third)
+              `(third-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'MILAWA::fourth)
+              `(fourth-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'MILAWA::fifth)
+              `(fifth-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'and)
+              `(and-wrapper (list ,@(half-translate-rw-list (cdr x)))))
+             ((equal (car x) 'or)
+              `(or-wrapper (list ,@(half-translate-rw-list (cdr x)))))
+             ((equal (car x) 'list)
+              `(list-wrapper (list ,@(half-translate-rw-list (cdr x)))))
+             ((and (equal (car x) 'cond)
+                   (tuple-listp 2 (cdr x)))
+              (let ((tests (strip-cars (cdr x)))
+                    (bodies (strip-cadrs (cdr x))))
+                `(cond-wrapper (list ,@(half-translate-rw-list tests))
+                               (list ,@(half-translate-rw-list bodies)))))
+             ((or (equal (car x) 'let)
+                  (equal (car x) 'let*))
+              (let* ((wrapper   (if (equal (car x) 'let) 'let-wrapper 'let*-wrapper))
+                     (let-pairs (second x))
+                     (vars      (strip-cars let-pairs))
+                     (vals      (strip-cadrs let-pairs))
+                     (decl      (if (equal (len x) 4) (third x) nil))
+                     (body      (if (equal (len x) 4) (fourth x) (third x))))
+                `(,wrapper (quote ,vars)
+                           (list ,@(half-translate-rw-list vals))
+                           (quote ,decl)
+                           ,(half-translate-rw body))))
+             ((and (consp (car x))
+                   (equal (caar x) 'lambda))
+              (let ((formals (second (car x)))
+                    (body    (third (car x)))
+                    (actuals (cdr x)))
+                `(lambda-wrapper (quote ,formals)
+                                 ,(half-translate-rw body)
+                                 (list ,@(half-translate-rw-list actuals)))))
+             (t
+              ;; Not one of our macros to protect, descend through it
+              (cons (car x)
+                    (half-translate-rw-list (cdr x)))))
+     x))
+
+ (defun half-translate-rw-list (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (cons (half-translate-rw (car x))
+             (half-translate-rw-list (cdr x)))
+     nil)))
+
+(defun unzip-cons-list (x)
+  ;; X is a list like (cons a (cons b 'nil))
+  ;; We need to extract (a b).
+  (if (and (consp x)
+           (equal (car x) 'cons))
+      (cons (second x)
+            (unzip-cons-list (third x)))
+    nil))
+
+(mutual-recursion
+
+ (defun half-translate-unrewrite (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (cond ((equal (car x) 'quote)
+              (if (or (natp (second x))
+                      (equal (second x) t)
+                      (equal (second x) nil))
+                  ;; Unquote values which don't need quotes
+                  (second x)
+                x))
+             ((equal (car x) 'first-wrapper)
+              `(MILAWA::first ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'second-wrapper)
+              `(MILAWA::second ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'third-wrapper)
+              `(MILAWA::third ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'fourth-wrapper)
+              `(MILAWA::fourth ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'fifth-wrapper)
+              `(MILAWA::fifth ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'and-wrapper)
+              ;; (and-wrapper (cons a (cons b (cons c nil)))) ==> (and a b c)
+              `(and ,@(half-translate-unrewrite-list (unzip-cons-list (second x)))))
+             ((equal (car x) 'or-wrapper)
+              `(or ,@(half-translate-unrewrite-list (unzip-cons-list (second x)))))
+             ((equal (car x) 'list-wrapper)
+              `(list ,@(half-translate-unrewrite-list (unzip-cons-list (second x)))))
+             ((equal (car x) 'cond-wrapper)
+              `(cond ,@(list2-list (half-translate-unrewrite-list (unzip-cons-list (second x)))
+                                   (half-translate-unrewrite-list (unzip-cons-list (third x))))))
+             ((or (equal (car x) 'let*-wrapper)
+                  (equal (car x) 'let-wrapper))
+              (let ((form (if (equal (car x) 'let*-wrapper) 'let* 'let))
+                    (vars (second (second x))) ;; (second x) = (quote ,vars)
+                    (vals (half-translate-unrewrite-list (unzip-cons-list (third x))))
+                    ;(decl (second (fourth x))) ;; (fourth x) = (quote [(declare ...)])
+                    (body (half-translate-unrewrite (fifth x))))
+                `(,form ,(list2-list vars vals)
+                        ;,@(if decl (list decl) nil)
+                        ,body)))
+             ((equal (car x) 'lambda-wrapper)
+              (let ((formals (second (second x))) ;; (second x) = (quote formals)
+                    (body    (half-translate-unrewrite (third x)))
+                    (actuals (half-translate-unrewrite-list (unzip-cons-list (fourth x)))))
+                `((lambda ,formals ,body) ,@actuals)))
+             (t
+              (cons (car x)
+                    (half-translate-unrewrite-list (cdr x)))))
+     x))
+
+ (defun half-translate-unrewrite-list (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (cons (half-translate-unrewrite (car x))
+             (half-translate-unrewrite-list (cdr x)))
+     nil)))
+
+
+(defun half-translate (x state)
+  (declare (xargs :mode :program :stobjs state))
+  (mv-let (erp val state)
+          (translate (half-translate-rw x) nil nil nil 'half-translate (w state) state)
+          (if erp
+              (mv erp val state)
+            (mv nil (half-translate-unrewrite val) state))))
+
+;; Here's some test code:
+#|
+(let ((term '(append (let* ((a (+ 1 '(2 . 5)))
+                            (b (or (MILAWA::first x) (MILAWA::second y)))
+                            (c (* a b)))
+                       (list a b c))
+                     (let ((a (+ 1 2))
+                           (b (or 'foo y))
+                           (c (* a b)))
+                       (list a b c))
+                     (cond ((equal (MILAWA::third x) (or 1 a))
+                            (and y z))
+                           ((equal x 2)
+                            ((lambda (x y z) (+ x (or y z))) 1 2 (and 3 4 5)))
+                           (t
+                            (list a b c))))))
+  (half-translate term state))
+|#
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/half-untranslate.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/half-untranslate.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/half-untranslate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/half-untranslate.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,236 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+;; We introduce the function half-translate, which expands away any ACL2 macros
+;; we don't know how to handle, but leaves in tact the Milawa-supported macros
+;; such as let, let*, and, or, etc.
+;;
+;; We do this in a stupid and straightforward way.
+;;
+;;  1. We rewrite the macros we recognize into "wrappers" that ACL2 will not touch.
+;;  2. We use ACL2's translator to get rid of ACL2-specific macros
+;;  3. We finally unrewrite the "wrappers" back into their macro form.
+;;
+;; Gaa, we need to try to do this using trans1 instead and iterating.
+
+(defun tuplep (n x)
+  (declare (xargs :mode :program))
+  (if (zp n)
+      (equal x nil)
+    (and (consp x)
+         (tuplep (- n 1) (cdr x)))))
+
+(defun tuple-listp (n x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (tuplep n (car x))
+           (tuple-listp n (cdr x)))
+    t))
+
+(defun list2-list (x y)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (cons (list (car x) (car y))
+            (list2-list (cdr x) (cdr y)))
+    nil))
+
+(defun and-wrapper (x) x)
+(defun or-wrapper (x) x)
+(defun list-wrapper (x) x)
+(defun cond-wrapper (x y) (list x y))
+(defun let-wrapper (a b c d) (list a b c d))
+(defun let*-wrapper (a b c d) (list a b c d))
+(defun first-wrapper (x) x)
+(defun second-wrapper (x) x)
+(defun third-wrapper (x) x)
+(defun fourth-wrapper (x) x)
+(defun fifth-wrapper (x) x)
+
+
+(mutual-recursion
+
+ (defun half-translate-rw (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (cond ((equal (car x) 'quote)
+              ;; Don't descend into quoted terms
+              x)
+             ((equal (car x) 'MILAWA::first)
+              `(first-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'MILAWA::second)
+              `(second-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'MILAWA::third)
+              `(third-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'MILAWA::fourth)
+              `(fourth-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'MILAWA::fifth)
+              `(fifth-wrapper ,(half-translate-rw (second x))))
+             ((equal (car x) 'and)
+              `(and-wrapper (list ,@(half-translate-rw-list (cdr x)))))
+             ((equal (car x) 'or)
+              `(or-wrapper (list ,@(half-translate-rw-list (cdr x)))))
+             ((equal (car x) 'list)
+              `(list-wrapper (list ,@(half-translate-rw-list (cdr x)))))
+             ((and (equal (car x) 'cond)
+                   (tuple-listp 2 (cdr x)))
+              (let ((tests (strip-cars (cdr x)))
+                    (bodies (strip-cadrs (cdr x))))
+                `(cond-wrapper (list ,@(half-translate-rw-list tests))
+                               (list ,@(half-translate-rw-list bodies)))))
+             ((or (equal (car x) 'let)
+                  (equal (car x) 'let*))
+              (let* ((wrapper   (if (equal (car x) 'let) 'let-wrapper 'let*-wrapper))
+                     (let-pairs (second x))
+                     (vars      (strip-cars let-pairs))
+                     (vals      (strip-cadrs let-pairs))
+                     (decl      (if (equal (len x) 4) (third x) nil))
+                     (body      (if (equal (len x) 4) (fourth x) (third x))))
+                `(,wrapper (quote ,vars)
+                           (list ,@(half-translate-rw-list vals))
+                           (quote ,decl)
+                           ,(half-translate-rw body))))
+             ;; BOZO add support for lambdas case
+             (t
+              ;; Not one of our macros to protect, descend through it
+              (cons (car x)
+                    (half-translate-rw-list (cdr x)))))
+     x))
+
+ (defun half-translate-rw-list (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (cons (half-translate-rw (car x))
+             (half-translate-rw-list (cdr x)))
+     nil)))
+
+(defun unzip-cons-list (x)
+  ;; X is a list like (cons a (cons b 'nil))
+  ;; We need to extract (a b).
+  (if (and (consp x)
+           (equal (car x) 'cons))
+      (cons (second x)
+            (unzip-cons-list (third x)))
+    nil))
+
+(mutual-recursion
+
+ (defun half-translate-unrewrite (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (cond ((equal (car x) 'quote)
+              (if (or (natp (second x))
+                      (equal (second x) t)
+                      (equal (second x) nil))
+                  ;; Unquote values which don't need quotes
+                  (second x)
+                x))
+             ((equal (car x) 'first-wrapper)
+              `(MILAWA::first ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'second-wrapper)
+              `(MILAWA::second ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'third-wrapper)
+              `(MILAWA::third ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'fourth-wrapper)
+              `(MILAWA::fourth ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'fifth-wrapper)
+              `(MILAWA::fifth ,(half-translate-unrewrite (second x))))
+             ((equal (car x) 'and-wrapper)
+              ;; (and-wrapper (cons a (cons b (cons c nil)))) ==> (and a b c)
+              `(and ,@(half-translate-unrewrite-list (unzip-cons-list (second x)))))
+             ((equal (car x) 'or-wrapper)
+              `(or ,@(half-translate-unrewrite-list (unzip-cons-list (second x)))))
+             ((equal (car x) 'list-wrapper)
+              `(list ,@(half-translate-unrewrite-list (unzip-cons-list (second x)))))
+             ((equal (car x) 'cond-wrapper)
+              `(cond ,@(list2-list (half-translate-unrewrite-list (unzip-cons-list (second x)))
+                                   (half-translate-unrewrite-list (unzip-cons-list (third x))))))
+             ((or (equal (car x) 'let*-wrapper)
+                  (equal (car x) 'let-wrapper))
+              (let ((form (if (equal (car x) 'let*-wrapper) 'let* 'let))
+                    (vars (second (second x))) ;; (second x) = (quote ,vars)
+                    (vals (half-translate-unrewrite-list (unzip-cons-list (third x))))
+                    ;(decl (second (fourth x))) ;; (fourth x) = (quote [(declare ...)])
+                    (body (half-translate-unrewrite (fifth x))))
+                `(,form ,(list2-list vars vals)
+                        ;,@(if decl (list decl) nil)
+                        ,body)))
+             (t
+              (cons (car x)
+                    (half-translate-unrewrite-list (cdr x)))))
+     x))
+
+ (defun half-translate-unrewrite-list (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (cons (half-translate-unrewrite (car x))
+             (half-translate-unrewrite-list (cdr x)))
+     nil)))
+
+
+(defun half-translate (x state)
+  (declare (xargs :mode :program :stobjs state))
+  (mv-let (erp val state)
+          (translate (half-translate-rw x) nil nil nil 'half-translate (w state) state)
+          (if erp
+              (mv erp val state)
+            (mv nil (half-translate-unrewrite val) state))))
+
+;; Here's some test code:
+#|
+; (include-book "../utilities/primitives" :ttags :all)
+(let ((term '(append (let* ((a (+ 1 '(2 . 5)))
+                            (b (or (MILAWA::first x) (MILAWA::second y)))
+                            (c (* a b)))
+                       (list a b c))
+                     (let ((a (+ 1 2))
+                           (b (or 'foo y))
+                           (c (* a b)))
+                       (list a b c))
+                     (cond ((equal (MILAWA::third x) (or 1 a))
+                            (and y z))
+                           ((equal x 2)
+                            (or y z))
+                           (t
+                            (list a b c))))))
+  (half-translate term state))
+|#
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/info.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/info.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/info.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/info.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,519 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(program)
+(set-state-ok t)
+
+
+
+;; BOZO would like to switch to ACL2's versions, but they don't include :class.
+;; Sent Matt an email.  Hopefully this gets fixed in ACL2 3.4.
+
+
+;; Info functions inspect the various rules and turn them into alists of the
+;; form:
+;;
+;;   (key . (value1 ... valueN))
+;;
+;; When we print these alists with our "info" function, we only print "key:
+;; value1".  This lets you store additional information in later values.  For
+;; example, value1 might want to untranslate the term for prettier printing to
+;; the user, or decode the type-set, etc.  Value2 can then include the original
+;; term or undecoded type-set, so that programs can use that value instead.
+
+(defun MILAWA::info-for-lemmas (lemmas numes ens wrld)
+  (if (null lemmas)
+      nil
+    (let* ((rule                (car lemmas))
+           (nume                (access rewrite-rule rule :nume))
+           (rune                (access rewrite-rule rule :rune))
+           (subclass            (access rewrite-rule rule :subclass))
+           (lhs                 (access rewrite-rule rule :lhs))
+           (rhs                 (access rewrite-rule rule :rhs))
+           (hyps                (access rewrite-rule rule :hyps))
+           (equiv               (access rewrite-rule rule :equiv))
+           (backchain-limit-lst (access rewrite-rule rule :backchain-limit-lst))
+           (heuristic-info      (access rewrite-rule rule :heuristic-info))
+           )
+      (if (or (eq numes t)
+              (member nume numes))
+          (cons `((:rune            ,rune)
+                  (:nume            ,nume)
+                  (:class           :rewrite)
+                  (:enabledp        ,(if (enabled-runep rune ens wrld) t nil))
+                  ,@(if (eq subclass 'meta)
+                        `((:meta-fn ,lhs)
+                          (:hyp-fn  ,(or hyps :none) ,hyps))
+                      `((:lhs  ,(untranslate lhs nil wrld) ,lhs)
+                        (:rhs  ,(untranslate rhs nil wrld) ,rhs)
+                        (:hyps ,(untranslate-hyps hyps wrld) ,hyps)))
+                  (:equiv               ,equiv)
+                  (:backchain-limit-lst ,backchain-limit-lst)
+                  (:subclass            ,subclass)
+                  ,@(cond ((eq subclass 'backchain)
+                           `((:loop-stopper ,heuristic-info)))
+                          ((eq subclass 'definition)
+                           `((:clique           ,(car heuristic-info))
+                             (:controller-alist ,(cdr heuristic-info))))
+                          (t
+                           nil)))
+                (MILAWA::info-for-lemmas (cdr lemmas) numes ens wrld))
+        (MILAWA::info-for-lemmas (cdr lemmas) numes ens wrld)))))
+
+(defun MILAWA::info-for-well-founded-relation-rules (rules)
+
+; There is no record class corresponding to well-founded-relation rules.  But
+; the well-founded-relation-alist contains triples of the form (rel mp . rune)
+; and we assume rules is a list of such triples.
+
+  (if (null rules)
+      nil
+    (let* ((rule (car rules))
+           (rune (cddr rule)))
+      (cons (list (list :rune                  rune)
+                  (list :class                 :well-founded-relation)
+                  (list :domain-predicate      (cadr rule))
+                  (list :well-founded-relation (car rule)))
+            (MILAWA::info-for-well-founded-relation-rules (cdr rules))))))
+
+(defun MILAWA::info-for-built-in-clause-rules1 (rules numes ens wrld)
+  (if (null rules)
+      nil
+    (let* ((rule   (car rules))
+           (nume   (access built-in-clause rule :nume))
+           (rune   (access built-in-clause rule :rune))
+           (clause (access built-in-clause rule :clause)))
+      (if (member nume numes)
+          (cons (list (list :rune     rune)
+                      (list :nume     nume)
+                      (list :class    :built-in-clauses)
+                      (list :enabledp (if (enabled-runep rune ens wrld) t nil))
+                      (list :clause   (prettyify-clause clause nil wrld) clause))
+                (MILAWA::info-for-built-in-clause-rules1 (cdr rules) numes ens wrld))
+        (MILAWA::info-for-built-in-clause-rules1 (cdr rules) numes ens wrld)))))
+
+(defun MILAWA::info-for-built-in-clause-rules (alist numes ens wrld)
+  (if (null alist)
+      nil
+    (append (MILAWA::info-for-built-in-clause-rules1 (cdar alist) numes ens wrld)
+            (MILAWA::info-for-built-in-clause-rules (cdr alist) numes ens wrld))))
+
+(defun MILAWA::info-for-compound-recognizer-rules (rules numes ens wrld)
+  (if (null rules)
+      nil
+    (let* ((rule     (car rules))
+           (nume     (access recognizer-tuple rule :nume))
+           (rune     (access recognizer-tuple rule :rune))
+           (true-ts  (access recognizer-tuple rule :true-ts))
+           (false-ts (access recognizer-tuple rule :false-ts))
+           (strongp  (access recognizer-tuple rule :strongp)))
+      (if (member nume numes)
+          (cons (list (list :rune     rune)
+                      (list :nume     nume)
+                      (list :class    :compound-recognizer)
+                      (list :enabledp (if (enabled-runep rune ens wrld) t nil))
+                      (list :fn       (access recognizer-tuple rule :fn))
+                      (list :true-ts  (decode-type-set true-ts) true-ts)
+                      (list :false-ts (decode-type-set false-ts) false-ts)
+                      (list :strongp  strongp))
+                (MILAWA::info-for-compound-recognizer-rules (cdr rules) numes ens wrld))
+        (MILAWA::info-for-compound-recognizer-rules (cdr rules) numes ens wrld)))))
+
+(defun MILAWA::info-for-generalize-rules (rules numes ens wrld)
+  (if (null rules)
+      nil
+    (let* ((rule    (car rules))
+           (nume    (access generalize-rule rule :nume))
+           (rune    (access generalize-rule rule :rune))
+           (formula (access generalize-rule rule :formula)))
+      (if (member nume numes)
+          (cons (list (list :rune     rune)
+                      (list :nume     nume)
+                      (list :class    :generalize)
+                      (list :enabledp (if (enabled-runep rune ens wrld) t nil))
+                      (list :formula  (untranslate formula t wrld) formula))
+                (MILAWA::info-for-generalize-rules (cdr rules) numes ens wrld))
+        (MILAWA::info-for-generalize-rules (cdr rules) numes ens wrld)))))
+
+(defun MILAWA::info-for-linear-lemmas (rules numes ens wrld)
+  (if (null rules)
+      nil
+    (let* ((rule                (car rules))
+           (nume                (access linear-lemma rule :nume))
+           (rune                (access linear-lemma rule :rune))
+           (hyps                (access linear-lemma rule :hyps))
+           (concl               (access linear-lemma rule :concl))
+           (max-term            (access linear-lemma rule :max-term))
+           (backchain-limit-lst (access linear-lemma rule :backchain-limit-lst)))
+      (if (member nume numes)
+          (cons (list (list :rune                rune)
+                      (list :nume                nume)
+                      (list :class               :linear)
+                      (list :enabledp            (if (enabled-runep rune ens wrld) t nil))
+                      (list :hyps                (untranslate-hyps hyps wrld)    hyps)
+                      (list :concl               (untranslate concl nil wrld)    concl)
+                      (list :max-term            (untranslate max-term nil wrld) max-term)
+                      (list :backchain-limit-lst backchain-limit-lst))
+                (MILAWA::info-for-linear-lemmas (cdr rules) numes ens wrld))
+        (MILAWA::info-for-linear-lemmas (cdr rules) numes ens wrld)))))
+
+(defun MILAWA::info-for-eliminate-destructors-rule (rule numes ens wrld)
+  (let ((rune             (access elim-rule rule :rune))
+        (nume             (access elim-rule rule :nume))
+        (hyps             (access elim-rule rule :hyps))
+        (lhs              (access elim-rule rule :lhs))
+        (rhs              (access elim-rule rule :rhs))
+        (destructor-term  (access elim-rule rule :destructor-term))
+        (destructor-terms (access elim-rule rule :destructor-terms))
+        (crucial-position (access elim-rule rule :crucial-position)))
+    (if (member nume numes)
+        (list (list :rune             rune)
+              (list :nume             nume)
+              (list :class            :elim)
+              (list :enabledp         (if (enabled-runep rune ens wrld) t nil))
+              (list :hyps             (untranslate-hyps hyps wrld)                hyps)
+              (list :lhs              (untranslate lhs nil wrld)                  lhs)
+              (list :rhs              (untranslate rhs nil wrld)                  rhs)
+              (list :destructor-term  (untranslate destructor-term nil wrld)      destructor-term)
+              (list :destructor-terms (untranslate-lst destructor-terms nil wrld) destructor-terms)
+              (list :crucial-position crucial-position))
+      nil)))
+
+;; (defun info-for-congruences (val numes ens wrld)
+
+;; ; val is of the form (equiv geneqv1 ... geneqvk ... geneqvn).
+;; ; This seems complicated so we'll punt for now.
+
+;;   (declare (ignore val numes ens wrld))
+;;   nil)
+
+;; (defun info-for-coarsenings (val numes ens wrld)
+
+;; ; It is not obvious how to determine which coarsenings are really new, so we
+;; ; print nothing.
+
+;;   (declare (ignore val numes ens wrld))
+;;   nil)
+
+(defun MILAWA::info-for-forward-chaining-rules (rules numes ens wrld)
+  (if (null rules)
+      nil
+    (let* ((rule    (car rules))
+           (rune    (access forward-chaining-rule rule :rune))
+           (nume    (access forward-chaining-rule rule :nume))
+           (trigger (access forward-chaining-rule rule :trigger))
+           (hyps    (access forward-chaining-rule rule :hyps))
+           (concls  (access forward-chaining-rule rule :concls)))
+      (if (member nume numes)
+          (cons (list (list :rune     rune)
+                      (list :nume     nume)
+                      (list :class    :forward-chaining)
+                      (list :enabledp (if (enabled-runep rune ens wrld) t nil))
+                      (list :trigger  (untranslate trigger nil wrld) trigger)
+                      (list :hyps     (untranslate-hyps hyps wrld)   hyps)
+                      (list :concls   (untranslate-hyps concls wrld) concls))
+                (MILAWA::info-for-forward-chaining-rules (cdr rules) numes ens wrld))
+        (MILAWA::info-for-forward-chaining-rules (cdr rules) numes ens wrld)))))
+
+(defun MILAWA::info-for-type-prescriptions (rules numes ens wrld)
+  (if (null rules)
+      nil
+    (let* ((rule      (car rules))
+           (rune      (access type-prescription rule :rune))
+           (nume      (access type-prescription rule :nume))
+           (term      (access type-prescription rule :term))
+           (hyps      (access type-prescription rule :hyps))
+           (basic-ts  (access type-prescription rule :basic-ts))
+           (vars      (access type-prescription rule :vars))
+           (corollary (access type-prescription rule :corollary)))
+      (if (member nume numes)
+          (cons (list (list :rune      rune)
+                      (list :nume      nume)
+                      (list :class     :type-prescription)
+                      (list :enabledp  (if (enabled-runep rune ens wrld) t nil))
+                      (list :term      (untranslate term nil wrld)    term)
+                      (list :hyps      (untranslate-hyps hyps wrld)   hyps)
+                      (list :basic-ts  (decode-type-set basic-ts)     basic-ts)
+                      (list :vars      vars)
+                      (list :corollary (untranslate corollary t wrld) corollary))
+                (MILAWA::info-for-type-prescriptions (cdr rules) numes ens wrld))
+        (MILAWA::info-for-type-prescriptions (cdr rules) numes ens wrld)))))
+
+(defun MILAWA::info-for-induction-rules (rules numes ens wrld)
+  (if (null rules)
+      nil
+    (let* ((rule      (car rules))
+           (rune      (access induction-rule rule :rune))
+           (nume      (access induction-rule rule :nume))
+           (pattern   (access induction-rule rule :pattern))
+           (condition (access induction-rule rule :condition))
+           (scheme    (access induction-rule rule :scheme)))
+      (if (member nume numes)
+          (cons (list (list :rune      rune)
+                      (list :nume      nume)
+                      (list :class     :induction)
+                      (list :enabledp  (if (enabled-runep rune ens wrld) t nil))
+                      (list :pattern   (untranslate pattern nil wrld) pattern)
+                      (list :condition (untranslate condition t wrld) condition)
+                      (list :scheme    (untranslate scheme nil wrld)  scheme))
+                (MILAWA::info-for-induction-rules (cdr rules) numes ens wrld))
+        (MILAWA::info-for-induction-rules (cdr rules) numes ens wrld)))))
+
+(defun MILAWA::info-for-type-set-inverter-rules (rules numes ens wrld)
+  (if (null rules)
+      nil
+    (let* ((rule     (car rules))
+           (rune     (access type-set-inverter-rule rule :rune))
+           (nume     (access type-set-inverter-rule rule :nume))
+           (type-set (access type-set-inverter-rule rule :ts))
+           (terms    (access type-set-inverter-rule rule :terms))
+           )
+      (if (member nume numes)
+          (cons (list (list :rune      rune)
+                      (list :nume      nume)
+                      (list :class     :type-set-inverter)
+                      (list :enabledp  (if (enabled-runep rune ens wrld) t nil))
+                      (list :type-set  type-set)
+                      (list :condition (untranslate-hyps terms wrld) terms))
+                (MILAWA::info-for-type-set-inverter-rules (cdr rules) numes ens wrld))
+        (MILAWA::info-for-type-set-inverter-rules (cdr rules) numes ens wrld)))))
+
+(defun MILAWA::info-for-x-rules (sym key val numes ens wrld)
+
+; See add-x-rule for an enumeration of rule classes that generate the
+; properties shown below.  Keep this function in sync with find-rules-of-rune2.
+
+  (cond
+   ((eq key 'global-value)
+    (case sym
+      (well-founded-relation-alist
+
+; Avoid printing the built-in anonymous rule if that is all we have here.
+
+       (if (consp (cdr val))
+           (MILAWA::info-for-well-founded-relation-rules val)
+         nil))
+      (built-in-clauses        (MILAWA::info-for-built-in-clause-rules val numes ens wrld))
+      (type-set-inverter-rules (MILAWA::info-for-type-set-inverter-rules val numes ens wrld))
+      (recognizer-alist        (MILAWA::info-for-compound-recognizer-rules val numes ens wrld))
+      (generalize-rules        (MILAWA::info-for-generalize-rules val numes ens wrld))
+      (otherwise nil)))
+   (t
+    (case key
+      (lemmas                     (MILAWA::info-for-lemmas val numes ens wrld))
+      (linear-lemmas              (MILAWA::info-for-linear-lemmas val numes ens wrld))
+      (eliminate-destructors-rule (MILAWA::info-for-eliminate-destructors-rule val numes ens wrld))
+      (congruences                (info-for-congruences val numes ens wrld))
+      (coarsenings                (info-for-coarsenings val numes ens wrld))
+      (forward-chaining-rules     (MILAWA::info-for-forward-chaining-rules val numes ens wrld))
+      (type-prescriptions         (MILAWA::info-for-type-prescriptions val numes ens wrld))
+      (induction-rules            (MILAWA::info-for-induction-rules val numes ens wrld))
+      (otherwise nil)))))
+
+(defun MILAWA::info-for-rules1 (props numes ens wrld)
+  (cond ((null props)
+         nil)
+        ((eq (cadar props) *acl2-property-unbound*)
+         (MILAWA::info-for-rules1 (cdr props) numes ens wrld))
+        (t
+         (append (MILAWA::info-for-x-rules (caar props) (cadar props) (cddar props) numes ens wrld)
+                 (MILAWA::info-for-rules1 (cdr props) numes ens wrld)))))
+
+(defun MILAWA::info-for-rule-classes-nil (name wrld)
+
+; There is no record class corresponding to :rule-classes nil rules.  But we can at
+; least look up the theorem that corresponds to this rule.
+
+  (let ((thm              (getprop name 'theorem nil 'current-acl2-world wrld))
+        (untranslated-thm (getprop name 'untranslated-theorem nil 'current-acl2-world wrld)))
+    (if thm
+        (list (list :name    name)
+              (list :class   nil)
+              (list :theorem untranslated-thm thm))
+      nil)))
+
+(defun info-fn (name state)
+  (let ((wrld (w state)))
+    (cond ((and (symbolp name)
+                (not (keywordp name)))
+           (let* ((name (deref-macro-name name (macro-aliases wrld)))
+                  (props (actual-props (world-to-next-event (cdr (decode-logical-name name wrld))) nil nil))
+                  (numes (strip-cars (getprop name 'runic-mapping-pairs nil 'current-acl2-world wrld))))
+             (if (consp numes)
+                 ;; There are proper numes for this name
+                 (MILAWA::info-for-rules1 props numes (ens state) wrld)
+               ;; No proper numes.  Maybe it's a rule-classes nil?
+               (list (MILAWA::info-for-rule-classes-nil name wrld)))))
+          (t
+           (er hard 'pr
+               "The argument to info-fn must be a non-keyword symbol.")))))
+
+
+
+
+(defun max-length-of-any-key (symbols max)
+  (if (consp symbols)
+      (max-length-of-any-key (cdr symbols)
+                             (max (length (symbol-name (car symbols))) max))
+    max))
+
+(defun downcase-all-but-first (str)
+  (let* ((chars (coerce str 'list))
+         (first (car chars))
+         (rest  (string-downcase1 (cdr chars))))
+    (coerce (cons first rest) 'string)))
+
+(defun expand-keys-into-strings (symbols max-len)
+  (if (consp symbols)
+      (let* ((name (symbol-name (car symbols)))
+            (len  (length name)))
+        (cons (string-append (downcase-all-but-first name)
+                             (cons #\: (make-list (- max-len len) :initial-element #\Space)))
+              (expand-keys-into-strings (cdr symbols) max-len)))
+    nil))
+
+(defun print-info-entry1 (keys vals state)
+  (if (not (consp keys))
+      state
+    (mv-let (col state)
+            (fmt1 "~s0 ~q1"
+                  (list (cons #\0 (car keys))
+                        (cons #\1 (caar vals)))
+                  0
+                  *standard-co*
+                  state
+                  nil)
+            (declare (ignore col))
+            (print-info-entry1 (cdr keys) (cdr vals) state))))
+
+(defun print-info-entry (entry state)
+  (let* ((keys              (strip-cars entry))
+         (vals              (strip-cdrs entry))
+         (key-column-length (+ 2 (max-length-of-any-key keys 0)))
+         (new-keys          (expand-keys-into-strings keys key-column-length)))
+    (pprogn
+     (print-info-entry1 new-keys vals state)
+     (fms "" 0 *standard-co* state nil)
+     )))
+
+(defun print-info (info state)
+  (if (not (consp info))
+      state
+    (pprogn (print-info-entry (car info) state)
+            (print-info (cdr info) state))))
+
+(defmacro info (name)
+  `(let ((state (print-info (info-fn ,name state) state)))
+     (mv nil :invisible state)))
+
+
+
+
+
+#|
+
+(logic)
+
+(defun sample-nonrec-defun (x)
+  (+ x 1))
+
+(defun sample-rec-defun (x)
+  (if (consp x)
+      (+ (nfix (car x))
+         (sample-rec-defun (cdr x)))
+    0))
+
+(defthm sample-rewrite-rule
+  (equal (natp (sample-rec-defun x))
+         t))
+
+(defthm sample-type-prescription-rule
+  (equal (natp (sample-rec-defun x))
+         t)
+  :rule-classes :type-prescription)
+
+(defun sample-equiv (x y)
+  (equal x y))
+
+(defequiv sample-equiv)
+
+(defcong sample-equiv equal (sample-rec-defun x) 1)
+
+(defthm sample-fc-rule
+  (implies (natp x)
+           (equal (natp (sample-rec-defun x))
+                  t))
+  :rule-classes :forward-chaining)
+
+(defthm sample-linear-rule
+  (<= 0 (sample-rec-defun x))
+  :rule-classes :linear)
+
+(pr 'sample-nonrec-defun)
+(info 'sample-nonrec-defun)
+
+(pr 'sample-rewrite-rule)
+(info 'sample-rewrite-rule)
+
+(pr 'sample-type-prescription-rule)
+(info 'sample-type-prescription-rule)
+
+(pr 'sample-equiv)
+(info 'sample-equiv)
+
+(pr 'sample-equiv-implies-equal-sample-rec-defun-1)
+(info 'sample-equiv-implies-equal-sample-rec-defun-1)
+
+(pr 'sample-equiv-is-an-equivalence)
+(info 'sample-equiv-is-an-equivalence)
+
+(pr 'sample-fc-rule)
+(info 'sample-fc-rule)
+
+(pr 'sample-linear-rule)
+(info 'sample-linear-rule)
+
+(defaxiom crock
+  (equal (car x) (car x))
+  :rule-classes nil)
+
+(pr 'crock)
+(info 'crock)
+
+
+
+
+|#
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/io.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/io.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/io.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/io.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,192 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(include-book "str")
+
+(defttag open-output-channel!)
+
+(defun mangle-filename (name)
+  ;; Some lisps complain about having certain characters in filenames.  When
+  ;; you open a file, you should consider mangling its name.
+  (declare (xargs :mode :program))
+  (STR::string-replace-patterns name
+                                '(("_" . "_usc_")
+                                  ("[" . "_lbr_")
+                                  ("]" . "_rbr_")
+                                  ("{" . "_lcl_")
+                                  ("}" . "_rcl_")
+                                  ("(" . "_lp_")
+                                  (")" . "_rp_")
+                                  ("<" . "_lt_")
+                                  (">" . "_gt_")
+                                  ("'"  . "_apo_")
+                                  ("\"" . "_quo_")
+                                  ("`" . "_bquo_")
+                                  ("*" . "_st_")
+                                  (" " . "_sp_")
+                                  ("/" . "_sl_")
+                                  ("\\" . "_bsl_")
+                                  ("?" . "_qmk_")
+                                  ("%" . "_pct_")
+                                  ("=" . "_eq_")
+                                  (":" . "_col_")
+                                  (";" . "_sem_")
+                                  ("|" . "_bar_")
+                                  )))
+
+(defun open-output-channel$ (file-name typ state)
+  ;; This is the same as open-output-channel!, except it can be used without
+  ;; having to have an open trust tag.  I don't think the behavior discussed
+  ;; in :doc open-output-channel! is a credible threat to soundness, and do
+  ;; not want to be forced to add ttags everywhere.
+  (declare (xargs :guard (and (stringp file-name)
+                              (member-eq typ *file-types*)
+                              (state-p state))
+                  :stobjs state))
+  (open-output-channel! file-name typ state))
+
+;; (defun current-book-info (state)
+;;   ;; If we are currently certifying a book, we return an alist that describes
+;;   ;; the location of the book's file.  The alist will look like this:
+;;   ;;
+;;   ;;   ((:FULLPATH . "/home/jared/my-book.lisp")
+;;   ;;    (:DIRNAME  . "/home/jared/")
+;;   ;;    (:BASENAME . "my-book.lisp")
+;;   ;;    (:ROOTNAME . "my-book")
+;;   ;;    (:SUFFIX   . ".lisp"))
+;;   ;;
+;;   ;; Otherwise, e.g., if you call this function from an interactive session,
+;;   ;; we return nil.
+;;   (declare (xargs :mode :program :stobjs state))
+;;   (let ((info
+;;          ;; In previous versions of ACL2 this was just a string or nil,
+;;          ;; but now it's a defrec or nil.
+;;          (f-get-global 'certify-book-info state)))
+;;     (if (not info)
+;;         nil
+;;       (let* ((fullpath       (access certify-book-info info :full-book-name))
+;;              (fullpath-len   (length fullpath))
+;;              (fullpath-chars (coerce fullpath 'list))
+;;              (dirname        (f-get-global 'connected-book-directory state))
+;;              (dirname-len    (length dirname))
+;;              (dirname-chars  (coerce dirname 'list)))
+;;         (if (or (not (< dirname-len fullpath-len))
+;;                 (not (equal (take dirname-len fullpath-chars) dirname-chars)))
+;;             (er hard 'current-book-info "Sanity check failed; aborting.")
+;;           (let* ((basename-chars (nthcdr dirname-len fullpath-chars))
+;;                  (basename       (coerce basename-chars 'string))
+;;                  (suffix-chars   (member-equal #\. basename-chars))
+;;                  (suffix         (coerce suffix-chars 'string)))
+;;             (if (not (equal suffix ".lisp"))
+;;                 (er hard 'current-book-info "Expected .lisp suffix; aborting.")
+;;               (let* ((rootname-chars (take (- (length basename) (length suffix)) basename-chars))
+;;                      (rootname       (coerce rootname-chars 'string)))
+;;                 (list (cons :fullpath fullpath)
+;;                       (cons :dirname  dirname)
+;;                       (cons :basename basename)
+;;                       (cons :rootname rootname)
+;;                       (cons :suffix suffix))))))))))
+
+
+
+(defun println (line channel state)
+  ;; This is the same as princ$, but it prints a newline afterwards.  This is
+  ;; useful since princ$ doesn't understand the ~% directive.
+  (declare (xargs :mode :program :stobjs state))
+  (princ$ (concatenate 'string line (coerce '(#\Newline) 'string)) channel state))
+
+
+
+(defun multicons (a x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (cons a (car x))
+            (multicons a (cdr x)))
+    nil))
+
+;; (defun cw!-fn (str alist)
+;;   ;; Has an "under the hood" implementation
+;;   (declare (ignore str alist)
+;;            (xargs :guard (stringp str)))
+;;   (cw "Error: cw!-fn has not been redefined."))
+
+;; (defmacro cw! (str &rest args)
+;;   ;; This is like ACL2's cw function, but it uses fmt1! instead of fmt under the
+;;   ;; hood.
+;;   `(cw!-fn ,str ,(cons 'list (multicons 'cons
+;;                          (pairlis2 `(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+;;                                    (pairlis$ args nil))))))
+
+;; (defttag cw!)
+
+;; (progn!
+;;  (set-raw-mode t)
+;;  (defun cw!-fn (str alist)
+;;    (progn
+;;      (fmt1! str alist 0 *standard-co* *the-live-state* nil)
+;;      nil))
+;;  (set-raw-mode nil))
+
+
+
+
+
+(defstub to-flat-string-aux (x) t)
+
+(defun to-flat-string (x)
+  ;; Logically, to-flat-string is just some uninterpreted function.  I think
+  ;; this is sound, since it should satisfy functional equality.
+  (declare (xargs :guard t))
+  (prog2$ (cw "Error: to-flat-string has not been redefined.~%")
+          (to-flat-string-aux x)))
+
+(defttag to-flat-string)
+
+(progn!
+ (set-raw-mode t)
+ (defun to-flat-string (x)
+   (let ((*print-circle* nil)
+         (*print-escape* t)
+         #+DRAFT-ANSI-CL-2 (*print-lines* nil)
+         #+DRAFT-ANSI-CL-2 (*print-miser-width* nil)
+         #+DRAFT-ANSI-CL-2 (*print-pprint-dispatch* nil)
+         #+DRAFT-ANSI-CL-2 (*print-readably* t)
+         #+DRAFT-ANSI-CL-2 (*print-right-margin* nil)
+         (*readtable* *acl2-readtable*)
+         (*print-case* :upcase)
+         (*print-pretty* nil)
+         (*print-level* nil)
+         (*print-length* nil))
+     (prin1-to-string x))))
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/ls.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/ls.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/ls.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/ls.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,84 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+;; We introduce a wrapper for ls so that we can inspect generated files.  We
+;; need a ttag to call sys-call, but this should be a sound extension of ACL2
+;; as it does not muck with any system internals.
+
+(defttag ls)
+
+(defun ls (filename)
+  (declare (xargs :guard (stringp filename))
+           (ignore filename))
+  (cw "ls has not yet been redefined under the hood~%"))
+
+(progn!
+ (set-raw-mode t)
+
+ (defun ls (filename)
+   ;; I've complained before that ACL2's sys-call does not provide a standard
+   ;; interface across Lisps, but it has not been standardized.  So, calling
+   ;; ls, which ought to be a really simple thing, is not and is probably buggy
+   ;; in some cases.  This sort of shit is really lame, and makes me want to
+   ;; use a different language.  In the meantime, we have this hacky solution.
+   #+gcl
+   ;; GCL needs the filename to be quoted, or it won't handle filenames with
+   ;; spaces correctly.
+   (if (position #\" filename)
+       (ACL2::cw "Sorry.  ACL2's sys-call is too broken to use \"ls\" on files~
+                  whose names include quotes on GCL.~%")
+     (sys-call "ls" (list "-lh" (concatenate 'string "\"" filename "\""))))
+   #+allegro
+   ;; Allegro is completely fucked.  Whether or not you quote the string, the
+   ;; spaces within it will be interpreted as argument separators.  So, I don't
+   ;; know of any way to actually say ls "hello world.txt" in allegro.
+   (if (position #\Space filename)
+       (ACL2::cw "Sorry.  ACL2's sys-call is too broken to use \"ls\" on files~
+                  whose names include spaces on Allegro.~%")
+     (sys-call "ls" (list "-lh" filename)))
+   #+(or clisp cmu openmcl sbcl)
+   ;; CLISP, CMU, SBCL, and OpenMCL do not want the filename to be quoted, and
+   ;; I think their behavior is the most proper.  You seem to be able to put
+   ;; most anything you want into filenames here.
+   (prog2$
+    ;; Often prevent horrible death on fork when too much memory is allocated
+    (funcall (intern "GC" (find-package "CCL")))
+    (sys-call "ls" (list "-lh" filename)))
+   #-(or gcl allegro clisp cmu openmcl sbcl)
+   (ACL2::cw "Sorry.  ACL2's sys-call is not standardized, and support for this~
+             platform has not yet been implemented.")
+   nil
+   ))
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/mksym.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/mksym.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/mksym.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/mksym.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,86 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+(defun concatenate-symbols (x)
+  (declare (xargs :guard (symbol-listp x) :mode :program))
+  (if (consp x)
+      (concatenate 'string
+                   (symbol-name (car x))
+                   (concatenate-symbols (cdr x)))
+    ""))
+
+(defun has-namespace1 (char-list)
+  (declare (xargs :mode :program))
+  (if (consp char-list)
+      (or (equal (car char-list) #\.)
+          (has-namespace1 (cdr char-list)))
+    nil))
+
+(defun has-namespace (symbol)
+  (declare (xargs :mode :program))
+  (has-namespace1 (coerce (symbol-name symbol) 'list)))
+
+(defun extract-namespace1 (char-list)
+  (declare (xargs :mode :program))
+  (if (consp char-list)
+      (if (equal (car char-list) #\.)
+          nil
+        (cons (car char-list)
+              (extract-namespace1 (cdr char-list))))
+    nil))
+
+(defun extract-namespace (symbol)
+  (declare (xargs :mode :program))
+  (let* ((char-list (coerce (symbol-name symbol) 'list))
+         (namespace (coerce (extract-namespace1 char-list) 'string)))
+    (intern-in-package-of-symbol namespace 'MILAWA::foo)))
+
+(defun extract-nonnamespace1 (char-list)
+  (declare (xargs :mode :program))
+  (if (consp char-list)
+      (if (equal (car char-list) #\.)
+          (cdr char-list)
+        (extract-nonnamespace1 (cdr char-list)))
+    nil))
+
+(defun extract-nonnamespace (symbol)
+  (declare (xargs :mode :program))
+  (let* ((char-list    (coerce (symbol-name symbol) 'list))
+         (nonnamespace (coerce (extract-nonnamespace1 char-list) 'string)))
+    (intern-in-package-of-symbol nonnamespace 'MILAWA::foo)))
+
+(defmacro mksym (&rest args)
+  `(intern-in-package-of-symbol (concatenate-symbols (list ,@args)) 'MILAWA::foo))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/no-fertilize.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/no-fertilize.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/no-fertilize.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/no-fertilize.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,87 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+;; It is unfortunate that we have to write this file, but ACL2 provides no nice
+;; way to disable fertilization and generalization, which usually don't work
+;; and are not implemented in Milawa.
+;;
+;; Originally I implemented a custom "defthm" hint that inserted a :do-not
+;; '(generalize fertilize) into my proofs on "Goal" automatically.  But this
+;; does not get carried through into forcing rounds, and ACL2 does not provide
+;; any kind of "All" target.  So, sometimes in forcing rounds I still had
+;; fertilization taking place.
+;;
+;; Now we just use a default hint that always disables generalization and
+;; fertilization when goals are stable under simplification.  This is chatty
+;; but I don't have many alternatives.
+
+(table no-fertilize-table 'fertilize-okp nil)
+(table no-fertilize-table 'generalize-okp nil)
+
+(defun no-fertilize-hint (world stable-under-simplificationp state)
+  (declare (xargs :mode :program :stobjs state))
+  (and stable-under-simplificationp
+       (let ((generalize-okp (cdr (assoc 'generalize-okp (table-alist 'no-fertilize-table world))))
+             (fertilize-okp  (cdr (assoc 'fertilize-okp (table-alist 'no-fertilize-table world)))))
+         (cond ((and (not generalize-okp)
+                     (not fertilize-okp))
+                (prog2$ (if (not (gag-mode))
+                            (cw ";; hint: no fertilize/generalize~|")
+                          nil)
+                        '(:do-not '(generalize fertilize))))
+               ((not generalize-okp)
+                (prog2$ (if (not (gag-mode))
+                            (cw ";; hint: no generalize~|")
+                          nil)
+                        '(:do-not '(generalize))))
+               ((not fertilize-okp)
+                (prog2$ (if (not (gag-mode))
+                            (cw ";; hint: no fertilize~|")
+                          nil)
+                        '(:do-not '(fertilize))))
+               (t
+                nil)))))
+
+(add-default-hints! '((no-fertilize-hint world stable-under-simplificationp state)))
+
+(defmacro allow-generalize (flag)
+  (declare (xargs :guard (booleanp flag)))
+  `(table no-fertilize-table 'generalize-okp ,flag))
+
+(defmacro allow-fertilize (flag)
+  (declare (xargs :guard (booleanp flag)))
+  `(table no-fertilize-table 'fertilize-okp ,flag))
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/patch-save-exec-pkg.lsp acl2-6.3/books/milawa/ACL2/acl2-hacks/patch-save-exec-pkg.lsp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/patch-save-exec-pkg.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/patch-save-exec-pkg.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,391 @@
+;; Patch by Matt Kaufmann to permit ACL2 to save the :q package when save-exec
+;; is called.
+
+(in-package "ACL2")
+
+(defvar *startup-package-name* "ACL2")
+
+(defun save-exec (exec-filename extra-startup-string)
+
+  ":Doc-Section Other
+
+  save an executable image and (for most Common Lisps) a wrapper script~/
+
+  ~l[saving-and-restoring] for an explanation of why one might want to use this
+  function.
+  ~bv[]
+  Examples:
+  ; Save an executable named my-saved_acl2:
+  (save-exec \"my-saved_acl2\"
+             \"This saved image includes Version 7 of Project Foo.\")
+
+  ; Same as above, but with a generic comment instead:
+  (save-exec \"my-saved_acl2\" nil)~/
+  General Form:
+  (save-exec exec-filename extra-startup-string)
+  ~ev[]
+  where ~c[exec-filename] is the filename of the proposed executable and
+  ~c[extra-startup-string] is a non-empty string to be printed after the normal
+  ACL2 startup message when you start up the saved image.  However,
+  ~c[extra-startup-string] is allowed to be ~c[nil], in which case a generic
+  string will be printed instead.
+
+  ~st[Note]: For technical reasons, we require that you first execute ~c[:q], to
+  exit the ACL2 read-eval-print loop, before evaluating a ~c[save-exec] call.
+
+  For most Common Lisps, the specified file (e.g., ~c[\"my-saved_acl2\"] in the
+  examples above) will be written as a small script, which in turn invokes a
+  saved image to which an extension has been appended (e.g.,
+  ~c[my-saved_acl2.gcl] for the examples above, when the underlying Common Lisp
+  is GCL on a non-Windows system).~/"
+
+  #-acl2-loop-only
+  (progn
+    (if (not (eql *ld-level* 0))
+        (er hard 'save-exec
+            "Please type :q to exit the ACL2 read-eval-print loop and then try ~
+             again."))
+    (if (equal extra-startup-string "")
+        (er hard 'save-exec
+            "The extra-startup-string argument of save-exec must be ~x0 or ~
+             else a non-empty string."
+            nil)
+      (setq *saved-string*
+            (format
+             nil
+             "~a~%MODIFICATION NOTICE:~%~%~a~%"
+             *saved-string*
+             (cond ((null extra-startup-string)
+                    "This ACL2 executable was created by saving a session.")
+                   (t extra-startup-string)))))
+    #-(or gcl cmu sbcl allegro clisp openmcl)
+    (er hard 'save-exec
+        "Sorry, but save-exec is not implemented for this Common Lisp.~a0"
+        #+lispworks "  If you care to investigate, see the comment in ~
+                     acl2-init.lisp starting with: ``The definition of ~
+                     save-exec-raw for lispworks (below) did not work.''"
+        #-lispworks "")
+
+; The forms just below, before the call of save-exec-raw, are there so that the
+; initial (lp) will set the :cbd correctly.
+
+    (f-put-global 'connected-book-directory nil *the-live-state*)
+    (setq *initial-cbd* nil)
+    (setq *lp-ever-entered-p* nil)
+    (setq *startup-package-name* (package-name *package*))
+    (setq *saved-build-date*
+
+; By using setq here for *saved-build-date* instead of a let-binding for
+; save-exec-raw, it happens that saving more than once in the same session (for
+; Lisps that allow this, such as Allegro CL but not GCL) would result in extra
+; "; then ..." strings.  But that seems a minor problem, and avoids having to
+; think about the effect of having a let-binding in force above a save of an
+; image.
+
+          (concatenate 'string
+                       *saved-build-date*
+                       "; then "
+                       (saved-build-date-string)))
+    (save-exec-raw exec-filename))
+  #+acl2-loop-only
+  (declare (ignore exec-filename extra-startup-string))
+  nil ; Won't get to here in GCL and perhaps other lisps
+  )
+
+(defun acl2-default-restart ()
+  (if *acl2-default-restart-complete*
+      (return-from acl2-default-restart nil))
+
+  #+openmcl
+  (progn
+
+; In OpenMCL, print greeting now, rather than upon first re-entry to ACL2 loop.
+; Here we follow a suggestion from Gary Byers.
+
+    (format t "~&Welcome to ~A ~A!~%"
+            (lisp-implementation-type)
+            (lisp-implementation-version))
+    (setq ccl::*inhibit-greeting* t))
+  #+hons (funcall 'hons-init)
+  (format t *saved-string*
+          *copy-of-acl2-version*
+          *saved-build-date*
+          (cond (*saved-mode*
+                 (format nil "~% Initialized with ~a." *saved-mode*))
+                (t ""))
+          (eval '(latest-release-note-string)) ; avoid possible warning
+          )
+  (maybe-load-acl2-init)
+  (eval `(in-package ,*startup-package-name*))
+
+; The following two lines follow the recommendation in Allegro CL's
+; documentation file doc/delivery.htm.
+
+  #+allegro (tpl:setq-default *package* (find-package "ACL2"))
+  #+allegro (rplacd (assoc 'tpl::*saved-package*
+                           tpl:*default-lisp-listener-bindings*)
+                    'common-lisp:*package*)
+
+  #+allegro (lp)
+  #+openmcl (eval '(lp)) ; using eval to avoid compiler warning
+
+; See the comment in save-acl2-in-lispworks for why we need the following call.
+
+  #+lispworks (mp:initialize-multiprocessing)
+
+  ;;Lispworks 4.2.0 no longer recognizes the following:
+  ;;#+lispworks (lw::extend-current-stack 1000)
+
+  (setq *acl2-default-restart-complete* t)
+  nil)
+
+#+openmcl
+(defun save-acl2-in-openmcl (sysout-name &optional mode core-name)
+  (setq *saved-mode* mode)
+  (eval `(in-package ,*startup-package-name*))
+  #-acl2-mv-as-values (proclaim-files)
+; We do the following load when *suppress-compile* in save-acl2, but it's
+; harmless enough to do it again here in case *suppress-compile* is set to t.
+  #+acl2-mv-as-values (load "acl2-proclaims.lisp")
+  (load "openmcl-acl2-trace.lisp")
+  (save-acl2-in-openmcl-aux sysout-name core-name))
+
+(defun lp (&rest args)
+
+; This function can only be called from within raw lisp, because no
+; ACL2 function mentions it.  Thus, we assume we are in raw lisp.
+; This is the top-level entry to ACL2.  Note that truename can cause an error
+; in some Common Lisps when the given file or directory does not exist.  Hence,
+; we sometimes call truename on "" rather than on a file name.
+
+  (let ((state *the-live-state*)
+        #+(and gcl (not ansi-cl)) (lisp::*break-enable*
+                                   (eq (debugger-enable *the-live-state*) t))
+        (raw-p
+         (cond
+          ((null args) nil)
+          ((equal args '(raw)) 'raw)
+          (t (error "LP either takes no args or a single argument, 'raw.")))))
+    (cond
+     ((> *ld-level* 0)
+      (when (raw-mode-p *the-live-state*)
+        (fms "You have attempted to enter the ACL2 read-eval-print loop from ~
+              within raw mode.  However, you appear already to be in that ~
+              loop.  If your intention is to leave raw mode, then execute:  ~
+              :set-raw-mode nil.~|"
+             nil (standard-co *the-live-state*) *the-live-state* nil))
+      (return-from lp nil))
+     (*lp-ever-entered-p*
+      (f-put-global 'standard-oi
+                    (if (and raw-p (not (raw-mode-p state)))
+                        (cons '(set-raw-mode t)
+                              *standard-oi*)
+                      *standard-oi*)
+                    *the-live-state*)
+      (with-warnings-suppressed
+       (ld-fn (f-get-ld-specials *the-live-state*)
+              *the-live-state*
+              nil)))
+     (t (eval `(in-package ,*startup-package-name*))
+
+; Acl2-default-restart isn't enough in Allegro, at least, to get the new prompt
+; when we start up:
+
+        (let* ((system-dir (getenv$-raw "ACL2_SYSTEM_BOOKS"))
+               (user-home-dir-path (user-homedir-pathname))
+               (user-home-dir0 (and user-home-dir-path
+                                    (namestring user-home-dir-path)))
+               (user-home-dir (if (eql (char user-home-dir0
+                                             (1- (length user-home-dir0)))
+                                       *directory-separator*)
+                                  (subseq user-home-dir0
+                                          0
+                                          (1- (length user-home-dir0)))
+                                user-home-dir0)))
+          (when system-dir
+            (f-put-global 'distributed-books-dir system-dir *the-live-state*))
+          (when user-home-dir
+            (f-put-global 'user-home-dir user-home-dir *the-live-state*)))
+        #-hons
+; Hons users are presumably advanced enough to tolerate the lack of a
+; "[RAW LISP]" prompt.
+        (install-new-raw-prompt)
+        (setq *lp-ever-entered-p* t)
+        #+(and (not acl2-loop-only) acl2-rewrite-meter)
+        (setq *rewrite-depth-alist* nil)
+
+; Without the following call, it was impossible to read and write with ACL2 I/O
+; functions to *standard-co* in CLISP 2.30.  Apparently the appropriate Lisp
+; streams at the time of the build were closed when the ACL2 image was brought
+; up.  So we "refresh" the appropriate property lists with the current such
+; Lisp streams.
+
+        (setup-standard-io)
+
+; The following applies to CLISP 2.30, where charset:iso-8859-1 is defined, not to
+; CLISP 2.27, where charset:utf-8 is not defined.  It apparently has to be
+; executed in the current Lisp session.  We tried executing the following form
+; before saving an image, but the value of custom:*default-file-encoding* at
+; startup was #<ENCODING CHARSET:ASCII :UNIX>.
+
+        #+(and clisp unicode)
+        (setq custom:*default-file-encoding* charset:iso-8859-1)
+        #+mswindows
+        (cond
+         ((null (f-get-global 'mswindows-drive *the-live-state*))
+          (let* ((str (namestring (truename "")))
+                 (posn (position #\: str)))
+            (cond
+             ((null posn)
+              (er soft 'LP
+                  "We are unable to determine the drive using ~
+                   (namestring (truename \"\")), which evaluates to ~p0."
+                  str)
+              (return-from lp nil)))
+            (f-put-global 'mswindows-drive
+                          (subseq str 0 (1+ posn))
+                          *the-live-state*))))
+        (cond ((f-get-global 'connected-book-directory *the-live-state*) nil)
+              ((null *initial-cbd*)
+               (setq *initial-cbd*
+                     (pathname-os-to-unix
+                      (namestring (truename
+
+; See the comment in save-acl2-in-allegro, which mentions a comment present
+; before Version_2.5 that was present here as well.
+
+                                   ""))
+                      *the-live-state*))
+
+; In openmcl, it seems that *initial-cbd* as computed above could give a string
+; not ending in "/".  We fix that here.
+
+               (cond ((and (stringp *initial-cbd*)
+                           (not (equal *initial-cbd* ""))
+                           (not (eql (char *initial-cbd*
+                                           (1- (length *initial-cbd*)))
+                                     #\/)))
+                      (setq *initial-cbd*
+                            (concatenate 'string *initial-cbd* "/"))))
+               (cond ((not (absolute-pathname-string-p
+                            *initial-cbd*
+                            t
+                            (os (w *the-live-state*))))
+                      (er soft 'LP
+                          "Our guess for the initial setting of cbd, ~x0, ~
+                           which was generated by (pathname-os-to-unix ~
+                           (namestring (truename \"\")) *the-live-state*), ~
+                           is not a legal directory!  Before entering ACL2, ~
+                           please setq *initial-cbd* to a nonempty string ~
+                           that represents an absolute ACL2 (i.e., ~
+                           Unix-style) pathname.  Sorry for the inconvenience."
+                          *initial-cbd*)
+                      (return-from lp nil)))
+               (f-put-global 'connected-book-directory *initial-cbd*
+                             *the-live-state*))
+              ((not (absolute-pathname-string-p *initial-cbd*
+                                                t
+                                                (os (w *the-live-state*))))
+               (er soft 'LP
+                   "The current setting of *initial-cbd*, ~x0, is ~
+                    not a directory.  Before entering ACL2, please ~
+                    setq *initial-cbd* to a nonempty string that ~
+                    represents the absolute ACL2 (i.e., Unix-style) ~
+                    pathname of a directory. See :DOC cbd."
+                   *initial-cbd*
+                   *directory-separator*)
+               (return-from lp nil))
+              (t
+               (f-put-global 'connected-book-directory *initial-cbd*
+                             *the-live-state*)))
+        (let ((customization-full-file-name
+               (let* ((cb1 (our-merge-pathnames
+                            (f-get-global 'connected-book-directory
+                                          *the-live-state*)
+                            "acl2-customization"))
+                      (cfb1 (string-append cb1 ".lisp")))
+                 (if (probe-file (pathname-unix-to-os cfb1 *the-live-state*))
+                     cfb1
+                   (let* ((cb2
+
+; There is not a true notion of home directory for Windows systems, as far as
+; we know.  We may provide one at a future point, but for now, we simply act as
+; though ~/acl2-customization.lisp does not exist on such systems.
+
+                           #+mswindows
+                           nil
+                           #-mswindows
+                           (our-merge-pathnames
+
+; The call of pathname-os-to-unix below may seem awkward, since later we apply
+; pathname-unix-to-os before calling probe-file.  However, our-merge-pathnames
+; requires Unix-style pathname arguments, and we prefer not to write an
+; analogous function that takes pathnames for the host operating system.
+
+                            (pathname-os-to-unix
+                             (namestring
+
+; MCL does not seem to handle calls of truename correctly on logical pathnames.
+; We should think some more about this, but for now, let's solve this problem
+; by brute force.
+
+                              #+(and mcl (not openmcl))
+                              (truename
+                               (common-lisp::translate-logical-pathname
+                                (user-homedir-pathname)))
+                              #-(and mcl (not openmcl))
+                              (truename (user-homedir-pathname)))
+                             *the-live-state*)
+                            "acl2-customization"))
+                          (cfb2 (and cb2 (string-append cb2 ".lisp"))))
+                     (if (and cfb2
+                              (probe-file (pathname-unix-to-os
+                                           cfb2 *the-live-state*)))
+                         cfb2
+                       nil))))))
+          (cond
+           ((and customization-full-file-name
+                 (not (global-val 'boot-strap-flg (w state))))
+
+; If the file "acl2-customization.lisp" on the current directory exists (and we
+; are not booting) and it hasn't been included yet, we include it first.  If it
+; does not exist, but it exists on the user's home directory, then we include
+; that.  Because of the ld-skip-proofsp setting we use, no warning is printed
+; if "acl2-customization.lisp" is uncertified.  But it will prevent the
+; production of truly certified books in any session in which it has been
+; included, so we check it explicitly below and warn the user.
+
+            (fms "Customizing with ~x0.~%"
+                 (list (cons #\0 customization-full-file-name))
+                 *standard-co*
+                 state
+                 nil)
+            (let ((old-infixp (f-get-global 'infixp *the-live-state*)))
+              (f-put-global 'infixp nil *the-live-state*)
+              (with-warnings-suppressed
+               (ld-fn (put-assoc-eq
+                       'standard-oi
+                       (if (and raw-p (not (raw-mode-p state)))
+                           (cons '(set-raw-mode t)
+                                 customization-full-file-name)
+                         customization-full-file-name)
+                       (put-assoc-eq
+                        'ld-error-action :return
+                        (f-get-ld-specials *the-live-state*)))
+                      *the-live-state*
+                      nil))
+              (f-put-global 'infixp old-infixp *the-live-state*))))
+          (f-put-global 'standard-oi
+                        (if (and raw-p (not (raw-mode-p state)))
+                            (cons '(set-raw-mode t)
+                                  *standard-oi*)
+                          *standard-oi*)
+                        *the-live-state*)
+          (f-put-global 'ld-error-action :continue *the-live-state*)
+          (with-warnings-suppressed
+           (ld-fn (f-get-ld-specials state)
+                  *the-live-state*
+                  nil)))))
+    (fms "Exiting the ACL2 read-eval-print loop.  To re-enter, execute (LP)."
+         nil *standard-co* *the-live-state* nil)
+    (values)))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/patch-weak-force.lsp acl2-6.3/books/milawa/ACL2/acl2-hacks/patch-weak-force.lsp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/patch-weak-force.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/patch-weak-force.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,331 @@
+;; Patch by Matt Kaufmann to permit forcing in some cases where ACL2 disables it.
+
+(in-package "ACL2")
+
+(mutual-recursion
+
+(defun lambda-subtermp (term)
+
+; We determine whether some lambda-expression is used as a function in term.
+
+  (if (or (variablep term)
+          (fquotep term))
+      nil
+    (or (flambdap (ffn-symb term))
+        (lambda-subtermp-lst (fargs term)))))
+
+(defun lambda-subtermp-lst (termlist)
+  (if termlist
+      (or (lambda-subtermp (car termlist))
+          (lambda-subtermp-lst (cdr termlist)))
+    nil))
+
+)
+
+(defun rewrite-atm (atm not-flg bkptr gstack type-alist wrld
+                        simplify-clause-pot-lst rcnst current-clause state)
+
+; This function rewrites atm with nth-update-rewriter, recursively.
+; Then it rewrites the result with rewrite, in the given context,
+; maintaining iff.
+
+; Note that not-flg is only used heuristically, as it is the
+; responsibility of the caller to account properly for it.
+; Current-clause is also used only heuristically.
+
+; It is used to rewrite the atoms of a clause as we sweep across.  It
+; is just a call of rewrite -- indeed, it didn't exist in Nqthm and
+; rewrite was called in its place -- except for one thing: it first
+; gives type-set a chance to decide things.  See the note about
+; pegate-lit in rewrite-clause.
+
+  (mv-let (knownp nilp ttree)
+          (known-whether-nil atm type-alist
+                             (access rewrite-constant rcnst
+                                     :current-enabled-structure)
+                             (ok-to-force rcnst)
+                             wrld
+                             nil)
+          (cond
+
+; Before Version  2.6 we had
+
+;           (knownp
+;            (cond (nilp (mv *nil* ttree))
+;                  (t (mv *t* ttree))))
+
+; but this allowed type-set to remove ``facts'' from a theorem which
+; may be needed later.  The following transcript illustrates the previous
+; behavior:
+#|
+ ACL2 !>(defthm fold-consts-in-+
+          (implies (and (syntaxp (consp c))
+                        (syntaxp (eq (car c) 'QUOTE))
+                        (syntaxp (consp d))
+                        (syntaxp (eq (car d) 'QUOTE)))
+                   (equal (+ c d x)
+                          (+ (+ c d) x))))
+ ACL2 !>(defthm helper
+          (implies (integerp x)
+                   (integerp (+ 1 x))))
+ ACL2 !>(thm
+          (implies (integerp (+ -1/2 x))
+                   (integerp (+ 1/2 x)))
+          :hints (("Goal" :use ((:instance helper
+                                           (x (+ -1/2 x)))))))
+
+ [Note:  A hint was supplied for our processing of the goal above.
+ Thanks!]
+
+ ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE an enabled
+ :REWRITE or :DEFINITION rule, so you may want to consider disabling
+ (:REWRITE HELPER).
+
+
+ We now augment the goal above by adding the hypothesis indicated by
+ the :USE hint.  The hypothesis can be derived from HELPER via instantiation.
+ The augmented goal is shown below.
+
+ Goal'
+ (IMPLIES (IMPLIES (INTEGERP (+ -1/2 X))
+                   (INTEGERP (+ 1 -1/2 X)))
+          (IMPLIES (INTEGERP (+ -1/2 X))
+                   (INTEGERP (+ 1/2 X)))).
+
+ By case analysis we reduce the conjecture to
+
+ Goal''
+ (IMPLIES (AND (OR (NOT (INTEGERP (+ -1/2 X)))
+                   (INTEGERP (+ 1 -1/2 X)))
+               (INTEGERP (+ -1/2 X)))
+          (INTEGERP (+ 1/2 X))).
+
+ This simplifies, using primitive type reasoning, to
+
+ Goal'''
+ (IMPLIES (INTEGERP (+ -1/2 X))
+          (INTEGERP (+ 1/2 X))).
+
+ Normally we would attempt to prove this formula by induction.  However,
+ we prefer in this instance to focus on the original input conjecture
+ rather than this simplified special case.  We therefore abandon our
+ previous work on this conjecture and reassign the name *1 to the original
+ conjecture.  (See :DOC otf-flg.)
+
+ No induction schemes are suggested by *1.  Consequently, the proof
+ attempt has failed.
+
+ Summary
+ Form:  ( THM ...)
+ Rules: ((:DEFINITION IMPLIES)
+         (:DEFINITION NOT)
+         (:FAKE-RUNE-FOR-TYPE-SET NIL))
+ Warnings:  Use
+ Time:  0.03 seconds (prove: 0.02, print: 0.01, other: 0.00)
+
+ ******** FAILED ********  See :DOC failure  ******** FAILED ********
+ ACL2 !>
+|#
+
+; Note that in the transition from Goal'' to Goal''', the needed
+; fact --- (INTEGERP (+ 1 -1/2 X)) --- was removed by type reasoning.
+; This is not good.  We now only use type reasoning at this point if
+; it will give us a win.
+
+; One might ask why we only disallow type-set from removing facts here.
+; Why not elswhere, and what about rewrite?  We do it this way because
+; it is only here that the user cannot prevent this removal from
+; happening by manipulating the enabled structure.
+
+           ((and knownp not-flg nilp)
+
+; We have reduced the atm to nil but it occurs negated in the
+; clause and so we have reduced the literal to t, proving the clause.
+; So we report this reduction.
+
+            (mv *nil* ttree))
+           ((and knownp (not not-flg) (not nilp))
+            (mv *t* ttree))
+           (t
+            (mv-let
+             (hitp atm1 ttree1)
+; Rockwell Addition
+             (cond
+              ((eq (nu-rewriter-mode wrld) :literals)
+               (nth-update-rewriter t atm nil
+                                    (access rewrite-constant rcnst
+                                            :current-enabled-structure)
+                                    wrld state))
+              (t (mv nil nil nil)))
+             (let ((atm2 (if hitp
+                             (lambda-abstract
+                              (cleanup-if-expr atm1 nil nil)
+                              (pkg-witness (current-package state)))
+                           atm)))
+               (mv-let (ans1 ans2)
+                       (rewrite-entry
+                        (rewrite atm2
+                                 nil
+                                 bkptr)
+                        :rdepth (rewrite-stack-limit wrld)
+                        :type-alist type-alist
+                        :obj '?
+                        :geneqv *geneqv-iff*
+                        :wrld wrld
+                        :fnstack nil
+                        :ancestors nil
+                        :backchain-limit (backchain-limit wrld)
+                        :simplify-clause-pot-lst simplify-clause-pot-lst
+                        :rcnst rcnst
+                        :gstack gstack
+                        :ttree (if hitp ttree1 nil))
+
+; But we need to do even more work to prevent type-set from removing
+; ``facts'' from the goal.  Here is another (edited) transcript:
+
+#|
+ ACL2 !>(defun foo (x y)
+   (if (acl2-numberp x)
+       (+ x y)
+     0))
+
+ ACL2 !>(defthm foo-thm
+   (implies (acl2-numberp x)
+            (equal (foo x y)
+                   (+ x y))))
+ ACL2 !>(in-theory (disable foo))
+ ACL2 !>(thm
+  (implies (and (acl2-numberp x)
+                (acl2-numberp y)
+                (equal (foo x y) x))
+           (equal y 0)))
+
+ This simplifies, using the :type-prescription rule FOO, to
+
+ Goal'
+ (IMPLIES (AND (ACL2-NUMBERP Y)
+               (EQUAL (FOO X Y) X))
+          (EQUAL Y 0)).
+
+ Name the formula above *1.
+
+ No induction schemes are suggested by *1.  Consequently, the proof
+ attempt has failed.
+
+ Summary
+ Form:  ( THM ...)
+ Rules: ((:TYPE-PRESCRIPTION FOO))
+ Warnings:  None
+ Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
+
+ ******** FAILED ********  See :DOC failure  ******** FAILED ********
+|# ; |
+
+; Note that in the transition from Goal to Goal' we removed the critical fact
+; that x was an acl2-numberp.  This fact can be derived from the third
+; hypothesis --- (equal (foo x y) x) --- via :type-prescription rule FOO as
+; indicated.  However, when we then go on to rewrite the third hypothesis, we
+; are not able to rederive this fact, since the type-alist used at that point
+; does not use use the third hypothesis so as to prevent tail-biting.
+
+; Robert Krug has seen this sort of behavior in reasoning about floor and mod.
+; In fact, that experience motivated him to provide the original version of the
+; code below not to remove certain additional facts.
+
+; Finally, note that even before this additional care, the lemma
+
+#|
+ (thm
+  (implies (and (acl2-numberp y)
+                (equal (foo x y) x)
+                (acl2-numberp x))
+           (equal y 0)))
+|# ;|
+
+; does succeed, since the (acl2-numberp x) hypothesis now appears after the
+; (equal (foo x y) x) hypothesis, hence does not get removed until after it has
+; been used to relieve the hypothesis of foo-thm.  This kind of situation in
+; which a proof succeeds or fails depending on the order of hypotheses really
+; gets Robert's goat.
+
+		 (cond ((not (or (equal ans1 *nil*)
+                                 (equal ans1 *t*)))
+
+; We have, presumably, not removed any facts, so we allow this rewrite.
+
+                        (mv ans1 ans2))
+                       ((and (nvariablep atm2)
+                             (not (fquotep atm2))
+                             (equivalence-relationp (ffn-symb atm2)
+                                                    wrld))
+
+; We want to blow away equality (and equivalence) hypotheses, because for
+; example there may be a :use or :cases hint that is intended to blow away (by
+; implication) such hypotheses.
+
+                        (mv ans1 ans2))
+                       ((equal ans1 (if not-flg *nil* *t*))
+
+; We have proved the original literal from which atm is derived; hence we have
+; proved the clause.  So we report this reduction.
+
+                        (mv ans1 ans2))
+                       ((all-type-reasoning-tags-p ans2)
+
+; Type-reasoning alone has been used, so we are careful in what we allow.
+
+			(cond ((lambda-subtermp atm2)
+
+; We received an example from Jared Davis in which a hypothesis of the form
+; (not (let ...)) rewrites to true with a tag tree of nil, and hence was kept
+; without this lambda-subtermp case.  The problem with keeping that hypothesis
+; is that it has calls of IF in a lambda body, which do not get eliminated by
+; clausification -- and this presence of IF terms causes the :force-info field
+; to be set to 'weak in the rewrite constant generated under simplify-clause.
+; That 'weak setting prevented forced simplification from occurring that was
+; necessary in order to make progress in Jared's proof!
+
+; A different solution would be to ignore IF calls in lambda bodies when
+; determining whether to set :force-info to 'weak.  However, that change caused
+; a regression suite failure: in books/symbolic/tiny-fib/tiny-rewrites.lisp,
+; theorem next-instr-pop.  The problem seemed to be premature forcing, of just
+; the sort we are trying to prevent with the above-mentioned check for IF
+; terms.
+
+; Robert Krug points out to us, regarding the efforts here to keep hypotheses
+; that rewrote to true, that for him the point is simply not to lose Boolean
+; hypotheses like (acl2-numberp x) in the example above.  Certainly we do not
+; expect terms with lambda calls to be of that sort, or even to make any sorts
+; of useful entries in type-alists.  If later we find other reasons to keep *t*
+; or *nil*, we can probably feel comfortable in adding conditions as we have
+; done with the lambda-subtermp test above.
+
+                               (mv ans1 ans2))
+                              ((eq (fn-symb atm2) 'implies)
+
+; We are contemplating throwing away the progress made by the above call of
+; rewrite.  However, we want to keep progress made by expanding terms of the
+; form (IMPLIES x y), so we do that expansion (again) here.  It seems
+; reasonable to keep this in sync with the corresponding use of subcor-var in
+; rewrite.
+
+                               (try-type-set-and-clause
+                                (subcor-var (formals 'implies wrld)
+                                            (list (fargn atm2 1)
+                                                  (fargn atm2 2))
+                                            (body 'implies t wrld))
+                                ans1 ans2 current-clause wrld
+                                (access rewrite-constant rcnst
+                                        :current-enabled-structure)))
+			      (t
+
+; We make one last effort to allow removal of certain ``trivial'' facts from
+; the goal.
+
+			       (try-type-set-and-clause
+                                atm2
+                                ans1 ans2 current-clause wrld
+                                (access rewrite-constant rcnst
+                                        :current-enabled-structure)))))
+		       (t
+			(mv ans1 ans2))))))))))
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/redef-notinline.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/redef-notinline.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/redef-notinline.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/redef-notinline.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,134 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(include-book "defun" :ttags :all)
+
+;; We introduce some macros which can be used to redefine functions in certain
+;; ways that improve their traceability.
+;;
+;; IMPORTANT NOTE:  These macros only work on functions which
+;;   (1) have their guards verified, and
+;;   (2) were introduced with MILAWA::defun
+;;
+;; (redef-notinline foo)
+;;   Redefines foo (with its own definition), but adds (declare (notinline foo))
+;;   so that the compiler cannot optimize away recursive calls.  In some lisps,
+;;   particularly OpenMCL, this will allow you to see all the calls with trace.
+;;
+;; (redef-original foo)
+;;   Redefines foo with its own definition, and without adding the notinline
+;;   declaration.  In other words, this "restores foo to its original version"
+;;   which may give you better performance if the compiler chooses to optimize
+;;   away recursive calls of foo.
+;;
+;;
+;; Here is an example:
+;;
+;; ACL2 !> (in-package "ACL2")
+;; ACL2 !> (MILAWA::defun fact (x acc)
+;;           (declare (xargs :guard (and (natp x)
+;;                                       (natp acc))))
+;;           (if (zp x)
+;;               acc
+;;             (fact (- x 1) (* x acc))))
+;; ACL2 !> (trace$ fact)
+;; ACL2 !> (fact 5 1)
+;;
+;; 1> (ACL2_*1*_ACL2::FACT 5 1)
+;;   2> (FACT 5 1)
+;;   <2 (FACT 120)
+;; <1 (ACL2_*1*_ACL2::FACT 120)
+;; 120
+;;
+;; ACL2 !> (redef-notinline fact)
+;; ACL2 !> (fact 5 1)
+;;
+;; 1> (ACL2_*1*_ACL2::FACT 5 1)
+;;   2> (FACT 5 1)
+;;     3> (FACT 4 5)
+;;       4> (FACT 3 20)
+;;         5> (FACT 2 60)
+;;           6> (FACT 1 120)
+;;             7> (FACT 0 120)
+;;             <7 (FACT 120)
+;;           <6 (FACT 120)
+;;         <5 (FACT 120)
+;;       <4 (FACT 120)
+;;     <3 (FACT 120)
+;;   <2 (FACT 120)
+;; <1 (ACL2_*1*_ACL2::FACT 120)
+;; 120
+;;
+;; ACL2 !> (redef-original fact)
+;; ACL2 !> (fact 5 1)
+;;
+;; 1> (ACL2_*1*_ACL2::FACT 5 1)
+;;   2> (FACT 5 1)
+;;   <2 (FACT 120)
+;; <1 (ACL2_*1*_ACL2::FACT 120)
+;; 120
+
+(defun redef-notinline-fn (f notinlinep)
+   (declare (ignore f notinlinep)
+            (xargs :guard t))
+   nil)
+
+(defttag redef-notinline)
+
+(progn!
+ (set-raw-mode t)
+ (defun redef-notinline-fn (f notinlinep)
+   (let* ((state *the-live-state*)
+          (world   (w state))
+          (def     (assoc f (get-acl2-defun-entries world))))
+     (if (not def)
+         (cw "redef-notinline-fn: attempting to redefine ~x0, which wasn't introduced with MILAWA::defun.~%" f)
+       (let* ((formals (second def))
+              (new-def (if notinlinep
+                           `(defun ,f ,formals
+                              ,@(cons `(declare (notinline ,f)) (cddr def)))
+                         `(defun ,f ,formals
+                            ,@(cddr def)))))
+         (eval new-def)
+         nil)))))
+
+(defmacro redef-original (f)
+  `(redef-notinline-fn ',f nil))
+
+(defmacro redef-notinline (f)
+  `(redef-notinline-fn ',f t))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/redef-okp.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/redef-okp.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/redef-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/redef-okp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,165 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+(defttag redef-okp)
+
+;; We allow certify-book even if redef has been set previously.  This is
+;; obviously unsound!
+
+(progn!
+ (set-raw-mode t)
+
+ (defun chk-acceptable-certify-book (book-name full-book-name k ctx state
+                                               suspect-book-action-alist)
+
+; This function determines that it is ok to run certify-book on
+; full-book-name and k.  Unless an error is caused we return a pair
+; (cmds . pre-alist) that contains the two parts of the portcullis.
+; If k is t it means that the existing certificate file specifies the
+; intended portcullis.  It also means that there must be such a file
+; and that we are in the ground zero state.  If all those things check
+; out, we will actually carry out the portcullis to get into the right
+; state by the time we return.
+
+   (let ((names
+
+; Warning: If you change the list of names below, be sure to change it
+; in the call of note-certification-world in certify-book-fn.
+
+          (cons 'defpkg *primitive-event-macros*))
+         (wrld (w state)))
+     (er-progn
+      (cond ((ld-skip-proofsp state)
+             (er soft ctx
+                 "Certify-book must be called with ld-skip-proofsp set to nil."))
+            ((f-get-global 'in-local-flg state)
+             (er soft ctx
+                 "Certify-book may not be called inside a LOCAL command."))
+            ((global-val 'skip-proofs-seen wrld)
+             (er soft ctx
+                 "At least one command in the current ACL2 world was executed ~
+                 while the value of state global variable '~x0 was not ~
+                 nil:~|~%  ~y1~%(If you did not explicitly use ~
+                 set-ld-skip-proofsp or call ld with :ld-skip-proofsp not ~
+                 nil, then some other function did so, for example, rebuild.) ~
+                 Certification is therefore not allowed in this world.  If ~
+                 the intention was for proofs to be skipped for one or more ~
+                 events in the certification world, consider wrapping those ~
+                 events explicitly in skip-proofs forms.  See :DOC ~
+                 skip-proofs."
+                 'ld-skip-proofsp
+                 (global-val 'skip-proofs-seen wrld)))
+            ((ttag wrld)
+
+; We disallow active ttag at certification time because we don't want to think
+; about certain oddly redundant defttag events.  Consider for example executing
+; (defttag foo), and then certifying a book containing the following forms,
+; (certify-book "foo" 1 nil :ttags ((foo nil))), indicating that ttag foo is
+; only active at the top level, not inside a book.
+
+; (defttag foo)
+
+; (defun f ()
+;   (declare (xargs :mode :program))
+;   (sys-call "ls" nil))
+
+; The defttag expands to a redundant table event, hence would be allowed.
+; Perhaps this is OK, but it is rather scary since we then have a case of a
+; book containing a defttag of which there is no evidence of this in any "TTAG
+; NOTE" string or in the book's certificate.  While we see no real problem
+; here, since the defttag really is ignored, still it's very easy for the user
+; to work around this situation by executing (defttag nil) before
+; certification; so we take this conservative approach.
+
+             (er soft ctx
+                 "It is illegal to certify a book while there is an active ~
+                 ttag, in this case, ~x0.  Consider undoing the corresponding ~
+                 defttag event (see :DOC ubt) or else executing ~x1.  See ~
+                 :DOC defttag."
+                 (ttag wrld)
+                 '(defttag nil)))
+            (t (value nil)))
+      (chk-book-name book-name full-book-name ctx state)
+      (er-let*
+       ((certp (certificate-filep full-book-name state)))
+       (mv-let
+        (erp cmds wrld-segs wrld-list state)
+        (get-portcullis-cmds wrld nil nil nil names ctx state)
+        (cond
+         (erp (silent-error state))
+         ((eq k t)
+          (cond
+           (cmds
+            (er soft ctx
+                "When you tell certify-book to recover the certification world ~
+                from the old certificate, you must call certify-book in the ~
+                initial ACL2 logical world -- so we don't have to worry about ~
+                the certification world  clashing with the existing logical ~
+                world.  But you are not in the initial logical world.  Use ~
+                :pbt 1 to see the world."))
+           ((not certp)
+            (er soft ctx
+                "There is no certificate on file for ~x0.  But you told ~
+                certify-book to recover the certi~-fication world from the ~
+                old certificate.  You will have to construct the ~
+                certi~-fication world by hand (by executing the desired ~
+                commands in the current logical world) and then call ~
+                certify-book again."
+                full-book-name))
+           (t
+
+; So k is t, we are in the initial world, and there is a certificate file
+; from which we can recover the portcullis.  Do it.
+
+            (er-let*
+             ((cert-obj
+               (chk-certificate-file full-book-name t ctx state
+                                     (cons '(:uncertified-okp . nil)
+                                           suspect-book-action-alist)
+                                     t))
+              (cert-obj-cmds (value (and cert-obj
+                                         (access cert-obj cert-obj :cmds)))))
+             (chk-acceptable-certify-book1 full-book-name
+                                           (length cert-obj-cmds) ;; k
+                                           cert-obj-cmds ;; cmds
+                                           :omitted ;; wrld-segs
+                                           wrld-list
+                                           names
+                                           (w state)
+                                           ctx state)))))
+         (t (chk-acceptable-certify-book1 full-book-name k cmds wrld-segs
+                                          wrld-list names wrld ctx
+                                          state)))))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/str.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/str.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/str.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/str.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,220 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "STR")
+(include-book "str/top" :dir :system)
+
+;; We introduce some string manipulation functions.  Note that we do not do
+;; much with strings, so we have not tried to make these functions efficient.
+;; Beware of trying to use them on larger data sets.
+;;
+;; We might eventually want to try to submit something like this to the ACL2
+;; distribution.
+
+(defun __cat-list (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (stringp (car x))
+          (string-append (car x) (__cat-list (cdr x)))
+        (__cat-list (cdr x)))
+    ""))
+
+
+(encapsulate
+ ()
+ (defun __pad-number-triple (x)
+   ;; X is a list of characters which are an exploded number between 0 and 999.
+   ;; Our job is to pad the number with leading zeroes (if necessary) so that it
+   ;; has three digits, e.g., "3" becomes "003", "14" becomes "014", etc.
+   (declare (xargs :guard t))
+   (let ((len (len x)))
+     (cond ((equal len 1) (cons #\0 (cons #\0 x)))
+           ((equal len 2) (cons #\0 x))
+           (t             x))))
+
+ (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
+
+ (local (defthm lemma
+          (implies (character-listp ans)
+                   (character-listp (explode-nonnegative-integer n base ans)))))
+
+ (defun __pretty-number-aux (n)
+   ;; We produce a list of the triples and commas, in reverse order of how they
+   ;; should be printed
+   (declare (xargs :guard t))
+   (let ((n (nfix n)))
+     (if (< n 1000)
+         ;; No padding for the leading digits
+         (list (coerce (explode-atom n 10) 'string))
+       (cons (coerce (__pad-number-triple (explode-atom (mod n 1000) 10)) 'string)
+             (cons "," (__pretty-number-aux (floor n 1000)))))))
+
+ (defun pretty-number (n)
+   (declare (xargs :guard t))
+   (__cat-list (reverse (__pretty-number-aux n)))))
+
+
+
+(defun character-list-fix (x)
+  (declare (xargs :guard t))
+  (if (character-listp x)
+      x
+    nil))
+
+(defund string-fix (x)
+  (declare (xargs :guard t))
+  (cond ((stringp x)
+         x)
+        ((natp x)
+         (pretty-number x))
+        ((integerp x)
+         (string-append "-" (pretty-number (- x))))
+        (t
+         "")))
+
+(defund string-list-fix (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (string-fix (car x))
+            (string-list-fix (cdr x)))
+    nil))
+
+(defthm string-listp-of-string-list-fix
+  (equal (string-listp (string-list-fix x))
+         t)
+  :hints(("Goal" :in-theory (enable string-list-fix))))
+
+(defun cat-list (strings)
+  ;; Concatenates a list of strings and natural numbers
+  (declare (xargs :guard t))
+  (string-append-lst (string-list-fix strings)))
+
+(defun cat-list-with-separator (strings sep)
+  ;; Concatenates the strings together, inserting the separator between each one
+  (declare (xargs :guard t))
+  (if (consp strings)
+      (if (consp (cdr strings))
+          (string-append (string-fix (car strings))
+                         (string-append (string-fix sep)
+                                        (cat-list-with-separator (cdr strings) sep)))
+        (string-fix (car strings)))
+    ""))
+
+;; This used to be STR::cat, but I renamed it for compatibility with the ACL2
+;; string library.
+
+(defmacro ncat (&rest strings)
+  `(cat-list (list ,@strings)))
+
+(defmacro sep (separator &rest strings)
+  `(cat-list-with-separator (list ,@strings) ,separator))
+
+
+
+
+
+(defun prefixp (x y)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (consp y)
+           (equal (car x) (car y))
+           (prefixp (cdr x) (cdr y)))
+    t))
+
+;; (defun implode (char-list)
+;;   ;; Coerces a character list into a string
+;;   (declare (xargs :guard t))
+;;   (coerce (character-list-fix char-list) 'string))
+
+;; (defun explode (string)
+;;   ;; Coerces a string into a character list
+;;   (declare (xargs :guard t))
+;;   (coerce (string-fix string) 'list))
+
+(defun explode-list (x)
+  ;; Coerces a string list into a "character list list"
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (explode (string-fix (car x)))
+            (explode-list (cdr x)))
+    nil))
+
+
+
+(defun char-list-replace (old new char-list)
+  ;; Replace a single character with a new one throughout a character list
+  (declare (xargs :mode :program))
+  (if (consp char-list)
+      (cons (if (equal (car char-list) old)
+                new
+              (car char-list))
+            (char-list-replace old new (cdr char-list)))
+    nil))
+
+(defun char-list-replace-char-list (old new char-list)
+  ;; Replaces all occurrences of "old" with "new" throughout char-list
+  (declare (xargs :mode :program))
+  (if (prefixp old char-list)
+      (append new
+              (char-list-replace-char-list old new (nthcdr (len old) char-list)))
+    (if (consp char-list)
+        (cons (car char-list)
+              (char-list-replace-char-list old new (cdr char-list)))
+      nil)))
+
+(defun char-list-replace-patterns (char-list patterns)
+  ;; Patterns is an alist of (old char-list . new char-list) entires.  We
+  ;; replace all old char-lists with new ones throughout char-list.  The
+  ;; replacements are done "one after another", so beware of inadvertent
+  ;; capture
+  (declare (xargs :mode :program))
+  (if (consp patterns)
+      (char-list-replace-patterns
+       (char-list-replace-char-list (car (car patterns))
+                                    (cdr (car patterns))
+                                    char-list)
+       (cdr patterns))
+    char-list))
+
+(defun string-replace-patterns (string patterns)
+  ;; Patterns is an alist of (old . new) entries, where old and new are
+  ;; strings.  We replace all substrings matching old with new.  The
+  ;; replacements are done "one after another", so beware of inadvertent
+  ;; capture
+  (declare (xargs :mode :program))
+  (implode (char-list-replace-patterns (explode string)
+                                       (pairlis$ (explode-list (strip-cars patterns))
+                                                 (explode-list (strip-cdrs patterns))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/acl2-hacks/top.lisp acl2-6.3/books/milawa/ACL2/acl2-hacks/top.lisp
--- acl2-6.2/books/milawa/ACL2/acl2-hacks/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/acl2-hacks/top.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,61 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(include-book "assume")
+(include-book "car-cdr-untranslate")
+;(include-book "compact-write-file")
+(include-book "debug-guards")
+;(include-book "defthm")
+(include-book "defthms-flag")
+(include-book "defun")
+(include-book "force")
+(include-book "info")
+(include-book "io")
+(include-book "ls")
+(include-book "mksym")
+(include-book "no-fertilize")
+;; Do not include redef-okp until it's needed; it's unsound
+(include-book "redef-notinline")
+(include-book "str")
+;; (include-book "widescreen")
+
+(defmacro defsection (name &rest args)
+  ;; This is just a "named encapsulate nil."  It doesn't really do anything
+  ;; except group some commands into a local scope.  But it prints a lot better
+  ;; with :pbt than hundreds of encapsulate nils.
+  (declare (ignore name))
+  `(encapsulate () ,@args))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/compatible-write-file.lisp acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/compatible-write-file.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/compatible-write-file.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/compatible-write-file.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,351 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+; compatible-write-file.lisp
+;
+; We now introduce an alternative to compact-write-file that can produce a
+; compatible proof file for both Common Lisp and the Verified Lisp.
+
+
+; Symbol Encoding
+;
+; The Verified Lisp uses a syntax that is similar to Common Lisp but has some
+; differences.  We now try to identify a subset of symbols that are compatible
+; across both Lisps.
+;
+; BOZO THIS PARAGRAPH IS OUTDATED AND DEAD WRONG (please update it):
+; The Verified Lisp gives two ways to write symbols.  A Plain Symbol (with no
+; bar escapes) must be non-empty, must begin with a character other than 0-9 or
+; quote, and may not contain: parens, periods, sharp signs, or vertical bars,
+; or ASCII characters under 32.  These symbols are also case-sensitive.  An
+; Escaped Symbol begins and ends with vertical bars, and may contain any
+; characters (case-sensitive); backslash is an escape, i.e., \| creates a
+; vertical bar and \\ creates a backslash, but all other characters stand for
+; themselves.
+;
+; Common Lisp also has plain symbols, but with some differences.  We also would
+; like to prohibit colons (because of the package system), semicolons (because
+; of comments), backquotes or commas (because of quasiquotation), double quotes
+; (because of string literals), backslashes (because of their special
+; interpretation as an escape), amperstands (because of their use in lambda
+; lists, slash (since it can lead to number confusion, e.g., 1/2), and
+; lowercase characters (because Common Lisp reads symbols in a case-insensitive
+; way).  We also need to prohibit dash as a first character since, e.g., -35
+; could be interpreted as a number.  On the other hand, Common Lisp's
+; bar-escape mechanism seems to be directly compatible with the Verified Lisp.
+;
+; We will use plain symbols only when the name is PLAIN_OK.
+;
+;   TAIL_CHAR ::= UPPERCASE_ALPHA (A-Z)
+;               | DIGIT (0-9)
+;               | '~' (tilde)
+;   ;; NO!!     | '!' (bang)
+;               | '@' (at)
+;   ;; NO!!     | '$' (dollar)
+;   ;; NO!!     | '%' (percent)
+;               | '^' (caret)
+;               | '*' (star)
+;               | '-' (dash)
+;               | '_' (underscore)
+;               | '+' (plus)
+;               | '=' (equal)
+;               | '[' (square open)
+;               | ']' (square close)
+;               | '{' (squiggly open)
+;               | '}' (squiggly close)
+;               | '<' (angle open)
+;               | '>' (angle close)
+;               | '?' (question mark)
+;
+;   HEAD_CHAR ::= TAIL_CHAR other than DIGIT or '-' (dash)
+;
+;   PLAIN_OK ::= HEAD_CHAR TAIL_CHAR*
+
+(defun safe-symtail-char-p (x)
+  (declare (xargs :guard (characterp x)))
+  (or (and (char<= #\A x) (char<= x #\Z))
+      (and (char<= #\0 x) (char<= x #\9))
+      (member x '(#\~ #\@ #\^ #\* #\- #\_
+                  #\+ #\= #\[ #\] #\{ #\}
+                  #\< #\> #\?))))
+
+(defun safe-symtail-charlist-p (x)
+  (declare (xargs :guard (character-listp x)))
+  (or (atom x)
+      (and (safe-symtail-char-p (car x))
+           (safe-symtail-charlist-p (cdr x)))))
+
+(defun safe-symhead-char-p (x)
+  (declare (xargs :guard (characterp x)))
+  (and (safe-symtail-char-p x)
+       (not (eql x #\-))
+       (not (and (char<= #\0 x) (char<= x #\9)))))
+
+(defun safe-symcharlist-p (x)
+  (declare (xargs :guard (character-listp x)))
+  (and (consp x)
+       (safe-symhead-char-p (car x))
+       (safe-symtail-charlist-p (cdr x))))
+
+(defun escape-unsafe-symcharlist (x)
+  (declare (xargs :guard (character-listp x)))
+  (cond ((atom x)
+         nil)
+        ((eql (car x) #\\)
+         (list* #\\ #\\ (escape-unsafe-symcharlist (cdr x))))
+        ((eql (car x) #\|)
+         (list* #\\ #\| (escape-unsafe-symcharlist (cdr x))))
+        (t
+         (cons (car x) (escape-unsafe-symcharlist (cdr x))))))
+
+(defthm character-listp-of-escape-unsafe-symcharlist
+  (implies (character-listp x)
+           (character-listp (escape-unsafe-symcharlist x))))
+
+(defun downcase-plain-symcharlist (x)
+  (declare (xargs :guard (character-listp x)))
+  (cond ((atom x)
+         nil)
+        ((and (char<= #\A (car x))
+              (char<= (car x) #\Z))
+         (cons (code-char (+ (char-code #\a)
+                             (- (char-code (car x))
+                                (char-code #\A))))
+               (downcase-plain-symcharlist (cdr x))))
+        (t
+         (cons (car x)
+               (downcase-plain-symcharlist (cdr x))))))
+
+(defthm character-listp-of-downcase-plain-symcharlist
+  (implies (character-listp x)
+           (character-listp (downcase-plain-symcharlist x))))
+
+(defun symbol-representation (x)
+  ;; Returns a string
+  (declare (xargs :guard (symbolp x)))
+  (let* ((name  (symbol-name x))
+         (chars (coerce (the string name) 'list)))
+    (if (safe-symcharlist-p chars)
+        (let ((downcase-chars (downcase-plain-symcharlist chars)))
+          (coerce downcase-chars 'string))
+      (let* ((escaped-chars (escape-unsafe-symcharlist chars))
+             (bars          (cons #\| (append escaped-chars '(#\|)))))
+        (coerce bars 'string)))))
+
+(defthm stringp-of-symbol-representation
+  (stringp (symbol-representation x)))
+
+(memoize 'symbol-representation)
+
+
+
+(defun compatible-write-file (obj filename size)
+  (declare (xargs :guard (and (stringp filename)
+                              (natp size))
+                  :mode :program)
+           (ignorable obj filename size))
+  nil)
+
+(defttag compatible-write-file)
+
+(progn!
+ (set-raw-mode t)
+ (in-package "ACL2")
+
+ (defun compatible-write-file-scan (obj ht)
+
+; Similar to compact-print-file-scan.  OBJ is any valid Milawa object.  HT is
+; an EQL hash table, which we are destructively modifying.  The idea here is to
+; decide which subterms of OBJ we would like to give #1=-style labels to when
+; we do our printing.
+;
+; A vague goal is to assign labels when they will help to create a smaller
+; printed representation.  So it would be dumb to assign a label to any subterm
+; that is only used once, since, e.g., #1=FOO takes more space than FOO all by
+; itself.  Furthermore, our "full events" object has on the order of 525
+; million unique conses.  It seems fairly reasonable to assume that we will
+; want to label something like 100+ million of these nodes, which means a label
+; might typically require 8 or 9 digits (along with two sharp signs, e.g.,
+; #100000000#) to reference.  So, we won't introduce labels if the symbol has
+; fewer than 11 characters.
+;
+; Initially HT is empty.  As we encounter an object for the first time, if we
+; regard it as worth labelling we bind it to :SEEN.  If we see it a second
+; time, we bind it to :LABEL.  Our printing function will only label things
+; that are bound to :LABEL.
+
+   (let ((worth-labelling-p
+          (cond ((consp obj)
+                 t)
+                ((symbolp obj)
+                 (let ((name (symbol-name obj)))
+                   (unless (equal obj (intern name "MILAWA"))
+                     (er hard? 'compatible-write-file-scan
+                         "Symbol is not in the Milawa package: ~x0." obj))
+                   ;; We check length against 9 instead of 11, since we expect
+                   ;; that most symbols need to be encoded and have vertical
+                   ;; bars in their printed representation.
+                   (>= (length name) 9)))
+                ((natp obj)
+                 ;; We think large enough numbers are sufficiently unlikely
+                 ;; that we won't bother to label any numbers.
+                 nil)
+                (t
+                 (er hard? 'compatible-write-file-scan
+                     "Illegal object for Milawa: ~x0." obj)))))
+     (when worth-labelling-p
+       (let ((val (gethash obj ht)))
+         (when (eq val :seen)
+           ;; Not sure if we should recur into the car/cdr.  Bob doesn't in
+           ;; compact-print-file-scan, so I guess I won't either.  But I haven't
+           ;; thought about whether this is good.
+           (setf (gethash obj ht) :label))
+         (when (not val)
+           (setf (gethash obj ht) :seen)
+           (unless (atom obj)
+             (compatible-write-file-scan (car obj) ht)
+             (compatible-write-file-scan (cdr obj) ht)))))))
+
+
+ (defun compatible-write-file-aux (obj ht stream free)
+
+; Similar to COMPACT-PRINT-FILE-HELP.  OBJ is the object to write.  HT is the
+; hash table that binds some objects to :SEEN and some to :LABEL.  STREAM is
+; the stream we are printing to.  FREE is the lowest index that has not been
+; assigned.  We return FREE'.
+
+   (when (not obj)
+     (write-char #\( stream)
+     (write-char #\) stream)
+     (return-from compatible-write-file-aux free))
+
+   (let ((lookup (gethash obj ht)))
+     (when (natp lookup)
+       (write-char #\# stream)
+       (write-string (coerce (explode-atom lookup 10) 'string) stream)
+       (write-char #\# stream)
+       (write-char #\Space stream)
+       (return-from compatible-write-file-aux free))
+     (when (eq lookup :label)
+       (setf (gethash obj ht) free)
+       (write-char #\# stream)
+       (write-string (coerce (explode-atom free 10) 'string) stream)
+       (write-char #\= stream)
+       (incf free)))
+
+   (cond ((symbolp obj)
+          (write-string (symbol-representation obj) stream)
+          (write-char #\Space stream))
+
+         ((natp obj)
+          (write-string (coerce (explode-atom obj 10) 'string) stream)
+          (write-char #\Space stream))
+
+         ((consp obj)
+          (write-char #\( stream)
+          (setq free (compatible-write-file-aux-list obj ht stream free))
+          (write-char #\) stream))
+
+         (t
+          (er hard? 'compatible-write-file-aux
+              "Not a valid Milawa object: ~x0" obj)))
+
+   free)
+
+ (defun compatible-write-file-aux-list (obj ht stream free)
+   (setq free (compatible-write-file-aux (car obj) ht stream free))
+   (cond ((null (cdr obj))
+          free)
+         ((or (atom (cdr obj))
+              (let ((lookup (gethash (cdr obj) ht)))
+                (or (natp lookup)
+                    (eq lookup :label))))
+          (progn
+            (write-char #\. stream)
+            (write-char #\Space stream)
+            (compatible-write-file-aux (cdr obj) ht stream free)))
+         (t
+          (compatible-write-file-aux-list (cdr obj) ht stream free))))
+
+ (defun compatible-write-file (obj filename size)
+   ;; We can use an EQ hash table since there aren't any numbers in it.
+   (let ((ht (make-hash-table :size size :test 'eq))
+         (*print-base* 10))
+     (time (compatible-write-file-scan obj ht))
+     (with-open-file
+      (stream filename
+              :direction :output
+              :if-exists :supersede)
+      (compatible-write-file-aux obj ht stream 0)))))
+
+
+(defun dumb-read-file (filename state)
+  (declare (xargs :mode :program :stobjs state))
+  (mv-let (channel state)
+    (open-input-channel filename :object state)
+    (mv-let (eofp obj state)
+      (read-object channel state)
+      (declare (ignore eofp))
+      (let ((state (close-input-channel channel state)))
+        (mv obj state)))))
+
+#||
+
+(in-package "ACL2")
+
+(set-debugger-enable t)
+
+(defun MILAWA::test-write (obj state)
+  (declare (xargs :mode :program :stobjs state))
+  (prog2$
+   (compatible-write-file obj "test.obj" 60)
+   (mv-let (read state)
+     (dumb-read-file "test.obj" state)
+     (prog2$ (or (equal read obj)
+                 (er hard? 'test "Oops, didn't read the right result."))
+             (mv read state)))))
+
+
+(in-package "MILAWA")
+
+(test-write 3 acl2::state)
+(test-write 'foo acl2::state)
+(test-write 'foo.bar acl2::state)
+(test-write '(foo.bar . foo.bar) acl2::state)
+(test-write '(foo foo (foo . foo) bar bar (foo . foo) . (foo . foo)) acl2::state)
+
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/export.lisp acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/export.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/export.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/export.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,172 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "compatible-write-file")
+(include-book "memory-mgmt-raw")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(acl2::set-debugger-enable t)
+(acl2::set-max-mem (* 56 (expt 2 30)))
+
+
+(defun milawa-read-files (files)
+  (declare (xargs :mode :program))
+  (if (consp files)
+      (cons (milawa-read-file (car files))
+            (milawa-read-files (cdr files)))
+    nil))
+
+(defconst *events-files*
+  '("../../../Proofs/utilities.events"
+    "../../../Proofs/logic.events"
+    "../../../Proofs/level2.events"
+    "../../../Proofs/level3.events"
+    "../../../Proofs/level4.events"
+    "../../../Proofs/level5.events"
+    "../../../Proofs/level6.events"
+    "../../../Proofs/level7.events"
+    "../../../Proofs/level8.events"
+    "../../../Proofs/level9.events"
+    "../../../Proofs/level10.events"
+    "../../../Proofs/level11.events"
+    "../../../Proofs/user.events"))
+
+(defconst *events*
+  (simple-flatten (milawa-read-files *events-files*)))
+
+
+
+
+(defun convert-events (events acc)
+  (declare (xargs :mode :program))
+  (if (not (consp events))
+      acc
+    (let* ((entry (car events))
+          (acc (cond
+                ((equal (first entry) 'VERIFY)
+                 (let* ((name      (second entry))
+                        (formula   (third entry))
+                        (filename  (str::cat "../../../" (fourth entry)))
+                        (proof     (car (milawa-read-file filename)))
+                        (new-event (acl2::hons-list 'VERIFY name formula proof)))
+                   (acl2::hons new-event acc)))
+
+                ((equal (first entry) 'DEFINE)
+                 (let* ((name     (second entry))
+                        (formals  (third entry))
+                        (body     (fourth entry))
+                        (measure   (fifth entry))
+                        ;; (inlinep  (memberp name functions-to-inline))
+                        (filename (str::cat "../../../" (ACL2::seventh entry)))
+                        (proofs   (car (milawa-read-file filename)))
+                        (new-event (acl2::hons-list 'DEFINE name formals body measure proofs)))
+                   (acl2::hons new-event acc)))
+
+                ((or (equal (first entry) 'SKOLEM)
+                     (equal (first entry) 'SWITCH))
+                 (acl2::hons entry acc))
+
+                ((equal (first entry) 'FINISH) ;; drop any "finish" events
+                 acc)
+
+                (t
+                 (acl2::er acl2::hard? 'convert-events
+                           "Bad event: ~x0.~%" entry)))))
+      (convert-events (cdr events) acc))))
+
+
+;; looks like there are about 525 million unique conses
+;; we can probably reduce this number.
+;; there is some lousy memory management stuff happening in the default acl2h.
+;; what are we fixing with memory-mgmt-raw in stp?
+(ACL2::hons-resize :addr-ht 650000000)
+
+(defconst *new-events*
+  ;; This took about 4400 seconds on fv-1.
+  ;; Allocated 28 GB.
+  ;; aha, with the fixed memory management it only takes 2500 sec
+  (acl2::reverse (acl2::time$ (convert-events *events* nil))))
+
+;; Throw away massive address table
+(acl2::time$ (acl2::hons-clear nil))
+(acl2::time$ (acl2::hons-resize :addr-ht 1000))
+
+;; with lousy mem mgmt, 24.6 gb allocated, 15 gb freed
+;; with fixed mem mgmt, 53.6 gb allocated, 44 gb freed
+(acl2::gc$)
+
+
+
+(defun do-save ()
+  (declare (xargs :mode :program))
+  ;; compact-write-file took about 4800 seconds on fv-1.
+  ;; (acl2::time$ (compact-write-file *new-events* "full.new-events")))
+  (acl2::time$
+   ;; this was taking about 4400 seconds, well, probably more like 3000
+   ;; with the fixed memory mgmt, it's only 1170 seconds
+   (acl2::compatible-write-file *new-events*
+                                "full.events"
+                                650000000)))
+
+(do-save)
+
+
+#||
+
+;; other commands to generate short files of fewer events
+
+(defun do-save2 ()
+  (declare (xargs :mode :program))
+  (acl2::time$
+   (acl2::compatible-write-file (firstn 100 *new-events*)
+                                "100.events"
+                                650000000)))
+
+
+(do-save2)
+
+(defun do-save3 ()
+  (declare (xargs :mode :program))
+  (acl2::time$
+   (acl2::compatible-write-file (firstn 1000 *new-events*)
+                                "1000.events"
+                                650000000)))
+
+(do-save3)
+
+||#
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/hons-analyze-memory-raw.lsp acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/hons-analyze-memory-raw.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/hons-analyze-memory-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/hons-analyze-memory-raw.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,148 @@
+(in-package "ACL2")
+
+; Raw lisp definition of hons-analyze-memory.
+
+#+static-hons
+(defun hl-sizeof (thing)
+
+; Highly CCL-specific.  This function computes something like "the size of
+; thing in bytes," and was originally developed by Gary Byers in response to a
+; question on the CCL mailing list.  Jared only changed the names so it can be
+; in the ACL2 package and added this comment.
+;
+; Note: determining memory usage is subtle and this function does NOT
+; necessarily give you the whole story.  For instance, in CCL each hash table
+; has a uvector inside of it that holds the data elements.  So, the (hl-sizeof
+; ht) for some hash table doesn't actually descend into this field!
+;
+; The following comment was left by Gary:
+
+  ;; All memory-allocated objects in CCL are either CONSes or
+  ;; "UVECTOR"s; a UVECTOR contains a header which describes the
+  ;; object's primitive type (represented as an (UNSIGNED-BYTE 8) and
+  ;; accessible via the function CCL::TYPECODE) and element-count
+  ;; (accessible via the function CCL::UVSIZE.)  A function defined in
+  ;; the compiler backend knows how to map from a typecode and
+  ;; element-count to a size in octets.  UVECTORs are aligned on
+  ;; doubleword boundaries and contain this extra header word, so the
+  ;; "physical size" of the uvector is a bit bigger.  On x86-64,
+  ;; SYMBOLs and FUNCTIONs have their own tag, but there's an
+  ;; underlying UVECTOR.
+  (cond ((null thing) 0)
+        ((consp thing) #+64-bit-target 16 #+32-bit-target 8)
+        #+x8664-target ((symbolp thing)
+                        (hl-sizeof (ccl::%symptr->symvector thing)))
+        #+x8664-target ((functionp thing)
+                        (hl-sizeof (ccl::function-to-function-vector thing)))
+        ((ccl::uvectorp thing)
+         (let* ((typecode (ccl::typecode thing))
+                (element-count (ccl::uvsize thing))
+                (sizeof-content-in-octets
+                 ;; Call the architecture-specific backend function.
+                 (funcall (arch::target-array-data-size-function
+                           (ccl::backend-target-arch ccl::*host-backend*))
+                          typecode element-count)))
+           (logandc2 (+ sizeof-content-in-octets
+                           #+64-bit-target (+ 8 15)
+                           #+32-bit-target (+ 4 7))
+                     #+64-bit-target 15
+                     #+32-bit-target 7)))
+        (t 0)))
+
+#+static-hons
+(defun hl-hash-table-bytes (ht)
+
+; This is Jared's approximation of the actual memory being used by the hash
+; table itself.  Note that this does NOT include the memory used by any of the
+; keys or values that are currently stored in the hash table; the only things
+; we count are the hash table's vector and its header size.  This may be an
+; under-approximation if we are missing other uvectors in the hash table
+; structure itself.
+
+  (declaim (type hash-table ht))
+  (+ (hl-sizeof ht)
+     (hl-sizeof (ccl::nhash.vector ht))))
+
+
+#+static-hons
+(defun hl-hash-table-key-bytes (ht)
+
+; This is Jared's approximation of the actual memory being used for the keys of
+; a hash table.  This doesn't follow any pointers in the keys, but should work
+; for counting up strings, bignums, that sort of thing.
+
+  (let ((size 0))
+    (maphash (lambda (key val)
+	       (declare (ignore val))
+	       (unless (typep key 'fixnum)
+		 (incf size (hl-sizeof key))))
+	     ht)
+    size))
+
+#+static-hons
+(defun hl-hspace-analyze-memory (slowp hs)
+
+; Print a brief report about the memory being used by the hons space.  When
+; slowp is set, we generate better information but may require a lot more time
+; to do it.
+
+  (declaim (type hl-hspace hs))
+  (format t "Analyzing hons-space memory usage.~%~%")
+
+  (format t "SBITS total memory:          ~15:D bytes~%~%"
+          (hl-sizeof (hl-hspace-sbits hs)))
+
+  (let* ((addr-ht             (hl-hspace-addr-ht hs))
+         (addr-key-bytes      (if slowp
+                                  (hl-hash-table-key-bytes addr-ht)
+                                0))
+         (addr-tbl-bytes      (hl-hash-table-bytes addr-ht))
+         (addr-overhead-bytes (+ addr-key-bytes addr-tbl-bytes))
+         (addr-data-bytes     (* (hl-sizeof '(1 . 2)) ;; 16
+                                 (hash-table-count addr-ht)))
+         (addr-total-mem      (+ addr-overhead-bytes addr-data-bytes)))
+    (format t "ADDR-HT total memory:        ~15:D bytes~%" addr-total-mem)
+    (format t "  - Actual cons data:        ~15:D bytes (~5,2f%)~%"
+            addr-data-bytes
+            (/ (* addr-data-bytes 100.0) addr-total-mem))
+    (if slowp
+        (progn
+          (format t "  - Total overhead:          ~15:D bytes (~5,2f%)~%"
+                  addr-overhead-bytes
+                  (/ (* addr-overhead-bytes 100.0) addr-total-mem))
+          (format t "     from the table itself:  ~15:D bytes~%" addr-tbl-bytes)
+          (format t "     from bignum indicies:   ~15:D bytes~%~%" addr-key-bytes))
+      (format t "  - Overhead (approx):       ~15:D bytes (~5,2f%)~%~%"
+              addr-overhead-bytes
+              (/ (* addr-overhead-bytes 100.0) addr-total-mem))))
+
+  (let* ((str-ht          (hl-hspace-str-ht hs))
+         (str-tbl-bytes   (hl-hash-table-bytes str-ht))
+         (str-key-bytes   (hl-hash-table-key-bytes str-ht))
+         (str-addr-bytes  (* (hl-sizeof '(1 . 2))
+                             (hash-table-count str-ht)))
+         (str-total-bytes (+ str-tbl-bytes str-key-bytes str-addr-bytes)))
+    (format t "STR-HT total memory:         ~15:D bytes~%" str-total-bytes)
+    (format t "  - Actual string data:      ~15:D bytes~%" str-key-bytes)
+    (format t "  - Total overhead:          ~15:D bytes~%" (+ str-tbl-bytes str-addr-bytes))
+    (format t "     from the table itself:  ~15:D bytes~%" str-tbl-bytes)
+    (format t "     from address conses:    ~15:D bytes~%~%" str-addr-bytes))
+
+  (let* ((other-ht          (hl-hspace-other-ht hs))
+         (other-tbl-bytes   (hl-hash-table-bytes other-ht))
+         (other-key-bytes   (hl-hash-table-key-bytes other-ht))
+         (other-addr-bytes  (* (hl-sizeof '(1 . 2))
+                               (hash-table-count other-ht)))
+         (other-total-bytes (+ other-tbl-bytes other-key-bytes other-addr-bytes)))
+    (format t "OTHER-HT total memory:       ~15:D bytes~%" other-total-bytes)
+    (format t "  - Data for the atoms:      ~15:D bytes~%" other-key-bytes)
+    (format t "  - Table overhead:          ~15:D bytes~%" other-tbl-bytes)
+    (format t "  - Address overhead:        ~15:D bytes~%~%" other-addr-bytes))
+  )
+
+(defun hons-analyze-memory (slowp)
+  (hl-maybe-initialize-default-hs)
+  #+static-hons
+  (hl-hspace-analyze-memory slowp *default-hs*)
+  #-static-hons
+  (cw "Hons-analyze-memory is only available for static honsing.~%"))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/memory-mgmt-logic.lisp acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/memory-mgmt-logic.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/memory-mgmt-logic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/memory-mgmt-logic.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,58 @@
+
+(in-package "ACL2")
+
+;; Note: This book should be included in conjunction with
+;; memory-mgmt-raw.lisp; otherwise, these functions won't do
+;; much of anything interesting.
+
+(defun hons-analyze-memory (slowp)
+  (declare (xargs :guard t)
+           (ignore slowp))
+  (er hard? 'hons-analyze-memory "Raw lisp definition not installed?"))
+
+(defun maybe-wash-memory-fn (n clear)
+  (declare (xargs :guard t)
+           (ignore n clear))
+  (cw "maybe-wash-memory is defined under the hood~%"))
+
+(defmacro maybe-wash-memory (n &optional clear)
+  `(maybe-wash-memory-fn ,n ,clear))
+
+(add-macro-alias maybe-wash-memory maybe-wash-memory-fn)
+
+
+(defun set-max-mem (n)
+  (declare (xargs :guard t)
+           (ignore n))
+  (cw "set-max-mem is defined under the hood~%"))
+
+
+(defun print-rwx-size ()
+  (declare (xargs :guard t))
+  (cw "print-rwx-size is defined under the hood~%"))
+
+
+(defun last-chance-wash-memory-fn ()
+  (declare (xargs :guard t))
+  ;; Sol: I removed this printing because in certain places I use BDD functions
+  ;; without loading the -raw book, and if it prints this line each time it's
+  ;; messy.
+  ;; (cw "last-chance-wash-memory is defined under the hood~%")
+  nil)
+
+(defmacro last-chance-wash-memory ()
+  `(last-chance-wash-memory-fn))
+
+(add-macro-alias last-chance-wash-memory last-chance-wash-memory-fn)
+
+
+(in-theory (disable maybe-wash-memory
+                    (maybe-wash-memory)
+                    (:type-prescription maybe-wash-memory-fn)
+                    last-chance-wash-memory
+                    (last-chance-wash-memory)
+                    (:type-prescription last-chance-wash-memory-fn)
+                    set-max-mem
+                    (set-max-mem)
+                    (:type-prescription set-max-mem)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/memory-mgmt-raw.lisp acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/memory-mgmt-raw.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/jitawa/memory-mgmt-raw.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/jitawa/memory-mgmt-raw.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,97 @@
+
+(in-package "ACL2")
+
+(include-book "memory-mgmt-logic")
+(include-book "tools/include-raw" :dir :system)
+
+; (depends-on "hons-analyze-memory-raw.lsp")
+
+(defttag memory-mgmt)
+
+(progn!
+ (set-raw-mode t)
+
+ (defmacro pkc (pkg fn &rest args)
+   (cons (intern (symbol-name fn) (symbol-name pkg))
+         args))
+
+ ;; Use defvar so these aren't clobbered.
+ (defvar *gc-min-threshold* (expt 2 30))
+
+ (defvar *max-mem-usage* (expt 2 32))
+
+ (defvar *last-chance-threshold*
+   ;; We'll automatically wash if we get within 1/400 of the max memory usage.
+   ;; Examples:
+   ;;   If *max-mem-usage* is   8 GB, the cushion is  ~21 MB.
+   ;;   If *max-mem-usage* is  16 GB, the cushion is  ~42 MB.
+   ;;   If *max-mem-usage* is  32 GB, the cushion is  ~85 MB.
+   ;;   If *max-mem-usage* is  64 GB, the cushion is ~171 MB.
+   ;;   If *max-mem-usage* is  96 GB, the cushion is ~257 MB.
+   ;;   If *max-mem-usage* is 128 GB, the cushion is ~343 MB.
+   (ceiling *max-mem-usage* 400))
+
+ (defun set-max-mem-usage (max)
+   (setf *max-mem-usage* max)
+   (setf *last-chance-threshold* (ceiling *max-mem-usage* 400))
+   (setf *gc-min-threshold* (floor *max-mem-usage* 5))
+   (set-and-reset-gc-thresholds))
+
+ (defun print-quick-memory-summary ()
+   (multiple-value-bind
+    (dynamic-used static-used library-used frozen-size)
+    (pkc ccl %usedbytes)
+    (let ((free (pkc ccl %freebytes))
+          (used (+ dynamic-used static-used library-used frozen-size))
+          (max  *max-mem-usage*))
+      (format t "Max:            ~15:D bytes~%" max)
+      (format t "Free:           ~15:D bytes~%" free)
+      (format t "Used:           ~15:D bytes~%" used)
+      (format t "  - Dynamic:    ~15:D bytes~%" dynamic-used)
+      (format t "  - Static:     ~15:D bytes~%" static-used)
+      (format t "  - Library:    ~15:D bytes~%" library-used)
+      (format t "  - Frozen:     ~15:D bytes~%" frozen-size)
+      (format t "Dynamic+Frozen: ~15:D bytes~%" (+ dynamic-used frozen-size))
+      (hons-summary)
+      (hons-analyze-memory nil)
+      (finish-output))))
+
+ (defun maybe-wash-memory-fn (n clear)
+   (when (or (eq n t)
+             (< (pkc ccl %freebytes) (nfix n)))
+     (format t "********** maybe-wash-memory started ***********~%~%")
+     (format t "Pre-wash memory usage.~%")
+     (print-quick-memory-summary)
+
+     (if clear
+         (time$ (clear-hash-tables)
+                :msg "(clear-hash-tables) took ~st seconds, ~sa bytes.~%~%")
+       (time$ (wash-memory)
+              :msg "(wash-memory) took ~st seconds, ~sa bytes.~%~%"))
+
+     (format t "Post-wash memory usage:~%")
+     (print-quick-memory-summary)
+
+     (format t "********** maybe-wash-memory finished **********~%"))
+
+   nil)
+
+ (defun last-chance-wash-memory-fn ()
+   (when (< (pkc ccl %freebytes) *last-chance-threshold*)
+     (format t "*********** last-chance-wash-memory ************~%")
+     (format t "~:D free bytes < ~:D last chance threshold~%"
+             (pkc ccl %freebytes)
+             *last-chance-threshold*)
+     (maybe-wash-memory-fn t nil)))
+
+ (defun set-max-mem (max)
+   (set-max-mem-usage max)
+   nil)
+
+ (defun print-rwx-size ()
+   (cw "~x0~%" (rwx-size))))
+
+(include-raw "hons-analyze-memory-raw.lsp")
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level10/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/acl2-customization.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level10/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/cert.image	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1 @@
+level10-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-clause.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-clause.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-clause.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-clause.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,319 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite")
+(%interactive)
+
+
+(%autoprove rw.ccstep->clause-prime-under-iff
+            (%enable default
+                     rw.ccstep->clause-prime
+                     rw.ccstep->provedp))
+
+(%autoprove forcing-rw.eqtrace-okp-of-rw.assms->contradiction-and-rw.assms->hypbox-free)
+
+(%autoprove forcing-rw.eqtrace-atblp-of-rw.assms->contradiction-of-rw.assume-right
+            (%enable default rw.assume-right))
+
+(%autoprove forcing-rw.eqtrace-atblp-of-rw.assms->contradiction-of-rw.assume-right-list
+            (%cdr-induction nhyps))
+
+(%autoprove forcing-rw.eqtrace-atblp-of-rw.assms->contradiction-of-rw.assume-left
+            (%enable default rw.assume-left))
+
+(%autoprove forcing-rw.eqtrace-atblp-of-rw.assms->contradiction-of-rw.assume-left-list
+            (%cdr-induction nhyps))
+
+
+
+
+(defsection rw.crewrite-take-step
+  (%autoadmit rw.crewrite-take-step)
+  (local (%enable default rw.crewrite-take-step))
+  (%autoprove forcing-rw.ccstepp-of-rw.crewrite-take-step)
+  (%autoprove forcing-rw.trace-okp-of-rw.ccstep->trace-of-rw.crewrite-take-step)
+  (%autoprove forcing-rw.trace-atblp-of-rw.ccstep->trace-of-rw.crewrite-take-step)
+  (%autoprove forcing-rw.ccstep-trace-env-okp-of-rw.ccstep->trace-of-rw.crewrite-take-step)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.ccstep->contradiction-of-rw.crewrite-take-step)
+  (%autoprove forcing-logic.term-atblp-of-rw.ccstep->term-of-rw.crewrite-take-step)
+  (%autoprove forcing-rw.hypbox-atblp-of-rw.ccstep->hypbox-of-rw.crewrite-take-step))
+
+
+
+
+(defsection rw.crewrite-clause-aux
+
+  (%autoadmit rw.crewrite-clause-aux)
+  (local (%restrict default rw.crewrite-clause-aux (equal todo 'todo)))
+  (local (%enable default rw.ccstep->provedp))
+
+  (%autoprove forcing-rw.ccstep-listp-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux))
+
+  (%autoprove forcing-rw.trace-list-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux))
+
+  (%autoprove forcing-rw.trace-list-atblp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux))
+
+  (%autoprove forcing-rw.trace-list-env-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux))
+
+  (defthmd lemma-for-forcing-rw.ccstep-list->compatiblep-of-rw.crewrite-clause-aux
+    ;; BOZO unlocalize
+    (implies (and (consp todo)
+                  (consp (cdr todo))
+                  (logic.term-listp todo)
+                  (logic.term-listp done)
+                  (rw.controlp control)
+                  (not (rw.ccstep->provedp (rw.crewrite-take-step todo done blimit rlimit control n))))
+             (equal
+              (rw.ccstep->result-goal
+               (rw.crewrite-take-step todo done blimit rlimit control n))
+              (rw.ccstep->original-goal
+               (rw.crewrite-take-step (cdr todo)
+                                      (cons (rw.ccstep->t1prime
+                                             (rw.crewrite-take-step todo done blimit rlimit control n))
+                                            done)
+                                      blimit rlimit control n))))
+    :hints(("Goal"
+            :in-theory (enable rw.crewrite-take-step
+                               rw.ccstep->result-goal
+                               rw.ccstep->original-goal
+                               rw.ccstep->t1prime
+                               rw.ccstep->provedp)
+            :do-not-induct t)))
+
+  (%autoprove lemma-for-forcing-rw.ccstep-list->compatiblep-of-rw.crewrite-clause-aux
+              (%enable default
+                       rw.crewrite-take-step
+                       rw.ccstep->result-goal
+                       rw.ccstep->original-goal
+                       rw.ccstep->t1prime
+                       rw.ccstep->provedp))
+
+  (%autoprove forcing-rw.ccstep-list->compatiblep-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux)
+              (%enable default lemma-for-forcing-rw.ccstep-list->compatiblep-of-rw.crewrite-clause-aux)
+              (%restrict default rw.ccstep-list->compatiblep
+                         (equal x '(CONS (RW.CREWRITE-TAKE-STEP TODO DONE BLIMIT RLIMIT CONTROL N) ACC))))
+
+  (%autoprove forcing-rw.ccstep-list->original-goal-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux)
+              (%restrict default rw.ccstep-list->original-goal
+                         (memberp x '(acc
+                                      (CONS (RW.CREWRITE-TAKE-STEP TODO DONE BLIMIT RLIMIT CONTROL N) ACC))))
+              (%restrict default rw.crewrite-clause-aux (equal todo '(cdr todo))))
+
+  (%autoprove consp-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux)
+              (%restrict default rw.crewrite-clause-aux (memberp todo '(todo (cdr todo)))))
+
+
+  (defthmd lemma-for-forcing-rw.ccstep->terminalp-of-car-of-rw.crewrite-clause-aux
+    ;; BOZO unlocalize
+    (implies (force (and (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)))
+             (iff (rw.hypbox->left (rw.ccstep->hypbox (rw.crewrite-take-step todo done blimit rlimit control n)))
+                  (consp (cdr todo))))
+    :hints(("Goal" :in-theory (enable rw.crewrite-take-step))))
+
+  (%autoprove lemma-for-forcing-rw.ccstep->terminalp-of-car-of-rw.crewrite-clause-aux
+              (%enable default rw.crewrite-take-step))
+
+  (%autoprove forcing-rw.ccstep->terminalp-of-car-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux)
+              (%enable default
+                       rw.ccstep->terminalp
+                       rw.ccstep->provedp
+                       ;; BOZO i don't think we need this:
+                       lemma-for-forcing-rw.ccstep->terminalp-of-car-of-rw.crewrite-clause-aux)
+              (%restrict default rw.crewrite-clause-aux (memberp todo '(todo (cdr todo)))))
+
+  (%autoprove forcing-rw.eqtrace-list-atblp-of-rw.ccstep-list-gather-contradictions-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux)
+              (%restrict default rw.crewrite-clause-aux (memberp todo '(todo (cdr todo)))))
+
+  (%autoprove forcing-logic.term-list-atblp-of-rw.ccstep-list-terms-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux)
+              (%restrict default rw.crewrite-clause-aux (memberp todo '(todo (cdr todo)))))
+
+  (%autoprove forcing-rw.hypbox-list-atblp-of-rw.ccstep-list-hypboxes-of-rw.crewrite-clause-aux
+              (%autoinduct rw.crewrite-clause-aux)
+              (%restrict default rw.crewrite-clause-aux (memberp todo '(todo (cdr todo))))))
+
+
+
+(defsection rw.crewrite-clause
+
+  (%autoadmit rw.crewrite-clause)
+
+  (local (%enable default rw.crewrite-clause))
+
+  (%autoprove forcing-rw.ccstep-listp-of-rw.crewrite-clause)
+  (%autoprove forcing-rw.ccstep-listp-of-rw.crewrite-clause-free)
+  (%autoprove forcing-rw.trace-list-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause)
+  (%autoprove forcing-rw.trace-list-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-free)
+  (%autoprove forcing-rw.trace-list-atblp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause)
+  (%autoprove forcing-rw.trace-list-atblp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-free)
+  (%autoprove forcing-rw.trace-list-env-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause)
+  (%autoprove forcing-rw.trace-list-env-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-free)
+  (%autoprove forcing-rw.ccstep-list->compatiblep-of-rw.crewrite-clause)
+
+  (defthmd lemma-for-forcing-rw.ccstep-list->original-goal-of-rw.crewrite-clause
+    ;; BOZO unlocalize
+    (implies (force (and (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)))
+             (equal (rw.ccstep->original-goal (rw.crewrite-take-step clause nil blimit rlimit control n))
+                    (clause.clause-formula clause)))
+    :hints(("Goal" :in-theory (enable rw.ccstep->original-goal
+                                      rw.crewrite-take-step))))
+
+  (%autoprove lemma-for-forcing-rw.ccstep-list->original-goal-of-rw.crewrite-clause
+              (%enable default rw.ccstep->original-goal rw.crewrite-take-step))
+
+  (%autoprove forcing-rw.ccstep-list->original-goal-of-rw.crewrite-clause
+              (%enable default lemma-for-forcing-rw.ccstep-list->original-goal-of-rw.crewrite-clause))
+
+  (%autoprove forcing-consp-of-rw.crewrite-clause)
+  ;; BOZO ACL2 uses "lemma2" here which we don't seem to need
+  (%autoprove forcing-rw.ccstep->result-goal-of-car-of-cdr-of-rw.crewrite-clause)
+  (%autoprove forcing-rw.ccstep->terminalp-of-car-of-rw.crewrite-clause)
+  (%autoprove forcing-rw.eqtrace-list-atblp-of-rw.ccstep-list-gather-contradictions-of-rw.crewrite-clause)
+  (%autoprove forcing-logic.term-list-atblp-of-rw.ccstep-list-terms-of-rw.crewrite-clause)
+  (%autoprove forcing-rw.hypbox-list-atblp-of-rw.ccstep-list-hypboxes-of-rw.crewrite-clause))
+
+
+
+
+(defsection rw.crewrite-clause-bldr
+  (%autoadmit rw.crewrite-clause-bldr)
+  (local (%enable default rw.crewrite-clause-bldr))
+  (%autoprove forcing-logic.appealp-of-rw.crewrite-clause-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.crewrite-clause-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.crewrite-clause-bldr))
+
+
+
+(%defprojection :list (rw.crewrite-clause-list x blimit rlimit control n)
+                :element (rw.crewrite-clause x blimit rlimit control n))
+
+(%autoprove forcing-cons-listp-of-rw.crewrite-clause-list
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.ccstep-list-listp-of-rw.crewrite-clause-list
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.ccstep-list-listp-of-rw.crewrite-clause-list-free)
+
+(%autoprove forcing-rw.trace-list-atblp-of-rw.ccstep-list-list-gather-traces-of-rw.crewrite-clause-list
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.trace-list-atblp-of-rw.ccstep-list-list-gather-traces-of-rw.crewrite-clause-list-free)
+
+
+
+
+(%autoadmit rw.ccstep-list-list-terminalp)
+
+(%autoprove rw.ccstep-list-list-terminalp-when-not-consp
+            (%restrict default rw.ccstep-list-list-terminalp (equal x 'x)))
+
+(%autoprove rw.ccstep-list-list-terminalp-of-cons
+            (%restrict default rw.ccstep-list-list-terminalp (equal x '(cons a x))))
+
+(%autoprove rw.ccstep-list-list-terminalp-of-rw.crewrite-clause-list
+            (%cdr-induction x))
+
+
+
+(%autoadmit rw.ccstep-list-list-obligations)
+
+(%autoprove true-listp-of-rw.ccstep-list-list-obligations
+            (%autoinduct rw.ccstep-list-list-obligations)
+            (%restrict default rw.ccstep-list-list-obligations (equal x 'x)))
+
+(%autoprove forcing-cons-listp-of-rw.ccstep-list-list-obligations
+            (%autoinduct rw.ccstep-list-list-obligations)
+            (%restrict default rw.ccstep-list-list-obligations (equal x 'x)))
+
+(%autoprove forcing-logic.term-list-listp-of-rw.ccstep-list-list-obligations
+            (%autoinduct rw.ccstep-list-list-obligations)
+            (%restrict default rw.ccstep-list-list-obligations (equal x 'x)))
+
+(%autoprove forcing-logic.term-list-listp-of-rw.ccstep-list-list-obligations-free)
+
+
+
+
+(defsection rw.crewrite-clause-list-bldr
+
+  (%autoadmit rw.crewrite-clause-list-bldr)
+
+  (local (%restrict default rw.crewrite-clause-list-bldr (equal clauses 'clauses)))
+
+  (local (%restrict default rw.ccstep-list-list-obligations
+                    (equal x '(RW.CREWRITE-CLAUSE-LIST CLAUSES BLIMIT RLIMIT CONTROL N))))
+
+  (local (%disable default
+                   expensive-term/formula-inference
+                   unusual-subsetp-rules
+                   unusual-memberp-rules
+                   unusual-consp-rules
+                   formula-decomposition
+                   expensive-arithmetic-rules
+                   expensive-arithmetic-rules-two
+                   same-length-prefixes-equal-cheap
+                   type-set-like-rules))
+
+  (%autoprove forcing-logic.appeal-listp-of-rw.crewrite-clause-list-bldr
+              (%autoinduct rw.crewrite-clause-list-bldr))
+
+  (%autoprove forcing-logic.strip-conclusions-of-rw.crewrite-clause-list-bldr
+              (%autoinduct rw.crewrite-clause-list-bldr))
+
+  (%autoprove forcing-logic.proof-listp-of-rw.crewrite-clause-list-bldr
+              (%autoinduct rw.crewrite-clause-list-bldr)
+              (%disable default
+                        memberp-when-not-consp
+                        memberp-when-memberp-of-cdr
+                        subsetp-transitive-two)))
+
+
+
+(%autoadmit rw.crewrite-records-show-progressp)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-hypbox.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-hypbox.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-hypbox.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-hypbox.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,285 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-tracep")
+(local (include-book "crewrite-local-settings"))
+(%interactive)
+
+(local (%max-proof-size 0))
+(local (%quiet t))
+
+(%autoprove lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+            (%disable default
+                      consp-when-consp-of-cdr-cheap
+                      forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+                      logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep)
+
+            (%forcingp nil)
+            (%liftlimit 10)
+            (%splitlimit 2)
+            (%betamode nil)
+            (%waterfall default 400)
+
+            (%betamode t)
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+
+            (%waterfall default 400)
+
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.crewrite-core-list-when-not-consp
+                      rw.crewrite-relieve-hyps-when-not-consp
+                      rw.crewrite-try-matches-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp
+                      minus-when-not-less
+                      minus-when-zp-right-cheap
+                      minus-when-zp-left-cheap
+                      logic.termp-when-not-consp-cheap
+                      logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+                      forcing-logic.lambda-actuals-of-logic.substitute
+                      forcing-logic.function-args-of-logic.substitute)
+
+;; old size: crewrite-hypbox.pcert.out:;; Proof size: 8,737,412,836 conses.
+;; trying with new trick: 4,615,160,904 conses. great!
+            (%betamode t)
+            (%crewrite default)
+
+            (%waterfall default 400)
+
+            (%enable default
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min
+                     logic.termp-when-invalid-maybe-expensive)
+
+            (%disable default
+                      squeeze-law-one
+                      squeeze-law-two
+                      squeeze-law-three
+                      minus-when-not-less
+                      not-equal-when-less
+                      |a <= b, c != 0 --> a < b+c|
+                      one-plus-trick
+                      |a <= b, c != 0 --> a < c+b|
+                      nfix-when-zp-cheap
+                      nfix-when-not-natp-cheap
+                      zp-when-not-natp-cheap
+                      natp-when-zp-cheap
+                      |a <= b, b <= c --> a < 1+c|
+                      equal-of-booleans-rewrite
+                      gather-constants-from-less-of-plus
+                      gather-constants-from-less-of-plus-two
+                      minus-when-zp-left-cheap
+                      minus-when-zp-right-cheap
+                      plus-when-zp-left-cheap
+                      plus-when-zp-right-cheap
+                      gather-constants-from-equal-of-plus
+                      equal-of-non-symbol-and-symbol-cheap
+                      equal-of-non-cons-and-cons-cheap
+                      equal-of-cons-and-non-cons-cheap
+                      equal-of-non-nat-and-nat-cheap
+                      equal-of-nat-and-non-nat-cheap
+                      equal-of-symbol-and-non-symbol-cheap)
+
+            (%waterfall default 400)
+            (%car-cdr-elim)
+            (%auto))
+
+(%autoprove forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-hypboxes-of-rw.cresult->data-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.trace-list-hypboxes-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove forcing-rw.cache-assmsp-of-rw.hyprseult->cache-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+
+
+
+
+
+
+#||
+
+old
+
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+
+            ;; Interlaced splitting and lightweight rewriting to control case explosion
+
+            (%quiet t)
+            (%betamode nil)
+            (%forcingp nil)
+            (%crewrite default)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 3 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+            (%quiet nil)
+
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+            (%betamode once)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+
+            (%crewrite default)
+            (%cleanup)
+
+            ;; This might look a little scary, but observe that no single goal is affected
+            ;; by more than one of these expansions.
+
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp)
+
+            (%crewrite default)
+
+            (%auto :strategy (split cleanup crewrite))
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min)
+
+            (%auto :strategy (split cleanup urewrite crewrite elim)))
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-iffp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-iffp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-iffp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-iffp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,410 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-tracep")
+(local (include-book "crewrite-local-settings"))
+(%interactive)
+
+
+; Original size: 2.47 b
+; Urewrite-focused size: 1.16 b
+; With rlimit hacking: 867 m
+; with crewrite-first: still 867 m
+
+(local (%max-proof-size 0))
+(local (%quiet t))
+
+(%autoprove lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core
+
+(%autoinduct rw.flag-crewrite)
+
+(%disable default
+          forcing-lookup-of-logic.function-name
+          forcing-lookup-of-logic.function-name-free
+          consp-when-consp-of-cdr-cheap
+          forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+          logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep)
+
+(%enable default
+         rw.trace-fast-image-equivalence-lemmas
+         special-disables-for-fast-pruning
+         splitters)
+
+(%urewrite default) ; 138
+(%cleanup) ; 124
+(%liftlimit 1)
+(%splitlimit 10)
+(%waterfall default 40 :strategy (split urewrite))
+(%cleanup)
+
+; Funny trick to only lightly use crewrite.  This way we get to prune some
+; goals while mainly relying upon assumptions, urewrite, and split, which
+; produce small proofs.
+
+(%forcingp nil)
+(%urwn 1000)
+(%blimit 0)
+(%rlimit 0)
+(%disable-loop-debugging)
+(%crewrite default)
+
+
+(%restrict default definition-of-rw.crewrite-core (equal x 'x))
+(%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+(%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+(%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+(%urewrite default)
+(%waterfall default 40 :strategy (split urewrite))
+(%cleanup)
+
+(%disable default ;; speed hint
+          minus-when-not-less
+          minus-when-zp-right-cheap
+          minus-when-zp-left-cheap
+          logic.termp-when-not-consp-cheap
+          logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+          forcing-logic.lambda-actuals-of-logic.substitute
+          forcing-logic.function-args-of-logic.substitute)
+
+(%blimit)
+(%rlimit)
+(%crewrite default)
+
+(%enable default
+         expensive-term/formula-inference
+         formula-decomposition
+         rw.crewrite-try-rules-when-not-consp
+         rw.tracep-when-memberp-of-rw.trace-listp
+         expensive-arithmetic-rules
+         expensive-arithmetic-rules-two
+         type-set-like-rules
+         unusual-consp-rules
+         unusual-memberp-rules
+         unusual-subsetp-rules
+         min)
+
+(%disable default
+          squeeze-law-one
+          squeeze-law-two
+          squeeze-law-three
+          minus-when-not-less
+          not-equal-when-less
+          |a <= b, c != 0 --> a < b+c|
+          one-plus-trick
+          |a <= b, c != 0 --> a < c+b|
+          nfix-when-zp-cheap
+          nfix-when-not-natp-cheap
+          zp-when-not-natp-cheap
+          natp-when-zp-cheap
+          |a <= b, b <= c --> a < 1+c|
+          gather-constants-from-less-of-plus
+          gather-constants-from-less-of-plus-two
+          minus-when-zp-left-cheap
+          minus-when-zp-right-cheap
+          plus-when-zp-left-cheap
+          plus-when-zp-right-cheap
+          gather-constants-from-equal-of-plus
+          equal-of-non-symbol-and-symbol-cheap
+          equal-of-non-cons-and-cons-cheap
+          equal-of-cons-and-non-cons-cheap
+          equal-of-non-nat-and-nat-cheap
+          equal-of-nat-and-non-nat-cheap
+          equal-of-symbol-and-non-symbol-cheap)
+
+; trying auto now instead of waterfall, since maybe we get better forcing sharing out of crewrite-all?
+(%auto))
+
+
+(%autoprove forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-iffps-of-rw.cresult->data-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.trace-list-iffps-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+
+
+
+#||
+
+
+(local (%rwn 1000))
+
+
+;; ;; I think this has increased in size because level9 isn't doing anything anymore.
+;; ;; Worlds are all broken.  Maybe we can fix them, or maybe put back a urewrite that
+;; ;; uses the slow urewriter anyway.
+
+
+
+
+;; ;; The previous proof, below, has increased to 3 billion conses.
+;; ;; seems like this is bigger because level9 is no longer actually doing anything?
+;; ;; and hence this is effectively a level 8 proof?
+
+;; (%autorule lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core)
+;; (%quiet t)
+;; (%autoinduct rw.flag-crewrite)
+;; (%disable default
+;;           forcing-lookup-of-logic.function-name
+;;           forcing-lookup-of-logic.function-name-free)
+;; (%betamode nil)
+;; (%forcingp nil)
+;; (%crewrite default)
+
+;; ; Lifting a lot seems to lead to lots of goals being proven immediately.
+
+;; (%split :liftp t :liftlimit 10 :splitlimit 5) ;; 1180 goals
+;; (%crewrite default)
+
+;; (%split :liftp t :liftlimit 10 :splitlimit 5)
+;; (%cleanup) ;; 745 goals
+;; (%crewrite default) ;; 469
+
+;; (%split :liftp t :liftlimit nil :splitlimit nil) ;; 1538
+;; (%crewrite default) ;; 765
+
+;; (%betamode once)
+;; (%enable default
+;;          splitters
+;;          special-disables-for-fast-pruning)
+;; (%crewrite default)  ;; 538
+;; (%split :liftp t :liftlimit nil :splitlimit nil) ;; 1754
+;; (%crewrite default)
+;; (%split :liftp t :liftlimit nil :splitlimit nil) ;; 996
+
+;; (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+;; (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+;; (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+;; (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+;; (%disable default ;; speed hint
+;;                       rw.crewrite-try-rules-when-not-consp
+;;                       rw.tracep-when-memberp-of-rw.trace-listp)
+
+;; (%crewrite default)
+
+;; (%auto :strategy (split cleanup crewrite))
+
+;; (%enable default
+;;                      expensive-term/formula-inference
+;;                      formula-decomposition
+;;                      rw.crewrite-try-rules-when-not-consp
+;;                      rw.tracep-when-memberp-of-rw.trace-listp
+;;                      expensive-arithmetic-rules
+;;                      expensive-arithmetic-rules-two
+;;                      type-set-like-rules
+;;                      unusual-consp-rules
+;;                      unusual-memberp-rules
+;;                      unusual-subsetp-rules
+;;                      min)
+
+;; (%auto :strategy (split cleanup urewrite crewrite elim))
+
+;; (%qed)
+
+
+
+
+;; ;;; --------------------
+
+
+
+
+
+;; (%split :liftp t :liftlimit 5 :splitlimit 5)
+
+
+;; (%ngoals) ;; 1406
+;; (%cleanup)
+;; (%ngoals) ;; 1323
+;; (%crewrite default)
+;; (%ngoals)
+;; (%cleanup)
+;; (%ngoals)
+;; (%split :liftp t :liftlimit nil :splitlimit nil)
+;; (%ngoals)
+;; (%crewrite default)
+;; (%cleanup)
+
+
+
+
+
+;;             (%betamode once)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 0 :splitlimit 0)
+
+;;             (%crewrite default)
+;;             (%cleanup)
+
+
+
+
+;; (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+;; (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+;; (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+;; (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+;; (%disable default ;; speed hint
+;;                       rw.crewrite-try-rules-when-not-consp
+;;                       rw.tracep-when-memberp-of-rw.trace-listp)
+
+;; (%crewrite default)
+
+;; (%auto :strategy (split cleanup crewrite))
+
+;; (%enable default
+;;                      expensive-term/formula-inference
+;;                      formula-decomposition
+;;                      rw.crewrite-try-rules-when-not-consp
+;;                      rw.tracep-when-memberp-of-rw.trace-listp
+;;                      expensive-arithmetic-rules
+;;                      expensive-arithmetic-rules-two
+;;                      type-set-like-rules
+;;                      unusual-consp-rules
+;;                      unusual-memberp-rules
+;;                      unusual-subsetp-rules
+;;                      min)
+
+;; (%auto :strategy (split cleanup urewrite crewrite elim)))
+
+
+
+;; old
+
+(%autoprove lemma-for-forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+
+            ;; Interlaced splitting and lightweight rewriting to control case explosion
+            (%quiet t)
+            (%betamode nil)
+            (%forcingp nil)
+            (%crewrite default)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 3 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+            (%quiet nil)
+
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+            (%betamode once)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+
+            (%crewrite default)
+            (%cleanup)
+
+            ;; This might look a little scary, but observe that no single goal is affected
+            ;; by more than one of these expansions.
+
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp)
+
+            (%crewrite default)
+
+            (%auto :strategy (split cleanup crewrite))
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min)
+
+            (%auto :strategy (split cleanup urewrite crewrite elim)))
+
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-lhs.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-lhs.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-lhs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-lhs.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,339 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-tracep")
+(local (include-book "crewrite-local-settings"))
+(%interactive)
+
+
+(local (%max-proof-size 0))
+(local (%quiet t))
+
+(%autoprove lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      ;; Maybe these cause some problems.
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+
+            (%disable default
+                      ;; The theory is already really tight, but there are a few things
+                      ;; we're missing, probably because we added the syntax evaluator
+                      ;; later on and who knows why for consp-when-consp-of-cdr-cheap.
+                      consp-when-consp-of-cdr-cheap
+                      forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+                      logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep)
+
+
+            ;; Phase 1.  Simplify the resulting induction goals before opening up the
+            ;; definitions.
+
+            (%forcingp nil)
+            (%liftlimit 10)
+            (%splitlimit 2)
+            (%betamode nil)
+            (%waterfall default 400)
+
+            (%betamode t)
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+
+            (%waterfall default 400)
+
+
+            ;; restrictions as before
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.crewrite-core-list-when-not-consp
+                      rw.crewrite-relieve-hyps-when-not-consp
+                      rw.crewrite-try-matches-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp
+                      minus-when-not-less
+                      minus-when-zp-right-cheap
+                      minus-when-zp-left-cheap
+                      logic.termp-when-not-consp-cheap
+                      logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+                      forcing-logic.lambda-actuals-of-logic.substitute
+                      forcing-logic.function-args-of-logic.substitute)
+
+;; old size to beat:
+;; crewrite-lhs.pcert.out:;; Proof size: 9,757,811,855 conses.
+;; trying new trick:;; Proof size: 5,816,777,976 conses.
+            (%betamode t)
+            (%crewrite default)
+
+            (%waterfall default 400)
+
+            (%enable default
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min
+                     logic.termp-when-invalid-maybe-expensive
+                     expensive-term/formula-inference
+                     formula-decomposition)
+
+            (%disable default
+                      squeeze-law-one
+                      squeeze-law-two
+                      squeeze-law-three
+                      minus-when-not-less
+                      not-equal-when-less
+                      |a <= b, c != 0 --> a < b+c|
+                      one-plus-trick
+                      |a <= b, c != 0 --> a < c+b|
+                      nfix-when-zp-cheap
+                      nfix-when-not-natp-cheap
+                      zp-when-not-natp-cheap
+                      natp-when-zp-cheap
+                      |a <= b, b <= c --> a < 1+c|
+                      equal-of-booleans-rewrite
+                      gather-constants-from-less-of-plus
+                      gather-constants-from-less-of-plus-two
+                      minus-when-zp-left-cheap
+                      minus-when-zp-right-cheap
+                      plus-when-zp-left-cheap
+                      plus-when-zp-right-cheap
+                      gather-constants-from-equal-of-plus
+                      equal-of-non-symbol-and-symbol-cheap
+                      equal-of-non-cons-and-cons-cheap
+                      equal-of-cons-and-non-cons-cheap
+                      equal-of-non-nat-and-nat-cheap
+                      equal-of-nat-and-non-nat-cheap
+                      equal-of-symbol-and-non-symbol-cheap
+
+                      AGGRESSIVE-EQUAL-OF-LOGIC.PNOTS
+                      AGGRESSIVE-EQUAL-OF-LOGIC.PORS
+                      AGGRESSIVE-EQUAL-OF-LOGIC.PEQUALS
+                      LOGIC.FMTYPE-WHEN-DEFINITIONP
+                      RW.CREWRITE-TRY-RULES-WHEN-NOT-CONSP
+                      LOGIC.GROUNDP-WHEN-LOGIC.CONSTANTP
+                      LOGIC.CONSTANTP-WHEN-LOGIC.VARIABLEP
+                      RW.TRACE-LIST-RHSES-WHEN-NOT-CONSP
+                      CONSP-OF-CDR-WHEN-LEN-TWO-CHEAP
+                      CONSP-WHEN-NATP-CHEAP
+                      LOGIC.CONSTANT-LISTP-WHEN-NOT-CONSP
+                      LOGIC.LAMBDAP-WHEN-CONSP-OF-CAR-CHEAP
+                      LOGIC.LAMBDAP-WHEN-NOT-OTHER-STUFF-CHEAP
+                      CONSP-WHEN-NOTHING-ELSE-CHEAP
+                      LOGIC.TERMP-WHEN-LOGIC.FORMULAP
+                      LOGIC.FUNCTIONP-WHEN-CLAUSE.NEGATIVE-TERMP
+                      FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                      LOGIC.TERMP-WHEN-LOGIC.CONSTANTP
+                      LOGIC.TERMP-WHEN-LOGIC.VARIABLEP)
+
+            (%waterfall default 400) ;; 272 secs
+
+            (%car-cdr-elim)
+            (%auto))
+
+
+(%autoprove forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-lhses-of-rw.cresult->data-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.trace-list-lhses-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove forcing-rw.cache-lhses-okp-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+
+
+
+(%autoprove forcing-rw.trace->rhs-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x)))
+
+(%autoprove forcing-rw.trace-list-rhses-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (%induct (rank x)
+                     ((not (consp x))
+                      nil)
+                     ((consp x)
+                      (((x (cdr x))
+                        (cache (rw.cresult->cache (rw.crewrite-relieve-hyp assms (car x) rule[s] sigma[s] cache
+                                                                           blimit rlimit anstack control)))))))
+            (%enable default splitters special-disables-for-fast-pruning))
+
+
+
+
+#||
+
+;; old
+
+(%autoprove lemma-for-forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core
+
+            (%quiet t)
+
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free
+                      equal-of-logic.function-rewrite
+                      equal-of-logic.function-rewrite-alt)
+
+            ;; Interlaced splitting and lightweight rewriting to control case explosion
+
+            (%betamode nil)
+            (%forcingp nil)
+            (%crewrite default)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 3 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+            (%quiet nil)
+
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+            (%betamode once)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+
+            (%crewrite default)
+            (%cleanup)
+
+            ;; This might look a little scary, but observe that no single goal is affected
+            ;; by more than one of these expansions.
+
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp)
+
+            (%crewrite default)
+
+            (%auto :strategy (split cleanup crewrite))
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min)
+
+            (%auto :strategy (split cleanup urewrite crewrite elim)))
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-local-settings.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-local-settings.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-local-settings.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-local-settings.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,194 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-start")
+(%interactive)
+
+
+;; ESSAY ON PROVING THEOREMS ABOUT CREWRITE.
+;;
+;; It is particularly difficult to prove theorems about crewrite because:
+;;
+;;   (1) the function itself is quite large and complicated, with 8
+;;       mutually-recursive flags and hundreds of lines of code;
+;;
+;;   (2) the induction scheme is correspondingly very complex; and
+;;
+;;   (3) each theorem we want to prove must have eight cases of its own in
+;;       order to address the various flags.
+;;
+;; This must be carefully managed to avoid a case explosion.  To handle this,
+;; we open each proof with a "light splitting, then light rewriting" approach.
+;; By "light rewriting", we mean:
+;;
+;;   (1) we rewrite with a cheap theory (so that rewriting is fast), and
+;;
+;;   (2) we do not use any splitting rules, beta reduction, or forcing (so that
+;;       we don't introduce more cases).
+;;
+;; The net effect is that many branches of the case-splitting tree are pruned
+;; early on instead of being explored.
+
+
+
+(%rwn 1000)
+
+
+
+(%cheapen default rw.trace-list-rhses-when-not-consp)
+;(%cheapen default rw.crewrite-core-list-when-not-consp)
+
+(%create-theory my-disables-for-extra-speed)
+(%enable my-disables-for-extra-speed
+         consp-when-memberp-of-logic.sigmap
+         consp-when-memberp-of-logic.sigmap-alt
+         consp-when-memberp-of-logic.sigma-atblp
+         consp-when-memberp-of-logic.sigma-atblp-alt
+         consp-when-memberp-of-logic.arity-tablep
+         consp-when-memberp-of-logic.arity-tablep-alt
+         ;;consp-when-memberp-of-logic.callmapp
+         ;;consp-when-memberp-of-logic.callmapp-alt
+         ;;consp-when-memberp-of-logic.callmap-atblp
+         ;;consp-when-memberp-of-logic.callmap-atblp-alt
+         consp-when-memberp-of-rw.cachemapp
+         consp-when-memberp-of-rw.cachemapp-alt
+         consp-when-memberp-of-none-consp
+         consp-when-memberp-of-none-consp-alt
+         consp-when-memberp-of-cons-listp
+         consp-when-memberp-of-cons-listp-alt
+         same-length-prefixes-equal-cheap
+         car-when-not-consp
+         cdr-when-not-consp
+         consp-when-natp-cheap
+         forcing-logic.groundp-of-logic.substitute
+         consp-when-logic.lambdap-cheap
+         consp-when-logic.functionp-cheap
+         consp-when-nonempty-subset-cheap
+         consp-when-memberp-cheap
+         logic.substitute-when-malformed-cheap
+         logic.constant-listp-when-not-consp
+         subsetp-when-not-consp
+         subsetp-when-not-consp-two
+         cons-listp-when-not-consp
+         none-consp-when-not-consp
+         forcing-logic.substitute-of-empty-sigma
+         not-equal-when-less
+         trichotomy-of-<
+         natp-of-len-free
+         transitivity-of-<
+         transitivity-of-<-three
+         transitivity-of-<-two
+         less-completion-left
+         less-of-one-right)
+(%disable default my-disables-for-extra-speed)
+
+(%disable default zp min)
+
+(%disable default
+          formula-decomposition
+          expensive-term/formula-inference
+          expensive-arithmetic-rules
+          expensive-arithmetic-rules-two
+          type-set-like-rules
+          unusual-consp-rules
+          unusual-memberp-rules
+          unusual-subsetp-rules
+          same-length-prefixes-equal-cheap
+          ;; ---
+          lookup-when-not-consp
+          rw.trace-list-rhses-when-not-consp
+          forcing-logic.function-of-logic.function-name-and-logic.function-args-free)
+
+(%disable default
+          logic.substitute-when-logic.lambdap-cheap
+          logic.substitute-when-logic.variablep
+          logic.substitute-when-logic.constantp
+          logic.substitute-when-logic.functionp-cheap
+          forcing-logic.substitute-list-of-empty-sigma
+          logic.substitute-list-when-not-consp
+          logic.substitute-list-of-cons-gross)
+
+
+;; SPECIAL THEORIES FOR THE OPENING MOVE.
+
+(%create-theory splitters)
+(%enable splitters
+         ;; These are all of the rules that introduce an "if" on the
+         ;; right-hand side (and hence may cause case splits).
+         (gather from default (not (clause.simple-termp rhs))))
+(%disable default splitters)
+
+
+(%create-theory special-disables-for-fast-pruning)
+(%enable special-disables-for-fast-pruning
+         ;; These are rules which %profile said were useless and
+         ;; expensive during the initial phase.  Disabling them helps to
+         ;; speed up the rewriting.
+         rw.trace-list-rhses-when-not-consp
+         logic.termp-when-not-consp-cheap
+         rank-when-not-consp
+         rw.trace-listp-when-not-consp
+         forcing-rw.assmsp-of-rw.assume-left
+         logic.term-listp-when-not-consp
+         ord<-when-naturals
+         logic.sigmap-when-not-consp
+         logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+         forcing-logic.term-listp-of-rw.trace-list-rhses
+         cdr-when-true-listp-with-len-free-past-the-end
+         forcing-logic.groundp-when-logic.constant-listp-of-logic.function-args
+         minus-when-zp-left-cheap
+         minus-when-zp-right-cheap
+         minus-when-not-less
+         forcing-logic.groundp-when-logic.constant-listp-of-logic.lambda-actuals
+         logic.variable-listp-of-cdr-when-logic.variable-listp
+         forcing-logic.termp-of-logic.substitute
+         logic.variablep-of-car-when-logic.variable-listp
+         rw.rule-listp-of-cdr-when-rw.rule-listp
+         cdr-of-cdr-when-true-listp-with-len-free-past-the-end
+         cdr-of-cdr-with-len-free-past-the-end
+         logic.groundp-when-logic.constantp
+         forcing-logic.function-args-of-logic.substitute
+         forcing-logic.lambda-actuals-of-logic.substitute
+         logic.constant-listp-of-cdr-when-logic.constant-listp
+         rw.typed-rulemapp-when-not-consp
+         memberp-when-not-consp ordp-when-natp
+         memberp-when-memberp-of-cdr
+         rw.rulep-of-car-when-rw.rule-listp
+         logic.sigmap-of-car-when-logic.sigma-listp
+         forcing-rw.cachep-of-rw.set-blockedp
+         logic.sigma-listp-of-cdr-when-logic.sigma-listp
+         )
+(%disable default special-disables-for-fast-pruning)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-start.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-start.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-start.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-start.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,308 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%rwn 1000)
+(%urwn 1000)
+
+(local (%max-proof-size 0))
+
+(%autoadmit four-nats-measure)
+
+(%autoprove ordp-of-four-nats-measure
+            (%enable default four-nats-measure)
+            (%restrict default ordp
+                       (memberp x '((CONS (CONS '3 (+ '1 A))
+                                          (CONS (CONS '2 (+ '1 B))
+                                                (CONS (CONS '1 (+ '1 C)) (NFIX D))))
+                                    (CONS (CONS '2 (+ '1 B))
+                                          (CONS (CONS '1 (+ '1 C)) (NFIX D)))
+                                    (CONS (CONS '1 (+ '1 C)) (NFIX D))))))
+
+(%autoprove ord<-of-four-nats-measure
+            (%enable default four-nats-measure)
+            (%restrict default ord<
+                       (memberp x '((CONS (CONS '3 (+ '1 A1))
+                                          (CONS (CONS '2 (+ '1 B1))
+                                                (CONS (CONS '1 (+ '1 C1)) (NFIX D1))))
+                                    (CONS (CONS '2 (+ '1 B1))
+                                          (CONS (CONS '1 (+ '1 C1)) (NFIX D1)))
+                                    (CONS (CONS '1 (+ '1 C1)) (NFIX D1))))))
+
+
+(defsection rw.cresult
+  (%autoadmit rw.cresult)
+  (%autoadmit rw.cresult->data)
+  (%autoadmit rw.cresult->cache)
+  (%autoadmit rw.cresult->alimitedp)
+
+  (local (%enable default
+                  rw.cresult
+                  rw.cresult->data
+                  rw.cresult->cache
+                  rw.cresult->alimitedp))
+
+  (%autoprove rw.cresult-under-iff)
+  (%autoprove rw.cresult->data-of-rw.cresult)
+  (%autoprove rw.cresult->cache-of-rw.cresult)
+  (%autoprove rw.cresult->alimitedp-of-rw.cresult))
+
+
+(defsection rw.hypresult
+  (%autoadmit rw.hypresult)
+  (%autoadmit rw.hypresult->successp)
+  (%autoadmit rw.hypresult->traces)
+  (%autoadmit rw.hypresult->cache)
+  (%autoadmit rw.hypresult->alimitedp)
+
+  (local (%enable default
+                  rw.hypresult
+                  rw.hypresult->successp
+                  rw.hypresult->traces
+                  rw.hypresult->cache
+                  rw.hypresult->alimitedp))
+
+  (%autoprove rw.hypresult-under-iff)
+  (%autoprove rw.hypresult->successp-of-rw.hypresult)
+  (%autoprove rw.hypresult->traces-of-rw.hypresult)
+  (%autoprove rw.hypresult->cache-of-rw.hypresult)
+  (%autoprove rw.hypresult->alimitedp-of-rw.hypresult))
+
+
+
+(%autoadmit rw.flag-crewrite)
+
+
+
+(defsection elimination-of-irrelevant-arguments
+
+  (local (%forcingp nil))
+  (local (%betamode nil))
+
+  (%autoprove rw.flag-crewrite-of-term-reduction
+              (%restrict default rw.flag-crewrite (and (equal flag ''term) (equal x 'x))))
+
+  (%autoprove rw.flag-crewrite-of-list-reduction
+              (%restrict default rw.flag-crewrite (and (equal flag ''list) (equal x 'x))))
+
+  (%autoprove rw.flag-crewrite-of-rule-reduction
+              (%restrict default rw.flag-crewrite (and (equal flag ''rule) (equal x 'x))))
+
+  (%autoprove rw.flag-crewrite-of-rules-reduction
+              (%restrict default rw.flag-crewrite (and (equal flag ''rules) (equal x 'x))))
+
+  (%autoprove rw.flag-crewrite-of-hyp-reduction
+              (%restrict default rw.flag-crewrite (and (equal flag ''hyp) (equal x 'x))))
+
+  (%autoprove rw.flag-crewrite-of-hyps-reduction
+              (%restrict default rw.flag-crewrite (and (equal flag ''hyps) (equal x 'x)))))
+
+
+
+(defsection flag-function-wrappers
+
+  (%autoadmit rw.crewrite-core)
+  (%autoadmit rw.crewrite-core-list)
+  (%autoadmit rw.crewrite-try-rule)
+  (%autoadmit rw.crewrite-try-rules)
+  (%autoadmit rw.crewrite-try-match)
+  (%autoadmit rw.crewrite-try-matches)
+  (%autoadmit rw.crewrite-relieve-hyp)
+  (%autoadmit rw.crewrite-relieve-hyps)
+
+  (local (%forcingp nil))
+  (local (%enable default
+                  rw.crewrite-core
+                  rw.crewrite-core-list
+                  rw.crewrite-try-rule
+                  rw.crewrite-try-rules
+                  rw.crewrite-try-match
+                  rw.crewrite-try-matches
+                  rw.crewrite-relieve-hyp
+                  rw.crewrite-relieve-hyps))
+
+  (%autoprove rw.flag-crewrite-of-term
+              (%use (%thm rw.flag-crewrite-of-term-reduction)))
+
+  (%autoprove rw.flag-crewrite-of-list
+              (%use (%thm rw.flag-crewrite-of-list-reduction)))
+
+  (%autoprove rw.flag-crewrite-of-rule
+              (%use (%thm rw.flag-crewrite-of-rule-reduction)))
+
+  (%autoprove rw.flag-crewrite-of-rules
+              (%use (%thm rw.flag-crewrite-of-rules-reduction)))
+
+  (%autoprove rw.flag-crewrite-of-match)
+  (%autoprove rw.flag-crewrite-of-matches)
+
+  (%autoprove rw.flag-crewrite-of-hyp
+              (%use (%thm rw.flag-crewrite-of-hyp-reduction)))
+
+  (%autoprove rw.flag-crewrite-of-hyps
+              (%use (%thm rw.flag-crewrite-of-hyps-reduction))))
+
+
+
+
+(%autoprove equal-with-quoted-list-of-nil)
+
+(defsection proper-definitions-for-flag-wrappers
+  (local (%forcingp nil))
+  (local (%rwn 2000))
+  (local (%disable default
+                   formula-decomposition
+                   expensive-term/formula-inference
+                   expensive-arithmetic-rules
+                   expensive-arithmetic-rules-two
+                   type-set-like-rules
+                   unusual-consp-rules
+                   unusual-memberp-rules
+                   unusual-subsetp-rules
+                   same-length-prefixes-equal-cheap
+                   ;; ---
+                   lookup-when-not-consp
+                   rw.trace-list-rhses-when-not-consp
+                   forcing-logic.function-of-logic.function-name-and-logic.function-args-free))
+
+  (%autoprove definition-of-rw.crewrite-core
+              (%use (%instance (%thm rw.flag-crewrite) (flag 'term)))
+              (%betamode nil)
+              (%auto)
+              (%betamode once))
+
+  (%autoprove definition-of-rw.crewrite-core-list
+              (%use (%instance (%thm rw.flag-crewrite) (flag 'list)))
+              (%betamode nil)
+              (%auto)
+              (%betamode once))
+
+  (%autoprove definition-of-rw.crewrite-try-rule
+              (%use (%instance (%thm rw.flag-crewrite) (flag 'rule)))
+              (%betamode nil)
+              (%auto)
+              (%betamode once))
+
+  (%autoprove definition-of-rw.crewrite-try-rules
+              (%use (%instance (%thm rw.flag-crewrite) (flag 'rules)))
+              (%betamode nil)
+              (%auto)
+              (%betamode once))
+
+  (%autoprove definition-of-rw.crewrite-try-match
+              (%use (%instance (%thm rw.flag-crewrite) (flag 'match)))
+              (%betamode nil)
+              (%auto)
+              (%betamode once))
+
+  (%autoprove definition-of-rw.crewrite-try-matches
+              (%use (%instance (%thm rw.flag-crewrite) (flag 'matches)))
+              (%betamode nil)
+              (%auto)
+              (%betamode once))
+
+  (%autoprove definition-of-rw.crewrite-relieve-hyp
+              (%use (%instance (%thm rw.flag-crewrite) (flag 'hyp)))
+              (%betamode nil)
+              (%auto)
+              (%betamode once))
+
+  (%autoprove definition-of-rw.crewrite-relieve-hyps
+              (%use (%instance (%thm rw.flag-crewrite) (flag 'hyps)))
+              (%betamode nil)
+              (%auto)
+              (%betamode once)))
+
+
+
+
+
+(%autoprove rw.crewrite-core-list-when-not-consp
+            (%restrict default definition-of-rw.crewrite-core-list (equal x 'x)))
+
+(%autoprove rw.crewrite-core-list-of-cons
+            (%restrict default definition-of-rw.crewrite-core-list (equal x '(cons a x))))
+
+(%autoprove true-listp-of-rw.cresult->data-of-rw.crewrite-core-list
+            (%induct (rank x)
+                     ((not (consp x))
+                      nil)
+                     ((consp x)
+                      (((x     (cdr x))
+                        (cache (rw.cresult->cache
+                                (rw.crewrite-core assms (car x) cache iffp blimit rlimit anstack control))))))))
+
+(%autoprove len-of-rw.cresult->data-of-rw.crewrite-core-list$
+            (%induct (rank x)
+                     ((not (consp x))
+                      nil)
+                     ((consp x)
+                      (((x     (cdr x))
+                        (cache (rw.cresult->cache
+                                (rw.crewrite-core assms (car x) cache iffp blimit rlimit anstack control))))))))
+
+
+
+
+(%autoprove rw.crewrite-try-rules-when-not-consp
+            (%restrict default definition-of-rw.crewrite-try-rules (equal rule[s] 'rule[s])))
+
+(%autoprove rw.crewrite-try-rules-of-cons
+            (%restrict default definition-of-rw.crewrite-try-rules (equal rule[s] '(cons rule rules))))
+
+
+
+(%autoprove rw.crewrite-try-matches-when-not-consp
+            (%restrict default definition-of-rw.crewrite-try-matches (equal sigma[s] 'sigma[s])))
+
+(%autoprove rw.crewrite-try-matches-of-cons
+            (%restrict default definition-of-rw.crewrite-try-matches (equal sigma[s] '(cons sigma sigmas))))
+
+
+
+(%autoprove rw.crewrite-relieve-hyps-when-not-consp
+            (%restrict default definition-of-rw.crewrite-relieve-hyps (equal x 'x)))
+
+(%autoprove rw.crewrite-relieve-hyps-of-cons
+            (%restrict default definition-of-rw.crewrite-relieve-hyps (equal x '(cons a x))))
+
+(%autoprove booleanp-of-rw.hypresult->successp-of-rw.crewrite-relieve-hyps
+            (%use (%thm definition-of-rw.crewrite-relieve-hyps)))
+
+
+
+(%autoprove zp-of-one-plus)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-trace-atblp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-trace-atblp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-trace-atblp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-trace-atblp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,312 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-tracep")
+(local (include-book "crewrite-local-settings"))
+(%interactive)
+
+
+(local (%max-proof-size 0))
+(local (%quiet t))
+
+(%autoprove lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core
+            (%autoinduct rw.flag-crewrite)
+
+            (%restrict default forcing-lookup-of-logic.function-name (equal atbl 'atbl))
+            (%restrict default forcing-lookup-of-logic.function-name-free (equal atbl 'atbl))
+
+
+            (%disable default
+                      ;; The theory is already really tight, but there are a few things
+                      ;; we're missing, probably because we added the syntax evaluator
+                      ;; later on and who knows why for consp-when-consp-of-cdr-cheap.
+                      consp-when-consp-of-cdr-cheap
+                      forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+                      logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep)
+
+
+            ;; Phase 1.  Simplify the resulting induction goals before opening up the
+            ;; definitions.
+
+            (%forcingp nil)
+            (%liftlimit 10)
+            (%splitlimit 2)
+            (%betamode nil)
+            (%waterfall default 400)
+
+            (%betamode t)
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+
+            (%waterfall default 400)
+
+
+            ;; restrictions as before
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.crewrite-core-list-when-not-consp
+                      rw.crewrite-relieve-hyps-when-not-consp
+                      rw.crewrite-try-matches-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp
+                      minus-when-not-less
+                      minus-when-zp-right-cheap
+                      minus-when-zp-left-cheap
+                      logic.termp-when-not-consp-cheap
+                      logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+                      forcing-logic.lambda-actuals-of-logic.substitute
+                      forcing-logic.function-args-of-logic.substitute)
+
+;; old size: crewrite-trace-atblp.pcert.out:;; Proof size: 8,515,629,064 conses.
+;; new trick: ;; Proof size: 4,604,904,097 conses.
+            (%betamode t)
+            (%crewrite default)
+
+            (%waterfall default 400)
+
+            (%enable default
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min
+                     logic.termp-when-invalid-maybe-expensive)
+
+            (%disable default
+                      squeeze-law-one
+                      squeeze-law-two
+                      squeeze-law-three
+                      minus-when-not-less
+                      not-equal-when-less
+                      |a <= b, c != 0 --> a < b+c|
+                      one-plus-trick
+                      |a <= b, c != 0 --> a < c+b|
+                      nfix-when-zp-cheap
+                      nfix-when-not-natp-cheap
+                      zp-when-not-natp-cheap
+                      natp-when-zp-cheap
+                      |a <= b, b <= c --> a < 1+c|
+                      equal-of-booleans-rewrite
+                      gather-constants-from-less-of-plus
+                      gather-constants-from-less-of-plus-two
+                      minus-when-zp-left-cheap
+                      minus-when-zp-right-cheap
+                      plus-when-zp-left-cheap
+                      plus-when-zp-right-cheap
+                      gather-constants-from-equal-of-plus
+                      equal-of-non-symbol-and-symbol-cheap
+                      equal-of-non-cons-and-cons-cheap
+                      equal-of-cons-and-non-cons-cheap
+                      equal-of-non-nat-and-nat-cheap
+                      equal-of-nat-and-non-nat-cheap
+                      equal-of-symbol-and-non-symbol-cheap)
+
+            (%waterfall default 400)
+            (%car-cdr-elim)
+            (%auto))
+
+(%autoprove forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-atblp-of-rw.cresult->data-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.cache-atblp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            ;; BOZO bad name. Shoulds say rw.cresult->cache instead of data
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.trace-list-atblp-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove forcing-rw.cache-atblp-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+
+
+
+
+
+
+#||
+
+old
+
+(%autoprove lemma-for-forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core
+
+            (%quiet t)
+
+            (%autoinduct rw.flag-crewrite)
+
+            (%restrict default forcing-lookup-of-logic.function-name (equal atbl 'atbl))
+            (%restrict default forcing-lookup-of-logic.function-name-free (equal atbl 'atbl))
+
+            ;; Interlaced splitting and lightweight rewriting to control case explosion
+
+            (%betamode nil)
+            (%forcingp nil)
+            (%crewrite default)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 3 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+            (%quiet nil)
+
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+            (%betamode once)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+
+            (%crewrite default)
+            (%cleanup)
+
+            ;; This might look a little scary, but observe that no single goal is affected
+            ;; by more than one of these expansions.
+
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp)
+
+            (%crewrite default)
+
+            (%auto :strategy (split cleanup crewrite))
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min)
+
+            (%auto :strategy (split cleanup urewrite crewrite elim)))
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-trace-env-okp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-trace-env-okp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-trace-env-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-trace-env-okp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,312 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-trace-atblp")
+(local (include-book "crewrite-local-settings"))
+(%interactive)
+
+(local (%max-proof-size 0))
+(local (%quiet t))
+
+(%autoprove lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core
+            (%autoinduct rw.flag-crewrite)
+            (%restrict default forcing-lookup-of-logic.function-name (equal atbl 'atbl))
+            (%restrict default forcing-lookup-of-logic.function-name-free (equal atbl 'atbl))
+
+            (%disable default
+                      ;; The theory is already really tight, but there are a few things
+                      ;; we're missing, probably because we added the syntax evaluator
+                      ;; later on and who knows why for consp-when-consp-of-cdr-cheap.
+                      consp-when-consp-of-cdr-cheap
+                      forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+                      logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep)
+
+
+            ;; Phase 1.  Simplify the resulting induction goals before opening up the
+            ;; definitions.
+
+            (%forcingp nil)
+            (%liftlimit 10)
+            (%splitlimit 2)
+            (%betamode nil)
+            (%waterfall default 400)  ;; 3214 seconds
+
+            (%betamode t)
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+
+            (%waterfall default 400) ;; 1491 seconds
+
+
+            ;; restrictions as before
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.crewrite-core-list-when-not-consp
+                      rw.crewrite-relieve-hyps-when-not-consp
+                      rw.crewrite-try-matches-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp
+                      minus-when-not-less
+                      minus-when-zp-right-cheap
+                      minus-when-zp-left-cheap
+                      logic.termp-when-not-consp-cheap
+                      logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+                      forcing-logic.lambda-actuals-of-logic.substitute
+                      forcing-logic.function-args-of-logic.substitute)
+
+;; old size: crewrite-trace-env-okp.pcert.out:;; Proof size: 9,946,713,505 conses.
+;; new trick: ;; Proof size: 6,641,263,939 conses.
+            (%betamode t)
+            (%crewrite default)
+
+            (%waterfall default 400) ;; 355 seconds
+
+            (%enable default
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min
+                     logic.termp-when-invalid-maybe-expensive)
+
+            (%disable default
+                      squeeze-law-one
+                      squeeze-law-two
+                      squeeze-law-three
+                      minus-when-not-less
+                      not-equal-when-less
+                      |a <= b, c != 0 --> a < b+c|
+                      one-plus-trick
+                      |a <= b, c != 0 --> a < c+b|
+                      nfix-when-zp-cheap
+                      nfix-when-not-natp-cheap
+                      zp-when-not-natp-cheap
+                      natp-when-zp-cheap
+                      |a <= b, b <= c --> a < 1+c|
+                      equal-of-booleans-rewrite
+                      gather-constants-from-less-of-plus
+                      gather-constants-from-less-of-plus-two
+                      minus-when-zp-left-cheap
+                      minus-when-zp-right-cheap
+                      plus-when-zp-left-cheap
+                      plus-when-zp-right-cheap
+                      gather-constants-from-equal-of-plus
+                      equal-of-non-symbol-and-symbol-cheap
+                      equal-of-non-cons-and-cons-cheap
+                      equal-of-cons-and-non-cons-cheap
+                      equal-of-non-nat-and-nat-cheap
+                      equal-of-nat-and-non-nat-cheap
+                      equal-of-symbol-and-non-symbol-cheap)
+
+            (%waterfall default 400) ;; 155 seconds
+            (%car-cdr-elim)
+            (%auto))
+
+(%autoprove forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-env-okp-of-rw.cresult->data-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.trace-list-env-okp-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove forcing-rw.cache-env-okp-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+
+
+
+
+
+
+#||
+
+Old approach
+
+(%autoprove lemma-for-forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core
+
+            (%autoinduct rw.flag-crewrite)
+
+            (%restrict default forcing-lookup-of-logic.function-name (equal atbl 'atbl))
+            (%restrict default forcing-lookup-of-logic.function-name-free (equal atbl 'atbl))
+
+            ;; Interlaced splitting and lightweight rewriting to control case explosion
+
+            (%betamode nil)
+            (%forcingp nil)
+            (%crewrite default)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 3 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+            (%quiet nil)
+
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+            (%betamode once)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+            (%crewrite default)
+            (%cleanup)
+
+            ;; This might look a little scary, but observe that no single goal is affected
+            ;; by more than one of these expansions.
+
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp)
+
+            (%crewrite default)
+
+            (%auto :strategy (split cleanup crewrite))
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min)
+
+            (%auto :strategy (split cleanup urewrite crewrite elim)))
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-trace-okp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-trace-okp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-trace-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-trace-okp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,457 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-iffp")
+(include-book "crewrite-hypbox")
+(include-book "crewrite-lhs")
+(local (include-book "crewrite-local-settings"))
+(%interactive)
+
+
+;; An ugly hack.
+;;
+;; Our free-variable matching doesn't work quite like ACL2's on certain "lousy"
+;; rewrite rules like forcing-rw.trace->hypbox-of-rw.cache-lookup, shown here:
+;;
+;; (IMPLIES (FORCE (AND (RW.CACHE-LOOKUP TERM IFFP CACHE)
+;;                      (LOGIC.TERMP TERM)
+;;                      (RW.CACHEP CACHE)
+;;                      (BOOLEANP IFFP)
+;;                      (RW.CACHE-ASSMSP CACHE ASSMS)))
+;;          (EQUAL (RW.TRACE->HYPBOX (RW.CACHE-LOOKUP TERM IFFP CACHE))
+;;                 (RW.ASSMS->HYPBOX ASSMS)))
+;;
+;; In the Milawa world, this rule is insufficient for our main theorem because
+;; the "cache" position is inhabited by a complicated term of the form:
+;;
+;;     (RW.CRESULT->CACHE (RW.CREWRITE-CORE-LIST ... cache ...))
+;;
+;; This leads our free-variable matching code to search for an assumption of the
+;; form:
+;;
+;;     (rw.cache-assmsp (RW.CRESULT->CACHE (RW.CREWRITE-CORE-LIST ... cache ...))
+;;                      assms)
+;;
+;; But the only reasonably close assumption we have around is instead:
+;;
+;;     (rw.cache-assmsp cache assms)
+;;
+;; Which does not match.  Somehow, miraculously, in the ACL2 world this works.
+;; But rather than try to fix our free variable matching code to handle such a
+;; strange situation, we just prove the following, ugly rule:
+
+(defthmd lemma-2-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core
+  (implies (force (and (rw.cache-lookup term iffp1
+                                        (rw.cresult->cache
+                                         (rw.crewrite-core-list assms args cache iffp2 blimit rlimit anstack control)))
+                       (rw.cache-assmsp cache assms)
+                       (logic.termp term)
+                       (logic.term-listp args)
+                       (rw.cachep cache)
+                       (booleanp iffp1)
+                       (booleanp iffp2)
+                       (rw.assmsp assms)
+                       (rw.controlp control)))
+           (equal (rw.trace->hypbox
+                   (rw.cache-lookup term iffp1
+                                    (rw.cresult->cache
+                                     (rw.crewrite-core-list assms args cache iffp2 blimit rlimit anstack control))))
+                  (rw.assms->hypbox assms)))
+  :hints(("Goal"
+          :in-theory (disable forcing-rw.trace->hypbox-of-rw.cache-lookup
+                              forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-core-list)
+          :use ((:instance forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-core-list
+                           (x args)
+                           (iffp iffp2))
+                (:instance forcing-rw.trace->hypbox-of-rw.cache-lookup
+                           (term term)
+                           (iffp iffp1)
+                           (cache (rw.cresult->cache (rw.crewrite-core-list assms args
+                                                                            cache iffp2
+                                                                            blimit rlimit anstack control)))
+                           (assms assms))))))
+
+(%autoprove lemma-2-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core
+            (%disable default
+                      forcing-rw.trace->hypbox-of-rw.cache-lookup
+                      forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-core-list)
+            (%use (%instance (%thm forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-core-list)
+                             (x args)
+                             (iffp iffp2)))
+            (%use (%instance (%thm forcing-rw.trace->hypbox-of-rw.cache-lookup)
+                             (term term)
+                             (iffp iffp1)
+                             (cache (rw.cresult->cache (rw.crewrite-core-list assms args
+                                                                              cache iffp2
+                                                                              blimit rlimit anstack control)))
+                             (assms assms))))
+
+
+(local (%max-proof-size 0))
+(local (%quiet t))
+
+(%autoprove lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core
+
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      ;; Maybe these cause some problems.
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+
+            (%disable default
+                      ;; The theory is already really tight, but there are a few things
+                      ;; we're missing, probably because we added the syntax evaluator
+                      ;; later on and who knows why for consp-when-consp-of-cdr-cheap.
+                      consp-when-consp-of-cdr-cheap
+                      forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+                      logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep)
+
+
+            ;; Phase 1.  Simplify the resulting induction goals before opening up the
+            ;; definitions.
+
+            (%forcingp nil)
+            (%liftlimit 10)
+            (%splitlimit 2)
+            (%betamode nil)
+            (%waterfall default 400) ;; 1657 seconds
+
+            (%betamode t)
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+
+            (%waterfall default 400) ;; 1178 seconds
+
+
+            ;; restrictions as before
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%enable default lemma-2-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.crewrite-core-list-when-not-consp
+                      rw.crewrite-relieve-hyps-when-not-consp
+                      rw.crewrite-try-matches-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp
+                      minus-when-not-less
+                      minus-when-zp-right-cheap
+                      minus-when-zp-left-cheap
+                      logic.termp-when-not-consp-cheap
+                      logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+                      forcing-logic.lambda-actuals-of-logic.substitute
+                      forcing-logic.function-args-of-logic.substitute)
+
+;; old size: rewrite-trace-okp.pcert.out:;; Proof size: 19,636,580,041 conses.
+;; new trick:  Proof size: 6,553,523,402 conses.
+            (%betamode t)
+            (%crewrite default)
+
+            (%waterfall default 400) ;; 388 sec
+
+            (%enable default
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min
+                     logic.termp-when-invalid-maybe-expensive)
+
+            (%disable default
+                      squeeze-law-one
+                      squeeze-law-two
+                      squeeze-law-three
+                      minus-when-not-less
+                      not-equal-when-less
+                      |a <= b, c != 0 --> a < b+c|
+                      one-plus-trick
+                      |a <= b, c != 0 --> a < c+b|
+                      nfix-when-zp-cheap
+                      nfix-when-not-natp-cheap
+                      zp-when-not-natp-cheap
+                      natp-when-zp-cheap
+                      |a <= b, b <= c --> a < 1+c|
+                      equal-of-booleans-rewrite
+                      gather-constants-from-less-of-plus
+                      gather-constants-from-less-of-plus-two
+                      minus-when-zp-left-cheap
+                      minus-when-zp-right-cheap
+                      plus-when-zp-left-cheap
+                      plus-when-zp-right-cheap
+                      gather-constants-from-equal-of-plus
+                      equal-of-non-symbol-and-symbol-cheap
+                      equal-of-non-cons-and-cons-cheap
+                      equal-of-cons-and-non-cons-cheap
+                      equal-of-non-nat-and-nat-cheap
+                      equal-of-nat-and-non-nat-cheap
+                      equal-of-symbol-and-non-symbol-cheap)
+
+            (%waterfall default 400) ;; 207 seconds
+            (%car-cdr-elim)
+
+            (%forcingp t)
+            (%auto))
+
+
+
+
+
+
+(%autoprove forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-okp-of-rw.cresult->data-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.trace-list-okp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyps
+            ;; BOZO bad name.  Should say hypresult->traces
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove forcing-rw.cache-traces-okp-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+
+
+
+
+
+#||
+
+old
+
+(%autoprove lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core
+
+            (%quiet t)
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free
+                      equal-of-logic.function-rewrite
+                      equal-of-logic.function-rewrite-alt)
+            (%betamode nil)
+            (%forcingp nil)
+            (%liftlimit 2)
+            (%splitlimit 2)
+            (%waterfall default 400)
+
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+            (%betamode once)
+            (%waterfall default 400)
+
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp)
+
+            (%enable default lemma-2-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+
+            (%waterfall default 400)
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min)
+
+            (%auto :strategy (split cleanup urewrite crewrite elim))
+
+            (%forcingp t)
+            (%auto))
+
+||#
+
+
+
+
+
+;; (%autoprove lemma-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core
+
+;;             (%quiet t)
+
+;;             (%autoinduct rw.flag-crewrite)
+;;             (%disable default
+;;                       forcing-lookup-of-logic.function-name
+;;                       forcing-lookup-of-logic.function-name-free
+;;                       equal-of-logic.function-rewrite
+;;                       equal-of-logic.function-rewrite-alt)
+
+;;             ;; Interlaced splitting and lightweight rewriting to control case explosion
+
+;;             (%betamode nil)
+;;             (%forcingp nil)
+;;             (%crewrite default)
+;;             (%split :liftp t :liftlimit 1 :splitlimit 25)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 1 :splitlimit 25)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 1 :splitlimit 25)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 1 :splitlimit 25)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 1 :splitlimit 25)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 1 :splitlimit 25)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 1 :splitlimit 25)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 3 :splitlimit 25)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 0 :splitlimit 0)
+;;             (%quiet nil)
+
+;;             (%enable default
+;;                      splitters
+;;                      special-disables-for-fast-pruning)
+;;             (%betamode once)
+;;             (%crewrite default)
+;;             (%cleanup)
+;;             (%split :liftp t :liftlimit 0 :splitlimit 0)
+
+;;             (%crewrite default)
+;;             (%cleanup)
+
+;;             ;; This might look a little scary, but observe that no single goal is affected
+;;             ;; by more than one of these expansions.
+
+;;             (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+;;             (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+;;             (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+;;             (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+;;             (%disable default ;; speed hint
+;;                       rw.crewrite-try-rules-when-not-consp
+;;                       rw.tracep-when-memberp-of-rw.trace-listp)
+
+;;             (%enable default lemma-2-for-forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core)
+
+;;             (%crewrite default)
+
+;;             (%auto :strategy (split cleanup crewrite))
+
+;;             (%enable default
+;;                      expensive-term/formula-inference
+;;                      formula-decomposition
+;;                      rw.crewrite-try-rules-when-not-consp
+;;                      rw.tracep-when-memberp-of-rw.trace-listp
+;;                      expensive-arithmetic-rules
+;;                      expensive-arithmetic-rules-two
+;;                      type-set-like-rules
+;;                      unusual-consp-rules
+;;                      unusual-memberp-rules
+;;                      unusual-subsetp-rules
+;;                      min)
+
+;;             (%auto :strategy (split cleanup urewrite crewrite elim)))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-tracep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-tracep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-tracep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-tracep.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,363 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-start")
+(local (include-book "crewrite-local-settings"))
+(%interactive)
+
+
+(local (%max-proof-size 0))
+(local (%quiet t))
+
+(%autoprove lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core
+
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      ;; Maybe these cause some problems.
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+
+            (%disable default
+                      ;; The theory is already really tight, but there are a few things
+                      ;; we're missing, probably because we added the syntax evaluator
+                      ;; later on and who knows why for consp-when-consp-of-cdr-cheap.
+                      consp-when-consp-of-cdr-cheap
+                      forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+                      logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep)
+
+
+            ;; Phase 1.  Simplify the resulting induction goals before opening up the
+            ;; definitions.
+
+            (%forcingp
+             ;; seems like a good idea until goals have settled down
+             nil)
+
+            (%liftlimit
+             ;; probably not ideal, but this was a good number for fast-image
+             10)
+
+            (%splitlimit
+             ;; probably not ideal, but this was a good number for fast-image
+             2)
+
+            (%betamode
+             ;; With betamode nil, the initial waterfall takes 769 seconds and produces 988
+             ;; goals.  If we subsequently set betamode=t and enable the splitters and the
+             ;; fast-pruning disables, finishing the settling down takes 759 seconds and we
+             ;; are left with 806 goals.  So, betamode nil gives a total phase1 time of
+             ;; 1528 seconds.
+             ;;
+             ;; Alternately, we can set betamode t from the beginning.  This increases the
+             ;; time of this initial waterfall pass to 1770 seconds, so clearly we want to
+             ;; stop beta reduction from happening, initially.
+             nil)
+
+            (%waterfall default 400)
+
+            (%betamode t)
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+
+            ;; with betamode t, 759 seconds, 806 goals remain
+            (%waterfall default 400)
+
+
+            ;; restrictions as before
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.crewrite-core-list-when-not-consp
+                      rw.crewrite-relieve-hyps-when-not-consp
+                      rw.crewrite-try-matches-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp
+                      minus-when-not-less
+                      minus-when-zp-right-cheap
+                      minus-when-zp-left-cheap
+                      logic.termp-when-not-consp-cheap
+                      logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+                      forcing-logic.lambda-actuals-of-logic.substitute
+                      forcing-logic.function-args-of-logic.substitute)
+
+;; old size: crewrite-tracep.pcert.out:;; Proof size: 8,560,621,231 conses.
+;; new trick: ;; Proof size: 4,254,244,542 conses.
+            (%betamode t)
+            (%crewrite default)
+
+            (%waterfall default 400)
+
+            (%enable default
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min
+                     logic.termp-when-invalid-maybe-expensive)
+
+            (%disable default
+                      squeeze-law-one
+                      squeeze-law-two
+                      squeeze-law-three
+                      minus-when-not-less
+                      not-equal-when-less
+                      |a <= b, c != 0 --> a < b+c|
+                      one-plus-trick
+                      |a <= b, c != 0 --> a < c+b|
+                      nfix-when-zp-cheap
+                      nfix-when-not-natp-cheap
+                      zp-when-not-natp-cheap
+                      natp-when-zp-cheap
+                      |a <= b, b <= c --> a < 1+c|
+                      equal-of-booleans-rewrite
+                      gather-constants-from-less-of-plus
+                      gather-constants-from-less-of-plus-two
+                      minus-when-zp-left-cheap
+                      minus-when-zp-right-cheap
+                      plus-when-zp-left-cheap
+                      plus-when-zp-right-cheap
+                      gather-constants-from-equal-of-plus
+                      equal-of-non-symbol-and-symbol-cheap
+                      equal-of-non-cons-and-cons-cheap
+                      equal-of-cons-and-non-cons-cheap
+                      equal-of-non-nat-and-nat-cheap
+                      equal-of-nat-and-non-nat-cheap
+                      equal-of-symbol-and-non-symbol-cheap)
+
+            (%waterfall default 400) ;; 169 seconds, 20 goals remain
+            (%car-cdr-elim)
+            (%auto))
+
+
+
+;; Some code for debugging proof times:
+
+;; (acl2::defttag my-check)
+;;
+;; (defun report-times ()
+;;   (declare (xargs :guard t))
+;;   (acl2::cw "Report times not redefined.~%"))
+;;
+;; (acl2::progn!
+;;
+;;  (acl2::set-raw-mode t)
+;;
+;;  (acl2::defparameter *step-times-ht* (acl2::make-hash-table :test #'acl2::eq :size 1024))
+;;
+;;  (acl2::defun level9.flag-proofp-aux (flag x worlds defs axioms thms atbl)
+;;               (if (equal flag 'proof)
+;;                   (let* ((start-time (ACL2::get-internal-real-time))
+;;                          (step1-okp  (level9.step-okp x worlds defs axioms thms atbl))
+;;                          (end-time   (ACL2::get-internal-real-time))
+;;                          (old-time   (or (ACL2::gethash (logic.method x) *step-times-ht*) 0)))
+;;                     (ACL2::progn
+;;                      (acl2::setf (acl2::gethash (logic.method x) *step-times-ht*)
+;;                                  (acl2::+ old-time (acl2::- end-time start-time)))
+;;                      (and step1-okp
+;;                           (level9.flag-proofp-aux 'list (logic.subproofs x) worlds defs axioms thms atbl))))
+;;                 (if (consp x)
+;;                     (and (level9.flag-proofp-aux 'proof (car x) worlds defs axioms thms atbl)
+;;                          (level9.flag-proofp-aux 'list (cdr x) worlds defs axioms thms atbl))
+;;                   t)))
+;;
+;;  (acl2::defun report-times ()
+;;               (acl2::maphash (lambda (key val)
+;;                                (acl2::format t "~a: ~a seconds.~%"
+;;                                              key
+;;                                              (acl2::/ (acl2::coerce val 'acl2::float) acl2::internal-time-units-per-second)))
+;;                              *step-times-ht* )))
+
+
+
+
+
+(%autoprove forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-listp-of-rw.cresult->data-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.trace-listp-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove forcing-rw.cachep-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+
+
+
+
+#||
+
+;; A previous, working attempt.
+
+(%autoprove lemma-for-forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core
+
+            (%autoinduct rw.flag-crewrite)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+
+            ;; Interlaced splitting and lightweight rewriting to control case explosion
+
+            (%quiet t)
+            (%betamode nil)
+            (%forcingp nil)
+            (%crewrite default)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 1 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 3 :splitlimit 25)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+            (%quiet nil)
+
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+            (%betamode once)
+            (%crewrite default)
+            (%cleanup)
+            (%split :liftp t :liftlimit 0 :splitlimit 0)
+
+            (%crewrite default)
+            (%cleanup)
+
+            ;; This might look a little scary, but observe that no single goal is affected
+            ;; by more than one of these expansions.
+
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.crewrite-try-rules-when-not-consp
+                      rw.tracep-when-memberp-of-rw.trace-listp)
+
+            (%crewrite default)
+
+            (%auto :strategy (split cleanup crewrite))
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min)
+
+            (%auto :strategy (split cleanup urewrite crewrite elim)))
+
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-world.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-world.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite-world.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite-world.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,283 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fast-crewrite-clause")
+(%interactive)
+
+
+(%autoprove nth-of-cons-when-constantp
+            (%restrict default nth (equal n 'n)))
+
+(%autoprove rw.crewrite-clause-aux-of-nil
+            (%restrict default rw.crewrite-clause-aux (equal todo ''nil)))
+
+(%autoprove rw.crewrite-clause-of-nil
+            (%enable default rw.crewrite-clause))
+
+(%autoprove tactic.world->index-under-iff
+            (%disable default forcing-natp-of-tactic.world->index)
+            (%use (%instance (%thm forcing-natp-of-tactic.world->index))))
+
+(%autoprove tactic.find-world-of-nil
+            (%cdr-induction worlds)
+            (%restrict default tactic.find-world (equal worlds 'worlds)))
+
+
+
+(%autoadmit rw.make-crewrite-clause-plan)
+(%autoadmit rw.crewrite-clause-planp)
+(%autoadmit rw.crewrite-clause-plan-okp)
+(%autoadmit rw.crewrite-clause-plan-atblp)
+(%autoadmit rw.crewrite-clause-plan->progressp)
+(%autoadmit rw.crewrite-clause-plan->clause)
+(%autoadmit rw.crewrite-clause-plan->provedp)
+(%autoadmit rw.crewrite-clause-plan->clause-prime)
+(%autoadmit rw.crewrite-clause-plan->forced-goals)
+(%autoadmit rw.crewrite-clause-plan-compiler)
+
+
+
+(%autoprove lemma-1-for-rw.crewrite-clause-plan)
+(%autoprove lemma-2-for-rw.crewrite-clause-plan)
+(%autoprove lemma-3-for-rw.crewrite-clause-plan)
+(%autoprove lemma-4-for-rw.crewrite-clause-plan)
+(%autoprove lemma-5-for-rw.crewrite-clause-plan)
+(%autoprove lemma-6-for-rw.crewrite-clause-plan)
+(%autoprove lemma-7-for-rw.crewrite-clause-plan)
+(%autoprove lemma-8-for-rw.crewrite-clause-plan)
+(%autoprove lemma-9-for-rw.crewrite-clause-plan)
+(%autoprove lemma-10-for-rw.crewrite-clause-plan)
+(%autoprove lemma-11-for-rw.crewrite-clause-plan)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 lemma-1-for-rw.crewrite-clause-plan
+                 lemma-2-for-rw.crewrite-clause-plan
+                 lemma-3-for-rw.crewrite-clause-plan
+                 lemma-4-for-rw.crewrite-clause-plan
+                 lemma-5-for-rw.crewrite-clause-plan
+                 lemma-6-for-rw.crewrite-clause-plan
+                 lemma-7-for-rw.crewrite-clause-plan
+                 lemma-8-for-rw.crewrite-clause-plan
+                 lemma-9-for-rw.crewrite-clause-plan
+                 lemma-10-for-rw.crewrite-clause-plan
+                 lemma-11-for-rw.crewrite-clause-plan))
+
+ (local (%enable default
+                 rw.make-crewrite-clause-plan
+                 rw.crewrite-clause-planp
+                 rw.crewrite-clause-plan-okp
+                 rw.crewrite-clause-plan-atblp
+                 rw.crewrite-clause-plan->clause
+                 rw.crewrite-clause-plan->provedp
+                 rw.crewrite-clause-plan->clause-prime
+                 rw.crewrite-clause-plan->forced-goals
+                 rw.crewrite-clause-plan-compiler))
+
+ (%autoprove booleanp-of-rw.crewrite-clause-planp)
+ (%autoprove booleanp-of-rw.crewrite-clause-plan-okp)
+ (%autoprove booleanp-of-rw.crewrite-clause-plan-atblp)
+
+ (%autoprove consp-of-rw.crewrite-clause-plan->clause-prime)
+ (%autoprove logic.term-listp-of-rw.crewrite-clause-plan->clause-prime)
+ (%autoprove true-listp-of-rw.crewrite-clause-plan->forced-goals)
+ (%autoprove logic.formula-listp-of-rw.crewrite-clause-plan->forced-goals)
+ (%autoprove logic.formula-list-atblp-of-rw.crewrite-clause-plan->forced-goals)
+
+ (%autoprove rw.crewrite-clause-plan->clause-of-rw.make-crewrite-clause-plan)
+ (%autoprove rw.crewrite-clause-planp-of-rw.make-crewrite-clause-plan)
+ (%autoprove rw.crewrite-clause-plan-okp-of-rw.make-crewrite-clause-plan)
+ (%autoprove rw.crewrite-clause-plan-atblp-of-rw.make-crewrite-clause-plan)
+
+ (%autoprove logic.appealp-of-rw.crewrite-clause-plan-compiler)
+ (%autoprove logic.conclusion-of-rw.crewrite-clause-plan-compiler)
+ (%autoprove logic.proofp-of-rw.crewrite-clause-plan-compiler
+             (%disable default
+                       type-set-like-rules
+                       expensive-term/formula-inference
+                       formula-decomposition
+                       expensive-arithmetic-rules
+                       expensive-arithmetic-rules-two
+                       unusual-memberp-rules
+                       unusual-subsetp-rules
+                       unusual-consp-rules)))
+
+
+(%deflist rw.crewrite-clause-plan-listp (x)
+          (rw.crewrite-clause-planp x))
+
+(%deflist rw.crewrite-clause-plan-list-okp (x world)
+          (rw.crewrite-clause-plan-okp x world))
+
+(%deflist rw.crewrite-clause-plan-list-atblp (x atbl)
+          (rw.crewrite-clause-plan-atblp x atbl))
+
+(%defprojection :list (rw.make-crewrite-clause-plan-list x fastp theoryname world)
+                :element (rw.make-crewrite-clause-plan x fastp theoryname world))
+
+
+(%autoadmit rw.crewrite-clause-plan-list->progressp)
+
+(%defprojection :list (rw.crewrite-clause-plan-list->clauses x)
+                :element (rw.crewrite-clause-plan->clause x))
+
+(%autoprove rw.crewrite-clause-plan-list->clauses-of-rw.make-crewrite-clause-plan-list
+            (%cdr-induction x))
+
+(%autoadmit rw.crewrite-clause-plan-list->clauses-prime)
+
+(%autoprove cons-listp-of-rw.crewrite-clause-plan-list->clauses-prime
+            (%cdr-induction x)
+            (%restrict default rw.crewrite-clause-plan-list->clauses-prime
+                       (equal x 'x)))
+
+(%autoprove logic.term-list-listp-of-rw.crewrite-clause-plan-list->clauses-prime
+            (%cdr-induction x)
+            (%restrict default rw.crewrite-clause-plan-list->clauses-prime
+                       (equal x 'x)))
+
+(%autoadmit rw.crewrite-clause-plan-list->forced-goals)
+
+(%autoprove true-listp-of-rw.crewrite-clause-plan-list->forced-goals
+            (%cdr-induction x)
+            (%restrict default rw.crewrite-clause-plan-list->forced-goals
+                       (equal x 'x)))
+
+(%autoprove logic.formula-listp-of-rw.crewrite-clause-plan-list->forced-goals
+            (%cdr-induction x)
+            (%restrict default rw.crewrite-clause-plan-list->forced-goals
+                       (equal x 'x)))
+
+(%autoprove logic.formula-list-atblp-of-rw.crewrite-clause-plan-list->forced-goals
+            (%cdr-induction x)
+            (%restrict default rw.crewrite-clause-plan-list->forced-goals
+                       (equal x 'x)))
+
+(%autoprove rw.crewrite-clause-plan-listp-of-rw.make-crewrite-clause-plan-list
+            (%cdr-induction x))
+
+(%autoprove rw.crewrite-clause-plan-list-okp-of-rw.make-crewrite-clause-plan-list
+            (%cdr-induction x))
+
+(%autoprove rw.crewrite-clause-plan-list-atblp-of-rw.make-crewrite-clause-plan-list
+            (%cdr-induction x))
+
+
+(%autoadmit rw.crewrite-clause-plan-list-compiler)
+
+(%autoprove logic.appeal-listp-of-rw.crewrite-clause-plan-list-compiler
+            (%autoinduct rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+            (%restrict default rw.crewrite-clause-plan-list-compiler (equal x 'x))
+            (%restrict default rw.crewrite-clause-plan-list->clauses-prime (equal x 'x))
+            (%restrict default rw.crewrite-clause-plan-list->forced-goals (equal x 'x)))
+
+(%autoprove logic.strip-conclusions-of-rw.crewrite-clause-plan-list-compiler
+            (%autoinduct rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+            (%restrict default rw.crewrite-clause-plan-list-compiler (equal x 'x))
+            (%restrict default rw.crewrite-clause-plan-list->clauses-prime (equal x 'x))
+            (%restrict default rw.crewrite-clause-plan-list->forced-goals (equal x 'x))
+            (%forcingp nil))
+
+(%autoprove logic.proof-listp-of-rw.crewrite-clause-plan-list-compiler
+            (%autoinduct rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+            (%restrict default rw.crewrite-clause-plan-list-compiler (equal x 'x))
+            (%restrict default rw.crewrite-clause-plan-list->clauses-prime (equal x 'x))
+            (%restrict default rw.crewrite-clause-plan-list->forced-goals (equal x 'x))
+            (%forcingp nil)
+            (%disable default unusual-consp-rules unusual-memberp-rules))
+
+(%autoprove rw.crewrite-clause-plan-atblp-removal
+            (%enable default
+                     rw.crewrite-clause-plan-atblp
+                     rw.crewrite-clause-plan->clause))
+
+(%autoprove rw.crewrite-clause-plan-list-atblp-removal
+            (%cdr-induction x)
+            (%restrict default rw.crewrite-clause-plan-list->clauses (equal x 'x))
+            (%restrict default rw.crewrite-clause-plan-list-atblp (equal x 'x)))
+
+
+
+(%autoprove consp-of-rw.crewrite-clause-plan->clause
+            (%enable default
+                     rw.crewrite-clause-planp
+                     rw.crewrite-clause-plan->clause))
+
+(%autoprove logic.term-listp-of-rw.crewrite-clause-plan->clause
+            (%enable default
+                     rw.crewrite-clause-planp
+                     rw.crewrite-clause-plan->clause))
+
+(%autoadmit rw.crewrite-clause-plan-compiler-high)
+(%autoadmit rw.crewrite-clause-plan-compiler-okp)
+
+
+(%autoprove rw.crewrite-clause-plan-compiler-okp-of-rw.crewrite-clause-plan-compiler-high
+            (%enable default
+                     rw.crewrite-clause-plan-compiler-okp
+                     rw.crewrite-clause-plan-compiler-high))
+
+
+(encapsulate
+ ()
+ (local (%enable default rw.crewrite-clause-plan-compiler-okp))
+ (%autoprove booleanp-of-rw.crewrite-clause-plan-compiler-okp)
+ (%autoprove rw.crewrite-clause-plan-compiler-okp-of-logic.appeal-identity)
+ (%autoprove lemma-1-for-soundness-of-rw.crewrite-clause-plan-compiler-okp)
+ (%autoprove lemma-2-for-soundness-of-rw.crewrite-clause-plan-compiler-okp
+             (%disable default
+                       unusual-subsetp-rules
+                       unusual-memberp-rules
+                       unusual-consp-rules))
+ (%autoprove forcing-soundness-of-rw.crewrite-clause-plan-compiler-okp
+             (%disable default
+                       unusual-subsetp-rules
+                       unusual-memberp-rules
+                       unusual-consp-rules)
+             (%use (%instance (%thm lemma-1-for-soundness-of-rw.crewrite-clause-plan-compiler-okp)))
+             (%use (%instance (%thm lemma-2-for-soundness-of-rw.crewrite-clause-plan-compiler-okp)))
+             (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                              (x (let* ((plan        (second (logic.extras x)))
+                                        (world      (tactic.find-world (first (logic.extras x)) worlds))
+                                        (provedp    (rw.crewrite-clause-plan->provedp plan))
+                                        (subproofs* (logic.provable-list-witness
+                                                     (logic.strip-conclusions (logic.subproofs x))
+                                                     axioms thms atbl))
+                                        (proof      (if provedp nil (car subproofs*)))
+                                        (fproofs    (if provedp subproofs* (cdr subproofs*))))
+                                   (rw.crewrite-clause-plan-compiler plan world proof fproofs)))))))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/crewrite-world")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/crewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/crewrite.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,82 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+;(include-book "crewrite-tracep")
+;(include-book "crewrite-lhs")
+;(include-book "crewrite-hypbox")
+(include-book "crewrite-trace-okp")
+(include-book "crewrite-trace-atblp")
+(include-book "crewrite-trace-env-okp")
+(%interactive)
+
+(%autoprove map-listp-when-logic.sigma-listp
+            (%cdr-induction x))
+
+#||
+
+;; Old -- this isn't needed anymore.
+
+(defsection rw.aux-crewrite
+  (%autoadmit rw.aux-crewrite)
+  (local (%restrict default rw.aux-crewrite (equal x 'x)))
+  (%autoprove forcing-rw.tracep-of-rw.aux-crewrite
+              (%autoinduct rw.aux-crewrite))
+  (%autoprove forcing-rw.trace->hypbox-of-rw.aux-crewrite)
+  (%autoprove forcing-rw.trace->lhs-of-rw.aux-crewrite)
+  (%autoprove forcing-rw.trace->iffp-of-rw.aux-crewrite)
+  (%autoprove forcing-rw.trace-atblp-of-rw.aux-crewrite
+              (%autoinduct rw.aux-crewrite))
+  (%autoprove forcing-rw.trace-okp-of-rw.aux-crewrite
+              (%autoinduct rw.aux-crewrite))
+  (%autoprove forcing-rw.trace-env-okp-of-rw.aux-crewrite
+              (%autoinduct rw.aux-crewrite)))
+||#
+
+(defsection rw.crewrite
+  (%autoadmit rw.crewrite)
+  (local (%enable default rw.crewrite))
+  (%autoprove forcing-rw.tracep-of-rw.crewrite)
+  (%autoprove forcing-rw.trace->hypbox-of-rw.crewrite)
+  (%autoprove forcing-rw.trace->lhs-of-rw.crewrite)
+  (%autoprove forcing-rw.trace->iffp-of-rw.crewrite)
+  (%autoprove forcing-rw.trace-atblp-of-rw.crewrite)
+  (%autoprove forcing-rw.trace-okp-of-rw.crewrite)
+  (%autoprove forcing-rw.trace-env-okp-of-rw.crewrite))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/crewrite"
+                                         ;; don't need cheap rules, we have %cheapen
+                                         rw.crewrite-try-rules-when-not-consp-cheap)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-crewrite-clause.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-crewrite-clause.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-crewrite-clause.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-crewrite-clause.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,299 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fast-crewrite")
+(include-book "crewrite-clause")
+(%interactive)
+
+(%autoadmit rw.fast-ccstepp)
+(%autoadmit rw.fast-ccstep)
+(%autoadmit rw.fast-ccstep->contradictionp)
+(%autoadmit rw.fast-ccstep->ftrace)
+
+(%autoprove rw.fast-ccstep->contradictionp-of-rw.fast-ccstep
+            (%enable default
+                     rw.fast-ccstep
+                     rw.fast-ccstep->contradictionp))
+
+(%autoprove rw.fast-ccstep->ftrace-of-rw.fast-ccstep
+            (%enable default rw.fast-ccstep
+                     rw.fast-ccstep->ftrace))
+
+(%autoprove booleanp-of-rw.fast-ccstepp
+            (%enable default rw.fast-ccstepp))
+
+(%autoprove rw.fast-ccstepp-of-rw.fast-ccstep
+            (%enable default rw.fast-ccstepp rw.fast-ccstep))
+
+(%autoprove booleanp-of-rw.fast-ccstep->contradictionp
+            (%enable default
+                     rw.fast-ccstepp
+                     rw.fast-ccstep->contradictionp))
+
+(%autoprove rw.ftracep-of-rw.fast-ccstep->ftrace
+            (%enable default
+                     rw.fast-ccstepp
+                     rw.fast-ccstep->contradictionp
+                     rw.fast-ccstep->ftrace))
+
+
+(%autoadmit rw.ccstep-fast-image)
+
+(%autoprove rw.fast-ccstepp-of-rw.ccstep-fast-image
+            (%enable default rw.ccstep-fast-image))
+
+(%autoprove rw.fast-ccstep->contradictionp-of-rw.ccstep-fast-image
+            (%enable default rw.ccstep-fast-image))
+
+(%autoprove rw.fast-ccstep->ftrace-of-rw.ccstep-fast-image
+            (%enable default rw.ccstep-fast-image))
+
+
+
+(%autoadmit rw.fast-crewrite-take-step)
+
+(%autoprove rw.fast-ccstepp-of-rw.fast-crewrite-take-step
+            (%enable default rw.fast-crewrite-take-step))
+
+
+(%autoprove rw.ccstep-fast-image-of-rw.crewrite-take-step
+
+            (%enable default
+                     rw.ccstep-fast-image
+                     rw.crewrite-take-step
+                     rw.fast-crewrite-take-step)
+            (%disable default
+                      rw.fast-assms->contradiction-of-rw.assms-fast-image
+                      [outside]rw.fast-assms->contradiction-of-rw.assms-fast-image
+                      )
+            (%use (%instance
+                   (%thm rw.fast-assms->contradiction-of-rw.assms-fast-image)
+                   (assms (rw.assume-right-list
+                           done
+                           (rw.assume-left-list (cdr todo)
+                                                (rw.empty-assms (rw.control->assmctrl control)))))))
+
+            (%auto :strategy (cleanup split crewrite))
+
+            ;; Very gross.  We don't pattern match literal conses...
+            (%enable default rw.fast-ccstep)
+            (%use (%instance (%thm equal-of-cons-rewrite)
+                             (x '(t))
+                             (a (RW.FAST-ASSMS->CONTRADICTION
+                                 (RW.FAST-ASSUME-RIGHT-LIST
+                                  DONE
+                                  (RW.FAST-ASSUME-LEFT-LIST
+                                   (CDR TODO)
+                                   (RW.EMPTY-FAST-ASSMS (RW.CONTROL->ASSMCTRL CONTROL))))))
+                             (b 'nil)))
+            (%auto))
+
+(%autoprove rw.fast-ccstep->contradictionp-of-rw.fast-crewrite-take-step
+            (%disable default
+                      rw.fast-ccstep->contradictionp-of-rw.ccstep-fast-image
+                      [outside]rw.fast-ccstep->contradictionp-of-rw.ccstep-fast-image)
+            (%use (%instance (%thm rw.fast-ccstep->contradictionp-of-rw.ccstep-fast-image)
+                             (x (rw.crewrite-take-step todo done blimit rlimit control n)))))
+
+(%autoprove rw.fast-ccstep->ftrace-of-rw.fast-crewrite-take-step
+            (%enable default
+                     rw.fast-crewrite-take-step
+                     rw.crewrite-take-step)
+            (%disable default
+                      rw.fast-assms->contradiction-of-rw.assms-fast-image
+                      [outside]rw.fast-assms->contradiction-of-rw.assms-fast-image)
+            (%use (%instance
+                   (%thm rw.fast-assms->contradiction-of-rw.assms-fast-image)
+                   (assms (rw.assume-right-list
+                           done
+                           (rw.assume-left-list (cdr todo)
+                                                (rw.empty-assms (rw.control->assmctrl control))))))))
+
+
+(%autoadmit rw.fast-ccstep->provedp)
+
+(%autoprove rw.fast-ccstep->provedp-of-rw.ccstep-fast-image
+            (%enable default
+                     rw.fast-ccstep->provedp
+                     rw.ccstep->provedp))
+
+(%autoprove rw.fast-ccstep->contradictionp-when-not-rw.fast-ccstep->provedp
+            (%enable default rw.fast-ccstep->provedp))
+
+(%autoprove rw.fast-ccstep->provedp-of-rw.fast-crewrite-take-step
+            (%disable default
+                      rw.fast-ccstep->provedp-of-rw.ccstep-fast-image
+                      [outside]rw.fast-ccstep->provedp-of-rw.ccstep-fast-image
+                      )
+            (%use (%instance (%thm rw.fast-ccstep->provedp-of-rw.ccstep-fast-image)
+                             (x (rw.crewrite-take-step todo done blimit rlimit control n)))))
+
+
+
+(%autoadmit rw.fast-ccstep->t1prime)
+
+(%autoprove rw.fast-ccstep->t1prime-of-rw.ccstep-fast-image
+            (%enable default rw.fast-ccstep->t1prime rw.ccstep->t1prime))
+
+(%autoprove logic.termp-of-rw.fast-ccstep->t1prime
+            (%enable default rw.fast-ccstep->t1prime))
+
+(%autoprove rw.fast-ccstep->t1prime-of-rw.fast-crewrite-take-step
+            (%enable default rw.ccstep->provedp)
+            (%disable default
+                      rw.fast-ccstep->t1prime-of-rw.ccstep-fast-image)
+            (%use (%instance (%thm rw.fast-ccstep->t1prime-of-rw.ccstep-fast-image)
+                             (x (rw.crewrite-take-step todo done blimit rlimit control n)))))
+
+
+
+
+
+
+;; Fast clause crewriting.
+;;
+;; This has been kind of tricky.  We don't really care about building any
+;; intermediate steps.  All we want to know is (1) whether the clause gets
+;; proved, (2) what is clause-prime, if the clause wasn't proved, and (2) what
+;; goals were forced?  We begin by introducing three functions to compute
+;; exactly these answers.  We won't run these functions, we just use them to do
+;; the reasoning.
+
+(%autoadmit rw.crewrite-clause-aux-provedp)
+(%autoadmit rw.crewrite-clause-aux-todo-primes)
+(%autoadmit rw.crewrite-clause-aux-fgoals)
+
+(%autoadmit rw.crewrite-clause-aux-noacc)
+
+(%autoprove consp-of-rw.crewrite-clause-aux-noacc
+            (%autoinduct rw.crewrite-clause-aux-noacc)
+            (%restrict default rw.crewrite-clause-aux-noacc (equal todo 'todo)))
+
+;; (defthm true-listp-of-rw.crewrite-clause-aux
+;;   (implies (true-listp acc)
+;;            (true-listp (rw.crewrite-clause-aux todo done blimit rlimit control n acc)))
+;;   :hints(("Goal" :in-theory (enable rw.crewrite-clause-aux))))
+
+;; (%autoprove true-listp-of-rw.crewrite-clause-aux
+;;             (%autoinduct rw.crewrite-clause-aux)
+;;             (%restrict default rw.crewrite-clause-aux (equal todo 'todo)))
+
+(%autoprove rw.crewrite-clause-aux-removal
+            (%autoinduct rw.crewrite-clause-aux)
+            (%restrict default rw.crewrite-clause-aux (equal todo 'todo))
+            (%restrict default rw.crewrite-clause-aux-noacc (equal todo 'todo)))
+
+(%autoprove car-of-app)
+(%autoprove cdr-of-app)
+(local (%enable default car-of-app))
+(local (%enable default cdr-of-app))
+
+
+(%autoprove rw.crewrite-clause-aux-provedp-correct
+            (%autoinduct rw.crewrite-clause-aux-noacc)
+            (%restrict default rw.crewrite-clause-aux-noacc (equal todo 'todo))
+            (%restrict default rw.crewrite-clause-aux-provedp (equal todo 'todo)))
+
+(%autoprove consp-of-rw.crewrite-clause-aux-todo-primes
+            (%autoinduct rw.crewrite-clause-aux-todo-primes)
+            (%restrict default rw.crewrite-clause-aux-todo-primes (equal todo 'todo)))
+
+(%autoprove rw.ccstep->clause-prime-of-rw.crewrite-take-step
+            (%enable default
+                     rw.ccstep->clause-prime
+                     rw.ccstep->provedp
+                     rw.ccstep->t1prime
+                     rw.crewrite-take-step))
+
+(%autoprove rw.crewrite-clause-aux-todo-primes-correct
+            (%autoinduct rw.crewrite-clause-aux-noacc todo done blimit rlimit control n)
+            (%restrict default rw.crewrite-clause-aux-todo-primes (equal todo 'todo))
+            (%restrict default rw.crewrite-clause-aux-provedp (equal todo 'todo))
+            (%restrict default rw.crewrite-clause-aux-noacc (equal todo 'todo)))
+
+(%autoprove true-listp-of-rw.crewrite-clause-aux-fgoals
+            (%autoinduct rw.crewrite-clause-aux-fgoals)
+            (%restrict default rw.crewrite-clause-aux-fgoals (equal todo 'todo)))
+
+(%autoprove rw.crewrite-clause-aux-fgoals-correct
+            (%autoinduct rw.crewrite-clause-aux-noacc)
+            (%restrict default rw.crewrite-clause-aux-fgoals (equal todo 'todo))
+            (%restrict default rw.crewrite-clause-aux-noacc (equal todo 'todo)))
+
+
+
+(%autoadmit rw.fast-crewrite-clause-aux)
+
+(%autoprove provedp-of-rw.fast-crewrite-clause-aux
+            (%autoinduct rw.fast-crewrite-clause-aux)
+            (%disable default rw.crewrite-clause-aux-provedp-correct)
+            (%restrict default rw.crewrite-clause-aux-provedp (equal todo 'todo))
+            (%restrict default rw.fast-crewrite-clause-aux (equal todo 'todo)))
+
+(%autoprove clause-prime-of-rw.fast-crewrite-clause-aux
+            (%autoinduct rw.fast-crewrite-clause-aux)
+            (%restrict default rw.crewrite-clause-aux-provedp (equal todo 'todo))
+            (%restrict default rw.crewrite-clause-aux-todo-primes (equal todo 'todo))
+            (%restrict default rw.fast-crewrite-clause-aux (equal todo 'todo)))
+
+(%autoprove forced-goals-of-rw.fast-crewrite-clause-aux
+            (%autoinduct rw.fast-crewrite-clause-aux)
+            (%restrict default rw.crewrite-clause-aux-fgoals (equal todo 'todo))
+            (%restrict default rw.fast-crewrite-clause-aux (equal todo 'todo))
+            (%enable default rw.ccstep-forced-goals))
+
+
+
+(%autoadmit rw.fast-crewrite-clause)
+
+(%autoprove first-of-rw.fast-crewrite-clause
+            (%enable default
+                     rw.fast-crewrite-clause
+                     rw.crewrite-clause
+                     rw.crewrite-clause-aux-removal))
+
+(%autoprove second-of-rw.fast-crewrite-clause
+            (%enable default
+                     rw.fast-crewrite-clause
+                     rw.crewrite-clause
+                     rw.crewrite-clause-aux-removal))
+
+(%autoprove third-of-rw.fast-crewrite-clause
+            (%enable default
+                     rw.fast-crewrite-clause
+                     rw.crewrite-clause
+                     rw.crewrite-clause-aux-removal))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/fast-crewrite-clause")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-crewrite.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-crewrite.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-crewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-crewrite.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,75 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fast-image")
+
+
+(%autoprove rw.ftrace->rhs-of-rw.fast-crewrite-core
+            (%disable default rw.trace-fast-image-of-rw.crewrite-core)
+            (%use (%instance (%thm rw.trace-fast-image-of-rw.crewrite-core))))
+
+
+#||
+
+;; this shoudln't be needed anymore
+
+(%autoadmit rw.aux-fast-crewrite)
+
+(%autoprove rw.ftracep-of-rw.aux-fast-crewrite
+            (%autoinduct rw.aux-fast-crewrite)
+            (%restrict default rw.aux-fast-crewrite (equal n 'n)))
+
+(%autoprove rw.trace-fast-image-of-rw.aux-crewrite
+            (%autoinduct rw.aux-crewrite)
+            (%restrict default rw.aux-crewrite (equal n 'n))
+            (%restrict default rw.aux-fast-crewrite (equal n 'n)))
+
+||#
+
+(%autoadmit rw.fast-crewrite)
+
+(%autoprove rw.ftracep-of-rw.fast-crewrite
+            (%enable default rw.fast-crewrite))
+
+(%autoprove rw.trace-fast-image-of-rw.crewrite
+            (%enable default rw.crewrite rw.fast-crewrite))
+
+(%autoprove rw.ftrace->rhs-of-rw.fast-crewrite
+            (%disable default rw.trace-fast-image-of-rw.crewrite)
+            (%use (%instance (%thm rw.trace-fast-image-of-rw.crewrite))))
+
+(%autoprove rw.ftrace->fgoals-of-rw.fast-crewrite
+            (%disable default rw.trace-fast-image-of-rw.crewrite)
+            (%use (%instance (%thm rw.trace-fast-image-of-rw.crewrite))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-ftracep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-ftracep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-ftracep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-ftracep.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,168 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fast-start")
+(%interactive)
+
+(local (include-book "crewrite-local-settings"))
+(local (%max-proof-size 0))
+
+(%autoprove lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core
+
+            (%quiet t)
+            (%forcingp nil)
+            (%splitlimit 2)
+            (%liftlimit 10)
+            (%rwn 20)
+            (%urwn 20)
+
+            (%autoinduct rw.fast-flag-crewrite flag assms x rule[s] sigma[s]
+                         cache iffp blimit rlimit anstack control)
+
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+
+            (%waterfall default 40) ;; 476 seconds, 7 GB, 3.8 allocated at finish, 1120 remain, 2.7 freed after gc
+
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning)
+            (%betamode once)
+
+            (%waterfall default 40) ;; 365 seconds, 5.2 gb allocated, 806 remain, 2.35 gb at finish, 1 freed after gc
+
+            (%cleanup) ;; 796 goals
+
+            (%restrict default definition-of-rw.fast-crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.fast-crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.fast-crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.fast-crewrite-relieve-hyp (equal x 'x))
+
+            (%disable default ;; speed hint
+                      rw.fast-crewrite-try-rules-when-not-consp)
+
+; I used this trick in fast-image.  Will it work here?  The size to beat is 27 GC.  wow, down to 4bn.
+; this is freaking wonderful.
+
+            ;(%urwn 50)
+            (%betamode t)
+            (%crewrite default)
+            (%waterfall default 40) ;; 414 seconds, 9.7 GB allocated, 173 remain, 4.78 gb at finish, 3.1 freed by gc
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     usual-consp-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min
+                     equal-of-booleans-rewrite
+                     )
+
+            (%waterfall default 40) ;; 695 seconds, 11 GB allocated, 4.6 GB allocated at finish, 2.9 freed by gc, 20 goals remain
+            (%auto))
+
+
+(%autoprove forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-core
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.ftracesp-of-rw.cresult->data-of-rw.fast-crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-core-list
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'list))))
+
+(%autoprove forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-try-rule
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-try-rules
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-try-match
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'match))))
+
+(%autoprove forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-try-matches
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove forcing-rw.ftracesp-of-rw.hypresult->traces-of-rw.fast-crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove forcing-rw.fast-cachep-of-rw.hypresult->cache-of-rw.fast-crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core)
+                             (flag 'hyps))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-image.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-image.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-image.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-image.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,318 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2007 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fast-ftracep")
+(local (include-book "crewrite-local-settings"))
+
+
+
+
+; This is the "hardest" proof in all of Milawa.  With some speed hints and
+; printing disabled, the ACL2 proof of this lemma takes around 650 seconds on
+; the lhug machines.  By comparison, most proofs about the regular rewriter
+; take only around 50 seconds.  So that's quite a jump.
+
+(local (%max-proof-size 0))
+
+(%autoprove lemma-for-rw.trace-fast-image-of-rw.crewrite-core
+
+; The goals produced here are so large that it is disabling output results
+; in a considerable speed boost.
+            (%quiet t)
+
+; At a high-level, the proof is not very complicated.  We induct upon the
+; definition of the ordinary reweriter, and our fast-image functions will
+; canonicalize the things it does into the fast versions.  So, we are inducting
+; over the definition of flag-crewrite, which is an eight-way mutual recursion.
+; And we are trying to simultaneously prove several facts about each of our
+; fast-crewrite functions.  The result is a terrible, multiplicative case
+; split.
+;
+; To handle this, we developed the %waterfall tactic, which can operate in a
+; depth-first manner instead of the ordinary breadth-first way.  The basic goal
+; is to completely perform all of the case splitting before we open up any of
+; the rewriter functions.  We rewrite the intermediate cases to "prune" the
+; tree, using a very restricted theory that does not introduce case splits and
+; where beta-reduction and forcing are disallowed.
+
+            (%autoinduct rw.flag-crewrite flag assms x rule[s] sigma[s]
+                         cache iffp blimit rlimit anstack control)
+
+            (%forcingp nil)
+
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-lookup-of-logic.function-name-free)
+
+
+; The waterfall operates by taking each goal and first trying to rewrite it in
+; the restricted theory we have just mentioned, then once that stabilizes we
+; try to split into cases.  As a result, the splitlimit and liftlimit really
+; have quite an impact on how many goals the rewriter will need to consider.  I
+; had very little intuition about what the proper settings were.  So, I fired
+; up a bunch of the lhug machines and got to writing this chart.
+;
+; These results are not very scientific.  Another user who will go unnamed has
+; been heavily using "my lhug machines" for the past semester, and my requests
+; to gripe have not resulted in more useful 64-bit machines.  Also, due to the
+; length of these experiments, I have not tried to repeat them.  At any rate,
+; the table below may have some considerable error.  It's not too important
+; that we get "the best answer", we just want the proof to complete in a
+; reasonable amount of time.
+;
+; Reading the chart.
+;
+;    - I tried two strategies, (crewrite split) and (crewrite nolift-split
+;      split).  NOLIFT indicates whether nolift-split was in the strategy
+;      or not.
+;
+;    - L_LIMIT and S_LIMIT are the liftlimit and splitlimit used.
+;
+;    - TIME is the total amount of time it took to run the waterfall,
+;      GC_TIME is the part of this that was spent in gc, and ALLOC is the
+;      total allocation during the whole waterfall (in GB)
+;
+;    - Clauses #125 and #118 were a couple of fairly large goals that could
+;      be used as indicators of how successful a strategy would be
+;
+;    - NA indicates that I killed the test rather than let it finish, after
+;      having first determined that it was not competitive with other
+;      approaches.
+;
+;  NOLIFT   L_LIMIT  S_LIMIT  TIME     GC_TIME  ALLOC  125_T  118_T
+;
+;  IN       2        1        6017s    235s     37.4   89s    810s      *test-2-1*
+;  IN       2        2        6041s    274s     36.2   104s   864s      *test-2-2*
+;  IN       2        4        6973s    410s     47.6   180s   1117s     *test-2-4*
+;  IN       5        2        9268s    433s     36.1   85s    1468s     *test-5-2*
+;  IN       8        2        5786s    206s     33.3   76s    602s      *test-8-2*
+;  IN       10       1        6148s    224s     36.5   52s    746s      *test-10-1*
+;  IN       10       2        5614s    200s     32.4   76s    608s      *test-10-2*
+;  IN       10       3        6517s    264s     37.3   125s   751s      *test-10-3*
+;  IN       10       5        NA       NA       NA     231s   945s      *test-10-5*
+;  IN       15       2        5507s    208s     32.5   77s    617s      *test-15-2*
+;  IN       20       2        5590s    233s     33.3   78s    622s      *test-20-2*
+;  IN       20       10       NA       NA       NA     1639s  NA        *test-20-10*
+;  IN       10       20       NA       NA       NA     NA     NA        *test-10-20*
+;
+;  OUT      2        2        5727s    266s     35.8   69s    536s      *test-2-2-lift*
+;  OUT      2        4        6867s    365s     42.1   199s   796s      *test-2-4-lift*
+;  OUT      4        2        6300s    285s     36.3   71s    490s      *test-4-2-lift*
+;  OUT      10       1        7761s    394s     45.3   111s   828s      *test-10-1-lift*
+;  OUT      10       2        6046s    277s     36.5   64s    468s      *test-10-2-lift*
+;  OUT      10       5        6689s    279s     35.8   46s    544s      *test-10-5-lift*
+;  OUT      15       2        6110s    384s     45.5   53s    539s      *test-15-2-lift*
+;
+; These results above were taken with
+;  (%enable default rw.trace-fast-image-equivalence-lemmas)
+;  (%betamode nil)
+;  (%liftlimit n)
+;  (%splitlimit n)
+;  (%waterfall default 400)
+;
+; I later investigated just allowing the beta-reduction and splitting to happen all at once.
+; And the result seems to be marginally faster than doing them separately, so I am just going
+; with it now.
+
+            (%liftlimit 1)
+            (%splitlimit 1)
+
+            (%betamode once)
+            (%enable default
+                     splitters
+                     special-disables-for-fast-pruning
+                     rw.trace-fast-image-equivalence-lemmas)
+
+            (%waterfall default 400)
+
+            (%enable default rw.fast-weakening-trace)
+            (%restrict default definition-of-rw.fast-crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.fast-crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.fast-crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.fast-crewrite-relieve-hyp (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-core (equal x 'x))
+            (%restrict default definition-of-rw.crewrite-try-rule (equal x 'x) (equal rule[s] 'rule[s]))
+            (%restrict default definition-of-rw.crewrite-try-match (equal x 'x) (equal sigma[s] 'sigma[s]))
+            (%restrict default definition-of-rw.crewrite-relieve-hyp (equal x 'x))
+
+; This crewrite is crucial for proof size.  It reduces the proof size from 240 GC to 19 GC.
+            (%betamode t)
+            (%crewrite default)
+
+            (%waterfall default 400)
+
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     rw.crewrite-try-rules-when-not-consp
+                     rw.tracep-when-memberp-of-rw.trace-listp
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules
+                     usual-consp-rules
+                     unusual-consp-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     min
+                     equal-of-booleans-rewrite)
+
+            (%auto))
+
+(%autoprove rw.trace-fast-image-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove rw.cache-fast-image-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'term))))
+
+(%autoprove rw.cresult->alimitedp-of-rw.crewrite-core
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'term))))
+
+
+(%autoprove rw.trace-list-fast-image-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove rw.cache-fast-image-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'list))))
+
+(%autoprove rw.cresult->alimitedp-of-rw.crewrite-core-list
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'list))))
+
+
+(%autoprove rw.crewrite-try-rule-under-iff
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove rw.trace-fast-image-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove rw.cache-fast-image-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+(%autoprove rw.cresult->alimitedp-of-rw.crewrite-try-rule
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'rule))))
+
+
+(%autoprove rw.crewrite-try-rules-under-iff
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove rw.trace-fast-image-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove rw.cache-fast-image-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+(%autoprove rw.cresult->alimitedp-of-rw.crewrite-try-rules
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'rules))))
+
+
+(%autoprove rw.crewrite-try-match-under-iff
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove rw.trace-fast-image-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove rw.cache-fast-image-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'match))))
+
+(%autoprove rw.cresult->alimitedp-of-rw.crewrite-try-match
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'match))))
+
+
+(%autoprove rw.crewrite-try-matches-under-iff
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove rw.trace-fast-image-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove rw.cache-fast-image-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+(%autoprove rw.cresult->alimitedp-of-rw.crewrite-try-matches
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'matches))))
+
+
+(%autoprove rw.crewrite-relieve-hyp-under-iff
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove rw.trace-fast-image-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove rw.cache-fast-image-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+(%autoprove rw.cresult->alimitedp-of-rw.crewrite-relieve-hyp
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'hyp))))
+
+
+(%autoprove rw.hypresult->successp-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove rw.trace-list-fast-image-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove rw.cache-fast-image-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'hyps))))
+
+(%autoprove rw.hypresult->alimitedp-of-rw.crewrite-relieve-hyps
+            (%use (%instance (%thm lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+                             (flag 'hyps))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-start.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-start.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/fast-start.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/fast-start.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,183 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite")
+(%interactive)
+
+
+
+(%autoadmit rw.fast-flag-crewrite)
+(%disable default rw.fast-flag-crewrite)
+(%splitlimit 10)
+
+
+(%rwn 1000)
+
+
+(defsection fast-irrelevant-argument-reduction
+  (%autoprove rw.fast-flag-crewrite-of-term-reduction
+              (%restrict default rw.fast-flag-crewrite (and (equal flag ''term) (equal x 'x))))
+  (%autoprove rw.fast-flag-crewrite-of-list-reduction
+              (%restrict default rw.fast-flag-crewrite (and (equal flag ''list) (equal x 'x))))
+  (%autoprove rw.fast-flag-crewrite-of-rule-reduction
+              (%restrict default rw.fast-flag-crewrite (and (equal flag ''rule) (equal x 'x))))
+  (%autoprove rw.fast-flag-crewrite-of-rules-reduction
+              (%restrict default rw.fast-flag-crewrite (and (equal flag ''rules) (equal rule[s] 'rule[s]))))
+  (%autoprove rw.fast-flag-crewrite-of-hyp-reduction
+              (%restrict default rw.fast-flag-crewrite (and (equal flag ''hyp) (equal x 'x))))
+  (%autoprove rw.fast-flag-crewrite-of-hyps-reduction
+              (%restrict default rw.fast-flag-crewrite (and (equal flag ''hyps) (equal x 'x)))))
+
+
+(defsection fast-flag-wrapper-functions
+  (%autoadmit rw.fast-crewrite-core)
+  (%autoadmit rw.fast-crewrite-core-list)
+  (%autoadmit rw.fast-crewrite-try-rule)
+  (%autoadmit rw.fast-crewrite-try-rules)
+  (%autoadmit rw.fast-crewrite-try-match)
+  (%autoadmit rw.fast-crewrite-try-matches)
+  (%autoadmit rw.fast-crewrite-relieve-hyp)
+  (%autoadmit rw.fast-crewrite-relieve-hyps))
+
+
+
+(defsection rw.fast-flag-crewrite-removal
+  (%autoprove rw.fast-flag-crewrite-of-term
+              (%enable default rw.fast-crewrite-core)
+              (%use (%thm rw.fast-flag-crewrite-of-term-reduction)))
+  (%autoprove rw.fast-flag-crewrite-of-list
+              (%enable default rw.fast-crewrite-core-list)
+              (%use (%thm rw.fast-flag-crewrite-of-list-reduction)))
+  (%autoprove rw.fast-flag-crewrite-of-rule
+              (%enable default rw.fast-crewrite-try-rule)
+              (%use (%thm rw.fast-flag-crewrite-of-rule-reduction)))
+  (%autoprove rw.fast-flag-crewrite-of-rules
+              (%enable default rw.fast-crewrite-try-rules)
+              (%use (%thm rw.fast-flag-crewrite-of-rules-reduction)))
+  (%autoprove rw.fast-flag-crewrite-of-match
+              (%enable default rw.fast-crewrite-try-match))
+  (%autoprove rw.fast-flag-crewrite-of-matches
+              (%enable default rw.fast-crewrite-try-matches))
+  (%autoprove rw.fast-flag-crewrite-of-hyp
+              (%enable default rw.fast-crewrite-relieve-hyp)
+              (%use (%thm rw.fast-flag-crewrite-of-hyp-reduction)))
+  (%autoprove rw.fast-flag-crewrite-of-hyps
+              (%enable default rw.fast-crewrite-relieve-hyps)
+              (%use (%thm rw.fast-flag-crewrite-of-hyps-reduction))))
+
+
+
+
+(local (%disable default
+                 formula-decomposition
+                 expensive-term/formula-inference
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 unusual-memberp-rules
+                 unusual-subsetp-rules
+                 unusual-consp-rules
+                 usual-consp-rules
+                 same-length-prefixes-equal-cheap
+                 forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                 equal-of-booleans-rewrite))
+
+(local (%max-proof-size 0))
+
+(%autoprove definition-of-rw.fast-crewrite-core
+            (%use (%instance (%thm rw.fast-flag-crewrite) (flag 'term)))
+            (%betamode nil)
+            (%auto)
+            (%betamode once))
+
+(%autoprove definition-of-rw.fast-crewrite-core-list
+            (%use (%instance (%thm rw.fast-flag-crewrite) (flag 'list))))
+
+(%autoprove definition-of-rw.fast-crewrite-try-rule
+            (%use (%instance (%thm rw.fast-flag-crewrite) (flag 'rule))))
+
+(%autoprove definition-of-rw.fast-crewrite-try-rules
+            (%use (%instance (%thm rw.fast-flag-crewrite) (flag 'rules))))
+
+(%autoprove definition-of-rw.fast-crewrite-try-match
+            (%use (%instance (%thm rw.fast-flag-crewrite) (flag 'match))))
+
+(%autoprove definition-of-rw.fast-crewrite-try-matches
+            (%use (%instance (%thm rw.fast-flag-crewrite) (flag 'matches))))
+
+(%autoprove definition-of-rw.fast-crewrite-relieve-hyp
+            (%use (%instance (%thm rw.fast-flag-crewrite) (flag 'hyp))))
+
+(%autoprove definition-of-rw.fast-crewrite-relieve-hyps
+            (%use (%instance (%thm rw.fast-flag-crewrite) (flag 'hyps))))
+
+
+
+
+(%autoprove rw.fast-crewrite-core-list-when-not-consp
+            (%restrict default definition-of-rw.fast-crewrite-core-list (equal x 'x)))
+
+(%autoprove rw.fast-crewrite-core-list-of-cons
+            (%restrict default definition-of-rw.fast-crewrite-core-list (equal x '(cons a x))))
+
+(%autoprove len-of-rw.ftraces->rhses-of-rw.cresult->data-of-rw.fast-crewrite-core-list$
+            (%autoinduct rw.fast-crewrite-list-induction))
+
+
+
+(%autoprove rw.fast-crewrite-try-rules-when-not-consp
+            (%restrict default definition-of-rw.fast-crewrite-try-rules (equal rule[s] 'rule[s])))
+
+(%autoprove rw.fast-crewrite-try-rules-of-cons
+            (%restrict default definition-of-rw.fast-crewrite-try-rules (equal rule[s] '(cons rule rules))))
+
+
+
+(%autoprove rw.fast-crewrite-try-matches-when-not-consp
+            (%restrict default definition-of-rw.fast-crewrite-try-matches (equal sigma[s] 'sigma[s])))
+
+(%autoprove rw.fast-crewrite-try-matches-of-cons
+            (%restrict default definition-of-rw.fast-crewrite-try-matches (equal sigma[s] '(cons sigma sigmas))))
+
+
+
+(%autoprove rw.fast-crewrite-relieve-hyps-when-not-consp
+            (%restrict default definition-of-rw.fast-crewrite-relieve-hyps (equal x 'x)))
+
+(%autoprove rw.fast-crewrite-relieve-hyps-of-cons
+            (%restrict default definition-of-rw.fast-crewrite-relieve-hyps (equal x '(cons a x))))
+
+(%autoprove booleanp-of-rw.hypresult->successp-of-rw.fast-crewrite-relieve-hyps
+            (%use (%instance (%thm definition-of-rw.fast-crewrite-relieve-hyps))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/level10.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level10/level10.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/level10.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/level10.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,218 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-world")
+(%interactive)
+
+(%autoadmit level10.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level10.step-okp))
+ (%autoprove soundness-of-level10.step-okp)
+ (%autoprove level10.step-okp-when-level9.step-okp
+             (%enable default level9.step-okp)
+             (%auto)
+             (%enable default level8.step-okp)
+             (%auto)
+             (%enable default level7.step-okp)
+             (%auto)
+             (%enable default level6.step-okp)
+             (%auto)
+             (%enable default level5.step-okp)
+             (%auto)
+             (%enable default level4.step-okp)
+             (%auto)
+             (%enable default level3.step-okp)
+             (%auto)
+             (%enable default level2.step-okp)
+             (%auto)
+             (%enable default logic.appeal-step-okp)
+             (%auto))
+ (%autoprove level10.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%forcingp nil))
+ (local (%enable default expensive-arithmetic-rules))
+ (%autoadmit level10.flag-proofp-aux))
+
+(%autoadmit level10.proofp-aux)
+(%autoadmit level10.proof-listp-aux)
+
+(%autoprove definition-of-level10.proofp-aux
+            (%enable default level10.proofp-aux level10.proof-listp-aux)
+            (%restrict default level10.flag-proofp-aux (equal x 'x)))
+
+(%autoprove definition-of-level10.proof-listp-aux
+            (%enable default level10.proofp-aux level10.proof-listp-aux)
+            (%restrict default level10.flag-proofp-aux (equal x 'x)))
+
+(%autoprove level10.proofp-aux-when-not-consp
+            (%enable default definition-of-level10.proofp-aux))
+
+(%autoprove level10.proof-listp-aux-when-not-consp
+            (%restrict default definition-of-level10.proof-listp-aux (equal x 'x)))
+
+(%autoprove level10.proof-listp-aux-of-cons
+            (%restrict default definition-of-level10.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level10.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%enable default
+                     definition-of-level10.proofp-aux
+                     expensive-arithmetic-rules)
+            (%forcingp nil))
+
+(%autoprove booleanp-of-level10.proofp-aux
+            (%use (%instance (%thm lemma-for-booleanp-of-level10.proofp-aux)
+                             (flag 'proof))))
+
+(%autoprove booleanp-of-level10.proof-listp-aux
+            (%use (%instance (%thm lemma-for-booleanp-of-level10.proofp-aux)
+                             (flag 'list))))
+
+(%deflist level10.proof-listp-aux (x worlds defs axioms thms atbl)
+          (level10.proofp-aux x worlds defs axioms thms atbl))
+
+
+
+
+(%autoprove lemma-for-logic.provablep-when-level10.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%splitlimit 2)
+            (%liftlimit 8)
+            (%disable default
+                      forcing-true-listp-of-logic.subproofs
+                      MEMBERP-WHEN-NOT-CONSP
+                      CONSP-WHEN-CONSP-OF-CDR-CHEAP
+                      LOOKUP-WHEN-NOT-CONSP
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-subset-of-somep-cheap
+                      memberp-when-not-superset-of-somep-cheap
+                      type-set-like-rules
+                      unusual-consp-rules
+                      unusual-memberp-rules
+                      unusual-subsetp-rules
+                      same-length-prefixes-equal-cheap
+                      logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest)
+            (%waterfall default 100)
+            (%restrict default definition-of-level10.proofp-aux (equal x 'x))
+            (%enable default
+                     expensive-arithmetic-rules
+                     type-set-like-rules)
+            (%waterfall default 100))
+
+(%autoprove logic.provablep-when-level10.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level10.proofp-aux)
+                             (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level10.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level10.proofp-aux)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-level10.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level10.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x))
+            (%enable default expensive-arithmetic-rules))
+
+(%autoprove level10.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level10.proofp-aux-when-logic.proofp)
+                             (flag 'proof))))
+
+(%autoprove level10.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level10.proofp-aux-when-logic.proofp)
+                             (flag 'list))))
+
+
+
+(%autoprove forcing-level10.proofp-aux-of-logic.provable-witness
+            (%enable default level10.proofp-aux-when-logic.proofp))
+
+
+(%autoadmit level10.static-checksp)
+(%enable default level10.static-checksp)
+
+(%autoadmit level10.proofp)
+
+(%autoprove booleanp-of-level10.proofp
+            (%enable default level10.proofp))
+
+(%autoprove logic.provablep-when-level10.proofp
+            (%enable default level10.proofp)
+            (%disable default
+                      logic.provablep-when-level10.proofp-aux
+                      unusual-memberp-rules
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-consp
+                      unusual-consp-rules
+                      expensive-term/formula-inference
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      formula-decomposition
+                      )
+            (%use (%instance (%thm logic.provablep-when-level10.proofp-aux)
+                             (x      (third (logic.extras x)))
+                             (defs   (first (logic.extras x)))
+                             (worlds (second (logic.extras x)))))
+            (%auto :strategy (cleanup split crewrite))
+            (%enable default expensive-term/formula-inference))
+
+(defsection level10-transition
+  (%install-new-proofp level10.proofp)
+  (%auto)
+  (%qed-install))
+
+(ACL2::table tactic-harness 'current-adapter 'level10.adapter)
+
+(%switch-builder rw.crewrite-clause-plan-compiler rw.crewrite-clause-plan-compiler-high)
+
+;; This is special, we need to tell the interface to switch to the fast
+;; crewriter during proofs.
+(ACL2::table tactic-harness 'cfastp t)
+
+(%finish "level10")
+(%save-events "level10.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level10/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/make-image.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level9/level9")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level10-symmetry"
+                 "Pre-loaded bootstrap/level9 directory.")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level10/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level10/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level10/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level10/symmetry	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level10-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level11/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/acl2-customization.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level11/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/cert.image	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1 @@
+level11-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/cleanup.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/cleanup.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/cleanup.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/cleanup.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,64 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(%interactive)
+
+(%autoadmit tactic.cleanup-okp)
+
+(%autoprove booleanp-of-tactic.cleanup-okp
+            (%enable default tactic.cleanup-okp))
+
+(%autoadmit tactic.cleanup-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.cleanup-tac
+            (%enable default tactic.cleanup-tac))
+
+(%autoprove forcing-tactic.cleanup-okp-of-tactic.cleanup-tac
+            (%enable default
+                     tactic.cleanup-tac
+                     tactic.cleanup-okp))
+
+(%autoadmit tactic.cleanup-compile)
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.cleanup-okp
+                 tactic.cleanup-compile))
+ (%autoprove forcing-logic.appeal-listp-of-tactic.cleanup-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.cleanup-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.cleanup-compile))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/cleanup")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,263 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cleanup")
+(include-book "conditional-eqsubst")
+(include-book "conditional-eqsubst-all")
+(include-book "crewrite-all")
+(include-book "crewrite-first")
+(include-book "elim")
+(include-book "distribute-all")
+(include-book "fertilize")
+(include-book "generalize-all")
+(include-book "generalize-first")
+(include-book "induct")
+(include-book "split-all")
+(include-book "split-first")
+(include-book "urewrite-all")
+(include-book "urewrite-first")
+(include-book "use")
+(include-book "waterfall")
+(include-book "simple-world-change")
+(include-book "theory-change")
+(%interactive)
+
+
+
+(%autoprove |(< b d) when (= (+ a (+ b c)) d)|)
+(%autoprove |(< a c) when (= (+ a b) c)|)
+(%autoprove |(< b c) when (= (+ a b) c)|)
+
+
+
+(%autoadmit tactic.world-stepp)
+
+(%autoprove booleanp-of-tactic.world-stepp
+            (%enable default tactic.world-stepp))
+
+
+(%autoadmit tactic.world-step-okp)
+
+(%autoprove booleanp-of-tactic.world-step-okp
+            (%enable default tactic.world-step-okp))
+
+(%autoadmit tactic.worlds-okp)
+
+
+(%autoadmit tactic.compile-worlds-step)
+
+(%autoprove tactic.worldp-of-tactic.compile-worlds-step
+            (%enable default
+                     tactic.compile-worlds-step
+                     tactic.world-step-okp))
+
+(%autoprove tactic.world-atblp-of-tactic.compile-worlds-step
+            (%enable default
+                     tactic.compile-worlds-step
+                     tactic.world-step-okp))
+
+(%autoprove tactic.world-env-okp-of-tactic.compile-worlds-step
+            (%enable default
+                     tactic.compile-worlds-step
+                     tactic.world-step-okp))
+
+(%autoprove tactic.world->index-of-tactic.compile-worlds-step
+            (%enable default
+                     tactic.world-stepp
+                     tactic.compile-worlds-step
+                     tactic.simple-change-world-compile-world
+                     tactic.update-noexec-compile-world
+                     tactic.create-theory-compile-world
+                     tactic.e/d-compile-world
+                     tactic.restrict-compile-world
+                     tactic.cheapen-compile-world))
+
+
+(%autoadmit tactic.compile-worlds)
+
+(%autoprove consp-of-tactic.compile-worlds
+            (%autoinduct tactic.compile-worlds x world)
+            (%restrict default tactic.compile-worlds (equal x 'x)))
+
+(%autoprove tactic.world-listp-of-tactic.compile-worlds
+            (%autoinduct tactic.compile-worlds x world)
+            (%restrict default tactic.compile-worlds (equal x 'x))
+            (%restrict default tactic.worlds-okp (equal x 'x)))
+
+(%autoprove tactic.world-list-atblp-of-tactic.compile-worlds
+            (%autoinduct tactic.compile-worlds x world)
+            (%restrict default tactic.compile-worlds (equal x 'x))
+            (%restrict default tactic.worlds-okp (equal x 'x)))
+
+(%autoprove tactic.world-list-env-okp-of-tactic.compile-worlds
+            (%autoinduct tactic.compile-worlds x world)
+            (%restrict default tactic.compile-worlds (equal x 'x))
+            (%restrict default tactic.worlds-okp (equal x 'x)))
+
+
+(%autoadmit tactic.skeleton-step-okp)
+
+(%autoadmit tactic.skeleton-step-env-okp)
+
+(%autoprove booleanp-of-tactic.skeleton-step-okp
+            (%enable default tactic.skeleton-step-okp))
+
+(%autoprove booleanp-of-tactic.skeleton-step-env-okp
+            (%enable default tactic.skeleton-step-env-okp))
+
+
+
+(%autoadmit tactic.skeleton-length)
+
+(%autoprove natp-of-tactic.skeleton-length
+            (%autoinduct tactic.skeleton-length)
+            (%restrict default tactic.skeleton-length (equal x 'x)))
+
+(%autoprove tactic.skeleton-length-zero
+            (%autoinduct tactic.skeleton-length)
+            (%restrict default tactic.skeleton-length (equal x 'x)))
+
+(%autoprove tactic.skeleton-length-one
+            (%autoinduct tactic.skeleton-length)
+            (%restrict default tactic.skeleton-length (equal x 'x)))
+
+(%autoprove tactic.skeleton-length-of-tactic.skeleton->history
+            (%autoinduct tactic.skeleton-length)
+            (%restrict default tactic.skeleton-length (equal x 'x)))
+
+(%autoadmit tactic.compile-skeleton-step)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.skeleton-step-okp
+                 tactic.skeleton-step-env-okp
+                 tactic.compile-skeleton-step
+                 tactic.world-stepp
+                 tactic.world-step-okp))
+ (local (%disable default
+                  expensive-arithmetic-rules
+                  type-set-like-rules
+                  unusual-memberp-rules
+                  unusual-subsetp-rules
+                  memberp-when-not-consp
+                  same-length-prefixes-equal-cheap
+                  expensive-term/formula-inference
+                  formula-decomposition))
+ (%autoprove forcing-logic.appeal-listp-of-tactic.compile-skeleton-step)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.compile-skeleton-step)
+ (%autoprove forcing-logic.proof-listp-of-tactic.compile-skeleton-step))
+
+
+(%autoadmit tactic.skeleton-okp)
+
+(%autoprove booleanp-of-tactic.skeleton-okp
+            (%autoinduct tactic.skeleton-okp)
+            (%restrict default tactic.skeleton-okp (equal x 'x)))
+
+
+(%autoadmit tactic.skeleton-env-okp)
+
+(%autoprove booleanp-of-tactic.skeleton-env-okp
+            (%autoinduct tactic.skeleton-env-okp)
+            (%restrict default tactic.skeleton-env-okp (equal x 'x)))
+
+
+(%autoadmit tactic.compile-skeleton)
+
+(%autoprove forcing-logic.appeal-listp-of-tactic.compile-skeleton
+            (%autoinduct tactic.compile-skeleton)
+            (%restrict default tactic.skeleton-okp (equal x 'x))
+            (%restrict default tactic.compile-skeleton (equal x 'x)))
+
+(%autoprove forcing-logic.strip-conclusions-of-tactic.compile-skeleton
+            (%autoinduct tactic.compile-skeleton)
+            (%restrict default tactic.skeleton-okp (equal x 'x))
+            (%restrict default tactic.compile-skeleton (equal x 'x))
+            (%restrict default tactic.original-conclusions (equal x 'x)))
+
+(%autoprove forcing-logic.proof-listp-of-tactic.compile-skeleton
+            (%autoinduct tactic.compile-skeleton)
+            (%restrict default tactic.skeleton-okp (equal x 'x))
+            (%restrict default tactic.skeleton-env-okp (equal x 'x))
+            (%restrict default tactic.compile-skeleton (equal x 'x))
+            (%disable default
+                      unusual-memberp-rules
+                      memberp-when-not-consp))
+
+
+
+
+(%autoadmit tactic.compile-skeleton-okp)
+
+(%autoprove booleanp-of-tactic.compile-skeleton-okp
+            (%enable default tactic.compile-skeleton-okp))
+
+(%defprojection
+ :list (logic.appeal-list method x subproofs extras)
+ :element (logic.appeal method x subproofs extras))
+
+(%autoadmit tactic.compile-skeleton-high)
+
+(%deflist tactic.compile-skeleton-list-okp (x worlds axioms thms atbl)
+  (tactic.compile-skeleton-okp x worlds axioms thms atbl))
+
+(%autoprove tactic.compile-skeleton-list-okp-of-logic.appeal-list
+            (%cdr-induction conclusions)
+            (%enable default tactic.compile-skeleton-okp))
+
+(%autoprove tactic.compile-skeleton-list-okp-of-tactic.compile-skeleton-high
+            (%enable default tactic.compile-skeleton-high))
+
+(encapsulate
+ ()
+ (local (%enable default tactic.compile-skeleton-okp))
+ (%autoprove tactic.compile-skeleton-okp-of-logic.appeal-identity)
+ (%autoprove lemma-1-for-soundness-of-tactic.compile-skeleton-okp)
+ (%autoprove lemma-2-for-soundness-of-tactic.compile-skeleton-okp)
+ (%autoprove forcing-soundness-of-tactic.compile-skeleton-okp
+             (%use (%instance (%thm lemma-1-for-soundness-of-tactic.compile-skeleton-okp)))
+             (%use (%instance (%thm lemma-2-for-soundness-of-tactic.compile-skeleton-okp)))
+             (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                              (x (let* ((skelly     (logic.extras x))
+                                        (in-proofs  (logic.provable-list-witness
+                                                     (logic.strip-conclusions (logic.subproofs x))
+                                                     axioms thms atbl))
+                                        (out-proofs (tactic.compile-skeleton skelly worlds in-proofs)))
+                                   (logic.find-proof (logic.conclusion x) out-proofs)))))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/compiler")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/conditional-eqsubst-all.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/conditional-eqsubst-all.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/conditional-eqsubst-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/conditional-eqsubst-all.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,390 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "conditional-eqsubst")
+(%interactive)
+
+
+(%autoadmit tactic.conditional-eqsubst-all-okp)
+(%autoadmit tactic.conditional-eqsubst-all-env-okp)
+
+(%autoprove booleanp-of-tactic.conditional-eqsubst-all-okp
+            (%enable default tactic.conditional-eqsubst-all-okp))
+
+(%autoprove booleanp-of-tactic.conditional-eqsubst-all-env-okp
+            (%enable default tactic.conditional-eqsubst-all-env-okp))
+
+(defthm forcing-logic.term-list-list-atblp-of-multicons
+  ;; BOZO unlocalize
+  (implies (force (and (logic.term-atblp a atbl)
+                       (logic.term-list-list-atblp x atbl)))
+           (equal (logic.term-list-list-atblp (multicons a x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-multicons
+            (%cdr-induction x))
+
+
+(%autoadmit tactic.conditional-eqsubst-all-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.conditional-eqsubst-all-tac
+            (%enable default tactic.conditional-eqsubst-all-tac))
+
+(%autoprove forcing-tactic.conditional-eqsubst-all-okp-of-tactic.conditional-eqsubst-all-tac
+            (%enable default
+                     tactic.conditional-eqsubst-all-tac
+                     tactic.conditional-eqsubst-all-okp))
+
+(%autoprove forcing-tactic.conditional-eqsubst-all-env-okp-of-tactic.conditional-eqsubst-all-tac
+            (%enable default
+                     tactic.conditional-eqsubst-all-tac
+                     tactic.conditional-eqsubst-all-env-okp))
+
+
+(%autoadmit tactic.conditional-eqsubst-list-bldr)
+
+(encapsulate
+ ()
+ (defthmd lemma-1-for-tactic.conditional-eqsubst-list-bldr
+   (implies (not (consp orig-goals))
+            (equal (TACTIC.CONDITIONAL-EQSUBST-LIST-BLDR P ORIG-GOALS PROOF1 PROOFS2 PROOFS3 LHS RHS)
+                   nil))
+   :hints(("Goal" :in-theory (enable TACTIC.CONDITIONAL-EQSUBST-LIST-BLDR))))
+
+ (defthmd lemma-2-for-tactic.conditional-eqsubst-list-bldr
+   (equal (TACTIC.CONDITIONAL-EQSUBST-LIST-BLDR P (cons a ORIG-GOALS) PROOF1 PROOFS2 PROOFS3 LHS RHS)
+          (CONS (TACTIC.CONDITIONAL-EQSUBST-BLDR P a
+                                                 PROOF1 (CAR PROOFS2)
+                                                 (CAR PROOFS3)
+                                                 LHS RHS)
+                (TACTIC.CONDITIONAL-EQSUBST-LIST-BLDR P ORIG-GOALS
+                                                      PROOF1 (CDR PROOFS2)
+                                                      (CDR PROOFS3)
+                                                      LHS RHS)))
+   :hints(("Goal" :in-theory (enable tactic.conditional-eqsubst-list-bldr))))
+
+ (%autoprove lemma-1-for-tactic.conditional-eqsubst-list-bldr
+             (%restrict default TACTIC.CONDITIONAL-EQSUBST-LIST-BLDR (equal orig-goals 'orig-goals)))
+
+ (%autoprove lemma-2-for-tactic.conditional-eqsubst-list-bldr
+             (%restrict default TACTIC.CONDITIONAL-EQSUBST-LIST-BLDR (equal orig-goals '(cons a orig-goals))))
+
+ (local (%enable default
+                 lemma-1-for-tactic.conditional-eqsubst-list-bldr
+                 lemma-2-for-tactic.conditional-eqsubst-list-bldr))
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.conditional-eqsubst-list-bldr
+             (%autoinduct tactic.conditional-eqsubst-list-bldr))
+
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.conditional-eqsubst-list-bldr
+             (%autoinduct tactic.conditional-eqsubst-list-bldr))
+
+ (%autoprove forcing-logic.proof-listp-of-tactic.conditional-eqsubst-list-bldr
+             (%autoinduct tactic.conditional-eqsubst-list-bldr)))
+
+
+
+
+
+(encapsulate
+ ()
+ (set-well-founded-relation ord<)
+ (set-measure-function rank)
+ (defun firstn-firstn-induct (n x y)
+   (declare (xargs :measure (nfix n)))
+   (if (zp n)
+       nil
+     (if (not (consp x))
+         nil
+       (if (not (consp y))
+           nil
+         (firstn-firstn-induct (- n 1) (cdr x) (cdr y)))))))
+
+(defthm lemma-0-for-tactic.conditional-eqsubst-all-compile
+  ;; NOTE: switched order of 1/len x, inc blimit to 1
+  (implies (not (cdr x))
+           (equal (equal 1 (len x))
+                  (consp x)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm lemma-1-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                  (logic.strip-conclusions proofs))
+           (equal (logic.conclusion (first proofs))
+                  (logic.disjoin-formulas (logic.term-list-formulas (car goals))))))
+
+(defthm lemma-2-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                  (logic.strip-conclusions proofs))
+           (equal (logic.strip-conclusions (firstn n proofs))
+                  (logic.disjoin-each-formula-list (logic.term-list-list-formulas (firstn n goals)))))
+  :hints(("Goal" :in-theory (enable firstn))))
+
+(defthm lemma-3-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                  (logic.strip-conclusions proofs))
+           (equal (logic.strip-conclusions (restn n proofs))
+                  (logic.disjoin-each-formula-list (logic.term-list-list-formulas (restn n goals)))))
+  :hints(("Goal" :in-theory (enable restn))))
+
+(defthm lemma-4-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                  (logic.strip-conclusions proofs))
+           (equal (logic.strip-conclusions (firstn n (cdr proofs)))
+                  (logic.disjoin-each-formula-list (logic.term-list-list-formulas (firstn n (cdr goals)))))))
+
+(defthm lemma-5-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                  (logic.strip-conclusions proofs))
+           (equal (logic.strip-conclusions (restn n (cdr proofs)))
+                  (logic.disjoin-each-formula-list (logic.term-list-list-formulas (restn n (cdr goals)))))))
+
+(defthm lemma-6-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (app a b) x)
+           (equal (firstn (len a) x)
+                  (list-fix a))))
+
+(defthm lemma-7-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (app a b) x)
+           (equal (restn (len a) x)
+                  (list-fix b))))
+
+(defthm lemma-8-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (app a (app b c)) x)
+           (equal (firstn (len b) (restn (len a) x))
+                  (list-fix b))))
+
+(defthm lemma-9-for-tactic.conditional-eqsubst-all-compile
+  (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                  (logic.strip-conclusions proofs))
+           (equal (consp proofs)
+                  (consp goals))))
+
+(defthm lemma-10-for-tactic.conditional-eqsubst-all-compile
+  (implies (EQUAL (APP (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))) Y)
+                  (CDR (TACTIC.SKELETON->GOALS X)))
+           (EQUAL (FIRSTN (LEN (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X)))
+                          (CDR (TACTIC.SKELETON->GOALS X)))
+                  (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X))
+                             (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X)))))
+  :hints(("Goal" :use ((:instance lemma-6-for-tactic.conditional-eqsubst-all-compile
+                                  (a (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))))
+                                  (b y)
+                                  (x (CDR (TACTIC.SKELETON->GOALS X))))))))
+
+(defthm lemma-11-for-tactic.conditional-eqsubst-all-compile
+  (implies (EQUAL (APP (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))) Y)
+                  (CDR (TACTIC.SKELETON->GOALS X)))
+           (EQUAL (RESTN (LEN (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X)))
+                         (CDR (TACTIC.SKELETON->GOALS X)))
+                  (list-fix Y)))
+  :hints(("Goal" :use ((:instance lemma-7-for-tactic.conditional-eqsubst-all-compile
+                                  (a (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))))
+                                  (b y)
+                                  (x (CDR (TACTIC.SKELETON->GOALS X))))))))
+
+(defthm lemma-12-for-tactic.conditional-eqsubst-all-compile
+  (implies (cons-listp x)
+           (LOGIC.ALL-DISJUNCTIONSP (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (MULTICONS a x)))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm lemma-13-for-tactic.conditional-eqsubst-all-compile
+  (implies (cons-listp x)
+           (equal (LOGIC.VLHSES (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (MULTICONS a x))))
+                  (repeat (logic.term-formula a) (len x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm lemma-14-for-tactic.conditional-eqsubst-all-compile
+  (implies (cons-listp x)
+           (equal (LOGIC.VRHSES (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (MULTICONS a x))))
+                  (logic.disjoin-each-formula-list (logic.term-list-list-formulas x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+
+
+(%autoprove lemma-0-for-tactic.conditional-eqsubst-all-compile)
+(%autoprove lemma-1-for-tactic.conditional-eqsubst-all-compile)
+
+
+(%autoprove lemma-2-for-tactic.conditional-eqsubst-all-compile
+            (%autoinduct firstn-firstn-induct n proofs goals)
+            (%forcingp nil)
+            (%restrict default firstn (equal n 'n)))
+
+(%autoprove lemma-3-for-tactic.conditional-eqsubst-all-compile
+            (%autoinduct firstn-firstn-induct n proofs goals)
+            (%forcingp nil)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove lemma-4-for-tactic.conditional-eqsubst-all-compile)
+(%autoprove lemma-5-for-tactic.conditional-eqsubst-all-compile)
+(%autoprove lemma-6-for-tactic.conditional-eqsubst-all-compile)
+(%autoprove lemma-7-for-tactic.conditional-eqsubst-all-compile)
+(%autoprove lemma-8-for-tactic.conditional-eqsubst-all-compile)
+(%autoprove lemma-9-for-tactic.conditional-eqsubst-all-compile)
+
+(%autoprove lemma-10-for-tactic.conditional-eqsubst-all-compile
+            (%use (%instance (%thm lemma-6-for-tactic.conditional-eqsubst-all-compile)
+                             (a (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))))
+                             (b y)
+                             (x (CDR (TACTIC.SKELETON->GOALS X))))))
+
+(%autoprove lemma-11-for-tactic.conditional-eqsubst-all-compile
+            (%use (%instance (%thm lemma-7-for-tactic.conditional-eqsubst-all-compile)
+                             (a (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))))
+                             (b y)
+                             (x (CDR (TACTIC.SKELETON->GOALS X))))))
+
+(%autoprove lemma-12-for-tactic.conditional-eqsubst-all-compile
+            (%cdr-induction x))
+
+(%autoprove lemma-13-for-tactic.conditional-eqsubst-all-compile
+            (%cdr-induction x))
+
+(%autoprove lemma-14-for-tactic.conditional-eqsubst-all-compile
+            (%cdr-induction x)
+            (%forcingp nil))
+
+
+(%autoadmit tactic.conditional-eqsubst-all-compile)
+
+(local (%enable default
+                tactic.conditional-eqsubst-all-okp
+                tactic.conditional-eqsubst-all-env-okp
+                tactic.conditional-eqsubst-all-compile
+                logic.term-formula))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 unusual-memberp-rules
+                 unusual-subsetp-rules
+                 type-set-like-rules))
+
+(%autoprove forcing-logic.appeal-listp-of-tactic.conditional-eqsubst-all-compile
+
+            (%forcingp nil)
+            (%auto :strategy (cleanup split urewrite))
+
+            (%car-cdr-elim proofs)
+            (%crewrite default first)
+            (%generalize (car proofs) proof1)
+            (%generalize (cdr proofs) proofs2)
+            (%auto :strategy (cleanup split urewrite crewrite dist))
+
+            (%disable default
+                      expensive-term/formula-inference
+                      formula-decomposition)
+
+            (%forcingp t)
+            (%waterfall default 40))
+
+(%autoprove forcing-logic.strip-conclusions-of-tactic.conditional-eqsubst-all-compile
+
+            (%forcingp nil)
+            (%auto :strategy (cleanup split urewrite))
+
+            (%car-cdr-elim proofs)
+            (%crewrite default first)
+            (%generalize (car proofs) proof1)
+            (%generalize (cdr proofs) proofs2)
+            (%auto :strategy (cleanup split urewrite crewrite dist))
+
+            (%disable default
+                      expensive-term/formula-inference
+                      formula-decomposition)
+
+            (%forcingp t)
+            (%waterfall default 40))
+
+
+(%autoprove forcing-logic.proof-listp-of-tactic.conditional-eqsubst-all-compile
+
+            (%forcingp nil)
+            (%auto :strategy (cleanup split urewrite))
+
+            (%car-cdr-elim proofs)
+            (%crewrite default first)
+            (%generalize (car proofs) proof1)
+            (%generalize (cdr proofs) proofs2)
+            (%auto :strategy (cleanup split urewrite crewrite dist))
+
+            (%disable default
+                      expensive-term/formula-inference
+                      formula-decomposition)
+
+            (%forcingp t)
+            (%waterfall default 40))
+
+
+(in-theory (disable lemma-0-for-tactic.conditional-eqsubst-all-compile
+                    lemma-1-for-tactic.conditional-eqsubst-all-compile
+                    lemma-2-for-tactic.conditional-eqsubst-all-compile
+                    lemma-3-for-tactic.conditional-eqsubst-all-compile
+                    lemma-4-for-tactic.conditional-eqsubst-all-compile
+                    lemma-5-for-tactic.conditional-eqsubst-all-compile
+                    lemma-6-for-tactic.conditional-eqsubst-all-compile
+                    lemma-7-for-tactic.conditional-eqsubst-all-compile
+                    lemma-8-for-tactic.conditional-eqsubst-all-compile
+                    lemma-9-for-tactic.conditional-eqsubst-all-compile
+                    lemma-10-for-tactic.conditional-eqsubst-all-compile
+                    lemma-11-for-tactic.conditional-eqsubst-all-compile
+                    lemma-12-for-tactic.conditional-eqsubst-all-compile
+                    lemma-13-for-tactic.conditional-eqsubst-all-compile
+                    lemma-14-for-tactic.conditional-eqsubst-all-compile))
+
+(%disable default
+          lemma-0-for-tactic.conditional-eqsubst-all-compile
+          lemma-1-for-tactic.conditional-eqsubst-all-compile
+          lemma-2-for-tactic.conditional-eqsubst-all-compile
+          lemma-3-for-tactic.conditional-eqsubst-all-compile
+          lemma-4-for-tactic.conditional-eqsubst-all-compile
+          lemma-5-for-tactic.conditional-eqsubst-all-compile
+          lemma-6-for-tactic.conditional-eqsubst-all-compile
+          lemma-7-for-tactic.conditional-eqsubst-all-compile
+          lemma-8-for-tactic.conditional-eqsubst-all-compile
+          lemma-9-for-tactic.conditional-eqsubst-all-compile
+          lemma-10-for-tactic.conditional-eqsubst-all-compile
+          lemma-11-for-tactic.conditional-eqsubst-all-compile
+          lemma-12-for-tactic.conditional-eqsubst-all-compile
+          lemma-13-for-tactic.conditional-eqsubst-all-compile
+          lemma-14-for-tactic.conditional-eqsubst-all-compile)
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/conditional-eqsubst-all")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/conditional-eqsubst.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/conditional-eqsubst.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/conditional-eqsubst.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/conditional-eqsubst.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,240 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(include-book "replace-subterm")
+(%interactive)
+
+(%autoadmit tactic.conditional-eqsubst-okp)
+(%autoadmit tactic.conditional-eqsubst-env-okp)
+
+(%autoprove booleanp-of-tactic.conditional-eqsubst-okp
+            (%enable default tactic.conditional-eqsubst-okp))
+
+(%autoprove booleanp-of-tactic.conditional-eqsubst-env-okp
+            (%enable default tactic.conditional-eqsubst-env-okp))
+
+
+
+(%autoadmit tactic.conditional-eqsubst-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.conditional-eqsubst-tac
+            (%enable default tactic.conditional-eqsubst-tac))
+
+(%autoprove forcing-tactic.conditional-eqsubst-okp-of-tactic.conditional-eqsubst-tac
+            (%enable default
+                     tactic.conditional-eqsubst-tac
+                     tactic.conditional-eqsubst-okp))
+
+(%autoprove forcing-tactic.conditional-eqsubst-env-okp-of-tactic.conditional-eqsubst-tac
+            (%enable default
+                     tactic.conditional-eqsubst-tac
+                     tactic.conditional-eqsubst-env-okp))
+
+
+;; BOZO consider moving to level4 or something?
+(%defderiv tactic.conditional-eqsubst-lemma1)
+
+
+
+
+(%autoadmit tactic.conditional-eqsubst-bldr)
+
+(encapsulate
+ ()
+ (local (%enable default tactic.conditional-eqsubst-bldr))
+ (%autoprove tactic.conditional-eqsubst-bldr-under-iff)
+ (%autoprove forcing-logic.appealp-of-tactic.conditional-eqsubst-bldr)
+ (%autoprove forcing-logic.conclusion-of-tactic.conditional-eqsubst-bldr)
+ (%autoprove forcing-logic.proofp-of-tactic.conditional-eqsubst-bldr))
+
+
+
+
+
+
+;; BOZO unlocalize/rename these in tactics/conditional-eqsubst.lisp
+
+(defthmd crock1-for-tactic.conditional-eqsubst-compile
+  (implies (equal (clause.clause-list-formulas goals) (logic.strip-conclusions proofs))
+           (equal (logic.conclusion (first proofs))
+                  (clause.clause-formula (first goals)))))
+
+(defthmd crock2-for-tactic.conditional-eqsubst-compile
+  (implies (equal (clause.clause-list-formulas goals) (logic.strip-conclusions proofs))
+           (equal (logic.conclusion (second proofs))
+                  (clause.clause-formula (second goals)))))
+
+(defthmd crock3-for-tactic.conditional-eqsubst-compile
+  (implies (equal (clause.clause-list-formulas goals) (logic.strip-conclusions proofs))
+           (equal (logic.conclusion (third proofs))
+                  (clause.clause-formula (third goals)))))
+
+(defthmd crock4-for-tactic.conditional-eqsubst-compile
+  ;; NOTE reordered equality to match term order
+  (implies (not (cdr x))
+           (equal (equal 1 (len x))
+                  (consp x)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(%autoprove crock1-for-tactic.conditional-eqsubst-compile)
+(%autoprove crock2-for-tactic.conditional-eqsubst-compile)
+(%autoprove crock3-for-tactic.conditional-eqsubst-compile)
+(%autoprove crock4-for-tactic.conditional-eqsubst-compile)
+
+
+(%autoadmit tactic.conditional-eqsubst-compile)
+
+(local (%enable default
+                tactic.conditional-eqsubst-okp
+                tactic.conditional-eqsubst-env-okp
+                tactic.conditional-eqsubst-compile
+                logic.term-formula))
+
+(local (%enable default
+                crock1-for-tactic.conditional-eqsubst-compile
+                crock2-for-tactic.conditional-eqsubst-compile
+                crock3-for-tactic.conditional-eqsubst-compile
+                crock4-for-tactic.conditional-eqsubst-compile))
+
+(%autoprove forcing-logic.appeal-listp-of-tactic.conditional-eqsubst-compile
+
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      unusual-memberp-rules
+                      unusual-consp-rules
+                      unusual-subsetp-rules
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      same-length-prefixes-equal-cheap)
+
+            (%waterfall default 40)
+
+            (%restrict default logic.strip-conclusions
+                       (or (equal x 'proofs)
+                           (equal x '(cdr proofs))
+                           (equal x '(cdr (cdr proofs)))))
+
+            (%restrict default definition-of-logic.appeal-listp
+                       (or (equal x 'proofs)
+                           (equal x '(cdr proofs))
+                           (equal x '(cdr (cdr proofs)))))
+
+            (%waterfall default 40)
+
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference
+                     unusual-consp-rules)
+            (%auto :strategy (cleanup split urewrite crewrite)))
+
+
+(%autoprove forcing-logic.strip-conclusions-of-tactic.conditional-eqsubst-compile
+
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      unusual-memberp-rules
+                      unusual-consp-rules
+                      unusual-subsetp-rules
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      same-length-prefixes-equal-cheap)
+
+            (%waterfall default 40)
+
+            (%restrict default logic.strip-conclusions
+                       (or (equal x 'proofs)
+                           (equal x '(cdr proofs))
+                           (equal x '(cdr (cdr proofs)))))
+
+            (%restrict default definition-of-logic.appeal-listp
+                       (or (equal x 'proofs)
+                           (equal x '(cdr proofs))
+                           (equal x '(cdr (cdr proofs)))))
+
+            (%waterfall default 40)
+
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference
+                     unusual-consp-rules)
+            (%auto :strategy (cleanup split urewrite crewrite)))
+
+
+
+(%autoprove forcing-logic.proof-listp-of-tactic.conditional-eqsubst-compile
+
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      unusual-memberp-rules
+                      unusual-consp-rules
+                      unusual-subsetp-rules
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      same-length-prefixes-equal-cheap)
+
+            (%waterfall default 40)
+
+            (%restrict default logic.strip-conclusions
+                       (or (equal x 'proofs)
+                           (equal x '(cdr proofs))
+                           (equal x '(cdr (cdr proofs)))))
+
+            (%restrict default definition-of-logic.appeal-listp
+                       (or (equal x 'proofs)
+                           (equal x '(cdr proofs))
+                           (equal x '(cdr (cdr proofs)))))
+
+            (%restrict default definition-of-logic.proof-listp
+                       (or (equal x 'proofs)
+                           (equal x '(cdr proofs))
+                           (equal x '(cdr (cdr proofs)))))
+
+            (%waterfall default 40)
+
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference
+                     unusual-consp-rules)
+            (%auto :strategy (cleanup split urewrite crewrite)))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/conditional-eqsubst")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/crewrite-all.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/crewrite-all.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/crewrite-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/crewrite-all.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,161 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(include-book "elim") ;; BOZO for strip-conclusions-of-restn
+(%interactive)
+
+
+(%autoadmit tactic.crewrite-all-okp)
+
+(%autoprove booleanp-of-tactic.crewrite-all-okp
+            (%enable default tactic.crewrite-all-okp))
+
+
+(%autoadmit tactic.crewrite-all-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.crewrite-all-tac
+            (%enable default tactic.crewrite-all-tac))
+
+(%autoprove forcing-tactic.crewrite-all-okp-of-tactic.crewrite-all-tac
+            (%enable default
+                     tactic.crewrite-all-tac
+                     tactic.crewrite-all-okp))
+
+(%autoadmit tactic.crewrite-all-compile)
+
+(local (%enable default
+                tactic.crewrite-all-okp
+                tactic.crewrite-all-compile))
+
+
+(%autoprove forcing-logic.appeal-listp-of-tactic.crewrite-all-compile
+            (%auto)
+            (%generalize (car (cdr (tatic.skeleton->extras x))) plans)
+            (%generalize (tactic.skeleton->goals x) goals)
+            (%auto)
+            (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                        (APP
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (RW.CREWRITE-CLAUSE-PLAN-LIST->CLAUSES-PRIME
+                            (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CLAUSE.MAKE-CLAUSES-FROM-ARBITRARY-FORMULAS
+                            (REMOVE-DUPLICATES
+                             (RW.CREWRITE-CLAUSE-PLAN-LIST->FORCED-GOALS
+                              (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))))))
+            (%auto)
+            (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                        (APP
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (RW.CREWRITE-CLAUSE-PLAN-LIST->CLAUSES-PRIME
+                            (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CLAUSE.MAKE-CLAUSES-FROM-ARBITRARY-FORMULAS
+                            (REMOVE-DUPLICATES
+                             (RW.CREWRITE-CLAUSE-PLAN-LIST->FORCED-GOALS
+                              (CAR (CDR (TACTIC.SKELETON->EXTRAS X)))))))))))
+
+(%autoprove forcing-logic.strip-conclusions-of-tactic.crewrite-all-compile
+            (%auto)
+            (%generalize (car (cdr (tatic.skeleton->extras x))) plans)
+            (%generalize (tactic.skeleton->goals x) goals)
+            (%auto)
+            (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                        (APP
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (RW.CREWRITE-CLAUSE-PLAN-LIST->CLAUSES-PRIME
+                            (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CLAUSE.MAKE-CLAUSES-FROM-ARBITRARY-FORMULAS
+                            (REMOVE-DUPLICATES
+                             (RW.CREWRITE-CLAUSE-PLAN-LIST->FORCED-GOALS
+                              (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))))))
+            (%auto)
+            (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                        (APP
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (RW.CREWRITE-CLAUSE-PLAN-LIST->CLAUSES-PRIME
+                            (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CLAUSE.MAKE-CLAUSES-FROM-ARBITRARY-FORMULAS
+                            (REMOVE-DUPLICATES
+                             (RW.CREWRITE-CLAUSE-PLAN-LIST->FORCED-GOALS
+                              (CAR (CDR (TACTIC.SKELETON->EXTRAS X)))))))))))
+
+(%autoprove forcing-logic.proof-listp-of-tactic.crewrite-all-compile
+            (%disable default
+                      unusual-memberp-rules
+                      memberp-when-not-consp
+                      MEMBERP-WHEN-MEMBERP-OF-CDR)
+            (%auto)
+            (%generalize (car (cdr (tatic.skeleton->extras x))) plans)
+            (%generalize (tactic.skeleton->goals x) goals)
+            (%auto)
+            (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                        (APP
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (RW.CREWRITE-CLAUSE-PLAN-LIST->CLAUSES-PRIME
+                            (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CLAUSE.MAKE-CLAUSES-FROM-ARBITRARY-FORMULAS
+                            (REMOVE-DUPLICATES
+                             (RW.CREWRITE-CLAUSE-PLAN-LIST->FORCED-GOALS
+                              (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))))))
+            (%auto)
+            (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                        (APP
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (RW.CREWRITE-CLAUSE-PLAN-LIST->CLAUSES-PRIME
+                            (CAR (CDR (TACTIC.SKELETON->EXTRAS X))))))
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CLAUSE.MAKE-CLAUSES-FROM-ARBITRARY-FORMULAS
+                            (REMOVE-DUPLICATES
+                             (RW.CREWRITE-CLAUSE-PLAN-LIST->FORCED-GOALS
+                              (CAR (CDR (TACTIC.SKELETON->EXTRAS X)))))))))))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/crewrite-all")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/crewrite-first.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/crewrite-first.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/crewrite-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/crewrite-first.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,114 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(include-book "elim") ;; bozo for strip-conclusions-of-restn, etc.
+(%interactive)
+
+
+
+(%autoadmit tactic.crewrite-first-okp)
+
+(%autoprove booleanp-of-tactic.crewrite-first-okp
+            (%enable default tactic.crewrite-first-okp))
+
+
+(%autoadmit tactic.crewrite-first-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.crewrite-first-tac
+            (%enable default tactic.crewrite-first-tac))
+
+(%autoprove forcing-tactic.crewrite-first-okp-of-tactic.crewrite-first-tac
+            (%enable default
+                     tactic.crewrite-first-tac
+                     tactic.crewrite-first-okp))
+
+
+(%autoadmit tactic.crewrite-first-compile)
+
+(local (%enable default
+                tactic.crewrite-first-okp
+                tactic.crewrite-first-compile))
+
+(%autoprove forcing-logic.appeal-listp-of-tactic.crewrite-first-compile
+            (%auto :strategy (cleanup split urewrite))
+            (%generalize (car (cdr (tactic.skeleton->extras x))) plan)
+            (%generalize (tactic.skeleton->goals x) goals)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%enable default dangerous-decomposition-of-app)
+            (%auto))
+
+(%autoprove forcing-logic.strip-conclusions-of-tactic.crewrite-first-compile
+            (%auto :strategy (cleanup split urewrite))
+            (%generalize (car (cdr (tactic.skeleton->extras x))) plan)
+            (%generalize (tactic.skeleton->goals x) goals)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%enable default dangerous-decomposition-of-app)
+            (%auto))
+
+(%autoprove forcing-logic.proof-listp-of-tactic.crewrite-first-compile
+            (%disable default
+                      unusual-memberp-rules
+                      memberp-when-not-consp
+                      MEMBERP-WHEN-MEMBERP-OF-CDR)
+            (%auto)
+            (%generalize (car (cdr (tactic.skeleton->extras x))) plan)
+            (%generalize (tactic.skeleton->goals x) goals)
+            (%auto)
+
+            (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                        (APP
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CDR (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X)))))
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CLAUSE.MAKE-CLAUSES-FROM-ARBITRARY-FORMULAS
+                            (RW.CREWRITE-CLAUSE-PLAN->FORCED-GOALS PLAN))))))
+            (%auto)
+
+            (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS2)
+                        (APP
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CDR (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X)))))
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS
+                           (CLAUSE.MAKE-CLAUSES-FROM-ARBITRARY-FORMULAS
+                            (RW.CREWRITE-CLAUSE-PLAN->FORCED-GOALS PLAN))))))
+            (%auto))
+
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/crewrite-first")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/distribute-all.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/distribute-all.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/distribute-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/distribute-all.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,195 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fertilize")
+(%interactive)
+
+(encapsulate
+ ()
+ (%autoadmit distribute.type1-literalp)
+ (%autoadmit distribute.type1-var)
+ (%autoadmit distribute.type1-expr)
+ (%autoadmit distribute.substitute-type1-literal)
+ (%autoadmit distribute.substitute-type1-literal-bldr)
+
+ (local (%enable default
+                 distribute.substitute-type1-literal-bldr
+                 distribute.substitute-type1-literal
+                 distribute.type1-literalp
+                 distribute.type1-var
+                 distribute.type1-expr))
+
+ (%autoprove booleanp-of-distribute.type1-literalp)
+ (%autoprove cons-listp-of-distribute.substitute-type1-literal)
+ (%autoprove forcing-logic.term-listp-of-distribute.substitute-type1-literal)
+ (%autoprove forcing-logic.term-list-atblp-of-distribute.substitute-type1-literal)
+ (%autoprove distribute.substitute-type1-literal-bldr-under-iff)
+ (%autoprove forcing-logic.appealp-of-distribute.substitute-type1-literal-bldr)
+ (%autoprove forcing-logic.conclusion-of-distribute.substitute-type1-literal-bldr)
+ (%autoprove forcing-logic.proofp-of-distribute.substitute-type1-literal-bldr))
+
+
+(encapsulate
+ ()
+ (%autoadmit distribute.type2-literalp)
+ (%autoadmit distribute.type2-var)
+ (%autoadmit distribute.type2-expr)
+ (%autoadmit distribute.substitute-type2-literal)
+ (%autoadmit distribute.substitute-type2-literal-bldr)
+
+ (local (%enable default
+                 distribute.type2-literalp
+                 distribute.type2-var
+                 distribute.type2-expr
+                 distribute.substitute-type2-literal
+                 distribute.substitute-type2-literal-bldr))
+
+ (%autoprove booleanp-of-distribute.type2-literalp)
+ (%autoprove cons-listp-of-distribute.substitute-type2-literal)
+ (%autoprove forcing-logic.term-listp-of-distribute.substitute-type2-literal)
+ (%autoprove forcing-logic.term-list-atblp-of-distribute.substitute-type2-literal)
+ (%autoprove distribute.substitute-type2-literal-bldr-under-iff)
+ (%autoprove forcing-logic.appealp-of-distribute.substitute-type2-literal-bldr)
+ (%autoprove forcing-logic.conclusion-of-distribute.substitute-type2-literal-bldr)
+ (%autoprove forcing-logic.proofp-of-distribute.substitute-type2-literal-bldr))
+
+
+
+(encapsulate
+ ()
+ (%autoadmit distribute.find-type1-literal)
+
+ (%autoprove distribute.type1-literalp-of-distribute.find-type1-literal
+             (%autoinduct distribute.find-type1-literal)
+             (%restrict default distribute.find-type1-literal (equal x 'x)))
+
+ (%autoprove forcing-logic.termp-of-distribute.find-type1-literal
+             (%autoinduct distribute.find-type1-literal)
+             (%restrict default distribute.find-type1-literal (equal x 'x)))
+
+ (%autoprove memberp-of-distribute.find-type1-literal
+             (%autoinduct distribute.find-type1-literal)
+             (%restrict default distribute.find-type1-literal (equal x 'x))))
+
+(encapsulate
+ ()
+ (%autoadmit distribute.find-type2-literal)
+
+ (%autoprove distribute.type2-literalp-of-distribute.find-type2-literal
+             (%autoinduct distribute.find-type2-literal)
+             (%restrict default distribute.find-type2-literal (equal x 'x)))
+
+ (%autoprove forcing-logic.termp-of-distribute.find-type2-literal
+             (%autoinduct distribute.find-type2-literal)
+             (%restrict default distribute.find-type2-literal (equal x 'x)))
+
+ (%autoprove memberp-of-distribute.find-type2-literal
+             (%autoinduct distribute.find-type2-literal)
+             (%restrict default distribute.find-type2-literal (equal x 'x))))
+
+
+(encapsulate
+ ()
+ (%autoadmit distribute.try-distributing-clause)
+ (%autoadmit distribute.try-distributing-clause-bldr)
+ (local (%enable default
+                 distribute.try-distributing-clause
+                 distribute.try-distributing-clause-bldr))
+ (%autoprove consp-of-distribute.try-distributing-clause)
+ (%autoprove forcing-logic.term-listp-of-distribute.try-distributing-clause)
+ (%autoprove forcing-logic.term-list-atblp-of-distribute.try-distributing-clause)
+ (%autoprove distribute.try-distributing-clause-bldr-under-iff)
+ (%autoprove forcing-logic.appealp-of-distribute.try-distributing-clause-bldr)
+ (%autoprove forcing-logic.conclusion-of-distribute.try-distributing-clause-bldr)
+ (%autoprove forcing-logic.proofp-of-distribute.try-distributing-clause-bldr))
+
+
+(%defprojection
+ :list (distribute.try-distributing-clause-list x)
+ :element (distribute.try-distributing-clause x))
+
+(%autoprove cons-listp-of-distribute.try-distributing-clause-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-listp-of-distribute.try-distributing-clause-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-distribute.try-distributing-clause-list
+            (%cdr-induction x))
+
+
+(encapsulate
+ ()
+ (%autoadmit distribute.try-distributing-clause-list-bldr)
+ (%autoprove forcing-logic.appeal-listp-of-distribute.try-distributing-clause-list-bldr
+             (%autoinduct distribute.try-distributing-clause-list-bldr)
+             (%restrict default distribute.try-distributing-clause-list-bldr (equal x 'x)))
+ (%autoprove forcing-logic.strip-conclusions-of-distribute.try-distributing-clause-list-bldr
+             (%autoinduct distribute.try-distributing-clause-list-bldr)
+             (%restrict default distribute.try-distributing-clause-list-bldr (equal x 'x)))
+ (%autoprove forcing-logic.proof-listp-of-distribute.try-distributing-clause-list-bldr
+             (%autoinduct distribute.try-distributing-clause-list-bldr)
+             (%restrict default distribute.try-distributing-clause-list-bldr (equal x 'x))))
+
+
+(%autoadmit tactic.distribute-all-okp)
+
+(%autoprove booleanp-of-tactic.distribute-all-okp
+            (%enable default tactic.distribute-all-okp))
+
+
+(%autoadmit tactic.distribute-all-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.distribute-all-tac
+            (%enable default tactic.distribute-all-tac))
+
+(%autoprove forcing-tactic.distribute-all-okp-of-tactic.distribute-all-tac
+            (%enable default
+                     tactic.distribute-all-tac
+                     tactic.distribute-all-okp))
+
+
+
+(encapsulate
+ ()
+ (%autoadmit tactic.distribute-all-compile)
+ (local (%enable default
+                 tactic.distribute-all-okp
+                 tactic.distribute-all-compile))
+ (%autoprove forcing-logic.appeal-listp-of-tactic.distribute-all-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.distribute-all-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.distribute-all-compile))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/distribute-all")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/elim.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/elim.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/elim.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/elim.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,423 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "conditional-eqsubst")
+(%interactive)
+
+
+(defthm logic.strip-conclusions-of-restn
+  ;; BOZO this seems to address some of the firstn/restn issues.  Move it where it
+  ;; belongs and try using it globally.
+  (equal (logic.strip-conclusions (restn n x))
+         (restn n (logic.strip-conclusions x))))
+
+(in-theory (disable restn-of-logic.strip-conclusions))
+
+(ACL2::theory-invariant (ACL2::incompatible (:rewrite logic.strip-conclusions-of-restn)
+                                            (:rewrite restn-of-logic.strip-conclusions)))
+
+(%autoprove logic.strip-conclusions-of-restn)
+(%disable default
+          restn-of-logic.strip-conclusions
+          [outside]restn-of-logic.strip-conclusions)
+
+
+(defthm logic.strip-conclusions-of-firstn
+  ;; BOZO this seems to address some of the firstn/restn issues.  Move it where it
+  ;; belongs and try using it globally.
+  (equal (logic.strip-conclusions (firstn n x))
+         (firstn n (logic.strip-conclusions x))))
+
+(in-theory (disable firstn-of-logic.strip-conclusions))
+
+(ACL2::theory-invariant (ACL2::incompatible (:rewrite logic.strip-conclusions-of-firstn)
+                                            (:rewrite firstn-of-logic.strip-conclusions)))
+
+(%autoprove logic.strip-conclusions-of-firstn)
+(%disable default
+          firstn-of-logic.strip-conclusions
+          [outside]firstn-of-logic.strip-conclusions)
+
+
+(%autoprove logic.substitute-formula-of-logic.disjoin-formulas-free)
+
+(%autoprove lemma-for-aggressive-forcing-logic.substitute-of-logic.replace-subterm
+            (%logic.term-induction flag x)
+            (%restrict default definition-of-logic.replace-subterm (equal x 'x)))
+
+(%autoprove aggressive-forcing-logic.substitute-of-logic.replace-subterm
+            (%use (%instance (%thm lemma-for-aggressive-forcing-logic.substitute-of-logic.replace-subterm)
+                             (flag 'term))))
+
+(%autoprove aggressive-forcing-logic.substitute-list-of-logic.replace-subterm-list
+            (%use (%instance (%thm lemma-for-aggressive-forcing-logic.substitute-of-logic.replace-subterm)
+                             (flag 'list))))
+
+(%autoprove lemma-for-equal-of-logic.replace-subterm-and-logic.replace-subterm-when-same-term-and-old
+            (%logic.term-induction flag x)
+            (%restrict default definition-of-logic.replace-subterm (equal x 'x))
+            (%restrict default definition-of-logic.subtermp (equal y 'x)))
+
+(%autoprove equal-of-logic.replace-subterm-and-logic.replace-subterm-when-same-term-and-old
+            (%use (%instance (%thm lemma-for-equal-of-logic.replace-subterm-and-logic.replace-subterm-when-same-term-and-old)
+                             (flag 'term))))
+
+(%autoprove equal-of-logic.replace-subterm-list-and-logic.replace-subterm-list-when-same-term-and-old
+            (%use (%instance (%thm lemma-for-equal-of-logic.replace-subterm-and-logic.replace-subterm-when-same-term-and-old)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.substitute-of-var-when-first-in-sigma
+            (%restrict default definition-of-logic.substitute (equal x 'var)))
+
+(%autoprove forcing-logic.substitute-of-var-when-second-in-sigma
+            (%restrict default definition-of-logic.substitute (equal x 'var)))
+
+(%autoprove equal-of-first-and-second-when-uniquep)
+(%autoprove equal-of-second-and-first-when-uniquep) ;; probably unnecessary via term order??
+
+(%autoprove memberp-of-first-of-difference-in-removed
+            (%disable default
+                      memberp-of-car
+                      [outside]memberp-of-car)
+            (%use (%instance (%thm memberp-of-car)
+                             (x (difference x y)))))
+
+(%autoprove memberp-of-second-of-difference-in-removed
+            (%disable default memberp-of-second)
+            (%use (%instance (%thm memberp-of-second)
+                             (x (difference x y)))))
+
+
+(%autoadmit elim.flag-collect-destructed-variables)
+(%autoadmit elim.flag-slow-collect-destructed-variables)
+(%autoadmit elim.collect-destructed-variables)
+(%autoadmit elim.collect-destructed-variables-list)
+
+(%autoprove true-listp-of-elim.flag-collect-destructed-variables
+            (%autoinduct elim.flag-collect-destructed-variables flag x acc)
+            (%restrict default elim.flag-collect-destructed-variables (equal x 'x)))
+
+(%autoprove elim.flag-slow-collect-destructed-variables-equiv
+            (%autoinduct elim.flag-collect-destructed-variables flag x acc)
+            (%restrict default elim.flag-collect-destructed-variables (equal x 'x))
+            (%restrict default elim.flag-slow-collect-destructed-variables (equal x 'x)))
+
+(%autoprove definition-of-elim.collect-destructed-variables
+            (%forcingp nil)
+            (%restrict default elim.flag-slow-collect-destructed-variables (equal x 'x))
+            (%enable default
+                     elim.collect-destructed-variables
+                     elim.collect-destructed-variables-list))
+
+(%autoprove definition-of-elim.collect-destructed-variables-list
+            (%restrict default elim.flag-slow-collect-destructed-variables (equal x 'x))
+            (%enable default
+                     elim.collect-destructed-variables
+                     elim.collect-destructed-variables-list))
+
+(%autoprove lemma-for-logic.variable-listp-of-elim.collect-destructed-variables
+            (%logic.term-induction flag x)
+            (%restrict default definition-of-elim.collect-destructed-variables (equal x 'x))
+            (%restrict default definition-of-elim.collect-destructed-variables-list (equal x 'x)))
+
+(%autoprove logic.variable-listp-of-elim.collect-destructed-variables
+            (%use (%instance (%thm lemma-for-logic.variable-listp-of-elim.collect-destructed-variables)
+                             (flag 'term))))
+
+(%autoprove logic.variable-listp-of-elim.collect-destructed-variables-list
+            (%use (%instance (%thm lemma-for-logic.variable-listp-of-elim.collect-destructed-variables)
+                             (flag 'list))))
+
+
+
+
+;; BOZO stupid name, should be called duplicity
+(%autoadmit fast-count)
+(%autoadmit slow-count)
+(%autoadmit count)
+
+(%autoprove fast-count-as-slow-count
+            (%autoinduct fast-count a x acc)
+            (%restrict default fast-count (equal x 'x))
+            (%restrict default slow-count (equal x 'x)))
+
+(%autoprove definition-of-count
+            (%enable default count)
+            (%restrict default slow-count (equal x 'x))
+            (%enable default fast-count-as-slow-count))
+
+(%autoprove count-when-not-consp
+            (%restrict default definition-of-count (equal x 'x)))
+
+(%autoprove count-of-cons
+            (%restrict default definition-of-count (equal x '(cons b x))))
+
+(%autoprove natp-of-count
+            (%cdr-induction x))
+
+(%autoprove count-of-zero
+            (%cdr-induction x))
+
+(%autoprove count-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove count-of-app
+            (%cdr-induction x))
+
+(%autoprove count-of-rev
+            (%cdr-induction x))
+
+(%autoprove count-when-not-memberp
+            (%cdr-induction x))
+
+
+(%autoadmit aux-maximal-count)
+
+(%autoprove memberp-of-aux-maximal-count
+            (%autoinduct aux-maximal-count best best-count domain x)
+            (%restrict default aux-maximal-count (equal domain 'domain)))
+
+(%autoprove aux-maximal-count-when-not-consp-of-x
+            (%autoinduct aux-maximal-count best best-count domain x)
+            (%restrict default aux-maximal-count (equal domain 'domain)))
+
+
+(%autoadmit maximal-count)
+
+(%autoprove maximal-count-when-not-consp
+            (%enable default maximal-count))
+
+(%autoprove memberp-of-maximal-count
+            (%enable default maximal-count))
+
+
+
+(%autoadmit elim.find-backup-var)
+
+(%autoprove logic.variablep-of-elim.find-backup-var
+            (%autoinduct elim.find-backup-var)
+            (%restrict default elim.find-backup-var (equal x 'x)))
+
+(%autoadmit elim.choose-var-to-eliminate)
+
+(%autoprove lemma-for-logic.variablep-of-elim.choose-var-to-eliminate
+            (%disable default logic.variablep-when-memberp-of-logic.variable-listp)
+            (%use (%instance (%thm logic.variablep-when-memberp-of-logic.variable-listp)
+                             (a (maximal-count x))
+                             (x x))))
+
+(%autoprove logic.variablep-of-elim.choose-var-to-eliminate
+            (%enable default
+                     elim.choose-var-to-eliminate
+                     lemma-for-logic.variablep-of-elim.choose-var-to-eliminate))
+
+(%deflist logic.variable-list-listp (x)
+          (logic.variable-listp x))
+
+(%defmap :map (elim.namesp x)
+         :key (logic.variablep x)
+         :val (logic.variable-listp x)
+         :key-list (logic.variable-listp x)
+         :val-list (logic.variable-list-listp x)
+         :val-of-nil t)
+
+(%autoadmit elim.pick-fresh-vars)
+
+(encapsulate
+ ()
+ (local (%disable default
+                  unusual-consp-rules
+                  unusual-memberp-rules
+                  unusual-subsetp-rules
+                  expensive-term/formula-inference
+                  type-set-like-rules
+                  list-of-first-and-second-when-len-2
+                  ))
+ (local (%enable default elim.pick-fresh-vars))
+ (%autoprove forcing-logic.variablep-of-first-of-elim.pick-fresh-vars)
+ (%autoprove forcing-logic.variablep-of-second-of-elim.pick-fresh-vars)
+ (%autoprove forcing-logic.memberp-of-first-of-elim.pick-fresh-vars)
+ (%autoprove forcing-logic.memberp-of-second-of-elim.pick-fresh-vars)
+ (%autoprove forcing-equal-of-first-and-second-of-elim.pick-fresh-vars)
+ (%autoprove forcing-equal-of-second-and-first-of-elim.pick-fresh-vars))
+
+
+(%autoadmit elim.elim-clause)
+(encapsulate
+ ()
+ (local (%enable default elim.elim-clause))
+ (%autoprove forcing-logic.term-list-listp-of-elim.elim-clause)
+ (%autoprove forcing-cons-listp-of-elim.elim-clause)
+ (%autoprove forcing-logic.term-list-list-atblp-of-elim.elim-clause))
+
+
+
+(%autoadmit elim.elim-clause-bldr)
+(encapsulate
+ ()
+ (local (%enable default
+                 axiom-cons-of-car-and-cdr
+                 elim.elim-clause
+                 logic.term-formula
+                 redefinition-of-logic.term-list-formulas
+                 elim.elim-clause-bldr))
+ (%autoprove forcing-logic.appealp-of-elim.elim-clause-bldr)
+ (%autoprove forcing-logic.conclusion-of-elim.elim-clause-bldr)
+ (%autoprove forcing-logic.proofp-of-elim.elim-clause-bldr))
+
+
+(%autoadmit elim.elim-clause-list)
+(%autoprove true-listp-of-elim.elim-clause-list
+            (%cdr-induction x)
+            (%restrict default elim.elim-clause-list (equal x 'x)))
+(%autoprove forcing-logic.term-list-listp-of-elim.elim-clause-list
+            (%cdr-induction x)
+            (%restrict default elim.elim-clause-list (equal x 'x)))
+(%autoprove forcing-logic.term-list-list-atblp-of-elim.elim-clause-list
+            (%cdr-induction x)
+            (%restrict default elim.elim-clause-list (equal x 'x)))
+(%autoprove forcing-cons-listp-of-elim.elim-clause-list
+            (%cdr-induction x)
+            (%restrict default elim.elim-clause-list (equal x 'x)))
+
+
+
+(%autoadmit elim.elim-clause-list-bldr)
+
+(encapsulate
+ ()
+
+ (%autoprove dangerous-decomposition-of-app
+             (%cdr-cdr-induction x a)
+             (%restrict default firstn (equal n '(len a)))
+             (%restrict default restn (equal n '(len a))))
+
+ (local (%enable default dangerous-decomposition-of-app))
+
+ (%autoprove forcing-logic.appeal-listp-of-elim.elim-clause-list-bldr
+             (%autoinduct elim.elim-clause-list-bldr)
+             (%restrict default elim.elim-clause-list-bldr (equal x 'x))
+             (%restrict default elim.elim-clause-list (equal x 'x)))
+
+ (%autoprove forcing-logic.strip-conclusions-of-elim.elim-clause-list-bldr
+             (%autoinduct elim.elim-clause-list-bldr)
+             (%restrict default elim.elim-clause-list-bldr (equal x 'x))
+             (%restrict default elim.elim-clause-list (equal x 'x)))
+
+ (%autoprove forcing-logic.proof-listp-of-elim.elim-clause-list-bldr
+             (%autoinduct elim.elim-clause-list-bldr)
+             (%restrict default elim.elim-clause-list-bldr (equal x 'x))
+             (%restrict default elim.elim-clause-list (equal x 'x))))
+
+
+
+
+(%autoadmit tactic.elim-first-okp)
+
+(%autoprove booleanp-of-tactic.elim-first-okp
+            (%enable default tactic.elim-first-okp))
+
+
+(%autoadmit tactic.elim-first-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.elim-first-tac
+            (%enable default tactic.elim-first-tac))
+
+(%autoprove forcing-tactic.elim-first-okp-of-tactic.elim-first-tac
+            (%enable default tactic.elim-first-tac tactic.elim-first-okp))
+
+
+
+(%autoadmit tactic.elim-first-compile)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.elim-first-okp
+                 tactic.elim-first-compile))
+
+ (local (%enable default dangerous-decomposition-of-app))
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.elim-first-compile
+             (%auto :strategy (cleanup split urewrite crewrite))
+             (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS (TACTIC.SKELETON->GOALS X)))))
+
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.elim-first-compile
+             (%auto :strategy (cleanup split urewrite crewrite))
+             (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS (TACTIC.SKELETON->GOALS X))))
+             (%auto :strategy (cleanup split urewrite crewrite))
+             (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS (TACTIC.SKELETON->GOALS X)))))
+
+ (%autoprove forcing-logic.proof-listp-of-tactic.elim-first-compile
+             (%auto :strategy (cleanup split urewrite crewrite))
+             (%fertilize (LOGIC.STRIP-CONCLUSIONS PROOFS)
+                         (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                          (LOGIC.TERM-LIST-LIST-FORMULAS (TACTIC.SKELETON->GOALS X))))))
+
+
+
+(%autoadmit tactic.elim-all-okp)
+
+(%autoprove booleanp-of-tactic.elim-all-okp
+            (%enable default tactic.elim-all-okp))
+
+
+(%autoadmit tactic.elim-all-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.elim-all-tac
+            (%enable default tactic.elim-all-tac))
+
+(%autoprove forcing-tactic.elim-all-okp-of-tactic.elim-all-tac
+            (%enable default tactic.elim-all-tac tactic.elim-all-okp))
+
+
+
+(%autoadmit tactic.elim-all-compile)
+
+(encapsulate
+ ()
+ (local (%enable default tactic.elim-all-okp tactic.elim-all-compile))
+ (%autoprove forcing-logic.appeal-listp-of-tactic.elim-all-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.elim-all-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.elim-all-compile))
+
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/elim")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/fertilize.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/fertilize.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/fertilize.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/fertilize.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,131 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(include-book "replace-subterm")
+(%interactive)
+
+(defthm logic.term-listp-when-tuplep-2-of-logic.termps
+  ;; BOZO unlocalize in tactics/fertilize
+  (implies (and (tuplep 2 x)
+                (logic.termp (first x))
+                (logic.termp (second x)))
+           (equal (logic.term-listp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(%autoprove logic.term-listp-when-tuplep-2-of-logic.termps)
+
+(%autoadmit tactic.fertilize-okp)
+(%autoadmit tactic.fertilize-env-okp)
+
+(%autoprove booleanp-of-tactic.fertilize-okp
+            (%enable default tactic.fertilize-okp))
+
+(%autoprove booleanp-of-tactic.fertilize-env-okp
+            (%enable default tactic.fertilize-env-okp))
+
+
+(%autoadmit tactic.fertilize-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.fertilize-tac
+            (%enable default tactic.fertilize-tac))
+
+(%autoprove forcing-tactic.fertilize-okp-of-tactic.fertilize-tac
+            (%enable default
+                     tactic.fertilize-tac
+                     tactic.fertilize-okp))
+
+(%autoprove forcing-tactic.fertilize-env-okp-of-tactic.fertilize-tac
+            (%enable default
+                     tactic.fertilize-tac
+                     tactic.fertilize-env-okp))
+
+
+(%deftheorem tactic.fertilize-lemma1-helper)
+
+(%autoadmit tactic.fertilize-lemma1)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.fertilize-lemma1-helper
+                 tactic.fertilize-lemma1))
+
+ (%autoprove tactic.fertilize-lemma1-under-iff)
+ (%autoprove forcing-logic.appealp-of-tactic.fertilize-lemma1)
+ (%autoprove forcing-logic.conclusion-of-tactic.fertilize-lemma1)
+ (%autoprove forcing-logic.proofp-of-tactic.fertilize-lemma1))
+
+
+
+
+(%autoadmit tactic.fertilize-bldr)
+
+(encapsulate
+ ()
+ (local (%enable default tactic.fertilize-bldr))
+ (%autoprove tactic.fertilize-bldr-under-iff)
+ (%autoprove forcing-logic.appealp-of-tactic.fertilize-bldr)
+ (%autoprove forcing-logic.conclusion-of-tactic.fertilize-bldr)
+ (%autoprove forcing-logic.proofp-of-tactic.fertilize-bldr))
+
+
+
+(%autoadmit tactic.fertilize-compile)
+
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.fertilize-okp
+                 tactic.fertilize-env-okp
+                 tactic.fertilize-compile
+                 logic.term-formula))
+
+ (defthmd crock-for-tactic.fertilize-compile
+   (implies (equal (clause.clause-list-formulas goals) (logic.strip-conclusions proofs))
+            (equal (logic.conclusion (first proofs))
+                   (clause.clause-formula (first goals)))))
+
+ (%autoprove crock-for-tactic.fertilize-compile)
+
+ (local (%enable default crock-for-tactic.fertilize-compile))
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.fertilize-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.fertilize-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.fertilize-compile))
+
+(%ensure-exactly-these-rules-are-missing "../../tactic/fertilize")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/generalize-all.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/generalize-all.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/generalize-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/generalize-all.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,80 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(%interactive)
+
+
+(%autoadmit tactic.generalize-all-okp)
+(%autoadmit tactic.generalize-all-env-okp)
+
+(%autoprove booleanp-of-tactic.generalize-all-okp
+            (%enable default tactic.generalize-all-okp))
+
+(%autoprove booleanp-of-tactic.generalize-all-env-okp
+            (%enable default tactic.generalize-all-env-okp))
+
+
+(%autoadmit tactic.generalize-all-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.generalize-all-tac
+            (%enable default tactic.generalize-all-tac))
+
+(%autoprove forcing-tactic.generalize-all-okp-of-tactic.generalize-all-tac
+            (%enable default
+                     tactic.generalize-all-tac
+                     tactic.generalize-all-okp))
+
+(%autoprove forcing-tactic.generalize-all-env-okp-of-tactic.generalize-all-tac
+            (%enable default
+                     tactic.generalize-all-tac
+                     tactic.generalize-all-env-okp))
+
+
+(%autoadmit tactic.generalize-all-compile)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.generalize-all-okp
+                 tactic.generalize-all-env-okp
+                 tactic.generalize-all-compile))
+
+ (%autoprove forcing-logic.substitute-of-logic.replace-subterm-list-list-with-fresh-variable-free)
+ (%autoprove forcing-logic.appeal-listp-of-tactic.generalize-all-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.generalize-all-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.generalize-all-compile))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/generalize-all")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/generalize-first.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/generalize-first.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/generalize-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/generalize-first.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,98 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(%interactive)
+
+
+(%autoadmit tactic.generalize-first-okp)
+(%autoadmit tactic.generalize-first-env-okp)
+
+(%autoprove booleanp-of-tactic.generalize-first-okp
+            (%enable default tactic.generalize-first-okp))
+
+(%autoprove booleanp-of-tactic.generalize-first-env-okp
+            (%enable default tactic.generalize-first-env-okp))
+
+
+(%autoadmit tactic.generalize-first-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.generalize-first-tac
+            (%enable default tactic.generalize-first-tac))
+
+(%autoprove forcing-tactic.generalize-first-okp-of-tactic.generalize-first-tac
+            (%enable default
+                     tactic.generalize-first-tac
+                     tactic.generalize-first-okp))
+
+(%autoprove forcing-tactic.generalize-first-env-okp-of-tactic.generalize-first-tac
+            (%enable default
+                     tactic.generalize-first-tac
+                     tactic.generalize-first-env-okp))
+
+
+(%autoadmit tactic.generalize-first-compile)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.generalize-first-okp
+                 tactic.generalize-first-env-okp
+                 tactic.generalize-first-compile))
+
+ (defthm crock1-for-tactic.generalize-first
+   ;; BOZO unlocalize/rename
+   (implies (equal x (logic.disjoin-formulas y))
+            (equal (logic.substitute-formula x sigma)
+                   (logic.disjoin-formulas (logic.substitute-formula-list y sigma)))))
+
+ (defthm crock2-for-tactic.generalize-first
+   ;; BOZO unlocalize/rename
+   (implies (and (equal terms (logic.replace-subterm-list x old new) )
+                 (not (memberp new (logic.term-list-vars x)))
+                 (logic.variablep new)
+                 (force (logic.term-listp x)))
+            (equal (logic.substitute-list terms (list (cons new old)))
+                   (list-fix x)))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (%autoprove crock1-for-tactic.generalize-first)
+ (%autoprove crock2-for-tactic.generalize-first)
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.generalize-first-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.generalize-first-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.generalize-first-compile))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/generalize-first")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/induct.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/induct.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/induct.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/induct.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,423 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(%interactive)
+
+
+
+(encapsulate
+ ()
+ (%autoadmit build.stepwise-modus-ponens-2)
+ (%autoprove true-listp-of-build.stepwise-modus-ponens-2
+             (%autoinduct build.stepwise-modus-ponens-2)
+             (%restrict default build.stepwise-modus-ponens-2 (equal x 'x)))
+ (%autoprove forcing-logic.appeal-list-of-build.stepwise-modus-ponens-2
+             (%autoinduct build.stepwise-modus-ponens-2)
+             (%restrict default build.stepwise-modus-ponens-2 (equal x 'x)))
+ (%autoprove forcing-logic.strip-conclusions-of-build.stepwise-modus-ponens-2
+             (%autoinduct build.stepwise-modus-ponens-2)
+             (%restrict default build.stepwise-modus-ponens-2 (equal x 'x)))
+ (%autoprove forcing-logic.proof-list-of-build.stepwise-modus-ponens-2
+             (%autoinduct build.stepwise-modus-ponens-2)
+             (%restrict default build.stepwise-modus-ponens-2 (equal x 'x))))
+
+
+(encapsulate
+ ()
+ (%autoadmit tactic.induct-basis-clause)
+ (%autoprove forcing-logic.term-listp-of-tactic.induct-basis-clause
+             (%enable default tactic.induct-basis-clause))
+ (%autoprove consp-of-tactic.induct-basis-clause
+             (%enable default tactic.induct-basis-clause)))
+
+
+(encapsulate
+ ()
+ (%autoadmit tactic.compile-induct-basis-clause)
+ (local (%enable default
+                 logic.term-formula
+                 tactic.induct-basis-clause
+                 tactic.compile-induct-basis-clause))
+ (%autoprove forcing-logic.appealp-of-tactic.compile-induct-basis-clause)
+ (%autoprove forcing-logic.conclusion-of-tactic.compile-induct-basis-clause)
+ (%autoprove forcing-logic.proofp-of-tactic.compile-induct-basis-clause))
+
+
+
+(defthmd lemma-for-tactic.compile-induct-inductive-clauses
+  ;; BOZO unlocalize/rename in tactics/induct
+  (implies (equal (logic.strip-conclusions proofs)
+                  (logic.negate-formulas x))
+           (equal (len proofs)
+                  (len x)))
+  :hints(("Goal"
+          :in-theory (disable len-of-logic.negate-formulas
+                              len-of-logic.strip-conclusions)
+          :use ((:instance len-of-logic.negate-formulas)
+                (:instance len-of-logic.strip-conclusions (x proofs))))))
+
+(encapsulate
+ ()
+ (%autoadmit tactic.induct-inductive-clauses)
+ (%autoadmit tactic.compile-induct-inductive-clauses)
+ (local (%enable default
+                 tactic.induct-inductive-clauses
+                 tactic.compile-induct-inductive-clauses))
+ (%autoprove forcing-logic.term-list-listp-of-tactic.induct-inductive-clauses)
+ (%autoprove cons-listp-of-tactic.induct-inductive-clauses)
+ (%autoprove true-listp-of-tactic.induct-inductive-clauses)
+
+ (%autoprove lemma-for-tactic.compile-induct-inductive-clauses
+             (%disable default
+                       len-of-logic.negate-formulas
+                       [outside]len-of-logic.negate-formulas
+                       len-of-logic.strip-conclusions
+                       [outside]len-of-logic.strip-conclusions)
+             (%use (%instance (%thm len-of-logic.negate-formulas)))
+             (%use (%instance (%thm len-of-logic.strip-conclusions) (x proofs))))
+ (local (%enable default lemma-for-tactic.compile-induct-inductive-clauses))
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.compile-induct-inductive-clauses)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.compile-induct-inductive-clauses)
+ (%autoprove forcing-logic.proof-listp-of-tactic.compile-induct-inductive-clauses))
+
+(encapsulate
+ ()
+ (%autoadmit tactic.induct-ordinal-clause)
+ (%autoadmit tactic.compile-induct-ordinal-clause)
+ (local (%enable default
+                 logic.term-formula
+                 tactic.induct-ordinal-clause
+                 tactic.compile-induct-ordinal-clause))
+ (%autoprove forcing-logic.term-listp-of-tactic.induct-ordinal-clause)
+ (%autoprove consp-of-tactic.induct-ordinal-clause)
+ (%autoprove forcing-logic.appealp-of-tactic.compile-induct-ordinal-clause)
+ (%autoprove forcing-logic.conclusion-of-tactic.compile-induct-ordinal-clause)
+ (%autoprove forcing-logic.proofp-of-tactic.compile-induct-ordinal-clause))
+
+(encapsulate
+ ()
+ (%autoadmit tactic.induct-measure-clauses)
+ (%autoadmit tactic.compile-induct-measure-clauses)
+ (local (%enable default
+                 tactic.induct-measure-clauses
+                 tactic.compile-induct-measure-clauses))
+ (%autoprove forcing-logic.term-list-listp-of-tactic.induct-measure-clauses)
+ (%autoprove cons-listp-of-tactic.induct-measure-clauses)
+ (%autoprove true-listp-of-tactic.induct-measure-clauses)
+ (local (%enable default lemma-for-tactic.compile-induct-inductive-clauses))  ;; ugly, but it's the same lemma.
+ (%autoprove true-listp-of-tactic.compile-induct-measure-clauses)
+ (%autoprove forcing-logic.appeal-list-of-tactic.compile-induct-measure-clauses)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.compile-induct-measure-clauses)
+ (%autoprove forcing-logic.proof-listp-of-tactic.compile-induct-measure-clauses))
+
+
+
+(%autoadmit tactic.induct-okp)
+(%autoprove booleanp-of-tactic.induct-okp
+            (%enable default tactic.induct-okp))
+
+(%autoadmit tactic.induct-env-okp)
+(%autoprove booleanp-of-tactic.induct-env-okp
+            (%enable default tactic.induct-env-okp))
+
+
+(%autoadmit tactic.induct-tac)
+(%autoprove forcing-tactic.skeletonp-of-tactic.induct-tac
+            (%enable default tactic.induct-tac))
+(%autoprove forcing-tactic.induct-okp-of-tactic.induct-tac
+            (%enable default tactic.induct-tac tactic.induct-okp))
+;; BOZO shouldn't we have an env-okp lemma too??
+
+
+(encapsulate
+ ()
+ (%autoadmit tactic.induct-compile-aux)
+ (local (%enable default tactic.induct-compile-aux))
+ (%autoprove forcing-logic.appealp-of-tactic.induct-compile-aux)
+ (%autoprove forcing-logic.conclusion-of-tactic.induct-compile-aux)
+ (%autoprove forcing-logic.proofp-of-tactic.induct-compile-aux))
+
+
+
+
+;; BOZO all of this stuff has to get unlocalized/renamed.
+
+(defthm crock1-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.strip-conclusions proofs)
+                  (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals)))))
+
+(defthm crock2-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.strip-conclusions (firstn n proofs))
+                  (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (firstn n goals)))))
+  :hints(("Goal"
+          :in-theory (disable FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+          :use ((:instance FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (Y n)
+                           (X (LOGIC.TERM-LIST-LIST-FORMULAS goals)))))))
+
+(defthm crock3-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.strip-conclusions (firstn n (cdr (cdr proofs))))
+                  (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (firstn n (cdr (cdr goals)))))))
+  :hints(("Goal"
+          :in-theory (disable FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+          :use ((:instance FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (Y n)
+                           (X (LOGIC.TERM-LIST-LIST-FORMULAS (cdr (cdr goals)))))))))
+
+(defthm crock4-for-tactic.induct-compile
+  (implies (equal (app a b) x)
+           (equal (firstn (len a) x)
+                  (list-fix a))))
+
+(defthm crock5-for-tactic.induct-compile
+  (implies (equal (app a b) x)
+           (equal (restn (len a) x)
+                  (list-fix b))))
+
+(defthm crock6-for-tactic.induct-compile
+  (implies (equal (app a (app b c)) x)
+           (equal (firstn (len b) (restn (len a) x))
+                  (list-fix b))))
+
+(defthm crock7-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.conclusion (car proofs))
+                  (logic.disjoin-formulas (logic.term-list-formulas (car goals))))))
+
+(defthm crock8-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.conclusion (second proofs))
+                  (logic.disjoin-formulas (logic.term-list-formulas (second goals))))))
+
+(defthm crock9-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (consp proofs)
+                  (consp goals))))
+
+(defthm crock10-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (consp (cdr proofs))
+                  (consp (cdr goals)))))
+
+(defthm crock11-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.strip-conclusions (restn n (cdr (cdr proofs))))
+                  (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (restn n (cdr (cdr goals)))))))
+  :hints(("Goal"
+          :in-theory (disable RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+          :use ((:instance RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (Y n)
+                           (X (LOGIC.TERM-LIST-LIST-FORMULAS (cdr (cdr goals)))))))))
+
+(defthm crock12-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.strip-conclusions (firstn n (restn m proofs)))
+                  (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (firstn n (restn m goals))))))
+  :hints(("Goal"
+          :in-theory (disable FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                              RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+          :use ((:instance FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (Y n)
+                           (X (LOGIC.TERM-LIST-LIST-FORMULAS (restn m goals))))
+                (:instance RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (Y m)
+                           (X (LOGIC.TERM-LIST-LIST-FORMULAS goals)))))))
+
+(defthm crock13-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.strip-conclusions (firstn n (restn m (cdr (cdr proofs)))))
+                  (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                   (LOGIC.TERM-LIST-LIST-FORMULAS (firstn n (restn m (cdr (cdr goals)))))))))
+
+(defthm crock14-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.strip-conclusions (restn n (restn m proofs)))
+                  (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (restn n (restn m goals))))))
+  :hints(("Goal"
+          :in-theory (disable RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+          :use ((:instance RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (Y n)
+                           (X (LOGIC.TERM-LIST-LIST-FORMULAS (restn m goals))))
+                (:instance RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (Y m)
+                           (X (LOGIC.TERM-LIST-LIST-FORMULAS goals)))))))
+
+(defthm crock15-for-tactic.induct-compile
+  (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                  (LOGIC.STRIP-CONCLUSIONS PROOFS))
+           (equal (logic.strip-conclusions (restn n (restn m (cdr (cdr proofs)))))
+                  (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                   (LOGIC.TERM-LIST-LIST-FORMULAS (restn n (restn m (cdr (cdr goals)))))))))
+
+
+
+
+
+(%autoprove crock1-for-tactic.induct-compile)
+(%autoprove crock2-for-tactic.induct-compile
+            (%disable default
+                      FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      [outside]FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+            (%use (%instance (%thm FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                             (Y n)
+                             (X (LOGIC.TERM-LIST-LIST-FORMULAS goals)))))
+(%autoprove crock3-for-tactic.induct-compile
+            (%disable default
+                      FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      [outside]FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+            (%use (%instance (%thm FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                             (Y n)
+                             (X (LOGIC.TERM-LIST-LIST-FORMULAS (cdr (cdr goals)))))))
+(%autoprove crock4-for-tactic.induct-compile)
+(%autoprove crock5-for-tactic.induct-compile)
+(%autoprove crock6-for-tactic.induct-compile)
+(%autoprove crock7-for-tactic.induct-compile)
+
+(%autoprove crock8-for-tactic.induct-compile
+            (%restrict default logic.strip-conclusions (or (equal x 'proofs)
+                                                           (equal x '(cdr proofs)))))
+
+(%autoprove crock9-for-tactic.induct-compile)
+(%autoprove crock10-for-tactic.induct-compile)
+
+(%autoprove crock11-for-tactic.induct-compile
+            (%disable default
+                      RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      [outside]RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+            (%use (%instance (%thm RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                             (Y n)
+                             (X (LOGIC.TERM-LIST-LIST-FORMULAS (cdr (cdr goals)))))))
+
+(%autoprove crock12-for-tactic.induct-compile
+            (%disable default
+                      FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      [outside]FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      [outside]RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      ;; causing rewrite loop??
+                      crock1-for-tactic.induct-compile
+                      )
+            (%use (%instance (%thm FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                             (Y n)
+                             (X (LOGIC.TERM-LIST-LIST-FORMULAS (restn m goals)))))
+            (%use (%instance (%thm RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                             (Y m)
+                             (X (LOGIC.TERM-LIST-LIST-FORMULAS goals)))))
+
+(%autoprove crock13-for-tactic.induct-compile)
+
+(%autoprove crock14-for-tactic.induct-compile
+            (%disable default
+                      RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      [outside]RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                      ;; loop again??
+                      crock1-for-tactic.induct-compile)
+            (%use (%instance (%thm RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                             (Y n)
+                             (X (LOGIC.TERM-LIST-LIST-FORMULAS (restn m goals)))))
+            (%use (%instance (%thm RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                             (Y m)
+                             (X (LOGIC.TERM-LIST-LIST-FORMULAS goals)))))
+
+(%autoprove crock15-for-tactic.induct-compile
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-term/formula-inference))
+
+
+(in-theory (disable
+            CROCK1-FOR-TACTIC.INDUCT-COMPILE
+            CROCK2-FOR-TACTIC.INDUCT-COMPILE
+            CROCK3-FOR-TACTIC.INDUCT-COMPILE
+            CROCK4-FOR-TACTIC.INDUCT-COMPILE
+            CROCK5-FOR-TACTIC.INDUCT-COMPILE
+            CROCK6-FOR-TACTIC.INDUCT-COMPILE
+            CROCK7-FOR-TACTIC.INDUCT-COMPILE
+            CROCK8-FOR-TACTIC.INDUCT-COMPILE
+            CROCK9-FOR-TACTIC.INDUCT-COMPILE
+            CROCK10-FOR-TACTIC.INDUCT-COMPILE
+            CROCK11-FOR-TACTIC.INDUCT-COMPILE
+            CROCK12-FOR-TACTIC.INDUCT-COMPILE
+            CROCK13-FOR-TACTIC.INDUCT-COMPILE
+            CROCK14-FOR-TACTIC.INDUCT-COMPILE
+            CROCK15-FOR-TACTIC.INDUCT-COMPILE))
+
+
+(encapsulate
+ ()
+ (%autoadmit tactic.induct-compile)
+ (local (%enable default
+                 tactic.induct-okp
+                 tactic.induct-env-okp
+                 tactic.induct-compile))
+ (%autoprove forcing-logic.appeal-listp-of-tactic.induct-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.induct-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.induct-compile))
+
+(%disable default
+          CROCK1-FOR-TACTIC.INDUCT-COMPILE
+          CROCK2-FOR-TACTIC.INDUCT-COMPILE
+          CROCK3-FOR-TACTIC.INDUCT-COMPILE
+          CROCK4-FOR-TACTIC.INDUCT-COMPILE
+          CROCK5-FOR-TACTIC.INDUCT-COMPILE
+          CROCK6-FOR-TACTIC.INDUCT-COMPILE
+          CROCK7-FOR-TACTIC.INDUCT-COMPILE
+          CROCK8-FOR-TACTIC.INDUCT-COMPILE
+          CROCK9-FOR-TACTIC.INDUCT-COMPILE
+          CROCK10-FOR-TACTIC.INDUCT-COMPILE
+          CROCK11-FOR-TACTIC.INDUCT-COMPILE
+          CROCK12-FOR-TACTIC.INDUCT-COMPILE
+          CROCK13-FOR-TACTIC.INDUCT-COMPILE
+          CROCK14-FOR-TACTIC.INDUCT-COMPILE
+          CROCK15-FOR-TACTIC.INDUCT-COMPILE)
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/induct")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/level11.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/level11.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/level11.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/level11.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,227 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "compiler")
+(%interactive)
+
+;; These get expensive with so many (memberp (thm-blah-blah) thms) in our goals
+(local (%disable default
+                 memberp-when-not-consp
+                 unusual-memberp-rules))
+
+
+(%autoadmit level11.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level11.step-okp))
+ (%autoprove soundness-of-level11.step-okp)
+ (%autoprove level11.step-okp-when-level10.step-okp
+             (%enable default level10.step-okp)
+             (%auto)
+             (%enable default level9.step-okp)
+             (%auto)
+             (%enable default level8.step-okp)
+             (%auto)
+             (%enable default level7.step-okp)
+             (%auto)
+             (%enable default level6.step-okp)
+             (%auto)
+             (%enable default level5.step-okp)
+             (%auto)
+             (%enable default level4.step-okp)
+             (%auto)
+             (%enable default level3.step-okp)
+             (%auto)
+             (%enable default level2.step-okp)
+             (%auto)
+             (%enable default logic.appeal-step-okp)
+             (%auto))
+ (%autoprove level11.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%forcingp nil))
+ (local (%enable default expensive-arithmetic-rules))
+ (%autoadmit level11.flag-proofp-aux))
+
+(%autoadmit level11.proofp-aux)
+(%autoadmit level11.proof-listp-aux)
+
+(%autoprove definition-of-level11.proofp-aux
+            (%enable default level11.proofp-aux level11.proof-listp-aux)
+            (%restrict default level11.flag-proofp-aux (equal x 'x)))
+
+(%autoprove definition-of-level11.proof-listp-aux
+            (%enable default level11.proofp-aux level11.proof-listp-aux)
+            (%restrict default level11.flag-proofp-aux (equal x 'x)))
+
+(%autoprove level11.proofp-aux-when-not-consp
+            (%enable default definition-of-level11.proofp-aux))
+
+(%autoprove level11.proof-listp-aux-when-not-consp
+            (%restrict default definition-of-level11.proof-listp-aux (equal x 'x)))
+
+(%autoprove level11.proof-listp-aux-of-cons
+            (%restrict default definition-of-level11.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level11.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%enable default
+                     definition-of-level11.proofp-aux
+                     expensive-arithmetic-rules)
+            (%forcingp nil))
+
+(%autoprove booleanp-of-level11.proofp-aux
+            (%use (%instance (%thm lemma-for-booleanp-of-level11.proofp-aux)
+                             (flag 'proof))))
+
+(%autoprove booleanp-of-level11.proof-listp-aux
+            (%use (%instance (%thm lemma-for-booleanp-of-level11.proofp-aux)
+                             (flag 'list))))
+
+(%deflist level11.proof-listp-aux (x worlds defs axioms thms atbl)
+          (level11.proofp-aux x worlds defs axioms thms atbl))
+
+
+
+
+(%autoprove lemma-for-logic.provablep-when-level11.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%splitlimit 2)
+            (%liftlimit 8)
+            (%disable default
+                      forcing-true-listp-of-logic.subproofs
+                      MEMBERP-WHEN-NOT-CONSP
+                      CONSP-WHEN-CONSP-OF-CDR-CHEAP
+                      LOOKUP-WHEN-NOT-CONSP
+                      CONSP-WHEN-TRUE-LISTP-CHEAP
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-subset-of-somep-cheap
+                      memberp-when-not-superset-of-somep-cheap
+                      type-set-like-rules
+                      unusual-consp-rules
+                      unusual-memberp-rules
+                      unusual-subsetp-rules
+                      same-length-prefixes-equal-cheap
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      formula-decomposition
+                      expensive-term/formula-inference
+                      logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest)
+            (%waterfall default 110)
+            (%restrict default definition-of-level11.proofp-aux (equal x 'x))
+            (%enable default
+                     expensive-arithmetic-rules
+                     type-set-like-rules)
+            (%waterfall default 110))
+
+(%autoprove logic.provablep-when-level11.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level11.proofp-aux)
+                             (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level11.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level11.proofp-aux)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-level11.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level11.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x))
+            (%enable default expensive-arithmetic-rules))
+
+(%autoprove level11.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level11.proofp-aux-when-logic.proofp)
+                             (flag 'proof))))
+
+(%autoprove level11.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level11.proofp-aux-when-logic.proofp)
+                             (flag 'list))))
+
+
+
+(%autoprove forcing-level11.proofp-aux-of-logic.provable-witness
+            (%enable default level11.proofp-aux-when-logic.proofp))
+
+
+(%autoadmit level11.static-checksp)
+(%enable default level11.static-checksp)
+
+(%autoadmit level11.proofp)
+
+(%autoprove booleanp-of-level11.proofp
+            (%enable default level11.proofp))
+
+(%autoprove logic.provablep-when-level11.proofp
+            (%enable default level11.proofp)
+            (%disable default
+                      logic.provablep-when-level11.proofp-aux
+                      unusual-memberp-rules
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-consp
+                      unusual-consp-rules
+                      expensive-term/formula-inference
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      formula-decomposition
+                      )
+            (%use (%instance (%thm logic.provablep-when-level11.proofp-aux)
+                             (x      (third (logic.extras x)))
+                             (defs   (first (logic.extras x)))
+                             (worlds (second (logic.extras x)))))
+            (%auto :strategy (cleanup split crewrite))
+            (%enable default expensive-term/formula-inference))
+
+(defsection level11-transition
+  (%install-new-proofp level11.proofp)
+  (%auto)
+  (%qed-install))
+
+(ACL2::table tactic-harness 'current-adapter 'level11.adapter)
+
+(%switch-builder tactic.compile-skeleton tactic.compile-skeleton-high)
+
+(%finish "level11")
+(%save-events "level11.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level11/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/make-image.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level10/level10")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level11-symmetry"
+                 "Pre-loaded bootstrap/level10 directory.")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/partition.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/partition.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/partition.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/partition.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,212 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%defprojection :list (rev-lists x)
+                :element (rev x)
+                :nil-preservingp t)
+
+(%autoprove rev-lists-of-rev-lists
+            (%cdr-induction x))
+
+
+(%autoadmit fast-app-lists$)
+(%autoadmit app-lists)
+
+(%autoadmit slow-app-lists)
+(%autoprove slow-app-lists-when-not-consp
+            (%restrict default slow-app-lists (equal x 'x)))
+(%autoprove slow-app-lists-of-cons
+            (%restrict default slow-app-lists (equal x '(cons a x))))
+(%autoprove true-listp-of-slow-app-lists
+            (%cdr-induction x))
+(%autoprove slow-app-lists-of-list-fix
+            (%cdr-induction x))
+(%autoprove slow-app-lists-of-app
+            (%cdr-induction x))
+(%autoprove rev-of-slow-app-lists
+            (%cdr-induction x))
+(%autoprove slow-app-lists-of-list-list-fix
+            (%cdr-induction x))
+
+
+
+
+(ACL2::skip-proofs
+ ;; BOZO unlocalize/rename
+ ;; Damn theory invariants -- I'll just skip it.  It's locally proved there.
+ (defthmd lemma1-for-definition-of-app-lists
+   (implies (true-listp acc)
+            (equal (fast-app-lists$ x acc)
+                   (app (slow-app-lists (rev (rev-lists x)))
+                        acc)))
+   :hints(("Goal" :in-theory (enable fast-app-lists$)))))
+
+(ACL2::skip-proofs
+ (defthmd lemma2-for-definition-of-app-lists
+   (equal (app-lists x)
+          (slow-app-lists x))
+   :hints(("Goal" :in-theory (enable app-lists)))))
+
+
+;; BOZO def of app-lists is screwed up in tactics/partition.
+;; Should say app-lists in recursive case, says slow-app-lists.
+(defthmd definition-of-app-lists-alt
+  (equal (app-lists x)
+         (if (consp x)
+             (app (car x)
+                  (app-lists (cdr x)))
+           nil))
+   :rule-classes :definition)
+
+(%autoprove lemma1-for-definition-of-app-lists
+            (%autoinduct fast-app-lists$)
+            (%restrict default fast-app-lists$ (equal x 'x)))
+
+(%autoprove lemma2-for-definition-of-app-lists
+            (%enable default lemma1-for-definition-of-app-lists)
+            (%restrict default app-lists (equal x 'x)))
+
+(%autoprove definition-of-app-lists-alt
+            (%enable default lemma2-for-definition-of-app-lists))
+
+(%autoprove app-lists-when-not-consp
+            (%restrict default definition-of-app-lists-alt (equal x 'x)))
+
+(%autoprove app-lists-of-cons
+            (%restrict default definition-of-app-lists-alt (equal x '(cons a x))))
+
+(%autoprove true-listp-of-app-lists
+            (%cdr-induction x))
+
+(%autoprove app-lists-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove app-lists-of-app
+            (%cdr-induction x))
+
+(%autoprove rev-of-app-lists
+            (%cdr-induction x))
+
+(%autoprove app-lists-of-list-list-fix
+            (%cdr-induction x))
+
+
+
+(%autoadmit fast-sum-list)
+(%autoadmit sum-list)
+(%autoadmit slow-sum-list)
+
+
+(ACL2::skip-proofs
+ ;; BOZO unlocalize/rename
+ (defthm lemma-for-definition-of-sum-list
+   (implies (force (natp acc))
+            (equal (fast-sum-list x acc)
+                   (+ (slow-sum-list x) acc)))
+   :hints(("Goal" :in-theory (enable fast-sum-list
+                                     slow-sum-list)))))
+
+(%autoprove lemma-for-definition-of-sum-list
+            (%autoinduct fast-sum-list)
+            (%restrict default fast-sum-list (equal x 'x))
+            (%restrict default slow-sum-list (equal x 'x)))
+
+(%autoprove definition-of-sum-list
+            (%restrict default slow-sum-list (equal x 'x))
+            (%enable default sum-list))
+
+(%autoprove sum-list-when-not-consp
+            (%restrict default definition-of-sum-list (equal x 'x)))
+
+(%autoprove sum-list-of-cons
+            (%restrict default definition-of-sum-list (equal x '(cons a x))))
+
+(%autoprove natp-of-sum-list
+            (%cdr-induction x))
+
+(%autoprove sum-list-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove sum-list-of-app
+            (%cdr-induction x))
+
+(%autoprove sum-list-of-rev
+            (%cdr-induction x))
+
+
+(%autoprove len-of-restn
+            ;; BOZO move to utilities
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+;; Hrmn, we already have len-of-firstn?? I wonder where that got defined...
+
+(%autoadmit partition)
+
+(%autoprove partition-when-not-consp
+            (%restrict default partition (equal lens 'lens)))
+
+(%autoprove partition-of-cons
+            (%restrict default partition (equal lens '(cons len lens))))
+
+(%autoprove partition-of-list-fix-one
+            (%autoinduct partition))
+
+(%autoprove partition-of-list-fix-two
+            (%autoinduct partition))
+
+(%autoprove true-listp-of-partition
+            (%autoinduct partition))
+
+
+;; BOZO we don't seem to need the arith lemma that is here in tactics/partition
+
+(%autoprove forcing-app-lists-of-partition
+            (%autoinduct partition))
+
+(%autoprove partition-of-strip-lens-of-app-lists
+            (%cdr-induction x))
+
+(%autoprove partition-of-strip-lens-of-app-lists-free)
+
+(%autoprove partition-of-simple-flatten
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/partition"
+                                         ;; BOZO fix this; it's broken, see above, we used -alt.
+                                         definition-of-app-lists)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/replace-subterm.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/replace-subterm.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/replace-subterm.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/replace-subterm.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,316 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+;; BOZO consider moving all of this to a previous level??
+;; Consider making a high-level proof step checker for this stuff??
+
+(%autoadmit build.flag-replace-subterm)
+(%autoadmit build.replace-subterm)
+(%autoadmit build.replace-subterm-list)
+
+(%autoprove definition-of-build.replace-subterm
+            (%enable default
+                     build.replace-subterm-list
+                     build.replace-subterm)
+            (%restrict default build.flag-replace-subterm (or (equal x 'x)
+                                                              (equal x 'old))))
+
+(%autoprove definition-of-build.replace-subterm-list
+            (%enable default
+                     build.replace-subterm-list
+                     build.replace-subterm)
+            (%restrict default build.flag-replace-subterm (equal x 'x)))
+
+(%autoprove build.flag-replace-subterm-of-term
+            (%enable default build.replace-subterm))
+
+(%autoprove build.flag-replace-subterm-of-list
+            (%enable default build.replace-subterm-list))
+
+(%autoprove build.replace-subterm-list-when-not-consp
+            (%restrict default definition-of-build.replace-subterm-list (equal x 'x)))
+
+(%autoprove build.replace-subterm-list-of-cons
+            (%restrict default definition-of-build.replace-subterm-list (equal x '(cons a x))))
+
+(%defprojection
+ :list (build.replace-subterm-list x old new proof)
+ :element (build.replace-subterm x old new proof))
+
+
+
+(defthm lemma-for-forcing-logic.appealp-of-build.replace-subterm
+  ;; BOZO unlocalize/rename in build/replace-subterm.lisp
+  (if (equal flag 'term)
+      (implies (and (logic.termp x)
+                    (logic.termp old)
+                    (logic.termp new)
+                    (logic.appealp proof)
+                    (equal (logic.conclusion proof) (logic.pequal old new)))
+               (and (logic.appealp (build.replace-subterm x old new proof))
+                    (equal (logic.conclusion (build.replace-subterm x old new proof))
+                           (logic.pequal x (logic.replace-subterm x old new)))))
+    (implies (and (logic.term-listp x)
+                  (logic.termp old)
+                  (logic.termp new)
+                  (logic.appealp proof)
+                  (equal (logic.conclusion proof) (logic.pequal old new)))
+             (and (logic.appeal-listp (build.replace-subterm-list x old new proof))
+                  (equal (logic.strip-conclusions (build.replace-subterm-list x old new proof))
+                         (logic.pequal-list x (logic.replace-subterm-list x old new))))))
+  :rule-classes nil)
+
+(%autoprove lemma-for-forcing-logic.appealp-of-build.replace-subterm
+            (%autoinduct build.flag-replace-subterm flag x old new proof)
+            (%auto)
+            (%restrict default definition-of-build.replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old)
+                           (equal x '(LOGIC.=LHS (LOGIC.CONCLUSION PROOF)))))
+            (%restrict default definition-of-logic.replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old)
+                           (equal x '(LOGIC.=LHS (LOGIC.CONCLUSION PROOF))))))
+
+(%autoprove forcing-logic.appealp-of-build.replace-subterm
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.replace-subterm)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.conclusion-of-build.replace-subterm
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.replace-subterm)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.appeal-listp-of-build.replace-subterm-list
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.replace-subterm)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.strip-conclusions-of-build.replace-subterm-list
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.replace-subterm)
+                             (flag 'list))))
+
+(defthm@ lemma-for-forcing-logic.proofp-of-build.replace-subterm
+  ;; BOZO unlocalize/rename in build/replace-subterm
+  (if (equal flag 'term)
+      (implies (and (logic.termp x)
+                    (logic.termp old)
+                    (logic.termp new)
+                    (logic.appealp proof)
+                    (equal (logic.conclusion proof) (logic.pequal old new))
+                    ;; ---
+                    (logic.term-atblp x atbl)
+                    (logic.proofp proof axioms thms atbl)
+                    (@obligations build.replace-subterm))
+               (logic.proofp (build.replace-subterm x old new proof) axioms thms atbl))
+    (implies (and (logic.term-listp x)
+                  (logic.termp old)
+                  (logic.termp new)
+                  (logic.appealp proof)
+                  (equal (logic.conclusion proof) (logic.pequal old new))
+                  ;; ---
+                  (logic.term-list-atblp x atbl)
+                  (logic.proofp proof axioms thms atbl)
+                  (@obligations build.replace-subterm-list))
+             (logic.proof-listp (build.replace-subterm-list x old new proof) axioms thms atbl)))
+  :rule-classes nil)
+
+(%autoprove lemma-for-forcing-logic.proofp-of-build.replace-subterm
+            (%autoinduct build.flag-replace-subterm flag x old new proof)
+            (%auto)
+            (%restrict default definition-of-build.replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old)
+                           (equal x '(LOGIC.=LHS (LOGIC.CONCLUSION PROOF)))))
+            (%restrict default definition-of-logic.replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old)
+                           (equal x '(LOGIC.=LHS (LOGIC.CONCLUSION PROOF))))))
+
+(%autoprove forcing-logic.proofp-of-build.replace-subterm
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-build.replace-subterm)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.proof-listp-of-build.replace-subterm-list
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-build.replace-subterm)
+                             (flag 'list))))
+
+
+
+
+
+
+(%autoadmit build.flag-disjoined-replace-subterm)
+(%autoadmit build.disjoined-replace-subterm)
+(%autoadmit build.disjoined-replace-subterm-list)
+
+(%autoprove definition-of-build.disjoined-replace-subterm
+            (%enable default
+                     build.disjoined-replace-subterm
+                     build.disjoined-replace-subterm-list)
+            (%restrict default build.flag-disjoined-replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old))))
+
+(%autoprove definition-of-build.disjoined-replace-subterm-list
+            (%enable default
+                     build.disjoined-replace-subterm
+                     build.disjoined-replace-subterm-list)
+            (%restrict default build.flag-disjoined-replace-subterm (equal x 'x)))
+
+(%autoprove build.flag-disjoined-replace-subterm-of-term
+            (%enable default build.disjoined-replace-subterm))
+
+(%autoprove build.flag-disjoined-replace-subterm-of-list
+            (%enable default build.disjoined-replace-subterm-list))
+
+(%autoprove build.disjoined-replace-subterm-list-when-not-consp
+            (%restrict default definition-of-build.disjoined-replace-subterm-list
+                       (equal x 'x)))
+
+(%autoprove build.disjoined-replace-subterm-list-of-cons
+            (%restrict default definition-of-build.disjoined-replace-subterm-list
+                       (equal x '(cons a x))))
+
+(%defprojection
+ :list (build.disjoined-replace-subterm-list x old new proof)
+ :element (build.disjoined-replace-subterm x old new proof))
+
+
+
+(defthm lemma-for-forcing-logic.appealp-of-build.disjoined-replace-subterm
+  ;; BOZO unlocalize/rename in build.replace-subterm
+  (if (equal flag 'term)
+      (implies (and (logic.termp x)
+                    (logic.termp old)
+                    (logic.termp new)
+                    (logic.appealp proof)
+                    (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                    (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new)))
+               (and (logic.appealp (build.disjoined-replace-subterm x old new proof))
+                    (equal (logic.conclusion (build.disjoined-replace-subterm x old new proof))
+                           (logic.por (logic.vlhs (logic.conclusion proof))
+                                      (logic.pequal x (logic.replace-subterm x old new))))))
+    (implies (and (logic.term-listp x)
+                  (logic.termp old)
+                  (logic.termp new)
+                  (logic.appealp proof)
+                  (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                  (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new)))
+             (and (logic.appeal-listp (build.disjoined-replace-subterm-list x old new proof))
+                  (equal (logic.strip-conclusions (build.disjoined-replace-subterm-list x old new proof))
+                         (logic.por-list (repeat (logic.vlhs (logic.conclusion proof)) (len x))
+                                         (logic.pequal-list x (logic.replace-subterm-list x old new)))))))
+  :rule-classes nil)
+
+(%autoprove lemma-for-forcing-logic.appealp-of-build.disjoined-replace-subterm
+            (%autoinduct build.flag-disjoined-replace-subterm)
+            (%auto)
+            (%restrict default definition-of-build.disjoined-replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old)
+                           (equal x '(LOGIC.=LHS (LOGIC.VRHS (LOGIC.CONCLUSION PROOF))))))
+            (%restrict default definition-of-logic.replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old)
+                           (equal x '(LOGIC.=LHS (LOGIC.VRHS (LOGIC.CONCLUSION PROOF)))))))
+
+(%autoprove forcing-logic.appealp-of-build.disjoined-replace-subterm
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-replace-subterm)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.conclusion-of-build.disjoined-replace-subterm
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-replace-subterm)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.appeal-listp-of-build.disjoined-replace-subterm-list
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-replace-subterm)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.strip-conclusions-of-build.disjoined-replace-subterm-list
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-replace-subterm)
+                             (flag 'list))))
+
+
+(defthm@ lemma-for-forcing-logic.proofp-of-build.disjoined-replace-subterm
+  ;; BOZO unlocalize/rename in build/replace-subterm
+  (if (equal flag 'term)
+      (implies (and (logic.termp x)
+                    (logic.termp old)
+                    (logic.termp new)
+                    (logic.appealp proof)
+                    (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                    (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))
+                    ;; ---
+                    (logic.term-atblp x atbl)
+                    (logic.proofp proof axioms thms atbl)
+                    (@obligations build.disjoined-replace-subterm))
+               (logic.proofp (build.disjoined-replace-subterm x old new proof) axioms thms atbl))
+    (implies (and (logic.term-listp x)
+                  (logic.termp old)
+                  (logic.termp new)
+                  (logic.appealp proof)
+                  (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                  (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))
+                  ;; ---
+                  (logic.term-list-atblp x atbl)
+                  (logic.proofp proof axioms thms atbl)
+                  (@obligations build.disjoined-replace-subterm-list))
+             (logic.proof-listp (build.disjoined-replace-subterm-list x old new proof) axioms thms atbl)))
+  :rule-classes nil)
+
+
+(%autoprove lemma-for-forcing-logic.proofp-of-build.disjoined-replace-subterm
+            (%autoinduct build.flag-disjoined-replace-subterm)
+            (%auto)
+            (%restrict default definition-of-build.disjoined-replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old)
+                           (equal x '(LOGIC.=LHS (LOGIC.VRHS (LOGIC.CONCLUSION PROOF))))))
+            (%restrict default definition-of-logic.replace-subterm
+                       (or (equal x 'x)
+                           (equal x 'old)
+                           (equal x '(LOGIC.=LHS (LOGIC.VRHS (LOGIC.CONCLUSION PROOF)))))))
+
+(%autoprove forcing-logic.proofp-of-build.disjoined-replace-subterm
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-build.disjoined-replace-subterm)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.proof-listp-of-build.disjoined-replace-subterm-list
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-build.disjoined-replace-subterm)
+                             (flag 'list))))
+
+(%ensure-exactly-these-rules-are-missing "../../build/replace-subterm")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/simple-world-change.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/simple-world-change.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/simple-world-change.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/simple-world-change.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,105 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(%interactive)
+
+
+(%autoadmit tactic.simple-world-change-aux)
+
+(%autoprove tactic.worldp-of-tactic.simple-world-change-aux
+            (%autoinduct tactic.simple-world-change-aux)
+            (%restrict default tactic.simple-world-change-aux (equal changes 'changes)))
+
+(%autoprove tactic.world-atblp-of-tactic.simple-world-change-aux
+            (%autoinduct tactic.simple-world-change-aux)
+            (%restrict default tactic.simple-world-change-aux (equal changes 'changes)))
+
+(%autoprove tactic.world-env-okp-of-tactic.simple-world-change-aux
+            (%autoinduct tactic.simple-world-change-aux)
+            (%restrict default tactic.simple-world-change-aux (equal changes 'changes)))
+
+(%autoprove tactic.world->index-of-tactic.simple-world-change-aux
+            (%autoinduct tactic.simple-world-change-aux)
+            (%restrict default tactic.simple-world-change-aux (equal changes 'changes)))
+
+
+(%autoadmit tactic.simple-world-change)
+
+(%autoprove tactic.worldp-of-tactic.simple-world-change
+            (%enable default tactic.simple-world-change))
+
+(%autoprove tactic.world-atblp-of-tactic.simple-world-change
+            (%enable default tactic.simple-world-change))
+
+(%autoprove tactic.world-env-okp-of-tactic.simple-world-change
+            (%enable default tactic.simple-world-change))
+
+(%autoprove tactic.world->index-of-tactic.simple-world-change
+            (%enable default tactic.simple-world-change))
+
+
+(%autoadmit tactic.simple-change-world-okp)
+
+(%autoprove booleanp-of-tactic.simple-change-world-okp
+            (%enable default tactic.simple-change-world-okp))
+
+(%autoprove tactic.skeleton->goals-when-tactic.simple-change-world-okp
+            (%enable default tactic.simple-change-world-okp))
+
+
+(%autoadmit tactic.simple-change-world-tac)
+
+(%autoprove tactic.skeletonp-of-tactic.simple-change-world-tac
+            (%enable default tactic.simple-change-world-tac))
+
+(%autoprove tactic.simple-change-world-okp-of-tactic.simple-change-world-tac
+            (%enable default
+                     tactic.simple-change-world-tac
+                     tactic.simple-change-world-okp))
+
+(%autoadmit tactic.simple-change-world-compile-world)
+
+(%autoprove tactic.worldp-of-tactic.simple-change-world-compile-world
+            (%enable default tactic.simple-change-world-compile-world))
+
+(%autoprove tactic.world-atblp-of-tactic.simple-change-world-compile-world
+            (%enable default tactic.simple-change-world-compile-world))
+
+(%autoprove tactic.world-env-okp-of-tactic.simple-change-world-compile-world
+            (%enable default tactic.simple-change-world-compile-world))
+
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/simple-world-change")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/skeletonp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/skeletonp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/skeletonp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/skeletonp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,245 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit tactic.skeletonp)
+(%autoadmit tactic.skeleton->goals)
+(%autoadmit tactic.skeleton->tacname)
+(%autoadmit tactic.skeleton->extras)
+(%autoadmit tactic.skeleton->history)
+
+(%autoprove booleanp-of-tactic.skeletonp
+            (%autoinduct tactic.skeletonp)
+            (%restrict default tactic.skeletonp (equal x 'x)))
+
+(%autoprove forcing-logic.term-list-listp-of-tactic.skeleton->goals
+            (%enable default tactic.skeleton->goals)
+            (%restrict default tactic.skeletonp (equal x 'x)))
+
+(%autoprove forcing-cons-listp-of-tactic.skeleton->goals
+            (%enable default tactic.skeleton->goals)
+            (%restrict default tactic.skeletonp (equal x 'x)))
+
+(%autoprove forcing-true-listp-of-tactic.skeleton->goals
+            (%enable default tactic.skeleton->goals)
+            (%restrict default tactic.skeletonp (equal x 'x)))
+
+(%autoprove forcing-symbolp-of-tactic.skeleton->tacname
+            (%enable default tactic.skeleton->tacname)
+            (%restrict default tactic.skeletonp (equal x 'x)))
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.skeleton->history
+            (%enable default
+                     tactic.skeleton->tacname
+                     tactic.skeleton->history)
+            (%restrict default tactic.skeletonp (equal x 'x)))
+
+(%autoprove rank-of-tactic.skeleton->history-when-tactic.skeleton->tacname
+            (%enable default
+                     tactic.skeleton->tacname
+                     tactic.skeleton->history)
+            (%restrict default tactic.skeletonp (equal x 'x)))
+
+
+(%autoadmit tactic.initial-skeleton)
+
+(%autoprove tactic.skeleton->goals-of-tactic.initial-skeleton
+            (%enable default
+                     tactic.initial-skeleton
+                     tactic.skeleton->goals))
+
+(%autoprove tactic.skeleton->tacname-of-tactic.initial-skeleton
+            (%enable default
+                     tactic.initial-skeleton
+                     tactic.skeleton->tacname))
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.initial.skeleton
+            (%enable default tactic.initial-skeleton)
+            (%restrict default tactic.skeletonp (equal x '(cons goals '(nil nil nil)))))
+
+(%autoadmit tactic.extend-skeleton)
+
+(%autoprove tactic.skeleton->goals-of-tactic.extend-skeleton
+            (%enable default
+                     tactic.extend-skeleton
+                     tactic.skeleton->goals))
+
+(%autoprove tactic.skeleton->tacname-of-tactic.extend-skeleton
+            (%enable default
+                     tactic.extend-skeleton
+                     tactic.skeleton->tacname))
+
+(%autoprove tactic.skeleton->extras-of-tactic.extend-skeleton
+            (%enable default
+                     tactic.extend-skeleton
+                     tactic.skeleton->extras))
+
+(%autoprove tactic.skeleton->history-of-tactic.extend-skeleton
+            (%enable default
+                     tactic.extend-skeleton
+                     tactic.skeleton->history))
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.extend.skeleton
+            (%enable default tactic.extend-skeleton)
+            (%restrict default tactic.skeletonp
+                       (equal x '(CONS GOALS
+                                  (CONS TACNAME
+                                        (CONS EXTRAS (CONS HISTORY 'NIL)))))))
+
+
+
+(%autoadmit tactic.original-conclusions)
+
+(%autoprove forcing-logic.term-list-listp-of-tactic.original-conclusion
+            (%autoinduct tactic.original-conclusions)
+            (%restrict default tactic.original-conclusions (equal x 'x)))
+
+(%autoprove forcing-cons-listp-of-tactic.original-conclusion
+            (%autoinduct tactic.original-conclusions)
+            (%restrict default tactic.original-conclusions (equal x 'x)))
+
+(%autoprove forcing-true-listp-of-tactic.original-conclusion
+            (%autoinduct tactic.original-conclusions)
+            (%restrict default tactic.original-conclusions (equal x 'x)))
+
+(%autoprove tactic.original-conclusions-of-tactic.initial-skeleton
+            (%restrict default tactic.original-conclusions
+                       (equal x '(tactic.initial-skeleton goals))))
+
+(%autoprove forcing-tactic.original-conclusions-of-tactic.extend-skeleton
+            (%restrict default tactic.original-conclusions
+                       (equal x '(tactic.extend-skeleton goals tacname extras history))))
+
+
+(%autoadmit tactic.skeleton-atblp)
+
+(%autoprove booleanp-of-tactic.skeleton-atbp
+            ;; BOZO bad name
+            (%autoinduct tactic.skeleton-atblp)
+            (%restrict default tactic.skeleton-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-tactic.skeleton->goals
+            (%autoinduct tactic.skeleton-atblp)
+            (%restrict default tactic.skeleton-atblp (equal x 'x)))
+
+(%autoprove forcing-tactic.skeleton-atblp-of-tactic.skeleton->history
+            (%restrict default tactic.skeleton-atblp (equal x 'x)))
+
+(%autoprove forcing-tactic.skeleton-atblp-of-tactic.initial.skeleton
+            (%restrict default tactic.skeleton-atblp (equal x '(tactic.initial-skeleton goals))))
+
+(%autoprove forcing-tactic.skeleton-atblp-of-tactic.extend.skeleton
+            (%disable default
+                      forcing-logic.term-list-list-atblp-of-tactic.skeleton->goals
+                      forcing-tactic.skeleton-atblp-of-tactic.skeleton->history)
+            (%restrict default tactic.skeleton-atblp
+                       (equal x '(TACTIC.EXTEND-SKELETON GOALS TACNAME EXTRAS HISTORY))))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-tactic.original-conclusion
+            (%autoinduct tactic.original-conclusions)
+            (%restrict default tactic.original-conclusions
+                       (equal x 'x)))
+
+
+
+(%autoadmit tactic.skeleton->len)
+
+(%autoprove natp-of-tactic.skeleton->len
+            (%autoinduct tactic.skeleton->len)
+            (%restrict default tactic.skeleton->len (equal x 'x)))
+
+(%autoprove tactic.skeleton->len-nonzero
+            (%autoinduct tactic.skeleton->len)
+            (%restrict default tactic.skeleton->len (equal x 'x)))
+
+(%autoprove tactic.skeleton->len-when-not-tacname
+            (%autoinduct tactic.skeleton->len)
+            (%restrict default tactic.skeleton->len (equal x 'x)))
+
+
+
+(%autoadmit logic.slow-term-list-list-arities)
+(%autoadmit logic.term-list-list-arities)
+
+(%autoprove true-listp-of-logic.term-list-list-arities
+            (%autoinduct logic.term-list-list-arities x acc)
+            (%restrict default logic.term-list-list-arities (equal x 'x)))
+
+(%autoprove logic.term-list-list-arities-removal
+            (%autoinduct logic.term-list-list-arities x acc)
+            (%restrict default logic.term-list-list-arities (equal x 'x))
+            (%restrict default logic.slow-term-list-list-arities (equal x 'x)))
+
+(%autoprove logic.slow-term-list-list-arities-correct
+            (%cdr-induction x)
+            (%restrict default logic.term-list-list-atblp (equal x 'x))
+            (%restrict default logic.slow-term-list-list-arities (equal x 'x)))
+
+
+(%autoadmit tactic.slow-skeleton-arities)
+(%autoadmit tactic.skeleton-arities)
+
+(%autoprove true-listp-of-tactic.skeleton-arities
+            (%autoinduct tactic.skeleton-arities x acc)
+            (%restrict default tactic.skeleton-arities (equal x 'x)))
+
+(%autoprove tactic.skeleton-arities-removal
+            (%autoinduct tactic.skeleton-arities x acc)
+            (%restrict default tactic.skeleton-arities (equal x 'x))
+            (%restrict default tactic.slow-skeleton-arities (equal x 'x)))
+
+(%autoprove logic.slow-skeleton-arities-correct
+            (%autoinduct tactic.skeleton-atblp x atbl)
+            (%restrict default tactic.slow-skeleton-arities (equal x 'x))
+            (%restrict default tactic.skeleton-atblp (equal x 'x))
+            (%disable default
+                      forcing-tactic.skeleton-atblp-of-tactic.skeleton->history
+                      forcing-logic.term-list-list-atblp-of-tactic.skeleton->goals))
+
+(%autoadmit tactic.fast-skeleton-atblp)
+
+(%autoprove tactic.fast-skeleton-atblp-correct
+            (%enable default tactic.fast-skeleton-atblp))
+
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/skeletonp")
+(%ensure-exactly-these-rules-are-missing "../../tactics/worldp")
+(%ensure-exactly-these-rules-are-missing "../../tactics/urewrite-world")
+(%ensure-exactly-these-rules-are-missing "../../tactics/crewrite-world")
+(%ensure-exactly-these-rules-are-missing "../../tactics/colors")
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/split-all.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/split-all.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/split-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/split-all.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,153 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "partition")
+(include-book "skeletonp")
+(%interactive)
+
+
+
+;; BOZO all this stuff belongs somewhere else.
+
+(%autoprove firstn-of-nfix
+            (%autoinduct firstn))
+
+(%autoprove restn-of-nfix
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove cons-listp-of-list-list-fix
+            ;; BOZO this was also autoproved in waterfall-steps.lisp, which caused a problem
+            ;; during proof checking which seemed to have to do with one file overwriting
+            ;; the other?  Now I'm just including this file in waterfall-steps.lisp to
+            ;; avoid this.
+            (%cdr-induction x))
+
+(%autoprove true-list-listp-of-list-list-fix
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-listp-of-list-list-fix
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-list-atblp-of-list-list-fix
+            (%cdr-induction x))
+
+(%autoprove logic.strip-conclusions-list-of-partition
+            (%autoinduct partition))
+
+(%autoprove nat-listp-of-strip-lens-free)
+
+(%autoprove logic.appeal-list-listp-of-partition
+            (%autoinduct partition lens proofs))
+
+(%autoprove true-list-listp-of-cdr-of-clause.split-list
+            (%autoinduct clause.split-list))
+
+(%autoprove list-list-fix-when-true-list-listp
+            (%cdr-induction x))
+
+(%autoprove clause.clause-list-list-formulas-of-partition
+            (%autoinduct partition))
+
+(%autoprove logic.proof-list-listp-of-partition
+            (%autoinduct partition))
+
+
+
+(%autoadmit tactic.split-all-okp)
+
+(%autoprove booleanp-of-tactic.split-all-okp
+            (%enable default tactic.split-all-okp))
+
+(%autoprove forcing-cons-listp-of-simple-flatten
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-listp-of-simple-flatten
+            (%cdr-induction x))
+
+
+(%autoadmit tactic.split-all-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.split-all-tac
+            (%enable default tactic.split-all-tac))
+
+(%autoprove forcing-tactic.split-all-okp-of-tactic.split-all-tac
+            (%enable default
+                     tactic.split-all-tac
+                     tactic.split-all-okp))
+
+
+
+(encapsulate
+ ()
+ (%autoadmit tactic.split-all-compile)
+
+ (local (%enable default tactic.split-all-okp tactic.split-all-compile))
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.split-all-compile
+             (%disable default
+                       partition-of-simple-flatten
+                       [outside]partition-of-simple-flatten)
+             (%use (%instance
+                    (%thm partition-of-simple-flatten)
+                    (x (cdr (clause.split-list (first (tactic.skeleton->extras x))
+                                               (second (tactic.skeleton->extras x))
+                                               (third (tactic.skeleton->extras x))
+                                               (list-list-fix (tactic.skeleton->goals (tactic.skeleton->history x)))))))))
+
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.split-all-compile
+             (%disable default
+                       partition-of-simple-flatten
+                       [outside]partition-of-simple-flatten)
+             (%use (%instance
+                    (%thm partition-of-simple-flatten)
+                    (x (cdr (clause.split-list (first (tactic.skeleton->extras x))
+                                               (second (tactic.skeleton->extras x))
+                                               (third (tactic.skeleton->extras x))
+                                               (list-list-fix (tactic.skeleton->goals (tactic.skeleton->history x)))))))))
+
+ (%autoprove forcing-logic.proof-listp-of-tactic.split-all-compile
+             (%disable default
+                       partition-of-simple-flatten
+                       [outside]partition-of-simple-flatten)
+             (%use (%instance
+                    (%thm partition-of-simple-flatten)
+                    (x (cdr (clause.split-list (first (tactic.skeleton->extras x))
+                                               (second (tactic.skeleton->extras x))
+                                               (third (tactic.skeleton->extras x))
+                                               (list-list-fix (tactic.skeleton->goals (tactic.skeleton->history x)))))))))
+ )
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/split-all")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/split-first.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/split-first.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/split-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/split-first.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,115 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(%interactive)
+
+
+(defthmd crock1-for-tactic.split-first-compile
+  ;; BOZO unlocalize/rename
+  (implies (and (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                       (logic.strip-conclusions proofs))
+                (equal (firstn n goals) y))
+           (equal (logic.strip-conclusions (firstn n proofs))
+                  (logic.disjoin-each-formula-list (logic.term-list-list-formulas y))))
+  :hints(("Goal"
+          :in-theory (disable firstn-of-logic.disjoin-each-formula-list)
+          :use ((:instance firstn-of-logic.disjoin-each-formula-list
+                           (x (logic.term-list-list-formulas goals))
+                           (y n))))))
+
+(defthm crock2-for-tactic.split-first-compile
+  ;; BOZO unlocalize/rename
+  (implies (and (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                       (logic.strip-conclusions proofs))
+                (equal (restn n goals) y))
+           (equal (logic.strip-conclusions (restn n proofs))
+                  (logic.disjoin-each-formula-list (logic.term-list-list-formulas y))))
+  :hints(("Goal"
+          :in-theory (disable restn-of-logic.disjoin-each-formula-list)
+          :use ((:instance restn-of-logic.disjoin-each-formula-list
+                           (x (logic.term-list-list-formulas goals))
+                           (y n))))))
+
+
+
+(%autoadmit tactic.split-first-okp)
+
+(%autoprove booleanp-of-tactic.split-first-okp
+            (%enable default tactic.split-first-okp))
+
+
+(%autoadmit tactic.split-first-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.split-first-tac
+            (%enable default tactic.split-first-tac))
+
+(%autoprove forcing-tactic.split-first-okp-of-tactic.split-first-tac
+            (%enable default tactic.split-first-tac tactic.split-first-okp))
+
+
+(%autoadmit tactic.split-first-compile)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.split-first-okp
+                 tactic.split-first-compile))
+
+ (%autoprove crock1-for-tactic.split-first-compile
+             (%disable default
+                       firstn-of-logic.disjoin-each-formula-list
+                       [outside]firstn-of-logic.disjoin-each-formula-list)
+             (%use (%instance (%thm firstn-of-logic.disjoin-each-formula-list)
+                              (x (logic.term-list-list-formulas goals))
+                              (y n))))
+
+ (%autoprove crock2-for-tactic.split-first-compile
+             (%disable default
+                       restn-of-logic.disjoin-each-formula-list
+                       [outside]restn-of-logic.disjoin-each-formula-list)
+             (%use (%instance (%thm restn-of-logic.disjoin-each-formula-list)
+                              (x (logic.term-list-list-formulas goals))
+                              (y n))))
+
+ (local (%enable default
+                 crock1-for-tactic.split-first-compile
+                 crock2-for-tactic.split-first-compile))
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.split-first-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.split-first-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.split-first-compile))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/split-first")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level11/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/symmetry	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level11-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/theory-change.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/theory-change.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/theory-change.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/theory-change.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,304 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(include-book "translate")
+(%interactive)
+
+
+(%autoprove rw.theory-list-atblp-of-range-of-clean-update
+            (%autoinduct clean-update theoryname val theories))
+(%autoprove rw.theory-list-env-okp-of-range-of-clean-update
+            (%autoinduct clean-update theoryname val theories))
+
+
+(%autoadmit tactic.find-theory)
+(%autoprove rw.theoryp-of-tactic.find-theory
+            (%enable default tactic.find-theory))
+(%autoprove rw.theory-atblp-of-tactic.find-theory
+            (%enable default tactic.find-theory))
+(%autoprove rw.theory-env-okp-of-tactic.find-theory
+            (%enable default tactic.find-theory))
+
+
+(%autoadmit tactic.find-rule)
+(%autoprove rw.rulep-of-tactic.find-rule
+            (%enable default tactic.find-rule))
+(%autoprove rw.rule-atblp-of-tactic.find-rule
+            (%enable default tactic.find-rule))
+(%autoprove rw.rule-env-okp-of-tactic.find-rule
+            (%enable default tactic.find-rule))
+
+
+(%autoadmit tactic.create-theory)
+(%autoprove tactic.worldp-of-tactic.create-theory
+            (%enable default tactic.create-theory))
+(%autoprove tactic.worldp-atblp-of-tactic.create-theory
+            ;; BOZO misnamed
+            (%enable default tactic.create-theory))
+(%autoprove tactic.world-env-okp-of-tactic.create-theory
+            (%enable default tactic.create-theory))
+(%autoprove tactic.world->index-of-tactic.create-theory
+            (%enable default tactic.create-theory))
+
+
+(%autoadmit tactic.create-theory-okp)
+(%autoprove booleanp-of-tactic.create-theory-okp
+            (%enable default tactic.create-theory-okp))
+(%autoprove tactic.skeleton->goals-when-tactic.create-theory-okp
+            (%enable default tactic.create-theory-okp))
+
+
+(%autoadmit tactic.create-theory-tac)
+(%autoprove tactic.skeletonp-of-tactic.create-theory-tac
+            (%enable default tactic.create-theory-tac))
+(%autoprove tactic.create-theory-okp-of-tactic.create-theory-tac
+            (%enable default
+                     tactic.create-theory-tac
+                     tactic.create-theory-okp))
+
+
+(%autoadmit tactic.create-theory-compile-world)
+(%autoprove tactic.worldp-of-tactic.create-theory-compile-world
+            (%enable default
+                     tactic.create-theory-compile-world
+                     tactic.create-theory-okp))
+(%autoprove tactic.world-atblp-of-tactic.create-theory-compile-world
+   (%enable default
+            tactic.create-theory-compile-world
+            tactic.create-theory-okp))
+(%autoprove tactic.world-env-okp-of-tactic.create-theory-compile-world
+            (%enable default
+                     tactic.create-theory-compile-world
+                     tactic.create-theory-okp))
+
+
+(%autoadmit tactic.collect-rules)
+(%autoprove true-listp-of-tactic.collect-rules
+            (%autoinduct tactic.collect-rules x world acc)
+            (%restrict default tactic.collect-rules (equal x 'x)))
+(%autoprove rw.rule-listp-of-tactic.collect-rules
+            (%autoinduct tactic.collect-rules x world acc)
+            (%restrict default tactic.collect-rules (equal x 'x)))
+(%autoprove rw.rule-list-atblp-of-tactic.collect-rules
+            (%autoinduct tactic.collect-rules x world acc)
+            (%restrict default tactic.collect-rules (equal x 'x)))
+(%autoprove rw.rule-list-env-okp-of-tactic.collect-rules
+            (%autoinduct tactic.collect-rules x world acc)
+            (%restrict default tactic.collect-rules (equal x 'x)))
+
+
+(%autoadmit tactic.e/d)
+(%autoprove tactic.worldp-of-tactic.e/d
+            (%enable default tactic.e/d))
+(%autoprove tactic.worldp-atblp-of-tactic.e/d
+            ;; BOZO misnamed
+            (%enable default tactic.e/d))
+(%autoprove tactic.world-env-okp-of-tactic.e/d
+            (%enable default tactic.e/d))
+(%autoprove tactic.world->index-of-tactic.e/d
+            (%enable default tactic.e/d))
+
+
+(%autoadmit tactic.e/d-okp)
+(%autoprove booleanp-of-tactic.e/d-okp
+            (%enable default tactic.e/d-okp))
+(%autoprove tactic.skeleton->goals-when-tactic.e/d-okp
+            (%enable default tactic.e/d-okp))
+
+
+(%autoadmit tactic.e/d-tac)
+(%autoprove tactic.skeletonp-of-tactic.e/d-tac
+            (%enable default tactic.e/d-tac))
+(%autoprove tactic.e/d-okp-of-tactic.e/d-tac
+            (%enable default tactic.e/d-tac tactic.e/d-okp))
+
+
+(%autoadmit tactic.e/d-compile-world)
+(%autoprove tactic.worldp-of-tactic.e/d-compile-world
+            (%enable default tactic.e/d-compile-world tactic.e/d-okp))
+(%autoprove tactic.world-atblp-of-tactic.e/d-compile-world
+            (%enable default tactic.e/d-compile-world tactic.e/d-okp))
+(%autoprove tactic.world-env-okp-of-tactic.e/d-compile-world
+            (%enable default tactic.e/d-compile-world tactic.e/d-okp))
+
+
+(%autoadmit tactic.restrict)
+(%autoprove tactic.worldp-of-tactic.restrict
+            (%enable default tactic.restrict))
+(%autoprove tactic.worldp-atblp-of-tactic.restrict
+            ;; BOZO misnamed
+            (%enable default tactic.restrict))
+(%autoprove lemma-for-tactic.world-env-okp-of-tactic.restrict
+            (%enable default rw.rule-env-okp rw.rule-clause))
+(%autoprove tactic.world-env-okp-of-tactic.restrict
+            (%enable default tactic.restrict))
+(%autoprove tactic.world->index-of-tactic.restrict
+            (%enable default tactic.restrict))
+
+
+(%autoadmit tactic.restrict-okp)
+(%autoprove booleanp-of-tactic.restrict-okp
+            (%enable default tactic.restrict-okp))
+(%autoprove tactic.skeleton->goals-when-tactic.restrict-okp
+            (%enable default tactic.restrict-okp))
+
+
+(%autoadmit tactic.restrict-tac)
+(%autoprove tactic.skeletonp-of-tactic.restrict-tac
+            (%enable default tactic.restrict-tac))
+(%autoprove tactic.restrict-okp-of-tactic.restrict-tac
+            (%enable default tactic.restrict-tac tactic.restrict-okp))
+
+
+(%autoadmit tactic.restrict-compile-world)
+(%autoprove tactic.worldp-of-tactic.restrict-compile-world
+            (%enable default tactic.restrict-compile-world tactic.restrict-okp))
+(%autoprove tactic.world-atblp-of-tactic.restrict-compile-world
+            (%enable default tactic.restrict-compile-world tactic.restrict-okp))
+(%autoprove tactic.world-env-okp-of-tactic.restrict-compile-world
+            (%enable default tactic.restrict-compile-world tactic.restrict-okp))
+
+
+(%autoadmit tactic.update-noexec)
+(%autoprove tactic.worldp-of-tactic.update-noexec
+            (%enable default tactic.update-noexec))
+(%autoprove tactic.worldp-atblp-of-tactic.update-noexec
+            ;; BOZO misnamed
+            (%enable default tactic.update-noexec))
+(%autoprove tactic.world-env-okp-of-tactic.update-noexec
+            (%enable default tactic.update-noexec))
+(%autoprove tactic.world->index-of-tactic.update-noexec
+            (%enable default tactic.update-noexec))
+
+
+(%autoadmit tactic.update-noexec-okp)
+(%autoprove booleanp-of-tactic.update-noexec-okp
+            (%enable default tactic.update-noexec-okp))
+(%autoprove tactic.skeleton->goals-when-tactic.update-noexec-okp
+            (%enable default tactic.update-noexec-okp))
+
+
+(%autoadmit tactic.update-noexec-tac)
+(%autoprove tactic.skeletonp-of-tactic.update-noexec-tac
+            (%enable default tactic.update-noexec-tac))
+(%autoprove tactic.update-noexec-okp-of-tactic.update-noexec-tac
+            (%enable default tactic.update-noexec-tac tactic.update-noexec-okp))
+
+
+(%autoadmit tactic.update-noexec-compile-world)
+(%autoprove tactic.worldp-of-tactic.update-noexec-compile-world
+            (%enable default
+                     tactic.update-noexec-compile-world
+                     tactic.update-noexec-okp))
+(%autoprove tactic.world-atblp-of-tactic.update-noexec-compile-world
+            (%enable default
+                     tactic.update-noexec-compile-world
+                     tactic.update-noexec-okp))
+(%autoprove tactic.world-env-okp-of-tactic.update-noexec-compile-world
+            (%enable default
+                     tactic.update-noexec-compile-world
+                     tactic.update-noexec-okp))
+
+
+(%autoadmit tactic.cheapen-each-hyp)
+(%autoprove rw.hyp-list-terms-of-tactic.cheapen-each-hyp
+            (%autoinduct tactic.cheapen-each-hyp)
+            (%restrict default tactic.cheapen-each-hyp (equal hyps 'hyps)))
+(%autoprove forcing-rw.hyp-listp-of-tactic.cheapen-each-hyp
+            (%autoinduct tactic.cheapen-each-hyp)
+            (%restrict default tactic.cheapen-each-hyp (equal hyps 'hyps)))
+(%autoprove forcing-rw.hyp-list-atblp-of-tactic.cheapen-each-hyp
+            (%autoinduct tactic.cheapen-each-hyp)
+            (%restrict default tactic.cheapen-each-hyp (equal hyps 'hyps)))
+
+
+(%autoadmit tactic.cheapen-rule)
+(%autoprove rw.rulep-of-tactic.cheapen-rule
+            (%enable default tactic.cheapen-rule))
+(%autoprove rw.rule-atblp-of-tactic.cheapen-rule
+            (%enable default tactic.cheapen-rule))
+(%autoprove rw.rule-env-okp-of-tactic.cheapen-rule
+            (%enable default tactic.cheapen-rule rw.rule-env-okp rw.rule-clause))
+
+
+(%autoadmit tactic.cheapen-rules)
+(%autoprove rw.rule-listp-of-tactic.cheapen-rules
+            (%autoinduct tactic.cheapen-rules)
+            (%restrict default tactic.cheapen-rules (equal rules 'rules)))
+(%autoprove rw.rule-list-atblp-of-tactic.cheapen-rules
+            (%autoinduct tactic.cheapen-rules)
+            (%restrict default tactic.cheapen-rules (equal rules 'rules)))
+(%autoprove rw.rule-list-env-okp-of-tactic.cheapen-rules
+            (%autoinduct tactic.cheapen-rules)
+            (%restrict default tactic.cheapen-rules (equal rules 'rules)))
+
+
+(%autoadmit tactic.cheapen)
+(%autoprove tactic.worldp-of-tactic.cheapen
+            (%enable default tactic.cheapen))
+(%autoprove tactic.worldp-atblp-of-tactic.cheapen
+            ;; BOZO misnamed
+            (%enable default tactic.cheapen))
+(%autoprove tactic.world-env-okp-of-tactic.cheapen
+            (%enable default tactic.cheapen))
+(%autoprove tactic.world->index-of-tactic.cheapen
+            (%enable default tactic.cheapen))
+
+
+(%autoadmit tactic.cheapen-okp)
+(%autoprove booleanp-of-tactic.cheapen-okp
+            (%enable default tactic.cheapen-okp))
+(%autoprove tactic.skeleton->goals-when-tactic.cheapen-okp
+            (%enable default tactic.cheapen-okp))
+
+
+(%autoadmit tactic.cheapen-tac)
+(%autoprove tactic.skeletonp-of-tactic.cheapen-tac
+            (%enable default tactic.cheapen-tac))
+(%autoprove tactic.cheapen-okp-of-tactic.cheapen-tac
+            (%enable default tactic.cheapen-tac tactic.cheapen-okp))
+
+
+(%autoadmit tactic.cheapen-compile-world)
+(%autoprove tactic.worldp-of-tactic.cheapen-compile-world
+            (%enable default tactic.cheapen-compile-world tactic.cheapen-okp))
+(%autoprove tactic.world-atblp-of-tactic.cheapen-compile-world
+            (%enable default tactic.cheapen-compile-world tactic.cheapen-okp))
+(%autoprove tactic.world-env-okp-of-tactic.cheapen-compile-world
+            (%enable default tactic.cheapen-compile-world tactic.cheapen-okp))
+
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/theory-change")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/translate.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/translate.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/translate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/translate.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,285 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit logic.translate-and-term)
+
+(%autoprove logic.termp-of-logic.translate-and-term
+            (%autoinduct logic.translate-and-term)
+            (%restrict default logic.translate-and-term (equal args 'args)))
+
+
+(%autoadmit logic.translate-let-term)
+
+(%autoprove lemma-for-logic.termp-of-logic.translate-let-term
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x x)
+                             (y (app (sort-symbols (difference (remove-duplicates x) y))
+                                     y)))))
+
+(%autoprove logic.termp-of-logic.translate-let-term
+            (%enable default
+                     logic.translate-let-term
+                     lemma-for-logic.termp-of-logic.translate-let-term)
+            (%disable default
+                      sort-symbols-when-not-consp
+                      remove-duplicates-when-unique
+                      unusual-consp-rules
+                      expensive-term/formula-inference))
+
+
+(%autoadmit logic.translate-or-term)
+
+(%autoprove logic.termp-of-logic.translate-or-term
+            (%autoinduct logic.translate-or-term)
+            (%restrict default logic.translate-or-term (equal args 'args)))
+
+
+(%autoadmit logic.translate-list-term)
+
+(%autoprove logic.termp-of-logic.translate-list-term
+            (%autoinduct logic.translate-list-term)
+            (%restrict default logic.translate-list-term (equal args 'args)))
+
+(%autoadmit logic.translate-cond-term)
+
+(%autoprove logic.termp-of-logic.translate-cond-term
+            (%autoinduct logic.translate-cond-term)
+            ;; ugh, worst variable-naming ever
+            (%restrict default logic.translate-cond-term (equal tests 'thens)))
+
+
+
+
+(%autoadmit logic.translate-let*-term)
+
+(%autoprove logic.termp-of-logic.translate-let*-term
+            (%autoinduct logic.translate-let*-term)
+            (%restrict default logic.translate-let*-term (equal vars 'vars)))
+
+
+
+(%autoadmit logic.flag-translate)
+(%autoadmit logic.translate)
+(%autoadmit logic.translate-list)
+
+(%autoprove definition-of-logic.translate
+            (%enable default logic.translate logic.translate-list)
+            (%restrict default logic.flag-translate (equal x 'x)))
+
+(%autoprove definition-of-logic.translate-list
+            (%enable default logic.translate logic.translate-list)
+            (%restrict default logic.flag-translate (equal x 'x)))
+
+(%autoprove logic.flag-translate-of-term-removal
+            (%enable default logic.translate))
+
+(%autoprove logic.flag-translate-of-list-removal
+            (%enable default logic.translate-list))
+
+(%autoprove logic.translate-list-when-not-consp
+            (%restrict default definition-of-logic.translate-list (equal x 'x)))
+
+(%autoprove logic.translate-list-of-cons
+            (%restrict default definition-of-logic.translate-list (equal x '(cons a x))))
+
+(%autoprove consp-of-logic.translate-list
+            (%cdr-induction x))
+
+(%autoprove len-of-cdr-of-logic.translate-list
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-cdr-of-logic.translate-list
+            (%cdr-induction x))
+
+(%autoprove booleanp-of-car-of-logic.translate-list
+            (%cdr-induction x))
+
+
+
+
+
+
+
+(defthmd lemma-1-for-logic.termp-of-logic.translate
+  ;; BOZO unlocalize/rename -- change blimit to 1
+  (implies (symbolp x)
+           (equal (logic.termp x)
+                  (and (not (equal x nil))
+                       (not (equal x t)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable logic.variablep
+                                    definition-of-logic.termp))))
+
+(defthmd lemma-2-for-logic.termp-of-logic.translate
+  ;; BOZO unlocalize/rename
+  (equal (logic.termp (cons 'quote x))
+         (tuplep 1 x))
+  :hints(("Goal" :in-theory (enable definition-of-logic.termp
+                                    logic.constantp
+                                    logic.variablep))))
+
+(defthm lemma-for-logic.termp-of-logic.translate
+  ;; BOZO unlocalize/rename
+  (if (equal flag 'term)
+      (implies (logic.translate x)
+               (logic.termp (logic.translate x)))
+    (logic.term-listp (cdr (logic.translate-list x))))
+  :rule-classes nil)
+
+
+(%autoprove lemma-1-for-logic.termp-of-logic.translate
+            (%enable default logic.variablep)
+            (%restrict default definition-of-logic.termp (equal x 'x)))
+
+(%autoprove lemma-2-for-logic.termp-of-logic.translate
+            (%enable default logic.constantp logic.variablep)
+            (%restrict default definition-of-logic.termp (equal x '(cons 'quote x))))
+
+(%autoprove lemma-for-logic.termp-of-logic.translate
+            (%autoinduct logic.flag-translate flag x)
+            (%enable default
+                     lemma-1-for-logic.termp-of-logic.translate
+                     lemma-2-for-logic.termp-of-logic.translate)
+            (%disable default
+                      logic.function-namep-when-consp
+                      usual-consp-rules
+                      uniquep-when-uniquep-of-domain
+                      same-length-prefixes-equal-cheap
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      unusual-memberp-rules
+                      unusual-subsetp-rules
+                      unusual-consp-rules)
+            (%forcingp nil)
+            (%waterfall default 40)
+            (%restrict default definition-of-logic.translate (equal x 'x))
+            (%restrict default definition-of-logic.translate-list (equal x 'x))
+            (%waterfall default 40)
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     usual-consp-rules
+                     logic.function-namep-when-consp
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     expensive-arithmetic-rules-two
+                     expensive-arithmetic-rules
+                     unusual-consp-rules)
+            (%forcingp t))
+
+(%autoprove logic.termp-of-logic.translate
+            (%use (%instance (%thm lemma-for-logic.termp-of-logic.translate)
+                             (flag 'term))))
+
+(%autoprove logic.term-listp-of-cdr-of-logic.translate-list
+            (%use (%instance (%thm lemma-for-logic.termp-of-logic.translate)
+                             (flag 'list))))
+
+
+
+
+
+
+
+(defthm lemma-for-logic.translate-when-logic.termp
+  ;; BOZO unlocalize/rename
+  (if (equal flag 'term)
+      (implies (logic.termp x)
+               (equal (logic.translate x) x))
+    (implies (logic.term-listp x)
+             (and (car (logic.translate-list x))
+                  (equal (cdr (logic.translate-list x))
+                         (list-fix x)))))
+  :rule-classes nil)
+
+
+
+(%autoprove lemma-for-logic.translate-when-logic.termp
+            ;; BOZO the acl2 proof is too hard to replicate.  Doing it live!
+            (%logic.term-induction flag x)
+            (%forcingp nil)
+            (%auto)
+
+            (%restrict default definition-of-logic.translate (equal x 'x))
+
+            (%disable default
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      usual-consp-rules
+                      logic.function-namep-when-consp
+                      unusual-memberp-rules
+                      unusual-subsetp-rules
+                      expensive-arithmetic-rules-two
+                      expensive-arithmetic-rules
+                      unusual-consp-rules)
+            (%waterfall default 40)
+
+            (%disable default
+                      logic.function-namep-of-car-when-logic.termp-and-not-logic.variablep
+                      logic.term-listp-when-logic.variable-listp-cheap
+                      logic.variable-listp-when-not-consp
+                      same-length-prefixes-equal-cheap)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%enable default
+                     logic.constantp
+                     logic.variablep
+                     logic.function
+                     logic.functionp
+                     logic.function-name
+                     logic.function-args
+                     logic.lambda
+                     logic.lambdap
+                     logic.lambda-formals
+                     logic.lambda-actuals
+                     logic.lambda-body)
+            (%enable default usual-consp-rules)
+            (%restrict default tuplep (logic.constantp n))
+            (%restrict default memberp (logic.constantp x)))
+
+(%autoprove logic.translate-when-logic.termp
+            (%use (%instance (%thm lemma-for-logic.translate-when-logic.termp)
+                             (flag 'term))))
+
+(%autoprove logic.translate-when-logic.term-listp
+            (%use (%instance (%thm lemma-for-logic.translate-when-logic.termp)
+                             (flag 'list))))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/translate")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/urewrite-all.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/urewrite-all.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/urewrite-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/urewrite-all.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,68 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(%interactive)
+
+(%autoadmit tactic.urewrite-all-okp)
+
+(%autoprove booleanp-of-tactic.urewrite-all-okp
+            (%enable default tactic.urewrite-all-okp))
+
+(%autoadmit tactic.urewrite-all-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.urewrite-all-tac
+            (%enable default
+                     tactic.urewrite-all-okp
+                     tactic.urewrite-all-tac))
+
+(%autoprove forcing-tactic.urewrite-all-okp-of-tactic.urewrite-all-tac
+            (%enable default
+                     tactic.urewrite-all-okp
+                     tactic.urewrite-all-tac))
+
+(%autoadmit tactic.urewrite-all-compile)
+
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.urewrite-all-okp
+                 tactic.urewrite-all-compile))
+ (%autoprove forcing-logic.appeal-listp-of-tactic.urewrite-all-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.urewrite-all-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.urewrite-all-compile))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/urewrite-all")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/urewrite-first.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/urewrite-first.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/urewrite-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/urewrite-first.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,73 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+
+
+(%autoadmit tactic.urewrite-first-okp)
+
+(%autoprove booleanp-of-tactic.urewrite-first-okp
+            (%enable default tactic.urewrite-first-okp))
+
+(%autoadmit tactic.urewrite-first-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.urewrite-first-tac
+            (%enable default tactic.urewrite-first-tac))
+
+(%autoprove forcing-tactic.urewrite-first-okp-of-tactic.urewrite-first-tac
+            (%forcingp nil)
+            (%enable default
+                     tactic.urewrite-first-tac
+                     tactic.urewrite-first-okp))
+
+(%autoadmit tactic.urewrite-first-compile)
+
+(local (%enable default
+                tactic.urewrite-first-okp
+                tactic.urewrite-first-compile))
+
+(local (%forcingp nil))
+
+(%autoprove forcing-logic.appeal-listp-of-tactic.urewrite-first-compile)
+(%autoprove forcing-logic.strip-conclusions-of-tactic.urewrite-first-compile)
+(%autoprove forcing-logic.proof-listp-of-tactic.urewrite-first-compile
+            (%disable default
+                      MEMBERP-WHEN-MEMBERP-OF-CDR
+                      MEMBERP-WHEN-NOT-CONSP
+                      CAR-WHEN-MEMBERP-AND-NOT-MEMBERP-OF-CDR-CHEAP
+                      CAR-WHEN-MEMBERP-OF-SINGLETON-LIST-CHEAP
+                      unusual-memberp-rules))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/urewrite-first")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/use.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/use.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/use.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/use.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,89 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(%interactive)
+
+
+(%autoadmit tactic.use-okp)
+
+(%autoprove booleanp-of-tactic.use-okp
+            (%enable default tactic.use-okp))
+
+(%autoadmit tactic.use-env-okp)
+
+(%autoprove booleanp-of-tactic.use-env-okp
+            (%enable default tactic.use-env-okp))
+
+
+
+(%autoadmit tactic.use-tac)
+(%autoprove forcing-tactic.skeletonp-of-tactic.use-tac
+            (%enable default tactic.use-tac))
+(%autoprove forcing-tactic.use-okp-of-tactic.use-tac
+            (%enable default tactic.use-tac tactic.use-okp))
+(%autoprove forcing-tactic.use-env-okp-of-tactic.use-tac
+            (%enable default tactic.use-tac tactic.use-env-okp))
+
+
+
+(defthmd crock-1-for-tactic.use-compile
+  ;; BOZO unlocalize/rename
+  (implies (and (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (TACTIC.SKELETON->GOALS X)))
+                       (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                (force (tactic.skeletonp x))
+                (force (consp proofs)))
+           (equal (logic.conclusion (first proofs))
+                  (logic.disjoin-formulas
+                   (logic.term-list-formulas (first (tactic.skeleton->goals x)))))))
+
+(%autoprove crock-1-for-tactic.use-compile)
+(local (%enable default crock-1-for-tactic.use-compile))
+
+(%autoadmit tactic.use-compile)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 tactic.use-okp
+                 tactic.use-env-okp
+                 tactic.use-compile
+                 logic.term-formula))
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.use-compile)
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.use-compile)
+ (%autoprove forcing-logic.proof-listp-of-tactic.use-compile))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/use")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/waterfall-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/waterfall-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/waterfall-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/waterfall-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,241 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "waterfall-steps")
+(%interactive)
+
+
+(%autoadmit rw.stop-waterstep-compiler)
+(encapsulate
+ ()
+ (local (%enable default
+                 rw.stop-waterstep-compiler
+                 rw.stop-waterstep-okp))
+ (local (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x)))
+ (%autoprove logic.appealp-of-rw.stop-waterstep-compiler)
+ (%autoprove logic.conclusion-of-rw.stop-waterstep-compiler)
+ (%autoprove logic.proofp-of-rw.stop-waterstep-compiler))
+
+
+(%autoadmit rw.urewrite-waterstep-compiler)
+(encapsulate
+ ()
+ (local (%enable default
+                 rw.urewrite-waterstep-compiler
+                 rw.urewrite-waterstep-okp))
+ (local (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x)))
+ (local (%disable default
+                  formula-decomposition
+                  expensive-term/formula-inference
+                  type-set-like-rules
+                  unusual-memberp-rules
+                  unusual-subsetp-rules
+                  expensive-arithmetic-rules
+                  expensive-arithmetic-rules-two
+                  MEMBERP-WHEN-MEMBERP-OF-CDR
+                  MEMBERP-WHEN-NOT-CONSP
+                  same-length-prefixes-equal-cheap
+                  CAR-WHEN-MEMBERP-OF-SINGLETON-LIST-CHEAP
+                  CAR-WHEN-MEMBERP-AND-NOT-MEMBERP-OF-CDR-CHEAP
+                  ))
+ (%autoprove logic.appealp-of-rw.urewrite-waterstep-compiler)
+ (%autoprove logic.conclusion-of-rw.urewrite-waterstep-compiler)
+ (%autoprove logic.proofp-of-rw.urewrite-waterstep-compiler))
+
+
+(%autoadmit rw.crewrite-waterstep-compiler)
+(encapsulate
+ ()
+ (local (%enable default
+                 rw.crewrite-waterstep-compiler
+                 rw.crewrite-waterstep-okp))
+ (local (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x)))
+ (local (%disable default
+                  formula-decomposition
+                  expensive-term/formula-inference
+                  type-set-like-rules
+                  unusual-memberp-rules
+                  unusual-subsetp-rules
+                  expensive-arithmetic-rules
+                  expensive-arithmetic-rules-two
+                  MEMBERP-WHEN-MEMBERP-OF-CDR
+                  MEMBERP-WHEN-NOT-CONSP
+                  same-length-prefixes-equal-cheap
+                  CAR-WHEN-MEMBERP-OF-SINGLETON-LIST-CHEAP
+                  CAR-WHEN-MEMBERP-AND-NOT-MEMBERP-OF-CDR-CHEAP
+                  ))
+ (%autoprove logic.appealp-of-rw.crewrite-waterstep-compiler)
+ (%autoprove logic.conclusion-of-rw.crewrite-waterstep-compiler)
+ (%autoprove logic.proofp-of-rw.crewrite-waterstep-compiler))
+
+
+(%autoadmit rw.split-waterstep-compiler)
+(encapsulate
+ ()
+ (local (%enable default
+                 rw.split-waterstep-okp
+                 rw.split-waterstep-compiler))
+ (local (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x)))
+ (%autoprove logic.appealp-of-rw.split-waterstep-compiler)
+ (%autoprove logic.conclusion-of-rw.split-waterstep-compiler)
+ (%autoprove logic.proofp-of-rw.split-waterstep-compiler))
+
+
+
+(%autoadmit rw.flag-waterstep-compiler)
+(%autoadmit rw.waterstep-compiler)
+(%autoadmit rw.waterstep-list-compiler)
+(%autoprove definition-of-rw.waterstep-compiler
+            (%restrict default rw.flag-waterstep-compiler (equal x 'x))
+            (%enable default rw.waterstep-list-compiler rw.waterstep-compiler))
+(%autoprove definition-of-rw.waterstep-list-compiler
+            (%restrict default rw.flag-waterstep-compiler (equal x 'x))
+            (%enable default rw.waterstep-list-compiler rw.waterstep-compiler))
+(%autoprove rw.flag-waterstep-compiler-of-clause
+            (%enable default rw.waterstep-compiler))
+(%autoprove rw.flag-waterstep-compiler-of-list
+            (%enable default rw.waterstep-list-compiler))
+
+(%autoprove rw.waterstep-compiler-of-nil
+            (%restrict default definition-of-rw.waterstep-compiler (equal x ''nil)))
+
+(%autoprove rw.waterstep-list-compiler-when-not-consp
+            (%restrict default definition-of-rw.waterstep-list-compiler (equal x 'x)))
+
+(%autoprove rw.waterstep-list-compiler-of-cons
+            (%restrict default definition-of-rw.waterstep-list-compiler (equal x '(cons a x))))
+
+(%defprojection
+ :list (rw.waterstep-list-compiler x world rproofs)
+ :element (rw.waterstep-compiler x world rproofs)
+ :nil-preservingp t)
+
+(%autoprove lemma-for-logic.appealp-of-rw.waterstep-compiler
+            (%autoinduct rw.waterstep-induction flag x)
+            (%disable default
+                      formula-decomposition
+                      expensive-term/formula-inference
+                      type-set-like-rules
+                      unusual-memberp-rules
+                      unusual-subsetp-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      same-length-prefixes-equal-cheap)
+            (%forcingp nil)
+            (%waterfall default 40)
+
+            (%restrict default definition-of-rw.waterstep-compiler (equal x 'x))
+            (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x))
+            (%restrict default definition-of-rw.waterstep-okp (equal x 'x))
+            (%waterfall default 40)
+
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference
+                     type-set-like-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     same-length-prefixes-equal-cheap)
+
+            (%waterfall default 40)
+            (%auto))
+
+(%autoprove logic.appealp-of-rw.waterstep-compiler
+            (%use (%instance (%thm lemma-for-logic.appealp-of-rw.waterstep-compiler)
+                             (flag 'clause))))
+
+(%autoprove logic.conclusion-of-rw.waterstep-compiler
+            (%use (%instance (%thm lemma-for-logic.appealp-of-rw.waterstep-compiler)
+                             (flag 'clause))))
+
+(%autoprove logic.appeal-listp-of-rw.waterstep-list-compiler
+            (%use (%instance (%thm lemma-for-logic.appealp-of-rw.waterstep-compiler)
+                             (flag 'list))))
+
+(%autoprove logic.strip-conclusions-of-rw.waterstep-list-compiler
+            (%use (%instance (%thm lemma-for-logic.appealp-of-rw.waterstep-compiler)
+                             (flag 'list))))
+
+(%autoprove lemma-for-logic.proofp-of-rw.waterstep-compiler
+            (%autoinduct rw.waterstep-induction flag x)
+            (%disable default
+                      formula-decomposition
+                      expensive-term/formula-inference
+                      type-set-like-rules
+                      unusual-memberp-rules
+                      unusual-subsetp-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      same-length-prefixes-equal-cheap
+                      MEMBERP-WHEN-MEMBERP-OF-CDR
+                      MEMBERP-WHEN-NOT-CONSP
+                      CAR-WHEN-MEMBERP-AND-NOT-MEMBERP-OF-CDR-CHEAP
+                      CAR-WHEN-MEMBERP-OF-SINGLETON-LIST-CHEAP
+                      SUBSETP-TRANSITIVE-TWO
+                      SUBSETP-OF-REMOVE-DUPLICATES-ONE-INDIRECT
+                      SUBSETP-OF-LOGIC.DISJOIN-EACH-FORMULA-LISTS-WHEN-SUBSETP
+                      SUBSETP-OF-LOGIC.TERM-LIST-LIST-FORMULASS-WHEN-SUBSETP)
+            (%forcingp nil)
+            (%liftlimit 2)
+            (%splitlimit 5)
+            (%waterfall default 40)
+
+            (%restrict default definition-of-rw.waterstep-compiler (equal x 'x))
+            (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x))
+            (%restrict default definition-of-rw.waterstep-okp (equal x 'x))
+            (%waterfall default 40)
+
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference
+                     type-set-like-rules
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     same-length-prefixes-equal-cheap)
+
+            (%waterfall default 40)
+            (%auto))
+
+(%autoprove logic.proofp-of-rw.waterstep-compiler
+            (%use (%instance (%thm lemma-for-logic.proofp-of-rw.waterstep-compiler)
+                             (flag 'clause))))
+
+(%autoprove logic.proof-listp-of-rw.waterstep-list-compiler
+            (%use (%instance (%thm lemma-for-logic.proofp-of-rw.waterstep-compiler)
+                             (flag 'list))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/waterfall-main.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/waterfall-main.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/waterfall-main.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/waterfall-main.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,280 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "waterfall-steps")
+(%interactive)
+
+(%autoadmit rw.flag-waterfall)
+(%autoadmit rw.waterfall)
+(%autoadmit rw.waterfall-list)
+
+(%autoprove definition-of-rw.waterfall
+            (%restrict default rw.flag-waterfall (and (equal x 'x) (equal steps 'steps)))
+            (%enable default rw.waterfall rw.waterfall-list))
+
+(%autoprove definition-of-rw.waterfall-list
+            (%restrict default rw.flag-waterfall (and (equal x 'x) (equal steps 'steps)))
+            (%enable default rw.waterfall rw.waterfall-list))
+
+(%autoprove rw.flag-waterfall-of-clause
+            (%enable default rw.waterfall))
+
+(%autoprove rw.flag-waterfall-of-list
+            (%enable default rw.waterfall-list))
+
+(%autoprove rw.waterfall-list-when-not-consp
+            (%restrict default definition-of-rw.waterfall-list (equal x 'x)))
+
+(%autoprove rw.waterfall-list-of-cons
+            (%restrict default definition-of-rw.waterfall-list (equal x '(cons a x))))
+
+(%defprojection :list (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n)
+                :element (rw.waterfall x theoryname cfastp ufastp world steps strategy n)
+                :nil-preservingp nil)
+
+
+;; BOZO.  Wow, these, uh, completely do not belong here at all...
+
+(%autoprove true-listp-of-clause.make-clause-from-arbitrary-formula
+            (%enable default clause.make-clause-from-arbitrary-formula))
+
+(%autoprove true-list-listp-of-clause.make-clauses-from-arbitrary-formulas
+            (%autoinduct clause.make-clauses-from-arbitrary-formulas)
+            (%restrict default clause.make-clauses-from-arbitrary-formulas (equal x 'x)))
+
+
+(%autoprove lemma-2-for-rw.waterstepp-of-rw.waterfall
+            ;; disabled!
+            (%enable default
+                     rw.make-crewrite-clause-plan
+                     rw.crewrite-clause-plan->clause-prime))
+
+(%autoprove lemma-for-rw.waterstepp-of-rw.waterfall
+            (%autoinduct rw.flag-waterfall)
+            (%forcingp nil)
+            (%waterfall default 40)
+            (%restrict default definition-of-rw.waterfall (and (equal x 'x)
+                                                               (equal steps 'steps)))
+            (%enable default lemma-2-for-rw.waterstepp-of-rw.waterfall)
+            (%waterfall default 40))
+
+(%autoprove rw.waterstepp-of-rw.waterfall
+            (%use (%instance (%thm lemma-for-rw.waterstepp-of-rw.waterfall)
+                             (flag 'clause))))
+
+(%autoprove rw.waterstep-listp-of-rw.waterfall-list
+            (%use (%instance (%thm lemma-for-rw.waterstepp-of-rw.waterfall)
+                             (flag 'list))))
+
+
+(%autoprove lemma-1-for-rw.waterstep-atblp-of-rw.waterfall
+            (%enable default rw.ccstep->clause-prime))
+
+(%autoprove lemma-2-for-rw.waterstep-atblp-of-rw.waterfall
+            (%autoinduct rw.ccstep-list-gather-traces)
+            (%restrict default rw.ccstep-list-gather-traces (equal x 'x))
+            (%enable default rw.ccstep->provedp rw.ccstep->contradiction))
+
+(%autoprove lemma-3-for-rw.waterstep-atblp-of-rw.waterfall
+            (%autoinduct rw.ccstep-list-hypboxes)
+            (%restrict default rw.ccstep-list-hypboxes (equal x 'x)))
+
+(%autoprove lemma-4-for-rw.waterstep-atblp-of-rw.waterfall
+            (%enable default lemma-1-for-rw.waterstep-atblp-of-rw.waterfall))
+
+(%autoprove lemma-5-for-rw.waterstep-atblp-of-rw.waterfall
+            (%enable default
+                     rw.crewrite-clause-planp
+                     rw.crewrite-clause-plan-atblp
+                     rw.crewrite-clause-plan-okp
+                     rw.crewrite-clause-plan->clause
+                     rw.crewrite-clause-plan->clause-prime
+                     lemma-1-for-rw.waterstep-atblp-of-rw.waterfall
+                     lemma-2-for-rw.waterstep-atblp-of-rw.waterfall
+                     lemma-3-for-rw.waterstep-atblp-of-rw.waterfall
+                     lemma-4-for-rw.waterstep-atblp-of-rw.waterfall)
+            ;; huh.. acl2 had to fertilize? we don't?
+            )
+
+
+;; The acl2 proof below uses restrict hints to fix problems with free var matching
+;; our system doesn't work quite the same -- we'll introduce alt-rules instead.
+
+(defthmd lemma-5-for-rw.waterstep-atblp-of-rw.waterfall-alt
+  (implies (force (and (tactic.worldp world)
+                       (rw.crewrite-clause-planp x)
+                       (rw.crewrite-clause-plan-atblp x atbl)
+                       (rw.crewrite-clause-plan-okp x world)
+                       (tactic.world-atblp world atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-atblp
+                   (rw.crewrite-clause-plan->clause-prime x)
+                   atbl)
+                  t))
+  :hints(("goal" :in-theory (enable lemma-5-for-rw.waterstep-atblp-of-rw.waterfall))))
+
+(%autoprove lemma-5-for-rw.waterstep-atblp-of-rw.waterfall-alt
+            (%enable default lemma-5-for-rw.waterstep-atblp-of-rw.waterfall))
+
+(defthm logic.formula-list-atblp-of-rw.crewrite-clause-plan->forced-goals-alt
+  (implies (force (and (tactic.worldp world)
+                       (rw.crewrite-clause-planp x)
+                       (rw.crewrite-clause-plan-okp x world)
+                       (rw.crewrite-clause-plan-atblp x atbl)
+                       (tactic.world-atblp world atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.formula-list-atblp
+                   (rw.crewrite-clause-plan->forced-goals x)
+                   atbl)
+                  t)))
+
+(%autoprove logic.formula-list-atblp-of-rw.crewrite-clause-plan->forced-goals-alt)
+
+
+
+(%autoprove lemma-for-rw.waterstep-atblp-of-rw.waterfall
+            (%autoinduct rw.flag-waterfall)
+            (%forcingp nil)
+
+            (%disable default
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      unusual-memberp-rules
+                      unusual-subsetp-rules
+                      unusual-consp-rules
+                      type-set-like-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      same-length-prefixes-equal-cheap)
+
+            (%waterfall default 40)
+
+            (%enable default
+                     lemma-1-for-rw.waterstep-atblp-of-rw.waterfall
+                     lemma-2-for-rw.waterstep-atblp-of-rw.waterfall
+                     lemma-3-for-rw.waterstep-atblp-of-rw.waterfall
+                     lemma-4-for-rw.waterstep-atblp-of-rw.waterfall
+                     lemma-5-for-rw.waterstep-atblp-of-rw.waterfall
+                     lemma-5-for-rw.waterstep-atblp-of-rw.waterfall-alt
+                     lemma-2-for-rw.waterstepp-of-rw.waterfall)
+
+            (%restrict default definition-of-rw.waterfall (and (equal x 'x) (equal steps 'steps)))
+            (%waterfall default 40))
+
+(%autoprove rw.waterstep-atblp-of-rw.waterfall
+            (%use (%instance (%thm lemma-for-rw.waterstep-atblp-of-rw.waterfall)
+                             (flag 'clause))))
+
+(%autoprove rw.waterstep-list-atblp-of-rw.waterfall-list
+            (%use (%instance (%thm lemma-for-rw.waterstep-atblp-of-rw.waterfall)
+                             (flag 'list))))
+
+(%autoprove lemma-for-rw.waterstep->clause-of-rw.waterfall
+            (%autoinduct rw.flag-waterfall)
+            (%forcingp nil)
+            (%waterfall default 40)
+            (%restrict default definition-of-rw.waterfall (and (equal x 'x) (equal steps 'steps))))
+
+(%autoprove rw.waterstep->clause-of-rw.waterfall
+            (%use (%instance (%thm lemma-for-rw.waterstep->clause-of-rw.waterfall)
+                             (flag 'clause))))
+
+(%autoprove rw.waterstep-list->clauses-of-rw.waterfall-list
+            (%use (%instance (%thm lemma-for-rw.waterstep->clause-of-rw.waterfall)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-rw.waterstep-okp-of-rw.waterfall
+
+            (%autoinduct rw.flag-waterfall)
+            (%forcingp nil)
+
+            (%disable default
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      unusual-memberp-rules
+                      unusual-subsetp-rules
+                      unusual-consp-rules
+                      type-set-like-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      same-length-prefixes-equal-cheap)
+
+            (%waterfall default 40)
+
+            (%restrict default definition-of-rw.waterfall (and (equal x 'x) (equal steps 'steps)))
+            (%waterfall default 40)
+
+            (%enable default
+                     definition-of-rw.waterstep-okp
+                     rw.stop-waterstep-okp
+                     rw.crewrite-waterstep-okp
+                     rw.split-waterstep-okp
+                     rw.urewrite-waterstep-okp
+                     lemma-2-for-rw.waterstepp-of-rw.waterfall)
+            (%waterfall default 40)
+
+            (%forcingp t)
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition
+                     unusual-memberp-rules
+                     unusual-subsetp-rules
+                     unusual-consp-rules
+                     type-set-like-rules
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     same-length-prefixes-equal-cheap)
+
+            (%auto))
+
+(%autoprove rw.waterstep-okp-of-rw.waterfall
+            (%use (%instance (%thm lemma-for-rw.waterstep-okp-of-rw.waterfall)
+                             (flag 'clause))))
+
+(%autoprove rw.waterstep-list-okp-of-rw.waterfall-list
+            (%use (%instance (%thm lemma-for-rw.waterstep-okp-of-rw.waterfall)
+                             (flag 'list))))
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/waterfall-steps.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/waterfall-steps.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/waterfall-steps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/waterfall-steps.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,377 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(include-book "split-all") ;; BOZO yuck for cons-listp-of-list-list-fix ??
+(%interactive)
+
+(%autoprove true-list-listp-of-remove-supersets1
+            (%autoinduct remove-supersets1 x acc)
+            (%restrict default remove-supersets1 (equal todo 'x)))
+
+(%autoprove true-list-listp-of-remove-supersets
+            (%enable default remove-supersets))
+
+(%autoprove true-list-listp-of-remove-duplicates-list
+            (%cdr-induction x))
+
+(%autoprove true-list-listp-of-third-of-clause.clean-clauses
+            (%enable default clause.clean-clauses))
+
+(%autoprove true-list-listp-of-third-of-clause.fast-clean-clauses
+            (%enable default clause.fast-clean-clauses)
+            (%disable default
+                      clause.fast-clean-clauses-removal
+                      clause.fast-clean-part1-removal))
+
+(%autoprove true-list-listp-of-revappend
+            (%autoinduct revappend x acc)
+            (%restrict default revappend (equal x 'x))
+            (%disable default forcing-revappend-removal))
+
+(%autoprove true-list-listp-of-clause.aux-split
+            (%autoinduct clause.aux-split)
+            (%restrict default clause.aux-split (equal todo 'todo)))
+
+(%autoprove true-list-listp-of-clause.aux-limsplit
+            (%autoinduct clause.aux-limsplit todo done splitlimit)
+            (%restrict default clause.aux-limsplit (equal todo 'todo)))
+
+(%autoprove true-list-listp-of-clause.simple-limsplit
+            (%enable default clause.simple-limsplit))
+
+(%autoprove true-list-listp-of-clause.simple-split
+            (%enable default clause.simple-split))
+
+(%autoprove true-list-listp-of-cdr-of-clause.split
+            (%forcingp nil)
+            (%enable default clause.split))
+
+(%autoprove logic.formula-listp-of-remove-duplicates-free)
+
+(%autoprove logic.formula-list-atblp-of-remove-duplicates-free)
+
+(%autoprove subsetp-of-remove-duplicates-one-indirect)
+
+;; this is now included as part of split-all to avoid overwriting files.
+;; (%autoprove cons-listp-of-list-list-fix
+;;             (%cdr-induction x))
+
+(%autoprove true-list-listp-of-list-list-fix
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-listp-of-list-list-fix
+            (%cdr-induction x))
+
+(%autoprove list-list-fix-when-true-list-listp
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-list-atblp-of-list-list-fix
+            (%cdr-induction x))
+
+
+(%autoadmit rw.flag-waterstepp)
+
+(%autoadmit rw.waterstepp)
+
+(%autoadmit rw.waterstep-listp)
+
+(%autoprove definition-of-rw.waterstepp
+            (%restrict default rw.flag-waterstepp (equal x 'x))
+            (%enable default rw.waterstepp rw.waterstep-listp))
+
+(%autoprove definition-of-rw.waterstep-listp
+            (%restrict default rw.flag-waterstepp (equal x 'x))
+            (%enable default rw.waterstepp rw.waterstep-listp))
+
+(%autoprove rw.waterstep-listp-when-not-consp
+            (%restrict default definition-of-rw.waterstep-listp (equal x 'x)))
+
+(%autoprove rw.waterstep-listp-of-cons
+            (%restrict default definition-of-rw.waterstep-listp (equal x '(cons a x))))
+
+(%autoadmit rw.raw-waterstep-induction)
+
+(%autoprove lemma-for-booleanp-of-rw.waterstepp
+            (%autoinduct rw.raw-waterstep-induction flag x)
+            (%restrict default definition-of-rw.waterstepp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.waterstepp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.waterstepp)
+                             (flag 'clause))))
+
+(%autoprove booleanp-of-rw.waterstep-listp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.waterstepp)
+                             (flag 'list))))
+
+(%deflist rw.waterstep-listp (x)
+          (rw.waterstepp x))
+
+
+(%autoadmit rw.waterstep)
+(%autoadmit rw.waterstep->method)
+(%autoadmit rw.waterstep->clause)
+(%autoadmit rw.waterstep->extras)
+(%autoadmit rw.waterstep->substeps)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 rw.waterstep
+                 rw.waterstep->method
+                 rw.waterstep->clause
+                 rw.waterstep->extras
+                 rw.waterstep->substeps))
+ (%autoprove rw.waterstep->method-of-rw.waterstep)
+ (%autoprove rw.waterstep->clause-of-rw.waterstep)
+ (%autoprove rw.waterstep->extras-of-rw.waterstep)
+ (%autoprove rw.waterstep->substeps-of-rw.waterstep)
+ (%autoprove rank-of-rw.waterstep->substeps)
+
+ (%autoprove rw.waterstepp-of-rw.waterstep
+             (%restrict default definition-of-rw.waterstepp
+                        (and (logic.functionp x)
+                             (equal (logic.function-name x) 'cons))))
+
+ (%autoprove symbolp-of-rw.waterstep->method
+             (%restrict default definition-of-rw.waterstepp (equal x 'x)))
+
+ (%autoprove logic.term-listp-of-rw.waterstep->clause
+             (%restrict default definition-of-rw.waterstepp (equal x 'x)))
+
+ (%autoprove consp-of-rw.waterstep->clause
+             (%restrict default definition-of-rw.waterstepp (equal x 'x)))
+
+ (%autoprove true-listp-of-rw.waterstep->clause
+             (%restrict default definition-of-rw.waterstepp (equal x 'x)))
+
+ (%autoprove rw.waterstep-listp-of-rw.waterstep->substeps
+             (%restrict default definition-of-rw.waterstepp (equal x 'x))))
+
+
+
+(%defprojection :list (rw.waterstep-list->clauses x)
+                :element (rw.waterstep->clause x)
+                :nil-preservingp t)
+
+(%autoprove cons-listp-of-rw.waterstep-list->clauses
+            (%cdr-induction x))
+
+(%autoprove true-list-listp-of-rw.waterstep-list->clauses
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-listp-of-rw.waterstep-list->clauses
+            (%cdr-induction x))
+
+
+(%autoadmit rw.waterstep-induction)
+
+(%autoadmit rw.flag-waterstep-atblp)
+(%autoadmit rw.waterstep-atblp)
+(%autoadmit rw.waterstep-list-atblp)
+
+(%autoprove definition-of-rw.waterstep-atblp
+            (%restrict default rw.flag-waterstep-atblp (equal x 'x))
+            (%enable default rw.waterstep-atblp rw.waterstep-list-atblp))
+
+(%autoprove definition-of-rw.waterstep-list-atblp
+            (%restrict default rw.flag-waterstep-atblp (equal x 'x))
+            (%enable default rw.waterstep-atblp rw.waterstep-list-atblp))
+
+(%autoprove rw.flag-waterstep-atblp-of-clause
+            (%enable default rw.waterstep-atblp))
+
+(%autoprove rw.flag-waterstep-list-atblp-of-clause
+            (%enable default rw.waterstep-list-atblp))
+
+(%autoprove rw.waterstep-list-atblp-when-not-consp
+            (%restrict default definition-of-rw.waterstep-list-atblp (equal x 'x)))
+
+(%autoprove rw.waterstep-list-atblp-of-cons
+            (%restrict default definition-of-rw.waterstep-list-atblp (equal x '(cons a x))))
+
+(%autoprove rw.waterstep-atblp-of-nil
+            (%restrict default definition-of-rw.waterstep-atblp (equal x ''nil)))
+
+(%autoprove lemma-for-booleanp-of-rw.waterstep-atblp
+            (%autoinduct rw.waterstep-induction flag x)
+            (%restrict default definition-of-rw.waterstep-atblp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.waterstep-atblp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.waterstep-atblp)
+                             (flag 'clause))))
+
+(%autoprove booleanp-of-rw.waterstep-list-atblp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.waterstep-atblp)
+                             (flag 'list))))
+
+
+(%deflist rw.waterstep-list-atblp (x atbl)
+          (rw.waterstep-atblp x atbl))
+
+(%autoprove logic.term-list-atblp-of-rw.waterstep->clause
+            (%restrict default definition-of-rw.waterstep-atblp (equal x 'x)))
+
+(%autoprove rw.waterstep-list-atblp-of-rw.waterstep->substeps
+            (%restrict default definition-of-rw.waterstep-atblp (equal x 'x)))
+
+(%autoprove rw.waterstep-atblp-of-rw.waterstep
+            (%restrict default definition-of-rw.waterstep-atblp
+                       (equal x '(rw.waterstep method clause extras substeps))))
+
+
+(%autoadmit rw.stop-waterstep-okp)
+(%autoprove booleanp-of-rw.stop-waterstep-okp
+            (%enable default rw.stop-waterstep-okp))
+
+(%autoadmit rw.urewrite-waterstep-okp)
+(%autoprove booleanp-of-rw.urewrite-waterstep-okp
+            (%enable default rw.urewrite-waterstep-okp))
+
+(%autoadmit rw.crewrite-waterstep-okp)
+(%autoprove booleanp-of-rw.crewrite-waterstep-okp
+            (%enable default rw.crewrite-waterstep-okp))
+
+(%autoadmit rw.split-waterstep-okp)
+(%autoprove booleanp-of-rw.split-waterstep-okp
+            (%enable default rw.split-waterstep-okp))
+
+
+(%autoadmit rw.flag-waterstep-okp)
+(%autoadmit rw.waterstep-okp)
+(%autoadmit rw.waterstep-list-okp)
+(%autoprove definition-of-rw.waterstep-okp
+            (%restrict default rw.flag-waterstep-okp (equal x 'x))
+            (%enable default rw.waterstep-okp rw.waterstep-list-okp))
+(%autoprove definition-of-rw.waterstep-list-okp
+            (%restrict default rw.flag-waterstep-okp (equal x 'x))
+            (%enable default rw.waterstep-okp rw.waterstep-list-okp))
+
+(%autoprove rw.waterstep-list-okp-when-not-consp
+            (%restrict default definition-of-rw.waterstep-list-okp (equal x 'x)))
+(%autoprove rw.waterstep-list-okp-of-cons
+            (%restrict default definition-of-rw.waterstep-list-okp (equal x '(cons a x))))
+
+(%autoprove rw.waterstep-okp-of-nil
+            (%restrict default definition-of-rw.waterstep-okp (equal x ''nil)))
+
+(%autoprove lemma-for-booleanp-of-rw.waterstep-okp
+            (%autoinduct rw.waterstep-induction flag x)
+            (%restrict default definition-of-rw.waterstep-okp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.waterstep-okp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.waterstep-okp)
+                             (flag 'clause))))
+
+(%autoprove booleanp-of-rw.waterstep-list-okp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.waterstep-okp)
+                             (flag 'list))))
+
+(%deflist rw.waterstep-list-okp (x world)
+          (rw.waterstep-okp x world))
+
+
+
+(%autoadmit rw.flag-waterfall-subgoals)
+(%autoadmit rw.waterfall-subgoals)
+(%autoadmit rw.waterfall-list-subgoals)
+
+(%autoprove definition-of-rw.waterfall-subgoals
+            (%enable default rw.waterfall-subgoals rw.waterfall-list-subgoals)
+            (%restrict default rw.flag-waterfall-subgoals (equal x 'x)))
+
+(%autoprove definition-of-rw.waterfall-list-subgoals
+            (%enable default rw.waterfall-subgoals rw.waterfall-list-subgoals)
+            (%restrict default rw.flag-waterfall-subgoals (equal x 'x)))
+
+(%autoprove rw.flag-waterfall-subgoals-of-clause
+            (%enable default rw.waterfall-subgoals))
+
+(%autoprove rw.flag-waterfall-list-subgoals-of-clause
+            (%enable default rw.waterfall-list-subgoals))
+
+(%autoprove rw.waterfall-list-subgoals-when-not-consp
+            (%restrict default definition-of-rw.waterfall-list-subgoals (equal x 'x)))
+
+(%autoprove rw.waterfall-list-subgoals-of-cons
+            (%restrict default definition-of-rw.waterfall-list-subgoals (equal x '(cons a x))))
+
+(%autoprove lemma-for-logic.term-list-listp-of-rw.waterfall-subgoals
+            (%autoinduct rw.flag-waterfall-subgoals flag x)
+            (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x)))
+
+(%autoprove logic.term-list-listp-of-rw.waterfall-subgoals
+            (%use (%instance (%thm lemma-for-logic.term-list-listp-of-rw.waterfall-subgoals)
+                             (flag 'clause))))
+
+(%autoprove logic.term-list-listp-of-rw.waterfall-list-subgoals
+            (%use (%instance (%thm lemma-for-logic.term-list-listp-of-rw.waterfall-subgoals)
+                             (flag 'list))))
+
+(%autoprove lemma-for-cons-listp-of-rw.waterfall-subgoals
+            (%autoinduct rw.flag-waterfall-subgoals flag x)
+            (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x)))
+
+(%autoprove cons-listp-of-rw.waterfall-subgoals
+            (%use (%instance (%thm lemma-for-cons-listp-of-rw.waterfall-subgoals)
+                             (flag 'clause))))
+
+(%autoprove cons-listp-of-rw.waterfall-list-subgoals
+            (%use (%instance (%thm lemma-for-cons-listp-of-rw.waterfall-subgoals)
+                             (flag 'list))))
+
+(%autoprove lemma-for-true-list-listp-of-rw.waterfall-subgoals
+            (%autoinduct rw.flag-waterfall-subgoals flag x)
+            (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x)))
+
+(%autoprove true-list-listp-of-rw.waterfall-subgoals
+            (%use (%instance (%thm lemma-for-true-list-listp-of-rw.waterfall-subgoals)
+                             (flag 'clause))))
+
+(%autoprove true-list-listp-rw.waterfall-list-subgoals
+            (%use (%instance (%thm lemma-for-true-list-listp-of-rw.waterfall-subgoals)
+                             (flag 'list))))
+
+(%autoprove lemma-for-true-listp-of-rw.waterfall-subgoals
+            (%autoinduct rw.flag-waterfall-subgoals flag x)
+            (%restrict default definition-of-rw.waterfall-subgoals (equal x 'x)))
+
+(%autoprove true-listp-of-rw.waterfall-subgoals
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.waterfall-subgoals)
+                             (flag 'clause))))
+
+(%autoprove true-listp-rw.waterfall-list-subgoals
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.waterfall-subgoals)
+                             (flag 'list))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level11/waterfall.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level11/waterfall.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level11/waterfall.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level11/waterfall.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,97 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "waterfall-main")
+(include-book "waterfall-compiler")
+(%interactive)
+
+
+(%autoadmit tactic.waterfall-okp)
+
+(%autoprove booleanp-of-tactic.waterfall-okp
+            (%enable default tactic.waterfall-okp))
+
+
+(%autoadmit rw.waterfall-list-wrapper)
+(%enable default rw.waterfall-list-wrapper)
+
+(%autoadmit tactic.waterfall-tac)
+
+(%autoprove forcing-tactic.skeletonp-of-tactic.waterfall-tac
+            (%enable default tactic.waterfall-tac))
+
+(%autoprove forcing-tactic.waterfall-okp-of-tactic.waterfall-tac
+            (%enable default tactic.waterfall-tac tactic.waterfall-okp)
+            (%restrict default nth (logic.constantp n)))
+
+
+(%autoadmit tactic.waterfall-compile)
+
+(encapsulate
+ ()
+ (local (%enable default tactic.waterfall-okp tactic.waterfall-compile))
+
+ (%autoprove forcing-logic.appeal-listp-of-tactic.waterfall-compile
+             (%auto :strategy (cleanup split urewrite))
+             ;; Wow, this is really nice.  I wish I could do this in ACL2.
+             (%generalize (NTH '5 (TACTIC.SKELETON->EXTRAS X)) ufastp)
+             (%generalize (nth '6 (TACTIC.SKELETON->EXTRAS X)) cfastp)
+             (%generalize (car (TACTIC.SKELETON->EXTRAS X)) wsteps)
+             (%generalize (car (cdr (TACTIC.SKELETON->EXTRAS X))) theoryname)
+             (%generalize (CAR (CDR (CDR (CDR (TACTIC.SKELETON->EXTRAS X))))) maxdepth)
+             (%generalize (CAR (CDR (CDR (TACTIC.SKELETON->EXTRAS X)))) strategy))
+
+ (%autoprove forcing-logic.strip-conclusions-of-tactic.waterfall-compile
+             (%auto :strategy (cleanup split urewrite))
+             ;; Wow, this is really nice.  I wish I could do this in ACL2.
+             (%generalize (NTH '5 (TACTIC.SKELETON->EXTRAS X)) ufastp)
+             (%generalize (nth '6 (TACTIC.SKELETON->EXTRAS X)) cfastp)
+             (%generalize (car (TACTIC.SKELETON->EXTRAS X)) wsteps)
+             (%generalize (car (cdr (TACTIC.SKELETON->EXTRAS X))) theoryname)
+             (%generalize (CAR (CDR (CDR (CDR (TACTIC.SKELETON->EXTRAS X))))) maxdepth)
+             (%generalize (CAR (CDR (CDR (TACTIC.SKELETON->EXTRAS X)))) strategy))
+
+ (%autoprove forcing-logic.proof-listp-of-tactic.waterfall-compile
+             (%auto :strategy (cleanup split urewrite))
+             ;; Wow, this is really nice.  I wish I could do this in ACL2.
+             (%generalize (NTH '5 (TACTIC.SKELETON->EXTRAS X)) ufastp)
+             (%generalize (nth '6 (TACTIC.SKELETON->EXTRAS X)) cfastp)
+             (%generalize (car (TACTIC.SKELETON->EXTRAS X)) wsteps)
+             (%generalize (car (cdr (TACTIC.SKELETON->EXTRAS X))) theoryname)
+             (%generalize (CAR (CDR (CDR (CDR (TACTIC.SKELETON->EXTRAS X))))) maxdepth)
+             (%generalize (CAR (CDR (CDR (TACTIC.SKELETON->EXTRAS X)))) strategy)))
+
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/waterfall")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level2/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/basic.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level2/basic.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/basic.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,212 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(defsection build.axiom
+  (%autoadmit build.axiom)
+  (local (%enable default build.axiom))
+  (%autoprove build.axiom-under-iff)
+  (%autoprove logic.method-of-build.axiom)
+  (%autoprove logic.conclusion-of-build.axiom)
+  (%autoprove logic.subproofs-of-build.axiom)
+  (%autoprove logic.extras-of-build.axiom)
+  (%autoprove forcing-logic.appealp-of-build.axiom)
+  (local (%disable default build.axiom))
+  (%autoprove forcing-logic.proofp-of-build.axiom
+              (%enable default logic.axiom-okp logic.appeal-step-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.axiom a)))))
+
+(defsection build.theorem
+  (%autoadmit build.theorem)
+  (local (%enable default build.theorem))
+  (%autoprove build.theorem-under-iff)
+  (%autoprove logic.method-of-build.theorem)
+  (%autoprove logic.conclusion-of-build.theorem)
+  (%autoprove logic.subproofs-of-build.theorem)
+  (%autoprove logic.extras-of-build.theorem)
+  (%autoprove forcing-logic.appealp-of-build.theorem)
+  (local (%disable default build.theorem))
+  (%autoprove forcing-logic.proofp-of-build.theorem
+              (%enable default logic.theorem-okp logic.appeal-step-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.theorem a)))))
+
+(defsection build.propositional-schema
+  (%autoadmit build.propositional-schema)
+  (local (%enable default build.propositional-schema))
+  (%autoprove build.propositional-schema-under-iff)
+  (%autoprove logic.method-of-build.propositional-schema)
+  (%autoprove logic.conclusion-of-build.propositional-schema)
+  (%autoprove logic.subproofs-of-build.propositional-schema)
+  (%autoprove logic.extras-of-build.propositional-schema)
+  (%autoprove forcing-logic.appealp-of-build.propositional-schema)
+  (local (%disable default build.propositional-schema))
+  (%autoprove forcing-logic.proofp-of-build.propositional-schema
+              (%enable default logic.appeal-step-okp logic.propositional-schema-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.propositional-schema a)))))
+
+(defsection build.cut
+  (%autoadmit build.cut)
+  (local (%enable default build.cut))
+  (%autoprove build.cut-under-iff)
+  (%autoprove logic.method-of-build.cut)
+  (%autoprove logic.conclusion-of-cut) ;; BOZO wrong name, should be build.cut
+  (%autoprove logic.subproofs-of-build.cut)
+  (%autoprove logic.extras-of-build.cut)
+  (%autoprove forcing-logic.appealp-of-build.cut)
+  (local (%disable default build.cut))
+  (%autoprove forcing-logic.proofp-of-build.cut
+              (%enable default logic.appeal-step-okp logic.cut-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.cut x y)))))
+
+(defsection build.contraction
+  (%autoadmit build.contraction)
+  (local (%enable default build.contraction))
+  (%autoprove build.contraction-under-iff)
+  (%autoprove logic.method-of-build.contraction)
+  (%autoprove logic.conclusion-of-build.contraction)
+  (%autoprove logic.subproofs-of-build.contraction)
+  (%autoprove logic.extras-of-build.contraction)
+  (%autoprove forcing-logic.appealp-of-build.contraction)
+  (local (%disable default build.contraction))
+  (%autoprove forcing-logic.proofp-of-build.contraction
+              (%enable default logic.appeal-step-okp logic.contraction-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.contraction x)))))
+
+(defsection build.expansion
+  (%autoadmit build.expansion)
+  (local (%enable default build.expansion))
+  (%autoprove build.expansion-under-iff)
+  (%autoprove logic.method-of-build.expansion)
+  (%autoprove logic.conclusion-of-build.expansion)
+  (%autoprove logic.subproofs-of-build.expansion)
+  (%autoprove logic.extras-of-build.expansion)
+  (%autoprove forcing-logic.appealp-of-build.expansion)
+  (local (%disable default build.expansion))
+  (%autoprove forcing-logic.proofp-of-build.expansion
+              (%enable default logic.appeal-step-okp logic.expansion-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.expansion a x)))))
+
+(defsection build.associativity
+  (%autoadmit build.associativity)
+  (local (%enable default build.associativity))
+  (%autoprove build.associativity-under-iff)
+  (%autoprove logic.method-of-build.associativity)
+  (%autoprove logic.conclusion-of-build.associativity)
+  (%autoprove logic.subproofs-of-build.associativity)
+  (%autoprove logic.extras-of-build.associativity)
+  (%autoprove forcing-logic.appealp-of-build.associativity)
+  (local (%disable default build.associativity))
+  (%autoprove forcing-logic.proofp-of-build.associativity
+              (%enable default logic.appeal-step-okp logic.associativity-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.associativity x)))))
+
+(defsection build.instantiation
+  (%autoadmit build.instantiation)
+  (local (%enable default build.instantiation))
+  (%autoprove build.instantiation-under-iff)
+  (%autoprove logic.method-of-build.instantiation)
+  (%autoprove logic.conclusion-of-build.instantiation)
+  (%autoprove logic.subproofs-of-build.instantiation)
+  (%autoprove logic.extras-of-build.instantiation)
+  (%autoprove forcing-logic.appealp-of-build.instantiation)
+  (%autoprove forcing-logic.proofp-of-build.instantiation
+              (%enable default logic.appeal-step-okp logic.instantiation-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(logic.appeal 'instantiation (logic.substitute-formula (logic.conclusion x) sigma) (cons x 'nil) sigma)))))
+
+(defsection build.functional-equality
+  (%autoadmit build.functional-equality)
+  (local (%enable default build.functional-equality))
+  (%autoprove build.functional-equality-under-iff)
+  (%autoprove logic.method-of-build.functional-equality)
+  (%autoprove logic.conclusion-of-build.functional-equality)
+  (%autoprove logic.subproofs-of-build.functional-equality)
+  (%autoprove logic.extras-of-build.functional-equality)
+  (%autoprove forcing-logic.appealp-of-build.functional-equality)
+  (local (%disable default build.functional-equality))
+  (%autoprove forcing-logic.proofp-of-build.functional-equality
+              (%enable default logic.appeal-step-okp logic.functional-equality-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.functional-equality fn ti si)))))
+
+(defsection build.beta-reduction
+  (%autoadmit build.beta-reduction)
+  (local (%enable default build.beta-reduction))
+  (%autoprove build.beta-reduction-under-iff)
+  (%autoprove logic.method-of-build.beta-reduction)
+  (%autoprove logic.conclusion-of-build.beta-reduction)
+  (%autoprove logic.subproofs-of-build.beta-reduction)
+  (%autoprove logic.extras-of-build.beta-reduction)
+  (%autoprove forcing-logic.appealp-of-build.beta-reduction)
+  (local (%disable default build.beta-reduction))
+  (%autoprove forcing-logic.proofp-of-build.beta-reduction
+              (%enable default logic.appeal-step-okp logic.beta-reduction-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.beta-reduction formals body actuals)))))
+
+(defsection build.base-eval
+  (%autoadmit build.base-eval)
+  (local (%enable default build.base-eval))
+  (%autoprove build.base-eval-under-iff)
+  (%autoprove logic.method-of-build.base-eval)
+  (%autoprove logic.conclusion-of-build.base-eval)
+  (%autoprove logic.subproofs-of-build.base-eval)
+  (%autoprove logic.extras-of-build.base-eval)
+  (%autoprove forcing-logic.appealp-of-build.base-eval)
+  (local (%disable default build.base-eval))
+  (%autoprove forcing-logic.proofp-of-build.base-eval
+              (%enable default logic.appeal-step-okp logic.base-eval-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.base-eval a)))))
+
+(defsection build.instantiation-list
+  (%autoadmit build.instantiation-list)
+  (%autoprove build.instantiation-list-when-not-consp (%restrict default build.instantiation-list (equal x 'x)))
+  (%autoprove build.instantiation-list-of-cons (%restrict default build.instantiation-list (equal x '(cons a x))))
+  (%autoprove forcing-logic.appeal-listp-of-build.instantiation-list (%cdr-induction x))
+  (%autoprove forcing-logic.strip-conclusions-of-build.instantiation-list (%cdr-induction x))
+  ;; BOZO next theorem is misnamed, should be proof-listp
+  (%autoprove forcing-logic.proofp-of-build.instantiation-list (%cdr-induction x)))
+
+(defsection build.induction
+  (%autoadmit build.induction)
+  (local (%enable default build.induction))
+  (%autoprove build.induction-under-iff)
+  (%autoprove logic.method-of-build.induction)
+  (%autoprove logic.conclusion-of-build.induction)
+  (%autoprove logic.subproofs-of-build.induction)
+  (%autoprove logic.extras-of-build.induction)
+  (%autoprove forcing-logic.appealp-of-build.induction)
+  (local (%disable default build.induction))
+  (%autoprove forcing-logic.proofp-of-build.induction
+              (%enable default logic.appeal-step-okp logic.induction-okp)
+              (%restrict default definition-of-logic.proofp (equal x '(build.induction f m qs all-sigmas proofs)))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level2/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/cert.image	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1 @@
+level2-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/defderiv.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level2/defderiv.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/defderiv.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/defderiv.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,115 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(defun %defderiv-fn (name world hintsmap omit-okp)
+  (declare (xargs :mode :program))
+  (let* ((info-entry     (lookup name (dd.get-info-for-%defderiv world)))
+         (local-axioms   (second info-entry))
+         (local-thms     (third info-entry))
+         (soundness-hint (fourth info-entry))
+         (name-okp       (ACL2::mksym name '-okp)))
+    `(encapsulate
+      ()
+      (encapsulate
+       ()
+       ,@(if (or local-axioms local-thms)
+             `((local (%enable default
+                               ,@(strip-firsts local-axioms)
+                               ,@(strip-firsts local-thms))))
+           nil)
+
+       (%autoadmit ,name)
+       (%noexec ,name)
+
+       (local (%enable default ,name))
+
+       (%autoprove ,(ACL2::mksym name '-under-iff)
+                   ;; BOZO globally disable forcing here after implementing
+                   ;; a flag in the control structure for it
+                   )
+       (%autoprove ,(ACL2::mksym 'forcing-logic.appealp-of- name)
+                   ,@(cdr (lookup (ACL2::mksym 'forcing-logic.appealp-of- name) hintsmap)))
+
+       (%autoprove ,(ACL2::mksym 'forcing-logic.conclusion-of- name)
+                   ,@(cdr (lookup (ACL2::mksym 'forcing-logic.conclusion-of- name) hintsmap)))
+
+       (%autoprove ,(ACL2::mksym 'forcing-logic.proofp-of- name)
+                   ,@(cdr (lookup (ACL2::mksym 'forcing-logic.proofp-of- name) hintsmap))))
+
+      ,@(if omit-okp
+            nil
+          `((%autoadmit ,name-okp)
+            (%autoprove ,(ACL2::mksym 'booleanp-of- name-okp)
+                        ,@(or (cdr (lookup (ACL2::mksym 'booleanp-of- name-okp) hintsmap))
+                              `((%enable default ,name-okp))))
+            (%autoprove ,(ACL2::mksym name-okp '-of-logic.appeal-identity)
+                        ,@(or (cdr (lookup (ACL2::mksym name-okp '-of-logic.appeal-identity) hintsmap))
+                              `((%enable default ,name-okp))))
+            (local (%enable default backtracking-logic.formula-atblp-rules))
+            (local (%disable default
+                             forcing-logic.formula-atblp-rules
+                             forcing-lookup-of-logic.function-name-free
+                             forcing-logic.term-list-atblp-of-logic.function-args))
+            (%autoprove ,(ACL2::mksym 'lemma-1-for-soundness-of- name-okp)
+                        (%enable default ,name-okp)
+                        ,@(or (cdr (lookup (ACL2::mksym 'lemma-1-for-soundness-of- name-okp) hintsmap))
+                              nil))
+            (%autoprove ,(ACL2::mksym 'lemma-2-for-soundness-of- name-okp)
+                        (%enable default ,name-okp)
+                        ,@(or (cdr (lookup (ACL2::mksym 'lemma-2-for-soundness-of- name-okp) hintsmap))
+                              nil))
+            (%autoprove ,(ACL2::mksym 'forcing-soundness-of- name-okp)
+                        ,@(or (cdr (lookup (ACL2::mksym 'forcing-soundness-of- name-okp) hintsmap))
+                              `((%enable default
+                                         ,(ACL2::mksym 'lemma-1-for-soundness-of- name-okp)
+                                         ,(ACL2::mksym 'lemma-2-for-soundness-of- name-okp))
+                                (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                                                 (x (,name ,@soundness-hint))))
+                                (%auto :strategy (cleanup split crewrite))
+                                (%enable default ,name-okp)
+                                (%auto :strategy (cleanup split crewrite)))
+                              )))))))
+
+(defmacro %defderiv (name &key hintsmap omit-okp)
+  `(ACL2::make-event (%defderiv-fn ',name (ACL2::w ACL2::state) ',hintsmap ',omit-okp)))
+
+(defmacro %deftheorem (name)
+  ;; We don't need to bother with proving the theorems.  But, we do want to
+  ;; have the theorem functions available.
+  `(encapsulate
+    ()
+    (%autoadmit ,name)
+    (%noexec ,name)))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/level2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level2/level2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/level2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/level2.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,141 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "support-3")
+(%interactive)
+
+
+
+(%autoadmit level2.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level2.step-okp))
+ (%autoprove soundness-of-level2.step-okp)
+ (%autoprove level2.step-okp-when-logic.appeal-step-okp (%enable default logic.appeal-step-okp))
+ (%autoprove level2.step-okp-when-not-consp             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%disable default forcing-true-listp-of-logic.subproofs))
+ (%autoadmit level2.flag-proofp))
+
+(%autoadmit level2.proofp)
+(%autoadmit level2.proof-listp)
+(%autoprove definition-of-level2.proofp
+            (%enable default level2.proofp level2.proof-listp)
+            (%restrict default level2.flag-proofp (equal x 'x)))
+(%autoprove definition-of-level2.proof-listp
+            (%enable default level2.proofp level2.proof-listp)
+            (%restrict default level2.flag-proofp (equal x 'x)))
+
+
+(%autoprove level2.proofp-when-not-consp      (%restrict default definition-of-level2.proofp (equal x 'x)))
+(%autoprove level2.proof-listp-when-not-consp (%restrict default definition-of-level2.proof-listp (equal x 'x)))
+(%autoprove level2.proof-listp-of-cons        (%restrict default definition-of-level2.proof-listp (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level2.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level2.proofp (equal x 'x)))
+
+(%autoprove booleanp-of-level2.proofp      (%use (%instance (%thm lemma-for-booleanp-of-level2.proofp) (flag 'proof))))
+(%autoprove booleanp-of-level2.proof-listp (%use (%instance (%thm lemma-for-booleanp-of-level2.proofp) (flag 'list))))
+
+
+(%deflist level2.proof-listp (x axioms thms atbl)
+          (level2.proofp x axioms thms atbl))
+
+
+(%autoprove lemma-for-logic.provablep-when-level2.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level2.proofp (equal x 'x)))
+
+(%autoprove logic.provablep-when-level2.proofp           (%use (%instance (%thm lemma-for-logic.provablep-when-level2.proofp) (flag 'proof))))
+(%autoprove logic.provable-listp-when-level2.proof-listp (%use (%instance (%thm lemma-for-logic.provablep-when-level2.proofp) (flag 'list))))
+
+
+
+(%autoprove lemma-for-level2.proofp-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level2.proofp (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove level2.proofp-when-logic.proofp                 (%use (%instance (%thm lemma-for-level2.proofp-when-logic.proofp) (flag 'proof))))
+(%autoprove level2.proof-listp-when-logic.proof-listp       (%use (%instance (%thm lemma-for-level2.proofp-when-logic.proofp) (flag 'list))))
+(%autoprove forcing-level2.proofp-of-logic.provable-witness (%enable default level2.proofp-when-logic.proofp))
+
+(defsection level2-transition
+  (%install-new-proofp level2.proofp)
+  (%auto)
+  (%qed-install))
+
+(%switch-builder build.commute-or                     build.commute-or-high)
+(%switch-builder build.right-expansion                build.right-expansion-high)
+(%switch-builder build.modus-ponens                   build.modus-ponens-high)
+(%switch-builder build.modus-ponens-2                 build.modus-ponens-2-high)
+(%switch-builder build.right-associativity            build.right-associativity-high)
+(%switch-builder build.disjoined-left-expansion       build.disjoined-left-expansion-high)
+(%switch-builder build.disjoined-right-expansion      build.disjoined-right-expansion-high)
+(%switch-builder build.disjoined-contraction          build.disjoined-contraction-high)
+(%switch-builder build.cancel-neg-neg                 build.cancel-neg-neg-high)
+(%switch-builder build.insert-neg-neg                 build.insert-neg-neg-high)
+(%switch-builder build.lhs-insert-neg-neg             build.lhs-insert-neg-neg-high)
+(%switch-builder build.merge-negatives                build.merge-negatives-high)
+(%switch-builder build.merge-implications             build.merge-implications-high)
+(%switch-builder build.disjoined-commute-or           build.disjoined-commute-or-high)
+(%switch-builder build.disjoined-right-associativity  build.disjoined-right-associativity-high)
+(%switch-builder build.disjoined-cut                  build.disjoined-cut-high)
+(%switch-builder build.disjoined-modus-ponens         build.disjoined-modus-ponens-high)
+(%switch-builder build.disjoined-modus-ponens-2       build.disjoined-modus-ponens-2-high)
+(%switch-builder build.lhs-commute-or-then-rassoc     build.lhs-commute-or-then-rassoc-high)
+(%switch-builder rw.crewrite-twiddle-bldr             rw.crewrite-twiddle-bldr-high)
+(%switch-builder rw.crewrite-twiddle2-bldr            rw.crewrite-twiddle2-bldr-high)
+(%switch-builder clause.aux-split-twiddle             clause.aux-split-twiddle-high)
+(%switch-builder clause.aux-split-twiddle2            clause.aux-split-twiddle2-high)
+(%switch-builder clause.aux-split-default-3-bldr      clause.aux-split-default-3-bldr-high)
+
+
+
+(%finish "level2")
+(%save-events "level2.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level2/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/make-image.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../logic/top")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level2-symmetry"
+                 "Preloaded bootstrap/logic directory.")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/support-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level2/support-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/support-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/support-1.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,59 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "defderiv")
+(include-book "basic")
+(%interactive)
+
+(%defderiv build.commute-or)
+(%defderiv build.right-expansion)
+(%defderiv build.modus-ponens)
+(%defderiv build.modus-ponens-2)
+(%defderiv build.right-associativity)
+(%defderiv build.disjoined-left-expansion)
+(%defderiv build.disjoined-right-expansion)
+(%defderiv build.disjoined-contraction)
+(%defderiv build.cancel-neg-neg)
+(%defderiv build.insert-neg-neg)
+(%defderiv build.lhs-insert-neg-neg)
+(%defderiv build.merge-negatives)
+
+(%defderiv build.merge-implications-lemma-1 :omit-okp t)
+(%defderiv build.merge-implications-lemma-2 :omit-okp t)
+(%defderiv build.merge-implications)
+
+(%defderiv build.disjoined-commute-or-lemma-1 :omit-okp t)
+(%defderiv build.disjoined-commute-or)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/support-2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level2/support-2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/support-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/support-2.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,56 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "support-1")
+(%interactive)
+
+(%defderiv build.disjoined-assoc-lemma-1a :omit-okp t)
+(%defderiv build.disjoined-assoc-lemma-1  :omit-okp t)
+(%defderiv build.disjoined-assoc-lemma-2a :omit-okp t)
+(%defderiv build.disjoined-assoc-lemma-2  :omit-okp t)
+(%defderiv build.disjoined-assoc-lemma-3a :omit-okp t)
+(%defderiv build.disjoined-assoc-lemma-3  :omit-okp t)
+
+(%defderiv build.disjoined-right-associativity)
+
+(%defderiv build.disjoined-assoc-lemma-4 :omit-okp t)
+(%defderiv build.disjoined-associativity)
+
+(%defderiv build.disjoined-cut-lemma-1 :omit-okp t)
+(%defderiv build.disjoined-cut-lemma-2 :omit-okp t)
+(%defderiv build.disjoined-cut)
+
+(%defderiv build.disjoined-modus-ponens)
+(%defderiv build.disjoined-modus-ponens-2)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/support-3.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level2/support-3.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/support-3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/support-3.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,57 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "support-2")
+(%interactive)
+
+(%defderiv build.lhs-commute-or-then-rassoc)
+
+(%defderiv rw.crewrite-twiddle-bldr)
+
+(%defderiv rw.crewrite-twiddle2-lemma :omit-okp t)
+(%defderiv rw.crewrite-twiddle2-bldr)
+
+(%defderiv clause.aux-split-twiddle-lemma-1 :omit-okp t)
+(%defderiv clause.aux-split-twiddle)
+
+(%defderiv clause.aux-split-twiddle2-lemma-1a :omit-okp t)
+(%defderiv clause.aux-split-twiddle2-lemma-1  :omit-okp t)
+(%defderiv clause.aux-split-twiddle2-lemma-2a :omit-okp t)
+(%defderiv clause.aux-split-twiddle2-lemma-2  :omit-okp t)
+(%defderiv clause.aux-split-twiddle2)
+
+(%defderiv clause.aux-split-default-3-bldr)
+
+(%defderiv clause.aux-limsplit-cutoff-step-bldr)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level2/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level2/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level2/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level2/symmetry	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level2-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level3/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/axioms.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/axioms.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/axioms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/axioms.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,51 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+;; We just want to admit all the functions for the axioms.  We don't need to
+;; know that they are formulas, etc.  We can just cycle thorough the defaxes
+;; and do it automatically.
+
+(ACL2::make-event
+ (let* ((defax-entries (dd.get-defax-table (ACL2::w ACL2::state)))
+        (len           (len defax-entries))
+        (admits        (multicons '%autoadmit (pair-lists defax-entries (repeat nil len))))
+        (disables      (multicons '%noexec (pair-lists defax-entries (repeat nil len)))))
+   `(encapsulate
+     ()
+     ,@admits
+     ,@disables)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level3/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/cert.image	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1 @@
+level3-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/disjoined-update-clause-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/disjoined-update-clause-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/disjoined-update-clause-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/disjoined-update-clause-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,39 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%defderiv clause.aux-disjoined-update-clause-twiddle)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/equal.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/equal.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/equal.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/equal.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,70 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hacks")
+(include-book "pequal")
+(%interactive)
+
+(%deftheorem theorem-reflexivity-of-equal)
+(%defderiv build.equal-reflexivity)
+
+(%deftheorem theorem-equal-nil-or-t)
+(%defderiv build.equal-t-from-not-nil)
+(%defderiv build.disjoined-equal-t-from-not-nil)
+(%defderiv build.equal-nil-from-not-t)
+(%defderiv build.disjoined-equal-nil-from-not-t)
+(%defderiv build.pequal-from-equal)
+(%defderiv build.disjoined-pequal-from-equal)
+(%defderiv build.not-equal-from-not-pequal)
+(%defderiv build.disjoined-not-equal-from-not-pequal)
+
+(%deftheorem theorem-symmetry-of-equal)
+(%defderiv build.commute-equal)
+(%defderiv build.disjoined-commute-equal)
+
+(%defderiv build.equal-from-pequal)
+(%defderiv build.disjoined-equal-from-pequal)
+(%defderiv build.not-pequal-from-not-equal)
+(%defderiv build.disjoined-not-pequal-from-not-equal)
+
+(%deftheorem theorem-transitivity-of-equal)
+(%defderiv build.transitivity-of-equal)
+
+(defsection build.disjoined-transitivity-of-equal
+  (local (%max-proof-size 1000000000))
+  (%defderiv build.disjoined-transitivity-of-equal))
+
+(%defderiv build.not-pequal-constants)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/hacks.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/hacks.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/hacks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/hacks.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,142 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+
+
+
+(defthmd bust-up-logic.function-args-expensive
+  (implies (and (ACL2::syntaxp (logic.constantp x))
+                (consp x))
+           (equal (equal x (logic.function-args y))
+                  (and (consp (logic.function-args y))
+                       (equal (car x) (car (logic.function-args y)))
+                       (equal (cdr x) (cdr (logic.function-args y))))))
+  :hints(("Goal" :in-theory (disable FORCING-TRUE-LISTP-OF-LOGIC.FUNCTION-ARGS))))
+
+(defthmd bust-up-cdr-of-logic.function-args-expensive
+  (implies (and (ACL2::syntaxp (logic.constantp x))
+                (consp x))
+           (equal (equal x (cdr (logic.function-args y)))
+                  (and (consp (cdr (logic.function-args y)))
+                       (equal (car x) (car (cdr (logic.function-args y))))
+                       (equal (cdr x) (cdr (cdr (logic.function-args y))))))))
+
+(defthmd bust-up-cdr-of-cdr-of-logic.function-args-expensive
+  (implies (and (ACL2::syntaxp (logic.constantp x))
+                (consp x))
+           (equal (equal x (cdr (cdr (logic.function-args y))))
+                  (and (consp (cdr (cdr (logic.function-args y))))
+                       (equal (car x) (car (cdr (cdr (logic.function-args y)))))
+                       (equal (cdr x) (cdr (cdr (cdr (logic.function-args y)))))))))
+
+(%autoprove bust-up-logic.function-args-expensive (%forcingp nil))
+(%autoprove bust-up-cdr-of-logic.function-args-expensive (%forcingp nil))
+(%autoprove bust-up-cdr-of-cdr-of-logic.function-args-expensive (%forcingp nil))
+
+
+
+;; (DEFTHM CDR-OF-CDR-UNDER-IFF-WHEN-TRUE-LISTP-WITH-LEN-FREE-alt
+;;   (IMPLIES (AND (EQUAL n (lEN X))
+;;                 (SYNTAXP (ACL2::QUOTEP N))
+;;                 (TRUE-LISTP X))
+;;            (IFF (CDR (CDR X)) (< 2 N))))
+
+;; (%autoprove CDR-OF-CDR-UNDER-IFF-WHEN-TRUE-LISTP-WITH-LEN-FREE-alt
+;;             (%use (%instance (%thm CDR-OF-CDR-UNDER-IFF-WHEN-TRUE-LISTP-WITH-LEN-FREE))))
+
+;; (DEFTHM LOGIC.FUNCTION-ARGS-UNDER-IFF-WITH-LEN-FREE-alt
+;;   (IMPLIES (AND (EQUAL N (LEN (LOGIC.FUNCTION-ARGS TERM)))
+;;                 (SYNTAXP (ACL2::QUOTEP N))
+;;                 (< 0 N))
+;;            (IFF (LOGIC.FUNCTION-ARGS TERM) T)))
+
+;; (%autoprove LOGIC.FUNCTION-ARGS-UNDER-IFF-WITH-LEN-FREE-alt)
+
+;; (DEFTHM CDR-OF-CDR-OF-CDR-UNDER-IFF-WHEN-TRUE-LISTP-WITH-LEN-FREE-alt
+;;   (IMPLIES (AND (EQUAL n (LEN X))
+;;                 (SYNTAXP (ACL2::QUOTEP N))
+;;                 (TRUE-LISTP X))
+;;            (IFF (CDR (CDR (CDR X))) (< 3 N))))
+
+;; (%autoprove CDR-OF-CDR-OF-CDR-UNDER-IFF-WHEN-TRUE-LISTP-WITH-LEN-FREE-alt
+;;             (%use (%instance (%thm CDR-OF-CDR-OF-CDR-UNDER-IFF-WHEN-TRUE-LISTP-WITH-LEN-FREE))))
+
+
+
+
+
+(defthm logic.term-list-atblp-of-cons-gross
+  (implies (ACL2::syntaxp (logic.constantp x))
+           (equal (logic.term-list-atblp x atbl)
+                  (if (consp x)
+                      (and (logic.term-atblp (car x) atbl)
+                           (logic.term-list-atblp (cdr x) atbl))
+                    t))))
+
+(%autoprove logic.term-list-atblp-of-cons-gross)
+
+
+
+(defthm logic.sigma-atblp-of-cons-gross
+  (implies (ACL2::syntaxp (logic.constantp x))
+           (equal (logic.sigma-atblp x atbl)
+                  (if (consp x)
+                      (and (consp (car x))
+                           (logic.variablep (car (car x)))
+                           (logic.term-atblp (cdr (car x)) atbl)
+                           (logic.sigma-atblp (cdr x) atbl))
+                      t))))
+
+(%autoprove logic.sigma-atblp-of-cons-gross)
+
+
+
+(defsection logic.substitute-list-of-cons-gross
+  ;; This rule fixes a problem that comes up when we run into terms of the form
+  ;; (logic.substitute-list '(x y) ...).  Here, our cons rule does not fire
+  ;; because our patmatch code does not allow it do.  We should probably fix
+  ;; our pattern matcher in the long run, but for now we can emulate it in a
+  ;; kind of gross way using a syntactic restriction.
+  (%prove (%rule logic.substitute-list-of-cons-gross
+                 :hyps (list (%hyp (consp x)))
+                 :lhs (logic.substitute-list x sigma)
+                 :rhs (cons (logic.substitute (car x) sigma)
+                            (logic.substitute-list (cdr x) sigma))
+                 :syntax ((logic.constantp x))))
+  (%auto)
+  (%qed)
+  (%enable default logic.substitute-list-of-cons-gross))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/if.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/if.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/if.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/if.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hacks")
+(include-book "pequal")
+(%interactive)
+
+(%defderiv build.if-when-not-nil)
+(%defderiv build.if-when-nil)
+
+(%deftheorem theorem-if-redux-same)
+(%deftheorem theorem-if-redux-then)
+(%deftheorem theorem-if-redux-else)
+(%deftheorem theorem-if-redux-test)
+(%deftheorem theorem-if-redux-nil)
+(%deftheorem theorem-if-redux-t)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/iff.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/iff.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/iff.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/iff.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,181 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hacks")
+(include-book "equal")
+(%interactive)
+
+
+
+(local (%noexec cons))
+
+(local (%enable default
+                bust-up-logic.function-args-expensive
+                bust-up-cdr-of-logic.function-args-expensive
+                bust-up-cdr-of-cdr-of-logic.function-args-expensive))
+
+
+(%autoadmit definition-of-iff)
+(%noexec definition-of-iff)
+
+(%deftheorem theorem-iff-lhs-false)
+(%deftheorem theorem-iff-lhs-true)
+(%deftheorem theorem-iff-rhs-false)
+(%deftheorem theorem-iff-rhs-true)
+
+(%deftheorem theorem-iff-both-true)
+(%deftheorem theorem-iff-both-false)
+(%deftheorem theorem-iff-true-false)
+(%deftheorem theorem-iff-false-true)
+
+(%deftheorem theorem-iff-t-when-not-nil)
+(%defderiv build.iff-t-from-not-pequal-nil)
+(%defderiv build.disjoined-iff-t-from-not-pequal-nil)
+
+(%deftheorem theorem-iff-t-when-nil)
+(%defderiv build.not-pequal-nil-from-iff-t)
+(%defderiv build.disjoined-not-pequal-nil-from-iff-t)
+
+(%deftheorem theorem-iff-nil-when-nil)
+(%deftheorem theorem-iff-nil-when-not-nil)
+
+
+;; (%deftheorem theorem-iff-t-when-not-nil)
+;; (%defderiv build.iff-t-from-not-pequal-nil)
+;; (%defderiv build.disjoined-iff-t-from-not-pequal-nil)
+
+
+;; (%defderiv build.pequal-nil-from-iff-nil)
+;; (%defderiv build.disjoined-pequal-nil-from-iff-nil)
+
+(%deftheorem theorem-iff-nil-or-t)
+(%deftheorem theorem-reflexivity-of-iff)
+(%deftheorem theorem-symmetry-of-iff)
+
+(%defderiv build.iff-t-from-not-nil)
+(%defderiv build.disjoined-iff-t-from-not-nil)
+(%defderiv build.iff-reflexivity)
+(%defderiv build.commute-iff)
+(%defderiv build.disjoined-commute-iff)
+
+
+(%deftheorem theorem-iff-congruence-lemma)
+(%deftheorem theorem-iff-congruence-lemma-2)
+
+(%deftheorem theorem-iff-congruent-if-1)
+(%deftheorem theorem-iff-congruent-iff-2)
+(%deftheorem theorem-iff-congruent-iff-1)
+
+(%deftheorem theorem-transitivity-of-iff)
+(%defderiv build.transitivity-of-iff)
+(%defderiv build.disjoined-transitivity-of-iff)
+
+(%deftheorem theorem-iff-from-pequal)
+(%defderiv build.iff-from-pequal)
+(%defderiv build.disjoined-iff-from-pequal)
+
+(%deftheorem theorem-iff-from-equal)
+(%defderiv build.iff-from-equal)
+(%defderiv build.disjoined-iff-from-equal)
+
+(%autoadmit build.equiv-reflexivity)
+
+
+;; EOF
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;; old junk
+
+;; (%deftheorem theorem-iff-when-not-nil-and-not-nil)
+;; (%deftheorem theorem-iff-when-not-nil-and-nil)
+;; (%deftheorem theorem-iff-when-nil-and-not-nil)
+;; (%deftheorem theorem-iff-when-nil-and-nil)
+;; (%deftheorem theorem-iff-of-nil)
+;; (%deftheorem theorem-iff-of-t)
+
+;; (%deftheorem theorem-iff-normalize-t)
+;; (%deftheorem theorem-iff-normalize-nil)
+
+
+;; (%defderiv build.iff-reflexivity)
+
+
+;; (%deftheorem theorem-iff-from-pequal)
+;; (%defderiv build.iff-from-pequal)
+;; (%defderiv build.disjoined-iff-from-pequal)
+
+;; (%deftheorem theorem-iff-from-equal)
+;; (%defderiv build.iff-from-equal)
+;; (%defderiv build.disjoined-iff-from-equal)
+;; (%defderiv build.not-equal-from-not-iff)
+
+
+
+;; (%defderiv build.disjoined-not-equal-from-not-iff)
+
+;; (%deftheorem theorem-iff-with-nil-or-t)
+;; (%deftheorem theorem-iff-nil-or-t)
+
+;; (%defderiv build.iff-t-from-not-nil)
+;; (%defderiv build.disjoined-iff-t-from-not-nil)
+;; (%defderiv build.iff-nil-from-not-t)
+;; (%defderiv build.disjoined-iff-nil-from-not-t)
+
+
+
+;; (%defderiv build.commute-iff)
+;; (%defderiv build.disjoined-commute-iff)
+
+
+;; (%deftheorem theorem-transitivity-two-of-iff)
+;; (%deftheorem theorem-transitivity-of-iff)
+
+;; (%defderiv build.transitivity-of-iff)
+;; (%defderiv build.disjoined-transitivity-of-iff)
+
+;; (%deftheorem theorem-iff-of-if-x-t-nil)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/level3.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/level3.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/level3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/level3.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,222 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop")
+(include-book "pequal")
+(include-book "equal")
+(include-book "iff")
+(include-book "if")
+(include-book "not")
+(include-book "disjoined-update-clause-bldr")
+(%interactive)
+
+
+(%autoadmit level3.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level3.step-okp))
+ (%autoprove soundness-of-level3.step-okp)
+ ;; BOZO we might want this to be when level2-step-okp instead
+ (%autoprove level3.step-okp-when-level2.step-okp
+             (%enable default level2.step-okp logic.appeal-step-okp)
+             (%auto :strategy (cleanup split urewrite)))
+ (%autoprove level3.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%disable default forcing-true-listp-of-logic.subproofs))
+ (%autoadmit level3.flag-proofp-aux))
+
+(%autoadmit level3.proofp-aux)
+(%autoadmit level3.proof-listp-aux)
+(%autoprove definition-of-level3.proofp-aux
+            (%enable default level3.proofp-aux level3.proof-listp-aux)
+            (%restrict default level3.flag-proofp-aux (equal x 'x)))
+(%autoprove definition-of-level3.proof-listp-aux
+            (%enable default level3.proofp-aux level3.proof-listp-aux)
+            (%restrict default level3.flag-proofp-aux (equal x 'x)))
+
+
+(%autoprove level3.proofp-aux-when-not-consp      (%restrict default definition-of-level3.proofp-aux (equal x 'x)))
+(%autoprove level3.proof-listp-aux-when-not-consp (%restrict default definition-of-level3.proof-listp-aux (equal x 'x)))
+(%autoprove level3.proof-listp-aux-of-cons        (%restrict default definition-of-level3.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level3.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level3.proofp-aux (equal x 'x)))
+
+(%autoprove booleanp-of-level3.proofp-aux      (%use (%instance (%thm lemma-for-booleanp-of-level3.proofp-aux) (flag 'proof))))
+(%autoprove booleanp-of-level3.proof-listp-aux (%use (%instance (%thm lemma-for-booleanp-of-level3.proofp-aux) (flag 'list))))
+
+
+(%deflist level3.proof-listp-aux (x axioms thms atbl)
+          (level3.proofp-aux x axioms thms atbl))
+
+
+(%autoprove lemma-for-logic.provablep-when-level3.proofp-aux
+             (%logic.appeal-induction flag x)
+             (%disable default forcing-true-listp-of-logic.subproofs)
+             ;; Using the urewrite here cleans up tons of simple clauses, reducing the proof size
+             ;; from 1.7B to 188M
+             (%auto :strategy (cleanup urewrite split))
+             (%auto)
+             (%restrict default definition-of-level3.proofp-aux (equal x 'x)))
+
+(%autoprove logic.provablep-when-level3.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level3.proofp-aux) (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level3.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level3.proofp-aux) (flag 'list))))
+
+
+
+(%autoprove lemma-for-level3.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level3.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove level3.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level3.proofp-aux-when-logic.proofp) (flag 'proof))))
+
+(%autoprove level3.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level3.proofp-aux-when-logic.proofp) (flag 'list))))
+
+(%autoprove forcing-level3.proofp-aux-of-logic.provable-witness
+            (%enable default level3.proofp-aux-when-logic.proofp))
+
+
+
+(%autoadmit level3.proofp)
+(%autoprove booleanp-of-level3.proofp
+            (%enable default level3.proofp))
+(%autoprove logic.provablep-when-level3.proofp
+            (%enable default level3.proofp))
+
+
+(defsection level3-transition
+  (%install-new-proofp level3.proofp)
+  (%auto)
+  (%qed-install))
+
+
+
+
+;; Propositional rules
+(%switch-builder build.modus-ponens-list                         build.modus-ponens-list-high)
+(%switch-builder build.disjoined-modus-ponens-list               build.disjoined-modus-ponens-list-high)
+(%switch-builder build.generic-subset                            build.generic-subset-high)
+(%switch-builder build.disjoined-subset                          build.generic-subset-high)
+(%switch-builder build.multi-expansion                           build.multi-expansion-high)
+(%switch-builder build.multi-or-expansion                        build.multi-or-expansion-high)
+(%switch-builder build.rev-disjunction                           build.rev-disjunction-high)
+(%switch-builder build.ordered-subset                            build.ordered-subset-high)
+(%switch-builder build.disjoined-rev-disjunction                 build.disjoined-rev-disjunction-high)
+(%switch-builder build.multi-assoc-expansion                     build.multi-assoc-expansion-high)
+(%switch-builder clause.aux-disjoined-update-clause-twiddle      clause.aux-disjoined-update-clause-twiddle-high)
+
+;; Pequal rules
+(%switch-builder build.reflexivity                               build.reflexivity-high)
+(%switch-builder build.commute-pequal                            build.commute-pequal-high)
+(%switch-builder build.disjoined-commute-pequal                  build.disjoined-commute-pequal-high)
+(%switch-builder build.commute-not-pequal                        build.commute-not-pequal-high)
+(%switch-builder build.disjoined-commute-not-pequal              build.disjoined-commute-not-pequal-high)
+(%switch-builder build.substitute-into-not-pequal                build.substitute-into-not-pequal-high)
+(%switch-builder build.disjoined-substitute-into-not-pequal      build.disjoined-substitute-into-not-pequal-high)
+(%switch-builder build.transitivity-of-pequal                    build.transitivity-of-pequal-high)
+(%switch-builder build.disjoined-transitivity-of-pequal          build.disjoined-transitivity-of-pequal-high)
+(%switch-builder build.not-nil-from-t                            build.not-nil-from-t-high)
+(%switch-builder build.disjoined-not-nil-from-t                  build.disjoined-not-nil-from-t-high)
+(%switch-builder build.not-t-from-nil                            build.not-t-from-nil-high)
+(%switch-builder build.disjoined-not-t-from-nil                  build.disjoined-not-t-from-nil-high)
+
+;; Equal rules
+(%switch-builder build.equal-reflexivity                         build.equal-reflexivity-high)
+(%switch-builder build.equal-t-from-not-nil                      build.equal-t-from-not-nil-high)
+(%switch-builder build.disjoined-equal-t-from-not-nil            build.disjoined-equal-t-from-not-nil-high)
+(%switch-builder build.equal-nil-from-not-t                      build.equal-nil-from-not-t-high)
+(%switch-builder build.disjoined-equal-nil-from-not-t            build.disjoined-equal-nil-from-not-t-high)
+(%switch-builder build.pequal-from-equal                         build.pequal-from-equal-high)
+(%switch-builder build.disjoined-pequal-from-equal               build.disjoined-pequal-from-equal-high)
+(%switch-builder build.not-equal-from-not-pequal                 build.not-equal-from-not-pequal-high)
+(%switch-builder build.disjoined-not-equal-from-not-pequal       build.disjoined-not-equal-from-not-pequal-high)
+(%switch-builder build.commute-equal                             build.commute-equal-high)
+(%switch-builder build.disjoined-commute-equal                   build.disjoined-commute-equal-high)
+(%switch-builder build.equal-from-pequal                         build.equal-from-pequal-high)
+(%switch-builder build.disjoined-equal-from-pequal               build.disjoined-equal-from-pequal-high)
+(%switch-builder build.not-pequal-from-not-equal                 build.not-pequal-from-not-equal-high)
+(%switch-builder build.disjoined-not-pequal-from-not-equal       build.disjoined-not-pequal-from-not-equal-high)
+(%switch-builder build.transitivity-of-equal                     build.transitivity-of-equal-high)
+(%switch-builder build.disjoined-transitivity-of-equal           build.disjoined-transitivity-of-equal-high)
+(%switch-builder build.not-pequal-constants                      build.not-pequal-constants-high)
+
+;; If rules
+(%switch-builder build.if-when-not-nil                           build.if-when-not-nil-high)
+(%switch-builder build.if-when-nil                               build.if-when-nil-high)
+
+;; Iff rules
+(%switch-builder build.iff-t-from-not-pequal-nil                 build.iff-t-from-not-pequal-nil-high)
+(%switch-builder build.disjoined-iff-t-from-not-pequal-nil       build.disjoined-iff-t-from-not-pequal-nil-high)
+(%switch-builder build.not-pequal-nil-from-iff-t                 build.not-pequal-nil-from-iff-t-high)
+(%switch-builder build.disjoined-not-pequal-nil-from-iff-t       build.disjoined-not-pequal-nil-from-iff-t-high)
+(%switch-builder build.iff-t-from-not-nil                        build.iff-t-from-not-nil-high)
+(%switch-builder build.disjoined-iff-t-from-not-nil              build.disjoined-iff-t-from-not-nil-high)
+(%switch-builder build.iff-reflexivity                           build.iff-reflexivity-high)
+(%switch-builder build.commute-iff                               build.commute-iff-high)
+(%switch-builder build.disjoined-commute-iff                     build.disjoined-commute-iff-high)
+(%switch-builder build.transitivity-of-iff                       build.transitivity-of-iff-high)
+(%switch-builder build.disjoined-transitivity-of-iff             build.disjoined-transitivity-of-iff-high)
+(%switch-builder build.iff-from-pequal                           build.iff-from-pequal-high)
+(%switch-builder build.disjoined-iff-from-pequal                 build.disjoined-iff-from-pequal-high)
+(%switch-builder build.iff-from-equal                            build.iff-from-equal-high)
+(%switch-builder build.disjoined-iff-from-equal                  build.disjoined-iff-from-equal-high)
+
+;; Not rules
+(%switch-builder build.disjoined-negative-lit-from-pequal-nil    build.disjoined-negative-lit-from-pequal-nil-high)
+(%switch-builder build.disjoined-pequal-nil-from-negative-lit    build.disjoined-pequal-nil-from-negative-lit-high)
+(%switch-builder build.disjoined-iff-when-not-nil                build.disjoined-iff-when-not-nil-high)
+
+
+
+(%finish "level3")
+(%save-events "level3.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level3/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/make-image.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level2/level2")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level3-symmetry"
+                 "Preloaded bootstrap/level2 directory.")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/not.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/not.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/not.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/not.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,63 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hacks")
+(include-book "iff")
+(%interactive)
+
+;(local (%disable default LOGIC.FUNCTION-OF-CONS-WITH-DEFECTIVELY-MERGED-CONSTANT))
+
+(%autoadmit definition-of-not)
+
+(%deftheorem theorem-not-when-nil)
+;; (%defderiv build.negative-lit-from-pequal-nil)  ;; Not used anywhere.
+(%defderiv build.disjoined-negative-lit-from-pequal-nil)
+
+
+(%deftheorem theorem-not-when-not-nil)
+;; (%defderiv build.pequal-nil-from-negative-lit)  ;; Not used anywhere.
+(%defderiv build.negative-lit-from-not-pequal-nil :omit-okp t) ;; Only used in %use hints.
+(%defderiv build.disjoined-pequal-nil-from-negative-lit)
+
+(%deftheorem theorem-not-of-not)
+(%deftheorem theorem-not-of-not-under-iff)
+(%deftheorem theorem-iff-when-not-nil)
+
+;; (%defderiv build.iff-when-not-nil) ;; Not used anywhere.
+
+(encapsulate
+ ()
+ (local (%enable default bust-up-cdr-of-logic.function-args-expensive))
+ (%defderiv build.disjoined-iff-when-not-nil))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/pequal.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/pequal.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/pequal.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/pequal.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,63 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "axioms")
+(%interactive)
+
+(%defderiv build.reflexivity)
+(%defderiv build.equality :omit-okp t)
+
+(%deftheorem theorem-commutativity-of-pequal)
+(%defderiv build.commute-pequal)
+(%defderiv build.disjoined-commute-pequal)
+(%defderiv build.commute-not-pequal)
+(%defderiv build.disjoined-commute-not-pequal)
+
+(%deftheorem theorem-substitute-into-not-pequal)
+(%defderiv build.substitute-into-not-pequal)
+(%defderiv build.disjoined-substitute-into-not-pequal-lemma-1 :omit-okp t)
+(%defderiv build.disjoined-substitute-into-not-pequal)
+
+(%deftheorem theorem-transitivity-of-pequal)
+(%defderiv build.transitivity-of-pequal)
+(%defderiv build.disjoined-transitivity-of-pequal-lemma-1 :omit-okp t)
+(%defderiv build.disjoined-transitivity-of-pequal)
+
+(%deftheorem theorem-not-t-or-not-nil)
+(%defderiv build.not-nil-from-t)
+(%defderiv build.disjoined-not-nil-from-t)
+(%defderiv build.not-t-from-nil)
+(%defderiv build.disjoined-not-t-from-nil)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/prop.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level3/prop.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/prop.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/prop.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,289 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hacks")
+(%interactive)
+
+;(local (%disable default LOGIC.FUNCTION-OF-CONS-WITH-DEFECTIVELY-MERGED-CONSTANT))
+
+
+(defsection build.modus-ponens-list
+  (encapsulate
+   ()
+   (%autoadmit build.modus-ponens-list)
+   (local (%restrict default build.modus-ponens-list (equal as 'as)))
+   (%autoprove forcing-build.modus-ponens-list-under-iff
+               (%autoinduct build.modus-ponens-list))
+   (%autoprove forcing-logic.appealp-of-build.modus-ponens-list
+               (%autoinduct build.modus-ponens-list))
+   (%autoprove forcing-logic.conclusion-of-build.modus-ponens-list
+               (%autoinduct build.modus-ponens-list))
+   (%autoprove forcing-logic.proofp-of-build.modus-ponens-list
+               (%autoinduct build.modus-ponens-list)))
+   (%autoadmit build.modus-ponens-list-okp)
+   (local (%enable default build.modus-ponens-list-okp))
+   (%autoprove booleanp-of-build.modus-ponens-list-okp)
+   (%autoprove build.modus-ponens-list-okp-of-logic.appeal-identity)
+   (local (%enable default backtracking-logic.formula-atblp-rules))
+   (local (%disable default
+                    forcing-logic.formula-atblp-rules
+                    forcing-lookup-of-logic.function-name-free
+                    forcing-logic.term-list-atblp-of-logic.function-args))
+   (%autoprove lemma-1-for-soundness-of-build.modus-ponens-list-okp)
+   (%autoprove lemma-2-for-soundness-of-build.modus-ponens-list-okp)
+   (%autoprove forcing-soundness-of-build.modus-ponens-list-okp
+               (%enable default
+                        lemma-1-for-soundness-of-build.modus-ponens-list-okp
+                        lemma-2-for-soundness-of-build.modus-ponens-list-okp)
+               (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                                (x (build.modus-ponens-list (logic.conclusion x)
+                                                            (logic.provable-list-witness
+                                                             (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                             axioms thms atbl)
+                                                            (logic.provable-witness
+                                                             (logic.conclusion (car (logic.subproofs x)))
+                                                             axioms thms atbl)))))
+               (%auto :strategy (cleanup split crewrite))))
+
+
+(defsection build.disjoined-modus-ponens-list
+  (%autoadmit build.disjoined-modus-ponens-list)
+  (%autoprove forcing-build.disjoined-modus-ponens-list-under-iff
+              (%restrict default build.disjoined-modus-ponens-list (equal as 'as))
+              (%autoinduct build.disjoined-modus-ponens-list))
+  (%autoprove lemma-for-forcing-logic.appealp-of-build.disjoined-modus-ponens-list
+              (%autoinduct build.disjoined-modus-ponens-list)
+              (%restrict default build.disjoined-modus-ponens-list (equal as 'as))
+              ;; This disable prevents an rlimit loop.  It wasn't clear to me how to syntactically
+              ;; limit the rule appropriately.
+              (%disable default forcing-logic.vrhs-of-logic.disjoin-formulas-free))
+  (%autoprove forcing-logic.appealp-of-build.disjoined-modus-ponens-list
+              (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-modus-ponens-list))))
+  (%autoprove forcing-logic.conclusion-of-build.disjoined-modus-ponens-list
+              (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-modus-ponens-list))))
+  (%autoprove forcing-logic.proofp-of-build.disjoined-modus-ponens-list
+              (%restrict default build.disjoined-modus-ponens-list (equal as 'as))
+              (%autoinduct build.disjoined-modus-ponens-list))
+
+  (%autoadmit build.disjoined-modus-ponens-list-okp)
+  (local (%enable default build.disjoined-modus-ponens-list-okp))
+  (%autoprove booleanp-of-build.disjoined-modus-ponens-list-okp)
+  (%autoprove build.disjoined-modus-ponens-list-okp-of-logic.appeal-identity)
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free
+                   forcing-logic.term-list-atblp-of-logic.function-args))
+  (%autoprove lemma-1-for-soundness-of-build.disjoined-modus-ponens-list-okp)
+  (%autoprove lemma-2-for-soundness-of-build.disjoined-modus-ponens-list-okp)
+  (%autoprove forcing-soundness-of-build.disjoined-modus-ponens-list-okp
+              (%enable default
+                       lemma-1-for-soundness-of-build.disjoined-modus-ponens-list-okp
+                       lemma-2-for-soundness-of-build.disjoined-modus-ponens-list-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (build.disjoined-modus-ponens-list (logic.vrhs (logic.conclusion x))
+                                                                     (logic.provable-list-witness
+                                                                      (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                      axioms thms atbl)
+                                                                     (logic.provable-witness
+                                                                      (logic.conclusion (car (logic.subproofs x)))
+                                                                      axioms thms atbl)))))
+              (%auto :strategy (cleanup split crewrite))))
+
+(defsection build.multi-expansion
+  ;; No okp --- we use generic-subset instead
+  (%autoadmit build.multi-expansion)
+  (local (%restrict default build.multi-expansion (equal as 'as)))
+  (%autoprove build.multi-expansion-under-iff)
+  (local (%disable default
+                   car-when-memberp-and-not-memberp-of-cdr-cheap
+                   car-when-memberp-of-singleton-list-cheap))
+  (%autoprove forcing-logic.appealp-of-build.multi-expansion
+              (%cdr-induction as)
+              (%auto)
+              (%enable default
+                       car-when-memberp-and-not-memberp-of-cdr-cheap
+                       car-when-memberp-of-singleton-list-cheap))
+  (%autoprove forcing-logic.conclusion-of-build.multi-expansion
+              (%cdr-induction as)
+              (%auto)
+              (%enable default
+                       car-when-memberp-and-not-memberp-of-cdr-cheap
+                       car-when-memberp-of-singleton-list-cheap))
+  (%autoprove forcing-logic.proofp-of-build.multi-expansion
+              (%cdr-induction as)
+              (%auto)
+              (%enable default
+                       car-when-memberp-and-not-memberp-of-cdr-cheap
+                       car-when-memberp-of-singleton-list-cheap)))
+
+(defsection build.multi-or-expansion-step
+  ;; No okp --- we use generic subset instead
+  (%autoadmit build.multi-or-expansion-step)
+  (%autoprove build.multi-or-expansion-step-under-iff
+              (%restrict default build.multi-or-expansion-step (equal as 'as)))
+  (local (%disable default
+                   car-when-memberp-of-singleton-list-cheap
+                   car-when-memberp-and-not-memberp-of-cdr-cheap))
+  (%autoprove lemma-for-forcing-logic.appealp-of-build.multi-or-expansion-step
+              (%cdr-induction as)
+              (%restrict default build.multi-or-expansion-step (equal as 'as))
+              (%auto)
+              (%enable default
+                       car-when-memberp-of-singleton-list-cheap
+                       car-when-memberp-and-not-memberp-of-cdr-cheap))
+  (%autoprove forcing-logic.appealp-of-build.multi-or-expansion-step
+              (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.multi-or-expansion-step))))
+  (%autoprove forcing-logic.conclusion-of-build.multi-or-expansion-step
+              (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.multi-or-expansion-step))))
+  (%autoprove forcing-logic.proofp-of-build.multi-or-expansion-step
+              (%cdr-induction as)
+              (%restrict default build.multi-or-expansion-step (equal as 'as))
+              (%auto)
+              (%enable default
+                       car-when-memberp-of-singleton-list-cheap
+                       car-when-memberp-and-not-memberp-of-cdr-cheap)))
+
+
+(defsection build.multi-or-expansion
+  ;; No okp --- we use generic subset instead
+  (%autoadmit build.multi-or-expansion)
+  (local (%restrict default build.multi-or-expansion (equal as 'as)))
+  (%autoprove build.multi-or-expansion-under-iff)
+
+  ;; loops with new rewriting changes
+  (local (%disable default car-when-memberp-and-not-memberp-of-cdr-cheap))
+  (%autoprove forcing-logic.appealp-of-build.multi-or-expansion
+              (%cdr-induction as))
+
+  (%autoprove forcing-logic.conclusion-of-build.multi-or-expansion
+              (%cdr-induction as))
+
+  (%autoprove forcing-logic.proofp-of-build.multi-or-expansion
+              (%cdr-induction as)))
+
+(%defderiv build.generic-subset-step-lemma-1 :omit-okp t)
+
+
+(defsection build.generic-subset-step
+  ;; No okp --- we use generic subset instead
+  (%autoadmit build.generic-subset-step)
+  (local (%enable default build.generic-subset-step))
+  (%autoprove build.generic-subset-step-under-iff)
+  (%autoprove forcing-logic.appealp-of-build.generic-subset-step)
+  (%autoprove forcing-logic.conclusion-of-build.generic-subset-step)
+  (%autoprove forcing-logic.proofp-of-build.generic-subset-step))
+
+
+(defsection build.generic-subset
+  (%autoadmit build.generic-subset)
+  (%autoprove build.generic-subset-under-iff
+              (%restrict default build.generic-subset (equal as 'as)))
+  (%autoprove lemma-for-forcing-logic.appealp-of-build.generic-subset
+              (%autoinduct build.generic-subset)
+              (%auto :strategy (cleanup split urewrite crewrite))
+              (%restrict default build.generic-subset (equal as 'as)))
+  (%autoprove forcing-logic.appealp-of-build.generic-subset
+              (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.generic-subset))))
+  (%autoprove forcing-logic.conclusion-of-build.generic-subset
+              (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.generic-subset))))
+  (%autoprove forcing-logic.proofp-of-build.generic-subset
+              (%autoinduct build.generic-subset)
+              (%auto :strategy (cleanup split urewrite crewrite))
+              (%restrict default build.generic-subset (equal as 'as)))
+  (%autoadmit build.generic-subset-okp)
+  (local (%enable default build.generic-subset-okp))
+  (%autoprove booleanp-of-build.generic-subset-okp)
+  (%autoprove build.generic-subset-okp-of-logic.appeal-identity)
+  (%autoprove forcing-soundness-of-build.generic-subset-okp
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (build.generic-subset (first (logic.extras x))
+                                                        (second (logic.extras x))
+                                                        (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                                                                axioms thms atbl)))))))
+
+
+(defsection build.multi-assoc-expansion
+  (%autoadmit build.multi-assoc-expansion)
+  (%autoprove build.multi-assoc-expansion-under-iff
+              (%restrict default build.multi-assoc-expansion (equal as 'as)))
+  (%autoprove lemma-for-forcing-logic.appealp-of-build.multi-assoc-expansion
+              (%autoinduct build.multi-assoc-expansion)
+              (%restrict default build.multi-assoc-expansion (equal as 'as))
+              (%forcingp nil))
+  (%autoprove forcing-logic.appealp-of-build.multi-assoc-expansion
+              (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.multi-assoc-expansion))))
+  (%autoprove forcing-logic.conclusion-of-build.multi-assoc-expansion
+              (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.multi-assoc-expansion))))
+  (%autoprove forcing-logic.proofp-of-build.multi-assoc-expansion
+              (%autoinduct build.multi-assoc-expansion)
+              (%restrict default build.multi-assoc-expansion (equal as 'as)))
+  (%autoadmit build.multi-assoc-expansion-okp)
+  (local (%enable default build.multi-assoc-expansion-okp))
+  (%autoprove booleanp-of-build.multi-assoc-expansion-okp)
+  (%autoprove build.multi-assoc-expansion-okp-of-logic.appeal-identity)
+  (%autoprove lemma-1-for-soundness-of-build.multi-assoc-expansion-okp)
+  (%autoprove lemma-2-for-soundness-of-build.multi-assoc-expansion-okp)
+  (%autoprove forcing-soundness-of-build.multi-assoc-expansion-okp
+              (%enable default
+                       lemma-1-for-soundness-of-build.multi-assoc-expansion-okp
+                       lemma-2-for-soundness-of-build.multi-assoc-expansion-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (build.multi-assoc-expansion (logic.provable-witness
+                                                                (logic.conclusion (car (logic.subproofs x)))
+                                                                axioms thms atbl)
+                                                               (logic.extras x)))))))
+
+
+(%autoadmit build.rev-disjunction)
+(%autoadmit build.disjoined-rev-disjunction)
+(%autoadmit build.disjoined-subset)
+(%autoadmit build.all-superset-of-some)
+
+(%autoprove forcing-logic.appeal-listp-of-build.all-superset-of-some
+            (%cdr-induction x)
+            (%restrict default build.all-superset-of-some (equal x 'x))
+            (%enable default build.disjoined-subset))
+
+(%autoprove forcing-logic.strip-conclusions-of-build.all-superset-of-some
+            (%cdr-induction x)
+            (%restrict default build.all-superset-of-some (equal x 'x))
+            (%enable default build.disjoined-subset))
+
+(%autoprove forcing-logic.proof-listp-of-build.all-superset-of-some
+            (%cdr-induction x)
+            (%restrict default build.all-superset-of-some (equal x 'x))
+            (%enable default build.disjoined-subset))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level3/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level3/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level3/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level3/symmetry	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level3-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level4/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/acl2-customization.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/aux-limsplit-cutoff-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/aux-limsplit-cutoff-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/aux-limsplit-cutoff-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/aux-limsplit-cutoff-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,147 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+
+
+(%autoadmit clause.aux-limsplit-cutoff-bldr)
+
+(%autoprove clause.aux-limsplit-cutoff-bldr-under-iff
+            (%autoinduct clause.aux-limsplit-cutoff-bldr)
+            (%restrict default clause.aux-limsplit-cutoff-bldr (equal as 'as)))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-limsplit-cutoff-bldr
+            (%autoinduct clause.aux-limsplit-cutoff-bldr)
+            (%restrict default clause.aux-limsplit-cutoff-bldr (equal as 'as)))
+
+(%autoprove lemma-for-forcing-logic.conclusion-of-clause.aux-limsplit-cutoff-bldr
+            (%cdr-induction a)
+            (%forcingp nil))
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-limsplit-cutoff-bldr
+            (%autoinduct clause.aux-limsplit-cutoff-bldr)
+            (%restrict default clause.aux-limsplit-cutoff-bldr (equal as 'as))
+            (%enable default lemma-for-forcing-logic.conclusion-of-clause.aux-limsplit-cutoff-bldr)
+            (%disable default ;; these seem to be causing loops
+                      forcing-logic.vlhs-of-logic.disjoin-formulas-free
+                      forcing-logic.vrhs-of-logic.disjoin-formulas-free)
+            (%auto :strategy (cleanup split urewrite crewrite dist)) ;; suppress elim
+            (%enable default ;; that's weird.  i seem to need them now.
+                     forcing-logic.vlhs-of-logic.disjoin-formulas-free
+                     forcing-logic.vrhs-of-logic.disjoin-formulas-free))
+
+(%autoprove forcing-logic.proofp-of-clause.aux-limsplit-cutoff-bldr
+            (%autoinduct clause.aux-limsplit-cutoff-bldr)
+            (%restrict default clause.aux-limsplit-cutoff-bldr (equal as 'as)))
+
+
+
+
+(%autoadmit clause.limsplit-cutoff-bldr)
+
+(%autoprove forcing-logic.appealp-of-clause.limsplit-cutoff-bldr
+            (%enable default
+                     clause.limsplit-cutoff-bldr
+                     build.rev-disjunction))
+
+(%autoprove forcing-logic.conclusion-of-clause.limsplit-cutoff-bldr
+            (%enable default
+                     clause.limsplit-cutoff-bldr
+                     build.rev-disjunction))
+
+(%autoprove forcing-logic.proofp-of-clause.limsplit-cutoff-bldr
+            (%enable default
+                     clause.limsplit-cutoff-bldr
+                     build.rev-disjunction))
+
+
+
+
+(%autoadmit clause.aux-split-goal)
+
+(%autoprove clause.aux-split-goal-when-not-consp-of-todo
+            (%enable default clause.aux-split-goal))
+
+
+
+(%autoadmit clause.limsplit-cutoff-bldr-nice)
+
+(%autoprove forcing-logic.appealp-of-clause.limsplit-cutoff-bldr-nice
+            (%enable default clause.limsplit-cutoff-bldr-nice))
+
+(%autoprove forcing-logic.conclusion-of-clause.limsplit-cutoff-bldr-nice
+            (%enable default
+                     clause.limsplit-cutoff-bldr-nice
+                     clause.aux-split-goal))
+
+(%autoprove forcing-logic.proofp-of-clause.limsplit-cutoff-bldr-nice
+            (%enable default clause.limsplit-cutoff-bldr-nice))
+
+
+
+
+
+
+(%autoadmit clause.limsplit-cutoff-bldr-nice-okp)
+
+(%autoadmit clause.limsplit-cutoff-bldr-nice-high)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 clause.limsplit-cutoff-bldr-nice-okp
+                 clause.limsplit-cutoff-bldr-nice-high))
+
+ (%autoprove booleanp-of-clause.limsplit-cutoff-bldr-nice-okp)
+
+ (%autoprove clause.limsplit-cutoff-bldr-nice-okp-of-logic.appeal-identity)
+
+ (%autoprove lemma-1-for-soundness-of-clause.limsplit-cutoff-bldr-nice-okp)
+
+ (%autoprove lemma-2-for-soundness-of-clause.limsplit-cutoff-bldr-nice-okp)
+
+ (%autoprove forcing-soundness-of-clause.limsplit-cutoff-bldr-nice-okp
+             (%enable default
+                      lemma-1-for-soundness-of-clause.limsplit-cutoff-bldr-nice-okp
+                      lemma-2-for-soundness-of-clause.limsplit-cutoff-bldr-nice-okp)
+             (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                              (x (clause.limsplit-cutoff-bldr-nice (first (logic.extras x))
+                                                                   (second (logic.extras x))
+                                                                   (logic.provable-witness (logic.conclusion (first (logic.subproofs x)))
+                                                                                           axioms thms atbl)))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/aux-split-misc.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/aux-split-misc.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/aux-split-misc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/aux-split-misc.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,44 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+(local (%max-proof-size 700000000))
+
+(%defderiv clause.aux-split-double-negate-lemma1-bldr)
+(%defderiv clause.aux-split-double-negate-lemma2-bldr)
+(%defderiv clause.aux-split-default-1-bldr)
+(%defderiv clause.aux-split-default-2-bldr)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/aux-split-negative.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/aux-split-negative.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/aux-split-negative.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/aux-split-negative.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+(local (%max-proof-size 1200000000))
+
+(%deftheorem clause.theorem-aux-split-negative)
+(%defderiv clause.aux-split-negative-bldr)
+(%defderiv clause.disjoined-aux-split-negative-bldr)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/aux-split-positive.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/aux-split-positive.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/aux-split-positive.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/aux-split-positive.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+(local (%max-proof-size 2200000000))
+
+(%deftheorem clause.theorem-aux-split-positive)
+(%defderiv clause.aux-split-positive-bldr)
+(%defderiv clause.disjoined-aux-split-positive-bldr :omit-okp t)
+(%defderiv clause.aux-split-positive-1-bldr)
+(%defderiv clause.aux-split-positive-2-bldr)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/casesplit.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/casesplit.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/casesplit.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/casesplit.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,44 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+(%deftheorem clause.cases-lemma)
+(%defderiv clause.cases-lemma1-bldr)
+(%defderiv clause.disjoined-cases-lemma1-bldr)
+;; build.lhs-commute-or-then-rassoc was added in level 1.
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/ccsteps.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/ccsteps.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/ccsteps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/ccsteps.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,42 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+(%defderiv rw.ccstep-lemma-1)
+(%defderiv rw.ccstep-lemma-2)
+(%defderiv rw.ccstep-lemma-3)
+(%defderiv rw.ccstep-lemma-4)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level4/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/cert.image	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1 @@
+level4-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/clause-basics.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/clause-basics.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/clause-basics.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/clause-basics.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,201 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list")
+(%interactive)
+
+(local (%enable default
+                bust-up-logic.function-args-expensive
+                bust-up-cdr-of-logic.function-args-expensive
+                bust-up-cdr-of-cdr-of-logic.function-args-expensive))
+
+(%autoadmit clause.clause-formula)
+
+(%autoprove redefinition-of-clause.clause-formula
+            (%cdr-induction x)
+            (%restrict default clause.clause-formula (equal x 'x))
+            (%forcingp nil))
+
+(%autoadmit clause.clause-list-formulas)
+
+(%autoprove redefinition-of-clause.clause-list-formulas
+            (%cdr-induction x)
+            (%restrict default clause.clause-list-formulas (equal x 'x)))
+
+(%autoadmit clause.negative-termp)
+
+(%autoprove booleanp-of-clause.negative-termp
+            (%enable default clause.negative-termp)
+            (%forcingp nil))
+
+(%autoprove clause.negative-termp-of-logic.function-of-not
+            (%enable default clause.negative-termp)
+            (%forcingp nil))
+
+(%autoprove logic.functionp-when-clause.negative-termp
+            (%enable default clause.negative-termp))
+
+(%enable expensive-term/formula-inference
+         logic.functionp-when-clause.negative-termp)
+
+
+
+(%autoadmit clause.negative-term-guts)
+
+(%autoprove forcing-logic.termp-of-clause.negative-term-guts
+            (%enable default clause.negative-termp clause.negative-term-guts))
+
+(%autoprove forcing-logic.term-atblp-of-clause.negative-term-guts
+            (%enable default clause.negative-termp clause.negative-term-guts))
+
+(%autoprove clause.negative-term-guts-of-logic.function-of-not
+            (%enable default clause.negative-term-guts))
+
+(%autoprove rank-of-clause.negative-term-guts-when-clause.negative-termp
+            (%enable default
+                     clause.negative-term-guts
+                     clause.negative-termp
+                     logic.function-args))
+
+(%autoprove rank-of-clause.negative-term-guts-of-clause.negative-term-guts
+            (%disable default rank-of-clause.negative-term-guts-when-clause.negative-termp)
+            (%use (%instance (%thm rank-of-clause.negative-term-guts-when-clause.negative-termp)
+                             (x (clause.negative-term-guts x))))
+            (%use (%instance (%thm rank-of-clause.negative-term-guts-when-clause.negative-termp))))
+
+
+
+(%autoadmit clause.term-guts)
+
+(%autoprove forcing-logic.termp-of-clause.term-guts
+            (%enable default clause.term-guts))
+
+(%autoprove forcing-logic.term-atblp-of-clause.term-guts
+            (%enable default clause.term-guts))
+
+
+
+(%defprojection :list (clause.term-list-guts x)
+                :element (clause.term-guts x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.term-listp-of-clause.term-list-guts
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.term-list-guts
+            (%cdr-induction x))
+
+
+
+(%autoadmit definition-of-not)
+(%noexec definition-of-not)
+
+(%defderiv clause.substitute-iff-into-literal-bldr)
+
+(encapsulate
+ ()
+ ;; previously 1.7 BN
+ (local (%max-proof-size 1000000000))
+ (%defderiv clause.disjoined-substitute-iff-into-literal-bldr))
+
+
+(%deftheorem clause.theorem-standardize-equal-x-nil)
+(%deftheorem clause.theorem-standardize-equal-nil-x)
+(%deftheorem clause.theorem-standardize-iff-x-nil)
+(%deftheorem clause.theorem-standardize-iff-nil-x)
+
+
+(defsection clause.standardize-negative-term-bldr
+  (%autoadmit clause.standardize-negative-term-bldr)
+  (local (%enable default
+                  clause.standardize-negative-term-bldr
+                  clause.negative-termp
+                  clause.negative-term-guts
+                  definition-of-not
+                  clause.theorem-standardize-equal-nil-x
+                  clause.theorem-standardize-equal-x-nil
+                  clause.theorem-standardize-iff-nil-x
+                  clause.theorem-standardize-iff-x-nil))
+  (%autoprove forcing-logic.appealp-of-clause.standardize-negative-term-bldr)
+  (%autoprove forcing-logic.conclusion-of-clause.standardize-negative-term-bldr)
+  (%autoprove forcing-logic.proofp-of-clause.standardize-negative-term-bldr))
+
+(defsection clause.standardize-negative-term-bldr-okp
+  (%autoadmit clause.standardize-negative-term-bldr-okp)
+  (local (%enable default clause.standardize-negative-term-bldr-okp))
+  (%autoprove booleanp-of-clause.standardize-negative-term-bldr-okp)
+  (%autoprove clause.standardize-negative-term-bldr-okp-of-logic.appeal-identity)
+  (%autoprove lemma-1-for-soundness-of-clause.standardize-negative-term-bldr-okp)
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+  (%autoprove lemma-2-for-soundness-of-clause.standardize-negative-term-bldr-okp)
+  (%autoprove forcing-soundness-of-clause.standardize-negative-term-bldr-okp
+              (%enable default
+                       lemma-1-for-soundness-of-clause.standardize-negative-term-bldr-okp
+                       lemma-2-for-soundness-of-clause.standardize-negative-term-bldr-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (clause.standardize-negative-term-bldr (logic.=lhs (logic.conclusion x))))))))
+
+(defsection clause.standardize-double-negative-term-bldr
+  (%autoadmit clause.standardize-double-negative-term-bldr)
+  (local (%enable default clause.standardize-double-negative-term-bldr))
+  (%autoprove forcing-logic.appealp-of-clause.standardize-double-negative-term-bldr)
+  (%autoprove forcing-logic.conclusion-of-clause.standardize-double-negative-term-bldr)
+  (%autoprove forcing-logic.proofp-of-clause.standardize-double-negative-term-bldr))
+
+(defsection clause.standardize-double-negative-term-bldr-okp
+  (%autoadmit clause.standardize-double-negative-term-bldr-okp)
+  (local (%enable default clause.standardize-double-negative-term-bldr-okp))
+  (%autoprove booleanp-of-clause.standardize-double-negative-term-bldr-okp)
+  (%autoprove clause.standardize-double-negative-term-bldr-okp-of-logic.appeal-identity)
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+  (%autoprove lemma-1-for-soundness-of-clause.standardize-double-negative-term-bldr-okp)
+  (%autoprove lemma-2-for-soundness-of-clause.standardize-double-negative-term-bldr-okp)
+  (%autoprove forcing-soundness-of-clause.standardize-double-negative-term-bldr-okp
+              (%enable default
+                       lemma-1-for-soundness-of-clause.standardize-double-negative-term-bldr-okp
+                       lemma-2-for-soundness-of-clause.standardize-double-negative-term-bldr-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (clause.standardize-double-negative-term-bldr (logic.=lhs (logic.conclusion x))))))))
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/clause-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/clause-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/clause-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/clause-compiler.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,179 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formula-compiler")
+(include-book "clause-basics")
+(%interactive)
+
+
+(%autoadmit clause.make-clause-from-arbitrary-formula)
+
+(%autoprove consp-of-clause.make-clause-from-arbitrary-formula
+            (%enable default clause.make-clause-from-arbitrary-formula))
+
+(%autoprove forcing-logic.term-listp-of-clause.make-clause-from-arbitrary-formula
+            (%enable default clause.make-clause-from-arbitrary-formula))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.make-clause-from-arbitrary-formula
+            (%enable default clause.make-clause-from-arbitrary-formula))
+
+(%autoadmit clause.prove-arbitrary-formula-from-its-clause)
+
+(encapsulate
+ ()
+ (local (%enable default
+                clause.prove-arbitrary-formula-from-its-clause
+                clause.make-clause-from-arbitrary-formula
+                logic.term-formula))
+ (%autoprove forcing-logic.appealp-of-clause.prove-arbitrary-formula-from-its-clause)
+ (%autoprove forcing-logic.conclusion-of-clause.prove-arbitrary-formula-from-its-clause)
+ (%autoprove forcing-logic.proofp-of-clause.prove-arbitrary-formula-from-its-clause))
+
+
+
+(%defprojection :list (clause.make-clauses-from-arbitrary-formulas x)
+                :element (clause.make-clause-from-arbitrary-formula x)
+                :nil-preservingp nil)
+
+(%autoprove consp-listp-of-clause.make-clauses-from-arbitrary-formulas
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-listp-of-clause.make-clauses-from-arbitrary-formulas
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-clause.make-clauses-from-arbitrary-formulas
+            (%cdr-induction x))
+
+
+(%autoadmit clause.prove-arbitrary-formulas-from-their-clauses)
+
+(%autoprove forcing-logic.appeal-listp-of-clause.prove-arbitrary-formulas-from-their-clauses
+            (%autoinduct clause.prove-arbitrary-formulas-from-their-clauses)
+            (%restrict default clause.prove-arbitrary-formulas-from-their-clauses
+                       (equal fs 'fs)))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.prove-arbitrary-formulas-from-their-clauses
+            (%autoinduct clause.prove-arbitrary-formulas-from-their-clauses)
+            (%restrict default clause.prove-arbitrary-formulas-from-their-clauses
+                       (equal fs 'fs)))
+
+(%autoprove forcing-logic.proofp-of-clause.prove-arbitrary-formulas-from-their-clauses
+            (%autoinduct clause.prove-arbitrary-formulas-from-their-clauses)
+            (%restrict default clause.prove-arbitrary-formulas-from-their-clauses
+                       (equal fs 'fs)))
+
+
+
+
+(%autoadmit clause.prove-arbitrary-formula-from-its-clause-okp)
+
+(%autoadmit clause.prove-arbitrary-formula-from-its-clause-high)
+(%autoprove clause.prove-arbitrary-formula-from-its-clause-okp-of-clause.prove-arbitrary-formula-from-its-clause-high
+            (%enable default clause.prove-arbitrary-formula-from-its-clause-okp
+                     clause.prove-arbitrary-formula-from-its-clause-high))
+
+
+(%autoprove hack-for-compile-formula-okp-1
+            (%autoinduct logic.compile-formula f)
+            (%restrict default logic.compile-formula (equal x 'f))
+
+            (%disable default
+                      FORCING-LOGIC.FORMULA-ATBLP-OF-LOGIC.VRHS
+                      FORCING-LOGIC.FORMULA-ATBLP-OF-LOGIC.VLHS
+                      FORCING-LOGIC.FORMULA-ATBLP-OF-LOGIC.~ARG
+                      FORCING-LOGIC.TERM-ATBLP-OF-LOGIC.=RHS
+                      FORCING-LOGIC.TERM-ATBLP-OF-LOGIC.=LHS
+                      FORCING-LOGIC.TERM-ATBLP-OF-LOGIC.FUNCTION
+                      FORCING-LOGIC.TERM-ATBLP-OF-LOGIC.COMPILE-FORMULA)
+
+            (%restrict default logic.formula-atblp (equal x 'f))
+
+            (%restrict default definition-of-logic.term-atblp
+                       (or (equal x '(LOGIC.FUNCTION 'IF
+                                                     (CONS (LOGIC.COMPILE-FORMULA (LOGIC.~ARG F))
+                                                           '('NIL 'T))))
+                           (equal x '(LOGIC.FUNCTION 'EQUAL
+                                                     (CONS (LOGIC.=LHS F)
+                                                           (CONS (LOGIC.=RHS F) 'nil))))
+                           (equal x '(LOGIC.FUNCTION 'IF
+                                                     (CONS (LOGIC.COMPILE-FORMULA (LOGIC.VLHS F))
+                                                           (CONS ''T
+                                                                 (CONS (LOGIC.COMPILE-FORMULA (LOGIC.VRHS F))
+                                                                       'NIL)))))))
+
+            (%forcingp nil))
+
+(%autoprove hack-for-compile-formula-okp-2
+            (%enable default
+                     clause.make-clause-from-arbitrary-formula
+                     clause.prove-arbitrary-formula-from-its-clause-okp
+                     logic.term-formula)
+            (%disable default
+                      logic.formula-atblp-when-logic.provablep
+                      logic.formula-list-atblp-of-when-logic.provable-listp)
+            (%forcingp nil)
+            (%use (%instance (%thm logic.formula-atblp-when-logic.provablep)
+                             (x (logic.conclusion (car (logic.subproofs x))))))
+            (%use (%instance (%thm hack-for-compile-formula-okp-1)
+                             (f (logic.conclusion x))))
+            (%auto)
+            (%fertilize (logic.compile-formula (logic.conclusion x))
+                        (logic.=lhs
+                         (logic.~arg (logic.conclusion (car (logic.subproofs x)))))))
+
+(encapsulate
+ ()
+ (local (%enable default clause.prove-arbitrary-formula-from-its-clause-okp))
+
+ (%autoprove booleanp-of-clause.prove-arbitrary-formula-from-its-clause-okp)
+ (%autoprove clause.prove-arbitrary-formula-from-its-clause-okp-of-logic.appeal-identity)
+
+ (%autoprove lemma-1-for-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp)
+
+ (%autoprove lemma-2-for-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp
+             (%enable default hack-for-compile-formula-okp-2))
+
+ (%autoprove forcing-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp
+             (%enable default
+                      lemma-1-for-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp
+                      lemma-2-for-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp)
+             (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                              (x (clause.prove-arbitrary-formula-from-its-clause
+                                  (logic.conclusion x)
+                                  (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                                          axioms thms atbl)))))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../clauses/compiler")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/clean-clauses.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/clean-clauses.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/clean-clauses.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/clean-clauses.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,137 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+(local (%enable default
+                bust-up-logic.function-args-expensive
+                bust-up-cdr-of-logic.function-args-expensive
+                bust-up-cdr-of-cdr-of-logic.function-args-expensive))
+
+(defsection clause.obvious-termp
+  (%autoadmit clause.obvious-termp)
+  (%autoprove booleanp-of-clause.obvious-termp
+              (%enable default clause.obvious-termp)))
+
+(defsection clause.obvious-term-bldr
+  (%autoadmit clause.obvious-term-bldr)
+  (local (%enable default
+                  clause.obvious-term-bldr
+                  clause.obvious-termp
+                  clause.negative-termp
+                  clause.negative-term-guts
+                  logic.term-formula
+                  theorem-if-redux-nil
+                  definition-of-not))
+  (%autoprove clause.obvious-term-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-clause.obvious-term-bldr)
+  (%autoprove forcing-logic.conclusion-of-clause.obvious-term-bldr)
+  (%autoprove forcing-logic.proofp-of-clause.obvious-term-bldr
+              (%disable default forcing-lookup-of-logic.function-name-free)))
+
+(defsection clause.find-obvious-term
+  (%autoadmit clause.find-obvious-term)
+  (%autoprove clause.find-obvious-term-when-not-consp
+              (%restrict default clause.find-obvious-term (equal x 'x)))
+  (%autoprove clause.find-obvious-term-of-cons
+              (%restrict default clause.find-obvious-term (equal x '(cons a x))))
+  (%autoprove clause.find-obvious-term-of-list-fix
+              (%cdr-induction x))
+  (%autoprove clause.find-obvious-term-of-app
+              (%cdr-induction x))
+  (%autoprove clause.find-obvious-term-of-rev-under-iff
+              (%cdr-induction x))
+  (%autoprove forcing-memberp-of-clause.find-obvious-term
+              (%cdr-induction x))
+  (%autoprove logic.termp-of-clause.find-obvious-term
+              (%cdr-induction x))
+  (%autoprove clause.obvious-termp-of-clause.find-obvious-term
+              (%cdr-induction x)))
+
+(defsection clause.remove-obvious-clauses
+  (%autoadmit clause.remove-obvious-clauses)
+  (%autoprove clause.remove-obvious-clauses-when-not-consp
+              (%restrict default clause.remove-obvious-clauses (equal x 'x)))
+  (%autoprove clause.remove-obvious-clauses-of-cons
+              (%restrict default clause.remove-obvious-clauses (equal x '(cons a x))))
+  (%autoprove true-listp-of-clause.remove-obvious-clauses
+              (%cdr-induction x))
+  (%autoprove clause.remove-obvious-clauses-of-list-fix
+              (%cdr-induction x))
+  (%autoprove clause.remove-obvious-clauses-of-app
+              (%cdr-induction x))
+  (%autoprove rev-of-clause.remove-obvious-clauses
+              (%cdr-induction x))
+  (%autoprove clause.remove-obvious-clauses-of-rev)
+  (%autoprove subsetp-of-clause.remove-obvious-clauses
+              (%cdr-induction x))
+  (%autoprove forcing-logic.term-list-listp-of-clause.remove-obvious-clauses
+              (%cdr-induction x))
+  (%autoprove forcing-logic.term-list-list-atblp-of-clause.remove-obvious-clauses
+              (%cdr-induction x))
+  (%autoprove cons-listp-of-clause.remove-obvious-clauses
+              (%cdr-induction x))
+  (%autoprove all-superset-of-somep-of-clause.remove-obvious-clauses
+              (%cdr-induction x)))
+
+(defsection clause.remove-obvious-clauses-bldr
+  (%autoadmit clause.remove-obvious-clauses-bldr)
+  (local (%restrict default clause.remove-obvious-clauses-bldr (equal x 'x)))
+  (%autoprove forcing-logic.appeal-listp-of-clause.remove-obvious-clauses-bldr
+              (%autoinduct clause.remove-obvious-clauses-bldr))
+  (%autoprove forcing-logic.strip-conclusions-of-clause.remove-obvious-clauses-bldr
+              (%autoinduct clause.remove-obvious-clauses-bldr))
+  (%autoprove forcing-logic.proof-listp-of-clause.remove-obvious-clauses-bldr
+              (%autoinduct clause.remove-obvious-clauses-bldr)))
+
+(defsection clause.obvious-term-bldr-okp
+  (%autoadmit clause.obvious-term-bldr-okp)
+  (local (%enable default clause.obvious-term-bldr-okp logic.term-formula))
+  (%autoprove booleanp-of-clause.obvious-term-bldr-okp)
+  (%autoprove clause.obvious-term-bldr-okp-of-logic.appeal-identity)
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+  (%autoprove lemma-1-for-soundness-of-clause.obvious-term-bldr-okp)
+  (%autoprove lemma-2-for-soundness-of-clause.obvious-term-bldr-okp)
+  (%autoprove forcing-soundness-of-clause.obvious-term-bldr-okp
+              (%use (%instance (%thm lemma-1-for-soundness-of-clause.obvious-term-bldr-okp)))
+              (%use (%instance (%thm lemma-2-for-soundness-of-clause.obvious-term-bldr-okp)))
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (clause.obvious-term-bldr (logic.=lhs (logic.~arg (logic.conclusion x)))))))
+              (%forcingp nil)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/crewrite-rule.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/crewrite-rule.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/crewrite-rule.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/crewrite-rule.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,260 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(include-book "rulep")
+(%interactive)
+
+
+(defthm LOGIC.PEQUAL-LIST-OF-CONS-AND-CONS-gross-right
+  (implies (syntaxp (logic.constantp y))
+           (equal (logic.pequal-list (cons a x) y)
+                  (if (consp y)
+                      (CONS (LOGIC.PEQUAL a (CAR Y))
+                            (LOGIC.PEQUAL-LIST x (CDR Y)))
+                    nil)))
+  :hints(("Goal" :expand (logic.pequal-list (cons a x) y))))
+
+(%autoprove LOGIC.PEQUAL-LIST-OF-CONS-AND-CONS-gross-right)
+
+;(local (%disable default LOGIC.FUNCTION-OF-CONS-WITH-DEFECTIVELY-MERGED-CONSTANT))
+
+
+
+(%deftheorem rw.crewrite-rule-lemma)
+
+(encapsulate
+ ()
+ (local (%enable default bust-up-cdr-of-logic.function-args-expensive))
+ (%defderiv rw.crewrite-rule-lemma-bldr)
+ (%defderiv rw.disjoined-crewrite-rule-lemma-bldr))
+
+(defsection rw.crewrite-rule-lemma-list-bldr
+  (%autoadmit rw.crewrite-rule-lemma-list-bldr)
+  (%autoprove forcing-logic.appeal-listp-of-rw.crewrite-rule-lemma-list-bldr
+              (%cdr-induction x)
+              (%restrict default rw.crewrite-rule-lemma-list-bldr (equal x 'x)))
+  (%autoprove forcing-logic.strip-conclusions-of-rw.crewrite-rule-lemma-list-bldr
+              (%cdr-induction x)
+              (%restrict default rw.crewrite-rule-lemma-list-bldr (equal x 'x))
+              (%enable default logic.negate-term)
+              (%disable default
+                        formula-decomposition
+                        expensive-term/formula-inference))
+  (%autoprove forcing-logic.proof-listp-of-rw.crewrite-rule-lemma-list-bldr
+              (%cdr-induction x)
+              (%restrict default rw.crewrite-rule-lemma-list-bldr (equal x 'x))))
+
+(defsection rw.disjoined-crewrite-rule-lemma-list-bldr
+  (%autoadmit rw.disjoined-crewrite-rule-lemma-list-bldr)
+  (%autoprove forcing-logic.appeal-listp-of-rw.disjoined-crewrite-rule-lemma-list-bldr
+              (%cdr-induction x)
+              (%restrict default rw.disjoined-crewrite-rule-lemma-list-bldr (equal x 'x)))
+  (%autoprove forcing-logic.strip-conclusions-of-rw.disjoined-crewrite-rule-lemma-list-bldr
+              (%cdr-induction x)
+              (%restrict default rw.disjoined-crewrite-rule-lemma-list-bldr (equal x 'x))
+              (%enable default logic.negate-term))
+  (%autoprove forcing-logic.proof-listp-of-rw.disjoined-crewrite-rule-lemma-list-bldr
+              (%cdr-induction x)
+              (%restrict default rw.disjoined-crewrite-rule-lemma-list-bldr (equal x 'x))))
+
+
+
+
+(defsection rw.compile-crewrite-rule-trace-lemma1
+
+  (defthmd lemma-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1
+    ;; BOZO unlocalize in ACL2 model
+    (implies (and (logic.all-negationsp a)
+                  (logic.all-negationsp c)
+                  (force (equal (len a) (len c))) ;; not always true, we force anyway
+                  (force (equal (len b) (len d))) ;; not always true, we force anyway
+                  (force (logic.formula-listp a))
+                  (force (logic.formula-listp b))
+                  (force (logic.formula-listp c))
+                  (force (logic.formula-listp d)))
+             (equal (equal (logic.disjoin-formulas (app a b))
+                           (logic.disjoin-formulas (app c d)))
+                    (and (equal (list-fix a) (list-fix c))
+                         (equal (list-fix b) (list-fix d))))))
+
+  (defthmd lemma2-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1
+    ;; BOZO unlocalize in ACL2 model
+    (implies (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                    (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+             (equal (len proofs)
+                    (len (rw.rule->hyps rule))))
+    :hints(("Goal"
+            :in-theory (disable len-of-strip-firsts len-of-logic.substitute-list)
+            :use ((:instance len-of-strip-firsts
+                             (x (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                  (:instance len-of-logic.substitute-list
+                             (x (rw.hyp-list-terms (rw.rule->hyps rule))))))))
+
+  (%autoadmit rw.compile-crewrite-rule-trace-lemma1)
+  (local (%enable default
+                  rw.compile-crewrite-rule-trace-lemma1
+                  rw.rule-clause
+                  redefinition-of-logic.term-list-formulas))
+
+  (%autoprove lemma-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1)
+
+  (%autoprove lemma2-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1
+              (%disable default
+                        len-of-strip-firsts
+                        len-of-logic.substitute-list
+                        [outside]len-of-strip-firsts
+                        [outside]len-of-logic.substitute-list)
+              (%use (%instance (%thm len-of-strip-firsts)
+                               (x (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs))))))
+              (%use (%instance (%thm len-of-logic.substitute-list)
+                               (x (rw.hyp-list-terms (rw.rule->hyps rule))))))
+  (local (%enable default
+                  lemma-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1
+                  lemma2-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1))
+  ;; Speed hack
+  (local (%disable default
+                   consp-when-memberp-of-logic.sigmap
+                   consp-when-memberp-of-logic.sigma-atblp
+                   all-equalp-of-subsetp-when-all-equalp))
+  (%autoprove logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1)
+  (%autoprove logic.conclusion-of-rw.compile-crewrite-rule-trace-lemma1)
+  (%autoprove logic.proofp-of-rw.compile-crewrite-rule-trace-lemma1
+              (%enable default rw.rule-env-okp)))
+
+
+(defsection rw.compile-crewrite-rule-trace-lemma2
+
+  (defthmd lemma-2-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma2
+    ;; BOZO unlocalize.  We use lemma-1 from lemma1.
+    (implies (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                    (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+             (equal (len proofs)
+                    (len (rw.rule->hyps rule))))
+    :hints(("Goal"
+            :in-theory (disable len-of-strip-firsts len-of-logic.substitute-list)
+            :use ((:instance len-of-strip-firsts
+                             (x (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                  (:instance len-of-logic.substitute-list
+                             (x (rw.hyp-list-terms (rw.rule->hyps rule))))))))
+
+  (%autoadmit rw.compile-crewrite-rule-trace-lemma2)
+
+  (local (%enable default
+                  rw.compile-crewrite-rule-trace-lemma2
+                  rw.rule-clause
+                  redefinition-of-logic.term-list-formulas))
+
+  (%autoprove lemma-2-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma2
+              (%disable default
+                        len-of-strip-firsts
+                        len-of-logic.substitute-list
+                        [outside]len-of-strip-firsts
+                        [outside]len-of-logic.substitute-list)
+              (%use (%instance (%thm len-of-strip-firsts)
+                               (x (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))))
+              (%use (%instance (%thm len-of-logic.substitute-list)
+                               (x (rw.hyp-list-terms (rw.rule->hyps rule))))))
+
+  (local (%enable default
+                  lemma-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1
+                  lemma-2-for-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma2))
+
+  (local (%disable default
+                   consp-when-memberp-of-logic.sigmap
+                   consp-when-memberp-of-logic.sigma-atblp
+                   all-equalp-of-subsetp-when-all-equalp))
+
+  (%autoprove forcing-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma2)
+  (%autoprove forcing-logic.conclusion-of-rw.compile-crewrite-rule-trace-lemma2)
+  (%autoprove forcing-logic.proofp-of-rw.compile-crewrite-rule-trace-lemma2
+              (%enable default rw.rule-env-okp)))
+
+
+
+(defsection rw.compile-crewrite-rule-trace-lemma1-okp
+  (%autoadmit rw.compile-crewrite-rule-trace-lemma1-okp)
+  (%autoprove booleanp-of-rw.compile-crewrite-rule-trace-lemma1-okp
+              (%enable default rw.compile-crewrite-rule-trace-lemma1-okp))
+  (%autoprove rw.compile-crewrite-rule-trace-lemma1-okp-of-logic.appeal-identity
+              (%enable default rw.compile-crewrite-rule-trace-lemma1-okp))
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+  (%autoprove lemma-1-for-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp
+              (%enable default rw.compile-crewrite-rule-trace-lemma1-okp))
+  (%autoprove lemma-2-for-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp
+              (%enable default rw.compile-crewrite-rule-trace-lemma1-okp))
+  (%autoprove forcing-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp
+              (%enable default
+                       lemma-1-for-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp
+                       lemma-2-for-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (rw.compile-crewrite-rule-trace-lemma1 (first (logic.extras x))
+                                                                         (second (logic.extras x))
+                                                                         (logic.provable-list-witness
+                                                                          (logic.strip-conclusions (logic.subproofs x))
+                                                                          axioms thms atbl)))))
+              (%auto :strategy (cleanup split crewrite))
+              (%enable default rw.compile-crewrite-rule-trace-lemma1-okp)
+              (%auto :strategy (cleanup split crewrite))))
+
+
+(defsection rw.compile-crewrite-rule-trace-lemma2-okp
+  (%autoadmit rw.compile-crewrite-rule-trace-lemma2-okp)
+  (%autoprove booleanp-of-rw.compile-crewrite-rule-trace-lemma2-okp
+              (%enable default rw.compile-crewrite-rule-trace-lemma2-okp))
+  (%autoprove rw.compile-crewrite-rule-trace-lemma2-okp-of-logic.appeal-identity
+              (%enable default rw.compile-crewrite-rule-trace-lemma2-okp))
+  (%autoprove lemma-1-for-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp
+              (%enable default rw.compile-crewrite-rule-trace-lemma2-okp))
+  (%autoprove lemma-2-for-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp
+              (%enable default rw.compile-crewrite-rule-trace-lemma2-okp))
+  (%autoprove forcing-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp
+              (%enable default
+                       lemma-1-for-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp
+                       lemma-2-for-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (rw.compile-crewrite-rule-trace-lemma2 (first (logic.extras x))
+                                                                         (second (logic.extras x))
+                                                                         (third (logic.extras x))
+                                                                         (logic.provable-list-witness
+                                                                          (logic.strip-conclusions (logic.subproofs x))
+                                                                          axioms thms atbl)))))
+              (%auto :strategy (cleanup split crewrite))
+              (%enable default rw.compile-crewrite-rule-trace-lemma2-okp)
+              (%auto :strategy (cleanup split crewrite))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/equal-by-args.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/equal-by-args.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/equal-by-args.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/equal-by-args.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,215 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list")
+(%interactive)
+
+
+(%autoadmit build.pequal-from-equal-list)
+
+(%autoprove len-of-build.pequal-from-equal-list
+            (%cdr-induction x)
+            (%restrict default build.pequal-from-equal-list (equal x 'x)))
+
+(%autoprove forcing-logic.appeal-listp-of-build.pequal-from-equal-list
+            (%cdr-induction x)
+            (%restrict default build.pequal-from-equal-list (equal x 'x)))
+
+(%autoprove forcing-logic.strip-conclusions-of-build.pequal-from-equal-list
+            (%cdr-induction x)
+            (%restrict default build.pequal-from-equal-list (equal x 'x)))
+
+(%autoprove forcing-logic.proof-listp-of-build.pequal-from-equal-list
+            (%cdr-induction x)
+            (%restrict default build.pequal-from-equal-list (equal x 'x)))
+
+
+
+
+
+(%autoadmit build.disjoined-pequal-from-equal-list)
+
+(%autoprove len-of-build.disjoined-pequal-from-equal-list
+            (%cdr-induction x)
+            (%restrict default build.disjoined-pequal-from-equal-list (equal x 'x)))
+
+(%autoprove forcing-logic.appeal-listp-of-build.disjoined-pequal-from-equal-list
+            (%cdr-induction x)
+            (%restrict default build.disjoined-pequal-from-equal-list (equal x 'x)))
+
+(%autoprove forcing-logic.strip-conclusions-of-build.disjoined-pequal-from-equal-list
+            (%cdr-induction x)
+            (%restrict default build.disjoined-pequal-from-equal-list (equal x 'x)))
+
+(%autoprove forcing-logic.proof-listp-of-build.disjoined-pequal-from-equal-list
+            (%cdr-induction x)
+            (%restrict default build.disjoined-pequal-from-equal-list (equal x 'x)))
+
+
+
+
+(%autoadmit build.equal-by-args)
+
+(encapsulate
+ ()
+ (local (%enable default build.equal-by-args axiom-equal-when-same))
+ (%autoprove build.equal-by-args-under-iff)
+ (%autoprove forcing-logic.appealp-of-build.equal-by-args)
+ (%autoprove forcing-logic.conclusion-of-build.equal-by-args)
+ (%autoprove forcing-logic.proofp-of-build.equal-by-args))
+
+
+
+(%autoadmit build.disjoined-equal-by-args)
+
+(encapsulate
+ ()
+ (local (%enable default build.disjoined-equal-by-args axiom-equal-when-same))
+ (%autoprove build.disjoined-equal-by-args-under-iff)
+ (%autoprove forcing-logic.appealp-of-build.disjoined-equal-by-args)
+ (%autoprove forcing-logic.conclusion-of-build.disjoined-equal-by-args)
+ (%autoprove forcing-logic.proofp-of-build.disjoined-equal-by-args))
+
+
+
+
+(%autoadmit build.equal-by-args-aux-okp)
+
+(%autoprove build.equal-by-args-aux-okp-removal
+            (%autoinduct build.equal-by-args-aux-okp)
+            (%splitlimit 8)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default build.equal-by-args-aux-okp (equal proofs 'proofs)))
+
+(%autoadmit build.equal-by-args-okp)
+
+(%autoprove booleanp-of-build.equal-by-args-aux-okp
+            (%autoinduct build.equal-by-args-aux-okp)
+            (%splitlimit 8)
+            (%restrict default build.equal-by-args-aux-okp (equal proofs 'proofs)))
+
+(%autoprove booleanp-of-build.equal-by-args-okp
+            (%enable default build.equal-by-args-okp))
+
+(%autoprove build.equal-by-args-okp-of-logic.appeal-identity
+            (%enable default build.equal-by-args-okp))
+
+(%autoprove lemma-1-for-soundness-of-build.equal-by-args-okp
+            (%enable default build.equal-by-args-okp))
+
+(%autoprove lemma-2-for-soundness-of-build.equal-by-args-okp
+            (%enable default build.equal-by-args-okp))
+
+(%autoprove lemma-3-for-soundness-of-build.equal-by-args-okp
+            (%enable default build.equal-by-args-okp))
+
+(%autoprove forcing-soundness-of-build.equal-by-args-okp
+            (%enable default
+                     lemma-1-for-soundness-of-build.equal-by-args-okp
+                     lemma-2-for-soundness-of-build.equal-by-args-okp
+                     lemma-3-for-soundness-of-build.equal-by-args-okp)
+            (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                             (x (build.equal-by-args (logic.function-name (first (logic.function-args (logic.=lhs (logic.conclusion x)))))
+                                                     (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                                  axioms thms atbl))))))
+
+
+
+
+(%autoadmit build.disjoined-equal-by-args-aux-okp)
+
+(%autoprove build.disjoined-equal-by-args-aux-okp-removal
+            (%autoinduct build.disjoined-equal-by-args-aux-okp)
+            (%splitlimit 8)
+            (%disable default
+                      trichotomy-of-<
+                      antisymmetry-of-<
+                      not-equal-when-less
+                      not-equal-when-less-two
+                      logic.termp-when-logic.formulap
+                      logic.formulap-when-logic.termp
+                      same-length-prefixes-equal-cheap
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots)
+            (%disable default logic.vlhs-of-logic.conclusion-of-car-when-all-equalp)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default build.disjoined-equal-by-args-aux-okp (equal proofs 'proofs)))
+
+(%autoadmit build.disjoined-equal-by-args-okp)
+
+(%autoprove booleanp-of-build.disjoined-equal-by-args-aux-okp
+            (%autoinduct build.disjoined-equal-by-args-aux-okp)
+            (%splitlimit 8)
+            (%restrict default build.disjoined-equal-by-args-aux-okp (equal proofs 'proofs)))
+
+(%autoprove booleanp-of-build.disjoined-equal-by-args-okp
+            (%enable default build.disjoined-equal-by-args-okp))
+
+(%autoprove build.disjoined-equal-by-args-okp-of-logic.appeal-identity
+            (%enable default build.disjoined-equal-by-args-okp))
+
+(%autoprove lemma-1-for-soundness-of-build.disjoined-equal-by-args-okp
+            (%enable default build.disjoined-equal-by-args-okp)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots))
+
+(%autoprove lemma-2-for-soundness-of-build.disjoined-equal-by-args-okp
+            (%enable default build.disjoined-equal-by-args-okp)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots))
+
+(%autoprove lemma-3-for-soundness-of-build.disjoined-equal-by-args-okp
+            (%enable default build.disjoined-equal-by-args-okp)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots))
+
+(%autoprove forcing-soundness-of-build.disjoined-equal-by-args-okp
+            (%enable default
+                     lemma-1-for-soundness-of-build.disjoined-equal-by-args-okp
+                     lemma-2-for-soundness-of-build.disjoined-equal-by-args-okp
+                     lemma-3-for-soundness-of-build.disjoined-equal-by-args-okp)
+            (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                             (x (build.disjoined-equal-by-args
+                                 (logic.function-name (first (logic.function-args (logic.=lhs (logic.vrhs (logic.conclusion x))))))
+                                 (logic.vlhs (logic.conclusion x))
+                                 (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                              axioms thms atbl))))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/eval.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/eval.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/eval.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/eval.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,39 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%defderiv eval-lemma-1-bldr)
+(%defderiv eval-lemma-2-bldr)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/factor-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/factor-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/factor-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/factor-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,40 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%defderiv clause.factor-bldr-lemma-1)
+(%defderiv clause.factor-bldr-lemma-2)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/formula-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/formula-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/formula-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/formula-compiler.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,193 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+;; BOZO these don't go here -- need them for compile lemmas.
+;; but we apparently don't introduce them anywhere else?  should we be using
+;; other rules, perhaps?
+
+(%defderiv build.disjoined-if-when-nil)
+(%defderiv build.disjoined-if-when-not-nil)
+
+(%deftheorem theorem-if-when-same)
+(%defderiv build.disjoined-if-when-same)
+
+;; </BOZO>
+
+
+(%autoadmit logic.compile-formula)
+
+(%autoprove forcing-logic.termp-of-logic.compile-formula
+            (%autoinduct logic.compile-formula)
+            (%restrict default logic.compile-formula (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-logic.compile-formula
+            (%autoinduct logic.compile-formula)
+            (%restrict default logic.compile-formula (equal x 'x)))
+
+(%defderiv build.compile-formula-lemma-1)
+(%defderiv build.compile-formula-lemma-2)
+
+
+(%autoadmit build.compile-formula)
+
+;; BOZO unlocalize+rename in clauses/compile-formula
+(encapsulate
+ ()
+ (local (in-theory (acl2::current-theory 'build.compile-formula)))
+ (defthm lemma-for-forcing-logic.appealp-of-first-of-build.compile-formula
+   (implies (logic.formulap x)
+            (let ((result (logic.compile-formula x))
+                  (proofs (build.compile-formula x)))
+              (and (logic.appealp (first proofs))
+                   (logic.appealp (second proofs))
+                   (equal (logic.conclusion (first proofs)) (logic.por (logic.pnot x) (logic.pequal result ''t)))
+                   (equal (logic.conclusion (second proofs)) (logic.por x (logic.pequal result ''nil)))
+                   )))
+   :rule-classes nil
+   :hints(("Goal"
+           :induct (logic.compile-formula x)
+           :in-theory (enable logic.compile-formula
+                              build.compile-formula
+                              axiom-equal-when-same
+                              axiom-equal-when-diff)))))
+
+(%autoprove lemma-for-forcing-logic.appealp-of-first-of-build.compile-formula
+            (%autoinduct logic.compile-formula)
+            (%disable default
+                      type-set-like-rules
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two)
+            (%auto)
+            (%restrict default logic.compile-formula (equal x 'x))
+            (%restrict default build.compile-formula (equal a 'x))
+            (%enable default
+                     axiom-equal-when-same
+                     axiom-equal-when-diff)
+            (%auto)
+            (%enable default formula-decomposition))
+
+(%autoprove forcing-logic.appealp-of-first-of-build.compile-formula
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-first-of-build.compile-formula))))
+
+(%autoprove forcing-logic.appealp-of-second-of-build.compile-formula
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-first-of-build.compile-formula))))
+
+(%autoprove forcing-logic.conclusion-of-first-of-build.compile-formula
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-first-of-build.compile-formula))))
+
+(%autoprove forcing-logic.conclusion-of-second-of-build.compile-formula
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-first-of-build.compile-formula))))
+
+
+
+;; BOZO unlocalize+rename in clauses/compile-formula
+;; NOTE: need to add rule-classes nil, also
+(encapsulate
+ ()
+ (local (in-theory (acl2::current-theory 'forcing-logic.proofp-of-first-of-build.compile-formula)))
+ (defthm@ lemma-for-forcing-logic.proofp-of-first-of-build.compile-formula
+   (implies (and (logic.formulap x)
+                 (logic.formula-atblp x atbl)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'if atbl)) 3)
+                 (@obligations build.compile-formula))
+            (and (logic.proofp (first (build.compile-formula x)) axioms thms atbl)
+                 (logic.proofp (second (build.compile-formula x)) axioms thms atbl)))
+   :rule-classes nil
+   :hints(("Goal" :in-theory (enable build.compile-formula
+                                     logic.compile-formula
+                                     axiom-equal-when-same
+                                     axiom-equal-when-diff)))))
+
+(%autoprove lemma-for-forcing-logic.proofp-of-first-of-build.compile-formula
+            (%autoinduct logic.compile-formula)
+            (%disable default
+                      type-set-like-rules
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default logic.compile-formula (equal x 'x))
+            (%restrict default build.compile-formula (equal a 'x))
+            (%enable default
+                     axiom-equal-when-same
+                     axiom-equal-when-diff)
+            (%auto))
+
+(%autoprove forcing-logic.proofp-of-first-of-build.compile-formula
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-first-of-build.compile-formula))))
+
+(%autoprove forcing-logic.proofp-of-second-of-build.compile-formula
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-first-of-build.compile-formula))))
+
+
+(%defprojection
+  :list (logic.compile-formula-list x)
+  :element (logic.compile-formula x)
+  :nil-preservingp t)
+
+(%autoprove forcing-logic.term-listp-of-logic.compile-formula-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.compile-formula-list
+            (%cdr-induction x))
+
+
+
+(%autoadmit build.compile-formula-list-comm-2)
+
+(%autoprove len-of-build.compile-formula-list-comm-2
+            (%cdr-induction x)
+            (%restrict default build.compile-formula-list-comm-2 (equal x 'x)))
+
+(%autoprove logic.appeal-listp-of-build.compile-formula-list-comm-2
+            (%cdr-induction x)
+            (%restrict default build.compile-formula-list-comm-2 (equal x 'x)))
+
+(%autoprove logic.strip-conclusions-of-logic.compile-formula-list-bldr3
+            ;; BOZO misnamed
+            (%cdr-induction x)
+            (%restrict default build.compile-formula-list-comm-2 (equal x 'x)))
+
+(%autoprove logic.proof-listp-of-build.compile-formula-list-comm-2
+            (%cdr-induction x)
+            (%restrict default build.compile-formula-list-comm-2 (equal x 'x)))
+
+(%ensure-exactly-these-rules-are-missing "../../build/formula-compiler")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/level4.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/level4.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/level4.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/level4.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,199 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-limsplit-cutoff-bldr")
+(include-book "aux-split-positive")
+(include-book "aux-split-negative")
+(include-book "aux-split-misc")
+(include-book "casesplit")
+(include-book "ccsteps")
+(include-book "clause-basics")
+(include-book "clean-clauses")
+(include-book "crewrite-rule")
+(include-book "eval")
+(include-book "equal-by-args")
+(include-book "factor-bldr")
+(include-book "update-clause")
+(include-book "clause-compiler")
+(%interactive)
+
+
+(%autoadmit level4.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level4.step-okp))
+ (%autoprove soundness-of-level4.step-okp)
+ (%autoprove level4.step-okp-when-level3.step-okp
+             (%forcingp nil)
+             (%auto)
+             (%enable default level3.step-okp)
+             (%auto)
+             (%enable default level2.step-okp)
+             (%auto)
+             (%enable default logic.appeal-step-okp))
+ (%autoprove level4.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%disable default forcing-true-listp-of-logic.subproofs))
+ (%autoadmit level4.flag-proofp-aux))
+
+(%autoadmit level4.proofp-aux)
+(%autoadmit level4.proof-listp-aux)
+(%autoprove definition-of-level4.proofp-aux
+            (%enable default level4.proofp-aux level4.proof-listp-aux)
+            (%restrict default level4.flag-proofp-aux (equal x 'x)))
+(%autoprove definition-of-level4.proof-listp-aux
+            (%enable default level4.proofp-aux level4.proof-listp-aux)
+            (%restrict default level4.flag-proofp-aux (equal x 'x)))
+
+
+(%autoprove level4.proofp-aux-when-not-consp      (%restrict default definition-of-level4.proofp-aux (equal x 'x)))
+(%autoprove level4.proof-listp-aux-when-not-consp (%restrict default definition-of-level4.proof-listp-aux (equal x 'x)))
+(%autoprove level4.proof-listp-aux-of-cons        (%restrict default definition-of-level4.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level4.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level4.proofp-aux (equal x 'x)))
+
+(%autoprove booleanp-of-level4.proofp-aux      (%use (%instance (%thm lemma-for-booleanp-of-level4.proofp-aux) (flag 'proof))))
+(%autoprove booleanp-of-level4.proof-listp-aux (%use (%instance (%thm lemma-for-booleanp-of-level4.proofp-aux) (flag 'list))))
+
+
+(%deflist level4.proof-listp-aux (x axioms thms atbl)
+          (level4.proofp-aux x axioms thms atbl))
+
+(%autoprove lemma-for-logic.provablep-when-level4.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto :strategy (cleanup urewrite split))
+            (%restrict default definition-of-level4.proofp-aux (equal x 'x))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove logic.provablep-when-level4.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level4.proofp-aux) (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level4.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level4.proofp-aux) (flag 'list))))
+
+
+
+(%autoprove lemma-for-level4.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level4.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove level4.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level4.proofp-aux-when-logic.proofp) (flag 'proof))))
+
+(%autoprove level4.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level4.proofp-aux-when-logic.proofp) (flag 'list))))
+
+(%autoprove forcing-level4.proofp-aux-of-logic.provable-witness
+            (%enable default level4.proofp-aux-when-logic.proofp))
+
+
+
+(%autoadmit level4.proofp)
+(%autoprove booleanp-of-level4.proofp
+            (%enable default level4.proofp))
+(%autoprove logic.provablep-when-level4.proofp
+            (%enable default level4.proofp))
+
+
+(defsection level4-transition
+  (%install-new-proofp level4.proofp)
+  (%auto)
+  (%qed-install))
+
+
+(%switch-builder clause.substitute-iff-into-literal-bldr            clause.substitute-iff-into-literal-bldr-high)
+(%switch-builder clause.disjoined-substitute-iff-into-literal-bldr  clause.disjoined-substitute-iff-into-literal-bldr-high)
+(%switch-builder clause.standardize-negative-term-bldr              clause.standardize-negative-term-bldr-high)
+(%switch-builder clause.standardize-double-negative-term-bldr       clause.standardize-double-negative-term-bldr-high)
+
+(%switch-builder clause.aux-split-double-negate-lemma1-bldr         clause.aux-split-double-negate-lemma1-bldr-high)
+(%switch-builder clause.aux-split-double-negate-lemma2-bldr         clause.aux-split-double-negate-lemma2-bldr-high)
+(%switch-builder clause.aux-split-positive-bldr                     clause.aux-split-positive-bldr-high)
+(%switch-builder clause.aux-split-positive-1-bldr                   clause.aux-split-positive-1-bldr-high)
+(%switch-builder clause.aux-split-positive-2-bldr                   clause.aux-split-positive-2-bldr-high)
+(%switch-builder clause.aux-split-negative-bldr                     clause.aux-split-negative-bldr-high)
+(%switch-builder clause.disjoined-aux-split-negative-bldr           clause.disjoined-aux-split-negative-bldr-high)
+;(%switch-builder clause.aux-split-negative-1-bldr                   clause.aux-split-negative-1-bldr-high)
+;(%switch-builder clause.aux-split-negative-2-bldr                   clause.aux-split-negative-2-bldr-high)
+(%switch-builder clause.aux-split-default-1-bldr                    clause.aux-split-default-1-bldr-high)
+(%switch-builder clause.aux-split-default-2-bldr                    clause.aux-split-default-2-bldr-high)
+(%switch-builder clause.aux-limsplit-cutoff-bldr-nice               clause.aux-limsplit-cutoff-bldr-nice)
+
+(%switch-builder clause.casesplit-lemma1-bldr                       clause.casesplit-lemma1-bldr-high)
+(%switch-builder clause.disjoined-casesplit-lemma1-bldr             clause.disjoined-casesplit-lemma1-bldr-high)
+
+(%switch-builder clause.aux-update-clause-lemma1-bldr               clause.aux-update-clause-lemma1-bldr-high)
+(%switch-builder clause.aux-update-clause-lemma2-bldr               clause.aux-update-clause-lemma2-bldr-high)
+(%switch-builder clause.aux-update-clause-iff-lemma1-bldr           clause.aux-update-clause-iff-lemma1-bldr-high)
+(%switch-builder clause.aux-update-clause-iff-lemma2-bldr           clause.aux-update-clause-iff-lemma2-bldr-high)
+
+(%switch-builder rw.ccstep-lemma-1                                  rw.ccstep-lemma-1-high)
+(%switch-builder rw.ccstep-lemma-2                                  rw.ccstep-lemma-2-high)
+(%switch-builder rw.ccstep-lemma-3                                  rw.ccstep-lemma-3-high)
+(%switch-builder rw.ccstep-lemma-4                                  rw.ccstep-lemma-4-high)
+
+(%switch-builder clause.obvious-term-bldr                           clause.obvious-term-bldr-high)
+
+(%switch-builder eval-lemma-1-bldr                                  eval-lemma-1-bldr-high)
+(%switch-builder eval-lemma-2-bldr                                  eval-lemma-2-bldr-high)
+
+(%switch-builder rw.compile-crewrite-rule-trace-lemma1              rw.compile-crewrite-rule-trace-lemma1-high)
+(%switch-builder rw.compile-crewrite-rule-trace-lemma2              rw.compile-crewrite-rule-trace-lemma2-high)
+
+(%switch-builder clause.factor-bldr-lemma-1                         clause.factor-bldr-lemma-1-high)
+(%switch-builder clause.factor-bldr-lemma-2                         clause.factor-bldr-lemma-2-high)
+
+(%switch-builder build.equal-by-args                                build.equal-by-args-high)
+(%switch-builder build.disjoined-equal-by-args                      build.disjoined-equal-by-args-high)
+
+(%switch-builder clause.prove-arbitrary-formula-from-its-clause     clause.prove-arbitrary-formula-from-its-clause-high)
+
+(%finish "level4")
+(%save-events "level4.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level4/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/make-image.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level3/level3")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level4-symmetry"
+                 "Preloaded bootstrap/level3 directory.")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/pequal-list.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/pequal-list.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/pequal-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/pequal-list.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,64 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(defsection build.reflexivity-list
+  (%autoadmit build.reflexivity-list)
+  (local (%restrict default build.reflexivity-list (equal x 'x)))
+  (%autoprove forcing-logic.appeal-listp-of-build.reflexivity-list (%cdr-induction x))
+  (%autoprove forcing-logic.strip-conclusions-of-build.reflexivity-list (%cdr-induction x))
+  (%autoprove forcing-logic.proof-listp-of-build.reflexivity-list (%cdr-induction x)))
+
+;; There isn't really any reason to bother optimizing these; the
+;; modus-ponens-list steps get optimized in level 3 anyway so these will only
+;; be like two steps.
+
+(defsection build.pequal-by-args
+  (%autoadmit build.pequal-by-args)
+  (local (%enable default logic.functional-axiom build.pequal-by-args))
+  (%autoprove forcing-build.pequal-by-args-under-iff)
+  (%autoprove forcing-logic.appealp-of-build.pequal-by-args)
+  (%autoprove forcing-logic.conclusion-of-build.pequal-by-args)
+  (%autoprove forcing-logic.proofp-of-build.pequal-by-args))
+
+(defsection build.disjoined-pequal-by-args
+  (%autoadmit build.disjoined-pequal-by-args)
+  (local (%enable default logic.functional-axiom build.disjoined-pequal-by-args))
+  (%autoprove forcing-build.disjoined-pequal-by-args-under-iff)
+  (%autoprove forcing-logic.appealp-of-build.disjoined-pequal-by-args)
+  (%autoprove forcing-logic.conclusion-of-build.disjoined-pequal-by-args)
+  (%autoprove forcing-logic.proofp-of-build.disjoined-pequal-by-args))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/rulep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/rulep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/rulep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/rulep.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,204 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+
+(%autoadmit rw.force-modep)
+
+(%autoprove booleanp-of-rw.force-modep
+            (%enable default rw.force-modep))
+
+(%defaggregate rw.hyp
+  (term fmode limitp limit)
+  :require ((logic.termp-of-rw.hyp->term     (logic.termp term))
+            (rw.force-modep-of-rw.hyp->fmode (rw.force-modep fmode))
+            (booleanp-of-rw.hyp->limitp      (booleanp limitp))
+            (natp-of-rw.hyp->limit           (natp limit))))
+
+(%deflist rw.hyp-listp (x)
+  (rw.hypp x))
+
+
+
+(%autoadmit rw.hyp-atblp)
+(%autoprove booleanp-of-rw.hyp-atblp
+            (%enable default rw.hyp-atblp))
+(%autoprove forcing-logic.term-atblp-of-rw.hyp
+            (%enable default rw.hyp-atblp))
+(%autoprove rw.hyp-atblp-of-rw.hyp
+            (%enable default rw.hyp-atblp))
+(%autoprove rw.hyp-atblp-of-nil
+            (%enable default rw.hyp-atblp))
+
+(%deflist rw.hyp-list-atblp (x atbl)
+  (rw.hyp-atblp x atbl))
+
+
+(%defprojection :list (rw.hyp-list-terms x)
+                :element (rw.hyp->term x))
+(%autoprove forcing-logic.term-listp-of-rw.hyp-list-terms
+            (%cdr-induction x))
+(%autoprove forcing-logic.term-list-atblp-of-rw.hyp-list-terms
+            (%cdr-induction x))
+
+
+(%defaggregate rw.rule
+  (name type hyps equiv lhs rhs syntax crithyps)
+  :require ((symbolp-of-rw.rule->name                (symbolp name))
+            (symbolp-of-rw.rule->type                (symbolp type))
+            (rw.hyp-listp-of-rw.rule->hyps           (rw.hyp-listp hyps))
+            (logic.function-namep-of-rw.rule->equiv  (logic.function-namep equiv))
+            (logic.termp-of-rw.rule->lhs             (logic.termp lhs))
+            (logic.termp-of-rw.rule->rhs             (logic.termp rhs))
+            (logic.term-listp-of-rw.rule->syntax     (logic.term-listp syntax))
+            (subsetp-of-rw.rule->crithyps            (logic.term-listp crithyps))))
+
+(%deflist rw.rule-listp (x)
+  (rw.rulep x))
+
+(%deflist rw.rule-list-listp (x)
+  (rw.rule-listp x))
+
+(%autoprove forcing-rw.rule-listp-of-simple-flatten
+            (%cdr-induction x))
+
+
+(%autoadmit rw.rule-atblp)
+
+(%autoprove rw.rule-atblp-of-nil
+            (%enable default rw.rule-atblp))
+(%autoprove booleanp-of-rw.rule-atblp
+            (%enable default rw.rule-atblp))
+(%autoprove forcing-rw.hyp-list-atblp-of-rw.rule->hyps
+            (%enable default rw.rule-atblp))
+(%autoprove forcing-logic.term-atblp-of-rw.rule->lhs
+            (%enable default rw.rule-atblp))
+(%autoprove forcing-logic.term-atblp-of-rw.rule->rhs
+            (%enable default rw.rule-atblp))
+(%autoprove forcing-logic.term-list-atblp-of-rw.rule->crithyps
+            (%enable default rw.rule-atblp))
+(%autoprove forcing-lookup-of-rw.rule-equiv
+            (%forcingp nil)
+            (%enable default rw.rule-atblp))
+(%autoprove forcing-rw.rule-atblp-of-rw.rule
+            (%enable default rw.rule-atblp))
+
+
+(%deflist rw.rule-list-atblp (x atbl)
+  (rw.rule-atblp x atbl))
+
+(%deflist rw.rule-list-list-atblp (x atbl)
+  (rw.rule-list-atblp x atbl))
+
+
+
+(%autoadmit rw.rule-clause)
+(%autoprove consp-of-rw.rule-clause
+            (%enable default rw.rule-clause))
+(%autoprove forcing-logic.term-listp-of-rw.rule-clause
+            (%enable default rw.rule-clause))
+(%autoprove forcing-logic.term-list-atbp-of-rw.rule-clause
+            (%enable default rw.rule-clause))
+(%autoprove forcing-rw.rule-clause-when-no-hyps
+            (%forcingp nil)
+            (%enable default rw.rule-clause))
+
+
+(%defprojection :list (rw.rule-list-clauses x)
+                :element (rw.rule-clause x))
+(%autoprove cons-listp-of-rw.rule-list-clauses
+            (%cdr-induction x))
+(%autoprove forcing-logic.term-list-listp-of-rw.rule-list-clauses
+            (%cdr-induction x))
+(%autoprove forcing-logic.term-list-list-atbp-of-rw.rule-list-clauses
+            (%cdr-induction x))
+
+
+(%defprojection :list (rw.rule-list-lhses x)
+                :element (rw.rule->lhs x))
+(%autoprove forcing-logic.term-listp-of-rw.rule-list-lhses
+            (%cdr-induction x))
+(%autoprove forcing-logic.term-list-atblp-of-rw.rule-list-lhses
+            (%cdr-induction x))
+
+
+(%defprojection :list (rw.rule-list-names x)
+                :element (rw.rule->name x))
+(%autoprove forcing-symbol-listp-of-rw.rule-list-names
+            (%cdr-induction x))
+
+
+(%autoadmit rw.rule-env-okp)
+(%autoprove booleanp-of-rw.rule-env-okp
+            (%enable default rw.rule-env-okp))
+
+
+(%deflist rw.rule-list-env-okp (x thms)
+  (rw.rule-env-okp x thms))
+
+(%deflist rw.rule-list-list-env-okp (x thms)
+  (rw.rule-list-env-okp x thms))
+
+
+
+
+(%autoadmit rw.rule-list-lookup)
+
+(%autoprove rw.rule-list-lookup-when-not-consp
+            (%restrict default rw.rule-list-lookup (equal rules 'rules)))
+
+(%autoprove rw.rule-list-lookup-of-cons
+            (%restrict default rw.rule-list-lookup (equal rules '(cons rule rules))))
+
+(%autoprove rw.rulep-of-rw.rule-list-lookup
+            (%cdr-induction rules))
+
+(%autoprove rw.rule-atblp-of-rw.rule-list-lookup
+            (%cdr-induction rules))
+
+(%autoprove rw.rule-env-okp-of-rw.rule-list-lookup
+            (%cdr-induction rules))
+
+(%autoprove rw.rule-list-atblp-of-cdr-of-lookup
+            (%cdr-induction map))
+
+(%autoprove rw.rule-list-env-okp-of-cdr-of-lookup
+            (%cdr-induction map))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/rulep")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level4/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/symmetry	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level4-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level4/update-clause.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level4/update-clause.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level4/update-clause.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level4/update-clause.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,44 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "clause-basics")
+(%interactive)
+
+(%defderiv clause.aux-update-clause-lemma1-bldr)
+(%defderiv clause.aux-update-clause-lemma2-bldr)
+
+(%defderiv clause.aux-update-clause-iff-lemma1-bldr)
+(%defderiv clause.aux-update-clause-iff-lemma2-bldr)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level5/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/acl2-customization.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/aux-split-negative.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/aux-split-negative.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/aux-split-negative.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/aux-split-negative.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,75 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%defderiv clause.aux-split-negative-1-bldr-lemma-1 :omit-okp t)
+
+(encapsulate
+ ()
+ (%autoprove equal-when-logic.functionp-and-logic.functionp
+             (%enable default logic.functionp logic.function-name logic.function-args))
+
+ (%autoprove equal-of-one-tuples)
+
+ (%autoprove equal-of-logic.function-args-and-logic.function-args-when-one-tuples
+             (%use (%instance (%thm equal-of-one-tuples)
+                              (x (logic.function-args x))
+                              (y (logic.function-args y)))))
+
+ (local (%enable default
+                 equal-when-logic.functionp-and-logic.functionp
+                 equal-of-one-tuples
+                 equal-of-logic.function-args-and-logic.function-args-when-one-tuples))
+
+ (%defderiv clause.aux-split-negative-1-bldr-lemma-2 :omit-okp t))
+
+
+(%defderiv clause.aux-split-negative-1-bldr)
+
+
+(%defderiv clause.aux-split-negative-2-bldr-lemma-1 :omit-okp t)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 equal-when-logic.functionp-and-logic.functionp
+                 equal-of-logic.function-args-and-logic.function-args-when-one-tuples))
+ (%defderiv clause.aux-split-negative-2-bldr-lemma-2))
+
+
+(%defderiv clause.aux-split-negative-2-bldr)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/basic-if-lemmas.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/basic-if-lemmas.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/basic-if-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/basic-if-lemmas.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,52 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "if-lemmas")
+(%interactive)
+
+(local (%enable default bust-up-cdr-of-logic.function-args-expensive))
+
+(%defderiv rw.iff-implies-equal-if-specialcase-nil-bldr)
+(%defderiv rw.iff-implies-iff-if-specialcase-nil-bldr)
+
+(%defderiv rw.iff-implies-equal-if-specialcase-t-bldr)
+(%defderiv rw.iff-implies-iff-if-specialcase-t-bldr)
+
+(%defderiv rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr)
+(%defderiv rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr)
+
+(%defderiv rw.disjoined-iff-implies-equal-if-specialcase-t-bldr)
+(%defderiv rw.disjoined-iff-implies-iff-if-specialcase-t-bldr)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level5/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/cert.image	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1 @@
+level5-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/contradiction-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/contradiction-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/contradiction-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/contradiction-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,96 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "contradictionp")
+(include-book "eqtrace-compiler")
+(%interactive)
+
+
+(%deftheorem theorem-inequality-of-not-x-and-x)
+(%deftheorem theorem-not-x-and-x-under-iff)
+(%deftheorem rw.eqtrace-contradiction-lemma1)
+
+(defsection rw.eqtrace-contradiction-lemma2
+  (%autoadmit rw.eqtrace-contradiction-lemma2)
+  (local (%enable default
+                  rw.eqtrace-contradiction-lemma2
+                  theorem-not-x-and-x-under-iff
+                  theorem-symmetry-of-iff))
+  (%autoprove rw.eqtrace-contradiction-lemma2-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.eqtrace-contradiction-lemma2)
+  (%autoprove forcing-logic.conclusion-of-rw.eqtrace-contradiction-lemma2)
+  (%autoprove forcing-logic.proofp-of-rw.eqtrace-contradiction-lemma2))
+
+(%defderiv rw.eqtrace-contradiction-bldr-lemma3a :omit-okp t)
+(%defderiv rw.eqtrace-contradiction-bldr-lemma3 :omit-okp t)
+
+
+(defsection rw.eqtrace-contradiction-bldr
+  (%autoadmit rw.eqtrace-contradiction-bldr)
+  (local (%enable default
+                  rw.eqtrace-contradictionp
+                  rw.eqtrace-contradiction-bldr
+                  rw.eqtrace-formula
+                  rw.eqtrace-contradiction-lemma1
+                  theorem-inequality-of-not-x-and-x))
+  (%autoprove rw.eqtrace-contradiction-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.eqtrace-contradiction-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.eqtrace-contradiction-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.eqtrace-contradiction-bldr))
+
+(%autoadmit rw.eqtrace-contradiction-bldr-okp)
+
+(%autoadmit rw.eqtrace-contradiction-bldr-high)
+
+(defsection rw.eqtrace-contradiction-bldr-okp
+  (local (%enable default rw.eqtrace-contradiction-bldr-okp))
+  (%autoprove booleanp-of-rw.eqtrace-contradiction-bldr-okp)
+  (%autoprove rw.eqtrace-contradiction-bldr-okp-of-logic.appeal-identity)
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free
+                   forcing-logic.term-list-atblp-of-logic.function-args))
+  (%autoprove lemma-1-for-soundness-of-rw.eqtrace-contradiction-bldr-okp)
+  (%autoprove lemma-2-for-soundness-of-rw.eqtrace-contradiction-bldr-okp)
+  (%autoprove forcing-soundness-of-rw.eqtrace-contradiction-bldr-okp
+              (%enable default
+                       lemma-1-for-soundness-of-rw.eqtrace-contradiction-bldr-okp
+                       lemma-2-for-soundness-of-rw.eqtrace-contradiction-bldr-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (rw.eqtrace-contradiction-bldr (first (logic.extras x))
+                                                                 (second (logic.extras x))))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/contradictionp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/contradictionp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/contradictionp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/contradictionp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,65 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(%interactive)
+
+
+(%autoadmit rw.eqtrace-contradictionp)
+
+(%autoprove booleanp-of-rw.eqtrace-contradictionp
+            (%enable default rw.eqtrace-contradictionp))
+
+
+(%autoadmit rw.find-eqtrace-contradiction)
+
+(%autoprove forcing-rw.eqtracep-of-rw.find-eqtrace-contradiction
+            (%cdr-induction x)
+            (%restrict default rw.find-eqtrace-contradiction (equal x 'x)))
+
+(%autoprove forcing-rw.eqtrace-atblp-of-rw.find-eqtrace-contradiction
+            (%cdr-induction x)
+            (%restrict default rw.find-eqtrace-contradiction (equal x 'x)))
+
+(%autoprove forcing-rw.eqtrace-okp-of-rw.find-eqtrace-contradiction
+            (%cdr-induction x)
+            (%restrict default rw.find-eqtrace-contradiction (equal x 'x)))
+
+(%autoprove forcing-rw.eqtrace-contradictionp-of-rw.find-eqtrace-contradiction
+            (%cdr-induction x)
+            (%restrict default rw.find-eqtrace-contradiction (equal x 'x)))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/contradictionp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/crewrite-if-lemmas.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/crewrite-if-lemmas.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/crewrite-if-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/crewrite-if-lemmas.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "if-lemmas")
+(%interactive)
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 type-set-like-rules))
+
+(%defderiv rw.disjoined-iff-implies-equal-if-bldr)
+(%defderiv rw.disjoined-iff-implies-iff-if-bldr)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/crewrite-if-lemmas2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/crewrite-if-lemmas2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/crewrite-if-lemmas2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/crewrite-if-lemmas2.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,41 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "if-lemmas")
+(%interactive)
+
+(%defderiv rw.disjoined-equal-of-if-x-y-y-bldr)
+(%defderiv rw.disjoined-iff-of-if-x-y-y-bldr)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/direct-iff-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/direct-iff-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/direct-iff-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/direct-iff-eqtrace-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,84 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(%interactive)
+
+(%defderiv rw.direct-iff-eqtrace-nhyp-bldr-lemma-1 :omit-okp t)
+(%defderiv rw.direct-iff-eqtrace-nhyp-bldr-lemma-2 :omit-okp t)
+
+(defsection rw.direct-iff-eqtrace-nhyp-bldr
+  (%autoadmit rw.direct-iff-eqtrace-nhyp-bldr)
+  (local (%enable default
+                  rw.direct-iff-eqtrace
+                  rw.direct-iff-eqtrace-nhyp-bldr
+                  theorem-not-when-nil
+                  logic.term-formula))
+  (local (%enable default
+                  forcing-equal-of-logic.pequal-rewrite-two
+                  forcing-equal-of-logic.pequal-rewrite
+                  forcing-equal-of-logic.por-rewrite-two
+                  forcing-equal-of-logic.por-rewrite
+                  forcing-equal-of-logic.pnot-rewrite-two
+                  forcing-equal-of-logic.pnot-rewrite))
+  (%autoprove rw.direct-iff-eqtrace-nhyp-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.direct-iff-eqtrace-nhyp-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.direct-iff-eqtrace-nhyp-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.direct-iff-eqtrace-nhyp-bldr))
+
+(defsection rw.direct-iff-eqtrace-bldr
+  (%autoadmit rw.direct-iff-eqtrace-bldr)
+  (local (%enable default
+                  rw.direct-iff-eqtrace-bldr
+                  rw.direct-iff-eqtrace-okp
+                  rw.hypbox-formula
+                  rw.eqtrace-formula))
+  (%autoprove rw.direct-iff-eqtrace-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.direct-iff-eqtrace-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.direct-iff-eqtrace-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.direct-iff-eqtrace-bldr))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/direct-iff-eqtrace-bldr"
+                                         booleanp-of-rw.direct-iff-eqtrace-nhyp-bldr-lemma-2-okp
+                                         rw.direct-iff-eqtrace-nhyp-bldr-lemma-2-okp-of-logic.appeal-identity
+                                         lemma-1-for-soundness-of-rw.direct-iff-eqtrace-nhyp-bldr-lemma-2-okp
+                                         lemma-2-for-soundness-of-rw.direct-iff-eqtrace-nhyp-bldr-lemma-2-okp
+                                         forcing-soundness-of-rw.direct-iff-eqtrace-nhyp-bldr-lemma-2-okp
+                                         booleanp-of-rw.direct-iff-eqtrace-nhyp-bldr-lemma-1-okp
+                                         rw.direct-iff-eqtrace-nhyp-bldr-lemma-1-okp-of-logic.appeal-identity
+                                         lemma-1-for-soundness-of-rw.direct-iff-eqtrace-nhyp-bldr-lemma-1-okp
+                                         lemma-2-for-soundness-of-rw.direct-iff-eqtrace-nhyp-bldr-lemma-1-okp
+                                         forcing-soundness-of-rw.direct-iff-eqtrace-nhyp-bldr-lemma-1-okp)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/direct-iff-eqtrace.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/direct-iff-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/direct-iff-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/direct-iff-eqtrace.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,78 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(%interactive)
+
+(defsection rw.direct-iff-eqtrace
+  (%autoadmit rw.direct-iff-eqtrace)
+  (local (%enable default rw.direct-iff-eqtrace))
+  (%autoprove forcing-rw.eqtrace->method-of-rw.direct-iff-eqtrace)
+  (%autoprove forcing-rw.eqtrace->iffp-of-rw.direct-iff-eqtrace)
+  (%autoprove forcing-rw.eqtrace->subtraces-of-rw.direct-iff-eqtrace)
+  (%autoprove forcing-rw.eqtracep-of-rw.direct-iff-eqtrace)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.direct-iff-eqtrace)
+  (%autoprove rw.direct-iff-eqtrace-normalize-okp-1)
+  (%autoprove rw.direct-iff-eqtrace-normalize-okp-2)
+  (%autoprove rw.direct-iff-eqtrace-normalize-okp-3))
+
+
+(defsection rw.find-nhyp-for-direct-iff-eqtracep
+  (%autoadmit rw.find-nhyp-for-direct-iff-eqtracep)
+  (local (%restrict default rw.find-nhyp-for-direct-iff-eqtracep (equal nhyps 'nhyps)))
+  (%autoprove rw.find-nhyp-for-direct-iff-eqtracep-of-nil
+              (%restrict default rw.find-nhyp-for-direct-iff-eqtracep (equal nhyps ''nil)))
+  (%autoprove forcing-logic.termp-of-rw.find-nhyp-for-direct-iff-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-logic.term-atblp-of-rw.find-nhyp-for-direct-iff-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-memberp-of-rw.find-nhyp-for-direct-iff-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-rw.direct-iff-eqtrace-of-rw.find-nhyp-for-direct-iff-eqtracep
+              (%cdr-induction nhyps)))
+
+(defsection rw.direct-iff-eqtrace-okp
+  (%autoadmit rw.direct-iff-eqtrace-okp)
+  (local (%enable default rw.direct-iff-eqtrace-okp))
+  (%autoprove booleanp-of-rw.direct-iff-eqtrace-okp)
+  (%autoprove lemma-for-forcing-rw.direct-iff-eqtrace-okp-rw.direct-iff-eqtrace
+              (%restrict default rw.find-nhyp-for-direct-iff-eqtracep (equal nhyps 'nhyps))
+              (%cdr-induction nhyps))
+  (%autoprove forcing-rw.direct-iff-eqtrace-okp-rw.direct-iff-eqtrace
+              (%enable default lemma-for-forcing-rw.direct-iff-eqtrace-okp-rw.direct-iff-eqtrace)
+              (%disable default rw.direct-iff-eqtrace-normalize-okp-1)))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/direct-iff-eqtrace")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/disjoined-update-clause-bldr-support.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/disjoined-update-clause-bldr-support.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/disjoined-update-clause-bldr-support.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/disjoined-update-clause-bldr-support.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,39 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(%defderiv clause.aux-disjoined-update-clause-lemma1-bldr)
+(%defderiv clause.aux-disjoined-update-clause-lemma2-bldr)
+(%defderiv clause.aux-disjoined-update-clause-lemma3-bldr)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/disjoined-update-clause-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/disjoined-update-clause-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/disjoined-update-clause-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/disjoined-update-clause-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,194 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "disjoined-update-clause-bldr-support")
+(include-book "fuse")
+(%interactive)
+
+
+(%autoadmit clause.aux-disjoined-update-clause-bldr)
+
+(local (%enable default logic.term-formula))
+
+(%autoprove clause.aux-disjoined-update-clause-bldr-under-iff
+            (%autoinduct clause.aux-disjoined-update-clause-bldr)
+            (%restrict default clause.aux-disjoined-update-clause-bldr (equal todo 'todo)))
+
+
+(defthm lemma-for-forcing-logic.appealp-of-clause.aux-disjoined-update-clause-bldr
+  ;; BOZO unlocalize/rename in clauses/disjoined-update-clause-bldr
+  (implies (and (logic.formulap p)
+                (logic.term-listp todo)
+                (logic.term-listp done)
+                (or (consp todo) (consp done))
+                (logic.appealp proof)
+                (logic.appeal-listp t-proofs)
+                (equal (logic.conclusion proof)
+                       (cond ((and (consp done) (consp todo))
+                              (logic.por p (logic.por (clause.clause-formula done)
+                                                      (clause.clause-formula todo))))
+                             ((consp done)
+                              (logic.por p (clause.clause-formula done)))
+                             (t
+                              (logic.por p (clause.clause-formula todo)))))
+                (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                (all-equalp p (logic.vlhses (logic.strip-conclusions t-proofs)))
+                (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) todo))
+           (and (logic.appealp (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof))
+                (equal (logic.conclusion (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof))
+                       (logic.por p (clause.clause-formula (app (rev (logic.=lhses (logic.vrhses (logic.strip-conclusions t-proofs)))) done))))))
+  ;;:hints(("Goal"
+  ;;        :induct (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof))))
+  :rule-classes nil
+  )
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.aux-disjoined-update-clause-bldr
+            (%autoinduct clause.aux-disjoined-update-clause-bldr)
+            (%forcingp nil)
+
+            (%disable default
+                      type-set-like-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      unusual-consp-rules
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      same-length-prefixes-equal-cheap
+                      unusual-subsetp-rules
+                      unusual-memberp-rules)
+
+            (%auto :strategy (cleanup split urewrite crewrite))
+
+            (%restrict default clause.aux-disjoined-update-clause-bldr (equal todo 'todo))
+            (%enable default expensive-term/formula-inference)
+
+            (%auto :strategy (cleanup split urewrite crewrite))
+
+            (%enable default formula-decomposition)
+            (%auto))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-disjoined-update-clause-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-disjoined-update-clause-bldr))))
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-disjoined-update-clause-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-disjoined-update-clause-bldr))))
+
+(%autoprove forcing-logic.proofp-of-clause.aux-disjoined-update-clause-bldr
+            (%autoinduct clause.aux-disjoined-update-clause-bldr)
+            (%forcingp nil)
+
+            (%disable default
+                      type-set-like-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      unusual-consp-rules
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      same-length-prefixes-equal-cheap
+                      unusual-subsetp-rules
+                      unusual-memberp-rules)
+
+            (%auto :strategy (cleanup split urewrite crewrite))
+
+            (%restrict default clause.aux-disjoined-update-clause-bldr (equal todo 'todo))
+            (%enable default expensive-term/formula-inference)
+
+            (%auto :strategy (cleanup split urewrite crewrite))
+
+            (%enable default formula-decomposition)
+            (%auto))
+
+
+
+;; (%enable default build.disjoined-rev-disjunction)
+
+(%autoadmit clause.disjoined-update-clause-bldr)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 clause.disjoined-update-clause-bldr
+                 build.disjoined-rev-disjunction))
+ (%autoprove clause.disjoined-update-clause-bldr-under-iff)
+ (%autoprove forcing-logic.appealp-of-clause.disjoined-update-clause-bldr)
+ (%autoprove forcing-logic.conclusion-of-clause.disjoined-update-clause-bldr)
+ (%autoprove forcing-logic.proofp-of-clause.disjoined-update-clause-bldr))
+
+
+
+
+
+(defsection clause.disjoined-update-clause-bldr-okp
+
+  (%autoadmit clause.disjoined-update-clause-bldr-okp)
+
+  (%autoprove booleanp-of-clause.disjoined-update-clause-bldr-okp
+              (%enable default clause.disjoined-update-clause-bldr-okp))
+
+  (%autoprove clause.disjoined-update-clause-bldr-okp-of-logic.appeal-identity
+              (%enable default clause.disjoined-update-clause-bldr-okp))
+
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+
+  (%autoprove lemma-1-for-soundness-of-clause.disjoined-update-clause-bldr-okp
+              (%enable default clause.disjoined-update-clause-bldr-okp))
+
+  (%autoprove lemma-2-for-soundness-of-clause.disjoined-update-clause-bldr-okp
+              (%enable default clause.disjoined-update-clause-bldr-okp))
+
+  (%autoprove forcing-soundness-of-clause.disjoined-update-clause-bldr-okp
+              (%disable default [OUTSIDE]CONSP-OF-LOGIC.STRIP-CONCLUSIONS) ;; why is this a problem??
+              (%enable default
+                       lemma-1-for-soundness-of-clause.disjoined-update-clause-bldr-okp
+                       lemma-2-for-soundness-of-clause.disjoined-update-clause-bldr-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (clause.disjoined-update-clause-bldr
+                                   (logic.=rhses
+                                    (logic.vrhses
+                                     (logic.strip-conclusions
+                                      (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                   axioms thms atbl))))
+                                   (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                   (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                axioms thms atbl)))))
+              (%forcingp nil)
+              (%auto :strategy (cleanup split crewrite))
+              (%enable default clause.disjoined-update-clause-bldr-okp)
+              (%auto)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/eqtrace-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/eqtrace-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/eqtrace-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/eqtrace-compiler.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,188 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(include-book "primary-eqtrace-bldr")
+(include-book "secondary-eqtrace-bldr")
+(include-book "trans1-eqtrace-bldr")
+(include-book "trans2-eqtrace-bldr")
+(include-book "trans3-eqtrace-bldr")
+(include-book "weakening-eqtrace-bldr")
+(include-book "direct-iff-eqtrace-bldr")
+(include-book "negative-iff-eqtrace-bldr")
+(include-book "hypbox-arities")
+(%interactive)
+
+(defsection rw.eqtrace-step-bldr
+  (%autoadmit rw.eqtrace-step-bldr)
+  (local (%enable default
+                  rw.eqtrace-step-bldr
+                  rw.eqtrace-step-okp))
+  (local (%restrict default definition-of-rw.eqtrace-okp (equal x 'x)))
+  (local (%disable default forcing-rw.eqtrace-list-okp-of-rw.eqtrace-subtraces))
+  (%autoprove rw.eqtrace-step-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.eqtrace-step-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.eqtrace-step-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.eqtrace-step-bldr))
+
+
+
+(%autoadmit rw.flag-eqtrace-bldr)
+(%autoadmit rw.eqtrace-bldr)
+(%autoadmit rw.eqtrace-list-bldr)
+
+(%autoprove definition-of-rw.eqtrace-bldr
+            (%restrict default rw.flag-eqtrace-bldr (equal x 'x))
+            (%enable default rw.eqtrace-bldr rw.eqtrace-list-bldr))
+
+(%autoprove definition-of-rw.eqtrace-list-bldr
+            (%restrict default rw.flag-eqtrace-bldr (equal x 'x))
+            (%enable default rw.eqtrace-bldr rw.eqtrace-list-bldr))
+
+(%autoprove rw.flag-eqtrace-bldr-of-trace
+            (%enable default rw.eqtrace-bldr))
+
+(%autoprove rw.flag-eqtrace-bldr-of-list
+            (%enable default rw.eqtrace-list-bldr))
+
+(%autoprove rw.eqtrace-list-bldr-when-not-consp
+            (%restrict default definition-of-rw.eqtrace-list-bldr (equal x 'x)))
+
+(%autoprove rw.eqtrace-list-bldr-of-cons
+            (%restrict default definition-of-rw.eqtrace-list-bldr (equal x '(cons a x))))
+
+(%defprojection :list (rw.eqtrace-list-bldr x box)
+                :element (rw.eqtrace-bldr x box))
+
+
+
+(defthm lemma-for-forcing-logic.appealp-of-rw.eqtrace-bldr
+  ;; BOZO change to defthms-flag
+  (if (equal flag 'trace)
+      (implies (and (rw.eqtracep x)
+                    (rw.hypboxp box)
+                    (rw.eqtrace-okp x box))
+               (and (logic.appealp (rw.eqtrace-bldr x box))
+                    (equal (logic.conclusion (rw.eqtrace-bldr x box))
+                           (rw.eqtrace-formula x box))))
+    (implies (and (rw.eqtrace-listp x)
+                  (rw.hypboxp box)
+                  (rw.eqtrace-list-okp x box))
+             (and (logic.appeal-listp (rw.eqtrace-list-bldr x box))
+                  (equal (logic.strip-conclusions (rw.eqtrace-list-bldr x box))
+                         (rw.eqtrace-formula-list x box)))))
+  :rule-classes nil
+  :hints(("Goal"
+          :induct (rw.flag-eqtrace-bldr flag x box)
+          :expand (rw.eqtrace-bldr x box))))
+
+(%autoprove lemma-for-forcing-logic.appealp-of-rw.eqtrace-bldr
+            (%rw.flag-eqtracep-induction flag x)
+            (%restrict default definition-of-rw.eqtrace-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.appealp-of-rw.eqtrace-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-rw.eqtrace-bldr)
+                             (flag 'trace))))
+
+(%autoprove forcing-logic.conclusion-of-rw.eqtrace-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-rw.eqtrace-bldr)
+                             (flag 'trace))))
+
+(%autoprove forcing-logic.appeal-listp-of-rw.eqtrace-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-rw.eqtrace-bldr)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.strip-conclusions-of-rw.eqtrace-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-rw.eqtrace-bldr)
+                             (flag 'list))))
+
+(defthm@ lemma-for-forcing-logic.proofp-of-rw.eqtrace-bldr
+  (implies (and (rw.hypboxp box)
+                (rw.hypbox-atblp box atbl)
+                (equal (cdr (lookup 'not atbl)) 1)
+                (equal (cdr (lookup 'equal atbl)) 2)
+                (equal (cdr (lookup 'iff atbl)) 2)
+                (@obligations rw.eqtrace-bldr))
+           (if (equal flag 'trace)
+               (implies (and (rw.eqtracep x)
+                             (rw.eqtrace-okp x box))
+                        (equal (logic.proofp (rw.eqtrace-bldr x box) axioms thms atbl)
+                               t))
+             (implies (and (rw.eqtrace-listp x)
+                           (rw.eqtrace-list-okp x box))
+                      (equal (logic.proof-listp (rw.eqtrace-list-bldr x box) axioms thms atbl)
+                             t))))
+  :rule-classes nil
+  :hints(("Goal"
+          :induct (rw.flag-eqtrace-bldr flag x box)
+          :expand (rw.eqtrace-bldr x box))))
+
+(%autoprove lemma-for-forcing-logic.proofp-of-rw.eqtrace-bldr
+            (%rw.flag-eqtracep-induction flag x)
+            (%restrict default definition-of-rw.eqtrace-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.proofp-of-rw.eqtrace-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-rw.eqtrace-bldr)
+                             (flag 'trace))))
+
+(%autoprove forcing-logic.proof-listp-of-rw.eqtrace-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-rw.eqtrace-bldr)
+                             (flag 'list))))
+
+
+
+(%autoadmit rw.eqtrace-bldr-okp)
+
+(%autoadmit rw.eqtrace-bldr-high)
+
+(defsection rw.eqtrace-bldr-okp
+  (local (%enable default rw.eqtrace-bldr-okp))
+  (%autoprove booleanp-of-rw.eqtrace-bldr-okp)
+  (%autoprove rw.eqtrace-bldr-okp-of-logic.appeal-identity)
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free
+                   forcing-logic.term-list-atblp-of-logic.function-args))
+  (%autoprove lemma-1-for-soundness-of-rw.eqtrace-bldr-okp)
+  (%autoprove lemma-2-for-soundness-of-rw.eqtrace-bldr-okp)
+  (%autoprove forcing-soundness-of-rw.eqtrace-bldr-okp
+              (%enable default
+                       lemma-1-for-soundness-of-rw.eqtrace-bldr-okp
+                       lemma-2-for-soundness-of-rw.eqtrace-bldr-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (rw.eqtrace-bldr (first (logic.extras x))
+                                                   (second (logic.extras x))))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/eqtrace-okp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/eqtrace-okp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/eqtrace-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/eqtrace-okp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,191 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primary-eqtrace")
+(include-book "secondary-eqtrace")
+(include-book "transitivity-eqtraces")
+(include-book "weakening-eqtrace")
+(include-book "direct-iff-eqtrace")
+(include-book "negative-iff-eqtrace")
+(%interactive)
+
+
+
+(%autoadmit rw.eqtrace-step-okp)
+(%autoprove booleanp-of-rw.eqtrace-step-okp
+            (%enable default rw.eqtrace-step-okp))
+
+
+(%autoadmit rw.flag-eqtrace-okp)
+(%autoadmit rw.eqtrace-okp)
+(%autoadmit rw.eqtrace-list-okp)
+
+(%autoprove definition-of-rw.eqtrace-okp
+            (%restrict default rw.flag-eqtrace-okp (equal x 'x))
+            (%enable default rw.eqtrace-okp rw.eqtrace-list-okp))
+
+(%autoprove definition-of-rw.eqtrace-list-okp
+            (%restrict default rw.flag-eqtrace-okp (equal x 'x))
+            (%enable default rw.eqtrace-okp rw.eqtrace-list-okp))
+
+(%autoprove rw.flag-eqtrace-okp-of-trace
+            (%enable default rw.eqtrace-okp))
+
+(%autoprove rw.flag-eqtrace-okp-of-list
+            (%enable default rw.eqtrace-list-okp))
+
+
+
+(%autoprove lemma-for-booleanp-of-rw.eqtrace-okp
+            (%rw.flag-eqtracep-induction flag x)
+            (%restrict default definition-of-rw.eqtrace-okp (equal x 'x))
+            (%restrict default definition-of-rw.eqtrace-list-okp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.eqtrace-okp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.eqtrace-okp)
+                             (flag 'trace))))
+
+(%autoprove booleanp-of-rw.eqtrace-list-okp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.eqtrace-okp)
+                             (flag 'list))))
+
+(%autoprove rw.eqtrace-list-okp-when-not-consp
+            (%restrict default definition-of-rw.eqtrace-list-okp (equal x 'x)))
+
+(%autoprove rw.eqtrace-list-okp-of-cons
+            (%restrict default definition-of-rw.eqtrace-list-okp (equal x '(cons a x))))
+
+(%autoprove rw.eqtrace-step-okp-of-nil
+            (%enable default rw.eqtrace-step-okp))
+
+(%autoprove rw.eqtrace-okp-of-nil
+            (%restrict default definition-of-rw.eqtrace-okp (equal x ''nil)))
+
+(%deflist rw.eqtrace-list-okp (x box)
+          (rw.eqtrace-okp x box))
+
+
+(%autoprove forcing-rw.eqtrace-list-okp-of-rw.eqtrace-subtraces
+            (%restrict default definition-of-rw.eqtrace-okp (equal x 'x)))
+
+(%autoprove rw.primary-eqtrace-okp-when-empty-box
+            (%enable default rw.primary-eqtrace-okp))
+
+(%autoprove rw.secondary-eqtrace-okp-when-empty-box
+            (%enable default rw.secondary-eqtrace-okp))
+
+
+(%autoprove lemma-for-rw.eqtrace-okp-when-empty-box
+            (%rw.flag-eqtracep-induction flag x)
+            (%restrict default definition-of-rw.eqtrace-okp (equal x 'x))
+            (%auto)
+            (%forcingp nil)
+            (%enable default
+                     rw.eqtrace-step-okp
+                     rw.trans1-eqtrace-okp
+                     rw.trans2-eqtrace-okp
+                     rw.trans3-eqtrace-okp
+                     rw.weakening-eqtrace-okp
+                     rw.direct-iff-eqtrace-okp
+                     rw.negative-iff-eqtrace-okp))
+
+(%autoprove rw.eqtrace-okp-when-empty-box
+            (%use (%instance (%thm lemma-for-rw.eqtrace-okp-when-empty-box)
+                             (flag 'trace))))
+
+(%autoprove rw.eqtrace-list-okp-when-empty-box
+            (%use (%instance (%thm lemma-for-rw.eqtrace-okp-when-empty-box)
+                             (flag 'list))))
+
+
+(encapsulate
+ ()
+ (local (%enable default rw.eqtrace-step-okp))
+
+ (%autoprove forcing-rw.eqtrace-okp-of-rw.primary-eqtrace
+             (%restrict default definition-of-rw.eqtrace-okp
+                        (memberp x '((rw.primary-eqtrace okp nhyp)
+                                     (rw.primary-eqtrace 't nhyp)))))
+
+ (%autoprove forcing-rw.eqtrace-okp-of-rw.secondary-eqtrace
+             (%restrict default definition-of-rw.eqtrace-okp
+                        (memberp x '((rw.secondary-eqtrace okp nhyp)
+                                     (rw.secondary-eqtrace 't nhyp)))))
+
+ (%autoprove forcing-rw.eqtrace-okp-of-rw.trans1-eqtrace
+             (%restrict default definition-of-rw.eqtrace-okp (equal x '(rw.trans1-eqtrace iffp x y))))
+
+ (%autoprove forcing-rw.eqtrace-okp-of-rw.trans2-eqtrace
+             (%restrict default definition-of-rw.eqtrace-okp (equal x '(rw.trans2-eqtrace iffp x y))))
+
+ (%autoprove forcing-rw.eqtrace-okp-of-rw.trans3-eqtrace
+             (%restrict default definition-of-rw.eqtrace-okp (equal x '(rw.trans3-eqtrace iffp x y))))
+
+ (%autoprove forcing-rw.eqtrace-okp-of-rw.weakening-eqtrace
+             (%restrict default definition-of-rw.eqtrace-okp (equal x '(rw.weakening-eqtrace x))))
+
+ (%autoprove forcing-rw.eqtrace-okp-of-rw.direct-iff-eqtrace
+             (%restrict default definition-of-rw.eqtrace-okp
+                        (memberp x '((rw.direct-iff-eqtrace okp nhyp)
+                                     (rw.direct-iff-eqtrace 't nhyp)))))
+
+ (%autoprove forcing-rw.eqtrace-okp-of-rw.negative-iff-eqtrace
+             (%restrict default definition-of-rw.eqtrace-okp
+                        (memberp x '((rw.negative-iff-eqtrace okp nhyp)
+                                     (rw.negative-iff-eqtrace 't nhyp))))))
+
+
+
+(%autoadmit rw.eqtrace-formula)
+
+
+(%autoprove forcing-logic.formulap-of-rw.eqtrace-formula
+            (%enable default rw.eqtrace-formula))
+
+(%autoprove forcing-logic.formula-atblp-of-rw.eqtrace-formula
+            (%enable default rw.eqtrace-formula))
+
+(%defprojection :list (rw.eqtrace-formula-list x box)
+                :element (rw.eqtrace-formula x box))
+
+(%autoprove forcing-logic.formula-listp-of-rw.eqtrace-formula-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-atblp-of-rw.eqtrace-formula
+            (%cdr-induction x))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/eqtrace-okp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/eqtracep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/eqtracep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/eqtracep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/eqtracep.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,303 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hypboxp")
+(%interactive)
+
+
+;; BOZO move this to primitives
+;; BOZO why bother, why not just use the two-nats-measure to admit it?
+
+(defthm rank-of-fifth
+  (equal (< (rank (fifth x)) (rank x))
+         (consp x)))
+
+(%autoprove rank-of-fifth)
+
+
+(defthm rank-of-fifth-weak
+  (equal (< (rank x) (rank (fifth x)))
+         nil))
+
+(%autoprove rank-of-fifth-weak)
+
+(defthm rank-of-cdr-of-cdr-of-cdr-weak
+  (equal (< (rank x)
+            (rank (cdr (cdr (cdr x)))))
+         nil))
+
+(%autoprove rank-of-cdr-of-cdr-of-cdr-weak
+            (%restrict default rank (memberp x '(x (cdr x) (cdr (cdr x))))))
+
+(defthm rank-of-cdr-of-cdr-of-cdr
+  (equal (< (rank (cdr (cdr (cdr x))))
+            (rank x))
+         (consp x)))
+
+(%autoprove rank-of-cdr-of-cdr-of-cdr
+            (%restrict default rank (memberp x '(x (cdr x) (cdr (cdr x))))))
+
+
+(%autoadmit rw.flag-eqtracep)
+(%autoadmit rw.eqtracep)
+(%autoadmit rw.eqtrace-listp)
+
+(%autoprove definition-of-rw.eqtracep
+            (%restrict default rw.flag-eqtracep (equal x 'x))
+            (%enable default rw.eqtracep rw.eqtrace-listp))
+
+(%autoprove definition-of-rw.eqtrace-listp
+            (%restrict default rw.flag-eqtracep (equal x 'x))
+            (%enable default rw.eqtracep rw.eqtrace-listp))
+
+(%autoprove rw.flag-eqtracep-of-trace
+            (%enable default rw.eqtracep))
+
+(%autoprove rw.flag-eqtracep-of-list
+            (%enable default rw.eqtrace-listp))
+
+
+
+(defmacro %rw.flag-eqtracep-induction-raw (flag x)
+  ;; This is a lot better than autoinduct for controlling cases
+  `(%induct (two-nats-measure (rank ,x) (if (equal ,flag 'trace) '1 '0))
+            ((equal ,flag 'trace)
+             (((,flag 'list) (,x (cdr (cdr (cdr ,x)))))))
+            ((and (not (equal ,flag 'trace))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'trace))
+                  (consp ,x))
+             (((,flag 'trace) (,x (car ,x)))
+              ((,flag 'list) (,x (cdr ,x)))))))
+
+(%autoprove lemma-for-booleanp-of-rw.eqtracep
+            (%rw.flag-eqtracep-induction-raw flag x)
+            (%restrict default definition-of-rw.eqtracep (equal x 'x))
+            (%restrict default definition-of-rw.eqtrace-listp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.eqtracep
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.eqtracep)
+                             (flag 'trace))))
+
+(%autoprove booleanp-of-rw.eqtrace-listp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.eqtracep)
+                             (flag 'list))))
+
+(%autoprove rw.eqtrace-listp-when-not-consp
+            (%restrict default definition-of-rw.eqtrace-listp (equal x 'x)))
+
+(%autoprove rw.eqtrace-listp-of-cons
+            (%restrict default definition-of-rw.eqtrace-listp (equal x '(cons a x))))
+
+(%deflist rw.eqtrace-listp (x)
+          (rw.eqtracep x))
+
+
+
+(%autoadmit rw.eqtrace->method)
+(%autoadmit rw.eqtrace->iffp)
+(%autoadmit rw.eqtrace->lhs)
+(%autoadmit rw.eqtrace->rhs)
+(%autoadmit rw.eqtrace->subtraces)
+
+(%autoprove forcing-symbolp-of-rw.eqtrace->method
+            (%restrict default definition-of-rw.eqtracep (equal x 'x))
+            (%enable default rw.eqtrace->method))
+
+(%autoprove forcing-booleanp-of-rw.eqtrace->iffp
+            (%restrict default definition-of-rw.eqtracep (equal x 'x))
+            (%enable default rw.eqtrace->iffp))
+
+(%autoprove forcing-logic.termp-of-rw.eqtrace->lhs
+            (%restrict default definition-of-rw.eqtracep (equal x 'x))
+            (%enable default rw.eqtrace->lhs))
+
+(%autoprove forcing-logic.termp-of-rw.eqtrace->rhs
+            (%restrict default definition-of-rw.eqtracep (equal x 'x))
+            (%enable default rw.eqtrace->rhs))
+
+(%autoprove forcing-rw.eqtrace-listp-of-rw.eqtrace->subtraces
+            (%restrict default definition-of-rw.eqtracep (equal x 'x))
+            (%enable default rw.eqtrace->subtraces))
+
+(%autoprove forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs
+            (%restrict default definition-of-rw.eqtracep (equal x 'x))
+            (%enable default rw.eqtrace->lhs rw.eqtrace->rhs))
+
+(%autoprove forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs-free)
+
+;; BOZO move to primitives
+(%autoprove |(< a (+ b c d e f a g))|)
+
+;; BOZO really want this still?  Don't think so...
+(%autoprove rank-of-rw.eqtrace->subtraces-weak
+            (%enable default rw.eqtrace->subtraces))
+
+
+
+(%autoadmit rw.flag-eqtrace-atblp)
+(%autoadmit rw.eqtrace-atblp)
+(%autoadmit rw.eqtrace-list-atblp)
+
+(%autoprove definition-of-rw.eqtrace-atblp
+            (%restrict default rw.flag-eqtrace-atblp (equal x 'x))
+            (%enable default rw.eqtrace-atblp rw.eqtrace-list-atblp))
+
+(%autoprove definition-of-rw.eqtrace-list-atblp
+            (%restrict default rw.flag-eqtrace-atblp (equal x 'x))
+            (%enable default rw.eqtrace-atblp rw.eqtrace-list-atblp))
+
+(%autoprove rw.flag-eqtrace-atblp-of-trace
+            (%enable default rw.eqtrace-atblp))
+
+(%autoprove rw.flag-eqtrace-atblp-of-list
+            (%enable default rw.eqtrace-list-atblp))
+
+
+
+
+(defmacro %rw.flag-eqtracep-induction (flag x)
+  `(%induct (two-nats-measure (rank ,x) (if (equal ,flag 'trace) '1 '0))
+            ((equal ,flag 'trace)
+             (((,flag 'list) (,x (rw.eqtrace->subtraces ,x)))))
+            ((and (not (equal ,flag 'trace))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'trace))
+                  (consp ,x))
+             (((,flag 'trace) (,x (car ,x)))
+              ((,flag 'list) (,x (cdr ,x)))))))
+
+(%autoprove lemma-for-booleanp-of-rw.eqtrace-atblp
+            (%rw.flag-eqtracep-induction flag x)
+            (%restrict default definition-of-rw.eqtrace-atblp (equal x 'x))
+            (%restrict default definition-of-rw.eqtrace-list-atblp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.eqtrace-atblp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.eqtrace-atblp)
+                             (flag 'trace))))
+
+(%autoprove booleanp-of-rw.eqtrace-list-atblp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.eqtrace-atblp)
+                             (flag 'list))))
+
+(%autoprove rw.eqtrace-list-atblp-when-not-consp
+            (%restrict default definition-of-rw.eqtrace-list-atblp (equal x 'x)))
+
+(%autoprove rw.eqtrace-list-atblp-of-cons
+            (%restrict default definition-of-rw.eqtrace-list-atblp (equal x '(cons a x))))
+
+(%autoprove rw.eqtrace-atblp-of-nil
+            (%restrict default definition-of-rw.eqtrace-atblp (equal x ''nil)))
+
+(%deflist rw.eqtrace-list-atblp (x atbl)
+          (rw.eqtrace-atblp x atbl))
+
+(%autoprove forcing-logic.term-atblp-of-rw.eqtrace->lhs
+            (%restrict default definition-of-rw.eqtrace-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-rw.eqtrace->rhs
+            (%restrict default definition-of-rw.eqtrace-atblp (equal x 'x)))
+
+(%autoprove forcing-rw.eqtrace-list-atblp-of-rw.eqtrace->subtraces
+            (%restrict default definition-of-rw.eqtrace-atblp (equal x 'x)))
+
+
+
+
+(%autoadmit rw.eqtrace)
+(%noexec rw.eqtrace)
+
+(%autoprove rw.eqtrace->method-of-rw.eqtrace
+            (%enable default rw.eqtrace rw.eqtrace->method))
+
+(%autoprove rw.eqtrace->iffp-of-rw.eqtrace
+            (%enable default rw.eqtrace rw.eqtrace->iffp))
+
+(%autoprove rw.eqtrace->lhs-of-rw.eqtrace
+            (%enable default rw.eqtrace rw.eqtrace->lhs))
+
+(%autoprove rw.eqtrace->rhs-of-rw.eqtrace
+            (%enable default rw.eqtrace rw.eqtrace->rhs))
+
+(%autoprove rw.eqtrace->subtraces-of-rw.eqtrace
+            (%enable default rw.eqtrace rw.eqtrace->subtraces))
+
+(%autoprove forcing-rw.eqtracep-of-rw.eqtrace
+            (%restrict default definition-of-rw.eqtracep (equal x '(CONS (CONS LHS RHS) (CONS IFFP (CONS METHOD SUBTRACES)))))
+            (%enable default rw.eqtrace))
+
+(%autoprove forcing-rw.eqtrace-atblp-of-rw.eqtrace
+            (%restrict default definition-of-rw.eqtrace-atblp
+                       (equal x '(rw.eqtrace method iffp lhs rhs subtraces))))
+
+(%autoprove rw.eqtrace-under-iff
+            (%enable default rw.eqtrace))
+
+
+(defsection rw.trace-list-iffps
+  (local (%disable default forcing-booleanp-of-rw.eqtrace->iffp))
+  (%defprojection :list (rw.eqtrace-list-iffps x)
+                  :element (rw.eqtrace->iffp x)
+                  :nil-preservingp t))
+
+(defsection rw.eqtrace-list-lhses
+  (local (%disable default forcing-booleanp-of-rw.eqtrace->iffp))
+  (%defprojection :list (rw.eqtrace-list-lhses x)
+                  :element (rw.eqtrace->lhs x)
+                  :nil-preservingp t))
+
+(defsection rw.eqtrace-list-rhses
+  (local (%disable default forcing-booleanp-of-rw.eqtrace->iffp))
+  (%defprojection :list (rw.eqtrace-list-rhses x)
+                  :element (rw.eqtrace->rhs x)
+                  :nil-preservingp t))
+
+(%autoprove forcing-logic.term-listp-of-rw.eqtrace-list-lhses (%cdr-induction x))
+(%autoprove forcing-logic.term-listp-of-rw.eqtrace-list-rhses (%cdr-induction x))
+(%autoprove forcing-logic.term-list-atblp-of-rw.eqtrace-list-lhses (%cdr-induction x))
+(%autoprove forcing-logic.term-list-atblp-of-rw.eqtrace-list-rhses (%cdr-induction x))
+(%autoprove rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps (%cdr-induction row))
+(%autoprove rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps-alt)
+
+
+(%autoprove rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses
+            (%cdr-induction x))
+
+(%autoprove rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses-alt)
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/eqtracep")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/fuse.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/fuse.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/fuse.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/fuse.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,81 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(%autoadmit logic.=lhses-of-strip-conclusions)
+(%autoprove logic.=lhses-of-strip-conclusions-removal
+            (%restrict default logic.=lhses-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
+(%autoadmit logic.=rhses-of-strip-conclusions)
+(%autoprove logic.=rhses-of-strip-conclusions-removal
+            (%restrict default logic.=rhses-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
+(%autoadmit logic.vrhses-of-strip-conclusions)
+(%autoprove logic.vrhses-of-strip-conclusions-removal
+            (%restrict default logic.vrhses-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
+(%autoadmit logic.vlhses-of-strip-conclusions)
+(%autoprove logic.vlhses-of-strip-conclusions-removal
+            (%restrict default logic.vlhses-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
+(%autoadmit logic.=lhses-of-vrhses-of-strip-conclusions)
+(%autoprove logic.=lhses-of-vrhses-of-strip-conclusions-removal
+            (%restrict default logic.=lhses-of-vrhses-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
+(%autoadmit logic.=rhses-of-vrhses-of-strip-conclusions)
+(%autoprove logic.=rhses-of-vrhses-of-strip-conclusions-removal
+            (%restrict default logic.=rhses-of-vrhses-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
+(%autoadmit logic.all-atomicp-of-strip-conclusions)
+(%autoprove logic.all-atomicp-of-strip-conclusions-removal
+            (%restrict default logic.all-atomicp-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
+(%autoadmit logic.all-disjunctionsp-of-strip-conclusions)
+(%autoprove logic.all-disjunctionsp-of-strip-conclusions-removal
+            (%restrict default logic.all-disjunctionsp-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
+(%autoadmit logic.all-atomicp-of-vrhses-of-strip-conclusions)
+(%autoprove logic.all-atomicp-of-vrhses-of-strip-conclusions-removal
+            (%restrict default logic.all-atomicp-of-vrhses-of-strip-conclusions (equal x 'x))
+            (%cdr-induction x))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/hypbox-arities.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/hypbox-arities.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/hypbox-arities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/hypbox-arities.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,80 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hypboxp")
+(%interactive)
+
+(%autoadmit rw.slow-hypbox-arities)
+(%autoadmit rw.hypbox-arities)
+
+(%autoprove true-listp-of-rw.hypbox-arities
+            (%enable default rw.hypbox-arities))
+
+(%autoprove rw.hypbox-arities-removal
+            (%enable default rw.hypbox-arities rw.slow-hypbox-arities))
+
+(%autoprove rw.slow-hypbox-arities-correct
+            (%forcingp nil)
+            (%enable default
+                     rw.hypbox-arities
+                     rw.slow-hypbox-arities
+                     rw.hypbox-atblp))
+
+(%autoadmit rw.fast-hypbox-atblp)
+
+(%autoprove rw.fast-hypbox-atblp-removal
+            (%enable default rw.fast-hypbox-atblp))
+
+
+
+(%autoadmit rw.slow-hypbox-list-arities)
+(%autoadmit rw.hypbox-list-arities)
+
+(%autoprove true-listp-of-rw.hypbox-list-arities
+            (%autoinduct rw.hypbox-list-arities)
+            (%restrict default rw.hypbox-list-arities (equal x 'x)))
+
+(%autoprove rw.hypbox-list-arities-removal
+            (%autoinduct rw.hypbox-list-arities)
+            (%restrict default rw.hypbox-list-arities (equal x 'x))
+            (%restrict default rw.slow-hypbox-list-arities (equal x 'x)))
+
+(%autoprove rw.slow-hypbox-list-arities-correct
+            (%cdr-induction x)
+            (%restrict default rw.slow-hypbox-list-arities (equal x 'x)))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/hypbox-arities")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/hypboxp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/hypboxp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/hypboxp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/hypboxp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,95 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%autoadmit rw.hypboxp)
+(%autoadmit rw.hypbox)
+(%autoadmit rw.hypbox->left)
+(%autoadmit rw.hypbox->right)
+
+(encapsulate
+ ()
+ (local (%enable default rw.hypboxp rw.hypbox rw.hypbox->left rw.hypbox->right))
+ (%autoprove booleanp-of-rw.hypboxp)
+ (%autoprove forcing-rw.hypboxp-of-rw.hypbox)
+ (%autoprove rw.hypbox->left-of-rw.hypbox)
+ (%autoprove rw.hypbox->right-of-rw.hypbox)
+ (%autoprove forcing-logic.term-listp-of-rw.hypbox->left)
+ (%autoprove forcing-logic.term-listp-of-rw.hypbox->right)
+ (%autoprove forcing-true-listp-of-rw.hypbox->left)
+ (%autoprove forcing-true-listp-of-rw.hypbox->right)
+ (%autoprove forcing-equal-of-rw.hypbox-one)
+ (%autoprove forcing-equal-of-rw.hypbox-two))
+
+(%autoadmit rw.hypbox-atblp)
+
+(encapsulate
+ ()
+ (local (%enable default rw.hypbox-atblp))
+ (%autoprove booleanp-of-rw.hypbox-atblp)
+ (%autoprove forcing-rw.hypbox-atblp-of-quote-nil)
+ (%autoprove forcing-logic.term-list-atblp-of-rw.hypbox->left)
+ (%autoprove forcing-logic.term-list-atblp-of-rw.hypbox->right)
+ (%autoprove forcing-rw.hypbox-atblp-of-rw.hypbox)
+ (%autoprove rw.hypbox-atblp-of-nil))
+
+(%autoadmit rw.hypbox-formula)
+(%autoprove forcing-logic.formulap-of-rw.hypbox-formula
+            (%enable default rw.hypbox-formula))
+(%autoprove forcing-logic.formula-atblp-of-rw.hypbox-formula
+            (%enable default rw.hypbox-formula))
+
+
+(%deflist rw.hypbox-listp (x)
+  (rw.hypboxp x))
+
+(%deflist rw.hypbox-list-atblp (x atbl)
+  (rw.hypbox-atblp x atbl))
+
+(%autoadmit logic.true-term-listp)
+
+(%autoprove logic.true-term-listp-removal
+            (%cdr-induction x)
+            (%restrict default logic.true-term-listp (equal x 'x)))
+
+(%autoadmit rw.faster-hypboxp)
+
+(%autoprove rw.faster-hypboxp-removal
+            (%enable default rw.faster-hypboxp rw.hypboxp))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/hypboxp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/if-lemmas.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/if-lemmas.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/if-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/if-lemmas.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,61 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%deftheorem rw.theorem-iff-implies-pequal-if-1)
+(%deftheorem rw.theorem-equal-implies-pequal-if-2)
+(%deftheorem rw.theorem-equal-implies-pequal-if-3)
+
+(%deftheorem rw.theorem-iff-implies-equal-if-combined)
+(%deftheorem rw.theorem-iff-implies-iff-if-2)
+(%deftheorem rw.theorem-iff-implies-iff-if-3)
+(%deftheorem rw.theorem-iff-implies-iff-if-combined)
+
+(%deftheorem rw.theorem-iff-implies-equal-if-specialcase-nil)
+(%deftheorem rw.theorem-iff-implies-iff-if-specialcase-nil)
+(%deftheorem rw.theorem-iff-implies-equal-if-specialcase-t)
+(%deftheorem rw.theorem-iff-implies-iff-if-specialcase-t)
+
+(%deftheorem rw.theorem-equal-of-if-x-y-y)
+(%deftheorem rw.theorem-iff-of-if-x-y-y)
+
+(%defderiv rw.two-modus-ponens :omit-okp t)
+(%defderiv rw.two-disjoined-modus-ponens :omit-okp t)
+(%defderiv rw.three-modus-ponens :omit-okp t)
+(%defderiv rw.three-disjoined-modus-ponens :omit-okp t)
+(%defderiv rw.mp-mp2-mp :omit-okp t)
+(%defderiv rw.disjoined-mp-mp2-mp :omit-okp t)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/lambda-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/lambda-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/lambda-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/lambda-1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,224 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fuse")
+(%interactive)
+
+
+
+(defthm equal-of-first-index-and-n-when-len-alt
+  ;; BOZO put this somewhere better.
+  (implies (equal (len x) n)
+           (equal (equal n (first-index a x))
+                  (not (memberp a x)))))
+
+(%autoprove equal-of-first-index-and-n-when-len-alt
+            (%use (%instance (%thm equal-of-first-index-and-n-when-len))))
+
+(%defderiv build.dual-substitution-lemma-1)
+(%autoadmit build.flag-dual-substitution)
+(%autoadmit build.dual-substitution)
+(%autoadmit build.dual-substitution-list)
+
+(%autoprove definition-of-build.dual-substitution
+            (%restrict default build.flag-dual-substitution (equal x 'x))
+            (%enable default
+                     build.dual-substitution
+                     build.dual-substitution-list))
+
+(%autoprove definition-of-build.dual-substitution-list
+            (%restrict default build.flag-dual-substitution (equal x 'x))
+            (%enable default
+                     build.dual-substitution
+                     build.dual-substitution-list))
+
+(%autoprove build.flag-dual-substitution-of-term-removal
+            (%enable default build.dual-substitution))
+
+(%autoprove build.flag-dual-substitution-of-list-removal
+            (%enable default build.dual-substitution-list))
+
+(%autoprove build.dual-substitution-under-iff
+            (%restrict default definition-of-build.dual-substitution (equal x 'x)))
+
+(%autoprove build.dual-substitution-list-when-not-consp
+            (%restrict default definition-of-build.dual-substitution-list (equal x 'x)))
+
+(%autoprove build.dual-substitution-list-of-cons
+            (%restrict default definition-of-build.dual-substitution-list (equal x '(cons a x))))
+
+(%autoprove len-of-build.dual-substitution-list
+            (%cdr-induction x))
+
+
+
+(defmacro %build.flag-dual-substitution-induction (flag x vars proofs)
+  `(%induct (rank ,x)
+
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+
+            ((and (equal ,flag 'term)
+                  (logic.variablep ,x))
+             nil)
+
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x))
+             (((,flag 'list)
+               (,x (logic.function-args ,x))
+               (,vars ,vars)
+               (,proofs ,proofs))))
+
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+
+             (((,flag 'list)
+               (,x (logic.lambda-actuals ,x))
+               (,vars ,vars)
+               (,proofs ,proofs))
+              ((,flag 'term)
+               (,x (logic.lambda-body ,x))
+               (,vars (logic.lambda-formals ,x))
+               (,proofs (build.dual-substitution-list (logic.lambda-actuals ,x) ,vars ,proofs)))))
+
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)
+
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term) (,x (car ,x)) (,vars ,vars) (,proofs ,proofs))
+              ((,flag 'list) (,x (cdr ,x)) (,vars ,vars) (,proofs ,proofs))))
+
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)))
+
+
+
+(%autoprove lemma-for-forcing-logic.appealp-of-build.dual-substitution
+            ;; with manual induction -- 100m; with autoinduction -- 176m
+            (%build.flag-dual-substitution-induction flag x vars proofs)
+            (%auto :strategy (cleanup urewrite split))
+            (%restrict default definition-of-build.dual-substitution (equal x 'x))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.appealp-of-build.dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.dual-substitution)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.appealp-listp-of-build.dual-substitution-list
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.dual-substitution)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.conclusion-of-build.dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.dual-substitution)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.strip-conclusions-of-build.dual-substitution-list
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.dual-substitution)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.proofp-of-build.dual-substitution
+            ;; (%build.flag-dual-substitution-induction flag x vars proofs)
+            (%autoinduct build.flag-dual-substitution)
+            (%auto :strategy (cleanup urewrite split))
+            (%restrict default definition-of-build.dual-substitution (equal x 'x))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.proofp-of-build.dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-build.dual-substitution)
+                             (flag 'term)))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.proof-listp-of-build.dual-substitution-list
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-build.dual-substitution)
+                             (flag 'list)))
+            (%auto :strategy (cleanup urewrite split)))
+
+
+
+(defsection build.lambda-pequal-by-args
+  (%autoadmit build.lambda-pequal-by-args)
+  (local (%enable default build.lambda-pequal-by-args))
+  (%autoprove build.lambda-pequal-by-args-under-iff)
+  (%autoprove forcing-logic.appealp-of-build.lambda-pequal-by-args)
+  (%autoprove forcing-logic.conclusion-of-build.lambda-pequal-by-args)
+  (%autoprove forcing-logic.proofp-of-build.lambda-pequal-by-args))
+
+
+
+(defsection build.lambda-pequal-by-args-okp
+
+  (%autoadmit build.lambda-pequal-by-args-okp)
+
+  (%autoprove booleanp-of-build.lambda-pequal-by-args-okp
+              (%enable default build.lambda-pequal-by-args-okp))
+
+  (%autoprove build.lambda-pequal-by-args-okp-of-logic.appeal-identity
+              (%enable default build.lambda-pequal-by-args-okp))
+
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+
+  (%autoprove lemma-1-for-soundness-of-build.lambda-pequal-by-args-okp
+              (%enable default build.lambda-pequal-by-args-okp))
+
+  (%autoprove lemma-2-for-soundness-of-build.lambda-pequal-by-args-okp
+              (%enable default build.lambda-pequal-by-args-okp))
+
+  (%autoprove forcing-soundness-of-build.lambda-pequal-by-args-okp
+              (%enable default
+                       lemma-1-for-soundness-of-build.lambda-pequal-by-args-okp
+                       lemma-2-for-soundness-of-build.lambda-pequal-by-args-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (build.lambda-pequal-by-args
+                                   (first (logic.extras x))
+                                   (second (logic.extras x))
+                                   (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                axioms thms atbl)))))
+              (%auto :strategy (cleanup split crewrite))
+              (%enable default build.lambda-pequal-by-args-okp)
+              (%auto :strategy (cleanup split crewrite))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/lambda-2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/lambda-2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/lambda-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/lambda-2.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,215 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lambda-1")
+(%interactive)
+
+
+(%defderiv build.disjoined-dual-substitution-lemma-1 :omit-okp t)
+
+(%autoadmit build.flag-disjoined-dual-substitution)
+(%autoadmit build.disjoined-dual-substitution)
+(%autoadmit build.disjoined-dual-substitution-list)
+
+(%autoprove definition-of-build.disjoined-dual-substitution
+            (%restrict default build.flag-disjoined-dual-substitution (equal x 'x))
+            (%enable default
+                     build.disjoined-dual-substitution
+                     build.disjoined-dual-substitution-list))
+
+(%autoprove definition-of-build.disjoined-dual-substitution-list
+            (%restrict default build.flag-disjoined-dual-substitution (equal x 'x))
+            (%enable default
+                     build.disjoined-dual-substitution
+                     build.disjoined-dual-substitution-list))
+
+(%autoprove build.flag-disjoined-dual-substitution-of-term-removal
+            (%enable default build.disjoined-dual-substitution))
+
+(%autoprove build.flag-disjoined-dual-substitution-of-list-removal
+            (%enable default build.disjoined-dual-substitution-list))
+
+(%autoprove forcing-build.disjoined-dual-substitution-under-iff
+            (%restrict default definition-of-build.disjoined-dual-substitution (equal x 'x)))
+
+(%autoprove build.disjoined-dual-substitution-list-when-not-consp
+            (%restrict default definition-of-build.disjoined-dual-substitution-list (equal x 'x)))
+
+(%autoprove build.disjoined-dual-substitution-list-of-cons
+            (%restrict default definition-of-build.disjoined-dual-substitution-list (equal x '(cons a x))))
+
+(%autoprove len-of-build.disjoined-dual-substitution-list
+            (%cdr-induction x))
+
+
+(defmacro %build.flag-disjoined-dual-substitution-induction (flag x vars p proofs)
+  `(%induct (rank ,x)
+
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+
+            ((and (equal ,flag 'term)
+                  (logic.variablep ,x))
+             nil)
+
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x))
+             (((,flag 'list)
+               (,x (logic.function-args ,x))
+               (,vars ,vars)
+               (,proofs ,proofs))))
+
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+
+             (((,flag 'list)
+               (,x (logic.lambda-actuals ,x))
+               (,vars ,vars)
+               (,p ,p)
+               (,proofs ,proofs))
+              ((,flag 'term)
+               (,x    (logic.lambda-body ,x))
+               (,vars (logic.lambda-formals ,x))
+               (,p ,p)
+               (,proofs (build.disjoined-dual-substitution-list (logic.lambda-actuals ,x) ,vars ,p ,proofs)))))
+
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)
+
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term) (,x (car ,x)) (,vars ,vars) (,proofs ,proofs))
+              ((,flag 'list) (,x (cdr ,x)) (,vars ,vars) (,proofs ,proofs))))
+
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)))
+
+(%autoprove lemma-for-forcing-logic.appealp-of-build.disjoined-dual-substitution
+            (%build.flag-disjoined-dual-substitution-induction flag x vars p proofs)
+            (%auto :strategy (cleanup urewrite split))
+            (%restrict default definition-of-build.disjoined-dual-substitution (equal x 'x))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.appealp-of-build.disjoined-dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-dual-substitution)
+                             (flag 'term)))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.conclusion-of-build.disjoined-dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-dual-substitution)
+                             (flag 'term)))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.appeal-listp-of-build.disjoined-dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-dual-substitution)
+                             (flag 'list)))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.strip-conclusions-of-build.disjoined-dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-build.disjoined-dual-substitution)
+                             (flag 'list)))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove lemma-for-forcing-logic.proofp-of-build.disjoined-dual-substitution
+            (%build.flag-disjoined-dual-substitution-induction flag x vars p proofs)
+            (%auto :strategy (cleanup urewrite split))
+            (%restrict default definition-of-build.disjoined-dual-substitution (equal x 'x))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.proofp-of-build.disjoined-dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-build.disjoined-dual-substitution)
+                             (flag 'term)))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-logic.proof-listp-of-build.disjoined-dual-substitution
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-build.disjoined-dual-substitution)
+                             (flag 'list)))
+            (%auto :strategy (cleanup urewrite split)))
+
+
+
+(defsection build.disjoined-lambda-pequal-by-args
+  (%autoadmit build.disjoined-lambda-pequal-by-args)
+  (local (%enable default build.disjoined-lambda-pequal-by-args))
+  (%autoprove forcing-build.disjoined-lambda-pequal-by-args-under-iff)
+  (%autoprove forcing-logic.appealp-of-build.disjoined-lambda-pequal-by-args)
+  (%autoprove forcing-logic.conclusion-of-build.disjoined-lambda-pequal-by-args)
+  (%autoprove forcing-logic.proofp-of-build.disjoined-lambda-pequal-by-args))
+
+
+
+
+(defsection build.disjoined-lambda-pequal-by-args-okp
+
+  (%autoadmit build.disjoined-lambda-pequal-by-args-okp)
+
+  (%autoprove booleanp-of-build.disjoined-lambda-pequal-by-args-okp
+              (%enable default build.disjoined-lambda-pequal-by-args-okp))
+
+  (%autoprove build.disjoined-lambda-pequal-by-args-okp-of-logic.appeal-identity
+              (%enable default build.disjoined-lambda-pequal-by-args-okp))
+
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+
+  (%autoprove lemma-1-for-soundness-of-build.disjoined-lambda-pequal-by-args-okp
+              (%enable default build.disjoined-lambda-pequal-by-args-okp))
+
+  (%autoprove lemma-2-for-soundness-of-build.disjoined-lambda-pequal-by-args-okp
+              (%enable default build.disjoined-lambda-pequal-by-args-okp))
+
+  (%autoprove forcing-soundness-of-build.disjoined-lambda-pequal-by-args-okp
+              (%enable default
+                       lemma-1-for-soundness-of-build.disjoined-lambda-pequal-by-args-okp
+                       lemma-2-for-soundness-of-build.disjoined-lambda-pequal-by-args-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (build.disjoined-lambda-pequal-by-args
+                                   (first (logic.extras x))
+                                   (second (logic.extras x))
+                                   (logic.vlhs (logic.conclusion x))
+                                   (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                axioms thms atbl)))))
+              (%auto :strategy (cleanup split crewrite))
+              (%enable default build.disjoined-lambda-pequal-by-args-okp)
+              (%auto :strategy (cleanup split crewrite))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/level5.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/level5.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/level5.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/level5.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,184 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-compiler")
+(include-book "contradiction-bldr")
+(include-book "update-clause-bldr")
+(include-book "disjoined-update-clause-bldr")
+(include-book "update-clause-iff-bldr")
+(include-book "lambda-2")
+(include-book "aux-split-negative")
+(include-book "basic-if-lemmas")
+(include-book "urewrite-if-lemmas")
+(include-book "crewrite-if-lemmas")
+(include-book "crewrite-if-lemmas2")
+(%interactive)
+
+
+(%autoadmit level5.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level5.step-okp))
+ (%autoprove soundness-of-level5.step-okp)
+ (%autoprove level5.step-okp-when-level4.step-okp
+             (%forcingp nil)
+             (%auto)
+             (%enable default level4.step-okp)
+             (%auto)
+             (%enable default level3.step-okp)
+             (%auto)
+             (%enable default level2.step-okp)
+             (%auto)
+             (%enable default logic.appeal-step-okp))
+ (%autoprove level5.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%disable default forcing-true-listp-of-logic.subproofs))
+ (%autoadmit level5.flag-proofp-aux))
+
+(%autoadmit level5.proofp-aux)
+(%autoadmit level5.proof-listp-aux)
+(%autoprove definition-of-level5.proofp-aux
+            (%enable default level5.proofp-aux level5.proof-listp-aux)
+            (%restrict default level5.flag-proofp-aux (equal x 'x)))
+(%autoprove definition-of-level5.proof-listp-aux
+            (%enable default level5.proofp-aux level5.proof-listp-aux)
+            (%restrict default level5.flag-proofp-aux (equal x 'x)))
+
+
+(%autoprove level5.proofp-aux-when-not-consp      (%restrict default definition-of-level5.proofp-aux (equal x 'x)))
+(%autoprove level5.proof-listp-aux-when-not-consp (%restrict default definition-of-level5.proof-listp-aux (equal x 'x)))
+(%autoprove level5.proof-listp-aux-of-cons        (%restrict default definition-of-level5.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level5.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level5.proofp-aux (equal x 'x)))
+
+(%autoprove booleanp-of-level5.proofp-aux      (%use (%instance (%thm lemma-for-booleanp-of-level5.proofp-aux) (flag 'proof))))
+(%autoprove booleanp-of-level5.proof-listp-aux (%use (%instance (%thm lemma-for-booleanp-of-level5.proofp-aux) (flag 'list))))
+
+
+(%deflist level5.proof-listp-aux (x axioms thms atbl)
+          (level5.proofp-aux x axioms thms atbl))
+
+(%autoprove lemma-for-logic.provablep-when-level5.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto :strategy (cleanup urewrite split))
+            (%restrict default definition-of-level5.proofp-aux (equal x 'x))
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove logic.provablep-when-level5.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level5.proofp-aux) (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level5.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level5.proofp-aux) (flag 'list))))
+
+
+
+(%autoprove lemma-for-level5.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level5.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove level5.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level5.proofp-aux-when-logic.proofp) (flag 'proof))))
+
+(%autoprove level5.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level5.proofp-aux-when-logic.proofp) (flag 'list))))
+
+(%autoprove forcing-level5.proofp-aux-of-logic.provable-witness
+            (%enable default level5.proofp-aux-when-logic.proofp))
+
+
+
+(%autoadmit level5.proofp)
+(%autoprove booleanp-of-level5.proofp
+            (%enable default level5.proofp))
+(%autoprove logic.provablep-when-level5.proofp
+            (%enable default level5.proofp))
+
+
+(defsection level5-transition
+  (%install-new-proofp level5.proofp)
+  (%auto)
+  (%qed-install))
+
+
+(%switch-builder rw.eqtrace-bldr                                         rw.eqtrace-bldr-high)
+(%switch-builder rw.eqtrace-contradiction-bldr                           rw.eqtrace-contradiction-bldr-high)
+(%switch-builder clause.update-clause-bldr                               clause.update-clause-bldr-high)
+(%switch-builder clause.update-clause-iff-bldr                           clause.update-clause-iff-bldr-high)
+(%switch-builder clause.disjoined-update-clause-bldr                     clause.disjoined-update-clause-bldr-high)
+(%switch-builder build.lambda-pequal-by-args                             build.lambda-pequal-by-args-high)
+(%switch-builder build.disjoined-lambda-pequal-by-args                   build.disjoined-lambda-pequal-by-args-high)
+(%switch-builder clause.aux-split-negative-1-bldr                        clause.aux-split-negative-1-bldr-high)
+(%switch-builder clause.aux-split-negative-2-bldr                        clause.aux-split-negative-2-bldr-high)
+(%switch-builder rw.iff-implies-equal-if-specialcase-nil-bldr            rw.iff-implies-equal-if-specialcase-nil-bldr-high)
+(%switch-builder rw.iff-implies-iff-if-specialcase-nil-bldr              rw.iff-implies-iff-if-specialcase-nil-bldr-high)
+(%switch-builder rw.iff-implies-equal-if-specialcase-t-bldr              rw.iff-implies-equal-if-specialcase-t-bldr-high)
+(%switch-builder rw.iff-implies-iff-if-specialcase-t-bldr                rw.iff-implies-iff-if-specialcase-t-bldr-high)
+(%switch-builder rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr  rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr-high)
+(%switch-builder rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr    rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr-high)
+(%switch-builder rw.disjoined-iff-implies-equal-if-specialcase-t-bldr    rw.disjoined-iff-implies-equal-if-specialcase-t-bldr-high)
+(%switch-builder rw.disjoined-iff-implies-iff-if-specialcase-t-bldr      rw.disjoined-iff-implies-iff-if-specialcase-t-bldr-high)
+(%switch-builder rw.iff-implies-equal-if-bldr                            rw.iff-implies-equal-if-bldr-high)
+(%switch-builder rw.iff-implies-iff-if-bldr                              rw.iff-implies-iff-if-bldr-high)
+(%switch-builder rw.equal-of-if-x-y-y-bldr                               rw.equal-of-if-x-y-y-bldr-high)
+(%switch-builder rw.iff-of-if-x-y-y-bldr                                 rw.iff-of-if-x-y-y-bldr-high)
+(%switch-builder rw.disjoined-iff-implies-equal-if-bldr                  rw.disjoined-iff-implies-equal-if-bldr-high)
+(%switch-builder rw.disjoined-iff-implies-iff-if-bldr                    rw.disjoined-iff-implies-iff-if-bldr-high)
+(%switch-builder rw.disjoined-equal-of-if-x-y-y-bldr                     rw.disjoined-equal-of-if-x-y-y-bldr-high)
+(%switch-builder rw.disjoined-iff-of-if-x-y-y-bldr                       rw.disjoined-iff-of-if-x-y-y-bldr-high)
+
+
+;; At this point we laso switch to using a split limit, due to the tradeoffs in proof sizes.
+
+(%splitlimit 8)
+
+
+
+(%finish "level5")
+(%save-events "level5.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level5/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/make-image.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level4/level4")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level5-symmetry"
+                 "Preloaded bootstrap/level4 directory.")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/negative-iff-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/negative-iff-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/negative-iff-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/negative-iff-eqtrace-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,81 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(%interactive)
+
+(%defderiv rw.negative-iff-eqtrace-nhyp-bldr-lemma-1 :omit-okp t)
+
+(defsection rw.negative-iff-eqtrace-nhyp-bldr
+  (%autoadmit rw.negative-iff-eqtrace-nhyp-bldr)
+  (local (%enable default
+                  rw.negative-iff-eqtrace
+                  rw.negative-iff-eqtrace-nhyp-bldr
+                  theorem-not-when-nil
+                  theorem-iff-t-when-not-nil
+                  logic.term-formula))
+  (local (%disable default
+                   forcing-equal-of-logic.pequal-rewrite-two
+                   forcing-equal-of-logic.pequal-rewrite
+                   forcing-equal-of-logic.por-rewrite-two
+                   forcing-equal-of-logic.por-rewrite
+                   forcing-equal-of-logic.pnot-rewrite-two
+                   forcing-equal-of-logic.pnot-rewrite))
+  (%autoprove rw.negative-iff-eqtrace-nhyp-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.negative-iff-eqtrace-nhyp-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.negative-iff-eqtrace-nhyp-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.negative-iff-eqtrace-nhyp-bldr))
+
+(defsection rw.negative-iff-eqtrace-bldr
+  (%autoadmit rw.negative-iff-eqtrace-bldr)
+  (local (%enable default
+                  rw.negative-iff-eqtrace-bldr
+                  rw.negative-iff-eqtrace-okp
+                  rw.hypbox-formula
+                  rw.eqtrace-formula))
+  (%autoprove rw.negative-iff-eqtrace-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.negative-iff-eqtrace-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.negative-iff-eqtrace-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.negative-iff-eqtrace-bldr))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/negative-iff-eqtrace-bldr"
+                                         ;; omit-ok stuff
+                                         booleanp-of-rw.negative-iff-eqtrace-nhyp-bldr-lemma-1-okp
+                                         rw.negative-iff-eqtrace-nhyp-bldr-lemma-1-okp-of-logic.appeal-identity
+                                         lemma-1-for-soundness-of-rw.negative-iff-eqtrace-nhyp-bldr-lemma-1-okp
+                                         lemma-2-for-soundness-of-rw.negative-iff-eqtrace-nhyp-bldr-lemma-1-okp
+                                         forcing-soundness-of-rw.negative-iff-eqtrace-nhyp-bldr-lemma-1-okp)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/negative-iff-eqtrace.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/negative-iff-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/negative-iff-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/negative-iff-eqtrace.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,78 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(%interactive)
+
+(defsection rw.negative-iff-eqtrace
+  (%autoadmit rw.negative-iff-eqtrace)
+  (local (%enable default rw.negative-iff-eqtrace))
+  (%autoprove forcing-rw.eqtrace->method-of-rw.negative-iff-eqtrace)
+  (%autoprove forcing-rw.eqtrace->iffp-of-rw.negative-iff-eqtrace)
+  (%autoprove forcing-rw.eqtrace->subtraces-of-rw.negative-iff-eqtrace)
+  (%autoprove forcing-rw.eqtracep-of-rw.negative-iff-eqtrace)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.negative-iff-eqtrace)
+  (%autoprove rw.negative-iff-eqtrace-normalize-okp-1)
+  (%autoprove rw.negative-iff-eqtrace-normalize-okp-2)
+  (%autoprove rw.negative-iff-eqtrace-normalize-okp-3))
+
+
+(defsection rw.find-nhyp-for-negative-iff-eqtracep
+  (%autoadmit rw.find-nhyp-for-negative-iff-eqtracep)
+  (local (%restrict default rw.find-nhyp-for-negative-iff-eqtracep (equal nhyps 'nhyps)))
+  (%autoprove rw.find-nhyp-for-negative-iff-eqtracep-of-nil
+              (%restrict default rw.find-nhyp-for-negative-iff-eqtracep (equal nhyps ''nil)))
+  (%autoprove forcing-logic.termp-of-rw.find-nhyp-for-negative-iff-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-logic.term-atblp-of-rw.find-nhyp-for-negative-iff-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-memberp-of-rw.find-nhyp-for-negative-iff-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-rw.negative-iff-eqtrace-of-rw.find-nhyp-for-negative-iff-eqtracep
+              (%cdr-induction nhyps)))
+
+(defsection rw.negative-iff-eqtrace-okp
+  (%autoadmit rw.negative-iff-eqtrace-okp)
+  (local (%enable default rw.negative-iff-eqtrace-okp))
+  (%autoprove booleanp-of-rw.negative-iff-eqtrace-okp)
+  (%autoprove lemma-for-forcing-rw.negative-iff-eqtrace-okp-rw.negative-iff-eqtrace
+              (%restrict default rw.find-nhyp-for-negative-iff-eqtracep (equal nhyps 'nhyps))
+              (%cdr-induction nhyps))
+  (%autoprove forcing-rw.negative-iff-eqtrace-okp-rw.negative-iff-eqtrace
+              (%enable default lemma-for-forcing-rw.negative-iff-eqtrace-okp-rw.negative-iff-eqtrace)
+              (%disable default rw.negative-iff-eqtrace-normalize-okp-1)))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/negative-iff-eqtrace")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/primary-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/primary-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/primary-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/primary-eqtrace-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,85 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(%interactive)
+
+(%defderiv rw.primary-eqtrace-nhyp-bldr-lemma-1 :omit-okp t)
+(%defderiv rw.primary-eqtrace-nhyp-bldr-lemma-2 :omit-okp t)
+
+(defsection rw.primary-eqtrace-nhyp-bldr
+  (%autoadmit rw.primary-eqtrace-nhyp-bldr)
+  (local (%disable default
+                   forcing-equal-of-logic.pequal-rewrite-two
+                   forcing-equal-of-logic.pequal-rewrite
+                   forcing-equal-of-logic.por-rewrite-two
+                   forcing-equal-of-logic.por-rewrite
+                   forcing-equal-of-logic.pnot-rewrite-two
+                   forcing-equal-of-logic.pnot-rewrite))
+  (local (%enable default
+                  rw.primary-eqtrace
+                  rw.primary-eqtrace-nhyp-bldr
+                  theorem-not-when-nil
+                  logic.term-formula))
+  (%autoprove rw.primary-eqtrace-nhyp-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.primary-eqtrace-nhyp-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.primary-eqtrace-nhyp-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.primary-eqtrace-nhyp-bldr))
+
+(defsection rw.primary-eqtrace-bldr
+  (%autoadmit rw.primary-eqtrace-bldr)
+  (local (%enable default
+                  rw.primary-eqtrace-bldr
+                  rw.primary-eqtrace-okp
+                  rw.hypbox-formula
+                  rw.eqtrace-formula))
+  (%autoprove rw.primary-eqtrace-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.primary-eqtrace-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.primary-eqtrace-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.primary-eqtrace-bldr))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/primary-eqtrace-bldr"
+
+                                         BOOLEANP-OF-RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-1-OKP
+                                         RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-1-OKP-OF-LOGIC.APPEAL-IDENTITY
+                                         LEMMA-1-FOR-SOUNDNESS-OF-RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-1-OKP
+                                         LEMMA-2-FOR-SOUNDNESS-OF-RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-1-OKP
+                                         FORCING-SOUNDNESS-OF-RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-1-OKP
+
+                                         BOOLEANP-OF-RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-2-OKP
+                                         RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-2-OKP-OF-LOGIC.APPEAL-IDENTITY
+                                         LEMMA-1-FOR-SOUNDNESS-OF-RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-2-OKP
+                                         LEMMA-2-FOR-SOUNDNESS-OF-RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-2-OKP
+                                         FORCING-SOUNDNESS-OF-RW.PRIMARY-EQTRACE-NHYP-BLDR-LEMMA-2-OKP)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/primary-eqtrace.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/primary-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/primary-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/primary-eqtrace.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,74 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(%interactive)
+
+(defsection rw.primary-eqtrace
+  (%autoadmit rw.primary-eqtrace)
+  (local (%enable default rw.primary-eqtrace))
+  (%autoprove forcing-rw.eqtrace->method-of-rw.primary-eqtrace)
+  (%autoprove forcing-rw.eqtrace->iffp-of-rw.primary-eqtrace)
+  (%autoprove forcing-rw.eqtrace->subtraces-of-rw.primary-eqtrace)
+  (%autoprove forcing-rw.eqtracep-of-rw.primary-eqtrace)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.primary-eqtrace)
+  (%autoprove rw.primary-eqtrace-normalize-okp-1)
+  (%autoprove rw.primary-eqtrace-normalize-okp-2)
+  (%autoprove rw.primary-eqtrace-normalize-okp-3))
+
+(defsection rw.find-nhyp-for-primary-eqtracep
+  (%autoadmit rw.find-nhyp-for-primary-eqtracep)
+  (local (%restrict default rw.find-nhyp-for-primary-eqtracep (equal nhyps 'nhyps)))
+  (%autoprove rw.find-nhyp-for-primary-eqtracep-of-nil
+              (%restrict default rw.find-nhyp-for-primary-eqtracep (equal nhyps ''nil)))
+  (%autoprove forcing-logic.termp-of-rw.find-nhyp-for-primary-eqtracep (%cdr-induction nhyps))
+  (%autoprove forcing-logic.term-atblp-of-rw.find-nhyp-for-primary-eqtracep (%cdr-induction nhyps))
+  (%autoprove forcing-memberp-of-rw.find-nhyp-for-primary-eqtracep (%cdr-induction nhyps))
+  (%autoprove forcing-rw.primary-eqtrace-of-rw.find-nhyp-for-primary-eqtracep (%cdr-induction nhyps)))
+
+(defsection rw.primary-eqtrace-okp
+  (%autoadmit rw.primary-eqtrace-okp)
+  (local (%enable default rw.primary-eqtrace-okp))
+  (%autoprove booleanp-of-rw.primary-eqtrace-okp)
+  (%autoprove lemma-for-forcing-rw.primary-eqtrace-okp-rw.primary-eqtrace
+              (%cdr-induction nhyps)
+              (%restrict default rw.find-nhyp-for-primary-eqtracep (equal nhyps 'nhyps)))
+  (%autoprove forcing-rw.primary-eqtrace-okp-rw.primary-eqtrace
+              (%enable default lemma-for-forcing-rw.primary-eqtrace-okp-rw.primary-eqtrace)
+              (%disable default rw.primary-eqtrace-normalize-okp-1))
+  )
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/primary-eqtrace")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/secondary-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/secondary-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/secondary-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/secondary-eqtrace-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,70 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(%interactive)
+
+(defsection rw.secondary-eqtrace-nhyp-bldr
+  (%autoadmit rw.secondary-eqtrace-nhyp-bldr)
+  (local (%enable default
+                  rw.secondary-eqtrace
+                  rw.secondary-eqtrace-nhyp-bldr
+                  logic.term-formula))
+  (local (%enable default
+                  forcing-equal-of-logic.pequal-rewrite-two
+                  forcing-equal-of-logic.pequal-rewrite
+                  forcing-equal-of-logic.por-rewrite-two
+                  forcing-equal-of-logic.por-rewrite
+                  forcing-equal-of-logic.pnot-rewrite-two
+                  forcing-equal-of-logic.pnot-rewrite))
+  (%autoprove rw.secondary-eqtrace-nhyp-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.secondary-eqtrace-nhyp-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.secondary-eqtrace-nhyp-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.secondary-eqtrace-nhyp-bldr))
+
+(defsection rw.secondary-eqtrace-bldr
+  (%autoadmit rw.secondary-eqtrace-bldr)
+  (local (%enable default
+                  rw.secondary-eqtrace-bldr
+                  rw.secondary-eqtrace-okp
+                  rw.hypbox-formula
+                  rw.eqtrace-formula))
+  (%autoprove rw.secondary-eqtrace-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.secondary-eqtrace-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.secondary-eqtrace-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.secondary-eqtrace-bldr))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/secondary-eqtrace-bldr")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/secondary-eqtrace.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/secondary-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/secondary-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/secondary-eqtrace.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,88 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(%interactive)
+
+(defsection rw.secondary-eqtrace
+  (%autoadmit rw.secondary-eqtrace)
+  (local (%enable default rw.secondary-eqtrace))
+  (local (%disable default forcing-booleanp-of-rw.eqtrace->iffp))
+  (%autoprove forcing-rw.eqtrace->method-of-rw.secondary-eqtrace)
+  (%autoprove forcing-rw.eqtrace->iffp-of-rw.secondary-eqtrace)
+  (%autoprove forcing-rw.eqtrace->subtraces-of-rw.secondary-eqtrace)
+  (%autoprove forcing-rw.eqtracep-of-rw.secondary-eqtrace)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.secondary-eqtrace)
+  (%autoprove rw.secondary-eqtrace-normalize-okp-1)
+  (%autoprove rw.secondary-eqtrace-normalize-okp-2)
+  (%autoprove rw.secondary-eqtrace-normalize-okp-3))
+
+
+(defsection rw.find-nhyp-for-secondary-eqtracep
+  (%autoadmit rw.find-nhyp-for-secondary-eqtracep)
+  (local (%restrict default rw.find-nhyp-for-secondary-eqtracep (equal nhyps 'nhyps)))
+  (%autoprove rw.find-nhyp-for-secondary-eqtracep-of-nil
+              (%restrict default rw.find-nhyp-for-secondary-eqtracep (equal nhyps ''nil)))
+  (%autoprove forcing-logic.termp-of-rw.find-nhyp-for-secondary-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-logic.term-atblp-of-rw.find-nhyp-for-secondary-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-memberp-of-rw.find-nhyp-for-secondary-eqtracep
+              (%cdr-induction nhyps))
+  (%autoprove forcing-rw.secondary-eqtrace-of-rw.find-nhyp-for-secondary-eqtracep
+              (%cdr-induction nhyps)))
+
+(defsection rw.secondary-eqtrace-okp
+  (%autoadmit rw.secondary-eqtrace-okp)
+  (local (%enable default rw.secondary-eqtrace-okp))
+  (%autoprove booleanp-of-rw.secondary-eqtrace-okp)
+  (%autoprove lemma-1-for-forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace
+              (%enable default
+                       rw.secondary-eqtrace-okp
+                       rw.secondary-eqtrace
+                       rw.eqtrace))
+  (%autoprove lemma-2-for-forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace
+              (%cdr-induction nhyps)
+              (%restrict default rw.find-nhyp-for-secondary-eqtracep (equal nhyps 'nhyps))
+              (%noexec rw.secondary-eqtrace))
+  (%autoprove forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace
+              (%enable default
+                       lemma-1-for-forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace
+                       lemma-2-for-forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace)
+              (%disable default rw.secondary-eqtrace-normalize-okp-1)
+              ))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/secondary-eqtrace")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level5/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/symmetry	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level5-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/trans1-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/trans1-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/trans1-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/trans1-eqtrace-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,68 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(%interactive)
+
+(%autoprove lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr)
+(%autoprove lemma-2-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+            (%enable default lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr))
+(%autoprove lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr)
+(%autoprove lemma-4-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr)
+
+(defsection rw.trans1-eqtrace-bldr
+  (%autoadmit rw.trans1-eqtrace-bldr)
+  (local (%enable default
+                  rw.eqtrace-formula
+                  rw.trans1-eqtrace-bldr
+                  rw.trans1-eqtrace-okp
+                  lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-2-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-4-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr))
+
+  ;; Originally I didn't have this, but later changes to the rewriter exposed some
+  ;; kind of loop caused by this rule, which was horribly problematic.
+
+  (local (%disable default RW.EQTRACE->RHS-OF-SUB1-WHEN-RW.TRANS1-EQTRACE-OKP))
+  (%autoprove forcing-rw.trans1-eqtrace-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.trans1-eqtrace-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.trans1-eqtrace-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.trans1-eqtrace-bldr))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/trans1-eqtrace-bldr")
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/trans2-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/trans2-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/trans2-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/trans2-eqtrace-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,64 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trans1-eqtrace-bldr")
+(%interactive)
+
+(local (%max-proof-size 700000000))
+
+(defsection rw.trans2-eqtrace-bldr
+
+  (%autoadmit rw.trans2-eqtrace-bldr)
+
+  (local (%enable default
+                  rw.eqtrace-formula
+                  rw.trans2-eqtrace-bldr
+                  rw.trans2-eqtrace-okp))
+  (%autoprove rw.trans2-eqtrace-bldr-under-iff)
+  (local (%enable default
+                  lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-2-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-4-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr))
+
+  ;; this is looping with one of the recent rewriter changes
+  (local (%disable default RW.EQTRACE->LHS-OF-SUB1-WHEN-RW.TRANS2-EQTRACE-OKP))
+
+  (%autoprove forcing-logic.appealp-of-rw.trans2-eqtrace-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.trans2-eqtrace-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.trans2-eqtrace-bldr))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/trans2-eqtrace-bldr")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/trans3-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/trans3-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/trans3-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/trans3-eqtrace-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,59 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trans1-eqtrace-bldr")
+(%interactive)
+
+(defsection rw.trans3-eqtrace-bldr
+  (%autoadmit rw.trans3-eqtrace-bldr)
+  (local (%enable default
+                  rw.eqtrace-formula
+                  rw.trans3-eqtrace-bldr
+                  rw.trans3-eqtrace-okp
+                  lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-2-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-4-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr))
+  (%autoprove rw.trans3-eqtrace-bldr-under-iff)
+
+  ;; looping in new versions of the rewriter?
+  (local (%disable default RW.EQTRACE->RHS-OF-SUB1-WHEN-RW.TRANS3-EQTRACE-OKP))
+
+  (%autoprove forcing-logic.appealp-of-rw.trans3-eqtrace-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.trans3-eqtrace-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.trans3-eqtrace-bldr))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/trans3-eqtrace-bldr")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/transitivity-eqtraces.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/transitivity-eqtraces.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/transitivity-eqtraces.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/transitivity-eqtraces.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,106 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(%interactive)
+
+(defsection rw.trans1-eqtrace-okp
+  (%autoadmit rw.trans1-eqtrace-okp)
+  (%enable default rw.trans1-eqtrace-okp)
+  (%autoprove booleanp-of-rw.trans1-eqtrace-okp)
+  (%autoprove rw.eqtrace->rhs-of-sub1-when-rw.trans1-eqtrace-okp)
+  (%autoprove rw.eqtrace->lhs-of-sub1-when-rw.trans1-eqtrace-okp)
+  (%autoprove rw.eqtrace->rhs-of-sub2-when-rw.trans1-eqtrace-okp))
+
+(defsection rw.trans1-eqtrace
+  (%autoadmit rw.trans1-eqtrace)
+  (local (%enable default rw.trans1-eqtrace))
+  (%autoprove rw.eqtrace->method-of-rw.trans1-eqtrace)
+  (%autoprove rw.eqtrace->iffp-of-rw.trans1-eqtrace)
+  (%autoprove rw.eqtrace->lhs-of-rw.trans1-eqtrace)
+  (%autoprove rw.eqtrace->rhs-of-rw.trans1-eqtrace)
+  (%autoprove rw.eqtrace->subtraces-of-rw.trans1-eqtrace)
+  (%autoprove lemma-for-forcing-rw.eqtracep-of-rw.trans1-eqtrace
+              (%disable default forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs)
+              (%use (%instance (%thm forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs) (x x)))
+              (%use (%instance (%thm forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs) (x y))))
+  (%autoprove forcing-rw.eqtracep-of-rw.trans1-eqtrace
+              (%enable default lemma-for-forcing-rw.eqtracep-of-rw.trans1-eqtrace))
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.trans1-eqtrace)
+  (%autoprove forcing-rw.trans1-eqtrace-okp-of-rw.trans1-eqtrace))
+
+(defsection rw.trans2-eqtrace-okp
+  (%autoadmit rw.trans2-eqtrace-okp)
+  (local (%enable default rw.trans2-eqtrace-okp))
+  (%autoprove booleanp-of-rw.trans2-eqtrace-okp)
+  (%autoprove rw.eqtrace->lhs-of-sub1-when-rw.trans2-eqtrace-okp)
+  (%autoprove rw.eqtrace->rhs-of-sub1-when-rw.trans2-eqtrace-okp)
+  (%autoprove rw.eqtrace->rhs-of-sub2-when-rw.trans2-eqtrace-okp))
+
+(defsection rw.trans2-eqtrace
+  (%autoadmit rw.trans2-eqtrace)
+  (local (%enable default rw.trans2-eqtrace))
+  (%autoprove rw.eqtrace->method-of-rw.trans2-eqtrace)
+  (%autoprove rw.eqtrace->iffp-of-rw.trans2-eqtrace)
+  (%autoprove rw.eqtrace->lhs-of-rw.trans2-eqtrace)
+  (%autoprove rw.eqtrace->rhs-of-rw.trans2-eqtrace)
+  (%autoprove rw.eqtrace->subtraces-of-rw.trans2-eqtrace)
+  (%autoprove forcing-rw.eqtracep-of-rw.trans2-eqtrace)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.trans2-eqtrace)
+  (%autoprove forcing-rw.trans2-eqtrace-okp-of-rw.trans2-eqtrace
+              (%enable default rw.trans2-eqtrace-okp)))
+
+(defsection rw.trans3-eqtrace-okp
+  (%autoadmit rw.trans3-eqtrace-okp)
+  (local (%enable default rw.trans3-eqtrace-okp))
+  (%autoprove booleanp-of-rw.trans3-eqtrace-okp)
+  (%autoprove rw.eqtrace->rhs-of-sub1-when-rw.trans3-eqtrace-okp)
+  (%autoprove rw.eqtrace->lhs-of-sub1-when-rw.trans3-eqtrace-okp)
+  (%autoprove rw.eqtrace->lhs-of-sub2-when-rw.trans3-eqtrace-okp))
+
+(defsection rw.trans3-eqtrace
+  (%autoadmit rw.trans3-eqtrace)
+  (local (%enable default rw.trans3-eqtrace))
+  (%autoprove rw.eqtrace->method-of-rw.trans3-eqtrace)
+  (%autoprove rw.eqtrace->iffp-of-rw.trans3-eqtrace)
+  (%autoprove rw.eqtrace->lhs-of-rw.trans3-eqtrace)
+  (%autoprove rw.eqtrace->rhs-of-rw.trans3-eqtrace)
+  (%autoprove rw.eqtrace->subtraces-of-rw.trans3-eqtrace)
+  (%autoprove forcing-rw.eqtracep-of-rw.trans3-eqtrace)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.trans3-eqtrace)
+  (%autoprove forcing-rw.trans3-eqtrace-okp-of-rw.trans3-eqtrace
+              (%enable default rw.trans3-eqtrace-okp)))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/transitivity-eqtraces")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/update-clause-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/update-clause-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/update-clause-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/update-clause-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,177 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fuse")
+(%interactive)
+
+
+
+(defthm lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-bldr
+  ;; BOZO unlocalize in update-clause.lisp
+  (implies (and (logic.term-listp todo)
+                (logic.term-listp done)
+                (or (consp todo) (consp done))
+                (logic.appealp proof)
+                (logic.appeal-listp t-proofs)
+                (equal (logic.conclusion proof)
+                       (cond ((and (consp done) (consp todo))
+                              (logic.por (clause.clause-formula done)
+                                         (clause.clause-formula todo)))
+                             ((consp done)
+                              (clause.clause-formula done))
+                             (t
+                              (clause.clause-formula todo))))
+                (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                (equal (logic.=rhses (logic.strip-conclusions t-proofs)) todo))
+           (and (logic.appealp (clause.aux-update-clause-bldr todo done t-proofs proof))
+                (equal (logic.conclusion (clause.aux-update-clause-bldr todo done t-proofs proof))
+                       (clause.clause-formula (app (rev (logic.=lhses (logic.strip-conclusions t-proofs)))
+                                                   done)))))
+  :rule-classes nil)
+
+
+
+(%autoadmit clause.aux-update-clause-bldr)
+
+(defmacro %clause.aux-update-clause-bldr-induction (todo done t-proofs proof)
+  `(%induct (rank ,todo)
+            ((not (consp ,todo))
+             nil)
+            ((and (consp ,todo)
+                  (not (consp (cdr ,todo))))
+             nil)
+            ((and (consp ,todo)
+                  (consp (cdr ,todo))
+                  (not (consp ,done)))
+             (((,todo (cdr ,todo))
+               (,done (cons (logic.=lhs (logic.conclusion (car ,t-proofs))) ,done))
+               (,t-proofs (cdr ,t-proofs))
+               (,proof (clause.aux-update-clause-lemma1-bldr (build.commute-or ,proof) (car ,t-proofs))))))
+            ((and (consp ,todo)
+                  (consp (cdr ,todo))
+                  (consp ,done))
+             (((,todo (cdr ,todo))
+               (,done (cons (logic.=lhs (logic.conclusion (car ,t-proofs))) ,done))
+               (,t-proofs (cdr ,t-proofs))
+               (,proof (clause.aux-update-clause-lemma2-bldr ,proof (car ,t-proofs))))))))
+
+(%autoprove clause.aux-update-clause-bldr-under-iff
+            (%clause.aux-update-clause-bldr-induction todo done t-proofs proof)
+            (%restrict default clause.aux-update-clause-bldr (equal todo 'todo))
+            (%enable default logic.term-formula))
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-bldr
+            (%clause.aux-update-clause-bldr-induction todo done t-proofs proof)
+            (%restrict default clause.aux-update-clause-bldr (memberp todo '(todo 'nil)))
+            (%enable default logic.term-formula))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-update-clause-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-bldr))))
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-update-clause-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-bldr))))
+
+(%autoprove forcing-logic.proofp-of-clause.aux-update-clause-bldr
+            (%clause.aux-update-clause-bldr-induction todo done t-proofs proof)
+            (%restrict default clause.aux-update-clause-bldr (memberp todo '(todo 'nil)))
+            (%enable default logic.term-formula)
+            (%auto :strategy (cleanup split urewrite crewrite dist))
+            ;; Oh my, why do we have to do this ?!?  I guess ACL2's expansion heuristics are taking
+            ;; care of this for us, but I'm still surprised we need to consider these cases and
+            ;; can't just address the proof using one-level expansion of aux-update-clause-bldr.
+            ;; Maybe the induction scheme is somehow flawed?
+            (%restrict default clause.aux-update-clause-bldr
+                       (memberp todo
+                                '((cons (logic.=rhs (logic.conclusion (car t-proofs))) (logic.=rhses (logic.strip-conclusions (cdr t-proofs))))
+                                  (cons (logic.=rhs (logic.conclusion (car t-proofs))) (logic.=rhses (logic.strip-conclusions (cdr t-proofs))))
+                                  (cons (logic.=lhs (logic.~arg (logic.conclusion proof))) 'nil)
+                                  (cons (logic.=rhs (logic.conclusion (car t-proofs))) 'nil)))))
+
+
+
+(defsection clause.update-clause-bldr
+  (%autoadmit clause.update-clause-bldr)
+  ;; BOZO have to enable rev-disjunction becuase we never bothered to prove
+  ;; anything about it, and we just made it an alias for generic-subset
+  ;; instead.  we should consider globally enabling this and the other
+  ;; functions like it.
+  (local (%enable default clause.update-clause-bldr build.rev-disjunction))
+  (%autoprove clause.update-clause-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-clause.update-clause-bldr)
+  (%autoprove forcing-logic.conclusion-of-clause.update-clause-bldr)
+  (%autoprove forcing-logic.proofp-of-clause.update-clause-bldr))
+
+
+(%autoprove logic.formula-list-atblp-of-logic.strip-conclusions-of-cdr-when-logic.provable-listp)
+
+(defsection clause.update-clause-bldr-okp
+
+  (%autoadmit clause.update-clause-bldr-okp)
+
+  (%autoprove booleanp-of-clause.update-clause-bldr-okp
+              (%enable default clause.update-clause-bldr-okp))
+
+  (%autoprove clause.update-clause-bldr-okp-of-logic.appeal-identity
+              (%enable default clause.update-clause-bldr-okp))
+
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+
+  (%autoprove lemma-1-for-soundness-of-clause.update-clause-bldr-okp
+              (%enable default clause.update-clause-bldr-okp))
+
+  (%autoprove lemma-2-for-soundness-of-clause.update-clause-bldr-okp
+              (%enable default clause.update-clause-bldr-okp))
+
+  (%autoprove forcing-soundness-of-clause.update-clause-bldr-okp
+              (%disable default [OUTSIDE]CONSP-OF-LOGIC.STRIP-CONCLUSIONS) ;; why is this a problem??
+              (%enable default
+                       lemma-1-for-soundness-of-clause.update-clause-bldr-okp
+                       lemma-2-for-soundness-of-clause.update-clause-bldr-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (clause.update-clause-bldr
+                                   (logic.=rhses
+                                    (logic.strip-conclusions
+                                     (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                  axioms thms atbl)))
+                                   (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                   (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                axioms thms atbl)))))
+              (%forcingp nil)
+              (%auto :strategy (cleanup split crewrite))
+              (%enable default clause.update-clause-bldr-okp)
+              (%auto)))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/update-clause-iff-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/update-clause-iff-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/update-clause-iff-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/update-clause-iff-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,208 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "update-clause-bldr") ;; BOZO needed for rev-disjunction for now, stupid.
+(%interactive)
+
+(local (%enable default build.rev-disjunction))
+
+(%autoadmit clause.aux-update-clause-iff-bldr)
+
+(defmacro %clause.aux-update-clause-iff-bldr-induction (todo done t-proofs proof)
+  `(%induct (rank ,todo)
+            ((not (consp ,todo))
+             nil)
+            ((and (consp ,todo)
+                  (not (consp (cdr ,todo)))
+                  (not (consp ,done)))
+             nil)
+            ((and (consp ,todo)
+                  (not (consp (cdr ,todo)))
+                  (consp ,done))
+             (((,todo (cdr ,todo))
+               (,done (cons (first (logic.function-args (logic.=lhs (logic.conclusion (car ,t-proofs)))))
+                            ,done))
+               (,t-proofs (cdr ,t-proofs))
+               (,proof (clause.aux-update-clause-iff-lemma1-bldr ,proof (car ,t-proofs))))))
+            ((and (consp ,todo)
+                  (consp (cdr ,todo))
+                  (not (consp ,done)))
+             (((,todo (cdr ,todo))
+               (,done (cons (first (logic.function-args (logic.=lhs (logic.conclusion (car ,t-proofs)))))
+                            ,done))
+               (,t-proofs (cdr ,t-proofs))
+               (,proof (clause.aux-update-clause-iff-lemma1-bldr (build.commute-or ,proof) (car ,t-proofs))))))
+            ((and (consp ,todo)
+                  (consp (cdr ,todo))
+                  (consp ,done))
+             (((,todo (cdr ,todo))
+               (,done (cons (first (logic.function-args (logic.=lhs (logic.conclusion (car ,t-proofs)))))
+                            ,done))
+               (,t-proofs (cdr ,t-proofs))
+               (,proof (clause.aux-update-clause-iff-lemma2-bldr ,proof (car ,t-proofs))))))))
+
+(%autoprove clause.aux-update-clause-iff-bldr-under-iff
+            (%clause.aux-update-clause-iff-bldr-induction todo done t-proofs proof)
+            (%restrict default clause.aux-update-clause-iff-bldr (equal todo 'todo))
+            (%enable default logic.term-formula))
+
+(defthm lemma-1-for-forcing-logic.appealp-of-clause.aux-update-clause-iff-bldr
+  ;; BOZO unlocalize this
+  (implies (and (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                (force (and (logic.appeal-listp x)
+                            (logic.all-atomicp (logic.strip-conclusions x))
+                            (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x))))))
+           (equal (consp (cdr (logic.function-args (logic.=lhs (logic.conclusion (car x))))))
+                  (consp x))))
+
+(%autoprove lemma-1-for-forcing-logic.appealp-of-clause.aux-update-clause-iff-bldr
+           (%forcingp nil))
+
+(defthm lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-iff-bldr
+  ;; BOZO unlocalize this
+  (implies (and (logic.term-listp todo)
+                (logic.term-listp done)
+                (or (consp todo) (consp done))
+                (logic.appealp proof)
+                (equal (logic.conclusion proof)
+                       (cond ((and (consp done) (consp todo))
+                              (logic.por (clause.clause-formula done) (clause.clause-formula todo)))
+                             ((consp done)
+                              (clause.clause-formula done))
+                             (t
+                              (clause.clause-formula todo))))
+                (logic.appeal-listp t-proofs)
+                (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) todo))
+           (and (logic.appealp (clause.aux-update-clause-iff-bldr todo done t-proofs proof))
+                (equal (logic.conclusion (clause.aux-update-clause-iff-bldr todo done t-proofs proof))
+                       (clause.clause-formula
+                        (app (rev (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                             done)))))
+  ;; Gonna need a different theory hint.
+  :rule-classes nil)
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-iff-bldr
+            (%clause.aux-update-clause-iff-bldr-induction todo done t-proofs proof)
+            (%auto :strategy (cleanup urewrite split))
+            (%restrict default clause.aux-update-clause-iff-bldr (equal todo 'todo))
+            (%enable default logic.term-formula)
+            (%auto :strategy (cleanup urewrite split))
+            (%forcingp nil)
+            (%auto) ;; out of steps
+            (%forcingp t)
+            (%auto))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-update-clause-iff-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-iff-bldr))))
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-update-clause-iff-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-iff-bldr))))
+
+(%autoprove forcing-logic.proofp-of-clause.aux-update-clause-iff-bldr
+            (%clause.aux-update-clause-iff-bldr-induction todo done t-proofs proof)
+            (%auto :strategy (cleanup urewrite split))
+            (%restrict default clause.aux-update-clause-iff-bldr (equal todo 'todo))
+            (%enable default logic.term-formula)
+            (%auto :strategy (cleanup urewrite split))
+            (%forcingp nil)
+            (%auto)
+            (%forcingp t)
+            (%auto))
+
+
+
+
+
+(defsection clause.update-clause-iff-bldr
+  (%autoadmit clause.update-clause-iff-bldr)
+  (local (%enable default
+                  strip-lens-of-rev
+                  clause.update-clause-iff-bldr))
+  (local (%disable default
+                   rev-of-logic.strip-conclusions
+                   rev-of-logic.=lhses
+                   rev-of-logic.strip-function-args
+                   rev-of-strip-lens))
+  (%autoprove clause.update-clause-iff-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-clause.update-clause-iff-bldr)
+  (%autoprove forcing-logic.conclusion-of-clause.update-clause-iff-bldr)
+  (%autoprove forcing-logic.proofp-of-clause.update-clause-iff-bldr))
+
+
+
+
+(defsection clause.update-clause-iff-bldr-okp
+
+  (%autoadmit clause.update-clause-iff-bldr-okp)
+
+  (%autoprove booleanp-of-clause.update-clause-iff-bldr-okp
+              (%enable default clause.update-clause-iff-bldr-okp))
+
+  (%autoprove clause.update-clause-iff-bldr-okp-of-logic.appeal-identity
+              (%enable default clause.update-clause-iff-bldr-okp))
+
+  (local (%enable default backtracking-logic.formula-atblp-rules))
+  (local (%disable default
+                   forcing-logic.formula-atblp-rules
+                   forcing-lookup-of-logic.function-name-free))
+
+  (%autoprove lemma-1-for-soundness-of-clause.update-clause-iff-bldr-okp
+              (%enable default clause.update-clause-iff-bldr-okp))
+
+  (%autoprove lemma-2-for-soundness-of-clause.update-clause-iff-bldr-okp
+              (%enable default clause.update-clause-iff-bldr-okp))
+
+  (%autoprove forcing-soundness-of-clause.update-clause-iff-bldr-okp
+              (%enable default
+                       lemma-1-for-soundness-of-clause.update-clause-iff-bldr-okp
+                       lemma-2-for-soundness-of-clause.update-clause-iff-bldr-okp
+                       clause.update-clause-iff-bldr-okp)
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (clause.update-clause-iff-bldr
+                                   (strip-seconds
+                                    (logic.strip-function-args
+                                     (logic.=lhses
+                                      (logic.strip-conclusions
+                                       (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                    axioms thms atbl)))))
+                                   (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                   (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                axioms thms atbl)))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/urewrite-if-lemmas.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/urewrite-if-lemmas.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/urewrite-if-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/urewrite-if-lemmas.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "if-lemmas")
+(%interactive)
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 type-set-like-rules))
+
+(%defderiv rw.iff-implies-equal-if-bldr)
+(%defderiv rw.iff-implies-iff-if-bldr)
+(%defderiv rw.equal-of-if-x-y-y-bldr)
+(%defderiv rw.iff-of-if-x-y-y-bldr)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/weakening-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/weakening-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/weakening-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/weakening-eqtrace-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,53 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trans1-eqtrace-bldr")
+(%interactive)
+
+(defsection rw.weakening-eqtrace-bldr
+  (%autoadmit rw.weakening-eqtrace-bldr)
+  (local (%enable default
+                  rw.eqtrace-formula
+                  rw.weakening-eqtrace-bldr
+                  rw.weakening-eqtrace-okp
+                  lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                  lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr))
+  (%autoprove forcing-rw.weakening-eqtrace-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.weakening-eqtrace-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.weakening-eqtrace-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.weakening-eqtrace-bldr))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/weakening-eqtrace-bldr")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level5/weakening-eqtrace.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level5/weakening-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level5/weakening-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level5/weakening-eqtrace.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,58 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(%interactive)
+
+(defsection rw.weakening-eqtrace
+  (%autoadmit rw.weakening-eqtrace)
+  (local (%enable default rw.weakening-eqtrace))
+  (%autoprove forcing-rw.eqtrace->method-of-rw.weakening-eqtrace)
+  (%autoprove forcing-rw.eqtrace->iffp-of-rw.weakening-eqtrace)
+  (%autoprove forcing-rw.eqtrace->lhs-of-rw.weakening-eqtrace)
+  (%autoprove forcing-rw.eqtrace->rhs-of-rw.weakening-eqtrace)
+  (%autoprove forcing-rw.eqtrace->subtraces-of-rw.weakening-eqtrace)
+  (%autoprove forcing-rw.eqtracep-of-rw.weakening-eqtrace)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.weakening-eqtrace))
+
+(defsection rw.weakening-eqtrace-okp
+  (%autoadmit rw.weakening-eqtrace-okp)
+  (local (%enable default rw.weakening-eqtrace-okp))
+  (%autoprove booleanp-of-rw.weakening-eqtrace-okp)
+  (%autoprove forcing-rw.weakening-eqtrace-okp-of-rw.weakening-eqtrace
+              (%enable default rw.weakening-eqtrace)))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/weakening-eqtrace")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level6/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/acl2-customization.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-limsplit-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-limsplit-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-limsplit-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-limsplit-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,95 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-limsplit")
+(include-book "aux-split-double-negate")
+(include-book "aux-split-negated-if")
+(include-book "aux-split-positive-if")
+(include-book "aux-split-negative-default")
+(include-book "aux-split-positive-default")
+(%interactive)
+
+
+;; BOZO this is still really slow.  We can probably speed it up by disabling
+;; more rules.
+
+(local (%disable default
+                 type-set-like-rules
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 expensive-term/formula-inference
+                 expensive-subsetp-rules
+                 unusual-consp-rules
+                 same-length-prefixes-equal-cheap))
+
+(%autoadmit clause.aux-limsplit-bldr)
+
+(local (%enable default clause.aux-split-goal-when-not-consp-of-todo))
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.aux-limsplit-bldr
+            (%autoinduct clause.aux-limsplit)
+            (%forcingp nil)
+            (%waterfall default 50)
+            (%restrict default clause.aux-limsplit-bldr (memberp todo '(todo 'nil)))
+            (%restrict default clause.aux-limsplit (memberp todo '(todo 'nil)))
+            (%waterfall default 50)
+            (%auto)
+            (%forcingp t)
+            (%enable default expensive-arithmetic-rules-two))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-limsplit-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-limsplit-bldr))))
+
+(%autoprove lemma-for-forcing-logic.proofp-of-clause.aux-limsplit-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-limsplit-bldr))))
+
+
+
+(%autoprove forcing-logic.proofp-of-clause.aux-limsplit-bldr
+            (%autoinduct clause.aux-limsplit)
+            (%forcingp nil)
+            (%waterfall default 50)
+            (%restrict default clause.aux-limsplit-bldr (memberp todo '(todo 'nil)))
+            (%restrict default clause.aux-limsplit (memberp todo '(todo 'nil)))
+            (%enable default lemma-for-forcing-logic.proofp-of-clause.aux-limsplit-bldr)
+            (%waterfall default 50)
+            (%car-cdr-elim)
+            (%forcingp t)
+            (%enable default expensive-arithmetic-rules-two))
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-limsplit-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-clause.aux-limsplit-bldr)))
+            (%enable default clause.aux-split-goal))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-limsplit.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-limsplit.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-limsplit.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-limsplit.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,125 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(%interactive)
+
+
+(local (%disable default
+                 type-set-like-rules
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 expensive-term/formula-inference
+                 expensive-subsetp-rules
+                 unusual-consp-rules))
+
+(%autoadmit clause.aux-limsplit)
+
+(%autoprove true-listp-of-clause.aux-limsplit
+            (%autoinduct clause.aux-limsplit)
+            (%restrict default clause.aux-limsplit (memberp todo '(todo 'nil))))
+
+;; (%autoprove consp-of-clause.aux-limsplit
+;;             (%autoinduct clause.aux-limsplit)
+;;             (%restrict default clause.aux-limsplit (memberp todo '(todo 'nil))))
+
+;; (%autoprove clause.aux-limsplit-under-iff
+;;             (%autoinduct clause.aux-limsplit)
+;;             (%restrict default clause.aux-limsplit (memberp todo '(todo 'nil))))
+
+(%autoprove forcing-term-list-listp-of-clause.aux-limsplit
+            (%autoinduct clause.aux-limsplit)
+            (%restrict default clause.aux-limsplit (memberp todo '(todo 'nil))))
+
+(%autoprove forcing-term-list-list-atblp-of-clause.aux-limsplit
+            (%autoinduct clause.aux-limsplit)
+            (%restrict default clause.aux-limsplit (memberp todo '(todo 'nil))))
+
+(%autoprove forcing-cons-listp-of-clause.aux-limsplit
+            (%autoinduct clause.aux-limsplit)
+            (%restrict default clause.aux-limsplit (memberp todo '(todo 'nil))))
+
+
+
+
+
+;; (%autoprove clause.aux-limsplit-when-double-negative
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-negative-1
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-negative-2
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-negative-3
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-negative-4
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-positive-1
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-positive-2
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-positive-3
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-positive-4
+;;             (%restrict default clause.aux-limsplit (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-limsplit-when-not-consp
+;;             (%restrict default clause.aux-limsplit (equal todo 'todo)))
+
+;; (%autoprove clause.aux-limsplit-when-zp
+;;             (%restrict default clause.aux-limsplit (equal todo 'todo)))
+
+;; (%create-theory clause.aux-limsplit-openers)
+;; (%enable clause.aux-limsplit-openers
+;;          clause.aux-limsplit-when-double-negative
+;;          clause.aux-limsplit-when-negative-1
+;;          clause.aux-limsplit-when-negative-1
+;;          clause.aux-limsplit-when-negative-2
+;;          clause.aux-limsplit-when-negative-3
+;;          clause.aux-limsplit-when-negative-4
+;;          clause.aux-limsplit-when-positive-1
+;;          clause.aux-limsplit-when-positive-2
+;;          clause.aux-limsplit-when-positive-3
+;;          clause.aux-limsplit-when-positive-4
+;;          clause.aux-limsplit-when-not-consp
+;;          clause.aux-limsplit-when-zp)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,86 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split-double-negate")
+(include-book "aux-split-negated-if")
+(include-book "aux-split-positive-if")
+(include-book "aux-split-negative-default")
+(include-book "aux-split-positive-default")
+(%interactive)
+
+
+(local (%disable default
+                 type-set-like-rules
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 expensive-term/formula-inference
+                 expensive-subsetp-rules
+                 unusual-consp-rules))
+
+(%autoadmit clause.aux-split-bldr)
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.aux-split-bldr
+            (%autoinduct clause.aux-split)
+            (%enable default clause.aux-split-goal-when-not-consp-of-todo)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default clause.aux-split-bldr (equal todo 'todo))
+            (%restrict default clause.aux-split (equal todo 'todo))
+            (%restrict default clause.split-count-list (equal x 'todo))
+            (%auto :strategy (cleanup split urewrite crewrite)))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-split-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-split-bldr))))
+
+(%autoprove lemma-for-forcing-logic.proofp-of-clause.aux-split-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.aux-split-bldr))))
+
+(local (%max-proof-size 800000000))
+
+(%autoprove forcing-logic.proofp-of-clause.aux-split-bldr
+            (%autoinduct clause.aux-split)
+            (%enable default
+                     clause.aux-split-goal-when-not-consp-of-todo
+                     lemma-for-forcing-logic.proofp-of-clause.aux-split-bldr)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default clause.split-count-list (equal x 'todo))
+            (%restrict default clause.aux-split-bldr (equal todo 'todo))
+            (%restrict default clause.aux-split (equal todo 'todo))
+            (%auto :strategy (cleanup split urewrite crewrite)))
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-split-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-clause.aux-split-bldr)))
+            (%enable default clause.aux-split-goal))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-double-negate.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-double-negate.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-double-negate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-double-negate.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,75 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(include-book "standardize-double-negative-term-under-iff-bldr")
+(%interactive)
+
+;; speed hint
+(local (%disable default
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PNOTS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PEQUALS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PORS
+                 FORCING-LOGIC.FUNCTION-OF-LOGIC.FUNCTION-NAME-AND-LOGIC.FUNCTION-ARGS-FREE
+                 LOGIC.TERM-LISTP-OF-SUBSETP-WHEN-LOGIC.TERM-LISTP
+                 LOGIC.TERM-LISTP-WHEN-LOGIC.VARIABLE-LISTP-CHEAP
+                 FORCING-LOGIC.DISJOIN-FORMULAS-OF-TWO-ELEMENT-LIST
+                 LOGIC.DISJOIN-FORMULAS-WHEN-NOT-CONSP
+
+                 CONSP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.FUNCTIONP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.TERMP-WHEN-INVALID-MAYBE-EXPENSIVE
+
+                 logic.termp-when-logic.formulap
+                 same-length-prefixes-equal-cheap
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 unusual-subsetp-rules
+                 car-when-not-consp
+                 cdr-when-not-consp
+                 type-set-like-rules
+                 unusual-memberp-rules
+                 ))
+
+(%autoadmit clause.aux-split-double-negate)
+
+(local (%enable default
+                logic.term-formula
+                clause.aux-split-goal
+                clause.aux-split-double-negate))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-split-double-negate)
+(%autoprove forcing-logic.conclusion-of-clause.aux-split-double-negate)
+(%autoprove forcing-logic.proofp-of-clause.aux-split-double-negate)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-negated-if.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-negated-if.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-negated-if.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-negated-if.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,192 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(%interactive)
+
+
+#||
+
+An experiment to see if it's worth improving eqtrace-bldr-okp... it helps, but
+it probably isn't worth the trouble.
+
+;(defund rw.slow-hypbox-arities (x)
+  (declare (xargs :guard (rw.hypboxp x)))
+  (app (logic.slow-term-list-arities (rw.hypbox->left x))
+       (logic.slow-term-list-arities (rw.hypbox->right x))))
+
+;(defund rw.hypbox-arities (x acc)
+  (declare (xargs :guard (and (rw.hypboxp x)
+                              (true-listp acc))))
+  (logic.term-list-arities (rw.hypbox->left x)
+                           (logic.term-list-arities (rw.hypbox->right x)
+                                                    acc)))
+
+(defthm true-listp-of-rw.hypbox-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.hypbox-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hypbox-arities))))
+
+(defthm rw.hypbox-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.hypbox-arities x acc)
+                  (app (rw.slow-hypbox-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.hypbox-arities
+                                    rw.slow-hypbox-arities))))
+
+(defthm rw.slow-hypbox-arities-correct
+  (implies (force (rw.hypboxp x))
+           (equal (logic.arities-okp (rw.slow-hypbox-arities x) atbl)
+                  (rw.hypbox-atblp x atbl)))
+  :hints(("Goal"
+          :in-theory (e/d (rw.slow-hypbox-arities
+                           rw.hypbox-atblp)
+                          ((:executable-counterpart acl2::force))))))
+
+(definlined rw.fast-hypbox-atblp (x atbl)
+  (declare (xargs :guard (and (rw.hypboxp x)
+                              (logic.arity-tablep atbl))))
+  ;; This is a generally faster check than rw.hypbox-atblp.  The speed advantage
+  ;; comes from collecting and mergesorting the function names (to remove dupes)
+  ;; before arity checking begins.
+  ;;
+  ;; We could consider using mergesort-map on arity table and use
+  ;; ordered-list-subsetp here, but we think that generally the aren't enough
+  ;; functions mentioned in the hypbox to make that worthwhile.  And, at any
+  ;; rate, we get a pretty big advantage just from running the mergesort.
+  ;;
+  ;; We could also consider using ordered-list-subsetp and requiring that the
+  ;; atbl be sorted ahead of time.  That might be quite valuable, but we haven't
+  ;; looked into fixing up the proof checkers to handle it.
+  (let* ((arities (rw.hypbox-arities x nil))
+         (sorted  (mergesort arities)))
+    (logic.arities-okp sorted atbl)))
+
+(defthm rw.fast-hypbox-atblp-removal
+  (implies (force (rw.hypboxp x))
+           (equal (rw.fast-hypbox-atblp x atbl)
+                  (rw.hypbox-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable rw.fast-hypbox-atblp))))
+
+
+
+(ACL2::defttag rw.eqtrace-bldr-okp-timing)
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+; (COMMON-LISP::DEFUN RW.EQTRACE-BLDR-OKP (X ATBL)
+                     (LET ((METHOD (LOGIC.METHOD X))
+                           (CONCLUSION (LOGIC.CONCLUSION X))
+                           (SUBPROOFS (LOGIC.SUBPROOFS X))
+                           (EXTRAS (LOGIC.EXTRAS X)))
+                          (AND (EQUAL METHOD 'RW.EQTRACE-BLDR)
+                               (TUPLEP 2 EXTRAS)
+                               (LET ((TRACE (FIRST EXTRAS))
+                                     (BOX (SECOND EXTRAS)))
+                                    (AND (RW.EQTRACEP TRACE)
+                                         (RW.HYPBOXP BOX)
+                                         (RW.FAST-HYPBOX-ATBLP BOX ATBL)
+                                         (RW.EQTRACE-OKP TRACE BOX)
+                                         (EQUAL CONCLUSION (RW.EQTRACE-FORMULA TRACE BOX))
+                                         (NOT SUBPROOFS))))))
+
+; (COMMON-LISP::DEFUN RW.EQTRACE-CONTRADICTION-BLDR-OKP (X ATBL)
+               (LET ((METHOD (LOGIC.METHOD X))
+                     (CONCLUSION (LOGIC.CONCLUSION X))
+                     (SUBPROOFS (LOGIC.SUBPROOFS X))
+                     (EXTRAS (LOGIC.EXTRAS X)))
+                    (AND (EQUAL METHOD 'RW.EQTRACE-CONTRADICTION-BLDR)
+                         (TUPLEP 2 EXTRAS)
+                         (LET ((TRACE (FIRST EXTRAS))
+                               (BOX (SECOND EXTRAS)))
+                              (AND (RW.EQTRACEP TRACE)
+                                   (RW.EQTRACE-CONTRADICTIONP TRACE)
+                                   (RW.EQTRACE-ATBLP TRACE ATBL)
+                                   (RW.HYPBOXP BOX)
+                                   (RW.FAST-HYPBOX-ATBLP BOX ATBL)
+                                   (RW.EQTRACE-OKP TRACE BOX)
+                                   (EQUAL CONCLUSION (RW.HYPBOX-FORMULA BOX))
+                                   (NOT SUBPROOFS)))))))
+
+
+||#
+
+(%autoadmit clause.aux-split-negated-if)
+
+
+;; speed hint
+(local (%disable default
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PNOTS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PEQUALS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PORS
+                 FORCING-LOGIC.FUNCTION-OF-LOGIC.FUNCTION-NAME-AND-LOGIC.FUNCTION-ARGS-FREE
+                 LOGIC.TERM-LISTP-OF-SUBSETP-WHEN-LOGIC.TERM-LISTP
+                 LOGIC.TERM-LISTP-WHEN-LOGIC.VARIABLE-LISTP-CHEAP
+                 FORCING-LOGIC.DISJOIN-FORMULAS-OF-TWO-ELEMENT-LIST
+                 LOGIC.DISJOIN-FORMULAS-WHEN-NOT-CONSP
+
+                 CONSP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.FUNCTIONP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.TERMP-WHEN-INVALID-MAYBE-EXPENSIVE
+
+                 logic.termp-when-logic.formulap
+                 same-length-prefixes-equal-cheap
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 unusual-subsetp-rules
+                 car-when-not-consp
+                 cdr-when-not-consp
+                 type-set-like-rules
+                 unusual-memberp-rules
+                 ))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-split-negated-if
+            (%enable default
+                     logic.term-formula
+                     clause.aux-split-goal
+                     clause.aux-split-negated-if))
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-split-negated-if
+            (%enable default
+                     logic.term-formula
+                     clause.aux-split-goal
+                     clause.aux-split-negated-if))
+
+(%autoprove forcing-logic.proofp-of-clause.aux-split-negated-if
+            (%enable default
+                     logic.term-formula
+                     clause.aux-split-goal
+                     clause.aux-split-negated-if))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-negative-default.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-negative-default.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-negative-default.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-negative-default.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,76 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(%interactive)
+
+;; speed hint
+(local (%disable default
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PNOTS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PEQUALS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PORS
+                 FORCING-LOGIC.FUNCTION-OF-LOGIC.FUNCTION-NAME-AND-LOGIC.FUNCTION-ARGS-FREE
+                 LOGIC.TERM-LISTP-OF-SUBSETP-WHEN-LOGIC.TERM-LISTP
+                 LOGIC.TERM-LISTP-WHEN-LOGIC.VARIABLE-LISTP-CHEAP
+                 FORCING-LOGIC.DISJOIN-FORMULAS-OF-TWO-ELEMENT-LIST
+                 LOGIC.DISJOIN-FORMULAS-WHEN-NOT-CONSP
+
+                 CONSP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.FUNCTIONP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.TERMP-WHEN-INVALID-MAYBE-EXPENSIVE
+
+                 logic.termp-when-logic.formulap
+                 same-length-prefixes-equal-cheap
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 unusual-subsetp-rules
+                 car-when-not-consp
+                 cdr-when-not-consp
+                 type-set-like-rules
+                 unusual-memberp-rules
+                 ))
+
+(%autoadmit clause.aux-split-negative-default)
+
+(local (%enable default
+                clause.aux-split-goal
+                clause.aux-split-negative-default
+                logic.term-formula))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-split-negative-default)
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-split-negative-default)
+
+(%autoprove forcing-logic.proofp-of-clause.aux-split-negative-default)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-positive-default.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-positive-default.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-positive-default.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-positive-default.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,77 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(%interactive)
+
+;; speed hint
+(local (%disable default
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PNOTS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PEQUALS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PORS
+                 FORCING-LOGIC.FUNCTION-OF-LOGIC.FUNCTION-NAME-AND-LOGIC.FUNCTION-ARGS-FREE
+                 LOGIC.TERM-LISTP-OF-SUBSETP-WHEN-LOGIC.TERM-LISTP
+                 LOGIC.TERM-LISTP-WHEN-LOGIC.VARIABLE-LISTP-CHEAP
+                 FORCING-LOGIC.DISJOIN-FORMULAS-OF-TWO-ELEMENT-LIST
+                 LOGIC.DISJOIN-FORMULAS-WHEN-NOT-CONSP
+
+                 CONSP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.FUNCTIONP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.TERMP-WHEN-INVALID-MAYBE-EXPENSIVE
+
+                 logic.termp-when-logic.formulap
+                 same-length-prefixes-equal-cheap
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 unusual-subsetp-rules
+                 car-when-not-consp
+                 cdr-when-not-consp
+                 type-set-like-rules
+                 unusual-memberp-rules
+                 ))
+
+(%autoadmit clause.aux-split-positive-default)
+
+(local (%enable default
+                clause.aux-split-goal
+                clause.aux-split-positive-default
+                logic.term-formula))
+
+(%autoprove forcing-logic.appealp-of-clause.aux-split-positive-default)
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-split-positive-default)
+
+(%autoprove forcing-logic.proofp-of-clause.aux-split-positive-default)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-positive-if.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-positive-if.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split-positive-if.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split-positive-if.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,84 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(%interactive)
+
+;; speed hint
+(local (%disable default
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PNOTS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PEQUALS
+                 AGGRESSIVE-EQUAL-OF-LOGIC.PORS
+                 FORCING-LOGIC.FUNCTION-OF-LOGIC.FUNCTION-NAME-AND-LOGIC.FUNCTION-ARGS-FREE
+                 LOGIC.TERM-LISTP-OF-SUBSETP-WHEN-LOGIC.TERM-LISTP
+                 LOGIC.TERM-LISTP-WHEN-LOGIC.VARIABLE-LISTP-CHEAP
+                 FORCING-LOGIC.DISJOIN-FORMULAS-OF-TWO-ELEMENT-LIST
+                 LOGIC.DISJOIN-FORMULAS-WHEN-NOT-CONSP
+
+                 CONSP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.FUNCTIONP-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.TERMP-WHEN-INVALID-MAYBE-EXPENSIVE
+
+                 logic.termp-when-logic.formulap
+                 same-length-prefixes-equal-cheap
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 unusual-subsetp-rules
+                 car-when-not-consp
+                 cdr-when-not-consp
+                 type-set-like-rules
+                 unusual-memberp-rules
+                 ))
+
+(%autoadmit clause.aux-split-positive-if)
+
+(%autoprove forcing-logic.appealp-of-clause.aux-split-positive-if
+            (%enable default
+                     logic.term-formula
+                     clause.aux-split-goal
+                     clause.aux-split-positive-if))
+
+(%autoprove forcing-logic.conclusion-of-clause.aux-split-positive-if
+            (%enable default
+                     logic.term-formula
+                     clause.aux-split-goal
+                     clause.aux-split-positive-if))
+
+(%autoprove forcing-logic.proofp-of-clause.aux-split-positive-if
+            (%enable default
+                     logic.term-formula
+                     clause.aux-split-goal
+                     clause.aux-split-positive-if))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/aux-split.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/aux-split.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,269 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lifted-termp")
+(include-book "complementary")
+(%interactive)
+
+
+;; BOZO move this to arithmetic
+
+(defthm |(zp (+ 1 a))|
+  ;; Why have this silly rule?  It's useful when the more expensive arithmetic
+  ;; rules are disabled.  For example, (= 0 (+ a b)) introduces case-splits.
+  ;; Yet we often need a fact like this in inductive proofs where some count is
+  ;; being decremented.
+  (equal (zp (+ 1 a))
+         nil))
+
+(%autoprove |(zp (+ 1 a))|)
+
+
+
+
+
+(%autoadmit clause.split-count)
+
+(%autoprove natp-of-clause.split-count
+            (%restrict default clause.split-count (equal x 'x)))
+
+(%autoprove |(< 0 (clause.split-count x))|
+            (%restrict default clause.split-count (equal x 'x)))
+
+(%autoprove clause.split-count-when-clause.negative-termp
+            (%restrict default clause.split-count (equal x 'x)))
+
+(%autoprove clause.split-count-when-if
+            (%restrict default clause.split-count (equal x 'x)))
+
+(%autoadmit clause.split-count-list)
+
+(%autoprove clause.split-count-list-when-not-consp
+            (%restrict default clause.split-count-list (equal x 'x)))
+
+(%autoprove clause.split-count-list-of-cons
+            (%restrict default clause.split-count-list (equal x '(cons a x))))
+
+(%autoprove natp-of-clause.split-count-list
+            (%restrict default clause.split-count-list (equal x 'x)))
+
+
+
+
+
+
+
+
+;; BOZO consider moving this to a lower level, particularly for the builder.
+
+(%autoadmit clause.aux-split-trivial-branchp)
+
+(%autoprove booleanp-of-clause.aux-split-trivial-branchp
+            (%enable default clause.aux-split-trivial-branchp))
+
+(defsection clause.aux-split-trivial-branch-bldr
+  (%autoadmit clause.aux-split-trivial-branch-bldr)
+  (local (%enable default
+                  clause.aux-split-trivial-branchp
+                  clause.aux-split-trivial-branch-bldr
+                  clause.aux-split-goal))
+  (%autoprove logic.appealp-of-clause.aux-split-trivial-branch-bldr)
+  (%autoprove logic.conclusion-of-clause.aux-split-trivial-branch-bldr)
+  (%autoprove logic.proofp-of-clause.aux-split-trivial-branch-bldr))
+
+
+
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 formula-decomposition
+                 expensive-term/formula-inference
+                 expensive-subsetp-rules
+                 unusual-consp-rules))
+
+(%autoadmit clause.aux-split)
+
+
+;; (defmacro %clause.aux-split-induction (todo done)
+;;   `(%induct (clause.split-count-list ,todo)
+;;             ((not (consp ,todo))
+;;              nil)
+;;             ((and (consp ,todo)
+;;                   (clause.negative-termp (car ,todo))
+;;                   (clause.negative-termp (clause.negative-term-guts (car ,todo))))
+;;              (((,todo (cons (clause.negative-term-guts (clause.negative-term-guts (car ,todo)))
+;;                             (cdr ,todo))))))
+;;             ((and (consp ,todo)
+;;                   (clause.negative-termp (car ,todo))
+;;                   (not (clause.negative-termp (clause.negative-term-guts (car ,todo))))
+;;                   (logic.functionp (clause.negative-term-guts (car ,todo)))
+;;                   (equal (logic.function-name (clause.negative-term-guts (car ,todo))) 'if)
+;;                   (equal (len (logic.function-args (clause.negative-term-guts (car ,todo)))) 3))
+;;              (((,todo (cons (logic.function 'not (list (first (logic.function-args (clause.negative-term-guts (car ,todo))))))
+;;                             (cons (logic.function 'not (list (second (logic.function-args (clause.negative-term-guts (car ,todo))))))
+;;                                   (cdr ,todo)))))
+;;               ((,todo (cons (first (logic.function-args (clause.negative-term-guts (car ,todo))))
+;;                             (cons (logic.function 'not (list (third (logic.function-args (clause.negative-term-guts (car ,todo))))))
+;;                                   (cdr ,todo)))))))
+;;             ((and (consp ,todo)
+;;                   (not (clause.negative-termp (car ,todo)))
+;;                   (logic.functionp (car ,todo))
+;;                   (equal (logic.function-name (car ,todo)) 'if)
+;;                   (equal (len (logic.function-args (car ,todo))) 3))
+;;              (((,todo (cons (logic.function 'not (list (first (logic.function-args (car ,todo)))))
+;;                             (cons (second (logic.function-args (car ,todo)))
+;;                                   (cdr ,todo)))))
+;;               ((,todo (cons (first (logic.function-args (car ,todo)))
+;;                             (cons (third (logic.function-args (car ,todo)))
+;;                                   (cdr ,todo)))))))
+;;             ((and (consp ,todo)
+;;                   (clause.negative-termp (car ,todo))
+;;                   (not (clause.negative-termp (clause.negative-term-guts (car ,todo))))
+;;                   (not (and (logic.functionp (clause.negative-term-guts (car ,todo)))
+;;                             (equal (logic.function-name (clause.negative-term-guts (car ,todo))) 'if)
+;;                             (equal (len (logic.function-args (clause.negative-term-guts (car ,todo)))) 3))))
+;;              (((,todo (cdr ,todo))
+;;                (,done (cons (logic.function 'not (list (clause.negative-term-guts (car ,todo)))) ,done)))))
+;;             ((and (consp ,todo)
+;;                   (not (clause.negative-termp (car ,todo)))
+;;                   (not (and (logic.functionp (car ,todo))
+;;                             (equal (logic.function-name (car ,todo)) 'if)
+;;                             (equal (len (logic.function-args (car ,todo))) 3))))
+;;              (((,todo (cdr ,todo))
+;;                (,done (cons (car ,todo) ,done)))))))
+
+
+
+(%autoprove true-listp-of-clause.aux-split
+            (%autoinduct clause.aux-split todo done)
+            ;(%clause.aux-split-induction todo done)
+            (%restrict default clause.aux-split (equal todo 'todo)))
+
+;; (%autoprove consp-of-clause.aux-split
+;;             (%clause.aux-split-induction todo done)
+;;             (%restrict default clause.aux-split (equal todo 'todo)))
+
+;; (%autoprove clause.aux-split-under-iff
+;;             (%use (%instance (%thm consp-of-clause.aux-split)))
+;;             (%disable default consp-of-clause.aux-split [outside]consp-of-clause.aux-split))
+
+(%autoprove forcing-term-list-listp-of-clause.aux-split
+            (%autoinduct clause.aux-split todo done)
+            ;(%clause.aux-split-induction todo done)
+            (%restrict default clause.aux-split (equal todo 'todo)))
+
+(%autoprove forcing-term-list-list-atblp-of-clause.aux-split
+            (%autoinduct clause.aux-split todo done)
+            ;(%clause.aux-split-induction todo done)
+            (%restrict default clause.aux-split (equal todo 'todo)))
+
+(%autoprove forcing-cons-listp-of-clause.aux-split
+            (%autoinduct clause.aux-split todo done)
+            ;(%clause.aux-split-induction todo done)
+            (%restrict default clause.aux-split (equal todo 'todo)))
+
+
+
+;; BOZO we don't bother to show that splitting is complete in the sense of the
+;; lifted-guts terms.  Maybe we eventually want to do that, but I don't think
+;; we will need it for now.
+
+;; (local (%enable default logic.term-formula))
+;; (local (%disable default
+;;                  equal-of-cons-rewrite
+;;                  forcing-equal-of-logic.pequal-rewrite-two
+;;                  forcing-equal-of-logic.pnot-rewrite-two
+;;                  forcing-equal-of-logic.por-rewrite-two
+;;                  forcing-equal-of-logic.pequal-rewrite
+;;                  forcing-equal-of-logic.pnot-rewrite
+;;                  forcing-equal-of-logic.por-rewrite))
+
+;; (%autoprove clause.aux-split-when-double-negative
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-negative-1
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-negative-2
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-negative-3
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-negative-4
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-positive-1
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-positive-2
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-positive-3
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-positive-4
+;;             (%restrict default clause.aux-split (equal todo '(cons a x))))
+
+;; (%autoprove clause.aux-split-when-not-consp
+;;             (%restrict default clause.aux-split (equal todo 'todo)))
+
+;; (%create-theory clause.aux-split-openers)
+;; (%enable clause.aux-split-openers
+;;          clause.aux-split-when-double-negative
+;;          clause.aux-split-when-negative-1
+;;          clause.aux-split-when-negative-1
+;;          clause.aux-split-when-negative-2
+;;          clause.aux-split-when-negative-3
+;;          clause.aux-split-when-negative-4
+;;          clause.aux-split-when-positive-1
+;;          clause.aux-split-when-positive-2
+;;          clause.aux-split-when-positive-3
+;;          clause.aux-split-when-positive-4
+;;          clause.aux-split-when-not-consp)
+
+
+
+
+
+
+;; BOZO this does NOT belong here.  It's in aux-split-bldr.lisp but it really belongs
+;; in utilities/utilities.
+
+(%autoprove len-when-not-consp-of-cdr-cheap)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level6/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/cert.image	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1 @@
+level6-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/complementary.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/complementary.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/complementary.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/complementary.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,143 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-negativep")
+(%interactive)
+
+(local (%enable default lemma-split-up-list-of-quoted-nil))
+
+(%autoadmit clause.complement-term)
+
+(%autoprove logic.termp-of-clause.complement-term
+            (%enable default clause.complement-term))
+
+(%autoprove clause.complement-term-of-clause.complement-term
+            (%enable default clause.complement-term))
+
+
+
+
+(%autoadmit clause.find-complementary-literal)
+
+(%autoprove clause.find-complementary-literal-when-not-consp
+            (%restrict default clause.find-complementary-literal (equal x 'x)))
+
+(%autoprove clause.find-complementary-literal-of-cons
+            (%restrict default clause.find-complementary-literal (equal x '(cons a x))))
+
+(%autoprove forcing-memberp-of-clause.find-complementary-literal
+            (%cdr-induction x))
+
+(%autoprove forcing-memberp-of-not-of-clause.find-complementary-literal
+            (%cdr-induction x))
+
+(%autoprove clause.find-complementary-literal-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove forcing-clause.find-complementary-literal-of-app-one
+            (%cdr-induction x))
+
+(%autoprove lemma-for-clause.find-complementary-literal-of-rev
+            (%cdr-induction x))
+
+(%autoprove clause.find-complementary-literal-of-rev
+            (%cdr-induction x)
+            (%enable default lemma-for-clause.find-complementary-literal-of-rev))
+
+
+
+(%autoadmit clause.remove-complement-clauses)
+
+(%autoprove clause.remove-complement-clauses-when-not-consp
+            (%restrict default clause.remove-complement-clauses (equal x 'x)))
+
+(%autoprove clause.remove-complement-clauses-of-cons
+            (%restrict default clause.remove-complement-clauses (equal x '(cons a x))))
+
+(%autoprove forcing-logic.term-list-listp-of-clause.remove-complement-clauses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-clause.remove-complement-clauses
+            (%cdr-induction x))
+
+(%autoprove cons-listp-of-clause.remove-complement-clauses
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-clause.remove-complement-clauses
+            (%cdr-induction x))
+
+(%autoprove clause.remove-complement-clauses-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove clause.remove-complement-clauses-of-app
+            (%cdr-induction x))
+
+(%autoprove rev-of-clause.remove-complement-clauses
+            (%cdr-induction x))
+
+(%autoprove clause.remove-complement-clauses-of-rev)
+
+
+
+
+(defsection clause.complement-clause-bldr
+  (%autoadmit clause.complement-clause-bldr)
+  (local (%enable default
+                  clause.complement-clause-bldr
+                  clause.complement-term
+                  theorem-not-when-nil))
+  (%autoprove forcing-logic.appealp-of-clause.complement-clause-bldr)
+  (%autoprove forcing-logic.conclusion-of-clause.complement-clause-bldr)
+  (%autoprove forcing-logic.proofp-of-clause.complement-clause-bldr))
+
+
+
+
+(%autoadmit clause.remove-complement-clauses-bldr)
+
+(%autoprove forcing-logic.appeal-listp-of-clause.remove-complement-clauses-bldr
+            (%autoinduct clause.remove-complement-clauses-bldr)
+            (%restrict default clause.remove-complement-clauses (equal x 'x))
+            (%restrict default clause.remove-complement-clauses-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.remove-complement-clauses-bldr
+            (%autoinduct clause.remove-complement-clauses-bldr)
+            (%restrict default clause.remove-complement-clauses (equal x 'x))
+            (%restrict default clause.remove-complement-clauses-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.proof-listp-of-clause.remove-complement-clauses-bldr
+            (%autoinduct clause.remove-complement-clauses-bldr)
+            (%restrict default clause.remove-complement-clauses (equal x 'x))
+            (%restrict default clause.remove-complement-clauses-bldr (equal x 'x)))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/factor-bldr-okp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/factor-bldr-okp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/factor-bldr-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/factor-bldr-okp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,70 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "factor-bldr")
+(%interactive)
+
+(%autoadmit logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas)
+
+(%autoprove logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas-removal
+            (%cdr-induction x)
+            (%restrict default logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas (equal x 'x))
+            (%forcingp nil))
+
+
+
+(%autoadmit clause.factor-bldr-okp)
+
+(%autoadmit clause.factor-bldr-high)
+
+(local (%enable default clause.factor-bldr-okp))
+
+(%autoprove booleanp-of-clause.factor-bldr-okp)
+
+(%autoprove clause.factor-bldr-okp-of-logic.appeal-identity)
+
+(%autoprove lemma-1-for-soundness-of-clause.factor-bldr-okp)
+
+(%autoprove lemma-2-for-soundness-of-clause.factor-bldr-okp)
+
+(%autoprove forcing-soundness-of-clause.factor-bldr-okp
+            (%enable default
+                     lemma-1-for-soundness-of-clause.factor-bldr-okp
+                     lemma-2-for-soundness-of-clause.factor-bldr-okp)
+            (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                             (x (clause.factor-bldr (first (logic.extras x))
+                                                    (second (logic.extras x)))))))
+
+(%ensure-exactly-these-rules-are-missing "../../clauses/if-lifting/factor-bldr")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/factor-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/factor-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/factor-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/factor-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,388 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "factor")
+(%interactive)
+
+
+(%autoadmit binding-formula)
+(%enable default binding-formula)
+
+(defsection assignment-formulas
+ (local (%disable default binding-formula))
+ (%defprojection :list (assignment-formulas x)
+                 :element (binding-formula x)))
+
+(%autoprove forcing-logic.formulap-listp-of-assignment-formulas
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-atblp-listp-of-assignment-formulas
+            (%cdr-induction x))
+
+
+;; We already introduced these earlier.
+;; (%defderiv clause.factor-bldr-lemma-1 :omit-okp t)
+;; (%defderiv clause.factor-bldr-lemma-2 :omit-okp t)
+
+
+(%autoadmit clause.flag-factor-bldr)
+(%autoadmit clause.factor-bldr)
+(%autoadmit clause.factor-list-bldr)
+
+(%autoprove definition-of-clause.factor-bldr
+            (%restrict default clause.flag-factor-bldr (equal x 'x))
+            (%enable default clause.factor-bldr clause.factor-list-bldr)
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove definition-of-clause.factor-list-bldr
+            (%restrict default clause.flag-factor-bldr (equal x 'x))
+            (%enable default clause.factor-bldr clause.factor-list-bldr)
+            (%auto :strategy (cleanup urewrite split)))
+
+(%autoprove forcing-clause.flag-factor-bldr-of-term-removal
+            (%enable default clause.factor-bldr))
+
+(%autoprove clause.flag-factor-bldr-of-list-removal
+            ;; BOZO rename should be called forcing-blah
+            (%enable default clause.factor-list-bldr))
+
+(%autoprove clause.factor-list-bldr-when-not-consp
+            (%restrict default definition-of-clause.factor-list-bldr (equal x 'x)))
+
+(%autoprove clause.factor-list-bldr-of-cons
+            (%restrict default definition-of-clause.factor-list-bldr (equal x '(cons a x))))
+
+(encapsulate
+ ()
+ (%autoprove lemma-for-nil-preservingp-of-clause.factor-list-bldr
+             (%restrict default definition-of-clause.factor-bldr (equal x ''nil)))
+ (local (%enable default lemma-for-nil-preservingp-of-clause.factor-list-bldr))
+ (%defprojection
+  :list (clause.factor-list-bldr x assignment hyps hyps-formula)
+  :element (clause.factor-bldr x assignment hyps hyps-formula)
+  :nil-preservingp t))
+
+
+;; This is super-aggressive forcing, but we should only be looking for the
+;; right terms during these proofs.
+(%autoprove lemma-forcing-memberp-of-pequal-a-nil-in-assignment-formulas
+            (%cdr-induction x))
+
+;; This is super-aggressive forcing, but we should only be looking for the
+;; right terms during these proofs.
+(%autoprove lemma-forcing-memberp-of-logic.pnot-pequal-a-nil-in-assignment-formulas
+            (%cdr-induction x))
+
+
+
+
+
+(%autoprove lemma-1-for-forcing-logic.appealp-of-clause.factor-bldr)
+(%autoprove lemma-2-for-forcing-logic.appealp-of-clause.factor-bldr)
+(%autoprove lemma-3-for-forcing-logic.appealp-of-clause.factor-bldr)
+
+(%autoprove lemma-1-for-forcing-logic.conclusion-of-clause.factor-bldr
+            (%forcingp nil))
+(%autoprove lemma-2-for-forcing-logic.conclusion-of-clause.factor-bldr
+            (%forcingp nil))
+(%autoprove lemma-3-for-forcing-logic.conclusion-of-clause.factor-bldr
+            (%forcingp nil))
+
+
+
+(defthm clause.factor-bldr-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (clause.factor-bldr x assignment)
+                  (let* ((hyps          (logic.smart-negate-formulas (assignment-formulas assignment)))
+                         (hyps-formula  (logic.disjoin-formulas hyps)))
+                    (build.expansion hyps-formula (build.reflexivity x)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-bldr))))
+
+(defthm clause.factor-bldr-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (clause.factor-bldr x assignment)
+                  (let* ((hyps          (logic.smart-negate-formulas (assignment-formulas assignment)))
+                         (hyps-formula  (logic.disjoin-formulas hyps)))
+                    (build.expansion hyps-formula (build.reflexivity x)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-bldr))))
+
+(defthm clause.factor-bldr-when-non-if-logic.functionp
+  (implies (and (logic.functionp x)
+                (not (equal (logic.function-name x) 'if)))
+           (equal (clause.factor-bldr x assignment)
+                  (let* ((hyps          (logic.smart-negate-formulas (assignment-formulas assignment)))
+                         (hyps-formula  (logic.disjoin-formulas hyps)))
+                    (build.disjoined-pequal-by-args (logic.function-name x)
+                                                    hyps-formula
+                                                    (clause.factor-list-bldr (logic.function-args x) assignment)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-bldr))))
+
+(defthm clause.factor-bldr-when-bad-args-logic.functionp
+  (implies (and (logic.functionp x)
+                (not (equal (len (logic.function-args x)) 3)))
+           (equal (clause.factor-bldr x assignment)
+                  (let* ((hyps          (logic.smart-negate-formulas (assignment-formulas assignment)))
+                         (hyps-formula  (logic.disjoin-formulas hyps)))
+                    (build.disjoined-pequal-by-args (logic.function-name x)
+                                                    hyps-formula
+                                                    (clause.factor-list-bldr (logic.function-args x) assignment)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-bldr))))
+
+(defthm clause.factor-bldr-when-if
+  (implies (and (logic.functionp x)
+                (equal (logic.function-name x) 'if)
+                (equal (len (logic.function-args x)) 3))
+           (equal (clause.factor-bldr x assignment)
+                  (let* ((hyps          (logic.smart-negate-formulas (assignment-formulas assignment)))
+                         (hyps-formula  (logic.disjoin-formulas hyps))
+                         (args          (logic.function-args x))
+                         (a-proof       (clause.factor-bldr (first args) assignment))
+                         (a-prime       (logic.=rhs (logic.vrhs (logic.conclusion a-proof))))
+                         (binding       (lookup a-prime assignment)))
+                    (if binding
+                        (if (cdr binding)
+                            (clause.factor-bldr-lemma-1 (build.multi-assoc-expansion (build.commute-or (build.propositional-schema (logic.pequal a-prime ''nil))) hyps)
+                                                        a-proof
+                                                        (clause.factor-bldr (second args) assignment)
+                                                        (third args))
+                          (clause.factor-bldr-lemma-2 (build.multi-assoc-expansion (build.propositional-schema (logic.pequal a-prime ''nil)) hyps)
+                                                      a-proof
+                                                      (clause.factor-bldr (third args) assignment)
+                                                      (second args)))
+                      (build.disjoined-pequal-by-args 'if
+                                                      hyps-formula
+                                                      (list a-proof
+                                                            (clause.factor-bldr (second args) assignment)
+                                                            (clause.factor-bldr (third args) assignment)))))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal"
+          :in-theory (e/d (definition-of-clause.factor-bldr)
+                          ((:executable-counterpart ACL2::force)))
+          :expand (clause.factor-bldr x assignment))))
+
+(defthm clause.factor-bldr-when-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (clause.factor-bldr x assignment)
+                  (let* ((hyps          (logic.smart-negate-formulas (assignment-formulas assignment)))
+                         (hyps-formula  (logic.disjoin-formulas hyps)))
+                    (build.disjoined-lambda-pequal-by-args (logic.lambda-formals x)
+                                                           (logic.lambda-body x)
+                                                           hyps-formula
+                                                           (clause.factor-list-bldr (logic.lambda-actuals x) assignment)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-bldr))))
+
+(defthm clause.factor-bldr-when-degenerate
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (clause.factor-bldr x assignment)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-bldr))))
+
+
+(%autoprove clause.factor-bldr-when-logic.constantp
+            (%restrict default definition-of-clause.factor-bldr (equal x 'x)))
+
+(%autoprove clause.factor-bldr-when-logic.variablep
+            (%restrict default definition-of-clause.factor-bldr (equal x 'x)))
+
+(%autoprove clause.factor-bldr-when-non-if-logic.functionp
+            (%restrict default definition-of-clause.factor-bldr (equal x 'x)))
+
+(%autoprove clause.factor-bldr-when-bad-args-logic.functionp
+            (%restrict default definition-of-clause.factor-bldr (equal x 'x)))
+
+(%autoprove clause.factor-bldr-when-if
+            (%restrict default definition-of-clause.factor-bldr (equal x 'x)))
+
+(%autoprove clause.factor-bldr-when-logic.lambdap
+            (%restrict default definition-of-clause.factor-bldr (equal x 'x)))
+
+(%autoprove clause.factor-bldr-when-degenerate
+            (%restrict default definition-of-clause.factor-bldr (equal x 'x)))
+
+
+
+(%create-theory clause.factor-bldr-openers)
+(%enable clause.factor-bldr-openers
+         clause.factor-bldr-when-logic.constantp
+         clause.factor-bldr-when-logic.variablep
+         clause.factor-bldr-when-non-if-logic.functionp
+         clause.factor-bldr-when-bad-args-logic.functionp
+         clause.factor-bldr-when-if
+         clause.factor-bldr-when-logic.lambdap
+         clause.factor-bldr-when-degenerate)
+
+(%create-theory clause.factor-openers)
+(%enable clause.factor-openers
+         clause.factor-when-logic.constantp
+         clause.factor-when-logic.variablep
+         clause.factor-when-non-if-logic.functionp
+         clause.factor-when-bad-args-logic.functionp
+         clause.factor-when-if-expression
+         clause.factor-when-logic.lambdap
+         clause.factor-when-degenerate)
+
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.factor-bldr
+            (%clause.simple-term-induction flag x)
+            (%enable default
+                     lemma-1-for-forcing-logic.appealp-of-clause.factor-bldr
+                     lemma-2-for-forcing-logic.appealp-of-clause.factor-bldr
+                     lemma-3-for-forcing-logic.appealp-of-clause.factor-bldr
+                     lemma-1-for-forcing-logic.conclusion-of-clause.factor-bldr
+                     lemma-2-for-forcing-logic.conclusion-of-clause.factor-bldr
+                     lemma-3-for-forcing-logic.conclusion-of-clause.factor-bldr
+                     lemma-forcing-memberp-of-pequal-a-nil-in-assignment-formulas
+                     lemma-forcing-memberp-of-logic.pnot-pequal-a-nil-in-assignment-formulas)
+            (%disable default
+                      clause.factor-openers
+                      clause.factor-bldr-openers
+                      forcing-equal-of-logic.por-rewrite-two
+                      forcing-equal-of-logic.por-rewrite
+                      forcing-equal-of-logic.pequal-rewrite-two
+                      forcing-equal-of-logic.pequal-rewrite
+                      forcing-equal-of-logic.pnot-rewrite-two
+                      forcing-equal-of-logic.pnot-rewrite
+                      forcing-equal-of-logic.por-list-rewrite-alt
+                      forcing-equal-of-logic.por-list-rewrite
+                      forcing-equal-of-logic.pequal-list-rewrite
+                      forcing-equal-of-logic.pequal-list-rewrite-alt
+                      equal-of-cons-rewrite
+                      equal-of-booleans-rewrite
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots
+                      not-equal-when-less
+                      not-equal-when-less-two
+                      equal-of-non-cons-and-cons-cheap
+                      equal-of-symbol-and-non-symbol-cheap
+                      equal-of-non-symbol-and-symbol-cheap
+                      equal-of-cons-and-non-cons-cheap
+                      equal-of-nat-and-non-nat-cheap
+                      equal-of-non-nat-and-nat-cheap)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%enable default
+                     forcing-equal-of-logic.por-rewrite-two
+                     forcing-equal-of-logic.por-rewrite
+                     forcing-equal-of-logic.pequal-rewrite-two
+                     forcing-equal-of-logic.pequal-rewrite
+                     forcing-equal-of-logic.por-list-rewrite-alt
+                     forcing-equal-of-logic.por-list-rewrite
+                     forcing-equal-of-logic.pequal-list-rewrite
+                     forcing-equal-of-logic.pequal-list-rewrite-alt)
+            (%crewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%enable default
+                     aggressive-equal-of-logic.pequals
+                     aggressive-equal-of-logic.pors
+                     aggressive-equal-of-logic.pnots
+                     equal-of-cons-rewrite
+                     equal-of-booleans-rewrite)
+            (%crewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%enable default
+                     clause.factor-openers
+                     clause.factor-bldr-openers)
+            (%disable default
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free)
+            (%crewrite default))
+
+(%autoprove forcing-logic.appealp-of-clause.factor-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.factor-bldr)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.conclusion-of-clause.factor-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.factor-bldr)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.appeal-listp-of-clause.factor-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.factor-bldr)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.factor-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.factor-bldr)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-1-for-forcing-logic.proofp-of-clause.factor-bldr)
+
+(%autoprove lemma-2-for-forcing-logic.proofp-of-clause.factor-bldr)
+
+(%autoprove lemma-3-for-forcing-logic.proofp-of-clause.factor-bldr)
+
+(%autoprove lemma-for-forcing-logic.proofp-of-clause.factor-bldr
+            (%clause.simple-term-induction flag x)
+            (%enable default
+                     lemma-1-for-forcing-logic.proofp-of-clause.factor-bldr
+                     lemma-2-for-forcing-logic.proofp-of-clause.factor-bldr
+                     lemma-3-for-forcing-logic.proofp-of-clause.factor-bldr
+                     lemma-forcing-memberp-of-pequal-a-nil-in-assignment-formulas
+                     lemma-forcing-memberp-of-logic.pnot-pequal-a-nil-in-assignment-formulas)
+            (%disable default
+                      forcing-equal-of-logic.pequal-list-rewrite
+                      forcing-equal-of-logic.por-list-rewrite
+                      equal-of-cons-rewrite
+                      equal-of-booleans-rewrite
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots
+                      not-equal-when-less
+                      not-equal-when-less-two
+                      equal-of-non-cons-and-cons-cheap
+                      equal-of-symbol-and-non-symbol-cheap
+                      equal-of-non-symbol-and-symbol-cheap
+                      equal-of-cons-and-non-cons-cheap
+                      equal-of-nat-and-non-nat-cheap
+                      equal-of-non-nat-and-nat-cheap))
+
+(%autoprove forcing-logic.proofp-of-clause.factor-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-clause.factor-bldr)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.proof-listp-of-clause.factor-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-clause.factor-bldr)
+                             (flag 'list))))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/factor.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/factor.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/factor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/factor.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,156 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-termp")
+(%interactive)
+
+
+(%autoadmit clause.flag-factor)
+(%disable default clause.flag-factor)
+
+
+(%autoadmit clause.factor)
+(%autoadmit clause.factor-list)
+
+(%autoprove definition-of-clause.factor
+            (%enable default clause.factor clause.factor-list)
+            (%restrict default clause.flag-factor (equal x 'x)))
+
+(%autoprove definition-of-clause.factor-list
+            (%enable default clause.factor clause.factor-list)
+            (%restrict default clause.flag-factor (equal x 'x)))
+
+(%autoprove clause.flag-factor-of-term-removal
+            (%enable default clause.factor))
+
+(%autoprove clause.flag-factor-of-list-removal
+            (%enable default clause.factor-list))
+
+(%autoprove clause.factor-list-when-not-consp
+            (%restrict default definition-of-clause.factor-list (equal x 'x)))
+
+(%autoprove clause.factor-list-of-cons
+            (%restrict default definition-of-clause.factor-list (equal x '(cons a x))))
+
+(%defprojection :list (clause.factor-list x assignment)
+                :element (clause.factor x assignment))
+
+(%autoprove clause.factor-list-when-len-three)
+
+(%autoprove clause.factor-when-logic.constantp
+            (%restrict default definition-of-clause.factor (equal x 'x)))
+
+(%autoprove clause.factor-when-logic.variablep
+            (%restrict default definition-of-clause.factor (equal x 'x)))
+
+(%autoprove clause.factor-when-non-if-logic.functionp
+            (%restrict default definition-of-clause.factor (equal x 'x)))
+
+(%autoprove clause.factor-when-bad-args-logic.functionp
+            (%restrict default definition-of-clause.factor (equal x 'x)))
+
+(%autoprove clause.factor-when-if-expression
+            (%forcingp nil)
+            (%restrict default definition-of-clause.factor (equal x 'x)))
+
+(%autoprove clause.factor-when-logic.lambdap
+            (%restrict default definition-of-clause.factor (equal x 'x)))
+
+(%autoprove clause.factor-when-degenerate
+            (%restrict default definition-of-clause.factor (equal x 'x)))
+
+
+(%autoprove lemma-for-forcing-logic.termp-of-clause.factor
+            (%clause.simple-term-induction flag x)
+            (%disable default
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      forcing-logic.functionp-when-logic.base-evaluablep
+                      not-equal-when-less
+                      trichotomy-of-<
+                      logic.formulap-when-not-consp))
+
+(%autoprove forcing-logic.termp-of-clause.factor
+            (%use (%instance (%thm lemma-for-forcing-logic.termp-of-clause.factor)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-listp-of-clause.factor-list
+            (%use (%instance (%thm lemma-for-forcing-logic.termp-of-clause.factor)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-forcing-logic.term-atblp-of-clause.factor
+            (%clause.simple-term-induction flag x)
+            (%disable default
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      forcing-logic.functionp-when-logic.base-evaluablep
+                      not-equal-when-less
+                      trichotomy-of-<
+                      logic.formulap-when-not-consp))
+
+(%autoprove forcing-logic.term-atblp-of-clause.factor
+            (%use (%instance (%thm lemma-for-forcing-logic.term-atblp-of-clause.factor)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.factor-list
+            (%use (%instance (%thm lemma-for-forcing-logic.term-atblp-of-clause.factor)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-clause.factor-when-not-consp-of-assignment
+            (%clause.simple-term-induction flag x)
+            (%disable default
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      forcing-logic.functionp-when-logic.base-evaluablep
+                      not-equal-when-less
+                      trichotomy-of-<
+                      logic.formulap-when-not-consp))
+
+(%autoprove clause.factor-when-not-consp-of-assignment
+            (%use (%instance (%thm lemma-for-clause.factor-when-not-consp-of-assignment)
+                             (flag 'term))))
+
+(%autoprove clause.factor-list-when-not-consp-of-assignment
+            (%use (%instance (%thm lemma-for-clause.factor-when-not-consp-of-assignment)
+                             (flag 'list))))
+
+
+(%defprojection :list (clause.multifactor term x)
+                :element (clause.factor term x))
+
+(%autoprove forcing-logic.term-listp-of-clause.multifactor
+            (%cdr-induction assignments))
+
+
+(%ensure-exactly-these-rules-are-missing "../../clauses/if-lifting/factor")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/level6.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/level6.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/level6.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/level6.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,158 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-split-bldr")
+(include-book "simple-limsplit-bldr")
+(include-book "factor-bldr-okp")
+(%interactive)
+
+(%autoadmit level6.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level6.step-okp))
+ (%autoprove soundness-of-level6.step-okp)
+ (%autoprove level6.step-okp-when-level5.step-okp
+             (%forcingp nil)
+             (%enable default level5.step-okp)
+             (%auto)
+             (%enable default level4.step-okp)
+             (%auto)
+             (%enable default level3.step-okp)
+             (%auto)
+             (%enable default level2.step-okp)
+             (%auto)
+             (%enable default logic.appeal-step-okp))
+ (%autoprove level6.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%disable default forcing-true-listp-of-logic.subproofs))
+ (%autoadmit level6.flag-proofp-aux))
+
+(%autoadmit level6.proofp-aux)
+(%autoadmit level6.proof-listp-aux)
+(%autoprove definition-of-level6.proofp-aux
+            (%enable default level6.proofp-aux level6.proof-listp-aux)
+            (%restrict default level6.flag-proofp-aux (equal x 'x)))
+(%autoprove definition-of-level6.proof-listp-aux
+            (%enable default level6.proofp-aux level6.proof-listp-aux)
+            (%restrict default level6.flag-proofp-aux (equal x 'x)))
+
+
+(%autoprove level6.proofp-aux-when-not-consp      (%restrict default definition-of-level6.proofp-aux (equal x 'x)))
+(%autoprove level6.proof-listp-aux-when-not-consp (%restrict default definition-of-level6.proof-listp-aux (equal x 'x)))
+(%autoprove level6.proof-listp-aux-of-cons        (%restrict default definition-of-level6.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level6.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level6.proofp-aux (equal x 'x)))
+
+(%autoprove booleanp-of-level6.proofp-aux      (%use (%instance (%thm lemma-for-booleanp-of-level6.proofp-aux) (flag 'proof))))
+(%autoprove booleanp-of-level6.proof-listp-aux (%use (%instance (%thm lemma-for-booleanp-of-level6.proofp-aux) (flag 'list))))
+
+
+(%deflist level6.proof-listp-aux (x axioms thms atbl)
+          (level6.proofp-aux x axioms thms atbl))
+
+(%autoprove lemma-for-logic.provablep-when-level6.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%urewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%restrict default definition-of-level6.proofp-aux (equal x 'x))
+            (%auto :strategy (cleanup split urewrite))
+            (%disable default
+                      ;; so many memberp terms that these get expensive
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-subset-of-somep-cheap
+                      memberp-when-not-superset-of-somep-cheap
+                      type-set-like-rules
+                      same-length-prefixes-equal-cheap
+                      logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest))
+
+(%autoprove logic.provablep-when-level6.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level6.proofp-aux) (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level6.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level6.proofp-aux) (flag 'list))))
+
+
+
+(%autoprove lemma-for-level6.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level6.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove level6.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level6.proofp-aux-when-logic.proofp) (flag 'proof))))
+
+(%autoprove level6.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level6.proofp-aux-when-logic.proofp) (flag 'list))))
+
+(%autoprove forcing-level6.proofp-aux-of-logic.provable-witness
+            (%enable default level6.proofp-aux-when-logic.proofp))
+
+
+
+(%autoadmit level6.proofp)
+(%autoprove booleanp-of-level6.proofp
+            (%enable default level6.proofp))
+(%autoprove logic.provablep-when-level6.proofp
+            (%enable default level6.proofp))
+
+
+(defsection level6-transition
+  (%install-new-proofp level6.proofp)
+  (%auto)
+  (%qed-install))
+
+
+(%switch-builder clause.simple-split-bldr     clause.simple-split-bldr-high)
+(%switch-builder clause.simple-limsplit-bldr  clause.simple-limsplit-bldr-high)
+(%switch-builder clause.factor-bldr           clause.factor-bldr-high)
+
+
+
+(%finish "level6")
+(%save-events "level6.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/lifted-termp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/lifted-termp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/lifted-termp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/lifted-termp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,102 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-termp")
+(%interactive)
+
+(%autoadmit clause.lifted-termp)
+
+(%autoprove clause.lifted-termp-when-logic.constantp
+            (%restrict default clause.lifted-termp (equal x 'x)))
+
+(%autoprove clause.lifted-termp-when-logic.variablep
+            (%restrict default clause.lifted-termp (equal x 'x)))
+
+(%autoprove clause.lifted-termp-when-not-if
+            (%restrict default clause.lifted-termp (equal x 'x)))
+
+(%autoprove clause.lifted-termp-when-bad-args-logic.functionp
+            (%restrict default clause.lifted-termp (equal x 'x)))
+
+(%autoprove clause.lifted-termp-when-if-logic.functionp
+            (%restrict default clause.lifted-termp (equal x 'x)))
+
+(%autoprove clause.lifted-termp-when-if-logic.lambdap
+            (%restrict default clause.lifted-termp (equal x 'x)))
+
+(%autoprove clause.lifted-termp-when-degenerate
+            (%restrict default clause.lifted-termp (equal x 'x)))
+
+(defmacro %clause.lifted-termp-induction (x)
+  `(%induct (rank ,x)
+            ((logic.constantp ,x) nil)
+            ((logic.variablep ,x) nil)
+            ((and (logic.functionp ,x)
+                  (equal (logic.function-name ,x) 'if)
+                  (equal (len (logic.function-args ,x)) 3))
+             (((,x (first (logic.function-args ,x))))
+              ((,x (second (logic.function-args ,x))))
+              ((,x (third (logic.function-args ,x))))))
+            ((and (logic.functionp ,x)
+                  (not (and (equal (logic.function-name ,x) 'if)
+                            (equal (len (logic.function-args ,x)) 3))))
+             nil)
+            ((logic.lambdap ,x) nil)
+            ((not (or (logic.constantp ,x)
+                      (logic.variablep ,x)
+                      (logic.functionp ,x)
+                      (logic.lambdap ,x)))
+             nil)))
+
+(%autoprove clause.lifted-termp-when-clause.simple-termp
+            (%clause.lifted-termp-induction x))
+
+(%autoprove booleanp-of-clause.lifted-termp
+            (%clause.lifted-termp-induction x))
+
+(%deflist clause.lifted-term-listp (x)
+          (clause.lifted-termp x))
+
+(%ensure-exactly-these-rules-are-missing "../../clauses/if-lifting/lifted-termp")
+
+(%create-theory clause.lifted-termp-openers)
+(%enable clause.lifted-termp-openers
+         clause.lifted-termp-when-logic.constantp
+         clause.lifted-termp-when-logic.variablep
+         clause.lifted-termp-when-not-if
+         clause.lifted-termp-when-bad-args-logic.functionp
+         clause.lifted-termp-when-if-logic.functionp
+         clause.lifted-termp-when-if-logic.lambdap
+         clause.lifted-termp-when-degenerate)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level6/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/make-image.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level5/level5")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level6-symmetry"
+                 "Pre-loaded bootstrap/level5 directory.")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/memory.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level6/memory.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/memory.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/memory.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,32 @@
+(in-package "ACL2")
+
+;; We want to try boosting the threshold so that we can allocate more between gc's.
+
+ -- we can try increasing the lisp-heap-gc-threshold
+    (CCL::set-lisp-heap-gc-threshold (expt 2 31)) ;; 2 gigabytes
+    (ACL2::save-exec "2gb-acl2" "Baseline, then with a 2 gigabyte threshold")
+
+ -- we want to try not "releasing" pages because we cons at a high rate
+    (CCL::gc-retain-pages t)
+    (ACL2::save-exec "release-acl2" "Now retaining pages.")
+
+ -- we might chang ethe egc-configuration by changing the sizes of the generations.
+    we would need to experiment to find ideal values.
+    (CCL::egc-configuration) --> 2048 4096 8192
+    (CCL::configure-egc 4096 8192 16384)
+    (ACL2::save-exec "2gen-acl2" "Baseline, then doubled the egc generation sizes")
+
+ -- we probably don't need a value stack or temp stack as large as we're requesting
+    we might not want to mess with the defaults at all.
+
+
+ -- try turning off egc completely
+    (CCL::egc nil)
+
+ -- try clearing the memo tables after each crewrite?
+    sol says we can use (acl2::clear-memoize-table 'foo) to just erase the table for
+    foo.  maybe we want to get rid of the tables for:
+      rw.assumptions-trace    (since assms probably won't be the same)
+      rw.create-sigmas-to-try (since assms probably won't be the same)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-limsplit-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-limsplit-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-limsplit-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-limsplit-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,70 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-limsplit")
+(include-book "aux-limsplit-bldr")
+(%interactive)
+
+(%autoadmit clause.simple-limsplit-bldr)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 clause.simple-limsplit
+                 clause.simple-limsplit-bldr))
+
+ (%autoprove forcing-logic.appealp-of-clause.simple-limsplit-bldr)
+ (%autoprove forcing-logic.conclusion-of-clause.simple-limsplit-bldr)
+ (%autoprove forcing-logic.proofp-of-clause.simple-limsplit-bldr))
+
+
+(%autoadmit clause.simple-limsplit-bldr-okp)
+
+(%autoadmit clause.simple-limsplit-bldr-high)
+(local (%enable default clause.simple-limsplit-bldr-okp))
+(%autoprove booleanp-of-clause.simple-limsplit-bldr-okp)
+(%autoprove clause.simple-limsplit-bldr-okp-of-logic.appeal-identity)
+(%autoprove lemma-1-for-soundness-of-clause.simple-limsplit-bldr-okp)
+(%autoprove lemma-2-for-soundness-of-clause.simple-limsplit-bldr-okp)
+(%autoprove forcing-soundness-of-clause.simple-limsplit-bldr-okp
+            (%enable default
+                     lemma-1-for-soundness-of-clause.simple-limsplit-bldr-okp
+                     lemma-2-for-soundness-of-clause.simple-limsplit-bldr-okp)
+            (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                             (x (clause.simple-limsplit-bldr (first (logic.extras x))
+                                                             (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                                          axioms thms atbl)
+                                                             (second (logic.extras x)))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-limsplit.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-limsplit.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-limsplit.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-limsplit.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,48 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-limsplit")
+(%interactive)
+
+(%autoadmit clause.simple-limsplit)
+
+(local (%enable default clause.simple-limsplit))
+
+(%autoprove true-listp-of-clause.simple-limsplit)
+;(%autoprove consp-of-clause.simple-limsplit)
+;(%autoprove clause.simple-limsplit-under-iff)
+(%autoprove forcing-term-list-listp-of-clause.simple-limsplit)
+(%autoprove forcing-term-list-list-atblp-of-clause.simple-limsplit)
+(%autoprove forcing-cons-listp-of-clause.simple-limsplit)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-negativep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-negativep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-negativep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-negativep.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,179 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(defthmd lemma-split-up-list-of-quoted-nil
+  ;; We normally don't break up constants, but this one gets in the way if we don't.
+  (equal (equal x '('nil))
+         (and (consp x)
+              (equal (car x) ''nil)
+              (not (cdr x)))))
+
+(%autoprove lemma-split-up-list-of-quoted-nil)
+
+(local (%enable default lemma-split-up-list-of-quoted-nil))
+
+(%autoadmit clause.simple-negativep)
+(%autoadmit clause.simple-negative-guts)
+
+(%autoprove booleanp-of-clause.simple-negativep
+            (%enable default clause.simple-negativep))
+
+(%autoprove forcing-logic.termp-of-clause.simple-negative-guts
+            (%enable default clause.simple-negativep clause.simple-negative-guts))
+
+(%autoprove forcing-logic.term-atblp-of-clause.simple-negative-guts
+            (%enable default clause.simple-negativep clause.simple-negative-guts))
+
+(%autoprove clause.simple-negativep-of-logic.function-of-not
+            (%enable default clause.simple-negativep))
+
+(%autoprove clause.negative-termp-when-clause.simple-negativep
+            (%enable default clause.simple-negativep clause.negative-termp))
+
+(%autoprove clause.simple-negative-guts-of-logic.function-of-not
+            (%enable default clause.simple-negative-guts))
+
+(%autoprove clause.simple-negative-guts-identity
+            (%enable default clause.simple-negativep clause.simple-negative-guts))
+
+(%autoprove forcing-clause.simple-negative-guts-under-iff
+            (%enable default clause.simple-negativep clause.simple-negative-guts))
+
+
+
+(%autoadmit clause.double-negative-free-listp)
+
+(%autoprove clause.double-negative-free-listp-when-not-consp
+            (%restrict default clause.double-negative-free-listp (equal x 'x)))
+
+(%autoprove clause.double-negative-free-listp-of-cons
+            (%restrict default clause.double-negative-free-listp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-clause.double-negative-free-listp
+            (%cdr-induction x))
+
+(%autoprove clause.double-negative-free-listp-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove clause.double-negative-free-listp-of-app
+            (%cdr-induction x))
+
+(%autoprove clause.double-negative-free-listp-of-rev
+            (%cdr-induction x))
+
+
+
+
+
+
+#|
+
+
+
+
+
+
+
+
+;; sweet!  now can we fold in the removing duplicates as well?  hrmn.  this seems
+;; to create problems because remove-duplicates does not have nice reversibility
+;; properties.  that is, the element order is left up to where the elements occur
+;; in the cdr.  that's actually a pretty shitty order to choose.  we might want to
+;; redesign remove-duplicates to keep the first one of each element instead
+
+
+
+;(defund clause.fast-clean-part1 (x acc)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x))))
+  (if (consp x)
+      (let ((normalized-clause (clause.fast-normalize-nots-term-list$ (car x) nil)))
+        (if (or (clause.find-obvious-term normalized-clause)
+                (clause.find-complementary-literal normalized-clause))
+            (clause.fast-clean-part1 (cdr x) acc)
+          (clause.fast-clean-part1 (cdr x)
+                                   (cons (clause.fast-remove-absurd-terms-from-list$ normalized-clause nil)
+                                         acc))))
+    acc))
+
+(%autoprove clause.fast-clean-part1-removal
+  (implies (force (and (true-listp acc)
+                       (logic.term-list-listp x)))
+           (equal (clause.fast-clean-part1 x acc)
+                  (revappend (clause.remove-absurd-terms-from-clauses
+                              (clause.remove-complement-clauses
+                               (clause.remove-obvious-clauses
+                                (clause.normalize-nots-clauses x))))
+                             acc)))
+  :hints(("Goal"
+          :in-theory (e/d (clause.fast-clean-part1
+                           clause.normalize-nots-term-list-of-rev)
+                          (rev-of-clause.normalize-nots-term-list)))))
+
+
+;(defund clause.fast-clean-clauses (x)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x))))
+  (let ((pass4 (clause.fast-clean-part1 x nil)))
+    (if (not (cons-listp pass4))
+        ;; Some clause is absurd.
+        (list t nil (list-fix x))
+      (let* ((pass5 (fast-remove-duplicates-list$ pass4 nil))
+             (pass6 (remove-supersets pass5)))
+        (list nil (not (disabled-equal x pass6)) pass6)))))
+
+
+
+
+
+(%autoprove clause.fast-clean-clauses-removal
+  (implies (force (logic.term-list-listp x))
+           (equal (clause.fast-clean-clauses x)
+                  (clause.clean-clauses x)))
+  :hints(("Goal" :in-theory (e/d (clause.clean-clauses
+                                  clause.fast-clean-clauses
+                                  clause.normalize-nots-clauses-of-rev
+                                  clause.remove-obvious-clauses-of-rev
+                                  clause.remove-complement-clauses-of-rev
+                                  )
+                                 (rev-of-clause.normalize-nots-clauses
+                                  rev-of-clause.remove-obvious-clauses
+                                  rev-of-clause.remove-complement-clauses
+                                  )))))
+
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-split-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-split-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-split-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-split-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,69 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-split")
+(include-book "aux-split-bldr")
+(%interactive)
+
+
+(%autoadmit clause.simple-split-bldr)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 clause.simple-split
+                 clause.simple-split-bldr))
+
+ (%autoprove forcing-logic.appealp-of-clause.simple-split-bldr)
+ (%autoprove forcing-logic.conclusion-of-clause.simple-split-bldr)
+ (%autoprove forcing-logic.proofp-of-clause.simple-split-bldr))
+
+
+
+(%autoadmit clause.simple-split-bldr-okp)
+(%autoadmit clause.simple-split-bldr-high)
+(local (%enable default clause.simple-split-bldr-okp))
+(%autoprove booleanp-of-clause.simple-split-bldr-okp)
+(%autoprove clause.simple-split-bldr-okp-of-logic.appeal-identity)
+(%autoprove lemma-1-for-soundness-of-clause.simple-split-bldr-okp)
+(%autoprove lemma-2-for-soundness-of-clause.simple-split-bldr-okp)
+(%autoprove forcing-soundness-of-clause.simple-split-bldr-okp
+            (%enable default
+                     lemma-1-for-soundness-of-clause.simple-split-bldr-okp
+                     lemma-2-for-soundness-of-clause.simple-split-bldr-okp)
+            (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                             (x (clause.simple-split-bldr (logic.extras x)
+                                                          (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                                       axioms thms atbl))))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-split.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-split.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-split.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-split.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,50 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(%interactive)
+
+
+(%autoadmit clause.simple-split)
+(local (%enable default clause.simple-split))
+(%autoprove true-listp-of-clause.simple-split)
+;(%autoprove consp-of-clause.simple-split)
+;(%autoprove clause.simple-split-under-iff)
+(%autoprove forcing-term-list-listp-of-clause.simple-split)
+(%autoprove forcing-term-list-list-atblp-of-clause.simple-split)
+(%autoprove forcing-cons-listp-of-clause.simple-split)
+
+;; we don't really care about this for soundness.
+;; (%autoprove clause.simple-term-list-listp-of-clause.simple-split-when-clause.lifted-term-listp)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-termp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-termp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/simple-termp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/simple-termp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,156 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit clause.flag-simple-termp)
+(%autoadmit clause.simple-termp)
+(%autoadmit clause.simple-term-listp)
+
+(%autoprove definition-of-clause.simple-termp
+            (%enable default clause.simple-termp clause.simple-term-listp)
+            (%restrict default clause.flag-simple-termp (equal x 'x)))
+
+(%autoprove definition-of-clause.simple-term-listp
+            (%enable default clause.simple-termp clause.simple-term-listp)
+            (%restrict default clause.flag-simple-termp (equal x 'x)))
+
+(%autoprove clause.flag-simple-termp-of-term-removal
+            (%enable default clause.simple-termp))
+
+(%autoprove clause.flag-simple-termp-of-list-removal
+            (%enable default clause.simple-term-listp))
+
+(%autoprove clause.simple-termp-when-logic.variablep
+            (%restrict default definition-of-clause.simple-termp (equal x 'x)))
+
+(%autoprove clause.simple-termp-when-logic.constantp
+            (%restrict default definition-of-clause.simple-termp (equal x 'x)))
+
+(%autoprove clause.simple-termp-when-non-if-logic.functionp
+            (%restrict default definition-of-clause.simple-termp (equal x 'x)))
+
+(%autoprove clause.simple-termp-when-bad-args-logic.functionp
+            (%restrict default definition-of-clause.simple-termp (equal x 'x)))
+
+(%autoprove clause.simple-termp-when-if-logic.functionp
+            (%restrict default definition-of-clause.simple-termp (equal x 'x)))
+
+(%autoprove clause.simple-termp-when-logic.lambdap
+            (%restrict default definition-of-clause.simple-termp (equal x 'x)))
+
+(%autoprove clause.simple-termp-when-degenerate
+            (%restrict default definition-of-clause.simple-termp (equal x 'x)))
+
+
+(defmacro %clause.simple-term-induction (flag x)
+  `(%induct (rank ,x)
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.variablep ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x)
+                  (equal (logic.function-name ,x) 'if)
+                  (equal (len (logic.function-args ,x)) 3))
+             (((,flag 'term) (,x (first (logic.function-args ,x))))
+              ((,flag 'term) (,x (second (logic.function-args ,x))))
+              ((,flag 'term) (,x (third (logic.function-args ,x))))))
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x)
+                  (not (and (equal (logic.function-name ,x) 'if)
+                            (equal (len (logic.function-args ,x)) 3))))
+             (((,flag 'list) (,x (logic.function-args ,x)))))
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+             (((,flag 'list) (,x (logic.lambda-actuals ,x)))))
+            ((and (equal ,flag 'term)
+                  (not (or (logic.constantp ,x)
+                           (logic.variablep ,x)
+                           (logic.functionp ,x)
+                           (logic.lambdap ,x))))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term) (,x (car ,x)))
+              ((,flag 'list) (,x (cdr ,x)))))))
+
+(%autoprove clause.simple-term-listp-when-not-consp
+            (%restrict default definition-of-clause.simple-term-listp (equal x 'x)))
+
+(%autoprove clause.simple-term-listp-of-cons
+            (%restrict default definition-of-clause.simple-term-listp (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-clause.simple-termp
+            (%clause.simple-term-induction flag x))
+
+(%autoprove booleanp-of-clause.simple-termp
+            (%use (%instance (%thm lemma-for-booleanp-of-clause.simple-termp)
+                             (flag 'term))))
+
+(%autoprove booleanp-of-clause.simple-term-listp
+            (%use (%instance (%thm lemma-for-booleanp-of-clause.simple-termp)
+                             (flag 'list))))
+
+(%deflist clause.simple-term-listp (x)
+          (clause.simple-termp x))
+
+
+(%autoprove clause.simple-term-listp-when-length-three)
+
+(%deflist clause.simple-term-list-listp (x)
+          (clause.simple-term-listp x))
+
+
+
+(%create-theory clause.simple-termp-openers)
+(%enable clause.simple-termp-openers
+         clause.simple-termp-when-logic.variablep
+         clause.simple-termp-when-logic.constantp
+         clause.simple-termp-when-non-if-logic.functionp
+         clause.simple-termp-when-bad-args-logic.functionp
+         clause.simple-termp-when-if-logic.functionp
+         clause.simple-termp-when-logic.lambdap
+         clause.simple-termp-when-degenerate)
+
+
+(%ensure-exactly-these-rules-are-missing "../../clauses/if-lifting/simple-termp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/standardize-double-negative-term-under-iff-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level6/standardize-double-negative-term-under-iff-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/standardize-double-negative-term-under-iff-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/standardize-double-negative-term-under-iff-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%autoadmit clause.standardize-double-negative-term-under-iff-bldr)
+
+(local (%enable default
+                clause.standardize-double-negative-term-under-iff-bldr
+                theorem-not-of-not-under-iff))
+
+(%autoprove forcing-logic.appealp-of-clause.standardize-double-negative-term-under-iff-bldr)
+(%autoprove forcing-logic.conclusion-of-clause.standardize-double-negative-term-under-iff-bldr)
+(%autoprove forcing-logic.proofp-of-clause.standardize-double-negative-term-under-iff-bldr)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level6/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level6/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level6/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level6/symmetry	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level6-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/absurd.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/absurd.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/absurd.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/absurd.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,102 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit clause.absurd-termp)
+
+(%autoprove booleanp-of-clause.absurd-termp
+            (%enable default clause.absurd-termp))
+
+
+(%autoadmit clause.remove-absurd-terms-from-list)
+
+(%autoprove clause.remove-absurd-terms-from-list-when-not-consp
+            (%restrict default clause.remove-absurd-terms-from-list (equal x 'x)))
+
+(%autoprove clause.remove-absurd-terms-from-list-of-cons
+            (%restrict default clause.remove-absurd-terms-from-list (equal x '(cons a x))))
+
+(%autoprove true-listp-of-clause.remove-absurd-terms-from-list
+            (%cdr-induction x))
+
+(%autoprove clause.remove-absurd-terms-from-list-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove clause.remove-absurd-terms-from-list-of-app
+            (%cdr-induction x))
+
+(%autoprove rev-of-clause.remove-absurd-terms-from-list
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-clause.remove-absurd-terms-from-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-listp-of-clause.remove-absurd-terms-from-list
+            (%cdr-induction x))
+
+
+
+(%defprojection :list (clause.remove-absurd-terms-from-clauses x)
+                :element (clause.remove-absurd-terms-from-list x))
+
+(%autoprove all-superset-of-somep-of-clause.remove-absurd-terms-from-clauses
+            (%cdr-induction x))
+
+(%autoprove all-subset-of-somep-of-clause.remove-absurd-terms-from-clauses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-listp-of-clause.remove-absurd-terms-from-clauses
+            (%cdr-induction x))
+
+
+
+
+(%autoadmit clause.fast-remove-absurd-terms-from-list$)
+
+(%autoprove clause.fast-remove-absurd-terms-from-list$-removal
+            (%induct (rank x)
+                     ((not (consp x))
+                      nil)
+                     ((and (consp x)
+                           (clause.absurd-termp (car x)))
+                      (((x (cdr x)) (acc acc))))
+                     ((and (consp x)
+                           (not (clause.absurd-termp (car x))))
+                      (((x (cdr x)) (acc (cons (car x) acc))))))
+            (%restrict default clause.fast-remove-absurd-terms-from-list$ (equal x 'x)))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level7/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/acl2-customization.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/casesplit-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/casesplit-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/casesplit-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/casesplit-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,92 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "casesplit")
+(%interactive)
+
+
+(%autoprove cdr-of-logic.smart-negate-formulas)
+
+(%autoprove car-of-logic.smart-negate-formulas
+            (%forcingp nil))
+
+(%autoadmit clause.cases-bldr)
+
+
+(defthm lemma-for-forcing-logic.appealp-of-clause.cases-bldr-alt
+  ;; BOZO the real lemma needs :rule-classes nil added
+  (implies (and (logic.termp a)
+                (logic.term-listp cases)
+                (logic.term-listp (domain assignment)))
+           (and (logic.appealp (clause.cases-bldr a cases assignment))
+                (equal (logic.conclusion (clause.cases-bldr a cases assignment))
+                       (if (consp assignment)
+                           (logic.por (logic.disjoin-formulas (logic.smart-negate-formulas (assignment-formulas assignment)))
+                                      (logic.pequal a (clause.casesplit a cases assignment)))
+                         (logic.pequal a (clause.casesplit a cases assignment))))))
+  :rule-classes nil)
+
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.cases-bldr-alt
+            (%clause.cases-induction cases assignment)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      expensive-term/formula-inference
+                      type-set-like-rules
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free)
+            (%auto :strategy (cleanup split))
+            (%restrict default clause.cases-bldr (equal cases 'cases))
+            (%restrict default clause.casesplit (equal cases 'cases)))
+
+(%autoprove forcing-logic.appealp-of-clause.cases-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.cases-bldr-alt))))
+
+(%autoprove forcing-logic.conclusion-of-clause.cases-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.cases-bldr-alt))))
+
+
+
+(%autoprove forcing-proofp-of-clause.cases-bldr
+            (%clause.cases-induction cases assignment)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      expensive-term/formula-inference
+                      type-set-like-rules
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free)
+            (%auto :strategy (cleanup split))
+            (%restrict default clause.cases-bldr (equal cases 'cases))
+            (%restrict default clause.casesplit (equal cases 'cases)))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/casesplit.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/casesplit.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/casesplit.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/casesplit.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,85 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(%autoadmit clause.casesplit)
+
+(%autoprove clause.casesplit-when-not-consp
+            (%restrict default clause.casesplit (equal cases 'cases)))
+
+(%autoprove clause.casesplit-of-cons
+            (%restrict default clause.casesplit (equal cases '(cons a cases))))
+
+(defmacro %clause.cases-induction (cases assignment)
+  `(%induct (rank ,cases)
+            ((not (consp ,cases))
+             nil)
+            ((consp ,cases)
+             (((,cases (cdr ,cases)) (,assignment (update (car ,cases) t ,assignment)))
+              ((,cases (cdr ,cases)) (,assignment (update (car ,cases) nil ,assignment)))))))
+
+(%autoprove forcing-logic.termp-of-clause.casesplit
+            (%clause.cases-induction cases assignment))
+
+(%autoprove forcing-logic.term-atblp-of-clause.casesplit
+            (%clause.cases-induction cases assignment))
+
+
+
+(%autoadmit clause.cases)
+
+(%autoprove clause.cases-when-not-consp
+            (%restrict default clause.cases (equal cases 'cases)))
+
+(%autoprove clause.cases-of-cons
+            (%restrict default clause.cases (equal cases '(cons a cases))))
+
+(%autoprove consp-of-clause.cases
+            (%clause.cases-induction cases assignment))
+
+(%autoprove domain-of-clause.cases
+            (%clause.cases-induction cases baseassign))
+
+(%autoprove clause.simple-term-listp-of-domain-of-clause.cases)
+
+(%autoprove disjoint-from-nonep-of-domain-of-clause.cases)
+
+
+(%ensure-exactly-these-rules-are-missing "../../clauses/if-lifting/casesplit")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level7/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/cert.image	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1 @@
+level7-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/clean-clauses.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/clean-clauses.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/clean-clauses.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/clean-clauses.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,102 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "absurd")
+(include-book "normalize-nots")
+(%interactive)
+
+
+(%autoadmit disabled-equal)
+(%autoadmit clause.clean-clauses)
+
+(defsection clause.clean-clauses
+  (local (%enable default clause.clean-clauses disabled-equal))
+  (%autoprove booleanp-of-first-of-clause.clean-clauses)
+  (%autoprove booleanp-of-second-of-clause.clean-clauses)
+  (%autoprove logic.term-list-listp-of-third-of-clause.clean-clauses)
+  (%autoprove logic.cons-listp-of-third-of-clause.clean-clauses)
+  (%autoprove true-listp-of-third-of-clause.clean-clauses))
+
+(%autoadmit clause.clean-clauses-bldr)
+
+(%autoprove forcing-logic.appeal-listp-of-clause.clean-clauses-bldr
+            (%enable default clause.clean-clauses-bldr clause.clean-clauses disabled-equal)
+            (%disable default consp-when-memberp-of-cons-listp))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.clean-clauses-bldr
+            (%enable default clause.clean-clauses-bldr clause.clean-clauses disabled-equal)
+            (%disable default consp-when-memberp-of-cons-listp))
+
+(%autoprove forcing-logic.proof-listp-of-clause.clean-clauses-bldr
+            (%enable default clause.clean-clauses-bldr clause.clean-clauses disabled-equal)
+            (%disable default consp-when-memberp-of-cons-listp))
+
+
+
+(%autoadmit clause.fast-clean-part1)
+
+(%autoprove clause.fast-clean-part1-removal
+            (%autoinduct clause.fast-clean-part1 x acc)
+            (%restrict default clause.fast-clean-part1 (equal x 'x))
+            (%enable default
+                     clause.normalize-nots-term-list-of-rev
+                     [outside]clause.normalize-nots-term-list-of-rev)
+            (%disable default
+                      rev-of-clause.normalize-nots-term-list
+                      [outside]rev-of-clause.normalize-nots-term-list))
+
+
+(%autoadmit clause.fast-clean-clauses)
+
+(%autoprove clause.fast-clean-clauses-removal
+            (%enable default
+                     clause.fast-clean-clauses
+                     clause.clean-clauses)
+            (%enable default
+                     clause.normalize-nots-clauses-of-rev
+                     clause.remove-obvious-clauses-of-rev
+                     clause.remove-complement-clauses-of-rev)
+            (%disable default
+                      rev-of-clause.normalize-nots-clauses
+                      rev-of-clause.remove-obvious-clauses
+                      rev-of-clause.remove-complement-clauses
+                      [outside]rev-of-clause.normalize-nots-clauses
+                      [outside]rev-of-clause.remove-obvious-clauses
+                      [outside]rev-of-clause.remove-complement-clauses)
+            (%disable default consp-when-memberp-of-cons-listp) ;; wtf?
+            )
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/depth-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/depth-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/depth-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/depth-1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,138 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+
+;; BOZO move these to utilities or wherever max is defined
+(defthm max-of-nfix-left
+  (equal (max (nfix a) b)
+         (max a b)))
+
+(defthm max-of-nfix-right
+  (equal (max a (nfix b))
+         (max a b)))
+
+(%autoprove max-of-nfix-left)
+(%autoprove max-of-nfix-right)
+
+
+(%autoadmit clause.flag-depth)
+(%autoadmit clause.depth)
+(%autoadmit clause.depth-list)
+
+(%autoprove definition-of-clause.depth
+            (%restrict default clause.flag-depth (equal x 'x))
+            (%enable default clause.depth clause.depth-list))
+
+(%autoprove definition-of-clause.depth-list
+            (%restrict default clause.flag-depth (equal x 'x))
+            (%enable default clause.depth clause.depth-list))
+
+(%autoprove clause.flag-depth-of-term
+            (%enable default clause.depth))
+
+(%autoprove clause.flag-depth-of-list
+            (%enable default clause.depth-list))
+
+
+
+(%autoprove forcing-clause.depth-of-logic.function
+            (%restrict default definition-of-clause.depth (memberp x '((logic.function fn args)
+                                                                       (logic.function 'if args))))
+            (%forcingp nil))
+
+(%autoprove forcing-clause.depth-of-logic.lambda
+            (%restrict default definition-of-clause.depth (equal x '(logic.lambda formals body actuals)))
+            (%forcingp nil))
+
+(%autoprove clause.depth-list-when-not-consp
+            (%restrict default definition-of-clause.depth-list (equal x 'x)))
+
+(%autoprove clause.depth-list-of-cons
+            (%restrict default definition-of-clause.depth-list (equal x '(cons a x))))
+
+
+
+(%autoprove clause.depth-list-when-length-three
+            (%disable default max))
+
+
+(%autoprove lemma-for-natp-of-clause.depth
+            (%clause.simple-term-induction flag x)
+            (%restrict default definition-of-clause.depth (equal x 'x)))
+
+(%autoprove natp-of-clause.depth
+            (%use (%instance (%thm lemma-for-natp-of-clause.depth) (flag 'term))))
+
+(%autoprove natp-of-clause.depth-list
+            (%use (%instance (%thm lemma-for-natp-of-clause.depth) (flag 'list))))
+
+
+(%autoprove clause.depth-list-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove clause.depth-list-of-app
+            (%cdr-induction x))
+
+(%autoprove clause.depth-list-of-rev
+            (%cdr-induction x))
+
+
+
+(%autoprove lemma-for-clause.depth-zero
+            (%clause.simple-term-induction flag x)
+            (%restrict default definition-of-clause.depth (equal x 'x)))
+
+(%autoprove clause.depth-zero
+            (%use (%instance (%thm lemma-for-clause.depth-zero) (flag 'term))))
+
+(%autoprove clause.depth-list-zero
+            (%use (%instance (%thm lemma-for-clause.depth-zero) (flag 'list))))
+
+
+
+(%autoprove clause.depth-when-clause.simple-termp)
+
+(%autoprove clause.depth-list-when-clause.simple-term-listp)
+
+(%autoprove clause.depth-positive-when-non-clause.simple-termp)
+
+(%autoprove clause.depth-list-positive-when-non-clause.simple-term-listp)
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/depth-2-deepest.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/depth-2-deepest.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/depth-2-deepest.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/depth-2-deepest.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,288 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "casesplit")
+(include-book "term-paths")
+(include-book "unlifted-subterms")
+(include-book "depth-1")
+(%interactive)
+
+
+;; BOZO I think this could be split up a lot better.  Lots of this doesn't seem
+;; to need deepest.
+
+
+(%autoadmit clause.deepest)
+
+(%autoprove clause.deepest-when-not-consp
+            (%restrict default clause.deepest (equal x 'x)))
+
+(%autoprove clause.deepest-of-cons
+            (%restrict default clause.deepest (equal x '(cons a x))))
+
+(%autoprove clause.deepest-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove clause.deepest-of-app
+            ;; BOZO ugly acl2 proof enables clause.deepest instead of using cdr-induction.
+            (%cdr-induction x))
+
+(%autoprove memberp-of-clause.deepest
+            (%cdr-induction x))
+
+(%autoprove positiveness-of-clause.depth-of-clause.deepest
+            (%cdr-induction x))
+
+(%autoprove clause.deepest-weakly-deeper-than-any-member
+            (%cdr-induction x))
+
+
+
+
+
+(%autoprove clause.depth-list-redefinition
+            (%cdr-induction x)
+            (%forcingp nil))
+
+
+(local (%create-theory common-disables))
+(local (%enable common-disables
+                expensive-arithmetic-rules
+                expensive-arithmetic-rules-two
+                type-set-like-rules
+                formula-decomposition
+                expensive-term/formula-inference
+                unusual-consp-rules
+                same-length-prefixes-equal-cheap
+                clause.term-tests-openers
+                clause.term-paths-openers
+                clause.lifted-termp-openers
+                clause.simple-termp-openers
+                clause.unlifted-subterms-openers
+                clause.factor-openers
+                app-when-not-consp-two
+                forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                clause.depth-list-when-not-consp
+                clause.depth-list-when-clause.simple-term-listp
+                clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                clause.simple-termp-of-car-when-clause.simple-term-listp
+                clause.depth-when-clause.simple-termp
+                clause.unlifted-subterms-when-clause.simple-termp))
+
+(%autoprove clause.unlifted-subterms-weakly-decreases-clause.depth
+            (%clause.unlifted-subterms-induction x)
+            (%disable default common-disables)
+            (%restrict default clause.unlifted-subterms (equal x 'x))
+            (%restrict default definition-of-clause.depth (equal x 'x))
+            (%auto)
+            (%enable default
+                     trichotomy-of-<
+                     antisymmetry-of-<
+                     expensive-arithmetic-rules-two
+                     expensive-term/formula-inference
+                     unusual-consp-rules))
+
+(%autoprove forcing-clause.simple-termp-of-clause.deepest
+            (%cdr-induction x))
+
+(%autoprove lemma-for-clause.factor-when-irrelevant-tests
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%disable default
+                      disjointp-when-subsetp-of-other-one
+                      disjointp-when-subsetp-of-other-two
+                      disjointp-when-subsetp-of-disjointp-four
+                      disjointp-when-subsetp-of-disjointp-three
+                      disjointp-when-subsetp-of-disjointp-two
+                      disjointp-when-subsetp-of-disjointp-one)
+            (%enable default
+                     clause.term-tests-openers
+                     clause.factor-openers)
+            (%auto)
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference
+                     unusual-consp-rules))
+
+(%autoprove clause.factor-when-irrelevant-tests
+            (%use (%instance (%thm lemma-for-clause.factor-when-irrelevant-tests)
+                             (flag 'term))))
+
+(%autoprove clause.factor-list-when-irrelevant-tests
+            (%use (%instance (%thm lemma-for-clause.factor-when-irrelevant-tests)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-clause.depth-of-clause.factor-weak
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%restrict default definition-of-clause.depth (equal x 'x))
+            (%auto)
+            (%enable default
+                     clause.simple-termp-openers
+                     clause.factor-openers)
+            (%auto)
+            (%enable default
+                     antisymmetry-of-<
+                     expensive-arithmetic-rules-two
+                     expensive-term/formula-inference
+                     unusual-consp-rules)
+            (%disable default
+                      clause.simple-termp-openers
+                      clause.factor-openers
+                      one-plus-trick
+                      less-when-zp-left-cheap
+                      clause.factor-openers
+                      squeeze-law-one
+                      squeeze-law-two
+                      squeeze-law-three))
+
+(%autoprove clause.depth-of-clause.factor-weak
+            (%use (%instance (%thm lemma-for-clause.depth-of-clause.factor-weak) (flag 'term))))
+
+(%autoprove clause.depth-of-clause.factor-list-weak
+            (%use (%instance (%thm lemma-for-clause.depth-of-clause.factor-weak) (flag 'list))))
+
+
+(%autoprove lemma-2-for-clause.depth-of-clause.factor-strong
+            (%disable default ;; speed hack
+                      type-set-like-rules
+                      squeeze-law-two
+                      same-length-prefixes-equal-cheap
+                      clause.depth-when-clause.simple-termp
+                      clause.factor-when-irrelevant-tests)
+            (%use (%instance (%thm |a <= b, b <= c --> a < 1+c|)
+                             (a (clause.depth (clause.factor a assignment)))
+                             (b (clause.depth a))
+                             (c (clause.depth b)))))
+
+
+(%autoprove lemma-for-clause.depth-of-clause.factor-strong
+            ;; BOZO expensive terrible proof
+            (%clause.simple-term-induction flag x)
+            (%auto :strategy (cleanup split urewrite))
+            (%restrict default definition-of-clause.depth (equal x 'x))
+            (%cheapen default
+                      disjoint-from-nonep-of-subsetp-when-disjoint-from-nonep
+                      disjointp-when-memberp-of-disjoint-from-nonep
+                      disjointp-when-subsetp-of-other-two
+                      disjointp-when-subsetp-of-other-one
+                      disjointp-when-subsetp-of-disjointp-four
+                      clause.factor-when-irrelevant-tests
+                      clause.factor-list-when-irrelevant-tests
+                      clause.simple-termp-when-memberp-of-clause.simple-term-listp
+                      clause.depth-when-clause.simple-termp
+                      clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                      clause.simple-termp-of-car-when-clause.simple-term-listp)
+            (%disable default
+                      type-set-like-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      same-length-prefixes-equal-cheap
+                      subsetp-when-prefixp-cheap
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      logic.formulap-when-logic.termp
+                      logic.termp-when-logic.formulap)
+            (%crewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%enable default
+                     lemma-2-for-clause.depth-of-clause.factor-strong)
+            (%crewrite default)
+            (%enable default
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules))
+
+(%autoprove clause.depth-of-clause.factor-strong
+            (%use (%instance (%thm lemma-for-clause.depth-of-clause.factor-strong)
+                             (flag 'term))))
+
+(%autoprove clause.depth-list-of-clause.factor-list-strong
+            (%use (%instance (%thm lemma-for-clause.depth-of-clause.factor-strong)
+                             (flag 'list))))
+
+
+
+(%autoprove clause.depth-list-of-clause.unlifted-subterms-of-clause.casesplit
+            (%clause.cases-induction cases assignment)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      same-length-prefixes-equal-cheap
+                      type-set-like-rules
+                      expensive-term/formula-inference
+                      formula-decomposition
+                      unusual-consp-rules)
+            (%cheapen default
+                      clause.depth-when-clause.simple-termp
+                      clause.depth-list-when-clause.simple-term-listp
+                      clause.simple-termp-when-memberp-of-clause.simple-term-listp
+                      clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                      clause.simple-termp-of-car-when-clause.simple-term-listp))
+
+(%autoprove lemma-for-clause.casesplit-strongly-reduces-clause.depth
+            (%disable default
+                      clause.unlifted-subterms-weakly-decreases-clause.depth
+                      [outside]clause.unlifted-subterms-weakly-decreases-clause.depth
+                      expensive-arithmetic-rules
+                      type-set-like-rules)
+            (%cheapen default
+                      clause.depth-when-clause.simple-termp
+                      clause.depth-list-when-clause.simple-term-listp
+                      clause.simple-termp-when-memberp-of-clause.simple-term-listp
+                      clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                      clause.simple-termp-of-car-when-clause.simple-term-listp)
+            (%use (%instance (%thm clause.unlifted-subterms-weakly-decreases-clause.depth)
+                             (x (clause.factor x assignment)))))
+
+(%autoprove clause.casesplit-strongly-reduces-clause.depth
+            (%clause.cases-induction cases assignment)
+            (%disable default
+                      type-set-like-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      same-length-prefixes-equal-cheap
+                      formula-decomposition
+                      expensive-term/formula-inference
+                      unusual-consp-rules)
+            (%cheapen default
+                      clause.depth-when-clause.simple-termp
+                      clause.depth-list-when-clause.simple-term-listp
+                      clause.simple-termp-when-memberp-of-clause.simple-term-listp
+                      clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                      clause.simple-termp-of-car-when-clause.simple-term-listp)
+            (%enable default lemma-for-clause.casesplit-strongly-reduces-clause.depth))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/depth-3-special.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/depth-3-special.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/depth-3-special.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/depth-3-special.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,103 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "depth-2-deepest")
+(%interactive)
+
+(%autoadmit clause.special-assignment)
+
+(%autoprove clause.special-assignment-when-not-consp
+            (%restrict default clause.special-assignment (equal assignments 'assignments)))
+
+(%autoprove clause.special-assignment-of-cons
+            (%restrict default clause.special-assignment (equal assignments '(cons a assignments))))
+
+(%autoprove memberp-of-clause.special-assignment
+            (%cdr-induction assignments))
+
+(%autoprove forcing-logic.termp-of-clause.deepest
+            (%cdr-induction x))
+
+(%autoprove clause.special-assignment-of-clause.multifactor
+            (%cdr-induction assignments)
+            (%enable default clause.depth-list-redefinition)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      same-length-prefixes-equal-cheap)
+            (%cheapen default
+                      clause.depth-when-clause.simple-termp
+                      clause.depth-list-when-clause.simple-term-listp
+                      clause.simple-termp-when-memberp-of-clause.simple-term-listp
+                      clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                      clause.simple-termp-of-car-when-clause.simple-term-listp)
+            (%auto)
+            (%enable default
+                     expensive-arithmetic-rules-two
+                     expensive-arithmetic-rules
+                     type-set-like-rules))
+
+
+
+(%autoadmit clause.deepest-after-factoring)
+
+(%autoprove clause.deepest-after-factoring-when-not-consp
+            (%restrict default clause.deepest-after-factoring (equal x 'x)))
+
+(%autoprove clause.deepest-after-factoring-of-cons
+            (%restrict default clause.deepest-after-factoring (equal x '(cons a x))))
+
+(%autoprove forcing-logic.termp-of-clause.deepest-after-factoring
+            (%cdr-induction x))
+
+(%autoprove memberp-of-clause.deepest-after-factoring
+            (%cdr-induction x))
+
+(%autoprove clause.deepest-of-clause.factor-list
+            (%cdr-induction x)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules))
+
+(%autoprove disjoint-from-nonep-of-clause.term-paths-of-clause.deepest-after-factoring
+            (%disable default disjoint-from-nonep-of-clause.term-paths-when-memberp)
+            (%use (%instance (%thm disjoint-from-nonep-of-clause.term-paths-when-memberp)
+                             (a (clause.deepest-after-factoring x assignment))
+                             (x x))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../clauses/if-lifting/depth")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/level7.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/level7.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/level7.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/level7.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,162 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 61 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "split-bldr")
+(%interactive)
+
+(%autoadmit level7.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level7.step-okp))
+ (%autoprove soundness-of-level7.step-okp)
+ (%autoprove level7.step-okp-when-level6.step-okp
+             (%forcingp nil)
+             (%enable default level6.step-okp)
+             (%auto)
+             (%enable default level5.step-okp)
+             (%auto)
+             (%enable default level4.step-okp)
+             (%auto)
+             (%enable default level3.step-okp)
+             (%auto)
+             (%enable default level2.step-okp)
+             (%auto)
+             (%enable default logic.appeal-step-okp))
+ (%autoprove level7.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%disable default forcing-true-listp-of-logic.subproofs))
+ (%autoadmit level7.flag-proofp-aux))
+
+(%autoadmit level7.proofp-aux)
+(%autoadmit level7.proof-listp-aux)
+(%autoprove definition-of-level7.proofp-aux
+            (%enable default level7.proofp-aux level7.proof-listp-aux)
+            (%restrict default level7.flag-proofp-aux (equal x 'x)))
+(%autoprove definition-of-level7.proof-listp-aux
+            (%enable default level7.proofp-aux level7.proof-listp-aux)
+            (%restrict default level7.flag-proofp-aux (equal x 'x)))
+
+
+(%autoprove level7.proofp-aux-when-not-consp      (%restrict default definition-of-level7.proofp-aux (equal x 'x)))
+(%autoprove level7.proof-listp-aux-when-not-consp (%restrict default definition-of-level7.proof-listp-aux (equal x 'x)))
+(%autoprove level7.proof-listp-aux-of-cons        (%restrict default definition-of-level7.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level7.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level7.proofp-aux (equal x 'x)))
+
+(%autoprove booleanp-of-level7.proofp-aux      (%use (%instance (%thm lemma-for-booleanp-of-level7.proofp-aux) (flag 'proof))))
+(%autoprove booleanp-of-level7.proof-listp-aux (%use (%instance (%thm lemma-for-booleanp-of-level7.proofp-aux) (flag 'list))))
+
+
+(%deflist level7.proof-listp-aux (x axioms thms atbl)
+          (level7.proofp-aux x axioms thms atbl))
+
+(%autoprove lemma-for-logic.provablep-when-level7.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%urewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%restrict default definition-of-level7.proofp-aux (equal x 'x))
+            (%auto :strategy (cleanup split urewrite))
+            (%disable default
+                      ;; so many memberp terms that these get expensive
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-subset-of-somep-cheap
+                      memberp-when-not-superset-of-somep-cheap
+                      type-set-like-rules
+                      same-length-prefixes-equal-cheap
+                      logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest))
+
+(%autoprove logic.provablep-when-level7.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level7.proofp-aux) (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level7.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level7.proofp-aux) (flag 'list))))
+
+
+
+(%autoprove lemma-for-level7.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level7.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove level7.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level7.proofp-aux-when-logic.proofp) (flag 'proof))))
+
+(%autoprove level7.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level7.proofp-aux-when-logic.proofp) (flag 'list))))
+
+(%autoprove forcing-level7.proofp-aux-of-logic.provable-witness
+            (%enable default level7.proofp-aux-when-logic.proofp))
+
+
+
+(%autoadmit level7.proofp)
+(%autoprove booleanp-of-level7.proofp
+            (%enable default level7.proofp))
+(%autoprove logic.provablep-when-level7.proofp
+            (%enable default level7.proofp))
+
+
+(defsection level7-transition
+  (%install-new-proofp level7.proofp)
+  (%auto)
+  (%qed-install))
+
+
+(%switch-builder clause.split-bldr clause.split-bldr-high)
+
+;; And now that cleanup is folded into splitting and is "free", we don't have to worry
+;; about how much splitting we do, really.  We still limit lifting, just because the
+;; lifting operation gets very slow after this point.
+(%splitlimit 0)
+(%liftlimit 10)
+
+
+
+(%finish "level7")
+(%save-events "level7.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/lift-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/lift-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/lift-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/lift-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,128 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lift")
+(include-book "casesplit-bldr")
+(%interactive)
+
+(%autoadmit clause.lift-term1-bldr)
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.lift-term1-bldr
+            (%clause.lift-term1-induction x)
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules
+                      logic.termp-when-logic.formulap)
+            (%auto)
+            (%restrict default clause.lift-term1-bldr (equal x 'x))
+            (%restrict default clause.lift-term1 (equal x 'x)))
+
+(%autoprove forcing-logic.appealp-of-clause.lift-term1-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.lift-term1-bldr))))
+
+(%autoprove forcing-logic.conclusion-of-clause.lift-term1-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.lift-term1-bldr))))
+
+(%autoprove forcing-logic.proofp-of-clause.lift-term1-bldr
+            (%clause.lift-term1-induction x)
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules
+                      logic.termp-when-logic.formulap)
+            (%auto)
+            (%restrict default clause.lift-term1-bldr (equal x 'x))
+            (%restrict default clause.lift-term1 (equal x 'x)))
+
+
+
+(%autoadmit clause.lift-term-bldr)
+
+(defthmd clause.lift-term-when-clause.lifted-termp
+  (implies (clause.lifted-termp x)
+           (equal (clause.lift-term x)
+                  x))
+  :hints(("Goal" :in-theory (enable clause.lift-term))))
+
+(%autoprove clause.lift-term-when-clause.lifted-termp
+            (%restrict default clause.lift-term (equal x 'x)))
+
+(local (%enable default clause.lift-term-when-clause.lifted-termp))
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.lift-term-bldr
+            (%clause.lift-term-induction x)
+            (%auto)
+            (%restrict default clause.lift-term-bldr (equal x 'x))
+            (%restrict default clause.lift-term (equal x 'x)))
+
+(%autoprove forcing-logic.appealp-of-clause.lift-term-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.lift-term-bldr))))
+
+(%autoprove forcing-logic.conclusion-of-clause.lift-term-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.lift-term-bldr))))
+
+(%autoprove forcing-logic.proofp-of-clause.lift-term-bldr
+            (%clause.lift-term-induction x)
+            (%auto)
+            (%restrict default clause.lift-term-bldr (equal x 'x))
+            (%restrict default clause.lift-term (equal x 'x)))
+
+
+(%defprojection :list (clause.lift-term-list-bldr x)
+                :element (clause.lift-term-bldr x))
+
+(%autoprove forcing-logic.appeal-listp-of-clause.lift-term-list-bldr
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.lift-term-list-bldr
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.proof-listp-of-clause.lift-term-list-bldr
+            (%cdr-induction x))
+
+
+
+(%autoadmit clause.lift-clauses-bldr)
+
+(%autoprove forcing-logic.appeal-listp-of-clause.lift-clauses-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.lift-clauses-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.lift-clauses-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.lift-clauses-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.proof-listp-of-clause.lift-clauses-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.lift-clauses-bldr (equal x 'x)))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/lift-term1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/lift-term1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/lift-term1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/lift-term1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,198 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "depth-3-special")
+(%interactive)
+
+(%autoadmit clause.lift-term1)
+
+
+(defmacro %clause.lift-term1-induction (x)
+  `(%induct (rank ,x)
+            ((logic.constantp ,x)
+             nil)
+            ((logic.variablep ,x)
+             nil)
+            ((logic.functionp ,x)
+             (((,x (first (logic.function-args ,x))))
+              ((,x (second (logic.function-args ,x))))
+              ((,x (third (logic.function-args ,x))))))
+            ((logic.lambdap ,x)
+             nil)
+            ((and (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)))
+
+
+(local (%disable default
+                 same-length-prefixes-equal-cheap
+                 logic.termp-when-logic.formulap))
+
+(%autoprove forcing-logic.termp-of-clause.lift-term1
+            (%clause.lift-term1-induction x)
+            (%restrict default clause.lift-term1 (equal x 'x))
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules))
+
+(%autoprove forcing-logic.term-atblp-of-clause.lift-term1
+            (%clause.lift-term1-induction x)
+            (%restrict default clause.lift-term1 (equal x 'x))
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules))
+
+(%autoprove clause.lift-term1-when-no-clause.unlifted-subterms
+            (%clause.lift-term1-induction x)
+            (%restrict default clause.lift-term1 (equal x 'x))
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules))
+
+
+
+(%autoprove forcing-clause.depth-of-clause.factor-strong)
+
+(local (%enable default forcing-clause.depth-of-clause.factor-strong))
+
+
+(%autoprove lemma-for-clause.depth-decreases-in-lambda-case
+            (%disable default clause.deepest-weakly-deeper-than-any-member)
+            (%use (%instance (%thm clause.deepest-weakly-deeper-than-any-member)
+                             (x (logic.lambda-actuals x))
+                             (a (clause.deepest-after-factoring (logic.lambda-actuals x) assignment)))))
+
+(%autoprove lemma2-for-clause.depth-decreases-in-lambda-case
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules
+                      clause.simple-term-listp-of-domain-of-clause.cases
+                      disjoint-from-nonep-of-domain-of-clause.cases
+                      lemma-for-clause.depth-decreases-in-lambda-case)
+            (%use (%instance (%thm lemma-for-clause.depth-decreases-in-lambda-case)
+                             (assignment (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil)))))
+
+            (%use (%instance (%thm clause.simple-term-listp-of-domain-of-clause.cases)
+                             (x     (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil)))
+                             (cases (clause.simple-tests-list (logic.lambda-actuals x)))
+                             (assignment nil)))
+
+            (%use (%instance (%thm disjoint-from-nonep-of-domain-of-clause.cases)
+                             (x     (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil)))
+                             (cases (clause.simple-tests-list (logic.lambda-actuals x)))
+                             (set   (clause.term-paths-list (logic.lambda-actuals x)))
+                             (assignment nil))))
+
+(%autoprove clause.depth-decreases-in-lambda-case
+            (%enable default
+                     clause.depth-list-redefinition
+                     lemma2-for-clause.depth-decreases-in-lambda-case)
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules))
+
+
+
+(%autoprove lemma-for-clause.depth-decreases-in-logic.functionp-case
+            (%disable default clause.deepest-weakly-deeper-than-any-member)
+            (%use (%instance (%thm clause.deepest-weakly-deeper-than-any-member)
+                             (x (logic.function-args x))
+                             (a (clause.deepest-after-factoring (logic.function-args x) assignment)))))
+
+(%autoprove lemma2-for-clause.depth-decreases-in-logic.functionp-case
+            (%disable default
+                      clause.simple-term-listp-of-domain-of-clause.cases
+                      disjoint-from-nonep-of-domain-of-clause.cases
+                      lemma-for-clause.depth-decreases-in-logic.functionp-case
+                      type-set-like-rules
+                      expensive-arithmetic-rules)
+            (%use (%instance (%thm lemma-for-clause.depth-decreases-in-logic.functionp-case)
+                             (assignment (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil)))))
+            (%use (%instance (%thm clause.simple-term-listp-of-domain-of-clause.cases)
+                             (x     (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil)))
+                             (cases (clause.simple-tests-list (logic.function-args x)))
+                             (assignment nil)))
+            (%use (%instance (%thm disjoint-from-nonep-of-domain-of-clause.cases)
+                             (x     (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil)))
+                             (cases (clause.simple-tests-list (logic.function-args x)))
+                             (set   (clause.term-paths-list (logic.function-args x)))
+                             (assignment nil))))
+
+(%autoprove clause.depth-decreases-in-non-if-logic.functionp-case
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules
+                      clause.simple-termp-when-bad-args-logic.functionp
+                      clause.unlifted-subterms-when-bad-args-logic.functionp)
+            (%enable default
+                     clause.depth-list-redefinition
+                     lemma2-for-clause.depth-decreases-in-logic.functionp-case))
+
+(%autoprove clause.depth-decreases-in-bad-args-logic.functionp-case
+            (%enable default
+                     clause.depth-list-redefinition
+                     lemma2-for-clause.depth-decreases-in-logic.functionp-case))
+
+(%autoprove clause.lift-term1-makes-progress
+            (%clause.lift-term1-induction x)
+            (%auto :strategy (cleanup split urewrite))
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules)
+            (%crewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%restrict default definition-of-clause.depth (equal x 'x))
+            (%restrict default clause.lift-term1 (equal x 'x))
+            (%enable default
+                     clause.depth-decreases-in-bad-args-logic.functionp-case
+                     clause.depth-decreases-in-non-if-logic.functionp-case
+                     clause.depth-decreases-in-lambda-case)
+            (%disable default
+                      expensive-arithmetic-rules-two
+                      clause.depth-list-when-length-three)
+            (%crewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%crewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%enable default
+                     clause.depth-list-when-length-three
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two
+                     type-set-like-rules))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/lift.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/lift.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/lift.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/lift.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,101 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lift-term1")
+(%interactive)
+
+(%autoadmit clause.lift-term)
+
+(defmacro %clause.lift-term-induction (x)
+  `(%induct (clause.depth-list (clause.unlifted-subterms ,x))
+            ((not (logic.termp ,x))
+             nil)
+            ((clause.lifted-termp ,x)
+             nil)
+            ((and (logic.termp ,x)
+                  (not (clause.lifted-termp ,x)))
+             (((x (clause.lift-term1 ,x)))))))
+
+(%autoprove forcing-logic.termp-of-clause.lift-term
+            (%clause.lift-term-induction x)
+            (%restrict default clause.lift-term (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-clause.lift-term
+            (%clause.lift-term-induction x)
+            (%restrict default clause.lift-term (equal x 'x)))
+
+(%autoprove forcing-clause.lifted-termp-of-clause.lift-term
+            (%clause.lift-term-induction x)
+            (%restrict default clause.lift-term (equal x 'x)))
+
+(%autoprove clause.lift-term-when-clause.simple-termp
+            (%clause.lift-term-induction x)
+            (%restrict default clause.lift-term (equal x 'x)))
+
+
+
+
+(%defprojection :list (clause.lift-term-list x)
+                :element (clause.lift-term x))
+
+(%autoprove forcing-logic.term-listp-of-clause.lift-term-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.lift-term-list
+            (%cdr-induction x))
+
+(%autoprove clause.lift-term-list-when-clause.simple-term-listp
+            (%cdr-induction x))
+
+(%autoprove forcing-clause.lifted-term-listp-of-clause.lift-term-list
+            (%cdr-induction x))
+
+
+
+(%defprojection :list (clause.lift-term-list-list x)
+                :element (clause.lift-term-list x))
+
+(%autoprove forcing-logic.term-listp-of-clause.lift-term-list-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.lift-term-list-list
+            (%cdr-induction x))
+
+(%autoprove clause.lift-term-list-list-when-clause.simple-term-list-listp
+            (%cdr-induction x))
+
+(%autoprove forcing-cons-listp-of-clause.lift-term-list-list
+            (%cdr-induction x))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/limlift-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/limlift-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/limlift-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/limlift-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,149 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "limlift")
+(include-book "casesplit-bldr")
+(%interactive)
+
+(%autoadmit clause.limlift-term1-bldr)
+
+(%autoprove cdr-of-clause.limlift-term1-bldr
+            (%autoinduct clause.limlift-term1-bldr x k)
+            (%restrict default clause.limlift-term1-bldr (equal x 'x))
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+
+(defthm lemma-for-forcing-logic.appealp-of-car-of-clause.limlift-term1-bldr
+  ;; BOZO it's local
+  (implies (logic.termp x)
+           (and (logic.appealp (car (clause.limlift-term1-bldr x k)))
+                (equal (logic.conclusion (car (clause.limlift-term1-bldr x k)))
+                       (logic.pequal x (car (clause.limlift-term1 x k))))))
+  :rule-classes nil)
+
+(%autoprove lemma-for-forcing-logic.appealp-of-car-of-clause.limlift-term1-bldr
+            (%autoinduct clause.limlift-term1-bldr x k)
+            (%restrict default clause.limlift-term1-bldr (equal x 'x))
+            (%restrict default clause.limlift-term1 (equal x 'x))
+            (%disable default
+                      clause.simple-termp-openers
+                      clause.lifted-termp-openers
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      same-length-prefixes-equal-cheap
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      logic.termp-when-logic.formulap))
+
+(%autoprove forcing-logic.appealp-of-car-of-clause.limlift-term1-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-car-of-clause.limlift-term1-bldr)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.conclusion-of-car-of-clause.limlift-term1-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-car-of-clause.limlift-term1-bldr)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.proofp-of-car-of-clause.limlift-term1-bldr
+            (%autoinduct clause.limlift-term1-bldr x k)
+            (%restrict default clause.limlift-term1-bldr (equal x 'x))
+            (%restrict default clause.limlift-term1 (equal x 'x))
+            (%disable default
+                      clause.simple-termp-openers
+                      clause.lifted-termp-openers
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      same-length-prefixes-equal-cheap
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      logic.termp-when-logic.formulap))
+
+
+
+(%autoadmit clause.limlift-term-bldr)
+
+(defthm lemma-for-forcing-logic.appealp-of-clause.limlift-term-bldr
+  ;; BOZO local in the file.
+  (implies (logic.termp x)
+           (and (logic.appealp (clause.limlift-term-bldr x k))
+                (equal (logic.conclusion (clause.limlift-term-bldr x k))
+                       (logic.pequal x (clause.limlift-term x k)))))
+  :rule-classes nil)
+
+(%autoprove lemma-for-forcing-logic.appealp-of-clause.limlift-term-bldr
+            (%autoinduct clause.limlift-term x k)
+            (%restrict default clause.limlift-term (equal x 'x))
+            (%restrict default clause.limlift-term-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.appealp-of-clause.limlift-term-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.limlift-term-bldr))))
+
+(%autoprove forcing-logic.conclusion-of-clause.limlift-term-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-clause.limlift-term-bldr))))
+
+(%autoprove forcing-logic.proofp-of-clause.limlift-term-bldr
+            (%autoinduct clause.limlift-term x k)
+            (%restrict default clause.limlift-term (equal x 'x))
+            (%restrict default clause.limlift-term-bldr (equal x 'x)))
+
+
+
+(%defprojection :list (clause.limlift-term-list-bldr x k)
+                :element (clause.limlift-term-bldr x k))
+
+(%autoprove forcing-logic.appeal-listp-of-clause.limlift-term-list-bldr
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.limlift-term-list-bldr
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.proof-listp-of-clause.limlift-term-list-bldr
+            (%cdr-induction x))
+
+
+
+(%autoadmit clause.limlift-clauses-bldr)
+
+(%autoprove forcing-logic.appeal-listp-of-clause.limlift-clauses-bldr
+            (%autoinduct clause.limlift-clauses-bldr)
+            (%restrict default clause.limlift-clauses-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.limlift-clauses-bldr
+            (%autoinduct clause.limlift-clauses-bldr)
+            (%restrict default clause.limlift-clauses-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.proof-listp-of-clause.limlift-clauses-bldr
+            (%autoinduct clause.limlift-clauses-bldr)
+            (%restrict default clause.limlift-clauses-bldr (equal x 'x)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/limlift.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/limlift.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/limlift.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/limlift.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,161 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "depth-3-special")
+(%interactive)
+
+(%autoprove lemma-for-consp-of-clause.simple-tests
+            (%clause.simple-term-induction flag x)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules))
+
+(%autoprove consp-of-clause.simple-tests
+            (%use (%instance (%thm lemma-for-consp-of-clause.simple-tests)
+                             (flag 'term))))
+
+(%autoprove consp-of-clause.simple-tests-list
+            (%use (%instance (%thm lemma-for-consp-of-clause.simple-tests)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-clause.simple-tests-when-not-clause.simple-termp-under-iff
+            (%clause.simple-term-induction flag x)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules))
+
+(%autoprove clause.simple-tests-when-not-clause.simple-termp-under-iff
+            (%use (%instance (%thm lemma-for-clause.simple-tests-when-not-clause.simple-termp-under-iff)
+                             (flag 'term))))
+
+(%autoprove clause.simple-tests-list-when-not-clause.simple-term-listp-under-iff
+            (%use (%instance (%thm lemma-for-clause.simple-tests-when-not-clause.simple-termp-under-iff)
+                             (flag 'list))))
+
+
+
+(%autoprove forcing-logic.term-listp-of-firstn)
+
+(%autoprove forcing-logic.term-list-atblp-of-firstn)
+
+
+
+
+
+(%autoadmit clause.limlift-term1)
+
+(%autoprove forcing-logic.termp-of-car-of-clause.limlift-term1
+            (%autoinduct clause.limlift-term1 x k)
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+(%autoprove forcing-natp-of-cdr-of-clause.limlift-term1
+            (%autoinduct clause.limlift-term1 x k)
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-car-of-clause.lift1
+            (%autoinduct clause.limlift-term1 x k)
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+(%autoprove car-of-clause.lift1-when-clause.lifted-termp
+            (%autoinduct clause.limlift-term1 x k)
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+(%autoprove cdr-of-clause.lift1-when-clause.lifted-termp
+            (%autoinduct clause.limlift-term1 x k)
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+(%autoprove cdr-of-clause.limlift-term1-never-increases
+            (%autoinduct clause.limlift-term1 x k)
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+(%autoprove cdr-of-clause.limlift-term1-stays-at-zero
+            (%autoinduct clause.limlift-term1 x k)
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+(%autoprove cdr-of-clause.limlift-term1-usually-decreases
+            (%autoinduct clause.limlift-term1 x k)
+            (%restrict default clause.limlift-term1 (equal x 'x)))
+
+
+
+
+
+(%autoadmit clause.limlift-term)
+
+(%autoprove forcing-logic.termp-of-clause.limlift-term
+            (%autoinduct clause.limlift-term x k)
+            (%restrict default clause.limlift-term (equal k 'k)))
+
+(%autoprove forcing-logic.term-atblp-of-clause.limlift-term
+            (%autoinduct clause.limlift-term x k)
+            (%restrict default clause.limlift-term (equal k 'k)))
+
+(%autoprove clause.limlift-term-when-clause.simple-termp
+            (%autoinduct clause.limlift-term x k)
+            (%restrict default clause.limlift-term (equal k 'k)))
+
+
+
+(%defprojection :list (clause.limlift-term-list x k)
+                :element (clause.limlift-term x k))
+
+(%autoprove forcing-logic.term-listp-of-clause.limlift-term-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.limlift-term-list
+            (%cdr-induction x))
+
+(%autoprove clause.limlift-term-list-when-clause.simple-term-listp
+            (%cdr-induction x))
+
+
+
+(%defprojection :list (clause.limlift-term-list-list x k)
+                :element (clause.limlift-term-list x k))
+
+(%autoprove forcing-logic.term-list-listp-of-clause.limlift-term-list-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-clause.limlift-term-list-list
+            (%cdr-induction x))
+
+(%autoprove clause.limlift-term-list-list-when-clause.simple-term-list-listp
+            (%cdr-induction x))
+
+(%autoprove cons-listp-of-clause.limlift-term-list-list
+            (%cdr-induction x))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level7/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/make-image.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level6/level6")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level7-symmetry"
+                 "Pre-loaded bootstrap/level6 directory.")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/normalize-nots.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/normalize-nots.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/normalize-nots.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/normalize-nots.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,192 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(local (%enable default lemma-split-up-list-of-quoted-nil))
+
+
+(%autoadmit clause.normalize-nots-term)
+
+(defmacro %clause.normalize-nots-term-induction (x)
+  `(%induct (rank ,x)
+            ((not (clause.negative-termp ,x))
+             nil)
+            ((and (clause.negative-termp ,x)
+                  (not (clause.negative-termp (clause.negative-term-guts ,x))))
+             nil)
+            ((and (clause.negative-termp ,x)
+                  (clause.negative-termp (clause.negative-term-guts ,x)))
+             (((,x (clause.negative-term-guts (clause.negative-term-guts ,x))))))))
+
+(%autoprove forcing-logic.termp-of-clause.normalize-nots-term
+            (%clause.normalize-nots-term-induction x)
+            (%restrict default clause.normalize-nots-term (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-clause.normalize-nots-term
+            (%clause.normalize-nots-term-induction x)
+            (%restrict default clause.normalize-nots-term (equal x 'x)))
+
+(%autoprove no-double-negatives-after-clause.normalize-nots-term
+            (%clause.normalize-nots-term-induction x)
+            (%restrict default clause.normalize-nots-term (equal x 'x)))
+
+(%autoadmit clause.normalize-nots-term-bldr)
+
+
+(defthmd lemma-1-for-forcing-logic.appealp-of-clause.normalize-nots-term-bldr
+  ;; BOZO need to unlocalize this in the clean-clauses.lisp
+  ;; NOTE -- changing the order of the equality to match term order.
+  (implies (not (cdr (cdr x)))
+           (equal (equal 2 (len x))
+                  (and (consp x)
+                       (consp (cdr x))))))
+
+(defthm lemma-2-for-forcing-logic.appealp-of-clause.normalize-nots-term-bldr
+  ;; BOZO need to unlocalize this in the clean-clauses.lisp
+  (implies (logic.termp a)
+           (and (logic.appealp (clause.normalize-nots-term-bldr a))
+                (equal (logic.conclusion (clause.normalize-nots-term-bldr a))
+                       (logic.pequal (logic.function 'iff (list a (clause.normalize-nots-term a)))
+                                     ''t))))
+  :rule-classes nil)
+
+(%autoprove lemma-1-for-forcing-logic.appealp-of-clause.normalize-nots-term-bldr)
+
+(%autoprove lemma-2-for-forcing-logic.appealp-of-clause.normalize-nots-term-bldr
+            (%clause.normalize-nots-term-induction a)
+            (%enable default lemma-1-for-forcing-logic.appealp-of-clause.normalize-nots-term-bldr)
+            (%disable default
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pequals)
+            (%restrict default clause.normalize-nots-term (equal x 'a))
+            (%restrict default clause.normalize-nots-term-bldr (equal a 'a))
+            (%enable default theorem-not-of-not-under-iff)
+            (%disable default
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      equal-of-booleans-rewrite
+                      equal-of-cons-rewrite)
+            (%auto :strategy (cleanup split urewrite))
+            (%forcingp t)
+            (%disable default
+                      EQUAL-OF-LOGIC.FUNCTION-REWRITE-ALT
+                      EQUAL-OF-LOGIC.FUNCTION-REWRITE
+                      equal-of-logic.function-and-logic.function
+                      [outside]equal-of-logic.function-and-logic.function)
+            (%enable default
+                     equal-of-booleans-rewrite
+                     equal-of-cons-rewrite)
+            (%auto)
+            (%enable default
+                     equal-of-logic.function-and-logic.function
+                     [outside]equal-of-logic.function-and-logic.function
+                     EQUAL-OF-LOGIC.FUNCTION-REWRITE-ALT
+                     EQUAL-OF-LOGIC.FUNCTION-REWRITE))
+
+(%autoprove forcing-logic.appealp-of-clause.normalize-nots-term-bldr
+            (%use (%instance (%thm lemma-2-for-forcing-logic.appealp-of-clause.normalize-nots-term-bldr))))
+
+(%autoprove forcing-logic.conclusion-of-clause.normalize-nots-term-bldr
+            (%use (%instance (%thm lemma-2-for-forcing-logic.appealp-of-clause.normalize-nots-term-bldr))))
+
+(%autoprove forcing-logic.proofp-of-clause.normalize-nots-term-bldr
+            (%clause.normalize-nots-term-induction a)
+            (%restrict default clause.normalize-nots-term (equal x 'a))
+            (%restrict default clause.normalize-nots-term-bldr (equal a 'a))
+            (%enable default theorem-not-of-not-under-iff))
+
+
+
+(%defprojection :list (clause.normalize-nots-term-list x)
+                :element (clause.normalize-nots-term x))
+
+(%autoprove forcing-logic.term-listp-of-clause.normalize-nots-term-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.normalize-nots-term-list
+            (%cdr-induction x))
+
+(%autoprove clause.double-negative-free-listp-of-clause.normalize-nots-term-list
+            (%cdr-induction x))
+
+
+
+(%defprojection :list (clause.normalize-nots-term-list-bldr x)
+                :element (clause.normalize-nots-term-bldr x))
+
+(%autoprove forcing-logic.appeal-listp-of-clause.normalize-nots-term-list-bldr
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.normalize-nots-term-list-bldr
+            (%cdr-induction x)
+            ;; bleh why are we having rlimit loops here?
+            (%auto :strategy (cleanup split urewrite elim)))
+
+(%autoprove forcing-logic.proof-listp-of-clause.normalize-nots-term-list-bldr
+            (%cdr-induction x)
+            ;; bleh why are we having rlimit loops here?
+            (%auto :strategy (cleanup split urewrite elim)))
+
+
+
+(%defprojection :list (clause.normalize-nots-clauses x)
+                :element (clause.normalize-nots-term-list x))
+
+(%autoprove forcing-logic.term-list-listp-of-clause.normalize-nots-clauses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-clause.normalize-nots-clauses
+            (%cdr-induction x))
+
+(%autoprove cons-listp-of-clause.normalize-nots-clauses
+            (%cdr-induction x))
+
+
+
+(%autoadmit clause.normalize-nots-clauses-bldr)
+
+(%autoprove forcing-logic.appeal-listp-of-clause.normalize-nots-clauses-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.normalize-nots-clauses-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.normalize-nots-clauses-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.normalize-nots-clauses-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.proof-listp-of-clause.normalize-nots-clauses-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.normalize-nots-clauses-bldr (equal x 'x)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/split-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/split-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/split-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/split-bldr.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,115 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "split")
+(include-book "lift-bldr")
+(include-book "limlift-bldr")
+(%interactive)
+
+
+(%autoadmit clause.split-bldr)
+
+(%autoprove forcing-logic.appealp-of-clause.split-bldr
+            (%enable default clause.split clause.split-bldr build.rev-disjunction))
+
+(%autoprove forcing-logic.conclusion-of-clause.split-bldr
+            (%enable default clause.split clause.split-bldr build.rev-disjunction))
+
+(%autoprove forcing-logic.proofp-of-clause.split-bldr
+            (%enable default clause.split clause.split-bldr build.rev-disjunction))
+
+
+(%deflist logic.appeal-list-listp (x)
+          (logic.appeal-listp x))
+
+(%defprojection :list (logic.strip-conclusions-list x)
+                :element (logic.strip-conclusions x))
+
+(encapsulate
+ ()
+ (local (%disable default redefinition-of-clause.clause-list-formulas
+                  [OUTSIDE]REDEFINITION-OF-CLAUSE.CLAUSE-LIST-FORMULAS))
+ (%defprojection :list (clause.clause-list-list-formulas x)
+                 :element (clause.clause-list-formulas x)))
+
+(%deflist logic.proof-list-listp (x axioms thms atbl)
+  (logic.proof-listp x axioms thms atbl))
+
+
+(%autoadmit clause.split-list-bldr)
+
+(%autoprove forcing-logic.appeal-listp-of-clause.split-list-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.split-list (equal x 'x))
+            (%restrict default clause.split-list-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.strip-conclusions-of-clause.split-list-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.split-list (equal x 'x))
+            (%restrict default clause.split-list-bldr (equal x 'x)))
+
+(%autoprove forcing-logic.proof-listp-of-clause.split-list-bldr
+            (%cdr-cdr-induction x proofs)
+            (%restrict default clause.split-list (equal x 'x))
+            (%restrict default clause.split-list-bldr (equal x 'x))
+            (%disable default
+                      expensive-arithmetic-rules
+                      type-set-like-rules
+                      memberp-when-memberp-of-cdr))
+
+
+
+(%autoadmit clause.split-bldr-okp)
+
+(%autoadmit clause.split-bldr-high)
+
+(encapsulate
+ ()
+ (local (%enable default clause.split-bldr-okp))
+ (%autoprove booleanp-of-clause.split-bldr-okp)
+ (%autoprove clause.split-bldr-okp-of-logic.appeal-identity)
+ (%autoprove lemma-1-for-soundness-of-clause.split-bldr-okp)
+ (%autoprove lemma-2-for-soundness-of-clause.split-bldr-okp)
+ (%autoprove forcing-soundness-of-clause.split-bldr-okp
+             (%enable default
+                      lemma-1-for-soundness-of-clause.split-bldr-okp
+                      lemma-2-for-soundness-of-clause.split-bldr-okp)
+             (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                              (x (clause.split-bldr (first (logic.extras x))
+                                                    (second (logic.extras x))
+                                                    (third (logic.extras x))
+                                                    (fourth (logic.extras x))
+                                                    (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                                 axioms thms atbl)))))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/split.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/split.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/split.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/split.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,149 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lift")
+(include-book "limlift")
+(include-book "clean-clauses")
+(%interactive)
+
+
+(%autoprove true-listp-of-clause.clean-clauses
+            (%enable default clause.clean-clauses))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-remove-supersets1
+            (%autoinduct remove-supersets1 x acc)
+            (%restrict default remove-supersets1 (equal todo 'x)))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-remove-supersets
+            (%enable default remove-supersets))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-remove-duplicates-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-clause.remove-absurd-terms-from-clauses
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-list-atblp-of-third-of-clause.clean-clauses
+            (%enable default clause.clean-clauses))
+
+(%autoprove forcing-clause.simple-term-list-listp-of-remove-supersets1
+            (%autoinduct remove-supersets1 x acc)
+            (%restrict default remove-supersets1 (equal todo 'x)))
+
+(%autoprove forcing-clause.simple-term-list-listp-of-remove-supersets
+            (%enable default remove-supersets))
+
+(%autoprove forcing-clause.simple-term-list-listp-of-remove-duplicates-list
+            (%cdr-induction x))
+
+(%autoprove forcing-clause.simple-term-list-listp-of-clause.remove-absurd-terms-from-clauses
+            (%cdr-induction x))
+
+(%autoprove forcing-clause.simple-term-list-listp-of-clause.remove-complement-clauses
+            (%cdr-induction x))
+
+(%autoprove forcing-clause.simple-term-list-listp-of-clause.remove-obvious-clauses
+            (%cdr-induction x))
+
+(%autoprove forcing-clause.simple-termp-of-clause.negative-term-guts
+            (%enable default
+                     clause.negative-termp
+                     clause.negative-term-guts))
+
+(%autoprove forcing-clause.simple-termp-of-clause.normalize-nots-term
+            (%autoinduct clause.normalize-nots-term)
+            (%restrict default clause.normalize-nots-term (equal x 'x)))
+
+(%autoprove forcing-clause.simple-term-listp-of-clause.normalize-nots-term-list
+            (%cdr-induction x))
+
+(%autoprove forcing-clause.simple-term-list-listp-of-clause.normalize-nots-clauses
+            (%cdr-induction x))
+
+(%autoprove clause.simple-term-list-listp-of-third-of-clause.clean-clauses
+            (%enable default clause.clean-clauses))
+
+
+
+(%autoadmit clause.split)
+
+(%autoprove true-listp-of-clause.split
+            ;; BOZO we don't want this theorem.  We want true-listp of cdr.  Oh well,
+            ;; I'll prove this one anyway.
+            (%enable default clause.split))
+
+(%autoprove forcing-logic.term-list-listp-of-cdr-of-clause.split
+            (%enable default clause.split))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-cdr-of-clause.split
+            (%enable default clause.split))
+
+(%autoprove forcing-cons-listp-of-cdr-of-clause.split
+            (%enable default clause.split))
+
+
+;; We don't bother to prove this.  Maybe we should, eventually.
+;; (%autoprove forcing-clause.simple-term-list-listp-of-clause.split-of-cdr-of--clause.lift-clause
+;;            (%enable default clause.split))
+
+
+(%autoadmit clause.split-list)
+
+(%autoprove clause.split-list-when-not-consp
+            (%restrict default clause.split-list (equal x 'x)))
+
+(%autoprove clause.split-list-of-cons
+            (%restrict default clause.split-list (equal x '(cons a x))))
+
+(%autoprove true-listp-of-cdr-of-clause.split-list
+            (%cdr-induction x))
+
+(%deflist logic.term-list-list-listp (x)
+  (logic.term-list-listp x))
+
+(%deflist logic.term-list-list-list-atblp (x atbl)
+  (logic.term-list-list-atblp x atbl))
+
+(%autoprove forcing-logic.term-list-list-listp-of-cdr-of-clause.split-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-list-list-atblp-of-cdr-of-clause.split-list
+            (%cdr-induction x))
+
+(%deflist cons-list-listp (x)
+          (cons-listp x))
+
+(%autoprove forcing-cons-list-listp-of-cdr-of-clause.split-list
+            (%cdr-induction x))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level7/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/symmetry	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level7-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/term-paths.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/term-paths.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/term-paths.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/term-paths.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,205 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "term-tests")
+(%interactive)
+
+
+;; (clause.term-paths x)
+;;
+;; We walk down the term and create lists of all the if expressions we
+;; encounter along the way.  I.e., these paths show you each set of choices you
+;; would need to make in order to get to every tip of a term.
+
+(%autoadmit clause.flag-term-paths)
+(%autoadmit clause.term-paths)
+(%autoadmit clause.term-paths-list)
+
+(%autoprove definition-of-clause.term-paths
+            (%restrict default clause.flag-term-paths (equal x 'x))
+            (%enable default clause.term-paths clause.term-paths-list))
+
+(%autoprove definition-of-clause.term-paths-list
+            (%restrict default clause.flag-term-paths (equal x 'x))
+            (%enable default clause.term-paths clause.term-paths-list))
+
+(%autoprove clause.flag-term-paths-of-term-removal
+            (%enable default clause.term-paths))
+
+(%autoprove clause.flag-term-paths-of-list-removal
+            (%enable default clause.term-paths-list))
+
+
+
+(%autoprove clause.term-paths-when-logic.constantp
+            (%restrict default definition-of-clause.term-paths (equal x 'x)))
+
+(%autoprove clause.term-paths-when-logic.variablep
+            (%restrict default definition-of-clause.term-paths (equal x 'x)))
+
+(%autoprove clause.term-paths-when-non-if-logic.functionp
+            (%restrict default definition-of-clause.term-paths (equal x 'x)))
+
+(%autoprove clause.term-paths-when-bad-args-logic.functionp
+            (%restrict default definition-of-clause.term-paths (equal x 'x)))
+
+(%autoprove clause.term-paths-when-if-logic.functionp
+            (%restrict default definition-of-clause.term-paths (equal x 'x)))
+
+(%autoprove clause.term-paths-when-logic.lambdap
+            (%restrict default definition-of-clause.term-paths (equal x 'x)))
+
+(%autoprove clause.term-paths-when-degenerate
+            (%restrict default definition-of-clause.term-paths (equal x 'x)))
+
+(%autoprove clause.term-paths-list-when-not-consp
+            (%restrict default definition-of-clause.term-paths-list (equal x 'x)))
+
+(%autoprove clause.term-paths-list-of-cons
+            (%restrict default definition-of-clause.term-paths-list (equal x '(cons a x))))
+
+(%autoprove clause.term-paths-list-when-len-three)
+
+
+
+
+(%create-theory clause.term-paths-openers)
+(%enable clause.term-paths-openers
+         clause.term-paths-when-logic.constantp
+         clause.term-paths-when-logic.variablep
+         clause.term-paths-when-non-if-logic.functionp
+         clause.term-paths-when-bad-args-logic.functionp
+         clause.term-paths-when-if-logic.functionp
+         clause.term-paths-when-logic.lambdap
+         clause.term-paths-when-degenerate
+         clause.term-paths-list-when-not-consp
+         clause.term-paths-list-of-cons
+         clause.term-paths-list-when-len-three)
+
+
+
+(%autoprove lemma-for-clause.term-paths-when-clause.simple-termp
+            (%clause.simple-term-induction flag x))
+
+(%autoprove clause.term-paths-when-clause.simple-termp
+            (%use (%instance (%thm lemma-for-clause.term-paths-when-clause.simple-termp)
+                             (flag 'term))))
+
+(%autoprove clause.term-paths-list-when-clause.simple-term-listp
+            (%use (%instance (%thm lemma-for-clause.term-paths-when-clause.simple-termp)
+                             (flag 'list))))
+
+
+
+(local (%create-theory common-disables))
+(local (%enable common-disables
+                expensive-arithmetic-rules
+                expensive-arithmetic-rules-two
+                type-set-like-rules
+                formula-decomposition
+                expensive-term/formula-inference
+                unusual-subsetp-rules
+                unusual-memberp-rules
+                unusual-consp-rules
+                usual-consp-rules
+                same-length-prefixes-equal-cheap
+                clause.term-paths-openers
+                subsetp-when-not-consp-two
+                subsetp-when-not-consp
+                app-when-not-consp-two
+                app-when-not-consp
+                logic.term-list-listp-when-not-consp
+                clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                logic.term-listp-when-subset-of-somep-alt
+                logic.term-list-listp-when-all-superset-of-somep-alt))
+
+(%autoprove lemma-for-forcing-logic.term-list-listp-of-clause.term-paths
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%auto)
+            (%enable default
+                     clause.term-paths-openers
+                     unusual-consp-rules))
+
+(%autoprove forcing-logic.term-list-listp-of-clause.term-paths
+            (%use (%instance (%thm lemma-for-forcing-logic.term-list-listp-of-clause.term-paths)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-list-listp-of-clause.term-paths-list
+            (%use (%instance (%thm lemma-for-forcing-logic.term-list-listp-of-clause.term-paths)
+                             (flag 'list))))
+
+
+
+
+(%autoprove lemma-for-forcing-consp-of-clause.term-paths
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%auto)
+            (%enable default
+                     clause.term-paths-openers
+                     unusual-consp-rules))
+
+(%autoprove forcing-consp-of-clause.term-paths
+            (%use (%instance (%thm lemma-for-forcing-consp-of-clause.term-paths)
+                             (flag 'term))))
+
+(%autoprove forcing-consp-of-clause.term-paths-list
+            (%use (%instance (%thm lemma-for-forcing-consp-of-clause.term-paths)
+                             (flag 'list))))
+
+
+
+(%autoprove disjoint-from-nonep-of-clause.term-paths-when-memberp
+            (%cdr-induction x)
+            (%disable default common-disables))
+
+
+(%autoprove lemma-for-disjoint-from-nonep-of-clause.simple-tests-and-clause.term-paths
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%auto)
+            (%enable default
+                     clause.term-paths-openers
+                     unusual-consp-rules))
+
+(%autoprove disjoint-from-nonep-of-clause.simple-tests-and-clause.term-paths
+            (%use (%instance (%thm lemma-for-disjoint-from-nonep-of-clause.simple-tests-and-clause.term-paths)
+                             (flag 'term))))
+
+(%autoprove disjoint-from-nonep-of-clause.simple-tests-list-and-clause.term-paths-list
+            (%use (%instance (%thm lemma-for-disjoint-from-nonep-of-clause.simple-tests-and-clause.term-paths)
+                             (flag 'list))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/term-tests.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/term-tests.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/term-tests.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/term-tests.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,526 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit clause.flag-term-tests)
+(%autoadmit clause.term-tests)
+(%autoadmit clause.term-tests-list)
+(%autoadmit clause.slow-term-tests)
+
+(defmacro %clause.flag-term-tests-induction (flag x acc)
+  `(%induct (rank ,x)
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.variablep ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x)
+                  (equal (logic.function-name ,x) 'if)
+                  (equal (len (logic.function-args ,x)) 3))
+             (((,flag 'term)
+               (,x (first (logic.function-args ,x)))
+               (,acc (clause.flag-term-tests 'term
+                                             (second (logic.function-args ,x))
+                                             (clause.flag-term-tests 'term
+                                                                     (third (logic.function-args ,x))
+                                                                     ,acc))))
+              ((,flag 'term)
+               (,x (second (logic.function-args ,x)))
+               (,acc (clause.flag-term-tests 'term
+                                             (third (logic.function-args ,x))
+                                             ,acc)))
+              ((,flag 'term)
+               (,x (third (logic.function-args ,x)))
+               (,acc ,acc))))
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x)
+                  (or (not (equal (logic.function-name ,x) 'if))
+                      (not (equal (len (logic.function-args ,x)) 3))))
+             (((,flag 'list)
+               (,x (logic.function-args ,x))
+               (,acc ,acc))))
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+             (((,flag 'list)
+               (,x (logic.lambda-actuals ,x))
+               (,acc ,acc))))
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term)
+               (,x (car ,x))
+               (,acc (clause.flag-term-tests 'list (cdr ,x) ,acc)))
+              ((,flag 'list)
+               (,x (cdr ,x))
+               (,acc ,acc))))))
+
+(encapsulate
+ ()
+ (%autoprove lemma-1-for-definition-of-clause.term-tests
+             (%logic.term-induction flag x)
+             (%restrict default clause.slow-term-tests (equal x 'x)))
+
+ (%autoprove lemma-2-for-definition-of-clause.term-tests
+             (%clause.flag-term-tests-induction flag x acc)
+             (%restrict default clause.flag-term-tests (equal x 'x)))
+
+ (local (%enable default
+                 lemma-1-for-definition-of-clause.term-tests
+                 [outside]lemma-1-for-definition-of-clause.term-tests
+                 lemma-2-for-definition-of-clause.term-tests
+                 [outside]lemma-2-for-definition-of-clause.term-tests))
+
+ (%autoprove lemma-3-for-definition-of-clause.term-tests
+             (%clause.flag-term-tests-induction flag x acc)
+             (%restrict default clause.flag-term-tests (equal x 'x))
+             (%restrict default clause.slow-term-tests (equal x 'x)))
+
+ (local (%enable default
+                 lemma-3-for-definition-of-clause.term-tests))
+
+ (%autoprove definition-of-clause.term-tests
+             (%enable default clause.term-tests clause.term-tests-list)
+             (%restrict default clause.flag-term-tests (equal x 'x))
+             (%restrict default clause.slow-term-tests (equal x 'x)))
+
+ (%autoprove definition-of-clause.term-tests-list
+             (%enable default clause.term-tests clause.term-tests-list)
+             (%restrict default clause.flag-term-tests (equal x 'x))
+             (%restrict default clause.slow-term-tests (equal x 'x)))
+
+ (%autoprove clause.flag-term-tests-removal
+             (%enable default clause.term-tests)
+             (%restrict default clause.slow-term-tests (equal x 'x)))
+
+ (%autoprove clause.flag-term-tests-list-removal
+             (%enable default clause.term-tests-list)
+             (%restrict default clause.slow-term-tests (equal x 'x))))
+
+
+
+(%autoprove clause.term-tests-when-logic.constantp
+            (%restrict default definition-of-clause.term-tests (equal x 'x)))
+
+(%autoprove clause.term-tests-when-logic.variablep
+            (%restrict default definition-of-clause.term-tests (equal x 'x)))
+
+(%autoprove clause.term-tests-when-non-if-logic.functionp
+            (%restrict default definition-of-clause.term-tests (equal x 'x)))
+
+(%autoprove clause.term-tests-when-bad-args-logic.functionp
+            (%restrict default definition-of-clause.term-tests (equal x 'x)))
+
+(%autoprove clause.term-tests-when-if-logic.functionp
+            (%restrict default definition-of-clause.term-tests (equal x 'x)))
+
+(%autoprove clause.term-tests-when-logic.lambdap
+            (%restrict default definition-of-clause.term-tests (equal x 'x)))
+
+(%autoprove clause.term-tests-when-degenerate
+            (%restrict default definition-of-clause.term-tests (equal x 'x)))
+
+
+
+(%autoprove clause.term-tests-list-when-not-consp
+            (%restrict default definition-of-clause.term-tests-list (equal x 'x)))
+
+(%autoprove clause.term-tests-list-of-cons
+            (%restrict default definition-of-clause.term-tests-list (equal x '(cons a x))))
+
+(%autoprove clause.term-tests-list-when-len-three)
+
+
+
+(%autoprove lemma-for-clause.term-tests-when-clause.simple-termp
+            (%clause.simple-term-induction flag x))
+
+(%autoprove clause.term-tests-when-clause.simple-termp
+            (%use (%instance (%thm lemma-for-clause.term-tests-when-clause.simple-termp)
+                             (flag 'term))))
+
+(%autoprove clause.term-tests-list-when-clause.simple-term-listp
+            (%use (%instance (%thm lemma-for-clause.term-tests-when-clause.simple-termp)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.term-listp-of-clause.term-tests
+            (%clause.simple-term-induction flag x)
+            (%disable default
+                      expensive-arithmetic-rules
+                      unusual-subsetp-rules
+                      type-set-like-rules
+                      formula-decomposition
+                      expensive-term/formula-inference
+                      logic.term-listp-of-subsetp-when-logic.term-listp
+                      logic.termp-when-memberp-of-logic.term-listp))
+
+(%autoprove forcing-logic.term-listp-of-clause.term-tests
+            (%use (%instance (%thm lemma-for-forcing-logic.term-listp-of-clause.term-tests)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-listp-of-clause.term-tests-list
+            (%use (%instance (%thm lemma-for-forcing-logic.term-listp-of-clause.term-tests)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.term-list-atblp-of-clause.term-tests
+            (%clause.simple-term-induction flag x)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      formula-decomposition
+                      expensive-term/formula-inference
+                      unusual-subsetp-rules
+                      same-length-prefixes-equal-cheap
+                      logic.term-list-atblp-of-subsetp-when-logic.term-list-atblp
+                      logic.term-atblp-when-memberp-of-logic.term-list-atblp
+                      logic.term-list-atblp-when-logic.variable-listp
+                      logic.term-list-atblp-when-not-consp
+                      clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                      logic.term-list-atblp-when-logic.constant-listp))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.term-tests
+            (%use (%instance (%thm lemma-for-forcing-logic.term-list-atblp-of-clause.term-tests)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.term-tests-list
+            (%use (%instance (%thm lemma-for-forcing-logic.term-list-atblp-of-clause.term-tests)
+                             (flag 'list))))
+
+
+
+
+
+
+(%autoadmit clause.flag-simple-tests)
+(%autoadmit clause.simple-tests)
+(%autoadmit clause.simple-tests-list)
+(%autoadmit clause.slow-simple-tests)
+
+(defmacro %clause.flag-simple-tests-induction (flag x acc)
+  `(%induct (rank ,x)
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.variablep ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x)
+                  (equal (logic.function-name ,x) 'if)
+                  (equal (len (logic.function-args ,x)) 3)
+                  (clause.simple-termp (first (logic.function-args ,x))))
+             (((,flag 'term)
+               (,x    (second (logic.function-args ,x)))
+               (,acc  (clause.flag-simple-tests 'term (third (logic.function-args ,x)) ,acc)))
+              ((,flag 'term)
+               (,x    (third (logic.function-args ,x)))
+               (,acc ,acc))))
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x)
+                  (or (not (equal (logic.function-name ,x) 'if))
+                      (not (equal (len (logic.function-args ,x)) 3))
+                      (not (clause.simple-termp (first (logic.function-args ,x))))))
+             (((,flag 'list)
+               (,x (logic.function-args ,x))
+               (,acc ,acc))))
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+             (((,flag 'list)
+               (,x (logic.lambda-actuals ,x))
+               (,acc ,acc))))
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term)
+               (,x (car ,x))
+               (,acc (clause.flag-simple-tests 'list (cdr ,x) ,acc)))
+              ((,flag 'list)
+               (,x (cdr ,x))
+               (,acc ,acc))))))
+
+(encapsulate
+ ()
+ (%autoprove lemma-1-for-definition-of-clause.simple-tests
+             (%logic.term-induction flag x)
+             (%restrict default clause.slow-simple-tests (equal x 'x)))
+
+ (%autoprove lemma-2-for-definition-of-clause.simple-tests
+             (%clause.flag-simple-tests-induction flag x acc)
+             (%restrict default clause.flag-simple-tests (equal x 'x)))
+
+ (local (%enable default
+                 lemma-1-for-definition-of-clause.simple-tests
+                 lemma-2-for-definition-of-clause.simple-tests))
+
+ (%autoprove lemma-3-for-definition-of-clause.simple-tests
+             (%clause.flag-simple-tests-induction flag x acc)
+             (%restrict default clause.flag-simple-tests (equal x 'x))
+             (%restrict default clause.slow-simple-tests (equal x 'x)))
+
+ (local (%enable default lemma-3-for-definition-of-clause.simple-tests))
+
+ (%autoprove definition-of-clause.simple-tests
+             (%enable default clause.simple-tests clause.simple-tests-list)
+             (%restrict default clause.slow-simple-tests (equal x 'x))
+             (%forcingp nil))
+
+ (%autoprove definition-of-clause.simple-tests-list
+             (%enable default clause.simple-tests clause.simple-tests-list)
+             (%restrict default clause.slow-simple-tests (equal x 'x)))
+
+ (%autoprove clause.flag-simple-tests-removal
+             (%enable default clause.simple-tests clause.simple-tests-list)
+             (%restrict default clause.slow-simple-tests (equal x 'x))
+             (%forcingp nil))
+
+ (%autoprove clause.flag-simple-tests-list-removal
+             (%enable default clause.simple-tests clause.simple-tests-list)
+             (%restrict default clause.slow-simple-tests (equal x 'x)))
+
+ (local (%disable default
+                  clause.flag-simple-tests-removal
+                  clause.flag-simple-tests-list-removal))
+
+ (%autoprove clause.slow-simple-tests-removal
+             (%enable default clause.simple-tests))
+
+ ;; BOZO clause.slow-simple-tests-list-removal doesn't seem to exist.
+ )
+
+(%autoprove clause.simple-tests-when-logic.constantp
+            (%restrict default definition-of-clause.simple-tests (equal x 'x)))
+
+(%autoprove clause.simple-tests-when-logic.variablep
+            (%restrict default definition-of-clause.simple-tests (equal x 'x)))
+
+(%autoprove clause.simple-tests-when-non-if-logic.functionp
+            (%restrict default definition-of-clause.simple-tests (equal x 'x)))
+
+(%autoprove clause.simple-tests-when-bad-args-logic.functionp
+            (%restrict default definition-of-clause.simple-tests (equal x 'x)))
+
+(%autoprove clause.simple-tests-when-if
+            (%restrict default definition-of-clause.simple-tests (equal x 'x)))
+
+(%autoprove clause.simple-tests-when-logic.lambdap
+            (%restrict default definition-of-clause.simple-tests (equal x 'x)))
+
+(%autoprove clause.simple-tests-when-degenerate
+            (%restrict default definition-of-clause.simple-tests (equal x 'x)))
+
+
+(%autoprove clause.simple-tests-list-when-not-consp
+            (%restrict default definition-of-clause.simple-tests-list (equal x 'x)))
+
+(%autoprove clause.simple-tests-list-of-cons
+            (%restrict default definition-of-clause.simple-tests-list (equal x '(cons a x))))
+
+(%autoprove clause.simple-tests-list-when-len-three)
+
+
+(%autoprove true-listp-of-clause.simple-tests-list
+            (%cdr-induction x))
+
+(%autoprove clause.simple-tests-list-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove clause.simple-tests-list-of-app
+            (%cdr-induction x))
+
+
+
+(%create-theory clause.term-tests-openers)
+(%enable clause.term-tests-openers
+         clause.term-tests-when-logic.constantp
+         clause.term-tests-when-logic.variablep
+         clause.term-tests-when-non-if-logic.functionp
+         clause.term-tests-when-bad-args-logic.functionp
+         clause.term-tests-when-if-logic.functionp
+         clause.term-tests-when-logic.lambdap
+         clause.term-tests-when-degenerate)
+
+(local (%create-theory common-disables))
+(local (%enable common-disables
+                expensive-arithmetic-rules
+                expensive-arithmetic-rules-two
+                type-set-like-rules
+                formula-decomposition
+                expensive-term/formula-inference
+                unusual-subsetp-rules
+                unusual-memberp-rules
+                unusual-consp-rules
+                same-length-prefixes-equal-cheap
+                clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                clause.term-tests-openers
+                subsetp-of-cons-two
+                subsetp-when-not-consp-two
+                subsetp-transitive-two
+                subsetp-of-app-of-app-when-subsetp-two
+                subsetp-of-app-of-app-when-subsetp-one))
+
+(%autoprove lemma-for-subsetp-of-clause.simple-tests-and-clause.term-tests
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%auto)
+            (%enable default
+                     clause.term-tests-openers
+                     subsetp-of-cons-two
+                     subsetp-when-not-consp-two
+                     subsetp-transitive-two
+                     subsetp-of-app-of-app-when-subsetp-two
+                     subsetp-of-app-of-app-when-subsetp-one
+                     unusual-consp-rules))
+
+(%autoprove subsetp-of-clause.simple-tests-and-clause.term-tests
+            (%use (%instance (%thm lemma-for-subsetp-of-clause.simple-tests-and-clause.term-tests)
+                             (flag 'term))))
+
+(%autoprove subsetp-of-clause.simple-tests-list-and-clause.term-tests-list
+            (%use (%instance (%thm lemma-for-subsetp-of-clause.simple-tests-and-clause.term-tests)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-clause.simple-term-listp-of-clause.simple-tests
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%auto)
+            (%enable default
+                     clause.term-tests-openers
+                     subsetp-of-cons-two
+                     subsetp-when-not-consp-two
+                     subsetp-transitive-two
+                     subsetp-of-app-of-app-when-subsetp-two
+                     subsetp-of-app-of-app-when-subsetp-one
+                     unusual-consp-rules))
+
+(%autoprove clause.simple-term-listp-of-clause.simple-tests
+            (%use (%instance (%thm lemma-for-clause.simple-term-listp-of-clause.simple-tests)
+                             (flag 'term))))
+
+(%autoprove clause.simple-term-listp-of-clause.simple-tests-list
+            (%use (%instance (%thm lemma-for-clause.simple-term-listp-of-clause.simple-tests)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-clause.simple-tests-when-clause.simple-termp
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%auto)
+            (%enable default
+                     clause.term-tests-openers
+                     subsetp-of-cons-two
+                     subsetp-when-not-consp-two
+                     subsetp-transitive-two
+                     subsetp-of-app-of-app-when-subsetp-two
+                     subsetp-of-app-of-app-when-subsetp-one
+                     unusual-consp-rules))
+
+(%autoprove clause.simple-tests-when-clause.simple-termp
+            (%use (%instance (%thm lemma-for-clause.simple-tests-when-clause.simple-termp)
+                             (flag 'term))))
+
+(%autoprove clause.simple-tests-list-when-clause.simple-term-listp
+            (%use (%instance (%thm lemma-for-clause.simple-tests-when-clause.simple-termp)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-forcing-logic.term-listp-of-clause.simple-tests
+            (%clause.simple-term-induction flag x)
+            (%disable default common-disables)
+            (%auto)
+            (%enable default
+                     clause.term-tests-openers
+                     subsetp-of-cons-two
+                     subsetp-when-not-consp-two
+                     subsetp-transitive-two
+                     subsetp-of-app-of-app-when-subsetp-two
+                     subsetp-of-app-of-app-when-subsetp-one
+                     unusual-consp-rules))
+
+(%autoprove forcing-logic.term-listp-of-clause.simple-tests
+            (%use (%instance (%thm lemma-for-forcing-logic.term-listp-of-clause.simple-tests)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-listp-of-clause.simple-tests-list
+            (%use (%instance (%thm lemma-for-forcing-logic.term-listp-of-clause.simple-tests)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-forcing-logic.term-list-atblp-of-clause.simple-tests
+            (%clause.simple-term-induction flag x)
+            (%disable default forcing-true-listp-of-logic.function-args)
+            (%disable default common-disables)
+            (%auto)
+            (%enable default
+                     clause.term-tests-openers
+                     subsetp-of-cons-two
+                     subsetp-when-not-consp-two
+                     subsetp-transitive-two
+                     subsetp-of-app-of-app-when-subsetp-two
+                     subsetp-of-app-of-app-when-subsetp-one
+                     unusual-consp-rules))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.simple-tests
+            (%use (%instance (%thm lemma-for-forcing-logic.term-list-atblp-of-clause.simple-tests)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.simple-tests-list
+            (%use (%instance (%thm lemma-for-forcing-logic.term-list-atblp-of-clause.simple-tests)
+                             (flag 'list))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level7/unlifted-subterms.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level7/unlifted-subterms.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level7/unlifted-subterms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level7/unlifted-subterms.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,167 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%autoadmit clause.unlifted-subterms)
+
+(%autoprove consp-of-clause.unlifted-subterms
+            (%restrict default clause.unlifted-subterms (equal x 'x)))
+
+(%autoprove clause.unlifted-subterms-when-logic.constantp
+            (%restrict default clause.unlifted-subterms (equal x 'x)))
+
+(%autoprove clause.unlifted-subterms-when-logic.variablep
+            (%restrict default clause.unlifted-subterms (equal x 'x)))
+
+(%autoprove clause.unlifted-subterms-when-non-if-logic.functionp
+            (%restrict default clause.unlifted-subterms (equal x 'x)))
+
+(%autoprove clause.unlifted-subterms-when-bad-args-logic.functionp
+            (%restrict default clause.unlifted-subterms (equal x 'x)))
+
+(%autoprove clause.unlifted-subterms-when-if-logic.functionp
+            (%restrict default clause.unlifted-subterms (equal x 'x)))
+
+(%autoprove clause.unlifted-subterms-when-logic.lambdap
+            (%restrict default clause.unlifted-subterms (equal x 'x)))
+
+(%autoprove clause.unlifted-subterms-when-degenerate
+            (%restrict default clause.unlifted-subterms (equal x 'x)))
+
+
+(defmacro %clause.unlifted-subterms-induction (x)
+  `(%induct (rank ,x)
+            ((logic.constantp ,x) nil)
+            ((logic.variablep ,x) nil)
+            ((and (logic.functionp ,x)
+                  (equal (logic.function-name ,x) 'if)
+                  (equal (len (logic.function-args ,x)) 3))
+             (((,x (first (logic.function-args ,x))))
+              ((,x (second (logic.function-args ,x))))
+              ((,x (third (logic.function-args ,x))))))
+            ((and (logic.functionp ,x)
+                  (or (not (equal (logic.function-name ,x) 'if))
+                      (not (equal (len (logic.function-args ,x)) 3))))
+             nil)
+            ((logic.lambdap ,x)
+             nil)
+            ((and (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)))
+
+(%autoprove true-listp-of-clause.unlifted-subterms
+            (%clause.unlifted-subterms-induction x))
+
+(%autoprove forcing-logic.term-listp-of-clause.unlifted-subterms
+            (%clause.unlifted-subterms-induction x))
+
+(%autoprove clause.unlifted-subterms-when-clause.simple-termp
+            (%clause.unlifted-subterms-induction x))
+
+(%autoprove clause.simple-termp-when-memberp-of-clause.unlifted-subterms
+            (%clause.unlifted-subterms-induction x)
+            ;; speed hint
+            (%disable default in-superset-when-in-subset-two
+                      not-in-subset-when-not-in-superset-one
+                      subsetp-transitive-two
+                      subsetp-when-prefixp-cheap
+                      subsetp-when-ordered-subsetp
+                      memberp-when-memberp-of-cdr
+                      clause.simple-termp-when-memberp-of-clause.simple-term-listp-alt))
+
+(%autoprove clause.unlifted-subterms-under-iff
+            (%clause.unlifted-subterms-induction x)
+            ;; speed hint
+            (%disable default
+                      clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                      clause.unlifted-subterms-when-clause.simple-termp
+                      clause.lifted-termp-when-clause.simple-termp))
+
+(%autoprove clause.simple-term-listp-of-clause.unlifted-subterms
+            (%clause.unlifted-subterms-induction x)
+            (%disable default
+                      clause.simple-term-listp-of-cdr-when-clause.simple-term-listp
+                      clause.unlifted-subterms-when-clause.simple-termp
+                      clause.lifted-termp-when-clause.simple-termp))
+
+
+
+
+
+(%autoadmit clause.unlifted-subterms-list)
+
+(%autoprove clause.unlifted-subterms-list-when-not-consp
+            (%restrict default clause.unlifted-subterms-list (equal x 'x)))
+
+(%autoprove clause.unlifted-subterms-list-of-cons
+            (%restrict default clause.unlifted-subterms-list (equal x '(cons a x))))
+
+(%autoprove true-listp-of-clause.unlifted-subterms-list
+            (%cdr-induction x))
+
+(%autoprove consp-of-clause.unlifted-subterms-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-listp-of-clause.unlifted-subterms-list
+            (%cdr-induction x))
+
+(%autoprove clause.unlifted-subterms-list-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove clause.unlifted-subterms-list-of-app
+            (%cdr-induction x))
+
+(%autoprove clause.simple-termp-when-memberp-of-clause.unlifted-subterms-list
+            (%cdr-induction x))
+
+(%autoprove clause.unlifted-subterms-list-under-iff
+            (%cdr-induction x))
+
+(%autoprove clause.simple-term-listp-of-clause.unlifted-subterms-list
+            (%cdr-induction x))
+
+
+(%create-theory clause.unlifted-subterms-openers)
+(%enable clause.unlifted-subterms-openers
+         clause.unlifted-subterms-when-logic.constantp
+         clause.unlifted-subterms-when-logic.variablep
+         clause.unlifted-subterms-when-non-if-logic.functionp
+         clause.unlifted-subterms-when-bad-args-logic.functionp
+         clause.unlifted-subterms-when-if-logic.functionp
+         clause.unlifted-subterms-when-logic.lambdap
+         clause.unlifted-subterms-when-degenerate)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level8/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/acl2-customization.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/assumptions-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/assumptions-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/assumptions-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/assumptions-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,59 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoprove rw.eqtrace-bldr-under-iff
+            ;; BOZO move to assms
+            (%restrict default definition-of-rw.eqtrace-bldr (equal x 'x)))
+
+(%autoadmit rw.compile-assumptions-trace)
+
+(local (%enable default
+                rw.assumptions-tracep
+                rw.compile-assumptions-trace
+                rw.eqtrace-formula
+                rw.trace-conclusion-formula
+                rw.trace-formula))
+
+(%autoprove rw.compile-assumptions-trace-under-iff)
+
+(%autoprove forcing-logic.appealp-of-rw.compile-assumptions-trace)
+
+(%autoprove forcing-logic.conclusion-of-rw.compile-assumptions-trace)
+
+(%autoprove forcing-logic.proofp-of-rw.compile-assumptions-trace)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/basic-recognizers.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/basic-recognizers.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/basic-recognizers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/basic-recognizers.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,106 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tracep")
+(include-book "evaluator-bldr-2")
+(%interactive)
+
+
+(%autoadmit rw.fail-tracep)
+
+(%autoprove booleanp-of-rw.fail-tracep
+            (%enable default rw.fail-tracep))
+
+
+(%autoadmit rw.transitivity-tracep)
+
+(%autoprove booleanp-of-rw.transitivity-tracep
+            (%enable default rw.transitivity-tracep))
+
+
+(%autoadmit rw.equiv-by-args-tracep)
+
+(%autoprove booleanp-of-rw.equiv-by-args-tracep
+            (%enable default rw.equiv-by-args-tracep))
+
+
+
+(%autoadmit rw.lambda-equiv-by-args-tracep)
+
+(%autoprove booleanp-of-rw.lambda-equiv-by-args-tracep
+            (%enable default rw.lambda-equiv-by-args-tracep))
+
+
+
+(%autoadmit rw.beta-reduction-tracep)
+
+(%autoprove booleanp-of-rw.beta-reduction-tracep
+            (%enable default rw.beta-reduction-tracep))
+
+
+
+(%autoadmit rw.ground-tracep)
+
+(%autoprove booleanp-of-rw.ground-tracep
+            (%enable default rw.ground-tracep))
+
+
+(%autoadmit rw.if-specialcase-nil-tracep)
+
+(%autoprove booleanp-of-rw.if-specialcase-nil-tracep
+            (%enable default rw.if-specialcase-nil-tracep))
+
+
+
+(%autoadmit rw.if-specialcase-t-tracep)
+
+(%autoprove booleanp-of-rw.if-specialcase-t-tracep
+            (%enable default rw.if-specialcase-t-tracep))
+
+
+
+(%autoadmit rw.not-tracep)
+
+(%autoprove booleanp-of-rw.not-tracep
+            (%enable default rw.not-tracep))
+
+
+(%autoadmit rw.negative-if-tracep)
+
+(%autoprove booleanp-of-rw.negative-if-tracep
+            (%enable default rw.negative-if-tracep))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/basic-recognizers")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/beta-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/beta-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/beta-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/beta-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,54 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-beta-reduction-trace)
+
+(local (%enable default
+                rw.beta-reduction-tracep
+                rw.compile-beta-reduction-trace
+                rw.trace-conclusion-formula
+                rw.trace-formula))
+
+(%autoprove rw.compile-beta-reduction-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-beta-reduction-trace)
+
+(%autoprove logic.conclusion-of-rw.compile-beta-reduction-trace)
+
+(%autoprove logic.proofp-of-rw.compile-beta-reduction-trace)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/ccstep-arities.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/ccstep-arities.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/ccstep-arities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/ccstep-arities.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,83 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-arities")
+(include-book "ccsteps")
+(%interactive)
+
+
+(%autoadmit rw.faster-ccstepp)
+
+(%autoprove rw.faster-ccstep-removal
+            (%enable default rw.ccstepp rw.faster-ccstepp))
+
+(%autoadmit rw.faster-ccstep-listp)
+
+(%autoprove rw.faster-ccstep-list-removal
+            (%cdr-induction x)
+            (%restrict default rw.faster-ccstep-listp (equal x 'x)))
+
+
+(%autoadmit rw.slow-ccstep-arities)
+
+(%autoprove rw.slow-ccsteps-arities-correct
+            (%enable default rw.slow-ccstep-arities))
+
+(%autoadmit rw.ccstep-arities)
+
+(%autoprove rw.cstep-arities-removal
+            (%enable default rw.ccstep-arities rw.slow-ccstep-arities))
+
+
+(%autoadmit rw.slow-ccstep-list-arities)
+
+(%autoprove rw.slow-ccstep-list-arities-correct
+            (%cdr-induction x)
+            (%restrict default rw.slow-ccstep-list-arities (equal x 'x)))
+
+
+(%autoadmit rw.ccstep-list-arities)
+
+(%autoprove true-listp-of-rw.ccstep-list-arities
+            (%autoinduct rw.ccstep-list-arities x acc)
+            (%restrict default rw.ccstep-list-arities (equal x 'x)))
+
+(%autoprove rw.ccstep-list-arities-removal
+            (%autoinduct rw.ccstep-list-arities x acc)
+            (%restrict default rw.ccstep-list-arities (equal x 'x))
+            (%restrict default rw.slow-ccstep-list-arities (equal x 'x)))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/ccstep-arities")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/ccstep-check.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/ccstep-check.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/ccstep-check.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/ccstep-check.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,106 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "ccsteps")
+(include-book "ccstep-arities")
+(%interactive)
+
+
+(%autoprove forcing-rw.hypbox-listp-of-rw.ccstep-list-hypboxes
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-listp-of-rw.ccstep-list-terms
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.trace-listp-of-rw.ccstep-list-gather-traces
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.eqtrace-listp-of-rw.ccstep-list-gather-contradictions
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formulap-of-rw.ccstep-list->original-goal
+            (%cdr-induction x)
+            (%restrict default rw.ccstep-list->original-goal (equal x 'x))
+            (%enable default rw.ccstep->original-goal))
+
+(%autoprove logic.provable-listp-of-remove-duplicates-when-logic.provable-listp-free)
+
+
+
+(defsection rw.ccstep-list-bldr-okp
+
+  (%autoadmit rw.ccstep-list-bldr-okp)
+  (%autoadmit rw.ccstep-list-bldr-high)
+
+  (local (%enable default
+                  rw.ccstep-list-bldr-okp
+                  rw.ccstep-list-bldr-high))
+
+  (%autoprove rw.ccstep-list-bldr-okp-of-rw.ccstep-list-bldr-high)
+
+  (local (%disable default
+                   expensive-arithmetic-rules
+                   expensive-arithmetic-rules-two
+                   memberp-when-not-consp
+                   memberp-when-not-subset-of-somep-cheap
+                   memberp-when-not-superset-of-somep-cheap
+                   memberp-when-memberp-of-cdr
+                   in-superset-when-in-subset-one
+                   not-in-subset-when-not-in-superset-two
+                   subset-of-somep-when-obvious-alt
+                   superset-of-somep-when-obvious-alt
+                   memberp-when-logic.all-terms-larger-cheap))
+
+  (%autoprove booleanp-of-rw.ccstep-list-bldr-okp)
+  (%autoprove rw.ccstep-list-bldr-okp-of-logic.appeal-identity)
+  (%autoprove lemma-1-for-soundness-of-rw.ccstep-list-bldr-okp)
+  (%autoprove lemma-2-for-soundness-of-rw.ccstep-list-bldr-okp)
+
+  (%autoprove forcing-soundness-of-rw.ccstep-list-bldr-okp
+              (%use (%instance (%thm lemma-1-for-soundness-of-rw.ccstep-list-bldr-okp)))
+              (%use (%instance (%thm lemma-2-for-soundness-of-rw.ccstep-list-bldr-okp)))
+              (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                               (x (rw.ccstep-list-bldr (logic.extras x)
+                                                       defs
+                                                       (if (rw.ccstep->provedp (first (logic.extras x)))
+                                                           nil
+                                                         (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                                                                 axioms thms atbl))
+                                                       (logic.provable-list-witness (RW.CCSTEP-LIST-FORCED-GOALS (LOGIC.EXTRAS X))
+                                                                                    axioms thms atbl)))))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/ccstep-check")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/ccsteps.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/ccsteps.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/ccsteps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/ccsteps.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,454 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-compiler")
+(%interactive)
+
+(defsection rw.ccstepp
+
+  (%autoadmit rw.ccstepp)
+  (%autoadmit rw.ccstep->term)
+  (%autoadmit rw.ccstep->hypbox)
+  (%autoadmit rw.ccstep->contradiction)
+  (%autoadmit rw.ccstep->trace)
+  (%autoadmit rw.ccstep)
+
+  (local (%enable default
+                  rw.ccstepp
+                  rw.ccstep
+                  rw.ccstep->term
+                  rw.ccstep->hypbox
+                  rw.ccstep->contradiction
+                  rw.ccstep->trace))
+
+  (%autoprove booleanp-of-rw.ccstepp)
+  (%autoprove forcing-rw.ccstepp-of-rw.ccstep)
+  (%autoprove rw.ccstep->term-of-rw.ccstep)
+  (%autoprove rw.ccstep->hypbox-of-rw.ccstep)
+  (%autoprove rw.ccstep->contradiction-of-rw.ccstep)
+  (%autoprove rw.ccstep->trace-of-rw.ccstep)
+  (%autoprove forcing-logic.termp-of-rw.ccstep->term)
+  (%autoprove forcing-rw.hypboxp-of-rw.ccstep->hypbox)
+  (%autoprove forcing-rw.eqtracep-of-rw.ccstep->contradiction)
+  (%autoprove forcing-rw.eqtrace-contradictionp-of-rw.ccstep->contradiction)
+  (%autoprove forcing-rw.eqtrace-okp-of-rw.ccstep->contradiction)
+  (%autoprove forcing-rw.hypbox->right-of-rw.ccstep->hypbox-when-rw.ccstep->contradiction)
+  (%autoprove forcing-rw.tracep-of-rw.ccstep->trace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.ccstep->trace)
+  (%autoprove forcing-rw.trace->hypbox-of-rw.ccstep->trace)
+  (%autoprove forcing-rw.trace->lhs-of-rw.ccstep->trace))
+
+
+(%deflist rw.ccstep-listp (x)
+          (rw.ccstepp x))
+
+(%deflist rw.ccstep-list-listp (x)
+          (rw.ccstep-listp x))
+
+
+(%defprojection :list (rw.ccstep-list-terms x)
+                :element (rw.ccstep->term x)
+                :nil-preservingp t)
+
+(%defprojection :list (rw.ccstep-list-list-terms x)
+                :element (rw.ccstep-list-terms x)
+                :nil-preservingp t)
+
+(%defprojection :list (rw.ccstep-list-hypboxes x)
+                :element (rw.ccstep->hypbox x)
+                :nil-preservingp t)
+
+(%defprojection :list (rw.ccstep-list-list-hypboxes x)
+                :element (rw.ccstep-list-hypboxes x)
+                :nil-preservingp t)
+
+
+(defsection rw.ccstep-list-gather-traces
+  (%autoadmit rw.ccstep-list-gather-traces)
+  (%autoprove rw.ccstep-list-gather-traces-when-not-consp
+              (%restrict default rw.ccstep-list-gather-traces (equal x 'x)))
+  (%autoprove rw.ccstep-list-gather-traces-of-cons
+              (%restrict default rw.ccstep-list-gather-traces (equal x '(cons a x))))
+  (%autoprove true-listp-of-rw.ccstep-list-gather-traces
+              (%cdr-induction x)))
+
+(defsection rw.ccstep-list-list-gather-traces
+  (%autoadmit rw.ccstep-list-list-gather-traces)
+  (%autoprove rw.ccstep-list-list-gather-traces-when-not-consp
+              (%restrict default rw.ccstep-list-list-gather-traces (equal x 'x)))
+  (%autoprove true-listp-of-rw.ccstep-list-list-gather-traces
+              (%cdr-induction x)
+              (%restrict default rw.ccstep-list-list-gather-traces (equal x 'x)))
+  (%autoprove rw.ccstep-list-list-gather-traces-of-cons
+              (%restrict default rw.ccstep-list-list-gather-traces (equal x '(cons a x)))))
+
+(defsection rw.ccstep-list-gather-contradictions
+  (%autoadmit rw.ccstep-list-gather-contradictions)
+  (%autoprove rw.ccstep-list-gather-contradictions-when-not-consp
+              (%restrict default rw.ccstep-list-gather-contradictions (equal x 'x)))
+  (%autoprove rw.ccstep-list-gather-contradictions-of-cons
+              (%restrict default rw.ccstep-list-gather-contradictions (equal x '(cons a x))))
+  (%autoprove true-listp-of-rw.ccstep-list-gather-contradictions
+              (%cdr-induction x)))
+
+(defsection rw.ccstep-list-list-gather-contradictions
+  (%autoadmit rw.ccstep-list-list-gather-contradictions)
+  (%autoprove rw.ccstep-list-list-gather-contradictions-when-not-consp
+              (%restrict default rw.ccstep-list-list-gather-contradictions (equal x 'x)))
+  (%autoprove true-listp-of-rw.ccstep-list-list-gather-contradictions
+              (%cdr-induction x)
+              (%restrict default rw.ccstep-list-list-gather-contradictions (equal x 'x)))
+  (%autoprove rw.ccstep-list-list-gather-contradictions-of-cons
+              (%restrict default rw.ccstep-list-list-gather-contradictions (equal x '(cons a x)))))
+
+
+(%autoadmit rw.ccstep->provedp)
+(%autoadmit rw.ccstep->terminalp)
+
+(%autoprove rw.ccstep->terminalp-when-rw.ccstep->provedp
+            (%enable default rw.ccstep->terminalp rw.ccstep->provedp))
+
+
+(%autoadmit rw.ccstep->original-goal)
+(%autoadmit rw.ccstep->result-goal)
+(%autoadmit rw.ccstep->clause-prime)
+
+(%autoprove booleanp-of-rw.ccsetp->provedp
+            ;; BOZO misnamed
+            (%enable default rw.ccstep->provedp))
+
+(%autoprove forcing-logic.term-listp-of-rw.ccstep->clause-prime
+            (%enable default rw.ccstep->clause-prime))
+
+(%autoprove forcing-true-listp-of-rw.ccstep->clause-prime
+            (%enable default rw.ccstep->clause-prime))
+
+(%autoprove forcing-rw.ccstep->result-goal-when-rw.ccstep->terminalp
+            (%enable default rw.ccstep->result-goal rw.ccstep->terminalp rw.ccstep->provedp rw.ccstep->clause-prime))
+
+
+(%autoadmit rw.ccstep->t1prime)
+
+(%autoprove forcing-logic.termp-of-rw.ccstep->t1prime
+            (%enable default rw.ccstep->provedp rw.ccstep->t1prime))
+
+(%autoprove forcing-logic.term-atblp-of-rw.ccstep->t1prime
+            (%enable default rw.ccstep->provedp rw.ccstep->t1prime))
+
+
+
+(defsection rw.ccstep-forced-goals
+  (%autoadmit rw.ccstep-forced-goals)
+  (local (%enable default rw.ccstep-forced-goals))
+  (%autoprove true-listp-of-rw.ccstep-forced-goals)
+  (%autoprove rw.ccstep-forced-goals-when-contradiction)
+  (%autoprove forcing-logic.formula-listp-of-rw.ccstep-forced-goals)
+  (%autoprove forcing-logic.formula-list-atblp-of-rw.ccstep-forced-goals))
+
+
+
+(defsection rw.fast-ccstep-list-forced-goals
+  ;(%autoadmit rw.fast-ccstep-list-forced-goals)
+  (%autoadmit rw.ccstep-list-forced-goals)
+  ;(%autoadmit rw.slow-ccstep-list-forced-goals)
+  ;(%autoprove lemma-1-for-definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;            (%autoinduct rw.fast-ccstep-list-forced-goals)
+  ;            (%restrict default rw.fast-ccstep-list-forced-goals (equal x 'x)))
+  ;(%autoprove lemma-2-for-definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;            (%autoinduct rw.fast-ccstep-list-forced-goals)
+  ;            (%restrict default rw.fast-ccstep-list-forced-goals (equal x 'x))
+  ;            (%restrict default rw.slow-ccstep-list-forced-goals (equal x 'x))
+  ;            (%enable default
+  ;                     rw.ccstep-forced-goals
+  ;                     lemma-1-for-definition-of-rw.crewrite-clause-step-list-forced-goals))
+  ;(%autoprove lemma-3-for-definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;            (%autoinduct rw.slow-ccstep-list-forced-goals)
+  ;            (%restrict default rw.slow-ccstep-list-forced-goals (equal x 'x)))
+  ;(%autoprove definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;            (%enable default
+  ;                     lemma-1-for-definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;                     lemma-2-for-definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;                     lemma-3-for-definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;                     rw.ccstep-list-forced-goals)
+  ;            (%restrict default rw.slow-ccstep-list-forced-goals (equal x 'x)))
+  ;(%autoprove rw.fast-ccstep-list-forced-goals-removal
+  ;            (%enable default
+  ;                     rw.ccstep-list-forced-goals
+  ;                     lemma-1-for-definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;                     lemma-2-for-definition-of-rw.crewrite-clause-step-list-forced-goals
+  ;                     lemma-3-for-definition-of-rw.crewrite-clause-step-list-forced-goals))
+  (%autoprove true-listp-of-rw.crewrite-clause-step-list-forced-goals
+              (%cdr-induction x)
+              (%restrict default rw.ccstep-list-forced-goals (equal x 'x)))
+  (%autoprove rw.ccstep-list-forced-goals-when-not-consp
+              (%restrict default rw.ccstep-list-forced-goals (equal x 'x)))
+  (%autoprove rw.ccstep-list-forced-goals-of-cons
+              (%restrict default rw.ccstep-list-forced-goals (equal x '(cons a x))))
+  (%autoprove rw.ccstep-list-forced-goals-of-list-fix
+              (%cdr-induction x))
+  (%autoprove rw.ccstep-list-forced-goals-of-app
+              (%cdr-induction x))
+  (%autoprove logic.formula-listp-of-rw.ccstep-list-forced-goals
+              (%cdr-induction x))
+  (%autoprove logic.formula-list-atblp-of-rw.ccstep-list-forced-goals
+              (%cdr-induction x)))
+
+(defsection rw.fast-ccstep-list-list-forced-goals
+  ;(%autoadmit rw.fast-ccstep-list-list-forced-goals)
+  (%autoadmit rw.ccstep-list-list-forced-goals)
+  ;(%autoadmit rw.slow-ccstep-list-list-forced-goals)
+  ;(%autoprove lemma-1-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals
+  ;            (%autoinduct rw.fast-ccstep-list-list-forced-goals)
+  ;            (%restrict default rw.fast-ccstep-list-list-forced-goals (equal x 'x)))
+  ;(%autoprove lemma-2-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals
+  ;            (%autoinduct rw.fast-ccstep-list-list-forced-goals)
+  ;            (%enable default lemma-1-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals)
+  ;            (%restrict default rw.fast-ccstep-list-list-forced-goals (equal x 'x))
+  ;            (%restrict default rw.slow-ccstep-list-list-forced-goals (equal x 'x)))
+  ;(%autoprove lemma-3-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals
+  ;            (%autoinduct rw.slow-ccstep-list-list-forced-goals)
+  ;            (%restrict default rw.slow-ccstep-list-list-forced-goals (equal x 'x)))
+  ;(%autoprove definition-of-rw.crewrite-clause-step-list-list-forced-goals
+  ;            (%autoinduct rw.slow-ccstep-list-list-forced-goals)
+  ;            (%enable default
+  ;                     rw.ccstep-list-list-forced-goals
+  ;                     lemma-1-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals
+  ;                     lemma-2-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals
+  ;                     lemma-3-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals)
+  ;            (%restrict default rw.slow-ccstep-list-list-forced-goals (equal x 'x)))
+  ;(%autoprove rw.fast-ccstep-list-list-forced-goals-removal
+  ;            (%enable default
+  ;                     rw.ccstep-list-list-forced-goals
+  ;                     lemma-1-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals
+  ;                     lemma-2-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals
+  ;                     lemma-3-for-definition-of-rw.crewrite-clause-step-list-list-forced-goals))
+  (%autoprove true-listp-of-rw.ccstep-list-list-forced-goals
+              (%cdr-induction x)
+              (%restrict default rw.ccstep-list-list-forced-goals (equal x 'x)))
+  (%autoprove rw.ccstep-list-list-forced-goals-when-not-consp
+              (%restrict default rw.ccstep-list-list-forced-goals (equal x 'x)))
+  (%autoprove rw.ccstep-list-list-forced-goals-of-cons
+              (%restrict default rw.ccstep-list-list-forced-goals (equal x '(cons a x))))
+  (%autoprove logic.formula-listp-of-rw.ccstep-list-list-forced-goals
+              (%cdr-induction x))
+  (%autoprove logic.formula-list-atblp-of-rw.ccstep-list-list-forced-goals
+              (%cdr-induction x)))
+
+
+(defsection rw.proved-ccstep-bldr
+  (%autoadmit rw.proved-ccstep-bldr)
+
+  (local (%enable default
+                  rw.proved-ccstep-bldr
+                  rw.ccstep->result-goal
+                  rw.ccstep->provedp
+                  rw.ccstep->original-goal
+                  rw.ccstep-forced-goals
+                  rw.hypbox-formula
+                  logic.term-formula
+                  rw.trace-formula
+                  rw.trace-conclusion-formula))
+
+  (local (%disable default ;; extra speed hint
+                   type-set-like-rules
+                   expensive-arithmetic-rules
+                   expensive-arithmetic-rules-two
+                   same-length-prefixes-equal-cheap
+                   expensive-term/formula-inference
+                   unusual-consp-rules
+                   car-when-not-consp
+                   cdr-when-not-consp
+                   memberp-when-not-consp
+                   memberp-when-not-subset-of-somep-cheap
+                   memberp-when-not-superset-of-somep-cheap
+                   memberp-when-memberp-of-cdr
+                   in-superset-when-in-subset-one
+                   not-in-subset-when-not-in-superset-two
+                   subset-of-somep-when-obvious-alt
+                   superset-of-somep-when-obvious-alt
+                   memberp-when-logic.all-terms-larger-cheap))
+
+  (%autoprove rw.proved-ccstep-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.proved-ccstep-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.proved-ccstep-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.proved-ccstep-bldr))
+
+
+(defsection rw.usual-ccstep-bldr
+  (%autoadmit rw.usual-ccstep-bldr)
+
+  (local (%enable default
+                  rw.usual-ccstep-bldr
+                  rw.ccstep->result-goal
+                  rw.ccstep->provedp
+                  rw.ccstep->original-goal
+                  rw.ccstep-forced-goals
+                  rw.hypbox-formula
+                  logic.term-formula
+                  rw.trace-formula
+                  rw.trace-conclusion-formula))
+
+  (local (%disable default ;; extra speed hint
+                   type-set-like-rules
+                   expensive-arithmetic-rules
+                   expensive-arithmetic-rules-two
+                   same-length-prefixes-equal-cheap
+                   expensive-term/formula-inference
+                   unusual-consp-rules
+                   car-when-not-consp
+                   cdr-when-not-consp
+                   memberp-when-not-consp
+                   memberp-when-not-subset-of-somep-cheap
+                   memberp-when-not-superset-of-somep-cheap
+                   memberp-when-memberp-of-cdr
+                   in-superset-when-in-subset-one
+                   not-in-subset-when-not-in-superset-two
+                   subset-of-somep-when-obvious-alt
+                   superset-of-somep-when-obvious-alt
+                   memberp-when-logic.all-terms-larger-cheap))
+
+  (%autoprove rw.usual-ccstep-bldr-under-iff)
+  (%autoprove forcing-logic.appealp-of-rw.usual-ccstep-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.usual-ccstep-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.usual-ccstep-bldr))
+
+
+
+
+(%autoadmit rw.ccstep-list->original-goal)
+
+(defsection rw.ccstep-list->none-provedp
+  (%autoadmit rw.ccstep-list->none-provedp)
+  (%autoprove rw.ccstep-list->none-provedp-when-not-consp
+              (%restrict default rw.ccstep-list->none-provedp (equal x 'x)))
+  (%autoprove rw.ccstep-list->none-provedp-of-cons
+              (%restrict default rw.ccstep-list->none-provedp (equal x '(cons a x))))
+  (%autoprove booleanp-of-rw.ccstep-list->none-provedp
+              (%cdr-induction x)))
+
+(defsection rw.ccstep-list->compatiblep
+  (%autoadmit rw.ccstep-list->compatiblep)
+  (%autoprove booleanp-of-rw.ccstep-list->compatiblep
+              (%autoinduct rw.ccstep-list->compatiblep)
+              (%restrict default rw.ccstep-list->compatiblep (equal x 'x)))
+  (%autoprove rw.ccstep-list->compatiblep-when-not-consp
+              (%restrict default rw.ccstep-list->compatiblep (equal x 'x)))
+  (%autoprove rw.ccstep-list->compatiblep-when-not-of-cdr
+              (%restrict default rw.ccstep-list->compatiblep (equal x 'x))))
+
+
+
+
+(defsection rw.usual-ccstep-list-bldr
+  (%autoadmit rw.usual-ccstep-list-bldr)
+  (local (%enable default rw.ccstep->provedp))
+  (local (%restrict default rw.usual-ccstep-list-bldr (equal x 'x)))
+  (local (%restrict default rw.ccstep-list->compatiblep (equal x 'x)))
+  (local (%restrict default rw.ccstep-list->original-goal (equal x 'x)))
+  (local (%disable default ;; extra speed hint
+                   type-set-like-rules
+                   expensive-arithmetic-rules
+                   expensive-arithmetic-rules-two
+                   same-length-prefixes-equal-cheap
+                   expensive-term/formula-inference
+                   unusual-consp-rules
+                   car-when-not-consp
+                   cdr-when-not-consp
+                   memberp-when-not-consp
+                   memberp-when-not-subset-of-somep-cheap
+                   memberp-when-not-superset-of-somep-cheap
+                   memberp-when-memberp-of-cdr
+                   in-superset-when-in-subset-one
+                   not-in-subset-when-not-in-superset-two
+                   subset-of-somep-when-obvious-alt
+                   superset-of-somep-when-obvious-alt
+                   memberp-when-logic.all-terms-larger-cheap))
+  (%autoprove forcing-logic.appealp-of-rw.usual-ccstep-list-bldr
+              (%autoinduct rw.usual-ccstep-list-bldr))
+  (%autoprove forcing-logic.conclusion-of-rw.usual-ccstep-list-bldr
+              (%autoinduct rw.usual-ccstep-list-bldr))
+  (%autoprove forcing-logic.proofp-of-rw.usual-ccstep-list-bldr
+              (%autoinduct rw.usual-ccstep-list-bldr)))
+
+
+(defsection rw.ccstep-list-bldr
+
+  (%autoadmit rw.ccstep-list-bldr)
+
+  (local (%enable default rw.ccstep-list-bldr))
+
+  (%autoprove lemma-1-for-rw.ccstep-list-bldr
+              (%autoinduct rw.ccstep-list->compatiblep)
+              (%restrict default rw.ccstep-list->compatiblep (equal x 'x)))
+
+  (%autoprove lemma-2-for-rw.ccstep-list-bldr
+              (%use (%instance (%thm lemma-1-for-rw.ccstep-list-bldr))))
+
+  (local (%enable default lemma-2-for-rw.ccstep-list-bldr))
+
+  (local (%disable default ;; extra speed hint
+                   type-set-like-rules
+                   expensive-arithmetic-rules
+                   expensive-arithmetic-rules-two
+                   same-length-prefixes-equal-cheap
+                   expensive-term/formula-inference
+                   unusual-consp-rules
+                   car-when-not-consp
+                   cdr-when-not-consp
+                   memberp-when-not-consp
+                   memberp-when-not-subset-of-somep-cheap
+                   memberp-when-not-superset-of-somep-cheap
+                   memberp-when-memberp-of-cdr
+                   in-superset-when-in-subset-one
+                   not-in-subset-when-not-in-superset-two
+                   subset-of-somep-when-obvious-alt
+                   superset-of-somep-when-obvious-alt
+                   memberp-when-logic.all-terms-larger-cheap))
+
+  (%autoprove forcing-logic.appealp-of-rw.ccstep-list-bldr
+              (%restrict default rw.ccstep-list->compatiblep (equal x 'x))
+              (%restrict default rw.ccstep-list->original-goal (equal x 'x)))
+
+  (%autoprove forcing-logic.conclusion-of-rw.ccstep-list-bldr
+              (%restrict default rw.ccstep-list->compatiblep (equal x 'x))
+              (%restrict default rw.ccstep-list->original-goal (equal x 'x)))
+
+  (%autoprove forcing-logic.proofp-of-rw.ccstep-list-bldr
+              (%restrict default rw.ccstep-list->compatiblep (equal x 'x))
+              (%restrict default rw.ccstep-list->original-goal (equal x 'x))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/ccsteps")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level8/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/cert.image	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1 @@
+level8-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/collect-forced-goals.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/collect-forced-goals.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/collect-forced-goals.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/collect-forced-goals.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,225 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+
+(defsection revappend-lemmas
+
+  (local (%disable default forcing-revappend-removal))
+
+  (%autoprove revappend-under-iff
+              (%autoinduct revappend x acc)
+              (%restrict default revappend (equal x 'x)))
+
+  (%autoprove consp-of-revappend
+              (%autoinduct revappend x acc)
+              (%restrict default revappend (equal x 'x)))
+
+  (%autoprove memberp-of-revappend
+              (%autoinduct revappend x acc)
+              (%restrict default revappend (equal x 'x)))
+
+  (%autoprove subsetp-of-revappend-one
+              (%autoinduct revappend x acc)
+              (%restrict default revappend (equal x 'x)))
+
+  (%autoprove subsetp-of-revappend-two
+              (%autoinduct revappend x acc)
+              (%restrict default revappend (equal x 'x)))
+
+  (%autoprove true-listp-of-revappend
+              (%autoinduct revappend x acc)
+              (%restrict default revappend (equal x 'x)))
+
+  (%autoprove logic.formula-listp-of-revappend
+              (%autoinduct revappend x acc)
+              (%restrict default revappend (equal x 'x)))
+
+  (%autoprove logic.formula-list-atblp-of-revappend
+              (%autoinduct revappend x acc)
+              (%restrict default revappend (equal x 'x))))
+
+
+(defsection fast-merge
+
+  (%autoadmit fast-merge)
+
+  (local (%enable default fast-merge))
+  (local (%disable default forcing-revappend-removal))
+
+  (%autoprove consp-of-fast-merge)
+  (%autoprove true-listp-of-fast-merge)
+  (%autoprove memberp-of-fast-merge)
+  (%autoprove subsetp-of-fast-merge-one)
+
+  (%autoprove subsetp-of-fast-merge-two
+              (%disable default
+                        subsetp-of-revappend-two
+                        [outside]subsetp-of-revappend-two)
+              (%use (%instance (%thm subsetp-of-revappend-two)
+                               (x x)
+                               (acc y)))
+              (%restrict default revappend (equal x 'x)))
+
+  (%autoprove logic.formula-listp-of-fast-merge)
+  (%autoprove logic.formula-list-atblp-of-fast-merge)
+  (%autoprove fast-merge-when-not-consp-left)
+  (%autoprove fast-merge-with-nil-left)
+  (%autoprove fast-merge-when-not-consp-right)
+  (%autoprove fast-merge-with-nil-right))
+
+
+
+
+(%autoadmit rw.flag-collect-forced-goals)
+
+(%autoprove true-listp-of-rw.flag-collect-forced-goals
+            (%autoinduct rw.flag-collect-forced-goals)
+            (%restrict default rw.flag-collect-forced-goals (equal x 'x)))
+
+(%autoadmit rw.collect-forced-goals)
+(%autoadmit rw.collect-forced-goals-list)
+
+(%autoprove definition-of-rw.collect-forced-goals
+            (%enable default
+                     rw.collect-forced-goals
+                     rw.collect-forced-goals-list)
+            (%restrict default rw.flag-collect-forced-goals (equal x 'x)))
+
+(%autoprove definition-of-rw.collect-forced-goals-list
+            (%enable default
+                     rw.collect-forced-goals
+                     rw.collect-forced-goals-list)
+            (%restrict default rw.flag-collect-forced-goals (equal x 'x)))
+
+(%autoprove rw.flag-collect-forced-goals-of-term
+            (%enable default rw.collect-forced-goals))
+
+(%autoprove rw.flag-collect-forced-goals-of-list
+            (%enable default rw.collect-forced-goals-list))
+
+
+
+(%autoprove rw.collect-forced-goals-list-when-not-consp
+            (%restrict default definition-of-rw.collect-forced-goals-list (equal x 'x)))
+
+(%autoprove rw.collect-forced-goals-list-of-cons
+            (%restrict default definition-of-rw.collect-forced-goals-list (equal x '(cons a x))))
+
+
+
+
+
+
+
+
+(%autoprove lemma-for-true-listp-of-rw.collect-forced-goals
+            (%rw.trace-induction flag x)
+            (%restrict default definition-of-rw.collect-forced-goals (equal x 'x)))
+
+(%autoprove true-listp-of-rw.collect-forced-goals
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.collect-forced-goals)
+                             (flag 'term))))
+
+(%autoprove true-listp-of-rw.collect-forced-goals-list
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.collect-forced-goals)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.formula-listp-of-rw.collect-forced-goals
+            (%rw.trace-induction flag x)
+            (%restrict default definition-of-rw.collect-forced-goals (equal x 'x)))
+
+(%autoprove forcing-logic.formula-listp-of-rw.collect-forced-goals
+            (%use (%instance (%thm lemma-for-forcing-logic.formula-listp-of-rw.collect-forced-goals)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.formula-listp-of-rw.collect-forced-goals-list
+            (%use (%instance (%thm lemma-for-forcing-logic.formula-listp-of-rw.collect-forced-goals)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.formula-list-atblp-of-rw.collect-forced-goals
+            (%rw.trace-induction flag x)
+            (%restrict default definition-of-rw.collect-forced-goals (equal x 'x)))
+
+(%autoprove forcing-logic.formula-list-atblp-of-rw.collect-forced-goals
+            (%use (%instance (%thm lemma-for-forcing-logic.formula-list-atblp-of-rw.collect-forced-goals)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.formula-list-atblp-of-rw.collect-forced-goals-list
+            (%use (%instance (%thm lemma-for-forcing-logic.formula-list-atblp-of-rw.collect-forced-goals)
+                             (flag 'list))))
+
+
+
+
+
+(%autoprove memberp-of-rw.trace-conclusion-formula-in-rw.collect-forced-goals
+            (%restrict default definition-of-rw.collect-forced-goals (equal x 'x)))
+
+(%autoprove forcing-subsetp-of-rw.collect-forced-goals-list-of-subtraces
+            (%restrict default definition-of-rw.collect-forced-goals (equal x 'x))
+            (%restrict default definition-of-rw.trace-okp (equal x 'x))
+            (%enable default
+                     rw.trace-step-okp
+                     rw.force-tracep))
+
+
+
+
+
+
+(%autoadmit rw.collect-forced-goals-list-list)
+
+(%autoprove rw.collect-forced-goals-list-list-when-not-consp
+            (%restrict default rw.collect-forced-goals-list-list (equal x 'x)))
+
+(%autoprove rw.collect-forced-goals-list-list-of-cons
+            (%restrict default rw.collect-forced-goals-list-list (equal x '(cons a x))))
+
+(%autoprove true-listp-of-rw.collect-forced-goals-list-list
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.formula-listp-of-rw.collect-forced-goals-list-list
+            (%cdr-induction x))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/collect-forced-goals")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/crewrite-if-general-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/crewrite-if-general-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/crewrite-if-general-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/crewrite-if-general-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,213 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-if-same-compiler")
+(%interactive)
+
+(%autoadmit rw.compile-crewrite-if-generalcase-trace)
+
+(local (%enable default rw.compile-crewrite-if-generalcase-trace))
+
+(local (%enable default
+                lemma-1-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-2-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-3-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-4-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-5-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-6-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-7-for-rw.compile-crewrite-if-specialcase-same-trace))
+
+(local (%enable default
+                rw.crewrite-if-generalcase-tracep
+                rw.compile-crewrite-if-generalcase-trace
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                rw.hypbox-formula
+                logic.term-formula))
+
+(local (%splitlimit 20))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 unusual-consp-rules
+                 usual-consp-rules
+                 expensive-term/formula-inference))
+
+
+(local (%create-theory locally-useless-rules))
+
+(local (%enable locally-useless-rules
+                CAR-WHEN-NOT-CONSP
+                CDR-OF-CDR-WHEN-TRUE-LISTP-WITH-LEN-FREE-PAST-THE-END
+                CDR-OF-CDR-WITH-LEN-FREE-PAST-THE-END
+                CDR-WHEN-TRUE-LISTP-WITH-LEN-FREE-PAST-THE-END
+                CLAUSE.NEGATIVE-TERMP-WHEN-CLAUSE.SIMPLE-NEGATIVEP
+                DEFINITION-LISTP-OF-CDR-WHEN-DEFINITION-LISTP
+                DEFINITION-LISTP-WHEN-NOT-CONSP
+                DEFINITIONP-OF-CAR-WHEN-DEFINITION-LISTP
+                FORCING-LOGIC.=LHS-UNDER-IFF
+                FORCING-LOGIC.FORMULAP-OF-LOGIC.VLHS
+                FORCING-LOGIC.FORMULAP-OF-LOGIC.~ARG
+                FORCING-LOGIC.FUNCTION-OF-LOGIC.FUNCTION-NAME-AND-LOGIC.FUNCTION-ARGS-FREE
+                FORCING-LOGIC.VRHS-UNDER-IFF
+                LEN-2-WHEN-NOT-CDR-OF-CDR
+                LEN-WHEN-NOT-CONSP
+                LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                LIST-OF-FIRST-AND-SECOND-WHEN-LEN-2
+                LOGIC.ALL-FUNCTIONSP-WHEN-NOT-CONSP
+                LOGIC.APPEAL-LISTP-WHEN-NOT-CONSP
+                LOGIC.APPEALP-OF-CAR-WHEN-LOGIC.APPEAL-LISTP
+                LOGIC.APPEALP-WHEN-MEMBERP-OF-LOGIC.APPEAL-LISTP
+                LOGIC.CONSTANT-LISTP-OF-CDR-WHEN-LOGIC.CONSTANT-LISTP
+                LOGIC.CONSTANT-LISTP-OF-LOGIC.FUNCTION-ARGS-WHEN-LOGIC.BASE-EVALUABLEP
+                LOGIC.CONSTANT-LISTP-WHEN-NOT-CONSP
+                LOGIC.CONSTANTP-WHEN-LOGIC.LAMBDAP-CHEAP
+                LOGIC.CONSTANTP-WHEN-LOGIC.VARIABLEP
+                LOGIC.CONSTANTP-WHEN-NOT-CONSP
+                LOGIC.DISJOIN-FORMULAS-WHEN-NOT-CONSP
+                LOGIC.FMTYPE-OF-CAR-WHEN-LOGIC.ALL-ATOMICP
+                LOGIC.FMTYPE-OF-CAR-WHEN-LOGIC.ALL-DISJUNCTIONSP
+                LOGIC.FMTYPE-OF-CAR-WHEN-LOGIC.ALL-NEGATIONSP
+                LOGIC.FMTYPE-WHEN-DEFINITIONP
+                LOGIC.FORMULA-LISTP-OF-CDR-WHEN-LOGIC.FORMULA-LISTP
+                LOGIC.FORMULA-LISTP-WHEN-DEFINITION-LISTP
+                LOGIC.FORMULA-LISTP-WHEN-NOT-CONSP
+                LOGIC.FORMULAP-OF-CAR-WHEN-LOGIC.FORMULA-LISTP
+                LOGIC.FORMULAP-OF-SECOND-WHEN-LOGIC.FORMULA-LISTP
+                LOGIC.FORMULAP-WHEN-DEFINITIONP
+                LOGIC.FORMULAP-WHEN-LOGIC.TERMP
+                LOGIC.FORMULAP-WHEN-MALFORMED-CHEAP
+                LOGIC.FORMULAP-WHEN-NOT-CONSP
+                LOGIC.FUNCTIONP-OF-CAR-WHEN-LOGIC.ALL-FUNCTIONSP
+                LOGIC.FUNCTIONP-OF-LOGIC.=LHS-WHEN-DEFINITIONP
+                LOGIC.FUNCTIONP-WHEN-CLAUSE.NEGATIVE-TERMP
+                LOGIC.FUNCTIONP-WHEN-LOGIC.LAMBDAP-CHEAP
+                LOGIC.LAMBDAP-WHEN-CONSP-OF-CAR-CHEAP
+                LOGIC.LAMBDAP-WHEN-NOT-ANYTHING-ELSE-MAYBE-EXPENSIVE
+                LOGIC.LAMBDAP-WHEN-NOT-OTHER-STUFF-CHEAP
+                LOGIC.PROOF-LISTP-WHEN-NOT-CONSP
+                LOGIC.STRIP-CONCLUSIONS-WHEN-NOT-CONSP
+                LOGIC.TERM-LIST-FORMULAS-WHEN-NOT-CONSP
+                LOGIC.TERM-LISTP-WHEN-LOGIC.CONSTANT-LISTP-CHEAP
+                LOGIC.TERM-LISTP-WHEN-LOGIC.VARIABLE-LISTP-CHEAP
+                LOGIC.TERM-LISTP-WHEN-NOT-CONSP
+                LOGIC.TERMP-WHEN-INVALID-MAYBE-EXPENSIVE
+                LOGIC.TERMP-WHEN-LOGIC.CONSTANTP
+                LOGIC.TERMP-WHEN-LOGIC.FORMULAP
+                LOGIC.TERMP-WHEN-LOGIC.VARIABLEP
+                LOGIC.TERMP-WHEN-NOT-CONSP-CHEAP
+                LOGIC.VARIABLE-LISTP-OF-CDR-WHEN-LOGIC.VARIABLE-LISTP
+                LOGIC.VARIABLE-LISTP-WHEN-NOT-CONSP
+                LOGIC.VARIABLEP-OF-CAR-WHEN-LOGIC.VARIABLE-LISTP
+                LOGIC.VARIABLEP-WHEN-CONSP
+                LOGIC.VARIABLEP-WHEN-LOGIC.CONSTANTP
+                LOGIC.VARIABLEP-WHEN-LOGIC.FUNCTIONP
+                LOGIC.VARIABLEP-WHEN-LOGIC.LAMBDAP-CHEAP
+                LOOKUP-WHEN-NOT-CONSP
+                MEMBERP-WHEN-MEMBERP-OF-CDR
+                MEMBERP-WHEN-NOT-CONSP
+                RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                SECOND-UNDER-IFF-WHEN-LOGIC.TERM-LISTP-WITH-LEN-FREE
+                TRUE-LIST-LISTP-WHEN-NOT-CONSP
+                TRUE-LISTP-OF-CAR-WHEN-TRUE-LIST-LISTP
+                TRUE-LISTP-WHEN-NOT-CONSP))
+
+(%autoprove rw.compile-crewrite-if-generalcase-trace-under-iff)
+
+
+(encapsulate
+ ()
+ (local (%max-proof-size 1300000000))
+ ;; this is 1100 seconds
+ (%autoprove logic.appealp-of-rw.compile-crewrite-if-generalcase-trace
+             (%enable default expensive-term/formula-inference usual-consp-rules)
+             (%disable default locally-useless-rules)
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default) ;; 296 seconds
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default logic.appealp-when-memberp-of-logic.appeal-listp)))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 1300000000))
+ (%autoprove logic.conclusion-of-rw.compile-crewrite-if-generalcase-trace
+             (%enable default expensive-term/formula-inference usual-consp-rules)
+             (%disable default locally-useless-rules)
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      logic.appealp-when-memberp-of-logic.appeal-listp)))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 900000000))
+ (%autoprove logic.proofp-of-rw.compile-crewrite-if-generalcase-trace
+             (%enable default expensive-term/formula-inference usual-consp-rules)
+             (%disable default locally-useless-rules)
+             (%disable default
+                       cdr-when-not-consp
+                       consp-when-true-listp-cheap
+                       consp-when-consp-of-cdr-cheap
+                       equal-of-booleans-rewrite)
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default
+                      consp-when-true-listp-cheap
+                      logic.appealp-when-memberp-of-logic.appeal-listp)))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/crewrite-if-same-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/crewrite-if-same-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/crewrite-if-same-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/crewrite-if-same-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,968 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoprove lemma-1-for-rw.compile-crewrite-if-specialcase-same-trace)
+(%autoprove lemma-2-for-rw.compile-crewrite-if-specialcase-same-trace (%forcingp nil))
+(%autoprove lemma-3-for-rw.compile-crewrite-if-specialcase-same-trace (%forcingp nil))
+(%autoprove lemma-4-for-rw.compile-crewrite-if-specialcase-same-trace)
+(%autoprove lemma-5-for-rw.compile-crewrite-if-specialcase-same-trace)
+(%autoprove lemma-6-for-rw.compile-crewrite-if-specialcase-same-trace)
+(%autoprove lemma-7-for-rw.compile-crewrite-if-specialcase-same-trace (%forcingp nil))
+
+(local (%enable default
+                rw.crewrite-if-specialcase-same-tracep
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                rw.hypbox-formula
+                logic.term-formula))
+
+(local (%enable default
+                lemma-1-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-2-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-3-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-4-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-5-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-6-for-rw.compile-crewrite-if-specialcase-same-trace
+                lemma-7-for-rw.compile-crewrite-if-specialcase-same-trace))
+
+(local (%create-theory locally-useless-rules))
+(local (%enable locally-useless-rules
+                CDR-WHEN-TRUE-LISTP-WITH-LEN-FREE-PAST-THE-END
+                LOGIC.FUNCTIONP-WHEN-LOGIC.LAMBDAP-CHEAP
+                LOGIC.FMTYPE-WHEN-DEFINITIONP
+                TRUE-LISTP-WHEN-NOT-CONSP
+                LOGIC.TERM-LIST-FORMULAS-WHEN-NOT-CONSP
+                LOGIC.STRIP-CONCLUSIONS-WHEN-NOT-CONSP
+                LOGIC.DISJOIN-FORMULAS-WHEN-NOT-CONSP
+                LOGIC.PROOF-LISTP-WHEN-NOT-CONSP
+                FORCING-LOGIC.=LHS-UNDER-IFF
+                MEMBERP-WHEN-MEMBERP-OF-CDR
+                FORCING-LOGIC.VRHS-UNDER-IFF
+                CDR-OF-CDR-WHEN-TRUE-LISTP-WITH-LEN-FREE-PAST-THE-END
+                CDR-OF-CDR-WITH-LEN-FREE-PAST-THE-END
+                MEMBERP-WHEN-NOT-CONSP
+                LOGIC.TERMP-WHEN-LOGIC.CONSTANTP
+                LOGIC.TERMP-WHEN-LOGIC.VARIABLEP
+                FORCING-LOGIC.FORMULAP-OF-LOGIC.~ARG
+                LOGIC.LAMBDAP-WHEN-NOT-ANYTHING-ELSE-MAYBE-EXPENSIVE
+                LOGIC.LAMBDAP-WHEN-NOT-OTHER-STUFF-CHEAP
+                LOGIC.LAMBDAP-WHEN-CONSP-OF-CAR-CHEAP
+                LOGIC.VARIABLEP-WHEN-LOGIC.CONSTANTP
+                LOGIC.CONSTANTP-WHEN-LOGIC.VARIABLEP
+                LOGIC.TERMP-WHEN-INVALID-MAYBE-EXPENSIVE
+                FORCING-LOGIC.FORMULAP-OF-LOGIC.VLHS
+                LOGIC.VARIABLEP-WHEN-LOGIC.LAMBDAP-CHEAP
+                LOGIC.VARIABLEP-WHEN-CONSP
+                CLAUSE.NEGATIVE-TERMP-WHEN-CLAUSE.SIMPLE-NEGATIVEP
+                LOGIC.FORMULA-LISTP-WHEN-DEFINITION-LISTP
+                LOGIC.TERMP-WHEN-LOGIC.FORMULAP
+                LOGIC.CONSTANTP-WHEN-NOT-CONSP
+                LOGIC.CONSTANTP-WHEN-LOGIC.LAMBDAP-CHEAP
+                DEFINITION-LISTP-WHEN-NOT-CONSP
+                LOGIC.TERM-LISTP-WHEN-LOGIC.CONSTANT-LISTP-CHEAP
+                LOGIC.FUNCTIONP-OF-LOGIC.=LHS-WHEN-DEFINITIONP
+                LOGIC.TERM-LISTP-WHEN-LOGIC.VARIABLE-LISTP-CHEAP
+                LOGIC.FORMULA-LISTP-WHEN-NOT-CONSP
+                LOGIC.FORMULAP-WHEN-NOT-CONSP
+                LOGIC.TERMP-WHEN-NOT-CONSP-CHEAP
+                LOGIC.FORMULAP-WHEN-MALFORMED-CHEAP
+                LOGIC.VARIABLE-LISTP-WHEN-NOT-CONSP
+                LOGIC.CONSTANT-LISTP-WHEN-NOT-CONSP
+                LOGIC.FORMULAP-WHEN-DEFINITIONP
+                LOGIC.TERM-LISTP-WHEN-NOT-CONSP
+                LOGIC.VARIABLEP-OF-CAR-WHEN-LOGIC.VARIABLE-LISTP
+                LIST-OF-FIRST-AND-SECOND-WHEN-LEN-2))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 unusual-consp-rules
+                 usual-consp-rules
+                 expensive-term/formula-inference
+                 locally-useless-rules))
+
+(%autoadmit rw.compile-crewrite-if-specialcase-same-trace-iff)
+
+(local (%enable default rw.compile-crewrite-if-specialcase-same-trace-iff))
+
+(%autoprove rw.compile-crewrite-if-specialcase-same-trace-iff-under-iff)
+
+
+
+; These are hard proofs.
+;
+; I've cut the rules back so far that there's not much more to be gained.
+; I've also tried mucking around with limiting the asusmptions system, but
+; it really doesn't seem to help.
+
+
+;; appealp.  the time to beat is 486 seconds.  394 million conses.  1.6 gb.
+
+
+#||
+(%autorule logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace-iff)
+
+(%enable default
+                     expensive-term/formula-inference)
+(%disable default
+                      locally-useless-rules
+                      equal-of-booleans-rewrite
+                      logic.appeal-listp-when-not-consp
+                      LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+                      RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                      FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                      iff)
+(%liftlimit 10)
+(%splitlimit 2)
+(%auto :strategy (cleanup split urewrite))
+(%crewrite default) ;; this gets us all the forcing goals together.
+(%auto :strategy (cleanup split urewrite))
+(%forcingp nil)
+(%enable default usual-consp-rules)
+(acl2::time$ (%waterfall default 50))
+(%forcingp t)
+
+(%auto)
+
+||#
+
+
+(%autoprove logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace-iff
+            (%enable default
+                     expensive-term/formula-inference)
+            (%disable default
+                      locally-useless-rules
+                      equal-of-booleans-rewrite
+                      logic.appeal-listp-when-not-consp
+                      LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+                      RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                      FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                      iff)
+            (%auto)
+            (%enable default usual-consp-rules))
+
+(%autoprove logic.conclusion-of-rw.compile-crewrite-if-specialcase-same-trace-iff
+            (%enable default
+                     expensive-term/formula-inference)
+            (%disable default
+                      locally-useless-rules
+                      equal-of-booleans-rewrite
+                      logic.appeal-listp-when-not-consp
+                      LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+                      RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                      FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                      iff)
+            (%auto)
+            (%enable default usual-consp-rules))
+
+(%autoprove logic.proofp-of-rw.compile-crewrite-if-specialcase-same-trace-iff
+            (%enable default
+                     expensive-term/formula-inference)
+            (%disable default
+                      locally-useless-rules
+                      equal-of-booleans-rewrite
+                      logic.appeal-listp-when-not-consp
+                      LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+                      RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                      FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                      iff)
+            (%auto)
+            (%enable default usual-consp-rules))
+
+
+
+
+(%autoadmit rw.compile-crewrite-if-specialcase-same-trace-equal)
+
+(local (%enable default rw.compile-crewrite-if-specialcase-same-trace-equal))
+
+(%autoprove rw.compile-crewrite-if-specialcase-same-trace-equal-under-equal)
+;; badly named
+
+
+(%autoprove logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace-equal
+            (%enable default
+                     expensive-term/formula-inference)
+            (%disable default
+                      locally-useless-rules
+                      equal-of-booleans-rewrite
+                      logic.appeal-listp-when-not-consp
+                      LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+                      RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                      FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                      iff)
+            (%auto)
+            (%enable default usual-consp-rules))
+
+(%autoprove logic.conclusion-of-rw.compile-crewrite-if-specialcase-same-trace-equal
+            (%enable default
+                     expensive-term/formula-inference)
+            (%disable default
+                      locally-useless-rules
+                      equal-of-booleans-rewrite
+                      logic.appeal-listp-when-not-consp
+                      LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+                      RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                      FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                      iff)
+            (%auto)
+            (%enable default usual-consp-rules))
+
+(%autoprove logic.proofp-of-rw.compile-crewrite-if-specialcase-same-trace-equal
+            (%enable default
+                     expensive-term/formula-inference)
+            (%disable default
+                      locally-useless-rules
+                      equal-of-booleans-rewrite
+                      logic.appeal-listp-when-not-consp
+                      LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+                      RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP
+                      LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                      FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                      iff)
+            (%auto)
+            (%enable default usual-consp-rules))
+
+
+
+(local (%disable default
+                 rw.compile-crewrite-if-specialcase-same-trace-iff
+                 rw.compile-crewrite-if-specialcase-same-trace-equal))
+
+(%autoadmit rw.compile-crewrite-if-specialcase-same-trace)
+
+(local (%enable default rw.compile-crewrite-if-specialcase-same-trace))
+
+(%autoprove rw.compile-crewrite-if-specialcase-same-trace-under-equal)
+
+(local (%splitlimit 8))
+(local (%liftlimit 8))
+
+(%autoprove logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace)
+
+(%autoprove logic.conclusion-of-rw.compile-crewrite-if-specialcase-same-trace)
+
+(%autoprove logic.proofp-of-rw.compile-crewrite-if-specialcase-same-trace)
+
+#|
+
+
+
+
+
+
+
+
+
+
+(%autorule logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace-equal)
+(%enable default
+         expensive-term/formula-inference)
+(%disable default
+          locally-useless-rules
+          equal-of-booleans-rewrite
+          logic.appeal-listp-when-not-consp
+          LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+          RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+          LEN-WHEN-NOT-CONSP
+          LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+          FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+          iff)
+(%auto :strategy (split cleanup urewrite))
+(%crewrite default)
+
+(%forcingp nil)
+(%auto :strategy (split cleanup urewrite))
+(ACL2::time$ (%crewrite default)) ;; 135 seconds
+(%auto :strategy (split cleanup urewrite))
+(ACL2::time$ (%crewrite default))
+
+
+
+
+
+(%auto :strategy (split cleanup urewrite))
+(%crewrite default)
+(%auto :strategy (split cleanup urewrite))
+
+(%crewrite default)
+
+
+
+(%auto :strategy (split cleanup urewrite))
+
+;; This is the point of interest.
+
+(ACL2::time$ (%crewrite default)) ;; no assm-tweaking, 177 seconds
+(%auto :strategy (split cleanup urewrite)) ;; this leaves us with 114 goals
+
+(ACL2::time$ (%crewrite default)) ;; 135 seconds
+(%auto :strategy (split cleanup urewrite)) ;; this leaves us with 22 goals
+
+(%enable default usual-consp-rules)
+(ACL2::time$ (%crewrite default)) ;; 35 seconds
+(%auto :strategy (split cleanup urewrite)) ;; this leaves us with 27 goals
+
+(ACL2::time$ (%crewrite default)) ;; 27 seconds
+(%auto :strategy (split cleanup urewrite)) ;; this leaves us with 13 goals
+
+(%auto) ;; win
+
+
+
+
+;; Undoing to the point of interest.
+
+(%assmctrl :primaryp nil :secondaryp nil :directp nil :negativep nil)
+
+(ACL2::time$ (%crewrite default)) ;; 11 seconds
+(%auto :strategy (split cleanup urewrite)) ;;  109 goals
+
+(%assmctrl :primaryp t :secondaryp t :directp t :negativep t)
+(%enable default usual-consp-rules)
+(ACL2::time$ (%crewrite default)) ;; 288 seconds
+(%auto :strategy (split cleanup urewrite))
+
+
+
+;; Undoing to the point of interest
+
+(%assmctrl :primaryp nil :secondaryp nil :directp t :negativep t)
+(ACL2::time$ (%crewrite default)) ;; 46 seconds
+(%auto :strategy (split cleanup urewrite)) ;; 109 goals
+
+(ACL2::time$ (%crewrite default)) ;; 46 seconds
+(%auto :strategy (split cleanup urewrite)) ;; 109 goals
+
+(ACL2::time$ (%crewrite default)) ;; fail to make progress
+
+
+
+;; Undoing to the point of interest
+
+;; A big chunk of this is the equalities.  Probably because so many hyps are equal hyps,
+;; caused by the forcing of goals.
+
+(%assmctrl :primaryp t :secondaryp t :directp nil :negativep nil)
+(ACL2::time$ (%crewrite default)) ;; 121 seconds,  splitting going nuts
+
+(%splitlimit 8)
+(%liftlimit 8)
+(%auto :strategy (split cleanup urewrite)) ;; much longer
+
+(ACL2::time$ (%crewrite default)) ;; 402 goals.  man, this seems loserly
+
+
+
+;; Undoing to the point of interest
+
+(%assmctrl :primaryp t :secondaryp nil :directp nil :negativep t)
+(ACL2::time$ (%crewrite default)) ;; 108 seconds
+(%auto :strategy (split cleanup urewrite)) ;; 109 goals
+
+(ACL2::time$ (%crewrite default)) ;; 112 seconds
+(%auto :strategy (split cleanup urewrite)) ;; 109 goals
+
+
+
+
+
+;; Undoing to the point of interest
+
+(%assmctrl :primaryp t :secondaryp t :directp nil :negativep t)
+(ACL2::time$ (%crewrite default)) ;; 100 seconds
+(%auto :strategy (split cleanup urewrite)) ;; 109 goals
+
+
+(%enable default usual-consp-rules)
+(ACL2::time$ (%crewrite default)) ;; 35 seconds
+(%auto :strategy (split cleanup urewrite)) ;; this leaves us with 27 goals
+
+(ACL2::time$ (%crewrite default)) ;; 27 seconds
+(%auto :strategy (split cleanup urewrite)) ;; this leaves us with 13 goals
+
+(%auto)
+
+
+
+
+(%assmctrl :primaryp nil :secondaryp nil :directp nil :negativep nil)
+(%auto :strategy (split cleanup urewrite crewrite))
+
+(%assmctrl :primaryp t :secondaryp t :directp nil :negativep nil)
+(%splitlimit 20)
+(acl2::time$ (%auto :strategy (split cleanup urewrite crewrite)))
+
+
+(%auto :strategy (cleanup split urewrite))
+(%crewrite default)
+(%auto :strategy (cleanup split urewrite))
+
+;; curious, would a very low backchain-limit allow us to make progress more quickly?  i.e.,
+;; prove off goals that are very simple to see without spending extra time on them, so we
+;; can then turn up the volume later?
+(%blimit 50)
+(%assmctrl :primaryp nil
+           :secondaryp nil
+           :directp nil
+           :negativep nil)
+(%crewrite default)
+(%auto :strategy (split cleanup urewrite)) ;; hrmn, maybe throw out elim?  it seems to be going nuts
+
+
+(%assmctrl :primaryp nil
+           :secondaryp nil
+           :directp nil
+           :negativep t)
+(%crewrite default)
+
+
+
+(%blimit 50)
+(%forcingp t)
+(%crewrite default)
+
+(%blimit 3)
+(%forcingp nil)
+(%auto :strategy (split cleanup urewrite))
+
+; oddly this dosen't seem much faster.  maybe the cost is in assembling the assumptions system?
+
+(%blimit 0)
+(acl2::time$ (%crewrite default))
+
+(strip-lens (tactic.skeleton->goals (tactic.harness->skeleton (acl2::w acl2::state))))
+
+
+
+
+
+
+
+(%disable default
+         CAR-OF-LOGIC.TERM-LIST-FORMULAS
+         CONSP-WHEN-TRUE-LISTP-CHEAP
+         EQUAL-OF-CONS-REWRITE
+         FORCING-LOGIC.FMTYPE-OF-LOGIC.DISJOIN-FORMULAS
+         FORCING-LOGIC.VLHS-OF-LOGIC.DISJOIN-FORMULAS
+         FORCING-LOGIC.VRHS-OF-LOGIC.DISJOIN-FORMULAS
+         LEMMA-7-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         ;RW.TRACE-CONCLUSION-FORMULA
+         )
+(%auto)
+
+
+
+(%auto :strategy (cleanup split dist crewrite elim)) ;; no urewrite for profile
+
+(%enable default usual-consp-rules)
+(%auto :strategy (cleanup split dist crewrite elim)) ;; no urewrite for profile
+
+
+
+
+
+
+
+(%create-theory actually-used-rules)
+(%enable actually-used-rules
+         SYMMETRY-OF-EQUAL
+         LOGIC.DISJOIN-FORMULAS-WHEN-SINGLETON-LIST
+         CDR-WHEN-NOT-CONSP
+         CAR-WHEN-NOT-CONSP
+         [OUTSIDE]CONSP-OF-LOGIC.TERM-LIST-FORMULAS
+         FORCING-LOGIC.APPEALP-OF-RW.DISJOINED-IFF-OF-IF-X-Y-Y-BLDR
+         CONSP-WHEN-TRUE-LISTP-CHEAP
+         [OUTSIDE]CDR-OF-LOGIC.TERM-LIST-FORMULAS
+         CDR-WHEN-TRUE-LISTP-WITH-LEN-FREE-PAST-THE-END
+         CONSP-WHEN-CONSP-OF-CDR-CHEAP
+         CONSP-OF-LOGIC.TERM-LIST-FORMULAS
+         LOGIC.FUNCTIONP-WHEN-CLAUSE.NEGATIVE-TERMP
+         FORCING-LOGIC.CONCLUSION-OF-RW.CREWRITE-TWIDDLE-BLDR
+         FORCING-LOGIC.FORMULA-LISTP-OF-LOGIC.TERM-LIST-FORMULAS
+         LEMMA-5-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         FORCING-LOGIC.VLHS-OF-LOGIC.DISJOIN-FORMULAS
+         RW.TRACE-CONCLUSION-FORMULA
+         RW.TRACEP-OF-CAR-WHEN-RW.TRACE-LISTP
+         FORCING-RW.HYPBOXP-OF-RW.TRACE->HYPBOX
+         [OUTSIDE]REDEFINITION-OF-CLAUSE.CLAUSE-FORMULA
+         RW.TRACE-FORMULA
+         FORCING-LOGIC.TERM-LISTP-OF-RW.HYPBOX->LEFT
+         LEMMA-6-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         CDR-OF-CDR-WITH-LEN-FREE-PAST-THE-END
+         CDR-OF-CDR-WHEN-TRUE-LISTP-WITH-LEN-FREE-PAST-THE-END
+         LOGIC.TERM-FORMULA
+         CAR-OF-LOGIC.TERM-LIST-FORMULAS
+         FORCING-LOGIC.CONCLUSION-OF-RW.CREWRITE-TWIDDLE2-BLDR
+         RW.HYPBOX-FORMULA
+         RW.TRACE-LISTP-OF-CDR-WHEN-RW.TRACE-LISTP
+         CONSP-OF-CDR-WITH-LEN-FREE
+         FORCING-LOGIC.APPEALP-OF-RW.IFF-OF-IF-X-Y-Y-BLDR
+         FORCING-TRUE-LISTP-OF-RW.HYPBOX->LEFT
+         REFLEXIVITY-OF-EQUAL
+         LOGIC.VLHS-OF-LOGIC.POR
+         LOGIC.VRHS-OF-LOGIC.POR
+         EQUAL-OF-NIL-ONE
+         FORCING-LOGIC.TERM-LISTP-OF-RW.HYPBOX->RIGHT
+         FORCING-LOGIC.FMTYPE-OF-LOGIC.DISJOIN-FORMULAS
+         FORCING-LOGIC.APPEALP-OF-RW.CREWRITE-TWIDDLE-BLDR
+         LOGIC.APPEALP-OF-SECOND-WHEN-LOGIC.APPEAL-LISTP
+         FORCING-LOGIC.VRHS-OF-LOGIC.DISJOIN-FORMULAS
+         FORCING-RW.TRACE-LISTP-OF-RW.TRACE->SUBTRACES
+         CONSP-OF-CDR-OF-CDR-WITH-LEN-FREE
+         [OUTSIDE]LOGIC.VLHS-OF-LOGIC.POR
+         LOGIC.=LHS-OF-LOGIC.PEQUAL
+         FORCING-LOGIC.APPEALP-OF-RW.CREWRITE-TWIDDLE2-BLDR
+         RW.TRACE->RHS-UNDER-IFF
+         LEMMA-4-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         LEMMA-2-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         LEN-2-WHEN-NOT-CDR-OF-CDR
+         LOGIC.FUNCTION-ARGS-OF-LOGIC.FUNCTION
+         LOGIC.APPEALP-WHEN-MEMBERP-OF-LOGIC.APPEAL-LISTP
+         [OUTSIDE]LOGIC.VRHS-OF-LOGIC.POR
+         CDR-OF-CONS
+         [OUTSIDE]LOGIC.FUNCTION-UNDER-IFF
+         LOGIC.~ARG-OF-LOGIC.PNOT
+         FORCING-TRUE-LISTP-OF-LOGIC.FUNCTION-ARGS
+         EQUAL-OF-LOGIC.DISJOIN-FORMULAS-AND-LOGIC.DISJOIN-FORMULAS-WHEN-SAME-LEN
+         LOGIC.FUNCTION-ARGS-UNDER-IFF-WITH-LEN-FREE
+         LOGIC.FMTYPE-OF-LOGIC.POR
+         CAR-OF-CONS
+         [OUTSIDE]LOGIC.~ARG-OF-LOGIC.PNOT
+         LOGIC.APPEAL-LISTP-OF-SUBSETP-WHEN-LOGIC.APPEAL-LISTP
+         LOGIC.APPEALP-OF-CAR-WHEN-LOGIC.APPEAL-LISTP
+         LOGIC.=RHS-OF-LOGIC.PEQUAL
+         LOGIC.FMTYPE-OF-LOGIC.PEQUAL
+         LOGIC.FUNCTION-NAME-OF-LOGIC.FUNCTION
+         SUBSETP-OF-CDR
+         [OUTSIDE]LOGIC.FMTYPE-OF-LOGIC.POR
+         LEMMA-3-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         LOGIC.FMTYPE-OF-LOGIC.PNOT
+         LEMMA-1-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         [OUTSIDE]LEN-OF-CONS
+         FORCING-LOGIC.FUNCTIONP-OF-LOGIC.FUNCTION
+         LEN-OF-CONS
+         LEMMA-7-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         EQUAL-OF-NIL-TWO
+         CONSP-OF-CONS
+         [OUTSIDE]SUBSETP-REFLEXIVE
+         LIST-FIX-WHEN-TRUE-LISTP
+         [OUTSIDE]LOGIC.FMTYPE-OF-LOGIC.PEQUAL
+         [OUTSIDE]LEN-OF-LOGIC.TERM-LIST-FORMULAS
+         [OUTSIDE]CLAUSE.NEGATIVE-TERMP-OF-LOGIC.FUNCTION-OF-NOT
+         [OUTSIDE]LOGIC.FMTYPE-OF-LOGIC.PNOT
+         [OUTSIDE]MEMBERP-OF-CAR
+         [OUTSIDE]TRUE-LISTP-OF-LOGIC.TERM-LIST-FORMULAS
+         EQUAL-OF-CONS-REWRITE
+         RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE-IFF
+         RW.CREWRITE-IF-SPECIALCASE-SAME-TRACEP)
+
+
+
+
+
+
+
+
+
+(%disable default
+          CAR-OF-LOGIC.TERM-LIST-FORMULAS
+          CONSP-WHEN-TRUE-LISTP-CHEAP
+          FORCING-LOGIC.FMTYPE-OF-LOGIC.DISJOIN-FORMULAS
+          FORCING-LOGIC.VLHS-OF-LOGIC.DISJOIN-FORMULAS
+          FORCING-LOGIC.VRHS-OF-LOGIC.DISJOIN-FORMULAS
+          RW.TRACE-CONCLUSION-FORMULA
+          LEMMA-7-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE)
+(%auto)
+
+
+
+
+
+(CAR-OF-LOGIC.TERM-LIST-FORMULAS
+     CONSP-WHEN-TRUE-LISTP-CHEAP
+     FORCING-LOGIC.FMTYPE-OF-LOGIC.DISJOIN-FORMULAS
+     FORCING-LOGIC.VLHS-OF-LOGIC.DISJOIN-FORMULAS
+     FORCING-LOGIC.VRHS-OF-LOGIC.DISJOIN-FORMULAS
+     LEMMA-7-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+     RW.TRACE-CONCLUSION-FORMULA)
+
+
+
+
+(%create-theory actually-used-rules)
+(%enable actually-used-rules
+         SYMMETRY-OF-EQUAL
+         LOGIC.DISJOIN-FORMULAS-WHEN-SINGLETON-LIST
+         CDR-WHEN-NOT-CONSP
+         CAR-WHEN-NOT-CONSP
+         [OUTSIDE]CONSP-OF-LOGIC.TERM-LIST-FORMULAS
+         FORCING-LOGIC.APPEALP-OF-RW.DISJOINED-IFF-OF-IF-X-Y-Y-BLDR
+         CONSP-WHEN-TRUE-LISTP-CHEAP
+         CONSP-WHEN-CONSP-OF-CDR-CHEAP
+         [OUTSIDE]CDR-OF-LOGIC.TERM-LIST-FORMULAS
+         CDR-WHEN-TRUE-LISTP-WITH-LEN-FREE-PAST-THE-END
+         FORCING-LOGIC.CONCLUSION-OF-RW.CREWRITE-TWIDDLE-BLDR
+         LEMMA-5-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         FORCING-LOGIC.FORMULA-LISTP-OF-LOGIC.TERM-LIST-FORMULAS
+         LOGIC.FUNCTIONP-WHEN-CLAUSE.NEGATIVE-TERMP
+         CONSP-OF-LOGIC.TERM-LIST-FORMULAS
+         RW.TRACE-CONCLUSION-FORMULA
+         FORCING-LOGIC.VLHS-OF-LOGIC.DISJOIN-FORMULAS
+         [OUTSIDE]REDEFINITION-OF-CLAUSE.CLAUSE-FORMULA
+         RW.TRACE-FORMULA
+         RW.TRACEP-OF-CAR-WHEN-RW.TRACE-LISTP
+         LEMMA-6-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         FORCING-LOGIC.CONCLUSION-OF-RW.CREWRITE-TWIDDLE2-BLDR
+         FORCING-RW.HYPBOXP-OF-RW.TRACE->HYPBOX
+         LOGIC.TERM-FORMULA
+         FORCING-LOGIC.TERM-LISTP-OF-RW.HYPBOX->LEFT
+         CAR-OF-LOGIC.TERM-LIST-FORMULAS
+         RW.HYPBOX-FORMULA
+         RW.TRACE-LISTP-OF-CDR-WHEN-RW.TRACE-LISTP
+         EQUAL-OF-NIL-TWO
+         CDR-OF-CDR-WITH-LEN-FREE-PAST-THE-END
+         CDR-OF-CDR-WHEN-TRUE-LISTP-WITH-LEN-FREE-PAST-THE-END
+         FORCING-LOGIC.APPEALP-OF-RW.IFF-OF-IF-X-Y-Y-BLDR
+         CONSP-OF-CDR-WITH-LEN-FREE
+         REFLEXIVITY-OF-EQUAL
+         LOGIC.VLHS-OF-LOGIC.POR
+         LOGIC.VRHS-OF-LOGIC.POR
+         FORCING-TRUE-LISTP-OF-RW.HYPBOX->LEFT
+         LOGIC.APPEALP-OF-SECOND-WHEN-LOGIC.APPEAL-LISTP
+         FORCING-LOGIC.APPEALP-OF-RW.CREWRITE-TWIDDLE-BLDR
+         FORCING-LOGIC.FMTYPE-OF-LOGIC.DISJOIN-FORMULAS
+         FORCING-LOGIC.TERM-LISTP-OF-RW.HYPBOX->RIGHT
+         CONSP-OF-CDR-OF-CDR-WITH-LEN-FREE
+         FORCING-LOGIC.VRHS-OF-LOGIC.DISJOIN-FORMULAS
+         LEMMA-4-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         FORCING-RW.TRACE-LISTP-OF-RW.TRACE->SUBTRACES
+         FORCING-LOGIC.APPEALP-OF-RW.CREWRITE-TWIDDLE2-BLDR
+         LEMMA-2-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         LOGIC.APPEALP-WHEN-MEMBERP-OF-LOGIC.APPEAL-LISTP
+         LEN-2-WHEN-NOT-CDR-OF-CDR
+         FORCING-TRUE-LISTP-OF-LOGIC.FUNCTION-ARGS
+         LOGIC.FUNCTION-ARGS-UNDER-IFF-WITH-LEN-FREE
+         LOGIC.FMTYPE-OF-LOGIC.POR
+         LOGIC.APPEAL-LISTP-OF-SUBSETP-WHEN-LOGIC.APPEAL-LISTP
+         LOGIC.APPEALP-OF-CAR-WHEN-LOGIC.APPEAL-LISTP
+         LOGIC.=LHS-OF-LOGIC.PEQUAL
+         CDR-OF-CONS
+         LOGIC.FUNCTION-ARGS-OF-LOGIC.FUNCTION
+         SUBSETP-OF-CDR
+         LEMMA-3-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         LEMMA-1-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         FORCING-LOGIC.FUNCTIONP-OF-LOGIC.FUNCTION
+         [OUTSIDE]LEN-OF-CONS
+         LOGIC.FMTYPE-OF-LOGIC.PNOT
+         LOGIC.FUNCTION-NAME-OF-LOGIC.FUNCTION
+         LOGIC.=RHS-OF-LOGIC.PEQUAL
+         EQUAL-OF-NIL-ONE
+         LOGIC.FMTYPE-OF-LOGIC.PEQUAL
+         [OUTSIDE]SUBSETP-REFLEXIVE
+         CAR-OF-CONS
+         LEN-OF-CONS
+         [OUTSIDE]CLAUSE.NEGATIVE-TERMP-OF-LOGIC.FUNCTION-OF-NOT
+         LEMMA-7-FOR-RW.COMPILE-CREWRITE-IF-SPECIALCASE-SAME-TRACE
+         [OUTSIDE]MEMBERP-OF-CAR
+         RW.TRACE->RHS-UNDER-IFF
+         CONSP-OF-CONS
+         [OUTSIDE]LOGIC.FUNCTION-UNDER-IFF)
+
+(%create-theory splitting-used-rules)
+(%enable splitting-used-rules
+         (gather from actually-used-rules
+                  (not (clause.simple-termp rhs))))
+
+
+
+
+(%describe-theory splitting-used-rules)
+
+
+
+
+    (if (
+
+    (or theory
+        (cw "W
+         (rules    (rw.gather-rules-from-theory
+    (sort-symbols
+     (rw.rule-list-names
+      (rw.gather-rules-from-theory
+       (cdr (lookup 'splitting-used-rules (tactic.world->theories (tactic.harness->world (acl2::w acl2::state)))))
+       ''t
+       (tactic.world->syndefs (tactic.harness->world (acl2::w acl2::state)))
+       nil)))
+
+
+
+
+
+
+         (%autoadmit rw.compile-crewrite-if-generalcase-trace)
+
+         (local (%enable default rw.compile-crewrite-if-generalcase-trace))
+
+         (%autoprove rw.compile-crewrite-if-generalcase-trace-under-iff)
+
+
+
+         (ACL2::time$
+          (%autoprove logic.appealp-of-rw.compile-crewrite-if-generalcase-trace
+                      (%enable default
+                               expensive-term/formula-inference)
+                      (%disable default
+                                locally-useless-rules
+                                equal-of-booleans-rewrite
+                                logic.appeal-listp-when-not-consp
+                                LOGIC.FUNCTIONP-WHEN-NOT-OTHER-STUFF-CHEAP
+                                RW.TRACE-LIST-FORMULAS-WHEN-NOT-CONSP
+                                LEN-WHEN-NOT-CONSP
+                                LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                                FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                                iff)
+                      (%auto)
+                      (%enable default usual-consp-rules)))
+
+
+
+
+
+
+
+
+         (%auto)
+
+         (%splitlimit nil)
+         (%liftlimit nil)
+         (%auto :strategy (split cleanup urewrite))
+         (%crewrite default)
+
+         (%auto :strategy (split cleanup urewrite))
+
+         (%disable default usual-consp-rules)
+         (%crewrite default)
+
+
+
+
+         (%create-theory temp)
+         (%enable temp (gather from default (not (clause.simple-termp rhs))))
+         (%disable default temp)
+
+         (%auto :strategy (split cleanup urewrite))
+         (%crewrite default)
+
+         (%auto :strategy (split cleanup urewrite))
+         (%enable default temp)
+
+
+         (%crewrite default first)
+         (%crewrite default first)
+         (%crewrite default first)
+         (%crewrite default first)
+         (%crewrite default first)
+         (%crewrite default first)
+         (%crewrite default first)
+
+
+         (%splitlimit nil)
+         (%liftlimit nil)
+         (%auto :strategy (split cleanup urewrite))
+
+         (%profile)
+         (%crewrite default first)
+
+
+
+         (%enable default equal-of-booleans-rewrite iff)
+
+
+
+
+
+
+
+         (%auto)
+         (%enable default
+                  ;; really need eobr and iff?
+                  equal-of-booleans-rewrite
+                  iff
+                  usual-consp-rules)))
+
+
+
+
+
+
+
+(%profile)
+(%crewrite default)
+
+(encapsulate
+ ()
+ (local (%max-proof-size 800000000))
+ (%autoprove logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default)
+             (%auto :strategy (split cleanup urewrite))
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default expensive-term/formula-inference)
+             (%disable default locally-useless-rules)
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%enable default usual-consp-rules)
+             (%auto :strategy (split cleanup urewrite crewrite))))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 900000000))
+ (%autoprove logic.conclusion-of-rw.compile-crewrite-if-specialcase-same-trace
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default)
+             (%auto :strategy (split cleanup urewrite))
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default expensive-term/formula-inference)
+             (%disable default locally-useless-rules)
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%enable default usual-consp-rules)
+             (%auto :strategy (split cleanup urewrite crewrite))))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 1000000000))
+ (%autoprove logic.proofp-of-rw.compile-crewrite-if-specialcase-same-trace
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default expensive-term/formula-inference)
+             (%disable default locally-useless-rules)
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default usual-consp-rules)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))))
+
+
+
+
+
+
+(%autoadmit rw.compile-crewrite-if-specialcase-same-trace)
+
+(%autoprove rw.compile-crewrite-if-specialcase-same-trace-under-iff)
+
+(encapsulate
+ ()
+ (local (%max-proof-size 800000000))
+ (%autoprove logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default)
+             (%auto :strategy (split cleanup urewrite))
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default expensive-term/formula-inference)
+             (%disable default locally-useless-rules)
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%enable default usual-consp-rules)
+             (%auto :strategy (split cleanup urewrite crewrite))))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 900000000))
+ (%autoprove logic.conclusion-of-rw.compile-crewrite-if-specialcase-same-trace
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default)
+             (%auto :strategy (split cleanup urewrite))
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default expensive-term/formula-inference)
+             (%disable default locally-useless-rules)
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%enable default usual-consp-rules)
+             (%auto :strategy (split cleanup urewrite crewrite))))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 1000000000))
+ (%autoprove logic.proofp-of-rw.compile-crewrite-if-specialcase-same-trace
+             (%auto :strategy (split cleanup urewrite))
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default expensive-term/formula-inference)
+             (%disable default locally-useless-rules)
+             (%forcingp t)
+             (%crewrite default)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default usual-consp-rules)
+             (%forcingp nil)
+             (%auto :strategy (split cleanup urewrite crewrite))))
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/crewrite-recognizers.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/crewrite-recognizers.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/crewrite-recognizers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/crewrite-recognizers.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,88 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tracep")
+(%interactive)
+
+
+(%autoadmit rw.crewrite-if-specialcase-same-tracep)
+
+(%autoprove booleanp-of-rw.crewrite-if-specialcase-same-tracep
+            (%enable default rw.crewrite-if-specialcase-same-tracep))
+
+
+(%autoadmit rw.crewrite-if-generalcase-tracep)
+
+(%autoprove booleanp-of-rw.crewrite-if-generalcase-tracep
+            (%enable default rw.crewrite-if-generalcase-tracep))
+
+
+
+(%autoadmit rw.crewrite-rule-tracep)
+
+(%autoprove booleanp-of-rw.crewrite-rule-tracep
+            (%enable default rw.crewrite-rule-tracep))
+
+
+
+(%autoadmit rw.crewrite-rule-trace-env-okp)
+
+(%autoprove booleanp-of-rw.crewrite-rule-trace-env-okp
+            (%enable default rw.crewrite-rule-trace-env-okp))
+
+
+
+(%autoadmit rw.assumptions-tracep)
+
+(%autoprove booleanp-of-rw.assumptions-tracep
+            (%enable default rw.assumptions-tracep))
+
+
+
+(%autoadmit rw.force-tracep)
+
+(%autoprove booleanp-of-rw.force-tracep
+            (%enable default rw.force-tracep))
+
+
+
+(%autoadmit rw.weakening-tracep)
+
+(%autoprove booleanp-of-rw.weakening-tracep
+            (%enable default rw.weakening-tracep))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/crewrite-recognizers")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/crewrite-rule-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/crewrite-rule-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/crewrite-rule-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/crewrite-rule-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,217 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(local (%enable default rw.trace-conclusion-formula rw.trace-formula))
+
+(%autoprove logic.strip-function-names-of-rw.trace-list-conclusion-formulas-when-all-iffp
+            (%cdr-induction x)
+            (%restrict default rw.trace-list-conclusion-formulas (equal x 'x)))
+
+(%autoprove logic.strip-lens-of-logic.strip-function-args-of-rw.trace-list-conclusion-formulas
+            (%cdr-induction x)
+            (%restrict default rw.trace-list-conclusion-formulas (equal x 'x)))
+
+
+;; These have already been introduced
+;; (%deftheorem rw.crewrite-rule-lemma)
+;; (%defderiv rw.crewrite-rule-lemma-bldr :omit-okp t)
+;; (%defderiv rw.disjoined-crewrite-rule-lemma-bldr :omit-okp t)
+
+;; These have already been introduced
+;; (%autoadmit rw.crewrite-rule-lemma-list-bldr)
+;; (%autoprove forcing-logic.appeal-listp-of-rw.crewrite-rule-lemma-list-bldr)
+;; (%autoprove forcing-logic.strip-conclusions-of-rw.crewrite-rule-lemma-list-bldr)
+;; (%autoprove forcing-logic.proof-listp-of-rw.crewrite-rule-lemma-list-bldr)
+
+(%autoprove len-of-rw.crewrite-rule-lemma-list-bldr
+            (%cdr-induction x)
+            (%restrict default rw.crewrite-rule-lemma-list-bldr (equal x 'x)))
+
+;; These has already been introduced
+;; (%autoadmit rw.disjoined-crewrite-rule-lemma-list-bldr)
+;; (%autoprove forcing-logic.appeal-listp-of-rw.disjoined-crewrite-rule-lemma-list-bldr)
+;; (%autoprove forcing-logic.strip-conclusions-of-rw.disjoined-crewrite-rule-lemma-list-bldr)
+;; (%autoprove forcing-logic.proof-listp-of-rw.disjoined-crewrite-rule-lemma-list-bldr)
+
+(%autoprove len-of-rw.disjoined-crewrite-rule-lemma-list-bldr
+            (%cdr-induction x)
+            (%restrict default rw.disjoined-crewrite-rule-lemma-list-bldr (equal x 'x)))
+
+;; These have already been introduced
+;; (%autoadmit rw.compile-crewrite-rule-trace-lemma1)
+;; (%autoprove logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1)
+;; (%autoprove logic.conclusion-of-rw.compile-crewrite-rule-trace-lemma1)
+;; (%autoprove logic.proofp-of-rw.compile-crewrite-rule-trace-lemma1)
+
+;; These have already been introduced
+;; (%autoadmit rw.compile-crewrite-rule-trace-lemma2)
+;; (%autoprove forcing-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma2)
+;; (%autoprove forcing-logic.conclusion-of-rw.compile-crewrite-rule-trace-lemma2)
+;; (%autoprove forcing-logic.proofp-of-rw.compile-crewrite-rule-trace-lemma2)
+
+
+
+(%autoadmit rw.compile-crewrite-rule-trace)
+
+(local (%enable default
+                rw.compile-crewrite-rule-trace
+                rw.crewrite-rule-tracep))
+
+(%autoprove lemma-1-for-rw.compile-crewrite-rule-trace)
+(%autoprove lemma-2-for-rw.compile-crewrite-rule-trace)
+(%autoprove lemma-3-for-rw.compile-crewrite-rule-trace)
+(%autoprove lemma-4-for-rw.compile-crewrite-rule-trace)
+(%autoprove lemma-5-for-rw.compile-crewrite-rule-trace
+            (%fertilize (logic.strip-conclusions proofs) (rw.trace-list-conclusion-formulas subtraces)))
+(%autoprove lemma-6-for-rw.compile-crewrite-rule-trace
+            (%fertilize (logic.strip-conclusions proofs) (rw.trace-list-conclusion-formulas subtraces)))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 unusual-consp-rules
+                 expensive-term/formula-inference
+                 ))
+
+(local (%enable default
+                lemma-1-for-rw.compile-crewrite-rule-trace
+                lemma-2-for-rw.compile-crewrite-rule-trace
+                lemma-3-for-rw.compile-crewrite-rule-trace
+                lemma-4-for-rw.compile-crewrite-rule-trace
+                lemma-5-for-rw.compile-crewrite-rule-trace
+                lemma-6-for-rw.compile-crewrite-rule-trace))
+
+(%autoprove rw.compile-crewrite-rule-trace-under-iff)
+
+;; Speed hint from profile.
+(local (%disable default
+                 CONSP-WHEN-MEMBERP-OF-LOGIC.SIGMAP
+                 CONSP-WHEN-MEMBERP-OF-LOGIC.SIGMA-ATBLP
+                 MEMBERP-WHEN-NOT-CONSP
+                 MEMBERP-OF-CAR-WHEN-MEMBER-OF-NONEP
+                 CDR-WHEN-NOT-CONSP CAR-WHEN-NOT-CONSP
+                 MEMBERP-WHEN-MEMBERP-OF-CDR
+                 MEMBER-OF-NONEP-WHEN-NOT-CONSP
+                 MEMBER-OF-NONEP-OF-CDR-WHEN-MEMBER-OF-NONEP
+                 LOOKUP-WHEN-NOT-CONSP
+                 TRUE-LISTP-OF-CAR-WHEN-TRUE-LIST-LISTP
+                 TRUE-LISTP-WHEN-NOT-CONSP
+                 LOGIC.SUBSTITUTE-WHEN-LOGIC.VARIABLEP
+                 SUBMAPP-WHEN-UNIQUE-DOMAINS-AND-SUBSETP
+                 LOOKUP-WHEN-LOOKUP-IN-SUBMAPP-ONE
+                 LOGIC.POR-LIST-WHEN-NOT-CONSP-TWO
+                 LOGIC.VARIABLEP-WHEN-LOOKUP-IN-LOGIC.SIGMAP
+                 ALL-EQUALP-OF-SUBSETP-WHEN-ALL-EQUALP
+                 DOMAIN-WHEN-NOT-CONSP
+                 FORCING-LOGIC.SUBSTITUTE-OF-EMPTY-SIGMA
+                 RW.HYP-LIST-TERMS-WHEN-NOT-CONSP
+                 TRUE-LIST-LISTP-OF-CDR-WHEN-TRUE-LIST-LISTP
+                 TRUE-LIST-LISTP-WHEN-NOT-CONSP
+                 LOGIC.VRHSES-WHEN-NOT-CONSP
+                 LOGIC.=LHSES-WHEN-NOT-CONSP
+                 LOGIC.SUBSTITUTE-LIST-WHEN-NOT-CONSP
+                 UNIQUEP-WHEN-NOT-CONSP
+                 LOGIC.VARIABLEP-WHEN-LOOKUP-IN-LOGIC.SIGMA-ATBLP
+                 SUBMAPP-OF-CAR-WHEN-SUBMAP-OF-EACHP
+                 LOGIC.STRIP-FUNCTION-ARGS-WHEN-NOT-CONSP
+                 SUBMAP-OF-EACHP-WHEN-NOT-CONSP
+                 EQUAL-OF-BOOLEANS-REWRITE
+                 RW.RULEP-OF-CAR-WHEN-RW.RULE-LISTP
+                 TUPLEP-WHEN-NOT-CONSP
+                 RW.RULE-LISTP-WHEN-NOT-CONSP
+                 LOGIC.VLHSES-WHEN-NOT-CONSP
+                 FORCING-LOGIC.SUBSTITUTE-LIST-OF-EMPTY-SIGMA
+                 SUBMAP-OF-EACHP-OF-CDR-WHEN-SUBMAP-OF-EACHP
+                 LOGIC.SIGMA-LISTP-WHEN-NOT-CONSP
+                 LOGIC.ALL-DISJUNCTIONSP-WHEN-NOT-CONSP
+                 STRIP-FIRSTS-WHEN-NOT-CONSP
+                 LEN-WHEN-NOT-CONSP-OF-CDR-CHEAP
+                 LOGIC.SIGMAP-WHEN-NOT-CONSP
+                 STRIP-SECONDS-WHEN-NOT-CONSP
+                 SUBSETP-WHEN-NOT-CONSP
+                 LOGIC.SIGMAP-OF-CAR-WHEN-LOGIC.SIGMA-LISTP
+                 LOGIC.=RHSES-WHEN-NOT-CONSP
+                 RW.RULE-ATBLP-OF-CAR-WHEN-RW.RULE-LIST-ATBLP
+                 RW.RULE-ENV-OKP-OF-CAR-WHEN-RW.RULE-LIST-ENV-OKP
+                 SUBSETP-WHEN-NOT-CONSP-TWO
+                 RW.RULE-LIST-ATBLP-WHEN-NOT-CONSP
+                 RW.RULE-LIST-ENV-OKP-WHEN-NOT-CONSP
+                 LOGIC.SIGMA-LIST-ATBLP-WHEN-NOT-CONSP
+                 LOGIC.SIGMAP-OF-SECOND-WHEN-LOGIC.SIGMA-LISTP
+                 LOGIC.SIGMA-ATBLP-WHEN-NOT-CONSP
+                 LOGIC.SIGMA-ATBLP-OF-CAR-WHEN-LOGIC.SIGMA-LIST-ATBLP
+                 STRIP-LENS-WHEN-NOT-CONSP
+                 LOGIC.STRIP-FUNCTION-NAMES-WHEN-NOT-CONSP
+                 LOGIC.ALL-FUNCTIONSP-WHEN-NOT-CONSP
+                 LOGIC.ALL-ATOMICP-WHEN-NOT-CONSP
+                 LOGIC.SIGMA-ATBLP-OF-SECOND-WHEN-LOGIC.SIGMA-LIST-ATBLP
+                 LOGIC.SUBSTITUTE-WHEN-LOGIC.FUNCTIONP-CHEAP
+                 RW.TRACE-LIST-CONCLUSION-FORMULAS-WHEN-NOT-CONSP
+                 LOGIC.POR-LIST-WHEN-NOT-CONSP-ONE
+                 LOGIC.SUBSTITUTE-WHEN-LOGIC.LAMBDAP-CHEAP
+                 LOGIC.SUBSTITUTE-WHEN-LOGIC.CONSTANTP
+                 LOGIC.SUBSTITUTE-WHEN-MALFORMED-CHEAP
+                 LEN-WHEN-NOT-CONSP
+                 FORCING-LOGIC.FUNCTIONP-WHEN-LOGIC.BASE-EVALUABLEP
+                 LOGIC.SUBSTITUTE-LIST-OF-CONS-GROSS
+                 UNIQUEP-WHEN-UNIQUEP-OF-DOMAIN
+                 TUPLEP-WHEN-ZP
+                 LOGIC.SIGMA-LISTP-OF-CDR-WHEN-LOGIC.SIGMA-LISTP
+                 LOGIC.SIGMA-LIST-ATBLP-OF-CDR-WHEN-LOGIC.SIGMA-LIST-ATBLP
+                 LOGIC.SIGMA-ATBLP-OF-CONS-GROSS))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 650000000))
+ (%autoprove forcing-logic.appealp-of-rw.compile-crewrite-rule-trace))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 1300000000))
+ (%autoprove forcing-logic.conclusion-of-rw.compile-crewrite-rule-trace))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 1400000000))
+ (%autoprove forcing-logic.proofp-of-rw.compile-crewrite-rule-trace
+             (%enable default rw.crewrite-rule-trace-env-okp)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/definitions.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/definitions.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/definitions.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/definitions.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,105 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit definitionp)
+
+(%autoprove booleanp-of-definitionp
+            (%enable default definitionp))
+
+(%autoprove logic.formulap-when-definitionp
+            (%enable default definitionp))
+
+(%autoprove logic.fmtype-when-definitionp
+            (%enable default definitionp))
+
+(%autoprove logic.functionp-of-logic.=lhs-when-definitionp
+            (%enable default definitionp))
+
+(%autoprove logic.variable-listp-of-logic.function-args-of-logic.=lhs-when-definitionp
+            (%enable default definitionp))
+
+(%autoprove uniquep-of-logic.function-args-of-logic.=lhs-when-definitionp
+            (%enable default definitionp))
+
+(%autoprove subsetp-of-logic.term-vars-of-logic.=rhs-when-definitionp
+            (%enable default definitionp))
+
+
+
+(%deflist definition-listp (x)
+          (definitionp x))
+
+(%autoprove logic.formula-listp-when-definition-listp
+            (%cdr-induction x))
+
+
+
+(%autoadmit definition-list-lookup)
+
+(%autoprove definition-list-lookup-when-not-consp
+            (%restrict default definition-list-lookup (equal x 'x)))
+
+(%autoprove definition-list-lookup-of-cons
+            (%restrict default definition-list-lookup (equal x '(cons a x))))
+
+(%autoprove definitionp-of-definition-list-lookup
+            (%cdr-induction x))
+
+(%autoprove logic.formula-atblp-of-definition-list-lookup
+            (%cdr-induction x))
+
+(%autoprove memberp-of-definition-list-lookup
+            (%cdr-induction defs))
+
+(%autoprove forcing-logic.fmtype-of-definition-list-lookup)
+
+(%autoprove forcing-logic.function-name-of-logic.=lhs-of-definition-list-lookup
+            (%cdr-induction defs))
+
+(%autoprove forcing-logic.functionp-of-logic.=lhs-of-definition-list-lookup
+            (%cdr-induction defs))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/definitions")
+
+
+
+(%enable expensive-term/formula-inference
+         logic.formulap-when-definitionp
+         logic.formula-listp-when-definition-listp
+         logic.functionp-of-logic.=lhs-when-definitionp
+         logic.fmtype-when-definitionp)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/equiv-by-args-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/equiv-by-args-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/equiv-by-args-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/equiv-by-args-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,115 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(defthm equal-of-cons-and-repeat
+  ;; BOZO a nice and useful rule in need of a good home
+  (equal (equal (cons a x)
+                (repeat b n))
+         (and (not (zp n))
+              (equal a b)
+              (equal x (repeat b (- n 1))))))
+
+(%autoprove equal-of-cons-and-repeat
+            (%autoinduct repeat b n)
+            (%restrict default repeat (equal n 'n)))
+
+
+(%autoadmit rw.compile-equiv-by-args-trace)
+
+(local (%enable default
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                rw.equiv-by-args-tracep
+                rw.compile-equiv-by-args-trace))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition))
+
+(%autoprove rw.compile-equiv-by-args-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-equiv-by-args-trace)
+
+(%autoprove lemma-for-logic.conclusion-of-rw.compile-equiv-by-args-trace
+            (%enable default logic.function-name logic.function-args))
+
+(local (%enable default lemma-for-logic.conclusion-of-rw.compile-equiv-by-args-trace))
+
+(%autoprove logic.conclusion-of-rw.compile-equiv-by-args-trace
+            (%auto)
+            (%enable default
+                     type-set-like-rules
+                     formula-decomposition
+                     expensive-arithmetic-rules-two)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots
+                      equal-of-logic.function-rewrite
+                      equal-of-logic.function-rewrite-alt))
+
+(%autoprove lemma-1-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+            (%disable default
+                      len-of-rw.trace-list-conclusion-formulas
+                      [outside]len-of-rw.trace-list-conclusion-formulas)
+            (%use (%instance (%thm len-of-rw.trace-list-conclusion-formulas)
+                             (x (rw.trace->subtraces x)))))
+
+(%autoprove lemma-2-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+            (%disable default
+                      len-of-rw.trace-list-conclusion-formulas
+                      [outside]len-of-rw.trace-list-conclusion-formulas)
+            (%use (%instance (%thm len-of-rw.trace-list-conclusion-formulas)
+                             (x (rw.trace->subtraces x)))))
+
+(%autoprove lemma-3-for-logic.proofp-of-rw.compile-equiv-by-args-trace)
+
+(%autoprove logic.proofp-of-rw.compile-equiv-by-args-trace
+            (%enable default
+                            lemma-1-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+                            lemma-2-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+                            lemma-3-for-logic.proofp-of-rw.compile-equiv-by-args-trace)
+            (%auto)
+            (%enable default
+                     type-set-like-rules
+                     expensive-arithmetic-rules-two))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/evaluator-bldr-2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/evaluator-bldr-2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/evaluator-bldr-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/evaluator-bldr-2.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,99 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "evaluator-bldr")
+(%interactive)
+
+(local (%enable default lemma-2-for-forcing-logic.appealp-of-generic-evaluator-bldr))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 600000000))
+ (%autoprove lemma-for-forcing-logic.proofp-of-generic-evaluator-bldr
+             (%flag-generic-evaluator-induction flag x defs n)
+             (%disable default
+                       formula-decomposition
+                       expensive-term/formula-inference
+                       expensive-arithmetic-rules
+                       expensive-arithmetic-rules-two
+                       expensive-subsetp-rules
+                       type-set-like-rules
+                       forcing-logic.function-of-logic.function-name-and-logic.function-args
+                       forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                       forcing-lookup-of-logic.function-name
+                       same-length-prefixes-equal-cheap
+                       definitionp-when-memberp-of-definition-listp
+                       definition-list-lookup-when-not-consp)
+             (%auto :strategy (split urewrite))
+             (%forcingp nil)
+             (%crewrite default)
+             (%restrict default definition-of-generic-evaluator (equal x 'x))
+             (%restrict default definition-of-generic-evaluator-bldr (equal x 'x))
+             (%restrict default definition-of-generic-evaluator-list (equal x 'x))
+             (%restrict default definition-of-generic-evaluator-list-bldr (equal x 'x))
+             (%auto :strategy (split urewrite))
+             (%crewrite default)
+             (%forcingp t)
+             (%enable default
+                      formula-decomposition
+                      expensive-term/formula-inference
+                      type-set-like-rules
+                      forcing-lookup-of-logic.function-name)
+             (%disable default
+                       logic.termp-when-logic.formulap
+                       logic.termp-when-invalid-maybe-expensive
+                       logic.formulap-when-logic.termp
+                       logic.formula-listp-when-definition-listp
+                       consp-when-logic.lambdap-cheap
+                       consp-when-logic.functionp-cheap
+                       consp-of-car-when-none-consp
+                       consp-of-car-when-cons-listp
+                       logic.substitute-when-malformed-cheap
+                       logic.lambdap-when-not-anything-else-maybe-expensive)
+             (%cheapen default
+                       logic.substitute-when-logic.constantp
+                       logic.substitute-when-logic.variablep
+                       logic.constantp-when-logic.variablep
+                       logic.variablep-when-logic.constantp
+                       logic.constantp-when-logic.functionp)
+             (%auto :strategy (split cleanup urewrite crewrite elim))))
+
+(%autoprove forcing-logic.proofp-of-generic-evaluator-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-generic-evaluator-bldr)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.proof-listp-of-generic-evaluator-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-generic-evaluator-bldr)
+                             (flag 'list))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/evaluator-bldr.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/evaluator-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/evaluator-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/evaluator-bldr.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,173 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "evaluator")
+(%interactive)
+
+(%autoadmit flag-generic-evaluator-bldr)
+(%autoadmit generic-evaluator-bldr)
+(%autoadmit generic-evaluator-list-bldr)
+
+(%autoprove definition-of-generic-evaluator-bldr
+            (%enable default generic-evaluator-bldr generic-evaluator-list-bldr)
+            (%restrict default flag-generic-evaluator-bldr (equal x 'x)))
+
+(%autoprove definition-of-generic-evaluator-list-bldr
+            (%enable default generic-evaluator-bldr generic-evaluator-list-bldr)
+            (%restrict default flag-generic-evaluator-bldr (equal x 'x)))
+
+(%autoprove flag-generic-evaluator-bldr-of-term
+            (%enable default generic-evaluator-bldr))
+
+(%autoprove flag-generic-evaluator-bldr-of-list
+            (%enable default generic-evaluator-list-bldr))
+
+(%autoprove forcing-len-of-cdr-of-generic-evaluator-list-bldr
+            (%cdr-induction x)
+            (%restrict default definition-of-generic-evaluator-list-bldr (equal x 'x)))
+
+
+
+(defthmd lemma-2-for-forcing-logic.appealp-of-generic-evaluator-bldr
+  ;; BOZO called "crock" and local in the other file.
+  (implies (submapp (logic.initial-arity-table) atbl)
+           (equal (lookup 'if atbl)
+                  '(if . 3)))
+  :hints(("Goal"
+          :in-theory (enable logic.initial-arity-table)
+          :use ((:instance equal-of-lookups-when-submapp
+                           (x (logic.initial-arity-table))
+                           (y atbl)
+                           (a 'if))))))
+
+(%autoprove lemma-2-for-forcing-logic.appealp-of-generic-evaluator-bldr
+            (%enable default logic.initial-arity-table)
+            (%use (%instance (%thm equal-of-lookups-when-submapp)
+                           (x (logic.initial-arity-table))
+                           (y atbl)
+                           (a 'if))))
+
+(local (%enable default lemma-2-for-forcing-logic.appealp-of-generic-evaluator-bldr))
+
+
+
+
+
+(encapsulate
+ ()
+ (local (%max-proof-size 1200000000))
+ (%autoprove lemma-for-forcing-logic.appealp-of-generic-evaluator-bldr
+             ;; This is a particularly difficult proof because of the complexity
+             ;; of the induction scheme and the number of cases involved when we
+             ;; open up the functions.  Our approach is not very complicated --
+             ;; we basically try to solve as much as we can "on the cheap" by
+             ;; only using urewrite and very limited crewriting.  Only after the
+             ;; big mess is made do we cheaply
+             (%flag-generic-evaluator-induction flag x defs n)
+             (%disable default
+                       formula-decomposition
+                       expensive-term/formula-inference
+                       expensive-arithmetic-rules
+                       expensive-arithmetic-rules-two
+                       expensive-subsetp-rules
+                       type-set-like-rules
+                       forcing-logic.function-of-logic.function-name-and-logic.function-args
+                       forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                       forcing-lookup-of-logic.function-name
+                       same-length-prefixes-equal-cheap
+                       definitionp-when-memberp-of-definition-listp
+                       definition-list-lookup-when-not-consp)
+             (%auto :strategy (split urewrite))
+             (%forcingp nil)
+             (%crewrite default)
+             (%restrict default definition-of-generic-evaluator (equal x 'x))
+             (%restrict default definition-of-generic-evaluator-bldr (equal x 'x))
+             (%restrict default definition-of-generic-evaluator-list (equal x 'x))
+             (%restrict default definition-of-generic-evaluator-list-bldr (equal x 'x))
+             (%auto :strategy (split urewrite))
+             (%crewrite default)
+             (%forcingp t)
+             (%enable default
+                      formula-decomposition
+                      expensive-term/formula-inference
+                      type-set-like-rules)
+             (%disable default
+                       logic.termp-when-logic.formulap
+                       logic.termp-when-invalid-maybe-expensive
+                       logic.formulap-when-logic.termp
+                       logic.formula-listp-when-definition-listp
+                       consp-when-logic.lambdap-cheap
+                       consp-when-logic.functionp-cheap
+                       consp-of-car-when-none-consp
+                       consp-of-car-when-cons-listp
+                       logic.substitute-when-malformed-cheap
+                       logic.lambdap-when-not-anything-else-maybe-expensive)
+             (%cheapen default
+                       logic.substitute-when-logic.constantp
+                       logic.substitute-when-logic.variablep
+                       logic.constantp-when-logic.variablep
+                       logic.variablep-when-logic.constantp
+                       logic.constantp-when-logic.functionp)
+             (%auto :strategy (split cleanup urewrite crewrite elim))))
+
+(%autoprove forcing-logic.appealp-of-generic-evaluator-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-generic-evaluator-bldr)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.conclusion-of-generic-evaluator-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-generic-evaluator-bldr)
+                             (flag 'term))))
+
+(%autoprove forcing-consp-of-generic-evaluator-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-generic-evaluator-bldr)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.appeal-listp-of-generic-evaluator-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-generic-evaluator-bldr)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.strip-conclusions-of-generic-evaluator-list-bldr
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-generic-evaluator-bldr)
+                             (flag 'list))))
+
+(%autoprove forcing-generic-evaluator-bldr-under-iff
+            (%disable default forcing-logic.appealp-of-generic-evaluator-bldr)
+            (%use (%instance (%thm forcing-logic.appealp-of-generic-evaluator-bldr))))
+
+(%autoprove forcing-generic-evaluator-list-bldr-under-iff
+            (%disable default forcing-consp-of-generic-evaluator-list-bldr)
+            (%use (%instance (%thm forcing-consp-of-generic-evaluator-list-bldr))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/evaluator.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/evaluator.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,428 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "definitions")
+(%interactive)
+
+
+(%autoadmit flag-generic-evaluator)
+(%autoadmit generic-evaluator)
+(%autoadmit generic-evaluator-list)
+
+(%autoprove definition-of-generic-evaluator
+            (%enable default generic-evaluator generic-evaluator-list)
+            (%restrict default flag-generic-evaluator (equal x 'x)))
+
+(%autoprove definition-of-generic-evaluator-list
+            (%enable default generic-evaluator generic-evaluator-list)
+            (%restrict default flag-generic-evaluator (equal x 'x)))
+
+(%autoprove flag-generic-evaluator-when-term
+            (%enable default generic-evaluator))
+
+(%autoprove flag-generic-evaluator-when-list
+            (%enable default generic-evaluator-list))
+
+(%autoprove generic-evaluator-list-when-not-consp
+            (%restrict default definition-of-generic-evaluator-list (equal x 'x)))
+
+(%autoprove generic-evaluator-list-of-cons
+            (%restrict default definition-of-generic-evaluator-list (equal x '(cons a x))))
+
+(%autoprove true-listp-of-generic-evaluator-list
+            (%cdr-induction x))
+
+(%autoprove forcing-len-of-cdr-of-generic-evaluator-list
+            (%cdr-induction x))
+
+(%autoprove consp-of-generic-evaluator-list
+            (%cdr-induction x))
+
+
+
+(defmacro %flag-generic-evaluator-induction (flag x defs n)
+  `(%induct (two-nats-measure ,n (rank ,x))
+
+            ((and (equal ,flag 'term)
+                  (zp ,n))
+             nil)
+
+            ((and (equal ,flag 'term)
+                  (not (zp ,n))
+                  (logic.functionp ,x)
+                  (equal (logic.function-name ,x) 'if)
+                  (equal (len (logic.function-args ,x)) '3))
+             (((,flag 'term) (,x (first (logic.function-args ,x))))
+              ((,flag 'term) (,x (second (logic.function-args ,x))))
+              ((,flag 'term) (,x (third (logic.function-args ,x))))))
+
+             ((and (equal ,flag 'term)
+                   (not (zp ,n))
+                   (logic.functionp ,x)
+                   (not (and (equal (logic.function-name ,x) 'if)
+                             (equal (len (logic.function-args ,x)) '3))))
+              (((,flag 'list) (,x (logic.function-args ,x)))
+               ((,flag 'term)
+                (x
+                 (logic.substitute
+                  (logic.=rhs (definition-list-lookup (logic.function-name ,x) ,defs))
+                  (pair-lists
+                   (logic.function-args
+                    (logic.=lhs (definition-list-lookup (logic.function-name ,x) ,defs)))
+                   (cdr (flag-generic-evaluator 'list
+                                                (logic.function-args ,x)
+                                                ,defs ,n)))))
+                (,n (- ,n '1)))))
+
+             ((and (equal ,flag 'term)
+                   (not (zp ,n))
+                   (logic.lambdap ,x))
+              (((,flag 'list) (,x (logic.lambda-actuals ,x)))
+               ((,flag 'term)
+                (,x (logic.substitute
+                    (logic.lambda-body ,x)
+                    (pair-lists (logic.lambda-formals ,x)
+                                (cdr (flag-generic-evaluator 'list
+                                                             (logic.lambda-actuals ,x)
+                                                             ,defs ,n)))))
+                (,n (- ,n '1)))))
+
+             ((and (equal ,flag 'term)
+                   (not (zp ,n))
+                   (not (logic.functionp ,x))
+                   (not (logic.lambdap ,x)))
+              nil)
+
+             ((and (not (equal ,flag 'term))
+                   (consp ,x))
+              (((,flag 'term) (,x (car ,x)))
+               ((,flag 'list) (,x (cdr ,x)))))
+
+             ((and (not (equal ,flag 'term))
+                   (not (consp ,x)))
+              nil)))
+
+;; (defmacro %flag-generic-evaluator-induction (flag x defs n)
+;;   `(%induct (two-nats-measure ,n (rank ,x))
+;;             ((and (equal ,flag 'term)
+;;                   (zp ,n))
+;;              nil)
+;;             ((and (equal ,flag 'term)
+;;                   (not (zp ,n))
+;;                   (logic.constantp ,x))
+;;              nil)
+;;             ((and (equal ,flag 'term)
+;;                   (not (zp ,n))
+;;                   (logic.variablep ,x))
+;;              nil)
+;;             ((and (equal ,flag 'term)
+;;                   (not (zp ,n))
+;;                   (logic.functionp ,x)
+;;                   (equal (logic.function-name ,x) 'if)
+;;                   (equal (len (logic.function-args ,x)) '3))
+;;              (((,flag 'term) (,x (first (logic.function-args ,x))))
+;;               ((,flag 'term) (,x (second (logic.function-args ,x))))
+;;               ((,flag 'term) (,x (third (logic.function-args ,x))))))
+;;              ((and (equal ,flag 'term)
+;;                    (not (zp ,n))
+;;                    (logic.functionp ,x)
+;;                    (not (and (equal (logic.function-name ,x) 'if)
+;;                              (equal (len (logic.function-args ,x)) '3))))
+;;               (((,flag 'list) (,x (logic.function-args ,x)))
+;;                ((,flag 'term)
+;;                 (x
+;;                  (logic.substitute
+;;                   (logic.=rhs (definition-list-lookup (logic.function-name ,x) ,defs))
+;;                   (pair-lists
+;;                    (logic.function-args
+;;                     (logic.=lhs (definition-list-lookup (logic.function-name ,x) ,defs)))
+;;                    (cdr (flag-generic-evaluator 'list
+;;                                                 (logic.function-args ,x)
+;;                                                 ,defs ,n)))))
+;;                 (,n (- ,n '1)))))
+;;              ((and (equal ,flag 'term)
+;;                    (not (zp ,n))
+;;                    (logic.lambdap ,x))
+;;               (((,flag 'list) (,x (logic.lambda-actuals ,x)))
+;;                ((,flag 'term)
+;;                 (,x (logic.substitute
+;;                     (logic.lambda-body ,x)
+;;                     (pair-lists (logic.lambda-formals ,x)
+;;                                 (cdr (flag-generic-evaluator 'list
+;;                                                              (logic.lambda-actuals ,x)
+;;                                                              ,defs ,n)))))
+;;                 (,n (- ,n '1)))))
+;;              ((and (equal ,flag 'term)
+;;                    (not (zp ,n))
+;;                    (not (logic.constantp ,x))
+;;                    (not (logic.variablep ,x))
+;;                    (not (logic.functionp ,x))
+;;                    (not (logic.lambdap ,x)))
+;;               nil)
+;;              ((and (not (equal ,flag 'term))
+;;                    (consp ,x))
+;;               (((,flag 'term) (,x (car ,x)))
+;;                ((,flag 'list) (,x (cdr ,x)))))
+;;              ((and (not (equal ,flag 'term))
+;;                    (not (consp ,x)))
+;;               nil)))
+
+;; (defthmd open-generic-evaluator-when-zp
+;;   (implies (and (syntaxp (equal x 'x))
+;;                 (zp n))
+;;            (equal (generic-evaluator x defs n)
+;;                   nil))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable definition-of-generic-evaluator))))
+
+;; (defthmd open-generic-evaluator-when-logic.constantp
+;;   (implies (and (syntaxp (equal x 'x))
+;;                 (not (zp n))
+;;                 (logic.constantp x))
+;;            (equal (generic-evaluator x defs n)
+;;                   x))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable definition-of-generic-evaluator))))
+
+;; (defthmd open-generic-evaluator-when-logic.variablep
+;;   (implies (and (syntaxp (equal x 'x))
+;;                 (logic.variablep x))
+;;            (equal (generic-evaluator x defs n)
+;;                   nil))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable definition-of-generic-evaluator))))
+
+;; (defthmd open-generic-evaluator-when-if
+;;   (implies (and (syntaxp (equal x 'x))
+;;                 (not (zp n))
+;;                 (logic.functionp x)
+;;                 (equal (logic.function-name x) 'if)
+;;                 (equal (len (logic.function-args x)) 3))
+;;            (equal (generic-evaluator x defs n)
+;;                   (let* ((args (logic.function-args x))
+;;                          (eval-test (generic-evaluator (first args) defs n)))
+;;                     (and eval-test
+;;                          (if (logic.unquote eval-test)
+;;                              (generic-evaluator (second args) defs n)
+;;                            (generic-evaluator (third args) defs n))))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (e/d (definition-of-generic-evaluator)
+;;                                  ((:executable-counterpart ACL2::force))))))
+
+;; (defthmd open-generic-evaluator-when-not-if
+;;   (implies (and (syntaxp (equal x 'x))
+;;                 (not (zp n))
+;;                 (logic.functionp x)
+;;                 (not (equal (logic.function-name x) 'if)))
+;;            (equal (generic-evaluator x defs n)
+;;                   (let* ((name (logic.function-name x))
+;;                          (args (logic.function-args x))
+;;                          (eval-args (generic-evaluator-list args defs n)))
+;;                     (and eval-args
+;;                          (let ((values (cdr eval-args)))
+;;                            (if (memberp name (domain (logic.initial-arity-table)))
+;;                                (and (equal (cdr (lookup name (logic.initial-arity-table))) (len values))
+;;                                     (logic.base-evaluator (logic.function name values)))
+;;                              (let* ((def (definition-list-lookup name defs)))
+;;                                (and def
+;;                                     (let ((formals (logic.function-args (logic.=lhs def)))
+;;                                           (body    (logic.=rhs def)))
+;;                                       (and (equal (len formals) (len values))
+;;                                            (generic-evaluator (logic.substitute body (pair-lists formals values))
+;;                                                               defs (- n 1))))))))))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (e/d (definition-of-generic-evaluator)
+;;                                  ((:executable-counterpart ACL2::force))))))
+
+;; (defthmd open-generic-evaluator-when-not-length-three
+;;   (implies (and (syntaxp (equal x 'x))
+;;                 (not (zp n))
+;;                 (logic.functionp x)
+;;                 (not (equal (len (logic.function-args x)) 3)))
+;;            (equal (generic-evaluator x defs n)
+;;                   (let* ((name (logic.function-name x))
+;;                          (args (logic.function-args x))
+;;                          (eval-args (generic-evaluator-list args defs n)))
+;;                     (and eval-args
+;;                          (let ((values (cdr eval-args)))
+;;                            (if (memberp name (domain (logic.initial-arity-table)))
+;;                                (and (equal (cdr (lookup name (logic.initial-arity-table))) (len values))
+;;                                     (logic.base-evaluator (logic.function name values)))
+;;                              (let* ((def (definition-list-lookup name defs)))
+;;                                (and def
+;;                                     (let ((formals (logic.function-args (logic.=lhs def)))
+;;                                           (body    (logic.=rhs def)))
+;;                                       (and (equal (len formals) (len values))
+;;                                            (generic-evaluator (logic.substitute body (pair-lists formals values))
+;;                                                               defs (- n 1))))))))))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal"
+;;           :expand (generic-evaluator x defs n)
+;;           :in-theory (e/d (definition-of-generic-evaluator)
+;;                           ((:executable-counterpart ACL2::force))))))
+
+;; (defthmd open-generic-evaluator-when-logic.lambdap
+;;   (implies (and (syntaxp (equal x 'x))
+;;                 (not (zp n))
+;;                 (logic.lambdap x))
+;;            (equal (generic-evaluator x defs n)
+;;                   (let ((formals (logic.lambda-formals x))
+;;                         (body    (logic.lambda-body x))
+;;                         (actuals (logic.lambda-actuals x)))
+;;                     (let ((eval-actuals (generic-evaluator-list actuals defs n)))
+;;                       (and eval-actuals
+;;                            (let ((values (cdr eval-actuals)))
+;;                              (generic-evaluator (logic.substitute body (pair-lists formals values))
+;;                                                 defs (- n 1))))))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (e/d (definition-of-generic-evaluator)
+;;                                  ((:executable-counterpart ACL2::force))))))
+
+;; (defthmd open-generic-evaluator-when-degenerate
+;;   (implies (and (syntaxp (equal x 'x))
+;;                 (not (logic.constantp x))
+;;                 (not (logic.variablep x))
+;;                 (not (logic.functionp x))
+;;                 (not (logic.lambdap x)))
+;;            (equal (generic-evaluator x defs n)
+;;                   nil))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable definition-of-generic-evaluator))))
+
+;; (deftheory open-generic-evaluator-theory
+;;   '(open-generic-evaluator-when-zp
+;;     open-generic-evaluator-when-logic.constantp
+;;     open-generic-evaluator-when-logic.variablep
+;;     open-generic-evaluator-when-if
+;;     open-generic-evaluator-when-not-if
+;;     open-generic-evaluator-when-not-length-three
+;;     open-generic-evaluator-when-logic.lambdap
+;;     open-generic-evaluator-when-degenerate))
+
+
+
+
+
+
+
+;; (%autoprove open-generic-evaluator-when-zp
+;;             (%restrict default definition-of-generic-evaluator (equal x 'x)))
+
+;; (%autoprove open-generic-evaluator-when-logic.constantp
+;;             (%restrict default definition-of-generic-evaluator (equal x 'x)))
+
+;; (%autoprove open-generic-evaluator-when-logic.variablep
+;;             (%restrict default definition-of-generic-evaluator (equal x 'x)))
+
+;; (%autoprove open-generic-evaluator-when-if
+;;             (%restrict default definition-of-generic-evaluator (equal x 'x)))
+
+;; (%autoprove open-generic-evaluator-when-not-if
+;;             (%restrict default definition-of-generic-evaluator (equal x 'x)))
+
+;; (%autoprove open-generic-evaluator-when-not-length-three
+;;             (%restrict default definition-of-generic-evaluator (equal x 'x)))
+
+;; (%autoprove open-generic-evaluator-when-logic.lambdap
+;;             (%restrict default definition-of-generic-evaluator (equal x 'x)))
+
+;; (%autoprove open-generic-evaluator-when-degenerate
+;;             (%restrict default definition-of-generic-evaluator (equal x 'x)))
+
+
+;; (%create-theory open-generic-evaluator-theory)
+;; (%enable open-generic-evaluator-theory
+;;          open-generic-evaluator-when-zp
+;;          open-generic-evaluator-when-logic.constantp
+;;          open-generic-evaluator-when-logic.variablep
+;;          open-generic-evaluator-when-if
+;;          open-generic-evaluator-when-not-if
+;;          open-generic-evaluator-when-not-length-three
+;;          open-generic-evaluator-when-logic.lambdap
+;;          open-generic-evaluator-when-degenerate)
+
+
+
+;; But I think it may be relevant to note that there wasn't much of a savings at all by
+;; using the opener theory instead of the definitions themselves.  With the original
+;; induction scheme, we're looking at 338K with openers versus 346K with restrict.
+;;
+;;  -  also consider consolidated induction schemes, and see if they are any use.
+;;     (they might work using the restrict style, even if they aren't suited for openers.)
+;;   -- Wow!  That reduced the proof to 110M conses.  And, the compiling time was only
+;;      a minute. (of course building the skeleton took longer than that).
+;;
+;;  -  also try opening the functions right away, not waiting for one pass of auto
+;;     to go first.  eeeeh, this seems bad.
+;;
+;;  - how about not forcing until we've issued the restrict hints?  hrmn, that seems to
+;;    be very slow during rewriting.  i got bored and didn't let it finish.
+
+;; 338K conses, 1306 seconds to compile.  damn.
+;; (%autoprove lemma-for-forcing-logic.constantp-of-cdr-of-generic-evaluator
+;;             (%flag-generic-evaluator-induction flag x defs n)
+;;             (%auto :strategy (cleanup split urewrite))
+;;             (%disable default  ;; speed hint
+;;                       logic.termp-when-logic.formulap
+;;                       logic.constantp-when-logic.variablep
+;;                       logic.variablep-when-logic.constantp
+;;                       logic.constantp-when-logic.functionp
+;;                       same-length-prefixes-equal-cheap
+;;                       not-equal-when-less
+;;                       not-equal-when-less-two)
+;;             (%crewrite default)
+;;             (%enable default open-generic-evaluator-theory))
+
+
+;; trying new induction scheme.
+;; orig scheme: 346k conses this way.  bleh.  but only 1134 seconds to compile.
+;; new scheme: way fewer initial goals (4500 vs 50k)
+
+;; also, consider not forcing until we open up the definitions?
+(%autoprove lemma-for-forcing-logic.constantp-of-cdr-of-generic-evaluator
+            (%flag-generic-evaluator-induction flag x defs n)
+            (%auto)
+            (%restrict default definition-of-generic-evaluator (equal x 'x))
+            (%restrict default definition-of-generic-evaluator-list (equal x 'x))
+            (%auto :steps 90))
+
+
+(%autoprove forcing-logic.constantp-of-cdr-of-generic-evaluator
+            (%use (%instance (%thm lemma-for-forcing-logic.constantp-of-cdr-of-generic-evaluator)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.constant-listp-of-cdr-of-generic-evaluator-list
+            (%use (%instance (%thm lemma-for-forcing-logic.constantp-of-cdr-of-generic-evaluator)
+                             (flag 'list))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/fail-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/fail-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/fail-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/fail-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,57 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-fail-trace)
+
+(local (%enable default
+                rw.fail-tracep
+                rw.compile-fail-trace
+                rw.trace-conclusion-formula
+                rw.trace-formula))
+
+(%autoprove rw.compile-fail-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-fail-trace)
+
+(%autoprove logic.conclusion-of-rw.compile-fail-trace)
+
+(%autoprove logic.proofp-of-rw.compile-fail-trace)
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/force-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/force-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/force-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/force-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,52 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-force-trace)
+
+(local (%enable default
+                rw.force-tracep
+                rw.compile-force-trace))
+
+(%autoprove rw.compile-force-trace-under-iff)
+
+(%autoprove forcing-logic.appealp-of-rw.compile-force-trace)
+
+(%autoprove forcing-logic.conclusion-of-rw.compile-force-trace)
+
+(%autoprove forcing-logic.proofp-of-rw.compile-force-trace)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/ground-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/ground-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/ground-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/ground-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,58 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-ground-trace)
+
+(local (%enable default
+                rw.ground-tracep
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                rw.compile-ground-trace
+                theorem-iff-t-when-not-nil))
+
+(%autoprove lemma-for-rw.compile-ground-trace)
+(local (%enable default lemma-for-rw.compile-ground-trace))
+
+(%autoprove rw.compile-ground-trace-under-iff)
+
+(%autoprove forcing-logic.appealp-of-rw.compile-ground-trace)
+
+(%autoprove forcing-logic.conclusion-of-rw.compile-ground-trace)
+
+(%autoprove forcing-logic.proofp-of-rw.compile-ground-trace)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/if-specialcase-nil-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/if-specialcase-nil-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/if-specialcase-nil-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/if-specialcase-nil-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,177 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+
+;; BOZO this is local in clean-clauses.lisp.  Consider making this a disabled
+;; rule that lives in utilities, and enabling it when we want.  Also consider
+;; adding the alt-version in utilities.
+
+(defthmd split-up-list-of-quoted-nil
+  (equal (equal x '('nil))
+         (and (consp x)
+              (equal (car x) ''nil)
+              (not (cdr x)))))
+
+(defthmd split-up-list-of-quoted-nil-alt
+  (equal (equal '('nil) x)
+         (and (consp x)
+              (equal (car x) ''nil)
+              (not (cdr x)))))
+
+(%autoprove split-up-list-of-quoted-nil)
+(%autoprove split-up-list-of-quoted-nil-alt)
+
+(%enable default
+         split-up-list-of-quoted-nil
+         split-up-list-of-quoted-nil-alt)
+
+
+
+(local (%splitlimit 20)) ;; BOZO Consider this globally at this level
+
+(%autoadmit rw.compile-if-specialcase-nil-trace)
+
+(local (%enable default
+                rw.if-specialcase-nil-tracep
+                rw.compile-if-specialcase-nil-trace
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                equal-of-2-and-len))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 unusual-consp-rules
+                 expensive-term/formula-inference))
+
+(local (%disable default
+                 logic.appealp-of-car-when-logic.appeal-listp
+                 logic.appealp-of-second-when-logic.appeal-listp
+                 logic.appealp-when-memberp-of-logic.appeal-listp
+                 logic.appeal-listp-of-cdr-when-logic.appeal-listp
+                 logic.proofp-when-memberp-of-logic.proof-listp
+                 logic.proofp-of-car-when-logic.proof-listp
+                 logic.proof-listp-of-cdr-when-logic.proof-listp
+                 rw.tracep-of-car-when-rw.trace-listp
+                 rw.trace-listp-of-cdr-when-rw.trace-listp
+                 rw.trace-listp-when-not-consp
+                 logic.appeal-listp-when-not-consp
+                 logic.proofp-when-not-consp
+                 logic.proof-listp-when-not-consp
+                 logic.strip-conclusions-when-not-consp
+                 rw.trace-list-formulas-when-not-consp
+                 rw.tracep-when-memberp-of-rw.trace-listp
+                 forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                 forcing-equal-of-logic.function-with-two-args-alt))
+
+(local (%enable default
+                ;; This rules were added to formula-decomposition and broke the proofs below.  We
+                ;; just leave them all enabled.  It would be better to figure out which ones we
+                ;; really need.  We could probably do that by profiling and experimentation.
+                equal-of-logic.function-rewrite
+                equal-logic.por-logic.por-rewrite
+                forcing-equal-of-logic.function-with-three-args-alt
+                equal-of-logic.function-rewrite-alt
+                equal-logic.pequal-logic.pequal-rewrite
+                [outside]equal-of-logic.function-and-logic.function
+                [outside]equal-logic.pequal-logic.pequal-rewrite
+                equal-logic.por-logic.por-rewrite
+                [outside]equal-logic.por-logic.por-rewrite))
+
+
+(%autoprove rw.compile-if-specialcase-nil-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-if-specialcase-nil-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%enable default formula-decomposition)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pors)
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%forcingp t))
+
+(%autoprove logic.conclusion-of-rw.compile-if-specialcase-nil-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pors)
+            (%forcingp t)
+            (%crewrite default)
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite)))
+
+(%autoprove logic.proofp-of-rw.compile-if-specialcase-nil-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.proof-listp  (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%enable default formula-decomposition)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pors)
+            (%forcingp t)
+            (%crewrite default)
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/if-specialcase-t-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/if-specialcase-t-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/if-specialcase-t-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/if-specialcase-t-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,154 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(local (%splitlimit 20)) ;; BOZO Consider this globally at this level
+
+(%autoadmit rw.compile-if-specialcase-t-trace)
+
+(local (%enable default
+                rw.if-specialcase-t-tracep
+                rw.compile-if-specialcase-t-trace
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                equal-of-2-and-len))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 unusual-consp-rules
+                 expensive-term/formula-inference))
+
+(local (%disable default
+                 logic.appealp-of-car-when-logic.appeal-listp
+                 logic.appealp-of-second-when-logic.appeal-listp
+                 logic.appealp-when-memberp-of-logic.appeal-listp
+                 logic.appeal-listp-of-cdr-when-logic.appeal-listp
+                 logic.proofp-when-memberp-of-logic.proof-listp
+                 logic.proofp-of-car-when-logic.proof-listp
+                 logic.proof-listp-of-cdr-when-logic.proof-listp
+                 rw.tracep-of-car-when-rw.trace-listp
+                 rw.trace-listp-of-cdr-when-rw.trace-listp
+                 rw.trace-listp-when-not-consp
+                 logic.appeal-listp-when-not-consp
+                 logic.proofp-when-not-consp
+                 logic.proof-listp-when-not-consp
+                 logic.strip-conclusions-when-not-consp
+                 rw.trace-list-formulas-when-not-consp
+                 rw.tracep-when-memberp-of-rw.trace-listp
+                 forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                 forcing-equal-of-logic.function-with-two-args-alt))
+
+(local (%enable default
+                ;; This rules were added to formula-decomposition and broke the proofs below.  We
+                ;; just leave them all enabled.  It would be better to figure out which ones we
+                ;; really need.  We could probably do that by profiling and experimentation.
+                equal-of-logic.function-rewrite
+                equal-logic.por-logic.por-rewrite
+                forcing-equal-of-logic.function-with-three-args-alt
+                equal-of-logic.function-rewrite-alt
+                equal-logic.pequal-logic.pequal-rewrite
+                [outside]equal-of-logic.function-and-logic.function
+                [outside]equal-logic.pequal-logic.pequal-rewrite
+                equal-logic.por-logic.por-rewrite
+                [outside]equal-logic.por-logic.por-rewrite))
+
+
+(%autoprove rw.compile-if-specialcase-t-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-if-specialcase-t-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference) ;; may not need this with formula-decomposition changes
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pors)
+            (%auto :strategy (split cleanup urewrite crewrite)))
+
+(%autoprove logic.conclusion-of-rw.compile-if-specialcase-t-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pors)
+            (%forcingp t)
+            (%crewrite default)
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite)))
+
+(%autoprove logic.proofp-of-rw.compile-if-specialcase-t-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.proof-listp  (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%enable default
+                     formula-decomposition
+                     expensive-term/formula-inference)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pors)
+            (%forcingp t)
+            (%crewrite default)
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/lambda-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/lambda-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/lambda-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/lambda-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,129 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "equiv-by-args-compiler")
+(%interactive)
+
+
+(%autoadmit build.lambda-equal-by-args)
+(encapsulate
+ ()
+ (local (%enable default build.lambda-equal-by-args))
+ (%autoprove build.lambda-equal-by-args-under-iff)
+ (%autoprove forcing-logic.appealp-of-build.lambda-equal-by-args)
+ (%autoprove forcing-logic.conclusion-of-build.lambda-equal-by-args)
+ (%autoprove forcing-logic.proofp-of-build.lambda-equal-by-args))
+
+(%autoadmit build.disjoined-lambda-equal-by-args)
+(encapsulate
+ ()
+ (local (%enable default build.disjoined-lambda-equal-by-args))
+ (%autoprove build.disjoined-lambda-equal-by-args-under-iff)
+ (%autoprove forcing-logic.appealp-of-build.disjoined-lambda-equal-by-args)
+ (%autoprove forcing-logic.conclusion-of-build.disjoined-lambda-equal-by-args)
+ (%autoprove forcing-logic.proofp-of-build.disjoined-lambda-equal-by-args))
+
+(%autoprove forcing-equal-when-equal-of-logic.lambda-parts
+            (%enable default
+                     logic.lambda-formals
+                     logic.lambda-body
+                     logic.lambda-actuals
+                     logic.lambdap)
+            (%restrict default definition-of-logic.termp (memberp x '(x y)))
+            (%disable default
+                      logic.term-vars-when-bad
+                      logic.constantp-when-logic.variablep
+                      logic.variablep-of-car-when-logic.variable-listp
+                      logic.term-vars-when-constant
+                      logic.term-vars-when-variable
+                      logic.term-vars-when-logic.lambda
+                      logic.variablep-when-logic.constantp
+                      expensive-subsetp-rules
+                      logic.formulap-when-logic.termp
+                      logic.termp-when-logic.formulap
+                      logic.termp-when-logic.variablep
+                      logic.termp-when-logic.constantp
+                      logic.termp-of-car-when-logic.term-listp
+                      logic.term-vars-when-function-call))
+
+(%autoadmit rw.compile-lambda-equiv-by-args-trace)
+
+(local (%enable default
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                rw.lambda-equiv-by-args-tracep
+                rw.compile-lambda-equiv-by-args-trace))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 forcing-logic.vrhses-of-logic.por-list-free))
+
+(%autoprove lemma-for-rw.compile-lambda-equiv-by-args-trace
+            (%disable default
+                      len-of-rw.trace-list-lhses
+                      [outside]len-of-rw.trace-list-lhses)
+            (%use (%instance (%thm len-of-rw.trace-list-lhses)
+                             (x y))))
+
+(local (%enable default
+                lemma-for-rw.compile-lambda-equiv-by-args-trace
+                lemma-1-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+                lemma-2-for-logic.proofp-of-rw.compile-equiv-by-args-trace))
+
+(%autoprove rw.compile-lambda-equiv-by-args-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-lambda-equiv-by-args-trace)
+
+(%autoprove logic.conclusion-of-rw.compile-lambda-equiv-by-args-trace
+            (%auto)
+            (%enable default
+                     type-set-like-rules
+                     forcing-equal-when-equal-of-logic.lambda-parts
+                     expensive-arithmetic-rules-two
+                     expensive-term/formula-inference
+                     formula-decomposition))
+
+(%autoprove logic.proofp-of-rw.compile-lambda-equiv-by-args-trace
+            (%disable default
+                      unusual-memberp-rules
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-consp))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/level8.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/level8.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/level8.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/level8.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,174 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 61 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "ccstep-check")
+(%interactive)
+
+(%autoadmit level8.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level8.step-okp))
+ (%autoprove soundness-of-level8.step-okp)
+ (%autoprove level8.step-okp-when-level7.step-okp
+             (%forcingp nil)
+             (%enable default level7.step-okp)
+             (%auto)
+             (%enable default level6.step-okp)
+             (%auto)
+             (%enable default level5.step-okp)
+             (%auto)
+             (%enable default level4.step-okp)
+             (%auto)
+             (%enable default level3.step-okp)
+             (%auto)
+             (%enable default level2.step-okp)
+             (%auto)
+             (%enable default logic.appeal-step-okp))
+ (%autoprove level8.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%disable default forcing-true-listp-of-logic.subproofs))
+ (%autoadmit level8.flag-proofp-aux))
+
+(%autoadmit level8.proofp-aux)
+(%autoadmit level8.proof-listp-aux)
+(%autoprove definition-of-level8.proofp-aux
+            (%enable default level8.proofp-aux level8.proof-listp-aux)
+            (%restrict default level8.flag-proofp-aux (equal x 'x)))
+(%autoprove definition-of-level8.proof-listp-aux
+            (%enable default level8.proofp-aux level8.proof-listp-aux)
+            (%restrict default level8.flag-proofp-aux (equal x 'x)))
+
+
+(%autoprove level8.proofp-aux-when-not-consp      (%restrict default definition-of-level8.proofp-aux (equal x 'x)))
+(%autoprove level8.proof-listp-aux-when-not-consp (%restrict default definition-of-level8.proof-listp-aux (equal x 'x)))
+(%autoprove level8.proof-listp-aux-of-cons        (%restrict default definition-of-level8.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level8.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level8.proofp-aux (equal x 'x)))
+
+(%autoprove booleanp-of-level8.proofp-aux      (%use (%instance (%thm lemma-for-booleanp-of-level8.proofp-aux) (flag 'proof))))
+(%autoprove booleanp-of-level8.proof-listp-aux (%use (%instance (%thm lemma-for-booleanp-of-level8.proofp-aux) (flag 'list))))
+
+
+(%deflist level8.proof-listp-aux (x axioms thms atbl)
+          (level8.proofp-aux x axioms thms atbl))
+
+(%autoprove lemma-for-logic.provablep-when-level8.proofp-aux
+            (%splitlimit 15)
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%urewrite default)
+            (%auto :strategy (cleanup split urewrite))
+            (%restrict default definition-of-level8.proofp-aux (equal x 'x))
+            (%auto :strategy (cleanup split urewrite))
+            (%disable default
+                      ;; so many memberp terms that these get expensive
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-subset-of-somep-cheap
+                      memberp-when-not-superset-of-somep-cheap
+                      type-set-like-rules
+                      same-length-prefixes-equal-cheap
+                      logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest))
+
+(%autoprove logic.provablep-when-level8.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level8.proofp-aux) (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level8.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level8.proofp-aux) (flag 'list))))
+
+
+
+(%autoprove lemma-for-level8.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level8.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove level8.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level8.proofp-aux-when-logic.proofp) (flag 'proof))))
+
+(%autoprove level8.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level8.proofp-aux-when-logic.proofp) (flag 'list))))
+
+(%autoprove forcing-level8.proofp-aux-of-logic.provable-witness
+            (%enable default level8.proofp-aux-when-logic.proofp))
+
+
+
+(%autoadmit level8.proofp)
+(%autoprove booleanp-of-level8.proofp
+            (%enable default level8.proofp))
+(%autoprove logic.provablep-when-level8.proofp
+            (%enable default level8.proofp)
+            (%disable default logic.provablep-when-level8.proofp-aux)
+            (%use (%instance (%thm logic.provablep-when-level8.proofp-aux)
+                             (x    (second (logic.extras x)))
+                             (defs (first (logic.extras x)))))
+            (%disable default
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-subset-of-somep-cheap
+                      memberp-when-not-superset-of-somep-cheap
+                      logic.provablep-of-car-when-logic.provable-listp-free
+                      logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules))
+
+
+(defsection level8-transition
+  (%install-new-proofp level8.proofp)
+  (%auto)
+  (%qed-install))
+
+(ACL2::table tactic-harness 'current-adapter 'level8.adapter)
+
+(%switch-builder rw.ccstep-list-bldr rw.ccstep-list-bldr-high)
+(%switch-builder rw.compile-trace rw.compile-trace-high)
+
+
+
+(%finish "level8")
+(%save-events "level8.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/magic-evaluator.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/magic-evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/magic-evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/magic-evaluator.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,77 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; NOTE: magic evaluation is not used anymore, because it was a lot easier
+;; to take it out than try to explain why it is sound. :)
+
+;; (include-book
+;;  "../../../rewrite/magic-evaluator")
+;; (include-book "evaluator-bldr-2")
+;; (%interactive)
+
+
+;; (%defchoose evaluable-termp-witness n (x defs)
+;;             (generic-evaluator x defs n))
+
+;; (defsection evaluable-termp
+;;   (%defun evaluable-termp (x defs)
+;;           (let ((n (evaluable-termp-witness x defs)))
+;;             (generic-evaluator x defs n)))
+;;   (%admit))
+
+;; (%autoprove evaluable-termp-suff
+;;             (%use (build.axiom (defchoose-axiom-for-evaluable-termp-witness)))
+;;             (%use (%instance (%thm evaluable-termp))))
+
+;; (%autoadmit magic-evaluator)
+
+;; (%autoprove forcing-logic.constantp-of-magic-evaluator
+;;             (%enable default magic-evaluator))
+
+
+
+
+;; (%autoadmit magic-evaluator-bldr)
+
+;; (%autoprove forcing-logic.appealp-of-magic-evaluator-bldr
+;;             (%enable default magic-evaluator magic-evaluator-bldr))
+
+;; (%autoprove forcing-logic.conclusion-of-magic-evaluator-bldr
+;;             (%enable default magic-evaluator magic-evaluator-bldr))
+
+;; (%autoprove forcing-logic.proofp-of-magic-evaluator-bldr
+;;             (%enable default magic-evaluator magic-evaluator-bldr))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level8/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/make-image.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level7/level7")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level8-symmetry"
+                 "Pre-loaded bootstrap/level7 directory.")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/negative-if-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/negative-if-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/negative-if-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/negative-if-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,61 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-negative-if-trace)
+
+(local (%enable default
+                rw.compile-negative-if-trace
+                rw.negative-if-tracep
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                logic.term-formula
+                definition-of-not))
+
+(%autoprove rw.compile-negative-if-trace-under-iff)
+
+(%autoprove forcing-logic.appealp-of-rw.compile-negative-if-trace)
+
+(%autoprove logic.conclusion-of-rw.compile-negative-if-trace
+            (%auto)
+            (%car-cdr-elim (logic.function-args (rw.trace->lhs x)))
+            (%auto)
+            (%car-cdr-elim (cdr (logic.function-args (rw.trace->lhs x))))
+            (%auto)
+            (%car-cdr-elim (cdr (cdr (logic.function-args (rw.trace->lhs x))))))
+
+(%autoprove logic.proofp-of-rw.compile-negative-if-trace)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/not-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/not-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/not-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/not-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,73 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%deftheorem rw.compile-not-lemma1)
+
+(%defderiv rw.compile-not-trace-lemma-0a :omit-okp t)
+(%defderiv rw.compile-not-trace-lemma-1a :omit-okp t)
+(%defderiv rw.compile-not-trace-lemma-2a :omit-okp t)
+
+(%defderiv rw.compile-not-trace-lemma-0b :omit-okp t)
+(%defderiv rw.compile-not-trace-lemma-1b :omit-okp t)
+(%defderiv rw.compile-not-trace-lemma-2b :omit-okp t)
+
+(%autoadmit rw.compile-not-trace)
+
+(local (%enable default
+                rw.compile-not-trace
+                rw.not-tracep
+                rw.trace-conclusion-formula
+                rw.trace-formula))
+
+(%autoprove lemma-1-for-rw.compile-not-trace)
+
+(%autoprove lemma-2-for-rw.compile-not-trace
+            (%car-cdr-elim proofs))
+
+(local (%enable default
+                lemma-1-for-rw.compile-not-trace
+                lemma-2-for-rw.compile-not-trace))
+
+(%autoprove rw.compile-not-trace-under-iff)
+
+(%autoprove forcing-logic.appealp-of-rw.compile-not-trace)
+
+(%autoprove logic.conclusion-of-rw.compile-not-trace)
+
+(%autoprove logic.proofp-of-rw.compile-not-trace)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level8/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/symmetry	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level8-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/trace-arities.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/trace-arities.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/trace-arities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/trace-arities.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,321 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tracep")
+(%interactive)
+
+(%autoadmit rw.slow-flag-trace-arities)
+(%autoadmit rw.slow-trace-arities)
+(%autoadmit rw.slow-trace-list-arities)
+
+(%autoprove definition-of-rw.slow-trace-arities
+            (%restrict default rw.slow-flag-trace-arities (equal x 'x))
+            (%enable default rw.slow-trace-list-arities rw.slow-trace-arities))
+
+(%autoprove definition-of-rw.slow-trace-list-arities
+            (%restrict default rw.slow-flag-trace-arities (equal x 'x))
+            (%enable default rw.slow-trace-list-arities rw.slow-trace-arities))
+
+(%autoprove rw.slow-trace-list-arities-when-not-consp
+            (%restrict default definition-of-rw.slow-trace-list-arities (equal x 'x)))
+
+(%autoprove rw.slow-trace-list-arities-of-cons
+            (%restrict default definition-of-rw.slow-trace-list-arities (equal x '(cons a x))))
+
+
+(%autoadmit rw.flag-trace-arities)
+(%autoadmit rw.trace-arities)
+(%autoadmit rw.trace-list-arities)
+
+(%autoprove definition-of-rw.trace-arities
+            (%enable default rw.trace-arities rw.trace-list-arities)
+            (%restrict default rw.flag-trace-arities (equal x 'x)))
+
+(%autoprove definition-of-rw.trace-list-arities
+            (%enable default rw.trace-arities rw.trace-list-arities)
+            (%restrict default rw.flag-trace-arities (equal x 'x)))
+
+(%autoprove rw.flag-trace-arities-of-term
+            (%enable default rw.trace-arities))
+
+(%autoprove rw.flag-trace-arities-of-list
+            (%enable default rw.trace-list-arities))
+
+(%autoprove rw.trace-list-arities-when-not-consp
+            (%restrict default definition-of-rw.trace-list-arities (equal x 'x)))
+
+(%autoprove rw.trace-list-arities-of-cons
+            (%restrict default definition-of-rw.trace-list-arities (equal x '(cons a x))))
+
+(%autoprove lemma-for-true-listp-of-rw.trace-arities
+            (%autoinduct rw.flag-trace-arities flag x acc)
+            (%restrict default definition-of-rw.trace-arities (equal x 'x)))
+
+(%autoprove true-listp-of-rw.trace-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.trace-arities)
+                             (flag 'term))))
+
+(%autoprove true-listp-of-rw.trace-list-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.trace-arities)
+                             (flag 'list))))
+
+(%autoprove lemma-for-rw.trace-arities-removal
+            (%autoinduct rw.flag-trace-arities flag x acc)
+            (%restrict default definition-of-rw.trace-arities (equal x 'x))
+            (%restrict default definition-of-rw.slow-trace-arities (equal x 'x)))
+
+(%autoprove rw.trace-arities-removal
+            (%use (%instance (%thm lemma-for-rw.trace-arities-removal)
+                             (flag 'term))))
+
+(%autoprove rw.trace-list-arities-removal
+            (%use (%instance (%thm lemma-for-rw.trace-arities-removal)
+                             (flag 'list))))
+
+(%autoprove lemma-for-rw.slow-trace-arities-correct
+            (%rw.trace-induction flag x)
+            (%forcingp nil)
+            (%restrict default definition-of-rw.slow-trace-arities (equal x 'x))
+            (%restrict default definition-of-rw.trace-atblp (equal x 'x)))
+
+(%autoprove rw.slow-trace-arities-correct
+            (%use (%instance (%thm lemma-for-rw.slow-trace-arities-correct)
+                             (flag 'term))))
+
+(%autoprove rw.slow-trace-list-arities-correct
+            (%use (%instance (%thm lemma-for-rw.slow-trace-arities-correct)
+                             (flag 'list))))
+
+(%autoadmit rw.fast-trace-atblp)
+
+(%autoprove rw.fast-trace-atblp-removal
+            (%enable default rw.fast-trace-atblp))
+
+
+(%autoadmit rw.fast-trace-list-atblp)
+
+(%autoprove rw.fast-trace-list-atblp-removal
+            (%enable default rw.fast-trace-list-atblp))
+
+
+
+
+(%autoadmit rw.slow-flag-eqtrace-arities)
+(%autoadmit rw.slow-eqtrace-arities)
+(%autoadmit rw.slow-eqtrace-list-arities)
+
+(%autoprove definition-of-rw.slow-eqtrace-arities
+            (%restrict default rw.slow-flag-eqtrace-arities (equal x 'x))
+            (%enable default rw.slow-eqtrace-list-arities rw.slow-eqtrace-arities))
+
+(%autoprove definition-of-rw.slow-eqtrace-list-arities
+            (%restrict default rw.slow-flag-eqtrace-arities (equal x 'x))
+            (%enable default rw.slow-eqtrace-list-arities rw.slow-eqtrace-arities))
+
+(%autoprove rw.slow-eqtrace-list-arities-when-not-consp
+            (%restrict default definition-of-rw.slow-eqtrace-list-arities (equal x 'x)))
+
+(%autoprove rw.slow-eqtrace-list-arities-of-cons
+            (%restrict default definition-of-rw.slow-eqtrace-list-arities (equal x '(cons a x))))
+
+
+(%autoadmit rw.flag-eqtrace-arities)
+(%autoadmit rw.eqtrace-arities)
+(%autoadmit rw.eqtrace-list-arities)
+
+(%autoprove definition-of-rw.eqtrace-arities
+            (%restrict default rw.flag-eqtrace-arities (equal x 'x))
+            (%enable default rw.eqtrace-arities rw.eqtrace-list-arities))
+
+(%autoprove definition-of-rw.eqtrace-list-arities
+            (%restrict default rw.flag-eqtrace-arities (equal x 'x))
+            (%enable default rw.eqtrace-arities rw.eqtrace-list-arities))
+
+(%autoprove rw.flag-eqtrace-arities-of-trace
+            (%enable default rw.eqtrace-arities))
+
+(%autoprove rw.flag-eqtrace-arities-of-list
+            (%enable default rw.eqtrace-list-arities))
+
+(%autoprove rw.eqtrace-list-arities-when-not-consp
+            (%restrict default definition-of-rw.eqtrace-list-arities (equal x 'x)))
+
+(%autoprove rw.eqtrace-list-arities-of-cons
+            (%restrict default definition-of-rw.eqtrace-list-arities (equal x '(cons a x))))
+
+(%autoprove lemma-for-true-listp-of-rw.eqtrace-arities
+            (%autoinduct rw.flag-eqtrace-arities flag x acc)
+            (%restrict default definition-of-rw.eqtrace-arities (equal x 'x)))
+
+(%autoprove true-listp-of-rw.eqtrace-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.eqtrace-arities)
+                             (flag 'trace))))
+
+(%autoprove true-listp-of-rw.eqtrace-list-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.eqtrace-arities)
+                             (flag 'list))))
+
+(%autoprove lemma-for-rw.eqtrace-arities-removal
+            (%autoinduct rw.flag-eqtrace-arities flag x acc)
+            (%restrict default definition-of-rw.eqtrace-arities (equal x 'x))
+            (%restrict default definition-of-rw.slow-eqtrace-arities (equal x 'x)))
+
+(%autoprove rw.eqtrace-arities-removal
+            (%use (%instance (%thm lemma-for-rw.eqtrace-arities-removal)
+                             (flag 'trace))))
+
+(%autoprove rw.eqtrace-list-arities-removal
+            (%use (%instance (%thm lemma-for-rw.eqtrace-arities-removal)
+                             (flag 'list))))
+
+(%autoprove lemma-for-rw.slow-eqtrace-arities-correct
+            (%autoinduct rw.flag-eqtrace-atblp flag x atbl)
+            (%forcingp nil)
+            (%restrict default definition-of-rw.eqtrace-atblp (equal x 'x))
+            (%restrict default definition-of-rw.slow-eqtrace-arities (equal x 'x)))
+
+(%autoprove rw.slow-eqtrace-arities-correct
+            (%use (%instance (%thm lemma-for-rw.slow-eqtrace-arities-correct)
+                             (flag 'trace))))
+
+(%autoprove rw.slow-eqtrace-list-arities-correct
+            (%use (%instance (%thm lemma-for-rw.slow-eqtrace-arities-correct)
+                             (flag 'list))))
+
+
+
+
+(%autoadmit rw.slow-faster-flag-trace-arities)
+(%autoadmit rw.slow-faster-trace-arities)
+(%autoadmit rw.slow-faster-trace-list-arities)
+
+(%autoprove definition-of-rw.slow-faster-trace-arities
+            (%restrict default rw.slow-faster-flag-trace-arities (equal x 'x))
+            (%enable default rw.slow-faster-trace-arities rw.slow-faster-trace-list-arities))
+
+(%autoprove definition-of-rw.slow-faster-trace-list-arities
+            (%restrict default rw.slow-faster-flag-trace-arities (equal x 'x))
+            (%enable default rw.slow-faster-trace-arities rw.slow-faster-trace-list-arities))
+
+(%autoprove rw.slow-faster-flag-trace-arities-of-term
+            (%enable default rw.slow-faster-trace-arities))
+
+(%autoprove rw.slow-faster-flag-trace-arities-of-list
+            (%enable default rw.slow-faster-trace-list-arities))
+
+(%autoprove rw.slow-faster-trace-list-arities-when-not-consp
+            (%restrict default definition-of-rw.slow-faster-trace-list-arities (equal x 'x)))
+
+(%autoprove rw.slow-faster-trace-list-arities-of-cons
+            (%restrict default definition-of-rw.slow-faster-trace-list-arities (equal x '(cons a x))))
+
+(%autoprove lemma-for-rw.slow-faster-trace-arities-correct
+            (%autoinduct rw.slow-faster-flag-trace-arities flag x hypbox)
+            (%forcingp nil)
+            (%restrict default definition-of-rw.slow-faster-trace-arities (equal x 'x))
+            (%restrict default definition-of-rw.trace-atblp (equal x 'x)))
+
+(%autoprove rw.slow-faster-trace-arities-correct
+            (%use (%instance (%thm lemma-for-rw.slow-faster-trace-arities-correct)
+                             (flag 'term))))
+
+(%autoprove rw.slow-faster-trace-list-arities-correct
+            (%use (%instance (%thm lemma-for-rw.slow-faster-trace-arities-correct)
+                             (flag 'list))))
+
+
+(%autoadmit rw.faster-flag-trace-arities)
+(%autoadmit rw.faster-trace-arities)
+(%autoadmit rw.faster-trace-list-arities)
+
+(%autoprove definition-of-rw.faster-trace-arities
+            (%restrict default rw.faster-flag-trace-arities (equal x 'x))
+            (%enable default rw.faster-trace-arities rw.faster-trace-list-arities))
+
+(%autoprove definition-of-rw.faster-trace-list-arities
+            (%restrict default rw.faster-flag-trace-arities (equal x 'x))
+            (%enable default rw.faster-trace-arities rw.faster-trace-list-arities))
+
+(%autoprove rw.faster-flag-trace-arities-of-term
+            (%enable default rw.faster-trace-arities))
+
+(%autoprove rw.faster-flag-trace-arities-of-list
+            (%enable default rw.faster-trace-list-arities))
+
+(%autoprove rw.faster-trace-list-arities-when-not-consp
+            (%restrict default definition-of-rw.faster-trace-list-arities (equal x 'x)))
+
+(%autoprove rw.faster-trace-list-arities-of-cons
+            (%restrict default definition-of-rw.faster-trace-list-arities (equal x '(cons a x))))
+
+(%autoprove lemma-for-true-listp-of-rw.faster-trace-arities
+            (%autoinduct rw.faster-flag-trace-arities flag x ext-hypbox acc)
+            (%restrict default definition-of-rw.faster-trace-arities (equal x 'x))
+            (%restrict default definition-of-rw.slow-faster-trace-arities (equal x 'x)))
+
+(%autoprove true-listp-of-rw.faster-trace-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.faster-trace-arities)
+                             (flag 'term))))
+
+(%autoprove true-listp-of-rw.faster-trace-list-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-rw.faster-trace-arities)
+                             (flag 'list))))
+
+(%autoprove lemma-for-rw.faster-trace-arities-removal
+            (%autoinduct rw.faster-flag-trace-arities flag x ext-hypbox acc)
+            (%restrict default definition-of-rw.faster-trace-arities (equal x 'x))
+            (%restrict default definition-of-rw.slow-faster-trace-arities (equal x 'x)))
+
+(%autoprove rw.faster-trace-arities-removal
+            (%use (%instance (%thm lemma-for-rw.faster-trace-arities-removal)
+                             (flag 'term))))
+
+(%autoprove rw.faster-trace-list-arities-removal
+            (%use (%instance (%thm lemma-for-rw.faster-trace-arities-removal)
+                             (flag 'list))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/trace-arities")
+
+
+
+
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/trace-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/trace-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/trace-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/trace-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,216 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "collect-forced-goals")
+(include-book "assumptions-compiler")
+(include-book "beta-compiler")
+(include-book "crewrite-if-general-compiler")
+(include-book "crewrite-if-same-compiler")
+(include-book "crewrite-rule-compiler")
+(include-book "equiv-by-args-compiler")
+(include-book "fail-compiler")
+(include-book "force-compiler")
+(include-book "ground-compiler")
+(include-book "if-specialcase-nil-compiler")
+(include-book "if-specialcase-t-compiler")
+(include-book "lambda-compiler")
+(include-book "negative-if-compiler")
+(include-book "not-compiler")
+(include-book "transitivity-compiler")
+(include-book "urewrite-if-general-compiler")
+(include-book "urewrite-if-same-compiler")
+(include-book "urewrite-rule-compiler")
+(include-book "weakening-compiler")
+(include-book "trace-arities")
+(%interactive)
+
+
+(%autoadmit rw.compile-trace-step)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 rw.trace-step-okp
+                 rw.trace-step-env-okp
+                 rw.compile-trace-step))
+ (%autoprove rw.compile-trace-step-under-iff)
+ (%autoprove forcing-logic.appealp-of-rw.compile-trace-step)
+ (%autoprove forcing-logic.conclusion-of-rw.compile-trace-step)
+ (%autoprove forcing-logic.proofp-of-rw.compile-trace-step))
+
+
+
+
+(%autoadmit rw.flag-compile-trace)
+(%autoadmit rw.compile-trace)
+(%autoadmit rw.compile-trace-list)
+
+(%autoprove definition-of-rw.compile-trace
+            (%restrict default rw.flag-compile-trace (equal x 'x))
+            (%enable default rw.compile-trace rw.compile-trace-list))
+
+(%autoprove definition-of-rw.compile-trace-list
+            (%restrict default rw.flag-compile-trace (equal x 'x))
+            (%enable default rw.compile-trace rw.compile-trace-list))
+
+(%autoprove rw.flag-compile-trace-of-term-removal
+            (%enable default rw.compile-trace))
+
+(%autoprove rw.flag-compile-trace-of-list-removal
+            (%enable default rw.compile-trace-list))
+
+
+(%autoprove lemma-for-forcing-logic.appealp-of-rw.compile-trace
+            (%rw.trace-induction flag x)
+            (%auto :strategy (cleanup split urewrite crewrite dist))
+            (%restrict default definition-of-rw.compile-trace (equal x 'x))
+            (%restrict default definition-of-rw.compile-trace-list (equal x 'x)))
+
+(%autoprove forcing-logic.appealp-of-rw.compile-trace
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-rw.compile-trace)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.conclusion-of-rw.compile-trace
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-rw.compile-trace)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.appeal-listp-of-rw.compile-trace-list
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-rw.compile-trace)
+                             (flag 'list))))
+
+(%autoprove forcing-logic.strip-conclusions-of-rw.compile-trace-list
+            (%use (%instance (%thm lemma-for-forcing-logic.appealp-of-rw.compile-trace)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.proofp-of-rw.compile-trace
+            (%rw.trace-induction flag x)
+
+            ;; The case-split is too severe, but we can cut it down with some
+            ;; selective urewriting.
+
+            ;; BOZO this is pretty horrible.  It'd be nice if we could just tell
+            ;; %auto to use a specific theory like temp, instead of having to mangle
+            ;; default.  Also, I worry that the enabling might linearize the lookup
+            ;; structure.  We should write some code to balance it.
+            (%create-theory temp :copy-of default)
+
+            (%disable default default)
+            (%enable default
+                     equal-of-nil-one
+                     equal-of-nil-two
+                     iff-of-nil-one
+                     iff-of-nil-two
+                     iff-of-t-left
+                     iff-of-t-right
+                     implies-of-self
+                     implies-of-t-left
+                     implies-of-t-right
+                     implies-of-nil-left
+                     implies-of-nil-right)
+            (%auto :strategy (urewrite split))
+
+            (%enable default temp)
+            (%disable default
+                      formula-decomposition
+                      type-set-like-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      same-length-prefixes-equal-cheap
+                      expensive-term/formula-inference
+                      unusual-consp-rules)
+
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default definition-of-rw.compile-trace (equal x 'x))
+            (%restrict default definition-of-rw.compile-trace-list (equal x 'x))
+            (%auto :strategy (cleanup split urewrite crewrite))
+
+            (%enable default
+                     type-set-like-rules
+                     expensive-arithmetic-rules
+                     expensive-arithmetic-rules-two))
+
+(%autoprove forcing-logic.proofp-of-rw.compile-trace
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-rw.compile-trace)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.proof-listp-of-rw.compile-trace
+            (%use (%instance (%thm lemma-for-forcing-logic.proofp-of-rw.compile-trace)
+                             (flag 'list))))
+
+
+
+(%autoadmit rw.compile-trace-okp)
+
+(%autoprove forcing-logic.appeal-listp-of-logic.find-proofs
+            (%cdr-induction formulas))
+
+(%autoprove forcing-logic.strip-conclusions-of-logic.find-proofs
+            (%cdr-induction formulas))
+
+(%autoadmit rw.compile-trace-high)
+
+(%autoprove rw.compile-trace-okp-of-rw.compile-trace-high
+            (%enable default
+                     rw.compile-trace-high
+                     rw.compile-trace-okp))
+
+
+(encapsulate
+ ()
+ (local (%enable default rw.compile-trace-okp))
+ (%autoprove booleanp-of-rw.compile-trace-okp)
+ (%autoprove rw.compile-trace-okp-of-logic.appeal-identity)
+ (%autoprove lemma-0-for-soundness-of-rw.compile-trace-okp)
+ (local (%enable default lemma-0-for-soundness-of-rw.compile-trace-okp))
+ (%autoprove lemma-1-for-soundness-of-rw.compile-trace-okp
+             (%forcingp nil))
+ (%autoprove lemma-2-for-soundness-of-rw.compile-trace-okp)
+ (%autoprove forcing-soundness-of-rw.compile-trace-okp
+             (%enable default
+                      lemma-1-for-soundness-of-rw.compile-trace-okp
+                      lemma-2-for-soundness-of-rw.compile-trace-okp)
+             (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                              (x (rw.compile-trace (logic.extras x)
+                                                   defs
+                                                   (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                                axioms thms atbl)))))))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/trace-compiler")
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/trace-okp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/trace-okp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/trace-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/trace-okp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,160 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-recognizers")
+(include-book "urewrite-recognizers")
+(include-book "crewrite-recognizers")
+(%interactive)
+
+
+(%autoadmit rw.trace-step-okp)
+
+(%autoadmit rw.trace-step-env-okp)
+
+(%autoprove booleanp-of-rw.trace-step-okp
+            (%enable default rw.trace-step-okp))
+
+(%autoprove booleanp-of-rw.trace-step-env-okp
+            (%enable default rw.trace-step-env-okp))
+
+
+
+(%autoadmit rw.flag-trace-okp)
+
+(%autoadmit rw.trace-okp)
+
+(%autoadmit rw.trace-list-okp)
+
+(%autoprove definition-of-rw.trace-okp
+            (%restrict default rw.flag-trace-okp (equal x 'x))
+            (%enable default rw.trace-okp rw.trace-list-okp))
+
+(%autoprove definition-of-rw.trace-list-okp
+            (%restrict default rw.flag-trace-okp (equal x 'x))
+            (%enable default rw.trace-okp rw.trace-list-okp))
+
+
+(%autoprove rw.trace-step-okp-of-nil
+            (%enable default rw.trace-step-okp))
+
+(%autoprove rw.trace-okp-of-nil
+            (%restrict default definition-of-rw.trace-okp (equal x ''nil)))
+
+(%autoprove rw.trace-list-okp-when-not-consp
+            (%rw.trace-induction flag x)
+            (%restrict default definition-of-rw.trace-list-okp (equal x 'x)))
+
+(%autoprove rw.trace-list-okp-of-cons
+            (%rw.trace-induction flag x)
+            (%restrict default definition-of-rw.trace-list-okp (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-rw.trace-okp
+            (%rw.trace-induction flag x)
+            (%restrict default definition-of-rw.trace-okp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.trace-okp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.trace-okp)
+                             (flag 'term))))
+
+(%autoprove booleanp-of-rw.trace-list-okp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.trace-okp)
+                             (flag 'list))))
+
+
+(%deflist rw.trace-list-okp (x)
+          (rw.trace-okp x))
+
+(%autoprove rw.trace-step-okp-when-rw.trace-okp
+            (%restrict default definition-of-rw.trace-okp (equal x 'x)))
+
+(%autoprove rw.trace-list-okp-of-rw.trace->subtraces-when-rw.trace-okp
+            (%restrict default definition-of-rw.trace-okp (equal x 'x)))
+
+
+
+
+
+(%autoadmit rw.flag-trace-env-okp)
+
+(%autoadmit rw.trace-env-okp)
+
+(%autoadmit rw.trace-list-env-okp)
+
+(%autoprove definition-of-rw.trace-env-okp
+            (%restrict default rw.flag-trace-env-okp (equal x 'x))
+            (%enable default rw.trace-env-okp rw.trace-list-env-okp))
+
+(%autoprove definition-of-rw.trace-list-env-okp
+            (%restrict default rw.flag-trace-env-okp (equal x 'x))
+            (%enable default rw.trace-env-okp rw.trace-list-env-okp))
+
+(%autoprove rw.trace-list-env-okp-when-not-consp
+            (%restrict default definition-of-rw.trace-list-env-okp (equal x 'x)))
+
+(%autoprove rw.trace-list-env-okp-of-cons
+            (%restrict default definition-of-rw.trace-list-env-okp (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-rw.trace-env-okp
+            (%rw.trace-induction flag x)
+            (%restrict default definition-of-rw.trace-env-okp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.trace-env-okp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.trace-env-okp)
+                             (flag 'term))))
+
+(%autoprove booleanp-of-rw.trace-list-env-okp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.trace-env-okp)
+                             (flag 'list))))
+
+(%autoprove rw.trace-step-env-okp-of-nil
+            (%enable default rw.trace-step-env-okp))
+
+(%autoprove rw.trace-env-okp-of-nil
+            (%restrict default definition-of-rw.trace-env-okp (equal x ''nil)))
+
+(%deflist rw.trace-list-env-okp (x axioms thms atbl)
+          (rw.trace-env-okp x axioms thms atbl))
+
+(%autoprove rw.trace-step-env-okp-when-rw.trace-env-okp
+            (%restrict default definition-of-rw.trace-env-okp (equal x 'x)))
+
+(%autoprove rw.trace-list-env-okp-of-rw.trace->subtraces-when-rw.trace-env-okp
+            (%restrict default definition-of-rw.trace-env-okp (equal x 'x)))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/trace-okp")
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/tracep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/tracep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/tracep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/tracep.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,394 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%autoprove rank-of-cdr-of-lookup-weak
+            (%cdr-induction map))
+
+(%autoprove rank-of-cdr-of-cdr-of-cdr-of-cdr-weak
+            (%restrict default rank (memberp x '(x (cdr x) (cdr (cdr x)) (cdr (cdr (cdr x)))))))
+
+
+(%autoadmit rw.flag-tracep)
+(%autoadmit rw.tracep)
+(%autoadmit rw.trace-listp)
+
+(%autoprove definition-of-rw.tracep
+            (%enable default rw.tracep rw.trace-listp)
+            (%restrict default rw.flag-tracep (equal x 'x)))
+
+(%autoprove definition-of-rw.trace-listp
+            (%enable default rw.tracep rw.trace-listp)
+            (%restrict default rw.flag-tracep (equal x 'x)))
+
+(defmacro %rw.raw-trace-induction (flag x)
+  `(%induct (two-nats-measure (rank ,x)
+                              (if (equal ,flag 'term) '1 '0))
+            ((equal ,flag 'term)
+             (((,x (cdr (cdr (cdr (cdr ,x))))) (,flag 'list))))
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,x (car ,x)) (,flag 'term))
+              ((,x (cdr ,x)) (,flag 'list))))))
+
+(%autoprove rw.trace-listp-when-not-consp
+            (%restrict default definition-of-rw.trace-listp (equal x 'x)))
+
+(%autoprove rw.trace-listp-of-cons
+            (%restrict default definition-of-rw.trace-listp (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-rw.tracep
+            (%rw.raw-trace-induction flag x)
+            (%restrict default definition-of-rw.tracep (equal x 'x)))
+
+(%autoprove booleanp-of-rw.tracep
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.tracep)
+                             (flag 'term))))
+
+(%autoprove booleanp-of-rw.trace-listp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.tracep)
+                             (flag 'list))))
+
+(%deflist rw.trace-listp (x)
+          (rw.tracep x))
+
+(%deflist rw.trace-list-listp (x)
+          (rw.trace-listp x))
+
+
+
+(%autoadmit rw.trace->method)
+(%autoadmit rw.trace->hypbox)
+(%autoadmit rw.trace->lhs)
+(%autoadmit rw.trace->rhs)
+(%autoadmit rw.trace->iffp)
+(%autoadmit rw.trace->subtraces)
+(%autoadmit rw.trace->extras)
+
+(%defprojection :list (rw.trace-list-iffps x)
+                :element (rw.trace->iffp x))
+
+(%defprojection :list (rw.trace-list-lhses x)
+                :element (rw.trace->lhs x))
+
+(%defprojection :list (rw.trace-list-rhses x)
+                :element (rw.trace->rhs x))
+
+(%defprojection :list (rw.trace-list-hypboxes x)
+                :element (rw.trace->hypbox x))
+
+(%defprojection :list (rw.trace-list-list-rhses x)
+                :element (rw.trace-list-rhses x))
+
+
+
+(%autoadmit rw.trace)
+
+(%autoprove rw.trace-under-iff
+            (%enable default rw.trace))
+
+(%autoprove rw.trace->method-of-rw.trace
+            (%enable default rw.trace rw.trace->method))
+
+(%autoprove rw.trace->hypbox-of-rw.trace
+            (%enable default rw.trace rw.trace->hypbox))
+
+(%autoprove rw.trace->lhs-of-rw.trace
+            (%enable default rw.trace rw.trace->lhs))
+
+(%autoprove rw.trace->rhs-of-rw.trace
+            (%enable default rw.trace rw.trace->rhs))
+
+(%autoprove rw.trace->iffp-of-rw.trace
+            (%enable default rw.trace rw.trace->iffp))
+
+(%autoprove rw.trace->subtraces-of-rw.trace
+            (%enable default rw.trace rw.trace->subtraces))
+
+(%autoprove rw.trace->extras-of-rw.trace
+            (%enable default rw.trace rw.trace->extras))
+
+(%autoprove forcing-rw.tracep-of-rw.trace
+            (%enable default rw.trace)
+            (%restrict default definition-of-rw.tracep
+                       (equal x '(CONS (CONS METHOD RHS)
+                                       (CONS (CONS LHS IFFP)
+                                             (CONS HYPBOX (CONS EXTRAS SUBTRACES)))))))
+
+(%autoprove forcing-symbolp-of-rw.trace->method
+            (%restrict default definition-of-rw.tracep (equal x 'x))
+            (%enable default rw.trace->method))
+
+(%autoprove forcing-rw.hypboxp-of-rw.trace->hypbox
+            (%restrict default definition-of-rw.tracep (equal x 'x))
+            (%enable default rw.trace->hypbox))
+
+(%autoprove forcing-logic.termp-of-rw.trace->lhs
+            (%restrict default definition-of-rw.tracep (equal x 'x))
+            (%enable default rw.trace->lhs))
+
+(%autoprove forcing-logic.termp-of-rw.trace->rhs
+            (%restrict default definition-of-rw.tracep (equal x 'x))
+            (%enable default rw.trace->rhs))
+
+(%autoprove forcing-booleanp-of-rw.trace->iffp
+            (%restrict default definition-of-rw.tracep (equal x 'x))
+            (%enable default rw.trace->iffp))
+
+(%autoprove forcing-rw.trace-listp-of-rw.trace->subtraces
+            (%restrict default definition-of-rw.tracep (equal x 'x))
+            (%enable default rw.trace->subtraces))
+
+(%autoprove forcing-logic.term-listp-of-rw.trace-list-lhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-listp-of-rw.trace-list-rhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-listp-of-rw.trace-list-list-rhses
+            (%cdr-induction x))
+
+(%autoprove cons-listp-of-rw.trace-list-list-rhses
+            (%cdr-induction x))
+
+
+
+
+(%autoprove rw.trace->lhs-under-iff
+            (%restrict default definition-of-rw.tracep (equal x 'x))
+            (%enable default rw.trace->lhs))
+
+(%autoprove rw.trace->rhs-under-iff
+            (%restrict default definition-of-rw.tracep (equal x 'x))
+            (%enable default rw.trace->rhs))
+
+(%autoprove rank-of-rw.trace->subtraces-weak
+            (%enable default rw.trace->subtraces))
+
+
+
+
+(%autoadmit rw.flag-trace-atblp)
+(%autoadmit rw.trace-atblp)
+(%autoadmit rw.trace-list-atblp)
+
+(%autoprove definition-of-rw.trace-atblp
+            (%enable default rw.trace-atblp rw.trace-list-atblp)
+            (%restrict default rw.flag-trace-atblp (equal x 'x)))
+
+(%autoprove definition-of-rw.trace-list-atblp
+            (%enable default rw.trace-atblp rw.trace-list-atblp)
+            (%restrict default rw.flag-trace-atblp (equal x 'x)))
+
+(%autoprove rw.trace-atblp-of-nil
+            (%restrict default definition-of-rw.trace-atblp (equal x ''nil)))
+
+(defmacro %rw.trace-induction (flag x)
+  `(%induct (two-nats-measure (rank ,x)
+                              (if (equal ,flag 'term) '1 '0))
+            ((equal ,flag 'term)
+             (((x (rw.trace->subtraces ,x)) (,flag 'list))))
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,x (car ,x)) (,flag 'term))
+              ((,x (cdr ,x)) (,flag 'list))))))
+
+(%autoprove rw.trace-list-atblp-when-not-consp
+            (%restrict default definition-of-rw.trace-list-atblp (equal x 'x)))
+
+(%autoprove rw.trace-list-atblp-of-cons
+            (%restrict default definition-of-rw.trace-list-atblp (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-rw.trace-atblp
+            (%rw.trace-induction flag x)
+            (%restrict default definition-of-rw.trace-atblp (equal x 'x)))
+
+(%autoprove booleanp-of-rw.trace-atblp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.trace-atblp)
+                             (flag 'term))))
+
+(%autoprove booleanp-of-rw.trace-list-atblp
+            (%use (%instance (%thm lemma-for-booleanp-of-rw.trace-atblp)
+                             (flag 'list))))
+
+(%deflist rw.trace-list-atblp (x atbl)
+          (rw.trace-atblp x atbl))
+
+
+
+(%autoprove forcing-rw.hypbox-atblp-of-rw.trace->hypbox
+            (%restrict default definition-of-rw.trace-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-rw.trace->lhs
+            (%restrict default definition-of-rw.trace-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-rw.trace->rhs
+            (%restrict default definition-of-rw.trace-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-list-atblp-of-rw.trace->subtraces
+            (%restrict default definition-of-rw.trace-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-list-atblp-of-rw.trace-list-lhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-rw.trace-list-rhses
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.trace-atblp-of-rw.trace
+            (%restrict default definition-of-rw.trace-atblp
+                       (equal x '(rw.trace method hypbox lhs rhs iffp subtraces extras))))
+
+
+
+(%autoadmit rw.trace-conclusion-formula)
+(%noexec rw.trace-conclusion-formula)
+(%autoprove forcing-logic.formulap-of-rw.trace-conclusion-formula
+            (%enable default rw.trace-conclusion-formula))
+(%autoprove forcing-logic.formula-atblp-of-rw.trace-conclusion-formula
+            (%enable default rw.trace-conclusion-formula))
+
+
+(%defprojection :list (rw.trace-list-conclusion-formulas x)
+                :element (rw.trace-conclusion-formula x))
+(%autoprove forcing-logic.formula-listp-of-rw.trace-list-conclusion-formulas
+            (%cdr-induction x))
+(%autoprove forcing-logic.formula-list-atblp-of-rw.trace-list-conclusion-formulas
+            (%cdr-induction x))
+
+(%autoadmit rw.trace-formula)
+(%autoprove forcing-logic.formulap-of-rw.trace-formula
+            (%enable default rw.trace-formula))
+(%autoprove forcing-logic.formula-atblp-of-rw.trace-formula
+            (%enable default rw.trace-formula))
+
+(%defprojection :list (rw.trace-list-formulas x)
+                :element (rw.trace-formula x))
+(%autoprove forcing-logic.formula-listp-of-rw.trace-list-formulas
+            (%cdr-induction x))
+(%autoprove forcing-logic.formula-list-atblp-of-rw.trace-list-formulas
+            (%cdr-induction x))
+
+
+(local (%enable default rw.trace-conclusion-formula rw.trace-formula))
+
+(%autoprove logic.all-atomicp-of-rw.trace-list-conclusion-formulas
+            (%cdr-induction x))
+(%autoprove logic.all-atomicp-of-rw.trace-list-conclusion-formulas-free)
+
+(%autoprove logic.=rhses-of-rw.trace-list-conclusion-formulas
+            (%cdr-induction x)
+            (%auto)
+            ;; BOZO why?? I had to add this after adding outside-in rules.
+            (%fertilize (LOGIC.=RHSES (RW.TRACE-LIST-CONCLUSION-FORMULAS X2))
+                        (REPEAT ''T (LEN X2))))
+(%autoprove logic.=rhses-of-rw.trace-list-conclusion-formulas-free)
+
+(%autoprove logic.all-functionsp-of-logic.=lhses-of-rw.trace-list-conclusion-formulas
+            (%cdr-induction x))
+(%autoprove logic.all-functionsp-of-logic.=lhses-of-rw.trace-list-conclusion-formulas-free)
+
+(%autoprove logic.strip-function-names-of-logic.=lhses-of-rw.trace-list-conclusion-formulas
+            (%cdr-induction x))
+(%autoprove logic.strip-function-names-of-logic.=lhses-of-rw.trace-list-conclusion-formulas-free)
+
+(%autoprove strip-lens-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-conclusion-formulas
+            (%cdr-induction x))
+(%autoprove strip-lens-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-conclusion-formulas-free)
+
+(%autoprove strip-firsts-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-lhses
+            (%cdr-induction x))
+(%autoprove strip-firsts-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-lhses-free)
+
+(%autoprove strip-seconds-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-lhses
+            (%cdr-induction x))
+(%autoprove strip-seconds-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-lhses-free)
+
+(local (%enable default forcing-equal-of-logic.por-list-rewrite))
+
+(%autoprove rw.trace-list-formulas-when-all-equalp-of-rw.trace-list-hypboxes
+            (%cdr-induction x)
+            (%splitlimit 10))
+
+
+
+(%autoadmit rw.faster-flag-tracep)
+(%autoadmit rw.faster-tracep)
+(%autoadmit rw.faster-trace-listp)
+
+(%autoprove definition-of-rw.faster-tracep
+            (%restrict default rw.faster-flag-tracep (equal x 'x))
+            (%enable default rw.faster-tracep rw.faster-trace-listp))
+
+(%autoprove definition-of-rw.faster-trace-listp
+            (%restrict default rw.faster-flag-tracep (equal x 'x))
+            (%enable default rw.faster-tracep rw.faster-trace-listp))
+
+(%autoprove rw.faster-flag-tracep-of-term
+            (%enable default rw.faster-tracep))
+
+(%autoprove rw.faster-flag-tracep-of-list
+            (%enable default rw.faster-trace-listp))
+
+(%autoprove rw.faster-trace-listp-when-not-consp
+            (%restrict default definition-of-rw.faster-trace-listp (equal x 'x)))
+
+(%autoprove rw.faster-trace-listp-of-cons
+            (%restrict default definition-of-rw.faster-trace-listp (equal x '(cons a x))))
+
+(%autoprove lemma-for-rw.faster-tracep-removal
+            (%autoinduct rw.faster-flag-tracep flag x hypbox)
+            (%forcingp nil)
+            (%restrict default definition-of-rw.faster-tracep (equal x 'x))
+            (%restrict default definition-of-rw.tracep (equal x 'x)))
+
+(%autoprove rw.faster-tracep-removal
+            (%use (%instance (%thm lemma-for-rw.faster-tracep-removal)
+                             (flag 'term))))
+
+(%autoprove rw.faster-trace-listp-removal
+            (%use (%instance (%thm lemma-for-rw.faster-tracep-removal)
+                             (flag 'list))))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/tracep")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/transitivity-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/transitivity-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/transitivity-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/transitivity-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,132 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fail-compiler")
+(%interactive)
+
+(%autoadmit rw.compile-transitivity-trace)
+
+(local (%splitlimit 20)) ;; BOZO Consider this globally at this level
+
+(local (%enable default
+                rw.transitivity-tracep
+                rw.compile-transitivity-trace
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                equal-of-2-and-len))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 unusual-consp-rules
+                 expensive-term/formula-inference))
+
+(local (%disable default
+                 logic.appealp-of-car-when-logic.appeal-listp
+                 logic.appealp-of-second-when-logic.appeal-listp
+                 logic.appealp-when-memberp-of-logic.appeal-listp
+                 logic.appeal-listp-of-cdr-when-logic.appeal-listp
+                 logic.proofp-when-memberp-of-logic.proof-listp
+                 logic.proofp-of-car-when-logic.proof-listp
+                 logic.proof-listp-of-cdr-when-logic.proof-listp
+                 rw.tracep-of-car-when-rw.trace-listp
+                 rw.trace-listp-of-cdr-when-rw.trace-listp
+                 rw.trace-listp-when-not-consp
+                 logic.appeal-listp-when-not-consp
+                 logic.proofp-when-not-consp
+                 logic.proof-listp-when-not-consp
+                 logic.strip-conclusions-when-not-consp
+                 rw.trace-list-formulas-when-not-consp
+                 rw.tracep-when-memberp-of-rw.trace-listp
+                 forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                 forcing-equal-of-logic.function-with-two-args-alt))
+
+(%autoprove rw.compile-transitivity-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-transitivity-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%forcingp nil)
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%enable default formula-decomposition)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pors
+                      equal-of-2-and-len)
+            (%auto :strategy (split cleanup urewrite crewrite)))
+
+
+(%autoprove logic.conclusion-of-rw.compile-transitivity-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%auto :strategy (split cleanup urewrite crewrite))
+            (%enable default formula-decomposition)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pnots
+                      aggressive-equal-of-logic.pors
+                      equal-of-2-and-len)
+            (%auto :strategy (split cleanup urewrite crewrite)))
+
+(encapsulate
+ ()
+ (local (%max-proof-size 700000000))
+ (%autoprove logic.proofp-of-rw.compile-transitivity-trace
+             (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+             (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+             (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+             (%restrict default definition-of-logic.proof-listp  (memberp x '(proofs (cdr proofs))))
+             (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+             (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+             (%auto :strategy (split cleanup urewrite crewrite))
+             (%enable default formula-decomposition)
+             (%disable default
+                       aggressive-equal-of-logic.pequals
+                       aggressive-equal-of-logic.pnots
+                       aggressive-equal-of-logic.pors
+                       equal-of-2-and-len)
+             (%auto :strategy (split cleanup urewrite crewrite))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/urewrite-if-general-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/urewrite-if-general-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/urewrite-if-general-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/urewrite-if-general-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,139 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-urewrite-if-generalcase-trace)
+
+(local (%splitlimit 20)) ;; BOZO Consider this globally at this level
+
+(local (%enable default
+                rw.compile-urewrite-if-generalcase-trace
+                rw.urewrite-if-generalcase-tracep
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                equal-of-3-and-len))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 unusual-consp-rules
+                 expensive-term/formula-inference))
+
+(local (%disable default
+                 logic.appealp-of-car-when-logic.appeal-listp
+                 logic.appealp-of-second-when-logic.appeal-listp
+                 logic.appealp-when-memberp-of-logic.appeal-listp
+                 logic.appeal-listp-of-cdr-when-logic.appeal-listp
+                 logic.proofp-when-memberp-of-logic.proof-listp
+                 logic.proofp-of-car-when-logic.proof-listp
+                 logic.proof-listp-of-cdr-when-logic.proof-listp
+                 rw.tracep-of-car-when-rw.trace-listp
+                 rw.trace-listp-of-cdr-when-rw.trace-listp
+                 rw.trace-listp-when-not-consp
+                 logic.appeal-listp-when-not-consp
+                 logic.proofp-when-not-consp
+                 logic.proof-listp-when-not-consp
+                 logic.strip-conclusions-when-not-consp
+                 rw.trace-list-formulas-when-not-consp
+                 rw.tracep-when-memberp-of-rw.trace-listp
+                 forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                 forcing-equal-of-logic.function-with-two-args-alt))
+
+
+
+(%autoprove rw.compile-urewrite-if-generalcase-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-urewrite-if-generalcase-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs) (cdr (cdr proofs)))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs) (cdr (cdr proofs)))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x)
+                                                                             (cdr (rw.trace->subtraces x))
+                                                                             (cdr (cdr (rw.trace->subtraces x)))
+                                                                             )))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x)
+                                                                             (cdr (rw.trace->subtraces x))
+                                                                             (cdr (cdr (rw.trace->subtraces x)))
+                                                                             ))))
+
+(%autoprove logic.conclusion-of-rw.compile-urewrite-if-generalcase-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs) (cdr (cdr proofs)))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs) (cdr (cdr proofs)))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x)
+                                                                             (cdr (rw.trace->subtraces x))
+                                                                             (cdr (cdr (rw.trace->subtraces x)))
+                                                                             )))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x)
+                                                                             (cdr (rw.trace->subtraces x))
+                                                                             (cdr (cdr (rw.trace->subtraces x)))
+                                                                             )))
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots
+                      logic.termp-when-logic.formulap
+                      logic.formulap-when-logic.termp
+                      ;; not disabling these makes the proof eggnormous
+                      forcing-equal-of-logic.pequal-rewrite
+                      forcing-equal-of-logic.pequal-rewrite-two
+                      ))
+
+(%autoprove logic.proofp-of-rw.compile-urewrite-if-generalcase-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs) (cdr (cdr proofs)))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs) (cdr (cdr proofs)))))
+            (%restrict default definition-of-logic.proof-listp  (memberp x '(proofs (cdr proofs) (cdr (cdr proofs)))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x)
+                                                                             (cdr (rw.trace->subtraces x))
+                                                                             (cdr (cdr (rw.trace->subtraces x)))
+                                                                             )))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x)
+                                                                             (cdr (rw.trace->subtraces x))
+                                                                             (cdr (cdr (rw.trace->subtraces x)))
+                                                                             ))))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/urewrite-if-same-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/urewrite-if-same-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/urewrite-if-same-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/urewrite-if-same-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,114 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-urewrite-if-specialcase-same-trace)
+
+(local (%splitlimit 20)) ;; BOZO Consider this globally at this level
+
+(local (%enable default
+                rw.compile-urewrite-if-specialcase-same-trace
+                rw.urewrite-if-specialcase-same-tracep
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                equal-of-2-and-len))
+
+(local (%disable default
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 type-set-like-rules
+                 expensive-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 formula-decomposition
+                 unusual-consp-rules
+                 expensive-term/formula-inference))
+
+(local (%disable default
+                 logic.appealp-of-car-when-logic.appeal-listp
+                 logic.appealp-of-second-when-logic.appeal-listp
+                 logic.appealp-when-memberp-of-logic.appeal-listp
+                 logic.appeal-listp-of-cdr-when-logic.appeal-listp
+                 logic.proofp-when-memberp-of-logic.proof-listp
+                 logic.proofp-of-car-when-logic.proof-listp
+                 logic.proof-listp-of-cdr-when-logic.proof-listp
+                 rw.tracep-of-car-when-rw.trace-listp
+                 rw.trace-listp-of-cdr-when-rw.trace-listp
+                 rw.trace-listp-when-not-consp
+                 logic.appeal-listp-when-not-consp
+                 logic.proofp-when-not-consp
+                 logic.proof-listp-when-not-consp
+                 logic.strip-conclusions-when-not-consp
+                 rw.trace-list-formulas-when-not-consp
+                 rw.tracep-when-memberp-of-rw.trace-listp
+                 forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                 forcing-equal-of-logic.function-with-two-args-alt))
+
+(%autoprove rw.compile-urewrite-if-specialcase-same-trace-under-iff)
+
+(%autoprove logic.appealp-of-rw.compile-urewrite-if-specialcase-same-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x))))))
+
+(%autoprove logic.conclusion-of-rw.compile-urewrite-if-specialcase-same-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots
+                      logic.termp-when-logic.formulap
+                      logic.formulap-when-logic.termp
+                      forcing-equal-of-logic.pequal-rewrite
+                      forcing-equal-of-logic.pequal-rewrite-two))
+
+(%autoprove logic.proofp-of-rw.compile-urewrite-if-specialcase-same-trace
+            (%use (%instance (%thm forcing-rw.trace-listp-of-rw.trace->subtraces)))
+            (%restrict default logic.strip-conclusions          (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.appeal-listp (memberp x '(proofs (cdr proofs))))
+            (%restrict default definition-of-logic.proof-listp  (memberp x '(proofs (cdr proofs))))
+            (%restrict default rw.trace-list-formulas           (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x)))))
+            (%restrict default definition-of-rw.trace-listp     (memberp x '((rw.trace->subtraces x) (cdr (rw.trace->subtraces x))))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/urewrite-recognizers.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/urewrite-recognizers.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/urewrite-recognizers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/urewrite-recognizers.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,64 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tracep")
+(%interactive)
+
+
+(%autoadmit rw.urewrite-if-specialcase-same-tracep)
+
+(%autoprove booleanp-of-rw.urewrite-if-specialcase-same-tracep
+            (%enable default rw.urewrite-if-specialcase-same-tracep))
+
+
+(%autoadmit rw.urewrite-if-generalcase-tracep)
+
+(%autoprove booleanp-of-rw.urewrite-if-generalcase-tracep
+            (%enable default rw.urewrite-if-generalcase-tracep))
+
+
+(%autoadmit rw.urewrite-rule-tracep)
+
+(%autoprove booleanp-of-rw.urewrite-rule-tracep
+            (%enable default rw.urewrite-rule-tracep))
+
+
+(%autoadmit rw.urewrite-rule-trace-env-okp)
+
+(%autoprove booleanp-of-rw.urewrite-rule-trace-env-okp
+            (%enable default rw.urewrite-rule-trace-env-okp))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/urewrite-recognizers")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/urewrite-rule-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/urewrite-rule-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/urewrite-rule-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/urewrite-rule-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,57 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-urewrite-rule-trace)
+
+(local (%enable default
+                rw.urewrite-rule-tracep
+                rw.compile-urewrite-rule-trace
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                rw.rule-env-okp
+                rw.urewrite-rule-trace-env-okp
+                logic.term-formula))
+
+(%autoprove rw.compile-urewrite-rule-trace-under-iff)
+
+(%autoprove forcing-logic.appealp-of-rw.compile-urewrite-rule-trace)
+
+(%autoprove forcing-logic.conclusion-of-rw.compile-urewrite-rule-trace)
+
+(%autoprove forcing-logic.proofp-of-rw.compile-urewrite-rule-trace)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level8/weakening-compiler.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level8/weakening-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level8/weakening-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level8/weakening-compiler.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,58 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(%interactive)
+
+(%autoadmit rw.compile-weakening-trace)
+
+(local (%enable default
+                rw.trace-conclusion-formula
+                rw.trace-formula
+                rw.weakening-tracep
+                rw.compile-weakening-trace))
+
+(local (%disable default
+                 forcing-logic.function-of-logic.function-name-and-logic.function-args-free))
+
+(%autoprove rw.compile-weakening-trace-under-iff)
+
+(%autoprove forcing-logic.appealp-of-rw.compile-weakening-trace)
+
+(%autoprove forcing-logic.conclusion-of-rw.compile-weakening-trace
+            (%forcingp nil))
+
+(%autoprove forcing-logic.proofp-of-rw.compile-weakening-trace)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level9/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/acl2-customization.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/add-equality.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/add-equality.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/add-equality.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/add-equality.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,522 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqdatabasep")
+(include-book "try-equiv-database")
+(%interactive)
+
+(%autoprove forcing-uniquep-of-remove-all)
+
+(%autoprove memberp-when-not-memberp-of-cdr)
+
+(%autoprove equal-of-rw.eqset->heads-when-uniquep-of-rw.eqset-list-heads
+            (%cdr-induction eqsets)
+            (%enable default memberp-when-not-memberp-of-cdr))
+
+(%autoprove uniquep-when-mutually-disjointp-and-cons-listp
+            (%cdr-induction x))
+
+(%autoprove rw.eqset-list-heads-of-remove-all
+            (%cdr-induction x))
+
+(%autoprove memberp-of-rw.eqset-list-rhses-when-memberp
+            (%cdr-induction eqsets)
+            (%enable default rw.eqset->rhses))
+
+(%autoprove cons-listp-of-rw.eqset-list-rhses
+            (%cdr-induction eqsets)
+            (%enable default rw.eqset->rhses))
+
+(%autoprove uniquep-of-rw.eqset-list-rhses-when-mutually-disjointp)
+
+(%autoprove lemma-for-rw.eqset-list-rhses-of-remove-all-when-mutually-disjointp
+            (%use (%instance (%thm equal-when-length-different)
+                             (a (rw.eqset-list-rhses (remove-all a x)))
+                             (b (rw.eqset-list-rhses x)))))
+
+(%autoprove rw.eqset-list-rhses-of-remove-all-when-mutually-disjointp
+            (%cdr-induction eqsets)
+            (%enable default lemma-for-rw.eqset-list-rhses-of-remove-all-when-mutually-disjointp))
+
+(%autoprove lemma-for-disjointp-of-rw.eqtrace-list-rhses-when-mutually-disjointp-of-rw.eqset-list-rhses
+            (%cdr-induction eqsets)
+            (%enable default rw.eqset->rhses memberp-when-not-memberp-of-cdr))
+
+(%autoprove disjointp-of-rw.eqtrace-list-rhses-when-mutually-disjointp-of-rw.eqset-list-rhses
+            (%enable default lemma-for-disjointp-of-rw.eqtrace-list-rhses-when-mutually-disjointp-of-rw.eqset-list-rhses))
+
+
+
+(defsection rw.eqtrace-list-update
+
+  (%defprojection :list (rw.eqtrace-list-update iffp e x)
+                  :element (rw.trans1-eqtrace iffp e x))
+
+  (%autoprove rw.eqtrace-list-iffps-of-rw.eqtrace-list-update
+              (%cdr-induction x))
+
+  (%autoprove rw.eqtrace-list-lhses-of-rw.eqtrace-list-update
+              (%cdr-induction x))
+
+  (%autoprove rw.eqtrace-list-rhses-of-rw.eqtrace-list-update
+              (%cdr-induction x))
+
+  (%autoprove forcing-rw.eqtrace-listp-of-rw.eqtrace-list-update
+              (%cdr-induction x))
+
+  (%autoprove forcing-rw.eqtrace-list-atblp-of-rw.eqtrace-list-update
+              (%cdr-induction x))
+
+  (%autoprove forcing-rw.eqtrace-list-okp-of-rw.eqtrace-list-update
+              (%cdr-induction x)))
+
+
+
+
+(defsection rw.find-relevant-eqset
+
+  (%autoadmit rw.eqset-relevant)
+  (%autoadmit rw.find-relevant-eqset)
+  (local (%enable default rw.eqset-relevant))
+  (local (%restrict default rw.find-relevant-eqset (equal eqsets 'eqsets)))
+
+  (%autoprove forcing-rw.eqsetp-of-rw.find-relevant-eqset
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove forcing-rw.eqset-lookup-of-rw.find-relevant-eqset-under-iff
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove forcing-memberp-of-rw.find-relevant-eqset
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove forcing-rw.eqeqset-relevant-of-rw.find-relevant-eqset
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove forcing-rw.eqset->iffp-of-rw.find-relevant-eqset-when-all-equalp
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove memberp-of-rw.eqtrace-list-rhses-when-irrelevant
+              (%enable default rw.eqset-lookup))
+
+  (%autoprove memberp-of-rw.eqtrace-list-rhses-when-irrelevant-from-all
+              (%autoinduct rw.find-relevant-eqset)
+              (%enable default rw.eqset->rhses))
+
+  (%autoprove memberp-of-rw.eqtrace-list-rhses-when-memberp-of-irrelevant-from-all
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove equal-to-rw.eqset->head-when-memberp-of-irrelevant-from-all
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove memberp-of-rw.eqset-list-heads-when-all-irrelevant
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove memberp-of-rw.eqtrace->lhs-in-rw.eqset-list-heads-when-no-relevant-sets
+              (%autoinduct rw.find-relevant-eqset))
+
+  (%autoprove rw.eqset->head-of-rw.find-relevant-eqset-when-among-heads
+              (%autoinduct rw.find-relevant-eqset)
+              (%enable default rw.eqset-lookup rw.eqset->rhses)))
+
+
+
+
+(defsection rw.join-eqsets
+
+  (%autoadmit rw.join-eqsets)
+
+  (local (%enable default
+                  rw.join-eqsets
+                  rw.eqset-relevant
+                  rw.eqset->rhses
+                  rw.eqtrace-list-iffps-of-rev
+                  [outside]rw.eqtrace-list-iffps-of-rev
+                  rw.eqtrace-list-lhses-of-rev
+                  [outside]rw.eqtrace-list-lhses-of-rev
+                  rw.eqtrace-list-rhses-of-rev
+                  [outside]rw.eqtrace-list-lhses-of-rev))
+
+  (local (%disable default
+                   rev-of-rw.eqtrace-list-iffps
+                   [outside]rev-of-rw.eqtrace-list-iffps
+                   rev-of-rw.eqtrace-list-lhses
+                   [outside]rev-of-rw.eqtrace-list-lhses
+                   rev-of-rw.eqtrace-list-rhses
+                   [outside]rev-of-rw.eqtrace-list-rhses))
+
+  (%autoprove lemma-for-rw.join-eqsets
+              (%disable default transitivity-of-logic.term-< forcing-transitivity-of-logic.term-<-three)
+              (%use (%instance (%thm transitivity-of-logic.term-<)
+                               (x (rw.eqset->head lhs-set))
+                               (y (rw.eqtrace->lhs trace))
+                               (z (rw.eqtrace->rhs trace))))
+              (%auto)
+              (%fertilize (rw.eqset->head rhs-set) (rw.eqtrace->rhs trace))
+              (%auto))
+
+  (local (%enable default lemma-for-rw.join-eqsets))
+
+  (%autoprove forcing-rw.eqsetp-of-rw.join-eqsets)
+  (%autoprove forcing-rw.eqset-atblp-of-rw.join-eqsets)
+  (%autoprove forcing-rw.eqset-okp-of-rw.join-eqsets)
+  (%autoprove forcing-rw.eqset->iffp-of-rw.join-eqsets)
+  (%autoprove forcing-rw.eqtrace-list-rhses-of-rw.eqset->tail-of-rw.join-eqsets)
+  (%autoprove forcing-rw.eqset->head-of-rw.join-eqsets))
+
+
+(defsection rw.eqset-extend
+  (%autoadmit rw.eqset-extend)
+  (local (%enable default rw.eqset-extend))
+  (%autoprove forcing-rw.eqsetp-of-rw.eqset-extend)
+  (%autoprove forcing-rw.eqset-atblp-of-rw.eqset-extend)
+  (%autoprove forcing-rw.eqset-okp-of-rw.eqset-extend)
+  (%autoprove forcing-rw.eqset->iffp-of-rw.eqset-extend)
+  (%autoprove choices-for-rw.eqset->head-of-rw.eqset-extend))
+
+
+
+(defsection rw.eqsets-extend
+
+  (%autoadmit rw.eqsets-extend)
+  (local (%enable default rw.eqsets-extend rw.eqset->rhses))
+  (%autoprove forcing-rw.eqset-listp-of-rw.eqsets-extend)
+  (%autoprove forcing-rw.eqset-list-atblp-of-rw.eqsets-extend)
+  (%autoprove forcing-rw.eqrow-list-okp-of-rw.eqsets-extend)
+
+
+  (%autoprove lemma-for-forcing-rw.eqset-list-iffps-of-rw.eqsets-extend)
+  (%autoprove forcing-rw.eqset-list-iffps-of-rw.eqsets-extend
+              (%use (%thm lemma-for-forcing-rw.eqset-list-iffps-of-rw.eqsets-extend))
+              (%enable default all-equalp-removal)
+              (%disable default rw.eqsets-extend))
+
+  (%autoprove forcing-uniquep-of-rw.eqset-list-heads-of-rw.eqsets-extend
+              (%auto)
+              (%use (%instance (%thm choices-for-rw.eqset->head-of-rw.eqset-extend)
+                               (trace trace)
+                               (eqset (rw.find-relevant-eqset (rw.eqtrace->rhs trace) eqsets))))
+              (%auto)
+              (%use (%instance (%thm choices-for-rw.eqset->head-of-rw.eqset-extend)
+                               (trace trace)
+                               (eqset (rw.find-relevant-eqset (rw.eqtrace->lhs trace) eqsets)))))
+
+  (%autoprove lemma-for-forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqsets-extend
+              (%cdr-induction eqsets))
+
+  (%autoprove forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqsets-extend
+              (%enable default
+                       lemma-for-forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqsets-extend
+                       rw.eqset-extend
+                       rw.eqtrace-list-rhses-of-rev)
+              (%disable default
+                        rev-of-rw.eqtrace-list-rhses
+                        [outside]rev-of-rw.eqtrace-list-rhses))
+
+
+
+  (defsection disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+
+    ;; ACL2 seems smarter than Milawa and doesn't need these lemmas.
+    (defthmd lemma-1-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+      (implies (force (rw.eqtracep x))
+               (equal (equal (rw.eqtrace->lhs x) (rw.eqtrace->rhs x))
+                      nil))
+      :hints(("goal" :use ((:instance forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs)))))
+
+    (defthmd lemma-2-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+      (implies (rw.eqtracep x)
+               (iff (rw.eqtrace->lhs x)
+                    t))
+      :hints(("Goal" :in-theory (enable definition-of-rw.eqtracep
+                                        rw.eqtrace->lhs))))
+
+    (defthmd lemma-3-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+      (implies (and (disjoint-from-allp heads rhses)
+                    (memberp a rhses))
+               (equal (disjointp a (remove-all b heads))
+                      t)))
+
+    (%autoprove lemma-1-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+                (%use (%instance (%thm forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs))))
+
+    (%autoprove lemma-2-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+                (%enable default definition-of-rw.eqtracep rw.eqtrace->lhs))
+
+    (%autoprove lemma-3-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend)
+
+    (%autoprove disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+                (%enable default
+                         rw.eqsets-extend
+                         rw.eqset-extend
+                         rw.eqset->rhses
+                         rw.eqtrace-list-rhses-of-rev
+                         lemma-for-forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqsets-extend
+                         lemma-1-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+                         lemma-2-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+                         lemma-3-for-disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend)
+                (%disable default
+                          rev-of-rw.eqtrace-list-rhses
+                          [outside]rev-of-rw.eqtrace-list-rhses)
+                (%disable default
+                          formula-decomposition
+                          expensive-arithmetic-rules
+                          expensive-arithmetic-rules-two
+                          type-set-like-rules
+                          same-length-prefixes-equal-cheap
+                          unusual-consp-rules
+                          expensive-term/formula-inference
+                          unusual-memberp-rules
+                          unusual-subsetp-rules))))
+
+
+
+
+(defsection rw.eqdatabase-extend
+  (%autoadmit rw.eqdatabase-extend)
+  (local (%enable default rw.eqdatabase-extend))
+  (%autoprove rw.eqdatabasep-of-rw.eqdatabase-extend)
+  (%autoprove rw.eqdatabase-atblp-of-rw.eqdatabase-extend)
+  (%autoprove rw.eqdatabase-okp-of-rw.eqdatabase-extend))
+
+
+(defsection rw.primary-eqtrace-okp-in-extended-hypbox
+
+  (defthmd lemma-1-for-rw.primary-eqtrace-okp-in-extended-hypbox
+    ;; BOZO unlocalize
+    (implies (and (equal (rw.primary-eqtrace t nhyp) trace)
+                  (memberp nhyp x)
+                  (force (logic.term-listp x)))
+             (iff (rw.find-nhyp-for-primary-eqtracep x trace)
+                  t))
+    :hints(("Goal" :in-theory (enable rw.find-nhyp-for-primary-eqtracep))))
+
+  (defthmd lemma-2-for-rw.primary-eqtrace-okp-in-extended-hypbox
+    ;; BOZO unlocalize
+    (implies (and (subsetp sub sup)
+                  (rw.find-nhyp-for-primary-eqtracep sub trace)
+                  (force (logic.term-listp sub))
+                  (force (logic.term-listp sup)))
+             (iff (rw.find-nhyp-for-primary-eqtracep sup trace)
+                  t))
+    :hints(("Goal" :use ((:instance lemma-1-for-rw.primary-eqtrace-okp-in-extended-hypbox
+                                    (nhyp (rw.find-nhyp-for-primary-eqtracep sub trace))
+                                    (x sup))))))
+
+  (%autoprove lemma-1-for-rw.primary-eqtrace-okp-in-extended-hypbox
+              (%autoinduct rw.find-nhyp-for-primary-eqtracep x trace)
+              (%restrict default rw.find-nhyp-for-primary-eqtracep (equal nhyps 'x)))
+
+  (%autoprove lemma-2-for-rw.primary-eqtrace-okp-in-extended-hypbox
+              (%use (%instance (%thm lemma-1-for-rw.primary-eqtrace-okp-in-extended-hypbox)
+                               (nhyp (rw.find-nhyp-for-primary-eqtracep sub trace))
+                               (x sup))))
+
+  (%autoprove rw.primary-eqtrace-okp-in-extended-hypbox
+              (%enable default
+                       rw.primary-eqtrace-okp
+                       lemma-1-for-rw.primary-eqtrace-okp-in-extended-hypbox
+                       lemma-2-for-rw.primary-eqtrace-okp-in-extended-hypbox)))
+
+
+
+(defsection rw.secondary-eqtrace-okp-in-extended-hypbox
+
+  (defthmd lemma-1-for-rw.secondary-eqtrace-okp-in-extended-hypbox
+    ;; BOZO unlocalize
+    (implies (and (equal (rw.secondary-eqtrace t nhyp) trace)
+                  (memberp nhyp x)
+                  (force (logic.term-listp x)))
+             (iff (rw.find-nhyp-for-secondary-eqtracep x trace)
+                  t))
+    :hints(("Goal" :in-theory (enable rw.find-nhyp-for-secondary-eqtracep))))
+
+  (defthmd lemma-2-for-rw.secondary-eqtrace-okp-in-extended-hypbox
+    ;; BOZO unlocalize
+    (implies (and (subsetp sub sup)
+                  (rw.find-nhyp-for-secondary-eqtracep sub trace)
+                  (force (logic.term-listp sub))
+                  (force (logic.term-listp sup)))
+             (iff (rw.find-nhyp-for-secondary-eqtracep sup trace)
+                  t))
+    :hints(("Goal" :use ((:instance lemma-1-for-rw.secondary-eqtrace-okp-in-extended-hypbox
+                                    (nhyp (rw.find-nhyp-for-secondary-eqtracep sub trace))
+                                    (x sup))))))
+
+  (%autoprove lemma-1-for-rw.secondary-eqtrace-okp-in-extended-hypbox
+              (%autoinduct rw.find-nhyp-for-secondary-eqtracep x trace)
+              (%restrict default rw.find-nhyp-for-secondary-eqtracep (equal nhyps 'x)))
+
+  (%autoprove lemma-2-for-rw.secondary-eqtrace-okp-in-extended-hypbox
+              (%use (%instance (%thm lemma-1-for-rw.secondary-eqtrace-okp-in-extended-hypbox)
+                               (nhyp (rw.find-nhyp-for-secondary-eqtracep sub trace))
+                               (x sup))))
+
+  (%autoprove rw.secondary-eqtrace-okp-in-extended-hypbox
+              (%enable default
+                       rw.secondary-eqtrace-okp
+                       lemma-1-for-rw.secondary-eqtrace-okp-in-extended-hypbox
+                       lemma-2-for-rw.secondary-eqtrace-okp-in-extended-hypbox)))
+
+
+
+(defsection rw.direct-iff-eqtrace-okp-in-extended-hypbox
+
+  (defthmd lemma-1-for-rw.direct-iff-eqtrace-okp-in-extended-hypbox
+    ;; BOZO unlocalize
+    (implies (and (equal (rw.direct-iff-eqtrace t nhyp) trace)
+                  (memberp nhyp x)
+                  (force (logic.term-listp x)))
+             (iff (rw.find-nhyp-for-direct-iff-eqtracep x trace)
+                  t))
+    :hints(("Goal" :in-theory (enable rw.find-nhyp-for-direct-iff-eqtracep))))
+
+  (defthmd lemma-2-for-rw.direct-iff-eqtrace-okp-in-extended-hypbox
+    ;; BOZO unlocalize
+    (implies (and (subsetp sub sup)
+                  (rw.find-nhyp-for-direct-iff-eqtracep sub trace)
+                  (force (logic.term-listp sub))
+                  (force (logic.term-listp sup)))
+             (iff (rw.find-nhyp-for-direct-iff-eqtracep sup trace)
+                  t))
+    :hints(("Goal" :use ((:instance lemma-1-for-rw.direct-iff-eqtrace-okp-in-extended-hypbox
+                                    (nhyp (rw.find-nhyp-for-direct-iff-eqtracep sub trace))
+                                    (x sup))))))
+
+  (%autoprove lemma-1-for-rw.direct-iff-eqtrace-okp-in-extended-hypbox
+              (%autoinduct rw.find-nhyp-for-direct-iff-eqtracep x trace)
+              (%restrict default rw.find-nhyp-for-direct-iff-eqtracep (equal nhyps 'x)))
+
+  (%autoprove lemma-2-for-rw.direct-iff-eqtrace-okp-in-extended-hypbox
+              (%use (%instance (%thm lemma-1-for-rw.direct-iff-eqtrace-okp-in-extended-hypbox)
+                               (nhyp (rw.find-nhyp-for-direct-iff-eqtracep sub trace))
+                               (x sup))))
+
+  (%autoprove rw.direct-iff-eqtrace-okp-in-extended-hypbox
+              (%enable default
+                       rw.direct-iff-eqtrace-okp
+                       lemma-1-for-rw.direct-iff-eqtrace-okp-in-extended-hypbox
+                       lemma-2-for-rw.direct-iff-eqtrace-okp-in-extended-hypbox)))
+
+
+
+(defsection rw.negative-iff-eqtrace-okp-in-extended-hypbox
+
+  (defthmd lemma-1-for-rw.negative-iff-eqtrace-okp-in-extended-hypbox
+    ;; BOZO unlocalize
+    (implies (and (equal (rw.negative-iff-eqtrace t nhyp) trace)
+                  (memberp nhyp x)
+                  (force (logic.term-listp x)))
+             (iff (rw.find-nhyp-for-negative-iff-eqtracep x trace)
+                  t))
+    :hints(("Goal" :in-theory (enable rw.find-nhyp-for-negative-iff-eqtracep))))
+
+  (defthmd lemma-2-for-rw.negative-iff-eqtrace-okp-in-extended-hypbox
+    (implies (and (subsetp sub sup)
+                  (rw.find-nhyp-for-negative-iff-eqtracep sub trace)
+                  (force (logic.term-listp sub))
+                  (force (logic.term-listp sup)))
+             (iff (rw.find-nhyp-for-negative-iff-eqtracep sup trace)
+                  t))
+    :hints(("Goal" :use ((:instance lemma-1-for-rw.negative-iff-eqtrace-okp-in-extended-hypbox
+                                    (nhyp (rw.find-nhyp-for-negative-iff-eqtracep sub trace))
+                                    (x sup))))))
+
+  (%autoprove lemma-1-for-rw.negative-iff-eqtrace-okp-in-extended-hypbox
+              (%autoinduct rw.find-nhyp-for-negative-iff-eqtracep x trace)
+              (%restrict default rw.find-nhyp-for-negative-iff-eqtracep (equal nhyps 'x)))
+
+  (%autoprove lemma-2-for-rw.negative-iff-eqtrace-okp-in-extended-hypbox
+              (%use (%instance (%thm lemma-1-for-rw.negative-iff-eqtrace-okp-in-extended-hypbox)
+                               (nhyp (rw.find-nhyp-for-negative-iff-eqtracep sub trace))
+                               (x sup))))
+
+  (%autoprove rw.negative-iff-eqtrace-okp-in-extended-hypbox
+              (%enable default
+                       rw.negative-iff-eqtrace-okp
+                       lemma-1-for-rw.negative-iff-eqtrace-okp-in-extended-hypbox
+                       lemma-2-for-rw.negative-iff-eqtrace-okp-in-extended-hypbox)))
+
+
+
+(defsection forcing-rw.eqtrace-okp-in-extended-hypbox
+
+  ;; BOZO switch this to a defthms-flag and unlocalize.
+
+  (local (in-theory (disable forcing-rw.eqtrace-list-okp-of-rw.eqtrace-subtraces)))
+  (defthm lemma-for-forcing-rw.eqtrace-okp-in-extended-hypbox
+    (implies (and (rw.hypboxp sub)
+                  (rw.hypboxp sup)
+                  (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                  (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup)))
+             (if (equal flag 'trace)
+                 (implies (rw.eqtrace-okp x sub)
+                          (rw.eqtrace-okp x sup))
+               (implies (rw.eqtrace-list-okp x sub)
+                        (rw.eqtrace-list-okp x sup))))
+    :rule-classes nil
+    :hints(("Goal"
+            :induct (rw.flag-eqtrace-okp flag x sub)
+            :in-theory (enable definition-of-rw.eqtrace-okp
+                               rw.eqtrace-step-okp))))
+
+  (%autoprove lemma-for-forcing-rw.eqtrace-okp-in-extended-hypbox
+              (%autoinduct rw.flag-eqtrace-okp flag x sub)
+              (%restrict default definition-of-rw.eqtrace-okp (equal x 'x))
+              (%enable default rw.eqtrace-step-okp))
+
+  (%autoprove forcing-rw.eqtrace-okp-in-extended-hypbox
+              (%use (%instance (%thm lemma-for-forcing-rw.eqtrace-okp-in-extended-hypbox)
+                               (flag 'trace))))
+
+  (%autoprove forcing-rw.eqtrace-list-okp-in-extended-hypbox
+              (%use (%instance (%thm lemma-for-forcing-rw.eqtrace-okp-in-extended-hypbox)
+                               (flag 'list)))))
+
+
+
+(%autoprove rw.eqset-okp-in-extended-hypbox
+            (%forcingp nil)
+            (%enable default rw.eqset-okp))
+
+(%autoprove rw.eqset-list-okp-in-extended-hypbox
+            (%cdr-induction x))
+
+(%autoprove rw.eqdatabase-okp-in-extended-hypbox
+            (%enable default rw.eqdatabase-okp))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/add-equality")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/ancestors.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/ancestors.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/ancestors.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/ancestors.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,83 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "worse-termp")
+(%interactive)
+
+
+(%autoadmit rw.anframep)
+
+(%autoprove booleanp-of-rw.anframep
+            (%enable default rw.anframep))
+
+(%deflist rw.anstackp (x)
+          (rw.anframep x))
+
+(defsection rw.anframe-stuff
+
+  (%autoadmit rw.anframe->term)
+  (%autoadmit rw.anframe->guts)
+  (%autoadmit rw.anframe->fcount)
+  (%autoadmit rw.anframe->tokens)
+
+  (local (%enable default
+                  rw.anframep
+                  rw.anframe->term
+                  rw.anframe->guts
+                  rw.anframe->fcount
+                  rw.anframe->tokens))
+
+  (%autoprove forcing-logic.termp-of-rw.anframe->term)
+
+  (%autoprove forcing-logic.termp-of-rw.anframe->guts
+              (%auto)
+              (%fertilize (car (cdr x)) (clause.negative-term-guts (car x))))
+
+  (%autoprove forcing-rw.anframe->fcount-elimination)
+
+  (%autoadmit rw.anframe)
+
+  (%autoprove rw.anframep-of-rw.anframe
+              (%enable default rw.anframe)))
+
+
+
+(%autoadmit rw.earlier-ancestor-biggerp)
+(%autoadmit rw.ancestors-check-aux)
+(%autoadmit rw.ancestors-check)
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/ancestors")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/assmctrl.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/assmctrl.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/assmctrl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/assmctrl.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,42 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(%defaggregate rw.assmctrl
+  (primaryp secondaryp directp negativep)
+  :require ((booleanp-of-rw.assmctrl->primaryp   (booleanp primaryp))
+            (booleanp-of-rw.assmctrl->secondaryp (booleanp secondaryp))
+            (booleanp-of-rw.assmctrl->directp    (booleanp directp))
+            (booleanp-of-rw.assmctrl->negativep  (booleanp negativep))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/assms-top.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/assms-top.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/assms-top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/assms-top.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,100 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "assmsp")
+;; (include-book "contradiction-bldr")
+(%interactive)
+
+
+(%autoprove forcing-rw.eqset-okp-when-empty-box
+            (%enable default rw.eqset-okp rw.eqsetp rw.eqset->tail))
+
+(%autoprove forcing-rw.eqset-list-okp-when-empty-box
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.eqdatabase-okp-when-empty-box
+            (%enable default
+                     rw.eqdatabasep
+                     rw.eqdatabase-okp
+                     rw.eqdatabase->equalsets
+                     rw.eqdatabase->contradiction))
+
+(%autoprove rw.eqrow-list-lookup-when-not-consp
+            (%restrict default rw.eqset-list-lookup (equal eqsets 'eqsets)))
+
+(%autoprove forcing-rw.try-equalities-when-empty-box
+            (%enable default rw.try-equiv-database))
+
+
+
+
+
+(%autoadmit rw.try-assms)
+
+(%autoprove forcing-logic.termp-of-rw.try-assms
+            (%enable default rw.try-assms))
+
+(%autoprove forcing-logic.term-atblp-of-rw.try-assms
+            (%enable default rw.try-assms))
+
+(%autoprove forcing-rw.try-assms-when-empty-hypbox
+            (%enable default
+                     rw.try-assms
+                     rw.assmsp
+                     rw.assms->eqdatabase
+                     rw.assms->hypbox))
+
+
+
+(defsection rw.try-assms-bldr
+
+  (%autoadmit rw.try-assms-bldr)
+
+  (local (%enable default
+                  rw.try-assms
+                  rw.try-assms-bldr
+                  rw.eqtrace-formula))
+
+  (%autoprove forcing-logic.appealp-of-rw.try-assms-bldr)
+
+  (%autoprove forcing-logic.conclusion-of-rw.try-assms-bldr
+              (%auto)
+              ;; BOZO: ugh, this shouldn't be necessary
+              (%enable default rw.assmsp rw.assms->eqdatabase rw.assms->hypbox))
+
+  (%autoprove forcing-logic.proofp-of-rw.try-assms-bldr))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/top")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/assmsp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/assmsp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/assmsp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/assmsp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,250 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "add-equality")
+(include-book "smart-negate")
+(include-book "assmctrl")
+(%interactive)
+
+
+(defsection rw.assmsp
+
+  (%autoadmit rw.assmsp)
+  (%autoadmit rw.assms)
+  (%autoadmit rw.assms->hypbox)
+  (%autoadmit rw.assms->contradiction)
+  (%autoadmit rw.assms->eqdatabase)
+  (%autoadmit rw.assms->trueterms)
+  (%autoadmit rw.assms->ctrl)
+  (%autoadmit rw.assms-atblp)
+
+  (local (%enable default
+                  rw.assmsp
+                  rw.assms
+                  rw.assms->hypbox
+                  rw.assms->contradiction
+                  rw.assms->eqdatabase
+                  rw.assms->trueterms
+                  rw.assms->ctrl
+                  rw.assms-atblp))
+
+  (%autoprove booleanp-of-rw.assmsp)
+  (%autoprove booleanp-of-rw.assms-atblp)
+  (%autoprove forcing-rw.assmsp-of-rw.assms)
+  (%autoprove forcing-rw.assms-atblp-of-rw.assms)
+  (%autoprove rw.assms->hypbox-of-rw.assms)
+  (%autoprove rw.assms->contradiction-of-rw.assms)
+  (%autoprove rw.assms->eqdatabase-of-rw.assms)
+  (%autoprove rw.assms->trueterms-of-rw.assms)
+  (%autoprove rw.assms->ctrl-of-rw.assms)
+  (%autoprove forcing-rw.hypboxp-of-rw.assms->hypbox)
+  (%autoprove forcing-rw.hypbox-atblp-of-rw.assms->hypbox)
+  (%autoprove forcing-rw.eqdatabasep-of-rw.assms->eqdatabase)
+  (%autoprove forcing-rw.eqdatabase-okp-of-rw.assms->eqdatabase)
+  (%autoprove forcing-rw.eqdatabase-atblp-of-rw.assms->eqdatabase)
+  (%autoprove rw.assms->contradiction-when-no-assumptions)
+  (%autoprove forcing-rw.eqtracep-of-rw.assms->contradiction)
+  (%autoprove forcing-rw.eqtrace-contradictionp-of-rw.assms->contradiction)
+  (%autoprove forcing-rw.eqtrace-okp-of-rw.assms->contradiction-and-rw.assms->hypbox)
+  (%autoprove forcing-logic.term-listp-of-rw.assms->trueterms)
+  (%autoprove forcing-logic.term-list-atblp-of-rw.assms->trueterms)
+  (%autoprove forcing-rw.assmctrlp-of-rw.assms->ctrl)
+  (%autoprove forcing-equal-of-rw.assms-one)
+  (%autoprove forcing-equal-of-rw.assms-two)
+  (%autoprove rw.assms-atblp-of-nil))
+
+(%deflist rw.assms-listp (x)
+          (rw.assmsp x))
+
+(%deflist rw.assms-list-atblp (x atbl)
+          (rw.assms-atblp x atbl))
+
+
+
+(defsection rw.empty-eqdatabase
+
+  (%autoadmit rw.empty-eqdatabase)
+  (%noexec rw.empty-eqdatabase)
+
+  (local (%enable default
+                  rw.empty-eqdatabase
+                  rw.eqdatabase-atblp
+                  rw.eqdatabase-okp))
+
+  (%autoprove rw.eqdatabasep-of-rw.empty-eqdatabase)
+  (%autoprove rw.eqdatabase-atblp-of-rw.empty-eqdatabase)
+  (%autoprove rw.eqdatabase-okp-of-rw.empty-eqdatabase)
+  (%autoprove rw.eqdatabase->equalsets-of-rw.empty-eqdatabase)
+  (%autoprove rw.eqdatabase->contradiction-of-rw.empty-eqdatabase))
+
+
+
+(defsection rw.empty-assms
+
+  (%autoadmit rw.empty-assms)
+  (%noexec rw.empty-assms)
+
+  (local (%enable default rw.empty-assms))
+
+  (%autoprove rw.assmsp-of-rw.empty-assms)
+  (%autoprove rw.assms-atblp-of-rw.empty-assms (%enable default rw.assms-atblp))
+  (%autoprove rw.assms->hypbox-of-rw.empty-assms)
+  (%autoprove rw.assms->contradiction-of-rw.empty-assms)
+  (%autoprove rw.assms->eqdatabase-of-rw.empty-assms)
+  (%autoprove rw.assms->trueterms-of-rw.empty-assms)
+  (%autoprove rw.assms->ctrl-of-rw.empty-assms))
+
+
+
+
+
+(%autoprove rw.eqset-atblp-when-not-consp
+            (%enable default rw.eqset-atblp rw.eqset->tail))
+
+(%autoprove forcing-rw.eqset-atblp-of-rw.find-relevant-set
+            (%autoinduct rw.find-relevant-eqset term sets)
+            (%restrict default rw.find-relevant-eqset (equal eqsets 'sets)))
+
+
+
+(defsection rw.assume-left
+
+  (%autoadmit rw.assume-left)
+
+  (%autoprove lemma-for-rw.assume-left
+              (%disable default rw.eqdatabase-okp-in-extended-hypbox)
+              (%use (%instance (%thm rw.eqdatabase-okp-in-extended-hypbox)
+                               (sub (rw.assms->hypbox assms))
+                               (sup (rw.hypbox (cons nhyp (rw.hypbox->left (rw.assms->hypbox assms)))
+                                               (rw.hypbox->right (rw.assms->hypbox assms))))
+                               (x (rw.assms->eqdatabase assms)))))
+
+  (local (%enable default
+                  rw.assume-left
+                  lemma-for-rw.assume-left))
+
+  (%autoprove forcing-rw.assmsp-of-rw.assume-left)
+  (%autoprove forcing-rw.assms-atblp-of-rw.assume-left)
+  (%autoprove rw.assms->hypbox-of-rw.assume-left))
+
+
+
+(defsection rw.assume-right
+
+  (%autoadmit rw.assume-right)
+
+  (%autoprove lemma-for-rw.assume-right
+              (%disable default rw.eqdatabase-okp-in-extended-hypbox)
+              (%use (%instance (%thm rw.eqdatabase-okp-in-extended-hypbox)
+                               (sub (rw.assms->hypbox assms))
+                               (sup (rw.hypbox (rw.hypbox->left (rw.assms->hypbox assms))
+                                               (cons nhyp (rw.hypbox->right (rw.assms->hypbox assms)))))
+                               (x (rw.assms->eqdatabase assms)))))
+
+  (local (%enable default
+                  rw.assume-right
+                  lemma-for-rw.assume-right))
+
+  (%autoprove forcing-rw.assmsp-of-rw.assume-right)
+  (%autoprove forcing-rw.assms-atblp-of-rw.assume-right)
+  (%autoprove rw.assms->hypbox-of-rw.assume-right))
+
+
+
+(defsection rw.assume-left-list
+
+  (%autoadmit rw.assume-left-list)
+
+  (%autoprove rw.assume-left-list-when-not-consp
+              (%restrict default rw.assume-left-list (equal nhyps 'nhyps)))
+
+  (%autoprove rw.assume-left-list-of-cons
+              (%restrict default rw.assume-left-list (equal nhyps '(cons nhyp nhyps))))
+
+  (%autoprove forcing-rw.assmsp-of-rw.assume-left-list
+              (%cdr-induction nhyps))
+
+  (%autoprove forcing-rw.assms-atblp-of-rw.assume-left-list
+              (%cdr-induction nhyps))
+
+  (%autoprove forcing-rw.assms->nhyps-of-rw.assume-left-list
+              (%cdr-induction nhyps)))
+
+
+
+(defsection rw.assume-right-list
+
+  (%autoadmit rw.assume-right-list)
+
+  (%autoprove rw.assume-right-list-when-not-consp
+              (%restrict default rw.assume-right-list (equal nhyps 'nhyps)))
+
+  (%autoprove rw.assume-right-list-of-cons
+              (%restrict default rw.assume-right-list (equal nhyps '(cons nhyp nhyps))))
+
+  (%autoprove forcing-rw.assmsp-of-rw.assume-right-list
+              (%cdr-induction nhyps))
+
+  (%autoprove forcing-rw.assms-atblp-of-rw.assume-right-list
+              (%cdr-induction nhyps))
+
+  (%autoprove forcing-rw.assms->hypbox-right-of-rw.assume-right-list
+              (%cdr-induction nhyps)))
+
+
+
+
+
+(%autoadmit rw.assms-emptyp)
+
+(%autoprove booleanp-of-rw.assms-emptyp
+            (%enable default rw.assms-emptyp))
+
+(%autoprove rw.assms-emptyp-of-rw.empty-assms
+            (%enable default rw.assms-emptyp))
+
+
+
+(%autoadmit rw.assms-formula)
+
+(%autoprove forcing-logic.formulap-of-rw.assms-formula
+            (%enable default rw.assms-formula rw.assms-emptyp))
+
+(%autoprove forcing-logic.formula-atblp-of-rw.assms-formula
+            (%enable default rw.assms-formula rw.assms-emptyp))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/assmsp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/basic-builders.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/basic-builders.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/basic-builders.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/basic-builders.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,453 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "controlp")
+(%interactive)
+
+
+(%autoprove booleanp-of-rw.trace->iffp)
+
+(local (%disable default forcing-booleanp-of-rw.trace->iffp))
+(local (%enable default booleanp-of-rw.trace->iffp))
+
+
+(defsection rw.fail-trace
+
+  (%autoadmit rw.fail-trace)
+
+  (local (%enable default rw.fail-trace))
+
+  (%autoprove rw.trace->method-of-rw.fail-trace)
+  (%autoprove rw.trace->hypbox-of-rw.fail-trace)
+  (%autoprove rw.trace->lhs-of-rw.fail-trace)
+  (%autoprove rw.trace->rhs-of-rw.fail-trace)
+  (%autoprove rw.trace->iffp-of-rw.fail-trace)
+  (%autoprove rw.trace->subtraces-of-rw.fail-trace)
+  (%autoprove rw.trace->extras-of-rw.fail-trace)
+  (%autoprove forcing-rw.tracep-of-rw.fail-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.fail-trace)
+
+  (local (%disable default rw.fail-trace))
+
+  (%autoprove rw.fail-tracep-of-rw.fail-trace
+              (%enable default rw.fail-tracep))
+
+  (%autoprove rw.trace-step-okp-of-rw.fail-trace
+              (%enable default rw.trace-step-okp))
+
+  (%autoprove rw.trace-step-env-okp-of-rw.fail-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.fail-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.fail-trace hypbox term iffp))))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.fail-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.fail-trace hypbox term iffp))))
+
+  (%autoprove rw.collect-forced-goals-of-rw.fail-trace
+              (%restrict default definition-of-rw.collect-forced-goals (equal x '(rw.fail-trace hypbox term iffp)))))
+
+
+
+(defsection rw.transitivity-trace
+
+  (%autoadmit rw.transitivity-trace)
+
+  (local (%enable default rw.transitivity-trace))
+
+  (%autoprove rw.transitivity-trace-under-iff)
+  (%autoprove rw.trace->method-of-rw.transitivity-trace)
+  (%autoprove rw.trace->hypbox-of-rw.transitivity-trace)
+  (%autoprove rw.trace->lhs-of-rw.transitivity-trace)
+  (%autoprove rw.trace->rhs-of-rw.transitivity-trace)
+  (%autoprove rw.trace->iffp-of-rw.transitivity-trace)
+  (%autoprove rw.trace->subtraces-of-rw.transitivity-trace)
+  (%autoprove rw.trace->extras-of-rw.transitivity-trace)
+  (%autoprove forcing-rw.tracep-of-rw.transitivity-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.transitivity-trace)
+
+  (local (%disable default rw.transitivity-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.transitivity-trace
+              (%enable default rw.transitivity-tracep rw.trace-step-okp))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.transitivity-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.transitivity-trace x y)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.transitivity-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.transitivity-trace
+              (%enable default rw.transitivity-tracep rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.transitivity-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.transitivity-trace x y)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.transitivity-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.transitivity-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+
+(defsection rw.equiv-by-args-trace
+
+  (%autoadmit rw.equiv-by-args-trace)
+
+  (local (%enable default rw.equiv-by-args-trace))
+
+  (%autoprove lemma-rw.trace->method-of-rw.equiv-by-args-trace)
+  (%autoprove forcing-rw.trace->hypbox-of-rw.equiv-by-args-trace)
+  (%autoprove forcing-rw.trace->lhs-of-rw.equiv-by-args-trace)
+  (%autoprove forcing-rw.trace->rhs-of-rw.equiv-by-args-trace)
+  (%autoprove rw.trace->iffp-of-rw.equiv-by-args-trace)
+  (%autoprove rw.trace->subtraces-of-rw.equiv-by-args-trace)
+  (%autoprove rw.trace->extras-of-rw.equiv-by-args-trace)
+  (%autoprove forcing-rw.tracep-of-rw.equiv-by-args-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.equiv-by-args-trace)
+
+  (local (%disable default rw.equiv-by-args-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.equiv-by-args-trace
+              (%enable default rw.equiv-by-args-tracep rw.trace-step-okp))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.equiv-by-args-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.equiv-by-args-trace hypbox f iffp traces)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.equiv-by-args-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.equiv-by-args-trace
+              (%enable default rw.equiv-by-args-tracep rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.equiv-by-args-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.equiv-by-args-trace hypbox f iffp traces)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.equiv-by-args-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.equiv-by-args-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.lambda-equiv-by-args-trace
+
+  (%autoadmit rw.lambda-equiv-by-args-trace)
+
+  (local (%enable default rw.lambda-equiv-by-args-trace))
+
+  (%autoprove rw.trace->method-of-rw.lambda-equiv-by-args-trace)
+  (%autoprove rw.trace->hypbox-of-rw.lambda-equiv-by-args-trace)
+  (%autoprove rw.trace->lhs-of-rw.lambda-equiv-by-args-trace)
+  (%autoprove rw.trace->rhs-of-rw.lambda-equiv-by-args-trace)
+  (%autoprove rw.trace->iffp-of-rw.lambda-equiv-by-args-trace)
+  (%autoprove rw.trace->subtraces-of-rw.lambda-equiv-by-args-trace)
+  (%autoprove rw.trace->extras-of-rw.lambda-equiv-by-args-trace)
+  (%autoprove forcing-rw.tracep-of-rw.lambda-equiv-by-args-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.lambda-equiv-by-args-trace)
+
+  (local (%disable default rw.lambda-equiv-by-args-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.lambda-equiv-by-args-trace
+              (%enable default rw.trace-step-okp rw.lambda-equiv-by-args-tracep))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.lambda-equiv-by-args-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.lambda-equiv-by-args-trace hypbox formals body iffp traces)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.lambda-equiv-by-args-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.lambda-equiv-by-args-trace
+              (%enable default rw.trace-step-env-okp rw.lambda-equiv-by-args-tracep))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.lambda-equiv-by-args-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.lambda-equiv-by-args-trace hypbox formals body iffp traces)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.lambda-equiv-by-args-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.lambda-equiv-by-args-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.beta-reduction-trace
+
+  (%autoadmit rw.beta-reduction-trace)
+
+  (local (%enable default rw.beta-reduction-trace))
+
+  (%autoprove rw.trace->method-of-rw.beta-reduction-trace)
+  (%autoprove rw.trace->hypbox-of-rw.beta-reduction-trace)
+  (%autoprove rw.trace->lhs-of-rw.beta-reduction-trace)
+  (%autoprove rw.trace->rhs-of-rw.beta-reduction-trace)
+  (%autoprove rw.trace->iffp-of-rw.beta-reduction-trace)
+  (%autoprove rw.trace->subtraces-of-rw.beta-reduction-trace)
+  (%autoprove rw.trace->extras-of-rw.beta-reduction-trace)
+  (%autoprove forcing-rw.tracep-of-rw.beta-reduction-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.beta-reduction-trace)
+
+  (local (%disable default rw.beta-reduction-trace))
+
+  (%autoprove lemma-forcing-rw.beta-reduction-tracep-of-rw.beta-reduction-trace
+              (%enable default rw.beta-reduction-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.beta-reduction-trace
+              (%enable default rw.trace-step-okp lemma-forcing-rw.beta-reduction-tracep-of-rw.beta-reduction-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.beta-reduction-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.beta-reduction-trace hypbox term iffp)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.beta-reduction-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.beta-reduction-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.beta-reduction-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.beta-reduction-trace hypbox term iffp)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.beta-reduction-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.beta-reduction-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.try-ground-simplify
+
+  (%autoadmit rw.try-ground-simplify)
+
+  (local (%enable default rw.try-ground-simplify))
+
+  (%autoprove rw.trace->method-of-rw.try-ground-simplify)
+  (%autoprove rw.trace->hypbox-of-rw.try-ground-simplify)
+  (%autoprove forcing-rw.trace->lhs-of-rw.try-ground-simplify)
+  (%autoprove forcing-rw.trace->iffp-of-rw.try-ground-simplify)
+  (%autoprove rw.trace->subtraces-of-rw.try-ground-simplify)
+  (%autoprove forcing-rw.trace->extras-of-rw.try-ground-simplify)
+  (%autoprove lemma-forcing-logic.constantp-of-rw.trace->rhs)
+  (%autoprove forcing-rw.tracep-of-rw.try-ground-simplify)
+  (%autoprove forcing-rw.trace-atblp-of-rw.try-ground-simplify)
+  (%autoprove lemma-forcing-rw.ground-tracep-of-rw.try-ground-simplify
+              (%enable default rw.ground-tracep))
+
+  (local (%disable default rw.try-ground-simplify))
+  (local (%enable default
+                  lemma-forcing-logic.constantp-of-rw.trace->rhs
+                  lemma-forcing-rw.ground-tracep-of-rw.try-ground-simplify))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.try-ground-simplify
+              (%enable default rw.trace-step-okp))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.try-ground-simplify
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.try-ground-simplify hypbox x iffp control)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.try-ground-simplify))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.try-ground-simplify
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.try-ground-simplify
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.try-ground-simplify hypbox x iffp control)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.try-ground-simplify))
+
+  (%autoprove forcing-rw.collect-forced-goals-of-rw.try-ground-simplify
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.if-specialcase-nil-trace
+
+  (%autoadmit rw.if-specialcase-nil-trace)
+
+  (local (%enable default rw.if-specialcase-nil-trace))
+
+  (%autoprove rw.trace->method-of-rw.if-specialcase-nil-trace)
+  (%autoprove rw.trace->hypbox-of-rw.if-specialcase-nil-trace)
+  (%autoprove rw.trace->lhs-of-rw.if-specialcase-nil-trace)
+  (%autoprove rw.trace->rhs-of-rw.if-specialcase-nil-trace)
+  (%autoprove rw.trace->iffp-of-rw.if-specialcase-nil-trace)
+  (%autoprove rw.trace->subtraces-of-rw.if-specialcase-nil-trace)
+  (%autoprove rw.trace->extras-of-rw.if-specialcase-nil-trace)
+  (%autoprove forcing-rw.tracep-of-rw.if-specialcase-nil-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.if-specialcase-nil-trace)
+
+  (local (%disable default rw.if-specialcase-nil-trace))
+
+  (%autoprove lemma-forcing-rw.if-specialcase-nil-tracep-of-rw.if-specialcase-nil-trace
+              (%enable default rw.if-specialcase-nil-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.if-specialcase-nil-trace
+              (%enable default rw.trace-step-okp lemma-forcing-rw.if-specialcase-nil-tracep-of-rw.if-specialcase-nil-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.if-specialcase-nil-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.if-specialcase-nil-trace x y b1)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.if-specialcase-nil-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.if-specialcase-nil-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.if-specialcase-nil-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.if-specialcase-nil-trace x y b1)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.if-specialcase-nil-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.if-specialcase-nil-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.if-specialcase-t-trace
+
+  (%autoadmit rw.if-specialcase-t-trace)
+
+  (local (%enable default rw.if-specialcase-t-trace))
+
+  (%autoprove rw.trace->method-of-rw.if-specialcase-t-trace)
+  (%autoprove rw.trace->hypbox-of-rw.if-specialcase-t-trace)
+  (%autoprove rw.trace->lhs-of-rw.if-specialcase-t-trace)
+  (%autoprove rw.trace->rhs-of-rw.if-specialcase-t-trace)
+  (%autoprove rw.trace->iffp-of-rw.if-specialcase-t-trace)
+  (%autoprove rw.trace->subtraces-of-rw.if-specialcase-t-trace)
+  (%autoprove rw.trace->extras-of-rw.if-specialcase-t-trace)
+  (%autoprove forcing-rw.tracep-of-rw.if-specialcase-t-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.if-specialcase-t-trace)
+
+  (local (%disable default rw.if-specialcase-t-trace))
+
+  (%autoprove lemma-forcing-rw.if-specialcase-t-tracep-of-rw.if-specialcase-t-trace
+              (%enable default rw.if-specialcase-t-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.if-specialcase-t-trace
+              (%enable default rw.trace-step-okp lemma-forcing-rw.if-specialcase-t-tracep-of-rw.if-specialcase-t-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.if-specialcase-t-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.if-specialcase-t-trace x y c1)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.if-specialcase-t-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.if-specialcase-t-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.if-specialcase-t-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.if-specialcase-t-trace x y c1)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.if-specialcase-t-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.if-specialcase-t-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.not-trace
+
+  (%autoadmit rw.not-trace)
+
+  (local (%enable default rw.not-trace))
+
+  (%autoprove rw.trace->method-of-rw.not-trace)
+  (%autoprove rw.trace->hypbox-of-rw.not-trace)
+  (%autoprove rw.trace->lhs-of-rw.not-trace)
+  (%autoprove lemma-rw.trace->rhs-of-rw.not-trace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.not-trace)
+  (%autoprove rw.trace->subtraces-of-rw.not-trace)
+  (%autoprove rw.trace->extras-of-rw.not-trace)
+  (%autoprove forcing-rw.tracep-of-rw.not-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.not-trace)
+
+  (local (%disable default rw.not-trace))
+  (local (%enable default lemma-rw.trace->rhs-of-rw.not-trace))
+
+  (%autoprove lemma-forcing-rw.not-tracep-of-rw.not-trace
+              (%enable default rw.not-tracep)
+              (%splitlimit 10))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.not-trace
+              (%enable default rw.trace-step-okp lemma-forcing-rw.not-tracep-of-rw.not-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.not-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.not-trace x iffp)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.not-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.not-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.not-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.not-trace x iffp)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.not-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.not-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+(defsection rw.negative-if-trace
+
+  (%autoadmit rw.negative-if-trace)
+
+  (local (%enable default rw.negative-if-trace))
+
+  (%autoprove rw.trace->method-of-rw.negative-if-trace)
+  (%autoprove rw.trace->hypbox-of-rw.negative-if-trace)
+  (%autoprove rw.trace->lhs-of-rw.negative-if-trace)
+  (%autoprove rw.trace->rhs-of-rw.negative-if-trace)
+  (%autoprove rw.trace->iffp-of-rw.negative-if-trace)
+  (%autoprove rw.trace->subtraces-of-rw.negative-if-trace)
+  (%autoprove rw.trace->extras-of-rw.negative-if-trace)
+  (%autoprove forcing-rw.tracep-of-rw.negative-if-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.negative-if-trace)
+
+  (local (%disable default rw.negative-if-trace))
+
+  (%autoprove lemma-forcing-rw.negative-if-tracep-of-rw.negative-if-trace
+              (%enable default rw.negative-if-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.negative-if-trace
+              (%enable default rw.trace-step-okp lemma-forcing-rw.negative-if-tracep-of-rw.negative-if-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.negative-if-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.negative-if-trace x iffp hypbox)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.negative-if-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.negative-if-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.negative-if-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.negative-if-trace x iffp hypbox)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.negative-if-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.negative-if-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.maybe-extend-trace
+  (%autoadmit rw.maybe-extend-trace)
+  (local (%enable default rw.maybe-extend-trace))
+  (%autoprove forcing-rw.tracep-of-rw.maybe-extend-trace)
+  (%autoprove forcing-rw.trace-okp-of-rw.maybe-extend-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.maybe-extend-trace)
+  (%autoprove forcing-rw.trace-env-okp-of-rw.maybe-extend-trace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.maybe-extend-trace)
+  (%autoprove forcing-rw.trace->assms-of-rw.maybe-extend-trace)
+  (%autoprove forcing-rw.trace->lhs-of-rw.maybe-extend-trace))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/basic-builders")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/cachep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/cachep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/cachep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/cachep.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,289 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "assms-top")
+(%interactive)
+
+
+(%autoadmit hons-lookup)
+(%autoadmit hons-update)
+(%enable default hons-update hons-lookup)
+
+
+(defsection rw.cachelinep
+  (%autoadmit rw.cachelinep)
+  (%autoadmit rw.cacheline)
+  (%autoadmit rw.cacheline->eqltrace)
+  (%autoadmit rw.cacheline->ifftrace)
+
+  (local (%enable default
+                  rw.cachelinep
+                  rw.cacheline
+                  rw.cacheline->eqltrace
+                  rw.cacheline->ifftrace))
+
+  (%autoprove booleanp-of-rw.cachelinep)
+  (%autoprove forcing-rw.cachelinep-of-rw.cacheline)
+  (%autoprove rw.cacheline->eqltrace-of-rw.cacheline)
+  (%autoprove rw.cacheline->ifftrace-of-rw.cacheline)
+  (%autoprove forcing-rw.tracep-of-rw.cacheline->eqltrace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.cacheline->eqltrace)
+  (%autoprove forcing-rw.tracep-of-rw.cacheline->ifftrace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.cacheline->ifftrace))
+
+
+
+(%deflist rw.cacheline-listp (x)
+          (rw.cachelinep x))
+
+
+(defsection rw.cacheline-assmsp
+  (%autoadmit rw.cacheline-assmsp)
+  (local (%enable default rw.cacheline-assmsp))
+  (%autoprove booleanp-of-rw.cacheline-assmsp)
+  (%autoprove forcing-rw.trace->assms-of-rw.cacheline->ifftrace)
+  (%autoprove forcing-rw.trace->assms-of-rw.cacheline->eqltrace)
+  (%autoprove forcing-rw.cacheline-assmsp-of-rw.cacheline))
+
+(%deflist rw.cacheline-list-assmsp (x assms)
+          (rw.cacheline-assmsp x assms))
+
+(%autoprove rw.trace->assms-of-rw.cacheline->eqltrace-of-lookup
+            (%cdr-induction data))
+
+(%autoprove rw.trace->assms-of-rw.cacheline->ifftrace-of-lookup
+            (%cdr-induction data))
+
+
+
+(defsection rw.cacheline-traces-okp
+  (%autoadmit rw.cacheline-traces-okp)
+  (local (%enable default rw.cacheline-traces-okp))
+  (%autoprove booleanp-of-rw.cacheline-traces-okp)
+  (%autoprove forcing-rw.trace-okp-of-rw.cacheline->ifftrace)
+  (%autoprove forcing-rw.trace-okp-of-rw.cacheline->eqltrace)
+  (%autoprove forcing-rw.cacheline-traces-okp-of-rw.cacheline))
+
+(%deflist rw.cacheline-list-traces-okp (x defs)
+          (rw.cacheline-traces-okp x defs))
+
+(%autoprove rw.trace-okp-of-rw.cacheline->eqltrace-of-lookup
+            (%cdr-induction data)
+            (%forcingp nil))
+
+(%autoprove rw.trace-okp-of-rw.cacheline->ifftrace-of-lookup
+            (%cdr-induction data)
+            (%forcingp nil))
+
+
+
+(defsection rw.cacheline-atblp
+  (%autoadmit rw.cacheline-atblp)
+  (local (%enable default rw.cacheline-atblp))
+  (%autoprove booleanp-of-rw.cacheline-atblp)
+  (%autoprove forcing-rw.trace-atblp-of-rw.cacheline->ifftrace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.cacheline->eqltrace)
+  (%autoprove forcing-rw.cacheline-atblp-of-rw.cacheline))
+
+(%deflist rw.cacheline-list-atblp (x atbl)
+          (rw.cacheline-atblp x atbl))
+
+(%autoprove rw.trace-atblp-of-rw.cacheline->eqltrace-of-lookup
+            (%cdr-induction data)
+            (%forcingp nil))
+
+(%autoprove rw.trace-atblp-of-rw.cacheline->ifftrace-of-lookup
+            (%cdr-induction data)
+            (%forcingp nil))
+
+
+
+(defsection rw.cacheline-env-okp
+  (%autoadmit rw.cacheline-env-okp)
+  (local (%enable default rw.cacheline-env-okp))
+  (%autoprove booleanp-of-rw.cacheline-env-okp)
+  (%autoprove forcing-rw.trace-env-okp-of-rw.cacheline->ifftrace)
+  (%autoprove forcing-rw.trace-env-okp-of-rw.cacheline->eqltrace)
+  (%autoprove forcing-rw.cacheline-env-okp-of-rw.cacheline))
+
+
+(%deflist rw.cacheline-list-env-okp (x defs thms atbl)
+          (rw.cacheline-env-okp x defs thms atbl))
+
+(%autoprove rw.trace-env-okp-of-rw.cacheline->eqltrace-of-lookup
+            (%cdr-induction data)
+            (%forcingp nil))
+
+(%autoprove rw.trace-env-okp-of-rw.cacheline->ifftrace-of-lookup
+            (%cdr-induction data)
+            (%forcingp nil))
+
+
+(%defmap :map (rw.cachemapp x)
+         :key (logic.termp x)
+         :val (rw.cachelinep x)
+         :key-list (logic.term-listp x)
+         :val-list (rw.cacheline-listp x)
+         :val-of-nil nil)
+
+
+
+(defsection rw.cachemal-lhses-okp
+  (%autoadmit rw.cachemap-lhses-okp)
+  (%autoprove rw.cachemap-lhses-okp-when-not-consp
+              (%restrict default rw.cachemap-lhses-okp (equal x 'x)))
+  (%autoprove rw.cachemap-lhses-okp-of-cons
+              (%restrict default rw.cachemap-lhses-okp (equal x '(cons a x))))
+  (%autoprove booleanp-of-rw.cachemap-lhses-okp
+              (%cdr-induction x))
+  (%autoprove rw.trace->lhs-of-rw.cacheline->eqltrace-of-lookup
+              (%cdr-induction data))
+  (%autoprove rw.trace->lhs-of-rw.cacheline->ifftrace-of-lookup
+              (%cdr-induction data)))
+
+
+
+(%defaggregate rw.cache
+               (blockp data)
+               :require ((booleanp-of-rw.cache->blockp   (booleanp blockp))
+                         (rw.cachemapp-of-rw.cache->data (rw.cachemapp data))))
+
+
+(%autoadmit rw.cache-assmsp)
+(%autoprove booleanp-of-rw.cache-assmsp
+            (%enable default rw.cache-assmsp))
+
+(%autoadmit rw.cache-traces-okp)
+(%autoprove booleanp-of-rw.cache-traces-okp
+            (%enable default rw.cache-traces-okp))
+
+(%autoadmit rw.cache-atblp)
+(%autoprove booleanp-of-rw.cache-atblp
+            (%enable default rw.cache-atblp))
+
+(%autoadmit rw.cache-env-okp)
+(%autoprove booleanp-of-rw.cache-env-okp
+            (%enable default rw.cache-env-okp))
+
+(%autoadmit rw.cache-lhses-okp)
+(%autoprove booleanp-of-rw.cache-lhses-okp
+            (%enable default rw.cache-lhses-okp))
+
+
+(defsection rw.set-blockedp
+  (%autoadmit rw.set-blockedp)
+  (%autoprove forcing-rw.cachep-of-rw.set-blockedp
+              (%enable default rw.set-blockedp))
+  (%autoprove forcing-rw.cache-assmsp-of-rw.set-blockedp
+              (%enable default rw.set-blockedp rw.cache-assmsp))
+  (%autoprove forcing-rw.cache-traces-okp-of-rw.set-blockedp
+              (%enable default rw.set-blockedp rw.cache-traces-okp))
+  (%autoprove forcing-rw.cache-atblp-of-rw.set-blockedp
+              (%enable default rw.set-blockedp rw.cache-atblp))
+  (%autoprove forcing-rw.cache-env-okp-of-rw.set-blockedp
+              (%enable default rw.set-blockedp rw.cache-env-okp))
+  (%autoprove forcing-rw.cache-lhses-okp-of-rw.set-blockedp
+              (%enable default rw.set-blockedp rw.cache-lhses-okp)))
+
+
+(defsection rw.cache-update
+  (%autoadmit rw.cache-update)
+  (%autoprove forcing-rw.cachep-of-rw.cache-update
+              (%enable default rw.cache-update))
+  (%autoprove forcing-rw.cache-assmsp-of-rw.cache-update
+              (%enable default rw.cache-update rw.cache-assmsp))
+  (%autoprove forcing-rw.cache-traces-okp-of-rw.cache-update
+              (%enable default rw.cache-update rw.cache-traces-okp))
+  (%autoprove forcing-rw.cache-atblp-of-rw.cache-update
+              (%enable default rw.cache-update rw.cache-atblp))
+  (%autoprove forcing-rw.cache-env-okp-of-rw.cache-update
+              (%enable default rw.cache-update rw.cache-env-okp))
+  (%autoprove forcing-rw.cache-lhses-okp-of-rw.cache-update
+              (%enable default rw.cache-update rw.cache-lhses-okp)))
+
+
+(defsection rw.cache-lookup
+  (%autoadmit rw.cache-lookup)
+  (%autoprove forcing-rw.tracep-of-rw.cache-lookup
+              (%enable default rw.cache-lookup))
+  (%autoprove forcing-rw.trace->iffp-of-rw.cache-lookup
+              (%enable default rw.cache-lookup))
+  (%autoprove forcing-rw.trace->hypbox-of-rw.cache-lookup
+              (%enable default rw.cache-lookup rw.cache-assmsp))
+  (%autoprove forcing-rw.trace->lhs-of-rw.cache-lookup
+              (%enable default rw.cache-lookup rw.cache-lhses-okp))
+  (%autoprove forcing-rw.trace-okp-of-rw.cache-lookup
+              (%enable default rw.cache-lookup rw.cache-traces-okp))
+  (%autoprove forcing-rw.trace-atblp-of-rw.cache-lookup
+              (%enable default rw.cache-lookup rw.cache-atblp))
+  (%autoprove forcing-rw.trace-env-okp-of-rw.cache-lookup
+              (%enable default rw.cache-lookup rw.cache-env-okp)))
+
+
+(defsection rw.empty-cache
+  (%autoadmit rw.empty-cache)
+  (%noexec rw.empty-cache)
+  (%autoprove rw.cachep-of-rw.empty-cache
+              (%enable default rw.empty-cache))
+  (%autoprove rw.cache-assmsp-of-rw.empty-cache
+              (%enable default rw.empty-cache rw.cache-assmsp))
+  (%autoprove rw.cache-traces-okp-of-rw.empty-cache
+              (%enable default rw.empty-cache rw.cache-traces-okp))
+  (%autoprove rw.cache-atblp-of-rw.empty-cache
+              (%enable default rw.empty-cache rw.cache-atblp))
+  (%autoprove rw.cache-env-okp-of-rw.empty-cache
+              (%enable default rw.empty-cache rw.cache-env-okp))
+  (%autoprove rw.cache-lhses-okp-rw.empty-cache
+              (%enable default rw.empty-cache rw.cache-lhses-okp)))
+
+
+(defsection rw.maybe-update-cache
+  (%autoadmit rw.maybe-update-cache)
+  (%autoprove forcing-rw.cachep-of-rw.maybe-update-cache
+              (%enable default rw.maybe-update-cache))
+  (%autoprove forcing-rw.cache-assmsp-of-rw.maybe-update-cache
+              (%enable default rw.maybe-update-cache))
+  (%autoprove forcing-rw.cache-traces-okp-of-rw.maybe-update-cache
+              (%enable default rw.maybe-update-cache))
+  (%autoprove forcing-rw.cache-atblp-of-rw.maybe-update-cache
+              (%enable default rw.maybe-update-cache))
+  (%autoprove forcing-rw.cache-env-okp-of-rw.maybe-update-cache
+              (%enable default rw.maybe-update-cache))
+  (%autoprove forcing-rw.cache-lhses-okp-of-rw.maybe-update-cache
+              (%enable default rw.maybe-update-cache)))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/cachep")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/level9/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/cert.image	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1 @@
+level9-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/controlp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/controlp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/controlp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/controlp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,132 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "theoryp")
+(include-book "assmctrl")
+(include-book "syntax-evaluator")
+(%interactive)
+
+
+(%defaggregate rw.control
+  (noexec forcingp betamode theory defs depth assmctrl)
+  :require ((logic.function-symbol-listp-of-rw.control->noexec  (logic.function-symbol-listp noexec))
+            (booleanp-of-rw.control->forcingp                   (booleanp forcingp))
+            (symbolp-of-rw.control->betamode                    (symbolp betamode))
+            (rw.theoryp-of-rw.control->theory                   (rw.theoryp theory))
+            (definition-listp-of-rw.control->defs               (definition-listp defs))
+            (natp-of-rw.control->depth                          (natp depth))
+            (rw.assmctrlp-of-rw.control->assmctrl               (rw.assmctrlp assmctrl))))
+
+
+(defsection rw.control-atblp
+  (%autoadmit rw.control-atblp)
+  (local (%enable default rw.control-atblp))
+  (%autoprove booleanp-of-rw.control-atblp)
+  (%autoprove forcing-rw.control-atblp-of-rw.control)
+  (%autoprove forcing-rw.theory-atblp-of-rw.control->theory)
+  (%autoprove forcing-logic.formula-list-atblp-of-rw.control->defs))
+
+
+(defsection rw.control-env-okp
+  (%autoadmit rw.control-env-okp)
+  (local (%enable default rw.control-env-okp))
+  (%autoprove booleanp-of-rw.control-env-okp)
+  (%autoprove forcing-rw.control-env-okp-of-rw.control)
+  (%autoprove forcing-rw.theory-env-okp-of-rw.control->theory)
+  (%autoprove forcing-subsetp-of-rw.control-defs-and-axioms))
+
+
+(defsection rw.grounding-sigma-fragment
+  (%autoadmit rw.grounding-sigma-fragment)
+  (%autoprove rw.grounding-sigma-fragment-when-not-consp
+              (%restrict default rw.grounding-sigma-fragment (equal x 'x)))
+  (%autoprove rw.grounding-sigma-fragment-of-cons
+              (%restrict default rw.grounding-sigma-fragment (equal x '(cons a x))))
+  (%autoprove forcing-logic.sigmap-of-rw.grounding-sigma-fragment
+              (%cdr-induction x))
+  (%autoprove logic.sigma-atblp-of-rw.grounding-sigma-fragment
+              (%cdr-induction x))
+  (%autoprove logic.ground-listp-of-range-of-rw.grounding-sigma-fragment
+              (%cdr-induction x))
+  (%autoprove domain-of-rw.grounding-sigma-fragment
+              (%cdr-induction x))
+  (%autoprove rw.grounding-sigma-fragment-of-list-fix
+              (%cdr-induction x))
+  (%autoprove true-listp-of-rw.grounding-sigma-fragment
+              (%cdr-induction x))
+  (%autoprove rw.grounding-sigma-fragment-of-app
+              (%cdr-induction x))
+  (%autoprove rw.grounding-sigma-fragment-of-rev
+              (%cdr-induction x))
+  (%autoprove rev-of-rw.grounding-sigma-fragment
+              (%cdr-induction x)))
+
+
+(%autoadmit rw.aux-extend-grounding-sigma)
+
+(%autoprove forcing-rw.aux-extend-grounding-sigma-removal
+            (%autoinduct rw.aux-extend-grounding-sigma)
+            (%restrict default rw.aux-extend-grounding-sigma (equal vars 'vars)))
+
+
+(defsection rw.extend-grounding-sigma
+  (%autoadmit rw.extend-grounding-sigma)
+  (local (%enable default rw.extend-grounding-sigma))
+  (local (%disable default
+                   rw.grounding-sigma-fragment-when-not-consp
+                   difference-when-not-consp
+                   rev-when-not-consp
+                   difference-when-subsetp))
+  (%autoprove forcing-logic.sigmap-of-rw.extend-grounding-sigma)
+  (%autoprove forcing-logic.sigma-atblp-of-rw.extend-grounding-sigma)
+  (%autoprove forcing-logic.ground-listp-of-range-of-rw.extend-grounding-sigma)
+  (%autoprove subsetp-of-logic.term-vars-and-domain-of-rw.extend-grounding-sigma
+              (%enable default domain-of-rev [outside]domain-of-rev)
+              (%disable default rev-of-domain [outside]rev-of-domain)))
+
+
+(%autoadmit rw.aux-rule-syntax-okp)
+(%autoadmit rw.rule-syntax-okp)
+
+(%autoprove booleanp-of-rw.aux-rule-syntax-okp
+            (%autoinduct rw.aux-rule-syntax-okp name terms partial-grounding-sigma defs depth)
+            (%restrict default rw.aux-rule-syntax-okp (equal restrictions 'terms)))
+
+(%autoprove booleanp-of-rw.rule-syntax-okp
+            (%enable default rw.rule-syntax-okp))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/controlp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/crewrite-builders.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/crewrite-builders.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/crewrite-builders.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/crewrite-builders.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,339 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-builders")
+(include-book "assms-top")
+(%interactive)
+
+
+(local (%enable default booleanp-of-rw.trace->iffp))
+(local (%disable default forcing-booleanp-of-rw.trace->iffp))
+
+
+(defsection rw.crewrite-if-specialcase-same-trace
+
+  (%autoadmit rw.crewrite-if-specialcase-same-trace)
+
+  (local (%enable default rw.crewrite-if-specialcase-same-trace))
+
+  (%autoprove lemma-rw.trace->method-of-rw.crewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->hypbox-of-rw.crewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->lhs-of-rw.crewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->rhs-of-rw.crewrite-if-specialcase-same-trace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.crewrite-if-specialcase-same-trace)
+  (%autoprove lemma-rw.trace->subtraces-of-rw.crewrite-if-specialcase-same-trace)
+  (%autoprove lemma-rw.trace->extras-of-rw.crewrite-if-specialcase-same-trace)
+  (%autoprove forcing-rw.tracep-of-rw.crewrite-if-specialcase-same-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.crewrite-if-specialcase-same-trace)
+
+  (local (%disable default rw.crewrite-if-specialcase-same-trace))
+  (local (%enable default
+                  lemma-rw.trace->method-of-rw.crewrite-if-specialcase-same-trace
+                  lemma-rw.trace->subtraces-of-rw.crewrite-if-specialcase-same-trace
+                  lemma-rw.trace->extras-of-rw.crewrite-if-specialcase-same-trace))
+
+  (%autoprove lemma-forcing-rw.crewrite-if-specialcase-same-tracep-of-rw.crewrite-if-specialcase-same-trace
+              (%enable default rw.crewrite-if-specialcase-same-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.crewrite-if-specialcase-same-trace
+              (%enable default
+                       lemma-forcing-rw.crewrite-if-specialcase-same-tracep-of-rw.crewrite-if-specialcase-same-trace
+                       rw.trace-step-okp))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.crewrite-if-specialcase-same-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.crewrite-if-specialcase-same-trace x y z)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.crewrite-if-specialcase-same-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-if-specialcase-same-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.crewrite-if-specialcase-same-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.crewrite-if-specialcase-same-trace x y z)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-if-specialcase-same-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.crewrite-if-specialcase-same-trace
+              (%restrict default definition-of-rw.collect-forced-goals
+                         (equal x '(RW.CREWRITE-IF-SPECIALCASE-SAME-TRACE X Y Z)))))
+
+
+
+(defsection rw.crewrite-if-generalcase-trace
+
+  (%autoadmit rw.crewrite-if-generalcase-trace)
+
+  (local (%enable default rw.crewrite-if-generalcase-trace))
+  (local (%splitlimit 10))
+
+  (%autoprove rw.trace->method-of-rw.crewrite-if-generalcase-trace)
+  (%autoprove rw.trace->hypbox-of-rw.crewrite-if-generalcase-trace)
+  (%autoprove rw.trace->lhs-of-rw.crewrite-if-generalcase-trace)
+  (%autoprove rw.trace->rhs-of-rw.crewrite-if-generalcase-trace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.crewrite-if-generalcase-trace)
+  (%autoprove rw.trace->subtraces-of-rw.crewrite-if-generalcase-trace)
+  (%autoprove rw.trace->extras-of-rw.crewrite-if-generalcase-trace)
+  (%autoprove forcing-rw.tracep-of-rw.crewrite-if-generalcase-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.crewrite-if-generalcase-trace)
+
+  (local (%disable default rw.crewrite-if-generalcase-trace))
+
+  (%autoprove lemma-forcing-rw.crewrite-if-generalcase-tracep-of-rw.crewrite-if-generalcase-trace
+              (%enable default rw.crewrite-if-generalcase-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.crewrite-if-generalcase-trace
+              (%enable default
+                       lemma-forcing-rw.crewrite-if-generalcase-tracep-of-rw.crewrite-if-generalcase-trace
+                       rw.trace-step-okp))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.crewrite-if-generalcase-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.crewrite-if-generalcase-trace x y z)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.crewrite-if-generalcase-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-if-generalcase-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.crewrite-if-generalcase-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.crewrite-if-generalcase-trace x y z)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-if-generalcase-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.crewrite-if-generalcase-trace
+              (%restrict default definition-of-rw.collect-forced-goals
+                         (equal x '(rw.crewrite-if-generalcase-trace x y z)))))
+
+
+
+(defsection rw.assumptions-trace
+
+  (%autoadmit rw.assumptions-trace)
+
+  (local (%enable default rw.assumptions-trace))
+  (local (%splitlimit 10))
+
+  (%autoprove lemma-rw.trace->method-of-rw.assumptions-trace)
+  (%autoprove rw.trace->assms-of-rw.assumptions-trace)
+  (%autoprove rw.trace->lhs-of-rw.assumptions-trace)
+  (%autoprove lemma-rw.trace->rhs-of-rw.assumptions-trace)
+  (%autoprove rw.trace->iffp-of-rw.assumptions-trace)
+  (%autoprove lemma-rw.trace->subtraces-of-rw.assumptions-trace)
+  (%autoprove lemma-rw.trace->extras-of-rw.assumptions-trace)
+  (%autoprove forcing-rw.tracep-of-rw.assumptions-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.assumptions-trace)
+  (%autoprove lemma-rw.eqtracep-of-rw.eqtrace->extras-of-rw.assumptions-trace)
+
+  (local (%disable default rw.assumptions-trace))
+  (local (%enable default
+                  lemma-rw.trace->method-of-rw.assumptions-trace
+                  lemma-rw.trace->rhs-of-rw.assumptions-trace
+                  lemma-rw.trace->subtraces-of-rw.assumptions-trace
+                  lemma-rw.trace->extras-of-rw.assumptions-trace
+                  lemma-rw.eqtracep-of-rw.eqtrace->extras-of-rw.assumptions-trace))
+
+  (%autoprove lemma-forcing-rw.assumptions-tracep-of-rw.assumptions-trace
+              (%enable default rw.assumptions-tracep rw.assumptions-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.assumptions-trace
+              (%enable default rw.trace-step-okp lemma-forcing-rw.assumptions-tracep-of-rw.assumptions-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.assumptions-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.assumptions-trace assms lhs iffp)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.assumptions-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.assumptions-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.assumptions-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.assumptions-trace assms lhs iffp)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.assumptions-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.assumptions-trace
+              (%restrict default definition-of-rw.collect-forced-goals
+                         (equal x '(rw.assumptions-trace assms lhs iffp)))
+              (%forcingp nil)
+              (%auto)
+              (%enable default rw.assumptions-trace)))
+
+
+
+
+
+(defsection rw.crewrite-rule-trace
+
+  (%autoadmit rw.crewrite-rule-trace)
+
+  (local (%enable default rw.crewrite-rule-trace))
+
+  (%autoprove rw.crewrite-rule-trace-under-iff)
+  (%autoprove lemma-rw.trace->method-of-rw.crewrite-rule-trace)
+  (%autoprove rw.trace->hypbox-of-rw.crewrite-rule-trace)
+  (%autoprove rw.trace->lhs-of-rw.crewrite-rule-trace)
+  (%autoprove rw.trace->rhs-of-rw.crewrite-rule-trace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.crewrite-rule-trace)
+  (%autoprove lemma-rw.trace->subtraces-of-rw.crewrite-rule-trace)
+  (%autoprove lemma-rw.trace->extras-of-rw.crewrite-rule-trace)
+  (%autoprove forcing-rw.tracep-of-rw.crewrite-rule-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.crewrite-rule-trace)
+
+  (local (%disable default rw.crewrite-rule-trace))
+  (local (%enable default
+                  lemma-rw.trace->method-of-rw.crewrite-rule-trace
+                  lemma-rw.trace->subtraces-of-rw.crewrite-rule-trace
+                  lemma-rw.trace->extras-of-rw.crewrite-rule-trace))
+
+  (%autoprove lemma-forcing-rw.crewrite-rule-tracep-of-rw.crewrite-rule-trace
+              (%enable default rw.crewrite-rule-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.crewrite-rule-trace
+              (%enable default
+                       rw.trace-step-okp
+                       lemma-forcing-rw.crewrite-rule-tracep-of-rw.crewrite-rule-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.crewrite-rule-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.crewrite-rule-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-rule-trace
+              (%enable default
+                       rw.trace-step-env-okp
+                       rw.crewrite-rule-trace-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.crewrite-rule-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-rule-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.crewrite-rule-trace
+              (%restrict default definition-of-rw.collect-forced-goals
+                         (equal x '(RW.CREWRITE-RULE-TRACE HYPBOX LHS RULE SIGMA IFFP TRACES)))))
+
+
+
+(defsection rw.force-trace
+
+  (%autoadmit rw.force-trace)
+
+  (local (%enable default rw.force-trace))
+
+  (%autoprove rw.force-trace-under-iff)
+  (%autoprove lemma-rw.trace->method-of-rw.force-trace)
+  (%autoprove rw.trace->hypbox-of-rw.force-trace)
+  (%autoprove rw.trace->lhs-of-rw.force-trace)
+  (%autoprove rw.trace->rhs-of-rw.force-trace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.force-trace)
+  (%autoprove lemma-rw.trace->subtraces-of-rw.force-trace)
+  (%autoprove lemma-rw.trace->extras-of-rw.force-trace)
+  (%autoprove forcing-rw.tracep-of-rw.force-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.force-trace)
+
+  (local (%disable default rw.force-trace))
+  (local (%enable default
+                  lemma-rw.trace->method-of-rw.force-trace
+                  lemma-rw.trace->subtraces-of-rw.force-trace
+                  lemma-rw.trace->extras-of-rw.force-trace))
+
+  (%autoprove lemma-forcing-rw.force-tracep-of-rw.force-trace
+              (%enable default rw.force-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.force-trace
+              (%enable default
+                       rw.trace-step-okp
+                       lemma-forcing-rw.force-tracep-of-rw.force-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.force-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.force-trace hypbox lhs)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.force-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.force-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.force-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.force-trace hypbox lhs)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.force-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.force-trace
+              (%restrict default definition-of-rw.collect-forced-goals
+                         (equal x '(rw.force-trace hypbox lhs)))))
+
+
+
+
+
+(defsection rw.weakening-trace
+
+  (%autoadmit rw.weakening-trace)
+
+  (local (%enable default rw.weakening-trace))
+
+  (%autoprove rw.weakening-trace-under-iff)
+  (%autoprove lemma-rw.trace->method-of-rw.weakening-trace)
+  (%autoprove rw.trace->hypbox-of-rw.weakening-trace)
+  (%autoprove rw.trace->lhs-of-rw.weakening-trace)
+  (%autoprove rw.trace->rhs-of-rw.weakening-trace)
+  (%autoprove forcing-rw.trace->iffp-of-rw.weakening-trace)
+  (%autoprove lemma-rw.trace->subtraces-of-rw.weakening-trace)
+  (%autoprove lemma-rw.trace->extras-of-rw.weakening-trace)
+  (%autoprove forcing-rw.tracep-of-rw.weakening-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.weakening-trace)
+
+  (local (%disable default rw.weakening-trace))
+  (local (%enable default
+                  lemma-rw.trace->method-of-rw.weakening-trace
+                  lemma-rw.trace->subtraces-of-rw.weakening-trace
+                  lemma-rw.trace->extras-of-rw.weakening-trace))
+
+  (%autoprove lemma-forcing-rw.weakening-tracep-of-rw.weakening-trace
+              (%enable default rw.weakening-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.weakening-trace
+              (%enable default
+                       rw.trace-step-okp
+                       lemma-forcing-rw.weakening-tracep-of-rw.weakening-trace))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.weakening-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.weakening-trace hypbox trace)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.weakening-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.weakening-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.weakening-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.weakening-trace hypbox trace)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.weakening-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.weakening-trace
+              (%restrict default definition-of-rw.collect-forced-goals
+                         (equal x '(rw.weakening-trace hypbox trace)))))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/crewrite-builders")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/eqdatabasep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/eqdatabasep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/eqdatabasep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/eqdatabasep.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,243 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+;; BOZO this is duplicated in basic-builders.  Move it to all-equalp.lisp
+(%autoprove all-equalp-removal
+            (%cdr-induction x)
+            (%restrict default repeat (equal n '(+ '1 (len (cdr x))))))
+
+(defsection rw.eqsetp
+
+  (%autoadmit rw.eqsetp)
+  (%autoadmit rw.eqset->head)
+  (%autoadmit rw.eqset->iffp)
+  (%autoadmit rw.eqset->tail)
+  (%autoadmit rw.eqset)
+
+  (local (%enable default
+                  rw.eqsetp
+                  rw.eqset->head
+                  rw.eqset->iffp
+                  rw.eqset->tail
+                  rw.eqset))
+
+  (%autoprove booleanp-of-rw.eqsetp)
+  (%autoprove rw.eqset->head-of-rw.eqset)
+  (%autoprove rw.eqset->iffp-of-rw.eqset)
+  (%autoprove rw.eqset->tail-of-rw.eqset)
+  (%autoprove forcing-rw.eqsetp-of-rw.eqset)
+  (%autoprove forcing-logic.termp-of-rw.eqset->head)
+  (%autoprove forcing-booleanp-of-rw.eqset->iffp)
+  (%autoprove forcing-consp-of-rw.eqset->tail)
+  (%autoprove forcing-true-listp-of-rw.eqset->tail)
+  (%autoprove forcing-rw.eqtrace-listp-of-rw.eqset->tail)
+  (%autoprove forcing-rw.eqtrace-list-iffps-of-rw.eqset->tail
+              (%enable default all-equalp-removal))
+  (%autoprove forcing-rw.eqtrace-list-lhses-of-rw.eqset->tail
+              (%enable default all-equalp-removal))
+  (%autoprove forcing-uniquep-of-rw.eqtrace-list-rhses-of-rw.eqset->tail))
+
+
+(%deflist rw.eqset-listp (x)
+          (rw.eqsetp x))
+
+
+(defsection rw.eqset-atblp
+
+  (%autoadmit rw.eqset-atblp)
+
+  (local (%enable default rw.eqset-atblp))
+
+  (%autoprove booleanp-of-rw.eqset-atblp)
+  (%autoprove forcing-rw.eqset-atblp-of-rw.eqset)
+  (%autoprove forcing-rw.eqtrace-list-atblp-of-rw.eqset->tail)
+  (%autoprove lemma-for-forcing-logic.term-atblp-of-rw.eqset->head)
+
+  (%autoprove forcing-logic.term-atblp-of-rw.eqset->head
+              (%disable default
+                        forcing-rw.eqtrace-list-atblp-of-rw.eqset->tail
+                        forcing-rw.eqtrace-list-lhses-of-rw.eqset->tail)
+              (%use (%instance (%thm lemma-for-forcing-logic.term-atblp-of-rw.eqset->head)
+                               (x    (rw.eqtrace-list-lhses (rw.eqset->tail x)))
+                               (term (rw.eqset->head x))
+                               (len  (len (rw.eqset->tail x)))))
+              (%use (%instance (%thm forcing-rw.eqtrace-list-lhses-of-rw.eqset->tail))))
+
+  (%autoprove rw.eqset-atblp-of-nil))
+
+
+(%deflist rw.eqset-list-atblp (x atbl)
+          (rw.eqset-atblp x atbl))
+
+
+(defsection rw.eqset-okp
+  (%autoadmit rw.eqset-okp)
+  (local (%enable default rw.eqset-okp))
+  (%autoprove booleanp-of-rw.eqset-okp)
+  (%autoprove forcing-rw.eqtrace-list-okp-of-rw.eqset->tail)
+  (%autoprove rw.eqset-okp-of-rw.eqset)
+  (%autoprove rw.eqset-okp-of-nil))
+
+
+(%deflist rw.eqset-list-okp (x box)
+          (rw.eqset-okp x box))
+
+
+
+(%defprojection :list (rw.eqset-list-heads x)
+                :element (rw.eqset->head x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.term-listp-of-rw.eqset-list-heads
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-rw.eqset-list-heads
+            (%cdr-induction x))
+
+
+(defsection rw.eqset-list-iffps
+  (local (%forcingp nil))
+  (%defprojection :list (rw.eqset-list-iffps x)
+                  :element (rw.eqset->iffp x)
+                  :nil-preservingp t))
+
+
+
+(%autoadmit rw.eqset->rhses)
+
+(%autoprove forcing-logic.term-listp-of-rw.eqset->rhses
+            (%enable default rw.eqset->rhses))
+
+(%autoprove forcing-logic.term-list-atblp-of-rw.eqset->rhses
+            (%enable default rw.eqset->rhses))
+
+
+
+
+(%defprojection :list (rw.eqset-list-rhses x)
+                :element (rw.eqset->rhses x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.term-list-listp-of-rw.eqset-list-rhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-rw.eqrow-list-rhses
+            (%cdr-induction x))
+
+
+
+(defsection rw.find-contradiction-in-eqset-list
+  (%autoadmit rw.find-contradiction-in-eqset-list)
+  (local (%restrict default rw.find-contradiction-in-eqset-list (equal x 'x)))
+  (%autoprove forcing-rw.eqtracep-of-rw.find-contradiction-in-eqrow-list
+              (%cdr-induction x))
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.find-contradiction-in-eqset-list
+              (%cdr-induction x))
+  (%autoprove forcing-rw.eqtrace-okp-of-rw.find-contradiction-in-eqset-list
+              (%cdr-induction x))
+  (%autoprove forcing-rw.eqtrace-contradictionp-of-rw.find-contradiction-in-eqset-list
+              (%cdr-induction x)))
+
+
+
+(defsection rw.eqdatabasep
+
+  (%autoadmit rw.eqdatabasep)
+  (%autoadmit rw.eqdatabase->equalsets)
+  (%autoadmit rw.eqdatabase->iffsets)
+  (%autoadmit rw.eqdatabase->contradiction)
+  (%autoadmit rw.eqdatabase)
+
+  (local (%enable default
+                  rw.eqdatabasep
+                  rw.eqdatabase->equalsets
+                  rw.eqdatabase->iffsets
+                  rw.eqdatabase->contradiction
+                  rw.eqdatabase))
+
+  (%autoprove booleanp-of-rw.eqdatabasep)
+  (%autoprove rw.eqdatabase->equalsets-of-rw.eqdatabase)
+  (%autoprove rw.eqdatabase->iffsets-of-rw.eqdatabase)
+  (%autoprove rw.eqdatabase->contradiction-of-rw.eqdatabase)
+  (%autoprove forcing-rw.eqdatabasep-of-rw.eqdatabase)
+  (%autoprove forcing-rw.eqset-listp-of-rw.eqdatabase->equalsets)
+  (%autoprove forcing-uniquep-of-rw.eqset-list-heads-of-rw.eqdatabase->equalsets)
+  (%autoprove forcing-disjoint-from-allp-of-rw.eqrow-list-heads-of-rw.eqdatabase->equalsets)
+  (%autoprove forcing-mutually-disjointp-of-rw.eqrow-list-rhses-of-rw.eqdatabase->equalsets)
+
+  (%autoprove forcing-rw.eqset-list-iffps-of-rw.eqdatabase->equalsets
+              (%enable default all-equalp-removal))
+
+  (%autoprove forcing-rw.eqset-listp-of-rw.eqdatabase->iffsets)
+  (%autoprove forcing-uniquep-of-rw.eqset-list-heads-of-rw.eqdatabase->iffsets)
+  (%autoprove forcing-disjoint-from-allp-of-rw.eqset-list-heads-of-rw.eqdatabase->iffsets)
+  (%autoprove forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqdatabase->iffsets)
+
+  (%autoprove forcing-rw.eqset-list-iffps-of-rw.eqdatabase->iffsets
+              (%enable default all-equalp-removal))
+
+  (%autoprove forcing-rw.eqtracep-of-rw.eqdatabase->contradiction)
+  (%autoprove forcing-rw.eqtrace-contradictionp-of-rw.eqdatabase->contradiction))
+
+
+(defsection rw.eqdatabase-atblp
+  (%autoadmit rw.eqdatabase-atblp)
+  (local (%enable default rw.eqdatabase-atblp))
+  (%autoprove rw.eqdatabase-atblp-of-nil)
+  (%autoprove booleanp-of-rw.eqdatabase-atblp)
+  (%autoprove forcing-rw.eqdatabase-atblp-of-rw.eqdatabase)
+  (%autoprove forcing-rw.eqset-list-atblp-of-rw.eqdatabase->equalsets)
+  (%autoprove forcing-rw.eqset-list-atblp-of-rw.eqdatabase->iffsets)
+  (%autoprove forcing-rw.trace-atblp-of-rw.eqdatabase->contradiction))
+
+
+(defsection rw.eqdatabase-okp
+  (%autoadmit rw.eqdatabase-okp)
+  (local (%enable default rw.eqdatabase-okp))
+  (%autoprove booleanp-of-rw.eqdatabase-okp)
+  (%autoprove forcing-rw.eqdatabase-okp-of-rw.eqdatabase)
+  (%autoprove forcing-rw.eqset-list-okp-of-rw.eqdatabase->equalsets)
+  (%autoprove forcing-rw.eqset-list-okp-of-rw.eqdatabase->iffsets)
+  (%autoprove forcing-rw.trace-okp-of-rw.eqdatabase->contradiction))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/eqdatabasep"
+                                         ;; BOZO this is getting killed
+                                         all-equalp-as-repeat
+                                         )
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/fast-assms.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/fast-assms.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/fast-assms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/fast-assms.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,594 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "assms-top")
+(%interactive)
+
+
+;; Fast Assumptions System.
+;;
+;; We now introduce a cut-down version of our assumptions system where instead
+;; of storing eqtraces, we only store the relevant terms.  It's actually quite
+;; a bit easier to develop the fast-assms system than the full-blown assms,
+;; because we can just introduce the notion of an FAST IMAGE and work from
+;; that.
+;;
+;; The fast image of an assumptions structure is a similar structure where all
+;; of the traces are gone and only the terms remain.  We basically only need to
+;; develop fast analogues of all the assumptions-manipulating routines, and
+;; then show that the image of each routine is the same as the fast-routine.
+;;
+;; This lets us "piggy back" on the proofs we've already done about the assms
+;; system, and frees us from proving all manner of things (e.g., about sets
+;; being mutually disjoint, etc.).  It's actually convenient to define our fast
+;; version of eqsets so that it doesn't need a unique tail, etc.
+
+(%defaggregate rw.fast-eqset
+  (head iffp tail)
+  :require ((logic.termp-of-rw.fast-eqset->head      (logic.termp head))
+            (booleanp-of-rw.fast-eqset->iffp         (booleanp iffp))
+            (consp-of-rw.fast-eqset->tail            (consp tail))
+            (true-listp-of-rw.fast-eqset->tail       (true-listp tail))
+            (logic.term-listp-of-rw.fast-eqset->tail (logic.term-listp tail))))
+
+(%autoprove equal-of-rw.fast-eqset-and-rw.fast-eqset
+            (%enable default rw.fast-eqset))
+
+(%deflist rw.fast-eqset-listp (x)
+          (rw.fast-eqsetp x))
+
+(%defprojection :list (rw.fast-eqset-list-heads x)
+                :element (rw.fast-eqset->head x)
+                :nil-preservingp t)
+
+(%defprojection :list (rw.fast-eqset-list-iffps x)
+                :element (rw.fast-eqset->iffp x)
+                :nil-preservingp t)
+
+(%defprojection :list (rw.fast-eqset-list-tails x)
+                :element (rw.fast-eqset->tail x)
+                :nil-preservingp t)
+
+
+
+(defsection rw.eqset-fast-image
+  (%autoadmit rw.eqset-fast-image)
+  (local (%enable default rw.eqset-fast-image))
+  (%autoprove rw.eqset-fast-image-under-iff)
+  (%autoprove rw.eqset-fast-image-of-rw.eqset)
+  (%autoprove rw.fast-eqsetp-of-rw.eqset-fast-image)
+  (%autoprove rw.fast-eqset->head-of-rw.eqset-fast-image)
+  (%autoprove rw.fast-eqset->iffp-of-rw.eqset-fast-image)
+  (%autoprove rw.fast-eqset->tail-of-rw.eqset-fast-image))
+
+
+
+(%defprojection :list (rw.eqset-list-fast-image x)
+                :element (rw.eqset-fast-image x))
+
+(%autoprove rw.fast-eqset-listp-of-rw.eqset-list-fast-image (%cdr-induction x))
+(%autoprove rw.fast-eqset-list-heads-of-rw.eqset-list-fast-image (%cdr-induction x))
+
+
+
+
+
+(%autoadmit rw.fast-eqtrace-contradictionp)
+
+(%autoprove booleanp-of-rw.fast-eqtrace-contradictionp
+            (%enable default rw.fast-eqtrace-contradictionp))
+
+(defthm rw.fast-eqtrace-contradictionp-when-rw.eqtrace-contradictionp
+  ;; BOZO should be redundant now.
+  (equal (rw.fast-eqtrace-contradictionp (rw.eqtrace->iffp x) (rw.eqtrace->lhs x) (rw.eqtrace->rhs x))
+         (rw.eqtrace-contradictionp x))
+  :hints(("Goal" :in-theory (enable rw.fast-eqtrace-contradictionp
+                                    rw.eqtrace-contradictionp))))
+
+(%autoprove rw.fast-eqtrace-contradictionp-when-rw.eqtrace-contradictionp
+            (%enable default
+                     rw.fast-eqtrace-contradictionp
+                     rw.eqtrace-contradictionp))
+
+
+
+(%autoadmit rw.fast-find-eqtrace-contradiction)
+
+(%autoprove booleanp-of-rw.fast-find-eqtrace-contradiction
+            (%cdr-induction rhses)
+            (%restrict default rw.fast-find-eqtrace-contradiction (equal rhses 'rhses)))
+
+(%autoprove rw.fast-find-eqtrace-contradiction-when-rw.find-eqtrace-contradiction
+            (%cdr-induction x)
+            (%restrict default rw.find-eqtrace-contradiction (memberp x '(x 'nil)))
+            (%restrict default rw.fast-find-eqtrace-contradiction
+                       (memberp rhses '(x 'nil (cons (rw.eqtrace->rhs x1)
+                                                     (rw.eqtrace-list-rhses x2))))))
+
+
+
+(%autoadmit rw.find-contradiction-in-fast-eqset-list)
+
+(%autoprove booleanp-of-rw.find-contradiction-in-fast-eqset-list
+            (%cdr-induction x)
+            (%restrict default rw.find-contradiction-in-fast-eqset-list (equal x 'x)))
+
+(%autoprove rw.find-contradiction-in-fast-eqset-list-of-rw.eqset-list-fast-image
+            (%cdr-induction eqsets)
+            (%restrict default rw.find-contradiction-in-fast-eqset-list
+                       (memberp x '(eqsets (cons (rw.eqset-fast-image eqsets1)
+                                                 (rw.eqset-list-fast-image eqsets2)))))
+            (%restrict default rw.find-contradiction-in-eqset-list (equal x 'eqsets)))
+
+
+
+
+(%defaggregate rw.fast-eqdatabase
+  (equalsets iffsets contradiction)
+  :require ((rw.fast-eqset-listp-of-rw.fast-eqdatabase->equalsets (rw.fast-eqset-listp equalsets))
+            (rw.fast-eqset-listp-of-rw.fast-eqdatabase->iffsets   (rw.fast-eqset-listp iffsets))
+            (booleanp-of-rw.fast-eqdatabase->contradiction        (booleanp contradiction))))
+
+(%autoprove equal-of-rw.fast-eqdatabase-rewrite
+            (%enable default
+                     rw.fast-eqdatabase
+                     rw.fast-eqdatabasep
+                     rw.fast-eqdatabase->equalsets
+                     rw.fast-eqdatabase->iffsets
+                     rw.fast-eqdatabase->contradiction))
+
+(defthm equal-of-rw.fast-eqdatabase-rewrite-alt
+  (implies (force (and (rw.fast-eqset-listp equalsets)
+                       (rw.fast-eqset-listp iffsets)
+                       (booleanp contradiction)))
+           (equal (equal db (rw.fast-eqdatabase equalsets iffsets contradiction))
+                  (and (rw.fast-eqdatabasep db)
+                       (equal (rw.fast-eqdatabase->equalsets db) equalsets)
+                       (equal (rw.fast-eqdatabase->iffsets db) iffsets)
+                       (equal (rw.fast-eqdatabase->contradiction db) contradiction)))))
+
+(%autoprove equal-of-rw.fast-eqdatabase-rewrite-alt
+            (%use (%thm equal-of-rw.fast-eqdatabase-rewrite)))
+
+
+
+
+(%autoadmit rw.eqdatabase-fast-image)
+
+(%autoprove rw.fast-eqdatabasep-of-rw.eqdatabase-fast-image
+            (%enable default rw.eqdatabase-fast-image))
+
+
+
+(%autoadmit rw.fast-eqset-lookup)
+
+(%autoprove rw.fast-eqset-lookup-of-rw.eqset-fast-image
+            (%enable default
+                     rw.fast-eqset-lookup
+                     rw.eqset-lookup
+                     rw.eqset-fast-image))
+
+(%autoadmit rw.fast-eqset-list-lookup)
+
+(%autoprove rw.eqset->head-under-iff
+            (%enable default rw.eqsetp rw.eqset->head))
+
+(%autoprove rw.fast-eqset-list-lookup-of-rw.eqset-list-fast-image
+            (%cdr-induction x)
+            (%restrict default rw.eqset-list-lookup (equal eqsets 'x))
+            (%restrict default rw.fast-eqset-list-lookup
+                       (memberp eqsets '(x 'nil (cons (rw.eqset-fast-image x1)
+                                                      (rw.eqset-list-fast-image x2))))))
+
+
+
+
+(%autoadmit rw.fast-try-equiv-database)
+
+(%autoprove rw.fast-try-equiv-database-of-rw.eqdatabase-image
+            (%enable default
+                     rw.eqdatabase-fast-image
+                     rw.try-equiv-database
+                     rw.fast-try-equiv-database))
+
+(%autoprove logic.termp-of-rw.fast-eqset-lookup
+            (%enable default rw.fast-eqset-lookup))
+
+(%autoprove logic.termp-of-rw.fast-eqset-list-lookup
+            (%cdr-induction eqsets)
+            (%restrict default rw.fast-eqset-list-lookup (equal eqsets 'eqsets)))
+
+(%autoprove logic.termp-of-rw.fast-try-equiv-database
+            (%enable default rw.fast-try-equiv-database))
+
+
+
+
+(%autoadmit rw.fast-eqset-relevant)
+
+(%autoprove rw.fast-eqset-relevant-of-rw.eqset-fast-image
+  (%enable default rw.fast-eqset-relevant rw.eqset-relevant))
+
+
+
+(%autoadmit rw.find-relevant-fast-eqset)
+
+(%autoprove rw.fast-eqsetp-of-rw.find-relevant-fast-eqset
+            (%cdr-induction eqsets)
+            (%restrict default rw.find-relevant-fast-eqset (equal eqsets 'eqsets)))
+
+(%autoprove rw.find-relevant-fast-eqset-of-rw.eqset-list-fast-image
+            (%cdr-induction eqsets)
+            (%restrict default rw.find-relevant-eqset (equal eqsets 'eqsets))
+            (%restrict default rw.find-relevant-fast-eqset
+                       (memberp eqsets '(eqsets 'nil (cons (rw.eqset-fast-image eqsets1)
+                                                           (rw.eqset-list-fast-image eqsets2))))))
+
+(%autoprove memberp-of-rw.find-relevant-fast-eqset
+            (%cdr-induction x)
+            (%restrict default rw.find-relevant-fast-eqset (equal eqsets 'x)))
+
+
+
+
+(%autoadmit rw.join-fast-eqsets)
+
+(%autoprove rw.fast-eqsetp-of-rw.join-fast-eqsets
+            (%enable default rw.join-fast-eqsets))
+
+(%autoprove rw.eqset-fast-image-of-rw.join-eqsets
+            (%enable default rw.join-eqsets rw.join-fast-eqsets))
+
+
+
+
+(%autoadmit rw.fast-eqset-extend)
+
+(%autoprove rw.fast-eqsetp-of-rw.fast-eqset-extend
+            (%enable default rw.fast-eqset-extend))
+
+(%autoprove rw.eqset-fast-image-of-rw.eqset-extend
+            (%enable default rw.eqset-extend
+                     rw.fast-eqset-extend))
+
+
+
+(%autoadmit rw.remove-fast-eqset-by-head)
+
+(%autoprove rw.fast-eqset-listp-of-rw.remove-fast-eqset-by-head
+            (%cdr-induction eqsets)
+            (%restrict default rw.remove-fast-eqset-by-head (equal eqsets 'eqsets)))
+
+
+
+
+(%autoadmit rw.fast-eqsets-extend)
+
+(%autoprove rw.fast-eqset-listp-of-rw.fast-eqsets-extend
+            (%enable default rw.fast-eqsets-extend))
+
+(%autoprove lemma-0-for-rw.eqset-fast-image-of-rw.eqsets-extend
+            (%cdr-induction x))
+
+(%autoprove lemma-0b-for-rw.eqset-fast-image-of-rw.eqsets-extend
+            (%cdr-induction x)
+            (%restrict default rw.remove-fast-eqset-by-head (equal eqsets 'x)))
+
+(%autoprove lemma-1-for-rw.eqset-fast-image-of-rw.eqsets-extend
+            (%cdr-induction x)
+            (%enable default
+                     lemma-0-for-rw.eqset-fast-image-of-rw.eqsets-extend
+                     lemma-0b-for-rw.eqset-fast-image-of-rw.eqsets-extend)
+            (%restrict default rw.remove-fast-eqset-by-head
+                       (memberp eqsets '(x (cons (rw.eqset-fast-image x1)
+                                                 (rw.eqset-list-fast-image x2))))))
+
+(%autoprove lemma-2-for-rw.eqset-fast-image-of-rw.eqsets-extend
+            (%enable default rw.eqset-fast-image))
+
+(%autoprove rw.eqset-fast-image-of-rw.eqsets-extend
+            (%enable default
+                     rw.fast-eqsets-extend
+                     rw.eqsets-extend
+                     lemma-1-for-rw.eqset-fast-image-of-rw.eqsets-extend
+                     lemma-2-for-rw.eqset-fast-image-of-rw.eqsets-extend)
+            (%auto)
+            (%restrict default rw.find-relevant-fast-eqset (equal eqsets ''nil))
+            (%restrict default rw.find-relevant-eqset (equal eqsets 'eqsets)))
+
+
+
+
+(defsection rw.fast-eqdatabase-extend
+
+  (%autoadmit rw.fast-eqdatabase-extend)
+  (%autoadmit rw.fast-eqdatabase-extend-equalsets)
+  (%autoadmit rw.fast-eqdatabase-extend-iffsets)
+  (%autoadmit rw.fast-eqdatabase-extend-contradiction)
+
+  (%autoprove booleanp-of-rw.fast-eqdatabase-extend-contradiction
+              (%enable default rw.fast-eqdatabase-extend-contradiction))
+
+  (%autoprove rw.fast-eqdatabase-extend-redefinition
+              (%enable default
+                       rw.fast-eqdatabase-extend
+                       rw.fast-eqdatabase-extend-equalsets
+                       rw.fast-eqdatabase-extend-iffsets
+                       rw.fast-eqdatabase-extend-contradiction))
+
+  (local (%enable default rw.fast-eqdatabase-extend-redefinition))
+
+  (%autoadmit rw.eqdatabase-extend-equalsets)
+  (%autoadmit rw.eqdatabase-extend-iffsets)
+  (%autoadmit rw.eqdatabase-extend-contradiction)
+  (%autoprove equal-of-rw.eqdatabase-rewrite
+              (%enable default
+                       rw.eqdatabase
+                       rw.eqdatabasep
+                       rw.eqdatabase->equalsets
+                       rw.eqdatabase->iffsets
+                       rw.eqdatabase->contradiction))
+
+  (local (%enable default equal-of-rw.eqdatabase-rewrite))
+
+  (defthmd equal-of-rw.eqdatabase-rewrite-alt
+    (implies (force (rw.eqdatabasep db))
+             (equal (equal db (rw.eqdatabase equalsets iffsets contradiction))
+                    (and (equal (rw.eqdatabase->equalsets db) equalsets)
+                         (equal (rw.eqdatabase->iffsets db) iffsets)
+                         (equal (rw.eqdatabase->contradiction db) contradiction))))
+    :hints(("Goal" :in-theory (enable equal-of-rw.eqdatabase-rewrite))))
+
+  (%autoprove equal-of-rw.eqdatabase-rewrite-alt
+              (%use (%thm equal-of-rw.eqdatabase-rewrite)))
+
+  (local (%enable default equal-of-rw.eqdatabase-rewrite-alt))
+
+  (%autoprove rw.eqdatabase-extend-redefinition
+              (%enable default
+                       rw.eqdatabase-extend
+                       rw.eqdatabase-extend-equalsets
+                       rw.eqdatabase-extend-iffsets
+                       rw.eqdatabase-extend-contradiction))
+
+
+  (local (%enable default rw.eqdatabase-extend-redefinition))
+
+  (%autoprove rw.fast-eqdatabasep-of-rw.fast-eqdatabase-extend
+              (%enable default rw.fast-eqdatabase-extend)
+              (%disable default rw.fast-eqdatabase-extend-redefinition))
+
+  (%autoprove rw.eqset-listp-of-rw.eqdatabase-extend-equalsets
+              (%enable default rw.eqdatabase-extend-equalsets))
+
+  (%autoprove rw.eqset-listp-of-rw.eqdatabase-extend-iffsets
+              (%enable default rw.eqdatabase-extend-iffsets))
+
+  (%autoprove lemma-1-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+              (%enable default
+                       rw.fast-eqdatabase-extend-equalsets
+                       rw.eqdatabase-extend-equalsets
+                       rw.eqdatabase-fast-image))
+
+  (%autoprove lemma-2-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+              (%enable default
+                       rw.fast-eqdatabase-extend-iffsets
+                       rw.eqdatabase-extend-iffsets
+                       rw.eqdatabase-fast-image))
+
+  (%autoprove lemma-3-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+              (%enable default
+                       rw.fast-eqdatabase-extend-contradiction
+                       rw.eqdatabase-extend-contradiction
+                       lemma-1-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                       lemma-2-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)
+              (%auto)
+              (%enable default rw.eqdatabase-fast-image))
+
+  (%autoprove lemma-4-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+              (%enable default
+                       rw.fast-eqdatabase-extend-contradiction
+                       rw.eqdatabase-extend-contradiction
+                       lemma-1-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                       lemma-2-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)
+              (%auto)
+              (%enable default rw.eqdatabase-fast-image))
+
+  (%autoprove rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+              (%enable default
+                       lemma-1-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                       lemma-2-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                       lemma-3-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                       lemma-4-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)
+              (%restrict default rw.eqdatabase-fast-image
+                         (equal x '(rw.eqdatabase
+                                    (rw.eqdatabase-extend-equalsets nhyp database primaryp secondaryp)
+                                    (rw.eqdatabase-extend-iffsets nhyp database primaryp secondaryp directp negativep)
+                                    (rw.eqdatabase-extend-contradiction nhyp database primaryp secondaryp directp negativep))))))
+
+(%autoprove rw.fast-eqdatabase->contradiction-of-rw.fast-eqdatabase-extend-of-rw.eqdatabase-fast-image
+            (%enable default rw.eqdatabase-fast-image)
+            (%disable default rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)
+            (%use (%instance (%thm rw.eqdatabase-fast-image-of-rw.eqdatabase-extend))))
+
+(%autoprove rw.fast-eqdatabase->equalsets-of-rw.fast-eqdatabase-extend-of-rw.eqdatabase-fast-image
+            (%enable default rw.eqdatabase-fast-image)
+            (%disable default rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)
+            (%use (%instance (%thm rw.eqdatabase-fast-image-of-rw.eqdatabase-extend))))
+
+(%autoprove rw.fast-eqdatabase->iffsets-of-rw.fast-eqdatabase-extend-of-rw.eqdatabase-fast-image
+            (%enable default rw.eqdatabase-fast-image)
+            (%disable default rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)
+            (%use (%instance (%thm rw.eqdatabase-fast-image-of-rw.eqdatabase-extend))))
+
+
+
+
+(%defaggregate rw.fast-assms
+  (hypbox contradiction eqdatabase trueterms ctrl)
+  :require ((rw.hypboxp-of-rw.fast-assms->hypbox              (rw.hypboxp hypbox))
+            (booleanp-of-rw.fast-assms->contradiction         (booleanp contradiction))
+            (rw.fast-eqdatabasep-of-rw.fast-assms->eqdatabase (rw.fast-eqdatabasep eqdatabase))
+            (logic.term-listp-of-rw.fast-assms->trueterms     (logic.term-listp trueterms))
+            (rw.assmctrlp-of-rw.fast-assms->ctrl              (rw.assmsctrlp ctrl))))
+
+
+(%autoadmit rw.assms-fast-image)
+
+(%autoprove rw.fast-assms->contradiction-of-rw.assms-fast-image
+            (%enable default rw.assms-fast-image))
+
+(%autoprove rw.fast-assms->hypbox-of-rw.assms-fast-image
+            (%enable default rw.assms-fast-image))
+
+(%autoprove rw.fast-assms->trueterms-of-rw.assms-fast-image
+            (%enable default rw.assms-fast-image))
+
+(%autoprove rw.fast-assms->ctrl-of-rw.assms-fast-image
+            (%enable default rw.assms-fast-image))
+
+(%autoprove equal-of-rw.fast-assms
+            (%enable default rw.fast-assms
+                     rw.fast-assmsp
+                     rw.fast-assms->hypbox
+                     rw.fast-assms->contradiction
+                     rw.fast-assms->eqdatabase
+                     rw.fast-assms->trueterms
+                     rw.fast-assms->ctrl))
+
+
+
+(%autoadmit rw.fast-assume-left)
+
+(%autoprove rw.assms-fast-image-of-rw.assume-left
+            (%enable default
+                     rw.assms-fast-image
+                     rw.assume-left
+                     rw.fast-assume-left
+                     rw.eqset->rhses))
+(%autoprove rw.fast-assmsp-of-rw.fast-assume-left
+            (%enable default rw.fast-assume-left))
+
+
+
+(%autoadmit rw.fast-assume-right)
+
+(%autoprove rw.assms-fast-image-of-rw.assume-right
+            (%enable default
+                     rw.assms-fast-image
+                     rw.assume-right
+                     rw.fast-assume-right
+                     rw.eqset->rhses))
+
+(%autoprove rw.fast-assmsp-of-rw.fast-assume-right
+            (%enable default rw.fast-assume-right))
+
+
+
+(%autoadmit rw.fast-assume-left-list)
+
+(%autoprove rw.assms-fast-image-of-rw.assume-left-list
+            (%cdr-induction nhyps)
+            (%restrict default rw.fast-assume-left-list (equal nhyps 'nhyps)))
+
+(%autoprove rw.fast-assmsp-of-rw.fast-assume-left-list
+            (%cdr-induction nhyps)
+            (%restrict default rw.fast-assume-left-list (equal nhyps 'nhyps)))
+
+
+
+
+(%autoadmit rw.fast-assume-right-list)
+
+(%autoprove rw.assms-fast-image-of-rw.assume-right-list
+            (%cdr-induction nhyps)
+            (%restrict default rw.fast-assume-right-list (equal nhyps 'nhyps)))
+
+(%autoprove rw.fast-assmsp-of-rw.fast-assume-right-list
+            (%cdr-induction nhyps)
+            (%restrict default rw.fast-assume-right-list (equal nhyps 'nhyps)))
+
+
+
+(%autoadmit rw.empty-fast-assms)
+(%noexec rw.empty-fast-assms)
+
+(%autoprove rw.assms-fast-image-of-rw.empty-assms
+            (%forcingp nil)
+            (%enable default
+                     rw.empty-assms
+                     rw.assms-fast-image
+                     rw.empty-fast-assms
+                     rw.empty-eqdatabase))
+
+(%autoprove rw.fast-assmsp-of-rw.empty-assms
+            (%forcingp nil)
+            (%enable default
+                     rw.empty-assms
+                     rw.assms-fast-image
+                     rw.empty-fast-assms
+                     rw.empty-eqdatabase))
+
+
+
+(%autoadmit rw.fast-assms-emptyp)
+
+(%autoprove rw.fast-assms-emptyp-of-rw.assms-fast-image
+            (%enable default
+                     rw.fast-assms-emptyp
+                     rw.assms-emptyp
+                     rw.assms-fast-image))
+
+
+
+(%autoadmit rw.fast-assms-formula)
+
+(%autoprove rw.fast-assms-formula-of-rw.assms-fast-image
+  (%enable default
+           rw.fast-assms-formula
+           rw.assms-formula
+           rw.assms-fast-image))
+
+
+(%autoadmit rw.fast-try-assms)
+
+(%autoprove rw.fast-try-assms-of-rw.assms-fast-image
+  (%enable default
+           rw.fast-try-assms
+           rw.try-assms
+           rw.assms-fast-image))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/fast")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/fast-cache.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/fast-cache.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/fast-cache.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/fast-cache.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,199 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cachep")
+(include-book "fast-traces")
+(%interactive)
+
+
+
+(%autoadmit rw.fast-cachelinep)
+(%autoadmit rw.fast-cacheline)
+(%autoadmit rw.fast-cacheline->eqltrace)
+(%autoadmit rw.fast-cacheline->ifftrace)
+
+(%autoprove booleanp-of-rw.fast-cachelinep
+            (%enable default rw.fast-cachelinep))
+
+(%autoprove forcing-rw.fast-cachelinep-of-rw.cacheline
+            (%enable default rw.fast-cachelinep rw.fast-cacheline))
+
+(%autoprove rw.fast-cacheline->eqltrace-of-rw.fast-cacheline
+            (%enable default rw.fast-cacheline rw.fast-cacheline->eqltrace))
+
+(%autoprove rw.fast-cacheline->ifftrace-of-rw.cacheline
+            (%enable default rw.fast-cacheline rw.fast-cacheline->ifftrace))
+
+(%autoprove forcing-rw.ftracep-of-rw.fast-cacheline->eqltrace
+            (%enable default rw.fast-cacheline->eqltrace rw.fast-cachelinep))
+
+(%autoprove forcing-rw.ftracep-of-rw.fast-cacheline->ifftrace
+            (%enable default rw.fast-cacheline->ifftrace rw.fast-cachelinep))
+
+(%deflist rw.fast-cacheline-listp (x)
+          (rw.fast-cachelinep x))
+
+
+
+(%autoadmit rw.cacheline-fast-image)
+
+(%autoprove rw.fast-cachelinep-of-rw.cacheline-fast-image
+            (%enable default rw.cacheline-fast-image))
+
+
+(%defprojection :list (rw.cacheline-list-fast-image x)
+                :element (rw.cacheline-fast-image x))
+
+(%autoprove rw.fast-cacheline-listp-of-rw.cacheline-list-fast-image
+            (%cdr-induction x))
+
+
+
+(%defmap :map (rw.fast-cachemapp x)
+         :key (logic.termp x)
+         :val (rw.fast-cachelinep x)
+         :key-list (logic.term-listp x)
+         :val-list (rw.fast-cacheline-listp x)
+         :val-of-nil nil)
+
+
+
+(%autoadmit rw.cachemap-fast-image)
+
+(%autoprove rw.fast-cachemapp-of-rw.cachemap-fast-image
+            (%cdr-induction x)
+            (%restrict default rw.cachemap-fast-image (equal x 'x)))
+
+
+
+(%defaggregate rw.fast-cache
+  (blockp data)
+  :require ((booleanp-of-rw.fast-cache->blockp   (booleanp blockp))
+            (rw.cachemapp-of-rw.fast-cache->data (rw.fast-cachemapp data))))
+
+(%autoadmit rw.cache-fast-image)
+
+(%autoprove rw.fast-cachep-of-rw.cache-fast-image
+            (%enable default rw.cache-fast-image))
+
+(%autoprove rw.fast-cache->blockp-of-rw.cache-fast-image
+            (%enable default rw.cache-fast-image))
+
+(%autoprove equal-of-rw.fast-cache-rewrite
+            (%enable default
+                     rw.fast-cachep
+                     rw.fast-cache
+                     rw.fast-cache->blockp
+                     rw.fast-cache->data))
+
+(defthm equal-of-rw.fast-cache-rewrite-alt
+  (implies (force (rw.fast-cachep cache))
+           (equal (equal cache (rw.fast-cache blockp data))
+                  (and (equal (rw.fast-cache->blockp cache) blockp)
+                       (equal (rw.fast-cache->data cache) data)))))
+
+(%autoprove equal-of-rw.fast-cache-rewrite-alt
+            (%use (%thm equal-of-rw.fast-cache-rewrite)))
+
+
+
+(%autoadmit rw.fast-set-blockedp)
+
+(%autoprove forcing-rw.fast-cachep-of-rw.set-blockedp
+            (%enable default rw.fast-set-blockedp))
+
+(%autoprove rw.cache-fast-image-of-rw.set-blockedp
+            (%enable default
+                     rw.fast-set-blockedp
+                     rw.set-blockedp
+                     rw.cache-fast-image))
+
+
+
+(%autoadmit rw.fast-cache-update)
+
+(%autoprove forcing-rw.fast-cachep-of-rw.cache-update
+            (%enable default rw.fast-cache-update))
+
+(%autoprove cdr-of-lookup-of-term-in-rw.cachemap-fast-image
+            (%cdr-induction x)
+            (%restrict default rw.cachemap-fast-image (equal x 'x)))
+
+(%autoprove lookup-of-term-in-rw.cachemap-fast-image
+            (%cdr-induction x)
+            (%restrict default rw.cachemap-fast-image (equal x 'x)))
+
+(%autoprove rw.cache-fast-image-of-rw.cache-update
+            (%enable default rw.fast-cache-update rw.cache-update)
+            (%enable default rw.cache-fast-image rw.trace-fast-image)
+            (%restrict default rw.cachemap-fast-image (and (consp x) (equal (car x) 'cons)))
+            (%enable default rw.cacheline-fast-image))
+
+
+
+
+(%autoadmit rw.maybe-update-fast-cache)
+
+(%autoprove forcing-rw.fast-cachep-of-rw.maybe-update-fast-cache
+            (%enable default rw.maybe-update-fast-cache))
+
+(%autoprove rw.cache-fast-image-of-rw.maybe-update-cache
+            (%enable default rw.maybe-update-fast-cache rw.maybe-update-cache))
+
+
+
+
+(%autoadmit rw.fast-cache-lookup)
+
+(%autoprove forcing-rw.ftracep-of-rw.fast-cache-lookup
+            (%enable default rw.fast-cache-lookup))
+
+(%autoprove rw.fast-cache-lookup-of-rw.cache-fast-image
+            (%enable default rw.fast-cache-lookup rw.cache-lookup rw.cache-fast-image rw.cacheline-fast-image)
+            (%restrict default rw.cachemap-fast-image (and (consp x) (equal (car x) 'cons))))
+
+
+
+(%autoadmit rw.fast-empty-cache)
+(%noexec rw.fast-empty-cache)
+
+(%autoprove rw.fast-cachep-of-rw.fast-empty-cache
+            (%enable default rw.fast-empty-cache))
+
+(%autoprove rw.cache-fast-image-of-rw.empty-cache
+            (%enable default rw.empty-cache rw.fast-empty-cache))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/fast-traces.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/fast-traces.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/fast-traces.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/fast-traces.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,458 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-builders")
+(include-book "urewrite-builders")
+(include-book "crewrite-builders")
+(include-book "fast-assms")
+(%interactive)
+
+(%autoprove lookup-of-rev-when-uniquep-of-domain
+            (%cdr-induction x))
+
+(%autoprove lemma-for-logic.substitute-of-rev-when-unique
+            (%logic.term-induction flag x))
+
+(%autoprove logic.substitute-of-rev-when-unique
+            (%use (%instance (%thm lemma-for-logic.substitute-of-rev-when-unique)
+                             (flag 'term))))
+
+(%autoprove logic.substitute-list-of-rev-when-unique
+            (%use (%instance (%thm lemma-for-logic.substitute-of-rev-when-unique)
+                             (flag 'list))))
+
+
+
+
+(%defaggregate rw.ftrace
+  (rhs fgoals)
+  :require ((logic.termp-of-rw.ftrace->rhs            (logic.termp rhs))
+            (logic.formula-listp-of-rw.ftrace->fgoals (logic.formula-listp fgoals))
+            (true-listp-of-rw.ftrace->fgoals          (true-listp fgoals))))
+
+(%defaggregate rw.ftraces
+  (rhses fgoals)
+  :require ((logic.term-listp-of-rw.ftraces->rhses     (logic.term-listp rhses))
+            (true-listp-of-rw.ftraces->rhses           (true-listp rhses))
+            (logic.formula-listp-of-rw.ftraces->fgoals (logic.formula-listp fgoals))
+            (true-listp-of-rw.ftraces->fgoals          (true-listp fgoals))))
+
+(%autoprove equal-of-rw.ftraces-and-rw.ftraces
+            (%enable default rw.ftraces))
+
+
+
+(defsection rw.trace-fast-image
+  (%autoadmit rw.trace-fast-image)
+  (local (%enable default rw.trace-fast-image))
+  (%autoprove rw.trace-fast-image-under-iff)
+  (%autoprove rw.ftracep-of-rw.trace-fast-image)
+  (%autoprove rw.ftrace->rhs-of-rw.trace-fast-image)
+  (%autoprove rw.ftrace->rhs-of-rw.trace-fast-image-free)
+  (%autoprove rw.ftrace->fgoals-of-rw.trace-fast-image)
+  (%autoprove rw.ftrace->fgoals-of-rw.trace-fast-image-free))
+
+
+
+(defsection rw.trace-list-fast-image
+  (%autoadmit rw.trace-list-fast-image)
+  (local (%enable default rw.trace-list-fast-image))
+  (%autoprove rw.ftracesp-of-rw.trace-list-fast-image)
+  (%autoprove rw.ftraces->rhses-of-rw.trace-list-fast-image)
+  (%autoprove rw.ftraces->fgoals-of-rw.trace-list-fast-image)
+  (%autoprove rw.ftraces->rhses-of-rw.trace-list-fast-image-free)
+  (%autoprove rw.ftraces->fgoals-of-rw.trace-list-fast-image-free)
+  (%autoprove rw.trace-list-fast-image-of-cons))
+
+
+
+(defsection rw.fast-fail-trace
+  (%autoadmit rw.fast-fail-trace)
+  (local (%enable default rw.fast-fail-trace))
+  (%autoprove rw.fast-fail-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-fail-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-fail-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-fail-trace)
+  (%autoprove rw.trace-fast-image-of-rw.fail-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-transitivity-trace
+  (%autoadmit rw.fast-transitivity-trace)
+  (local (%enable default rw.fast-transitivity-trace))
+  (%autoprove rw.fast-transitivity-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-transitivity-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-transitivity-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-transitivity-trace)
+  (%autoprove rw.trace-fast-image-of-rw.transitivity-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-equiv-by-args-trace
+  (%autoadmit rw.fast-equiv-by-args-trace)
+  (local (%enable default rw.fast-equiv-by-args-trace))
+  (%autoprove rw.fast-equiv-by-args-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.equiv-by-args-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-equiv-by-args-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-equiv-by-args-trace)
+  (%autoprove rw.trace-fast-image-of-rw.equiv-by-args-trace
+              (%enable default rw.trace-fast-image rw.trace-list-fast-image)))
+
+
+
+(defsection rw.fast-lambda-equiv-by-args-trace
+  (%autoadmit rw.fast-lambda-equiv-by-args-trace)
+  (local (%enable default rw.fast-lambda-equiv-by-args-trace))
+  (%autoprove rw.fast-lambda-equiv-by-args-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-lambda-equiv-by-args-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-lambda-equiv-by-args-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-lambda-equiv-by-args-trace)
+  (%autoprove rw.trace-fast-image-of-rw.lambda-equiv-by-args-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-beta-reduction-trace
+  (%autoadmit rw.fast-beta-reduction-trace)
+  (local (%enable default rw.fast-beta-reduction-trace))
+  (%autoprove rw.fast-beta-reduction-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-beta-reduction-trace)
+  (%autoprove forcing-rw.ftrace->rhs-of-rw.fast-beta-reduction-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-beta-reduction-trace)
+  (%autoprove rw.trace-fast-image-of-rw.beta-reduction-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-try-ground-simplify
+  (%autoadmit rw.fast-try-ground-simplify)
+  (local (%enable default rw.fast-try-ground-simplify))
+  (%autoprove rw.ftracep-of-rw.fast-try-ground-simplify)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-try-ground-simplify)
+  (%autoprove rw.trace-fast-image-of-rw.try-ground-simplify
+              (%enable default
+                       rw.trace-fast-image
+                       rw.try-ground-simplify
+                       definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.fast-if-specialcase-nil-trace
+  (%autoadmit rw.fast-if-specialcase-nil-trace)
+  (%enable default rw.fast-if-specialcase-nil-trace)
+  (%autoprove rw.fast-if-specialcase-nil-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-if-specialcase-nil-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-if-specialcase-nil-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-if-specialcase-nil-trace)
+  (%autoprove rw.trace-fast-image-of-rw.if-specialcase-nil-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-if-specialcase-t-trace
+  (%autoadmit rw.fast-if-specialcase-t-trace)
+  (local (%enable default rw.fast-if-specialcase-t-trace))
+  (%autoprove rw.fast-if-specialcase-t-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-if-specialcase-t-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-if-specialcase-t-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-if-specialcase-t-trace)
+  (%autoprove rw.trace-fast-image-of-rw.if-specialcase-t-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-not-trace
+  (%autoadmit rw.fast-not-trace)
+  (local (%enable default rw.fast-not-trace))
+  (%autoprove rw.fast-not-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-not-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-not-trace)
+  (%autoprove rw.trace-fast-image-of-rw.not-trace
+              (%enable default
+                       rw.trace-fast-image
+                       rw.not-trace
+                       definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.fast-negative-if-trace
+  (%autoadmit rw.fast-negative-if-trace)
+  (local (%enable default rw.fast-negative-if-trace))
+  (%autoprove rw.fast-negative-if-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-negative-if-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-negative-if-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-negative-if-trace)
+  (%autoprove rw.trace-fast-image-of-rw.negative-if-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-crewrite-if-specialcase-same-trace
+  (%autoadmit rw.fast-crewrite-if-specialcase-same-trace)
+  (local (%enable default rw.fast-crewrite-if-specialcase-same-trace))
+  (%autoprove rw.fast-crewrite-if-specialcase-same-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-crewrite-if-specialcase-same-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-crewrite-if-specialcase-same-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-crewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace-fast-image-of-rw.crewrite-if-specialcase-same-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-crewrite-if-generalcase-trace
+  (%autoadmit rw.fast-crewrite-if-generalcase-trace)
+  (local (%enable default rw.fast-crewrite-if-generalcase-trace))
+  (%autoprove rw.fast-crewrite-if-generalcase-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-crewrite-if-generalcase-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-crewrite-if-generalcase-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-crewrite-if-generalcase-trace)
+  (%autoprove rw.trace-fast-image-of-rw.crewrite-if-generalcase-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-assumptions-trace
+  (%autoadmit rw.fast-assumptions-trace)
+  (local (%enable default rw.fast-assumptions-trace))
+  (%autoprove forcing-rw.ftracep-of-rw.fast-assumptions-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-assumptions-trace)
+
+  (%autoprove rw.trace-fast-image-of-rw.assumptions-trace
+              (%enable default
+                       rw.trace-fast-image
+                       rw.assms-fast-image
+                       rw.assumptions-trace
+                       definition-of-rw.collect-forced-goals)
+              (%auto)
+              (%disable default forcing-logic.termp-of-rw.eqtrace->lhs)
+              (%use (%instance (%thm forcing-logic.termp-of-rw.eqtrace->lhs)
+                               (x (rw.try-equiv-database lhs (rw.assms->eqdatabase assms) iffp)))))
+
+  (%autoprove lemma-for-rw.fast-assumptions-trace-of-rw.assms-fast-image
+              (%enable default definition-of-rw.eqtracep rw.eqtrace->lhs))
+
+  (%autoprove rw.fast-assumptions-trace-of-rw.assms-fast-image
+              (%enable default
+                       rw.assumptions-trace
+                       rw.fast-assumptions-trace
+                       rw.assms-fast-image
+                       rw.trace-fast-image
+                       definition-of-rw.collect-forced-goals
+                       lemma-for-rw.fast-assumptions-trace-of-rw.assms-fast-image)))
+
+
+
+(defsection rw.fast-crewrite-rule-trace
+  (%autoadmit rw.fast-crewrite-rule-trace)
+  (local (%enable default rw.fast-crewrite-rule-trace))
+  (%autoprove rw.fast-crewrite-rule-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-crewrite-rule-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-crewrite-rule-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-crewrite-rule-trace)
+  (%autoprove rw.trace-fast-image-of-rw.crewrite-rule-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-force-trace
+  (%autoadmit rw.fast-force-trace)
+  (local (%enable default rw.fast-force-trace))
+  (%autoprove rw.fast-force-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-force-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-force-trace)
+  (%autoprove rw.trace-fast-image-of-rw.force-trace
+              (%enable default
+                       rw.trace-fast-image
+                       rw.trace-formula
+                       rw.trace-conclusion-formula)))
+
+
+
+(defsection rw.fast-weakening-trace
+  (%autoadmit rw.fast-weakening-trace)
+  (local (%enable default rw.fast-weakening-trace))
+  (%autoprove rw.fast-weakening-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-weakening-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-weakening-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-weakening-trace)
+  (%autoprove rw.trace-fast-image-of-rw.weakening-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-urewrite-if-specialcase-same-trace
+  (%autoadmit rw.fast-urewrite-if-specialcase-same-trace)
+  (local (%enable default rw.fast-urewrite-if-specialcase-same-trace))
+  (%autoprove rw.fast-urewrite-if-specialcase-same-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-urewrite-if-specialcase-same-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-urewrite-if-specialcase-same-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-urewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace-fast-image-of-rw.urewrite-if-specialcase-same-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-urewrite-if-generalcase-trace
+  (%autoadmit rw.fast-urewrite-if-generalcase-trace)
+  (local (%enable default rw.fast-urewrite-if-generalcase-trace))
+  (%autoprove rw.fast-urewrite-if-generalcase-trace-under-iff)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-urewrite-if-generalcase-trace)
+  (%autoprove rw.ftrace->rhs-of-rw.fast-urewrite-if-generalcase-trace)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-urewrite-if-generalcase-trace)
+  (%autoprove rw.trace-fast-image-of-rw.urewrite-if-generalcase-trace
+              (%enable default rw.trace-fast-image)))
+
+
+
+(defsection rw.fast-try-urewrite-rule
+  (%autoadmit rw.fast-try-urewrite-rule)
+  (local (%enable default rw.fast-try-urewrite-rule))
+  (%autoprove forcing-rw.ftracep-of-rw.fast-try-urewrite-rule)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-try-urewrite-rule)
+  (%autoprove rw.trace-fast-image-of-rw.try-urewrite-rule
+              (%enable default
+                       rw.trace-fast-image
+                       rw.try-urewrite-rule
+                       definition-of-rw.collect-forced-goals)))
+
+
+(defsection rw.fast-try-urewrite-rule-list
+  (%autoadmit rw.fast-try-urewrite-rule-list)
+  (%autoprove forcing-rw.ftracep-of-rw.fast-try-urewrite-rule-list
+              (%cdr-induction rules)
+              (%restrict default rw.fast-try-urewrite-rule-list (equal rules 'rules)))
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-try-urewrite-rule-list
+              ;; BOZO poorly named variable, "rule", should be called "rules"
+              (%cdr-induction rule)
+              (%restrict default rw.fast-try-urewrite-rule-list (equal rules 'rule)))
+  (%autoprove rw.trace-fast-image-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules)
+              (%restrict default rw.fast-try-urewrite-rule-list (equal rules 'rules))
+              (%restrict default rw.try-urewrite-rule-list (equal rules 'rules))
+              (%auto)
+              ;; BOZO this is really ugly.  Fix up the ACL2 proof and this, too.
+              (%enable default
+                       rw.fast-try-urewrite-rule
+                       rw.try-urewrite-rule
+                       rw.trace-fast-image
+                       definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.fast-try-urewrite-rules
+  (%autoadmit rw.fast-try-urewrite-rules)
+  (local (%enable default rw.fast-try-urewrite-rules))
+  (%autoprove forcing-rw.ftracep-of-rw.fast-try-urewrite-rules)
+  (%autoprove rw.ftrace->fgoals-of-rw.fast-try-urewrite-rules)
+  (%autoprove rw.trace-fast-image-of-rw.try-urewrite-rules
+              (%enable default rw.try-urewrite-rules)))
+
+
+
+(defsection rw.maybe-extend-fast-trace
+  (%autoadmit rw.maybe-extend-fast-trace)
+  (local (%enable default rw.maybe-extend-fast-trace))
+  (%autoprove rw.ftracep-of-rw.maybe-extend-fast-trace)
+  (%autoprove rw.trace-fast-image-of-rw.maybe-extend-trace
+              (%enable default rw.maybe-extend-trace)))
+
+
+
+
+(defsection rw.trace-fast-image-equivalence-lemmas
+
+  (%autoprove equiv-lemma-rw.try-ground-simplify-under-iff
+              (%enable default rw.try-ground-simplify rw.fast-try-ground-simplify))
+
+  (%autoprove equiv-lemma-rw.trace->rhs-of-rw.try-ground-simplify
+              (%enable default rw.try-ground-simplify rw.fast-try-ground-simplify))
+
+  (%autoprove equiv-lemma-rw.try-urewrite-rule-list-under-iff
+              (%cdr-induction rules)
+              (%restrict default rw.try-urewrite-rule-list (equal rules 'rules))
+              (%restrict default rw.fast-try-urewrite-rule-list (equal rules 'rules))
+              (%auto)
+              (%enable default rw.try-urewrite-rule rw.fast-try-urewrite-rule))
+
+  (%autoprove equiv-lemma-rw.try-urewrite-rules-under-iff
+              (%enable default
+                       equiv-lemma-rw.try-urewrite-rule-list-under-iff
+                       rw.try-urewrite-rules
+                       rw.fast-try-urewrite-rules))
+
+  (%autoprove equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules)
+              (%restrict default rw.try-urewrite-rule-list (equal rules 'rules))
+              (%restrict default rw.fast-try-urewrite-rule-list (equal rules 'rules))
+              (%auto)
+              (%enable default rw.try-urewrite-rule rw.fast-try-urewrite-rule))
+
+  (%autoprove equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rules
+              (%enable default
+                       equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rule-list
+                       rw.try-urewrite-rules
+                       rw.fast-try-urewrite-rules))
+
+  (%autoprove equiv-lemma-rw.trace->rhs-of-rw.not-trace
+              (%enable default rw.not-trace rw.fast-not-trace))
+
+  (%autoprove equiv-lemma-rw.ftrace->rhs-of-rw.maybe-extend-fast-trace
+              (%enable default rw.maybe-extend-trace rw.maybe-extend-fast-trace))
+
+  (%autoprove equiv-lemma-rw.trace->rhs-of-rw.maybe-extend-trace
+              (%enable default rw.maybe-extend-trace))
+
+  (%autoprove equiv-lemma-rw.ftrace->rhs-of-rw.maybe-extend-fast-trace-of-rw.trace-fast-image
+              (%enable default rw.maybe-extend-trace rw.maybe-extend-fast-trace))
+
+  (%create-theory rw.trace-fast-image-equivalence-lemmas)
+  (%enable rw.trace-fast-image-equivalence-lemmas
+           equiv-lemma-rw.try-ground-simplify-under-iff
+           equiv-lemma-rw.trace->rhs-of-rw.try-ground-simplify
+           equiv-lemma-rw.try-urewrite-rule-list-under-iff
+           equiv-lemma-rw.try-urewrite-rules-under-iff
+           equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rule-list
+           equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rules
+           equiv-lemma-rw.trace->rhs-of-rw.not-trace
+           equiv-lemma-rw.ftrace->rhs-of-rw.maybe-extend-fast-trace
+           equiv-lemma-rw.trace->rhs-of-rw.maybe-extend-trace
+           equiv-lemma-rw.ftrace->rhs-of-rw.maybe-extend-fast-trace-of-rw.trace-fast-image))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/fast-traces")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/fast-urewrite.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/fast-urewrite.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/fast-urewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/fast-urewrite.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,143 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "urewrite")
+(include-book "fast-traces")
+(%interactive)
+
+(%autoadmit rw.fast-flag-urewrite)
+(%autoadmit rw.fast-urewrite)
+(%autoadmit rw.fast-urewrite-list)
+
+(%autoprove definition-of-rw.fast-urewrite
+            (%enable default rw.fast-urewrite rw.fast-urewrite-list)
+            (%restrict default rw.fast-flag-urewrite (equal x 'x)))
+
+(%autoprove definition-of-rw.fast-urewrite-list
+            (%enable default rw.fast-urewrite rw.fast-urewrite-list)
+            (%restrict default rw.fast-flag-urewrite (equal x 'x)))
+
+(%autoprove rw.fast-flag-urewrite-of-term
+            (%enable default rw.fast-urewrite))
+
+(%autoprove rw.fast-flag-urewrite-of-list
+            (%enable default rw.fast-urewrite-list))
+
+(%autoprove rw.fast-urewrite-under-iff
+            (%restrict default definition-of-rw.fast-urewrite (equal x 'x)))
+
+(%autoprove len-of-rw.ftraces->rhses-of-rw.fast-urewrite-list
+            (%cdr-induction x)
+            (%restrict default definition-of-rw.fast-urewrite-list (equal x 'x)))
+
+
+
+
+(%autoprove lemma-for-forcing-rw.ftracep-of-rw.fast-urewrite
+            (%autoinduct rw.fast-flag-urewrite)
+            (%splitlimit 10)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      expensive-term/formula-inference
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      formula-decomposition)
+            (%auto)
+            (%restrict default definition-of-rw.fast-urewrite (equal x 'x))
+            (%restrict default definition-of-rw.fast-urewrite-list (memberp x '(x (cons x1 x2))))
+            (%auto)
+            (%enable default expensive-term/formula-inference))
+
+(%autoprove forcing-rw.ftracep-of-rw.fast-urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.fast-urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.ftrace-listp-of-rw.fast-urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.ftracep-of-rw.fast-urewrite)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-rw.trace-fast-image-of-rw.urewrite
+            (%autoinduct rw.fast-flag-urewrite)
+            (%splitlimit 10)
+            (%enable default rw.trace-fast-image-equivalence-lemmas)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                      expensive-term/formula-inference
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      type-set-like-rules
+                      formula-decomposition)
+            (%auto)
+            (%restrict default definition-of-rw.fast-urewrite (equal x 'x))
+            (%restrict default definition-of-rw.urewrite (equal x 'x))
+            (%restrict default definition-of-rw.fast-urewrite-list (memberp x '(x (cons x1 x2))))
+            (%restrict default definition-of-rw.urewrite-list (memberp x '(x (cons x1 x2))))
+            (%auto)
+            (%enable default expensive-term/formula-inference))
+
+(%autoprove forcing-rw.trace-fast-image-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-fast-image-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-fast-image-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-fast-image-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+(%autoprove forcing-rw.ftrace->rhs-of-rw.fast-urewrite
+            (%disable default forcing-rw.trace-fast-image-of-rw.urewrite)
+            (%use (%thm forcing-rw.trace-fast-image-of-rw.urewrite)))
+
+(%autoprove forcing-rw.ftraces->rhses-of-rw.fast-urewrite-list
+            (%disable default forcing-rw.trace-list-fast-image-of-rw.urewrite-list)
+            (%use (%thm forcing-rw.trace-list-fast-image-of-rw.urewrite-list)))
+
+(%autoprove forcing-rw.ftrace->fgoals-of-rw.fast-urewrite
+            (%disable default forcing-rw.trace-fast-image-of-rw.urewrite)
+            (%use (%thm forcing-rw.trace-fast-image-of-rw.urewrite)))
+
+(%autoprove forcing-rw.ftraces->fgoals-of-rw.fast-urewrite-list
+            (%disable default forcing-rw.trace-list-fast-image-of-rw.urewrite-list)
+            (%use (%thm forcing-rw.trace-list-fast-image-of-rw.urewrite-list)))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/fast-urewrite")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/gather.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/gather.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/gather.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/gather.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,106 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "theoryp")
+(%interactive)
+
+
+(%autoadmit rw.rule-components)
+(%enable default rw.rule-components)
+
+
+(%autoadmit rw.consider-rule)
+
+(%autoprove booleanp-of-rw.consider-rule
+            (%enable default rw.consider-rule))
+
+
+(%autoadmit rw.gather-rules-from-list)
+
+(%autoprove true-listp-of-rw.gather-rules-from-list
+            (%autoinduct rw.gather-rules-from-list)
+            (%restrict default rw.gather-rules-from-list (equal rules 'rules)))
+
+(%autoprove forcing-rw.rule-listp-of-rw.gather-rules-from-list
+            (%autoinduct rw.gather-rules-from-list)
+            (%restrict default rw.gather-rules-from-list (equal rules 'rules)))
+
+(%autoprove forcing-rw.rule-list-atblp-of-rw.gather-rules-from-list
+            (%autoinduct rw.gather-rules-from-list)
+            (%restrict default rw.gather-rules-from-list (equal rules 'rules)))
+
+(%autoprove forcing-rw.rule-list-env-okp-of-rw.gather-rules-from-list
+            (%autoinduct rw.gather-rules-from-list)
+            (%restrict default rw.gather-rules-from-list (equal rules 'rules)))
+
+
+(%autoadmit rw.gather-rules-from-map)
+
+(%autoprove true-listp-of-rw.gather-rules-from-map
+            (%autoinduct rw.gather-rules-from-map)
+            (%restrict default rw.gather-rules-from-map (equal rulemap 'rulemap)))
+
+(%autoprove rw.rule-listp-of-rw.gather-rules-from-map
+            (%autoinduct rw.gather-rules-from-map)
+            (%restrict default rw.gather-rules-from-map (equal rulemap 'rulemap)))
+
+(%autoprove rw.rule-list-atblp-of-rw.gather-rules-from-map
+            (%autoinduct rw.gather-rules-from-map)
+            (%restrict default rw.gather-rules-from-map (equal rulemap 'rulemap)))
+
+(%autoprove rw.rule-list-env-okp-of-rw.gather-rules-from-map
+            (%autoinduct rw.gather-rules-from-map)
+            (%restrict default rw.gather-rules-from-map (equal rulemap 'rulemap)))
+
+
+(%autoadmit rw.gather-rules-from-theory)
+
+(%autoprove true-listp-of-rw.gather-rules-from-theory
+            (%autoinduct rw.gather-rules-from-theory)
+            (%restrict default rw.gather-rules-from-theory (equal theory 'theory)))
+
+(%autoprove rw.rule-listp-of-rw.gather-rules-from-theory
+            (%autoinduct rw.gather-rules-from-theory)
+            (%restrict default rw.gather-rules-from-theory (equal theory 'theory)))
+
+(%autoprove rw.rule-list-atblp-of-rw.gather-rules-from-theory
+            (%autoinduct rw.gather-rules-from-theory)
+            (%restrict default rw.gather-rules-from-theory (equal theory 'theory)))
+
+(%autoprove rw.rule-list-env-okp-of-rw.gather-rules-from-theory
+            (%autoinduct rw.gather-rules-from-theory)
+            (%restrict default rw.gather-rules-from-theory (equal theory 'theory)))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/gather")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/level9.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/level9.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/level9.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/level9.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,218 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "rewrite-world-bldrs")
+(include-book "world-check")
+(include-book "ancestors") ;; move to level 10?
+(include-book "cachep") ;; move to level 10?
+(include-book "fast-cache") ;; move to level 10?
+(include-book "match-free") ;; move to level 10?
+
+
+
+(local (%disable default
+                 formula-decomposition
+                 expensive-term/formula-inference
+                 type-set-like-rules
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 expensive-subsetp-rules
+                 unusual-memberp-rules
+                 unusual-consp-rules
+                 unusual-subsetp-rules
+                 memberp-when-memberp-of-cdr
+                 subsetp-when-not-consp
+                 subsetp-when-not-consp-two))
+
+
+(%autoadmit level9.step-okp)
+
+(encapsulate
+ ()
+ (local (%enable default level9.step-okp))
+ (%autoprove soundness-of-level9.step-okp)
+ (%autoprove level9.step-okp-when-level8.step-okp
+             (%enable default level8.step-okp)
+             (%auto)
+             (%enable default level7.step-okp)
+             (%auto)
+             (%enable default level6.step-okp)
+             (%auto)
+             (%enable default level5.step-okp)
+             (%auto)
+             (%enable default level4.step-okp)
+             (%auto)
+             (%enable default level3.step-okp)
+             (%auto)
+             (%enable default level2.step-okp)
+             (%auto)
+             (%enable default logic.appeal-step-okp)
+             (%auto))
+ (%autoprove level9.step-okp-when-not-consp
+             (%enable default logic.method)))
+
+(encapsulate
+ ()
+ (local (%forcingp nil))
+ (local (%enable default expensive-arithmetic-rules))
+ (%autoadmit level9.flag-proofp-aux))
+
+(%autoadmit level9.proofp-aux)
+(%autoadmit level9.proof-listp-aux)
+
+(%autoprove definition-of-level9.proofp-aux
+            (%enable default level9.proofp-aux level9.proof-listp-aux)
+            (%restrict default level9.flag-proofp-aux (equal x 'x)))
+
+(%autoprove definition-of-level9.proof-listp-aux
+            (%enable default level9.proofp-aux level9.proof-listp-aux)
+            (%restrict default level9.flag-proofp-aux (equal x 'x)))
+
+
+
+(%autoprove level9.proofp-aux-when-not-consp
+            (%enable default definition-of-level9.proofp-aux))
+
+(%autoprove level9.proof-listp-aux-when-not-consp
+            (%restrict default definition-of-level9.proof-listp-aux (equal x 'x)))
+
+(%autoprove level9.proof-listp-aux-of-cons
+            (%restrict default definition-of-level9.proof-listp-aux (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-level9.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%enable default
+                     definition-of-level9.proofp-aux
+                     expensive-arithmetic-rules)
+            (%forcingp nil))
+
+(%autoprove booleanp-of-level9.proofp-aux
+            (%use (%instance (%thm lemma-for-booleanp-of-level9.proofp-aux)
+                             (flag 'proof))))
+
+(%autoprove booleanp-of-level9.proof-listp-aux
+            (%use (%instance (%thm lemma-for-booleanp-of-level9.proofp-aux)
+                             (flag 'list))))
+
+(%deflist level9.proof-listp-aux (x worlds defs axioms thms atbl)
+  (level9.proofp-aux x worlds defs axioms thms atbl))
+
+(%autoprove lemma-for-logic.provablep-when-level9.proofp-aux
+            (%logic.appeal-induction flag x)
+            (%splitlimit 2)
+            (%liftlimit 8)
+            (%disable default
+                      forcing-true-listp-of-logic.subproofs
+                      MEMBERP-WHEN-NOT-CONSP
+                      CONSP-WHEN-CONSP-OF-CDR-CHEAP
+                      LOOKUP-WHEN-NOT-CONSP
+                      memberp-when-memberp-of-cdr
+                      memberp-when-not-subset-of-somep-cheap
+                      memberp-when-not-superset-of-somep-cheap
+                      type-set-like-rules
+                      same-length-prefixes-equal-cheap
+                      logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest)
+            (%waterfall default 100)
+            (%restrict default definition-of-level9.proofp-aux (equal x 'x))
+            (%enable default
+                     expensive-arithmetic-rules
+                     type-set-like-rules)
+            (%waterfall default 100))
+
+(%autoprove logic.provablep-when-level9.proofp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level9.proofp-aux)
+                             (flag 'proof))))
+
+(%autoprove logic.provable-listp-when-level9.proof-listp-aux
+            (%use (%instance (%thm lemma-for-logic.provablep-when-level9.proofp-aux)
+                             (flag 'list))))
+
+
+(%autoprove lemma-for-level9.proofp-aux-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%auto)
+            (%restrict default definition-of-level9.proofp-aux (equal x 'x))
+            (%restrict default definition-of-logic.proofp (equal x 'x))
+            (%enable default expensive-arithmetic-rules))
+
+(%autoprove level9.proofp-aux-when-logic.proofp
+            (%use (%instance (%thm lemma-for-level9.proofp-aux-when-logic.proofp)
+                             (flag 'proof))))
+
+(%autoprove level9.proof-listp-aux-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-level9.proofp-aux-when-logic.proofp)
+                             (flag 'list))))
+
+(%autoprove forcing-level9.proofp-aux-of-logic.provable-witness
+            (%enable default level9.proofp-aux-when-logic.proofp))
+
+(%autoadmit level9.static-checksp)
+(%enable default level9.static-checksp)
+
+(%autoadmit level9.proofp)
+
+(%autoprove booleanp-of-level9.proofp
+            (%enable default level9.proofp))
+
+(%autoprove logic.provablep-when-level9.proofp
+            (%enable default
+                     level9.proofp
+                     expensive-term/formula-inference)
+            (%disable default logic.provablep-when-level9.proofp-aux)
+            (%use (%instance (%thm logic.provablep-when-level9.proofp-aux)
+                             (x      (third (logic.extras x)))
+                             (defs   (first (logic.extras x)))
+                             (worlds (second (logic.extras x))))))
+
+(defsection level9-transition
+  (%install-new-proofp level9.proofp)
+  (%auto)
+  (%qed-install))
+
+(ACL2::table tactic-harness 'current-adapter 'level9.adapter)
+
+(%switch-builder rw.world-urewrite-list-bldr rw.world-urewrite-list-bldr-high)
+
+;; This is special, we need to tell the interface to switch to the fast
+;; urewriter during proofs.
+(ACL2::table tactic-harness 'ufastp t)
+
+(%finish "level9")
+(%save-events "level9.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/level9/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/make-image.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level8/level8")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/level9-symmetry"
+                 "Pre-loaded bootstrap/level8 directory.")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/match-free.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/match-free.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/match-free.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/match-free.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,160 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "assms-top")
+(%interactive)
+
+
+(%autoprove submap-of-eachp-when-submapp
+            (%cdr-induction x))
+
+(%autoprove submap-of-eachp-when-submapp-alt)
+
+(%autoadmit rw.collect-critical-hyps)
+
+(%autoprove subsetp-of-rw.collect-critical-hyps
+            (%autoinduct rw.collect-critical-hyps)
+            (%restrict default rw.collect-critical-hyps (equal hyps 'hyps)))
+
+
+
+
+(%autoadmit rw.critical-hyps)
+
+(%autoprove subsetp-of-rw.critical-hyps
+            (%enable default rw.critical-hyps))
+
+(%autoprove logic.term-listp-of-rw.critical-hyps
+            (%disable default
+                      subsetp-of-rw.critical-hyps
+                      [outside]subsetp-of-rw.critical-hyps)
+            (%use (%instance (%thm subsetp-of-rw.critical-hyps))))
+
+
+
+(%autoadmit rw.limit-hyps-aux)
+
+(%autoadmit rw.limit-hyps)
+
+
+
+
+(%autoadmit rw.find-extensions-for-sigma-aux)
+
+(%autoprove forcing-logic.sigma-listp-of-rw.find-extensions-for-sigma-aux
+            (%autoinduct rw.find-extensions-for-sigma-aux)
+            (%restrict default rw.find-extensions-for-sigma-aux (equal trueterms 'trueterms)))
+
+(%autoprove forcing-logic.sigma-list-atblp-of-rw.find-extensions-for-sigma-aux
+            (%autoinduct rw.find-extensions-for-sigma-aux)
+            (%restrict default rw.find-extensions-for-sigma-aux (equal trueterms 'trueterms)))
+
+(%autoprove submap-of-eachp-of-rw.find-extensions-for-sigma-aux
+            (%autoinduct rw.find-extensions-for-sigma-aux)
+            (%restrict default rw.find-extensions-for-sigma-aux (equal trueterms 'trueterms)))
+
+(%autoprove submap-of-eachp-of-rw.find-extensions-for-sigma-aux-free
+            (%autoinduct rw.find-extensions-for-sigma-aux)
+            (%restrict default rw.find-extensions-for-sigma-aux (equal trueterms 'trueterms)))
+
+
+
+(%autoadmit rw.find-extensions-for-sigma)
+
+(%autoprove forcing-logic.sigma-listp-of-rw.find-extensions-for-sigma
+            (%enable default rw.find-extensions-for-sigma))
+
+(%autoprove forcing-logic.sigma-list-atblp-of-rw.find-extensions-for-sigma
+            (%enable default rw.find-extensions-for-sigma))
+
+(%autoprove submap-of-eachp-of-rw.find-extensions-for-sigma
+            (%enable default rw.find-extensions-for-sigma))
+
+(%autoprove submap-of-eachp-of-rw.find-extensions-for-sigma-free
+            (%enable default rw.find-extensions-for-sigma))
+
+
+
+
+
+(%autoadmit rw.find-extensions-for-sigma-list)
+
+(%autoprove forcing-logic.sigma-listp-of-rw.find-extensions-for-sigma-list
+            (%autoinduct rw.find-extensions-for-sigma-list)
+            (%restrict default rw.find-extensions-for-sigma-list (equal sigmas 'sigmas)))
+
+(%autoprove forcing-logic.sigma-list-atblp-of-rw.find-extensions-for-sigma-list
+            (%autoinduct rw.find-extensions-for-sigma-list)
+            (%restrict default rw.find-extensions-for-sigma-list (equal sigmas 'sigmas)))
+
+(%autoprove submap-of-eachp-of-rw.find-extensions-for-sigma-list
+            (%autoinduct rw.find-extensions-for-sigma-list)
+            (%restrict default rw.find-extensions-for-sigma-list (equal sigmas 'sigmas)))
+
+
+
+
+(%autoadmit rw.find-extensions-for-crit-hyps)
+
+(%autoprove forcing-logic.sigma-listp-of-rw.find-extensions-for-crit-hyps
+            (%autoinduct rw.find-extensions-for-crit-hyps)
+            (%restrict default rw.find-extensions-for-crit-hyps (equal hyps 'hyps)))
+
+(%autoprove forcing-logic.sigma-list-atblp-of-rw.find-extensions-for-crit-hyps
+            (%autoinduct rw.find-extensions-for-crit-hyps)
+            (%restrict default rw.find-extensions-for-crit-hyps (equal hyps 'hyps)))
+
+(%autoprove submap-of-eachp-of-rw.find-extensions-for-crit-hyps
+            (%autoinduct rw.find-extensions-for-crit-hyps)
+            (%restrict default rw.find-extensions-for-crit-hyps (equal hyps 'hyps)))
+
+
+
+
+
+(%autoadmit rw.create-sigmas-to-try)
+
+(%autoprove forcing-logic.sigma-listp-of-rw.create-sigmas-to-try
+            (%enable default rw.create-sigmas-to-try))
+
+(%autoprove forcing-logic.sigma-list-atblp-of-rw.create-sigmas-to-try
+            (%enable default rw.create-sigmas-to-try))
+
+(%autoprove submap-of-eachp-of-rw.create-sigmas-to-try
+            (%enable default rw.create-sigmas-to-try))
+
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/match-free")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/rewrite-world-bldrs.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/rewrite-world-bldrs.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/rewrite-world-bldrs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/rewrite-world-bldrs.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,187 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "rewrite-world")
+(include-book "urewrite-clause")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defsection rw.world-urewrite-list-bldr
+  (%autoadmit rw.world-urewrite-list-bldr)
+  (local (%enable default rw.world-urewrite-list-bldr))
+  (%autoprove logic.appealp-of-rw.world-urewrite-list-bldr)
+  (%autoprove logic.conclusion-of-rw.world-urewrite-list-bldr)
+  (%autoprove logic.proofp-of-rw.world-urewrite-list-bldr))
+
+
+(%autoadmit rw.world-urewrite-list-list-bldr)
+
+(local (%disable default rw.world-urewrite-list-bldr))
+
+(local (%disable default
+                 formula-decomposition
+                 expensive-term/formula-inference
+                 type-set-like-rules
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 expensive-subsetp-rules
+                 unusual-memberp-rules
+                 unusual-consp-rules
+                 unusual-subsetp-rules
+                 CONSP-WHEN-TRUE-LISTP-CHEAP
+                 LOGIC.TERM-LIST-LISTP-OF-SUBSETP-WHEN-LOGIC.TERM-LIST-LISTP
+                 MEMBERP-WHEN-MEMBERP-OF-CDR
+                 LOGIC.APPEAL-LISTP-OF-SUBSETP-WHEN-LOGIC.APPEAL-LISTP
+                 LOGIC.APPEALP-WHEN-MEMBERP-OF-LOGIC.APPEAL-LISTP
+                 LOGIC.DISJOIN-EACH-FORMULA-LIST-WHEN-NOT-CONSP
+                 RW.TRACE-LIST-LIST-RHSES-WHEN-NOT-CONSP
+                 TRUE-LISTP-OF-CDR
+                 LOGIC.TERM-LISTP-WHEN-MEMBERP-OF-LOGIC.TERM-LIST-LISTP
+                 LOGIC.TERM-LIST-LISTP-OF-CDR-WHEN-LOGIC.TERM-LIST-LISTP
+                 SUBSET-OF-SOMEP-WHEN-FIND-SUPERSET
+                 FORCING-PREFIXP-WHEN-NOT-PREFIXP-BADGUY
+                 LOGIC.DISJOIN-FORMULAS-WHEN-NOT-CONSP
+                 LOGIC.DISJOIN-FORMULAS-WHEN-SINGLETON-LIST
+                 LOGIC.TERM-LIST-FORMULAS-WHEN-NOT-CONSP
+                 MEMBERP-OF-CAR-IN-CDR-WHEN-UNIQUEP
+                 RW.TRACE-LIST-RHSES-WHEN-NOT-CONSP
+                 RW.UREWRITE-LIST-WHEN-NOT-CONSP
+                 CONS-LISTP-WHEN-NOT-CONSP
+                 LOGIC.TERM-LIST-LISTP-WHEN-NOT-CONSP
+                 SUBSETP-WHEN-NOT-CONSP
+                 SUBSETP-WHEN-NOT-CONSP-TWO
+                 LOGIC.TERM-LISTP-WHEN-LOGIC.CONSTANT-LISTP-CHEAP
+                 LOGIC.TERM-LISTP-OF-SUBSETP-WHEN-LOGIC.TERM-LISTP
+                 LOOKUP-WHEN-NOT-CONSP
+                 LOGIC.TERM-LIST-ATBLP-OF-CAR-WHEN-LOGIC.TERM-LIST-LIST-ATBLP
+                 LOGIC.TERM-LIST-ATBLP-WHEN-LOGIC.VARIABLE-LISTP
+                 LOGIC.TERM-LISTP-WHEN-LOGIC.VARIABLE-LISTP-CHEAP
+                 LOGIC.TERM-LISTP-WHEN-NOT-CONSP
+                 LOGIC.TERM-LIST-LIST-ATBLP-OF-CDR-WHEN-LOGIC.TERM-LIST-LIST-ATBLP
+                 LOGIC.TERM-LIST-ATBLP-WHEN-LOGIC.CONSTANT-LISTP
+                 ))
+
+(local (%splitlimit 2))
+(local (%liftlimit 2))
+
+(%autoprove logic.appeal-listp-of-rw.world-urewrite-list-bldr
+            (%autoinduct rw.world-urewrite-list-list-bldr x result fastp theoryname world traces proofs)
+            (%restrict default rw.world-urewrite-list-list-bldr (equal x 'x))
+            (%waterfall default 40)
+            (%car-cdr-elim x)
+            (%waterfall default 40)
+            (%car-cdr-elim result)
+            (%waterfall default 40)
+            (%car-cdr-elim proofs)
+            (%waterfall default 40)
+            (%car-cdr-elim traces)
+            (%waterfall default 40))
+
+(%autoprove logic.conclusion-of-rw.world-urewrite-list-list-bldr
+            (%autoinduct rw.world-urewrite-list-list-bldr x result fastp theoryname world traces proofs)
+            (%restrict default rw.world-urewrite-list-list-bldr (equal x 'x))
+            (%waterfall default 40)
+            (%car-cdr-elim x)
+            (%waterfall default 40)
+            (%car-cdr-elim result)
+            (%waterfall default 40)
+            (%car-cdr-elim proofs)
+            (%waterfall default 40)
+            (%car-cdr-elim traces)
+            (%waterfall default 40))
+
+(%autoprove logic.proofp-of-rw.world-urewrite-list-list-bldr
+            (%autoinduct rw.world-urewrite-list-list-bldr x result fastp theoryname world traces proofs)
+            (%waterfall default 40)
+            (%restrict default rw.world-urewrite-list-list-bldr (equal x 'x))
+            (%waterfall default 40)
+            (%car-cdr-elim x)
+            (%waterfall default 40)
+            (%car-cdr-elim result)
+            (%waterfall default 40)
+            (%car-cdr-elim proofs)
+            (%waterfall default 40)
+            (%car-cdr-elim traces)
+            (%waterfall default 40))
+
+(%autoprove logic.term-listp-of-rw.trace-list-rhses-free)
+
+(local (%disable default
+                 formula-decomposition
+                 expensive-term/formula-inference
+                 type-set-like-rules
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 expensive-subsetp-rules
+                 unusual-memberp-rules
+                 unusual-consp-rules
+                 unusual-subsetp-rules
+                 memberp-when-memberp-of-cdr
+                 subsetp-when-not-consp
+                 subsetp-when-not-consp-two))
+
+(%autoadmit rw.world-urewrite-list-bldr-okp)
+(%autoadmit rw.world-urewrite-list-bldr-high)
+
+(encapsulate
+ ()
+ (local (%enable default
+                 rw.world-urewrite-list-bldr-okp
+                 rw.world-urewrite-list-bldr-high))
+ (%autoprove rw.world-urewrite-list-bldr-okp-of-rw.world-urewrite-list-bldr-high)
+ (%autoprove booleanp-of-rw.world-urewrite-list-bldr-okp)
+ (%autoprove rw.world-urewrite-list-bldr-okp-of-logic.appeal-identity)
+ (%autoprove lemma-1-for-soundness-of-rw.world-urewrite-list-bldr-okp)
+ (%autoprove lemma-2-for-soundness-of-rw.world-urewrite-list-bldr-okp)
+ (%autoprove forcing-soundness-of-rw.world-urewrite-list-bldr-okp
+             (%use (%instance (%thm lemma-1-for-soundness-of-rw.world-urewrite-list-bldr-okp)))
+             (%use (%instance (%thm lemma-2-for-soundness-of-rw.world-urewrite-list-bldr-okp)))
+             (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                              (x (let ((orig-clause   (first (logic.extras x)))
+                                       (result-clause (second (logic.extras x)))
+                                       (theoryname    (third (logic.extras x)))
+                                       (fastp         t) ;; so no traces are needed
+                                       (world         (tactic.find-world (fourth (logic.extras x)) worlds))
+                                       (traces        nil) ;; since fastp is set
+                                       (proof         (logic.provable-witness (logic.conclusion
+                                                                               (first (logic.subproofs x)))
+                                                                              axioms thms atbl)))
+                                   (rw.world-urewrite-list-bldr orig-clause result-clause fastp theoryname
+                                                                world traces proof)))))))
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/rewrite-world")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/rewrite-world.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/rewrite-world.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/rewrite-world.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/rewrite-world.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,90 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "worldp")
+(include-book "fast-urewrite")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defsection tactic.world->control
+  (%autoadmit tactic.world->control)
+  (local (%enable default tactic.world->control))
+  (%autoprove rw.controlp-of-tactic.world->control)
+  (%autoprove rw.control-atblp-of-tactic.world->control)
+  (%autoprove rw.control-env-okp-of-tactic.world->control))
+
+
+(%autoadmit rw.world-urewrite)
+(%enable default rw.world-urewrite)
+
+(%autoadmit rw.world-urewrite-list)
+(%autoadmit rw.world-urewrite-list-list)
+
+(%autoprove rw.world-urewrite-list-redefinition
+            (%cdr-induction x)
+            (%restrict default rw.world-urewrite-list (equal x 'x)))
+
+(%autoprove rw.world-urewrite-list-list-redefinition
+            (%cdr-induction x)
+            (%restrict default rw.world-urewrite-list-list (equal x 'x)))
+
+(%autoadmit rw.fast-urewrite-list-list)
+
+(%autoprove rw.fast-urewrite-list-list-removal
+            (%cdr-induction x)
+            (%restrict default rw.fast-urewrite-list-list (equal x 'x)))
+
+(%autoadmit rw.fast-world-urewrite)
+(%enable default rw.fast-world-urewrite)
+
+(%autoadmit rw.fast-world-urewrite-list)
+
+(%autoprove definition-of-rw.fast-world-urewrite-list
+            (%cdr-induction x)
+            (%restrict default rw.fast-world-urewrite-list (equal x 'x))
+            (%restrict default definition-of-rw.fast-urewrite-list (equal x 'x))
+            (%disable default tactic.world->control))
+
+(%autoadmit rw.fast-world-urewrite-list-list)
+
+(%autoprove definition-of-rw.fast-world-urewrite-list-list
+            (%cdr-induction x)
+            (%restrict default rw.fast-world-urewrite-list-list (equal x 'x))
+            (%restrict default rw.fast-urewrite-list-list (equal x 'x))
+            (%disable default tactic.world->control))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/smart-negate.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/smart-negate.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/smart-negate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/smart-negate.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,57 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit clause.smart-negate)
+
+(%autoprove forcing-logic.termp-of-clause.smart-negate
+            (%enable default clause.smart-negate))
+
+(%autoprove forcing-logic.term-atblp-of-clause.smart-negate
+            (%enable default clause.smart-negate))
+
+
+(%defprojection :list (clause.smart-negate-list x)
+                :element (clause.smart-negate x))
+
+(%autoprove forcing-logic.term-listp-of-clause.smart-negate-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-clause.smart-negate-list
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../clauses/smart-negate")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/level9/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/symmetry	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/level9-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/syntax-evaluator.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/syntax-evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/syntax-evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/syntax-evaluator.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,151 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit rewrite.syntaxp-arity-table)
+
+(%autoprove logic.arity-tablep-of-rewrite.syntaxp-arity-table)
+(%noexec rewrite.syntaxp-arity-table)
+
+
+(%autoadmit rewrite.syntaxp-base-evaluablep)
+
+(%autoprove booleanp-of-rewrite.syntaxp-base-evaluablep
+            (%enable default rewrite.syntaxp-base-evaluablep)
+            (%forcingp nil))
+
+(%autoprove forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+            (%enable default rewrite.syntaxp-base-evaluablep))
+
+(%autoprove logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep
+            (%enable default
+                     rewrite.syntaxp-base-evaluablep
+                     logic.function-args))
+
+(%autoprove lookup-logic.function-name-in-rewrite.syntaxp-arity-table-when-rewrite.syntaxp-base-evaluablep
+            (%enable default rewrite.syntaxp-base-evaluablep))
+
+(%autoprove lemma-for-logic.term-atblp-when-rewrite.syntaxp-base-evaluablep
+            (%enable default rewrite.syntaxp-arity-table))
+
+(%autoprove logic.term-atblp-when-rewrite.syntaxp-base-evaluablep
+            (%enable default rewrite.syntaxp-base-evaluablep)
+            ;; now looping with new reweriter changes??
+            (%disable default len-when-tuplep)
+            (%use (%instance (%thm lemma-for-logic.term-atblp-when-rewrite.syntaxp-base-evaluablep)
+                             (fn (logic.function-name term))
+                             (args (logic.function-args term)))))
+
+(%autoprove rewrite.syntaxp-base-evaluablep-when-preliminary-fn-applied-to-constants
+            (%enable default
+                     rewrite.syntaxp-base-evaluablep
+                     rewrite.syntaxp-arity-table))
+
+(%autoprove rewrite.syntaxp-base-evaluablep-of-logic.function-equal
+            (%enable default
+                     rewrite.syntaxp-base-evaluablep
+                     rewrite.syntaxp-arity-table))
+
+
+
+(%autoadmit rewrite.syntaxp-base-evaluator)
+
+(%autoprove forcing-logic.constantp-of-rewrite.syntaxp-base-evaluator
+            (%enable default
+                     rewrite.syntaxp-base-evaluator))
+
+(%autoprove forcing-logic.constantp-of-rewrite.syntaxp-base-evaluator-free)
+
+(%autoprove rewrite.syntaxp-base-evaluator-of-logic.function-equal
+            (%enable default rewrite.syntaxp-base-evaluator))
+
+
+
+(%autoadmit rewrite.flag-syntaxp-evaluator)
+
+(%autoadmit rewrite.syntaxp-evaluator)
+(%autoadmit rewrite.syntaxp-evaluator-list)
+
+(%autoprove definition-of-rewrite.syntaxp-evaluator
+            (%enable default rewrite.syntaxp-evaluator rewrite.syntaxp-evaluator-list)
+            (%restrict default rewrite.flag-syntaxp-evaluator (equal x 'x)))
+
+(%autoprove definition-of-rewrite.syntaxp-evaluator-list
+            (%enable default rewrite.syntaxp-evaluator rewrite.syntaxp-evaluator-list)
+            (%restrict default rewrite.flag-syntaxp-evaluator (equal x 'x)))
+
+(%autoprove rewrite.flag-syntaxp-evaluator-when-term
+            (%enable default rewrite.syntaxp-evaluator))
+
+(%autoprove rewrite.flag-syntaxp-evaluator-when-list
+            (%enable default rewrite.syntaxp-evaluator-list))
+
+(%autoprove rewrite.syntaxp-evaluator-list-when-not-consp
+            (%restrict default definition-of-rewrite.syntaxp-evaluator-list (equal x 'x)))
+
+(%autoprove rewrite.syntaxp-evaluator-list-of-cons
+            (%restrict default definition-of-rewrite.syntaxp-evaluator-list (equal x '(cons a x))))
+
+(%autoprove true-listp-of-rewrite.syntaxp-evaluator-list
+            (%cdr-induction x))
+
+(%autoprove forcing-len-of-cdr-of-rewrite.syntaxp-evaluator-list
+            (%cdr-induction x))
+
+(%autoprove consp-of-rewrite.syntaxp-evaluator-list
+            (%cdr-induction x))
+
+(%autoprove lemma-for-forcing-logic.constantp-of-cdr-of-rewrite.syntaxp-evaluator
+            (%autoinduct rewrite.flag-syntaxp-evaluator flag x defs n)
+            (%disable default
+                      type-set-like-rules
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two
+                      expensive-term/formula-inference)
+            (%auto)
+            (%restrict default definition-of-rewrite.syntaxp-evaluator (equal x 'x))
+            (%auto)
+            (%enable default expensive-term/formula-inference))
+
+(%autoprove forcing-logic.constantp-of-cdr-of-rewrite.syntaxp-evaluator
+            (%use (%instance (%thm lemma-for-forcing-logic.constantp-of-cdr-of-rewrite.syntaxp-evaluator)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.constant-listp-of-cdr-of-rewrite.syntaxp-evaluator-list
+            (%use (%instance (%thm lemma-for-forcing-logic.constantp-of-cdr-of-rewrite.syntaxp-evaluator)
+                             (flag 'list))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/theoryp-aux.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/theoryp-aux.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/theoryp-aux.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/theoryp-aux.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,574 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoprove alternate-trichotomy-of-symbol-<)
+
+(%autoprove all-equalp-removal
+            (%cdr-induction x)
+            (%restrict default repeat (equal n '(+ '1 (len (cdr x))))))
+
+
+
+(%autoadmit rw.leading-symbol)
+
+(encapsulate
+ ()
+ (local (%disable default consp-when-consp-of-cdr-cheap))  ;; BOZO screws with our stupid elim heuristics
+ (%defprojection :list (rw.leading-symbol-list x)
+                 :element (rw.leading-symbol x)
+                 :nil-preservingp t))
+
+(%autoprove forcing-symbolp-of-rw.leading-symbol
+            (%enable default rw.leading-symbol))
+
+(%autoprove forcing-symbol-listp-of-rw.leading-symbol-list
+            (%cdr-induction x))
+
+
+(encapsulate
+ ()
+ (local (%disable default
+                  memberp-when-not-consp
+                  memberp-when-memberp-of-cdr
+                  subsetp-when-not-consp
+                  not-in-subset-when-not-in-superset-one
+                  in-superset-when-in-subset-two
+                  symbolp-when-logic.function-namep
+                  symbolp-when-logic.variablep
+                  same-length-prefixes-equal-cheap
+                  expensive-arithmetic-rules
+                  expensive-arithmetic-rules-two
+                  type-set-like-rules
+                  unusual-consp-rules
+                  unusual-memberp-rules
+                  unusual-subsetp-rules
+                  formula-decomposition))
+
+ (%defmap :map (rw.typed-rulemapp x)
+          :key (symbolp x)
+          :val (rw.rule-listp x)
+          :key-list (symbol-listp x)
+          :val-list (rw.rule-list-listp x)
+          :val-of-nil t))
+
+
+
+
+
+(%autoadmit rw.rule-list-consistent-leading-symbolsp)
+
+(%autoprove rw.rule-list-consistent-leading-symbolsp-removal
+            (%cdr-induction rules)
+            (%restrict default rw.rule-list-consistent-leading-symbolsp (equal rules 'rules))
+            (%disable default all-equalp-removal))
+
+(%autoadmit rw.rulemap-consistent-leading-symbolsp)
+
+(%autoprove rw.rulemap-consistent-leading-symbolsp-removal
+            (%cdr-induction rulemap)
+            (%restrict default rw.rulemap-consistent-leading-symbolsp (equal rulemap 'rulemap))
+            (%disable default all-equalp-removal))
+
+
+
+(defsection rw.theoryp
+  (%autoadmit rw.theoryp)
+  (%autoadmit rw.theory->name)
+  (%autoadmit rw.theory->left)
+  (%autoadmit rw.theory->right)
+  (%autoadmit rw.theory->rulemap)
+  (%autoadmit rw.theory)
+  (local (%enable default
+                  rw.theory
+                  rw.theory->name
+                  rw.theory->left
+                  rw.theory->right
+                  rw.theory->rulemap))
+  (%autoprove booleanp-of-rw.theoryp
+              (%restrict default rw.theoryp (equal x 'x)))
+  (%autoprove consp-of-rw.theory)
+  (%autoprove rw.theory-under-iff)
+  (%autoprove forcing-rw.theoryp-of-rw.theory
+              (%restrict default rw.theoryp
+                         (equal x '(cons name (cons left (cons right (cons rulemap 'nil)))))))
+  (%autoprove rw.theory->name-of-rw.theory)
+  (%autoprove rw.theory->left-of-rw.theory)
+  (%autoprove rw.theory->right-of-rw.theory)
+  (%autoprove rw.theory->rulemap-of-rw.theory)
+  (%autoprove forcing-symbolp-of-rw.theory->name
+              (%restrict default rw.theoryp (equal x 'x)))
+  (%autoprove forcing-theoryp-of-rw.theory->left
+              (%restrict default rw.theoryp (equal x 'x)))
+  (%autoprove forcing-theoryp-of-rw.theory->right
+              (%restrict default rw.theoryp (equal x 'x)))
+  (%autoprove forcing-rw.typed-rulemapp-of-rw.theory->rulemap
+              (%restrict default rw.theoryp (equal x 'x)))
+  (%autoprove forcing-leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-rw.theory->rulemap
+              (%restrict default rw.theoryp (equal x 'x))
+              (%enable default all-equalp-removal)
+              (%disable default
+                        member-of-nonep-of-cdr-when-member-of-nonep
+                        simple-flatten-when-not-consp
+                        rw.rule-list-lhses-when-not-consp
+                        rw.leading-symbol-list-when-not-consp))
+  (%autoprove rank-of-rw.theory->left)
+  (%autoprove rank-of-rw.theory->right)
+  (%autoprove rw.theory->left-when-not-consp)
+  (%autoprove rw.theory->right-when-not-consp))
+
+
+
+(defsection rw.theory-atblp
+  (%autoadmit rw.theory-atblp)
+  (%autoprove booleanp-of-rw.theory-atblp
+              (%autoinduct rw.theory-atblp)
+              (%restrict default rw.theory-atblp (equal x 'x)))
+  (%autoprove rw.theory-atblp-when-not-consp
+              (%restrict default rw.theory-atblp (equal x 'x)))
+  (%autoprove forcing-theory-atblp-of-rw.theory->left
+              (%restrict default rw.theory-atblp (equal x 'x)))
+  (%autoprove forcing-theory-atblp-of-rw.theory->right
+              (%restrict default rw.theory-atblp (equal x 'x)))
+  (%autoprove forcing-rw.rule-list-list-atblp-of-of-range-of-rw.theory->rulemap
+              (%restrict default rw.theory-atblp (equal x 'x))
+              (%enable default rw.theory->rulemap))
+  (%autoprove forcing-rw.theory-atblp-of-rw.theory
+              (%restrict default rw.theory-atblp (equal x '(rw.theory name left right rules)))))
+
+
+(defsection rw.theory-env-okp
+  (%autoadmit rw.theory-env-okp)
+  (%autoprove booleanp-of-rw.theory-env-okp
+              (%autoinduct rw.theory-env-okp)
+              (%restrict default rw.theory-env-okp (equal x 'x)))
+  (%autoprove rw.theory-env-okp-when-not-consp
+              (%restrict default rw.theory-env-okp (equal x 'x)))
+  (%autoprove forcing-theory-env-okp-of-rw.theory->left
+              (%restrict default rw.theory-env-okp (equal x 'x)))
+  (%autoprove forcing-theory-env-okp-of-rw.theory->right
+              (%restrict default rw.theory-env-okp (equal x 'x)))
+  (%autoprove forcing-rw.rule-list-list-env-okp-of-range-of-rw.theory->rulemap
+              (%restrict default rw.theory-env-okp (equal x 'x))
+              (%enable default rw.theory->rulemap))
+  (%autoprove forcing-rw.theory-env-okp-of-rw.theory
+              (%restrict default rw.theory-env-okp (equal x '(rw.theory name left right rules)))))
+
+
+
+(%autoprove rw.rule-list-atblp-of-simple-flatten
+            (%cdr-induction x))
+
+(%autoprove rw.rule-list-env-okp-of-simple-flatten
+            (%cdr-induction x))
+
+(defsection rw.theory-allrules
+  (%autoadmit rw.fast-theory-all-rules)
+  (%autoadmit rw.slow-theory-all-rules)
+  (%autoadmit rw.theory-allrules)
+  (%autoprove true-listp-of-rw.fast-theory-all-rules
+              (%autoinduct rw.fast-theory-all-rules)
+              (%restrict default rw.fast-theory-all-rules (equal x 'x)))
+  (%autoprove lemma-for-definition-of-rw.theory-allrules
+              (%autoinduct rw.fast-theory-all-rules)
+              (%restrict default rw.fast-theory-all-rules (equal x 'x))
+              (%restrict default rw.slow-theory-all-rules (equal x 'x)))
+  (%autoprove definition-of-rw.theory-allrules
+              (%enable default
+                       rw.theory-allrules
+                       lemma-for-definition-of-rw.theory-allrules)
+              (%restrict default rw.slow-theory-all-rules (equal x 'x)))
+  (%autoprove rw.fast-theory-all-rules-elim
+              (%enable default
+                       rw.theory-allrules
+                       lemma-for-definition-of-rw.theory-allrules))
+  (%autoprove forcing-true-listp-of-rw.theory-allrules
+              (%restrict default definition-of-rw.theory-allrules (equal x 'x)))
+  (%autoprove forcing-rw.rule-listp-of-rw.theory-allrules
+              (%autoinduct rw.slow-theory-all-rules)
+              (%restrict default definition-of-rw.theory-allrules (equal x 'x)))
+  (%autoprove forcing-rw.rule-listp-atblp-of-rw.theory-allrules
+              (%autoinduct rw.slow-theory-all-rules)
+              (%restrict default definition-of-rw.theory-allrules (equal x 'x)))
+  (%autoprove forcing-rw.rule-listp-env-okp-of-rw.theory-allrules
+              (%autoinduct rw.slow-theory-all-rules)
+              (%restrict default definition-of-rw.theory-allrules (equal x 'x))))
+
+
+(defsection rw.theory-lookup
+  (%autoadmit rw.theory-lookup-aux)
+  (%autoadmit rw.theory-lookup)
+  (%autoprove rw.theory-lookup-aux-when-not-consp
+              (%restrict default rw.theory-lookup-aux (equal x 'x)))
+  (%autoprove forcing-rw.typed-rulemapp-of-rw.theory-lookup-aux
+              (%autoinduct rw.theory-lookup-aux)
+              (%restrict default rw.theory-lookup-aux (equal x 'x)))
+  (%autoprove forcing-rw.rule-list-list-atblp-of-range-of-rw.theory-lookup-aux
+              (%autoinduct rw.theory-lookup-aux)
+              (%restrict default rw.theory-lookup-aux (equal x 'x)))
+  (%autoprove forcing-rw.rule-list-list-env-okp-of-range-of-rw.theory-lookup-aux
+              (%autoinduct rw.theory-lookup-aux)
+              (%restrict default rw.theory-lookup-aux (equal x 'x)))
+  (%autoprove rw.theory-lookup-aux-of-rw.theory
+              (%restrict default rw.theory-lookup-aux (equal x '(rw.theory name left right rules))))
+  (%autoprove forcing-rw.typed-rulemapp-of-rw.theory-lookup
+              (%enable default rw.theory-lookup))
+  (%autoprove forcing-rw.rule-list-listp-atblp-of-range-of-rw.theory-lookup
+              (%enable default rw.theory-lookup))
+  (%autoprove forcing-rw.rule-list-list-env-okp-of-range-of-rw.theory-lookup
+              (%enable default rw.theory-lookup)))
+
+
+(defsection rw.extend-typed-rulemap
+  (%autoadmit rw.extend-typed-rulemap)
+  (%autoprove forcing-rw.typed-rulemapp-of-rw.extend-typed-rulemap
+              (%autoinduct rw.extend-typed-rulemap)
+              (%restrict default rw.extend-typed-rulemap (equal rulemap 'rulemap)))
+  (%autoprove forcing-rw.rule-list-list-atblp-of-range-of-rw.extend-typed-rulemap
+              (%autoinduct rw.extend-typed-rulemap)
+              (%restrict default rw.extend-typed-rulemap (equal rulemap 'rulemap))
+              (%disable default
+                        rw.rule-list-atblp-of-subsetp-when-rw.rule-list-atblp
+                        rw.rule-atblp-when-memberp-of-rw.rule-list-atblp
+                        unusual-consp-rules))
+  (%autoprove forcing-rw.rule-list-list-env-okp-of-range-of-rw.extend-typed-rulemap
+              (%autoinduct rw.extend-typed-rulemap)
+              (%restrict default rw.extend-typed-rulemap (equal rulemap 'rulemap))
+              (%disable default
+                        rw.rule-list-env-okp-of-subsetp-when-rw.rule-list-env-okp
+                        rw.rule-env-okp-when-memberp-of-rw.rule-list-env-okp
+                        unusual-consp-rules))
+  (%autoprove lemma-for-forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-rw.extend-typed-rulemap
+              (%autoinduct rw.extend-typed-rulemap)
+              (%restrict default rw.extend-typed-rulemap (equal rulemap 'rulemap))
+              (%disable default
+                        all-equalp-of-subsetp-when-all-equalp
+                        subsetp-of-rw.leading-symbol-lists-when-subsetp
+                        unusual-consp-rules
+                        type-set-like-rules))
+  (%autoprove forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-rw.extend-typed-rulemap
+              (%use (%thm lemma-for-forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-rw.extend-typed-rulemap))
+              (%restrict default rw.extend-typed-rulemap (equal rulemap 'rulemap))
+              (%enable default all-equalp-removal))
+  (%autoprove rw.extend-typed-rulemap-of-nil
+              (%restrict default rw.extend-typed-rulemap (equal rulemap ''nil))))
+
+
+(defsection rw.theory-insert
+  (%autoadmit rw.theory-insert-aux)
+  (%autoadmit rw.theory-insert)
+  (%autoprove rw.theory-insert-aux-under-iff
+              (%restrict default rw.theory-insert-aux (equal x 'x)))
+  (%autoprove lemma-for-forcing-rw.theoryp-of-rw.theory-insert-aux
+              (%autoinduct rw.theory-insert-aux)
+              (%restrict default rw.theory-insert-aux (equal x 'x)))
+  (%autoprove forcing-rw.theoryp-of-rw.theory-insert-aux
+              (%use (%thm lemma-for-forcing-rw.theoryp-of-rw.theory-insert-aux)))
+  (%autoprove forcing-rw.theory-name-of-rw.theory-insert-aux
+              (%use (%thm lemma-for-forcing-rw.theoryp-of-rw.theory-insert-aux)))
+  (%autoprove forcing-rw.theory-atblp-of-rw.theory-insert-aux
+              (%autoinduct rw.theory-insert-aux)
+              (%restrict default rw.theory-insert-aux (equal x 'x)))
+  (%autoprove forcing-rw.theory-env-okp-of-rw.theory-insert-aux
+              (%autoinduct rw.theory-insert-aux)
+              (%restrict default rw.theory-insert-aux (equal x 'x)))
+  (%autoprove lemma-for-forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux
+              (%autoinduct rw.theory-insert-aux put-goal rule x)
+              (%restrict default rw.theory-insert-aux (equal x 'x))
+              (%restrict default rw.theory-lookup-aux (equal x 'x)))
+  (%autoprove lemma-2-for-forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux
+              (%autoinduct rw.theory-insert-aux)
+              (%restrict default rw.theory-insert-aux (equal x 'x))
+              (%restrict default rw.theory-lookup-aux (equal x 'x)))
+  (%autoprove forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux
+              (%use (%instance (%thm lemma-2-for-forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux)
+                               (goal get-goal)))
+              (%use (%instance (%thm lemma-for-forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux))))
+  (%autoprove forcing-rw.theoryp-of-rw.theory-insert
+              (%enable default rw.theory-insert))
+  (%autoprove forcing-rw.theory-atblp-of-rw.theory-insert
+              (%enable default rw.theory-insert))
+  (%autoprove forcing-rw.theory-env-okp-of-rw.theory-insert
+              (%enable default rw.theory-insert))
+  (%autoprove forcing-rw.theory-lookup-of-rw.theory-insert
+              (%enable default rw.theory-insert rw.theory-lookup))
+  (%autoprove forcing-subsetp-of-rw.theory-lookup-aux-and-rw.theory-allrules
+              (%autoinduct rw.theory-lookup-aux)
+              (%restrict default rw.theory-lookup-aux (equal x 'x))
+              (%restrict default definition-of-rw.theory-allrules (equal x 'x)))
+  (%autoprove forcing-subsetp-of-rw.theory-lookup-and-rw.theory-allrules
+              (%enable default rw.theory-lookup)))
+
+
+(%autoprove forcing-rw.typed-rulemapp-of-remove-all-from-ranges
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.rule-list-list-atblp-of-range-of-remove-all-from-ranges
+            (%cdr-induction rulemap)
+            (%disable default
+                      RW.RULE-LIST-ATBLP-OF-SUBSETP-WHEN-RW.RULE-LIST-ATBLP
+                      RW.RULE-LIST-ATBLP-WHEN-NOT-CONSP
+                      REMOVE-ALL-WHEN-DISJOINT-FROM-ALLP-AND-CONS-LISTP
+                      SIMPLE-FLATTEN-WHEN-NOT-CONSP))
+
+(%autoprove forcing-rw.rule-list-env-okp-of-range-of-remove-all-from-ranges
+            (%cdr-induction rulemap)
+            (%disable default
+                      RW.RULE-LIST-ENV-OKP-OF-SUBSETP-WHEN-RW.RULE-LIST-ENV-OKP
+                      RW.RULE-LIST-ENV-OKP-WHEN-NOT-CONSP
+                      SUBSETP-WHEN-NOT-CONSP
+                      SIMPLE-FLATTEN-WHEN-NOT-CONSP))
+
+(%autoprove lemma-for-forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-remove-all-from-ranges
+            (%cdr-induction rulemap)
+            (%disable default all-equalp-removal)
+            (%disable default
+                      RW.RULE-LIST-LHSES-WHEN-NOT-CONSP
+                      REMOVE-ALL-WHEN-DISJOINT-FROM-ALLP-AND-CONS-LISTP
+                      RW.LEADING-SYMBOL-LIST-WHEN-NOT-CONSP
+                      SIMPLE-FLATTEN-WHEN-NOT-CONSP
+                      type-set-like-rules
+                      unusual-subsetp-rules
+                      unusual-consp-rules
+                      unusual-memberp-rules))
+
+(%autoprove forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-remove-all-from-ranges
+            (%enable default all-equalp-removal)
+            (%use (%instance (%thm lemma-for-forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-remove-all-from-ranges)
+                             (name (rw.leading-symbol (rw.rule->lhs rule))))))
+
+
+(defsection rw.theory-delete
+
+  (%autoadmit rw.theory-delete-aux)
+  (%autoadmit rw.theory-delete)
+
+  (%autoprove rw.theory-delete-aux-when-not-consp
+              (%autoinduct rw.theory-delete-aux)
+              (%restrict default rw.theory-delete-aux (equal x 'x)))
+
+  (%autoprove lemma-for-forcing-rw.theoryp-of-rw.theory-delete-aux
+              (%autoinduct rw.theory-delete-aux)
+              (%restrict default rw.theory-delete-aux (equal x 'x)))
+
+  (%autoprove forcing-rw.theoryp-of-rw.theory-delete-aux
+              (%use (%thm lemma-for-forcing-rw.theoryp-of-rw.theory-delete-aux)))
+
+  (%autoprove forcing-rw.theory-name-of-rw.theory-delete-aux
+              (%use (%thm lemma-for-forcing-rw.theoryp-of-rw.theory-delete-aux)))
+
+  (%autoprove forcing-rw.theory-atblp-of-rw.theory-delete-aux
+              (%autoinduct rw.theory-delete-aux)
+              (%restrict default rw.theory-delete-aux (equal x 'x)))
+
+  (%autoprove forcing-rw.theory-env-okp-of-rw.theory-delete-aux
+              (%autoinduct rw.theory-delete-aux)
+              (%restrict default rw.theory-delete-aux (equal x 'x)))
+
+  (%autoprove lemma-for-forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux
+              (%autoinduct rw.theory-delete-aux put-goal rule x)
+              (%restrict default rw.theory-delete-aux (equal x 'x))
+              (%restrict default rw.theory-lookup-aux (equal x 'x)))
+
+  (%autoprove lemma-2-for-forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux
+              (%autoinduct rw.theory-delete-aux)
+              (%restrict default rw.theory-delete-aux (equal x 'x))
+              (%restrict default rw.theory-lookup-aux (equal x 'x)))
+
+  (%autoprove forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux
+              (%enable default
+                       lemma-2-for-forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux
+                       lemma-for-forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux))
+
+  (%autoprove forcing-rw.theoryp-of-rw.theory-delete
+              (%enable default rw.theory-delete))
+
+  (%autoprove forcing-rw.theory-atblp-of-rw.theory-delete
+              (%enable default rw.theory-delete))
+
+  (%autoprove forcing-rw.theory-env-okp-of-rw.theory-delete
+              (%enable default rw.theory-delete))
+
+  (%autoprove forcing-rw.theory-lookup-of-rw.theory-delete
+              (%enable default rw.theory-delete rw.theory-lookup)))
+
+
+
+(defsection rw.theory-insert-list
+  (%autoadmit rw.theory-insert-list)
+  (%autoprove rw.theory-insert-list-when-not-consp
+              (%restrict default rw.theory-insert-list (equal rules 'rules)))
+  (%autoprove rw.theory-insert-list-of-cons
+              (%restrict default rw.theory-insert-list (equal rules '(cons rule rules))))
+  (%autoprove forcing-rw.theoryp-of-rw.theory-insert-list
+              (%autoinduct rw.theory-insert-list))
+  (%autoprove forcing-rw.theory-atblp-of-rw.theory-insert-list
+              (%autoinduct rw.theory-insert-list rules theory))
+  (%autoprove forcing-rw.theory-env-okp-of-rw.theory-insert-list
+              (%autoinduct rw.theory-insert-list rules theory)))
+
+
+
+(defsection rw.theory-delete-list
+  (%autoadmit rw.theory-delete-list)
+  (%autoprove rw.theory-delete-list-when-not-consp
+              (%restrict default rw.theory-delete-list (equal rules 'rules)))
+  (%autoprove rw.theory-delete-list-of-cons
+              (%restrict default rw.theory-delete-list (equal rules '(cons rule rules))))
+  (%autoprove forcing-rw.theoryp-of-rw.theory-delete-list
+              (%autoinduct rw.theory-delete-list))
+  (%autoprove forcing-rw.theory-atblp-of-rw.theory-delete-list
+              (%autoinduct rw.theory-delete-list rules theory))
+  (%autoprove forcing-rw.theory-env-okp-of-rw.theory-delete-list
+              (%autoinduct rw.theory-delete-list rules theory)))
+
+
+
+;; (%autoadmit rw.theory-union)
+
+;; (%autoprove forcing-rw.theoryp-of-rw.theory-union
+;;             (%enable default rw.theory-union))
+
+
+;; (%autoadmit rw.theory-difference)
+
+;; (%autoprove forcing-rw.theoryp-of-rw.theory-difference
+;;             (%enable default rw.theory-difference))
+
+
+
+
+
+(%deflist rw.theory-listp (x)
+          (rw.theoryp x))
+
+(%deflist rw.theory-list-atblp (x atbl)
+          (rw.theory-atblp x atbl))
+
+(%deflist rw.theory-list-env-okp (x thms)
+          (rw.theory-env-okp x thms))
+
+(defsection rw.theory-list-allrules
+  (%autoadmit rw.fast-theory-list-all-rules)
+  (%autoadmit rw.slow-theory-list-all-rules)
+  (%autoadmit rw.theory-list-allrules)
+
+  (%autoprove true-listp-of-rw.fast-theory-list-all-rules
+              (%autoinduct rw.fast-theory-list-all-rules)
+              (%restrict default rw.fast-theory-list-all-rules (equal x 'x)))
+
+  (%autoprove lemma-for-definition-of-rw.theory-list-allrules
+              (%autoinduct rw.fast-theory-list-all-rules)
+              (%restrict default rw.fast-theory-list-all-rules (equal x 'x))
+              (%restrict default rw.slow-theory-list-all-rules (equal x 'x))
+              (%forcingp nil))
+
+  (%autoprove definition-of-rw.theory-list-allrules
+              (%enable default rw.theory-list-allrules)
+              (%restrict default rw.slow-theory-list-all-rules (equal x 'x))
+              (%enable default lemma-for-definition-of-rw.theory-list-allrules)
+              (%forcingp nil))
+
+  (%autoprove rw.fast-theory-list-all-rules-elim
+              (%enable default
+                       lemma-for-definition-of-rw.theory-list-allrules
+                       rw.theory-list-allrules))
+
+  (%autoprove forcing-true-listp-of-rw.theory-list-allrules
+              (%cdr-induction x)
+              (%restrict default definition-of-rw.theory-list-allrules (equal x 'x)))
+
+  (%autoprove forcing-rw.rule-listp-of-rw.theory-list-allrules
+              (%cdr-induction x)
+              (%restrict default definition-of-rw.theory-list-allrules (equal x 'x)))
+
+  (%autoprove forcing-rw.rule-listp-atblp-of-rw.theory-list-allrules
+              (%cdr-induction x)
+              (%restrict default definition-of-rw.theory-list-allrules (equal x 'x)))
+
+  (%autoprove forcing-rw.rule-listp-env-okp-of-rw.theory-list-allrules
+              (%cdr-induction x)
+              (%restrict default definition-of-rw.theory-list-allrules (equal x 'x))))
+
+
+(%defmap :map (rw.theory-mapp x)
+         :key (symbolp x)
+         :val (rw.theoryp x)
+         :key-list (symbol-listp x)
+         :val-list (rw.theory-listp x))
+
+(%autoprove rw.theory-mapp-of-clean-update
+            (%autoinduct clean-update key val map))
+
+(%autoadmit rw.theory-list-atblp-of-range)
+
+(%autoprove rw.theory-list-atblp-of-range-removal
+            (%cdr-induction x)
+            (%restrict default rw.theory-list-atblp-of-range (equal x 'x)))
+
+
+(%autoadmit rw.theory-list-env-okp-of-range)
+
+(%autoprove rw.theory-list-env-okp-of-range-removal
+            (%cdr-induction x)
+            (%restrict default rw.theory-list-env-okp-of-range (equal x 'x)))
+
+
+
+;; (%autoprove rw.rule-list-atblp-of-lookup-when-rw.rule-list-atblp-of-simple-flatten-of-range
+;;             (%cdr-induction rulemap)
+;;             (%disable default
+;;                       RW.RULE-LIST-ATBLP-OF-SUBSETP-WHEN-RW.RULE-LIST-ATBLP
+;;                       RW.RULE-LIST-ATBLP-WHEN-NOT-CONSP))
+
+;; (%autoprove rw.rule-list-env-okp-of-lookup-when-rw.rule-list-atblp-of-simple-flatten-of-range
+;;             (%cdr-induction rulemap)
+;;             (%disable default
+;;                       RW.RULE-LIST-ENV-OKP-OF-SUBSETP-WHEN-RW.RULE-LIST-ENV-OKP
+;;                       RW.RULE-LIST-ENV-OKP-WHEN-NOT-CONSP))
+
+
+
+
+
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/theoryp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/theoryp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/theoryp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/theoryp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,291 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "theoryp-aux")
+(%interactive)
+
+
+(%autoadmit rw.slow-hyp-arities)
+(%autoadmit rw.hyp-arities)
+
+(%autoprove true-listp-of-rw.hyp-arities
+            (%enable default rw.hyp-arities))
+
+(%autoprove rw.hyp-arities-removal
+            (%enable default rw.hyp-arities rw.slow-hyp-arities))
+
+(%autoprove logic.slow-hyp-arities-correct
+            (%forcingp nil)
+            (%enable default rw.hyp-atblp rw.slow-hyp-arities))
+
+
+(%autoadmit rw.slow-hyp-list-arities)
+(%autoadmit rw.hyp-list-arities)
+
+(%autoprove true-listp-of-rw.hyp-list-arities
+            (%autoinduct rw.hyp-list-arities)
+            (%restrict default rw.hyp-list-arities (equal x 'x)))
+
+(%autoprove rw.hyp-list-arities-removal
+            (%autoinduct rw.hyp-list-arities)
+            (%restrict default rw.hyp-list-arities (equal x 'x))
+            (%restrict default rw.slow-hyp-list-arities (equal x 'x)))
+
+(%autoprove rw.slow-hyp-list-arities-correct
+            (%cdr-induction x)
+            (%forcingp nil)
+            (%restrict default rw.hyp-list-atblp (equal x 'x))
+            (%restrict default rw.slow-hyp-list-arities (equal x 'x)))
+
+
+
+(%autoadmit rw.slow-rule-arities)
+(%autoadmit rw.rule-arities)
+
+(%autoprove true-listp-of-rw.rule-arities
+            (%enable default rw.rule-arities))
+
+(%autoprove rw.rule-arities-removal
+            (%enable default rw.rule-arities rw.slow-rule-arities))
+
+(%autoprove rw.slow-rule-arities-correct
+            (%forcingp nil)
+            (%enable default rw.slow-rule-arities rw.rule-atblp))
+
+
+
+(%autoadmit rw.slow-rule-list-arities)
+(%autoadmit rw.rule-list-arities)
+
+(%autoprove true-listp-of-rw.rule-list-arities
+            (%autoinduct rw.rule-list-arities)
+            (%restrict default rw.rule-list-arities (equal x 'x)))
+
+(%autoprove rw.rule-list-arities-removal
+            (%autoinduct rw.rule-list-arities)
+            (%restrict default rw.rule-list-arities (equal x 'x))
+            (%restrict default rw.slow-rule-list-arities (equal x 'x)))
+
+(%autoprove rw.slow-rule-list-arities-correct
+            (%cdr-induction x)
+            (%forcingp nil)
+            (%restrict default rw.rule-list-atblp (equal x 'x))
+            (%restrict default rw.slow-rule-list-arities (equal x 'x)))
+
+
+(%autoadmit rw.slow-rule-list-list-arities)
+(%autoadmit rw.rule-list-list-arities)
+
+(%autoprove true-listp-of-rw.rule-list-list-arities
+            (%autoinduct rw.rule-list-list-arities)
+            (%restrict default rw.rule-list-list-arities (equal x 'x)))
+
+(%autoprove rw.rule-list-list-arities-removal
+            (%autoinduct rw.rule-list-list-arities)
+            (%restrict default rw.rule-list-list-arities (equal x 'x))
+            (%restrict default rw.slow-rule-list-list-arities (equal x 'x)))
+
+(%autoprove rw.slow-rule-list-list-arities-correct
+            (%cdr-induction x)
+            (%forcingp nil)
+            (%restrict default rw.slow-rule-list-list-arities (equal x 'x))
+            (%restrict default rw.rule-list-list-atblp (equal x 'x)))
+
+
+
+(%autoadmit rw.slow-typed-rulemap-arities)
+(%autoadmit rw.typed-rulemap-arities)
+
+(%autoprove true-listp-of-rw.typed-rulemap-arities
+            (%autoinduct rw.typed-rulemap-arities)
+            (%restrict default rw.typed-rulemap-arities (equal x 'x)))
+
+(%autoprove rw.typed-rulemap-arities-removal
+            (%autoinduct rw.typed-rulemap-arities)
+            (%restrict default rw.typed-rulemap-arities (equal x 'x))
+            (%restrict default rw.slow-typed-rulemap-arities (equal x 'x)))
+
+(%autoprove rw.slow-typed-rulemap-arities-correct
+            (%cdr-induction x)
+            (%restrict default rw.slow-typed-rulemap-arities (equal x 'x)))
+
+
+(%autoadmit rw.slow-theory-arities)
+(%autoadmit rw.theory-arities)
+
+(%autoprove true-listp-of-rw.theory-arities
+            (%autoinduct rw.theory-arities)
+            (%restrict default rw.theory-arities (equal x 'x)))
+
+(%autoprove rw.theory-arities-removal
+            (%autoinduct rw.theory-arities)
+            (%restrict default rw.theory-arities (equal x 'x))
+            (%restrict default rw.slow-theory-arities (equal x 'x)))
+
+(%autoprove rw.slow-theory-arities-correct
+            (%autoinduct rw.slow-theory-arities)
+            (%forcingp nil)
+            (%restrict default rw.slow-theory-arities (equal x 'x))
+            (%restrict default rw.theory-atblp (equal x 'x)))
+
+
+(%autoadmit rw.slow-theory-map-arities)
+(%autoadmit rw.theory-map-arities)
+
+(%autoprove true-listp-of-rw.theory-map-arities
+            (%autoinduct rw.theory-map-arities)
+            (%restrict default rw.theory-map-arities (equal x 'x)))
+
+(%autoprove rw.theory-map-arities-removal
+            (%autoinduct rw.theory-map-arities)
+            (%restrict default rw.theory-map-arities (equal x 'x))
+            (%restrict default rw.slow-theory-map-arities (equal x 'x)))
+
+(%autoprove rw.slow-theory-map-arities-correct
+            (%autoinduct rw.slow-theory-map-arities)
+            (%restrict default rw.slow-theory-map-arities (equal x 'x)))
+
+(%autoadmit rw.slow-rule-list-thms)
+(%autoadmit rw.rule-list-thms)
+
+(%autoprove true-listp-of-rw.rule-list-thms
+            (%autoinduct rw.rule-list-thms)
+            (%restrict default rw.rule-list-thms (equal x 'x)))
+
+(%autoprove rw.rule-list-thms-removal
+            (%autoinduct rw.rule-list-thms)
+            (%restrict default rw.rule-list-thms (equal x 'x))
+            (%restrict default rw.slow-rule-list-thms (equal x 'x)))
+
+(%autoprove rw.slow-rule-list-thms-correct
+            (%cdr-induction x)
+            (%restrict default rw.slow-rule-list-thms (equal x 'x))
+            (%restrict default rw.rule-list-env-okp (equal x 'x))
+            (%enable default rw.rule-env-okp))
+
+
+
+(%autoadmit rw.slow-rule-list-list-thms)
+(%autoadmit rw.rule-list-list-thms)
+
+(%autoprove true-listp-of-rw.rule-list-list-thms
+            (%autoinduct rw.rule-list-list-thms)
+            (%restrict default rw.rule-list-list-thms (equal x 'x)))
+
+(%autoprove rw.rule-list-list-thms-removal
+            (%autoinduct rw.rule-list-list-thms)
+            (%restrict default rw.rule-list-list-thms (equal x 'x))
+            (%restrict default rw.slow-rule-list-list-thms (equal x 'x)))
+
+(%autoprove rw.slow-rule-list-list-thms-correct
+            (%cdr-induction x)
+            (%restrict default rw.slow-rule-list-list-thms (equal x 'x))
+            (%restrict default rw.rule-list-list-env-okp (equal x 'x)))
+
+
+(%autoadmit rw.slow-typed-rulemap-thms)
+(%autoadmit rw.typed-rulemap-thms)
+
+(%autoprove true-listp-of-rw.typed-rulemap-thms
+            (%autoinduct rw.typed-rulemap-thms)
+            (%restrict default rw.typed-rulemap-thms (equal x 'x)))
+
+(%autoprove rw.typed-rulemap-thms-removal
+            (%autoinduct rw.typed-rulemap-thms)
+            (%restrict default rw.typed-rulemap-thms (equal x 'x))
+            (%restrict default rw.slow-typed-rulemap-thms (equal x 'x)))
+
+(%autoprove rw.slow-typed-rulemap-thms-correct
+            (%cdr-induction x)
+            (%restrict default rw.slow-typed-rulemap-thms (equal x 'x)))
+
+
+(%autoadmit rw.slow-theory-thms)
+(%autoadmit rw.theory-thms)
+
+(%autoprove true-listp-of-rw.theory-thms
+            (%autoinduct rw.theory-thms)
+            (%restrict default rw.theory-thms (equal x 'x)))
+
+(%autoprove rw.theory-thms-removal
+            (%autoinduct rw.theory-thms)
+            (%restrict default rw.theory-thms (equal x 'x))
+            (%restrict default rw.slow-theory-thms (equal x 'x)))
+
+(%autoprove rw.slow-theory-thms-correct
+            (%autoinduct rw.slow-theory-thms)
+            (%forcingp nil)
+            (%restrict default rw.slow-theory-thms (equal x 'x))
+            (%restrict default rw.theory-env-okp (equal x 'x)))
+
+
+(%autoadmit rw.slow-theory-list-thms)
+(%autoadmit rw.theory-list-thms)
+
+(%autoprove true-listp-of-rw.theory-list-thms
+            (%autoinduct rw.theory-list-thms)
+            (%restrict default rw.theory-list-thms (equal x 'x)))
+
+(%autoprove rw.theory-list-thms-removal
+            (%autoinduct rw.theory-list-thms)
+            (%restrict default rw.theory-list-thms (equal x 'x))
+            (%restrict default rw.slow-theory-list-thms (equal x 'x)))
+
+(%autoprove rw.slow-theory-list-thms-correct
+            (%cdr-induction x)
+            (%restrict default rw.slow-theory-list-thms (equal x 'x)))
+
+
+(%autoadmit rw.slow-theory-map-thms)
+(%autoadmit rw.theory-map-thms)
+
+(%autoprove true-listp-of-rw.theory-map-thms
+            (%autoinduct rw.theory-map-thms)
+            (%restrict default rw.theory-map-thms (equal x 'x)))
+
+(%autoprove rw.theory-map-thms-removal
+            (%autoinduct rw.theory-map-thms)
+            (%restrict default rw.theory-map-thms (equal x 'x))
+            (%restrict default rw.slow-theory-map-thms (equal x 'x)))
+
+(%autoprove rw.slow-theory-map-thms-correct
+            (%cdr-induction x)
+            (%restrict default rw.slow-theory-map-thms (equal x 'x)))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/theoryp"
+                                         ;; we probably just shouldn't even introduce a :induction rule for
+                                         ;; this.  there's no milawa equivalent.
+                                         induction-for-rw.theory-allrules)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/try-equiv-database.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/try-equiv-database.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/try-equiv-database.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/try-equiv-database.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,147 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqdatabasep")
+(%interactive)
+
+
+(defsection rw.eqtrace-list-lookup
+  (%autoadmit rw.eqtrace-list-lookup)
+  (local (%restrict default rw.eqtrace-list-lookup (equal eqtraces 'eqtraces)))
+  (%autoprove forcing-rw.eqtrace-list-lookup-under-iff
+              ;; BOZO inappropriately uses x
+              (%autoinduct rw.eqtrace-list-lookup x eqtraces))
+  (%autoprove forcing-rw.eqtracep-of-rw.eqtrace-list-lookup
+              (%autoinduct rw.eqtrace-list-lookup))
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.eqtrace-list-lookup
+              (%autoinduct rw.eqtrace-list-lookup))
+  (%autoprove forcing-rw.eqtrace-okp-of-rw.eqtrace-list-lookup
+              (%autoinduct rw.eqtrace-list-lookup))
+  (%autoprove forcing-memberp-of-rw.eqtrace-list-lookup
+              (%autoinduct rw.eqtrace-list-lookup))
+  (%autoprove forcing-eqtrace->rhs-of-rw.eqtrace-list-lookup
+              (%autoinduct rw.eqtrace-list-lookup))
+  (%autoprove rw.eqtrace->lhs-of-rw.eqtrace-list-lookup-when-all-equalp
+              (%disable default forcing-rw.eqtrace-list-lookup-under-iff))
+  (%autoprove forcing-rw.eqtrace->iffp-of-rw.eqtrace-list-lookup-in-rw.eqset->tail
+              (%use (%instance (%thm rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps)
+                               (a    (rw.eqtrace-list-lookup term (rw.eqset->tail eqset)))
+                               (x    (rw.eqset->tail eqset))
+                               (iffp (rw.eqset->iffp eqset)))))
+  (%autoprove forcing-rw.eqtrace->lhs-of-rw.eqtrace-list-lookup-in-rw.eqset->tail
+              (%use (%instance (%thm rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses)
+                               (a    (rw.eqtrace-list-lookup term (rw.eqset->tail eqset)))
+                               (x    (rw.eqset->tail eqset))
+                               (lhs  (rw.eqset->head eqset))))))
+
+
+(defsection rw.eqset-lookup
+  (%autoadmit rw.eqset-lookup)
+  (local (%enable default rw.eqset-lookup))
+  (%autoprove rw.eqset-lookup-of-term-and-nil)
+  (%autoprove forcing-rw.eqtracep-of-rw.eqset-lookup)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.eqset-lookup)
+  (%autoprove forcing-rw.eqtrace-okp-of-rw.eqset-lookup)
+  (%autoprove forcing-memberp-of-rw.eqset-lookup)
+  (%autoprove forcing-eqtrace->iffp-of-rw.eqset-lookup)
+  (%autoprove forcing-eqtrace->rhs-of-rw.eqset-lookup)
+  (%autoprove forcing-eqtrace->lhs-of-rw.eqset-lookup))
+
+
+(%autoprove lemma-for-rw.eqset-lookup-of-rw.eqset->head (%cdr-induction x))
+(%autoprove lemma-2-for-rw.eqset-lookup-of-rw.eqset->head (%cdr-induction x))
+(%autoprove forcing-rw.eqset-lookup-of-rw.eqset->head
+            (%enable default
+                     rw.eqset-lookup
+                     lemma-for-rw.eqset-lookup-of-rw.eqset->head
+                     lemma-2-for-rw.eqset-lookup-of-rw.eqset->head))
+
+
+(%autoprove forcing-rw.eqset-lookup-of-rw.eqset->head-free)
+
+(%autoprove forcing-memberp-of-rw.eqset->head-in-rw.eqtrace-list-rhses-of-rw.eqset->tail
+            (%use (%instance (%thm lemma-for-rw.eqset-lookup-of-rw.eqset->head)
+                             (lhs (rw.eqset->head eqset))
+                             (x   (rw.eqset->tail eqset)))))
+
+(%autoprove forcing-memberp-of-rw.eqset->head-in-rw.eqtrace-list-rhses-of-rw.eqset->tail-free)
+
+(%autoprove forcing-memberp-of-rw.eqtrace-list-rhses-of-rw.eqset->tail-when-smaller-than-head
+            (%use (%instance (%thm lemma-for-rw.eqset-lookup-of-rw.eqset->head)
+                             (lhs (rw.eqset->head eqset))
+                             (x   (rw.eqset->tail eqset)))))
+
+(%autoprove forcing-logic.term-<-of-rw.eqset->head-when-rw.eqset-lookup
+            (%enable default
+                     rw.eqset-lookup
+                     lemma-for-rw.eqset-lookup-of-rw.eqset->head
+                     lemma-2-for-rw.eqset-lookup-of-rw.eqset->head))
+
+
+(defsection rw.eqset-list-lookup
+  (%autoadmit rw.eqset-list-lookup)
+  (local (%restrict default rw.eqset-list-lookup (equal eqsets 'eqsets)))
+  (%autoprove forcing-rw.eqtracep-of-rw.eqset-list-lookup
+              (%cdr-induction eqsets))
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.eqset-list-lookup
+              (%cdr-induction eqsets))
+  (%autoprove forcing-rw.eqtrace-okp-of-rw.eqset-list-lookup
+              (%cdr-induction eqsets))
+  (%autoprove forcing-eqtrace->rhs-of-rw.eqset-list-lookup
+              (%cdr-induction eqsets))
+  (%autoprove forcing-rw.eqtrace->iffp-of-rw.eqset-list-lookup-when-all-equalp
+              (%cdr-induction eqsets)))
+
+
+(defsection rw.try-equiv-database
+  (%autoadmit rw.try-equiv-database)
+  (local (%enable default rw.try-equiv-database))
+  (%autoprove forcing-rw.eqtracep-of-rw.try-equiv-database)
+  (%autoprove forcing-rw.eqtrace-atblp-of-rw.try-equiv-database)
+  (%autoprove forcing-rw.eqtrace-okp-of-rw.try-equiv-database)
+  (%autoprove forcing-eqtrace->rhs-of-rw.try-equiv-database)
+  (%autoprove forcing-eqtrace->iffp-of-rw.try-equiv-database
+              (%use (%instance (%thm forcing-rw.eqtrace->iffp-of-rw.eqset-list-lookup-when-all-equalp)
+                               (iffp nil)
+                               (eqsets (rw.eqdatabase->equalsets database))
+                               (term term)))
+              (%use (%instance (%thm forcing-rw.eqtrace->iffp-of-rw.eqset-list-lookup-when-all-equalp)
+                               (iffp t)
+                               (eqsets (rw.eqdatabase->iffsets database))
+                               (term term)))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/assms/try-equiv-database")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/urewrite-builders.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/urewrite-builders.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/urewrite-builders.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/urewrite-builders.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,205 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-builders") ;; for fail-trace
+(%interactive)
+
+
+(local (%enable default booleanp-of-rw.trace->iffp))
+(local (%disable default forcing-booleanp-of-rw.trace->iffp))
+
+
+
+(defsection rw.urewrite-if-specialcase-same-trace
+
+  (%autoadmit rw.urewrite-if-specialcase-same-trace)
+
+  (local (%enable default rw.urewrite-if-specialcase-same-trace))
+
+  (%autoprove rw.trace->method-of-rw.urewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->hypbox-of-rw.urewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->lhs-of-rw.urewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->rhs-of-rw.urewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->iffp-of-rw.urewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->subtraces-of-rw.urewrite-if-specialcase-same-trace)
+  (%autoprove rw.trace->extras-of-rw.urewrite-if-specialcase-same-trace)
+  (%autoprove forcing-rw.tracep-of-rw.urewrite-if-specialcase-same-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.urewrite-if-specialcase-same-trace)
+
+  (local (%disable default rw.urewrite-if-specialcase-same-trace))
+
+  (%autoprove lemma-forcing-rw.urewrite-if-specialcase-same-tracep-of-rw.urewrite-if-specialcase-same-trace
+              (%enable default rw.urewrite-if-specialcase-same-tracep))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.urewrite-if-specialcase-same-trace
+              (%enable default
+                       lemma-forcing-rw.urewrite-if-specialcase-same-tracep-of-rw.urewrite-if-specialcase-same-trace
+                       rw.trace-step-okp))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.urewrite-if-specialcase-same-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.urewrite-if-specialcase-same-trace x y a)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.urewrite-if-specialcase-same-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.urewrite-if-specialcase-same-trace
+              (%enable default rw.trace-step-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.urewrite-if-specialcase-same-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.urewrite-if-specialcase-same-trace x y a)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.urewrite-if-specialcase-same-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.urewrite-if-specialcase-same-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.urewrite-if-generalcase-trace
+
+  (%autoadmit rw.urewrite-if-generalcase-trace)
+
+  (local (%enable default rw.urewrite-if-generalcase-trace))
+  (local (%splitlimit 10))
+
+  (%autoprove rw.trace->method-of-rw.urewrite-if-generalcase-trace)
+  (%autoprove rw.trace->hypbox-of-rw.urewrite-if-generalcase-trace)
+  (%autoprove rw.trace->lhs-of-rw.urewrite-if-generalcase-trace)
+  (%autoprove rw.trace->rhs-of-rw.urewrite-if-generalcase-trace)
+  (%autoprove rw.trace->iffp-of-rw.urewrite-if-generalcase-trace)
+  (%autoprove rw.trace->subtraces-of-rw.urewrite-if-generalcase-trace)
+  (%autoprove rw.trace->extras-of-rw.urewrite-if-generalcase-trace)
+  (%autoprove forcing-rw.tracep-of-rw.urewrite-if-generalcase-trace)
+  (%autoprove forcing-rw.trace-atblp-of-rw.urewrite-if-generalcase-trace)
+
+  (local (%disable default rw.urewrite-if-generalcase-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.urewrite-if-generalcase-trace
+              (%enable default rw.trace-step-okp rw.urewrite-if-generalcase-tracep))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.urewrite-if-generalcase-trace
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.urewrite-if-generalcase-trace x y z)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.urewrite-if-generalcase-trace))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.urewrite-if-generalcase-trace
+              (%enable default rw.trace-step-env-okp rw.urewrite-if-generalcase-tracep))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.urewrite-if-generalcase-trace
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.urewrite-if-generalcase-trace x y z)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.urewrite-if-generalcase-trace))
+
+  (%autoprove rw.collect-forced-goals-of-rw.urewrite-if-generalcase-trace
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+(defsection rw.try-urewrite-rule
+
+  (%autoadmit rw.try-urewrite-rule)
+
+  (local (%enable default rw.try-urewrite-rule))
+  (local (%splitlimit 10))
+
+  (%autoprove lemma-forcing-rw.trace->method-of-rw.try-urewrite-rule)
+  (%autoprove forcing-rw.trace->hypbox-of-rw.try-urewrite-rule)
+  (%autoprove forcing-rw.trace->lhs-of-rw.try-urewrite-rule)
+  (%autoprove forcing-rw.trace->iffp-of-rw.try-urewrite-rule)
+  (%autoprove lemma-forcing-rw.trace->subtraces-of-rw.try-urewrite-rule)
+  (%autoprove lemma-forcing-rw.trace->extras-of-rw.try-urewrite-rule)
+  (%autoprove forcing-rw.tracep-of-rw.try-urewrite-rule)
+  (%autoprove forcing-rw.trace-atblp-of-rw.try-urewrite-rule)
+
+  (%autoprove lemma-forcing-rw.urewrite-rule-tracep-of-rw.try-urewrite-rule
+              (%enable default rw.urewrite-rule-tracep))
+
+  (local (%disable default rw.try-urewrite-rule))
+  (local (%enable default
+                  lemma-forcing-rw.trace->method-of-rw.try-urewrite-rule
+                  lemma-forcing-rw.trace->subtraces-of-rw.try-urewrite-rule
+                  lemma-forcing-rw.trace->extras-of-rw.try-urewrite-rule
+                  lemma-forcing-rw.urewrite-rule-tracep-of-rw.try-urewrite-rule))
+
+  (%autoprove lemma-forcing-rw.trace-step-okp-of-rw.try-urewrite-rule
+              (%enable default rw.trace-step-okp))
+
+  (%autoprove forcing-rw.trace-okp-of-rw.try-urewrite-rule
+              (%restrict default definition-of-rw.trace-okp (equal x '(rw.try-urewrite-rule hypbox term rule iffp control)))
+              (%enable default lemma-forcing-rw.trace-step-okp-of-rw.try-urewrite-rule))
+
+  (%autoprove lemma-forcing-rw.trace-step-env-okp-of-rw.try-urewrite-rule
+              (%enable default rw.trace-step-env-okp rw.urewrite-rule-trace-env-okp))
+
+  (%autoprove forcing-rw.trace-env-okp-of-rw.try-urewrite-rule
+              (%restrict default definition-of-rw.trace-env-okp (equal x '(rw.try-urewrite-rule hypbox term rule iffp control)))
+              (%enable default lemma-forcing-rw.trace-step-env-okp-of-rw.try-urewrite-rule))
+
+  (%autoprove forcing-rw.collect-forced-goals-of-rw.try-urewrite-rule
+              (%enable default definition-of-rw.collect-forced-goals)))
+
+
+
+
+(defsection rw.try-urewrite-rule-list
+  (%autoadmit rw.try-urewrite-rule-list)
+  (local (%restrict default rw.try-urewrite-rule-list (equal rules 'rules)))
+  (%autoprove forcing-rw.trace->lhs-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules))
+  (%autoprove forcing-rw.trace->iffp-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules))
+  (%autoprove forcing-rw.trace->hypbox-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules))
+  (%autoprove forcing-rw.tracep-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules))
+  (%autoprove forcing-rw.trace-atblp-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules))
+  (%autoprove forcing-rw.trace-okp-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules))
+  (%autoprove forcing-rw.trace-env-okp-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules))
+  (%autoprove forcing-rw.collect-forced-goals-of-rw.try-urewrite-rule-list
+              (%cdr-induction rules)))
+
+
+(defsection rw.try-urewrite-rules
+  (%autoadmit rw.try-urewrite-rules)
+  (local (%enable default rw.try-urewrite-rules))
+  (%autoprove forcing-rw.trace->lhs-of-rw.try-urewrite-rules)
+  (%autoprove forcing-rw.trace->iffp-of-rw.try-urewrite-rules)
+  (%autoprove forcing-rw.trace->hypbox-of-rw.try-urewrite-rules)
+  (%autoprove forcing-rw.tracep-of-rw.try-urewrite-rules)
+  (%autoprove forcing-rw.trace-atblp-of-rw.try-urewrite-rules)
+  (%autoprove forcing-rw.trace-okp-of-rw.try-urewrite-rules)
+  (%autoprove forcing-rw.trace-env-okp-of-rw.try-urewrite-rules)
+  (%autoprove forcing-rw.collect-forced-goals-of-rw.try-urewrite-rules))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/traces/urewrite-builders")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/urewrite-clause.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/urewrite-clause.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/urewrite-clause.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/urewrite-clause.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,57 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "urewrite")
+(%interactive)
+
+(defsection rw.urewrite-clause-bldr
+  (%autoadmit rw.urewrite-clause-bldr)
+  (local (%enable default rw.urewrite-clause-bldr))
+  (%autoprove forcing-logic.appealp-of-rw.urewrite-clause-bldr)
+  (%autoprove forcing-logic.conclusion-of-rw.urewrite-clause-bldr)
+  (%autoprove forcing-logic.proofp-of-rw.urewrite-clause-bldr))
+
+(defsection rw.urewrite-clause-list-bldr
+  (%autoadmit rw.urewrite-clause-list-bldr)
+  (local (%restrict default rw.urewrite-clause-list-bldr (equal x 'x)))
+  (%autoprove forcing-logic.appeal-listp-of-rw.urewrite-clause-list-bldr
+              (%autoinduct rw.urewrite-clause-list-bldr))
+  (%autoprove forcing-logic.strip-conclusions-of-rw.urewrite-clause-list-bldr
+              (%autoinduct rw.urewrite-clause-list-bldr))
+  (%autoprove forcing-logic.proof-listp-of-rw.urewrite-clause-list-bldr
+              (%autoinduct rw.urewrite-clause-list-bldr)))
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/urewrite-clause")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/urewrite.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/urewrite.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/urewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/urewrite.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,292 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "urewrite-builders")
+(%interactive)
+
+(%autoadmit rw.empty-hypbox)
+
+(%autoadmit rw.flag-urewrite)
+(%autoadmit rw.urewrite)
+(%autoadmit rw.urewrite-list)
+
+(%autoprove definition-of-rw.urewrite
+            (%enable default rw.urewrite rw.urewrite-list)
+            (%restrict default rw.flag-urewrite (equal x 'x)))
+
+(%autoprove definition-of-rw.urewrite-list
+            (%enable default rw.urewrite rw.urewrite-list)
+            (%restrict default rw.flag-urewrite (equal x 'x)))
+
+(%autoprove rw.flag-urewrite-of-term
+            (%enable default rw.urewrite))
+
+(%autoprove rw.flag-urewrite-of-list
+            (%enable default rw.urewrite-list))
+
+
+(%autoprove rw.urewrite-list-when-not-consp
+            (%restrict default definition-of-rw.urewrite-list (equal x 'x)))
+
+(%autoprove rw.urewrite-list-of-cons
+            (%restrict default definition-of-rw.urewrite-list (equal x '(cons a x))))
+
+(%defprojection :list (rw.urewrite-list x iffp control n)
+                :element (rw.urewrite x iffp control n))
+
+(local (%disable default
+                 formula-decomposition
+                 type-set-like-rules
+                 expensive-arithmetic-rules
+                 expensive-arithmetic-rules-two
+                 unusual-memberp-rules
+                 unusual-subsetp-rules
+                 same-length-prefixes-equal-cheap
+                 forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                 minus-when-not-less
+                 rw.tracep-when-memberp-of-rw.trace-listp
+                 rw.trace-list-rhses-when-not-consp))
+
+(local (%splitlimit 10))
+
+(%autoprove lemma-for-forcing-rw.tracep-of-rw.urewrite
+            (%autoinduct rw.flag-urewrite flag x iffp control n)
+            (%disable default expensive-term/formula-inference)
+            (%auto :strategy (split cleanup urewrite))
+            (%auto)
+            (%restrict default definition-of-rw.urewrite (equal x 'x))
+            (%enable default expensive-term/formula-inference)
+            (%auto))
+
+(%autoprove forcing-rw.tracep-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-listp-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.tracep-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+;; BOZO probably just take this out of our disables from above.
+(local (%enable default expensive-arithmetic-rules-two))
+
+
+(%autoprove lemma-for-forcing-rw.trace->iffp-of-rw.urewrite
+            (%autoinduct rw.flag-urewrite flag x iffp control n)
+            (%disable default expensive-term/formula-inference)
+            (%auto :strategy (split cleanup urewrite))
+            (%auto)
+            (%restrict default definition-of-rw.urewrite (equal x 'x))
+            (%auto)
+            (%enable default expensive-term/formula-inference))
+
+(%autoprove forcing-rw.trace->iffp-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-iffps-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->iffp-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-rw.trace->lhs-of-rw.urewrite
+            (%autoinduct rw.flag-urewrite flag x iffp control n)
+            (%disable default expensive-term/formula-inference)
+            (%auto :strategy (split cleanup urewrite))
+            (%auto)
+            (%restrict default definition-of-rw.urewrite (equal x 'x))
+            (%auto)
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition))
+
+(%autoprove forcing-rw.trace->lhs-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-lhses-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->lhs-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-rw.trace->nhyps-of-rw.urewrite
+            (%autoinduct rw.flag-urewrite flag x iffp control n)
+            (%disable default expensive-term/formula-inference)
+            (%auto :strategy (split urewrite crewrite))
+            (%restrict default definition-of-rw.urewrite (equal x 'x))
+            (%auto)
+            (%enable default
+                     expensive-term/formula-inference
+                     formula-decomposition))
+
+(%autoprove forcing-rw.trace->nhyps-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->nhyps-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-nhyps-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace->nhyps-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+
+(%autoprove lemma-for-forcing-rw.trace-atblp-of-rw.urewrite
+            (%autoinduct rw.flag-urewrite flag x iffp control n)
+            (%disable default expensive-term/formula-inference)
+            (%liftlimit 1)
+            (%create-theory splitters)
+            (%enable splitters (gather from default (not (clause.simple-termp rhs))))
+            (%disable default splitters)
+            (%auto :strategy (urewrite cleanup split))
+            (%forcingp nil)
+            (%auto)
+            (%enable default splitters)
+            (%auto)
+            (%restrict default definition-of-rw.urewrite (equal x 'x)))
+
+(%autoprove forcing-rw.trace-atblp-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-atblp-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-atblp-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-rw.trace-env-okp-of-rw.urewrite
+            (%autoinduct rw.flag-urewrite flag x iffp control n)
+            (%disable default expensive-term/formula-inference)
+            (%liftlimit 1)
+            (%create-theory splitters)
+            (%enable splitters (gather from default (not (clause.simple-termp rhs))))
+            (%disable default splitters)
+            (%auto :strategy (urewrite cleanup split))
+            (%forcingp nil)
+            (%auto)
+            (%enable default splitters)
+            (%auto)
+            (%restrict default definition-of-rw.urewrite (equal x 'x)))
+
+(%autoprove forcing-rw.trace-env-okp-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-env-okp-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-env-okp-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-rw.trace-okp-of-rw.urewrite
+            (%autoinduct rw.flag-urewrite flag x iffp control n)
+            (%disable default expensive-term/formula-inference)
+            (%liftlimit 1)
+            (%create-theory splitters)
+            (%enable splitters (gather from default (not (clause.simple-termp rhs))))
+            (%disable default splitters)
+            (%auto :strategy (urewrite cleanup split))
+            (%forcingp nil)
+            (%auto)
+            (%enable default splitters)
+            (%auto)
+            (%restrict default definition-of-rw.urewrite (equal x 'x))
+            (%auto)
+            (%enable default expensive-term/formula-inference))
+
+(%autoprove forcing-rw.trace-okp-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.trace-list-okp-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.trace-okp-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-rw.collect-forced-goals-of-rw.urewrite
+            (%autoinduct rw.flag-urewrite flag x iffp control n)
+            (%disable default expensive-term/formula-inference)
+            (%liftlimit 1)
+            (%create-theory splitters)
+            (%enable splitters (gather from default (not (clause.simple-termp rhs))))
+            (%disable default splitters)
+            (%auto :strategy (urewrite cleanup split))
+            (%forcingp nil)
+            (%auto)
+            (%enable default splitters)
+            (%auto)
+            (%restrict default definition-of-rw.urewrite (equal x 'x)))
+
+(%autoprove forcing-rw.collect-forced-goals-of-rw.urewrite
+            (%use (%instance (%thm lemma-for-forcing-rw.collect-forced-goals-of-rw.urewrite)
+                             (flag 'term))))
+
+(%autoprove forcing-rw.collect-forced-goals-list-of-rw.urewrite-list
+            (%use (%instance (%thm lemma-for-forcing-rw.collect-forced-goals-of-rw.urewrite)
+                             (flag 'list))))
+
+
+
+(%autoprove forcing-rw.trace-list-formulas-of-rw.urewrite-list
+            (%use (%instance (%thm rw.trace-list-formulas-when-all-equalp-of-rw.trace-list-hypboxes)
+                             (hypbox (rw.empty-hypbox))
+                             (x (rw.urewrite-list x iffp control n)))))
+
+(%autoprove forcing-rw.trace-list-conclusion-formulas-of-rw.urewrite-list
+            (%cdr-induction x)
+            (%restrict default rw.trace-list-conclusion-formulas (equal x 'x))
+            (%enable default rw.trace-conclusion-formula))
+
+
+
+(%defprojection :list (rw.urewrite-list-list x iffp control n)
+                :element (rw.urewrite-list x iffp control n))
+
+(%autoprove cons-listp-of-rw.urewrite-list-list
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.trace-list-listp-of-rw.urewrite-list-list
+            (%cdr-induction x))
+
+(%autoprove forcing-rw.collect-forced-goals-list-list-of-rw.urewrite-list-list
+            (%cdr-induction x))
+
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/urewrite")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/world-check.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/world-check.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/world-check.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/world-check.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,253 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "worldp")
+(%interactive)
+
+(%autoadmit tactic.slow-world-arities)
+(%autoadmit tactic.world-arities)
+
+(%autoprove true-listp-of-tactic.world-arities
+            (%enable default tactic.world-arities))
+
+(%autoprove tactic.world-arities-removal
+            (%enable default tactic.world-arities)
+            (%enable default tactic.slow-world-arities))
+
+(%autoprove tactic.slow-world-arities-correct
+            (%forcingp nil)
+            (%enable default tactic.slow-world-arities tactic.world-atblp))
+
+
+(%autoadmit tactic.slow-world-list-arities)
+(%autoadmit tactic.world-list-arities)
+
+(%autoprove true-listp-of-tactic.world-list-arities
+            (%autoinduct tactic.world-list-arities)
+            (%restrict default tactic.world-list-arities (equal x 'x)))
+
+(%autoprove tactic.world-list-arities-removal
+            (%autoinduct tactic.world-list-arities)
+            (%restrict default tactic.world-list-arities (equal x 'x))
+            (%restrict default tactic.slow-world-list-arities (equal x 'x)))
+
+(%autoprove tactic.slow-world-list-arities-correct
+            (%autoinduct tactic.slow-world-list-arities)
+            (%restrict default tactic.slow-world-list-arities (equal x 'x))
+            (%restrict default tactic.world-list-atblp (equal x 'x)))
+
+
+(%autoadmit tactic.slow-world-partial-arities)
+(%autoadmit tactic.world-partial-arities)
+
+(%autoprove true-listp-of-tactic.world-partial-arities
+            (%enable default tactic.world-partial-arities))
+
+(%autoprove tactic.world-partial-arities-removal
+            (%enable default tactic.world-partial-arities)
+            (%enable default tactic.slow-world-partial-arities))
+
+(%autoprove tactic.slow-world-partial-arities-correct
+            (%forcingp nil)
+            (%enable default tactic.world-atblp)
+            (%enable default tactic.slow-world-partial-arities))
+
+
+(%autoadmit tactic.slow-world-list-partial-arities)
+(%autoadmit tactic.world-list-partial-arities)
+
+(%autoprove true-listp-of-tactic.world-list-partial-arities
+            (%autoinduct tactic.world-list-partial-arities)
+            (%restrict default tactic.world-list-partial-arities (equal x 'x)))
+
+(%autoprove tactic.world-list-partial-arities-removal
+            (%autoinduct tactic.world-list-partial-arities)
+            (%restrict default tactic.world-list-partial-arities (equal x 'x))
+            (%restrict default tactic.slow-world-list-partial-arities (equal x 'x)))
+
+(%autoadmit tactic.world-list-compatiblep-hack)
+
+(%autoprove tactic.slow-world-list-partial-arities-correct
+            (%cdr-induction x)
+            (%forcingp nil)
+            (%restrict default tactic.world-list-compatiblep-hack (or (equal x 'x) (equal x '(cdr x))))
+            (%restrict default tactic.slow-world-list-partial-arities (or (equal x 'x) (equal x '(cdr x)))))
+
+
+(%autoadmit tactic.fast-world-list-atblp)
+
+(%autoprove tactic.fast-world-list-atblp-is-tactic.world-list-atblp
+            (%enable default tactic.fast-world-list-atblp)
+            (%forcingp nil))
+
+
+(%autoadmit tactic.world-thms-okp)
+(%autoadmit tactic.world-axioms-okp)
+
+(%autoprove booleanp-of-tactic.world-thms-okp
+            (%enable default tactic.world-thms-okp))
+
+(%autoprove booleanp-of-tactic.world-axioms-okp
+            (%enable default tactic.world-axioms-okp))
+
+(%deflist tactic.world-list-thms-okp (x thms)
+          (tactic.world-thms-okp x thms))
+
+(%deflist tactic.world-list-axioms-okp (x axioms)
+          (tactic.world-axioms-okp x axioms))
+
+(%autoprove tactic.world-env-okp-redefinition
+            (%enable default
+                     tactic.world-env-okp
+                     tactic.world-thms-okp
+                     tactic.world-axioms-okp))
+
+(%autoprove tactic.world-list-env-okp-redefinition
+            (%cdr-induction x)
+            (%enable default tactic.world-env-okp-redefinition))
+
+
+(%autoadmit tactic.slow-world-thms)
+(%autoadmit tactic.world-thms)
+
+(%autoprove true-listp-of-tactic.world-thms
+            (%enable default tactic.world-thms))
+
+(%autoprove tactic.world-thms-removal
+            (%enable default tactic.world-thms tactic.slow-world-thms))
+
+(%autoprove tactic.slow-world-thms-correct
+            (%enable default tactic.slow-world-thms tactic.world-thms-okp))
+
+
+(%autoadmit tactic.slow-world-list-thms)
+(%autoadmit tactic.world-list-thms)
+
+(%autoprove true-listp-of-tactic.world-list-thms
+            (%autoinduct tactic.world-list-thms)
+            (%restrict default tactic.world-list-thms (equal x 'x)))
+
+(%autoprove tactic.world-list-thms-removal
+            (%autoinduct tactic.world-list-thms)
+            (%restrict default tactic.world-list-thms (equal x 'x))
+            (%restrict default tactic.slow-world-list-thms (equal x 'x)))
+
+(%autoprove tactic.slow-world-list-thms-correct
+            (%cdr-induction x)
+            (%restrict default tactic.slow-world-list-thms (equal x 'x)))
+
+
+(%autoadmit tactic.slow-world-partial-thms)
+(%autoadmit tactic.world-partial-thms)
+
+(%autoprove true-listp-of-tactic.world-partial-thms
+            (%enable default tactic.world-partial-thms))
+
+(%autoprove tactic.world-partial-thms-removal
+            (%enable default tactic.world-partial-thms tactic.slow-world-partial-thms))
+
+(%autoprove tactic.slow-world-partial-thms-correct
+            (%enable default tactic.slow-world-partial-thms tactic.world-thms-okp))
+
+(%autoadmit tactic.slow-world-list-partial-thms)
+(%autoadmit tactic.world-list-partial-thms)
+
+(%autoprove true-listp-of-tactic.world-list-partial-thms
+            (%autoinduct tactic.world-list-partial-thms)
+            (%restrict default tactic.world-list-partial-thms (equal x 'x)))
+
+(%autoprove tactic.world-list-partial-thms-removal
+            (%autoinduct tactic.world-list-partial-thms)
+            (%restrict default tactic.world-list-partial-thms (equal x 'x))
+            (%restrict default tactic.slow-world-list-partial-thms (equal x 'x)))
+
+(%autoprove tactic.slow-world-list-partial-thms-correct
+            (%cdr-induction x)
+            (%restrict default tactic.world-list-compatiblep-hack
+                       (or (equal x 'x) (equal x '(cdr x))))
+            (%restrict default tactic.slow-world-list-partial-thms
+                       (or (equal x 'x) (equal x '(cdr x))))
+            (%restrict default tactic.world-list-thms-okp
+                       (or (equal x 'x) (equal x '(cdr x)))))
+
+
+(%autoadmit tactic.world-list-defs)
+
+(%autoprove true-listp-of-tactic.world-list-defs
+            (%cdr-induction x)
+            (%restrict default tactic.world-list-defs (equal x 'x)))
+
+(%autoprove tactic.world-list-defs-correct
+            (%cdr-induction x)
+            (%restrict default tactic.world-list-defs (equal x 'x))
+            (%enable default tactic.world-axioms-okp))
+
+(%autoprove tactic.world-list-partial-defs-correct
+            (%cdr-induction x)
+            (%enable default tactic.world-axioms-okp)
+            (%restrict default tactic.world-list-compatiblep-hack
+                       (or (equal x 'x) (equal x '(cdr x))))
+            (%restrict default tactic.world-list-defs
+                       (or (equal x 'x) (equal x '(cdr x)))))
+
+
+(%autoadmit tactic.fast-world-list-env-okp)
+
+(%autoprove lemma-1-for-tactic.fast-world-list-env-okp-lemma
+            (%cdr-induction x)
+            (%enable default
+                     tactic.world-thms-okp
+                     tactic.slow-world-partial-thms)
+            (%restrict default tactic.world-list-compatiblep-hack
+                       (or (equal x 'x) (equal x '(cdr x))))
+            (%restrict default tactic.slow-world-list-partial-thms
+                       (or (equal x 'x) (equal x '(cdr x)))))
+
+(%autoprove lemma-2-for-tactic.fast-world-list-env-okp-lemma
+            (%cdr-induction x)
+            (%enable default tactic.world-thms-okp))
+
+(%autoprove tactic.fast-world-list-env-okp-lemma
+            (%restrict default tactic.fast-world-list-env-okp (equal x 'x))
+            (%enable default
+                     lemma-1-for-tactic.fast-world-list-env-okp-lemma
+                     lemma-2-for-tactic.fast-world-list-env-okp-lemma))
+
+
+(%autoprove tactic.fast-world-list-env-okp-correct
+            ;; BOZO move to world-check eventually
+            (%enable default
+                     tactic.fast-world-list-env-okp-lemma
+                     tactic.world-list-env-okp-redefinition))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/worldp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/worldp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/worldp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/worldp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,212 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(in-package "MILAWA")
+(include-book "gather")
+(%interactive)
+
+(%autoprove rw.theory-env-okp-of-lookup-when-rw.theory-list-env-okp-of-range
+            (%cdr-induction theories))
+
+
+(%defaggregate tactic.world
+  (index
+   forcingp
+   betamode
+   liftlimit
+   splitlimit
+   blimit
+   rlimit
+   rwn
+   urwn
+   noexec
+   theories
+   defs
+   depth
+   allrules
+   assm-primaryp
+   assm-secondaryp
+   assm-directp
+   assm-negativep
+   )
+  :require
+  ((natp-of-tactic.world->index                         (natp index))
+   (booleanp-of-tactic.world->forcingp                  (booleanp forcingp))
+   (symbolp-of-tactic.world->betamode                   (symbolp betamode))
+   (natp-of-tactic.world->liftlimit                     (natp liftlimit))
+   (natp-of-tactic.world->splitlimit                    (natp splitlimit))
+   (natp-of-tactic.world->blimit                        (natp blimit))
+   (natp-of-tactic.world->rlimit                        (natp rlimit))
+   (natp-of-tactic.world->rwn                           (natp rwn))
+   (natp-of-tactic.world->urwn                          (natp urwn))
+   (definition-listp-of-tactic.world->defs              (definition-listp defs))
+   (natp-of-tactic.world->depth                         (natp depth))
+   (rw.theory-mapp-of-tactic.world->theories            (rw.theory-mapp theories))
+   (logic.function-symbol-listp-of-tactic.world->noexec (logic.function-symbol-listp noexec))
+   (rw.rule-listp-of-tactic.world->allrules             (rw.rule-listp allrules))
+   (booleanp-of-tactic.world->assm-primaryp             (booleanp assm-primaryp))
+   (booleanp-of-tactic.world->assm-secondaryp           (booleanp assm-secondaryp))
+   (booleanp-of-tactic.world->assm-directp              (booleanp assm-directp))
+   (booleanp-of-tactic.world->assm-negativep            (booleanp assm-negativep))
+   ))
+
+(%deflist tactic.world-listp (x)
+          (tactic.worldp x))
+
+(%autoadmit tactic.world-atblp)
+
+(%autoprove booleanp-of-tactic.world-atblp
+            (%enable default tactic.world-atblp))
+
+(%autoprove tactic.world-atblp-of-nil
+            (%enable default tactic.world-atblp))
+
+(%autoprove lemma-for-rw.theory-atblp-of-looked-up-theory
+            (%cdr-induction theories))
+
+(%autoprove rw.theory-atblp-of-looked-up-theory
+            (%enable default
+                     tactic.world-atblp
+                     lemma-for-rw.theory-atblp-of-looked-up-theory))
+
+(%autoprove tactic.world-atblp-of-tactic.world
+            (%enable default tactic.world-atblp))
+
+(%autoprove rw.theory-list-atblp-of-range-of-tactic.world->theories
+            (%enable default tactic.world-atblp))
+
+(%autoprove logic.formula-list-atblp-of-tactic.world->defs
+            (%enable default tactic.world-atblp))
+
+(%autoprove rw.rule-list-atblp-of-tactic.world->allrules
+            (%enable default tactic.world-atblp))
+
+(%deflist tactic.world-list-atblp (x atbl)
+          (tactic.world-atblp x atbl))
+
+
+
+(%autoadmit tactic.world-env-okp)
+
+(%autoprove booleanp-of-tactic.world-env-okp
+            (%enable default tactic.world-env-okp))
+
+(%autoprove tactic.world-env-okp-of-nil
+            (%enable default tactic.world-env-okp))
+
+(%autoprove lemma-for-rw.theory-env-okp-of-looked-up-theory
+            (%cdr-induction theories))
+
+(%autoprove rw.theory-env-okp-of-looked-up-theory
+            (%enable default
+                     tactic.world-env-okp
+                     lemma-for-rw.theory-env-okp-of-looked-up-theory))
+
+(%autoprove tactic.world-env-okp-of-tactic.world
+            (%enable default tactic.world-env-okp))
+
+(%autoprove rw.theory-list-env-okp-of-range-of-tactic.world->theories
+            (%enable default tactic.world-env-okp))
+
+(%autoprove subsetp-of-tactic.world->defs-and-axioms
+            (%enable default tactic.world-env-okp))
+
+(%autoprove rw.rule-list-env-okp-of-tactic.world->allrules
+            (%enable default tactic.world-env-okp))
+
+(%deflist tactic.world-list-env-okp (x axioms thms)
+  (tactic.world-env-okp x axioms thms))
+
+
+(%autoprove subsetp-of-tactic.world->defs-when-memberp
+            (%cdr-induction worlds))
+
+(%autoprove subsetp-of-tactic.world->defs-when-memberp-alt)
+
+(%autoprove rw.theory-env-okp-when-memberp
+            (%cdr-induction worlds))
+
+(%autoprove rw.theory-env-okp-when-memberp-alt
+            (%cdr-induction worlds))
+
+
+
+
+
+(%autoadmit tactic.find-world)
+
+(%autoprove tactic.worldp-of-tactic.find-world-under-iff
+            (%autoinduct tactic.find-world)
+            (%restrict default tactic.find-world (equal worlds 'worlds)))
+
+(%autoprove tactic.world-atblp-of-tactic.find-world-under-iff
+            (%autoinduct tactic.find-world)
+            (%restrict default tactic.find-world (equal worlds 'worlds)))
+
+(%autoprove tactic.world-env-okp-of-tactic.find-world-under-iff
+            (%autoinduct tactic.find-world)
+            (%restrict default tactic.find-world (equal worlds 'worlds)))
+
+(%autoprove tactic.world->index-of-tactic.find-world
+            (%autoinduct tactic.find-world)
+            (%restrict default tactic.find-world (equal worlds 'worlds)))
+
+(%autoprove subsetp-of-tactic.world->defs-of-tactic.find-world-and-axioms
+            (%disable default subsetp-of-tactic.world->defs-and-axioms)
+            (%use (%instance (%thm subsetp-of-tactic.world->defs-and-axioms)
+                             (world (tactic.find-world index worlds)))))
+
+(%autoprove rw.theory-list-env-okp-of-range-of-tactic.world->theories-of-find-world
+            (%disable default rw.theory-list-env-okp-of-range-of-tactic.world->theories)
+            (%use (%instance (%thm rw.theory-list-env-okp-of-range-of-tactic.world->theories)
+                             (world (tactic.find-world world worlds)))))
+
+
+(%autoadmit tactic.increment-world-index)
+
+(%autoprove tactic.worldp-of-tactic.increment-world-index
+            (%enable default tactic.increment-world-index))
+
+(%autoprove tactic.world-atblp-of-tactic.increment-world-index
+            (%enable default tactic.increment-world-index))
+
+(%autoprove tactic.world-env-okp-of-tactic.increment-world-index
+            (%enable default tactic.increment-world-index))
+
+(%autoprove tactic.world->index-of-tactic.increment-world-index
+            (%enable default tactic.increment-world-index))
+
+
+(%ensure-exactly-these-rules-are-missing "../../tactics/worldp")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/level9/worse-termp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/level9/worse-termp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/level9/worse-termp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/level9/worse-termp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,61 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;                                                                           ;;
+;; EXTRA COPYRIGHT NOTICE.                                                   ;;
+;;                                                                           ;;
+;; This file is derived from type-set-b.lisp in the ACL2 3.1 sources.  I     ;;
+;; have copied or adapted many of the comments verbatim, and the functions   ;;
+;; have also been adapted to my system.  Of course, ACL2 is also GPL'd       ;;
+;; software, so there is no impact on Milawa's license.                      ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+(%autoadmit rw.flag-pseudo-variantp)
+(%autoadmit rw.pseudo-variantp)
+(%autoadmit rw.pseudo-variant-listp)
+
+(%autoadmit rw.flag-worsep)
+(%autoadmit rw.worse-termp)
+(%autoadmit rw.worse-than-listp)
+(%autoadmit rw.some-subterm-worse-than-or-equalp)
+(%autoadmit rw.some-subterm-worse-than-or-equal-listp)
+(%autoadmit rw.basic-worse-termp)
+(%autoadmit rw.some-less-ugly-than-correspondingp)
+(%autoadmit rw.some-worse-than-correspondingp)
+(%autoadmit rw.worse-than-or-equal-termp)
+
+(%ensure-exactly-these-rules-are-missing "../../rewrite/worse-termp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/logic/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/acl2-customization.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/appeal-identity.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/appeal-identity.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/appeal-identity.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/appeal-identity.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,109 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp")
+(%interactive)
+
+
+(%autoadmit logic.appeal-identity)
+
+(%autoprove logic.appeal-identity-under-iff
+            (%enable default logic.appeal-identity))
+
+(%autoprove logic.method-of-logic.appeal-identity
+            (%enable default logic.appeal-identity logic.method))
+
+(%autoprove logic.conclusion-of-logic.appeal-identity
+            (%enable default logic.appeal-identity logic.conclusion))
+
+(%autoprove logic.subproofs-of-logic.appeal-identity
+            (%enable default logic.appeal-identity logic.subproofs))
+
+(%autoprove logic.extras-of-logic.appeal-identity
+            (%enable default logic.appeal-identity logic.extras))
+
+(local (%disable default forcing-true-listp-of-logic.subproofs))
+
+(%autoprove logic.axiom-okp-of-logic.appeal-identity
+            (%enable default logic.axiom-okp))
+
+(%autoprove logic.theorem-okp-of-logic.appeal-identity
+            (%enable default logic.theorem-okp))
+
+(%autoprove logic.propositional-schema-okp-of-logic.appeal-identity
+            (%enable default logic.propositional-schema-okp))
+
+(%autoprove logic.functional-equality-okp-of-logic.appeal-identity
+            (%enable default logic.functional-equality-okp))
+
+(%autoprove logic.expansion-okp-of-logic.appeal-identity
+            (%enable default logic.expansion-okp))
+
+(%autoprove logic.contraction-okp-of-logic.appeal-identity
+            (%enable default logic.contraction-okp))
+
+(%autoprove logic.associativity-okp-of-logic.appeal-identity
+            (%enable default logic.associativity-okp))
+
+(%autoprove logic.cut-okp-of-logic.appeal-identity
+            (%enable default logic.cut-okp))
+
+(%autoprove logic.instantiation-okp-of-logic.appeal-identity
+            (%enable default logic.instantiation-okp))
+
+(%autoprove logic.beta-reduction-okp-of-logic.appeal-identity
+            (%enable default logic.beta-reduction-okp))
+
+(%autoprove logic.induction-okp-of-logic.appeal-identity
+            (%enable default logic.induction-okp))
+
+(%autoprove logic.base-eval-okp-of-logic.appeal-identity
+            (%enable default logic.base-eval-okp))
+
+(%autoprove logic.appeal-step-okp-of-logic.appeal-identity
+            (%enable default logic.appeal-step-okp))
+
+(%autoprove logic.appealp-of-logic.appeal-identity
+            (%restrict default definition-of-logic.appealp (equal x 'x))
+            (%enable default logic.appeal-identity))
+
+(%autoprove logic.proofp-of-logic.appeal-identity
+            (%restrict default definition-of-logic.proofp (or (equal x '(logic.appeal-identity x))
+                                                              (equal x 'x))))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/appeal-identity"
+                                         logic.skip-okp-of-logic.appeal-identity)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/arities-okp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/arities-okp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/arities-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/arities-okp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,309 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(%autoadmit logic.arities-okp)
+
+(%autoprove logic.arities-okp-when-not-consp
+            (%restrict default logic.arities-okp (equal arities 'arities)))
+
+(%autoprove logic.arities-okp-of-cons
+            (%restrict default logic.arities-okp (equal arities '(cons a x))))
+
+(%autoprove booleanp-of-logic.arities-okp
+            (%cdr-induction arities))
+
+(%autoprove logic.arities-okp-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove logic.arities-okp-of-app
+            (%cdr-induction x))
+
+(%autoprove logic.arities-okp-of-rev
+            (%cdr-induction x))
+
+(%autoprove logic.arities-okp-of-cdr)
+
+(%autoprove lemma-1-for-logic.arities-okp-when-subsetp
+            (%cdr-induction x))
+
+(%autoprove lemma-2-for-logic.arities-okp-when-subsetp
+            (%cdr-induction x))
+
+(%autoprove logic.arities-okp-when-subsetp-1
+            (%cdr-induction x)
+            (%enable default lemma-1-for-logic.arities-okp-when-subsetp
+                             lemma-2-for-logic.arities-okp-when-subsetp))
+
+(%autoprove logic.arities-okp-when-subsetp-2)
+
+
+
+
+(%autoadmit logic.fast-arities-okp)
+
+
+(%autoprove logic.arities-okp-of-halve-list
+            (%disable default
+                      halve-list-correct
+                      [outside]halve-list-correct
+                      logic.arities-okp-of-list-fix
+                      [outside]logic.arities-okp-of-list-fix
+                      logic.arities-okp-when-subsetp-1
+                      logic.arities-okp-when-subsetp-2)
+
+            (%use (%instance (%thm halve-list-correct)))
+            (%use (%instance (%thm logic.arities-okp-of-list-fix)))
+            (%auto)
+            ;; Dammit Jared, this is gross.
+            (%fertilize (list-fix x)
+                        (APP (REV (CAR (HALVE-LIST X)))
+                             (CDR (HALVE-LIST X))))
+            (%auto)
+            (%fertilize (list-fix x)
+                        (APP (REV (CAR (HALVE-LIST X)))
+                             (CDR (HALVE-LIST X))))
+            (%auto)
+            (%fertilize (list-fix x)
+                        (APP (REV (CAR (HALVE-LIST X)))
+                             (CDR (HALVE-LIST X))))
+            (%auto))
+
+(%autoprove logic.arities-okp-of-merge-lists
+            (%autoinduct merge-lists)
+            (%restrict default merge-lists (and (equal x 'x) (equal y 'y))))
+
+(%autoprove logic.arities-okp-of-mergesort
+            (%autoinduct mergesort))
+
+(%autoprove logic.arities-okp-of-mergesort-map
+            (%cdr-induction x))
+
+(%autoprove mapp-of-cdr-when-mapp)
+
+(%autoprove memberp-of-nil-when-mapp
+            (%cdr-induction x))
+
+(%autoprove lemma-1-for-logic.arities-okp-when-subsetp-of-unique-atbl
+            (%cdr-induction x))
+
+(%autoprove lemma-2-for-logic.arities-okp-when-subsetp-of-unique-atbl
+            (%cdr-induction x))
+
+(%autoprove lemma-3-for-logic.arities-okp-when-subsetp-of-unique-atbl
+            (%cdr-induction x))
+
+(%autoprove lemma-4-for-logic.arities-okp-when-subsetp-of-unique-atbl
+            (%cdr-induction x))
+
+(%autoprove logic.arities-okp-when-subsetp-of-unique-atbl
+            (%cdr-induction x)
+            (%enable default lemma-1-for-logic.arities-okp-when-subsetp-of-unique-atbl
+                             lemma-2-for-logic.arities-okp-when-subsetp-of-unique-atbl
+                             lemma-3-for-logic.arities-okp-when-subsetp-of-unique-atbl
+                             lemma-4-for-logic.arities-okp-when-subsetp-of-unique-atbl
+                             ))
+
+(%autoprove logic.fast-arities-okp-removal
+            (%enable default logic.fast-arities-okp)
+            (%use (%instance (%thm logic.arities-okp-when-subsetp-of-unique-atbl)
+                             (atbl (mergesort-map atbl))
+                             (x x))))
+
+
+(%autoadmit logic.flag-slow-term-arities)
+(%autoadmit logic.slow-term-arities)
+(%autoadmit logic.slow-term-list-arities)
+
+(%autoprove definition-of-logic.slow-term-arities
+            (%enable default logic.slow-term-arities logic.slow-term-list-arities)
+            (%restrict default logic.flag-slow-term-arities (equal x 'x)))
+
+(%autoprove definition-of-logic.slow-term-list-arities
+            (%enable default logic.slow-term-arities logic.slow-term-list-arities)
+            (%restrict default logic.flag-slow-term-arities (equal x 'x)))
+
+(%autoprove logic.flag-slow-term-arities-of-term
+            (%enable default logic.slow-term-arities))
+
+(%autoprove logic.flag-slow-term-arities-of-list
+            (%enable default logic.slow-term-list-arities))
+
+(%autoprove logic.slow-term-list-arities-when-not-consp
+            (%restrict default definition-of-logic.slow-term-list-arities (equal x 'x)))
+
+(%autoprove logic.slow-term-list-arities-of-cons
+            (%restrict default definition-of-logic.slow-term-list-arities (equal x '(cons a x))))
+
+(%autoadmit logic.flag-term-arities)
+(%autoadmit logic.term-arities)
+(%autoadmit logic.term-list-arities)
+
+(%autoprove definition-of-logic.term-arities
+            (%enable default logic.term-arities logic.term-list-arities)
+            (%restrict default logic.flag-term-arities (equal x 'x)))
+
+(%autoprove definition-of-logic.term-list-arities
+            (%enable default logic.term-arities logic.term-list-arities)
+            (%restrict default logic.flag-term-arities (equal x 'x)))
+
+(%autoprove logic.flag-term-arities-of-term
+            (%enable default logic.term-arities))
+
+(%autoprove logic.flag-term-arities-of-list
+            (%enable default logic.term-list-arities))
+
+(%autoprove logic.term-list-arities-when-not-consp
+            (%restrict default definition-of-logic.term-list-arities (equal x 'x)))
+
+(%autoprove logic.term-list-arities-of-cons
+            (%restrict default definition-of-logic.term-list-arities (equal x '(cons a x))))
+
+(%autoprove lemma-for-true-listp-of-logic.slow-term-arities
+            (%logic.term-induction flag x)
+            (%restrict default definition-of-logic.slow-term-arities (equal x 'x)))
+
+(%autoprove true-listp-of-logic.slow-term-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-logic.slow-term-arities)
+                             (flag 'term))))
+
+(%autoprove true-listp-of-logic.slow-term-list-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-logic.slow-term-arities)
+                             (flag 'list))))
+
+(%autoprove lemma-for-true-listp-of-logic.term-arities
+            (%autoinduct logic.flag-term-arities flag x acc)
+            (%forcingp nil)
+            (%restrict default definition-of-logic.term-arities (equal x 'x)))
+
+(%autoprove true-listp-of-logic.term-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-logic.term-arities)
+                             (flag 'term))))
+
+(%autoprove true-listp-of-logic.term-list-arities
+            (%use (%instance (%thm lemma-for-true-listp-of-logic.term-arities)
+                             (flag 'list))))
+
+(%autoprove lemma-for-logic.term-arities-removal
+            (%autoinduct logic.flag-term-arities flag x acc)
+            (%disable default
+                      expensive-arithmetic-rules
+                      expensive-arithmetic-rules-two)
+            (%forcingp nil)
+            (%waterfall default 40)
+            (%restrict default definition-of-logic.term-arities (equal x 'x))
+            (%restrict default definition-of-logic.slow-term-arities (equal x 'x))
+            (%auto)
+            (%fertilize (LOGIC.TERM-LIST-ARITIES (LOGIC.LAMBDA-ACTUALS X) ACC)
+                        (APP (LOGIC.SLOW-TERM-LIST-ARITIES (LOGIC.LAMBDA-ACTUALS X)) ACC))
+            (%auto)
+            (%fertilize (LOGIC.TERM-LIST-ARITIES X2 ACC)
+                        (APP (LOGIC.SLOW-TERM-LIST-ARITIES X2) ACC))
+            (%auto))
+
+(%autoprove logic.term-arities-removal
+            (%use (%instance (%thm lemma-for-logic.term-arities-removal)
+                             (flag 'term))))
+
+(%autoprove logic.term-list-arities-removal
+            (%use (%instance (%thm lemma-for-logic.term-arities-removal)
+                             (flag 'list))))
+
+
+(%autoprove lemma-2-for-logic.term-atblp-when-logic.arities-okp-of-logic.slow-term-arities)
+
+(%autoprove lemma-for-logic.slow-term-arities-correct
+            (%logic.term-induction flag x)
+            (%enable default
+                     lemma-2-for-logic.term-atblp-when-logic.arities-okp-of-logic.slow-term-arities)
+            (%forcingp nil)
+            (%waterfall default 40)
+            (%restrict default definition-of-logic.slow-term-arities (equal x 'x))
+            (%restrict default definition-of-logic.term-atblp (equal x 'x))
+            (%waterfall default 40))
+
+(%autoprove logic.slow-term-arities-correct
+            (%use (%instance (%thm lemma-for-logic.slow-term-arities-correct)
+                             (flag 'term))))
+
+(%autoprove logic.slow-term-list-arities-correct
+            (%use (%instance (%thm lemma-for-logic.slow-term-arities-correct)
+                             (flag 'list))))
+
+
+(%autoadmit logic.slow-formula-arities)
+(%autoadmit logic.formula-arities)
+
+(%autoprove true-listp-of-logic.formula-arities
+            (%autoinduct logic.formula-arities)
+            (%restrict default logic.formula-arities (equal x 'x)))
+
+(%autoprove logic.formula-arities-removal
+            (%autoinduct logic.formula-arities)
+            (%restrict default logic.formula-arities (equal x 'x))
+            (%restrict default logic.slow-formula-arities (equal x 'x)))
+
+(%autoprove logic.slow-formula-arities-correct
+            (%autoinduct logic.slow-formula-arities)
+            (%forcingp nil)
+            (%restrict default logic.slow-formula-arities (equal x 'x))
+            (%restrict default logic.formula-atblp (equal x 'x)))
+
+(%autoadmit logic.slow-formula-list-arities)
+(%autoadmit logic.formula-list-arities)
+
+(%autoprove true-listp-of-logic.formula-list-arities
+            (%autoinduct logic.formula-list-arities)
+            (%restrict default logic.formula-list-arities (equal x 'x)))
+
+(%autoprove logic.formula-list-arities-removal
+            (%autoinduct logic.formula-list-arities)
+            (%restrict default logic.formula-list-arities (equal x 'x))
+            (%restrict default logic.slow-formula-list-arities (equal x 'x)))
+
+(%autoprove logic.slow-formula-list-arities-correct
+            (%cdr-induction x)
+            (%forcingp nil)
+            (%restrict default logic.formula-list-atblp (equal x 'x))
+            (%restrict default logic.slow-formula-list-arities (equal x 'x)))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/arities-okp")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/base-evaluator.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/base-evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/base-evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/base-evaluator.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,107 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+
+(%autoadmit logic.initial-arity-table)
+
+(%autoprove logic.arity-tablep-of-logic.initial-arity-table)
+
+(%noexec logic.initial-arity-table)
+
+
+
+
+(%autoadmit logic.base-evaluablep)
+
+(%autoprove booleanp-of-logic.base-evaluablep
+            (%enable default logic.base-evaluablep)
+            (%disable default
+                      forcing-lookup-of-logic.function-name
+                      forcing-true-listp-of-logic.function-args))
+
+(%autoprove forcing-logic.functionp-when-logic.base-evaluablep
+            (%enable default logic.base-evaluablep))
+
+(%autoprove logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+            (%enable default logic.base-evaluablep)
+            (%disable default forcing-lookup-of-logic.function-name))
+
+(%autoprove lookup-logic.function-name-in-logic.initial-arity-table-when-logic.base-evaluablep
+            (%enable default logic.base-evaluablep)
+            (%disable default forcing-lookup-of-logic.function-name))
+
+(%autoprove lemma-for-logic.term-atblp-when-logic.base-evaluablep
+            ;; BOZO we shouldn't need this use hint
+            (%use (%instance (%thm forcing-logic.term-atblp-of-logic.function)
+                             (name fn)
+                             (args args)
+                             (atbl (logic.initial-arity-table)))))
+
+(%autoprove logic.term-atblp-when-logic.base-evaluablep
+            (%autorule logic.term-atblp-when-logic.base-evaluablep)
+            (%enable default logic.base-evaluablep)
+            ;; BOZO we shouldn't need this use hint, we should just be able to enable the lemma.
+            (%use (%instance (%thm lemma-for-logic.term-atblp-when-logic.base-evaluablep)
+                             (fn (logic.function-name term))
+                             (args (logic.function-args term))))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.base-evaluablep-when-preliminary-fn-applied-to-constants
+            (%enable default logic.base-evaluablep)
+            (%auto)
+            (%use (%instance (%thm logic.function-namep-when-lookup-in-logic.arity-tablep)
+                             (x (logic.initial-arity-table))
+                             (a fn))))
+
+(%autoprove logic.base-evaluablep-of-logic.function-equal
+            (%enable default logic.base-evaluablep logic.initial-arity-table))
+
+
+
+(%autoadmit logic.base-evaluator)
+
+(%autoprove forcing-logic.constantp-of-logic.base-evaluator
+            (%enable default logic.base-evaluator))
+
+(%autoprove forcing-logic.constantp-of-logic.base-evaluator-free)
+
+(%autoprove logic.base-evaluator-of-logic.function-equal
+            (%enable default logic.base-evaluator))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/base-evaluator")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/logic/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/cert.image	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1 @@
+logic-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/disjoin-formulas.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/disjoin-formulas.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/disjoin-formulas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/disjoin-formulas.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,140 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(%interactive)
+
+(%autoadmit logic.disjoin-formulas)
+
+(defmacro %logic.disjoin-formulas-induction (x)
+  `(%induct (rank ,x)
+            ((or (not (consp ,x))
+                 (not (consp (cdr ,x))))
+             nil)
+            ((and (consp ,x)
+                  (consp (cdr ,x)))
+             (((,x (cdr ,x)))))))
+
+(defsection logic.disjoin-formulas-when-not-consp
+  ;; BOZO add to acl2?  This lets us avoid many expand hints below
+  (%prove (%rule logic.disjoin-formulas-when-not-consp
+                 :hyps (list (%hyp (not (consp x))))
+                 :lhs (logic.disjoin-formulas x)
+                 :rhs nil))
+  (local (%restrict default logic.disjoin-formulas (equal x 'x)))
+  (%auto)
+  (%qed)
+  (%enable default logic.disjoin-formulas-when-not-consp))
+
+(%autoprove logic.disjoin-formulas-when-singleton-list
+            (%restrict default logic.disjoin-formulas (equal x 'x)))
+
+(%autoprove logic.disjoin-formulas-of-cons-onto-consp
+            (%restrict default logic.disjoin-formulas (equal x '(cons a x))))
+
+(%autoprove logic.disjoin-formulas-of-list-fix
+            (%logic.disjoin-formulas-induction x)
+            (%disable default
+                      forcing-logic.formulap-of-logic.por
+                      aggressive-equal-of-logic.pors
+                      forcing-equal-of-logic.por-rewrite
+                      forcing-equal-of-logic.por-rewrite-two))
+
+(%autoprove forcing-logic.formulap-of-logic.disjoin-formulas
+            (%logic.disjoin-formulas-induction x)
+            (%enable default logic.formulap-of-logic.por-expensive))
+
+(%autoprove logic.formula-atblp-of-logic.por-expensive
+            (%restrict default logic.formula-atblp (equal x '(logic.por x y))))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.disjoin-formulas
+            (%logic.disjoin-formulas-induction x)
+            (%enable default logic.formula-atblp-of-logic.por-expensive))
+
+(%autoprove logic.formula-listp-when-logic.formulap-of-logic.disjoin-formulas-free)
+
+(%autoprove logic.formula-list-atblp-when-logic.formula-atblp-of-logic.disjoin-formulas-free)
+
+(%autoprove forcing-logic.fmtype-of-logic.disjoin-formulas
+            (%logic.disjoin-formulas-induction x))
+
+(%autoprove forcing-logic.vlhs-of-logic.disjoin-formulas)
+
+(%autoprove forcing-logic.vrhs-of-logic.disjoin-formulas)
+
+(%autoprove forcing-logic.fmtype-of-logic.disjoin-formulas-free)
+
+(%autoprove forcing-logic.vlhs-of-logic.disjoin-formulas-free)
+
+(%autoprove forcing-logic.vrhs-of-logic.disjoin-formulas-free)
+
+(%autoprove forcing-logic.disjoin-formulas-of-two-element-list)
+
+(%autoprove equal-of-logic.disjoin-formulas-and-logic.disjoin-formulas-when-same-len
+            (%induct (rank x)
+                     ((or (not (consp x))
+                          (not (consp y))
+                          (not (consp (cdr x)))
+                          (not (consp (cdr y))))
+                      nil)
+                     ((and (consp x)
+                           (consp (cdr x))
+                           (consp y)
+                           (consp (cdr y)))
+                      (((x (cdr x))
+                        (y (cdr y))))))
+            ;; these cause loops after some rewriter changes.  taking them out.
+            (%disable default
+                      forcing-logic.fmtype-of-logic.disjoin-formulas-free
+                      consp-of-cdr-with-len-free))
+
+(encapsulate
+ ()
+ (local (%disable default EQUAL-OF-LOGIC.DISJOIN-FORMULAS-AND-LOGIC.DISJOIN-FORMULAS-WHEN-SAME-LEN))
+ (%defprojection :list (logic.disjoin-each-formula-list x)
+                 :element (logic.disjoin-formulas x)
+                 :nil-preservingp t))
+
+(%autoprove forcing-logic.formula-listp-of-logic.disjoin-each-formula-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.disjoin-each-formula-list
+            (%cdr-induction x))
+
+(%autoprove logic.disjoin-each-formula-list-of-listify-each
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/disjoin-formulas")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/find-proof.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/find-proof.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/find-proof.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/find-proof.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,54 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp")
+(%interactive)
+
+(%autoadmit logic.find-proof)
+(%autoprove logic.find-proof-when-not-consp (%restrict default logic.find-proof (equal x 'x)))
+(%autoprove logic.find-proof-of-cons        (%restrict default logic.find-proof (equal x '(cons b x))))
+(%autoprove logic.find-proof-of-list-fix    (%cdr-induction x))
+(%autoprove forcing-logic.find-proof-of-app (%cdr-induction x))
+(%autoprove conclusion-of-logic.find-proof  (%cdr-induction x))
+(%autoprove forcing-logic.find-proof-under-iff-when-memberp-of-logic.strip-conclusions (%cdr-induction x))
+(%autoprove forcing-memberp-of-logic.strip-conclusions-when-logic.find-proof (%cdr-induction x))
+(%autoprove forcing-logic.appealp-of-logic.find-proof (%cdr-induction x))
+(%autoprove forcing-logic.proofp-of-logic.find-proof (%cdr-induction x))
+
+(%defprojection :list (logic.find-proofs x proofs)
+                :element (logic.find-proof x proofs))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/find-proof")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formula-size.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formula-size.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formula-size.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formula-size.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,99 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(%interactive)
+
+;; BOZO shouldn't formula-size be using the proper accessors?  This definition
+;; seems strange and not very good.
+(%autoadmit logic.formula-size)
+
+(%autoprove natp-of-logic.formula-size
+            (%restrict default logic.formula-size (equal x 'x)))
+
+(%autoprove logic.formula-size-nonzero
+            (%restrict default logic.formula-size (equal x 'x)))
+
+(%autoprove ordp-of-logic.formula-size)
+
+(%autoprove forcing-logic.formula-size-of-logic.=lhs
+            (%restrict default logic.formula-size (equal x 'x))
+            (%enable default logic.fmtype logic.=lhs))
+
+(%autoprove forcing-logic.formula-size-of-logic.=rhs
+            (%restrict default logic.formula-size (equal x 'x))
+            (%enable default logic.fmtype logic.=rhs))
+
+(%autoprove forcing-logic.formula-size-of-logic.~arg
+            (%restrict default logic.formula-size (equal x 'x))
+            (%enable default logic.fmtype logic.~arg))
+
+(%autoprove forcing-logic.formula-size-of-logic.vlhs
+            (%restrict default logic.formula-size (equal x 'x))
+            (%enable default logic.fmtype logic.vlhs))
+
+(%autoprove forcing-logic.formula-size-of-logic.vrhs
+            (%restrict default logic.formula-size (equal x 'x))
+            (%enable default logic.fmtype logic.vrhs))
+
+(%autoprove logic.formula-size-of-logic.pnot
+            (%restrict default logic.formula-size (equal x '(cons 'pnot* (cons x 'nil))))
+            (%enable default logic.pnot))
+
+(%autoprove logic.formula-size-of-logic.por
+            (%restrict default logic.formula-size (equal x '(cons 'por* (cons x (cons y 'nil)))))
+            (%enable default logic.por))
+
+(%autoprove logic.formula-size-of-pequal
+            (%restrict default logic.formula-size (equal x '(cons 'pequal* (cons x (cons y 'nil)))))
+            (%enable default logic.pequal))
+
+
+
+(%autoadmit logic.formula-list-size)
+
+(%autoprove logic.formula-list-size-when-not-consp
+            (%restrict default logic.formula-list-size (equal x 'x)))
+
+(%autoprove logic.formula-list-size-of-cons
+            (%restrict default logic.formula-list-size (equal x '(cons a x))))
+
+(%autoprove natp-of-logic.formula-list-size
+            (%cdr-induction x))
+
+(%autoprove ordp-of-logic.formula-list-size)
+
+(%ensure-exactly-these-rules-are-missing "../../logic/formula-size")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,95 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+
+
+(%autoadmit logic.formulap)
+
+(%autoadmit logic.pequal)
+(%autoadmit logic.pnot)
+(%autoadmit logic.por)
+
+(%noexec logic.pequal)
+(%noexec logic.pnot)
+(%noexec logic.por)
+
+(%autoadmit logic.fmtype)
+(%autoadmit logic.=lhs)
+(%autoadmit logic.=rhs)
+(%autoadmit logic.~arg)
+(%autoadmit logic.vlhs)
+(%autoadmit logic.vrhs)
+
+
+(defmacro %logic.raw-formulap-induction (x)
+  `(%induct (rank ,x)
+            ((equal (first ,x) 'pequal*)
+             nil)
+            ((equal (first ,x) 'pnot*)
+             (((,x (second ,x)))))
+            ((equal (first ,x) 'por*)
+             (((,x (second ,x)))
+              ((,x (third ,x)))))
+            ((and (not (equal (first ,x) 'pequal*))
+                  (not (equal (first ,x) 'pnot*))
+                  (not (equal (first ,x) 'por*)))
+             nil)))
+
+(%autoprove booleanp-of-logic.formulap
+            (%logic.raw-formulap-induction x)
+            (%restrict default logic.formulap (equal x 'x))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.formulap-when-not-consp
+            (%restrict default logic.formulap (equal x 'x))
+            (%auto :strategy (cleanup split crewrite)))
+
+
+
+(%autoprove lemma-1-for-logic.formulap-when-logic.termp
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove lemma-2-for-logic.formulap-when-logic.termp
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%enable default logic.constantp))
+
+(%autoprove logic.formulap-when-logic.termp
+            (%use (%instance (%thm lemma-1-for-logic.formulap-when-logic.termp)))
+            (%use (%instance (%thm lemma-2-for-logic.formulap-when-logic.termp))))
+
+(%autoprove logic.termp-when-logic.formulap)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-atblp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-atblp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-atblp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-atblp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,119 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas-1")
+(%interactive)
+
+
+(%autoprove rank-of-logic.=lhs-strong
+            (%enable default logic.=lhs logic.fmtype)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove rank-of-logic.=rhs-strong
+            (%enable default logic.=rhs logic.fmtype)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove rank-of-logic.~arg-strong
+            (%enable default logic.~arg logic.fmtype)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove rank-of-logic.vlhs-strong
+            (%enable default logic.vlhs logic.fmtype)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove rank-of-logic.vrhs-strong
+            (%enable default logic.vrhs logic.fmtype)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove rank-of-logic.pnot
+            (%enable default logic.pnot))
+
+(%autoprove rank-of-logic.pequal
+            (%enable default logic.pequal))
+
+(%autoprove rank-of-logic.por
+            (%enable default logic.por))
+
+
+(%autoadmit logic.formula-atblp)
+
+(defmacro %logic.formulap-induction (x)
+  `(%induct (rank ,x)
+            ((equal (logic.fmtype ,x) 'pequal*)
+             nil)
+            ((equal (logic.fmtype ,x) 'pnot*)
+             (((,x (logic.~arg ,x)))))
+            ((equal (logic.fmtype ,x) 'por*)
+             (((,x (logic.vlhs ,x)))
+              ((,x (logic.vrhs ,x)))))
+            ((and (not (equal (logic.fmtype ,x) 'pequal*))
+                  (not (equal (logic.fmtype ,x) 'pnot*))
+                  (not (equal (logic.fmtype ,x) 'por*)))
+             nil)))
+
+(%autoprove booleanp-of-logic.formula-atblp
+            (%logic.formulap-induction x)
+            (%restrict default logic.formula-atblp (equal x 'x)))
+
+(%autoprove logic.formula-atblp-when-not-consp
+            (%restrict default logic.formula-atblp (equal x 'x))
+            (%enable default logic.fmtype))
+
+(%autoprove forcing-logic.term-atblp-of-logic.=lhs
+            (%restrict default logic.formula-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-logic.=rhs
+            (%restrict default logic.formula-atblp (equal x 'x))
+            (%disable default forcing-logic.term-atblp-of-logic.=lhs))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.~arg
+            (%restrict default logic.formula-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.vlhs
+            (%restrict default logic.formula-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.vrhs
+            (%restrict default logic.formula-atblp (equal x 'x))
+            (%disable default forcing-logic.formula-atblp-of-logic.vlhs))
+
+(%autoprove logic.formulap-when-malformed-cheap
+            ;; BOZO I don't like where this is located; try moving it up in formulas.lisp and
+            ;; move it to one of the basic files maybe.
+            (%restrict default logic.formulap (equal x 'x))
+            (%enable default logic.fmtype))
+
+(%autoprove logic.formula-atblp-when-malformed-cheap
+            (%restrict default logic.formula-atblp (equal x 'x)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-basic.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-basic.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-basic.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,163 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas-1")
+(%interactive)
+
+
+
+(%autoprove forcing-logic.termp-of-logic.=lhs
+            (%enable default logic.fmtype logic.=lhs)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove forcing-logic.termp-of-logic.=rhs
+            (%enable default logic.fmtype logic.=rhs)
+            (%restrict default logic.formulap (equal x 'x))
+            (%disable default forcing-logic.termp-of-logic.=lhs))
+
+(%autoprove forcing-logic.formulap-of-logic.~arg
+            (%enable default logic.fmtype logic.~arg)
+            (%restrict default logic.formulap (equal x 'x))
+            (%disable default forcing-logic.termp-of-logic.=lhs
+                      forcing-logic.termp-of-logic.=rhs))
+
+(%autoprove forcing-logic.formulap-of-logic.vlhs
+            (%enable default logic.fmtype logic.vlhs)
+            (%restrict default logic.formulap (equal x 'x))
+            (%disable default
+                      forcing-logic.termp-of-logic.=lhs
+                      forcing-logic.termp-of-logic.=rhs
+                      forcing-logic.formulap-of-logic.~arg))
+
+(%autoprove forcing-logic.formulap-of-logic.vrhs
+            (%enable default logic.fmtype logic.vrhs)
+            (%restrict default logic.formulap (equal x 'x))
+            (%disable default
+                      forcing-logic.termp-of-logic.=lhs
+                      forcing-logic.termp-of-logic.=rhs
+                      forcing-logic.formulap-of-logic.~arg
+                      forcing-logic.formulap-of-logic.vlhs))
+
+
+
+(%autoprove forcing-logic.formulap-of-logic.pequal
+            (%enable default logic.pequal)
+            (%restrict default logic.formulap (equal x '(cons 'pequal* (cons a (cons b 'nil))))))
+
+(%autoprove forcing-logic.formulap-of-logic.pnot
+            (%enable default logic.pnot)
+            (%restrict default logic.formulap (equal x '(cons 'pnot* (cons a 'nil)))))
+
+(%autoprove forcing-logic.formulap-of-logic.por
+            (%enable default logic.por)
+            (%restrict default logic.formulap (equal x '(cons 'por* (cons a (cons b 'nil))))))
+
+(%autoprove logic.fmtype-of-logic.pequal
+            (%enable default logic.fmtype logic.pequal))
+
+(%autoprove logic.fmtype-of-logic.pnot
+            (%enable default logic.fmtype logic.pnot))
+
+(%autoprove logic.fmtype-of-logic.por
+            (%enable default logic.fmtype logic.por))
+
+(%autoprove logic.=lhs-of-logic.pequal
+            (%enable default logic.=lhs logic.pequal))
+
+(%autoprove logic.=rhs-of-logic.pequal
+            (%enable default logic.=rhs logic.pequal))
+
+(%autoprove logic.~arg-of-logic.pnot
+            (%enable default logic.~arg logic.pnot))
+
+(%autoprove logic.vlhs-of-logic.por
+            (%enable default logic.vlhs logic.por))
+
+(%autoprove logic.vrhs-of-logic.por
+            (%enable default logic.vrhs logic.por))
+
+(%autoprove logic.=lhs-of-logic.pequal-free)
+
+(%autoprove logic.=rhs-of-logic.pequal-free)
+
+(%autoprove logic.fmtype-of-logic.pequal-free)
+
+
+
+(%autoprove forcing-equal-of-logic.pequal-rewrite-two
+            (%auto)
+            (%enable default logic.fmtype logic.pequal logic.=lhs logic.=rhs)
+            (%restrict default logic.formulap (equal x 'x))
+            (%restrict default tuplep (or (equal n ''3) (equal n ''2) (equal n ''1)))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-equal-of-logic.pequal-rewrite)
+
+
+
+(%autoprove forcing-equal-of-logic.pnot-rewrite-two
+            (%enable default logic.fmtype logic.pnot logic.~arg)
+            (%restrict default logic.formulap (equal x 'x))
+            (%restrict default tuplep (or (equal n ''2) (equal n ''1)))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-equal-of-logic.pnot-rewrite)
+
+(%autoprove forcing-equal-of-logic.por-rewrite-two
+            (%enable default logic.fmtype logic.vlhs logic.vrhs logic.por)
+            (%restrict default logic.formulap (equal x 'x))
+            (%restrict default tuplep (or (equal n ''3) (equal n ''2) (equal n ''1)))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-equal-of-logic.por-rewrite)
+
+
+
+
+(%autoprove forcing-logic.pnot-of-logic.~arg)
+
+(%autoprove forcing-logic.por-of-logic.vlhs-and-logic.vrhs)
+
+(%autoprove forcing-logic.pequal-of-logic.=lhs-and-logic.=rhs)
+
+(%autoprove equal-logic.pequal-logic.pequal-rewrite
+            (%enable default logic.pequal))
+
+(%autoprove equal-logic.pnot-logic.pnot-rewrite
+            (%enable default logic.pnot))
+
+(%autoprove equal-logic.por-logic.por-rewrite
+            (%enable default logic.por))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-basic2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-basic2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-basic2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-basic2.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,87 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas-1")
+(%interactive)
+
+(%autoprove logic.pequal-under-iff
+            (%enable default logic.pequal))
+
+(%autoprove logic.pnot-under-iff
+            (%enable default logic.pnot))
+
+(%autoprove logic.por-under-iff
+            (%enable default logic.por))
+
+(%autoprove forcing-logic.=lhs-under-iff
+            (%enable default logic.fmtype logic.=lhs)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove forcing-logic.=rhs-under-iff
+            (%enable default logic.fmtype logic.=rhs)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove forcing-logic.~arg-under-iff
+            (%enable default logic.fmtype logic.~arg)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove forcing-logic.vlhs-under-iff
+            (%enable default logic.fmtype logic.vlhs)
+            (%restrict default logic.formulap (equal x 'x)))
+
+(%autoprove forcing-logic.vrhs-under-iff
+            (%enable default logic.fmtype logic.vrhs)
+            (%restrict default logic.formulap (equal x 'x)))
+
+
+(%autoprove logic.formulap-of-logic.pequal-of-nil-one
+            (%enable default logic.pequal)
+            (%restrict default logic.formulap (equal x '(cons 'pequal* (cons 'nil (cons x 'nil))))))
+
+(%autoprove logic.formulap-of-logic.pequal-of-nil-two
+            (%enable default logic.pequal)
+            (%restrict default logic.formulap (equal x '(cons 'pequal* (cons x '(nil))))))
+
+(%autoprove logic.formulap-of-logic.pnot-of-logic.pequal-of-nil-one
+            (%enable default logic.pnot)
+            (%restrict default logic.formulap (equal x '(CONS 'PNOT* (CONS (LOGIC.PEQUAL 'NIL X) 'NIL)))))
+
+(%autoprove logic.formulap-of-logic.pnot-of-logic.pequal-of-nil-two
+            (%enable default logic.pnot)
+            (%restrict default logic.formulap (equal x '(CONS 'PNOT* (CONS (LOGIC.PEQUAL X 'NIL) 'NIL)))))
+
+(%autoprove logic.formulap-of-logic.por-expensive
+            (%restrict default logic.formulap (equal x '(cons 'por* (cons x (cons y 'nil)))))
+            (%enable default logic.por))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-equal.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-equal.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-equal.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-equal.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,53 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas-1")
+(%interactive)
+
+(%autoprove aggressive-equal-of-logic.pors
+            (%enable default logic.fmtype logic.vlhs logic.vrhs)
+            (%restrict default logic.formulap (or (equal x 'x) (equal x 'y)))
+            (%restrict default tuplep (or (equal n ''3) (equal n ''2) (equal n ''1))))
+
+(%autoprove aggressive-equal-of-logic.pnots
+            (%enable default logic.fmtype logic.~arg)
+            (%restrict default logic.formulap (or (equal x 'x) (equal x 'y)))
+            (%restrict default tuplep (or (equal n ''2) (equal n ''1))))
+
+(%autoprove aggressive-equal-of-logic.pequals
+            (%enable default logic.fmtype logic.=lhs logic.=rhs)
+            (%restrict default logic.formulap (or (equal x 'x) (equal x 'y)))
+            (%restrict default tuplep (or (equal n ''3) (equal n ''2) (equal n ''1))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-list.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-list.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2-list.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,55 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas-1")
+(%interactive)
+
+
+(%deflist logic.formula-listp (x)
+  (logic.formulap x))
+
+(%autoprove forcing-logic.formula-listp-of-app
+            (%enable default logic.formula-listp-of-app))
+
+(%autoprove logic.formulap-of-second-when-logic.formula-listp)
+
+(%autoprove logic.formula-listp-of-ordered-subsetp)
+
+
+(%deflist logic.formula-list-listp (x)
+  (logic.formula-listp x))
+
+(%autoprove forcing-logic.formula-listp-of-simple-flatten
+            (%cdr-induction x))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-2.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,93 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas-2-atblp")
+(include-book "formulas-2-basic")
+(include-book "formulas-2-basic2")
+(include-book "formulas-2-equal")
+(include-book "formulas-2-list")
+(%interactive)
+
+(%autoprove forcing-logic.formula-atblp-of-logic.pequal
+            (%restrict default logic.formula-atblp (equal x '(logic.pequal a b))))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.pnot
+            (%restrict default logic.formula-atblp (equal x '(logic.pnot a)))
+            (%disable default forcing-logic.formula-atblp-of-logic.~arg))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.por
+            (%restrict default logic.formula-atblp (equal x '(logic.por a b)))
+            (%disable default forcing-logic.formula-atblp-of-logic.vlhs forcing-logic.formula-atblp-of-logic.vrhs))
+
+
+(%create-theory forcing-logic.formula-atblp-rules)
+(%enable forcing-logic.formula-atblp-rules
+         forcing-logic.term-atblp-of-logic.=lhs
+         forcing-logic.term-atblp-of-logic.=rhs
+         forcing-logic.formula-atblp-of-logic.~arg
+         forcing-logic.formula-atblp-of-logic.vlhs
+         forcing-logic.formula-atblp-of-logic.vrhs
+         forcing-logic.formula-atblp-of-logic.pequal
+         forcing-logic.formula-atblp-of-logic.pnot
+         forcing-logic.formula-atblp-of-logic.por)
+
+
+(encapsulate
+ ()
+ (local (%enable default forcing-logic.formula-atblp-rules))
+
+ (%autoprove logic.formula-atblp-when-por-expensive
+             (%restrict default logic.formula-atblp (equal x 'x)))
+ (%autoprove logic.formula-atblp-when-pnot-expensive
+             (%restrict default logic.formula-atblp (equal x 'x)))
+ (%autoprove logic.formula-atblp-when-pequal-expensive
+             (%restrict default logic.formula-atblp (equal x 'x)))
+ (%autoprove logic.formula-atblp-of-logic.por-expensive
+             (%restrict default logic.formula-atblp (equal x '(logic.por x y))))
+ (%autoprove logic.formula-atblp-of-logic.pequal-expensive
+             (%restrict default logic.formula-atblp (equal x '(logic.pequal x y))))
+ (%autoprove logic.formula-atblp-of-logic.pnot-expensive
+             (%restrict default logic.formula-atblp (equal x '(logic.pnot x)))))
+
+
+(%create-theory backtracking-logic.formula-atblp-rules)
+(%enable backtracking-logic.formula-atblp-rules
+         logic.formula-atblp-when-por-expensive
+         logic.formula-atblp-when-pnot-expensive
+         logic.formula-atblp-when-pequal-expensive
+         logic.formula-atblp-of-logic.por-expensive
+         logic.formula-atblp-of-logic.pnot-expensive
+         logic.formula-atblp-of-logic.pequal-expensive)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-3-list-atblp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-3-list-atblp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas-3-list-atblp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas-3-list-atblp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,52 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas-2-atblp")
+(%interactive)
+
+
+(%deflist logic.formula-list-atblp (x atbl)
+  (logic.formula-atblp x atbl))
+
+(%autoprove forcing-logic.formula-list-atblp-of-app
+            (%enable default logic.formula-list-atblp-of-app))
+
+(%autoprove logic.formula-atblp-of-second-when-logic.formula-list-atblp)
+
+(%autoprove logic.formula-atbl-listp-of-ordered-subsetp)
+
+(%deflist logic.formula-list-list-atblp (x atbl)
+          (logic.formula-list-atblp x atbl))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/formulas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/formulas.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas-2")
+(include-book "formulas-3-list-atblp")
+(%interactive)
+
+(%ensure-exactly-these-rules-are-missing
+ "../../logic/formulas"
+ ;; I hate this rule and want to get rid of it
+ LOGIC.FMTYPE-NORMALIZER-CHEAP
+)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/fterm-lists.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/fterm-lists.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/fterm-lists.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/fterm-lists.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,107 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+
+(%deflist logic.all-functionsp (x)
+          (logic.functionp x))
+
+(%defprojection :list (logic.strip-function-names x)
+                :element (logic.function-name x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.function-symbol-listp-of-logic.strip-function-names
+            (%cdr-induction x))
+
+
+(%defprojection :list (logic.strip-function-args x)
+                :element (logic.function-args x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.term-list-listp-of-logic.strip-function-args
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-list-atblp-of-logic.strip-function-args
+            (%cdr-induction x))
+
+(%autoprove forcing-true-list-listp-of-logic.strip-function-args
+            (%cdr-induction x))
+
+(%autoprove logic.term-listp-of-strip-firsts-when-all-lens-2
+            (%cdr-induction x))
+
+(%autoprove logic.term-listp-of-strip-seconds-when-all-lens-2
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-atblp-of-strip-firsts-when-all-lens-2
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-atblp-of-strip-seconds-when-all-lens-2
+            (%cdr-induction x))
+
+
+
+
+(%defprojection
+ ;; Interestingly this doesn't need the hint we used in ACL2, which was to disable
+ ;; the rule equal-of-logic.function-rewrite.
+ :list (logic.function-list name x)
+ :element (logic.function name x))
+
+(%autoprove forcing-logic.term-listp-of-logic.function-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.function-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.all-functionsp-of-logic.function-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.strip-function-names-of-logic.function-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.strip-function-args-of-logic.function-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-listp-list-of-list2-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.term-list-atblp-list-of-list2-list
+            (%cdr-cdr-induction x y))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/fterm-lists")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/functional-axiom.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/functional-axiom.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/functional-axiom.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/functional-axiom.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,112 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp")
+(%interactive)
+
+(%autoadmit logic.functional-axiom)
+
+(%autoprove forcing-logic.formulap-of-logic.functional-axiom
+            (%enable default logic.functional-axiom))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.functional-axiom
+            (%enable default logic.functional-axiom))
+
+
+
+(%autoadmit logic.functional-axiom-alt1)
+
+(defmacro %logic.functional-axiom-alt1-induction (ti si tacc sacc)
+  `(%induct (rank ,ti)
+            ((or (not (consp ,ti))
+                 (not (consp ,si)))
+             nil)
+            ((and (consp ,ti)
+                  (consp ,si))
+             (((,ti (cdr ,ti))
+               (,si (cdr ,si))
+               (,tacc (cons (car ,ti) ,tacc))
+               (,sacc (cons (car ,si) ,sacc)))))))
+
+(%autoprove logic.check-functional-axiom-of-logic.functional-axiom-alt1
+            (%logic.functional-axiom-alt1-induction ti si tacc sacc)
+            (%restrict default logic.functional-axiom-alt1 (equal ti 'ti))
+            (%auto)
+            (%restrict default logic.check-functional-axiom (equal ti 'tacc)))
+
+
+(%autoadmit logic.functional-axiom-alt2)
+
+(%autoprove logic.functional-axiom-alt1/alt2-equivalence
+            ;; broken with the alternate rewriter strategy withotu assms
+            ;; (%skip) reverting
+            (%logic.functional-axiom-alt1-induction ti si tacc sacc)
+            (%restrict default logic.functional-axiom-alt1 (equal ti 'ti))
+            (%enable default logic.functional-axiom-alt2)
+            (%disable default
+                      aggressive-equal-of-logic.pequals
+                      aggressive-equal-of-logic.pors
+                      aggressive-equal-of-logic.pnots
+                      forcing-logic.formulap-of-logic.por
+                      forcing-logic.formulap-of-logic.pequal
+                      forcing-logic.formulap-of-logic.pnot
+                      forcing-logic.formulap-of-logic.pequal-list
+                      forcing-equal-of-logic.por-rewrite-two
+                      forcing-equal-of-logic.por-rewrite
+                      forcing-logic.fmtype-of-logic.disjoin-formulas
+                      [outside]consp-of-logic.pequal-list ;; why ??
+                      ))
+
+(%autoprove logic.functional-axiom-alt2/main-equivalence
+            (%disable default
+                      forcing-logic.formulap-of-logic.pequal-list
+                      logic.formula-listp-of-logic.negate-formulas
+                      forcing-logic.termp-of-logic.function
+                      forcing-equal-of-logic.pequal-list-rewrite
+                      forcing-logic.formula-listp-of-app
+                      forcing-logic.formulap-of-logic.pequal
+                      equal-of-logic.pequal-list-and-logic.pequal-list
+                      equal-of-logic.disjoin-formulas-and-logic.disjoin-formulas-when-same-len)
+            (%enable default
+                     logic.functional-axiom-alt2
+                     logic.functional-axiom))
+
+(%autoprove forcing-logic.check-functional-axiom-of-logic.functional-axiom
+            (%use (%instance (%thm logic.check-functional-axiom-of-logic.functional-axiom-alt1)
+                             (tacc nil)
+                             (sacc nil))))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/functional-axiom")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/groundp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/groundp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/groundp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/groundp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,117 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(%interactive)
+
+
+(%autoadmit logic.flag-groundp)
+(%autoadmit logic.groundp)
+(%autoadmit logic.ground-listp)
+
+(%autoprove definition-of-logic.groundp
+            (%restrict default logic.flag-groundp (equal x 'x))
+            (%enable default logic.groundp)
+            (%enable default logic.ground-listp))
+
+(%autoprove definition-of-logic.ground-listp
+            (%restrict default logic.flag-groundp (equal x 'x))
+            (%enable default logic.groundp)
+            (%enable default logic.ground-listp))
+
+
+(%autoprove logic.ground-listp-when-not-consp
+            (%restrict default definition-of-logic.ground-listp (equal x 'x)))
+
+(%autoprove logic.ground-listp-of-cons
+            (%restrict default definition-of-logic.ground-listp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-logic.ground-listp
+            (%cdr-induction x))
+
+(%autoprove booleanp-of-logic.groundp
+            (%restrict default definition-of-logic.groundp (equal x 'x)))
+
+(%autoprove logic.groundp-when-logic.constantp
+            (%restrict default definition-of-logic.groundp (equal x 'x)))
+
+(%autoprove forcing-logic.ground-listp-of-logic.function-args-when-logic.groundp
+            (%restrict default definition-of-logic.groundp (equal x 'x)))
+
+(%autoprove forcing-logic.ground-listp-of-logic.lambda-actuals-when-logic.groundp
+            (%restrict default definition-of-logic.groundp (equal x 'x)))
+
+
+
+(%deflist logic.ground-listp (x)
+          (logic.groundp x))
+
+(%autoprove logic.ground-listp-when-logic.constant-listp
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.groundp-of-logic.function
+            (%restrict default definition-of-logic.groundp (equal x '(logic.function name args))))
+
+(%autoprove forcing-logic.groundp-of-logic.lambda
+            (%restrict default definition-of-logic.groundp (equal x '(logic.lambda formals body actuals))))
+
+
+
+(%autoprove lemma-2-for-forcing-logic.groundp-of-logic.substitute
+            (%cdr-induction sigma))
+
+(%autoprove lemma-for-forcing-logic.groundp-of-logic.substitute
+            (%logic.term-induction flag x)
+            (%enable default lemma-2-for-forcing-logic.groundp-of-logic.substitute))
+
+(%autoprove forcing-logic.groundp-of-logic.substitute
+            (%use (%instance (%thm lemma-for-forcing-logic.groundp-of-logic.substitute) (flag 'term))))
+
+(%autoprove forcing-logic.ground-listp-of-logic.substitute-list
+            (%use (%instance (%thm lemma-for-forcing-logic.groundp-of-logic.substitute) (flag 'list))))
+
+(%autoprove forcing-logic.groundp-when-logic.constant-listp-of-logic.function-args
+            (%use (%instance (%thm forcing-logic.groundp-of-logic.function)
+                             (name (logic.function-name term))
+                             (args (logic.function-args term)))))
+
+
+(%autoprove forcing-logic.groundp-when-logic.constant-listp-of-logic.lambda-actuals
+            (%use (%instance (%thm forcing-logic.groundp-of-logic.lambda)
+                             (formals (logic.lambda-formals term))
+                             (body    (logic.lambda-body term))
+                             (actuals (logic.lambda-actuals term)))))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/groundp")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/logic/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/make-image.lsp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../utilities/top")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/logic-symmetry"
+                 "Preloaded bootstrap/utilities directory.")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/negate-formulas.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/negate-formulas.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/negate-formulas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/negate-formulas.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,141 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(%interactive)
+
+
+(%deflist logic.all-negationsp (x)
+          (equal (logic.fmtype x) 'pnot*)
+          :hintsmap ((logic.all-negationsp-of-remove-duplicates
+                      (%cdr-induction x)
+                      (%auto)
+                      (%use (%instance (%thm equal-when-memberp-of-logic.all-negationsp)
+                                       (a x1)
+                                       (x x2))))
+                     (logic.all-negationsp-of-subsetp-when-logic.all-negationsp
+                      (%cdr-induction x)
+                      (%auto)
+                      (%use (%instance (%thm equal-when-memberp-of-logic.all-negationsp)
+                                       (a x1)
+                                       (x y))))))
+
+(%autoprove logic.fmtype-of-car-when-logic.all-negationsp
+            (%enable default equal-of-car-when-logic.all-negationsp))
+
+(%autoprove logic.fmtype-when-memberp-of-logic.all-negationsp
+            (%use (%instance (%thm equal-when-memberp-of-logic.all-negationsp))))
+
+(%autoprove logic.fmtype-when-memberp-of-logic.all-negationsp-alt)
+
+
+
+(%defprojection :list (logic.~args x)
+                :element (logic.~arg x)
+                :nil-preservingp t)
+
+
+(%autoprove forcing-logic.formula-listp-of-logic.~args
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.~args
+            (%cdr-induction x))
+
+(%autoprove logic.~arg-of-car-when-all-equalp-of-logic.~args)
+
+(defsection logic.negate-formulas
+
+  (local (%disable default
+                   forcing-logic.formulap-of-logic.pnot
+                   aggressive-equal-of-logic.pnots
+                   forcing-equal-of-logic.pnot-rewrite
+                   forcing-equal-of-logic.pnot-rewrite-two))
+
+  (%defprojection :list (logic.negate-formulas x)
+                  :element (logic.pnot x)))
+
+(%autoprove memberp-of-logic.pnot-in-logic.negate-formulas
+            (%enable default memberp-of-logic.pnot-in-logic.negate-formulas-when-memberp)
+            (%cdr-induction x))
+
+(%autoprove logic.formula-listp-of-logic.negate-formulas
+            (%cdr-induction x))
+
+(%autoprove logic.formula-list-atblp-of-logic.negate-formulas
+            (%cdr-induction x))
+
+(%autoprove equal-of-logic.negate-formulas-and-logic.negate-formulas
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.~args-of-logic.negate-formulas
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.~args-of-logic.negate-formulas-free)
+
+(%autoprove forcing-logic.all-negationsp-of-logic.negate-formulas
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.all-negationsp-of-logic.negate-formulas-free)
+
+
+
+
+
+(%autoadmit logic.smart-negate-formulas)
+
+(%autoprove logic.smart-negate-formulas-when-not-consp (%restrict default logic.smart-negate-formulas (equal x 'x)))
+(%autoprove logic.smart-negate-formulas-of-cons        (%restrict default logic.smart-negate-formulas (equal x '(cons a x))))
+
+(%autoprove true-listp-of-logic.smart-negate-formulas  (%cdr-induction x))
+(%autoprove logic.smart-negate-formulas-of-list-fix    (%cdr-induction x))
+(%autoprove logic.smart-negate-formulas-of-app         (%cdr-induction x))
+(%autoprove len-of-logic.smart-negate-formulas         (%cdr-induction x))
+(%autoprove consp-of-logic.smart-negate-formulas       (%cdr-induction x))
+(%autoprove logic.smart-negate-formulas-under-iff      (%cdr-induction x))
+(%autoprove forcing-logic.formula-listp-of-logic.smart-negate-formulas      (%cdr-induction x))
+(%autoprove forcing-logic.formula-list-atblp-of-logic.smart-negate-formulas (%cdr-induction x))
+
+(%autoprove memberp-of-logic.pnot-in-logic.smart-negate-formulas
+            (%cdr-induction x))
+
+(%autoprove memberp-of-logic.pequal-in-logic.smart-negate-formulas
+            (%cdr-induction x))
+
+(%autoprove memberp-of-logic.~arg-in-logic.smart-negate-formulas
+            (%cdr-induction x))
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/negate-formulas")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/negate-term.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/negate-term.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/negate-term.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/negate-term.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,56 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(%interactive)
+
+
+
+(%autoadmit logic.negate-term)
+(%autoprove forcing-logic.termp-of-logic.negate-term      (%enable default logic.negate-term))
+(%autoprove forcing-logic.term-atblp-of-logic.negate-term (%enable default logic.negate-term))
+
+
+(%defprojection :list (logic.negate-term-list x)
+                :element (logic.negate-term x))
+
+(%autoprove forcing-logic.term-listp-of-logic.negate-term-list      (%cdr-induction x))
+(%autoprove forcing-logic.term-list-atblp-of-logic.negate-term-list (%cdr-induction x))
+(%autoprove logic.substitute-of-logic.negate-term                   (%enable default logic.negate-term))
+(%autoprove logic.substitute-list-of-logic.negate-term-list         (%cdr-induction x))
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/negate-terms")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/patmatch-term.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/patmatch-term.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/patmatch-term.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/patmatch-term.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,296 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(%interactive)
+
+(%autoadmit logic.flag-patmatch)
+(%autoadmit logic.patmatch)
+(%autoadmit logic.patmatch-list)
+
+(%autoprove definition-of-logic.patmatch
+            (%enable default logic.patmatch logic.patmatch-list)
+            (%restrict default logic.flag-patmatch (equal pat 'pat)))
+
+(%autoprove definition-of-logic.patmatch-list
+            (%enable default logic.patmatch logic.patmatch-list)
+            (%restrict default logic.flag-patmatch (equal pat 'pat)))
+
+(%autoprove logic.flag-patmatch-term-removal (%enable default logic.patmatch))
+(%autoprove logic.flag-patmatch-list-removal (%enable default logic.patmatch-list))
+
+(defmacro %logic.flag-patmatch-induction (flag pat term sigma)
+  `(%induct (rank ,pat)
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,pat))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.variablep ,pat))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,pat))
+             (((,flag 'list)
+               (,pat (logic.function-args ,pat))
+               (,term (logic.function-args ,term))
+               (,sigma ,sigma))))
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,pat))
+             nil)
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,pat))
+                  (not (logic.variablep ,pat))
+                  (not (logic.functionp ,pat))
+                  (not (logic.lambdap ,pat)))
+             nil)
+            ((and (not (equal flag 'term))
+                  (or (not (consp ,pat))
+                      (not (consp ,term))))
+             nil)
+            ((and (not (equal flag 'term))
+                  (consp ,pat)
+                  (consp ,term))
+             (((,flag 'term)
+               (,pat (car ,pat))
+               (,term (car ,term))
+               (,sigma ,sigma))
+              ((,flag 'list)
+               (,pat (cdr ,pat))
+               (,term (cdr ,term))
+               (,sigma (logic.flag-patmatch 'term (car ,pat) (car ,term) ,sigma)))))))
+
+
+;; (%autoprove lemma-for-consp-of-logic.patmatch
+;;             (%logic.flag-patmatch-induction flag x y sigma)
+;;             (%auto)
+;;             (%restrict default definition-of-logic.patmatch (equal pat 'x))
+;;             (%restrict default definition-of-logic.patmatch-list (equal pat 'x)))
+
+;; (%autoprove consp-of-logic.patmatch
+;;             (%use (%instance (%thm lemma-for-consp-of-logic.patmatch)
+;;                              (flag 'term))))
+
+;; (%autoprove consp-of-logic.patmatch-list
+;;             (%use (%instance (%thm lemma-for-consp-of-logic.patmatch)
+;;                              (flag 'list))))
+
+
+
+;; (%autoprove lemma-for-booleanp-of-car-of-logic.patmatch
+;;             (%logic.flag-patmatch-induction flag x y sigma)
+;;             (%auto)
+;;             (%restrict default definition-of-logic.patmatch (equal pat 'x))
+;;             (%restrict default definition-of-logic.patmatch-list (equal pat 'x)))
+
+;; (%autoprove booleanp-of-car-of-logic.patmatch
+;;             (%use (%instance (%thm lemma-for-booleanp-of-car-of-logic.patmatch)
+;;                              (flag 'term))))
+
+;; (%autoprove booleanp-of-car-of-logic.patmatch-list
+;;             (%use (%instance (%thm lemma-for-booleanp-of-car-of-logic.patmatch)
+;;                              (flag 'list))))
+
+
+(%autoprove lemma-for-forcing-logic.sigmap-of-logic.patmatch
+            (%logic.flag-patmatch-induction flag x y sigma)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default definition-of-logic.patmatch (equal pat 'x))
+            (%restrict default definition-of-logic.patmatch-list (equal pat 'x)))
+
+(%autoprove forcing-logic.sigmap-of-logic.patmatch
+            (%use (%instance (%thm lemma-for-forcing-logic.sigmap-of-logic.patmatch)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.sigmap-of-logic.patmatch-list
+            (%use (%instance (%thm lemma-for-forcing-logic.sigmap-of-logic.patmatch)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.sigma-atblp-of-logic.patmatch
+            (%logic.flag-patmatch-induction flag x y sigma)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default definition-of-logic.patmatch (equal pat 'x))
+            (%restrict default definition-of-logic.patmatch-list (equal pat 'x)))
+
+(%autoprove forcing-logic.sigma-atblp-of-logic.patmatch
+            (%use (%instance (%thm lemma-for-forcing-logic.sigma-atblp-of-logic.patmatch)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.sigma-atblp-of-logic.patmatch-list
+            (%use (%instance (%thm lemma-for-forcing-logic.sigma-atblp-of-logic.patmatch)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-submapp-of-logic.patmatch
+            (%logic.flag-patmatch-induction flag x y sigma)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default definition-of-logic.patmatch (equal pat 'x))
+            (%restrict default definition-of-logic.patmatch-list (equal pat 'x)))
+
+(%autoprove forcing-submapp-of-logic.patmatch
+            (%use (%instance (%thm lemma-for-forcing-submapp-of-logic.patmatch)
+                             (flag 'term))))
+
+(%autoprove forcing-submapp-of-logic.patmatch-list
+            (%use (%instance (%thm lemma-for-forcing-submapp-of-logic.patmatch)
+                             (flag 'list))))
+
+
+
+
+
+(%autoprove two-deep-submapp-of-logic.patmatch
+            (%disable default forcing-submapp-of-logic.patmatch)
+            (%use (%instance (%thm forcing-submapp-of-logic.patmatch)
+                             (x a) (y b) (sigma sigma)))
+            (%use (%instance (%thm forcing-submapp-of-logic.patmatch)
+                             (x c) (y d) (sigma (logic.patmatch a b sigma)))))
+
+
+
+(%autoprove lemma-2-for-memberp-of-domain-of-logic.patmatch
+            (%disable default equal-of-lookups-when-submapp)
+            (%use (%instance (%thm equal-of-lookups-when-submapp)
+                             (a key)
+                             (x (cons (cons key val) sigma))
+                             (y (logic.patmatch-list x y (cons (cons key val) sigma))))))
+
+(%autoprove lemma-for-memberp-of-domain-of-logic.patmatch
+            (%logic.flag-patmatch-induction flag x y sigma)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%enable default lemma-2-for-memberp-of-domain-of-logic.patmatch)
+            (%restrict default definition-of-logic.patmatch (equal pat 'x))
+            (%restrict default definition-of-logic.patmatch-list (equal pat 'x)))
+
+(%autoprove memberp-of-domain-of-logic.patmatch
+            (%use (%instance (%thm lemma-for-memberp-of-domain-of-logic.patmatch)
+                             (flag 'term))))
+
+(%autoprove memberp-of-domain-of-logic.patmatch-list
+            (%use (%instance (%thm lemma-for-memberp-of-domain-of-logic.patmatch)
+                             (flag 'list))))
+
+
+
+(%autoprove two-deep-memberp-of-logic.patmatch
+            (%disable default memberp-of-domain-of-logic.patmatch)
+            (%use (%instance (%thm memberp-of-domain-of-logic.patmatch)
+                             (a e) (x a) (y b) (sigma sigma)))
+            (%use (%instance (%thm memberp-of-domain-of-logic.patmatch)
+                             (a e) (x c) (y d) (sigma (logic.patmatch a b sigma)))))
+
+(%autoprove subsetp-of-logic.term-vars-and-domain-of-logic.patmatch
+            (%disable default memberp-of-domain-under-iff [outside]memberp-of-domain-under-iff)
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x (logic.term-vars x))
+                             (y (domain (logic.patmatch x y sigma))))))
+
+(%autoprove subsetp-of-logic.term-list-vars-and-domain-of-logic.patmatch-list
+            (%disable default memberp-of-domain-under-iff [outside]memberp-of-domain-under-iff)
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x (logic.term-list-vars x))
+                             (y (domain (logic.patmatch-list x y sigma))))))
+
+(%autoprove two-deep-subsetp-of-logic.patmatch
+            (%disable default subsetp-of-logic.term-vars-and-domain-of-logic.patmatch)
+            (%use (%instance (%thm subsetp-of-logic.term-vars-and-domain-of-logic.patmatch)
+                             (x a) (y b) (sigma sigma)))
+            (%use (%instance (%thm subsetp-of-logic.term-vars-and-domain-of-logic.patmatch)
+                             (x c) (y d) (sigma (logic.patmatch a b sigma)))))
+
+
+
+
+
+(%autoprove lemma-2-for-forcing-logic.substitute-of-logic.patmatch
+            (%disable default equal-of-logic.substitutes-of-expansion)
+            (%use (%instance (%thm equal-of-logic.substitutes-of-expansion)
+                             (x (car x))
+                             (sigma1 (logic.patmatch (car x) (car y) sigma))
+                             (sigma2 (logic.patmatch-list (cdr x) (cdr y) (logic.patmatch (car x) (car y) sigma))))))
+
+(%autoprove lemma-for-forcing-logic.substitute-of-logic.patmatch
+            (%logic.flag-patmatch-induction flag x y sigma)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%enable default lemma-2-for-forcing-logic.substitute-of-logic.patmatch)
+            (%restrict default definition-of-logic.patmatch-list (equal pat 'x))
+            (%restrict default definition-of-logic.patmatch (equal pat 'x)))
+
+(%autoprove forcing-logic.substitute-of-logic.patmatch
+            (%use (%instance (%thm lemma-for-forcing-logic.substitute-of-logic.patmatch)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.substitute-list-of-logic.patmatch-list
+            (%use (%instance (%thm lemma-for-forcing-logic.substitute-of-logic.patmatch)
+                             (flag 'list))))
+
+
+
+(%autoprove forcing-logic.substitute-of-logic.patmatch-expansion
+            (%disable default equal-of-logic.substitutes-of-expansion)
+            (%use (%instance (%thm equal-of-logic.substitutes-of-expansion)
+                             (x x)
+                             (sigma1 (logic.patmatch x y sigma))
+                             (sigma2 sigma2))))
+
+(%autoprove forcing-logic.substitute-of-logic.patmatch-list-expansion
+            (%disable default equal-of-logic.substitute-lists-of-expansion)
+            (%use (%instance (%thm equal-of-logic.substitute-lists-of-expansion)
+                             (x x)
+                             (sigma1 (logic.patmatch-list x y sigma))
+                             (sigma2 sigma2))))
+
+
+;; BOZO take "cdr" out of the name now that patmatch has been optimized a bit
+
+(%autoprove lemma-for-forcing-uniquep-of-domain-of-cdr-of-logic.patmatch
+            (%logic.flag-patmatch-induction flag x y sigma)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default definition-of-logic.patmatch (equal pat 'x))
+            (%restrict default definition-of-logic.patmatch-list (equal pat 'x)))
+
+(%autoprove forcing-uniquep-of-domain-of-cdr-of-logic.patmatch
+            (%use (%instance (%thm lemma-for-forcing-uniquep-of-domain-of-cdr-of-logic.patmatch)
+                             (flag 'term))))
+
+(%autoprove forcing-uniquep-of-domain-of-cdr-of-logic.patmatch-list
+            (%use (%instance (%thm lemma-for-forcing-uniquep-of-domain-of-cdr-of-logic.patmatch)
+                             (flag 'list))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/patmatch-term"
+                                         lemma-1-for-forcing-logic.substitute-of-logic.patmatch)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list-1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,116 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(%interactive)
+
+(%autoadmit logic.pequal-list)
+
+(%autoprove logic.pequal-list-when-not-consp-one
+            (%restrict default logic.pequal-list (equal x 'x)))
+
+(%autoprove logic.pequal-list-when-not-consp-two
+            (%restrict default logic.pequal-list (equal x 'x)))
+
+(%autoprove logic.pequal-list-of-cons-and-cons
+            (%restrict default logic.pequal-list (equal x '(cons a x))))
+
+(%autoprove logic.pequal-list-under-iff)
+
+(%autoprove logic.pequal-list-of-list-fix-one
+            (%cdr-cdr-induction x y))
+
+(%autoprove logic.pequal-list-of-list-fix-two
+            (%cdr-cdr-induction x y))
+
+(%autoprove true-listp-of-logic.pequal-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.formulap-of-logic.pequal-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.pequal-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove consp-of-logic.pequal-list)
+
+(%autoprove car-of-logic.pequal-list
+            ;; BOZO yuck, new car-cdr-elim code goes berserk here for some reason.
+            ;; We just enable the function instead of dealing with it.
+            (%restrict default logic.pequal-list (equal x 'x)))
+
+(%autoprove cdr-of-logic.pequal-list)
+
+(%autoprove len-of-logic.pequal-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove logic.pequal-list-of-cons-and-repeat-plus-one)
+
+
+
+
+(%deflist logic.all-atomicp (x)
+          (equal (logic.fmtype x) 'pequal*)
+          :hintsmap
+          ;; These nasty hints are needed becuase the "equal" above ruins the
+          ;; canonicalization we expect.
+          ((logic.all-atomicp-of-remove-duplicates
+            (%cdr-induction x)
+            (%auto)
+            (%use (%instance (%thm equal-when-memberp-of-logic.all-atomicp)
+                             (a x1)
+                             (x x2))))
+           (logic.all-atomicp-of-subsetp-when-logic.all-atomicp
+            (%cdr-induction x)
+            (%auto)
+            (%use (%instance (%thm equal-when-memberp-of-logic.all-atomicp)
+                             (a x1)
+                             (x y))))))
+
+(%autoprove logic.fmtype-of-car-when-logic.all-atomicp
+            (%enable default equal-of-car-when-logic.all-atomicp))
+
+(%autoprove logic.fmtype-when-memberp-of-logic.all-atomicp
+            (%use (%instance (%thm equal-when-memberp-of-logic.all-atomicp))))
+
+(%autoprove logic.fmtype-when-memberp-of-logic.all-atomicp-alt)
+
+(%autoprove forcing-logic.all-atomicp-of-logic.pequal-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.all-atomicp-of-logic.pequal-list-free)
+
+(%autoprove logic.fmtype-of-nth-when-logic.all-atomicp)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list-2-basic.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list-2-basic.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list-2-basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list-2-basic.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,58 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list-1")
+(%interactive)
+
+(%autoprove equal-of-logic.pequal-list-and-logic.pequal-list
+            ;; BOZO this proof is really big.  We might do better to improve
+            ;; our conditional eqsubst tactic by allowing it to take a list of
+            ;; equalities to substitute in.  The autoelim tactic could then
+            ;; look for multiple variables to substitute at once, and hit them
+            ;; all together.
+            ;; NOTE: This rewriting is kind of slow; consider using it for cache
+            ;; analysis.
+            (%four-cdrs-induction a b c d))
+
+(%autoprove logic.pequal-list-of-app-and-app
+            (%cdr-cdr-induction a c)
+            (%disable default equal-of-logic.pequal-list-and-logic.pequal-list))
+
+(%autoprove rev-of-logic.pequal-list
+            (%cdr-cdr-induction a b)
+            (%disable default
+                      forcing-logic.formulap-of-logic.pequal
+                      aggressive-equal-of-logic.pequals))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list-2-lhses.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list-2-lhses.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list-2-lhses.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list-2-lhses.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,54 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list-1")
+(%interactive)
+
+
+(%defprojection :list (logic.=lhses x)
+                :element (logic.=lhs x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.term-listp-of-logic.=lhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.=lhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.=lhses-of-logic.pequal-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.=lhses-of-logic.pequal-list-free)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list-2-rhses.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list-2-rhses.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list-2-rhses.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list-2-rhses.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,56 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list-1")
+(%interactive)
+
+
+(%defprojection :list (logic.=rhses x)
+                :element (logic.=rhs x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.term-listp-of-logic.=rhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.=rhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.=rhses-free)
+
+(%autoprove forcing-logic.=rhses-of-logic.pequal-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.=rhses-of-logic.pequal-list-free)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/pequal-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/pequal-list.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,66 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list-2-basic")
+(include-book "pequal-list-2-rhses")
+(include-book "pequal-list-2-lhses")
+(%interactive)
+
+(defthm forcing-equal-of-logic.pequal-list-rewrite-alt
+  ;; BOZO add this to the ACL2 model?
+  (implies (and (force (equal (len x) (len y)))
+                (force (logic.term-listp x))
+                (force (logic.term-listp y)))
+           (equal (equal z (logic.pequal-list x y))
+                  (and (true-listp z)
+                       (logic.formula-listp z)
+                       (logic.all-atomicp z)
+                       (equal (list-fix x) (logic.=lhses z))
+                       (equal (list-fix y) (logic.=rhses z))))))
+
+(%autoprove forcing-logic.pequal-list-of-logic.=lhses-and-logic.=rhses
+            (%cdr-induction x))
+
+(%autoprove forcing-equal-of-logic.pequal-list-rewrite
+            (%cdr-cdr-cdr-induction x y z))
+
+(%autoprove forcing-equal-of-logic.pequal-list-rewrite-alt
+            (%use (%instance (%thm forcing-equal-of-logic.pequal-list-rewrite))))
+
+(%autoprove logic.pequal-list-of-app-with-repeat
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/pequal-list")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/por-list.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/por-list.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/por-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/por-list.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,174 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(%interactive)
+
+
+(defthm forcing-equal-of-logic.por-list-rewrite-alt
+  ;; BOZO add this to the acl2 model
+  (implies (and (force (equal (len x) (len y)))
+                (force (logic.formula-listp x))
+                (force (logic.formula-listp y)))
+           (equal (equal z (logic.por-list x y))
+                  (and (true-listp z)
+                       (logic.formula-listp z)
+                       (logic.all-disjunctionsp z)
+                       (equal (list-fix x) (logic.vlhses z))
+                       (equal (list-fix y) (logic.vrhses z))))))
+
+
+(%autoadmit logic.por-list)
+
+(%autoprove logic.por-list-when-not-consp-one
+            (%restrict default logic.por-list (equal x 'x)))
+
+(%autoprove logic.por-list-when-not-consp-two
+            (%restrict default logic.por-list (equal x 'x)))
+
+(%autoprove logic.por-list-of-cons-and-cons
+            (%restrict default logic.por-list (equal x '(cons a x))))
+
+(%autoprove logic.por-list-under-iff)
+
+(%autoprove logic.por-list-of-list-fix-one
+            (%cdr-cdr-induction x y))
+
+(%autoprove logic.por-list-of-list-fix-two
+            (%cdr-cdr-induction x y))
+
+(%autoprove true-listp-of-logic.por-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.formulap-of-logic.por-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.por-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove consp-of-logic.por-list)
+
+(%autoprove car-of-logic.por-list
+            ;; BOZO elim goes berserk
+            (%restrict default logic.por-list (equal x 'x)))
+
+(%autoprove cdr-of-logic.por-list)
+
+(%autoprove len-of-logic.por-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.por-list-of-singleton-lhs)
+
+
+
+(%deflist logic.all-disjunctionsp (x)
+          (equal (logic.fmtype x) 'por*)
+          :hintsmap
+          ((logic.all-disjunctionsp-of-remove-duplicates
+            (%cdr-induction x)
+            (%auto)
+            (%use (%instance (%thm equal-when-memberp-of-logic.all-disjunctionsp)
+                             (a x1)
+                             (x x2))))
+           (logic.all-disjunctionsp-of-subsetp-when-logic.all-disjunctionsp
+            (%cdr-induction x)
+            (%auto)
+            (%use (%instance (%thm equal-when-memberp-of-logic.all-disjunctionsp)
+                             (a x1)
+                             (x y))))))
+
+(%autoprove logic.fmtype-of-car-when-logic.all-disjunctionsp
+            (%enable default equal-of-car-when-logic.all-disjunctionsp))
+
+(%autoprove logic.fmtype-when-memberp-of-logic.all-disjunctionsp
+            (%use (%instance (%thm equal-when-memberp-of-logic.all-disjunctionsp))))
+
+(%autoprove logic.fmtype-when-memberp-of-logic.all-disjunctionsp-alt)
+
+
+(%autoprove forcing-logic.all-disjunctionsp-of-logic.por-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.all-disjunctionsp-of-logic.por-list-free)
+
+(%autoprove logic.fmtype-of-nth-when-logic.all-disjunctionsp)
+
+
+
+
+(%defprojection :list (logic.vlhses x)
+                :element (logic.vlhs x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.formula-listp-of-logic.vlhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.vlhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.vlhses-of-logic.por-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.vlhses-of-logic.por-list-free)
+
+(%autoprove logic.vlhs-of-car-when-all-equalp-of-logic.vlhses)
+
+
+
+
+(%defprojection :list (logic.vrhses x)
+                :element (logic.vrhs x)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.formula-listp-of-logic.vrhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.vrhses
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.vrhses-of-logic.por-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-logic.vrhses-of-logic.por-list-free)
+
+(%autoprove forcing-equal-of-logic.por-list-rewrite
+            (%cdr-cdr-cdr-induction x y z))
+
+(%autoprove forcing-equal-of-logic.por-list-rewrite-alt
+            (%use (%instance (%thm forcing-equal-of-logic.por-list-rewrite))))
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/por-list")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,171 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "base-evaluator")
+(include-book "substitute-formula")
+(%interactive)
+
+
+(%autoadmit logic.flag-appealp)
+(%autoadmit logic.appealp)
+(%autoadmit logic.appeal-listp)
+
+(%autoadmit logic.appeal)
+(%autoadmit logic.method)
+(%autoadmit logic.conclusion)
+(%autoadmit logic.subproofs)
+(%autoadmit logic.extras)
+
+(%autoprove definition-of-logic.appealp
+            (%enable default logic.appealp logic.appeal-listp)
+            (%restrict default logic.flag-appealp (equal x 'x)))
+
+(%autoprove definition-of-logic.appeal-listp
+            (%enable default logic.appealp logic.appeal-listp)
+            (%restrict default logic.flag-appealp (equal x 'x)))
+
+(defmacro %logic.appeal-induction (flag x)
+  ;; weird that this has 'list instead of 'proof??
+  `(%induct (two-nats-measure (rank ,x) (if (equal ,flag 'proof) '1 '0))
+            ((equal ,flag 'proof)
+             (((,x    (logic.subproofs ,x))
+               (,flag 'list))))
+            ((and (not (equal ,flag 'proof))
+                  (consp ,x))
+             (((,x    (car ,x))
+               (,flag 'proof))
+              ((,x    (cdr ,x))
+               (,flag 'list))))
+            ((and (not (equal ,flag 'proof))
+                  (not (consp ,x)))
+             nil)))
+
+(defsection lemma-for-booleanp-of-logic.appealp
+  (%prove (%rule lemma-for-booleanp-of-logic.appealp
+                 :lhs (if (equal flag 'proof)
+                          (booleanp (logic.appealp x))
+                        (booleanp (logic.appeal-listp x)))
+                 :rhs t))
+  (%logic.appeal-induction flag x)
+  (local (%restrict default definition-of-logic.appealp (equal x 'x)))
+  (local (%restrict default definition-of-logic.appeal-listp (equal x 'x)))
+  (local (%enable default logic.subproofs))
+  (%auto)
+  (%qed))
+
+(%autoprove booleanp-of-logic.appealp
+            (%use (%instance (%thm lemma-for-booleanp-of-logic.appealp) (flag 'proof))))
+
+(%autoprove booleanp-of-logic.appeal-listp
+            (%use (%instance (%thm lemma-for-booleanp-of-logic.appealp) (flag 'list))))
+
+(%autoprove logic.appeal-listp-when-not-consp
+            (%restrict default definition-of-logic.appeal-listp (equal x 'x)))
+
+(%autoprove logic.appeal-listp-of-cons
+            (%restrict default definition-of-logic.appeal-listp (equal x '(cons a x))))
+
+(%deflist logic.appeal-listp (x)
+          (logic.appealp x))
+
+
+(%autoprove logic.appealp-of-nth-when-logic.appeal-listp)
+
+(%autoprove logic.appealp-of-second-when-logic.appeal-listp)
+
+(%autoprove forcing-logic.appeal-listp-of-firstn)
+
+(%autoprove forcing-logic.appeal-listp-of-restn)
+
+
+
+(%autoprove logic.method-of-logic.appeal
+            (%enable default logic.appeal logic.method))
+
+(%autoprove logic.conclusion-of-logic.appeal
+            (%enable default logic.appeal logic.conclusion))
+
+(%autoprove logic.subproofs-of-logic.appeal
+            (%enable default logic.appeal logic.subproofs))
+
+(%autoprove logic.extras-of-logic.appeal
+            (%enable default logic.appeal logic.extras))
+
+(%autoprove logic.appeal-under-iff
+            (%enable default logic.appeal))
+
+(%autoprove forcing-logic.appealp-of-logic.appeal
+            (%enable default logic.appeal)
+            (%restrict default definition-of-logic.appealp
+                       (or (equal x '(CONS METHOD (CONS CONCLUSION 'NIL)))
+                           (equal x '(CONS METHOD (CONS CONCLUSION (CONS SUBPROOFS 'NIL))))
+                           (equal x '(CONS METHOD (CONS CONCLUSION (CONS SUBPROOFS (CONS EXTRAS 'NIL))))))))
+
+
+(%autoprove forcing-symbolp-of-logic.method
+            (%enable default logic.method)
+            (%restrict default definition-of-logic.appealp (equal x 'x)))
+
+(%autoprove forcing-logic.formulap-of-logic.conclusion
+            (%enable default logic.conclusion)
+            (%restrict default definition-of-logic.appealp (equal x 'x)))
+
+(%autoprove forcing-true-listp-of-logic.subproofs
+            (%enable default logic.subproofs)
+            (%restrict default definition-of-logic.appealp (equal x 'x)))
+
+(%autoprove forcing-logic.appeal-listp-of-logic.subproofs
+            (%enable default logic.subproofs)
+            (%restrict default definition-of-logic.appealp (equal x 'x)))
+
+
+(%autoprove rank-of-logic.subproofs
+            (%enable default logic.subproofs)
+            (%restrict default definition-of-logic.appealp (equal x 'x)))
+
+(%autoprove rank-of-logic.subproofs-weak
+            (%enable default logic.subproofs))
+
+(%autoprove rank-of-logic.subproofs-strong-via-consp
+            (%enable default logic.subproofs))
+
+(%autoprove rank-of-first-of-logic.subproofs
+            (%disable default rank-of-logic.subproofs)
+            (%use (%instance (%thm rank-of-logic.subproofs))))
+
+(%autoprove rank-of-second-of-logic.subproofs
+            (%disable default rank-of-logic.subproofs)
+            (%use (%instance (%thm rank-of-logic.subproofs))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-2-induction.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-2-induction.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-2-induction.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-2-induction.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,142 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp-1")
+(%interactive)
+
+
+
+(%autoadmit logic.make-basis-step)
+
+(%autoprove forcing-logic.formulap-of-logic.make-basis-step
+            (%enable default logic.make-basis-step))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.make-basis-step
+            (%enable default logic.make-basis-step))
+
+
+
+(%autoadmit logic.make-induction-step)
+
+(%autoprove forcing-logic.formulap-of-logic.make-induction-step
+            (%enable default logic.make-induction-step))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.make-induction-step
+            (%enable default logic.make-induction-step))
+
+
+
+(%autoadmit logic.make-induction-steps)
+
+(defmacro %logic.make-induction-steps-induction (qs all-sigmas)
+  `(%induct (rank ,qs)
+            ((not (consp ,qs))
+             nil)
+            ((consp ,qs)
+             (((,qs         (cdr ,qs))
+               (,all-sigmas (cdr ,all-sigmas)))))))
+
+(%autoprove true-listp-of-logic.make-induction-steps
+            (%logic.make-induction-steps-induction qs all-sigmas)
+            (%restrict default logic.make-induction-steps (equal qs 'qs)))
+
+(%autoprove len-of-logic.make-induction-steps
+            (%logic.make-induction-steps-induction qs all-sigmas)
+            (%restrict default logic.make-induction-steps (equal qs 'qs)))
+
+(%autoprove forcing-logic.formula-listp-of-logic.make-induction-steps
+            (%logic.make-induction-steps-induction qs all-sigmas)
+            (%restrict default logic.make-induction-steps (equal qs 'qs)))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.make-induction-steps
+            (%logic.make-induction-steps-induction qs all-sigmas)
+            (%restrict default logic.make-induction-steps (equal qs 'qs)))
+
+
+
+(%autoadmit logic.make-ordinal-step)
+
+(%autoprove forcing-logic.formulap-of-logic.make-ordinal-step
+            (%enable default logic.make-ordinal-step))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.make-ordinal-step
+            (%enable default logic.make-ordinal-step))
+
+
+
+(%autoadmit logic.make-measure-step)
+
+(%autoprove forcing-logic.formulap-of-logic.make-measure-step
+            (%enable default logic.make-measure-step))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.make-measure-step
+            (%enable default logic.make-measure-step))
+
+
+
+(%autoadmit logic.make-measure-steps)
+
+(%autoprove forcing-logic.formula-listp-of-logic.make-measure-steps
+            (%cdr-induction sigmas-i)
+            (%restrict default logic.make-measure-steps (equal sigmas-i 'sigmas-i)))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.make-measure-steps
+            (%cdr-induction sigmas-i)
+            (%restrict default logic.make-measure-steps (equal sigmas-i 'sigmas-i)))
+
+
+
+(%autoadmit logic.make-all-measure-steps)
+
+(defmacro %logic.make-all-measure-steps-induction (qs all-sigmas)
+  `(%induct (rank ,all-sigmas)
+            ((not (consp ,all-sigmas))
+             nil)
+            ((consp ,all-sigmas)
+             (((qs         (cdr ,qs))
+               (all-sigmas (cdr ,all-sigmas)))))))
+
+(%autoprove true-listp-of-logic.make-all-measure-steps
+            (%logic.make-all-measure-steps-induction qs all-sigmas)
+            (%restrict default logic.make-all-measure-steps (equal all-sigmas 'all-sigmas)))
+
+(%autoprove forcing-logic.formula-listp-of-logic.make-all-measure-steps
+            (%logic.make-all-measure-steps-induction qs all-sigmas)
+            (%restrict default logic.make-all-measure-steps (equal all-sigmas 'all-sigmas)))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.make-all-measure-steps
+            (%logic.make-all-measure-steps-induction qs all-sigmas)
+            (%restrict default logic.make-all-measure-steps (equal all-sigmas 'all-sigmas)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-2-strip-conclusions.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-2-strip-conclusions.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-2-strip-conclusions.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-2-strip-conclusions.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,70 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp-1")
+(%interactive)
+
+
+(%defprojection :list (logic.strip-conclusions x)
+                :element (logic.conclusion x)
+                :nil-preservingp t)
+
+(%autoprove second-of-logic.strip-conclusions)
+
+(%autoprove forcing-logic.formula-listp-of-logic.strip-conclusions
+            (%cdr-induction x))
+
+
+(%autoprove logic.fmtype-of-logic.conclusion-of-nth-when-logic.all-disjunctionsp)
+
+(%autoprove logic.fmtype-of-logic.conclusion-of-nth-when-logic.all-atomicp)
+
+(%autoprove logic.vlhs-of-logic.conclusion-of-car-when-all-equalp)
+
+
+(%autoprove logic.vlhs-of-logic.conclusion-of-nth-when-all-equalp-of-logic.vlhses
+            (%autoinduct nth)
+            (%restrict default nth (equal n 'n)))
+
+(%autoprove logic.fmtype-of-logic.vrhs-of-logic.conclusion-of-nth-when-logic.all-disjunctionsp-of-logic.all-atomicp)
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-of-car)
+(%autoprove logic.formula-atblp-of-logic.conclusion-of-second)
+(%autoprove logic.formula-atblp-of-logic.conclusion-of-third)
+
+
+(%autoprove logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+
+(%autoprove logic.formula-list-atblp-of-logic.strip-conclusions-when-len-2)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-2.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,338 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp-2-strip-conclusions")
+(include-book "proofp-2-induction")
+(%interactive)
+
+
+
+(%autoadmit logic.axiom-okp)
+
+(%autoprove booleanp-of-logic.axiom-okp
+            (%enable default logic.axiom-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.axiom-okp
+            (%enable default logic.axiom-okp))
+
+
+(%autoadmit logic.theorem-okp)
+
+(%autoprove booleanp-of-logic.theorem-okp
+            (%enable default logic.theorem-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.theorem-okp
+            (%enable default logic.theorem-okp))
+
+
+(%autoadmit logic.propositional-schema-okp)
+
+(%autoprove booleanp-of-logic.propositional-schema-okp
+            (%enable default logic.propositional-schema-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.propositional-schema-okp
+            (%enable default
+                     logic.propositional-schema-okp
+                     backtracking-logic.formula-atblp-rules)
+            (%disable default
+                      forcing-logic.formula-atblp-rules))
+
+
+
+
+(%autoadmit logic.check-functional-axiom)
+
+(%autoprove booleanp-of-logic.check-functional-axiom
+            (%induct (rank x)
+                     ((equal (logic.fmtype x) 'pequal*)
+                      nil)
+                     ((equal (logic.fmtype x) 'por*)
+                      (((x  (logic.vrhs x))
+                        (ti (cons (logic.=lhs (logic.~arg (logic.vlhs x))) ti))
+                        (si (cons (logic.=rhs (logic.~arg (logic.vlhs x))) si)))))
+                     ((and (not (equal (logic.fmtype x) 'pequal*))
+                           (not (equal (logic.fmtype x) 'por*)))
+                      nil))
+            (%restrict default logic.check-functional-axiom (equal x 'x)))
+
+(%autoadmit logic.functional-equality-okp)
+
+(%autoprove booleanp-of-logic.functional-equality-okp
+            (%enable default logic.functional-equality-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.functional-equality-okp
+            (%enable default logic.functional-equality-okp))
+
+
+
+(%autoadmit logic.expansion-okp)
+
+(%autoprove booleanp-of-logic.expansion-okp
+            (%enable default logic.expansion-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.expansion-okp
+            (%enable default
+                     logic.expansion-okp
+                     backtracking-logic.formula-atblp-rules
+                     logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+            (%disable default
+                      forcing-logic.formula-atblp-rules
+                      forcing-true-listp-of-logic.subproofs))
+
+
+
+(%autoadmit logic.contraction-okp)
+
+(%autoprove booleanp-of-logic.contraction-okp
+            (%enable default logic.contraction-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.contraction-okp
+            (%enable default
+                     logic.contraction-okp
+                     backtracking-logic.formula-atblp-rules
+                     logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+            (%disable default
+                      forcing-logic.formula-atblp-rules
+                      forcing-true-listp-of-logic.subproofs))
+
+
+(%autoadmit logic.associativity-okp)
+
+(%autoprove booleanp-of-logic.associativity-okp
+            (%enable default logic.associativity-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.associativity-okp
+            (%enable default
+                     logic.associativity-okp
+                     backtracking-logic.formula-atblp-rules
+                     logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+            (%disable default
+                      forcing-logic.formula-atblp-rules
+                      forcing-true-listp-of-logic.subproofs))
+
+
+
+(%autoadmit logic.cut-okp)
+
+(%autoprove booleanp-of-logic.cut-okp
+            (%enable default logic.cut-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.cut-okp
+            (%enable default
+                     logic.cut-okp
+                     backtracking-logic.formula-atblp-rules
+                     logic.formula-list-atblp-of-logic.strip-conclusions-when-len-2)
+            (%disable default
+                      forcing-logic.formula-atblp-rules
+                      forcing-true-listp-of-logic.subproofs))
+
+
+
+(%autoadmit logic.instantiation-okp)
+
+(%autoprove booleanp-of-logic.instantiation-okp
+            (%enable default logic.instantiation-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.instantiation-okp
+            (%enable default
+                     logic.instantiation-okp
+                     backtracking-logic.formula-atblp-rules
+                     logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+            (%disable default
+                      forcing-logic.formula-atblp-rules
+                      forcing-true-listp-of-logic.subproofs))
+
+
+(%autoadmit logic.beta-reduction-okp)
+
+(%autoprove booleanp-of-logic.beta-reduction-okp
+            (%enable default logic.beta-reduction-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.beta-reduction-okp
+            (%enable default logic.beta-reduction-okp))
+
+
+
+(%autoadmit logic.base-eval-okp)
+
+(%autoprove booleanp-of-logic.base-eval-okp
+            (%enable default logic.base-eval-okp))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.base-eval-okp
+            (%enable default
+                     logic.base-eval-okp
+                     backtracking-logic.formula-atblp-rules)
+            (%disable default
+                      forcing-logic.formula-atblp-rules
+                      forcing-true-listp-of-logic.subproofs))
+
+
+
+
+
+(%autoadmit logic.induction-okp)
+
+(%autoprove booleanp-of-logic.induction-okp
+            (%enable default logic.induction-okp))
+
+(%autoprove lemma-for-logic.formula-atblp-of-logic.conclusion-when-logic.induction-okp
+            (%enable default logic.make-basis-step))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.induction-okp
+            (%enable default
+                     logic.induction-okp
+                     lemma-for-logic.formula-atblp-of-logic.conclusion-when-logic.induction-okp)
+            (%disable default
+                      logic.formula-atblp-when-memberp-of-logic.formula-list-atblp
+                      logic.formula-atblp-when-memberp-of-logic.formula-list-atblp-alt)
+            (%auto)
+            (%use (%instance (%thm logic.formula-atblp-when-memberp-of-logic.formula-list-atblp)
+                             (a (logic.make-basis-step (logic.conclusion x) (second (logic.extras x))))
+                             (x (logic.strip-conclusions (logic.subproofs x))))))
+
+
+(%autoadmit logic.appeal-step-okp)
+
+;; (defsection logic.appeal-step-okp
+;;   ;; Bleh skip okp thing.  We need autoadmit to respect :export.
+;;   (%defun logic.appeal-step-okp (x axioms thms atbl)
+;;           (LET ((HOW (LOGIC.METHOD X)))
+;;                (COND ((EQUAL HOW 'AXIOM)
+;;                       (LOGIC.AXIOM-OKP X AXIOMS ATBL))
+;;                      ((EQUAL HOW 'THEOREM)
+;;                       (LOGIC.THEOREM-OKP X THMS ATBL))
+;;                      ((EQUAL HOW 'PROPOSITIONAL-SCHEMA)
+;;                       (LOGIC.PROPOSITIONAL-SCHEMA-OKP X ATBL))
+;;                      ((EQUAL HOW 'FUNCTIONAL-EQUALITY)
+;;                       (LOGIC.FUNCTIONAL-EQUALITY-OKP X ATBL))
+;;                      ((EQUAL HOW 'BETA-REDUCTION)
+;;                       (LOGIC.BETA-REDUCTION-OKP X ATBL))
+;;                      ((EQUAL HOW 'EXPANSION)
+;;                       (LOGIC.EXPANSION-OKP X ATBL))
+;;                      ((EQUAL HOW 'CONTRACTION)
+;;                       (LOGIC.CONTRACTION-OKP X))
+;;                      ((EQUAL HOW 'ASSOCIATIVITY)
+;;                       (LOGIC.ASSOCIATIVITY-OKP X))
+;;                      ((EQUAL HOW 'CUT) (LOGIC.CUT-OKP X))
+;;                      ((EQUAL HOW 'INSTANTIATION)
+;;                       (LOGIC.INSTANTIATION-OKP X ATBL))
+;;                      ((EQUAL HOW 'INDUCTION)
+;;                       (LOGIC.INDUCTION-OKP X))
+;;                      ((EQUAL HOW 'BASE-EVAL)
+;;                       (LOGIC.BASE-EVAL-OKP X ATBL))
+;;                      ;((EQUAL HOW 'SKIP)
+;;                      ; (LOGIC.SKIP-OKP X ATBL))
+;;                      (T NIL))))
+;;   (%admit))
+
+(%autoprove booleanp-of-logic.appeal-step-okp
+            (%enable default logic.appeal-step-okp))
+
+(%autoprove logic.appeal-step-okp-when-not-consp
+            (%enable default logic.appeal-step-okp logic.method))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.appeal-step-okp
+            (%enable default logic.appeal-step-okp))
+
+
+(encapsulate
+ ()
+ ;; BOZO add hints facility to %autoadmit
+ (local (%disable default forcing-true-listp-of-logic.subproofs))
+ (%autoadmit logic.flag-proofp))
+
+(%autoadmit logic.proofp)
+(%autoadmit logic.proof-listp)
+
+(%autoprove definition-of-logic.proofp
+            (%enable default logic.proofp logic.proof-listp)
+            (%restrict default logic.flag-proofp (equal x 'x)))
+
+(%autoprove definition-of-logic.proof-listp
+            (%enable default logic.proofp logic.proof-listp)
+            (%restrict default logic.flag-proofp (equal x 'x)))
+
+(%autoprove logic.proofp-when-not-consp
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove logic.proof-listp-when-not-consp
+            (%restrict default definition-of-logic.proof-listp (equal x 'x)))
+
+(%autoprove logic.proof-listp-of-cons
+            (%restrict default definition-of-logic.proof-listp (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%disable default forcing-true-listp-of-logic.subproofs)
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove booleanp-of-logic.proofp
+            (%use (%instance (%thm lemma-for-booleanp-of-logic.proofp) (flag 'proof))))
+
+(%autoprove booleanp-of-logic.proof-listp
+            (%use (%instance (%thm lemma-for-booleanp-of-logic.proofp) (flag 'list))))
+
+
+
+(%deflist logic.proof-listp (x axioms thms atbl)
+          (logic.proofp x axioms thms atbl))
+
+(%autoprove logic.proofp-of-nth-when-logic.proof-listp
+            (%autoinduct nth)
+            (%restrict default nth (equal n 'n)))
+
+(%autoprove forcing-logic.proof-listp-of-firstn)
+
+(%autoprove forcing-logic.proof-listp-of-restn)
+
+
+
+(%autoprove lemma-for-logic.formula-atblp-of-logic.conclusion-when-logic.proofp
+            (%logic.appeal-induction flag x)
+            (%restrict default definition-of-logic.proofp (equal x 'x))
+            (%disable default forcing-true-listp-of-logic.subproofs))
+
+(%autoprove logic.formula-atblp-of-logic.conclusion-when-logic.proofp
+            (%use (%instance (%thm lemma-for-logic.formula-atblp-of-logic.conclusion-when-logic.proofp)
+                             (flag 'proof))))
+
+(%autoprove logic.formula-list-atblp-of-logic.strip-conclusions-when-logic.proof-listp
+            (%use (%instance (%thm lemma-for-logic.formula-atblp-of-logic.conclusion-when-logic.proofp)
+                             (flag 'list))))
+
+(%autoprove logic.proof-listp-of-logic.subproofs-when-logic.proofp
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-3-provablep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-3-provablep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-3-provablep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-3-provablep.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,133 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp-2")
+(%interactive)
+
+(%defchoose logic.provable-witness proof (x axioms thms atbl)
+            (and (logic.appealp proof)
+                 (logic.proofp proof axioms thms atbl)
+                 (equal (logic.conclusion proof) x)))
+
+(defun logic.provablep (x axioms thms atbl)
+  ;; BOZO because we used defun-sk to introduce it, which is based on
+  ;; ACL2::defun instead of MILAWA::defun, there's no syntax-defuns entry for
+  ;; logic.provablep, So, we now add a redundant definition of logic.provablep
+  ;; using MILAWA::defun, so that %autoadmit knows what its definition is.
+  (declare (xargs :guard (and (logic.formulap x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((proof (logic.provable-witness x axioms thms atbl)))
+       (and (logic.appealp proof)
+            (logic.proofp proof axioms thms atbl)
+            (equal (logic.conclusion proof) x))))
+
+(%autoadmit logic.provablep)
+
+(%autoprove logic.provablep-suff
+            (%use (build.axiom (defchoose-axiom-for-logic.provable-witness)))
+            (%enable default logic.provablep))
+
+(%autoprove booleanp-of-logic.provablep
+            (%enable default logic.provablep))
+
+(%autoprove forcing-logic.appealp-of-logic.provable-witness
+            (%enable default logic.provablep))
+
+(%autoprove forcing-logic.proofp-of-logic.provable-witness
+            (%enable default logic.provablep)
+            (%disable default forcing-logic.appealp-of-logic.provable-witness))
+
+(%autoprove forcing-logic.conclusion-of-logic.provable-witness
+            (%enable default logic.provablep))
+
+(%autoprove logic.formulap-when-logic.provablep
+            (%disable default forcing-logic.formulap-of-logic.conclusion)
+            (%use (%instance (%thm forcing-logic.formulap-of-logic.conclusion)
+                             (x (logic.provable-witness x axioms thms atbl))))
+            ;; This %split is important for some reason
+            (%split))
+
+(%autoprove logic.formula-atblp-when-logic.provablep
+            (%use (%instance (%thm logic.formula-atblp-of-logic.conclusion-when-logic.proofp)
+                             (x (logic.provable-witness x axioms thms atbl)))))
+
+(%autoprove logic.provablep-when-not-consp
+            (%disable default logic.formulap-when-not-consp)
+            (%use (%instance (%thm logic.formulap-when-not-consp))))
+
+(%autoprove forcing-logic.provablep-when-logic.proofp
+            (%use (%instance (%thm logic.provablep-suff)
+                             (proof x)
+                             (x (logic.conclusion x)))))
+
+
+
+(%deflist logic.provable-listp (x axioms thms atbl)
+          (logic.provablep x axioms thms atbl))
+
+(%autoprove logic.provablep-of-car-when-logic.provable-listp-free)
+
+(%autoprove logic.provablep-of-second-when-logic.provable-listp)
+
+(%autoprove forcing-logic.provable-listp-of-logic.strip-conclusions-when-logic.proof-listp
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.provable-listp-of-logic.subproofs-when-logic.proofp
+            (%restrict default definition-of-logic.proofp (equal x 'x)))
+
+(%autoprove logic.formula-list-atblp-of-when-logic.provable-listp
+            (%cdr-induction x))
+
+
+
+(%defprojection :list (logic.provable-list-witness x axioms thms atbl)
+                :element (logic.provable-witness x axioms thms atbl))
+
+(%autoprove forcing-logic.appeal-listp-of-logic.provable-list-witness
+            (%cdr-induction x))
+
+(%autoprove force-logic.proof-listp-of-logic.provable-list-witness
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.strip-conclusions-of-logic.provable-list-witness
+            (%cdr-induction x))
+
+(%autoprove logic.provablep-of-logic.conclusion-of-first-when-logic.provable-listp)
+(%autoprove logic.provablep-of-logic.conclusion-of-second-when-logic.provable-listp)
+(%autoprove logic.provablep-of-logic.conclusion-of-third-when-logic.provable-listp)
+(%autoprove logic.provablep-of-logic.conclusion-of-fourth-when-logic.provable-listp)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-3-subproofs.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-3-subproofs.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp-3-subproofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp-3-subproofs.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,334 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp-2")
+(%interactive)
+
+
+
+;; BOZO add all these to autoprove
+(%autoprove lemma-axiom-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.axiom-okp))
+
+(%autoprove lemma-theorem-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.theorem-okp))
+
+(%autoprove lemma-propositional-schema-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.propositional-schema-okp))
+
+(%autoprove lemma-functional-equality-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.functional-equality-okp))
+
+(%autoprove lemma-beta-reduction-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.beta-reduction-okp))
+
+(%autoprove lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%disable default len-of-logic.strip-conclusions [outside]len-of-logic.strip-conclusions)
+            (%use (%instance (%thm len-of-logic.strip-conclusions) (x a)))
+            (%use (%instance (%thm len-of-logic.strip-conclusions) (x b))))
+
+(%autoprove lemma-expansion-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.expansion-okp)
+            (%use (%instance (%thm lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable)
+                             (a (logic.subproofs x))
+                             (b new-subproofs))))
+
+(%autoprove lemma-contraction-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.contraction-okp)
+            (%use (%instance (%thm lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable)
+                             (a (logic.subproofs x))
+                             (b new-subproofs)))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%car-cdr-elim new-subproofs)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove lemma-associativity-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.associativity-okp)
+            (%use (%instance (%thm lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable)
+                             (a (logic.subproofs x))
+                             (b new-subproofs)))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%car-cdr-elim new-subproofs)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove lemma-cut-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.cut-okp)
+            (%betamode nil)
+            (%use (%instance (%thm lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable)
+                             (a (logic.subproofs x))
+                             (b new-subproofs)))
+            (%auto :strategy (cleanup split crewrite))
+            (%car-cdr-elim new-subproofs)
+            (%auto :strategy (cleanup split crewrite))
+            (%car-cdr-elim (cdr new-subproofs))
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove lemma-instantiation-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.instantiation-okp)
+            (%use (%instance (%thm lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable)
+                             (a (logic.subproofs x))
+                             (b new-subproofs)))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%car-cdr-elim new-subproofs)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove lemma-induction-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.induction-okp)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove lemma-base-eval-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.base-eval-okp)
+            (%forcingp nil)
+            (%auto :strategy (cleanup split crewrite)))
+
+
+
+
+
+
+;; Bah. We have a problem now.  Our rules above target
+;;
+;;   (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x))
+;;
+;; But we never see this.  Instead, we see things like:
+;;
+;;   (logic.appealp 'base-eval (logic.conclusion x) new-subproofs (logic.extras x))
+;;
+;; And even though we know that (logic.method x) is equal to 'base-eval, we don't match the
+;; rule because we don't consider the canonical forms when doing pattern matching.  Maybe
+;; we should try to change that.  That is, suppose we are trying to match (foo x y), but we
+;; know (via our assms structure) that x = x', where x' is the canonical form of x.  Then,
+;; really maybe we should be trying to match (foo x' y) instead.  This would require some
+;; work to change.
+;;
+;; Instead of doing this, I add the following hack theorems which suck but do the job.
+;;
+;; How does ACL2 handle this?  It might be interesting to ask Matt.
+
+(defsection lemma-axiom-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-axiom-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'axiom)))
+                 :lhs (logic.axiom-okp (logic.appeal 'axiom (logic.conclusion x) new-subproofs (logic.extras x)) axioms atbl)
+                 :rhs (logic.axiom-okp x axioms atbl)))
+  (%use (%instance (%thm lemma-axiom-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-theorem-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-theorem-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'theorem)))
+                 :lhs (logic.theorem-okp (logic.appeal 'theorem (logic.conclusion x) new-subproofs (logic.extras x)) thms atbl)
+                 :rhs (logic.theorem-okp x thms atbl)))
+  (%use (%instance (%thm lemma-theorem-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-propositional-schema-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-propositional-schema-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'propositional-schema)))
+                 :lhs (logic.propositional-schema-okp (logic.appeal 'propositional-schema (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                 :rhs (logic.propositional-schema-okp x atbl)))
+  (%use (%instance (%thm lemma-propositional-schema-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-functional-equality-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-functional-equality-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'functional-equality)))
+                 :lhs (logic.functional-equality-okp (logic.appeal 'functional-equality (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                 :rhs (logic.functional-equality-okp x atbl)))
+  (%use (%instance (%thm lemma-functional-equality-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-beta-reduction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-beta-reduction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'beta-reduction)))
+                 :lhs (logic.beta-reduction-okp (logic.appeal 'beta-reduction (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                 :rhs (logic.beta-reduction-okp x atbl)))
+  (%use (%instance (%thm lemma-beta-reduction-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-expansion-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-expansion-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'expansion)))
+                 :lhs (logic.expansion-okp (logic.appeal 'expansion (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                 :rhs (logic.expansion-okp x atbl)))
+  (%use (%instance (%thm lemma-expansion-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-contraction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-contraction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'contraction)))
+                 :lhs (logic.contraction-okp (logic.appeal 'contraction (logic.conclusion x) new-subproofs (logic.extras x)))
+                 :rhs (logic.contraction-okp x)))
+  (%use (%instance (%thm lemma-contraction-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-associativity-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-associativity-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'associativity)))
+                 :lhs (logic.associativity-okp (logic.appeal 'associativity (logic.conclusion x) new-subproofs (logic.extras x)))
+                 :rhs (logic.associativity-okp x)))
+  (%use (%instance (%thm lemma-associativity-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-cut-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-cut-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'cut)))
+                 :lhs (logic.cut-okp (logic.appeal 'cut (logic.conclusion x) new-subproofs (logic.extras x)))
+                 :rhs (logic.cut-okp x)))
+  (%use (%instance (%thm lemma-cut-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-instantiation-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-instantiation-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'instantiation)))
+                 :lhs (logic.instantiation-okp (logic.appeal 'instantiation (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                 :rhs (logic.instantiation-okp x atbl)))
+  (%use (%instance (%thm lemma-instantiation-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-induction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-induction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'induction)))
+                 :lhs (logic.induction-okp (logic.appeal 'induction (logic.conclusion x) new-subproofs (logic.extras x)))
+                 :rhs (logic.induction-okp x)))
+  (%use (%instance (%thm lemma-induction-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(defsection lemma-base-eval-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+  (%prove (%rule lemma-base-eval-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                 :hyps (list (%hyp (logic.appealp x))
+                             (%hyp (logic.appeal-listp new-subproofs))
+                             (%hyp (true-listp new-subproofs))
+                             (%hyp (equal (logic.strip-conclusions (logic.subproofs x))
+                                          (logic.strip-conclusions new-subproofs)))
+                             (%hyp (equal (logic.method x) 'base-eval)))
+                 :lhs (logic.base-eval-okp (logic.appeal 'base-eval (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                 :rhs (logic.base-eval-okp x atbl)))
+  (%use (%instance (%thm lemma-base-eval-for-forcing-logic.provablep-when-logic.subproofs-provable)))
+  (%auto)
+  (%qed))
+
+(%autoprove lemma-appeal-step-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%enable default logic.appeal-step-okp)
+            (%enable default
+                     lemma-axiom-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-theorem-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-propositional-schema-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-functional-equality-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-beta-reduction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-expansion-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-contraction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-associativity-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-cut-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-instantiation-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-induction-for-forcing-logic.provablep-when-logic.subproofs-provable-hack
+                     lemma-base-eval-for-forcing-logic.provablep-when-logic.subproofs-provable-hack))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/proofp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/proofp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,70 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp-3-provablep")
+(include-book "proofp-3-subproofs")
+(%interactive)
+
+
+
+(%autoprove lemma-main-for-forcing-logic.provablep-when-logic.subproofs-provable
+            (%restrict default definition-of-logic.proofp
+                       (equal x '(logic.appeal (logic.method x)
+                                               (logic.conclusion x)
+                                               (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                            axioms thms atbl)
+                                               (logic.extras x))))
+            (%enable default lemma-appeal-step-for-forcing-logic.provablep-when-logic.subproofs-provable))
+
+
+(%autoprove forcing-logic.provablep-when-logic.subproofs-provable
+            (%use (%instance (%thm forcing-logic.provablep-when-logic.proofp)
+                             (x (logic.appeal (logic.method x)
+                                              (logic.conclusion x)
+                                              (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                           axioms thms atbl)
+                                              (logic.extras x)))))
+            (%enable default lemma-main-for-forcing-logic.provablep-when-logic.subproofs-provable))
+
+(%autoprove logic.formula-list-atblp-of-logic.strip-conclusions-of-cdr-when-logic.provable-listp)
+
+(%autoprove logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest)
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/proofp"
+                                         ;; We don't have skip-okp here.
+                                         logic.formula-atblp-of-logic.conclusion-when-logic.skip-okp
+                                         booleanp-of-logic.skip-okp)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/quote-range.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/quote-range.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/quote-range.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/quote-range.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,54 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "groundp")
+(%interactive)
+
+
+(%autoadmit logic.quote-range)
+(%autoprove logic.quote-range-when-not-consp                           (%restrict default logic.quote-range (equal x 'x)))
+(%autoprove logic.quote-range-of-cons                                  (%restrict default logic.quote-range (equal x '(cons a x))))
+(%autoprove true-listp-of-logic.quote-range                            (%cdr-induction x))
+(%autoprove logic.quote-range-of-list-fix                              (%cdr-induction x))
+(%autoprove len-of-logic.quote-range                                   (%cdr-induction x))
+(%autoprove logic.quote-range-of-app                                   (%cdr-induction x))
+(%autoprove forcing-logic.sigmap-of-logic.quote-range                  (%cdr-induction x))
+(%autoprove forcing-logic.sigma-atblp-of-logic.quote-range             (%cdr-induction sigma))
+(%autoprove forcing-logic.constant-listp-of-range-of-logic.quote-range (%cdr-induction x))
+(%autoprove forcing-logic.ground-listp-of-range-of-logic.quote-range)
+(%autoprove forcing-domain-of-logic.quote-range                        (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../logic/quote-range")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/replace-subterm.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/replace-subterm.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/replace-subterm.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/replace-subterm.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,127 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(%interactive)
+
+
+(%autoadmit logic.flag-replace-subterm)
+(%autoadmit logic.replace-subterm)
+(%autoadmit logic.replace-subterm-list)
+
+(%autoprove definition-of-logic.replace-subterm
+            (%restrict default logic.flag-replace-subterm (or (equal x 'x) (equal x 'old)))
+            (%enable default logic.replace-subterm logic.replace-subterm-list)
+            ;; Causes a rlimit loop
+            (%disable default forcing-logic.function-of-logic.function-name-and-logic.function-args-free))
+
+(%autoprove definition-of-logic.replace-subterm-list
+            (%restrict default logic.flag-replace-subterm (equal x 'x))
+            (%enable default logic.replace-subterm logic.replace-subterm-list))
+
+(%autoprove logic.flag-replace-subterm-of-term-removal
+            (%enable default logic.replace-subterm))
+
+(%autoprove logic.flag-replace-subterm-of-list-removal
+            (%enable default logic.replace-subterm-list))
+
+(%autoprove logic.replace-subterm-list-when-not-consp
+            (%restrict default definition-of-logic.replace-subterm-list (equal x 'x)))
+
+(%autoprove logic.replace-subterm-list-of-cons
+            (%restrict default definition-of-logic.replace-subterm-list (equal x '(cons a x))))
+
+(%defprojection :list (logic.replace-subterm-list x old new)
+                :element (logic.replace-subterm x old new))
+
+
+
+(%autoprove lemma-for-forcing-logic.termp-of-logic.replace-subterm
+            (%logic.term-induction flag x)
+            (%auto)
+            (%restrict default definition-of-logic.replace-subterm (equal x 'x)))
+
+(%autoprove forcing-logic.termp-of-logic.replace-subterm
+            (%use (%instance (%thm lemma-for-forcing-logic.termp-of-logic.replace-subterm)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-listp-of-logic.replace-subterm-list
+            (%use (%instance (%thm lemma-for-forcing-logic.termp-of-logic.replace-subterm)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.term-atblp-of-logic.replace-subterm
+            (%logic.term-induction flag x)
+            (%auto)
+            (%restrict default definition-of-logic.replace-subterm (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-logic.replace-subterm
+            (%use (%instance (%thm lemma-for-forcing-logic.term-atblp-of-logic.replace-subterm)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.replace-subterm-list
+            (%use (%instance (%thm lemma-for-forcing-logic.term-atblp-of-logic.replace-subterm)
+                             (flag 'list))))
+
+
+
+(%autoprove lemma-for-forcing-logic.substitute-of-logic.replace-subterm-with-fresh-variable
+            (%logic.term-induction flag x)
+            (%auto)
+            (%restrict default definition-of-logic.replace-subterm (equal x 'x)))
+
+(%autoprove forcing-logic.substitute-of-logic.replace-subterm-with-fresh-variable
+            (%use (%instance (%thm lemma-for-forcing-logic.substitute-of-logic.replace-subterm-with-fresh-variable)
+                             (flag 'term))))
+
+(%autoprove forcing-logic.substitute-of-logic.replace-subterm-list-with-fresh-variable
+            (%use (%instance (%thm lemma-for-forcing-logic.substitute-of-logic.replace-subterm-with-fresh-variable)
+                             (flag 'list))))
+
+
+
+
+(%defprojection :list (logic.replace-subterm-list-list x old new)
+                :element (logic.replace-subterm-list x old new))
+
+(%autoprove forcing-logic.term-list-listp-of-logic.replace-subterm-list-list                (%cdr-induction x))
+(%autoprove forcing-logic.term-list-list-atblp-of-logic.replace-subterm-list-list           (%cdr-induction x))
+(%autoprove cons-listp-of-logic.replace-subterm-list-list                                   (%cdr-induction x))
+(%autoprove forcing-logic.substitute-of-logic.replace-subterm-list-list-with-fresh-variable (%cdr-induction x))
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/replace-subterm")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-formula-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-formula-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-formula-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-formula-1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,75 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(include-book "substitute-term")
+(%interactive)
+
+(%autoadmit logic.substitute-formula)
+
+(%autoprove logic.substitute-formula-of-logic.por
+            (%restrict default logic.substitute-formula (equal formula '(logic.por x y))))
+
+(%autoprove logic.substitute-formula-of-logic.pnot
+            (%restrict default logic.substitute-formula (equal formula '(logic.pnot x))))
+
+(%autoprove logic.substitute-formula-of-logic.pequal
+            (%restrict default logic.substitute-formula (equal formula '(logic.pequal x y))))
+
+(%autoprove logic.substitute-formula-when-malformed-cheap
+            (%restrict default logic.substitute-formula (equal formula 'formula)))
+
+(%autoprove logic.substitute-formula-of-nil)
+
+(%autoprove forcing-logic.formulap-of-logic.substitute-formula
+            (%logic.formulap-induction formula)
+            (%restrict default logic.substitute-formula (equal formula 'formula)))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.substitute-formula
+            (%logic.formulap-induction formula)
+            (%restrict default logic.substitute-formula (equal formula 'formula)))
+
+(%autoprove forcing-logic.substitute-formula-under-iff
+            (%restrict default logic.substitute-formula (equal formula 'formula)))
+
+(%autoprove forcing-logic.fmtype-of-logic.substitute-formula
+            (%restrict default logic.substitute-formula (equal formula 'x)))
+
+(%autoprove forcing-logic.=lhs-of-logic.substitute-formula
+            (%restrict default logic.substitute-formula (equal formula 'x)))
+
+(%autoprove forcing-logic.=rhs-of-logic.substitute-formula
+            (%restrict default logic.substitute-formula (equal formula 'x)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-formula-2-each.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-formula-2-each.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-formula-2-each.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-formula-2-each.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-formula-1")
+(%interactive)
+
+
+(%defprojection :list (logic.substitute-each-sigma-into-formula f x)
+                :element (logic.substitute-formula f x)
+                :nil-preservingp nil)
+
+(%autoprove logic.formula-listp-of-logic.substitute-each-sigma-into-formula
+            (%cdr-induction sigmas))
+
+(%autoprove logic.formula-list-atblp-of-logic.substitute-each-sigma-into-formula
+            (%cdr-induction sigmas))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-formula-2-list.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-formula-2-list.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-formula-2-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-formula-2-list.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-formula-1")
+(%interactive)
+
+
+(%defprojection :list (logic.substitute-formula-list x sigma)
+                :element (logic.substitute-formula x sigma)
+                :nil-preservingp t)
+
+(%autoprove forcing-logic.formula-listp-of-logic.substitute-formula-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.substitute-formula-list
+            (%cdr-induction x))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-formula.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-formula.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-formula.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-formula.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,95 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-formula-2-each")
+(include-book "substitute-formula-2-list")
+(include-book "disjoin-formulas")
+(include-book "negate-formulas")
+(include-book "pequal-list")
+(include-book "por-list")
+(%interactive)
+
+(%autoprove logic.substitute-formula-of-logic.disjoin-formulas
+            (%cdr-induction x)
+            (%restrict default logic.disjoin-formulas (equal x 'x))
+            (%disable default
+                      ;; These rules cause some problems with forcing
+                      forcing-logic.fmtype-of-logic.substitute-formula
+                      forcing-logic.fmtype-of-logic.disjoin-formulas
+                      forcing-logic.formula-listp-of-logic.substitute-formula-list
+                      forcing-logic.vlhs-of-logic.disjoin-formulas
+                      forcing-logic.formulap-of-logic.disjoin-formulas
+                      forcing-logic.formulap-of-logic.substitute-formula
+                      forcing-logic.formulap-of-logic.por
+                      forcing-equal-of-logic.por-rewrite-two
+                      equal-of-logic.disjoin-formulas-and-logic.disjoin-formulas-when-same-len
+                      aggressive-equal-of-logic.pors))
+
+(%autoprove logic.substitute-formula-list-of-logic.negate-formulas
+            (%cdr-induction x))
+
+(%autoprove logic.substitute-formula-list-of-logic.pequal-list
+            (%cdr-cdr-induction x y)
+            (%disable default
+                      forcing-equal-of-logic.pequal-list-rewrite
+                      forcing-equal-of-logic.pequal-list-rewrite-alt))
+
+(%autoprove logic.substitute-formula-list-of-logic.por-list
+            (%cdr-cdr-induction x y)
+            (%disable default
+                      forcing-equal-of-logic.por-list-rewrite
+                      forcing-equal-of-logic.por-list-rewrite-alt))
+
+
+
+(%defprojection :list (logic.substitute-formula-list-list x sigma)
+                :element (logic.substitute-formula-list x sigma)
+                ;; BOZO this is nil-preserving, but the ACL2 model needs to be updated with that fact.
+                ;; :nil-preservingp t
+                )
+
+(%autoprove forcing-logic.formula-list-listp-of-logic.substitute-formula-list-list
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-list-atblp-of-logic.substitute-formula-list-list
+            (%cdr-induction x))
+
+(%autoprove logic.substitute-formula-list-of-logic.disjoin-each-formula-list
+            (%cdr-induction x))
+
+(%autoprove logic.substitute-formula-list-of-logic.disjoin-each-formula-list-free)
+
+(%ensure-exactly-these-rules-are-missing "../../logic/substitute-formula")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-1-sigma-atblp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-1-sigma-atblp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-1-sigma-atblp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-1-sigma-atblp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,222 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+
+(%defmap :map (logic.sigma-atblp x atbl)
+         :key (logic.variablep x)
+         :val (logic.term-atblp x atbl)
+         :key-list (logic.variable-listp x)
+         :val-list (logic.term-list-atblp x atbl)
+         :val-of-nil nil)
+
+;; (DEFSECTION LOGIC.SIGMA-ATBLP
+;; (%AUTOADMIT LOGIC.SIGMA-ATBLP)
+;; (%AUTOPROVE LOGIC.SIGMA-ATBLP-WHEN-NOT-CONSP
+;;               (%RESTRICT DEFAULT LOGIC.SIGMA-ATBLP (EQUAL X 'X)))
+;; (%AUTOPROVE LOGIC.SIGMA-ATBLP-OF-CONS
+;;               (%RESTRICT DEFAULT LOGIC.SIGMA-ATBLP
+;;                          (EQUAL X '(CONS A X))))
+;; (%AUTOPROVE CONSP-WHEN-MEMBERP-OF-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X)
+;;               (%AUTO)
+;;               (%CAR-CDR-ELIM X))
+;; (%AUTOPROVE CONSP-WHEN-MEMBERP-OF-LOGIC.SIGMA-ATBLP-ALT)
+;; (%AUTOPROVE LOGIC.VARIABLEP-OF-CAR-WHEN-MEMBERP-OF-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X)
+;;               (%AUTO)
+;;               (%CAR-CDR-ELIM X))
+;; (%AUTOPROVE LOGIC.VARIABLEP-WHEN-LOOKUP-IN-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X)
+;;               (%AUTO)
+;;               (%CAR-CDR-ELIM X))
+;; (%AUTOPROVE LOGIC.TERM-ATBLP-OF-CDR-WHEN-MEMBERP-OF-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X)
+;;               (%AUTO)
+;;               (%CAR-CDR-ELIM X))
+;; (%AUTOPROVE BOOLEANP-OF-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X))
+;; (%AUTOPROVE LOGIC.SIGMA-ATBLP-OF-LIST-FIX
+;;               (%CDR-INDUCTION X))
+
+
+
+;; (ACL2::defttag disable-caching)
+
+;; (ACL2::progn!
+;;  (ACL2::set-raw-mode t)
+;;  (ACL2::defun rw.cache-update (term trace cache)
+;;               (declare (xargs :guard (and (logic.termp term)
+;;                                           (rw.tracep trace)
+;;                                           (rw.cachep cache)))
+;;                        (ignore term trace))
+;;               cache)
+;;  (ACL2::defun rw.cache-lookup (term iffp cache)
+;;               (declare (xargs :guard (and (logic.termp term)
+;;                                           (booleanp iffp)
+;;                                           (rw.cachep cache)))
+;;                        (ignore term iffp cache))
+;;               nil))
+
+
+
+;; (%AUTORULE LOGIC.SIGMA-ATBLP-OF-APP)
+;; (%CDR-INDUCTION X)
+;; ;; (%auto):
+;; (%cleanup)
+;; ;; No progress
+;; (%split)
+;; ;; Progress; 11 goals remain
+;; (%cleanup)
+;; ;; Progress; 4 goals remain
+;; (%cleanup)
+;; ;; No progress
+;; (%split)
+;; ;; Progress; 8 goals remain
+;; (%cleanup)
+;; ;; No progress
+;; (%split)
+;; ;; No progress
+;; (%distribute)
+;; ;; No progress
+;; (%urewrite default)
+;; ;; Progress; 8 goals remain
+;; (%cleanup)
+;; ;; Progress; 7 goals remain
+;; (%cleanup)
+;; ;; No progress
+;; (%split)
+;; ;; No progress
+;; (%distribute)
+;; ;; No progress
+;; (%urewrite default)
+;; ;; No progress
+;; (%profile)
+;; (%crewrite default)                           ;; THE FIRST REWRITE
+;; (%profile.report)
+;; (%profile.clear)
+;; ; Rewrote 7 clauses; 4 remain (0 forced)
+;; ;; Progress; 4 goals remain
+;; (%cleanup)
+;; ;; No progress
+;; (%split)
+;; ;; Progress; 16 goals remain
+;; (%cleanup)
+;; ;; Progress; 7 goals remain
+;; (%cleanup)
+;; ;; No progress
+;; (%split)
+;; ;; No progress
+;; (%distribute)
+;; ;; No progress
+;; (%urewrite default)
+;; ;; No progress
+;; (%crewrite default)                            ;; THE SECOND REWRITE
+;; (%profile.report)
+
+;; ;; No progress
+;; (%auto-elim)
+;; ;; Progress; 15 goals remain
+;; (%cleanup)
+;; ;; Progress; 8 goals remain
+;; (%cleanup)
+;; ;; No progress
+;; (%split)
+;; ;; No progress
+;; (%distribute)
+;; ;; No progress
+;; (%urewrite default)
+;; ;; Progress; 8 goals remain
+;; (%cleanup)
+;; ;; Progress; 8 goals remain
+;; (%cleanup)
+;; ;; No progress
+;; (%split)
+;; ;; Progress; 114 goals remain
+;; (%cleanup)
+;; ;; Progress; 0 goals remain
+;; ;All goals have been proven.
+
+
+
+;;   (%AUTOPROVE LOGIC.SIGMA-ATBLP-OF-REV
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE LOGIC.SIGMA-ATBLP-OF-REMOVE-ALL-WHEN-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE LOGIC.SIGMA-ATBLP-OF-REMOVE-DUPLICATES
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE LOGIC.SIGMA-ATBLP-OF-DIFFERENCE-WHEN-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE LOGIC.SIGMA-ATBLP-OF-SUBSET-WHEN-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE LOGIC.SIGMA-ATBLP-OF-SUBSET-WHEN-LOGIC.SIGMA-ATBLP-ALT)
+;;   (%AUTOPROVE LOGIC.VARIABLE-LISTP-OF-DOMAIN-WHEN-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE LOGIC.TERM-LIST-ATBLP-OF-RANGE-WHEN-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE MAPP-WHEN-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE LOGIC.TERM-ATBLP-OF-CDR-OF-LOOKUP-WHEN-LOGIC.SIGMA-ATBLP
+;;               (%CDR-INDUCTION X))
+;;   (%AUTOPROVE
+;;    CDR-OF-LOOKUP-UNDER-IFF-WHEN-LOGIC.SIGMA-ATBLP
+;;    (%USE
+;;        (%INSTANCE
+;;             (%THM LOGIC.TERM-ATBLP-OF-CDR-OF-LOOKUP-WHEN-LOGIC.SIGMA-ATBLP)))
+;;    (%DISABLE DEFAULT
+;;              LOGIC.TERM-ATBLP-OF-CDR-OF-LOOKUP-WHEN-LOGIC.SIGMA-ATBLP)))
+
+
+
+(%autoprove forcing-logic.sigma-atblp-of-pair-lists
+            (%autoinduct pair-lists))
+
+
+
+(%deflist logic.sigma-list-atblp (x atbl)
+  (logic.sigma-atblp x atbl))
+
+(%autoprove logic.sigma-atblp-of-second-when-logic.sigma-list-atblp)
+
+(%autoprove forcing-logic.sigma-list-atblp-of-revappend-onto-each
+            (%cdr-induction x))
+
+
+
+(%deflist logic.sigma-list-list-atblp (x atbl)
+  (logic.sigma-list-atblp x atbl))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-1-sigmap.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-1-sigmap.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-1-sigmap.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-1-sigmap.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,67 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+(%defmap :map (logic.sigmap x)
+         :key (logic.variablep x)
+         :val (logic.termp x)
+         :key-list (logic.variable-listp x)
+         :val-list (logic.term-listp x)
+         :val-of-nil nil)
+
+(%autoprove forcing-logic.sigmap-of-pair-lists
+            (%autoinduct pair-lists))
+
+
+(%deflist logic.sigma-listp (x)
+  (logic.sigmap x))
+
+(%autoprove logic.sigmap-of-second-when-logic.sigma-listp)
+
+(%autoprove forcing-logic.sigma-listp-of-revappend-onto-each
+            (%cdr-induction x))
+
+
+
+(%deflist logic.sigma-list-listp (x)
+  (logic.sigma-listp x))
+
+(%autoprove logic.sigma-listp-of-second-when-logic.sigma-list-listp)
+
+(%autoprove forcing-logic.sigma-listp-of-simple-flatten
+            (%cdr-induction x))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-1-substitute.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-1-substitute.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-1-substitute.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-1-substitute.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,108 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+(%autoadmit logic.flag-substitute)
+(%autoadmit logic.substitute)
+(%autoadmit logic.substitute-list)
+
+
+(%autoprove definition-of-logic.substitute
+            (%enable default logic.substitute logic.substitute-list)
+            (%restrict default logic.flag-substitute (equal x 'x)))
+
+(%autoprove definition-of-logic.substitute-list
+            (%enable default logic.substitute logic.substitute-list)
+            (%restrict default logic.flag-substitute (equal x 'x)))
+
+(%autoprove logic.flag-substitute-of-term
+            (%enable default logic.substitute))
+
+(%autoprove logic.flag-substitute-of-term-list
+            (%enable default logic.substitute-list))
+
+(%autoprove logic.substitute-when-malformed-cheap
+            ;; BOZO this rule says it's cheap, but it doesn't have any backchain limits here or
+            ;; in the ACL2 model!
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove logic.substitute-list-when-not-consp
+            (%restrict default definition-of-logic.substitute-list (equal x 'x)))
+
+(%autoprove logic.substitute-list-of-cons
+            (%restrict default definition-of-logic.substitute-list (equal x '(cons a x))))
+
+(%defprojection :list (logic.substitute-list x sigma)
+                :element (logic.substitute x sigma)
+                :nil-preservingp t)
+
+
+
+(%autoprove logic.substitute-when-logic.constantp
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove logic.substitute-when-logic.variablep
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove logic.substitute-when-logic.functionp-cheap
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove logic.substitute-when-logic.lambdap-cheap
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove forcing-logic.substitute-of-logic.function)
+
+(%autoprove forcing-logic.function-name-of-logic.substitute
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove forcing-logic.function-args-of-logic.substitute
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove forcing-logic.substitute-of-logic.lambda
+            ;; BOZO this should not be named `forcing` since there are no hyps
+            (%disable default forcing-logic.termp-of-logic.lambda)
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove forcing-logic.lambda-formals-of-logic.substitute
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove forcing-logic.lambda-body-of-logic.substitute
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
+(%autoprove forcing-logic.lambda-actuals-of-logic.substitute
+            (%restrict default definition-of-logic.substitute (equal x 'x)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,48 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-1-sigmap")
+(include-book "substitute-term-1-sigma-atblp")
+(include-book "substitute-term-1-substitute")
+(%interactive)
+
+
+(%autoprove forcing-logic.substitute-under-iff
+            (%restrict default definition-of-logic.substitute (equal x 'term)))
+
+(%autoprove logic.substitute-list-of-repeat
+            (%dec-induction n)
+            (%restrict default repeat (equal n 'n)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-all-bound.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-all-bound.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-all-bound.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-all-bound.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-1")
+(%interactive)
+
+(%autoprove lemma-for-logic.substitute-of-logic.substitute-when-all-bound
+            (%logic.term-induction flag x)
+            (%disable default implies)
+            (%auto)
+            (%enable default implies))
+
+(%autoprove logic.substitute-of-logic.substitute-when-all-bound
+            (%use (%instance (%thm lemma-for-logic.substitute-of-logic.substitute-when-all-bound) (flag 'term))))
+
+(%autoprove logic.substitute-list-of-logic.substitute-list-when-all-bound
+            (%use (%instance (%thm lemma-for-logic.substitute-of-logic.substitute-when-all-bound) (flag 'list))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-empty-sigma.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-empty-sigma.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-empty-sigma.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-empty-sigma.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-1")
+(%interactive)
+
+
+(%autoprove lemma-for-forcing-logic.substitute-of-empty-sigma
+            (%logic.term-induction flag x)
+            (%auto :strategy (cleanup split urewrite)))
+
+(%autoprove forcing-logic.substitute-of-empty-sigma
+            (%use (%instance (%thm lemma-for-forcing-logic.substitute-of-empty-sigma) (flag 'term))))
+
+(%autoprove forcing-logic.substitute-list-of-empty-sigma
+            (%use (%instance (%thm lemma-for-forcing-logic.substitute-of-empty-sigma) (flag 'list))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-list-list.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-list-list.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-list-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-list-list.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-1")
+(%interactive)
+
+(%defprojection :list (logic.substitute-list-list x sigma)
+                :element (logic.substitute-list x sigma)
+                :nil-preservingp t)
+
+(%autoprove strip-lens-of-logic.substitute-list-list
+            (%cdr-induction x))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-pair-lists.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-pair-lists.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-pair-lists.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-pair-lists.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,50 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-1")
+(%interactive)
+
+(%autoprove lemma-for-logic.substitute-list-of-vars-with-pair-lists
+            (%use (%instance (%thm prefixp-badguy-index-property)
+                             (x (logic.substitute-list vars (pair-lists vars vals)))
+                             (y vals))))
+
+(%autoprove logic.substitute-list-of-vars-with-pair-lists
+            (%enable default lemma-for-logic.substitute-list-of-vars-with-pair-lists)
+            ;; BOZO the ACL2 proof doesn't have this use hint; do we really need it?
+            (%use (%instance (%thm same-length-prefixes-equal-cheap)
+                             (x (logic.substitute-list vars (pair-lists vars vals)))
+                             (y (list-fix vals)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-submapp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-submapp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-submapp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-submapp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-1")
+(%interactive)
+
+(%autoprove lemma-for-equal-of-logic.substitutes-of-expansion
+            (%logic.term-induction flag x))
+
+(%autoprove equal-of-logic.substitutes-of-expansion
+            (%use (%instance (%thm lemma-for-equal-of-logic.substitutes-of-expansion) (flag 'term))))
+
+(%autoprove equal-of-logic.substitute-lists-of-expansion
+            (%use (%instance (%thm lemma-for-equal-of-logic.substitutes-of-expansion) (flag 'list))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-term-atblp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-term-atblp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-term-atblp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-term-atblp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,54 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-1")
+(%interactive)
+
+
+(%autoprove lemma-for-forcing-logic.term-atblp-of-logic.substitute
+            (%logic.term-induction flag x)
+            (%auto)
+            ;; BOZO yuck, why is this broken and how can we fix it?
+            ;; Hey, is this one of those rules that we were supposed to
+            ;; force both hyps on, but didn't?  I think we complained
+            ;; about a couple back in terms.lisp.  Go check!
+            (%use (%thm forcing-logic.term-atblp-of-logic.lambda-body)))
+
+(%autoprove forcing-logic.term-atblp-of-logic.substitute
+            (%use (%instance (%thm lemma-for-forcing-logic.term-atblp-of-logic.substitute) (flag 'term))))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.substitute-list
+            (%use (%instance (%thm lemma-for-forcing-logic.term-atblp-of-logic.substitute) (flag 'list))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-termp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-termp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term-2-termp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term-2-termp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,52 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-1")
+(%interactive)
+
+
+(%autoprove lemma-for-forcing-logic.termp-of-logic.substitute
+            (%logic.term-induction flag x)
+            (%auto)
+            ;; BOZO yuck, what's going on here?  We shouldn't have to write
+            ;; this hint.
+            (%use (%thm FORCING-LOGIC.TERMP-OF-LOGIC.LAMBDA-BODY)))
+
+(%autoprove forcing-logic.termp-of-logic.substitute
+            (%use (%instance (%thm lemma-for-forcing-logic.termp-of-logic.substitute) (flag 'term))))
+
+(%autoprove forcing-logic.term-listp-of-logic.substitute-list
+            (%use (%instance (%thm lemma-for-forcing-logic.termp-of-logic.substitute) (flag 'list))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/substitute-term.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/substitute-term.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term-2-termp")
+(include-book "substitute-term-2-term-atblp")
+(include-book "substitute-term-2-empty-sigma")
+(include-book "substitute-term-2-submapp")
+(include-book "substitute-term-2-all-bound")
+(include-book "substitute-term-2-pair-lists")
+(include-book "substitute-term-2-list-list")
+(%interactive)
+
+(%ensure-exactly-these-rules-are-missing "../../logic/substitute-term")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/subtermp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/subtermp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/subtermp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/subtermp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,171 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+
+
+(%autoadmit logic.flag-subtermp)
+(%autoadmit logic.subtermp)
+(%autoadmit logic.subterm-of-somep)
+
+
+(%autoprove definition-of-logic.subtermp
+            (%enable default logic.subtermp logic.subterm-of-somep)
+            (%restrict default logic.flag-subtermp (equal y 'y)))
+
+(%autoprove definition-of-logic.subterm-of-somep
+            (%enable default logic.subtermp logic.subterm-of-somep)
+            (%restrict default logic.flag-subtermp (equal y 'y)))
+
+(%autoprove logic.subterm-of-somep-when-not-consp
+            (%restrict default definition-of-logic.subterm-of-somep (equal y 'x)))
+
+(%autoprove logic.subterm-of-somep-of-cons
+            (%restrict default definition-of-logic.subterm-of-somep (equal y '(cons b y))))
+
+(%autoprove lemma-for-booleanp-of-logic.subtermp
+            (%logic.term-induction flag y)
+            (%restrict default definition-of-logic.subtermp (equal y 'y))
+            (%disable default
+                      forcing-true-listp-of-logic.function-args
+                      forcing-true-listp-of-logic.lambda-actuals))
+
+
+(%autoprove booleanp-of-logic.subtermp
+            (%use (%instance (%thm lemma-for-booleanp-of-logic.subtermp)
+                             (flag 'term))))
+
+(%autoprove booleanp-of-logic.subterm-of-somep
+            (%use (%instance (%thm lemma-for-booleanp-of-logic.subtermp)
+                             (flag 'list))))
+
+
+(%autoprove logic.subterm-of-somep-when-memberp-is-logic.subtermp
+            (%cdr-induction x))
+
+(%autoprove logic.subterm-of-somep-when-memberp-is-logic.subtermp-alt)
+
+(%autoprove logic.subtermp-is-reflexive
+            (%restrict default definition-of-logic.subtermp (equal x 'x)))
+
+(%autoprove lemma-for-logic.subtermp-is-transitive
+            (%logic.term-induction flag z)
+            (%disable default
+                      forcing-true-listp-of-logic.function-args
+                      forcing-true-listp-of-logic.lambda-actuals)
+            (%auto)
+            (%restrict default definition-of-logic.subtermp (memberp y '(y z)))
+            ;; strategy reduces from 650M to 200M
+            (%auto :strategy (cleanup split crewrite elim)))
+
+(%autoprove logic.subtermp-is-transitive
+            (%use (%instance (%thm lemma-for-logic.subtermp-is-transitive)
+                             (flag 'term))))
+
+(%autoprove logic.subtermp-is-transitive-two)
+
+(%autoprove logic.subterm-of-somep-when-logic.subtermp-and-logic.subterm-of-somep
+            (%use (%instance (%thm lemma-for-logic.subtermp-is-transitive)
+                             (flag 'list))))
+
+(%autoprove logic.subterm-of-somep-when-logic.subtermp-and-logic.subterm-of-somep-alt)
+
+
+
+(%autoprove lemma-for-rank-when-logic.subtermp-weak
+            (%logic.term-induction flag y)
+            (%disable default
+                      forcing-true-listp-of-logic.function-args
+                      forcing-true-listp-of-logic.lambda-actuals)
+            (%auto)
+            (%restrict default definition-of-logic.subtermp (equal y 'y)))
+
+(%autoprove rank-when-logic.subtermp-weak
+            (%use (%instance (%thm lemma-for-rank-when-logic.subtermp-weak)
+                             (flag 'term))))
+
+(%autoprove rank-when-logic.subterm-of-somep
+            (%use (%instance (%thm lemma-for-rank-when-logic.subtermp-weak)
+                             (flag 'list))))
+
+(%autoprove rank-when-logic.subterm-of-somep-weak)
+
+(%autoprove rank-when-logic.subtermp
+            (%restrict default definition-of-logic.subtermp (equal y 'y))
+            (%auto)
+            (%disable default rank-when-logic.subterm-of-somep)
+            (%use (%instance (%thm rank-when-logic.subterm-of-somep) (x x) (y (logic.function-args y))))
+            (%auto)
+            (%use (%instance (%thm rank-when-logic.subterm-of-somep) (x x) (y (logic.lambda-actuals y)))))
+
+(%autoprove logic.subtermp-is-weakly-antisymmetric
+            (%disable default rank-when-logic.subtermp)
+            (%use (%instance (%thm rank-when-logic.subtermp))))
+
+(%autoprove logic.subtermp-of-logic.functionp
+            (%restrict default definition-of-logic.subtermp (equal y '(logic.function fn args))))
+
+(%autoprove logic.subtermp-of-logic.lambda
+            (%restrict default definition-of-logic.subtermp (equal y '(logic.lambda xs b ts))))
+
+(%autoprove logic.subterm-of-somep-of-list-fix (%cdr-induction x))
+(%autoprove logic.subterm-of-somep-of-app      (%cdr-induction x))
+(%autoprove logic.subterm-of-somep-of-rev      (%cdr-induction x))
+
+
+
+
+(%deflist logic.all-subterm-of-somep (x others)
+          (logic.subterm-of-somep x others))
+
+(%autoprove logic.all-subterm-of-somep-when-not-consp-two (%cdr-induction x))
+(%autoprove logic.all-subterm-of-somep-of-cons-two        (%cdr-induction x))
+(%autoprove logic.all-subterm-of-somep-of-list-fix-two    (%cdr-induction x))
+(%autoprove logic.all-subterm-of-somep-of-app-two         (%cdr-induction x))
+(%autoprove logic.all-subterm-of-somep-of-app-two-alt     (%cdr-induction x))
+(%autoprove logic.all-subterm-of-somep-of-rev-two         (%cdr-induction x))
+(%autoprove logic.all-subterm-of-somep-is-reflexive       (%cdr-induction x))
+
+(%autoprove logic.subterm-of-somep-when-subterm-and-logic.all-subterm-of-somep (%cdr-induction x))
+(%autoprove logic.subterm-of-somep-when-subterm-and-logic.all-subterm-of-somep-alt)
+
+(%autoprove logic.all-subterm-of-somep-is-transitive (%cdr-induction x))
+(%autoprove logic.all-subterm-of-somep-is-transitive-alt)
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/subtermp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/logic/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/symmetry	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/logic-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-formula.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-formula.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-formula.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-formula.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,113 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-formula")
+(%interactive)
+
+
+(%autoadmit logic.term-formula)
+
+(%autoprove forcing-logic.formulap-of-logic.term-formula
+            (%enable default logic.term-formula))
+
+(%autoprove forcing-logic.formula-atblp-of-logic.term-formula
+            (%enable default logic.term-formula))
+
+(%autoprove logic.substitute-formula-of-logic.term-formula
+            (%enable default logic.term-formula))
+
+
+
+(%defprojection :list (logic.term-list-formulas x)
+                :element (logic.term-formula x))
+
+(%autoprove redefinition-of-logic.term-list-formulas
+            (%cdr-induction x)
+            (%enable default logic.term-formula))
+
+(%autoprove forcing-logic.formula-listp-of-logic.term-list-formulas
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-atblp-of-logic.term-list-formulas
+            (%cdr-induction x))
+
+(%autoprove memberp-of-logic.term-formula-and-logic.term-list-formulas
+            (%cdr-induction x)
+            (%enable default logic.term-formula))
+
+(%autoprove memberp-of-logic.pnot-of-logic.pequal-nil-in-logic.term-list-formulas
+            (%cdr-induction x)
+            (%enable default logic.term-formula))
+
+(%autoprove subsetp-of-logic.term-list-formulas-and-logic.term-list-formulas
+            (%cdr-induction x))
+
+(%autoprove logic.substitute-formula-list-of-logic.term-list-formulas
+            (%cdr-induction x))
+
+
+
+
+(%defprojection :list (logic.term-list-list-formulas x)
+                :element (logic.term-list-formulas x))
+
+(%autoprove forcing-logic.formula-list-listp-of-logic.term-list-list-formulas
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.formula-list-list-atblp-of-logic.term-list-list-formulas
+            (%cdr-induction x))
+
+(%autoprove cons-listp-of-logic.term-list-list-formulas
+            (%cdr-induction x))
+
+(%autoprove supserset-of-somep-of-logic.term-list-formulas-and-logic.term-list-list-formulas
+            (%cdr-induction x))
+
+(%autoprove all-superset-of-somep-of-logic.term-list-list-formulas
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-list-formulas-of-list-list-fix
+            (%cdr-induction x))
+
+(%autoprove logic.substitute-formula-list-list-of-logic.term-list-list-formulas
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-list-formulas-of-listify-each
+            (%cdr-induction x)
+            (%enable default logic.term-formula))
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/term-formula")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-order-consts.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-order-consts.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-order-consts.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-order-consts.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,216 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+
+(%autoadmit logic.fast-constant-size)
+
+;; (defsection logic.fast-constant-size
+;;   ;; BOZO make autoadmit respect :export and switch to autoadmit
+;;   (%defun logic.fast-constant-size (x acc)
+;;           (cond ((symbolp x) (+ 1 acc))
+;;                 ((natp x) (+ x acc))
+;;                 (t (logic.fast-constant-size (cdr x) (logic.fast-constant-size (car x) (+ 1 acc)))))
+;;           :measure (rank x))
+;;   (%auto)
+;;   (%admit))
+
+(defmacro %logic.fast-constant-size-induction (x acc)
+  `(%induct (rank ,x)
+            ((symbolp ,x) nil)
+            ((natp ,x) nil)
+            ((consp ,x)
+             (((x (car ,x)) (acc (+ 1 ,acc)))
+              ((x (cdr ,x)) (acc (logic.fast-constant-size (car ,x) (+ 1 ,acc))))))))
+
+(%autoprove forcing-natp-of-logic.fast-constant-size
+            (%logic.fast-constant-size-induction x acc)
+            (%restrict default logic.fast-constant-size (equal x 'x)))
+
+(%autoadmit logic.constant-size)
+
+(%autoadmit logic.slow-constant-size)
+
+;; (defsection logic.slow-constant-size
+;;   ;; BOZO make autoadmit respect :export and switch to autoadmit
+;;   (%defun logic.slow-constant-size (x)
+;;           (cond ((symbolp x) 1)
+;;                 ((natp x) x)
+;;                 (t (+ 1 (+ (logic.slow-constant-size (car x))
+;;                            (logic.slow-constant-size (cdr x))))))
+;;           :measure (rank x))
+;;   (%auto)
+;;   (%admit))
+
+(%autoprove natp-of-logic.slow-constant-size
+            (%car-cdr-induction x)
+            (%restrict default logic.slow-constant-size (equal x 'x)))
+
+(%autoprove lemma-for-definition-of-logic.constant-size
+            (%logic.fast-constant-size-induction x acc)
+            (%restrict default logic.fast-constant-size (equal x 'x))
+            (%restrict default logic.slow-constant-size (equal x 'x))
+            (%auto)
+            (%fertilize (logic.fast-constant-size x1 (+ '1 acc))
+                        (+ '1 (+ acc (logic.slow-constant-size x1)))))
+
+(defsection definition-of-logic.constant-size
+  ;; NOTE: This defsection is okay and we don't want to replace it with autoprove.
+  ;; The ACL2-version of this rule includes a special compatibility hack for bad
+  ;; objects, and we don't need it for our Milawa rule.
+  (%prove (%rule definition-of-logic.constant-size
+                 :lhs (logic.constant-size x)
+                 :rhs (cond ((symbolp x) 1)
+                            ((natp x) x)
+                            (t
+                             (+ 1 (+ (logic.constant-size (car x))
+                                     (logic.constant-size (cdr x))))))))
+  (local (%enable default logic.constant-size))
+  (local (%restrict default logic.slow-constant-size (equal x 'x)))
+  (local (%enable default lemma-for-definition-of-logic.constant-size))
+  (%auto)
+  (%qed))
+
+(%autoprove forcing-fast-constant-size-removal
+            (%enable default logic.constant-size lemma-for-definition-of-logic.constant-size))
+
+(%autoprove natp-of-logic.constant-size
+            (%car-cdr-induction x)
+            (%restrict default definition-of-logic.constant-size (equal x 'x)))
+
+
+
+
+(%autoadmit logic.flag-count-constant-sizes)
+(%autoadmit logic.count-constant-sizes)
+(%autoadmit logic.count-constant-sizes-list)
+(%autoadmit logic.slow-count-constant-sizes)
+
+(defmacro %logic.flag-count-constant-sizes-induction (flag x acc)
+  `(%induct (rank ,x)
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+            ((and (equal flag 'term)
+                  (logic.variablep ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x))
+             (((,flag 'list)
+               (,x    (logic.function-args ,x))
+               (,acc  ,acc))))
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+             (((,flag 'list)
+               (,x    (logic.lambda-actuals ,x))
+               (,acc  ,acc))))
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term)
+               (,x (car ,x))
+               (acc ,acc))
+              ((,flag 'list)
+               (,x (cdr ,x))
+               (,acc (logic.flag-count-constant-sizes 'term (car ,x) ,acc)))))))
+
+(%autoprove forcing-natp-of-logic.flag-count-constant-sizes
+            (%logic.flag-count-constant-sizes-induction flag x acc)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default logic.flag-count-constant-sizes (equal x 'x)))
+
+(%autoprove natp-of-logic.slow-count-constant-sizes
+            (%logic.term-induction flag x)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default logic.slow-count-constant-sizes (equal x 'x)))
+
+(%autoprove lemma-forcing-logic.flag-count-constant-sizes-removal
+            (%logic.flag-count-constant-sizes-induction flag x acc)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default logic.flag-count-constant-sizes (equal x 'x))
+            (%restrict default logic.slow-count-constant-sizes (equal x 'x))
+            (%auto)
+            (%fertilize (logic.flag-count-constant-sizes 'term x1 acc)
+                        (+ acc (logic.slow-count-constant-sizes 'term x1))))
+
+(%autoprove definition-of-logic.count-constant-sizes
+            (%enable default logic.count-constant-sizes
+                     logic.count-constant-sizes-list
+                     lemma-forcing-logic.flag-count-constant-sizes-removal
+                     )
+            (%restrict default logic.slow-count-constant-sizes (equal x 'x)))
+
+(%autoprove definition-of-logic.count-constant-sizes-list
+            (%enable default logic.count-constant-sizes
+                     logic.count-constant-sizes-list
+                     lemma-forcing-logic.flag-count-constant-sizes-removal
+                     )
+            (%restrict default logic.slow-count-constant-sizes (equal x 'x)))
+
+(%autoprove logic.flag-count-constant-sizes-removal
+            (%enable default lemma-forcing-logic.flag-count-constant-sizes-removal
+                             logic.count-constant-sizes
+                             logic.count-constant-sizes-list)
+            (%restrict default logic.slow-count-constant-sizes (equal x 'x)))
+
+(%autoprove logic.count-constant-sizes-list-when-not-consp
+            (%restrict default definition-of-logic.count-constant-sizes-list (equal x 'x)))
+
+(%autoprove logic.count-constant-sizes-list-of-cons
+            (%restrict default definition-of-logic.count-constant-sizes-list (equal x '(cons a x))))
+
+(%autoprove lemma-for-natp-of-logic.count-constant-sizes
+            (%logic.term-induction flag x)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default definition-of-logic.count-constant-sizes (equal x 'x)))
+
+(%autoprove natp-of-logic.count-constant-sizes
+            (%use (%instance (%thm lemma-for-natp-of-logic.count-constant-sizes)
+                             (flag 'term))))
+
+(%autoprove natp-of-logic.count-constant-sizes-list
+            (%use (%instance (%thm lemma-for-natp-of-logic.count-constant-sizes)
+                             (flag 'list))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-order-fns.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-order-fns.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-order-fns.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-order-fns.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,144 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+
+(%autoadmit logic.flag-count-function-occurrences)
+(%autoadmit logic.count-function-occurrences)
+(%autoadmit logic.count-function-occurrences-list)
+(%autoadmit logic.slow-count-function-occurrences)
+
+(defmacro %logic.flag-count-function-occurrences-induction (flag x acc)
+  `(%induct (rank ,x)
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+            ((and (equal flag 'term)
+                  (logic.variablep ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x))
+             (((,flag 'list)
+               (,x    (logic.function-args ,x))
+               (,acc  (+ 1 ,acc)))))
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+             (((,flag 'list)
+               (,x    (logic.lambda-actuals ,x))
+               (,acc  (+ 1 ,acc)))))
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term)
+               (,x (car ,x))
+               (acc ,acc))
+              ((,flag 'list)
+               (,x (cdr ,x))
+               (,acc (logic.flag-count-function-occurrences 'term (car ,x) ,acc)))))))
+
+(%autoprove forcing-natp-of-logic.flag-count-function-occurrences
+            (%logic.flag-count-function-occurrences-induction flag x acc)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default logic.flag-count-function-occurrences (equal x 'x)))
+
+(%autoprove lemma-forcing-logic.flag-count-function-occurrences-removal
+            (%logic.flag-count-function-occurrences-induction flag x acc)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default logic.flag-count-function-occurrences (equal x 'x))
+            (%restrict default logic.slow-count-function-occurrences (equal x 'x))
+            (%auto)
+            (%fertilize (logic.flag-count-function-occurrences 'term x1 acc)
+                        (+ acc (logic.slow-count-function-occurrences 'term x1))))
+
+(%autoprove definition-of-logic.count-function-occurrences
+            (%restrict default logic.slow-count-function-occurrences (equal x 'x))
+            (%enable default
+                     logic.count-function-occurrences
+                     logic.count-function-occurrences-list
+                     lemma-forcing-logic.flag-count-function-occurrences-removal
+                     ))
+
+(%autoprove definition-of-logic.count-function-occurrences-list
+            (%restrict default logic.slow-count-function-occurrences (equal x 'x))
+            (%enable default
+                     logic.count-function-occurrences
+                     logic.count-function-occurrences-list
+                     lemma-forcing-logic.flag-count-function-occurrences-removal
+                     ))
+
+(%autoprove logic.flag-count-function-occurrences-removal
+            (%restrict default logic.slow-count-function-occurrences (equal x 'x))
+            (%enable default
+                     lemma-forcing-logic.flag-count-function-occurrences-removal
+                     logic.count-function-occurrences
+                     logic.count-function-occurrences-list))
+
+(%autoprove logic.count-function-occurrences-list-when-not-consp
+            (%restrict default definition-of-logic.count-function-occurrences-list (equal x 'x)))
+
+(%autoprove logic.count-function-occurrences-list-of-cons
+            (%restrict default definition-of-logic.count-function-occurrences-list (equal x '(cons a x))))
+
+
+(%autoprove lemma-for-natp-of-logic.count-function-occurrences
+            (%logic.term-induction flag x)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default definition-of-logic.count-function-occurrences (equal x 'x)))
+
+(%autoprove natp-of-logic.count-function-occurrences
+            (%use (%instance (%thm lemma-for-natp-of-logic.count-function-occurrences) (flag 'term))))
+
+(%autoprove natp-of-logic.count-function-occurrences-list
+            (%use (%instance (%thm lemma-for-natp-of-logic.count-function-occurrences) (flag 'list))))
+
+(%autoprove logic.count-function-occurrences-when-logic.constantp
+            (%restrict default definition-of-logic.count-function-occurrences (equal x 'x)))
+
+(%autoprove logic.count-function-occurrences-positive-when-logic.functionp
+            (%restrict default definition-of-logic.count-function-occurrences (equal x 'x)))
+
+(%autoprove logic.count-function-occurrences-positive-when-logic.lambdap
+            (%restrict default definition-of-logic.count-function-occurrences (equal x 'x)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-order-vars.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-order-vars.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-order-vars.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-order-vars.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,140 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(%interactive)
+
+(%autoadmit logic.flag-count-variable-occurrences)
+(%autoadmit logic.count-variable-occurrences)
+(%autoadmit logic.count-variable-occurrences-list)
+(%autoadmit logic.slow-count-variable-occurrences)
+
+(defmacro %logic.flag-count-variable-occurrences-induction (flag x acc)
+  `(%induct (rank ,x)
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+            ((and (equal flag 'term)
+                  (logic.variablep ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x))
+             (((,flag 'list)
+               (,x    (logic.function-args ,x))
+               (,acc  ,acc))))
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+             (((,flag 'list)
+               (,x    (logic.lambda-actuals ,x))
+               (,acc  ,acc))))
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term)
+               (,x (car ,x))
+               (acc ,acc))
+              ((,flag 'list)
+               (,x (cdr ,x))
+               (,acc (logic.flag-count-variable-occurrences 'term (car ,x) ,acc)))))))
+
+(%autoprove forcing-natp-of-logic.flag-count-variable-occurrences
+            (%logic.flag-count-variable-occurrences-induction flag x acc)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default logic.flag-count-variable-occurrences (equal x 'x)))
+
+(%autoprove lemma-logic.flag-count-variable-occurrences-removal
+            (%logic.flag-count-variable-occurrences-induction flag x acc)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default logic.flag-count-variable-occurrences (equal x 'x))
+            (%restrict default logic.slow-count-variable-occurrences (equal x 'x))
+            (%auto)
+            (%fertilize (logic.flag-count-variable-occurrences 'term x1 acc)
+                        (+ acc (logic.slow-count-variable-occurrences 'term x1))))
+
+(%autoprove definition-of-logic.count-variable-occurrences
+            (%restrict default logic.slow-count-variable-occurrences (equal x 'x))
+            (%enable default
+                     logic.count-variable-occurrences
+                     logic.count-variable-occurrences-list
+                     lemma-logic.flag-count-variable-occurrences-removal
+                     ))
+
+(%autoprove definition-of-logic.count-variable-occurrences-list
+            (%restrict default logic.slow-count-variable-occurrences (equal x 'x))
+            (%enable default
+                     logic.count-variable-occurrences
+                     logic.count-variable-occurrences-list
+                     lemma-logic.flag-count-variable-occurrences-removal))
+
+(%autoprove logic.flag-count-variable-occurrences-removal
+            (%restrict default logic.slow-count-variable-occurrences (equal x 'x))
+            (%enable default
+                     logic.count-variable-occurrences
+                     logic.count-variable-occurrences-list
+                     lemma-logic.flag-count-variable-occurrences-removal))
+
+(%autoprove logic.count-variables-occurrences-list-when-not-consp
+            (%restrict default definition-of-logic.count-variable-occurrences-list (equal x 'x)))
+
+(%autoprove logic.count-variables-occurrences-list-of-cons
+            (%restrict default definition-of-logic.count-variable-occurrences-list (equal x '(cons a x))))
+
+
+(%autoprove lemma-for-natp-of-logic.count-variable-occurrences
+            (%logic.term-induction flag x)
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default definition-of-logic.count-variable-occurrences (equal x 'x)))
+
+(%autoprove natp-of-logic.count-variable-occurrences
+            (%use (%instance (%thm lemma-for-natp-of-logic.count-variable-occurrences)
+                             (flag 'term))))
+
+(%autoprove natp-of-logic.count-variable-occurrences-list
+            (%use (%instance (%thm lemma-for-natp-of-logic.count-variable-occurrences)
+                             (flag 'list))))
+
+(%autoprove logic.count-variable-occurrences-when-logic.constantp
+            (%restrict default definition-of-logic.count-variable-occurrences (equal x 'x)))
+
+(%autoprove logic.count-variable-occurrences-when-logic.variablep
+            (%restrict default definition-of-logic.count-variable-occurrences (equal x 'x)))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-order.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-order.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/term-order.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/term-order.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,186 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "term-order-vars")
+(include-book "term-order-fns")
+(include-book "term-order-consts")
+(%interactive)
+
+
+(%autoadmit logic.flag-count-term-sizes)
+
+(%autoprove natp-of-car-of-logic.flag-count-term-sizes
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x)))
+
+(%autoprove natp-of-cdar-of-logic.flag-count-term-sizes
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x)))
+
+(%autoprove natp-of-cddr-of-logic.flag-count-term-sizes
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x)))
+
+(%autoprove car-of-logic.flag-count-term-sizes
+            (%forcingp nil)
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x))
+            (%restrict default logic.flag-count-variable-occurrences (equal x 'x)))
+
+(%autoprove cadr-of-logic.flag-count-term-sizes
+            (%forcingp nil)
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x))
+            (%restrict default logic.flag-count-function-occurrences (equal x 'x)))
+
+(%autoprove cddr-of-logic.flag-count-term-sizes
+            (%forcingp nil)
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x))
+            (%restrict default logic.flag-count-constant-sizes (equal x 'x)))
+
+(%autoprove consp-of-logic.flag-count-term-sizes-1
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x)))
+
+(%autoprove consp-of-logic.flag-count-term-sizes-2
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x)))
+
+(%autoprove consp-of-logic.flag-count-term-sizes-3
+            (%autoinduct logic.flag-count-term-sizes)
+            (%restrict default logic.flag-count-term-sizes (equal x 'x)))
+
+(%autoadmit logic.count-term-sizes)
+
+(%autoprove definition-of-logic.count-term-sizes
+            (%enable default
+                     logic.count-term-sizes
+                     consp-of-logic.flag-count-term-sizes-1
+                     consp-of-logic.flag-count-term-sizes-2
+                     consp-of-logic.flag-count-term-sizes-3))
+
+(%autoadmit logic.term-<)
+
+(%autoprove definition-of-logic.term-<
+            (%enable default
+                     logic.term-<
+                     logic.count-term-sizes))
+
+(%autoprove booleanp-of-logic.term-<
+            (%enable default definition-of-logic.term-<))
+
+(%autoprove irreflexivity-of-logic.term-<
+            (%enable default definition-of-logic.term-<))
+
+(%autoprove antisymmetry-of-logic.term-<
+            (%enable default definition-of-logic.term-<))
+
+(%autoprove transitivity-of-logic.term-<
+            (%enable default definition-of-logic.term-<))
+
+(%autoprove trichotomy-of-logic.term-<
+            (%enable default definition-of-logic.term-<))
+
+(%autoprove transitivity-of-logic.term-<-two
+            (%disable default trichotomy-of-logic.term-<)
+            (%use (%instance (%thm trichotomy-of-logic.term-<)
+                             (x y)
+                             (y z))))
+
+(%autoprove forcing-transitivity-of-logic.term-<-three)
+(%autoprove forcing-transitivity-of-logic.term-<-four)
+
+(%autoprove forcing-minimality-of-constants-under-logic.term-<
+            (%enable default definition-of-logic.term-<)
+            (%auto)
+            ;; We don't have a :cases hint, but this eqsubst is a sneaky way of
+            ;; emulating it.  We replace (logic.constantp y) into this big if
+            ;; expression that introduces the cases for y, and then the
+            ;; if-lifting/splitting tactic creates new clauses for these cases.
+            (%eqsubst (logic.termp y)
+                      (logic.constantp y)
+                      (if (logic.variablep y)
+                          'nil
+                        (if (logic.functionp y)
+                            'nil
+                          (if (logic.lambdap y)
+                              'nil
+                            't)))))
+
+
+
+(%deflist logic.all-terms-largerp (b x)
+          (logic.term-< b x))
+
+(%autoprove all-terms-larger-when-all-terms-larger-than-something-bigger
+            (%cdr-induction x))
+
+(%autoprove logic.term-<-when-memberp-of-logic.all-terms-largerp-two)
+
+(%autoprove logic.term-<-when-memberp-of-logic.all-terms-largerp-two-alt)
+
+(%autoprove memberp-when-logic.all-terms-larger-cheap
+            (%cdr-induction x))
+
+
+(%autoadmit logic.all-terms-largerp-badguy)
+
+(%autoprove logic.all-terms-largerp-badguy-when-not-consp
+            (%restrict default logic.all-terms-largerp-badguy (equal x 'x)))
+
+(%autoprove logic.all-terms-largerp-badguy-of-cons
+            (%restrict default logic.all-terms-largerp-badguy (equal x '(cons b x))))
+
+(defsection logic.all-terms-largerp-badguy-membership-property
+  ;; BOZO add to autoprove; we need to change this to rule-classes nil since the
+  ;; dual :rewrite rules screw up autoprove.
+  (%prove (%rule logic.all-terms-largerp-badguy-membership-property
+                 :hyps (list (%hyp (logic.all-terms-largerp-badguy a x)))
+                 :lhs (and (memberp (logic.all-terms-largerp-badguy a x) x)
+                           (not (logic.term-< a (logic.all-terms-largerp-badguy a x))))
+                 :rhs t))
+  (%cdr-induction x)
+  (%auto)
+  (%qed))
+
+(%autoprove logic.all-terms-largerp-when-not-logic.all-terms-largerp-badguy
+            ;; BOZO do we want to switch this rule to target atl-badguy under iff like
+            ;; the subset badguy?
+            (%cdr-induction x))
+
+
+(%ensure-exactly-these-rules-are-missing "../../logic/term-order")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-1.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,99 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(%autoadmit logic.variablep)
+
+(%autoprove booleanp-of-logic.variablep
+            (%enable default logic.variablep))
+
+(%autoprove symbolp-when-logic.variablep
+            (%enable default logic.variablep))
+
+(%autoprove logic.variablep-when-consp
+            (%enable default logic.variablep))
+
+
+
+(%autoadmit logic.constantp)
+
+(%autoprove booleanp-of-logic.constantp
+            (%enable default logic.constantp))
+
+(%autoprove logic.constantp-when-not-consp
+            (%enable default logic.constantp))
+
+(%autoprove logic.constantp-of-list-quote
+            (%enable default logic.constantp))
+
+
+
+(%autoadmit logic.unquote)
+
+(%autoprove logic.unquote-of-list-quote
+            (%enable default logic.unquote))
+
+(%autoprove logic.unquote-under-iff-when-logic.constantp
+            (%enable default logic.constantp logic.unquote))
+
+(%autoprove equal-of-logic.unquote-and-logic.unquote
+            (%enable default logic.constantp logic.unquote)
+            (%restrict default tuplep (memberp n '('2 '1))))
+
+(%autoprove logic.variablep-when-logic.constantp
+            (%enable default logic.variablep logic.constantp))
+
+(%autoprove logic.constantp-when-logic.variablep)
+
+
+(%autoadmit logic.function-namep)
+
+(%autoprove booleanp-of-logic.function-namep
+            (%enable default logic.function-namep))
+
+(%autoprove symbolp-when-logic.function-namep
+            (%enable default logic.function-namep))
+
+(%autoprove logic.function-namep-when-consp
+            (%enable default logic.function-namep))
+
+(%autoprove logic.constantp-when-cons-of-logic.function-namep
+            (%enable default logic.constantp))
+
+(%autoprove logic.variablep-of-cons-when-logic.function-namep
+            (%enable default logic.variablep))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-constant-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-constant-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-constant-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-constant-listp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-1")
+(%interactive)
+
+(%deflist logic.constant-listp (x)
+  (logic.constantp x))
+
+(%autoprove logic.constantp-of-second-when-logic.constant-listp)
+
+(%autoprove logic.constantp-of-third-when-logic.constant-listp)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-function-symbol-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-function-symbol-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-function-symbol-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-function-symbol-listp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,41 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-1")
+(%interactive)
+
+(%deflist logic.function-symbol-listp (x)
+  (logic.function-namep x))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-none-constantp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-none-constantp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-none-constantp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-none-constantp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,42 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-1")
+(%interactive)
+
+(%deflist logic.none-constantp (x)
+  (logic.constantp x)
+  :negatedp t)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-term-vars.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-term-vars.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-term-vars.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-term-vars.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,105 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-1")
+(%interactive)
+
+
+
+(%autoadmit logic.flag-term-vars)
+(%autoadmit logic.slow-term-vars)
+(%autoadmit logic.term-vars)
+(%autoadmit logic.term-list-vars)
+
+(defmacro %logic.flag-term-vars-induction (flag x acc)
+  `(%induct (rank ,x)
+            ((and (equal ,flag 'term)
+                  (or (logic.constantp ,x)
+                      (logic.variablep ,x)
+                      (not (consp ,x))))
+             nil)
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (consp ,x))
+             (((,flag 'list)
+               (,x    (cdr ,x))
+               (,acc  ,acc))))
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term)
+               (,x    (car ,x))
+               (,acc  (logic.flag-term-vars 'list (cdr ,x) ,acc)))
+              ((,flag 'list)
+               (,x    (cdr ,x))
+               (,acc  ,acc))))))
+
+
+
+(%autoprove true-listp-of-logic.flag-term-vars
+            (%restrict default logic.flag-term-vars (equal x 'x))
+            (%logic.flag-term-vars-induction flag x acc)
+            ;; big gains by avoiding urewrite for some reason
+            (%auto :strategy (cleanup split crewrite elim)))
+
+(encapsulate
+ ()
+ (%autoprove lemma-for-definition-of-logic.term-vars
+             (%logic.flag-term-vars-induction flag x acc)
+             (%restrict default logic.flag-term-vars (equal x 'x))
+             (%restrict default logic.slow-term-vars (equal x 'x))
+             (%auto :strategy (cleanup split crewrite elim)))
+
+ (local (%enable default lemma-for-definition-of-logic.term-vars))
+
+ (%autoprove definition-of-logic.term-vars
+             (%enable default logic.term-vars logic.term-list-vars)
+             (%restrict default logic.slow-term-vars (equal x 'x)))
+
+ (%autoprove definition-of-logic.term-list-vars
+             (%enable default logic.term-vars logic.term-list-vars)
+             (%restrict default logic.slow-term-vars (equal x 'x)))
+
+ (%autoprove logic.flag-term-vars-of-term-removal
+             (%enable default logic.term-vars)
+             (%restrict default logic.slow-term-vars (equal x 'x)))
+
+ (%autoprove logic.flag-term-vars-of-list-removal
+             (%enable default logic.term-list-vars)
+             (%restrict default logic.slow-term-vars (equal x 'x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-termp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-termp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-termp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-termp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,119 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-2-term-vars")
+(include-book "terms-2-variable-listp")
+(%interactive)
+
+
+(%autoadmit logic.flag-termp)
+(%autoadmit logic.termp)
+(%autoadmit logic.term-listp)
+
+(defmacro %logic.term-induction (flag x)
+  `(%induct (rank ,x)
+            ((and (equal ,flag 'term)
+                  (logic.constantp ,x))
+             nil)
+            ((and (equal flag 'term)
+                  (logic.variablep ,x))
+             nil)
+            ((and (equal ,flag 'term)
+                  (logic.functionp ,x))
+             (((,flag 'list)
+               (,x    (logic.function-args ,x)))))
+            ((and (equal ,flag 'term)
+                  (logic.lambdap ,x))
+             (((,flag 'term)
+               (,x    (logic.lambda-body ,x)))
+              ((,flag 'list)
+               (,x    (logic.lambda-actuals ,x)))))
+            ((and (equal ,flag 'term)
+                  (not (logic.constantp ,x))
+                  (not (logic.variablep ,x))
+                  (not (logic.functionp ,x))
+                  (not (logic.lambdap ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (not (consp ,x)))
+             nil)
+            ((and (not (equal ,flag 'term))
+                  (consp ,x))
+             (((,flag 'term)
+               (,x    (car ,x)))
+              ((,flag 'list)
+               (,x    (cdr ,x)))))))
+
+(%autoprove definition-of-logic.termp
+            (%enable default logic.termp logic.term-listp)
+            (%restrict default logic.flag-termp (equal x 'x)))
+
+(%autoprove definition-of-logic.term-listp
+            (%enable default logic.termp logic.term-listp)
+            (%restrict default logic.flag-termp (equal x 'x)))
+
+(%autoprove logic.termp-when-not-consp-cheap
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.termp-when-logic.variablep
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.termp-when-logic.constantp
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.term-listp-when-not-consp
+            (%restrict default definition-of-logic.term-listp (equal x 'x)))
+
+(%autoprove logic.term-listp-of-cons
+            (%restrict default definition-of-logic.term-listp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-logic.term-listp
+            (%cdr-induction x))
+
+(%autoprove booleanp-of-logic.termp
+            (%restrict default definition-of-logic.termp (equal x 'x)))
+
+
+(%deflist logic.term-listp (x)
+          (logic.termp x))
+
+(%autoprove first-under-iff-when-logic.term-listp-with-len-free)
+
+(%autoprove second-under-iff-when-logic.term-listp-with-len-free)
+
+(%autoprove third-under-iff-when-logic.term-listp-with-len-free)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-unquote-list.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-unquote-list.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-unquote-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-unquote-list.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,42 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-1")
+(%interactive)
+
+(%defprojection :list (logic.unquote-list x)
+                :element (logic.unquote x)
+                :nil-preservingp t)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-variable-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-variable-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2-variable-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2-variable-listp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-1")
+(%interactive)
+
+(%deflist logic.variable-listp (x)
+  (logic.variablep x))
+
+(%autoprove logic.variable-listp-of-sort-symbols-insert
+            (%cdr-induction x))
+
+(%autoprove logic.variable-listp-of-sort-symbols
+            (%cdr-induction x))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-2.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,51 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-2-constant-listp")
+(include-book "terms-2-variable-listp")
+(include-book "terms-2-none-constantp")
+(include-book "terms-2-unquote-list")
+(include-book "terms-2-function-symbol-listp")
+(include-book "terms-2-term-vars")
+(include-book "terms-2-termp")
+(%interactive)
+
+(%autoprove logic.term-listp-when-logic.constant-listp-cheap
+            (%cdr-induction x))
+
+(%autoprove logic.term-listp-when-logic.variable-listp-cheap
+            (%cdr-induction x))
+
+(%autoprove logic.term-listp-of-sort-symbols-when-logic.variable-listp)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-arity-tablep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-arity-tablep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-arity-tablep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-arity-tablep.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,86 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-2")
+(%interactive)
+
+(%defmap :map (logic.arity-tablep x)
+         :key (logic.function-namep x)
+         :val (natp x)
+         :key-list (logic.function-symbol-listp x)
+         :val-list (nat-listp x)
+         :val-of-nil nil)
+
+(%autoprove logic.arity-tablep-of-halve-list
+            (%disable default
+                      halve-list-correct
+                      [outside]halve-list-correct
+                      logic.arity-tablep-of-list-fix
+                      [outside]logic.arity-tablep-of-list-fix
+                      logic.arity-tablep-of-subset-when-logic.arity-tablep)
+            (%use (%instance (%thm halve-list-correct)))
+            (%use (%instance (%thm logic.arity-tablep-of-list-fix)))
+            (%auto :strategy (cleanup split urewrite))
+            (%fertilize (list-fix x)
+                        (app (rev (car (halve-list x)))
+                             (cdr (halve-list x))))
+            (%auto)
+            (%fertilize (list-fix x)
+                        (app (rev (car (halve-list x)))
+                             (cdr (halve-list x))))
+            (%auto))
+
+(%autoprove logic.arity-tablep-of-halve-list-1
+            (%use (%instance (%thm logic.arity-tablep-of-halve-list))))
+
+(%autoprove logic.arity-tablep-of-halve-list-2
+            (%use (%instance (%thm logic.arity-tablep-of-halve-list))))
+
+(%autoprove logic.arity-tablep-of-merge-maps
+            (%autoinduct merge-maps x y)
+            (%restrict default merge-maps (and (equal x 'x) (equal y 'y)))
+            (%disable default
+                      logic.arity-tablep-of-subset-when-logic.arity-tablep
+                      LOGIC.ARITY-TABLEP-WHEN-NOT-CONSP))
+
+(%autoprove logic.arity-tablep-of-mergesort-map
+            (%autoinduct mergesort-map)
+            (%restrict default mergesort-map (equal x 'x))
+            (%disable default
+                      logic.arity-tablep-of-subset-when-logic.arity-tablep
+                      LOGIC.ARITY-TABLEP-WHEN-NOT-CONSP
+                      MERGESORT-MAP-WHEN-NOT-CONSP-OF-CDR
+                      MERGESORT-MAP-WHEN-NOT-CONSP
+                      ))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-functionp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-functionp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-functionp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-functionp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,172 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-2")
+(%interactive)
+
+
+(%autoadmit logic.functionp)
+(%autoadmit logic.function)
+(%autoadmit logic.function-name)
+(%autoadmit logic.function-args)
+
+(%noexec logic.function)
+
+(%autoprove booleanp-of-logic.functionp
+            (%enable default logic.functionp))
+
+(%autoprove consp-when-logic.functionp-cheap
+            (%enable default logic.functionp))
+
+(%autoprove logic.variablep-when-logic.functionp
+            (%enable default logic.functionp))
+
+(%autoprove logic.constantp-when-logic.functionp
+            (%enable default logic.functionp))
+
+(%autoprove consp-of-logic.function
+            (%enable default logic.function))
+
+(%autoprove logic.function-under-iff
+            (%enable default logic.function))
+
+(%autoprove forcing-logic.constantp-of-logic.function
+            (%enable default logic.function))
+
+(%autoprove forcing-logic.variablep-of-logic.function
+            (%enable default logic.function))
+
+(%autoprove forcing-logic.termp-of-logic.function
+            (%enable default logic.function)
+            (%restrict default definition-of-logic.termp (equal x '(cons name args)))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-logic.functionp-of-logic.function
+            (%enable default logic.functionp logic.function))
+
+(%autoprove forcing-logic.function-namep-of-logic.function-name
+            (%enable default logic.functionp logic.function-name))
+
+(%autoprove logic.function-name-of-logic.function
+            (%enable default logic.function-name logic.function))
+
+(%autoprove forcing-true-listp-of-logic.function-args
+            (%enable default logic.functionp logic.function-args)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-logic.term-listp-of-logic.function-args
+            (%enable default logic.functionp logic.function-args)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.function-args-of-logic.function
+            (%enable default logic.function-args logic.function))
+
+(%autoprove forcing-logic.function-of-logic.function-name-and-logic.function-args
+            (%enable default logic.functionp logic.function logic.function-name logic.function-args))
+
+(%autoprove logic.function-of-logic.function-name-and-nil-when-nil-logic.function-args
+            (%enable default logic.functionp logic.function-name logic.function logic.function-args))
+
+(%autoprove forcing-logic.function-of-logic.function-name-and-logic.function-args-free)
+
+(%autoprove rank-of-logic.function-args
+            (%enable default logic.function-args))
+
+(%autoprove rank-of-first-of-logic.function-args
+            (%enable default logic.function-args))
+
+(%autoprove rank-of-second-of-logic.function-args
+            (%enable default logic.function-args))
+
+(%autoprove rank-of-third-of-logic.function-args
+            (%enable default logic.function-args))
+
+(%autoprove equal-of-logic.function-rewrite
+            (%enable default logic.function logic.functionp logic.function-name logic.function-args))
+
+
+(defthm equal-of-logic.function-rewrite-alt
+  ;; bozo add this to acl2
+  (implies (force (logic.function-namep name))
+           (equal (equal x (logic.function name args))
+                  (and (logic.functionp x)
+                       (equal (logic.function-name x) name)
+                       (equal (logic.function-args x) args))))
+  :hints(("goal" :use ((:instance equal-of-logic.function-rewrite)))))
+
+(%autoprove equal-of-logic.function-rewrite-alt
+            (%use (%instance (%thm equal-of-logic.function-rewrite))))
+
+(%autoprove equal-of-logic.function-and-logic.function
+            (%enable default logic.function))
+
+(%autoprove logic.function-args-under-iff-with-len-free)
+
+
+
+(%autoprove forcing-equal-of-logic.function-with-two-args)
+
+(defthm forcing-equal-of-logic.function-with-two-args-alt
+  (implies (and (equal (len (logic.function-args x)) 2)
+                (force (logic.termp x))
+                (force (logic.functionp x)))
+           (equal (equal x (logic.function name (list a b)))
+                  (and (equal name (logic.function-name x))
+                       (equal a (first (logic.function-args x)))
+                       (equal b (second (logic.function-args x)))))))
+
+(%autoprove forcing-equal-of-logic.function-with-two-args-alt
+            (%use (%thm forcing-equal-of-logic.function-with-two-args)))
+
+
+
+
+(%autoprove forcing-equal-of-logic.function-with-three-args)
+
+(defthm forcing-equal-of-logic.function-with-three-args-alt
+               (implies (and (equal 3 (len (logic.function-args x)))
+                             (force (logic.termp x))
+                             (force (logic.functionp x)))
+                        (equal (equal x (logic.function name (list a b c)))
+                               (and (equal name (logic.function-name x))
+                                    (equal a (first (logic.function-args x)))
+                                    (equal b (second (logic.function-args x)))
+                                    (equal c (third (logic.function-args x)))))))
+
+(%autoprove forcing-equal-of-logic.function-with-three-args-alt
+            (%use (%instance (%thm forcing-equal-of-logic.function-with-three-args))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-lambdap.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-lambdap.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-lambdap.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-lambdap.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,194 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-2")
+(%interactive)
+
+
+(%autoadmit logic.lambdap)
+(%autoadmit logic.lambda)
+(%autoadmit logic.lambda-formals)
+(%autoadmit logic.lambda-body)
+(%autoadmit logic.lambda-actuals)
+
+
+(%autoprove booleanp-of-logic.lambdap
+            (%enable default logic.lambdap))
+
+(%autoprove consp-when-logic.lambdap-cheap
+            (%enable default logic.lambdap))
+
+(%autoprove logic.variablep-when-logic.lambdap-cheap
+            (%enable default logic.lambdap logic.variablep))
+
+(%autoprove logic.constantp-when-logic.lambdap-cheap
+            (%enable default logic.lambdap logic.constantp))
+
+(%noexec logic.lambda)
+
+(%autoprove consp-of-logic.lambda
+            (%enable default logic.lambda))
+
+(%autoprove logic.lambda-under-iff
+            (%enable default logic.lambda))
+
+(%autoprove logic.constantp-of-logic.lambda
+            (%enable default logic.lambda logic.constantp))
+
+(%autoprove logic.variablep-of-logic.lambda
+            (%enable default logic.lambda logic.variablep))
+
+(%autoprove forcing-logic.termp-of-logic.lambda
+            (%enable default logic.lambda)
+            (%restrict default definition-of-logic.termp (equal x '(cons (cons 'lambda (cons formals (cons body 'nil))) actuals)))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.lambdap-of-logic.lambda
+            (%enable default logic.lambdap logic.lambda))
+
+(%autoprove equal-of-logic.lambda-and-logic.lambda
+            (%enable default logic.lambda))
+
+(%autoprove forcing-true-listp-of-logic.lambda-formals
+            (%enable default logic.lambdap logic.lambda-formals)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-logic.variable-listp-of-logic.lambda-formals
+            (%enable default logic.lambdap logic.lambda-formals)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-uniquep-of-logic.lambda-formals
+            (%enable default logic.lambdap logic.lambda-formals)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.lambda-formals-of-logic.lambda
+            (%enable default logic.lambda-formals logic.lambda))
+
+
+
+
+
+(%autoprove forcing-logic.termp-of-logic.lambda-body
+            (%enable default logic.lambdap logic.lambda-body)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.lambda-body-of-logic.lambda
+            (%enable default logic.lambda-body logic.lambda))
+
+(%autoprove rank-of-logic.lambda-body
+            (%enable default logic.lambda-body))
+
+(%autoprove forcing-subsetp-of-logic.term-vars-of-logic.lambda-body-with-logic.lambda-formals
+            (%enable default logic.lambdap logic.lambda-body logic.lambda-formals)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-true-listp-of-logic.lambda-actuals
+            (%enable default logic.lambdap logic.lambda-actuals)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-logic.term-listp-of-logic.lambda-actuals
+            (%enable default logic.lambdap logic.lambda-actuals)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove logic.lambda-actuals-of-logic.lambda
+            (%enable default logic.lambda-actuals logic.lambda))
+
+
+
+
+
+
+(%autoprove forcing-equal-lens-of-logic.lambda-formals-and-logic.lambda-actuals
+            (%enable default logic.lambdap logic.lambda-formals logic.lambda-actuals)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-logic.lambda-of-logic.lambda-formals-body-and-actuals
+            (%enable default logic.lambdap logic.lambda logic.lambda-formals logic.lambda-body logic.lambda-actuals)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%restrict default tuplep (or (equal n ''3) (equal n ''2) (equal n ''1) (equal n ''0)))
+            (%betamode nil)
+            (%auto :strategy (cleanup split crewrite))
+            (%betamode once)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove forcing-logic.lambda-of-logic.lambda-formals-body-and-actuals-free)
+
+(%autoprove rank-of-logic.lambda-actuals
+            (%enable default logic.lambda-actuals))
+
+(%autoprove rank-of-first-of-logic.lambda-actuals
+            (%enable default logic.lambda-actuals))
+
+(%autoprove rank-of-second-of-logic.lambda-actuals
+            (%enable default logic.lambda-actuals))
+
+(%autoprove rank-of-third-of-logic.lambda-actuals
+            (%enable default logic.lambda-actuals))
+
+(%autoprove logic.lambdap-when-consp-of-car-cheap
+            (%enable default logic.lambdap))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-term-list-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-term-list-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-term-list-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-term-list-listp.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,58 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-2")
+(%interactive)
+
+(%autoadmit logic.fast-term-list-list-vars)
+
+(%deflist logic.term-list-listp (x)
+  (logic.term-listp x))
+
+(%autoprove logic.term-listp-of-strip-firsts-when-logic.term-list-listp
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-list-listp-of-listify-each
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-listp-of-simple-flatten
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-logic.fast-term-list-list-vars
+            (%cdr-induction x)
+            (%restrict default logic.fast-term-list-list-vars (equal x 'x)))
+
+(%autoprove forcing-logic.term-list-listp-of-multicons
+            (%cdr-induction x))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-term-vars.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-term-vars.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3-term-vars.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3-term-vars.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,78 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-2")
+(%interactive)
+
+(%autoprove logic.term-list-vars-when-not-consp
+            (%restrict default definition-of-logic.term-list-vars (equal x 'x)))
+
+(%autoprove logic.term-list-vars-of-cons
+            (%restrict default definition-of-logic.term-list-vars (equal x '(cons a x))))
+
+(%autoprove true-listp-of-logic.term-list-vars
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-logic.term-vars
+            (%restrict default definition-of-logic.term-vars (equal x 'x)))
+
+(%autoprove logic.term-vars-when-variable
+            (%restrict default definition-of-logic.term-vars (equal x 'x)))
+
+(%autoprove logic.term-vars-when-constant
+            (%restrict default definition-of-logic.term-vars (equal x 'x)))
+
+(%autoprove logic.term-vars-when-bad
+            (%restrict default definition-of-logic.term-vars (equal x 'x)))
+
+(%autoprove subsetp-of-logic.term-list-vars-of-cdr-with-logic.term-list-vars)
+
+(%autoprove subsetp-of-logic.term-vars-of-car-with-logic.term-list-vars)
+
+(%autoprove logic.term-list-vars-when-logic.variable-listp
+            (%cdr-induction x))
+
+(encapsulate
+ ()
+ (%autoprove lemma-for-subsetp-of-logic.term-list-vars-and-remove-duplicates
+             (%cdr-induction x))
+
+ (%autoprove subsetp-of-logic.term-list-vars-and-remove-duplicates
+             (%cdr-induction x)
+             (%enable default lemma-for-subsetp-of-logic.term-list-vars-and-remove-duplicates)))
+
+(%autoprove subsetp-of-logic.term-list-vars-and-remove-duplicates-two
+            (%cdr-induction x))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms-3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms-3.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,140 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-2")
+(include-book "terms-3-functionp")
+(include-book "terms-3-lambdap")
+(include-book "terms-3-term-vars")
+(include-book "terms-3-term-list-listp")
+(include-book "terms-3-arity-tablep")
+(%interactive)
+
+
+
+(%autoprove logic.functionp-when-logic.lambdap-cheap
+            (%enable default logic.lambdap logic.functionp))
+
+(%autoprove logic.lambdap-when-logic.functionp-cheap)
+
+(%autoprove logic.functionp-of-logic.lambda)
+
+(%autoprove logic.function-namep-of-car-when-logic.termp-and-not-logic.variablep
+            (%enable default logic.functionp logic.constantp)
+            (%restrict default definition-of-logic.termp (equal x 'x)))
+
+(%autoprove logic.lambdap-when-not-anything-else-maybe-expensive
+            (%enable default logic.lambdap logic.functionp)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil))
+
+(%autoprove logic.termp-when-invalid-maybe-expensive)
+
+(%autoprove logic.functionp-when-not-other-stuff-cheap
+            (%enable default logic.lambdap logic.functionp)
+            (%restrict default definition-of-logic.termp (equal x 'x))
+            (%betamode nil))
+
+(%autoprove logic.lambdap-when-not-other-stuff-cheap)
+
+
+
+(%autoprove logic.term-vars-when-function-call
+            (%enable default logic.function-args)
+            (%restrict default definition-of-logic.term-vars (equal x 'x))
+            (%betamode nil))
+
+(%autoprove logic.term-vars-when-logic.lambda
+            (%enable default logic.lambdap logic.lambda-actuals)
+            (%restrict default definition-of-logic.term-vars (equal x 'x))
+            (%betamode nil))
+
+
+(%autoprove lemma-for-forcing-logic.variable-listp-of-logic.term-vars
+            (%logic.term-induction flag x)
+            ;; This rule is really expensive, taking 716 frames/try when it's enabled
+            (local (%disable default logic.variable-listp-of-subsetp-when-logic.variable-listp))
+            ;; These rules cause problems with forcing
+            (local (%disable default
+                             FORCING-TRUE-LISTP-OF-LOGIC.FUNCTION-ARGS
+                             FORCING-LOGIC.TERMP-OF-LOGIC.LAMBDA-BODY
+                             FORCING-TRUE-LISTP-OF-LOGIC.LAMBDA-ACTUALS))
+            (%auto :strategy (cleanup split crewrite elim)))
+
+(%autoprove forcing-logic.variable-listp-of-logic.term-vars
+            (%use (%instance (%thm lemma-for-forcing-logic.variable-listp-of-logic.term-vars) (flag 'term))))
+
+(%autoprove forcing-logic.variable-listp-of-logic.term-list-vars
+            (%use (%instance (%thm lemma-for-forcing-logic.variable-listp-of-logic.term-vars) (flag 'list))))
+
+
+
+(%autoprove logic.term-listp-when-subset-of-somep
+            (%cdr-induction x))
+
+(%autoprove logic.term-listp-when-subset-of-somep-alt)
+
+(%autoprove logic.term-list-listp-when-all-superset-of-somep
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-listp-when-all-superset-of-somep-alt)
+
+(%autoprove forcing-logic.term-list-listp-of-remove-supersets1
+            (%autoinduct remove-supersets1))
+
+(%autoprove forcing-logic.term-list-listp-of-remove-supersets
+            (%enable default remove-supersets))
+
+(%autoprove forcing-logic.term-list-listp-of-remove-duplicates-list
+            (%cdr-induction x))
+
+
+
+(%autoadmit logic.term-list-list-vars)
+
+(%autoprove definition-of-logic.term-list-list-vars
+            (%enable default logic.term-list-list-vars)
+            (%restrict default logic.fast-term-list-list-vars (equal x 'x)))
+
+(%autoprove logic.term-list-list-vars-when-not-consp
+            (%restrict default definition-of-logic.term-list-list-vars (equal x 'x)))
+
+(%autoprove logic.term-list-list-vars-of-cons
+            (%restrict default definition-of-logic.term-list-list-vars (equal x '(cons a x))))
+
+(%autoprove true-listp-of-logic.term-list-list-vars
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.variable-listp-of-logic.term-list-list-vars
+            (%cdr-induction x))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/terms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/terms.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,155 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms-3")
+(%interactive)
+
+
+(%autoadmit logic.flag-term-atblp)
+(%autoadmit logic.term-atblp)
+(%autoadmit logic.term-list-atblp)
+
+(%autoprove definition-of-logic.term-atblp
+            (%enable default logic.term-atblp logic.term-list-atblp)
+            (%restrict default logic.flag-term-atblp (equal x 'x)))
+
+(%autoprove definition-of-logic.term-list-atblp
+            (%enable default logic.term-atblp logic.term-list-atblp)
+            (%restrict default logic.flag-term-atblp (equal x 'x)))
+
+(%autoprove logic.term-list-atblp-when-not-consp
+            (%restrict default definition-of-logic.term-list-atblp (equal x 'x)))
+
+(%autoprove logic.term-list-atblp-of-cons
+            (%restrict default definition-of-logic.term-list-atblp (equal x '(cons a x))))
+
+(%autoprove lemma-for-booleanp-of-logic.term-atblp
+            (%logic.term-induction flag x)
+            (local (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+            (%auto :strategy (cleanup split crewrite elim)))
+
+(%autoprove booleanp-of-logic.term-atblp
+            (%use (%instance (%thm lemma-for-booleanp-of-logic.term-atblp) (flag 'term))))
+
+(%autoprove booleanp-of-logic.term-list-atblp
+            (%use (%instance (%thm lemma-for-booleanp-of-logic.term-atblp) (flag 'list))))
+
+(%autoprove logic.term-atblp-of-nil
+            (%restrict default definition-of-logic.term-atblp (equal x ''nil)))
+
+(%deflist logic.term-list-atblp (x atbl)
+          (logic.term-atblp x atbl))
+
+(%deflist logic.term-list-list-atblp (x atbl)
+          (logic.term-list-atblp x atbl))
+
+
+
+(%autoprove logic.term-atblp-when-logic.variablep
+            (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+
+(%autoprove logic.term-atblp-when-logic.constantp
+            (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+
+(%autoprove logic.term-list-atblp-when-logic.constant-listp
+            (%cdr-induction x))
+
+(%autoprove logic.term-list-atblp-when-logic.variable-listp
+            (%cdr-induction x))
+
+(%autoprove forcing-logic.term-atblp-of-logic.function
+            (%restrict default definition-of-logic.term-atblp (equal x '(logic.function name args))))
+
+(%autoprove forcing-logic.term-atblp-of-logic.lambda
+            (%disable default logic.lambdap-when-not-anything-else-maybe-expensive)
+            (%restrict default definition-of-logic.term-atblp (equal x '(logic.lambda formals body actuals))))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.function-args
+            (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-list-atblp-of-logic.lambda-actuals
+            (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+
+(%autoprove forcing-logic.term-atblp-of-logic.lambda-body
+            (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+
+(%autoprove logic.term-list-atblp-of-strip-firsts-when-logic.term-list-listp
+            (%cdr-induction x))
+
+(%autoprove forcing-lookup-of-logic.function-name
+            (%disable default forcing-logic.term-list-atblp-of-logic.function-args)
+            (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+
+(%autoprove forcing-lookup-of-logic.function-name-free)
+
+
+
+(%autoprove lemma-1-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table)
+
+(%autoprove lemma-2-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table
+            ;; BOZO previously we were using a backchain limit on this submapp
+            ;; call in the Milawa-proof only.  Do we need to have that or is
+            ;; the proof still reasonable?
+            (%use (%instance (%thm equal-of-lookups-when-submapp) (a name) (x atbl) (y atbl2))))
+
+(%autoprove lemma-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table
+            (%logic.term-induction flag x)
+            (%auto :strategy (cleanup split))
+            (%enable default
+                     lemma-1-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table
+                     lemma-2-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table)
+            (%forcingp nil)
+            (%auto)
+            (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+
+(%autoprove logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table
+            (%use (%instance (%thm lemma-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table) (flag 'term))))
+
+(%autoprove logic.term-list-atblp-when-logic.term-list-atblp-in-smaller-arity-table
+            (%use (%instance (%thm lemma-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table) (flag 'list))))
+
+(%autoprove logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table-alt)
+
+(%autoprove logic.term-list-atblp-when-logic.term-list-atblp-in-smaller-arity-table-alt)
+
+(%autoprove logic.term-atblp-when-malformed-cheap
+            (%restrict default definition-of-logic.term-atblp (equal x 'x)))
+
+
+(%ensure-exactly-these-rules-are-missing
+ "../../logic/terms"
+ ;; BOZO somehow we didn't need this.  Localize it in ACL2 or get rid of it in ACL2?
+ LEMMA-FOR-FORCING-LOOKUP-OF-LOGIC.FUNCTION-NAME)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/logic/top.lisp acl2-6.3/books/milawa/ACL2/bootstrap/logic/top.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/logic/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/logic/top.lisp	2013-09-30 17:53:17.000000000 +0000
@@ -0,0 +1,140 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(include-book "arities-okp")
+(include-book "appeal-identity")
+(include-book "base-evaluator")
+(include-book "disjoin-formulas")
+(include-book "find-proof")
+(include-book "formula-size")
+(include-book "formulas")
+(include-book "fterm-lists")
+(include-book "functional-axiom")
+(include-book "groundp")
+(include-book "negate-formulas")
+(include-book "negate-term")
+;; Stupid file, don't implement (include-book "pand")
+;; Never used, probably don't care? (include-book "patmatch-formula")
+(include-book "patmatch-term")
+(include-book "pequal-list")
+;; Stupid file, don't implement (include-book "piff")
+(include-book "por-list")
+(include-book "proofp")
+(include-book "quote-range")
+(include-book "replace-subterm")
+(include-book "substitute-formula")
+(include-book "substitute-term")
+(include-book "subtermp")
+;; Probably don't care?  (include-book "termination")
+(include-book "term-formula")
+(include-book "term-order")
+(include-book "terms")
+;; ACL2-specific, move elsewhere? (include-book "trace-proofp")
+;; Probably don't care? (include-book "translate")
+;; Probably don't care? (include-book "translate-sigma")
+
+
+
+(%create-theory formula-decomposition)
+(%enable formula-decomposition
+         aggressive-equal-of-logic.pors
+         aggressive-equal-of-logic.pnots
+         aggressive-equal-of-logic.pequals
+         forcing-equal-of-logic.pequal-rewrite
+         forcing-equal-of-logic.pequal-rewrite-two
+         forcing-equal-of-logic.por-rewrite
+         forcing-equal-of-logic.por-rewrite-two
+         forcing-equal-of-logic.pnot-rewrite
+         forcing-equal-of-logic.pnot-rewrite-two
+         forcing-equal-of-logic.pequal-list-rewrite
+         forcing-equal-of-logic.pequal-list-rewrite-alt
+         forcing-equal-of-logic.function-with-three-args-alt
+         equal-of-logic.function-rewrite
+         equal-of-logic.function-rewrite-alt
+         [outside]equal-of-logic.function-and-logic.function
+         equal-logic.pequal-logic.pequal-rewrite
+         [outside]equal-logic.pequal-logic.pequal-rewrite
+         equal-logic.por-logic.por-rewrite
+         [outside]equal-logic.por-logic.por-rewrite)
+
+(%create-theory expensive-term/formula-inference)
+(%enable expensive-term/formula-inference
+         logic.termp-when-logic.formulap
+         logic.termp-when-invalid-maybe-expensive
+         logic.formulap-when-logic.termp
+         logic.constantp-when-not-consp
+         logic.constantp-when-logic.variablep
+         logic.constantp-when-logic.functionp
+         logic.constantp-when-logic.lambdap-cheap
+         logic.constantp-of-car-when-logic.constant-listp
+         logic.constantp-of-second-when-logic.constant-listp
+         logic.constantp-of-third-when-logic.constant-listp
+         logic.constantp-of-car-when-logic.none-constantp
+         logic.constantp-when-memberp-of-logic.constant-listp
+         logic.constant-listp-when-not-consp
+         logic.constant-listp-of-subsetp-when-logic.constant-listp
+         logic.variablep-when-consp
+         logic.variablep-when-logic.constantp
+         logic.variablep-when-logic.functionp
+         logic.variablep-when-logic.lambdap-cheap
+         logic.functionp-when-not-other-stuff-cheap
+         logic.functionp-when-logic.lambdap-cheap
+         forcing-logic.functionp-when-logic.base-evaluablep
+         forcing-logic.functionp-when-logic.base-evaluablep
+         logic.lambdap-when-not-other-stuff-cheap
+         logic.lambdap-when-not-anything-else-maybe-expensive
+         logic.lambdap-when-consp-of-car-cheap
+         logic.lambdap-when-logic.functionp-cheap
+         forcing-true-listp-of-logic.function-args)
+
+(%enable expensive-subsetp-rules
+         memberp-when-logic.all-terms-larger-cheap)
+
+(%enable unusual-memberp-rules
+         memberp-when-logic.all-terms-larger-cheap)
+
+(%enable unusual-consp-rules
+         consp-when-memberp-of-logic.sigmap-alt
+         consp-when-memberp-of-logic.arity-tablep-alt
+         consp-when-logic.functionp-cheap
+         consp-when-logic.lambdap-cheap)
+
+
+(%finish "logic")
+(%save-events "logic.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/proof-sizes-acl2.lsp acl2-6.3/books/milawa/ACL2/bootstrap/proof-sizes-acl2.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/proof-sizes-acl2.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/proof-sizes-acl2.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,134 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+; INSTRUCTIONS:
+;
+; After generating all the proofs and whatnot, run the following commands.
+;
+;   cd $(MILAWA)/Sources/ACL2/bootstrap
+;   ./level2/symmetry < proof-sizes-acl2.lsp
+;
+; This generates the proof-sizes-acl2 executable, which can then be used
+; to run the proof-sizes.lsp script.
+
+
+; What does this script do?
+;
+; To compare the sizes of proofs at different levels, we want to be able
+; to recreate the "environment" in which the proof was carried out.  That
+; is, we want to store things such as the world and definitions that were
+; in play at the time the proof was done.
+;
+; In this script, we begin by redefining %autoprove so that it will store
+; the world which was being used at the beginning of each proof.  We then
+; load all of the bootstrapping files where proofs are carried out.
+;
+; It takes several minutes to load all of the proofs.  Because of this, we want
+; to go ahead and save a proof-sizes-acl2 executable, which we can use to carry
+; out the re-proving, without having to reload all of these books.
+
+(ACL2::set-ld-redefinition-action '(:warn . :overwrite) ACL2::state)
+
+(ACL2::table proof-sizes 'autoprove-hints nil)
+
+(defun get-autoprove-hints (world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'autoprove-hints (ACL2::table-alist 'proof-sizes world))))
+
+(defmacro %autoprove (name &rest hints)
+  `(ACL2::progn
+    (ACL2::table proof-sizes 'autoprove-hints
+                 (cons (let ((world (tactic.harness->world ACL2::world)))
+                         (list ',name ',hints world))
+                       (get-autoprove-hints ACL2::world)))
+    (ACL2::make-event (autoprove-fn ',name ',hints ACL2::state))))
+
+
+
+; These include-books grab everything EXCEPT the actual transitions to new
+; proof checkers.  You MUST NOT include books such as level2/level2, or
+; level3/level3, because they include %switch-builder calls which are
+; irrevocable.  We do not want to switch the builders until we are ready to try
+; the proof at different levels.
+
+; Often the -acl2 book includes the supporting books.  I'm actually wanting to
+; move away from that style.  To see what books you need to load, look at
+; levelN.lisp, and see what it includes.  Then load all those books (not LevelN
+; itself, just what it includes) and also load the -acl2 book.
+
+(include-book "level2/support-3")
+(include-book "level2/level2-acl2")  ;; doesn't include sub-books
+
+(include-book "level3/prop")
+(include-book "level3/pequal")
+(include-book "level3/equal")
+(include-book "level3/iff")
+(include-book "level3/if")
+(include-book "level3/not")
+(include-book "level3/disjoined-update-clause-bldr")
+(include-book "level3/level3-acl2") ;; doesn't include sub-books
+
+(include-book "level4/level4-acl2")
+
+(include-book "level5/level5-acl2")
+
+(include-book "level6/level6-acl2")
+
+(include-book "level7/level7-acl2")
+
+(include-book "level8/level8-acl2")
+
+(include-book "level9/world-check")
+(include-book "level9/ancestors")
+(include-book "level9/cachep")
+(include-book "level9/fast-cache")
+(include-book "level9/match-free")
+(include-book "level9/rewrite-world-bldrs")
+(include-book "level9/level9-acl2") ; doesn't include sub-books
+
+(include-book "level10/crewrite-world")
+(include-book "level10/level10-acl2") ; doesn't include sub-books
+
+(include-book "level11/compiler")
+(include-book "level11/level11-acl2") ; doesn't include sub-books
+
+
+; Now that all the books are loaded, we can save our image.
+
+:q
+
+(ACL2::save-exec "proof-sizes-acl2" "Ready to compare proof sizes.")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/proof-sizes.lsp acl2-6.3/books/milawa/ACL2/bootstrap/proof-sizes.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/proof-sizes.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/proof-sizes.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,892 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+; Proof Sizes Script
+;
+; This script measures the proof sizes of some sample proofs when emitted at
+; the various levels.  You must run this script with the proof-sizes-acl2
+; executable, which can be generated by running proof-sizes-acl2.lsp in
+; level2/symmetry.
+
+(in-package "MILAWA")
+(%interactive)
+
+
+; Now we introduce the %reprove command.  This takes the name of the theorem to
+; reprove, and perhaps some additional hints that will be necessary to fix the
+; issues with "local" theory changes, etc.  It then tries to redo the proof by
+; reusing the theory and hints and so forth that our modified %autoprove has
+; built.  Finally, if everything is successful, it saves the UNCOMPILED PROOF
+; SKELETON so that it can be compiled at various levels and the proof sizes
+; compared.
+
+(ACL2::table reprove 'goalworlds nil)
+(ACL2::table reprove 'skeletons nil)
+(ACL2::table reprove 'sizes nil)
+
+(defun reprove->goalworlds (world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'goalworlds (ACL2::table-alist 'reprove world))))
+
+(defun reprove->skeletons (world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'skeletons (ACL2::table-alist 'reprove world))))
+
+(defun reprove->sizes (world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'sizes (ACL2::table-alist 'reprove world))))
+
+
+(ACL2::table reprove 'full-world (tactic.harness->world acl2::world))
+
+
+(defun reprove->fullworld (world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'full-world (ACL2::table-alist 'reprove world))))
+
+(defmacro %reprove (name &rest rhints)
+  `(ACL2::make-event (%reprove-fn ',name ',rhints (ACL2::w ACL2::state))))
+
+;; stupid god damn embeddable events and time$...
+(defun start-timer ()
+  (declare (xargs :guard t))
+  (acl2::cw "start-timer not redefined.~%"))
+
+(defun end-timer ()
+  (declare (xargs :guard t))
+  (acl2::cw "end-timer not redefined.~%"))
+
+
+(defun %reprove-fn (name rhints world)
+  (declare (xargs :mode :program))
+  (let* ((rule          (tactic.find-rule name (reprove->fullworld world)))
+         (hints-tuple   (lookup name (get-autoprove-hints world)))
+         (hints         (second hints-tuple))
+         (initial-world (third hints-tuple)))
+    (ACL2::prog2$
+     (ACL2::cw "%reprove-fn> size of initial-world is ~x0.~%" (rank initial-world))
+     `(ACL2::encapsulate
+       ()
+
+; This is basically like %prove.  We need to load the goalrule, goalworld, and
+; set up an empty, initial skeleton with the appropriate goals.
+
+       (ACL2::value-triple (ACL2::cw "[%Reprove]> Submitting ~x0.~%" ',name))
+       (ACL2::table tactic-harness 'goalrule ',rule)
+       (ACL2::table tactic-harness 'goalworld ',initial-world)
+       (ACL2::table tactic-harness 'world ',initial-world)
+
+       (local (ACL2::table tactic-harness 'skeleton (tactic.initial-skeleton (list ',(rw.rule-clause rule)))))
+
+; This is basically like %autoprove.  We get the hints that were given when the
+; proof was submitted, preceeded by any extra hints that we might want to give
+; to fix up theories, etc., then finally give %auto.
+
+       (ACL2::value-triple (ACL2::cw "[%Reprove]> Trying to replay the proof.~%"))
+       (acl2::value-triple (start-timer))
+       (local (ACL2::progn ,@rhints ,@hints (%auto)))
+       (acl2::value-triple (end-timer))
+
+       (ACL2::value-triple (ACL2::cw "[%Reprove]> Checking for success and saving skeleton.~%"))
+       (ACL2::make-event (%reprove-save-skelly-fn ACL2::state))))))
+
+
+(defun %reprove-save-skelly-fn (ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+
+; Here we save the skeleton, world, and definitions that were used during the
+; proof.  We will need these in order to compile the skeleton and build the
+; level-N proof.
+
+  (let* ((world     (ACL2::w ACL2::state))
+         (skeleton  (tactic.harness->skeleton world))
+         (goals     (tactic.skeleton->goals skeleton))
+         (goalrule  (tactic.harness->goalrule world))
+         (goalworld (tactic.harness->goalworld world))
+         (name      (rw.rule->name goalrule)))
+    (if (consp goals)
+        (ACL2::er soft '%reprove "Outstanding goals remain for ~s0.~%" name)
+      (ACL2::mv nil
+                `(ACL2::progn
+                  (ACL2::table reprove 'skeletons
+                               (cons (cons ',name ',skeleton) (reprove->skeletons ACL2::world)))
+                  (ACL2::table reprove 'goalworlds
+                               (cons (cons ',name ',goalworld) (reprove->goalworlds ACL2::world))))
+                ACL2::state))))
+
+(defmacro %reprove-compile (name)
+  `(ACL2::progn
+    (local (ACL2::memoize 'rank))
+    (ACL2::make-event (ACL2::time$ (%reprove-compile-fn ',name ACL2::state)))
+    (local (ACL2::unmemoize 'rank))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))))
+
+(defun static-analysis (proof)
+  ;; We return (STATIC-RANK . DYNAMIC-RANK) where these count the static and dynamic
+  ;; sizes of the proof.
+  (declare (xargs :mode :program))
+  (let ((method (logic.method proof))
+        (extras (logic.extras proof)))
+    (acl2::prog2$
+     (acl2::cw "static analysis for proof of type ~x0. total rank is ~x1. #extras = ~x2~%"
+               method
+               (rank proof)
+               (len extras))
+     (let ((result (cond ((equal method 'level8.proofp)
+                          (acl2::prog2$
+                           (or (equal (len extras) 2)
+                               (acl2::er hard? 'static-analysis "level8 format changed?"))
+                           (list (rank (first extras)) (rank (second extras)))))
+                         ((or (equal method 'level9.proofp)
+                              (equal method 'level10.proofp)
+                              (equal method 'level11.proofp))
+                          (acl2::prog2$
+                           (or (equal (len extras) 3)
+                               (acl2::er hard? 'static-analysis "level9-11 format changed?"))
+                           (list (+ (rank (first extras)) (rank (second extras)))
+                                 (rank (third extras)))))
+                         (t
+                          (list 0 (rank proof))))))
+       (acl2::prog2$
+        (acl2::cw "static analysis yields: ~x0.~%" result)
+        result)))))
+
+(defun %time-and-check-proof (proofp-name thm-name proof axioms thms atbl)
+  (declare (xargs :guard t)
+           (ignore proofp-name thm-name proof axioms thms atbl))
+  (acl2::cw "%time-and-check-proof has not been redefined!~%"))
+
+(defun %time-proof-building (proofp-name thm-name skelly init-world)
+  (declare (xargs :guard t)
+           (ignore proofp-name thm-name skelly init-world))
+  (acl2::cw "%time-proof-building has not been redefined!~%"))
+
+(acl2::defttag time-and-check-proof)
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+
+ (acl2::defparameter *time-and-check-table* nil)
+ (acl2::defparameter *time-building-table* nil)
+
+ (acl2::defparameter *timer-for-start/end-timer* 0)
+
+ (acl2::defun start-timer ()
+              (acl2::setf *timer-for-start/end-timer* (acl2::get-internal-real-time)))
+
+ (acl2::defun end-timer ()
+              (let* ((start   *timer-for-start/end-timer*)
+                     (end     (acl2::get-internal-real-time))
+                     (elapsed (ACL2::/ (ACL2::coerce (ACL2::- end start) 'ACL2::float)
+                               ACL2::internal-time-units-per-second)))
+                (acl2::progn
+                 (ACL2::format t "Elapsed time from start/end-timer: ~a.~%" elapsed)
+                 nil)))
+
+ (acl2::defun %time-and-check-proof (proofp-name thm-name proof axioms thms atbl)
+   (let* ((start-time (ACL2::get-internal-real-time))
+          (result     (%current-proofp proof axioms thms atbl))
+          (end-time   (ACL2::get-internal-real-time))
+          (elapsed    (ACL2::/ (ACL2::coerce (ACL2::- end-time start-time) 'ACL2::float)
+                               ACL2::internal-time-units-per-second)))
+     (ACL2::progn
+      (ACL2::format t "~a checks ~a in ~a seconds.~%" proofp-name thm-name elapsed)
+      (acl2::push (list proofp-name thm-name elapsed) *time-and-check-table*)
+      result)))
+
+ (acl2::defun %time-proof-building (proofp-name thm-name skelly init-world)
+   (let* ((start-time (ACL2::get-internal-real-time))
+          (worlds (ACL2::prog2$
+                   (ACL2::cw "; Compiling worlds for ~x0...~%" thm-name)
+                   (tactic.compile-worlds skelly init-world)))
+          (proof  (%current-adapter
+                   (ACL2::prog2$ (ACL2::cw "Compiling skeleton for ~x0.~%" thm-name)
+                                 (car (ACL2::time$ (tactic.compile-skeleton skelly worlds nil))))
+                   (tactic.world->defs init-world)
+                   init-world
+                   worlds))
+          (end-time   (ACL2::get-internal-real-time))
+          (elapsed    (ACL2::/ (ACL2::coerce (ACL2::- end-time start-time) 'ACL2::float)
+                               ACL2::internal-time-units-per-second)))
+     (ACL2::progn
+      (ACL2::format t "built ~a for ~a in ~a seconds.~%" thm-name proofp-name elapsed)
+      (acl2::push (list proofp-name thm-name elapsed) *time-building-table*)
+      proof))))
+
+(defun %reprove-compile-fn (name ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((world      (ACL2::w ACL2::state))
+         (skelly     (cdr (lookup name (reprove->skeletons world))))
+         (init-world (cdr (lookup name (reprove->goalworlds world)))))
+    (if (not skelly)
+        (ACL2::er soft '%reprove-compile "Unable to find skeleton for ~s0.~%" name)
+
+; This is basically like %qed-check-fn.  We have the goalworld and skeleton,
+; and we just need to compile it and apply the adapter.
+
+      (let* ((proof (%time-proof-building (tactic.harness->current-proofp world)
+                                          name
+                                          skelly
+                                          init-world))
+             (check  (ACL2::prog2$
+                      (ACL2::cw "Checking the proof...~%")
+                      (or (%time-and-check-proof (tactic.harness->current-proofp world)
+                                                 name
+                                                 proof
+                                                 (tactic.harness->axioms world)
+                                                 (tactic.harness->thms world)
+                                                 (tactic.harness->atbl world))
+                          (ACL2::er hard? '%reprove-compile-fn "Proof was rejected.~%")))))
+        (declare (ignore check))
+        (ACL2::prog2$
+         (ACL2::cw "Total size: ~s0~s1 conses~s2.~%" *blue* (STR::pretty-number (rank proof)) *black*)
+         (ACL2::mv nil
+                   `(ACL2::table reprove 'sizes
+                                 (cons (list (tactic.harness->current-proofp ACL2::world)
+                                             ',name
+                                             ',(static-analysis proof))
+                                       (reprove->sizes ACL2::world)))
+                   ACL2::state))))))
+
+
+
+(include-book "level2/level2")
+(include-book "level3/level3")
+(include-book "level4/level4")
+(include-book "level5/level5")
+(include-book "level6/level6")
+(include-book "level7/level7")
+(include-book "level8/level8")
+(include-book "level9/level9")
+(include-book "level10/level10")
+(i-am-here)
+
+;; reprove fresh here for fast-urewrite
+(include-book "level10/level10")
+
+;; reprove fresh here for fast-crewrite
+(include-book "level11/level11")
+
+;; probably reprove fresh here for good measure
+
+(%reprove forcing-logic.proofp-of-build.disjoined-transitivity-of-iff
+          (%enable default
+                   theorem-transitivity-of-iff
+                   theorem-transitivity-of-iff
+                   theorem-transitivity-of-iff
+                   build.disjoined-transitivity-of-iff))
+
+(%reprove-compile forcing-logic.proofp-of-build.disjoined-transitivity-of-iff)
+
+
+8 compile
+6 static-checks
+2 skeletonp
+147 skeleton-okp
+
+288s atblp -- this is the one to fix, suppose 10s
+0s env-okp
+---------
+(+ 8 6 2 147) 163
+
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+:redef
+
+(defund tactic.compile-skeleton-okp (x worlds axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (tactic.world-listp worlds)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'tactic.compile-skeleton)
+         (acl2::time$ (tactic.skeletonp extras))
+         (acl2::time$ (tactic.skeleton-okp extras worlds))
+         (acl2::time$ (tactic.fast-skeleton-atblp extras atbl))
+         (acl2::time$ (tactic.skeleton-env-okp extras worlds axioms thms atbl))
+         (memberp conclusion
+                  (clause.clause-list-formulas (tactic.original-conclusions extras)))
+         (equal (logic.strip-conclusions subproofs)
+                (clause.clause-list-formulas (tactic.skeleton->goals extras))))))
+
+
+
+
+
+
+
+
+
+
+
+
+(%reprove lemma-for-forcing-logic.proofp-of-generic-evaluator-bldr
+          ;(%enable default iff iff iff)
+          )
+
+(%reprove-compile lemma-for-forcing-logic.proofp-of-generic-evaluator-bldr)
+
+
+;; --- we are missing some rules from this, somehow ??
+;(include-book "level10/crewrite-local-settings")
+(encapsulate
+ ()
+
+ (%rwn 1000)
+
+ (%cheapen default rw.trace-list-rhses-when-not-consp)
+; (%cheapen default rw.crewrite-core-list-when-not-consp)
+
+ (%create-theory my-disables-for-extra-speed)
+ (%enable my-disables-for-extra-speed
+          consp-when-memberp-of-logic.sigmap
+          consp-when-memberp-of-logic.sigmap-alt
+          consp-when-memberp-of-logic.sigma-atblp
+          consp-when-memberp-of-logic.sigma-atblp-alt
+          consp-when-memberp-of-logic.arity-tablep
+          consp-when-memberp-of-logic.arity-tablep-alt
+          ;;consp-when-memberp-of-logic.callmapp
+          ;;consp-when-memberp-of-logic.callmapp-alt
+          ;;consp-when-memberp-of-logic.callmap-atblp
+          ;;consp-when-memberp-of-logic.callmap-atblp-alt
+;          consp-when-memberp-of-rw.cachemapp
+;          consp-when-memberp-of-rw.cachemapp-alt
+          consp-when-memberp-of-none-consp
+          consp-when-memberp-of-none-consp-alt
+          consp-when-memberp-of-cons-listp
+          consp-when-memberp-of-cons-listp-alt
+          same-length-prefixes-equal-cheap
+          car-when-not-consp
+          cdr-when-not-consp
+          consp-when-natp-cheap
+          forcing-logic.groundp-of-logic.substitute
+          consp-when-logic.lambdap-cheap
+          consp-when-logic.functionp-cheap
+          consp-when-nonempty-subset-cheap
+          consp-when-memberp-cheap
+          logic.substitute-when-malformed-cheap
+          logic.constant-listp-when-not-consp
+          subsetp-when-not-consp
+          subsetp-when-not-consp-two
+          cons-listp-when-not-consp
+          none-consp-when-not-consp
+          forcing-logic.substitute-of-empty-sigma
+          not-equal-when-less
+          trichotomy-of-<
+          natp-of-len-free
+          transitivity-of-<
+          transitivity-of-<-three
+          transitivity-of-<-two
+          less-completion-left
+          less-of-one-right)
+ (%disable default my-disables-for-extra-speed)
+
+ (%disable default zp min)
+
+ (%disable default
+           formula-decomposition
+           expensive-term/formula-inference
+           expensive-arithmetic-rules
+           expensive-arithmetic-rules-two
+           type-set-like-rules
+           unusual-consp-rules
+           unusual-memberp-rules
+           unusual-subsetp-rules
+           same-length-prefixes-equal-cheap
+           ;; ---
+           lookup-when-not-consp
+           rw.trace-list-rhses-when-not-consp
+           forcing-logic.function-of-logic.function-name-and-logic.function-args-free)
+
+ (%disable default
+           logic.substitute-when-logic.lambdap-cheap
+           logic.substitute-when-logic.variablep
+           logic.substitute-when-logic.constantp
+           logic.substitute-when-logic.functionp-cheap
+           forcing-logic.substitute-list-of-empty-sigma
+           logic.substitute-list-when-not-consp
+           logic.substitute-list-of-cons-gross)
+
+
+ ;; SPECIAL THEORIES FOR THE OPENING MOVE.
+
+ (%create-theory splitters)
+ (%enable splitters
+          ;; These are all of the rules that introduce an "if" on the
+          ;; right-hand side (and hence may cause case splits).
+          (gather from default (not (clause.simple-termp rhs))))
+ (%disable default splitters)
+
+
+ (%create-theory special-disables-for-fast-pruning)
+ (%enable special-disables-for-fast-pruning
+          ;; These are rules which %profile said were useless and
+          ;; expensive during the initial phase.  Disabling them helps to
+          ;; speed up the rewriting.
+          rw.trace-list-rhses-when-not-consp
+          logic.termp-when-not-consp-cheap
+          rank-when-not-consp
+          rw.trace-listp-when-not-consp
+;          forcing-rw.assmsp-of-rw.assume-left
+          logic.term-listp-when-not-consp
+          ord<-when-naturals
+          logic.sigmap-when-not-consp
+          logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+          forcing-logic.term-listp-of-rw.trace-list-rhses
+          cdr-when-true-listp-with-len-free-past-the-end
+          forcing-logic.groundp-when-logic.constant-listp-of-logic.function-args
+          minus-when-zp-left-cheap
+          minus-when-zp-right-cheap
+          minus-when-not-less
+          forcing-logic.groundp-when-logic.constant-listp-of-logic.lambda-actuals
+          logic.variable-listp-of-cdr-when-logic.variable-listp
+          forcing-logic.termp-of-logic.substitute
+          logic.variablep-of-car-when-logic.variable-listp
+          rw.rule-listp-of-cdr-when-rw.rule-listp
+          cdr-of-cdr-when-true-listp-with-len-free-past-the-end
+          cdr-of-cdr-with-len-free-past-the-end
+          logic.groundp-when-logic.constantp
+          forcing-logic.function-args-of-logic.substitute
+          forcing-logic.lambda-actuals-of-logic.substitute
+          logic.constant-listp-of-cdr-when-logic.constant-listp
+;          rw.typed-rulemapp-when-not-consp
+          memberp-when-not-consp ordp-when-natp
+          memberp-when-memberp-of-cdr
+          rw.rulep-of-car-when-rw.rule-listp
+          logic.sigmap-of-car-when-logic.sigma-listp
+;          forcing-rw.cachep-of-rw.set-blockedp
+          logic.sigma-listp-of-cdr-when-logic.sigma-listp
+          )
+ (%disable default special-disables-for-fast-pruning)
+
+ )
+
+
+(%reprove lemma-for-rw.trace-fast-image-of-rw.crewrite-core)
+
+
+
+
+; You can now choose a theorem to try.  It gets the previous hints
+; automatically, but you can give more hints to set up whatever local
+; environment you need, e.g., with theories, etc.
+
+
+; I choose a few proofs by running
+;
+;    grep -B 2 "Proof size" *.pcert.out
+;
+; in each directory and looking for large proofs.  (Actually you can
+; automatically choose only the multi-million cons proofs like this):
+;
+;    grep -B 2 "Proof size" *.pcert.out | grep -B 2 "[0-9][0-9][0-9],[0-9][0-9][0-9],[0-9][0-9][0-9]"
+;
+; I picked a few proofs from each directory.  I tried to get some level of
+; diversity in the type of proof.
+
+(acl2::trace$ (TACTIC.CREWRITE-ALL-TAC
+               :entry (list :theoryname (second acl2::arglist)
+                            :fastp (third acl2::arglist))))
+
+(acl2::trace$ rw.fast-transitivity-trace)
+
+(%reprove forcing-logic.proofp-of-build.disjoined-transitivity-of-iff
+          (%enable default
+                   theorem-transitivity-of-iff
+                   build.disjoined-transitivity-of-iff))
+
+(%reprove forcing-logic.proofp-of-build.disjoined-negative-lit-from-pequal-nil
+          (%enable default
+                   build.disjoined-negative-lit-from-pequal-nil
+                   theorem-not-when-nil))
+
+(%reprove forcing-logic.proofp-of-clause.aux-split-double-negate
+          (%splitlimit 8) ;; from level5/level5
+          (%enable default
+                   logic.term-formula
+                   clause.aux-split-goal
+                   clause.aux-split-double-negate))
+
+(%reprove build.disjoined-equal-by-args-aux-okp-removal)
+
+(%reprove forcing-logic.proofp-of-clause.disjoined-substitute-iff-into-literal-bldr
+          (%enable default clause.disjoined-substitute-iff-into-literal-bldr))
+
+(%reprove forcing-logic.conclusion-of-clause.disjoined-aux-split-negative-bldr
+           (%enable default
+                    clause.disjoined-aux-split-negative-bldr
+                    clause.theorem-aux-split-negative))
+
+(%reprove lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-bldr)
+e
+(%reprove lemma-for-forcing-logic.proofp-of-generic-evaluator-bldr)
+
+(%reprove lemma-for-forcing-logic.appealp-of-clause.factor-bldr)
+
+
+
+; The reprove command above creates the skeleton, but doesn't compile
+; it.  We can now compile it with the %reprove-compile command.
+
+(defmacro do-compilations ()
+  `(acl2::progn
+    (%reprove-compile forcing-logic.proofp-of-build.disjoined-transitivity-of-iff)
+    (%reprove-compile forcing-logic.proofp-of-build.disjoined-negative-lit-from-pequal-nil)
+    (%reprove-compile forcing-logic.proofp-of-clause.aux-split-double-negate)
+    (%reprove-compile build.disjoined-equal-by-args-aux-okp-removal)
+    (%reprove-compile forcing-logic.proofp-of-clause.disjoined-substitute-iff-into-literal-bldr)
+    (%reprove-compile forcing-logic.conclusion-of-clause.disjoined-aux-split-negative-bldr)
+    (%reprove-compile lemma-for-forcing-logic.appealp-of-clause.aux-update-clause-bldr)
+    (%reprove-compile lemma-for-forcing-logic.proofp-of-generic-evaluator-bldr)
+    (%reprove-compile lemma-for-forcing-logic.appealp-of-clause.factor-bldr)
+    ))
+
+
+
+
+(do-compilations)
+
+; To see what the proof is like at later levels, we can include-book the
+; next level up and call reprove-compile again.  This time the compilation
+; is done using the newly-switched builders.
+
+(include-book "level2/level2")
+(do-compilations)
+
+; And so on, for the other levels.  The sizes for the proofs are saved
+; into a the reprove->sizes table, so you can summarize them at the end.
+
+(include-book "level3/level3")
+(do-compilations)
+
+(include-book "level4/level4")
+(do-compilations)
+
+(include-book "level5/level5")
+(do-compilations)
+
+(include-book "level6/level6")
+(do-compilations)
+
+(include-book "level7/level7")
+(do-compilations)
+
+(include-book "level8/level8")
+(do-compilations)
+
+(include-book "level9/level9")
+(do-compilations)
+
+(include-book "level10/level10")
+(do-compilations)
+
+(include-book "level11/level11")
+(do-compilations)
+
+; To see a summary, we run reprove->sizes.
+
+(reprove->sizes (ACL2::w ACL2::state))
+
+
+
+(include-book "level2/level2")
+(include-book "level3/level3")
+(include-book "level4/level4")
+(include-book "level5/level5")
+(include-book "level6/level6")
+(include-book "level7/level7")
+(include-book "level8/level8")
+(include-book "level9/level9")
+(include-book "level10/level10")
+
+
+(do-compilations)
+
+(include-book "level10/level10")
+(do-compilations)
+
+(include-book "level11/level11")
+
+
+
+
+(i-am-here)
+
+:q
+
+(acl2::cw "~x0~%"
+          (acl2::sort (reprove->sizes (acl2::w acl2::*the-live-state*))
+                      (lambda (x y)
+                        (or (symbol-< (second x) (second y))
+                            (and (equal (second x) (second y))
+                                 (symbol-< (first x) (first y)))))))
+
+(acl2::dolist (elem (acl2::sort *time-and-check-table*
+                          (lambda (x y)
+                            (or (symbol-< (second x) (second y))
+                                (and (equal (second x) (second y))
+                                     (symbol-< (first x) (first y)))))))
+  (acl2::format t "~a~%" elem))
+
+;; ((LEVEL10.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                  404290)
+;;  (LEVEL11.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                  394081)
+;;  (LEVEL2.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                 4487648)
+;;  (LEVEL3.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                 2376969)
+;;  (LEVEL4.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                 1212457)
+;;  (LEVEL5.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                 929253)
+;;  (LEVEL6.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                 782922)
+;;  (LEVEL7.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                 705301)
+;;  (LEVEL8.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                 406863)
+;;  (LEVEL9.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                 403202)
+;;  (LOGIC.PROOFP BUILD.DISJOINED-EQUAL-BY-ARGS-AUX-OKP-REMOVAL
+;;                37671049)
+;;  (LEVEL10.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       53612318)
+;;  (LEVEL11.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       52341246)
+;;  (LEVEL2.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       1126851329)
+;;  (LEVEL3.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       615153460)
+;;  (LEVEL4.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       104945672)
+;;  (LEVEL5.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       82338572)
+;;  (LEVEL6.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       37956239)
+;;  (LEVEL7.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       33735165)
+;;  (LEVEL8.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       53725739)
+g;;  (LEVEL9.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       53541935)
+;;  (LOGIC.PROOFP
+;;       FORCING-LOGIC.CONCLUSION-OF-CLAUSE.DISJOINED-AUX-SPLIT-NEGATIVE-BLDR
+;;       9728218760)
+;;  (LEVEL10.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       586569)
+;;  (LEVEL11.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       600090)
+;;  (LEVEL2.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       1465619)
+;;  (LEVEL3.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       721025)
+;;  (LEVEL4.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       365949)
+;;  (LEVEL5.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       334504)
+;;  (LEVEL6.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       334504)
+;;  (LEVEL7.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       334504)
+;;  (LEVEL8.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       592816)
+;;  (LEVEL9.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       586376)
+;;  (LOGIC.PROOFP
+;;       FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-NEGATIVE-LIT-FROM-PEQUAL-NIL
+;;       10345413)
+;;  (LEVEL10.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                  58643629)
+;;  (LEVEL11.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                  58670026)
+;;  (LEVEL2.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                 408753676)
+;;  (LEVEL3.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                 218777972)
+;;  (LEVEL4.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                 52578550)
+;;  (LEVEL5.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                 44103994)
+;;  (LEVEL6.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                 29091881)
+;;  (LEVEL7.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                 27036162)
+;;  (LEVEL8.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                 58661507)
+;;  (LEVEL9.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                 58639725)
+;;  (LOGIC.PROOFP FORCING-LOGIC.PROOFP-OF-BUILD.DISJOINED-TRANSITIVITY-OF-IFF
+;;                3491784272)
+;;  (LEVEL10.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                  2002070)
+;;  (LEVEL11.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                  1927685)
+;;  (LEVEL2.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                 63495138)
+;;  (LEVEL3.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                 33861782)
+;;  (LEVEL4.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                 6806516)
+;;  (LEVEL5.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                 4845556)
+;;  (LEVEL6.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                 2257161)
+;;  (LEVEL7.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                 2024643)
+;;  (LEVEL8.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                 2029213)
+;;  (LEVEL9.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                 1988318)
+;;  (LOGIC.PROOFP FORCING-LOGIC.PROOFP-OF-CLAUSE.AUX-SPLIT-DOUBLE-NEGATE
+;;                548911438)
+;;  (LEVEL10.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     10548888)
+;;  (LEVEL11.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     10490631)
+;;  (LEVEL2.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     1537111835)
+;;  (LEVEL3.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     862118740)
+;;  (LEVEL4.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     135627663)
+;;  (LEVEL5.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     103002504)
+;;  (LEVEL6.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     33821445)
+;;  (LEVEL7.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     25821804)
+;;  (LEVEL8.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     10573491)
+;;  (LEVEL9.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     10535724)
+;;  (LOGIC.PROOFP
+;;     FORCING-LOGIC.PROOFP-OF-CLAUSE.DISJOINED-SUBSTITUTE-IFF-INTO-LITERAL-BLDR
+;;     13175548486)
+;;  (LEVEL10.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       288974)
+;;  (LEVEL11.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       269611)
+;;  (LEVEL2.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       11644)
+;;  (LEVEL3.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       2233102)
+;;  (LEVEL4.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       1044698)
+;;  (LEVEL5.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       831077)
+;;  (LEVEL6.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       603458)
+;;  (LEVEL7.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       420481)
+;;  (LEVEL8.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       320978)
+;;  (LEVEL9.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       288405)
+;;  (LOGIC.PROOFP
+;;       LEMMA-FOR-FORCING-LOGIC.APPEALP-OF-CLAUSE.AUX-UPDATE-CLAUSE-BLDR
+;;       73072)
+;;  (LEVEL10.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                  359554)
+;;  (LEVEL11.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                  271017)
+;;  (LEVEL2.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                 19653560)
+;;  (LEVEL3.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                 9142242)
+;;  (LEVEL4.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                 3088482)
+;;  (LEVEL5.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                 2370091)
+;;  (LEVEL6.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                 1314330)
+;;  (LEVEL7.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                 462773)
+;;  (LEVEL8.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                 448562)
+;;  (LEVEL9.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                 359258)
+;;  (LOGIC.PROOFP LEMMA-FOR-FORCING-LOGIC.PROOFP-OF-GENERIC-EVALUATOR-BLDR
+;;                164627444))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/user/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/user/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/user/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/user/acl2-customization.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/user/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/user/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/user/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/user/cert.image	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1 @@
+user-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/user/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/user/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/user/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/user/make-image.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(include-book "../level11/level11")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/user-symmetry"
+                 "Pre-loaded bootstrap/level11 directory.")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/user/multiply.lisp acl2-6.3/books/milawa/ACL2/bootstrap/user/multiply.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/user/multiply.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/user/multiply.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,234 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(%interactive)
+
+
+(include-book
+ ;; Fooling dependency scanner with newline because of provisional
+ ;; certification problems with loading other books.  Generally we certify all
+ ;; ACL2 books before doing the Milawa translation, so this isn't a problem.
+ ;; Bug Jared to fix omake stuff if you need this to work.
+ "../../utilities/arithmetic/multiply")
+
+
+
+;; This file gives a demo of using our highest-level proof checker.
+;;
+;; This is probably completely stupid, since there are 13 other directories
+;; filled with examples of proofs, and the particular proof-checker being
+;; used is utterly irrelevant except for proof sizes.
+;;
+;; On the other hand, at least we get to test that our interface is
+;; creating proofs that are accepted by level11.proofp.
+;;
+;; What shall we prove?  Well, multiplication is not one of our primitives.
+;; Nor, in fact, is it used anywhere in Milawa.  But once upon a time, I looked
+;; at writing a more complete library for basic arithmetic, so if you look in
+;; Sources/ACL2/utilities/arithmetic you will find some various lemmas about
+;; multiplication, division, and so on.  In particular, to see what theorems
+;; we are proving, see
+;;
+;;    Sources/ACL2/utilities/arithmetic/multiply.lisp
+;;
+;; I imagined adding multiplication as a new primitive.  But for this simple
+;; example file, I will just give it the recursive definition I had imagined
+;; would be its defining axiom.  There's no ACL2 analogue, so we use %defun
+;; explicitly.
+;;
+;; In every other file you'll see %autoadmit being used instead, except
+;; probably for something like prepare-for-bootstrapping.lisp in the utilities
+;; directory.  But if you look at the macros in the ACL2/interface directory,
+;; you'll find that %defun and %admit can be used manually.  There are similar
+;; facilities called %prove and %qed, instead of %autoprove.  If you are going
+;; to use Milawa at all, you will probably need to read through the interface
+;; files to see what commands are available.
+
+(%building t) ;; Turn on proof building, for demo purposes
+(%saving t)   ;; Turn on proof saving, for demo purposes
+(%checking t) ;; Turn on proof checking, for demo purposes
+
+
+;; Introduce multiply manually, since the ACL2 definition in
+;; extended-primitives is "under the hood" and not legitimate.
+
+(encapsulate
+ ()
+ (%defun * (a b)
+         (if (zp a)
+             0
+           (+ b (* (- a 1) b)))
+         :measure (nfix a))
+ (%auto)
+ (%admit))
+
+(%autoprove natp-of-*
+            (%restrict default * (equal a 'a)))
+
+(%autoprove *-when-not-natp-left-cheap
+            (%restrict default * (equal a 'a)))
+
+(%autoprove *-when-not-natp-right-cheap
+            (%dec-induction a)
+            (%restrict default * (equal a 'a)))
+
+(%autoprove *-when-zp-left-cheap
+            (%restrict default * (equal a 'a)))
+
+(%autoprove *-when-zp-right-cheap
+            (%dec-induction a)
+            (%restrict default * (equal a 'a)))
+
+(%autoprove |(* 0 a)|
+            (%restrict default * (equal a ''0)))
+
+(%autoprove |(* a 0)|
+            (%dec-induction a)
+            (%restrict default * (equal a 'a)))
+
+(%autoprove |(* (nfix a) b)|
+            (%enable default nfix))
+
+(%autoprove |(* a (nfix b))|
+            (%enable default nfix))
+
+(%autoprove |(* 1 a)|
+            (%restrict default * (equal a ''1)))
+
+(%autoprove |(* a 1)|
+            (%dec-induction a)
+            (%restrict default * (equal a 'a)))
+
+(%autoprove |(equal (* a b) 0)|
+            (%dec-induction a)
+            (%restrict default * (equal a 'a)))
+
+(%autoprove |(* (+ a c) b)|
+            (%dec-induction a)
+            (%restrict default *
+                       (or (equal a '(+ '1 c))
+                           (equal a '(+ a c))
+                           (equal a 'a)
+                           (equal a 'c))))
+
+(%autoprove |(* a (+ b c))|
+            (%dec-induction a)
+            (%restrict default *
+                       (and (equal a 'a)
+                            (or (equal b 'b)
+                                (equal b '(+ b c))
+                                (equal b 'c)))))
+
+(%autoprove |(* (- a b) c)|
+            (%dec-dec-induction a b)
+            (%restrict default *
+                       (and (equal b 'c)
+                            (or (equal a '(- a b))
+                                (equal a '(- a '1))
+                                (equal a 'a)
+                                (equal a 'b)))))
+
+(%autoprove |(* a (- b c))|
+            (%dec-induction a)
+            (%restrict default *
+                       (and (equal a 'a)
+                            (or (equal b 'b)
+                                (equal b 'c)
+                                (equal b '(- b c)))))
+            (%disable default |(* (- a b) c)|))
+
+(%autoprove |(< a (* a b))|
+            (%dec-induction a))
+
+(%autoprove |(< b (* a b))|
+            (%dec-induction a)
+            (%restrict default * (equal a 'a))
+            (%disable default |(* (- a b) c)|))
+
+(%autoprove |(< (* a b) a)|
+            (%dec-induction a))
+
+(%autoprove |(< (* a b) b)|
+            (%dec-induction a))
+
+(%autoprove |(< (* a c) (* b c))|
+            (%dec-dec-induction a b))
+
+(%autoprove |(< (* a b) (* a c))|
+            (%dec-induction a))
+
+(%autoprove associativity-of-*
+            (%dec-induction a))
+
+(%autoprove commutativity-of-*
+            (%dec-induction a))
+
+(%autoprove commutativity-of-*-two
+            (%use (%instance (%thm commutativity-of-*)
+                             (a a) (b (* b c)))))
+
+(%autoprove |(= a (* a b))|
+            (%restrict default *
+                       (or (and (equal a 'a) (equal b 'b))
+                           (and (equal a 'b) (equal b '(- a '1)))))
+            (%disable default |(* a (- b c))|))
+
+(%autoprove |(= 1 (* a b))|
+            (%restrict default * (and (equal a 'a) (equal b 'b)))
+            (%use (%instance (%thm |(* a (- b c))|)
+                             (a b) (b a) (c 1)))
+            (%disable default |(* a (- b c))|))
+
+
+;; Keeping current with ACL2 file if any theorems are added:
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/arithmetic/multiply"
+                                         ;; no rules are missing, but if we wanted
+                                         ;; to exclude some, we'd list them here.
+                                         )
+
+
+;; When you're done with a bunch of files, you can save an events file like
+;; this.  The %finish command inserts a finish command so that processing the
+;; .events file gives you a new image with the events loaded.  You should also
+;; clear out the thmfiles table any time you run save-events, so you don't
+;; process the same events again later.  I typically do this once per
+;; directory.
+
+(%finish "user")
+(%save-events "user.events")
+(ACL2::table tactic-harness 'thmfiles nil)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/user/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/user/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/user/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/user/symmetry	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/user-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/acl2-customization.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/all-at-leastp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/all-at-leastp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/all-at-leastp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/all-at-leastp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,50 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "nat-listp")
+(include-book "all-equalp")
+(%interactive)
+
+(%deflist all-at-leastp (n x)
+          (< x n)
+          :negatedp t)
+
+(%autoprove all-at-leastp-when-all-equalp
+            (%cdr-induction x))
+
+(%autoprove all-at-leastp-of-zero
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/all-at-leastp")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/all-equalp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/all-equalp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/all-equalp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/all-equalp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,50 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%deflist all-equalp (b x)
+          (equal b x))
+
+(%autoprove car-when-all-equalp)
+
+(%autoprove all-equalp-of-repeat-free)
+
+(%autoprove all-equalp-when-all-equalp-free
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../all-equalp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/cert.image acl2-6.3/books/milawa/ACL2/bootstrap/utilities/cert.image
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/cert.image	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1 @@
+utilities-symmetry
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/clean-update.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/clean-update.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/clean-update.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/clean-update.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,48 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(%autoadmit clean-update)
+
+(%autoprove clean-update-when-not-consp
+  (%restrict default clean-update (equal map 'map)))
+
+(%autoprove clean-update-of-cons
+  (%restrict default clean-update (equal map '(cons a map))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/cons-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/cons-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/cons-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/cons-listp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,42 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%deflist cons-listp (x)
+  (consp x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/cons-listp")
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/cons-onto-ranges.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/cons-onto-ranges.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/cons-onto-ranges.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/cons-onto-ranges.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,48 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%autoadmit cons-onto-ranges)
+(%autoprove cons-onto-ranges-when-not-consp (%restrict default cons-onto-ranges (equal x 'x)))
+(%autoprove cons-onto-ranges-of-cons        (%restrict default cons-onto-ranges (equal x '(cons b x))))
+(%autoprove cons-onto-ranges-of-list-fix    (%cdr-induction x))
+(%autoprove true-listp-of-cons-onto-ranges  (%cdr-induction x))
+(%autoprove cons-onto-ranges-of-app         (%cdr-induction x))
+(%autoprove mapp-of-cons-onto-ranges        (%cdr-induction x))
+(%autoprove domain-of-cons-onto-ranges      (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/cons-onto-ranges")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/defaggregate.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/defaggregate.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/defaggregate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/defaggregate.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,113 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+
+(defun %make-accessors (name fields)
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons `(%autoadmit ,(accessor-name name (car fields)))
+            (%make-accessors name (cdr fields)))
+    nil))
+
+(defun %make-accessor-of-constructor (name field)
+  (declare (xargs :mode :program))
+  `(%autoprove ,(ACL2::mksym (accessor-name name field) '-of- (constructor-name name))
+               (%enable default
+                        ,(accessor-name name field)
+                        ,(constructor-name name))))
+
+(defun %make-accessors-of-constructor-aux (name fields)
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons (%make-accessor-of-constructor name (car fields))
+            (%make-accessors-of-constructor-aux name (cdr fields)))
+    nil))
+
+(defun %make-accessors-of-constructor (name fields)
+  (declare (xargs :mode :program))
+  (%make-accessors-of-constructor-aux name fields))
+
+(defun %make-requirement-of-recognizer (name require accnames)
+  (declare (xargs :mode :program))
+  `(%autoprove ,(ACL2::mksym 'forcing- (first require))
+               (%enable default
+                        ,(recognizer-name name)
+                        ,@accnames)))
+
+(defun %make-requirements-of-recognizer-aux (name require accnames)
+  (declare (xargs :mode :program))
+  (if (consp require)
+      (cons (%make-requirement-of-recognizer name (car require) accnames)
+            (%make-requirements-of-recognizer-aux name (cdr require) accnames))
+    nil))
+
+(defun %make-requirements-of-recognizer (name require fields)
+  (declare (xargs :mode :program))
+  (%make-requirements-of-recognizer-aux name require (accessor-names name fields)))
+
+
+(defmacro %defaggregate (name fields &key require)
+  ;; BOZO change defaggregate so it stores its name, fields, and requirements
+  ;; in a table; then we can change the defaggregate in one place and
+  ;; %defaggregate can consult these tables instead of needing to be a whole
+  ;; copy of them big form.
+  (declare (ACL2::ignorable name fields require))
+  (let ((foop (recognizer-name name))
+        (make-foo (constructor-name name)))
+    (declare (ACL2::ignorable foop make-foo))
+    `(encapsulate
+      ()
+      (%autoadmit ,(recognizer-name name))
+      (%autoadmit ,(constructor-name name))
+
+      ,@(%make-accessors name fields)
+
+      (%autoprove ,(ACL2::mksym make-foo '-under-iff)
+                  (%enable default ,make-foo))
+
+      (%autoprove ,(ACL2::mksym 'booleanp-of- foop)
+                  (%enable default ,foop))
+
+      ,(if (consp require)
+           `(%autoprove ,(ACL2::mksym 'forcing- foop '-of- make-foo)
+                        (%enable default ,foop ,make-foo))
+         `(%autoprove ,(ACL2::mksym foop '-of- make-foo)
+                      (%enable default ,foop ,make-foo)))
+
+      ,@(%make-accessors-of-constructor name fields)
+      ,@(%make-requirements-of-recognizer name require fields)
+
+      )))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/deflist.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/deflist.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/deflist.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/deflist.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,331 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(%interactive)
+
+(defun %deflist-fn (name formals element negatedp hintsmap)
+  (declare (xargs :mode :program))
+  (and (or (ACL2::symbolp name)
+           (ACL2::er ACL2::hard '%deflist
+                     "Name must be a symbol, but is ~x0.~%" name))
+       (or (and (ACL2::symbol-listp formals)
+                (uniquep formals)
+                (memberp 'x formals))
+           (ACL2::er ACL2::hard '%deflist
+                     "The formals must be a list of unique symbols which ~
+                      contain x, but the formals are ~x0.~%" formals))
+       (or (and (not (memberp 'y formals))
+                (not (memberp 'a formals)))
+           (ACL2::er ACL2::hard '%deflist
+                     "As a special restriction, formals may not mention a, n, or ~
+                      y, but the formals are ~x0.~%" formals))
+       (or (and (ACL2::symbolp (car element))
+                (consp element))
+           (ACL2::er ACL2::hard '%deflist
+                     "The element transformation must be a function applied ~
+                      to the formals, but is ~x0.~%" element))
+       (or (booleanp negatedp)
+           (ACL2::er ACL2::hard '%deflist
+                     ":negatedp must be a boolean, but is ~x0.~%" negatedp))
+       (or (mapp hintsmap)
+           (ACL2::er ACL2::hard '%deflist
+                     ":hintsmap must be an alist, but is ~x0.~%" hintsmap))
+       (let ((elementp (car element)))
+
+         `(defsection ,(ACL2::mksym name '-deflist)
+
+            (local (%forcingp nil))
+
+            (ACL2::make-event (if (tactic.find-rule ',name
+                                                    (tactic.harness->world (ACL2::w ACL2::state)))
+                                  '(ACL2::value-triple :redundant)
+                                '(%autoadmit ,name)))
+
+            (ACL2::make-event (if (tactic.find-rule ',(ACL2::mksym name '-when-not-consp)
+                                                    (tactic.harness->world (ACL2::w ACL2::state)))
+                                  '(ACL2::value-triple :redundant)
+                                '(%autoprove ,(ACL2::mksym name '-when-not-consp)
+                                             ,@(or (cdr (lookup (ACL2::mksym name '-when-not-consp) hintsmap))
+                                                   `((%restrict default ,name (equal x 'x)))))))
+            (local (%enable default ,(ACL2::mksym name '-when-not-consp)))
+
+            (ACL2::make-event (if (tactic.find-rule ',(ACL2::mksym name '-of-cons)
+                                                    (tactic.harness->world (ACL2::w ACL2::state)))
+                                  '(ACL2::value-triple :redundant)
+                                '(%autoprove ,(ACL2::mksym name '-of-cons)
+                                             ,@(or (cdr (lookup (ACL2::mksym name '-of-cons) hintsmap))
+                                                   `((%restrict default ,name (equal x '(cons a x))))))))
+            (local (%enable default ,(ACL2::mksym name '-of-cons)))
+
+            (ACL2::make-event (if (tactic.find-rule ',(ACL2::mksym 'booleanp-of- name)
+                                                    (tactic.harness->world (ACL2::w ACL2::state)))
+                                  '(ACL2::value-triple :redundant)
+                                '(%autoprove ,(ACL2::mksym 'booleanp-of- name)
+                                             ,@(or (cdr (lookup (ACL2::mksym 'booleanp-of- name) hintsmap))
+                                                   `((%cdr-induction x))))))
+            (local (%enable default ,(ACL2::mksym 'booleanp-of- name)))
+
+            (%autoprove ,(ACL2::mksym name '-of-list-fix)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-list-fix) hintsmap))
+                              `((%cdr-induction x))))
+            (local (%enable default ,(ACL2::mksym name '-of-list-fix)))
+
+            (%autoprove ,(ACL2::mksym name '-of-app)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-app) hintsmap))
+                              `((%cdr-induction x))))
+            (local (%enable default ,(ACL2::mksym name '-of-app)))
+
+            (%autoprove ,(ACL2::mksym name '-of-rev)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-rev) hintsmap))
+                              `((%cdr-induction x))))
+            (local (%enable default ,(ACL2::mksym name '-of-rev)))
+
+            (%autoprove ,(ACL2::mksym elementp '-of-car-when- name)
+                        ,@(cdr (lookup (ACL2::mksym elementp '-of-car-when- name) hintsmap)))
+            (local (%enable default ,(ACL2::mksym elementp '-of-car-when- name)))
+
+            (%autoprove ,(ACL2::mksym name '-of-cdr-when- name)
+                        ,@(cdr (lookup (ACL2::mksym name '-of-cdr-when- name) hintsmap)))
+            (local (%enable default ,(ACL2::mksym name '-of-cdr-when- name)))
+
+            (%autoprove ,(ACL2::mksym elementp '-when-memberp-of- name)
+                        ,@(or (cdr (lookup (ACL2::mksym elementp '-when-memberp-of- name) hintsmap))
+                              `((%cdr-induction x))))
+            (local (%enable default ,(ACL2::mksym elementp '-when-memberp-of- name)))
+
+            (%autoprove ,(ACL2::mksym elementp '-when-memberp-of- name '-alt)
+                        ,@(or (cdr (lookup (ACL2::mksym elementp '-when-memberp-of- name '-alt) hintsmap))
+                              `((%use (%thm ,(ACL2::mksym elementp '-when-memberp-of- name))))))
+            (local (%enable default ,(ACL2::mksym elementp '-when-memberp-of- name '-alt)))
+
+            (%autoprove ,(ACL2::mksym name '-of-remove-all-when- name)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-remove-all-when- name) hintsmap))
+                              `((%cdr-induction x))))
+            (local (%enable default ,(ACL2::mksym name '-of-remove-all-when- name)))
+
+            (%autoprove ,(ACL2::mksym name '-of-remove-duplicates)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-remove-duplicates) hintsmap))
+                              `((%cdr-induction x))))
+            (local (%enable default ,(ACL2::mksym name '-of-remove-duplicates)))
+
+            (%autoprove ,(ACL2::mksym name '-of-difference-when- name)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-difference-when- name) hintsmap))
+                              `((%cdr-induction x))))
+            (local (%enable default ,(ACL2::mksym name '-of-difference-when- name)))
+
+            (%autoprove ,(ACL2::mksym name '-of-subsetp-when- name)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-subsetp-when- name) hintsmap))
+                              `((%cdr-induction x))))
+            (local (%enable default ,(ACL2::mksym name '-of-subsetp-when- name)))
+
+            (%autoprove ,(ACL2::mksym name '-of-subsetp-when- name '-alt)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-subsetp-when- name '-alt) hintsmap))
+                              nil))
+            (local (%enable default ,(ACL2::mksym name '-of-subsetp-when- name '-alt)))
+
+            (%autoprove ,(ACL2::mksym name '-of-repeat)
+                        ,@(or (cdr (lookup (ACL2::mksym name '-of-repeat) hintsmap))
+                              `((%dec-induction y)
+                                (%restrict default repeat (equal n 'y)))))
+            (local (%enable default ,(ACL2::mksym name '-of-repeat)))
+
+            ))))
+
+(defmacro %deflist (name formals element &key negatedp hintsmap)
+  (%deflist-fn name formals element negatedp hintsmap))
+
+
+
+
+(defun %defprojection-fn (list element nil-preservingp hintsmap)
+  (declare (xargs :mode :program))
+  (let* ((list-fn   (car list))
+         (elem-fn   (car element))
+         ;; (elem-args (cdr element))
+         (fast-fn   (if (ACL2::has-namespace list-fn)
+                        (ACL2::mksym (ACL2::extract-namespace list-fn)
+                               '.fast-
+                               (ACL2::extract-nonnamespace list-fn)
+                               '$)
+                      (ACL2::mksym 'fast- list-fn '$))))
+    `(defsection ,list-fn
+
+       (local (%forcingp nil))
+
+       (ACL2::make-event (if (tactic.find-rule ',list-fn
+                                               (tactic.harness->world (ACL2::w ACL2::state)))
+                             '(ACL2::value-triple :redundant)
+                           '(%autoadmit ,list-fn)))
+
+       (ACL2::make-event (if (or (tactic.find-rule ',fast-fn
+                                                   (tactic.harness->world (ACL2::w ACL2::state)))
+                                 (not (ACL2::get-untranslated-defun ',fast-fn (ACL2::w ACL2::state))))
+                             '(ACL2::value-triple :redundant)
+                           '(%autoadmit ,fast-fn)))
+
+       (ACL2::make-event (if (tactic.find-rule ',(ACL2::mksym list-fn '-when-not-consp)
+                                               (tactic.harness->world (ACL2::w ACL2::state)))
+                             '(ACL2::value-triple :redundant)
+                           '(%autoprove ,(ACL2::mksym list-fn '-when-not-consp)
+                                        ,@(or (cdr (lookup (ACL2::mksym list-fn '-when-not-consp) hintsmap))
+                                              `((%restrict default ,list-fn (equal x 'x)))))))
+       (local (%enable default ,(ACL2::mksym list-fn '-when-not-consp)))
+
+       (ACL2::make-event (if (tactic.find-rule ',(ACL2::mksym list-fn '-of-cons)
+                                               (tactic.harness->world (ACL2::w ACL2::state)))
+                             '(ACL2::value-triple :redundant)
+                           '(%autoprove ,(ACL2::mksym list-fn '-of-cons)
+                                        ,@(or (cdr (lookup (ACL2::mksym list-fn '-of-cons) hintsmap))
+                                              `((%restrict default ,list-fn (equal x '(cons a x))))))))
+       (local (%enable default ,(ACL2::mksym list-fn '-of-cons)))
+
+       (%autoprove ,(ACL2::mksym 'true-listp-of- list-fn)
+                   ,@(or (cdr (lookup (ACL2::mksym 'true-listp-of- list-fn) hintsmap))
+                         `((%cdr-induction x))))
+       (local (%enable default ,(ACL2::mksym 'true-listp-of- list-fn)))
+
+       (%autoprove ,(ACL2::mksym 'len-of- list-fn)
+                   ,@(or (cdr (lookup (ACL2::mksym 'len-of- list-fn) hintsmap))
+                         `((%cdr-induction x))))
+       (local (%enable default ,(ACL2::mksym 'len-of- list-fn)))
+
+       (%autoprove ,(ACL2::mksym 'consp-of- list-fn)
+                   ,@(or (cdr (lookup (ACL2::mksym 'consp-of- list-fn) hintsmap))
+                         `((%cdr-induction x))))
+       (local (%enable default ,(ACL2::mksym 'consp-of- list-fn)))
+
+       (%autoprove ,(ACL2::mksym 'car-of- list-fn)
+                   ,@(cdr (lookup (ACL2::mksym 'car-of- list-fn) hintsmap)))
+       (local (%enable default ,(ACL2::mksym 'car-of- list-fn)))
+
+       (%autoprove ,(ACL2::mksym 'cdr-of- list-fn)
+                   ,@(cdr (lookup (ACL2::mksym 'cdr-of- list-fn) hintsmap)))
+       (local (%enable default ,(ACL2::mksym 'cdr-of- list-fn)))
+
+       (%autoprove ,(ACL2::mksym list-fn '-under-iff)
+                   ,@(cdr (lookup (ACL2::mksym list-fn '-under-iff) hintsmap)))
+       (local (%enable default ,(ACL2::mksym list-fn '-under-iff)))
+
+       (%autoprove ,(ACL2::mksym list-fn '-of-list-fix)
+                   ,@(or (cdr (lookup (ACL2::mksym list-fn '-of-list-fix) hintsmap))
+                         `((%cdr-induction x))))
+       (local (%enable default ,(ACL2::mksym list-fn '-of-list-fix)))
+
+       (%autoprove ,(ACL2::mksym list-fn '-of-app)
+                   ,@(or (cdr (lookup (ACL2::mksym list-fn '-of-app) hintsmap))
+                         `((%cdr-induction x))))
+       (local (%enable default ,(ACL2::mksym list-fn '-of-app)))
+
+       (%autoprove ,(ACL2::mksym 'rev-of- list-fn)
+                   ,@(or (cdr (lookup (ACL2::mksym 'rev-of- list-fn) hintsmap))
+                         `((%cdr-induction x))))
+       (local (%enable default ,(ACL2::mksym 'rev-of- list-fn)))
+
+       (%autoprove ,(ACL2::mksym list-fn '-of-rev)
+                   ,@(cdr (lookup (ACL2::mksym list-fn '-of-rev) hintsmap)))
+       ;; DO NOT ENABLE THIS (it will loop with rev-of-list-fn)
+       ;; (local (%enable default ,(ACL2::mksym list-fn '-of-rev)))
+
+       (%autoprove ,(ACL2::mksym 'firstn-of- list-fn)
+                   ,@(or (cdr (lookup (ACL2::mksym 'firstn-of- list-fn) hintsmap))
+                         `((%autoinduct firstn y x)
+                           (%restrict default firstn (equal n 'y)))))
+       (local (%enable default ,(ACL2::mksym 'firstn-of- list-fn)))
+
+       (%autoprove ,(ACL2::mksym 'restn-of- list-fn)
+                   ,@(or (cdr (lookup (ACL2::mksym 'restn-of- list-fn) hintsmap))
+                         `((%autoinduct restn y x)
+                           (%restrict default restn (equal n 'y)))))
+       (local (%enable default ,(ACL2::mksym 'restn-of- list-fn)))
+
+       (%autoprove ,(ACL2::mksym 'memberp-of- elem-fn '-in- list-fn '-when-memberp)
+                   ,@(or (cdr (lookup (ACL2::mksym 'memberp-of- elem-fn '-in- list-fn '-when-memberp) hintsmap))
+                         `((%cdr-induction x))))
+       (local (%enable default ,(ACL2::mksym 'memberp-of- elem-fn '-in- list-fn '-when-memberp)))
+
+       (%autoprove ,(ACL2::mksym 'subsetp-of- list-fn 's-when-subsetp)
+                   ,@(or (cdr (lookup (ACL2::mksym 'subsetp-of- list-fn 's-when-subsetp) hintsmap))
+                         `((%cdr-induction x))))
+       (local (%enable default ,(ACL2::mksym 'subsetp-of- list-fn 's-when-subsetp)))
+
+      ,@(if nil-preservingp
+
+            `((%autoprove ,(ACL2::mksym 'nth-of- list-fn)
+                          ,@(or (cdr (lookup (ACL2::mksym 'nth-of- list-fn) hintsmap))
+                                `((%autoinduct nth)
+                                  (%restrict default nth (equal n 'n)))))
+              (local (%enable default ,(ACL2::mksym 'nth-of- list-fn))))
+
+          nil)
+
+      (ACL2::make-event (if (not (lookup ',fast-fn (tactic.harness->atbl (ACL2::w ACL2::state))))
+                            '(ACL2::value-triple :invisible)
+                          '(%autoprove ,(ACL2::mksym fast-fn '-removal)
+                                       ,@(or (cdr (lookup (ACL2::mksym fast-fn '-removal) hintsmap))
+                                             `((%autoinduct ,fast-fn)
+                                               ;;(%induct (rank x)
+                                               ;;         ((not (consp x))
+                                               ;;          nil)
+                                               ;;         ((consp x)
+                                               ;;          (((x   (cdr x))
+                                               ;;            (acc (cons (,elem-fn ,@(ACL2::subst '(car x) 'x elem-args)) acc))))))
+                                               (%restrict default ,fast-fn (equal x 'x)))))))
+
+      )))
+
+
+
+(defmacro %defprojection (&key list element nil-preservingp hintsmap)
+  (declare (xargs :guard (and (ACL2::symbol-listp list)
+                              (ACL2::symbol-listp element)
+                              (booleanp nil-preservingp)
+                              (consp list)
+                              (consp element)
+                              (uniquep (cdr list))
+                              (let ((element-vars (remove-constants (cdr element))))
+                                (and (uniquep element-vars)
+                                     (memberp 'x element-vars)
+                                     (not (memberp 'a element-vars))
+                                     (not (memberp 'y element-vars))
+                                     (not (memberp 'acc element-vars))
+                                     (subsetp element-vars (cdr list))
+                                     (subsetp (cdr list) element-vars))))))
+  (%defprojection-fn list element nil-preservingp hintsmap))
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/defmap.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/defmap.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/defmap.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/defmap.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,164 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(%interactive)
+
+(defun %defmap-fn (map key val key-list val-list val-of-nil)
+  (declare (xargs :mode :program))
+  (let ((mapp (car map))
+        (keyp (car key))
+        (valp (car val))
+        (key-listp (car key-list))
+        (val-listp (car val-list))
+        ;(map-formals (cdr map))
+        ;(key-formals (cdr key))
+        ;(val-formals (cdr val))
+        ;(key-list-formals (cdr key-list))
+        ;(val-list-formals (cdr val-list))
+        )
+    `(defsection ,mapp
+
+       (local (%forcingp nil))
+
+       (%autoadmit ,mapp)
+
+       (%autoprove ,(ACL2::mksym mapp '-when-not-consp)
+                   (%restrict default ,mapp (equal x 'x)))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-cons)
+                   (%restrict default ,mapp (equal x '(cons a x))))
+
+       (%autoprove ,(ACL2::mksym 'consp-when-memberp-of- mapp)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym 'consp-when-memberp-of- mapp '-alt))
+
+       (local (%disable default
+                        ,(ACL2::mksym 'consp-when-memberp-of- mapp)
+                        ,(ACL2::mksym 'consp-when-memberp-of- mapp '-alt)))
+
+       (%autoprove ,(ACL2::mksym keyp '-of-car-when-memberp-of- mapp)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym keyp '-when-lookup-in- mapp)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym valp '-of-cdr-when-memberp-of- mapp)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym 'booleanp-of- mapp)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-list-fix)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-app)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-rev)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-remove-all-when- mapp)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-remove-duplicates)
+                   (%cdr-induction x)
+                   (%enable default ,(ACL2::mksym 'consp-when-memberp-of- mapp)))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-difference-when- mapp)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-subset-when- mapp)
+                   (%cdr-induction x)
+                   (%enable default ,(ACL2::mksym 'consp-when-memberp-of- mapp)))
+
+       (%autoprove ,(ACL2::mksym mapp '-of-subset-when- mapp '-alt))
+
+       ,@(if (not key-list)
+             nil
+           `((%autoprove ,(ACL2::mksym key-listp '-of-domain-when- mapp)
+                         (%cdr-induction x))))
+
+       ,@(if (not val-list)
+             nil
+           `((%autoprove ,(ACL2::mksym val-listp '-of-range-when- mapp)
+                         (%cdr-induction x))))
+
+       (%autoprove ,(ACL2::mksym 'mapp-when- mapp)
+                   (%cdr-induction x))
+
+       (%autoprove ,(ACL2::mksym valp '-of-cdr-of-lookup-when- mapp)
+                   (%cdr-induction x))
+
+       ,@(if val-of-nil
+             nil
+           `((%autoprove ,(ACL2::mksym 'cdr-of-lookup-under-iff-when- mapp)
+                         (%use (%instance (%thm ,(ACL2::mksym valp '-of-cdr-of-lookup-when- mapp))))
+                         (%disable default ,(ACL2::mksym valp '-of-cdr-of-lookup-when- mapp)))))
+
+       )))
+
+(defmacro %defmap (&key map key val key-list val-list (val-of-nil 't))
+  (declare (xargs :guard (and (ACL2::symbol-listp map)
+                              (ACL2::symbol-listp key)
+                              (ACL2::symbol-listp val)
+                              (ACL2::symbol-listp key-list)
+                              (ACL2::symbol-listp val-list)
+                              (consp map)
+                              (consp key)
+                              (consp val)
+                              (or (consp key-list) (not key-list))
+                              (or (consp val-list) (not val-list))
+                              ;; Argument lists must all be unique
+                              (uniquep (cdr map))
+                              (uniquep (cdr key))
+                              (uniquep (cdr val))
+                              (uniquep (cdr key-list))
+                              (uniquep (cdr val-list))
+                              ;; Argument lists must contain only the names in
+                              ;; the map formals
+                              (subsetp (cdr key) (cdr map))
+                              (subsetp (cdr val) (cdr map))
+                              (or (not key-list)
+                                  (subsetp (cdr key-list) (cdr map)))
+                              (or (not val-list)
+                                  (subsetp (cdr val-list) (cdr map)))
+                              ;; x must be in each argument list
+                              ;; a,b must not be found in any argument list
+                              (memberp 'x (cdr map))
+                              (not (memberp 'a (cdr map)))
+                              (not (memberp 'y (cdr map))))))
+  (%defmap-fn map key val key-list val-list val-of-nil))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/extended-subsets.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/extended-subsets.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/extended-subsets.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/extended-subsets.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,176 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "cons-listp")
+(include-book "remove-duplicates-list")
+(%interactive)
+
+
+(%autoadmit superset-of-somep)
+(%autoprove superset-of-somep-when-not-consp         (%restrict default superset-of-somep (equal x 'x)))
+(%autoprove superset-of-somep-of-cons                (%restrict default superset-of-somep (equal x '(cons b x))))
+(%autoprove booleanp-of-superset-of-somep            (%cdr-induction x))
+(%autoprove superset-of-somep-of-list-fix-one        (%cdr-induction x))
+(%autoprove superset-of-somep-of-list-fix-two        (%cdr-induction x))
+(%autoprove superset-of-somep-of-app                 (%cdr-induction x))
+(%autoprove superset-of-somep-of-rev                 (%cdr-induction x))
+(%autoprove memberp-when-not-superset-of-somep-cheap (%cdr-induction x))
+(%autoprove superset-of-somep-when-obvious           (%cdr-induction x))
+(%autoprove superset-of-somep-when-obvious-alt)
+
+
+(%autoadmit find-subset)
+(%autoprove find-subset-when-not-consp         (%restrict default find-subset (equal x 'x)))
+(%autoprove find-subset-of-cons                (%restrict default find-subset (equal x '(cons b x))))
+(%autoprove find-subset-of-list-fix-one        (%cdr-induction x))
+(%autoprove find-subset-of-list-fix-two        (%cdr-induction x))
+(%autoprove find-subset-of-rev-one             (%cdr-induction x))
+(%autoprove subsetp-of-find-subset             (%cdr-induction x))
+(%autoprove memberp-of-find-subset             (%cdr-induction x))
+(%autoprove superset-of-somep-when-find-subset (%cdr-induction x))
+(%autoprove find-subset-of-app                 (%cdr-induction x))
+(%autoprove find-subset-when-subsetp-two       (%cdr-induction x))
+
+(%autoprove superset-of-somep-when-subsetp-two
+            (%disable default superset-of-somep-when-obvious superset-of-somep-when-obvious-alt)
+            (%use (%instance (%thm superset-of-somep-when-obvious)
+                             (a a)
+                             (e (find-subset a x))
+                             (x y))))
+
+(%autoprove superset-of-somep-when-subsetp-two-alt)
+(%autoprove superset-of-somep-when-superset-of-somep-of-smaller     (%cdr-induction x))
+(%autoprove superset-of-somep-when-superset-of-somep-of-smaller-alt (%cdr-induction x))
+
+
+(%deflist all-superset-of-somep (x ys)
+          (superset-of-somep x ys))
+
+(%autoprove all-superset-of-somep-of-list-fix-two               (%cdr-induction x))
+(%autoprove all-superset-of-somep-of-cons-two                   (%cdr-induction x))
+(%autoprove all-superset-of-somep-of-all-two                    (%cdr-induction x))
+(%autoprove all-superset-of-somep-of-all-two-alt                (%cdr-induction x))
+(%autoprove all-superset-of-somep-of-rev-two                    (%cdr-induction x))
+(%autoprove all-superset-of-somep-when-subsetp-two              (%cdr-induction x))
+(%autoprove all-superset-of-somep-when-subsetp-two-alt          (%cdr-induction x))
+(%autoprove all-superset-of-somep-of-cons-two-when-irrelevant   (%cdr-induction x))
+(%autoprove all-superset-of-somep-of-app-two-when-irrelevant    (%cdr-induction y))
+(%autoprove superset-of-somep-when-all-superset-of-somep        (%cdr-induction x))
+(%autoprove superset-of-somep-when-all-superset-of-somep-alt)
+(%autoprove all-superset-of-somep-is-reflexive                  (%cdr-induction x))
+(%autoprove all-superset-of-somep-is-transitive                 (%cdr-induction x))
+(%autoprove all-superset-of-somep-of-remove-duplicates-list     (%cdr-induction x))
+(%autoprove all-superset-of-somep-of-remove-duplicates-list-gen (%cdr-induction x))
+
+
+(%autoadmit remove-supersets1)
+
+(%autoprove remove-supersets1-when-not-consp                  (%restrict default remove-supersets1 (equal todo 'x)))
+(%autoprove remove-supersets1-of-cons                         (%restrict default remove-supersets1 (equal todo '(cons a x))))
+(%autoprove true-listp-of-remove-supersets1                   (%autoinduct remove-supersets1 x done))
+(%autoprove uniquep-of-remove-supersets1                      (%autoinduct remove-supersets1 todo done))
+(%autoprove all-superset-of-somep-of-remove-supersets1        (%autoinduct remove-supersets1 todo done))
+(%autoprove cons-listp-when-not-superset-of-some-is-non-consp (%cdr-induction x))
+(%autoprove cons-listp-of-remove-supersets1                   (%autoinduct remove-supersets1 todo done))
+
+
+
+(%autoadmit remove-supersets)
+(%autoprove true-listp-of-remove-supersets                (%enable default remove-supersets))
+(%autoprove all-superset-of-somep-of-remove-supersets     (%enable default remove-supersets))
+(%autoprove all-superset-of-somep-of-remove-supersets-gen (%enable default remove-supersets))
+(%autoprove cons-listp-of-remove-supersets                (%enable default remove-supersets))
+
+
+
+(%autoadmit subset-of-somep)
+(%autoprove subset-of-somep-when-not-consp         (%restrict default subset-of-somep (equal x 'x)))
+(%autoprove subset-of-somep-of-cons                (%restrict default subset-of-somep (equal x '(cons b x))))
+(%autoprove booleanp-of-subset-of-somep            (%cdr-induction x))
+(%autoprove subset-of-somep-of-list-fix-one        (%cdr-induction x))
+(%autoprove subset-of-somep-of-list-fix-two        (%cdr-induction x))
+(%autoprove subset-of-somep-of-app                 (%cdr-induction x))
+(%autoprove subset-of-somep-of-rev                 (%cdr-induction x))
+(%autoprove memberp-when-not-subset-of-somep-cheap (%cdr-induction x))
+(%autoprove subset-of-somep-when-obvious           (%cdr-induction x))
+(%autoprove subset-of-somep-when-obvious-alt)
+
+
+(%autoadmit find-superset)
+
+(%autoprove find-superset-when-not-consp       (%restrict default find-superset (equal x 'x)))
+(%autoprove find-superset-of-cons              (%restrict default find-superset (equal x '(cons b x))))
+(%autoprove find-superset-of-list-fix-one      (%cdr-induction x))
+(%autoprove find-superset-of-list-fix-two      (%cdr-induction x))
+(%autoprove find-superset-of-rev-one           (%cdr-induction x))
+(%autoprove subsetp-of-find-superset           (%cdr-induction x))
+(%autoprove memberp-of-find-superset           (%cdr-induction x))
+(%autoprove subset-of-somep-when-find-superset (%cdr-induction x))
+(%autoprove find-superset-when-subsetp-two     (%cdr-induction x))
+
+(%autoprove subset-of-somep-when-subsetp-two
+            (%disable default subset-of-somep-when-obvious subset-of-somep-when-obvious-alt)
+            (%use (%instance (%thm subset-of-somep-when-obvious)
+                             (a a)
+                             (e (find-superset a x))
+                             (x y))))
+
+(%autoprove subset-of-somep-when-subsetp-two-alt)
+(%autoprove subset-of-somep-when-subset-of-somep-of-smaller     (%cdr-induction x))
+(%autoprove subset-of-somep-when-subset-of-somep-of-smaller-alt (%cdr-induction x))
+
+
+(%deflist all-subset-of-somep (x ys)
+          (subset-of-somep x ys))
+
+(%autoprove all-subset-of-somep-of-list-fix-two               (%cdr-induction x))
+(%autoprove all-subset-of-somep-of-cons-two                   (%cdr-induction x))
+(%autoprove all-subset-of-somep-of-all-two                    (%cdr-induction x))
+(%autoprove all-subset-of-somep-of-all-two-alt                (%cdr-induction x))
+(%autoprove all-subset-of-somep-of-rev-two                    (%cdr-induction x))
+(%autoprove all-subset-of-somep-when-subsetp-two              (%cdr-induction x))
+(%autoprove all-subset-of-somep-when-subsetp-two-alt          (%cdr-induction x))
+(%autoprove all-subset-of-somep-of-cons-two-when-irrelevant   (%cdr-induction x))
+(%autoprove all-subset-of-somep-of-app-two-when-irrelevant    (%cdr-induction y))
+(%autoprove subset-of-somep-when-all-subset-of-somep          (%cdr-induction x))
+(%autoprove subset-of-somep-when-all-subset-of-somep-alt)
+(%autoprove all-subset-of-somep-is-reflexive                  (%cdr-induction x))
+(%autoprove all-subset-of-somep-is-transitive                 (%cdr-induction x))
+(%autoprove all-subset-of-somep-of-remove-duplicates-list     (%cdr-induction x))
+(%autoprove all-subset-of-somep-of-remove-duplicates-list-gen (%cdr-induction x))
+
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/extended-subsets")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/fast-remove-supersets.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/fast-remove-supersets.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/fast-remove-supersets.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/fast-remove-supersets.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,110 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "extended-subsets")
+(include-book "mergesort")
+(%interactive)
+
+
+(%deflist ordered-list-listp (x)
+          (ordered-listp x))
+
+(%defprojection :list (mergesort-list x)
+                :element (mergesort x)
+                :nil-preservingp t)
+
+(%autoprove ordered-list-listp-of-mergesort-list
+            (%cdr-induction x))
+
+(%autoprove superset-of-somep-of-mergesort-left
+            (%cdr-induction x))
+
+(%autoprove superset-of-somep-of-mergesort-list-right
+            (%cdr-induction x))
+
+
+(%autoadmit fast-superset-of-somep)
+
+(%autoprove fast-superset-of-somep-when-not-consp
+            (%restrict default fast-superset-of-somep (equal x 'x)))
+
+(%autoprove fast-superset-of-somep-of-cons
+            (%restrict default fast-superset-of-somep (equal x '(cons b x))))
+
+(%autoprove fast-superset-of-somep-removal
+            (%cdr-induction x)
+            (%enable default
+                     fast-superset-of-somep-when-not-consp
+                     fast-superset-of-somep-of-cons))
+
+
+
+(%autoadmit fast-remove-supersets1)
+
+(%autoprove fast-remove-supersets1-when-not-consp
+            (%restrict default fast-remove-supersets1 (equal todo-sorted 'todo-sorted)))
+
+(%autoprove fast-remove-supersets1-of-cons
+            (%restrict default fast-remove-supersets1 (equal todo-sorted '(cons a todo-sorted))))
+
+(%autoprove fast-remove-supersets1-removal
+            (%autoinduct remove-supersets1 todo done)
+            (%enable default
+                     fast-remove-supersets1-when-not-consp
+                     fast-remove-supersets1-of-cons))
+
+
+
+
+(%autoadmit cdr-10-times)
+(%autoadmit cdr-50-times)
+(%autoadmit cdr-250-times)
+(%autoadmit len-over-250p)
+(%autoadmit some-len-over-250p)
+
+(%autoadmit fast-remove-supersets)
+
+(%autoprove fast-remove-supersets-removal
+            (%enable default
+                     fast-remove-supersets
+                     remove-supersets)
+            (%disable default
+                      fast-remove-supersets1-removal
+                      [outside]fast-remove-supersets1-removal)
+            (%use (%instance (%thm fast-remove-supersets1-removal)
+                             (todo x)
+                             (done nil))))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/fast-remove-supersets")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/intersect.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/intersect.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/intersect.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/intersect.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,55 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(%interactive)
+
+(%autoadmit intersect)
+(%autoprove intersect-when-not-consp-one (%restrict default intersect (equal x 'x)))
+(%autoprove intersect-of-cons-one        (%restrict default intersect (equal x '(cons a x))))
+(%autoprove intersect-when-not-consp-two (%cdr-induction x))
+(%autoprove intersect-under-iff          (%cdr-induction x))
+(%autoprove true-listp-of-intersect      (%cdr-induction x))
+(%autoprove intersect-of-list-fix-one    (%cdr-induction x))
+(%autoprove intersect-of-list-fix-two    (%cdr-induction x))
+(%autoprove intersect-of-app-one         (%cdr-induction x))
+(%autoprove rev-of-intersect             (%cdr-induction x))
+(%autoprove intersect-of-rev-two         (%cdr-induction x))
+(%autoprove subsetp-of-intersect-one     (%cdr-induction x))
+(%autoprove subsetp-of-intersect-two     (%cdr-induction x))
+(%autoprove intersect-when-subsetp       (%cdr-induction x))
+(%autoprove intersect-with-self)
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/intersect")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/list-list-fix.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/list-list-fix.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/list-list-fix.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/list-list-fix.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,43 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%defprojection :list (list-list-fix x)
+                :element (list-fix x)
+                :nil-preservingp t)
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/list-list-fix")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/listify-each.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/listify-each.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/listify-each.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/listify-each.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,48 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cons-listp")
+(%interactive)
+
+
+(defsection listify-each
+  (local (%disable default equal-of-cons-rewrite))
+  (%defprojection :list (listify-each x)
+                  :element (list x)))
+
+(%autoprove cons-listp-of-listify-each
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/listify-each")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/make-image.lsp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/make-image.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,6 @@
+(in-package "MILAWA")
+(ACL2::include-book "../../interface/top" :ttags :all)
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../../acl2-images/utilities-symmetry"
+                 "Symmetry -- The Milawa User Interface.")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/map-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/map-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/map-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/map-listp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,65 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tuple-listp")
+(%interactive)
+
+(%deflist map-listp (x)
+          (mapp x))
+
+(%deflist submap-of-eachp (map x)
+          (submapp map x))
+
+(encapsulate
+ ()
+ (defsection lemma-for-revappend-onto-each
+   ;; BOZO localized in ACL2; unlocalize it
+   (%prove (%rule lemma-for-revappend-onto-each
+                  :hyps (list (%hyp (true-listp y)))
+                  :lhs (revappend x y)
+                  :rhs (app (rev x) y)))
+   (%auto)
+   (%qed))
+
+ (local (%enable default lemma-for-revappend-onto-each))
+ (local (%disable default forcing-revappend-removal))
+
+ (%defprojection :list (revappend-onto-each list x)
+                 :element (revappend list x)))
+
+(%autoprove forcing-submap-of-eachp-of-revappend-onto-each
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/map-listp")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/mergesort-map.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/mergesort-map.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/mergesort-map.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/mergesort-map.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,242 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "mergesort")
+(%interactive)
+
+
+(%autoadmit ordered-mapp)
+
+(%autoprove ordered-mapp-when-not-consp
+            (%restrict default ordered-mapp (equal x 'x)))
+
+(%autoprove ordered-mapp-when-not-consp-of-cdr
+            (%restrict default ordered-mapp (equal x 'x)))
+
+(%autoprove ordered-mapp-of-cons
+            (%restrict default ordered-mapp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-ordered-mapp
+            (%cdr-induction x))
+
+(%autoprove ordered-mapp-of-cdr-when-ordered-mapp)
+
+(%autoprove lemma-for-uniquep-when-ordered-mapp
+            (%cdr-induction x))
+
+(%autoprove uniquep-of-domain-when-ordered-mapp
+            (%cdr-induction x)
+            (%enable default lemma-for-uniquep-when-ordered-mapp))
+
+
+
+(%autoadmit merge-maps)
+
+(%autoprove merge-maps-when-not-consp-left
+            (%restrict default merge-maps (and (equal x 'x) (equal y 'y))))
+
+(%autoprove merge-maps-when-not-consp-right
+            (%restrict default merge-maps (and (equal x 'x) (equal y 'y))))
+
+(%autoprove merge-maps-of-cons-and-cons
+            (%restrict default merge-maps (and (or (equal x '(cons a x))
+                                                   (equal x '(cons b x)))
+                                               (or (equal y '(cons a y))
+                                                   (equal y '(cons b y))))))
+
+(%autoprove consp-of-merge-maps
+            (%restrict default merge-maps (and (equal x 'x) (equal y 'y))))
+
+(%autoprove lookup-of-first-of-first)
+
+(%autoprove lookup-when-not-first-of-first)
+
+(%autoprove smaller-than-merge-maps
+            (%autoinduct merge-maps)
+            (%restrict default merge-maps (and (equal x 'x) (equal y 'y))))
+
+(%autoprove ordered-mapp-of-merge-maps
+            (%autoinduct merge-maps x y)
+            (%restrict default merge-maps (and (equal x 'x) (equal y 'y))))
+
+(%autoprove mapp-of-merge-maps
+            (%autoinduct merge-maps x y)
+            (%restrict default merge-maps (and (equal x 'x) (equal y 'y))))
+
+(%autoprove lookup-of-merge-maps
+            (%autoinduct merge-maps x y)
+            (%restrict default merge-maps (and (equal x 'x) (equal y 'y)))
+            (%enable default
+                     lemma-2-for-ordered-list-subsetp-property
+                     lemma-for-uniquep-when-ordered-mapp))
+
+
+
+(%autoadmit mergesort-map)
+
+(%autoprove mergesort-map-when-not-consp
+            (%restrict default mergesort-map (equal x 'x)))
+
+(%autoprove mergesort-map-when-not-consp-of-cdr
+            (%restrict default mergesort-map (equal x 'x)))
+
+(%autoprove mapp-of-mergesort-map
+            (%autoinduct mergesort-map)
+            (%restrict default mergesort-map (equal x 'x)))
+
+(%autoprove ordered-mapp-of-mergesort-map
+            (%autoinduct mergesort-map)
+            (%restrict default mergesort-map (equal x 'x)))
+
+(verify-guards mergesort-map)
+
+(%autoprove uniquep-of-domain-of-mergesort-map)
+
+(%autoprove lemma-1-for-lookup-of-mergesort-map
+            (%use (%instance (%thm halve-list-lookup-property))))
+
+(%autoprove lemma-2-for-lookup-of-mergesort-map
+            (%use (%instance (%thm halve-list-lookup-property))))
+
+(%autoprove lookup-of-mergesort-map
+            (%autoinduct mergesort-map)
+            (%restrict default mergesort-map (equal x 'x))
+            (%enable default lemma-1-for-lookup-of-mergesort-map
+                             lemma-2-for-lookup-of-mergesort-map))
+
+(%autoprove submapp-of-mergesort-map-and-self-left
+            (%use (%instance (%thm submapp-badguy-membership-property)
+                             (x (mergesort-map x))
+                             (y x))))
+
+(%autoprove submapp-of-mergesort-map-and-self-right
+            (%use (%instance (%thm submapp-badguy-membership-property)
+                             (y (mergesort-map x))
+                             (x x))))
+
+(%autoprove submapp-of-mergesort-map-left)
+
+(%autoprove submapp-of-mergesort-map-right)
+
+
+
+(%autoadmit ordered-map-submapp)
+
+(%autoprove ordered-map-submapp-when-not-consp-left
+            (%restrict default ordered-map-submapp (and (equal x 'x) (equal y 'y))))
+
+(%autoprove ordered-map-submapp-when-not-consp-right
+            (%restrict default ordered-map-submapp (and (equal x 'x) (equal y 'y))))
+
+(%autoprove ordered-map-submapp-of-cons-and-cons
+            (%restrict default ordered-map-submapp (and (or (equal x '(cons a x))
+                                                            (equal x '(cons b x)))
+                                                        (or (equal y '(cons a y))
+                                                            (equal y '(cons b y))))))
+
+(%autoprove booleanp-of-ordered-map-submapp
+            (%autoinduct ordered-map-submapp x y))
+
+(%autoprove lemma-1-for-ordered-map-submapp-property)
+
+(%autoprove lemma-2-for-ordered-map-submapp-property
+            (%enable default submapp))
+
+(%autoprove lemma-3-for-ordered-map-submapp-property
+            (%disable default equal-of-lookups-when-submapp)
+            (%use (%instance (%thm equal-of-lookups-when-submapp)
+                             (x x)
+                             (y y)
+                             (a (car (car x))))))
+
+(%autoprove lemma-4-for-ordered-map-submapp-property-aux
+            (%autoinduct submapp1 dom x y)
+            (%restrict default submapp1 (equal domain 'dom)))
+
+(%autoprove lemma-4-for-ordered-map-submapp-property
+            (%enable default
+                     lemma-4-for-ordered-map-submapp-property-aux
+                     lemma-for-uniquep-when-ordered-mapp
+                     submapp))
+
+(%autoprove lemma-5-for-ordered-map-submapp-property
+            (%disable default lemma-for-uniquep-when-ordered-mapp)
+            (%use (%instance (%thm lemma-for-uniquep-when-ordered-mapp)
+                             (a (first (first x)))
+                             (x y))))
+
+(%autoprove lemma-6-for-ordered-map-submapp-property
+            (%disable default equal-of-lookups-when-submapp)
+            (%use (%instance (%thm equal-of-lookups-when-submapp)
+                             (a (first (first x)))
+                             (x x)
+                             (y y)))
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%restrict default lookup (or (equal x 'x) (equal y 'y))))
+
+(%autoprove lemma-7-for-ordered-map-submapp-property-aux
+            (%autoinduct submapp1 dom x y)
+            (%restrict default submapp1 (equal domain 'dom)))
+
+(%autoprove lemma-7-for-ordered-map-submapp-property
+            (%enable default
+                     submapp
+                     lemma-for-uniquep-when-ordered-mapp)
+            (%use (%instance (%thm lemma-7-for-ordered-map-submapp-property-aux)
+                             (dom (domain x)))))
+
+
+(%autoprove ordered-map-submapp-property
+            (%autoinduct ordered-map-submapp x y)
+            (%enable default lemma-for-uniquep-when-ordered-mapp
+                     lemma-1-for-ordered-map-submapp-property
+                             lemma-2-for-ordered-map-submapp-property
+                             lemma-3-for-ordered-map-submapp-property
+                             lemma-4-for-ordered-map-submapp-property
+                             lemma-5-for-ordered-map-submapp-property
+                             lemma-6-for-ordered-map-submapp-property
+                             lemma-7-for-ordered-map-submapp-property))
+
+(%autoprove lemma-for-ordered-listp-when-ordered-mapp
+            (%restrict default << (and (equal x 'a) (equal y 'b))))
+
+(%autoprove ordered-listp-when-ordered-mapp
+            (%cdr-induction x)
+            (%enable default lemma-for-ordered-listp-when-ordered-mapp))
+
+(%autoprove ordered-listp-of-mergesort-map)
+
+(%ensure-exactly-these-rules-are-missing "../../../utilities/mergesort")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/mergesort.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/mergesort.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/mergesort.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/mergesort.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,236 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(include-book "total-order")
+(%interactive)
+
+
+(%autoprove mapp-of-rev
+            (%cdr-induction x))
+
+(%autoadmit halve-list-aux)
+
+(%autoadmit halve-list)
+
+(%autoprove halve-list-aux-when-not-consp
+            (%autoinduct halve-list-aux)
+            (%restrict default halve-list-aux (equal x 'x)))
+
+(%autoprove halve-list-aux-when-not-consp-of-cdr
+            (%autoinduct halve-list-aux)
+            (%restrict default halve-list-aux (equal x 'x)))
+
+(%autoprove halve-list-aux-append-property
+            (%autoinduct halve-list-aux)
+            (%restrict default halve-list-aux (equal x 'x)))
+
+(%autoprove halve-list-aux-len-1
+            (%autoinduct halve-list-aux)
+            (%restrict default halve-list-aux (equal x 'x)))
+
+(%autoprove halve-list-aux-len-2
+            (%autoinduct halve-list-aux)
+            (%restrict default halve-list-aux (equal x 'x)))
+
+(%autoprove halve-list-correct
+            (%enable default halve-list))
+
+(%autoprove halve-list-len-1
+            (%enable default halve-list)
+            (%disable default halve-list-aux-len-1)
+            (%use (%instance (%thm halve-list-aux-len-1)
+                             (mid x) (x x) (acc nil))))
+
+(%autoprove halve-list-len-2
+            (%enable default halve-list))
+
+(%autoprove halve-list-membership-property
+            (%disable default memberp-of-app)
+            (%use (%instance (%thm memberp-of-app)
+                             (x (rev (car (halve-list x))))
+                             (y (cdr (halve-list x))))))
+
+(%autoprove halve-list-lookup-property
+            (%disable default lookup-of-app)
+            (%use (%instance (%thm lookup-of-app)
+                             (x (rev (car (halve-list x))))
+                             (y (cdr (halve-list x))))))
+
+(%autoprove mapp-of-first-of-halve-list-aux-1
+            (%autoinduct halve-list-aux)
+            (%restrict default halve-list-aux (equal x 'x)))
+
+(%autoprove mapp-of-first-of-halve-list-aux-2
+            (%autoinduct halve-list-aux)
+            (%restrict default halve-list-aux (equal x 'x)))
+
+(%autoprove mapp-of-first-of-halve-list-1
+            (%enable default halve-list))
+
+(%autoprove mapp-of-first-of-halve-list-2
+            (%enable default halve-list))
+
+
+(%autoadmit ordered-listp)
+
+(%autoprove ordered-listp-when-not-consp
+            (%restrict default ordered-listp (equal x 'x)))
+
+(%autoprove ordered-listp-when-not-consp-of-cdr
+            (%restrict default ordered-listp (equal x 'x)))
+
+(%autoprove ordered-listp-of-cons
+            (%restrict default ordered-listp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-ordered-listp
+            (%cdr-induction x))
+
+(%autoprove lemma-for-uniquep-when-ordered-listp
+            (%cdr-induction x))
+
+(%autoprove uniquep-when-ordered-listp
+            (%cdr-induction x)
+            (%enable default lemma-for-uniquep-when-ordered-listp))
+
+
+(%autoadmit merge-lists)
+
+(%autoprove merge-lists-when-not-consp-left
+            (%restrict default merge-lists (and (equal x 'x) (equal y 'y))))
+
+(%autoprove merge-lists-when-not-consp-right
+            (%restrict default merge-lists (and (equal x 'x) (equal y 'y))))
+
+(%autoprove merge-lists-of-cons-and-cons
+            (%restrict default merge-lists (and (or (equal x '(cons a x))
+                                                    (equal x '(cons b x)))
+                                                (or (equal y '(cons a y))
+                                                    (equal y '(cons b y))))))
+
+(%autoprove consp-of-merge-lists
+            (%autoinduct merge-lists)
+            (%restrict default merge-lists (and (equal x 'x) (equal y 'y))))
+
+(%autoprove smaller-than-merge-lists
+            (%autoinduct merge-lists)
+            (%restrict default merge-lists (and (equal x 'x) (equal y 'y))))
+
+(%autoprove ordered-listp-of-merge-lists
+            (%autoinduct merge-lists)
+            (%restrict default merge-lists (and (equal x 'x) (equal y 'y))))
+
+(%autoprove memberp-of-merge-lists
+            (%autoinduct merge-lists)
+            (%restrict default merge-lists (and (equal x 'x) (equal y 'y))))
+
+
+(%autoadmit mergesort)
+
+(%autoprove mergesort-when-not-consp
+            (%restrict default mergesort (equal x 'x)))
+
+(%autoprove mergesort-when-not-consp-of-cdr
+            (%restrict default mergesort (equal x 'x)))
+
+(%autoprove ordered-listp-of-mergesort
+            (%autoinduct mergesort)
+            (%restrict default mergesort (equal x 'x)))
+
+(%autoprove uniquep-of-mergesort
+            (%enable default uniquep-when-ordered-listp))
+
+(%autoprove lemma-for-memberp-of-mergesort
+            (%use (%instance (%thm halve-list-membership-property))))
+
+(%autoprove lemma-2-for-memberp-of-mergesort
+            (%use (%instance (%thm halve-list-membership-property))))
+
+(%autoprove memberp-of-mergesort
+            (%autoinduct mergesort)
+            (%restrict default mergesort (equal x 'x))
+            (%auto :strategy (cleanup split urewrite crewrite))
+            (%enable default
+                     lemma-for-memberp-of-mergesort
+                     lemma-2-for-memberp-of-mergesort))
+
+(%autoprove subsetp-of-mergesort-left
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x (mergesort x))
+                             (y y)))
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x x)
+                             (y y))))
+
+(%autoprove subsetp-of-mergesort-right
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x x)
+                             (y (mergesort y)))))
+
+
+
+(%autoadmit ordered-list-subsetp)
+
+(%autoprove booleanp-of-ordered-list-subsetp
+            (%autoinduct ordered-list-subsetp)
+            (%restrict default ordered-list-subsetp (and (equal x 'x) (equal y 'y))))
+
+(%autoprove lemma-1-for-ordered-list-subsetp-property)
+
+(%autoprove lemma-2-for-ordered-list-subsetp-property)
+
+(%autoprove lemma-3-for-ordered-list-subsetp-property
+            (%cdr-induction x)
+            (%enable default
+                     lemma-2-for-ordered-list-subsetp-property
+                     lemma-for-uniquep-when-ordered-listp))
+
+(%autoprove lemma-4-for-ordered-list-subsetp-property
+            (%autoinduct ordered-listp x)
+            (%enable default
+                     lemma-1-for-ordered-list-subsetp-property
+                     lemma-2-for-ordered-list-subsetp-property
+                     lemma-3-for-ordered-list-subsetp-property))
+
+(%autoprove ordered-list-subsetp-property
+            (%autoinduct ordered-list-subsetp x y)
+            (%restrict default ordered-list-subsetp (and (equal x 'x) (equal y 'y)))
+            (%enable default
+                     lemma-1-for-ordered-list-subsetp-property
+                     lemma-2-for-ordered-list-subsetp-property
+                     lemma-3-for-ordered-list-subsetp-property
+                     lemma-4-for-ordered-list-subsetp-property))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/multicons.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/multicons.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/multicons.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/multicons.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cons-listp")
+(include-book "mutually-disjoint")
+(%interactive)
+
+(%defprojection :list (multicons e x)
+                :element (cons e x))
+
+(%autoprove cons-listp-of-multicons
+            (%cdr-induction x))
+
+(%autoprove disjoint-from-nonep-of-multicons
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/multicons")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/mutually-disjoint.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/mutually-disjoint.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/mutually-disjoint.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/mutually-disjoint.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,195 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "cons-listp")
+(%interactive)
+
+
+
+(%deflist member-of-nonep (e x)
+          (memberp e x)
+          :negatedp t)
+
+
+(%autoadmit lists-lookup)
+(%autoprove lists-lookup-when-not-consp (%restrict default lists-lookup (equal xs 'xs)))
+(%autoprove lists-lookup-of-cons (%restrict default lists-lookup (equal xs '(cons x xs))))
+(%autoprove lists-lookup-of-list-fix (%cdr-induction xs))
+(%autoprove lists-lookup-of-app (%cdr-induction xs))
+(%autoprove consp-of-lists-lookup (%cdr-induction xs))
+(%autoprove lists-lookup-under-iff (%cdr-induction xs))
+(%autoprove lists-lookup-of-rev-under-iff (%cdr-induction xs))
+(%autoprove memberp-of-element-in-lists-lookup (%cdr-induction xs))
+(%autoprove memberp-of-in-lists-lookup-in-lists (%cdr-induction xs))
+
+
+
+(%deflist none-consp (x)
+          (consp x)
+          :negatedp t)
+
+(%deflist disjoint-from-allp (e x)
+          (disjointp e x))
+
+(%autoprove disjoint-from-allp-when-not-consp-left (%cdr-induction x))
+(%autoprove disjoint-from-allp-of-cons-left (%cdr-induction x))
+(%autoprove disjoint-from-allp-of-cdr-left)
+(%autoprove member-of-nonep-when-memberp-of-disjoint-from-allp (%cdr-induction x))
+(%autoprove member-of-nonep-when-memberp-of-disjoint-from-allp-alt)
+(%autoprove disjointp-when-memberp-of-disjoint-from-allp-one (%cdr-induction ys))
+(%autoprove disjointp-when-memberp-of-disjoint-from-allp-two (%cdr-induction ys))
+(%autoprove disjointp-when-memberp-of-disjoint-from-allp-three)
+(%autoprove disjointp-when-memberp-of-disjoint-from-allp-four)
+(%autoprove disjoint-from-allp-when-subsetp-of-disjoint-from-allp-one (%cdr-induction x))
+(%autoprove disjoint-from-allp-when-subsetp-of-disjoint-from-allp-two)
+(%autoprove disjoint-from-allp-when-subsetp-of-disjoint-from-allp-three (%cdr-induction ys))
+(%autoprove disjoint-from-allp-when-subsetp-of-disjoint-from-allp-four)
+
+(%autoprove disjoint-from-allp-when-memberp (%cdr-induction ys))
+(%autoprove disjoint-from-allp-of-list-fix-left)
+(%autoprove disjoint-from-allp-of-app-left (%cdr-induction x))
+(%autoprove disjoint-from-allp-of-rev-left (%cdr-induction x))
+(%autoprove remove-all-when-disjoint-from-allp-and-cons-listp (%cdr-induction x))
+
+
+(%autoadmit all-disjoint-from-allp)
+(%autoprove all-disjoint-from-allp-when-not-consp-one (%restrict default all-disjoint-from-allp (equal xs 'xs)))
+(%autoprove all-disjoint-from-allp-of-cons-one (%restrict default all-disjoint-from-allp (equal xs '(cons x xs))))
+(%autoprove all-disjoint-from-allp-when-not-consp-two (%cdr-induction xs))
+(%autoprove all-disjoint-from-allp-of-cons-two (%cdr-induction xs))
+(%autoprove booleanp-of-all-disjoint-from-allp (%cdr-induction xs))
+(%autoprove symmetry-of-all-disjoint-from-allp (%cdr-induction xs))
+(%autoprove all-disjoint-from-allp-of-list-fix-two (%cdr-induction ys))
+(%autoprove all-disjoint-from-allp-of-list-fix-one)
+(%autoprove all-disjoint-from-allp-of-app-two (%cdr-induction ys))
+(%autoprove all-disjoint-from-allp-of-app-one)
+(%autoprove all-disjoint-from-allp-of-rev-two (%cdr-induction ys))
+(%autoprove all-disjoint-from-allp-of-rev-one)
+(%autoprove all-disjoint-from-allp-when-subsetp-of-other-one (%cdr-induction xs))
+(%autoprove all-disjoint-from-allp-when-subsetp-of-other-two)
+(%autoprove disjoint-from-allp-when-memberp-of-all-disjoint-from-allp-one (%cdr-induction xs))
+(%autoprove disjoint-from-allp-when-memberp-of-all-disjoint-from-allp-two (%cdr-induction ys))
+(%autoprove disjointp-when-members-of-all-disjoint-from-allp (%cdr-induction xs))
+(%autoprove all-disjoint-from-allp-when-subsetp-of-all-disjoint-one (%cdr-induction xs))
+(%autoprove all-disjoint-from-allp-when-subsetp-of-all-disjoint-two)
+(%autoprove all-disjoint-from-allp-when-subsetp-of-all-disjoint-three (%cdr-induction ys))
+(%autoprove all-disjoint-from-allp-when-subsetp-of-all-disjoint-four)
+
+
+(%autoadmit mutually-disjointp)
+(%autoprove mutually-disjointp-when-not-consp (%restrict default mutually-disjointp (equal xs 'xs)))
+(%autoprove mutually-disjointp-of-cons (%restrict default mutually-disjointp (equal xs '(cons x xs))))
+(%autoprove booleanp-of-mutually-disjointp (%cdr-induction xs))
+(%autoprove mutually-disjointp-of-cdr-when-mutually-disjointp)
+(%autoprove mutually-disjointp-of-list-fix (%cdr-induction x))
+(%autoprove mutually-disjointp-of-app (%cdr-induction x))
+(%autoprove mutually-disjointp-of-rev (%cdr-induction x))
+(%autoprove mutually-disjointp-of-remove-all-when-mutually-disjointp (%cdr-induction x))
+(%autoprove disjointp-when-both-membersp-of-mutually-disjointp (%cdr-induction xs))
+
+
+(%autoadmit disjoint-from-allp-badguy)
+
+(defsection disjoint-from-allp-badguy-property
+  ;; BOZO the lemmas need to be unlocalized, and the defthm needs to be added to
+  ;; :rule-classes nil instead of just using defthmd, since it screws up autoprove
+  ;; to have dual conclusions.  Actually, do we want to switch this the way that we
+  ;; have done for subsetp-badguy and use the iff rule or whatever?
+  (%prove (%rule disjoint-from-allp-badguy-property
+                 :hyps (list (%hyp (not (disjoint-from-allp x ys))))
+                 :lhs (and (memberp (disjoint-from-allp-badguy x ys) ys)
+                           (not (disjointp x (disjoint-from-allp-badguy x ys))))
+                 :rhs t))
+  (%cdr-induction ys)
+  (%restrict default disjoint-from-allp-badguy (equal ys 'ys))
+  (%auto)
+  (%qed))
+
+(%autoprove disjoint-from-allp-of-remove-all-when-memberp-of-mutually-disjointp
+            (%use (%instance (%thm disjoint-from-allp-badguy-property)
+                             (x x)
+                             (ys (remove-all x xs)))))
+
+(%autoprove member-of-nonep-of-remove-all-when-mutually-disjointp
+            (%cdr-induction xs))
+
+(%autoprove disjoint-from-allp-when-subsetp-of-remove-all-of-mutually-disjointp)
+(%autoprove disjoint-from-allp-when-subsetp-of-remove-all-of-mutually-disjointp-two)
+
+
+
+(%autoprove lists-lookup-of-rev-when-mutually-disjointp (%cdr-induction xs))
+(%autoprove lists-lookup-when-memberp-in-lists-lookup-when-mutually-disjointp (%cdr-induction xs))
+
+(%autoprove lists-lookup-of-remove-all-from-mutually-disjointp
+            (%cdr-induction xs))
+
+(%autoprove lists-lookup-when-mutually-disjointp
+            (%cdr-induction xs))
+
+(%autoprove lists-lookup-of-car-of-lists-lookup
+            (%use (%instance (%thm lists-lookup-when-mutually-disjointp)
+                             (x (lists-lookup a xs))
+                             (b (car (lists-lookup a xs))))))
+
+(%autoprove member-of-nonep-when-member-of-lists-lookup
+            (%cdr-induction xs))
+
+(%autoprove member-of-nonep-when-member-of-cdr-of-lists-lookup
+            (%use (%thm member-of-nonep-when-member-of-lists-lookup)))
+
+(%autoprove member-of-nonep-of-car-of-lists-lookup
+            (%cdr-induction xs))
+
+(%autoprove member-of-lists-lookup-when-members-of-mutually-disjointp
+            (%auto)
+            (%fertilize (lists-lookup a xs) (lists-lookup c xs)))
+
+
+
+(%deflist disjoint-from-nonep (e x)
+          (disjointp e x)
+          :negatedp t)
+
+(%autoprove disjoint-from-nonep-when-not-consp-left (%cdr-induction x))
+(%autoprove disjoint-from-nonep-of-cons-left        (%cdr-induction x))
+(%autoprove disjoint-from-nonep-of-list-fix-left    (%cdr-induction x))
+(%autoprove disjoint-from-nonep-of-app-left-one     (%cdr-induction x))
+(%autoprove disjoint-from-nonep-of-app-left-two     (%cdr-induction x))
+(%autoprove disjoint-from-nonep-of-rev-left         (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/mutually-disjoint")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/nat-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/nat-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/nat-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/nat-listp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,42 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%deflist nat-listp (x)
+  (natp x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/nat-listp")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/ordered-subsetp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/ordered-subsetp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/ordered-subsetp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/ordered-subsetp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,104 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(%interactive)
+
+
+(%autoadmit ordered-subsetp)
+
+(%autoprove ordered-subsetp-when-not-consp-one
+            (%restrict default ordered-subsetp (equal y 'y)))
+
+(%autoprove ordered-subsetp-when-not-consp-two
+            (%restrict default ordered-subsetp (equal y 'y)))
+
+(%autoprove ordered-subsetp-of-cons-and-cons
+            (%restrict default ordered-subsetp (equal y '(cons b y))))
+
+(%autoprove booleanp-of-ordered-subsetp
+            (%autoinduct ordered-subsetp))
+
+(%autoprove ordered-subsetp-of-cdr-when-ordered-subsetp
+            (%induct (rank y)
+                     ((or (not (consp x))
+                          (not (consp y)))
+                      nil)
+                     ((and (consp x)
+                           (consp y))
+                      (((x (cdr x)) (y (cdr y)))
+                       ((x x) (y (cdr y)))))))
+
+(%autoprove ordered-subsetp-when-ordered-subsetp-of-cons
+            (%use (%instance (%thm ordered-subsetp-of-cdr-when-ordered-subsetp)
+                             (x (cons a x))
+                             (y y))))
+
+(%autoprove ordered-subsetp-of-cons-when-ordered-subsetp
+            (%restrict default ordered-subsetp (equal y '(cons a y))))
+
+(%autoprove ordered-subsetp-when-ordered-subsetp-of-cdr)
+
+(%autoprove ordered-subsetp-is-reflexive
+            (%cdr-induction x))
+
+(%autoprove ordered-subsetp-is-transitive
+            (%induct (+ (rank x) (+ (rank y) (rank z)))
+                     ((or (not (consp x))
+                          (not (consp y))
+                          (not (consp z)))
+                      nil)
+                     ((and (consp x)
+                           (consp y)
+                           (consp z))
+                      (((x (cdr x)) (y (cdr y)) (z (cdr z)))
+                       ((x (cdr x)) (y (cdr y)) (z z))
+                       ((x x) (y (cdr y)) (z (cdr z)))
+                       ((x x) (y y) (z (cdr z))))))
+            ;; These seem to be expensive here.  In fact this rewrite is pretty slow.
+            (%disable default squeeze-law-two |a <= b, c != 0 --> a < c+b|))
+
+(%autoprove ordered-subsetp-of-list-fix-one (%autoinduct ordered-subsetp))
+(%autoprove ordered-subsetp-of-list-fix-two (%autoinduct ordered-subsetp))
+(%autoprove ordered-subsetp-of-app-when-ordered-subsetp-one (%autoinduct ordered-subsetp))
+(%autoprove ordered-subsetp-of-app-one)
+(%autoprove ordered-subsetp-of-app-two (%cdr-induction y))
+(%autoprove ordered-subsetp-of-app-when-ordered-subsetp-two)
+(%autoprove subsetp-when-ordered-subsetp (%autoinduct ordered-subsetp))
+(%autoprove ordered-subsetp-of-remove-duplicates (%cdr-induction x))
+(%autoprove ordered-subsetp-of-remove-all (%cdr-induction x))
+(%autoprove ordered-subsetp-of-difference (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/ordered-subsetp")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/prepare-for-bootstrapping.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/prepare-for-bootstrapping.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/prepare-for-bootstrapping.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/prepare-for-bootstrapping.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,366 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(include-book
+ ;; I break this include-book up to ruin the Makefile's scanner, so that we are
+ ;; not trying to find the file "book-thms.mtime" in the ACL2 distribution
+ "xdoc/book-thms" :dir :system)
+
+
+;; Fix inlining status of NOT.
+(ACL2::table ACL2::milawa 'ACL2::functions-to-inline
+             (cons 'not
+                   (ACL2::get-functions-to-inline ACL2::world)))
+
+
+(defun find-acl2-rules-that-exist-in-milawa (acl2thms milawarules)
+  (declare (xargs :mode :program))
+  (if (consp acl2thms)
+      (let ((lookup (rw.rule-list-lookup (car acl2thms) milawarules)))
+        (if lookup
+            (cons lookup
+                  (find-acl2-rules-that-exist-in-milawa (cdr acl2thms) milawarules))
+          (find-acl2-rules-that-exist-in-milawa (cdr acl2thms) milawarules)))
+    nil))
+
+(defun %list-missing-rules (filename ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((world     (ACL2::w ACL2::state))
+         (acl2-thms (difference (ACL2::theorems-introduced-in filename ACL2::state)
+                                '(ACL2::ACL2-ASG-PACKAGE
+                                  ACL2::ACL2-AGP-PACKAGE
+                                  ACL2::ACL2-CRG-PACKAGE
+                                  ACL2::U-PACKAGE)))
+         (mlw-thms  (find-acl2-rules-that-exist-in-milawa acl2-thms (tactic.harness->allrules world))))
+    (difference acl2-thms
+                (rw.rule-list-names mlw-thms))))
+
+(defmacro %ensure-exactly-these-rules-are-missing (filename &rest rules)
+  `(ACL2::make-event (ensure-exactly-these-rules-are-missing-fn ,filename ',rules ACL2::state)))
+
+(defun ensure-exactly-these-rules-are-missing-fn (filename expected-missing ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let ((actually-missing (%list-missing-rules filename ACL2::state)))
+    (if (and (subsetp actually-missing expected-missing)
+             (subsetp expected-missing actually-missing))
+        `(ACL2::value-triple :invisible)
+      (ACL2::er hard
+                'ensure-exactly-these-rules-are-missing
+                "~%~%Incorrect missing rules for ~s0.~%~%~
+                  We thought these rules would not be missing:~%  ~&1.~%~%~
+                  We thought these rules would be missing, but they are present:~%  ~&2.~%~%"
+                filename
+                (difference actually-missing expected-missing)
+                (difference expected-missing actually-missing)))))
+
+
+
+;; BOZO put this somewhere sensible
+
+(defun compact-anstack (x)
+  (if (consp x)
+      (cons (list (first (car x))
+                  (rw.rule-list-names (fourth (car x))))
+            (compact-anstack (cdr x)))
+    nil))
+
+(defmacro trace-ancestors ()
+  `(ACL2::trace! (rw.ancestors-check :entry (list (first acl2::arglist)
+                                                  (rw.rule-list-names (second acl2::arglist))
+                                                  (compact-anstack (third acl2::arglist))))))
+
+
+
+
+;; prepare-for-bootstrapping.lisp
+;;
+;; This file is used to get the system ready to do bootstrapping.  It is in
+;; charge of initializing all of the variables in the tactic harness.  This is
+;; where we do all of the messy hacks we need so that the rest of the
+;; bootstrapping process can be done in a principled way.  There is nothing
+;; very intellectually stimulating here, it's just a bunch of details that need
+;; to be taken care of before we can begin in earnest.
+
+
+
+
+
+
+#|| We don't do this any more --- syndefs are gone.
+
+;; 1.  Loading definitions for use in :syntax restrictions.
+;;
+;; Some of our rewrite rules use :syntax restrictions to limit their
+;; application.  For example, we use a rewrite rule to orient (equal x y) so
+;; that x < y in the term order.  This rule simply commutes (equal y x) to
+;; (equal x y), and a :syntax restriction requires that y is bigger than x
+;; before the rule is applied.
+;;
+;; We want to introduce this rule, and other rules using concepts such as
+;; the term order, constantp, etc., long before the term order itself is
+;; introduced.  Our tactic harness keeps a list of "syntax definitions"
+;; which are used for this purpose.  Since these definitions are only used
+;; heuristically (to decide whether or not to apply a rule), there are no
+;; soundness issues to be concerned with.
+;;
+;; The file syntax-defuns.lisp, which is automatically generated by our make
+;; system (using our custom "defun" event and some various modifications in
+;; the ACL2/utilities and ACL2/logic directories), will have the current list
+;; of definitions for us to add to the syntax definitions list.  We load them
+;; in at this time.
+
+;; (defun annhialate-time$ (x)
+;;   (declare (xargs :mode :program))
+;;   (if (consp x)
+;;       (if (and (equal (car x) 'ACL2::time$)
+;;                (equal (len x) 2))
+;;           (annhialate-time$ (second x))
+;;         (cons (annhialate-time$ (car x))
+;;               (annhialate-time$ (cdr x))))
+;;     x))
+
+;; (ACL2::make-event
+;;  `(ACL2::progn ,@(acl2::time$
+;;                   (fast-rev
+;;                    (annhialate-time$
+;;                     (ACL2::get-syntax-defun-entries (ACL2::w ACL2::state)))))))
+
+||#
+
+
+
+
+;; 2.  Adding the rank, ordp, and ord< functions.
+;;
+;; The functions rank, ordp, and ord< are not among our base functions, but
+;; they cannot be admitted in the ordinary manner.  This is because they are
+;; recursive, hence admitting them requires that we prove they terminate.  But
+;; the termination proofs will mention the functions rank, ordp, and ord<,
+;; which cannot be mentioned until rank, ordp, and ord< are admitted.  We
+;; therefore reach in and forcibly make their definitions available to the
+;; system by adding them to the arity table, definitions list, and syntax
+;; definitions list.  (They are also added as axioms in part 3.)
+
+(ACL2::table tactic-harness 'atbl
+             (ACL2::list* '(rank . 1)
+                          '(ordp . 1)
+                          '(ord< . 2)
+                          (tactic.harness->atbl ACL2::world)))
+
+(ACL2::table tactic-harness 'world
+             (change-tactic.world-wrapper (tactic.harness->world ACL2::world)
+                                          :defs
+                                          (ACL2::list* (definition-of-rank)
+                                                       (definition-of-ordp)
+                                                       (definition-of-ord<)
+                                                       (tactic.harness->defs ACL2::world))))
+
+
+
+
+;; 3.  Adding the symbolic axioms.
+;;
+;; In the file ACL2/build/axioms.lisp, we introduced our symbolic axioms using
+;; the special defax command.  Each such axiom is noted in the defax registry,
+;; so we can read this registry in order to introduce all of our axioms at this
+;; time.  This way, you just need to add your new axioms in the
+;; ACL2/build/axioms.lisp file as defax'es, and they will be automatically
+;; available to the system.
+
+(defun aux-introduce-all-defaxes (registry)
+  (declare (xargs :mode :program))
+  (if (consp registry)
+      (let ((axiom-name (car registry)))
+        (cons `(%axiom (,axiom-name))
+              (aux-introduce-all-defaxes (cdr registry))))
+    nil))
+
+(defun introduce-all-defaxes (world)
+  (declare (xargs :mode :program))
+  (let ((registry (fast-rev (dd.get-defax-table world))))
+    `(ACL2::progn ,@(aux-introduce-all-defaxes registry))))
+
+(ACL2::make-event (introduce-all-defaxes (ACL2::w ACL2::state)))
+
+
+
+
+;; 4. Adding the "deftheorem" theorems.
+;;
+;; Our builder functions make use of several theorems introduced by the
+;; "deftheorem" event throughout our files.  Like defax, deftheorem remembers
+;; which theorems it has introduced by adding them to a registry.  We are now
+;; going to read in all of these theorems and prove them.
+;;
+;; This is a somewhat delicate process.
+;;
+;;    - Some of the theorems mention the functions "iff" and "not" which have
+;;      not yet been introduced.  So, we will need to introduce these functions
+;;      before loading all the deftheorems.
+;;
+;;    - To introduced "iff" and "not", we need to have the following theorems
+;;      available (to convert the axiom into a theorem corresponding to the
+;;      associated rule)
+;;         1. theorem-substitute-into-not-pequal
+;;         2. theorem-not-t-or-not-nil
+;;
+;;    - But fortunately these theorems do not mention iff or not, so we are
+;;      able to complete the process pretty easily.
+
+(defmacro check-deftheorem (name)
+  `(ACL2::progn
+    (local (ACL2::make-event (let ((proof-okp (%theorem-check ',name
+                                                              (,name)
+                                                              (,(ACL2::mksym name '-proof))
+                                                              ACL2::state)))
+                               (acl2::prog2$
+                                (acl2::cw ";; proof-okp = ~x0.~%" proof-okp)
+                                '(ACL2::value-triple :invisible)))))
+    (local (acl2::value-triple (acl2::cw "check-deftheorem calling %raw-add-theorem~%")))
+    (%raw-add-theorem ,name (,name))))
+
+(check-deftheorem theorem-substitute-into-not-pequal)
+(check-deftheorem theorem-not-t-or-not-nil)
+
+(defsection not
+  ;; Essay on how "not" is handled.
+  ;;
+  ;; There are many variants of "not", such as (if x nil t), (equal x nil), and
+  ;; so forth.  We have chosen to use (not x) as our canonical form.  It seems
+  ;; like the simplest of these alternatives, since it has only a single
+  ;; argument.
+  ;;
+  ;; Our conditional rewriter has a special case for handling not, which ensures
+  ;; that x is always rewritten under IFF.  We also have a special case so that
+  ;; (if x nil t) will be canonicalized to (not x).  The other variants can be
+  ;; canonicalized with rewrite rules.
+  ;;
+  ;; Because of our special cases, regular rewrite rules (including definitions)
+  ;; are never attempted when simplifying (not x).  Hence, it doesn't matter if
+  ;; "not" is enabled or disabled, its definition will not be expanded in either
+  ;; case.  I've chosen to leave it disabled just as a reminder that it won't be
+  ;; used.  Rewrite rules should never target "not", because they would never be
+  ;; used.  Of course, rules like (booleanp (not x)) are fine.
+  (%defun not (x)
+          (if x nil t))
+  (%admit))
+
+(defsection iff
+  (%defun iff (x y)
+          (if x (if y t nil) (if y nil t)))
+  (%admit)
+  (%enable default iff))
+
+(defun aux-introduce-all-deftheorems (registry)
+  (declare (xargs :mode :program))
+  (if (consp registry)
+      (let ((theorem-name (car (car registry))))
+        (if (memberp theorem-name '(theorem-substitute-into-not-pequal theorem-not-t-or-not-nil))
+            ;; Skip the theorems we've already introduced.
+            (aux-introduce-all-deftheorems (cdr registry))
+          (cons `(check-deftheorem ,theorem-name)
+                (aux-introduce-all-deftheorems (cdr registry)))))
+    nil))
+
+(defun introduce-all-deftheorems (world)
+  (declare (xargs :mode :program))
+  ;; The registry entries are in the reverse order of how they were added, so we
+  ;; reverse them to recover the original order they were added.
+  (let ((registry (fast-rev (dd.get-deftheorem-registry world))))
+    `(ACL2::progn ,@(aux-introduce-all-deftheorems registry))))
+
+(ACL2::make-event (introduce-all-deftheorems (ACL2::w ACL2::state)))
+
+
+
+;; 5. Adding "implies"
+;;
+;; Most of our functions are defined in our ACL2 scripts.  However, we cannot
+;; redefine implies, because ACL2's defthm command is expecting its theorems to
+;; have the form (ACL2::implies ... (equal lhs rhs)).  We correct for this now.
+
+(defsection implies
+  (%defun implies (x y)
+          (if x (if y t nil) t))
+  (%admit)
+  (%enable default implies))
+
+
+
+;; 7. Adding rules which are "deeply" part of ACL2
+
+(defsection reflexivity-of-equal
+  (%prove (%rule reflexivity-of-equal
+                 :lhs (equal x x)
+                 :rhs t))
+  (%use (build.theorem (theorem-reflexivity-of-equal)))
+  (%cleanup)
+  (%qed)
+  (%enable default reflexivity-of-equal))
+
+(defsection symmetry-of-equal
+  (%prove (%rule symmetry-of-equal
+                 :lhs (equal x y)
+                 :rhs (equal y x)
+                 :syntax ((logic.term-< y x))))
+  (%use (build.theorem (theorem-symmetry-of-equal)))
+  (%cleanup)
+  (%qed)
+  (%enable default symmetry-of-equal))
+
+(defsection equal-of-t-and-equal
+  (%prove (%rule equal-of-t-and-equal
+                 :lhs (equal t (equal x y))
+                 :rhs (equal x y)))
+  (%use (build.theorem (theorem-equal-of-equal-and-t)))
+  (%urewrite default)
+  (%cleanup)
+  (%qed)
+  (%enable default equal-of-t-and-equal))
+
+(defsection consp-of-cons
+  (%prove (%rule consp-of-cons
+                 :lhs (consp (cons x y))
+                 :rhs t))
+  (%use (build.axiom (axiom-consp-of-cons)))
+  (%cleanup)
+  (%qed)
+  (%enable default consp-of-cons))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-1.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,487 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prepare-for-bootstrapping")
+(%interactive)
+
+
+(%autoadmit nfix)
+(%autoadmit <=)
+(%autoadmit zp)
+(%autoadmit min)
+(%autoadmit max)
+(%autoadmit max3)
+
+(%enable default min max max3 <=)
+
+(%autoadmit booleanp)
+
+
+
+
+;; (ACL2::trace! (tactic.apply-strategy-step :entry (let* ((args acl2::arglist)
+;;                                                         (step (first args))
+;;                                                         (blimit (third args))
+;;                                                         (rlimit (fourth args))
+;;                                                         (rw-n (acl2::sixth args)))
+;;                                                    (list step '<skelly> blimit rlimit '<control> rw-n))
+;;                                           :exit (let* ((values acl2::values)
+;;                                                        (result (car values)))
+;;                                                   (if result
+;;                                                       '<skelly-result>
+;;                                                     'fail))))
+
+
+;; (ACL2::trace! (tactic.auto-tac :entry (let* ((args acl2::arglist)
+;;                                              (current-strat (second args))
+;;                                              (global-strat (third args)))
+;;                                         (list current-strat global-strat))
+;;                                :exit '<result>))
+
+(defsection equal-of-booleans-rewrite
+  ;; I add a syntaxp restriction here.  If you just use %restrict later, you
+  ;; can't disable equal-of-booleans-rewrite because our disabling code works
+  ;; by the whole rule instead of by its name.  Maybe we should redo that,
+  ;; since this is kind of retarded.
+  (%prove (%rule equal-of-booleans-rewrite
+                 :type inside
+                 :hyps (list (%hyp (booleanp x) :limit 1)
+                             (%hyp (booleanp y) :limit 1))
+                 :lhs (equal x y)
+                 :rhs (iff x y)
+                 :syntax ((not (logic.term-< y x)))))
+  (local (%enable default booleanp))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-booleans-rewrite))
+
+(%autoprove booleanp-of-booleanp
+            (%enable default booleanp))
+
+(%autoprove booleanp-of-equal
+            (%enable default booleanp))
+
+(%autoprove booleanp-of-not
+            (%use (build.axiom (definition-of-not))))
+
+(%autoprove booleanp-of-iff)
+
+(%autoprove booleanp-of-zp
+            (%enable default zp))
+
+
+;; Crewrite automatically converts (if x nil t) to (not x).  We now provide
+;; rewrite rules to convert the other not-variants to (not x) as well.
+
+(defsection equal-of-nil-one
+  ;; No equivalent in ACL2
+  (%prove (%rule equal-of-nil-one
+                 :lhs (equal x nil)
+                 :rhs (not x)))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-nil-one)
+  (%raw-add-rule (%rule [outside]equal-of-nil-one
+                        :type outside
+                        :lhs (equal x nil)
+                        :rhs (not x))))
+
+(defsection equal-of-nil-two
+  ;; No equivalent in ACL2
+  (%prove (%rule equal-of-nil-two
+                 :lhs (equal nil x)
+                 :rhs (not x)))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-nil-two)
+  (%raw-add-rule (%rule [outside]equal-of-nil-two
+                        :type outside
+                        :lhs (equal nil x)
+                        :rhs (not x))))
+
+(defsection iff-of-nil-one
+  ;; No equivalent in ACL2
+  (%prove (%rule iff-of-nil-one
+                 :lhs (iff x nil)
+                 :rhs (not x)))
+  (%auto)
+  (%qed)
+  (%enable default iff-of-nil-one)
+  (%raw-add-rule (%rule [outside]iff-of-nil-one
+                        :type outside
+                        :lhs (iff x nil)
+                        :rhs (not x))))
+
+(defsection iff-of-nil-two
+  ;; No equivalent in ACL2
+  (%prove (%rule iff-of-nil-two
+                 :lhs (iff nil x)
+                 :rhs (not x)))
+  (%auto)
+  (%qed)
+  (%enable default iff-of-nil-two)
+  (%raw-add-rule (%rule [outside]iff-of-nil-two
+                        :type outside
+                        :lhs (iff nil x)
+                        :rhs (not x))))
+
+(defsection iff-of-t-left
+  ;; No equivalent in ACL2.  Useful when iff is disabled.
+  (%prove (%rule iff-of-t-left
+                 :equiv iff
+                 :lhs (iff t x)
+                 :rhs x))
+  (%auto)
+  (%qed)
+  (%enable default iff-of-t-left)
+  (%raw-add-rule (%rule [outside]iff-of-t-left
+                        :type outside
+                        :equiv iff
+                        :lhs (iff t x)
+                        :rhs x)))
+
+(defsection iff-of-t-right
+  ;; No equivalent in ACL2.  Useful when iff is disabled.
+  (%prove (%rule iff-of-t-right
+                 :equiv iff
+                 :lhs (iff x t)
+                 :rhs x))
+  (%auto)
+  (%qed)
+  (%enable default iff-of-t-right)
+  (%raw-add-rule (%rule [outside]iff-of-t-right
+                        :type outside
+                        :equiv iff
+                        :lhs (iff x t)
+                        :rhs x)))
+
+
+
+
+;; Cons, Car, and Cdr.
+
+(%autoprove booleanp-of-consp
+            (%use (build.axiom (axiom-consp-nil-or-t))))
+
+(%autoprove car-when-not-consp
+            (%use (build.axiom (axiom-car-when-not-consp))))
+
+(%autoprove cdr-when-not-consp
+            (%use (build.axiom (axiom-cdr-when-not-consp))))
+
+(%autoprove car-of-cons
+            (%use (build.axiom (axiom-car-of-cons))))
+
+(%autoprove cdr-of-cons
+            (%use (build.axiom (axiom-cdr-of-cons))))
+
+;; No equivalent of car-cdr-elim in Milawa.
+
+(%autoprove cons-of-car-and-cdr
+            (%use (build.axiom (axiom-cons-of-car-and-cdr))))
+
+(%autoprove equal-of-cons-rewrite
+            (%auto :strategy (cleanup split crewrite dist)))
+
+(%autoprove booleanp-of-symbolp
+            (%use (build.axiom (axiom-symbolp-nil-or-t))))
+
+(%autoprove booleanp-of-symbol-<
+            (%use (build.axiom (axiom-symbol-<-nil-or-t))))
+
+(%autoprove irreflexivity-of-symbol-<
+            (%use (build.axiom (axiom-irreflexivity-of-symbol-<))))
+
+(%autoprove antisymmetry-of-symbol-<
+            (%use (build.axiom (axiom-antisymmetry-of-symbol-<))))
+
+(%autoprove transitivity-of-symbol-<
+            (%use (build.axiom (axiom-transitivity-of-symbol-<))))
+
+(%autoprove trichotomy-of-symbol-<
+            (%use (build.axiom (axiom-trichotomy-of-symbol-<))))
+
+(%autoprove symbol-<-completion-left
+            (%use (build.axiom (axiom-symbol-<-completion-left))))
+
+(%autoprove symbol-<-completion-right
+            (%use (build.axiom (axiom-symbol-<-completion-right))))
+
+
+
+;; Reasoning about Types.
+
+(%autoprove booleanp-of-natp
+            (%use (build.axiom (axiom-natp-nil-or-t))))
+
+(%autoprove symbolp-when-natp-cheap
+            (%use (build.axiom (axiom-disjoint-symbols-and-naturals))))
+
+(%autoprove symbolp-when-consp-cheap
+            (%use (build.axiom (axiom-disjoint-symbols-and-conses))))
+
+(%autoprove consp-when-natp-cheap
+            (%use (build.axiom (axiom-disjoint-naturals-and-conses))))
+
+(%autoprove booleanp-when-natp-cheap
+            (%enable default booleanp))
+
+(%autoprove booleanp-when-consp-cheap
+            (%enable default booleanp))
+
+(%autoprove symbolp-when-booleanp-cheap
+            (%enable default booleanp))
+
+(defsection cons-under-iff
+  ;; Not in utilities/primitives; somehow built into ACL2?
+  (%prove (%rule cons-under-iff
+                 :equiv iff
+                 :lhs (cons x y)
+                 :rhs t))
+  (%use (build.theorem (theorem-cons-is-not-nil)))
+  (%auto)
+  (%qed)
+  (%enable default cons-under-iff)
+  (%raw-add-rule (%rule [outside]cons-under-iff
+                        :type outside
+                        :equiv iff
+                        :lhs (cons x y)
+                        :rhs t)))
+
+
+;; The following rules have no equivalents in ACL2 because there they can be
+;; handled with type reasoning.
+
+(defsection equal-of-symbol-and-non-symbol-cheap
+  ;; BOZO should we syntactically restrict this rule so that it only fires when x <= y,
+  ;; in the term order, so that the symmetry rule fires first?
+  (%prove (%rule equal-of-symbol-and-non-symbol-cheap
+                 :hyps (list (%hyp (symbolp x) :limit 1)
+                             (%hyp (not (symbolp y)) :limit 1))
+                 :lhs (equal x y)
+                 :rhs nil))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-symbol-and-non-symbol-cheap))
+
+(defsection equal-of-non-symbol-and-symbol-cheap
+  (%prove (%rule equal-of-non-symbol-and-symbol-cheap
+                 :hyps (list (%hyp (not (symbolp x)) :limit 1)
+                             (%hyp (symbolp y) :limit 1))
+                 :lhs (equal x y)
+                 :rhs nil))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-non-symbol-and-symbol-cheap))
+
+(defsection equal-of-cons-and-non-cons-cheap
+  (%prove (%rule equal-of-cons-and-non-cons-cheap
+                 :hyps (list (%hyp (consp x) :limit 1)
+                             (%hyp (not (consp y)) :limit 1))
+                 :lhs (equal x y)
+                 :rhs nil))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-cons-and-non-cons-cheap))
+
+(defsection equal-of-non-cons-and-cons-cheap
+  (%prove (%rule equal-of-non-cons-and-cons-cheap
+                 :hyps (list (%hyp (not (consp x)) :limit 1)
+                             (%hyp (consp y) :limit 1))
+                 :lhs (equal x y)
+                 :rhs nil))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-non-cons-and-cons-cheap))
+
+(defsection equal-of-nat-and-non-nat-cheap
+  (%prove (%rule equal-of-nat-and-non-nat-cheap
+                 :hyps (list (%hyp (natp x) :limit 1)
+                             (%hyp (not (natp y)) :limit 1))
+                 :lhs (equal x y)
+                 :rhs nil))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-nat-and-non-nat-cheap))
+
+(defsection equal-of-non-nat-and-nat-cheap
+  (%prove (%rule equal-of-non-nat-and-nat-cheap
+                 :hyps (list (%hyp (not (natp x)) :limit 1)
+                             (%hyp (natp y) :limit 1))
+                 :lhs (equal x y)
+                 :rhs nil))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-non-nat-and-nat-cheap))
+
+
+(defsection car-when-symbolp-cheap
+  ;; This isn't part of ACL2
+  (%prove (%rule car-when-symbolp-cheap
+                 :hyps (list (%hyp (symbolp x) :limit 0))
+                 :lhs (car x)
+                 :rhs nil))
+  (%use (%instance (%thm car-when-not-consp)))
+  (%auto)
+  (%qed)
+  (%enable default car-when-symbolp-cheap))
+
+
+
+(defsection not-of-not-under-iff
+  ;; This isn't part of ACL2.
+  ;;
+  ;; The conditional rewriter doesn't target not, but the unconditional
+  ;; rewriter can use this rule so it's still useful.
+  (%prove (%rule not-of-not-under-iff
+                 :equiv iff
+                 :lhs (not (not x))
+                 :rhs x))
+  (%auto)
+  (%qed)
+  (%enable default not-of-not-under-iff)
+  (%raw-add-rule (%rule [outside]not-of-not-under-iff
+                        :type outside
+                        :equiv iff
+                        :lhs (not (not x))
+                        :rhs x)))
+
+
+
+;; Rules about Implies.
+;;
+;; These rules are not found in ACL2.  And, you might wonder what they're doing
+;; here, too, since we almost always leave implies enabled.  In some big proofs,
+;; particularly mutually-recursive style ones with several implies, a useful
+;; size reduction technique is to disable implies until late in the proof to
+;; control case splitting.  When we do this, these rules let us simplify some
+;; of the more trivial implies statements we run into.
+
+(defsection implies-of-self
+  (%prove (%rule implies-of-self
+                 :lhs (implies x x)
+                 :rhs t))
+  (%auto)
+  (%qed)
+  (%enable default implies-of-self)
+  (%raw-add-rule (%rule [outside]implies-of-self
+                        :type outside
+                        :lhs (implies x x)
+                        :rhs t)))
+
+(defsection implies-of-t-left
+  (%prove (%rule implies-of-t-left
+                 :equiv iff
+                 :lhs (implies t x)
+                 :rhs x))
+  (%auto)
+  (%qed)
+  (%enable default implies-of-t-left)
+  (%raw-add-rule (%rule [outside]implies-of-t-left
+                        :type outside
+                        :equiv iff
+                        :lhs (implies t x)
+                        :rhs x)))
+
+(defsection implies-of-t-right
+  (%prove (%rule implies-of-t-right
+                 :lhs (implies x t)
+                 :rhs t))
+  (%auto)
+  (%qed)
+  (%enable default implies-of-t-right)
+  (%raw-add-rule (%rule [outside]implies-of-t-right
+                        :type outside
+                        :lhs (implies x t)
+                        :rhs t)))
+
+(defsection implies-of-nil-left
+  (%prove (%rule implies-of-nil-left
+                 :lhs (implies nil x)
+                 :rhs t))
+  (%auto)
+  (%qed)
+  (%enable default implies-of-nil-left)
+  (%raw-add-rule (%rule [outside]implies-of-nil-left
+                        :type outside
+                        :lhs (implies nil x)
+                        :rhs t)))
+
+(defsection implies-of-nil-right
+  (%prove (%rule implies-of-nil-right
+                 :lhs (implies x nil)
+                 :rhs (not x)))
+  (%auto)
+  (%qed)
+  (%enable default implies-of-nil-right)
+  (%raw-add-rule (%rule [outside]implies-of-nil-right
+                        :type outside
+                        :lhs (implies x nil)
+                        :rhs (not x))))
+
+(defsection booleanp-of-implies
+  (%prove (%rule booleanp-of-implies
+                 :lhs (booleanp (implies x y))
+                 :rhs t))
+  (%auto)
+  (%qed)
+  (%enable default booleanp-of-implies)
+  (%raw-add-rule (%rule [outside]booleanp-of-implies
+                        :type outside
+                        :lhs (booleanp (implies x y))
+                        :rhs t)))
+
+
+
+;; (ACL2::trace! (rw.cache-lookup :entry (let ((args ACL2::arglist))
+;;                                         (list (first args)
+;;                                               (second args)
+;;                                               '<cache>))
+;;                                :exit (let ((args ACL2::arglist)
+;;                                            (vals ACL2::values))
+;;                                        (if (car vals)
+;;                                            (if (equal (first args) (rw.trace->lhs (first vals)))
+;;                                                (list 'hit (first vals) 'assms-are (rw.trace->assms (first vals)))
+;;                                              (list 'hey-somethings-fucked-up (first vals)))
+;;                                          (list 'miss)))))
+
+;; (ACL2::trace! (rw.cache-update :entry (let ((args ACL2::arglist))
+;;                                         (list (first args)
+;;                                               (rw.trace->rhs (second args))
+;;                                               (third args)
+;;                                               '<cache>))
+;;                                :exit (let ((args ACL2::arglist))
+;;                                        (declare (ignore args))
+;;                                        (list '<new-cache>))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-2.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,217 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives-1")
+(%interactive)
+
+
+;; BOZO reorganize these properly
+
+(%autoprove natp-of-nfix
+            (%enable default nfix))
+
+(%autoprove nfix-when-natp-cheap
+            (%enable default nfix))
+
+(%autoprove nfix-when-not-natp-cheap
+            (%enable default nfix))
+
+(%autoprove equal-of-nfix-of-self)
+
+(defsection [outside]equal-of-nfix-of-self-alt
+  ;; Can't rely on term-order for outside-in.
+  (%prove (%rule [outside]equal-of-nfix-of-self-alt
+                 :type outside
+                 :lhs (equal (nfix x) x)
+                 :rhs (natp x)))
+  (%auto)
+  (%qed)
+  (%enable default [outside]equal-of-nfix-of-self-alt))
+
+(%autoprove equal-of-zero-and-nfix
+            (%enable default nfix zp))
+
+(defsection [outside]equal-of-zero-and-nfix-alt
+  ;; Can't rely on term-order for outside-in.
+  (%prove (%rule [outside]equal-of-zero-and-nfix-alt
+                 :type outside
+                 :lhs (equal (nfix x) 0)
+                 :rhs (zp x)))
+  (%auto)
+  (%qed)
+  (%enable default [outside]equal-of-zero-and-nfix-alt))
+
+(%autoprove zp-when-natp-cheap
+            (%enable default zp))
+
+(%autoprove zp-when-not-natp-cheap
+            (%enable default zp))
+
+(%autoprove zp-of-nfix
+            (%enable default nfix))
+
+(%autoprove nfix-of-nfix)
+
+(%autoprove natp-when-not-zp-cheap)
+
+(%autoprove natp-when-zp-cheap)
+
+(%autoprove nfix-when-zp-cheap)
+
+(%autoprove equal-of-nfix-with-positive-constant
+            (%enable default nfix))
+
+
+
+;; Addition.
+
+(%autoprove natp-of-plus
+            (%use (build.axiom (axiom-natp-of-plus))))
+
+(%autoprove plus-under-iff
+            (%disable default natp-of-plus [outside]natp-of-plus)
+            (%use (%thm natp-of-plus)))
+
+(%autoprove commutativity-of-+
+            (%use (build.axiom (axiom-commutativity-of-+))))
+
+(%autoprove associativity-of-+
+            (%use (build.axiom (axiom-associativity-of-+))))
+
+(%disable default [outside]associativity-of-+) ;; Interferes with constant gathering
+
+(%autoprove commutativity-of-+-two
+            (%use (%instance (build.axiom (axiom-commutativity-of-+)) (b (+ b c)))))
+
+(%autoprove gather-constants-from-plus-of-plus)
+
+
+
+(%autoprove plus-completion-left
+            (%use (build.axiom (axiom-plus-when-not-natp-left)))
+            (%use (build.instantiation (build.axiom (axiom-plus-of-zero-when-natural))
+                                       (list (cons 'a 'b))))
+            (%use (build.axiom (axiom-plus-when-not-natp-left)))
+            (%use (build.instantiation (build.axiom (axiom-plus-when-not-natp-left))
+                                       (list (cons 'a 'b)
+                                             (cons 'b ''0)))))
+
+(%autoprove plus-completion-right
+            (%disable default nfix plus-completion-left)
+            (%use (%instance (%thm plus-completion-left) (a b) (b a))))
+
+(%autoprove plus-of-zero-right
+            (%enable default plus-completion-right)
+            (%use (build.axiom (axiom-plus-of-zero-when-natural))))
+
+(%autoprove plus-of-zero-left
+            (%use (%instance (%thm commutativity-of-+) (a 0) (b a))))
+
+(%autoprove plus-when-zp-left-cheap
+            (%use (%thm plus-completion-left)))
+
+(%autoprove plus-when-zp-right-cheap
+            (%use (%thm plus-completion-right)))
+
+(%autoprove plus-of-nfix-left
+            (%enable default nfix))
+
+(%autoprove plus-of-nfix-right
+            (%enable default nfix))
+
+
+
+
+;; Less-Than Relation.
+
+(%autoprove booleanp-of-<
+            (%use (build.axiom (axiom-<-nil-or-t))))
+
+(%autoprove irreflexivity-of-<
+            (%use (build.axiom (axiom-irreflexivity-of-<))))
+
+(%autoprove less-of-zero-right
+            (%use (build.axiom (axiom-less-of-zero-right))))
+
+(%autoprove less-completion-right
+            (%use (build.axiom (axiom-less-completion-right))))
+
+(%autoprove less-when-zp-right-cheap
+            (%use (%thm less-completion-right)))
+
+(%autoprove less-of-zero-left
+            (%use (build.axiom (axiom-less-of-zero-left-when-natp))))
+
+(%autoprove less-completion-left
+            (%use (build.axiom (axiom-less-completion-left))))
+
+(%autoprove less-when-zp-left-cheap
+            (%use (%thm less-completion-left)))
+
+(%autoprove less-of-nfix-left
+            (%enable default nfix))
+
+(%autoprove less-of-nfix-right
+            (%enable default nfix))
+
+(%autoprove transitivity-of-<
+            (%use (build.axiom (axiom-transitivity-of-<))))
+
+(%autoprove antisymmetry-of-<
+            (%disable default transitivity-of-<)
+            (%use (%instance (%thm transitivity-of-<) (a a) (b b) (c a))))
+
+(%autoprove trichotomy-of-<
+            (%use (build.axiom (axiom-trichotomy-of-<-when-natp))))
+
+(%autoprove one-plus-trick
+            (%use (build.axiom (axiom-one-plus-trick))))
+
+(%autoprove less-of-one-right
+            (%use (build.axiom (axiom-natural-less-than-one-is-zero))))
+
+(%autoprove less-of-one-left
+            (%enable default zp))
+
+(%autoprove transitivity-of-<-two
+            (%enable default nfix)
+            (%disable default trichotomy-of-<)
+            (%use (%instance (%thm trichotomy-of-<) (a b) (b c))))
+
+(%autoprove transitivity-of-<-three)
+
+(%autoprove transitivity-of-<-four)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-3.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-3.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-3.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,97 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives-2")
+(%interactive)
+
+
+
+;; Less-Than and Addition.
+
+(%autoprove |(< (+ a b) (+ a c))| (%use (build.axiom (axiom-less-than-of-plus-and-plus))))
+
+(%autoprove |(< a (+ a b))|
+            (%disable default
+                      |(< (+ a b) (+ a c))|
+                      |[OUTSIDE](< (+ a b) (+ a c))|)
+            (%use (%instance (%thm |(< (+ a b) (+ a c))|) (b 0) (c b))))
+
+(%autoprove |(< a (+ b a))|)
+
+(%autoprove |(< (+ a b) a)|
+            (%disable default
+                      |(< (+ a b) (+ a c))|
+                      |[OUTSIDE](< (+ a b) (+ a c))|)
+            (%use (%instance (%thm |(< (+ a b) (+ a c))|) (c 0))))
+
+(%autoprove |(< (+ b a) a)|)
+
+(%autoprove |(< a (+ b c a))|)
+(%autoprove |(< a (+ b a c))|)
+(%autoprove |(< a (+ b c d a))|)
+(%autoprove |(< a (+ b c a d))|)
+(%autoprove |(< a (+ b c d e a))|)
+(%autoprove |(< a (+ b c d a e))|)
+(%autoprove |(< a (+ b c d e f a))|)
+(%autoprove |(< a (+ b c d e a f))|)
+
+(%autoprove |(< (+ a b) (+ c a))|)
+(%autoprove |(< (+ b a) (+ c a))|)
+(%autoprove |(< (+ b a) (+ a c))|)
+
+(%autoprove |(< (+ a b) (+ c a d))|)
+(%autoprove |(< (+ b a c) (+ d a))|)
+
+(%autoprove |a <= b, c != 0 --> a < b+c| (%enable default zp))
+(%autoprove |a <= b, c != 0 --> a < c+b|)
+
+(%autoprove |a <= b, c != 0 --> a < c+b+d|
+            ;; BOZO, why do I have to disable this?
+            (%disable default [OUTSIDE]LESS-OF-ZERO-LEFT))
+(%autoprove |a <= b, c != 0 --> a < c+d+b|
+            (%disable default [OUTSIDE]LESS-OF-ZERO-LEFT))
+
+
+(%autoprove |c < a, d <= b --> c+d < a+b|
+            (%use (%instance (%thm transitivity-of-<-three) (a (+ c d)) (b (+ c b)) (c (+ a b)))))
+(%autoprove |c < a, d <= b --> c+d < b+a|)
+
+(%autoprove |c <= a, d < b --> c+d < a+b|
+            (%use (%instance (%thm |c < a, d <= b --> c+d < a+b|) (c d) (a b) (d c) (b a))))
+(%autoprove |c <= a, d < b --> c+d < b+a|)
+(%autoprove |c <= a, d <= b --> c+d <= a+b|
+            (%use (%instance (%thm transitivity-of-<-four) (a (+ c d)) (b (+ c b)) (c (+ a b)))))
+(%autoprove |c <= a, d <= b --> c+d <= b+a|)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-4.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-4.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-4.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-4.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,89 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives-3")
+(%interactive)
+
+
+;; Equalities with Sums.
+
+(%autoprove |(= a (+ a b))|
+            (%enable default nfix)
+            (%disable default |[OUTSIDE](< a (+ a b))|)
+            (%auto)
+            (%use (%thm |(< a (+ a b))|))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove |(= a (+ b a))|)
+
+(%autoprove |lemma for (= (+ a b) (+ a c))|
+            (%use (%instance (%thm |(< (+ a b) (+ a c))|) (a a) (b b) (c c)))
+            (%use (%instance (%thm |(< (+ a b) (+ a c))|) (a a) (b c) (c b)))
+            (%disable default |[OUTSIDE](< (+ a b) (+ a c))|)
+            (%disable default |(< (+ a b) (+ a c))|))
+
+(%autoprove |(= (+ a b) (+ a c))|
+            (%enable default nfix)
+            (%use (%instance (%thm |lemma for (= (+ a b) (+ a c))|)
+                             (a a)
+                             (b (nfix b))
+                             (c (nfix c)))))
+
+(%autoprove |(= (+ a b) (+ c a))|)
+(%autoprove |(= (+ b a) (+ c a))|)
+(%autoprove |(= (+ b a) (+ a c))|)
+
+(%autoprove |(= 0 (+ a b))|
+            (%use (%instance (%thm |(< (+ a b) (+ a c))|) (a b) (b 0) (c a)))
+            (%disable default
+                      |(< (+ a b) (+ a c))|
+                      |[OUTSIDE](< (+ a b) (+ a c))|)
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove |lemma for (= (+ a x b) (+ c x d))|)
+
+(%autoprove |(= (+ a x b) (+ c x d))|
+            (%use (%instance (%thm |lemma for (= (+ a x b) (+ c x d))|)
+                             (e a) (b x) (c b) (d c) (f d))))
+
+(%autoprove squeeze-law-one
+            (%enable default nfix))
+
+(%autoprove squeeze-law-two
+            (%enable default nfix))
+
+(%autoprove squeeze-law-three
+            (%enable default nfix))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-5.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-5.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-5.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-5.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,132 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives-4")
+(%interactive)
+
+
+;; Subtraction.
+
+(%autoprove natp-of-minus
+            (%use (build.axiom (axiom-natp-of-minus))))
+
+(%autoprove minus-under-iff
+            (local (%disable default natp-of-minus [outside]natp-of-minus))
+            (%use (%thm natp-of-minus)))
+
+(%autoprove minus-when-not-less
+            (%use (build.axiom (axiom-minus-when-subtrahend-as-large))))
+
+(%autoprove minus-of-self)
+
+(%autoprove minus-of-zero-left)
+
+(%autoprove minus-cancels-summand-right
+            (%use (build.axiom (axiom-minus-cancels-summand-right))))
+
+(%autoprove minus-of-zero-right
+            (%enable default nfix)
+            (%disable default minus-cancels-summand-right [outside]minus-cancels-summand-right)
+            (%use (%instance (%thm minus-cancels-summand-right) (a a) (b 0))))
+
+(%autoprove minus-cancels-summand-left
+            (%disable default commutativity-of-+ nfix)
+            (%eqsubst 't (+ a b) (+ b a)))
+
+(%autoprove |(< (- a b) c)| (%use (build.axiom (axiom-less-of-minus-left))))
+(%autoprove |(< a (- b c))| (%use (build.axiom (axiom-less-of-minus-right))))
+(%disable default |[OUTSIDE](< a (- b c))|) ;; interferes with constant gathering
+
+(%autoprove |(+ a (- b c))| (%use (build.axiom (axiom-plus-of-minus-right))))
+(%autoprove |(+ (- a b) c)|)
+
+(%autoprove |(- a (- b c))| (%use (build.axiom (axiom-minus-of-minus-right))))
+(%autoprove |(- (- a b) c)| (%use (build.axiom (axiom-minus-of-minus-left))))
+(%disable default |[OUTSIDE](- (- a b) c)|) ;; interferes with constant gathering
+
+(%autoprove |(= (- a b) c)| (%use (build.axiom (axiom-equal-of-minus-property))))
+(%autoprove |(= c (- a b))|)
+
+(%autoprove |(- (+ a b) (+ a c))|)
+(%autoprove |(- (+ a b) (+ c a))|)
+(%autoprove |(- (+ b a) (+ c a))|)
+(%autoprove |(- (+ b a) (+ a c))|)
+
+(%autoprove |(- (+ a b) (+ c d a))|)
+
+(%autoprove |a < b --> a <= b-1|
+            (%enable default nfix))
+
+(%autoprove minus-when-zp-left-cheap)
+
+(%autoprove minus-when-zp-right-cheap)
+
+(%autoprove minus-of-nfix-left)
+
+(%autoprove minus-of-nfix-right)
+
+
+
+
+;; Constant Gathering.  We break our normal forms when we can put two constants
+;; next to one another, since they can then be evaluated away to make progress.
+
+(%autoprove gather-constants-from-less-of-plus)
+
+(%autoprove gather-constants-from-less-of-plus-two)
+
+(%autoprove gather-constants-from-less-of-plus-and-plus)
+
+(%autoprove lemma-for-gather-constants-from-equal-of-plus-and-plus)
+
+(%autoprove lemma2-for-gather-constants-from-equal-of-plus-and-plus
+            (%enable default nfix)
+            (%auto)
+            (%use (%instance (%thm trichotomy-of-<) (a c1) (b c2))))
+
+(%autoprove gather-constants-from-equal-of-plus-and-plus
+            (%use (%instance (%thm lemma-for-gather-constants-from-equal-of-plus-and-plus)))
+            (%use (%instance (%thm lemma2-for-gather-constants-from-equal-of-plus-and-plus)))
+            (%split))
+
+(%autoprove gather-constants-from-equal-of-plus
+            (%enable default nfix))
+
+(%autoprove gather-constants-from-minus-of-plus)
+
+(%autoprove gather-constants-from-minus-of-plus-two)
+
+(%autoprove gather-constants-from-minus-of-plus-and-plus)
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-6.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-6.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives-6.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives-6.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,231 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives-5")
+(%interactive)
+
+
+(%autoprove not-equal-when-less)
+(%autoprove not-equal-when-less-two)
+
+(%autoprove |a <= d, b+c <= e --> b+a+c <= d+e|)
+
+(%autoprove |(< (+ a b) (+ c b d))|)
+
+(%autoprove |(< (+ a b c)) (+ d c))|
+            (%disable default
+                      |(< (+ b a c) (+ d a))|
+                      |[OUTSIDE](< (+ b a c) (+ d a))|)
+            (%use (%instance (%thm |(< (+ b a c) (+ d a))|)
+                             (a c) (b a) (c b) (d d))))
+
+(%autoprove |a <= b, b <= c --> a < 1+c|)
+(%autoprove |b <= c, a <= b --> a < 1+c|)
+
+(%autoprove natp-of-max)
+(%autoprove equal-of-max-and-zero)
+(%autoprove max-of-zero-left)
+(%autoprove max-of-zero-right)
+
+(%autoprove natp-of-min)
+(%autoprove equal-of-min-and-zero)
+(%autoprove min-of-zero-left)
+(%autoprove min-of-zero-right)
+
+
+;; Special admission for ordp, ord<, and rank.  We don't use %autoadmit, instead we add
+;; their definitions as axioms, which we convert into theorems now.
+
+(defsection ordp
+  (%prove (%rule ordp
+                 :lhs (ordp x)
+                 :rhs (if (not (consp x))
+                          (natp x)
+                        (and (consp (car x))
+                             (ordp (car (car x)))
+                             (not (equal (car (car x)) 0))
+                             (< 0 (cdr (car x)))
+                             (ordp (cdr x))
+                             (if (consp (cdr x))
+                                 (ord< (car (car (cdr x))) (car (car x)))
+                               t)))))
+  (%use (build.axiom (definition-of-ordp)))
+  (%cleanup)
+  (%qed)
+  ;; Don't enable; definition
+  )
+
+(defsection ord<
+  (%prove (%rule ord<
+                 :lhs (ord< x y)
+                 :rhs (cond ((not (consp x))
+                             (if (consp y) t (< x y)))
+                            ((not (consp y)) nil)
+                            ((not (equal (car (car x)) (car (car y))))
+                             (ord< (car (car x)) (car (car y))))
+                            ((not (equal (cdr (car x)) (cdr (car y))))
+                             (< (cdr (car x)) (cdr (car y))))
+                            (t (ord< (cdr x) (cdr y))))))
+  (%use (build.axiom (definition-of-ord<)))
+  (%cleanup)
+  (%qed)
+  ;; Don't enable; definition
+  )
+
+(defsection rank
+  (%prove (%rule rank
+                 :lhs (rank x)
+                 :rhs (if (consp x)
+                          (+ 1 (+ (rank (car x))
+                                  (rank (cdr x))))
+                        0)))
+  (%use (build.axiom (definition-of-rank)))
+  (%cleanup)
+  (%qed)
+  ;; Don't enable; definition
+  )
+
+
+
+;; NOTE: we had to move booleanp-of-ord< after the rank stuff.
+;; NOTE: we had to move booleanp-of-ordp after the rank stuff.
+
+(%autoprove ord<-when-naturals
+            (%restrict default ord< (equal x 'x)))
+
+(%autoprove ordp-when-natp
+            (%restrict default ordp (equal x 'x)))
+
+(%autoprove natp-of-rank
+            (%restrict default rank (equal x 'x)))
+
+(%autoprove rank-when-not-consp
+            (%restrict default rank (equal x 'x)))
+
+(%autoprove rank-of-cons
+            (%restrict default rank (equal x '(cons x y))))
+
+(%autoprove |(< 0 (rank x))|
+            (%restrict default rank (equal x 'x)))
+
+(%autoprove ordp-of-rank)
+
+(%autoprove rank-of-car
+            (%restrict default rank (equal x 'x)))
+
+(%autoprove rank-of-car-weak
+            (%restrict default rank (equal x 'x)))
+
+(%autoprove rank-of-cdr
+            (%restrict default rank (equal x 'x)))
+
+(%autoprove rank-of-cdr-weak
+            (%restrict default rank (equal x 'x)))
+
+(%autoprove rank-of-second)
+
+(%autoprove rank-of-second-weak
+            (%use (%instance (%thm transitivity-of-<-three)
+                             (a (rank (car (cdr x))))
+                             (b (rank (cdr x)))
+                             (c (rank x)))))
+
+(%autoprove rank-of-third)
+
+(%autoprove rank-of-third-weak
+            (%use (%instance (%thm transitivity-of-<-three)
+                             (a (rank (third x)))
+                             (b (rank (cdr x)))
+                             (c (rank x)))))
+
+(%autoprove rank-of-fourth)
+
+(%autoprove rank-of-fourth-weak
+            (%use (%instance (%thm transitivity-of-<-four)
+                             (a (rank (fourth x)))
+                             (b (rank (cdr x)))
+                             (c (rank x)))))
+
+(%autoprove booleanp-of-ord<
+            ;; Note.  This is a simpler induction scheme than ACL2 picks.  Originally I
+            ;; used ACL2's induction scheme, but with this simpler scheme the proof was
+            ;; about 1/5 the size.
+            (%induct (rank x)
+                     ((not (consp x))
+                      nil)
+                     ((consp x)
+                      (((x (cdr x)) (y (cdr y)))
+                       ((x (car (car x))) (y (car (car y)))))))
+            (%split)
+            (%restrict default ord< (equal x 'x) (equal y 'y)))
+
+(%autoprove booleanp-of-ordp
+            ;; Again we use a simpler induction scheme than ACL2.
+            (%induct (rank x)
+                     ((not (consp x))
+                      nil)
+                     ((consp x)
+                      (((x (car (car x))))
+                       ((x (cdr x))))))
+            (%split)
+            (%restrict default ordp (equal x 'x)))
+
+
+
+
+;; We don't need an equivalent of ord<-is-well-founded; that's just to instruct ACL2
+;; about which well founded relation to use.
+
+(%autoadmit two-nats-measure)
+
+(%autoprove ordp-of-two-nats-measure
+            (%enable default two-nats-measure)
+            (%restrict default ordp (equal x '(CONS (CONS '1 (+ '1 A)) (NFIX B)))))
+
+(%autoprove ord<-of-two-nats-measure
+            (%enable default two-nats-measure)
+            (%restrict default ord< (equal x '(CONS (CONS '1 (+ '1 A1)) (NFIX B1)))))
+
+(%autoadmit three-nats-measure)
+
+(%autoprove ordp-of-three-nats-measure
+            (%enable default three-nats-measure)
+            (%restrict default ordp (or (equal x '(CONS (CONS '2 (+ '1 A)) (CONS (CONS '1 (+ '1 B)) (NFIX C))))
+                                        (equal x '(CONS (CONS '1 (+ '1 B)) (NFIX C))))))
+
+(%autoprove ord<-of-three-nats-measure
+            (%enable default three-nats-measure)
+            (%restrict default ord< (or (equal x '(CONS (CONS '2 (+ '1 A1)) (CONS (CONS '1 (+ '1 B1)) (NFIX C1))))
+                                        (equal x '(CONS (CONS '1 (+ '1 B1)) (NFIX C1))))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/primitives.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/primitives.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,155 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives-6")
+
+(defmacro %cdr-induction (x)
+  `(%induct (rank ,x)
+            ((not (consp ,x))
+             nil)
+            ((consp ,x)
+             (((,x (cdr ,x)))))))
+
+(defmacro %cdr-cdr-induction (x y)
+  `(%induct (rank ,x)
+            ((or (not (consp ,x))
+                 (not (consp ,y)))
+             nil)
+            ((and (consp ,x)
+                  (consp ,y))
+             (((,x (cdr ,x))
+               (,y (cdr ,y)))))))
+
+(defmacro %cdr-cdr-cdr-induction (x y z)
+  `(%induct (rank ,x)
+            ((or (not (consp ,x))
+                 (not (consp ,y))
+                 (not (consp ,z)))
+             nil)
+            ((and (consp ,x)
+                  (consp ,y)
+                  (consp ,z))
+             (((,x (cdr ,x))
+               (,y (cdr ,y))
+               (,z (cdr ,z)))))))
+
+(defmacro %four-cdrs-induction (a b c d)
+  `(%induct (rank ,a)
+            ((or (not (consp ,a))
+                 (not (consp ,b))
+                 (not (consp ,c))
+                 (not (consp ,d)))
+             nil)
+            ((and (consp ,a)
+                  (consp ,b)
+                  (consp ,c)
+                  (consp ,d))
+             (((,a (cdr ,a))
+               (,b (cdr ,b))
+               (,c (cdr ,c))
+               (,d (cdr ,d)))))))
+
+(defmacro %dec-induction (a)
+  `(%induct (nfix ,a)
+            ((zp ,a)
+             nil)
+            ((not (zp ,a))
+             (((,a (- ,a 1)))))))
+
+(defmacro %dec-dec-induction (a b)
+  `(%induct (nfix ,a)
+            ((or (zp ,a)
+                 (zp ,b))
+             nil)
+            ((and (not (zp ,a))
+                  (not (zp ,b)))
+             (((,a (- ,a '1))
+               (,b (- ,b '1)))))))
+
+(defmacro %sub-induction (a b)
+  `(%induct (nfix ,a)
+            ((zp ,b)
+             nil)
+            ((and (not (zp ,b))
+                  (< ,a ,b))
+             nil)
+            ((and (not (zp ,b))
+                  (not (< ,a ,b)))
+             (((,a (- ,a ,b))
+               (,b ,b))))))
+
+(defmacro %car-cdr-induction (x)
+  `(%induct (rank ,x)
+            ((not (consp ,x))
+             nil)
+            ((consp ,x)
+             (((,x (car ,x)))
+              ((,x (cdr ,x)))))))
+
+
+(%ensure-exactly-these-rules-are-missing
+ "../../utilities/primitives"
+ ;; These should be missing because we don't want to add extra axioms for
+ ;; them yet.
+; DEFINITION-OF-BITWISE-NTH
+; DEFINITION-OF-BITWISE-XOR
+; DEFINITION-OF-BITWISE-OR
+; DEFINITION-OF-BITWISE-AND
+; DEFINITION-OF-BITWISE-SHR
+; DEFINITION-OF-BITWISE-SHL
+; DEFINITION-OF-EXPT
+; DEFINITION-OF-MOD
+; DEFINITION-OF-FLOOR
+; DEFINITION-OF-*
+ ;; This is only needed to tell ACL2 to use ord< as its wfr.
+ ORD<-IS-WELL-FOUNDED
+ ;; This is only needed to tell ACL2 to use car-cdr-elim automatically; we
+ ;; use the %car-cdr-elim tactic instead
+ CAR-CDR-ELIM
+
+ ;; BOZO why is this rule missing?
+ ;; Aah, it ought to be local in the ACL2 file but we forgot to keep it local. Stupid us.
+ ;; Relocalize it in the ACL2 file and get rid of it from this list.
+ NATURAL-LESS-THAN-ONE-IS-ZERO
+
+ ;; This isn't part of the logic.
+; UNBOUNDED-RANK
+
+ ;; This one was added to account for changes in ACL2 6.2.
+ EQUAL-OF-CONS-REWRITE-CONSTANTS
+ )
+
+
+(%save-events "primitives.events")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/remove-all-from-ranges.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/remove-all-from-ranges.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/remove-all-from-ranges.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/remove-all-from-ranges.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,74 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tuple-listp")
+(include-book "list-list-fix")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(%autoadmit remove-all-from-ranges)
+
+(%autoprove remove-all-from-ranges-when-not-consp
+            (%restrict default remove-all-from-ranges (equal x 'x)))
+
+(%autoprove remove-all-from-ranges-of-cons
+            (%restrict default remove-all-from-ranges (equal x '(cons b x))))
+
+(%autoprove true-listp-of-remove-all-from-ranges
+            (%cdr-induction x))
+
+(%autoprove true-list-listp-of-remove-all-from-ranges
+            (%cdr-induction x))
+
+(%autoprove mapp-of-remove-all-from-ranges
+            (%cdr-induction x))
+
+(%autoprove remove-all-from-ranges-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove remove-all-from-ranges-of-list-list-fix
+            (%cdr-induction x))
+
+(%autoprove remove-all-from-ranges-of-app
+            (%cdr-induction x))
+
+(%autoprove remove-all-from-ranges-of-rev
+            (%cdr-induction x))
+
+(%autoprove len-of-remove-all-from-ranges
+            (%cdr-induction x))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/remove-duplicates-list.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/remove-duplicates-list.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/remove-duplicates-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/remove-duplicates-list.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,49 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cons-listp")
+(%interactive)
+
+(%defprojection :list (remove-duplicates-list x)
+                :element (remove-duplicates x)
+                :nil-preservingp t)
+
+(%autoprove consp-of-remove-duplicates
+            (%cdr-induction x))
+
+(%autoprove cons-listp-of-remove-duplicates-list
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/remove-duplicates-list")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/simple-flatten.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/simple-flatten.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/simple-flatten.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/simple-flatten.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,94 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "list-list-fix")
+(%interactive)
+
+
+(%autoadmit slow-simple-flatten)
+
+(%autoprove slow-simple-flatten-when-not-consp
+            (%restrict default slow-simple-flatten (equal x 'x)))
+
+(%autoprove slow-simple-flatten-of-cons
+            (%restrict default slow-simple-flatten (equal x '(cons a x))))
+
+(%autoadmit fast-simple-flatten$)
+
+(%autoadmit simple-flatten)
+
+(%autoprove lemma-for-definition-of-simple-flatten
+            (%autoinduct fast-simple-flatten$)
+            (%restrict default fast-simple-flatten$ (equal x 'x)))
+
+(%autoprove definition-of-simple-flatten
+            (%enable default simple-flatten lemma-for-definition-of-simple-flatten))
+
+(%autoprove simple-flatten-when-not-consp
+            (%restrict default definition-of-simple-flatten (equal x 'x)))
+
+(%autoprove simple-flatten-of-cons
+            (%restrict default definition-of-simple-flatten (equal x '(cons a x))))
+
+(%autoprove true-listp-of-simple-flatten
+            (%cdr-induction x))
+
+(%autoprove simple-flatten-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove simple-flatten-of-app
+            (%cdr-induction x))
+
+(%autoprove simple-flatten-of-list-list-fix
+            (%cdr-induction x))
+
+(%autoprove forcing-fast-simple-flatten$-removal
+            (%autoinduct fast-simple-flatten$)
+            (%restrict default fast-simple-flatten$ (equal x 'x)))
+
+
+(%autoadmit fast-simple-flatten-of-domain$)
+
+(%autoprove fast-simple-flatten-of-domain$-removal
+            (%autoinduct fast-simple-flatten-of-domain$)
+            (%restrict default fast-simple-flatten-of-domain$ (equal x 'x)))
+
+(%autoadmit fast-simple-flatten-of-range$)
+
+(%autoprove fast-simple-flatten-of-range$-removal
+            (%autoinduct fast-simple-flatten-of-range$)
+            (%restrict default fast-simple-flatten-of-range$ (equal x 'x)))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/simple-flatten")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/sort-symbols.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/sort-symbols.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/sort-symbols.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/sort-symbols.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,99 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(%interactive)
+
+
+(%autoadmit sort-symbols-insert)
+
+(%autoprove sort-symbols-insert-when-not-consp
+            (%restrict default sort-symbols-insert (equal x 'x)))
+
+(%autoprove sort-symbols-insert-of-cons
+            (%restrict default sort-symbols-insert (equal x '(cons b x))))
+
+(%autoprove memberp-of-sort-symbols-insert
+            (%cdr-induction x))
+
+(%autoprove len-of-sort-symbols-insert
+            (%cdr-induction x))
+
+(%autoprove consp-of-sort-symbols-insert
+            (%cdr-induction x))
+
+(%autoprove car-of-sort-symbols-insert)
+
+(%autoprove uniquep-of-sort-symbols-insert
+            (%cdr-induction x))
+
+
+(%autoadmit sort-symbols)
+
+(%autoprove sort-symbols-when-not-consp
+            (%restrict default sort-symbols (equal x 'x)))
+
+(%autoprove sort-symbols-of-cons
+            (%restrict default sort-symbols (equal x '(cons a x))))
+
+(%autoprove memberp-of-sort-symbols
+            (%cdr-induction x))
+
+(%autoprove len-of-sort-symbols
+            (%cdr-induction x))
+
+(%autoprove disjointp-of-sort-symbols
+            (%cdr-induction x))
+
+(%autoprove uniquep-of-sort-symbols
+            (%cdr-induction x))
+
+
+(%autoadmit symbol-list-orderedp)
+
+(%autoprove symbol-list-orderedp-when-not-consp
+            (%restrict default symbol-list-orderedp (equal x 'x)))
+
+(%autoprove symbol-list-orderedp-when-not-consp-of-cdr
+            (%restrict default symbol-list-orderedp (equal x 'x)))
+
+(%autoprove symbol-list-orderedp-of-cons
+            (%restrict default symbol-list-orderedp (equal x '(cons a x))))
+
+(%autoprove symbol-list-orderedp-of-sort-symbols-insert
+            (%cdr-induction x))
+
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/sort-symbols")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/strip-firsts.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/strip-firsts.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/strip-firsts.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/strip-firsts.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%defprojection :list (strip-firsts x)
+                :element (first x)
+                :nil-preservingp t)
+
+(%autoprove rank-of-strip-firsts-weak
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/strip-firsts")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/strip-lens.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/strip-lens.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/strip-lens.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/strip-lens.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "nat-listp")
+(%interactive)
+
+(%defprojection :list (strip-lens x)
+                :element (len x))
+
+(%autoprove nat-listp-of-strip-lens
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/strip-lens")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/strip-seconds.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/strip-seconds.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/strip-seconds.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/strip-seconds.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%defprojection :list (strip-seconds x)
+                :element (second x)
+                :nil-preservingp t)
+
+(%autoprove rank-of-strip-seconds-weak
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/strip-seconds")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/strip-thirds.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/strip-thirds.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/strip-thirds.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/strip-thirds.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%defprojection :list (strip-thirds x)
+                :element (third x)
+                :nil-preservingp t)
+
+(%autoprove rank-of-strip-thirds-weak
+            (%cdr-induction x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/strip-thirds")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/symbol-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/symbol-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/symbol-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/symbol-listp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,42 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(%interactive)
+
+(%deflist symbol-listp (x)
+  (symbolp x))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/symbol-listp")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/symmetry acl2-6.3/books/milawa/ACL2/bootstrap/utilities/symmetry
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/symmetry	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/symmetry	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ../../acl2-images/utilities-symmetry "$@"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/top.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/top.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/top.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,166 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(include-book "all-at-leastp")
+(include-book "all-equalp")
+;(include-book "bitwise-support")          ; shouldn't be necessary
+(include-book "clean-update")
+(include-book "cons-listp")
+(include-book "cons-onto-ranges")
+(include-book "defaggregate")
+(include-book "deflist")
+(include-book "defmap")
+(include-book "extended-subsets")
+(include-book "fast-remove-supersets")
+(include-book "intersect")
+(include-book "list-list-fix")
+(include-book "listify-each")
+(include-book "map-listp")
+(include-book "mergesort")
+(include-book "mergesort-map")
+(include-book "multicons")
+(include-book "mutually-disjoint")
+(include-book "nat-listp")
+(include-book "ordered-subsetp")
+(include-book "primitives")
+(include-book "remove-duplicates-list")
+(include-book "remove-all-from-ranges")
+(include-book "simple-flatten")
+(include-book "strip-firsts")
+(include-book "strip-lens")
+(include-book "strip-seconds")
+(include-book "strip-thirds")
+(include-book "sort-symbols")
+(include-book "symbol-listp")
+(include-book "total-order")
+(include-book "tuple-listp")
+(include-book "utilities")
+
+
+(%create-theory type-set-like-rules)
+(%enable type-set-like-rules
+         equal-of-non-cons-and-cons-cheap
+         equal-of-symbol-and-non-symbol-cheap
+         equal-of-non-symbol-and-symbol-cheap
+         equal-of-cons-and-non-cons-cheap
+         equal-of-nat-and-non-nat-cheap
+         equal-of-non-nat-and-nat-cheap
+         consp-when-natp-cheap
+         consp-when-nothing-else-cheap
+         symbolp-when-booleanp-cheap
+         symbolp-when-consp-cheap
+         symbolp-when-natp-cheap
+         car-when-symbolp-cheap
+         booleanp-when-natp-cheap
+         booleanp-when-consp-cheap)
+
+(%create-theory expensive-arithmetic-rules)
+(%enable expensive-arithmetic-rules
+         not-equal-when-less
+         not-equal-when-less-two
+         trichotomy-of-<
+         antisymmetry-of-<)
+
+(%create-theory expensive-arithmetic-rules-two)
+(%enable expensive-arithmetic-rules-two
+         |a <= b, c != 0 --> a < c+b|
+         |a <= b, c != 0 --> a < b+c|
+         |b <= c, a <= b --> a < 1+c|
+         transitivity-of-<
+         transitivity-of-<-two
+         transitivity-of-<-three
+         transitivity-of-<-four
+         squeeze-law-two
+         one-plus-trick
+         less-when-zp-left-cheap
+         less-when-zp-right-cheap
+         plus-when-zp-right-cheap
+         natp-when-zp-cheap
+         natp-when-not-zp-cheap
+         nfix-when-zp-cheap
+         nfix-when-not-natp-cheap
+         zp-when-not-natp-cheap
+         zp-when-natp-cheap)
+
+(%create-theory expensive-subsetp-rules)
+(%enable expensive-subsetp-rules
+         subsetp-when-prefixp-cheap
+         subsetp-when-ordered-subsetp
+         memberp-when-not-subset-of-somep-cheap
+         memberp-when-not-superset-of-somep-cheap)
+
+(%create-theory unusual-memberp-rules)
+(%enable unusual-memberp-rules
+         memberp-when-not-superset-of-somep-cheap
+         memberp-when-not-subset-of-somep-cheap
+         memberp-when-memberp-of-member-of-nonep-alt)
+
+(%create-theory unusual-subsetp-rules)
+(%enable unusual-subsetp-rules
+         subsetp-when-prefixp-cheap
+         subsetp-when-ordered-subsetp)
+
+(%create-theory unusual-consp-rules)
+(%enable unusual-consp-rules
+         consp-when-memberp-of-cons-listp-alt
+         consp-when-memberp-of-none-consp-alt
+         consp-of-cdr-when-tuplep-2-cheap
+         consp-of-cdr-when-tuplep-3-cheap
+         consp-of-cdr-of-cdr-when-tuplep-3-cheap
+         consp-of-car-when-none-consp
+         consp-of-car-when-cons-listp
+         consp-of-cdr-when-len-two-cheap
+         consp-of-cdr-when-memberp-not-car-cheap)
+
+(%create-theory usual-consp-rules)
+(%enable usual-consp-rules
+         car-when-not-consp
+         cdr-when-not-consp
+         consp-when-true-listp-cheap
+         consp-when-consp-of-cdr-cheap
+         cdr-of-cdr-with-len-free-past-the-end
+         cdr-when-true-listp-with-len-free-past-the-end
+         cdr-of-cdr-when-true-listp-with-len-free-past-the-end
+         consp-of-cdr-with-len-free
+         consp-of-cdr-of-cdr-with-len-free
+         cdr-under-iff-when-true-listp-with-len-free
+         cdr-of-cdr-under-iff-when-true-listp-with-len-free)
+
+(%finish "utilities")
+(%save-events "utilities.events")
+
+;; Clear out the thmfiles table since we'll use the saved image from now on.
+(ACL2::table tactic-harness 'thmfiles nil)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/total-order.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/total-order.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/total-order.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/total-order.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,100 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives")
+(%interactive)
+
+
+(defsection consp-when-nothing-else-cheap
+  (%prove (%rule consp-when-nothing-else-cheap
+                 :hyps (list (%hyp (not (natp x)) :limit 0)
+                             (%hyp (not (symbolp x)) :limit 0))
+                 :lhs (consp x)
+                 :rhs t))
+  (%use (build.axiom (axiom-closed-universe)))
+  (%auto)
+  (%qed)
+  (%enable default consp-when-nothing-else-cheap))
+
+(%autoadmit <<)
+
+(defmacro %<<-induction (x y)
+  `(%induct (rank x)
+            ((natp x) nil)
+            ((natp y) nil)
+            ((symbolp x) nil)
+            ((symbolp y) nil)
+            ((and (consp x)
+                  (consp y))
+             (((,x (car ,x)) (,y (car ,y)))
+              ((,x (cdr ,x)) (,y (cdr ,y)))))))
+
+(%autoprove booleanp-of-<<
+            (%<<-induction x y)
+            (%restrict default << (equal x 'x)))
+
+(%autoprove irreflexivity-of-<<
+            (%induct (rank x)
+                     ((natp x) nil)
+                     ((symbolp x) nil)
+                     ((consp x)
+                      (((x (car x)))
+                       ((x (cdr x))))))
+            (%restrict default << (equal x 'x)))
+
+(%autoprove asymmetry-of-<<
+            (%<<-induction x y)
+            (%restrict default << (or (equal x 'x)
+                                      (equal x 'y))))
+
+(%autoprove transitivity-of-<<
+            (%induct (rank x)
+                     ((not (consp x))
+                      nil)
+                     ((consp x)
+                      (((x (car x)) (y (car y)) (z (car z)))
+                       ((x (cdr x)) (y (cdr y)) (z (cdr z))))))
+            (%auto :strategy (cleanup split crewrite))
+            (%restrict default << (or (equal x 'x)
+                                      (equal x 'y)))
+            (%auto :strategy (cleanup split crewrite elim)))
+
+(%autoprove forcing-trichotomy-of-<<
+            (%<<-induction x y)
+            (%restrict default << (or (equal x 'x)
+                                      (equal x 'y))))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/total-order")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/tuple-listp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/tuple-listp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/tuple-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/tuple-listp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,118 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "strip-firsts")
+(include-book "strip-seconds")
+(include-book "strip-lens")
+(%interactive)
+
+
+(%deflist true-list-listp (x)
+          (true-listp x))
+
+
+
+(%deflist tuple-listp (n x)
+          (tuplep n x))
+
+(%autoprove rank-of-strip-firsts-when-tuple-listp-2
+            (%cdr-induction x))
+
+(%autoprove rank-of-strip-seconds-when-tuple-listp-2
+            (%cdr-induction x))
+
+(%autoprove strip-lens-when-tuple-listp
+            (%cdr-induction x)
+            (%auto)
+            (%fertilize (strip-lens x2) (repeat (nfix n) (len x2))))
+
+
+
+(%autoadmit list2-list)
+
+(%autoprove list2-list-when-not-consp-one
+            (%restrict default list2-list (equal x 'x)))
+
+(%autoprove list2-list-when-not-consp-two
+            (%restrict default list2-list (equal x 'x)))
+
+(%autoprove list2-list-of-cons-and-cons
+            (%restrict default list2-list (equal x '(cons a x))))
+
+(%autoprove true-listp-of-list2-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove true-listp-list-of-list2-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove list2-list-of-list-fix-one
+            (%cdr-cdr-induction x y))
+
+(%autoprove list2-list-of-list-fix-two
+            (%cdr-cdr-induction x y))
+
+(%autoprove len-of-list2-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove strip-lens-of-list2-list
+            (%cdr-cdr-induction x y))
+
+
+(defsection more-than-two-when-not-zero-one-or-two
+  ;; This isn't needed in ACL2.  not sure why we need it.
+  ;; BOZO might this have to do with our missing rule?
+  (%prove (%rule more-than-two-when-not-zero-one-or-two
+                 :hyps (list (%hyp (not (zp n)))
+                             (%hyp (not (equal 1 n)))
+                             (%hyp (not (equal 2 n))))
+                 :lhs (< 2 n)
+                 :rhs t))
+  (%use (%instance (%thm squeeze-law-one) (b 2) (a n)))
+  (%auto)
+  (%qed))
+
+(%autoprove tuple-listp-of-list2-list
+            (%cdr-cdr-induction x y)
+            (%enable default more-than-two-when-not-zero-one-or-two))
+
+(%autoprove forcing-strip-firsts-of-list2-list
+            (%cdr-cdr-induction x y))
+
+(%autoprove forcing-strip-seconds-of-list2-list
+            (%cdr-cdr-induction x y))
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/tuple-listp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-1.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-1.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-1.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,314 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives")
+(%interactive)
+
+
+;; BOZO move this stuff to ACL2 utilities file
+
+(defthmd equal-of-2-and-len
+  ;; BOZO move this to ACL2 utilities
+  (equal (equal 2 (len x))
+         (and (consp x)
+              (consp (cdr x))
+              (not (consp (cdr (cdr x)))))))
+
+(defthmd equal-of-3-and-len
+  (equal (equal 3 (len x))
+         (and (consp x)
+              (consp (cdr x))
+              (consp (cdr (cdr x)))
+              (not (consp (cdr (cdr (cdr x))))))))
+
+(defthm consp-when-consp-of-cdr-cheap
+  (implies (consp (cdr x))
+           (equal (consp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+
+
+
+(%autoadmit len)
+
+(%autoprove len-when-not-consp
+            (%restrict default len (equal x 'x)))
+
+(%autoprove len-of-cons
+            (%restrict default len (equal x '(cons a x))))
+
+(%autoprove natp-of-len
+            (%cdr-induction x))
+
+(%autoprove natp-of-len-free)
+
+(%autoprove len-under-iff
+            (%use (%instance (%thm natp-of-len)))
+            (%disable default natp-of-len natp-of-len-free [outside]natp-of-len))
+
+(%autoprove |(< 0 (len x))|)
+
+(%autoprove |(< 1 (len x))|)
+
+(%autoprove decrement-len-when-consp)
+
+(%autoprove equal-of-len-and-zero)
+
+(defsection [outside]equal-of-len-and-zero-alt
+  (%prove (%rule [outside]equal-of-len-and-zero-alt
+                 :type outside
+                 :lhs (equal (len x) 0)
+                 :rhs (not (consp x))))
+  (%auto)
+  (%qed)
+  (%enable default [outside]equal-of-len-and-zero-alt))
+
+(%autoprove consp-of-cdr-when-len-two-cheap)
+
+
+;; We can solve (consp (cdr ... (cdr x))) when we know the length of x.
+
+(%autoprove consp-of-cdr-with-len-free)
+(%autoprove consp-of-cdr-of-cdr-with-len-free)
+(%autoprove consp-of-cdr-of-cdr-of-cdr-with-len-free)
+
+
+;; We can solve (cdr ... (cdr x)) under iff when we know the length of x.
+
+(%autoprove cdr-under-iff-with-len-free-in-bound)
+(%autoprove cdr-of-cdr-under-iff-with-len-free-in-bound)
+(%autoprove cdr-of-cdr-of-cdr-under-iff-with-len-free-in-bound)
+(%autoprove cdr-of-cdr-with-len-free-past-the-end)
+(%autoprove cdr-of-cdr-of-cdr-with-len-free-past-the-end)
+
+(%autoprove len-2-when-not-cdr-of-cdr)
+
+(%autoprove equal-when-length-different)
+
+(%autoprove equal-of-2-and-len)
+
+(%autoprove equal-of-3-and-len
+            (%restrict default len (memberp x '(x (cdr x) (cdr (cdr x))))))
+
+(%autoprove consp-when-consp-of-cdr-cheap)
+
+
+
+
+
+
+(%autoadmit fast-len)
+
+(%autoprove fast-len-removal
+            (%autoinduct fast-len)
+            (%restrict default fast-len (equal x 'x)))
+
+(%autoadmit same-lengthp)
+
+(%autoprove same-lengthp-removal
+            (%cdr-cdr-induction x y)
+            (%restrict default same-lengthp (equal x 'x)))
+
+
+(%autoadmit true-listp)
+
+(%autoprove true-listp-when-not-consp
+            (%restrict default true-listp (equal x 'x)))
+
+(%autoprove true-listp-of-cons
+            (%restrict default true-listp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-true-listp
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-cdr)
+
+(%autoprove consp-when-true-listp-cheap)
+
+(%autoprove list-of-first-and-second-when-len-2)
+(%autoprove list-of-first-and-second-and-third-when-len-3)
+
+(%autoprove cdr-when-true-listp-with-len-free-past-the-end)
+(%autoprove cdr-of-cdr-when-true-listp-with-len-free-past-the-end)
+(%autoprove cdr-of-cdr-of-cdr-when-true-listp-with-len-free-past-the-end)
+
+(%autoprove cdr-under-iff-when-true-listp-with-len-free)
+(%autoprove cdr-of-cdr-under-iff-when-true-listp-with-len-free)
+(%autoprove cdr-of-cdr-of-cdr-under-iff-when-true-listp-with-len-free)
+
+(defsection less-of-len-of-cdr-and-len
+  ;; BOZO add to ACL2 file
+  (%prove (%rule less-of-len-of-cdr-and-len
+                 :lhs (< (len (cdr x)) (len x))
+                 :rhs (consp x)))
+  (%auto)
+  (%qed)
+  (%enable default less-of-len-of-cdr-and-len))
+
+
+
+
+(%autoadmit list-fix)
+
+(%autoprove list-fix-when-not-consp
+            (%restrict default list-fix (equal x 'x)))
+
+(%autoprove list-fix-of-cons
+            (%restrict default list-fix (equal x '(cons a x))))
+
+(%autoprove car-of-list-fix)
+(%autoprove cdr-of-list-fix)
+
+(%autoprove consp-of-list-fix)
+
+(%autoprove list-fix-under-iff)
+
+(%autoprove len-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove list-fix-when-true-listp
+            (%cdr-induction x))
+
+(%autoprove cdr-of-list-fix-under-iff)
+
+(%autoprove equal-of-list-fix-and-self
+            (%cdr-induction x))
+
+
+
+
+
+
+
+
+
+(%autoadmit memberp)
+
+(%autoprove memberp-when-not-consp
+            (%restrict default memberp (equal x 'x)))
+
+(%autoprove memberp-of-cons
+            (%restrict default memberp (equal x '(cons b x))))
+
+(%autoprove booleanp-of-memberp
+            (%cdr-induction x))
+
+(%autoprove memberp-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove memberp-when-memberp-of-cdr)
+
+(%autoprove memberp-of-car)
+
+(%autoprove memberp-of-second)
+
+(%autoprove car-when-memberp-of-singleton-list-cheap)
+
+(%autoprove car-when-memberp-and-not-memberp-of-cdr-cheap)
+
+(%autoprove consp-when-memberp-cheap)
+
+(%autoprove consp-of-cdr-when-memberp-not-car-cheap)
+
+(%autoprove rank-when-memberp
+            (%cdr-induction x))
+
+(%autoprove rank-when-memberp-weak
+            (%cdr-induction x))
+
+
+
+(%autoadmit subsetp)
+
+(%autoprove subsetp-when-not-consp
+            (%restrict default subsetp (equal x 'x)))
+
+(%autoprove subsetp-of-cons
+            (%restrict default subsetp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-subsetp
+            (%cdr-induction x))
+
+(%autoprove subsetp-when-not-consp-two
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-cons-two
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-list-fix-one
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-list-fix-two
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-cdr)
+
+(%autoprove in-superset-when-in-subset-one
+            (%cdr-induction x))
+
+(%autoprove in-superset-when-in-subset-two)
+
+(%autoprove not-in-subset-when-not-in-superset-one)
+
+(%autoprove not-in-subset-when-not-in-superset-two)
+
+(%autoprove consp-when-nonempty-subset-cheap)
+
+(%autoprove subsetp-reflexive
+            (%cdr-induction x))
+
+(%autoprove subsetp-transitive-one
+            (%cdr-induction x))
+
+(%autoprove subsetp-transitive-two)
+
+
+
+(%autoadmit subsetp-badguy)
+
+(%autoprove subsetp-badguy-membership-property
+            (%cdr-induction x)
+            (%restrict default subsetp-badguy (equal x 'x)))
+
+(%autoprove subsetp-badguy-under-iff
+            (%cdr-induction x)
+            (%restrict default subsetp (equal x 'x))
+            (%restrict default subsetp-badguy (equal x 'x)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-2.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-2.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-2.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,145 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-1")
+(%interactive)
+
+(defsection equal-of-cdr-and-self
+  ;; BOZO I don't have this rule in ACL2.  Maybe I should add it?
+  ;; BOZO Move this to primitives somewhere
+  (%prove (%rule equal-of-cdr-and-self
+                 :lhs (equal x (cdr x))
+                 :rhs (not x)))
+  (local (%disable default rank-of-cdr [outside]rank-of-cdr))
+  (%use (%instance (%thm rank-of-cdr)))
+  (%auto)
+  (%qed)
+  (%enable default equal-of-cdr-and-self))
+
+(%autoadmit app)
+
+(%autoprove app-when-not-consp
+            (%restrict default app (equal x 'x)))
+
+(%autoprove app-of-cons
+            (%restrict default app (equal x '(cons a x))))
+
+(%autoprove app-of-list-fix-one
+            (%cdr-induction x))
+
+(%autoprove app-of-list-fix-two
+            (%cdr-induction x))
+
+(%autoprove app-when-not-consp-two
+            (%cdr-induction x))
+
+(%autoprove app-of-singleton-list-cheap)
+
+(%autoprove true-listp-of-app
+            (%cdr-induction x))
+
+(%autoprove app-of-app
+            (%cdr-induction x))
+
+(%autoprove memberp-of-app
+            (%cdr-induction x))
+
+(%autoprove consp-of-app)
+
+(%autoprove app-under-iff)
+
+(%autoprove len-of-app
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-app-one
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-app-two
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x x) (y (app x y)))))
+
+(%autoprove subsetp-of-app-three
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x y) (y (app x y)))))
+
+(%autoprove subsetp-of-app-when-subsets
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (app x w)) (y (app y z)))))
+
+(%autoprove subsetp-of-symmetric-apps
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (app x y)) (y (app y x)))))
+
+(%autoprove weirdo-rule-for-subsetp-of-app-one)
+(%autoprove weirdo-rule-for-subsetp-of-app-two)
+
+(%autoprove cdr-of-app-when-x-is-consp)
+(%autoprove car-of-app-when-x-is-consp)
+(%autoprove memberp-of-app-onto-singleton)
+
+(%autoprove subsetp-of-app-onto-singleton-with-cons
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (app x (list a))) (y (cons a x)))))
+
+(%autoprove subsetp-of-cons-with-app-onto-singleton
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (cons a x)) (y (app x (list a))))))
+
+(%autoprove subsetp-of-cons-of-app-of-app-one
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x x) (y (cons b (app y (app x z)))))))
+
+(%autoprove subsetp-of-cons-of-app-of-app-two
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x x) (y (cons a (app y (app z x)))))))
+
+(%autoprove subsetp-of-app-of-app-when-subsetp-one
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x x) (y (app a (app y b))))))
+
+(%autoprove subsetp-of-app-of-app-when-subsetp-two
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x x) (y (app a (app b y))))))
+
+(%autoprove app-of-cons-of-list-fix-right
+            (%cdr-induction x))
+
+(%autoprove app-of-cons-when-not-consp-right
+            (%cdr-induction x))
+
+(%autoprove equal-of-app-and-app-when-equal-lens
+            (%cdr-cdr-induction a c))
+
+(%autoprove lemma-for-equal-of-app-and-self
+            (%cdr-induction x))
+
+(%autoprove equal-of-app-and-self
+            (%cdr-induction x)
+            (%enable default lemma-for-equal-of-app-and-self)
+            (%auto :strategy (cleanup urewrite split crewrite)) ;; elim uglies it up
+            (%use (%instance (%thm len-of-app)))
+            (%use (%instance (%thm len-of-app) (x (cdr x))))
+            (%disable default len-of-app [outside]len-of-app))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-3.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-3.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-3.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,119 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-2")
+(%interactive)
+
+
+
+(%autoadmit rev)
+
+(%autoprove rev-when-not-consp
+            (%restrict default rev (equal x 'x)))
+
+(%autoprove rev-of-cons
+            (%restrict default rev (equal x '(cons a x))))
+
+(%autoprove rev-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-rev
+            (%car-cdr-elim x))
+
+(%autoprove rev-under-iff)
+
+(%autoprove len-of-rev
+            (%cdr-induction x))
+
+(%autoprove memberp-of-rev
+            (%cdr-induction x))
+
+(%autoprove memberp-of-first-of-rev
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-rev-one
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (rev x)) (y x)))
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x x) (y (rev x)))))
+
+(%autoprove subsetp-of-rev-two
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x y) (y (rev y))))
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (rev y)) (y y))))
+
+(%autoprove lemma-for-rev-of-rev
+            (%cdr-induction x))
+
+(%autoprove rev-of-rev
+            (%cdr-induction x)
+            (%enable default lemma-for-rev-of-rev))
+
+(%autoprove rev-of-app
+            (%cdr-induction x)
+            (%auto)
+            (%fertilize (rev (app x2 y)) (app (rev y) (rev x2))))
+
+(%autoprove subsetp-of-app-of-rev-of-self-one
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-app-of-rev-of-self-two
+            (%cdr-induction x))
+
+
+
+(%autoadmit revappend)
+
+(%autoprove revappend-when-not-consp
+            (%restrict default revappend (equal x 'x)))
+
+(%autoprove revappend-of-cons
+            (%restrict default revappend (equal x '(cons a x))))
+
+(%autoprove forcing-revappend-removal
+            (%autoinduct revappend)
+            (%enable default revappend-when-not-consp revappend-of-cons))
+
+
+
+(%autoadmit fast-rev)
+
+(%autoprove fast-rev-removal
+            (%enable default fast-rev))
+
+
+
+(%autoadmit fast-app)
+
+(%autoprove fast-app-removal
+            (%enable default fast-app))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-difference.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-difference.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-difference.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-difference.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,94 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-3")
+(%interactive)
+
+
+(%autoadmit difference)
+
+(%autoprove difference-when-not-consp
+            (%restrict default difference (equal x 'x)))
+
+(%autoprove difference-of-cons
+            (%restrict default difference (equal x '(cons a x))))
+
+(%autoprove true-listp-of-difference
+            (%cdr-induction x))
+
+(%autoprove difference-of-list-fix-one
+            (%cdr-induction x))
+
+(%autoprove difference-of-list-fix-two
+            (%cdr-induction x))
+
+(%autoprove difference-of-app-one
+            (%cdr-induction x))
+
+(%autoprove difference-of-difference
+            (%cdr-induction x))
+
+(%autoprove rev-of-difference
+            (%cdr-induction x))
+
+(%autoprove difference-of-rev)
+
+(%autoprove difference-of-rev-two
+            (%cdr-induction x))
+
+(%autoprove memberp-of-difference
+            (%cdr-induction x))
+
+(%autoprove difference-when-subsetp
+            (%cdr-induction x))
+
+(%autoprove subsetp-with-app-of-difference-onto-takeaway
+            (%cdr-induction x))
+
+
+
+(%autoadmit fast-difference$)
+
+(%autoprove fast-difference$-when-not-consp
+            (%restrict default fast-difference$ (equal x 'x)))
+
+(%autoprove fast-difference$-of-cons
+            (%restrict default fast-difference$ (equal x '(cons a x))))
+
+(%autoprove forcing-fast-difference$-removal
+            (%enable default fast-difference$-when-not-consp)
+            (%enable default fast-difference$-of-cons)
+            (%autoinduct fast-difference$))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-disjointp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-disjointp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-disjointp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-disjointp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,107 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-3")
+(%interactive)
+
+
+
+(%autoadmit disjointp)
+
+
+(%autoprove disjointp-when-not-consp-one
+            (%restrict default disjointp (equal x 'x)))
+
+(%autoprove disjointp-of-cons-one
+            (%restrict default disjointp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-disjointp
+            (%cdr-induction x))
+
+(%autoprove disjointp-when-not-consp-two
+            (%cdr-induction x))
+
+(%autoprove disjointp-of-cons-two
+            (%cdr-induction x))
+
+(%autoprove symmetry-of-disjointp
+            (%cdr-induction x))
+
+(%autoprove disjointp-of-list-fix-one
+            (%cdr-induction x))
+
+(%autoprove disjointp-of-list-fix-two
+            (%disable default symmetry-of-disjointp)
+            (%use (%instance (%thm symmetry-of-disjointp) (x x) (y (list-fix y))))
+            (%use (%instance (%thm symmetry-of-disjointp) (x y) (y x))))
+
+(%autoprove disjointp-of-singleton-one)
+(%autoprove disjointp-of-singleton-two)
+
+(%autoprove disjointp-when-common-member-one
+            (%cdr-induction x))
+
+(%autoprove disjointp-when-common-member-two)
+
+(%autoprove disjointp-of-app-two
+            (%cdr-induction x))
+
+(%autoprove disjointp-of-app-one)
+
+(%autoprove disjointp-of-rev-two
+            (%cdr-induction x))
+
+(%autoprove disjointp-of-rev-one)
+
+(%autoprove disjointp-when-subsetp-of-disjointp-one
+            (%cdr-induction x))
+
+(%autoprove disjointp-when-subsetp-of-disjointp-two)
+
+(%autoprove disjointp-when-subsetp-of-disjointp-three
+            (%cdr-induction x))
+
+(%autoprove disjointp-when-subsetp-of-disjointp-four)
+
+(%autoprove disjointp-when-subsetp-of-other-one
+            (%cdr-induction x))
+
+(%autoprove disjointp-when-subsetp-of-other-two
+            (%cdr-induction y))
+
+(%autoprove memberp-when-disjointp-one
+            (%cdr-induction x))
+
+(%autoprove memberp-when-disjointp-two)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-nth.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-nth.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-nth.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-nth.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,72 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-3")
+(%interactive)
+
+
+(%autoadmit nth)
+
+(%autoprove nth-when-zp
+            (%restrict default nth (equal n 'n)))
+
+(%autoprove nth-of-nfix
+            (%restrict default nfix (memberp n '(n (nfix n)))))
+
+(%autoprove nth-of-list-fix
+            (%autoinduct nth)
+            (%restrict default nth (equal n 'n)))
+
+(%autoprove nth-when-index-too-large
+            (%autoinduct nth)
+            (%restrict default nth (equal n 'n)))
+
+(%autoprove nth-of-increment
+            (%restrict default nth (equal n '(+ '1 n))))
+
+(%autoprove nth-of-app
+            (%autoinduct nth)
+            (%restrict default nth (equal n 'n)))
+
+(%autoprove nth-of-rev
+            (%cdr-induction x)
+            (%restrict default nth (memberp n '((- n (len x2)) (- (len x2) n)))))
+
+(%autoprove memberp-of-nth
+            (%autoinduct nth)
+            (%restrict default nth (equal n 'n)))
+
+;; see also utilities-4.lisp for more theorems about nth
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-remove-all.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-remove-all.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-remove-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-remove-all.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,105 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-3")
+(%interactive)
+
+
+
+(%autoadmit remove-all)
+
+(%autoprove remove-all-when-not-consp
+            (%restrict default remove-all (equal x 'x)))
+
+(%autoprove remove-all-of-cons
+            (%restrict default remove-all (equal x '(cons b x))))
+
+(%autoprove remove-all-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-remove-all
+            (%cdr-induction x))
+
+(%autoprove memberp-of-remove-all
+            (%cdr-induction x))
+
+(%autoprove remove-all-of-app
+            (%cdr-induction x))
+
+(%autoprove rev-of-remove-all
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-remove-all-with-x
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-remove-all-with-remove-all
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x (remove-all a x))
+                             (y (remove-all a y)))))
+
+(%autoprove subsetp-of-remove-all-when-subsetp)
+
+(%autoprove remove-all-of-non-memberp
+            (%cdr-induction x))
+
+(%autoprove remove-all-of-remove-all
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-cons-and-remove-all-two
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x (cons a y))
+                             (y (cons a (remove-all a y))))))
+
+
+
+
+(%autoprove lemma-for-equal-of-len-of-remove-all-and-len
+            (%cdr-induction x))
+
+(%autoprove equal-of-len-of-remove-all-and-len
+            (%enable default lemma-for-equal-of-len-of-remove-all-and-len))
+
+
+(%autoadmit fast-remove-all$)
+
+(%autoprove fast-remove-all$-when-not-consp
+            (%restrict default fast-remove-all$ (equal x 'x)))
+
+(%autoprove fast-remove-all$-of-cons
+            (%restrict default fast-remove-all$ (equal x '(cons b x))))
+
+(%autoprove forcing-fast-remove-all$-removal
+            (%autoinduct fast-remove-all$)
+            (%enable default fast-remove-all$-when-not-consp fast-remove-all$-of-cons))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-remove-duplicates.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-remove-duplicates.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-remove-duplicates.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-remove-duplicates.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,72 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-3")
+(%interactive)
+
+
+
+(%autoadmit remove-duplicates)
+
+(%autoprove remove-duplicates-when-not-consp
+            (%restrict default remove-duplicates (equal x 'x)))
+
+(%autoprove remove-duplicates-of-cons
+            (%restrict default remove-duplicates (equal x '(cons a x))))
+
+(%autoprove true-listp-of-remove-duplicates
+            (%cdr-induction x))
+
+(%autoprove len-of-remove-duplicates
+            (%cdr-induction x))
+
+(%autoprove remove-duplicates-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove memberp-of-remove-duplicates
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-remove-duplicates-one
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (remove-duplicates x)) (y x)))
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x x) (y (remove-duplicates x)))))
+
+(%autoprove subsetp-of-remove-duplicates-two
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (remove-duplicates y)) (y y)))
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x y) (y (remove-duplicates y)))))
+
+(%autoprove subsetp-of-cons-onto-remove-duplicates)
+
+;; see also utilities-4.lisp for some additional theorems about remove-duplicates
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-repeat.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-repeat.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-repeat.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-repeat.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,97 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-3")
+(%interactive)
+
+
+(%autoadmit repeat)
+
+(%autoprove repeat-of-zero
+            (%restrict default repeat (equal n ''0)))
+
+(%autoprove repeat-of-one
+            (%restrict default repeat (equal n ''1)))
+
+(%autoprove consp-of-repeat
+            (%restrict default repeat (equal n 'n)))
+
+(%autoprove repeat-under-iff
+            (%restrict default repeat (equal n 'n)))
+
+(%autoprove car-of-repeat
+            (%restrict default repeat (equal n 'n)))
+
+(%autoprove cdr-of-repeat
+            (%restrict default repeat (equal n 'n)))
+
+(%autoprove repeat-of-nfix
+            (%dec-induction n)
+            (%restrict default repeat (equal n '(nfix n))))
+
+(%autoprove len-of-repeat
+            (%dec-induction n)
+            (%restrict default repeat (equal n 'n)))
+
+(%autoprove true-listp-of-repeat
+            (%dec-induction n)
+            (%restrict default repeat (equal n 'n)))
+
+(%autoprove memberp-of-repeat
+            (%dec-induction n)
+            (%split)
+            ;; Could use (%restrict ...) (%auto) for 187m conses
+            ;; Could use (%auto) (%restrict ...) (%auto) for 47m conses
+            ;; Or leave these nasty hints for 36m conses
+            (%cleanup)
+            (%crewrite default)
+            (%split)
+            (%cleanup)
+            (%restrict default repeat (or (equal n 'n) (equal n ''1))))
+
+(%autoprove app-of-repeat
+            (%dec-induction n1)
+            (%split)
+            (%restrict default repeat (or (equal n 'n1) (equal n ''0))))
+
+(%autoprove lemma-for-rev-of-repeat
+            (%dec-induction n)
+            (%restrict default repeat (equal n 'n)))
+
+(%autoprove rev-of-repeat
+            (%dec-induction n)
+            (%enable default lemma-for-rev-of-repeat)
+            (%restrict default repeat (equal n 'n)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-tuplep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-tuplep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-tuplep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-tuplep.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,84 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-3")
+(%interactive)
+
+
+
+(%autoadmit tuplep)
+
+(defmacro %tuplep-induct (n x)
+  `(%induct (nfix ,n)
+            ((zp ,n)
+             nil)
+            ((not (zp ,n))
+             (((,n (- ,n 1))
+               (,x (cdr ,x)))))))
+
+(%autoprove tuplep-when-not-consp
+            (%restrict default tuplep (equal n 'n)))
+
+(%autoprove tuplep-when-zp
+            (%restrict default tuplep (equal n 'n)))
+
+(%autoprove tuplep-of-cons
+            (%restrict default tuplep (equal n 'n)))
+
+(%autoprove booleanp-of-tuplep
+            (%tuplep-induct n x))
+
+(%autoprove true-listp-when-tuplep
+            (%tuplep-induct n x))
+
+(%autoprove len-when-tuplep
+            (%tuplep-induct n x))
+
+(defthm tuplep-of-len
+  ;; BOZO move to utilities
+  (equal (tuplep (len x) x)
+         (true-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(%autoprove tuplep-of-len
+            (%cdr-induction x)
+            (%restrict default tuplep (equal x 'x)))
+
+(%autoprove tuplep-when-true-listp
+            (%tuplep-induct n x))
+
+(%autoprove consp-of-cdr-when-tuplep-2-cheap)
+(%autoprove consp-of-cdr-when-tuplep-3-cheap)
+(%autoprove consp-of-cdr-of-cdr-when-tuplep-3-cheap)
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-uniquep.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-uniquep.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4-uniquep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4-uniquep.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,59 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-3")
+(%interactive)
+
+
+(%autoadmit uniquep)
+
+(%autoprove uniquep-when-not-consp
+            (%restrict default uniquep (equal x 'x)))
+
+(%autoprove uniquep-of-cons
+            (%restrict default uniquep (equal x '(cons a x))))
+
+(%autoprove uniquep-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove booleanp-of-uniquep
+            (%cdr-induction x))
+
+(%autoprove uniquep-of-cdr-when-uniquep)
+
+(%autoprove memberp-of-car-in-cdr-when-uniquep)
+
+
+;; see also utilities-4.lisp for some additional theorems about uniquep
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-4.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-4.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,128 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-4-remove-all")
+(include-book "utilities-4-disjointp")
+(include-book "utilities-4-uniquep")
+(include-book "utilities-4-difference")
+(include-book "utilities-4-remove-duplicates")
+(include-book "utilities-4-tuplep")
+(include-book "utilities-4-repeat")
+(include-book "utilities-4-nth")
+(%interactive)
+
+
+
+;; Extra theorems for disjointp.
+
+(%autoprove disjointp-of-remove-all-of-remove-all-when-disjointp-right)
+
+(%autoprove disjointp-of-remove-all-when-disjointp-left)
+
+
+
+;; Extra theorems for uniquep.
+
+(%autoprove uniquep-of-app
+            (%cdr-induction x))
+
+(%autoprove uniquep-of-rev
+            (%cdr-induction x))
+
+(%autoprove uniquep-of-remove-all-when-uniquep
+            (%cdr-induction x))
+
+
+
+;; Extra theorems for difference.
+
+(%autoprove uniquep-of-difference-when-uniquep
+            (%cdr-induction x))
+
+(%autoprove disjointp-of-difference-with-y
+            (%cdr-induction x))
+
+(%autoprove disjointp-of-difference-with-y-alt
+            (%cdr-induction x))
+
+
+
+;; Extra theorems for remove-duplicates.
+
+(%autoprove uniquep-of-remove-duplicates
+            (%cdr-induction x))
+
+(%autoprove remove-duplicates-of-difference
+            (%cdr-induction x))
+
+(%autoprove remove-duplicates-when-unique
+            (%cdr-induction x))
+
+(%autoprove app-of-remove-duplicates-with-unique-and-disjoint
+            (%cdr-induction x))
+
+(%autoprove remove-duplicates-of-remove-all
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-remove-all-of-remove-duplicates)
+
+
+;; Extra theorems for nth.
+
+(%autoprove equal-of-nths-when-uniquep
+            ;; This proof is pretty cool.  It has really improved over time as my
+            ;; tactics have gotten better.
+            (%induct (rank x)
+                     ((not (consp x))
+                      nil)
+                     ((and (consp x)
+                           (or (zp m)
+                               (zp n)))
+                      nil)
+                     ((and (consp x)
+                           (not (zp m))
+                           (not (zp n)))
+                      (((x (cdr x))
+                        (n (- n 1))
+                        (m (- m 1))))))
+            (%restrict default nth (or (equal n 'n) (equal n 'm) (equal n ''0) (equal n ''1))))
+
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-first-index.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-first-index.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-first-index.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-first-index.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,85 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-4")
+(%interactive)
+
+
+
+(%autoadmit first-index)
+
+(%autoprove first-index-when-not-consp
+            (%restrict default first-index (equal x 'x)))
+
+(%autoprove first-index-of-cons
+            (%restrict default first-index (equal x '(cons b x))))
+
+(%autoprove natp-of-first-index
+            (%cdr-induction x))
+
+(%autoprove first-index-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove memberp-binds-first-index-range
+            (%cdr-induction x))
+
+(%autoprove first-index-of-app
+            (%cdr-induction x))
+
+(%autoprove first-index-of-rev-when-unique
+            (%cdr-induction x))
+
+(%autoprove first-index-of-car)
+
+(%autoprove nth-of-first-index-when-memberp
+            (%cdr-induction x))
+
+(%autoprove first-index-less-than-len
+            (%cdr-induction x))
+
+(%autoprove first-index-less-than-len-free)
+
+(%autoprove nth-of-first-index-of-nth
+            (%cdr-induction x))
+
+(%autoprove first-index-of-nth-when-unique
+            (%use (%instance (%thm equal-of-nths-when-uniquep)
+                             (n (first-index (nth n x) x))
+                             (m n)
+                             (x x))))
+
+(%autoprove equal-of-first-index-and-n-when-len
+            (%distribute)
+            (%cdr-induction x))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-firstn.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-firstn.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-firstn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-firstn.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,94 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-4")
+(%interactive)
+
+
+
+(%autoadmit firstn)
+
+(%autoprove firstn-of-zero
+            (%restrict default firstn (equal n ''0)))
+
+(%autoprove true-listp-of-firstn
+            (%autoinduct firstn)
+            (%restrict default firstn (equal n 'n)))
+
+(%autoprove consp-of-firstn
+            (%autoinduct firstn)
+            (%restrict default firstn (or (equal n 'n) (equal n ''1))))
+
+(%autoprove firstn-under-iff
+            (%restrict default firstn (equal n 'n)))
+
+(%autoprove firstn-of-list-fix
+            (%autoinduct firstn)
+            (%restrict default firstn (equal n 'n)))
+
+(%autoprove firstn-of-len
+            (%cdr-induction x)
+            (%restrict default firstn (equal n '(+ '1 (len x2)))))
+
+(%autoprove len-of-firstn
+            (%autoinduct firstn)
+            (%restrict default firstn (or (equal n 'n) (equal n ''1))))
+
+(%autoprove firstn-of-too-many
+            (%autoinduct firstn)
+            (%restrict default firstn (equal n 'n)))
+
+(defsection firstn-of-too-many-replacement
+  ;; BOZO fix acl2 to limit this
+  ;;        -- NO, wait! First check if we need to do that now that we
+  ;;           have our cache working
+  (%prove (%rule firstn-of-too-many-replacement
+                 :hyps (list (%hyp (< (len x) n) :limit 1))
+                 :lhs (firstn n x)
+                 :rhs (list-fix x)))
+  (%auto)
+  (%qed)
+  (%disable default firstn-of-too-many)
+  (%enable default firstn-of-too-many-replacement))
+
+(%autoprove firstn-of-app
+            ;; BOZO check if we still need this disable with our cache
+            (%autoinduct firstn)
+            (%disable default len-when-tuplep trichotomy-of-< antisymmetry-of-<)
+            (%restrict default firstn (equal n 'n)))
+
+(%autoprove subsetp-of-firstn-when-in-range
+            (%autoinduct firstn)
+            (%restrict default firstn (equal n 'n)))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-mapp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-mapp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-mapp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-mapp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,219 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-4")
+(%interactive)
+
+
+(%autoadmit mapp)
+
+(%autoprove mapp-when-not-consp
+            (%restrict default mapp (equal x 'x)))
+
+(%autoprove mapp-of-cons
+            (%restrict default mapp (equal x '(cons a x))))
+
+(%autoprove booleanp-of-mapp
+            (%cdr-induction x))
+
+(%autoprove mapp-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove mapp-of-app
+            (%cdr-induction x))
+
+
+
+(%autoadmit cons-fix)
+
+(%autoprove cons-fix-when-not-consp
+            (%restrict default cons-fix (equal x 'x)))
+
+(%autoprove cons-fix-when-consp
+            (%restrict default cons-fix (equal x 'x)))
+
+(%autoprove consp-of-cons-fix
+            (%car-cdr-elim x))
+
+(%autoprove cons-fix-under-iff
+            (%car-cdr-elim x))
+
+(%autoprove cons-fix-of-cons)
+
+(%autoprove car-of-cons-fix)
+
+(%autoprove cdr-of-cons-fix)
+
+
+
+(%autoadmit lookup)
+
+(%autoprove lookup-when-not-consp
+            (%restrict default lookup (equal x 'x)))
+
+(%autoprove lookup-of-cons
+            (%restrict default lookup (equal x '(cons b x))))
+
+(%autoprove lookup-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove lookup-of-app
+            (%cdr-induction x))
+
+(%autoprove car-of-lookup-when-found
+            (%cdr-induction map))
+
+(%autoprove consp-of-lookup-under-iff
+            (%cdr-induction x))
+
+
+
+(%autoadmit update)
+
+(%autoprove car-of-update
+            (%enable default update))
+
+(%autoprove cdr-of-update
+            (%enable default update))
+
+(%autoprove consp-of-update
+            (%enable default update))
+
+(%autoprove update-of-list-fix
+            (%enable default update))
+
+(%autoprove mapp-of-update-when-mapp
+            ;; BOZO I think this should be forced
+            (%enable default update))
+
+(%autoprove lookup-of-update
+            (%enable default update))
+
+
+
+(%autoadmit domain)
+
+(%autoprove domain-when-not-consp
+            (%restrict default domain (equal x 'x)))
+
+(%autoprove domain-of-cons
+            (%restrict default domain (equal x '(cons a x))))
+
+(%autoprove domain-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove consp-of-domain)
+
+(%autoprove true-listp-of-domain
+            (%cdr-induction x))
+
+(%autoprove domain-of-app
+            (%cdr-induction x))
+
+(%autoprove domain-of-update
+            (%enable default update))
+
+(%autoprove memberp-of-domain-when-memberp
+            (%cdr-induction x))
+
+(%autoprove memberp-of-domain-when-memberp-of-subset-domain
+            (%cdr-induction x))
+
+(%autoprove subsetp-of-domains
+            (%use (%instance (%thm subsetp-badguy-membership-property)
+                             (x (domain x))
+                             (y (domain y)))))
+
+(%autoprove uniquep-when-uniquep-of-domain
+            (%cdr-induction x))
+
+(%autoprove memberp-of-domain-under-iff
+            (%cdr-induction x))
+
+(%autoprove rev-of-domain
+            (%cdr-induction x))
+
+(%autoprove domain-of-rev)
+
+
+
+(%autoadmit fast-domain$)
+
+(%autoprove fast-domain$-when-not-consp
+            (%restrict default fast-domain$ (equal x 'x)))
+
+(%autoprove fast-domain$-of-cons
+            (%restrict default fast-domain$ (equal x '(cons a x))))
+
+(%autoprove forcing-fast-domain$-removal
+            (%autoinduct fast-domain$)
+            (%enable default fast-domain$-when-not-consp fast-domain$-of-cons))
+
+
+
+(%autoadmit range)
+
+(%autoprove range-when-not-consp
+            (%restrict default range (equal x 'x)))
+
+(%autoprove range-of-cons
+            (%restrict default range (equal x '(cons a x))))
+
+(%autoprove range-of-list-fix
+            (%cdr-induction x))
+
+(%autoprove true-listp-of-range
+            (%cdr-induction x))
+
+(%autoprove len-of-range
+            (%cdr-induction x))
+
+(%autoprove range-of-app
+            (%cdr-induction x))
+
+
+
+(%autoadmit fast-range$)
+
+(%autoprove fast-range$-when-not-consp
+            (%restrict default fast-range$ (equal x 'x)))
+
+(%autoprove fast-range$-of-cons
+            (%restrict default fast-range$ (equal x '(cons a x))))
+
+(%autoprove forcing-fast-range$-removal
+            (%autoinduct fast-range$)
+            (%enable default fast-range$-when-not-consp fast-range$-of-cons))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-prefixp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-prefixp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-prefixp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-prefixp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,126 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-4")
+(%interactive)
+
+
+
+(%autoadmit prefixp)
+
+(%autoprove prefixp-when-not-consp-one
+            (%restrict default prefixp (equal x 'x)))
+
+(%autoprove prefixp-when-not-consp-two
+            (%restrict default prefixp (equal x 'x)))
+
+(%autoprove prefixp-of-cons-and-cons
+            (%restrict default prefixp (equal x '(cons a x)))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove booleanp-of-prefixp
+            (%cdr-cdr-induction x y))
+
+(%autoprove prefixp-of-list-fix-one
+            (%cdr-cdr-induction x y))
+
+(%autoprove prefixp-of-list-fix-two
+            (%cdr-cdr-induction x y))
+
+(%autoprove same-length-prefixes-equal-cheap
+            (%cdr-cdr-induction x y))
+
+(%autoprove prefixp-when-lengths-wrong
+            (%cdr-cdr-induction x y))
+
+(defsection prefixp-when-lengths-wrong-replacement
+  ;; BOZO see if we still need this?  If so, change the ACL2 rule to
+  ;; add a backchain limit.  Else, just use the above autoprove.
+  (%prove (%rule prefixp-when-lengths-wrong-replacement
+                 :hyps (list (%hyp (< (len y) (len x)) :limit 1))
+                 :lhs (prefixp x y)
+                 :rhs nil))
+  (%auto)
+  (%qed)
+  (%disable default prefixp-when-lengths-wrong)
+  (%enable default prefixp-when-lengths-wrong-replacement))
+
+
+
+(%autoadmit prefixp-badguy)
+
+(%autoprove prefixp-badguy-when-not-consp
+            (%restrict default prefixp-badguy (equal x 'x)))
+
+(%autoprove prefixp-badguy-of-cons
+            (%restrict default prefixp-badguy (equal x '(cons a x)))
+            (%auto :strategy (cleanup split crewrite)))
+
+(local (%enable default prefixp-badguy-when-not-consp prefixp-badguy-of-cons))
+
+(%autoprove natp-of-prefixp-badguy
+            (%cdr-induction x))
+
+(%autoprove lemma-for-prefixp-badguy-index-property
+  (%induct (rank x)
+           ((not (consp x))
+            nil)
+           ((consp x)
+            (((x (cdr x))
+              (y (cdr y)))))))
+
+(%autoprove lemma-2-for-prefixp-badguy-index-property
+  (%induct (rank x)
+           ((not (consp x))
+            nil)
+           ((consp x)
+            (((x (cdr x))
+              (y (cdr y)))))))
+
+(%autoprove prefixp-badguy-index-property
+            (%enable default
+                     lemma-for-prefixp-badguy-index-property
+                     lemma-2-for-prefixp-badguy-index-property))
+
+(%autoprove forcing-prefixp-when-not-prefixp-badguy
+            (%cdr-cdr-induction x y))
+
+(local (%disable default prefixp-badguy-when-not-consp prefixp-badguy-of-cons))
+
+
+
+(%autoprove subsetp-when-prefixp-cheap
+            (%cdr-cdr-induction x y))
+
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-restn.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-restn.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5-restn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5-restn.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,78 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-4")
+(%interactive)
+
+(%autoadmit restn)
+
+(%autoprove restn-of-zero
+            (%restrict default restn (equal n ''0)))
+
+(%autoprove restn-of-one
+            (%restrict default restn (equal n ''1)))
+
+(%autoprove true-listp-of-restn
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove consp-of-restn
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove restn-under-iff
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove restn-of-list-fix
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove restn-when-not-natp
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove restn-of-app
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove subsetp-of-restn
+            (%autoinduct restn)
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove restn-of-len
+            (%cdr-induction x))
+
+;; See also utilities-5.lisp for more theorems about restn
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-5.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-5.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,80 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-5-prefixp")
+(include-book "utilities-5-firstn")
+(include-book "utilities-5-restn")
+(include-book "utilities-5-first-index")
+(include-book "utilities-5-mapp")
+(%interactive)
+
+
+
+(%autoprove nth-of-first-index-of-domain-and-range
+            (%cdr-induction x)
+            (%restrict default firstn (equal n 'n)))
+
+(%autoprove prefixp-of-firstn
+            (%autoinduct firstn)
+            (%restrict default firstn (equal n 'n)))
+
+(%autoprove prefixp-of-firstn-unusual
+            (%autoinduct firstn)
+            (%restrict default firstn (equal n 'n)))
+
+(%autoprove app-of-firstn-and-restn
+            (%autoinduct restn)
+            (%restrict default firstn (equal n 'n))
+            (%restrict default restn (equal n 'n)))
+
+(%autoprove lemma-for-equal-of-app-with-firstn-and-restn)
+
+(%autoprove lemma-2-for-equal-of-app-with-firstn-and-restn)
+
+(%autoprove lemma-3-for-equal-of-app-with-firstn-and-restn)
+
+(%autoprove lemma-4-for-equal-of-app-with-firstn-and-restn
+            (%enable default lemma-3-for-equal-of-app-with-firstn-and-restn)
+            (%use (%instance (%thm lemma-for-equal-of-app-with-firstn-and-restn)
+                             (n (len y))
+                             (x x)))
+            (%use (%instance (%thm lemma-2-for-equal-of-app-with-firstn-and-restn)
+                             (n (len y))
+                             (y (list-fix y))))
+            (%auto :strategy (cleanup split crewrite)))
+
+(%autoprove equal-of-app-with-firstn-and-restn
+            (%enable default lemma-4-for-equal-of-app-with-firstn-and-restn)
+            (%use (%instance (%thm lemma-for-equal-of-app-with-firstn-and-restn))))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-6-pair-lists.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-6-pair-lists.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-6-pair-lists.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-6-pair-lists.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,100 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-5")
+(%interactive)
+
+
+
+(%autoadmit pair-lists)
+
+(%autoprove pair-lists-when-not-consp
+            (%restrict default pair-lists (equal x 'x)))
+
+(%autoprove pair-lists-of-cons-one
+            (%restrict default pair-lists (equal x '(cons a x))))
+
+(%autoprove pair-lists-of-cons-two
+            (%restrict default pair-lists (equal y '(cons a y))))
+
+(%autoprove true-listp-of-pair-lists
+            (%autoinduct pair-lists))
+
+(%autoprove pair-lists-of-list-fix-one
+            (%autoinduct pair-lists))
+
+(%autoprove pair-lists-of-list-fix-two
+            (%autoinduct pair-lists))
+
+(%autoprove domain-of-pair-lists
+            (%autoinduct pair-lists))
+
+(%autoprove range-of-pair-lists
+            (%autoinduct pair-lists domain range))
+
+(%autoprove lookup-of-pair-lists
+            (%autoinduct pair-lists keys vals))
+
+(%autoprove lookup-of-pair-lists-of-rev)
+
+(%autoprove lookup-of-nth-in-pair-lists-when-unique-keys
+            (%induct (rank x)
+                     ((or (not (consp x))
+                          (not (consp y)))
+                      nil)
+                     ((zp n)
+                      nil)
+                     ((and (consp x)
+                           (consp y)
+                           (not (zp n)))
+                      (((n (- n 1))
+                        (x (cdr x))
+                        (y (cdr y))))))
+            ;; somehow no urewrite saves a lot of conses
+            (%auto :strategy (cleanup split crewrite)))
+
+
+
+(%autoadmit fast-pair-lists$)
+
+(%autoprove fast-pair-lists$-when-not-consp
+            (%restrict default fast-pair-lists$ (equal x 'x)))
+
+(%autoprove fast-pair-lists$-of-cons
+            (%restrict default fast-pair-lists$ (equal x '(cons a x))))
+
+(%autoprove forcing-fast-pair-lists$-removal
+            (%autoinduct fast-pair-lists$)
+            (%enable default fast-pair-lists$-when-not-consp fast-pair-lists$-of-cons))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-6-submapp.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-6-submapp.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities-6-submapp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities-6-submapp.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,184 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-5")
+(%interactive)
+
+
+
+(%autoadmit submapp1)
+
+(%autoprove submapp1-when-not-consp
+            (%restrict default submapp1 (equal domain 'domain)))
+
+(%autoprove submapp1-of-cons
+            (%restrict default submapp1 (equal domain '(cons a domain))))
+
+(%autoprove booleanp-of-submapp1
+            (%cdr-induction domain))
+
+(%autoprove equal-of-lookups-when-memberp-of-submapp1-domain
+            (%cdr-induction domain))
+
+(%autoprove lookup-when-memberp-of-submapp1
+            (%use (%instance (%thm equal-of-lookups-when-memberp-of-submapp1-domain))))
+
+
+
+(%autoadmit submapp1-badguy)
+
+(%autoprove submapp1-badguy-when-not-consp
+            (%restrict default submapp1-badguy (equal domain 'domain)))
+
+(%autoprove submapp1-badguy-of-cons
+            (%restrict default submapp1-badguy (equal domain '(cons a domain))))
+
+(%autoprove submapp1-badguy-membership-property
+            (%cdr-induction domain)
+            (%enable default submapp1-badguy-when-not-consp submapp1-badguy-of-cons))
+
+
+(%autoprove submapp1-badguy-under-iff
+            (%cdr-induction domain)
+            (%enable default submapp1-badguy-when-not-consp submapp1-badguy-of-cons))
+
+(%autoprove submapp1-when-submapp1-of-domain-superset-one
+            (%use (%instance (%thm submapp1-badguy-membership-property) (domain domain1) (x x) (y y))))
+
+(%autoprove submapp1-when-submapp1-of-domain-superset-two
+            (%use (%instance (%thm submapp1-when-submapp1-of-domain-superset-one))))
+
+(%autoprove submapp1-of-list-fix-one)
+
+(%autoprove submapp1-of-list-fix-two
+            (%cdr-induction domain))
+
+(%autoprove submapp1-of-list-fix-three
+            (%cdr-induction domain))
+
+
+
+(%autoadmit submapp)
+
+(%autoprove booleanp-of-submapp
+            (%enable default submapp))
+
+(%autoprove submapp-of-list-fix-one
+            (%enable default submapp))
+
+(%autoprove submapp-of-list-fix-two
+            (%enable default submapp))
+
+(%autoprove equal-of-lookups-when-submapp
+            (%enable default submapp))
+
+(%autoprove equal-of-cdrs-of-lookups-when-submapp
+            (%disable default equal-of-lookups-when-submapp)
+            (%use (%instance (%thm equal-of-lookups-when-submapp))))
+
+(%autoprove lookup-when-lookup-in-submapp-one
+            (%enable default submapp))
+
+(%autoprove lookup-when-lookup-in-submapp-two
+            (%use (%instance (%thm lookup-when-lookup-in-submapp-one))))
+
+
+
+(%autoadmit submapp-badguy)
+
+(%autoprove submapp-badguy-membership-property
+            (%enable default submapp-badguy)
+            (%use (%instance (%thm submapp1-badguy-membership-property)
+                             (domain (domain x)))))
+
+(%autoprove submapp-badguy-under-iff
+            (%enable default submapp submapp-badguy))
+
+(%autoprove subsetp-of-domains-when-submap
+            (%use (%instance (%thm subsetp-badguy-membership-property) (x (domain x)) (y (domain y)))))
+
+(%autoprove submapp-reflexive
+            (%use (%instance (%thm submapp-badguy-membership-property) (x x) (y x))))
+
+(%autoprove submapp-transitive
+            (%use (%instance (%thm submapp-badguy-membership-property) (x x) (y z)))
+            (%waterfall default 40)
+            (%disable default equal-of-lookups-when-submapp)
+            (%use (%instance (%thm equal-of-lookups-when-submapp) (a (cdr (submapp-badguy x z))) (x x) (y y)))
+            (%use (%instance (%thm equal-of-lookups-when-submapp) (a (cdr (submapp-badguy x z))) (x y) (y z)))
+            (%waterfall default 40))
+
+(%autoprove submapp-transitive-alt)
+
+
+
+
+
+(%autoprove lemma-for-submapp1-of-app
+            (%use (%instance (%thm submapp1-badguy-membership-property) (domain (app d1 d2)) (x a) (y b))))
+
+(%autoprove submapp1-of-app
+            (%enable default lemma-for-submapp1-of-app))
+
+
+
+
+(%autoprove lemma-for-submapp-of-cons-onto-map
+            (%cdr-induction x))
+
+(%autoprove submapp-of-cons-onto-map
+            (%cdr-induction map)
+            (%enable default lemma-for-submapp-of-cons-onto-map submapp))
+
+(%autoprove lemma-for-submapp-when-unique-domains-and-subsetp
+            (%cdr-induction x))
+
+(%autoprove lemma2-for-submapp-when-unique-domains-and-subsetp
+            (%enable default lemma-for-submapp-when-unique-domains-and-subsetp)
+            (%cdr-induction x))
+
+(%autoprove submapp-when-unique-domains-and-subsetp
+            (%enable default lemma2-for-submapp-when-unique-domains-and-subsetp)
+            (%use (%instance (%thm submapp-badguy-membership-property) (x x) (y y))))
+
+(%autoprove lemma-for-submapp-of-app-when-submapp
+            (%cdr-induction dom))
+
+(%autoprove submapp-of-app-when-submapp
+            (%enable default submapp lemma-for-submapp-of-app-when-submapp))
+
+(%autoprove submapp-of-rev-when-uniquep
+            (%enable default domain-of-rev)
+            (%disable default [outside]rev-of-domain rev-of-domain))
diff -Nru acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities.lisp acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities.lisp
--- acl2-6.2/books/milawa/ACL2/bootstrap/utilities/utilities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/bootstrap/utilities/utilities.lisp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,39 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities-6-submapp")
+(include-book "utilities-6-pair-lists")
+
+(%ensure-exactly-these-rules-are-missing "../../utilities/utilities")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/build/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/build/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/build/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/build/axioms.lisp acl2-6.3/books/milawa/ACL2/build/axioms.lisp
--- acl2-6.2/books/milawa/ACL2/build/axioms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/axioms.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,313 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../defderiv/defderiv")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defax axiom-reflexivity
+  (= x x))
+
+(defax axiom-equality
+  (v (!= x1 y1)
+     (v (!= x2 y2)
+        (v (!= x1 x2)
+           (= y1 y2)))))
+
+(defax axiom-t-not-nil
+  (!= t nil))
+
+(defax axiom-equal-when-same
+  (v (!= x y)
+     (= (equal x y) t)))
+
+(defax axiom-equal-when-diff
+  (v (= x y)
+     (= (equal x y) nil)))
+
+(defax axiom-if-when-nil
+  (v (!= x nil)
+     (= (if x y z) z)))
+
+(defax axiom-if-when-not-nil
+  (v (= x nil)
+     (= (if x y z) y)))
+
+
+
+(defax axiom-consp-of-cons
+  (= (consp (cons x y)) t))
+
+(defax axiom-car-of-cons
+  (= (car (cons x y)) x))
+
+(defax axiom-cdr-of-cons
+  (= (cdr (cons x y)) y))
+
+(defax axiom-consp-nil-or-t
+  (v (= (consp x) nil)
+     (= (consp x) t)))
+
+(defax axiom-car-when-not-consp
+  (v (!= (consp x) nil)
+     (= (car x) nil)))
+
+(defax axiom-cdr-when-not-consp
+  (v (!= (consp x) nil)
+     (= (cdr x) nil)))
+
+(defax axiom-cons-of-car-and-cdr
+  (v (= (consp x) nil)
+     (= (cons (car x) (cdr x)) x)))
+
+
+
+(defax axiom-symbolp-nil-or-t
+  (v (= (symbolp x) nil)
+     (= (symbolp x) t)))
+
+(defax axiom-symbol-<-nil-or-t
+  (v (= (symbol-< x y) nil)
+     (= (symbol-< x y) t)))
+
+(defax axiom-irreflexivity-of-symbol-<
+  (= (symbol-< x x) nil))
+
+(defax axiom-antisymmetry-of-symbol-<
+  (v (= (symbol-< x y) nil)
+     (= (symbol-< y x) nil)))
+
+(defax axiom-transitivity-of-symbol-<
+  (v (= (symbol-< x y) nil)
+     (v (= (symbol-< y z) nil)
+        (= (symbol-< x z) t))))
+
+(defax axiom-trichotomy-of-symbol-<
+  (v (= (symbolp x) nil)
+     (v (= (symbolp y) nil)
+        (v (= (symbol-< x y) t)
+           (v (= (symbol-< y x) t)
+              (= x y))))))
+
+(defax axiom-symbol-<-completion-left
+  (v (= (symbolp x) t)
+     (= (symbol-< x y)
+        (symbol-< nil y))))
+
+(defax axiom-symbol-<-completion-right
+  (v (= (symbolp y) t)
+     (= (symbol-< x y)
+        (symbol-< x nil))))
+
+
+
+(defax axiom-disjoint-symbols-and-naturals
+  (v (= (symbolp x) nil)
+     (= (natp x) nil)))
+
+(defax axiom-disjoint-symbols-and-conses
+  (v (= (symbolp x) nil)
+     (= (consp x) nil)))
+
+(defax axiom-disjoint-naturals-and-conses
+  (v (= (natp x) nil)
+     (= (consp x) nil)))
+
+
+
+(defax axiom-natp-nil-or-t
+  (v (= (natp x) nil)
+     (= (natp x) t)))
+
+(defax axiom-natp-of-plus
+  (= (natp (+ a b)) t))
+
+(defax axiom-commutativity-of-+
+  (= (+ a b) (+ b a)))
+
+(defax axiom-associativity-of-+
+  (= (+ (+ a b) c)
+     (+ a (+ b c))))
+
+(defax axiom-plus-when-not-natp-left
+  (v (= (natp a) t)
+     (= (+ a b) (+ 0 b))))
+
+(defax axiom-plus-of-zero-when-natural
+  (v (= (natp a) nil)
+     (= (+ a 0) a)))
+
+(defax axiom-<-nil-or-t
+  (v (= (< x y) nil)
+     (= (< x y) t)))
+
+(defax axiom-irreflexivity-of-<
+  (= (< a a) nil))
+
+(defax axiom-less-of-zero-right
+  (= (< a 0) nil))
+
+(defax axiom-less-of-zero-left-when-natp
+  (v (= (natp a) nil)
+     (= (< 0 a)
+        (if (equal a 0)
+            nil
+          t))))
+
+(defax axiom-less-completion-left
+  (v (= (natp a) t)
+     (= (< a b)
+        (< 0 b))))
+
+(defax axiom-less-completion-right
+  (v (= (natp b) t)
+     (= (< a b)
+        nil)))
+
+(defax axiom-transitivity-of-<
+  (v (= (< a b) nil)
+     (v (= (< b c) nil)
+        (= (< a c) t))))
+
+(defax axiom-trichotomy-of-<-when-natp
+  (v (= (natp a) nil)
+     (v (= (natp b) nil)
+        (v (= (< a b) t)
+           (v (= (< b a) t)
+              (= a b))))))
+
+(defax axiom-one-plus-trick
+  (v (= (< a b) nil)
+     (= (< b (+ 1 a)) nil)))
+
+(defax axiom-natural-less-than-one-is-zero
+  (v (= (natp a) nil)
+     (v (= (< a 1) nil)
+        (= a 0))))
+
+(defax axiom-less-than-of-plus-and-plus
+  (= (< (+ a b) (+ a c))
+     (< b c)))
+
+
+
+;; BOZO we could probably "weaken" some of these axioms and assume less
+
+(defax axiom-natp-of-minus
+  (= (natp (- a b)) t))
+
+(defax axiom-minus-when-subtrahend-as-large
+  (v (= (< b a) t)
+     (= (- a b) 0)))
+
+(defax axiom-minus-cancels-summand-right
+  (= (- (+ a b) b)
+     (if (natp a)
+         a
+       0)))
+
+(defax axiom-less-of-minus-left
+  (v (= (< b a) nil)
+     (= (< (- a b) c)
+        (< a (+ b c)))))
+
+(defax axiom-less-of-minus-right
+  (= (< a (- b c))
+     (< (+ a c) b)))
+
+(defax axiom-plus-of-minus-right
+  (v (= (< c b) nil)
+     (= (+ a (- b c))
+        (- (+ a b) c))))
+
+(defax axiom-minus-of-minus-right
+  (v (= (< c b) nil)
+     (= (- a (- b c))
+        (- (+ a c) b))))
+
+(defax axiom-minus-of-minus-left
+  (= (- (- a b) c)
+     (- a (+ b c))))
+
+(defax axiom-equal-of-minus-property
+  (v (= (< b a) nil)
+     (= (equal (- a b) c)
+        (equal a (+ b c)))))
+
+
+(defax axiom-closed-universe
+  (v (= (natp x) t)
+     (v (= (symbolp x) t)
+        (= (consp x) t))))
+
+
+(defax definition-of-rank
+  (= (rank x)
+     (if (consp x)
+         (+ 1
+            (+ (rank (car x))
+               (rank (cdr x))))
+       0)))
+
+(ACL2::make-event
+ `(defax definition-of-ord<
+    (= (ord< x y)
+       ,(logic.translate '(cond ((not (consp x))
+                                 (if (consp y) t (< x y)))
+                                ((not (consp y)) nil)
+                                ((not (equal (car (car x)) (car (car y))))
+                                 (ord< (car (car x)) (car (car y))))
+                                ((not (equal (cdr (car x)) (cdr (car y))))
+                                 (< (cdr (car x)) (cdr (car y))))
+                                (t (ord< (cdr x) (cdr y))))))))
+
+(ACL2::make-event
+ `(defax definition-of-ordp
+    (= (ordp x)
+       ,(logic.translate '(if (not (consp x))
+                              (natp x)
+                              (and (consp (car x))
+                                   (ordp (car (car x)))
+                                   (not (equal (car (car x)) 0))
+                                   (< 0 (cdr (car x)))
+                                   (ordp (cdr x))
+                                   (if (consp (cdr x))
+                                       (ord< (car (car (cdr x))) (car (car x)))
+                                       t)))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/build/basic.lisp acl2-6.3/books/milawa/ACL2/build/basic.lisp
--- acl2-6.2/books/milawa/ACL2/build/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/basic.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,778 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../defderiv/top")
+(include-book "axioms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(dd.open "basic.tex")
+
+(dd.write "Builders are functions that build proofs from their inputs.  The
+simplest builders correspond to the basic axioms and rules of inference, while
+more complex builders can generate long sequences of proof steps.  Builders
+correspond to derived rules of inference in logic.")
+
+(dd.write "During bootstrapping, we want our builders to produce short proofs.
+Next to most derivations, we write down how many steps will be introduced by
+using the derivation.  Sometimes we can optimize special cases (e.g., we don't
+need to add any steps at all to commute a proof of $a = a$), but here we only
+show the steps and costs for the general case.")
+
+
+
+(defund build.axiom (a)
+  (declare (xargs :guard (logic.formulap a)))
+  (logic.appeal 'axiom a nil nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.axiom)))
+
+ (defthm build.axiom-under-iff
+   (iff (build.axiom a)
+        t))
+
+ (defthm logic.method-of-build.axiom
+   (equal (logic.method (build.axiom a))
+          'axiom))
+
+ (defthm logic.conclusion-of-build.axiom
+   (equal (logic.conclusion (build.axiom a))
+          a))
+
+ (defthm logic.subproofs-of-build.axiom
+   (equal (logic.subproofs (build.axiom a))
+          nil))
+
+ (defthm logic.extras-of-build.axiom
+   (equal (logic.extras (build.axiom a))
+          nil))
+
+ (defthm forcing-logic.appealp-of-build.axiom
+   (implies (force (logic.formulap a))
+            (equal (logic.appealp (build.axiom a))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.axiom
+   (implies (force (and (memberp a axioms)
+                        (logic.formula-atblp a atbl)))
+            (equal (logic.proofp (build.axiom a) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp
+                                     logic.appeal-step-okp
+                                     logic.axiom-okp)))))
+
+
+
+(defund build.theorem (a)
+  (declare (xargs :guard (logic.formulap a)))
+  (logic.appeal 'theorem a nil nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.theorem)))
+
+ (defthm build.theorem-under-iff
+   (iff (build.theorem a)
+        t))
+
+ (defthm logic.method-of-build.theorem
+   (equal (logic.method (build.theorem a))
+          'theorem))
+
+ (defthm logic.conclusion-of-build.theorem
+   (equal (logic.conclusion (build.theorem a))
+          a))
+
+ (defthm logic.subproofs-of-build.theorem
+   (equal (logic.subproofs (build.theorem a))
+          nil))
+
+ (defthm logic.extras-of-build.theorem
+   (equal (logic.extras (build.theorem a))
+          nil))
+
+ (defthm forcing-logic.appealp-of-build.theorem
+   (implies (force (logic.formulap a))
+            (equal (logic.appealp (build.theorem a))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.theorem
+   (implies (force (and (logic.formula-atblp a atbl)
+                        (memberp a thms)))
+            (equal (logic.proofp (build.theorem a) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp
+                                     logic.appeal-step-okp
+                                     logic.theorem-okp)))))
+
+
+
+(defund@ build.propositional-schema (a)
+  (declare (xargs :guard (logic.formulap a)))
+  (logic.appeal 'propositional-schema
+                (logic.por (logic.pnot a) a)
+                nil
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.propositional-schema)))
+
+ (defthm build.propositional-schema-under-iff
+   (iff (build.propositional-schema a)
+        t))
+
+ (defthm logic.method-of-build.propositional-schema
+   (equal (logic.method (build.propositional-schema a))
+          'propositional-schema))
+
+ (defthm logic.conclusion-of-build.propositional-schema
+   (equal (logic.conclusion (build.propositional-schema a))
+          (logic.por (logic.pnot a) a)))
+
+ (defthm logic.subproofs-of-build.propositional-schema
+   (equal (logic.subproofs (build.propositional-schema a))
+          nil))
+
+ (defthm logic.extras-of-build.propositional-schema
+   (equal (logic.extras (build.propositional-schema a))
+          nil))
+
+ (defthm forcing-logic.appealp-of-build.propositional-schema
+   (implies (force (logic.formulap a))
+            (equal (logic.appealp (build.propositional-schema a))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.propositional-schema
+   (implies (force (logic.formula-atblp a atbl))
+            (equal (logic.proofp (build.propositional-schema a) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp
+                                     logic.appeal-step-okp
+                                     logic.propositional-schema-okp)))))
+
+
+
+(defund@ build.cut (x y)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.appealp y)
+                              (@match (proof x (v A B))
+                                      (proof y (v (! A) C))))))
+  (logic.appeal 'cut
+                (@formula (v B C))
+                (list x y)
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.cut)))
+
+ (defthm build.cut-under-iff
+   (iff (build.cut x y)
+        t))
+
+ (defthm logic.method-of-build.cut
+   (equal (logic.method (build.cut x y))
+          'cut))
+
+ (defthm@ logic.conclusion-of-cut
+   (@extend ((proof x (v A B))
+             (proof y (v (! A) C)))
+            (equal (logic.conclusion (build.cut x y))
+                   (@formula (v B C)))))
+
+ (defthm logic.subproofs-of-build.cut
+   (equal (logic.subproofs (build.cut x y))
+          (list x y)))
+
+ (defthm logic.extras-of-build.cut
+   (equal (logic.extras (build.cut x y))
+          nil))
+
+ (defthm@ forcing-logic.appealp-of-build.cut
+   (implies (force (and (logic.appealp x)
+                        (logic.appealp y)
+                        (@match (proof x (v A B))
+                                (proof y (v (! A) C)))))
+            (equal (logic.appealp (build.cut x y))
+                   t)))
+
+ (defthm@ forcing-logic.proofp-of-build.cut
+   (implies (force (and ;(logic.appealp x)
+                        ;(logic.appealp y)
+                        (@match (proof x (v A B))
+                                (proof y (v (! A) C)))
+                        (logic.proofp x axioms thms atbl)
+                        (logic.proofp y axioms thms atbl)))
+            (equal (logic.proofp (build.cut x y) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (e/d (definition-of-logic.proofp
+                                    logic.appeal-step-okp
+                                    logic.cut-okp)
+                                  (FORCING-TRUE-LISTP-OF-LOGIC.SUBPROOFS)
+                                  )))))
+
+
+
+
+(defund@ build.contraction (x)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (@match (proof x (v A A))))))
+  (logic.appeal 'contraction
+                (@formula A)
+                (list x)
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.contraction)))
+
+ (defthm build.contraction-under-iff
+   (iff (build.contraction x)
+        t))
+
+ (defthm logic.method-of-build.contraction
+   (equal (logic.method (build.contraction x))
+          'contraction))
+
+ (defthm@ logic.conclusion-of-build.contraction
+   (@extend ((proof x (v A A)))
+            (equal (logic.conclusion (build.contraction x))
+                   (@formula A))))
+
+ (defthm logic.subproofs-of-build.contraction
+   (equal (logic.subproofs (build.contraction x))
+          (list x)))
+
+ (defthm logic.extras-of-build.contraction
+   (equal (logic.extras (build.contraction x))
+          nil))
+
+ (defthm@ forcing-logic.appealp-of-build.contraction
+   (implies (force (and (logic.appealp x)
+                        (@match (proof x (v A A)))))
+            (equal (logic.appealp (build.contraction x))
+                   t)))
+
+ (defthm@ forcing-logic.proofp-of-build.contraction
+   (implies (force (and ;(logic.appealp x)
+                        (@match (proof x (v A A)))
+                        (logic.proofp x axioms thms atbl)))
+            (equal (logic.proofp (build.contraction x) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (e/d (definition-of-logic.proofp
+                                    logic.appeal-step-okp
+                                    logic.contraction-okp)
+                                  (FORCING-TRUE-LISTP-OF-LOGIC.SUBPROOFS))))))
+
+
+
+(defund@ build.expansion (a x)
+  (declare (xargs :guard (and (logic.formulap a)
+                              (logic.appealp x)
+                              (@match (formula a A)
+                                      (proof x B)))))
+  (logic.appeal 'expansion
+                (@formula (v A B))
+                (list x)
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.expansion)))
+
+ (defthm build.expansion-under-iff
+   (iff (build.expansion a x)
+        t))
+
+ (defthm logic.method-of-build.expansion
+   (equal (logic.method (build.expansion a x))
+          'expansion))
+
+ (defthm@ logic.conclusion-of-build.expansion
+   (@extend ((formula a A)
+             (proof x B))
+            (equal (logic.conclusion (build.expansion a x))
+                   (@formula (v A B)))))
+
+ (defthm logic.subproofs-of-build.expansion
+   (equal (logic.subproofs (build.expansion a x))
+          (list x)))
+
+ (defthm logic.extras-of-build.expansion
+   (equal (logic.extras (build.expansion a x))
+          nil))
+
+ (defthm forcing-logic.appealp-of-build.expansion
+   (implies (force (and (logic.formulap a)
+                        (logic.appealp x)))
+            (equal (logic.appealp (build.expansion a x))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.expansion
+   (implies (force (and (logic.formula-atblp a atbl)
+                        ;(logic.appealp x)
+                        (logic.proofp x axioms thms atbl)))
+            (equal (logic.proofp (build.expansion a x) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (e/d (logic.appeal-step-okp
+                                   logic.expansion-okp
+                                   definition-of-logic.proofp)
+                                  (forcing-logic.formula-atblp-rules
+                                   FORCING-LOGIC.FORMULA-ATBLP-OF-LOGIC.VLHS
+                                   FORCING-TRUE-LISTP-OF-LOGIC.SUBPROOFS))))))
+
+
+
+(defund@ build.associativity (x)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (@match (proof x (v A (v B C)))))))
+  (logic.appeal 'associativity
+                (@formula (v (v A B) C))
+                (list x)
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.associativity)))
+
+ (defthm build.associativity-under-iff
+   (iff (build.associativity x)
+        t))
+
+ (defthm logic.method-of-build.associativity
+   (equal (logic.method (build.associativity x))
+          'associativity))
+
+ (defthm@ logic.conclusion-of-build.associativity
+   (@extend ((proof x (v A (v B C))))
+            (equal (logic.conclusion (build.associativity x))
+                   (@formula (v (v A B) C)))))
+
+ (defthm logic.subproofs-of-build.associativity
+   (equal (logic.subproofs (build.associativity x))
+          (list x)))
+
+ (defthm logic.extras-of-build.associativity
+   (equal (logic.extras (build.associativity x))
+          nil))
+
+ (defthm@ forcing-logic.appealp-of-build.associativity
+   (implies (force (and (logic.appealp x)
+                        (@match (proof x (v A (v B C))))))
+            (equal (logic.appealp (build.associativity x))
+                   t)))
+
+ (defthm@ forcing-logic.proofp-of-build.associativity
+   (implies (force (and ;(logic.appealp x)
+                        (@match (proof x (v A (v B C))))
+                        (logic.proofp x axioms thms atbl)))
+            (equal (logic.proofp (build.associativity x) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (e/d (definition-of-logic.proofp
+                                    logic.appeal-step-okp
+                                    logic.associativity-okp)
+                                  (forcing-true-listp-of-logic.subproofs))))))
+
+
+
+(defund build.instantiation (x sigma)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.sigmap sigma))))
+  (let* ((conclusion (logic.conclusion x))
+         (instance   (logic.substitute-formula conclusion sigma)))
+    (if (equal conclusion instance)
+        (logic.appeal-identity x)
+      (logic.appeal 'instantiation instance (list x) sigma))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.instantiation)))
+
+ (defthm build.instantiation-under-iff
+   (iff (build.instantiation x sigma)
+        t))
+
+ (defthm logic.method-of-build.instantiation
+   (equal (logic.method (build.instantiation x sigma))
+          (if (equal (logic.conclusion x)
+                     (logic.substitute-formula (logic.conclusion x) sigma))
+              (logic.method x)
+            'instantiation)))
+
+ (defthm logic.conclusion-of-build.instantiation
+   (equal (logic.conclusion (build.instantiation x sigma))
+          (logic.substitute-formula (logic.conclusion x) sigma)))
+
+ (defthm logic.subproofs-of-build.instantiation
+   (equal (logic.subproofs (build.instantiation x sigma))
+          (if (equal (logic.conclusion x)
+                     (logic.substitute-formula (logic.conclusion x) sigma))
+              (logic.subproofs x)
+            (list x))))
+
+ (defthm logic.extras-of-build.instantiation
+   (equal (logic.extras (build.instantiation x sigma))
+          (if (equal (logic.conclusion x)
+                     (logic.substitute-formula (logic.conclusion x) sigma))
+              (logic.extras x)
+            sigma)))
+
+ (defthm forcing-logic.appealp-of-build.instantiation
+   (implies (force (and (logic.appealp x)
+                        (logic.sigmap sigma)))
+            (equal (logic.appealp (build.instantiation x sigma))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.instantiation
+   (implies (force (and ;(logic.appealp x)
+                        (logic.sigmap sigma)
+                        (logic.sigma-atblp sigma atbl)
+                        (logic.proofp x axioms thms atbl)))
+            (equal (logic.proofp (build.instantiation x sigma) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (e/d (definition-of-logic.proofp
+                                    logic.appeal-step-okp
+                                    logic.instantiation-okp)
+                                  (FORCING-TRUE-LISTP-OF-LOGIC.SUBPROOFS))))))
+
+
+
+(defund build.functional-equality (fn ti si)
+  (declare (xargs :guard (and (logic.function-namep fn)
+                              (logic.term-listp ti)
+                              (logic.term-listp si)
+                              (equal (len si) (len ti)))))
+  (logic.appeal 'functional-equality
+                (logic.functional-axiom fn ti si)
+                nil
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.functional-equality)))
+
+ (defthm build.functional-equality-under-iff
+   (iff (build.functional-equality fn ti si)
+        t))
+
+ (defthm logic.method-of-build.functional-equality
+   (equal (logic.method (build.functional-equality fn ti si))
+          'functional-equality))
+
+ (defthm logic.conclusion-of-build.functional-equality
+   (equal (logic.conclusion (build.functional-equality fn ti si))
+          (logic.functional-axiom fn ti si)))
+
+ (defthm logic.subproofs-of-build.functional-equality
+   (equal (logic.subproofs (build.functional-equality fn ti si))
+          nil))
+
+ (defthm logic.extras-of-build.functional-equality
+   (equal (logic.extras (build.functional-equality fn ti si))
+          nil))
+
+ (defthm forcing-logic.appealp-of-build.functional-equality
+   (implies (force (and (logic.function-namep fn)
+                        (logic.term-listp ti)
+                        (logic.term-listp si)
+                        (equal (len ti) (len si))))
+            (equal (logic.appealp (build.functional-equality fn ti si))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.functional-equality
+   (implies (force (and (logic.function-namep fn)
+                        (logic.term-list-atblp ti atbl)
+                        (logic.term-list-atblp si atbl)
+                        (equal (len ti) (len si))
+                        (equal (cdr (lookup fn atbl)) (len ti))))
+            (equal (logic.proofp (build.functional-equality fn ti si) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp
+                                     logic.appeal-step-okp
+                                     logic.functional-equality-okp)))))
+
+
+
+(defund build.beta-reduction (formals body actuals)
+  (declare (xargs :guard (and (true-listp formals)
+                              (logic.variable-listp formals)
+                              (uniquep formals)
+                              (logic.termp body)
+                              (subsetp (logic.term-vars body) formals)
+                              (equal (len formals) (len actuals))
+                              (true-listp actuals)
+                              (logic.term-listp actuals))))
+  (logic.appeal 'beta-reduction
+                (logic.pequal (logic.lambda formals body actuals)
+                              (logic.substitute body (pair-lists formals actuals)))
+                nil
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.beta-reduction)))
+
+ (defthm build.beta-reduction-under-iff
+   (iff (build.beta-reduction formals body actuals)
+        t))
+
+ (defthm logic.method-of-build.beta-reduction
+   (equal (logic.method (build.beta-reduction formals body actuals))
+          'beta-reduction))
+
+ (defthm logic.conclusion-of-build.beta-reduction
+   (equal (logic.conclusion (build.beta-reduction formals body actuals))
+          (logic.pequal (logic.lambda formals body actuals)
+                        (logic.substitute body (pair-lists formals actuals)))))
+
+ (defthm logic.subproofs-of-build.beta-reduction
+   (equal (logic.subproofs (build.beta-reduction formals body actuals))
+          nil))
+
+ (defthm logic.extras-of-build.beta-reduction
+   (equal (logic.extras (build.beta-reduction formals body actuals))
+          nil))
+
+ (defthm forcing-logic.appealp-of-build.beta-reduction
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (equal (len formals) (len actuals))
+                        (true-listp actuals)
+                        (logic.term-listp actuals)))
+            (equal (logic.appealp (build.beta-reduction formals body actuals))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.beta-reduction
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (equal (len formals) (len actuals))
+                        (true-listp actuals)
+                        (logic.term-listp actuals)
+                        (logic.term-atblp body atbl)
+                        (logic.term-list-atblp actuals atbl)))
+            (equal (logic.proofp (build.beta-reduction formals body actuals) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp
+                                     logic.appeal-step-okp
+                                     logic.beta-reduction-okp)))))
+
+
+
+(defund build.base-eval (a)
+  (declare (xargs :guard (and (logic.termp a)
+                              (logic.base-evaluablep a))))
+  (logic.appeal 'base-eval
+                (logic.pequal a (logic.base-evaluator a))
+                nil
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.base-eval)))
+
+ (defthm build.base-eval-under-iff
+   (iff (build.base-eval a)
+        t))
+
+ (defthm logic.method-of-build.base-eval
+   (equal (logic.method (build.base-eval a))
+          'base-eval))
+
+ (defthm logic.conclusion-of-build.base-eval
+   (equal (logic.conclusion (build.base-eval a))
+          (logic.pequal a (logic.base-evaluator a))))
+
+ (defthm logic.subproofs-of-build.base-eval
+   (equal (logic.subproofs (build.base-eval a))
+          nil))
+
+ (defthm logic.extras-of-build.base-eval
+   (equal (logic.extras (build.base-eval a))
+          nil))
+
+ (defthm forcing-logic.appealp-of-build.base-eval
+   (implies (force (and (logic.termp a)
+                        (logic.base-evaluablep a)))
+            (equal (logic.appealp (build.base-eval a))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.base-eval
+   (implies (force (and ;(logic.termp a)
+                        (logic.base-evaluablep a)
+                        (logic.term-atblp a atbl)))
+            (equal (logic.proofp (build.base-eval a) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp
+                                     logic.appeal-step-okp
+                                     logic.base-eval-okp)))))
+
+
+
+
+(defund build.instantiation-list (x sigma)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.sigmap sigma))))
+  (if (consp x)
+      (cons (build.instantiation (car x) sigma)
+            (build.instantiation-list (cdr x) sigma))
+    nil))
+
+(defobligations build.instantiation-list
+  (build.instantiation))
+
+(encapsulate
+ ()
+ (defthm build.instantiation-list-when-not-consp
+   (implies (not (consp x))
+            (equal (build.instantiation-list x sigma)
+                   nil))
+   :hints(("Goal" :in-theory (enable build.instantiation-list))))
+
+ (defthm build.instantiation-list-of-cons
+   (equal (build.instantiation-list (cons a x) sigma)
+          (cons (build.instantiation a sigma)
+                (build.instantiation-list x sigma)))
+   :hints(("Goal" :in-theory (enable build.instantiation-list))))
+
+ (defthm forcing-logic.appeal-listp-of-build.instantiation-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.sigmap sigma)))
+            (equal (logic.appeal-listp (build.instantiation-list x sigma))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm forcing-logic.strip-conclusions-of-build.instantiation-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.sigmap sigma)))
+            (equal (logic.strip-conclusions (build.instantiation-list x sigma))
+                   (logic.substitute-formula-list (logic.strip-conclusions x) sigma)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm forcing-logic.proofp-of-build.instantiation-list
+   (implies (force (and ;(logic.appeal-listp x)
+                        (logic.sigmap sigma)
+                        ;; ---
+                        (logic.sigma-atblp sigma atbl)
+                        (logic.proof-listp x axioms thms atbl)))
+            (equal (logic.proof-listp (build.instantiation-list x sigma) axioms thms atbl)
+                   t))
+   :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+
+
+(defund build.induction (f m qs all-sigmas proofs)
+  (declare (xargs :guard (and (logic.formulap f)
+                              (logic.termp m)
+                              (logic.formula-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas))
+                              (logic.appeal-listp proofs)
+                              (memberp (logic.make-basis-step f qs) (logic.strip-conclusions proofs))
+                              (subsetp (logic.make-induction-steps f qs all-sigmas) (logic.strip-conclusions proofs))
+                              (memberp (logic.make-ordinal-step m) (logic.strip-conclusions proofs))
+                              (subsetp (logic.make-all-measure-steps m qs all-sigmas) (logic.strip-conclusions proofs)))))
+  (logic.appeal 'induction
+                f
+                (list-fix proofs)
+                (list m qs all-sigmas)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.induction)))
+
+ (defthm build.induction-under-iff
+   (iff (build.induction f m qs sigmas proofs)
+        t))
+
+ (defthm logic.method-of-build.induction
+   (equal (logic.method (build.induction f m qs sigmas proofs))
+          'induction))
+
+ (defthm logic.conclusion-of-build.induction
+   (equal (logic.conclusion (build.induction f m qs sigmas proofs))
+          f))
+
+ (defthm logic.subproofs-of-build.induction
+   (equal (logic.subproofs (build.induction f m qs sigmas proofs))
+          (list-fix proofs)))
+
+ (defthm logic.extras-of-build.induction
+   (equal (logic.extras (build.induction f m qs sigmas proofs))
+          (list m qs sigmas)))
+
+ (defthm forcing-logic.appealp-of-build.induction
+   (implies (force (and (logic.formulap f)
+                        (logic.appeal-listp proofs)))
+            (equal (logic.appealp (build.induction f m qs sigmas proofs))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.induction
+   (implies (force (and (logic.formulap f)
+                        (logic.termp m)
+                        (logic.formula-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appeal-listp proofs)
+                        (memberp (logic.make-basis-step f qs) (logic.strip-conclusions proofs))
+                        (subsetp (logic.make-induction-steps f qs all-sigmas) (logic.strip-conclusions proofs))
+                        (memberp (logic.make-ordinal-step m) (logic.strip-conclusions proofs))
+                        (subsetp (logic.make-all-measure-steps m qs all-sigmas) (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.formula-atblp f atbl)
+                        (logic.proof-listp proofs axioms thms atbl)))
+            (equal (logic.proofp (build.induction f m qs all-sigmas proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp
+                                     logic.appeal-step-okp
+                                     logic.induction-okp)))))
+
+
+
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/build/cert.acl2 acl2-6.3/books/milawa/ACL2/build/cert.acl2
--- acl2-6.2/books/milawa/ACL2/build/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/cert.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/build/conjunctions.lisp acl2-6.3/books/milawa/ACL2/build/conjunctions.lisp
--- acl2-6.2/books/milawa/ACL2/build/conjunctions.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/conjunctions.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,124 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(dd.open "conjunctions.tex")
+
+(dd.subsection "Conjunction rules")
+
+(dd.write "These builders act as $\\wedge$ introduction and elimination rules.
+We typically avoid using conjunctions and instead build both proofs separately
+to avoid the conversion overhead.")
+
+(defderiv build.conjoin
+ :derive (! (v (! A) (! B)))
+ :from   ((proof x A)
+          (proof y B))
+ :proof  (@derive ((v (! (v (! A) (! B))) (v (! A) (! B)))   (build.propositional-schema (@formula (v (! A) (! B)))))
+                  ((v (v (! (v (! A) (! B))) (! A)) (! B))   (build.associativity @-))
+                  ((v (! B) (v (! (v (! A) (! B))) (! A)))   (build.commute-or @-))
+                  (B                                         (@given y))
+                  ((v (! (v (! A) (! B))) (! A))             (build.modus-ponens @- @--))
+                  ((v (! A) (! (v (! A) (! B))))             (build.commute-or @-))
+                  (A                                         (@given x))
+                  ((! (v (! A) (! B)))                       (build.modus-ponens @- @--))))
+
+(defderiv build.first-conjunct
+ :derive A
+ :from   ((proof x (! (v (! A) (! B)))))
+ :proof  (@derive ((v (! A) A)             (build.propositional-schema (@formula A)))
+                  ((v A (! A))             (build.commute-or @-))
+                  ((v (! B) (v A (! A)))   (build.expansion (@formula (! B)) @-))
+                  ((v (v (! B) A) (! A))   (build.associativity @-))
+                  ((v (! A) (v (! B) A))   (build.commute-or @-))
+                  ((v (v (! A) (! B)) A)   (build.associativity @-))
+                  ((! (v (! A) (! B)))     (@given x))
+                  (A                       (build.modus-ponens-2 @- @--))))
+
+(defderiv build.second-conjunct
+ :derive B
+ :from   ((proof x (! (v (! A) (! B)))))
+ :proof  (@derive ((v (! B) B)             (build.propositional-schema (@formula B)))
+                  ((v (! A) (v (! B) B))   (build.expansion (@formula (! A)) @-))
+                  ((v (v (! A) (! B)) B)   (build.associativity @-))
+                  ((! (v (! A) (! B)))     (@given x))
+                  (B                       (build.modus-ponens-2 @- @--))))
+
+(defderiv build.disjoined-conjoin
+ :derive (v P (! (v (! A) (! B))))
+ :from   ((proof x (v P A))
+          (proof y (v P B)))
+ :proof  (@derive ((v (! (v (! A) (! B))) (v (! A) (! B)))   (build.propositional-schema (@formula (v (! A) (! B)))))
+                  ((v (v (! (v (! A) (! B))) (! A)) (! B))   (build.associativity @-))
+                  ((v (! B) (v (! (v (! A) (! B))) (! A)))   (build.commute-or @-)  *1)
+                  ((v P B)                                   (@given y))
+                  ((v B P)                                   (build.commute-or @-))
+                  ((v P (v (! (v (! A) (! B))) (! A)))       (build.cut @- *1))
+                  ((v P (v (! A) (! (v (! A) (! B)))))       (build.disjoined-commute-or @-))
+                  ((v P A)                                   (@given x))
+                  ((v P (! (v (! A) (! B))))                 (build.disjoined-modus-ponens @- @--))))
+
+(defderiv build.disjoined-first-conjunct
+ :derive (v P A)
+ :from   ((proof x (v P (! (v (! A) (! B))))))
+ :proof  (@derive ((v (! A) A)                 (build.propositional-schema (@formula A)))
+                  ((v A (! A))                 (build.commute-or @-))
+                  ((v (! B) (v A (! A)))       (build.expansion (@formula (! B)) @-))
+                  ((v (v (! B) A) (! A))       (build.associativity @-))
+                  ((v (! A) (v (! B) A))       (build.commute-or @-))
+                  ((v (v (! A) (! B)) A)       (build.associativity @-)                   *1)
+                  ((v P (! (v (! A) (! B))))   (@given x))
+                  ((v (! (v (! A) (! B))) P)   (build.commute-or @-))
+                  ((v A P)                     (build.cut *1 @-))
+                  ((v P A)                     (build.commute-or @-))))
+
+(defderiv build.disjoined-second-conjunct
+ :derive (v P B)
+ :from   ((proof x (v P (! (v (! A) (! B))))))
+ :proof  (@derive ((v (! B) B)                 (build.propositional-schema (@formula B)))
+                  ((v (! A) (v (! B) B))       (build.expansion (@formula (! A)) @-))
+                  ((v (v (! A) (! B)) B)       (build.associativity @-)                    *1)
+                  ((v P (! (v (! A) (! B))))   (@given x))
+                  ((v (! (v (! A) (! B))) P)   (build.commute-or @-))
+                  ((v B P)                     (build.cut *1 @-))
+                  ((v P B)                     (build.commute-or @-))))
+
+(dd.close)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/build/cons.lisp acl2-6.3/books/milawa/ACL2/build/cons.lisp
--- acl2-6.2/books/milawa/ACL2/build/cons.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/cons.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,66 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "cons.tex")
+
+(deftheorem theorem-cons-is-not-nil
+  :derive (!= (cons x y) nil)
+  :proof  (@derive
+           ((v (= (symbolp x) nil)          (= (consp x) nil))              (build.axiom (axiom-disjoint-symbols-and-conses)))
+           ((v (= (symbolp (cons x y)) nil) (= (consp (cons x y)) nil))     (build.instantiation @- (@sigma (x . (cons x y)))))
+           ((v (= (consp (cons x y)) nil)   (= (symbolp (cons x y)) nil))   (build.commute-or @-)                                 *1)
+           ((= (consp (cons x y)) t)                                        (build.axiom (axiom-consp-of-cons)))
+           ((!= (consp (cons x y)) nil)                                     (build.not-nil-from-t @-))
+           ((= (symbolp (cons x y)) nil)                                    (build.modus-ponens-2 @- *1))
+           ((!= (symbolp (cons x y)) t)                                     (build.not-t-from-nil @-))
+           ((!= t (symbolp (cons x y)))                                     (build.commute-not-pequal @-))
+           ((= (symbolp nil) t)                                             (build.base-eval '(symbolp 'nil)))
+           ((!= (symbolp nil) (symbolp (cons x y)))                         (build.substitute-into-not-pequal @-- @-))
+           ((!= (symbolp (cons x y)) (symbolp nil))                         (build.commute-not-pequal @-)                         *2)
+           ((v (!= (cons x y) nil) (= (cons x y) nil))                      (build.propositional-schema (@formula (= (cons x y) nil))))
+           ((v (!= (cons x y) nil) (= (symbolp (cons x y)) (symbolp nil)))  (build.disjoined-pequal-by-args 'symbolp (@formula (!= (cons x y) nil)) (list @-)))
+           ((v (= (symbolp (cons x y)) (symbolp nil)) (!= (cons x y) nil))  (build.commute-or @-))
+           ((!= (cons x y) nil)                                             (build.modus-ponens-2 *2 @-)))
+  :minatbl ((cons . 2)
+            (consp . 1)
+            (symbolp . 1)))
+
+(dd.close)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/build/disjoined-rev-disjunction.lisp acl2-6.3/books/milawa/ACL2/build/disjoined-rev-disjunction.lisp
--- acl2-6.2/books/milawa/ACL2/build/disjoined-rev-disjunction.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/disjoined-rev-disjunction.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,241 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "disjoined-rev-disjunction.tex")
+
+
+(defderiv build.disjoined-revappend-disjunction-lemma1-bldr
+  :derive (v P (v Q (v t1 R)))
+  :from   ((proof x (v P (v (v t1 Q) R))))
+  :proof  (@derive
+           ((v P (v (v t1 Q) R))    (@given x))
+           ((v P (v R (v t1 Q)))    (build.disjoined-commute-or @-))
+           ((v P (v (v R t1) Q))    (build.disjoined-associativity @-))
+           ((v P (v Q (v R t1)))    (build.disjoined-commute-or @-))
+           ((v (v P Q) (v R t1))    (build.associativity @-))
+           ((v (v P Q) (v t1 R))    (build.disjoined-commute-or @-))
+           ((v P (v Q (v t1 R)))    (build.right-associativity @-))))
+
+(defund@ build.disjoined-revappend-disjunction (p todo done proof)
+  ;; Derive P v tn v ... v t1 v d1 v ... v dm from P v (t1 v ... v tn) v (d1 v ... v dm)
+  (declare (xargs :guard (and (logic.formulap p)
+                              (logic.formula-listp todo)
+                              (logic.formula-listp done)
+                              (or (consp todo) (consp done))
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (cond ((and (consp todo)
+                                                 (consp done))
+                                            (logic.por p (logic.por (logic.disjoin-formulas todo)
+                                                                    (logic.disjoin-formulas done))))
+                                           ((consp todo)
+                                            (logic.por p (logic.disjoin-formulas todo)))
+                                           (t
+                                            (logic.por p (logic.disjoin-formulas done))))))
+                  :verify-guards nil))
+  (if (and (consp todo)
+           (consp (cdr todo)))
+      (if (consp done)
+          (build.disjoined-revappend-disjunction p
+                                                 (cdr todo)
+                                                 (cons (car todo) done)
+                                                 ;; P v (t1 v t2-tn) v d1-dm
+                                                 ;; ------------------------
+                                                 ;; P v t2-tn v t1 v d1-dm
+                                                 (build.disjoined-revappend-disjunction-lemma1-bldr proof))
+        (build.disjoined-revappend-disjunction p
+                                               (cdr todo)
+                                               (cons (car todo) done)
+                                               ;; P v t1 v t2-tn
+                                               ;; --------------
+                                               ;; P v t2-tn v t1
+                                               (build.disjoined-commute-or proof)))
+    ;; Otherwise, the todo list is only one long, so we already have the proof
+    ;; we were looking for.
+    (logic.appeal-identity proof)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-revappend-disjunction)))
+
+ (defthm build.disjoined-revappend-disjunction-under-iff
+   (iff (build.disjoined-revappend-disjunction p todo done proof)
+        t))
+
+ (local (defthm lemma
+          (implies (and (logic.formulap p)
+                        (logic.formula-listp todo)
+                        (logic.formula-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp todo)
+                                           (consp done))
+                                      (logic.por p (logic.por (logic.disjoin-formulas todo)
+                                                              (logic.disjoin-formulas done))))
+                                     ((consp todo)
+                                      (logic.por p (logic.disjoin-formulas todo)))
+                                     (t
+                                      (logic.por p (logic.disjoin-formulas done))))))
+                   (and (logic.appealp (build.disjoined-revappend-disjunction p todo done proof))
+                        (equal (logic.conclusion (build.disjoined-revappend-disjunction p todo done proof))
+                               (logic.por p (logic.disjoin-formulas (app (rev todo) done))))))))
+
+ (defthm forcing-logic.appealp-of-build.disjoined-revappend-disjunction
+   (implies (force (and (logic.formulap p)
+                        (logic.formula-listp todo)
+                        (logic.formula-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp todo)
+                                           (consp done))
+                                      (logic.por p (logic.por (logic.disjoin-formulas todo)
+                                                              (logic.disjoin-formulas done))))
+                                     ((consp todo)
+                                      (logic.por p (logic.disjoin-formulas todo)))
+                                     (t
+                                      (logic.por p (logic.disjoin-formulas done)))))))
+            (equal (logic.appealp (build.disjoined-revappend-disjunction p todo done proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-revappend-disjunction
+   (implies (force (and (logic.formulap p)
+                        (logic.formula-listp todo)
+                        (logic.formula-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp todo)
+                                           (consp done))
+                                      (logic.por p (logic.por (logic.disjoin-formulas todo)
+                                                              (logic.disjoin-formulas done))))
+                                     ((consp todo)
+                                      (logic.por p (logic.disjoin-formulas todo)))
+                                     (t
+                                      (logic.por p (logic.disjoin-formulas done)))))))
+            (equal (logic.conclusion (build.disjoined-revappend-disjunction p todo done proof))
+                   (logic.por p (logic.disjoin-formulas (app (rev todo) done)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (verify-guards build.disjoined-revappend-disjunction)
+
+ (defthm forcing-logic.proofp-of-build.disjoined-revappend-disjunction
+   (implies (force (and (logic.formulap p)
+                        (logic.formula-listp todo)
+                        (logic.formula-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp todo)
+                                           (consp done))
+                                      (logic.por p (logic.por (logic.disjoin-formulas todo)
+                                                              (logic.disjoin-formulas done))))
+                                     ((consp todo)
+                                      (logic.por p (logic.disjoin-formulas todo)))
+                                     (t
+                                      (logic.por p (logic.disjoin-formulas done)))))
+                        ;; ---
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.disjoined-revappend-disjunction p todo done proof) axioms thms atbl)
+                   t))))
+
+
+(defund build.disjoined-rev-disjunction (x proof)
+  ;; Derive P v tn v ... v t1 from P v t1 v ... v tn
+  ;; (x should be the list of formulas [t1, ..., tn])
+  (declare (xargs :guard (and (consp x)
+                              (logic.formula-listp x)
+                              (logic.appealp proof)
+                              (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                              (equal (logic.vrhs (logic.conclusion proof))
+                                     (logic.disjoin-formulas x)))
+                  :export (build.generic-subset
+                           (cons (logic.vlhs (logic.conclusion proof))
+                                 x)
+                           (cons (logic.vlhs (logic.conclusion proof))
+                                 (fast-rev x))
+                           proof)))
+  (build.disjoined-revappend-disjunction (logic.vlhs (logic.conclusion proof)) x nil proof))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-rev-disjunction)))
+
+ (defthm build.disjoined-rev-disjunction-under-iff
+   (iff (build.disjoined-rev-disjunction x proof)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.disjoined-rev-disjunction
+   (implies (force (and (consp x)
+                        (logic.formula-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof))
+                               (logic.disjoin-formulas x))))
+            (equal (logic.appealp (build.disjoined-rev-disjunction x proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-rev-disjunction
+   (implies (force (and (consp x)
+                        (logic.formula-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof))
+                               (logic.disjoin-formulas x))))
+            (equal (logic.conclusion (build.disjoined-rev-disjunction x proof))
+                   (logic.por (logic.vlhs (logic.conclusion proof))
+                              (logic.disjoin-formulas (rev x)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proofp-of-build.disjoined-rev-disjunction
+   (implies (force (and (consp x)
+                        (logic.formula-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof))
+                               (logic.disjoin-formulas x))
+                        ;; ---
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.disjoined-rev-disjunction x proof) axioms thms atbl)
+                   t))))
+
+(dd.close)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/build/disjoined-subset.lisp acl2-6.3/books/milawa/ACL2/build/disjoined-subset.lisp
--- acl2-6.2/books/milawa/ACL2/build/disjoined-subset.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/disjoined-subset.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1151 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop-list")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "disjoined-subset.tex")
+
+
+;; We introduce builders to prove B1 v ... v Bm from A1 v ... v An, where
+;; [A1,...,An] is a subset of [B1,...,Bm].
+;;
+;; We actually introduce several such builders.  The first of these is called
+;; build.generic-subset, and can construct the proof in the general case.  But
+;; it is not very efficient.  To address this, we introduce some variants for
+;; the special purposes of proving list reversals, ordered subsets, and the
+;; like.  In the end, we create an "adaptive" builder which tries to
+;; semi-intelligently choose an efficient proof method.
+
+
+(defund@ build.multi-or-expansion-step (base as)
+  ;; Derive P v A1 v ... v An from P v Ai
+  ;; Note: this is basically like Shankar's function M2-Proof-Step
+  (declare (xargs :guard (and (logic.appealp base)
+                              (logic.formula-listp as)
+                              (@match (proof base (v P Ai)))
+                              (memberp (@formula Ai) as))
+                  :verify-guards nil))
+  (@extend ((formula (car as) A1))
+           (if (and (consp as)
+                    (consp (cdr as)))
+               (cond ((equal (@formula A1) (@formula Ai))
+                      (@derive ((v P A1)                         (@given base))
+                               ((v P (v A1 (v A2 (v dots An))))  (build.disjoined-right-expansion @- (logic.disjoin-formulas (cdr as))))))
+                     (t
+                      (@derive ((v P (v A2 (v dots An)))         (build.multi-or-expansion-step base (cdr as)))
+                               ((v P (v A1 (v A2 (v dots An))))  (build.disjoined-left-expansion @- (@formula A1))))))
+             ;; Else there is only one A, so it must be Ai
+             (@derive ((v P Ai) (logic.appeal-identity base))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.multi-or-expansion-step)))
+
+ (defthm build.multi-or-expansion-step-under-iff
+   (iff (build.multi-or-expansion-step base as)
+        t))
+
+ (defthm@ lemma-for-forcing-logic.appealp-of-build.multi-or-expansion-step
+  ;; BOZO add to disjoined-subset.lisp
+  (implies (and (logic.appealp base)
+                (logic.formula-listp as)
+                (@match (proof base (v P Ai)))
+                (memberp (@formula Ai) as))
+           (and (logic.appealp (build.multi-or-expansion-step base as))
+                (equal (logic.conclusion (build.multi-or-expansion-step base as))
+                       (logic.por (@formula P) (logic.disjoin-formulas as)))))
+  :rule-classes nil)
+
+ (defthm@ forcing-logic.appealp-of-build.multi-or-expansion-step
+   (implies (force (and (logic.appealp base)
+                        (logic.formula-listp as)
+                        (@match (proof base (v P Ai)))
+                        (memberp (@formula Ai) as)))
+            (equal (logic.appealp (build.multi-or-expansion-step base as))
+                   t))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-build.multi-or-expansion-step)))))
+
+ (defthm@ forcing-logic.conclusion-of-build.multi-or-expansion-step
+   (implies (force (and (logic.appealp base)
+                        (logic.formula-listp as)
+                        (@match (proof base (v P Ai)))
+                        (memberp (@formula Ai) as)))
+            (equal (logic.conclusion (build.multi-or-expansion-step base as))
+                   (logic.por (@formula P) (logic.disjoin-formulas as))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-build.multi-or-expansion-step)))))
+
+ (verify-guards build.multi-or-expansion-step)
+
+ (defthm@ forcing-logic.proofp-of-build.multi-or-expansion-step
+   (implies (force (and (logic.appealp base)
+                        (logic.formula-listp as)
+                        (@match (proof base (v P Ai)))
+                        (memberp (@formula Ai) as)
+                        ;; ---
+                        (logic.formula-list-atblp as atbl)
+                        (logic.proofp base axioms thms atbl)))
+            (equal (logic.proofp (build.multi-or-expansion-step base as) axioms thms atbl)
+                   t))))
+
+
+
+
+
+(defund@ build.multi-or-expansion (base as)
+  ;; Derive A1 v ... v An from Ai v Aj for any 1 <= i,j <= n
+  ;; Note: this is basically like Shankar's function "M2-Proof"
+  (declare (xargs :guard (and (logic.appealp base)
+                              (logic.formula-listp as)
+                              (@match (proof base (v Ai Aj)))
+                              (memberp (@formula Ai) as)
+                              (memberp (@formula Aj) as))))
+
+  (if (consp as)
+      (@extend ((formula (car as) A1))
+        (cond ((equal (@formula Ai) (@formula Aj))
+               (@derive ((v Ai Ai)                  (@given base))
+                        (Ai                         (build.contraction @-))
+                        ((v A1 (v dots An))         (build.multi-expansion @- as))))
+              ((equal (@formula Ai) (@formula A1))
+               (@derive ((v A1 Aj)                  (@given base))
+                        ((v A1 (v dots An))         (build.multi-or-expansion-step @- (cdr as)))))
+              ((equal (@formula Aj) (@formula A1))
+               (@derive ((v Ai A1)                  (@given base))
+                        ((v A1 Ai)                  (build.commute-or @-))
+                        ((v A1 (v dots An))         (build.multi-or-expansion-step @- (cdr as)))))
+              (t
+               (@derive ((v A2 (v dots An))         (build.multi-or-expansion base (cdr as)))
+                        ((v A1 (v A2 (v dots An)))  (build.expansion (@formula A1) @-))))))
+    ;; Degenerate case.
+    (logic.appeal-identity base)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.multi-or-expansion)))
+
+ (defthm build.multi-or-expansion-under-iff
+   (iff (build.multi-or-expansion base as)
+        t))
+
+ (defthm@ forcing-logic.appealp-of-build.multi-or-expansion
+   (implies (force (and (logic.appealp base)
+                        (logic.formula-listp as)
+                        (@match (proof base (v Ai Aj)))
+                        (memberp (@formula Ai) as)
+                        (memberp (@formula Aj) as)))
+            (equal (logic.appealp (build.multi-or-expansion base as))
+                   t)))
+
+ (defthm@ forcing-logic.conclusion-of-build.multi-or-expansion
+   (implies (force (and (logic.appealp base)
+                        (logic.formula-listp as)
+                        (@match (proof base (v Ai Aj)))
+                        (memberp (@formula Ai) as)
+                        (memberp (@formula Aj) as)))
+            (equal (logic.conclusion (build.multi-or-expansion base as))
+                   (logic.disjoin-formulas as)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.multi-or-expansion
+   (implies (force (and (logic.appealp base)
+                        (logic.formula-listp as)
+                        (@match (proof base (v Ai Aj)))
+                        (memberp (@formula Ai) as)
+                        (memberp (@formula Aj) as)
+                        ;; ---
+                        (force (logic.formula-list-atblp as atbl))
+                        (force (logic.proofp base axioms thms atbl))))
+            (equal (logic.proofp (build.multi-or-expansion base as) axioms thms atbl)
+                   t))))
+
+
+
+(defderiv build.generic-subset-step-lemma-1
+  :from   ((proof x (v (v P A) P)))
+  :derive (v P A)
+  :proof  (@derive ((v (v P A) P)  (@given x))
+                   ((v P (v P A))  (build.commute-or @-))
+                   ((v (v P P) A)  (build.associativity @-))
+                   ((v A (v P P))  (build.commute-or @-))
+                   ((v A P)        (build.disjoined-contraction @-))
+                   ((v P A)        (build.commute-or @-))))
+
+(defund@ build.generic-subset-step (proof as)
+  ;; Derive A1 v ... v An from (Ai v Aj) v (A1 v ... v An)
+  ;;
+  ;; I originally based this on Shankar's M3-Proof function, but since then
+  ;; I've tweaked it slightly and it no now uses multi-or-expansion-step
+  ;; instead of multi-or-expansion.  This seems to save about 4-5% off of
+  ;; proofs of the generic subset builder.
+  (declare (xargs :guard (and (logic.formula-listp as)
+                              (logic.appealp proof)
+                              (@match (proof proof (v (v Ai Aj) A1-An)))
+                              (memberp (@formula Ai) as)
+                              (memberp (@formula Aj) as)
+                              (equal (@formula A1-An) (logic.disjoin-formulas as)))))
+  (@derive
+   ((v (v Ai Aj) A1-An)     (@given proof))
+   ((v A1-An (v Ai Aj))     (build.commute-or @-))
+   ((v (v A1-An Ai) Aj)     (build.associativity @-))
+   ((v (v A1-An Ai) A1-An)  (build.multi-or-expansion-step @- as))
+   ((v A1-An Ai)            (build.generic-subset-step-lemma-1 @-))
+   ((v A1-An A1-An)         (build.multi-or-expansion-step @- as))
+   (A1-An                   (build.contraction @-))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.generic-subset-step)))
+
+ (defthm build.generic-subset-step-under-iff
+   (iff (build.generic-subset-step proof as)
+        t))
+
+ (defthm@ forcing-logic.appealp-of-build.generic-subset-step
+   (implies (force (and (logic.formula-listp as)
+                        (logic.appealp proof)
+                        (@match (proof proof (v (v Ai Aj) A1-An)))
+                        (memberp (@formula Ai) as)
+                        (memberp (@formula Aj) as)
+                        (equal (@formula A1-An) (logic.disjoin-formulas as))))
+            (equal (logic.appealp (build.generic-subset-step proof as))
+                   t)))
+
+ (verify-guards build.generic-subset-step)
+
+ (defthm@ forcing-logic.conclusion-of-build.generic-subset-step
+   (implies (force (and (logic.formula-listp as)
+                        (logic.appealp proof)
+                        (@match (proof proof (v (v Ai Aj) A1-An)))
+                        (memberp (@formula Ai) as)
+                        (memberp (@formula Aj) as)
+                        (equal (@formula A1-An) (logic.disjoin-formulas as))))
+            (equal (logic.conclusion (build.generic-subset-step proof as))
+                   (logic.disjoin-formulas as)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.generic-subset-step
+   (implies (force (and (logic.formula-listp as)
+                        (logic.appealp proof)
+                        (@match (proof proof (v (v Ai Aj) A1-An)))
+                        (memberp (@formula Ai) as)
+                        (memberp (@formula Aj) as)
+                        (equal (@formula A1-An) (logic.disjoin-formulas as))
+                        ;; ---
+                        (logic.formula-list-atblp as atbl)
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.generic-subset-step proof as) axioms thms atbl)
+                   t))))
+
+
+
+
+;: build.generic-subset                               Cost: 12(n^2) + x
+;: Derive B1 v ... v Bm
+;:   from A1 v ... v An,
+;:   where {A1 ... An} is a subset of {B1 ... Bm}
+;:
+;; Derivation. (defined by induction on n)
+;;
+;; Base Case:   n = 1                                     Cost: n + x
+;;   1. Ai                Given
+;;   2. B1 v ... v Bm     Multi Expansion
+;;
+;; Base Case:   n = 2                                     Cost: 6n + x
+;;   1. Ai v Aj
+;;   2. B1 v ... v Bm     Multi Or Expansion
+;;
+;; Induction Case:  n >= 3                                Cost: 12n + x
+;;   Let F = (A1 v A2).
+;;   F v (A3 v (A4 v ... v An)) is a disjunction of n-1 formulas.
+;;   Inductively assume we can prove F v (B1 v ... v Bm) from a proof
+;;   of F v (A3 v ... v An).
+;;
+;; Derivation.
+;;   1.   A1 v (A2 v ... v An)         Given
+;;   2.   (A1 v A2) v (A3 v ... v An)  Associativity
+;;   2'.  F v (A3 v ... v An)          (By the definition of F)
+;;   3.   F v (B1 v ... v Bm)          Inductive Hypothesis
+;;   3'.  (A1 v A2) v (B1 v ... v Bm)  (By the definition of F)
+;;   4.   B1 v B2 v ... v Bm           Disjoined-Subset-Step
+;;
+;;
+;; Note: This is basically like Shankar's function "M-Proof."  We take two
+;; lists of formulas, (A1 ... An) and (B1 ... Bm), where each A occurs in the
+;; list of B's.  We also take, as another input, a proof of A1 v A2 v ... v An.
+;; We construct a proof of B1 v B2 v ... v Bm.  Note that both n,m must be >=
+;; 1; i.e., we must have non-empty lists of formulas.
+
+(defund@ build.generic-subset (as bs proof)
+  ;; Derive B1 v ... v Bm from A1 v ... v An, where as are a subset of bs
+  ;; Note: this is basically like Shankar's function "M-Proof"
+  (declare (xargs :guard (and (logic.formula-listp bs)
+                              (subsetp as bs)
+                              (consp as)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (logic.disjoin-formulas as)))
+                  :measure (len as)
+                  :verify-guards nil))
+  (@extend ((formula (first as) A1)
+            (formula (second as) A2)
+            (formula (third as) A3))
+    (cond ((not (consp as))
+           ;; Degenerate case -- this isn't even allowed by our guard
+           (logic.appeal-identity proof))
+
+          ((not (consp (cdr as)))
+           ;; as = [A1]
+           (@derive (A1                   (@given proof))
+                    ((v B1 (v dots Bn))   (build.multi-expansion @- bs))))
+
+          ((not (consp (cdr (cdr as))))
+           ;; as = [A1 A2]
+           (@derive ((v A1 A2)            (@given proof))
+                    ((v B1 (v dots Bn))   (build.multi-or-expansion @- bs))))
+
+          (t
+           ;; as = [A1 A2 A3 ...]
+           (@derive ((v A1 (v A2 (v A3 (v dots An))))   (@given proof))
+                    ((v (v A1 A2) (v A3 (v dots An)))   (build.associativity @-))
+                    ((v (v A1 A2) (v B1 (v dots Bm)))   (build.generic-subset (cons (@formula (v A1 A2)) (cdr (cdr as)))
+                                                                              (cons (@formula (v A1 A2)) bs)
+                                                                              @-))
+                    ((v B1 (v dots Bm))                 (build.generic-subset-step @- bs)))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.generic-subset)))
+
+ (defthm build.generic-subset-under-iff
+   (iff (build.generic-subset as bs proof)
+        t))
+
+ (defthm lemma-for-forcing-logic.appealp-of-build.generic-subset
+   (implies (and (logic.formula-listp bs)
+                 (subsetp as bs)
+                 (consp as)
+                 (logic.appealp proof)
+                 (equal (logic.conclusion proof) (logic.disjoin-formulas as)))
+            (and (logic.appealp (build.generic-subset as bs proof))
+                 (equal (logic.conclusion (build.generic-subset as bs proof))
+                        (logic.disjoin-formulas bs))))
+   :rule-classes nil)
+
+ (defthm forcing-logic.appealp-of-build.generic-subset
+   (implies (force (and (logic.formula-listp bs)
+                        (logic.appealp proof)
+                        (subsetp as bs)
+                        (consp as)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas as))))
+            (equal (logic.appealp (build.generic-subset as bs proof))
+                   t))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-build.generic-subset)))))
+
+ (defthm forcing-logic.conclusion-of-build.generic-subset
+   (implies (force (and (logic.formula-listp bs)
+                        (logic.appealp proof)
+                        (subsetp as bs)
+                        (consp as)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas as))))
+            (equal (logic.conclusion (build.generic-subset as bs proof))
+                   (logic.disjoin-formulas bs)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-build.generic-subset)))))
+
+ (verify-guards build.generic-subset)
+
+ (defthm forcing-logic.proofp-of-build.generic-subset
+   (implies (force (and (logic.formula-listp bs)
+                        (logic.appealp proof)
+                        (subsetp as bs)
+                        (consp as)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas as))
+                        ;; ---
+                        (logic.formula-list-atblp bs atbl)
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.generic-subset as bs proof) axioms thms atbl)
+                   t))))
+
+
+
+
+
+
+;; We now introduce build.rev-disjunction, which efficiently builds a proof of
+;; (an v ... v a1) from a proof of (a1 v ... v an).  We could already build
+;; such proofs with our generic subset builder, but this builder is much more
+;; efficient.  For simple tests of the variety shown at the end of this
+;; section, we obtain the following savings in terms of "rank":
+;;
+;;    n   generic-subset   rev-disjunction    savings
+;;   ----------------------------------------------------
+;;     1             5                 5           0%
+;;     2            38                38           0%
+;;     3         1,864               771          59%
+;;     5        15,194             3,605          76%
+;;    10       176,269            18,670          89%
+;;    20     2,042,969            83,000          96%
+;;    30     8,936,569           192,930          98%
+;;   ----------------------------------------------------
+;;
+;; Our proof construction mirrors the "revappend" function, and is implemented
+;; as build.revappend-disjunction.  Most users should call build.rev-disjunction
+;; instead, which hides the accumulator.
+
+(defund@ build.revappend-disjunction (todo done proof)
+  ;; Derive tn v ... v t1 v d1 v ... v dm from (t1 v ... v tn) v (d1 v ... v dm)
+  (declare (xargs :guard (and (logic.formula-listp todo)
+                              (logic.formula-listp done)
+                              (or (consp todo) (consp done))
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (cond ((and (consp todo)
+                                                 (consp done))
+                                            (logic.por (logic.disjoin-formulas todo)
+                                                 (logic.disjoin-formulas done)))
+                                           ((consp todo)
+                                            (logic.disjoin-formulas todo))
+                                           (t
+                                            (logic.disjoin-formulas done)))))
+                  :verify-guards nil))
+  (if (and (consp todo)
+           (consp (cdr todo)))
+      (if (consp done)
+          (@derive
+           ((v (v t1 t2-tn) d1-dm)     (@given proof))
+           ((v d1-dm (v t1 t2-tn))     (build.commute-or @-))
+           ((v (v d1-dm t1) t2-tn)     (build.associativity @-))
+           ((v t2-tn (v d1-dm t1))     (build.commute-or @-))
+           ((v t2-tn (v t1 d1-dm))     (build.disjoined-commute-or @-))
+           ((v tn-t1 dm-d1)            (build.revappend-disjunction (cdr todo) (cons (car todo) done) @-)))
+        (@derive
+         ((v t1 t2-n)                  (@given proof))
+         ((v t2-n t1)                  (build.commute-or @-))
+         (tn-t1                        (build.revappend-disjunction (cdr todo) (list (car todo)) @-))))
+    ;; Otherwise, the todo list is only one long, so we already have the proof
+    ;; we were looking for.
+    (logic.appeal-identity proof)))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.revappend-disjunction)))
+
+ (defthm build.revappend-disjunction-under-iff
+   (iff (build.revappend-disjunction todo done proof)
+        t))
+
+ (local (defthm lemma
+          (implies (and (logic.formula-listp todo)
+                        (logic.formula-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp todo)
+                                           (consp done))
+                                      (logic.por (logic.disjoin-formulas todo)
+                                                 (logic.disjoin-formulas done)))
+                                     ((consp todo)
+                                      (logic.disjoin-formulas todo))
+                                     (t
+                                      (logic.disjoin-formulas done)))))
+                   (and (logic.appealp (build.revappend-disjunction todo done proof))
+                        (equal (logic.conclusion (build.revappend-disjunction todo done proof))
+                               (logic.disjoin-formulas (app (rev todo) done)))))))
+
+ (defthm forcing-logic.appealp-of-build.revappend-disjunction
+   (implies (force (and (logic.formula-listp todo)
+                        (logic.formula-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp todo)
+                                           (consp done))
+                                      (logic.por (logic.disjoin-formulas todo)
+                                                 (logic.disjoin-formulas done)))
+                                     ((consp todo)
+                                      (logic.disjoin-formulas todo))
+                                     (t
+                                      (logic.disjoin-formulas done))))))
+            (equal (logic.appealp (build.revappend-disjunction todo done proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.revappend-disjunction
+   (implies (force (and (logic.formula-listp todo)
+                        (logic.formula-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp todo)
+                                           (consp done))
+                                      (logic.por (logic.disjoin-formulas todo)
+                                                 (logic.disjoin-formulas done)))
+                                     ((consp todo)
+                                      (logic.disjoin-formulas todo))
+                                     (t
+                                      (logic.disjoin-formulas done))))))
+            (equal (logic.conclusion (build.revappend-disjunction todo done proof))
+                   (logic.disjoin-formulas (app (rev todo) done))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (verify-guards build.revappend-disjunction)
+
+ (defthm forcing-logic.proofp-of-build.revappend-disjunction
+   (implies (force (and (logic.formula-listp todo)
+                        (logic.formula-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp todo)
+                                           (consp done))
+                                      (logic.por (logic.disjoin-formulas todo)
+                                                 (logic.disjoin-formulas done)))
+                                     ((consp todo)
+                                      (logic.disjoin-formulas todo))
+                                     (t
+                                      (logic.disjoin-formulas done))))
+                        ;; ---
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.revappend-disjunction todo done proof) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.rev-disjunction (x proof)
+  ;; Derive tn v ... v t1 from t1 v ... v tn
+  (declare (xargs :guard (and (consp x)
+                              (logic.formula-listp x)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (logic.disjoin-formulas x)))
+                  ;; As far as Milawa is concerned, build.rev-disjunction is going to be
+                  ;; an alias for build.generic-subset.  This way we don't have to write
+                  ;; any proofs about it, we can just let it expand.
+                  :export (build.generic-subset x (fast-rev x) proof)))
+  (build.revappend-disjunction x nil proof))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.rev-disjunction)))
+
+ (defthm build.rev-disjunction-under-iff
+   (iff (build.rev-disjunction x proof)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.rev-disjunction
+   (implies (force (and (consp x)
+                        (logic.formula-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas x))))
+            (equal (logic.appealp (build.rev-disjunction x proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.rev-disjunction
+   (implies (force (and (consp x)
+                        (logic.formula-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas x))))
+            (equal (logic.conclusion (build.rev-disjunction x proof))
+                   (logic.disjoin-formulas (rev x))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proofp-of-build.rev-disjunction
+   (implies (force (and (consp x)
+                        (logic.formula-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas x))
+                        ;; ---
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.rev-disjunction x proof) axioms thms atbl)
+                   t))))
+
+
+
+;; Our test data above was obtained by just running this let expression and
+;; commenting out the appropriate number of lines.
+;;
+;; (let* ((formulas (list
+;;                   (logic.pequal 'a1 'a1-prime)
+;;                   (logic.pequal 'a2 'a2-prime)
+;;                   (logic.pequal 'a3 'a3-prime)
+;;                   (logic.pequal 'a4 'a4-prime)
+;;                   (logic.pequal 'a5 'a5-prime)
+;;                   (logic.pequal 'a6 'a6-prime)
+;;                   (logic.pequal 'a7 'a7-prime)
+;;                   (logic.pequal 'a8 'a8-prime)
+;;                   (logic.pequal 'a9 'a9-prime)
+;;                   (logic.pequal 'a10 'a10-prime)
+;;                   ;(logic.pequal 'a11 'a11-prime)
+;;                   ;(logic.pequal 'a12 'a12-prime)
+;;                   ;(logic.pequal 'a13 'a13-prime)
+;;                   ;(logic.pequal 'a14 'a14-prime)
+;;                   ;(logic.pequal 'a15 'a15-prime)
+;;                   ;(logic.pequal 'a16 'a16-prime)
+;;                   ;(logic.pequal 'a17 'a17-prime)
+;;                   ;(logic.pequal 'a18 'a18-prime)
+;;                   ;(logic.pequal 'a19 'a19-prime)
+;;                   ;(logic.pequal 'a20 'a20-prime)
+;;                   ;(logic.pequal 'a21 'a21-prime)
+;;                   ;(logic.pequal 'a22 'a22-prime)
+;;                   ;(logic.pequal 'a23 'a23-prime)
+;;                   ;(logic.pequal 'a24 'a24-prime)
+;;                   ;(logic.pequal 'a25 'a25-prime)
+;;                   ;(logic.pequal 'a26 'a26-prime)
+;;                   ;(logic.pequal 'a27 'a27-prime)
+;;                   ;(logic.pequal 'a28 'a28-prime)
+;;                   ;(logic.pequal 'a29 'a29-prime)
+;;                   ;(logic.pequal 'a30 'a30-prime)
+;;                   ))
+;;        (axiom  (build.axiom (logic.disjoin-formulas formulas)))
+;;        (proof1 (build.generic-subset formulas (rev formulas) axiom))
+;;        (proof2 (build.rev-disjunction formulas axiom)))
+;;   (list (list 'OK (equal (logic.conclusion proof1)
+;;                          (logic.conclusion proof2)))
+;;         (list 'generic-rank (rank proof1))
+;;         (list 'rev-rank (rank proof2))))
+
+
+
+
+
+
+;; We now introduce the ordered subset bldr, which is more efficient than the
+;; generic builder when applied to large, ordered subsets (such as are obtained
+;; by applying remove-duplicates or remove-all to a list).  Note that for small
+;; lists, the generic builder is actually better.
+;;
+;;   n     generic-subset       ordered-subset       savings
+;; ----------------------------------------------------------------
+;;    1              64                 818           Lose
+;;    2             523               6,626           Lose
+;;    3           8,557              17,378           Lose
+;;    4          25,380              33,074           Lose
+;;    5          53,714              55,555           Lose
+;;    6         103,552              79,298           23%
+;;   10         579,540             231,074           60%
+;;   15       2,306,725             532,034           77%
+;;   20       6,263,860             956,594           85%
+;;
+;; Note that our test data comes from the experiment shown at the end of this
+;; section.
+
+(defund@ build.ordered-subset-aux (sub sup done proof)
+  ;; Derive [bm,...,b1,d1,...,dk] from [d1,...,dk] v [a1,...,an]
+  ;; where [a1,...,an] is an ordered subset of [b1,...,bm]
+  (declare (xargs :guard (and (logic.formula-listp sup)
+                              (ordered-subsetp sub sup)
+                              (logic.formula-listp done)
+                              (or (consp sub) (consp done))
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (cond ((and (consp sub) (consp done))
+                                            (logic.por (logic.disjoin-formulas done)
+                                                       (logic.disjoin-formulas sub)))
+                                           ((consp sub)
+                                            (logic.disjoin-formulas sub))
+                                           (t
+                                            (logic.disjoin-formulas done)))))
+                  :verify-guards nil
+                  :measure (+ (rank sub) (rank sup))))
+  (@extend ((formula (car sub) A1)
+            (formula (car sup) B1))
+    (cond ((and (consp sub)
+                (consp sup))
+           (if (consp done)
+               (if (equal (@formula A1) (@formula B1))
+                   (if (consp (cdr sub))
+                       (@derive
+                        ;; Case 1: [a1,a2...], [b1=a1,...], [d1,...]
+                        ;; Step Goal: [a1,d1,...,dk] v [a2,...,an]
+                        ((v D1-Dk (v A1 A2-An))  (@given proof))
+                        ((v D1-Dk (v A2-An A1))  (build.disjoined-commute-or @-))
+                        ((v (v D1-Dk A2-An) A1)  (build.associativity @-))
+                        ((v A1 (v D1-Dk A2-An))  (build.commute-or @-))
+                        ((v (v A1 D1-Dk) A2-An)  (build.associativity @-))
+                        ((v Bm-B1 D1-Dk)         (build.ordered-subset-aux (cdr sub) (cdr sup) (cons (car sup) done) @-)))
+                     (@derive
+                      ;; Case 2: [a1], [b1=a1,...], [d1,...]
+                      ;; Step Goal: [a1,d1,...,dk]
+                      ((v D1-Dk A1)     (@given proof))
+                      ((v A1 D1-Dk)     (build.commute-or @-))
+                      ((v Bm-B1 D1-Dk)  (build.ordered-subset-aux (cdr sub) (cdr sup) (cons (car sup) done) @-))))
+                 ;; Case 3: [a1,...], [b1!=a1,...], [d1,...]
+                 ;; Step Goal: [b1,d1,...,dk] v [a1,...,an]
+                 (@derive
+                  ((v D1-Dk A1-An)         (@given proof))
+                  ((v B1 (v D1-Dk A1-An))  (build.expansion (@formula B1) @-))
+                  ((v (v B1 D1-Dk) A1-An)  (build.associativity @-))
+                  ((v Bm-B1 D1-Dk)         (build.ordered-subset-aux sub (cdr sup) (cons (car sup) done) @-))))
+             (if (equal (@formula A1) (@formula B1))
+                 ;; Case 4: [a1,...], [b1=a1,...], done = empty
+                 ;; Step Goal: a1..n
+                 (@derive
+                  (A1-An  (@given proof))
+                  (Bm-B1  (build.ordered-subset-aux (cdr sub) (cdr sup) (cons (car sup) done) @-)))
+               ;; Case 5: [a1,...], [b1!=a1,...], done = empty
+               ;; Step Goal: b1 v (a1..n)
+               (@derive
+                (A1-An         (@given proof))
+                ((v B1 A1-An)  (build.expansion (@formula B1) @-))
+                (Bm-B1         (build.ordered-subset-aux sub (cdr sup) (cons (car sup) done) @-))))))
+          ((consp sup)
+           ;; Case 6: sub = empty, [b1,...], done = [d1,...]  (done is nonempty via our guard)
+           ;; Step Goal: [b1,d1,...,dk]
+           (@derive
+            (D1-Dk            (@given proof))
+            ((v B1 D1-Dk)     (build.expansion (@formula B1) @-))
+            ((v Bm-B1 D1-Dk)  (build.ordered-subset-aux sub (cdr sup) (cons (car sup) done) @-))))
+          (t
+           ;; Case 7: sup = empty
+           (logic.appeal-identity proof)))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.ordered-subset-aux)))
+
+ (defthm build.ordered-subset-aux-under-iff
+   (iff (build.ordered-subset-aux sub sup done proof)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.ordered-subset-aux
+   (implies (force (and (logic.formula-listp sup)
+                        (ordered-subsetp sub sup)
+                        (logic.formula-listp done)
+                        (or (consp sub) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp sub) (consp done))
+                                      (logic.por (logic.disjoin-formulas done)
+                                                 (logic.disjoin-formulas sub)))
+                                     ((consp sub)
+                                      (logic.disjoin-formulas sub))
+                                     (t
+                                      (logic.disjoin-formulas done))))))
+            (equal (logic.appealp (build.ordered-subset-aux sub sup done proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.ordered-subset-aux
+   (implies (force (and (logic.formula-listp sup)
+                        (ordered-subsetp sub sup)
+                        (logic.formula-listp done)
+                        (or (consp sub) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp sub) (consp done))
+                                      (logic.por (logic.disjoin-formulas done)
+                                                 (logic.disjoin-formulas sub)))
+                                     ((consp sub)
+                                      (logic.disjoin-formulas sub))
+                                     (t
+                                      (logic.disjoin-formulas done))))))
+            (equal (logic.conclusion (build.ordered-subset-aux sub sup done proof))
+                   (logic.disjoin-formulas (app (rev sup) done)))))
+
+ (verify-guards build.ordered-subset-aux)
+
+ (defthm forcing-logic.proofp-of-build.ordered-subset-aux
+   (implies (force (and (logic.formula-listp sup)
+                        (ordered-subsetp sub sup)
+                        (logic.formula-listp done)
+                        (or (consp sub) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp sub) (consp done))
+                                      (logic.por (logic.disjoin-formulas done)
+                                                 (logic.disjoin-formulas sub)))
+                                     ((consp sub)
+                                      (logic.disjoin-formulas sub))
+                                     (t
+                                      (logic.disjoin-formulas done))))
+                        ;; ---
+                        (logic.formula-list-atblp sup atbl)
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.ordered-subset-aux sub sup done proof) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.ordered-subset (sub sup proof)
+  (declare (xargs :guard (and (logic.formula-listp sup)
+                              (logic.appealp proof)
+                              (consp sub)
+                              (ordered-subsetp sub sup)
+                              (equal (logic.conclusion proof) (logic.disjoin-formulas sub)))))
+  (build.rev-disjunction (fast-rev sup)
+                         (build.ordered-subset-aux sub sup nil proof)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.ordered-subset)))
+
+ (defthm build.ordered-subset-under-iff
+   (iff (build.ordered-subset sub sup proof)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.ordered-subset
+   (implies (force (and (logic.formula-listp sup)
+                        (logic.appealp proof)
+                        (consp sub)
+                        (ordered-subsetp sub sup)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas sub))))
+            (equal (logic.appealp (build.ordered-subset sub sup proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.ordered-subset
+   (implies (force (and (logic.formula-listp sup)
+                        (logic.appealp proof)
+                        (consp sub)
+                        (ordered-subsetp sub sup)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas sub))))
+            (equal (logic.conclusion (build.ordered-subset sub sup proof))
+                   (logic.disjoin-formulas sup))))
+
+ (defthm forcing-logic.proofp-of-build.ordered-subset
+   (implies (force (and (logic.formula-listp sup)
+                        (logic.appealp proof)
+                        (consp sub)
+                        (ordered-subsetp sub sup)
+                        (equal (logic.conclusion proof) (logic.disjoin-formulas sub))
+                        ;; ---
+                        (logic.formula-list-atblp sup atbl)
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.ordered-subset sub sup proof) axioms thms atbl)
+                   t))))
+
+
+
+
+;; Test data for the build.ordered-subset was taken from running this let*
+;; expression with the appropriate lines commented out.
+
+;; (let* ((sub (list
+;;              (logic.pequal 'a1 'a1-prime)
+;;              (logic.pequal 'a2 'a2-prime)
+;;              (logic.pequal 'a3 'a3-prime)
+;;              (logic.pequal 'a4 'a4-prime)
+;;              (logic.pequal 'a5 'a5-prime)
+;;              (logic.pequal 'a6 'a6-prime)
+;;              (logic.pequal 'a7 'a7-prime)
+;;              (logic.pequal 'a8 'a8-prime)
+;;              (logic.pequal 'a9 'a9-prime)
+;;              (logic.pequal 'a10 'a10-prime)
+;;              (logic.pequal 'a11 'a11-prime)
+;;              (logic.pequal 'a12 'a12-prime)
+;;              (logic.pequal 'a13 'a13-prime)
+;;              (logic.pequal 'a14 'a14-prime)
+;;              (logic.pequal 'a15 'a15-prime)
+;;              (logic.pequal 'a16 'a16-prime)
+;;              (logic.pequal 'a17 'a17-prime)
+;;              (logic.pequal 'a18 'a18-prime)
+;;              (logic.pequal 'a19 'a19-prime)
+;;              (logic.pequal 'a20 'a20-prime)
+;;              ))
+;;        (sup (list
+;;              (logic.pequal 'c1 'c1-prime)
+;;              (logic.pequal 'a1 'a1-prime)
+;;              (logic.pequal 'b1 'b1-prime)
+;;              (logic.pequal 'c2 'c2-prime)
+;;              (logic.pequal 'a2 'a2-prime)
+;;              (logic.pequal 'b2 'b2-prime)
+;;              (logic.pequal 'c3 'c3-prime)
+;;              (logic.pequal 'a3 'a3-prime)
+;;              (logic.pequal 'b3 'b3-prime)
+;;              (logic.pequal 'c4 'c4-prime)
+;;              (logic.pequal 'a4 'a4-prime)
+;;              (logic.pequal 'b4 'b4-prime)
+;;              (logic.pequal 'c5 'c5-prime)
+;;              (logic.pequal 'a5 'a5-prime)
+;;              (logic.pequal 'b5 'b5-prime)
+;;              (logic.pequal 'c6 'c6-prime)
+;;              (logic.pequal 'a6 'a6-prime)
+;;              (logic.pequal 'b6 'b6-prime)
+;;              (logic.pequal 'c7 'c7-prime)
+;;              (logic.pequal 'a7 'a7-prime)
+;;              (logic.pequal 'b7 'b7-prime)
+;;              (logic.pequal 'c8 'c8-prime)
+;;              (logic.pequal 'a8 'a8-prime)
+;;              (logic.pequal 'b8 'b8-prime)
+;;              (logic.pequal 'c9 'c9-prime)
+;;              (logic.pequal 'a9 'a9-prime)
+;;              (logic.pequal 'b9 'b9-prime)
+;;              (logic.pequal 'c10 'c10-prime)
+;;              (logic.pequal 'a10 'a10-prime)
+;;              (logic.pequal 'b10 'b10-prime)
+;;              (logic.pequal 'c11 'c11-prime)
+;;              (logic.pequal 'a11 'a11-prime)
+;;              (logic.pequal 'b11 'b11-prime)
+;;              (logic.pequal 'c12 'c12-prime)
+;;              (logic.pequal 'a12 'a12-prime)
+;;              (logic.pequal 'b12 'b12-prime)
+;;              (logic.pequal 'c13 'c13-prime)
+;;              (logic.pequal 'a13 'a13-prime)
+;;              (logic.pequal 'b13 'b13-prime)
+;;              (logic.pequal 'c14 'c14-prime)
+;;              (logic.pequal 'a14 'a14-prime)
+;;              (logic.pequal 'b14 'b14-prime)
+;;              (logic.pequal 'c15 'c15-prime)
+;;              (logic.pequal 'a15 'a15-prime)
+;;              (logic.pequal 'b15 'b15-prime)
+;;              (logic.pequal 'c16 'c16-prime)
+;;              (logic.pequal 'a16 'a16-prime)
+;;              (logic.pequal 'b16 'b16-prime)
+;;              (logic.pequal 'c17 'c17-prime)
+;;              (logic.pequal 'a17 'a17-prime)
+;;              (logic.pequal 'b17 'b17-prime)
+;;              (logic.pequal 'c18 'c18-prime)
+;;              (logic.pequal 'a18 'a18-prime)
+;;              (logic.pequal 'b18 'b18-prime)
+;;              (logic.pequal 'c19 'c19-prime)
+;;              (logic.pequal 'a19 'a19-prime)
+;;              (logic.pequal 'b19 'b19-prime)
+;;              (logic.pequal 'c20 'c20-prime)
+;;              (logic.pequal 'a20 'a20-prime)
+;;              (logic.pequal 'b20 'b20-prime)
+;;              ))
+;;        (proof (build.axiom (logic.disjoin-formulas sub)))
+;;        (oproof (build.ordered-subset sub sup proof))
+;;        (sproof (build.generic-subset sub sup proof)))
+;;   (list
+;;    (list 'ok (equal (logic.conclusion oproof) (logic.conclusion sproof)))
+;;    (list 'rank-o (rank oproof))
+;;    (list 'rank-s (rank sproof))))
+
+
+
+
+;; Finally we introduce our "adaptive" builder.  We check for certain common
+;; cases.
+
+(defund build.disjoined-subset (as bs proof)
+  (declare (xargs :guard (and (logic.formula-listp bs)
+                              (subsetp as bs)
+                              (logic.appealp proof)
+                              (consp as)
+                              (equal (logic.conclusion proof)
+                                     (logic.disjoin-formulas as)))
+                  :export (build.generic-subset as bs proof)))
+  (cond ((equal bs as)
+         ;; The best case: we can just reuse the proof verbatim.
+         (logic.appeal-identity proof))
+        ((equal bs (fast-rev as))
+         ;; Another good case, we can use our reversal builder.
+         (build.rev-disjunction as proof))
+        ((ordered-subsetp as bs)
+         ;; Here we may be able to optimize.  As a heuristic, if there are more
+         ;; than 5 members in the subset or more than 10 in the superset, we
+         ;; just use the ordered builder since the generic builder is probably
+         ;; not as efficient.  Otherwise, we'll try both builders and just use
+         ;; whichever proof turns out to be smaller.
+         (if (or (< 5 (len as))
+                 (< 10 (len bs)))
+             (build.ordered-subset as bs proof)
+           (let* ((proof1 (build.generic-subset as bs proof))
+                  (proof2 (build.ordered-subset as bs proof))
+                  (rank1  (rank proof1))
+                  (rank2  (rank proof2)))
+             (ACL2::prog2$
+              (ACL2::cw "BDJS n,m,generic,ord = ~x0, ~x1, ~x2, ~x3~%"
+                  (len as) (len bs) rank1 rank2)
+              (if (< (rank proof1) (rank proof2))
+                  proof1
+                proof2)))))
+        (t
+         ;; If we get here, we have no special tricks to use.  We fall back to
+         ;; using the generic subset builder.
+         (build.generic-subset as bs proof))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-subset)))
+
+ (defthm build.disjoined-subset-under-iff
+   (iff (build.disjoined-subset as bs proof)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.disjoined-subset
+   (implies (force (and (logic.formula-listp bs)
+                        (subsetp as bs)
+                        (logic.appealp proof)
+                        (consp as)
+                        (equal (logic.conclusion proof)
+                               (logic.disjoin-formulas as))))
+            (equal (logic.appealp (build.disjoined-subset as bs proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-subset
+   (implies (force (and (logic.formula-listp bs)
+                        (subsetp as bs)
+                        (logic.appealp proof)
+                        (consp as)
+                        (equal (logic.conclusion proof)
+                               (logic.disjoin-formulas as))))
+            (equal (logic.conclusion (build.disjoined-subset as bs proof))
+                   (logic.disjoin-formulas bs)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proofp-of-build.disjoined-subset
+   (implies (force (and (logic.formula-listp bs)
+                        (subsetp as bs)
+                        (logic.appealp proof)
+                        (consp as)
+                        (equal (logic.conclusion proof)
+                               (logic.disjoin-formulas as))
+                        ;; ---
+                        (logic.formula-list-atblp bs atbl)
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (build.disjoined-subset as bs proof) axioms thms atbl)
+                   t))))
+
+
+
+
+;; We can now also talk about building a lists of proofs X1,...,Xn from another
+;; list of proofs Y1,...,Ym, where "each Xi is a superset of some Yi".
+
+(defund build.all-superset-of-some (x y proofs)
+  (declare (xargs :guard (and (logic.formula-list-listp x)
+                              (logic.formula-list-listp y)
+                              (cons-listp y)
+                              (all-superset-of-somep x y)
+                              (logic.appeal-listp proofs)
+                              (subsetp (logic.disjoin-each-formula-list y)
+                                       (logic.strip-conclusions proofs)))))
+  (if (consp x)
+      (let* ((subset (find-subset (car x) y))
+             (proof  (logic.find-proof (logic.disjoin-formulas subset) proofs)))
+        ;; Proof is now a proof of subset, which is a subset of (car x).
+        ;; We can just expand the proof to get a proof of (car x).
+        (cons (build.disjoined-subset subset (car x) proof)
+              (build.all-superset-of-some (cdr x) y proofs)))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.all-superset-of-some)))
+
+ (defthm forcing-logic.appeal-listp-of-build.all-superset-of-some
+   (implies (force (and (logic.formula-list-listp x)
+                        (logic.formula-list-listp y)
+                        (cons-listp y)
+                        (all-superset-of-somep x y)
+                        (logic.appeal-listp proofs)
+                        (subsetp (logic.disjoin-each-formula-list y)
+                                 (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (build.all-superset-of-some x y proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-build.all-superset-of-some
+   (implies (force (and (logic.formula-list-listp x)
+                        (logic.formula-list-listp y)
+                        (cons-listp y)
+                        (all-superset-of-somep x y)
+                        (logic.appeal-listp proofs)
+                        (subsetp (logic.disjoin-each-formula-list y)
+                                 (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (build.all-superset-of-some x y proofs))
+                   (logic.disjoin-each-formula-list x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proof-listp-of-build.all-superset-of-some
+   (implies (force (and (logic.formula-list-listp x)
+                        (logic.formula-list-listp y)
+                        (cons-listp y)
+                        (all-superset-of-somep x y)
+                        (logic.appeal-listp proofs)
+                        (subsetp (logic.disjoin-each-formula-list y)
+                                 (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.formula-list-list-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)))
+            (equal (logic.proof-listp (build.all-superset-of-some x y proofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.generic-subset-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'build.generic-subset)
+         (equal (len subproofs) 1)
+         (tuplep 2 extras)
+         (let ((as (first extras))
+               (bs (second extras)))
+           (and (logic.formula-listp bs)
+                (logic.formula-list-atblp bs atbl)
+                (subsetp as bs)
+                (consp as)
+                (equal conclusion (logic.disjoin-formulas bs))
+                (equal (logic.conclusion (first subproofs))
+                       (logic.disjoin-formulas as)))))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.generic-subset-okp)))
+
+ (defthm booleanp-of-build.generic-subset-okp
+   (equal (booleanp (build.generic-subset-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable forcing-true-listp-of-logic.subproofs))))
+
+ (defthm build.generic-subset-okp-of-logic.appeal-identity
+   (equal (build.generic-subset-okp (logic.appeal-identity x) atbl)
+          (build.generic-subset-okp x atbl))
+   :hints(("goal" :in-theory (disable forcing-true-listp-of-logic.subproofs))))
+
+ (defthm forcing-soundness-of-build.generic-subset-okp
+   (implies (and (build.generic-subset-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (build.generic-subset
+                                 (first (logic.extras x))
+                                 (second (logic.extras x))
+                                 (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                                         axioms thms atbl)))))))))
+
+
+
+(dd.close)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/build/equal.lisp acl2-6.3/books/milawa/ACL2/build/equal.lisp
--- acl2-6.2/books/milawa/ACL2/build/equal.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/equal.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1499 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lambda")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(dd.open "equal.tex")
+
+(dd.section "Equal manipulation")
+
+
+(deftheorem theorem-reflexivity-of-equal
+  :derive (= (equal x x) t)
+  :proof  (@derive ((v (!= x y) (= (equal x y) t))                                    (build.axiom (axiom-equal-when-same)))
+                   ((v (!= x x) (= (equal x x) t))                                    (build.instantiation @- (@sigma (y . x))))
+                   ((= x x)                                                           (build.reflexivity (@term x)))
+                   ((= (equal x x) t)                                                 (build.modus-ponens @- @--)))
+  :minatbl ((equal . 2)))
+
+(defderiv build.equal-reflexivity
+  :derive (= (equal (? a) (? a)) t)
+  :from   ((term a (? a)))
+  :proof  (@derive ((= (equal x x) t)                                                 (build.theorem (theorem-reflexivity-of-equal)))
+                   ((= (equal (? a) (? a)) t)                                         (build.instantiation @- (@sigma (x . (? a))))))
+  :minatbl ((equal . 2)))
+
+
+
+(deftheorem theorem-equal-nil-or-t
+  :derive (v (= (equal x y) nil)
+             (= (equal x y) t))
+  :proof  (@derive ((v (= x y) (= (equal x y) nil))                                   (build.axiom (axiom-equal-when-diff)))
+                   ((v (!= x y) (= (equal x y) t))                                    (build.axiom (axiom-equal-when-same)))
+                   ((v (= (equal x y) nil) (= (equal x y) t))                         (build.cut @-- @-)))
+  :minatbl ((equal . 2)))
+
+(defderiv build.equal-t-from-not-nil
+  :derive (= (equal (? a) (? b)) t)
+  :from   ((proof x (!= (equal (? a) (? b)) nil)))
+  :proof  (@derive ((v (= (equal x y) nil) (= (equal x y) t))                         (build.theorem (theorem-equal-nil-or-t)))
+                   ((v (= (equal (? a) (? b)) nil) (= (equal (? a) (? b)) t))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                   ((!= (equal (? a) (? b)) nil)                                      (@given x))
+                   ((= (equal (? a) (? b)) t)                                         (build.modus-ponens-2 @- @--))))
+
+(defderiv build.disjoined-equal-t-from-not-nil
+  :derive (v P (= (equal (? a) (? b)) t))
+  :from   ((proof x (v P (!= (equal (? a) (? b)) nil))))
+  :proof  (@derive ((v (= (equal x y) nil) (= (equal x y) t))                         (build.theorem (theorem-equal-nil-or-t)))
+                   ((v (= (equal (? a) (? b)) nil) (= (equal (? a) (? b)) t))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                   ((v P (v (= (equal (? a) (? b)) nil) (= (equal (? a) (? b)) t)))   (build.expansion (@formula P) @-))
+                   ((v P (!= (equal (? a) (? b)) nil))                                (@given x))
+                   ((v P (= (equal (? a) (? b)) t))                                   (build.disjoined-modus-ponens-2 @- @--))))
+
+(defderiv build.equal-nil-from-not-t
+  :derive (= (equal (? a) (? b)) nil)
+  :from   ((proof x (!= (equal (? a) (? b)) t)))
+  :proof  (@derive ((v (= (equal x y) nil) (= (equal x y) t))                         (build.theorem (theorem-equal-nil-or-t)))
+                   ((v (= (equal x y) t) (= (equal x y) nil))                         (build.commute-or @-))
+                   ((v (= (equal (? a) (? b)) t) (= (equal (? a) (? b)) nil))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                   ((!= (equal (? a) (? b)) t)                                        (@given x))
+                   ((= (equal (? a) (? b)) nil)                                       (build.modus-ponens-2 @- @--))))
+
+(defderiv build.disjoined-equal-nil-from-not-t
+  :derive (v P (= (equal (? a) (? b)) nil))
+  :from   ((proof x (v P (!= (equal (? a) (? b)) t))))
+  :proof  (@derive ((v (= (equal x y) nil) (= (equal x y) t))                         (build.theorem (theorem-equal-nil-or-t)))
+                   ((v (= (equal x y) t) (= (equal x y) nil))                         (build.commute-or @-))
+                   ((v (= (equal (? a) (? b)) t) (= (equal (? a) (? b)) nil))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                   ((v P (v (= (equal (? a) (? b)) t) (= (equal (? a) (? b)) nil)))   (build.expansion (@formula P) @-))
+                   ((v P (!= (equal (? a) (? b)) t))                                  (@given x))
+                   ((v P (= (equal (? a) (? b)) nil))                                 (build.disjoined-modus-ponens-2 @- @--))))
+
+(defderiv build.equal-from-pequal
+ :derive (= (equal (? a) (? b)) t)
+ :from   ((proof x (= (? a) (? b))))
+ :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                ;; Optimization.  We can just use reflexivity.
+                (@derive ((= (equal (? a) (? b)) t)                               (build.equal-reflexivity (@term (? a))))))
+               (t
+                (@derive ((v (!= x y) (= (equal x y) t))                          (build.axiom (axiom-equal-when-same)))
+                         ((v (!= (? a) (? b)) (= (equal (? a) (? b)) t))          (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                         ((= (? a) (? b))                                         (@given x))
+                         ((= (equal (? a) (? b)) t)                               (build.modus-ponens @- @--)))))
+ :minatbl ((equal . 2))
+ :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                         (build.equal-reflexivity (@term (? a)))
+                       (LOGIC.APPEAL 'BUILD.EQUAL-FROM-PEQUAL
+                                     (@FORMULA (= (EQUAL (? A) (? B)) T))
+                                     (LIST X)
+                                     NIL)))
+
+(defderiv build.disjoined-equal-from-pequal
+  :derive (v P (= (equal (? a) (? b)) t))
+  :from   ((proof x (v P (= (? a) (? b)))))
+  :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use reflexivity and expansion.
+                 (@derive ((= (equal (? a) (? b)) t)                              (build.equal-reflexivity (@term (? a))))
+                          ((v P (= (equal (? a) (? b)) t))                        (build.expansion (@formula P) @-))))
+                (t
+                 (@derive ((v (!= x y) (= (equal x y) t))                         (build.axiom (axiom-equal-when-same)))
+                          ((v (!= (? a) (? b)) (= (equal (? a) (? b)) t))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                          ((v P (v (!= (? a) (? b)) (= (equal (? a) (? b)) t)))   (build.expansion (@formula P) @-))
+                          ((v P (= (? a) (? b)))                                  (@given x))
+                          ((v P (= (equal (? a) (? b)) t))                        (build.disjoined-modus-ponens @- @--)))))
+  :minatbl ((equal . 2))
+  :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                          (@derive ((= (equal (? a) (? b)) t)         (build.equal-reflexivity (@term (? a))))
+                                   ((v P (= (equal (? a) (? b)) t))   (build.expansion (@formula P) @-)))
+                        (LOGIC.APPEAL 'BUILD.DISJOINED-EQUAL-FROM-PEQUAL
+                                      (@FORMULA (V P (= (EQUAL (? A) (? B)) T)))
+                                      (LIST X)
+                                      NIL)))
+
+(defderiv build.not-pequal-from-not-equal
+ :derive (!= (? a) (? b))
+ :from   ((proof x (= (equal (? a) (? b)) nil)))
+ :proof  (@derive ((v (!= x y) (= (equal x y) t))                                 (build.axiom (axiom-equal-when-same)))
+                  ((v (= (equal x y) t) (!= x y))                                 (build.commute-or @-))
+                  ((v (= (equal (? a) (? b)) t) (!= (? a) (? b)))                 (build.instantiation @- (@sigma (x . (? a)) (y . (? b))))  *1)
+                  ((= (equal (? a) (? b)) nil)                                    (@given x))
+                  ((!= (equal (? a) (? b)) t)                                     (build.not-t-from-nil @-))
+                  ((!= (? a) (? b))                                               (build.modus-ponens-2 @- *1))))
+
+(defderiv build.disjoined-not-pequal-from-not-equal
+ :derive (v P (!= (? a) (? b)))
+ :from   ((proof x (v P (= (equal (? a) (? b)) nil))))
+ :proof  (@derive ((v (!= x y) (= (equal x y) t))                                 (build.axiom (axiom-equal-when-same)))
+                  ((v (= (equal x y) t) (!= x y))                                 (build.commute-or @-))
+                  ((v (= (equal (? a) (? b)) t) (!= (? a) (? b)))                 (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                  ((v P (v (= (equal (? a) (? b)) t) (!= (? a) (? b))))           (build.expansion (@formula P) @-)                           *1)
+                  ((v P (= (equal (? a) (? b)) nil))                              (@given x))
+                  ((v P (!= (equal (? a) (? b)) t))                               (build.disjoined-not-t-from-nil @-))
+                  ((v P (!= (? a) (? b)))                                         (build.disjoined-modus-ponens-2 @- *1))))
+
+
+
+(deftheorem theorem-symmetry-of-equal
+  :derive (= (equal x y) (equal y x))
+  :proof  (@derive ((v (= x y) (= (equal x y) nil))           (build.axiom (axiom-equal-when-diff)) *1)
+                   ((v (= y x) (= (equal y x) nil))           (build.instantiation @- (@sigma (x . y) (y . x))))
+                   ((v (= y x) (= nil (equal y x)))           (build.disjoined-commute-pequal @-))
+                   ((v (= nil (equal y x)) (= y x))           (build.commute-or @-))
+                   ((v (= nil (equal y x)) (= x y))           (build.disjoined-commute-pequal @-))
+                   ((v (= x y) (= nil (equal y x)))           (build.commute-or @-))
+                   ((v (= x y) (= (equal x y) (equal y x)))   (build.disjoined-transitivity-of-pequal *1 @-) *2)
+                   ;; ---
+                   ((v (!= x y) (= (equal x y) t))            (build.axiom (axiom-equal-when-same)) *3)
+                   ((v (!= y x) (= (equal y x) t))            (build.instantiation @- (@sigma (x . y) (y . x))))
+                   ((v (!= y x) (= t (equal y x)))            (build.disjoined-commute-pequal @-))
+                   ((v (= t (equal y x)) (!= y x))            (build.commute-or @-))
+                   ((v (= t (equal y x)) (!= x y))            (build.disjoined-commute-not-pequal @-))
+                   ((v (!= x y) (= t (equal y x)))            (build.commute-or @-))
+                   ((v (!= x y) (= (equal x y) (equal y x)))  (build.disjoined-transitivity-of-pequal *3 @-) *4)
+                   ;; ---
+                   ((v (= (equal x y) (equal y x))
+                       (= (equal x y) (equal y x)))           (build.cut *2 *4))
+                   ((= (equal x y) (equal y x))               (build.contraction @-)))
+  :minatbl ((equal . 2)))
+
+(defderiv build.commute-equal
+  :derive (= (equal (? b) (? a)) t)
+  :from   ((proof x (= (equal (? a) (? b)) t)))
+  :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimziation.  Just use reflexivity.
+                 (@derive ((= (equal (? b) (? a)) t)                           (build.equal-reflexivity (@term (? a))))))
+                (t
+                 (@derive ((= (equal x y) (equal y x))                         (build.theorem (theorem-symmetry-of-equal)))
+                          ((= (equal (? b) (? a)) (equal (? a) (? b)))         (build.instantiation @- (@sigma (x . (? b)) (y . (? a)))))
+                          ((= (equal (? a) (? b)) t)                           (@given x))
+                          ((= (equal (? b) (? a)) t)                           (build.transitivity-of-pequal @-- @-)))))
+  :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                          (build.equal-reflexivity (@term (? a)))
+                        (LOGIC.APPEAL 'BUILD.COMMUTE-EQUAL
+                                      (@FORMULA (= (EQUAL (? B) (? A)) T))
+                                      (LIST X)
+                                      NIL)))
+
+(defderiv build.disjoined-commute-equal
+  :derive (v P (= (equal (? b) (? a)) t))
+  :from   ((proof x (v P (= (equal (? a) (? b)) t))))
+  :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use reflexivity and expansion.
+                 (@derive ((= (equal (? b) (? a)) t)                           (build.equal-reflexivity (@term (? a))))
+                          ((v P (= (equal (? b) (? a)) t))                     (build.expansion (@formula P) @-))))
+                (t
+                 (@derive ((= (equal x y) (equal y x))                         (build.theorem (theorem-symmetry-of-equal)))
+                          ((= (equal (? b) (? a)) (equal (? a) (? b)))         (build.instantiation @- (@sigma (x . (? b)) (y . (? a)))))
+                          ((v P (= (equal (? b) (? a)) (equal (? a) (? b))))   (build.expansion (@formula P) @-))
+                          ((v P (= (equal (? a) (? b)) t))                     (@given x))
+                          ((v P (= (equal (? b) (? a)) t))                     (build.disjoined-transitivity-of-pequal @-- @-)))))
+  :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                          (@derive ((= (equal (? b) (? a)) t)          (build.equal-reflexivity (@term (? a))))
+                                   ((v P (= (equal (? b) (? a)) t))    (build.expansion (@formula P) @-)))
+                        (LOGIC.APPEAL 'BUILD.DISJOINED-COMMUTE-EQUAL
+                                      (@FORMULA (V P (= (EQUAL (? B) (? A)) T)))
+                                      (LIST X)
+                                      NIL)))
+
+
+(deftheorem theorem-transitivity-of-equal
+  :derive (v (!= (equal x y) t)
+             (v (!= (equal y z) t)
+                (= (equal x z) t)))
+  :proof  (@derive
+           ((v (= x y) (= (equal x y) nil))                          (build.axiom (axiom-equal-when-diff)))
+           ((v (= x y) (!= (equal x y) t))                           (build.disjoined-not-t-from-nil @-)                   *1)
+
+           ((v (!= (equal y z) t) (v (= x y) (!= (equal x y) t)))    (build.expansion (@formula (!= (equal y z) t)) @-))
+           ((v (v (!= (equal y z) t) (= x y)) (!= (equal x y) t))    (build.associativity @-))
+           ((v (!= (equal x y) t) (v (!= (equal y z) t) (= x y)))    (build.commute-or @-))
+           ((v (v (!= (equal x y) t) (!= (equal y z) t)) (= x y))    (build.associativity @-)                                *2)
+
+           ((v (= y z) (!= (equal y z) t))                           (build.instantiation *1 (@sigma (x . y) (y . z))))
+           ((v (!= (equal y z) t) (= y z))                           (build.commute-or @-))
+           ((v (!= (equal x y) t) (v (!= (equal y z) t) (= y z)))    (build.expansion (@formula (!= (equal x y) t)) @-))
+           ((v (v (!= (equal x y) t) (!= (equal y z) t)) (= y z))    (build.associativity @-))
+           ((v (v (!= (equal x y) t) (!= (equal y z) t)) (= x z))    (build.disjoined-transitivity-of-pequal *2 @-)          *3)
+
+           ((v (v (!= (equal x y) t) (!= (equal y z) t))
+               (= (equal x z) t))                                    (build.disjoined-equal-from-pequal @-))
+           ((v (!= (equal x y) t)
+               (v (!= (equal y z) t)
+                  (= (equal x z) t)))                                (build.right-associativity @-)))
+  :minatbl ((equal . 2)))
+
+(defderiv build.transitivity-of-equal
+  :derive (= (equal (? a) (? c)) t)
+  :from   ((proof x (= (equal (? a) (? b)) t))
+           (proof y (= (equal (? b) (? c)) t)))
+  :proof  (cond ((equal (@term (? a)) (@term (? c)))
+                 ;; Optimization.  Just use reflexivity.
+                 (@derive ((= (equal (? a) (? c)) t)     (build.equal-reflexivity (@term (? a))))))
+                ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use the proof of (equal b c) = t.
+                 (logic.appeal-identity y))
+                ((equal (@term (? b)) (@term (? c)))
+                 ;; Optimization.  Just use teh proof of (equal a b) = t.
+                 (logic.appeal-identity x))
+                (t
+                 (@derive ((v (!= (equal x y) t) (v (!= (equal y z) t) (= (equal x z) t)))                           (build.theorem (theorem-transitivity-of-equal)))
+                          ((v (!= (equal (? a) (? b)) t) (v (!= (equal (? b) (? c)) t) (= (equal (? a) (? c)) t)))   (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                          ((= (equal (? a) (? b)) t)                                                                 (@given x))
+                          ((v (!= (equal (? b) (? c)) t) (= (equal (? a) (? c)) t))                                  (build.modus-ponens @- @--))
+                          ((= (equal (? b) (? c)) t)                                                                 (@given y))
+                          ((= (equal (? a) (? c)) t)                                                                 (build.modus-ponens @- @--)))))
+  :highlevel-override (cond ((equal (@term (? a)) (@term (? c)))
+                             (build.equal-reflexivity (@term (? a))))
+                            ((equal (@term (? a)) (@term (? b)))
+                             y)
+                            ((equal (@term (? b)) (@term (? c)))
+                             x)
+                            (t
+                             (LOGIC.APPEAL 'BUILD.TRANSITIVITY-OF-EQUAL
+                                           (@FORMULA (= (EQUAL (? A) (? C)) T))
+                                           (LIST X Y)
+                                           NIL))))
+
+(defderiv build.disjoined-transitivity-of-equal
+  :derive (v P (= (equal (? a) (? c)) t))
+  :from   ((proof x (v P (= (equal (? a) (? b)) t)))
+           (proof y (v P (= (equal (? b) (? c)) t))))
+  :proof  (cond ((equal (@term (? a)) (@term (? c)))
+                 ;; Optimization. Just use reflexivity and expansion.
+                 (@derive ((= (equal (? a) (? c)) t)                                                                         (build.equal-reflexivity (@term (? a))))
+                          ((v P (= (equal (? a) (? c)) t))                                                                   (build.expansion (@formula P) @-))))
+                ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization. Just use the proof of P v b = c.
+                 (logic.appeal-identity y))
+                ((equal (@term (? b)) (@term (? c)))
+                 ;; Optimization.  Just use the proof of P v a = b.
+                 (logic.appeal-identity x))
+                (t
+                 (@derive ((v (!= (equal x y) t) (v (!= (equal y z) t) (= (equal x z) t)))                                 (build.theorem (theorem-transitivity-of-equal)))
+                          ((v (!= (equal (? a) (? b)) t) (v (!= (equal (? b) (? c)) t) (= (equal (? a) (? c)) t)))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                          ((v P (v (!= (equal (? a) (? b)) t) (v (!= (equal (? b) (? c)) t) (= (equal (? a) (? c)) t))))   (build.expansion (@formula P) @-))
+                          ((v P (= (equal (? a) (? b)) t))                                                                 (@given x))
+                          ((v P (v (!= (equal (? b) (? c)) t) (= (equal (? a) (? c)) t)))                                  (build.disjoined-modus-ponens @- @--))
+                          ((v P (= (equal (? b) (? c)) t))                                                                 (@given y))
+                          ((v P (= (equal (? a) (? c)) t))                                                                 (build.disjoined-modus-ponens @- @--)))))
+  :highlevel-override (cond ((equal (@term (? a)) (@term (? c)))
+                             (@derive ((= (equal (? a) (? c)) t)         (build.equal-reflexivity (@term (? a))))
+                                      ((v P (= (equal (? a) (? c)) t))   (build.expansion (@formula P) @-))))
+                            ((equal (@term (? a)) (@term (? b)))
+                             y)
+                            ((equal (@term (? b)) (@term (? c)))
+                             x)
+                            (t
+                             (LOGIC.APPEAL 'BUILD.DISJOINED-TRANSITIVITY-OF-EQUAL
+                                           (@FORMULA (V P (= (EQUAL (? A) (? C)) T)))
+                                           (LIST X Y)
+                                           NIL))))
+
+
+(defderiv build.not-pequal-constants
+  :derive (!= (? c1) (? c2))
+  :from ((term c1 (? c1))
+         (term c2 (? c2)))
+  :where ((logic.constantp (@term (? c1)))
+          (logic.constantp (@term (? c2)))
+          (not (equal (@term (? c1)) (@term (? c2)))))
+  :proof (@derive
+          ((= (equal (? c1) (? c2)) nil)                                          (build.base-eval (@term (equal (? c1) (? c2)))))
+          ((!= (? c1) (? c2))                                                     (build.not-pequal-from-not-equal @-)))
+  :minatbl ((equal . 2)))
+
+(defund build.equal-from-pequal-list (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-atomicp (logic.strip-conclusions x)))))
+  (if (consp x)
+      (cons (build.equal-from-pequal (car x))
+            (build.equal-from-pequal-list (cdr x)))
+    nil))
+
+(defobligations build.equal-from-pequal-list
+  (build.equal-from-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.equal-from-pequal-list)))
+
+ (defthm len-of-build.equal-from-pequal-list
+   (equal (len (build.equal-from-pequal-list x))
+          (len x)))
+
+ (defthm forcing-logic.appeal-listp-of-build.equal-from-pequal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))))
+            (equal (logic.appeal-listp (build.equal-from-pequal-list x))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-build.equal-from-pequal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))))
+            (equal (logic.strip-conclusions (build.equal-from-pequal-list x))
+                   (logic.pequal-list (logic.function-list 'equal (list2-list (logic.=lhses (logic.strip-conclusions x))
+                                                                              (logic.=rhses (logic.strip-conclusions x))))
+                                      (repeat ''t (len x)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-build.equal-from-pequal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        ;; ---
+                        (logic.proof-listp x axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations build.equal-from-pequal-list)))
+            (equal (logic.proof-listp (build.equal-from-pequal-list x) axioms thms atbl)
+                   t))))
+
+
+
+
+
+(defund build.equal-reflexivity-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (cons (build.equal-reflexivity (car x))
+            (build.equal-reflexivity-list (cdr x)))
+    nil))
+
+(defobligations build.equal-reflexivity-list
+  (build.equal-reflexivity))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.equal-reflexivity-list)))
+
+ (defthm len-of-build.equal-reflexivity-list
+   (equal (len (build.equal-reflexivity-list x))
+          (len x)))
+
+ (defthm forcing-logic.appeal-listp-of-build.equal-reflexivity-list
+   (implies (force (logic.term-listp x))
+            (equal (logic.appeal-listp (build.equal-reflexivity-list x))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-build.equal-reflexivity-list
+   (implies (force (logic.term-listp x))
+            (equal (logic.strip-conclusions (build.equal-reflexivity-list x))
+                   (logic.pequal-list (logic.function-list 'equal (list2-list x x))
+                                      (repeat ''t (len x)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-build.equal-reflexivity-list
+   (implies (force (and (logic.term-listp x)
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations build.equal-reflexivity-list)))
+            (equal (logic.proof-listp (build.equal-reflexivity-list x) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.disjoined-equal-from-pequal-list (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-disjunctionsp (logic.strip-conclusions x))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x))))))
+  (if (consp x)
+      (cons (build.disjoined-equal-from-pequal (car x))
+            (build.disjoined-equal-from-pequal-list (cdr x)))
+    nil))
+
+(defobligations build.disjoined-equal-from-pequal-list
+  (build.disjoined-equal-from-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-equal-from-pequal-list)))
+
+ (defthm len-of-build.disjoined-equal-from-pequal-list
+   (equal (len (build.disjoined-equal-from-pequal-list x))
+          (len x)))
+
+ (defthm forcing-logic.appeal-listp-of-build.disjoined-equal-from-pequal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))))
+            (equal (logic.appeal-listp (build.disjoined-equal-from-pequal-list x))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-build.disjoined-equal-from-pequal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))))
+            (equal (logic.strip-conclusions (build.disjoined-equal-from-pequal-list x))
+                   (logic.por-list (logic.vlhses (logic.strip-conclusions x))
+                                   (logic.pequal-list
+                                    (logic.function-list 'equal (list2-list (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))
+                                                                            (logic.=rhses (logic.vrhses (logic.strip-conclusions x)))))
+                                    (repeat ''t (len x))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-build.disjoined-equal-from-pequal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        ;; ---
+                        (logic.proof-listp x axioms thms atbl)
+                        (force (equal (cdr (lookup 'equal atbl)) 2))
+                        (@obligations build.disjoined-equal-from-pequal-list)))
+            (equal (logic.proof-listp (build.disjoined-equal-from-pequal-list x) axioms thms atbl)
+                   t))))
+
+
+(dd.subsection "Special conversion rules")
+
+(defderiv build.pequal-from-equal
+  :derive (= (? a) (? b))
+  :from ((proof x (= (equal (? a) (? b)) t)))
+  :proof (cond ((equal (@term (? a)) (@term (? b)))
+                ;; Optimization.  Just use reflexivity.
+                (@derive ((= (? a) (? b))   (build.reflexivity (@term (? a))))))
+               (t
+                (@derive ((v (= x y) (= (equal x y) nil))                  (build.axiom (axiom-equal-when-diff)))
+                         ((v (= (equal x y) nil) (= x y))                  (build.commute-or @-))
+                         ((v (= (equal (? a) (? b)) nil) (= (? a) (? b)))  (build.instantiation @- (@sigma (x . (? a)) (y . (? b))))  *1)
+                         ((= (equal (? a) (? b)) t)                        (@given x))
+                         ((!= (equal (? a) (? b)) nil)                     (build.not-nil-from-t @-))
+                         ((= (? a) (? b))                                  (build.modus-ponens-2 @- *1)))))
+  :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                          (build.reflexivity (@term (? a)))
+                        (LOGIC.APPEAL 'BUILD.PEQUAL-FROM-EQUAL
+                                      (@FORMULA (= (? A) (? B)))
+                                      (LIST X)
+                                      NIL)))
+
+(defderiv build.disjoined-pequal-from-equal
+ :derive (v P (= (? a) (? b)))
+ :from   ((proof x (v P (= (equal (? a) (? b)) t))))
+ :proof  (@derive ((v (= x y) (= (equal x y) nil))                         (build.axiom (axiom-equal-when-diff)))
+                  ((v (= (equal x y) nil) (= x y))                         (build.commute-or @-))
+                  ((v (= (equal (? a) (? b)) nil) (= (? a) (? b)))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                  ((v P (v (= (equal (? a) (? b)) nil) (= (? a) (? b))))   (build.expansion (@formula P) @-) *1)
+                  ((v P (= (equal (? a) (? b)) t))                         (@given x))
+                  ((v P (!= (equal (? a) (? b)) nil))                      (build.disjoined-not-nil-from-t @-))
+                  ((v P (= (? a) (? b)))                                   (build.disjoined-modus-ponens-2 @- *1))))
+
+(defderiv build.not-equal-from-not-pequal
+ :derive (= (equal (? a) (? b)) nil)
+ :from   ((proof x (!= (? a) (? b))))
+ :proof  (@derive ((v (= x y) (= (equal x y) nil))                  (build.axiom (axiom-equal-when-diff)))
+                  ((v (= (? a) (? b)) (= (equal (? a) (? b)) nil))  (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                  ((!= (? a) (? b))                                 (@given x))
+                  ((= (equal (? a) (? b)) nil)                      (build.modus-ponens-2 @- @--)))
+ :minatbl ((equal . 2)))
+
+(defderiv build.disjoined-not-equal-from-not-pequal
+ :derive (v P (= (equal (? a) (? b)) nil))
+ :from   ((proof x (v P (!= (? a) (? b)))))
+ :proof  (@derive ((v (= x y) (= (equal x y) nil))                        (build.axiom (axiom-equal-when-diff)))
+                  ((v (= (? a) (? b)) (= (equal (? a) (? b)) nil))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                  ((v P (v (= (? a) (? b)) (= (equal (? a) (? b)) nil)))  (build.expansion (@formula P) @-))
+                  ((v P (!= (? a) (? b)))                                 (@given x))
+                  ((v P (= (equal (? a) (? b)) nil))                      (build.disjoined-modus-ponens-2 @- @--)))
+ :minatbl ((equal . 2)))
+
+(deftheorem theorem-equal-of-equal-and-t
+   :derive (= (equal (equal x y) t) (equal x y))
+   :proof (@derive
+           ((v (= x y) (= (equal x y) nil))                               (build.axiom (axiom-equal-when-diff)) *1a)
+           ((v (= x y) (!= (equal x y) t))                                (build.disjoined-not-t-from-nil @-))
+           ((v (= x y) (= (equal (equal x y) t) nil))                     (build.disjoined-not-equal-from-not-pequal @-))
+           ((v (= x y) (= nil (equal x y)))                               (build.disjoined-commute-pequal *1a))
+           ((v (= x y) (= (equal (equal x y) t) (equal x y)))             (build.disjoined-transitivity-of-pequal @-- @-)     *1)
+           ;; ---
+           ((v (!= x y) (= (equal x y) t))                                (build.axiom (axiom-equal-when-same)))
+           ((v (!= x y) (= (equal (equal x y) t) t))                      (build.disjoined-equal-from-pequal @-))
+           ((v (!= x y) (= t (equal x y)))                                (build.disjoined-commute-pequal @--))
+           ((v (!= x y) (= (equal (equal x y) t) (equal x y)))            (build.disjoined-transitivity-of-pequal @-- @-))
+           ;; ---
+           ((v (= (equal (equal x y) t) (equal x y))
+               (= (equal (equal x y) t) (equal x y)))                     (build.cut *1 @-))
+           ((= (equal (equal x y) t) (equal x y))                         (build.contraction @-)))
+   :minatbl ((equal . 2)))
+
+
+
+;; (dd.subsection "Special equal rules")
+
+(defund build.pequal-from-equal-list (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (let ((concs (logic.strip-conclusions x)))
+                                (and (logic.all-atomicp concs)
+                                     (let ((lhses (logic.=lhses concs))
+                                           (rhses (logic.=rhses concs)))
+                                       (and (all-equalp ''t rhses)
+                                            (logic.all-functionsp lhses)
+                                            (all-equalp 'equal (logic.strip-function-names lhses))
+                                            (all-equalp 2 (strip-lens (logic.strip-function-args lhses))))))))))
+  (if (consp x)
+      (cons (build.pequal-from-equal (car x))
+            (build.pequal-from-equal-list (cdr x)))
+    nil))
+
+(defobligations build.pequal-from-equal-list
+  (build.pequal-from-equal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.pequal-from-equal-list)))
+
+ (defthm len-of-build.pequal-from-equal-list
+   (equal (len (build.pequal-from-equal-list x))
+          (len x)))
+
+ (defthm forcing-logic.appeal-listp-of-build.pequal-from-equal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))))
+            (equal (logic.appeal-listp (build.pequal-from-equal-list x))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-build.pequal-from-equal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))))
+            (equal (logic.strip-conclusions (build.pequal-from-equal-list x))
+                   (logic.pequal-list (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x))))
+                                      (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-build.pequal-from-equal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        ;; ---
+                        (logic.proof-listp x axioms thms atbl)
+                        (@obligations build.pequal-from-equal-list)))
+            (equal (logic.proof-listp (build.pequal-from-equal-list x) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.disjoined-pequal-from-equal-list (x)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (let ((concs (logic.strip-conclusions x)))
+                                 (and (logic.all-disjunctionsp concs)
+                                      (let ((equals (logic.vrhses concs)))
+                                        (and (logic.all-atomicp equals)
+                                             (let ((lhses (logic.=lhses equals))
+                                                   (rhses (logic.=rhses equals)))
+                                               (and (all-equalp ''t rhses)
+                                                    (logic.all-functionsp lhses)
+                                                    (all-equalp 'equal (logic.strip-function-names lhses))
+                                                    (all-equalp 2 (strip-lens (logic.strip-function-args lhses))))))))))))
+   (if (consp x)
+       (cons (build.disjoined-pequal-from-equal (car x))
+             (build.disjoined-pequal-from-equal-list (cdr x)))
+     nil))
+
+(defobligations build.disjoined-pequal-from-equal-list
+  (build.disjoined-pequal-from-equal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-pequal-from-equal-list)))
+
+ (defthm len-of-build.disjoined-pequal-from-equal-list
+   (equal (len (build.disjoined-pequal-from-equal-list x))
+          (len x)))
+
+ (defthm forcing-logic.appeal-listp-of-build.disjoined-pequal-from-equal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))))
+            (equal (logic.appeal-listp (build.disjoined-pequal-from-equal-list x))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-build.disjoined-pequal-from-equal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))))
+            (equal (logic.strip-conclusions (build.disjoined-pequal-from-equal-list x))
+                   (logic.por-list (logic.vlhses (logic.strip-conclusions x))
+                                   (logic.pequal-list (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                                                      (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-build.disjoined-pequal-from-equal-list
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                        ;; ---
+                        (logic.proof-listp x axioms thms atbl)
+                        (@obligations build.disjoined-pequal-from-equal-list)))
+            (equal (logic.proof-listp (build.disjoined-pequal-from-equal-list x) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.equal-by-args (f x)
+  ;;
+  ;;   (equal s1 t1) = t
+  ;;   ...
+  ;;   (equal sn tn) = t
+  ;; -------------------------------------------
+  ;;   (equal (f s1 ... sn) (f t1 ... tn)) = t
+  ;;
+  (declare (xargs :guard (and (logic.function-namep f)
+                              (logic.appeal-listp x)
+                              (let ((concs (logic.strip-conclusions x)))
+                                (and (logic.all-atomicp concs)
+                                     (let ((lhses (logic.=lhses concs))
+                                           (rhses (logic.=rhses concs)))
+                                       (and (all-equalp ''t rhses)
+                                            (logic.all-functionsp lhses)
+                                            (all-equalp 'equal (logic.strip-function-names lhses))
+                                            (all-equalp 2 (strip-lens (logic.strip-function-args lhses))))))))
+                  :guard-hints (("Goal" :in-theory (enable axiom-equal-when-same)))))
+  (let* ((s-t-tuples (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x))))
+         (s*         (strip-firsts  s-t-tuples))
+         (t*         (strip-seconds s-t-tuples)))
+    (cond ((equal s* t*)
+           ;; Optimization.  We can just use reflexivity.
+           (build.equal-reflexivity (logic.function f s*)))
+          (t
+           ;; Derivation.
+           ;;
+           ;;  1. s1 = t1, ..., sn = tn                                                      = from equal list
+           ;;  2. (f s1 ... sn) = (f t1 ... tn)                                              = by args
+           ;;  3. x != y v (equal x y) = t                                                   Axiom equal when same
+           ;;  4. (f s1 ... sn) != (f t1 ... tn) v (equal (f s1 ... sn) (f t1 ... tn)) = t   Instantiation; 3
+           ;;  5. (equal (f s1 ... sn) (f t1 ... tn)) = t                                    Modus Ponens; 2, 4
+           ;;
+           ;; Q.E.D.
+           (let* ((line-1 (build.pequal-from-equal-list x))
+                  (line-2 (build.pequal-by-args f line-1))
+                  (line-3 (build.axiom (axiom-equal-when-same)))
+                  (line-4 (build.instantiation line-3 (list (cons 'x (logic.=lhs (logic.conclusion line-2)))
+                                                            (cons 'y (logic.=rhs (logic.conclusion line-2))))))
+                  (line-5 (build.modus-ponens line-2 line-4)))
+             line-5)))))
+
+(defobligations build.equal-by-args
+  (build.equal-reflexivity build.pequal-from-equal-list build.instantiation build.modus-ponens)
+  :extra-axioms ((axiom-equal-when-same)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.equal-by-args axiom-equal-when-same)))
+
+ (defthm build.equal-by-args-under-iff
+   (iff (build.equal-by-args f x)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm forcing-logic.appealp-of-build.equal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))))
+            (equal (logic.appealp (build.equal-by-args f x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.equal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))))
+            (equal (logic.conclusion (build.equal-by-args f x))
+                   (logic.pequal (logic.function 'equal (list (logic.function f (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                                                              (logic.function f (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))))
+                                 ''t)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.equal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        ;; ---
+                        (logic.proof-listp x axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup f atbl)) (len x))
+                        (@obligations build.equal-by-args)))
+            (equal (logic.proofp (build.equal-by-args f x) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.equal-by-args-aux-okp (lhses rhses proofs)
+  (declare (xargs :guard (and (logic.term-listp lhses)
+                              (logic.term-listp rhses)
+                              (logic.appeal-listp proofs))
+                  :measure (rank proofs)))
+  (if (consp proofs)
+      (let ((conclusion (logic.conclusion (car proofs))))
+        (and (equal 'pequal* (logic.fmtype conclusion))
+             (equal (logic.=rhs conclusion) ''t)
+             (let ((lhs (logic.=lhs conclusion)))
+               (and (logic.functionp lhs)
+                    (equal 'equal (logic.function-name lhs))
+                    (let ((args (logic.function-args lhs)))
+                      (and (equal 2 (fast-len args 0))
+                           (equal (first args) (car lhses))
+                           (equal (second args) (car rhses))
+                           (build.equal-by-args-aux-okp (cdr lhses) (cdr rhses) (cdr proofs))))))))
+    t))
+
+(defthm build.equal-by-args-aux-okp-removal
+  (implies (force (and (logic.term-listp lhses)
+                       (logic.term-listp rhses)
+                       (true-listp lhses)
+                       (true-listp rhses)
+                       (logic.appeal-listp proofs)
+                       (equal (len lhses) (len proofs))
+                       (equal (len rhses) (len proofs))))
+           (equal (build.equal-by-args-aux-okp lhses rhses proofs)
+                  (and (logic.all-atomicp (logic.strip-conclusions proofs))
+                       (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs)))
+                       (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                       (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                       (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                       (equal lhses (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                       (equal rhses (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs))))))))
+  :hints(("Goal"
+          :induct (build.equal-by-args-aux-okp lhses rhses proofs)
+          :in-theory (enable build.equal-by-args-aux-okp)
+          :expand (build.equal-by-args-aux-okp lhses rhses proofs))))
+
+
+(defund build.equal-by-args-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'build.equal-by-args)
+         (logic.formula-atblp conclusion atbl)
+         (not extras)
+         (equal (logic.fmtype conclusion) 'pequal*)
+         (let ((=lhs (logic.=lhs conclusion))
+               (=rhs (logic.=rhs conclusion)))
+           (and (equal =rhs ''t)
+                (logic.functionp =lhs)
+                (equal (logic.function-name =lhs) 'equal)
+                (let ((args (logic.function-args =lhs)))
+                  (and (equal 2 (fast-len args 0))
+                       (let ((f-of-lhses (first args))
+                             (f-of-rhses (second args)))
+                         (and (logic.functionp f-of-lhses)
+                              (logic.functionp f-of-rhses)
+                              (equal (logic.function-name f-of-lhses) (logic.function-name f-of-rhses))
+                              (let ((lhses (logic.function-args f-of-lhses))
+                                    (rhses (logic.function-args f-of-rhses)))
+                                (and (same-lengthp lhses subproofs)
+                                     (same-lengthp rhses subproofs)
+                                     (build.equal-by-args-aux-okp lhses rhses subproofs))))))))))))
+
+
+(defund@ build.equal-by-args-high (f x)
+  (declare (xargs :guard (and (logic.function-namep f)
+                              (logic.appeal-listp x)
+                              (let ((concs (logic.strip-conclusions x)))
+                                (and (logic.all-atomicp concs)
+                                     (let ((lhses (logic.=lhses concs))
+                                           (rhses (logic.=rhses concs)))
+                                       (and (all-equalp ''t rhses)
+                                            (logic.all-functionsp lhses)
+                                            (all-equalp 'equal (logic.strip-function-names lhses))
+                                            (all-equalp 2 (strip-lens (logic.strip-function-args lhses))))))))
+                  :guard-hints (("Goal"
+                                 :in-theory (e/d (logic.strip-conclusions-of-rev
+                                                  logic.=lhses-of-rev
+                                                  logic.strip-function-args-of-rev
+                                                  strip-lens-of-rev)
+                                                 (rev-of-logic.strip-conclusions
+                                                  rev-of-logic.=lhses
+                                                  rev-of-logic.strip-function-args
+                                                  rev-of-strip-lens))))))
+  (let* ((rev-concs  (logic.fast-strip-conclusions$ x nil))
+         (lhses      (logic.fast-=lhses$ rev-concs nil))
+         (rev-args   (logic.fast-strip-function-args$ lhses nil))
+         (s*         (fast-strip-firsts$ rev-args nil))
+         (t*         (fast-strip-seconds$ rev-args nil)))
+        (cond ((equal s* t*)
+               (build.equal-reflexivity (logic.function f s*)))
+              (t
+               (logic.appeal 'build.equal-by-args
+                             (logic.pequal (logic.function 'equal (list (logic.function f s*)
+                                                                        (logic.function f t*)))
+                                           ''t)
+                             (list-fix x)
+                             nil)))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.equal-by-args-okp)))
+
+ (defthm booleanp-of-build.equal-by-args-aux-okp
+   (equal (booleanp (build.equal-by-args-aux-okp lhses rhses proofs))
+          t)
+   :hints(("Goal" :in-theory (e/d (build.equal-by-args-aux-okp)
+                                  ((:executable-counterpart ACL2::force))))))
+
+ (defthm booleanp-of-build.equal-by-args-okp
+   (equal (booleanp (build.equal-by-args-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm build.equal-by-args-okp-of-logic.appeal-identity
+   (equal (build.equal-by-args-okp (logic.appeal-identity x) atbl)
+          (build.equal-by-args-okp x atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-1-for-soundness-of-build.equal-by-args-okp
+   (implies (and (build.equal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (build.equal-by-args (logic.function-name (first (logic.function-args (logic.=lhs (logic.conclusion x)))))
+                                         (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                      axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-build.equal-by-args-okp
+   (implies (and (build.equal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations build.equal-by-args))
+            (equal (logic.proofp
+                    (build.equal-by-args (logic.function-name (first (logic.function-args (logic.=lhs (logic.conclusion x)))))
+                                         (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                      axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthmd lemma-3-for-soundness-of-build.equal-by-args-okp
+   (implies (and (build.equal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.appealp
+                    (build.equal-by-args (logic.function-name (first (logic.function-args (logic.=lhs (logic.conclusion x)))))
+                                         (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                      axioms thms atbl)))
+                   t))
+   :hints(("Goal" :in-theory (enable build.equal-by-args-okp))))
+
+ (defthm@ forcing-soundness-of-build.equal-by-args-okp
+   (implies (and (build.equal-by-args-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations build.equal-by-args))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-build.equal-by-args-okp
+                               lemma-2-for-soundness-of-build.equal-by-args-okp
+                               lemma-3-for-soundness-of-build.equal-by-args-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (build.equal-by-args (logic.function-name (first (logic.function-args (logic.=lhs (logic.conclusion x)))))
+                                                     (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                                  axioms thms atbl)))))))))
+
+
+
+
+
+(defund build.disjoined-equal-by-args (f p x)
+   ;;
+   ;;   P v (equal s1 t1) = t
+   ;;   ...
+   ;;   P v (equal sn tn) = t
+   ;; -----------------------------------------------
+   ;;   P v (equal (f s1 ... sn) (f t1 ... tn)) = t
+   ;;
+   (declare (xargs :guard (and (logic.function-namep f)
+                               (logic.formulap p)
+                               (logic.appeal-listp x)
+                               (let ((concs (logic.strip-conclusions x)))
+                                 (and (logic.all-disjunctionsp concs)
+                                      (all-equalp p (logic.vlhses concs))
+                                      (let ((equals (logic.vrhses concs)))
+                                        (and (logic.all-atomicp equals)
+                                             (let ((lhses (logic.=lhses equals))
+                                                   (rhses (logic.=rhses equals)))
+                                               (and (all-equalp ''t rhses)
+                                                    (logic.all-functionsp lhses)
+                                                    (all-equalp 'equal (logic.strip-function-names lhses))
+                                                    (all-equalp 2 (strip-lens (logic.strip-function-args lhses))))))))))
+                   :guard-hints (("Goal" :in-theory (enable axiom-equal-when-same)))))
+   (let* ((s-t-tuples  (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+          (s*          (strip-firsts s-t-tuples))
+          (t*          (strip-seconds s-t-tuples)))
+     (cond ((equal s* t*)
+            ;; Optimization.  We can just use reflexivity and expansion.
+            (build.expansion p (build.equal-reflexivity (logic.function f s*))))
+           (t
+            ;; Derivation.
+            ;;
+            ;;  1. P v s1 = t1, ..., P v sn = tn                                                  DJ = from equal list
+            ;;  2. P v (f s1 ... sn) = (f t1 ... tn)                                              DJ = by args
+            ;;  3. x != y v (equal x y) = t                                                       Axiom equal when same
+            ;;  4. (f s1 ... sn) != (f t1 ... tn) v (equal (f s1 ... sn) (f t1 ... tn)) = t       Instantiation
+            ;;  5. P v (f s1 ... sn) != (f t1 ... tn) v (equal (f s1 ... sn) (f t1 ... tn)) = t   Expansion
+            ;;  6. P v (equal (f s1 ... sn) (f t1 ... tn)) = t                                    DJ Modus Ponens; 2, 4
+            ;;
+            ;; Q.E.D.
+            (let* ((line-1 (build.disjoined-pequal-from-equal-list x))
+                   (line-2 (build.disjoined-pequal-by-args f p line-1))
+                   (line-3 (build.axiom (axiom-equal-when-same)))
+                   (line-4 (build.instantiation line-3 (list (cons 'x (logic.=lhs (logic.vrhs (logic.conclusion line-2))))
+                                                             (cons 'y (logic.=rhs (logic.vrhs (logic.conclusion line-2)))))))
+                   (line-5 (build.expansion p line-4))
+                   (line-6 (build.disjoined-modus-ponens line-2 line-5)))
+              line-6)))))
+
+(defobligations build.disjoined-equal-by-args
+  (build.expansion build.equal-reflexivity build.disjoined-pequal-from-equal-list
+   build.disjoined-pequal-by-args build.instantiation build.expansion build.disjoined-modus-ponens)
+  :extra-axioms ((axiom-equal-when-same)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-equal-by-args axiom-equal-when-same)))
+
+ (defthm build.disjoined-equal-by-args-under-iff
+   (iff (build.disjoined-equal-by-args f p x)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm forcing-logic.appealp-of-build.disjoined-equal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.formulap p)
+                        (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))))
+            (equal (logic.appealp (build.disjoined-equal-by-args f p x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-equal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.formulap p)
+                        (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))))
+            (equal (logic.conclusion (build.disjoined-equal-by-args f p x))
+                   (logic.por p (logic.pequal (logic.function 'equal (list (logic.function f (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                                                                           (logic.function f (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))))
+                                              ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.disjoined-equal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.formulap p)
+                        (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                        ;; ---
+                        (logic.formula-atblp p atbl)
+                        (logic.proof-listp x axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup f atbl)) (len x))
+                        (@obligations build.disjoined-equal-by-args)))
+            (equal (logic.proofp (build.disjoined-equal-by-args f p x) axioms thms atbl)
+                   t))))
+
+(defund build.disjoined-equal-by-args-aux-okp (p lhses rhses proofs)
+  (declare (xargs :guard (and (logic.formulap p)
+                              (logic.term-listp lhses)
+                              (logic.term-listp rhses)
+                              (logic.appeal-listp proofs))
+                  :measure (rank proofs)))
+  (if (consp proofs)
+      (let ((conclusion (logic.conclusion (car proofs))))
+        (and (equal 'por* (logic.fmtype conclusion))
+             (equal p (logic.vlhs conclusion))
+             (let ((rest (logic.vrhs conclusion)))
+               (and (equal 'pequal* (logic.fmtype rest))
+                    (equal (logic.=rhs rest) ''t)
+                    (let ((lhs (logic.=lhs rest)))
+                      (and (logic.functionp lhs)
+                           (equal 'equal (logic.function-name lhs))
+                           (let ((args (logic.function-args lhs)))
+                             (and (equal 2 (fast-len args 0))
+                                  (equal (first args) (car lhses))
+                                  (equal (second args) (car rhses))
+                                  (build.disjoined-equal-by-args-aux-okp p (cdr lhses) (cdr rhses) (cdr proofs))))))))))
+    t))
+
+(defthm build.disjoined-equal-by-args-aux-okp-removal
+  (implies (force (and (logic.formulap p)
+                       (logic.term-listp lhses)
+                       (logic.term-listp rhses)
+                       (true-listp lhses)
+                       (true-listp rhses)
+                       (logic.appeal-listp proofs)
+                       (equal (len lhses) (len proofs))
+                       (equal (len rhses) (len proofs))))
+           (equal (build.disjoined-equal-by-args-aux-okp p lhses rhses proofs)
+                  (and (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                       (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                       (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                       (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))
+                       (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                       (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                       (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                       (equal lhses (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                       (equal rhses (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))))))
+  :hints(("Goal"
+          :induct (build.disjoined-equal-by-args-aux-okp p lhses rhses proofs)
+          :in-theory (enable build.disjoined-equal-by-args-aux-okp)
+          :expand (build.disjoined-equal-by-args-aux-okp p lhses rhses proofs))))
+
+(defund build.disjoined-equal-by-args-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'build.disjoined-equal-by-args)
+         (logic.formula-atblp conclusion atbl)
+         (not extras)
+         (equal 'por* (logic.fmtype conclusion))
+         (equal 'pequal* (logic.fmtype (logic.vrhs conclusion)))
+         (let ((p    (logic.vlhs conclusion))
+               (=lhs (logic.=lhs (logic.vrhs conclusion)))
+               (=rhs (logic.=rhs (logic.vrhs conclusion))))
+           (and (equal =rhs ''t)
+                (logic.functionp =lhs)
+                (equal (logic.function-name =lhs) 'equal)
+                (let ((args (logic.function-args =lhs)))
+                  (and (equal 2 (fast-len args 0))
+                       (let ((f-of-lhses (first args))
+                             (f-of-rhses (second args)))
+                         (and (logic.functionp f-of-lhses)
+                              (logic.functionp f-of-rhses)
+                              (equal (logic.function-name f-of-lhses) (logic.function-name f-of-rhses))
+                              (let ((lhses (logic.function-args f-of-lhses))
+                                    (rhses (logic.function-args f-of-rhses)))
+                                (and (same-lengthp lhses subproofs)
+                                     (same-lengthp rhses subproofs)
+                                     (build.disjoined-equal-by-args-aux-okp p lhses rhses subproofs))))))))))))
+
+
+(defund@ build.disjoined-equal-by-args-high (f p x)
+  (declare (xargs :guard (and (logic.function-namep f)
+                              (logic.formulap p)
+                              (logic.appeal-listp x)
+                              (let ((concs (logic.strip-conclusions x)))
+                                (and (logic.all-disjunctionsp concs)
+                                     (all-equalp p (logic.vlhses concs))
+                                     (let ((equals (logic.vrhses concs)))
+                                       (and (logic.all-atomicp equals)
+                                            (let ((lhses (logic.=lhses equals))
+                                                  (rhses (logic.=rhses equals)))
+                                              (and (all-equalp ''t rhses)
+                                                   (logic.all-functionsp lhses)
+                                                   (all-equalp 'equal (logic.strip-function-names lhses))
+                                                   (all-equalp 2 (strip-lens (logic.strip-function-args lhses))))))))))
+                  :guard-hints (("Goal"
+                                 :in-theory (e/d (logic.strip-conclusions-of-rev
+                                                  logic.vrhses-of-rev
+                                                  logic.=lhses-of-rev
+                                                  logic.strip-function-args-of-rev
+                                                  strip-lens-of-rev)
+                                                 (rev-of-logic.strip-conclusions
+                                                  rev-of-logic.vrhses
+                                                  rev-of-logic.=lhses
+                                                  rev-of-logic.strip-function-args
+                                                  rev-of-strip-lens))))))
+  (let* ((rev-concs  (logic.fast-strip-conclusions$ x nil))
+         (vrhses     (logic.fast-vrhses$ rev-concs nil))
+         (rev-=lhses (logic.fast-=lhses$ vrhses nil))
+         (args       (logic.fast-strip-function-args$ rev-=lhses nil))
+         (firsts     (strip-firsts args))
+         (seconds    (strip-seconds args)))
+    (if (equal firsts seconds)
+        (build.expansion p (build.equal-reflexivity (logic.function f firsts)))
+      (logic.appeal 'build.disjoined-equal-by-args
+                    (logic.por p (logic.pequal (logic.function 'equal (list (logic.function f firsts)
+                                                                            (logic.function f seconds)))
+                                               ''t))
+                    (list-fix x)
+                    nil))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-equal-by-args-okp)))
+
+ (defthm booleanp-of-build.disjoined-equal-by-args-aux-okp
+   (equal (booleanp (build.disjoined-equal-by-args-aux-okp p lhses rhses proofs))
+          t)
+   :hints(("Goal" :in-theory (e/d (build.disjoined-equal-by-args-aux-okp)
+                                  ((:executable-counterpart ACL2::force))))))
+
+ (defthm booleanp-of-build.disjoined-equal-by-args-okp
+   (equal (booleanp (build.disjoined-equal-by-args-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm build.disjoined-equal-by-args-okp-of-logic.appeal-identity
+   (equal (build.disjoined-equal-by-args-okp (logic.appeal-identity x) atbl)
+          (build.disjoined-equal-by-args-okp x atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-1-for-soundness-of-build.disjoined-equal-by-args-okp
+   (implies (and (build.disjoined-equal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (build.disjoined-equal-by-args
+                     (logic.function-name (first (logic.function-args (logic.=lhs (logic.vrhs (logic.conclusion x))))))
+                     (logic.vlhs (logic.conclusion x))
+                     (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                  axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-build.disjoined-equal-by-args-okp
+   (implies (and (build.disjoined-equal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations build.disjoined-equal-by-args))
+            (equal (logic.proofp
+                    (build.disjoined-equal-by-args
+                     (logic.function-name (first (logic.function-args (logic.=lhs (logic.vrhs (logic.conclusion x))))))
+                     (logic.vlhs (logic.conclusion x))
+                     (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                  axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthmd lemma-3-for-soundness-of-build.disjoined-equal-by-args-okp
+   (implies (and (build.disjoined-equal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.appealp
+                    (build.disjoined-equal-by-args
+                     (logic.function-name (first (logic.function-args (logic.=lhs (logic.vrhs (logic.conclusion x))))))
+                     (logic.vlhs (logic.conclusion x))
+                     (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                  axioms thms atbl)))
+                   t))
+   :hints(("Goal" :in-theory (enable build.disjoined-equal-by-args-okp))))
+
+ (defthm@ forcing-soundness-of-build.disjoined-equal-by-args-okp
+   (implies (and (build.disjoined-equal-by-args-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations build.disjoined-equal-by-args))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-build.disjoined-equal-by-args-okp
+                               lemma-2-for-soundness-of-build.disjoined-equal-by-args-okp
+                               lemma-3-for-soundness-of-build.disjoined-equal-by-args-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (build.disjoined-equal-by-args
+                                 (logic.function-name (first (logic.function-args (logic.=lhs (logic.vrhs (logic.conclusion x))))))
+                                 (logic.vlhs (logic.conclusion x))
+                                 (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                              axioms thms atbl)))))))))
+
+
+
+
+
+
+(defund build.lambda-equal-by-args (formals body proofs)
+  ;;
+  ;;   (equal t1 s1) = t
+  ;;   ...
+  ;;   (equal tn sn) = t
+  ;; ---------------------------------------------------------------------------------
+  ;;   (equal ((lambda (x1...xn) B) t1 ... tn) ((lambda (x1...xn) B) s1 ... sn)) = t
+  ;;
+  (declare (xargs :guard (and (true-listp formals)
+                              (logic.variable-listp formals)
+                              (uniquep formals)
+                              (logic.termp body)
+                              (subsetp (logic.term-vars body) formals)
+                              (logic.appeal-listp proofs)
+                              (same-lengthp proofs formals)
+                              (logic.all-atomicp (logic.strip-conclusions proofs))
+                              (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                              (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                              (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs))))))
+  ;; Derivation.
+  ;;
+  ;;   1. t1 = s1, ..., tn = sn                                                            = from equal list
+  ;;   2. ((lambda (x1...xn) B) t1 ... tn) = ((lambda (x1...xn) B) s1 ... sn)              Lambda = by args
+  ;;   3. (equal ((lambda (x1...xn) B) t1 ... tn) ((lambda (x1...xn) B) s1 ... sn) = t     Equal from =
+  ;;
+  ;; Q.E.D.
+  (let* ((line-1 (build.pequal-from-equal-list proofs))
+         (line-2 (build.lambda-pequal-by-args formals body line-1))
+         (line-3 (build.equal-from-pequal line-2)))
+    line-3))
+
+(defobligations build.lambda-equal-by-args
+  (build.pequal-from-equal-list build.lambda-pequal-by-args build.equal-from-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.lambda-equal-by-args)))
+
+ (defthm build.lambda-equal-by-args-under-iff
+   (iff (build.lambda-equal-by-args formals body proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.lambda-equal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.appeal-listp proofs)
+                        (same-lengthp proofs formals)
+                        (logic.all-atomicp (logic.strip-conclusions proofs))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs)))))
+            (equal (logic.appealp (build.lambda-equal-by-args formals body proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.lambda-equal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.appeal-listp proofs)
+                        (same-lengthp proofs formals)
+                        (logic.all-atomicp (logic.strip-conclusions proofs))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs)))))
+            (equal (logic.conclusion (build.lambda-equal-by-args formals body proofs))
+                   (logic.pequal (logic.function 'equal (list (logic.lambda formals body (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                                                              (logic.lambda formals body (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))))
+                                 ''t)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.lambda-equal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.appeal-listp proofs)
+                        (same-lengthp proofs formals)
+                        (logic.all-atomicp (logic.strip-conclusions proofs))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs)))
+                        ;; ---
+                        (logic.term-atblp body atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations build.lambda-equal-by-args)))
+            (equal (logic.proofp (build.lambda-equal-by-args formals body proofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.disjoined-lambda-equal-by-args (formals body P proofs)
+  ;;
+  ;;   P v (equal t1 s1) = t
+  ;;   ...
+  ;;   P v (equal tn sn) = t
+  ;; -------------------------------------------------------------------------------------
+  ;;   P v (equal ((lambda (x1...xn) B) t1 ... tn) ((lambda (x1...xn) B) s1 ... sn)) = t
+  ;;
+  (declare (xargs :guard (and (true-listp formals)
+                              (logic.variable-listp formals)
+                              (uniquep formals)
+                              (logic.termp body)
+                              (subsetp (logic.term-vars body) formals)
+                              (logic.formulap P)
+                              (logic.appeal-listp proofs)
+                              (same-lengthp proofs formals)
+                              (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                              (all-equalp P (logic.vlhses (logic.strip-conclusions proofs)))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                              (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                              (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                              (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs)))))))
+  ;; Derivation.
+  ;;
+  ;;  1. P v t1 = s1, ..., P v tn = sn                                                   DJ = from equal list
+  ;;  2. P v ((lambda (x1...xn) B) s1...sn) = ((lambda (x1...xn) B) t1...tn)             DJ lambda = by args
+  ;;  3. P v (equal ((lambda (x1...xn) B) s1...sn) ((lambda (x1...xn) B) t1...tn)) = t   DJ equal from =
+  ;;
+  ;; Q.E.D.
+  (let* ((line-1 (build.disjoined-pequal-from-equal-list proofs))
+         (line-2 (build.disjoined-lambda-pequal-by-args formals body P line-1))
+         (line-3 (build.disjoined-equal-from-pequal line-2)))
+    line-3))
+
+(defobligations build.disjoined-lambda-equal-by-args
+  (build.disjoined-pequal-from-equal-list build.disjoined-lambda-pequal-by-args
+   build.disjoined-equal-from-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-lambda-equal-by-args)))
+
+ (defthm build.disjoined-lambda-equal-by-args-under-iff
+   (iff (build.disjoined-lambda-equal-by-args formals body P proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.disjoined-lambda-equal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.formulap P)
+                        (logic.appeal-listp proofs)
+                        (same-lengthp proofs formals)
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp P (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))))
+            (equal (logic.appealp (build.disjoined-lambda-equal-by-args formals body P proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-lambda-equal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.formulap P)
+                        (logic.appeal-listp proofs)
+                        (same-lengthp proofs formals)
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp P (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))))
+            (equal (logic.conclusion (build.disjoined-lambda-equal-by-args formals body P proofs))
+                   (logic.por P (logic.pequal (logic.function 'equal (list (logic.lambda formals body (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                                                                           (logic.lambda formals body (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))))
+                                              ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.disjoined-lambda-equal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.formulap P)
+                        (logic.appeal-listp proofs)
+                        (same-lengthp proofs formals)
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp P (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        (all-equalp 'equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        ;; ---
+                        (logic.formula-atblp p atbl)
+                        (logic.term-atblp body atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations build.disjoined-lambda-equal-by-args)))
+            (equal (logic.proofp (build.disjoined-lambda-equal-by-args formals body P proofs) axioms thms atbl)
+                   t))))
+
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/build/formula-compiler.lisp acl2-6.3/books/milawa/ACL2/build/formula-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/build/formula-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/formula-compiler.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,370 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "equal")
+(include-book "if")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(dd.open "formula-compiler.tex")
+
+;; Formula Compiler.
+;;
+;; We introduce a compiler which translates formulas into terms.  This is very
+;; useful because it means we can focus on term manipulation rather than trying
+;; to deal with formulas and terms.  The compliation is done by recursively
+;; applying the following transformations everywhere throughout the formula:
+;;
+;;   compile(x = y) == (equal x y)
+;;   compile(~F)    == (if compile(F) nil t)
+;;   compile(F v G) == (if compile(F) t compile(G))
+;;
+;; Now, if we want to prove some formula, A-formula, it suffices to compile it
+;; into A-term, and then prove A-term != nil.  Then, we can just use the
+;; following derivation:
+;;
+;;  1. A-formula v A-term = nil        Compile-Formula Builder, Property #3
+;;  2. A-term = nil v A-formula        Commute Or
+;;  3. A-term != nil                   Given
+;;  4. A-formula                       Modus Ponens 2; 3,2
+;;
+;; Q.E.D.
+
+(defund logic.compile-formula (x)
+  (declare (xargs :guard (logic.formulap x)
+                  :verify-guards nil))
+  (cond ((equal (logic.fmtype x) 'por*)
+         (logic.function 'if
+                (list (logic.compile-formula (logic.vlhs x))
+                      ''t
+                      (logic.compile-formula (logic.vrhs x)))))
+        ((equal (logic.fmtype x) 'pnot*)
+         (logic.function 'if
+                (list (logic.compile-formula (logic.~arg x))
+                      ''nil
+                      ''t)))
+        ((equal (logic.fmtype x) 'pequal*)
+         (logic.function 'equal (list (logic.=lhs x) (logic.=rhs x))))
+        (t nil)))
+
+(defthm forcing-logic.termp-of-logic.compile-formula
+  (implies (force (logic.formulap x))
+           (equal (logic.termp (logic.compile-formula x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.compile-formula))))
+
+(defthm forcing-logic.term-atblp-of-logic.compile-formula
+  (implies (force (and (logic.formulap x)
+                       (logic.formula-atblp x atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (equal (cdr (lookup 'equal atbl)) 2)))
+           (equal (logic.term-atblp (logic.compile-formula x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.compile-formula))))
+
+(verify-guards logic.compile-formula)
+
+
+
+
+(defderiv build.compile-formula-lemma-1
+  :derive (v (v B C) (= (if (? p) t (? q)) nil))
+  :from ((proof x (v B (= (? p) nil)))
+         (proof y (v C (= (? q) nil))))
+  :proof (@derive
+          ((v B (= (? p) nil))                          (@given x))
+          ((v B (= (if (? p) t (? q)) (? q)))           (build.disjoined-if-when-nil @- (@term t) (@term (? q))))
+          ((v (v B C) (= (if (? p) t (? q)) (? q)))     (build.multi-assoc-expansion @- (@formulas B C)) *1)
+          ((v C (= (? q) nil))                          (@given y))
+          ((v (v B C) (= (? q) nil))                    (build.multi-assoc-expansion @- (@formulas B C)))
+          ((v (v B C) (= (if (? p) t (? q)) nil))       (build.disjoined-transitivity-of-pequal *1 @-)))
+  :minatbl ((if . 3)))
+
+(defderiv build.compile-formula-lemma-2
+  :derive (v (! (v B C)) (= (if (? p) t (? q)) t))
+  :from ((proof x (v (! B) (= (? p) t)))
+         (proof y (v (! C) (= (? q) t))))
+  :proof (@derive
+          ((v (! B) (= (? p) t))                     (@given x))
+          ((v (! B) (!= (? p) nil))                  (build.disjoined-not-nil-from-t @-))
+          ((v (! B) (= (if (? p) t (? q)) t))        (build.disjoined-if-when-not-nil @- (@term t) (@term (? q))) *1)
+          ((v (! C) (= (? q) t))                     (@given y))
+          ((v (! C) (= t (? q)))                     (build.disjoined-commute-pequal @-))
+          ((v (! C) (= (if (? p) t (? q)) t))        (build.disjoined-if-when-same @- (@term (? p))))
+          ((v (! (v B C)) (= (if (? p) t (? q)) t))  (build.merge-implications *1 @-)))
+  :minatbl ((if . 3)))
+
+(defund@ build.compile-formula (a)
+  (declare (xargs :guard (logic.formulap a)
+                  :verify-guards nil))
+  ;; We simultaneously derive the following four formulas.
+  ;;
+  ;;   1. ~A v (logic.compile-formula A) = t
+  ;;   2. A v (logic.compile-formula A) = nil
+  ;;
+  ;; The resulting proofs are returned in a list.
+  (cond ((equal (logic.fmtype a) 'por*)
+         ;; Let A = B v C.
+         ;; Let D = (logic.compile-formula B).
+         ;; Let E = (logic.compile-formula C).
+         ;; Now (logic.compile-formula A) is (if D t E).
+         (let* ((subproofs-b (build.compile-formula (logic.vlhs a)))
+                (subproofs-c (build.compile-formula (logic.vrhs a)))
+                ;; Sub-B1: ~B v D = t
+                (sub-b1      (first subproofs-b))
+                ;; Sub-B2: B v D = nil
+                (sub-b2      (second subproofs-b))
+                ;; Sub-C1: ~C v E = t
+                (sub-c1      (first subproofs-c))
+                ;; Sub-C2: ~C v E = nil
+                (sub-c2      (second subproofs-c))
+                ;; Goal1: ~(B v C) v (if D t E) = t
+                (goal-1 (@derive ((v (! B) (= (? d) t))                        (@given sub-b1))
+                                 ((v (! C) (= (? e) t))                        (@given sub-c1))
+                                 ((v (! (v B C)) (= (if (? d) t (? e)) t))     (build.compile-formula-lemma-2 @-- @-))))
+                ;; Goal2: (B v C) v (if D t E) = nil
+                (goal-2 (@derive ((v B (= (? d) nil))                          (@given sub-b2))
+                                 ((v C (= (? e) nil))                          (@given sub-c2))
+                                 ((v (v B C) (= (if (? d) t (? e)) nil))       (build.compile-formula-lemma-1 @-- @-)))))
+
+           (list goal-1 goal-2)))
+
+        ((equal (logic.fmtype a) 'pnot*)
+         ;; Let A = ~B.
+         ;; Let C = (logic.compile-formula B).
+         ;; Now (logic.compile-formula A) is (if C nil t).
+         (let* ((subproofs (build.compile-formula (logic.~arg a)))
+                ;; Sub1: ~B v C = t
+                (sub1      (first subproofs))
+                ;; Sub2: B v C = nil
+                (sub2      (second subproofs))
+                ;; Goal1: ~~B v (if C nil t) = t
+                (goal-1 (@derive ((v B (= (? c) nil))                          (@given sub2))
+                                 ((v B (= (if (? c) nil t) t))                 (build.disjoined-if-when-nil @- (@term nil) (@term t)))
+                                 ((v (! (! B)) (= (if (? c) nil t) t))         (build.lhs-insert-neg-neg @-))))
+                ;; Goal2: ~B v (if C nil t) = nil
+                (goal-2 (@derive ((v (! B) (= (? c) t))                        (@given sub1))
+                                 ((v (! B) (!= (? c) nil))                     (build.disjoined-not-nil-from-t @-))
+                                 ((v (! B) (= (if (? c) nil t) nil))           (build.disjoined-if-when-not-nil @- (@term nil) (@term t))))))
+           (list goal-1 goal-2)))
+
+
+        ((equal (logic.fmtype a) 'pequal*)
+         ;; Now (logic.compile-formula A) is (equal lhs rhs).
+         (let* ((left   (logic.=lhs a))
+                (right  (logic.=rhs a))
+                (goal-1 (@derive ((v (!= x y) (= (equal x y) t))                     (build.axiom (axiom-equal-when-same)))
+                                 ((v (!= (? l) (? r)) (= (equal (? l) (? r)) t))     (build.instantiation @- (list (cons 'x left) (cons 'y right))))))
+                (goal-2 (@derive ((v (= x y) (= (equal x y) nil))                    (build.axiom (axiom-equal-when-diff)))
+                                 ((v (= (? l) (? r)) (= (equal (? l) (? r)) nil))    (build.instantiation @- (list (cons 'x left) (cons 'y right)))))))
+           (list goal-1 goal-2)))
+
+        (t nil)))
+
+
+
+(defobligations build.compile-formula
+  (build.instantiation
+   build.lhs-insert-neg-neg
+   build.disjoined-if-when-nil
+   build.disjoined-if-when-not-nil
+   build.compile-formula-lemma-1
+   build.compile-formula-lemma-2
+   build.disjoined-not-nil-from-t
+   build.disjoined-not-t-from-nil
+   build.disjoined-not-nil-from-t
+   build.disjoined-t-from-not-nil)
+  :extra-axioms ((axiom-equal-when-same)
+                 (axiom-equal-when-diff)))
+
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (logic.formulap x)
+                   (let ((result (logic.compile-formula x))
+                         (proofs (build.compile-formula x)))
+                     (and (logic.appealp (first proofs))
+                          (logic.appealp (second proofs))
+                          (equal (logic.conclusion (first proofs)) (logic.por (logic.pnot x) (logic.pequal result ''t)))
+                          (equal (logic.conclusion (second proofs)) (logic.por x (logic.pequal result ''nil)))
+                          )))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.compile-formula x)
+                  :in-theory (enable logic.compile-formula
+                                     build.compile-formula
+                                     axiom-equal-when-same
+                                     axiom-equal-when-diff)))))
+
+ (defthm forcing-logic.appealp-of-first-of-build.compile-formula
+   (implies (force (logic.formulap x))
+            (equal (logic.appealp (first (build.compile-formula x)))
+                   t))
+   :hints(("Goal" :use ((:instance lemma)))))
+
+ (defthm forcing-logic.appealp-of-second-of-build.compile-formula
+   (implies (force (logic.formulap x))
+            (equal (logic.appealp (second (build.compile-formula x)))
+                   t))
+   :hints(("Goal" :use ((:instance lemma)))))
+
+ (defthm forcing-logic.conclusion-of-first-of-build.compile-formula
+   (implies (force (logic.formulap x))
+            (equal (logic.conclusion (first (build.compile-formula x)))
+                   (logic.por (logic.pnot x) (logic.pequal (logic.compile-formula x) ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma)))))
+
+ (defthm forcing-logic.conclusion-of-second-of-build.compile-formula
+   (implies (force (logic.formulap x))
+            (equal (logic.conclusion (second (build.compile-formula x)))
+                   (logic.por x (logic.pequal (logic.compile-formula x) ''nil))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma))))))
+
+
+
+(encapsulate
+ ()
+ (local (defthm@ lemma
+          (implies (and (logic.formulap x)
+                        (logic.formula-atblp x atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations build.compile-formula))
+                   (and (logic.proofp (first (build.compile-formula x)) axioms thms atbl)
+                        (logic.proofp (second (build.compile-formula x)) axioms thms atbl)))
+          :hints(("Goal" :in-theory (enable build.compile-formula
+                                            logic.compile-formula
+                                            axiom-equal-when-same
+                                            axiom-equal-when-diff)))))
+
+ (defthm@ forcing-logic.proofp-of-first-of-build.compile-formula
+   (implies (force (and (logic.formulap x)
+                        (logic.formula-atblp x atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations build.compile-formula)))
+            (equal (logic.proofp (first (build.compile-formula x)) axioms thms atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma)))))
+
+ (defthm@ forcing-logic.proofp-of-second-of-build.compile-formula
+   (implies (force (and (logic.formulap x)
+                        (logic.formula-atblp x atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations build.compile-formula)))
+            (equal (logic.proofp (second (build.compile-formula x)) axioms thms atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma))))))
+
+
+(verify-guards build.compile-formula
+               :hints(("Goal" :in-theory (enable axiom-equal-when-same
+                                                 axiom-equal-when-diff))))
+
+
+(defprojection
+  :list (logic.compile-formula-list x)
+  :element (logic.compile-formula x)
+  :guard (logic.formula-listp x)
+  :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-logic.compile-formula-list
+  (implies (force (logic.formula-listp x))
+           (equal (logic.term-listp (logic.compile-formula-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-logic.compile-formula-list
+  (implies (force (and (logic.formula-listp x)
+                       (logic.formula-list-atblp x atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (equal (cdr (lookup 'equal atbl)) 2)))
+           (equal (logic.term-list-atblp (logic.compile-formula-list x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defund build.compile-formula-list-comm-2 (x)
+  (declare (xargs :guard (logic.formula-listp x)))
+  (if (consp x)
+      (cons (build.commute-or (second (build.compile-formula (car x))))
+            (build.compile-formula-list-comm-2 (cdr x)))
+    nil))
+
+(defobligations build.compile-formula-list-comm-2
+  (build.commute-or
+   build.compile-formula))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.compile-formula-list-comm-2)))
+
+ (defthm len-of-build.compile-formula-list-comm-2
+   (equal (len (build.compile-formula-list-comm-2 x))
+          (len x)))
+
+ (defthm logic.appeal-listp-of-build.compile-formula-list-comm-2
+   (implies (force (logic.formula-listp x))
+            (equal (logic.appeal-listp (build.compile-formula-list-comm-2 x))
+                   t)))
+
+ (defthm logic.strip-conclusions-of-logic.compile-formula-list-bldr3
+   (implies (force (logic.formula-listp x))
+            (equal (logic.strip-conclusions (build.compile-formula-list-comm-2 x))
+                   (logic.por-list
+                    (logic.pequal-list (logic.compile-formula-list x)
+                                       (repeat ''nil (len x)))
+                    x))))
+
+ (defthm@ logic.proof-listp-of-build.compile-formula-list-comm-2
+   (implies (force (and (logic.formula-listp x)
+                        ;; ---
+                        (logic.formula-list-atblp x atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations build.compile-formula-list-comm-2)
+                        ))
+            (equal (logic.proof-listp (build.compile-formula-list-comm-2 x) axioms thms atbl)
+                   t))))
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/build/if.lisp acl2-6.3/books/milawa/ACL2/build/if.lisp
--- acl2-6.2/books/milawa/ACL2/build/if.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/if.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,253 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(dd.open "if.tex")
+
+(dd.section "If manipulation")
+
+(defderiv build.if-when-not-nil
+  :derive (= (if (? a) (? b) (? c)) (? b))
+  :from   ((proof x (!= (? a) nil))
+           (term b (? b))
+           (term c (? c)))
+  :proof  (@derive ((v (= x nil) (= (if x y z) y))                      (build.axiom (axiom-if-when-not-nil)))
+                   ((v (= (? a) nil) (= (if (? a) (? b) (? c)) (? b)))  (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                   ((!= (? a) nil)                                      (@given x))
+                   ((= (if (? a) (? b) (? c)) (? b))                    (build.modus-ponens-2 @- @--)))
+  :minatbl ((if . 3)))
+
+(defderiv build.disjoined-if-when-not-nil
+  :derive (v P (= (if (? a) (? b) (? c)) (? b)))
+  :from   ((proof x (v P (!= (? a) nil)))
+           (term b (? b))
+           (term c (? c)))
+  :proof  (@derive ((v (= x nil) (= (if x y z) y))                            (build.axiom (axiom-if-when-not-nil)))
+                   ((v (= (? a) nil) (= (if (? a) (? b) (? c)) (? b)))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                   ((v P (v (= (? a) nil) (= (if (? a) (? b) (? c)) (? b))))  (build.expansion (@formula P) @-))
+                   ((v P (!= (? a) nil))                                      (@given x))
+                   ((v P (= (if (? a) (? b) (? c)) (? b)))                    (build.disjoined-modus-ponens-2 @- @--)))
+  :minatbl ((if . 3)))
+
+(defderiv build.if-when-nil
+ :derive (= (if (? a) (? b) (? c)) (? c))
+ :from   ((proof x (= (? a) nil))
+          (term b (? b))
+          (term c (? c)))
+ :proof  (@derive ((v (!= x nil) (= (if x y z) z))                       (build.axiom (axiom-if-when-nil)))
+                  ((v (!= (? a) nil) (= (if (? a) (? b) (? c)) (? c)))   (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                  ((= (? a) nil)                                         (@given x))
+                  ((= (if (? a) (? b) (? c)) (? c))                      (build.modus-ponens @- @--)))
+ :minatbl ((if . 3)))
+
+(defderiv build.disjoined-if-when-nil
+ :derive (v P (= (if (? a) (? b) (? c)) (? c)))
+ :from   ((proof x (v P (= (? a) nil)))
+          (term b (? b))
+          (term c (? c)))
+ :proof  (@derive ((v (!= x nil) (= (if x y z) z))                           (build.axiom (axiom-if-when-nil)))
+                  ((v (!= (? a) nil) (= (if (? a) (? b) (? c)) (? c)))       (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                  ((v P (v (!= (? a) nil) (= (if (? a) (? b) (? c)) (? c)))) (build.expansion (@formula P) @-))
+                  ((v P (= (? a) nil))                                       (@given x))
+                  ((v P (= (if (? a) (? b) (? c)) (? c)))                    (build.disjoined-modus-ponens @- @--)))
+ :minatbl ((if . 3)))
+
+(defderiv build.if-of-t
+  :derive (= (if t (? b) (? c)) (? b))
+  :from   ((term b (? b))
+           (term c (? c)))
+  :proof  (@derive
+           ((!= t nil)                     (build.axiom (axiom-t-not-nil)))
+           ((= (if t (? b) (? c)) (? b))   (build.if-when-not-nil @-
+                                                                  (@term (? b))
+                                                                  (@term (? c)))))
+  :minatbl ((if . 3)))
+
+(defderiv build.if-of-nil
+  :derive (= (if nil (? b) (? c)) (? c))
+  :from   ((term b (? b))
+           (term c (? c)))
+  :proof  (@derive
+           ((= nil nil)                     (build.reflexivity (@term nil)))
+           ((= (if nil (? b) (? c)) (? c))  (build.if-when-nil @-
+                                                               (@term (? b))
+                                                               (@term (? c)))))
+  :minatbl ((if . 3)))
+
+
+
+(deftheorem theorem-if-redux-same
+  :derive (= (if x y y) y)
+  :proof  (@derive ((v (= x nil) (= (if x y z) y))         (build.axiom (axiom-if-when-not-nil)))
+                   ((v (= x nil) (= (if x y y) y))         (build.instantiation @- (@sigma (z . y)))  *1)
+                   ((v (!= x nil) (= (if x y z) z))        (build.axiom (axiom-if-when-nil)))
+                   ((v (!= x nil) (= (if x y y) y))        (build.instantiation @- (@sigma (z . y))))
+                   ((v (= (if x y y) y) (= (if x y y) y))  (build.cut *1 @-))
+                   ((= (if x y y) y)                       (build.contraction @-)))
+  :minatbl ((if . 3)))
+
+(deftheorem theorem-if-when-same
+  :derive (v (!= y z) (= (if x y z) y))
+  :proof (@derive
+          ((= x x)                                (build.reflexivity (@term x)))
+          ((v (!= y z) (= x x))                   (build.expansion (@formula (!= y z)) @-)          *1a)
+          ((= y y)                                (build.reflexivity (@term y)))
+          ((v (!= y z) (= y y))                   (build.expansion (@formula (!= y z)) @-)          *1b)
+          ((v (!= y z) (= y z))                   (build.propositional-schema (@formula (= y z))))
+          ((v (!= y z) (= z y))                   (build.disjoined-commute-pequal @-)               *1c)
+          ((v (!= y z) (= (if x y z) (if x y y))) (build.disjoined-pequal-by-args 'if
+                                                                                  (@formula (!= y z))
+                                                                                  (list *1a *1b *1c))   *1)
+          ((= (if x y y) y)                       (build.theorem (theorem-if-redux-same)))
+          ((v (!= y z) (= (if x y y) y))          (build.expansion (@formula (!= y z)) @-))
+          ((v (!= y z) (= (if x y z) y))          (build.disjoined-transitivity-of-pequal *1 @-)))
+  :minatbl ((if . 3)))
+
+(defderiv build.if-when-same
+  :derive (= (if (? a) (? b) (? c)) (? b))
+  :from ((proof x (= (? b) (? c)))
+         (term a (? a)))
+  :proof (@derive
+          ((v (!= y z) (= (if x y z) y))                           (build.theorem (theorem-if-when-same)))
+          ((v (!= (? b) (? c)) (= (if (? a) (? b) (? c)) (? b)))   (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+          ((= (? b) (? c))                                         (@given x))
+          ((= (if (? a) (? b) (? c)) (? b))                        (build.modus-ponens @- @--)))
+  :minatbl ((if . 3)))
+
+(defderiv build.disjoined-if-when-same
+  :derive (v P (= (if (? a) (? b) (? c)) (? b)))
+  :from ((proof x (v P (= (? b) (? c))))
+         (term a (? a)))
+  :proof (@derive
+          ((v (!= y z) (= (if x y z) y))                                 (build.theorem (theorem-if-when-same)))
+          ((v (!= (? b) (? c)) (= (if (? a) (? b) (? c)) (? b)))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+          ((v P (v (!= (? b) (? c)) (= (if (? a) (? b) (? c)) (? b))))   (build.expansion (@formula P) @-))
+          ((v P (= (? b) (? c)))                                         (@given x))
+          ((v P (= (if (? a) (? b) (? c)) (? b)))                        (build.disjoined-modus-ponens @- @--)))
+  :minatbl ((if . 3)))
+
+
+
+
+(deftheorem theorem-if-redux-then
+ :derive (= (if x (if x y w) z) (if x y z))
+ :proof  (@derive ((v (= x nil) (= (if x y z) y))                     (build.axiom (axiom-if-when-not-nil))                        *1)
+                  ((v (= x nil) (= (if x y w) y))                     (build.instantiation @- (@sigma (z . w))))
+                  ((v (= x nil) (= y (if x y z)))                     (build.disjoined-commute-pequal *1))
+                  ((v (= x nil) (= (if x y w) (if x y z)))            (build.disjoined-transitivity-of-pequal @-- @-))
+                  ((v (= x nil) (= (if x (if x y w) z) (if x y w)))   (build.instantiation *1 (@sigma (y . (if x y w)))))
+                  ((v (= x nil) (= (if x (if x y w) z) (if x y z)))   (build.disjoined-transitivity-of-pequal @- @--)         *2)
+
+                  ((v (!= x nil) (= (if x y z) z))                    (build.axiom (axiom-if-when-nil))                            *3)
+                  ((v (!= x nil) (= z (if x y z)))                    (build.disjoined-commute-pequal @-))
+                  ((v (!= x nil) (= (if x (if x y w) z) z))           (build.instantiation *3 (@sigma (y . (if x y w)))))
+                  ((v (!= x nil) (= (if x (if x y w) z) (if x y z)))  (build.disjoined-transitivity-of-pequal @- @--)         *4)
+
+                  ((v (= (if x (if x y w) z) (if x y z))
+                      (= (if x (if x y w) z) (if x y z)))             (build.cut *2 *4))
+                  ((= (if x (if x y w) z) (if x y z))                 (build.contraction @-)))
+ :minatbl ((if . 3)))
+
+(deftheorem theorem-if-redux-else
+ :derive (= (if x y (if x w z)) (if x y z))
+ :proof  (@derive ((v (= x nil) (= (if x y z) y))                     (build.axiom (axiom-if-when-not-nil))                     *1)
+                  ((v (= x nil) (= (if x y (if x w z)) y))            (build.instantiation @- (@sigma (z . (if x w z)))))
+                  ((v (= x nil) (= y (if x y z)))                     (build.disjoined-commute-pequal *1))
+                  ((v (= x nil) (= (if x y (if x w z)) (if x y z)))   (build.disjoined-transitivity-of-pequal @-- @-)      *2)
+
+                  ((v (!= x nil) (= (if x y z) z))                    (build.axiom (axiom-if-when-nil))                         *3)
+                  ((v (!= x nil) (= (if x w z) z))                    (build.instantiation @- (@sigma (y . w))))
+                  ((v (!= x nil) (= x (if x y z)))                    (build.disjoined-commute-pequal *3))
+                  ((v (!= x nil) (= (if x w z) (if x y z)))           (build.disjoined-transitivity-of-pequal @-- @-))
+                  ((v (!= x nil) (= (if x y (if x w z)) (if x w z)))  (build.instantiation *3 (@sigma (z . (if x w z)))))
+                  ((v (!= x nil) (= (if x y (if x w z)) (if x y z)))  (build.disjoined-transitivity-of-pequal @- @--)      *4)
+
+                  ((v (= (if x y (if x w z)) (if x y z))
+                      (= (if x y (if x w z)) (if x y z)))             (build.cut *2 *4))
+                  ((= (if x y (if x w z)) (if x y z))                 (build.contraction @-)))
+ :minatbl ((if . 3)))
+
+(deftheorem theorem-if-redux-test
+ :derive (= (if (if x y z) p q) (if x (if y p q) (if z p q)))
+ :proof  (@derive ((v (= x nil) (= (if x y z) y))                                        (build.axiom (axiom-if-when-not-nil))      *1a)
+                  ((= p p)                                                               (build.reflexivity (@term p))         *p)
+                  ((v (= x nil) (= p p))                                                 (build.expansion (@formula (= x nil)) @-)  *1b)
+                  ((= q q)                                                               (build.reflexivity (@term q))         *q)
+                  ((v (= x nil) (= q q))                                                 (build.expansion (@formula (= x nil)) @-)  *1c)
+                  ((v (= x nil) (= (if (if x y z) p q) (if y p q)))                      (build.disjoined-pequal-by-args 'if
+                                                                                                                        (@formula (= x nil))
+                                                                                                                        (list *1a *1b *1c))      *1)
+                  ((v (= x nil) (= (if x (if y p q) (if z p q)) (if y p q)))             (build.instantiation *1a (@sigma (y . (if y p q))
+                                                                                                                    (z . (if z p q)))))
+                  ((v (= x nil) (= (if y p q) (if x (if y p q) (if z p q))))             (build.disjoined-commute-pequal @-))
+                  ((v (= x nil) (= (if (if x y z) p q) (if x (if y p q) (if z p q))))    (build.disjoined-transitivity-of-pequal *1 @-)           **1)
+
+                  ((v (!= x nil) (= (if x y z) z))                                       (build.axiom (axiom-if-when-nil))          *2a)
+                  ((v (!= x nil) (= p p))                                                (build.expansion (@formula (!= x nil)) *p) *2b)
+                  ((v (!= x nil) (= q q))                                                (build.expansion (@formula (!= x nil)) *q) *2c)
+                  ((v (!= x nil) (= (if (if x y z) p q) (if z p q)))                     (build.disjoined-pequal-by-args 'if
+                                                                                                                        (@formula (!= x nil))
+                                                                                                                        (list *2a *2b *2c))      *2)
+                  ((v (!= x nil) (= (if x (if y p q) (if z p q)) (if z p q)))            (build.instantiation *2a (@sigma (y . (if y p q))
+                                                                                                                    (z . (if z p q)))))
+                  ((v (!= x nil) (= (if z p q) (if x (if y p q) (if z p q))))            (build.disjoined-commute-pequal @-))
+                  ((v (!= x nil) (= (if (if x y z) p q) (if x (if y p q) (if z p q))))   (build.disjoined-transitivity-of-pequal *2 @-)           **2)
+
+                  ((v (= (if (if x y z) p q) (if x (if y p q) (if z p q)))
+                      (= (if (if x y z) p q) (if x (if y p q) (if z p q))))              (build.cut **1 **2))
+                  ((= (if (if x y z) p q) (if x (if y p q) (if z p q)))                  (build.contraction @-)))
+ :minatbl ((if . 3)))
+
+(deftheorem theorem-if-redux-nil
+ :derive (= (if nil y z) z)
+ :proof  (@derive ((= nil nil)         (build.reflexivity (@term nil)))
+                  ((= (if nil y z) z)  (build.if-when-nil @- (@term y) (@term z))))
+ :minatbl ((if . 3)))
+
+(deftheorem theorem-if-redux-t
+ :derive (= (if t y z) y)
+ :proof  (@derive ((!= t nil)        (build.axiom (axiom-t-not-nil)))
+                  ((= (if t y z) y)  (build.if-when-not-nil @- (@term y) (@term z))))
+ :minatbl ((if . 3)))
+
+
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/build/iff.lisp acl2-6.3/books/milawa/ACL2/build/iff.lisp
--- acl2-6.2/books/milawa/ACL2/build/iff.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/iff.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1873 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "equal")
+(include-book "if")
+(include-book "disjoined-subset")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(dd.open "iff.tex")
+
+(dd.section "Iff manipulation")
+
+
+(defund definition-of-iff ()
+  (logic.pequal (logic.function 'iff (list 'x 'y))
+                (logic.function 'if (list 'x
+                                          (logic.function 'if (list 'y ''t ''nil))
+                                          (logic.function 'if (list 'y ''nil ''t))))))
+
+(in-theory (disable (:executable-counterpart definition-of-iff)))
+
+(defthm logic.formulap-of-definition-of-iff
+  (equal (logic.formulap (definition-of-iff))
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-iff))))
+
+(defthm forcing-logic.formula-atblp-of-definition-of-iff
+  (implies (force (and (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.formula-atblp (definition-of-iff) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-iff))))
+
+(acl2::set-ignore-ok t)
+
+
+
+
+
+;; LEMMAS.
+;;
+;; We characterize the behavior of iff when one or both of its arguments are
+;; known to be nil or non-nil.  These lemmas are useful in proving the theorems
+;; and rules we are actually interested in.
+
+(deftheorem theorem-iff-lhs-false
+  :derive (v (!= x nil) (= (iff x y) (if y nil t)))
+  :proof  (@derive
+           ((= (iff x y) (if x (if y t nil) (if y nil t)))        (build.axiom (definition-of-iff)))
+
+           ((v (!= x nil)
+               (= (iff x y) (if x (if y t nil) (if y nil t))))    (build.expansion (@formula (!= x nil)) @-)   *1)
+
+           ((v (!= x nil) (= x nil))                              (build.propositional-schema (@formula (= x nil))))
+
+           ((v (!= x nil) (= (if x (if y t nil) (if y nil t))
+                             (if y nil t)))                       (build.disjoined-if-when-nil @-
+                                                                                               (@term (if y t nil))
+                                                                                               (@term (if y nil t))))
+
+           ((v (!= x nil) (= (iff x y) (if y nil t)))             (build.disjoined-transitivity-of-pequal *1 @-)))
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+(deftheorem theorem-iff-lhs-true
+  :derive (v (= x nil) (= (iff x y) (if y t nil)))
+  :proof  (@derive
+           ((= (iff x y) (if x (if y t nil) (if y nil t)))        (build.axiom (definition-of-iff)))
+
+           ((v (= x nil)
+               (= (iff x y) (if x (if y t nil) (if y nil t))))    (build.expansion (@formula (= x nil)) @-)   *1)
+
+           ((v (!= x nil) (= x nil))                              (build.propositional-schema (@formula (= x nil))))
+
+           ((v (= x nil) (!= x nil))                              (build.commute-or @-))
+
+           ((v (= x nil) (= (if x (if y t nil) (if y nil t))
+                            (if y t nil)))                        (build.disjoined-if-when-not-nil @-
+                                                                                                   (@term (if y t nil))
+                                                                                                   (@term (if y nil t))))
+
+           ((v (= x nil) (= (iff x y) (if y t nil)))              (build.disjoined-transitivity-of-pequal *1 @-)))
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+(deftheorem theorem-iff-rhs-false
+  :derive (v (!= y nil) (= (iff x y) (if x nil t)))
+  :proof  (@derive
+           ((= (iff x y) (if x (if y t nil) (if y nil t)))        (build.axiom (definition-of-iff)))
+
+           ((v (!= y nil)
+               (= (iff x y) (if x (if y t nil) (if y nil t))))    (build.expansion (@formula (!= y nil)) @-)   *1)
+
+           ((= x x)                                               (build.reflexivity (@term x)))
+           ((v (!= y nil) (= x x))                                (build.expansion (@formula (!= y nil)) @-)   *2a)
+
+           ((v (!= y nil) (= y nil))                              (build.propositional-schema (@formula (= y nil))))
+           ((v (!= y nil) (= (if y t nil) nil))                   (build.disjoined-if-when-nil @- (@term t) (@term nil))  *2b)
+           ((v (!= y nil) (= (if y nil t) t))                     (build.disjoined-if-when-nil @-- (@term nil) (@term t))  *2c)
+
+           ((v (!= y nil) (= (if x (if y t nil) (if y nil t))
+                             (if x nil t)))                       (build.disjoined-pequal-by-args 'if
+                                                                                                  (@formula (!= y nil))
+                                                                                                  (list *2a *2b *2c)))
+
+           ((v (!= y nil) (= (iff x y) (if x nil t)))             (build.disjoined-transitivity-of-pequal *1 @-)))
+
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+(deftheorem theorem-iff-rhs-true
+  :derive (v (= y nil) (= (iff x y) (if x t nil)))
+  :proof  (@derive
+           ((= (iff x y) (if x (if y t nil) (if y nil t)))        (build.axiom (definition-of-iff)))
+
+           ((v (= y nil)
+               (= (iff x y) (if x (if y t nil) (if y nil t))))    (build.expansion (@formula (= y nil)) @-)   *1)
+
+           ((= x x)                                               (build.reflexivity (@term x)))
+           ((v (= y nil) (= x x))                                 (build.expansion (@formula (= y nil)) @-)   *2a)
+
+           ((v (!= y nil) (= y nil))                              (build.propositional-schema (@formula (= y nil))))
+           ((v (= y nil) (!= y nil))                              (build.commute-or @-))
+           ((v (= y nil) (= (if y t nil) t))                      (build.disjoined-if-when-not-nil @- (@term t) (@term nil))  *2b)
+           ((v (= y nil) (= (if y nil t) nil))                    (build.disjoined-if-when-not-nil @-- (@term nil) (@term t))  *2c)
+
+           ((v (= y nil) (= (if x (if y t nil) (if y nil t))
+                            (if x t nil)))                        (build.disjoined-pequal-by-args 'if
+                                                                                                  (@formula (= y nil))
+                                                                                                  (list *2a *2b *2c)))
+
+           ((v (= y nil) (= (iff x y) (if x t nil)))              (build.disjoined-transitivity-of-pequal *1 @-)))
+
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+(deftheorem theorem-iff-both-true
+ :derive (v (= x nil) (v (= y nil) (= (iff x y) t)))
+ :proof (@derive
+         ((v (= x nil) (= (iff x y) (if y t nil)))                (build.theorem (theorem-iff-lhs-true)))
+         ((v (v (= x nil) (= y nil)) (= (iff x y) (if y t nil)))  (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil))) *1)
+         ((v (= x nil) (= (if x y z) y))                          (build.axiom (axiom-if-when-not-nil)))
+         ((v (= y nil) (= (if y t nil) t))                        (build.instantiation @- (@sigma (x . y) (y . t) (z . nil))))
+         ((v (v (= x nil) (= y nil)) (= (if y t nil) t))          (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil))))
+         ((v (v (= x nil) (= y nil)) (= (iff x y) t))             (build.disjoined-transitivity-of-pequal *1 @-))
+         ((v (= x nil) (v (= y nil) (= (iff x y) t)))             (build.right-associativity @-)))
+ :minatbl ((iff . 2)
+           (if . 3)))
+
+(deftheorem theorem-iff-both-false
+ :derive (v (!= x nil) (v (!= y nil) (= (iff x y) t)))
+ :proof (@derive
+         ((v (!= x nil) (= (iff x y) (if y nil t)))                 (build.theorem (theorem-iff-lhs-false)))
+         ((v (v (!= x nil) (!= y nil)) (= (iff x y) (if y nil t)))  (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= y nil))) *1)
+         ((v (!= x nil) (= (if x y z) z))                           (build.axiom (axiom-if-when-nil)))
+         ((v (!= y nil) (= (if y nil t) t))                         (build.instantiation @- (@sigma (x . y) (y . nil) (z . t))))
+         ((v (v (!= x nil) (!= y nil)) (= (if y nil t) t))          (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= y nil))))
+         ((v (v (!= x nil) (!= y nil)) (= (iff x y) t))             (build.disjoined-transitivity-of-pequal *1 @-))
+         ((v (!= x nil) (v (!= y nil) (= (iff x y) t)))             (build.right-associativity @-)))
+ :minatbl ((iff . 2)
+           (if . 3)))
+
+(deftheorem theorem-iff-true-false
+ :derive (v (= x nil) (v (!= y nil) (= (iff x y) nil)))
+ :proof (@derive
+         ((v (= x nil) (= (iff x y) (if y t nil)))                  (build.theorem (theorem-iff-lhs-true)))
+         ((v (v (= x nil) (!= y nil)) (= (iff x y) (if y t nil)))   (build.multi-assoc-expansion @- (@formulas (= x nil) (!= y nil))) *1)
+         ((v (= x nil) (= (if x y z) z))                            (build.axiom (axiom-if-when-nil)))
+         ((v (!= y nil) (= (if y t nil) nil))                       (build.instantiation @- (@sigma (x . y) (y . t) (z . nil))))
+         ((v (v (= x nil) (!= y nil)) (= (if y t nil) nil))         (build.multi-assoc-expansion @- (@formulas (= x nil) (!= y nil))))
+         ((v (v (= x nil) (!= y nil)) (= (iff x y) nil))            (build.disjoined-transitivity-of-pequal *1 @-))
+         ((v (= x nil) (v (!= y nil) (= (iff x y) nil)))            (build.right-associativity @-)))
+ :minatbl ((iff . 2)
+           (if . 3)))
+
+(deftheorem theorem-iff-false-true
+ :derive (v (!= x nil) (v (= y nil) (= (iff x y) nil)))
+ :proof (@derive
+         ((v (!= x nil) (= (iff x y) (if y nil t)))                (build.theorem (theorem-iff-lhs-false)))
+         ((v (v (!= x nil) (= y nil)) (= (iff x y) (if y nil t)))  (build.multi-assoc-expansion @- (@formulas (!= x nil) (= y nil))) *1)
+         ((v (= x nil) (= (if x y z) y))                           (build.axiom (axiom-if-when-not-nil)))
+         ((v (= y nil) (= (if y nil t) nil))                       (build.instantiation @- (@sigma (x . y) (y . nil) (z . t))))
+         ((v (v (!= x nil) (= y nil)) (= (if y nil t) nil))        (build.multi-assoc-expansion @- (@formulas (!= x nil) (= y nil))))
+         ((v (v (!= x nil) (= y nil)) (= (iff x y) nil))           (build.disjoined-transitivity-of-pequal *1 @-))
+         ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))           (build.right-associativity @-)))
+ :minatbl ((iff . 2)
+           (if . 3)))
+
+
+
+
+;; Yuck, I don't really want to have these.  The disjoined transitive if reduction rules might give me a
+;; nice way around these.
+
+(deftheorem theorem-iff-t-when-not-nil
+  :derive (v (= x nil) (= (iff x t) t))
+  :proof (@derive
+          ((v (= x nil) (= (iff x y) (if y t nil)))   (build.theorem (theorem-iff-lhs-true)))
+          ((v (= x nil) (= (iff x t) (if t t nil)))   (build.instantiation @- (@sigma (y . t))) *1)
+          ((= (if t t nil) t)                         (build.if-of-t (@term t) (@term nil)))
+          ((v (= x nil) (= (if t t nil) t))           (build.expansion (@formula (= x nil)) @-))
+          ((v (= x nil) (= (iff x t) t))              (build.disjoined-transitivity-of-pequal *1 @-)))
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+(defderiv build.iff-t-from-not-pequal-nil
+  :derive (= (iff (? a) t) t)
+  :from   ((proof x (!= (? a) nil)))
+  :proof  (@derive
+           ((v (= x nil) (= (iff x t) t))          (build.theorem (theorem-iff-t-when-not-nil)))
+           ((v (= (? a) nil) (= (iff (? a) t) t))  (build.instantiation @- (@sigma (x . (? a)))))
+           ((!= (? a) nil)                         (@given x))
+           ((= (iff (? a) t) t)                    (build.modus-ponens-2 @- @--)))
+  :minatbl ((iff . 2)))
+
+(defderiv build.disjoined-iff-t-from-not-pequal-nil
+  :derive (v P (= (iff (? a) t) t))
+  :from   ((proof x (v P (!= (? a) nil))))
+  :proof  (@derive
+           ((v (= x nil) (= (iff x t) t))               (build.theorem (theorem-iff-t-when-not-nil)))
+           ((v (= (? a) nil) (= (iff (? a) t) t))       (build.instantiation @- (@sigma (x . (? a)))))
+           ((v P (v (= (? a) nil) (= (iff (? a) t) t))) (build.expansion (@formula P) @-))
+           ((v P (!= (? a) nil))                        (@given x))
+           ((v P (= (iff (? a) t) t))                   (build.disjoined-modus-ponens-2 @- @--)))
+  :minatbl ((iff . 2)))
+
+
+
+(deftheorem theorem-iff-t-when-nil
+  :derive (v (!= x nil) (= (iff x t) nil))
+  :proof (@derive
+          ((v (!= x nil) (= (iff x y) (if y nil t)))  (build.theorem (theorem-iff-lhs-false)))
+          ((v (!= x nil) (= (iff x t) (if t nil t)))  (build.instantiation @- (@sigma (y . t))) *1)
+          ((= (if t nil nil) nil)                     (build.if-of-t (@term nil) (@term t)))
+          ((v (!= x nil) (= (if t nil nil) nil))      (build.expansion (@formula (!= x nil)) @-))
+          ((v (!= x nil) (= (iff x t) nil))           (build.disjoined-transitivity-of-pequal *1 @-)))
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+(defderiv build.not-pequal-nil-from-iff-t
+  :derive (!= (? a) nil)
+  :from   ((proof x (!= (iff (? a) t) nil)))
+  :proof  (@derive
+           ((v (!= x nil) (= (iff x t) nil))          (build.theorem (theorem-iff-t-when-nil)))
+           ((v (!= (? a) nil) (= (iff (? a) t) nil))  (build.instantiation @- (@sigma (x . (? a)))))
+           ((v (= (iff (? a) t) nil) (!= (? a) nil))  (build.commute-or @-))
+           ((!= (iff (? a) t) nil)                    (@given x))
+           ((!= (? a) nil)                            (build.modus-ponens-2 @- @--))))
+
+(defderiv build.disjoined-not-pequal-nil-from-iff-t
+  :derive (v P (!= (? a) nil))
+  :from   ((proof x (v P (!= (iff (? a) t) nil))))
+  :proof  (@derive
+           ((v (!= x nil) (= (iff x t) nil))                (build.theorem (theorem-iff-t-when-nil)))
+           ((v (!= (? a) nil) (= (iff (? a) t) nil))        (build.instantiation @- (@sigma (x . (? a)))))
+           ((v (= (iff (? a) t) nil) (!= (? a) nil))        (build.commute-or @-))
+           ((v P (v (= (iff (? a) t) nil) (!= (? a) nil)))  (build.expansion (@formula P) @-))
+           ((v P (!= (iff (? a) t) nil))                    (@given x))
+           ((v P (!= (? a) nil))                            (build.disjoined-modus-ponens-2 @- @--))))
+
+
+(deftheorem theorem-iff-nil-when-nil
+ :derive (v (!= x nil) (= (iff x nil) t))
+ :proof  (@derive
+          ((v (!= x nil) (= (iff x y) (if y nil t)))     (build.theorem (theorem-iff-lhs-false)))
+          ((v (!= x nil) (= (iff x nil) (if nil nil t))) (build.instantiation @- (@sigma (y . nil))) *1)
+          ((= (if nil nil t) nil)                        (build.if-of-nil (@term nil) (@term t)))
+          ((v (!= x nil) (= (if nil nil t) nil))         (build.expansion (@formula (!= x nil)) @-))
+          ((v (!= x nil) (= (iff x nil) nil))            (build.disjoined-transitivity-of-pequal *1 @-)))
+ :minatbl ((if . 3)
+           (iff . 2)))
+
+(deftheorem theorem-iff-nil-when-not-nil
+  :derive (v (= x nil) (= (iff x nil) nil))
+  :proof  (@derive
+           ((v (= x nil) (= (iff x y) (if y t nil)))       (build.theorem (theorem-iff-lhs-true)))
+           ((v (= x nil) (= (iff x nil) (if nil t nil)))   (build.instantiation @- (@sigma (y . nil))) *1)
+           ((= (if nil t nil) nil)                         (build.if-of-nil (@term t) (@term nil)))
+           ((v (= x nil) (= (if nil t nil) nil))           (build.expansion (@formula (= x nil)) @-))
+           ((v (= x nil) (= (iff x nil) nil))              (build.disjoined-transitivity-of-pequal *1 @-)))
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+
+
+
+;; EQUIVALENCE RULES.  (except transitivity)
+;;
+;; We now establish that iff is Boolean-valued, reflexive, and symmetric.  We
+;; will do the transitivity proof later, after some additional rules about if.
+;; As usual, we do the work in theorems which can later be instantiated to keep
+;; proof sizes down.
+
+(deftheorem theorem-iff-nil-or-t
+  :derive (v (= (iff x y) nil)
+             (= (iff x y) t))
+  :proof (@derive
+          ((v (= x nil) (v (= y nil) (= (iff x y) t)))     (build.theorem (theorem-iff-both-true)))
+          ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))  (build.theorem (theorem-iff-false-true)))
+
+          ((v (v (= y nil) (= (iff x y) t))
+              (v (= y nil) (= (iff x y) nil)))             (build.cut @-- @-))
+
+          ((v (= y nil)
+              (v (= (iff x y) t)
+                 (v (= y nil)
+                    (= (iff x y) nil))))                   (build.right-associativity @-))
+
+          ((v (= y nil)
+              (v (= (iff x y) nil)
+                 (= (iff x y) t)))                         (build.generic-subset (@formulas (= y nil)
+                                                                                            (= (iff x y) t)
+                                                                                            (= y nil)
+                                                                                            (= (iff x y) nil))
+                                                                                 (@formulas (= y nil)
+                                                                                            (= (iff x y) nil)
+                                                                                            (= (iff x y) t))
+                                                                                 @-) *1)
+
+          ((v (= x nil) (v (!= y nil) (= (iff x y) nil)))  (build.theorem (theorem-iff-true-false)))
+          ((v (!= x nil) (v (!= y nil) (= (iff x y) t)))   (build.theorem (theorem-iff-both-false)))
+
+          ((v (v (!= y nil) (= (iff x y) nil))
+              (v (!= y nil) (= (iff x y) t)))              (build.cut @-- @-))
+
+          ((v (!= y nil)
+              (v (= (iff x y) nil)
+                 (v (!= y nil)
+                    (= (iff x y) t))))                     (build.right-associativity @-))
+
+          ((v (!= y nil)
+              (v (= (iff x y) nil)
+                 (= (iff x y) t)))                         (build.generic-subset (@formulas (!= y nil)
+                                                                                            (= (iff x y) nil)
+                                                                                            (!= y nil)
+                                                                                            (= (iff x y) t))
+                                                                                 (@formulas (!= y nil)
+                                                                                            (= (iff x y) nil)
+                                                                                            (= (iff x y) t))
+                                                                                 @-))
+          ((v (v (= (iff x y) nil) (= (iff x y) t))
+              (v (= (iff x y) nil) (= (iff x y) t)))       (build.cut *1 @-))
+          ((v (= (iff x y) nil) (= (iff x y) t))           (build.contraction @-)))
+
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+(deftheorem theorem-reflexivity-of-iff
+  :derive (= (iff x x) t)
+  :proof  (@derive
+           ((v (= x nil) (= (iff x y) (if y t nil)))                           (build.theorem (theorem-iff-lhs-true)))
+           ((v (= x nil) (= (iff x x) (if x t nil)))                           (build.instantiation @- (@sigma (y . x)))  *1a)
+           ((v (= x nil) (= (if x y z) y))                                     (build.axiom (axiom-if-when-not-nil)))
+           ((v (= x nil) (= (if x t nil) t))                                   (build.instantiation @- (@sigma (y . t) (z . nil))))
+           ((v (= x nil) (= (iff x x) t))                                      (build.disjoined-transitivity-of-pequal *1a @-)  *1)
+           ;; ---
+           ((v (!= x nil) (= (iff x y) (if y nil t)))                          (build.theorem (theorem-iff-lhs-false)))
+           ((v (!= x nil) (= (iff x x) (if x nil t)))                          (build.instantiation @- (@sigma (y . x)))  *2a)
+           ((v (!= x nil) (= (if x y z) z))                                    (build.axiom (axiom-if-when-nil)))
+           ((v (!= x nil) (= (if x nil t) t))                                  (build.instantiation @- (@sigma (y . nil) (z . t))))
+           ((v (!= x nil) (= (iff x x) t))                                     (build.disjoined-transitivity-of-pequal *2a @-) *2)
+           ;; ---
+           ((v (= (iff x x) t) (= (iff x x) t))                                (build.cut *1 *2))
+           ((= (iff x x) t)                                                    (build.contraction @-)))
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+(deftheorem theorem-symmetry-of-iff
+  :derive (= (iff x y) (iff y x))
+  :proof  (@derive
+           ((v (= y nil) (= (iff x y) (if x t nil)))                           (build.theorem (theorem-iff-rhs-true)))
+           ((v (= x nil) (= (iff y x) (if y t nil)))                           (build.instantiation @- (@sigma (x . y) (y . x))))
+           ((v (= x nil) (= (if y t nil) (iff y x)))                           (build.disjoined-commute-pequal @-))
+           ((v (= x nil) (= (iff x y) (if y t nil)))                           (build.theorem (theorem-iff-lhs-true)))
+           ((v (= x nil) (= (iff x y) (iff y x)))                              (build.disjoined-transitivity-of-pequal @- @--)   *1)
+           ;; ---
+           ((v (!= y nil) (= (iff x y) (if x nil t)))                          (build.theorem (theorem-iff-rhs-false)))
+           ((v (!= x nil) (= (iff y x) (if y nil t)))                          (build.instantiation @- (@sigma (x . y) (y . x))))
+           ((v (!= x nil) (= (if y nil t) (iff y x)))                          (build.disjoined-commute-pequal @-))
+           ((v (!= x nil) (= (iff x y) (if y nil t)))                          (build.theorem (theorem-iff-lhs-false)))
+           ((v (!= x nil) (= (iff x y) (iff y x)))                             (build.disjoined-transitivity-of-pequal @- @--)   *2)
+           ;; ---
+           ((v (= (iff x y) (iff y x)) (= (iff x y) (iff y x)))                (build.cut *1 *2))
+           ((= (iff x y) (iff y x))                                            (build.contraction @-)))
+  :minatbl ((iff . 2)
+            (if . 3)))
+
+(defderiv build.iff-t-from-not-nil
+ :derive (= (iff (? a) (? b)) t)
+ :from   ((proof x (!= (iff (? a) (? b)) nil)))
+ :proof  (@derive
+          ((v (= (iff x y) nil) (= (iff x y) t))                                (build.theorem (theorem-iff-nil-or-t)))
+          ((v (= (iff (? a) (? b)) nil) (= (iff (? a) (? b)) t))                (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+          ((!= (iff (? a) (? b)) nil)                                           (@given x))
+          ((= (iff (? a) (? b)) t)                                              (build.modus-ponens-2 @- @--))))
+
+(defderiv build.disjoined-iff-t-from-not-nil
+ :derive (v P (= (iff (? a) (? b)) t))
+ :from   ((proof x (v P (!= (iff (? a) (? b)) nil))))
+ :proof  (@derive
+          ((v (= (iff x y) nil) (= (iff x y) t))                                (build.theorem (theorem-iff-nil-or-t)))
+          ((v (= (iff (? a) (? b)) nil) (= (iff (? a) (? b)) t))                (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+          ((v P (v (= (iff (? a) (? b)) nil) (= (iff (? a) (? b)) t)))          (build.expansion (@formula P) @-))
+          ((v P (!= (iff (? a) (? b)) nil))                                     (@given x))
+          ((v P (= (iff (? a) (? b)) t))                                        (build.disjoined-modus-ponens-2 @- @--))))
+
+(defderiv build.iff-reflexivity
+  :derive (= (iff (? a) (? a)) t)
+  :from   ((term a (? a)))
+  :proof  (@derive ((= (iff x x) t)          (build.theorem (theorem-reflexivity-of-iff)))
+                   ((= (iff (? a) (? a)) t)  (build.instantiation @- (@sigma (x . (? a))))))
+  :minatbl ((iff . 2)))
+
+(defderiv build.commute-iff
+  :derive (= (iff (? b) (? a)) t)
+  :from   ((proof x (= (iff (? a) (? b)) t)))
+  :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use iff reflexivity.
+                 (@derive ((= (iff (? b) (? a)) t)                              (build.iff-reflexivity (@term (? a))))))
+                (t
+                 (@derive ((= (iff x y) (iff y x))                              (build.theorem (theorem-symmetry-of-iff)))
+                          ((= (iff (? b) (? a)) (iff (? a) (? b)))              (build.instantiation @- (@sigma (x . (? b)) (y . (? a)))))
+                          ((= (iff (? a) (? b)) t)                              (@given x))
+                          ((= (iff (? b) (? a)) t)                              (build.transitivity-of-pequal @-- @-)))))
+  :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                          (build.iff-reflexivity (@term (? a)))
+                        (LOGIC.APPEAL 'BUILD.COMMUTE-IFF
+                                      (@FORMULA (= (IFF (? B) (? A)) T))
+                                      (LIST X)
+                                      NIL)))
+
+(defderiv build.disjoined-commute-iff
+  :derive (v P (= (iff (? b) (? a)) t))
+  :from   ((proof x (v P (= (iff (? a) (? b)) t))))
+  :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use iff-reflexivity and expansion.
+                 (@derive
+                  ((= (iff (? b) (? a)) t)                                      (build.iff-reflexivity (@term (? a))))
+                  ((v P (= (iff (? b) (? a)) t))                                (build.expansion (@formula P) @-))))
+                (t
+                 (@derive
+                  ((= (iff x y) (iff y x))                                      (build.theorem (theorem-symmetry-of-iff)))
+                  ((= (iff (? b) (? a)) (iff (? a) (? b)))                      (build.instantiation @- (@sigma (x . (? b)) (y . (? a)))))
+                  ((v P (= (iff (? b) (? a)) (iff (? a) (? b))))                (build.expansion (@formula P) @-))
+                  ((v P (= (iff (? a) (? b)) t))                                (@given x))
+                  ((v P (= (iff (? b) (? a)) t))                                (build.disjoined-transitivity-of-pequal @-- @-)))))
+  :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                          (@derive ((= (iff (? b) (? a)) t)         (build.iff-reflexivity (@term (? a))))
+                                   ((v P (= (iff (? b) (? a)) t))   (build.expansion (@formula P) @-)))
+                        (LOGIC.APPEAL 'BUILD.DISJOINED-COMMUTE-IFF
+                                      (@FORMULA (V P (= (IFF (? B) (? A)) T)))
+                                      (LIST X)
+                                      NIL)))
+
+
+
+;; CONGRUENCE RULES.
+;;
+;; We now develop the classic "congruence rules" which say that when (iff x y),
+;; we can replace
+;;  - (if x a b) with (if y a b)
+;;  - (iff x z) with (iff y z), and
+;;  - (iff z x) with (iff z y).
+
+(deftheorem theorem-iff-congruence-lemma
+ :derive (v (= x nil) (v (= y nil) (= (if x a b) (if y a b))))
+ :proof (@derive
+         ((v (= x nil) (= (if x y z) z))                        (build.axiom (axiom-if-when-not-nil)))
+         ((v (= x nil) (= (if x a b) b))                        (build.instantiation @- (@sigma (y . a) (z . b))))
+         ((v (v (= x nil) (= y nil)) (= (if x a b) b))          (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil))) *1)
+         ((v (= y nil) (= (if y a b) b))                        (build.instantiation @-- (@sigma (x . y))))
+         ((v (v (= x nil) (= y nil)) (= (if y a b) b))          (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil))))
+         ((v (v (= x nil) (= y nil)) (= b (if y a b)))          (build.disjoined-commute-pequal @-))
+         ((v (v (= x nil) (= y nil)) (= (if x a b) (if y a b))) (build.disjoined-transitivity-of-pequal *1 @-))
+         ((v (= x nil) (v (= y nil) (= (if x a b) (if y a b)))) (build.right-associativity @-)))
+ :minatbl ((iff . 2)
+           (if . 3)))
+
+(deftheorem theorem-iff-congruence-lemma-2
+ :derive (v (!= x nil) (v (!= y nil) (= (if x a b) (if y a b))))
+ :proof  (@derive
+          ((v (!= x nil) (= (if x y z) y))                          (build.axiom (axiom-if-when-nil)))
+          ((v (!= x nil) (= (if x a b) b))                          (build.instantiation @- (@sigma (y . a) (z . b))))
+          ((v (v (!= x nil) (!= y nil)) (= (if x a b) b))           (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= y nil))) *1)
+
+          ((v (!= y nil) (= (if y a b) b))                          (build.instantiation @-- (@sigma (x . y))))
+          ((v (v (!= x nil) (!= y nil)) (= (if y a b) b))           (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= y nil))))
+          ((v (v (!= x nil) (!= y nil)) (= b (if y a b)))           (build.disjoined-commute-pequal @-))
+          ((v (v (!= x nil) (!= y nil)) (= (if x a b) (if y a b)))  (build.disjoined-transitivity-of-pequal *1 @-))
+
+          ((v (!= x nil) (v (!= y nil) (!= (if x a b) (if y a b)))) (build.right-associativity @-)))
+ :minatbl ((iff . 2)
+           (if . 3)))
+
+(deftheorem theorem-iff-congruent-if-1
+  :derive (v (= (iff x y) nil)
+             (= (if x a b) (if y a b)))
+  :proof (@derive
+
+          ((v (= x nil) (v (= y nil) (= (if x a b) (if y a b))))   (build.theorem (theorem-iff-congruence-lemma)))
+          ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))          (build.theorem (theorem-iff-false-true)))
+
+          ((v (v (= y nil) (= (if x a b) (if y a b)))
+              (v (= y nil) (= (iff x y) nil)))                     (build.cut @-- @-))
+
+          ((v (= y nil)
+              (v (= (if x a b) (if y a b))
+                 (v (= y nil)
+                    (= (iff x y) nil))))                           (build.right-associativity @-))
+
+          ((v (= y nil)
+              (v (= (iff x y) nil)
+                 (= (if x a b) (if y a b))))                       (build.generic-subset (@formulas (= y nil)
+                                                                                                    (= (if x a b) (if y a b))
+                                                                                                    (= y nil)
+                                                                                                    (= (iff x y) nil))
+                                                                                         (@formulas (= y nil)
+                                                                                                    (= (iff x y) nil)
+                                                                                                    (= (if x a b) (if y a b)))
+                                                                                         @-)    *1)
+
+          ;; ---------------
+
+          ((v (= x nil) (v (!= y nil) (= (iff x y) nil)))          (build.theorem (theorem-iff-true-false)))
+          ((v (!= x nil) (v (!= y nil) (= (if x a b) (if y a b)))) (build.theorem (theorem-iff-congruence-lemma-2)))
+          ((v (v (!= y nil) (= (iff x y) nil))
+              (v (!= y nil) (= (if x a b) (if y a b))))            (build.cut @-- @-))
+
+          ((v (!= y nil)
+              (v (= (iff x y) nil)
+                 (v (!= y nil)
+                    (= (if x a b) (if y a b)))))                   (build.right-associativity @-))
+
+          ((v (!= y nil)
+              (v (= (iff x y) nil)
+                 (= (if x a b) (if y a b))))                       (build.generic-subset (@formulas (!= y nil)
+                                                                                                    (= (iff x y) nil)
+                                                                                                    (!= y nil)
+                                                                                                    (= (if x a b) (if y a b)))
+                                                                                         (@formulas (!= y nil)
+                                                                                                    (= (iff x y) nil)
+                                                                                                    (= (if x a b) (if y a b)))
+                                                                                         @-))
+
+          ((v (v (= (iff x y) nil)
+                 (= (if x a b) (if y a b)))
+              (v (= (iff x y) nil)
+                 (= (if x a b) (if y a b))))                       (build.cut *1 @-))
+
+          ((v (= (iff x y) nil)
+              (= (if x a b) (if y a b)))                        (build.contraction @-)))
+
+  :minatbl ((iff . 2)
+            (if . 3)))
+
+(deftheorem theorem-iff-congruent-iff-2
+  :derive (v (= (iff x y) nil)
+             (= (iff z x) (iff z y)))
+  :proof  (@derive
+
+           ((v (= x nil) (= (iff x y) (if y t nil)))  (build.theorem (theorem-iff-lhs-true)))
+
+           ((v (= z nil)
+               (= (iff z x) (if x t nil)))            (build.instantiation @- (@sigma (x . z) (y . x)))    *1a)
+
+           ((v (= z nil)
+               (= (iff z y) (if y t nil)))            (build.instantiation @- (@sigma (x . y))))
+
+           ((v (= z nil)
+               (= (if y t nil) (iff z y)))            (build.disjoined-commute-pequal @-)                  *1b)
+
+           ((v (= (iff x y) nil)
+               (= (if x a b) (if y a b)))             (build.theorem (theorem-iff-congruent-if-1)))
+
+           ((v (= (iff x y) nil)
+               (= (if x nil t) (if y t nil)))         (build.instantiation @- (@sigma (a . t) (b . nil)))  *1c)
+
+           ;; ---
+
+           ((v (= z nil)
+               (v (= (iff x y) nil)
+                  (= (iff z x) (if x t nil))))        (build.multi-assoc-expansion *1a (@formulas (= z nil)
+                                                                                                  (= (iff x y) nil))))
+
+           ((v (= z nil)
+               (v (= (iff x y) nil)
+                  (= (if x nil t) (if y t nil))))     (build.multi-assoc-expansion *1c (@formulas (= z nil)
+                                                                                                  (= (iff x y) nil))))
+
+           ((v (= z nil)
+               (v (= (iff x y) nil)
+                  (= (iff z x) (if y t nil))))        (build.disjoined-transitivity-of-pequal @-- @-))
+
+           ((v (= z nil)
+               (v (= (iff x y) nil)
+                  (= (if y t nil) (iff z y))))        (build.multi-assoc-expansion *1b (@formulas (= z nil)
+                                                                                                  (= (iff x y) nil))))
+
+           ((v (= z nil)
+               (v (= (iff x y) nil)
+                  (= (iff z x) (iff z y))))           (build.disjoined-transitivity-of-pequal @-- @-))
+
+           ((v (= z nil)
+               (v (= (iff x y) nil)
+                  (= (iff z x) (iff z y))))           (build.right-associativity @-)     *1)
+
+           ;; -------------
+
+           ((v (!= x nil)
+               (= (iff x y) (if y nil t)))            (build.theorem (theorem-iff-lhs-false)))
+
+           ((v (!= z nil)
+               (= (iff z x) (if x nil t)))            (build.instantiation @- (@sigma (x . z) (y . x)))   *2a)
+
+           ((v (!= z nil)
+               (= (iff z y) (if y nil t)))            (build.instantiation @- (@sigma (x . y))))
+
+           ((v (!= z nil)
+               (= (if y nil t) (iff z y)))            (build.disjoined-commute-pequal @-)               *2b)
+
+           ((v (= (iff x y) nil)
+               (= (if x a b) (if y a b)))             (build.theorem (theorem-iff-congruent-if-1)))
+
+           ((v (= (iff x y) nil)
+               (= (if x nil t) (if y nil t)))         (build.instantiation @- (@sigma (a . nil) (b . t)))  *2c)
+
+           ;; ---
+
+           ((v (v (!= z nil)
+                  (= (iff x y) nil))
+               (= (iff z x) (if x nil t)))            (build.multi-assoc-expansion *2a (@formulas (!= z nil)
+                                                                                                  (= (iff x y) nil))))
+
+           ((v (v (!= z nil)
+                  (= (iff x y) nil))
+               (= (if x nil t) (if y nil t)))         (build.multi-assoc-expansion *2c (@formulas (!= z nil)
+                                                                                                  (= (iff x y) nil))))
+
+           ((v (v (!= z nil)
+                  (= (iff x y) nil))
+               (= (iff z x) (if y nil t)))            (build.disjoined-transitivity-of-pequal @-- @-))
+
+           ((v (v (!= z nil)
+                  (= (iff x y) nil))
+               (= (if y nil t) (iff z y)))            (build.multi-assoc-expansion *2b (@formulas (!= z nil)
+                                                                                                  (= (iff x y) nil))))
+
+           ((v (v (!= z nil)
+                  (= (iff x y) nil))
+               (= (iff z x) (iff z y)))               (build.disjoined-transitivity-of-pequal @-- @-))
+
+           ((v (!= z nil)
+               (v (= (iff x y) nil)
+                  (= (iff z x) (iff z y))))           (build.right-associativity @-)  *2)
+
+           ;; ------------------
+
+           ((v (v (= (iff x y) nil)
+                  (= (iff z x) (iff z y)))
+               (v (= (iff x y) nil)
+                  (= (iff z x) (iff z y))))           (build.cut *1 *2))
+
+           ((v (= (iff x y) nil)
+               (= (iff z x) (iff z y)))            (build.contraction @-)))
+
+  :minatbl ((iff . 2)
+            (if . 3)))
+
+(deftheorem theorem-iff-congruent-iff-1
+  :derive (v (= (iff x y) nil)
+             (= (iff x z) (iff y z)))
+  :proof (@derive
+          ((= (iff x y) (iff y x))                         (build.theorem (theorem-symmetry-of-iff)))
+          ((= (iff z y) (iff y z))                         (build.instantiation @- (@sigma (x . z) (y . y))))
+          ((= (iff z x) (iff x z))                         (build.instantiation @-- (@sigma (x . z) (y . x))))
+          ((v (= (iff x y) nil)
+              (= (iff z y) (iff y z)))                     (build.expansion (@formula (= (iff x y) nil)) @--) *1a)
+          ((v (= (iff x y) nil)
+              (= (iff z x) (iff x z)))                     (build.expansion (@formula (= (iff x y) nil)) @--) *1b)
+          ((v (= (iff x y) nil)
+              (= (iff z x) (iff z y)))                     (build.theorem (theorem-iff-congruent-iff-2)))
+          ((v (= (iff x y) nil)
+              (= (iff z x) (iff y z)))                     (build.disjoined-transitivity-of-pequal @- *1a))
+          ((v (= (iff x y) nil)
+              (= (iff y z) (iff z x)))                     (build.disjoined-commute-pequal @-))
+          ((v (= (iff x y) nil)
+              (= (iff y z) (iff x z)))                     (build.disjoined-transitivity-of-pequal @- *1b))
+          ((v (= (iff x y) nil)
+              (= (iff x z) (iff y z)))                     (build.disjoined-commute-pequal @-)))
+  :minatbl ((iff . 2)
+            (if . 3)))
+
+
+
+;; TRANSITIVITY.
+;;
+;; With these congruence rules in place, transitivity is straightforward.  As
+;; usual we prove a theorem which we can just instantiate with modus ponens to
+;; keep proof sizes down.
+
+(deftheorem theorem-transitivity-of-iff
+  :derive (v (!= (iff x y) t)
+             (v (!= (iff y z) t)
+                (= (iff x z) t)))
+  :proof (@derive
+          ((v (= (iff x y) nil) (= (iff x z) (iff y z)))    (build.theorem (theorem-iff-congruent-iff-1)))
+          ((v (= (iff x z) (iff y z)) (= (iff x y) nil))    (build.commute-or @-))
+          ((v (= (iff x z) (iff y z)) (!= (iff x y) t))     (build.disjoined-not-t-from-nil @-))
+          ((v (!= (iff x y) t) (= (iff x z) (iff y z)))     (build.commute-or @-))
+
+          ((v (v (!= (iff x y) t)
+                 (!= (iff y z) t))
+              (= (iff x z) (iff y z)))                      (build.multi-assoc-expansion @- (@formulas (!= (iff x y) t)
+                                                                                                       (!= (iff y z) t))) *1)
+
+
+          ((v (!= (iff y z) t) (= (iff y z) t))             (build.propositional-schema (@formula (= (iff y z) t))))
+
+          ((v (v (!= (iff x y) t)
+                 (!= (iff y z) t))
+              (= (iff y z) t))                              (build.multi-assoc-expansion @- (@formulas (!= (iff x y) t)
+                                                                                                       (!= (iff y z) t))))
+          ((v (v (!= (iff x y) t)
+                 (!= (iff y z) t))
+              (= (iff x z) t))                              (build.disjoined-transitivity-of-pequal *1 @-))
+
+          ((v (!= (iff x y) t)
+              (v (!= (iff y z) t)
+                 (= (iff x z) t)))                          (build.right-associativity @-)))
+
+  :minatbl ((iff . 2)
+            (if . 3)))
+
+(defderiv build.transitivity-of-iff
+ :derive (= (iff (? a) (? c)) t)
+ :from   ((proof x (= (iff (? a) (? b)) t))
+          (proof y (= (iff (? b) (? c)) t)))
+ :proof  (@derive
+          ((v (!= (iff x y) t)
+              (v (!= (iff y z) t)
+                 (= (iff x z) t)))            (build.theorem (theorem-transitivity-of-iff)))
+
+          ((v (!= (iff (? a) (? b)) t)
+              (v (!= (iff (? b) (? c)) t)
+                 (= (iff (? a) (? c)) t)))    (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c))))   *1)
+
+          ((= (iff (? a) (? b)) t)            (@given x))
+
+          ((v (!= (iff (? b) (? c)) t)
+              (= (iff (? a) (? c)) t))        (build.modus-ponens @- *1) *2)
+
+          ((= (iff (? b) (? c)) t)            (@given y))
+
+          ((= (iff (? a) (? c)) t)            (build.modus-ponens @- *2))))
+
+(defderiv build.disjoined-transitivity-of-iff
+ :derive (v P (= (iff (? a) (? c)) t))
+ :from   ((proof x (v P (= (iff (? a) (? b)) t)))
+          (proof y (v P (= (iff (? b) (? c)) t))))
+ :proof  (@derive
+          ((v (!= (iff x y) t)
+              (v (!= (iff y z) t)
+                 (= (iff x z) t)))                  (build.theorem (theorem-transitivity-of-iff)))
+
+          ((v (!= (iff (? a) (? b)) t)
+              (v (!= (iff (? b) (? c)) t)
+                 (= (iff (? a) (? c)) t)))          (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+
+          ((v P (v (!= (iff (? a) (? b)) t)
+                   (v (!= (iff (? b) (? c)) t)
+                      (= (iff (? a) (? c)) t))))    (build.expansion (@formula P) @-))
+
+          ((v P (= (iff (? a) (? b)) t))            (@given x))
+
+          ((v P (v (!= (iff (? b) (? c)) t)
+                   (= (iff (? a) (? c)) t)))        (build.disjoined-modus-ponens @- @--))
+
+          ((v P (= (iff (? b) (? c)) t))            (@given y))
+
+          ((v P (!= (iff (? a) (? c)) t))           (build.disjoined-modus-ponens @- @--))))
+
+
+
+;; REFINEMENT.
+;;
+;; A trivial consequence of reflexivity is that any time x = y, (iff x y) also
+;; holds.  It is useful to be able to switch from an equality into an iff.
+;; Similarly, if (equal x y) = t, then (iff x y) = t.
+
+(deftheorem theorem-iff-from-pequal
+ :derive (v (!= x y) (= (iff x y) t))
+ :proof  (@derive
+          ((= x x)                                                              (build.reflexivity 'x))
+          ((v (!= x y) (= x x))                                                 (build.expansion (@formula (!= x y)) @-)        *1a)
+          ((v (!= x y) (= x y))                                                 (build.propositional-schema (@formula (= x y))))
+          ((v (!= x y) (= y x))                                                 (build.disjoined-commute-pequal @-)             *1b)
+          ((v (!= x y) (= (iff x y) (iff x x)))                                 (build.disjoined-pequal-by-args 'iff
+                                                                                                                (@formula (!= x y))
+                                                                                                                (list *1a *1b))  *1)
+          ((= (iff x x) t)                                                      (build.theorem (theorem-reflexivity-of-iff)))
+          ((v (!= x y) (= (iff x x) t))                                         (build.expansion (@formula (!= x y)) @-))
+          ((v (!= x y) (= (iff x y) t))                                         (build.disjoined-transitivity-of-pequal *1 @-)))
+ :minatbl ((iff . 2)))
+
+(defderiv build.iff-from-pequal
+  :derive (= (iff (? a) (? b)) t)
+  :from   ((proof x (= (? a) (? b))))
+  :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use iff reflexivity.
+                 (@derive
+                  ((= (iff (? a) (? b)) t)                                      (build.iff-reflexivity (@term (? a))))))
+                (t
+                 (@derive
+                  ((v (!= x y) (= (iff x y) t))                                 (build.theorem (theorem-iff-from-pequal)))
+                  ((v (!= (? a) (? b)) (= (iff (? a) (? b)) t))                 (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                  ((= (? a) (? b))                                              (@given x))
+                  ((= (iff (? a) (? b)) t)                                      (build.modus-ponens @- @--)))))
+  :minatbl ((iff . 2))
+  :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                          (build.iff-reflexivity (@term (? a)))
+                        (LOGIC.APPEAL 'BUILD.IFF-FROM-PEQUAL
+                                      (@FORMULA (= (IFF (? A) (? B)) T))
+                                      (LIST X)
+                                      NIL)))
+
+(defderiv build.disjoined-iff-from-pequal
+ :derive (v P (= (iff (? a) (? b)) t))
+ :from   ((proof x (v P (= (? a) (? b)))))
+ :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                ;; Optimization.  We can just use iff-reflexivity and expansion.
+                (@derive
+                 ((= (iff (? a) (? b)) t)                                       (build.iff-reflexivity (@term (? a))))
+                 ((v P (= (iff (? a) (? b)) t))                                 (build.expansion (@formula P) @-))))
+               (t
+                (@derive
+                 ((v (!= x y) (= (iff x y) t))                                  (build.theorem (theorem-iff-from-pequal)))
+                 ((v (!= (? a) (? b)) (= (iff (? a) (? b)) t))                  (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                 ((v P (v (!= (? a) (? b)) (= (iff (? a) (? b)) t)))            (build.expansion (@formula P) @-))
+                 ((v P (= (? a) (? b)))                                         (@given x))
+                 ((v P (= (iff (? a) (? b)) t))                                 (build.disjoined-modus-ponens @- @--)))))
+ :minatbl ((iff . 2))
+ :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                         (@derive ((= (iff (? a) (? b)) t)           (build.iff-reflexivity (@term (? a))))
+                                  ((v P (= (iff (? a) (? b)) t))     (build.expansion (@formula P) @-)))
+                       (LOGIC.APPEAL 'BUILD.DISJOINED-IFF-FROM-PEQUAL
+                                     (@FORMULA (V P (= (IFF (? A) (? B)) T)))
+                                     (LIST X)
+                                     NIL)))
+
+
+
+(deftheorem theorem-iff-from-equal
+  :derive (v (!= (equal x y) t) (= (iff x y) t))
+  :proof  (@derive ((v (= x y) (= (equal x y) nil))                             (build.axiom (axiom-equal-when-diff)))
+                   ((v (= x y) (!= (equal x y) t))                              (build.disjoined-not-t-from-nil @-))
+                   ((v (!= x y) (= (iff x y) t))                                (build.theorem (theorem-iff-from-pequal)))
+                   ((v (!= (equal x y) t) (= (iff x y) t))                      (build.cut @-- @-)))
+  :minatbl ((iff . 2)
+            (equal . 2)))
+
+(defderiv build.iff-from-equal
+ :derive (= (iff (? a) (? b)) t)
+ :from   ((proof x (= (equal (? a) (? b)) t)))
+ :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                ;; Optimization.  Just use iff reflexivity.
+                (@derive ((= (iff (? a) (? b)) t)                               (build.iff-reflexivity (@term (? a))))))
+               (t
+                (@derive
+                 ((v (!= (equal x y) t) (= (iff x y) t))                        (build.theorem (theorem-iff-from-equal)))
+                 ((v (!= (equal (? a) (? b)) t) (= (iff (? a) (? b)) t))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                 ((= (equal (? a) (? b)) t)                                     (@given x))
+                 ((= (iff (? a) (? b)) t)                                       (build.modus-ponens @- @--)))))
+ :minatbl ((iff . 2))
+ :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                         (build.iff-reflexivity (@term (? a)))
+                       (LOGIC.APPEAL 'BUILD.IFF-FROM-EQUAL
+                                     (@FORMULA (= (IFF (? A) (? B)) T))
+                                     (LIST X)
+                                     NIL)))
+
+(defderiv build.disjoined-iff-from-equal
+ :derive (v P (= (iff (? a) (? b)) t))
+ :from   ((proof x (v P (= (equal (? a) (? b)) t))))
+ :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                ;; Optimization.  We can just use iff-reflexivity and expansion.
+                (@derive ((= (iff (? a) (? b)) t)                               (build.iff-reflexivity (@term (? a))))
+                         ((v P (= (iff (? a) (? b)) t))                         (build.expansion (@formula P) @-))))
+               (t
+                (@derive
+                 ((v (!= (equal x y) t) (= (iff x y) t))                        (build.theorem (theorem-iff-from-equal)))
+                 ((v (!= (equal (? a) (? b)) t) (= (iff (? a) (? b)) t))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                 ((v P (v (!= (equal (? a) (? b)) t) (= (iff (? a) (? b)) t)))  (build.expansion (@formula P) @-))
+                 ((v P (= (equal (? a) (? b)) t))                               (@given x))
+                 ((v P (= (iff (? a) (? b)) t))                                 (build.disjoined-modus-ponens @- @--)))))
+ :minatbl ((iff . 2))
+ :highlevel-override (if (equal (@term (? a)) (@term (? b)))
+                         (@derive ((= (iff (? a) (? b)) t)         (build.iff-reflexivity (@term (? a))))
+                                  ((v P (= (iff (? a) (? b)) t))   (build.expansion (@formula P) @-)))
+                       (LOGIC.APPEAL 'BUILD.DISJOINED-IFF-FROM-EQUAL
+                                     (@FORMULA (V P (= (IFF (? A) (? B)) T)))
+                                     (LIST X)
+                                     NIL)))
+
+
+
+
+;; Note: we leave build.equiv-reflexivity enabled
+
+(defun build.equiv-reflexivity (x iffp)
+  (declare (xargs :guard (and (logic.termp x)
+                              (booleanp iffp))))
+  (if iffp
+      (build.iff-reflexivity x)
+    (build.equal-reflexivity x)))
+
+(in-theory (disable (:executable-counterpart build.equiv-reflexivity)))
+
+(defobligations build.equiv-reflexivity
+  (build.iff-reflexivity build.equal-reflexivity))
+
+
+(dd.close)
+
+
+
+
+;; OLD JUNK ---------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+;; (deftheorem theorem-iff-lhs-t-base
+;;   :derive (= (iff t x) (if x t nil))
+;;   :proof  (@derive
+;;            ((= (iff x y) (if x (if y t nil) (if y nil t)))                   (build.axiom (definition-of-iff)))
+;;            ((= (iff t x) (if t (if x t nil) (if x nil t)))                   (build.instantiation @- (@sigma (x . t) (y . x))))
+;;            ((= (if t (if x t nil) (if x nil t)) (if x t nil))                (build.if-of-t (@term (if x t nil)) (@term (if x nil t))))
+;;            ((= (iff t x) (if x t nil))                                       (build.transitivity-of-pequal @-- @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+;; (deftheorem theorem-iff-rhs-t-base
+;;  :derive (= (iff x t) (if x t nil))
+;;  :proof  (@derive
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                    (build.axiom (definition-of-iff)))
+;;           ((= (iff x t) (if x (if t t nil) (if t nil t)))                    (build.instantiation @- (@sigma (y . t)))   *1)
+;;           ((= x x)                                                           (build.reflexivity (@term x))  *2a)
+;;           ((= (if t t nil) t)                                                (build.if-of-t (@term t) (@term nil)) *2b)
+;;           ((= (if t nil t) nil)                                              (build.if-of-t (@term nil) (@term t)) *2c)
+;;           ((= (if x (if t t nil) (if t nil t)) (if x t nil))                 (build.pequal-by-args 'if (list *2a *2b *2c)))
+;;           ((= (iff x t) (if x t nil))                                        (build.transitivity-of-pequal *1 @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-lhs-nil-base
+;;   :derive (= (iff nil x) (if x nil t))
+;;   :proof  (@derive
+;;            ((= (iff x y) (if x (if y t nil) (if y nil t)))                    (build.axiom (definition-of-iff)))
+;;            ((= (iff nil x) (if nil (if x t nil) (if x nil t)))                (build.instantiation @- (@sigma (x . nil) (y . x))) *1)
+;;            ((= (if nil (if x t nil) (if x nil t)) (if x nil t))               (build.if-of-nil (@term (if x t nil)) (@term (if x nil t))))
+;;            ((= (if nil x) (if x nil t))                                       (build.transitivity-of-pequal @-- @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+;; (deftheorem theorem-iff-rhs-nil-base
+;;   :derive (= (iff x nil) (if x nil t))
+;;   :proof (@derive
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                    (build.axiom (definition-of-iff)))
+;;           ((= (iff x nil) (if x (if nil t nil) (if nil nil t)))              (build.instantiation @- (@sigma (y . nil)))   *1)
+;;           ((= x x)                                                           (build.reflexivity (@term x))  *2a)
+;;           ((= (if nil t nil) nil)                                            (build.if-of-nil (@term t) (@term nil)) *2b)
+;;           ((= (if nil nil t) t)                                              (build.if-of-nil (@term nil) (@term t)) *2c)
+;;           ((= (if x (if t t nil) (if t nil t)) (if x nil t))                 (build.pequal-by-args 'if (list *2a *2b *2c)))
+;;           ((= (iff x nil) (if x nil t))                                      (build.transitivity-of-pequal *1 @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-move-t-right
+;;   :derive (= (iff t x) (iff x t))
+;;   :proof  (@derive
+;;            ((= (iff x t) (if x t nil))    (build.theorem (theorem-iff-rhs-t-base)))
+;;            ((= (if x t nil) (iff x t))    (build.commute-pequal @-))
+;;            ((= (iff t x) (if x t nil))    (build.theorem (theorem-iff-lhs-t-base)))
+;;            ((= (iff t x) (iff x t))       (build.transitivity-of-pequal @- @--)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+;; (deftheorem theorem-iff-move-nil-right
+;;   :derive (= (iff nil x) (iff x nil))
+;;   :proof  (@derive
+;;            ((= (iff x nil) (if x nil t))    (build.theorem (theorem-iff-rhs-nil-base)))
+;;            ((= (if x nil t) (iff x nil))    (build.commute-pequal @-))
+;;            ((= (iff nil x) (if x nil t))    (build.theorem (theorem-iff-lhs-nil-base)))
+;;            ((= (iff nil x) (iff x nil))     (build.transitivity-of-pequal @- @--)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;; (deftheorem theorem-iff-lhs-t-1
+;;   :derive (v (= x nil) (= (iff t x) t))
+;;   :proof (@derive
+;;           ((= (iff t x) (if x t nil))                                       (build.theorem (theorem-iff-lhs-t-base)))
+;;           ((v (= x nil) (= (iff t x) (if x t nil)))                         (build.expansion (@formula (= x nil)) @-)  *1)
+;;           ((v (!= x nil) (= x nil))                                         (build.propositional-schema (@formula (= x nil))))
+;;           ((v (= x nil) (!= x nil))                                         (build.commute-or @-))
+;;           ((v (= x nil) (= (if x t nil) t))                                 (build.disjoined-if-when-not-nil @- (@term t) (@term nil)))
+;;           ((v (= x nil) (= (iff t x) t))                                    (build.disjoined-transitivity-of-pequal *1 @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+;; (deftheorem theorem-iff-rhs-t-1
+;;   :derive (v (= x nil) (= (iff x t) t))
+;;   :proof (@derive
+;;           ((= (iff x t) (if x t nil))                                       (build.theorem (theorem-iff-rhs-t-base)))
+;;           ((v (= x nil) (= (iff x t) (if x t nil)))                         (build.expansion (@formula (= x nil)) @-)  *1)
+;;           ((v (!= x nil) (= x nil))                                         (build.propositional-schema (@formula (= x nil))))
+;;           ((v (= x nil) (!= x nil))                                         (build.commute-or @-))
+;;           ((v (= x nil) (= (if x t nil) t))                                 (build.disjoined-if-when-not-nil @- (@term t) (@term nil)))
+;;           ((v (= x nil) (= (iff x t) t))                                    (build.disjoined-transitivity-of-pequal *1 @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+
+;; (deftheorem theorem-iff-lhs-t-2
+;;   :derive (v (!= x nil) (= (iff t x) nil))
+;;   :proof (@derive
+;;           ((= (iff t x)  (if x t nil))                                       (build.theorem (theorem-iff-lhs-t-base)))
+;;           ((v (!= x nil) (= (iff t x) (if x t nil)))                         (build.expansion (@formula (!= x nil)) @-)  *1)
+;;           ((v (!= x nil) (= x nil))                                          (build.propositional-schema (@formula (= x nil))))
+;;           ((v (!= x nil) (= (if x t nil) nil))                               (build.disjoined-if-when-nil @- (@term t) (@term nil)))
+;;           ((v (!= x nil) (= (iff t x) nil))                                  (build.disjoined-transitivity-of-pequal *1 @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+;; (deftheorem theorem-iff-rhs-t-2
+;;   :derive (v (!= x nil) (= (iff x t) nil))
+;;   :proof (@derive
+;;           ((= (iff x t) (if x t nil))                                        (build.theorem (theorem-iff-rhs-t-base)))
+;;           ((v (!= x nil) (= (iff x t) (if x t nil)))                         (build.expansion (@formula (!= x nil)) @-)  *1)
+;;           ((v (!= x nil) (= x nil))                                          (build.propositional-schema (@formula (= x nil))))
+;;           ((v (!= x nil) (= (if x t nil) nil))                               (build.disjoined-if-when-nil @- (@term t) (@term nil)))
+;;           ((v (!= x nil) (= (iff x t) nil))                                  (build.disjoined-transitivity-of-pequal *1 @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+
+
+;; (defderiv build.intro-iff-rhs-t-1
+;;   :derive (= (iff (? a) t) t)
+;;   :from   ((proof x (!= (? a) nil)))
+;;   :proof  (@derive
+;;            ((v (= x nil) (= (iff x t) t))          (build.theorem (theorem-iff-rhs-t-1)))
+;;            ((v (= (? a) nil) (= (iff (? a) t) t))  (build.instantiation @- (@sigma (x . (? a)))))
+;;            ((!= (? a) nil)                         (@given x))
+;;            ((= (iff (? a) t) t)                    (build.modus-ponens-2 @- @--)))
+;;   :minatbl ((iff . 2)))
+
+;; (defderiv build.disjoined-intro-iff-rhs-t-1
+;;   :derive (v P (= (iff (? a) t) t))
+;;   :from   ((proof x (v P (!= (? a) nil))))
+;;   :proof  (@derive
+;;            ((v (= x nil) (= (iff x t) t))               (build.theorem (theorem-iff-rhs-t-1)))
+;;            ((v (= (? a) nil) (= (iff (? a) t) t))       (build.instantiation @- (@sigma (x . (? a)))))
+;;            ((v P (v (= (? a) nil) (= (iff (? a) t) t))) (build.expansion (@formula P) @-))
+;;            ((v P (!= (? a) nil))                        (@given x))
+;;            ((v P (= (iff (? a) t) t))                   (build.disjoined-modus-ponens-2 @- @--)))
+;;   :minatbl ((iff . 2)))
+
+;; (defderiv build.elim-iff-rhs-t-2
+;;   :derive (!= (? a) nil)
+;;   :from   ((proof x (!= (iff (? a) t) nil)))
+;;   :proof  (@derive
+;;            ((v (!= x nil) (= (iff x t) nil))          (build.theorem (theorem-iff-rhs-t-2)))
+;;            ((v (!= (? a) nil) (= (iff (? a) t) nil))  (build.instantiation @- (@sigma (x . (? a)))))
+;;            ((v (= (iff (? a) t) nil) (!= (? a) nil))  (build.commute-or @-))
+;;            ((!= (iff (? a) t) nil)                    (@given x))
+;;            ((!= (? a) nil)                            (build.modus-ponens-2 @- @--))))
+
+;; (defderiv build.disjoined-elim-iff-rhs-t-2
+;;   :derive (v P (!= (? a) nil))
+;;   :from   ((proof x (v P (!= (iff (? a) t) nil))))
+;;   :proof  (@derive
+;;            ((v (!= x nil) (= (iff x t) nil))                (build.theorem (theorem-iff-rhs-t-2)))
+;;            ((v (!= (? a) nil) (= (iff (? a) t) nil))        (build.instantiation @- (@sigma (x . (? a)))))
+;;            ((v (= (iff (? a) t) nil) (!= (? a) nil))        (build.commute-or @-))
+;;            ((v P (v (= (iff (? a) t) nil) (!= (? a) nil)))  (build.expansion (@formula P) @-))
+;;            ((v P (!= (iff (? a) t) nil))                    (@given x))
+;;            ((v P (!= (? a) nil))                            (build.disjoined-modus-ponens-2 @- @--))))
+
+
+
+
+
+;; (deftheorem theorem-iff-rhs-nil-1
+;;    :derive (v (= x nil) (= (iff x nil) nil))
+;;    :proof  (@derive
+;;             ((= (iff x nil) (if x nil t))                   (build.theorem (theorem-iff-rhs-nil-base)))
+;;             ((v (= x nil) (= (iff x nil) (if x nil t)))     (build.expansion (@formula (= x nil)) @-) *1)
+;;             ((v (!= x nil) (= x nil))                       (build.propositional-schema (@formula (= x nil))))
+;;             ((v (= x nil) (!= x nil))                       (build.commute-or @-))
+;;             ((v (= x nil) (= (if x nil t) t))               (build.disjoined-if-when-not-nil @- (@term nil) (@term t)))
+;;             ((v (= x nil) (= (iff x nil) t))                (build.disjoined-transitivity-of-pequal *1 @-)))
+;;    :minatbl ((if . 3)
+;;              (iff . 2)))
+
+;; (deftheorem theorem-iff-rhs-nil-1
+;;    :derive (v (= x nil) (= (iff x nil) nil))
+;;    :proof  (@derive
+;;             ((= (iff x nil) (if x nil t))                   (build.theorem (theorem-iff-rhs-nil-base)))
+;;             ((v (= x nil) (= (iff x nil) (if x nil t)))     (build.expansion (@formula (= x nil)) @-) *1)
+;;             ((v (!= x nil) (= x nil))                       (build.propositional-schema (@formula (= x nil))))
+;;             ((v (= x nil) (!= x nil))                       (build.commute-or @-))
+;;             ((v (= x nil) (= (if x nil t) t))               (build.disjoined-if-when-not-nil @- (@term nil) (@term t)))
+;;             ((v (= x nil) (= (iff x nil) t))                (build.disjoined-transitivity-of-pequal *1 @-)))
+;;    :minatbl ((if . 3)
+;;              (iff . 2)))
+
+;; (deftheorem theorem-iff-rhs-nil-2
+;;    :derive (v (!= x nil) (= (iff x nil) t))
+;;    :proof  (@derive
+;;             ((= (iff x nil) (if x nil t))                   (build.theorem (theorem-iff-rhs-nil-base)))
+;;             ((v (!= x nil) (= (iff x nil) (if x nil t)))    (build.expansion (@formula (!= x nil)) @-) *1)
+;;             ((v (!= x nil) (= x nil))                       (build.propositional-schema (@formula (= x nil))))
+;;             ((v (!= x nil) (= (if x nil t) t))              (build.disjoined-if-when-nil @- (@term nil) (@term t)))
+;;             ((v (!= x nil) (= (iff x nil) t))               (build.disjoined-transitivity-of-pequal *1 @-)))
+;;    :minatbl ((if . 3)
+;;              (iff . 2)))
+
+
+;; (defderiv build.elim-iff-rhs-nil-pequal-nil-from-iff-nil
+;;   :derive (= (? a) nil)
+;;   :from   ((proof x (!= (iff (? a) nil) nil)))
+;;   :proof  (@derive
+;;            ((v (= x nil) (= (iff x nil) nil))          (build.theorem (theorem-iff-nil-when-not-nil)))
+;;            ((v (= (? a) nil) (= (iff (? a) nil) nil))  (build.instantiation @- (@sigma (x . (? a)))))
+;;            ((v (= (iff (? a) nil) nil) (= (? a) nil))  (build.commute-or @-))
+;;            ((!= (iff (? a) nil) nil)                   (@given x))
+;;            ((= (? a) nil)                              (build.modus-ponens-2 @- @--))))
+
+;; (defderiv build.disjoined-pequal-nil-from-iff-nil
+;;   :derive (v P (= (? a) nil))
+;;   :from   ((proof x (v P (!= (iff (? a) nil) nil))))
+;;   :proof  (@derive
+;;            ((v (= x nil) (= (iff x nil) nil))                 (build.theorem (theorem-iff-nil-when-not-nil)))
+;;            ((v (= (? a) nil) (= (iff (? a) nil) nil))         (build.instantiation @- (@sigma (x . (? a)))))
+;;            ((v (= (iff (? a) nil) nil) (= (? a) nil))         (build.commute-or @-))
+;;            ((v P (v (= (iff (? a) nil) nil) (= (? a) nil)))   (build.expansion (@formula P) @-))
+;;            ((v P (!= (iff (? a) nil) nil))                    (@given x))
+;;            ((v P (= (? a) nil))                               (build.disjoined-modus-ponens-2 @- @--))))
+
+
+
+
+
+
+
+
+;; (deftheorem theorem-iff-t-when-nil-rhs
+;;   :derive (v (!= x nil) (= (iff x t) nil))
+;;   :proof (@derive
+;;           ((= (iff x nil)
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                    (build.axiom (definition-of-iff)))
+;;           ((= (iff x t) (if x (if t t nil) (if t nil t)))                    (build.instantiation @- (@sigma (y . t)))   *1)
+;;           ;; ---
+;;           ((= x x)                                                           (build.reflexivity (@term x))  *2a)
+;;           ((= (if t t nil) t)                                                (build.if-of-t (@term t) (@term nil)) *2b)
+;;           ((= (if t nil t) nil)                                              (build.if-of-t (@term nil) (@term t)) *2c)
+;;           ((= (if x (if t t nil) (if t nil t)) (if x t nil))                 (build.pequal-by-args 'if (list *2a *2b *2c)))
+;;           ((= (iff x t) (if x t nil))                                        (build.transitivity-of-pequal *1 @-))
+;;           ((v (!= x nil) (= (iff x t) (if x t nil)))                         (build.expansion (@formula (!= x nil)) @-)  *2)
+;;           ;; ---
+;;           ((v (!= x nil) (= x nil))                                          (build.propositional-schema (@formula (= x nil))))
+;;           ((v (!= x nil) (= (if x t nil) nil))                               (build.disjoined-if-when-nil @- (@term t) (@term nil)))
+;;           ((v (!= x nil) (= (iff x t) nil))                                  (build.disjoined-transitivity-of-pequal *2 @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+
+;;  :proof  (@derive
+;;           ((v (= x nil) (= (if x y z) y))             (build.axiom (axiom-if-when-not-nil)))
+;;           ((v (= x nil) (= (if x t nil) t))           (build.instantiation @- (@sigma (y . t) (z . nil))))
+;;           ((v (= x nil) (= t (if x t nil)))           (build.disjoined-commute-pequal @-))
+;;           ((v (= x nil) (= (iff x t) t))              (build.theorem (theorem-iff-t-when-not-nil)))
+;;           ((v (= x nil) (= (iff x t) (if x t nil)))   (build.disjoined-transitivity-of-pequal @- @--)  *1)
+;;           ;; ---
+;;           ((v (!= x nil) (= (if x y z) z))            (build.axiom (axiom-if-when-nil)))
+;;           ((v (!= x nil) (= (if x t nil) nil))        (build.instantiation @- (@sigma (y . t) (z . nil))))
+;;           ((v (!= x nil) (= nil (if x t nil)))        (build.disjoined-commute-pequal @-))
+;;           ((v (!= x nil) (= (iff x t) nil))           (build.theorem (theorem-iff-t-when-nil)))
+;;           ((v (!= x nil) (= (iff x t) (if x t nil)))  (build.disjoined-transitivity-of-pequal @- @--)  *2)
+;;           ;; ---
+;;           ((v (= (iff x t) (if x t nil))
+;;               (= (iff x t) (if x t nil)))             (build.cut *1 *2))
+;;           ((= (iff x t) (if x t nil))                 (build.contraction @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-of-nil
+;;  :derive (= (iff x nil) (equal x nil))
+;;  :proof  (@derive
+;;           ((v (= x y)   (= (equal x y) nil))             (build.axiom (axiom-equal-when-diff)))
+;;           ((v (= x nil) (= (equal x nil) nil))           (build.instantiation @- (@sigma (y . nil))))
+;;           ((v (= x nil) (= nil (equal x nil)))           (build.disjoined-commute-pequal @-))
+;;           ((v (= x nil) (= (iff x nil) nil))             (build.theorem (theorem-iff-nil-when-not-nil)))
+;;           ((v (= x nil) (= (iff x nil) (equal x nil)))   (build.disjoined-transitivity-of-pequal @- @--)  *1)
+;;           ;; ---
+;;           ((v (!= x y)   (= (equal x y) t))              (build.axiom (axiom-equal-when-same)))
+;;           ((v (!= x nil) (= (equal x nil) t))            (build.instantiation @- (@sigma (y . nil))))
+;;           ((v (!= x nil) (= t (equal x nil)))            (build.disjoined-commute-pequal @-))
+;;           ((v (!= x nil) (= (iff x nil) t))              (build.theorem (theorem-iff-nil-when-nil)))
+;;           ((v (!= x nil) (= (iff x nil) (equal x nil)))  (build.disjoined-transitivity-of-pequal @- @--)  *2)
+;;           ;; ---
+;;           ((v (= (iff x nil) (equal x nil))
+;;               (= (iff x nil) (equal x nil)))             (build.cut *1 *2))
+;;           ((= (iff x nil) (equal x nil))                 (build.contraction @-)))
+;;  :minatbl ((equal . 2)
+;;            (iff . 2)))
+
+
+
+
+
+
+;; (deftheorem theorem-if-of-t
+;; (= (iff x t) (if x t nil)
+
+
+;; (deftheorem theorem-iff-t-when-nil
+;;   :derive (v (!= x nil) (= (iff x t) nil))
+;;   :proof (@derive
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                    (build.axiom (definition-of-iff)))
+;;           ((= (iff x t) (if x (if t t nil) (if t nil t)))                    (build.instantiation @- (@sigma (y . t)))   *1)
+;;           ;; ---
+;;           ((= x x)                                                           (build.reflexivity (@term x))  *2a)
+;;           ((= (if t t nil) t)                                                (build.if-of-t (@term t) (@term nil)) *2b)
+;;           ((= (if t nil t) nil)                                              (build.if-of-t (@term nil) (@term t)) *2c)
+;;           ((= (if x (if t t nil) (if t nil t)) (if x t nil))                 (build.pequal-by-args 'if (list *2a *2b *2c)))
+;;           ((= (iff x t) (if x t nil))                                        (build.transitivity-of-pequal *1 @-))
+;;           ((v (!= x nil) (= (iff x t) (if x t nil)))                         (build.expansion (@formula (!= x nil)) @-)  *2)
+;;           ;; ---
+;;           ((v (!= x nil) (= x nil))                                          (build.propositional-schema (@formula (= x nil))))
+;;           ((v (!= x nil) (= (if x t nil) nil))                               (build.disjoined-if-when-nil @- (@term t) (@term nil)))
+;;           ((v (!= x nil) (= (iff x t) nil))                                  (build.disjoined-transitivity-of-pequal *2 @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+
+
+
+;; (deftheorem theorem-iff-t-when-not-nil
+;;   :derive (v (= x nil) (= (iff x t) t))
+;;   :proof  (@derive
+;;            ((= (iff x y) (if x (if y t nil) (if y nil t)))                    (build.axiom (definition-of-iff)))
+;;            ((= (iff x t) (if x (if t t nil) (if t nil t)))                    (build.instantiation @- (@sigma (y . t))))
+;;            ((v (= x nil) (= (iff x t) (if x (if t t nil) (if t nil t))))      (build.expansion (@formula (= x nil)) @-)                                *1)
+;;            ;; ---
+;;            ((v (= x nil) (= (if x y z) y))                                    (build.axiom (axiom-if-when-not-nil)))
+;;            ((v (= x nil) (= (if x (if t t nil) (if t nil t)) (if t t nil)))   (build.instantiation @- (@sigma (y . (if t t nil)) (z . (if t nil t))))  *2)
+;;            ;; ---
+;;            ((= (if t y z) y)                                                  (build.theorem (theorem-if-redux-t)))
+;;            ((= (if t t nil) t)                                                (build.instantiation @- (@sigma (y . t) (z . nil))))
+;;            ((v (= x nil) (= (if t t nil) t))                                  (build.expansion (@formula (= x nil)) @-))
+;;            ((v (= x nil) (= (if x (if t t nil) (if t nil t)) t))              (build.disjoined-transitivity-of-pequal *2 @-))
+;;            ((v (= x nil) (= (iff x t) t))                                     (build.disjoined-transitivity-of-pequal *1 @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+
+;; (deftheorem theorem-iff-nil-when-nil
+;;  :derive (v (!= x nil) (= (iff x nil) t))
+;;  :proof  (@derive
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                            (build.axiom (definition-of-iff)))
+;;           ((= (iff x nil) (if x (if nil t nil) (if nil nil t)))                      (build.instantiation @- (@sigma (y . nil))))
+;;           ((v (!= x nil) (= (iff x nil) (if x (if nil t nil) (if nil nil t))))       (build.expansion (@formula (!= x nil)) @-)                                   *1)
+;;           ;; ---
+;;           ((v (!= x nil) (= (if x y z) z))                                           (build.axiom (axiom-if-when-nil)))
+;;           ((v (!= x nil) (= (if x (if nil t nil) (if nil nil t)) (if nil nil t)))    (build.instantiation @- (@sigma (y . (if nil t nil)) (z . (if nil nil t))))  *2)
+;;           ;; ---
+;;           ((= (if nil y z) z)                                                        (build.theorem (theorem-if-redux-nil)))
+;;           ((= (if nil nil t) t)                                                      (build.instantiation @- (@sigma (y . nil) (z . t))))
+;;           ((v (!= x nil) (= (if nil nil t) t))                                       (build.expansion (@formula (!= x nil)) @-))
+;;           ((v (!= x nil) (= (if x (if nil t nil) (if nil nil t)) t))                 (build.disjoined-transitivity-of-pequal *2 @-))
+;;           ((v (!= x nil) (= (iff x nil) t))                                          (build.disjoined-transitivity-of-pequal *1 @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-nil-when-not-nil
+;;  :derive (v (= x nil) (= (iff x nil) nil))
+;;  :proof  (@derive
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                           (build.axiom (definition-of-iff)))
+;;           ((= (iff x nil) (if x (if nil t nil) (if nil nil t)))                     (build.instantiation @- (@sigma (y . nil))))
+;;           ((v (= x nil) (= (iff x nil) (if x (if nil t nil) (if nil nil t))))       (build.expansion (@formula (= x nil)) @-)                                    *1)
+;;           ;; ---
+;;           ((v (= x nil) (= (if x y z) y))                                           (build.axiom (axiom-if-when-not-nil)))
+;;           ((v (= x nil) (= (if x (if nil t nil) (if nil nil t)) (if nil t nil)))    (build.instantiation @- (@sigma (y . (if nil t nil)) (z . (if nil nil t))))  *2)
+;;           ;; ---
+;;           ((= (if nil y z) z)                                                       (build.theorem (theorem-if-redux-nil)))
+;;           ((= (if nil t nil) nil)                                                   (build.instantiation @- (@sigma (y . t) (z . nil))))
+;;           ((v (= x nil) (= (if nil t nil) nil))                                     (build.expansion (@formula (= x nil)) @-))
+;;           ((v (= x nil) (= (if x (if nil t nil) (if nil nil t)) nil))               (build.disjoined-transitivity-of-pequal *2 @-))
+;;           ((v (= x nil) (= (iff x nil) nil))                                        (build.disjoined-transitivity-of-pequal *1 @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (defderiv build.pequal-nil-from-iff-nil
+;;   :derive (= (? a) nil)
+;;   :from   ((proof x (!= (iff (? a) nil) nil)))
+;;   :proof  (@derive
+;;            ((v (= x nil) (= (iff x nil) nil))          (build.theorem (theorem-iff-nil-when-not-nil)))
+;;            ((v (= (? a) nil) (= (iff (? a) nil) nil))  (build.instantiation @- (@sigma (x . (? a)))))
+;;            ((v (= (iff (? a) nil) nil) (= (? a) nil))  (build.commute-or @-))
+;;            ((!= (iff (? a) nil) nil)                   (@given x))
+;;            ((= (? a) nil)                              (build.modus-ponens-2 @- @--))))
+
+;; (defderiv build.disjoined-pequal-nil-from-iff-nil
+;;   :derive (v P (= (? a) nil))
+;;   :from   ((proof x (v P (!= (iff (? a) nil) nil))))
+;;   :proof  (@derive
+;;            ((v (= x nil) (= (iff x nil) nil))                 (build.theorem (theorem-iff-nil-when-not-nil)))
+;;            ((v (= (? a) nil) (= (iff (? a) nil) nil))         (build.instantiation @- (@sigma (x . (? a)))))
+;;            ((v (= (iff (? a) nil) nil) (= (? a) nil))         (build.commute-or @-))
+;;            ((v P (v (= (iff (? a) nil) nil) (= (? a) nil)))   (build.expansion (@formula P) @-))
+;;            ((v P (!= (iff (? a) nil) nil))                    (@given x))
+;;            ((v P (= (? a) nil))                               (build.disjoined-modus-ponens-2 @- @--))))
+
+;; (deftheorem theorem-iff-when-not-nil-and-not-nil
+;;  :derive (v (= x nil) (v (= y nil) (= (iff x y) t)))
+;;  :proof  (@derive
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                     (build.axiom (definition-of-iff)))
+;;           ((v (= x nil) (= (iff x y) (if x (if y t nil) (if y nil t))))       (build.expansion (@formula (= x nil)) @-)                                *1)
+;;           ;; ---
+;;           ((v (= x nil) (= (if x y z) y))                                     (build.axiom (axiom-if-when-not-nil))                                    *2)
+;;           ((v (= x nil) (= (if x (if y t nil) (if y nil t)) (if y t nil)))    (build.instantiation @- (@sigma (y . (if y t nil)) (z . (if y nil t)))))
+;;           ((v (= x nil) (= (iff x y) (if y t nil)))                           (build.disjoined-transitivity-of-pequal *1 @-))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x y) (if x t nil)))             (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil)))         *3)
+;;           ;; ---
+;;           ((v (= y nil) (= (if y t nil) t))                                   (build.instantiation *2 (@sigma (x . y) (y . t) (z . nil))))
+;;           ((v (v (= x nil) (= y nil)) (= (if y t nil) t))                     (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil))))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x y) t))                        (build.disjoined-transitivity-of-pequal *3 @-))
+;;           ((v (= x nil) (v (= y nil) (= (iff x y) t)))                        (build.right-associativity @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-when-not-nil-and-nil
+;;  :derive (v (= x nil) (v (!= y nil) (= (iff x y) nil)))
+;;  :proof (@derive
+;;          ((= (iff x y) (if x (if y t nil) (if y nil t)))                     (build.axiom (definition-of-iff)))
+;;          ((v (= x nil) (= (iff x y) (if x (if y t nil) (if y nil t))))       (build.expansion (@formula (= x nil)) @-)                                *1)
+;;          ;; ---
+;;          ((v (= x nil) (= (if x y z) y))                                     (build.axiom (axiom-if-when-not-nil)))
+;;          ((v (= x nil) (= (if x (if y t nil) (if y nil t)) (if y t nil)))    (build.instantiation @- (@sigma (y . (if y t nil)) (z . (if y nil t)))))
+;;          ((v (= x nil) (= (iff x y) (if y t nil)))                           (build.disjoined-transitivity-of-pequal *1 @-))
+;;          ((v (v (= x nil) (!= y nil)) (= (iff x y) (if y t nil)))            (build.multi-assoc-expansion @- (@formulas (= x nil) (!= y nil)))        *2)
+;;          ;; ---
+;;          ((v (!= x nil) (= (if x y z) z))                                    (build.axiom (axiom-if-when-nil)))
+;;          ((v (!= y nil) (= (if y t nil) nil))                                (build.instantiation @- (@sigma (x . y) (y . t) (z . nil))))
+;;          ((v (v (= x nil) (!= y nil)) (= (if y t nil) nil))                  (build.multi-assoc-expansion @- (@formulas (= x nil) (!= y nil))))
+;;          ((v (v (= x nil) (!= y nil)) (= (iff x y) nil))                     (build.disjoined-transitivity-of-pequal *2 @-))
+;;          ((v (= x nil) (v (!= y nil) (= (iff x y) nil)))                     (build.right-associativity @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-when-nil-and-not-nil
+;;  :derive (v (!= x nil) (v (= y nil) (= (iff x y) nil)))
+;;  :proof  (@derive
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                      (build.axiom (definition-of-iff)))
+;;           ((v (!= x nil) (= (iff x y) (if x (if y t nil) (if y nil t))))       (build.expansion (@formula (!= x nil)) @-)                               *1)
+;;           ;; ---
+;;           ((v (!= x nil) (= (if x y z) z))                                     (build.axiom (axiom-if-when-nil)))
+;;           ((v (!= x nil) (= (if x (if y t nil) (if y nil t)) (if y nil t)))    (build.instantiation @- (@sigma (y . (if y t nil)) (z . (if y nil t)))))
+;;           ((v (!= x nil) (= (iff x y) (if y nil t)))                           (build.disjoined-transitivity-of-pequal *1 @-))
+;;           ((v (v (!= x nil) (= y nil)) (= (iff x y) (if y nil t)))             (build.multi-assoc-expansion @- (@formulas (!= x nil) (= y nil)))        *2)
+;;           ;; ---
+;;           ((v (= x nil) (= (if x y z) y))                                      (build.axiom (axiom-if-when-not-nil)))
+;;           ((v (= y nil) (= (if y nil t) nil))                                  (build.instantiation @- (@sigma (x . y) (y . nil) (z . t))))
+;;           ((v (v (!= x nil) (= y nil)) (= (if y nil t) nil))                   (build.multi-assoc-expansion @- (@formulas (!= x nil) (= y nil))))
+;;           ((v (v (!= x nil) (= y nil)) (= (iff x y) nil))                      (build.disjoined-transitivity-of-pequal *2 @-))
+;;           ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))                      (build.right-associativity @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-when-nil-and-nil
+;;  :derive (v (!= x nil) (v (!= y nil) (= (iff x y) t)))
+;;  :proof  (@derive
+;;           ((= (iff x y) (if x (if y t nil) (if y nil t)))                      (build.axiom (definition-of-iff)))
+;;           ((v (!= x nil) (= (iff x y) (if x (if y t nil) (if y nil t))))       (build.expansion (@formula (!= x nil)) @-)                               *1)
+;;           ;; ---
+;;           ((v (!= x nil) (= (if x y z) z))                                     (build.axiom (axiom-if-when-nil))                                        *2)
+;;           ((v (!= x nil) (= (if x (if y t nil) (if y nil t)) (if y nil t)))    (build.instantiation @- (@sigma (y . (if y t nil)) (z . (if y nil t)))))
+;;           ((v (!= x nil) (= (iff x y) (if y nil t)))                           (build.disjoined-transitivity-of-pequal *1 @-))
+;;           ((v (v (!= x nil) (!= y nil)) (= (iff x y) (if y nil t)))            (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= y nil)))       *3)
+;;           ;; ---
+;;           ((v (!= y nil) (= (if y nil t) t))                                   (build.instantiation *2 (@sigma (x . y) (y . nil) (z . t))))
+;;           ((v (v (!= x nil) (!= y nil)) (= (if y nil t) t))                    (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= y nil))))
+;;           ((v (v (!= x nil) (!= y nil)) (= (iff x y) t))                       (build.disjoined-transitivity-of-pequal *3 @-))
+;;           ((v (!= x nil) (v (!= y nil) (= (iff x y) t)))                       (build.right-associativity @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-of-nil
+;;  :derive (= (iff x nil) (equal x nil))
+;;  :proof  (@derive
+;;           ((v (= x y)   (= (equal x y) nil))             (build.axiom (axiom-equal-when-diff)))
+;;           ((v (= x nil) (= (equal x nil) nil))           (build.instantiation @- (@sigma (y . nil))))
+;;           ((v (= x nil) (= nil (equal x nil)))           (build.disjoined-commute-pequal @-))
+;;           ((v (= x nil) (= (iff x nil) nil))             (build.theorem (theorem-iff-nil-when-not-nil)))
+;;           ((v (= x nil) (= (iff x nil) (equal x nil)))   (build.disjoined-transitivity-of-pequal @- @--)  *1)
+;;           ;; ---
+;;           ((v (!= x y)   (= (equal x y) t))              (build.axiom (axiom-equal-when-same)))
+;;           ((v (!= x nil) (= (equal x nil) t))            (build.instantiation @- (@sigma (y . nil))))
+;;           ((v (!= x nil) (= t (equal x nil)))            (build.disjoined-commute-pequal @-))
+;;           ((v (!= x nil) (= (iff x nil) t))              (build.theorem (theorem-iff-nil-when-nil)))
+;;           ((v (!= x nil) (= (iff x nil) (equal x nil)))  (build.disjoined-transitivity-of-pequal @- @--)  *2)
+;;           ;; ---
+;;           ((v (= (iff x nil) (equal x nil))
+;;               (= (iff x nil) (equal x nil)))             (build.cut *1 *2))
+;;           ((= (iff x nil) (equal x nil))                 (build.contraction @-)))
+;;  :minatbl ((equal . 2)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-of-t
+;;  :derive (= (iff x t) (if x t nil))
+;;  :proof  (@derive
+;;           ((v (= x nil) (= (if x y z) y))             (build.axiom (axiom-if-when-not-nil)))
+;;           ((v (= x nil) (= (if x t nil) t))           (build.instantiation @- (@sigma (y . t) (z . nil))))
+;;           ((v (= x nil) (= t (if x t nil)))           (build.disjoined-commute-pequal @-))
+;;           ((v (= x nil) (= (iff x t) t))              (build.theorem (theorem-iff-t-when-not-nil)))
+;;           ((v (= x nil) (= (iff x t) (if x t nil)))   (build.disjoined-transitivity-of-pequal @- @--)  *1)
+;;           ;; ---
+;;           ((v (!= x nil) (= (if x y z) z))            (build.axiom (axiom-if-when-nil)))
+;;           ((v (!= x nil) (= (if x t nil) nil))        (build.instantiation @- (@sigma (y . t) (z . nil))))
+;;           ((v (!= x nil) (= nil (if x t nil)))        (build.disjoined-commute-pequal @-))
+;;           ((v (!= x nil) (= (iff x t) nil))           (build.theorem (theorem-iff-t-when-nil)))
+;;           ((v (!= x nil) (= (iff x t) (if x t nil)))  (build.disjoined-transitivity-of-pequal @- @--)  *2)
+;;           ;; ---
+;;           ((v (= (iff x t) (if x t nil))
+;;               (= (iff x t) (if x t nil)))             (build.cut *1 *2))
+;;           ((= (iff x t) (if x t nil))                 (build.contraction @-)))
+;;  :minatbl ((if . 3)
+;;            (iff . 2)))
+
+;; (deftheorem theorem-iff-normalize-t
+;;  :derive (v (= y nil) (= (iff x y) (if x t nil)))
+;;  :proof  (@derive
+;;           ((v (= x nil) (v (= y nil) (= (iff x y) t)))              (build.theorem (theorem-iff-when-not-nil-and-not-nil)))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x y) t))              (build.associativity @-)                                            *1a)
+;;           ((v (= x nil) (= (iff x t) t))                            (build.theorem (theorem-iff-t-when-not-nil)))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x t) t))              (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil))))
+;;           ((v (v (= x nil) (= y nil)) (= t (iff x t)))              (build.disjoined-commute-pequal @-))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x y) (iff x t)))      (build.disjoined-transitivity-of-pequal *1a @-)                *1b)
+;;           ((= (iff x t) (if x t nil))                               (build.theorem (theorem-iff-of-t)))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x t) (if x t nil)))   (build.expansion (@formula (v (= x nil) (= y nil))) @-))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x y) (if x t nil)))   (build.disjoined-transitivity-of-pequal *1b @-))
+;;           ((v (= x nil) (v (= y nil) (= (iff x y) (if x t nil))))   (build.right-associativity @-)                                 *1)
+;;           ;; ---
+;;           ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))           (build.theorem (theorem-iff-when-nil-and-not-nil)))
+;;           ((v (v (!= x nil) (= y nil)) (= (iff x y) nil))           (build.associativity @-)                                            *2a)
+;;           ((v (!= x nil) (= (iff x t) nil))                         (build.theorem (theorem-iff-t-when-nil)))
+;;           ((v (v (!= x nil) (= y nil)) (= (iff x t) nil))           (build.multi-assoc-expansion @- (@formulas (!= x nil) (= y nil))))
+;;           ((v (v (!= x nil) (= y nil)) (= nil (iff x t)))           (build.disjoined-commute-pequal @-))
+;;           ((v (v (!= x nil) (= y nil)) (= (iff x y) (iff x t)))     (build.disjoined-transitivity-of-pequal *2a @-)                *2b)
+;;           ((= (iff x t) (if x t nil))                               (build.theorem (theorem-iff-of-t)))
+;;           ((v (v (!= x nil) (= y nil)) (= (iff x t) (if x t nil)))  (build.expansion (@formula (v (!= x nil) (= y nil))) @-))
+;;           ((v (v (!= x nil) (= y nil)) (= (iff x y) (if x t nil)))  (build.disjoined-transitivity-of-pequal *2b @-))
+;;           ((v (!= x nil) (v (= y nil) (= (iff x y) (if x t nil))))  (build.right-associativity @-)                                 *2)
+;;           ;; ---
+;;           ((v (v (= y nil) (= (iff x y) (if x t nil)))
+;;               (v (= y nil) (= (iff x y) (if x t nil))))             (build.cut *1 *2))
+;;           ((v (= y nil) (= (iff x y) (if x t nil)))                 (build.contraction @-)))
+;;  :minatbl ((iff . 2)
+;;            (if . 3)))
+
+;; (deftheorem theorem-iff-normalize-nil
+;;  :derive (v (!= y nil) (= (iff x y) (equal x nil)))
+;;  :proof (@derive
+;;          ((= x x)                                        (build.reflexivity 'x))
+;;          ((v (!= y nil) (= x x))                         (build.expansion (@formula (!= y nil)) @-))
+;;          ((v (!= y nil) (= y nil))                       (build.propositional-schema (@formula (= y nil))))
+;;          ((v (!= y nil) (= (iff x y) (iff x nil)))       (build.disjoined-pequal-by-args 'iff (@formula (!= y nil)) (list @-- @-)) *1)
+;;          ((= (iff x nil) (equal x nil))                  (build.theorem (theorem-iff-of-nil)))
+;;          ((v (!= y nil) (= (iff x nil) (equal x nil)))   (build.expansion (@formula (!= y nil)) @-))
+;;          ((v (!= y nil) (= (iff x y) (equal x nil)))     (build.disjoined-transitivity-of-pequal *1 @-)))
+;;  :minatbl ((iff . 2)
+;;            (equal . 2)))
+
+;; (deftheorem theorem-reflexivity-of-iff
+;;   :derive (= (iff x x) t)
+;;   :proof  (@derive
+;;            ((v (= x nil) (= (if x y z) y))                                     (build.axiom (axiom-if-when-not-nil)))
+;;            ((v (= x nil) (= (if x (if x t nil) (if x nil t)) (if x t nil)))    (build.instantiation @- (@sigma (y . (if x t nil)) (z . (if x nil t)))))
+;;            ((v (= x nil) (= (if x t nil) t))                                   (build.instantiation @-- (@sigma (y . t) (z . nil))))
+;;            ((v (= x nil) (= (if x (if x t nil) (if x nil t)) t))               (build.disjoined-transitivity-of-pequal @-- @-)                           *1)
+;;            ;; ---
+;;            ((v (!= x nil) (= (if x y z) z))                                    (build.axiom (axiom-if-when-nil)))
+;;            ((v (!= x nil) (= (if x (if x t nil) (if x nil t)) (if x nil t)))   (build.instantiation @- (@sigma (y . (if x t nil)) (z . (if x nil t)))))
+;;            ((v (!= x nil) (= (if x nil t) t))                                  (build.instantiation @-- (@sigma (y . nil) (z . t))))
+;;            ((v (!= x nil) (= (if x (if x t nil) (if x nil t)) t))              (build.disjoined-transitivity-of-pequal @-- @-)                           *2)
+;;            ;; ---
+;;            ((= (iff x y) (if x (if y t nil) (if y nil t)))                     (build.axiom (definition-of-iff)))
+;;            ((= (iff x x) (if x (if x t nil) (if x nil t)))                     (build.instantiation @- (@sigma (y . x)))                                 *3)
+;;            ((v (= (if x (if x t nil) (if x nil t)) t)
+;;                (= (if x (if x t nil) (if x nil t)) t))                         (build.cut *1 *2))
+;;            ((= (if x (if x t nil) (if x nil t)) t)                             (build.contraction @-))
+;;            ((= (iff x x) t)                                                    (build.transitivity-of-pequal *3 @-)))
+;;   :minatbl ((if . 3)
+;;             (iff . 2)))
+
+;; (defderiv build.iff-reflexivity
+;;   :derive (= (iff (? a) (? a)) t)
+;;   :from   ((term a (? a)))
+;;   :proof  (@derive ((= (iff x x) t)          (build.theorem (theorem-reflexivity-of-iff)))
+;;                    ((= (iff (? a) (? a)) t)  (build.instantiation @- (@sigma (x . (? a))))))
+;;   :minatbl ((iff . 2)))
+
+
+
+;; BOZO This is never used anywhere.  Get rid of it.
+;; (defund build.iff-reflexivity-list (x)
+;;   (declare (xargs :guard (logic.term-listp x)))
+;;   (if (consp x)
+;;       (cons (build.iff-reflexivity (car x))
+;;             (build.iff-reflexivity-list (cdr x)))
+;;     nil))
+
+;; (defobligations build.iff-reflexivity-list
+;;   (build.iff-reflexivity))
+
+;; (encapsulate
+;;  ()
+;;  (local (in-theory (enable build.iff-reflexivity-list)))
+
+;;  (defthm len-of-build.iff-reflexivity-list
+;;    (equal (len (build.iff-reflexivity-list x))
+;;           (len x)))
+
+;;  (defthm forcing-logic.appeal-listp-of-build.iff-reflexivity-list
+;;    (implies (force (logic.term-listp x))
+;;             (equal (logic.appeal-listp (build.iff-reflexivity-list x))
+;;                    t)))
+
+;;  (defthm forcing-logic.strip-conclusions-of-build.iff-reflexivity-list
+;;    (implies (force (logic.term-listp x))
+;;             (equal (logic.strip-conclusions (build.iff-reflexivity-list x))
+;;                    (logic.pequal-list (logic.function-list 'iff (list2-list x x))
+;;                                       (repeat ''t (len x)))))
+;;    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+;;  (defthm@ forcing-logic.proof-listp-of-build.iff-reflexivity-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         ;; ---
+;;                         (logic.term-list-atblp x atbl)
+;;                         (equal (cdr (lookup 'iff atbl)) 2)
+;;                         (@obligations build.iff-reflexivity-list)))
+;;             (equal (logic.proof-listp (build.iff-reflexivity-list x) axioms thms atbl)
+;;                    t))))
+
+
+
+
+
+
+;; (defderiv build.not-equal-from-not-iff
+;;   :derive (!= (equal (? a) (? b)) t)
+;;   :from   ((proof x (!= (iff (? a) (? b)) t)))
+;;   :proof  (@derive ((v (!= (equal x y) t) (= (iff x y) t))                      (build.theorem (theorem-iff-from-equal)))
+;;                    ((v (= (iff x y) t) (!= (equal x y) t))                      (build.commute-or @-))
+;;                    ((v (= (iff (? a) (? b)) t) (!= (equal (? a) (? b)) t))      (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+;;                    ((!= (iff (? a) (? b)) t)                                    (@given x))
+;;                    ((!= (equal (? a) (? b)) t)                                  (build.modus-ponens-2 @- @--)))
+;;   :minatbl ((equal . 2)))
+
+;; (defderiv build.disjoined-not-equal-from-not-iff
+;;  :derive (v P (!= (equal (? a) (? b)) t))
+;;  :from   ((proof x (v P (!= (iff (? a) (? b)) t))))
+;;  :proof  (@derive
+;;           ((v (!= (equal x y) t) (= (iff x y) t))                               (build.theorem (theorem-iff-from-equal)))
+;;           ((v (= (iff x y) t) (!= (equal x y) t))                               (build.commute-or @-))
+;;           ((v (= (iff (? a) (? b)) t) (!= (equal (? a) (? b)) t))               (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+;;           ((v P (v (= (iff (? a) (? b)) t) (!= (equal (? a) (? b)) t)))         (build.expansion (@formula P) @-))
+;;           ((v P (!= (iff (? a) (? b)) t))                                       (@given x))
+;;           ((v P (!= (equal (? a) (? b)) t))                                     (build.disjoined-modus-ponens-2 @- @--)))
+;;  :minatbl ((iff . 2)
+;;            (equal . 2)))
+
+;; (deftheorem theorem-iff-with-nil-or-t
+;;   :derive (v (= (iff x nil) t) (= (iff x t) t))
+;;   :proof  (@derive ((v (= x nil) (= (iff x t) t))                               (build.theorem (theorem-iff-t-when-not-nil)))
+;;                    ((v (!= x nil) (= (iff x nil) t))                            (build.theorem (theorem-iff-nil-when-nil)))
+;;                    ((v (= (iff x t) t) (= (iff x nil) t))                       (build.cut @-- @-))
+;;                    ((v (= (iff x nil) t) (= (iff x t) t))                       (build.commute-or @-)))
+;;   :minatbl ((iff . 2)))
+
+;; (deftheorem theorem-iff-nil-or-t
+;;   :derive (v (= (iff x y) nil)
+;;              (= (iff x y) t))
+;;   :proof (@derive
+;;           ((v (= x nil) (v (= y nil) (= (iff x y) t)))                          (build.theorem (theorem-iff-when-not-nil-and-not-nil)))
+;;           ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))                       (build.theorem (theorem-iff-when-nil-and-not-nil)))
+;;           ((v (v (= y nil) (= (iff x y) t)) (v (= y nil) (= (iff x y) nil)))    (build.cut @-- @-))
+;;           ((v (= y nil) (v (= (iff x y) t) (v (= y nil) (= (iff x y) nil))))    (build.right-associativity @-))
+;;           ((v (= y nil) (v (v (= y nil) (= (iff x y) nil)) (= (iff x y) t)))    (build.disjoined-commute-or @-))
+;;           ((v (= y nil) (v (= y nil) (v (= (iff x y) nil) (= (iff x y) t))))    (build.disjoined-right-associativity @-))
+;;           ((v (v (= y nil) (= y nil)) (v (= (iff x y) nil) (= (iff x y) t)))    (build.associativity @-))
+;;           ((v (v (= (iff x y) nil) (= (iff x y) t)) (v (= y nil) (= y nil)))    (build.commute-or @-))
+;;           ((v (v (= (iff x y) nil) (= (iff x y) t)) (= y nil))                  (build.disjoined-contraction @-))
+;;           ((v (= y nil) (v (= (iff x y) nil) (= (iff x y) t)))                  (build.commute-or @-)                              *1)
+;;           ;; ---
+;;           ((v (= x nil) (v (!= y nil) (= (iff x y) nil)))                       (build.theorem (theorem-iff-when-not-nil-and-nil)))
+;;           ((v (!= x nil) (v (!= y nil) (= (iff x y) t)))                        (build.theorem (theorem-iff-when-nil-and-nil)))
+;;           ((v (v (!= y nil) (= (iff x y) nil)) (v (!= y nil) (= (iff x y) t)))  (build.cut @-- @-))
+;;           ((v (!= y nil) (v (= (iff x y) nil) (v (!= y nil) (= (iff x y) t))))  (build.right-associativity @-))
+;;           ((v (!= y nil) (v (v (!= y nil) (= (iff x y) t)) (= (iff x y) nil)))  (build.disjoined-commute-or @-))
+;;           ((v (!= y nil) (v (!= y nil) (v (= (iff x y) t) (= (iff x y) nil))))  (build.disjoined-right-associativity @-))
+;;           ((v (v (!= y nil) (!= y nil)) (v (= (iff x y) t) (= (iff x y) nil)))  (build.associativity @-))
+;;           ((v (v (= (iff x y) t) (= (iff x y) nil)) (v (!= y nil) (!= y nil)))  (build.commute-or @-))
+;;           ((v (v (= (iff x y) t) (= (iff x y) nil)) (!= y nil))                 (build.disjoined-contraction @-))
+;;           ((v (!= y nil) (v (= (iff x y) t) (= (iff x y) nil)))                 (build.commute-or @-))
+;;           ((v (!= y nil) (v (= (iff x y) nil) (= (iff x y) t)))                 (build.disjoined-commute-or @-)                   *2)
+;;           ;; ---
+;;           ((v (v (= (iff x y) nil) (= (iff x y) t))
+;;               (v (= (iff x y) nil) (= (iff x y) t)))                            (build.cut *1 *2))
+;;           ((v (= (iff x y) nil) (= (iff x y) t))                                (build.contraction @-)))
+;;   :minatbl ((iff . 2)))
+
+
+;; (defderiv build.iff-nil-from-not-t
+;;  :derive (= (iff (? a) (? b)) nil)
+;;  :from   ((proof x (!= (iff (? a) (? b)) t)))
+;;  :proof  (@derive ((v (= (iff x y) nil) (= (iff x y) t))                        (build.theorem (theorem-iff-nil-or-t)))
+;;                   ((v (= (iff x y) t) (= (iff x y) nil))                        (build.commute-or @-))
+;;                   ((v (= (iff (? a) (? b)) t) (= (iff (? a) (? b)) nil))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+;;                   ((!= (iff (? a) (? b)) t)                                     (@given x))
+;;                   ((= (iff (? a) (? b)) nil)                                    (build.modus-ponens-2 @- @--))))
+
+;; (defderiv build.disjoined-iff-nil-from-not-t
+;;  :derive (v P (= (iff (? a) (? b)) nil))
+;;  :from   ((proof x (v P (!= (iff (? a) (? b)) t))))
+;;  :proof  (@derive
+;;           ((v (= (iff x y) nil) (= (iff x y) t))                                (build.theorem (theorem-iff-nil-or-t)))
+;;           ((v (= (iff x y) t) (= (iff x y) nil))                                (build.commute-or @-))
+;;           ((v (= (iff (? a) (? b)) t) (= (iff (? a) (? b)) nil))                (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+;;           ((v P (v (= (iff (? a) (? b)) t) (= (iff (? a) (? b)) nil)))          (build.expansion (@formula P) @-))
+;;           ((v P (!= (iff (? a) (? b)) t))                                       (@given x))
+;;           ((v P (= (iff (? a) (? b)) nil))                                      (build.disjoined-modus-ponens-2 @- @--))))
+
+;; (deftheorem theorem-symmetry-of-iff
+;;   :derive (= (iff x y) (iff y x))
+;;   :proof (@derive
+;;           ((v (= x nil) (v (= y nil) (= (iff x y) t)))                          (build.theorem (theorem-iff-when-not-nil-and-not-nil)))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x y) t))                          (build.associativity @-)                                    *1a)
+;;           ((v (v (= y nil) (= x nil)) (= (iff y x) t))                          (build.instantiation @- (@sigma (x . y) (y . x))))
+;;           ((v (= (iff y x) t) (v (= y nil) (= x nil)))                          (build.commute-or @-))
+;;           ((v (= (iff y x) t) (v (= x nil) (= y nil)))                          (build.disjoined-commute-or @-))
+;;           ((v (v (= x nil) (= y nil)) (= (iff y x) t))                          (build.commute-or @-))
+;;           ((v (v (= x nil) (= y nil)) (= t (iff y x)))                          (build.disjoined-commute-pequal @-))
+;;           ((v (v (= x nil) (= y nil)) (= (iff x y) (iff y x)))                  (build.disjoined-transitivity-of-pequal *1a @-))
+;;           ((v (= x nil) (v (= y nil) (= (iff x y) (iff y x))))                  (build.right-associativity @-)                              *1)
+;;           ;; ---
+;;           ((v (= x nil) (v (!= y nil) (= (iff x y) nil)))                       (build.theorem (theorem-iff-when-not-nil-and-nil)))
+;;           ((v (v (= x nil) (!= y nil)) (= (iff x y) nil))                       (build.associativity @-)                                    *2a)
+;;           ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))                       (build.theorem (theorem-iff-when-nil-and-not-nil)))
+;;           ((v (!= y nil) (v (= x nil) (= (iff y x) nil)))                       (build.instantiation @- (@sigma (x . y) (y . x))))
+;;           ((v (v (!= y nil) (= x nil)) (= (iff y x) nil))                       (build.associativity @-))
+;;           ((v (= (iff y x) nil) (v (!= y nil) (= x nil)))                       (build.commute-or @-))
+;;           ((v (= (iff y x) nil) (v (= x nil) (!= y nil)))                       (build.disjoined-commute-or @-))
+;;           ((v (v (= x nil) (!= y nil)) (= (iff y x) nil))                       (build.commute-or @-))
+;;           ((v (v (= x nil) (!= y nil)) (= nil (iff y x)))                       (build.disjoined-commute-pequal @-))
+;;           ((v (v (= x nil) (!= y nil)) (= (iff x y) (iff y x)))                 (build.disjoined-transitivity-of-pequal *2a @-))
+;;           ((v (= x nil) (v (!= y nil) (= (iff x y) (iff y x))))                 (build.right-associativity @-)                              *2)
+;;           ;; ---
+;;           ((v (= y nil) (v (!= x nil) (= (iff y x) (iff x y))))                 (build.instantiation @- (@sigma (x . y) (y . x))))
+;;           ((v (v (= y nil) (!= x nil)) (= (iff y x) (iff x y)))                 (build.associativity @-))
+;;           ((v (v (= y nil) (!= x nil)) (= (iff x y) (iff y x)))                 (build.disjoined-commute-pequal @-))
+;;           ((v (= (iff x y) (iff y x)) (v (= y nil) (!= x nil)))                 (build.commute-or @-))
+;;           ((v (= (iff x y) (iff y x)) (v (!= x nil) (= y nil)))                 (build.disjoined-commute-or @-))
+;;           ((v (v (!= x nil) (= y nil)) (= (iff x y) (iff y x)))                 (build.commute-or @-))
+;;           ((v (!= x nil) (v (= y nil) (= (iff x y) (iff y x))))                 (build.right-associativity @-)                              *3)
+;;           ;; ---
+;;           ((v (!= x nil) (v (!= y nil) (= (iff x y) t)))                        (build.theorem (theorem-iff-when-nil-and-nil)))
+;;           ((v (v (!= x nil) (!= y nil)) (= (iff x y) t))                        (build.associativity @-)                                    *4a)
+;;           ((v (v (!= y nil) (!= x nil)) (= (iff y x) t))                        (build.instantiation @- (@sigma (x . y) (y . x))))
+;;           ((v (= (iff y x) t) (v (!= y nil) (!= x nil)))                        (build.commute-or @-))
+;;           ((v (= (iff y x) t) (v (!= x nil) (!= y nil)))                        (build.disjoined-commute-or @-))
+;;           ((v (v (!= x nil) (!= y nil)) (= (iff y x) t))                        (build.commute-or @-))
+;;           ((v (v (!= x nil) (!= y nil)) (= t (iff y x)))                        (build.disjoined-commute-pequal @-))
+;;           ((v (v (!= x nil) (!= y nil)) (= (iff x y) (iff y x)))                (build.disjoined-transitivity-of-pequal *4a @-))
+;;           ((v (!= x nil) (v (!= y nil) (= (iff x y) (iff y x))))                (build.right-associativity @-)                              *4)
+;;           ;; ---
+;;           ((v (v (= y nil) (= (iff x y) (iff y x)))
+;;               (v (= y nil) (= (iff x y) (iff y x))))                            (build.cut *1 *3))
+;;           ((v (= y nil) (= (iff x y) (iff y x)))                                (build.contraction @-)                                      *5a)
+;;           ((v (v (!= y nil) (= (iff x y) (iff y x)))
+;;               (v (!= y nil) (= (iff x y) (iff y x))))                           (build.cut *2 *4))
+;;           ((v (!= y nil) (= (iff x y) (iff y x)))                               (build.contraction @-))
+;;           ((v (= (iff x y) (iff y x)) (= (iff x y) (iff y x)))                  (build.cut *5a @-))
+;;           ((= (iff x y) (iff y x))                                              (build.contraction @-)))
+;;   :minatbl ((iff . 2)))
+
+
+;; (deftheorem theorem-transitivity-two-of-iff
+;;   :derive (v (= (iff x y) nil)
+;;              (= (iff x z) (iff y z)))
+;;   :proof  (@derive
+;;            ((= (iff x y) (iff y x))                                        (build.theorem (theorem-symmetry-of-iff)))
+;;            ((= (iff y x) (iff x y))                                        (build.instantiation @- (@sigma (x . y) (y . x)))                         *1a)
+;;            ((v (= y nil) (= (iff y x) (iff x y)))                          (build.expansion (@formula (= y nil)) @-))
+;;            ((v (= y nil) (= (iff x y) (if x t nil)))                       (build.theorem (theorem-iff-normalize-t)))
+;;            ((v (= y nil) (= (iff y x) (if x t nil)))                       (build.disjoined-transitivity-of-pequal @-- @-))
+;;            ((v (= x nil) (= (iff x y) (if y t nil)))                       (build.instantiation @- (@sigma (x . y) (y . x)))                         *1)
+;;            ;; ---
+;;            ((v (= x nil) (= (iff x z) (if z t nil)))                       (build.instantiation *1 (list (cons 'y 'z))))
+;;            ((v (v (= x nil) (= y nil)) (= (iff x z) (if z t nil)))         (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil)))          *3a)
+;;            ((v (= y nil) (= (iff y z) (if z t nil)))                       (build.instantiation *1 (list (cons 'x 'y) (cons 'y 'z))))
+;;            ((v (v (= x nil) (= y nil)) (= (iff y z) (if z t nil)))         (build.multi-assoc-expansion @- (@formulas (= x nil) (= y nil))))
+;;            ((v (v (= x nil) (= y nil)) (= (if z t nil) (iff y z)))         (build.disjoined-commute-pequal @-))
+;;            ((v (v (= x nil) (= y nil)) (= (iff x z) (iff y z)))            (build.disjoined-transitivity-of-pequal *3a @-))
+;;            ((v (= x nil) (v (= y nil) (= (iff x z) (iff y z))))            (build.right-associativity @-))
+;;            ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))                 (build.theorem (theorem-iff-when-nil-and-not-nil)))
+;;            ((v (v (= y nil) (= (iff x z) (iff y z)))
+;;                (v (= y nil) (= (iff x y) nil)))                            (build.cut @-- @-))
+;;            ((v (= y nil) (v (= (iff x z) (iff y z))
+;;                             (v (= y nil) (= (iff x y) nil))))              (build.right-associativity @-))
+;;            ((v (= y nil) (v (v (= y nil) (= (iff x y) nil))
+;;                             (= (iff x z) (iff y z))))                      (build.disjoined-commute-or @-))
+;;            ((v (= y nil) (v (= y nil) (v (= (iff x y) nil)
+;;                                          (= (iff x z) (iff y z)))))        (build.disjoined-right-associativity @-))
+;;            ((v (v (= y nil) (= y nil))
+;;                (v (= (iff x y) nil) (= (iff x z) (iff y z))))              (build.associativity @-))
+;;            ((v (v (= (iff x y) nil) (= (iff x z) (iff y z)))
+;;                (v (= y nil) (= y nil)))                                    (build.commute-or @-))
+;;            ((v (v (= (iff x y) nil) (= (iff x z) (iff y z))) (= y nil))    (build.disjoined-contraction @-))
+;;            ((v (= y nil) (v (= (iff x y) nil) (= (iff x z) (iff y z))))    (build.commute-or @-)                                                     *5)
+;;            ;; ---
+;;            ((v (!= y nil) (= (iff y x) (iff x y)))                         (build.expansion (@formula (!= y nil)) *1a))
+;;            ((v (!= y nil) (= (iff x y) (equal x nil)))                     (build.theorem (theorem-iff-normalize-nil)))
+;;            ((v (!= y nil) (= (iff y x) (equal x nil)))                     (build.disjoined-transitivity-of-pequal @-- @-))
+;;            ((v (!= x nil) (= (iff x y) (equal y nil)))                     (build.instantiation @- (@sigma (x . y) (y . x)))                         *2)
+;;            ;; ---
+;;            ((v (!= x nil) (= (iff x z) (equal z nil)))                     (build.instantiation *2 (@sigma (y . z))))
+;;            ((v (v (!= x nil) (!= y nil)) (= (iff x z) (equal z nil)))      (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= y nil)))        *4a)
+;;            ((v (!= y nil) (= (iff y z) (equal z nil)))                     (build.instantiation *2 (@sigma (x . y) (y . z))))
+;;            ((v (v (!= x nil) (!= y nil)) (= (iff y z) (equal z nil)))      (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= y nil))))
+;;            ((v (v (!= x nil) (!= y nil)) (= (equal z nil) (iff y z)))      (build.disjoined-commute-pequal @-))
+;;            ((v (v (!= x nil) (!= y nil)) (= (iff x z) (iff y z)))          (build.disjoined-transitivity-of-pequal *4a @-))
+;;            ((v (!= x nil) (v (!= y nil) (= (iff x z) (iff y z))))          (build.right-associativity @-))
+;;            ((v (= x nil) (v (!= y nil) (= (iff x y) nil)))                 (build.theorem (theorem-iff-when-not-nil-and-nil)))
+;;            ((v (v (!= y nil) (= (iff x y) nil))
+;;                (v (!= y nil) (= (iff x z) (iff y z))))                     (build.cut @- @--))
+;;            ((v (!= y nil) (v (= (iff x y) nil)
+;;                              (v (!= y nil) (= (iff x z) (iff y z)))))      (build.right-associativity @-))
+;;            ((v (!= y nil) (v (v (!= y nil) (= (iff x z) (iff y z)))
+;;                              (= (iff x y) nil)))                           (build.disjoined-commute-or @-))
+;;            ((v (!= y nil) (v (!= y nil) (v (= (iff x z) (iff y z))
+;;                                            (= (iff x y) nil))))            (build.disjoined-right-associativity @-))
+;;            ((v (v (!= y nil) (!= y nil))
+;;                (v (= (iff x z) (iff y z)) (= (iff x y) nil)))              (build.associativity @-))
+;;            ((v (v (= (iff x z) (iff y z)) (= (iff x y) nil))
+;;                (v (!= y nil) (!= y nil)))                                  (build.commute-or @-))
+;;            ((v (v (= (iff x z) (iff y z)) (= (iff x y) nil))
+;;                (!= y nil))                                                 (build.disjoined-contraction @-))
+;;            ((v (!= y nil) (v (= (iff x z) (iff y z)) (= (iff x y) nil)))   (build.commute-or @-))
+;;            ((v (!= y nil) (v (= (iff x y) nil) (= (iff x z) (iff y z))))   (build.disjoined-commute-or @-))
+;;            ;; ---
+;;            ((v (v (= (iff x y) nil) (= (iff x z) (iff y z)))
+;;                (v (= (iff x y) nil) (= (iff x z) (iff y z))))              (build.cut *5 @-))
+;;            ((v (= (iff x y) nil) (= (iff x z) (iff y z)))                  (build.contraction @-)))
+;;            :minatbl ((iff . 2)
+;;                      (equal . 2)
+;;                      (if . 3)))
+
+;; (deftheorem theorem-transitivity-of-iff
+;;  :derive (v (= (iff x y) nil) (v (= (iff y z) nil) (= (iff x z) t)))
+;;  :proof  (@derive
+;;           ((v (= (iff x y) nil) (= (iff x z) (iff y z)))                          (build.theorem (theorem-transitivity-two-of-iff)))
+;;           ((v (v (= (iff x y) nil) (= (iff y z) nil)) (= (iff x z) (iff y z)))    (build.multi-assoc-expansion @- (@formulas (= (iff x y) nil) (= (iff y z) nil)))   *1)
+;;           ((v (= (iff x y) nil) (= (iff x y) t))                                  (build.theorem (theorem-iff-nil-or-t)))
+;;           ((v (= (iff y z) nil) (= (iff y z) t))                                  (build.instantiation @- (list (cons 'x 'y) (cons 'y 'z))))
+;;           ((v (v (= (iff x y) nil) (= (iff y z) nil)) (= (iff y z) t))            (build.multi-assoc-expansion @- (@formulas (= (iff x y) nil) (= (iff y z) nil))))
+;;           ((v (v (= (iff x y) nil) (= (iff y z) nil)) (= (iff x z) t))            (build.disjoined-transitivity-of-pequal *1 @-))
+;;           ((v (= (iff x y) nil) (v (= (iff y z) nil) (= (iff x z) t)))            (build.right-associativity @-)))
+;;  :minatbl ((iff . 2)))
+
+;; (defderiv build.transitivity-of-iff
+;;  :derive (= (iff (? a) (? c)) t)
+;;  :from   ((proof x (= (iff (? a) (? b)) t))
+;;           (proof y (= (iff (? b) (? c)) t)))
+;;  :proof  (@derive
+;;           ((v (= (iff x y) nil) (v (= (iff y z) nil) (= (iff x z) t)))                          (build.theorem (theorem-transitivity-of-iff)))
+;;           ((v (= (iff (? a) (? b)) nil) (v (= (iff (? b) (? c)) nil) (= (iff (? a) (? c)) t)))  (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c))))   *1)
+;;           ((= (iff (? a) (? b)) t)                                                              (@given x))
+;;           ;; BOZO we can avoid this if we change the theorem.
+;;           ((!= (iff (? a) (? b)) nil)                                                           (build.not-nil-from-t @-))
+;;           ((v (= (iff (? b) (? c)) nil) (= (iff (? a) (? c)) t))                                (build.modus-ponens-2 @- *1) *2)
+;;           ((= (iff (? b) (? c)) t)                                                              (@given y))
+;;           ;; BOZO we can avoid this if we change the theorem.
+;;           ((!= (iff (? b) (? c)) nil)                                                           (build.not-nil-from-t @-))
+;;           ((= (iff (? a) (? c)) t)                                                              (build.modus-ponens-2 @- *2))))
+
+;; (defderiv build.disjoined-transitivity-of-iff
+;;  :derive (v P (= (iff (? a) (? c)) t))
+;;  :from   ((proof x (v P (= (iff (? a) (? b)) t)))
+;;           (proof y (v P (= (iff (? b) (? c)) t))))
+;;  :proof  (@derive
+;;           ((v (= (iff x y) nil) (v (= (iff y z) nil) (= (iff x z) t)))                                (build.theorem (theorem-transitivity-of-iff)))
+;;           ((v (= (iff (? a) (? b)) nil) (v (= (iff (? b) (? c)) nil) (= (iff (? a) (? c)) t)))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+;;           ((v P (v (= (iff (? a) (? b)) nil) (v (= (iff (? b) (? c)) nil) (= (iff (? a) (? c)) t))))  (build.expansion (@formula P) @-)                         *1)
+;;           ((v P (= (iff (? a) (? b)) t))                                                              (@given x))
+;;           ;; BOZO we can remove this if we change the theorem.
+;;           ((v P (!= (iff (? a) (? b)) nil))                                                           (build.disjoined-not-nil-from-t @-))
+;;           ((v P (v (= (iff (? b) (? c)) nil) (= (iff (? a) (? c)) t)))                                (build.disjoined-modus-ponens-2 @- *1) *2)
+;;           ((v P (= (iff (? b) (? c)) t))                                                              (@given y))
+;;           ;; BOZO we can remove this if we change the theorem.
+;;           ((v P (!= (iff (? b) (? c)) nil))                                                           (build.disjoined-not-nil-from-t @-))
+;;           ((v P (= (iff (? a) (? c)) t))                                                              (build.disjoined-modus-ponens-2 @- *2))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/build/lambda.lisp acl2-6.3/books/milawa/ACL2/build/lambda.lisp
--- acl2-6.2/books/milawa/ACL2/build/lambda.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/lambda.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1008 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pequal-list")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(dd.open "lambda-rules.tex")
+
+(dd.section "$\\lambda$ reduction rules")
+
+
+(defderiv build.dual-substitution-lemma-1
+  :from   ((proof x (= (? a) (? b)))
+           (proof y (= (? b) (? d)))
+           (proof z (= (? c) (? d))))
+  :derive (= (? a) (? c))
+  :proof  (@derive
+           ((= (? a) (? b))         (@given x))
+           ((= (? b) (? d))         (@given y))
+           ((= (? a) (? d))         (build.transitivity-of-pequal @-- @-)  *1)
+           ((= (? c) (? d))         (@given z))
+           ((= (? d) (? c))         (build.commute-pequal @-))
+           ((= (? a) (? c))         (build.transitivity-of-pequal *1 @-))))
+
+(defun build.flag-dual-substitution (flag x vars proofs)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (logic.variable-listp vars)
+                              (uniquep vars)
+                              (logic.appeal-listp proofs)
+                              (same-lengthp vars proofs)
+                              (logic.all-atomicp (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             ;; If x is a constant, then x/[Vi<-Ti] = x and x/[Vi<-Si] = x, so our goal
+             ;; is to prove x = x, which is trivial by reflexivity.
+             (build.reflexivity x))
+            ((logic.variablep x)
+             ;; If x is a variable, then either it is some vi or not.
+             (let ((index (first-index x vars)))
+               (if (equal index (len vars))
+                   ;; If it wasn't found among the vi, then as in the constant case we
+                   ;; have x/[Vi<-Ti] = x and x/[Vi<-Si] = x, so our goal is to prove x
+                   ;; = x, which is again trivial by reflexivity.
+                   (build.reflexivity x)
+                 ;; Else x is exactly some vi, and we have x/[Vi<-Ti] = ti and
+                 ;; x/[Vi<-Si] = si, so our goal is to prove ti = si, which is trivial
+                 ;; by the ith proof.
+                 (logic.appeal-identity (nth index proofs)))))
+            ((logic.functionp x)
+             ;; If x is (f a1 ... an), then
+             ;;   x/[Vi<-Ti] = (f a1/[Vi<-Ti] ... an/[Vi<-Ti]), and
+             ;;   x/[Vi<-Si] = (f a1/[Vi<-Si] ... an/[Vi<-Si]).
+             ;;
+             ;; For each ai, we can recursively prove ai/[Vi<-Ti] = ai/[Vi<-Si], then
+             ;; by pequal-by-args we can prove our goal.
+             (build.pequal-by-args (logic.function-name x)
+                                   (build.flag-dual-substitution 'list (logic.function-args x) vars proofs)))
+            ((logic.lambdap x)
+             ;; If x is ((lambda (x1...xn) B) a1...an), then by beta reduction we have
+             ;;
+             ;; To begin, we recursively construct proofs of:
+             ;;   ai/[Vi<-Ti] = ai/[Vi<-Si]                                 (*1)
+             ;;
+             ;; To make our next steps more clear, let
+             ;;   ci = ai/[Vi<-Ti], and
+             ;;   di = ai/[Vi<-Si]
+             ;;
+             ;; In other words, the proofs in *1 establish:
+             ;;   ci = di
+             ;;
+             ;; Using these proofs, we can recursively prove B/[Xi<-Ci] = B/[Xi<-Di].
+             ;; This is well-founded because we are recurring over only the structure
+             ;; of x, and B is contained in x and hence is smaller than x.  If we now
+             ;; expand away the definitions of Ci and Di, we have proven:
+             ;;
+             ;;   B/[Xi<-(Ai/[Vi<-Ti])] = B/[Xi<-(Ai/[Vi<-Si])]
+             ;;
+             ;; But since x is a lambda, all of the variables in B must be among the
+             ;; Xi, so the substitutions can be teased apart.  We find that the proof
+             ;; above is exactly a proof of:
+             ;;
+             ;;   (B/[Xi<-Ai])/[Vi<-Ti] = (B/[Xi<-Ai])/[Vi<-Si]             (*2)
+             ;;
+             ;; We can now derive our goal, x/[Vi<-Ti] = x/[Vi<-Si], as follows:
+             ;;
+             ;;    1. x = B/[Xi<-Ai]                                  Beta Reduction
+             ;;    2. x/[Vi<-Ti] = (B/[Xi<-Ai])/[Vi<-Ti]              Instantiation; 1   a=b
+             ;;    3. (B/[Xi<-Ai])/[Vi<-Ti] = (B/[Xi<-Ai])/[Vi<-Si]   By *2              b=d
+             ;;    4. x/[Vi<-Si] = (B/[Xi<-Ai])/[Vi<-Si]              Instantiation; 1   c=d
+             ;;    5. x/[Vi<-Ti] = x/[Vi<-Si]                         Lemma; 2,3,4
+             (let* ((ti=si*   (logic.strip-conclusions proofs))
+                    (line-1   (build.beta-reduction (logic.lambda-formals x)
+                                                    (logic.lambda-body x)
+                                                    (logic.lambda-actuals x))))
+               (build.dual-substitution-lemma-1
+                (build.instantiation line-1 (pair-lists vars (logic.=lhses ti=si*)))
+                (build.flag-dual-substitution 'term (logic.lambda-body x) (logic.lambda-formals x)
+                                              (build.flag-dual-substitution 'list (logic.lambda-actuals x) vars proofs))
+                (build.instantiation line-1 (pair-lists vars (logic.=rhses ti=si*))))))
+
+            (t
+             ;; sneaky hack so that it's always iff to t.
+             t))
+    ;; List case.
+    (if (consp x)
+        (cons (build.flag-dual-substitution 'term (car x) vars proofs)
+              (build.flag-dual-substitution 'list (cdr x) vars proofs))
+      nil)))
+
+(definlined build.dual-substitution (x vars proofs)
+  (declare (xargs :guard (and (logic.termp x)
+                               (logic.variable-listp vars)
+                               (uniquep vars)
+                               (logic.appeal-listp proofs)
+                               (same-lengthp vars proofs)
+                               (logic.all-atomicp (logic.strip-conclusions proofs)))
+                   :verify-guards nil))
+  (build.flag-dual-substitution 'term x vars proofs))
+
+(definlined build.dual-substitution-list (x vars proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.variable-listp vars)
+                              (uniquep vars)
+                              (logic.appeal-listp proofs)
+                              (same-lengthp vars proofs)
+                              (logic.all-atomicp (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (build.flag-dual-substitution 'list x vars proofs))
+
+
+(defthmd definition-of-build.dual-substitution
+  (equal (build.dual-substitution x vars proofs)
+         (cond ((logic.constantp x)
+                (build.reflexivity x))
+               ((logic.variablep x)
+                (let ((index (first-index x vars)))
+                  (if (equal index (len vars))
+                      (build.reflexivity x)
+                    (logic.appeal-identity (nth index proofs)))))
+               ((logic.functionp x)
+                (build.pequal-by-args (logic.function-name x)
+                                      (build.dual-substitution-list (logic.function-args x) vars proofs)))
+               ((logic.lambdap x)
+                (let* ((ti=si*   (logic.strip-conclusions proofs))
+                       (line-1   (build.beta-reduction (logic.lambda-formals x)
+                                                       (logic.lambda-body x)
+                                                       (logic.lambda-actuals x))))
+                  (build.dual-substitution-lemma-1
+                   (build.instantiation line-1 (pair-lists vars (logic.=lhses ti=si*)))
+                   (build.flag-dual-substitution 'term (logic.lambda-body x) (logic.lambda-formals x)
+                                                 (build.flag-dual-substitution 'list (logic.lambda-actuals x) vars proofs))
+                   (build.instantiation line-1 (pair-lists vars (logic.=rhses ti=si*))))))
+               (t t)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable build.dual-substitution
+                                    build.dual-substitution-list))))
+
+(defthmd definition-of-build.dual-substitution-list
+  (equal (build.dual-substitution-list x vars proofs)
+         (if (consp x)
+             (cons (build.dual-substitution (car x) vars proofs)
+                   (build.dual-substitution-list (cdr x) vars proofs))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable build.dual-substitution
+                                    build.dual-substitution-list))))
+
+(defobligations build.dual-substitution
+  (build.reflexivity
+   build.pequal-by-args
+   build.beta-reduction
+   build.instantiation
+   build.dual-substitution-lemma-1))
+
+(defobligations build.dual-substitution-list
+  (build.dual-substitution))
+
+(defthm build.flag-dual-substitution-of-term-removal
+  (equal (build.flag-dual-substitution 'term x vars proofs)
+         (build.dual-substitution x vars proofs))
+  :hints(("Goal" :in-theory (enable build.dual-substitution))))
+
+(defthm build.flag-dual-substitution-of-list-removal
+  (equal (build.flag-dual-substitution 'list x vars proofs)
+         (build.dual-substitution-list x vars proofs))
+  :hints(("Goal" :in-theory (enable build.dual-substitution-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition build.dual-substitution))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition build.dual-substitution-list))))
+
+
+
+
+(defthm build.dual-substitution-under-iff
+  (iff (build.dual-substitution x vars proofs)
+       t)
+  :hints(("Goal" :use ((:instance definition-of-build.dual-substitution)))))
+
+(defthm build.dual-substitution-list-when-not-consp
+  (implies (not (consp x))
+           (equal (build.dual-substitution-list x vars proofs)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-build.dual-substitution-list))))
+
+(defthm build.dual-substitution-list-of-cons
+  (equal (build.dual-substitution-list (cons a x) vars proofs)
+         (cons (build.dual-substitution a vars proofs)
+               (build.dual-substitution-list x vars proofs)))
+  :hints(("Goal" :in-theory (enable definition-of-build.dual-substitution-list))))
+
+(defthm len-of-build.dual-substitution-list
+  (equal (len (build.dual-substitution-list x vars proofs))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthms-flag
+  :shared-hyp (force (and (logic.variable-listp vars)
+                          (uniquep vars)
+                          (logic.appeal-listp proofs)
+                          (equal (len vars) (len proofs))
+                          (logic.all-atomicp (logic.strip-conclusions proofs))))
+  :thms ((term forcing-logic.appealp-of-build.dual-substitution
+               (implies (force (logic.termp x))
+                        (equal (logic.appealp (build.dual-substitution x vars proofs))
+                               t)))
+         (term forcing-logic.conclusion-of-build.dual-substitution
+               (implies (force (logic.termp x))
+                        (equal (logic.conclusion (build.dual-substitution x vars proofs))
+                               (logic.pequal
+                                (logic.substitute x (pair-lists vars (logic.=lhses (logic.strip-conclusions proofs))))
+                                (logic.substitute x (pair-lists vars (logic.=rhses (logic.strip-conclusions proofs))))))))
+         (t forcing-logic.appealp-listp-of-build.dual-substitution-list
+            (implies (force (logic.term-listp x))
+                     (equal (logic.appeal-listp (build.dual-substitution-list x vars proofs))
+                            t)))
+         (t forcing-logic.strip-conclusions-of-build.dual-substitution-list
+            (implies (force (logic.term-listp x))
+                     (equal (logic.strip-conclusions (build.dual-substitution-list x vars proofs))
+                            (logic.pequal-list
+                             (logic.substitute-list x (pair-lists vars (logic.=lhses (logic.strip-conclusions proofs))))
+                             (logic.substitute-list x (pair-lists vars (logic.=rhses (logic.strip-conclusions proofs)))))))))
+  :hints (("Goal"
+           :restrict ((definition-of-build.dual-substitution ((x x))))
+           :in-theory (e/d (definition-of-build.dual-substitution)
+                           (forcing-lookup-of-logic.function-name))
+           :induct (build.flag-dual-substitution flag x vars proofs))))
+
+(verify-guards build.flag-dual-substitution
+               :hints(("Goal" :in-theory (disable forcing-lookup-of-logic.function-name))))
+(verify-guards build.dual-substitution)
+(verify-guards build.dual-substitution-list)
+
+(defthms-flag
+  :@contextp t
+  :shared-hyp (force (and (logic.variable-listp vars)
+                          (uniquep vars)
+                          (logic.appeal-listp proofs)
+                          (logic.proof-listp proofs axioms thms atbl)
+                          (equal (len vars) (len proofs))
+                          (logic.all-atomicp (logic.strip-conclusions proofs))))
+  :thms ((term forcing-logic.proofp-of-build.dual-substitution
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (@obligations build.dual-substitution)))
+                        (equal (logic.proofp (build.dual-substitution x vars proofs) axioms thms atbl)
+                               t)))
+         (t forcing-logic.proof-listp-of-build.dual-substitution-list
+            (implies (force (and (logic.term-listp x)
+                                 (logic.term-list-atblp x atbl)
+                                 (@obligations build.dual-substitution-list)))
+                     (equal (logic.proof-listp (build.dual-substitution-list x vars proofs) axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :restrict ((definition-of-build.dual-substitution ((x x))))
+           :in-theory (enable definition-of-build.dual-substitution)
+           :induct (build.flag-dual-substitution flag x vars proofs))))
+
+
+
+
+(defund build.lambda-pequal-by-args (formals body proofs)
+  ;; Derive ((lambda (x1...xn) B) t1...tn) = ((lambda (x1...xn) B) s1...sn) from t1 = s1, ..., tn = sn
+  (declare (xargs :guard (and (true-listp formals)
+                              (logic.variable-listp formals)
+                              (uniquep formals)
+                              (logic.termp body)
+                              (subsetp (logic.term-vars body) formals)
+                              (logic.appeal-listp proofs)
+                              (same-lengthp proofs formals)
+                              (logic.all-atomicp (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((conclusions (logic.strip-conclusions proofs)) ;; (t1 = s1, ..., tn = sn)
+         (t*          (logic.=lhses conclusions))       ;; (t1, ..., tn)
+         (s*          (logic.=rhses conclusions)))      ;; (s1, ..., sn)
+    (if (equal t* s*)
+        ;; Optimization. As with build.pequal-by-args, if all of the arguments
+        ;; are identical, we will just use reflexivity to build the proof.
+        (build.reflexivity (logic.lambda formals body t*))
+
+      ;; Otherwise, we use the following derivation.
+      ;;
+      ;;   1. ((lambda (x1...xn) B) t1...tn) = B/[Xi<-Ti]                       Beta reduction
+      ;;   2. B/[Xi<-Ti] = B/[Xi<-Si]                                           Dual substitution
+      ;;   3. ((lambda (x1...xn) B) t1...tn) = B/[Xi<-Si]                       Trans =; 1,2
+      ;;   4. ((lambda (x1...xn) B) s1...sn) = B/[Xi<-Si]                       Beta reduction
+      ;;   5. B/[Xi<-Si] = ((lambda (x1...xn) B) s1...sn)                       Commute =; 4
+      ;;   6. ((lambda (x1...xn) B) t1...tn) = ((lambda (x1...xn) B) s1...sn)   Trans =; 3,5
+      ;;
+      ;; Q.E.D.
+      (let* ((line-1 (build.beta-reduction formals body t*))
+             (line-2 (build.dual-substitution body formals proofs))
+             (line-3 (build.transitivity-of-pequal line-1 line-2))
+             (line-4 (build.beta-reduction formals body s*))
+             (line-5 (build.commute-pequal line-4))
+             (line-6 (build.transitivity-of-pequal line-3 line-5)))
+        line-6))))
+
+(defobligations build.lambda-pequal-by-args
+  (build.reflexivity
+   build.beta-reduction
+   build.dual-substitution
+   build.transitivity-of-pequal
+   build.commute-pequal
+   build.transitivity-of-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.lambda-pequal-by-args)))
+
+ (defthm build.lambda-pequal-by-args-under-iff
+   (iff (build.lambda-pequal-by-args formals body proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.lambda-pequal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.appeal-listp proofs)
+                        (equal (len proofs) (len formals))
+                        (logic.all-atomicp (logic.strip-conclusions proofs))))
+            (equal (logic.appealp (build.lambda-pequal-by-args formals body proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.lambda-pequal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.appeal-listp proofs)
+                        (equal (len proofs) (len formals))
+                        (logic.all-atomicp (logic.strip-conclusions proofs))))
+            (equal (logic.conclusion (build.lambda-pequal-by-args formals body proofs))
+                   (logic.pequal (logic.lambda formals body (logic.=lhses (logic.strip-conclusions proofs)))
+                                 (logic.lambda formals body (logic.=rhses (logic.strip-conclusions proofs))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.lambda-pequal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (logic.term-atblp body atbl)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.appeal-listp proofs)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (len proofs) (len formals))
+                        (logic.all-atomicp (logic.strip-conclusions proofs))
+                        (@obligations build.lambda-pequal-by-args)))
+            (equal (logic.proofp (build.lambda-pequal-by-args formals body proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards build.lambda-pequal-by-args))
+
+
+
+(defund build.lambda-pequal-by-args-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'build.lambda-pequal-by-args)
+         (tuplep 2 extras)
+         (let ((formals (first extras))
+               (body    (second extras)))
+           (and (true-listp formals)
+                (logic.variable-listp formals)
+                (uniquep formals)
+                (logic.termp body)
+                (logic.term-atblp body atbl)
+                (subsetp (logic.term-vars body) formals)
+                (same-lengthp subproofs formals)
+                (logic.all-atomicp-of-strip-conclusions subproofs)
+                (equal conclusion
+                       (logic.pequal (logic.lambda formals body (logic.=lhses-of-strip-conclusions subproofs))
+                                     (logic.lambda formals body (logic.=rhses-of-strip-conclusions subproofs)))))))))
+
+(defund build.lambda-pequal-by-args-high (formals body proofs)
+  ;; BOZO we could add a true-listp restriction to proofs to avoid the list-fix
+  (declare (xargs :guard (and (true-listp formals)
+                              (logic.variable-listp formals)
+                              (uniquep formals)
+                              (logic.termp body)
+                              (subsetp (logic.term-vars body) formals)
+                              (logic.appeal-listp proofs)
+                              (same-lengthp proofs formals)
+                              (logic.all-atomicp (logic.strip-conclusions proofs)))))
+  (logic.appeal 'build.lambda-pequal-by-args
+                (logic.pequal (logic.lambda formals body (logic.=lhses-of-strip-conclusions proofs))
+                              (logic.lambda formals body (logic.=rhses-of-strip-conclusions proofs)))
+                (list-fix proofs)
+                (list formals body)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.lambda-pequal-by-args-okp)))
+
+ (defthm booleanp-of-build.lambda-pequal-by-args-okp
+   (equal (booleanp (build.lambda-pequal-by-args-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm build.lambda-pequal-by-args-okp-of-logic.appeal-identity
+   (equal (build.lambda-pequal-by-args-okp (logic.appeal-identity x) atbl)
+          (build.lambda-pequal-by-args-okp x atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthm lemma-1-for-soundness-of-build.lambda-pequal-by-args-okp
+   (implies (and (build.lambda-pequal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion (build.lambda-pequal-by-args
+                                      (first (logic.extras x))
+                                      (second (logic.extras x))
+                                      (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                   axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthm@ lemma-2-for-soundness-of-build.lambda-pequal-by-args-okp
+   (implies (and (build.lambda-pequal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations build.lambda-pequal-by-args))
+            (equal (logic.proofp (build.lambda-pequal-by-args
+                                  (first (logic.extras x))
+                                  (second (logic.extras x))
+                                  (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                               axioms thms atbl))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-build.lambda-pequal-by-args-okp
+   (implies (and (build.lambda-pequal-by-args-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations build.lambda-pequal-by-args))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-build.lambda-pequal-by-args-okp
+                               lemma-2-for-soundness-of-build.lambda-pequal-by-args-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (build.lambda-pequal-by-args
+                                 (first (logic.extras x))
+                                 (second (logic.extras x))
+                                 (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                              axioms thms atbl)))))))))
+
+
+
+
+
+
+
+
+(defderiv build.disjoined-dual-substitution-lemma-1
+  :from   ((proof x (v P (= (? a) (? b))))
+           (proof y (v P (= (? b) (? d))))
+           (proof z (v P (= (? c) (? d)))))
+  :derive (v P (= (? a) (? c)))
+  :proof  (@derive
+           ((v P (= (? a) (? b)))    (@given x))
+           ((v P (= (? b) (? d)))    (@given y))
+           ((v P (= (? a) (? d)))    (build.disjoined-transitivity-of-pequal @-- @-)  *1)
+           ((v P (= (? c) (? d)))    (@given z))
+           ((v P (= (? d) (? c)))    (build.disjoined-commute-pequal @-))
+           ((v P (= (? a) (? c)))    (build.disjoined-transitivity-of-pequal *1 @-))))
+
+
+(defun build.flag-disjoined-dual-substitution (flag x vars p proofs)
+   ;;
+   ;;     P v t1 = s1
+   ;;     ...
+   ;;     P v tn = sn
+   ;;   -----------------------------------------------------
+   ;;     P v x/[v1<-t1, ..., vn<-tn] = x/[v1<-s1, ..., vn<-sn]
+   ;;
+   ;; - x is the term we are instantiating
+   ;; - vars are the list of variables (v1 ... vn) from above
+   ;; - p is explicitly given; we can't extract it if proofs is empty
+   ;; - proofs are the givens, i.e., proofs of (t1 = s1, ..., tn = sn)
+   ;;
+   ;; Note: we don't comment this proof since it's almost identical to the one
+   ;; in build.flag-dual-substitution.  So see the comments there instead.
+   (declare (xargs :guard (and (if (equal flag 'term)
+                                   (logic.termp x)
+                                 (and (equal flag 'list)
+                                      (logic.term-listp x)))
+                               (logic.variable-listp vars)
+                               (uniquep vars)
+                               (logic.formulap p)
+                               (logic.appeal-listp proofs)
+                               (equal (len vars) (len proofs))
+                               (let ((conclusions (logic.strip-conclusions proofs)))
+                                 (and (logic.all-disjunctionsp conclusions)
+                                      (all-equalp p (logic.vlhses conclusions))
+                                      (logic.all-atomicp (logic.vrhses conclusions)))))
+                   :verify-guards nil))
+   (if (equal flag 'term)
+       (cond ((logic.constantp x)
+              (build.expansion p (build.reflexivity x)))
+             ((logic.variablep x)
+              (let ((index (first-index x vars)))
+                (if (equal index (len vars))
+                    (build.expansion p (build.reflexivity x))
+                  (logic.appeal-identity (nth index proofs)))))
+             ((logic.functionp x)
+              (let ((name (logic.function-name x))
+                    (args (logic.function-args x)))
+                (build.disjoined-pequal-by-args name p (build.flag-disjoined-dual-substitution 'list args vars p proofs))))
+             ((logic.lambdap x)
+              (let* ((ti=si*   (logic.vrhses (logic.strip-conclusions proofs)))
+                     (line-1   (build.beta-reduction (logic.lambda-formals x)
+                                                     (logic.lambda-body x)
+                                                     (logic.lambda-actuals x))))
+              (build.disjoined-dual-substitution-lemma-1
+               (build.expansion p (build.instantiation line-1 (pair-lists vars (logic.=lhses ti=si*))))
+               (build.flag-disjoined-dual-substitution 'term
+                                                           (logic.lambda-body x)
+                                                           (logic.lambda-formals x)
+                                                           p
+                                                           (build.flag-disjoined-dual-substitution 'list
+                                                                                                       (logic.lambda-actuals x)
+                                                                                                       vars
+                                                                                                       p
+                                                                                                       proofs))
+               (build.expansion p (build.instantiation line-1 (pair-lists vars (logic.=rhses ti=si*)))))))
+             (t t))
+     (if (consp x)
+         (cons (build.flag-disjoined-dual-substitution 'term (car x) vars p proofs)
+               (build.flag-disjoined-dual-substitution 'list (cdr x) vars p proofs))
+       nil)))
+
+(definlined build.disjoined-dual-substitution (x vars p proofs)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.variable-listp vars)
+                              (uniquep vars)
+                              (logic.formulap p)
+                              (logic.appeal-listp proofs)
+                              (equal (len vars) (len proofs))
+                              (let ((conclusions (logic.strip-conclusions proofs)))
+                                (and (logic.all-disjunctionsp conclusions)
+                                     (all-equalp p (logic.vlhses conclusions))
+                                     (logic.all-atomicp (logic.vrhses conclusions)))))
+                  :verify-guards nil))
+  (build.flag-disjoined-dual-substitution 'term x vars p proofs))
+
+(definlined build.disjoined-dual-substitution-list (x vars p proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.variable-listp vars)
+                              (uniquep vars)
+                              (logic.formulap p)
+                              (logic.appeal-listp proofs)
+                              (equal (len vars) (len proofs))
+                              (let ((conclusions (logic.strip-conclusions proofs)))
+                                (and (logic.all-disjunctionsp conclusions)
+                                     (all-equalp p (logic.vlhses conclusions))
+                                     (logic.all-atomicp (logic.vrhses conclusions)))))
+                  :verify-guards nil))
+  (build.flag-disjoined-dual-substitution 'list x vars p proofs))
+
+(defthmd definition-of-build.disjoined-dual-substitution
+  (equal (build.disjoined-dual-substitution x vars p proofs)
+         (cond ((logic.constantp x)
+                (build.expansion p (build.reflexivity x)))
+               ((logic.variablep x)
+                (let ((index (first-index x vars)))
+                  (if (equal index (len vars))
+                      (build.expansion p (build.reflexivity x))
+                    (logic.appeal-identity (nth index proofs)))))
+               ((logic.functionp x)
+                (let ((name (logic.function-name x))
+                      (args (logic.function-args x)))
+                  (build.disjoined-pequal-by-args name p (build.disjoined-dual-substitution-list args vars p proofs))))
+               ((logic.lambdap x)
+                (let* ((ti=si*   (logic.vrhses (logic.strip-conclusions proofs)))
+                       (line-1   (build.beta-reduction (logic.lambda-formals x)
+                                                       (logic.lambda-body x)
+                                                       (logic.lambda-actuals x))))
+                  (build.disjoined-dual-substitution-lemma-1
+                   (build.expansion p (build.instantiation line-1 (pair-lists vars (logic.=lhses ti=si*))))
+                   (build.disjoined-dual-substitution (logic.lambda-body x) (logic.lambda-formals x) p
+                                                          (build.disjoined-dual-substitution-list (logic.lambda-actuals x) vars p proofs))
+                   (build.expansion p (build.instantiation line-1 (pair-lists vars (logic.=rhses ti=si*)))))))
+               (t t)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable build.disjoined-dual-substitution
+                                    build.disjoined-dual-substitution-list))))
+
+(defthmd definition-of-build.disjoined-dual-substitution-list
+  (equal (build.disjoined-dual-substitution-list x vars p proofs)
+         (if (consp x)
+             (cons (build.disjoined-dual-substitution (car x) vars p proofs)
+                   (build.disjoined-dual-substitution-list (cdr x) vars p proofs))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable build.disjoined-dual-substitution
+                                    build.disjoined-dual-substitution-list))))
+
+
+(defobligations build.disjoined-dual-substitution
+  (build.expansion
+   build.reflexivity
+   build.disjoined-pequal-by-args
+   build.beta-reduction
+   build.instantiation
+   build.disjoined-transitivity-of-pequal
+   build.commute-pequal))
+
+(defobligations build.disjoined-dual-substitution-list
+  (build.disjoined-dual-substitution))
+
+(defthm build.flag-disjoined-dual-substitution-of-term-removal
+  (equal (build.flag-disjoined-dual-substitution 'term x vars p proofs)
+         (build.disjoined-dual-substitution x vars p proofs))
+  :hints(("Goal" :in-theory (enable build.disjoined-dual-substitution))))
+
+(defthm build.flag-disjoined-dual-substitution-of-list-removal
+  (equal (build.flag-disjoined-dual-substitution 'list x vars p proofs)
+         (build.disjoined-dual-substitution-list x vars p proofs))
+  :hints(("Goal" :in-theory (enable build.disjoined-dual-substitution-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition build.disjoined-dual-substitution))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition build.disjoined-dual-substitution-list))))
+
+(defthm forcing-build.disjoined-dual-substitution-under-iff
+  (iff (build.disjoined-dual-substitution x vars p proofs)
+       t)
+  :hints(("Goal" :use ((:instance definition-of-build.disjoined-dual-substitution)))))
+
+(defthm build.disjoined-dual-substitution-list-when-not-consp
+  (implies (not (consp x))
+           (equal (build.disjoined-dual-substitution-list x vars p proofs)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-build.disjoined-dual-substitution-list))))
+
+(defthm build.disjoined-dual-substitution-list-of-cons
+  (equal (build.disjoined-dual-substitution-list (cons a x) vars p proofs)
+         (cons (build.disjoined-dual-substitution a vars p proofs)
+               (build.disjoined-dual-substitution-list x vars p proofs)))
+  :hints(("Goal" :in-theory (enable definition-of-build.disjoined-dual-substitution-list))))
+
+(defthm len-of-build.disjoined-dual-substitution-list
+  (equal (len (build.disjoined-dual-substitution-list x vars p proofs))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthms-flag
+  :shared-hyp (force (and (logic.variable-listp vars)
+                          (uniquep vars)
+                          (logic.formulap p)
+                          (logic.appeal-listp proofs)
+                          (equal (len vars) (len proofs))
+                          (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                          (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                          (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))))
+  :thms ((term forcing-logic.appealp-of-build.disjoined-dual-substitution
+               (implies (force (logic.termp x))
+                        (equal (logic.appealp (build.disjoined-dual-substitution x vars p proofs))
+                               t)))
+         (term forcing-logic.conclusion-of-build.disjoined-dual-substitution
+               (implies (force (logic.termp x))
+                        (equal (logic.conclusion (build.disjoined-dual-substitution x vars p proofs))
+                               (logic.por p (logic.pequal (logic.substitute x (pair-lists vars (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                                                          (logic.substitute x (pair-lists vars (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))))))))
+         (t forcing-logic.appeal-listp-of-build.disjoined-dual-substitution
+            (implies (force (logic.term-listp x))
+                     (equal (logic.appeal-listp (build.disjoined-dual-substitution-list x vars p proofs))
+                            t)))
+         (t forcing-logic.strip-conclusions-of-build.disjoined-dual-substitution
+            (implies (force (logic.term-listp x))
+                     (equal (logic.strip-conclusions (build.disjoined-dual-substitution-list x vars p proofs))
+                            (logic.por-list (repeat p (len x))
+                                            (logic.pequal-list
+                                             (logic.substitute-list x (pair-lists vars (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                                             (logic.substitute-list x (pair-lists vars (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs)))))))))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-build.disjoined-dual-substitution)
+           :induct (build.flag-disjoined-dual-substitution flag x vars p proofs))))
+
+(verify-guards build.flag-disjoined-dual-substitution)
+(verify-guards build.disjoined-dual-substitution)
+(verify-guards build.disjoined-dual-substitution-list)
+
+(defthms-flag
+  :@contextp t
+  :shared-hyp (force (and (logic.variable-listp vars)
+                          (uniquep vars)
+                          (logic.formulap p)
+                          (logic.formula-atblp p atbl)
+                          (logic.appeal-listp proofs)
+                          (equal (len vars) (len proofs))
+                          (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                          (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                          (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                          (logic.proof-listp proofs axioms thms atbl)))
+  :thms ((term forcing-logic.proofp-of-build.disjoined-dual-substitution
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (logic.proof-listp proofs axioms thms atbl)
+                                    (@obligations build.disjoined-dual-substitution)))
+                        (equal (logic.proofp (build.disjoined-dual-substitution x vars p proofs) axioms thms atbl)
+                               t)))
+         (t forcing-logic.proof-listp-of-build.disjoined-dual-substitution
+            (implies (force (and (logic.term-listp x)
+                                 (logic.term-list-atblp x atbl)
+                                 (logic.proof-listp proofs axioms thms atbl)
+                                 (@obligations build.disjoined-dual-substitution-list)))
+                     (equal (logic.proof-listp (build.disjoined-dual-substitution-list x vars p proofs) axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-build.disjoined-dual-substitution)
+           :induct (build.flag-disjoined-dual-substitution flag x vars p proofs))))
+
+
+
+(defund build.disjoined-lambda-pequal-by-args (formals body p proofs)
+  (declare (xargs :guard (and (true-listp formals)
+                              (logic.variable-listp formals)
+                              (uniquep formals)
+                              (logic.termp body)
+                              (subsetp (logic.term-vars body) formals)
+                              (logic.formulap p)
+                              (logic.appeal-listp proofs)
+                              (equal (len proofs) (len formals))
+                              (let ((conclusions (logic.strip-conclusions proofs)))
+                                (and (logic.all-disjunctionsp conclusions)
+                                     (all-equalp p (logic.vlhses conclusions))
+                                     (logic.all-atomicp (logic.vrhses conclusions)))))))
+  (let* ((ti=si* (logic.vrhses (logic.strip-conclusions proofs)))
+         (ti*    (logic.=lhses ti=si*))
+         (si*    (logic.=rhses ti=si*)))
+    (if (equal ti* si*)
+        ;; Optimization.  If all the args are identical, we can just use
+        ;; reflexivity and expansion to build the proof.
+        (build.expansion p (build.reflexivity (logic.lambda formals body ti*)))
+
+      ;; Otherwise, we use the following derivation:
+      ;;
+      ;;   1. P v ((lambda (x1...xn) B) t1...tn) = B/[Xi<-Ti]                       Beta reduction, expansion
+      ;;   2. P v B/[Xi<-Ti] = B/[Xi<-Si]                                           DJ Dual Substitution
+      ;;   3. P v ((lambda (x1...xn) B) t1...tn) = B/[Xi<-Si]                       DJ Trans =; 1,2
+      ;;   4. P v B/[Xi<-Si] = ((lambda (x1...xn) B) s1...sn)                       Beta, commute =, expansion
+      ;;   5. P v ((lambda (x1...xn) B) t1...tn) = ((lambda (x1...xn) B) s1...sn)   DJ Trans =; 3,4
+      ;;
+      ;; Q.E.D.
+      (let* ((line-1 (build.expansion p (build.beta-reduction formals body ti*)))
+             (line-2 (build.disjoined-dual-substitution body formals p proofs))
+             (line-3 (build.disjoined-transitivity-of-pequal line-1 line-2))
+             (line-4 (build.expansion p (build.commute-pequal (build.beta-reduction formals body si*))))
+             (line-5 (build.disjoined-transitivity-of-pequal line-3 line-4)))
+        line-5))))
+
+(defobligations build.disjoined-lambda-pequal-by-args
+  (build.expansion
+   build.reflexivity
+   build.disjoined-dual-substitution
+   build.disjoined-transitivity-of-pequal
+   build.commute-pequal
+   build.beta-reduction))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-lambda-pequal-by-args)))
+
+ (defthm forcing-build.disjoined-lambda-pequal-by-args-under-iff
+   (iff (build.disjoined-lambda-pequal-by-args formals body p proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.disjoined-lambda-pequal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.formulap p)
+                        (logic.appeal-listp proofs)
+                        (equal (len proofs) (len formals))
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))))
+            (equal (logic.appealp (build.disjoined-lambda-pequal-by-args formals body p proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-lambda-pequal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.formulap p)
+                        (logic.appeal-listp proofs)
+                        (equal (len proofs) (len formals))
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))))
+            (equal (logic.conclusion (build.disjoined-lambda-pequal-by-args formals body p proofs))
+                   (logic.por p (logic.pequal
+                                 (logic.lambda formals body (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                                 (logic.lambda formals body (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.disjoined-lambda-pequal-by-args
+   (implies (force (and (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (logic.formulap p)
+                        (logic.appeal-listp proofs)
+                        (equal (len proofs) (len formals))
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                        ;; ---
+                        (logic.term-atblp body atbl)
+                        (logic.formula-atblp p atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations build.disjoined-lambda-pequal-by-args)))
+            (equal (logic.proofp (build.disjoined-lambda-pequal-by-args formals body p proofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.disjoined-lambda-pequal-by-args-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'build.disjoined-lambda-pequal-by-args)
+         (tuplep 2 extras)
+         (let ((formals (first extras))
+               (body    (second extras)))
+           (and (true-listp formals)
+                (logic.variable-listp formals)
+                (uniquep formals)
+                (logic.termp body)
+                (logic.term-atblp body atbl)
+                (subsetp (logic.term-vars body) formals)
+                (same-lengthp subproofs formals)
+                (logic.all-disjunctionsp-of-strip-conclusions subproofs)
+                (logic.all-atomicp-of-vrhses-of-strip-conclusions subproofs)
+                (equal (logic.fmtype conclusion) 'por*)
+                (logic.formula-atblp (logic.vlhs conclusion) atbl)
+                ;; BOZO efficiency -- add an all-equalp-of-vlhses-of-strip-conclusions
+                (all-equalp (logic.vlhs conclusion) (logic.vlhses-of-strip-conclusions subproofs))
+                (equal (logic.vrhs conclusion)
+                       (logic.pequal (logic.lambda formals body (logic.=lhses-of-vrhses-of-strip-conclusions subproofs))
+                                     (logic.lambda formals body (logic.=rhses-of-vrhses-of-strip-conclusions subproofs)))))))))
+
+(defund build.disjoined-lambda-pequal-by-args-high (formals body p proofs)
+  ;; BOZO we could add a true-listp restriction to proofs to avoid the list-fix
+  (declare (xargs :guard (and (true-listp formals)
+                              (logic.variable-listp formals)
+                              (uniquep formals)
+                              (logic.termp body)
+                              (subsetp (logic.term-vars body) formals)
+                              (logic.formulap p)
+                              (logic.appeal-listp proofs)
+                              (equal (len proofs) (len formals))
+                              (let ((conclusions (logic.strip-conclusions proofs)))
+                                (and (logic.all-disjunctionsp conclusions)
+                                     (all-equalp p (logic.vlhses conclusions))
+                                     (logic.all-atomicp (logic.vrhses conclusions)))))))
+  (logic.appeal 'build.disjoined-lambda-pequal-by-args
+                (logic.por p (logic.pequal (logic.lambda formals body (logic.=lhses-of-vrhses-of-strip-conclusions proofs))
+                                           (logic.lambda formals body (logic.=rhses-of-vrhses-of-strip-conclusions proofs))))
+                (list-fix proofs)
+                (list formals body)))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-lambda-pequal-by-args-okp)))
+
+ (defthm booleanp-of-build.disjoined-lambda-pequal-by-args-okp
+   (equal (booleanp (build.disjoined-lambda-pequal-by-args-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm build.disjoined-lambda-pequal-by-args-okp-of-logic.appeal-identity
+   (equal (build.disjoined-lambda-pequal-by-args-okp (logic.appeal-identity x) atbl)
+          (build.disjoined-lambda-pequal-by-args-okp x atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthm lemma-1-for-soundness-of-build.disjoined-lambda-pequal-by-args-okp
+   (implies (and (build.disjoined-lambda-pequal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion (build.disjoined-lambda-pequal-by-args
+                                      (first (logic.extras x))
+                                      (second (logic.extras x))
+                                      (logic.vlhs (logic.conclusion x))
+                                      (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                   axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthm@ lemma-2-for-soundness-of-build.disjoined-lambda-pequal-by-args-okp
+   (implies (and (build.disjoined-lambda-pequal-by-args-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations build.disjoined-lambda-pequal-by-args))
+            (equal (logic.proofp (build.disjoined-lambda-pequal-by-args
+                                  (first (logic.extras x))
+                                  (second (logic.extras x))
+                                  (logic.vlhs (logic.conclusion x))
+                                  (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                               axioms thms atbl))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-build.disjoined-lambda-pequal-by-args-okp
+   (implies (and (build.disjoined-lambda-pequal-by-args-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations build.disjoined-lambda-pequal-by-args))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-build.disjoined-lambda-pequal-by-args-okp
+                               lemma-2-for-soundness-of-build.disjoined-lambda-pequal-by-args-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (build.disjoined-lambda-pequal-by-args
+                                 (first (logic.extras x))
+                                 (second (logic.extras x))
+                                 (logic.vlhs (logic.conclusion x))
+                                 (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                              axioms thms atbl)))))))))
+
+
+
+
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/build/not.lisp acl2-6.3/books/milawa/ACL2/build/not.lisp
--- acl2-6.2/books/milawa/ACL2/build/not.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/not.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,257 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "iff")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "not.tex")
+
+(defund@ definition-of-not ()
+  (declare (xargs :guard t))
+  (@formula (= (not x) (if x nil t))))
+
+(in-theory (disable (:executable-counterpart definition-of-not)))
+
+(defthm logic.formulap-of-definition-of-not
+  (equal (logic.formulap (definition-of-not))
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-not))))
+
+(defthm logic.formula-atblp-of-definition-of-not
+  (implies (force (and (equal (cdr (lookup 'not atbl)) 1)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.formula-atblp (definition-of-not) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-not))))
+
+
+
+(deftheorem theorem-not-when-nil
+  :derive (v (!= x nil) (= (not x) t))
+  :proof (@derive
+          ((v (!= x nil) (= (if x y z) z))                        (build.axiom (axiom-if-when-nil)))
+          ((v (!= x nil) (= (if x nil t) t))                      (build.instantiation @- (@sigma (y . nil) (z . t)))   *1)
+          ((= (not x) (if x nil t))                               (build.axiom (definition-of-not)))
+          ((v (!= x nil) (= (not x) (if x nil t)))                (build.expansion (@formula (!= x nil)) @-))
+          ((v (!= x nil) (= (not x) t))                           (build.disjoined-transitivity-of-pequal @- *1)))
+  :minatbl ((if . 3)
+            (not . 1)))
+
+(defderiv build.negative-lit-from-pequal-nil
+  :derive (!= (not (? a)) nil)
+  :from   ((proof x (= (? a) nil)))
+  :proof  (@derive
+           ((v (!= x nil) (= (not x) t))                          (build.theorem (theorem-not-when-nil)))
+           ((v (!= x nil) (!= (not x) nil))                       (build.disjoined-not-nil-from-t @-))
+           ((v (!= (? a) nil) (!= (not (? a)) nil))               (build.instantiation @- (@sigma (x . (? a)))))
+           ((= (? a) nil)                                         (@given x))
+           ((!= (not (? a)) nil)                                  (build.modus-ponens @- @--)))
+  :minatbl ((not . 1)))
+
+(defderiv build.disjoined-negative-lit-from-pequal-nil
+  :derive (v P (!= (not (? a)) nil))
+  :from   ((proof x (v P (= (? a) nil))))
+  :proof  (@derive
+           ((v (!= x nil) (= (not x) t))                          (build.theorem (theorem-not-when-nil)))
+           ((v (!= x nil) (!= (not x) nil))                       (build.disjoined-not-nil-from-t @-))
+           ((v (!= (? a) nil) (!= (not (? a)) nil))               (build.instantiation @- (@sigma (x . (? a)))))
+           ((v P (v (!= (? a) nil) (!= (not (? a)) nil)))         (build.expansion (@formula P) @-))
+           ((v P (= (? a) nil))                                   (@given x))
+           ((v P (!= (not (? a)) nil))                            (build.disjoined-modus-ponens @- @--)))
+  :minatbl ((not . 1)))
+
+
+
+(deftheorem theorem-not-when-not-nil
+  :derive (v (= x nil) (= (not x) nil))
+  :proof (@derive
+          ((v (= x nil) (= (if x y z) y))                         (build.axiom (axiom-if-when-not-nil)))
+          ((v (= x nil) (= (if x nil t) nil))                     (build.instantiation @- (@sigma (y . nil) (z . t)))   *1)
+          ((= (not x) (if x nil t))                               (build.axiom (definition-of-not)))
+          ((v (= x nil) (= (not x) (if x nil t)))                 (build.expansion (@formula (= x nil)) @-))
+          ((v (= x nil) (= (not x) nil))                          (build.disjoined-transitivity-of-pequal @- *1)))
+  :minatbl ((if . 3)
+            (not . 1)))
+
+(defderiv build.pequal-nil-from-negative-lit
+  :derive (= (? a) nil)
+  :from   ((proof x (!= (not (? a)) nil)))
+  :proof  (@derive
+           ((v (= x nil) (= (not x) nil))                         (build.theorem (theorem-not-when-not-nil)))
+           ((v (= (not x) nil) (= x nil))                         (build.commute-or @-))
+           ((v (= (not (? a)) nil) (= (? a) nil))                 (build.instantiation @- (@sigma (x . (? a)))))
+           ((!= (not (? a)) nil)                                  (@given x))
+           ((= (? a) nil)                                         (build.modus-ponens-2 @- @--)))
+  :minatbl ((not . 1)))
+
+(defderiv build.negative-lit-from-not-pequal-nil
+  :derive (= (not (? a)) nil)
+  :from   ((proof x (!= (? a) nil)))
+  :proof  (@derive
+           ((v (= x nil) (= (not x) nil))          (build.theorem (theorem-not-when-not-nil)))
+           ((v (= (? a) nil) (= (not (? a)) nil))  (build.instantiation @- (@sigma (x . (? a)))))
+           ((!= (? a) nil)                         (@given x))
+           ((= (not (? a)) nil)                    (build.modus-ponens-2 @- @--)))
+  :minatbl ((not . 1)))
+
+(defderiv build.disjoined-pequal-nil-from-negative-lit
+  :derive (v P (= (? a) nil))
+  :from   ((proof x (v P (!= (not (? a)) nil))))
+  :proof  (@derive
+           ((v (= x nil) (= (not x) nil))                         (build.theorem (theorem-not-when-not-nil)))
+           ((v (= (not x) nil) (= x nil))                         (build.commute-or @-))
+           ((v (= (not (? a)) nil) (= (? a) nil))                 (build.instantiation @- (@sigma (x . (? a)))))
+           ((v P (v (= (not (? a)) nil) (= (? a) nil)))           (build.expansion (@formula P) @-))
+           ((v P (= (? a) nil))                                   (@given x))
+           ((v P (= (? a) nil))                                   (build.disjoined-modus-ponens-2 @- @--)))
+  :minatbl ((not . 1)))
+
+
+
+
+(deftheorem theorem-not-of-not
+  :derive (= (not (not x)) (if x t nil))
+  :proof  (@derive
+           ((= (not x) (if x nil t))                              (build.axiom (definition-of-not)))
+           ((= (not (not x)) (not (if x nil t)))                  (build.pequal-by-args 'not (list @-)))
+           ((= (not (if x nil t)) (if (if x nil t) nil t))        (build.instantiation @-- (@sigma (x . (if x nil t)))))
+           ((= (not (not x)) (if (if x nil t) nil t))             (build.transitivity-of-pequal @-- @-)                       *1)
+           ;; ---
+           ((= x x)                                               (build.reflexivity (@term x))                               *2a)
+           ((= (if nil y z) z)                                    (build.theorem (theorem-if-redux-nil)))
+           ((= (if nil nil t) t)                                  (build.instantiation @- (@sigma (y . nil) (z . t)))         *2b)
+           ((= (if t y z) y)                                      (build.theorem (theorem-if-redux-t)))
+           ((= (if t nil t) nil)                                  (build.instantiation @- (@sigma (y . nil) (z . t)))         *2c)
+           ((= (if x (if nil nil t) (if t nil t)) (if x t nil))   (build.pequal-by-args 'if (list *2a *2b *2c))               *2)
+           ;; ---
+           ((= (if (if x y z) p q)
+               (if x (if y p q) (if z p q)))                      (build.theorem (theorem-if-redux-test)))
+           ((= (if (if x nil t) nil t)
+               (if x (if nil nil t) (if t nil t)))                (build.instantiation @- (@sigma (y . nil) (z . t) (p . nil) (q . t))))
+           ((= (if (if x nil t) nil t) (if x t nil))              (build.transitivity-of-pequal @- *2))
+           ((= (not (not x)) (if x t nil))                        (build.transitivity-of-pequal *1 @-)))
+  :minatbl ((if . 3)
+            (not . 1)))
+
+
+
+
+
+
+(deftheorem theorem-iff-of-if-x-t-nil
+  :derive (= (iff (if x t nil) x) t)
+  :proof  (@derive
+           ((v (= x nil) (= (if x y z) y))                       (build.axiom (axiom-if-when-not-nil)))
+           ((v (= x nil) (= (if x t nil) t))                     (build.instantiation @- (@sigma (y . t) (z . nil)))                           *1a)
+           ((= x x)                                              (build.reflexivity (@term x)))
+           ((v (= x nil) (= x x))                                (build.expansion (@formula (= x nil)) @-)                                     *1b)
+           ((v (= x nil) (= (iff (if x t nil) x) (iff t x)))     (build.disjoined-pequal-by-args 'iff (@formula (= x nil)) (list *1a *1b))     *1c)
+           ((= (iff x y) (iff y x))                              (build.theorem (theorem-symmetry-of-iff)))
+           ((= (iff t x) (iff x t))                              (build.instantiation @- (@sigma (x . t) (y . x))))
+           ((v (= x nil) (= (iff t x) (iff x t)))                (build.expansion (@formula (= x nil)) @-))
+           ((v (= x nil) (= (iff (if x t nil) x) (iff x t)))     (build.disjoined-transitivity-of-pequal *1c @-))
+           ((v (= x nil) (= (iff x t) t))                        (build.theorem (theorem-iff-t-when-not-nil)))
+           ((v (= x nil) (= (iff (if x t nil) x) t))             (build.disjoined-transitivity-of-pequal @-- @-)                               *1)
+           ;; ---
+           ((v (!= x nil) (= (if x y z) z))                      (build.axiom (axiom-if-when-nil)))
+           ((v (!= x nil) (= (if x t nil) nil))                  (build.instantiation @- (@sigma (y . t) (z . nil)))                           *2a)
+           ((= x x)                                              (build.reflexivity (@term x)))
+           ((v (!= x nil) (= x x))                               (build.expansion (@formula (!= x nil)) @-)                                    *2b)
+           ((v (!= x nil) (= (iff (if x t nil) x) (iff nil x)))  (build.disjoined-pequal-by-args 'iff (@formula (!= x nil)) (list *2a *2b))    *2c)
+           ((= (iff x y) (iff y x))                              (build.theorem (theorem-symmetry-of-iff)))
+           ((= (iff nil x) (iff x nil))                          (build.instantiation @- (@sigma (x . nil) (y . x))))
+           ((v (!= x nil) (= (iff nil x) (iff x nil)))           (build.expansion (@formula (!= x nil)) @-))
+           ((v (!= x nil) (= (iff (if x t nil) x) (iff x nil)))  (build.disjoined-transitivity-of-pequal *2c @-))
+           ((v (!= x nil) (= (iff x nil) t))                     (build.theorem (theorem-iff-nil-when-nil)))
+           ((v (!= x nil) (= (iff (if x t nil) x) t))            (build.disjoined-transitivity-of-pequal @-- @-)                               *2)
+           ;; ---
+           ((v (= (iff (if x t nil) x) t)
+               (= (iff (if x t nil) x) t))                       (build.cut *1 *2))
+           ((= (iff (if x t nil) x) t)                           (build.contraction @-)))
+  :minatbl ((if . 3)
+            (iff . 2)))
+
+
+(deftheorem theorem-not-of-not-under-iff
+  :derive (= (iff (not (not x)) x) t)
+  :proof  (@derive
+           ((= (not (not x)) (if x t nil))                        (build.theorem (theorem-not-of-not)))
+           ((= x x)                                               (build.reflexivity (@term x)))
+           ((= (iff (not (not x)) x) (iff (if x t nil) x))        (build.pequal-by-args 'iff (list @-- @-)))
+           ((= (iff (if x t nil) x) t)                            (build.theorem (theorem-iff-of-if-x-t-nil)))
+           ((= (iff (not (not x)) x) t)                           (build.transitivity-of-pequal @-- @-)))
+  :minatbl ((if . 3)
+            (iff . 2)
+            (not . 1)))
+
+
+
+(deftheorem theorem-iff-when-not-nil
+  :derive (v (!= (not x) nil) (= (iff x t) t))
+  :proof (@derive
+          ((v (= x nil) (= (iff x t) t))         (build.theorem (theorem-iff-t-when-not-nil)))
+          ((v (= (iff x t) t) (= x nil))         (build.commute-or @-))
+          ((v (= (iff x t) t) (!= (not x) nil))  (build.disjoined-negative-lit-from-pequal-nil @-))
+          ((v (!= (not x) nil) (= (iff x t) t))  (build.commute-or @-)))
+  :minatbl ((iff . 2)
+            (not . 1)))
+
+(defderiv build.iff-when-not-nil
+  :derive (= (iff (? a) t) t)
+  :from   ((proof x (= (not (? a)) nil)))
+  :proof  (@derive
+           ((v (!= (not x) nil) (= (iff x t) t))          (build.theorem (theorem-iff-when-not-nil)))
+           ((v (!= (not (? a)) nil) (= (iff (? a) t) t))  (build.instantiation @- (@sigma (x . (? a)))))
+           ((= (not (? a)) nil)                           (@given x))
+           ((= (iff (? a) t) t)                           (build.modus-ponens @- @--)))
+  :minatbl ((iff . 2)))
+
+(defderiv build.disjoined-iff-when-not-nil
+  :derive (v P (= (iff (? a) t) t))
+  :from   ((proof x (v P (= (not (? a)) nil))))
+  :proof  (@derive
+           ((v (!= (not x) nil) (= (iff x t) t))                (build.theorem (theorem-iff-when-not-nil)))
+           ((v (!= (not (? a)) nil) (= (iff (? a) t) t))        (build.instantiation @- (@sigma (x . (? a)))))
+           ((v P (v (!= (not (? a)) nil) (= (iff (? a) t) t)))  (build.expansion (@formula P) @-))
+           ((v P (= (not (? a)) nil))                           (@given x))
+           ((v P (= (iff (? a) t) t))                           (build.disjoined-modus-ponens @- @--)))
+  :minatbl ((iff . 2)))
+
+
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/build/pequal-list.lisp acl2-6.3/books/milawa/ACL2/build/pequal-list.lisp
--- acl2-6.2/books/milawa/ACL2/build/pequal-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/pequal-list.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,211 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop-list")
+(include-book "pequal")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "pequal-list.tex")
+
+(defund build.reflexivity-list (x)
+  ;; BOZO update the defderiv table with the axiom?
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (cons (build.reflexivity (car x))
+            (build.reflexivity-list (cdr x)))
+    nil))
+
+(defobligations build.reflexivity-list
+  (build.reflexivity))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.reflexivity-list)))
+
+ (defthm forcing-logic.appeal-listp-of-build.reflexivity-list
+   (implies (force (logic.term-listp x))
+            (equal (logic.appeal-listp (build.reflexivity-list x))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-build.reflexivity-list
+   (implies (force (logic.term-listp x))
+            (equal (logic.strip-conclusions (build.reflexivity-list x))
+                   (logic.pequal-list x x))))
+
+ (defthm@ forcing-logic.proof-listp-of-build.reflexivity-list
+   (implies (force (and (logic.term-listp x)
+                        (logic.term-list-atblp x atbl)
+                        (@obligations build.reflexivity-list)))
+            (equal (logic.proof-listp (build.reflexivity-list x) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.pequal-by-args (f as)
+  ;; Derive (f t1 ... tn) = (f s1 ... sn) from t1 = s1, ..., tn = sn.
+  (declare (xargs :guard (and (logic.function-namep f)
+                              (logic.appeal-listp as)
+                              (logic.all-atomicp (logic.strip-conclusions as)))
+                  :guard-hints (("Goal" :in-theory (enable logic.functional-axiom)))))
+  (let* ((conclusions (logic.strip-conclusions as)) ;; (t1 = s1, ..., tn = sn)
+         (t*          (logic.=lhses conclusions))   ;; (t1, ..., tn)
+         (s*          (logic.=rhses conclusions)))  ;; (s1, ..., sn)
+    (cond ((equal t* s*)
+           ;; Optimization.  We can just use reflexivity.
+           (build.reflexivity (logic.function f t*)))
+          (t
+           ;; Otherwise, take the functional equality axiom,
+           ;;    t1 = s1 -> ... -> tn = sn -> (f t1 ... tn) = (f s1 ... sn),
+           ;; and apply repeated modus ponens.
+           (build.modus-ponens-list (logic.pequal (logic.function f t*) (logic.function f s*))
+                                    as
+                                    (build.functional-equality f t* s*))))))
+
+(defobligations build.pequal-by-args
+  (build.reflexivity build.modus-ponens-list build.functional-equality))
+
+(encapsulate
+ ()
+ (local (in-theory (enable logic.functional-axiom build.pequal-by-args)))
+
+ (defthm forcing-build.pequal-by-args-under-iff
+   (iff (build.pequal-by-args f as)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.pequal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.appeal-listp as)
+                        (logic.all-atomicp (logic.strip-conclusions as))))
+            (equal (logic.appealp (build.pequal-by-args f as))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.pequal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.appeal-listp as)
+                        (logic.all-atomicp (logic.strip-conclusions as))))
+            (equal (logic.conclusion (build.pequal-by-args f as))
+                   (logic.pequal (logic.function f (logic.=lhses (logic.strip-conclusions as)))
+                                 (logic.function f (logic.=rhses (logic.strip-conclusions as))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.pequal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.appeal-listp as)
+                        (logic.all-atomicp (logic.strip-conclusions as))
+                        (logic.proof-listp as axioms thms atbl)
+                        (equal (len as) (cdr (lookup f atbl)))
+                        (@obligations build.pequal-by-args)))
+            (equal (logic.proofp (build.pequal-by-args f as) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.disjoined-pequal-by-args (f p as)
+  ;; Derive P v (f t1 ... tn) = (f s1 ... sn) from P v t1 = s1, ..., P v tn = sn
+  (declare (xargs :guard (and (logic.function-namep f)
+                              (logic.formulap p)
+                              (logic.appeal-listp as)
+                              (let ((aconcs (logic.strip-conclusions as)))
+                                (and (logic.all-disjunctionsp aconcs)
+                                     (all-equalp p (logic.vlhses aconcs))
+                                     (logic.all-atomicp (logic.vrhses aconcs)))))
+                  :guard-hints(("Goal" :in-theory (enable logic.functional-axiom)))))
+  (let* ((ti=si* (logic.vrhses (logic.strip-conclusions as)))  ;; (t1 = s1, ..., tn = sn)
+         (t*     (logic.=lhses ti=si*))                        ;; (t1, ..., tn)
+         (s*     (logic.=rhses ti=si*)))                       ;; (s1, ..., sn)
+     (cond ((equal t* s*)
+            ;; Optimization.  We can just use reflexivity and expansion.
+            (build.expansion P (build.reflexivity (logic.function f t*))))
+           (t
+            ;; Otherwise, take the functional equality axiom,
+            ;;    t1 = s1 -> ... -> tn = sn -> (f t1 ... tn) = (f s1 ... sn),
+            ;; expand it with P,
+            ;;    P v t1 = s1 -> ... -> tn = sn -> (f t1 ... tn) = (f s1 ... sn),
+            ;; and apply repeated disjoined modus ponens.
+            (build.disjoined-modus-ponens-list (logic.pequal (logic.function f t*) (logic.function f s*))
+                                               as
+                                               (build.expansion p (build.functional-equality f t* s*)))))))
+
+(defobligations build.disjoined-pequal-by-args
+  (build.expansion build.reflexivity build.disjoined-modus-ponens-list build.functional-equality))
+
+(encapsulate
+ ()
+ (local (in-theory (enable logic.functional-axiom build.disjoined-pequal-by-args)))
+
+ (defthm forcing-build.disjoined-pequal-by-args-under-iff
+   (iff (build.disjoined-pequal-by-args f p as)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.disjoined-pequal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.formulap p)
+                        (logic.appeal-listp as)
+                        (logic.all-disjunctionsp (logic.strip-conclusions as))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions as)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions as)))))
+            (equal (logic.appealp (build.disjoined-pequal-by-args f p as))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-pequal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.formulap p)
+                        (logic.appeal-listp as)
+                        (logic.all-disjunctionsp (logic.strip-conclusions as))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions as)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions as)))))
+            (equal (logic.conclusion (build.disjoined-pequal-by-args f p as))
+                   (logic.por p (logic.pequal (logic.function f (logic.=lhses (logic.vrhses (logic.strip-conclusions as))))
+                                              (logic.function f (logic.=rhses (logic.vrhses (logic.strip-conclusions as))))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-build.disjoined-pequal-by-args
+   (implies (force (and (logic.function-namep f)
+                        (logic.formulap p)
+                        (logic.appeal-listp as)
+                        (logic.all-disjunctionsp (logic.strip-conclusions as))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions as)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions as)))
+                        (logic.formula-atblp p atbl)
+                        (logic.proof-listp as axioms thms atbl)
+                        (equal (cdr (lookup f atbl)) (len as))
+                        (@obligations build.disjoined-pequal-by-args)))
+            (equal (logic.proofp (build.disjoined-pequal-by-args f p as) axioms thms atbl)
+                   t))))
+
+(dd.close)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/build/pequal.lisp acl2-6.3/books/milawa/ACL2/build/pequal.lisp
--- acl2-6.2/books/milawa/ACL2/build/pequal.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/pequal.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,310 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "pequal.tex")
+
+(defderiv build.reflexivity
+  :from   ((term a (? a)))
+  :derive (= (? a) (? a))
+  :proof  (@derive ((= x x)           (build.axiom (axiom-reflexivity)))
+                   ((= (? a) (? a))   (build.instantiation @- (@sigma (x . (? a)))))))
+
+(defderiv build.equality
+  :from   ((term a1 (? a_1))
+           (term b1 (? b_1))
+           (term a2 (? a_2))
+           (term b2 (? b_2)))
+  :derive (v (!= (? a_1) (? b_1)) (v (!= (? a_2) (? b_2)) (v (!= (? a_1) (? a_2)) (= (? b_1) (? b_2)))))
+  :proof (@derive ((v (!= x1 y1) (v (!= x2 y2) (v (!= x1 x2) (= y1 y2))))                                          (build.axiom (axiom-equality)))
+                  ((v (!= (? a_1) (? b_1)) (v (!= (? a_2) (? b_2)) (v (!= (? a_1) (? a_2)) (= (? b_1) (? b_2)))))  (build.instantiation @- (@sigma (x1 . (? a_1)) (x2 . (? a_2)) (y1 . (? b_1)) (y2 . (? b_2)))))))
+
+(deftheorem theorem-commutativity-of-pequal
+  :derive (v (!= x y) (= y x))
+  :proof (@derive ((= x x)                                             (build.reflexivity (@term x)))
+                  ((v (!= x y) (= x x))                                (build.expansion (@formula (!= x y)) @-)  *1)
+                  ((v (!= x y) (v (!= x x) (v (!= x x) (= y x))))      (build.equality (@term x) (@term y) (@term x) (@term x)))
+                  ((v (!= x y) (v (!= x x) (= y x)))                   (build.disjoined-modus-ponens *1 @-))
+                  ((v (!= x y) (= y x))                                (build.disjoined-modus-ponens *1 @-))))
+
+(defderiv build.commute-pequal
+  :derive (= (? b) (? a))
+  :from   ((proof x (= (? a) (? b))))
+  :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use reflexivity.
+                 (@derive ((= (? b) (? a))                             (build.reflexivity (@term (? a))))))
+                (t
+                 (@derive ((v (!= x y) (= y x))                        (build.theorem (theorem-commutativity-of-pequal)))
+                          ((v (!= (? a) (? b)) (= (? b) (? a)))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                          ((= (? a) (? b))                             (@given x))
+                          ((= (? b) (? a))                             (build.modus-ponens @- @--))))))
+
+(defderiv build.disjoined-commute-pequal
+  :derive (v P (= (? b) (? a)))
+  :from   ((proof x (v P (= (? a) (? b)))))
+  :proof  (cond ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use reflexivity and expansion.
+                 (@derive ((= (? b) (? a))                             (build.reflexivity (@term (? a))))
+                          ((v P (= (? b) (? a)))                       (build.expansion (@formula P) @-))))
+                (t
+                 (@derive ((v (!= x y) (= y x))                        (build.theorem (theorem-commutativity-of-pequal)))
+                          ((v (!= (? a) (? b)) (= (? b) (? a)))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)))))
+                          ((v P (v (!= (? a) (? b)) (= (? b) (? a))))  (build.expansion (@formula P) @-))
+                          ((v P (= (? a) (? b)))                       (@given x))
+                          ((v P (= (? b) (? a)))                       (build.disjoined-modus-ponens @- @--))))))
+
+(defderiv build.commute-not-pequal
+  :derive (!= (? b) (? a))
+  :from   ((proof x (!= (? a) (? b))))
+  :proof  (@derive ((v (!= x y) (= y x))                               (build.theorem (theorem-commutativity-of-pequal)))
+                   ((v (= y x) (!= x y))                               (build.commute-or @-))
+                   ((v (= (? a) (? b)) (!= (? b) (? a)))               (build.instantiation @- (@sigma (x . (? b)) (y . (? a)))))
+                   ((!= (? a) (? b))                                   (@given x))
+                   ((!= (? b) (? a))                                   (build.modus-ponens-2 @- @--))))
+
+(defderiv build.disjoined-commute-not-pequal
+  :derive (v P (!= (? b) (? a)))
+  :from   ((proof x (v P (!= (? a) (? b)))))
+  :proof  (@derive ((v (!= x y) (= y x))                               (build.theorem (theorem-commutativity-of-pequal)))
+                   ((v (= y x) (!= x y))                               (build.commute-or @-))
+                   ((v (= (? a) (? b)) (!= (? b) (? a)))               (build.instantiation @- (@sigma (x . (? b)) (y . (? a)))))
+                   ((v P (v (= (? a) (? b)) (!= (? b) (? a))))         (build.expansion (@formula P) @-))
+                   ((v P (!= (? a) (? b)))                             (@given x))
+                   ((v P (!= (? b) (? a)))                             (build.disjoined-modus-ponens-2 @- @--))))
+
+
+
+(deftheorem theorem-substitute-into-not-pequal
+  :derive (v (= x y) (v (!= z x) (!= z y)))
+  :proof  (@derive
+           ((= y y)                                           (build.reflexivity (@term y)))
+           ((v (!= z x) (= y y))                              (build.expansion (@formula (!= z x)) @-))
+           ((v (!= z x) (v (!= y y) (v (!= z y) (= x y))))    (build.equality (@term z) (@term x) (@term y) (@term y)))
+           ((v (!= z x) (v (!= z y) (= x y)))                 (build.disjoined-modus-ponens @-- @-))
+           ((v (v (!= z x) (!= z y)) (= x y))                 (build.associativity @-))
+           ((v (= x y) (v (!= z x) (!= z y)))                 (build.commute-or @-))))
+
+(defderiv build.substitute-into-not-pequal
+  :derive (!= (? c) (? b))
+  :from   ((proof x (!= (? a) (? b)))
+           (proof y (= (? c) (? a))))
+  :proof  (cond
+           ((equal (@term (? a)) (@term (? c)))
+            ;; Optimization.  Just use the proof of a != b.
+            (@derive ((!= (? c) (? b))                                           (logic.appeal-identity x))))
+           (t
+            (@derive ((v (= x y) (v (!= z x) (!= z y)))                          (build.theorem (theorem-substitute-into-not-pequal)))
+                     ((v (= (? a) (? b)) (v (!= (? c) (? a)) (!= (? c) (? b))))  (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                     ((!= (? a) (? b))                                           (@given x))
+                     ((v (!= (? c) (? a)) (!= (? c) (? b)))                      (build.modus-ponens-2 @- @--))
+                     ((= (? c) (? a))                                            (@given y))
+                     ((!= (? c) (? b))                                           (build.modus-ponens @- @--)))))
+  :highlevel-override (if (equal (@term (? a)) (@term (? c)))
+                          x
+                        (logic.appeal 'build.substitute-into-not-pequal
+                                      (@formula (!= (? c) (? b)))
+                                      (list x y)
+                                      nil)))
+
+(defderiv build.disjoined-substitute-into-not-pequal-lemma-1
+  :from   ((proof x (v P (!= (? a) (? b))))
+           (term c (? c)))
+  :derive (v P (v (!= (? c) (? a)) (!= (? c) (? b))))
+  :proof  (@derive ((v (= x y) (v (!= z x) (!= z y)))                                (build.theorem (theorem-substitute-into-not-pequal)))
+                   ((v (= (? a) (? b)) (v (!= (? c) (? a)) (!= (? c) (? b))))        (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                   ((v P (v (= (? a) (? b)) (v (!= (? c) (? a)) (!= (? c) (? b)))))  (build.expansion (@formula P) @-))
+                   ((v P (!= (? a) (? b)))                                           (@given x))
+                   ((v P (v (!= (? c) (? a)) (!= (? c) (? b))))                      (build.disjoined-modus-ponens-2 @- @--))))
+
+(defderiv build.disjoined-substitute-into-not-pequal
+  :derive (v P (!= (? c) (? b)))
+  :from   ((proof x (v P (!= (? a) (? b))))
+           (proof y (v P (= (? c) (? a)))))
+  :proof  (cond ((equal (@term (? a)) (@term (? c)))
+                 ;; Optimization.  Just use the proof of P v a != b
+                 (@derive ((v P (!= (? c) (? b)))                                           (logic.appeal-identity x))))
+                (t
+                 (@derive ((v P (v (!= (? c) (? a)) (!= (? c) (? b))))                      (build.disjoined-substitute-into-not-pequal-lemma-1 x (@term (? c))))
+                          ((v P (= (? c) (? a)))                                            (@given y))
+                          ((v P (!= (? c) (? b)))                                           (build.disjoined-modus-ponens @- @--)))))
+  :highlevel-override (if (equal (@term (? a)) (@term (? c)))
+                          x
+                        (LOGIC.APPEAL 'BUILD.DISJOINED-SUBSTITUTE-INTO-NOT-PEQUAL
+                                      (@FORMULA (V P (!= (? C) (? B))))
+                                      (LIST X Y)
+                                      NIL)))
+
+
+(deftheorem theorem-transitivity-of-pequal
+  :derive (v (!= x y) (v (!= y z) (= x z)))
+  :proof  (@derive
+           ((v (!= x y) (= y x))                                                       (build.theorem (theorem-commutativity-of-pequal)))
+           ((v (!= x y) (v (!= y z) (= y x)))                                          (build.disjoined-left-expansion @- (@formula (!= y z))))
+           ((v (v (!= x y) (!= y z)) (= y x))                                          (build.associativity @-)                                         *1)
+           ((v (!= y z) (= y z))                                                       (build.propositional-schema (@formula (= y z))))
+           ((v (!= x y) (v (!= y z) (= y z)))                                          (build.expansion (@formula (!= x y)) @-))
+           ((v (v (!= x y) (!= y z)) (= y z))                                          (build.associativity @-)                                         *2)
+           ((= y y)                                                                    (build.reflexivity (@term y)))
+           ((v (v (!= x y) (!= y z)) (= y y))                                          (build.expansion (@formula (v (!= x y) (!= y z))) @-)            *3)
+           ((v (!= y x) (v (!= y z) (v (!= y y) (= x z))))                             (build.equality (@term y) (@term x) (@term y) (@term z)))
+           ((v (v (!= x y) (!= y z)) (v (!= y x) (v (!= y z) (v (!= y y) (= x z)))))   (build.expansion (@formula (v (!= x y) (!= y z))) @-))
+           ((v (v (!= x y) (!= y z)) (v (!= y z) (v (!= y y) (= x z))))                (build.disjoined-modus-ponens *1 @-))
+           ((v (v (!= x y) (!= y z)) (v (!= y y) (= x z)))                             (build.disjoined-modus-ponens *2 @-))
+           ((v (v (!= x y) (!= y z)) (= x z))                                          (build.disjoined-modus-ponens *3 @-))
+           ((v (!= x y) (v (!= y z) (= x z)))                                          (build.right-associativity @-))))
+
+(defderiv build.transitivity-of-pequal
+  :derive (= (? a) (? c))
+  :from   ((proof x (= (? a) (? b)))
+           (proof y (= (? b) (? c))))
+  :proof  (cond ((equal (@term (? a)) (@term (? c)))
+                 ;; Optimization.  Just use reflexivity.
+                 (@derive ((= (? a) (? c))                                             (build.reflexivity (@term (? a))))))
+                ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use the proof that b = c.
+                 (@derive ((= (? a) (? c))                                             (logic.appeal-identity y))))
+                ((equal (@term (? b)) (@term (? c)))
+                 ;; Optimization.  Just use the proof that a = b.
+                 (@derive ((= (? a) (? c))                                             (logic.appeal-identity x))))
+                (t
+                 (@derive ((v (!= x y) (v (!= y z) (= x z)))                           (build.theorem (theorem-transitivity-of-pequal)))
+                          ((v (!= (? a) (? b)) (v (!= (? b) (? c)) (= (? a) (? c))))   (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                          ((= (? a) (? b))                                             (@given x))
+                          ((v (!= (? b) (? c)) (= (? a) (? c)))                        (build.modus-ponens @- @--))
+                          ((= (? b) (? c))                                             (@given y))
+                          ((= (? a) (? c))                                             (build.modus-ponens @- @--)))))
+  :highlevel-override (cond ((equal (@term (? a)) (@term (? c)))
+                             (build.reflexivity (@term (? a))))
+                            ((equal (@term (? a)) (@term (? b)))
+                             y)
+                            ((equal (@term (? b)) (@term (? c)))
+                             x)
+                            (t
+                             (LOGIC.APPEAL 'BUILD.TRANSITIVITY-OF-PEQUAL
+                                           (@FORMULA (= (? A) (? C)))
+                                           (LIST X Y)
+                                           NIL))))
+
+(defderiv build.disjoined-transitivity-of-pequal-lemma-1
+    :derive (v P (= (? a) (? c)))
+    :from   ((proof x (v P (= (? a) (? b))))
+             (proof y (v P (= (? b) (? c)))))
+    :proof  (@derive ((v (!= x y) (v (!= y z) (= x z)))                                 (build.theorem (theorem-transitivity-of-pequal)))
+                     ((v (!= (? a) (? b)) (v (!= (? b) (? c)) (= (? a) (? c))))         (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+                     ((v P (v (!= (? a) (? b)) (v (!= (? b) (? c)) (= (? a) (? c)))))   (build.expansion (@formula P) @-))
+                     ((v P (= (? a) (? b)))                                             (@given x))
+                     ((v P (v (!= (? b) (? c)) (= (? a) (? c))))                        (build.disjoined-modus-ponens @- @--))
+                     ((v P (= (? b) (? c)))                                             (@given y))
+                     ((v P (= (? a) (? c)))                                             (build.disjoined-modus-ponens @- @--))))
+
+(defderiv build.disjoined-transitivity-of-pequal
+  :derive (v P (= (? a) (? c)))
+  :from   ((proof x (v P (= (? a) (? b))))
+           (proof y (v P (= (? b) (? c)))))
+  :proof  (cond ((equal (@term (? a)) (@term (? c)))
+                 ;; Optimization.  Just use expansion and reflexivity.
+                 (@derive ((= (? a) (? c))                          (build.reflexivity (@term (? a))))
+                          ((v P (= (? a) (? c)))                    (build.expansion (@formula P) @-))))
+                ((equal (@term (? a)) (@term (? b)))
+                 ;; Optimization.  Just use the proof of P v b = c.
+                 (@derive ((v P (= (? a) (? c)))                    (logic.appeal-identity y))))
+                ((equal (@term (? b)) (@term (? c)))
+                 ;; Optimization.  Just use the proof of P v a = b.
+                 (@derive ((v P (= (? a) (? c)))                    (logic.appeal-identity x))))
+                (t
+                 (@derive ((v P (= (? a) (? c)))                    (build.disjoined-transitivity-of-pequal-lemma-1 x y)))))
+  :highlevel-override (cond ((equal (@term (? a)) (@term (? c)))
+                             (@derive ((= (? a) (? c))          (build.reflexivity (@term (? a))))
+                                      ((v P (= (? a) (? c)))    (build.expansion (@formula P) @-))))
+                            ((equal (@term (? a)) (@term (? b)))
+                             y)
+                            ((equal (@term (? b)) (@term (? c)))
+                             x)
+                            (t
+                             (LOGIC.APPEAL 'BUILD.DISJOINED-TRANSITIVITY-OF-PEQUAL
+                                           (@FORMULA (V P (= (? A) (? C))))
+                                           (LIST X Y)
+                                           NIL))))
+
+(deftheorem theorem-not-t-or-not-nil
+  :derive (v (!= x t) (!= x nil))
+  :proof  (@derive ((!= t nil)               (build.axiom (axiom-t-not-nil)))
+                   ((v (!= x t) (!= t nil))  (build.expansion (@formula (!= x t)) @-))
+                   ((v (!= x t) (= x t))     (build.propositional-schema (@formula (= x t))))
+                   ((v (!= x t) (!= x nil))  (build.disjoined-substitute-into-not-pequal @-- @-))))
+
+(defderiv build.not-nil-from-t
+  :derive (!= (? a) nil)
+  :from   ((proof x (= (? a) t)))
+  :proof  (@derive
+           ((v (!= x t) (!= x nil))           (build.theorem (theorem-not-t-or-not-nil)))
+           ((v (!= (? a) t) (!= (? a) nil))   (build.instantiation @- (@sigma (x . (? a)))))
+           ((= (? a) t)                       (@given x))
+           ((!= (? a) nil)                    (build.modus-ponens @- @--))))
+
+(defderiv build.disjoined-not-nil-from-t
+  :derive (v P (!= (? a) nil))
+  :from   ((proof x (v P (= (? a) t))))
+  :proof  (@derive ((v (!= x t) (!= x nil))                 (build.theorem (theorem-not-t-or-not-nil)))
+                   ((v (!= (? a) t) (!= (? a) nil))         (build.instantiation @- (@sigma (x . (? a)))))
+                   ((v P (v (!= (? a) t) (!= (? a) nil)))   (build.expansion (@formula P) @-))
+                   ((v P (= (? a) t))                       (@given x))
+                   ((v P (!= (? a) nil))                    (build.disjoined-modus-ponens @- @--))))
+
+(defderiv build.not-t-from-nil
+  :derive (!= (? a) t)
+  :from   ((proof x (= (? a) nil)))
+  :proof  (@derive ((v (!= x t) (!= x nil))           (build.theorem (theorem-not-t-or-not-nil)))
+                   ((v (!= x nil) (!= x t))           (build.commute-or @-))
+                   ((v (!= (? a) nil) (!= (? a) t))   (build.instantiation @- (@sigma (x . (? a)))))
+                   ((= (? a) nil)                     (@given x))
+                   ((!= (? a) t)                      (build.modus-ponens @- @--))))
+
+(defderiv build.disjoined-not-t-from-nil
+  :derive (v P (!= (? a) t))
+  :from   ((proof x (v P (= (? a) nil))))
+  :proof  (@derive ((v (!= x t) (!= x nil))                 (build.theorem (theorem-not-t-or-not-nil)))
+                   ((v (!= x nil) (!= x t))                 (build.commute-or @-))
+                   ((v (!= (? a) nil) (!= (? a) t))         (build.instantiation @- (@sigma (x . (? a)))))
+                   ((v P (v (!= (? a) nil) (!= (? a) t)))   (build.expansion (@formula P) @-))
+                   ((v P (= (? a) nil))                     (@given x))
+                   ((v P (!= (? a) t))                      (build.disjoined-modus-ponens @- @--))))
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/build/prop-list.lisp acl2-6.3/books/milawa/ACL2/build/prop-list.lisp
--- acl2-6.2/books/milawa/ACL2/build/prop-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/prop-list.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,698 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; List-based rules.
+
+(defund@ build.modus-ponens-list (b as base)
+  ;;    A1
+  ;;    ...
+  ;;    An
+  ;;    ~A1 v ... v ~An v B
+  ;;  -----------------------
+  ;;    B
+  (declare (xargs :guard (and (logic.formulap b)
+                              (logic.appeal-listp as)
+                              (logic.appealp base)
+                              (equal (logic.conclusion base)
+                                     (logic.disjoin-formulas (app (logic.negate-formulas (logic.strip-conclusions as))
+                                                                  (list b)))))))
+  (cond ((consp as)
+         (@derive ((v (! A_1) (v dots (v (! A_n) B)))  (@given base))
+                  (A_1                                 (@given (car as)))
+                  ((v (! A_2) (v dots (v (! A_n) B)))  (build.modus-ponens @- @--))
+                  (B                                   (build.modus-ponens-list b (cdr as) @-))))
+        (t
+         (@derive (B                                   (@given (logic.appeal-identity base)))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.modus-ponens-list)))
+
+ (defthm forcing-build.modus-ponens-list-under-iff
+   (iff (build.modus-ponens-list b as base)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.modus-ponens-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (equal (logic.conclusion base)
+                               (logic.disjoin-formulas (app (logic.negate-formulas (logic.strip-conclusions as))
+                                                            (list b))))))
+            (equal (logic.appealp (build.modus-ponens-list b as base))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.modus-ponens-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (equal (logic.conclusion base)
+                               (logic.disjoin-formulas (app (logic.negate-formulas (logic.strip-conclusions as))
+                                                            (list b))))))
+            (equal (logic.conclusion (build.modus-ponens-list b as base))
+                   b))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proofp-of-build.modus-ponens-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (equal (logic.conclusion base)
+                               (logic.disjoin-formulas (app (logic.negate-formulas (logic.strip-conclusions as))
+                                                            (list b))))
+                        (logic.proof-listp as axioms thms atbl)
+                        (logic.proofp base axioms thms atbl)))
+            (equal (logic.proofp (build.modus-ponens-list b as base) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund@ build.modus-ponens-2-list (b as base)
+  ;;    ~A1
+  ;;    ...
+  ;;    ~An
+  ;;    A1 v ... v An v B
+  ;;  ---------------------
+  ;;    B
+  (declare (xargs :guard (and (logic.formulap b)
+                              (logic.appeal-listp as)
+                              (logic.appealp base)
+                              (logic.all-negationsp (logic.strip-conclusions as))
+                              (equal (logic.conclusion base)
+                                     (logic.disjoin-formulas (app (logic.~args (logic.strip-conclusions as))
+                                                                  (list b)))))))
+  (cond ((consp as)
+         (@derive ((v A1 (v dots (v An B)))   (@given base))
+                  ((! A1)                     (@given (car as)))
+                  ((v A2 (v dots (v An B)))   (build.modus-ponens-2 @- @--))
+                  (B                          (build.modus-ponens-2-list b (cdr as) @-))))
+        (t
+         (@derive (B                          (@given (logic.appeal-identity base)))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.modus-ponens-2-list)))
+
+ (defthm forcing-build.modus-ponens-2-list-under-iff
+   (iff (build.modus-ponens-2-list b as base)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.modus-ponens-2-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (logic.all-negationsp (logic.strip-conclusions as))
+                        (equal (logic.conclusion base)
+                               (logic.disjoin-formulas (app (logic.~args (logic.strip-conclusions as))
+                                                            (list b))))))
+            (equal (logic.appealp (build.modus-ponens-2-list b as base))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.modus-ponens-2-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (logic.all-negationsp (logic.strip-conclusions as))
+                        (equal (logic.conclusion base)
+                               (logic.disjoin-formulas (app (logic.~args (logic.strip-conclusions as))
+                                                            (list b))))))
+            (equal (logic.conclusion (build.modus-ponens-2-list b as base))
+                   b))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proofp-of-build.modus-ponens-2-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (logic.all-negationsp (logic.strip-conclusions as))
+                        (equal (logic.conclusion base)
+                               (logic.disjoin-formulas (app (logic.~args (logic.strip-conclusions as))
+                                                            (list b))))
+                        ;; ---
+                        (logic.proof-listp as axioms thms atbl)
+                        (logic.proofp base axioms thms atbl)))
+            (equal (logic.proofp (build.modus-ponens-2-list b as base) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund@ build.disjoined-modus-ponens-list (b as base)
+  ;; Derive P v B from P v A1, ..., P v An, and P v ~A1 v ~A2 v ... v ~An v B
+  (declare (xargs :guard (and (logic.formulap b)
+                              (logic.appeal-listp as)
+                              (logic.appealp base)
+                              (let ((aconcs   (logic.strip-conclusions as))
+                                    (baseconc (logic.conclusion base)))
+                                (and (logic.all-disjunctionsp aconcs)
+                                     (equal (logic.fmtype baseconc) 'por*)
+                                     (all-equalp (logic.vlhs baseconc) (logic.vlhses aconcs))
+                                     (equal (logic.vrhs baseconc)
+                                            (logic.disjoin-formulas (app (logic.negate-formulas (logic.vrhses aconcs))
+                                                                         (list b)))))))))
+  (cond ((consp as)
+         (@derive ((v P (v A_1 (v dots (v A_n B))))    (@given base))
+                  ((v P A_1)                           (@given (car as)))
+                  ((v P (v A_2 (v dots (v A_n B))))    (build.disjoined-modus-ponens @- @--))
+                  ((v P B)                             (build.disjoined-modus-ponens-list b (cdr as) @-))))
+        (t
+         (@derive ((v P B)                             (@given (logic.appeal-identity base)))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-modus-ponens-list)))
+
+ (defthm forcing-build.disjoined-modus-ponens-list-under-iff
+   (iff (build.disjoined-modus-ponens-list b as base)
+        t))
+
+ (defthm lemma-for-forcing-logic.appealp-of-build.disjoined-modus-ponens-list
+   (implies (and (logic.formulap b)
+                 (logic.appeal-listp as)
+                 (logic.appealp base)
+                 (logic.all-disjunctionsp (logic.strip-conclusions as))
+                 (equal (logic.fmtype (logic.conclusion base)) 'por*)
+                 (all-equalp (logic.vlhs (logic.conclusion base)) (logic.vlhses (logic.strip-conclusions as)))
+                 (equal (logic.vrhs (logic.conclusion base))
+                        (logic.disjoin-formulas (app (logic.negate-formulas (logic.vrhses (logic.strip-conclusions as)))
+                                                     (list b)))))
+            (and (logic.appealp (build.disjoined-modus-ponens-list b as base))
+                 (equal (logic.conclusion (build.disjoined-modus-ponens-list b as base))
+                        (logic.por (logic.vlhs (logic.conclusion base)) b))))
+  :rule-classes nil)
+
+ (defthm forcing-logic.appealp-of-build.disjoined-modus-ponens-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (logic.all-disjunctionsp (logic.strip-conclusions as))
+                        (equal (logic.fmtype (logic.conclusion base)) 'por*)
+                        (all-equalp (logic.vlhs (logic.conclusion base)) (logic.vlhses (logic.strip-conclusions as)))
+                        (equal (logic.vrhs (logic.conclusion base))
+                               (logic.disjoin-formulas (app (logic.negate-formulas (logic.vrhses (logic.strip-conclusions as)))
+                                                            (list b))))))
+            (equal (logic.appealp (build.disjoined-modus-ponens-list b as base))
+                   t))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-build.disjoined-modus-ponens-list)))))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-modus-ponens-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (logic.all-disjunctionsp (logic.strip-conclusions as))
+                        (equal (logic.fmtype (logic.conclusion base)) 'por*)
+                        (all-equalp (logic.vlhs (logic.conclusion base)) (logic.vlhses (logic.strip-conclusions as)))
+                        (equal (logic.vrhs (logic.conclusion base))
+                               (logic.disjoin-formulas (app (logic.negate-formulas (logic.vrhses (logic.strip-conclusions as)))
+                                                            (list b))))))
+            (equal (logic.conclusion (build.disjoined-modus-ponens-list b as base))
+                   (logic.por (logic.vlhs (logic.conclusion base)) b)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-build.disjoined-modus-ponens-list)))))
+
+ (defthm forcing-logic.proofp-of-build.disjoined-modus-ponens-list
+   (implies (force (and (logic.formulap b)
+                        (logic.appeal-listp as)
+                        (logic.appealp base)
+                        (logic.all-disjunctionsp (logic.strip-conclusions as))
+                        (equal (logic.fmtype (logic.conclusion base)) 'por*)
+                        (all-equalp (logic.vlhs (logic.conclusion base)) (logic.vlhses (logic.strip-conclusions as)))
+                        (equal (logic.vrhs (logic.conclusion base))
+                               (logic.disjoin-formulas (app (logic.negate-formulas (logic.vrhses (logic.strip-conclusions as)))
+                                                            (list b))))
+                        (logic.proof-listp as axioms thms atbl)
+                        (logic.proofp base axioms thms atbl)))
+            (equal (logic.proofp (build.disjoined-modus-ponens-list b as base) axioms thms atbl)
+                   t))))
+
+
+
+(defund@ build.multi-assoc-expansion (x as)
+  ;; Derive (A_1 v ... v A_n) v P from A_i v P
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp as)
+                              (@match (proof x (v A_i P)))
+                              (memberp (@formula A_i) as))))
+  (if (and (consp as)
+           (consp (cdr as)))
+      (cond ((equal (car as) (@formula A_i))
+             (@derive ((v A_1 P)                             (@given x))
+                      ((v A_1 (v (v A_2 (v dots A_n)) P))    (build.disjoined-left-expansion @- (logic.disjoin-formulas (cdr as))))
+                      ((v (v A_1 (v dots A_n)) P)            (build.associativity @-))))
+            (t
+             (@derive ((v (v A_2 (v dots A_n)) P)            (build.multi-assoc-expansion x (cdr as)))
+                      ((v A_1 (v (v A_2 (v dots A_n)) P))    (build.expansion (car as) @-))
+                      ((v (v A_1 (v A_2 (v dots A_n))) P)    (build.associativity @-)))))
+    (logic.appeal-identity x)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.multi-assoc-expansion)))
+
+ (defthm build.multi-assoc-expansion-under-iff
+   (iff (build.multi-assoc-expansion x as)
+        t))
+
+ (defthm lemma-for-forcing-logic.appealp-of-build.multi-assoc-expansion
+   (implies (and (logic.appealp x)
+                 (logic.formula-listp as)
+                 (equal (logic.fmtype (logic.conclusion x)) 'por*)
+                 (memberp (logic.vlhs (logic.conclusion x)) as))
+            (and (logic.appealp (build.multi-assoc-expansion x as))
+                 (equal (logic.conclusion (build.multi-assoc-expansion x as))
+                        (logic.por (logic.disjoin-formulas as)
+                                   (logic.vrhs (logic.conclusion x))))))
+   :rule-classes nil)
+
+ (defthm forcing-logic.appealp-of-build.multi-assoc-expansion
+   (implies (force (and (logic.appealp x)
+                        (logic.formula-listp as)
+                        (equal (logic.fmtype (logic.conclusion x)) 'por*)
+                        (memberp (logic.vlhs (logic.conclusion x)) as)))
+            (equal (logic.appealp (build.multi-assoc-expansion x as))
+                   t))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-build.multi-assoc-expansion)))))
+
+ (defthm forcing-logic.conclusion-of-build.multi-assoc-expansion
+   (implies (force (and (logic.appealp x)
+                        (logic.formula-listp as)
+                        (equal (logic.fmtype (logic.conclusion x)) 'por*)
+                        (memberp (logic.vlhs (logic.conclusion x)) as)))
+            (equal (logic.conclusion (build.multi-assoc-expansion x as))
+                   (logic.por (logic.disjoin-formulas as)
+                              (logic.vrhs (logic.conclusion x)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-build.multi-assoc-expansion)))))
+
+ (defthm forcing-logic.proofp-of-build.multi-assoc-expansion
+   (implies (force (and (logic.appealp x)
+                        (logic.formula-listp as)
+                        (equal (logic.fmtype (logic.conclusion x)) 'por*)
+                        (memberp (logic.vlhs (logic.conclusion x)) as)
+                        (logic.proofp x axioms thms atbl)
+                        (logic.formula-list-atblp as atbl)))
+            (equal (logic.proofp (build.multi-assoc-expansion x as) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund@ build.multi-expansion (x as)
+  ;; Derive A_1 v ... v A_n from A_i
+  ;; Note: this is like Shankar's M1-proof
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp as)
+                              (@match (proof x A_i))
+                              (memberp (@formula A_i) as))))
+  (if (and (consp as)
+           (consp (cdr as)))
+      (cond ((equal (car as) (@formula A_i))
+             (@derive (A_1                             (@given x))
+                      ((v A_1 (v A_2 (v dots A_n)))    (build.right-expansion @- (logic.disjoin-formulas (cdr as))))))
+            (t
+             (@derive ((v A_2 (v dots A_n))            (build.multi-expansion x (cdr as)))
+                      ((v A_1 (v A_2 (v dots A_n)))    (build.expansion (car as) @-)))))
+    (logic.appeal-identity x)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.multi-expansion)))
+
+ (defthm build.multi-expansion-under-iff
+   (iff (build.multi-expansion ai as)
+        t))
+
+ (defthm forcing-logic.appealp-of-build.multi-expansion
+   (implies (force (and (logic.formula-listp as)
+                        (logic.appealp ai)
+                        (memberp (logic.conclusion ai) as)))
+            (equal (logic.appealp (build.multi-expansion ai as))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-build.multi-expansion
+   (implies (force (and (logic.appealp ai)
+                        (logic.formula-listp as)
+                        (memberp (logic.conclusion ai) as)))
+            (equal (logic.conclusion (build.multi-expansion ai as))
+                   (logic.disjoin-formulas as)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proofp-of-build.multi-expansion
+   (implies (force (and (logic.appealp ai)
+                        (logic.formula-listp as)
+                        (memberp (logic.conclusion ai) as)
+                        (logic.proofp ai axioms thms atbl)
+                        (logic.formula-list-atblp as atbl)))
+            (equal (logic.proofp (build.multi-expansion ai as) axioms thms atbl)
+                   t))))
+
+
+
+(defund build.modus-ponens-list-okp (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'build.modus-ponens-list)
+         (not extras)
+         (consp subproofs)
+         (let ((base (car subproofs))
+               (as   (cdr subproofs)))
+           (equal (logic.conclusion base)
+                  (logic.disjoin-formulas
+                   (app (logic.negate-formulas (logic.strip-conclusions as))
+                        (list conclusion))))))))
+
+(defund build.modus-ponens-list-high (b as base)
+  (declare (xargs :guard (and (logic.formulap b)
+                              (logic.appeal-listp as)
+                              (logic.appealp base)
+                              (equal (logic.conclusion base)
+                                     (logic.disjoin-formulas
+                                      (app (logic.negate-formulas (logic.strip-conclusions as))
+                                           (list b)))))))
+  (logic.appeal 'build.modus-ponens-list
+                b
+                (cons base (list-fix as))
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.modus-ponens-list-okp)))
+
+ (defthm booleanp-of-build.modus-ponens-list-okp
+   (equal (booleanp (build.modus-ponens-list-okp x))
+          t)
+   :hints(("goal" :in-theory (disable forcing-true-listp-of-logic.subproofs))))
+
+ (defthm build.modus-ponens-list-okp-of-logic.appeal-identity
+   (equal (build.modus-ponens-list-okp (logic.appeal-identity x))
+          (build.modus-ponens-list-okp x))
+   :hints(("goal" :in-theory (disable forcing-true-listp-of-logic.subproofs))))
+
+ (local (in-theory (enable backtracking-logic.formula-atblp-rules)))
+ (local (in-theory (disable forcing-logic.formula-atblp-rules
+                            forcing-lookup-of-logic.function-name-free
+                            forcing-logic.term-list-atblp-of-logic.function-args)))
+
+ (defthm lemma-1-for-soundness-of-build.modus-ponens-list-okp
+   (implies (and (build.modus-ponens-list-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (build.modus-ponens-list (logic.conclusion x)
+                                             (logic.provable-list-witness
+                                              (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                              axioms thms atbl)
+                                             (logic.provable-witness
+                                              (logic.conclusion (car (logic.subproofs x)))
+                                              axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthm lemma-2-for-soundness-of-build.modus-ponens-list-okp
+   (implies (and (build.modus-ponens-list-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.proofp
+                    (build.modus-ponens-list (logic.conclusion x)
+                                             (logic.provable-list-witness
+                                              (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                              axioms thms atbl)
+                                             (logic.provable-witness
+                                              (logic.conclusion (car (logic.subproofs x)))
+                                              axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm forcing-soundness-of-build.modus-ponens-list-okp
+   (implies (and (build.modus-ponens-list-okp x)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-build.modus-ponens-list-okp
+                               lemma-2-for-soundness-of-build.modus-ponens-list-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (build.modus-ponens-list (logic.conclusion x)
+                                                         (logic.provable-list-witness
+                                                          (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                          axioms thms atbl)
+                                                         (logic.provable-witness
+                                                          (logic.conclusion (car (logic.subproofs x)))
+                                                          axioms thms atbl)))))))))
+
+
+
+(defund@ build.disjoined-modus-ponens-list (b as base)
+  ;; Derive P v B from P v A1, ..., P v An, and P v ~A1 v ~A2 v ... v ~An v B
+  (declare (xargs :guard (and (logic.formulap b)
+                              (logic.appeal-listp as)
+                              (logic.appealp base)
+                              (let ((aconcs   (logic.strip-conclusions as))
+                                    (baseconc (logic.conclusion base)))
+                                (and (logic.all-disjunctionsp aconcs)
+                                     (equal (logic.fmtype baseconc) 'por*)
+                                     (all-equalp (logic.vlhs baseconc) (logic.vlhses aconcs))
+                                     (equal (logic.vrhs baseconc)
+                                            (logic.disjoin-formulas (app (logic.negate-formulas (logic.vrhses aconcs))
+                                                                         (list b)))))))))
+  (cond ((consp as)
+         (@derive ((v P (v A_1 (v dots (v A_n B))))    (@given base))
+                  ((v P A_1)                           (@given (car as)))
+                  ((v P (v A_2 (v dots (v A_n B))))    (build.disjoined-modus-ponens @- @--))
+                  ((v P B)                             (build.disjoined-modus-ponens-list b (cdr as) @-))))
+        (t
+         (@derive ((v P B)                             (@given (logic.appeal-identity base)))))))
+
+(defund build.disjoined-modus-ponens-list-okp (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'build.disjoined-modus-ponens-list)
+         (not extras)
+         (consp subproofs)
+         (equal (logic.fmtype conclusion) 'por*)
+         (let* ((b        (logic.vrhs conclusion))
+                (base     (car subproofs))
+                (as       (cdr subproofs))
+                (baseconc (logic.conclusion base))
+                (aconcs   (logic.strip-conclusions as)))
+           (and (logic.all-disjunctionsp aconcs)
+                (equal (logic.fmtype baseconc) 'por*)
+                (all-equalp (logic.vlhs baseconc) (logic.vlhses aconcs))
+                (equal (logic.vlhs baseconc) (logic.vlhs conclusion))
+                (equal (logic.vrhs baseconc)
+                       (logic.disjoin-formulas (app (logic.negate-formulas (logic.vrhses aconcs))
+                                                    (list b)))))))))
+
+(defund build.disjoined-modus-ponens-list-high (b as base)
+  (declare (xargs :guard (and (logic.formulap b)
+                              (logic.appeal-listp as)
+                              (logic.appealp base)
+                              (let ((aconcs (logic.strip-conclusions as))
+                                    (baseconc (logic.conclusion base)))
+                                   (and (logic.all-disjunctionsp aconcs)
+                                        (equal (logic.fmtype baseconc) 'por*)
+                                        (all-equalp (logic.vlhs baseconc) (logic.vlhses aconcs))
+                                        (equal (logic.vrhs baseconc)
+                                               (logic.disjoin-formulas
+                                                (app (logic.negate-formulas (logic.vrhses aconcs))
+                                                     (list b)))))))))
+  (logic.appeal 'build.disjoined-modus-ponens-list
+                (logic.por (logic.vlhs (logic.conclusion base)) b)
+                (cons base (list-fix as))
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.disjoined-modus-ponens-list-okp)))
+
+ (defthm booleanp-of-build.disjoined-modus-ponens-list-okp
+   (equal (booleanp (build.disjoined-modus-ponens-list-okp x))
+          t)
+   :hints(("goal" :in-theory (disable forcing-true-listp-of-logic.subproofs))))
+
+ (defthm build.disjoined-modus-ponens-list-okp-of-logic.appeal-identity
+   (equal (build.disjoined-modus-ponens-list-okp (logic.appeal-identity x))
+          (build.disjoined-modus-ponens-list-okp x))
+   :hints(("goal" :in-theory (disable forcing-true-listp-of-logic.subproofs))))
+
+ (local (in-theory (enable backtracking-logic.formula-atblp-rules)))
+ (local (in-theory (disable forcing-logic.formula-atblp-rules
+                            forcing-lookup-of-logic.function-name-free
+                            forcing-logic.term-list-atblp-of-logic.function-args)))
+
+ (defthm lemma-1-for-soundness-of-build.disjoined-modus-ponens-list-okp
+   (implies (and (build.disjoined-modus-ponens-list-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (build.disjoined-modus-ponens-list (logic.vrhs (logic.conclusion x))
+                                                       (logic.provable-list-witness
+                                                        (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                        axioms thms atbl)
+                                                       (logic.provable-witness
+                                                        (logic.conclusion (car (logic.subproofs x)))
+                                                        axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthm lemma-2-for-soundness-of-build.disjoined-modus-ponens-list-okp
+   (implies (and (build.disjoined-modus-ponens-list-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.proofp
+                    (build.disjoined-modus-ponens-list (logic.vrhs (logic.conclusion x))
+                                                       (logic.provable-list-witness
+                                                        (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                        axioms thms atbl)
+                                                       (logic.provable-witness
+                                                        (logic.conclusion (car (logic.subproofs x)))
+                                                        axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm forcing-soundness-of-build.disjoined-modus-ponens-list-okp
+   (implies (and (build.disjoined-modus-ponens-list-okp x)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-build.disjoined-modus-ponens-list-okp
+                               lemma-2-for-soundness-of-build.disjoined-modus-ponens-list-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (build.disjoined-modus-ponens-list (logic.vrhs (logic.conclusion x))
+                                                                   (logic.provable-list-witness
+                                                                    (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                    axioms thms atbl)
+                                                                   (logic.provable-witness
+                                                                    (logic.conclusion (car (logic.subproofs x)))
+                                                                    axioms thms atbl)))))))))
+
+
+(defund build.multi-assoc-expansion-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'build.multi-assoc-expansion)
+         (equal (len subproofs) 1)
+         (let ((base (car subproofs))
+               (as   extras))
+           (and (logic.formula-listp as)
+                (logic.formula-list-atblp as atbl)
+                (equal (logic.fmtype (logic.conclusion base)) 'por*)
+                (memberp (logic.vlhs (logic.conclusion base)) as)
+                (equal conclusion
+                       (logic.por (logic.disjoin-formulas as)
+                                  (logic.vrhs (logic.conclusion base)))))))))
+
+(defund@ build.multi-assoc-expansion-high (x as)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp as)
+                              (@match (proof x (v A_i P)))
+                              (memberp (@formula A_i) as))))
+  (logic.appeal 'build.multi-assoc-expansion
+                (logic.por (logic.disjoin-formulas as)
+                           (@formula P))
+                (list x)
+                as))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.multi-assoc-expansion-okp)))
+
+ (defthm booleanp-of-build.multi-assoc-expansion-okp
+   (equal (booleanp (build.multi-assoc-expansion-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm build.multi-assoc-expansion-okp-of-logic.appeal-identity
+   (equal (build.multi-assoc-expansion-okp (logic.appeal-identity x) atbl)
+          (build.multi-assoc-expansion-okp x atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm lemma-1-for-soundness-of-build.multi-assoc-expansion-okp
+   (implies (and (build.multi-assoc-expansion-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (build.multi-assoc-expansion (logic.provable-witness
+                                                  (logic.conclusion (car (logic.subproofs x)))
+                                                  axioms thms atbl)
+                                                 (logic.extras x)))
+                   (logic.conclusion x))))
+
+ (defthm lemma-2-for-soundness-of-build.multi-assoc-expansion-okp
+   (implies (and (build.multi-assoc-expansion-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.proofp
+                    (build.multi-assoc-expansion (logic.provable-witness
+                                                  (logic.conclusion (car (logic.subproofs x)))
+                                                  axioms thms atbl)
+                                                 (logic.extras x))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm forcing-soundness-of-build.multi-assoc-expansion-okp
+   (implies (and (build.multi-assoc-expansion-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-build.multi-assoc-expansion-okp
+                               lemma-2-for-soundness-of-build.multi-assoc-expansion-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (build.multi-assoc-expansion (logic.provable-witness
+                                                              (logic.conclusion (car (logic.subproofs x)))
+                                                              axioms thms atbl)
+                                                             (logic.extras x)))))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/build/prop.lisp acl2-6.3/books/milawa/ACL2/build/prop.lisp
--- acl2-6.2/books/milawa/ACL2/build/prop.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/prop.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,411 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "prop.tex")
+
+(defderiv build.commute-or
+  :from   ((proof x (v A B)))
+  :derive (v B A)
+  :proof  (@derive ((v A B)               (@given x))
+                   ((v (! A) A)           (build.propositional-schema (@formula A)))
+                   ((v B A)               (build.cut @-- @-))))
+
+(defderiv build.right-expansion
+  :from   ((proof x A)
+           (formula b B))
+  :derive (v A B)
+  :proof  (@derive ((v A B)               (@given x))
+                   ((v B A)               (build.expansion b @-))
+                   ((v A B)               (build.commute-or @-))))
+
+(defderiv build.modus-ponens
+  :from   ((proof x A)
+           (proof y (v (! A) B)))
+  :derive B
+  :proof  (@derive (A                     (@given x))
+                   ((v A B)               (build.right-expansion @- (@formula B)))
+                   ((v (! A) B)           (@given y))
+                   ((v B B)               (build.cut @-- @-))
+                   (B                     (build.contraction @-))))
+
+(defderiv build.modus-ponens-2
+  :from   ((proof x (! A))
+           (proof y (v A B)))
+  :derive B
+  :proof  (@derive ((! A)                 (@given x))
+                   ((v (! A) B)           (build.right-expansion @- (@formula B)))
+                   ((v A B)               (@given y))
+                   ((v B B)               (build.cut @- @--))
+                   (B                     (build.contraction @-))))
+
+(defderiv build.right-associativity
+  :from   ((proof x (v (v A B) C)))
+  :derive (v A (v B C))
+  :proof  (@derive ((v (v A B) C)         (@given x))
+                   ((v C (v A B))         (build.commute-or @-))
+                   ((v (v C A) B)         (build.associativity @-))
+                   ((v B (v C A))         (build.commute-or @-))
+                   ((v (v B C) A)         (build.associativity @-))
+                   ((v A (v B C))         (build.commute-or @-))))
+
+(defderiv build.disjoined-left-expansion
+  :from   ((proof x (v P A))
+           (formula b B))
+  :derive (v P (v B A))
+  :proof  (@derive ((v P A)               (@given x))
+                   ((v A P)               (build.commute-or @-))
+                   ((v B (v A P))         (build.expansion (@formula B) @-))
+                   ((v (v B A) P)         (build.associativity @-))
+                   ((v P (v B A))         (build.commute-or @-))))
+
+(defderiv build.disjoined-right-expansion
+  :from   ((proof x (v P A))
+           (formula b B))
+  :derive (v P (v A B))
+  :proof  (@derive ((v P A)               (@given x))
+                   ((v B (v P A))         (build.expansion (@formula B) @-))
+                   ((v (v B P) A)         (build.associativity @-))
+                   ((v A (v B P))         (build.commute-or @-))
+                   ((v (v A B) P)         (build.associativity @-))
+                   ((v P (v A B))         (build.commute-or @-))))
+
+(defderiv build.disjoined-contraction
+  :from   ((proof x (v P (v A A))))
+  :derive (v P A)
+  :proof  (@derive ((v P (v A A))         (@given x))
+                   ((v (v P A) A)         (build.associativity @-))
+                   ((v A (v P A))         (build.commute-or @-))
+                   ((v P (v A (v P A)))   (build.expansion (@formula P) @-))
+                   ((v (v P A) (v P A))   (build.associativity @-))
+                   ((v P A)               (build.contraction @-))))
+
+(defderiv build.cancel-neg-neg
+  :from   ((proof x (! (! A))))
+  :derive A
+  :proof  (@derive ((! (! A))             (@given x))
+                   ((v (! A) A)           (build.propositional-schema (@formula A)))
+                   (A                     (build.modus-ponens-2 @-- @-))))
+
+(defderiv build.insert-neg-neg
+  :from   ((proof x A))
+  :derive (! (! A))
+  :proof  (@derive ((v (! (! A)) (! A))   (build.propositional-schema (@formula (! A))))
+                   ((v (! A) (! (! A)))   (build.commute-or @-))
+                   (A                     (@given x))
+                   ((! (! A))             (build.modus-ponens @- @--))))
+
+(defderiv build.lhs-insert-neg-neg
+  :from   ((proof x (v A B)))
+  :derive (v (! (! A)) B)
+  :proof  (@derive ((v (! (! A)) (! A))   (build.propositional-schema (@formula (! A))))
+                   ((v (! A) (! (! A)))   (build.commute-or @-))
+                   ((v A B)               (@given x))
+                   ((v B (! (! A)))       (build.cut @- @--))
+                   ((v (! (! A)) B)       (build.commute-or @-))))
+
+(defderiv build.lhs-cancel-neg-neg
+  :from   ((proof x (v (! (! A)) B)))
+  :derive (v A B)
+  :proof  (@derive ((v (! A) A)           (build.propositional-schema (@formula A)))
+                   ((v (! (! A)) B)       (@given x))
+                   ((v A B)               (build.cut @-- @-))))
+
+(defderiv build.merge-negatives
+  :from   ((proof x (! A))
+           (proof y (! B)))
+  :derive (! (v A B))
+  :proof  (@derive ((v (! (v A B)) (v A B))   (build.propositional-schema (@formula (v A B))))
+                   ((v (v (! (v A B)) A) B)   (build.associativity @-))
+                   ((v B (v (! (v A B)) A))   (build.commute-or @-))
+                   ((! B)                     (@given y))
+                   ((v (! (v A B)) A)         (build.modus-ponens-2 @- @--))
+                   ((v A (! (v A B)))         (build.commute-or @-))
+                   ((! A)                     (@given x))
+                   ((! (v A B))               (build.modus-ponens-2 @- @--))))
+
+(defderiv build.merge-implications-lemma-1
+  :from   ((proof x (v (! B) C))
+           (formula a A))
+  :derive (v A (v C (! (v A B))))
+  :proof  (@derive ((v (! (v A B)) (v A B))   (build.propositional-schema (@formula (v A B))))
+                   ((v (v (! (v A B)) A) B)   (build.associativity @-))
+                   ((v B (v (! (v A B)) A))   (build.commute-or @-))
+                   ((v (! B) C)               (@given x))
+                   ((v (v (! (v A B)) A) C)   (build.cut @-- @-))
+                   ((v C (v (! (v A B)) A))   (build.commute-or @-))
+                   ((v (v C (! (v A B))) A)   (build.associativity @-))
+                   ((v A (v C (! (v A B))))   (build.commute-or @-))))
+
+(defderiv build.merge-implications-lemma-2
+  :from   ((proof x (v A (v C D)))
+           (proof y (v (! A) C)))
+  :derive (v D C)
+  :proof  (@derive ((v A (v C D))   (@given x))
+                   ((v (! A) C)     (@given y))
+                   ((v (v C D) C)   (build.cut @-- @-))
+                   ((v C (v C D))   (build.commute-or @-))
+                   ((v (v C C) D)   (build.associativity @-))
+                   ((v D (v C C))   (build.commute-or @-))
+                   ((v D C)         (build.disjoined-contraction @-))))
+
+(defderiv build.merge-implications
+  :from   ((proof x (v (! A) C))
+           (proof y (v (! B) C)))
+  :derive (v (! (v A B)) C)
+  :proof  (@derive
+           ((v (! B) C)                 (@given y))
+           ((v A (v C (! (v A B))))     (build.merge-implications-lemma-1 @- (@formula A)))
+           ((v (! A) C)                 (@given x))
+           ((v (! (v A B)) C)           (build.merge-implications-lemma-2 @-- @-))))
+
+(defderiv build.disjoined-commute-or-lemma-1
+  :from   ((proof x (v P (v A B))))
+  :derive (v A (v (v B A) P))
+  :proof  (@derive ((v P (v A B))               (@given x))
+                   ((v (v P A) B)               (build.associativity @-))
+                   ((v A (v (v P A) B))         (build.expansion (@formula A) @-))
+                   ((v (v A (v P A)) B)         (build.associativity @-))
+                   ((v B (v A (v P A)))         (build.commute-or @-))
+                   ((v (v B A) (v P A))         (build.associativity @-))
+                   ((v (v (v B A) P) A)         (build.associativity @-))
+                   ((v A (v (v B A) P))         (build.commute-or @-))))
+
+(defderiv build.disjoined-commute-or
+  :from   ((proof x (v P (v A B))))
+  :derive (v P (v B A))
+  :proof  (@derive
+           ((v P (v A B))               (@given x))
+           ((v A (v (v B A) P))         (build.disjoined-commute-or-lemma-1 @-))
+           ((v B (v A (v (v B A) P)))   (build.expansion (@formula B) @-))
+           ((v (v B A) (v (v B A) P))   (build.associativity @-))
+           ((v (v (v B A) (v B A)) P)   (build.associativity @-))
+           ((v P (v (v B A) (v B A)))   (build.commute-or @-))
+           ((v P (v B A))               (build.disjoined-contraction @-))))
+
+(defderiv build.disjoined-assoc-lemma-1a
+  :from   ((formula b B)
+           (formula c C)
+           (proof x (v P (v A D))))
+  :derive (v A (v B (v (v C D) P)))
+  :proof  (@derive ((v P (v A D))               (@given x))
+                   ((v (v P A) D)               (build.associativity @-))
+                   ((v D (v P A))               (build.commute-or @-))
+                   ((v C (v D (v P A)))         (build.expansion (@formula C) @-))
+                   ((v (v C D) (v P A))         (build.associativity @-))
+                   ((v (v (v C D) P) A)         (build.associativity @-))
+                   ((v B (v (v (v C D) P) A))   (build.expansion (@formula B) @-))
+                   ((v (v B (v (v C D) P)) A)   (build.associativity @-))
+                   ((v A (v B (v (v C D) P)))   (build.commute-or @-))))
+
+(defderiv build.disjoined-assoc-lemma-1
+  :from   ((formula a A)
+           (formula b B)
+           (formula c C)
+           (formula d D))
+  :derive (v (! (v A D)) (v (v A B) (v C D)))
+  :proof  (@derive ((v (! (v A D)) (v A D))               (build.propositional-schema (@formula (v A D))))
+                   ((v A (v B (v (v C D) (! (v A D)))))   (build.disjoined-assoc-lemma-1a (@formula B) (@formula C) @-))
+                   ((v (v A B) (v (v C D) (! (v A D))))   (build.associativity @-))
+                   ((v (v (v A B) (v C D)) (! (v A D)))   (build.associativity @-))
+                   ((v (! (v A D)) (v (v A B) (v C D)))   (build.commute-or @-))))
+
+(defderiv build.disjoined-assoc-lemma-2a
+  :from   ((formula a A)
+           (formula d D)
+           (proof x (v P (v B C))))
+  :derive (v A (v B (v (v C D) P)))
+  :proof  (@derive ((v P (v B C))              (@given x))
+                   ((v (v P B) C)              (build.associativity @-))
+                   ((v D (v (v P B) C))        (build.expansion (@formula D) @-))
+                   ((v (v D (v P B)) C)        (build.associativity @-))
+                   ((v C (v D (v P B)))        (build.commute-or @-))
+                   ((v (v C D) (v P B))        (build.associativity @-))
+                   ((v (v (v C D) P) B)        (build.associativity @-))
+                   ((v B (v (v C D) P))        (build.commute-or @-))
+                   ((v A (v B (v (v C D) P)))  (build.expansion (@formula A) @-))))
+
+(defderiv build.disjoined-assoc-lemma-2
+  :from   ((formula a A)
+           (formula b B)
+           (formula c C)
+           (formula d D))
+  :derive (v (! (v B C)) (v (v A B) (v C D)))
+  :proof  (@derive ((v (! (v B C)) (v B C))               (build.propositional-schema (@formula (v B C))))
+                   ((v A (v B (v (v C D) (! (v B C)))))   (build.disjoined-assoc-lemma-2a (@formula A) (@formula D) @-))
+                   ((v (v A B) (v (v C D) (! (v B C))))   (build.associativity @-))
+                   ((v (v (v A B) (v C D)) (! (v B C)))   (build.associativity @-))
+                   ((v (! (v B C)) (v (v A B) (v C D)))   (build.commute-or @-))))
+
+(defderiv build.disjoined-assoc-lemma-3a
+  :from   ((formula a A)
+           (formula b B)
+           (formula c C)
+           (formula d D))
+  :derive (v (! (v (v A D) (v B C))) (v (v A B) (v C D)))
+  :proof  (@derive ((v (! (v A D)) (v (v A B) (v C D)))              (build.disjoined-assoc-lemma-1 (@formula A) (@formula B) (@formula C) (@formula D)))
+                   ((v (! (v B C)) (v (v A B) (v C D)))              (build.disjoined-assoc-lemma-2 (@formula A) (@formula B) (@formula C) (@formula D)))
+                   ((v (! (v (v A D) (v B C))) (v (v A B) (v C D)))  (build.merge-implications @-- @-))))
+
+(defderiv build.disjoined-assoc-lemma-3
+  :from   ((proof x (v (v A D) (v B C))))
+  :derive (v (v A B) (v C D))
+  :proof  (@derive ((v (! (v (v A D) (v B C))) (v (v A B) (v C D)))  (build.disjoined-assoc-lemma-3a (@formula A) (@formula B) (@formula C) (@formula D)))
+                   ((v (v A D) (v B C))                              (@given x))
+                   ((v (v A B) (v C D))                              (build.modus-ponens @- @--))))
+
+(defderiv build.disjoined-right-associativity
+  :from   ((proof x (v P (v (v A B) C))))
+  :derive (v P (v A (v B C)))
+  :proof  (@derive ((v P (v (v A B) C))   (@given x))
+                   ((v P (v C (v A B)))   (build.disjoined-commute-or @-))
+                   ((v (v P C) (v A B))   (build.associativity @-))
+                   ((v (v P A) (v B C))   (build.disjoined-assoc-lemma-3 @-))
+                   ((v P (v A (v B C)))   (build.right-associativity @-))))
+
+
+(defderiv build.disjoined-assoc-lemma-4
+  :from   ((proof x (v (v P A) (v B C))))
+  :derive (v (v P C) (v A B))
+  :proof  (@derive ((v (v P A) (v B C))   (@given x))
+                   ((v (v P A) (v C B))   (build.disjoined-commute-or @-))
+                   ((v (v P C) (v B A))   (build.disjoined-assoc-lemma-3 @-))
+                   ((v (v P C) (v A B))   (build.disjoined-commute-or @-))))
+
+(defderiv build.disjoined-associativity
+  :from   ((proof x (v P (v A (v B C)))))
+  :derive (v P (v (v A B) C))
+  :proof  (@derive ((v P (v A (v B C)))   (@given x))
+                   ((v (v P A) (v B C))   (build.associativity @-))
+                   ((v (v P C) (v A B))   (build.disjoined-assoc-lemma-4 @-))
+                   ((v P (v C (v A B)))   (build.right-associativity @-))
+                   ((v P (v (v A B) C))   (build.disjoined-commute-or @-))))
+
+(defderiv build.disjoined-cut-lemma-1
+  :from   ((proof x (v P (v A B)))
+           (proof y (v P (v (! A) C))))
+  :derive (v (v B P) (v C P))
+  :proof  (@derive ((v P (v A B))         (@given x))
+                   ((v (v A B) P)         (build.commute-or @-))
+                   ((v A (v B P))         (build.right-associativity @-) *1)
+                   ((v P (v (! A) C))     (@given y))
+                   ((v (v (! A) C) P)     (build.commute-or @-))
+                   ((v (! A) (v C P))     (build.right-associativity @-))
+                   ((v (v B P) (v C P))   (build.cut *1 @-))))
+
+(defderiv build.disjoined-cut-lemma-2
+  :from   ((proof x (v P (v A B)))
+           (proof y (v P (v (! A) C))))
+  :derive (v (v B C) (v P P))
+  :proof  (@derive
+           ((v P (v A B))         (@given x))
+           ((v P (v (! A) C))     (@given y))
+           ((v (v B P) (v C P))   (build.disjoined-cut-lemma-1 @-- @-))
+           ((v (v B C) (v P P))   (build.disjoined-assoc-lemma-3 @-))))
+
+(defderiv build.disjoined-cut
+  :from   ((proof x (v P (v A B)))
+           (proof y (v P (v (! A) C))))
+  :derive (v P (v B C))
+  :proof  (@derive ((v P (v A B))         (@given x))
+                   ((v P (v (! A) C))     (@given y))
+                   ((v (v B C) (v P P))   (build.disjoined-cut-lemma-2 @-- @-))
+                   ((v (v B C) P)         (build.disjoined-contraction @-))
+                   ((v P (v B C))         (build.commute-or @-))))
+
+(defderiv build.disjoined-modus-ponens
+  :from   ((proof x (v P A))
+           (proof y (v P (v (! A) B))))
+  :derive (v P B)
+  :proof  (@derive ((v P A)               (@given x))
+                   ((v B (v P A))         (build.expansion (@formula B) @-))
+                   ((v (v B P) A)         (build.associativity @-))
+                   ((v A (v B P))         (build.commute-or @-) *1)
+                   ((v P (v (! A) B))     (@given y))
+                   ((v (v P (! A)) B)     (build.associativity @-))
+                   ((v B (v P (! A)))     (build.commute-or @-))
+                   ((v (v B P) (! A))     (build.associativity @-))
+                   ((v (! A) (v B P))     (build.commute-or @-))
+                   ((v (v B P) (v B P))   (build.cut *1 @-))
+                   ((v B P)               (build.contraction @-))
+                   ((v P B)               (build.commute-or @-))))
+
+(defderiv build.disjoined-modus-ponens-2
+  :from   ((proof x (v P (! A)))
+           (proof y (v P (v A B))))
+  :derive (v P B)
+  :proof  (@derive ((v P (v A B))         (@given y))
+                   ((v (v P A) B)         (build.associativity @-))
+                   ((v B (v P A))         (build.commute-or @-))
+                   ((v (v B P) A)         (build.associativity @-))
+                   ((v A (v B P))         (build.commute-or @-)   *1)
+                   ((v P (! A))           (@given x))
+                   ((v B (v P (! A)))     (build.expansion (@formula B) @-))
+                   ((v (v B P) (! A))     (build.associativity @-))
+                   ((v (! A) (v B P))     (build.commute-or @-))
+                   ((v (v B P) (v B P))   (build.cut *1 @-))
+                   ((v B P)               (build.contraction @-))
+                   ((v P B)               (build.commute-or @-))))
+
+
+
+
+;; (defderiv build.first-negated-disjunct
+;;   :from   ((proof x (! (v A B))))
+;;   :derive (! A)
+;;   :proof  (@derive ((v (! A) A)         (build.propositional-schema (@formula A)))
+;;                    ((v B (v (! A) A))   (build.expansion (@formula B) @-))
+;;                    ((v (v B (! A)) A)   (build.associativity @-))
+;;                    ((v A (v B (! A)))   (build.commute-or @-))
+;;                    ((v (v A B) (! A))   (build.associativity @-))
+;;                    ((! (v A B))         (@given x))
+;;                    ((! A)               (build.modus-ponens-2 @- @--))))
+
+;; (defderiv build.second-negated-disjunct
+;;   :from   ((proof x (! (v A B))))
+;;   :derive (! B)
+;;   :proof  (@derive ((v (! B) B)          (build.propositional-schema (@formula B)))
+;;                    ((v B (! B))          (build.commute-or @-))
+;;                    ((v A (v B (! B)))    (build.expansion (@formula A) @-))
+;;                    ((v (v A B) (! B))    (build.associativity @-))
+;;                    ((! (v A B))          (@given x))
+;;                    ((! B)                (build.modus-ponens-2 @- @--))))
+
+(dd.close)
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/build/replace-subterm.lisp acl2-6.3/books/milawa/ACL2/build/replace-subterm.lisp
--- acl2-6.2/books/milawa/ACL2/build/replace-subterm.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/replace-subterm.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,597 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lambda")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defun build.flag-replace-subterm (flag x old new proof)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (logic.termp old)
+                              (logic.termp new)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (logic.pequal old new)))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((equal x old)
+             (logic.appeal-identity proof))
+            ((logic.constantp x)
+             (build.reflexivity x))
+            ((logic.variablep x)
+             (build.reflexivity x))
+            ((logic.functionp x)
+             (let* ((name       (logic.function-name x))
+                    (args       (logic.function-args x))
+                    (arg-proofs (build.flag-replace-subterm 'list args old new proof)))
+               (build.pequal-by-args name arg-proofs)))
+            ((logic.lambdap x)
+             (let* ((formals       (logic.lambda-formals x))
+                    (body          (logic.lambda-body x))
+                    (actuals       (logic.lambda-actuals x))
+                    (actual-proofs (build.flag-replace-subterm 'list actuals old new proof)))
+               (build.lambda-pequal-by-args formals body actual-proofs)))
+            ;; Sneaky twiddle for hypless iff theorem
+            (t t))
+    (if (consp x)
+        (cons (build.flag-replace-subterm 'term (car x) old new proof)
+              (build.flag-replace-subterm 'list (cdr x) old new proof))
+      nil)))
+
+(definlined build.replace-subterm (x old new proof)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp old)
+                              (logic.termp new)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (logic.pequal old new)))
+                  :verify-guards nil))
+  (build.flag-replace-subterm 'term x old new proof))
+
+(definlined build.replace-subterm-list (x old new proof)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.termp old)
+                              (logic.termp new)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (logic.pequal old new)))
+                  :verify-guards nil))
+  (build.flag-replace-subterm 'list x old new proof))
+
+(defobligations build.flag-replace-subterm
+  (logic.appeal-identity
+   build.reflexivity
+   build.pequal-by-args
+   build.lambda-pequal-by-args))
+
+(defobligations build.replace-subterm
+  (build.flag-replace-subterm))
+
+(defobligations build.replace-subterm-list
+  (build.flag-replace-subterm))
+
+(defthmd definition-of-build.replace-subterm
+  (equal (build.replace-subterm x old new proof)
+         (cond ((equal x old)
+                (logic.appeal-identity proof))
+               ((logic.constantp x)
+                (build.reflexivity x))
+               ((logic.variablep x)
+                (build.reflexivity x))
+               ((logic.functionp x)
+                (let* ((name       (logic.function-name x))
+                       (args       (logic.function-args x))
+                       (arg-proofs (build.replace-subterm-list args old new proof)))
+                  (build.pequal-by-args name arg-proofs)))
+               ((logic.lambdap x)
+                (let* ((formals       (logic.lambda-formals x))
+                       (body          (logic.lambda-body x))
+                       (actuals       (logic.lambda-actuals x))
+                       (actual-proofs (build.replace-subterm-list actuals old new proof)))
+                  (build.lambda-pequal-by-args formals body actual-proofs)))
+               ;; Sneaky twiddle for hypless iff theorem
+               (t t)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable build.replace-subterm build.replace-subterm-list))))
+
+(defthmd definition-of-build.replace-subterm-list
+  (equal (build.replace-subterm-list x old new proof)
+         (if (consp x)
+             (cons (build.replace-subterm (car x) old new proof)
+                   (build.replace-subterm-list (cdr x) old new proof))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable build.replace-subterm build.replace-subterm-list))))
+
+(defthm build.flag-replace-subterm-of-term
+  (equal (build.flag-replace-subterm 'term x old new proof)
+         (build.replace-subterm x old new proof))
+  :hints(("Goal" :in-theory (enable build.replace-subterm))))
+
+(defthm build.flag-replace-subterm-of-list
+  (equal (build.flag-replace-subterm 'list x old new proof)
+         (build.replace-subterm-list x old new proof))
+  :hints(("Goal" :in-theory (enable build.replace-subterm-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition build.replace-subterm))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition build.replace-subterm-list))))
+
+(encapsulate
+ ()
+ (defthm build.replace-subterm-list-when-not-consp
+   (implies (not (consp x))
+            (equal (build.replace-subterm-list x old new proof)
+                   nil))
+   :hints(("Goal" :in-theory (enable definition-of-build.replace-subterm-list))))
+
+ (defthm build.replace-subterm-list-of-cons
+   (equal (build.replace-subterm-list (cons a x) old new proof)
+          (cons (build.replace-subterm a old new proof)
+                (build.replace-subterm-list x old new proof)))
+   :hints(("Goal" :in-theory (enable definition-of-build.replace-subterm-list))))
+
+ (defprojection
+   :list (build.replace-subterm-list x old new proof)
+   :element (build.replace-subterm x old new proof)
+   :already-definedp t))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (implies (and (logic.termp x)
+                            (logic.termp old)
+                            (logic.termp new)
+                            (logic.appealp proof)
+                            (equal (logic.conclusion proof) (logic.pequal old new)))
+                       (and (logic.appealp (build.replace-subterm x old new proof))
+                            (equal (logic.conclusion (build.replace-subterm x old new proof))
+                                   (logic.pequal x (logic.replace-subterm x old new)))))
+            (implies (and (logic.term-listp x)
+                          (logic.termp old)
+                          (logic.termp new)
+                          (logic.appealp proof)
+                          (equal (logic.conclusion proof) (logic.pequal old new)))
+                     (and (logic.appeal-listp (build.replace-subterm-list x old new proof))
+                          (equal (logic.strip-conclusions (build.replace-subterm-list x old new proof))
+                                 (logic.pequal-list x (logic.replace-subterm-list x old new))))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :expand ((build.replace-subterm x old new proof)
+                           (build.replace-subterm old old new proof)
+                           (logic.replace-subterm x old new)
+                           (logic.replace-subterm old old new))
+                  ;; :restrict ((forcing-lookup-of-logic.function-name ((atbl atbl))))
+                  :induct (build.flag-replace-subterm flag x old new proof)))))
+
+ (defthm forcing-logic.appealp-of-build.replace-subterm
+   (implies (force (and (logic.termp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.pequal old new))))
+            (equal (logic.appealp (build.replace-subterm x old new proof))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm forcing-logic.conclusion-of-build.replace-subterm
+   (implies (force (and (logic.termp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.pequal old new))))
+            (equal (logic.conclusion (build.replace-subterm x old new proof))
+                   (logic.pequal x (logic.replace-subterm x old new))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm forcing-logic.appeal-listp-of-build.replace-subterm-list
+   (implies (force (and (logic.term-listp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.pequal old new))))
+            (equal (logic.appeal-listp (build.replace-subterm-list x old new proof))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list))))))
+
+ (defthm forcing-logic.strip-conclusions-of-build.replace-subterm-list
+   (implies (force (and (logic.term-listp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.pequal old new))))
+            (equal (logic.strip-conclusions (build.replace-subterm-list x old new proof))
+                   (logic.pequal-list x (logic.replace-subterm-list x old new))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(encapsulate
+ ()
+ (local (defthm@ lemma
+          (if (equal flag 'term)
+              (implies (and (logic.termp x)
+                            (logic.termp old)
+                            (logic.termp new)
+                            (logic.appealp proof)
+                            (equal (logic.conclusion proof) (logic.pequal old new))
+                            ;; ---
+                            (logic.term-atblp x atbl)
+                            (logic.proofp proof axioms thms atbl)
+                            (@obligations build.replace-subterm))
+                       (logic.proofp (build.replace-subterm x old new proof) axioms thms atbl))
+            (implies (and (logic.term-listp x)
+                          (logic.termp old)
+                          (logic.termp new)
+                          (logic.appealp proof)
+                          (equal (logic.conclusion proof) (logic.pequal old new))
+                          ;; ---
+                          (logic.term-list-atblp x atbl)
+                          (logic.proofp proof axioms thms atbl)
+                          (@obligations build.replace-subterm-list))
+                     (logic.proof-listp (build.replace-subterm-list x old new proof) axioms thms atbl)))
+          :rule-classes nil
+          :hints(("Goal"
+                  :expand ((build.replace-subterm x old new proof)
+                           (build.replace-subterm old old new proof))
+                  ;; :restrict ((forcing-lookup-of-logic.function-name ((atbl atbl))))
+                  :induct (build.flag-replace-subterm flag x old new proof)))))
+
+ (defthm@ forcing-logic.proofp-of-build.replace-subterm
+   (implies (force (and (logic.termp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.pequal old new))
+                        ;; ---
+                        (logic.term-atblp x atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations build.replace-subterm)))
+            (equal (logic.proofp (build.replace-subterm x old new proof) axioms thms atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm@ forcing-logic.proof-listp-of-build.replace-subterm-list
+   (implies (force (and (logic.term-listp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (logic.pequal old new))
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations build.replace-subterm-list)))
+            (equal (logic.proof-listp (build.replace-subterm-list x old new proof) axioms thms atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(verify-guards build.flag-replace-subterm)
+(verify-guards build.replace-subterm)
+(verify-guards build.replace-subterm-list)
+
+
+
+
+
+
+(defun build.flag-disjoined-replace-subterm (flag x old new proof)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (logic.termp old)
+                              (logic.termp new)
+                              (logic.appealp proof)
+                              (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                              (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new)))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((equal x old)
+             (logic.appeal-identity proof))
+            ((logic.constantp x)
+             (build.expansion (logic.vlhs (logic.conclusion proof))
+                              (build.reflexivity x)))
+            ((logic.variablep x)
+             (build.expansion (logic.vlhs (logic.conclusion proof))
+                              (build.reflexivity x)))
+            ((logic.functionp x)
+             (let* ((name       (logic.function-name x))
+                    (args       (logic.function-args x))
+                    (arg-proofs (build.flag-disjoined-replace-subterm 'list args old new proof)))
+               (build.disjoined-pequal-by-args name (logic.vlhs (logic.conclusion proof)) arg-proofs)))
+            ((logic.lambdap x)
+             (let* ((formals       (logic.lambda-formals x))
+                    (body          (logic.lambda-body x))
+                    (actuals       (logic.lambda-actuals x))
+                    (actual-proofs (build.flag-disjoined-replace-subterm 'list actuals old new proof)))
+               (build.disjoined-lambda-pequal-by-args formals body (logic.vlhs (logic.conclusion proof)) actual-proofs)))
+            ;; Sneaky twiddle for hypless iff theorem
+            (t t))
+    (if (consp x)
+        (cons (build.flag-disjoined-replace-subterm 'term (car x) old new proof)
+              (build.flag-disjoined-replace-subterm 'list (cdr x) old new proof))
+      nil)))
+
+(definlined build.disjoined-replace-subterm (x old new proof)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp old)
+                              (logic.termp new)
+                              (logic.appealp proof)
+                              (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                              (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new)))
+                  :verify-guards nil))
+  (build.flag-disjoined-replace-subterm 'term x old new proof))
+
+(definlined build.disjoined-replace-subterm-list (x old new proof)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.termp old)
+                              (logic.termp new)
+                              (logic.appealp proof)
+                              (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                              (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new)))
+                  :verify-guards nil))
+  (build.flag-disjoined-replace-subterm 'list x old new proof))
+
+(defobligations build.flag-disjoined-replace-subterm
+  (logic.appeal-identity
+   build.reflexivity
+   build.expansion
+   build.disjoined-pequal-by-args
+   build.disjoined-lambda-pequal-by-args))
+
+(defobligations build.disjoined-replace-subterm
+  (build.flag-disjoined-replace-subterm))
+
+(defobligations build.disjoined-replace-subterm-list
+  (build.flag-disjoined-replace-subterm))
+
+(defthmd definition-of-build.disjoined-replace-subterm
+  (equal (build.disjoined-replace-subterm x old new proof)
+         (cond ((equal x old)
+                (logic.appeal-identity proof))
+               ((logic.constantp x)
+                (build.expansion (logic.vlhs (logic.conclusion proof))
+                                 (build.reflexivity x)))
+               ((logic.variablep x)
+                (build.expansion (logic.vlhs (logic.conclusion proof))
+                                 (build.reflexivity x)))
+               ((logic.functionp x)
+                (let* ((name       (logic.function-name x))
+                       (args       (logic.function-args x))
+                       (arg-proofs (build.disjoined-replace-subterm-list args old new proof)))
+                  (build.disjoined-pequal-by-args name (logic.vlhs (logic.conclusion proof)) arg-proofs)))
+               ((logic.lambdap x)
+                (let* ((formals       (logic.lambda-formals x))
+                       (body          (logic.lambda-body x))
+                       (actuals       (logic.lambda-actuals x))
+                       (actual-proofs (build.disjoined-replace-subterm-list actuals old new proof)))
+                  (build.disjoined-lambda-pequal-by-args formals body (logic.vlhs (logic.conclusion proof)) actual-proofs)))
+               ;; Sneaky twiddle for hypless iff theorem
+               (t t)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable build.disjoined-replace-subterm build.disjoined-replace-subterm-list))))
+
+(defthmd definition-of-build.disjoined-replace-subterm-list
+  (equal (build.disjoined-replace-subterm-list x old new proof)
+         (if (consp x)
+             (cons (build.disjoined-replace-subterm (car x) old new proof)
+                   (build.disjoined-replace-subterm-list (cdr x) old new proof))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable build.disjoined-replace-subterm build.disjoined-replace-subterm-list))))
+
+(defthm build.flag-disjoined-replace-subterm-of-term
+  (equal (build.flag-disjoined-replace-subterm 'term x old new proof)
+         (build.disjoined-replace-subterm x old new proof))
+  :hints(("Goal" :in-theory (enable build.disjoined-replace-subterm))))
+
+(defthm build.flag-disjoined-replace-subterm-of-list
+  (equal (build.flag-disjoined-replace-subterm 'list x old new proof)
+         (build.disjoined-replace-subterm-list x old new proof))
+  :hints(("Goal" :in-theory (enable build.disjoined-replace-subterm-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition build.disjoined-replace-subterm))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition build.disjoined-replace-subterm-list))))
+
+(encapsulate
+ ()
+ (defthm build.disjoined-replace-subterm-list-when-not-consp
+   (implies (not (consp x))
+            (equal (build.disjoined-replace-subterm-list x old new proof)
+                   nil))
+   :hints(("Goal" :in-theory (enable definition-of-build.disjoined-replace-subterm-list))))
+
+ (defthm build.disjoined-replace-subterm-list-of-cons
+   (equal (build.disjoined-replace-subterm-list (cons a x) old new proof)
+          (cons (build.disjoined-replace-subterm a old new proof)
+                (build.disjoined-replace-subterm-list x old new proof)))
+   :hints(("Goal" :in-theory (enable definition-of-build.disjoined-replace-subterm-list))))
+
+ (defprojection
+   :list (build.disjoined-replace-subterm-list x old new proof)
+   :element (build.disjoined-replace-subterm x old new proof)
+   :already-definedp t))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (implies (and (logic.termp x)
+                            (logic.termp old)
+                            (logic.termp new)
+                            (logic.appealp proof)
+                            (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                            (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new)))
+                       (and (logic.appealp (build.disjoined-replace-subterm x old new proof))
+                            (equal (logic.conclusion (build.disjoined-replace-subterm x old new proof))
+                                   (logic.por (logic.vlhs (logic.conclusion proof))
+                                              (logic.pequal x (logic.replace-subterm x old new))))))
+            (implies (and (logic.term-listp x)
+                          (logic.termp old)
+                          (logic.termp new)
+                          (logic.appealp proof)
+                          (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                          (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new)))
+                     (and (logic.appeal-listp (build.disjoined-replace-subterm-list x old new proof))
+                          (equal (logic.strip-conclusions (build.disjoined-replace-subterm-list x old new proof))
+                                 (logic.por-list (repeat (logic.vlhs (logic.conclusion proof)) (len x))
+                                                 (logic.pequal-list x (logic.replace-subterm-list x old new)))))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :expand ((build.disjoined-replace-subterm x old new proof)
+                           (build.disjoined-replace-subterm old old new proof)
+                           (logic.replace-subterm x old new)
+                           (logic.replace-subterm old old new))
+                  ;; :restrict ((forcing-lookup-of-logic.function-name ((atbl atbl))))
+                  :induct (build.flag-disjoined-replace-subterm flag x old new proof)))))
+
+ (defthm forcing-logic.appealp-of-build.disjoined-replace-subterm
+   (implies (force (and (logic.termp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))))
+            (equal (logic.appealp (build.disjoined-replace-subterm x old new proof))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm forcing-logic.conclusion-of-build.disjoined-replace-subterm
+   (implies (force (and (logic.termp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))))
+            (equal (logic.conclusion (build.disjoined-replace-subterm x old new proof))
+                   (logic.por (logic.vlhs (logic.conclusion proof))
+                              (logic.pequal x (logic.replace-subterm x old new)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm forcing-logic.appeal-listp-of-build.disjoined-replace-subterm-list
+   (implies (force (and (logic.term-listp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))))
+            (equal (logic.appeal-listp (build.disjoined-replace-subterm-list x old new proof))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list))))))
+
+ (defthm forcing-logic.strip-conclusions-of-build.disjoined-replace-subterm-list
+   (implies (force (and (logic.term-listp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))))
+            (equal (logic.strip-conclusions (build.disjoined-replace-subterm-list x old new proof))
+                   (logic.por-list (repeat (logic.vlhs (logic.conclusion proof)) (len x))
+                                   (logic.pequal-list x (logic.replace-subterm-list x old new)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(encapsulate
+ ()
+ (local (defthm@ lemma
+          (if (equal flag 'term)
+              (implies (and (logic.termp x)
+                            (logic.termp old)
+                            (logic.termp new)
+                            (logic.appealp proof)
+                            (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                            (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))
+                            ;; ---
+                            (logic.term-atblp x atbl)
+                            (logic.proofp proof axioms thms atbl)
+                            (@obligations build.disjoined-replace-subterm))
+                       (logic.proofp (build.disjoined-replace-subterm x old new proof) axioms thms atbl))
+            (implies (and (logic.term-listp x)
+                          (logic.termp old)
+                          (logic.termp new)
+                          (logic.appealp proof)
+                          (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                          (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))
+                          ;; ---
+                          (logic.term-list-atblp x atbl)
+                          (logic.proofp proof axioms thms atbl)
+                          (@obligations build.disjoined-replace-subterm-list))
+                     (logic.proof-listp (build.disjoined-replace-subterm-list x old new proof) axioms thms atbl)))
+          :rule-classes nil
+          :hints(("Goal"
+                  :expand ((build.disjoined-replace-subterm x old new proof)
+                           (build.disjoined-replace-subterm old old new proof))
+                  ;; :restrict ((forcing-lookup-of-logic.function-name ((atbl atbl))))
+                  :induct (build.flag-disjoined-replace-subterm flag x old new proof)))))
+
+ (defthm@ forcing-logic.proofp-of-build.disjoined-replace-subterm
+   (implies (force (and (logic.termp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))
+                        ;; ---
+                        (logic.term-atblp x atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations build.disjoined-replace-subterm)))
+            (equal (logic.proofp (build.disjoined-replace-subterm x old new proof) axioms thms atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm@ forcing-logic.proof-listp-of-build.disjoined-replace-subterm-list
+   (implies (force (and (logic.term-listp x)
+                        (logic.termp old)
+                        (logic.termp new)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (logic.pequal old new))
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations build.disjoined-replace-subterm-list)))
+            (equal (logic.proof-listp (build.disjoined-replace-subterm-list x old new proof) axioms thms atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(verify-guards build.flag-disjoined-replace-subterm)
+(verify-guards build.disjoined-replace-subterm)
+(verify-guards build.disjoined-replace-subterm-list)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/build/skip.lisp acl2-6.3/books/milawa/ACL2/build/skip.lisp
--- acl2-6.2/books/milawa/ACL2/build/skip.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/skip.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,105 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund build.skip (a)
+  (declare (xargs :guard (logic.formulap a)))
+  (logic.appeal 'skip a nil nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.skip)))
+
+ (defthm build.skip-under-iff
+   (iff (build.skip a)
+        t))
+
+ (defthm logic.method-of-build.skip
+   (equal (logic.method (build.skip a))
+          'skip))
+
+ (defthm logic.conclusion-of-build.skip
+   (equal (logic.conclusion (build.skip a))
+          a))
+
+ (defthm logic.subproofs-of-build.skip
+   (equal (logic.subproofs (build.skip a))
+          nil))
+
+ (defthm logic.extras-of-build.skip
+   (equal (logic.extras (build.skip a))
+          nil))
+
+ (defthm forcing-logic.appealp-of-build.skip
+   (implies (force (logic.formulap a))
+            (equal (logic.appealp (build.skip a))
+                   t)))
+
+ (defthm forcing-logic.proofp-of-build.skip
+   (implies (force (logic.formula-atblp a atbl))
+            (equal (logic.proofp (build.skip a) skips thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp
+                                     logic.appeal-step-okp
+                                     logic.skip-okp)))))
+
+
+(defprojection :list (build.skip-list x)
+               :element (build.skip x)
+               :guard (logic.formula-listp x))
+
+(defthm forcing-logic.appeal-listp-of-build.skip-list
+  (implies (force (logic.formula-listp x))
+           (equal (logic.appeal-listp (build.skip-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.strip-conclusions-of-build.skip-list
+  (implies (force (logic.formula-listp x))
+           (equal (logic.strip-conclusions (build.skip-list x))
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.proof-listp-of-build.skip-list
+  (implies (force (logic.formula-list-atblp x atbl))
+           (equal (logic.proof-listp (build.skip-list x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/build/top.lisp acl2-6.3/books/milawa/ACL2/build/top.lisp
--- acl2-6.2/books/milawa/ACL2/build/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/build/top.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,54 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(include-book "basic")
+(include-book "conjunctions")
+(include-book "cons")
+(include-book "disjoined-subset")
+(include-book "disjoined-rev-disjunction")
+(include-book "equal")
+(include-book "formula-compiler")
+(include-book "if")
+(include-book "iff")
+(include-book "lambda")
+(include-book "not")
+(include-book "pequal")
+(include-book "pequal-list")
+(include-book "prop")
+(include-book "prop-list")
+(include-book "replace-subterm")
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/cert.acl2 acl2-6.3/books/milawa/ACL2/cert.acl2
--- acl2-6.2/books/milawa/ACL2/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/cert.acl2	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(include-book "portcullis")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
diff -Nru acl2-6.2/books/milawa/ACL2/classic/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/classic/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/classic/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/classic/acl2-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/classic/cert.acl2 acl2-6.3/books/milawa/ACL2/classic/cert.acl2
--- acl2-6.2/books/milawa/ACL2/classic/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/classic/cert.acl2	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/classic/deduction.lisp acl2-6.3/books/milawa/ACL2/classic/deduction.lisp
--- acl2-6.2/books/milawa/ACL2/classic/deduction.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/classic/deduction.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,602 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../build/prop")
+(local (include-book "proof-alteration"))
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+#| Doh, I broke it.
+
+
+;; The deduction rule is basically the following:
+;;
+;;      |-_{T \Cup F} G
+;;   ---------------------
+;;       |-_{T} F -> G
+;;
+;; In other words, if you can prove some formula G by first assuming F is true,
+;; then you can conclude F -> G.
+;;
+;; NOTE: This is actually only true when the input proof "admits deduction".
+;; Loosely, a proof admits deduction with respect to F as long as (1) the proof
+;; makes only modest use of induction, and (2) the proof never tries to
+;; instantiate any of the variables of F.
+
+
+
+
+;; Definition: Tainted Formulas.
+;;
+;; Suppose that T is a theory, F is a formula, and G is another formula.
+;; Suppose that X is a proof of G from {T \Cup {F}}.  Recall that our goal is to
+;; produce a proof of F -> G from T.  In other words, we want to "remove" uses
+;; of the "assumption" F, and make the dependence on F explicit.
+;;
+;; Each step in the proof X is either an axiom, or a rule of inference applied
+;; to previously proven formulas.  We are going to distinguish between those
+;; portions of X which are "tainted" versus "untainted" by the assumption F.
+;;
+;;   - An axiomatic appeal is tainted by F exactly when it is an appeal to F
+;;     itself.  For example, if our assumption, F, is the formula x = 'nil,
+;;     then the only axiomatic appeals which are tainted by F are those appeals
+;;     of the form ('axiom ('pequal* x 'nil)).  No other axiomatic appeals are
+;;     tainted by F.
+;;
+;;   - A non-axiomatic appeal (i.e., an appeal with subproofs) is tainted by F
+;;     exactly when one of its subproofs is tainted by F.  So for example, if as
+;;     before our assumption x = 'nil, then the following appeal is tainted for
+;;     any formula G, because one of its children is tainted by F:
+;;
+;;        ('expansion ('por* <G> ('pequal* x 'nil))
+;;                    (('axiom ('pequal* x 'nil))))
+;;
+;; I could have tried to define "taintedp" to recognize the tainted proofs, but
+;; instead I have defined "untaintedp" to recognize untainted proofs.  I think
+;; that untaintedp is a nicer function, because in the list case it acts just
+;; like a standard list recognizer like integerp, i.e., it operates via "and".
+;; In contrast, "tainted-listp" would have to operate through "or", which I
+;; think makes the rules about it less nice.
+
+(mutual-recursion
+ (defund untaintedp (x f)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (logic.formulap f))))
+   (if (mbt (logic.appealp x))
+       (if (or (equal (logic.method x) 'axiom)
+               (equal (logic.method x) 'theorem))
+           (not (equal (logic.conclusion x) f))
+         (untainted-listp (logic.subproofs x) f))
+     nil))
+ (defund untainted-listp (x f)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (logic.formulap f))))
+   (if (consp x)
+       (and (untaintedp (car x) f)
+            (untainted-listp (cdr x) f))
+     t)))
+
+(defthm untainted-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (untainted-listp x f)
+                  t))
+  :hints(("Goal" :in-theory (enable untainted-listp))))
+
+(defthm untainted-listp-of-cons
+  (equal (untainted-listp (cons a x) f)
+         (and (untaintedp a f)
+              (untainted-listp x f)))
+  :hints(("Goal" :in-theory (enable untainted-listp))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'proof)
+              (booleanp (untaintedp x f))
+            (booleanp (untainted-listp x f)))
+          :rule-classes nil
+          :hints(("Goal"
+                  :in-theory (enable untaintedp untainted-listp)
+                  :induct (logic.appeal-induction flag x)))))
+
+ (defthm booleanp-of-untaintedp
+   (booleanp (untaintedp x f))
+   :hints(("Goal" :use ((:instance lemma (flag 'proof))))))
+
+ (defthm booleanp-of-untainted-listp
+   (booleanp (untaintedp x f))
+   :hints(("Goal" :use ((:instance lemma (flag 'proof)))))))
+
+(defthm untaintedp-of-car-when-untainted-listp
+  (implies (untainted-listp x f)
+           (equal (untaintedp (car x) f)
+                  (consp x)))
+  :hints(("Goal" :in-theory (enable untaintedp))))
+
+(defthm untaintedp-of-cdr-when-untainted-listp
+  (implies (untainted-listp x f)
+           (untainted-listp (cdr x) f)))
+
+(defthm forcing-untaintedp-when-axiom
+  (implies (and (force (logic.appealp x))
+                (equal (logic.method x) 'axiom))
+           (equal (untaintedp x f)
+                  (not (equal (logic.conclusion x) f))))
+  :hints(("Goal" :in-theory (enable untaintedp))))
+
+(defthm forcing-untaintedp-when-theorem
+  (implies (and (force (logic.appealp x))
+                (equal (logic.method x) 'theorem))
+           (equal (untaintedp x f)
+                  (not (equal (logic.conclusion x) f))))
+  :hints(("Goal" :in-theory (enable untaintedp))))
+
+(defthm forcing-untaintedp-when-non-axiom/theorem
+  (implies (and (force (logic.appealp x))
+                (not (equal (logic.method x) 'axiom))
+                (not (equal (logic.method x) 'theorem)))
+           (equal (untaintedp x f)
+                  (untainted-listp (logic.subproofs x) f)))
+  :hints(("Goal" :in-theory (enable untaintedp))))
+
+(defthm untainted-listp-of-logic.subproofs-when-untainted-and-logic.appeal-step-okp
+  (implies (and (logic.appeal-step-okp x axioms thms)
+                (untaintedp x f)
+                (logic.appealp x))
+           (untainted-listp (logic.subproofs x) f))
+  :hints(("Goal" :in-theory (enable untaintedp
+                                    logic.appeal-step-okp
+                                    logic.axiom-okp
+                                    logic.theorem-okp))))
+
+(defthm logic.axiom-okp-of-remove-all-when-untaintedp
+  (implies (and (logic.appealp x)
+                (untaintedp x f))
+           (equal (logic.axiom-okp x (remove-all f axioms))
+                  (logic.axiom-okp x axioms)))
+  :hints(("Goal" :in-theory (enable logic.axiom-okp))))
+
+(defthm logic.appeal-step-okp-of-remove-all-from-axioms-when-untaintedp
+  (implies (and (logic.appealp x)
+                (untaintedp x f))
+           (equal (logic.appeal-step-okp x (remove-all f axioms) thms)
+                  (logic.appeal-step-okp x axioms thms)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.theorem-okp-of-remove-all-when-untaintedp
+  (implies (and (logic.appealp x)
+                (untaintedp x f))
+           (equal (logic.theorem-okp x (remove-all f thms))
+                  (logic.theorem-okp x thms)))
+  :hints(("Goal" :in-theory (enable logic.theorem-okp))))
+
+(defthm logic.appeal-step-okp-of-remove-all-from-thms-when-untaintedp
+  (implies (and (logic.appealp x)
+                (untaintedp x f))
+           (equal (logic.appeal-step-okp x axioms (remove-all f thms))
+                  (logic.appeal-step-okp x axioms thms)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'proof)
+              (implies (and (logic.appealp x)
+                            (untaintedp x f))
+                       (equal (logic.proofp x (remove-all f axioms) thms atbl)
+                              (logic.proofp x axioms thms atbl)))
+            (implies (and (logic.appeal-listp x)
+                          (untainted-listp x f))
+                     (equal (logic.proof-listp x (remove-all f axioms) thms atbl)
+                            (logic.proof-listp x axioms thms atbl))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.appeal-induction flag x)
+                  :in-theory (enable logic.proofp)))))
+
+ (defthm logic.proofp-of-remove-all-from-axioms-when-untaintedp
+   (implies (and (logic.appealp x)
+                 (untaintedp x f))
+            (equal (logic.proofp x (remove-all f axioms) thms atbl)
+                   (logic.proofp x axioms thms atbl)))
+   :hints(("Goal" :use ((:instance lemma (flag 'proof))))))
+
+ (defthm logic.proof-listp-of-remove-all-from-axioms-when-untainted-listp
+   (implies (and (logic.appeal-listp x)
+                 (untainted-listp x f))
+            (equal (logic.proof-listp x (remove-all f axioms) thms atbl)
+                   (logic.proof-listp x axioms thms atbl)))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'proof)
+              (implies (and (logic.appealp x)
+                            (untaintedp x f))
+                       (equal (logic.proofp x axioms (remove-all f thms) atbl)
+                              (logic.proofp x axioms thms atbl)))
+            (implies (and (logic.appeal-listp x)
+                          (untainted-listp x f))
+                     (equal (logic.proof-listp x axioms (remove-all f thms) atbl)
+                            (logic.proof-listp x axioms thms atbl))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.appeal-induction flag x)
+                  :in-theory (enable logic.proofp)))))
+
+ (defthm logic.proofp-of-remove-all-from-thms-when-untaintedp
+   (implies (and (logic.appealp x)
+                 (untaintedp x f))
+            (equal (logic.proofp x axioms (remove-all f thms) atbl)
+                   (logic.proofp x axioms thms atbl)))
+   :hints(("Goal" :use ((:instance lemma (flag 'proof))))))
+
+ (defthm logic.proof-listp-of-remove-all-from-thms-when-untainted-listp
+   (implies (and (logic.appeal-listp x)
+                 (untainted-listp x f))
+            (equal (logic.proof-listp x axioms (remove-all f thms) atbl)
+                   (logic.proof-listp x axioms thms atbl)))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+
+
+
+;; Definition: Admits Deduction.
+;;
+;; We say that X "admits deduction with respect to F" if the following hold:
+;;
+;;   (1) Whenever sigma is a substitution list used in a tainted appeal to
+;;       instantiation, F/sigma = F.
+;;
+;;   (2) There are no tainted appeals to induction.
+;;
+;; For example, if as before F is the formula x = 'nil, then the following
+;; proof admits deduction, because its substitution list [x <- x] does not
+;; change F.
+;;
+;;   ('instantiation ('pequal* x 'nil)
+;;                   (('axiom ('pequal* x 'nil)))
+;;                   ((x . x)))
+;;
+;; However, the following proof does not admit deduction, because its
+;; substitution list [x <- a] changes F.
+;;
+;;   ('instantiation ('pequal* a 'nil)
+;;                   (('axiom ('pequal* x 'nil)))
+;;                   ((x . a)))
+;;
+;; We will show that whenever a proof of G from {T \Cup F} admits deduction,
+;; then we can transform it into a proof of F -> G from T.
+
+
+;; BOZO this will also prohibit tainted appeals to reflection.  I don't know if
+;; we care about that or how to handle that yet.
+
+(encapsulate
+ ()
+ (local (defthm termination-lemma-1
+          (implies (or (equal (logic.method x) 'expansion)
+                       (equal (logic.method x) 'contraction)
+                       (equal (logic.method x) 'associativity)
+                       (equal (logic.method x) 'cut)
+                       (equal (logic.method x) 'instantiation))
+                   (equal (< (rank (first (logic.subproofs x)))
+                             (rank x))
+                          t))
+          :hints(("Goal" :in-theory (enable logic.method logic.subproofs)))))
+
+ (local (defthm termination-lemma-2
+          (implies (equal (logic.method x) 'cut)
+                   (equal (< (rank (second (logic.subproofs x)))
+                             (rank x))
+                          t))
+          :hints(("Goal" :in-theory (enable logic.method logic.subproofs)))))
+
+ (defund admits-deductionp (x f)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (logic.formulap f))
+                   :verify-guards nil))
+   (let ((method (logic.method x))
+         (subproofs (logic.subproofs x)))
+     (cond ((untaintedp x f)
+            ;; All untainted proofs admit deduction.  Note that this implicitly
+            ;; covers the cases where x is an appeal to any non-f axiom, including
+            ;; base-evaluation, propositional axioms, and functional equality
+            ;; axioms.
+            t)
+
+           ((or (equal method 'axiom)
+                (equal method 'theorem))
+            ;; The only tainted axiom/theorem is F itself, and it is permissible.
+            t)
+
+           ((or (equal method 'expansion)
+                (equal method 'contraction)
+                (equal method 'associativity))
+            ;; Tainted appeals to expansion, contraction, and associativity
+            ;; are permissible as long as the subgoal admits deduction.
+            (admits-deductionp (first subproofs) f))
+
+           ((equal method 'cut)
+            ;; Tainted appeals to cut are permissible as long as both subproofs
+            ;; admit deduction.
+            (and (admits-deductionp (first subproofs) f)
+                 (admits-deductionp (second subproofs) f)))
+
+
+           ((equal method 'instantiation)
+            ;; Tainted appeals to instantiation are permissible as long as the
+            ;; substitution list used does not change F, and the subgoal admits
+            ;; deduction.
+            (and (equal (logic.substitute-formula f (logic.extras x)) f)
+                 (admits-deductionp (first subproofs) f)))
+
+           (t
+            ;; Other tainted appeals are not acceptable.  In particular,
+            ;; tainted appeals to induction are not tolerated.
+            nil)))))
+
+(verify-guards admits-deductionp
+  :hints(("Goal" :in-theory (enable logic.proofp))))
+
+(defthm forcing-admits-deduction-when-untainted
+  (implies (and (untaintedp x f)
+                (force (logic.appealp x)))
+           (admits-deductionp x f axioms thms atbl))
+  :hints(("Goal" :in-theory (enable admits-deductionp))))
+
+(defthm admits-deductionp-when-logic.axiom-okp
+  (implies (and (logic.axiom-okp x axioms)
+                (force (logic.appealp x)))
+           (admits-deductionp x f axioms thms atbl))
+  :hints(("Goal" :in-theory (enable admits-deductionp logic.axiom-okp))))
+
+(defthm admits-deductionp-when-logic.theorem-okp
+  (implies (and (logic.theorem-okp x thms)
+                (force (logic.appealp x)))
+           (admits-deductionp x f axioms thms atbl))
+  :hints(("Goal" :in-theory (enable admits-deductionp logic.theorem-okp))))
+
+(defthm admits-deductionp-when-logic.expansion-okp
+  (implies (and (logic.expansion-okp x)
+                (force (logic.appealp x)))
+           (equal (admits-deductionp x f axioms thms atbl)
+                  (if (untaintedp x f)
+                      t
+                    (admits-deductionp (first (logic.subproofs x)) f axioms thms atbl))))
+  :hints(("Goal" :in-theory (enable admits-deductionp logic.expansion-okp))))
+
+(defthm admits-deductionp-when-logic.contraction-okp
+  (implies (and (logic.contraction-okp x)
+                (force (logic.appealp x)))
+           (equal (admits-deductionp x f axioms thms atbl)
+                  (if (untaintedp x f)
+                      t
+                    (admits-deductionp (first (logic.subproofs x)) f axioms thms atbl))))
+  :hints(("Goal" :in-theory (enable admits-deductionp logic.contraction-okp))))
+
+(defthm admits-deductionp-when-logic.associativity-okp
+  (implies (and (logic.associativity-okp x)
+                (force (logic.appealp x)))
+           (equal (admits-deductionp x f axioms thms atbl)
+                  (if (untaintedp x f)
+                      t
+                    (admits-deductionp (first (logic.subproofs x)) f axioms thms atbl))))
+  :hints(("Goal" :in-theory (enable admits-deductionp logic.associativity-okp))))
+
+(defthm admits-deductionp-when-logic.cut-okp
+  (implies (and (logic.cut-okp x)
+                (force (logic.appealp x)))
+           (equal (admits-deductionp x f axioms thms atbl)
+                  (if (untaintedp x f)
+                      t
+                    (and (admits-deductionp (first (logic.subproofs x)) f axioms thms atbl)
+                         (admits-deductionp (second (logic.subproofs x)) f axioms thms atbl)))))
+  :hints(("Goal" :in-theory (enable admits-deductionp logic.cut-okp))))
+
+(defthm admits-deductionp-when-logic.instantiation-okp
+  (implies (and (logic.instantiation-okp x)
+                (force (logic.appealp x)))
+           (equal (admits-deductionp x f axioms thms atbl)
+                  (if (untaintedp x f)
+                      t
+                    (and (equal (logic.substitute-formula f (logic.extras x)) f)
+                         (admits-deductionp (first (logic.subproofs x)) f axioms thms atbl)))))
+  :hints(("Goal" :in-theory (enable admits-deductionp logic.instantiation-okp))))
+
+
+
+;; Suppose X is a proof of A from some database which admits deduction
+;; w.r.t. F.  Then, the following builder should construct a proof of F -> A
+;; from (remove-all f axioms).
+
+(defund deduction-law-bldr (x f axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formulap f)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl)
+                              (logic.proofp x axioms thms atbl)
+                              (admits-deductionp x f axioms thms atbl))
+                  :verify-guards nil))
+  (if (not (mbt (logic.appealp x)))
+      ;; stupid hack for termination
+      nil
+    (let ((method (logic.method x))
+          (subproofs (logic.subproofs x)))
+      (cond
+       ((untaintedp x f)
+        ;; If X is not tainted by F, then we can prove A without ever referring
+        ;; to F.  We can then just expand this proof with ~F.  Note that this
+        ;; case entirely subsumes any uses of 'propositional-schema,
+        ;; 'functional-equality, 'base-eval, and any axioms other than F.
+        (build.expansion (logic.pnot f) x))
+
+       ((or (equal method 'axiom)
+            (equal method 'theorem))
+        ;; X is an axiom/theorem but it is tainted.  The only possibility is
+        ;; that X is an axiomatic appeal to F itself.  We need to prove ~F v F,
+        ;; which is really easy since that's a propositional axiom.
+        (build.propositional-schema f))
+
+       ((equal method 'expansion)
+        ;; X is a tainted appeal to expansion.  Then, it has the form
+        ;; ('expansion ('por* P Q) ([proof of Q])).  We will recursively
+        ;; construct a proof of ~F v Q, then by Disjoined Left Expansion we
+        ;; obtain ~F v (P v Q).
+        (build.disjoined-left-expansion
+         (deduction-law-bldr (first subproofs) f axioms thms atbl)
+         (logic.vlhs (logic.conclusion x))))
+
+       ((equal method 'contraction)
+        ;; X is a tainted appeal to contraction.  Then, it has the form
+        ;; ('contraction P ([proof of P v P])).  We recursively construct a
+        ;; proof of ~F v (P v P).  We can then use disjoined contraction to
+        ;; produce a proof of ~F v P.
+        (build.disjoined-contraction
+         (deduction-law-bldr (first subproofs) f axioms thms atbl)))
+
+       ((equal method 'associativity)
+        ;; X is a tainted appeal to associativity.  Then, it has the form
+        ;; ('associativity ('por* ('por* P Q) R) ([proof of ('por* P ('por* Q
+        ;; R))]).  We will recursively construct a proof of ~F v (P v (Q v R))
+        ;; and then use disjoined left associativity to produce a proof of
+        ;; ~F v ((P v Q) v R)
+        (build.disjoined-associativity
+         (deduction-law-bldr (first subproofs) f axioms thms atbl)))
+
+       ((equal method 'cut)
+        ;; X is a tainted appeal to cut.  Then, it has the form ('cut
+        ;; ('por* Q R) [(proof of P v Q), (proof of ~P v R)])).  We will
+        ;; recursively construct proofs of ~F v (P v Q) and ~F v (~P v R),
+        ;; then use disjoined cut to produce a proof of ~F v (Q v R).
+        (build.disjoined-cut
+         (deduction-law-bldr (first subproofs) f axioms thms atbl)
+         (deduction-law-bldr (second subproofs) f axioms thms atbl)))
+
+       ((equal method 'instantiation)
+        ;; X is a tainted appeal to instantiation.  Then, it has the form
+        ;; ('instantiation P/sigma P sigma).  We will recursively construct a
+        ;; proof of ~F v P.  Then, since X admits deduction, we know that sigma
+        ;; mentions none of the variables in F, so by instantiation with sigma
+        ;; we conclude (~F v P)/sigma = ~F/sigma v P/sigma, which is ~F v
+        ;; P/sigma.
+        (build.instantiation
+         (deduction-law-bldr (first subproofs) f axioms thms atbl)
+         (logic.extras x)))
+
+       (t
+        ;; This case should never occur
+        nil)))))
+
+(local (defthm equal-when-dual-logic.pnots
+         (implies (and (equal (logic.fmtype a) 'pnot*)
+                       (equal (logic.fmtype b) 'pnot*)
+                       (force (logic.formulap a))
+                       (force (logic.formulap b)))
+                  (equal (equal a b)
+                         (equal (logic.~arg a) (logic.~arg b))))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))
+         :hints(("Goal" :in-theory (enable logic.formulap logic.~arg logic.fmtype)))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (logic.appealp x)
+                        (logic.formulap f)
+                        (logic.formula-listp axioms)
+                        (logic.formula-listp thms)
+                        (logic.arity-tablep atbl)
+                        (logic.proofp x axioms thms atbl)
+                        (admits-deductionp x f axioms thms atbl))
+                   (and (logic.appealp (deduction-law-bldr x f axioms thms atbl))
+                        (equal (logic.conclusion (deduction-law-bldr x f axioms thms atbl))
+                               (logic.por (logic.pnot f) (logic.conclusion x)))))
+          :hints(("Goal"
+                  :in-theory (enable deduction-law-bldr
+                                     admits-deductionp
+                                     logic.proofp)
+                  :induct (deduction-law-bldr x f axioms thms atbl)))))
+
+ (defthm forcing-logic.appealp-of-deduction-law-bldr
+   (implies (force (and (logic.appealp x)
+                        (logic.formulap f)
+                        (logic.formula-listp axioms)
+                        (logic.formula-listp thms)
+                        (logic.arity-tablep atbl)
+                        (logic.proofp x axioms thms atbl)
+                        (admits-deductionp x f axioms thms atbl)))
+            (logic.appealp (deduction-law-bldr x f axioms thms atbl))))
+
+ (defthm forcing-logic.conclusion-of-deduction-law-bldr
+   (implies (force (and (logic.appealp x)
+                        (logic.formulap f)
+                        (logic.formula-listp axioms)
+                        (logic.formula-listp thms)
+                        (logic.arity-tablep atbl)
+                        (logic.proofp x axioms thms atbl)
+                        (admits-deductionp x f axioms thms atbl)))
+            (equal (logic.conclusion (deduction-law-bldr x f axioms thms atbl))
+                   (logic.por (logic.pnot f) (logic.conclusion x))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(verify-guards deduction-law-bldr
+ :hints(("Goal" :in-theory (enable logic.proofp admits-deductionp))))
+
+
+(defthm forcing-logic.proofp-of-deduction-law-bldr
+  (implies (force (and (logic.appealp x)
+                       (logic.formulap f)
+                       (logic.formula-listp axioms)
+                       (logic.formula-listp thms)
+                       (logic.arity-tablep atbl)
+                       (logic.proofp x axioms thms atbl)
+                       (admits-deductionp x f axioms thms atbl)))
+           (logic.proofp (deduction-law-bldr x f axioms thms atbl)
+                         (remove-all f axioms)
+                         (remove-all f thms)
+                         atbl))
+  :hints(("Goal" :in-theory (enable deduction-law-bldr
+                                    admits-deductionp
+                                    logic.proofp))))
+
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/classic/demo-extension.lisp acl2-6.3/books/milawa/ACL2/classic/demo-extension.lisp
--- acl2-6.2/books/milawa/ACL2/classic/demo-extension.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/classic/demo-extension.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,330 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../build/prop")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; We prove that a new proof checker, demo.proofp, is sound with respect to the
+;; core proof checker, logic.proofp.  Our new proof checker understands all of
+;; the primitive rules, and also commute-or.  This isn't a practically useful
+;; thing to do, but perhaps this serves as the simplest example of extending
+;; the core prover.
+
+(defund@ demo.commute-or$ (x)
+  ;; This builds a "commute or" appeal.  Such appeals are not accepted by
+  ;; logic.proofp, but they will be accepted by demo.proofp.
+  (declare (xargs :guard (and (logic.appealp x)
+                              (@match (proof x (v A B))))))
+  (logic.appeal 'commute-or
+                (@formula (v B A))
+                (list x)
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable demo.commute-or$)))
+
+ (defthm demo.commute-or$-under-iff
+   (iff (demo.commute-or$ x)
+        t))
+
+ (defthm logic.method-of-demo.commute-or$
+   (equal (logic.method (demo.commute-or$ x))
+          'commute-or))
+
+ (defthm@ logic.conclusion-of-demo.commute-or$
+   (@extend ((proof x (v A B)))
+            (equal (logic.conclusion (demo.commute-or$ x))
+                   (@formula (v B A)))))
+
+ (defthm logic.subproofs-of-demo.commute-or$
+   (equal (logic.subproofs (demo.commute-or$ x))
+          (list x)))
+
+ (defthm logic.extras-of-demo.commute-or$
+   (equal (logic.extras (demo.commute-or$ x))
+          nil))
+
+ (defthm@ forcing-logic.appealp-of-demo.commute-or$
+   (implies (force (and (logic.appealp x)
+                        (@match (proof x (v A B)))))
+            (equal (logic.appealp (demo.commute-or$ x))
+                   t))))
+
+
+
+(defund@ demo.commute-or-okp (x)
+  ;; This checks that a commute or appeal is valid.  It's the same idea as in
+  ;; the primitive checkers for expansion, associativity, etc.
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'commute-or)
+         (equal extras nil)
+         (equal (len subproofs) 1)
+         (@match (formula conclusion (v A B))
+                 (proof (first subproofs) (v B A))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable demo.commute-or-okp)))
+
+ (defthm booleanp-of-demo.commute-or-okp
+   (equal (booleanp (demo.commute-or-okp x))
+          t))
+
+ (defthm@ forcing-demo.commute-or-okp-of-demo.commute-or$
+   (implies (force (and (logic.appealp x)
+                        (@match (proof x (v A B)))))
+            (equal (demo.commute-or-okp (demo.commute-or$ x))
+                   t)))
+
+ (defthm demo.commute-or-okp-of-logic.appeal-identity
+   (equal (demo.commute-or-okp (logic.appeal-identity x))
+          (demo.commute-or-okp x)))
+
+ ;; Now we'll show that demo.commute-or-okp is sound w.r.t. the core proof
+ ;; checker: if demo.commute-or-okp accepts a step whose subproofs are all
+ ;; provable, then the step's conclusion is also provable.
+
+ (local (defthm lemma1
+          (implies (and (demo.commute-or-okp x)
+                        (logic.appealp x)
+                        (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+                   (equal (logic.conclusion (build.commute-or (logic.provable-witness (logic.conclusion (first (logic.subproofs x))) axioms thms atbl)))
+                          (logic.conclusion x)))))
+
+ (local (defthm lemma2
+          (implies (and (demo.commute-or-okp x)
+                        (logic.appealp x)
+                        (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+                   (equal (logic.proofp (build.commute-or (logic.provable-witness (logic.conclusion (first (logic.subproofs x))) axioms thms atbl)) axioms thms atbl)
+                          t))))
+
+ (defthm soundness-of-demo.commute-or-okp
+   (implies (and (demo.commute-or-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints(("Goal"
+           :use (:instance forcing-logic.provablep-when-logic.proofp
+                           (x (build.commute-or (logic.provable-witness (logic.conclusion (first (logic.subproofs x))) axioms thms atbl))))))))
+
+
+
+
+(defund demo.appeal-step-okp (x axioms thms atbl)
+  ;; This is our extended version of logic.appeal-step-okp.  We accept commute
+  ;; or appeals, and also all the primitive appeals.  I sometimes think of this
+  ;; function as "extending of the virtual table" to include a new "subclass"
+  ;; of the appeal class.
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (cond ((equal (logic.method x) 'commute-or)
+         (demo.commute-or-okp x))
+        (t
+         (logic.appeal-step-okp x axioms thms atbl))))
+
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable demo.appeal-step-okp)))
+
+ (defthm soundness-of-demo.appeal-step-okp
+   (implies (and (logic.appealp x)
+                 (demo.appeal-step-okp x axioms thms atbl)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm demo.appeal-step-okp-when-logic.appeal-step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (logic.appeal-step-okp x axioms thms atbl)
+            (demo.appeal-step-okp x axioms thms atbl))
+   :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+ (defthm demo.appeal-step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (demo.appeal-step-okp x axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+
+
+(defund demo.flag-proofp (flag x axioms thms atbl)
+  (declare (xargs :guard (and (if (equal flag 'proof)
+                                  (logic.appealp x)
+                                (and (equal flag 'list)
+                                     (logic.appeal-listp x)))
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :measure (two-nats-measure (rank x)
+                                             (if (equal flag 'proof) 1 0))))
+  (if (equal flag 'proof)
+      (and (demo.appeal-step-okp x axioms thms atbl)
+           (demo.flag-proofp 'list (logic.subproofs x) axioms thms atbl))
+    (if (consp x)
+        (and (demo.flag-proofp 'proof (car x) axioms thms atbl)
+             (demo.flag-proofp 'list (cdr x) axioms thms atbl))
+     t)))
+
+(definlined demo.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (demo.flag-proofp 'proof x axioms thms atbl))
+
+(definlined demo.proof-listp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (demo.flag-proofp 'list x axioms thms atbl))
+
+(defthmd definition-of-demo.proofp
+  (equal (demo.proofp x axioms thms atbl)
+         (and (demo.appeal-step-okp x axioms thms atbl)
+              (demo.proof-listp (logic.subproofs x) axioms thms atbl)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable demo.proofp demo.proof-listp demo.flag-proofp))))
+
+(defthmd definition-of-demo.proof-listp
+  (equal (demo.proof-listp x axioms thms atbl)
+         (if (consp x)
+             (and (demo.proofp (car x) axioms thms atbl)
+                  (demo.proof-listp (cdr x) axioms thms atbl))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable demo.proofp demo.proof-listp demo.flag-proofp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition demo.proofp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition demo.proof-list))))
+
+
+
+(defthm demo.proofp-when-not-consp
+  (implies (not (consp x))
+           (equal (demo.proofp x axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-demo.proofp))))
+
+(defthm demo.proof-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (demo.proof-listp x axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-demo.proof-listp))))
+
+(defthm demo.proof-listp-of-cons
+  (equal (demo.proof-listp (cons a x) axioms thms atbl)
+         (and (demo.proofp a axioms thms atbl)
+              (demo.proof-listp x axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-demo.proof-listp))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-demo.proofp
+                (equal (booleanp (demo.proofp x axioms thms atbl))
+                       t))
+         (t booleanp-of-demo.proof-listp
+            (equal (booleanp (demo.proof-listp x axioms thms atbl))
+                   t)))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-demo.proofp))))
+
+(deflist demo.proof-listp (x axioms thms atbl)
+  (demo.proofp x axioms thms atbl)
+  :already-definedp t)
+
+
+(defthms-flag
+  :thms ((proof logic.provablep-when-demo.proofp
+                (implies (and (logic.appealp x)
+                              (demo.proofp x axioms thms atbl))
+                         (logic.provablep (logic.conclusion x) axioms thms atbl)))
+         (t logic.provable-listp-when-demo.proof-listp
+            (implies (and (logic.appeal-listp x)
+                          (demo.proof-listp x axioms thms atbl))
+                     (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-demo.proofp))))
+
+
+(defthms-flag
+  ;; WARNING: THESE THEOREMS MUST BE LEFT DISABLED!
+  ;;
+  ;; Suppose this rule is enabled, and we are trying to prove (demo.proofp X
+  ;; ...)  Using this rule, we backchain and try to show (logic.proofp X ...),
+  ;; which causes our forcing rules to kick in and assert that the subproofs of
+  ;; X are acceptable using logic.proofp.
+  ;;
+  ;; But this is horrible; if any of the subproofs are derived rules that only
+  ;; demo.proofp understands, we end up stuck in forcing rounds that we cannot
+  ;; relieve.  So, we should always be reasoning about some single layer and
+  ;; never about previous layers.
+  :thms ((proof demo.proofp-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (demo.proofp x axioms thms atbl)))
+         (t demo.proof-listp-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (demo.proof-listp x axioms thms atbl))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-demo.proofp
+                              definition-of-logic.proofp))))
+
+(in-theory (disable demo.proofp-when-logic.proofp demo.proof-listp-when-logic.proof-listp))
+
+(defthm forcing-demo.proofp-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by demo.proofp.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (demo.proofp (logic.provable-witness formula axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable demo.proofp-when-logic.proofp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/classic/equal-substitution.lisp acl2-6.3/books/milawa/ACL2/classic/equal-substitution.lisp
--- acl2-6.2/books/milawa/ACL2/classic/equal-substitution.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/classic/equal-substitution.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,754 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tautologies")
+(include-book "../build/lambda")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Let X' (a term) be obtained from X (another term) by replacing some
+;; occurrences of terms A1,...,An by A1',...,An', respectively.  If
+;;   |- A1 = A1', |- A2 = A2', ..., |- An = An'
+;; Then
+;;   |- X = X'
+;;
+;; Furthermore, if Y' (a formula) is obtained from Y (another formula)
+;; by similar replacements, then
+;;   |- Y <-> Y'
+
+
+
+;; We introduce the function equals-for-equalsp, which takes as inputs the
+;; terms x and y, and the list of formulas [A1, A2, ..., An].  We return true
+;; if and only if y is obtainable from x by replacing some terms ti with other
+;; terms si, where ti=si or si=ti is some Ai.
+;;
+;; This function is sort of like tautologyp1, in that it does not build a
+;; proof, but is rather just an algorithm to decide if a proof can be
+;; generated.
+
+(mutual-recursion
+ (defund equal-substitutible-logic.termp (x y as)
+   (declare (xargs :guard (and (logic.termp x)
+                               (logic.termp y)
+                               (logic.formula-listp as))))
+   (or (equal x y)
+       (memberp (logic.pequal x y) as)
+       (memberp (logic.pequal y x) as)
+       (cond ((logic.constantp x)
+              nil)
+             ((logic.variablep x)
+              nil)
+             ((logic.functionp x)
+              (and (logic.functionp y)
+                   (equal (logic.function-name x) (logic.function-name y))
+                   (equal-substitutible-logic.term-listp (logic.function-args x) (logic.function-args y) as)))
+             ((logic.lambdap x)
+              (and (logic.lambdap y)
+                   (equal (logic.lambda-formals x) (logic.lambda-formals y))
+                   (equal (logic.lambda-body x) (logic.lambda-body y))
+                   (equal-substitutible-logic.term-listp (logic.lambda-actuals x)
+                                                         (logic.lambda-actuals y)
+                                                         as)))
+             (t nil))))
+
+ (defund equal-substitutible-logic.term-listp (x y as)
+   (declare (xargs :guard (and (logic.term-listp x)
+                               (logic.term-listp y)
+                               (logic.formula-listp as))))
+   (if (consp x)
+       (and (consp y)
+            (equal-substitutible-logic.termp (car x) (car y) as)
+            (equal-substitutible-logic.term-listp (cdr x) (cdr y) as))
+     (not (consp y)))))
+
+(defthm equal-substitutible-logic.term-listp-of-cdrs-when-equal-substitutible-logic.term-listp
+  (implies (and (equal-substitutible-logic.term-listp x y as)
+                (consp x)
+                (consp y))
+           (equal-substitutible-logic.term-listp (cdr x) (cdr y) as))
+  :hints(("Goal" :in-theory (enable equal-substitutible-logic.term-listp))))
+
+(defthm equal-substitutible-logic.termp-of-cars-when-equal-substitutible-logic.term-listp
+  (implies (and (equal-substitutible-logic.term-listp x y as)
+                (consp x)
+                (consp y))
+           (equal-substitutible-logic.termp (car x) (car y) as))
+  :hints(("Goal" :in-theory (enable equal-substitutible-logic.term-listp))))
+
+(defthm equal-of-lengths-when-equal-substitutible-logic.term-listp
+  (implies (equal-substitutible-logic.term-listp x y as)
+           (equal (equal (len x) (len y))
+                  t))
+  :hints(("Goal"
+          :induct (cdr-cdr-induction x y)
+          :in-theory (enable equal-substitutible-logic.term-listp))))
+
+(defthm equal-substitutible-logic.term-listp-of-logic.lambda-actuals-when-logic.lambdaps
+  (implies (and (equal-substitutible-logic.termp x y as)
+                (logic.lambdap x)
+                (logic.lambdap y)
+                (not (equal x y))
+                (not (memberp (logic.pequal x y) as))
+                (not (memberp (logic.pequal y x) as)))
+           (equal-substitutible-logic.term-listp (logic.lambda-actuals x)
+                                           (logic.lambda-actuals y)
+                                           as))
+  :hints(("Goal"
+          :in-theory (enable equal-substitutible-logic.termp)
+          :expand (equal-substitutible-logic.termp x y as))))
+
+(defthm equal-substitutible-logic.term-listp-of-logic.function-args-when-logic.functionps
+  (implies (and (equal-substitutible-logic.termp x y as)
+                (logic.functionp x)
+                (logic.functionp y)
+                (not (equal x y))
+                (not (memberp (logic.pequal x y) as))
+                (not (memberp (logic.pequal y x) as)))
+           (equal-substitutible-logic.term-listp (logic.function-args x) (logic.function-args y) as))
+  :hints(("Goal"
+          :in-theory (enable equal-substitutible-logic.termp)
+          :expand (equal-substitutible-logic.termp x y as))))
+
+
+
+;; Below we introduce equals-for-equals-bldr, which takes as inputs the terms x
+;; and y, and the list of proofs [A1, A2, ..., An].  It should be the case that
+;; these inputs satisfy equal-substitutible-logic.termp (i.e., using the conclusions
+;; of the proofs A1...An).  Our goal is to build a proof that x = y, by
+;; utilizing the provided proofs as necessary.
+;;
+;; This function is sort of like tautologyp-bldr1, which builds a proof
+;; whenever tautologyp1 says that some inputs are ok.  In this case, we build a
+;; proof when equal-substitutible-logic.termp says that the inputs are ok.
+
+(mutual-recursion
+ (defund equal-substitutible-term-bldr (x y as)
+   (declare (xargs :guard (and (logic.termp x)
+                               (logic.termp y)
+                               (logic.appeal-listp as)
+                               (equal-substitutible-logic.termp
+                                x y (logic.strip-conclusions as)))
+                   :verify-guards nil))
+   (cond ((equal x y)
+          (build.reflexivity x))
+         ((memberp (logic.pequal x y) (logic.strip-conclusions as))
+          (logic.find-proof (logic.pequal x y) as))
+         ((memberp (logic.pequal y x) (logic.strip-conclusions as))
+          (build.commute-pequal (logic.find-proof (logic.pequal y x) as)))
+         ((logic.functionp x)
+          (if (and (logic.functionp y)
+                   (equal (logic.function-name x) (logic.function-name y)))
+              (build.pequal-by-args
+               (logic.function-name x)
+               (equal-substitutible-term-list-bldr (logic.function-args x) (logic.function-args y) as))
+            nil))
+         ((logic.lambdap x)
+          (if (and (logic.lambdap y)
+                   (equal (logic.lambda-formals x) (logic.lambda-formals y))
+                   (equal (logic.lambda-body x) (logic.lambda-body y)))
+              (build.lambda-pequal-by-args
+               (logic.lambda-formals x)
+               (logic.lambda-body x)
+               (equal-substitutible-term-list-bldr (logic.lambda-actuals x)
+                                                   (logic.lambda-actuals y)
+                                                   as))
+              nil))
+         (t nil)))
+ (defund equal-substitutible-term-list-bldr (x y as)
+   (declare (xargs :guard (and (logic.term-listp x)
+                               (logic.term-listp y)
+                               (logic.appeal-listp as)
+                               (equal-substitutible-logic.term-listp
+                                x y (logic.strip-conclusions as)))))
+   (if (consp x)
+       (if (consp y)
+           (cons (equal-substitutible-term-bldr (car x) (car y) as)
+                 (equal-substitutible-term-list-bldr (cdr x) (cdr y) as))
+         nil)
+     nil)))
+
+(defthm len-of-equal-substitutible-term-list-bldr
+  (implies (force (equal (len x) (len y)))
+           (equal (len (equal-substitutible-term-list-bldr x y as))
+                  (len x)))
+  :hints(("Goal"
+          :in-theory (enable equal-substitutible-term-list-bldr)
+          :induct (cdr-cdr-induction x y))))
+
+(defthm true-listp-of-equal-substitutible-term-list-bldr
+  (equal (true-listp (equal-substitutible-term-list-bldr x y as))
+         t)
+  :hints(("Goal"
+          :in-theory (enable equal-substitutible-term-list-bldr)
+          :induct (cdr-cdr-induction x y))))
+
+
+(encapsulate
+  ()
+  (local
+   (defun my-induction (flag x y as)
+     (declare (xargs :verify-guards nil))
+     (if (equal flag 'term)
+         (cond ((equal x y)
+                nil)
+               ((memberp (logic.pequal x y) (logic.strip-conclusions as))
+                nil)
+               ((memberp (logic.pequal y x) (logic.strip-conclusions as))
+                nil)
+               ((logic.constantp x)
+                nil)
+               ((logic.variablep x)
+                nil)
+               ((logic.functionp x)
+                (my-induction 'list (logic.function-args x) (logic.function-args y) as))
+               ((logic.lambdap x)
+                (my-induction 'list
+                              (logic.lambda-actuals x)
+                              (logic.lambda-actuals y)
+                              as))
+               (t nil))
+       (if (and (consp x)
+                (consp y))
+           (list (my-induction 'term (car x) (car y) as)
+                 (my-induction 'list (cdr x) (cdr y) as))
+         nil))))
+
+  (local
+   (defthm lemma
+     (if (equal flag 'term)
+         (implies (and (logic.termp x)
+                       (logic.termp y)
+                       (logic.appeal-listp as)
+                       (equal-substitutible-logic.termp x y (logic.strip-conclusions as)))
+                  (and (logic.appealp
+                        (equal-substitutible-term-bldr x y as))
+                       (equal (logic.conclusion
+                               (equal-substitutible-term-bldr x y as))
+                              (logic.pequal x y))))
+       (implies (and (logic.term-listp x)
+                     (logic.term-listp y)
+                     (logic.appeal-listp as)
+                     (equal-substitutible-logic.term-listp x y (logic.strip-conclusions as)))
+                (and (logic.appeal-listp
+                      (equal-substitutible-term-list-bldr x y as))
+                     (equal (logic.strip-conclusions
+                             (equal-substitutible-term-list-bldr x y as))
+                            (logic.pequal-list x y)))))
+     :rule-classes nil
+     :hints(("Goal"
+             :induct (my-induction flag x y as)
+             :in-theory (e/d (equal-substitutible-term-bldr
+                              equal-substitutible-term-list-bldr
+                              equal-substitutible-logic.termp
+                              equal-substitutible-logic.term-listp))))))
+
+  (defthm forcing-logic.appealp-of-equal-substitutible-term-bldr
+    (implies (and (force (logic.termp x))
+                  (force (logic.termp y))
+                  (force (logic.appeal-listp as))
+                  (force (equal-substitutible-logic.termp x y (logic.strip-conclusions as))))
+             (logic.appealp (equal-substitutible-term-bldr x y as)))
+    :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+  (defthm forcing-logic.appeal-listp-of-equal-substitutible-term-list-bldr
+    (implies (and (force (logic.term-listp x))
+                  (force (logic.term-listp y))
+                  (force (logic.appeal-listp as))
+                  (force (equal-substitutible-logic.term-listp x y (logic.strip-conclusions as))))
+             (logic.appeal-listp (equal-substitutible-term-list-bldr x y as)))
+    :hints(("Goal" :use ((:instance lemma (flag 'list))))))
+
+  (defthm forcing-logic.conclusion-of-equal-substitutible-term-bldr
+    (implies (and (force (logic.termp x))
+                  (force (logic.termp y))
+                  (force (logic.appeal-listp as))
+                  (force (equal-substitutible-logic.termp x y (logic.strip-conclusions as))))
+             (equal (logic.conclusion (equal-substitutible-term-bldr x y as))
+                    (logic.pequal x y)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0))
+    :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+  (defthm forcing-logic.strip-conclusions-of-equal-substitutible-term-list-bldr
+    (implies (and (force (logic.term-listp x))
+                  (force (logic.term-listp y))
+                  (force (logic.appeal-listp as))
+                  (force (equal-substitutible-logic.term-listp x y (logic.strip-conclusions as))))
+             (equal (logic.strip-conclusions (equal-substitutible-term-list-bldr x y as))
+                    (logic.pequal-list x y)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0))
+    :hints(("Goal" :use ((:instance lemma (flag 'list))))))
+
+  (local (defthm crock
+           (implies (and (equal (logic.lambda-formals x)
+                                (logic.lambda-formals y))
+                         (logic.termp x)
+                         (logic.termp y)
+                         (logic.lambdap x)
+                         (logic.lambdap y))
+                    (equal (equal (len (logic.lambda-actuals x))
+                                  (len (logic.lambda-actuals y)))
+                           t))
+           :hints(("Goal"
+                   :in-theory (disable FORCING-EQUAL-LENS-OF-LOGIC.LAMBDA-FORMALS-AND-LOGIC.LAMBDA-ACTUALS)
+                   :use ((:instance FORCING-EQUAL-LENS-OF-LOGIC.LAMBDA-FORMALS-AND-LOGIC.LAMBDA-ACTUALS)
+                         (:instance FORCING-EQUAL-LENS-OF-LOGIC.LAMBDA-FORMALS-AND-LOGIC.LAMBDA-ACTUALS (x y)))))))
+
+  (verify-guards equal-substitutible-term-bldr)
+
+
+  (local (defthm lemma3
+           (if (equal flag 'term)
+               (implies (and (logic.termp x)
+                             (logic.termp y)
+                             (logic.appeal-listp as)
+                             (equal-substitutible-logic.termp x y (logic.strip-conclusions as))
+                             ;; ---
+                             (logic.term-atblp x atbl)
+                             (logic.term-atblp y atbl)
+                             (logic.proof-listp as axioms thms atbl)
+                             (memberp (axiom-reflexivity) axioms)
+                             (memberp (axiom-equality) axioms)
+                             (memberp (theorem-transitivity-of-pequal) thms)
+                             (memberp (theorem-commutativity-of-pequal) thms))
+                        (logic.proofp (equal-substitutible-term-bldr x y as) axioms thms atbl))
+             (implies (and (logic.term-listp x)
+                           (logic.term-listp y)
+                           (logic.appeal-listp as)
+                           (equal-substitutible-logic.term-listp x y (logic.strip-conclusions as))
+                           ;; ---
+                           (logic.term-list-atblp x atbl)
+                           (logic.term-list-atblp y atbl)
+                           (logic.proof-listp as axioms thms atbl)
+                           (memberp (axiom-reflexivity) axioms)
+                           (memberp (axiom-equality) axioms)
+                           (memberp (theorem-transitivity-of-pequal) thms)
+                           (memberp (theorem-commutativity-of-pequal) thms))
+                      (logic.proof-listp (equal-substitutible-term-list-bldr x y as) axioms thms atbl)))
+           :rule-classes nil
+           :hints(("Goal"
+                   :induct (my-induction flag x y as)
+                   :in-theory (enable equal-substitutible-term-bldr
+                                      equal-substitutible-term-list-bldr
+                                      equal-substitutible-logic.termp
+                                      equal-substitutible-logic.term-listp)))))
+
+  (defthm forcing-logic.proofp-of-equal-substitutible-term-bldr
+    (implies (force (and (logic.termp x)
+                         (logic.termp y)
+                         (logic.appeal-listp as)
+                         (equal-substitutible-logic.termp x y (logic.strip-conclusions as))
+                         ;; ---
+                         (logic.term-atblp x atbl)
+                         (logic.term-atblp y atbl)
+                         (logic.proof-listp as axioms thms atbl)
+                         (memberp (axiom-reflexivity) axioms)
+                         (memberp (axiom-equality) axioms)
+                         (memberp (theorem-transitivity-of-pequal) thms)
+                         (memberp (theorem-commutativity-of-pequal) thms)))
+             (logic.proofp (equal-substitutible-term-bldr x y as)
+                           axioms thms atbl))
+    :hints(("Goal" :use ((:instance lemma3 (flag 'term))))))
+
+  (defthm forcing-logic.proof-listp-of-equal-substitutible-term-list-bldr
+    (implies (force (and (logic.term-listp x)
+                         (logic.term-listp y)
+                         (logic.appeal-listp as)
+                         (equal-substitutible-logic.term-listp x y (logic.strip-conclusions as))
+                         ;; ---
+                         (logic.term-list-atblp x atbl)
+                         (logic.term-list-atblp y atbl)
+                         (logic.proof-listp as axioms thms atbl)
+                         (memberp (axiom-reflexivity) axioms)
+                         (memberp (axiom-equality) axioms)
+                         (memberp (theorem-transitivity-of-pequal) thms)
+                         (memberp (theorem-commutativity-of-pequal) thms)))
+             (logic.proof-listp (equal-substitutible-term-list-bldr x y as)
+                                axioms thms atbl))
+    :hints(("Goal" :use ((:instance lemma3 (flag 'list)))))))
+
+
+
+
+;; The second part of equals for equals is that, if a formula Y' is obtained
+;; from some formula Y through replacements of equals for equals, then we
+;; should be able to prove Y <-> Y'.
+
+(defund equal-substitutiblep (x y as)
+  (declare (xargs :guard (and (logic.formulap x)
+                              (logic.formulap y)
+                              (logic.formula-listp as))))
+  (cond ((equal (logic.fmtype x) 'por*)
+         (and (equal (logic.fmtype y) 'por*)
+              (equal-substitutiblep (logic.vlhs x) (logic.vlhs y) as)
+              (equal-substitutiblep (logic.vrhs x) (logic.vrhs y) as)))
+        ((equal (logic.fmtype x) 'pnot*)
+         (and (equal (logic.fmtype y) 'pnot*)
+              (equal-substitutiblep (logic.~arg x) (logic.~arg y) as)))
+        ((equal (logic.fmtype x) 'pequal*)
+         (and (equal (logic.fmtype x) 'pequal*)
+              (equal (logic.fmtype y) 'pequal*)
+              (equal-substitutible-logic.termp (logic.=lhs x) (logic.=lhs y) as)
+              (equal-substitutible-logic.termp (logic.=rhs x) (logic.=rhs y) as)))
+        (t nil)))
+
+(defthm logic.fmtype-when-equal-substitutiblep-with-logic.por
+  (implies (and (equal-substitutiblep x y as)
+                (equal (logic.fmtype x) 'por*))
+           (equal (logic.fmtype y) 'por*))
+   :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm logic.fmtype-when-equal-substitutiblep-with-logic.pnot
+  (implies (and (equal-substitutiblep x y as)
+                (equal (logic.fmtype x) 'pnot*))
+           (equal (logic.fmtype y) 'pnot*))
+   :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm logic.fmtype-when-equal-substitutiblep-with-pequal
+  (implies (and (equal-substitutiblep x y as)
+                (equal (logic.fmtype x) 'pequal*))
+           (equal (logic.fmtype y) 'pequal*))
+   :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm equal-substitutiblep-of-recursive-calls-in-logic.por-case
+  (implies (and (equal-substitutiblep x y as)
+                (force (equal (logic.fmtype x) 'por*)))
+           (and (equal-substitutiblep (logic.vlhs x) (logic.vlhs y) as)
+                (equal-substitutiblep (logic.vrhs x) (logic.vrhs y) as)))
+  :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm equal-substitutiblep-of-recursive-calls-in-logic.pnot-case
+  (implies (and (equal-substitutiblep x y as)
+                (force (equal (logic.fmtype x) 'pnot*)))
+           (equal-substitutiblep (logic.~arg x) (logic.~arg y) as))
+  :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm equal-substitutible-logic.termp-of-recursive-calls-in-pequal-case
+  (implies (and (equal-substitutiblep x y as)
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (and (equal-substitutible-logic.termp (logic.=lhs x) (logic.=lhs y) as)
+                (equal-substitutible-logic.termp (logic.=rhs x) (logic.=rhs y) as)))
+  :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+
+
+
+;; Note: This is like Shankar's function FORM-EQUAL-PROOF
+;;
+;; BOZO consider not using tautologies and building the proofs separately?
+
+(defund equal-substitutible-bldr (x y as)
+  (declare (xargs :guard (and (logic.formulap x)
+                              (logic.formulap y)
+                              (logic.appeal-listp as)
+                              (equal-substitutiblep
+                               x y (logic.strip-conclusions as)))
+                  :verify-guards nil))
+  (cond ((equal (logic.fmtype x) 'por*)
+         (tautological-consequence-bldr
+          (logic.piff x y)
+          (list (equal-substitutible-bldr (logic.vlhs x) (logic.vlhs y) as)
+                (equal-substitutible-bldr (logic.vrhs x) (logic.vrhs y) as))))
+        ((equal (logic.fmtype x) 'pnot*)
+         (tautological-consequence-bldr
+          (logic.piff x y)
+          (list (equal-substitutible-bldr (logic.~arg x) (logic.~arg y) as))))
+        ((equal (logic.fmtype x) 'pequal*)
+         (let ((T1       (logic.=lhs x))
+               (T1-Prime (logic.=lhs y))
+               (T2       (logic.=rhs x))
+               (T2-Prime (logic.=rhs y)))
+           (let* ((T1=T1-Prime (equal-substitutible-term-bldr T1 T1-Prime as))
+                  (T2=T2-Prime (equal-substitutible-term-bldr T2 T2-Prime as))
+                  (T1-Prime=T1 (build.commute-pequal T1=T1-Prime))
+                  (T2-Prime=T2 (build.commute-pequal T2=T2-Prime)))
+             (tautological-consequence-bldr
+              (logic.piff x y)
+              (list T1=T1-Prime
+                    T2=T2-Prime
+                    T1-Prime=T1
+                    T2-Prime=T2
+                    (build.equality T1 T1-Prime T2 T2-Prime)
+                    (build.equality T1-Prime T1 T2-Prime T2))))))
+        (t nil)))
+
+
+
+;; Explanation of the Base Case
+;;
+;; In the base case above, we assume that we have two formulas, T1=T1' and
+;; T2=T2', which are provable by the use of equals-for-equals.  We now need
+;; to show that T1=T2 <-> T1'=T2'.
+;;
+;; Shoenfield explains the proof as follows.
+;;
+;; 1. Use equals-for-equals to prove T1=T1', T2=T2'.
+;; 2. Use commute-equal to prove T1'=T1, T2'=T2.
+;; 3. Use the equality axiom to prove T1=T1' -> T2=T2' -> T1=T2' -> T1'=T2'
+;; 4. Use the equality axiom to prove T1'=T1 -> T2'=T2 -> T1'=T2' -> T1=T2
+;;
+;; Now, our goal T1=T2 <-> T1'=T2' is a tautological consequence of the
+;; formulas produced in steps 1-4.
+;;
+;; We can "test this out" on some example formulas as below.  You can run
+;; this example to see that we do indeed have a tautological consequence.
+;;
+;; (tautological-consequencep
+;;  (logic.piff (logic.pequal 'T1 'T2)
+;;        (logic.pequal 'T1-Prime 'T2-Prime))
+;;  (logic.strip-conclusions
+;;   (list
+;;    (build.axiom (logic.pequal 'T1 'T1-Prime))
+;;    (build.axiom (logic.pequal 'T2 'T2-Prime))
+;;    (build.axiom (logic.pequal 'T1-Prime 'T1))
+;;    (build.axiom (logic.pequal 'T2-Prime 'T2))
+;;    (build.equality 'T1 'T1-Prime 'T2 'T2-Prime)
+;;    (build.equality 'T1-Prime 'T1 'T2-Prime 'T2))))
+;;
+;; But what we need to do is show this for arbitrary T1,T2,T1',T2' instead
+;; of just for the above examples.
+
+(encapsulate
+ ()
+
+;; BOZO i still don't like how we use logic.=lhs and logic.=rhs explicitly here.  i'd
+;; rather it used explicit variables instead.
+
+ (local (defthm lemma
+          (implies (and (force (logic.formulap x))
+                        (force (logic.formulap y))
+                        (force (equal (logic.fmtype x) 'pequal*))
+                        (force (equal (logic.fmtype y) 'pequal*)))
+                   (tautological-consequencep
+                    (logic.piff x y)
+                    (list (logic.pequal (logic.=lhs x) (logic.=lhs y))
+                          (logic.pequal (logic.=rhs x) (logic.=rhs y))
+                          (logic.pequal (logic.=lhs y) (logic.=lhs x))
+                          (logic.pequal (logic.=rhs y) (logic.=rhs x))
+                          (logic.por (logic.pnot (logic.pequal (logic.=lhs x) (logic.=lhs y)))
+                               (logic.por (logic.pnot (logic.pequal (logic.=rhs x) (logic.=rhs y)))
+                                    (logic.por (logic.pnot x) y)))
+                          (logic.por (logic.pnot (logic.pequal (logic.=lhs y) (logic.=lhs x)))
+                               (logic.por (logic.pnot (logic.pequal (logic.=rhs y) (logic.=rhs x)))
+                                    (logic.por (logic.pnot y) x))))))
+          :hints(("Goal" :in-theory (e/d (tautological-consequencep)
+                                         ;; This is a yucky looking hint, but
+                                         ;; it's just for speed.
+                                         (in-superset-when-in-subset-two
+                                          in-superset-when-in-subset-one
+                                          not-in-subset-when-not-in-superset-one
+                                          not-in-subset-when-not-in-superset-two
+                                          memberp-when-memberp-of-cdr
+                                          memberp-when-not-consp
+                                          subsetp-when-not-consp-two
+                                          subsetp-of-cdr
+                                          subsetp-when-not-consp))))))
+
+
+ (local (defthm lemma2
+          (implies (and (logic.formulap x)
+                        (logic.formulap y)
+                        (logic.appeal-listp as)
+                        (equal-substitutiblep x y (logic.strip-conclusions as)))
+                   (and (logic.appealp (equal-substitutible-bldr x y as))
+                        (equal (logic.conclusion (equal-substitutible-bldr x y as))
+                               (logic.piff x y))))
+          :hints(("Goal" :in-theory (enable equal-substitutible-bldr)))))
+
+ (defthm forcing-logic.appealp-of-equal-substitutible-bldr
+   (implies (and (force (logic.formulap x))
+                 (force (logic.formulap y))
+                 (force (logic.appeal-listp as))
+                 (force (equal-substitutiblep x y (logic.strip-conclusions as))))
+            (logic.appealp (equal-substitutible-bldr x y as))))
+
+ (defthm forcing-logic.conclusion-of-equal-substitutible-bldr
+   (implies (and (force (logic.formulap x))
+                 (force (logic.formulap y))
+                 (force (logic.appeal-listp as))
+                 (force (equal-substitutiblep x y (logic.strip-conclusions as))))
+            (equal (logic.conclusion (equal-substitutible-bldr x y as))
+                   (logic.piff x y)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (verify-guards equal-substitutible-bldr)
+
+ (defthm forcing-logic.proofp-of-equal-substitutible-bldr
+   (implies (and (force (logic.formulap x))
+                 (force (logic.formulap y))
+                 (force (logic.appeal-listp as))
+                 (force (equal-substitutiblep x y (logic.strip-conclusions as)))
+                 ;; ---
+                 (force (logic.formula-atblp x atbl))
+                 (force (logic.formula-atblp y atbl))
+                 (force (logic.proof-listp as axioms thms atbl))
+                 (force (memberp (axiom-reflexivity) axioms))
+                 (force (memberp (axiom-equality) axioms))
+                 (force (memberp (theorem-transitivity-of-pequal) thms))
+                 (force (memberp (theorem-commutativity-of-pequal) thms)))
+            (logic.proofp (equal-substitutible-bldr x y as) axioms thms atbl))
+   :hints(("Goal" :in-theory (enable equal-substitutible-bldr)))))
+
+
+
+;; As with the tautology and equivalence theorems, the equality theorem is
+;; perhaps most often useful in the form below.  Suppose that G is a formula
+;; which is obtained from F by equality substitution of A1=A1' ... An=An'.
+;; Then, if we have proofs of A1=A1' ... An=An' and F, we should be able to
+;; prove G.  This is the equal-consequence-bldr.
+
+(defund equal-consequence-bldr (g f as)
+  (declare (xargs :guard (and (logic.formulap g)
+                              (logic.appealp f)
+                              (logic.appeal-listp as)
+                              (equal-substitutiblep
+                               (logic.conclusion f) g (logic.strip-conclusions as)))
+                  :verify-guards nil))
+  (let ((iff-f-g (equal-substitutible-bldr (logic.conclusion f) g as)))
+    (tautological-consequence-bldr g (list iff-f-g f))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (logic.formulap f)
+                        (logic.formulap g))
+                   (tautological-consequencep g (list (logic.piff f g) f)))
+          :hints(("Goal" :in-theory (enable tautological-consequencep)))))
+
+ (verify-guards equal-consequence-bldr)
+
+ (defthm forcing-logic.conclusion-of-equal-consequence-bldr
+   (implies (and (force (logic.formulap g))
+                 (force (logic.appealp f))
+                 (force (logic.appeal-listp as))
+                 (force (equal-substitutiblep (logic.conclusion f) g (logic.strip-conclusions as))))
+            (equal (logic.conclusion (equal-consequence-bldr g f as))
+                   g))
+   :hints(("Goal" :in-theory (enable equal-consequence-bldr))))
+
+ (defthm forcing-logic.appealp-of-equal-consequence-bldr
+   (implies (and (force (logic.formulap g))
+                 (force (logic.appealp f))
+                 (force (logic.appeal-listp as))
+                 (force (equal-substitutiblep (logic.conclusion f) g (logic.strip-conclusions as))))
+            (logic.appealp (equal-consequence-bldr g f as)))
+   :hints(("Goal" :in-theory (enable equal-consequence-bldr))))
+
+ (defthm forcing-logic.proofp-of-equal-consequence-bldr
+   (implies (and (force (logic.formulap g))
+                 (force (logic.appealp f))
+                 (force (logic.appeal-listp as))
+                 (force (equal-substitutiblep (logic.conclusion f) g (logic.strip-conclusions as)))
+                 ;; ---
+                 (force (logic.formula-atblp g atbl))
+                 (force (logic.proofp f axioms thms atbl))
+                 (force (logic.proof-listp as axioms thms atbl))
+                 (force (memberp (axiom-reflexivity) axioms))
+                 (force (memberp (axiom-equality) axioms))
+                 (force (memberp (theorem-transitivity-of-pequal) thms))
+                 (force (memberp (theorem-commutativity-of-pequal) thms)))
+            (logic.proofp (equal-consequence-bldr g f as) axioms thms atbl))
+   :hints(("Goal" :in-theory (enable equal-consequence-bldr)))))
+
+
+
+
+
+(defthm forcing-equal-substitutiblep-of-logic.pors
+  (implies (and (force (logic.formulap a))
+                (force (logic.formulap b))
+                (force (logic.formulap c))
+                (force (logic.formulap d)))
+           (equal (equal-substitutiblep (logic.por a b) (logic.por c d) proofs)
+                  (and (equal-substitutiblep a c proofs)
+                       (equal-substitutiblep b d proofs))))
+  :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm forcing-equal-substitutiblep-of-logic.pnots
+  (implies (and (force (logic.formulap a))
+                (force (logic.formulap b)))
+           (equal (equal-substitutiblep (logic.pnot a) (logic.pnot b) proofs)
+                  (equal-substitutiblep a b proofs)))
+  :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm forcing-equal-substitutiblep-of-pequals
+  (implies (and (force (logic.termp a))
+                (force (logic.termp b))
+                (force (logic.termp c))
+                (force (logic.termp d)))
+           (equal (equal-substitutiblep (logic.pequal a b) (logic.pequal c d) proofs)
+                  (and (equal-substitutible-logic.termp a c proofs)
+                       (equal-substitutible-logic.termp b d proofs))))
+  :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm reflexivity-of-equal-substitutible-logic.termp
+  (equal-substitutible-logic.termp x x proofs)
+  :hints(("Goal" :in-theory (enable equal-substitutible-logic.termp))))
+
+(defthm reflexivity-of-equal-substitutiblep
+  (implies (force (logic.formulap x))
+           (equal-substitutiblep x x proofs))
+  :hints(("Goal" :in-theory (enable equal-substitutiblep))))
+
+(defthm equal-substitutible-logic.termp-of-lhs-and-rhs-when-in-proofs
+  (implies (and (memberp proof proofs)
+                (force (logic.formulap proof))
+                ;; jcd:2006-04-05 added this hyp
+                (force (equal (logic.fmtype proof) 'pequal*)))
+           (equal-substitutible-logic.termp (logic.=lhs proof) (logic.=rhs proof) proofs))
+  :hints(("Goal" :in-theory (enable equal-substitutible-logic.termp))))
+
+(defthm forcing-equal-substitutible-logic.termp-of-logic.functions
+  (implies (and (force (logic.function-namep fn))
+                (force (true-listp args1))
+                (force (logic.term-listp args1))
+                (force (true-listp args2))
+                (force (logic.term-listp args2)))
+           (equal (equal-substitutible-logic.termp (logic.function fn args1)
+                                             (logic.function fn args2)
+                                             proofs)
+                  (or (equal args1 args2)
+                      (memberp (logic.pequal (logic.function fn args1)
+                                       (logic.function fn args2))
+                               proofs)
+                      (memberp (logic.pequal (logic.function fn args2)
+                                       (logic.function fn args1))
+                               proofs)
+                      (equal-substitutible-logic.term-listp args1 args2 proofs))))
+  :hints(("Goal" :in-theory (enable equal-substitutible-logic.termp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/classic/iff-substitution.lisp acl2-6.3/books/milawa/ACL2/classic/iff-substitution.lisp
--- acl2-6.2/books/milawa/ACL2/classic/iff-substitution.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/classic/iff-substitution.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,377 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../build/prop")
+(include-book "../build/conjunctions")
+(include-book "../logic/find-proof")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; In this file, we extend our proof checker with an equivalence checking
+;; extension.  This extension is based on the equivalence theorem, below:
+;;
+;;   The Equivalence Theorem.
+;;   (From Shoenfield's Mathematical Logic; Page 34)
+;;
+;;   Let G be obtained from F by replacing some occurrences of A1,...,An by
+;;   A1',...,An', respectively.  If
+;;    |- A1 <-> A1', |- A2 <-> A2', ..., |- An <-> An',
+;;   then
+;;    |- F <-> G.
+;;
+;; Our work is again very similar to Shankar's work in formalizing Godel's
+;; incompleteness theorem in NQTHM.
+
+
+
+;; We begin formalizing the equivalence theorem using the function
+;; equivalent-underp below, which takes as inputs:
+;;
+;;   - two formulas, f and g
+;;   - a list of equivalences, [A1 <-> A1', A2 <-> A2', ..., An <-> An']
+;;
+;; The equivalent-underp function returns true if g can be obtained by
+;; replacing some occurrences of A1, ..., An with A1', ..., An'.
+;;
+;; Note: This is like Shankar's function, "eqn-form"
+
+(defund iff-substitutiblep (f g as)
+  (declare (xargs :guard (and (logic.formulap f)
+                              (logic.formulap g)
+                              (logic.formula-listp as))))
+  (cond ((equal f g) t)
+        ((memberp (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                             (logic.pnot (logic.por (logic.pnot g) f))))
+                  as)
+         t)
+        ((equal (logic.fmtype f) 'pnot*)
+         (if (equal (logic.fmtype g) 'pnot*)
+             (iff-substitutiblep (logic.~arg f) (logic.~arg g) as)
+           nil))
+        ((equal (logic.fmtype f) 'por*)
+         (if (equal (logic.fmtype g) 'por*)
+             (and (iff-substitutiblep (logic.vlhs f) (logic.vlhs g) as)
+                  (iff-substitutiblep (logic.vrhs f) (logic.vrhs g) as))
+           nil))
+        (t nil)))
+
+(defthm booleanp-of-iff-substitutiblep
+  (equal (booleanp (iff-substitutiblep f g as))
+         t)
+  :hints(("Goal" :in-theory (e/d (iff-substitutiblep)
+                                 (logic.fmtype-normalizer-cheap
+                                  aggressive-equal-of-logic.pnots
+                                  aggressive-equal-of-logic.pors)))))
+
+
+
+
+
+;; Historical Performance Notes
+;;
+;; Each of the branches below, except for the one where we just use find-proof,
+;; are tautologies or tautological consequences of the recursively proven
+;; formulas.  And, originally, I used the tautology builder directly in order
+;; to construct the proofs, just as Shankar had done in his function.
+;;
+;; This is fine for proving that iff substitution is sound.  But in the
+;; bootstrapping process, we actually care about proof size, and the tautology
+;; builder builds remarkably long proofs.  So, now I use several "by hand"
+;; derivations below, instead of calling upon the tautology builder.  This
+;; results in a massive improvement.
+;;
+;; We did some test cases below.
+;;
+;; (defconst *F* (logic.pequal 'A1 'A1))
+;; (defconst *G* (logic.pequal 'A2 'A2))
+;; (defconst *H* (logic.pequal 'B1 'B1))
+;; (defconst *I* (logic.pequal 'B2 'B2))
+;;
+;; Test1: (iff-substitutible-bldr *F* *F* nil)
+;; Test2: (iff-substitutible-bldr
+;;         (logic.pnot *F*)
+;;         (logic.pnot *G*)
+;;         (list (build.axiom (logic.piff *F* *G*))))
+;;
+;; Test3: (iff-substitutible-bldr
+;;         (logic.por *F* *G*)
+;;         (logic.por *H* *I*)
+;;         (list (build.axiom (logic.piff *F* *H*))
+;;               (build.axiom (logic.piff *G* *I*))))
+;;
+;; Here are the size results:
+;;
+;; Test    Rank w/Tautologies     Rank by Hand     Savings
+;; Test1   1,780                  1,106            37.9%
+;; Test2   60,291                 2,511            95.8%
+;; Test3   1,122,354              5,294            99.5%
+;;
+;; BOZO we can probably do even better by building the proofs separately with
+;; some kind of aux builder, then conjoining them in the end.
+
+(defund iff-substitutible-bldr (f g as)
+  (declare (xargs :guard (and (logic.formulap f)
+                              (logic.formulap g)
+                              (logic.appeal-listp as)
+                              (iff-substitutiblep f g (logic.strip-conclusions as)))
+                  :verify-guards nil))
+  (cond ((equal f g)
+         ;; Here F = G, so F <-> F is a tautology.  Originally, I used the
+         ;; tautology builder here, but now I prefer this shorter derivation:
+         ;;
+         ;; Derivation.  (Cost: 18)
+         ;;
+         ;;   1. F -> F      Propositional Schema
+         ;;   2. F <-> F     Conjoin; 1,1
+         ;;
+         ;; Q.E.D.
+         (let ((lemma (build.propositional-schema f)))
+           (build.conjoin lemma lemma)))
+        ((memberp (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                                         (logic.pnot (logic.por (logic.pnot g) f))))
+                  (logic.strip-conclusions as))
+         ;; Here F <-> G happens to be a proof given to us in the list of
+         ;; proofs.  Just find that proof and return it.
+         (logic.find-proof (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                                                  (logic.pnot (logic.por (logic.pnot g) f))))
+                           as))
+        ((equal (logic.fmtype f) 'pnot*)
+         ;; Here we have F = ~A1 and G = ~A2.  Originally, I proved A1 <-> A2
+         ;; recursively, and then as a tautological consequence concluded that
+         ;; F <-> G.  Now, I use the derivation below, which creates much
+         ;; shorter proofs:
+         ;;
+         ;; Derivation.  (Cost: 35 + 2x)
+         ;;
+         ;;  1. A1 <-> A2         (Given; constructed recursively)
+         ;;  2. ~A2 v A1          Second Conjunct; 1
+         ;;  3. A1 v ~A2          Commute Or
+         ;;  4. ~~A1 v ~A2        LHS Insert ~~
+         ;;  5. ~A1 v A2          First Conjunct; 1
+         ;;  6. A2 v ~A1          Commute Or
+         ;;  7. ~~A2 v ~A1        LHS Insert ~~
+         ;;  8. F <-> G           Conjoin; 4,7
+         ;;
+         ;; Q.E.D.
+         (let ((lemma (iff-substitutible-bldr (logic.~arg f) (logic.~arg g) as)))
+           (build.conjoin
+            (build.lhs-insert-neg-neg (build.commute-or (build.second-conjunct lemma)))
+            (build.lhs-insert-neg-neg (build.commute-or (build.first-conjunct lemma))))))
+        ((equal (logic.fmtype f) 'por*)
+         ;; Here we have F = A1 v B1 and G = A2 v B2.  Originally, I proved
+         ;; A1 <-> A2 and B1 <-> B2, recursively, and then as a tautological
+         ;; consequence concluded that F <-> G.  Now, I use the derivation
+         ;; below, which creates much shorter proofs:
+         ;;
+         ;; Derivation.  (Cost: 119 + 2x + 2y)
+         ;;
+         ;;   1. A1 <-> A2               (Given; constructed recursively)
+         ;;   2. B1 <-> B2               (Given; constructed recursively)
+         ;;
+         ;;   3. ~A1 v A2                1st Conjunct; 1
+         ;;   4. ~A1 v (A2 v B2)         DJ Right Expansion
+         ;;   5. ~B1 v B2                1st Conjunct; 2
+         ;;   6. ~B1 v (A2 v B2)         DJ Left Expansion
+         ;;   7. ~(A1 v B1) v (A2 v B2)  Merge Implications; 4,6
+         ;;
+         ;;   8. ~A2 v A1                2nd Conjunct; 1
+         ;;   9. ~A2 v (A1 v B1)         DJ Right Expansion
+         ;;  10. ~B2 v B1                2nd Conjunct; 2
+         ;;  11. ~B2 v (A1 v B1)         DJ Left Expansion
+         ;;  12. ~(A2 v B2) v (A1 v B1)  Merge Implications; 9,11
+         ;;  13. F <-> G                 Conjoin; 7,12
+         ;;
+         ;; Q.E.D.
+         (let ((lemma1 (iff-substitutible-bldr (logic.vlhs f) (logic.vlhs g) as))
+               (lemma2 (iff-substitutible-bldr (logic.vrhs f) (logic.vrhs g) as)))
+           (build.conjoin
+            (build.merge-implications
+             (build.disjoined-right-expansion (build.first-conjunct lemma1) (logic.vrhs g))
+             (build.disjoined-left-expansion (build.first-conjunct lemma2) (logic.vlhs g)))
+            (build.merge-implications
+             (build.disjoined-right-expansion (build.second-conjunct lemma1) (logic.vrhs f))
+             (build.disjoined-left-expansion (build.second-conjunct lemma2) (logic.vlhs f))))))
+        (t nil)))
+
+
+(defthm logic.fmtype-of-g-when-iff-substitutible-for-logic.pnot
+  (implies (and (iff-substitutiblep f g as)
+                (not (memberp (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                                                     (logic.pnot (logic.por (logic.pnot g) f))))
+                              as))
+                (equal (logic.fmtype f) 'pnot*))
+           (equal (logic.fmtype g) 'pnot*))
+  :hints(("Goal" :in-theory (enable iff-substitutiblep))))
+
+(defthm logic.fmtype-of-g-when-iff-substitutible-for-logic.por
+  (implies (and (iff-substitutiblep f g as)
+                (not (memberp (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                                                     (logic.pnot (logic.por (logic.pnot g) f))))
+                              as))
+                (force (equal (logic.fmtype f) 'por*)))
+           (equal (logic.fmtype g) 'por*))
+  :hints(("Goal" :in-theory (enable iff-substitutiblep))))
+
+(defthm forcing-iff-substitutiblep-of-logic.vlhs
+  (implies (and (iff-substitutiblep f g as)
+                (not (memberp (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                                                     (logic.pnot (logic.por (logic.pnot g) f))))
+                              as))
+                (force (equal (logic.fmtype f) 'por*)))
+           (iff-substitutiblep (logic.vlhs f) (logic.vlhs g) as))
+  :hints(("Goal" :in-theory (enable iff-substitutiblep))))
+
+(defthm forcing-iff-substitutiblep-of-logic.vrhs
+  (implies (and (iff-substitutiblep f g as)
+                (not (memberp (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                                                     (logic.pnot (logic.por (logic.pnot g) f))))
+                              as))
+                (force (equal (logic.fmtype f) 'por*)))
+           (iff-substitutiblep (logic.vrhs f) (logic.vrhs g) as))
+  :hints(("Goal" :in-theory (enable iff-substitutiblep))))
+
+(defthm forcing-iff-substitutiblep-of-logic.~arg
+  (implies (and (iff-substitutiblep f g as)
+                (not (memberp (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                                                     (logic.pnot (logic.por (logic.pnot g) f))))
+                              as))
+                (force (equal (logic.fmtype f) 'pnot*)))
+           (iff-substitutiblep (logic.~arg f) (logic.~arg g) as))
+  :hints(("Goal" :in-theory (enable iff-substitutiblep))))
+
+(encapsulate
+ ()
+ (local (defthm main-lemma
+          (implies (and (logic.formulap f)
+                        (logic.formulap g)
+                        (logic.appeal-listp as)
+                        (iff-substitutiblep f g (logic.strip-conclusions as)))
+                   (and (logic.appealp (iff-substitutible-bldr f g as))
+                        (equal (logic.conclusion (iff-substitutible-bldr f g as))
+                               (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                                          (logic.pnot (logic.por (logic.pnot g) f)))))))
+          :hints(("Goal" :in-theory (enable iff-substitutible-bldr iff-substitutiblep)))))
+
+(defthm forcing-logic.appealp-of-iff-substitutible-bldr
+   (implies (and (force (logic.formulap f))
+                 (force (logic.formulap g))
+                 (force (logic.appeal-listp as))
+                 (force (iff-substitutiblep f g (logic.strip-conclusions as))))
+            (equal (logic.appealp (iff-substitutible-bldr f g as))
+                   t)))
+
+(defthm forcing-logic.conclusion-of-iff-substitutible-bldr
+   (implies (and (force (logic.formulap f))
+                 (force (logic.formulap g))
+                 (force (logic.appeal-listp as))
+                 (force (iff-substitutiblep f g (logic.strip-conclusions as))))
+            (equal (logic.conclusion (iff-substitutible-bldr f g as))
+                   (logic.pnot (logic.por (logic.pnot (logic.por (logic.pnot f) g))
+                              (logic.pnot (logic.por (logic.pnot g) f))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(defthm forcing-logic.proofp-of-iff-substitutible-bldr
+  (implies (and (force (logic.formulap f))
+                (force (logic.formulap g))
+                (force (logic.appeal-listp as))
+                (force (iff-substitutiblep f g (logic.strip-conclusions as)))
+                ;; ---
+                (force (logic.formula-atblp f atbl))
+                (force (logic.formula-atblp g atbl))
+                (force (logic.proof-listp as axioms thms atbl)))
+           (logic.proofp (iff-substitutible-bldr f g as)
+                   axioms thms atbl))
+  :hints(("Goal" :in-theory (enable iff-substitutible-bldr
+                                    iff-substitutiblep))))
+
+(verify-guards iff-substitutible-bldr)
+
+
+
+;; Iff Consequences
+;; Derive G from proofs of F and A1 <-> A1', ..., An <-> An'
+;;   where G is iff-substitutible for F.
+;;
+;; Derivation.
+;;
+;;   1. F <-> G     Iff Substitution
+;;   2. F -> G      First Conjunct
+;;   3. F           Given
+;;   4. G           Modus Ponens; 3,2
+;;
+;; Q.E.D.
+
+(defun iff-consequence-bldr (g f as)
+  (declare (xargs :guard (and (logic.formulap g)
+                              (logic.appealp f)
+                              (logic.appeal-listp as)
+                              (iff-substitutiblep (logic.conclusion f) g (logic.strip-conclusions as)))))
+  (build.modus-ponens f (build.first-conjunct (iff-substitutible-bldr (logic.conclusion f) g as))))
+
+(defthm forcing-logic.appealp-of-iff-consequence-bldr
+  (implies (and (force (logic.formulap g))
+                (force (logic.appealp f))
+                (force (logic.appeal-listp as))
+                (force (iff-substitutiblep (logic.conclusion f) g (logic.strip-conclusions as))))
+           (equal (logic.appealp (iff-consequence-bldr g f as))
+                  t))
+  :hints(("Goal" :in-theory (enable iff-consequence-bldr))))
+
+(defthm forcing-logic.conclusion-of-iff-consequence-bldr
+  (implies (and (force (logic.formulap g))
+                (force (logic.appealp f))
+                (force (logic.appeal-listp as))
+                (force (iff-substitutiblep (logic.conclusion f) g (logic.strip-conclusions as))))
+           (equal (logic.conclusion (iff-consequence-bldr g f as))
+                  g))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable iff-consequence-bldr))))
+
+(defthm forcing-logic.proofp-of-iff-consequence-bldr
+  (implies (and (force (logic.formulap g))
+                (force (logic.appealp f))
+                (force (logic.appeal-listp as))
+                (force (iff-substitutiblep (logic.conclusion f) g (logic.strip-conclusions as)))
+                ;; ---
+                (force (logic.formula-atblp g atbl))
+                (force (logic.proofp f axioms thms atbl))
+                (force (logic.proof-listp as axioms thms atbl)))
+           (equal (logic.proofp (iff-consequence-bldr g f as) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable iff-consequence-bldr))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/classic/proof-alteration.lisp acl2-6.3/books/milawa/ACL2/classic/proof-alteration.lisp
--- acl2-6.2/books/milawa/ACL2/classic/proof-alteration.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/classic/proof-alteration.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,257 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../logic/proofp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; The deduction rule is unique (so far) in that it manipulates proofs which
+;; already exist, rather than building atop of other proofs.  This is not
+;; something that our usual theory is well set up to handle, so here we add
+;; many rules to assist with reasoning about already existing proofs.
+;;
+;; These rules are not something we normally want around, so we exile them to
+;; this file instead of integrating them into our system.  This file is then
+;; locally included whenever we want these sorts of rules available.
+
+(defthm logic.appeal-step-okp-when-axiom
+  (implies (equal (logic.method x) 'axiom)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.axiom-okp x axioms atbl)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-propositional-schema
+  (implies (equal (logic.method x) 'propositional-schema)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.propositional-schema-okp x atbl)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-functional-equality
+  (implies (equal (logic.method x) 'functional-equality)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.functional-equality-okp x atbl)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-expansion
+  (implies (equal (logic.method x) 'expansion)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.expansion-okp x atbl)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-contraction
+  (implies (equal (logic.method x) 'contraction)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.contraction-okp x)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-associativity
+  (implies (equal (logic.method x) 'associativity)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.associativity-okp x)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-cut
+  (implies (equal (logic.method x) 'cut)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.cut-okp x)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-instantiation
+  (implies (equal (logic.method x) 'instantiation)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.instantiation-okp x atbl)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-induction
+  (implies (equal (logic.method x) 'induction)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.induction-okp x)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-base-eval
+  (implies (equal (logic.method x) 'base-eval)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  (logic.base-eval-okp x atbl)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-logic.proofp
+  (implies (logic.proofp x axioms thms atbl)
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.proofp))))
+
+
+
+(defthm cons-structure-of-logic.subproofs-when-logic.cut-okp
+  (implies (logic.cut-okp x)
+           (and (logic.subproofs x)
+                (consp (logic.subproofs x))
+                (cdr (logic.subproofs x))
+                (consp (cdr (logic.subproofs x)))))
+  :hints(("Goal" :in-theory (enable logic.cut-okp))))
+
+(defthm cons-structure-of-logic.subproofs-when-logic.instantiation-okp
+  (implies (logic.instantiation-okp x atbl)
+           (and (logic.subproofs x)
+                (consp (logic.subproofs x))))
+  :hints(("Goal" :in-theory (e/d (logic.instantiation-okp)
+                                 (forcing-logic.appeal-listp-of-logic.subproofs)))))
+
+(defthm cons-structure-of-logic.subproofs-when-logic.expansion-okp
+  (implies (logic.expansion-okp x atbl)
+           (and (logic.subproofs x)
+                (consp (logic.subproofs x))))
+  :hints(("Goal" :in-theory (e/d (logic.expansion-okp)
+                                 (forcing-logic.appeal-listp-of-logic.subproofs)))))
+
+(defthm cons-structure-of-logic.subproofs-when-logic.contraction-okp
+  (implies (logic.contraction-okp x)
+           (and (logic.subproofs x)
+                (consp (logic.subproofs x))))
+  :hints(("Goal" :in-theory (enable logic.contraction-okp))))
+
+(defthm cons-structure-of-logic.subproofs-when-associativity
+  (implies (logic.associativity-okp x)
+           (and (logic.subproofs x)
+                (consp (logic.subproofs x))))
+  :hints(("Goal" :in-theory (enable logic.associativity-okp))))
+
+
+
+(defthm conclusion-when-logic.instantiation-okp
+  (implies (logic.instantiation-okp x atbl)
+           (equal (logic.conclusion x)
+                  (logic.substitute-formula (logic.conclusion (car (logic.subproofs x)))
+                                            (logic.extras x))))
+  :hints(("Goal" :in-theory (e/d (logic.instantiation-okp)
+                                 (forcing-true-listp-of-logic.subproofs
+                                  forcing-logic.appeal-listp-of-logic.subproofs)))))
+
+(defthm logic.sigmap-of-logic.extras-when-logic.instantiation-okp
+  (implies (logic.instantiation-okp x atbl)
+           (logic.sigmap (logic.extras x)))
+  :hints(("Goal" :in-theory (enable logic.instantiation-okp))))
+
+(defthm conclusion-when-logic.cut-okp
+  (implies (and (logic.cut-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.conclusion x)
+                  (logic.por (logic.vrhs (logic.conclusion (first (logic.subproofs x))))
+                             (logic.vrhs (logic.conclusion (second (logic.subproofs x)))))))
+  :hints(("Goal" :in-theory (enable logic.cut-okp))))
+
+(defthm logic.fmtype-of-logic.conclusion-of-first-subgoal-when-logic.cut-okp
+  (implies (and (logic.cut-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.fmtype (logic.conclusion (first (logic.subproofs x))))
+                  'por*))
+  :hints(("Goal" :in-theory (enable logic.cut-okp))))
+
+(defthm logic.fmtype-of-logic.conclusion-of-second-subgoal-when-logic.cut-okp
+  (implies (and (logic.cut-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.fmtype (logic.conclusion (second (logic.subproofs x))))
+                  'por*))
+  :hints(("Goal" :in-theory (enable logic.cut-okp))))
+
+(defthm logic.vlhs-of-logic.conclusion-of-second-subgoal-when-logic.cut-okp
+  (implies (and (logic.cut-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.vlhs (logic.conclusion (second (logic.subproofs x))))
+                  (logic.pnot (logic.vlhs (logic.conclusion (first (logic.subproofs x)))))))
+  :hints(("Goal" :in-theory (enable logic.cut-okp))))
+
+(defthm conclusion-when-logic.associativity-okp
+  (implies (and (logic.associativity-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.conclusion x)
+                  (logic.por (logic.por (logic.vlhs (logic.conclusion (first (logic.subproofs x))))
+                                        (logic.vlhs (logic.vrhs (logic.conclusion (first (logic.subproofs x))))))
+                             (logic.vrhs (logic.vrhs (logic.conclusion (first (logic.subproofs x))))))))
+  :hints(("Goal" :in-theory (enable logic.associativity-okp))))
+
+(defthm logic.fmtype-of-logic.conclusion-of-subgoal-when-logic.associativity-okp
+  (implies (and (logic.associativity-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.fmtype (logic.conclusion (first (logic.subproofs x))))
+                  'por*))
+  :hints(("Goal" :in-theory (enable logic.associativity-okp))))
+
+(defthm logic.fmtype-of-logic.vrhs-of-logic.conclusion-of-subgoal-when-logic.associativity-okp
+  (implies (and (logic.associativity-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.fmtype (logic.vrhs (logic.conclusion (first (logic.subproofs x)))))
+                  'por*))
+  :hints(("Goal" :in-theory (enable logic.associativity-okp))))
+
+
+(defthm conclusion-when-logic.contraction-okp
+  (implies (and (logic.contraction-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.conclusion x)
+                  (logic.vlhs (logic.conclusion (first (logic.subproofs x))))))
+  :hints(("Goal" :in-theory (enable logic.contraction-okp))))
+
+(defthm logic.vrhs-of-logic.conclusion-of-first-subgoal-when-logic.contraction-okp
+  (implies (and (logic.contraction-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.vrhs (logic.conclusion (first (logic.subproofs x))))
+                  (logic.vlhs (logic.conclusion (first (logic.subproofs x))))))
+  :hints(("Goal" :in-theory (enable logic.contraction-okp))))
+
+(defthm logic.fmtype-of-logic.conclusion-of-first-subgoal-when-logic.contraction-okp
+  (implies (and (logic.contraction-okp x)
+                (force (logic.appealp x)))
+           (equal (logic.fmtype (logic.conclusion (first (logic.subproofs x))))
+                  'por*))
+  :hints(("Goal" :in-theory (enable logic.contraction-okp))))
+
+
+(defthm logic.fmtype-of-logic.conclusion-when-logic.expansion-okp
+  (implies (and (logic.expansion-okp x atbl)
+                (force (logic.appealp x)))
+           (equal (logic.fmtype (logic.conclusion x))
+                  'por*))
+  :hints(("Goal" :in-theory (enable logic.expansion-okp))))
+
+(defthm logic.vrhs-of-logic.conclusion-when-logic.expansion-okp
+  (implies (and (logic.expansion-okp x atbl)
+                (force (logic.appealp x)))
+           (equal (logic.vrhs (logic.conclusion x))
+                  (logic.conclusion (first (logic.subproofs x)))))
+  :hints(("Goal" :in-theory (enable logic.expansion-okp))))
diff -Nru acl2-6.2/books/milawa/ACL2/classic/tautologies.lisp acl2-6.3/books/milawa/ACL2/classic/tautologies.lisp
--- acl2-6.2/books/milawa/ACL2/classic/tautologies.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/classic/tautologies.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1467 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../logic/formula-size")
+(include-book "../logic/piff")  ;; Yuck!
+(include-book "../build/disjoined-subset")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; This is a port of Shankar's tautology checker from his work formalizing
+;; Godel's incompleteness theorem in NQTHM, which in turn was based on
+;; Shoenfield's proof of the tautology theorem.
+;;
+;;  - We introduce a tautology checker (see tautologyp1/tautologyp) that
+;;    operates on formulas, returning t if the formula is a tautology and nil
+;;    otherwise.
+;;
+;;  - We show that whenever tautologyp accepts a formula, its truth value is
+;;    true for every truth valuation
+;;
+;;  - We show that whenever tautologyp rejects a formula, there is some truth
+;;    valuation which makes that formula's truth value false.
+;;
+;;  - We introduce a tautology builder (see tautology-bldr1/tautology-bldr)
+;;    which can construct a proof of an arbitrary tautology, and show that it
+;;    does in fact construct a proof for any formula that our tautologyp
+;;    function accepts.
+;;
+;;
+;; We adopt Shoenfield's definition of tautologies: a tautology is a formula
+;; whose truth value is true under every possible truth valuation.
+;;
+;; Definition.  A truth valuation is a mapping from every atomic formula
+;; (formulas of the form t1 = t2) to truth values (true or false).  Given a
+;; truth valuation V, we assign a truth value to each formula as follows:
+;;
+;;    1. Val(t1 = t2) is true iff Val maps t1=t2 to true
+;;    2. Val(~F) is not(Val(F))
+;;    3. Val(F v G) is or(Val(F),Val(G))
+;;
+;; We represent truth valuations as simple lists of atomic formulas.  We assign
+;; true to formulas in the list, and false to formulas not in the list.
+;;
+;; Why is this a legitimate representation?  After all, we said that a truth
+;; valuation maps *every* atomic formula to true or false.  But surely there
+;; are infinitely many atomic formulas, and yet our lists are finite.  Haven't
+;; we failed to cover those truth valuations which map all formulas to true, or
+;; even those which simply map some infinite number of formulas to true?
+;;
+;; Although we cannot represent such valuations as lists, we really don't need
+;; to do so if our goal is only to determine if a formula is a tautology or
+;; not.  After all, any formula is itself finite, and hence contains at most
+;; some finite number of atomic formulas.  Hence, to determine if a formula F
+;; is a tautology or not, we only need to consider the bindings of the atomic
+;; formulas within F, all of which can be represented finitely.
+;;
+;; We begin by introducing the function truth-value below, which evaluates a
+;; formula with respect to a truth valuation.
+
+(defund truth-value (f valuation)
+  (declare (xargs :guard (logic.formulap f)))
+  (cond ((equal (logic.fmtype f) 'por*)
+         (or (truth-value (logic.vlhs f) valuation)
+             (truth-value (logic.vrhs f) valuation)))
+        ((equal (logic.fmtype f) 'pnot*)
+         (not (truth-value (logic.~arg f) valuation)))
+        ((equal (logic.fmtype f) 'pequal*)
+         (memberp f valuation))
+        (t nil)))
+
+(defthm booleanp-of-truth-value
+  (equal (booleanp (truth-value f valuation))
+         t)
+  :hints(("Goal" :in-theory (e/d (truth-value)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm truth-value-of-list-fix
+  (equal (truth-value f (list-fix valuation))
+         (truth-value f valuation))
+  :hints(("Goal" :in-theory (e/d (truth-value)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm truth-value-when-logic.por
+  (implies (equal (logic.fmtype f) 'por*)
+           (equal (truth-value f valuation)
+                  (or (truth-value (logic.vlhs f) valuation)
+                      (truth-value (logic.vrhs f) valuation))))
+  :hints(("Goal" :in-theory (enable truth-value))))
+
+(defthm truth-value-when-logic.pnot
+  (implies (equal (logic.fmtype f) 'pnot*)
+           (equal (truth-value f valuation)
+                  (not (truth-value (logic.~arg f) valuation))))
+  :hints(("Goal" :in-theory (enable truth-value))))
+
+(defthm truth-value-when-pequal
+  (implies (equal (logic.fmtype f) 'pequal*)
+           (equal (truth-value f valuation)
+                  (memberp f valuation)))
+  :hints(("Goal" :in-theory (enable truth-value))))
+
+(defthm truth-value-when-degenerate
+  (implies (and (not (equal (logic.fmtype f) 'por*))
+                (not (equal (logic.fmtype f) 'pnot*))
+                (not (equal (logic.fmtype f) 'pequal*)))
+           (equal (truth-value f valuation)
+                  nil))
+  :hints(("Goal" :in-theory (e/d (truth-value)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm forcing-truth-value-of-logic.por
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (truth-value (logic.por x y) valuation)
+                  (or (truth-value x valuation)
+                      (truth-value y valuation))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm forcing-truth-value-of-logic.pnot
+  (implies (force (logic.formulap x))
+           (equal (truth-value (logic.pnot x) valuation)
+                  (not (truth-value x valuation))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm forcing-truth-value-of-pequal
+  (implies (and (force (logic.termp x))
+                (force (logic.termp y)))
+           (equal (truth-value (logic.pequal x y) valuation)
+                  (memberp (logic.pequal x y) valuation)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm forcing-truth-value-of-logic.pand
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (truth-value (logic.pand x y) valuation)
+                  (and (truth-value x valuation)
+                       (truth-value y valuation))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.pand))))
+
+(defthm forcing-truth-value-of-logic.piff
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (truth-value (logic.piff x y) valuation)
+                  (iff (truth-value x valuation)
+                       (truth-value y valuation))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.piff))))
+
+
+(deftheory slow-truth-value-theory
+  '(truth-value-when-logic.por
+    truth-value-when-logic.pnot
+    truth-value-when-pequal
+    truth-value-when-degenerate))
+
+(in-theory (disable slow-truth-value-theory))
+
+
+
+
+;; Suppose we want to reason about the truth value of logic.disjoin-formulas
+;; under some valuation.  Then the value will be true iff one of the formulas
+;; we are about to disjoin happens to be true under the valuation.  The
+;; function find-positive searches for a formula that has a true truth-value
+;; under a valuation, returning the first such formula found, or nil if no such
+;; formula exists.
+
+(defund find-positive (x valuation)
+  (declare (xargs :guard (logic.formula-listp x)))
+  (if (consp x)
+      (if (truth-value (car x) valuation)
+          (car x)
+        (find-positive (cdr x) valuation))
+    nil))
+
+(defthm find-positive-when-not-consp
+  (implies (not (consp x))
+           (equal (find-positive x valuation)
+                  nil))
+  :hints(("Goal" :in-theory (enable find-positive))))
+
+(defthm find-positive-of-cons
+  (equal (find-positive (cons a x) valuation)
+         (if (truth-value a valuation)
+             a
+           (find-positive x valuation)))
+  :hints(("Goal" :in-theory (enable find-positive))))
+
+(defthm find-positive-of-list-fix-one
+  (equal (find-positive (list-fix x) valuation)
+         (find-positive x valuation))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-positive-of-list-fix-two
+  (equal (find-positive x (list-fix valuation))
+         (find-positive x valuation))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-positive-of-app
+  (equal (find-positive (app x y) valuation)
+         (or (find-positive x valuation)
+             (find-positive y valuation)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable slow-truth-value-theory))))
+
+(defthm find-positive-when-memberp-with-true-value
+  (implies (and (memberp a x)
+                (truth-value a valuation))
+           (iff (find-positive x valuation)
+                t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable slow-truth-value-theory))))
+
+(defthm memberp-of-find-positive-when-find-positive
+  (implies (find-positive x valuation)
+           (equal (memberp (find-positive x valuation) x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm truth-value-of-find-positive-when-find-positive
+  (implies (find-positive x valuation)
+           (equal (truth-value (find-positive x valuation) valuation)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-positive-when-subsetp
+  (implies (and (find-positive x valuation)
+                (subsetp x y))
+           (iff (find-positive y valuation)
+                t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-positive-when-find-positive-of-cdr
+  (implies (find-positive (cdr x) valuation)
+           (find-positive x valuation)))
+
+(defthm find-positive-when-not-find-positive-of-cdr
+  (implies (not (find-positive (cdr x) valuation))
+           (equal (find-positive x valuation)
+                  (if (truth-value (car x) valuation)
+                      (car x)
+                    nil))))
+
+(defthm find-positive-when-complementary-members
+  (implies (and (memberp (logic.pnot a) x)
+                (memberp a x)
+                (logic.formula-listp x))
+           (iff (find-positive x valuation)
+                t))
+  :hints(("Goal" :cases ((truth-value a valuation)))))
+
+(defthm find-positive-when-complementary-members-alt
+  (implies (and (memberp (logic.~arg a) x)
+                (memberp a x)
+                (equal (logic.fmtype a) 'pnot*)
+                (logic.formula-listp x))
+           (iff (find-positive x valuation)
+                t))
+  :hints(("Goal"
+          :in-theory (enable slow-truth-value-theory)
+          :cases ((truth-value a valuation)))))
+
+(defthm find-positive-when-complementary-members-app-one
+  (implies (and (memberp (logic.pnot a) x)
+                (memberp a (app x y))
+                (logic.formula-listp x)
+                (logic.formula-listp y))
+           (iff (find-positive (app x y) valuation)
+                t))
+  :hints(("Goal"
+          :in-theory (disable find-positive-when-complementary-members)
+          :use ((:instance find-positive-when-complementary-members
+                           (x (app x y)))))))
+
+(defthm find-positive-when-complementary-members-app-two
+  (implies (and (memberp (logic.pnot a) y)
+                (memberp a (app x y))
+                (logic.formula-listp x)
+                (logic.formula-listp y))
+           (iff (find-positive (app x y) valuation)
+                t))
+  :hints(("Goal"
+          :in-theory (disable find-positive-when-complementary-members)
+          :use ((:instance find-positive-when-complementary-members
+                           (x (app x y)))))))
+
+(defthm find-positive-when-complementary-members-app-alt-one
+  (implies (and (memberp (logic.~arg a) x)
+                (memberp a (app x y))
+                (equal (logic.fmtype a) 'pnot*)
+                (logic.formula-listp x)
+                (logic.formula-listp y))
+           (iff (find-positive (app x y) valuation)
+                t))
+  :hints(("Goal"
+          :in-theory (disable find-positive-when-complementary-members-alt)
+          :use ((:instance find-positive-when-complementary-members-alt
+                           (x (app x y)))))))
+
+(defthm find-positive-when-complementary-members-app-alt-two
+  (implies (and (memberp (logic.~arg a) y)
+                (memberp a (app x y))
+                (equal (logic.fmtype a) 'pnot*)
+                (logic.formula-listp x)
+                (logic.formula-listp y))
+           (iff (find-positive (app x y) valuation)
+                t))
+  :hints(("Goal"
+          :in-theory (disable find-positive-when-complementary-members-alt)
+          :use ((:instance find-positive-when-complementary-members-alt
+                           (x (app x y)))))))
+
+(defthm forcing-truth-valuation-of-disjoin-formula-under-iff
+  (implies (force (logic.formula-listp x))
+           (iff (truth-value (logic.disjoin-formulas x) valuation)
+                (find-positive x valuation)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable slow-truth-value-theory logic.disjoin-formulas))))
+
+
+
+
+
+
+;; "Basic formulas" play a particularly important role in our tautology
+;; checker.  And, for guards and for certain theorems, we need to be able to
+;; talk about lists of basic formulas.  (Shoenfield calls these "lists of
+;; elementary formulas and their negations").  We now introduce the function
+;; basic-logic.formula-listp, which checks to see if every formula in a list is
+;; basic.
+
+;; BOZO my god this is crying out for deflist.
+
+(defund basic-logic.formula-listp (x)
+  (declare (xargs :guard (logic.formula-listp x)))
+  (if (consp x)
+      (and (or (equal (logic.fmtype (car x)) 'pequal*)
+               (and (equal (logic.fmtype (car x)) 'pnot*)
+                    (equal (logic.fmtype (logic.~arg (car x))) 'pequal*)))
+           (basic-logic.formula-listp (cdr x)))
+    t))
+
+(defthm basic-logic.formula-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (basic-logic.formula-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable basic-logic.formula-listp))))
+
+(defthm basic-logic.formula-listp-of-cons
+  (equal (basic-logic.formula-listp (cons a x))
+         (and (or (equal (logic.fmtype a) 'pequal*)
+                  (and (equal (logic.fmtype a) 'pnot*)
+                       (equal (logic.fmtype (logic.~arg a)) 'pequal*)))
+              (basic-logic.formula-listp x)))
+  :hints(("Goal" :in-theory (enable basic-logic.formula-listp))))
+
+(defthm all-listeralsp-of-list-fix
+  (equal (basic-logic.formula-listp (list-fix x))
+         (basic-logic.formula-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm booleanp-of-basic-logic.formula-listp
+  (equal (booleanp (basic-logic.formula-listp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm basic-logic.formula-listp-of-cdr-when-basic-logic.formula-listp
+  (implies (basic-logic.formula-listp x)
+           (equal (basic-logic.formula-listp (cdr x))
+                  t)))
+
+(defthm logic.fmtype-logic.pnot-when-non-pequal-memberp-of-basic-logic.formula-listp
+  (implies (and (memberp a x)
+                (basic-logic.formula-listp x)
+                (not (equal (logic.fmtype a) 'pequal*)))
+           (equal (logic.fmtype a) 'pnot*))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-of-logic.~arg-when-non-pequal-memberp-of-basic-logic.formula-listp
+  (implies (and (memberp a x)
+                (basic-logic.formula-listp x)
+                (not (equal (logic.fmtype a) 'pequal*)))
+           (equal (logic.fmtype (logic.~arg a)) 'pequal*))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-of-logic.~arg-when-logic.pnot-memberp-of-basic-logic.formula-listp
+  (implies (and (memberp a x)
+                (basic-logic.formula-listp x)
+                (equal (logic.fmtype a) 'pnot*))
+           (equal (logic.fmtype (logic.~arg a)) 'pequal*))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-pequal-when-non-logic.pnot-memberp-of-basic-logic.formula-listp
+  (implies (and (memberp a x)
+                (basic-logic.formula-listp x)
+                (not (equal (logic.fmtype a) 'pnot*)))
+           (equal (logic.fmtype a) 'pequal*))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-logic.pnot-when-non-pequal-car-of-basic-logic.formula-listp
+  (implies (and (basic-logic.formula-listp x)
+                (force (consp x))
+                (not (equal (logic.fmtype (car x)) 'pequal*)))
+           (equal (logic.fmtype (car x)) 'pnot*)))
+
+(defthm logic.fmtype-of-logic.~arg-when-non-pequal-car-of-basic-logic.formula-listp
+  (implies (and (basic-logic.formula-listp x)
+                (force (consp x))
+                (not (equal (logic.fmtype (car x)) 'pequal*)))
+           (equal (logic.fmtype (logic.~arg (car x))) 'pequal*)))
+
+(defthm logic.fmtype-of-logic.~arg-when-logic.pnot-car-of-basic-logic.formula-listp
+  (implies (and (basic-logic.formula-listp x)
+                (force (consp x))
+                (equal (logic.fmtype (car x)) 'pnot*))
+           (equal (logic.fmtype (logic.~arg (car x))) 'pequal*)))
+
+(defthm logic.fmtype-pequal-when-non-logic.pnot-car-of-basic-logic.formula-listp
+  (implies (and (basic-logic.formula-listp x)
+                (force (consp x))
+                (not (equal (logic.fmtype (car x)) 'pnot*)))
+           (equal (logic.fmtype (car x)) 'pequal*)))
+
+(defthm logic.fmtype-when-memberp-and-basic-logic.formula-listp
+  (implies (and (basic-logic.formula-listp x)
+                (memberp a x))
+           (or (equal (logic.fmtype a) 'pequal*)
+               (and (equal (logic.fmtype a) 'pnot*)
+                    (equal (logic.fmtype (logic.~arg a)) 'pequal*))))
+  :rule-classes nil)
+
+(defthm basic-logic.formula-listp-of-app
+  (equal (basic-logic.formula-listp (app x y))
+         (and (basic-logic.formula-listp x)
+              (basic-logic.formula-listp y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm basic-logic.formula-listp-when-subset-one
+  (implies (and (basic-logic.formula-listp y)
+                (subsetp x y))
+           (basic-logic.formula-listp x))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable basic-logic.formula-listp))))
+
+(defthm basic-logic.formula-listp-when-subset-two
+  (implies (and (subsetp x y)
+                (basic-logic.formula-listp y))
+           (basic-logic.formula-listp x)))
+
+
+
+
+;; Another important idea that we will introduce before discussing the
+;; tautology checker itself is the following.  Suppose that the basic formulas
+;; t1 = t2 and t1 != t2 both occur within some list of basic formulas.  Then,
+;; we say that the list contains complementary formulas.  We write the function
+;; find-complements to search for complementary formulas.
+
+(defund find-complements (x)
+  (declare (xargs :guard (and (logic.formula-listp x)
+                              (basic-logic.formula-listp x))))
+  (if (consp x)
+      (if (if (equal (logic.fmtype (car x)) 'pnot*)
+              (memberp (logic.~arg (car x)) (cdr x))
+            (memberp (logic.pnot (car x)) (cdr x)))
+          (car x)
+        (find-complements (cdr x)))
+    nil))
+
+(defthm find-complements-when-not-consp
+  (implies (not (consp x))
+           (not (find-complements x)))
+  :hints(("Goal" :in-theory (enable find-complements))))
+
+(defthm find-complements-of-cons
+  (equal (find-complements (cons a x))
+         (if (if (equal (logic.fmtype a) 'pnot*)
+                 (memberp (logic.~arg a) x)
+               (memberp (logic.pnot a) x))
+             a
+           (find-complements x)))
+  :hints(("Goal" :in-theory (enable find-complements))))
+
+(defthm find-complements-of-list-fix
+  (equal (find-complements (list-fix x))
+         (find-complements x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defthm not-find-complements-of-cdr-when-not-find-complements
+  (implies (and (not (find-complements x))
+                (force (logic.formula-listp x)))
+           (not (find-complements (cdr x)))))
+
+(defthm find-complements-when-not-find-complements-of-cdr
+  (implies (not (find-complements (cdr x)))
+           (equal (find-complements x)
+                  (if (if (equal (logic.fmtype (car x)) 'pnot*)
+                          (memberp (logic.~arg (car x)) (cdr x))
+                        (memberp (logic.pnot (car x)) (cdr x)))
+                      (car x)
+                    nil))))
+
+(defthm memberp-of-find-complements
+  (implies (find-complements x)
+           (memberp (find-complements x) x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-logic.pnot-of-find-complements
+  (implies (and (find-complements x)
+                (equal (logic.fmtype (find-complements x)) 'pequal*))
+           (memberp (logic.pnot (find-complements x)) x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-logic.~arg-of-find-complements
+  (implies (and (find-complements x)
+                (equal (logic.fmtype (find-complements x)) 'pnot*))
+           (memberp (logic.~arg (find-complements x)) x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-complements-when-complementary-members-one
+  (implies (and (memberp (logic.pnot a) x)
+                (memberp a x)
+                (equal (logic.fmtype a) 'pequal*)
+                (force (logic.formula-listp x)))
+           (find-complements x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-complements-when-complementary-members-two
+  (implies (and (memberp (logic.~arg a) x)
+                (memberp a x)
+                (equal (logic.fmtype a) 'pnot*)
+                (equal (logic.fmtype (logic.~arg a)) 'pequal*)
+                (force (logic.formula-listp x)))
+           (find-complements x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-of-find-complements-when-not-pequal
+  (implies (and (force (logic.formula-listp x))
+                (force (basic-logic.formula-listp x))
+                (find-complements x)
+                (not (equal (logic.fmtype (find-complements x)) 'pequal*)))
+           (equal (logic.fmtype (find-complements x))
+                  'pnot*))
+  :hints(("Goal" :in-theory (enable find-complements))))
+
+(defthm logic.fmtype-of-find-complements-when-not-logic.pnot
+  (implies (and (force (logic.formula-listp x))
+                (force (basic-logic.formula-listp x))
+                (find-complements x)
+                (not (equal (logic.fmtype (find-complements x)) 'pnot*)))
+           (equal (logic.fmtype (find-complements x))
+                  'pequal*))
+  :hints(("Goal" :in-theory (enable find-complements))))
+
+(encapsulate
+ ()
+ (local (defthm lemma1
+          (implies (and (force (logic.formula-listp y))
+                        (force (basic-logic.formula-listp y))
+                        (find-complements x)
+                        (equal (logic.fmtype (find-complements x)) 'pequal*)
+                        (subsetp x y))
+                   (find-complements y))
+          :hints(("Goal"
+                  :in-theory (disable in-superset-when-in-subset-one
+                                      in-superset-when-in-subset-two)
+                  :use ((:instance in-superset-when-in-subset-one
+                                   (a (find-complements x))
+                                   (x x)
+                                   (y y))
+                        (:instance in-superset-when-in-subset-one
+                                   (a (logic.pnot (find-complements x)))
+                                   (x x)
+                                   (y y)))))))
+
+ (local (defthm lemma2
+          (implies (and (force (logic.formula-listp y))
+                        (force (basic-logic.formula-listp y))
+                        (find-complements x)
+                        (equal (logic.fmtype (find-complements x)) 'pnot*)
+                        (subsetp x y))
+                   (find-complements y))
+          :hints(("Goal"
+                  :in-theory (disable in-superset-when-in-subset-one
+                                      in-superset-when-in-subset-two)
+                  :use ((:instance in-superset-when-in-subset-one
+                                   (a (find-complements x))
+                                   (x x)
+                                   (y y))
+                        (:instance in-superset-when-in-subset-one
+                                   (a (logic.~arg (find-complements x)))
+                                   (x x)
+                                   (y y)))))))
+
+ (defthm find-complements-when-find-complements-of-subset-one
+   (implies (and (find-complements x)
+                 (subsetp x y)
+                 (force (logic.formula-listp y))
+                 (force (basic-logic.formula-listp y)))
+            (find-complements y))
+   :hints(("Goal"
+           :cases ((equal (logic.fmtype (find-complements x)) 'pequal*)
+                   (equal (logic.fmtype (find-complements x)) 'pnot*)))))
+
+ (defthm find-complements-when-find-complements-of-subset-two
+   (implies (and (subsetp x y)
+                 (find-complements x)
+                 (force (logic.formula-listp y))
+                 (force (basic-logic.formula-listp y)))
+            (find-complements y)))
+
+ (defthm not-find-complements-when-not-find-complements-of-superset-one
+   (implies (and (not (find-complements y))
+                 (subsetp x y)
+                 (force (logic.formula-listp y))
+                 (force (basic-logic.formula-listp y)))
+            (not (find-complements x))))
+
+ (defthm not-find-complements-when-not-find-complements-of-superset-two
+   (implies (and (subsetp x y)
+                 (not (find-complements y))
+                 (force (logic.formula-listp y))
+                 (force (basic-logic.formula-listp y)))
+            (not (find-complements x)))))
+
+
+
+;; One of the key theorems about basic formula lists is the following.  Suppose
+;; that the list contains complementary formulas.  Then, we can always find at
+;; least some formula which evaluates to true under any arbitrary truth
+;; valuation.
+
+(defthm find-positive-when-find-complements
+  (implies (and (logic.formula-listp x)
+                (basic-logic.formula-listp x)
+                (find-complements x))
+           (find-positive x valuation))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable slow-truth-value-theory))))
+
+
+
+;; Finally, suppose that we are given a list of basic formulas.  If there are
+;; no complementary formulas in the list, then it is possible to construct a
+;; valuation which will render the disjunction false.  (See Shoenfield, at the
+;; top of page 27.)  Essentially, we construct a valuation V as follows.  Let
+;; V(t1 = t2) be true iff t1 != t2 is a member of the list.  In Shankar's
+;; implementation, this is the function "falsify".
+
+(defund falsify-formulas (x)
+  (declare (xargs :guard (and (logic.formula-listp x)
+                              (basic-logic.formula-listp x)
+                              (not (find-complements x)))))
+  (if (consp x)
+      (if (equal (logic.fmtype (car x)) 'pnot*)
+          (cons (logic.~arg (car x))
+                (falsify-formulas (cdr x)))
+        (falsify-formulas (cdr x)))
+    nil))
+
+(defthm falsify-formulas-when-not-consp
+  (implies (not (consp x))
+           (equal (falsify-formulas x)
+                  nil))
+  :hints(("Goal" :in-theory (enable falsify-formulas))))
+
+(defthm true-listp-of-falsify-formulas
+  (equal (true-listp (falsify-formulas x))
+         t)
+  :hints(("Goal" :in-theory (enable falsify-formulas))))
+
+(defthm memberp-of-falsify-formulas
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.formulap a)))
+           (equal (memberp a (falsify-formulas x))
+                  (memberp (logic.pnot a) x)))
+  :hints(("Goal" :in-theory (enable falsify-formulas))))
+
+(encapsulate
+ ()
+ (local (defthm lemma1
+          ;; If L \in X is of the form t1 = t2, then it evaluates to true under
+          ;; the falsifying valuation only when its complement t1 != t2 is also
+          ;; a member of the list.
+          (implies (and (force (logic.formula-listp x))
+                        (force (basic-logic.formula-listp x))
+                        (memberp a x)
+                        (equal (logic.fmtype a) 'pequal*))
+                   (equal (truth-value a (falsify-formulas x))
+                          (memberp (logic.pnot a) x)))
+          :hints(("Goal" :in-theory (enable slow-truth-value-theory)))))
+
+ (local (defthm lemma2
+          ;; We can conclude from Lemma 1 that if find-positive is able to find
+          ;; a positive formula L (i.e., L is of the form t1 = t2) which
+          ;; evaluates to true under the falsifying valuation, then X must have
+          ;; some complementary formula.  After all, since L evaluates to true,
+          ;; t1 != t2 must be in X.
+          (implies (and (force (logic.formula-listp x))
+                        (force (basic-logic.formula-listp x))
+                        (find-positive x (falsify-formulas x))
+                        (equal (logic.fmtype (find-positive x (falsify-formulas x)))
+                               'pequal*))
+                   (find-complements x))
+          :hints(("Goal" :in-theory (disable lemma1)
+                  :use ((:instance lemma1
+                                   (a (find-positive x (falsify-formulas x)))
+                                   (x x)))))))
+
+ (local (defthm lemma3
+          ;; Alternately, if L \in X is of the form t1 != t2, then it surely
+          ;; does not evaluate to true under the falsifying valuation, because
+          ;; the falsifying valuation will bind t1 = t2 to true, and hence t1
+          ;; != t2 is false.
+          (implies (and (force (logic.formula-listp x))
+                        (force (basic-logic.formula-listp x))
+                        (memberp a x)
+                        (equal (logic.fmtype a) 'pnot*)
+                        (equal (logic.fmtype (logic.~arg a)) 'pequal*))
+                   (not (truth-value a (falsify-formulas x))))
+          :hints(("Goal" :in-theory (enable slow-truth-value-theory)))))
+
+ (local (defthm lemma4
+          ;; And as a result of Lemma 3, we see that the if find positive is
+          ;; able to find some formulas L which evaluates to true under the
+          ;; falsifying valuation, then surely L must be positive.
+          (implies (and (force (logic.formula-listp x))
+                        (force (basic-logic.formula-listp x))
+                        (find-positive x (falsify-formulas x)))
+                   (equal (logic.fmtype (find-positive x (falsify-formulas x))) 'pequal*))
+          :hints(("Goal"
+                  :in-theory (disable lemma3)
+                  :use ((:instance logic.fmtype-when-memberp-and-basic-logic.formula-listp
+                                   (a (find-positive x (falsify-formulas x)))
+                                   (x x))
+                        (:instance lemma3
+                                   (a (find-positive x (falsify-formulas x)))
+                                   (x x)))))))
+
+ (local (defthm lemma5
+          ;; Chaining together Lemmas 2 and 4, we see that whenever
+          ;; find-positive returns true, it must be the case that
+          ;; find-complements is successful.
+          (implies (and (force (logic.formula-listp x))
+                        (force (basic-logic.formula-listp x))
+                        (find-positive x (falsify-formulas x)))
+                   (find-complements x))))
+
+ (defthm find-positive-of-falsify-formulas
+   ;; We have already proven the other half of the implication in Lemma 5 in a
+   ;; more general setting, in the theorem find-positive-when-find-complements.
+   ;; So, we can now provide an iff-rewrite and say that find-positive finds an
+   ;; acceptable formula only when complementary formulas exist.
+   (implies (and (force (logic.formula-listp x))
+                 (force (basic-logic.formula-listp x)))
+            (iff (find-positive x (falsify-formulas x))
+                 (find-complements x)))))
+
+
+
+
+
+
+;; We now introduce our main tautology checking function, tautologyp1.  We take
+;; as inputs two lists of formulas, As and Acc.  We assume that acc is a list
+;; of basic formulas with no complementary members, and we return true only
+;; when the disjunction of (app as acc) is a tautology.  This function is like
+;; Shankar's function of the same name.  We prove that the function is "sound
+;; and complete" in the sense that it only accepts tautologies, and anything it
+;; rejects is not a tautology.
+
+(local (defthm termination-crock-1
+         (implies (and (equal (logic.fmtype as1) 'pnot*)
+                       (equal (logic.fmtype (logic.~arg as1)) 'por*))
+                  (< (+ 1 (logic.formula-size (logic.vrhs (logic.~arg as1))))
+                          (logic.formula-size as1)))
+         :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.vrhs logic.~arg)))))
+
+(local (defthm termination-crock-2
+         (implies (and (equal (logic.fmtype x) 'pnot*)
+                       (equal (logic.fmtype (logic.~arg x)) 'pnot*))
+                  (< (logic.formula-size (logic.~arg (logic.~arg x)))
+                     (logic.formula-size x)))
+         :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.~arg)))))
+
+(local (defthm termination-crock-3
+         (implies (and (equal (logic.fmtype x) 'pnot*)
+                       (equal (logic.fmtype (logic.~arg x)) 'por*))
+                  (< (+ 1 (logic.formula-size (logic.vlhs (logic.~arg x))))
+                     (logic.formula-size x)))
+         :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.vlhs logic.~arg)))))
+
+(local (defthm termination-crock-4
+         (implies (equal (logic.fmtype as1) 'por*)
+                  (< (+ (logic.formula-size (logic.vlhs as1))
+                                      (logic.formula-size (logic.vrhs as1)))
+                     (logic.formula-size as1)))
+         :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.vlhs logic.vrhs)))))
+
+(defund tautologyp1 (as acc)
+  (declare (xargs :guard (and (logic.formula-listp as)
+                              (logic.formula-listp acc))
+                  :measure (logic.formula-list-size as)
+                  :hints(("Goal" :in-theory (disable logic.fmtype-normalizer-cheap)))))
+  (if (consp as)
+      (let ((A1 (car as)))
+        (cond
+
+         ;; TC([B v C,...], acc) = TC([B,C,...], acc)
+         ((equal (logic.fmtype A1) 'por*)
+          (tautologyp1 (list* (logic.vlhs A1) (logic.vrhs A1) (cdr as)) acc))
+
+         ;; TC([~(B v C),...], acc) = TC([~B,...], acc) andalso
+         ;;                           TC([~C,...], acc)
+         ((and (equal (logic.fmtype A1) 'pnot*)
+               (equal (logic.fmtype (logic.~arg A1)) 'por*))
+          (and (tautologyp1 (cons (logic.pnot (logic.vlhs (logic.~arg A1)))
+                                  (cdr as))
+                            acc)
+               (tautologyp1 (cons (logic.pnot (logic.vrhs (logic.~arg A1)))
+                                  (cdr as))
+                            acc)))
+
+          ;; TC([~~B,...], acc) = TC([B,...], acc)
+         ((and (equal (logic.fmtype A1) 'pnot*)
+               (equal (logic.fmtype (logic.~arg A1)) 'pnot*))
+          (tautologyp1 (cons (logic.~arg (logic.~arg A1))
+                             (cdr as))
+                       acc))
+
+         ;; TC([~(t1=t2),...], acc) = memberp(t1=t2, acc) orelse
+         ;;                           TC(..., ~(t1=t2)::acc)
+         ((equal (logic.fmtype A1) 'pnot*)
+          (or (memberp (logic.~arg A1) acc)
+              (tautologyp1 (cdr as) (cons A1 acc))))
+
+         ;; TC([t1=t2,...], acc) = memberp(~(t1=t2), acc) orelse
+         ;;                        TC(..., t1=t2::acc)
+         (t
+          (or (memberp (logic.pnot A1) acc)
+              (tautologyp1 (cdr as) (cons A1 acc))))))
+    nil))
+
+(defthm booleanp-of-tautologyp1
+  (equal (booleanp (tautologyp1 as acc))
+         t)
+  :hints(("Goal" :in-theory (enable tautologyp1))))
+
+(defthm tautologyp1-when-not-consp
+  (implies (not (consp as))
+           (not (tautologyp1 as acc)))
+  :hints(("Goal" :in-theory (enable tautologyp1))))
+
+(defthm tautologyp1-of-list-fix-one
+  (equal (tautologyp1 (list-fix as) acc)
+         (tautologyp1 as acc))
+  :hints(("Goal" :in-theory (enable tautologyp1
+                                    ;; Yuck!  why?
+                                    list-fix))))
+
+(defthm tautologyp1-of-list-fix-two
+  (equal (tautologyp1 as (list-fix acc))
+         (tautologyp1 as acc))
+  :hints(("Goal" :in-theory (enable tautologyp1))))
+
+(defthm tautologyp1-of-recursive-call-in-logic.por-case
+  (implies (and (tautologyp1 as acc)
+                (equal (logic.fmtype (car as)) 'por*))
+           (equal (tautologyp1 (list* (logic.vlhs (car as)) (logic.vrhs (car as)) (cdr as)) acc)
+                  t))
+  :hints(("Goal" :in-theory (enable tautologyp1))))
+
+(defthm tautologyp1-of-recursive-calls-in-logic.pnot-of-logic.pors-case
+  (implies (and (tautologyp1 as acc)
+                (equal (logic.fmtype (car as)) 'pnot*)
+                (equal (logic.fmtype (logic.~arg (car as))) 'por*))
+           (and (tautologyp1 (cons (logic.pnot (logic.vlhs (logic.~arg (car as)))) (cdr as)) acc)
+                (tautologyp1 (cons (logic.pnot (logic.vrhs (logic.~arg (car as)))) (cdr as)) acc)))
+  :hints(("Goal" :in-theory (enable tautologyp1))))
+
+(defthm tautologyp1-of-recursive-call-in-logic.pnot-of-logic.pnot-case
+  (implies (and (tautologyp1 as acc)
+                (equal (logic.fmtype (car as)) 'pnot*)
+                (equal (logic.fmtype (logic.~arg (car as))) 'pnot*))
+           (equal (tautologyp1 (cons (logic.~arg (logic.~arg (car as))) (cdr as)) acc)
+                  t))
+  :hints(("Goal" :in-theory (enable tautologyp1))))
+
+(defthm tautologyp1-of-recursive-call-in-logic.pnot-of-pequal-case
+  (implies (and (tautologyp1 as acc)
+                (equal (logic.fmtype (car as)) 'pnot*)
+                (equal (logic.fmtype (logic.~arg (car as))) 'pequal*)
+                (not (memberp (logic.~arg (car as)) acc)))
+           (equal (tautologyp1 (cdr as) (cons (car as) acc))
+                  t))
+  :hints(("Goal" :in-theory (enable tautologyp1))))
+
+(defthm tautologyp1-of-recursive-call-in-pequal-case
+  (implies (and (logic.formula-listp as)
+                (tautologyp1 as acc)
+                (equal (logic.fmtype (car as)) 'pequal*)
+                (not (memberp (logic.pnot (car as)) acc)))
+           (equal (tautologyp1 (cdr as) (cons (car as) acc))
+                  t))
+  :hints(("Goal" :in-theory (enable tautologyp1))))
+
+
+
+;; We now begin our correctness argument for tautologyp1.  Our first goal is to
+;; show that "tautologies are true".  In other words, suppose that as and acc
+;; satisfy the conditions we have described.  Then, it follows that the
+;; disjunction of (app as acc) must evaluate to true under every arbitrary
+;; truth valuation.  Given our supporting definitions, the proof works out
+;; easily.
+
+(defthm forcing-tautologies-are-true
+   (implies (and (force (logic.formula-listp as))
+                 (force (logic.formula-listp acc))
+                 (tautologyp1 as acc))
+            (equal (truth-value (logic.disjoin-formulas (app as acc)) valuation)
+                   t))
+   :hints(("Goal" :in-theory (enable tautologyp1 slow-truth-value-theory))))
+
+
+
+;; Our attention now turns to demonstrating the completeness of tautologyp1.
+;; That is, suppose that tautologyp1 rejects its inputs.  Then, we would like
+;; to show that there is some truth valuation which makes (app as acc) false.
+;; To do this, we will actually construct such a valuation.
+
+;; Shoenfield explains this process at the top of Page 27, and in Shankar's
+;; work it appears as the function "falsify-taut", which we recreate below with
+;; the appropriate changes.  We return a pair of the form (successp
+;; . valuation), where if successp is true then valuation is a falsifying
+;; valuation for this formula, and otherwise we have failed to produce such a
+;; valuation.
+
+(defund falsify-taut (as acc)
+  (declare (xargs :measure (logic.formula-list-size as)
+                  :guard (and (logic.formula-listp as)
+                              (logic.formula-listp acc)
+                              (basic-logic.formula-listp acc)
+                              (not (find-complements acc)))
+                  :verify-guards nil))
+  (if (consp as)
+      (let ((A1 (car as)))
+        (cond ((equal (logic.fmtype A1) 'por*)
+               (falsify-taut (list* (logic.vlhs A1) (logic.vrhs A1) (cdr as)) acc))
+              ((and (equal (logic.fmtype A1) 'pnot*)
+                    (equal (logic.fmtype (logic.~arg A1)) 'por*))
+               (let* ((candidate (falsify-taut (cons (logic.pnot (logic.vlhs (logic.~arg A1)))
+                                                     (cdr as))
+                                               acc))
+                      (successp (car candidate)))
+                 (if successp
+                     candidate
+                   (falsify-taut (cons (logic.pnot (logic.vrhs (logic.~arg A1)))
+                                       (cdr as))
+                                 acc))))
+              ((and (equal (logic.fmtype A1) 'pnot*)
+                    (equal (logic.fmtype (logic.~arg A1)) 'pnot*))
+               (falsify-taut (cons (logic.~arg (logic.~arg A1))
+                                   (cdr as))
+                             acc))
+              ((equal (logic.fmtype A1) 'pnot*)
+               (if (memberp (logic.~arg A1) acc)
+                   '(nil . nil)
+                 (falsify-taut (cdr as) (cons A1 acc))))
+              (t
+               (if (memberp (logic.pnot A1) acc)
+                   '(nil . nil)
+                 (falsify-taut (cdr as) (cons A1 acc))))))
+    (cons t (falsify-formulas acc))))
+
+(defthm consp-of-falsify-taut
+  (equal (consp (falsify-taut as acc))
+         t)
+  :hints(("Goal" :in-theory (enable falsify-taut))))
+
+(verify-guards falsify-taut
+               :hints(("Goal" :in-theory (enable logic.fmtype-normalizer-cheap))))
+
+(encapsulate
+ ()
+
+ (local
+  (defthm lemma
+    ;; By looking at the definitions of falsify-taut and tautologyp1, we can see
+    ;; that falsify-taut considers itself "successful" exactly when tautologyp1
+    ;; rejects these inputs.
+    (implies (and (logic.formula-listp as))
+             (equal (tautologyp1 as acc)
+                    (not (car (falsify-taut as acc)))))
+    :hints(("Goal"
+            :in-theory (enable tautologyp1 falsify-taut)
+            :induct (tautologyp1 as acc)))))
+
+ (defthm forcing-non-tautologies-are-falsifiable
+   ;; We can also demonstrate that when tautologyp1 rejects its inputs, then the
+   ;; valuation returned by falsify-taut falsifies the disjunction of these
+   ;; formulas.  In other words, anything that tautologyp1 rejects is not true
+   ;; in all valuations, and hence is not a tautology.
+   (implies (and (force (logic.formula-listp as))
+                 (force (logic.formula-listp acc))
+                 (force (basic-logic.formula-listp acc))
+                 (force (not (find-complements acc)))
+                 (not (tautologyp1 as acc)))
+            (not (truth-value (logic.disjoin-formulas (app as acc))
+                              (cdr (falsify-taut as acc)))))
+   :hints(("Goal"
+           :in-theory (enable falsify-taut
+                              slow-truth-value-theory
+                              logic.fmtype-normalizer-cheap)
+           :induct (falsify-taut as acc)))))
+
+
+
+;; We now have a function, tautologyp1, which we can use to determine precisely
+;; when (logic.disjoin-formulas (app as acc)) is a tautology, assuming that as and
+;; acc are lists of formulas, where acc consists entirely of basic formulas and
+;; has no complementary formulas.  This turns out to be sufficient to answer
+;; whether any formula F is a tautology, by asking about (logic.disjoin-formulas
+;; (list F) nil).  We now "wrap up" this common usage as follows.
+
+(defund tautologyp (x)
+  (declare (xargs :guard (logic.formulap x)))
+  (tautologyp1 (list x) nil))
+
+(defthm booleanp-of-tautologyp
+  (equal (booleanp (tautologyp x))
+         t)
+  :hints(("Goal" :in-theory (enable tautologyp))))
+
+(defund tautologyp-counterexample (x)
+  (declare (xargs :guard (and (logic.formulap x)
+                              (not (tautologyp x)))))
+  (cdr (falsify-taut (list x) nil)))
+
+(defthm truth-value-when-tautologyp
+  (implies (and (force (logic.formulap x))
+                (tautologyp x))
+           (equal (truth-value x valuation)
+                  t))
+  :hints(("Goal"
+          :in-theory (e/d (tautologyp)
+                          (forcing-tautologies-are-true))
+          :use (:instance forcing-tautologies-are-true
+                          (as (list x))
+                          (acc nil)))))
+
+(defthm truth-value-of-counterexample-when-not-tautologyp
+  (implies (and (force (logic.formulap x))
+                (not (tautologyp x)))
+           (not (truth-value x (tautologyp-counterexample x))))
+  :hints(("Goal"
+          :in-theory (e/d (tautologyp tautologyp-counterexample)
+                          (forcing-non-tautologies-are-falsifiable))
+          :use (:instance forcing-non-tautologies-are-falsifiable
+                          (as (list x))
+                          (acc nil)))))
+
+
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (logic.formula-listp xs)
+                        (truth-value (logic.disjoin-formulas xs)
+                                     (cdr (falsify-taut xs nil))))
+                   (tautologyp1 xs nil))
+          :hints(("Goal"
+                  :in-theory (disable forcing-non-tautologies-are-falsifiable)
+                  :use ((:instance forcing-non-tautologies-are-falsifiable
+                                   (as xs)
+                                   (acc nil)))))))
+
+ (defthm tautologyp-when-cannot-be-falsified
+   ;; This is Shankar's trick for allowing us to symbolically simplify
+   ;; tautologies as they arise in formulas.  (See page 88 of his book,
+   ;; Metamathematics, Machines, and Godel's Proof).
+   (implies (and (logic.formulap x)
+                 (truth-value x (cdr (falsify-taut (list x) nil))))
+            (equal (tautologyp x)
+                   t))
+   :hints(("Goal"
+           :in-theory (enable tautologyp)))))
+
+(defthm forcing-tautologyp-of-logic.piff-a-a
+  (implies (force (logic.formulap a))
+           (equal (tautologyp (logic.piff a a))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.piff logic.pand))))
+
+
+
+
+
+;; It is not sufficient to prove that tautologyp1 is sound and complete in the
+;; sense we have demonstrated above.  We need to show that we can actually
+;; build proofs of every tautology.
+
+
+(defund tautology-bldr1 (as acc)
+  ;; Derive (logic.disjoin-formulas (app as acc)) when (tautologyp1 as acc).
+  ;; Note: This is basically like Shankar's function "taut-proof1".
+  (declare (xargs :guard (and (logic.formula-listp as)
+                              (logic.formula-listp acc)
+                              (tautologyp1 as acc))
+                  :verify-guards nil
+                  :measure (logic.formula-list-size as)))
+  ;; We will denote As = [A1 ... An]
+  ;; We will write Acc = [B1 ... Bm]
+  ;; Goal is to prove [A1 v... v An v B1 v ... v Bm] (fully right associated)
+  (if (consp as)
+      (let ((A1 (car as)))
+        (cond
+
+         ;; As = [(F v G), A2, ..., An]
+         ((equal (logic.fmtype A1) 'por*)
+
+          ;; Case 1: {A2...An}U{B1...Bm} is nonempty
+          ;;   Recursively build F v (G v (A2 ... An v B1 ... Bm))
+          ;;   Associativity yields (F v G) v (A2 ... An v B1 ... Bm)
+          (if (or (consp (cdr as))
+                  (consp acc))
+              (build.associativity (tautology-bldr1 (list* (logic.vlhs A1) (logic.vrhs A1) (cdr as)) acc))
+
+            ;; Case 2: {A2...An}U{B1...Bm} is empty
+            ;;   Recursively build F v G
+            (tautology-bldr1 (list* (logic.vlhs A1) (logic.vrhs A1) (cdr as)) acc)))
+
+         ;; As = [~(F v G), A2, ..., An]
+         ((and (equal (logic.fmtype A1) 'pnot*)
+               (equal (logic.fmtype (logic.~arg A1)) 'por*))
+
+          ;; Case 1: {A2...An}U{B1...Bm} is nonempty
+          ;;   Recursively build ~F v (A2 ... An v B1 ... Bm)
+          ;;   Recursively build ~G v (A2 ... An v B1 ... Bm)
+          ;;   Merge Implications yields ~(F v G) v (A2 ... An v B1 ... Bm)
+          (if (or (consp (cdr as))
+                  (consp acc))
+              (build.merge-implications (tautology-bldr1 (cons (logic.pnot (logic.vlhs (logic.~arg A1))) (cdr as)) acc)
+                                       (tautology-bldr1 (cons (logic.pnot (logic.vrhs (logic.~arg A1))) (cdr as)) acc))
+
+            ;; Case 2: {A2...An}U{B1...Bm} is empty
+            ;;   Recursively build ~F
+            ;;   Recursively Build ~G
+            ;;   Merge Negatives yields ~(F v G)
+            (build.merge-negatives (tautology-bldr1 (cons (logic.pnot (logic.vlhs (logic.~arg A1))) (cdr as)) acc)
+                                  (tautology-bldr1 (cons (logic.pnot (logic.vrhs (logic.~arg A1))) (cdr as)) acc))))
+
+         ;; As = [~~B, A2, ..., An]
+         ((and (equal (logic.fmtype A1) 'pnot*)
+               (equal (logic.fmtype (logic.~arg A1)) 'pnot*))
+
+          ;; Case 1: [A2...An]@[B1...Bm] is nonempty
+          ;;   Recursively build B v (A2 ... An v B1 ... Bm)
+          ;;   Lhs Insert ~~ yields ~~B v (A2 ... An v B1 ... Bm)
+          (if (or (consp (cdr as))
+                  (consp acc))
+              (build.lhs-insert-neg-neg (tautology-bldr1 (cons (logic.~arg (logic.~arg A1)) (cdr as)) acc))
+
+            ;; Case 2: [A2...An]@[B1...Bm] is empty
+            ;;  Recursively build B
+            ;;  Then Double Negate yields ~~B
+            (build.insert-neg-neg (tautology-bldr1 (cons (logic.~arg (logic.~arg A1)) (cdr as)) acc))))
+
+
+        ;; As = [~(t1 = t2), A2, ..., An]
+        ((equal (logic.fmtype A1) 'pnot*)
+
+         ;; Case 1: t1=t2 is Bi for some i.
+         ;;   Propositional Schema:  A1 v Bi
+         ;;   Multi Or Expansion:    A1 ... An v B1 ... Bm
+         (if (memberp (logic.~arg A1) acc)
+             (build.multi-or-expansion (build.propositional-schema (logic.~arg A1)) (app as acc))
+
+           ;; Case 2: t1=t2 is not Bi for any i.
+           ;;   Recursively build A2 ... An v A1 v B1 ... Bm
+           ;;   Disjoined Subset yields A1 ... An v B1 ... Bm
+           (build.disjoined-subset (app (cdr as) (cons a1 acc))
+                                  (app as acc)
+                                  (tautology-bldr1 (cdr as) (cons A1 acc)))))
+
+
+        ;; As = [t1=t2, A2, ..., An]
+        (t
+
+         ;; Case 1: ~(t1=t2) is Bi for some i.
+         ;;   Propositional Schema:  Bi v A1
+         ;;   Multi Or Expansion:    A1 ... An v B1 ... Bm
+         (if (memberp (logic.pnot A1) acc)
+             (build.multi-or-expansion (build.propositional-schema A1) (app as acc))
+
+           ;; Case 2: ~(t1=t2) is not Bi for any i.
+           ;;   Recursively build A2...An v A1 v B1 ... Bm
+           ;;   Disjoined Subset yields A1...An v B1...Bm
+           (build.disjoined-subset (app (cdr as) (cons a1 acc))
+                                  (app as acc)
+                                  (tautology-bldr1 (cdr as) (cons A1 acc)))))
+
+         ))
+
+    ;; as = [], our guard is violated; we return garbage.
+    nil))
+
+
+
+;; We now prove that whenever the tautologyp1 function accepts as and acc, the
+;; tautology-bldr1 function will actually construct the appropriate proof.
+;; This still leaves the question of whether or not tautologyp1 behaves
+;; correctly, but establishes that if it does, then tautologyp-bldr will indeed
+;; construct a proof of any arbitrary tautology.
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (force (logic.formula-listp as))
+                        (force (logic.formula-listp acc))
+                        (force (tautologyp1 as acc)))
+                   (and (logic.appealp (tautology-bldr1 as acc))
+                        (equal (logic.conclusion (tautology-bldr1 as acc))
+                               (logic.disjoin-formulas (app as acc)))))
+          :hints(("Goal" :in-theory (enable tautology-bldr1 logic.fmtype-normalizer-cheap)))))
+
+ (verify-guards tautology-bldr1
+                :hints(("Goal" :in-theory (enable logic.fmtype-normalizer-cheap))))
+
+ (defthm forcing-logic.appealp-of-tautology-bldr1
+   (implies (and (force (logic.formula-listp as))
+                 (force (logic.formula-listp acc))
+                 (force (tautologyp1 as acc)))
+            (equal (logic.appealp (tautology-bldr1 as acc))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-tautology-bldr1
+   (implies (and (force (logic.formula-listp as))
+                 (force (logic.formula-listp acc))
+                 (force (tautologyp1 as acc)))
+            (equal (logic.conclusion (tautology-bldr1 as acc))
+                   (logic.disjoin-formulas (app as acc))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proofp-of-tautology-bldr1
+   (implies (and (force (logic.formula-listp as))
+                 (force (logic.formula-listp acc))
+                 (force (tautologyp1 as acc))
+                 ;; ---
+                 (force (logic.formula-list-atblp as atbl))
+                 (force (logic.formula-list-atblp acc atbl)))
+            (equal (logic.proofp (tautology-bldr1 as acc) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable tautology-bldr1 logic.fmtype-normalizer-cheap)))))
+
+
+
+(defund tautology-bldr (x)
+  (declare (xargs :guard (and (logic.formulap x)
+                              (tautologyp x))
+                  :guard-hints (("Goal" :in-theory (enable tautologyp)))))
+  (tautology-bldr1 (list x) nil))
+
+(encapsulate
+ ()
+ (defthm forcing-logic.appealp-of-tautology-bldr
+   (implies (and (force (tautologyp x))
+                 (force (logic.formulap x)))
+            (equal (logic.appealp (tautology-bldr x))
+                   t))
+   :hints(("Goal" :in-theory (enable tautologyp tautology-bldr))))
+
+ (defthm forcing-logic.conclusion-of-tautology-bldr
+   (implies (and (force (tautologyp x))
+                 (force (logic.formulap x)))
+            (equal (logic.conclusion (tautology-bldr x))
+                   x))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :in-theory (enable tautologyp tautology-bldr))))
+
+ (defthm forcing-logic.proofp-of-tautology-bldr
+   (implies (and (force (tautologyp x))
+                 (force (logic.formulap x))
+                 ;; ---
+                 (force (logic.formula-atblp x atbl)))
+            (equal (logic.proofp (tautology-bldr x) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable tautologyp tautology-bldr)))))
+
+
+
+
+;; ------------------------------------------------------------------------- ;;
+;;                                                                           ;;
+;;                                   Part 3                                  ;;
+;;                                                                           ;;
+;;                         Tautological Consequences                         ;;
+;;                                                                           ;;
+;; ------------------------------------------------------------------------- ;;
+
+;; We now write a function that checks if some formula B is a tautological
+;; consequence of some other formulas, say A1, A2, ..., An.  We also write a
+;; function that will build a proof of B given proofs of each Ai.
+
+(defund tautological-consequencep (b as)
+  (declare (xargs :guard (and (logic.formulap b)
+                              (logic.formula-listp as))))
+  (tautologyp (logic.disjoin-formulas (cons b (logic.negate-formulas as)))))
+
+(defthm booleanp-of-tautological-consequencep
+  (equal (booleanp (tautological-consequencep b as))
+         t)
+  :hints(("Goal" :in-theory (enable tautological-consequencep))))
+
+;; BOZO move; rename
+(defthm forcing-tautological-consequencep-of-nots
+  (implies (and (force (logic.formulap f))
+                (force (logic.formulap g))
+                (force (equal (logic.fmtype f) 'pnot*))
+                (force (equal (logic.fmtype g) 'pnot*)))
+           (equal (tautological-consequencep (logic.piff f g)
+                                             (list (logic.piff (logic.~arg f) (logic.~arg g))))
+                  t))
+  :hints(("Goal" :in-theory (enable slow-truth-value-theory
+                                    tautological-consequencep))))
+
+;; BOZO move; rename
+(defthm forcing-tautological-consequencep-of-ors
+  (implies (and (force (logic.formulap f))
+                (force (logic.formulap g))
+                (force (equal (logic.fmtype f) 'por*))
+                (force (equal (logic.fmtype g) 'por*)))
+           (equal (tautological-consequencep (logic.piff f g)
+                                             (list (logic.piff (logic.vlhs f) (logic.vlhs g))
+                                                   (logic.piff (logic.vrhs f) (logic.vrhs g))))
+                  t))
+  :hints(("Goal" :in-theory (enable slow-truth-value-theory
+                                    logic.piff
+                                    tautological-consequencep))))
+
+
+
+(defund tautological-consequence-bldr (b as)
+  (declare (xargs :guard (and (logic.formulap b)
+                              (logic.appeal-listp as)
+                              (tautological-consequencep b (logic.strip-conclusions as)))
+                  :verify-guards nil))
+  (build.modus-ponens-list b as
+   (tautology-bldr (logic.disjoin-formulas
+                    (fast-app (logic.negate-formulas (logic.strip-conclusions as))
+                              (list b))))))
+
+
+
+;; There is a slight disconnect here; our builder function appends the
+;; singleton list [B] to the end of [A1 ... An], whereas our simple testing
+;; function conses B onto the front instead.  We to a little work here to show
+;; that there is really no difference between these two lists as far as
+;; tautologyp is concerned.
+
+(defthm forcing-truth-value-of-logic.disjoin-formulas-of-superset-one
+  (implies (and (subsetp x y)
+                (truth-value (logic.disjoin-formulas x) valuation)
+                (force (logic.formula-listp y)))
+           (equal (truth-value (logic.disjoin-formulas y) valuation)
+                  t)))
+
+(defthm forcing-truth-value-of-logic.disjoin-formulas-of-superset-two
+  (implies (and (truth-value (logic.disjoin-formulas x) valuation)
+                (subsetp x y)
+                (force (logic.formula-listp y)))
+           (equal (truth-value (logic.disjoin-formulas y) valuation)
+                  t)))
+
+(defthm forcing-tautologyp-of-logic.disjoin-formulas-of-superset-one
+  (implies (and (tautologyp (logic.disjoin-formulas x))
+                (subsetp x y)
+                (force (consp x))
+                (force (logic.formula-listp y)))
+           (equal (tautologyp (logic.disjoin-formulas y))
+                  t)))
+
+(defthm forcing-tautologyp-of-logic.disjoin-formulas-of-superset-two
+  (implies (and (subsetp x y)
+                (tautologyp (logic.disjoin-formulas x))
+                (force (consp x))
+                (force (logic.formula-listp y)))
+           (equal (tautologyp (logic.disjoin-formulas y))
+                  t)))
+
+
+
+
+;; And finally we can state the usual properties about our tautological
+;; consequence builder function.
+
+(verify-guards tautological-consequence-bldr
+  :hints(("Goal" :in-theory (enable tautological-consequencep))))
+
+(defthm forcing-logic.appealp-of-tautological-consequence-bldr
+  (implies (and (force (logic.formulap b))
+                (force (logic.appeal-listp as))
+                (force (tautological-consequencep b (logic.strip-conclusions as))))
+           (equal (logic.appealp (tautological-consequence-bldr b as))
+                  t))
+  :hints(("Goal" :in-theory (enable tautological-consequence-bldr tautological-consequencep))))
+
+(defthm forcing-logic.conclusion-of-tautological-consequence-bldr
+  (implies (and (force (logic.formulap b))
+                (force (logic.appeal-listp as))
+                (force (tautological-consequencep b (logic.strip-conclusions as))))
+           (equal (logic.conclusion (tautological-consequence-bldr b as))
+                  b))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable tautological-consequence-bldr tautological-consequencep))))
+
+(defthm forcing-logic.proofp-of-tautological-consequence-bldr
+  (implies (and (force (logic.formulap b))
+                (force (logic.appeal-listp as))
+                (force (tautological-consequencep b (logic.strip-conclusions as)))
+                ;; ---
+                (force (logic.formula-atblp b atbl))
+                (force (logic.proof-listp as axioms thms atbl)))
+           (equal (logic.proofp (tautological-consequence-bldr b as) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tautological-consequence-bldr tautological-consequencep))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/clauses/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/clauses/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/aux-limsplit-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/aux-limsplit-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/aux-limsplit-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/aux-limsplit-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,714 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop")
+(include-book "../build/disjoined-subset")
+(include-book "aux-split-support")
+(include-book "aux-limsplit")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund clause.aux-limsplit-cutoff-bldr (as bs proof)
+  ;;    (A1 v ... v An v B1 v ... v Bm) v Q
+  ;;  ---------------------------------------
+  ;;   (B1 v ... v Bm) v (An v ... v A1 v Q)
+  ;;
+  ;; This is just the repeated application of aux-limsplit-cutoff-step-bldr.
+  (declare (xargs :guard (and (logic.formula-listp as)
+                              (logic.formula-listp bs)
+                              (consp bs)
+                              (logic.appealp proof)
+                              (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                              (equal (logic.vlhs (logic.conclusion proof))
+                                     (logic.disjoin-formulas (app as bs))))
+                  :verify-guards nil))
+  (if (consp as)
+      (clause.aux-limsplit-cutoff-bldr (cdr as) bs
+                                       (clause.aux-limsplit-cutoff-step-bldr proof))
+    (logic.appeal-identity proof)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-limsplit-cutoff-bldr)))
+
+ (defthm clause.aux-limsplit-cutoff-bldr-under-iff
+   (iff (clause.aux-limsplit-cutoff-bldr as bs proof)
+        t))
+
+ (defthm forcing-logic.appealp-of-clause.aux-limsplit-cutoff-bldr
+   (implies (force (and (logic.formula-listp as)
+                        (logic.formula-listp bs)
+                        (consp bs)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vlhs (logic.conclusion proof))
+                               (logic.disjoin-formulas (app as bs)))))
+            (equal (logic.appealp (clause.aux-limsplit-cutoff-bldr as bs proof))
+                   t)))
+
+ (defthmd lemma-for-forcing-logic.conclusion-of-clause.aux-limsplit-cutoff-bldr
+   (implies (force (and (logic.formulap b)
+                        (logic.formulap c)))
+            (equal (logic.disjoin-formulas (app a (list b c)))
+                   (logic.disjoin-formulas (app a (list (logic.por b c))))))
+   :hints(("Goal"
+           :induct (cdr-induction a)
+           :in-theory (enable logic.disjoin-formulas))))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-limsplit-cutoff-bldr
+   (implies (force (and (logic.formula-listp as)
+                        (logic.formula-listp bs)
+                        (consp bs)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vlhs (logic.conclusion proof))
+                               (logic.disjoin-formulas (app as bs)))))
+            (equal (logic.conclusion (clause.aux-limsplit-cutoff-bldr as bs proof))
+                   (logic.por (logic.disjoin-formulas bs)
+                              (logic.disjoin-formulas (app (rev as) (list (logic.vrhs (logic.conclusion proof))))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal"
+           :in-theory (enable lemma-for-forcing-logic.conclusion-of-clause.aux-limsplit-cutoff-bldr))))
+
+ (verify-guards clause.aux-limsplit-cutoff-bldr)
+
+ (defthm forcing-logic.proofp-of-clause.aux-limsplit-cutoff-bldr
+   (implies (force (and (logic.formula-listp as)
+                        (logic.formula-listp bs)
+                        (consp bs)
+                        (logic.appealp proof)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vlhs (logic.conclusion proof))
+                               (logic.disjoin-formulas (app as bs)))
+                        ;; ---
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (clause.aux-limsplit-cutoff-bldr as bs proof) axioms thms atbl)
+                   t))))
+
+
+(defund clause.limsplit-cutoff-bldr (as bs proof)
+  ;;    (A1 v ... v An v B1 v ... v Bm)
+  ;;  -----------------------------------
+  ;;   (B1 v ... v Bm) v (An v ... v A1)
+  (declare (xargs :guard (and (logic.formula-listp as)
+                              (logic.formula-listp bs)
+                              (logic.appealp proof)
+                              (or (consp as) (consp bs))
+                              (equal (logic.conclusion proof)
+                                     (logic.disjoin-formulas (app as bs))))
+                  :verify-guards nil))
+  (if (consp as)
+      (if (consp bs)
+          (if (consp (cdr as))
+              ;; The usual case.  We have a proof of A1 v (A2 v ... v B1...Bm).  We rotate the A1 to
+              ;; the right with a commute-or and it becomes Q.  Then, we handle the rest with our
+              ;; aux-cutoff-builder.
+              (clause.aux-limsplit-cutoff-bldr (cdr as) bs (build.commute-or proof))
+            ;; An unusual case.  We have A1 v B1...Bm.  This is super easy -- we just need to commute
+            ;; the or.
+            (build.commute-or proof))
+        ;; An unusual case.  We have A1...An all by itself.  We can just reverse it.
+        (build.rev-disjunction as proof))
+    ;; An unusual case.  We have B1...Bm all by itself.  We don't need to do anything.
+    (logic.appeal-identity proof)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.limsplit-cutoff-bldr)))
+
+ (defthm forcing-logic.appealp-of-clause.limsplit-cutoff-bldr
+   (implies (force (and (logic.formula-listp as)
+                        (logic.formula-listp bs)
+                        (logic.appealp proof)
+                        (or (consp as) (consp bs))
+                        (equal (logic.conclusion proof)
+                               (logic.disjoin-formulas (app as bs)))))
+            (equal (logic.appealp (clause.limsplit-cutoff-bldr as bs proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.limsplit-cutoff-bldr
+   (implies (force (and (logic.formula-listp as)
+                        (logic.formula-listp bs)
+                        (logic.appealp proof)
+                        (or (consp as) (consp bs))
+                        (equal (logic.conclusion proof)
+                               (logic.disjoin-formulas (app as bs)))))
+            (equal (logic.conclusion (clause.limsplit-cutoff-bldr as bs proof))
+                   (cond ((and (consp as)
+                               (consp bs))
+                          (logic.por (logic.disjoin-formulas bs)
+                                     (logic.disjoin-formulas (rev as))))
+                         ((consp as)
+                          (logic.disjoin-formulas (rev as)))
+                         (t
+                          (logic.disjoin-formulas bs)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (verify-guards clause.limsplit-cutoff-bldr)
+
+ (defthm forcing-logic.proofp-of-clause.limsplit-cutoff-bldr
+   (implies (force (and (logic.formula-listp as)
+                        (logic.formula-listp bs)
+                        (logic.appealp proof)
+                        (or (consp as) (consp bs))
+                        (equal (logic.conclusion proof)
+                               (logic.disjoin-formulas (app as bs)))
+                        ;; ---
+                        (logic.proofp proof axioms thms atbl)))
+            (equal (logic.proofp (clause.limsplit-cutoff-bldr as bs proof) axioms thms atbl)
+                   t))))
+
+
+
+
+
+(defund clause.limsplit-cutoff-bldr-nice (todo done proof)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (true-listp todo)
+                              (logic.term-listp done)
+                              (logic.appealp proof)
+                              (or (consp todo) (consp done))
+                              (equal (logic.conclusion proof)
+                                     (clause.clause-formula (revappend done todo))))))
+  (clause.limsplit-cutoff-bldr (logic.term-list-formulas (fast-rev done))
+                               (logic.term-list-formulas todo)
+                               proof))
+
+(defthm forcing-logic.appealp-of-clause.limsplit-cutoff-bldr-nice
+  (implies (force (and (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (logic.appealp proof)
+                       (or (consp todo) (consp done))
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (app (rev done) todo)))))
+           (equal (logic.appealp (clause.limsplit-cutoff-bldr-nice todo done proof))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limsplit-cutoff-bldr-nice))))
+
+(defthm forcing-logic.conclusion-of-clause.limsplit-cutoff-bldr-nice
+  (implies (force (and (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (logic.appealp proof)
+                       (or (consp todo) (consp done))
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (app (rev done) todo)))))
+           (equal (logic.conclusion (clause.limsplit-cutoff-bldr-nice todo done proof))
+                  (clause.aux-split-goal todo done)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable clause.limsplit-cutoff-bldr-nice
+                                    clause.aux-split-goal))))
+
+(defthm forcing-logic.proofp-of-clause.limsplit-cutoff-bldr-nice
+  (implies (force (and (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (logic.appealp proof)
+                       (or (consp todo) (consp done))
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (app (rev done) todo)))
+                       (logic.proofp proof axioms thms atbl)))
+           (equal (logic.proofp (clause.limsplit-cutoff-bldr-nice todo done proof) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limsplit-cutoff-bldr-nice
+                                    clause.aux-split-goal))))
+
+
+
+
+
+
+(defund clause.limsplit-cutoff-bldr-nice-okp (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.limsplit-cutoff-bldr-nice)
+         (tuplep 2 extras)
+         (equal (len subproofs) 1)
+         (let ((todo (first extras))
+               (done (second extras))
+               (proof (first subproofs)))
+           (and (logic.term-listp todo)
+                (true-listp todo)
+                (logic.term-listp done)
+                (or (consp todo) (consp done))
+                (equal conclusion (clause.aux-split-goal todo done))
+                (equal (logic.conclusion proof)
+                       (clause.clause-formula (revappend done todo))))))))
+
+(defund clause.limsplit-cutoff-bldr-nice-high (todo done proof)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (true-listp todo)
+                              (logic.term-listp done)
+                              (logic.appealp proof)
+                              (or (consp todo) (consp done))
+                              (equal (logic.conclusion proof)
+                                     (clause.clause-formula (revappend done todo))))))
+  (logic.appeal 'clause.limsplit-cutoff-bldr-nice
+                (clause.clause-formula (revappend done todo))
+                (list proof)
+                (list todo done)))
+
+(defobligations clause.limsplit-cutoff-bldr-nice-okp
+  (clause.limsplit-cutoff-bldr-nice))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.limsplit-cutoff-bldr-nice-okp
+                           clause.limsplit-cutoff-bldr-nice-high)))
+
+ (defthm booleanp-of-clause.limsplit-cutoff-bldr-nice-okp
+   (equal (booleanp (clause.limsplit-cutoff-bldr-nice-okp x))
+          t))
+
+ (defthm clause.limsplit-cutoff-bldr-nice-okp-of-logic.appeal-identity
+   (equal (clause.limsplit-cutoff-bldr-nice-okp (logic.appeal-identity x))
+          (clause.limsplit-cutoff-bldr-nice-okp x)))
+
+ (defthmd lemma-1-for-soundness-of-clause.limsplit-cutoff-bldr-nice-okp
+   (implies (and (clause.limsplit-cutoff-bldr-nice-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (clause.limsplit-cutoff-bldr-nice (first (logic.extras x))
+                                                      (second (logic.extras x))
+                                                      (logic.provable-witness (logic.conclusion (first (logic.subproofs x)))
+                                                                              axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.limsplit-cutoff-bldr-nice-okp
+   (implies (and (clause.limsplit-cutoff-bldr-nice-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.limsplit-cutoff-bldr-nice-okp))
+            (equal (logic.proofp
+                    (clause.limsplit-cutoff-bldr-nice (first (logic.extras x))
+                                                      (second (logic.extras x))
+                                                      (logic.provable-witness (logic.conclusion (first (logic.subproofs x)))
+                                                                              axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.limsplit-cutoff-bldr-nice-okp
+   (implies (and (clause.limsplit-cutoff-bldr-nice-okp x)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.limsplit-cutoff-bldr-nice-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.limsplit-cutoff-bldr-nice-okp
+                               lemma-2-for-soundness-of-clause.limsplit-cutoff-bldr-nice-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.limsplit-cutoff-bldr-nice (first (logic.extras x))
+                                                                  (second (logic.extras x))
+                                                                  (logic.provable-witness (logic.conclusion (first (logic.subproofs x)))
+                                                                                          axioms thms atbl)))))))))
+
+
+
+
+
+(defund clause.aux-limsplit-bldr (todo done proofs n)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (true-listp todo)
+                              (or (consp todo) (consp done))
+                              (natp n)
+                              (logic.appeal-listp proofs)
+                              (subsetp (clause.clause-list-formulas (clause.aux-limsplit todo done n))
+                                       (logic.strip-conclusions proofs)))
+                  :verify-guards nil
+                  :measure (clause.split-count-list todo)))
+  (if (zp n)
+      (clause.limsplit-cutoff-bldr-nice todo done
+                                        (logic.find-proof (clause.clause-formula (revappend done todo)) proofs))
+    (if (consp todo)
+        (let ((t1 (car todo)))
+          (if (clause.negative-termp t1)
+              (let ((guts (clause.negative-term-guts t1)))
+                (if (clause.negative-termp guts)
+                    (clause.aux-split-double-negate t1 (cdr todo) done
+                                                    (clause.aux-limsplit-bldr (cons (clause.negative-term-guts guts) (cdr todo))
+                                                                              done proofs n))
+                  (if (and (logic.functionp guts)
+                           (equal (logic.function-name guts) 'if)
+                           (equal (len (logic.function-args guts)) 3))
+                      (let ((args (logic.function-args guts)))
+                        (let ((a      (first args))
+                              (not-a  (logic.function 'not (list (first args))))
+                              (not-b  (logic.function 'not (list (second args))))
+                              (not-c  (logic.function 'not (list (third args))))
+                              (rest   (cdr todo)))
+                          (let ((triv1 (clause.aux-split-trivial-branchp not-a not-b rest done))
+                                (triv2 (clause.aux-split-trivial-branchp a not-c rest done)))
+                            (cond ((and triv1 triv2)
+                                   (clause.aux-split-negated-if t1 rest done
+                                                                (clause.aux-split-trivial-branch-bldr not-a not-b rest done)
+                                                                (clause.aux-split-trivial-branch-bldr a not-c rest done)))
+                                  (triv1
+                                   (clause.aux-split-negated-if t1 rest done
+                                                                (clause.aux-split-trivial-branch-bldr not-a not-b rest done)
+                                                                (clause.aux-limsplit-bldr (cons a (cons not-c rest)) done proofs n)))
+                                  (triv2
+                                   (clause.aux-split-negated-if t1 rest done
+                                                                (clause.aux-limsplit-bldr (cons not-a (cons not-b rest)) done proofs n)
+                                                                (clause.aux-split-trivial-branch-bldr a not-c rest done)))
+                                  (t
+                                   (clause.aux-split-negated-if t1 rest done
+                                                                (clause.aux-limsplit-bldr (cons not-a (cons not-b rest)) done proofs (- n 1))
+                                                                (clause.aux-limsplit-bldr (cons a (cons not-c rest)) done proofs (- n 1))))))))
+
+                    (clause.aux-split-negative-default t1 (cdr todo) done
+                                                       (clause.aux-limsplit-bldr (cdr todo)
+                                                                                 (cons (logic.function 'not (list guts)) done)
+                                                                                 proofs n)))))
+            (if (and (logic.functionp t1)
+                     (equal (logic.function-name t1) 'if)
+                     (equal (len (logic.function-args t1)) 3))
+                (let ((args (logic.function-args t1)))
+                  (let ((a     (first args))
+                        (not-a (logic.function 'not (list (first args))))
+                        (b     (second args))
+                        (c     (third args))
+                        (rest  (cdr todo)))
+                    (let ((triv1 (clause.aux-split-trivial-branchp not-a b rest done))
+                          (triv2 (clause.aux-split-trivial-branchp a c rest done)))
+                      (cond ((and triv1 triv2)
+                             (clause.aux-split-positive-if t1 rest done
+                                                           (clause.aux-split-trivial-branch-bldr not-a b rest done)
+                                                           (clause.aux-split-trivial-branch-bldr a c rest done)))
+                            (triv1
+                             (clause.aux-split-positive-if t1 rest done
+                                                           (clause.aux-split-trivial-branch-bldr not-a b rest done)
+                                                           (clause.aux-limsplit-bldr (cons a (cons c rest)) done proofs n)))
+                            (triv2
+                             (clause.aux-split-positive-if t1 rest done
+                                                           (clause.aux-limsplit-bldr (cons not-a (cons b rest)) done proofs n)
+                                                           (clause.aux-split-trivial-branch-bldr a c rest done)))
+                            (t
+                             (clause.aux-split-positive-if t1 rest done
+                                                           (clause.aux-limsplit-bldr (cons not-a (cons b rest)) done proofs (- n 1))
+                                                           (clause.aux-limsplit-bldr (cons a (cons c rest)) done proofs (- n 1))))))))
+
+              (clause.aux-split-positive-default t1 (cdr todo) done
+                                                 (clause.aux-limsplit-bldr (cdr todo) (cons t1 done) proofs n)))))
+
+      (logic.find-proof (clause.clause-formula done) proofs))))
+
+(defobligations clause.aux-limsplit-bldr
+  (clause.aux-split-double-negate
+   clause.aux-split-negated-if
+   clause.aux-split-negative-default
+   clause.aux-split-positive-if
+   clause.aux-split-positive-default
+   clause.aux-split-trivial-branch-bldr))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-limsplit-bldr
+                           clause.aux-split-goal-when-not-consp-of-todo
+                           )))
+
+ (defthm lemma-for-forcing-logic.appealp-of-clause.aux-limsplit-bldr
+   (implies (and (logic.term-listp todo)
+                 (logic.term-listp done)
+                 (true-listp todo)
+                 (or (consp todo) (consp done))
+                 (logic.appeal-listp proofs)
+                 (subsetp (clause.clause-list-formulas (clause.aux-limsplit todo done n))
+                          (logic.strip-conclusions proofs)))
+            (and (logic.appealp (clause.aux-limsplit-bldr todo done proofs n))
+                 (equal (logic.conclusion (clause.aux-limsplit-bldr todo done proofs n))
+                        (clause.aux-split-goal todo done))))
+   :rule-classes nil
+   :hints(("Goal"
+           :induct (clause.aux-limsplit-bldr todo done proofs n)
+           :expand ((clause.aux-limsplit todo done n)
+                    (clause.aux-limsplit nil done n))
+           )))
+
+ (defthm forcing-logic.appealp-of-clause.aux-limsplit-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (true-listp todo)
+                        (or (consp todo) (consp done))
+                        (logic.appeal-listp proofs)
+                        (subsetp (clause.clause-list-formulas (clause.aux-limsplit todo done n))
+                                 (logic.strip-conclusions proofs))))
+            (equal (logic.appealp (clause.aux-limsplit-bldr todo done proofs n))
+                   t))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-clause.aux-limsplit-bldr)))))
+
+ ;; We want to keep working with clause.aux-limsplit-goal, for now.
+ (defthmd lemma-for-forcing-logic.proofp-of-clause.aux-limsplit-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (true-listp todo)
+                        (or (consp todo) (consp done))
+                        (logic.appeal-listp proofs)
+                        (subsetp (clause.clause-list-formulas (clause.aux-limsplit todo done n))
+                                 (logic.strip-conclusions proofs))))
+            (equal (logic.conclusion (clause.aux-limsplit-bldr todo done proofs n))
+                   (clause.aux-split-goal todo done)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-clause.aux-limsplit-bldr)))))
+
+ (verify-guards clause.aux-limsplit-bldr
+                :hints(("Goal"
+                        :in-theory (enable lemma-for-forcing-logic.proofp-of-clause.aux-limsplit-bldr)
+                        :expand ((clause.aux-limsplit todo done n)
+                                 (clause.aux-limsplit nil done n))
+                        )))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-limsplit-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (true-listp todo)
+                        (or (consp todo) (consp done))
+                        (logic.appeal-listp proofs)
+                        (subsetp (clause.clause-list-formulas (clause.aux-limsplit todo done n))
+                                 (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.term-list-atblp todo atbl)
+                        (logic.term-list-atblp done atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations clause.aux-limsplit-bldr)
+                        ))
+            (equal (logic.proofp (clause.aux-limsplit-bldr todo done proofs n) axioms thms atbl)
+                   t))
+   :hints(("Goal"
+           :induct (clause.aux-limsplit-bldr todo done proofs n)
+           :in-theory (enable lemma-for-forcing-logic.proofp-of-clause.aux-limsplit-bldr)
+           :expand ((clause.aux-limsplit todo done n)
+                    (clause.aux-limsplit nil done n))
+           )))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-limsplit-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (true-listp todo)
+                        (or (consp todo) (consp done))
+                        (logic.appeal-listp proofs)
+                        (subsetp (clause.clause-list-formulas (clause.aux-limsplit todo done n))
+                                 (logic.strip-conclusions proofs))))
+            (equal (logic.conclusion (clause.aux-limsplit-bldr todo done proofs n))
+                   (cond ((and (consp todo)
+                               (consp done))
+                          (logic.por (clause.clause-formula todo)
+                                     (clause.clause-formula done)))
+                         ((consp todo)
+                          (clause.clause-formula todo))
+                         (t
+                          (clause.clause-formula done)))))
+   :hints(("Goal"
+           :in-theory (enable clause.aux-split-goal)
+           :use ((:instance lemma-for-forcing-logic.proofp-of-clause.aux-limsplit-bldr))
+           :expand (clause.aux-limsplit nil done n)
+           ))))
+
+
+
+
+
+
+(defund clause.simple-limsplit-bldr (clause proofs n)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (true-listp clause)
+                              (natp n)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (clause.simple-limsplit clause n))
+                                     (logic.strip-conclusions proofs)))
+                  :guard-hints (("Goal" :in-theory (enable clause.simple-limsplit)))))
+  (clause.aux-limsplit-bldr clause nil proofs n))
+
+(defobligations clause.simple-limsplit-bldr
+  (clause.aux-limsplit-bldr))
+
+(defthm forcing-logic.appealp-of-clause.simple-limsplit-bldr
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (true-listp clause)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.simple-limsplit clause n))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appealp (clause.simple-limsplit-bldr clause proofs n))
+                   t))
+   :hints(("Goal" :in-theory (enable clause.simple-limsplit
+                                     clause.simple-limsplit-bldr))))
+
+(defthm forcing-logic.conclusion-of-clause.simple-limsplit-bldr
+   (implies (force (and (logic.term-listp clause)
+                        (true-listp clause)
+                        (consp clause)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.simple-limsplit clause n))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.conclusion (clause.simple-limsplit-bldr clause proofs n))
+                   (clause.clause-formula clause)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :in-theory (enable clause.simple-limsplit
+                                     clause.simple-limsplit-bldr))))
+
+(defthm@ forcing-logic.proofp-of-clause.simple-limsplit-bldr
+   (implies (force (and (logic.term-listp clause)
+                        (true-listp clause)
+                        (consp clause)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.simple-limsplit clause n))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.term-list-atblp clause atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations clause.simple-limsplit-bldr)
+                        ))
+            (equal (logic.proofp (clause.simple-limsplit-bldr clause proofs n) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable clause.simple-limsplit
+                                     clause.simple-limsplit-bldr))))
+
+
+
+(defund clause.simple-limsplit-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.simple-limsplit-bldr)
+         (tuplep 2 extras)
+         (let ((clause (first extras))
+               (n      (second extras)))
+           (and (consp clause)
+                (true-listp clause)
+                (logic.term-listp clause)
+                (logic.term-list-atblp clause atbl)
+                (natp n)
+                (equal (clause.clause-list-formulas (clause.simple-limsplit clause n))
+                       (logic.strip-conclusions subproofs))
+                (equal conclusion
+                       (clause.clause-formula clause)))))))
+
+(defund clause.simple-limsplit-bldr-high (clause proofs n)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (true-listp clause)
+                              (natp n)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (clause.simple-limsplit clause n))
+                                     (logic.strip-conclusions proofs)))))
+  (logic.appeal 'clause.simple-limsplit-bldr
+                (clause.clause-formula clause)
+                (list-fix proofs)
+                (list clause n)))
+
+(defobligations clause.simple-limsplit-bldr-okp
+  (clause.simple-limsplit-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.simple-limsplit-bldr-okp)))
+
+ (defthm booleanp-of-clause.simple-limsplit-bldr-okp
+   (equal (booleanp (clause.simple-limsplit-bldr-okp x atbl))
+          t))
+
+ (defthm clause.simple-limsplit-bldr-okp-of-logic.appeal-identity
+   (equal (clause.simple-limsplit-bldr-okp (logic.appeal-identity x) atbl)
+          (clause.simple-limsplit-bldr-okp x atbl)))
+
+ (defthmd lemma-1-for-soundness-of-clause.simple-limsplit-bldr-okp
+   (implies (and (clause.simple-limsplit-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (clause.simple-limsplit-bldr (first (logic.extras x))
+                                                 (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                              axioms thms atbl)
+                                                 (second (logic.extras x))))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.simple-limsplit-bldr-okp
+   (implies (and (clause.simple-limsplit-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.simple-limsplit-bldr-okp)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'if atbl)) 3))
+            (equal (logic.proofp
+                    (clause.simple-limsplit-bldr (first (logic.extras x))
+                                                 (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                              axioms thms atbl)
+                                                 (second (logic.extras x)))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.simple-limsplit-bldr-okp
+   (implies (and (clause.simple-limsplit-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.simple-limsplit-bldr-okp)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.simple-limsplit-bldr-okp
+                               lemma-2-for-soundness-of-clause.simple-limsplit-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.simple-limsplit-bldr
+                                 (first (logic.extras x))
+                                 (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                              axioms thms atbl)
+                                 (second (logic.extras x))))))))))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/aux-limsplit.lisp acl2-6.3/books/milawa/ACL2/clauses/aux-limsplit.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/aux-limsplit.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/aux-limsplit.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,366 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund clause.aux-limsplit (todo done n)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (true-listp todo)
+                              (natp n))
+                  :verify-guards nil
+                  :measure (clause.split-count-list todo)))
+  (if (zp n)
+      ;; This is a tricky, important ordering.  See the builder and its cutoff builder for
+      ;; the messy details.
+      (list (revappend done todo))
+    (if (consp todo)
+        (let* ((negativep (clause.negative-termp (car todo)))
+               (guts      (if negativep (clause.negative-term-guts (car todo)) (car todo))))
+          (cond
+
+           ((and negativep (clause.negative-termp guts))
+            ;; Cancel (not (not a))
+            (clause.aux-limsplit (cons (clause.negative-term-guts guts) (cdr todo)) done
+                                 ;; Don't decrement n -- we haven't split anything!
+                                 n))
+
+           ((and (logic.functionp guts)
+                 (equal (logic.function-name guts) 'if)
+                 (equal (len (logic.function-args guts)) 3))
+            (let ((args (logic.function-args guts)))
+              (if negativep
+                  ;; The first literal is (not (if a b c)).
+                  ;; New clause 1: (not a) v (not b) v rest
+                  ;; New clause 2: a v (not c) v rest
+                  (let ((a      (first args))
+                        (not-a  (logic.function 'not (list (first args))))
+                        (not-b  (logic.function 'not (list (second args))))
+                        (not-c  (logic.function 'not (list (third args))))
+                        (rest   (cdr todo)))
+                    (let ((triv1 (clause.aux-split-trivial-branchp not-a not-b rest done))
+                          (triv2 (clause.aux-split-trivial-branchp a not-c rest done)))
+                      (cond ((and triv1 triv2)
+                             nil)
+                            (triv1
+                             ;; Jared's guess.  We probably don't want to decrease n here, because
+                             ;; even though we've split an if, one of the branches was trivial and
+                             ;; so really we're still dealing with the same number of clauses as
+                             ;; before.  So, this seems more to me like cancelling double negatives
+                             ;; or normalizing nots or something, rather than actual splitting.
+                             (clause.aux-limsplit (cons a (cons not-c rest)) done n))
+                            (triv2
+                             (clause.aux-limsplit (cons not-a (cons not-b rest)) done n))
+                            (t
+                             ;; But in the case where we really do split, decrease n!
+                             (revappend (clause.aux-limsplit (cons not-a (cons not-b rest)) done (- n 1))
+                                        (clause.aux-limsplit (cons a (cons not-c rest)) done (- n 1)))))))
+                ;; The first literal is (if a b c).
+                ;; New clause 1: (not a) v b v rest
+                ;; New clause 2: a v c v rest
+                (let ((a     (first args))
+                      (not-a (logic.function 'not (list (first args))))
+                      (b     (second args))
+                      (c     (third args))
+                      (rest  (cdr todo)))
+                  (let ((triv1 (clause.aux-split-trivial-branchp not-a b rest done))
+                        (triv2 (clause.aux-split-trivial-branchp a c rest done)))
+                    (cond ((and triv1 triv2)
+                           nil)
+                          (triv1
+                           (clause.aux-limsplit (cons a (cons c rest)) done n))
+                          (triv2
+                           ;; BOZO consider not decreasing n
+                           (clause.aux-limsplit (cons not-a (cons b rest)) done n))
+                          (t
+                           (revappend (clause.aux-limsplit (cons not-a (cons b rest)) done (- n 1))
+                                      (clause.aux-limsplit (cons a (cons c rest)) done (- n 1))))))))))
+
+           (t
+            ;; We can't split this literal, but we'll normalize it to "(not x)" if it is
+            ;; some other negative-termp variant of not.
+            (clause.aux-limsplit (cdr todo)
+                                 (cons (if negativep
+                                           (logic.function 'not (list guts))
+                                         (car todo))
+                                       done)
+                                 ;; Don't decrement n -- we haven't split anything!
+                                 n))))
+      (list done))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-limsplit)))
+
+ (defthm true-listp-of-clause.aux-limsplit
+   (implies (force (true-listp todo))
+            (equal (true-listp (clause.aux-limsplit todo done n))
+                   t)))
+
+;;  (defthm consp-of-clause.aux-limsplit
+;;    (implies (force (true-listp todo))
+;;             (equal (consp (clause.aux-limsplit todo done n))
+;;                    t)))
+
+;;  (defthm clause.aux-limsplit-under-iff
+;;    (implies (force (true-listp todo))
+;;             (iff (clause.aux-limsplit todo done n)
+;;                  t)))
+
+ (defthm forcing-term-list-listp-of-clause.aux-limsplit
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (true-listp todo)))
+            (equal (logic.term-list-listp (clause.aux-limsplit todo done n))
+                   t)))
+
+ (defthm forcing-term-list-list-atblp-of-clause.aux-limsplit
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-list-atblp todo atbl)
+                        (logic.term-list-atblp done atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (true-listp todo)))
+            (equal (logic.term-list-list-atblp (clause.aux-limsplit todo done n) atbl)
+                   t)))
+
+ (verify-guards clause.aux-limsplit)
+
+ (defthm forcing-cons-listp-of-clause.aux-limsplit
+   (implies (force (and (or (consp todo)
+                            (consp done))
+                        (true-listp todo)))
+            (equal (cons-listp (clause.aux-limsplit todo done n))
+                   t))))
+
+
+
+
+
+;; (defthmd clause.aux-limsplit-when-double-negative
+;;   (implies (and (not (zp n))
+;;                 (clause.negative-termp a)
+;;                 (clause.negative-termp (clause.negative-term-guts a)))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (clause.aux-limsplit (cons (clause.negative-term-guts (clause.negative-term-guts a)) x) done n)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-negative-1
+;;   (implies (and (not (zp n))
+;;                 (clause.negative-termp a)
+;;                 (not (clause.negative-termp (clause.negative-term-guts a)))
+;;                 (not (logic.functionp (clause.negative-term-guts a))))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (clause.aux-limsplit x (cons (logic.function 'not (list (clause.negative-term-guts a))) done) n)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-negative-2
+;;   (implies (and (not (zp n))
+;;                 (clause.negative-termp a)
+;;                 (not (clause.negative-termp (clause.negative-term-guts a)))
+;;                 (not (equal (logic.function-name (clause.negative-term-guts a)) 'if)))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (clause.aux-limsplit x (cons (logic.function 'not (list (clause.negative-term-guts a))) done) n)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-negative-3
+;;   (implies (and (not (zp n))
+;;                 (clause.negative-termp a)
+;;                 (not (clause.negative-termp (clause.negative-term-guts a)))
+;;                 (not (equal (len (logic.function-args (clause.negative-term-guts a))) 3)))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (clause.aux-limsplit x (cons (logic.function 'not (list (clause.negative-term-guts a))) done) n)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-negative-4
+;;   (implies (and (not (zp n))
+;;                 (clause.negative-termp a)
+;;                 (not (clause.negative-termp (clause.negative-term-guts a)))
+;;                 (logic.functionp (clause.negative-term-guts a))
+;;                 (equal (logic.function-name (clause.negative-term-guts a)) 'if)
+;;                 (equal (len (logic.function-args (clause.negative-term-guts a))) 3)
+;;                 (force (true-listp x)))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (revappend (clause.aux-limsplit (cons (logic.function 'not (list (first (logic.function-args (clause.negative-term-guts a)))))
+;;                                                         (cons (logic.function 'not (list (second (logic.function-args (clause.negative-term-guts a)))))
+;;                                                               x))
+;;                                                   done
+;;                                                   (- n 1))
+;;                              (clause.aux-limsplit (cons (first (logic.function-args (clause.negative-term-guts a)))
+;;                                                         (cons (logic.function 'not (list (third (logic.function-args (clause.negative-term-guts a)))))
+;;                                                               x))
+;;                                                   done
+;;                                                   (- n 1)))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-positive-1
+;;   (implies (and (not (zp n))
+;;                 (not (clause.negative-termp a))
+;;                 (not (logic.functionp a)))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (clause.aux-limsplit x (cons a done) n)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-positive-2
+;;   (implies (and (not (zp n))
+;;                 (not (clause.negative-termp a))
+;;                 (not (equal (logic.function-name a) 'if)))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (clause.aux-limsplit x (cons a done) n)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-positive-3
+;;   (implies (and (not (zp n))
+;;                 (not (clause.negative-termp a))
+;;                 (not (equal (len (logic.function-args a)) 3)))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (clause.aux-limsplit x (cons a done) n)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-positive-4
+;;   (implies (and (not (zp n))
+;;                 (not (clause.negative-termp a))
+;;                 (logic.functionp a)
+;;                 (equal (logic.function-name a) 'if)
+;;                 (equal (len (logic.function-args a)) 3)
+;;                 (force (true-listp x)))
+;;            (equal (clause.aux-limsplit (cons a x) done n)
+;;                   (revappend (clause.aux-limsplit (cons (logic.function 'not (list (first (logic.function-args a))))
+;;                                                         (cons (second (logic.function-args a))
+;;                                                               x))
+;;                                                   done
+;;                                                   (- n 1))
+;;                              (clause.aux-limsplit (cons (first (logic.function-args a))
+;;                                                         (cons (third (logic.function-args a))
+;;                                                               x))
+;;                                                   done
+;;                                                   (- n 1)))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-not-consp
+;;   (implies (and (not (zp n))
+;;                 (not (consp todo))
+;;                 (force (true-listp todo)))
+;;            (equal (clause.aux-limsplit todo done n)
+;;                   (list done)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (defthmd clause.aux-limsplit-when-zp
+;;   (implies (and (zp n)
+;;                 (force (true-listp todo)))
+;;            (equal (clause.aux-limsplit todo done n)
+;;                   (list (revappend done todo))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+;; (deftheory clause.aux-limsplit-openers
+;;   '(clause.aux-limsplit-when-double-negative
+;;     clause.aux-limsplit-when-negative-1
+;;     clause.aux-limsplit-when-negative-1
+;;     clause.aux-limsplit-when-negative-2
+;;     clause.aux-limsplit-when-negative-3
+;;     clause.aux-limsplit-when-negative-4
+;;     clause.aux-limsplit-when-positive-1
+;;     clause.aux-limsplit-when-positive-2
+;;     clause.aux-limsplit-when-positive-3
+;;     clause.aux-limsplit-when-positive-4
+;;     clause.aux-limsplit-when-not-consp
+;;     clause.aux-limsplit-when-zp))
+
+
+
+
+
+(definlined clause.simple-limsplit (clause n)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (true-listp clause)
+                              (consp clause)
+                              (natp n))))
+  (clause.aux-limsplit clause nil n))
+
+(defthm true-listp-of-clause.simple-limsplit
+  (implies (force (true-listp clause))
+           (equal (true-listp (clause.simple-limsplit clause n))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-limsplit))))
+
+;; (defthm consp-of-clause.simple-limsplit
+;;   (implies (force (true-listp clause))
+;;            (equal (consp (clause.simple-limsplit clause n))
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable clause.simple-limsplit))))
+
+;; (defthm clause.simple-limsplit-under-iff
+;;   (implies (force (true-listp clause))
+;;            (iff (clause.simple-limsplit clause n)
+;;                 t))
+;;   :hints(("Goal" :in-theory (enable clause.simple-limsplit))))
+
+(defthm forcing-term-list-listp-of-clause.simple-limsplit
+  (implies (force (and (logic.term-listp clause)
+                       (true-listp clause)))
+           (equal (logic.term-list-listp (clause.simple-limsplit clause n))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-limsplit))))
+
+(defthm forcing-term-list-list-atblp-of-clause.simple-limsplit
+  (implies (force (and (logic.term-listp clause)
+                       (true-listp clause)
+                       (logic.term-list-atblp clause atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-list-list-atblp (clause.simple-limsplit clause n) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-limsplit))))
+
+(defthm forcing-cons-listp-of-clause.simple-limsplit
+  (implies (force (and (consp clause)
+                       (true-listp clause)))
+           (equal (cons-listp (clause.simple-limsplit clause n))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-limsplit))))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/aux-split-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/aux-split-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/aux-split-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/aux-split-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,385 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split-support")
+(include-book "aux-split")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund clause.aux-split-bldr (todo done proofs)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (or (consp todo) (consp done))
+                              (logic.appeal-listp proofs)
+                              (subsetp (clause.clause-list-formulas (clause.aux-split todo done))
+                                       (logic.strip-conclusions proofs)))
+                  :verify-guards nil
+                  :measure (clause.split-count-list todo)))
+  (if (consp todo)
+      (let ((t1 (car todo)))
+        (if (clause.negative-termp t1)
+            (let ((guts (clause.negative-term-guts t1)))
+
+              (cond ((clause.negative-termp guts)
+                     (clause.aux-split-double-negate t1 (cdr todo) done
+                                                     (clause.aux-split-bldr (cons (clause.negative-term-guts guts) (cdr todo))
+                                                                            done proofs)))
+                    ((and (logic.functionp guts)
+                          (equal (logic.function-name guts) 'if)
+                          (equal (len (logic.function-args guts)) 3))
+                     (let ((args (logic.function-args guts)))
+                       (let ((a      (first args))
+                             (not-a  (logic.function 'not (list (first args))))
+                             (not-b  (logic.function 'not (list (second args))))
+                             (not-c  (logic.function 'not (list (third args))))
+                             (rest   (cdr todo)))
+                         (let ((triv1 (clause.aux-split-trivial-branchp not-a not-b rest done))
+                               (triv2 (clause.aux-split-trivial-branchp a not-c rest done)))
+                           (cond ((and triv1 triv2)
+                                  (clause.aux-split-negated-if t1 rest done
+                                                               (clause.aux-split-trivial-branch-bldr not-a not-b rest done)
+                                                               (clause.aux-split-trivial-branch-bldr a not-c rest done)))
+                                 (triv1
+                                  (clause.aux-split-negated-if t1 rest done
+                                                               (clause.aux-split-trivial-branch-bldr not-a not-b rest done)
+                                                               (clause.aux-split-bldr (cons a (cons not-c rest)) done proofs)))
+                                 (triv2
+                                  (clause.aux-split-negated-if t1 rest done
+                                                               (clause.aux-split-bldr (cons not-a (cons not-b rest)) done proofs)
+                                                               (clause.aux-split-trivial-branch-bldr a not-c rest done)))
+                                 (t
+                                  (clause.aux-split-negated-if t1 rest done
+                                                               (clause.aux-split-bldr (cons not-a (cons not-b rest)) done proofs)
+                                                               (clause.aux-split-bldr (cons a (cons not-c rest)) done proofs))))))))
+
+                    (t
+                     (clause.aux-split-negative-default t1 (cdr todo) done
+                                                        (clause.aux-split-bldr (cdr todo)
+                                                                               (cons (logic.function 'not (list guts)) done)
+                                                                               proofs)))))
+          (cond ((and (logic.functionp t1)
+                      (equal (logic.function-name t1) 'if)
+                      (equal (len (logic.function-args t1)) 3))
+                 (let ((args (logic.function-args t1)))
+                   (let ((a     (first args))
+                         (not-a (logic.function 'not (list (first args))))
+                         (b     (second args))
+                         (c     (third args))
+                         (rest  (cdr todo)))
+                     (let ((triv1 (clause.aux-split-trivial-branchp not-a b rest done))
+                           (triv2 (clause.aux-split-trivial-branchp a c rest done)))
+                       (cond ((and triv1 triv2)
+                              (clause.aux-split-positive-if t1 rest done
+                                                            (clause.aux-split-trivial-branch-bldr not-a b rest done)
+                                                            (clause.aux-split-trivial-branch-bldr a c rest done)))
+                             (triv1
+                              (clause.aux-split-positive-if t1 rest done
+                                                            (clause.aux-split-trivial-branch-bldr not-a b rest done)
+                                                            (clause.aux-split-bldr (cons a (cons c rest)) done proofs)))
+                             (triv2
+                              (clause.aux-split-positive-if t1 rest done
+                                                            (clause.aux-split-bldr (cons not-a (cons b rest)) done proofs)
+                                                            (clause.aux-split-trivial-branch-bldr a c rest done)))
+                             (t
+                              (clause.aux-split-positive-if t1 rest done
+                                                            (clause.aux-split-bldr (cons not-a (cons b rest)) done proofs)
+                                                            (clause.aux-split-bldr (cons a (cons c rest)) done proofs))))))))
+
+                (t
+                 (clause.aux-split-positive-default t1 (cdr todo) done
+                                                    (clause.aux-split-bldr (cdr todo) (cons t1 done) proofs))))))
+
+    (logic.find-proof (clause.clause-formula done) proofs)))
+
+(defobligations clause.aux-split-bldr
+  (clause.aux-split-double-negate
+   clause.aux-split-negated-if
+   clause.aux-split-negative-default
+   clause.aux-split-positive-if
+   clause.aux-split-positive-default
+   clause.aux-split-trivial-branch-bldr))
+
+(encapsulate
+ ()
+ ;; Now we can carry out the correctness proof entirely using the
+ ;; clause.aux-split-goal abstraction. Then, we get rid of it in the final
+ ;; conclusion proof, so nobody has to deal with it except us.
+
+ (local (in-theory (enable clause.aux-split-bldr
+                           clause.aux-split-goal-when-not-consp-of-todo)))
+
+ (defthm lemma-for-forcing-logic.appealp-of-clause.aux-split-bldr
+   (implies (and (logic.term-listp todo)
+                 (logic.term-listp done)
+                 (or (consp todo) (consp done))
+                 (logic.appeal-listp proofs)
+                 (subsetp (clause.clause-list-formulas (clause.aux-split todo done))
+                          (logic.strip-conclusions proofs)))
+            (and (logic.appealp (clause.aux-split-bldr todo done proofs))
+                 (equal (logic.conclusion (clause.aux-split-bldr todo done proofs))
+                        (clause.aux-split-goal todo done))))
+   :rule-classes nil
+   :hints(("Goal"
+           :induct (clause.aux-split-bldr todo done proofs)
+           :expand (clause.aux-split todo done))))
+
+ (defthm forcing-logic.appealp-of-clause.aux-split-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appeal-listp proofs)
+                        (subsetp (clause.clause-list-formulas (clause.aux-split todo done))
+                                 (logic.strip-conclusions proofs))))
+            (equal (logic.appealp (clause.aux-split-bldr todo done proofs))
+                   t))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-clause.aux-split-bldr)))))
+
+ ;; We want to keep working with clause.aux-split-goal, for now.
+ (defthmd lemma-for-forcing-logic.proofp-of-clause.aux-split-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appeal-listp proofs)
+                        (subsetp (clause.clause-list-formulas (clause.aux-split todo done))
+                                 (logic.strip-conclusions proofs))))
+            (equal (logic.conclusion (clause.aux-split-bldr todo done proofs))
+                   (clause.aux-split-goal todo done)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-clause.aux-split-bldr)))))
+
+ (verify-guards clause.aux-split-bldr
+                :hints(("Goal"
+                        :in-theory (enable lemma-for-forcing-logic.proofp-of-clause.aux-split-bldr)
+                        :expand (clause.aux-split todo done)
+                        )))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-split-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appeal-listp proofs)
+                        (subsetp (clause.clause-list-formulas (clause.aux-split todo done))
+                                 (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.term-list-atblp todo atbl)
+                        (logic.term-list-atblp done atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations clause.aux-split-bldr)
+                        ))
+            (equal (logic.proofp (clause.aux-split-bldr todo done proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal"
+           :induct (clause.aux-split-bldr todo done proofs)
+           :in-theory (enable lemma-for-forcing-logic.proofp-of-clause.aux-split-bldr)
+           :expand (clause.aux-split todo done)
+           )))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-split-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appeal-listp proofs)
+                        (subsetp (clause.clause-list-formulas (clause.aux-split todo done))
+                                 (logic.strip-conclusions proofs))))
+            (equal (logic.conclusion (clause.aux-split-bldr todo done proofs))
+                   (cond ((and (consp todo)
+                               (consp done))
+                          (logic.por (clause.clause-formula todo)
+                                     (clause.clause-formula done)))
+                         ((consp todo)
+                          (clause.clause-formula todo))
+                         (t
+                          (clause.clause-formula done)))))
+   :hints(("Goal"
+           :in-theory (enable clause.aux-split-goal)
+           :use ((:instance lemma-for-forcing-logic.proofp-of-clause.aux-split-bldr))))))
+
+
+
+
+
+
+(defund clause.simple-split-bldr (clause proofs)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (clause.simple-split clause))
+                                     (logic.strip-conclusions proofs)))
+                  :guard-hints (("Goal" :in-theory (enable clause.simple-split)))))
+  (clause.aux-split-bldr clause nil proofs))
+
+(defobligations clause.simple-split-bldr
+  (clause.aux-split-bldr))
+
+(defthm forcing-logic.appealp-of-clause.simple-split-bldr
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.simple-split clause))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appealp (clause.simple-split-bldr clause proofs))
+                   t))
+   :hints(("Goal" :in-theory (enable clause.simple-split
+                                     clause.simple-split-bldr))))
+
+(defthm forcing-logic.conclusion-of-clause.simple-split-bldr
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.simple-split clause))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.conclusion (clause.simple-split-bldr clause proofs))
+                   (clause.clause-formula clause)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :in-theory (enable clause.simple-split
+                                     clause.simple-split-bldr))))
+
+(defthm@ forcing-logic.proofp-of-clause.simple-split-bldr
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.simple-split clause))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.term-list-atblp clause atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations clause.simple-split-bldr)
+                        ))
+            (equal (logic.proofp (clause.simple-split-bldr clause proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable clause.simple-split
+                                     clause.simple-split-bldr))))
+
+
+(defund clause.simple-split-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    ;; Extras holds the input clause to split.
+    (and (equal method 'clause.simple-split-bldr)
+         (logic.term-listp extras)
+         (logic.term-list-atblp extras atbl)
+         (consp extras)
+         (equal (clause.clause-list-formulas (clause.simple-split extras))
+                (logic.strip-conclusions subproofs))
+         (equal conclusion
+                (clause.clause-formula extras)))))
+
+(defund clause.simple-split-bldr-high (clause proofs)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (clause.simple-split clause))
+                                     (logic.strip-conclusions proofs)))))
+  (logic.appeal 'clause.simple-split-bldr
+                (clause.clause-formula clause)
+                (list-fix proofs)
+                clause))
+
+(defobligations clause.simple-split-bldr-okp
+  (clause.simple-split-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.simple-split-bldr-okp)))
+
+ (defthm booleanp-of-clause.simple-split-bldr-okp
+   (equal (booleanp (clause.simple-split-bldr-okp x atbl))
+          t))
+
+ (defthm clause.simple-split-bldr-okp-of-logic.appeal-identity
+   (equal (clause.simple-split-bldr-okp (logic.appeal-identity x) atbl)
+          (clause.simple-split-bldr-okp x atbl)))
+
+ (defthmd lemma-1-for-soundness-of-clause.simple-split-bldr-okp
+   (implies (and (clause.simple-split-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (clause.simple-split-bldr (logic.extras x)
+                                              (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                           axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.simple-split-bldr-okp
+   (implies (and (clause.simple-split-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.simple-split-bldr-okp)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'if atbl)) 3))
+            (equal (logic.proofp
+                    (clause.simple-split-bldr (logic.extras x)
+                                              (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                           axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.simple-split-bldr-okp
+   (implies (and (clause.simple-split-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.simple-split-bldr-okp)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             )))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.simple-split-bldr-okp
+                               lemma-2-for-soundness-of-clause.simple-split-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.simple-split-bldr (logic.extras x)
+                                                          (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                                       axioms thms atbl)))))))))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/aux-split-support.lisp acl2-6.3/books/milawa/ACL2/clauses/aux-split-support.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/aux-split-support.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/aux-split-support.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,963 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "prop")
+(include-book "aux-split")
+(include-book "basic-bldrs")
+(include-book "../build/iff")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (clause.aux-split-bldr todo done proofs)
+;;
+;; Proofs should established every clause resulting from the split.  We build
+;; a proof whose conclusion depends on whether todo and done are empty:
+;;
+;;       Todo        Done        Goal
+;;   ---------------------------------------------------------------
+;;       nonempty    nonempty    (t1 v ... v tn) v (d1 v ... v dm)
+;;       nonempty    empty       (t1 v ... v tn)
+;;       empty       nonempty    (d1 v ... v dm)
+;;       empty       empty       [error]
+;;
+;; To manage these cases, we split the proof into many auxilliary lemmas, which
+;; we will introduce first.
+
+
+
+;; Builders for the (not (not x)) case.
+
+(defderiv clause.aux-split-double-negate-lemma1-bldr
+  :derive (v (v (!= (? a) nil) P) Q)
+  :from   ((proof x (v (v (!= (? b) nil) P) Q))
+           (proof y (= (iff (? a) (? b)) t)))
+  :proof  (@derive
+           ((v (v (!= (? b) nil) P) Q)            (@given x))
+           ((v (!= (? b) nil) (v P Q))            (build.right-associativity @-))
+           ((v (v P Q) (!= (? b) nil))            (build.commute-or @-)   *1)
+           ((= (iff (? a) (? b)) t)               (@given y))
+           ((v (v P Q) (= (iff (? a) (? b)) t))   (build.expansion (@formula (v P Q)) @-))
+           ((v (v P Q) (!= (? a) nil))            (clause.disjoined-substitute-iff-into-literal-bldr *1 @-))
+           ((v (!= (? a) nil) (v P Q))            (build.commute-or @-))
+           ((v (v (!= (? a) nil) P) Q)            (build.associativity @-))))
+
+(defderiv clause.aux-split-double-negate-lemma2-bldr
+  :derive (v (!= (? a) nil) P)
+  :from   ((proof x (v (!= (? b) nil) P))
+           (proof y (= (iff (? a) (? b)) t)))
+  :proof  (@derive
+           ((v (!= (? b) nil) P)                 (@given x))
+           ((v P (!= (? b) nil))                 (build.commute-or @-)   *1)
+           ((= (iff (? a) (? b)) t)              (@given y))
+           ((v P (= (iff (? a) (? b)) t))        (build.expansion (@formula P) @-))
+           ((v P (!= (? a) nil))                 (clause.disjoined-substitute-iff-into-literal-bldr *1 @-))
+           ((v (!= (? a) nil) P)                 (build.commute-or @-))))
+
+
+
+
+;; Builders for the positive (if a b c) case.
+
+(deftheorem clause.theorem-aux-split-positive
+  :derive (v (! (v (!= (not x) nil) (!= y nil)))
+             (v (! (v (!= x nil) (!= z nil)))
+                (!= (if x y z) nil)))
+  :proof  (let ((p (@formula (v (!= (not x) nil) (!= y nil))))
+                (q (@formula (v (!= x nil) (!= z nil)))))
+            (@derive
+             ((v (= x nil) (= (if x y z) y))                (build.axiom (axiom-if-when-not-nil)))
+             ((v (! P) (v (= x nil) (= (if x y z) y)))      (build.expansion (logic.pnot p) @-))
+             ((v (v (! P) (= x nil)) (= (if x y z) y))      (build.associativity @-)                             *1a)
+             ((v (! P) (v (!= (not x) nil) (!= y nil)))     (build.propositional-schema p))
+             ((v (! P) (v (!= y nil) (!= (not x) nil)))     (build.disjoined-commute-or @-))
+             ((v (v (! P) (!= y nil)) (!= (not x) nil))     (build.associativity @-))
+             ((v (v (! P) (!= y nil)) (= x nil))            (build.disjoined-pequal-nil-from-negative-lit @-))
+             ((v (! P) (v (!= y nil) (= x nil)))            (build.right-associativity @-))
+             ((v (! P) (v (= x nil) (!= y nil)))            (build.disjoined-commute-or @-))
+             ((v (v (! P) (= x nil)) (!= y nil))            (build.associativity @-))
+             ((v (v (! P) (= x nil)) (!= (if x y z) nil))   (build.disjoined-substitute-into-not-pequal @- *1a))
+             ((v (!= (if x y z) nil) (v (! P) (= x nil)))   (build.commute-or @-))
+             ((v (!= (if x y z) nil) (v (= x nil) (! P)))   (build.disjoined-commute-or @-))
+             ((v (v (= x nil) (! P)) (!= (if x y z) nil))   (build.commute-or @-))
+             ((v (= x nil) (v (! P) (!= (if x y z) nil)))   (build.right-associativity @-)                       *1)
+             ;; ---
+             ((v (!= x nil) (= (if x y z) z))               (build.axiom (axiom-if-when-nil)))
+             ((v (! Q) (v (!= x nil) (= (if x y z) z)))     (build.expansion (logic.pnot q) @-))
+             ((v (v (! Q) (!= x nil)) (= (if x y z) z))     (build.associativity @-)                             *2a)
+             ((v (! Q) (v (!= x nil) (!= z nil)))           (build.propositional-schema q))
+             ((v (v (! Q) (!= x nil)) (!= z nil))           (build.associativity @-))
+             ((v (v (! Q) (!= x nil)) (!= (if x y z) nil))  (build.disjoined-substitute-into-not-pequal @- *2a))
+             ((v (!= (if x y z) nil) (v (! Q) (!= x nil)))  (build.commute-or @-))
+             ((v (!= (if x y z) nil) (v (!= x nil) (! Q)))  (build.disjoined-commute-or @-))
+             ((v (v (!= x nil) (! Q)) (!= (if x y z) nil))  (build.commute-or @-))
+             ((v (!= x nil) (v (! Q) (!= (if x y z) nil)))  (build.right-associativity @-)                       *2)
+             ;; ---
+             ((v (v (! P) (!= (if x y z) nil))
+                 (v (! Q) (!= (if x y z) nil)))             (build.cut *1 *2))
+             ((v (! P) (v (! Q) (!= (if x y z) nil)))       (clause.aux-split-twiddle @-))))
+  :minatbl ((if . 3)
+            (not . 1)))
+
+(defderiv clause.aux-split-positive-bldr
+  :derive (!= (if (? a) (? b) (? c)) nil)
+  :from   ((proof x (v (!= (not (? a)) nil) (!= (? b) nil)))
+           (proof y (v (!= (? a) nil) (!= (? c) nil))))
+  :proof  (@derive
+           ((v (! (v (!= (not x) nil) (!= y nil)))
+               (v (! (v (!= x nil) (!= z nil)))
+                  (!= (if x y z) nil)))                      (build.theorem (clause.theorem-aux-split-positive)))
+           ((v (! (v (!= (not (? a)) nil) (!= (? b) nil)))
+               (v (! (v (!= (? a) nil) (!= (? c) nil)))
+                  (!= (if (? a) (? b) (? c)) nil)))          (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+           ((v (!= (not (? a)) nil) (!= (? b) nil))          (@given x))
+           ((v (! (v (!= (? a) nil) (!= (? c) nil)))
+               (!= (if (? a) (? b) (? c)) nil))              (build.modus-ponens @- @--))
+           ((v (!= (? a) nil) (!= (? c) nil))                (@given y))
+           ((!= (if (? a) (? b) (? c)) nil)                  (build.modus-ponens @- @--)))
+  :minatbl ((if . 3)))
+
+(defderiv clause.disjoined-aux-split-positive-bldr
+  :derive (v P (!= (if (? a) (? b) (? c)) nil))
+  :from   ((proof x (v P (v (!= (not (? a)) nil) (!= (? b) nil))))
+           (proof y (v P (v (!= (? a) nil) (!= (? c) nil)))))
+  :proof  (@derive
+           ((v (! (v (!= (not x) nil) (!= y nil)))
+               (v (! (v (!= x nil) (!= z nil)))
+                  (!= (if x y z) nil)))                            (build.theorem (clause.theorem-aux-split-positive)))
+           ((v (! (v (!= (not (? a)) nil) (!= (? b) nil)))
+               (v (! (v (!= (? a) nil) (!= (? c) nil)))
+                  (!= (if (? a) (? b) (? c)) nil)))                (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+           ((v P (v (! (v (!= (not (? a)) nil) (!= (? b) nil)))
+                    (v (! (v (!= (? a) nil) (!= (? c) nil)))
+                       (!= (if (? a) (? b) (? c)) nil))))          (build.expansion (@formula P) @-))
+           ((v P (v (!= (not (? a)) nil) (!= (? b) nil)))          (@given x))
+           ((v P (v (! (v (!= (? a) nil) (!= (? c) nil)))
+                    (!= (if (? a) (? b) (? c)) nil)))              (build.disjoined-modus-ponens @- @--))
+           ((v P (v (!= (? a) nil) (!= (? c) nil)))                (@given y))
+           ((v P (!= (if (? a) (? b) (? c)) nil))                  (build.disjoined-modus-ponens @- @--)))
+  :minatbl ((if . 3)))
+
+(defderiv clause.aux-split-positive-1-bldr
+  :derive (v (v (!= (if (? a) (? b) (? c)) nil) P) Q)
+  :from   ((proof x (v (v (!= (not (? a)) nil) (v (!= (? b) nil) P)) Q))
+           (proof y (v (v (!= (? a) nil) (v (!= (? c) nil) P)) Q)))
+  :proof (@derive
+          ((v (v (!= (not (? a)) nil) (v (!= (? b) nil) P)) Q)    (@given x))
+          ((v (v P Q) (v (!= (not (? a)) nil) (!= (? b) nil)))    (clause.aux-split-twiddle2 @-)  *1)
+          ((v (v (!= (? a) nil) (v (!= (? c) nil) P)) Q)          (@given y))
+          ((v (v P Q) (v (!= (? a) nil) (!= (? c) nil)))          (clause.aux-split-twiddle2 @-)  *2)
+          ((v (v P Q) (!= (if (? a) (? b) (? c)) nil))            (clause.disjoined-aux-split-positive-bldr *1 *2))
+          ((v (!= (if (? a) (? b) (? c)) nil) (v P Q))            (build.commute-or @-))
+          ((v (v (!= (if (? a) (? b) (? c)) nil) P) Q)            (build.associativity @-)))
+  :minatbl ((if . 3)))
+
+(defderiv clause.aux-split-positive-2-bldr
+  :derive (v (!= (if (? a) (? b) (? c)) nil) P)
+  :from   ((proof x (v (v (!= (not (? a)) nil) (!= (? b) nil)) P))
+           (proof y (v (v (!= (? a) nil) (!= (? c) nil)) P)))
+  :proof (@derive
+          ((v (v (!= (not (? a)) nil) (!= (? b) nil)) P)    (@given x))
+          ((v P (v (!= (not (? a)) nil) (!= (? b) nil)))    (build.commute-or @-)      *1)
+          ((v (v (!= (? a) nil) (!= (? c) nil)) P)          (@given y))
+          ((v P (v (!= (? a) nil) (!= (? c) nil)))          (build.commute-or @-)      *2)
+          ((v P (!= (if (? a) (? b) (? c)) nil))            (clause.disjoined-aux-split-positive-bldr *1 *2))
+          ((v (!= (if (? a) (? b) (? c)) nil) P)            (build.commute-or @-)))
+  :minatbl ((if . 3)))
+
+
+
+
+;; Builders for the (not (if a b c)) case.
+
+(deftheorem clause.theorem-aux-split-negative
+  :derive (v (! (v (!= (not x) nil) (!= (not y) nil)))
+             (v (! (v (!= x nil) (!= (not z) nil)))
+                (!= (not (if x y z)) nil)))
+  :proof  (let ((p (@formula (v (!= (not x) nil) (!= (not y) nil))))
+                (q (@formula (v (!= x nil) (!= (not z) nil)))))
+            (@derive
+             ((v (= x nil) (= (if x y z) y))                       (build.axiom (axiom-if-when-not-nil)))
+             ((v (! P) (v (= x nil) (= (if x y z) y)))             (build.expansion (logic.pnot p) @-))
+             ((v (v (! P) (= x nil)) (= (if x y z) y))             (build.associativity @-)                          *1a)
+             ((v (! P) (v (!= (not x) nil) (!= (not y) nil)))      (build.propositional-schema p))
+             ((v (v (! P) (!= (not x) nil)) (!= (not y) nil))      (build.associativity @-))
+             ((v (v (! P) (!= (not x) nil)) (= y nil))             (build.disjoined-pequal-nil-from-negative-lit @-))
+             ((v (! P) (v (!= (not x) nil) (= y nil)))             (build.right-associativity @-))
+             ((v (! P) (v (= y nil) (!= (not x) nil)))             (build.disjoined-commute-or @-))
+             ((v (v (! P) (= y nil)) (!= (not x) nil))             (build.associativity @-))
+             ((v (v (! P) (= y nil)) (= x nil))                    (build.disjoined-pequal-nil-from-negative-lit @-))
+             ((v (! P) (v (= y nil) (= x nil)))                    (build.right-associativity @-))
+             ((v (! P) (v (= x nil) (= y nil)))                    (build.disjoined-commute-or @-))
+             ((v (v (! P) (= x nil)) (= y nil))                    (build.associativity @-))
+             ((v (v (! P) (= x nil)) (= (if x y z) nil))           (build.disjoined-transitivity-of-pequal *1a @-))
+             ((v (v (! P) (= x nil)) (!= (not (if x y z)) nil))    (build.disjoined-negative-lit-from-pequal-nil @-))
+             ((v (!= (not (if x y z)) nil) (v (! P) (= x nil)))    (build.commute-or @-))
+             ((v (v (!= (not (if x y z)) nil) (! P)) (= x nil))    (build.associativity @-))
+             ((v (= x nil) (v (!= (not (if x y z)) nil) (! P)))    (build.commute-or @-))
+             ((v (= x nil) (v (! P) (!= (not (if x y z)) nil)))    (build.disjoined-commute-or @-)                   *1)
+             ;; ---
+             ((v (!= x nil) (= (if x y z) z))                      (build.axiom (axiom-if-when-nil)))
+             ((v (! Q) (v (!= x nil) (= (if x y z) z)))            (build.expansion (logic.pnot q) @-))
+             ((v (v (! Q) (!= x nil)) (= (if x y z) z))            (build.associativity @-)                          *2a)
+             ((v (! Q) (v (!= x nil) (!= (not z) nil)))            (build.propositional-schema q))
+             ((v (v (! Q) (!= x nil)) (!= (not z) nil))            (build.associativity @-))
+             ((v (v (! Q) (!= x nil)) (= z nil))                   (build.disjoined-pequal-nil-from-negative-lit @-))
+             ((v (v (! Q) (!= x nil)) (= (if x y z) nil))          (build.disjoined-transitivity-of-pequal *2a @-))
+             ((v (v (! Q) (!= x nil)) (!= (not (if x y z)) nil))   (build.disjoined-negative-lit-from-pequal-nil @-))
+             ((v (!= (not (if x y z)) nil) (v (! Q) (!= x nil)))   (build.commute-or @-))
+             ((v (!= (not (if x y z)) nil) (v (!= x nil) (! Q)))   (build.disjoined-commute-or @-))
+             ((v (v (!= x nil) (! Q)) (!= (not (if x y z)) nil))   (build.commute-or @-))
+             ((v (!= x nil) (v (! Q) (!= (not (if x y z)) nil)))   (build.right-associativity @-)                    *2)
+             ;; ---
+             ((v (v (! P) (!= (not (if x y z)) nil))
+                 (v (! Q) (!= (not (if x y z)) nil)))              (build.cut *1 *2))
+             ((v (! P) (v (! Q) (!= (not (if x y z)) nil)))        (clause.aux-split-twiddle @-))))
+  :minatbl ((if . 3)
+            (not . 1)))
+
+(defderiv clause.aux-split-negative-bldr
+  :derive (!= (not (if (? a) (? b) (? c))) nil)
+  :from   ((proof x (v (!= (not (? a)) nil) (!= (not (? b)) nil)))
+           (proof y (v (!= (? a) nil) (!= (not (? c)) nil))))
+  :proof  (@derive
+           ((v (! (v (!= (not x) nil) (!= (not y) nil)))
+               (v (! (v (!= x nil) (!= (not z) nil)))
+                  (!= (not (if x y z)) nil)))                      (build.theorem (clause.theorem-aux-split-negative)))
+           ((v (! (v (!= (not (? a)) nil) (!= (not (? b)) nil)))
+               (v (! (v (!= (? a) nil) (!= (not (? c)) nil)))
+                  (!= (not (if (? a) (? b) (? c))) nil)))          (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+           ((v (!= (not (? a)) nil) (!= (not (? b)) nil))          (@given x))
+           ((v (! (v (!= (? a) nil) (!= (not (? c)) nil)))
+               (!= (not (if (? a) (? b) (? c))) nil))              (build.modus-ponens @- @--))
+           ((v (!= (? a) nil) (!= (not (? c)) nil))                (@given y))
+           ((!= (not (if (? a) (? b) (? c))) nil)                  (build.modus-ponens @- @--)))
+  :minatbl ((if . 3)))
+
+(defderiv clause.disjoined-aux-split-negative-bldr
+  :derive (v P (!= (not (if (? a) (? b) (? c))) nil))
+  :from   ((proof x (v P (v (!= (not (? a)) nil) (!= (not (? b)) nil))))
+           (proof y (v P (v (!= (? a) nil) (!= (not (? c)) nil)))))
+  :proof  (@derive
+           ((v (! (v (!= (not x) nil) (!= (not y) nil)))
+               (v (! (v (!= x nil) (!= (not z) nil)))
+                  (!= (not (if x y z)) nil)))                            (build.theorem (clause.theorem-aux-split-negative)))
+           ((v (! (v (!= (not (? a)) nil) (!= (not (? b)) nil)))
+               (v (! (v (!= (? a) nil) (!= (not (? c)) nil)))
+                  (!= (not (if (? a) (? b) (? c))) nil)))                (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+           ((v P (v (! (v (!= (not (? a)) nil) (!= (not (? b)) nil)))
+                    (v (! (v (!= (? a) nil) (!= (not (? c)) nil)))
+                       (!= (not (if (? a) (? b) (? c))) nil))))          (build.expansion (@formula P) @-))
+           ((v P (v (!= (not (? a)) nil) (!= (not (? b)) nil)))          (@given x))
+           ((v P (v (! (v (!= (? a) nil) (!= (not (? c)) nil)))
+                    (!= (not (if (? a) (? b) (? c))) nil)))              (build.disjoined-modus-ponens @- @--))
+           ((v P (v (!= (? a) nil) (!= (not (? c)) nil)))                (@given y))
+           ((v P (!= (not (if (? a) (? b) (? c))) nil))                  (build.disjoined-modus-ponens @- @--)))
+  :minatbl ((if . 3)))
+
+
+(defderiv clause.aux-split-negative-1-bldr-lemma-1
+  :derive (v (v P Q) (!= (not (if (? a) (? b) (? c))) nil))
+  :from   ((proof x (v (v (!= (not (? a)) nil) (v (!= (not (? b)) nil) P)) Q))
+           (proof y (v (v (!= (? a) nil) (v (!= (not (? c)) nil) P)) Q)))
+  :proof  (@derive
+           ((v (v (!= (not (? a)) nil) (v (!= (not (? b)) nil) P)) Q)   (@given x))
+           ((v (v P Q) (v (!= (not (? a)) nil) (!= (not (? b)) nil)))   (clause.aux-split-twiddle2 @-)  *1)
+           ((v (v (!= (? a) nil) (v (!= (not (? c)) nil) P)) Q)         (@given y))
+           ((v (v P Q) (v (!= (? a) nil) (!= (not (? c)) nil)))         (clause.aux-split-twiddle2 @-))
+           ((v (v P Q) (!= (not (if (? a) (? b) (? c))) nil))           (clause.disjoined-aux-split-negative-bldr *1 @-)))
+  :minatbl ((if . 3)))
+
+(encapsulate
+ ()
+ (defthmd equal-when-logic.functionp-and-logic.functionp
+   (implies (and (logic.functionp x)
+                 (logic.functionp y))
+            (equal (equal x y)
+                   (and (equal (logic.function-name x) (logic.function-name y))
+                        (equal (logic.function-args x) (logic.function-args y)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :in-theory (enable logic.functionp logic.function-name logic.function-args))))
+
+ (defthmd equal-of-one-tuples
+   (implies (and (equal (len x) 1)
+                 (equal (len y) 1)
+                 (true-listp x)
+                 (true-listp y))
+            (equal (equal x y)
+                   (equal (first x) (first y))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthmd equal-of-logic.function-args-and-logic.function-args-when-one-tuples
+   (implies (and (equal (len (logic.function-args x)) 1)
+                 (equal (len (logic.function-args y)) 1)
+                 (force (logic.functionp x))
+                 (force (logic.functionp y))
+                 (force (logic.termp x))
+                 (force (logic.termp y)))
+            (equal (equal (logic.function-args x)
+                          (logic.function-args y))
+                   (equal (first (logic.function-args x))
+                          (first (logic.function-args y)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :use ((:instance equal-of-one-tuples
+                                   (x (logic.function-args x))
+                                   (y (logic.function-args y)))))))
+
+ (local (in-theory (enable equal-when-logic.functionp-and-logic.functionp
+                           equal-of-one-tuples
+                           equal-of-logic.function-args-and-logic.function-args-when-one-tuples)))
+
+ (defderiv clause.aux-split-negative-1-bldr-lemma-2
+   :derive (v (v (!= (? t1) nil) P) Q)
+   :from   ((proof x (v (v P Q) (!= (not (? a)) nil)))
+            (proof y (= (? t1) (not (? a)))))
+   :proof  (@derive
+            ((v (v P Q) (!= (not (? a)) nil))     (@given x) *1)
+            ((= (? t1) (not (? a)))               (@given y))
+            ((v (v P Q) (= (? t1) (not (? a))))   (build.expansion (@formula (v P Q)) @-))
+            ((v (v P Q) (!= (? t1) nil))          (build.disjoined-substitute-into-not-pequal *1 @-))
+            ((v (!= (? t1) nil) (v P Q))          (build.commute-or @-))
+            ((v (v (!= (? t1) nil) P) Q)          (build.associativity @-)))))
+
+(defderiv clause.aux-split-negative-1-bldr
+  :derive (v (v (!= (? t1) nil) P) Q)
+  :from   ((proof x (v (v (!= (not (? a)) nil) (v (!= (not (? b)) nil) P)) Q))
+           (proof y (v (v (!= (? a) nil) (v (!= (not (? c)) nil) P)) Q))
+           (proof z (= (? t1) (not (if (? a) (? b) (? c))))))
+  :proof (@derive
+          ((v (v (!= (not (? a)) nil) (v (!= (not (? b)) nil) P)) Q)   (@given x))
+          ((v (v (!= (? a) nil) (v (!= (not (? c)) nil) P)) Q)         (@given y))
+          ((v (v P Q) (!= (not (if (? a) (? b) (? c))) nil))           (clause.aux-split-negative-1-bldr-lemma-1 @-- @-))
+          ((= (? t1) (not (if (? a) (? b) (? c))))                     (@given z))
+          ((v (v (!= (? t1) nil) P) Q)                                 (clause.aux-split-negative-1-bldr-lemma-2 @-- @-))))
+
+
+(defderiv clause.aux-split-negative-2-bldr-lemma-1
+  :derive (v P (!= (not (if (? a) (? b) (? c))) nil))
+  :from   ((proof x (v (v (!= (not (? a)) nil) (!= (not (? b)) nil)) P))
+           (proof y (v (v (!= (? a) nil) (!= (not (? c)) nil)) P)))
+  :proof  (@derive
+           ((v (v (!= (not (? a)) nil) (!= (not (? b)) nil)) P)         (@given x))
+           ((v P (v (!= (not (? a)) nil) (!= (not (? b)) nil)))         (build.commute-or @-)       *1)
+           ((v (v (!= (? a) nil) (!= (not (? c)) nil)) P)               (@given y))
+           ((v P (v (!= (? a) nil) (!= (not (? c)) nil)))               (build.commute-or @-)       *2)
+           ((v P (!= (not (if (? a) (? b) (? c))) nil))                 (clause.disjoined-aux-split-negative-bldr *1 *2)))
+  :minatbl ((if . 3)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable equal-when-logic.functionp-and-logic.functionp
+                           equal-of-logic.function-args-and-logic.function-args-when-one-tuples)))
+
+ (defderiv clause.aux-split-negative-2-bldr-lemma-2
+   :derive (v (!= (? t1) nil) P)
+   :from   ((proof x (= (? t1) (not (? a))))
+            (proof y (v P (!= (not (? a)) nil))))
+   :proof  (@derive
+            ((= (? t1) (not (? a)))           (@given x))
+            ((v P (= (? t1) (not (? a))))     (build.expansion (@formula P) @-))
+            ((v P (!= (not (? a)) nil))       (@given y))
+            ((v P (!= (? t1) nil))            (build.disjoined-substitute-into-not-pequal @- @--))
+            ((v (!= (? t1) nil) P)            (build.commute-or @-)))))
+
+(defderiv clause.aux-split-negative-2-bldr
+  :derive (v (!= (? t1) nil) P)
+  :from   ((proof x (v (v (!= (not (? a)) nil) (!= (not (? b)) nil)) P))
+           (proof y (v (v (!= (? a) nil) (!= (not (? c)) nil)) P))
+           (proof z (= (? t1) (not (if (? a) (? b) (? c))))))
+  :proof  (@derive
+           ((v (v (!= (not (? a)) nil) (!= (not (? b)) nil)) P)         (@given x))
+           ((v (v (!= (? a) nil) (!= (not (? c)) nil)) P)               (@given y))
+           ((v P (!= (not (if (? a) (? b) (? c))) nil))                 (clause.aux-split-negative-2-bldr-lemma-1 @-- @-))
+           ((= (? t1) (not (if (? a) (? b) (? c))))                     (@given z))
+           ((v (!= (? t1) nil) P)                                       (clause.aux-split-negative-2-bldr-lemma-2 @- @--))))
+
+
+
+;; Builders for the default case.
+
+(defderiv clause.aux-split-default-1-bldr
+  :derive (v (v (!= (? a) nil) P) Q)
+  :from   ((proof x (v P (v (!= (? b) nil) Q)))
+           (proof y (= (? a) (? b))))
+  :proof  (@derive
+           ((v P (v (!= (? b) nil) Q))   (@given x))
+           ((v (v P (!= (? b) nil)) Q)   (build.associativity @-))
+           ((v Q (v P (!= (? b) nil)))   (build.commute-or @-))
+           ((v (v Q P) (!= (? b) nil))   (build.associativity @-)  *1)
+           ((= (? a) (? b))              (@given y))
+           ((v (v Q P) (= (? a) (? b)))  (build.expansion (@formula (v Q P)) @-))
+           ((v (v Q P) (!= (? a) nil))   (build.disjoined-substitute-into-not-pequal *1 @-))
+           ((v (!= (? a) nil) (v Q P))   (build.commute-or @-))
+           ((v (!= (? a) nil) (v P Q))   (build.disjoined-commute-or @-))
+           ((v (v (!= (? a) nil) P) Q)   (build.associativity @-))))
+
+(defderiv clause.aux-split-default-2-bldr
+  :derive (v (!= (? a) nil) P)
+  :from   ((proof x (v P (!= (? b) nil)))
+           (proof y (= (? a) (? b))))
+  :proof  (@derive
+           ((= (? a) (? b))       (@given y))
+           ((v P (= (? a) (? b))) (build.expansion (@formula P) @-))
+           ((v P (!= (? b) nil))  (@given x))
+           ((v P (!= (? a) nil))  (build.disjoined-substitute-into-not-pequal @- @--))
+           ((v (!= (? a) nil) P)  (build.commute-or @-))))
+
+
+
+;; Originally I didn't bother to introduce clause.aux-split-goal and the other supporting
+;; functions based on it below.  This approach worked fine in the ACL2 model, but I wasn't
+;; able to handle the complexity of the proof during bootstrapping.  The new approach has
+;; many more functions, but they are all comparatively simple and hence the work can be
+;; broken up a lot better.  The key to doing this splitting is to introduce something like
+;; clause.aux-split-goal, so the case-split about what kind of formula is being proven
+;; can be contained.
+
+(definlined clause.aux-split-double-negate (t1 t2-tn done proof)
+  (declare (xargs :guard (and (logic.termp t1)
+                              (clause.negative-termp t1)
+                              (clause.negative-termp (clause.negative-term-guts t1))
+                              (logic.term-listp t2-tn)
+                              (logic.term-listp done)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (clause.aux-split-goal (cons (clause.negative-term-guts
+                                                                   (clause.negative-term-guts t1))
+                                                                  t2-tn)
+                                                            done)))
+                  :verify-guards nil))
+  (let ((lemma (clause.standardize-double-negative-term-under-iff-bldr t1)))
+    (if (consp t2-tn)
+        (if (consp done)
+            (clause.aux-split-double-negate-lemma1-bldr proof lemma)
+          (clause.aux-split-double-negate-lemma2-bldr proof lemma))
+      (if (consp done)
+          (clause.aux-split-double-negate-lemma2-bldr proof lemma)
+        (clause.substitute-iff-into-literal-bldr proof lemma)))))
+
+(defobligations clause.aux-split-double-negate
+  (clause.standardize-double-negative-term-under-iff-bldr
+   clause.aux-split-double-negate-lemma1-bldr
+   clause.aux-split-double-negate-lemma2-bldr
+   clause.substitute-iff-into-literal-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-split-goal
+                           clause.aux-split-double-negate
+                           logic.term-formula)))
+
+ (verify-guards clause.aux-split-double-negate)
+
+ (defthm forcing-logic.appealp-of-clause.aux-split-double-negate
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (clause.negative-termp (clause.negative-term-guts t1))
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal (cons (clause.negative-term-guts
+                                                             (clause.negative-term-guts t1))
+                                                            t2-tn)
+                                                      done))))
+            (equal (logic.appealp (clause.aux-split-double-negate t1 t2-tn done proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-split-double-negate
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (clause.negative-termp (clause.negative-term-guts t1))
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal (cons (clause.negative-term-guts
+                                                             (clause.negative-term-guts t1))
+                                                            t2-tn)
+                                                      done))))
+            (equal (logic.conclusion (clause.aux-split-double-negate t1 t2-tn done proof))
+                   (clause.aux-split-goal (cons t1 t2-tn) done)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-split-double-negate
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (clause.negative-termp (clause.negative-term-guts t1))
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal (cons (clause.negative-term-guts
+                                                             (clause.negative-term-guts t1))
+                                                            t2-tn)
+                                                      done))
+                        ;; ---
+                        (logic.term-atblp t1 atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.aux-split-double-negate)))
+            (equal (logic.proofp (clause.aux-split-double-negate t1 t2-tn done proof) axioms thms atbl)
+                   t))))
+
+
+
+
+
+
+
+(definlined clause.aux-split-negated-if (t1 t2-tn done proof1 proof2)
+  (declare (xargs :guard (and (logic.termp t1)
+                              (clause.negative-termp t1)
+                              (logic.functionp (clause.negative-term-guts t1))
+                              (equal (logic.function-name (clause.negative-term-guts t1)) 'if)
+                              (equal (len (logic.function-args (clause.negative-term-guts t1))) 3)
+                              (logic.term-listp t2-tn)
+                              (logic.term-listp done)
+                              (logic.appealp proof1)
+                              (logic.appealp proof2)
+                              (equal (logic.conclusion proof1)
+                                     (clause.aux-split-goal (cons (logic.function 'not (list (first (logic.function-args (clause.negative-term-guts t1)))))
+                                                                  (cons (logic.function 'not (list (second (logic.function-args (clause.negative-term-guts t1)))))
+                                                                        t2-tn))
+                                                            done))
+                              (equal (logic.conclusion proof2)
+                                     (clause.aux-split-goal (cons (first (logic.function-args (clause.negative-term-guts t1)))
+                                                                  (cons (logic.function 'not (list (third (logic.function-args (clause.negative-term-guts t1)))))
+                                                                        t2-tn))
+                                                            done)))
+                  :verify-guards nil))
+  ;; Matched a negated term of the form (if a b c)
+  ;; Goal:   (t1 != nil [v T2...Tn]) [v D1...Dm]
+  ;; Lemma:  t1 = (not (if a b c))
+  ;; Proof1: ((not a) != nil v (not b) != nil [v T2...Tn]) [v D1...Dm]
+  ;; Proof2: (a != nil v (not c) != nil [v T2...Tn]) [v D1...Dm]
+  (let ((lemma (clause.standardize-negative-term-bldr t1)))
+    (if (consp t2-tn)
+        (if (consp done)
+            (clause.aux-split-negative-1-bldr proof1 proof2 lemma)
+          (clause.aux-split-negative-2-bldr (build.associativity proof1)
+                                            (build.associativity proof2)
+                                            lemma))
+      (if (consp done)
+          (clause.aux-split-negative-2-bldr proof1 proof2 lemma)
+        (build.substitute-into-not-pequal (clause.aux-split-negative-bldr proof1 proof2)
+                                          lemma)))))
+
+(defobligations clause.aux-split-negated-if
+  (clause.standardize-negative-term-bldr
+   clause.aux-split-negative-1-bldr
+   clause.aux-split-negative-2-bldr
+   clause.aux-split-negative-bldr
+   build.substitute-into-not-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-split-goal
+                           clause.aux-split-negated-if
+                           logic.term-formula)))
+
+ (defthm len-when-not-consp-of-cdr-cheap
+   ;; BOZO move to utilities
+   (implies (not (consp (cdr x)))
+            (equal (len x)
+                   (if (consp x)
+                       1
+                     0)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (verify-guards clause.aux-split-negated-if)
+
+ (defthm forcing-logic.appealp-of-clause.aux-split-negated-if
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (logic.functionp (clause.negative-term-guts t1))
+                        (equal (logic.function-name (clause.negative-term-guts t1)) 'if)
+                        (equal (len (logic.function-args (clause.negative-term-guts t1))) 3)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (equal (logic.conclusion proof1)
+                               (clause.aux-split-goal (cons (logic.function 'not (list (first (logic.function-args (clause.negative-term-guts t1)))))
+                                                            (cons (logic.function 'not (list (second (logic.function-args (clause.negative-term-guts t1)))))
+                                                                  t2-tn))
+                                                      done))
+                        (equal (logic.conclusion proof2)
+                               (clause.aux-split-goal (cons (first (logic.function-args (clause.negative-term-guts t1)))
+                                                            (cons (logic.function 'not (list (third (logic.function-args (clause.negative-term-guts t1)))))
+                                                                  t2-tn))
+                                                      done))))
+            (equal (logic.appealp (clause.aux-split-negated-if t1 t2-tn done proof1 proof2))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-split-negated-if
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (logic.functionp (clause.negative-term-guts t1))
+                        (equal (logic.function-name (clause.negative-term-guts t1)) 'if)
+                        (equal (len (logic.function-args (clause.negative-term-guts t1))) 3)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (equal (logic.conclusion proof1)
+                               (clause.aux-split-goal (cons (logic.function 'not (list (first (logic.function-args (clause.negative-term-guts t1)))))
+                                                            (cons (logic.function 'not (list (second (logic.function-args (clause.negative-term-guts t1)))))
+                                                                  t2-tn))
+                                                      done))
+                        (equal (logic.conclusion proof2)
+                               (clause.aux-split-goal (cons (first (logic.function-args (clause.negative-term-guts t1)))
+                                                            (cons (logic.function 'not (list (third (logic.function-args (clause.negative-term-guts t1)))))
+                                                                  t2-tn))
+                                                      done))))
+            (equal (logic.conclusion (clause.aux-split-negated-if t1 t2-tn done proof1 proof2))
+                   (clause.aux-split-goal (cons t1 t2-tn) done)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-split-negated-if
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (logic.functionp (clause.negative-term-guts t1))
+                        (equal (logic.function-name (clause.negative-term-guts t1)) 'if)
+                        (equal (len (logic.function-args (clause.negative-term-guts t1))) 3)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (equal (logic.conclusion proof1)
+                               (clause.aux-split-goal (cons (logic.function 'not (list (first (logic.function-args (clause.negative-term-guts t1)))))
+                                                            (cons (logic.function 'not (list (second (logic.function-args (clause.negative-term-guts t1)))))
+                                                                  t2-tn))
+                                                      done))
+                        (equal (logic.conclusion proof2)
+                               (clause.aux-split-goal (cons (first (logic.function-args (clause.negative-term-guts t1)))
+                                                            (cons (logic.function 'not (list (third (logic.function-args (clause.negative-term-guts t1)))))
+                                                                  t2-tn))
+                                                      done))
+                        ;; ---
+                        (logic.term-atblp t1 atbl)
+                        (logic.proofp proof1 axioms thms atbl)
+                        (logic.proofp proof2 axioms thms atbl)
+                        (@obligations clause.aux-split-negated-if)))
+            (equal (logic.proofp (clause.aux-split-negated-if t1 t2-tn done proof1 proof2) axioms thms atbl)
+                   t))))
+
+
+
+
+(definlined clause.aux-split-positive-if (t1 t2-tn done proof1 proof2)
+  (declare (xargs :guard (and (logic.termp t1)
+                              (logic.functionp t1)
+                              (equal (logic.function-name t1) 'if)
+                              (equal (len (logic.function-args t1)) 3)
+                              (logic.term-listp t2-tn)
+                              (logic.term-listp done)
+                              (logic.appealp proof1)
+                              (logic.appealp proof2)
+                              (equal (logic.conclusion proof1)
+                                     (clause.aux-split-goal (cons (logic.function 'not (list (first (logic.function-args t1))))
+                                                                  (cons (second (logic.function-args t1))
+                                                                        t2-tn))
+                                                            done))
+                              (equal (logic.conclusion proof2)
+                                     (clause.aux-split-goal (cons (first (logic.function-args t1))
+                                                                  (cons (third (logic.function-args t1))
+                                                                        t2-tn))
+                                                            done)))
+                  :verify-guards nil)
+           (ignore t1))
+  ;; Matched a positive term of the form (if a b c)
+  ;; Goal: (t1 != nil [v T2...Tn]) [v D1...Dm]
+  ;; Proof1: ((not a) != nil v b != nil [v T2...Tn]) [v D1...Dm]
+  ;; Proof2: (a != nil v c != nil [v T2...Tn]) [v D1...Dm]
+  (if (consp t2-tn)
+      (if (consp done)
+          (clause.aux-split-positive-1-bldr proof1 proof2)
+        (clause.aux-split-positive-2-bldr (build.associativity proof1)
+                                          (build.associativity proof2)))
+    (if (consp done)
+        (clause.aux-split-positive-2-bldr proof1 proof2)
+      (clause.aux-split-positive-bldr proof1 proof2))))
+
+(defobligations clause.aux-split-positive-if
+  (clause.aux-split-positive-1-bldr
+   clause.aux-split-positive-2-bldr
+   clause.aux-split-positive-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-split-goal
+                           clause.aux-split-positive-if
+                           logic.term-formula)))
+
+ (verify-guards clause.aux-split-positive-if)
+
+ (defthm forcing-logic.appealp-of-clause.aux-split-positive-if
+   (implies (force (and (logic.termp t1)
+                        (logic.functionp t1)
+                        (equal (logic.function-name t1) 'if)
+                        (equal (len (logic.function-args t1)) 3)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (equal (logic.conclusion proof1)
+                               (clause.aux-split-goal (cons (logic.function 'not (list (first (logic.function-args t1))))
+                                                            (cons (second (logic.function-args t1))
+                                                                  t2-tn))
+                                                      done))
+                        (equal (logic.conclusion proof2)
+                               (clause.aux-split-goal (cons (first (logic.function-args t1))
+                                                            (cons (third (logic.function-args t1))
+                                                                  t2-tn))
+                                                      done))))
+            (equal (logic.appealp (clause.aux-split-positive-if t1 t2-tn done proof1 proof2))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-split-positive-if
+   (implies (force (and (logic.termp t1)
+                        (logic.functionp t1)
+                        (equal (logic.function-name t1) 'if)
+                        (equal (len (logic.function-args t1)) 3)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (equal (logic.conclusion proof1)
+                               (clause.aux-split-goal (cons (logic.function 'not (list (first (logic.function-args t1))))
+                                                            (cons (second (logic.function-args t1))
+                                                                  t2-tn))
+                                                      done))
+                        (equal (logic.conclusion proof2)
+                               (clause.aux-split-goal (cons (first (logic.function-args t1))
+                                                            (cons (third (logic.function-args t1))
+                                                                  t2-tn))
+                                                      done))))
+            (equal (logic.conclusion (clause.aux-split-positive-if t1 t2-tn done proof1 proof2))
+                   (clause.aux-split-goal (cons t1 t2-tn) done)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-split-positive-if
+   (implies (force (and (logic.termp t1)
+                        (logic.functionp t1)
+                        (equal (logic.function-name t1) 'if)
+                        (equal (len (logic.function-args t1)) 3)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (equal (logic.conclusion proof1)
+                               (clause.aux-split-goal (cons (logic.function 'not (list (first (logic.function-args t1))))
+                                                            (cons (second (logic.function-args t1))
+                                                                  t2-tn))
+                                                      done))
+                        (equal (logic.conclusion proof2)
+                               (clause.aux-split-goal (cons (first (logic.function-args t1))
+                                                            (cons (third (logic.function-args t1))
+                                                                  t2-tn))
+                                                      done))
+                        ;; ---
+                        (logic.term-atblp t1 atbl)
+                        (logic.proofp proof1 axioms thms atbl)
+                        (logic.proofp proof2 axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.aux-split-positive-if)))
+            (equal (logic.proofp (clause.aux-split-positive-if t1 t2-tn done proof1 proof2) axioms thms atbl)
+                   t))))
+
+
+
+
+
+(definlined clause.aux-split-negative-default (t1 t2-tn done proof)
+  (declare (xargs :guard (and (logic.termp t1)
+                              (clause.negative-termp t1)
+                              (logic.term-listp t2-tn)
+                              (logic.term-listp done)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (clause.aux-split-goal t2-tn
+                                                            (cons (logic.function 'not (list (clause.negative-term-guts t1)))
+                                                                  done))))
+                  :verify-guards nil))
+  ;; Matched a negative term of some non-if form.
+  ;; Goal is (t1 != nil [v T2...Tn]) [v D1...Dm]
+  ;; Proof is [T2...Tn v] ((not guts) != nil [v D1...Dm])
+  ;; Lemma is t1 = (not guts)
+  (let ((lemma (clause.standardize-negative-term-bldr t1)))
+    (if (consp t2-tn)
+        (if (consp done)
+            (clause.aux-split-default-1-bldr proof lemma)
+          (clause.aux-split-default-2-bldr proof lemma))
+      (if (consp done)
+          (clause.aux-split-default-2-bldr (build.commute-or proof) lemma)
+        (build.substitute-into-not-pequal proof lemma)))))
+
+(defobligations clause.aux-split-negative-default
+  (clause.standardize-negative-term-bldr
+   clause.aux-split-default-1-bldr
+   clause.aux-split-default-2-bldr
+   build.substitute-into-not-pequal
+   build.commute-or))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-split-goal
+                           clause.aux-split-negative-default
+                           logic.term-formula)))
+
+ (verify-guards clause.aux-split-negative-default)
+
+ (defthm forcing-logic.appealp-of-clause.aux-split-negative-default
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal t2-tn
+                                                      (cons (logic.function 'not (list (clause.negative-term-guts t1)))
+                                                            done)))))
+            (equal (logic.appealp (clause.aux-split-negative-default t1 t2-tn done proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-split-negative-default
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal t2-tn
+                                                      (cons (logic.function 'not (list (clause.negative-term-guts t1)))
+                                                            done)))))
+            (equal (logic.conclusion (clause.aux-split-negative-default t1 t2-tn done proof))
+                   (clause.aux-split-goal (cons t1 t2-tn) done)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-split-negative-default
+   (implies (force (and (logic.termp t1)
+                        (clause.negative-termp t1)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal t2-tn
+                                                      (cons (logic.function 'not (list (clause.negative-term-guts t1)))
+                                                            done)))
+                        ;; ---
+                        (logic.term-atblp t1 atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations clause.aux-split-negative-default)))
+            (equal (logic.proofp (clause.aux-split-negative-default t1 t2-tn done proof) axioms thms atbl)
+                   t))))
+
+
+
+
+(definlined clause.aux-split-positive-default (t1 t2-tn done proof)
+  (declare (xargs :guard (and (logic.termp t1)
+                              (logic.term-listp t2-tn)
+                              (logic.term-listp done)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (clause.aux-split-goal t2-tn (cons t1 done))))
+                  :verify-guards nil)
+           (ignore t1))
+  ;; Matched a positive term of some non-if form.
+  ;; Goal is (t1 != nil [v T2...Tn]) [v D1...Dm]
+  ;; Proof is [T2...Tn v] (t1 != nil [v D1...Dm])
+  (if (consp t2-tn)
+      (if (consp done)
+          (clause.aux-split-default-3-bldr proof)
+        (build.commute-or proof))
+    proof))
+
+(defobligations clause.aux-split-positive-default
+  (clause.aux-split-default-3-bldr
+   build.commute-or))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-split-goal
+                           clause.aux-split-positive-default
+                           logic.term-formula)))
+
+ (verify-guards clause.aux-split-positive-default)
+
+ (defthm forcing-logic.appealp-of-clause.aux-split-positive-default
+   (implies (force (and (logic.termp t1)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal t2-tn (cons t1 done)))))
+            (equal (logic.appealp (clause.aux-split-positive-default t1 t2-tn done proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-split-positive-default
+   (implies (force (and (logic.termp t1)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal t2-tn (cons t1 done)))))
+            (equal (logic.conclusion (clause.aux-split-positive-default t1 t2-tn done proof))
+                   (clause.aux-split-goal (cons t1 t2-tn) done)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-split-positive-default
+   (implies (force (and (logic.termp t1)
+                        (logic.term-listp t2-tn)
+                        (logic.term-listp done)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.aux-split-goal t2-tn (cons t1 done)))
+                        ;; ---
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations clause.aux-split-positive-default)))
+            (equal (logic.proofp (clause.aux-split-positive-default t1 t2-tn done proof) axioms thms atbl)
+                   t))))
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/aux-split.lisp acl2-6.3/books/milawa/ACL2/clauses/aux-split.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/aux-split.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/aux-split.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,787 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(include-book "clean-clauses")
+(include-book "if-lifting/lifted-termp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Definition of clause.aux-split
+;;
+;; Clause.aux-split is our main routine for splitting clauses.  We think of
+;; todo and done together as a single input clause, (app todo done), and we
+;; produce a list of clauses which whose conjunction is logically equivalent to
+;; the input clause.  We search todo for three kinds of literals,
+;;
+;;   - (not (not x)),
+;;   - (not (if a b c)), and
+;;   - (if a b c),
+;;
+;; where each "not" should be understood to include the negative-termp variants
+;; such as (iff x nil).  We scan the todo list for these kinds of literals, and
+;; then apply the following reductions.
+;;
+;;   1. (aux-split [(not (not x)), ...] done) = (aux-split [x, ...] done)
+;;
+;;   2. (aux-split [(not (if a b c)), ...] done) =
+;;        (app (aux-split [(not a),(not b),...] done)
+;;             (aux-split [a,(not c),...] done)))
+;;
+;;   3. (aux-split [(if a b c), ...] done) =
+;;        (app (aux-split [(not a),b...] done)
+;;             (aux-split [a,c,...] done))
+;;
+;; To see that this terminates, we introduce the following count,
+;;
+;;   m(not x)    = 1 + m(x),
+;;   m(if a b c) = 1 + m(a) + m(b) + m(c), and
+;;   m(_)        = 1,
+;;
+;; and we sum the counts of the literals in todo.  This decreases with each
+;; recursive call above:
+;;
+;;    (1) WTS: m(x) < m(not (not x))
+;;         <-> m(x) < 1 + 1 + m(x)
+;;         <-> 0 < 2
+;;
+;;   (2a) WTS: m(not a) + m(not b) < m(not (if a b c))
+;;         <-> 1 + m(a) + 1 + m(b) < 1 + 1 + m(a) + m(b) + m(c)
+;;         <-> 0 < m(c)
+;;
+;;   (2b) WTS: m(a) + m(not c) < m(not (if a b c))
+;;         <-> m(a) + 1 + m(c) < 1 + m(a) + m(b) + m(c)
+;;         <-> 0 < m(c)
+;;
+;;   (3a) WTS: m(not a) + m(c) < m(if a b c)
+;;         <-> 1 + m(a) + m(c) < 1 + m(a) + m(b) + m(c)
+;;         <-> 0 < m(b)
+;;
+;;   (3b) WTS: m(a) + m(c) < m(if a b c)
+;;         <-> m(a) + m(c) < 1 + m(a) + m(b) + m(c)
+;;         <-> 0 < 1 + m(c)
+
+(defund clause.split-count (x)
+  (declare (xargs :guard (logic.termp x)))
+  (if (clause.negative-termp x)
+      (+ 1 (clause.split-count (clause.negative-term-guts x)))
+    (if (and (logic.functionp x)
+             (equal (logic.function-name x) 'if)
+             (equal (len (logic.function-args x)) 3))
+        (+ 1 (+ (clause.split-count (first (logic.function-args x)))
+                (+ (clause.split-count (second (logic.function-args x)))
+                   (clause.split-count (third (logic.function-args x))))))
+      1)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.split-count)))
+
+ (defthm natp-of-clause.split-count
+   (equal (natp (clause.split-count x))
+          t))
+
+ (defthm |(< 0 (clause.split-count x))|
+   (equal (< 0 (clause.split-count x))
+          t))
+
+ (defthm clause.split-count-when-clause.negative-termp
+   (implies (clause.negative-termp x)
+            (equal (clause.split-count x)
+                   (+ 1 (clause.split-count (clause.negative-term-guts x))))))
+
+ (defthm clause.split-count-when-if
+   (implies (and (logic.functionp x)
+                 (equal (logic.function-name x) 'if)
+                 (equal (len (logic.function-args x)) 3)
+                 (not (clause.negative-termp x)))
+            (equal (clause.split-count x)
+                   (+ 1 (+ (clause.split-count (first (logic.function-args x)))
+                           (+ (clause.split-count (second (logic.function-args x)))
+                              (clause.split-count (third (logic.function-args x))))))))))
+
+
+
+
+(defund clause.split-count-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (+ (clause.split-count (car x))
+         (clause.split-count-list (cdr x)))
+    0))
+
+(encapsulate
+ ()
+ (defthm clause.split-count-list-when-not-consp
+   (implies (not (consp x))
+            (equal (clause.split-count-list x)
+                   0))
+   :hints(("Goal" :in-theory (enable clause.split-count-list))))
+
+ (defthm clause.split-count-list-of-cons
+   (equal (clause.split-count-list (cons a x))
+          (+ (clause.split-count a)
+             (clause.split-count-list x)))
+   :hints(("Goal" :in-theory (enable clause.split-count-list))))
+
+ (defthm natp-of-clause.split-count-list
+   (equal (natp (clause.split-count-list x))
+          t)
+   :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+
+(defund clause.aux-split-goal (todo done)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (or (consp todo)
+                                  (consp done)))))
+  (cond ((and (consp todo)
+              (consp done))
+         (logic.por (clause.clause-formula todo)
+                    (clause.clause-formula done)))
+        ((consp todo)
+         (clause.clause-formula todo))
+        (t
+         (clause.clause-formula done))))
+
+(defthmd clause.aux-split-goal-when-not-consp-of-todo
+   (implies (and (not (consp todo))
+                 (force (consp done)))
+            (equal (clause.aux-split-goal todo done)
+                   (clause.clause-formula done)))
+   :hints(("Goal" :in-theory (enable clause.aux-split-goal))))
+
+
+
+
+(defund clause.aux-split-trivial-branchp (x y rest done)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y)
+                              (logic.term-listp rest)
+                              (logic.term-listp done))))
+  ;; As we split, we often introduce trivial clauses where a term is obvious or where
+  ;; the new literals are the complements of other literals.  In these cases, we want
+  ;; to stop splitting immediately, and just prove the goal formula for the branch.
+  (or (clause.obvious-termp x)
+      (clause.obvious-termp y)
+      (let ((xbar (clause.complement-term x)))
+        (or (equal xbar y)
+            (memberp xbar rest)
+            (memberp xbar done)))
+      (let ((ybar (clause.complement-term y)))
+        (or (memberp ybar rest)
+            (memberp ybar done)))))
+
+(defthm booleanp-of-clause.aux-split-trivial-branchp
+  (equal (booleanp (clause.aux-split-trivial-branchp x y rest done))
+         t)
+  :hints(("Goal" :in-theory (enable clause.aux-split-trivial-branchp))))
+
+
+
+
+(defund@ clause.aux-split-trivial-branch-bldr (x y rest done)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y)
+                              (logic.term-listp rest)
+                              (logic.term-listp done)
+                              (clause.aux-split-trivial-branchp x y rest done))
+                  :guard-hints (("Goal" :in-theory (enable
+                                                    clause.aux-split-trivial-branchp)))))
+
+  ;; Goal is to prove
+  ;; (clause.aux-split-goal (cons x (cons y todo)) done)
+
+  (let* ((xbar          (clause.complement-term x))
+         (ybar          (clause.complement-term y))
+         (todo          (cons x (cons y rest)))
+         (todo-formulas (logic.term-list-formulas todo)))
+
+    (cond ((clause.obvious-termp x)
+           (if (consp done)
+               (@derive
+                ((!= X nil)                  (clause.obvious-term-bldr x))
+                ((v X (v Y T1-Tn))           (build.multi-expansion @- todo-formulas))
+                ((v (v X (v Y T1-Tn)) D1-Dm) (build.right-expansion @- (clause.clause-formula done))))
+             (@derive
+              ((!= X nil)                  (clause.obvious-term-bldr x))
+              ((v X (v Y T1-Tn))           (build.multi-expansion @- todo-formulas)))))
+
+          ((clause.obvious-termp y)
+           (if (consp done)
+               (@derive
+                ((!= Y nil)                  (clause.obvious-term-bldr y))
+                ((v X (v Y T1-Tn))           (build.multi-expansion @- todo-formulas))
+                ((v (v X (v Y T1-Tn)) D1-Dm) (build.right-expansion @- (clause.clause-formula done))))
+             (@derive
+              ((!= Y nil)                  (clause.obvious-term-bldr y))
+              ((v X (v Y T1-Tn))           (build.multi-expansion @- todo-formulas)))))
+
+          ((or (equal xbar y) (memberp xbar rest))
+           (if (consp done)
+               (@derive
+                ((v X (v Y T1-Tn))           (clause.complement-clause-bldr x todo))
+                ((v (v X (v Y T1-Tn)) D1-Dm) (build.right-expansion @- (clause.clause-formula done))))
+             (@derive
+              ((v X (v Y T1-Tn)) (clause.complement-clause-bldr x todo)))))
+
+          ((memberp xbar done)
+           (@derive
+            ((v X D1-Dm)                  (clause.complement-clause-bldr x (cons x done)))
+            ((v X (v (v Y T1-Tn) D1-Dm))  (build.disjoined-left-expansion @- (clause.clause-formula (cons y rest))))
+            ((v (v X (v Y T1-Tn)) D1-Dm)  (build.associativity @-))))
+
+          ((memberp ybar rest)
+           (if (consp done)
+               (@derive
+                ((v X (v Y T1-Tn))           (clause.complement-clause-bldr y todo))
+                ((v (v X (v Y T1-Tn)) D1-Dm) (build.right-expansion @- (clause.clause-formula done))))
+             (@derive
+              ((v X (v Y T1-Tn)) (clause.complement-clause-bldr y todo)))))
+
+          ((memberp ybar done)
+           (if (consp rest)
+               (@derive
+                ((v Y D1-Dm)                  (clause.complement-clause-bldr y (cons y done)))
+                ((v Y (v T1-Tn D1-Dm))        (build.disjoined-left-expansion @- (clause.clause-formula rest)))
+                ((v (v Y T1-Tn) D1-Dm)        (build.associativity @-))
+                ((v X (v (v Y T1-Tn) D1-Dm))  (build.expansion (logic.term-formula x) @-))
+                ((v (v X (v Y T1-Tn)) D1-Dm)  (build.associativity @-)))
+             (@derive
+              ((v Y D1-Dm)        (clause.complement-clause-bldr y (cons y done)))
+              ((v X (v Y D1-Dm))  (build.expansion (logic.term-formula x) @-))
+              ((v (v X Y) D1-Dm)  (build.associativity @-)))))
+
+          (t
+           nil))))
+
+
+(defobligations clause.aux-split-trivial-branch-bldr
+  (clause.obvious-term-bldr
+   build.multi-expansion
+   build.right-expansion
+   clause.complement-clause-bldr
+   build.disjoined-left-expansion
+   build.associativity
+   build.expansion))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-split-trivial-branchp
+                           clause.aux-split-trivial-branch-bldr
+                           clause.aux-split-goal)))
+
+ (defthm logic.appealp-of-clause.aux-split-trivial-branch-bldr
+   (implies (force (and (logic.termp x)
+                        (logic.termp y)
+                        (logic.term-listp rest)
+                        (logic.term-listp done)
+                        (clause.aux-split-trivial-branchp x y rest done)))
+            (equal (logic.appealp (clause.aux-split-trivial-branch-bldr x y rest done))
+                   t)))
+
+ (defthm logic.conclusion-of-clause.aux-split-trivial-branch-bldr
+   (implies (force (and (logic.termp x)
+                        (logic.termp y)
+                        (logic.term-listp rest)
+                        (logic.term-listp done)
+                        (clause.aux-split-trivial-branchp x y rest done)))
+            (equal (logic.conclusion (clause.aux-split-trivial-branch-bldr x y rest done))
+                   (clause.aux-split-goal (cons x (cons y rest)) done))))
+
+ (defthm@ logic.proofp-of-clause.aux-split-trivial-branch-bldr
+   (implies (force (and (logic.termp x)
+                        (logic.termp y)
+                        (logic.term-listp rest)
+                        (logic.term-listp done)
+                        (clause.aux-split-trivial-branchp x y rest done)
+                        ;; ---
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (logic.term-atblp x atbl)
+                        (logic.term-atblp y atbl)
+                        (logic.term-list-atblp rest atbl)
+                        (logic.term-list-atblp done atbl)
+                        (@obligations clause.aux-split-trivial-branch-bldr)))
+            (equal (logic.proofp (clause.aux-split-trivial-branch-bldr x y rest done) axioms thms atbl)
+                   t))))
+
+
+
+
+
+(defund clause.aux-split (todo done)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done))
+                  :verify-guards nil
+                  :measure (clause.split-count-list todo)))
+  (if (consp todo)
+      (let* ((negativep (clause.negative-termp (car todo)))
+             (guts      (if negativep (clause.negative-term-guts (car todo)) (car todo))))
+        (cond
+
+         ((and negativep (clause.negative-termp guts))
+          ;; Cancel (not (not a))
+          (clause.aux-split (cons (clause.negative-term-guts guts) (cdr todo)) done))
+
+         ((and (logic.functionp guts)
+               (equal (logic.function-name guts) 'if)
+               (equal (len (logic.function-args guts)) 3))
+          (let ((args (logic.function-args guts)))
+            (if negativep
+                ;; The first literal is (not (if a b c)).
+                ;; New clause 1: (not a) v (not b) v rest
+                ;; New clause 2: a v (not c) v rest
+                (let ((a      (first args))
+                      (not-a  (logic.function 'not (list (first args))))
+                      (not-b  (logic.function 'not (list (second args))))
+                      (not-c  (logic.function 'not (list (third args))))
+                      (rest   (cdr todo)))
+                  (let ((triv1 (clause.aux-split-trivial-branchp not-a not-b rest done))
+                        (triv2 (clause.aux-split-trivial-branchp a not-c rest done)))
+                    (cond ((and triv1 triv2)
+                           nil)
+                          (triv1
+                           (clause.aux-split (cons a (cons not-c rest)) done))
+                          (triv2
+                           (clause.aux-split (cons not-a (cons not-b rest)) done))
+                          (t
+                           (revappend (clause.aux-split (cons not-a (cons not-b rest)) done)
+                                      (clause.aux-split (cons a (cons not-c rest)) done))))))
+
+              ;; The first literal is (if a b c).
+              ;; New clause 1: (not a) v b v rest
+              ;; New clause 2: a v c v rest
+              (let ((a     (first args))
+                    (not-a (logic.function 'not (list (first args))))
+                    (b     (second args))
+                    (c     (third args))
+                    (rest  (cdr todo)))
+                (let ((triv1 (clause.aux-split-trivial-branchp not-a b rest done))
+                      (triv2 (clause.aux-split-trivial-branchp a c rest done)))
+                  (cond ((and triv1 triv2)
+                         nil)
+                        (triv1
+                         (clause.aux-split (cons a (cons c rest)) done))
+                        (triv2
+                         (clause.aux-split (cons not-a (cons b rest)) done))
+                        (t
+                         (revappend (clause.aux-split (cons not-a (cons b rest)) done)
+                                    (clause.aux-split (cons a (cons c rest)) done)))))))))
+
+         (t
+          ;; We can't split this literal, but we'll normalize it to "(not x)" if it is
+          ;; some other negative-termp variant of not.
+          (clause.aux-split (cdr todo) (cons (if negativep
+                                                 (logic.function 'not (list guts))
+                                               (car todo))
+                                             done)))))
+    (list done)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-split)))
+
+ (defthm true-listp-of-clause.aux-split
+   (equal (true-listp (clause.aux-split todo done))
+          t))
+
+ ;; (defthm consp-of-clause.aux-split
+ ;;    (equal (consp (clause.aux-split todo done))
+ ;;           t))
+
+ ;; (defthm clause.aux-split-under-iff
+ ;;   (iff (clause.aux-split todo done)
+ ;;        t))
+
+ (defthm forcing-term-list-listp-of-clause.aux-split
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)))
+            (equal (logic.term-list-listp (clause.aux-split todo done))
+                   t)))
+
+ (defthm forcing-term-list-list-atblp-of-clause.aux-split
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-list-atblp todo atbl)
+                        (logic.term-list-atblp done atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)))
+            (equal (logic.term-list-list-atblp (clause.aux-split todo done) atbl)
+                   t)))
+
+ (verify-guards clause.aux-split)
+
+ (defthm forcing-cons-listp-of-clause.aux-split
+   (implies (force (or (consp todo) (consp done)))
+            (equal (cons-listp (clause.aux-split todo done))
+                   t))))
+
+
+
+;; We say that clause splitting is "complete" if the resulting clauses contain
+;; only simple terms.  Clearly aux-split is not complete for all terms, because
+;; it only looks for "if" expressions at the top of a literal.  So, even though
+;; it would split (IF X (CONSP Y) (CONSP Z)), it would miss (CONSP (IF X Y Z)).
+;; But aux-split is complete for all "lifted" terms, so we can combine our
+;; clause.lift routine with aux-split to arrive at a complete routine for any
+;; clause.
+;;
+;; The definition of lifted-termp does not line up well with aux-split because
+;; of negative-termps, so we actually show that aux-split is complete for a
+;; larger class of terms, the lifted-gutsp terms, which subsume the lifted
+;; terms.
+
+(defund clause.lifted-gutsp (x)
+  (declare (xargs :guard (logic.termp x)))
+  (if (clause.negative-termp x)
+      (clause.lifted-gutsp (clause.negative-term-guts x))
+    (if (and (logic.functionp x)
+             (equal (logic.function-name x) 'if)
+             (equal (len (logic.function-args x)) 3))
+        (and (clause.lifted-gutsp (first (logic.function-args x)))
+             (clause.lifted-gutsp (second (logic.function-args x)))
+             (clause.lifted-gutsp (third (logic.function-args x))))
+      (clause.simple-termp x))))
+
+(defthm booleanp-of-clause.lifted-gutsp
+  (equal (booleanp (clause.lifted-gutsp x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.lifted-gutsp))))
+
+(defthm forcing-clause.lifted-termp-of-clause.negative-term-guts-when-clause.lifted-termp
+  (implies (and (clause.lifted-termp x)
+                (force (clause.negative-termp x))
+                (force (logic.termp x)))
+           (equal (clause.lifted-termp (clause.negative-term-guts x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.negative-termp clause.negative-term-guts))))
+
+;; (defthm clause.lifted-termp-when-bad-args-logic.functionp
+;;   (implies (and (logic.functionp x)
+;;                 (not (equal (len (logic.function-args x)) 3)))
+;;            (equal (clause.lifted-termp x)
+;;                   (clause.simple-term-listp (logic.function-args x))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+(defthmd lemma-for-forcing-clause.lifted-gutsp-when-clause.lifted-termp
+  (implies (not (logic.functionp x))
+           (equal (clause.lifted-termp x)
+                  (clause.simple-termp x)))
+  :hints(("Goal" :induct (clause.lifted-termp-induction x))))
+
+(defthm forcing-clause.lifted-gutsp-when-clause.lifted-termp
+  (implies (and (clause.lifted-termp x)
+                (force (logic.termp x)))
+           (equal (clause.lifted-gutsp x)
+                  t))
+  :hints(("Goal"
+          :in-theory (enable clause.lifted-gutsp
+                             lemma-for-forcing-clause.lifted-gutsp-when-clause.lifted-termp))))
+
+
+(deflist clause.lifted-guts-listp (x)
+  (clause.lifted-gutsp x)
+  :elementp-of-nil t
+  :guard (logic.term-listp x))
+
+(defthm forcing-clause.lifted-guts-listp-when-clause.lifted-term-listp
+  (implies (and (clause.lifted-term-listp x)
+                (force (logic.term-listp x)))
+           (equal (clause.lifted-guts-listp x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(encapsulate
+ ()
+ (local (defthm lemma1
+          (implies (and (clause.lifted-gutsp x)
+                        (clause.negative-termp x))
+                   (equal (clause.lifted-gutsp (clause.negative-term-guts x))
+                          t))
+          :hints(("Goal" :in-theory (enable clause.lifted-gutsp)))))
+
+ (local (defthm lemma2
+          (equal (clause.lifted-gutsp (logic.function 'not (list arg)))
+                 (clause.lifted-gutsp arg))
+          :hints(("Goal" :in-theory (enable clause.lifted-gutsp)))))
+
+ (local (defthm lemma3
+          (implies (and (clause.lifted-gutsp x)
+                        (not (clause.negative-termp x))
+                        (logic.functionp x)
+                        (equal (logic.function-name x) 'if)
+                        (equal (len (logic.function-args x)) 3))
+                   (equal (clause.lifted-gutsp (first (logic.function-args x)))
+                          t))
+          :hints(("Goal" :expand (clause.lifted-gutsp x)))))
+
+ (local (defthm lemma4
+          (implies (and (clause.lifted-gutsp x)
+                        (not (clause.negative-termp x))
+                        (logic.functionp x)
+                        (equal (logic.function-name x) 'if)
+                        (equal (len (logic.function-args x)) 3))
+                   (equal (clause.lifted-gutsp (second (logic.function-args x)))
+                          t))
+          :hints(("Goal" :expand (clause.lifted-gutsp x)))))
+
+ (local (defthm lemma5
+          (implies (and (clause.lifted-gutsp x)
+                        (not (clause.negative-termp x))
+                        (logic.functionp x)
+                        (equal (logic.function-name x) 'if)
+                        (equal (len (logic.function-args x)) 3))
+                   (equal (clause.lifted-gutsp (third (logic.function-args x)))
+                          t))
+          :hints(("Goal" :expand (clause.lifted-gutsp x)))))
+
+ (local (defthm lemma6
+          (implies (and (clause.lifted-gutsp x)
+                        (not (clause.negative-termp x))
+                        (not (clause.simple-termp x)))
+                   (and (equal (logic.functionp x) t)
+                        (equal (logic.function-name x) 'if)
+                        (equal (len (logic.function-args x)) 3)))
+          :hints(("Goal" :expand (clause.lifted-gutsp x)))))
+
+ (defthm clause.simple-term-list-listp-of-clause.aux-split-when-clause.lifted-guts-listp
+   (implies (and (logic.term-listp todo)
+                 (logic.term-listp done)
+                 (clause.lifted-guts-listp todo)
+                 (clause.simple-term-listp done))
+            (equal (clause.simple-term-list-listp (clause.aux-split todo done))
+                   t))
+   :hints(("Goal"
+           :in-theory (enable clause.aux-split)
+           :induct (clause.aux-split todo done)))))
+
+(defthm clause.simple-term-list-listp-of-clause.aux-split-when-clause.lifted-term-listp
+  (implies (and (logic.term-listp todo)
+                (logic.term-listp done)
+                (clause.lifted-term-listp todo)
+                (clause.simple-term-listp done))
+           (equal (clause.simple-term-list-listp (clause.aux-split todo done))
+                  t)))
+
+
+
+;; (defthmd clause.aux-split-when-double-negative
+;;   (implies (and (clause.negative-termp a)
+;;                 (clause.negative-termp (clause.negative-term-guts a)))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (clause.aux-split (cons (clause.negative-term-guts (clause.negative-term-guts a)) x) done)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-negative-1
+;;   (implies (and (clause.negative-termp a)
+;;                 (not (clause.negative-termp (clause.negative-term-guts a)))
+;;                 (not (logic.functionp (clause.negative-term-guts a))))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (clause.aux-split x (cons (logic.function 'not (list (clause.negative-term-guts a))) done))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-negative-2
+;;   (implies (and (clause.negative-termp a)
+;;                 (not (clause.negative-termp (clause.negative-term-guts a)))
+;;                 (not (equal (logic.function-name (clause.negative-term-guts a)) 'if)))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (clause.aux-split x (cons (logic.function 'not (list (clause.negative-term-guts a))) done))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-negative-3
+;;   (implies (and (clause.negative-termp a)
+;;                 (not (clause.negative-termp (clause.negative-term-guts a)))
+;;                 (not (equal (len (logic.function-args (clause.negative-term-guts a))) 3)))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (clause.aux-split x (cons (logic.function 'not (list (clause.negative-term-guts a))) done))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-negative-4
+;;   (implies (and (clause.negative-termp a)
+;;                 (not (clause.negative-termp (clause.negative-term-guts a)))
+;;                 (logic.functionp (clause.negative-term-guts a))
+;;                 (equal (logic.function-name (clause.negative-term-guts a)) 'if)
+;;                 (equal (len (logic.function-args (clause.negative-term-guts a))) 3))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (let ((args (logic.function-args (clause.negative-term-guts a))))
+;;                     (let ((a      (first args))
+;;                           (not-a  (logic.function 'not (list (first args))))
+;;                           (not-b  (logic.function 'not (list (second args))))
+;;                           (not-c  (logic.function 'not (list (third args))))
+;;                           (rest   x))
+;;                       (let ((part1  (if (clause.aux-split-trivial-branchp not-a not-b rest done)
+;;                                         nil
+;;                                       (clause.aux-split (cons not-a (cons not-b rest)) done)))
+;;                             (part2 (if (clause.aux-split-trivial-branchp a not-c rest done)
+;;                                        nil
+;;                                      (clause.aux-split (cons a (cons not-c rest)) done))))
+;;                         (cond ((and part1 part2)
+;;                                (revappend part1 part2))
+;;                               (part1 part1)
+;;                               (t     part2)))))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-positive-1
+;;   (implies (and (not (clause.negative-termp a))
+;;                 (not (logic.functionp a)))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (clause.aux-split x (cons a done))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-positive-2
+;;   (implies (and (not (clause.negative-termp a))
+;;                 (not (equal (logic.function-name a) 'if)))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (clause.aux-split x (cons a done))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-positive-3
+;;   (implies (and (not (clause.negative-termp a))
+;;                 (not (equal (len (logic.function-args a)) 3)))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (clause.aux-split x (cons a done))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-positive-4
+;;   (implies (and (not (clause.negative-termp a))
+;;                 (logic.functionp a)
+;;                 (equal (logic.function-name a) 'if)
+;;                 (equal (len (logic.function-args a)) 3))
+;;            (equal (clause.aux-split (cons a x) done)
+;;                   (let ((args (logic.function-args a)))
+;;                     (let ((a     (first args))
+;;                           (not-a (logic.function 'not (list (first args))))
+;;                           (b     (second args))
+;;                           (c     (third args))
+;;                           (rest  x))
+;;                       (let ((part1 (if (clause.aux-split-trivial-branchp not-a b rest done)
+;;                                        nil
+;;                                      (clause.aux-split (cons not-a (cons b rest)) done)))
+;;                             (part2 (if (clause.aux-split-trivial-branchp a c rest done)
+;;                                        nil
+;;                                      (clause.aux-split (cons a (cons c rest)) done))))
+;;                         (cond ((and part1 part2)
+;;                                (revappend part1 part2))
+;;                               (part1 part1)
+;;                               (t     part2)))))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (defthmd clause.aux-split-when-not-consp
+;;   (implies (not (consp todo))
+;;            (equal (clause.aux-split todo done)
+;;                   (list done)))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+;; (deftheory clause.aux-split-openers
+;;   '(clause.aux-split-when-double-negative
+;;     clause.aux-split-when-negative-1
+;;     clause.aux-split-when-negative-1
+;;     clause.aux-split-when-negative-2
+;;     clause.aux-split-when-negative-3
+;;     clause.aux-split-when-negative-4
+;;     clause.aux-split-when-positive-1
+;;     clause.aux-split-when-positive-2
+;;     clause.aux-split-when-positive-3
+;;     clause.aux-split-when-positive-4
+;;     clause.aux-split-when-not-consp))
+
+
+
+
+(definlined clause.simple-split (clause)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause))))
+  (clause.aux-split clause nil))
+
+(defthm true-listp-of-clause.simple-split
+  (equal (true-listp (clause.simple-split clause))
+         t)
+  :hints(("Goal" :in-theory (enable clause.simple-split))))
+
+;; (defthm consp-of-clause.simple-split
+;;   (equal (consp (clause.simple-split clause))
+;;          t)
+;;   :hints(("Goal" :in-theory (enable clause.simple-split))))
+
+;; (defthm clause.simple-split-under-iff
+;;   (iff (clause.simple-split clause)
+;;        t)
+;;   :hints(("Goal" :in-theory (enable clause.simple-split))))
+
+(defthm forcing-term-list-listp-of-clause.simple-split
+  (implies (force (logic.term-listp clause))
+           (equal (logic.term-list-listp (clause.simple-split clause))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-split))))
+
+(defthm forcing-term-list-list-atblp-of-clause.simple-split
+  (implies (force (and (logic.term-listp clause)
+                       (logic.term-list-atblp clause atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-list-list-atblp (clause.simple-split clause) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-split))))
+
+(defthm forcing-cons-listp-of-clause.simple-split
+  (implies (force (consp clause))
+           (equal (cons-listp (clause.simple-split clause))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-split))))
+
+(defthm clause.simple-term-list-listp-of-clause.simple-split-when-clause.lifted-term-listp
+  (implies (and (logic.term-listp clause)
+                (clause.lifted-term-listp clause))
+           (equal (clause.simple-term-list-listp (clause.simple-split clause))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-split))))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/basic-bldrs.lisp acl2-6.3/books/milawa/ACL2/clauses/basic-bldrs.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/basic-bldrs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/basic-bldrs.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,484 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(include-book "../build/not")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defderiv clause.substitute-iff-into-literal-bldr
+  :derive (!= (? a) nil)
+  :from   ((proof x (!= (? b) nil))
+           (proof y (= (iff (? a) (? b)) t)))
+  :proof  (@derive
+           ((!= (? b) nil)              (@given x))
+           ((= (iff (? b) t) t)         (build.iff-t-from-not-pequal-nil @-))
+           ((= (iff (? a) (? b)) t)     (@given y))
+           ((= (iff (? a) t) t)         (build.transitivity-of-iff @- @--))
+           ((!= (iff (? a) t) nil)      (build.not-nil-from-t @-))
+           ((!= (? a) nil)              (build.not-pequal-nil-from-iff-t @-))))
+
+
+(defderiv clause.disjoined-substitute-iff-into-literal-bldr
+  :derive (v P (!= (? a) nil))
+  :from   ((proof x (v P (!= (? b) nil)))
+           (proof y (v P (= (iff (? a) (? b)) t))))
+  :proof  (@derive
+           ((v P (!= (? b) nil))             (@given x))
+           ((v P (= (iff (? b) t) t))        (build.disjoined-iff-t-from-not-pequal-nil @-))
+           ((v P (= (iff (? a) (? b)) t))    (@given y))
+           ((v P (= (iff (? a) t) t))        (build.disjoined-transitivity-of-iff @- @--))
+           ((v P (!= (iff (? a) t) nil))     (build.disjoined-not-nil-from-t @-))
+           ((v P (!= (? a) nil))             (build.disjoined-not-pequal-nil-from-iff-t @-))))
+
+
+
+;; Not standardization.
+;;
+;; Negative-termp recognizes many variants of (not x).  We can normalize any of
+;; these to (not x) with standardize-negative-term-bldr.
+
+(deftheorem clause.theorem-standardize-equal-x-nil
+  :derive (= (equal x nil) (not x))
+  :proof  (@derive
+           ((v (= x y) (= (equal x y) nil))                (build.axiom (axiom-equal-when-diff)))
+           ((v (= x nil) (= (equal x nil) nil))            (build.instantiation @- (@sigma (y . nil)))          *1a)
+           ((v (= x nil) (= (if x y z) y))                 (build.axiom (axiom-if-when-not-nil)))
+           ((v (= x nil) (= (if x nil t) nil))             (build.instantiation @- (@sigma (y . nil) (z . t))))
+           ((v (= x nil) (= nil (if x nil t)))             (build.disjoined-commute-pequal @-))
+           ((v (= x nil) (= (equal x nil) (if x nil t)))   (build.disjoined-transitivity-of-pequal *1a @-)      *1)
+           ;; ---
+           ((v (!= x y) (= (equal x y) t))                 (build.axiom (axiom-equal-when-same)))
+           ((v (!= x nil) (= (equal x nil) t))             (build.instantiation @- (@sigma (y . nil)))          *2a)
+           ((v (!= x nil) (= (if x y z) z))                (build.axiom (axiom-if-when-nil)))
+           ((v (!= x nil) (= (if x nil t) t))              (build.instantiation @- (@sigma (y . nil) (z . t))))
+           ((v (!= x nil) (= t (if x nil t)))              (build.disjoined-commute-pequal @-))
+           ((v (!= x nil) (= (equal x nil) (if x nil t)))  (build.disjoined-transitivity-of-pequal *2a @-)      *2)
+           ;; ---
+           ((v (= (equal x nil) (if x nil t))
+               (= (equal x nil) (if x nil t)))             (build.cut *1 *2))
+           ((= (equal x nil) (if x nil t))                 (build.contraction @-)                               *3)
+           ((= (not x) (if x nil t))                       (build.axiom (definition-of-not)))
+           ((= (if x nil t) (not x))                       (build.commute-pequal @-))
+           ((= (equal x nil) (not x))                      (build.transitivity-of-pequal *3 @-)))
+  :minatbl ((if . 3)
+            (equal . 2)
+            (not . 1)))
+
+(deftheorem clause.theorem-standardize-equal-nil-x
+  :derive (= (equal nil x) (not x))
+  :proof  (@derive
+           ((= (equal x y) (equal y x))      (build.theorem (theorem-symmetry-of-equal)))
+           ((= (equal nil x) (equal x nil))  (build.instantiation @- (@sigma (x . nil) (y . x))))
+           ((= (equal x nil) (not x))        (build.theorem (clause.theorem-standardize-equal-x-nil)))
+           ((= (equal nil x) (not x))        (build.transitivity-of-pequal @-- @-)))
+  :minatbl ((equal . 2)
+            (if . 3)
+            (not . 1)))
+
+(deftheorem clause.theorem-standardize-iff-x-nil
+  :derive (= (iff x nil) (not x))
+  :proof  (@derive
+           ((v (!= x nil) (= (not x) t))                   (build.theorem (theorem-not-when-nil)))
+           ((v (!= x nil) (= t (not x)))                   (build.disjoined-commute-pequal @-))
+           ((v (!= x nil) (= (iff x nil) t))               (build.theorem (theorem-iff-nil-when-nil)))
+           ((v (!= x nil) (= (iff x nil) (not x)))         (build.disjoined-transitivity-of-pequal @- @--) *1)
+
+           ((v (= x nil) (= (not x) nil))                  (build.theorem (theorem-not-when-not-nil)))
+           ((v (= x nil) (= nil (not x)))                  (build.disjoined-commute-pequal @-))
+           ((v (= x nil) (= (iff x nil) nil))              (build.theorem (theorem-iff-nil-when-not-nil)))
+           ((v (= x nil) (= (iff x nil) (not x)))          (build.disjoined-transitivity-of-pequal @- @--))
+
+           ((v (= (iff x nil) (not x))
+               (= (iff x nil) (not x)))                    (build.cut @- *1))
+           ((= (iff x nil) (not x))                        (build.contraction @-)))
+  :minatbl ((iff . 2)
+            (equal . 2)
+            (not . 1)))
+
+(deftheorem clause.theorem-standardize-iff-nil-x
+  :derive (= (iff nil x) (not x))
+  :proof  (@derive
+           ((= (iff x y) (iff y x))        (build.theorem (theorem-symmetry-of-iff)))
+           ((= (iff nil x) (iff x nil))    (build.instantiation @- (@sigma (x . nil) (y . x))))
+           ((= (iff x nil) (not x))        (build.theorem (clause.theorem-standardize-iff-x-nil)))
+           ((= (iff nil x) (not x))        (build.transitivity-of-pequal @-- @-)))
+  :minatbl ((iff . 2)
+            (not . 1)))
+
+
+
+(defund@ clause.standardize-negative-term-bldr (x)
+  ;; Prove that any negative term is equal to (not guts).
+  (declare (xargs :guard (and (logic.termp x)
+                              (clause.negative-termp x))
+                  :guard-hints (("Goal" :in-theory (enable clause.negative-termp
+                                                           definition-of-not
+                                                           clause.theorem-standardize-equal-x-nil
+                                                           clause.theorem-standardize-equal-nil-x
+                                                           clause.theorem-standardize-iff-nil-x
+                                                           clause.theorem-standardize-iff-x-nil)))))
+  (let ((name (logic.function-name x))
+        (args (logic.function-args x)))
+    (cond ((equal name 'not)
+           ;; Found (not guts)
+           (@derive ((= (not guts) (not guts))             (build.reflexivity x))))
+          ((equal name 'if)
+           ;; Found (if guts nil t).
+           (@derive ((= (not x) (if x nil t))              (build.axiom (definition-of-not)))
+                    ((= (if x nil t) (not x))              (build.commute-pequal @-))
+                    ((= (if guts nil t) (not guts))        (build.instantiation @- (list (cons 'x (first args)))))))
+          ((equal name 'equal)
+           (if (equal (first args) ''nil)
+               ;; Found (equal nil guts).
+               (@derive ((= (equal nil x) (not x))         (build.theorem (clause.theorem-standardize-equal-nil-x)))
+                        ((= (equal nil guts) (not guts))   (build.instantiation @- (list (cons 'x (second args))))))
+             ;; Found (equal guts nil)
+             (@derive ((= (equal x nil) (not x))           (build.theorem (clause.theorem-standardize-equal-x-nil)))
+                      ((= (equal guts nil) (not guts))     (build.instantiation @- (list (cons 'x (first args))))))))
+          (t
+           (if (equal (first args) ''nil)
+               ;; Found (iff nil guts)
+               (@derive ((= (iff nil x) (not x))           (build.theorem (clause.theorem-standardize-iff-nil-x)))
+                        ((= (iff nil guts) (not guts))     (build.instantiation @- (list (cons 'x (second args))))))
+             ;; Found (iff guts nil)
+             (@derive ((= (iff x nil) (not x))             (build.theorem (clause.theorem-standardize-iff-x-nil)))
+                      ((= (iff guts nil) (not guts))       (build.instantiation @- (list (cons 'x (first args)))))))))))
+
+(defobligations clause.standardize-negative-term-bldr
+  (build.reflexivity build.commute-pequal build.instantiation)
+  :extra-axioms ((definition-of-not))
+  :extra-thms ((clause.theorem-standardize-equal-nil-x)
+               (clause.theorem-standardize-equal-x-nil)
+               (clause.theorem-standardize-iff-nil-x)
+               (clause.theorem-standardize-iff-x-nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.standardize-negative-term-bldr
+                           clause.negative-termp
+                           clause.negative-term-guts
+                           definition-of-not
+                           clause.theorem-standardize-equal-nil-x
+                           clause.theorem-standardize-equal-x-nil
+                           clause.theorem-standardize-iff-nil-x
+                           clause.theorem-standardize-iff-x-nil)))
+
+ (defthm forcing-logic.appealp-of-clause.standardize-negative-term-bldr
+   (implies (force (and (logic.termp x)
+                        (clause.negative-termp x)))
+            (equal (logic.appealp (clause.standardize-negative-term-bldr x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.standardize-negative-term-bldr
+   (implies (force (and (logic.termp x)
+                        (clause.negative-termp x)))
+            (equal (logic.conclusion (clause.standardize-negative-term-bldr x))
+                   (logic.pequal x (logic.function 'not (list (clause.negative-term-guts x)))))))
+
+ (defthm@ forcing-logic.proofp-of-clause.standardize-negative-term-bldr
+   (implies (force (and (logic.termp x)
+                        (clause.negative-termp x)
+                        ;; ---
+                        (logic.term-atblp x atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.standardize-negative-term-bldr)))
+            (equal (logic.proofp (clause.standardize-negative-term-bldr x) axioms thms atbl)
+                   t))))
+
+
+
+(defund clause.standardize-negative-term-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.standardize-negative-term-bldr)
+         (equal extras nil)
+         (equal subproofs nil)
+         (equal (logic.fmtype conclusion) 'pequal*)
+         (let ((lhs (logic.=lhs conclusion))
+               (rhs (logic.=rhs conclusion)))
+           (and (logic.term-atblp lhs atbl)
+                (clause.negative-termp lhs)
+                (equal rhs (logic.function 'not (list (clause.negative-term-guts lhs)))))))))
+
+(defund clause.standardize-negative-term-bldr-high (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (clause.negative-termp x))))
+  (logic.appeal 'clause.standardize-negative-term-bldr
+                (logic.pequal x (logic.function 'not (list (clause.negative-term-guts x))))
+                nil
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.standardize-negative-term-bldr-okp)))
+
+ (defthm booleanp-of-clause.standardize-negative-term-bldr-okp
+   (equal (booleanp (clause.standardize-negative-term-bldr-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm clause.standardize-negative-term-bldr-okp-of-logic.appeal-identity
+   (equal (clause.standardize-negative-term-bldr-okp (logic.appeal-identity x) atbl)
+          (clause.standardize-negative-term-bldr-okp x atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthm lemma-1-for-soundness-of-clause.standardize-negative-term-bldr-okp
+   (implies (and (clause.standardize-negative-term-bldr-okp x atbl)
+                 (logic.appealp x))
+            (equal (logic.conclusion (clause.standardize-negative-term-bldr (logic.=lhs (logic.conclusion x))))
+                   (logic.conclusion x))))
+
+ (defthm@ lemma-2-for-soundness-of-clause.standardize-negative-term-bldr-okp
+   (implies (and (clause.standardize-negative-term-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (@obligations clause.standardize-negative-term-bldr)
+                 (equal (cdr (lookup 'not atbl)) 1))
+            (equal (logic.proofp (clause.standardize-negative-term-bldr (logic.=lhs (logic.conclusion x)))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.standardize-negative-term-bldr-okp
+   (implies (and (clause.standardize-negative-term-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.standardize-negative-term-bldr)
+                             (equal (cdr (lookup 'not atbl)) 1))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.standardize-negative-term-bldr-okp
+                               lemma-2-for-soundness-of-clause.standardize-negative-term-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.standardize-negative-term-bldr (logic.=lhs (logic.conclusion x))))))))))
+
+
+
+
+
+
+(defund@ clause.standardize-double-negative-term-bldr (a)
+  ;; Prove that any double-negative term is equal to (not (not guts')), where
+  ;; guts' is the guts of its guts.
+  (declare (xargs :guard (and (logic.termp a)
+                              (clause.negative-termp a)
+                              (clause.negative-termp (clause.negative-term-guts a)))))
+  (let* ((guts (clause.negative-term-guts a)))
+    (@derive ((= guts (not guts-prime))               (clause.standardize-negative-term-bldr guts))
+             ((= (not guts) (not (not guts-prime)))   (build.pequal-by-args 'not (list @-)))
+             ((= a (not guts))                        (clause.standardize-negative-term-bldr a))
+             ((= a (not (not guts-prime)))            (build.transitivity-of-pequal @- @--)))))
+
+(defobligations clause.standardize-double-negative-term-bldr
+  (clause.standardize-negative-term-bldr build.pequal-by-args build.transitivity-of-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.standardize-double-negative-term-bldr)))
+
+ (defthm forcing-logic.appealp-of-clause.standardize-double-negative-term-bldr
+   (implies (force (and (logic.termp a)
+                        (clause.negative-termp a)
+                        (clause.negative-termp (clause.negative-term-guts a))))
+            (equal (logic.appealp (clause.standardize-double-negative-term-bldr a))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.standardize-double-negative-term-bldr
+   (implies (force (and (logic.termp a)
+                        (clause.negative-termp a)
+                        (clause.negative-termp (clause.negative-term-guts a))))
+            (equal (logic.conclusion (clause.standardize-double-negative-term-bldr a))
+                   (logic.pequal a (logic.function 'not (list (logic.function 'not (list (clause.negative-term-guts (clause.negative-term-guts a))))))))))
+
+ (defthm@ forcing-logic.proofp-of-clause.standardize-double-negative-term-bldr
+   (implies (force (and (logic.termp a)
+                        (clause.negative-termp a)
+                        (clause.negative-termp (clause.negative-term-guts a))
+                        ;; ---
+                        (logic.term-atblp a atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.standardize-double-negative-term-bldr)))
+            (equal (logic.proofp (clause.standardize-double-negative-term-bldr a) axioms thms atbl)
+                   t))))
+
+
+
+(defund clause.standardize-double-negative-term-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.standardize-double-negative-term-bldr)
+         (equal extras nil)
+         (equal subproofs nil)
+         (equal (logic.fmtype conclusion) 'pequal*)
+         (let ((lhs (logic.=lhs conclusion))
+               (rhs (logic.=rhs conclusion)))
+           (and (clause.negative-termp lhs)
+                (clause.negative-termp (clause.negative-term-guts lhs))
+                (logic.term-atblp lhs atbl)
+                (equal rhs (logic.function 'not (list
+                            (logic.function 'not (list
+                             (clause.negative-term-guts
+                              (clause.negative-term-guts lhs))))))))))))
+
+(defund clause.standardize-double-negative-term-bldr-high (a)
+  (declare (xargs :guard (and (logic.termp a)
+                              (clause.negative-termp a)
+                              (clause.negative-termp (clause.negative-term-guts a)))))
+  (logic.appeal 'clause.standardize-double-negative-term-bldr
+                (logic.pequal a (logic.function 'not (list
+                                 (logic.function 'not (list
+                                  (clause.negative-term-guts
+                                   (clause.negative-term-guts a)))))))
+                nil
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.standardize-double-negative-term-bldr-okp)))
+
+ (defthm booleanp-of-clause.standardize-double-negative-term-bldr-okp
+   (equal (booleanp (clause.standardize-double-negative-term-bldr-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm clause.standardize-double-negative-term-bldr-okp-of-logic.appeal-identity
+   (equal (clause.standardize-double-negative-term-bldr-okp (logic.appeal-identity x) atbl)
+          (clause.standardize-double-negative-term-bldr-okp x atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthm lemma-1-for-soundness-of-clause.standardize-double-negative-term-bldr-okp
+   (implies (and (clause.standardize-double-negative-term-bldr-okp x atbl)
+                 (logic.appealp x))
+            (equal (logic.conclusion (clause.standardize-double-negative-term-bldr (logic.=lhs (logic.conclusion x))))
+                   (logic.conclusion x))))
+
+ (defthm@ lemma-2-for-soundness-of-clause.standardize-double-negative-term-bldr-okp
+   (implies (and (clause.standardize-double-negative-term-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (@obligations clause.standardize-double-negative-term-bldr)
+                 (equal (cdr (lookup 'not atbl)) 1))
+            (equal (logic.proofp (clause.standardize-double-negative-term-bldr (logic.=lhs (logic.conclusion x)))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.standardize-double-negative-term-bldr-okp
+   (implies (and (clause.standardize-double-negative-term-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.standardize-double-negative-term-bldr)
+                             (equal (cdr (lookup 'not atbl)) 1))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.standardize-double-negative-term-bldr-okp
+                               lemma-2-for-soundness-of-clause.standardize-double-negative-term-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.standardize-double-negative-term-bldr (logic.=lhs (logic.conclusion x))))))))))
+
+
+
+
+(defund@ clause.standardize-double-negative-term-under-iff-bldr (a)
+  ;; Prove that any double-negative term is iff to (not (not guts')), where
+  ;; guts' is the guts of its guts.
+  (declare (xargs :guard (and (logic.termp a)
+                              (clause.negative-termp a)
+                              (clause.negative-termp (clause.negative-term-guts a)))
+                  :guard-hints (("Goal" :in-theory (enable theorem-not-of-not-under-iff)))))
+  (let ((guts-prime (clause.negative-term-guts (clause.negative-term-guts a))))
+    (@derive
+     ((= a (not (not guts-prime)))                   (clause.standardize-double-negative-term-bldr a))
+     ((= (iff a (not (not guts-prime))) t)           (build.iff-from-pequal @-)                           *1)
+     ((= (iff (not (not x)) x) t)                    (build.theorem (theorem-not-of-not-under-iff)))
+     ((= (iff (not (not guts-prime)) guts-prime) t)  (build.instantiation @- (list (cons 'x guts-prime))))
+     ((= (iff a guts-prime) t)                       (build.transitivity-of-iff *1 @-)))))
+
+(defobligations clause.standardize-double-negative-term-under-iff-bldr
+  (clause.standardize-double-negative-term-bldr
+   build.iff-from-pequal build.instantiation build.transitivity-of-iff)
+  :extra-thms ((theorem-not-of-not-under-iff)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.standardize-double-negative-term-under-iff-bldr
+                           theorem-not-of-not-under-iff)))
+
+ (defthm forcing-logic.appealp-of-clause.standardize-double-negative-term-under-iff-bldr
+   (implies (force (and (logic.termp a)
+                        (clause.negative-termp a)
+                        (clause.negative-termp (clause.negative-term-guts a))))
+            (equal (logic.appealp (clause.standardize-double-negative-term-under-iff-bldr a))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.standardize-double-negative-term-under-iff-bldr
+   (implies (force (and (logic.termp a)
+                        (clause.negative-termp a)
+                        (clause.negative-termp (clause.negative-term-guts a))))
+            (equal (logic.conclusion (clause.standardize-double-negative-term-under-iff-bldr a))
+                   (let* ((guts-prime         (clause.negative-term-guts (clause.negative-term-guts a))))
+                     (logic.pequal (logic.function 'iff (list a guts-prime))
+                                   ''t)))))
+
+ (defthm@ forcing-logic.proofp-of-clause.standardize-double-negative-term-under-iff-bldr
+   (implies (force (and (logic.termp a)
+                        (clause.negative-termp a)
+                        (clause.negative-termp (clause.negative-term-guts a))
+                        ;; ---
+                        (logic.term-atblp a atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations clause.standardize-double-negative-term-under-iff-bldr)))
+            (equal (logic.proofp (clause.standardize-double-negative-term-under-iff-bldr a) axioms thms atbl)
+                   t))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/basic.lisp acl2-6.3/books/milawa/ACL2/clauses/basic.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/basic.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,253 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../logic/top")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Clauses
+;;
+;; We use CLAUSES to represent our goals in goal-directed proof construction.
+;; Each clause represents a disjunction of terms, i.e., L1 v ... v Ln, which
+;; more accurately should be written as L1 != nil v ... v L1 != nil.  We just
+;; use term lists to represent a clausees, but the empty clause does not have a
+;; well defined meaning and we consider it to be degenerate.  The terms in a
+;; clause are called LITERALS.
+
+(defund clause.clause-formula (x)
+  ;; NOTE: we (effectively) leave this function enabled via the redefinition rule below!
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x))))
+  (if (consp x)
+      (if (consp (cdr x))
+          (logic.por (logic.term-formula (car x))
+                     (clause.clause-formula (cdr x)))
+        (logic.term-formula (car x)))
+    nil))
+
+(defthm redefinition-of-clause.clause-formula
+  (equal (clause.clause-formula x)
+         (logic.disjoin-formulas (logic.term-list-formulas x)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.clause-formula logic.disjoin-formulas))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.clause-formula))))
+
+
+
+(defund clause.clause-list-formulas (x)
+  ;; NOTE: we (effectively) leave this function enabled via the redefinition rule below!
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x))))
+  (if (consp x)
+      (cons (clause.clause-formula (car x))
+            (clause.clause-list-formulas (cdr x)))
+    nil))
+
+(defthm redefinition-of-clause.clause-list-formulas
+  (equal (clause.clause-list-formulas x)
+         (logic.disjoin-each-formula-list (logic.term-list-list-formulas x)))
+  :hints(("Goal" :in-theory (enable clause.clause-list-formulas))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.clause-list-formulas))))
+
+
+
+
+
+;; Polarity of literals.
+;;
+;; We sometimes talk about literals being POSITIVE or NEGATIVE.  A literal is
+;; positive unless it matches one of the following patterns:
+;;
+;;    (not x)
+;;    (if x nil t)
+;;    (equal x nil)
+;;    (equal nil x)
+;;    (iff x nil)
+;;    (iff nil x)
+;;
+;; The GUTS of a negative literals are the term being negated, e.g., the guts
+;; of (not (consp 3)) are (consp 3).  The guts of a positive literal are the
+;; entire literal, i.e., the guts of (+ 1 2) are (+ 1 2).
+
+(definlined clause.negative-termp (x)
+  (declare (xargs :guard (logic.termp x)))
+  (and (logic.functionp x)
+       (let ((name (logic.function-name x))
+             (args (logic.function-args x)))
+         (or (and (equal name 'not)
+                  (equal (len args) 1))
+             (and (equal name 'if)
+                  (equal (len args) 3)
+                  (equal (second args) ''nil)
+                  (equal (third args) ''t))
+             (and (equal name 'equal)
+                  (equal (len args) 2)
+                  (or (equal (first args) ''nil)
+                      (equal (second args) ''nil)))
+             (and (equal name 'iff)
+                  (equal (len args) 2)
+                  (or (equal (first args) ''nil)
+                      (equal (second args) ''nil)))))))
+
+(defthm booleanp-of-clause.negative-termp
+  (equal (booleanp (clause.negative-termp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (clause.negative-termp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm clause.negative-termp-of-logic.function-of-not
+  (equal (clause.negative-termp (logic.function 'not args))
+         (equal (len args) 1))
+  :hints(("Goal" :in-theory (enable clause.negative-termp))))
+
+(defthm logic.functionp-when-clause.negative-termp
+  (implies (clause.negative-termp x)
+           (equal (logic.functionp x)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.negative-termp))))
+
+
+
+(definlined clause.negative-term-guts (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (clause.negative-termp x))
+                  :guard-hints (("Goal" :in-theory (enable clause.negative-termp)))))
+  (let ((name (logic.function-name x))
+        (args (logic.function-args x)))
+    (cond ((equal name 'not)
+           (first args))
+          ((equal name 'if)
+           (first args))
+          ((equal name 'equal)
+           (if (equal (first args) ''nil)
+               (second args)
+             (first args)))
+          ((equal name 'iff)
+           (if (equal (first args) ''nil)
+               (second args)
+             (first args)))
+          (t nil))))
+
+(defthm forcing-logic.termp-of-clause.negative-term-guts
+  (implies (force (and (logic.termp x)
+                       (clause.negative-termp x)))
+           (equal (logic.termp (clause.negative-term-guts x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.negative-termp clause.negative-term-guts))))
+
+(defthm forcing-logic.term-atblp-of-clause.negative-term-guts
+  (implies (force (and (logic.termp x)
+                       (logic.term-atblp x atbl)
+                       (clause.negative-termp x)))
+           (equal (logic.term-atblp (clause.negative-term-guts x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.negative-termp clause.negative-term-guts))))
+
+(defthm clause.negative-term-guts-of-logic.function-of-not
+  (equal (clause.negative-term-guts (logic.function 'not args))
+         (first args))
+  :hints(("Goal" :in-theory (enable clause.negative-term-guts))))
+
+(defthm rank-of-clause.negative-term-guts-when-clause.negative-termp
+  (implies (clause.negative-termp x)
+           (equal (< (rank (clause.negative-term-guts x))
+                     (rank x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.negative-term-guts
+                                    clause.negative-termp
+                                    logic.function-args ;; yuck but whatever
+                                    ))))
+
+(defthm rank-of-clause.negative-term-guts-of-clause.negative-term-guts
+  (implies (and (clause.negative-termp x)
+                (clause.negative-termp (clause.negative-term-guts x)))
+           (equal (< (rank (clause.negative-term-guts (clause.negative-term-guts x)))
+                     (rank x))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable rank-of-clause.negative-term-guts-when-clause.negative-termp)
+          :use ((:instance rank-of-clause.negative-term-guts-when-clause.negative-termp
+                           (x (clause.negative-term-guts x)))
+                (:instance rank-of-clause.negative-term-guts-when-clause.negative-termp)))))
+
+
+
+(definlined clause.term-guts (x)
+  (declare (xargs :guard (logic.termp x)))
+  (if (clause.negative-termp x)
+      (clause.negative-term-guts x)
+    x))
+
+(defthm forcing-logic.termp-of-clause.term-guts
+  (implies (force (logic.termp x))
+           (equal (logic.termp (clause.term-guts x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.term-guts))))
+
+(defthm forcing-logic.term-atblp-of-clause.term-guts
+  (implies (force (and (logic.termp x)
+                       (logic.term-atblp x atbl)))
+           (equal (logic.term-atblp (clause.term-guts x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.term-guts))))
+
+
+
+
+(defprojection :list (clause.term-list-guts x)
+               :element (clause.term-guts x)
+               :guard (logic.term-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-clause.term-list-guts
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (clause.term-list-guts x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-clause.term-list-guts
+  (implies (force (and (logic.term-listp x)
+                       (logic.term-list-atblp x atbl)))
+           (equal (logic.term-list-atblp (clause.term-list-guts x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/cert.acl2 acl2-6.3/books/milawa/ACL2/clauses/cert.acl2
--- acl2-6.2/books/milawa/ACL2/clauses/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/cert.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/clean-clauses.lisp acl2-6.3/books/milawa/ACL2/clauses/clean-clauses.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/clean-clauses.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/clean-clauses.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1516 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(include-book "basic-bldrs")
+(include-book "update-clause-iff-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Clause cleaning.
+;;
+;; In this file, we introduce a function to clean up clause lists in some
+;; trivial ways:
+;;
+;;   1. We eliminate double negation from the tops of literals,
+;;   2. We standardize all not-variants to (not guts),
+;;   3. We eliminate any clauses with "obvious" literals,
+;;   4. We eliminate any clauses with complementary literals,
+;;   5. We remove any "absurd" literals from each clause,
+;;   6. We remove any duplicate literals within each clause, and
+;;   7. We eliminate any "subsumed" clauses from the list.
+;;
+;; This process will generate a new list of clauses which should be nicer to
+;; look at and perhaps easier to prove.  Given proofs of these resulting
+;; clauses, we can create proofs of the original clauses using our cleanup
+;; builder.
+;;
+;; Eliminating double negation is useful because it allows us to identify more
+;; literals as obvious, complementary, or absurd.  It also is nicer to look at
+;; clauses which don't have terms like (not (not x)).
+;;
+;; Standardizing not variants such as (if x t nil) to (not x) allows us to more
+;; easily search for complementary literals and gives a clenaer presentation to
+;; the reader.
+;;
+;; Each literal in the clause stands for the formula L != nil.  If a literal is
+;; a constant, or if it is negative and its guts are a constant as in (NOT 3)
+;; or (EQUAL 5 NIL), then we can immediately tell if this formula will be
+;; valid.
+;;
+;;   Example: 3 and (NOT NIL) are "obvious" since 3 != NIL and (NOT NIL) != NIL
+;;            are clearly true.
+;;
+;;   Example: NIL and (NOT 5) are "absurd" since NIL != NIL and (NOT 5) != NIL
+;;            are clearly false.
+;;
+;; Obvious literals are useful since finding one will immediately let us prove
+;; the clause: all we need to do is build a proof of L != nil, then expand this
+;; proof with the formulas for the other literals.  This is even efficient;
+;; it's just multi-expansion.
+;;
+;; Complementary literals, i.e., x and (not x), are useful because we can
+;; immediately prove any clause containing them, since we know that one of x or
+;; (not x) must hold.
+;;
+;; Absurd literals are useless in the sense that they are false, and we can
+;; only prove A v FALSE when we can prove A.  By removing these literals from
+;; each clause, we can reduce the amount that our users and clause processing
+;; routines need to look at, which seems like progress.
+;;
+;; Duplicate literals are also useless since we can prove A v A exactly when we
+;; can prove A.  As with absurd literals, we remove duplicates from each clause
+;; so that we don't need to look at so many literals.
+;;
+;; A clause "subsumes" any of its supersets, e.g., A v B subsumes A v B v C.
+;; Recall that a clause list represents a list of goals we are trying to prove,
+;; so if both of these clauses appear in our list, we only need to prove A v B
+;; since A v B implies A v B v C.  We therefore throw away any supersets we
+;; find, which also has the effect of reoving duplicate clauses.
+
+
+
+(local (defthm split-up-list-of-quoted-nil
+          ;; We normally don't break up constants, but this one gets in the way if we don't.
+          (equal (equal x '('nil))
+                 (and (consp x)
+                      (equal (car x) ''nil)
+                      (not (cdr x))))))
+
+
+
+
+(definlined clause.simple-negativep (x)
+  ;; We say a term of the form (not foo) is a "simple negative term".  These
+  ;; will come into play in a useful optimization later on.
+  (declare (xargs :guard (logic.termp x)))
+  (and (logic.functionp x)
+       (equal (logic.function-name x) 'not)
+       (equal (len (logic.function-args x)) 1)))
+
+(definlined clause.simple-negative-guts (x)
+  ;; Given a simple negative term, say (not foo), we call "foo" the guts of
+  ;; the term.
+  (declare (xargs :guard (and (logic.termp x)
+                              (clause.simple-negativep x))
+                  :guard-hints (("Goal" :in-theory (enable clause.simple-negativep)))))
+  (first (logic.function-args x)))
+
+(defthm booleanp-of-clause.simple-negativep
+  (equal (booleanp (clause.simple-negativep x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.simple-negativep))))
+
+(defthm forcing-logic.termp-of-clause.simple-negative-guts
+  (implies (force (and (logic.termp x)
+                       (clause.simple-negativep x)))
+           (equal (logic.termp (clause.simple-negative-guts x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-negativep clause.simple-negative-guts))))
+
+(defthm forcing-logic.term-atblp-of-clause.simple-negative-guts
+  (implies (force (and (logic.termp x)
+                       (logic.term-atblp x atbl)
+                       (clause.simple-negativep x)))
+           (equal (logic.term-atblp (clause.simple-negative-guts x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-negativep clause.simple-negative-guts))))
+
+(defthm clause.simple-negativep-of-logic.function-of-not
+  (equal (clause.simple-negativep (logic.function 'not (list a)))
+         t)
+  :hints(("Goal" :in-theory (enable clause.simple-negativep))))
+
+(defthm clause.negative-termp-when-clause.simple-negativep
+  (implies (clause.simple-negativep x)
+           (equal (clause.negative-termp x)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-negativep
+                                    clause.negative-termp))))
+
+(defthm clause.simple-negative-guts-of-logic.function-of-not
+  (equal (clause.simple-negative-guts (logic.function 'not (list a)))
+         a)
+  :hints(("Goal" :in-theory (enable clause.simple-negative-guts))))
+
+(defthm clause.simple-negative-guts-identity
+  (implies (and (clause.simple-negativep x)
+                (force (logic.termp x)))
+           (equal (logic.function 'not (list (clause.simple-negative-guts x)))
+                  x))
+  :hints(("Goal" :in-theory (enable clause.simple-negativep
+                                    clause.simple-negative-guts))))
+
+(defthm forcing-clause.simple-negative-guts-under-iff
+  (implies (force (and (clause.simple-negativep x)
+                       (logic.termp x)))
+           (iff (clause.simple-negative-guts x)
+                t))
+  :hints(("Goal" :in-theory (enable clause.simple-negative-guts
+                                    clause.simple-negativep))))
+
+
+
+(defund clause.double-negative-free-listp (x)
+  ;; We say a list of terms is double-negative free if it has no terms of
+  ;; the form (not (not x)).
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (and (or (not (clause.simple-negativep (car x)))
+               (not (clause.simple-negativep (clause.simple-negative-guts (car x)))))
+           (clause.double-negative-free-listp (cdr x)))
+    t))
+
+(defthm clause.double-negative-free-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.double-negative-free-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.double-negative-free-listp))))
+
+(defthm clause.double-negative-free-listp-of-cons
+  (equal (clause.double-negative-free-listp (cons a x))
+         (and (or (not (clause.simple-negativep a))
+                  (not (clause.simple-negativep (clause.simple-negative-guts a))))
+              (clause.double-negative-free-listp x)))
+  :hints(("Goal" :in-theory (enable clause.double-negative-free-listp))))
+
+(defthm booleanp-of-clause.double-negative-free-listp
+  (equal (booleanp (clause.double-negative-free-listp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.double-negative-free-listp-of-list-fix
+  (equal (clause.double-negative-free-listp (list-fix x))
+         (clause.double-negative-free-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.double-negative-free-listp-of-app
+  (equal (clause.double-negative-free-listp (app x y))
+         (and (clause.double-negative-free-listp x)
+              (clause.double-negative-free-listp y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.double-negative-free-listp-of-rev
+  (equal (clause.double-negative-free-listp (rev x))
+         (clause.double-negative-free-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(definlined clause.normalize-nots-term (x)
+  ;; We only apply to the "top" of a term.  We eliminate any double negation,
+  ;; and also standardize the term, if it is negative, to (not guts).
+  (declare (xargs :guard (logic.termp x)))
+  (if (clause.negative-termp x)
+      (let ((guts (clause.negative-term-guts x)))
+        (if (clause.negative-termp guts)
+            (clause.normalize-nots-term (clause.negative-term-guts guts))
+          (logic.function 'not (list guts))))
+    x))
+
+(defthm forcing-logic.termp-of-clause.normalize-nots-term
+  (implies (force (logic.termp x))
+           (equal (logic.termp (clause.normalize-nots-term x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.normalize-nots-term))))
+
+(defthm forcing-logic.term-atblp-of-clause.normalize-nots-term
+  (implies (force (and (logic.termp x)
+                       (logic.term-atblp x atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-atblp (clause.normalize-nots-term x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.normalize-nots-term))))
+
+(defthm no-double-negatives-after-clause.normalize-nots-term
+  (implies (clause.simple-negativep (clause.normalize-nots-term x))
+           (equal (clause.simple-negativep
+                   (clause.simple-negative-guts
+                    (clause.normalize-nots-term x)))
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.normalize-nots-term))))
+
+
+
+
+
+(defund@ clause.normalize-nots-term-bldr (a)
+  ;; Prove (iff a (clause.normalize-nots-term a)) = t
+  (declare (xargs :guard (logic.termp a)
+                  :verify-guards nil))
+  (if (not (clause.negative-termp a))
+      ;; A is positive; no cancellation.
+      (@derive ((= (iff a a) t)                                     (build.iff-reflexivity a)))
+    (let ((guts (clause.negative-term-guts a)))
+      (if (not (clause.negative-termp guts))
+          ;; A has positive guts; we normalize it.
+          (@derive ((= a (not guts))                                (clause.standardize-negative-term-bldr a))
+                   ((= (iff a (not guts)) t)                        (build.iff-from-pequal @-)))
+        (let ((guts-prime (clause.negative-term-guts guts)))
+          ;; A has the form (not guts) or some variant of this
+          ;; Guts has the from (not guts') or some variant of this
+          (@derive ((= a (not (not guts-prime)))                    (clause.standardize-double-negative-term-bldr a))
+                   ((= (iff a (not (not guts-prime))) t)            (build.iff-from-pequal @-)                               *1)
+                   ;; ---
+                   ((= (iff (not (not x)) x) t)                     (build.theorem (theorem-not-of-not-under-iff)))
+                   ((= (iff (not (not guts-prime)) guts-prime) t)   (build.instantiation @- (list (cons 'x guts-prime))))
+                   ((= (iff a guts-prime) t)                        (build.transitivity-of-iff *1 @-))
+                   ((= (iff guts-prime result) t)                   (clause.normalize-nots-term-bldr guts-prime))
+                   ((= (iff a result) t)                            (build.transitivity-of-iff @-- @-))))))))
+
+(defobligations clause.normalize-nots-term-bldr
+  (build.iff-reflexivity clause.standardize-negative-term-bldr
+   build.iff-from-pequal clause.standardize-double-negative-term-bldr
+   build.instantiation   build.transitivity-of-iff)
+  :extra-thms ((theorem-not-of-not-under-iff)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.normalize-nots-term-bldr
+                           clause.normalize-nots-term
+                           theorem-not-of-not-under-iff)))
+
+ (local (defthm crock
+          (implies (not (cdr (cdr x)))
+                   (equal (equal (len x) 2)
+                          (and (consp x)
+                               (consp (cdr x)))))))
+
+ (local (defthm lemma
+          (implies (logic.termp a)
+                   (and (logic.appealp (clause.normalize-nots-term-bldr a))
+                        (equal (logic.conclusion (clause.normalize-nots-term-bldr a))
+                               (logic.pequal (logic.function 'iff (list a (clause.normalize-nots-term a)))
+                                             ''t))))))
+
+ (defthm forcing-logic.appealp-of-clause.normalize-nots-term-bldr
+   (implies (force (logic.termp a))
+            (equal (logic.appealp (clause.normalize-nots-term-bldr a))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.normalize-nots-term-bldr
+   (implies (force (logic.termp a))
+            (equal (logic.conclusion (clause.normalize-nots-term-bldr a))
+                   (logic.pequal (logic.function 'iff (list a (clause.normalize-nots-term a)))
+                                 ''t))))
+
+ (verify-guards clause.normalize-nots-term-bldr)
+
+ (defthm@ forcing-logic.proofp-of-clause.normalize-nots-term-bldr
+   (implies (force (and (logic.termp a)
+                        ;; ---
+                        (logic.term-atblp a atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.normalize-nots-term-bldr)))
+            (equal (logic.proofp (clause.normalize-nots-term-bldr a) axioms thms atbl)
+                   t))))
+
+
+
+
+(defprojection :list (clause.normalize-nots-term-list x)
+               :element (clause.normalize-nots-term x)
+               :guard (logic.term-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-clause.normalize-nots-term-list
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (clause.normalize-nots-term-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-clause.normalize-nots-term-list
+  (implies (force (and (logic.term-listp x)
+                       (logic.term-list-atblp x atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-list-atblp (clause.normalize-nots-term-list x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.double-negative-free-listp-of-clause.normalize-nots-term-list
+  (equal (clause.double-negative-free-listp
+          (clause.normalize-nots-term-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defprojection :list (clause.normalize-nots-term-list-bldr x)
+               :element (clause.normalize-nots-term-bldr x)
+               :guard (logic.term-listp x))
+
+(defobligations clause.normalize-nots-term-list-bldr
+  (clause.normalize-nots-term-bldr))
+
+(defthm forcing-logic.appeal-listp-of-clause.normalize-nots-term-list-bldr
+  (implies (force (logic.term-listp x))
+           (equal (logic.appeal-listp (clause.normalize-nots-term-list-bldr x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.strip-conclusions-of-clause.normalize-nots-term-list-bldr
+  (implies (force (logic.term-listp x))
+           (equal (logic.strip-conclusions (clause.normalize-nots-term-list-bldr x))
+                  (logic.pequal-list
+                   (logic.function-list 'iff (list2-list x (clause.normalize-nots-term-list x)))
+                   (repeat ''t (len x)))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm@ forcing-logic.proof-listp-of-clause.normalize-nots-term-list-bldr
+  (implies (force (and (logic.term-listp x)
+                       ;; ---
+                       (logic.term-list-atblp x atbl)
+                       (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (@obligations clause.normalize-nots-term-list-bldr)))
+           (equal (logic.proof-listp (clause.normalize-nots-term-list-bldr x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+(defprojection :list (clause.normalize-nots-clauses x)
+               :element (clause.normalize-nots-term-list x)
+               :guard (logic.term-list-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-list-listp-of-clause.normalize-nots-clauses
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.term-list-listp (clause.normalize-nots-clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atblp-of-clause.normalize-nots-clauses
+  (implies (force (and (logic.term-list-listp x)
+                       (logic.term-list-list-atblp x atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-list-list-atblp (clause.normalize-nots-clauses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-clause.normalize-nots-clauses
+  (equal (cons-listp (clause.normalize-nots-clauses x))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defund clause.normalize-nots-clauses-bldr (x proofs)
+  ;; Given a list of clauses, x, and proofs of all the clauses obtained by
+  ;; undoublenegating x, we build proofs of each clause in x.
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (clause.normalize-nots-clauses x))))))
+  (if (consp x)
+      (let ((cancelled (clause.normalize-nots-term-list (car x)))
+            (t-proofs  (clause.normalize-nots-term-list-bldr (car x))))
+        (cons (clause.update-clause-iff-bldr cancelled (car proofs) t-proofs)
+              (clause.normalize-nots-clauses-bldr (cdr x) (cdr proofs))))
+    nil))
+
+(defobligations clause.normalize-nots-clauses-bldr
+  (clause.normalize-nots-term-list-bldr
+   clause.update-clause-iff-bldr))
+
+(encapsulate
+ ()
+ (in-theory (enable clause.normalize-nots-clauses-bldr))
+
+ (defthm forcing-logic.appeal-listp-of-clause.normalize-nots-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.normalize-nots-clauses x)))))
+            (equal (logic.appeal-listp (clause.normalize-nots-clauses-bldr x proofs))
+                   t))
+   :hints(("Goal" :induct (cdr-cdr-induction x proofs))))
+
+ (defthm forcing-logic.strip-conclusions-of-clause.normalize-nots-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.normalize-nots-clauses x)))))
+            (equal (logic.strip-conclusions (clause.normalize-nots-clauses-bldr x proofs))
+                   (clause.clause-list-formulas x)))
+   :hints(("Goal" :induct (cdr-cdr-induction x proofs))))
+
+ (defthm@ forcing-logic.proof-listp-of-clause.normalize-nots-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.normalize-nots-clauses x)))
+                        ;; ---
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (logic.term-list-list-atblp x atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.normalize-nots-clauses-bldr)))
+            (equal (logic.proof-listp (clause.normalize-nots-clauses-bldr x proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal" :induct (cdr-cdr-induction x proofs)))))
+
+
+
+
+(definlined clause.obvious-termp (x)
+  (declare (xargs :guard (logic.termp x)))
+  (if (clause.negative-termp x)
+      (equal (clause.negative-term-guts x) ''nil)
+    (and (logic.constantp x)
+         (not (equal x ''nil)))))
+
+(defthm booleanp-of-clause.obvious-termp
+  (equal (booleanp (clause.obvious-termp x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.obvious-termp))))
+
+
+
+
+(defund@ clause.obvious-term-bldr (x)
+  ;; Prove the formula for an obvious term
+  (declare (xargs :guard (and (logic.termp x)
+                              (clause.obvious-termp x))
+                  :guard-hints (("Goal" :in-theory (enable clause.obvious-termp
+                                                           clause.negative-termp
+                                                           clause.negative-term-guts
+                                                           theorem-if-redux-nil
+                                                           definition-of-not)))))
+  (if (clause.negative-termp x)
+      ;; A negative term is obvious when its guts are nil.
+      (let ((name (logic.function-name x)))
+        (cond ((equal name 'not)
+               ;; (not guts) --> goal is (not nil) != nil
+               (@derive ((= (not x) (if x nil t))     (build.axiom (definition-of-not)))
+                        ((= (not nil) (if nil nil t)) (build.instantiation @- (@sigma (x . nil)))     *1)
+                        ((= (if nil y z) z)           (build.theorem (theorem-if-redux-nil)))
+                        ((= (if nil nil t) t)         (build.instantiation @- (@sigma (y . nil) (z . t))))
+                        ((= (not nil) t)              (build.transitivity-of-pequal *1 @-))
+                        ((!= (not nil) nil)           (build.not-nil-from-t @-))))
+              ((equal name 'if)
+               ;; (if guts nil t) --> goal is (if nil nil t) != nil
+               (@derive ((= (if nil y z) z)           (build.theorem (theorem-if-redux-nil)))
+                        ((= (if nil nil t) t)         (build.instantiation @- (@sigma (y . nil) (z . t))))
+                        ((!= (if nil nil t) t)        (build.not-nil-from-t @-))))
+              ((equal name 'equal)
+               ;; (equal nil guts) --> goal is (equal nil nil) != nil
+               ;; (equal guts nil) --> goal is (equal nil nil) != nil
+               (@derive ((= (equal nil nil) t)        (build.equal-reflexivity ''nil))
+                        ((!= (equal nil nil) nil)     (build.not-nil-from-t @-))))
+              (t
+               ;; (iff nil guts) --> goal is (iff nil nil) != nil
+               ;; (iff guts nil) --> goal is (iff nil nil) != nil
+               (@derive ((= (iff nil nil) t)          (build.iff-reflexivity ''nil))
+                        ((!= (iff nil nil) t)         (build.not-nil-from-t @-))))))
+    ;; A positive term is obvious when it is a non-nil constant.
+    (@derive ((!= x nil)                              (build.not-pequal-constants x ''nil)))))
+
+(defobligations clause.obvious-term-bldr
+  (build.instantiation build.transitivity-of-pequal build.not-nil-from-t
+   build.equal-reflexivity build.iff-reflexivity build.not-pequal-constants)
+  :extra-axioms ((definition-of-not))
+  :extra-thms ((theorem-if-redux-nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.obvious-term-bldr
+                           clause.obvious-termp
+                           clause.negative-termp
+                           clause.negative-term-guts
+                           logic.term-formula
+                           theorem-if-redux-nil
+                           definition-of-not)))
+
+ (defthm clause.obvious-term-bldr-under-iff
+   (iff (clause.obvious-term-bldr x)
+        t))
+
+ (defthm forcing-logic.appealp-of-clause.obvious-term-bldr
+   (implies (force (and (logic.termp x)
+                        (clause.obvious-termp x)))
+            (equal (logic.appealp (clause.obvious-term-bldr x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.obvious-term-bldr
+   (implies (force (and (logic.termp x)
+                        (clause.obvious-termp x)))
+            (equal (logic.conclusion (clause.obvious-term-bldr x))
+                   (logic.term-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.obvious-term-bldr
+   (implies (force (and (logic.termp x)
+                        (clause.obvious-termp x)
+                        ;; ---
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.obvious-term-bldr)))
+            (equal (logic.proofp (clause.obvious-term-bldr x) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (disable forcing-lookup-of-logic.function-name-free)))))
+
+
+
+(defund clause.obvious-term-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.obvious-term-bldr)
+         (equal (logic.fmtype conclusion) 'pnot*)
+         (equal (logic.fmtype (logic.~arg conclusion)) 'pequal*)
+         (equal (logic.=rhs (logic.~arg conclusion)) ''nil)
+         (clause.obvious-termp (logic.=lhs (logic.~arg conclusion)))
+         (logic.term-atblp (logic.=lhs (logic.~arg conclusion)) atbl)
+         (not subproofs)
+         (not extras))))
+
+(defund clause.obvious-term-bldr-high (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (clause.obvious-termp x))))
+  (logic.appeal 'clause.obvious-term-bldr
+                (logic.term-formula x)
+                nil
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.obvious-term-bldr-okp logic.term-formula)))
+
+ (defthm booleanp-of-clause.obvious-term-bldr-okp
+   (equal (booleanp (clause.obvious-term-bldr-okp x atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm clause.obvious-term-bldr-okp-of-logic.appeal-identity
+   (equal (clause.obvious-term-bldr-okp (logic.appeal-identity x) atbl)
+          (clause.obvious-term-bldr-okp x atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthmd lemma-1-for-soundness-of-clause.obvious-term-bldr-okp
+   (implies (and (clause.obvious-term-bldr-okp x atbl)
+                 (force (logic.appealp x)))
+            (equal (logic.conclusion (clause.obvious-term-bldr (logic.=lhs (logic.~arg (logic.conclusion x)))))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.obvious-term-bldr-okp
+   (implies (and (clause.obvious-term-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (@obligations clause.obvious-term-bldr)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3))))
+            (equal (logic.proofp (clause.obvious-term-bldr (logic.=lhs (logic.~arg (logic.conclusion x))))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.obvious-term-bldr-okp
+   (implies (and (clause.obvious-term-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.obvious-term-bldr)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.obvious-term-bldr-okp
+                               lemma-2-for-soundness-of-clause.obvious-term-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.obvious-term-bldr (logic.=lhs (logic.~arg (logic.conclusion x)))))))))))
+
+
+
+
+
+
+(defund clause.find-obvious-term (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (if (clause.obvious-termp (car x))
+          (car x)
+        (clause.find-obvious-term (cdr x)))
+    nil))
+
+(encapsulate
+ ()
+ (defthm clause.find-obvious-term-when-not-consp
+   (implies (not (consp x))
+            (equal (clause.find-obvious-term x)
+                   nil))
+   :hints(("Goal" :in-theory (enable clause.find-obvious-term))))
+
+ (defthm clause.find-obvious-term-of-cons
+   (equal (clause.find-obvious-term (cons a x))
+          (if (clause.obvious-termp a)
+              a
+            (clause.find-obvious-term x)))
+   :hints(("Goal" :in-theory (enable clause.find-obvious-term))))
+
+ (defthm clause.find-obvious-term-of-list-fix
+   (equal (clause.find-obvious-term (list-fix x))
+          (clause.find-obvious-term x))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm clause.find-obvious-term-of-app
+   (equal (clause.find-obvious-term (app x y))
+          (or (clause.find-obvious-term x)
+              (clause.find-obvious-term y)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm clause.find-obvious-term-of-rev-under-iff
+   (iff (clause.find-obvious-term (rev x))
+        (clause.find-obvious-term x))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm forcing-memberp-of-clause.find-obvious-term
+   (implies (force (logic.term-listp x))
+            (equal (memberp (clause.find-obvious-term x) x)
+                   (if (clause.find-obvious-term x)
+                       t
+                     nil)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm logic.termp-of-clause.find-obvious-term
+   (implies (and (clause.find-obvious-term x)
+                 (force (logic.term-listp x)))
+            (equal (logic.termp (clause.find-obvious-term x))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm clause.obvious-termp-of-clause.find-obvious-term
+   (implies (clause.find-obvious-term x)
+            (equal (clause.obvious-termp (clause.find-obvious-term x))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+
+(defund clause.remove-obvious-clauses (x)
+  (declare (xargs :guard (logic.term-list-listp x)))
+  (if (consp x)
+      (if (clause.find-obvious-term (car x))
+          (clause.remove-obvious-clauses (cdr x))
+        (cons (car x) (clause.remove-obvious-clauses (cdr x))))
+    nil))
+
+(encapsulate
+ ()
+ (defthm clause.remove-obvious-clauses-when-not-consp
+   (implies (not (consp x))
+            (equal (clause.remove-obvious-clauses x)
+                   nil))
+   :hints(("Goal" :in-theory (enable clause.remove-obvious-clauses))))
+
+ (defthm clause.remove-obvious-clauses-of-cons
+   (equal (clause.remove-obvious-clauses (cons a x))
+          (if (clause.find-obvious-term a)
+              (clause.remove-obvious-clauses x)
+            (cons a (clause.remove-obvious-clauses x))))
+   :hints(("Goal" :in-theory (enable clause.remove-obvious-clauses))))
+
+ (defthm true-listp-of-clause.remove-obvious-clauses
+   (equal (true-listp (clause.remove-obvious-clauses x))
+          t)
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm clause.remove-obvious-clauses-of-list-fix
+   (equal (clause.remove-obvious-clauses (list-fix x))
+          (clause.remove-obvious-clauses x))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm clause.remove-obvious-clauses-of-app
+   (equal (clause.remove-obvious-clauses (app x y))
+          (app (clause.remove-obvious-clauses x)
+               (clause.remove-obvious-clauses y)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm rev-of-clause.remove-obvious-clauses
+   (equal (rev (clause.remove-obvious-clauses x))
+          (clause.remove-obvious-clauses (rev x)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthmd clause.remove-obvious-clauses-of-rev
+   (equal (clause.remove-obvious-clauses (rev x))
+          (rev (clause.remove-obvious-clauses x))))
+
+ (ACL2::theory-invariant (ACL2::incompatible (:rewrite rev-of-clause.remove-obvious-clauses)
+                                             (:rewrite clause.remove-obvious-clauses-of-rev)))
+
+ (defthm subsetp-of-clause.remove-obvious-clauses
+   (equal (subsetp (clause.remove-obvious-clauses x) x)
+          t)
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm forcing-logic.term-list-listp-of-clause.remove-obvious-clauses
+   (implies (force (logic.term-list-listp x))
+            (equal (logic.term-list-listp (clause.remove-obvious-clauses x))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm forcing-logic.term-list-list-atblp-of-clause.remove-obvious-clauses
+   (implies (force (logic.term-list-list-atblp x atbl))
+            (equal (logic.term-list-list-atblp (clause.remove-obvious-clauses x) atbl)
+                   t))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm cons-listp-of-clause.remove-obvious-clauses
+   (equal (cons-listp (clause.remove-obvious-clauses x))
+          (cons-listp x))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm all-superset-of-somep-of-clause.remove-obvious-clauses
+   (equal (all-superset-of-somep (clause.remove-obvious-clauses x) x)
+          t)
+   :hints(("Goal" :induct (cdr-induction x)))))
+
+
+(defund clause.remove-obvious-clauses-bldr (x proofs)
+   ;; Suppose x is a list of clauses, and that after removing the obvious
+   ;; clauses you are left with x'.  Suppose we have proofs of each clause in
+   ;; x'.  Then, this function will construct proofs of each clause in x, by
+   ;; filling in the proofs of the obvious clauses.
+   (declare (xargs :guard (and (logic.term-list-listp x)
+                               (cons-listp x)
+                               (logic.appeal-listp proofs)
+                               (equal (clause.clause-list-formulas (clause.remove-obvious-clauses x))
+                                      (logic.strip-conclusions proofs)))))
+   (if (consp x)
+       (let* ((clause1 (car x))
+              (obvious (clause.find-obvious-term clause1)))
+         (if obvious
+             ;; We need to fill in the proof of this clause.
+             (let* ((term-proof   (clause.obvious-term-bldr obvious))
+                    (clause-proof (build.multi-expansion term-proof (logic.term-list-formulas clause1))))
+               (cons clause-proof
+                     (clause.remove-obvious-clauses-bldr (cdr x) proofs)))
+           ;; Else we can just reuse the given proof of this clause.
+           (cons (car proofs)
+                 (clause.remove-obvious-clauses-bldr (cdr x) (cdr proofs)))))
+     nil))
+
+(defobligations clause.remove-obvious-clauses-bldr
+  (clause.obvious-term-bldr build.multi-expansion))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.remove-obvious-clauses-bldr)))
+
+ (defthm forcing-logic.appeal-listp-of-clause.remove-obvious-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.remove-obvious-clauses x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (clause.remove-obvious-clauses-bldr x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-clause.remove-obvious-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.remove-obvious-clauses x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (clause.remove-obvious-clauses-bldr x proofs))
+                   (clause.clause-list-formulas x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-clause.remove-obvious-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (clause.remove-obvious-clauses x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.term-list-list-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.remove-obvious-clauses-bldr)))
+            (equal (logic.proof-listp (clause.remove-obvious-clauses-bldr x proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable clause.remove-obvious-clauses-bldr)))))
+
+
+
+
+(defund clause.complement-term (a)
+  (declare (xargs :guard (logic.termp a)))
+  (if (clause.simple-negativep a)
+      (clause.simple-negative-guts a)
+    (logic.function 'not (list a))))
+
+(defthm logic.termp-of-clause.complement-term
+  (implies (force (logic.termp a))
+           (equal (logic.termp (clause.complement-term a))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.complement-term))))
+
+(defthm clause.complement-term-of-clause.complement-term
+  (implies (and (force (logic.termp a))
+                (or (not (clause.simple-negativep a))
+                    (not (clause.simple-negativep (clause.simple-negative-guts a)))))
+           (equal (clause.complement-term (clause.complement-term a))
+                  a))
+  :hints(("Goal" :in-theory (enable clause.complement-term))))
+
+
+
+(defund clause.find-complementary-literal (x)
+  ;; Returns nil on failure, or else returns a term a from x such that (not a)
+  ;; is also in x.
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (if (memberp (clause.complement-term (car x)) (cdr x))
+          (car x)
+        (clause.find-complementary-literal (cdr x)))
+    nil))
+
+(defthm clause.find-complementary-literal-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.find-complementary-literal x)
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.find-complementary-literal))))
+
+(defthm clause.find-complementary-literal-of-cons
+  (equal (clause.find-complementary-literal (cons a x))
+         (if (memberp (clause.complement-term a) x)
+             a
+           (clause.find-complementary-literal x)))
+  :hints(("Goal" :in-theory (enable clause.find-complementary-literal))))
+
+(defthm forcing-memberp-of-clause.find-complementary-literal
+  (implies (clause.find-complementary-literal x)
+           (equal (memberp (clause.find-complementary-literal x) x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-memberp-of-not-of-clause.find-complementary-literal
+  (implies (clause.find-complementary-literal x)
+           (equal (memberp (clause.complement-term (clause.find-complementary-literal x)) x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.find-complementary-literal-of-list-fix
+  (equal (clause.find-complementary-literal (list-fix x))
+         (clause.find-complementary-literal x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-clause.find-complementary-literal-of-app-one
+  (implies (and (force (logic.term-listp x))
+                (force (logic.term-listp y))
+                (clause.find-complementary-literal x))
+           (iff (clause.find-complementary-literal (app x y))
+                t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd lemma-for-clause.find-complementary-literal-of-rev
+  (implies (and (logic.term-listp x)
+                (logic.termp a)
+                (or (not (clause.simple-negativep a))
+                    (not (clause.simple-negativep (clause.simple-negative-guts a))))
+                (clause.double-negative-free-listp x))
+           (iff (clause.find-complementary-literal (app x (list a)))
+                (or (clause.find-complementary-literal x)
+                    (memberp (clause.complement-term a) x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.find-complementary-literal-of-rev
+  (implies (and (logic.term-listp x)
+                (clause.double-negative-free-listp x)
+                )
+           (iff (clause.find-complementary-literal (rev x))
+                (clause.find-complementary-literal x)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable lemma-for-clause.find-complementary-literal-of-rev))))
+
+
+
+
+(defund clause.remove-complement-clauses (x)
+  (declare (xargs :guard (logic.term-list-listp x)))
+  (if (consp x)
+      (if (clause.find-complementary-literal (car x))
+          (clause.remove-complement-clauses (cdr x))
+        (cons (car x) (clause.remove-complement-clauses (cdr x))))
+    nil))
+
+(defthm clause.remove-complement-clauses-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.remove-complement-clauses x)
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.remove-complement-clauses))))
+
+(defthm clause.remove-complement-clauses-of-cons
+  (equal (clause.remove-complement-clauses (cons a x))
+         (if (clause.find-complementary-literal a)
+             (clause.remove-complement-clauses x)
+           (cons a (clause.remove-complement-clauses x))))
+  :hints(("Goal" :in-theory (enable clause.remove-complement-clauses))))
+
+(defthm forcing-logic.term-list-listp-of-clause.remove-complement-clauses
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.term-list-listp (clause.remove-complement-clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atblp-of-clause.remove-complement-clauses
+  (implies (force (logic.term-list-list-atblp x atbl))
+           (equal (logic.term-list-list-atblp (clause.remove-complement-clauses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-clause.remove-complement-clauses
+  (equal (cons-listp (clause.remove-complement-clauses x))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-clause.remove-complement-clauses
+  (equal (true-listp (clause.remove-complement-clauses x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.remove-complement-clauses-of-list-fix
+  (equal (clause.remove-complement-clauses (list-fix x))
+         (clause.remove-complement-clauses x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.remove-complement-clauses-of-app
+  (equal (clause.remove-complement-clauses (app x y))
+         (app (clause.remove-complement-clauses x)
+              (clause.remove-complement-clauses y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rev-of-clause.remove-complement-clauses
+  (equal (rev (clause.remove-complement-clauses x))
+         (clause.remove-complement-clauses (rev x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd clause.remove-complement-clauses-of-rev
+  (equal (clause.remove-complement-clauses (rev x))
+         (rev (clause.remove-complement-clauses x))))
+
+(ACL2::theory-invariant (ACL2::incompatible (:rewrite rev-of-clause.remove-complement-clauses)
+                                            (:rewrite clause.remove-complement-clauses-of-rev)))
+
+
+
+
+
+(defund@ clause.complement-clause-bldr (a x)
+  (declare (xargs :guard (and (logic.termp a)
+                              (logic.term-listp x)
+                              (memberp a x)
+                              (memberp (clause.complement-term a) x))
+                  :guard-hints (("Goal" :in-theory (enable theorem-not-when-nil
+                                                           clause.complement-term)))))
+  (let ((guts (if (clause.simple-negativep a)
+                  (clause.simple-negative-guts a)
+                a)))
+    (@derive ((v (!= x nil) (= (not x) t))     (build.theorem (theorem-not-when-nil)))
+             ((v (!= x nil) (!= (not x) nil))  (build.disjoined-not-nil-from-t @-))
+             ((v (!= a nil) (!= (not a) nil))  (build.instantiation @- (list (cons 'x guts))))
+             (goal                             (build.multi-or-expansion @- (logic.term-list-formulas x))))))
+
+(defobligations clause.complement-clause-bldr
+  (build.disjoined-not-nil-from-t build.instantiation build.multi-or-expansion)
+  :extra-thms ((theorem-not-when-nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.complement-clause-bldr
+                           clause.complement-term
+                           theorem-not-when-nil)))
+
+ (defthm forcing-logic.appealp-of-clause.complement-clause-bldr
+   (implies (force (and (logic.termp a)
+                        (logic.term-listp x)
+                        (memberp a x)
+                        (memberp (clause.complement-term a) x)))
+            (equal (logic.appealp (clause.complement-clause-bldr a x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.complement-clause-bldr
+   (implies (force (and (logic.termp a)
+                        (logic.term-listp x)
+                        (memberp a x)
+                        (memberp (clause.complement-term a) x)))
+            (equal (logic.conclusion (clause.complement-clause-bldr a x))
+                   (clause.clause-formula x))))
+
+ (defthm@ forcing-logic.proofp-of-clause.complement-clause-bldr
+   (implies (force (and (logic.termp a)
+                        (logic.term-listp x)
+                        (memberp a x)
+                        (memberp (clause.complement-term a) x)
+                        ;; ---
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.term-list-atblp x atbl)
+                        (@obligations clause.complement-clause-bldr)))
+            (equal (logic.proofp (clause.complement-clause-bldr a x) axioms thms atbl)
+                   t))))
+
+
+
+(defund@ clause.remove-complement-clauses-bldr (x proofs)
+  ;; Suppose x is a list of clauses and proofs establish every clause after
+  ;; removing the complement clauses from x.  Then, we prove the clauses in x.
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (clause.remove-complement-clauses x))))))
+  (if (consp x)
+      (let* ((clause1 (car x))
+             (literal (clause.find-complementary-literal clause1)))
+        (if literal
+            (cons
+             (clause.complement-clause-bldr literal clause1)
+             (clause.remove-complement-clauses-bldr (cdr x) proofs))
+          ;; Else, we just reuse the proof.
+          (cons (car proofs)
+                (clause.remove-complement-clauses-bldr (cdr x) (cdr proofs)))))
+    nil))
+
+(defobligations clause.remove-complement-clauses-bldr
+  (clause.complement-clause-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.remove-complement-clauses
+                           clause.remove-complement-clauses-bldr)))
+
+ (defthm forcing-logic.appeal-listp-of-clause.remove-complement-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.remove-complement-clauses x)))))
+            (equal (logic.appeal-listp (clause.remove-complement-clauses-bldr x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-clause.remove-complement-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.remove-complement-clauses x)))))
+            (equal (logic.strip-conclusions (clause.remove-complement-clauses-bldr x proofs))
+                   (clause.clause-list-formulas x))))
+
+ (defthm@ forcing-logic.proof-listp-of-clause.remove-complement-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.remove-complement-clauses x)))
+                        ;; ---
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.term-list-list-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations clause.remove-complement-clauses-bldr)))
+            (equal (logic.proof-listp (clause.remove-complement-clauses-bldr x proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+(definlined clause.absurd-termp (x)
+  (declare (xargs :guard (logic.termp x)))
+  (if (clause.negative-termp x)
+      (let ((guts (clause.negative-term-guts x)))
+        (and (logic.constantp guts)
+             (not (equal guts ''nil))))
+    (equal x ''nil)))
+
+(defthm booleanp-of-clause.absurd-termp
+  (equal (booleanp (clause.absurd-termp x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.absurd-termp))))
+
+
+
+(defund clause.remove-absurd-terms-from-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (if (clause.absurd-termp (car x))
+          (clause.remove-absurd-terms-from-list (cdr x))
+        (cons (car x) (clause.remove-absurd-terms-from-list (cdr x))))
+    nil))
+
+(encapsulate
+ ()
+ (defthm clause.remove-absurd-terms-from-list-when-not-consp
+   (implies (not (consp x))
+            (equal (clause.remove-absurd-terms-from-list x)
+                   nil))
+   :hints(("Goal" :in-theory (enable clause.remove-absurd-terms-from-list))))
+
+ (defthm clause.remove-absurd-terms-from-list-of-cons
+   (equal (clause.remove-absurd-terms-from-list (cons a x))
+          (if (clause.absurd-termp a)
+              (clause.remove-absurd-terms-from-list x)
+            (cons a (clause.remove-absurd-terms-from-list x))))
+   :hints(("Goal" :in-theory (enable clause.remove-absurd-terms-from-list))))
+
+ (defthm true-listp-of-clause.remove-absurd-terms-from-list
+   (equal (true-listp (clause.remove-absurd-terms-from-list x))
+          t)
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm clause.remove-absurd-terms-from-list-of-list-fix
+   (equal (clause.remove-absurd-terms-from-list (list-fix x))
+          (clause.remove-absurd-terms-from-list x))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm clause.remove-absurd-terms-from-list-of-app
+   (equal (clause.remove-absurd-terms-from-list (app x y))
+          (app (clause.remove-absurd-terms-from-list x)
+               (clause.remove-absurd-terms-from-list y)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm rev-of-clause.remove-absurd-terms-from-list
+   (equal (rev (clause.remove-absurd-terms-from-list x))
+          (clause.remove-absurd-terms-from-list (rev x)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm subsetp-of-clause.remove-absurd-terms-from-list
+   (equal (subsetp (clause.remove-absurd-terms-from-list x) x)
+          t)
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm forcing-logic.term-listp-of-clause.remove-absurd-terms-from-list
+   (implies (force (logic.term-listp x))
+            (equal (logic.term-listp (clause.remove-absurd-terms-from-list x))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+
+
+
+(defprojection :list (clause.remove-absurd-terms-from-clauses x)
+               :element (clause.remove-absurd-terms-from-list x)
+               :guard (logic.term-list-listp x)
+               :nil-preservingp t)
+
+(defthm all-superset-of-somep-of-clause.remove-absurd-terms-from-clauses
+  (equal (all-superset-of-somep x (clause.remove-absurd-terms-from-clauses x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-clause.remove-absurd-terms-from-clauses
+  (equal (all-subset-of-somep (clause.remove-absurd-terms-from-clauses x) x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-listp-of-clause.remove-absurd-terms-from-clauses
+   (implies (force (logic.term-list-listp x))
+            (equal (logic.term-list-listp (clause.remove-absurd-terms-from-clauses x))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(definlined disabled-equal (x y)
+  (declare (xargs :guard t))
+  (equal x y))
+
+
+
+(defund clause.clean-clauses (x)
+  ;; We produce the 3-tuple (unprovablep progressp x'), where:
+  ;;
+  ;;  - Unprovablep is set if some clause is discovered to be absurd,
+  ;;  - Progressp is set if we have been able to improve some clause, and
+  ;;  - X' are the new, cleaned clauses or a copy of x if no progress has
+  ;;    been made.
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x))))
+  (let* ((pass1 (clause.normalize-nots-clauses x))
+         (pass2 (clause.remove-obvious-clauses pass1))
+         (pass3 (clause.remove-complement-clauses pass2))
+         (pass4 (clause.remove-absurd-terms-from-clauses pass3)))
+    (if (not (cons-listp pass4))
+        ;; Some clause is absurd.
+        (list t nil (list-fix x))
+      (let* ((pass5 (remove-duplicates-list pass4))
+             (pass6 (fast-remove-supersets pass5)))
+        (list nil (not (disabled-equal x pass6)) pass6)))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.clean-clauses disabled-equal)))
+
+ (defthm booleanp-of-first-of-clause.clean-clauses
+   (equal (booleanp (first (clause.clean-clauses x)))
+          t))
+
+ (defthm booleanp-of-second-of-clause.clean-clauses
+   (equal (booleanp (second (clause.clean-clauses x)))
+          t))
+
+ (defthm logic.term-list-listp-of-third-of-clause.clean-clauses
+   (implies (force (logic.term-list-listp x))
+            (equal (logic.term-list-listp (third (clause.clean-clauses x)))
+                   t)))
+
+ (defthm logic.cons-listp-of-third-of-clause.clean-clauses
+   (implies (force (cons-listp x))
+            (equal (cons-listp (third (clause.clean-clauses x)))
+                   t)))
+
+ (local (defthm true-listp-of-remove-supersets-free
+          (implies (equal (remove-supersets x) y)
+                   (equal (true-listp y)
+                          t))))
+
+ (defthm true-listp-of-third-of-clause.clean-clauses
+   (equal (true-listp (third (clause.clean-clauses x)))
+          t)))
+
+
+
+(defund clause.clean-clauses-bldr (x proofs)
+  ;; Suppose that x is a list of clauses and we apply clean-clauses to
+  ;; produce x', and suppose that we have proofs of each clause in x'.
+  ;; Then, we can apply this function to prove each clause in x.
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (third (clause.clean-clauses x)))
+                                     (logic.strip-conclusions proofs)))
+                  :guard-hints (("Goal" :in-theory (enable clause.clean-clauses)))))
+  (let* ((pass1 (clause.normalize-nots-clauses x))
+         (pass2 (clause.remove-obvious-clauses pass1))
+         (pass3 (clause.remove-complement-clauses pass2))
+         (pass4 (clause.remove-absurd-terms-from-clauses pass3)))
+    (if (not (cons-listp pass4))
+        proofs
+      (let* ((pass5 (remove-duplicates-list pass4))
+             (pass6 (fast-remove-supersets pass5))
+             ;; Proofs establish every clause in the final pass, but passes 4-6 only removed terms from existing clauses,
+             ;; so every clause in pass 3 is a superset of some clause in the final pass.
+             (pass3-proofs (build.all-superset-of-some (logic.term-list-list-formulas pass3) (logic.term-list-list-formulas pass6) proofs))
+             ;; We fill in the complement proofs to get to pass 2
+             (pass2-proofs (clause.remove-complement-clauses-bldr pass2 pass3-proofs))
+             ;; We can fill in the obvious clauses to get to pass1.
+             (pass1-proofs (clause.remove-obvious-clauses-bldr pass1 pass2-proofs))
+             ;; We can undo the double negation to get to x.
+             (x-proofs     (clause.normalize-nots-clauses-bldr x pass1-proofs)))
+        (ACL2::prog2$
+         (ACL2::cw! ";; Clean step: ~s0~|"
+                    (STR::ncat "Inputs " (unbounded-rank proofs) "; "
+                              "Redundant/absurd " (- (unbounded-rank pass3-proofs)
+                                                     (unbounded-rank proofs)) "; "
+                              "Complementary " (- (unbounded-rank pass2-proofs)
+                                                  (unbounded-rank pass3-proofs)) "; "
+                              "Obvious " (- (unbounded-rank pass1-proofs)
+                                            (unbounded-rank pass2-proofs)) "; "
+                              "Normalize " (- (unbounded-rank x-proofs)
+                                              (unbounded-rank pass1-proofs)) "; "
+                              "Outputs " (unbounded-rank x-proofs) "."))
+         x-proofs)))))
+
+(defobligations clause.clean-clauses-bldr
+  (clause.normalize-nots-clauses-bldr
+   clause.remove-obvious-clauses-bldr
+   clause.remove-complement-clauses-bldr
+   build.all-superset-of-some ))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.clean-clauses clause.clean-clauses-bldr)))
+
+ (defthm forcing-logic.appeal-listp-of-clause.clean-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (third (clause.clean-clauses x)))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (clause.clean-clauses-bldr x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-clause.clean-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (third (clause.clean-clauses x)))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (clause.clean-clauses-bldr x proofs))
+                   (clause.clause-list-formulas x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-clause.clean-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (third (clause.clean-clauses x)))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.term-list-list-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations clause.clean-clauses-bldr)))
+            (equal (logic.proof-listp (clause.clean-clauses-bldr x proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+
+
+
+
+;; sweet!  now can we fold in the removing duplicates as well?  hrmn.  this seems
+;; to create problems because remove-duplicates does not have nice reversibility
+;; properties.  that is, the element order is left up to where the elements occur
+;; in the cdr.  that's actually a pretty shitty order to choose.  we might want to
+;; redesign remove-duplicates to keep the first one of each element instead
+
+
+(defund clause.fast-remove-absurd-terms-from-list$ (x acc)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.term-listp acc)
+                              (true-listp acc))))
+  (if (consp x)
+      (if (clause.absurd-termp (car x))
+          (clause.fast-remove-absurd-terms-from-list$ (cdr x) acc)
+        (clause.fast-remove-absurd-terms-from-list$ (cdr x) (cons (car x) acc)))
+    acc))
+
+(defthm clause.fast-remove-absurd-terms-from-list$-removal
+  (implies (force (true-listp acc))
+           (equal (clause.fast-remove-absurd-terms-from-list$ x acc)
+                  (revappend (clause.remove-absurd-terms-from-list x) acc)))
+  :hints(("Goal" :in-theory (enable clause.fast-remove-absurd-terms-from-list$))))
+
+
+
+
+(defund clause.fast-clean-part1 (x acc)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x))))
+  (if (consp x)
+      (let ((normalized-clause (clause.fast-normalize-nots-term-list$ (car x) nil)))
+        (if (or (clause.find-obvious-term normalized-clause)
+                (clause.find-complementary-literal normalized-clause))
+            (clause.fast-clean-part1 (cdr x) acc)
+          (clause.fast-clean-part1 (cdr x)
+                                   (cons (clause.fast-remove-absurd-terms-from-list$ normalized-clause nil)
+                                         acc))))
+    acc))
+
+(defthm clause.fast-clean-part1-removal
+  (implies (force (and (true-listp acc)
+                       (logic.term-list-listp x)))
+           (equal (clause.fast-clean-part1 x acc)
+                  (revappend (clause.remove-absurd-terms-from-clauses
+                              (clause.remove-complement-clauses
+                               (clause.remove-obvious-clauses
+                                (clause.normalize-nots-clauses x))))
+                             acc)))
+  :hints(("Goal"
+          :in-theory (e/d (clause.fast-clean-part1
+                           clause.normalize-nots-term-list-of-rev)
+                          (rev-of-clause.normalize-nots-term-list
+                           )))))
+
+
+(defund clause.fast-clean-clauses (x)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x))))
+  (let ((pass4 (clause.fast-clean-part1 x nil)))
+    (if (not (cons-listp pass4))
+        ;; Some clause is absurd.
+        (list t nil (list-fix x))
+      (let* ((pass5 (fast-remove-duplicates-list$ pass4 nil))
+             (pass6 (fast-remove-supersets pass5)))
+        (list nil (not (disabled-equal x pass6)) pass6)))))
+
+
+
+
+
+
+
+(defthm clause.fast-clean-clauses-removal
+  (implies (force (logic.term-list-listp x))
+           (equal (clause.fast-clean-clauses x)
+                  (clause.clean-clauses x)))
+  :hints(("Goal" :in-theory (e/d (clause.clean-clauses
+                                  clause.fast-clean-clauses
+                                  clause.normalize-nots-clauses-of-rev
+                                  clause.remove-obvious-clauses-of-rev
+                                  clause.remove-complement-clauses-of-rev
+                                  )
+                                 (rev-of-clause.normalize-nots-clauses
+                                  rev-of-clause.remove-obvious-clauses
+                                  rev-of-clause.remove-complement-clauses
+                                  )))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/compiler.lisp acl2-6.3/books/milawa/ACL2/clauses/compiler.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/compiler.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,357 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(include-book "../build/formula-compiler")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund clause.make-clause-from-arbitrary-formula (x)
+  (declare (xargs :guard (logic.formulap x)))
+  (list (logic.compile-formula x)))
+
+(defthm consp-of-clause.make-clause-from-arbitrary-formula
+  (equal (consp (clause.make-clause-from-arbitrary-formula x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.make-clause-from-arbitrary-formula))))
+
+(defthm forcing-logic.term-listp-of-clause.make-clause-from-arbitrary-formula
+  (implies (force (logic.formulap x))
+           (equal (logic.term-listp (clause.make-clause-from-arbitrary-formula x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.make-clause-from-arbitrary-formula))))
+
+(defthm forcing-logic.term-list-atblp-of-clause.make-clause-from-arbitrary-formula
+  (implies (force (and (logic.formulap x)
+                       (logic.formula-atblp x atbl)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-atblp (clause.make-clause-from-arbitrary-formula x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.make-clause-from-arbitrary-formula))))
+
+
+
+
+(defund@ clause.prove-arbitrary-formula-from-its-clause (f proof)
+  (declare (xargs :guard (and (logic.formulap f)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (clause.clause-formula (clause.make-clause-from-arbitrary-formula f))))
+                  :verify-guards nil))
+  (@derive
+   ((v F (= term-f nil))    (@given (second (build.compile-formula f))))
+   ((v (= term-f nil) F)    (build.commute-or @-))
+   ((!= term-f nil)         (@given proof))
+   (F                       (build.modus-ponens-2 @- @--))))
+
+(defobligations clause.prove-arbitrary-formula-from-its-clause
+  (build.compile-formula
+   build.commute-or
+   build.modus-ponens-2))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.prove-arbitrary-formula-from-its-clause
+                           clause.make-clause-from-arbitrary-formula
+                           logic.term-formula)))
+
+ (verify-guards clause.prove-arbitrary-formula-from-its-clause)
+
+ (defthm forcing-logic.appealp-of-clause.prove-arbitrary-formula-from-its-clause
+   (implies (force (and (logic.formulap f)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (clause.make-clause-from-arbitrary-formula f)))))
+            (equal (logic.appealp (clause.prove-arbitrary-formula-from-its-clause f proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.prove-arbitrary-formula-from-its-clause
+   (implies (force (and (logic.formulap f)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (clause.make-clause-from-arbitrary-formula f)))))
+            (equal (logic.conclusion (clause.prove-arbitrary-formula-from-its-clause f proof))
+                   f)))
+
+ (defthm@ forcing-logic.proofp-of-clause.prove-arbitrary-formula-from-its-clause
+   (implies (force (and (logic.formulap f)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (clause.make-clause-from-arbitrary-formula f)))
+                        ;; ---
+                        (logic.formula-atblp f atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations clause.prove-arbitrary-formula-from-its-clause)))
+            (equal (logic.proofp (clause.prove-arbitrary-formula-from-its-clause f proof) axioms thms atbl)
+                   t))))
+
+
+
+(defund clause.prove-arbitrary-formula-from-its-clause-okp (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.prove-arbitrary-formula-from-its-clause)
+         (not extras)
+         (tuplep 1 subproofs)
+         (equal (logic.conclusion (car subproofs))
+                (clause.clause-formula
+                 (clause.make-clause-from-arbitrary-formula conclusion))))))
+
+(defund clause.prove-arbitrary-formula-from-its-clause-high (f proof)
+  (DECLARE (XARGS :GUARD (AND (LOGIC.FORMULAP F)
+                              (LOGIC.APPEALP PROOF)
+                              (EQUAL (LOGIC.CONCLUSION PROOF)
+                                     (CLAUSE.CLAUSE-FORMULA
+                                      (CLAUSE.MAKE-CLAUSE-FROM-ARBITRARY-FORMULA F))))))
+  (logic.appeal 'clause.prove-arbitrary-formula-from-its-clause
+                f
+                (list proof)
+                nil))
+
+(defthm clause.prove-arbitrary-formula-from-its-clause-okp-of-clause.prove-arbitrary-formula-from-its-clause-high
+  (implies (AND (LOGIC.FORMULAP F)
+                              (LOGIC.APPEALP PROOF)
+                              (EQUAL (LOGIC.CONCLUSION PROOF)
+                                     (CLAUSE.CLAUSE-FORMULA
+                                      (CLAUSE.MAKE-CLAUSE-FROM-ARBITRARY-FORMULA F))))
+           (clause.prove-arbitrary-formula-from-its-clause-okp
+            (clause.prove-arbitrary-formula-from-its-clause-high f proof)))
+  :hints(("Goal"
+          :in-theory (enable clause.prove-arbitrary-formula-from-its-clause-okp
+                             clause.prove-arbitrary-formula-from-its-clause-high))))
+
+(defthmd hack-for-compile-formula-okp-1
+   (implies (force (and (logic.formulap f)
+                        (EQUAL (CDR (LOOKUP 'IF ATBL)) 3)
+                        (EQUAL (CDR (LOOKUP 'EQUAL ATBL)) 2)))
+            (equal (logic.term-atblp (logic.compile-formula f) atbl)
+                   (logic.formula-atblp f atbl)))
+   :hints(("Goal"
+           :induct (logic.compile-formula f)
+           :in-theory (e/d (logic.compile-formula)
+                           (FORCING-LOGIC.FORMULA-ATBLP-OF-LOGIC.VRHS
+                            FORCING-LOGIC.FORMULA-ATBLP-OF-LOGIC.VLHS
+                            FORCING-LOGIC.FORMULA-ATBLP-OF-LOGIC.~ARG
+                            FORCING-LOGIC.TERM-ATBLP-OF-LOGIC.=RHS
+                            FORCING-LOGIC.TERM-ATBLP-OF-LOGIC.=LHS
+                            FORCING-LOGIC.TERM-ATBLP-OF-LOGIC.FUNCTION
+                            FORCING-LOGIC.TERM-ATBLP-OF-LOGIC.COMPILE-FORMULA))
+           :expand ((logic.formula-atblp f atbl)
+                    (logic.term-atblp (logic.function 'if
+                                                      (LIST (LOGIC.COMPILE-FORMULA (LOGIC.VLHS F))
+                                                            ''T
+                                                            (LOGIC.COMPILE-FORMULA (LOGIC.VRHS F))))
+                                      atbl)
+                    (logic.term-atblp (LOGIC.FUNCTION 'IF
+                                                      (CONS (LOGIC.COMPILE-FORMULA (LOGIC.~ARG F))
+                                                            '('NIL 'T)))
+                                      atbl)
+                    (logic.term-atblp (LOGIC.FUNCTION 'EQUAL
+                                                      (LIST (LOGIC.=LHS F) (LOGIC.=RHS F)))
+                                      atbl)))))
+
+(encapsulate
+  ()
+  (local (acl2::allow-fertilize t))
+  (defthmd hack-for-compile-formula-okp-2
+    (implies (and (clause.prove-arbitrary-formula-from-its-clause-okp x)
+                  (logic.appealp x)
+                  (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                  (equal (cdr (lookup 'equal atbl)) 2)
+                  (equal (cdr (lookup 'if atbl)) 3))
+             (logic.formula-atblp (logic.conclusion x) atbl))
+    :hints(("Goal"
+            :in-theory (e/d (clause.make-clause-from-arbitrary-formula
+                             clause.prove-arbitrary-formula-from-its-clause-okp
+                             logic.term-formula)
+                            (lOGIC.FORMULA-ATBLP-WHEN-LOGIC.PROVABLEP
+                             LOGIC.FORMULA-LIST-ATBLP-OF-WHEN-LOGIC.PROVABLE-LISTP
+                             hack-for-compile-formula-okp-1
+                             (:executable-counterpart acl2::force)))
+            :use ((:instance LOGIC.FORMULA-ATBLP-WHEN-LOGIC.PROVABLEP
+                             (x (logic.conclusion (car (logic.subproofs x)))))
+                  (:instance hack-for-compile-formula-okp-1
+                             (f (logic.conclusion x))))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.prove-arbitrary-formula-from-its-clause-okp)))
+
+ (defthm booleanp-of-clause.prove-arbitrary-formula-from-its-clause-okp
+   (equal (booleanp (clause.prove-arbitrary-formula-from-its-clause-okp x))
+          t)
+   :hints(("Goal" :in-theory (e/d (clause.prove-arbitrary-formula-from-its-clause-okp)
+                                  ((:executable-counterpart ACL2::force))))))
+
+ (defthm clause.prove-arbitrary-formula-from-its-clause-okp-of-logic.appeal-identity
+   (equal (clause.prove-arbitrary-formula-from-its-clause-okp (logic.appeal-identity x))
+          (clause.prove-arbitrary-formula-from-its-clause-okp x))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-1-for-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp
+   (implies (and (clause.prove-arbitrary-formula-from-its-clause-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (clause.prove-arbitrary-formula-from-its-clause
+                     (logic.conclusion x)
+                     (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                             axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp
+   (implies (and (clause.prove-arbitrary-formula-from-its-clause-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.prove-arbitrary-formula-from-its-clause)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'if atbl)) 3)
+                 )
+            (equal (logic.proofp
+                    (clause.prove-arbitrary-formula-from-its-clause
+                     (logic.conclusion x)
+                     (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                             axioms thms atbl))
+                    axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable hack-for-compile-formula-okp-2))))
+
+ (defthm@ forcing-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp
+   (implies (and (clause.prove-arbitrary-formula-from-its-clause-okp x)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.prove-arbitrary-formula-from-its-clause)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp
+                               lemma-2-for-soundness-of-clause.prove-arbitrary-formula-from-its-clause-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.prove-arbitrary-formula-from-its-clause
+                                 (logic.conclusion x)
+                                 (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                                         axioms thms atbl)))))))))
+
+
+
+
+
+
+(defprojection :list (clause.make-clauses-from-arbitrary-formulas x)
+               :element (clause.make-clause-from-arbitrary-formula x)
+               :guard (logic.formula-listp x)
+               :nil-preservingp nil)
+
+(defthm consp-listp-of-clause.make-clauses-from-arbitrary-formulas
+  (equal (cons-listp (clause.make-clauses-from-arbitrary-formulas x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-listp-of-clause.make-clauses-from-arbitrary-formulas
+  (implies (force (logic.formula-listp x))
+           (equal (logic.term-list-listp (clause.make-clauses-from-arbitrary-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atblp-of-clause.make-clauses-from-arbitrary-formulas
+  (implies (force (and (logic.formula-listp x)
+                       (logic.formula-list-atblp x atbl)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-list-atblp (clause.make-clauses-from-arbitrary-formulas x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.make-clauses-from-arbitrary-formulas))))
+
+
+
+
+(defund clause.prove-arbitrary-formulas-from-their-clauses (fs proofs)
+  (declare (xargs :guard (and (logic.formula-listp fs)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (clause.make-clauses-from-arbitrary-formulas fs))))))
+  (if (consp fs)
+      (cons (clause.prove-arbitrary-formula-from-its-clause (car fs) (car proofs))
+            (clause.prove-arbitrary-formulas-from-their-clauses (cdr fs) (cdr proofs)))
+    nil))
+
+(defobligations clause.prove-arbitrary-formulas-from-their-clauses
+  (clause.prove-arbitrary-formula-from-its-clause))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.prove-arbitrary-formulas-from-their-clauses)))
+
+ (defthm forcing-logic.appeal-listp-of-clause.prove-arbitrary-formulas-from-their-clauses
+   (implies (force (and (logic.formula-listp fs)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.make-clauses-from-arbitrary-formulas fs)))))
+            (equal (logic.appeal-listp (clause.prove-arbitrary-formulas-from-their-clauses fs proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-clause.prove-arbitrary-formulas-from-their-clauses
+   (implies (force (and (logic.formula-listp fs)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.make-clauses-from-arbitrary-formulas fs)))))
+            (equal (logic.strip-conclusions (clause.prove-arbitrary-formulas-from-their-clauses fs proofs))
+                   (list-fix fs))))
+
+ (defthm@ forcing-logic.proofp-of-clause.prove-arbitrary-formulas-from-their-clauses
+   (implies (force (and (logic.formula-listp fs)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.make-clauses-from-arbitrary-formulas fs)))
+                        ;; ---
+                        (logic.formula-list-atblp fs atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations clause.prove-arbitrary-formulas-from-their-clauses)))
+            (equal (logic.proof-listp (clause.prove-arbitrary-formulas-from-their-clauses fs proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/disjoined-update-clause-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/disjoined-update-clause-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/disjoined-update-clause-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/disjoined-update-clause-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,543 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(include-book "../build/pequal")
+(include-book "../build/disjoined-rev-disjunction")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+;; We introduce (clause.disjoined-update-clause-bldr x proof t-proofs).  This
+;; is just a disjoined version of update-clause-bldr.
+;;
+;; X is a non-empty clause, say [T1, ..., Tn]
+;; Proof is a proof of P v T1' v ... v Tn'
+;; T-Proofs are of P v T1 = T1', ..., P v Tn = Tn'
+;; We prove P v T1 v ... v Tn.
+;;
+;; That is:
+;;
+;;   P v T1' v ... v Tn'
+;;   P v T1 = T1'
+;;   ...
+;;   P v Tn = Tn'
+;; --------------------------------------------------------
+;;   P v T1 v ... v Tn
+;;
+;; We again use a tail recursive auxilliary builder which reverses the list in
+;; the process.  This has to be repaired with build.rev-disjunction afterwards.
+;;
+;; The specification for our auxilliary builder is the following:
+;;
+;;      P v (D1 v ... v Dm) v (T1' v ... v Tn')
+;;      P v T1.term = T1'.term
+;;      ...
+;;      P v Tn.term = TN'.term
+;;   -------------------------------------------
+;;      P v Tn v ... v T1 v D1 v ... v Dm
+;;
+;; We think of D1..m as the "done" literals which don't need to be processed
+;; anymore, and T1' ... Tn' as the "todo" literals which we still need to
+;; process.  At each step, our task is to process T1' by replacing it with T1
+;; and moving it to the front of the done list.
+
+(defderiv clause.aux-disjoined-update-clause-twiddle
+  :derive (v P (v (v S Q) R))
+  :from   ((proof x (v R (v (v P Q) S))))
+  :proof  (@derive
+           ((v R (v (v P Q) S))    (@given x))
+           ((v R (v P (v Q S)))    (build.disjoined-right-associativity @-))
+           ((v (v R P) (v Q S))    (build.associativity @-))
+           ((v (v R P) (v S Q))    (build.disjoined-commute-or @-))
+           ((v (v S Q) (v R P))    (build.commute-or @-))
+           ((v (v (v S Q) R) P)    (build.associativity @-))
+           ((v P (v (v S Q) R))    (build.commute-or @-))))
+
+(defderiv clause.aux-disjoined-update-clause-lemma1-bldr
+  ;; Case 1: We still have more todo literals beyond the first (R) and
+  ;;         there are already some done literals (Q)
+  :derive (v P (v (v (!= (? a) nil) Q) R))
+  :from   ((proof x (v P (v Q (v (!= (? b) nil) R))))
+           (proof y (v P (= (? a) (? b)))))
+  :proof  (@derive
+           ((v P (v Q (v (!= (? b) nil) R)))    (@given x))
+           ((v (v P Q) (v (!= (? b) nil) R))    (build.associativity @-))
+           ((v (v (v P Q) (!= (? b) nil)) R)    (build.associativity @-))
+           ((v R (v (v P Q) (!= (? b) nil)))    (build.commute-or @-))
+           ((v (v R (v P Q)) (!= (? b) nil))    (build.associativity @-) *1)
+           ;; ---
+           ((v P (= (? a) (? b)))               (@given y))
+           ((v P (v Q (= (? a) (? b))))         (build.disjoined-left-expansion @- (@formula Q)))
+           ((v (v P Q) (= (? a) (? b)))         (build.associativity @-))
+           ((v R (v (v P Q) (= (? a) (? b))))   (build.expansion (@formula R) @-))
+           ((v (v R (v P Q)) (= (? a) (? b)))   (build.associativity @-))
+           ((v (v R (v P Q)) (!= (? a) nil))    (build.disjoined-substitute-into-not-pequal *1 @-))
+           ((v R (v (v P Q) (!= (? a) nil)))    (build.right-associativity @-))
+           ((v P (v (v (!= (? a) nil) Q) R))    (clause.aux-disjoined-update-clause-twiddle @-))))
+
+(defderiv clause.aux-disjoined-update-clause-lemma2-bldr
+  ;; Case 2: We still have more todo literals beyond the first (R) but
+  ;;         there are not yet any done literals.
+  :derive (v P (v (!= (? a) nil) R))
+  :from   ((proof x (v P (v (!= (? b) nil) R)))
+           (proof y (v P (= (? a) (? b)))))
+  :proof  (@derive
+           ((v P (v (!= (? b) nil) R))    (@given x))
+           ((v (v P (!= (? b) nil)) R)    (build.associativity @-))
+           ((v R (v P (!= (? b) nil)))    (build.commute-or @-))
+           ((v (v R P) (!= (? b) nil))    (build.associativity @-)   *1)
+           ;; ---
+           ((v P (= (? a) (? b)))         (@given y))
+           ((v R (v P (= (? a) (? b))))   (build.expansion (@formula R) @-))
+           ((v (v R P) (= (? a) (? b)))   (build.associativity @-))
+           ((v (v R P) (!= (? a) nil))    (build.disjoined-substitute-into-not-pequal *1 @-))
+           ((v (!= (? a) nil) (v R P))    (build.commute-or @-))
+           ((v (v (!= (? a) nil) R) P)    (build.associativity @-))
+           ((v P (v (!= (? a) nil) R))    (build.commute-or @-))))
+
+(defderiv clause.aux-disjoined-update-clause-lemma3-bldr
+  ;; Case 3: We have no todo literals beyond the first, but we have some
+  ;;         done literals (Q).
+  :derive (v P (v (!= (? a) nil) Q))
+  :from   ((proof x (v P (v Q (!= (? b) nil))))
+           (proof y (v P (= (? a) (? b)))))
+  :proof  (@derive
+           ((v P (v Q (!= (? b) nil)))   (@given x))
+           ((v P (v (!= (? b) nil) Q))   (build.disjoined-commute-or @-))
+           ((v P (= (? a) (? b)))        (@given y))
+           ((v P (v (!= (? a) nil) Q))   (clause.aux-disjoined-update-clause-lemma2-bldr @-- @-))))
+
+
+
+(defund@ clause.aux-disjoined-update-clause-bldr (p todo done t-proofs proof)
+  (declare (xargs :guard (and (logic.formulap p)
+                              (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (or (consp todo) (consp done))
+                              (logic.appealp proof)
+                              (logic.appeal-listp t-proofs)
+                              (equal (logic.conclusion proof)
+                                     (cond ((and (consp done) (consp todo))
+                                            (logic.por p (logic.por (clause.clause-formula done)
+                                                                    (clause.clause-formula todo))))
+                                           ((consp done)
+                                            (logic.por p (clause.clause-formula done)))
+                                           (t
+                                            (logic.por p (clause.clause-formula todo)))))
+                              (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                              (all-equalp p (logic.vlhses (logic.strip-conclusions t-proofs)))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                              (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) todo))
+                  :verify-guards nil))
+  (if (consp todo)
+      (let ((new-term (logic.=lhs (logic.vrhs (logic.conclusion (car t-proofs))))))
+        (if (consp (cdr todo))
+            (if (consp done)
+                ;; Case 1: We still have more todo literals beyond the first (R) and
+                ;;         there are already some done literals (Q)
+                (clause.aux-disjoined-update-clause-bldr p
+                                                         (cdr todo)
+                                                         (cons new-term done)
+                                                         (cdr t-proofs)
+                                                         ;; P v (D1..m v (T1' != nil v T2..n'))
+                                                         ;; P v T1 = T1'
+                                                         ;; ----------------------------------
+                                                         ;; P v ((T1 != nil v D1..m) v T2..n')
+                                                         (clause.aux-disjoined-update-clause-lemma1-bldr proof (car t-proofs)))
+              ;; Case 2: We still have more todo literals beyond the first (R) but
+              ;;         there are not yet any done literals.
+              (clause.aux-disjoined-update-clause-bldr p
+                                                       (cdr todo)
+                                                       (cons new-term done)
+                                                       (cdr t-proofs)
+                                                       ;; P v (T1' != nil v T2..n')
+                                                       ;; P v T1 = T1'
+                                                       ;; ------------------------
+                                                       ;; P v (T1 != nil v T2..n')
+                                                       (clause.aux-disjoined-update-clause-lemma2-bldr proof (car t-proofs))))
+          (if (consp done)
+              ;; Case 3: We have no todo literals beyond the first, but we have some
+              ;;         done literals (Q).
+              ;; P v (D1..m v T1' != nil)
+              ;; P v T1 = T1'
+              ;; -----------------------
+              ;; P v (T1 != nil v D1..m)
+              (clause.aux-disjoined-update-clause-lemma3-bldr proof (car t-proofs))
+            ;; Case 4: We have no todo literals beyond the first, and no done literals.
+            ;; P v T1' != nil
+            ;; P v T1 = T1'
+            ;; ------------------
+            ;; P v T1' != nil
+            (build.disjoined-substitute-into-not-pequal proof (car t-proofs)))))
+    ;; Degenerate case.
+    (logic.appeal-identity proof)))
+
+(defobligations clause.aux-disjoined-update-clause-bldr
+  (clause.aux-disjoined-update-clause-lemma1-bldr
+   clause.aux-disjoined-update-clause-lemma2-bldr
+   clause.aux-disjoined-update-clause-lemma3-bldr
+   build.disjoined-substitute-into-not-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-disjoined-update-clause-bldr
+                           logic.term-formula)))
+
+ (defthm clause.aux-disjoined-update-clause-bldr-under-iff
+   (iff (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof)
+        t))
+
+ (local (defthm lemma
+          (implies (and (logic.formulap p)
+                        (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por p (logic.por (clause.clause-formula done)
+                                                              (clause.clause-formula todo))))
+                                     ((consp done)
+                                      (logic.por p (clause.clause-formula done)))
+                                     (t
+                                      (logic.por p (clause.clause-formula todo)))))
+                        (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                        (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) todo))
+                   (and (logic.appealp (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof))
+                        (equal (logic.conclusion (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof))
+                               (logic.por p (clause.clause-formula (app (rev (logic.=lhses (logic.vrhses (logic.strip-conclusions t-proofs)))) done))))))
+          :hints(("Goal"
+                  :induct (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof)))))
+
+ (defthm forcing-logic.appealp-of-clause.aux-disjoined-update-clause-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por p (logic.por (clause.clause-formula done)
+                                                              (clause.clause-formula todo))))
+                                     ((consp done)
+                                      (logic.por p (clause.clause-formula done)))
+                                     (t
+                                      (logic.por p (clause.clause-formula todo)))))
+                        (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                        (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) todo)))
+            (equal (logic.appealp (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-disjoined-update-clause-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por p (logic.por (clause.clause-formula done)
+                                                              (clause.clause-formula todo))))
+                                     ((consp done)
+                                      (logic.por p (clause.clause-formula done)))
+                                     (t
+                                      (logic.por p (clause.clause-formula todo)))))
+                        (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                        (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) todo)))
+            (equal (logic.conclusion (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof))
+                   (logic.por p (clause.clause-formula (app (rev (logic.=lhses (logic.vrhses (logic.strip-conclusions t-proofs)))) done)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-disjoined-update-clause-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por p (logic.por (clause.clause-formula done)
+                                                              (clause.clause-formula todo))))
+                                     ((consp done)
+                                      (logic.por p (clause.clause-formula done)))
+                                     (t
+                                      (logic.por p (clause.clause-formula todo)))))
+                        (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                        (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) todo)
+                        ;; ---
+                        (logic.proofp proof axioms thms atbl)
+                        (logic.proof-listp t-proofs axioms thms atbl)
+                        (@obligations clause.aux-disjoined-update-clause-bldr)
+                        ))
+            (equal (logic.proofp (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof) axioms thms atbl)
+                   t))
+   :hints(("Goal" :induct (clause.aux-disjoined-update-clause-bldr p todo done t-proofs proof))))
+
+ (verify-guards clause.aux-disjoined-update-clause-bldr))
+
+
+
+
+(defund clause.disjoined-update-clause-bldr (x proof t-proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x)
+                              (logic.appealp proof)
+                              (logic.appeal-listp t-proofs)
+                              (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                              (equal (logic.vrhs (logic.conclusion proof)) (clause.clause-formula x))
+                              (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                              (all-equalp (logic.vlhs (logic.conclusion proof)) (logic.vlhses (logic.strip-conclusions t-proofs)))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                              (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) x))))
+  (build.disjoined-rev-disjunction
+   ;; this is probably pretty expensive.  having a compiler that folded these would be a huge win.
+   (logic.term-list-formulas (fast-rev (logic.=lhses (logic.vrhses (logic.strip-conclusions t-proofs)))))
+   (clause.aux-disjoined-update-clause-bldr (logic.vlhs (logic.conclusion proof)) x nil t-proofs proof)))
+
+(defobligations clause.disjoined-update-clause-bldr
+  (clause.aux-disjoined-update-clause-bldr
+   build.disjoined-rev-disjunction))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.disjoined-update-clause-bldr)))
+
+ (defthm clause.disjoined-update-clause-bldr-under-iff
+   (iff (clause.disjoined-update-clause-bldr x proof t-proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-clause.disjoined-update-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (clause.clause-formula x))
+                        (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                        (all-equalp (logic.vlhs (logic.conclusion proof)) (logic.vlhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                        (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) x)))
+            (equal (logic.appealp (clause.disjoined-update-clause-bldr x proof t-proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.disjoined-update-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (clause.clause-formula x))
+                        (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                        (all-equalp (logic.vlhs (logic.conclusion proof)) (logic.vlhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                        (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) x)))
+            (equal (logic.conclusion (clause.disjoined-update-clause-bldr x proof t-proofs))
+                   (logic.por (logic.vlhs (logic.conclusion proof))
+                              (clause.clause-formula (logic.=lhses (logic.vrhses (logic.strip-conclusions t-proofs))))))))
+
+ (defthm@ forcing-logic.proofp-of-clause.disjoined-update-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                        (equal (logic.vrhs (logic.conclusion proof)) (clause.clause-formula x))
+                        (logic.all-disjunctionsp (logic.strip-conclusions t-proofs))
+                        (all-equalp (logic.vlhs (logic.conclusion proof)) (logic.vlhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions t-proofs)))
+                        (equal (logic.=rhses (logic.vrhses (logic.strip-conclusions t-proofs))) x)
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (logic.proof-listp t-proofs axioms thms atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations clause.disjoined-update-clause-bldr)))
+            (equal (logic.proofp (clause.disjoined-update-clause-bldr x proof t-proofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund clause.disjoined-update-clause-bldr-okp (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.disjoined-update-clause-bldr)
+         ;; In the builder's parlance, we want to build from a term list, proof, and t-proofs.
+         ;; The term list is exactly the same as the rhses of the strip-conclusions of t-proofs,
+         ;; so we take it from there directly.
+         (not extras)
+         (consp subproofs)
+         (let ((proof    (car subproofs))
+               (t-proofs (cdr subproofs)))
+           (and (consp t-proofs)
+                (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                (logic.all-disjunctionsp-of-strip-conclusions t-proofs)
+                (let ((p (logic.vlhs (logic.conclusion proof))))
+                  (and
+                   (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                   (all-equalp p (logic.vlhses-of-strip-conclusions t-proofs))
+                   (logic.all-atomicp-of-vrhses-of-strip-conclusions t-proofs)
+                   (let ((x (logic.=rhses-of-vrhses-of-strip-conclusions t-proofs)))
+                     (and (equal (logic.vrhs (logic.conclusion proof))
+                                 (clause.clause-formula x))
+                          (equal conclusion
+                                 (logic.por
+                                  p
+                                  (clause.clause-formula
+                                   (logic.=lhses-of-vrhses-of-strip-conclusions t-proofs)))))))))))))
+
+(defund clause.disjoined-update-clause-bldr-high (x proof t-proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x)
+                              (logic.appealp proof)
+                              (logic.appeal-listp t-proofs)
+                              (equal (logic.fmtype (logic.conclusion proof))
+                                     'por*)
+                              (equal (logic.vrhs (logic.conclusion proof))
+                                     (clause.clause-formula x))
+                              (logic.all-disjunctionsp
+                               (logic.strip-conclusions t-proofs))
+                              (all-equalp
+                               (logic.vlhs (logic.conclusion proof))
+                               (logic.vlhses (logic.strip-conclusions t-proofs)))
+                              (logic.all-atomicp
+                               (logic.vrhses (logic.strip-conclusions t-proofs)))
+                              (equal
+                               (logic.=rhses
+                                (logic.vrhses (logic.strip-conclusions t-proofs)))
+                               x)))
+           (ignore x))
+  (logic.appeal 'clause.disjoined-update-clause-bldr
+                (logic.por (logic.vlhs (logic.conclusion proof))
+                           (clause.clause-formula (logic.=lhses-of-vrhses-of-strip-conclusions t-proofs)))
+                (cons proof (list-fix t-proofs))
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.disjoined-update-clause-bldr-okp)))
+
+ (defthm booleanp-of-clause.disjoined-update-clause-bldr-okp
+   (equal (booleanp (clause.disjoined-update-clause-bldr-okp x))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm clause.disjoined-update-clause-bldr-okp-of-logic.appeal-identity
+   (equal (clause.disjoined-update-clause-bldr-okp (logic.appeal-identity x))
+          (clause.disjoined-update-clause-bldr-okp x))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthmd lemma-1-for-soundness-of-clause.disjoined-update-clause-bldr-okp
+   (implies (and (clause.disjoined-update-clause-bldr-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion (clause.disjoined-update-clause-bldr
+
+                                      (logic.=rhses
+                                       (logic.vrhses
+                                        (logic.strip-conclusions
+                                         (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                      axioms thms atbl))))
+
+                                      (logic.provable-witness
+                                       (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                      (logic.provable-list-witness
+                                       (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                       axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.disjoined-update-clause-bldr-okp
+   (implies (and (clause.disjoined-update-clause-bldr-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.disjoined-update-clause-bldr))
+            (equal (logic.proofp (clause.disjoined-update-clause-bldr
+                                  (logic.=rhses
+                                   (logic.vrhses
+                                    (logic.strip-conclusions
+                                     (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                  axioms thms atbl))))
+                                  (logic.provable-witness
+                                   (logic.conclusion (car (logic.subproofs x)))
+                                   axioms thms atbl)
+                                  (logic.provable-list-witness
+                                   (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                   axioms thms atbl))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.disjoined-update-clause-bldr-okp
+   (implies (and (clause.disjoined-update-clause-bldr-okp x)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.disjoined-update-clause-bldr))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.disjoined-update-clause-bldr-okp
+                               lemma-2-for-soundness-of-clause.disjoined-update-clause-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.disjoined-update-clause-bldr
+                                 (logic.=rhses
+                                  (logic.vrhses
+                                   (logic.strip-conclusions
+                                    (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                 axioms thms atbl))))
+                                 (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                 (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                              axioms thms atbl)))))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/casesplit-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/casesplit-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/casesplit-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/casesplit-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,265 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../prop")
+(include-book "casesplit")
+(include-book "factor-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm cdr-of-logic.smart-negate-formulas
+  ;; BOZO move me
+  (equal (cdr (logic.smart-negate-formulas x))
+         (logic.smart-negate-formulas (cdr x))))
+
+(defthm car-of-logic.smart-negate-formulas
+  ;; BOZO move me
+  (equal (car (logic.smart-negate-formulas x))
+         (if (consp x)
+             (if (equal (logic.fmtype (car x)) 'pnot*)
+                 (logic.~arg (car x))
+               (logic.pnot (car x)))
+           nil))
+  :hints(("Goal" :in-theory (disable FORCING-EQUAL-OF-LOGIC.PNOT-REWRITE-TWO
+                                     FORCING-EQUAL-OF-LOGIC.PNOT-REWRITE))))
+
+
+
+
+;; (clause.cases-bldr a cases assignment)
+;;
+;; We prove:
+;;
+;;   - a = a' if assignment is empty, or
+;;   - hyps v a = a' otherwise,
+;;
+;; Where:
+;;
+;;   - a' = (clause.casesplit a cases assignment), and
+;;   - hyps are the assumptions implied by assignment (as in clause.factor).
+
+(deftheorem clause.cases-lemma
+  :derive (v (! (v (= x nil) (= a y)))
+             (v (! (v (!= x nil) (= a z)))
+                (= a (if x y z))))
+  :proof  (@derive
+           ((v (= x nil) (= (if x y z) y))                                  (build.axiom (axiom-if-when-not-nil)))
+           ((v (= x nil) (= y (if x y z)))                                  (build.disjoined-commute-pequal @-))
+           ((v (v (! (v (= x nil) (= a y))) (= x nil)) (= y (if x y z)))    (build.multi-assoc-expansion @- (@formulas (! (v (= x nil) (= a y))) (= x nil)))   *1a)
+           ((v (! (v (= x nil) (= a y))) (v (= x nil) (= a y)))             (build.propositional-schema (@formula (v (= x nil) (= a y)))))
+           ((v (v (! (v (= x nil) (= a y))) (= x nil)) (= a y))             (build.associativity @-))
+           ((v (v (! (v (= x nil) (= a y))) (= x nil)) (= a (if x y z)))    (build.disjoined-transitivity-of-pequal @- *1a))
+           ((v (! (v (= x nil) (= a y))) (v (= x nil) (= a (if x y z))))    (build.right-associativity @-))
+           ((v (v (= x nil) (= a (if x y z))) (! (v (= x nil) (= a y))))    (build.commute-or @-))
+           ((v (= x nil) (v (= a (if x y z)) (! (v (= x nil) (= a y)))))    (build.right-associativity @-)  *1)
+           ;; ---
+           ((v (!= x nil) (= (if x y z) z))                                 (build.axiom (axiom-if-when-nil)))
+           ((v (!= x nil) (= z (if x y z)))                                 (build.disjoined-commute-pequal @-))
+           ((v (v (! (v (!= x nil) (= a z))) (!= x nil)) (= z (if x y z)))  (build.multi-assoc-expansion @- (@formulas (! (v (!= x nil) (= a z))) (!= x nil)))  *2a)
+           ((v (! (v (!= x nil) (= a z))) (v (!= x nil) (= a z)))           (build.propositional-schema (@formula (v (!= x nil) (= a z)))))
+           ((v (v (! (v (!= x nil) (= a z))) (!= x nil)) (= a z))           (build.associativity @-))
+           ((v (v (! (v (!= x nil) (= a z))) (!= x nil)) (= a (if x y z)))  (build.disjoined-transitivity-of-pequal @- *2a))
+           ((v (! (v (!= x nil) (= a z))) (v (!= x nil) (= a (if x y z))))  (build.right-associativity @-))
+           ((v (v (!= x nil) (= a (if x y z))) (! (v (!= x nil) (= a z))))  (build.commute-or @-))
+           ((v (!= x nil) (v (= a (if x y z)) (! (v (!= x nil) (= a z)))))  (build.right-associativity @-)  *2)
+           ;; ---
+           ((v (v (= a (if x y z)) (! (v (= x nil) (= a y))))
+               (v (= a (if x y z)) (! (v (!= x nil) (= a z)))))             (build.cut *1 *2))
+           ((v (v (= a (if x y z)) (= a (if x y z)))
+               (v (! (v (!= x nil) (= a z))) (! (v (= x nil) (= a y)))))    (build.disjoined-assoc-lemma-3 @-))
+           ((v (v (= a (if x y z)) (= a (if x y z)))
+               (v (! (v (= x nil) (= a y))) (! (v (!= x nil) (= a z)))))    (build.disjoined-commute-or @-))
+           ((v (v (! (v (= x nil) (= a y))) (! (v (!= x nil) (= a z))))
+               (v (= a (if x y z)) (= a (if x y z))))                       (build.commute-or @-))
+           ((v (v (! (v (= x nil) (= a y))) (! (v (!= x nil) (= a z))))
+               (= a (if x y z)))                                            (build.disjoined-contraction @-))
+           ((v (! (v (= x nil) (= a y)))
+               (v (! (v (!= x nil) (= a z)))
+                  (= a (if x y z))))                                        (build.right-associativity @-)))
+  :minatbl ((if . 3)))
+
+(defderiv clause.cases-lemma1-bldr
+  :derive (= (? a) (if (? x) (? b) (? c)))
+  :from   ((proof x (v (= (? x) nil) (= (? a) (? b))))
+           (proof y (v (!= (? x) nil) (= (? a) (? c)))))
+  :proof  (@derive
+           ((v (! (v (= x nil) (= a y)))
+               (v (! (v (!= x nil) (= a z)))
+                  (= a (if x y z))))                        (build.theorem (clause.cases-lemma)))
+           ((v (! (v (= (? x) nil) (= (? a) (? b))))
+               (v (! (v (!= (? x) nil) (= (? a) (? c))))
+                  (= (? a) (if (? x) (? b) (? c)))))        (build.instantiation @- (@sigma (x . (? x)) (a . (? a)) (y . (? b)) (z . (? c)))))
+           ((v (= (? x) nil) (= (? a) (? b)))               (@given x))
+           ((v (! (v (!= (? x) nil) (= (? a) (? c))))
+                  (= (? a) (if (? x) (? b) (? c))))         (build.modus-ponens @- @--))
+           ((v (!= (? x) nil) (= (? a) (? c)))              (@given y))
+           ((= (? a) (if (? x) (? b) (? c)))                (build.modus-ponens @- @--)))
+  :minatbl ((if . 3)))
+
+(defderiv clause.disjoined-cases-lemma1-bldr
+  :derive (v P (= (? a) (if (? x) (? b) (? c))))
+  :from   ((proof x (v P (v (= (? x) nil) (= (? a) (? b)))))
+           (proof y (v P (v (!= (? x) nil) (= (? a) (? c))))))
+  :proof  (@derive
+           ((v (! (v (= x nil) (= a y)))
+               (v (! (v (!= x nil) (= a z)))
+                  (= a (if x y z))))                            (build.theorem (clause.cases-lemma)))
+           ((v (! (v (= (? x) nil) (= (? a) (? b))))
+               (v (! (v (!= (? x) nil) (= (? a) (? c))))
+                  (= (? a) (if (? x) (? b) (? c)))))            (build.instantiation @- (@sigma (x . (? x)) (a . (? a)) (y . (? b)) (z . (? c)))))
+           ((v P (v (! (v (= (? x) nil) (= (? a) (? b))))
+                    (v (! (v (!= (? x) nil) (= (? a) (? c))))
+                       (= (? a) (if (? x) (? b) (? c))))))      (build.expansion (@formula P) @-))
+           ((v P (v (= (? x) nil) (= (? a) (? b))))             (@given x))
+           ((v P (v (! (v (!= (? x) nil) (= (? a) (? c))))
+                    (= (? a) (if (? x) (? b) (? c)))))          (build.disjoined-modus-ponens @- @--))
+           ((v P (v (!= (? x) nil) (= (? a) (? c))))            (@given y))
+           ((v P (= (? a) (if (? x) (? b) (? c))))              (build.disjoined-modus-ponens @- @--)))
+  :minatbl ((if . 3)))
+
+
+
+(defund@ clause.cases-bldr (a cases assignment)
+  (declare (xargs :guard (and (logic.termp a)
+                              (logic.term-listp cases)
+                              (mapp assignment)
+                              (logic.term-listp (domain assignment)))
+                  :verify-guards nil))
+  (if (consp cases)
+      ;; There are still cases to split on.
+      (let* ((then-assignment (update (car cases) t assignment))
+             (else-assignment (update (car cases) nil assignment))
+             (then-proof      (clause.cases-bldr a (cdr cases) then-assignment))
+             (else-proof      (clause.cases-bldr a (cdr cases) else-assignment))
+             (at              (logic.=rhs (logic.vrhs (logic.conclusion then-proof))))
+             (anil            (logic.=rhs (logic.vrhs (logic.conclusion else-proof)))))
+        (if (not (consp assignment))
+            ;; There are no hyps.
+            (if (equal at anil)
+                ;; Splitting on case1 does not change a.
+                (@derive ((v (= case1 nil) (= a at))     (@given then-proof))
+                         ((v (!= case1 nil) (= a anil))  (@given else-proof))
+                         ((v (= a at) (= a anil))        (build.cut @-- @-))
+                         ((= a at)                       (build.contraction @-)))
+              ;; Splitting on case1 changes a.
+              (@derive ((v (= case1 nil) (= a at))       (@given then-proof))
+                       ((v (!= case1 nil) (= a anil))    (@given else-proof))
+                       ((= a (if case1 at anil))         (clause.cases-lemma1-bldr @-- @-))))
+          ;; Else there are some hyps.
+          (if (equal at anil)
+              ;; Splitting on case1 does not change a.
+              (@derive ((v (v (= case1 nil) hyps) (= a at))        (@given then-proof))
+                       ((v (v (!= case1 nil) hyps) (= a anil))     (@given else-proof))
+                       ((v (= case1 nil) (v hyps (= a at)))        (build.right-associativity @--))
+                       ((v (!= case1 nil) (v hyps (= a anil)))     (build.right-associativity @--))
+                       ((v (v hyps (= a at)) (v hyps (= a anil)))  (build.cut @-- @-))
+                       ((v hyps (= a at))                          (build.contraction @-)))
+            ;; Splitting on case1 changes a.
+            (@derive ((v (v (= case1 nil) hyps) (= a at))      (@given then-proof))
+                     ((v (v (!= case1 nil) hyps) (= a anil))   (@given else-proof))
+                     ((v hyps (v (= case1 nil) (= a at)))      (build.lhs-commute-or-then-rassoc @--))
+                     ((v hyps (v (!= case1 nil) (= a anil)))   (build.lhs-commute-or-then-rassoc @--))
+                     ((v hyps (= a (if case1 at anil)))        (clause.disjoined-cases-lemma1-bldr @-- @-))))))
+    ;; Else there are no more cases to split on.
+    (if (consp assignment)
+        (clause.factor-bldr a assignment)
+      (build.reflexivity a))))
+
+(defobligations clause.cases-bldr
+  (build.cut build.contraction clause.cases-lemma1-bldr build.right-associativity
+   build.lhs-commute-or-then-rassoc clasue.disjoined-cases-lemma1-bldr clause.factor-bldr
+   build.reflexivity))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-forcing-logic.appealp-of-clause.cases-bldr
+   (implies (and (logic.termp a)
+                 (logic.term-listp cases)
+                 (logic.term-listp (domain assignment)))
+            (and (logic.appealp (clause.cases-bldr a cases assignment))
+                 (equal (logic.conclusion (clause.cases-bldr a cases assignment))
+                        (if (consp assignment)
+                            (logic.por (logic.disjoin-formulas (logic.smart-negate-formulas (assignment-formulas assignment)))
+                                       (logic.pequal a (clause.casesplit a cases assignment)))
+                          (logic.pequal a (clause.casesplit a cases assignment))))))
+   :hints(("Goal"
+           :do-not-induct t
+           :in-theory (enable clause.cases-bldr)
+           :induct (clause.cases-bldr a cases assignment))))
+
+ (local (in-theory (enable lemma-for-forcing-logic.appealp-of-clause.cases-bldr)))
+
+ (defthm forcing-logic.appealp-of-clause.cases-bldr
+   (implies (force (and (logic.termp a)
+                        (logic.term-listp cases)
+                        (logic.term-listp (domain assignment))))
+            (equal (logic.appealp (clause.cases-bldr a cases assignment))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.cases-bldr
+   (implies (force (and (logic.termp a)
+                        (logic.term-listp cases)
+                        (logic.term-listp (domain assignment))))
+            (equal (logic.conclusion (clause.cases-bldr a cases assignment))
+                   (if (consp assignment)
+                       (logic.por (logic.disjoin-formulas (logic.smart-negate-formulas (assignment-formulas assignment)))
+                                  (logic.pequal a (clause.casesplit a cases assignment)))
+                     (logic.pequal a (clause.casesplit a cases assignment)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(verify-guards clause.cases-bldr)
+
+
+(defthm@ forcing-proofp-of-clause.cases-bldr
+  (implies (force (and (logic.termp a)
+                       (logic.term-listp cases)
+                       (logic.term-listp (domain assignment))
+                       ;; ---
+                       (logic.term-atblp a atbl)
+                       (logic.term-list-atblp cases atbl)
+                       (logic.term-list-atblp (domain assignment) atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (@obligations clause.cases-bldr)))
+           (equal (logic.proofp (clause.cases-bldr a cases assignment) axioms thms atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (enable clause.cases-bldr)
+          :induct (clause.cases-bldr a cases assignment))))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/casesplit.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/casesplit.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/casesplit.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/casesplit.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,165 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "factor")
+(include-book "simple-termp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund clause.casesplit (x cases assignment)
+  ;; Suppose x is a term, cases are a list of terms [c1, ..., cn], and
+  ;; assignmetn is a mapping from terms to truth values.  Assignment acts
+  ;; as an accumulator as we create a new term by splitting x based on
+  ;; every term in cases.  I.e., we create a new term:
+  ;;
+  ;;  (if c1
+  ;;      (if c2
+  ;;          ...
+  ;;          (if cn
+  ;;              X|(revappend [c1=t,...,cn=t] assignment)
+  ;;            X|(revappend [c1=t,...,cn=nil] assignment))
+  ;;      ...)
+  ;;      X|(revappend [c1=nil,...,cn=nil] assignment))
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.term-listp cases)
+                              (mapp assignment))
+                  :verify-guards nil))
+  (if (consp cases)
+      (let* ((true-assignment  (update (car cases) t assignment))
+             (false-assignment (update (car cases) nil assignment))
+             (true-term        (clause.casesplit x (cdr cases) true-assignment))
+             (false-term       (clause.casesplit x (cdr cases) false-assignment)))
+        (if (equal true-term false-term)
+            true-term
+          (logic.function 'if (list (car cases) true-term false-term))))
+    (clause.factor x assignment)))
+
+(defthm clause.casesplit-when-not-consp
+  (implies (not (consp cases))
+           (equal (clause.casesplit x cases assignment)
+                  (clause.factor x assignment)))
+  :hints(("Goal" :in-theory (enable clause.casesplit))))
+
+(defthm clause.casesplit-of-cons
+  (equal (clause.casesplit x (cons a cases) assignment)
+         (let* ((true-assignment  (update a t assignment))
+                (false-assignment (update a nil assignment))
+                (true-term        (clause.casesplit x cases true-assignment))
+                (false-term       (clause.casesplit x cases false-assignment)))
+           (if (equal true-term false-term)
+               true-term
+             (logic.function 'if (list a true-term false-term)))))
+  :hints(("Goal" :in-theory (enable clause.casesplit))))
+
+(defthm forcing-logic.termp-of-clause.casesplit
+  (implies (and (force (logic.termp x))
+                (force (logic.term-listp cases)))
+           (equal (logic.termp (clause.casesplit x cases assignment))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.casesplit))))
+
+(verify-guards clause.casesplit)
+
+(defthm forcing-logic.term-atblp-of-clause.casesplit
+  (implies (and (force (logic.termp x))
+                (force (logic.term-atblp x atbl))
+                (force (logic.term-list-atblp cases atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-atblp (clause.casesplit x cases assignment) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.casesplit))))
+
+
+
+
+(defund clause.cases (cases assignment)
+  ;; Suppose cases are a list of terms [c1, ..., cn] and assignment is a
+  ;; mapping of terms to truth values as before.  We parallel the execution of
+  ;; clause.casesplit, but instead of actually creating a new term, we just
+  ;; create the list of all the assignments that x will get factored by.  I.e.,
+  ;; we produce the list:
+  ;;
+  ;;  [ (revappend [c1=t,...,cn=t] assignment),
+  ;;    ...,
+  ;;    (revappend [c1=nil,...,cn=nil] assignment) ]
+  (declare (xargs :guard (and (logic.term-listp cases)
+                              (mapp assignment))))
+  (if (consp cases)
+      (let* ((true-assignment (update (car cases) t assignment))
+             (false-assignment (update (car cases) nil assignment)))
+        (app (clause.cases (cdr cases) true-assignment)
+             (clause.cases (cdr cases) false-assignment)))
+    (list assignment)))
+
+(defthm clause.cases-when-not-consp
+  (implies (not (consp cases))
+           (equal (clause.cases cases assignment)
+                  (list assignment)))
+  :hints(("Goal" :in-theory (enable clause.cases))))
+
+(defthm clause.cases-of-cons
+  (equal (clause.cases (cons a cases) assignment)
+         (app (clause.cases cases (update a t assignment))
+              (clause.cases cases (update a nil assignment))))
+  :hints(("Goal" :in-theory (enable clause.cases))))
+
+(defthm consp-of-clause.cases
+  (equal (consp (clause.cases cases assignment))
+         t)
+  :hints(("Goal" :in-theory (enable clause.cases))))
+
+(defthm domain-of-clause.cases
+  (implies (memberp assign (clause.cases cases baseassign))
+           (equal (domain assign)
+                  (app (rev cases) (domain baseassign))))
+  :hints(("Goal" :in-theory (enable clause.cases))))
+
+(defthm clause.simple-term-listp-of-domain-of-clause.cases
+  (implies (and (clause.simple-term-listp (domain assignment))
+                (clause.simple-term-listp cases)
+                (memberp x (clause.cases cases assignment)))
+           (equal (clause.simple-term-listp (domain x))
+                  t)))
+
+(defthm disjoint-from-nonep-of-domain-of-clause.cases
+  (implies (and (disjoint-from-nonep cases set)
+                (memberp x (clause.cases cases assignment)))
+           (equal (disjoint-from-nonep (domain x) set)
+                  t)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/cert.acl2 acl2-6.3/books/milawa/ACL2/clauses/if-lifting/cert.acl2
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/cert.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/depth.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/depth.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/depth.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/depth.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,648 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "casesplit")
+(include-book "term-paths")
+(include-book "unlifted-subterms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund clause.flag-depth (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) 0)
+            ((logic.variablep x) 0)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (and (equal name 'if)
+                        (equal (len args) 3))
+                   (+ 1 (max3 (clause.flag-depth 'term (first args))
+                              (clause.flag-depth 'term (second args))
+                              (clause.flag-depth 'term (third args))))
+                 (clause.flag-depth 'list args))))
+            ((logic.lambdap x)
+             (clause.flag-depth 'list (logic.lambda-actuals x)))
+            (t 0))
+    (if (consp x)
+        (max (clause.flag-depth 'term (car x))
+             (clause.flag-depth 'list (cdr x)))
+      0)))
+
+(defund clause.depth (x)
+  (declare (xargs :guard (logic.termp x)))
+  (clause.flag-depth 'term x))
+
+(defund clause.depth-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (clause.flag-depth 'list x))
+
+(defthmd definition-of-clause.depth
+  (equal (clause.depth x)
+         (cond ((logic.constantp x) 0)
+               ((logic.variablep x) 0)
+               ((logic.functionp x)
+                (let ((name (logic.function-name x))
+                      (args (logic.function-args x)))
+                  (if (and (equal name 'if)
+                           (equal (len args) 3))
+                      (+ 1 (max3 (clause.depth (first args))
+                                 (clause.depth (second args))
+                                 (clause.depth (third args))))
+                    (clause.depth-list args))))
+               ((logic.lambdap x)
+                (clause.depth-list (logic.lambda-actuals x)))
+               (t 0)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.flag-depth
+                                    clause.depth
+                                    clause.depth-list))))
+
+(defthmd definition-of-clause.depth-list
+  (equal (clause.depth-list x)
+         (if (consp x)
+             (max (clause.depth (car x))
+                  (clause.depth-list (cdr x)))
+           0))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.flag-depth
+                                    clause.depth
+                                    clause.depth-list))))
+
+(defthm clause.flag-depth-of-term
+  (equal (clause.flag-depth 'term x)
+         (clause.depth x))
+  :hints(("Goal" :in-theory (enable clause.depth))))
+
+(defthm clause.flag-depth-of-list
+  (equal (clause.flag-depth 'list x)
+         (clause.depth-list x))
+  :hints(("Goal" :in-theory (enable clause.depth-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.depth))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.flag-depth))))
+
+
+
+
+;; (mutual-recursion
+;;  (defund clause.depth (x)
+;;    (declare (xargs :guard (logic.termp x)))
+;;    (cond ((logic.constantp x) 0)
+;;          ((logic.variablep x) 0)
+;;          ((logic.functionp x)
+;;           (let ((name (logic.function-name x))
+;;                 (args (logic.function-args x)))
+;;             (if (and (equal name 'if)
+;;                      (equal (len args) 3))
+;;                 (+ 1 (max3 (clause.depth (first args))
+;;                            (clause.depth (second args))
+;;                            (clause.depth (third args))))
+;;               (clause.depth-list args))))
+;;          ((logic.lambdap x)
+;;           (clause.depth-list (logic.lambda-actuals x)))
+;;          (t 0)))
+;;  (defund clause.depth-list (x)
+;;    (declare (xargs :guard (logic.term-listp x)))
+;;    (if (consp x)
+;;        (max (clause.depth (car x))
+;;             (clause.depth-list (cdr x)))
+;;      0)))
+
+;; (defthm clause.depth-when-logic.constantp
+;;   (implies (logic.constantp x)
+;;            (equal (clause.depth x)
+;;                   0))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable clause.depth))))
+
+;; (defthm clause.depth-when-logic.variablep
+;;   (implies (logic.variablep x)
+;;            (equal (clause.depth x)
+;;                   0))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable clause.depth))))
+
+;; (defthm clause.depth-when-non-if-logic.functionp
+;;   (implies (and (logic.functionp x)
+;;                 ;; Was using case-split
+;;                 (not (equal (logic.function-name x) 'if)))
+;;            (equal (clause.depth x)
+;;                   (clause.depth-list (logic.function-args x))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable clause.depth))))
+
+;; (defthm clause.depth-when-bad-args-logic.functionp
+;;   (implies (and (logic.functionp x)
+;;                 ;; Was using case-split
+;;                 (not (equal (len (logic.function-args x)) 3)))
+;;            (equal (clause.depth x)
+;;                   (clause.depth-list (logic.function-args x))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable clause.depth))))
+
+;; (defthm clause.depth-when-if-logic.functionp
+;;   (implies (and (logic.functionp x)
+;;                 (equal (logic.function-name x) 'if)
+;;                 (equal (len (logic.function-args x)) 3))
+;;            (equal (clause.depth x)
+;;                   (+ 1 (max3 (clause.depth (first (logic.function-args x)))
+;;                              (clause.depth (second (logic.function-args x)))
+;;                              (clause.depth (third (logic.function-args x)))))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable clause.depth))))
+
+;; (defthm clause.depth-when-logic.lambdap
+;;   (implies (logic.lambdap x)
+;;            (equal (clause.depth x)
+;;                   (clause.depth-list (logic.lambda-actuals x))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable clause.depth))))
+
+;; (defthm clause.depth-when-degenerate
+;;   (implies (and (not (logic.constantp x))
+;;                 (not (logic.variablep x))
+;;                 (not (logic.functionp x))
+;;                 (not (logic.lambdap x)))
+;;            (equal (clause.depth x)
+;;                   0))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable clause.depth))))
+
+
+(defthm forcing-clause.depth-of-logic.function
+  (implies (force (logic.function-namep fn))
+           (equal (clause.depth (logic.function fn args))
+                  (if (and (equal fn 'if)
+                           (equal (len args) 3))
+                      (+ 1 (max3 (clause.depth (first args))
+                                 (clause.depth (second args))
+                                 (clause.depth (third args))))
+                    (clause.depth-list args))))
+  :hints(("Goal"
+          :in-theory (disable (:executable-counterpart ACL2::force))
+          :expand (clause.depth (logic.function fn args)))))
+
+(defthm forcing-clause.depth-of-logic.lambda
+  (equal (clause.depth (logic.lambda formals body actuals))
+         (clause.depth-list actuals))
+  :hints(("Goal"
+          :in-theory (disable (:executable-counterpart ACL2::force))
+          :expand (clause.depth (logic.lambda formals body actuals)))))
+
+
+(defthm clause.depth-list-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.depth-list x)
+                  0))
+  :hints(("Goal" :in-theory (enable definition-of-clause.depth-list))))
+
+(defthm clause.depth-list-of-cons
+  (equal (clause.depth-list (cons a x))
+         (max (clause.depth a)
+              (clause.depth-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-clause.depth-list))))
+
+(defthm clause.depth-list-when-length-three
+  (implies (equal (len x) 3)
+           (equal (clause.depth-list x)
+                  (max3 (clause.depth (first x))
+                        (clause.depth (second x))
+                        (clause.depth (third x))))))
+
+(defthms-flag
+  :thms ((term natp-of-clause.depth
+               (equal (natp (clause.depth x))
+                      t))
+         (t natp-of-clause.depth-list
+            (equal (natp (clause.depth-list x))
+                   t)))
+  :hints (("Goal"
+           :expand (clause.depth x)
+           :induct (clause.simple-term-induction flag x))))
+
+(defthm clause.depth-list-of-list-fix
+  (equal (clause.depth-list (list-fix x))
+         (clause.depth-list x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.depth-list-of-app
+  (equal (clause.depth-list (app x y))
+         (max (clause.depth-list x)
+              (clause.depth-list y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.depth-list-of-rev
+  (equal (clause.depth-list (rev x))
+         (clause.depth-list x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthms-flag
+  :thms ((term clause.depth-zero
+               (equal (equal 0 (clause.depth x))
+                      (clause.simple-termp x)))
+         (t clause.depth-list-zero
+            (equal (equal 0 (clause.depth-list x))
+                   (clause.simple-term-listp x))))
+  :hints (("Goal"
+           :expand (clause.depth x)
+           :induct (clause.simple-term-induction flag x))))
+
+(defthm clause.depth-when-clause.simple-termp
+  (implies (clause.simple-termp x)
+           (equal (clause.depth x)
+                  0)))
+
+(defthm clause.depth-list-when-clause.simple-term-listp
+  (implies (clause.simple-term-listp x)
+           (equal (clause.depth-list x)
+                  0)))
+
+(defthm clause.depth-positive-when-non-clause.simple-termp
+  (equal (< 0 (clause.depth x))
+         (not (clause.simple-termp x))))
+
+(defthm clause.depth-list-positive-when-non-clause.simple-term-listp
+  (equal (< 0 (clause.depth-list x))
+         (not (clause.simple-term-listp x))))
+
+
+
+;; (clause.deepest x)
+;;
+;; X is a list of terms.  If x is empty, we return nil.  Otherwise, we return
+;; the first member of x whose clause.depth is maximal for this list.
+
+(defund clause.deepest (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (if (consp (cdr x))
+          (let ((clause.deepest-in-cdr (clause.deepest (cdr x))))
+            (if (< (clause.depth (car x))
+                   (clause.depth clause.deepest-in-cdr))
+                clause.deepest-in-cdr
+              (car x)))
+        (car x))
+    nil))
+
+(defthm clause.deepest-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.deepest x)
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.deepest))))
+
+(defthm clause.deepest-of-cons
+  (equal (clause.deepest (cons a x))
+         (if (consp x)
+             (if (< (clause.depth a)
+                    (clause.depth (clause.deepest x)))
+                 (clause.deepest x)
+               a)
+           a))
+  :hints(("Goal" :in-theory (enable clause.deepest))))
+
+(defthm clause.deepest-of-list-fix
+  (equal (clause.deepest (list-fix x))
+         (clause.deepest x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.deepest-of-app
+  (equal (clause.deepest (app x y))
+         (cond ((and (consp x) (consp y))
+                (if (< (clause.depth (clause.deepest x))
+                       (clause.depth (clause.deepest y)))
+                    (clause.deepest y)
+                  (clause.deepest x)))
+               ((consp x)
+                (clause.deepest x))
+               ((consp y)
+                (clause.deepest y))
+               (t nil)))
+  :hints(("Goal" :in-theory (enable clause.deepest))))
+
+(defthm memberp-of-clause.deepest
+  (equal (memberp (clause.deepest x) x)
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm positiveness-of-clause.depth-of-clause.deepest
+  (equal (< 0 (clause.depth (clause.deepest x)))
+         (and (consp x)
+              (not (clause.simple-term-listp x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.deepest-weakly-deeper-than-any-member
+  (implies (memberp a x)
+           (equal (< (clause.depth (clause.deepest x))
+                     (clause.depth a))
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+;; clause.depth-list can be redefined in terms of clause.deepest, but we do not enable
+;; this rule by default since it is so severe.
+
+(defthmd clause.depth-list-redefinition
+  (equal (clause.depth-list x)
+         (if (consp x)
+             (clause.depth (clause.deepest x))
+           0))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.unlifted-subterms-weakly-decreases-clause.depth
+  (equal (< (clause.depth x)
+            (clause.depth-list (clause.unlifted-subterms x)))
+         nil)
+  :hints(("Goal"
+          :expand (clause.depth x)
+          :in-theory (enable clause.unlifted-subterms)
+          :induct (clause.unlifted-subterms x))))
+
+(defthm forcing-clause.simple-termp-of-clause.deepest
+  (equal (clause.simple-termp (clause.deepest x))
+         (clause.simple-term-listp x))
+  :hints(("Goal"
+          :induct (cdr-induction x))))
+
+(defthms-flag
+  :thms ((term clause.factor-when-irrelevant-tests
+               (implies (and (disjointp (domain assignment) (clause.term-tests x))
+                             (force (logic.termp x)))
+                        (equal (clause.factor x assignment)
+                               x)))
+         (t clause.factor-list-when-irrelevant-tests
+            (implies (and (disjointp (domain assignment) (clause.term-tests-list x))
+                          (force (logic.term-listp x)))
+                     (equal (clause.factor-list x assignment)
+                            (list-fix x)))))
+  :hints (("Goal"
+           :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term clause.depth-of-clause.factor-weak
+               (implies (force (logic.termp x))
+                        (equal (< (clause.depth x)
+                                  (clause.depth (clause.factor x assignment)))
+                               nil)))
+         (t clause.depth-of-clause.factor-list-weak
+            (implies (force (logic.term-listp x))
+                     (equal (< (clause.depth-list x)
+                               (clause.depth-list (clause.factor-list x assignment)))
+                            nil))))
+  :hints (("Goal"
+           :expand (clause.depth x)
+           :induct (clause.simple-term-induction flag x))))
+
+
+
+(defthmd lemma-2-for-clause.depth-of-clause.factor-strong
+  (implies (and (< (clause.depth a) (clause.depth b))
+                (force (logic.termp a)))
+           (equal (< (clause.depth (clause.factor a assignment))
+                     (+ 1 (clause.depth b)))
+                  t))
+  :hints(("Goal"
+          :use ((:instance |a <= b, b <= c --> a < 1+c|
+                           (a (clause.depth (clause.factor a assignment)))
+                           (b (clause.depth a))
+                           (c (clause.depth b)))))))
+
+(defthms-flag
+  :shared-hyp (clause.simple-term-listp (domain assignment))
+  :thms ((term clause.depth-of-clause.factor-strong
+               (implies (and (logic.termp x)
+                             (not (clause.simple-termp x))
+                             (disjoint-from-nonep (domain assignment) (clause.term-paths x)))
+                        (equal (< (clause.depth (clause.factor x assignment))
+                                  (clause.depth x))
+                               t)))
+         (t clause.depth-list-of-clause.factor-list-strong
+            (implies (and (logic.term-listp x)
+                          (not (clause.simple-term-listp x))
+                          (disjoint-from-nonep (domain assignment) (clause.term-paths-list x)))
+                     (equal (< (clause.depth-list (clause.factor-list x assignment))
+                               (clause.depth-list x))
+                            t))))
+  :hints (("Goal"
+           :expand (clause.depth x)
+           :induct (clause.simple-term-induction flag x)
+           :in-theory (enable lemma-2-for-clause.depth-of-clause.factor-strong))))
+
+(defthm clause.depth-list-of-clause.unlifted-subterms-of-clause.casesplit
+  (implies (and (logic.termp x)
+                (logic.term-listp cases)
+                (clause.simple-term-listp cases))
+           (equal (clause.depth-list
+                   (clause.unlifted-subterms
+                    (clause.casesplit x cases assignment)))
+                  (clause.depth-list
+                   (clause.unlifted-subterms-list
+                    (clause.multifactor x
+                     (clause.cases cases assignment))))))
+  :hints(("Goal"
+          :in-theory (enable clause.casesplit)
+          :induct (clause.casesplit x cases assignment))))
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-clause.casesplit-strongly-reduces-clause.depth
+   (implies (and (logic.termp x)
+                 (not (clause.simple-termp x))
+                 (clause.simple-term-listp (domain assignment))
+                 (disjoint-from-nonep (domain assignment) (clause.term-paths x)))
+            (equal (< (clause.depth-list (clause.unlifted-subterms (clause.factor x assignment)))
+                      (clause.depth x))
+                   t))
+   :hints(("Goal"
+           :in-theory (disable clause.unlifted-subterms-weakly-decreases-clause.depth)
+           :use ((:instance clause.unlifted-subterms-weakly-decreases-clause.depth
+                            (x (clause.factor x assignment)))))))
+
+ (defthm clause.casesplit-strongly-reduces-clause.depth
+   (implies (and (logic.termp x)
+                 (not (clause.simple-termp x))
+                 (logic.term-listp cases)
+                 (clause.simple-term-listp cases)
+                 (clause.simple-term-listp (domain assignment))
+                 (disjoint-from-nonep (domain assignment) (clause.term-paths x)))
+            (equal (< (clause.depth-list
+                       (clause.unlifted-subterms
+                        (clause.casesplit x cases assignment)))
+                      (clause.depth x))
+                   t))
+   :hints(("Goal"
+           :in-theory (enable clause.casesplit
+                              lemma-for-clause.casesplit-strongly-reduces-clause.depth)
+           :induct (clause.casesplit x cases assignment)))))
+
+
+
+
+;; among a list of assignments, the special assignment is the one that will
+;; have the clause.deepest unlifted subterm.
+
+(defund clause.special-assignment (x assignments)
+  (declare (xargs :guard (and (logic.termp x)
+                              (map-listp assignments))))
+  (if (consp assignments)
+      (if (consp (cdr assignments))
+          (let ((special-from-cdr (clause.special-assignment x (cdr assignments))))
+            (if (< (clause.depth-list (clause.unlifted-subterms (clause.factor x (car assignments))))
+                   (clause.depth-list (clause.unlifted-subterms (clause.factor x special-from-cdr))))
+                special-from-cdr
+              (car assignments)))
+        (car assignments))
+    nil))
+
+(defthm clause.special-assignment-when-not-consp
+  (implies (not (consp assignments))
+           (equal (clause.special-assignment x assignments)
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.special-assignment))))
+
+(defthm clause.special-assignment-of-cons
+  (equal (clause.special-assignment x (cons a assignments))
+         (if (consp assignments)
+             (if (< (clause.depth-list
+                     (clause.unlifted-subterms
+                      (clause.factor x a)))
+                    (clause.depth-list
+                     (clause.unlifted-subterms
+                      (clause.factor x
+                       (clause.special-assignment x assignments)))))
+                 (clause.special-assignment x assignments)
+               a)
+           a))
+  :hints(("Goal" :in-theory (enable clause.special-assignment))))
+
+(defthm memberp-of-clause.special-assignment
+  (equal (memberp (clause.special-assignment x assignments) assignments)
+         (consp assignments))
+  :hints(("Goal" :induct (cdr-induction assignments))))
+
+
+(defthm forcing-logic.termp-of-clause.deepest
+  (implies (force (logic.term-listp x))
+           (equal (logic.termp (clause.deepest x))
+                  (consp x)))
+  :hints(("Goal" :in-theory (enable clause.deepest))))
+
+(defthm clause.special-assignment-of-clause.multifactor
+  (implies (and (consp assignments)
+                (force (logic.termp x)))
+           (equal (clause.deepest
+                   (clause.unlifted-subterms-list
+                    (clause.multifactor x assignments)))
+                  (clause.deepest
+                   (clause.unlifted-subterms
+                    (clause.factor x (clause.special-assignment x assignments))))))
+  :hints(("Goal"
+          :in-theory (e/d (clause.depth-list-redefinition)
+                          (positiveness-of-clause.depth-of-clause.deepest) ;; Yuck!
+                          )
+          :induct (cdr-induction assignments))))
+
+
+
+
+
+;; among a list of terms to be factored with some assignment, the most deeply
+;; factorable is the one which will be clause.deepest after factoring.
+
+(defund clause.deepest-after-factoring (x assignment)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (mapp assignment))))
+  (if (consp x)
+      (if (consp (cdr x))
+          (let ((clause.deepest-from-cdr (clause.deepest-after-factoring (cdr x) assignment)))
+            (if (< (clause.depth (clause.factor (car x) assignment))
+                   (clause.depth (clause.factor clause.deepest-from-cdr assignment)))
+                clause.deepest-from-cdr
+              (car x)))
+        (car x))
+    nil))
+
+(defthm clause.deepest-after-factoring-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.deepest-after-factoring x assignment)
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.deepest-after-factoring))))
+
+(defthm clause.deepest-after-factoring-of-cons
+  (equal (clause.deepest-after-factoring (cons a x) assignment)
+         (if (consp x)
+             (let ((clause.deepest-from-cdr (clause.deepest-after-factoring x assignment)))
+               (if (< (clause.depth (clause.factor a assignment))
+                      (clause.depth (clause.factor clause.deepest-from-cdr assignment)))
+                   clause.deepest-from-cdr
+                 a))
+           a))
+  :hints(("Goal" :in-theory (enable clause.deepest-after-factoring))))
+
+(defthm forcing-logic.termp-of-clause.deepest-after-factoring
+  (implies (force (logic.term-listp x))
+           (equal (logic.termp (clause.deepest-after-factoring x assignment))
+                  (consp x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-clause.deepest-after-factoring
+  (equal (memberp (clause.deepest-after-factoring x assignment) x)
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.deepest-of-clause.factor-list
+  (implies (consp x)
+           (equal (clause.deepest (clause.factor-list x assignment))
+                  (clause.factor (clause.deepest-after-factoring x assignment)
+                             assignment)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-nonep-of-clause.term-paths-of-clause.deepest-after-factoring
+  (implies (disjoint-from-nonep domain (clause.term-paths-list x))
+           (equal (disjoint-from-nonep domain (clause.term-paths (clause.deepest-after-factoring x assignment)))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable disjoint-from-nonep-of-clause.term-paths-when-memberp)
+          :use ((:instance disjoint-from-nonep-of-clause.term-paths-when-memberp
+                           (a (clause.deepest-after-factoring x assignment))
+                           (x x))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/factor-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/factor-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/factor-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/factor-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,630 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "factor")
+(include-book "../../build/lambda")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; (binding-formula x)
+;;
+;; Assume x is a (term . value) pair which occurs in an assignment.  We
+;; produce a corresponding formula, i.e., term = nil when the value is nil,
+;; or term != nil otherwise.
+;;
+;; Note: We leave this function enabled.
+
+(defun binding-formula (x)
+  (declare (xargs :guard (and (consp x)
+                              (logic.termp (car x)))))
+  (if (cdr x)
+      (logic.pnot (logic.pequal (car x) ''nil))
+    (logic.pequal (car x) ''nil)))
+
+
+
+
+;; (assignment-formulas x)
+;;
+;; We produce a list of formulas corresponding to each binding in the
+;; assignment.
+
+(encapsulate
+ ()
+ (local (in-theory (disable binding-formula)))
+ (defprojection
+   :list (assignment-formulas x)
+   :element (binding-formula x)
+   :guard (and (mapp x)
+               (logic.term-listp (domain x)))))
+
+(defthm forcing-logic.formulap-listp-of-assignment-formulas
+  (implies (force (logic.term-listp (domain x)))
+           (equal (logic.formula-listp (assignment-formulas x))
+                  t))
+  :hints(("Goal" :in-theory (enable assignment-formulas))))
+
+(defthm forcing-logic.formula-atblp-listp-of-assignment-formulas
+  (implies (force (logic.term-list-atblp (domain x) atbl))
+           (equal (logic.formula-list-atblp (assignment-formulas x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable assignment-formulas))))
+
+
+
+
+
+
+(defderiv clause.factor-bldr-lemma-1
+  :from   ((proof x (v P (!= (? a2) nil)))
+           (proof y (v P (= (? a1) (? a2))))
+           (proof z (v P (= (? b1) (? b2))))
+           (term  c (? c)))
+  :derive (v P (= (if (? a1) (? b1) (? c)) (? b2)))
+  :proof  (@derive
+           ((v P (!= (? a2) nil))                                          (@given x))
+           ((v P (= (? a1) (? a2)))                                        (@given y))
+           ((v P (!= (? a1) nil))                                          (build.disjoined-substitute-into-not-pequal @-- @-) *1)
+           ((v (= x nil) (= (if x y z) y))                                 (build.axiom (axiom-if-when-not-nil)))
+           ((v (= (? a1) nil) (= (if (? a1) (? b1) (? c)) (? b1)))         (build.instantiation @- (@sigma (x . (? a1)) (y . (? b1)) (z . (? c)))))
+           ((v P (v (= (? a1) nil) (= (if (? a1) (? b1) (? c)) (? b1))))   (build.expansion (@formula P) @-))
+           ((v P (= (if (? a1) (? b1) c) (? b1)))                          (build.disjoined-modus-ponens-2 *1 @-))
+           ((v P (= (? b1) (? b2)))                                        (@given z))
+           ((v P (= (if (? a1) (? b1) c) (? b2)))                          (build.disjoined-transitivity-of-pequal @-- @-)))
+  :minatbl ((if . 3)))
+
+(defderiv clause.factor-bldr-lemma-2
+  :from   ((proof x (v P (= (? a2) nil)))
+           (proof y (v P (= (? a1) (? a2))))
+           (proof z (v P (= (? c1) (? c2))))
+           (term  b (? b)))
+  :derive (v P (= (if (? a1) (? b) (? c1)) (? c2)))
+  :proof  (@derive
+           ((v P (= (? a2) nil))                                            (@given x))
+           ((v P (= (? a1) (? a2)))                                         (@given y))
+           ((v P (= (? a1) nil))                                            (build.disjoined-transitivity-of-pequal @- @--) *1)
+           ((v (!= x nil) (= (if x y z) z))                                 (build.axiom (axiom-if-when-nil)))
+           ((v (!= (? a1) nil) (= (if (? a1) (? b) (? c1)) (? c1)))         (build.instantiation @- (@sigma (x . (? a1)) (y . (? b)) (z . (? c1)))))
+           ((v P (v (!= (? a1) nil) (= (if (? a1) (? b) (? c1)) (? c1))))   (build.expansion (@formula P) @-))
+           ((v P (= (if (? a1) (? b) (? c1)) (? c1)))                       (build.disjoined-modus-ponens *1 @-))
+           ((v P (= (? c1) (? c2)))                                         (@given z))
+           ((v P (= (if (? a1) (? b) (? c1)) (? c2)))                       (build.disjoined-transitivity-of-pequal @-- @-)))
+  :minatbl ((if . 3)))
+
+
+
+(defund clause.flag-factor-bldr (flag x assignment hyps hyps-formula)
+   ;; X is a term and assignment is non-empty.
+   ;; Our "hyps" are the negated formulas from the assignment, i.e.,
+   ;;
+   ;;   hyps = (logic.smart-negate-formulas (assignment-formulas assignment))
+   ;;
+   ;; Our goal is to prove hyps v x = x|assignment
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (logic.term-listp x))
+                              (consp assignment)
+                              (mapp assignment)
+                              (logic.term-listp (domain assignment))
+                              ;; hyps just saves us from having to recons this each time.
+                              (equal hyps (logic.smart-negate-formulas (assignment-formulas assignment)))
+                              ;; hyps-formula just saves us from having to recons this each time.
+                              (equal hyps-formula (logic.disjoin-formulas hyps)))
+                   :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             (build.expansion hyps-formula (build.reflexivity x)))
+            ((logic.variablep x)
+             (build.expansion hyps-formula (build.reflexivity x)))
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (and (equal name 'if)
+                        (equal (len args) 3))
+                   ;; Matched (if a b c).
+                   (let* ((a-proof (clause.flag-factor-bldr 'term (first args) assignment hyps hyps-formula))
+                          (a-prime (logic.=rhs (logic.vrhs (logic.conclusion a-proof))))
+                          (binding (lookup a-prime assignment)))
+                     (if binding
+                         (if (cdr binding)
+                             ;; Assignment binds a' to t.
+                             ;;  -- a' != nil is the binding formula.
+                             ;;  -- a' = nil is one of the disjuncts in hyps.
+                             ;; Goal is to prove hyps v (if a b c) = b'.
+                             (clause.factor-bldr-lemma-1 (build.multi-assoc-expansion
+                                                          (build.commute-or
+                                                           (build.propositional-schema (logic.pequal a-prime ''nil))) hyps)
+                                                             a-proof
+                                                             (clause.flag-factor-bldr 'term (second args) assignment hyps hyps-formula)
+                                                             (third args))
+                           (clause.factor-bldr-lemma-2 (build.multi-assoc-expansion (build.propositional-schema (logic.pequal a-prime ''nil)) hyps)
+                                                           a-proof
+                                                           (clause.flag-factor-bldr 'term (third args) assignment hyps hyps-formula)
+                                                           (second args)))
+                       ;; Assignment does not bind a'.
+                       ;; Goal is hyps v (if a b c) = (if a' b' c')
+                       (build.disjoined-pequal-by-args 'if
+                                                       hyps-formula
+                                                       (list a-proof
+                                                             (clause.flag-factor-bldr 'term (second args) assignment hyps hyps-formula)
+                                                             (clause.flag-factor-bldr 'term (third args) assignment hyps hyps-formula)))))
+                 ;; Matched a non-if function.
+                 (build.disjoined-pequal-by-args name
+                                                 hyps-formula
+                                                 (clause.flag-factor-bldr 'list args assignment hyps hyps-formula)))))
+            ((logic.lambdap x)
+             (let ((formals (logic.lambda-formals x))
+                   (body    (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               (build.disjoined-lambda-pequal-by-args formals body
+                                                      hyps-formula
+                                                      (clause.flag-factor-bldr 'list actuals assignment hyps hyps-formula))))
+            (t nil))
+    (if (consp x)
+        (cons (clause.flag-factor-bldr 'term (car x) assignment hyps hyps-formula)
+              (clause.flag-factor-bldr 'list (cdr x) assignment hyps hyps-formula))
+      nil)))
+
+(defobligations clause.flag-factor-bldr
+  (build.reflexivity
+   build.expansion
+   build.propositional-schema
+   build.commute-or
+   build.multi-assoc-expansion
+   clause.factor-bldr-lemma-1
+   clause.factor-bldr-lemma-2
+   build.disjoined-pequal-by-args
+   build.disjoined-lambda-pequal-by-args))
+
+(defund clause.factor-bldr (x assignment)
+  (declare (xargs :guard (and (logic.termp x)
+                              (consp assignment)
+                              (mapp assignment)
+                              (logic.term-listp (domain assignment)))
+                  :verify-guards nil))
+  (let* ((hyps         (logic.smart-negate-formulas (assignment-formulas assignment)))
+         (hyps-formula (logic.disjoin-formulas hyps)))
+    (clause.flag-factor-bldr 'term x assignment hyps hyps-formula)))
+
+(defund clause.factor-list-bldr (x assignment)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp assignment)
+                              (mapp assignment)
+                              (logic.term-listp (domain assignment)))
+                  :verify-guards nil))
+  (let* ((hyps         (logic.smart-negate-formulas (assignment-formulas assignment)))
+         (hyps-formula (logic.disjoin-formulas hyps)))
+    (clause.flag-factor-bldr 'list x assignment hyps hyps-formula)))
+
+(defobligations clause.factor-bldr
+  (clause.flag-factor-bldr))
+
+(defobligations clause.factor-list-bldr
+  (clause.flag-factor-bldr))
+
+(defthmd definition-of-clause.factor-bldr
+  (equal (clause.factor-bldr x assignment)
+         (let* ((hyps          (logic.smart-negate-formulas (assignment-formulas assignment)))
+                (hyps-formula  (logic.disjoin-formulas hyps)))
+           (cond ((logic.constantp x)
+                  (build.expansion hyps-formula (build.reflexivity x)))
+                 ((logic.variablep x)
+                  (build.expansion hyps-formula (build.reflexivity x)))
+                 ((logic.functionp x)
+                  (let ((name (logic.function-name x))
+                        (args (logic.function-args x)))
+                    (if (and (equal name 'if)
+                             (equal (len args) 3))
+                        ;; Matched (if a b c).
+                        (let* ((a-proof (clause.factor-bldr (first args) assignment))
+                               (a-prime (logic.=rhs (logic.vrhs (logic.conclusion a-proof))))
+                               (binding (lookup a-prime assignment)))
+                          (if binding
+                              (if (cdr binding)
+                                  ;; Assignment binds a' to t.
+                                  ;;  -- a' != nil is the binding formula.
+                                  ;;  -- a' = nil is one of the disjuncts in hyps.
+                                  ;; Goal is to prove hyps v (if a b c) = b'.
+                                  (clause.factor-bldr-lemma-1 (build.multi-assoc-expansion (build.commute-or (build.propositional-schema (logic.pequal a-prime ''nil))) hyps)
+                                                                  a-proof
+                                                                  (clause.factor-bldr (second args) assignment)
+                                                                  (third args))
+                                (clause.factor-bldr-lemma-2 (build.multi-assoc-expansion (build.propositional-schema (logic.pequal a-prime ''nil)) hyps)
+                                                                a-proof
+                                                                (clause.factor-bldr (third args) assignment)
+                                                                (second args)))
+                            ;; Assignment does not bind a'.
+                            ;; Goal is hyps v (if a b c) = (if a' b' c')
+                            (build.disjoined-pequal-by-args 'if
+                                                            hyps-formula
+                                                            (list a-proof
+                                                                  (clause.factor-bldr (second args) assignment)
+                                                                  (clause.factor-bldr (third args) assignment)))))
+                      ;; Matched a non-if function.
+                      (build.disjoined-pequal-by-args name
+                                                      hyps-formula
+                                                      (clause.factor-list-bldr args assignment)))))
+                 ((logic.lambdap x)
+                  (let ((formals (logic.lambda-formals x))
+                        (body    (logic.lambda-body x))
+                        (actuals (logic.lambda-actuals x)))
+                    (build.disjoined-lambda-pequal-by-args formals body
+                                                           hyps-formula
+                                                           (clause.factor-list-bldr actuals assignment))))
+                 (t nil))))
+         :rule-classes :definition
+         :hints(("Goal" :in-theory (enable clause.factor-bldr
+                                           clause.factor-list-bldr
+                                           clause.flag-factor-bldr))))
+
+(defthmd definition-of-clause.factor-list-bldr
+  (equal (clause.factor-list-bldr x assignment)
+         (if (consp x)
+             (cons (clause.factor-bldr (car x) assignment)
+                   (clause.factor-list-bldr (cdr x) assignment))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.factor-bldr
+                                    clause.factor-list-bldr
+                                    clause.flag-factor-bldr))))
+
+(defthm forcing-clause.flag-factor-bldr-of-term-removal
+  (implies (force (and (equal hyps (logic.smart-negate-formulas (assignment-formulas assignment)))
+                       (equal hyps-formula (logic.disjoin-formulas hyps))))
+           (equal (clause.flag-factor-bldr 'term x assignment hyps hyps-formula)
+                  (clause.factor-bldr x assignment)))
+  :hints(("Goal" :in-theory (enable clause.factor-bldr))))
+
+(defthm clause.flag-factor-bldr-of-list-removal
+  (implies (force (and (equal hyps (logic.smart-negate-formulas (assignment-formulas assignment)))
+                       (equal hyps-formula (logic.disjoin-formulas hyps))))
+           (equal (clause.flag-factor-bldr 'list x assignment hyps hyps-formula)
+                  (clause.factor-list-bldr x assignment)))
+  :hints(("Goal" :in-theory (enable clause.factor-list-bldr))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.factor-bldr))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.factor-list-bldr))))
+
+
+
+(defthm clause.factor-list-bldr-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.factor-list-bldr x assignment)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-list-bldr))))
+
+(defthm clause.factor-list-bldr-of-cons
+  (equal (clause.factor-list-bldr (cons a x) assignment)
+         (cons (clause.factor-bldr a assignment)
+               (clause.factor-list-bldr x assignment)))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-list-bldr))))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-nil-preservingp-of-clause.factor-list-bldr
+   (equal (clause.factor-bldr nil assignment)
+          nil)
+   :hints(("Goal" :in-theory (enable definition-of-clause.factor-bldr))))
+ (local (in-theory (enable lemma-for-nil-preservingp-of-clause.factor-list-bldr)))
+ (defprojection
+   :list (clause.factor-list-bldr x assignment)
+   :element (clause.factor-bldr x assignment)
+   :guard (and (logic.term-listp x)
+               (consp assignment)
+               (mapp assignment)
+               (logic.term-listp (domain assignment)))
+   :verify-guards nil
+   :nil-preservingp t
+   :already-definedp t))
+
+
+;; This is super-aggressive forcing, but we should only be looking for the
+;; right terms during these proofs.
+(defthmd lemma-forcing-memberp-of-pequal-a-nil-in-assignment-formulas
+  (implies (and (force (lookup a x))
+                (force (not (cdr (lookup a x))))
+                (force (logic.term-listp (domain x)))
+                (force (logic.termp a)))
+           (equal (memberp (logic.pequal a ''nil) (assignment-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+;; This is super-aggressive forcing, but we should only be looking for the
+;; right terms during these proofs.
+(defthmd lemma-forcing-memberp-of-logic.pnot-pequal-a-nil-in-assignment-formulas
+  (implies (and (force (lookup a x))
+                (force (cdr (lookup a x)))
+                (force (logic.term-listp (domain x)))
+                (force (logic.termp a)))
+           (equal (memberp (logic.pnot (logic.pequal a ''nil)) (assignment-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthmd lemma-1-for-forcing-logic.appealp-of-clause.factor-bldr
+  (implies (and (logic.appeal-listp (clause.factor-list-bldr x assignment))
+                (force (consp x)))
+           (equal (logic.appealp (clause.factor-bldr (first x) assignment))
+                  t)))
+
+(defthmd lemma-2-for-forcing-logic.appealp-of-clause.factor-bldr
+  (implies (and (logic.appeal-listp (clause.factor-list-bldr x assignment))
+                (force (consp (cdr x))))
+           (equal (logic.appealp (clause.factor-bldr (second x) assignment))
+                  t)))
+
+(defthmd lemma-3-for-forcing-logic.appealp-of-clause.factor-bldr
+  (implies (and (logic.appeal-listp (clause.factor-list-bldr x assignment))
+                (force (consp (cdr (cdr x)))))
+           (equal (logic.appealp (clause.factor-bldr (third x) assignment))
+                  t)))
+
+(defthmd lemma-1-for-forcing-logic.conclusion-of-clause.factor-bldr
+  (implies (and (equal (logic.strip-conclusions (clause.factor-list-bldr x assignment))
+                       (logic.por-list y z))
+                (force (consp x)))
+           (equal (logic.conclusion (clause.factor-bldr (first x) assignment))
+                  (logic.por (first y) (first z))))
+  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthmd lemma-2-for-forcing-logic.conclusion-of-clause.factor-bldr
+  (implies (and (equal (logic.strip-conclusions (clause.factor-list-bldr x assignment))
+                       (logic.por-list y z))
+                (force (consp (cdr x))))
+           (equal (logic.conclusion (clause.factor-bldr (second x) assignment))
+                  (logic.por (second y) (second z))))
+  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthmd lemma-3-for-forcing-logic.conclusion-of-clause.factor-bldr
+  (implies (and (equal (logic.strip-conclusions (clause.factor-list-bldr x assignment))
+                       (logic.por-list y z))
+                (force (consp (cdr (cdr x)))))
+           (equal (logic.conclusion (clause.factor-bldr (third x) assignment))
+                  (logic.por (third y) (third z))))
+  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+
+
+
+(local (in-theory (enable lemma-forcing-memberp-of-pequal-a-nil-in-assignment-formulas
+                          lemma-forcing-memberp-of-logic.pnot-pequal-a-nil-in-assignment-formulas)))
+
+(local (in-theory (disable forcing-equal-of-logic.pequal-list-rewrite
+                           forcing-equal-of-logic.por-list-rewrite)))
+
+(defthms-flag
+  :shared-hyp (force (and (consp assignment)
+                          (logic.term-listp (domain assignment))))
+  :thms ((term forcing-logic.appealp-of-clause.factor-bldr
+               (implies (force (logic.termp x))
+                        (equal (logic.appealp (clause.factor-bldr x assignment))
+                               t)))
+         (term forcing-logic.conclusion-of-clause.factor-bldr ;; BOZO backchain limit 0?
+               (implies (force (logic.termp x))
+                        (equal (logic.conclusion (clause.factor-bldr x assignment))
+                               (logic.por (logic.disjoin-formulas (logic.smart-negate-formulas (assignment-formulas assignment)))
+                                          (logic.pequal x (clause.factor x assignment))))))
+         (t forcing-logic.appeal-listp-of-clause.factor-list-bldr
+            (implies (force (logic.term-listp x))
+                     (equal (logic.appeal-listp (clause.factor-list-bldr x assignment))
+                            t)))
+         (t forcing-logic.strip-conclusions-of-clause.factor-list-bldr ;; BOZO backchain limit 0?
+            (implies (force (logic.term-listp x))
+                     (equal (logic.strip-conclusions (clause.factor-list-bldr x assignment))
+                            (logic.por-list (repeat (logic.disjoin-formulas (logic.smart-negate-formulas (assignment-formulas assignment))) (len x))
+                                            (logic.pequal-list x (clause.factor-list x assignment)))))))
+  :hints (("Goal"
+           :induct (logic.term-induction flag x)
+           :in-theory (enable definition-of-clause.factor-bldr
+                              lemma-1-for-forcing-logic.appealp-of-clause.factor-bldr
+                              lemma-2-for-forcing-logic.appealp-of-clause.factor-bldr
+                              lemma-3-for-forcing-logic.appealp-of-clause.factor-bldr
+                              lemma-1-for-forcing-logic.conclusion-of-clause.factor-bldr
+                              lemma-2-for-forcing-logic.conclusion-of-clause.factor-bldr
+                              lemma-3-for-forcing-logic.conclusion-of-clause.factor-bldr)
+           :expand ((clause.factor-bldr x assignment)))))
+
+(verify-guards clause.flag-factor-bldr)
+(verify-guards clause.factor-bldr)
+(verify-guards clause.factor-list-bldr)
+
+
+
+
+(defthmd lemma-1-for-forcing-logic.proofp-of-clause.factor-bldr
+  (implies (and (logic.proof-listp (clause.factor-list-bldr x assignment) axioms thms atbl)
+                (force (consp x)))
+           (equal (logic.proofp (clause.factor-bldr (first x) assignment) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthmd lemma-2-for-forcing-logic.proofp-of-clause.factor-bldr
+  (implies (and (logic.proof-listp (clause.factor-list-bldr x assignment) axioms thms atbl)
+                (force (consp (cdr x))))
+           (equal (logic.proofp (clause.factor-bldr (second x) assignment) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthmd lemma-3-for-forcing-logic.proofp-of-clause.factor-bldr
+  (implies (and (logic.proof-listp (clause.factor-list-bldr x assignment) axioms thms atbl)
+                (force (consp (cdr (cdr x)))))
+           (equal (logic.proofp (clause.factor-bldr (third x) assignment) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+
+
+(defthms-flag
+  :@contextp t
+  :shared-hyp (force (and (consp assignment)
+                          (logic.term-listp (domain assignment))
+                          (logic.term-list-atblp (domain assignment) atbl)
+                          (@obligations clause.factor-bldr)))
+  :thms ((term forcing-logic.proofp-of-clause.factor-bldr
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)))
+                        (equal (logic.proofp (clause.factor-bldr x assignment) axioms thms atbl)
+                               t)))
+         (t forcing-logic.proof-listp-of-clause.factor-list-bldr
+            (implies (force (and (logic.term-listp x)
+                                 (logic.term-list-atblp x atbl)))
+                     (equal (logic.proof-listp (clause.factor-list-bldr x assignment) axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.term-induction flag x)
+           :in-theory (enable definition-of-clause.factor-bldr
+                              lemma-1-for-forcing-logic.proofp-of-clause.factor-bldr
+                              lemma-2-for-forcing-logic.proofp-of-clause.factor-bldr
+                              lemma-3-for-forcing-logic.proofp-of-clause.factor-bldr)
+           :expand ((clause.factor-bldr x assignment)))))
+
+
+
+
+(defund logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas (x)
+  (declare (xargs :guard (and (mapp x)
+                              (logic.term-listp (domain x))
+                              (consp x))))
+  (if (consp x)
+      (let* ((binding-formula (binding-formula (car x)))
+             (smartly-negated (if (equal (logic.fmtype binding-formula) 'pnot*)
+                                  (logic.~arg binding-formula)
+                                (logic.pnot binding-formula))))
+        (if (consp (cdr x))
+            (logic.por smartly-negated
+                       (logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas (cdr x)))
+          smartly-negated))
+    nil))
+
+(defthm logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas-removal
+  (equal (logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas x)
+         (logic.disjoin-formulas (logic.smart-negate-formulas (assignment-formulas x))))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (e/d (logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas)
+                          ((:executable-counterpart ACL2::force))))))
+
+
+
+
+(defund clause.factor-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.factor-bldr)
+         (not subproofs)
+         (tuplep 2 extras)
+         (let ((term       (first extras))
+               (assignment (second extras)))
+           (and (logic.termp term)
+                (logic.term-atblp term atbl)
+                (consp assignment)
+                (mapp assignment)
+                (let ((domain (fast-domain$ assignment nil)))
+                  (and (logic.term-listp domain)
+                       (logic.term-list-atblp domain atbl)))
+                (equal conclusion
+                       (logic.por (logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas assignment)
+                                  (logic.pequal term (clause.factor term assignment)))))))))
+
+(defund clause.factor-bldr-high (x assignment)
+  (declare (xargs :guard (and (logic.termp x)
+                              (consp assignment)
+                              (mapp assignment)
+                              (logic.term-listp (domain assignment)))))
+  (logic.appeal 'clause.factor-bldr
+                (logic.por (logic.disjoin-formulas-of-smart-negate-formulas-of-assignment-formulas assignment)
+                           (logic.pequal x (clause.factor x assignment)))
+                nil
+                (list x assignment)))
+
+(defobligations clause.factor-bldr-okp
+  (clause.factor-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.factor-bldr-okp)))
+
+ (defthm booleanp-of-clause.factor-bldr-okp
+   (equal (booleanp (clause.factor-bldr-okp x atbl))
+          t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm clause.factor-bldr-okp-of-logic.appeal-identity
+   (equal (clause.factor-bldr-okp (logic.appeal-identity x) atbl)
+          (clause.factor-bldr-okp x atbl))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-1-for-soundness-of-clause.factor-bldr-okp
+   (implies (and (clause.factor-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion (clause.factor-bldr (first (logic.extras x))
+                                                         (second (logic.extras x))))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.factor-bldr-okp
+   (implies (and (clause.factor-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.factor-bldr-okp))
+            (equal (logic.proofp (clause.factor-bldr (first (logic.extras x))
+                                                     (second (logic.extras x)))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.factor-bldr-okp
+   (implies (and (clause.factor-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.factor-bldr-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.factor-bldr-okp
+                               lemma-2-for-soundness-of-clause.factor-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.factor-bldr (first (logic.extras x))
+                                                    (second (logic.extras x))))))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/factor.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/factor.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/factor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/factor.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,319 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-termp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund clause.flag-factor (flag x assignment)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (logic.term-listp x))
+                              (mapp assignment))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond
+       ((logic.constantp x) x)
+       ((logic.variablep x) x)
+       ((logic.functionp x)
+        (let ((name (logic.function-name x))
+              (args (logic.function-args x)))
+          (if (and (equal name 'if)
+                   (equal (len args) 3))
+              (let* ((new-test (clause.flag-factor 'term (first args) assignment))
+                     (new-test-binding (lookup new-test assignment)))
+                (if new-test-binding
+                    (if (cdr new-test-binding)
+                        (clause.flag-factor 'term (second args) assignment)
+                      (clause.flag-factor 'term (third args) assignment))
+                  (let ((new-arg2 (clause.flag-factor 'term (second args) assignment))
+                        (new-arg3 (clause.flag-factor 'term (third args) assignment)))
+                    (logic.function 'if (list new-test new-arg2 new-arg3)))))
+            (logic.function name (clause.flag-factor 'list args assignment)))))
+       ((logic.lambdap x)
+        (logic.lambda (logic.lambda-formals x)
+                      (logic.lambda-body x)
+                      (clause.flag-factor 'list (logic.lambda-actuals x) assignment)))
+       (t x))
+    (if (consp x)
+        (cons (clause.flag-factor 'term (car x) assignment)
+              (clause.flag-factor 'list (cdr x) assignment))
+      nil)))
+
+(definlined clause.factor (x assignment)
+  (declare (xargs :guard (and (logic.termp x)
+                              (mapp assignment))
+                  :verify-guards nil))
+  (clause.flag-factor 'term x assignment))
+
+(definlined clause.factor-list (x assignment)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (mapp assignment))
+                  :verify-guards nil))
+  (clause.flag-factor 'list x assignment))
+
+(defthmd definition-of-clause.factor
+  (equal (clause.factor x assignment)
+         (cond
+          ((logic.constantp x) x)
+          ((logic.variablep x) x)
+          ((logic.functionp x)
+           (let ((name (logic.function-name x))
+                 (args (logic.function-args x)))
+             (if (and (equal name 'if)
+                      (equal (len args) 3))
+                 (let* ((new-test (clause.factor (first args) assignment))
+                        (new-test-binding (lookup new-test assignment)))
+                   (if new-test-binding
+                       (if (cdr new-test-binding)
+                           (clause.factor (second args) assignment)
+                         (clause.factor (third args) assignment))
+                     (let ((new-arg2 (clause.factor (second args) assignment))
+                           (new-arg3 (clause.factor (third args) assignment)))
+                       (logic.function 'if (list new-test new-arg2 new-arg3)))))
+               (logic.function name (clause.factor-list args assignment)))))
+          ((logic.lambdap x)
+           (logic.lambda (logic.lambda-formals x)
+                         (logic.lambda-body x)
+                         (clause.factor-list (logic.lambda-actuals x) assignment)))
+          (t x)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.factor
+                                    clause.factor-list
+                                    clause.flag-factor))))
+
+(defthmd definition-of-clause.factor-list
+  (equal (clause.factor-list x assignment)
+         (if (consp x)
+             (cons (clause.factor (car x) assignment)
+                   (clause.factor-list (cdr x) assignment))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.factor
+                                    clause.factor-list
+                                    clause.flag-factor))))
+
+(defthm clause.flag-factor-of-term-removal
+  (equal (clause.flag-factor 'term x assignment)
+         (clause.factor x assignment))
+  :hints(("Goal" :in-theory (enable clause.factor))))
+
+(defthm clause.flag-factor-of-list-removal
+  (equal (clause.flag-factor 'list x assignment)
+         (clause.factor-list x assignment))
+  :hints(("Goal" :in-theory (enable clause.factor-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.factor))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.factor-list))))
+
+
+
+(defthm clause.factor-list-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.factor-list x assignment)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-list))))
+
+(defthm clause.factor-list-of-cons
+  (equal (clause.factor-list (cons a x) assignment)
+         (cons (clause.factor a assignment)
+               (clause.factor-list x assignment)))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor-list))))
+
+(defprojection :list (clause.factor-list x assignment)
+               :element (clause.factor x assignment)
+               :guard (and (logic.term-listp x)
+                           (mapp assignment))
+               :verify-guards nil
+               :already-definedp t)
+
+(defthm clause.factor-list-when-len-three
+  (implies (equal (len x) 3)
+           (equal (clause.factor-list x assignment)
+                  (list (clause.factor (first x) assignment)
+                        (clause.factor (second x) assignment)
+                        (clause.factor (third x) assignment)))))
+
+
+
+;; Usually I don't really care for these kinds of opening rules.  But here they
+;; seem to do a good job.  For example, they prevent the large case splits that
+;; would be caused by just enabling factor when we get into situations like
+;; proving the factor builder, and allow us to prove the theorem more quickly.
+
+(defthm clause.factor-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (clause.factor x assignment)
+                  x))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor))))
+
+(defthm clause.factor-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (clause.factor x assignment)
+                  x))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor))))
+
+(defthm clause.factor-when-non-if-logic.functionp
+  (implies (and (not (equal 'if (logic.function-name x)))
+                (logic.functionp x))
+           (equal (clause.factor x assignment)
+                  (logic.function (logic.function-name x)
+                         (clause.factor-list (logic.function-args x) assignment))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor))))
+
+(defthm clause.factor-when-bad-args-logic.functionp
+  (implies (and (not (equal 3 (len (logic.function-args x))))
+                (logic.functionp x))
+           (equal (clause.factor x assignment)
+                  (logic.function (logic.function-name x)
+                         (clause.factor-list (logic.function-args x) assignment))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor))))
+
+;; (defthm clause.factor-when-test-not-bound
+;;   (implies (and (logic.functionp x)
+;;                 (not (lookup (clause.factor (first (logic.function-args x)) assignment) assignment)))
+;;            (equal (clause.factor x assignment)
+;;                   (logic.function (logic.function-name x)
+;;                                   (clause.factor-list (logic.function-args x) assignment))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal"
+;;           :in-theory (enable definition-of-clause.factor)
+;;           :expand (clause.factor x assignment))))
+
+;; (defthm clause.factor-when-if-logic.functionp
+;;   (implies (and (logic.functionp x)
+;;                 (equal (logic.function-name x) 'if)
+;;                 (equal (len (logic.function-args x)) 3)
+;;                 (lookup (clause.factor (first (logic.function-args x)) assignment) assignment))
+;;            (equal (clause.factor x assignment)
+;;                   (if (cdr (lookup (clause.factor (first (logic.function-args x)) assignment) assignment))
+;;                       (clause.factor (second (logic.function-args x)) assignment)
+;;                     (clause.factor (third (logic.function-args x)) assignment))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable definition-of-clause.factor))))
+
+(defthm clause.factor-when-if-expression
+  (implies (and (equal 'if (logic.function-name x))
+                (equal 3 (len (logic.function-args x)))
+                (logic.functionp x))
+           (equal (clause.factor x assignment)
+                  (if (lookup (clause.factor (first (logic.function-args x)) assignment) assignment)
+                      (if (cdr (lookup (clause.factor (first (logic.function-args x)) assignment) assignment))
+                          (clause.factor (second (logic.function-args x)) assignment)
+                        (clause.factor (third (logic.function-args x)) assignment))
+                    (logic.function (logic.function-name x)
+                                    (clause.factor-list (logic.function-args x) assignment)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor))))
+
+(defthm clause.factor-when-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (clause.factor x assignment)
+                  (logic.lambda (logic.lambda-formals x)
+                                (logic.lambda-body x)
+                                (clause.factor-list (logic.lambda-actuals x) assignment))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor))))
+
+(defthm clause.factor-when-degenerate
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (clause.factor x assignment)
+                  x))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.factor))))
+
+
+
+(defthms-flag
+  :thms ((term forcing-logic.termp-of-clause.factor
+               (implies (force (logic.termp x))
+                        (equal (logic.termp (clause.factor x assignment))
+                               t)))
+         (t forcing-logic.term-listp-of-clause.factor-list
+            (implies (force (logic.term-listp x))
+                     (equal (logic.term-listp (clause.factor-list x assignment))
+                            t))))
+  :hints(("Goal" :induct (clause.simple-term-induction flag x))))
+
+(verify-guards clause.flag-factor)
+(verify-guards clause.factor)
+(verify-guards clause.factor-list)
+
+(defthms-flag
+  :thms ((term forcing-logic.term-atblp-of-clause.factor
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)))
+                        (equal (logic.term-atblp (clause.factor x assignment) atbl)
+                               t)))
+         (t forcing-logic.term-list-atblp-of-clause.factor-list
+            (implies (force (and (logic.term-listp x)
+                                 (logic.term-list-atblp x atbl)))
+                     (equal (logic.term-list-atblp (clause.factor-list x assignment) atbl)
+                            t))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :shared-hyp (not (consp assignment))
+  :thms ((term clause.factor-when-not-consp-of-assignment
+               (implies (force (logic.termp x))
+                        (equal (clause.factor x assignment)
+                               x)))
+         (t clause.factor-list-when-not-consp-of-assignment
+            (implies (force (logic.term-listp x))
+                     (equal (clause.factor-list x assignment)
+                            (list-fix x)))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defprojection :list (clause.multifactor term x)
+               :element (clause.factor term x)
+               :guard (and (logic.termp term)
+                           (map-listp x)))
+
+(defthm forcing-logic.term-listp-of-clause.multifactor
+  (implies (force (logic.termp x))
+           (equal (logic.term-listp (clause.multifactor x assignments))
+                  t))
+  :hints(("Goal" :induct (cdr-induction assignments))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/lift-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/lift-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/lift-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/lift-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,258 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lift")
+(include-book "casesplit-bldr")
+(include-book "../update-clause-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund clause.lift-term1-bldr (x)
+  (declare (xargs :guard (logic.termp x)
+                  :verify-guards nil))
+  (cond ((logic.constantp x)
+         (build.reflexivity x))
+        ((logic.variablep x)
+         (build.reflexivity x))
+        ((logic.functionp x)
+         (let ((name (logic.function-name x))
+               (args (logic.function-args x)))
+           (if (and (equal name 'if)
+                    (equal (len args) 3))
+               (build.pequal-by-args 'if
+                                     (list (clause.lift-term1-bldr (first args))
+                                           (clause.lift-term1-bldr (second args))
+                                           (clause.lift-term1-bldr (third args))))
+             (if (clause.simple-term-listp args)
+                 (build.reflexivity x)
+               (clause.cases-bldr x (clause.simple-tests x) nil)))))
+        ((logic.lambdap x)
+         (let ((actuals (logic.lambda-actuals x)))
+           (if (clause.simple-term-listp actuals)
+               (build.reflexivity x)
+             (clause.cases-bldr x (clause.simple-tests x) nil))))
+        (t nil)))
+
+(defobligations clause.lift-term1-bldr
+  (build.reflexivity build.pequal-by-args clause.cases-bldr))
+
+(encapsulate
+ ()
+ (defthm lemma-for-forcing-logic.appealp-of-clause.lift-term1-bldr
+   (implies (logic.termp x)
+            (and (logic.appealp (clause.lift-term1-bldr x))
+                 (equal (logic.conclusion (clause.lift-term1-bldr x))
+                        (logic.pequal x (clause.lift-term1 x)))))
+   :rule-classes nil
+   :hints(("Goal"
+           :in-theory (enable clause.lift-term1-bldr clause.lift-term1)
+           :induct (clause.lift-term1-bldr x))))
+
+ (defthm forcing-logic.appealp-of-clause.lift-term1-bldr
+   (implies (force (logic.termp x))
+            (equal (logic.appealp (clause.lift-term1-bldr x))
+                   t))
+   :hints (("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-clause.lift-term1-bldr)))))
+
+ (defthm forcing-logic.conclusion-of-clause.lift-term1-bldr
+   (implies (force (logic.termp x))
+            (equal (logic.conclusion (clause.lift-term1-bldr x))
+                   (logic.pequal x (clause.lift-term1 x))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints (("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-clause.lift-term1-bldr))))))
+
+(verify-guards clause.lift-term1-bldr)
+
+(defthm@ forcing-logic.proofp-of-clause.lift-term1-bldr
+  (implies (force (and (logic.termp x)
+                       ;; ---
+                       (logic.term-atblp x atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (@obligations clause.lift-term1-bldr)))
+           (equal (logic.proofp (clause.lift-term1-bldr x) axioms thms atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (enable clause.lift-term1-bldr)
+          :induct (clause.lift-term1-bldr x))))
+
+
+
+
+(defund clause.lift-term-bldr (x)
+  (declare (xargs :guard (logic.termp x)
+                  :measure (clause.depth-list (clause.unlifted-subterms x))
+                  :verify-guards nil))
+  (if (and (logic.termp x)
+           (not (clause.lifted-termp x)))
+      (let* ((step-proof (clause.lift-term1-bldr x))             ;; x = x'
+             (x-prime (logic.=rhs (logic.conclusion step-proof))))
+        (if (clause.lifted-termp x-prime)
+            ;; Optimization: don't bother to do the transitivity step if x' is
+            ;; lifted, since lifting x' will just give us x'
+            step-proof
+          (build.transitivity-of-pequal step-proof (clause.lift-term-bldr x-prime))))
+    (build.reflexivity x)))
+
+(defobligations clause.lift-term-bldr
+  (clause.lift-term1-bldr build.transitivity-of-pequal build.reflexivity))
+
+(encapsulate
+ ()
+ (defthm lemma-for-forcing-logic.appealp-of-clause.lift-term-bldr
+   (implies (logic.termp x)
+            (and (logic.appealp (clause.lift-term-bldr x))
+                 (equal (logic.conclusion (clause.lift-term-bldr x))
+                        (logic.pequal x (clause.lift-term x)))))
+   :rule-classes nil
+   :hints(("Goal" :in-theory (enable clause.lift-term-bldr clause.lift-term))))
+
+ (defthm forcing-logic.appealp-of-clause.lift-term-bldr
+   (implies (force (logic.termp x))
+            (equal (logic.appealp (clause.lift-term-bldr x))
+                   t))
+   :hints (("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-clause.lift-term-bldr)))))
+
+ (defthm forcing-logic.conclusion-of-clause.lift-term-bldr
+   (implies (force (logic.termp x))
+            (equal (logic.conclusion (clause.lift-term-bldr x))
+                   (logic.pequal x (clause.lift-term x))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints (("Goal" :use ((:instance lemma-for-forcing-logic.appealp-of-clause.lift-term-bldr))))))
+
+(verify-guards clause.lift-term-bldr)
+
+(defthm@ forcing-logic.proofp-of-clause.lift-term-bldr
+  (implies (force (and (logic.termp x)
+                       ;; ---
+                       (logic.term-atblp x atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (@obligations clause.lift-term-bldr)))
+           (equal (logic.proofp (clause.lift-term-bldr x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.lift-term-bldr))))
+
+
+
+
+
+(defprojection :list (clause.lift-term-list-bldr x)
+               :element (clause.lift-term-bldr x)
+               :guard (logic.term-listp x))
+
+(defobligations clause.lift-term-list-bldr
+  (clause.lift-term-bldr))
+
+(defthm forcing-logic.appeal-listp-of-clause.lift-term-list-bldr
+  (implies (force (logic.term-listp x))
+           (equal (logic.appeal-listp (clause.lift-term-list-bldr x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.lift-term-list-bldr))))
+
+(defthm forcing-logic.strip-conclusions-of-clause.lift-term-list-bldr
+  (implies (force (logic.term-listp x))
+           (equal (logic.strip-conclusions (clause.lift-term-list-bldr x))
+                  (logic.pequal-list x (clause.lift-term-list x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable clause.lift-term-list-bldr))))
+
+(defthm@ forcing-logic.proof-listp-of-clause.lift-term-list-bldr
+  (implies (force (and (logic.term-listp x)
+                       (logic.term-list-atblp x atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (@obligations clause.lift-term-list-bldr)))
+           (equal (logic.proof-listp (clause.lift-term-list-bldr x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.lift-term-list-bldr))))
+
+
+
+
+(defun clause.lift-clauses-bldr (x proofs)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (clause.lift-term-list-list x))))))
+  (if (consp x)
+      (let* ((lift-proofs  (clause.lift-term-list-bldr (car x)))
+             (lift-terms   (clause.lift-term-list (car x)))
+             (update-proof (clause.update-clause-bldr lift-terms (car proofs) lift-proofs)))
+        (ACL2::prog2$
+         (ACL2::cw! ";; Lift step: ~s0~|"
+                    (STR::ncat "Input " (unbounded-rank (car proofs))
+                               "; Lift " (unbounded-rank lift-proofs)
+                               "; Update " (- (unbounded-rank update-proof)
+                                              (ACL2::+ (unbounded-rank lift-proofs)
+                                                       (unbounded-rank (car proofs))))
+                               "; Output " (unbounded-rank update-proof)))
+         (cons update-proof
+               (clause.lift-clauses-bldr (cdr x) (cdr proofs)))))
+    nil))
+
+(defobligations clause.lift-clauses-bldr
+  (clause.update-clause-bldr
+   clause.lift-term-list-bldr))
+
+(encapsulate
+ ()
+ (assume (force (and (logic.term-list-listp x)
+                     (cons-listp x)
+                     (logic.appeal-listp proofs)
+                     (equal (logic.strip-conclusions proofs)
+                            (clause.clause-list-formulas (clause.lift-term-list-list x))))))
+
+ (conclude forcing-logic.appeal-listp-of-clause.lift-clauses-bldr
+           (equal (logic.appeal-listp (clause.lift-clauses-bldr x proofs))
+                  t))
+
+ (conclude forcing-logic.strip-conclusions-of-clause.lift-clauses-bldr
+           (equal (logic.strip-conclusions (clause.lift-clauses-bldr x proofs))
+                  (clause.clause-list-formulas x))
+           :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-clause.lift-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.lift-term-list-list x)))
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (logic.term-list-list-atblp x atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations clause.lift-clauses-bldr)))
+            (equal (logic.proof-listp (clause.lift-clauses-bldr x proofs) axioms thms atbl)
+                   t))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/lift.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/lift.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/lift.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/lift.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,360 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "depth")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (clause.lift-term1 x)
+;;
+;; This is a single pass of if-lifting.  We collect all the simple tests that
+;; occur within unlifted portions of the term, and case-split based on those
+;; simple tests.  This makes progress by reducing the maximum if-depth of any
+;; unlifted subterm.
+
+(defund clause.lift-term1 (x)
+  (declare (xargs :guard (logic.termp x)
+                  :verify-guards nil))
+  (cond ((logic.constantp x) x)
+        ((logic.variablep x) x)
+        ((logic.functionp x)
+         (let ((name (logic.function-name x))
+               (args (logic.function-args x)))
+           (if (and (equal name 'if)
+                    (equal (len args) 3))
+               (logic.function 'if
+                      (list (clause.lift-term1 (first args))
+                            (clause.lift-term1 (second args))
+                            (clause.lift-term1 (third args))))
+             (if (clause.simple-term-listp args)
+                 x
+               (clause.casesplit x (clause.simple-tests x) nil)))))
+        ((logic.lambdap x)
+         (let ((actuals (logic.lambda-actuals x)))
+           (if (clause.simple-term-listp actuals)
+               x
+             (clause.casesplit x (clause.simple-tests x) nil))))
+        (t x)))
+
+(defthm forcing-logic.termp-of-clause.lift-term1
+  (implies (force (logic.termp x))
+           (equal (logic.termp (clause.lift-term1 x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.lift-term1))))
+
+(verify-guards clause.lift-term1)
+
+(defthm forcing-logic.term-atblp-of-clause.lift-term1
+  (implies (and (force (logic.termp x))
+                (force (logic.term-atblp x atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-atblp (clause.lift-term1 x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.lift-term1))))
+
+(defthm clause.lift-term1-when-no-clause.unlifted-subterms
+  (implies (and (clause.lifted-termp x)
+                (force (logic.termp x)))
+           (equal (clause.lift-term1 x)
+                  x))
+  :hints(("Goal" :in-theory (enable clause.lift-term1))))
+
+
+
+(defthmd forcing-clause.depth-of-clause.factor-strong
+  (implies (and (force (logic.termp x))
+                (force (not (clause.simple-termp x)))
+                (force (clause.simple-term-listp (domain assignment)))
+                (force (disjoint-from-nonep (domain assignment) (clause.term-paths x))))
+           (equal (< (clause.depth (clause.factor x assignment))
+                     (clause.depth x))
+                  t)))
+
+(local (in-theory (enable forcing-clause.depth-of-clause.factor-strong)))
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-clause.depth-decreases-in-lambda-case
+   (implies (and (logic.lambdap x)
+                 (logic.termp x)
+                 (not (clause.simple-term-listp (logic.lambda-actuals x)))
+                 (clause.simple-term-listp (domain assignment))
+                 (disjoint-from-nonep (domain assignment) (clause.term-paths-list (logic.lambda-actuals x))))
+            (< (clause.depth (clause.factor (clause.deepest-after-factoring (logic.lambda-actuals x) assignment) assignment))
+               (clause.depth (clause.deepest (logic.lambda-actuals x)))))
+   :hints(("Goal"
+           :in-theory (disable clause.deepest-weakly-deeper-than-any-member)
+           :use ((:instance clause.deepest-weakly-deeper-than-any-member
+                            (x (logic.lambda-actuals x))
+                            (a (clause.deepest-after-factoring (logic.lambda-actuals x) assignment)))))))
+
+ (defthmd lemma2-for-clause.depth-decreases-in-lambda-case
+   (implies (and (logic.lambdap x)
+                 (logic.termp x)
+                 (not (clause.simple-term-listp (logic.lambda-actuals x))))
+            (< (clause.depth
+                (clause.factor
+                 (clause.deepest-after-factoring
+                  (logic.lambda-actuals x)
+                  (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil)))
+                 (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil))))
+               (clause.depth (clause.deepest (logic.lambda-actuals x)))))
+   :hints(("Goal"
+           :in-theory (disable clause.simple-term-listp-of-domain-of-clause.cases
+                               disjoint-from-nonep-of-domain-of-clause.cases
+                               lemma-for-clause.depth-decreases-in-lambda-case)
+           :use ((:instance lemma-for-clause.depth-decreases-in-lambda-case
+                            (assignment (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil))))
+                 (:instance clause.simple-term-listp-of-domain-of-clause.cases
+                            (x     (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil)))
+                            (cases (clause.simple-tests-list (logic.lambda-actuals x)))
+                            (assignment nil))
+                 (:instance disjoint-from-nonep-of-domain-of-clause.cases
+                            (x     (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil)))
+                            (cases (clause.simple-tests-list (logic.lambda-actuals x)))
+                            (set   (clause.term-paths-list (logic.lambda-actuals x)))
+                            (assignment nil))))))
+
+ (defthmd clause.depth-decreases-in-lambda-case
+   (implies (and (logic.lambdap x)
+                 (not (clause.simple-term-listp (logic.lambda-actuals x)))
+                 (logic.termp x))
+            (< (clause.depth-list (clause.unlifted-subterms-list (clause.multifactor x (clause.cases (clause.simple-tests-list (logic.lambda-actuals x)) nil))))
+               (clause.depth-list (logic.lambda-actuals x))))
+   :hints(("Goal" :in-theory (enable lemma2-for-clause.depth-decreases-in-lambda-case
+                                     clause.depth-list-redefinition)))))
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-clause.depth-decreases-in-logic.functionp-case
+   (implies (and (logic.functionp x)
+                 (logic.termp x)
+                 (not (clause.simple-term-listp (logic.function-args x)))
+                 (clause.simple-term-listp (domain assignment))
+                 (disjoint-from-nonep (domain assignment) (clause.term-paths-list (logic.function-args x))))
+            (< (clause.depth (clause.factor (clause.deepest-after-factoring (logic.function-args x) assignment) assignment))
+               (clause.depth (clause.deepest (logic.function-args x)))))
+   :hints(("Goal"
+           :in-theory (disable clause.deepest-weakly-deeper-than-any-member)
+           :use ((:instance clause.deepest-weakly-deeper-than-any-member
+                            (x (logic.function-args x))
+                            (a (clause.deepest-after-factoring (logic.function-args x) assignment)))))))
+
+ (defthmd lemma2-for-clause.depth-decreases-in-logic.functionp-case
+   (implies (and (logic.functionp x)
+                 (logic.termp x)
+                 (not (clause.simple-term-listp (logic.function-args x))))
+            (< (clause.depth
+                (clause.factor
+                 (clause.deepest-after-factoring (logic.function-args x) (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil)))
+                 (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil))))
+               (clause.depth (clause.deepest (logic.function-args x)))))
+   :hints(("Goal"
+           :in-theory (disable clause.simple-term-listp-of-domain-of-clause.cases
+                               disjoint-from-nonep-of-domain-of-clause.cases
+                               lemma-for-clause.depth-decreases-in-logic.functionp-case)
+           :use ((:instance lemma-for-clause.depth-decreases-in-logic.functionp-case
+                            (assignment (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil))))
+                 (:instance clause.simple-term-listp-of-domain-of-clause.cases
+                            (x     (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil)))
+                            (cases (clause.simple-tests-list (logic.function-args x)))
+                            (assignment nil))
+                 (:instance disjoint-from-nonep-of-domain-of-clause.cases
+                            (x     (clause.special-assignment x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil)))
+                            (cases (clause.simple-tests-list (logic.function-args x)))
+                            (set   (clause.term-paths-list (logic.function-args x)))
+                            (assignment nil))))))
+
+ (defthmd clause.depth-decreases-in-non-if-logic.functionp-case
+   (implies (and (not (equal (logic.function-name x) 'if))
+                 (not (clause.simple-term-listp (logic.function-args x)))
+                 (logic.functionp x)
+                 (logic.termp x))
+            (< (clause.depth-list (clause.unlifted-subterms-list (clause.multifactor x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil))))
+               (clause.depth-list (logic.function-args x))))
+   :hints(("Goal" :in-theory (e/d (clause.depth-list-redefinition
+                                   lemma2-for-clause.depth-decreases-in-logic.functionp-case)
+                                  (clause.simple-termp-when-bad-args-logic.functionp
+                                   clause.unlifted-subterms-when-bad-args-logic.functionp)))))
+
+ (defthmd clause.depth-decreases-in-bad-args-logic.functionp-case
+   (implies (and (not (equal (len (logic.function-args x)) 3))
+                 (not (clause.simple-term-listp (logic.function-args x)))
+                 (logic.functionp x)
+                 (logic.termp x))
+            (< (clause.depth-list (clause.unlifted-subterms-list (clause.multifactor x (clause.cases (clause.simple-tests-list (logic.function-args x)) nil))))
+               (clause.depth-list (logic.function-args x))))
+   :hints(("Goal" :in-theory (enable clause.depth-list-redefinition
+                                     lemma2-for-clause.depth-decreases-in-logic.functionp-case)))))
+
+(defthm clause.lift-term1-makes-progress
+  (implies (and (logic.termp x)
+                (clause.unlifted-subterms x))
+           (equal (< (clause.depth-list (clause.unlifted-subterms (clause.lift-term1 x)))
+                     (clause.depth-list (clause.unlifted-subterms x)))
+                  t))
+  :hints(("Goal"
+          :expand (clause.depth x)
+          :in-theory (enable clause.lift-term1
+                             clause.depth-decreases-in-bad-args-logic.functionp-case
+                             clause.depth-decreases-in-non-if-logic.functionp-case
+                             clause.depth-decreases-in-lambda-case)
+          :induct (clause.lift-term1 x))))
+
+
+
+
+;; (clause.lift-term x)
+;;
+;; This is full, multi-pass if-lifting.  We repeatedly call if-lift1 to bring
+;; up tests to the top of a term, until the term is in lifted form.
+
+(defund clause.lift-term (x)
+  (declare (xargs :guard (logic.termp x)
+                  :measure (clause.depth-list (clause.unlifted-subterms x))))
+  (if (and (logic.termp x)
+           (not (clause.lifted-termp x)))
+      (clause.lift-term (clause.lift-term1 x))
+    x))
+
+(defthm forcing-logic.termp-of-clause.lift-term
+  (implies (force (logic.termp x))
+           (equal (logic.termp (clause.lift-term x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.lift-term))))
+
+(defthm forcing-logic.term-atblp-of-clause.lift-term
+  (implies (and (force (logic.termp x))
+                (force (logic.term-atblp x atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-atblp (clause.lift-term x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.lift-term))))
+
+(defthm forcing-clause.lifted-termp-of-clause.lift-term
+  (implies (force (logic.termp x))
+           (equal (clause.lifted-termp (clause.lift-term x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.lift-term))))
+
+(defthm clause.lift-term-when-clause.simple-termp
+  (implies (clause.simple-termp x)
+           (equal (clause.lift-term x)
+                  x))
+  :hints(("Goal" :in-theory (enable clause.lift-term))))
+
+(defthm clause.lift-term-when-clause.lifted-termp
+  (implies (clause.lifted-termp x)
+           (equal (clause.lift-term x)
+                  x))
+  :hints(("Goal" :in-theory (enable clause.lift-term))))
+
+
+
+(defprojection :list (clause.lift-term-list x)
+               :element (clause.lift-term x)
+               :guard (logic.term-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-clause.lift-term-list
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (clause.lift-term-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-clause.lift-term-list
+  (implies (and (force (logic.term-listp x))
+                (force (logic.term-list-atblp x atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-atblp (clause.lift-term-list x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.lift-term-list-when-clause.simple-term-listp
+  (implies (clause.simple-term-listp x)
+           (equal (clause.lift-term-list x)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.lift-term-list-when-clause.lifted-term-listp
+  (implies (clause.lifted-term-listp x)
+           (equal (clause.lift-term-list x)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-clause.lifted-term-listp-of-clause.lift-term-list
+  (implies (force (logic.term-listp x))
+           (equal (clause.lifted-term-listp (clause.lift-term-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defprojection :list (clause.lift-term-list-list x)
+               :element (clause.lift-term-list x)
+               :guard (logic.term-list-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-clause.lift-term-list-list
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.term-list-listp (clause.lift-term-list-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-clause.lift-term-list-list
+  (implies (and (force (logic.term-list-listp x))
+                (force (logic.term-list-list-atblp x atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-list-atblp (clause.lift-term-list-list x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.lift-term-list-list-when-clause.simple-term-list-listp
+  (implies (clause.simple-term-list-listp x)
+           (equal (clause.lift-term-list-list x)
+                  (list-list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-cons-listp-of-clause.lift-term-list-list
+  (implies (force (cons-listp x))
+           (equal (cons-listp (clause.lift-term-list-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/lifted-termp.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/lifted-termp.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/lifted-termp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/lifted-termp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,156 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-termp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; (clause.lifted-termp x)
+;;
+;; We say x is a "lifted" term if it has no subterms of the form (f ... (if
+;; ...)  ...) unless f is if.  We call such subterms the "unlifted" parts of a
+;; term.
+
+(defund clause.lifted-termp (x)
+  (declare (xargs :guard (logic.termp x)))
+  (cond ((logic.constantp x) t)
+        ((logic.variablep x) t)
+        ((logic.functionp x)
+         (let ((name (logic.function-name x))
+               (args (logic.function-args x)))
+           (if (and (equal name 'if)
+                    (equal (len args) 3))
+               (and (clause.lifted-termp (first args))
+                    (clause.lifted-termp (second args))
+                    (clause.lifted-termp (third args)))
+             (clause.simple-term-listp (logic.function-args x)))))
+        ((logic.lambdap x)
+         (clause.simple-term-listp (logic.lambda-actuals x)))
+        (t t)))
+
+(defthm clause.lifted-termp-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (clause.lifted-termp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+(defthm clause.lifted-termp-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (clause.lifted-termp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+(defthm clause.lifted-termp-when-not-if
+  (implies (and (not (equal 'if (logic.function-name x)))
+                (logic.functionp x))
+           (equal (clause.lifted-termp x)
+                  (clause.simple-term-listp (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+(defthm clause.lifted-termp-when-bad-args-logic.functionp
+  (implies (and (not (equal 3 (len (logic.function-args x))))
+                (logic.functionp x))
+           (equal (clause.lifted-termp x)
+                  (clause.simple-term-listp (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+(defthm clause.lifted-termp-when-if-logic.functionp
+  (implies (and (equal 'if (logic.function-name x))
+                (equal 3 (len (logic.function-args x)))
+                (logic.functionp x))
+           (equal (clause.lifted-termp x)
+                  (and (clause.lifted-termp (first (logic.function-args x)))
+                       (clause.lifted-termp (second (logic.function-args x)))
+                       (clause.lifted-termp (third (logic.function-args x))))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+(defthm clause.lifted-termp-when-if-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (clause.lifted-termp x)
+                  (clause.simple-term-listp (logic.lambda-actuals x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+(defthm clause.lifted-termp-when-degenerate
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (clause.lifted-termp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+
+(defun clause.lifted-termp-induction (x)
+  (declare (xargs :verify-guards nil))
+  (cond ((logic.constantp x) nil)
+        ((logic.variablep x) nil)
+        ((and (logic.functionp x)
+              (equal (logic.function-name x) 'if)
+              (equal (len (logic.function-args x)) 3))
+         (list (clause.lifted-termp-induction (first (logic.function-args x)))
+               (clause.lifted-termp-induction (second (logic.function-args x)))
+               (clause.lifted-termp-induction (third (logic.function-args x)))))
+        ((logic.functionp x)
+         nil)
+        ((logic.lambdap x)
+         nil)
+        (t nil)))
+
+(defthm clause.lifted-termp-when-clause.simple-termp
+  (implies (clause.simple-termp x)
+           (equal (clause.lifted-termp x)
+                  t))
+  :hints(("Goal" :induct (clause.lifted-termp-induction x))))
+
+(defthm booleanp-of-clause.lifted-termp
+  (equal (booleanp (clause.lifted-termp x))
+         t)
+  :hints(("Goal" :induct (clause.lifted-termp-induction x))))
+
+(deflist clause.lifted-term-listp (x)
+  (clause.lifted-termp x)
+  :elementp-of-nil t
+  :guard (logic.term-listp x))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/limlift-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/limlift-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/limlift-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/limlift-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,284 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "limlift")
+(include-book "casesplit-bldr")
+(include-book "../update-clause-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund clause.limlift-term1-bldr (x k)
+  (declare (xargs :guard (and (logic.termp x)
+                              (natp k))
+                  :verify-guards nil))
+  (cond ((logic.constantp x)
+         (cons (build.reflexivity x) k))
+        ((logic.variablep x)
+         (cons (build.reflexivity x) k))
+        ((logic.functionp x)
+         (let ((name (logic.function-name x))
+               (args (logic.function-args x)))
+           (cond ((and (equal name 'if)
+                       (equal (len args) 3))
+                  (let* ((lift-first  (clause.limlift-term1-bldr (first args) k))
+                         (lift-second (clause.limlift-term1-bldr (second args) (cdr lift-first)))
+                         (lift-third  (clause.limlift-term1-bldr (third args) (cdr lift-second))))
+                    (cons (build.pequal-by-args 'if (list (car lift-first) (car lift-second) (car lift-third)))
+                          (cdr lift-third))))
+                 ((clause.simple-term-listp args)
+                  (cons (build.reflexivity x) k))
+                 (t
+                  (let* ((tests    (clause.simple-tests x))
+                         (numtests (fast-len tests 0)))
+                    (if (<= numtests k)
+                        (cons (clause.cases-bldr x tests nil) (- k numtests))
+                      (cons (clause.cases-bldr x (firstn k tests) nil) 0)))))))
+        ((logic.lambdap x)
+         (let ((actuals (logic.lambda-actuals x)))
+           (if (clause.simple-term-listp actuals)
+               (cons (build.reflexivity x) k)
+             (let* ((tests    (clause.simple-tests x))
+                    (numtests (fast-len tests 0)))
+               (if (<= numtests k)
+                   (cons (clause.cases-bldr x tests nil) (- k numtests))
+                 (cons (clause.cases-bldr x (firstn k tests) nil) 0))))))
+        (t
+         (cons nil k))))
+
+(defobligations clause.limlift-term1-bldr
+  (build.reflexivity
+   build.pequal-by-args
+   clause.cases-bldr))
+
+(defthm cdr-of-clause.limlift-term1-bldr
+  (equal (cdr (clause.limlift-term1-bldr x k))
+         (cdr (clause.limlift-term1 x k)))
+  :hints(("Goal"
+          :expand ((clause.limlift-term1-bldr x k)
+                   (clause.limlift-term1 x k))
+          :in-theory (enable clause.limlift-term1-bldr)
+          :induct (clause.limlift-term1-bldr x k))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (logic.termp x)
+                   (and (logic.appealp (car (clause.limlift-term1-bldr x k)))
+                        (equal (logic.conclusion (car (clause.limlift-term1-bldr x k)))
+                               (logic.pequal x (car (clause.limlift-term1 x k))))))
+          :hints(("Goal"
+                  :expand ((clause.limlift-term1-bldr x k)
+                           (clause.limlift-term1 x k))
+                  :in-theory (enable clause.limlift-term1-bldr)
+                  :induct (clause.limlift-term1-bldr x k)))))
+
+ (defthm forcing-logic.appealp-of-car-of-clause.limlift-term1-bldr
+   (implies (force (logic.termp x))
+            (equal (logic.appealp (car (clause.limlift-term1-bldr x k)))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-car-of-clause.limlift-term1-bldr
+   (implies (force (logic.termp x))
+            (equal (logic.conclusion (car (clause.limlift-term1-bldr x k)))
+                   (logic.pequal x (car (clause.limlift-term1 x k)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(verify-guards clause.limlift-term1-bldr)
+
+(defthm@ forcing-logic.proofp-of-car-of-clause.limlift-term1-bldr
+  (implies (force (and (logic.termp x)
+                       ;; ---
+                       (logic.term-atblp x atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (@obligations clause.limlift-term1-bldr)))
+           (equal (logic.proofp (car (clause.limlift-term1-bldr x k)) axioms thms atbl)
+                  t))
+  :hints(("Goal"
+          :expand (clause.limlift-term1-bldr x k)
+          :in-theory (enable clause.limlift-term1-bldr)
+          :induct (clause.limlift-term1-bldr x k))))
+
+
+
+
+(defund clause.limlift-term-bldr (x k)
+  (declare (xargs :guard (and (logic.termp x)
+                              (natp k))
+                  :verify-guards nil
+                  :measure (nfix k)))
+  (cond ((zp k)
+         (build.reflexivity x))
+        ((clause.lifted-termp x)
+         (build.reflexivity x))
+        (t
+         (let* ((lift1       (clause.limlift-term1-bldr x k))
+                (lift1-proof (car lift1))
+                (lift1-k     (cdr lift1))
+                (lift1-rhs   (logic.=rhs (logic.conclusion lift1-proof))))
+           (build.transitivity-of-pequal lift1-proof
+                                         (clause.limlift-term-bldr lift1-rhs lift1-k))))))
+
+(defobligations clause.limlift-term-bldr
+  (clause.limlift-term1-bldr
+   build.transitivity-of-pequal
+   build.reflexivity))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (logic.termp x)
+                   (and (logic.appealp (clause.limlift-term-bldr x k))
+                        (equal (logic.conclusion (clause.limlift-term-bldr x k))
+                               (logic.pequal x (clause.limlift-term x k)))))
+          :hints(("Goal" :in-theory (enable clause.limlift-term-bldr clause.limlift-term)))))
+
+ (defthm forcing-logic.appealp-of-clause.limlift-term-bldr
+   (implies (force (logic.termp x))
+            (equal (logic.appealp (clause.limlift-term-bldr x k))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.limlift-term-bldr
+   (implies (force (logic.termp x))
+            (equal (logic.conclusion (clause.limlift-term-bldr x k))
+                   (logic.pequal x (clause.limlift-term x k))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(verify-guards clause.limlift-term-bldr)
+
+(defthm@ forcing-logic.proofp-of-clause.limlift-term-bldr
+  (implies (force (and (logic.termp x)
+                       (logic.term-atblp x atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (@obligations clause.limlift-term-bldr)))
+           (equal (logic.proofp (clause.limlift-term-bldr x k) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limlift-term-bldr))))
+
+
+
+
+(defprojection
+  :list (clause.limlift-term-list-bldr x k)
+  :element (clause.limlift-term-bldr x k)
+  :guard (and (logic.term-listp x)
+              (natp k)))
+
+(defobligations clause.limlift-term-list-bldr
+  (clause.limlift-term-bldr))
+
+(defthm forcing-logic.appeal-listp-of-clause.limlift-term-list-bldr
+  (implies (force (logic.term-listp x))
+           (equal (logic.appeal-listp (clause.limlift-term-list-bldr x k))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limlift-term-list-bldr))))
+
+(defthm forcing-logic.strip-conclusions-of-clause.limlift-term-list-bldr
+  (implies (force (logic.term-listp x))
+           (equal (logic.strip-conclusions (clause.limlift-term-list-bldr x k))
+                  (logic.pequal-list x (clause.limlift-term-list x k))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable clause.limlift-term-list-bldr))))
+
+(defthm@ forcing-logic.proof-listp-of-clause.limlift-term-list-bldr
+  (implies (force (and (logic.term-listp x)
+                       (logic.term-list-atblp x atbl)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (@obligations clause.limlift-term-list-bldr)))
+           (equal (logic.proof-listp (clause.limlift-term-list-bldr x k) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limlift-term-list-bldr))))
+
+
+
+(defun clause.limlift-clauses-bldr (x limit proofs)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x)
+                              (natp limit)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (clause.limlift-term-list-list x limit))))))
+  (if (consp x)
+      (let* ((lift-proofs  (clause.limlift-term-list-bldr (car x) limit))
+             (lift-terms   (clause.limlift-term-list (car x) limit))
+             (update-proof (clause.update-clause-bldr lift-terms (car proofs) lift-proofs)))
+        (ACL2::prog2$
+         (ACL2::cw! ";; Limlift step: ~s0~|"
+                    (STR::ncat "Input " (unbounded-rank (car proofs))
+                              "; Lift " (unbounded-rank lift-proofs)
+                              "; Update " (- (unbounded-rank update-proof)
+                                             (ACL2::+ (unbounded-rank lift-proofs)
+                                                      (unbounded-rank (car proofs))))
+                              "; Output " (unbounded-rank update-proof)))
+         (cons update-proof
+               (clause.limlift-clauses-bldr (cdr x) limit (cdr proofs)))))
+    nil))
+
+(defobligations clause.limlift-clauses-bldr
+  (clause.limlift-term-list-bldr
+   clause.update-clause-bldr))
+
+(encapsulate
+ ()
+ (assume (force (and (logic.term-list-listp x)
+                     (cons-listp x)
+                     (natp limit)
+                     (logic.appeal-listp proofs)
+                     (equal (logic.strip-conclusions proofs)
+                            (clause.clause-list-formulas (clause.limlift-term-list-list x limit))))))
+
+ (conclude forcing-logic.appeal-listp-of-clause.limlift-clauses-bldr
+           (equal (logic.appeal-listp (clause.limlift-clauses-bldr x limit proofs))
+                  t))
+
+ (conclude forcing-logic.strip-conclusions-of-clause.limlift-clauses-bldr
+           (equal (logic.strip-conclusions (clause.limlift-clauses-bldr x limit proofs))
+                  (clause.clause-list-formulas x))
+           :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-clause.limlift-clauses-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (natp limit)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (clause.limlift-term-list-list x limit)))
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (logic.term-list-list-atblp x atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations clause.limlift-clauses-bldr)))
+            (equal (logic.proof-listp (clause.limlift-clauses-bldr x limit proofs) axioms thms atbl)
+                   t))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/limlift.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/limlift.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/limlift.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/limlift.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,309 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "depth")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; BOZO find this stuff a home
+
+(defthms-flag
+  :thms ((term consp-of-clause.simple-tests
+               (equal (consp (clause.simple-tests x))
+                      (if (clause.simple-tests x)
+                          t
+                        nil)))
+         (t consp-of-clause.simple-tests-list
+            (equal (consp (clause.simple-tests-list x))
+                   (if (clause.simple-tests-list x)
+                       t
+                     nil))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+
+(defthms-flag
+  :thms ((term clause.simple-tests-when-not-clause.simple-termp-under-iff
+               (implies (not (clause.simple-termp x))
+                        (iff (clause.simple-tests x)
+                             t)))
+         (t clause.simple-tests-list-when-not-clause.simple-term-listp-under-iff
+            (implies (not (clause.simple-term-listp x))
+                     (iff (clause.simple-tests-list x)
+                          t))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+
+
+(defthm forcing-logic.term-listp-of-firstn
+  ;; BOZO move to terms
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (firstn n x))
+                  t)))
+
+(defthm forcing-logic.term-list-atblp-of-firstn
+  ;; BOZO move to terms
+  (implies (force (logic.term-list-atblp x atbl))
+           (equal (logic.term-list-atblp (firstn n x) atbl)
+                  t)))
+
+
+
+
+;; (clause.limlift-term1 x k)
+;;
+;; This is a k-limited version of clause.lift1.  We perform if-lifting on the
+;; term x, but only do up to k case-splits.  We return the number of
+;; case-splits still available.
+
+(defund clause.limlift-term1 (x k)
+  (declare (xargs :guard (and (logic.termp x)
+                              (natp k))
+                  :verify-guards nil))
+  (cond ((logic.constantp x)
+         (cons x k))
+        ((logic.variablep x)
+         (cons x k))
+        ((logic.functionp x)
+         (let ((name (logic.function-name x))
+               (args (logic.function-args x)))
+           (cond ((and (equal name 'if)
+                       (equal (len args) 3))
+                  ;; The term is (if a b c).  This level of the term is already
+                  ;; split, but a,b,c might not be split.  So, we just need to
+                  ;; go down into the term and split it up.
+                  (let* ((lift-first+  (clause.limlift-term1 (first args) k))
+                         (lift-second+ (clause.limlift-term1 (second args) (cdr lift-first+)))
+                         (lift-third+  (clause.limlift-term1 (third args) (cdr lift-second+))))
+                    (cons (logic.function 'if (list (car lift-first+) (car lift-second+) (car lift-third+)))
+                          (cdr lift-third+))))
+                 ((clause.simple-term-listp args)
+                  ;; Nothing to do...
+                  (cons x k))
+                 (t
+                  ;; The term is (f a b c ...) and there are ifs inside the
+                  ;; a,b,c.  Go into the args and collect the terms and lift as
+                  ;; many as we can.
+                  (let* ((tests    (clause.simple-tests x))
+                         (numtests (fast-len tests 0)))
+                    (if (<= numtests k)
+                        (cons (clause.casesplit x tests nil) (- k numtests))
+                      (cons (clause.casesplit x (firstn k tests) nil) 0)))))))
+        ((logic.lambdap x)
+         (let ((actuals (logic.lambda-actuals x)))
+           (if (clause.simple-term-listp actuals)
+               (cons x k)
+             (let* ((tests    (clause.simple-tests x))
+                    (numtests (fast-len tests 0)))
+               (if (<= numtests k)
+                   (cons (clause.casesplit x tests nil) (- k numtests))
+                 (cons (clause.casesplit x (firstn k tests) nil) 0))))))
+        (t
+         (cons x k))))
+
+(defthm forcing-logic.termp-of-car-of-clause.limlift-term1
+  (implies (force (logic.termp x))
+           (equal (logic.termp (car (clause.limlift-term1 x k)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limlift-term1))))
+
+(defthm forcing-natp-of-cdr-of-clause.limlift-term1
+  (implies (force (natp k))
+           (equal (natp (cdr (clause.limlift-term1 x k)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limlift-term1))))
+
+(verify-guards clause.limlift-term1)
+
+(defthm forcing-logic.term-atblp-of-car-of-clause.lift1
+  (implies (and (force (logic.termp x))
+                (force (logic.term-atblp x atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-atblp (car (clause.limlift-term1 x k)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limlift-term1))))
+
+(defthm car-of-clause.lift1-when-clause.lifted-termp
+  (implies (and (clause.lifted-termp x)
+                (force (logic.termp x)))
+           (equal (car (clause.limlift-term1 x k))
+                  x))
+  :hints(("Goal" :in-theory (enable clause.limlift-term1))))
+
+(defthm cdr-of-clause.lift1-when-clause.lifted-termp
+  (implies (clause.lifted-termp x)
+           (equal (cdr (clause.limlift-term1 x k))
+                  k))
+  :hints(("Goal" :in-theory (e/d (clause.limlift-term1)
+                                 ((:executable-counterpart ACL2::force))))))
+
+(defthm cdr-of-clause.limlift-term1-never-increases
+  (equal (< k (cdr (clause.limlift-term1 x k)))
+         nil)
+  :hints(("Goal" :in-theory (enable clause.limlift-term1))))
+
+(defthm cdr-of-clause.limlift-term1-stays-at-zero
+  (equal (cdr (clause.limlift-term1 x 0))
+         0)
+  :hints(("Goal" :in-theory (e/d (clause.limlift-term1)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm cdr-of-clause.limlift-term1-usually-decreases
+  (implies (and (not (clause.lifted-termp x))
+                (not (zp k)))
+           (equal (< (cdr (clause.limlift-term1 x k)) k)
+                  t))
+  :hints(("Goal"
+          :induct (clause.limlift-term1 x k)
+          :in-theory (enable clause.limlift-term1 clause.lifted-termp)
+          :do-not-induct t)))
+
+
+
+;; (clause.limlift-term x k)
+;;
+;; This is full, multi-pass if-lifting.  We repeatedly call if-lift1 to bring
+;; up tests to the top of a term, until the term is in lifted form.
+
+(defund clause.limlift-term (x k)
+  (declare (xargs :guard (and (logic.termp x)
+                              (natp k))
+                  :measure (nfix k)))
+  (cond ((zp k)
+         x)
+        ((clause.lifted-termp x)
+         x)
+        (t
+         (let* ((lift1      (clause.limlift-term1 x k))
+                (lift1-term (car lift1))
+                (lift1-k    (cdr lift1)))
+           (clause.limlift-term lift1-term lift1-k)))))
+
+(defthm forcing-logic.termp-of-clause.limlift-term
+  (implies (force (logic.termp x))
+           (equal (logic.termp (clause.limlift-term x k))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limlift-term))))
+
+(defthm forcing-logic.term-atblp-of-clause.limlift-term
+  (implies (and (force (logic.termp x))
+                (force (logic.term-atblp x atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-atblp (clause.limlift-term x k) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.limlift-term))))
+
+(defthm clause.limlift-term-when-clause.simple-termp
+  (implies (clause.simple-termp x)
+           (equal (clause.limlift-term x k)
+                  x))
+  :hints(("Goal" :in-theory (enable clause.limlift-term))))
+
+(defthm clause.limlift-term-when-clause.lifted-termp
+  (implies (clause.lifted-termp x)
+           (equal (clause.limlift-term x k)
+                  x))
+  :hints(("Goal" :in-theory (enable clause.limlift-term))))
+
+
+
+(defprojection :list (clause.limlift-term-list x k)
+               :element (clause.limlift-term x k)
+               :guard (and (logic.term-listp x)
+                           (natp k))
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-clause.limlift-term-list
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (clause.limlift-term-list x k))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-clause.limlift-term-list
+  (implies (and (force (logic.term-listp x))
+                (force (logic.term-list-atblp x atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-atblp (clause.limlift-term-list x k) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.limlift-term-list-when-clause.simple-term-listp
+  (implies (clause.simple-term-listp x)
+           (equal (clause.limlift-term-list x k)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.limlift-term-list-when-clause.lifted-term-listp
+  (implies (clause.lifted-term-listp x)
+           (equal (clause.limlift-term-list x k)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defprojection :list (clause.limlift-term-list-list x k)
+               :element (clause.limlift-term-list x k)
+               :guard (and (logic.term-list-listp x)
+                           (natp k))
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-list-listp-of-clause.limlift-term-list-list
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.term-list-listp (clause.limlift-term-list-list x k))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atblp-of-clause.limlift-term-list-list
+  (implies (and (force (logic.term-list-listp x))
+                (force (logic.term-list-list-atblp x atbl))
+                (force (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-list-atblp (clause.limlift-term-list-list x k) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.limlift-term-list-list-when-clause.simple-term-list-listp
+  (implies (clause.simple-term-list-listp x)
+           (equal (clause.limlift-term-list-list x k)
+                  (list-list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-clause.limlift-term-list-list
+  (implies (force (cons-listp x))
+           (equal (cons-listp (clause.limlift-term-list-list x k))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/simple-termp.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/simple-termp.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/simple-termp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/simple-termp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,234 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../../logic/terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (clause.simple-termp x)
+;;
+;; A term is "simple" if it contains no if-expressions.  As a slight hack, we
+;; consider degenerate terms to be simple, so this definition lines up
+;; perfectly with clause.depth.
+
+(defund clause.flag-simple-termp (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (and (equal flag 'list)
+                                (logic.term-listp x)))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) t)
+            ((logic.variablep x) t)
+            ((logic.functionp x)
+             (if (and (equal (logic.function-name x) 'if)
+                      (equal (len (logic.function-args x)) 3))
+                 nil
+               (clause.flag-simple-termp 'list (logic.function-args x))))
+            ((logic.lambdap x)
+             (clause.flag-simple-termp 'list (logic.lambda-actuals x)))
+         (t t))
+    (if (consp x)
+        (and (clause.flag-simple-termp 'term (car x))
+             (clause.flag-simple-termp 'list (cdr x)))
+      t)))
+
+(definlined clause.simple-termp (x)
+  (declare (xargs :guard (logic.termp x)))
+  (clause.flag-simple-termp 'term x))
+
+(definlined clause.simple-term-listp (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (clause.flag-simple-termp 'list x))
+
+(defthmd definition-of-clause.simple-termp
+  (equal (clause.simple-termp x)
+         (cond ((logic.constantp x) t)
+               ((logic.variablep x) t)
+               ((logic.functionp x)
+                (if (and (equal (logic.function-name x) 'if)
+                         (equal (len (logic.function-args x)) 3))
+                    nil
+                  (clause.simple-term-listp (logic.function-args x))))
+               ((logic.lambdap x)
+                (clause.simple-term-listp (logic.lambda-actuals x)))
+               (t t)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.simple-termp
+                                    clause.simple-term-listp
+                                    clause.flag-simple-termp))))
+
+(defthmd definition-of-clause.simple-term-listp
+  (equal (clause.simple-term-listp x)
+         (if (consp x)
+             (and (clause.simple-termp (car x))
+                  (clause.simple-term-listp (cdr x)))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.simple-termp
+                                    clause.simple-term-listp
+                                    clause.flag-simple-termp))))
+
+(defthm clause.flag-simple-termp-of-term-removal
+  (equal (clause.flag-simple-termp 'term x)
+         (clause.simple-termp x))
+  :hints(("Goal" :in-theory (enable clause.simple-termp))))
+
+(defthm clause.flag-simple-termp-of-list-removal
+  (equal (clause.flag-simple-termp 'list x)
+         (clause.simple-term-listp x))
+  :hints(("Goal" :in-theory (enable clause.simple-term-listp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.simple-termp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.simple-term-listp))))
+
+(defthm clause.simple-termp-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (clause.simple-termp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-termp))))
+
+(defthm clause.simple-termp-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (clause.simple-termp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-termp))))
+
+(defthm clause.simple-termp-when-non-if-logic.functionp
+  (implies (and (not (equal 'if (logic.function-name x)))
+                (logic.functionp x))
+           (equal (clause.simple-termp x)
+                  (clause.simple-term-listp (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-termp))))
+
+(defthm clause.simple-termp-when-bad-args-logic.functionp
+  (implies (and (not (equal 3 (len (logic.function-args x))))
+                (logic.functionp x))
+           (equal (clause.simple-termp x)
+                  (clause.simple-term-listp (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-termp))))
+
+(defthm clause.simple-termp-when-if-logic.functionp
+  (implies (and (equal 'if (logic.function-name x))
+                (equal 3 (len (logic.function-args x)))
+                (logic.functionp x))
+           (equal (clause.simple-termp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-termp))))
+
+(defthm clause.simple-termp-when-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (clause.simple-termp x)
+                  (clause.simple-term-listp (logic.lambda-actuals x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-termp))))
+
+(defthm clause.simple-termp-when-degenerate
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (clause.simple-termp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-termp))))
+
+
+
+
+(defun clause.simple-term-induction (flag x)
+  (declare (xargs :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) nil)
+            ((logic.variablep x) nil)
+            ((logic.functionp x)
+             (if (and (equal (logic.function-name x) 'if)
+                      (equal (len (logic.function-args x)) 3))
+                 (list (clause.simple-term-induction 'term (first (logic.function-args x)))
+                       (clause.simple-term-induction 'term (second (logic.function-args x)))
+                       (clause.simple-term-induction 'term (third (logic.function-args x))))
+               (clause.simple-term-induction 'list (logic.function-args x))))
+            ((logic.lambdap x)
+             (clause.simple-term-induction 'list (logic.lambda-actuals x)))
+            (t nil))
+    (if (consp x)
+        (list (clause.simple-term-induction 'term (car x))
+              (clause.simple-term-induction 'list (cdr x)))
+      nil)))
+
+(defthm clause.simple-term-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.simple-term-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-term-listp))))
+
+(defthm clause.simple-term-listp-of-cons
+  (equal (clause.simple-term-listp (cons a x))
+         (and (clause.simple-termp a)
+              (clause.simple-term-listp x)))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-term-listp))))
+
+(defthms-flag
+  :thms ((term booleanp-of-clause.simple-termp
+               (equal (booleanp (clause.simple-termp x))
+                      t))
+         (t booleanp-of-clause.simple-term-listp
+            (equal (booleanp (clause.simple-term-listp x))
+                   t)))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(deflist clause.simple-term-listp (x)
+  (clause.simple-termp x)
+  :elementp-of-nil t
+  :already-definedp t)
+
+(defthm clause.simple-term-listp-when-length-three
+  (implies (equal (len x) 3)
+           (equal (clause.simple-term-listp x)
+                  (and (clause.simple-termp (first x))
+                       (clause.simple-termp (second x))
+                       (clause.simple-termp (third x))))))
+
+(deflist clause.simple-term-list-listp (x)
+  (clause.simple-term-listp x)
+  :elementp-of-nil t
+  :guard (logic.term-list-listp x))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/term-paths.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/term-paths.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/term-paths.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/term-paths.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,265 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "term-tests")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; (clause.term-paths x)
+;;
+;; We walk down the term and create lists of all the if expressions we
+;; encounter along the way.  I.e., these paths show you each set of choices you
+;; would need to make in order to get to every tip of a term.
+
+(defund clause.flag-term-paths (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) nil)
+            ((logic.variablep x) nil)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (and (equal name 'if)
+                        (equal (len args) 3))
+                   (let ((paths (app (clause.flag-term-paths 'term (first args))
+                                     (app (clause.flag-term-paths 'term (second args))
+                                          (clause.flag-term-paths 'term (third args))))))
+                     (if paths
+                         (multicons (first args) paths)
+                       (list (list (first args)))))
+                 (clause.flag-term-paths 'list (logic.function-args x)))))
+            ((logic.lambdap x)
+             (clause.flag-term-paths 'list (logic.lambda-actuals x)))
+            (t nil))
+    (if (consp x)
+        (app (clause.flag-term-paths 'term (car x))
+             (clause.flag-term-paths 'list (cdr x)))
+      nil)))
+
+(defund clause.term-paths (x)
+  (declare (xargs :guard (logic.termp x)))
+  (clause.flag-term-paths 'term x))
+
+(defund clause.term-paths-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (clause.flag-term-paths 'list x))
+
+(defthmd definition-of-clause.term-paths
+  (equal (clause.term-paths x)
+         (cond ((logic.constantp x) nil)
+               ((logic.variablep x) nil)
+               ((logic.functionp x)
+                (let ((name (logic.function-name x))
+                      (args (logic.function-args x)))
+                  (if (and (equal name 'if)
+                           (equal (len args) 3))
+                      (let ((paths (app (clause.term-paths (first args))
+                                        (app (clause.term-paths (second args))
+                                             (clause.term-paths (third args))))))
+                        (if paths
+                            (multicons (first args) paths)
+                          (list (list (first args)))))
+                    (clause.term-paths-list (logic.function-args x)))))
+               ((logic.lambdap x)
+                (clause.term-paths-list (logic.lambda-actuals x)))
+               (t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.term-paths
+                                    clause.flag-term-paths
+                                    clause.term-paths-list))))
+
+(defthmd definition-of-clause.term-paths-list
+  (equal (clause.term-paths-list x)
+         (if (consp x)
+             (app (clause.term-paths (car x))
+                  (clause.term-paths-list (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable clause.term-paths
+                                    clause.flag-term-paths
+                                    clause.term-paths-list))))
+
+(defthm clause.flag-term-paths-of-term-removal
+  (equal (clause.flag-term-paths 'term x)
+         (clause.term-paths x))
+  :hints(("Goal" :in-theory (enable clause.term-paths))))
+
+(defthm clause.flag-term-paths-of-list-removal
+  (equal (clause.flag-term-paths 'list x)
+         (clause.term-paths-list x))
+  :hints(("Goal" :in-theory (enable clause.term-paths-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.term-paths))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.term-paths-list))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.flag-term-paths))))
+
+(defthm clause.term-paths-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (clause.term-paths x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths))))
+
+(defthm clause.term-paths-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (clause.term-paths x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths))))
+
+(defthm clause.term-paths-when-non-if-logic.functionp
+  (implies (and (not (equal 'if (logic.function-name x)))
+                (logic.functionp x))
+           (equal (clause.term-paths x)
+                  (clause.term-paths-list (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths))))
+
+(defthm clause.term-paths-when-bad-args-logic.functionp
+  (implies (and (not (equal 3 (len (logic.function-args x))))
+                (logic.functionp x))
+           (equal (clause.term-paths x)
+                  (clause.term-paths-list (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths))))
+
+(defthm clause.term-paths-when-if-logic.functionp
+  (implies (and (equal 'if (logic.function-name x))
+                (equal 3 (len (logic.function-args x)))
+                (logic.functionp x))
+           (equal (clause.term-paths x)
+                  (let ((paths (app (clause.term-paths (first (logic.function-args x)))
+                                    (app (clause.term-paths (second (logic.function-args x)))
+                                         (clause.term-paths (third (logic.function-args x)))))))
+                    (if paths
+                        (multicons (first (logic.function-args x)) paths)
+                      (list (list (first (logic.function-args x))))))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths))))
+
+(defthm clause.term-paths-when-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (clause.term-paths x)
+                  (clause.term-paths-list (logic.lambda-actuals x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths))))
+
+(defthm clause.term-paths-when-degenerate
+  (implies (and (not (logic.variablep x))
+                (not (logic.constantp x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (clause.term-paths x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths))))
+
+(defthm clause.term-paths-list-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.term-paths-list x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths-list))))
+
+(defthm clause.term-paths-list-of-cons
+  (equal (clause.term-paths-list (cons a x))
+         (app (clause.term-paths a)
+              (clause.term-paths-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-paths-list))))
+
+(defthm clause.term-paths-list-when-len-three
+  (implies (equal (len x) 3)
+           (equal (clause.term-paths-list x)
+                  (app (clause.term-paths (first x))
+                       (app (clause.term-paths (second x))
+                            (clause.term-paths (third x)))))))
+
+(defthms-flag
+  :thms ((term clause.term-paths-when-clause.simple-termp
+               (implies (clause.simple-termp x)
+                        (equal (clause.term-paths x)
+                               nil)))
+         (t clause.term-paths-list-when-clause.simple-term-listp
+            (implies (clause.simple-term-listp x)
+                     (equal (clause.term-paths-list x)
+                            nil))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term forcing-logic.term-list-listp-of-clause.term-paths
+               (implies (force (logic.termp x))
+                        (equal (logic.term-list-listp (clause.term-paths x))
+                               t)))
+         (t forcing-logic.term-list-listp-of-clause.term-paths-list
+            (implies (force (logic.term-listp x))
+                     (equal (logic.term-list-listp (clause.term-paths-list x))
+                            t))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term forcing-consp-of-clause.term-paths
+               (implies (force (logic.termp x))
+                        (equal (consp (clause.term-paths x))
+                               (not (clause.simple-termp x)))))
+         (t forcing-consp-of-clause.term-paths-list
+            (implies (force (logic.term-listp x))
+                     (equal (consp (clause.term-paths-list x))
+                            (not (clause.simple-term-listp x))))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthm disjoint-from-nonep-of-clause.term-paths-when-memberp
+  (implies (and (disjoint-from-nonep domain (clause.term-paths-list x))
+                (memberp a x))
+           (equal (disjoint-from-nonep domain (clause.term-paths a))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthms-flag
+  :thms ((term disjoint-from-nonep-of-clause.simple-tests-and-clause.term-paths
+               (implies (force (logic.termp x))
+                        (equal (disjoint-from-nonep (clause.simple-tests x) (clause.term-paths x))
+                               t)))
+         (t disjoint-from-nonep-of-clause.simple-tests-list-and-clause.term-paths-list
+            (implies (force (logic.term-listp x))
+                     (equal (disjoint-from-nonep (clause.simple-tests-list x)
+                                                 (clause.term-paths-list x))
+                            t))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/term-tests.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/term-tests.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/term-tests.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/term-tests.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,653 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-termp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; (clause.term-tests x)
+;;
+;; Construct the set of tests for x -- { a : (if a b c) is a subterm of x }
+
+(defund clause.flag-term-tests (flag x acc)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (true-listp acc))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) acc)
+            ((logic.variablep x) acc)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (and (equal name 'if)
+                        (equal (len args) 3))
+                   (cons (first args)
+                         (clause.flag-term-tests 'term (first args)
+                          (clause.flag-term-tests 'term (second args)
+                           (clause.flag-term-tests 'term (third args) acc))))
+                 (clause.flag-term-tests 'list args acc))))
+            ((logic.lambdap x)
+             (clause.flag-term-tests 'list (logic.lambda-actuals x) acc))
+            (t acc))
+    (if (consp x)
+        (clause.flag-term-tests 'term (car x)
+         (clause.flag-term-tests 'list (cdr x) acc))
+      acc)))
+
+(definlined clause.term-tests (x)
+  (declare (xargs :guard (logic.termp x)
+                  :verify-guards nil))
+  (clause.flag-term-tests 'term x nil))
+
+(definlined clause.term-tests-list (x)
+  (declare (xargs :guard (logic.term-listp x)
+                  :verify-guards nil))
+  (clause.flag-term-tests 'list x nil))
+
+(defund clause.slow-term-tests (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (and (equal flag 'list)
+                                (logic.term-listp x)))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) nil)
+            ((logic.variablep x) nil)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (and (equal name 'if)
+                        (equal (len args) 3))
+                   (cons (first args)
+                         (app (clause.slow-term-tests 'term (first args))
+                              (app (clause.slow-term-tests 'term (second args))
+                                   (clause.slow-term-tests 'term (third args)))))
+                 (clause.slow-term-tests 'list args))))
+            ((logic.lambdap x)
+             (clause.slow-term-tests 'list (logic.lambda-actuals x)))
+            (t nil))
+    (if (consp x)
+        (app (clause.slow-term-tests 'term (car x))
+             (clause.slow-term-tests 'list (cdr x)))
+      nil)))
+
+(encapsulate
+ ()
+ (defthmd lemma-1-for-definition-of-clause.term-tests
+   (equal (true-listp (clause.slow-term-tests flag x))
+          t)
+   :hints(("Goal"
+           :in-theory (enable clause.slow-term-tests)
+           :induct (clause.slow-term-tests flag x))))
+
+ (defthmd lemma-2-for-definition-of-clause.term-tests
+   (equal (true-listp (clause.flag-term-tests flag x acc))
+          (true-listp acc))
+   :hints(("Goal"
+           :in-theory (enable clause.flag-term-tests)
+           :induct (clause.flag-term-tests flag x acc))))
+
+ (local (in-theory (enable lemma-1-for-definition-of-clause.term-tests
+                           lemma-2-for-definition-of-clause.term-tests)))
+
+ (defthmd lemma-3-for-definition-of-clause.term-tests
+   (implies (true-listp acc)
+            (equal (clause.flag-term-tests flag x acc)
+                   (app (clause.slow-term-tests flag x) acc)))
+   :hints(("Goal"
+           :in-theory (enable clause.flag-term-tests clause.slow-term-tests)
+           :induct (clause.flag-term-tests flag x acc))))
+
+ (local (in-theory (enable lemma-3-for-definition-of-clause.term-tests)))
+
+ (verify-guards clause.flag-term-tests)
+ (verify-guards clause.term-tests)
+ (verify-guards clause.term-tests-list)
+
+ (defthmd definition-of-clause.term-tests
+   (equal (clause.term-tests x)
+          (cond ((logic.constantp x) nil)
+                ((logic.variablep x) nil)
+                ((logic.functionp x)
+                 (let ((name (logic.function-name x))
+                       (args (logic.function-args x)))
+                   (if (and (equal name 'if)
+                            (equal (len args) 3))
+                       (cons (first args)
+                             (app (clause.term-tests (first args))
+                                  (app (clause.term-tests (second args))
+                                       (clause.term-tests (third args)))))
+                     (clause.term-tests-list args))))
+                ((logic.lambdap x)
+                 (clause.term-tests-list (logic.lambda-actuals x)))
+                (t nil)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable clause.term-tests
+                                     clause.term-tests-list
+                                     clause.slow-term-tests))))
+
+ (defthmd definition-of-clause.term-tests-list
+   (equal (clause.term-tests-list x)
+          (if (consp x)
+              (app (clause.term-tests (car x))
+                   (clause.term-tests-list (cdr x)))
+            nil))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable clause.term-tests
+                                     clause.term-tests-list
+                                     clause.slow-term-tests))))
+
+ (defthm clause.flag-term-tests-removal
+   (implies (force (true-listp acc))
+            (equal (clause.flag-term-tests 'term x acc)
+                   (app (clause.term-tests x) acc)))
+   :hints(("Goal" :in-theory (enable clause.term-tests
+                                     clause.slow-term-tests))))
+
+ (defthm clause.flag-term-tests-list-removal
+   (implies (force (true-listp acc))
+            (equal (clause.flag-term-tests 'list x acc)
+                   (app (clause.term-tests-list x) acc)))
+   :hints(("Goal" :in-theory (enable clause.term-tests-list
+                                     clause.slow-term-tests)))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.term-tests))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.term-tests-list))))
+
+(defthm clause.term-tests-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (clause.term-tests x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests))))
+
+(defthm clause.term-tests-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (clause.term-tests x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests))))
+
+(defthm clause.term-tests-when-non-if-logic.functionp
+  (implies (and (not (equal 'if (logic.function-name x)))
+                (logic.functionp x))
+           (equal (clause.term-tests x)
+                  (clause.term-tests-list (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests))))
+
+(defthm clause.term-tests-when-bad-args-logic.functionp
+  (implies (and (not (equal 3 (len (logic.function-args x))))
+                (logic.functionp x))
+           (equal (clause.term-tests x)
+                  (clause.term-tests-list (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests))))
+
+(defthm clause.term-tests-when-if-logic.functionp
+  (implies (and (equal 'if (logic.function-name x))
+                (equal 3 (len (logic.function-args x)))
+                (logic.functionp x))
+           (equal (clause.term-tests x)
+                  (cons (first (logic.function-args x))
+                        (app (clause.term-tests (first (logic.function-args x)))
+                             (app (clause.term-tests (second (logic.function-args x)))
+                                  (clause.term-tests (third (logic.function-args x))))))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests))))
+
+(defthm clause.term-tests-when-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (clause.term-tests x)
+                  (clause.term-tests-list (logic.lambda-actuals x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests))))
+
+(defthm clause.term-tests-when-degenerate
+  (implies (and (not (logic.variablep x))
+                (not (logic.constantp x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (clause.term-tests x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests))))
+
+
+
+(defthm clause.term-tests-list-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.term-tests-list x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests-list))))
+
+(defthm clause.term-tests-list-of-cons
+  (equal (clause.term-tests-list (cons a x))
+         (app (clause.term-tests a)
+              (clause.term-tests-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-clause.term-tests-list))))
+
+(defthm clause.term-tests-list-when-len-three
+  (implies (equal (len x) 3)
+           (equal (clause.term-tests-list x)
+                  (app (clause.term-tests (first x))
+                       (app (clause.term-tests (second x))
+                            (clause.term-tests (third x)))))))
+
+
+
+(defthms-flag
+  :thms ((term clause.term-tests-when-clause.simple-termp
+               (implies (clause.simple-termp x)
+                        (equal (clause.term-tests x)
+                               nil)))
+         (t clause.term-tests-list-when-clause.simple-term-listp
+            (implies (clause.simple-term-listp x)
+                     (equal (clause.term-tests-list x)
+                            nil))))
+  :hints(("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term forcing-logic.term-listp-of-clause.term-tests
+               (implies (force (logic.termp x))
+                        (equal (logic.term-listp (clause.term-tests x))
+                               t)))
+         (t forcing-logic.term-listp-of-clause.term-tests-list
+            (implies (force (logic.term-listp x))
+                     (equal (logic.term-listp (clause.term-tests-list x))
+                            t))))
+  :hints(("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term forcing-logic.term-list-atblp-of-clause.term-tests
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)))
+                        (equal (logic.term-list-atblp (clause.term-tests x) atbl)
+                               t)))
+         (t forcing-logic.term-list-atblp-of-clause.term-tests-list
+            (implies (force (and (logic.term-listp x)
+                                 (logic.term-list-atblp x atbl)))
+                     (equal (logic.term-list-atblp (clause.term-tests-list x) atbl)
+                            t))))
+  :hints(("Goal" :induct (clause.simple-term-induction flag x))))
+
+
+
+
+;; (clause.simple-tests x)
+;;
+;; Construct the set of simple tests for x:
+;;
+;;   { a : a is simple, (if a b c) is a subterm of x }
+
+(defund clause.flag-simple-tests (flag x acc)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (true-listp acc))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) acc)
+            ((logic.variablep x) acc)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (and (equal name 'if)
+                        (equal (len args) 3)
+                        (clause.simple-termp (first args)))
+                   (cons (first args)
+                         (clause.flag-simple-tests 'term (second args)
+                          (clause.flag-simple-tests 'term (third args) acc)))
+                 (clause.flag-simple-tests 'list args acc))))
+            ((logic.lambdap x)
+             (clause.flag-simple-tests 'list (logic.lambda-actuals x) acc))
+            (t acc))
+    (if (consp x)
+        (clause.flag-simple-tests 'term (car x)
+         (clause.flag-simple-tests 'list (cdr x) acc))
+      acc)))
+
+(definlined clause.simple-tests (x)
+  (declare (xargs :guard (logic.termp x)
+                  :verify-guards nil))
+  (clause.flag-simple-tests 'term x nil))
+
+(definlined clause.simple-tests-list (x)
+  (declare (xargs :guard (logic.term-listp x)
+                  :verify-guards nil))
+  (clause.flag-simple-tests 'list x nil))
+
+(defun clause.slow-simple-tests (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (and (equal flag 'list)
+                                (logic.term-listp x)))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) nil)
+            ((logic.variablep x) nil)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (and (equal name 'if)
+                        (equal (len args) 3)
+                        (clause.simple-termp (first args)))
+                   (cons (first args)
+                         (app (clause.slow-simple-tests 'term (second args))
+                              (clause.slow-simple-tests 'term (third args))))
+                 (clause.slow-simple-tests 'list args))))
+            ((logic.lambdap x)
+             (clause.slow-simple-tests 'list (logic.lambda-actuals x)))
+            (t nil))
+    (if (consp x)
+        (app (clause.slow-simple-tests 'term (car x))
+             (clause.slow-simple-tests 'list (cdr x)))
+      nil)))
+
+(encapsulate
+ ()
+ (defthmd lemma-1-for-definition-of-clause.simple-tests
+   (equal (true-listp (clause.slow-simple-tests flag x))
+          t)
+   :hints(("Goal"
+           :in-theory (enable clause.slow-simple-tests)
+           :induct (clause.slow-simple-tests flag x))))
+
+ (defthmd lemma-2-for-definition-of-clause.simple-tests
+   (equal (true-listp (clause.flag-simple-tests flag x acc))
+          (true-listp acc))
+   :hints(("Goal"
+           :in-theory (enable clause.flag-simple-tests)
+           :induct (clause.flag-simple-tests flag x acc))))
+
+ (local (in-theory (enable lemma-1-for-definition-of-clause.simple-tests
+                           lemma-2-for-definition-of-clause.simple-tests)))
+
+ (defthmd lemma-3-for-definition-of-clause.simple-tests
+   (implies (true-listp acc)
+            (equal (clause.flag-simple-tests flag x acc)
+                   (app (clause.slow-simple-tests flag x) acc)))
+   :hints(("Goal"
+           :in-theory (enable clause.flag-simple-tests clause.slow-simple-tests)
+           :induct (clause.flag-simple-tests flag x acc))))
+
+ (local (in-theory (enable lemma-3-for-definition-of-clause.simple-tests)))
+
+ (verify-guards clause.flag-simple-tests)
+ (verify-guards clause.simple-tests)
+ (verify-guards clause.simple-tests-list)
+
+ (defthmd definition-of-clause.simple-tests
+   (equal (clause.simple-tests x)
+          (cond ((logic.constantp x) nil)
+                ((logic.variablep x) nil)
+                ((logic.functionp x)
+                 (let ((name (logic.function-name x))
+                       (args (logic.function-args x)))
+                   (if (and (equal name 'if)
+                            (equal (len args) 3)
+                            (clause.simple-termp (first args)))
+                       (cons (first args)
+                             (app (clause.simple-tests (second args))
+                                  (clause.simple-tests (third args))))
+                     (clause.simple-tests-list args))))
+                ((logic.lambdap x)
+                 (clause.simple-tests-list (logic.lambda-actuals x)))
+                (t nil)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable clause.simple-tests
+                                     clause.simple-tests-list
+                                     clause.slow-simple-tests))))
+
+ (defthmd definition-of-clause.simple-tests-list
+   (equal (clause.simple-tests-list x)
+          (if (consp x)
+              (app (clause.simple-tests (car x))
+                   (clause.simple-tests-list (cdr x)))
+            nil))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable clause.simple-tests
+                                     clause.simple-tests-list
+                                     clause.slow-simple-tests))))
+
+ (defthm clause.flag-simple-tests-removal
+   (implies (force (true-listp acc))
+            (equal (clause.flag-simple-tests 'term x acc)
+                   (app (clause.simple-tests x) acc)))
+   :hints(("Goal" :in-theory (enable clause.simple-tests
+                                     clause.slow-simple-tests))))
+
+ (defthm clause.flag-simple-tests-list-removal
+   (implies (force (true-listp acc))
+            (equal (clause.flag-simple-tests 'list x acc)
+                   (app (clause.simple-tests-list x) acc)))
+   :hints(("Goal" :in-theory (enable clause.simple-tests-list
+                                     clause.slow-simple-tests))))
+
+ (local (in-theory (disable clause.flag-simple-tests-removal
+                            clause.flag-simple-tests-list-removal)))
+
+ (defthm clause.slow-simple-tests-removal
+   (equal (clause.slow-simple-tests 'term x)
+          (clause.simple-tests x))
+   :hints(("Goal" :in-theory (enable clause.simple-tests))))
+
+ (defthm clause.slow-simple-tests-removal
+   (equal (clause.slow-simple-tests 'term x)
+          (clause.simple-tests x))
+   :hints(("Goal" :in-theory (enable clause.simple-tests-list)))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.simple-tests))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition clause.simple-tests-list))))
+
+(defthm clause.simple-tests-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (clause.simple-tests x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+(defthm clause.simple-tests-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (clause.simple-tests x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+(defthm clause.simple-tests-when-non-if-logic.functionp
+  (implies (and (logic.functionp x)
+                ;; Was using case-split
+                (not (equal (logic.function-name x) 'if)))
+           (equal (clause.simple-tests x)
+                  (clause.simple-tests-list (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+(defthm clause.simple-tests-when-bad-args-logic.functionp
+  (implies (and (logic.functionp x)
+                ;; Was using case-split
+                (not (equal (len (logic.function-args x)) 3)))
+           (equal (clause.simple-tests x)
+                  (clause.simple-tests-list (logic.function-args x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+
+
+;; (defthm clause.simple-tests-when-not-simple-first
+;;   (implies (and (logic.functionp x)
+;;                 ;; Was using case-split
+;;                 (not (clause.simple-termp (first (logic.function-args x)))))
+;;            (equal (clause.simple-tests x)
+;;                   (clause.simple-tests-list (logic.function-args x))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+;; (defthm clause.simple-tests-when-not-if-logic.functionp-of-simple
+;;   (implies (and (logic.functionp x)
+;;                 (equal (logic.function-name x) 'if)
+;;                 (equal (len (logic.function-args x)) 3)
+;;                 (clause.simple-termp (first (logic.function-args x))))
+;;            (equal (clause.simple-tests x)
+;;                   (cons (first (logic.function-args x))
+;;                         (app (clause.simple-tests (second (logic.function-args x)))
+;;                              (clause.simple-tests (third (logic.function-args x)))))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 1))
+;;   :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+(defthm clause.simple-tests-when-if
+  (implies (and (logic.functionp x)
+                (equal (logic.function-name x) 'if)
+                (equal (len (logic.function-args x)) 3))
+           (equal (clause.simple-tests x)
+                  (if (clause.simple-termp (car (logic.function-args x)))
+                      (cons (first (logic.function-args x))
+                            (app (clause.simple-tests (second (logic.function-args x)))
+                                 (clause.simple-tests (third (logic.function-args x)))))
+                    (clause.simple-tests-list (logic.function-args x)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+(defthm clause.simple-tests-when-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (clause.simple-tests x)
+                  (clause.simple-tests-list (logic.lambda-actuals x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+(defthm clause.simple-tests-when-degenerate
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (clause.simple-tests x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests))))
+
+(defthm clause.simple-tests-list-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.simple-tests-list x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests-list))))
+
+(defthm clause.simple-tests-list-of-cons
+  (equal (clause.simple-tests-list (cons a x))
+         (app (clause.simple-tests a)
+              (clause.simple-tests-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-clause.simple-tests-list))))
+
+(defthm clause.simple-tests-list-when-len-three
+  (implies (equal (len x) 3)
+           (equal (clause.simple-tests-list x)
+                  (app (clause.simple-tests (first x))
+                       (app (clause.simple-tests (second x))
+                            (clause.simple-tests (third x)))))))
+
+(defthm true-listp-of-clause.simple-tests-list
+  (equal (true-listp (clause.simple-tests-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.simple-tests-list-of-list-fix
+  (equal (clause.simple-tests-list (list-fix x))
+         (clause.simple-tests-list x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.simple-tests-list-of-app
+  (equal (clause.simple-tests-list (app x y))
+         (app (clause.simple-tests-list x)
+              (clause.simple-tests-list y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthms-flag
+  :thms ((term subsetp-of-clause.simple-tests-and-clause.term-tests
+               (equal (subsetp (clause.simple-tests x) (clause.term-tests x))
+                      t))
+         (t subsetp-of-clause.simple-tests-list-and-clause.term-tests-list
+            (equal (subsetp (clause.simple-tests-list x) (clause.term-tests-list x))
+                   t)))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term clause.simple-term-listp-of-clause.simple-tests
+               (equal (clause.simple-term-listp (clause.simple-tests x))
+                      t))
+         (t clause.simple-term-listp-of-clause.simple-tests-list
+            (equal (clause.simple-term-listp (clause.simple-tests-list x))
+                   t)))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term clause.simple-tests-when-clause.simple-termp
+               (implies (clause.simple-termp x)
+                        (equal (clause.simple-tests x)
+                               nil)))
+         (t clause.simple-tests-list-when-clause.simple-term-listp
+            (implies (clause.simple-term-listp x)
+                     (equal (clause.simple-tests-list x)
+                            nil))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term forcing-logic.term-listp-of-clause.simple-tests
+               (implies (force (logic.termp x))
+                        (equal (logic.term-listp (clause.simple-tests x))
+                               t)))
+         (t forcing-logic.term-listp-of-clause.simple-tests-list
+            (implies (force (logic.term-listp x))
+                     (equal (logic.term-listp (clause.simple-tests-list x))
+                            t))))
+  :hints (("Goal" :induct (clause.simple-term-induction flag x))))
+
+(defthms-flag
+  :thms ((term forcing-logic.term-list-atblp-of-clause.simple-tests
+               (implies (force (logic.term-atblp x atbl))
+                        (equal (logic.term-list-atblp (clause.simple-tests x) atbl)
+                               t)))
+         (t forcing-logic.term-list-atblp-of-clause.simple-tests-list
+            (implies (force (logic.term-list-atblp x atbl))
+                     (equal (logic.term-list-atblp (clause.simple-tests-list x) atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (clause.simple-term-induction flag x)
+           :in-theory (disable forcing-true-listp-of-logic.function-args))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/if-lifting/unlifted-subterms.lisp acl2-6.3/books/milawa/ACL2/clauses/if-lifting/unlifted-subterms.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/if-lifting/unlifted-subterms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/if-lifting/unlifted-subterms.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,230 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "lifted-termp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund clause.unlifted-subterms (x)
+  (declare (xargs :guard (logic.termp x)))
+  (cond ((logic.constantp x) nil)
+        ((logic.variablep x) nil)
+        ((logic.functionp x)
+         (let ((name (logic.function-name x))
+               (args (logic.function-args x)))
+           (if (and (equal name 'if)
+                    (equal (len args) 3))
+               (app (clause.unlifted-subterms (first args))
+                    (app (clause.unlifted-subterms (second args))
+                         (clause.unlifted-subterms (third args))))
+             (if (clause.simple-term-listp args)
+                 nil
+               (list x)))))
+        ((logic.lambdap x)
+         (if (clause.simple-term-listp (logic.lambda-actuals x))
+             nil
+           (list x)))
+        (t nil)))
+
+(defthm consp-of-clause.unlifted-subterms
+  (equal (consp (clause.unlifted-subterms x))
+         (if (clause.unlifted-subterms x)
+             t
+           nil))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (clause.unlifted-subterms x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (clause.unlifted-subterms x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-when-non-if-logic.functionp
+  (implies (and (not (equal 'if (logic.function-name x)))
+                (logic.functionp x))
+           (equal (clause.unlifted-subterms x)
+                  (if (clause.simple-termp x)
+                      nil
+                    (list x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-when-bad-args-logic.functionp
+  (implies (and (not (equal 3 (len (logic.function-args x))))
+                (logic.functionp x))
+           (equal (clause.unlifted-subterms x)
+                  (if (clause.simple-termp x)
+                      nil
+                    (list x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-when-if-logic.functionp
+  (implies (and (equal 'if (logic.function-name x))
+                (equal 3 (len (logic.function-args x)))
+                (logic.functionp x))
+           (equal (clause.unlifted-subterms x)
+                  (app (clause.unlifted-subterms (first (logic.function-args x)))
+                       (app (clause.unlifted-subterms (second (logic.function-args x)))
+                            (clause.unlifted-subterms (third (logic.function-args x)))))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-when-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (clause.unlifted-subterms x)
+                  (if (clause.simple-termp x)
+                      nil
+                    (list x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-when-degenerate
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (clause.unlifted-subterms x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm true-listp-of-clause.unlifted-subterms
+  (equal (true-listp (clause.unlifted-subterms x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm forcing-logic.term-listp-of-clause.unlifted-subterms
+  (implies (force (logic.termp x))
+           (logic.term-listp (clause.unlifted-subterms x)))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-when-clause.simple-termp
+  (implies (clause.simple-termp x)
+           (equal (clause.unlifted-subterms x)
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.simple-termp-when-memberp-of-clause.unlifted-subterms
+  (implies (memberp a (clause.unlifted-subterms x))
+           (equal (clause.simple-termp a)
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+(defthm clause.unlifted-subterms-under-iff
+  (iff (clause.unlifted-subterms x)
+       (not (clause.lifted-termp x)))
+  :hints(("Goal" :in-theory (enable clause.lifted-termp))))
+
+(defthm clause.simple-term-listp-of-clause.unlifted-subterms
+  (equal (clause.simple-term-listp (clause.unlifted-subterms x))
+         (clause.lifted-termp x))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms))))
+
+
+
+
+
+(defund clause.unlifted-subterms-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (app (clause.unlifted-subterms (car x))
+           (clause.unlifted-subterms-list (cdr x)))
+    nil))
+
+(defthm clause.unlifted-subterms-list-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.unlifted-subterms-list x)
+                  nil))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms-list))))
+
+(defthm clause.unlifted-subterms-list-of-cons
+  (equal (clause.unlifted-subterms-list (cons a x))
+         (app (clause.unlifted-subterms a)
+              (clause.unlifted-subterms-list x)))
+  :hints(("Goal" :in-theory (enable clause.unlifted-subterms-list))))
+
+(defthm true-listp-of-clause.unlifted-subterms-list
+  (equal (true-listp (clause.unlifted-subterms-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-of-clause.unlifted-subterms-list
+  (equal (consp (clause.unlifted-subterms-list x))
+         (not (clause.lifted-term-listp x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-listp-of-clause.unlifted-subterms-list
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (clause.unlifted-subterms-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.unlifted-subterms-list-of-list-fix
+  (equal (clause.unlifted-subterms-list (list-fix x))
+         (clause.unlifted-subterms-list x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.unlifted-subterms-list-of-app
+  (equal (clause.unlifted-subterms-list (app x y))
+         (app (clause.unlifted-subterms-list x)
+              (clause.unlifted-subterms-list y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.simple-termp-when-memberp-of-clause.unlifted-subterms-list
+  (implies (memberp a (clause.unlifted-subterms-list x))
+           (equal (clause.simple-termp a)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.unlifted-subterms-list-under-iff
+  (iff (clause.unlifted-subterms-list x)
+       (not (clause.lifted-term-listp x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.simple-term-listp-of-clause.unlifted-subterms-list
+  (equal (clause.simple-term-listp (clause.unlifted-subterms-list x))
+         (clause.lifted-term-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/prop.lisp acl2-6.3/books/milawa/ACL2/clauses/prop.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/prop.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/prop.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,162 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../build/prop")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defderiv build.lhs-commute-or-then-rassoc
+  :derive (v B (v A C))
+  :from   ((proof x (v (v A B) C)))
+  :proof  (@derive
+           ((v (v A B) C)   (@given x))
+           ((v C (v A B))   (build.commute-or @-))
+           ((v (v C A) B)   (build.associativity @-))
+           ((v B (v C A))   (build.commute-or @-))
+           ((v B (v A C))   (build.disjoined-commute-or @-))))
+
+(defderiv clause.aux-limsplit-cutoff-step-bldr
+  ;; BOZO i guess this is the same as above.
+  :derive (v P (v A Q))
+  :from ((proof x (v (v A P) Q)))
+  :proof
+  (@derive
+   ((v (v A P) Q)     (@given x))
+   ((v Q (v A P))     (build.commute-or @-))
+   ((v (v Q A) P)     (build.associativity @-))
+   ((v P (v Q A))     (build.commute-or @-))
+   ((v P (v A Q))     (build.disjoined-commute-or @-))))
+
+(defderiv clause.aux-split-default-3-bldr
+  :derive (v (v A P) Q)
+  :from   ((proof x (v P (v A Q))))
+  :proof  (@derive
+           ((v P (v A Q))   (@given x))
+           ((v P (v Q A))   (build.disjoined-commute-or @-))
+           ((v (v P Q) A)   (build.associativity @-))
+           ((v A (v P Q))   (build.commute-or @-))
+           ((v (v A P) Q)   (build.associativity @-))))
+
+(defderiv clause.aux-split-twiddle-lemma-1
+  :derive (v (v (v B C) (v A (v B C))) A)
+  :from   ((proof x (v (v A C) (v B C))))
+  :proof  (@derive
+           ((v (v A C) (v B C))               (@given x))
+           ((v (v B C) (v A C))               (build.commute-or @-))
+           ((v A (v (v B C) (v A C)))         (build.expansion (@formula A) @-))
+           ((v (v A (v B C)) (v A C))         (build.associativity @-))
+           ((v (v (v A (v B C)) A) C)         (build.associativity @-))
+           ((v C (v (v A (v B C)) A))         (build.commute-or @-))
+           ((v B (v C (v (v A (v B C)) A)))   (build.expansion (@formula B) @-))
+           ((v (v B C) (v (v A (v B C)) A))   (build.associativity @-))
+           ((v (v (v B C) (v A (v B C))) A)   (build.associativity @-))))
+
+(defderiv clause.aux-split-twiddle
+  :derive (v A (v B C))
+  :from   ((proof x (v (v A C) (v B C))))
+  :proof  (@derive
+           ((v (v A C) (v B C))               (@given x))
+           ((v (v (v B C) (v A (v B C))) A)   (clause.aux-split-twiddle-lemma-1 @-))
+           ((v A (v (v B C) (v A (v B C))))   (build.commute-or @-))
+           ((v (v A (v B C)) (v A (v B C)))   (build.associativity @-))
+           ((v A (v B C))                     (build.contraction @-))))
+
+(defderiv clause.aux-split-twiddle2-lemma-1a
+  :derive (v A (v B (v C (v P Q))))
+  :from   ((proof x (v Q (v A C)))
+           (formula p P)
+           (formula b B))
+  :proof  (@derive
+           ((v Q (v A C))              (@given x))
+           ((v P (v Q (v A C)))        (build.expansion (@formula P) @-))
+           ((v (v P Q) (v A C))        (build.associativity @-))
+           ((v (v A C) (v P Q))        (build.commute-or @-))
+           ((v A (v C (v P Q)))        (build.right-associativity @-))
+           ((v A (v B (v C (v P Q))))  (build.disjoined-left-expansion @- (@formula B)))))
+
+(defderiv clause.aux-split-twiddle2-lemma-1
+  :derive (v (v (v P Q) (v A B)) C)
+  :from   ((proof x (v Q (v A C)))
+           (formula p P)
+           (formula b B))
+  :proof (@derive
+          ((v Q (v A C))              (@given x))
+          ((v A (v B (v C (v P Q))))  (clause.aux-split-twiddle2-lemma-1a @- (@formula P) (@formula B)))
+          ((v (v A B) (v C (v P Q)))  (build.associativity @-))
+          ((v (v (v A B) C) (v P Q))  (build.associativity @-))
+          ((v (v P Q) (v (v A B) C))  (build.commute-or @-))
+          ((v (v (v P Q) (v A B)) C)  (build.associativity @-))))
+
+(defderiv clause.aux-split-twiddle2-lemma-2a
+  :derive (v A (v B (v (v P Q) C)))
+  :from   ((proof x (v C (v B P)))
+           (formula a A)
+           (formula q Q))
+  :proof  (@derive
+           ((v C (v B P))               (@given x))
+           ((v (v C B) P)               (build.associativity @-))
+           ((v Q (v (v C B) P))         (build.expansion (@formula Q) @-))
+           ((v (v Q (v C B)) P)         (build.associativity @-))
+           ((v P (v Q (v C B)))         (build.commute-or @-))
+           ((v (v P Q) (v C B))         (build.associativity @-))
+           ((v (v (v P Q) C) B)         (build.associativity @-))
+           ((v B (v (v P Q) C))         (build.commute-or @-))
+           ((v A (v B (v (v P Q) C)))   (build.expansion (@formula A) @-))))
+
+(defderiv clause.aux-split-twiddle2-lemma-2
+  :derive (v C (v (v P Q) (v A B)))
+  :from   ((proof x (v C (v B P)))
+           (formula a A)
+           (formula q Q))
+  :proof  (@derive
+           ((v C (v B P))               (@given x))
+           ((v A (v B (v (v P Q) C)))   (clause.aux-split-twiddle2-lemma-2a @- (@formula A) (@formula Q)))
+           ((v (v A B) (v (v P Q) C))   (build.associativity @-))
+           ((v (v (v A B) (v P Q)) C)   (build.associativity @-))
+           ((v C (v (v A B) (v P Q)))   (build.commute-or @-))
+           ((v C (v (v P Q) (v A B)))   (build.disjoined-commute-or @-))))
+
+(defderiv clause.aux-split-twiddle2
+  :derive (v (v P Q) (v A B))
+  :from   ((proof x (v (v A (v B P)) Q)))
+  :proof  (@derive
+           ((v (v A (v B P)) Q)                          (@given x))
+           ((v Q (v A (v B P)))                          (build.commute-or @-))
+           ((v (v (v P Q) (v A B)) (v B P))              (clause.aux-split-twiddle2-lemma-1 @- (@formula P) (@formula B)))
+           ((v (v (v P Q) (v A B)) (v (v P Q) (v A B)))  (clause.aux-split-twiddle2-lemma-2 @- (@formula A) (@formula Q)))
+           ((v (v P Q) (v A B))                          (build.contraction @-))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/smart-negate.lisp acl2-6.3/books/milawa/ACL2/clauses/smart-negate.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/smart-negate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/smart-negate.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,80 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund clause.smart-negate (x)
+  (declare (xargs :guard (logic.termp x)))
+  (if (clause.negative-termp x)
+      (clause.negative-term-guts x)
+    (logic.function 'not (list x))))
+
+(defthm forcing-logic.termp-of-clause.smart-negate
+  (implies (force (logic.termp x))
+           (equal (logic.termp (clause.smart-negate x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.smart-negate))))
+
+(defthm forcing-logic.term-atblp-of-clause.smart-negate
+  (implies (force (and (logic.termp x)
+                       (logic.term-atblp x atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-atblp (clause.smart-negate x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.smart-negate))))
+
+
+(defprojection :list (clause.smart-negate-list x)
+               :element (clause.smart-negate x)
+               :guard (logic.term-listp x))
+
+(defthm forcing-logic.term-listp-of-clause.smart-negate-list
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (clause.smart-negate-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-clause.smart-negate-list
+  (implies (force (and (logic.term-listp x)
+                       (logic.term-list-atblp x atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-list-atblp (clause.smart-negate-list x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/split-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/split-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/split-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/split-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,358 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "split")
+(include-book "aux-split-bldr")
+(include-book "aux-limsplit-bldr")
+(include-book "update-clause-bldr")
+(include-book "if-lifting/lift-bldr")
+(include-book "if-lifting/limlift-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund clause.split-bldr (liftp liftlimit splitlimit x proofs)
+  ;; Suppose x is a clause and we have proofs of all the clauses x splits
+  ;; into.  Then, build a proof of x.
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (true-listp x)
+                              (consp x)
+                              (natp liftlimit)
+                              (natp splitlimit)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (cdr (clause.split liftp liftlimit splitlimit x)))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((lifted-clause     (if liftp
+                                (if (equal liftlimit 0)
+                                    (clause.fast-lift-term-list$ x nil)
+                                  (clause.fast-limlift-term-list$ x liftlimit nil))
+                              x))
+         (split-clauses     (if (equal splitlimit 0)
+                                (clause.simple-split lifted-clause)
+                              (clause.simple-limsplit lifted-clause splitlimit)))
+         (clean-proofs      (clause.clean-clauses-bldr split-clauses proofs))
+         (split-proof       (if (equal splitlimit 0)
+                                (clause.simple-split-bldr lifted-clause clean-proofs)
+                              (clause.simple-limsplit-bldr lifted-clause clean-proofs splitlimit))))
+    (if liftp
+        (let* ((lit-proofs   (if (equal liftlimit 0)
+                                 (clause.fast-lift-term-list-bldr$ x nil)
+                               (clause.fast-limlift-term-list-bldr$ x liftlimit nil)))
+               (update-proof (clause.update-clause-bldr lifted-clause split-proof lit-proofs))
+               (rev-proof    (build.rev-disjunction (logic.fast-term-list-formulas$ x nil) update-proof)))
+          (ACL2::prog2$
+           (ACL2::cw! ";; Split step: ~s0~|"
+                      (STR::ncat "Inputs " (unbounded-rank proofs) "; "
+                                "Unclean " (- (unbounded-rank clean-proofs) (unbounded-rank proofs)) "; "
+                                "Unsplit " (- (unbounded-rank split-proof) (unbounded-rank clean-proofs)) "; "
+                                "Unlift " (unbounded-rank lit-proofs) "; "
+                                "Update " (- (unbounded-rank update-proof)
+                                             (ACL2::+ (unbounded-rank split-proof) (unbounded-rank lit-proofs))) "; "
+                                "Rev " (- (unbounded-rank rev-proof) (unbounded-rank update-proof)) "; "
+                                "Outputs " (unbounded-rank rev-proof) "."))
+           rev-proof))
+      (ACL2::prog2$
+       (ACL2::cw! ";; Split step: ~s0~|"
+                  (STR::ncat "Inputs " (unbounded-rank proofs) "; "
+                            "Unclean " (- (unbounded-rank clean-proofs) (unbounded-rank proofs)) "; "
+                            "Unsplit " (- (unbounded-rank split-proof) (unbounded-rank clean-proofs)) "; "
+                            "Outputs " (unbounded-rank split-proof) "."))
+       split-proof))))
+
+(defobligations clause.split-bldr
+  (clause.lift-term-list-bldr
+   clause.limlift-term-list-bldr
+   clause.simple-split-bldr
+   clause.simple-limsplit-bldr
+   clause.update-clause-bldr
+   clause.clean-clauses-bldr
+   build.rev-disjunction))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.split clause.split-bldr)))
+
+ (verify-guards clause.split-bldr)
+
+ (defthm forcing-logic.appealp-of-clause.split-bldr
+   (implies (force (and (logic.term-listp x)
+                        (true-listp x)
+                        (consp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (cdr (clause.split liftp liftlimit splitlimit x)))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appealp (clause.split-bldr liftp liftlimit splitlimit x proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.split-bldr
+   (implies (force (and (logic.term-listp x)
+                        (true-listp x)
+                        (consp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (cdr (clause.split liftp liftlimit splitlimit x)))
+                               (logic.strip-conclusions proofs))
+                        ))
+            (equal (logic.conclusion (clause.split-bldr liftp liftlimit splitlimit x proofs))
+                   (clause.clause-formula x))))
+
+ (defthm@ forcing-logic.proofp-of-clause.split-bldr
+   (implies (force (and (logic.term-listp x)
+                        (true-listp x)
+                        (consp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (cdr (clause.split liftp liftlimit splitlimit x)))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations clause.split-bldr)))
+            (equal (logic.proofp (clause.split-bldr liftp liftlimit splitlimit x proofs) axioms thms atbl)
+                   t))))
+
+
+
+(deflist logic.appeal-list-listp (x)
+  ;; BOZO find me a home
+  (logic.appeal-listp x)
+  :elementp-of-nil t)
+
+(defprojection
+  ;; BOZO find me a home
+  :list (logic.strip-conclusions-list x)
+  :element (logic.strip-conclusions x)
+  :guard (logic.appeal-list-listp x)
+  :nil-preservingp t)
+
+(encapsulate
+ ()
+ ;; BOZO find me a home
+ (local (in-theory (disable redefinition-of-clause.clause-list-formulas)))
+ (defprojection
+   :list (clause.clause-list-list-formulas x)
+   :element (clause.clause-list-formulas x)
+   :guard (and (logic.term-list-list-listp x)
+               (cons-list-listp x))
+   :nil-preservingp t))
+
+(deflist logic.proof-list-listp (x axioms thms atbl)
+  ;; BOZO find me a home
+  (logic.proof-listp x axioms thms atbl)
+  :guard (and (logic.appeal-list-listp x)
+              (logic.formula-listp axioms)
+              (logic.formula-listp thms)
+              (logic.arity-tablep atbl))
+  :elementp-of-nil t)
+
+(defund clause.split-list-bldr (liftp liftlimit splitlimit x proofs)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (true-list-listp x)
+                              (cons-listp x)
+                              (natp liftlimit)
+                              (natp splitlimit)
+                              (logic.appeal-list-listp proofs)
+                              (equal (clause.clause-list-list-formulas (cdr (clause.split-list liftp liftlimit splitlimit x)))
+                                     (logic.strip-conclusions-list proofs)))))
+  (if (consp x)
+      (cons (ACL2::prog2$ (ACL2::cw "; Building proof of clause #~x0.~%" (fast-len x 0))
+                          (clause.split-bldr liftp liftlimit splitlimit (car x) (car proofs)))
+            (clause.split-list-bldr liftp liftlimit splitlimit (cdr x) (cdr proofs)))
+    nil))
+
+(defobligations clause.split-list-bldr
+  (clause.split-bldr))
+
+(defthm forcing-logic.appeal-listp-of-clause.split-list-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (true-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-list-listp proofs)
+                        (equal (clause.clause-list-list-formulas (cdr (clause.split-list liftp liftlimit splitlimit x)))
+                               (logic.strip-conclusions-list proofs))
+                        ))
+            (equal (logic.appeal-listp (clause.split-list-bldr liftp liftlimit splitlimit x proofs))
+                   t))
+   :hints(("Goal" :in-theory (enable clause.split-list clause.split-list-bldr))))
+
+(defthm forcing-logic.strip-conclusions-of-clause.split-list-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (true-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-list-listp proofs)
+                        (equal (clause.clause-list-list-formulas (cdr (clause.split-list liftp liftlimit splitlimit x)))
+                               (logic.strip-conclusions-list proofs))
+                        ))
+            (equal (logic.strip-conclusions (clause.split-list-bldr liftp liftlimit splitlimit x proofs))
+                   (clause.clause-list-formulas x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal"  :in-theory (enable clause.split-list clause.split-list-bldr))))
+
+(defthm@ forcing-logic.proof-listp-of-clause.split-list-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (true-list-listp x)
+                        (cons-listp x)
+                        (logic.appeal-list-listp proofs)
+                        (equal (clause.clause-list-list-formulas (cdr (clause.split-list liftp liftlimit splitlimit x)))
+                               (logic.strip-conclusions-list proofs))
+                        ;; ---
+                        (logic.term-list-list-atblp x atbl)
+                        (logic.proof-list-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations clause.split-list-bldr)
+                        ))
+            (equal (logic.proof-listp (clause.split-list-bldr liftp liftlimit splitlimit x proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable clause.split-list clause.split-list-bldr))))
+
+
+
+
+(defund clause.split-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.split-bldr)
+         (tuplep 4 extras)
+         (let ((liftp      (first extras))
+               (liftlimit  (second extras))
+               (splitlimit (third extras))
+               (clause     (fourth extras)))
+           (and (natp liftlimit)
+                (natp splitlimit)
+                (logic.term-listp clause)
+                (logic.term-list-atblp clause atbl)
+                (true-listp clause)
+                (consp clause)
+                (equal conclusion (clause.clause-formula clause))
+                (equal (clause.clause-list-formulas (cdr (clause.split liftp liftlimit splitlimit clause)))
+                       (logic.strip-conclusions subproofs)))))))
+
+(defund clause.split-bldr-high (liftp liftlimit splitlimit x proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (true-listp x)
+                              (consp x)
+                              (natp liftlimit)
+                              (natp splitlimit)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (cdr (clause.split liftp liftlimit splitlimit x)))
+                                     (logic.strip-conclusions proofs)))))
+  (logic.appeal 'clause.split-bldr
+                (clause.clause-formula x)
+                (list-fix proofs)
+                (list liftp liftlimit splitlimit x)))
+
+(defobligations clause.split-bldr-okp
+  (clause.split-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.split-bldr-okp)))
+
+ (defthm booleanp-of-clause.split-bldr-okp
+   (equal (booleanp (clause.split-bldr-okp x atbl))
+          t))
+
+ (defthm clause.split-bldr-okp-of-logic.appeal-identity
+   (equal (clause.split-bldr-okp (logic.appeal-identity x) atbl)
+          (clause.split-bldr-okp x atbl)))
+
+ (defthmd lemma-1-for-soundness-of-clause.split-bldr-okp
+   (implies (and (clause.split-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (clause.split-bldr (first (logic.extras x))
+                                       (second (logic.extras x))
+                                       (third (logic.extras x))
+                                       (fourth (logic.extras x))
+                                       (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                    axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.split-bldr-okp
+   (implies (and (clause.split-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.split-bldr-okp)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'if atbl)) 3))
+            (equal (logic.proofp
+                    (clause.split-bldr (first (logic.extras x))
+                                       (second (logic.extras x))
+                                       (third (logic.extras x))
+                                       (fourth (logic.extras x))
+                                       (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                    axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.split-bldr-okp
+   (implies (and (clause.split-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.split-bldr-okp)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.split-bldr-okp
+                               lemma-2-for-soundness-of-clause.split-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.split-bldr (first (logic.extras x))
+                                                   (second (logic.extras x))
+                                                   (third (logic.extras x))
+                                                   (fourth (logic.extras x))
+                                                   (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                                axioms thms atbl)))))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/split.lisp acl2-6.3/books/milawa/ACL2/clauses/split.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/split.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/split.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,387 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "aux-split")
+(include-book "aux-limsplit")
+(include-book "if-lifting/lift")
+(include-book "if-lifting/limlift")
+(include-book "clean-clauses")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; BOZO move this stuff to clean-clauses
+
+(defthm true-listp-of-clause.clean-clauses
+  (equal (true-listp (clause.clean-clauses x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.clean-clauses))))
+
+(defthm forcing-logic.term-list-list-atblp-of-remove-supersets1
+  (implies (force (and (logic.term-list-list-atblp x atbl)
+                       (logic.term-list-list-atblp acc atbl)))
+           (equal (logic.term-list-list-atblp (remove-supersets1 x acc) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+(defthm forcing-logic.term-list-list-atblp-of-remove-supersets
+  (implies (force (logic.term-list-list-atblp x atbl))
+           (equal (logic.term-list-list-atblp (remove-supersets x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable remove-supersets))))
+
+(defthm forcing-logic.term-list-list-atblp-of-remove-duplicates-list
+  (implies (force (logic.term-list-list-atblp x atbl))
+           (equal (logic.term-list-list-atblp (remove-duplicates-list x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atblp-of-clause.remove-absurd-terms-from-clauses
+  (implies (force (logic.term-list-list-atblp x atbl))
+           (equal (logic.term-list-list-atblp (clause.remove-absurd-terms-from-clauses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-list-atblp-of-third-of-clause.clean-clauses
+  (implies (force (and (logic.term-list-listp x)
+                       (logic.term-list-list-atblp x atbl)
+                       (equal 1 (cdr (lookup 'not atbl)))))
+           (equal (logic.term-list-list-atblp (third (clause.clean-clauses x)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.clean-clauses disabled-equal))))
+
+
+
+
+
+(defthm forcing-clause.simple-term-list-listp-of-remove-supersets1
+  (implies (force (and (clause.simple-term-list-listp x)
+                       (clause.simple-term-list-listp acc)))
+           (equal (clause.simple-term-list-listp (remove-supersets1 x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+(defthm forcing-clause.simple-term-list-listp-of-remove-supersets
+  (implies (force (clause.simple-term-list-listp x))
+           (equal (clause.simple-term-list-listp (remove-supersets x))
+                  t))
+  :hints(("Goal" :in-theory (enable remove-supersets))))
+
+(defthm forcing-clause.simple-term-list-listp-of-remove-duplicates-list
+  (implies (force (clause.simple-term-list-listp x))
+           (equal (clause.simple-term-list-listp (remove-duplicates-list x))
+                  t))
+  :hints(("Goal" :in-theory (enable remove-duplicates-list))))
+
+(defthm forcing-clause.simple-term-list-listp-of-clause.remove-absurd-terms-from-clauses
+  (implies (force (clause.simple-term-list-listp x))
+           (equal (clause.simple-term-list-listp (clause.remove-absurd-terms-from-clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-clause.simple-term-list-listp-of-clause.remove-complement-clauses
+  (implies (force (clause.simple-term-list-listp x))
+           (equal (clause.simple-term-list-listp (clause.remove-complement-clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-clause.simple-term-list-listp-of-clause.remove-obvious-clauses
+  (implies (force (clause.simple-term-list-listp x))
+           (equal (clause.simple-term-list-listp (clause.remove-obvious-clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-clause.simple-termp-of-clause.negative-term-guts
+  (implies (force (and (clause.simple-termp x)
+                       (clause.negative-termp x)
+                       (logic.termp x)))
+           (equal (clause.simple-termp (clause.negative-term-guts x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.negative-termp
+                                    clause.negative-term-guts))))
+
+(defthm forcing-clause.simple-termp-of-clause.normalize-nots-term
+  (implies (force (and (clause.simple-termp x)
+                       (logic.termp x)))
+           (equal (clause.simple-termp (clause.normalize-nots-term x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.normalize-nots-term))))
+
+(defthm forcing-clause.simple-term-listp-of-clause.normalize-nots-term-list
+  (implies (force (and (clause.simple-term-listp x)
+                       (logic.term-listp x)))
+           (equal (clause.simple-term-listp (clause.normalize-nots-term-list x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.normalize-nots-term-list))))
+
+(defthm forcing-clause.simple-term-list-listp-of-clause.normalize-nots-clauses
+  (implies (force (and (clause.simple-term-list-listp x)
+                       (logic.term-list-listp x)))
+           (equal (clause.simple-term-list-listp (clause.normalize-nots-clauses x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.normalize-nots-clauses))))
+
+(defthm clause.simple-term-list-listp-of-third-of-clause.clean-clauses
+  (implies (force (and (clause.simple-term-list-listp x)
+                       (logic.term-list-listp x)))
+           (equal (clause.simple-term-list-listp (third (clause.clean-clauses x)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.clean-clauses))))
+
+
+
+
+(defund clause.split (liftp liftlimit splitlimit x)
+  ;; Clause Splitting.
+  ;;
+  ;; Clause splitting is a fundamental reduction which splits up a single goal
+  ;; clause into several, simpler clauses based on its if-expressions.  Proving
+  ;; all of these simpler clauses is sufficient to show that the original clause
+  ;; was true.
+  ;;
+  ;; Clause splitting is implemented in three phases:
+  ;;
+  ;;   1.  A "lifting" pass is used to transform literals in the clause such as
+  ;;       (foo (if a b c)) into the form (if (foo a) (foo b) (foo c)).
+  ;;
+  ;;   2.  A "splitting" pass is then used to split the clause into subclauses,
+  ;;       based on the top-level tests of its literals.
+  ;;
+  ;;   3.  A "cleanup" pass finally eliminates any obvious and redundant
+  ;;       subclauses, eliminates useless literals, normalizes nots, and the
+  ;;       like.
+  ;;
+  ;; We return a pair of the form (progressp . new-clauses).
+  ;;
+  ;; Controlling Splitting.
+  ;;
+  ;; The lifting/splitting passes are occasionally too aggressive and can result
+  ;; in excessive numbers of clauses being created.  This is especially apparent
+  ;; during the early stages of bootstrapping, when proof sizes are at a premium.
+  ;; To address this, the liftp, liftlimit, and splitlimit options can be used.
+  ;;
+  ;; Liftp is a boolean flag which can be set to nil in order to completely
+  ;; stop any if-lifting from occurring.  This can result in fewer top-level
+  ;; if-expressions, which means fewer literals being split.
+  ;;
+  ;; Alternately, when liftp is enabled, a liftlimit can be imposed to reduce
+  ;; the number of if-expressions which will be percolated up through other
+  ;; function calls, which again has the effect of reducing the number of
+  ;; top-level ifs that will be generated.  Use 0 to indicate "no limit", or
+  ;; any positive number to impose a limit.
+  ;;
+  ;; Finally, the splitlimit can be used to stop the splitting pass early,
+  ;; before it has had a chance to process all of the top-level tests.  As with
+  ;; the liftlimit, you can use 0 to indicate "no limit", or any positive
+  ;; number to impose a limit.
+  ;;
+  ;; Despite all these features, a nice theorem about clause splitting is the
+  ;; following: when unlimited lifting and splitting are allowed, the splitting
+  ;; process is "complete."  That is, the resulting clauses will not have any
+  ;; if-expressions anywhere within them.
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (true-listp x)
+                              (consp x)
+                              (natp liftlimit)
+                              (natp splitlimit))))
+  (let* ((lifted-clause     (if liftp
+                                (if (equal liftlimit 0)
+                                    (clause.fast-lift-term-list$ x nil)
+                                  (clause.fast-limlift-term-list$ x liftlimit nil))
+                              x))
+         (split-clauses     (if (equal splitlimit 0)
+                                (clause.simple-split lifted-clause)
+                              (clause.simple-limsplit lifted-clause splitlimit)))
+         (clean-tuple       (clause.fast-clean-clauses split-clauses))
+         (clean-unprovablep (first clean-tuple))
+         (clean-progressp   (second clean-tuple))
+         (clean-clauses     (third clean-tuple))
+         (progressp         (or ;; We are happy as long as there has been any kind of progress.
+                                ;; It's particularly easy to check for cleaning progress.
+                                clean-progressp
+
+                                ;; If splitting made no progress, it returns (list (rev lifted-clause)).
+                                ;; The below check is the same as
+                                ;;   (not (equal split-clauses) (list (rev lifted-clause)))
+                                ;;
+                                ;; But we just optimize for some common cases.  First, if 0 or 2+ clauses
+                                ;; have been returned, clearly some progress has been made.  Also, if the
+                                ;; returned clause is not the same length, then again we have progress.
+                                (not split-clauses)
+                                (consp (cdr split-clauses))
+                                (not (same-lengthp (car split-clauses) lifted-clause))
+                                (not (equal split-clauses (list (fast-rev lifted-clause))))
+
+                                ;; Finally, lifting might have made progress without causing splits.
+                                ;; For example, (foo (if a b b)) becomes (foo b) when lifted.  If there
+                                ;; has been no progress, then the lifted-clause will be the same as
+                                ;; (rev x).  We check this below.
+
+                                (and liftp
+                                     (or (not (same-lengthp lifted-clause x))
+                                         (not (equal lifted-clause (fast-rev x))))))))
+    (ACL2::prog2$
+     ;; As a convenience, we print a warning if an unprovable clause is discovered.
+     ;; But this really doesn't bother us -- who cares if the user can't prove the
+     ;; subgoal.  That's his or her problem.  It doesn't affect our soundness.
+     (if clean-unprovablep
+         (ACL2::cw ";; Unprovable clause discovered in clause.split: ~%~x0~%" (fast-rev lifted-clause))
+       nil)
+     (cons progressp clean-clauses))))
+
+(defthm true-listp-of-clause.split
+  (implies (force (and (logic.term-listp x)
+                       (true-listp x)))
+           (equal (true-listp (clause.split liftp liftlimit splitlimit x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.split))))
+
+(defthm forcing-logic.term-list-listp-of-cdr-of-clause.split
+  (implies (force (and (logic.term-listp x)
+                       (true-listp x)))
+           (equal (logic.term-list-listp (cdr (clause.split liftp liftlimit splitlimit x)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.split))))
+
+(defthm forcing-logic.term-list-list-atblp-of-cdr-of-clause.split
+  (implies (force (and (logic.term-listp x)
+                       (logic.term-list-atblp x atbl)
+                       (true-listp x)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-list-atblp (cdr (clause.split liftp limitlimit splitlimit x)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable clause.split))))
+
+(defthm forcing-cons-listp-of-cdr-of-clause.split
+  (implies (force (and (consp x)
+                       (true-listp x)
+                       (logic.term-listp x)))
+           (equal (cons-listp (cdr (clause.split liftp liftlimit splitlimit x)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.split))))
+
+(defthm forcing-clause.simple-term-list-listp-of-cdr-of-clause.split-of-clause.lift-clause
+  ;; This is the claim that splitting is complete.
+  (implies (force (and (logic.term-listp x)
+                       (clause.lifted-term-listp x)))
+           (equal (clause.simple-term-list-listp (cdr (clause.split t 0 0 x)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.split))))
+
+
+
+
+(defund clause.split-list (liftp liftlimit splitlimit x)
+  ;; We are given a list of clauses, x, to try to split.  We return a pair,
+  ;; (progressp . new-clauses), where progressp is set if any of the clauses
+  ;; can be split, and new-clauses are a list of clause lists.
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (true-list-listp x)
+                              (cons-listp x)
+                              (natp liftlimit)
+                              (natp splitlimit))))
+  (if (consp x)
+      (ACL2::prog2$ (ACL2::cw "; Splitting clause ~x0.~%" (fast-len x 0))
+                    (let ((split-car (clause.split liftp liftlimit splitlimit (car x)))
+                          (split-cdr (clause.split-list liftp liftlimit splitlimit (cdr x))))
+                      (cons (or (car split-car)
+                                (car split-cdr))
+                            (cons (cdr split-car)
+                                  (cdr split-cdr)))))
+    (cons nil nil)))
+
+(defthm true-listp-of-cdr-of-clause.split-list
+  (equal (true-listp (cdr (clause.split-list liftp liftlimit splitlimit x)))
+         t)
+  :hints(("Goal" :in-theory (enable clause.split-list))))
+
+(defthm clause.split-list-when-not-consp
+  (implies (not (consp x))
+           (equal (clause.split-list liftp liftlimit splitlimit x)
+                  (cons nil nil)))
+  :hints(("Goal" :in-theory (enable clause.split-list))))
+
+(defthm clause.split-list-of-cons
+  (equal (clause.split-list liftp liftlimit splitlimit (cons a x))
+         (cons (or (car (clause.split liftp liftlimit splitlimit a))
+                   (car (clause.split-list liftp liftlimit splitlimit x)))
+               (cons (cdr (clause.split liftp liftlimit splitlimit a))
+                     (cdr (clause.split-list liftp liftlimit splitlimit x)))))
+  :hints(("Goal" :in-theory (enable clause.split-list))))
+
+(deflist logic.term-list-list-listp (x)
+  ;; BOZO find me a home
+  (logic.term-list-listp x)
+  :elementp-of-nil t)
+
+(deflist logic.term-list-list-list-atblp (x atbl)
+  ;; BOZO find me a home
+  (logic.term-list-list-atblp x atbl)
+  :guard (and (logic.term-list-list-listp x)
+              (logic.arity-tablep atbl))
+  :elementp-of-nil t)
+
+(defthm forcing-logic.term-list-list-listp-of-cdr-of-clause.split-list
+  (implies (force (and (logic.term-list-listp x)
+                       (true-list-listp x)))
+           (equal (logic.term-list-list-listp (cdr (clause.split-list liftp liftlimit splitlimit x)))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-list-atblp-of-cdr-of-clause.split-list
+  (implies (force (and (logic.term-list-listp x)
+                       (logic.term-list-list-atblp x atbl)
+                       (true-list-listp x)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.term-list-list-list-atblp (cdr (clause.split-list liftp liftlimit splitlimit x)) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(deflist cons-list-listp (x)
+  ;; BOZO find me a home
+  (cons-listp x)
+  :elementp-of-nil t)
+
+(defthm forcing-cons-list-listp-of-cdr-of-clause.split-list
+  (implies (force (and (cons-listp x)
+                       (true-list-listp x)
+                       (logic.term-list-listp x)))
+           (equal (cons-list-listp (cdr (clause.split-list liftp liftlimit splitlimit x)))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/update-clause-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/update-clause-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/update-clause-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/update-clause-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,554 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic")
+(include-book "../build/pequal")
+(include-book "../build/disjoined-subset")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+;; We introduce (clause.update-clause-bldr x proof t-proofs).
+;;
+;;   T1' v ... v Tn'            (clause x, proven in proof)
+;;   T1 = T1'
+;;   ...                        (proofs from t-proofs)
+;;   Tn = Tn'
+;; --------------------------------------------------------
+;;   T1 v ... v Tn
+;;
+;; Our goal is to prove T1 v ... v Tn.  (Or, if you prefer, our goal is to
+;; prove T1 != nil v ... v Tn != nil, where x is actually T1' != nil v ...  Tn'
+;; != nil.
+;;
+;; We could have just used equal-consequence-bldr for this, giving it the goal
+;; clause [t1 = nil, t2 != nil, ...], proof, and t-proofs as inputs.  But our
+;; customized builder seems to produce proofs which are smaller by over 3
+;; orders of magnitude better; see the tests at the end of this file.
+
+
+
+
+
+;; The core of our routine is a tail recursive builder which is similar to the
+;; build.revappend-disjunction.  Our auxilliary builder reverses the list in
+;; the process, so this has to be repaired with build.rev-disjunction
+;; afterwards.
+;;
+;; Instead of accumulating "to the back", we accumulated "to the front" because
+;; this looked like it would make smaller proofs.  The specification for our
+;; auxilliary builder is the following:
+;;
+;;      (D1 v ... v Dm) v (T1' v ... v Tn')
+;;      T1.term = T1'.term
+;;      ...
+;;      Tn.term = TN'.term
+;;   -------------------------------------------
+;;      Tn v ... v T1 v D1 v ... v Dm
+;;
+;; Here we think of D1..m as the "done" literals which don't need to be
+;; processed anymore, and T1' ... Tn' as the "todo" literals which we still
+;; need to process.  At each step, our task is to process T1' by replacing it
+;; with T1 and moving it to the front of the done list.
+
+(defderiv clause.aux-update-clause-lemma1-bldr
+  :derive (v (!= (? a) nil) P)
+  :from   ((proof x (v P (!= (? b) nil)))
+           (proof y (= (? a) (? b))))
+  :proof  (@derive
+           ((= (? a) (? b))                  (@given y))
+           ((v P (= (? a) (? b)))            (build.expansion (@formula P) @-))
+           ((v P (!= (? b) nil))             (@given x))
+           ((v P (!= (? a) nil))             (build.disjoined-substitute-into-not-pequal @- @--))
+           ((v (!= (? a) nil) P)             (build.commute-or @-))))
+
+(defderiv clause.aux-update-clause-lemma2-bldr
+  :derive (v (v (!= (? a) nil) P) Q)
+  :from   ((proof x (v P (v (!= (? b) nil) Q)))
+           (proof y (= (? a) (? b))))
+  :proof  (@derive
+           ((v P (v (!= (? b) nil) Q))       (@given x))
+           ((v (v P (!= (? b) nil)) Q)       (build.associativity @-))
+           ((v Q (v P (!= (? b) nil)))       (build.commute-or @-))
+           ((v (v Q P) (!= (? b) nil))       (build.associativity @-))
+           ((= (? a) (? b))                  (@given y))
+           ((v (!= (? a) nil) (v Q P))       (clause.aux-update-clause-lemma1-bldr @-- @-))
+           ((v (!= (? a) nil) (v P Q))       (build.disjoined-commute-or @-))
+           ((v (v (!= (? a) nil) P) Q)       (build.associativity @-))))
+
+
+(defund@ clause.aux-update-clause-bldr (todo done t-proofs proof)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (or (consp todo) (consp done))
+                              (logic.appealp proof)
+                              (logic.appeal-listp t-proofs)
+                              (equal (logic.conclusion proof)
+                                     (cond ((and (consp done) (consp todo))
+                                            (logic.por (clause.clause-formula done)
+                                                       (clause.clause-formula todo)))
+                                           ((consp done)
+                                            (clause.clause-formula done))
+                                           (t
+                                            (clause.clause-formula todo))))
+                              (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                              (equal (logic.=rhses (logic.strip-conclusions t-proofs)) todo))
+                  :verify-guards nil))
+  (if (consp todo)
+      (let ((new-term (logic.=lhs (logic.conclusion (car t-proofs)))))
+        (if (consp (cdr todo))
+            (if (consp done)
+                (clause.aux-update-clause-bldr (cdr todo)
+                                              (cons new-term done)
+                                              (cdr t-proofs)
+                                              ;; D1..m v (T1' != nil v T2..n')
+                                              ;; T1 = T1'
+                                              ;; ----------------------------------
+                                              ;; (T1 != nil v D1..m) v T2..n'
+                                              (clause.aux-update-clause-lemma2-bldr proof (car t-proofs)))
+              (clause.aux-update-clause-bldr (cdr todo)
+                                             (cons new-term done)
+                                             (cdr t-proofs)
+                                             ;; T1' != nil v T2..n'
+                                             ;; T1 = T1'
+                                             ;; ------------------------
+                                             ;; T1 != nil v T2..n'
+                                             (clause.aux-update-clause-lemma1-bldr (build.commute-or proof) (car t-proofs))))
+          (if (consp done)
+              ;; D1..m v T1' != nil
+              ;; T1 = T1'
+              ;; -----------------------
+              ;; T1 != nil v D1..m
+              (clause.aux-update-clause-lemma1-bldr proof (car t-proofs))
+            ;; T1' != nil
+            ;; T1 = T1'
+            ;; ------------------
+            ;; T1' != nil
+            (build.substitute-into-not-pequal proof (car t-proofs)))))
+    ;; Degenerate case.
+    (logic.appeal-identity proof)))
+
+
+
+
+
+
+
+
+
+
+(defund clause.aux-update-clause-bldr (todo done t-proofs proof)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (or (consp todo) (consp done))
+                              (logic.appealp proof)
+                              (logic.appeal-listp t-proofs)
+                              (equal (logic.conclusion proof)
+                                     (cond ((and (consp done) (consp todo))
+                                            (logic.por (clause.clause-formula done)
+                                                       (clause.clause-formula todo)))
+                                           ((consp done)
+                                            (clause.clause-formula done))
+                                           (t
+                                            (clause.clause-formula todo))))
+                              (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                              (equal (logic.=rhses (logic.strip-conclusions t-proofs)) todo))
+                  :verify-guards nil))
+  (if (consp todo)
+      (let ((new-term (logic.=lhs (logic.conclusion (car t-proofs)))))
+        (if (consp (cdr todo))
+            (if (consp done)
+                (clause.aux-update-clause-bldr (cdr todo)
+                                              (cons new-term done)
+                                              (cdr t-proofs)
+                                              ;; D1..m v (T1' != nil v T2..n')
+                                              ;; T1 = T1'
+                                              ;; ----------------------------------
+                                              ;; (T1 != nil v D1..m) v T2..n'
+                                              (clause.aux-update-clause-lemma2-bldr proof (car t-proofs)))
+              (clause.aux-update-clause-bldr (cdr todo)
+                                            (cons new-term done)
+                                            (cdr t-proofs)
+                                            ;; T1' != nil v T2..n'
+                                            ;; T1 = T1'
+                                            ;; ------------------------
+                                            ;; T1 != nil v T2..n'
+                                            (clause.aux-update-clause-lemma1-bldr (build.commute-or proof) (car t-proofs))))
+          (if (consp done)
+              ;; D1..m v T1' != nil
+              ;; T1 = T1'
+              ;; -----------------------
+              ;; T1 != nil v D1..m
+              (clause.aux-update-clause-lemma1-bldr proof (car t-proofs))
+            ;; T1' != nil
+            ;; T1 = T1'
+            ;; ------------------
+            ;; T1' != nil
+            (build.substitute-into-not-pequal proof (car t-proofs)))))
+    ;; Degenerate case.
+    (logic.appeal-identity proof)))
+
+(defobligations clause.aux-update-clause-bldr
+  (clause.aux-update-clause-lemma1-bldr
+   clause.aux-update-clause-lemma2-bldr
+   build.substitute-into-not-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-update-clause-bldr logic.term-formula)))
+
+ (defthm clause.aux-update-clause-bldr-under-iff
+   (iff (clause.aux-update-clause-bldr todo done t-proofs proof)
+        t))
+
+ (local (defthm lemma
+          (implies (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por (clause.clause-formula done)
+                                                 (clause.clause-formula todo)))
+                                     ((consp done)
+                                      (clause.clause-formula done))
+                                     (t
+                                      (clause.clause-formula todo))))
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (equal (logic.=rhses (logic.strip-conclusions t-proofs)) todo))
+                   (and (logic.appealp (clause.aux-update-clause-bldr todo done t-proofs proof))
+                        (equal (logic.conclusion (clause.aux-update-clause-bldr todo done t-proofs proof))
+                               (clause.clause-formula (app (rev (logic.=lhses (logic.strip-conclusions t-proofs)))
+                                                           done)))))
+          :hints(("Goal"
+                  :induct (clause.aux-update-clause-bldr todo done t-proofs proof)))))
+
+ (defthm forcing-logic.appealp-of-clause.aux-update-clause-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por (clause.clause-formula done)
+                                                 (clause.clause-formula todo)))
+                                     ((consp done)
+                                      (clause.clause-formula done))
+                                     (t
+                                      (clause.clause-formula todo))))
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (equal (logic.=rhses (logic.strip-conclusions t-proofs)) todo)))
+            (equal (logic.appealp (clause.aux-update-clause-bldr todo done t-proofs proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-update-clause-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por (clause.clause-formula done)
+                                                 (clause.clause-formula todo)))
+                                     ((consp done)
+                                      (clause.clause-formula done))
+                                     (t
+                                      (clause.clause-formula todo))))
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (equal (logic.=rhses (logic.strip-conclusions t-proofs)) todo)))
+            (equal (logic.conclusion (clause.aux-update-clause-bldr todo done t-proofs proof))
+                   (clause.clause-formula (app (rev (logic.=lhses (logic.strip-conclusions t-proofs)))
+                                               done))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-update-clause-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por (clause.clause-formula done)
+                                                 (clause.clause-formula todo)))
+                                     ((consp done)
+                                      (clause.clause-formula done))
+                                     (t
+                                      (clause.clause-formula todo))))
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (equal (logic.=rhses (logic.strip-conclusions t-proofs)) todo)
+                        ;; ---
+                        (force (logic.term-list-atblp todo atbl))
+                        (force (logic.term-list-atblp done atbl))
+                        (force (logic.proofp proof axioms thms atbl))
+                        (force (logic.proof-listp t-proofs axioms thms atbl))
+                        (@obligations clause.aux-update-clause-bldr)))
+            (equal (logic.proofp (clause.aux-update-clause-bldr todo done t-proofs proof) axioms thms atbl)
+                   t))
+   :hints(("Goal" :induct (clause.aux-update-clause-bldr todo done t-proofs proof))))
+
+ (verify-guards clause.aux-update-clause-bldr))
+
+
+
+
+(defund clause.update-clause-bldr (x proof t-proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x)
+                              (logic.appealp proof)
+                              (logic.appeal-listp t-proofs)
+                              (equal (logic.conclusion proof) (clause.clause-formula x))
+                              (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                              (equal (logic.=rhses (logic.strip-conclusions t-proofs)) x))))
+  (let ((lhses (logic.=lhses-of-strip-conclusions t-proofs)))
+    (if (equal lhses x)
+        ;; Important optimization!  If nothing has changed, just reuse the input proof.
+        (logic.appeal-identity proof)
+      (build.rev-disjunction
+       (logic.fast-term-list-formulas$ lhses nil)
+       (clause.aux-update-clause-bldr x nil t-proofs proof)))))
+
+(defobligations clause.update-clause-bldr
+  (clause.aux-update-clause-bldr
+   build.rev-disjunction))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.update-clause-bldr)))
+
+ (defthm clause.update-clause-bldr-under-iff
+   (iff (clause.update-clause-bldr x proof t-proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-clause.update-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof) (clause.clause-formula x))
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (equal (logic.=rhses (logic.strip-conclusions t-proofs)) x)))
+            (equal (logic.appealp (clause.update-clause-bldr x proof t-proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.update-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof) (clause.clause-formula x))
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (equal (logic.=rhses (logic.strip-conclusions t-proofs)) x)))
+            (equal (logic.conclusion (clause.update-clause-bldr x proof t-proofs))
+                   (clause.clause-formula (logic.=lhses (logic.strip-conclusions t-proofs))))))
+
+ (defthm@ forcing-logic.proofp-of-clause.update-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (logic.appealp proof)
+                        (logic.appeal-listp t-proofs)
+                        (equal (logic.conclusion proof) (clause.clause-formula x))
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (equal (logic.=rhses (logic.strip-conclusions t-proofs)) x)
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (logic.proof-listp t-proofs axioms thms atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations clause.update-clause-bldr)))
+            (equal (logic.proofp (clause.update-clause-bldr x proof t-proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+;; Here's how clause.update-clause compares against the generic equal-consequence
+;; builder.
+;;
+;;    n    equal-consequence   clause.update-clause   savings
+;;   -------------------------------------------------------------
+;;     1          1,165,951            312            99.97%
+;;     2          4,187,075          2,419            99.94%
+;;     3         17,511,319          7,127            99.96%
+;;     4         66,176,366         14,215            99.98%
+;;     5        209,545,630         23,683            99.99%
+;;   ------------------------------------------------------------
+;;
+;; This table was generated by commenting out the appropriate parts of this test code:
+;;
+;; (include-book "clausep")
+;; (include-book "../classic/equal-substitution")
+;;
+;; (let* ((goal-clause (list 'T1
+;;                           'T2
+;;                           'T3
+;;                           'T4
+;;                           'T5
+;;                           ))
+;;        (t-proofs (list
+;;                   (build.axiom (logic.pequal 'T1 'T1-Prime))
+;;                   (build.axiom (logic.pequal 'T2 'T2-Prime))
+;;                   (build.axiom (logic.pequal 'T3 'T3-Prime))
+;;                   (build.axiom (logic.pequal 'T4 'T4-Prime))
+;;                   (build.axiom (logic.pequal 'T5 'T5-Prime))
+;;                   ))
+;;        (orig-clause   (logic.=rhses (logic.strip-conclusions t-proofs)))
+;;        (input-proof   (build.axiom (clause.clause-formula orig-clause)))
+;;        (classic-proof (equal-consequence-bldr (clause.clause-formula goal-clause) input-proof t-proofs))
+;;        (new-proof     (clause.update-clause-bldr orig-clause input-proof t-proofs))
+;;        )
+;;   (list (list 'input-proof  (logic.conclusion input-proof))
+;;         (list 't-proofs     (logic.strip-conclusions t-proofs))
+;;         (list 'classic-rank (rank classic-proof))
+;;         (list 'classic-conc (logic.conclusion classic-proof))
+;;         (list 'new-rank     (rank new-proof))
+;;         (list 'new-conc     (logic.conclusion new-proof))
+;;         (list 'ok           (equal (logic.conclusion classic-proof)
+;;                                    (logic.conclusion new-proof))))
+;;         )
+
+
+
+
+(defund clause.update-clause-bldr-okp (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.update-clause-bldr)
+         ;; In the builder's parlance, we want to build from a term list, proof, and t-proofs.
+         ;; The term list is exactly the same as the rhses of the strip-conclusions of t-proofs,
+         ;; so we take it from there directly.
+         (not extras)
+         (consp subproofs)
+         (let ((proof    (car subproofs))
+               (t-proofs (cdr subproofs)))
+           (and (consp t-proofs)
+                (logic.all-atomicp-of-strip-conclusions t-proofs)
+                (equal conclusion (clause.clause-formula (logic.=lhses-of-strip-conclusions t-proofs)))
+                (equal (logic.conclusion proof)
+                       (clause.clause-formula (logic.=rhses-of-strip-conclusions t-proofs))))))))
+
+(defund clause.update-clause-bldr-high (x proof t-proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x)
+                              (logic.appealp proof)
+                              (logic.appeal-listp t-proofs)
+                              (equal (logic.conclusion proof) (clause.clause-formula x))
+                              (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                              (equal (logic.=rhses (logic.strip-conclusions t-proofs)) x)))
+           (ignore x))
+  (logic.appeal 'clause.update-clause-bldr
+                (clause.clause-formula (logic.=lhses-of-strip-conclusions t-proofs))
+                (cons proof (list-fix t-proofs))
+                nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.update-clause-bldr-okp)))
+
+ (defthm booleanp-of-clause.update-clause-bldr-okp
+   (equal (booleanp (clause.update-clause-bldr-okp x))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm clause.update-clause-bldr-okp-of-logic.appeal-identity
+   (equal (clause.update-clause-bldr-okp (logic.appeal-identity x))
+          (clause.update-clause-bldr-okp x))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthmd lemma-1-for-soundness-of-clause.update-clause-bldr-okp
+   (implies (and (clause.update-clause-bldr-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion (clause.update-clause-bldr
+                                      (logic.=rhses
+                                       (logic.strip-conclusions
+                                        (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                     axioms thms atbl)))
+                                      (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                      (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                   axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.update-clause-bldr-okp
+   (implies (and (clause.update-clause-bldr-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.update-clause-bldr))
+            (equal (logic.proofp (clause.update-clause-bldr
+                                  (logic.=rhses
+                                   (logic.strip-conclusions
+                                    (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                 axioms thms atbl)))
+                                  (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                  (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                               axioms thms atbl))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.update-clause-bldr-okp
+   (implies (and (clause.update-clause-bldr-okp x)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.update-clause-bldr))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.update-clause-bldr-okp
+                               lemma-2-for-soundness-of-clause.update-clause-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.update-clause-bldr
+                                 (logic.=rhses
+                                  (logic.strip-conclusions
+                                   (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                axioms thms atbl)))
+                                 (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                 (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                              axioms thms atbl)))))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/clauses/update-clause-iff-bldr.lisp acl2-6.3/books/milawa/ACL2/clauses/update-clause-iff-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/clauses/update-clause-iff-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/clauses/update-clause-iff-bldr.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,599 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-bldrs")
+(include-book "../build/iff")
+(include-book "../build/disjoined-subset")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; We now introduce clause.update-clause-iff-bldr, which is almost the same as
+;; clause.update-clause-bldr.  Here, instead of taking proofs that ti = ti', we
+;; take proofs that (iff ti ti') = t.  This allows us to rewrite each literal
+;; under iff, and then use those results to create a new clause.  This is also
+;; relatively cheap.
+
+;; (defderiv clause.aux-update-clause-iff-lemma-0-bldr
+;;   :derive (!= (? a) nil)
+;;   :from   ((proof x (!= (? b) nil))
+;;            (proof y (= (iff (? a) (? b)) t)))
+;;   :proof  (@derive
+;;            ((!= (? b) nil)              (@given x))
+;;            ((= (iff (? b) t) t)         (build.iff-t-from-not-pequal-nil @-))
+;;            ((= (iff (? a) (? b)) t)     (@given y))
+;;            ((= (iff (? a) t) t)         (build.transitivity-of-iff @- @--))
+;;            ((!= (iff (? a) t) nil)      (build.not-nil-from-t @-))
+;;            ((!= (? a) nil)              (build.not-pequal-nil-from-iff-t @-))))
+
+(defderiv clause.aux-update-clause-iff-lemma1-bldr
+  :derive (v (!= (? a) nil) P)
+  :from   ((proof x (v P (!= (? b) nil)))
+           (proof y (= (iff (? a) (? b)) t)))
+  :proof  (@derive
+           ((= (iff (? a) (? b)) t)          (@given y))
+           ((v P (= (iff (? a) (? b)) t))    (build.expansion (@formula P) @-))
+           ((v P (!= (? b) nil))             (@given x))
+           ((v P (!= (? a) nil))             (clause.disjoined-substitute-iff-into-literal-bldr @- @--))
+           ((v (!= (? a) nil) P)             (build.commute-or @-))))
+
+;;   :proof  (@derive
+;;            ((= (iff (? a) (? b)) t)          (@given y))
+;;            ((v P (= (iff (? a) (? b)) t))    (build.expansion (@formula P) @-)   *1)
+;;            ((v P (!= (? b) nil))             (@given x))
+;;            ((v P (= (iff (? b) t) t))        (build.disjoined-iff-t-from-not-pequal-nil @-))
+;;            ((v P (= (iff (? a) t) t))        (build.disjoined-transitivity-of-iff *1 @-))
+;;            ((v P (!= (iff (? a) t) nil))     (build.disjoined-not-nil-from-t @-))
+;;            ((v P (!= (? a) nil))             (build.disjoined-not-pequal-nil-from-iff-t @-))
+;;            ((v (!= (? a) nil) P)             (build.commute-or @-))))
+
+(defderiv clause.aux-update-clause-iff-lemma2-bldr
+  :derive (v (v (!= (? a) nil) P) Q)
+  :from   ((proof x (v P (v (!= (? b) nil) Q)))
+           (proof y (= (iff (? a) (? b)) t)))
+  :proof  (@derive
+           ((v P (v (!= (? b) nil) Q))       (@given x))
+           ((v (v P (!= (? b) nil)) Q)       (build.associativity @-))
+           ((v Q (v P (!= (? b) nil)))       (build.commute-or @-))
+           ((v (v Q P) (!= (? b) nil))       (build.associativity @-)       *1)
+           ((= (? a) (? b))                  (@given y))
+           ((v (!= (? a) nil) (v Q P))       (clause.aux-update-clause-iff-lemma1-bldr @-- @-))
+           ((v (!= (? a) nil) (v P Q))       (build.disjoined-commute-or @-))
+           ((v (v (!= (? a) nil) P) Q)       (build.associativity @-))))
+
+
+(defund clause.aux-update-clause-iff-bldr (todo done t-proofs proof)
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (or (consp todo) (consp done))
+                              ;; (D1 v ... v Dm) v (L1' v ... v Ln')
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (cond ((and (consp done)
+                                                 (consp todo))
+                                            (logic.por (clause.clause-formula done)
+                                                       (clause.clause-formula todo)))
+                                           ((consp done)
+                                            (clause.clause-formula done))
+                                           (t
+                                            (clause.clause-formula todo))))
+                              ;; (iff L1 L1') = t, ..., (iff Ln Ln') = t
+                              (logic.appeal-listp t-proofs)
+                              (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                              (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                              (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                              (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs))))
+                                     todo))
+                  :verify-guards nil))
+  (if (consp todo)
+      (let ((new-term (first (logic.function-args (logic.=lhs (logic.conclusion (car t-proofs)))))))
+        (if (consp (cdr todo))
+            (if (consp done)
+                (clause.aux-update-clause-iff-bldr (cdr todo)
+                                                  (cons new-term done)
+                                                  (cdr t-proofs)
+                                                  ;; D1..m v (L1' != nil v L2..n')
+                                                  ;; (iff L1 L1') = t
+                                                  ;; ----------------------------------
+                                                  ;; (L1 != nil v D1..m) v L2..n
+                                                  (clause.aux-update-clause-iff-lemma2-bldr proof (car t-proofs)))
+              (clause.aux-update-clause-iff-bldr (cdr todo)
+                                                (cons new-term done)
+                                                (cdr t-proofs)
+                                                ;; L1' != nil v L2..n'
+                                                ;; (iff L1 L1') = t
+                                                ;; --------------------------
+                                                ;; L1 != nil v L2..n'
+                                                (clause.aux-update-clause-iff-lemma1-bldr (build.commute-or proof) (car t-proofs))))
+          (if (consp done)
+              (clause.aux-update-clause-iff-bldr (cdr todo)
+                                                (cons new-term done)
+                                                (cdr t-proofs)
+                                                ;; D1..m v L1' != nil
+                                                ;; (iff L1 L1') = t
+                                                ;; --------------------------
+                                                ;; L1 != nil v D1..m
+                                                (clause.aux-update-clause-iff-lemma1-bldr proof (car t-proofs)))
+            ;; L1' != nil
+            ;; (iff L1 L1') = t
+            ;; --------------------------
+            ;; L1 != nil
+            (clause.substitute-iff-into-literal-bldr proof (car t-proofs)))))
+    ;; Degenerate case.
+    (logic.appeal-identity proof)))
+
+(defobligations clause.aux-update-clause-iff-bldr
+  (clause.aux-update-clause-iff-lemma2-bldr
+   clause.aux-update-clause-iff-lemma1-bldr
+   ;; BOZO this isn't needed
+   clause.aux-update-clause-iff-lemma0-bldr))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.aux-update-clause-iff-bldr logic.term-formula)))
+
+ (defthm clause.aux-update-clause-iff-bldr-under-iff
+   (iff (clause.aux-update-clause-iff-bldr todo done t-proofs proof)
+        t))
+
+ (local (defthm crock
+          ;; Ugh what an ugly pit
+          (implies (and (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        (force (and (logic.appeal-listp x)
+                                    (logic.all-atomicp (logic.strip-conclusions x))
+                                    (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x))))))
+                   (equal (consp (cdr (logic.function-args (logic.=lhs (logic.conclusion (car x))))))
+                          (consp x)))))
+
+ (local (defthm lemma
+          (implies (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por (clause.clause-formula done) (clause.clause-formula todo)))
+                                     ((consp done)
+                                      (clause.clause-formula done))
+                                     (t
+                                      (clause.clause-formula todo))))
+                        (logic.appeal-listp t-proofs)
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                        (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) todo))
+                   (and (logic.appealp (clause.aux-update-clause-iff-bldr todo done t-proofs proof))
+                        (equal (logic.conclusion (clause.aux-update-clause-iff-bldr todo done t-proofs proof))
+                               (clause.clause-formula
+                                (app (rev (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                                     done)))))
+          :hints(("Goal" :induct (clause.aux-update-clause-iff-bldr todo done t-proofs proof)))))
+
+ (defthm forcing-logic.appealp-of-clause.aux-update-clause-iff-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por (clause.clause-formula done) (clause.clause-formula todo)))
+                                     ((consp done)
+                                      (clause.clause-formula done))
+                                     (t
+                                      (clause.clause-formula todo))))
+                        (logic.appeal-listp t-proofs)
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                        (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) todo)))
+            (equal (logic.appealp (clause.aux-update-clause-iff-bldr todo done t-proofs proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.aux-update-clause-iff-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por (clause.clause-formula done) (clause.clause-formula todo)))
+                                     ((consp done)
+                                      (clause.clause-formula done))
+                                     (t
+                                      (clause.clause-formula todo))))
+                        (logic.appeal-listp t-proofs)
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                        (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) todo)))
+            (equal (logic.conclusion (clause.aux-update-clause-iff-bldr todo done t-proofs proof))
+                   (clause.clause-formula
+                    (app (rev (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                         done))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.aux-update-clause-iff-bldr
+   (implies (force (and (logic.term-listp todo)
+                        (logic.term-listp done)
+                        (or (consp todo) (consp done))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (cond ((and (consp done) (consp todo))
+                                      (logic.por (clause.clause-formula done) (clause.clause-formula todo)))
+                                     ((consp done)
+                                      (clause.clause-formula done))
+                                     (t
+                                      (clause.clause-formula todo))))
+                        (logic.appeal-listp t-proofs)
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                        (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) todo)
+                        ;; ---
+                        (logic.term-list-atblp todo atbl)
+                        (logic.term-list-atblp done atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (logic.proof-listp t-proofs axioms thms atbl)
+                        (@obligations clause.aux-update-clause-iff-bldr)))
+            (equal (logic.proofp (clause.aux-update-clause-iff-bldr todo done t-proofs proof) axioms thms atbl)
+                   t))
+   :hints(("Goal" :induct (clause.aux-update-clause-iff-bldr todo done t-proofs proof))))
+
+ (verify-guards clause.aux-update-clause-iff-bldr))
+
+
+
+
+
+(local (in-theory (e/d (strip-lens-of-rev)
+                       (rev-of-logic.strip-conclusions
+                        rev-of-logic.=lhses
+                        rev-of-logic.strip-function-args
+                        rev-of-strip-lens))))
+
+(defund clause.update-clause-iff-bldr (x proof t-proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (clause.clause-formula x))
+                              (logic.appeal-listp t-proofs)
+                              (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                              (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                              (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                              (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) x))))
+  (let ((lhses (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs))))))
+    (if (equal lhses x)
+        ;; Important optimization!  If nothing has changed, just reuse the original proof.
+        (logic.appeal-identity proof)
+      (build.rev-disjunction
+       (logic.term-list-formulas (fast-rev lhses))
+       (clause.aux-update-clause-iff-bldr x nil t-proofs proof)))))
+
+(defobligations clause.update-clause-iff-bldr
+  (build.rev-disjunction clause.aux-update-clause-iff-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.update-clause-iff-bldr)))
+
+ (defthm clause.update-clause-iff-bldr-under-iff
+   (iff (clause.update-clause-iff-bldr x proof t-proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-clause.update-clause-iff-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (clause.clause-formula x))
+                        (logic.appeal-listp t-proofs)
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                        (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) x)))
+            (equal (logic.appealp (clause.update-clause-iff-bldr x proof t-proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-clause.update-clause-iff-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (clause.clause-formula x))
+                        (logic.appeal-listp t-proofs)
+                        (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                        (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) x)))
+            (equal (logic.conclusion (clause.update-clause-iff-bldr x proof t-proofs))
+                   (clause.clause-formula (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-clause.update-clause-iff-bldr
+   (implies (force (and (and (logic.term-listp x)
+                             (consp x)
+                             (logic.appealp proof)
+                             (equal (logic.conclusion proof) (clause.clause-formula x))
+                             (logic.appeal-listp t-proofs)
+                             (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                             (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                             (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                             (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                             (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                             (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) x)
+                             ;; ---
+                             (logic.term-list-atblp x atbl)
+                             (logic.proofp proof axioms thms atbl)
+                             (logic.proof-listp t-proofs axioms thms atbl)
+                             (@obligations clause.update-clause-iff-bldr))))
+            (equal (logic.proofp (clause.update-clause-iff-bldr x proof t-proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+;; Rudimentary Size Testing
+;;
+;; Here's how clause.update-clause compares against the generic equal-consequence
+;; builder.
+;;
+;;    n    equal-consequence   clause.update-clause   savings
+;;   -------------------------------------------------------------
+;;     1          1,165,951            312            99.97%
+;;     2          4,187,075          2,419            99.94%
+;;     3         17,511,319          7,127            99.96%
+;;     4         66,176,366         14,215            99.98%
+;;     5        209,545,630         23,683            99.99%
+;;   ------------------------------------------------------------
+;;
+;; This table was generated by commenting out the appropriate parts of this test code:
+;;
+;; (include-book "update-clause-bldr")
+;; (include-book "../classic/equal-substitution")
+;;
+;; (let* ((goal-clause (list 'T1
+;;                           'T2
+;;                           'T3
+;;                           'T4
+;;                           'T5
+;;                           ))
+;;        (t-proofs (list
+;;                   (build.axiom (logic.pequal 'T1 'T1-Prime))
+;;                   (build.axiom (logic.pequal 'T2 'T2-Prime))
+;;                   (build.axiom (logic.pequal 'T3 'T3-Prime))
+;;                   (build.axiom (logic.pequal 'T4 'T4-Prime))
+;;                   (build.axiom (logic.pequal 'T5 'T5-Prime))
+;;                   ))
+;;        (orig-clause   (logic.=rhses (logic.strip-conclusions t-proofs)))
+;;        (input-proof   (build.axiom (clause.clause-formula orig-clause)))
+;;        (classic-proof (equal-consequence-bldr (clause.clause-formula goal-clause) input-proof t-proofs))
+;;        (new-proof     (clause.update-clause-bldr orig-clause input-proof t-proofs))
+;;        )
+;;   (list (list 'input-proof  (logic.conclusion input-proof))
+;;         (list 't-proofs     (logic.strip-conclusions t-proofs))
+;;         (list 'classic-rank (rank classic-proof))
+;;         (list 'classic-conc (logic.conclusion classic-proof))
+;;         (list 'new-rank     (rank new-proof))
+;;         (list 'new-conc     (logic.conclusion new-proof))
+;;         (list 'ok           (equal (logic.conclusion classic-proof)
+;;                                    (logic.conclusion new-proof))))
+;;         )
+;;
+;;
+;; And here's how clause.update-clause-iff compares to clause.update-clause.
+;;
+;;    n    clause.update-clause   clause.update-clause-iff
+;;   ---------------------------------------------------------
+;;     1              313                 1,370
+;;     2            2,419                 9,307
+;;     3            7,127                20,159
+;;     4           14,215                35,191
+;;     5           26,683                54,403
+;;   ---------------------------------------------------------
+;;
+;; This table was generated by commenting out the appropriate parts of this test code:
+;;
+;; (let* ((goal-clause (list 'T1
+;;                           'T2
+;;                           'T3
+;;                           'T4
+;;                           'T5
+;;                           ))
+;;        (t-proofs (list
+;;                   (build.axiom (logic.pequal 'T1 'T1-Prime))
+;;                   (build.axiom (logic.pequal 'T2 'T2-Prime))
+;;                   (build.axiom (logic.pequal 'T3 'T3-Prime))
+;;                   (build.axiom (logic.pequal 'T4 'T4-Prime))
+;;                   (build.axiom (logic.pequal 'T5 'T5-Prime))
+;;                   ))
+;;        (t-proofs-iff (list
+;;                       (build.axiom (logic.pequal '(iff T1 T1-Prime) ''t))
+;;                       (build.axiom (logic.pequal '(iff T2 T2-Prime) ''t))
+;;                       (build.axiom (logic.pequal '(iff T3 T3-Prime) ''t))
+;;                       (build.axiom (logic.pequal '(iff T4 T4-Prime) ''t))
+;;                       (build.axiom (logic.pequal '(iff T5 T5-Prime) ''t))
+;;                       ))
+;;        (orig-clause   (logic.=rhses (logic.strip-conclusions t-proofs)))
+;;        (input-proof   (build.axiom (clause.clause-formula orig-clause)))
+;;        (pequal-proof  (clause.update-clause-bldr orig-clause input-proof t-proofs))
+;;        (iff-proof     (clause.update-clause-iff-bldr orig-clause input-proof t-proofs-iff)))
+;;   (list (list 'input-proof  (logic.conclusion input-proof))
+;;         (list 't-proofs     (logic.strip-conclusions t-proofs))
+;;         (list 't-proofs-iff (logic.strip-conclusions t-proofs-iff))
+;;         (list 'pequal-rank  (rank pequal-proof))
+;;         (list 'iff-rank     (rank iff-proof))
+;;         (list 'pequal-conc  (logic.conclusion pequal-proof))
+;;         (list 'iff-conc     (logic.conclusion iff-proof))
+;;         (list 'pequal-okp   (equal (logic.conclusion pequal-proof) (clause.clause-formula goal-clause)))
+;;         (list 'iff-okp      (equal (logic.conclusion iff-proof) (clause.clause-formula goal-clause)))))
+
+
+
+
+(defund clause.update-clause-iff-bldr-okp (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'clause.update-clause-iff-bldr)
+         (not extras)
+         (consp subproofs)
+         (let ((proof    (car subproofs))
+               (t-proofs (cdr subproofs)))
+           (and (consp t-proofs)
+                (logic.all-atomicp-of-strip-conclusions t-proofs)
+                (logic.all-functionsp (logic.=lhses-of-strip-conclusions t-proofs))
+                (all-equalp 'iff (logic.strip-function-names (logic.=lhses-of-strip-conclusions t-proofs)))
+                (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses-of-strip-conclusions t-proofs))))
+                (all-equalp ''t (logic.=rhses-of-strip-conclusions t-proofs))
+                ;; BOZO efficiency -- we could do a ton with folding/deforestation here
+                (equal conclusion
+                       (clause.clause-formula (strip-firsts (logic.strip-function-args (logic.=lhses-of-strip-conclusions t-proofs)))))
+                (equal (logic.conclusion proof)
+                       (clause.clause-formula (strip-seconds (logic.strip-function-args (logic.=lhses-of-strip-conclusions t-proofs)))))
+                )))))
+
+(defund clause.update-clause-iff-bldr-high (x proof t-proofs)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (clause.clause-formula x))
+                              (logic.appeal-listp t-proofs)
+                              (logic.all-atomicp (logic.strip-conclusions t-proofs))
+                              (all-equalp ''t (logic.=rhses (logic.strip-conclusions t-proofs)))
+                              (logic.all-functionsp (logic.=lhses (logic.strip-conclusions t-proofs)))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions t-proofs))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                              (equal (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))) x)))
+           (ignore x))
+  (logic.appeal 'clause.update-clause-iff-bldr
+                (clause.clause-formula (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions t-proofs)))))
+                (cons proof (list-fix t-proofs))
+                nil))
+
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable clause.update-clause-iff-bldr-okp)))
+
+ (defthm booleanp-of-clause.update-clause-iff-bldr-okp
+   (equal (booleanp (clause.update-clause-iff-bldr-okp x))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm clause.update-clause-iff-bldr-okp-of-logic.appeal-identity
+   (equal (clause.update-clause-iff-bldr-okp (logic.appeal-identity x))
+          (clause.update-clause-iff-bldr-okp x))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthmd lemma-1-for-soundness-of-clause.update-clause-iff-bldr-okp
+   (implies (and (clause.update-clause-iff-bldr-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion (clause.update-clause-iff-bldr
+                                      (strip-seconds
+                                       (logic.strip-function-args
+                                        (logic.=lhses
+                                         (logic.strip-conclusions
+                                          (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                       axioms thms atbl)))))
+                                      (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                      (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                   axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-clause.update-clause-iff-bldr-okp
+   (implies (and (clause.update-clause-iff-bldr-okp x)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations clause.update-clause-iff-bldr))
+            (equal (logic.proofp (clause.update-clause-iff-bldr
+                                  (strip-seconds
+                                   (logic.strip-function-args
+                                    (logic.=lhses
+                                     (logic.strip-conclusions
+                                      (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                   axioms thms atbl)))))
+                                  (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                  (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                               axioms thms atbl))
+                                 axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-clause.update-clause-iff-bldr-okp
+   (implies (and (clause.update-clause-iff-bldr-okp x)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations clause.update-clause-iff-bldr))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-clause.update-clause-iff-bldr-okp
+                               lemma-2-for-soundness-of-clause.update-clause-iff-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (clause.update-clause-iff-bldr
+                                 (strip-seconds
+                                  (logic.strip-function-args
+                                   (logic.=lhses
+                                    (logic.strip-conclusions
+                                     (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                                  axioms thms atbl)))))
+                                 (logic.provable-witness (logic.conclusion (car (logic.subproofs x))) axioms thms atbl)
+                                 (logic.provable-list-witness (logic.strip-conclusions (cdr (logic.subproofs x)))
+                                                              axioms thms atbl)))))))))
diff -Nru acl2-6.2/books/milawa/ACL2/count.lsp acl2-6.3/books/milawa/ACL2/count.lsp
--- acl2-6.2/books/milawa/ACL2/count.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/count.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,148 @@
+; count.lsp
+;
+; I use this script in order to count how many events are in the ACL2 books.
+; This approach, and the function count-events-through, was developed by
+; Peter Dillinger in response to an email I sent to the ACL2 help list, and
+; is presumably in the public domain.
+;
+; Instructions:
+;
+;    ./modified-acl2
+;    (ld "count.lsp")
+;
+; This loads a bunch of books and eventually prints a bunch of statistics.
+; It takes a few minutes to run.
+
+(in-package "ACL2")
+(set-verify-guards-eagerness 2)
+
+; Can't do anything about the ttag notes, but this clears up some output.
+(set-inhibit-output-lst '(error warning warning! observation prove proof-checker event expansion summary proof-tree))
+
+(defun symbol-to-nat-alistp (x)
+  (declare (xargs :guard t))
+ (or (null x)
+     (and (consp x)
+          (consp (car x))
+          (symbolp (caar x))
+          (natp (cdar x))
+          (symbol-to-nat-alistp (cdr x)))))
+
+(defun inc-nat-alist (key alist)
+ (declare (xargs :guard (and (symbolp key)
+                             (symbol-to-nat-alistp alist))))
+ (cond ((endp alist)
+        (list (cons key 1)))
+       ((eq key (caar alist))
+        (cons (cons key (1+ (cdar alist)))
+              (cdr alist)))
+       (t
+        (cons (car alist)
+              (inc-nat-alist key (cdr alist))))))
+
+(defthm symbol-to-nat-alistp--inc-nat-alist
+ (implies (and (symbolp key)
+               (symbol-to-nat-alistp alist))
+          (symbol-to-nat-alistp (inc-nat-alist key alist))))
+
+(defun count-events-through1 (cur-wrld end-wrld alist)
+ (declare (xargs :guard (and (worldp cur-wrld)
+                             (worldp end-wrld)
+                             (symbol-to-nat-alistp alist))))
+ (cond ((or (endp cur-wrld)
+            (equal cur-wrld end-wrld))
+        alist)
+       ((and (eq (first (car cur-wrld)) 'event-landmark)
+             (eq (second (car cur-wrld)) 'global-value)
+             (consp (cddr (car cur-wrld)))
+             (consp (cdddr (car cur-wrld))))
+        (let ((key (cond ((and (consp (fourth (car cur-wrld)))
+                               (symbolp (car (fourth (car cur-wrld)))))
+                          (car (fourth (car cur-wrld))))
+                         ((symbolp (fourth (car cur-wrld)))
+                          (fourth (car cur-wrld)))
+                         (t
+                          'unknown))))
+          (count-events-through1 (cdr cur-wrld)
+                                 end-wrld
+                                 (inc-nat-alist key
+                                                alist))))
+       (t
+        (count-events-through1 (cdr cur-wrld)
+                               end-wrld
+                               alist))))
+
+(defun count-events-through (start-wrld end-wrld)
+ (declare (xargs :guard (and (worldp start-wrld)
+                             (worldp end-wrld))))
+ (count-events-through1 start-wrld end-wrld nil))
+
+; The basic approach is to save the world, then load the "top" book for each
+; directory, and save the world again.  Then we can count the number of events
+; added by each set of includes.
+
+(assign start-wrld (w state))
+
+(include-book "utilities/top" :ttags :all)
+(assign util-wrld (w state))
+
+(include-book "logic/top" :ttags :all)
+(assign logic-wrld (w state))
+
+(include-book "build/top" :ttags :all)
+(assign build-wrld (w state))
+
+; There isn't a top book for clauses, so we just load everything
+(include-book "clauses/split" :ttags :all)
+(include-book "clauses/compiler" :ttags :all)
+(include-book "clauses/clean-clauses" :ttags :all)
+(include-book "clauses/update-clause-iff-bldr" :ttags :all)
+(include-book "clauses/update-clause-bldr" :ttags :all)
+(include-book "clauses/disjoined-update-clause-bldr" :ttags :all)
+(include-book "clauses/smart-negate" :ttags :all)
+(include-book "clauses/split-bldr" :ttags :all)
+(assign clause-wrld (w state))
+
+(include-book "rewrite/assms/top" :ttags :all)
+(assign assms-wrld (w state))
+
+(include-book "rewrite/crewrite-clause" :ttags :all)
+(include-book "rewrite/fast-crewrite-clause" :ttags :all)
+(include-book "rewrite/urewrite-clause" :ttags :all)
+(include-book "rewrite/theory-arities" :ttags :all)
+(include-book "rewrite/traces/trace-arities" :ttags :all)
+(include-book "rewrite/gather" :ttags :all)
+(assign rewrite-wrld (w state))
+
+(include-book "tactics/compiler" :ttags :all)
+(assign tactic-wrld (w state))
+
+(include-book "interface/top" :ttags :all)
+(assign iface-wrld (w state))
+
+
+
+(cw "Utilities directory stats: ~%~x0~%"
+    (count-events-through (@ util-wrld) (@ start-wrld)))
+
+(cw "Logic directory stats: ~%~x0~%"
+    (count-events-through (@ logic-wrld) (@ util-wrld)))
+
+(cw "Build directory stats: ~%~x0~%"
+    (count-events-through (@ build-wrld) (@ logic-wrld)))
+
+(cw "Clauses directory stats: ~%~x0~%"
+    (count-events-through (@ clause-wrld) (@ build-wrld)))
+
+(cw "Assms directory stats: ~%~x0~%"
+    (count-events-through (@ assms-wrld) (@ clause-wrld)))
+
+(cw "Rewrite directory stats: ~%~x0~%"
+    (count-events-through (@ rewrite-wrld) (@ assms-wrld)))
+
+(cw "Tactic directory stats: ~%~x0~%"
+    (count-events-through (@ tactic-wrld) (@ rewrite-wrld)))
+
+(cw "Interface directory stats: ~%~x0~%"
+    (count-events-through (@ iface-wrld) (@ tactic-wrld)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/defderiv/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/defderiv/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/defderiv/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/defderiv/acl2-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/defderiv/cert.acl2 acl2-6.3/books/milawa/ACL2/defderiv/cert.acl2
--- acl2-6.2/books/milawa/ACL2/defderiv/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/defderiv/cert.acl2	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/defderiv/context.lisp acl2-6.3/books/milawa/ACL2/defderiv/context.lisp
--- acl2-6.2/books/milawa/ACL2/defderiv/context.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/defderiv/context.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,997 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../logic/top")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; This file introduces the @context macro, which forms the basis for defun@,
+;; defthm@, deftheorem, and defderiv.  Before looking at the implementation
+;; here, you may wish to browse through some of our basic builders, to see
+;; what this code is used to support.
+
+
+
+
+;; Patterns to describe terms and formulas.
+;;
+;; We can use patterns to concisely describe the shapes of terms and formulas.
+;; The patterns we understand are described by the following tables.
+;;
+;;   term pattern             matches                       bindings
+;; ----------------------------------------------------------------------------
+;;     (? sym)                  any term                      sym bound here
+;;     t, nil                   ''t, ''nil                    none
+;;     0, 1, 2, ...             ''0, ''1, ''2, ...            none
+;;     a quoted constant        exactly that constant         none
+;;     a variable               exactly that variable         none
+;;     (f tpat1 ... tpatN)      a matching call of f          tpat bindings
+;;
+;;   formula pattern          matches                       bindings
+;; ----------------------------------------------------------------------------
+;;     symbol                   any formula                   sym bound here
+;;     (= tpat1 tpat2)          matching equalities           tpat bindings
+;;     (!= tpat1 tpat2)         matching inequalities         tpat bindings
+;;     (! fpat)                 matching negations            fpat bindings
+;;     (v fpat1 fpat2)          matching disjunctions         fpat bindings
+;;
+;; We can also describe sigmas with patterns, using lists of (var . tpat)
+;; pairs.
+
+(mutual-recursion
+ (defun dd.term-patternp (x)
+   (declare (xargs :mode :program))
+   (or (equal x t)
+       (equal x nil)
+       (natp x)
+       (logic.constantp x)
+       (logic.variablep x)
+       (and (consp x)
+            (cond ((equal (first x) '?)
+                   (and (tuplep 2 x)
+                        (logic.variablep (second x))))
+                  (t
+                   (and (logic.function-namep (first x))
+                        (true-listp (cdr x))
+                        (dd.term-pattern-listp (cdr x))))))
+       (ACL2::cw "Warning: invalid dd.term-patternp: ~x0~%" x)))
+ (defun dd.term-pattern-listp (x)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (and (dd.term-patternp (car x))
+            (dd.term-pattern-listp (cdr x)))
+     t)))
+
+(defun dd.formula-patternp (x)
+  (declare (xargs :mode :program))
+  (or (logic.variablep x)
+      (and (consp x)
+           (cond ((equal (first x) '=)
+                  (and (tuplep 3 x)
+                       (dd.term-patternp (second x))
+                       (dd.term-patternp (third x))))
+                 ((equal (first x) '!=)
+                  (and (tuplep 3 x)
+                       (dd.term-patternp (second x))
+                       (dd.term-patternp (third x))))
+                 ((equal (first x) '!)
+                  (and (tuplep 2 x)
+                       (dd.formula-patternp (second x))))
+                 ((equal (first x) 'v)
+                  (and (tuplep 3 x)
+                       (dd.formula-patternp (second x))
+                       (dd.formula-patternp (third x))))
+                 (t nil)))
+      (ACL2::cw "Warning: invalid dd.formula-patternp: ~x0~%" x)))
+
+(defun dd.formula-pattern-listp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (dd.formula-patternp (car x))
+           (dd.formula-pattern-listp (cdr x)))
+    t))
+
+(defun dd.sigma-patternp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (or (and (consp (car x))
+               (logic.variablep (car (car x)))
+               (dd.term-patternp (cdr (car x)))
+               (dd.sigma-patternp (cdr x)))
+          (ACL2::cw "Warning: invalid dd.sigma-patternp entry: ~x0~%" (car x)))
+    t))
+
+
+
+
+;; Matching Lisp objects against patterns.
+;;
+;; When we write a Lisp function or an ACL2 theorem, we often want to know if
+;; some Lisp object matches a pattern.  For example, perhaps we are writing a
+;; function (foo x), and as a guard we want to say that x is a proof whose
+;; conclusion has the form A v B.
+;;
+;; We are going to write some macros which can generate code to perform this
+;; kind of matching.  To our macros, things like x and (logic.conclusion x) are
+;; just s-expressions, i.e., fragments of Lisp syntax that have some semantic
+;; meaning we are ignorant of.  We call these things "paths".  Continuing our
+;; example, the path we are interested in is literally the s-expression
+;; (logic.conclusion x).
+;;
+;; The first issue to address is deciding if our path has the proper structure
+;; as far as its connectives, the names of any functions used within it, and
+;; occurrences of any explicit constants.  Continuing our example, since our
+;; pattern is A v B, we want to check that the fmtype of our path is por*.
+;;
+;; To handle complex patterns, we allow our path to "grow" as we make the
+;; match.  For example, to test PATH against A v (B v C), we first check that
+;; the fmtype of PATH is por*.  Then, for the recursive call, we change our
+;; path to (logic.vrhs PATH), and try to match that against (B v C).
+
+(mutual-recursion
+ (defun dd.term-pattern-structure-tests (path pat)
+   (declare (xargs :mode :program))
+   (cond ((or (equal pat t)
+              (equal pat nil)
+              (natp pat))
+          (list `(equal ,path '',pat)))
+         ((logic.constantp pat)
+          (list `(equal ,path ,pat)))
+         ((logic.variablep pat)
+          (list `(equal ,path ',pat)))
+         ((equal (first pat) '?)
+          nil)
+         (t
+          (app (list `(logic.functionp ,path)
+                     `(equal (logic.function-name ,path) ',(first pat))
+                     `(equal (len (logic.function-args ,path)) ,(len (cdr pat))))
+               (dd.term-pattern-structure-tests-list `(logic.function-args ,path) (cdr pat))))))
+ (defun dd.term-pattern-structure-tests-list (path pat)
+   (declare (xargs :mode :program))
+   (if (consp pat)
+       (app (dd.term-pattern-structure-tests `(car ,path) (car pat))
+            (dd.term-pattern-structure-tests-list `(cdr ,path) (cdr pat)))
+     nil)))
+
+(defun dd.formula-pattern-structure-tests (path pat)
+   (declare (xargs :mode :program))
+   (cond ((symbolp pat)
+          nil)
+         ((equal (first pat) '=)
+          (cons `(equal (logic.fmtype ,path) 'pequal*)
+                (app (dd.term-pattern-structure-tests `(logic.=lhs ,path) (second pat))
+                     (dd.term-pattern-structure-tests `(logic.=rhs ,path) (third pat)))))
+         ((equal (first pat) '!=)
+          (cons `(equal (logic.fmtype ,path) 'pnot*)
+                (cons `(equal (logic.fmtype (logic.~arg ,path)) 'pequal*)
+                      (app (dd.term-pattern-structure-tests `(logic.=lhs (logic.~arg ,path)) (second pat))
+                           (dd.term-pattern-structure-tests `(logic.=rhs (logic.~arg ,path)) (third pat))))))
+         ((equal (first pat) '!)
+          (cons `(equal (logic.fmtype ,path) 'pnot*)
+                (dd.formula-pattern-structure-tests `(logic.~arg ,path) (second pat))))
+         ((equal (first pat) 'v)
+          (cons `(equal (logic.fmtype ,path) 'por*)
+                (app (dd.formula-pattern-structure-tests `(logic.vlhs ,path) (second pat))
+                     (dd.formula-pattern-structure-tests `(logic.vrhs ,path) (third pat)))))
+         (t
+          (ACL2::er hard 'dd.formula-pattern-structure-tests
+                    "Bad formula pattern encountered: ~x0~%" pat))))
+
+
+
+
+;; Context variables and bindings maps.
+;;
+;; Given a pattern like A v B, we say A and B are "context variables."  In
+;; order to properly match patterns with repeated variables (e.g., A v A), we
+;; need to keep track of which parts of the formula are bound to each variable.
+;; To do this, we build a "bindings map" that associates each context variable
+;; with the paths it is bound to.  For example, if PATH is (conclusion x) and
+;; pattern is A v B, we will generate a map that contains these entries:
+;;
+;;    (A . (logic.vlhs (conclusion x)))
+;;    (B . (logic.vrhs (conclusion x)))
+;;
+;; If a variable is used multiple times, it will show up repeatedly in the map,
+;; e.g., matching (conclusion x) against A v A would yield:
+;;
+;;    (A . (logic.vlhs (conclusion x)))
+;;    (A . (logic.vrhs (conclusion x)))
+;;
+;; We can look for duplicate occurrences in order to see which equality tests
+;; we will need to generate, e.g., in the above example we would see that we
+;; need to check:
+;;
+;;    (equal (logic.vlhs (conclusion x)) (logic.vrhs (conclusion x)))
+;;
+;; Since the same variable, A, is bound to each of these.  Since equality is
+;; transitive, we only need n-1 checks for n occurrences of a context variable.
+
+(mutual-recursion
+ (defun dd.term-pattern-path-bindings (path pat)
+   (declare (xargs :mode :program))
+   (cond ((or (equal pat t)
+              (equal pat nil)
+              (natp pat)
+              (logic.constantp pat)
+              (logic.variablep pat))
+          nil)
+         ((equal (first pat) '?)
+          (list (cons (second pat) path)))
+         (t
+          (dd.term-pattern-path-bindings-list `(logic.function-args ,path) (cdr pat)))))
+ (defun dd.term-pattern-path-bindings-list (path pat)
+   (declare (xargs :mode :program))
+   (if (consp pat)
+       (app (dd.term-pattern-path-bindings `(car ,path) (car pat))
+            (dd.term-pattern-path-bindings-list `(cdr ,path) (cdr pat)))
+     nil)))
+
+(defun dd.formula-pattern-path-bindings (path pat)
+  (declare (xargs :mode :program))
+  (cond ((symbolp pat)
+         (list (cons pat path)))
+        ((equal (first pat) '=)
+         (app (dd.term-pattern-path-bindings `(logic.=lhs ,path) (second pat))
+              (dd.term-pattern-path-bindings `(logic.=rhs ,path) (third pat))))
+        ((equal (first pat) '!=)
+         (app (dd.term-pattern-path-bindings `(logic.=lhs (logic.~arg ,path)) (second pat))
+              (dd.term-pattern-path-bindings `(logic.=rhs (logic.~arg ,path)) (third pat))))
+        ((equal (first pat) '!)
+         (dd.formula-pattern-path-bindings `(logic.~arg ,path) (second pat)))
+        ((equal (first pat) 'v)
+         (app (dd.formula-pattern-path-bindings `(logic.vlhs ,path) (second pat))
+              (dd.formula-pattern-path-bindings `(logic.vrhs ,path) (third pat))))
+        (t
+         (ACL2::er hard 'dd.formula-pattern-path-bindings
+                   "Bad formula pattern encountered: ~x0~%" pat))))
+
+(defun dd.path-bindings-to-equalities (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((result (lookup (car (car x)) (cdr x))))
+        (if result
+            (cons `(equal ,(cdr (car x)) ,(cdr result))
+                  (dd.path-bindings-to-equalities (cdr x)))
+          (dd.path-bindings-to-equalities (cdr x))))
+    nil))
+
+
+
+
+;; Constructing objects using patterns.
+;;
+;; After you've matched an object against some pattern, it's quite convenient
+;; to be able to refer to parts of that object via the context variables you
+;; just used.  That is, if you match x against A v B, you'd like to be able to
+;; talk about A and B instead of (logic.vlhs x) and (logic.vrhs x).
+;;
+;; Once we've built the binding map, we can easily choose a representative for
+;; A and B.  In fact, we can do better than this: if you provide a new pattern
+;; that describes an object you'd like to construct in terms of the context
+;; variables you've already matched, we can write the constructor code to
+;; reassemble the object.  E.g., now that you've matched x against A v B, you
+;; can say B v A and we can fill in (logic.por (logic.vrhs x) (logic.vlhs x)).
+
+(mutual-recursion
+ (defun dd.term-from-path-bindings (pat bindings)
+   (declare (xargs :mode :program))
+   (cond ((equal pat t)
+          '''t)
+         ((equal pat nil)
+          '''nil)
+         ((natp pat)
+          (list 'quote (list 'quote pat)))
+         ((logic.constantp pat)
+          (list 'quote pat))
+         ((logic.variablep pat)
+          (list 'quote pat))
+         ((equal (first pat) '?)
+          (let ((entry (lookup (second pat) bindings)))
+            (if (consp entry)
+                (cdr entry)
+              (ACL2::er hard 'dd.term-from-path-bindings
+                        "Pattern mentions ~x0, but this is not bound.~%" pat))))
+         (t
+          `(logic.function ',(car pat)
+                  (list ,@(dd.term-from-path-bindings-list (cdr pat) bindings))))))
+ (defun dd.term-from-path-bindings-list (pat bindings)
+   (declare (xargs :mode :program))
+   (if (consp pat)
+       (cons (dd.term-from-path-bindings (car pat) bindings)
+             (dd.term-from-path-bindings-list (cdr pat) bindings))
+     nil)))
+
+(defun dd.formula-from-path-bindings (pat bindings)
+  (declare (xargs :mode :program))
+  (cond ((symbolp pat)
+         (let ((entry (lookup pat bindings)))
+           (if (consp entry)
+               (cdr entry)
+             (ACL2::er hard 'dd.formula-from-path-bindings
+                       "Pattern mentions ~x0, but this is not bound.~%" pat))))
+        ((equal (first pat) '=)
+         `(logic.pequal ,(dd.term-from-path-bindings (second pat) bindings)
+                  ,(dd.term-from-path-bindings (third pat) bindings)))
+        ((equal (first pat) '!=)
+         `(logic.pnot (logic.pequal ,(dd.term-from-path-bindings (second pat) bindings)
+                        ,(dd.term-from-path-bindings (third pat) bindings))))
+        ((equal (first pat) '!)
+         `(logic.pnot ,(dd.formula-from-path-bindings (second pat) bindings)))
+        ((equal (first pat) 'v)
+         `(logic.por ,(dd.formula-from-path-bindings (second pat) bindings)
+               ,(dd.formula-from-path-bindings (third pat) bindings)))
+        (t
+         (ACL2::er hard 'dd.formula-from-path-bindings
+                   "Bad formula pattern encountered: ~x0~%" pat))))
+
+(defun dd.formula-from-path-bindings-list (pat bindings)
+  (declare (xargs :mode :program))
+  (if (consp pat)
+      (cons (dd.formula-from-path-bindings (car pat) bindings)
+            (dd.formula-from-path-bindings-list (cdr pat) bindings))
+    nil))
+
+(defun dd.sigma-from-path-bindings (x bindings)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (cons `(cons ',(car (car x))
+                   ,(dd.term-from-path-bindings (cdr (car x)) bindings))
+            (dd.sigma-from-path-bindings (cdr x) bindings))
+    nil))
+
+
+
+
+;; Matching lots of patterns at once.
+;;
+;; It's often the case that we'll want to try to pattern match several objects,
+;; and share their variables.  E.g., for modus ponens, we want to match x with
+;; A and y with ~A v B, and we want these A's to relate to one another.
+;;
+;; We introduce "multi patterns" objects to describe a list of matches to be
+;; made.  Each entry in the list is a 3-tuple of the form
+;;
+;;    (type path pattern)
+;;
+;; Where type is either term, formula, proof, or constant.
+;;
+;;   - If type is term or formula, we try to match path against pattern, which
+;;     should be a term or formula pattern, respectively.
+;;
+;;   - If type is proof, we try to match (conclusion path) against the formula
+;;     pattern.  This isn't really needed but it is very convenient.
+;;
+;;   - If type is constant, the path may only be a variable, i.e., (? a), and
+;;     we will require (constantp path).
+
+(defun dd.multi-patternsp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (tuplep 3 (car x))
+           (let ((type (first (car x)))
+                 ;; we ignore path
+                 (pattern (third (car x))))
+             (cond ((equal type 'term)
+                    (dd.term-patternp pattern))
+                   ((equal type 'formula)
+                    (dd.formula-patternp pattern))
+                   ((equal type 'proof)
+                    (dd.formula-patternp pattern))
+                   ((equal type 'constant)
+                    (and (tuplep 2 pattern)
+                         (equal (first pattern) '?)
+                         (logic.variablep (second pattern))))
+                   (t
+                    (ACL2::cw "Warning: invalid type for dd.multi-patternsp: ~x0~%" x))))
+           (dd.multi-patternsp (cdr x)))
+    t))
+
+(defun dd.multi-patterns-structure-tests (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let* ((entry (car x))
+             (type  (first entry))
+             (path  (second entry))
+             (pattern (third entry)))
+        (app (cond ((equal type 'term)
+                    (dd.term-pattern-structure-tests path pattern))
+                   ((equal type 'formula)
+                    (dd.formula-pattern-structure-tests path pattern))
+                   ((equal type 'proof)
+                    (dd.formula-pattern-structure-tests `(logic.conclusion ,path) pattern))
+                   ((equal type 'constant)
+                    (list `(logic.constantp ,path)))
+                   (t
+                    (ACL2::er hard 'dd.multi-patterns-structure-tests
+                              "Bad multipattern entry: ~x0.~%" entry)))
+             (dd.multi-patterns-structure-tests (cdr x))))
+    nil))
+
+(defun dd.multi-patterns-path-bindings (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((type (first (car x)))
+            (path (second (car x)))
+            (pattern (third (car x))))
+        (app (cond ((equal type 'term)
+                    (dd.term-pattern-path-bindings path pattern))
+                   ((equal type 'formula)
+                    (dd.formula-pattern-path-bindings path pattern))
+                   ((equal type 'proof)
+                    (dd.formula-pattern-path-bindings `(logic.conclusion ,path) pattern))
+                   ((equal type 'constant)
+                    (let ((variable (second pattern)))
+                      (list (cons variable path))))
+                   (t
+                    (ACL2::er hard 'dd.multi-patterns-path-bindings
+                              "Bad multipattern entry: ~x0.~%" (car x))))
+             (dd.multi-patterns-path-bindings (cdr x))))
+    nil))
+
+
+
+
+;; Pattern-based derivations.
+;;
+;; We also provide support for writing derivations with patterns.  Each line in
+;; a derivation has the form:
+;;
+;;      (conclusion justification [name])
+;;
+;; Where:
+;;
+;;   - Each conclusion is a formula pattern which describes what this step
+;;     concludes.  Typically this is only used for documentation purpoess.
+;;
+;;   - Each justification explains how to arrive at this conclusion.  It must
+;;     have the form (foo ...), and our documentation tools will mention foo
+;;     when describing this derivation.  As special conveniences,
+;;        * (@given x) can be used to refer to an existing proof.  We write
+;;          this instead of x so that our documentation tools know what is
+;;          given.
+;;        * @- may be used to refer to the proof on the previous line,
+;;        * @-- may be used to refer to the proof on the two-previous line,
+;;        * Previously defined named lines may also be used by writing their
+;;          names.
+;;
+;;   - Names are optional but sometimes necessary so that you can refer back
+;;     to something you proved earlier.  If omitted, a name such as __LINE3__
+;;     will be generated.  I typically use *1, *2, ... for names.
+
+(defun dd.deriv-linep (x)
+  (declare (xargs :mode :program))
+  (or (and (or (tuplep 2 x)
+               (tuplep 3 x))
+           (let ((conclusion    (first x))
+                 (justification (second x))
+                 (name          (third x)))
+             (and (dd.formula-patternp conclusion)
+                  (true-listp justification)
+                  (consp justification)
+                  (logic.function-namep (car justification))
+                  (symbolp name))))
+      (ACL2::cw "Warning: invalid deriv line: ~x0.~%" x)))
+
+(defun dd.deriv-linesp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (dd.deriv-linep (car x))
+           (dd.deriv-linesp (cdr x)))
+    t))
+
+(defun dd.deriv-assign-names (x n)
+  ;; Fill in the names, wherever they have been omitted, with __LINE<N>__
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((conclusion    (first (car x)))
+            (justification (second (car x)))
+            (name          (third (car x))))
+        (if (not name)
+            (cons (list conclusion justification
+                        (ACL2::intern-in-package-of-symbol
+                         (ACL2::concatenate 'ACL2::string "__LINE"
+                                            (ACL2::coerce (ACL2::explode-atom n 10)
+                                                          'ACL2::string) "__")
+                         'proofp))
+                  (dd.deriv-assign-names (cdr x) (+ n 1)))
+          (cons (car x)
+                (dd.deriv-assign-names (cdr x) n))))
+    nil))
+
+(defun dd.deriv-link-subst (just prev1 prev2)
+  ;; "just" is a justification of some line.  We have no idea what it looks
+  ;; like, so we walk throughout it as if it were a tree.  We replace any
+  ;; occurrences of @- and @-- with the names given in prev1 and prev2,
+  ;; respectively.
+  (declare (xargs :mode :program))
+  (cond ((equal just '@-)
+         (or prev1
+             (ACL2::er ACL2::hard 'dd.deriv-link-subst
+                       "Attempting to substitute nil into @-.~%")))
+        ((equal just '@--)
+         (or prev2
+             (ACL2::er ACL2::hard 'dd.deriv-link-subst
+                       "Attempting to substitute nil into @--.~%")))
+        ((not (consp just))
+         just)
+        (t
+         (cons (dd.deriv-link-subst (car just) prev1 prev2)
+               (dd.deriv-link-subst (cdr just) prev1 prev2)))))
+
+(defun dd.deriv-link-relative (x prev1 prev2)
+  ;; We change all occurrences of @- and @-- in each justification with the
+  ;; names of the lines they refer to.
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((conclusion    (first (car x)))
+            (justification (second (car x)))
+            (name          (third (car x))))
+        (cons
+         (list conclusion (dd.deriv-link-subst justification prev1 prev2) name)
+         (dd.deriv-link-relative (cdr x) name prev1)))
+    nil))
+
+(defun dd.deriv-letify1 (x)
+  ;; We change these post-linking lines into lines for a let* statement, and
+  ;; eliminate any (@given x) with x.
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((justification (second (car x)))
+            (name          (third (car x))))
+        (if (equal (car justification) '@given)
+            (if (tuplep 2 justification)
+                ;; replace (@given x) with x
+                (cons `(,name ,(second justification))
+                      (dd.deriv-letify1 (cdr x)))
+              (ACL2::er ACL2::hard 'dd.deriv-letify "Invalid @given: ~x0 ~%" justification))
+          ;; other justifications are not altered.
+          (cons `(,name ,justification)
+                (dd.deriv-letify1 (cdr x)))))
+    nil))
+
+(defun dd.deriv-letify (x)
+  ;; Converts a list of derivation lines into a let* statement.  This bundles
+  ;; the renaming, linking, and letification steps.
+  (declare (xargs :mode :program))
+  (if (not (dd.deriv-linesp x))
+      (ACL2::er ACL2::hard 'dd.deriv-letify "Invalid derivation: ~x0.~%" x)
+    (let* ((named    (dd.deriv-assign-names x 1))
+           (linked   (dd.deriv-link-relative named nil nil))
+           (letified (dd.deriv-letify1 linked))
+           (lastname (car (car (ACL2::last letified)))))
+      `(let* ,letified ,lastname))))
+
+
+
+
+
+;; The @context macro.
+;;
+;; All of the tools we have developed so far are brought together with @context
+;; which is a sophisticated macro.  When I first developed pattern matching
+;; support, I had no notion of contexts.  Here's a typical example of using one
+;; of my early match macros:
+;;
+;; (defthm forcing-conclusion-of-merge-implications-bldr
+;;   (implies (force (and (appeal-structurep x)
+;;                        (appeal-structurep y)
+;;                        (@match (proof x (v (! A) C))
+;;                                (proof y (v (! B) C)))))
+;;            (equal (conclusion (merge-implications-bldr x y))
+;;                   (por (pnot (por (~arg (vlhs (conclusion x)))
+;;                                   (~arg (vlhs (conclusion y)))))
+;;                        (vrhs x)))))
+;;
+;; Even this kind of matching was a big improvement from manually writing out
+;; everything you had to test, but obviously we could benefit from being able
+;; to use context variables in the conclusion of the theorem.  But merely
+;; adding some kind of "body" parameter to the match* statement wouldn't be
+;; sufficient: we want the matching statements to occur in the hyps of the
+;; implication, but we want to refer to the context variables we matched much
+;; later.  I introduced @context to address this.
+;;
+;; The @context macro establishes a scope for all the context variables matched
+;; within it.  Within a @context, we can embed certain special forms:
+;;
+;;   (@match ...)    - introduce code for pattern matching some multipatterns
+;;   (@extend ...)   - manually inject extra paths into the context
+;;   (@expand ...)   - alias for @extend because I always forget its name
+;;   (@term ...)     - construct a term based on a pattern
+;;   (@formula ...)  - construct a formula based on a pattern
+;;   (@formulas ...) - construct a list of formulas based on some patterns
+;;   (@sigma ...)    - construct a sigma based on a pattern
+;;   (@derive ...)   - build a proof using our derivation syntax
+;;
+;; We could now write our example theorem in the following style:
+;;
+;; (@context
+;;   (defthm forcing-conclusion-of-merge-implications-bldr
+;;     (implies (force (and (appeal-structurep x)
+;;                          (appeal-structurep y)
+;;                          (@match (proof x (v (! A) C))
+;;                                  (proof y (v (! B) C)))))
+;;              (equal (conclusion (merge-implications-bldr x y))
+;;                     (@formula (v (! (v A B)) C))))))
+;;
+;; We process the argument to @context in two passes.
+;;
+;;  (1) Namespace building.  We consider all of the @match and @extend/expand
+;;      operations which occur in the context, and create a binding map out of
+;;      their variables.  Note that this namespace is shared throughout the
+;;      entire context.
+;;
+;;  (2) Code generation.  We then replace each of our special forms with some
+;;      regular Lisp code.
+;;
+;;        - (@match <multi-patterns>) forms are replaced by all the structural
+;;          checks they induce, and also with equality checks for the whole
+;;          binding.
+;;
+;;          NOTE: the bindings checks are strange; you should probably limit
+;;          yourself to one @match per context.
+;;            -- BOZO maybe we should enforce a limit?
+;;            -- BOZO maybe only do local bindings checks instead?
+;;
+;;        - (@extend/expand <multi-patterns> body) forms are replaced by their
+;;          bodies (which are recursively processed)
+;;
+;;        - @term, @formula, @formulas, and @sigma are replaced by expressions
+;;          which will construct the object described by their pattern
+;;
+;;        - (@derive <lines>) is replaced with its "letified" equivalent.
+;;
+;; @context cannot be purposefully nested.  The outer @context will treat the
+;; inner @context as just another function call, and steal all of its special
+;; forms as if they were its own.  This eliminates all of the special forms
+;; inside the inner @context, turning it into a no-op.
+
+(defun dd.context-gather (x)
+  (declare (xargs :mode :program))
+  (cond ((not (consp x))
+         nil)
+        ;((memberp (first x) '(@match-term))
+        ; (if (and (tuplep 3 x)
+        ;          (dd.term-patternp (third x)))
+        ;     (dd.term-pattern-path-bindings (second x) (third x))
+        ;   (ACL2::er hard 'dd.context-gather "Invalid @match-term encountered: ~x0 ~%" x)))
+        ;((memberp (first x) '(@match-formula))
+        ; (if (and (tuplep 3 x)
+        ;          (dd.formula-patternp (third x)))
+        ;     (dd.formula-pattern-path-bindings  (second x) (third x))
+        ;   (ACL2::er hard 'dd.context-gather "Invalid @match-formula encountered: ~x0 ~%" x)))
+        ;((memberp (first x) '(@match-proof))
+        ; (if (and (tuplep 3 x)
+        ;          (dd.formula-patternp (third x)))
+        ;     (dd.formula-pattern-path-bindings  `(logic.conclusion ,(second x)) (third x))
+        ;   (ACL2::er hard 'dd.context-gather "Invalid @match-proof encountered: ~x0 ~%" x)))
+        ((memberp (first x) '(@match))
+         (if (dd.multi-patternsp (cdr x))
+             (dd.multi-patterns-path-bindings (cdr x))
+           (ACL2::er hard 'dd.context-gather "Invalid @match encountered: ~x0 ~%" x)))
+        ((memberp (first x) '(@extend @expand))
+         (if (dd.multi-patternsp (second x))
+             (dd.multi-patterns-path-bindings (second x))
+           (ACL2::er hard 'dd.context-gather "Invalid ~x0 encountered: ~x1 ~%" (first x) x)))
+        (t
+         (app (dd.context-gather (car x))
+              (dd.context-gather (cdr x))))))
+
+(defun dd.context-replace (x bindings)
+  (declare (xargs :mode :program))
+  (cond ((not (consp x))
+         x)
+        ;((equal (first x) '@match-term)
+        ; ;; dd.context-gather handles the sanity checks
+        ; `(and ,@(dd.term-pattern-structure-tests (second x) (third x))))
+        ;((equal (first x) '@match-formula)
+        ; ;; dd.context-gather handles the sanity checks
+        ; `(and ,@(dd.formula-pattern-structure-tests (second x) (third x))))
+        ;((equal (first x) '@match-proof)
+        ; ;; dd.context-gather handles the sanity checks
+        ; `(and ,@(dd.formula-pattern-structure-tests `(logic.conclusion ,(second x)) (third x))))
+        ((equal (first x) '@match)
+         ;; dd.context-gather handles the sanity checks
+         `(and
+           ;; @match has structural tests AND binding tests built in
+           ,@(dd.multi-patterns-structure-tests (cdr x))
+           ,@(dd.path-bindings-to-equalities bindings)))
+        ((memberp (first x) '(@extend @expand))
+         ;; @extend is just replaced by its body
+         (dd.context-replace (third x) bindings))
+        ;((equal (first x) '@check-bindings)
+        ; (if (not (tuplep 1 x))
+        ;     (ACL2::er ACL2::hard 'dd.context-replace "Invalid @check-bindings encountered: ~x0 ~%" x)
+        ;   `(and ,@(dd.path-bindings-to-equalities bindings))))
+        ((equal (first x) '@term)
+         (if (or (not (tuplep 2 x))
+                 (not (dd.term-patternp (second x))))
+             (ACL2::er ACL2::hard 'dd.context-replace "Invalid @term encountered: ~x0 ~%" x)
+           (dd.term-from-path-bindings (second x) bindings)))
+        ((equal (first x) '@formula)
+         (if (or (not (tuplep 2 x))
+                 (not (dd.formula-patternp (second x))))
+             (ACL2::er ACL2::hard 'dd.context-replace "Invalid @formula encountered: ~x0 ~%" x)
+           (dd.formula-from-path-bindings (second x) bindings)))
+        ((equal (first x) '@terms)
+         (if (not (dd.term-pattern-listp (cdr x)))
+             (ACL2::er ACL2::hard 'dd.context-replace "Invalid @terms encountered: ~x0 ~%" x)
+           `(list ,@(dd.term-from-path-bindings-list (cdr x) bindings))))
+        ((equal (first x) '@formulas)
+         (if (not (dd.formula-pattern-listp (cdr x)))
+             (ACL2::er ACL2::hard 'dd.context-replace "Invalid @formulas encountered: ~x0 ~%" x)
+           `(list ,@(dd.formula-from-path-bindings-list (cdr x) bindings))))
+        ((equal (first x) '@sigma)
+         (if (not (dd.sigma-patternp (cdr x)))
+             (ACL2::er ACL2::hard 'dd.context-replace "Invalid @sigma encountered: ~x0 ~%" x)
+           `(list ,@(dd.sigma-from-path-bindings (cdr x) bindings))))
+        (t
+         (cons (dd.context-replace (car x) bindings)
+               (dd.context-replace (cdr x) bindings)))))
+
+;; To allow @formula and @term and such to be used transparently inside of
+;; @derive, we process @context in two passes.  Our first step is to replace
+;; any @derive expressions with their expansion.  We then hit the result with
+;; the context gathering and replacement.
+
+(defun dd.deriv-letify-all (x)
+  (declare (xargs :mode :program))
+  (cond ((not (consp x))
+         x)
+        ((equal (car x) '@derive)
+         (dd.deriv-letify (cdr x)))
+        (t
+         (cons (dd.deriv-letify-all (car x))
+               (dd.deriv-letify-all (cdr x))))))
+
+(defun dd.context-fn (x)
+  (declare (xargs :mode :program))
+  (let ((expand-deriv (dd.deriv-letify-all x)))
+    (dd.context-replace expand-deriv (dd.context-gather expand-deriv))))
+
+(defmacro @context (x)
+  (dd.context-fn x))
+
+
+;; It is difficult to directly put multiple contexts in a single function
+;; because "cond" is a macro and will not accept something like
+;;
+;; (cond (@context ((@match ...) ...)) ...)
+;;
+;; We introduce our own @cond which gives a new context to each branch in the
+;; cond.  This way, you can use matching to determine your tests, etc.
+;;
+;; Note: @cond cannot be meaningfully nested inside some external @context.
+
+;; (defun dd.context-list-fn (x)
+;;   (declare (xargs :mode :program))
+;;   (if (consp x)
+;;       (cons (dd.context-fn (car x))
+;;             (dd.context-list-fn (cdr x)))
+;;     nil))
+
+;; (defmacro @cond (&rest args)
+;;   `(cond ,@(dd.context-list-fn args)))
+
+
+
+
+
+;; Axiom and theorem tracking.
+;;
+;; We can also automatically extract a list of axioms and theorems which are
+;; used in a derivation.  Some of these are "local", meaning that they are
+;; directly used via (build.axiom ...).  Others are "inherited", meaning they
+;; are required by some other builder we've called upon.  We store lists of
+;; axioms and theorems used by our builders, so that we can infer the axioms
+;; and theorems we have inherited.
+
+(ACL2::table milawa 'builder-axioms nil)
+
+(ACL2::table milawa 'builder-theorems nil)
+
+(defun dd.get-builder-axioms (wrld)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'builder-axioms (ACL2::table-alist 'milawa wrld))))
+
+(defun dd.get-builder-theorems (wrld)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'builder-theorems (ACL2::table-alist 'milawa wrld))))
+
+(defun dd.deriv-local-axioms (x)
+  ;; Extract all the local axioms for a list of derivation lines
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((justification (second (car x))))
+        (cond ((equal (first justification) 'build.axiom)
+               ;; E.g., (build.axiom (axiom-blah))
+               (cons (second justification)
+                     (dd.deriv-local-axioms (cdr x))))
+              (t
+               (dd.deriv-local-axioms (cdr x)))))
+    nil))
+
+(defun dd.deriv-inherited-axioms (x wrld)
+  ;; Infer all the inherited axioms for a list of derivation lines
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let* ((justification (second (car x))))
+        (app (cdr (lookup (first justification) (dd.get-builder-axioms wrld)))
+             (dd.deriv-inherited-axioms (cdr x) wrld)))
+    nil))
+
+(defun dd.deriv-local-theorems (x)
+  ;; Extract all the local theorems for a list of derivation lines
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((justification (second (car x))))
+        (cond ((equal (first justification) 'build.theorem)
+               ;; E.g., (build.theorem (theorem-blah))
+               (cons (second justification)
+                     (dd.deriv-local-theorems (cdr x))))
+              (t
+               (dd.deriv-local-theorems (cdr x)))))
+    nil))
+
+(defun dd.deriv-inherited-theorems (x wrld)
+  ;; Infer all the inherited theorems for a list of derivation lines
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let* ((justification (second (car x))))
+        (app (cdr (lookup (first justification) (dd.get-builder-theorems wrld)))
+             (dd.deriv-inherited-theorems (cdr x) wrld)))
+    nil))
+
+(defun dd.make-members (x set)
+  ;; Create a list of [(memberp (axiom1) <set>), ...]
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (cons `(memberp ,(car x) ,set)
+            (dd.make-members (cdr x) set))
+    nil))
+
+(defun dd.manual-inherited-axioms (x wrld)
+  ;; x is a list of builder names; collect all the axioms they need.
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (app (cdr (lookup (car x) (dd.get-builder-axioms wrld)))
+           (dd.manual-inherited-axioms (cdr x) wrld))
+    nil))
+
+(defun dd.manual-inherited-theorems (x wrld)
+  ;; x is a list of builder names; collect all the theorems they need.
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (app (cdr (lookup (car x) (dd.get-builder-theorems wrld)))
+           (dd.manual-inherited-theorems (cdr x) wrld))
+    nil))
+
+
+
+;; Since @context does not take state, we need to introduce some wrappers if we want
+;; to provide direct support for axiom and theorem inference.  Towards this end, we
+;; provide defun@, defund@, defthm@, and defthmd@, which implicitly wrap their defun
+;; or defthm with @context, and also replace any occurrences of
+;;
+;;    (@obligations bldr1 bldr2 ... bldrN)
+;;
+;; With membership checks for the inherited axioms and theorems of these builders,
+;; i.e.,
+;;
+;;    (and (memberp (axiom1) axioms)
+;;         ...
+;;         (memberp (axiomN) axioms)
+;;         (memberp (thm1) thms)
+;;         ...
+;;         (memberp (thmN) thms))
+
+(defun dd.replace-obligations (x wrld)
+  (declare (xargs :mode :program))
+  (cond ((not (consp x))
+         x)
+        ((equal (first x) '@obligations)
+         `(and ,@(dd.make-members (dd.manual-inherited-axioms (cdr x) wrld) 'axioms)
+               ,@(dd.make-members (dd.manual-inherited-theorems (cdr x) wrld) 'thms)))
+        (t
+         (cons (dd.replace-obligations (car x) wrld)
+               (dd.replace-obligations (cdr x) wrld)))))
+
+(defmacro defun@ (&rest args)
+  `(ACL2::progn
+    (ACL2::make-event `(@context (defun ,@(dd.replace-obligations ',args (ACL2::w ACL2::state)))))))
+
+(defmacro defund@ (&rest args)
+  `(ACL2::progn
+    (ACL2::make-event `(@context (defund ,@(dd.replace-obligations ',args (ACL2::w ACL2::state)))))))
+
+(defmacro definline@ (&rest args)
+  `(ACL2::progn
+    (ACL2::make-event `(@context (defun ,@(dd.replace-obligations ',args (ACL2::w ACL2::state)))))
+    (ACL2::table milawa 'functions-to-inline
+                 (cons ',(second args)
+                       (ACL2::get-functions-to-inline ACL2::world)))))
+
+(defmacro definlined@ (&rest args)
+  `(ACL2::progn
+    (ACL2::make-event `(@context (defund ,@(dd.replace-obligations ',args (ACL2::w ACL2::state)))))
+    (ACL2::table milawa 'functions-to-inline
+                 (cons ',(second args)
+                       (ACL2::get-functions-to-inline ACL2::world)))))
+
+(defmacro defthm@ (&rest args)
+  `(ACL2::progn
+    (ACL2::make-event `(@context (defthm ,@(dd.replace-obligations ',args (ACL2::w ACL2::state)))))))
+
+(defmacro defthmd@ (&rest args)
+  `(ACL2::progn
+    (ACL2::make-event `(@context (defthmd ,@(dd.replace-obligations ',args (ACL2::w ACL2::state)))))))
+
+
+(defmacro defsection@ (&rest args)
+  ;; This is the same as defsection, but it also provides a context.
+  `(ACL2::progn
+    (ACL2::make-event `(@context (defsection ,@(dd.replace-obligations ',args (ACL2::w ACL2::state)))))))
+
+
+
+(defmacro defobligations (name builders &key extra-axioms extra-thms)
+  ;; Name should refer to a new builder which we are introducing.  Builders should be
+  ;; the list of all the builders used by name.  We look up all the theorem and axiom
+  ;; obligations for all these builders, and give them to name.
+  ;;
+  ;; You can also optionally provide some :extra-axioms and :extra-theorems that the
+  ;; builder is going to require, if it manually uses build.axiom or build.theorem.
+  (declare (xargs :guard (and (symbolp name)
+                              (symbol-listp builders)
+                              (true-listp extra-axioms)
+                              (true-listp extra-thms))))
+  `(ACL2::progn
+    (ACL2::table milawa 'builder-axioms
+                 (update ',name
+                         (remove-duplicates (app ',extra-axioms
+                                                 (dd.manual-inherited-axioms ',builders ACL2::world)))
+                         (dd.get-builder-axioms ACL2::world)))
+    (ACL2::table milawa 'builder-theorems
+                 (update ',name
+                         (remove-duplicates (app ',extra-thms
+                                                 (dd.manual-inherited-theorems ',builders ACL2::world)))
+                         (dd.get-builder-theorems ACL2::world)))
+    (ACL2::value-triple (cons ',name
+                              (list (cons 'AXMS (cdr (lookup ',name (dd.get-builder-axioms (ACL2::w ACL2::state)))))
+                                    (cons 'THMS (cdr (lookup ',name (dd.get-builder-theorems (ACL2::w ACL2::state))))))))))
diff -Nru acl2-6.2/books/milawa/ACL2/defderiv/defderiv.lisp acl2-6.3/books/milawa/ACL2/defderiv/defderiv.lisp
--- acl2-6.2/books/milawa/ACL2/defderiv/defderiv.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/defderiv/defderiv.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1124 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "context")
+(include-book "latex")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(acl2::defttag acl2::open-output-channel!)
+
+
+
+;; Derivation cost estimation.
+;;
+;; We maintain a table that includes cost estimates for simple builders.
+;; Initially we say that the "price" of each primitive builder is 1, and that
+;; each given costs 0.  Then, given a derivation, we can try to sum the costs
+;; associated with each step.  If all the costs are defined, we will have
+;; successfully made an estimate.
+
+(ACL2::table milawa 'builder-costs
+             '((@given . 0)
+               (build.axiom . 1)
+               (build.theorem . 1)
+               (build.propositional-schema . 1)
+               (build.cut . 1)
+               (build.contraction . 1)
+               (build.expansion . 1)
+               (build.associativity . 1)
+               (build.instantiation . 1)
+               (build.functional-equality . 1)
+               (build.beta-reduction . 1)
+               (build.base-eval . 1)))
+
+(defun dd.get-builder-costs (wrld)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'builder-costs (ACL2::table-alist 'milawa wrld))))
+
+(defun dd.estimate-cost-of-lines (lines wrld)
+  (declare (xargs :mode :program))
+  (if (consp lines)
+      (let* ((justification (second (car lines)))
+             (lookup        (cdr (lookup (first justification) (dd.get-builder-costs wrld)))))
+        (and lookup
+             (+ lookup (dd.estimate-cost-of-lines (cdr lines) wrld))))
+    0))
+
+
+
+
+(defun dd.all-deriv-local-axioms (x)
+  (declare (xargs :mode :program))
+  (cond ((not (consp x))
+         x)
+        ((equal (car x) '@derive)
+         (dd.deriv-local-axioms (cdr x)))
+        (t
+         (app (dd.all-deriv-local-axioms (car x))
+              (dd.all-deriv-local-axioms (cdr x))))))
+
+(defun dd.all-deriv-local-theorems (x)
+  (declare (xargs :mode :program))
+  (cond ((not (consp x))
+         x)
+        ((equal (car x) '@derive)
+         (dd.deriv-local-theorems (cdr x)))
+        (t
+         (app (dd.all-deriv-local-theorems (car x))
+              (dd.all-deriv-local-theorems (cdr x))))))
+
+(defun dd.all-deriv-inherited-axioms (x wrld)
+  (declare (xargs :mode :program))
+  (cond ((not (consp x))
+         x)
+        ((equal (car x) '@derive)
+         (dd.deriv-inherited-axioms (cdr x) wrld))
+        (t
+         (app (dd.all-deriv-inherited-axioms (car x) wrld)
+              (dd.all-deriv-inherited-axioms (cdr x) wrld)))))
+
+(defun dd.all-deriv-inherited-theorems (x wrld)
+  (declare (xargs :mode :program))
+  (cond ((not (consp x))
+         x)
+        ((equal (car x) '@derive)
+         (dd.deriv-inherited-theorems (cdr x) wrld))
+        (t
+         (app (dd.all-deriv-inherited-theorems (car x) wrld)
+              (dd.all-deriv-inherited-theorems (cdr x) wrld)))))
+
+
+
+
+
+
+;; (defderiv <name>
+;;   :derive <formula>
+;;   :from   <multi-patterns>
+;;   :proof  <deriv>)
+;;
+;; Defderiv allows us to introduce a simple derivation using matching and
+;; @derive style lines.
+
+
+(defun dd.defderiv-formals (from)
+  ;; We analyze the :from <multi-patterns> section and extract all the paths.
+  ;; We expect that each path is a simple variable.  These variables become the
+  ;; inputs to our builder function.
+  (declare (xargs :mode :program))
+  (if (consp from)
+      (let ((path (second (car from))))
+        (if (not (logic.variablep path))
+            (ACL2::er ACL2::hard 'dd.defderiv-formals
+                      "All paths in defderiv :from multi-patterns must be variables.~%")
+          (cons path (dd.defderiv-formals (cdr from)))))
+    nil))
+
+(defun dd.count-proofs (x)
+  ;; X is the :from <multi-patterns> object.
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((type (first (car x))))
+        (if (equal type 'proof)
+            (+ 1 (dd.count-proofs (cdr x)))
+          (dd.count-proofs (cdr x))))
+    0))
+
+(defun dd.build-subproofs-matching-code (x path)
+  ;; X is the :from <multi-patterns> object.  We write code to check that a list of
+  ;; subproofs match the proofs in these patterns.  This code will be given to a new
+  ;; @match.  So, for example, we write:
+  ;;
+  ;;   (proof (car subproofs) pattern-1)
+  ;;   (proof (car (cdr subproofs)) pattern-2)
+  ;;   ...
+  ;;   (proof (car (cdr (cdr ...))) pattern-N)
+  ;;
+  ;; Path is just an accumulator which begins with "subproofs", then "(cdr subproofs)",
+  ;; etc.
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((type (first (car x)))
+            (pattern (third (car x))))
+        (cond ((equal type 'proof)
+               (cons `(proof (car ,path) ,pattern)
+                     (dd.build-subproofs-matching-code (cdr x) `(cdr ,path))))
+              ((or (equal type 'term)
+                   (equal type 'formula))
+               (dd.build-subproofs-matching-code (cdr x) path))
+              (t
+               ;; I think constant is not a valid option anymore.  It's handled by
+               ;; where instead.
+               (ACL2::er ACL2::hard 'dd.build-subproofs-matching-code
+                         "Invalid entry ~x0.~%" (car x)))))
+    nil))
+
+(defun dd.build-subproofs-witness-code (x path)
+  ;; X is the :from <multi-patterns> object.  Our job is to provide an argument list
+  ;; that can be used to instantiate a call of this builder, using the provable
+  ;; witnesses for its subproofs.  For example,
+  ;;
+  ;;  :from ((term a [term-pattern])
+  ;;         (proof b [proof-pattern-b])
+  ;;         (formula c [formula-pattern])
+  ;;         (proof d [proof-pattern-d]))
+  ;;  --->
+  ;;
+  ;;   (  (@term [term-pattern])
+  ;;      (logic.provable-witness (logic.conclusion (car subproofs)) axioms thms atbl)
+  ;;      (@formula [formula-pattern])
+  ;;      (logic.provable-witness (logic.conclusion (car (cdr subproofs))) axioms thms atbl)  )
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((type (first (car x)))
+            (pattern (third (car x))))
+        (cond ((equal type 'term)
+               (cons `(@term ,pattern)
+                     (dd.build-subproofs-witness-code (cdr x) path)))
+              ((equal type 'formula)
+               (cons `(@formula ,pattern)
+                     (dd.build-subproofs-witness-code (cdr x) path)))
+              ((equal type 'proof)
+               (cons `(logic.provable-witness (logic.conclusion (car ,path)) axioms thms atbl)
+                     (dd.build-subproofs-witness-code (cdr x) `(cdr ,path))))
+              (t
+               ;; I think constant is not a valid option anymore.  It's handled by where
+               ;; instead.
+               (ACL2::er ACL2::hard 'dd.build-subproofs-witness-code
+                         "Invalid entry ~x0.~%" (car x)))))
+    nil))
+
+(defun dd.names-of-subproofs (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((type (first (car x)))
+            (name (second (car x))))
+        (if (equal type 'proof)
+            (cons name (dd.names-of-subproofs (cdr x)))
+          (dd.names-of-subproofs (cdr x))))
+    nil))
+
+(defun dd.defderiv-extra-guards (from)
+  ;; These are the hyps we add to @match for the logic.appealp
+  ;; theorem, the conclusion theorem, and for the function's guards.
+  (declare (xargs :mode :program))
+  (if (consp from)
+      (let ((type (first (car from)))
+            (path (second (car from))))
+        (cond ((equal type 'term)
+               (cons `(logic.termp ,path)
+                     (dd.defderiv-extra-guards (cdr from))))
+               ((equal type 'formula)
+               (cons `(logic.formulap ,path)
+                     (dd.defderiv-extra-guards (cdr from))))
+              ((equal type 'proof)
+               (cons `(logic.appealp ,path)
+                     (dd.defderiv-extra-guards (cdr from))))
+              ((equal type 'constant)
+               (dd.defderiv-extra-guards (cdr from)))
+              (t
+               (ACL2::er ACL2::hard 'dd.defderiv-extra-guards
+                         "Invalid entry ~x0~%" (car from)))))
+    nil))
+
+(defun dd.defderiv-extra-guards-atbl (from)
+  ;; These are the hyps we add to @match for the logic.appeal-atblp theorem.
+  (declare (xargs :mode :program))
+  (if (consp from)
+      (let ((type (first (car from)))
+            (path (second (car from))))
+        (cond ((equal type 'term)
+               (cons `(logic.termp ,path)
+                     (cons `(logic.term-atblp ,path atbl)
+                           (dd.defderiv-extra-guards-atbl (cdr from)))))
+              ((equal type 'formula)
+               (cons `(logic.formulap ,path)
+                     (cons `(logic.formula-atblp ,path atbl)
+                           (dd.defderiv-extra-guards-atbl (cdr from)))))
+              ((equal type 'proof)
+               (cons `(logic.appealp ,path)
+                     (cons `(logic.appeal-atblp ,path atbl)
+                           (dd.defderiv-extra-guards-atbl (cdr from)))))
+              ((equal type 'constant)
+               (dd.defderiv-extra-guards-atbl (cdr from)))
+              (t
+               (ACL2::er ACL2::hard 'dd.defderiv-extra-guards-atbl
+                         "Invalid entry ~x0~%" (car from)))))
+    nil))
+
+(defun dd.defderiv-extra-guards-proofp (from)
+  ;; These are the guards we add to @match for the logic.proofp theorem.
+  (declare (xargs :mode :program))
+  (if (consp from)
+      (let ((type (first (car from)))
+            (path (second (car from))))
+        (cond ((equal type 'term)
+               (cons `(logic.termp ,path)
+                     (cons `(logic.term-atblp ,path atbl)
+                           (dd.defderiv-extra-guards-proofp (cdr from)))))
+              ((equal type 'formula)
+               (cons `(logic.formulap ,path)
+                     (cons `(logic.formula-atblp ,path atbl)
+                           (dd.defderiv-extra-guards-proofp (cdr from)))))
+              ((equal type 'proof)
+               (cons `(logic.appealp ,path)
+                     (cons `(logic.proofp ,path axioms thms atbl)
+                           (dd.defderiv-extra-guards-proofp (cdr from)))))
+              ((equal type 'constant)
+               (dd.defderiv-extra-guards-proofp (cdr from)))
+              (t
+               (ACL2::er ACL2::hard 'dd.defderiv-extra-guards-proofp
+                         "Invalid entry ~x0~%" (car from)))))
+    nil))
+
+
+
+
+;; For the recognizer, we need to do arity checks on any new formulas or terms that have
+;; been supplied.
+
+(defun dd.defderiv-atbl-checks-for-okp (from)
+  (declare (xargs :mode :program))
+  (if (consp from)
+      (let ((type (first (car from)))
+            ;(path (second (car from)))
+            (pat  (third (car from))))
+        (cond ((equal type 'term)
+               (cons `(logic.term-atblp (@term ,pat) atbl)
+                     (dd.defderiv-atbl-checks-for-okp (cdr from))))
+              ((equal type 'formula)
+               (cons `(logic.formula-atblp (@formula ,pat) atbl)
+                     (dd.defderiv-atbl-checks-for-okp (cdr from))))
+              (t
+               (dd.defderiv-atbl-checks-for-okp (cdr from)))))
+    nil))
+
+
+;; We can probably eventually automate the minimum atbl requirements for the
+;; logic.appealp and logic.proofp theorems, but for now we will just have the user supply
+;; it as an atbl fragment, i.e., ((if . 3) (equal . 2)), etc.
+
+(defun dd.minatbl-to-checks (minatbl)
+  (declare (xargs :mode :program))
+  (if (consp minatbl)
+      (let ((fn (car (car minatbl)))
+            (arity (cdr (car minatbl))))
+        (cons `(equal (cdr (lookup ',fn atbl)) ,arity)
+              (dd.minatbl-to-checks (cdr minatbl))))
+    nil))
+
+
+;; We save some information for bootstrapping in the info-for-%defderiv table.
+(ACL2::table milawa 'info-for-%defderiv nil)
+
+(defun dd.get-info-for-%defderiv (world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'info-for-%defderiv (ACL2::table-alist 'milawa world))))
+
+(defun dd.defderiv-fn (name from derive where proof minatbl highlevel-override wrld)
+  (declare (xargs :mode :program))
+  (let* ((formals              (dd.defderiv-formals from))
+         (extra-guards         (dd.defderiv-extra-guards from))
+         (extra-guards-proofp  (dd.defderiv-extra-guards-proofp from))
+         (local-axioms         (dd.all-deriv-local-axioms proof))
+         (local-theorems       (dd.all-deriv-local-theorems proof))
+         (all-axioms           (cdr (lookup name (dd.get-builder-axioms wrld))))
+         (all-theorems         (cdr (lookup name (dd.get-builder-theorems wrld))))
+         (atbl-checks          (dd.minatbl-to-checks minatbl))
+         (name-okp             (ACL2::mksym name '-okp))
+         (name-high            (ACL2::mksym name '-high)))
+    `(encapsulate
+      ()
+      ;; We begin by introducing the proof builder and proving the theorems about
+      ;; it conclusion, appeal-ness, and proof-ness.
+      (encapsulate
+       ()
+       ,@(if (or local-axioms local-theorems)
+             `((local (in-theory (enable ,@(strip-firsts local-axioms)
+                                         ,@(strip-firsts local-theorems)))))
+           nil)
+
+       (defund@ ,name ,formals
+         (declare (xargs :guard (and ,@extra-guards
+                                     (@match ,@from)
+                                     ,@where)))
+         ,proof)
+
+       (in-theory (disable (:executable-counterpart ,name)))
+
+       (local (in-theory (enable ,name)))
+
+       (defthm@ ,(ACL2::mksym name '-under-iff)
+         (iff (,name ,@formals)
+              t)
+         :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+       (defthm@ ,(ACL2::mksym 'forcing-logic.appealp-of- name)
+         (implies (force (and ,@extra-guards
+                              (@match ,@from)
+                              ,@where))
+                  (equal (logic.appealp (,name ,@formals))
+                         t)))
+
+       (defthm@ ,(ACL2::mksym 'forcing-logic.conclusion-of- name)
+         (implies (force (and ,@extra-guards
+                              (@match ,@from)
+                              ,@where))
+                  (equal (logic.conclusion (,name ,@formals))
+                         (@formula ,derive)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+       (defthm@ ,(ACL2::mksym 'forcing-logic.proofp-of- name)
+         (implies (force (and ,@extra-guards-proofp
+                              (@match ,@from)
+                              ,@atbl-checks
+                              ,@(dd.make-members all-axioms 'axioms)
+                              ,@(dd.make-members all-theorems 'thms)
+                              ,@where))
+                  (equal (logic.proofp (,name ,@formals) axioms thms atbl)
+                         t))))
+
+       (@context
+        (@expand ((proof x ,derive))
+                 (ACL2::table milawa 'info-for-%defderiv
+                              (cons (list ',name
+                                          ',local-axioms
+                                          ',local-theorems
+                                          ',(dd.build-subproofs-witness-code from '(logic.subproofs x))
+                                          )
+                                    (dd.get-info-for-%defderiv ACL2::world)))))
+
+      ;; Now we introduce a recognizer for these kinds of steps.
+       ;; we should do a better job of avoiding atbl if we can
+      (defund@ ,name-okp (x atbl)
+        (declare (xargs :guard (and (logic.appealp x)
+                                    (logic.arity-tablep atbl)))
+                 (ACL2::ignorable atbl))
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method ',name)
+               (equal extras nil)
+               (equal (len subproofs) ,(dd.count-proofs from))
+               (@match (formula conclusion ,derive)
+                       ,@(dd.build-subproofs-matching-code from 'subproofs))
+               ,@(dd.defderiv-atbl-checks-for-okp from)
+               ,@where)))
+
+      (local (in-theory (enable ,name-okp)))
+
+      (defthm ,(ACL2::mksym 'booleanp-of- name-okp)
+        (equal (booleanp (,name-okp x atbl))
+               t)
+        :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+      (defthm ,(ACL2::mksym name-okp '-of-logic.appeal-identity)
+        (equal (,name-okp (logic.appeal-identity x) atbl)
+               (,name-okp x atbl))
+        :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+      (encapsulate
+       ()
+       (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                              (forcing-logic.formula-atblp-rules
+                               forcing-lookup-of-logic.function-name-free
+                               forcing-logic.term-list-atblp-of-logic.function-args
+                               ))))
+
+       (defthmd@ ,(ACL2::mksym 'lemma-1-for-soundness-of- name-okp)
+         (@expand ((proof x ,derive)) ;; so we can match vars in the conclusion
+                  (implies (and (,name-okp x atbl)
+                                (logic.appealp x)
+                                ;; NEW: we don't assume it's an formula-atbl.
+                                ;; (logic.formula-atblp (logic.conclusion x) atbl)
+                                (logic.formula-list-atblp (logic.strip-conclusions (logic.subproofs x)) atbl)
+                                (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+                           (equal (logic.conclusion (,name ,@(dd.build-subproofs-witness-code from '(logic.subproofs x))))
+                                  (logic.conclusion x)))))
+
+       (defthmd@ ,(ACL2::mksym 'lemma-2-for-soundness-of- name-okp)
+         (@expand ((proof x ,derive)) ;; so we can match vars in the conclusion
+                  (implies (and (,name-okp x atbl)
+                                (logic.appealp x)
+                                ;; NEW: we don't assume it's an formula-atbl.
+                                ;; (logic.formula-atblp (logic.conclusion x) atbl)
+                                (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                                ,@atbl-checks
+                                ,@(dd.make-members all-axioms 'axioms)
+                                ,@(dd.make-members all-theorems 'thms))
+                           (equal (logic.proofp
+                                   (,name ,@(dd.build-subproofs-witness-code from '(logic.subproofs x)))
+                                   axioms thms atbl)
+                                  t)))))
+
+      (defthm@ ,(ACL2::mksym 'forcing-soundness-of- name-okp)
+        (@expand ((proof x ,derive)) ;; so we can match vars in the conclusion
+                 (implies (and (,name-okp x atbl)
+                               (force (and (logic.appealp x)
+                                           ;; NEW: we don't assume it's an formula-atbl.
+                                           ;;(logic.formula-atblp (logic.conclusion x) atbl)
+                                           (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                                           ,@atbl-checks
+                                           ,@(dd.make-members all-axioms 'axioms)
+                                           ,@(dd.make-members all-theorems 'thms))))
+                          (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                 t)))
+        :hints(("Goal"
+                :in-theory (enable ,(ACL2::mksym 'lemma-1-for-soundness-of- name-okp)
+                                   ,(ACL2::mksym 'lemma-2-for-soundness-of- name-okp))
+                :use (:instance forcing-logic.provablep-when-logic.proofp
+                                (x (,name ,@(dd.build-subproofs-witness-code from '(logic.subproofs x))))))))
+
+      ;; We finally introduce the corresponding high-level builder.
+
+      (defund@ ,name-high ,formals
+        (declare (xargs :guard (and ,@extra-guards
+                                    (@match ,@from)
+                                    ,@where)))
+        ,(or highlevel-override
+             `(logic.appeal ',name
+                            (@formula ,derive)
+                            (list ,@(dd.names-of-subproofs from))
+                            nil)))
+
+      )))
+
+
+
+
+
+;; LaTeX support for Derivations
+
+(defconst *dd.max-summary-width* (dd.inches-to-twips 5))
+(defconst *dd.max-derive-line-width* (dd.inches-to-twips (acl2::+ 3 3/4)))
+(defconst *dd.justify-width* (dd.inches-to-twips 5/4))
+
+(defconst *dd.bldr-name-always-replace*
+  ;; Replacements to builder names which are always applied
+  (list (cons (dd.explode "pequal")           (dd.explode "$=$"))
+        (cons (dd.explode "not pequal")       (dd.explode "$\\neq$"))
+        (cons (dd.explode "not =")            (dd.explode "$\\neq$"))
+        (cons (dd.explode "not $=$")          (dd.explode "$\\neq$"))
+        (cons (dd.explode "nega")             (dd.explode "1hide"))
+        (cons (dd.explode "neg")              (dd.explode "$\\neg$"))
+        (cons (dd.explode "$\\neg$ $\\neg$")  (dd.explode "$\\neg\\neg$"))
+        (cons (dd.explode " bldr")            (dd.explode ""))
+        (cons (dd.explode "build.")           (dd.explode ""))
+        (cons (dd.explode "tactic.")          (dd.explode ""))
+        (cons (dd.explode "clause.")          (dd.explode ""))
+        (cons (dd.explode "rw.")              (dd.explode ""))
+        (cons (dd.explode "1hide")            (dd.explode "nega"))))
+
+(defconst *dd.bldr-name-maybe-replace*
+  ;; Replacements to builder names which are only applied if we want to shorten the name
+  (list (cons (dd.explode "disjoined")         (dd.explode "dj."))
+        (cons (dd.explode "theorem")           (dd.explode "th."))
+        (cons (dd.explode "axiom")             (dd.explode "ax."))
+        (cons (dd.explode "associativity")     (dd.explode "assoc."))
+        (cons (dd.explode "negative")          (dd.explode "neg."))
+        (cons (dd.explode "transitivity of")   (dd.explode "trans."))
+        (cons (dd.explode "transitivity")      (dd.explode "trans."))
+        (cons (dd.explode "reflexivity of")    (dd.explode "refl."))
+        (cons (dd.explode "reflexivity")       (dd.explode "refl."))
+        (cons (dd.explode "commutativity of")  (dd.explode "comm."))
+        (cons (dd.explode "commutativity")     (dd.explode "comm."))
+        (cons (dd.explode "commute")           (dd.explode "comm."))
+        (cons (dd.explode "left")              (dd.explode "l."))
+        (cons (dd.explode "right")             (dd.explode "r."))
+        (cons (dd.explode "modus ponens 2")    (dd.explode "mp2"))
+        (cons (dd.explode "modus ponens")      (dd.explode "mp"))
+        (cons (dd.explode "propositional")     (dd.explode "prop."))
+        (cons (dd.explode "normalize")           (dd.explode "norm."))
+        (cons (dd.explode "contraction")         (dd.explode "contr."))
+        (cons (dd.explode "implications")        (dd.explode "imp."))
+        (cons (dd.explode "implies")             (dd.explode "imp."))
+        (cons (dd.explode "equal")               (dd.explode "eq."))
+        (cons (dd.explode "specialcase")         (dd.explode "sp."))
+        (cons (dd.explode "substitute")          (dd.explode "sub."))
+        (cons (dd.explode "lemma")               (dd.explode "lm."))
+        (cons (dd.explode "two")                 (dd.explode "2"))
+        (cons (dd.explode "not nil and nil")     (dd.explode "nnil, nil"))
+        (cons (dd.explode "not nil and not nil") (dd.explode "nnil, nnil"))
+        (cons (dd.explode "nil and nil")         (dd.explode "nil, nil"))
+        (cons (dd.explode "nil and not nil")     (dd.explode "nil, nnil"))
+        (cons (dd.explode "not nil")             (dd.explode "nnil"))
+        (cons (dd.explode "expansion")           (dd.explode "exp."))
+        (cons (dd.explode " when")                (dd.explode ","))
+        (cons (dd.explode "from")                (dd.explode "fr."))
+        (cons (dd.explode "by args")             (dd.explode "args"))
+        ))
+
+(defconst *dd.cross-patterns*
+  ;; Replacements to cross-references
+  (list (cons (dd.explode "*1a, *1b, *1c") (dd.explode "*1abc"))
+        (cons (dd.explode "*2a, *2b, *2c") (dd.explode "*2abc"))
+        (cons (dd.explode "*1a, *1b") (dd.explode "*1ab"))
+        (cons (dd.explode "*1a, *1b") (dd.explode "*1ab"))))
+
+(defun dd.cat-separator-between-strings (strings sep) ;; => string
+  ;; Insert a separator between each string in a list
+  (declare (xargs :mode :program))
+  (if (consp strings)
+      (if (consp (cdr strings))
+          (dd.cat (car strings)
+                  sep
+                  (dd.cat-separator-between-strings (cdr strings) sep))
+        (car strings))
+    ""))
+
+(defun dd.char-list-replace (old new char-list) ;; => char list
+  ;; Replace all character occurrences
+  (declare (xargs :mode :program))
+  (if (consp char-list)
+      (cons (if (equal (car char-list) old)
+                new
+              (car char-list))
+            (dd.char-list-replace old new (cdr char-list)))
+    nil))
+
+(defun dd.char-list-replace-char-list (old new char-list) ;; => char list
+  ;; Replace all substring occurrences
+  (declare (xargs :mode :program))
+  (if (prefixp old char-list)
+      (app new
+           (dd.char-list-replace-char-list old new (ACL2::nthcdr (len old) char-list)))
+    (if (consp char-list)
+        (cons (car char-list)
+              (dd.char-list-replace-char-list old new (cdr char-list)))
+      nil)))
+
+(defun dd.char-list-replace-patterns (char-list patterns) ;; => char list
+  ;; Replace all substring occurrences specified in a table
+  (declare (xargs :mode :program))
+  (if (consp patterns)
+      (dd.char-list-replace-patterns (dd.char-list-replace-char-list (car (car patterns))
+                                                                     (cdr (car patterns))
+                                                                     char-list)
+                                     (cdr patterns))
+    char-list))
+
+(defun dd.name-estimate-twips (x)
+  ;; Estimate how long a builder name will be
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (equal (car x) #\$)
+          (cond ((prefixp (dd.explode "$=$") x)
+                 (+ *dd.equal-width*
+                    (dd.name-estimate-twips (ACL2::nthcdr 3 x))))
+                ((prefixp (dd.explode "$\\neq$") x)
+                 (+ *dd.neq-width*
+                    (dd.name-estimate-twips (ACL2::nthcdr 6 x))))
+                ((prefixp (dd.explode "$\\neg$") x)
+                 (+ *dd.neg-width*
+                    (dd.name-estimate-twips (ACL2::nthcdr 6 x))))
+                ((prefixp (dd.explode "$\\neg\\neg$") x)
+                 (+ (+ *dd.neg-width* *dd.neg-width*)
+                    (dd.name-estimate-twips (ACL2::nthcdr 10 x))))
+                (t
+                 (ACL2::er hard 'dd.name-estimate-twips "Unusual math mode encountered. ~x0~%" x)))
+        (+ (dd.normal-twips (car x))
+           (dd.name-estimate-twips (cdr x))))
+    0))
+
+(defun dd.name-autotruncate (char-list patterns twips) ;; => char list
+  ;; Successively try applying patterns until the name is short enough
+  (declare (xargs :mode :program))
+  (if (consp patterns)
+      (if (<= (dd.name-estimate-twips char-list) twips)
+          char-list
+        (dd.name-autotruncate (dd.char-list-replace-char-list (car (car patterns)) (cdr (car patterns)) char-list)
+                              (cdr patterns)
+                              twips))
+    char-list))
+
+(defun dd.bldr-name (x twips) ;; => string
+  (declare (xargs :mode :program))
+  (let* ((name-chars      (dd.explode (ACL2::string-downcase (ACL2::symbol-name x))))
+         (erase-dashes    (dd.char-list-replace #\- #\Space name-chars))
+         (erase-opening-@ (if (equal (car erase-dashes) #\@)
+                              (cdr erase-dashes)
+                            erase-dashes))
+         (apply-pats      (dd.char-list-replace-patterns erase-opening-@ *dd.bldr-name-always-replace*))
+         (auto-shorten    (dd.name-autotruncate apply-pats *dd.bldr-name-maybe-replace* twips))
+         (fix-case        (cons (ACL2::char-upcase (car auto-shorten))
+                                (cdr auto-shorten))))
+    fix-case))
+
+
+
+(defun dd.extract-proofs-from-multipatterns (x) ;; => (proof path pat) list
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (equal (car (car x)) 'proof)
+          (cons (car x) (dd.extract-proofs-from-multipatterns (cdr x)))
+        (dd.extract-proofs-from-multipatterns (cdr x)))
+    nil))
+
+(defun dd.defderiv-latex-summary (from derive where) ;; => string
+  (declare (xargs :mode :program))
+  (let ((types (strip-firsts from)))
+    (if (and (not (consp where))
+             (not (memberp 'constant types)))
+        ;; This is a simple derivation involving only proofs, terms, and formulas
+        ;; which are not further restricted by where clauses and none of which are
+        ;; required to be constants.  We'll just build one of the table-style rules:
+        ;;  hyp1
+        ;;  ...
+        ;;  hypN
+        ;; --------------------
+        ;;  conclusion
+        (let* ((proof-tuples   (dd.extract-proofs-from-multipatterns from))
+               (proof-patterns (strip-thirds proof-tuples))
+               (boxed-hyps     (dd.latex-autobox-formulas proof-patterns *dd.max-summary-width*))
+               (boxed-concl    (dd.latex-autobox-formula derive *dd.max-summary-width*)))
+          (dd.cat "\\begin{tabular}{l}" *dd.nl*
+                  (if (consp proof-tuples)
+                      (dd.cat-separator-between-strings boxed-hyps (dd.cat " \\\\ " *dd.nl*))
+                    "")
+                  " \\\\ " *dd.nl*
+                  "\\hline" *dd.nl*
+                  boxed-concl *dd.nl*
+                  "\\end{tabular}" *dd.nl*))
+      "Bozo: Implement non-simple summaries")))
+
+(defun dd.find-last-derive (x) ;; => (@derive ...)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (equal (car x) '@derive)
+          (or (dd.find-last-derive (cdr x))
+              x)
+        (or (dd.find-last-derive (cdr x))
+            (dd.find-last-derive (car x))))
+    nil))
+
+(defun dd.get-deriv-lines (proof)
+  ;; We try to find the very last (@derive ...) in an object, which should be the most
+  ;; general one in a derivation.
+  (declare (xargs :mode :program))
+  (let ((derivation (dd.find-last-derive proof)))
+    (if (not derivation)
+        (ACL2::er hard 'dd.get-deriv-lines "Unable to find an @derive in the proof.~%")
+      (cdr derivation))))
+
+(defun dd.flatten (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (app (dd.flatten (car x))
+           (dd.flatten (cdr x)))
+    (list x)))
+
+(defun dd.intersection (x y)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (memberp (car x) y)
+          (cons (car x) (dd.intersection (cdr x) y))
+        (dd.intersection (cdr x) y))
+    nil))
+
+(defun dd.symbol-name-list (x) ;; => string list
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (cons (ACL2::string-downcase (ACL2::symbol-name (car x)))
+            (dd.symbol-name-list (cdr x)))
+    nil))
+
+(defun dd.latex-justification (justify names) ;; => string
+  (declare (xargs :mode :program))
+  (let* ((cross-refs  (remove-all nil (dd.intersection (dd.flatten (cdr justify)) names)))
+         (cross-text  (if cross-refs
+                          (dd.cat " " (dd.cat-separator-between-strings (dd.symbol-name-list cross-refs) ", "))
+                        ""))
+         (cross-text  (dd.name-autotruncate (dd.explode cross-text) *dd.cross-patterns* 0))
+         (cross-twips (dd.name-estimate-twips (dd.explode cross-text)))
+         (raw-name    (if (memberp (first justify) '(build.theorem build.axiom))
+                          ;; (build.axiom (axiom-blah-blah)) or (build.theorem (theorem-blah-blah))
+                          (car (second justify))
+                        (first justify)))
+         (bldr-name   (dd.bldr-name raw-name (- *dd.justify-width* cross-twips)))
+         (needs-linkp (not (memberp raw-name '(@given propositional-schema cut contraction expansion associativity
+                                                      instantiation functional-equality beta-reduction base-eval)))))
+    (if needs-linkp
+        (dd.cat "\\hyperlink{" (ACL2::string-downcase (ACL2::symbol-name raw-name)) "}{" bldr-name "}" cross-text)
+      (dd.cat bldr-name cross-text))))
+
+(defun dd.latex-deriv-line (line formula-width names) ;; => string
+  (declare (xargs :mode :program))
+  (let ((formula (first line))
+        (jusify  (second line))
+        (name    (third line)))
+    (dd.cat (dd.latex-autobox-formula formula formula-width)
+            " & "
+            (dd.latex-justification jusify names)
+            " & "
+            (if name
+                (dd.cat "(" (ACL2::string-downcase (ACL2::symbol-name name)) ")")
+              ""))))
+
+(defun dd.latex-deriv-lines (lines formula-width names) ;; => string
+  (declare (xargs :mode :program))
+  (if (consp lines)
+      (dd.cat (dd.latex-deriv-line (car lines) formula-width names)
+              (if (consp (cdr lines)) "" "\\qedhere")
+              " \\\\ " *dd.nl*
+              (dd.latex-deriv-lines (cdr lines) formula-width names))
+    ""))
+
+(defun dd.defderiv-latex-derivation (lines) ;; => string
+  (declare (xargs :mode :program))
+  (let* ((formulas      (strip-firsts lines))
+         (names         (strip-thirds lines))
+         (desired-width (dd.latex-formulas-max-desired-width formulas (- *dd.max-derive-line-width* *dd.overestimate-padding*)))
+         (derivs-width  (+ desired-width *dd.overestimate-padding*)))
+    (dd.latex-deriv-lines lines derivs-width names)))
+
+
+
+(defconst *dd.hypercommand-patterns*
+  (list (cons (dd.explode "build.") (dd.explode ""))
+        (cons (dd.explode ".")      (dd.explode ""))
+        (cons (dd.explode "-")      (dd.explode ""))
+        (cons (dd.explode "1")      (dd.explode "one"))
+        (cons (dd.explode "2")      (dd.explode "two"))
+        (cons (dd.explode "3")      (dd.explode "three"))
+        (cons (dd.explode "4")      (dd.explode "four"))
+        (cons (dd.explode "5")      (dd.explode "five"))
+        (cons (dd.explode "6")      (dd.explode "six"))
+        (cons (dd.explode "7")      (dd.explode "seven"))
+        (cons (dd.explode "8")      (dd.explode "eight"))
+        (cons (dd.explode "9")      (dd.explode "nine"))
+        (cons (dd.explode "0")      (dd.explode "zero"))))
+
+(defun dd.hypercommand (internal-name)
+  (declare (xargs :mode :program))
+  (dd.implode
+   (app (dd.explode "\\DR")
+        (STR::char-list-replace-patterns (dd.explode internal-name)
+                                         *dd.hypercommand-patterns*))))
+
+(defun dd.defderiv-latex (name from derive where proof minatbl ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state)
+           (ignore minatbl))
+  (let* ((internal-name (ACL2::string-downcase (ACL2::symbol-name name)))
+         (print-name    (dd.bldr-name name *dd.max-summary-width*))
+         (filename      (dd.cat "defderiv-" internal-name ".tex"))
+         (cost          (cdr (lookup name (dd.get-builder-costs (ACL2::w ACL2::state)))))
+         (derivation    (dd.cat "\\begin{derivedrule}{\\hypertarget{" internal-name "}" "{" print-name "}}" *dd.nl*
+                                "\\index{Derived rules!" print-name "}" *dd.nl*
+
+                                ;; Important: keep this all one one line (i.e., no *dd.nl*)
+                                "%\\newcommand{" (dd.hypercommand internal-name) "}[1][" print-name "]"
+                                   "{\\hyperlink{" internal-name "}{#1}}"
+                                ;; /Important
+
+                                *dd.nl* *dd.nl*
+                                (dd.defderiv-latex-summary from derive where)
+                                "\\begin{proof}[Derivation]"
+                                (if cost
+                                    (dd.cat " (" (dd.implode (ACL2::explode-atom cost 10)) ")")
+                                  "")
+                                ;"\\mbox{} "
+                                *dd.nl* *dd.nl*
+                                "\\noindent "
+                                "\\begin{longtable}{lll}" *dd.nl*
+                                (dd.defderiv-latex-derivation (dd.get-deriv-lines proof)) *dd.nl*
+                                "\\end{longtable}"
+                                "\\end{proof}" *dd.nl*
+                                "\\bigskip" *dd.nl*
+                                "\\end{derivedrule}" *dd.nl* *dd.nl*))
+         (sfilename     (dd.cat "defsummary-" internal-name ".tex"))
+         (scontents     (dd.cat "\\begin{derivedrule}{\\hyperlink{" internal-name "}{" print-name "}}" *dd.nl*
+                                "\\index{Derived rules!" print-name "}" *dd.nl* *dd.nl*
+                                (dd.defderiv-latex-summary from derive where)
+                                "\\end{derivedrule}" *dd.nl* *dd.nl*)))
+    (ACL2::mv-let (channel ACL2::state)
+                  (ACL2::open-output-channel! (dd.cat "autodoc/" filename) :character ACL2::state)
+                  (let* ((ACL2::state (ACL2::princ$ derivation channel ACL2::state))
+                         (ACL2::state (ACL2::close-output-channel channel ACL2::state))
+                         (ACL2::state (dd.write-fn (dd.cat "\\input{" filename "}" *dd.nl*) ACL2::state)))
+                    (ACL2::mv-let (channel ACL2::state)
+                                  (ACL2::open-output-channel! (dd.cat "autodoc/" sfilename) :character ACL2::state)
+                                  (let* ((ACL2::state (ACL2::princ$ scontents channel ACL2::state))
+                                         (ACL2::state (ACL2::close-output-channel channel ACL2::state)))
+                                    ACL2::state))))))
+
+
+(defmacro defderiv (name &key from derive where proof minatbl highlevel-override)
+  `(ACL2::progn
+    ;; Axiom computation for the builder-axioms table.
+    (ACL2::table milawa 'builder-axioms
+                 (update ',name
+                         (app (dd.all-deriv-local-axioms ',proof)
+                              (dd.all-deriv-inherited-axioms ',proof ACL2::world))
+                         (dd.get-builder-axioms ACL2::world)))
+    ;; Theorem computation for builder-theorems table.
+    (ACL2::table milawa 'builder-theorems
+                 (update ',name
+                         (app (dd.all-deriv-local-theorems ',proof)
+                              (dd.all-deriv-inherited-theorems ',proof ACL2::world))
+                         (dd.get-builder-theorems ACL2::world)))
+    ;; Cost computation for builder-costs table.
+    (ACL2::table milawa 'builder-costs
+                 (update ',name
+                         (dd.estimate-cost-of-lines (dd.get-deriv-lines ',proof) ACL2::world)
+                         (dd.get-builder-costs ACL2::world)))
+    ;; Builder introduction
+    (ACL2::make-event
+     (dd.defderiv-fn ',name ',from ',derive ',where ',proof ',minatbl ',highlevel-override (ACL2::w ACL2::state)))
+    ;; LaTeX printing
+    (local (ACL2::make-event
+            (let ((ACL2::state (dd.defderiv-latex ',name ',from ',derive ',where ',proof ',minatbl ACL2::state)))
+              (ACL2::mv nil '(ACL2::value-triple ',name) ACL2::state))))))
+
+
+
+
+(defun dd.deftheorem-fn (name derive proof minatbl wrld)
+  (declare (xargs :mode :program))
+  (let* ((name-proof     (ACL2::mksym name '-proof))
+         (local-axioms   (dd.all-deriv-local-axioms proof))
+         (local-theorems (dd.all-deriv-local-theorems proof))
+         (all-axioms     (app local-axioms (dd.all-deriv-inherited-axioms proof wrld)))
+         (all-theorems   (app local-theorems (dd.all-deriv-inherited-theorems proof wrld))))
+    (cond ((dd.context-gather proof)
+           (ACL2::er ACL2::hard 'deftheorem
+                     "deftheorem proof illegally mentions context variables: ~x0~%"
+                     (dd.context-gather proof)))
+          (t
+           `(encapsulate
+             ()
+             (ACL2::set-inhibit-warnings "theory")
+
+             (local (in-theory (ACL2::executable-counterpart-theory :here)))
+
+             (defund@ ,name ()
+               (declare (xargs :guard t))
+               (@formula ,derive))
+
+             (defund@ ,name-proof ()
+               (declare (xargs :guard t))
+               ,proof)
+
+             (defthm ,(ACL2::mksym 'logic.formulap-of- name)
+               (equal (logic.formulap (,name))
+                      t))
+
+             (defthm ,(ACL2::mksym 'conclusion-of- name-proof)
+               (equal (logic.conclusion (,name-proof))
+                      (,name)))
+
+             (defthm ,(ACL2::mksym 'logic.proofp-of- name-proof)
+               (equal (logic.proofp (,name-proof)
+                                    (list ,@all-axioms)
+                                    (list ,@all-theorems)
+                                    ',minatbl)
+                      t))
+
+             (in-theory (disable (:executable-counterpart ,name)
+                                 (:executable-counterpart ,name-proof))))))))
+
+
+(defun dd.deftheorem-latex (name derive proof minatbl ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state)
+           (ignore minatbl))
+  (let* ((internal-name (ACL2::string-downcase (ACL2::symbol-name name)))
+         (print-name    (dd.bldr-name name *dd.max-summary-width*))
+         (print-name    (if (prefixp (ACL2::coerce "Theorem " 'ACL2::list) print-name)
+                            (let ((chop (restn (ACL2::length "Theorem ") print-name)))
+                              (cons (ACL2::char-upcase (car chop))
+                                    (cdr chop)))
+                          print-name))
+         (filename      (dd.cat internal-name ".tex"))
+         (sfilename     (dd.cat "summary-" internal-name ".tex"))
+         (derivation    (dd.cat "\\begin{formalthm}{\\hypertarget{" internal-name "}" "{" print-name "}}" *dd.nl*
+                                "\\index{Formal theorems!" print-name "}" *dd.nl*
+                                ;"\\mbox{} \\\\"
+                                *dd.nl* *dd.nl*
+                                (dd.latex-autobox-formula derive *dd.max-summary-width*)
+                                "\\begin{proof}[Proof]"
+                                ;"\\mbox{} "
+                                *dd.nl* *dd.nl*
+                                "\\noindent "
+                                "\\begin{longtable}{lll}" *dd.nl*
+                                (dd.defderiv-latex-derivation (dd.get-deriv-lines proof)) *dd.nl*
+                                "\\end{longtable}"
+                                "\\end{proof}" *dd.nl*
+                                "\\bigskip" *dd.nl*
+                                "\\end{formalthm}" *dd.nl* *dd.nl*))
+         (scontents     (dd.cat "\\begin{formalthm}{\\hyperlink{" internal-name "}" "{" print-name "}}" *dd.nl*
+                                "\\index{Formal theorems!" print-name "}" *dd.nl* *dd.nl*
+                                (dd.latex-autobox-formula derive *dd.max-summary-width*) *dd.nl* *dd.nl*
+                                "\\end{formalthm}" *dd.nl* *dd.nl* *dd.nl*)))
+    (ACL2::mv-let (channel ACL2::state)
+                  (ACL2::open-output-channel! (dd.cat "autodoc/" filename) :character ACL2::state)
+                  (let* ((ACL2::state (ACL2::princ$ derivation channel ACL2::state))
+                         (ACL2::state (ACL2::close-output-channel channel ACL2::state))
+                         (ACL2::state (dd.write-fn (dd.cat "\\input{" filename "}" *dd.nl*) ACL2::state)))
+                    (ACL2::mv-let (channel ACL2::state)
+                                  (ACL2::open-output-channel! (dd.cat "autodoc/" sfilename) :character ACL2::state)
+                                  (let* ((ACL2::state (ACL2::princ$ scontents channel ACL2::state))
+                                         (ACL2::state (ACL2::close-output-channel channel ACL2::state)))
+                                    ACL2::state))))))
+
+(defun dd.deftheorem-dump (name full-proof ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((internal-name (ACL2::string-downcase (ACL2::symbol-name name)))
+         (filename      (dd.cat "proofs/" internal-name ".proof")))
+    (ACL2::mv-let (channel ACL2::state)
+                  (ACL2::open-output-channel! filename :character ACL2::state)
+     (ACL2::mv-let (col ACL2::state)
+                   (ACL2::fmt1! "~f0~%" (list (cons #\0 full-proof)) 0 channel ACL2::state nil)
+                   (declare (ignore col))
+       (ACL2::close-output-channel channel ACL2::state)))))
+
+;; Every time we call deftheorem we store a (thmname . proof-function-name)
+;; pair into the defthm registry table.  We use this table to dump out all the
+;; theorems we've proven at the start of bootstrapping.
+
+(ACL2::table milawa 'deftheorem-registry nil)
+
+(defun dd.get-deftheorem-registry (wrld)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'deftheorem-registry (ACL2::table-alist 'milawa wrld))))
+
+(defmacro deftheorem (name &key derive proof minatbl)
+  `(ACL2::progn
+    ;; Theorem Introduction
+    (ACL2::make-event
+     (dd.deftheorem-fn ',name ',derive ',proof ',minatbl (ACL2::w ACL2::state)))
+    ;; LaTeX Printing of the Derivation
+    (local (ACL2::make-event
+            (let ((ACL2::state (dd.deftheorem-latex ',name ',derive ',proof ',minatbl ACL2::state)))
+              (ACL2::mv nil '(ACL2::value-triple ',name) ACL2::state))))
+    ;; Print the proof to a file
+    (local (ACL2::make-event
+            (let ((ACL2::state (dd.deftheorem-dump ',name ,(list (ACL2::mksym name '-proof)) ACL2::state)))
+              (ACL2::mv nil '(ACL2::value-triple ',name) ACL2::state))))
+    ;; Write the entry to the table.
+    (ACL2::table milawa 'deftheorem-registry
+                 (update ',name ',(ACL2::mksym name '-proof)
+                         (dd.get-deftheorem-registry ACL2::world)))))
+
+
+
+
+
+
+(ACL2::table milawa 'defax-table nil)
+
+(defun dd.get-defax-table (wrld)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'defax-table (ACL2::table-alist 'milawa wrld))))
+
+
+(mutual-recursion
+ (defun dd.term-functions-and-arities (x acc)
+   (declare (xargs :mode :program))
+   (if (or (equal x t)
+           (equal x nil)
+           (natp x)
+           (logic.constantp x)
+           (logic.variablep x)
+           (not (consp x))
+           (equal (first x) '?))
+       acc
+     (let ((arity (len (cdr x)))
+           (entry (lookup (first x) acc)))
+       (if entry
+           (if (equal (cdr entry) arity)
+               (dd.term-list-functions-and-arities (cdr x) acc)
+             (ACL2::er hard 'dd.term-functions-and-arities "Arity mismatch for ~x0.~%" (first x)))
+         (dd.term-list-functions-and-arities (cdr x) (update (first x) arity acc))))))
+ (defun dd.term-list-functions-and-arities (x acc)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (dd.term-list-functions-and-arities
+        (cdr x)
+        (dd.term-functions-and-arities (car x) acc))
+     acc)))
+
+(defun dd.formula-functions-and-arities (x acc)
+  (declare (xargs :mode :program))
+  (if (not (consp x))
+      acc
+    (cond ((or (equal (first x) '=)
+               (equal (first x) '!=))
+           (dd.term-functions-and-arities (second x)
+                                          (dd.term-functions-and-arities (third x) acc)))
+          ((equal (first x) '!)
+           (dd.formula-functions-and-arities (second x) acc))
+          ((equal (first x) 'v)
+           (dd.formula-functions-and-arities (second x)
+                                             (dd.formula-functions-and-arities (third x) acc)))
+          (t nil))))
+
+(defun dd.extract-minatbl-from-formula (x)
+  (declare (xargs :mode :program))
+  (remove-duplicates (dd.formula-functions-and-arities x nil)))
+
+
+
+
+(defun defax-fn (name body)
+  (declare (xargs :mode :program))
+  (let ((atbl-checks (dd.minatbl-to-checks (dd.extract-minatbl-from-formula body))))
+    `(encapsulate
+      ()
+      (defund@ ,name ()
+        (declare (xargs :guard t))
+        (@formula ,body))
+
+      (in-theory (disable (:executable-counterpart ,name)))
+
+      (defthm ,(ACL2::mksym 'logic.formulap-of- name)
+        (equal (logic.formulap (,name))
+               t)
+      :hints(("Goal" :in-theory (enable ,name))))
+
+      (defthm ,(ACL2::mksym 'blah-logic.formula-atblp-of- name)
+        (implies (force (and ,@atbl-checks))
+                 (equal (logic.formula-atblp (,name) atbl)
+                        t))
+        :hints(("Goal" :in-theory (enable ,name)))))))
+
+(defmacro defax (name body)
+  `(ACL2::progn
+    (ACL2::make-event (defax-fn ',name ',body))
+    (ACL2::table milawa 'defax-table
+                 (cons ',name (dd.get-defax-table ACL2::world)))))
diff -Nru acl2-6.2/books/milawa/ACL2/defderiv/latex-magic.lisp acl2-6.3/books/milawa/ACL2/defderiv/latex-magic.lisp
--- acl2-6.2/books/milawa/ACL2/defderiv/latex-magic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/defderiv/latex-magic.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,178 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../utilities/top")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; LaTeX doesn't do a good job of automatically splitting formulas across
+;; lines.  Probably they think everyone is typesetting their own formulas by
+;; hand and so there isn't much need.  But we want to typeset formulas that
+;; occur in patterns, which may need to span multiple lines.  So, we want to be
+;; able to automatically split up our formulas across lines.
+;;
+;; To do this in an acceptable way, we need to be able to tell how wide parts
+;; of a formula will be.  This is tricky since there are variable-width fonts,
+;; special symbols, and subscripts involved.
+;;
+;; Apparently the LaTeX fonts come with tfm files that have this sort of
+;; information in them, but I don't know much about the LaTeX internals and I
+;; didn't find much information about how to extract this sort of data.  So,
+;; I am eyeballing it.
+;;
+;; I used xdvi and zoomed in as far as it would go, then measured ten
+;; characters wide in the various fonts with kruler to come up with the below
+;; estimates.  I also measured a 1-inch horizontal line, and it was 600 pixels.
+;; Ten such lines would be 6000 pixels, so each width unit in these tables is
+;; about 1/6000 of an inch.  I call these units "twips" even though that term
+;; means something else in typography.
+;;
+;; There's certainly some error, but hopefully because of the zooming it won't
+;; be off by much.  And, it only needs to be close.
+
+(defconst *dd.twips-per-inch*  6000)
+
+(defun dd.inches-to-twips (x)
+  (declare (xargs :mode :program :guard (ACL2::rationalp x)))
+  (ACL2::round (ACL2::* x *dd.twips-per-inch*) 1))
+
+(defun dd.twips-to-inches (x)
+  ;; We approximate to 1/100 of an inch and return the string "?.??in"
+  (declare (xargs :mode :program :guard (natp x)))
+  (let* ((hundreths (ACL2::floor x 60))
+         (units     (ACL2::floor hundreths 100))
+         (remainder (- hundreths (ACL2::* 100 units))))
+    (ACL2::concatenate 'ACL2::string
+                       (ACL2::coerce (ACL2::explode-atom units 10) 'ACL2::string)
+                       "."
+                       (ACL2::coerce (ACL2::explode-atom remainder 10) 'ACL2::string)
+                       "in")))
+
+(defconst *dd.tt-width*    510)  ;; any \texttt{...} character
+(defconst *dd.quad-width*  960)  ;; a \quad
+(defconst *dd.qquad-width* 1920) ;; a \qquad
+(defconst *dd.vee-width*   1130) ;; a \vee and its surrounding space
+(defconst *dd.equal-width* 1340) ;; an = and its surrounding space
+(defconst *dd.neq-width*   1340) ;; an \neq and its surrounding space
+(defconst *dd.neg-width*   655)  ;; a \neg and its surrounding space
+(defconst *dd.paren-width* 370)  ;; a ( or ) in regular font
+
+;; These approximate the widths of regular LaTeX characters
+(defconst *dd.normal-widths*
+  '((#\a . 490) (#\b . 540) (#\c . 430) (#\d . 540) (#\e . 430)
+    (#\f . 290) (#\g . 490) (#\h . 540) (#\i . 270) (#\j . 290)
+    (#\k . 510) (#\l . 270) (#\m . 810) (#\n . 540) (#\o . 510)
+    (#\p . 540) (#\q . 515) (#\r . 375) (#\s . 380) (#\t . 375)
+    (#\u . 540) (#\v . 515) (#\w . 705) (#\x . 515) (#\y . 515)
+    (#\z . 430)
+    (#\A . 730) (#\B . 685) (#\C . 700) (#\D . 740) (#\E . 660)
+    (#\F . 635) (#\G . 760) (#\H . 730) (#\I . 375) (#\J . 500)
+    (#\K . 755) (#\L . 605) (#\M . 890) (#\N . 730) (#\O . 755)
+    (#\P . 660) (#\Q . 755) (#\R . 720) (#\S . 535) (#\T . 705)
+    (#\U . 730) (#\V . 730) (#\W . 1005) (#\X . 725) (#\Y . 730)
+    (#\Z . 890)
+    (#\1 . 490) (#\2 . 500) (#\3 . 500) (#\4 . 490) (#\5 . 500)
+    (#\6 . 500) (#\7 . 505) (#\8 . 495) (#\9 . 495) (#\0 . 495)
+    (#\Space . 325) (#\* . 480) (#\. . 270) (#\, . 270)
+    ))
+
+;; These approximate the widths of \mathit{...} characters
+(defconst *dd.mathit-normal-widths*
+  '((#\a . 500) (#\b . 440) (#\c . 400) (#\d . 500) (#\e . 400)
+    (#\f . 320) (#\g . 450) (#\h . 500) (#\i . 300) (#\j . 310)
+    (#\k . 450) (#\l . 300) (#\m . 800) (#\n . 550) (#\o . 450)
+    (#\p . 500) (#\q . 450) (#\r . 410) (#\s . 400) (#\t . 330)
+    (#\u . 530) (#\v . 450) (#\w . 650) (#\x . 450) (#\y . 470)
+    (#\z . 400)
+    (#\A . 710) (#\B . 690) (#\C . 700) (#\D . 730) (#\E . 660)
+    (#\F . 640) (#\G . 755) (#\H . 730) (#\I . 380) (#\J . 520)
+    (#\K . 755) (#\L . 610) (#\M . 880) (#\N . 730) (#\O . 740)
+    (#\P . 660) (#\Q . 740) (#\R . 705) (#\S . 550) (#\T . 700)
+    (#\U . 730) (#\V . 730) (#\W . 980) (#\X . 730) (#\Y . 735)
+    (#\Z . 600)
+    (#\1 . 490) (#\2 . 500) (#\3 . 500) (#\4 . 490) (#\5 . 500)
+    (#\6 . 500) (#\7 . 505) (#\8 . 495) (#\9 . 495) (#\0 . 495)
+    (#\( . 370) (#\) . 370)))
+
+;; These approximate the widths of subscript characters within
+;; a \mathit{...}
+(defconst *dd.mathit-subscript-widths*
+  '((#\a . 360) (#\b . 320) (#\c . 290) (#\d . 360) (#\e . 295)
+    (#\f . 230) (#\g . 330) (#\h . 360) (#\i . 215) (#\j . 220)
+    (#\k . 330) (#\l . 215) (#\m . 580) (#\n . 400) (#\o . 325)
+    (#\p . 360) (#\q . 325) (#\r . 300) (#\s . 285) (#\t . 235)
+    (#\u . 380) (#\v . 325) (#\w . 465) (#\x . 330) (#\y . 340)
+    (#\z . 290)
+    (#\A . 520) (#\B . 500) (#\C . 510) (#\D . 535) (#\E . 480)
+    (#\F . 460) (#\G . 545) (#\H . 535) (#\I . 280) (#\J . 375)
+    (#\K . 550) (#\L . 450) (#\M . 640) (#\N . 530) (#\O . 540)
+    (#\P . 480) (#\Q . 540) (#\R . 520) (#\S . 400) (#\T . 510)
+    (#\U . 530) (#\V . 535) (#\W . 715) (#\X . 530) (#\Y . 535)
+    (#\Z . 440)
+    (#\1 . 355) (#\2 . 360) (#\3 . 360) (#\4 . 355) (#\5 . 360)
+    (#\6 . 360) (#\7 . 367) (#\8 . 360) (#\9 . 360) (#\0 . 360)
+    (#\( . 270) (#\) . 270)))
+
+(defun dd.tt-twips (len)
+  (declare (xargs :mode :program))
+  (ACL2::* len *dd.tt-width*))
+
+(defun dd.normal-twips (char)
+  (declare (xargs :mode :program))
+  (let ((lookup (lookup char *dd.normal-widths*)))
+    (if lookup
+        (cdr lookup)
+      (ACL2::er hard 'dd.normal-twips
+                "No width known for normal character: ~x0~%" char))))
+
+(defun dd.mathit-twips (char)
+  (declare (xargs :mode :program))
+  (let ((lookup (lookup char *dd.mathit-normal-widths*)))
+    (if lookup
+        (cdr lookup)
+      (ACL2::er hard 'dd.mathit-twips
+                "No width known for mathit character: ~x0~%" char))))
+
+(defun dd.mathit-subscript-twips (char)
+  (declare (xargs :mode :program))
+  (let ((lookup (lookup char *dd.mathit-subscript-widths*)))
+    (if lookup
+        (cdr lookup)
+      (ACL2::er hard 'dd.mathit-subscript-twips
+                "No width known for mathit subscript character: ~x0~%" char))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/defderiv/latex.lisp acl2-6.3/books/milawa/ACL2/defderiv/latex.lisp
--- acl2-6.2/books/milawa/ACL2/defderiv/latex.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/defderiv/latex.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,579 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "context")
+(include-book "latex-magic")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(ACL2::defttag ACL2::open-output-channel!)
+
+
+(defconst *dd.nl*
+  (ACL2::coerce '(#\Newline) 'ACL2::string))
+
+(defmacro dd.cat (&rest strings)
+  `(ACL2::concatenate 'ACL2::string ,@strings))
+
+(defun dd.implode (char-list) ;; => string
+  (declare (xargs :mode :program))
+  (ACL2::coerce char-list 'ACL2::string))
+
+(defun dd.explode (string) ;; => char-list
+  (declare (xargs :mode :program))
+  (ACL2::coerce string 'ACL2::list))
+
+
+
+(defun dd.safe-get-global (x ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (if (ACL2::boundp-global x ACL2::state)
+      (ACL2::f-get-global x ACL2::state)
+    nil))
+
+
+;; We provide "persistent output" that can span many events.  We can open a
+;; channel with dd.open, and it stays open until we call dd.close or dd.open
+;; upon a new channel.
+
+(defun dd.close-fn (ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let ((channel (dd.safe-get-global 'dd.channel ACL2::state)))
+    (if channel
+        (let ((ACL2::state (ACL2::close-output-channel channel ACL2::state)))
+          (ACL2::assign dd.channel nil))
+      (ACL2::value :invisible))))
+
+(defmacro dd.close ()
+  `(ACL2::progn
+    (ACL2::make-event
+     (ACL2::mv-let (er val ACL2::state)
+                   (dd.close-fn ACL2::state)
+                   (declare (ignore er))
+                   (ACL2::mv nil (list 'ACL2::value-triple (list 'quote val)) ACL2::state)))))
+
+(defun dd.open-fn (file ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  ;; Close the previous file if one is open
+  (ACL2::mv-let (err val ACL2::state)
+                (dd.close-fn ACL2::state)
+                (declare (ignore err val))
+   ;; Open the new file
+   (ACL2::mv-let (channel ACL2::state)
+                 (ACL2::open-output-channel! (dd.cat "autodoc/" file) :character ACL2::state)
+                 (ACL2::assign dd.channel channel))))
+
+(defmacro dd.open (file)
+  `(ACL2::progn
+    (ACL2::make-event
+     (ACL2::mv-let (er val ACL2::state)
+                   (dd.open-fn ,file ACL2::state)
+                   (declare (ignore er))
+                   (ACL2::mv nil (list 'ACL2::value-triple (list 'quote val)) ACL2::state)))))
+
+(defun dd.write-fn (text ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let ((channel (dd.safe-get-global 'dd.channel ACL2::state)))
+    (if channel
+        (ACL2::princ$ text channel ACL2::state)
+      (let ((err (ACL2::cw "Warning [dd.write]: not writing since no channel is open!~%")))
+        (declare (ignore err))
+        ACL2::state))))
+
+(defmacro dd.write (&rest text)
+  `(ACL2::progn
+    (ACL2::make-event
+     (let ((ACL2::state (dd.write-fn (dd.cat ,@text *dd.nl* *dd.nl*) ACL2::state)))
+       (ACL2::mv nil '(ACL2::value-triple '<dd.text>) ACL2::state)))))
+
+(defun dd.section-fn (name ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (dd.write-fn (dd.cat "\\section{" name "}" *dd.nl* *dd.nl*) ACL2::state))
+
+(defmacro dd.section (name)
+  `(ACL2::progn
+    (ACL2::make-event (let ((ACL2::state (dd.section-fn ,name ACL2::state)))
+                        (ACL2::mv nil '(ACL2::value-triple '<dd.section>) ACL2::state)))))
+
+(defun dd.subsection-fn (name ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (dd.write-fn (dd.cat "\\subsection{" name "}" *dd.nl* *dd.nl*) ACL2::state))
+
+(defmacro dd.subsection (name)
+  `(ACL2::progn
+    (ACL2::make-event (let ((ACL2::state (dd.subsection-fn ,name ACL2::state)))
+                        (ACL2::mv nil '(ACL2::value-triple '<dd.subsection>) ACL2::state)))))
+
+
+
+(defun dd.aux-latex-metavariable (x subscriptp) ;; => (twips . char-list)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let* ((remaining (dd.aux-latex-metavariable (cdr x) (or subscriptp (equal (car x) #\_))))
+             (rem-twips (car remaining))
+             (rem-text  (cdr remaining)))
+        (if (equal (car x) #\_)
+            (if subscriptp
+                (ACL2::er hard 'dd.aux-latex-metavariable "Found two subscripts in metavariable.~%~x0~%" x)
+              (cons rem-twips
+                    (cons #\_ (cons #\{ (app rem-text (list #\}))))))
+          (let ((car-twips (if subscriptp
+                               (dd.mathit-subscript-twips (car x))
+                             (dd.mathit-twips (car x)))))
+            (cons (+ car-twips rem-twips)
+                  (cons (car x) rem-text)))))
+    (cons 0 nil)))
+
+(defun dd.latex-term-metavariable (x) ;; => (twips . string)
+  (declare (xargs :mode :program))
+  (let* ((twips/char-list (dd.aux-latex-metavariable (dd.explode (ACL2::string-downcase (ACL2::symbol-name x))) nil))
+         (twips           (car twips/char-list))
+         (char-list       (cdr twips/char-list)))
+    (cons twips (dd.cat "\\mathit{" (dd.implode char-list) "}"))))
+
+(defun dd.latex-formula-metavariable (x) ;; => (twips . string)
+  (declare (xargs :mode :program))
+  (let* ((twips/char-list (dd.aux-latex-metavariable (dd.explode (ACL2::string-upcase (ACL2::symbol-name x))) nil))
+         (twips      (car twips/char-list))
+         (char-list  (cdr twips/char-list)))
+    (cons twips (dd.cat "\\mathit{" (dd.implode char-list) "}"))))
+
+(defun dd.latex-object-variable (x) ;; => (twips . string)
+  (declare (xargs :mode :program))
+  (let ((text (ACL2::string-downcase (ACL2::symbol-name x))))
+    (cons (dd.tt-twips (ACL2::length text))
+          (dd.cat "\\Token{" text "}"))))
+
+(defun dd.aux-latex-constant (x) ;; => string
+  (declare (xargs :mode :program))
+  (cond ((natp x)
+         (dd.implode (ACL2::explode-atom x 10)))
+        ((symbolp x)
+         (ACL2::string-downcase (ACL2::symbol-name x)))
+        (t
+         (dd.cat "(" (dd.aux-latex-constant (car x)) " . " (dd.aux-latex-constant (cdr x)) ")"))))
+
+(defun dd.latex-constant (x) ;; => (twips . string)
+  (declare (xargs :mode :program))
+  (let* ((value (cond ((logic.constantp x)
+                       (logic.unquote x))
+                      ((or (equal x t)
+                           (equal x nil)
+                           (natp x))
+                       x)
+                      (t
+                       (ACL2::er hard 'dd.latex-constant "Bad input ~x0.~%" x))))
+         (text (if (or (equal value t)
+                       (equal value nil)
+                       (natp value))
+                   ;; No quote is necessary
+                   (dd.aux-latex-constant value)
+                 ;; Insert a quote character
+                 (dd.cat "'" (dd.aux-latex-constant value)))))
+    (cons (dd.tt-twips (ACL2::length text))
+          (dd.cat "\\Token{" text "}"))))
+
+(mutual-recursion
+ (defun dd.latex-term (x) ;; => (twips . string)
+   (declare (xargs :mode :program))
+   (cond ((or (equal x t)
+              (equal x nil)
+              (natp x)
+              (logic.constantp x))
+          (dd.latex-constant x))
+         ((logic.variablep x)
+          (dd.latex-object-variable x))
+         ((consp x)
+          (if (equal (first x) '?)
+              (dd.latex-term-metavariable (second x))
+            (let ((fn    (ACL2::string-downcase (ACL2::symbol-name (first x)))))
+              (if (consp (cdr x))
+                  (let* ((args-twips/text (dd.latex-term-list (cdr x)))
+                         (args-twips      (car args-twips/text))
+                         (args-text       (cdr args-twips/text)))
+                    (cons (+ args-twips (dd.tt-twips (+ (ACL2::length fn) 3)))  ;; name, opening space, and two parens
+                          (dd.cat "\\Token{(" fn " }" args-text "\\RP")))
+                ;; Else there are no args
+                (cons (dd.tt-twips (+ (ACL2::length fn) 2))  ;; name and two parens
+                      (dd.cat "\\Token{(" fn ")}"))))))
+         (t
+          (ACL2::er hard 'dd.latex-term "Bad input: ~x0~%" x))))
+ (defun dd.latex-term-list (x) ;; => (twips . string)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (let* ((first-twips/text (dd.latex-term (car x)))
+              (first-twips      (car first-twips/text))
+              (first-text       (cdr first-twips/text)))
+         (if (consp (cdr x))
+             (let* ((rest-twips/text (dd.latex-term-list (cdr x)))
+                    (rest-twips      (car rest-twips/text))
+                    (rest-text       (cdr rest-twips/text)))
+               (cons (+ first-twips (+ (dd.tt-twips 1) rest-twips))
+                     (dd.cat first-text "\\SP" rest-text)))
+           first-twips/text))
+     (cons 0 ""))))
+
+
+
+;; We're now about to develop our formula layout algorithm.  It's a bit messy.
+;; To start, we're going to prepare the formula for layout.  We generate a list
+;; of (twips . text) pairs for the subcomponents of the formula.  We eventually
+;; need to combine all these pairs into a single string by adding appropriate
+;; newlines.
+;;
+;; To help ourselves out, we also add layout hints, so the resulting list will
+;; actually have these pairs and also some numbers.  The numbers indicate our
+;; willingness to split the formula at this point in the list.  The depth
+;; should be seeded at 1 to begin and is used to encourage splitting on top
+;; level formulas instead of interior subformulas.
+
+(defun dd.aux-latex-formula (x depth)
+  (declare (xargs :mode :program))
+  (cond ((logic.variablep x)
+         (list (dd.latex-formula-metavariable x)))
+        ((equal (first x) '=)
+         (list (dd.latex-term (second x))
+               (+ 4 depth)                        ;; we are willing but not eager to split on =
+               (cons *dd.equal-width* " = ")
+               (dd.latex-term (third x))))
+        ((equal (first x) '!=)
+         (list (dd.latex-term (second x))
+               (+ 4 depth)                        ;; we are willing but not eager to split on !=
+               (cons *dd.neq-width* " \\neq ")
+               (dd.latex-term (third x))))
+        ((equal (first x) '!)
+         (cond ((equal (first (second x)) '=)
+                ;; Collapse (! (= lhs rhs)) into (!= lhs rhs)
+                (dd.aux-latex-formula (list '!= (second (second x)) (third (second x))) depth))
+               ((equal (first (second x)) '!)
+                ;; Print (! (! A)) as !!A with no extra parens
+                (list* (cons *dd.neg-width* " \\neg ")
+                       (dd.aux-latex-formula (second x) (+ 3 depth))))
+               ((logic.variablep (second x))
+                ;; Write !A instead of !(A) for formula metavariables
+                (list* (cons *dd.neg-width* " \\neg ")
+                       (dd.aux-latex-formula (second x) (+ 3 depth))))
+               (t
+                ;; Write parens when we have !(a = b) and !(A v B) in parens
+                (list* (cons *dd.neg-width* " \\neg ")
+                       (cons *dd.paren-width* "(")
+                       (app (dd.aux-latex-formula (second x) (+ 3 depth))
+                            (list (cons *dd.paren-width* ")")))))))
+        ((equal (first x) 'v)
+         (if (equal (first (second x)) 'v)
+             ;; Put parens when we have (A v B) v C
+             (list* (cons *dd.paren-width* "(")
+                    (app (dd.aux-latex-formula (second x) (+ 2 depth))
+                         (list* (cons *dd.paren-width* ")")
+                                depth                                   ;; preferred split point
+                                (cons *dd.vee-width* " \\vee ")
+                                (dd.aux-latex-formula (third x) (+ 1 depth)))))
+           ;; Don't insert parens otherwise
+           (app (dd.aux-latex-formula (second x) (+ 2 depth))
+                (list* depth                                            ;; preferred split point
+                       (cons *dd.vee-width* " \\vee ")
+                       (dd.aux-latex-formula (third x) (+ 1 depth))))))
+        (t
+         (ACL2::er hard 'dd.aux-latex-formula "Invalid formula pattern ~x0~%" x))))
+
+
+
+;; Ideally, every formula wants to be laid out on a single line.  We can
+;; estimate how much space this would take just by summing up the twips in the
+;; list.  Since the car of a natural is zero, the layout hints don't get in the
+;; way of the computation.
+
+(defun dd.max-list (x) ;; => nat
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (max (car x)
+           (dd.max-list (cdr x)))
+    0))
+
+(defun dd.sum-list (x) ;; => nat
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (+ (car x)
+         (dd.sum-list (cdr x)))
+    0))
+
+(defun dd.latex-formula-desired-width (formula) ;; => twips
+  (declare (xargs :mode :program))
+  (let ((parse (dd.aux-latex-formula formula 1)))
+    (dd.sum-list (strip-firsts parse))))
+
+(defun dd.latex-formulas-max-desired-width (formulas max-length) ;; => twips
+  (declare (xargs :mode :program))
+  (if (consp formulas)
+      (let ((desired-car-width (dd.latex-formula-desired-width (car formulas)))
+            (desired-cdr-width (dd.latex-formulas-max-desired-width (cdr formulas) max-length)))
+        (min max-length
+             (max desired-car-width desired-cdr-width)))
+    0))
+
+
+
+;; Before we begin our layout algorithm, we need some auxilliary notions of
+;; BRICKS, ROWS, and LAYOUTS.
+;;
+;; BRICKS are formed by extending the (twips . text) pairs above with a badness
+;; field, forming tuples of the form (badness twips text).  The badness
+;; indicates how unhappy we are to split after this brick, and is already given
+;; to us for some of the pairs in the layout hints that were added to the list.
+;; All the other bricks get a badness of 100 + whatever the worst badness was
+;; anywhere in the list.
+
+(defun dd.brickp (x)
+  (declare (xargs :mode :program))
+  (and (tuplep 3 x)
+       (natp (first x))               ;; badness
+       (natp (second x))              ;; twips
+       (ACL2::stringp (third x))))    ;; text
+
+(defun dd.brick-listp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (dd.brickp (car x))
+           (dd.brick-listp (cdr x)))
+    t))
+
+(defun dd.reversed-brick-list-text (bricks acc) ;; => string
+  (declare (xargs :mode :program))
+  (if (consp bricks)
+      (dd.reversed-brick-list-text (cdr bricks)
+                                   (dd.cat (third (car bricks)) acc))
+    acc))
+
+
+;; A ROW contains a list of bricks and has its own width and badness.  Its
+;; width should be less than the desired width and its badness is equal to the
+;; badness of its last brick.  We represent a row as a (badness, width,
+;; reversed-bricks) tuple.
+
+(defun dd.rowp (x)
+  (declare (xargs :mode :program))
+  (and (tuplep 3 x)
+       (natp (first x))               ;; badness
+       (natp (second x))              ;; twips
+       (dd.brick-listp (third x))))   ;; reversed-bricks
+
+(defun dd.row-text (row) ;; => string
+  (declare (xargs :mode :program))
+  (dd.reversed-brick-list-text (third row) nil))
+
+
+;; A LAYOUT is just a list of rows.  The badness of a layout is the sum of the
+;; badnesses of each of its rows.  We think of each row in the layout as being
+;; separated by a newline character.
+
+(defun dd.layoutp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (dd.rowp (car x))
+           (dd.layoutp (cdr x)))
+    t))
+
+(defun dd.layout-listp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (dd.layoutp (car x))
+           (dd.layout-listp (cdr x)))
+    t))
+
+(defun dd.layout-badness (layout) ;; => nat
+  (declare (xargs :mode :program))
+  (if (consp layout)
+      (let* ((row         (first layout))
+             (row-badness (first row)))
+        (+ row-badness (dd.layout-badness (cdr layout))))
+    0))
+
+(defun dd.minimal-layout (layouts best-so-far) ;; => layout
+  (declare (xargs :mode :program))
+  (if (consp layouts)
+      (if best-so-far
+          (let ((my-badness   (dd.layout-badness (car layouts)))
+                (best-badness (dd.layout-badness best-so-far)))
+            (if (< best-badness my-badness)
+                (dd.minimal-layout (cdr layouts) best-so-far)
+              (dd.minimal-layout (cdr layouts) (car layouts))))
+        (dd.minimal-layout (cdr layouts) (car layouts)))
+    best-so-far))
+
+(defun dd.layout-text (layout) ;; => string
+  (declare (xargs :mode :program))
+  (if (consp layout)
+      (dd.cat (dd.row-text (car layout))
+              (if (consp (cdr layout))
+                  (dd.cat " \\\\ " *dd.nl*)
+                "")
+              (dd.layout-text (cdr layout)))
+    nil))
+
+
+
+;; We merge our funny combined list of (twips . text) pairs and layout hints
+;; into bricks.
+
+(defun dd.aux-merge-into-bricks (x max-badness) ;; => brick list
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (cond ((natp (first x))
+             (ACL2::er hard 'dd.aux-merge-into-bricks "Don't expect a number to come first.~%"))
+            ((natp (second x))
+             (cons (list (second x) ;; score for this brick
+                         (car (car x)) ;; twips
+                         (cdr (car x))) ;; text
+                   (dd.aux-merge-into-bricks (cdr (cdr x)) max-badness)))
+            (t
+             (cons (list max-badness ;; default score
+                         (car (car x)) ;; twips
+                         (cdr (car x))) ;; text
+                   (dd.aux-merge-into-bricks (cdr x) max-badness))))
+    nil))
+
+(defun dd.merge-into-bricks (x) ;; => brick list
+  (declare (xargs :mode :program))
+  (dd.aux-merge-into-bricks x (+ 100 (dd.max-list x))))
+
+
+
+;; The QQUAD BRICK is put into each line of a layout except the first.  This
+;; ensures that all lines after the first are indented.
+
+(defconst *dd.qquad-brick*
+  (list 0 *dd.qquad-width* " {\\qquad} "))
+
+
+;; LAYOUT ALGORITHM.
+;;
+;; Our layout algorithm takes a list of bricks to process, a maximum length to
+;; lay out the bricks in, and a list of layouts that contain the bricks we've
+;; seen so far.
+;;
+;; Our algorithm's main operation is to expand upon the list of layouts by
+;; adding the next brick to each of them.  There are two ways we can add a
+;; brick to a layout:
+;;
+;;   (1) If it fits within the maximum length we can add it to the current row,
+;;   (2) Alternately, we can always put it on a new row.
+;;
+;; Given N input layouts, this produces up to 2*N output layouts per brick.
+;; So, repeating by M bricks, this algorithm is O(2^M) which is terrible.  In
+;; practice it is too expensive to apply to even modestly sized formulas, so
+;; as a heuristic we only try to start a new row if the badness of the brick
+;; is under 100.
+
+(defun dd.split-solutions (max-width brick todo acc) ;; => layout list
+  (declare (xargs :mode :program))
+  (if (consp todo)
+      (let* ((solution1  (car todo))
+             (final-row  (car solution1))
+             (prev-brick (car (third final-row)))
+             ;; Try adding the brick to the current row.
+             (new-width (+ (second final-row) (second brick)))  ;; row's width + brick width
+             (new-acc   (if (<= new-width max-width)
+                            ;; It fits so we add it.
+                            (let* ((new-row  (list (first brick) new-width (cons brick (third final-row))))
+                                   (new-soln (cons new-row (cdr solution1))))
+                              (cons new-soln acc))
+                          ;; It doesn't fit so we continue.
+                          acc)))
+        (if (and (<= 100 (first prev-brick))
+                 (<= new-width max-width))
+            ;; Heuristic: the previous brick's badness was over 100 so we probably don't
+            ;; want to split after it.  Furthermore, this brick fits.  So, don't even try
+            ;; to make a new row.
+            (dd.split-solutions max-width brick (cdr todo) new-acc)
+          ;; Try creating a new row for the new brick.
+          (let ((new-width (+ *dd.qquad-width* (second brick)))) ;; width of brick1 + a qquad
+            (if (<= new-width max-width)
+                (let* ((new-row  (list (first brick) new-width (list brick *dd.qquad-brick*)))
+                       (new-soln (cons new-row solution1)))
+                  (dd.split-solutions max-width brick (cdr todo) (cons new-soln new-acc)))
+              ;; It doesn't even fit on a brand new row.
+              (ACL2::er hard 'dd.generate-possible-layouts "Brick ~x0 is too wide.~%" brick)))))
+    acc))
+
+(defun dd.generate-layouts (max-width bricks solutions) ;; => layout list
+  (declare (xargs :mode :program))
+  (if (consp bricks)
+      (dd.generate-layouts max-width
+                           (cdr bricks)
+                           ;; Split all the existing solutions with the first brick
+                           (dd.split-solutions max-width (car bricks) solutions nil))
+    solutions))
+
+(defun dd.latex-formula (formula max-width) ;; => string
+  (declare (xargs :mode :program))
+  (let* ((bricks              (dd.merge-into-bricks (dd.aux-latex-formula formula 1)))
+         ;; The initial solution will have a single row and a single brick.  We don't add
+         ;; a qquad brick becuase it's the starting row and we don't want it indented.
+         (initial-row         (list (first (car bricks))  ;; brick1's badness
+                                    (second (car bricks)) ;; brick1's width
+                                    (list (car bricks)))) ;; brick1 itself
+         (initial-soln        (list initial-row))
+         ;; Generate the possible layouts then choose a minimal one.
+         (possible-layouts    (dd.generate-layouts max-width (cdr bricks) (list initial-soln)))
+         (best-layout         (dd.minimal-layout possible-layouts nil)))
+    ;; We generated the layouts in reverse, so we have to reverse the text.
+    (dd.layout-text (fast-rev best-layout))))
+
+(defconst *dd.formula-padding* 600)
+(defconst *dd.overestimate-padding* 1800)
+
+(defun dd.aux-latex-autobox-formulas (formulas twips) ;; => string list
+  (declare (xargs :mode :program))
+  (if (consp formulas)
+      (cons (dd.cat "\\parbox[t]"
+                    "{" (dd.twips-to-inches twips) "}"
+                    "{$" (dd.latex-formula (car formulas) (- twips *dd.formula-padding*)) "$}")
+            (dd.aux-latex-autobox-formulas (cdr formulas) twips))
+    nil))
+
+(defun dd.latex-autobox-formulas (formulas twips) ;; => string list
+  (declare (xargs :mode :program))
+  (let* ((desired-width (dd.latex-formulas-max-desired-width formulas (- twips *dd.overestimate-padding*)))
+         (autobox-width (+ desired-width *dd.overestimate-padding*)))
+    (dd.aux-latex-autobox-formulas formulas autobox-width)))
+
+(defun dd.latex-autobox-formula (formula twips) ;; => string
+  (declare (xargs :mode :program))
+  (car (dd.latex-autobox-formulas (list formula) twips)))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/defderiv/top.lisp acl2-6.3/books/milawa/ACL2/defderiv/top.lisp
--- acl2-6.2/books/milawa/ACL2/defderiv/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/defderiv/top.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,41 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(include-book "context")
+(include-book "defderiv")
+(include-book "latex")
+(include-book "latex-magic")
+
diff -Nru acl2-6.2/books/milawa/ACL2/integer/abs-min-max.lisp acl2-6.3/books/milawa/ACL2/integer/abs-min-max.lisp
--- acl2-6.2/books/milawa/ACL2/integer/abs-min-max.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/integer/abs-min-max.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,163 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "base")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defsection iabs
+
+  (defund iabs (a)
+    (declare (xargs :guard t))
+    (if (i< a 0)
+        (ineg a)
+      (ifix a)))
+
+  (local (in-theory (enable integerp iabs ifix ineg i<)))
+
+  (defthm natp-of-iabs
+    (equal (natp (iabs a))
+           t))
+
+  (defthm iabs-of-ifix
+    (equal (iabs (ifix a))
+           (iabs a)))
+
+  (defund fast-iabs (a)
+    (declare (xargs :guard (integerp a)))
+    (if (consp a)
+        (cdr a)
+      a))
+
+  (defthm fast-iabs-removal
+    (implies (force (integerp a))
+             (equal (fast-iabs a)
+                    (iabs a)))
+    :hints(("Goal" :in-theory (enable fast-iabs)))))
+
+
+
+(defsection imax
+
+  (defund imax (a b)
+    (declare (xargs :guard t))
+    (if (i< a b)
+        (ifix b)
+      (ifix a)))
+
+  (local (in-theory (enable imax)))
+
+  (defthm integerp-of-imax
+    (equal (integerp (imax a b))
+           t))
+
+  (defthm imax-of-ifix-left
+    (equal (imax (ifix a) b)
+           (imax a b)))
+
+  (defthm imax-of-ifix-right
+    (equal (imax a (ifix b))
+           (imax a b)))
+
+  (defthm |(i< (imax a b) a)|
+    (equal (i< (imax a b) a)
+           nil))
+
+  (defthm |(i< (imax a b) b)|
+    (equal (i< (imax a b) b)
+           nil))
+
+  (defund fast-imax (a b)
+    (declare (xargs :guard (and (integerp a)
+                                (integerp b))))
+    (if (fast-i< a b)
+        b
+      a))
+
+  (defthm fast-imax-removal
+    (implies (force (and (integerp a)
+                         (integerp b)))
+             (equal (fast-imax a b)
+                    (imax a b)))
+    :hints(("Goal" :in-theory (enable fast-imax)))))
+
+
+
+(defsection imin
+
+  (defund imin (a b)
+    (declare (xargs :guard t))
+    (if (i< a b)
+        (ifix a)
+      (ifix b)))
+
+  (local (in-theory (enable imin)))
+
+  (defthm integerp-of-imin
+    (equal (integerp (imin a b))
+           t))
+
+  (defthm imin-of-ifix-left
+    (equal (imin (ifix a) b)
+           (imin a b)))
+
+  (defthm imin-of-ifix-right
+    (equal (imin a (ifix b))
+           (imin a b)))
+
+  (defthm |(i< a (imin a b))|
+    (equal (i< a (imin a b))
+           nil))
+
+  (defthm |(i< b (imin a b))|
+    (equal (i< b (imin a b))
+           nil))
+
+  (defund fast-imin (a b)
+    (declare (xargs :guard (and (integerp a)
+                                (integerp b))))
+    (if (fast-i< a b)
+        a
+      b))
+
+  (defthm fast-imin-removal
+    (implies (force (and (integerp a)
+                         (integerp b)))
+             (equal (fast-imin a b)
+                    (imin a b)))
+    :hints(("Goal" :in-theory (enable fast-imin)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/integer/base.lisp acl2-6.3/books/milawa/ACL2/integer/base.lisp
--- acl2-6.2/books/milawa/ACL2/integer/base.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/integer/base.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,830 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../utilities/utilities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+; Integer base -- integerp, ifix, zip, ineg, i+, i<, i<=
+
+(defsection integerp
+
+  (definlined integerp (a)
+    (declare (xargs :guard t))
+    (or (natp a)
+        (and (consp a)
+             (equal (car a) 'minus)
+             (< 0 (cdr a)))))
+
+  (local (in-theory (enable integerp)))
+
+  (defthm booleanp-of-integerp
+    (booleanp (integerp x)))
+
+  (defthm integerp-when-natp
+    (implies (natp x)
+             (integerp x))))
+
+
+(defsection ifix
+
+  (definlined ifix (a)
+    (declare (xargs :guard t))
+    (if (integerp a)
+        a
+      0))
+
+  (local (in-theory (enable integerp ifix)))
+
+  (defthm ifix-under-iff
+    (iff (ifix a)
+         t))
+
+  (defthm integerp-of-ifix
+    (equal (integerp (ifix a))
+           t))
+
+  (defthm ifix-when-integerp-cheap
+    (implies (integerp a)
+             (equal (ifix a)
+                    a))
+    :rule-classes ((:rewrite :backchain-limit-lst 2)))
+
+  (defthm ifix-when-not-integerp-cheap
+    (implies (not (integerp a))
+             (equal (ifix a)
+                    0))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm ifix-of-ifix
+    (equal (ifix (ifix a))
+           (ifix a)))
+
+  (defthm equal-of-ifix-of-self
+    ;; No symmetric rule because of term order
+    (equal (equal a (ifix a))
+           (integerp a))))
+
+
+(defsection zip
+
+  (definline zip (a)
+    (declare (xargs :guard t))
+    (or (not (integerp a))
+        (equal a 0)))
+
+  (local (in-theory (enable zip integerp ifix)))
+
+  (defthm booleanp-of-zip
+    (equal (booleanp (zip a))
+           t))
+
+  (defthm zip-when-integerp-cheap
+    (implies (integerp a)
+             (equal (zip a)
+                    (equal a 0)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm zip-when-not-integerp-cheap
+    (implies (not (integerp a))
+             (equal (zip a)
+                    t))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm integerp-when-not-zip-cheap
+    (implies (not (zip a))
+             (equal (integerp a)
+                    t))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm ifix-when-zip-cheap
+    (implies (zip a)
+             (equal (ifix a)
+                    0))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm zip-of-ifix
+    (equal (zip (ifix a))
+           (zip a)))
+
+  (defthm equal-of-zero-and-ifix
+    ;; No symmetric rule because of term order
+    (equal (equal 0 (ifix a))
+           (zip a)))
+
+  (definlined fast-zip (a)
+    (declare (xargs :guard (integerp a)))
+    (equal a 0))
+
+  (defthm fast-zip-removal
+    (implies (force (integerp a))
+             (equal (fast-zip a)
+                    (zip a)))
+    :hints(("Goal" :in-theory (enable fast-zip)))))
+
+
+
+(defsection ineg
+
+  (defund ineg (a)
+    (declare (xargs :guard t))
+    (let ((a (ifix a)))
+      (cond ((consp a)
+             (cdr a))
+            ((equal a 0)
+             0)
+            (t
+             (cons 'minus a)))))
+
+  (local (in-theory (enable integerp ineg ifix zip)))
+
+  (defthm ineg-under-iff
+    (iff (ineg a)
+         t))
+
+  (defthm integerp-of-ineg
+    (equal (integerp (ineg a))
+           t))
+
+  (defthm ineg-of-ifix
+    (equal (ineg (ifix a))
+           (ineg a)))
+
+  (defthm zip-of-ineg
+    (equal (zip (ineg a))
+           (zip a)))
+
+  (defthm |(equal 0 (ineg a))|
+    (equal (equal 0 (ineg a))
+           (zip a)))
+
+  (defthm |(ineg (ineg a))|
+    (equal (ineg (ineg a))
+           (ifix a))))
+
+
+(defsection i+
+
+  (defund i+ (a b)
+    (declare (xargs :guard t))
+    (let ((a (ifix a))
+          (b (ifix b)))
+      (if (consp a)
+          (if (consp b)
+              ;; -5 + -3 = -(5 + 3)
+              (cons 'minus (+ (cdr a) (cdr b)))
+            ;; Subtle: to avoid creating -0, we need to arrange the IF tests so
+            ;; that the inequality is strict on the negative side.  That is, we
+            ;; check (< b (cdr a)) here instead of (< a (cdr b)), because that
+            ;; way the (equal a b) case makes a +0 instead of a -0.
+            (if (< b (cdr a))
+                ;; -5 + 3 = -(5 - 3)
+                (cons 'minus (- (cdr a) b))
+              ;; -3 + 5 = 5 - 3 and the zero case
+              (- b (cdr a))))
+        (if (consp b)
+            (if (< a (cdr b))
+                ;; 3 + -5 = -(5 - 3)
+                (cons 'minus (- (cdr b) a))
+              ;; 5 + -3 = 5 - 3
+              (- a (cdr b)))
+          ;; 5 + 3
+          (+ a b)))))
+
+  (local (in-theory (enable i+ integerp zip ifix)))
+
+  (defthm i+-under-iff
+    (iff (i+ a b)
+         t))
+
+  (defthm integerp-of-i+
+    (equal (integerp (i+ a b))
+           t))
+
+  (defthm commutativity-of-i+
+    (equal (i+ a b)
+           (i+ b a)))
+
+  (defthm associativity-of-i+
+    (equal (i+ (i+ a b) c)
+           (i+ a (i+ b c))))
+
+  (defthm commutativity-of-i+-two
+    (equal (i+ a (i+ b c))
+           (i+ b (i+ a c))))
+
+  (defthm gather-constants-from-i+-of-i+
+    (implies (and (syntaxp (ACL2::quotep a))
+                  (syntaxp (ACL2::quotep b)))
+             (equal (i+ a (i+ b c))
+                    (i+ (i+ a b) c))))
+
+  (defthmd i+-completion-left
+    (implies (not (integerp a))
+             (equal (i+ a b)
+                    (ifix b))))
+
+  (defthmd i+-completion-right
+    (implies (not (integerp b))
+             (equal (i+ a b)
+                    (ifix a))))
+
+  (defthm i+-when-zip-left-cheap
+    (implies (zip a)
+             (equal (i+ a b)
+                    (ifix b)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm i+-when-zip-right-cheap
+    (implies (zip b)
+             (equal (i+ a b)
+                    (ifix a)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm i+-of-zero-left
+    (equal (i+ 0 b)
+           (ifix b)))
+
+  (defthm i+-of-zero-right
+    (equal (i+ a 0)
+           (ifix a)))
+
+  (defthm i+-of-ifix-left
+    (equal (i+ (ifix a) b)
+           (i+ a b)))
+
+  (defthm i+-of-ifix-right
+    (equal (i+ a (ifix b))
+           (i+ a b))))
+
+
+(defsection fast-i+
+
+  (defund fast-i+ (a b)
+    (declare (xargs :guard (and (integerp a)
+                                (integerp b))))
+    (if (consp a)
+        (if (consp b)
+            (cons 'minus (+ (cdr a) (cdr b)))
+          (if (< b (cdr a))
+              (cons 'minus (- (cdr a) b))
+            (- b (cdr a))))
+      (if (consp b)
+          (if (< a (cdr b))
+              (cons 'minus (- (cdr b) a))
+            (- a (cdr b)))
+        (+ a b))))
+
+  (local (in-theory (enable fast-i+ i+)))
+
+  (defthm fast-i+-removal
+    (implies (force (and (integerp a)
+                         (integerp b)))
+             (equal (fast-i+ a b)
+                    (i+ a b)))))
+
+
+(defsection i<
+
+  (defund i< (a b)
+    (declare (xargs :guard t))
+    (let ((a (ifix a))
+          (b (ifix b)))
+      (if (consp a)
+          (if (consp b)
+              ;; -5 < -3 = 3 < 5
+              (< (cdr b) (cdr a))
+            ;; -5 < 3 = T
+            t)
+        (if (consp b)
+            ;; 5 < -3 = NIL
+            nil
+          ;; 5 < 3, natural case
+          (< a b)))))
+
+  (definline i<= (a b)
+    ;; We just leave this enabled
+    (declare (xargs :guard t))
+    (not (i< b a)))
+
+  (local (in-theory (enable i< i+ integerp ifix zip)))
+
+  (defthm booleanp-of-i<
+    (equal (booleanp (i< a b))
+           t))
+
+  (defthm irreflexivity-of-i<
+    (equal (i< a a)
+           nil))
+
+  (defthm i<-completion-left
+    (implies (not (integerp a))
+             (equal (i< a b)
+                    (i< 0 b)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm i<-completion-right
+    (implies (not (integerp b))
+             (equal (i< a b)
+                    (i< a 0)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm i<-of-ifix-left
+    (equal (i< (ifix a) b)
+           (i< a b)))
+
+  (defthm i<-of-ifix-right
+    (equal (i< a (ifix b))
+           (i< a b)))
+
+  (defthm antisymmetry-of-i<
+    (implies (i< a b)
+             (equal (i< b a)
+                    nil)))
+
+  (defthm transitivity-of-i<
+    (implies (and (i< a b)
+                  (i< b c))
+             (i< a c)))
+
+  (defthm trichotomy-of-i<
+    (implies (and (not (equal (ifix a) (ifix b)))
+                  (not (i< a b)))
+             (equal (i< b a)
+                    t)))
+
+  (defthm one-i+-trick
+    (implies (i< a b)
+             (equal (i< b (i+ 1 a))
+                    nil)))
+
+  (defthm |(i< 0 (ineg a))|
+    (equal (i< 0 (ineg a))
+           (i< a 0))
+    :hints(("Goal" :in-theory (enable ineg))))
+
+  (defthm |(i< (ineg a) 0)|
+    (equal (i< (ineg a) 0)
+           (i< 0 a))
+    :hints(("Goal" :in-theory (enable ineg))))
+
+  (defthm transitivity-of-i<-two
+    (implies (and (i< a b)
+                  (not (i< c b)))
+             (equal (i< a c)
+                    t)))
+
+  (defthm transitivity-of-i<-three
+    (implies (and (not (i< b a))
+                  (i< b c))
+             (equal (i< a c)
+                    t)))
+
+  (defthm transitivity-of-i<-four
+    (implies (and (not (i< b a))
+                  (not (i< c b)))
+             (equal (i< c a)
+                    nil))))
+
+
+(defsection fast-i<
+
+  (defund fast-i< (a b)
+    (declare (xargs :guard (and (integerp a)
+                                (integerp b))))
+    (if (consp a)
+        (if (consp b)
+            ;; -5 < -3 = 3 < 5
+            (< (cdr b) (cdr a))
+          ;; -5 < 3 = T
+          t)
+      (if (consp b)
+          ;; 5 < -3 = NIL
+          nil
+        ;; 5 < 3, natural case
+        (< a b))))
+
+  (defthm fast-i<-removal
+    (implies (force (and (integerp a)
+                         (integerp b)))
+             (equal (fast-i< a b)
+                    (i< a b)))
+    :hints(("Goal" :in-theory (enable fast-i< i<))))
+
+  (definline fast-i<= (a b)
+    ;; We just leave this enabled
+    (declare (xargs :guard (and (integerp a)
+                                (integerp b))))
+    (not (fast-i< b a))))
+
+
+
+(defsection i<-of-sums
+
+  (local (in-theory (enable i< i+ integerp ifix zip)))
+
+  (defthm |(i< (i+ a b) (i+ a c))|
+    (equal (i< (i+ a b) (i+ a c))
+           (i< b c)))
+
+  (defthm |(i< a (i+ a b))|
+    (equal (i< a (i+ a b))
+           (i< 0 b)))
+
+  (defthm |(i< a (i+ b a))|
+    (equal (i< a (i+ b a))
+           (i< 0 b)))
+
+  (defthm |(i< (i+ a b) a)|
+    (equal (i< (i+ a b) a)
+           (i< b 0)))
+
+  (defthm |(i< (i+ b a) a)|
+    (equal (i< (i+ b a) a)
+           (i< b 0)))
+
+  (local (in-theory (disable i< i+ ifix integerp zip)))
+
+  (defthm |(i< a (i+ b c a))|
+    (equal (i< a (i+ b (i+ c a)))
+           (i< 0 (i+ b c))))
+
+  (defthm |(i< a (i+ b a c))|
+    (equal (i< a (i+ b (i+ a c)))
+           (i< 0 (i+ b c))))
+
+  (defthm |(i< a (i+ b c d a))|
+    (equal (i< a (i+ b (i+ c (i+ d a))))
+           (i< 0 (i+ b (i+ c d)))))
+
+  (defthm |(i< a (i+ b c a d))|
+    (equal (i< a (i+ b (i+ c (i+ a d))))
+           (i< 0 (i+ b (i+ c d)))))
+
+  (defthm |(i< a (i+ b c d e a))|
+    (equal (i< a (i+ b (i+ c (i+ d (i+ e a)))))
+           (i< 0 (i+ b (i+ c (i+ d e))))))
+
+  (defthm |(i< a (i+ b c d a e))|
+    (equal (i< a (i+ b (i+ c (i+ d (i+ a e)))))
+           (i< 0 (i+ b (i+ c (i+ d e))))))
+
+  (defthm |(i< a (i+ b c d e f a))|
+    (equal (i< a (i+ b (i+ c (i+ d (i+ e (i+ f a))))))
+           (i< 0 (i+ b (i+ c (i+ d (i+ e f)))))))
+
+  (defthm |(i< a (i+ b c d e a f))|
+    (equal (i< a (i+ b (i+ c (i+ d (i+ e (i+ a f))))))
+           (i< 0 (i+ b (i+ c (i+ d (i+ e f)))))))
+
+  (defthm |(i< (i+ a b) (i+ c a))|
+    (equal (i< (i+ a b) (i+ c a))
+           (i< b c)))
+
+  (defthm |(i< (i+ b a) (i+ c a))|
+    (equal (i< (i+ b a) (i+ c a))
+           (i< b c)))
+
+  (defthm |(i< (i+ b a) (i+ a c))|
+    (equal (i< (i+ b a) (i+ a c))
+           (i< b c)))
+
+  (defthm |(i< (i+ a b) (i+ c a d))|
+    (equal (i< (i+ a b) (i+ c (i+ a d)))
+           (i< b (i+ c d))))
+
+  (defthm |(i< (i+ b a c) (i+ d a))|
+    (equal (i< (i+ b (i+ a c)) (i+ d a))
+           (i< (i+ b c) d)))
+
+  (local (in-theory (enable i< i+ ifix integerp zip)))
+
+  (defthm |(i<= a b), c > 0 --> (i< a (i+ b c))|
+    (implies (and (i<= a b)
+                  (not (zp c)))
+             (equal (i< a (i+ b c))
+                    t)))
+
+  (defthm |(i<= a b), c > 0 --> (i< a (i+ c b))|
+    (implies (and (i<= a b)
+                  (not (zp c)))
+             (equal (i< a (i+ c b))
+                    t)))
+
+  (local (in-theory (disable i< i+ ifix integerp zip)))
+
+  (defthm |(i< c a), (i<= d b) --> (i< (i+ c d) (i+ a b))|
+    (implies (and (i< c a)
+                  (i<= d b))
+             (equal (i< (i+ c d) (i+ a b))
+                    t))
+    :hints(("Goal" :use ((:instance transitivity-of-i<-three
+                                    (a (i+ c d))
+                                    (b (i+ c b))
+                                    (c (i+ a b)))))))
+
+  (defthm |(i< c a), (i<= d b) --> (i< (i+ c d) (i+ b a))|
+    (implies (and (i< c a)
+                  (i<= d b))
+             (equal (i< (i+ c d) (i+ b a))
+                    t)))
+
+  (defthm |(i<= c a), (i< d b) --> (i< (i+ c d) (i+ a b))|
+    (implies (and (i<= c a)
+                  (i< d b))
+             (equal (i< (i+ c d) (i+ a b))
+                    t))
+    :hints(("Goal" :use ((:instance |(i< c a), (i<= d b) --> (i< (i+ c d) (i+ b a))|
+                                    (c d) (a b) (d c) (b a))))))
+
+  (defthm |(i<= c a), (i< d b) --> (i< (i+ c d) (i+ b a))|
+    (implies (and (i<= c a)
+                  (i< d b))
+             (equal (i< (i+ c d) (i+ b a))
+                    t)))
+
+  (defthm |(i<= c a), (i<= d b) --> (i<= (i+ c d) (i+ a b))|
+    (implies (and (i<= c a)
+                  (i<= d b))
+             (equal (i< (i+ a b) (i+ c d))
+                    nil))
+    :hints(("Goal" :use ((:instance transitivity-of-i<-four
+                                    (a (i+ c d))
+                                    (b (i+ c b))
+                                    (c (i+ a b)))))))
+
+  (defthm |(i<= c a), (i<= d b) --> (i<= (i+ c d) (i+ b a))|
+    (implies (and (i<= c a)
+                  (i<= d b))
+             (equal (i< (i+ b a) (i+ c d))
+                    nil))))
+
+
+
+(defsection equality-of-sums
+
+  (local (in-theory (enable i< i+ ifix integerp zip)))
+
+  (defthm |(= a (i+ a b))|
+    (equal (equal a (i+ a b))
+           (and (integerp a)
+                (zip b))))
+
+  (defthm |(= a (i+ b a))|
+    (equal (equal a (i+ b a))
+           (and (integerp a)
+                (zip b))))
+
+  (local (in-theory (disable i< i+ ifix integerp zip)))
+
+  (encapsulate
+    ()
+    (defthm |lemma for (= (i+ a b) (i+ a c))|
+      (implies (and (integerp b)
+                    (integerp c)
+                    (equal (i+ a b) (i+ a c)))
+               (equal b c))
+      :rule-classes nil
+      :hints(("Goal"
+              :in-theory (disable |(i< (i+ a b) (i+ a c))|)
+              :use ((:instance |(i< (i+ a b) (i+ a c))| (a a) (b b) (c c))
+                    (:instance |(i< (i+ a b) (i+ a c))| (a a) (b c) (c b))))))
+
+    (defthm |(= (i+ a b) (i+ a c))|
+      (equal (equal (i+ a b) (i+ a c))
+             (equal (ifix b) (ifix c)))
+      :hints(("Goal"
+              :in-theory (enable ifix)
+              :use ((:instance |lemma for (= (i+ a b) (i+ a c))|
+                               (a a)
+                               (b (ifix b))
+                               (c (ifix c))))))))
+
+  (defthm |(= (i+ a b) (i+ c a))|
+    (equal (equal (i+ a b) (i+ c a))
+           (equal (ifix b) (ifix c))))
+
+  (defthm |(= (i+ b a) (i+ c a))|
+    (equal (equal (i+ b a) (i+ c a))
+           (equal (ifix b) (ifix c))))
+
+  (defthm |(= (i+ b a) (i+ a c))|
+    (equal (equal (i+ b a) (i+ a c))
+           (equal (ifix b) (ifix c))))
+
+  (defthm |(= 0 (i+ a b))|
+    (equal (equal 0 (i+ a b))
+           (equal (ifix a) (ineg b)))
+    :hints(("Goal" :in-theory (enable i< i+ ifix integerp zip ineg))))
+
+  (encapsulate
+    ()
+    (defthmd |lemma for (= (i+ a x b) (i+ c x d))|
+      ;; hackery with names to make it commute them nicely
+      (equal (equal (i+ e (i+ b c))
+                    (i+ d (i+ b f)))
+             (equal (i+ e c)
+                    (i+ d f))))
+
+    (defthm |(= (i+ a x b) (i+ c x d))|
+      (equal (equal (i+ a (i+ x b))
+                    (i+ c (i+ x d)))
+             (equal (i+ a b)
+                    (i+ c d)))
+      :hints(("Goal" :in-theory (enable |lemma for (= (i+ a x b) (i+ c x d))|))))))
+
+
+
+(defsection i<-squeeze-laws
+
+  (defthm i<-squeeze-law-one
+    (implies (not (i< b a))
+             (equal (i< (i+ 1 a) b)
+                    (and (not (equal (ifix a) (ifix b)))
+                         (not (equal (i+ 1 a) (ifix b))))))
+    :hints(("Goal" :in-theory (enable ifix integerp i< i+))))
+
+  (defthm i<-squeeze-law-two
+    (implies (not (i< b a))
+             (equal (i< b (i+ 1 a))
+                    (equal (ifix b) (ifix a))))
+    :hints(("Goal" :in-theory (enable ifix integerp i< i+))))
+
+  (defthm i<-squeeze-law-three
+    (implies (i< a b)
+             (equal (i< (i+ 1 a) b)
+                    (not (equal (ifix b) (i+ 1 a)))))
+    :hints(("Goal" :in-theory (enable ifix)))))
+
+
+
+(defsection i-
+
+; We just leave this enabled, and use (i+ a (ineg b)) as our normal form.  Now,
+; we don't have any special handling for sums with inegs in them.  It might be
+; worth thinking about how to make a fancy commutativity rule that will either
+; ignore the ineg for the purposes of sorting the sum, or to always make the
+; negative terms on the right?  I'm not sure which would work better.
+
+  (definline i- (a b)
+    (declare (xargs :guard t))
+    (i+ a (ineg b)))
+
+  (definline fast-i- (a b)
+    (declare (xargs :guard (and (integerp a)
+                                (integerp b))))
+    (fast-i+ a (ineg b))))
+
+
+
+(defsection minus-basics
+
+  (defthm |(i+ a (ineg a))|
+    (equal (i+ a (ineg a))
+           0)
+    :hints(("Goal" :in-theory (enable i+ ineg ifix integerp))))
+
+  (defthm |(ineg (i+ a b))|
+    (equal (ineg (i+ a b))
+           (i+ (ineg a) (ineg b)))
+    :hints(("Goal" :in-theory (enable i+ ineg ifix integerp))))
+
+  (defthm |(i+ a b (ineg b))|
+    (equal (i+ a (i+ b (ineg b)))
+           (ifix a)))
+
+  (defthm |(i+ a b (ineg a))|
+    (equal (i+ a (i+ b (ineg a)))
+           (ifix b))
+    :hints(("Goal"
+            :in-theory (disable commutativity-of-i+-two)
+            :use ((:instance commutativity-of-i+-two
+                             (a a) (b b) (c (ineg a)))))))
+
+  (defthm |(i+ a (ineg a) b)|
+    (equal (i+ a (i+ (ineg a) b))
+           (ifix b)))
+
+  (defthm |(i< (i+ a (ineg b)) c)|
+    (equal (i< (i+ a (ineg b)) c)
+           (i< a (i+ b c)))
+    :hints(("Goal" :in-theory (enable i+ ineg i< ifix integerp))))
+
+  (defthm |(i< (i+ (ineg a) b) c)|
+    (equal (i< (i+ (ineg a) b) c)
+           (i< b (i+ a c))))
+
+  (defthm |(i< a (i+ b (ineg c)))|
+    (equal (i< a (i+ b (ineg c)))
+           (i< (i+ a c) b))
+    :hints(("Goal" :in-theory (enable i+ ineg i< ifix integerp))))
+
+  (defthm |(i< a (i+ b (i+ c (ineg d))))|
+    (equal (i< a (i+ b (i+ c (ineg d))))
+           (i< (i+ a d) (i+ b c)))
+    :hints(("Goal"
+            :in-theory (disable |(i< (i+ a b) (i+ a c))|)
+            :use ((:instance |(i< (i+ a b) (i+ a c))|
+                             (a d)
+                             (b a)
+                             (c (i+ b (i+ c (ineg d)))))))))
+
+  (defthm |(i< a (i+ b (i+ (ineg c) d)))|
+    (equal (i< a (i+ b (i+ (ineg c) d)))
+           (i< (i+ a c) (i+ b d))))
+
+  (defthm |(= (i+ a (ineg b)) c)|
+    (equal (equal (i+ a (ineg b)) c)
+           (if (integerp c)
+               (equal (ifix a) (i+ b c))
+             nil))
+    :hints(("Goal" :in-theory (enable integerp ifix i+ ineg))))
+
+  (defthm |(= (i+ (ineg a) b) c)|
+    (equal (equal (i+ (ineg a) b) c)
+           (if (integerp c)
+               (equal (ifix b) (i+ a c))
+             nil)))
+
+  (defthm |(= c (i+ a (ineg b)))|
+    (equal (equal c (i+ a (ineg b)))
+           (if (integerp c)
+               (equal (ifix a) (i+ b c))
+             nil)))
+
+  (defthm |(= c (i+ (ineg a) b))|
+    (equal (equal c (i+ (ineg a) b))
+           (if (integerp c)
+               (equal (ifix b) (i+ a c))
+             nil))))
+
+
+
+(defsection i-constant-gathering
+
+  (defthm gather-constants-from-i<-of-i+
+    (implies (and (syntaxp (ACL2::quotep const))
+                  (syntaxp (ACL2::quotep const2)))
+             (equal (i< (i+ const x) const2)
+                    (i< x (i+ const2 (ineg const))))))
+
+  (defthm gather-constants-from-i<-of-i+-two
+    (implies (and (syntaxp (ACL2::quotep const))
+                  (syntaxp (ACL2::quotep const2)))
+             (equal (i< const (i+ const2 x))
+                    (i< (i+ const (ineg const2)) x))))
+
+  (defthm gather-constants-from-i<-of-i+-and-i+
+    (implies (and (syntaxp (ACL2::quotep a))
+                  (syntaxp (ACL2::quotep b)))
+             (equal (i< (i+ a x) (i+ b y))
+                    (i< x (i+ b (i+ (ineg a) y))))))
+
+  (defthm gather-constants-from-equal-of-i+-and-i+
+    (implies (and (syntaxp (ACL2::quotep c1))
+                  (syntaxp (ACL2::quotep c2)))
+             (equal (equal (i+ c1 x) (i+ c2 y))
+                    (equal (ifix x) (i+ (i+ c2 (ineg c1)) y))))
+    :hints(("Goal"
+            :in-theory (disable |(= (i+ a b) (i+ a c))|)
+            :use ((:instance |(= (i+ a b) (i+ a c))|
+                             (a (ineg c1))
+                             (b (i+ c1 x))
+                             (c (i+ c2 y))))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/acl2 acl2-6.3/books/milawa/ACL2/interface/acl2
--- acl2-6.2/books/milawa/ACL2/interface/acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+../acl2-images/interface-acl2
diff -Nru acl2-6.2/books/milawa/ACL2/interface/acl2-connection.lisp acl2-6.3/books/milawa/ACL2/interface/acl2-connection.lisp
--- acl2-6.2/books/milawa/ACL2/interface/acl2-connection.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/acl2-connection.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,567 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "core")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Goal checking
+;;
+;; Since our tactic harness is inside ACL2, we can ask ACL2 if it believes the
+;; goals are true using (%check).  Of course, this will only work if all the
+;; functions involved are already defined inside of ACL2.
+
+(defun %check-goal (goal)
+  (declare (xargs :mode :program))
+  `(ACL2::make-event (ACL2::mv-let (erp val ACL2::state)
+                                   (ACL2::thm (or ,@goal))
+                                   (declare (ignore erp val))
+                                   (ACL2::value '(ACL2::value-triple :invisible)))))
+
+(defun %aux-check-goals (goals n)
+  (declare (xargs :mode :program))
+  (if (consp goals)
+      (list* `(ACL2::value-triple (ACL2::cw "Checking goal ~x0~%" ',n))
+             (%check-goal (car goals))
+             (%aux-check-goals (cdr goals) (+ 1 n)))
+    nil))
+
+(defun %check-goals (goals)
+  (declare (xargs :mode :program))
+  `(ACL2::encapsulate () ,@(%aux-check-goals goals 1)))
+
+(defmacro %check ()
+  ;; Check if ACL2 believes the goals are theorems.
+  `(ACL2::make-event (%check-goals (tactic.harness->goals (ACL2::w ACL2::state)))))
+
+
+
+;; Autoadmitting Functions
+;;
+;; We can look up a function's definition in the ACL2 world, convert it into a
+;; Milawa-usable form, and submit it as a Milawa definition.  This won't work
+;; unless all the functions it calls are already in Milawa, etc., but it's
+;; awfully handy.
+
+(defun ACL2::get-untranslated-defun (name world)
+  (declare (xargs :mode :program))
+  (let* ((ev-world (ACL2::decode-logical-name name world)))
+    (ACL2::access-event-tuple-form (ACL2::cddar ev-world))))
+
+(defun ACL2::get-measure (name world)
+  (declare (xargs :mode :program))
+  (let* ((justification (acl2::fgetprop name 'acl2::justification nil world)))
+    (and justification
+         (ACL2::access ACL2::justification justification :measure))))
+
+(defun find-syntax-defun (name syntax-defuns)
+  (declare (xargs :mode :program))
+  (if (consp syntax-defuns)
+      (if (equal name (second (car syntax-defuns)))
+          (car syntax-defuns)
+        (find-syntax-defun name (cdr syntax-defuns)))
+    nil))
+
+(defun %autoadmit-fn (name world)
+  (declare (xargs :mode :program))
+  ;; What about :export support?  We should be looking for that instead.
+  (let* ((syntax-defuns  (ACL2::get-syntax-defun-entries world))
+         (this-defun     (find-syntax-defun name syntax-defuns))
+         ;; (untranslated-defun (ACL2::get-untranslated-defun name world))
+         ;; (real-name      (ACL2::deref-macro-name name world))
+         (measure        (ACL2::get-measure name world))
+         ;; (formals        (third untranslated-defun))
+         (formals        (third this-defun))
+         ;; (body           (car (ACL2::last untranslated-defun))))
+         (body           (fourth this-defun)))
+    (if measure
+        `(defsection ,name
+           (%defun ,name ,formals
+                   ;; ,(ACL2::clean-up-body (annhialate-declarations body))
+                   ,body
+                   :measure ,measure)
+           (local (%auto))
+           (%admit))
+      `(defsection ,name
+         (%defun ,name ,formals
+                 ;; ,(ACL2::clean-up-body (annhialate-declarations body)))
+                 ,body)
+         (%admit)))))
+
+(defmacro %autoadmit (name)
+  `(ACL2::make-event (%autoadmit-fn ',name (ACL2::w ACL2::state))))
+
+
+
+;; Automatic "outside-in" rule creation
+;;
+;; The rule (car (cons x y)) = x is a perfect example of a good outside-in
+;; rule because it lets us throw away "y" before we even look at it.  I go
+;; ahead and generate an outside-in rule from ACL2 rules when:
+;;
+;;   1. The right-hand side "never increases a variable"
+;;   2. There are no syntaxp restrictions, and
+;;   3. There are no hypotheses.
+;;
+;; At one time I also prohibited rules that repeated a variable in their lhs,
+;; such as (subsetp x x) = t, under the theory that we would want to give both
+;; sides a chance to canonicalize first.  But since we're keeping the
+;; inside-out version too, I think this is not really much of a problem.
+;;
+;; Criteria #1 is the main issue.  The whole point of outside-in rules is that
+;; they'll allow us to avoid rewriting parts of terms by throwing away some
+;; variable that they matched.  And we don't want to introduce duplicates,
+;; e.g., (foo x y (bar x z)) = (baz z z) is probably a bad outside-in rule
+;; since if "z" is large then we might have blown up the term considerably.
+;; Maybe it makes sense to break this rule when we "know" that z is usually
+;; small, but for automatic outside-in rule introduction, I'm not bothering
+;; with that.
+;;
+;; At one time, I also require that at least one variable was decreased.  But
+;; now I don't require this, since it allows rules like (iff x nil) = (not x)
+;; to be made outside-rules, which I think probably helps canonicalize things.
+;;
+;; Criteria #2 is in place because often syntaxp rules are used to break
+;; canonical forms, e.g., to left-associate (+ a (+ b c)) when a,b are
+;; constants.  We think it's unlikely that they'll be constants before we
+;; rewrite them.  Moreover, it seems like a reasonable expectation on the
+;; part of the syntaxp writer is that their matches are already in
+;; canonical form.
+;;
+;; Criteria #3 is probably overly restrictive.  Basically we don't want to
+;; introduce huge complicated hyps by instantiating their variables with big
+;; expressions.  It might pay off to investigate relaxing this somewhat,
+;; especially given our caching mechanism.
+
+(defthm forcing-mapp-of-clean-update
+  (implies (force (mapp map))
+           (equal (mapp (clean-update key val map))
+                  t))
+  :hints(("Goal" :in-theory (e/d (clean-update)
+                                 (rw.theory-mapp-of-clean-update)))))
+
+(defund rw.flag-count-variables (flag x acc)
+  ;; Create a map from variable names to their number of occurrences in a term,
+  ;; x.
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (logic.term-listp x))
+                              (mapp acc))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) acc)
+            ((logic.variablep x) (clean-update x (+ 1 (cdr (lookup x acc))) acc))
+            ((logic.functionp x) (rw.flag-count-variables 'list (logic.function-args x) acc))
+            ((logic.lambdap x)   (rw.flag-count-variables 'list (logic.lambda-actuals x) acc))
+            (t acc))
+    (if (consp x)
+        (rw.flag-count-variables 'list (cdr x)
+                                 (rw.flag-count-variables 'term (car x) acc))
+      acc)))
+
+(defthm forcing-mapp-of-rw.flag-count-variables
+  (implies (force (mapp acc))
+           (equal (mapp (rw.flag-count-variables flag x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.flag-count-variables))))
+
+(verify-guards rw.flag-count-variables)
+
+(definlined rw.count-variables (x)
+  (declare (xargs :guard (logic.termp x)))
+  (rw.flag-count-variables 'term x nil))
+
+(definlined rw.count-variables-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (rw.flag-count-variables 'list x nil))
+
+(defthm mapp-of-rw.count-variables
+  (equal (mapp (rw.count-variables x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.count-variables))))
+
+(defund rw.no-count-increases-aux (dom x y)
+  ;; For all the keys listed in domain, is the corresponding value in y never
+  ;; greater than the corresponding value in x?  I.e., "did no variables increase?"
+  (declare (xargs :guard (and (mapp x)
+                              (mapp y))))
+  (if (consp dom)
+      (and (<= (cdr (lookup (car dom) y))
+               (cdr (lookup (car dom) x)))
+           (rw.no-count-increases-aux (cdr dom) x y))
+    t))
+
+(definlined rw.no-count-increases (x y)
+  ;; For all keys in x, is the corresponding value in y never greater than the
+  ;; corresponding value in x?
+  (declare (xargs :guard (and (mapp x)
+                              (mapp y))))
+  (rw.no-count-increases-aux (fast-domain$ x nil) x y))
+
+(defund rw.some-count-decreases-aux (dom x y)
+  ;; For some key listed in domain, is the corresponding value in y smaller
+  ;; than the corresponding value in x?  I.e., "did some variable decrease?"
+  (declare (xargs :guard (and (mapp x)
+                              (mapp y))))
+  (if (consp dom)
+      (or (< (cdr (lookup (car dom) y))
+             (cdr (lookup (car dom) x)))
+          (rw.some-count-decreases-aux (cdr dom) x y))
+    nil))
+
+(definlined rw.some-count-decreases (x y)
+  (declare (xargs :guard (and (mapp x)
+                              (mapp y))))
+  (rw.some-count-decreases-aux (fast-domain$ x nil) x y))
+
+(defund rw.looks-good-for-outside-inp (rule)
+  ;; Would we like rule to be an outside-in rule as well?
+  (declare (xargs :guard (rw.rulep rule)))
+  (and (equal (rw.rule->type rule) 'inside)
+       (not (rw.rule->syntax rule))
+       (not (rw.rule->hyps rule))
+       (let ((lhsmap (rw.count-variables (rw.rule->lhs rule)))
+             (rhsmap (rw.count-variables (rw.rule->rhs rule))))
+         (and (subsetp (domain rhsmap) (domain lhsmap)) ;; no new vars please
+              ;; we don't require this anymore.
+              ;; (rw.some-count-decreases lhsmap rhsmap) not any more.
+              (rw.no-count-increases lhsmap rhsmap)))))
+
+
+
+
+
+
+
+
+
+;; Translating Rewrite Rules
+;;
+;; Our first step is to convert the rule's hypotheses into hypp's for Milawa.
+;; This is somewhat involved:
+;;
+;;   (1) ACL2 embeds "force" inside the term; we have a separate field in the
+;;       hypp structure for this.
+;;   (2) Some ACL2 hyps are syntaxp hyps; we do not consider these to be hyps
+;;       and store them in a separate part of the rule.
+;;   (3) ACL2 embeds the backchain limits for the hyps in a separate list,
+;;       while we store them inside each hyp.
+;;
+;; We may also need to create additional syntaxp hyps from the loop-stoppers
+;; of a rule.
+
+(defun make-force-list (x)
+  (declare (xargs :mode :program))
+  ;; We are given a list of acl2-hyps as terms.  We create tuples of the form
+  ;; (forcep term) as follows:
+  ;;    (force a) --> (t a)
+  ;;    a         --> (nil a)
+  (if (consp x)
+      (let ((term (car x)))
+        (if (and (consp term)
+                 (equal (car term) 'ACL2::force))
+            (cons (list t (second term))
+                  (make-force-list (cdr x)))
+          (cons (list nil term)
+                (make-force-list (cdr x)))))
+    nil))
+
+(defun make-syntax-list (x)
+  (declare (xargs :mode :program))
+  ;; X is a list of (forcep term) tuples.  We create tuples of the form
+  ;; (syntaxp forcep term) as follows:
+  ;;   (forcep (syntaxp a)) => (t   forcep a*)
+  ;;   (forcep a)           => (nil forcep a)
+  ;; Where a* is the "corrected" version of a.  That is, a might include
+  ;; calls of ACL2::quotep, which does not exist in Milawa and must be
+  ;; replaced with MILAWA::logic.constantp.
+  (if (consp x)
+      (let* ((entry  (car x))
+             (forcep (first entry))
+             (term   (second entry)))
+        (if (and (consp term)
+                 (equal (car term) 'ACL2::synp))
+            ;; The hyp is (synp vars form (quote term))
+            (let* ((syn-term   (second (fourth term)))
+                   (fix-quotep (ACL2::subst 'logic.constantp 'ACL2::quotep syn-term)))
+              (cons (list t forcep fix-quotep)
+                    (make-syntax-list (cdr x))))
+          ;; This isn't a syntax hyp.
+          (cons (list nil forcep term)
+                (make-syntax-list (cdr x)))))
+    nil))
+
+(defun insert-backchain-limits (x blimits)
+  (declare (xargs :mode :program))
+  ;; X is a list of (syntaxp forcep term) tuples
+  ;; Blimits is the :backchain-limit-lst from the ACL2 rule
+  ;; We add the blimit to each hyp, creating tuples of the form (blimit syntaxp forcep term)
+  ;; Each blimit is either nil (for no limit) or a number.
+  (if (consp x)
+      (cons (cons (car blimits) (car x))
+            (insert-backchain-limits (cdr x) (cdr blimits)))
+    nil))
+
+(defun collect-semantic-hyps (x)
+  (declare (xargs :mode :program))
+  ;; X is a list of (limit syntaxp forcep term) tuples.  We build the hypp structures for all
+  ;; of the non-syntaxp hyps.
+  (if (consp x)
+      (let ((limit   (first (car x)))
+            (syntaxp (second (car x)))
+            (forcep  (third (car x)))
+            (term    (fourth (car x))))
+        (if syntaxp
+            (collect-semantic-hyps (cdr x))
+          (cons (%hyp-fn term (if forcep 'weak nil) limit)
+                (collect-semantic-hyps (cdr x)))))
+    nil))
+
+(defun collect-syntax-hyps (x)
+  (declare (xargs :mode :program))
+  ;; X is a list of (limit syntaxp forcep term) tuples.  We collect only the
+  ;; terms from all the entries with valid syntaxp pairs.
+  (if (consp x)
+      (let ((syntaxp (second (car x)))
+            (term    (fourth (car x))))
+        (if syntaxp
+            (cons term
+                  (collect-syntax-hyps (cdr x)))
+          (collect-syntax-hyps (cdr x))))
+    nil))
+
+(defun create-loop-stoppers (stoppers)
+  (declare (xargs :mode :program))
+  ;; Stoppers are a list of (x y . fns) objects.  We create a list of
+  ;; (logic.term-< y x) entries.
+  (if (consp stoppers)
+      (let ((x (first (car stoppers)))
+            (y (second (car stoppers))))
+        (cons (logic.function 'logic.term-< (list y x))
+              (create-loop-stoppers (cdr stoppers))))
+    nil))
+
+(defun create-rule-from-rewrite-entry (name entry)
+  (declare (xargs :mode :program))
+  ;; We return (enabledp . milawa-rule) for an ACL2 rewrite rule entry.
+  (let* ((hyps                (third (lookup :hyps entry)))
+         (lhs                 (third (lookup :lhs entry)))
+         (rhs                 (third (lookup :rhs entry)))
+         (equiv               (second (lookup :equiv entry)))
+         (backchain-limit-lst (second (lookup :backchain-limit-lst entry)))
+         (loop-stopper        (second (lookup :loop-stopper entry)))
+         (enabledp            (second (lookup :enabledp entry)))
+         (hypmap              (insert-backchain-limits (make-syntax-list (make-force-list hyps))
+                                                       backchain-limit-lst))
+         (milawa-hyps         (collect-semantic-hyps hypmap))
+         (syntax              (revappend (create-loop-stoppers loop-stopper)
+                                         (collect-syntax-hyps hypmap))))
+    (cons enabledp (%rule-fn name 'inside milawa-hyps lhs rhs equiv syntax))))
+
+
+
+
+
+;; Translating Rule-Classes Nil Rules
+;;
+
+(defun annhialate-forces (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (and (equal (first x) 'ACL2::force)
+               (tuplep 2 x))
+          (annhialate-forces (second x))
+        (cons (annhialate-forces (car x))
+              (annhialate-forces (cdr x))))
+    x))
+
+(defun create-rule-from-rule-classes-nil (name entry)
+  (declare (xargs :mode :program))
+  ;; We return (enabledp . milawa-rule) for an ACL2 :rule-classes nil entry.
+  (let* ((thm (annhialate-forces (third (lookup :theorem entry)))))
+    (cond ((equal (car thm) 'implies)
+           ;; We know implies is boolean, so we can cheat and use equal as the
+           ;; equivalence relation.  This turned out to be better than parsing
+           ;; out the hyps separately.
+           (cons nil (%rule-fn name
+                               'manual ; "manual" rules are our equivalent of ACL2's rule-classes nil
+                               nil ; hyps
+                               thm ; lhs is the whole theorem
+                               ''t ; rhs is t
+                               'equal ; equiv is equal
+                               nil)))
+          ((memberp (car thm) '(equal iff))
+           (cons nil (%rule-fn name
+                               'manual
+                               nil          ; hyps
+                               (second thm) ; lhs
+                               (third thm)  ; rhs
+                               (first thm)  ; equiv
+                               nil)))       ; syntax
+          (t
+           (cons nil (%rule-fn name
+                               'manual
+                               nil
+                               thm
+                               ''t
+                               'iff
+                               nil))))))
+
+(defun create-rule-from-acl2 (name ACL2::state)
+  ;; Returns (enabledp . milawa-rule) or throws an error.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let ((info-entries (ACL2::info-fn name ACL2::state)))
+    (if (not (and (tuplep 1 info-entries)
+                  (car info-entries)))
+        (ACL2::er hard 'create-rule-from-acl2
+                  "Something seems to be wrong with ~x0.~%~
+                   Its info-entry is: ~x1.~%"
+                  name info-entries)
+      (let* ((entry (car info-entries))
+             (class (first (cdr (lookup :class entry)))))
+        (cond ((equal class :rewrite)
+               (create-rule-from-rewrite-entry name entry))
+              ((equal class nil)
+               (create-rule-from-rule-classes-nil name entry))
+              (t
+               (ACL2::er hard 'create-rule-from-acl2 "Don't know how to handle rule-classes ~x0.~%" class)))))))
+
+
+
+(defmacro %autorule (name)
+  `(ACL2::make-event `(%prove ',(cdr (create-rule-from-acl2 ',name ACL2::state)))))
+
+(defun autoprove-fn (name hints ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((rule+    (create-rule-from-acl2 name ACL2::state))
+         (enabledp (car rule+))
+         (rule     (cdr rule+)))
+    `(defsection ,name
+       (%prove ',rule)
+       (local (ACL2::progn ,@hints))
+       (local (%auto))
+       (%qed)
+       ,@(if enabledp
+             `((%enable default ,name))
+           nil)
+       ,@(if (rw.looks-good-for-outside-inp rule)
+             (let ((new-name (ACL2::mksym '[OUTSIDE] (rw.rule->name rule))))
+               `((%raw-add-rule
+                  (%rule ,new-name
+                         :type   outside
+                         :hyps   ,(rw.rule->hyps rule)
+                         :lhs    ,(rw.rule->lhs rule)
+                         :rhs    ,(rw.rule->rhs rule)
+                         :equiv  ,(rw.rule->equiv rule)
+                         :syntax ,(rw.rule->syntax rule)))
+                 ,@(if enabledp
+                       `((%enable default ,new-name))
+                     nil)))
+           nil))))
+
+
+(defmacro %autoprove (name &rest hints)
+  `(ACL2::make-event (autoprove-fn ',name ',hints ACL2::state)))
+
+
+
+
+
+(defmacro %autoinduct (name &rest args)
+  ;; Try inducting as suggested by the definition of the function <name>.
+  ;; You can also rename the arguments, e.g.,
+  ;;   (%autoinduct cdr-induction y)
+  ;; Will try "cdr-induction on y" instead of "cdr-induction on x", which is the
+  ;; default since the argument to cdr-induction is x.
+  `(local (ACL2::make-event (%autoinduct-fn ',name ',args (ACL2::w ACL2::state)))))
+
+(defun pair-formals-with-calls (formals calls)
+  ;; Calls are a list of function calls, e.g., ((foo a b) (foo c d) (foo e f)), and formals
+  ;; are the names of the formals, e.g., (x y).  We're going to turn these into substitution
+  ;; lists, e.g., ((x . a) (y . b)), ((x . c) (y . d)), etc.
+  (declare (xargs :mode :program))
+  (if (consp calls)
+      (cons (list2-list formals (logic.function-args (car calls)))
+            (pair-formals-with-calls formals (cdr calls)))
+    nil))
+
+(defun acl2-tests-and-calls-to-induct-pairs (formals x)
+  ;; X is a list of tests-and-calls produced by acl2's induction-machine-for-fn function.  We
+  ;; need to walk through it and turn it into a list of conditions and substitutions.
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (let ((tests (ACL2::access ACL2::tests-and-calls (car x) :tests))
+            (calls (ACL2::access ACL2::tests-and-calls (car x) :calls)))
+        (cons (list (cond ((and (consp tests)
+                                (consp (cdr tests)))
+                           (cons 'and tests))
+                          ((consp tests)
+                           (car tests))
+                          (t
+                           (ACL2::er hard 'acl2-tests-and-calls-to-induct-pairs
+                                     "A tests-and-calls entry had no tests!~%")))
+                    (pair-formals-with-calls formals calls))
+              (acl2-tests-and-calls-to-induct-pairs formals (cdr x))))
+    nil))
+
+(defun %autoinduct-fn (name args world)
+  (declare (xargs :mode :program))
+  (let* ((syntax-defuns  (ACL2::get-syntax-defun-entries world))
+         (this-defun     (find-syntax-defun name syntax-defuns))
+         (measure        (ACL2::get-measure name world))
+         (formals        (third this-defun))
+         (body           (logic.translate (fourth this-defun)))
+         (args*          (or args formals)))
+    (cond ((not measure)
+           (ACL2::er hard '%autoinduct-fn "The function ~x0 doesn't seem to have a measure.~%" name))
+          ((not (same-lengthp args* formals))
+           (ACL2::er hard '%autoinduct-fn "Wrong number of arguments provided.  ~x0 takes ~x1 arguments.~%"
+                     name (len formals)))
+          (t
+           (let* ((args-sigma    (fast-pair-lists$ formals args* nil))
+                  (body/sigma    (logic.substitute body args-sigma))
+                  (measure/sigma (logic.substitute measure args-sigma))
+                  (tests-and-calls (ACL2::induction-machine-for-fn (list name) body/sigma
+                                                                   ;; In 3.5, ruler-extenders were added.  For
+                                                                   ;; 3.4 compatibility we only sometimes add them.
+                                                                   #-v3-4 nil)))
+             `(%induct ,measure/sigma
+                       ,@(acl2-tests-and-calls-to-induct-pairs args* tests-and-calls)))))))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/interface/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/interface/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,35 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/interface/auto-tactic.lisp acl2-6.3/books/milawa/ACL2/interface/auto-tactic.lisp
--- acl2-6.2/books/milawa/ACL2/interface/auto-tactic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/auto-tactic.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,262 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-tactics")
+(include-book "rewrite-tactics")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; (defund tactic.discover-elim-vars-for-goal (goal acc)
+;;   ;; We search the goal for a term of the form (not (consp x)), where x is a
+;;   ;; variable.  We return a list of all such x.  We also tolerate variants
+;;   ;; of not.
+;;   (declare (xargs :guard (logic.term-listp goal)))
+;;   (if (consp goal)
+;;       (if (not (clause.negative-termp (car goal)))
+;;           (tactic.discover-elim-vars-for-goal (cdr goal) acc)
+;;         (let ((guts (clause.negative-term-guts (car goal))))
+;;           (if (and (logic.functionp guts)
+;;                    (equal (logic.function-name guts) 'consp)
+;;                    (equal (len (logic.function-args guts)) 1)
+;;                    (logic.variablep (first (logic.function-args guts))))
+;;               ;; This term has the form (not (consp x)).  We want
+;;               ;; to add x to the list of vars.
+;;               (tactic.discover-elim-vars-for-goal (cdr goal) (cons (first (logic.function-args guts)) acc))
+;;             (tactic.discover-elim-vars-for-goal (cdr goal) acc))))
+;;     acc))
+
+;; (defthm logic.variable-listp-of-tactic.discover-elim-vars-for-goal
+;;   (implies (logic.variable-listp acc)
+;;            (equal (logic.variable-listp (tactic.discover-elim-vars-for-goal goal acc))
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable tactic.discover-elim-vars-for-goal))))
+
+;; (defund tactic.discover-elim-vars-for-all-goals (vars goals)
+;;   ;; Vars are a list of vars we are considering eliminating.  We remove any
+;;   ;; vars which are not discovered in all of the goals.  That is, the only vars
+;;   ;; we keep are elim'able in every single goal.
+;;   (declare (xargs :guard (and (logic.term-list-listp goals)
+;;                               (cons-listp goals))))
+;;   (if (consp goals)
+;;       (tactic.discover-elim-vars-for-all-goals
+;;        (intersect vars (tactic.discover-elim-vars-for-goal (car goals) nil))
+;;        (cdr goals))
+;;     vars))
+
+;; (defthm logic.variable-listp-of-tactic.discover-elim-vars-for-all-goals
+;;   (implies (logic.variable-listp vars)
+;;            (equal (logic.variable-listp (tactic.discover-elim-vars-for-all-goals vars goals))
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable tactic.discover-elim-vars-for-all-goals))))
+
+;; (defund tactic.find-var-to-elim (goals)
+;;   ;; We first discover the elim'able vars in the first goal.  We then remove
+;;   ;; all the vars which aren't elim'able in later goals.  Finally we pick the
+;;   ;; first remaining var if there is one.
+;;   (declare (xargs :guard (and (logic.term-list-listp goals)
+;;                               (cons-listp goals))))
+;;   (and (consp goals)
+;;        (car (tactic.discover-elim-vars-for-all-goals
+;;              (tactic.discover-elim-vars-for-goal (car goals) nil)
+;;              (cdr goals)))))
+
+;; (defthm logic.variablep-of-tactic.find-var-to-elim
+;;   (implies (tactic.find-var-to-elim goals)
+;;            (equal (logic.variablep (tactic.find-var-to-elim goals))
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable tactic.find-var-to-elim))))
+
+;; (defund tactic.auto-elim-tac (x warnp)
+;;   ;; We try to detect an elim'able variable and eliminate it.
+;;   (declare (xargs :guard (and (tactic.skeletonp x)
+;;                               (booleanp warnp))))
+;;   (let ((goals (tactic.skeleton->goals x)))
+;;     (if (not (consp goals))
+;;         (and warnp
+;;              (ACL2::cw "~s0auto-elim failure~s1: all goals are already proven.~%" *red* *black*))
+;;       (let ((chosen-var (tactic.find-var-to-elim goals)))
+;;         (if (not chosen-var)
+;;             (and warnp
+;;                  (ACL2::cw "~s0auto-elim failure~s1: no candidate variable detected.~%" *red* *black*))
+;;           (tactic.conditional-eqsubst-all-tac x
+;;                                               (logic.function 'consp (list chosen-var))
+;;                                               chosen-var
+;;                                               (logic.function 'cons (list (logic.function 'car (list chosen-var))
+;;                                                                           (logic.function 'cdr (list chosen-var))))
+;;                                               warnp))))))
+
+;; (defthm forcing-tactic.skeletonp-of-tactic.auto-elim-tac
+;;   (implies (and (tactic.auto-elim-tac x warnp)
+;;                 (force (tactic.skeletonp x)))
+;;            (equal (tactic.skeletonp (tactic.auto-elim-tac x warnp))
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable tactic.auto-elim-tac))))
+
+
+
+
+(defund tactic.apply-strategy-step (step x theoryname cfastp ufastp world names)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (symbolp theoryname)
+                              (booleanp cfastp)
+                              (booleanp ufastp)
+                              (tactic.worldp world)
+                              (elim.namesp names))))
+  (let ((result (cond ((equal step 'cleanup)
+                       (ACL2::prog2$ (ACL2::cw "(%cleanup)~|")
+                                     (tactic.cleanup-tac x nil)))
+                      ((equal step 'urewrite)
+                       (ACL2::prog2$ (ACL2::cw "(%urewrite ~s0)~|" theoryname)
+                                     (tactic.urewrite-all-tac x theoryname ufastp world nil)))
+                      ((equal step 'crewrite)
+                       (ACL2::prog2$ (ACL2::cw "(%crewrite ~s0)~|" theoryname)
+                                     (tactic.crewrite-all-tac x theoryname cfastp world nil)))
+                      ((equal step 'dist)
+                       (ACL2::prog2$ (ACL2::cw "(%distribute)~|")
+                                     (tactic.distribute-all-tac x nil)))
+                      ((equal step 'split)
+                       ;; At one point in time we just tried full splitting and if-lifting.  But this
+                       ;; turned out to be far too expensive.  We added the liftlimit to prevent some
+                       ;; lifting.  We can do even better by trying to do lift-free splitting initially.
+                       ;; This lets us intersperse a cleanup pass between our cheap split and more
+                       ;; aggressive splitting.
+                       (ACL2::prog2$ (ACL2::cw "(%split)~|")
+                                     (or (tactic.split-all-tac nil
+                                                               (tactic.world->liftlimit world)
+                                                               (tactic.world->splitlimit world)
+                                                               x nil)
+                                         ;; BOZO try adding another call with splitlimit=5 or
+                                         ;; something else that's relatively low in here?
+                                         (tactic.split-all-tac t
+                                                               (tactic.world->liftlimit world)
+                                                               (tactic.world->splitlimit world)
+                                                               x nil))))
+                      ((equal step 'elim)
+                       (ACL2::prog2$ (ACL2::cw "(%car-cdr-elim)~|")
+                                     (tactic.elim-all-tac x names nil)))
+                      (t
+                       (ACL2::cw "Error in %auto: tried to apply unknown step: ~x0.~%" step)))))
+    (ACL2::prog2$ (if result
+                      (ACL2::cw ";; Progress; ~x0 goals remain~|"
+                                (fast-len (tactic.skeleton->goals result) 0))
+                    (ACL2::cw ";; No progress~|"))
+                  result)))
+
+(defthm tactic.skeletonp-of-tactic.apply-strategy-step
+  (implies (and (tactic.apply-strategy-step step x theoryname cfastp ufastp world names)
+                (force (tactic.skeletonp x))
+                (force (tactic.worldp world))
+                (force (elim.namesp names)))
+           (equal (tactic.skeletonp (tactic.apply-strategy-step step x theoryname cfastp ufastp world names))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.apply-strategy-step))))
+
+(defund tactic.apply-strategy (strategy x theoryname cfastp ufastp world names)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (symbolp theoryname)
+                              (booleanp cfastp)
+                              (booleanp ufastp)
+                              (tactic.worldp world)
+                              (elim.namesp names))))
+  (if (consp strategy)
+      (or (tactic.apply-strategy-step (car strategy) x theoryname cfastp ufastp world names)
+          (tactic.apply-strategy (cdr strategy) x theoryname cfastp ufastp world names))
+    nil))
+
+(defthm tactic.skeletonp-of-tactic.apply-strategy
+  (implies (and (tactic.apply-strategy strategy x theoryname cfastp ufastp world names)
+                (force (elim.namesp names))
+                (force (tactic.skeletonp x))
+                (force (tactic.worldp world)))
+           (equal (tactic.skeletonp (tactic.apply-strategy strategy x theoryname cfastp ufastp world names))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.apply-strategy))))
+
+
+
+(defund tactic.auto-tac (x strategy theoryname cfastp ufastp world names auto-n)
+  ;; The auto tactic might be more properly called a "tactical" than a "tactic".
+  ;; We try to repeatedly apply conditional rewriting, splitting, and
+  ;; car-cdr-elim to simplify a goal.
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (symbolp theoryname)
+                              (booleanp cfastp)
+                              (booleanp ufastp)
+                              (tactic.worldp world)
+                              (elim.namesp names))
+                  :measure (nfix auto-n)
+                  :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force))))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        ;; All the goals are proven, we can stop.
+        x
+      (let ((step (tactic.apply-strategy strategy x theoryname cfastp ufastp world names)))
+        (if step
+            ;; Able to make some progress.  Continue our loop if we can.
+            (if (zp auto-n)
+                (ACL2::prog2$ (ACL2::cw "~s0warning~s1: out of steps in auto-tac.~%" *red* *black*)
+                              step)
+              (tactic.auto-tac step strategy theoryname cfastp ufastp world names (- auto-n 1)))
+          ;; No progress was made.  Stop here.
+          x)))))
+
+(defun %tactic.auto-tac-wrapper (x strategy theoryname cfastp ufastp world names auto-n)
+  ;; To avoid the expensive parts of guard-checking.
+  (declare (xargs :mode :program))
+  (tactic.auto-tac x strategy theoryname cfastp ufastp world names auto-n))
+
+(defmacro %auto (&key (theory   'default)
+                      (strategy '(cleanup split dist urewrite crewrite elim))
+                      (steps    '500))
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton   ACL2::world))
+                               (cfastp     (tactic.harness->cfastp     ACL2::world))
+                               (ufastp     (tactic.harness->ufastp     ACL2::world))
+                               (strategy   ',strategy)
+                               (theoryname ',theory)
+                               (world      (tactic.harness->world      ACL2::world))
+                               (names      (%tactic.harness->create-elim-names-wrapper (tactic.skeleton->goals skelly)))
+                               (auto-n     ',steps)
+                               (new-skelly (%tactic.auto-tac-wrapper skelly strategy theoryname
+                                                                     cfastp ufastp world names auto-n)))
+                          new-skelly)))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))
+    (local (%print))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/cert.acl2 acl2-6.3/books/milawa/ACL2/interface/cert.acl2
--- acl2-6.2/books/milawa/ACL2/interface/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/cert.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1 @@
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/interface/cert.image acl2-6.3/books/milawa/ACL2/interface/cert.image
--- acl2-6.2/books/milawa/ACL2/interface/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/cert.image	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1 @@
+interface-acl2
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/interface/compact-print-raw.lsp acl2-6.3/books/milawa/ACL2/interface/compact-print-raw.lsp
--- acl2-6.2/books/milawa/ACL2/interface/compact-print-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/compact-print-raw.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,704 @@
+; compact-print-raw.lsp
+; Copyright (C) 2011  University of Texas at Austin
+
+; This program is free software; you can redistribute it and/or modify
+; it under the terms of Version 2 of the GNU General Public License as
+; published by the Free Software Foundation.
+
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+; GNU General Public License for more details.
+
+; You should have received a copy of the GNU General Public License
+; along with this program; if not, write to the Free Software
+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(in-package "ACL2")
+
+; compact-print-raw.lsp
+;
+; This file is DEPRECATED.  It is provided only so that former users of
+; compact-print and compact-read can still access them.
+;
+; This file was derived from the original Hons and Memoization code developed
+; by Bob Boyer and Warren Hunt.  This code was formerly part of the
+; experimental Hons version of ACL2.
+;
+; Jared split these functions out of memoize-raw.lisp when he added the new
+; serialization code to ACL2.  He suggests using the new ACL2 commands
+; serialize-read and serialize-write instead of these routines.
+
+#-hons
+(eval-when
+ (:execute :compile-toplevel :load-toplevel)
+ (format t "Warning: compact-print-raw.lsp is doing nothing because #+hons ~
+            is not set."))
+
+
+#+hons
+(progn
+
+
+
+
+; HONS READ
+
+; Hash consing when reading is implemented via a change to the readtable for
+; the characters open parenthesis, close parenthesis, and period, the consing
+; dot.
+
+
+; See matching comment below.
+
+; Note: our implementation of the #=/## reader, which we built because some
+; Lisps would not let us get past #500 or so, does not comply with ANSI at
+; least in this regard: it does not allow the entry of looping structures as in
+; '(#0= (3 #0#)), which is no problem for ACL2 users.
+
+; WARNING: Any call of READ using *hons-readtable* as *readtable* needs to
+; worry about the possible top-level return of HREAD-CLOSE-PAREN-OBJ and
+; HREAD-DOT-OBJ, which are simply part of the fiction whereby we read while
+; honsing.  Those two objects should absolutely not be returned as the value of
+; an ACL2 function.  See, for example, the definition of HONS-READ.
+
+
+; *** NOTE:  The following collection of functions is just that: a
+;            collection.  Unless you understand everything about the
+;            various read table macros, then don't touch this code!
+;
+; [Jared]: poke, poke, poke...
+
+
+
+
+;; [Jared]: I turned these into defconstants instead of defgs, since they are
+;; never written, to further separate this from the memoize code.
+
+;; [Jared]: hrmn, well, sbcl seems to gripe about them being redeclared.  I don't
+;; understand why.  I'll make them parameters instead
+
+(defparameter hread-close-paren-obj '(#\)))
+(defparameter hread-dot-obj         '(#\.))
+
+;; [Jared]: note that these get reinitialized in hons-readtable-init
+(defg *hons-readtable*        (copy-readtable *acl2-readtable*))
+(defg *hacked-acl2-readtable* (copy-readtable *acl2-readtable*))
+
+(defvar *compact-print-file-ht*)
+(declaim (hash-table *compact-print-file-ht*))
+
+(defparameter *hons-read-ht* nil) ; bound sometimes
+
+(defmacro hons-read-ar-len () (expt 2 21))
+
+(defparameter *hons-read-ar*
+  (make-array (hons-read-ar-len) :initial-element 0))
+
+(defparameter *hons-read-ar-max* -1)
+
+(defparameter *compact-print-file-n* 0)
+(declaim (type fixnum *compact-print-file-n*))
+
+
+; [Jared]: using defg for this probably breaks any attempt to compact-print
+; from multiple threads at the same time.  We should fix this.
+(defg *space-owed* nil)
+
+(defun hread-nonsense (x)
+  (or (eq x hread-close-paren-obj) (eq x hread-dot-obj)))
+
+(defun check-hread-nonsense (x stream)
+  (cond ((hread-nonsense x)
+         (hread-error "~&;  Illegal object: ~s." stream (car x)))))
+
+(defun hread-error (string stream &rest r)
+  (our-syntax-nice
+   (let* ((*standard-input* *debug-io*))
+     (apply #'format *error-output* string r)
+     (cond ((and (streamp stream) (file-position stream))
+            (format *error-output*
+                    "~&; near file-position ~s in stream ~s."
+                    (file-position stream) stream)))
+     (error "hread."))))
+
+(defun illegal-error1 (x stream)
+  (hread-error "~&; ** Error:  Illegal:  ~s." stream x))
+
+(defun illegal-error2 (stream char)
+  (illegal-error1 char stream))
+
+(defun close-paren-read-macro (stream char)
+  (declare (ignore char))
+  (if *read-suppress* (illegal-error1 #\\ stream))
+  hread-close-paren-obj)
+
+(defun dot-read-macro (stream char)
+  (declare (ignore char))
+  (if *read-suppress* (illegal-error1 #\. stream))
+  (let ((ch (peek-char nil stream t nil t)))
+    (cond ((or (member ch '(#\( #\) #\' #\` #\, #\" #\;
+                            #\Tab #\Space #\Newline))
+               (eql 13 (char-code ch))
+               (multiple-value-bind (fn nonterminating)
+                   (get-macro-character ch)
+                 (and fn (not nonterminating))))
+           hread-dot-obj)
+          (t (let ((*readtable* *acl2-readtable*))
+               (unread-char #\. stream)
+               (hons-copy (read stream t nil t)))))))
+
+(defun hons-read-list (stream)
+
+  ; HONS-READ-LIST must return a HONSP whenever it turns a CONSP, even
+  ; when the object comes from some readmacro such as that for quote
+  ; or backquote that might return a CONS.  Hence the calls to
+  ; HONS-COPY.
+
+  (let ((o (read stream t nil t)))
+    (cond
+     ((eq o hread-close-paren-obj) nil)
+     ((eq o hread-dot-obj)
+      (let ((lo (read stream t nil t))
+            (lp (read stream t nil t)))
+        (check-hread-nonsense lo stream)
+        (cond
+         ((eq lp hread-close-paren-obj)
+          (hons-copy lo))
+         (t (illegal-error1 #\. stream)))))
+     (t (hons o (hons-read-list stream))))))
+
+(defun hons-read-list-top (stream)
+
+  (let ((o (read stream t nil t)))
+    (cond
+     ((eq o hread-close-paren-obj) nil)
+     (t (check-hread-nonsense o stream)
+        (hons o (hons-read-list stream))))))
+
+(defun hons-read-reader (stream char)
+
+  (declare (ignore char))
+  (cond (*read-suppress*
+         (unread-char #\( stream)
+         (let ((*readtable* *acl2-readtable*))
+           (read stream t nil t)
+           nil))
+        (t (hons-read-list-top stream))))
+
+(defg *use-hons-in-read-object* t)
+
+(defun clear-hons-read-ar (index)
+  (loop for i from 0 to index do
+        (setf (aref (the (simple-array t (*)) *hons-read-ar*)
+                    (the fixnum i))
+              0)))
+
+(defvar *inside-hons-read*
+; WARNING: Do not use defg, since this variable can be let-bound.
+  nil)
+
+(defun hons-read (&optional stream (eep t) eofv rp)
+
+  "HONS-READ takes the same args as READ.  If *USE-HONS-IN-READ-OBJECT* is
+  non-NIL, then HONS is used in the reading instead of CONS.
+
+  We currently disallow any call of hons-read with rp=nil inside a call of
+  hons-read."
+
+  (when (and (not rp) *inside-hons-read*)
+    (error "Recursive hons-read!"))
+  (let ((*inside-hons-read* t)
+        (our-eofv (cons nil nil)))
+    (cond (*use-hons-in-read-object*
+
+; Although a readmacro such as quote or backquote might return a CONS
+; that is not HONSP, HONS-READ-LIST will turn those into HONSES.
+
+           (cond (rp ; DO NOT BIND *HONS-READ-HT/AR-MAX*.
+                  (let* ((*readtable* *hons-readtable*)
+                         (x (read stream eep our-eofv rp)))
+                    (cond ((and (null eep) (eq x our-eofv))
+                           eofv)
+                          (t (check-hread-nonsense x stream)
+                             (hons-copy x)))))
+                 (t ; DO BIND *HONS-READ-HT/AR-MAX*, OTHERWISE SAME.
+                  (let* ((*hons-read-ht* nil)
+                         (*hons-read-ar-max* -1)
+                         (*readtable* *hons-readtable*)
+                         (x (read stream eep our-eofv rp)))
+                    (clear-hons-read-ar *hons-read-ar-max*)
+                    (cond ((and (null eep) (eq x our-eofv))
+                           eofv)
+                          (t (check-hread-nonsense x stream)
+                             (hons-copy x)))))))
+          (t (cond (rp ; DO NOT BIND *HONS-READ-HT/AR-MAX*.
+                    (let* ((*readtable* *hacked-acl2-readtable*)
+                           (x (read stream eep our-eofv rp)))
+                      (cond ((and (null eep) (eq x our-eofv))
+                             eofv)
+                            (t x))))
+                   (t ; DO BIND *HONS-READ-HT/AR-MAX*, OTHERWISE SAME.
+                    (let* ((*hons-read-ht* nil)
+                           (*hons-read-ar-max* -1)
+                           (*readtable* *hacked-acl2-readtable*)
+                           (x (read stream eep our-eofv rp)))
+                      (clear-hons-read-ar *hons-read-ar-max*)
+                      (cond ((and (null eep) (eq x our-eofv))
+                             eofv)
+                            (t x)))))))))
+
+(defun hons-read-file (file-name)
+  (with-open-file (stream file-name)
+    (let ((eof (cons nil nil)) temp ans)
+      (loop (setq temp (hons-read stream nil eof nil))
+            (cond ((eq eof temp)
+                   (setq ans (nreverse ans))
+                   (when *use-hons-in-read-object*
+                     (setq ans (hons-copy ans)))
+                   (return ans))
+                  (t (push temp ans)))))))
+
+
+;  COMPACT PRINT AND READ
+
+(defun compact-read-file (fn)
+
+; May be called directly.
+
+   "(COMPACT-READ-FILE fn) READs the first Lisp/ACL2 form of the file named FN.
+   The file should have exactly one Lisp object in it.
+
+   HONS is used instead of CONS while reading when *USE-HONS-IN-READ-OBJECT* is
+   not NIL.
+
+   The *ACL2-READTABLE* is used during reading.  The reading respects Common
+   Lisp's #2= and #2# readmacro support, but not for circular cons structures."
+
+   (with-open-file (stream fn)
+     (let* ((eof (cons nil nil))
+            (p (hons-read stream nil eof nil)))
+          (when (eq p eof)
+            (error "compact-read-file: ~s appears empty." fn))
+          (unless (eq (read stream nil eof) eof)
+            (error "compact-read-file: ~s has too many forms." fn))
+          p)))
+
+
+
+(defmacro space-if-necessary (stream)
+
+; do not call
+
+  `(when *space-owed*
+     (write-char #\Space ,stream)
+     (setq *space-owed* nil)))
+
+(defun compact-print-file-scan (x)
+
+; do not call
+
+  (unless (or (and (symbolp x)
+                   (let ((p (symbol-package x)))
+                     (or (eq p *main-lisp-package*)
+                         (eq p *package*)))
+                   (<= (length (symbol-name x)) 4))
+
+              ; On the one hand, in ANSI Lisp, you can't READ the same
+              ; string twice.  On the other hand, in HONSing, we
+              ; cannonicalize strings.  Should we or shouldn't we
+              ; identify common strings here?  Sometimes we do, and
+              ; sometimes we don't.
+
+              (and (stringp x) (<= (length x) 2))
+              (and (integerp x) (< -100 x 1000))
+              (characterp x))
+    (let ((g (gethash x *compact-print-file-ht*)))
+      (unless (or (atom x) g)
+        (compact-print-file-scan (car x))
+        (compact-print-file-scan (cdr x)))
+      (unless (eq g 'give-it-a-name)
+        (setf (gethash x *compact-print-file-ht*)
+              (if g 'give-it-a-name 'found-at-least-once))))))
+
+(defun compact-print-file-help (x hash stream)
+
+; do not call directly.
+
+  (cond ((typep hash 'fixnum)
+         (space-if-necessary stream)
+         (write-char #\# stream)
+         (princ hash stream)
+         (write-char #\# stream))
+        (t (cond ((eq hash 'give-it-a-name)
+                  (let ((n *compact-print-file-n*))
+                    (declare (type fixnum n))
+                    (when (eql n most-positive-fixnum)
+                      (error "*compact-print-file-n* overflow."))
+                    (setq n (the fixnum (+ 1 n)))
+                    (setq *compact-print-file-n* n)
+                    (setf (gethash x *compact-print-file-ht*) n)
+                    (space-if-necessary stream)
+                    (write-char #\# stream)
+                    (princ n stream)
+                    (write-char #\= stream))))
+           (cond
+            ((null x)
+             (write-char #\( stream)
+             (write-char #\) stream)
+             (setq *space-owed* nil))
+            ((atom x)
+             (space-if-necessary stream)
+
+             ; This PRIN1 could commence with a vertical bar that
+             ; might be immediately preceded by a sharp sign, which
+             ; could confuse comment reading.
+
+             (prin1 x stream)
+             (setq *space-owed* t))
+            (t (write-char #\( stream)
+               (setq *space-owed* nil)
+               (loop (compact-print-file-help
+                      (car x)
+                      (gethash (car x) *compact-print-file-ht*)
+                      stream)
+                     (cond
+                      ((null (cdr x))
+                       (write-char #\) stream)
+                       (setq *space-owed* nil)
+                       (return))
+                      ((or (progn
+                             (setq hash
+                                   (gethash (cdr x)
+                                            *compact-print-file-ht*))
+                             (or (eq hash 'give-it-a-name)
+                                 (typep hash 'fixnum)))
+                           (atom (cdr x)))
+                       (space-if-necessary stream)
+                       (write-char #\. stream)
+                       (setq *space-owed* t)
+                       (compact-print-file-help (cdr x) hash stream)
+                       (write-char #\) stream)
+                       (setq *space-owed* nil)
+                       (return))
+                      (t (pop x)))))))))
+
+(defun compact-print-stream (data stream)
+  (cond ((null *print-circle-stream*)
+         (error "Attempt to call compact-print-stream without ~
+                 initializing ~% *print-circle-stream*.  Consider ~
+                 opening output ~% channel with macro ~
+                 with-output-object-channel-sharing."))
+        ((not (eq stream *print-circle-stream*))
+         (error "Attempt to call compact-print-stream on other ~
+                 than the current stream.")))
+  (let ((*compact-print-file-ht* (hl-mht))
+        (*print-array* t))
+    (setq *space-owed* nil)
+    (let ((p *package*))
+      (loop for two in
+
+            ;; We'll cause an error if the settings of these are
+            ;; different than they will be under OUR-SYNTAX.
+
+            '((*print-array*                t)
+              (*print-base*                 10)
+              (*print-case*                 :upcase)
+              (*print-circle*               t)
+              (*print-escape*               t)
+              (*print-pretty*               nil)
+              (*print-radix*                nil)
+              (*read-base*                  10)
+              (*read-suppress*              nil)
+              (*readtable*                  *acl2-readtable*))
+            when (not (equal (symbol-value (car two))
+                             (if (symbolp (cadr two))
+                                 (symbol-value (cadr two))
+                               (cadr two))))
+            do
+            (error "PRINT-COMPACT-STREAM: Problem with the setting of ~a" two))
+
+; Currently, there is no way from within ACL2 to alter
+; READTABLE-CASE.  Thank goodness.  So the following error will
+; never happen.  But if ACL2 were someday 'enhanced' to permit
+; control over READTABLE-CASE, there just might be a problem
+; about the setting of *PRINT-READABLY* to T by OUR-SYNTAX
+; below if the current setting of *PRINT-READABLY* were NIL.
+
+      ;; *PACKAGE* -- we let the user use any ACL2 package.
+
+      (unless (eq (readtable-case *acl2-readtable*) :upcase)
+        (error "PRINT-COMPACT-STREAM: Problem with the setting of ~
+               (readtable-case *acl2-readtable*)."))
+
+      ;; We do not cause an error if the following *PRINT-...*
+      ;; variable settings are different from what OUR-SYNTAX will
+      ;; effect, and for many good reasons, as follows.
+
+      ;; *PRINT-READABLY* -- a very tedious explanation.  When
+      ;; *PRINT-READABLY* is T, then some extra errors may be caught
+      ;; when attempting to print unprintable objects, and there are
+      ;; effects upon the printing of arrays.  OUR-SYNTAX binds
+      ;; *PRINT-READABLY* to T, and that will be O.K. because (a) we
+      ;; don't print packages or arrays in ACL2, (b) we want an error
+      ;; signaled by PRINT-OBJECT$ whenever it might be appropriate,
+      ;; and (c) as far as we can imagine, when printing any ordinary
+      ;; ACL2 object no errors should arise, excepting of the
+      ;; catastrophic sort, e.g., disk space exhaused, power outage,
+      ;; stack overflow.  But errors may well happen in printing some
+      ;; legitimate Lisp, as opposed to ACL2, objects, when printing
+      ;; with *PRINT-READABLY* bound to T, e.g., some bizarre
+      ;; 'floating point numbers' such as 'infinity', packages, and
+      ;; readtables.  Cf. the ANSI function PRINT-UNREADABLE-OBJECT.
+
+      ;; *PRINT-LENGTH*          -- only for pretty
+      ;; *PRINT-LEVEL*           -- only for pretty
+      ;; *PRINT-LINES*           -- only for pretty
+      ;; *PRINT-PPRINT-DISPATCH* -- only for pretty
+      ;; *PRINT-MISER-WIDTH*     -- only for pretty
+      ;; *PRINT-RIGHT-MARGIN*    -- only for pretty
+
+      ;; *READ-DEFAULT-FLOAT-FORMAT* -- no floats in ACL2
+
+      ;; *PRINT-GENSYM* -- no gensyms in ACL2
+
+      ;; *READ-EVAL* -- OUR-SYNTAX uses T for *READ-EVAL*.  But we
+      ;; don't print #. in compact-printing unless the # is properly
+      ;; quoted with vertical bars or back-slashes.
+
+      ;; Though OUR-SYNTAX binds *PRINT-CIRCLE* to NIL,
+      ;; COMPACT-PRINT-STREAM is designed to do the job that
+      ;; *PRINT-CIRCLE* should do, except for circular objects, which
+      ;; are not found in ACL2.
+
+      (our-syntax
+       (setq *package* p) ; Bound by OUR-SYNTAX to *ACL2-READTABLE*.
+       (compact-print-file-scan data)
+       (compact-print-file-help
+        data
+        (gethash data *compact-print-file-ht*)
+        stream)
+       nil))))
+
+(defun compact-print-file
+  (data file-name &key (if-exists :supersede))
+
+; May be called directly.
+
+  "(COMPACT-PRINT-FILE x str) PRIN1s x to a new file named str so that
+   Common Lisp can READ the result and get back something EQUAL,
+   assuming the package and readtable are the same on print and read.
+   COMPACT-PRINT-FILE prints as though *PRINT-CIRCLE* were T to
+   minimize printing by a kind of compression, using traditional Lisp
+   #..# syntax.  However, circular object are not handled.  See the
+   bindings of some *PRINT-...* variables via OUR-SYNTAX in
+   COMPACT-PRINT-STREAM, which favor accuracy and not prettiness.  The
+   ACL2 package, ACL2 readtable, and decimal *PRINT-BASE* are used."
+
+  (setq *compact-print-file-n* 0)
+  (with-open-file (stream file-name
+                          :direction :output
+                          :if-exists if-exists)
+    (let ((*print-circle-stream* stream)
+
+; These *print... and *read... settings are deliberately inflicted
+; upon the user of COMPACT-PRINT-FILE.  The user is still free to
+; choose *PACKAGE*.  Read the comment in compact-print-stream for
+; information about our rather fascist approach to these settings.
+
+          (*print-base* 10)
+          (*print-case* :UPCASE)
+          (*print-circle* t)
+          (*print-escape* t)
+          (*print-pretty* nil)
+          (*read-base* 10)
+          (*read-eval* t)  ; to support #.constant printing
+          (*read-suppress* nil)
+          (*readtable* *acl2-readtable*)
+
+          ; Not relevant once one knows that *PRINT-PRETTY* is NIL:
+
+          (*print-length* nil)
+          (*print-level* nil)
+          (*print-lines* nil)
+          (*print-radix* nil)
+          (*print-right-margin* nil)
+
+          ; Not relevant when printing only ACL2 objects:
+
+          (*print-readably* t)
+          (*read-default-float-format*  'single-float)
+          (*print-gensym* t)
+          (*print-array* t)
+
+          ; This one is crucial to know about since strings are ACL2
+          ; objects:
+
+          #+CCL
+          (ccl::*print-string-length* nil)
+
+          #+CCL
+          (ccl::*print-abbreviate-quote* nil)
+
+          ; These are irrelevant as long as we are printing
+          ; an ACL2 object.
+
+          #+CCL
+          (ccl::*print-structure* t)
+          #+CCL
+          (ccl::*print-simple-vector* nil)
+          #+CCL
+          (ccl::*print-simple-bit-vector* nil)
+
+          ; Do many other Lisps have their own private set of secret
+          ; print control variables?
+
+          )
+      (compact-print-stream data stream))
+    (namestring (our-truename stream))))
+
+(defun ns-=-reader (stream subchar arg)
+
+; We don't use DEFUN because this function might return 0 values.
+
+; Do not call ns-=-reader directly.
+
+; NS-=-READER intentionally does not read circular Lisp objects
+; correctly, such as those normally created by reading #2=(1 #2#).
+; Such a circular object could not be an ACL2 object anyway.  An
+; attempt to read such an object will result in a clean error, e.g., a
+; report that the expression #2# makes no sense because a #2= ?
+; expression has not been fully read.
+
+; *HONS-READ-HT* must always have a value, either NIL or a hash table;
+; cf. READ-OBJECT and COMPACT-READ-FILE.
+
+; *HONS-READ-AR* must always have a value, either NIL or a simple
+; vector.  cf. READ-OBJECT and COMPACT-READ-FILE.
+
+  (declare (ignore subchar))
+  (cond ((null arg)
+         (hread-error "~&; ns-=-reader: ** Error: #= is illegal."
+                      stream arg))
+        (*read-suppress* (values))
+        ((< arg (hons-read-ar-len))
+         (let ((x (read stream t nil t)))
+           (cond ((eql x 0) ; 0 might be confused for the default
+                  (unless *hons-read-ht*
+                    (setq *hons-read-ht* (make-hash-table)))
+                  (multiple-value-bind (val present-p)
+                      (gethash arg *hons-read-ht*)
+                    (when present-p
+                      (hread-error
+                       "~&; ns-=-reader: ** Error: #~s= is already ~
+                        defined to be ~s."
+                       stream arg val))
+                    (setf (gethash arg *hons-read-ht*) 0)))
+                 (t (setf *hons-read-ar-max*
+                          (max (the fixnum *hons-read-ar-max*)
+                               (the fixnum arg)))
+                    (setf (aref (the (simple-array t (*))
+                                  *hons-read-ar*)
+                                (the fixnum arg))
+                          x)))))
+        (*hons-read-ht*
+         (multiple-value-bind (val present-p)
+             (gethash arg *hons-read-ht*)
+           (when present-p
+             (hread-error
+              "~&; ns-=-reader: ** Error: #~s= is already ~
+               defined to be ~s."
+              stream arg val))
+           (setf (gethash arg *hons-read-ht*)
+                 (read stream t nil t))))
+        (t (setq *hons-read-ht* (make-hash-table))
+           (setf (gethash arg *hons-read-ht*)
+                 (read stream t nil t)))))
+
+(defun ns-ns-reader (stream subchar arg)
+
+; Do not call NS-NS-READER directly.
+
+; *HONS-READ-HT* must always have as its value NIL or a hash table.
+; *HONS-READ-AR* must always have as its value NIL or a simple,
+; one-dimensional array.  cf. READ-OBJECT and COMPACT-READ-FILE.
+
+  (declare (ignore subchar))
+  (cond (*read-suppress* nil)  ; ?
+        ((null arg)
+         (hread-error
+          "~&; ns-ns-reader: ** Error: meaningless ##."
+          stream arg))
+        ((and *hons-read-ar* (< arg (hons-read-ar-len)))
+         (let ((ans (aref (the (simple-array t (*)) *hons-read-ar*)
+                          (the fixnum arg))))
+           (cond ((eql ans 0) ; could be the default
+                  (unless *hons-read-ht*
+                    (setq *hons-read-ht* (make-hash-table)))
+                  (multiple-value-bind (val present-p)
+                      (gethash arg *hons-read-ht*)
+                    (cond (present-p val)
+                          (t (hread-error
+                              "~&; ns-ns-reader: ** Error: ~
+                               meaningless #~s#."
+                              stream arg)))))
+                 (t ans))))
+        (*hons-read-ht*
+         (multiple-value-bind (val present-p)
+             (gethash arg *hons-read-ht*)
+           (cond (present-p val)
+                 (t (hread-error
+                     "~&; ns-ns-reader: ** Error: meaningless ~
+                      #~s#."
+                     stream arg)))))
+        (t (hread-error
+            "~&; ns-ns-reader:  ** Error:  meaningless #~s#."
+            stream arg))))
+
+
+;  HONS READTABLE INIT
+
+(defg *hons-readtable-init-done* nil)
+
+(defun hons-readtable-init ()
+
+  (when *hons-readtable-init-done*
+    ;; Already initialized
+    (return-from hons-readtable-init nil))
+
+  (setq *hons-readtable*
+        ;; BOZO why?  it already started as a copy of the acl2-readtable...
+        (copy-readtable *acl2-readtable*))
+
+  (set-macro-character
+   #\( #'hons-read-reader       nil *hons-readtable*)
+  (set-macro-character
+   #\) #'close-paren-read-macro nil *hons-readtable*)
+  (set-macro-character
+   #\. #'dot-read-macro         t   *hons-readtable*)
+  (set-dispatch-macro-character
+   #\# #\# #'ns-ns-reader           *hons-readtable*)
+  (set-dispatch-macro-character
+   #\# #\= #'ns-=-reader            *hons-readtable*)
+
+  (setq *hacked-acl2-readtable*
+        ;; BOZO why?  it already started as a copy of the acl2-readtable...
+        (copy-readtable *acl2-readtable*))
+
+  (set-dispatch-macro-character
+   #\# #\# #'ns-ns-reader           *hacked-acl2-readtable*)
+  (set-dispatch-macro-character
+   #\# #\= #'ns-=-reader            *hacked-acl2-readtable*)
+
+  (setq *hons-readtable-init-done* t))
+
+
+
+)
+
+
+; [Jared] formerly this was called as part of hons-init-hook...
+; maybe this is sufficient?
+#+hons
+(eval-when (:load-toplevel)
+ (hons-readtable-init))
diff -Nru acl2-6.2/books/milawa/ACL2/interface/compact-print.acl2 acl2-6.3/books/milawa/ACL2/interface/compact-print.acl2
--- acl2-6.2/books/milawa/ACL2/interface/compact-print.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/compact-print.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,2 @@
+(in-package "ACL2")
+; cert-flags: ? t :ttags :all
diff -Nru acl2-6.2/books/milawa/ACL2/interface/compact-print.lisp acl2-6.3/books/milawa/ACL2/interface/compact-print.lisp
--- acl2-6.2/books/milawa/ACL2/interface/compact-print.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/compact-print.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,62 @@
+; compact-print.lisp
+; Copyright (C) 2011  University of Texas at Austin
+
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of Version 2 of the GNU General Public License as published by the
+; Free Software Foundation.
+
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+; GNU General Public License for more details.
+
+; You should have received a copy of the GNU General Public License
+; along with this program; if not, write to the Free Software
+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(in-package "ACL2")
+; (depends-on "compact-print-raw.lsp")
+
+; compact-print.lisp
+;
+; This file is DEPRECATED.  It is provided only so that former users of
+; compact-print and compact-read can still access them.
+;
+; This file was derived from the original Hons and Memoization code developed
+; by Bob Boyer and Warren Hunt.  This code was formerly part of the
+; experimental Hons version of ACL2.
+;
+; Jared split these functions out of memoize-raw.lisp when he added the new
+; serialization code to ACL2.  He suggests using the new ACL2 commands
+; serialize-read and serialize-write instead of these routines.
+
+(include-book "tools/include-raw" :dir :system)
+
+
+(make-event
+ (prog2$ (cw "Note: Using compact-print is deprecated; see :doc serialize ~
+              for a replacement.~%")
+         '(value-triple :invisible))
+ :check-expansion t)
+
+
+(defttag compact-print)
+(include-raw "compact-print-raw.lsp")
+
+
+#||
+
+; Well, it seems to work...
+
+(include-book ;; newline to fool dependency scanner
+ "compact-print")
+
+:q
+
+(let* ((x (cons 1 2))
+       (y (cons x x)))
+  (compact-print-file y "foo"))
+
+(compact-read-file "foo")
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/interface/compact-write-file.acl2 acl2-6.3/books/milawa/ACL2/interface/compact-write-file.acl2
--- acl2-6.2/books/milawa/ACL2/interface/compact-write-file.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/compact-write-file.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,3 @@
+(in-package "ACL2")
+(include-book "../portcullis")
+; cert-flags: ? t :ttags :all
diff -Nru acl2-6.2/books/milawa/ACL2/interface/compact-write-file.lisp acl2-6.3/books/milawa/ACL2/interface/compact-write-file.lisp
--- acl2-6.2/books/milawa/ACL2/interface/compact-write-file.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/compact-write-file.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,78 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(include-book "misc/hons-help2" :dir :system)
+(include-book "compact-print")
+
+;; This is the same as ACL2's compact-write-file, except that it prints symbols
+;; from the MILAWA package instead of the ACL2 package.  This helps keep file
+;; sizes down, e.g., we only print PEQUAL* instead of MILAWA::PEQUAL*, etc.
+;;
+;; Though we use a ttag, this should be a sound extension of ACL2 as it does
+;; not muck with any system internals.
+
+(defund MILAWA::compact-write-file (data filename)
+  (declare (xargs :guard t)
+           (ignore data))
+  (progn$
+   (cw "Warning: compact-write-file has not been redefined!~%")
+   filename))
+
+(defttag compact-write-file)
+
+(progn!
+ (set-raw-mode t)
+ (defund MILAWA::compact-write-file (data filename)
+   (setq *compact-print-file-ht* (hl-mht))
+   (setq *compact-print-file-n* 0)
+   (setq *space-owed* nil)
+   (with-open-file (*standard-output* filename
+                                      :direction :output
+                                      :if-does-not-exist :create
+                                      :if-exists :supersede)
+                   (with-standard-io-syntax
+                    (let ((*package* (find-package "MILAWA"))
+                          (*readtable* *acl2-readtable*))
+                      (compact-print-file-scan data)
+                      (compact-print-file-help data
+                                               (gethash data *compact-print-file-ht*)
+                                               ;; In V3-5, an extra stream argument was added.  We still
+                                               ;; want to support v3-4, so we only sometimes add the arg.
+                                               #-v3-4 *standard-output*
+                                               )
+                      (setq *compact-print-file-ht* (hl-mht)))))
+   filename))
+
+(value-triple (milawa::compact-write-file '(1 . 2) "compact-write-file.test.out"))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/interface/core.lisp acl2-6.3/books/milawa/ACL2/interface/core.lisp
--- acl2-6.2/books/milawa/ACL2/interface/core.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/core.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1743 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "rule")
+(include-book "compact-write-file")
+(include-book "centaur/misc/seed-random" :dir :system)
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(ACL2::make-event
+ (let ((proofs-dir (ACL2::extend-pathname ACL2::*path-to-milawa-acl2-directory*
+                                          "../Proofs/"
+                                          ACL2::state)))
+   `(defconst *proofs-dir* ',proofs-dir)))
+
+(defun get-current-libdir (ACL2::state)
+  ;; The "libdir" is the immediate name of the directory this book resides in, i.e.,
+  ;; if the full path to the book is "/foo/bar/baz/sets", then the libdir is "sets".
+  ;; Ugh, ACL2 string manipulation is so shitty.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((cbd        (ACL2::cbd))
+         (cbd-rev    (ACL2::reverse cbd))
+         (cbd-rchars (STR::explode cbd-rev))
+         (chop1      (if (equal (car cbd-rchars) ACL2::*directory-separator*)
+                         (cdr cbd-rchars)
+                       cbd-rchars))
+         (pos        (ACL2::position ACL2::*directory-separator* chop1))
+         (rdirchars  (ACL2::take pos chop1))
+         (dirstr     (STR::implode (ACL2::reverse rdirchars))))
+    dirstr))
+
+(defun generate-filename (prefix name suffix ACL2::state)
+  ;; We generate files of the form "libdir/prefix-name.suffix"
+  ;;
+  ;; Previously we also generated the path name for the proofs/ directory relative
+  ;; to the current location for the book being certified, and some of the commented
+  ;; out lines below implement this.
+  ;;
+  ;; Our new approach is that generate-filename only creates the filename and not
+  ;; the directory.  The idea is to store everything into a single directory so we
+  ;; can zip it up and move it around, and refer to things only relatively so it is
+  ;; easy to move proofs.
+  ;;
+  ;; If you want to put the directory back into this function, you'll need to search
+  ;; for uses of generate-filename and modify them appropriately.
+  (declare (xargs :mode :program :stobjs ACL2::state)
+           (ACL2::ignorable ACL2::state))
+  (acl2::prog2$
+   ;; HACK -- we now seed the random number generator here because if we're
+   ;; generating a filename then we're probably about to write a file, and in
+   ;; CCL the :supersede mode of open-file is based on a random filename that
+   ;; derives from the current random seed, and if we have a bunch of ACL2
+   ;; processes all writing to the same directory then we can easily get
+   ;; clashes when they try to write their files.
+   (ACL2::seed-random$ 'generate-filename)
+   (let* ((libdir   (get-current-libdir ACL2::state))
+          (partname (STR::cat (ACL2::mangle-filename (ACL2::string-downcase (ACL2::symbol-name name)))
+                              "."
+                              (ACL2::string-downcase (ACL2::symbol-name suffix))))
+          (basename (if prefix
+                        (STR::cat (ACL2::string-downcase (ACL2::symbol-name prefix)) "-" partname)
+                      partname)))
+     (ACL2::extend-pathname libdir basename ACL2::state))))
+
+(defun logic.flag-warn-term-atblp (flag x atbl)
+  ;; This is the same as logic.term-atblp, but it usefully prints a warning to
+  ;; explain which subterm in particular is undefined or of improper arity.
+  (declare (xargs :mode :program))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) t)
+            ((logic.variablep x) t)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (and (or (equal (len args) (cdr (lookup name atbl)))
+                        (if (lookup name atbl)
+                            (ACL2::cw ";; Warning: found a call of the undefined function ~x0.~%" name)
+                          (ACL2::cw ";; Warning: found a call of ~x0 with ~x1 args, but it takes ~x2 args.~%" name (len args) (cdr (lookup name atbl)))))
+                    (logic.flag-warn-term-atblp 'list args atbl))))
+            ((logic.lambdap x)
+             (let ((body (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               (and (logic.flag-warn-term-atblp 'term body atbl)
+                    (logic.flag-warn-term-atblp 'list actuals atbl))))
+            (t nil))
+    (if (consp x)
+        (and (logic.flag-warn-term-atblp 'term (car x) atbl)
+             (logic.flag-warn-term-atblp 'list (cdr x) atbl))
+     t)))
+
+(defun logic.warn-term-atblp (x atbl)
+  (declare (xargs :mode :program))
+  (logic.flag-warn-term-atblp 'term x atbl))
+
+
+
+
+
+;; Core proof checker emulation
+;;
+;; We manage an evolving list of axioms, theorems, definitions, and an evolving
+;; arity table.  This basically emulates the Milawa core proof checker, except
+;; that we're pretty permissive and don't require termination proofs, etc.  The
+;; user could obviously tinker with these, and we do nothing to prevent that.
+;; To really check your proofs, you need to use the external Milawa checker.
+
+(ACL2::table tactic-harness 'axioms nil)
+(ACL2::table tactic-harness 'thms nil)
+(ACL2::table tactic-harness 'atbl (logic.initial-arity-table))
+
+(ACL2::table tactic-harness 'world
+             (tactic.world
+              0 ;; initial index
+              t ;; forcingp
+              t ;; betamode  NIL, T, or 'ONCE
+              1 ;; liftlimit
+              0 ;; splitlimit
+              50 ;; blimit
+              100 ;; rlimit
+              20 ;; rwn - still used?
+              20 ;; urwn - still used?
+              nil ;; noexec
+              nil ;; theories
+              nil ;; defs
+              500 ;; depth
+              nil ;; allrules
+              t ;; assm-primaryp
+              t ;; assm-secondaryp
+              t ;; assm-directp
+              t ;; assm-negativep
+              ))
+
+(defun tactic.harness->axioms (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'axioms (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->thms (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'thms (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->atbl (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'atbl (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->world (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'world (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->defs (acl2-world)
+  (declare (xargs :mode :program))
+  (tactic.world->defs (tactic.harness->world acl2-world)))
+
+(defun tactic.harness->depth (acl2-world)
+  (declare (xargs :mode :program))
+  (tactic.world->depth (tactic.harness->world acl2-world)))
+
+(defun tactic.world-wrapper (INDEX FORCINGP BETAMODE LIFTLIMIT SPLITLIMIT BLIMIT RLIMIT RWN URWN
+                                      NOEXEC THEORIES DEFS DEPTH ALLRULES ASSM-PRIMARYP
+                                      ASSM-SECONDARYP ASSM-DIRECTP ASSM-NEGATIVEP)
+  (declare (xargs :mode :program))
+  (tactic.world INDEX FORCINGP BETAMODE LIFTLIMIT SPLITLIMIT BLIMIT RLIMIT RWN URWN
+                NOEXEC THEORIES DEFS DEPTH ALLRULES
+                ASSM-PRIMARYP ASSM-SECONDARYP ASSM-DIRECTP ASSM-NEGATIVEP))
+
+(defun tactic.world->index-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->index x))
+
+(defun tactic.world->forcingp-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->forcingp x))
+
+(defun tactic.world->betamode-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->betamode x))
+
+(defun tactic.world->liftlimit-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->liftlimit x))
+
+(defun tactic.world->splitlimit-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->splitlimit x))
+
+(defun tactic.world->blimit-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->blimit x))
+
+(defun tactic.world->rlimit-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->rlimit x))
+
+(defun tactic.world->rwn-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->rwn x))
+
+(defun tactic.world->urwn-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->urwn x))
+
+(defun tactic.world->noexec-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->noexec x))
+
+(defun tactic.world->theories-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->theories x))
+
+(defun tactic.world->defs-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->defs x))
+
+(defun tactic.world->depth-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->depth x))
+
+(defun tactic.world->allrules-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->allrules x))
+
+(defun tactic.world->assm-primaryp-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->assm-primaryp x))
+
+(defun tactic.world->assm-secondaryp-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->assm-secondaryp x))
+
+(defun tactic.world->assm-directp-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->assm-directp x))
+
+(defun tactic.world->assm-negativep-wrapper (x)
+  (declare (xargs :mode :program))
+  (tactic.world->assm-negativep x))
+
+(defun change-tactic.world-fn-wrapper (x alist)
+  (declare (xargs :mode :program))
+  (CONS 'TACTIC.WORLD-WRAPPER
+        (LIST (IF (LOOKUP :INDEX ALIST)
+                  (CDR (LOOKUP :INDEX ALIST))
+                  (LIST 'TACTIC.WORLD->INDEX-wrapper X))
+              (IF (LOOKUP :FORCINGP ALIST)
+                  (CDR (LOOKUP :FORCINGP ALIST))
+                  (LIST 'TACTIC.WORLD->FORCINGP-wrapper X))
+              (IF (LOOKUP :BETAMODE ALIST)
+                  (CDR (LOOKUP :BETAMODE ALIST))
+                  (LIST 'TACTIC.WORLD->BETAMODE-wrapper X))
+              (IF (LOOKUP :LIFTLIMIT ALIST)
+                  (CDR (LOOKUP :LIFTLIMIT ALIST))
+                  (LIST 'TACTIC.WORLD->LIFTLIMIT-wrapper X))
+              (IF (LOOKUP :SPLITLIMIT ALIST)
+                  (CDR (LOOKUP :SPLITLIMIT ALIST))
+                  (LIST 'TACTIC.WORLD->SPLITLIMIT-wrapper X))
+              (IF (LOOKUP :BLIMIT ALIST)
+                  (CDR (LOOKUP :BLIMIT ALIST))
+                  (LIST 'TACTIC.WORLD->BLIMIT-wrapper X))
+              (IF (LOOKUP :RLIMIT ALIST)
+                  (CDR (LOOKUP :RLIMIT ALIST))
+                  (LIST 'TACTIC.WORLD->RLIMIT-wrapper X))
+              (IF (LOOKUP :RWN ALIST)
+                  (CDR (LOOKUP :RWN ALIST))
+                  (LIST 'TACTIC.WORLD->RWN-wrapper X))
+              (IF (LOOKUP :URWN ALIST)
+                  (CDR (LOOKUP :URWN ALIST))
+                  (LIST 'TACTIC.WORLD->URWN-wrapper X))
+              (IF (LOOKUP :NOEXEC ALIST)
+                  (CDR (LOOKUP :NOEXEC ALIST))
+                  (LIST 'TACTIC.WORLD->NOEXEC-wrapper X))
+              (IF (LOOKUP :THEORIES ALIST)
+                  (CDR (LOOKUP :THEORIES ALIST))
+                  (LIST 'TACTIC.WORLD->THEORIES-wrapper X))
+              (IF (LOOKUP :DEFS ALIST)
+                  (CDR (LOOKUP :DEFS ALIST))
+                  (LIST 'TACTIC.WORLD->DEFS-wrapper X))
+              (IF (LOOKUP :DEPTH ALIST)
+                  (CDR (LOOKUP :DEPTH ALIST))
+                  (LIST 'TACTIC.WORLD->DEPTH-wrapper X))
+              (IF (LOOKUP :ALLRULES ALIST)
+                  (CDR (LOOKUP :ALLRULES ALIST))
+                  (LIST 'TACTIC.WORLD->ALLRULES-wrapper X))
+              (IF (LOOKUP :ASSM-PRIMARY ALIST)
+                  (CDR (LOOKUP :ASSM-PRIMARY ALIST))
+                  (LIST 'TACTIC.WORLD->ASSM-PRIMARYp-wrapper X))
+              (IF (LOOKUP :ASSM-SECONDARY ALIST)
+                  (CDR (LOOKUP :ASSM-SECONDARY ALIST))
+                  (LIST 'TACTIC.WORLD->ASSM-SECONDARYp-wrapper X))
+              (IF (LOOKUP :ASSM-DIRECTP ALIST)
+                  (CDR (LOOKUP :ASSM-DIRECTP ALIST))
+                  (LIST 'TACTIC.WORLD->ASSM-DIRECTP-wrapper X))
+              (IF (LOOKUP :ASSM-NEGATIVEP ALIST)
+                  (CDR (LOOKUP :ASSM-NEGATIVEP ALIST))
+                  (LIST 'TACTIC.WORLD->ASSM-NEGATIVEP-wrapper X))
+              )))
+
+(defmacro change-tactic.world-wrapper (x &rest args)
+  (CHANGE-TACTIC.WORLD-FN-WRAPPER
+   X
+   (CHANGER-ARGS-TO-ALIST ARGS
+                          '(:INDEX :FORCINGP :BETAMODE
+                                      :LIFTLIMIT :SPLITLIMIT
+                                      :BLIMIT :RLIMIT
+                                      :RWN :URWN :NOEXEC
+                                      :THEORIES :DEFS
+                                      :DEPTH :ALLRULES
+                                      :ASSM-PRIMARY :ASSM-SECONDARY
+                                      :ASSM-DIRECTP :ASSM-NEGATIVEP))))
+
+
+
+
+;; Adding axioms to the database
+;;
+;; We add a formula using (%axiom formula).  We don't really do any checking on
+;; axioms as we check them.  Instead, we expect that the axioms will be hard
+;; coded into the standalone proof checker.
+
+(defmacro %axiom (formula)
+  `(ACL2::make-event (%axiom-fn ,formula (ACL2::w ACL2::state))))
+
+(defun %axiom-fn (formula acl2-world)
+  (declare (xargs :mode :program))
+  (let ((axioms (tactic.harness->axioms acl2-world)))
+    (cond ((not (logic.formulap formula))
+           (ACL2::er hard '%axiom "~x0 is not even a formula.~%" formula))
+          ((memberp formula axioms)
+           `(ACL2::value-triple :redundant))
+          (t
+           (ACL2::prog2$
+            (ACL2::cw "Adding axiom: ~x0~%" formula)
+            `(ACL2::progn (ACL2::table tactic-harness 'axioms
+                                       (cons ',formula (tactic.harness->axioms ACL2::world)))
+                          (ACL2::value-triple :invisible)))))))
+
+
+
+
+;; Adding theorems to the database
+;;
+;; We want to record every theorem we add, and the order that we add them, and
+;; remember the proofs that we used to admit them.
+;;
+;; Below, when we save proofs, we write out ".proof" files.  We remember which
+;; proof files we have written using the thmfiles table, which is a list of
+;; tuples of the form (type filename conclusion), and which are kept in the
+;; reverse order of when we added them because we cons onto the front of the
+;; list.
+;;
+;; We do not do any checking here to ensure that the proof has been checked
+;; and saved.  Hence, the "raw"-ness of %raw-add-theorem.
+
+(ACL2::table tactic-harness 'thmfiles nil)
+
+(defun tactic.harness->thmfiles (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'thmfiles (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun %raw-add-theorem-fn (name formula)
+  (declare (xargs :mode :program))
+  `(ACL2::progn
+    (ACL2::table tactic-harness 'thms
+                 (cons ,formula (tactic.harness->thms ACL2::world)))
+    (ACL2::make-event
+     ;; We use a relative file name here so that the proofs directory can be
+     ;; moved around easily.
+     (let ((filename  (STR::cat "Proofs/" (generate-filename 'thm ',name 'proof ACL2::state)))
+           (formula  ,formula)
+           (name     ',name))
+       `(ACL2::table tactic-harness 'thmfiles
+                     (cons (list 'VERIFY ',name ',formula ',filename)
+                           (tactic.harness->thmfiles ACL2::world)))))))
+
+(defmacro %raw-add-theorem (name formula)
+  (%raw-add-theorem-fn name formula))
+
+
+
+
+;; Support for multiple proof checking layers
+;;
+;; We can transition the tactic harness from using logic.proofp to instead
+;; using a higher-level proof checker.  We store the name of the currently
+;; loaded proof checker in this table entry.  As with the lists of axioms and
+;; theorems, a user could tinker with this.  Use the external Milawa checker to
+;; really have confidence in your proofs.
+
+(ACL2::table tactic-harness 'current-proofp 'logic.proofp)
+(ACL2::table tactic-harness 'current-adapter '%initial-adapter)
+
+(defun tactic.harness->current-proofp (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'current-proofp (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->current-adapter (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'current-adapter (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun %current-proofp (proof axioms thms atbl)
+  (declare (xargs :mode :program)
+           (ignore proof axioms thms atbl))
+  (ACL2::er hard '%current-proofp "Under-the-hood definition not properly installed."))
+
+(defun %current-adapter (proof defs initial-world all-worlds)
+  (declare (xargs :mode :program)
+           (ignore proof defs initial-world all-worlds))
+  ;; Adapter gets to look at the defs, initial world, and list of all compiled worlds.
+  ;; Note that initial-world and all-worlds MAY BE NIL when functions are admitted.  See
+  ;; the horrible mess in %admit-finalize-fn for details.
+  (ACL2::er hard '%current-adapter "Under-the-hood definition not properly installed."))
+
+(defun %initial-adapter (proof defs initial-world all-worlds)
+  ;; In the initial steps, we don't need any kind of adaptation.
+  (declare (xargs :mode :program)
+           (ignore defs initial-world all-worlds))
+  proof)
+
+(encapsulate
+ ()
+ (ACL2::defttag %current-proofp)
+ (ACL2::progn!
+  (ACL2::set-raw-mode t)
+
+  (ACL2::defun %current-proofp (proof axioms thms atbl)
+               (let* ((acl2-world     (ACL2::w ACL2::*the-live-state*))
+                      (current-proofp (tactic.harness->current-proofp acl2-world)))
+                 (ACL2::funcall current-proofp proof axioms thms atbl)))
+
+  (ACL2::defun %current-adapter (proof defs initial-world all-worlds)
+               (let* ((acl2-world      (ACL2::w ACL2::*the-live-state*))
+                      (current-adapter (tactic.harness->current-adapter acl2-world)))
+                 (ACL2::funcall current-adapter proof defs initial-world all-worlds)))))
+
+(defun %current-adapter-list (proofs defs initial-world all-worlds)
+  (declare (xargs :mode :program))
+  (if (consp proofs)
+      (cons (%current-adapter (car proofs) defs initial-world all-worlds)
+            (%current-adapter-list (cdr proofs) defs initial-world all-worlds))
+    nil))
+
+(defun %current-proof-listp (proofs axioms thms atbl)
+  (declare (xargs :mode :program))
+  (if (consp proofs)
+      (and (%current-proofp (car proofs) axioms thms atbl)
+           (%current-proof-listp (cdr proofs) axioms thms atbl))
+    t))
+
+
+
+;; Interactive proof management
+;;
+;; We manage an evolving proof skeleton for the "current proof attempt".  This
+;; is implicitly operated on by all our tactics.
+
+(ACL2::table tactic-harness 'skeleton nil)
+
+(defun tactic.harness->skeleton (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'skeleton (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->goals (acl2-world)
+  (declare (xargs :mode :program))
+  (tactic.skeleton->goals (tactic.harness->skeleton acl2-world)))
+
+
+
+
+(ACL2::table tactic-harness 'quiet nil)
+
+(defun tactic.harness->quiet (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'quiet (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defmacro %quiet (&optional (quietp 't))
+  ;; Control whether (%print) should make any output
+  ;;
+  ;;   (%quiet)      Turns on quiet mode, suppressing %print's output
+  ;;   (%quiet nil)  Turns off quiet mode
+  `(ACL2::table tactic-harness 'quiet ,quietp))
+
+(defun %print-choose-goals (args goals i)
+  ;; Args are the list of arguments given to %print.  We walk through the list
+  ;; of goals, and keep the ith goal only if it is mentioned in args or if * is
+  ;; mentioned.  We produce a list of (index . goal) pairs for all of the goals
+  ;; we're supposed to keep.
+  (declare (xargs :mode :program))
+  (if (consp goals)
+      (if (or (memberp i args)
+              (memberp 'all args))
+          (cons (cons i (car goals))
+                (%print-choose-goals args (cdr goals) (+ 1 i)))
+        (%print-choose-goals args (cdr goals) (+ 1 i)))
+    nil))
+
+(defun %print-negate-hyps (hyps)
+  ;; Given a list of terms, we "negate" them by wrapping them in "not" or
+  ;; stripping the "not" as appropriate.
+  (declare (xargs :mode :program))
+  (if (consp hyps)
+      (let* ((hyp1 (car hyps))
+             (hyp1-negated (if (and (logic.functionp hyp1)
+                                    (equal (logic.function-name hyp1) 'not)
+                                    (equal (len (logic.function-args hyp1)) 1))
+                               (first (logic.function-args (car hyps)))
+                             (logic.function 'not (list hyp1)))))
+        (cons hyp1-negated (%print-negate-hyps (cdr hyps))))
+    nil))
+
+(defun %print-make-implication (goal)
+  ;; Turn a clause into an analagous implies statement.
+  (declare (xargs :mode :program))
+  (if (consp (cdr goal))
+      ;; More than one disjunct, make an implies.
+      (let* ((hyps  (firstn (- (len goal) 1) goal))
+             (nhyps (%print-negate-hyps hyps))
+             (concl (car (restn (- (len goal) 1) goal))))
+        `(implies (and ,@nhyps) ,concl))
+    ;; Only one disjunct, the goal is this disjunct alone.
+    (car goal)))
+
+(defun %print-write-goals (chosen rawp ACL2::state)
+  ;; Print out each of the chosen goals.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (if (not (consp chosen))
+      ACL2::state
+    (let ((number (car (car chosen)))
+          (goal   (cdr (car chosen))))
+      (ACL2::mv-let (col ACL2::state)
+                    (ACL2::fmt "  ~s0~x1.~s2 " (list (cons #\0 *green*)
+                                                     (cons #\1 number)
+                                                     (cons #\2 *black*))
+                               ACL2::*standard-co* ACL2::state nil)
+                    (ACL2::mv-let (col ACL2::state)
+                                  (ACL2::fmt1 "~q0~%"
+                                              (list (cons #\0 (if rawp goal (%print-make-implication goal))))
+                                              ;; We have to subtract the "lengths" of the character codes, which
+                                              ;; fixes ugly stairstepped output and makes it look right
+                                              (- col (+ (ACL2::length *green*)
+                                                        (ACL2::length *black*)))
+                                              ACL2::*standard-co* ACL2::state nil)
+                                  (declare (ignore col))
+                                  (%print-write-goals (cdr chosen) rawp ACL2::state))))))
+
+(defun %print-core (args goals ACL2::state)
+  ;; Decide which goals to print out and then print them.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((numgoals   (len goals))
+         (rawp       (memberp 'raw args))
+         (args-prime (if rawp (remove-all 'raw args) args))
+         (choose-us  (if (consp args-prime)
+                         args-prime
+                       (list 1 2 3)))
+         (chosen     (%print-choose-goals choose-us goals 1)))
+    (ACL2::prog2$
+     (cond ((equal numgoals 0) (ACL2::cw "All goals have been proven.~%"))
+           ((equal numgoals 1) (ACL2::cw "One goal remains.~%"))
+           (t                  (ACL2::cw "~N0 goals remain.~%" numgoals)))
+     (%print-write-goals chosen rawp ACL2::state))))
+
+(defun %print-fn (args ACL2::state)
+  ;; Decide which goals to print out and then print them.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world (ACL2::w ACL2::state)))
+    (if (tactic.harness->quiet acl2-world)
+        (ACL2::mv nil '(ACL2::value-triple :invisible) ACL2::state)
+      (let ((ACL2::state (%print-core args (tactic.harness->goals acl2-world) ACL2::state)))
+        (ACL2::mv nil '(ACL2::value-triple :invisible) ACL2::state)))))
+
+(defmacro %print (&rest args)
+  ;; Prints out the current goals
+  ;;
+  ;; By default, only the first three goals is shown, and each clause is
+  ;; printed as a more friendly "implies" statement.  But you can override
+  ;; these defaults by passing some parameters.  For example:
+  ;;
+  ;;   (%print all)         Prints all the goals.
+  ;;   (%print 2 5 7 ...)   Prints goals 2, 5, 7, ...
+  ;;   (%print raw ...)     Prints as clauses instead of "implies" terms
+  `(local (ACL2::make-event (%print-fn ',args ACL2::state))))
+
+(defmacro %interactive ()
+  ;; Hide ugly ACL2 output generated by other % commands.
+  '(ACL2::make-event
+    (ACL2::er-progn (ACL2::set-inhibit-output-lst '(ACL2::event ACL2::summary ACL2::proof-tree))
+                    (ACL2::value '(ACL2::value-triple nil)))))
+
+(defmacro %noninteractive ()
+  ;; Switch back to normal ACL2 output.
+  '(ACL2::make-event
+    (ACL2::er-progn (ACL2::set-inhibit-output-lst '(ACL2::proof-tree))
+                    (ACL2::value '(ACL2::value-triple nil)))))
+
+(ACL2::table tactic-harness 'warnp t)
+
+(defun tactic.harness->warnp (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'warnp (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defmacro %warn (&optional (warnp 't))
+  ;; %warn can be used to suppress the output of some tactics when they
+  ;; fail.
+  ;;
+  ;; Usage:
+  ;;   (%warn)       Turn on warnings
+  ;;   (%warn nil)   Turn off warnings
+  ;;
+  `(ACL2::table tactic-harness 'warnp ,warnp))
+
+
+
+
+;; Saving proofs.
+;;
+;; By default, we build the proof objects upon %qed and %admit, and save them
+;; to a file using the compact-write-file system.  You can turn this off if
+;; you don't care about building the proofs by running (%building nil), or
+;; re-enable it using (%building t).
+;;
+;; We also allow you to specify a maximum acceptable proof size, which is
+;; really useful for discovering that some change to a tactic has caused a
+;; proof to break, using (%max-proof-size n).  The default is 500 million
+;; conses, at which point proofs are taking several minutes to check.  If
+;; you set this to zero, it won't be checked.
+;;
+;; Typically we do not bother to check the proof before we write it to the
+;; file, because this would slow us down during bootstrapping.  However,
+;; dynamic checking can be turned on or off using (%checking t) and (%checking
+;; nil), in case you're worried about some proofs.
+
+(ACL2::table tactic-harness 'building t)
+(ACL2::table tactic-harness 'checking nil)
+(ACL2::table tactic-harness 'saving t)
+(ACL2::table tactic-harness 'max-proof-size 500000000)
+
+(defun tactic.harness->building (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'building (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->checking (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'checking (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->saving (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'saving (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->max-proof-size (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'max-proof-size (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defmacro %checking (arg)
+  (declare (xargs :guard (booleanp arg)))
+  `(ACL2::table tactic-harness 'checking ,arg))
+
+(defmacro %building (arg)
+  (declare (xargs :guard (booleanp arg)))
+  `(ACL2::table tactic-harness 'building ,arg))
+
+(defmacro %saving (arg)
+  (declare (xargs :guard (booleanp arg)))
+  `(ACL2::table tactic-harness 'saving ,arg))
+
+(defmacro %max-proof-size (&optional (n '500000000))
+  `(ACL2::table tactic-harness 'max-proof-size ,n))
+
+(defun %theorem-check (name formula proof ACL2::state)
+  ;; Check that proof proves formula; write out the proof to a file.
+  ;; Causes an ACL2 error if any errors are encountered.  Always returns nil.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world    (ACL2::w ACL2::state))
+         (filename      (generate-filename 'thm name 'proof ACL2::state))
+         (full-filename (ACL2::extend-pathname *proofs-dir* filename ACL2::state))
+         (axioms        (tactic.harness->axioms acl2-world))
+         (thms          (tactic.harness->thms acl2-world))
+         (atbl          (tactic.harness->atbl acl2-world))
+         (checking      (tactic.harness->checking acl2-world))
+         (maxsize       (tactic.harness->max-proof-size acl2-world))
+         (size          (unbounded-rank proof)))
+    (ACL2::prog2$
+     (ACL2::cw "; Preparing to check ~x0.~%" name)
+     (ACL2::prog2$
+      ;; Previously I also reported the number of unique conses with ACL2::number-subtrees,
+      ;; but for large proof this was causing unacceptable delays.  And, in retrospect, it's
+      ;; not really a very interesting number.
+      (ACL2::cw ";; Proof size: ~s0~s1 conses~s2.~%"
+                *green* (STR::pretty-number size) *black*)
+      (if (and (not (ACL2::zp maxsize))
+               (ACL2::< maxsize size))
+          (ACL2::er hard '%theorem-check "The proof exceeds the maximum permitted proof size. ~
+                                          Use (%max-proof-size n) to override this check.~%")
+        (ACL2::prog2$
+         (ACL2::cw "; ~s0 the proof.~%" (if checking "Checking" "Not checking"))
+         (let ((proof-okp (if checking
+                              (ACL2::time$ (%current-proofp proof axioms thms atbl))
+                            t)))
+           (cond ((not (equal (logic.conclusion proof) formula))
+                  (ACL2::er hard '%theorem-check "The proof does not have the right conclusion.~%~
+                                                  Want: ~x0~%~
+                                                  Concludes: ~x1~%"
+                            formula (logic.conclusion proof)))
+                 ((not proof-okp)
+                  (ACL2::er hard '%theorem-check "The proof was rejected by current-proofp.~%"))
+                 ((tactic.harness->saving acl2-world)
+                  ;; We're supposed to save the proof
+                  (ACL2::prog2$ (ACL2::cw ";; Proof accepted.  Saving as ~s0~%" filename)
+                                (compact-write-file proof full-filename)))
+                 (t
+                  (ACL2::cw ";; Proof saving is disabled, so we are done.~%"))))))))))
+
+
+
+
+
+;; Defining functions
+;;
+;; NO NO NO.  There is now only one kind of definitions.  syndefs are gone.
+;;
+;; There are two kinds of definitions, and we keep them in separate lists.
+;;
+;;   - Defs are functions that have been properly introduced in the logic,
+;;     exist in the arity table, and have their corresponding axioms available.
+;;     These definitions are introduced using %defun and %admit.
+;;
+;;   - Syndefs are functions that have not been properly introduced, but yet
+;;     can be used heuristically by our rewriter, etc.  These functions cannot
+;;     be reasoned about, but don't need to terminate.
+
+;; (defmacro %syntax-defun (name formals body)
+;;   ;; Introduce a function for the syndefs list
+;;   ;;
+;;   ;; There is no admission obligation, and only minimal checking is performed:
+;;   ;; the formals must be unique, the body may only mention the formals, it must
+;;   ;; not conflict with some previous definition, etc.
+;;   `(ACL2::make-event (%syntax-defun-fn ',name ',formals ',body (ACL2::w ACL2::state))))
+
+(defmacro %defun (name formals body &key measure)
+  ;; Introduce a function for the defs list (Part 1 of 2)
+  ;;
+  ;; In addition to the %syntax-defun requirements, the function may only call
+  ;; previously %defun'ed functions and must be shown to terminate with the
+  ;; given measure.  The termination obligations are loaded as the current
+  ;; proof goals.  Once established, you should call (%admit) to finish
+  ;; introducing the function.
+  `(ACL2::make-event (%defun-fn ',name ',formals ',body ',measure (ACL2::w ACL2::state))))
+
+(defmacro %admit ()
+  ;; Introduce a function for the defs list (Part 2 of 2)
+  ;;
+  ;; This should be called once all the proof goals introduced by %defun have
+  ;; been discharged; it saves the proofs and updates the thmfiles table with
+  ;; the function introduction.
+  `(ACL2::progn
+    (local (ACL2::memoize 'unbounded-rank))
+    (local (ACL2::make-event (%admit-check-fn ACL2::state)))
+    (local (ACL2::unmemoize 'unbounded-rank))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))
+    (ACL2::make-event (%admit-update-fn ACL2::state))
+    (ACL2::make-event (%admit-finalize-fn ACL2::state))))
+
+(ACL2::table tactic-harness 'goaldef     nil)
+(ACL2::table tactic-harness 'goalmeasure nil)
+(ACL2::table tactic-harness 'goalbody    nil)
+(ACL2::table tactic-harness 'goalworld   nil)
+; (ACL2::table tactic-harness 'separate-syndefsp t)
+
+;; (defun tactic.harness->separate-syndefsp (acl2-world)
+;;   (declare (xargs :mode :program))
+;;   (cdr (lookup 'separate-syndefsp (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->goaldef (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'goaldef (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->goalmeasure (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'goalmeasure (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->goalbody (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'goalbody (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->goalworld (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'goalworld (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.find-def (name defs)
+  (declare (xargs :mode :program))
+  (if (consp defs)
+      (if (equal (logic.function-name (logic.=lhs (car defs))) name)
+          (car defs)
+        (tactic.find-def name (cdr defs)))
+    nil))
+
+;; (defun %syntax-defun-fn (name formals body acl2-world)
+;;   (declare (xargs :mode :program))
+;;   (cond ((not (logic.function-namep name))
+;;          (ACL2::er hard '%syntax-defun "The proposed name, ~x0, is invalid.~%" name))
+;;         ((not (logic.variable-listp formals))
+;;          (ACL2::er hard '%syntax-defun "The proposed formals for ~x0 are invalid.~%" name))
+;;         ((not (uniquep formals))
+;;          (ACL2::er hard '%syntax-defun "The proposed formals for ~x0 are not unique.~%" name))
+;;         ((not (tactic.harness->separate-syndefsp acl2-world))
+;;          `(ACL2::value-triple :invisible))
+;;         (t
+;;          (let ((body (logic.translate body)))
+;;            (cond ((not body)
+;;                   (ACL2::er hard '%syntax-defun "The proposed body for ~x0 is not translatable to a term.~%" name))
+;;                  ((not (subsetp (logic.term-vars body) formals))
+;;                   (ACL2::er hard '%syntax-defun "The proposed body for ~x0 mentions free variable(s) ~&1.~%"
+;;                             name (difference (logic.term-vars body) formals)))
+;;                  (t
+;;                   (let ((proposed-def (logic.pequal (logic.function name formals) body))
+;;                         (existing-def (tactic.find-def name (tactic.harness->syndefs acl2-world))))
+;;                     (if existing-def
+;;                         (if (not (equal proposed-def existing-def))
+;;                             (ACL2::er hard '%syntax-defun "The function ~x0 already has a different syndef.~%" name)
+;;                           `(ACL2::value-triple :redundant))
+;;                       `(ACL2::progn
+;;                         (ACL2::table tactic-harness 'world
+;;                                      (change-tactic.world-wrapper
+;;                                       (tactic.harness->world ACL2::world)
+;;                                       :syndefs
+;;                                       ;; This one probably doesn't need to be a hons, but we do it anyway.  See the
+;;                                       ;; comment in %admit-update-fn to see why.
+;;                                       (ACL2::hons ',proposed-def
+;;                                                   (tactic.harness->syndefs ACL2::world)))))))))))))
+
+
+
+(defun %defun-fn (name formals body measure acl2-world)
+  (declare (xargs :mode :program))
+  (cond ((not (logic.function-namep name))
+         (ACL2::er hard '%defun "The proposed name, ~x0, is invalid.~%" name))
+        ((not (logic.variable-listp formals))
+         (ACL2::er hard '%defun "The proposed formals are invalid.~%"))
+        ((not (uniquep formals))
+         (ACL2::er hard '%defun "The proposed formals are not unique.~%"))
+        (t
+         (let ((body-trans    (logic.translate body))
+               (measure-trans (logic.translate measure))
+               (new-atbl      (update name (len formals) (tactic.harness->atbl acl2-world))))
+           (cond ((not body-trans)
+                  (ACL2::er hard '%defun "The proposed body is not translatable to a term.~%"))
+                 ((not measure-trans)
+                  (ACL2::er hard '%defun "The proposed measure is not translatable to a term.~%"))
+                 ((not (subsetp (logic.term-vars body-trans) formals))
+                  (ACL2::er hard '%defun "The proposed body mentions free variable(s) ~&0.~%"
+                            (difference (logic.term-vars body-trans) formals)))
+                 ((not (subsetp (logic.term-vars measure-trans) formals))
+                  (ACL2::er hard '%defun "The proposed measure mentions free variable(s) ~&0.~%"
+                            (difference (logic.term-vars measure-trans) formals)))
+                 ((not (logic.warn-term-atblp body-trans new-atbl))
+                  (ACL2::er hard '%defun "The proposed body is invalid w.r.t. the current arity table.~%"))
+                 (t
+                  (let* ((proposed-def (logic.pequal (logic.function name formals) body-trans))
+                         ;; We check the existing def in the syndefs, since anything in the actual defs
+                         ;; should also occur in the syndefs.
+                         (existing-def (tactic.find-def name (tactic.harness->defs acl2-world)))
+                         (obligations  (logic.termination-obligations name formals body-trans measure-trans))
+                         (ob-clauses   (clause.make-clauses-from-arbitrary-formulas obligations)))
+                    (if (and existing-def (not (equal existing-def proposed-def)))
+                        (ACL2::er hard '%defun "The function ~x0 is already defined differently.~%" name)
+                      `(ACL2::progn
+                        ;; We store the proposed definition and measure in the goaldef/goalmeasure variables.
+                        (ACL2::table tactic-harness 'goaldef ',proposed-def)
+                        (ACL2::table tactic-harness 'goalbody ',body)
+                        (ACL2::table tactic-harness 'goalmeasure ',measure)
+                        ;; We add the function to the arity table.  Why do we need to do this?  Well, consider
+                        ;; a function like
+                        ;;   (foo x) = (if (foo (car x)) (foo (cdr x)) nil)
+                        ;; This isn't too contrived; for example, the "list" case in a typical mutual-recursion
+                        ;; will have this form.  Then, (foo (car x)) is a ruler of the recursive call (foo (cdr x)),
+                        ;; so we are allowed to assume it (foo (car x)) in the proof that (foo (cdr x)) is smaller.
+                        ;; Of course, we won't "know" anything about foo because we don't add the axioms about foo
+                        ;; until the admission proof is done.  But we still need to know that foo is an okay term
+                        ;; during the admission proof, so we add it to the arity table even though it hasn't been
+                        ;; properly admitted yet.  I am certain this is sound, since we could always do the same
+                        ;; thing with an uninterpreted function in ACL2.
+                        (ACL2::table tactic-harness 'atbl
+                                     (update ',name ,(len formals) (tactic.harness->atbl ACL2::world)))
+                        (local (ACL2::table tactic-harness 'goalworld
+                                            (tactic.harness->world acl2::world)))
+                        (local (ACL2::table tactic-harness 'skeleton (tactic.initial-skeleton ',ob-clauses)))
+                        (local (%print)))))))))))
+
+
+
+(defun %admit-check-fn (ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world    (ACL2::w ACL2::state))
+         (skeleton      (tactic.harness->skeleton acl2-world))
+         (goals         (tactic.skeleton->goals skeleton))
+         (goaldef       (tactic.harness->goaldef acl2-world))
+         (goalworld     (tactic.harness->goalworld acl2-world))
+         (name          (logic.function-name (logic.=lhs goaldef)))
+         (formals       (logic.function-args (logic.=lhs goaldef)))
+         (defs          (tactic.harness->defs acl2-world))
+         (body-trans    (logic.=rhs goaldef))
+         (measure-trans (logic.translate (tactic.harness->goalmeasure acl2-world)))
+         (filename      (generate-filename 'admit name 'proofs ACL2::state))
+         (full-filename (ACL2::extend-pathname *proofs-dir* filename ACL2::state))
+         (obligations   (logic.termination-obligations name formals body-trans measure-trans)))
+
+    (cond ((consp goals)
+           (ACL2::er hard '%admit "(%admit) called but there are outstanding goals.~%"))
+
+          ((not (tactic.harness->building acl2-world))
+           ;; We aren't building, saving, or checking proofs.
+           (ACL2::prog2$ (ACL2::cw "; Skipping proof-compiling since (%building nil) is set.~%")
+                         '(ACL2::value-triple :invisible)))
+
+          (t
+           ;; We need to at least build the proofs.
+           (let* ((worlds (ACL2::prog2$
+                           (ACL2::cw "; Compiling worlds for ~x0...~%" name)
+                           (tactic.compile-worlds skeleton goalworld)))
+                  (proofs (%current-adapter-list
+                           (ACL2::prog2$
+                            (ACL2::cw "; Compiling proofs for ~x0...~%" name)
+                            (ACL2::time$
+                             (clause.prove-arbitrary-formulas-from-their-clauses
+                              obligations
+                              (tactic.compile-skeleton skeleton worlds nil))))
+                           defs goalworld worlds))
+                  (axioms (tactic.harness->axioms acl2-world))
+                  (thms   (tactic.harness->thms acl2-world))
+                  (atbl   (tactic.harness->atbl acl2-world)))
+             (ACL2::progn$
+              (ACL2::cw ";; Preparing to admit ~x0.~%" name)
+              (ACL2::cw ";; Proof sizes total: ~s0 conses (with ~s1 unique conses).~%"
+                        (STR::pretty-number (unbounded-rank proofs))
+                        (STR::pretty-number (ACL2::number-subtrees proofs)))
+              ;; Check the proofs if checking is set.
+              (if (not (tactic.harness->checking acl2-world))
+                  (ACL2::cw "; Skipping proof-checking since (%checking nil) is set.~%")
+                (let ((proofs-okp (ACL2::progn$
+                                   (ACL2::cw "; Checking the proofs...~%")
+                                   (ACL2::time$ (%current-proof-listp proofs axioms thms atbl)))))
+                  (cond ((not proofs-okp)
+                         (ACL2::er hard '%admit-check "Some proof was rejected by current-proofp.~%"))
+                        ((not (equal (logic.strip-conclusions proofs)
+                                     (logic.termination-obligations name formals body-trans measure-trans)))
+                         (ACL2::er hard '%admit-check "The proofs do not have the right conclusions.~%"))
+                        (t
+                         (ACL2::cw "; Proof-checking completed.~%")))))
+              ;; Save the proof is saving is set.
+              (if (not (tactic.harness->saving acl2-world))
+                  (ACL2::cw "; Skipping proof-saving since (%saving nil) is set.~%")
+                (ACL2::progn$
+                 (ACL2::cw ";; Proofs accepted.  Saving as ~s0~%" filename)
+                 (compact-write-file proofs full-filename)))
+              ;; All done.
+              '(ACL2::value-triple :invisible)))))))
+
+(defun %admit-update-fn (ACL2::state)
+  ;; This is Part 1 of 2 after successfully checking the proofs of termination.
+  ;;
+  ;; We add the axiom, definition, and syntax definition for the function.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world (ACL2::w ACL2::state))
+         (goaldef    (tactic.harness->goaldef acl2-world)))
+    `(ACL2::progn
+      (ACL2::table tactic-harness 'axioms
+                   (cons ',goaldef (tactic.harness->axioms ACL2::world)))
+      (ACL2::table tactic-harness 'world
+                   (change-tactic.world-wrapper
+                    (tactic.harness->world ACL2::world)
+                    :defs
+                    ;; BOZO this comment is outdated since magic-evaluator is no longer used.  I leave
+                    ;; it in, in case we want to add it.
+                    ;;
+                    ;; It is VITALLY IMPORTANT that this be a hons, but the reason is obscure.  We need
+                    ;; to make sure that "defs" stay the same as we pass them around, so magic-evaluator
+                    ;; and magic-evaluator-bldr will be happy (it wants the defs it's passed to be literally
+                    ;; EQ to the harness defs).  But the defs get put into urewrite/crewrite traces via
+                    ;; the function rw.try-ground-simplify, which in turn calls rw.trace.  And in the file
+                    ;; hons-proofs, we make rw.trace use hons instead of cons.  So, if the harness defs
+                    ;; aren't in the hons space, they'll be re-consed then and put into the hons space.
+                    ;; The easy fix is just to make sure the defs are always honsed.
+                    (ACL2::hons ',goaldef (tactic.harness->defs ACL2::world))
+
+                    ;; :syndefs
+                    ;; ;; It probably doesn't matter that this is a hons, but we do it anyway.
+                    ;; (if (tactic.harness->separate-syndefsp ACL2::world)
+                    ;;     (ACL2::hons ',goaldef (tactic.harness->syndefs ACL2::world))
+                    ;;  (tactic.harness->syndefs ACL2::world))
+
+                    )))))
+
+(defun %admit-finalize-fn (ACL2::state)
+  ;; This is Part 2 of 2 after successfully checking the proofs of termination.
+  ;;
+  ;; We add the theorem and axiom for this function's definition.  We do this
+  ;; separately from Part 1, because the theorem relies upon the axiom for the
+  ;; function, and we want to check the theorem using theorem-check (so that it
+  ;; gets written to a file, etc.)
+  ;;
+  ;; Note: this gets used non-locally, so do the work in the local make-event
+  ;; rather than in the let* statement at the beginning here.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world (ACL2::w ACL2::state))
+         (goaldef    (tactic.harness->goaldef acl2-world))
+         (name       (logic.function-name (logic.=lhs goaldef)))
+         (formals    (logic.function-args (logic.=lhs goaldef)))
+         (body       (tactic.harness->goalbody acl2-world))
+         (body-trans (logic.=rhs goaldef))
+         (measure    (tactic.harness->goalmeasure acl2-world))
+         ;; Relative file name for easy proofs-dir moving
+         (filename   (STR::cat "Proofs/" (generate-filename 'admit name 'proofs ACL2::state)))
+         (theorem    (logic.pnot (logic.pequal (logic.function 'equal (list (logic.function name formals) body-trans)) ''nil))))
+    `(ACL2::progn
+      (local (ACL2::make-event
+              (let* ((proof (%current-adapter
+                             (let* ((line1 (build.axiom ',goaldef)) ;; (fn args) = body
+                                    (line2 (build.equal-from-pequal line1)) ;; (equal (fn args) body) = t
+                                    (line3 (build.not-nil-from-t line2))) ;; (equal (fn args) body) != nil
+                               line3)
+                             (tactic.harness->defs (ACL2::w ACL2::state))
+                             nil nil))
+                     (proof-ok (%theorem-check ',name ',theorem proof ACL2::state)))
+                (declare (ignore proof-ok))
+                '(ACL2::value-triple :invisible))))
+      (ACL2::table tactic-harness 'thmfiles
+                   (cons (list 'DEFINE ',name ',formals ',body ',measure ',filename)
+                         (tactic.harness->thmfiles ACL2::world)))
+      (%raw-add-theorem ,name ',theorem)
+      (%raw-add-rule (%rule ,name
+                            :lhs ,(logic.function name formals)
+                            :rhs ,body)))))
+
+
+
+
+
+
+;; Introducing choice functions
+;;
+;; We have a defchoose facility like ACL2's.  This causes no proof obligation,
+;; but several syntactic criteria must be met for the defchoose to be
+;; acceptable.
+
+(defmacro %defchoose (name bound-var free-vars body)
+  `(ACL2::make-event (%defchoose-fn ',name ',bound-var ',free-vars ',body (ACL2::w ACL2::state))))
+
+(defun %defchoose-fn (name bound-var free-vars body world)
+  (declare (xargs :mode :program))
+  (let ((atbl       (tactic.harness->atbl world))
+        (body-trans (logic.translate body)))
+    (cond ((not (logic.function-namep name))
+           (ACL2::er hard '%defchoose "The name must be a function name, but is ~x0.~%" name))
+          ((lookup name atbl)
+           (ACL2::er hard '%defchoose "The name, ~x0, is already in use.~%" name))
+          ((not (logic.variablep bound-var))
+           (ACL2::er hard '%defchoose "The bound-var must be a variable, but is ~x0.~%" bound-var))
+          ((not (logic.variable-listp free-vars))
+           (ACL2::er hard '%defchoose "The free-vars must be a list of variables, but are ~x0.~%" free-vars))
+          ((not (uniquep free-vars))
+           (ACL2::er hard '%defchoose "The free-vars must be unique, but are ~x0.~%" free-vars))
+          ((memberp bound-var free-vars)
+           (ACL2::er hard '%defchoose "The bound-var, ~x0, unacceptably occurs among the free vars.~%" bound-var))
+          ((not body-trans)
+           (ACL2::er hard '%defchoose "The body cannot be translated into a term.~%"))
+          ((not (subsetp (logic.term-vars body-trans) (cons bound-var free-vars)))
+           (ACL2::er hard '%defchoose "The body mentions variable(s) which are not among the bound and free vars: ~&0~%"
+                     (difference (logic.term-vars body-trans) (cons bound-var free-vars))))
+          ((not (logic.warn-term-atblp body-trans atbl))
+           (ACL2::er hard '%defchoose "The body is not valid w.r.t. the current arity table.~%"))
+          (t
+           ;; In ACL2, the new axiom is:
+           ;;   (implies body (let ((bound-var (fn free-vars))) body))
+           ;;
+           ;; In other words:
+           ;;   (implies body ((lambda (bound-var :: free-vars) body) (fn free-vars) free-vars))
+           ;;
+           ;; Which is equivalent to:
+           ;;    body = nil v ((lambda (bound-var :: free-vars) body) (fn free-vars) free-vars) != nil
+           (let ((new-axiom (logic.por (logic.pequal body-trans ''nil)
+                                       (logic.pnot (logic.pequal (logic.lambda (cons bound-var free-vars)
+                                                                               body-trans
+                                                                               (cons (logic.function name free-vars) free-vars))
+                                                                 ''nil)))))
+             `(ACL2::progn
+               (defun ,(ACL2::mksym 'defchoose-axiom-for- name) ()
+                 ',new-axiom)
+               (ACL2::table tactic-harness 'atbl
+                            (update ',name ,(len free-vars) (tactic.harness->atbl ACL2::world)))
+               (ACL2::table tactic-harness 'axioms
+                            (cons ',new-axiom (tactic.harness->axioms ACL2::world)))
+               (ACL2::table tactic-harness 'thmfiles
+                            (cons (list 'SKOLEM ',name ',bound-var ',free-vars ',body)
+                                  (tactic.harness->thmfiles ACL2::world)))))))))
+
+
+
+
+
+
+
+;; Theories (rewrite rule collections)
+;;
+;; We provide a system for using named theories, and we can add and remove
+;; rules from these theories.  Theories and rules "share a namespace" and
+;; their names must be unique.
+
+;; bleh -- what can we do to keep the rules separate but still in the same
+;; named theory structure?
+
+(defun tactic.harness->allrules (acl2-world)
+  (declare (xargs :mode :program))
+  (tactic.world->allrules (tactic.harness->world acl2-world)))
+
+(defun tactic.harness->theories (acl2-world)
+  (declare (xargs :mode :program))
+  (tactic.world->theories (tactic.harness->world acl2-world)))
+
+(defun tactic.create-theory-wrapper (newtheoryname copyofname world)
+  (declare (xargs :mode :program))
+  (tactic.create-theory newtheoryname copyofname world))
+
+(defun tactic.create-theory-tac-wrapper (skelly newtheoryname copyofname)
+  (declare (xargs :mode :program))
+  (tactic.create-theory-tac skelly newtheoryname copyofname))
+
+
+(defmacro %create-theory (theoryname &key copy-of)
+  ;; %create-theory introduces a new theory.
+  ;;
+  ;; Usage:
+  ;;   (%create-theory foo)                   Adds foo as the empty theory.
+  ;;   (%create-theory foo :copy-of target)   Adds foo as a copy of the target theory.
+  ;;
+  ;; We can call %create-theory in two different contexts.
+  ;;
+  ;;  (1) During a proof, in which case the theory is (probably) local to the
+  ;;      current proof attempt and we need to update the skeleton to reflect
+  ;;      that the new theory is being added.
+  ;;
+  ;;      In this case, we need to update the world and also extend the skeleton
+  ;;      so that the compiler knows to update its world.
+  ;;
+  ;;  (2) Outside of any proof attempt, in which case all we need to do is
+  `(ACL2::progn
+    ;; Step 1: Update the global world.
+    (ACL2::table tactic-harness 'world
+                 (let* ((theoryname ',theoryname)
+                        (copy-of    ',copy-of)
+                        (world      (tactic.harness->world ACL2::world)))
+                   (tactic.create-theory-wrapper theoryname copy-of world)))
+    ;; Step 2: Update the skeleton, if there currently is one.
+    (ACL2::table tactic-harness 'skeleton
+                 (let* ((theoryname ',theoryname)
+                        (copy-of    ',copy-of)
+                        (skelly     (tactic.harness->skeleton ACL2::world)))
+                   (and skelly
+                        (tactic.create-theory-tac-wrapper skelly theoryname copy-of))))))
+
+(%create-theory default)
+
+(defun tactic.e/d-wrapper (theoryname enables disables world)
+  ;; Prevent guard checking for %e/d
+  (declare (xargs :mode :program))
+  (tactic.e/d theoryname enables disables world))
+
+(defun tactic.e/d-tac-wrapper (x theoryname enables disables)
+  ;; Prevent guard checking for %e/d-tac
+  (declare (xargs :mode :program))
+  (tactic.e/d-tac x theoryname enables disables))
+
+(defmacro %e/d (theoryname enables disables)
+  ;; %e/d enables and disables some rules
+  ;;
+  ;; Usage:
+  ;;   (%e/d foo
+  ;;         (rule theory (%gather ...) rule theory ...)  ;; <--- "enable these"
+  ;;         (rule theory (%gather ...) rule theory ...)) ;; <--- "disable these"
+  ;;
+  ;; Like %create-theory we handle enables and disables globally or within proof
+  ;; attempts, so we need to update the world and perhaps the skeleton.
+  `(ACL2::progn
+    ;; Step 1: Update the global world
+    (ACL2::table tactic-harness 'world
+                 (let* ((theoryname ',theoryname)
+                        (enables    ',enables)
+                        (disables   ',disables)
+                        (world      (tactic.harness->world ACL2::world)))
+                   (tactic.e/d-wrapper theoryname enables disables world)))
+    ;; Step 2: Update the skeleton, if there currently is one
+    (ACL2::table tactic-harness 'skeleton
+                 (let* ((theoryname ',theoryname)
+                        (enables    ',enables)
+                        (disables   ',disables)
+                        (skelly     (tactic.harness->skeleton ACL2::world)))
+                   (and skelly
+                        (tactic.e/d-tac-wrapper skelly theoryname enables disables))))
+    (ACL2::value-triple :invisible)))
+
+(defmacro %enable (theoryname &rest what)
+  ;; %enable adds some rules to a theory.
+  ;;
+  ;; Usage:
+  ;;   (%enable foo
+  ;;            rule theory (%gather ...) rule theory ...)
+  ;;
+  `(%e/d ,theoryname ,what nil))
+
+(defmacro %disable (theoryname &rest what)
+  ;; %disable removes some rules from a theory.
+  `(%e/d ,theoryname nil ,what))
+
+(defmacro %pr (name)
+  ;; (%pr name) tries to look up the rule of the given name.
+  `(tactic.find-rule ',name (tactic.harness->world (ACL2::w ACL2::state))))
+
+
+(defmacro %raw-add-rule (rule)
+  `(ACL2::make-event (%raw-add-rule-fn ,rule (ACL2::w ACL2::state))))
+
+(defun %raw-add-rule-fn (rule acl2-world)
+  (declare (xargs :mode :program))
+  (if (not (rw.rulep rule))
+      (ACL2::er hard '%raw-add-rule "The proposed rule, ~x0, is invalid.~%" rule)
+    (let* ((world         (tactic.harness->world acl2-world))
+           (existing-rule (tactic.find-rule (rw.rule->name rule) world)))
+      (cond ((tactic.find-theory (rw.rule->name rule) world)
+             (ACL2::er hard '%raw-add-rule "The proposed name, ~x0, is already in use as a theory.~%"
+                       (rw.rule->name rule)))
+            ((and existing-rule
+                  (equal existing-rule rule))
+             `(ACL2::value-triple :redundant))
+            (existing-rule
+             (ACL2::er hard '%raw-add-rule
+                       "The proposed name, ~x0, is already in use as a different rule.~%"
+                       (rw.rule->name rule)))
+            ((not (memberp (clause.clause-formula (rw.rule-clause rule))
+                           (tactic.harness->thms acl2-world)))
+             (ACL2::er hard '%raw-add-rule "The rule's formula, ~x0, is not currently a member of thms.~%"
+                       (clause.clause-formula (rw.rule-clause rule))))
+            (t
+             (ACL2::prog2$
+              (ACL2::cw! "New rule: ~s0~%" (rw.rule->name rule))
+              `(ACL2::table tactic-harness 'world
+                            (let* ((world    (tactic.harness->world ACL2::world))
+                                   (allrules (tactic.world->allrules-wrapper world)))
+                              (change-tactic.world-wrapper
+                               world
+                               :allrules (cons ',rule allrules))))))))))
+
+
+(defun tactic.restrict-wrapper (theoryname rulename syntax world)
+  (declare (xargs :mode :program))
+  (tactic.restrict theoryname rulename syntax world))
+
+(defun tactic.restrict-tac-wrapper (skelly theoryname rulename syntax)
+  (declare (xargs :mode :program))
+  (tactic.restrict-tac skelly theoryname rulename syntax))
+
+(defmacro %restrict (theoryname rulename &rest syntax)
+  (let ((syntax-trans (logic.translate-list syntax)))
+    (if (not (car syntax-trans))
+        (ACL2::er hard '%restrict
+                  "Syntactic restrictions were not translateable.~%")
+      `(ACL2::progn
+         ;; Step 1: Update the global world
+        (ACL2::table tactic-harness 'world
+                     (let* ((theoryname ',theoryname)
+                            (rulename   ',rulename)
+                            (syntax     ',(cdr syntax-trans))
+                            (world      (tactic.harness->world ACL2::world)))
+                       (tactic.restrict-wrapper theoryname rulename syntax world)))
+        ;; Step 2: Update the skeleton, if there currently is one
+        (ACL2::table tactic-harness 'skeleton
+                     (let* ((theoryname ',theoryname)
+                            (rulename   ',rulename)
+                            (syntax     ',(cdr syntax-trans))
+                            (skelly     (tactic.harness->skeleton ACL2::world)))
+                       (and skelly
+                            (tactic.restrict-tac-wrapper skelly theoryname rulename syntax))))
+        (ACL2::value-triple :invisible)))))
+
+
+
+(defun tactic.cheapen-wrapper (theoryname what world)
+  (declare (xargs :mode :program))
+  (tactic.cheapen theoryname what world))
+
+(defun tactic.cheapen-tac-wrapper (skelly theoryname what)
+  (declare (xargs :mode :program))
+  (tactic.cheapen-tac skelly theoryname what))
+
+(defmacro %cheapen (theoryname &rest what)
+  `(ACL2::progn
+    ;; Step 1: Update the global world
+    (ACL2::table tactic-harness 'world
+                 (let* ((theoryname ',theoryname)
+                        (what       ',what)
+                        (world      (tactic.harness->world ACL2::world)))
+                   (tactic.cheapen-wrapper theoryname what world)))
+    ;; Step 2: Update the skeleton, if there currently is one
+    (ACL2::table tactic-harness 'skeleton
+                 (let* ((theoryname ',theoryname)
+                        (what        ',what)
+                        (skelly     (tactic.harness->skeleton ACL2::world)))
+                   (and skelly
+                        (tactic.cheapen-tac-wrapper skelly theoryname what))))
+    (ACL2::value-triple :invisible)))
+
+
+
+
+;; Proving lemmas
+;;
+;;  -- We can load up our skeleton with a conjecture using %prove.
+;;  -- We then apply tactics until all the goals are relieved.
+;;  -- We finally call %qed to compile the skeleton and submit the proof.
+
+(ACL2::table tactic-harness 'goalrule nil)
+
+(defun tactic.harness->goalrule (world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'goalrule (ACL2::table-alist 'tactic-harness world))))
+
+(defmacro %prove (rule)
+  `(ACL2::make-event (%prove-fn ,rule (ACL2::w ACL2::state))))
+
+(defmacro %qed ()
+  `(ACL2::progn
+    (local (ACL2::memoize 'unbounded-rank))
+    (local (ACL2::make-event (%qed-check-fn ACL2::state)))
+    (ACL2::make-event (%qed-finalize-fn ACL2::state))
+    (local (ACL2::unmemoize 'unbounded-rank))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))))
+
+(defun %prove-fn (rule acl2-world)
+  (declare (xargs :mode :program))
+  (if (not (rw.rulep rule))
+      (ACL2::er hard '%prove "The proposed rule, ~x0, is not valid.~%" rule)
+    (let* ((world (tactic.harness->world acl2-world))
+           (atbl  (tactic.harness->atbl acl2-world)))
+      (cond ((not (rw.rule-atblp rule atbl))
+             (ACL2::er hard '%prove "The proposed rule, ~x0, is not valid w.r.t. the current atbl.~%" rule))
+            ((tactic.find-theory (rw.rule->name rule) world)
+             (ACL2::er hard '%prove "The proposed name, ~x0, is already in use as the name of a theory.~%"
+                       (rw.rule->name rule)))
+            ((tactic.find-rule (rw.rule->name rule) world)
+             (ACL2::er hard '%prove "The proposed name, ~x0, is already in use as the name of a rule.~%"
+                       (rw.rule->name rule)))
+            (t
+             `(ACL2::progn
+               (ACL2::table tactic-harness 'goalrule ',rule)
+               (local (ACL2::table tactic-harness 'goalworld
+                                   (tactic.harness->world ACL2::world)))
+               (local (ACL2::table tactic-harness 'skeleton
+                                   (tactic.initial-skeleton (list ',(rw.rule-clause rule)))))
+               (local (%print))))))))
+
+(defun %qed-check-fn (ACL2::state)
+  ;; This is Part 1 of 2 for accepting a theorem.  We check the proof and write
+  ;; its file.  If the proof is not acceptable, we cause an error.  Else we do
+  ;; not change the state.  This operation is "local" inside %qed, so that it
+  ;; will not be run while including uncertified files.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world   (ACL2::w ACL2::state))
+         (skeleton  (tactic.harness->skeleton acl2-world))
+         (goals     (tactic.skeleton->goals skeleton))
+         (goalrule  (tactic.harness->goalrule acl2-world))
+         (goalworld (tactic.harness->goalworld acl2-world))
+         (defs      (tactic.harness->defs acl2-world))
+         (name      (rw.rule->name goalrule))
+         (formula   (clause.clause-formula (rw.rule-clause goalrule))))
+    (cond ((consp goals)
+           (ACL2::er soft '%qed "(%qed) called but there are outstanding goals.~%"))
+
+          ((not (tactic.harness->building acl2-world))
+           ;; We aren't building or checking proofs.
+           (ACL2::prog2$ (ACL2::cw "; Skipping proof-compiling since (%building nil) is set.~%")
+                         (ACL2::mv nil `(ACL2::value-triple :invisible) ACL2::state)))
+
+          (t
+           (let* ((worlds (ACL2::prog2$
+                           (ACL2::cw "; Compiling worlds for ~x0...~%" name)
+                           (tactic.compile-worlds skeleton goalworld)))
+                  (proof  (%current-adapter
+                           (ACL2::prog2$ (ACL2::cw "Compiling skeleton for ~x0.~%" name)
+                                         (car (ACL2::time$ (tactic.compile-skeleton skeleton worlds nil))))
+                           defs goalworld worlds))
+                  (proof-okp (%theorem-check name formula proof ACL2::state)))
+             (declare (ignore proof-okp))
+             ;; NOTE: it is vitally important that ",proof" not occur in the
+             ;; return-value immediately below.  If it does, then the proof
+             ;; will be visible in the output of a make-event, and will be
+             ;; saved in the .cert file.  This will make the cert files balloon
+             ;; to hundreds of megabytes and slow our system down.
+             (ACL2::mv nil `(ACL2::value-triple :invisible) ACL2::state))))))
+
+(defun %qed-finalize-fn (ACL2::state)
+  ;; This is Part 2 of 2 for accepting a theorem.  We do no proof checking, but
+  ;; we update the thms and rules tables.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world (ACL2::w ACL2::state))
+         (goalrule   (tactic.harness->goalrule acl2-world))
+         (name       (rw.rule->name goalrule))
+         (formula    (clause.clause-formula (rw.rule-clause goalrule))))
+    (ACL2::mv nil
+              `(ACL2::progn
+                (%raw-add-theorem ,name ',formula)
+                (%raw-add-rule ',goalrule))
+              ACL2::state)))
+
+
+
+
+
+
+;; Transitioning to a new proof checker
+;;
+;;  -- We can create a skeleton for the soundness theorem using (%install-new-proofp [new-proofp-function]).
+;;  -- We then apply tactics until the goal is proven
+;;  -- We finally call (%qed-install) to finalize the transition and install the new checker.
+;;
+;; Then, to start using higher-level builder functions,
+;;  -- We call (%switch-builder old-name new-name) for each such builder
+
+(ACL2::table tactic-harness 'new-proofp-name nil)
+
+(defun tactic.harness->new-proofp-name (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'new-proofp-name (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defmacro %install-new-proofp (new-proofp)
+  `(ACL2::make-event (%install-new-proofp-fn ',new-proofp ACL2::state)))
+
+(defmacro %qed-install ()
+  `(ACL2::progn
+    (local (ACL2::memoize 'unbounded-rank))
+    (local (ACL2::make-event (%qed-install-check ACL2::state)))
+    (ACL2::make-event (%qed-install-finalize ACL2::state))
+    (local (ACL2::unmemoize 'unbounded-rank))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))))
+
+(defun %install-new-proofp-fn (name ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world  (ACL2::w ACL2::state))
+         (atbl        (tactic.harness->atbl acl2-world)))
+    (cond ((not (logic.function-namep name))
+           (ACL2::er soft '%install-new-proofp "Expected ~x0 to be a function name.~%" name))
+          ((not (equal 4 (cdr (lookup name atbl))))
+           (ACL2::er soft '%install-new-proofp "Expected ~x0 to have arity 4.~%" name))
+          (t
+           (ACL2::value
+            `(ACL2::progn
+              (ACL2::table tactic-harness 'new-proofp-name ',name)
+              (local (ACL2::table tactic-harness 'goalworld (tactic.harness->world ACL2::world)))
+              (local (ACL2::table tactic-harness 'skeleton
+                                  (tactic.initial-skeleton
+                                   (list (list (logic.compile-formula (logic.soundness-claim ',name)))))))
+              (local (%print))))))))
+
+(defmacro %qed-install ()
+  `(ACL2::progn
+    (local (ACL2::memoize 'unbounded-rank))
+    (local (ACL2::make-event (%qed-install-check ACL2::state)))
+    (ACL2::make-event (%qed-install-finalize ACL2::state))
+    (local (ACL2::unmemoize 'unbounded-rank))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))))
+
+(defun %qed-install-check (ACL2::state)
+  ;; This is part 1 of 2 for transitioning to a new proof checker.  We compile
+  ;; the skeleton and check the proof.  It must have the obligation for this
+  ;; new-proofp.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((acl2-world  (ACL2::w ACL2::state))
+         (skeleton    (tactic.harness->skeleton acl2-world))
+         (goals       (tactic.skeleton->goals skeleton))
+         (goalworld   (tactic.harness->goalworld acl2-world))
+         (new-proofp  (tactic.harness->new-proofp-name acl2-world))
+         (defs        (tactic.harness->defs acl2-world))
+         (obligation  (logic.soundness-claim new-proofp)))
+    (cond
+     ((consp goals)
+      (ACL2::er soft '%qed-install "There are still remaining goals.~%"))
+
+     ((not (tactic.harness->building acl2-world))
+      ;; We aren't building or checking proofs.
+      (ACL2::prog2$ (ACL2::cw "; Skipping proof-compiling since (%building nil) is set.~%")
+                    (ACL2::mv nil `(ACL2::value-triple :invisible) ACL2::state)))
+
+     (t
+      (let* ((worlds (ACL2::prog2$
+                      (ACL2::cw "; Compiling worlds for installing ~s0...~%" new-proofp)
+                      (tactic.compile-worlds skeleton goalworld)))
+             (PROOF-BEFORE-ADAPTER
+              (ACL2::prog2$ (ACL2::cw "Compiling skeleton for installing ~s0.~%" new-proofp)
+                                   (car (ACL2::time$ (tactic.compile-skeleton skeleton worlds nil)))))
+             (line-1 (second (build.compile-formula obligation)))   ;; OBLIG v (COMP OBLIG) = NIL
+             (line-2 (build.commute-or line-1))                     ;; (COMP OBLIG) = NIL v OBLIG
+             (line-3 (build.modus-ponens-2 proof-BEFORE-ADAPTER line-2))
+             (proof  (%current-adapter line-3 defs goalworld worlds))
+             ;; PROOF: (COMP OBLIG) != NIL
+             (proof-okp (%theorem-check (ACL2::mksym 'install-new-proofp- new-proofp)
+                                        obligation proof ACL2::state)))
+        (declare (ignore proof-okp))
+        (ACL2::mv nil `(ACL2::value-triple :invisible) ACL2::state))))))
+
+(defun %qed-install-finalize (ACL2::state)
+  ;; This is part 2 of 2 for transitioning to a new proof checker.  We assume
+  ;; the proof has been accepted and everything is okay.  We need to change the
+  ;; current-proofp to our new-proofp.
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (let* ((world      (ACL2::w ACL2::state))
+         (new-proofp (tactic.harness->new-proofp-name world))
+         (obligation (logic.soundness-claim new-proofp)))
+    `(ACL2::progn
+      (%raw-add-theorem ,(ACL2::mksym 'install-new-proofp- new-proofp) ',obligation)
+      (ACL2::table tactic-harness 'current-proofp ',new-proofp)
+      (ACL2::table tactic-harness 'thmfiles
+                   (cons (list 'SWITCH ',new-proofp)
+                         (tactic.harness->thmfiles ACL2::world))))))
+
+
+
+;; After switching proofp-levels, it's convenient to just slip in new
+;; definitions for the builders that are introduced at that level under the
+;; hood, using the same name as the previous builders.  We don't do any sanity
+;; checking here, so the user must be very careful to use this command
+;; correctly and only when appropriate.
+
+(defmacro %switch-builder (old-name new-name)
+  (declare (xargs :guard (and (logic.function-namep old-name)
+                              (logic.function-namep new-name))))
+  `(ACL2::make-event (let ((temp (%switch-builder-fn ',old-name ',new-name)))
+                       (declare (ignore temp))
+                       '(ACL2::value-triple :invisible))
+                     ;; We need this to run even when books are being included.
+                     :check-expansion t))
+
+(defun %switch-builder-fn (old-name new-name)
+  ;; This redefines the old-name function to new-name.
+  (declare (xargs :mode :program))
+  (declare (ignore old-name new-name))
+  (ACL2::er hard '%switch-builder "Under the hood definition not installed."))
+
+(encapsulate
+ ()
+ (ACL2::defttag %switch-builder)
+ (ACL2::progn!
+  (ACL2::set-raw-mode t)
+  (ACL2::defun %switch-builder-fn (old-name new-name)
+               (let* ((state       ACL2::*the-live-state*)
+                      (world       (ACL2::w state))
+                      (old-formals (cdr (lookup 'ACL2::formals (ACL2::getprops old-name 'ACL2::current-acl2-world world))))
+                      (new-formals (cdr (lookup 'ACL2::formals (ACL2::getprops new-name 'ACL2::current-acl2-world world)))))
+                 (cond ((memberp old-name (ACL2::get-functions-to-inline world))
+                        (ACL2::er hard '%switch-builder "Refusing to switch-builder for inlined function ~x0.  (Since the ~
+                                                         function was inlined our attempt at redefinition may miss some ~
+                                                         calls, which could result in the old function being used.)~%"
+                                  old-name))
+                       ((not (equal old-formals new-formals))
+                        (ACL2::er hard '%switch-builder "The formals for ~s0 and ~s1 are incompatible." old-formals new-formals))
+                       (ACL2::progn
+                        (ACL2::cw! "Switching ~s0 ==> ~s1~|" old-name new-name)
+                        (ACL2::eval `(ACL2::defun ,old-name ,old-formals
+                                                  (,new-name ,@new-formals)))))))))
+
+
+
+
+
+; %save-events filename
+
+(defmacro %save-events (filename)
+  `(local (ACL2::make-event (%save-events-fn ,filename acl2::state))))
+
+(defun print-list-of-objects (objects channel ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (if (not (consp objects))
+      ACL2::state
+    (let ((ACL2::state (ACL2::print-object$ (car objects) channel ACL2::state)))
+      (print-list-of-objects (cdr objects) channel ACL2::state))))
+
+(ACL2::defttag save-list-of-objects)
+
+(defun save-list-of-objects (filename objects ACL2::state)
+  (declare (xargs :mode :program :stobjs ACL2::state))
+  (ACL2::mv-let
+   (channel ACL2::state)
+   (ACL2::open-output-channel! filename :object ACL2::state)
+   (let ((ACL2::state (print-list-of-objects objects channel ACL2::state)))
+     (ACL2::close-output-channel channel ACL2::state))))
+
+(defun thmfiles-to-events (thmfiles functions-to-inline)
+  (declare (xargs :mode :program))
+  (if (consp thmfiles)
+      (cons (let ((entry (car thmfiles)))
+              (cond ((equal (first entry) 'VERIFY)
+                     (let ((name     (second entry))
+                           (formula  (third entry))
+                           (filename (fourth entry)))
+                       (list 'VERIFY name formula filename)))
+                    ((equal (first entry) 'DEFINE)
+                     (let* ((name     (second entry))
+                            (formals  (third entry))
+                            (body     (fourth entry))
+                            (measure  (fifth entry))
+                            (inlinep  (memberp name functions-to-inline))
+                            (filename (ACL2::sixth entry)))
+                       (list 'DEFINE name formals body measure inlinep filename)))
+                    ((equal (first entry) 'SKOLEM)
+                     (let* ((name      (second entry))
+                            (bound-var (third entry))
+                            (free-vars (fourth entry))
+                            (body      (fifth entry)))
+                       (list 'SKOLEM name bound-var free-vars body)))
+                    ((equal (first entry) 'SWITCH)
+                     (let* ((name     (second entry)))
+                       (list 'SWITCH name)))
+                    ((equal (first entry) 'FINISH)
+                     (let* ((name     (second entry)))
+                       (list 'FINISH name)))
+                    (t
+                     (ACL2::er hard 'thmfiles-to-events "Unknown event type: ~x0.~%" (first entry)))))
+            (thmfiles-to-events (cdr thmfiles) functions-to-inline))
+    nil))
+
+(defun %save-events-fn (filename ACL2::state)
+  (declare (xargs :stobjs ACL2::state
+                  :mode :program))
+  (let ((ACL2::state
+         (save-list-of-objects (ACL2::extend-pathname *proofs-dir* filename ACL2::state)
+                               (thmfiles-to-events
+                                (fast-rev (tactic.harness->thmfiles (ACL2::w ACL2::state)))
+                                (ACL2::get-functions-to-inline (ACL2::w ACL2::state)))
+                               ACL2::state)))
+    (ACL2::value `(ACL2::value-triple ,filename))))
+
+
+
+(defmacro %finish (name)
+  `(ACL2::table tactic-harness 'thmfiles
+                (cons (list 'FINISH ',name)
+                      (tactic.harness->thmfiles ACL2::world))))
+
+
+(defun %ngoals-fn (wrld)
+  (declare (xargs :mode :program))
+  (len (tactic.skeleton->goals (tactic.harness->skeleton wrld))))
+
+(defmacro %ngoals ()
+  `(%ngoals-fn (acl2::w acl2::state)))
+
+
+(defun break ()
+  (declare (xargs :guard t))
+  (acl2::cw "break has not been redefined!~%"))
+
+(acl2::defttag break)
+(acl2::progn!
+ (acl2::set-raw-mode t)
+ (acl2::defun break ()
+   (acl2::cw "(break) was called.~%")
+   (common-lisp::break)
+   nil))
+
+;; :q
+
+;; (CCL::advise tactic.crewrite-all-tac
+;;              (let* ((arglist CCL::arglist)
+;;                     (control (fourth arglist))
+;;                     (defs    (rw.control->defs control)))
+;;                (ACL2::cw "$$$ crewrite-all-tac: defs are same? ~x0.~%"
+;;                          (ACL2::eq defs (tactic.harness->defs (ACl2::w ACL2::*the-live-state*)))))
+;;              :when :before)
+
+;; (CCL::advise tactic.crewrite-all-compile
+;;              (let* ((arglist CCL::arglist)
+;;                     (control (nth 2 (tactic.skeleton->extras (car arglist))))
+;;                     (defs    (rw.control->defs control)))
+;;                (ACL2::cw "$$$ crewrite-all-compile: defs are same? ~x0.~%"
+;;                          (ACL2::eq defs (tactic.harness->defs (ACl2::w ACL2::*the-live-state*)))))
+;;              :when :before)
+
+;; (CCL::advise rw.crewrite-clause-list-bldr
+;;              (let* ((arglist CCL::arglist)
+;;                     (control (fourth arglist))
+;;                     (defs    (rw.control->defs control)))
+;;                (ACL2::cw "$$$ crewrite-clause-list-bldr: defs are same? ~x0.~%"
+;;                          (ACL2::eq defs (tactic.harness->defs (ACl2::w ACL2::*the-live-state*)))))
+;;              :when :before)
+
+;; (CCL::advise rw.crewrite-clause-bldr
+;;              (let* ((arglist CCL::arglist)
+;;                     (control (fourth arglist))
+;;                     (defs    (rw.control->defs control)))
+;;                (ACL2::cw "$$$ crewrite-clause-bldr: defs are same? ~x0.~%"
+;;                          (ACL2::eq defs (tactic.harness->defs (ACl2::w ACL2::*the-live-state*)))))
+;;              :when :before)
+
+;; (CCL::advise rw.compile-ground-trace
+;;              (let* ((arglist CCL::arglist)
+;;                     (defs    (rw.trace->extras (car arglist))))
+;;                (ACL2::cw "$$$ compile-ground-trace: defs are same? ~x0.~%"
+;;                          (ACL2::eq defs (tactic.harness->defs (ACl2::w ACL2::*the-live-state*)))))
+;;              :when :before)
+
+;; (CCL::advise rw.try-ground-simplify
+;;              (let* ((arglist CCL::arglist)
+;;                     (control (fourth arglist))
+;;                     (defs    (rw.control->defs control)))
+;;                (ACL2::cw "$$$ rw.try-ground-simplify: defs are same? ~x0.~%"
+;;                          (ACL2::eq defs (tactic.harness->defs (ACl2::w ACL2::*the-live-state*)))))
+;;              :when :before)
diff -Nru acl2-6.2/books/milawa/ACL2/interface/debug-rewrite-cost.lisp acl2-6.3/books/milawa/ACL2/interface/debug-rewrite-cost.lisp
--- acl2-6.2/books/milawa/ACL2/interface/debug-rewrite-cost.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/debug-rewrite-cost.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,168 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(mutual-recursion
+ (defun rw.count-forcing-traces (x)
+   (declare (xargs :guard (rw.tracep x)
+                   :measure (two-nats-measure (rank x) 1)))
+   (let ((method (rw.trace->method x))
+         (subtraces (rw.trace->subtraces x)))
+     (if (equal method 'force)
+         (+ 1 (rw.count-forcing-traces-list subtraces))
+       (rw.count-forcing-traces-list subtraces))))
+ (defun rw.count-forcing-traces-list (x)
+   (declare (xargs :guard (rw.trace-listp x)
+                   :measure (two-nats-measure (rank x) 0)))
+   (if (consp x)
+       (+ (rw.count-forcing-traces (car x))
+          (rw.count-forcing-traces-list (cdr x)))
+     0)))
+
+(mutual-recursion
+ (defun rw.count-traces (x)
+   (declare (xargs :guard (rw.tracep x)
+                   :measure (two-nats-measure (rank x) 1)))
+   (let ((subtraces (rw.trace->subtraces x)))
+     (+ 1 (rw.count-traces-list subtraces))))
+ (defun rw.count-traces-list (x)
+   (declare (xargs :guard (rw.trace-listp x)
+                   :measure (two-nats-measure (rank x) 0)))
+   (if (consp x)
+       (+ (rw.count-traces (car x))
+          (rw.count-traces-list (cdr x)))
+     0)))
+
+(ACL2::mutual-recursion
+ (ACL2::defun rw.trace-size-debug (x alist)
+   (declare (xargs :mode :program))
+   (let ((method    (rw.trace->method x))
+         (subtraces (rw.trace->subtraces x)))
+     (if (equal method 'crewrite-rule)
+         (let* ((rule               (first (rw.trace->extras x)))
+                (name               (rw.rule->name rule))
+                (num-subtraces      (rw.count-traces-list subtraces))
+                (num-fsubtraces     (rw.count-forcing-traces-list subtraces))
+                (alist-entry        (cdr (ACL2::hons-assoc-equal name alist)))
+                (new-count          (+ num-subtraces (car alist-entry)))
+                (new-fcount         (+ num-fsubtraces (cdr alist-entry)))
+                (new-alist          (ACL2::hons-acons name
+                                                      (cons new-count new-fcount)
+                                                      alist)))
+           (rw.trace-size-debug-list subtraces new-alist))
+       (rw.trace-size-debug-list subtraces alist))))
+ (ACL2::defun rw.trace-size-debug-list (x alist)
+   (declare (xargs :mode :program))
+   (if (consp x)
+       (rw.trace-size-debug-list (cdr x)
+                                 (rw.trace-size-debug (car x) alist))
+     alist)))
+
+(ACL2::memoize 'rw.count-forcing-traces)
+(ACL2::memoize 'rw.count-traces)
+
+
+
+(defun get-traces-from-ccstep-list (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (third (car x))
+          (cons (third (car x))
+                (get-traces-from-ccstep-list (cdr x)))
+        (get-traces-from-ccstep-list (cdr x)))
+    nil))
+
+(defun get-traces-from-ccstep-list-list (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (revappend (get-traces-from-ccstep-list (car x))
+                 (get-traces-from-ccstep-list-list (cdr x)))
+    nil))
+
+(defun get-traces-from-skeleton (x)
+  (declare (xargs :mode :program))
+  (if (not (tactic.skeleton->tacname x))
+      nil
+    (let ((name (tactic.skeleton->tacname x)))
+      (if (equal name 'crewrite-all)
+          (let* ((ccsteps (nth 4 (tactic.skeleton->extras x)))
+                 (traces  (get-traces-from-ccstep-list-list ccsteps)))
+            (revappend traces
+                       (get-traces-from-skeleton (tactic.skeleton->history x))))
+        (get-traces-from-skeleton (tactic.skeleton->history x))))))
+
+
+
+
+(defun crewrite-cost-report-line (entry)
+  (declare (xargs :mode :program))
+  (let ((name (car entry))
+        (count (car (cdr entry)))
+        (fcount (cdr (cdr entry))))
+    (ACL2::cw! "  ~c0  ~c1   ~s2~%"
+               (cons count 10)
+               (cons fcount 10)
+               name)))
+
+(defun crewrite-cost-report (alist)
+  (declare (xargs :mode :program))
+  (if (consp alist)
+      (ACL2::prog2$ (crewrite-cost-report-line (car alist))
+                    (crewrite-cost-report (cdr alist)))
+    nil))
+
+
+(defun %debug-crewrite-cost ()
+  (declare (xargs :guard t))
+  nil)
+
+
+(ACL2::defttag %debug-crewrite-cost)
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+ (ACL2::defun %debug-crewrite-cost ()
+  (let* ((report-lines (remove-shadowed-pairs
+                        (rw.trace-size-debug-list
+                         (get-traces-from-skeleton (tactic.harness->skeleton (ACL2::w ACL2::*the-live-state*))) nil)
+                        nil))
+         (sorted-lines (ACL2::sort report-lines
+                                   #'(lambda (x y) (ACL2::> (second x) (second y))))))
+    (crewrite-cost-report sorted-lines))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/debug-split.lisp acl2-6.3/books/milawa/ACL2/interface/debug-split.lisp
--- acl2-6.2/books/milawa/ACL2/interface/debug-split.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/debug-split.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,69 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "core")
+
+
+(defmacro %ensure-no-outstanding-goals (note)
+  `(ACL2::make-event (%ensure-no-outstanding-goals-fn ',note (ACL2::w ACL2::state))))
+
+(defun %ensure-no-outstanding-goals-fn (note world)
+  (declare (xargs :mode :program))
+  (if (consp (tactic.harness->goals world))
+      (ACL2::er hard '%ensure-no-outstanding-goals
+                "Expected no outstanding goals at ~x0.~%"
+                note)
+    '(ACL2::value-triple :invisible)))
+
+
+
+(defmacro %debug-split ()
+  `(ACL2::make-event (%debug-split-fn (ACL2::w ACL2::state))))
+
+(defun %aux-debug-split-fn (goals i)
+  (declare (xargs :mode :program))
+  (if (consp goals)
+      (cons `(defsection ,(ACL2::mksym 'debugging-goal- (ACL2::intern-in-package-of-symbol (STR::string-fix i) 'foo))
+               (ACL2::value-triple (ACL2::cw "Now Debugging Goal ~x0.~%" ,i))
+               (ACL2::value-triple (ACL2::cw "~x0~%" '(ACL2::table tactic-harness 'skeleton (tactic.initial-skeleton (list ',(car goals))))))
+               (ACL2::table tactic-harness 'skeleton (tactic.initial-skeleton (list ',(car goals))))
+               (%auto)
+               (%ensure-no-outstanding-goals ,i))
+            (%aux-debug-split-fn (cdr goals) (+ i 1)))
+    nil))
+
+(defun %debug-split-fn (world)
+  (declare (xargs :mode :program))
+  `(ACL2::progn ,@(%aux-debug-split-fn (tactic.harness->goals world) 1)))
diff -Nru acl2-6.2/books/milawa/ACL2/interface/describe-theory.lisp acl2-6.3/books/milawa/ACL2/interface/describe-theory.lisp
--- acl2-6.2/books/milawa/ACL2/interface/describe-theory.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/describe-theory.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,80 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "core")
+
+
+;; BOZO I had two versions of this.  Not sure which one is better?
+
+;; (ACL2::defun sort-symbol-list (x)
+;;              (declare (xargs :mode :program)
+;;                       (ignore x))
+;;              (ACL2::er hard 'sort-symbol-list "Error: sort-symbol-list has not been redefined!~%"))
+
+;; (ACL2::defttag sort-symbol-list)
+
+;; (ACL2::progn!
+;;  (ACL2::set-raw-mode t)
+;;  (ACL2::defun sort-symbol-list (x)
+;;               (declare (xargs :mode :program))
+;;               (ACL2::sort x #'symbol-<)))
+
+;; (defmacro %describe-theory (theoryname)
+;;   `(describe-theory-fn ',theoryname (ACL2::w ACL2::state)))
+
+;; (defun describe-theory-fn (theoryname world)
+;;   (declare (xargs :mode :program))
+;;   (sort-symbol-list (rw.fast-rule-list-names$ (rw.gather-rules-from-theory
+;;                                                (tactic.find-theory theoryname world)
+;;                                                ''t
+;;                                                (tactic.harness->syndefs world)
+;;                                                nil)
+;;                                               nil)))
+
+
+
+(defmacro %describe-theory (theoryname)
+  `(describe-theory-fn ',theoryname (ACL2::w ACL2::state)))
+
+(defun describe-theory-fn (theoryname world)
+  (declare (xargs :mode :program))
+  (let* ((tactic-world (tactic.harness->world world))
+         (theory   (or (tactic.find-theory theoryname tactic-world)
+                       (acl2::er hard? 'describe-theory-fn "Theory ~x0 not found." theoryname)))
+         (defs     (tactic.world->defs tactic-world))
+         (rules    (rw.gather-rules-from-theory (cdr theory) ''t defs nil))
+         (names    (rw.rule-list-names rules)))
+    (sort-symbols names)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/evaluator.lisp acl2-6.3/books/milawa/ACL2/interface/evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/interface/evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/evaluator.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,165 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "core")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Implementing Magic Evaluation
+;;
+;; Now that we can inspect the global function definitions and arity table, we can
+;; make the magic-evaluator executable for the current definitions.
+
+(encapsulate
+ ()
+ (ACL2::defttag executable-magic-evaluator)
+ (ACL2::progn!
+  (ACL2::set-raw-mode t)
+
+  (ACL2::defun magic-evaluator (x defs)
+               (cond ((not (logic.termp x))
+                      (ACL2::er hard 'magic-evaluator "Tried to evaluate a non-term, ~x0.~%" x))
+                     ((not (logic.groundp x))
+                      (ACL2::er hard 'magic-evaluator "Tried to evaluate a non-ground term, ~x0.~%" x))
+                     ((ACL2::eq defs (tactic.harness->defs (ACL2::w ACL2::*the-live-state*)))
+                      (if (logic.warn-term-atblp x (tactic.harness->atbl (ACL2::w ACL2::*the-live-state*)))
+                          (list 'quote (ACL2::eval x))
+                        (ACL2::er hard 'magic-evaluator "Tried to evaluate a term with improper arity, ~x0.~%" x)))
+                     ;((ACL2::eq defs (tactic.harness->syndefs (ACL2::w ACL2::*the-live-state*)))
+                     ; ;; BOZO we should check the atbl with respect to the syndefs.  We don't even have an
+                     ; ;; atbl set up for this.  But we could add one and just update it in %syntax-defun-fn.
+                     ; (list 'quote (ACL2::eval x)))
+                     (t
+                      (ACL2::er hard 'magic-evaluator "Tried to evaluate with the wrong definitions.  ~
+                                                      Only (tactic.harness->defs (ACL2::w ACL2::state)) or ~
+                                                      (tactic.harness->syndefs (ACL2::w ACL2::state)) are ~
+                                                      permitted.~%"))))
+
+
+  ;; We were able to redefine the magic-evaluator above because we already had
+  ;; ACL2::eval available to us.  But ACL2 has no built-in function for creating
+  ;; a Milawa proof corresponding to an execution.  But we can easily introduce
+  ;; one, by modifying the generic-evaluator-bldr to not take a clock.
+
+  (ACL2::defun ACL2::eval-bldr (flag x defs)
+               (if (equal flag 'term)
+                   (cond ((logic.constantp x)
+                          (build.reflexivity x))
+                         ((logic.variablep x)
+                          nil)
+                         ((logic.functionp x)
+                          (let ((fn   (logic.function-name x))
+                                (args (logic.function-args x)))
+                            (if (and (equal fn 'if)
+                                     (equal (len args) 3))
+                                (let ((arg1-proof (ACL2::eval-bldr 'term (first args) defs)))
+                                  (and arg1-proof
+                                       (let ((arg1-prime (logic.=rhs (logic.conclusion arg1-proof))))
+                                         (if (logic.unquote arg1-prime)
+                                             (let ((arg2-proof (ACL2::eval-bldr 'term (second args) defs)))
+                                               (and arg2-proof
+                                                    (eval-lemma-1-bldr arg1-proof arg2-proof (third args))))
+                                           (let ((arg3-proof (ACL2::eval-bldr 'term (third args) defs)))
+                                             (and arg3-proof
+                                                  (eval-lemma-2-bldr arg1-proof arg3-proof (second args))))))))
+                              (let ((aproofs+ (ACL2::eval-bldr 'list args defs)))
+                                (and aproofs+
+                                     (let* ((aproofs (cdr aproofs+))
+                                            (vals    (logic.=rhses (logic.strip-conclusions aproofs))))
+                                       (if (memberp fn (domain (logic.initial-arity-table)))
+                                           (and (equal (cdr (lookup fn (logic.initial-arity-table))) (len aproofs))
+                                                (build.transitivity-of-pequal (build.pequal-by-args fn aproofs)
+                                                                              (build.base-eval (logic.function fn vals))))
+                                         (let* ((def (definition-list-lookup fn defs)))
+                                           (and def
+                                                (let ((formals (logic.function-args (logic.=lhs def)))
+                                                      (body    (logic.=rhs def)))
+                                                  (and (equal (len formals) (len aproofs))
+                                                       (let* ((sigma       (pair-lists formals vals))
+                                                              (ground-body (logic.substitute body sigma))
+                                                              (body-proof  (ACL2::eval-bldr 'term ground-body defs)))
+                                                         (and body-proof
+                                                              (build.transitivity-of-pequal (build.pequal-by-args fn aproofs)
+                                                                                            (build.transitivity-of-pequal
+                                                                                             (build.instantiation (build.axiom def) sigma)
+                                                                                             body-proof)))))))))))))))
+                         ((logic.lambdap x)
+                          (let ((formals  (logic.lambda-formals x))
+                                (body     (logic.lambda-body x))
+                                (actuals  (logic.lambda-actuals x)))
+                            (let ((aproofs+ (ACL2::eval-bldr 'list actuals defs)))
+                              (and aproofs+
+                                   (let* ((vals       (logic.=rhses (logic.strip-conclusions (cdr aproofs+))))
+                                          (sigma      (pair-lists formals vals))
+                                          (body-proof (ACL2::eval-bldr 'term (logic.substitute body sigma) defs)))
+                                     (and body-proof
+                                          (build.transitivity-of-pequal (build.transitivity-of-pequal
+                                                                         (build.lambda-pequal-by-args formals body (cdr aproofs+))
+                                                                         (build.beta-reduction formals body vals))
+                                                                        body-proof)))))))
+                         (t nil))
+                 (if (consp x)
+                     (let ((first (ACL2::eval-bldr 'term (car x) defs))
+                           (rest  (ACL2::eval-bldr 'list (cdr x) defs)))
+                       (if (and first rest)
+                           (cons t (cons first (cdr rest)))
+                         nil))
+                   (cons t nil))))
+
+  (ACL2::defun magic-evaluator-bldr (x defs)
+               (cond ((not (logic.termp x))
+                      (ACL2::er hard 'magic-evaluator-bldr "Tried to evaluate-bldr a non-term, ~x0.~%" x))
+                     ((not (logic.groundp x))
+                      (ACL2::er hard 'magic-evaluator-bldr "Tried to evaluate-bldr a non-ground term, ~x0.~%" x))
+                     ((not (logic.warn-term-atblp x (tactic.harness->atbl (ACL2::w ACL2::*the-live-state*))))
+                      (ACL2::er hard 'magic-evaluator-bldr "Tried to evaluate-bldr a term with improper arity, ~x0.~%" x))
+                     (t
+                      (if (ACL2::eq defs (tactic.harness->defs (ACL2::w ACL2::*the-live-state*)))
+                          (ACL2::eval-bldr 'term x defs)
+                        (ACL2::er hard 'magic-evaluator-bldr "Tried to evaluate-bldr with the wrong definitions. ~
+                                                              Only (tactic.harness->defs (ACL2::w ACL2::state)) ~
+                                                              are permitted.~%~
+                                                              Lengths: ~x0 (should be ~x1)~%~
+                                                              Missing: ~x2 ~%~
+                                                              Additional: ~x3 ~%~
+                                                              Defs are equal (but not eq)?: ~x4~%"
+                                  (len defs)
+                                  (len (tactic.harness->defs (ACL2::w ACL2::*the-live-state*)))
+                                  (fast-difference$ (tactic.harness->defs (ACL2::w ACL2::*the-live-state*)) defs nil)
+                                  (fast-difference$ defs (tactic.harness->defs (ACL2::w ACL2::*the-live-state*)) nil)
+                                  (equal defs (tactic.harness->defs (ACL2::w ACL2::*the-live-state*))))))))))
diff -Nru acl2-6.2/books/milawa/ACL2/interface/hons-proofs.lisp acl2-6.3/books/milawa/ACL2/interface/hons-proofs.lisp
--- acl2-6.2/books/milawa/ACL2/interface/hons-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/hons-proofs.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,95 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(ACL2::defttag hons-proofs)
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+
+ (ACL2::defun logic.function (name args)
+              (ACL2::hons name args))
+
+ (ACL2::defun logic.lambda (xs b ts)
+              (ACL2::hons (ACL2::hist 'lambda xs b) ts))
+
+ (ACL2::defun logic.pequal (a b)
+              (ACL2::hist 'pequal* a b))
+
+ (ACL2::defun logic.por (a b)
+              (ACL2::hist 'por* a b))
+
+ (ACL2::defun logic.pnot (a)
+              (ACL2::hist 'pnot* a))
+
+ (ACL2::defun logic.appeal (method conclusion subproofs extras)
+              (if extras
+                  (ACL2::hist method conclusion subproofs extras)
+                (if subproofs
+                    (ACL2::hist method conclusion subproofs)
+                  (ACL2::hist method conclusion))))
+
+ (ACL2::defun logic.appeal-identity (x)
+              (if (consp x)
+                  x
+                (ACL2::hons nil nil)))
+
+ (ACL2::defun hons-lookup (key map)
+              (ACL2::hons-get key map))
+
+ (ACL2::defun hons-update (key val map)
+              (ACL2::hons-acons key val map))
+
+ (ACL2::defun rw.eqtrace (method iffp lhs rhs subtraces)
+              (ACL2::hons (ACL2::hons lhs rhs)
+                          (ACL2::hons iffp
+                                      (ACL2::hons method subtraces))))
+
+ (ACL2::defun rw.trace (method hypbox lhs rhs iffp subtraces extras)
+              (ACL2::hons (ACL2::hons method rhs)
+                          (ACL2::hons (ACL2::hons lhs iffp)
+                                      (ACL2::hons hypbox
+                                                  (ACL2::hons extras subtraces)))))
+
+ (ACL2::defun rw.ftrace (rhs fgoals)
+              (ACL2::hons rhs fgoals)))
+
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/make-image.lsp acl2-6.3/books/milawa/ACL2/interface/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/interface/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/make-image.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,10 @@
+(in-package "MILAWA")
+:ubt! 1
+(ACL2::include-book "../levels/level11" :ttags :all)
+(ACL2::reset-prehistory)
+:q
+;; We get about a 1.5% speed improvement on rewriting by disabling
+;; the ephemeral garabage collector on OpenMCL.
+#+openmcl
+(CCL::egc nil)
+(ACL2::save-exec "../acl2-images/interface-acl2" "All tactics pre-loaded.")
diff -Nru acl2-6.2/books/milawa/ACL2/interface/pcert.lisp acl2-6.3/books/milawa/ACL2/interface/pcert.lisp
--- acl2-6.2/books/milawa/ACL2/interface/pcert.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/pcert.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,101 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; pcert.lisp -- provisional certification mechanism
+
+(in-package "ACL2")
+
+
+
+;; We implement our own provisional certification scheme for bootstrapping.
+;; This predates ACL2's notion of provisional certificates.  We might
+;; eventually switch to ACL2's new pcert mechanism, but at present it is not
+;; very mature and our scheme doesn't require the extra acl2x pass.
+;;
+;; Basic instructions for using this scheme:
+;;
+;;   (provisionally-certify "foo")
+;;
+;; This is ordinarily done by the pcert.pl script.
+;;
+;; For earlier versions of ACL2 (up through at least 4.1) the certify-book-info
+;; state global was just a string naming the book, and I did something here to
+;; emulate certify-book.  But with the new ACL2 pcert mechanism, this is now
+;; some complicated stupid defrec with very complicated semantics.  I don't
+;; know how to properly fake it, and keep hitting problems with uncertified-okp
+;; not being allowed no matter what mode I try.  Worse, I suspect this is all
+;; going to get overhauled again soon and so I'll have to update whatever I do
+;; to solve it.
+;;
+;; Well, fortunately the only function I was taking advantage of this was the
+;; current-book-info macro from acl2-hacks/io.lisp, and it seems that this
+;; macro was not even being used at all, so it doesn't really matter.
+;;
+;; So, now our pcert mechanism involves very little.  We basically just try to
+;; ld the file, and see if it was successful.  If we successfully load the
+;; file, we write out a .pcert file with its checksum.
+
+(defun check-sum-file (filename state)
+  (declare (xargs :guard (stringp filename) :mode :program :stobjs state))
+  (mv-let (channel state)
+          (open-input-channel filename :object state)
+          (mv-let (sum state)
+                  (check-sum channel state)
+                  (let ((state (close-input-channel channel state)))
+                    (mv sum state)))))
+
+;; This is very basic.  It doesn't do any embeddable event checks
+;; but does fail for incorrect theorems, at least.
+
+(defun provisionally-certify-fn (filename state)
+  (declare (xargs :guard (stringp filename)
+                  :mode :program
+                  :stobjs state))
+  (let ((lisp-file  (concatenate 'string filename ".lisp"))
+        (pcert-file (concatenate 'string filename ".mpcert")))
+    (ld `((cw "Provisionally certifying ~x0.~%" ,filename)
+          (ld ,lisp-file :ld-error-action :error)
+          (mv-let (channel state) (open-output-channel ,pcert-file :object state)
+            (mv-let (sum state) (check-sum-file ,lisp-file state)
+              (let* ((state (fms! "~f0 check-sum ~f1~|"
+                                  (list (cons #\0 ,lisp-file)
+                                        (cons #\1 sum))
+                                  channel state nil)))
+                (close-output-channel channel state))))
+          (cw "Provisional certification successful.~%")
+          (exit 44)))))
+
+(defmacro provisionally-certify (filename)
+  `(provisionally-certify-fn ,filename state))
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/profile-raw.lsp acl2-6.3/books/milawa/ACL2/interface/profile-raw.lsp
--- acl2-6.2/books/milawa/ACL2/interface/profile-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/profile-raw.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,417 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(ACL2::set-current-package "MILAWA" ACL2::*the-live-state*)
+
+;; This is the raw-lisp code for our rule profiler.
+;;
+;; Our goal is to pretend that the rewriter keeps a stack of the rules it is
+;; backchaining through.  For each rule, we want to count:
+;;
+;;   - cost, the number of stack frames generated because of this rule,
+;;   - tries, the number of times the rule was actually tried explicitly, and
+;;   - successes, the number of times all the rule's hyps were relieved.
+;;
+;; Eventually all of this information gets put into the "stored costs" table
+;; which maps rule names to cons-structures of the form:
+;;
+;;    (successes . (cost . tries))
+;;
+;; We really want profiling to be efficient, so the code is relatively ugly and
+;; optimized.  But for a moment, let's consider the most naive implementation
+;; of the profiler:
+;;
+;;   every time a rule is tried,
+;;    - increment the "cost" for each "active rule",
+;;    - increment the "tries" for this rule,
+;;    - increment the "successes" for this rule, if successful
+;;
+;; But this wouldn't be very efficient because the number of "active rules"
+;; will grow during backchaining, so incrementing them all might require quite
+;; a bit of work.
+;;
+;; To make this efficient, we introduce the following strategy.  There are two
+;; data structures involved:
+;;
+;;    - The "stored costs" table, as before, and
+;;    - The "active rules" stack, which has the form:
+;;         ( (cost1 . rune1) (cost2 . rune2) ... (costN . runeN) )
+;;
+;; Here, costI is the number of frames which runeN will be blamed for.  We
+;; update this structure as follows:
+;;
+;;   (1) every time a rule is tried, we simply augment the list as:
+;;       (1 . newrune) (cost1 . rune1) ... (costN . runeN)
+;;
+;;   (2) every time a cost1/rule1 are popped, we:
+;;        - add cost1 to cost2, so that rune2 will eventually inherit
+;           all the blame attributed to rune1
+;;        - add cost1 to rune1's cost in the stored costs table, so
+;;          that all the frames we want to give to rune1 are recorded
+;;        - add 1 to rune1's tried count in the stored costs table,
+;;          so that this additional try of rune1 is recorded
+;;
+;; This approach is dirtier but saves us from having to walk down the list and
+;; increment all the costs, and still keeps us from hammering the table all the
+;; time.
+
+(ACL2::declaim (ACL2::type ACL2::fixnum *profile.cache-tries*))
+(ACL2::declaim (ACL2::type ACL2::fixnum *profile.cache-hits*))
+(ACL2::declaim (ACL2::type ACL2::hash-table *profile.stored-costs*))
+(ACL2::declaim (ACL2::inline profile.update-stored-costs))
+(ACL2::declaim (ACL2::inline profile.push-rune))
+(ACL2::declaim (ACL2::inline profile.pop-rune))
+
+;; This size is almost surely excessive, but it's only going to be allocated
+;; once and I'd prefer if it never needed to be re-consed.
+(ACL2::defparameter *profile.stored-costs* (ACL2::make-hash-table :size 8192 :test #'ACL2::eq))
+(ACL2::defparameter *profile.active-rules* nil)
+(ACL2::defparameter *profile.cache-tries* 0)
+(ACL2::defparameter *profile.cache-hits* 0)
+
+(ACL2::defmacro the-fixnum (n) `(ACL2::the ACL2::fixnum ,n))
+(ACL2::defmacro when (&rest args) `(ACL2::when ,@args))
+(ACL2::defmacro progn (&rest args) `(ACL2::progn ,@args))
+(ACL2::defmacro incf (&rest args) `(ACL2::incf ,@args))
+(ACL2::defmacro setf (&rest args) `(ACL2::setf ,@args))
+(ACL2::defmacro gethash (&rest args) `(ACL2::gethash ,@args))
+
+(ACL2::defun profile.update-stored-costs (rune cost successp)
+             (declare (ACL2::type ACL2::fixnum cost))
+             (let ((entry (gethash rune *profile.stored-costs*)))
+               (if entry
+                   ;; Entry has the form (successes . (cost . tries)); we are going to
+                   ;; destructively update each component.
+                   (progn
+                    (when successp (incf (the-fixnum (ACL2::car entry))))
+                    (incf (the-fixnum (ACL2::cadr entry))
+                          (the-fixnum cost))
+                    (incf (the-fixnum (ACL2::cddr entry)))
+                    nil)
+                 ;; Otherwise we need to create the initial entry for this rune.  I was
+                 ;; quite surprised that (setf entry (cons ...)) didn't seem to work here.
+                 ;; Instead I had to repeat the gethash.  I'm not sure why this would be.
+                 (progn
+                   (setf (gethash rune *profile.stored-costs*)
+                         (cons (if successp 1 0)
+                               (cons cost 1)))
+                   nil))))
+
+(ACL2::defun profile.push-rune (rune)
+             (ACL2::push (cons 1 rune) *profile.active-rules*))
+
+(ACL2::defun profile.pop-rune (successp)
+             (when (consp *profile.active-rules*)
+               ;; This guard is needed in order to properly handle interrupts.
+               ;; If you interrupt in the middle of rewriting, generate a
+               ;; report, and then hit :go to continue, the rewriter will be
+               ;; exiting and trying to pop rules that you've already popped
+               ;; when generating the report.  We just silently ignore these
+               ;; frames now.  It's not quite accurate, but who really cares.
+               ;; Profiling is just to give you an idea of big trends, not
+               ;; little things.
+               (let* ((pair   (ACL2::pop *profile.active-rules*))
+                      (cost   (the-fixnum (ACL2::car pair)))
+                      (rune   (ACL2::cdr pair)))
+                 ;; Normally there will be subsequent pairs, which will need to be updated.
+                 (ACL2::when (consp *profile.active-rules*)
+                             (ACL2::incf (the-fixnum (ACL2::caar *profile.active-rules*))
+                                         (the-fixnum cost)))
+                 ;; And of course we need to update the stored costs.
+                 (profile.update-stored-costs rune cost successp))))
+
+(ACL2::defun profile.pop-all ()
+             (if (consp *profile.active-rules*)
+                 (progn (profile.pop-rune nil)
+                        (profile.pop-all))
+               nil))
+
+
+
+
+;; We also will profile execution of functions.
+
+(ACL2::defparameter *profile.executed-fns* (ACL2::make-hash-table :size 8192 :test #'ACL2::eq))
+
+
+(ACL2::defun %profile.clear ()
+             (setf *profile.active-rules* nil)
+             (setf *profile.cache-tries* 0)
+             (setf *profile.cache-hits* 0)
+             (ACL2::clrhash *profile.stored-costs*)
+             (ACL2::clrhash *profile.executed-fns*)
+             nil)
+
+
+(acl2::defun left-pad (x desired-width)
+             (let ((actual-width (ACL2::length x)))
+               (STR::cat (STR::implode (repeat #\Space (- desired-width actual-width))) x)))
+
+(acl2::defun pretty-fraction (x places)
+  (let* ((pretty-intpart (STR::pretty-number (ACL2::floor x 1)))
+         (floatpart      (ACL2::mod (ACL2::floor (ACL2::* (ACL2::expt 10 places) (ACL2::abs x)) 1)
+                                    (ACL2::expt 10 places))))
+    (STR::cat pretty-intpart
+              "."
+              (STR::implode (ACL2::explode-atom floatpart 10)))))
+
+(ACL2::defun profile.report-line (alist-entry)
+             (let* ((rune        (ACL2::car alist-entry))
+                    (successes   (ACL2::cadr alist-entry))
+                    (cost        (ACL2::caddr alist-entry))
+                    (tries       (ACL2::cdddr alist-entry))
+                    (rule        (tactic.find-rule rune (ACL2::w ACL2::*the-live-state*)))
+                    (splits      (not (clause.simple-termp (rw.rule->rhs rule))))
+                    (true-ratio  (ACL2::/ cost tries))
+                    (succ-color  (if (zp successes) *red* *black*))
+                    (ratio-color (cond ((ACL2::< true-ratio 20) *green*)
+                                       ((ACL2::< true-ratio 100) *blue*)
+                                       (t *red*)))
+                    (line        (STR::cat succ-color (left-pad (STR::pretty-number successes) 10) *black*
+                                           "  " (left-pad (STR::pretty-number tries) 10)
+                                           "  " (left-pad (STR::pretty-number cost) 12)
+                                           "  " ratio-color (left-pad (pretty-fraction true-ratio 2) 12) *black*
+                                           "   " (if splits "*" " ") (ACL2::symbol-name rune))))
+               (ACL2::cw! "~s0~%" line)))
+
+(ACL2::defun profile.names-of-unsuccessful-rules (alist)
+             (if (consp alist)
+                 (let ((alist-entry (ACL2::car alist)))
+                   (let ((rune      (ACL2::car alist-entry))
+                         (successes (ACL2::cadr alist-entry))
+                         (cost      (ACL2::caddr alist-entry)))
+                     (if (and (zp successes)
+                              (< 99 cost))
+                         (cons rune (profile.names-of-unsuccessful-rules (cdr alist)))
+                       (profile.names-of-unsuccessful-rules (cdr alist)))))
+               nil))
+
+(ACL2::defun profile.report-lines (alist)
+             (if (consp alist)
+                 (progn (profile.report-line (car alist))
+                        (profile.report-lines (cdr alist)))
+               nil))
+
+(ACL2::defun profile.exec-report-line (alist-entry)
+             (let* ((name      (ACL2::car alist-entry))
+                    (tries     (ACL2::cadr alist-entry))
+                    (successes (ACL2::cddr alist-entry))
+                    (line      (STR::cat
+                                (left-pad (STR::pretty-number tries) 10)
+                                "   " (left-pad (STR::pretty-number successes) 10)
+                                "     " (ACL2::symbol-name name))))
+               (ACL2::cw! "~s0~%" line)))
+
+(ACL2::defun profile.exec-report-lines (alist)
+             (if (consp alist)
+                 (progn (profile.exec-report-line (car alist))
+                        (profile.exec-report-lines (cdr alist)))
+               nil))
+
+(ACL2::defun %profile.report ()
+
+             ;; If we were interrupted, there may be entries on the active rule
+             ;; stack.  We pop them all to put them into stored costs.
+             (profile.pop-all)
+
+             (let ((alist nil))
+               (ACL2::loop for key being the hash-keys of *profile.stored-costs*
+                           using (hash-value value)
+                           do (ACL2::push (cons key value) alist))
+               (let ((sorted-alist (ACL2::sort alist #'(lambda (x y) (ACL2::> (ACL2::caddr x) (ACL2::caddr y))))))
+
+                 (ACL2::cw "~%The following statistics were gathered since the last (%profile) or ~
+                            (%profile.clear) was issued.~%~%")
+
+                 (ACL2::cw (STR::cat *blue* "Rewrite Rule Report~%~%" *black*))
+
+                 (let* ((percent   (acl2::floor (acl2::* 100 *profile.cache-hits*)
+                                                (if (acl2::= *profile.cache-tries* 0)
+                                                    1
+                                                  *profile.cache-tries*)))
+                        (pct-color (cond ((< percent 15) *red*)
+                                         ((< percent 30) *blue*)
+                                         (t *green*))))
+                   (ACL2::cw "~s0~%~%"
+                             (STR::cat "Cache hit rate: " pct-color percent "%" *black* " ("
+                                     (STR::pretty-number *profile.cache-hits*)
+                                     " hits in "
+                                     (STR::pretty-number *profile.cache-tries*)
+                                     " tries)")))
+
+                 (ACL2::cw "In the following table,~% ~
+                             - \"Success\" counts how many times all the hyps were relieved.~%  ~
+                             - \"Frames\" counts how many rules were tried due to this rule backchaining.~%  ~
+                             - \"Tries\" counts how many times this rule itself was tried.~%  ~
+                             - \"Ratio\" is the average number of frames per try.~%  ~
+                             - A star indicates this rule can cause case splits.~%~%   ~
+                             Success       Tries        Frames         Ratio    Rule~%~%")
+
+                 (profile.report-lines sorted-alist)
+
+                 ;; Execution report.
+                 (let ((exec-alist nil))
+                   (ACL2::loop for key being the hash-keys of *profile.executed-fns*
+                               using (hash-value value)
+                               do (ACL2::push (cons key value) exec-alist))
+                   (let ((sorted-exec-alist
+                          (ACL2::sort exec-alist #'(lambda (x y)
+                                                     (ACL2::> (ACL2::cadr x) (ACL2::cadr y))))))
+                     (ACL2::cw (STR::cat *blue* "~%Execution report.~%~%" *black*))
+                     (ACL2::cw "     Tries    Successes     Function~%")
+                     (profile.exec-report-lines sorted-exec-alist)))
+
+
+                 (let ((useless-rules (profile.names-of-unsuccessful-rules sorted-alist)))
+                   (if useless-rules
+                       (progn
+                         (ACL2::cw (STR::cat *blue* "~%~%Useless, Expensive Rules~%~%" *black*))
+                         (ACL2::cw "The following rules were never successful and each took over 100 frames.  ~
+                                    To speed up your rewriting, you may wish to consider disabling them:~%~%~
+                                    ~x0.~%~%" useless-rules))
+                     (ACL2::cw "~%~%")))
+
+                 )))
+
+(ACL2::defun %profile ()
+              (ACL2::progn
+               (ACL2::redef-notinline rw.flag-crewrite)
+               (ACL2::redef-notinline rw.fast-flag-crewrite) ;; wtf is this?
+
+               (%profile.clear)
+
+               (CCL:advise rw.try-ground-simplify
+                           (let ((x      (ACL2::second CCL::arglist))
+                                 (answer (ACL2::first CCL::values)))
+                             (when (logic.functionp x)
+                               (let* ((name  (logic.function-name x))
+                                      ;; Entry ::= (tries . successes) or NIL if not yet entered.
+                                      (entry (gethash name *profile.executed-fns*))
+                                      (tries (if entry (car entry) 0))
+                                      (succs (if entry (cdr entry) 0)))
+                                 (setf (gethash name *profile.executed-fns*)
+                                       (cons (+ 1 tries)
+                                             (if answer (+ 1 succs) succs))))))
+                           :when :after)
+               (CCL:advise rw.fast-try-ground-simplify
+                           (let ((x      (ACL2::second CCL::arglist))
+                                 (answer (ACL2::first CCL::values)))
+                             (when (logic.functionp x)
+                               (let* ((name  (logic.function-name x))
+                                      ;; Entry ::= (tries . successes) or NIL if not yet entered.
+                                      (entry (gethash name *profile.executed-fns*))
+                                      (tries (if entry (car entry) 0))
+                                      (succs (if entry (cdr entry) 0)))
+                                 (setf (gethash name *profile.executed-fns*)
+                                       (cons (+ 1 tries)
+                                             (if answer (+ 1 succs) succs))))))
+                           :when :after)
+
+               (CCL:advise rw.flag-crewrite
+                           (let ((flag (ACL2::first CCL::arglist)))
+                             (if (ACL2::eq flag 'match)
+                                 (let ((rule[s] (ACL2::fourth CCL::arglist)))
+                                   (profile.push-rune (rw.rule->name rule[s])))
+                               nil))
+                           :when :before)
+               (CCL:advise rw.flag-crewrite
+                           (let ((flag (ACL2::first CCL::arglist)))
+                             (if (ACL2::eq flag 'match)
+                                 ;; We have to "car" this twice, because CCL::values supports multiple-value
+                                 ;; returns.  The first car gets us to our 3-tuple, and the second car gets
+                                 ;; us our trace/nil entry.
+                                 (let ((trace/nil (ACL2::car (ACL2::first CCL::values))))
+                                   (profile.pop-rune trace/nil))
+                               nil))
+                           :when :after)
+
+               (CCL:advise rw.fast-flag-crewrite
+                           (let ((flag (ACL2::first CCL::arglist)))
+                             (if (ACL2::eq flag 'match)
+                                 (let ((rule[s] (ACL2::fourth CCL::arglist)))
+                                   (profile.push-rune (rw.rule->name rule[s])))
+                               nil))
+                           :when :before)
+               (CCL:advise rw.fast-flag-crewrite
+                           (let ((flag (ACL2::first CCL::arglist)))
+                             (if (ACL2::eq flag 'match)
+                                 ;; We have to "car" this twice, because CCL::values supports multiple-value
+                                 ;; returns.  The first car gets us to our 3-tuple, and the second car gets
+                                 ;; us our trace/nil entry.
+                                 (let ((trace/nil (ACL2::car (ACL2::first CCL::values))))
+                                   (profile.pop-rune trace/nil))
+                               nil))
+                           :when :after)
+
+               (CCL:advise rw.cache-lookup
+                           (let ((answer (ACL2::first CCL::values)))
+                             (ACL2::incf *profile.cache-tries*)
+                             (ACL2::when answer (ACL2::incf *profile.cache-hits*)))
+                           :when :after)
+               (CCL:advise rw.fast-cache-lookup
+                           (let ((answer (ACL2::first CCL::values)))
+                             (ACL2::incf *profile.cache-tries*)
+                             (ACL2::when answer (ACL2::incf *profile.cache-hits*)))
+                           :when :after)
+               nil))
+
+(ACL2::defun %profile.stop ()
+              (ACL2::progn
+               (CCL:unadvise rw.try-ground-simplify)
+               (CCL:unadvise rw.fast-try-ground-simplify)
+               (CCL:unadvise rw.flag-crewrite)
+               (CCL:unadvise rw.fast-flag-crewrite)
+               (CCL:unadvise rw.cache-lookup)
+               (CCL:unadvise rw.fast-cache-lookup)
+               (ACL2::redef-original rw.flag-crewrite) ;; wtf is this?
+               (ACL2::redef-original rw.fast-flag-crewrite) ;; wtf is this?
+               nil))
+
+
+#|
+(profile.push-rune 'a)
+(profile.push-rune 'b)
+(profile.push-rune 'c)
+(profile.push-rune 'd)
+(profile.pop-rune)
+(profile.pop-rune)
+(profile.push-rune 'e)
+(profile.push-rune 'f)
+(profile.pop-rune)
+(profile.pop-rune)
+(profile.pop-rune)
+(profile.pop-rune)
+(%profile.report)
+|#
diff -Nru acl2-6.2/books/milawa/ACL2/interface/profile.lisp acl2-6.3/books/milawa/ACL2/interface/profile.lisp
--- acl2-6.2/books/milawa/ACL2/interface/profile.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/profile.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,477 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; Profiling code.
+;;
+;; This is supposed to be like ACL2's "accumulated-persistence" facility.  As
+;; with accumulated-persistence, profiling will considerably slow down the
+;; rewriter, so you'll only want to enable it to figure out which rules are
+;; expensive, then disable it to do your actual rewriting.  Here is the public
+;; interface for using the profiler.
+
+(ACL2::defun %profile ()
+  ;; Begin collecting profiling data.
+  (declare (xargs :guard t))
+  (ACL2::cw "%profile needs to be redefined!~%"))
+
+(ACL2::defun %profile.clear ()
+  ;; Erase all the current profiling data
+  (declare (xargs :guard t))
+  (ACL2::cw "%profile.clear needs to be redefined!~%"))
+
+(ACL2::defun %profile.report ()
+  ;; View the current profiling report, and erase current data
+  (declare (xargs :guard t))
+  (ACL2::cw "%profile.report needs to be redefined!~%"))
+
+(ACL2::defun %profile.stop ()
+  ;; Completely turn off the profiler.
+  (declare (xargs :guard t))
+  (ACL2::cw "%profile.stop needs to be redefined!~%"))
+
+
+
+;; There are also some system-level commands.  You should never call these
+;; directly.  But, I still need to introduce them as ACL2 functions and then
+;; redefine them, so that we can call them from the new trace$ code introduced
+;; in ACL2 3.4.
+
+(ACL2::defun %profile-enter-rw.flag-crewrite (flag rule[s])
+  ;; Called when we enter rw.flag-crewrite
+  ;; We may need to update the rule usage statistics tables
+  (declare (xargs :guard t)
+           (ignore flag rule[s]))
+  (ACL2::cw "%profile-enter-rw.flag-crewrite needs to be redefined!~%"))
+
+(ACL2::defun %profile-exit-rw.flag-crewrite (flag)
+  ;; Called when we exit rw.flag-crewrite
+  ;; We may need to update the rule usage statistics tables
+  (declare (xargs :guard t)
+           (ignore flag))
+  (ACL2::cw "%profile-exit-rw.flag-crewrite needs to be redefined!~%"))
+
+(ACL2::defun %profile-exit-rw.cache-lookup (answer)
+  ;; Called when we exit rw.cache-lookup
+  ;; We just update the cache hit-rate statistics
+  (declare (xargs :guard t)
+           (ignore answer))
+  (ACL2::cw "%profile-exit-rw.cache-lookup needs to be redefined!~%"))
+
+
+
+
+
+(ACL2::defttag profile)
+
+;; ---- this is the new profiling code.  uncomment this when Matt implements
+;;      a print-free tracing mechanism
+
+
+;; (ACL2::progn!
+;;  (ACL2::set-raw-mode t)
+
+;;  ;; This is the raw-lisp code for our rule profiler.  We have tried to make
+;;  ;; profiling somewhat efficient, so the code is somewhat complex.
+;;  ;;
+;;  ;; We pretend that the rewriter keeps a stack of the rules it is backchaining
+;;  ;; through.  For each rule, we want to count (1) the number of stack frames
+;;  ;; generated because of this rule, and (2) the number of times the rule was
+;;  ;; actually tried explicitly.
+;;  ;;
+;;  ;; Eventually all of this information gets put into the "stored costs" alist,
+;;  ;; which is just a table of entries of the form <rune, cost, tries>.  The most
+;;  ;; naive implementation of the profiler would just be:
+;;  ;;
+;;  ;;   (1) every time a rule is tried, increment all of the costs of every
+;;  ;;       active rule, and increment the tries of the rule being tried.
+;;  ;;
+;;  ;; This wouldn't be very efficient.  An enhancement would be to associate
+;;  ;; costs with each active rule.  Under this idea:
+;;  ;;
+;;  ;;   (1) every time a rule is tried, increment all of the costs on the
+;;  ;;       active rule stack.
+;;  ;;
+;;  ;;   (2) when a rule is popped, add its cost into the stored costs alist.
+;;  ;;
+;;  ;; This saves a lot of alist accessing, but it still requires us to increment
+;;  ;; many variables.  Our final twist is to change the active rule list into a
+;;  ;; funny stack that looks like this:
+;;  ;;
+;;  ;;   (cost1 rune1 cost2 rune2 ... costN runeN)
+;;  ;;
+;;  ;; Here, costI is the number of frames which runeN will be blamed for.  We
+;;  ;; update this structure as follows:
+;;  ;;
+;;  ;;   (1) every time a rule is tried, we simply augment the list as:
+;;  ;;       (1 newrune cost1 rune1 ... costN runeN)
+;;  ;;
+;;  ;;   (2) every time a cost1/rule1 are popped, we:
+;;  ;;        - add cost1 to cost2, so that rune2 inherits all the blame
+;;  ;;          attributed to rune1
+;;  ;;        - add cost1 to rune1's cost in the stored costs alist
+;;  ;;        - add 1 to rune1's tried count in the stored costs alist
+;;  ;;
+;;  ;; This approach is dirtier but saves us from having to walk down the list and
+;;  ;; increment all the costs, and still keeps us from hammering the alist all the
+;;  ;; time.
+
+
+;;  (ACL2::defparameter *profile.active-rules* nil)
+;;  (ACL2::defparameter *profile.stored-costs* nil)
+;;  (ACL2::defparameter *profile.cache-tries* 0)
+;;  (ACL2::defparameter *profile.cache-hits* 0)
+
+
+
+;;  (ACL2::defun %profile.clear ()
+;;               (ACL2::setf *profile.active-rules* nil)
+;;               (ACL2::setf *profile.stored-costs* nil)
+;;               (ACL2::setf *profile.cache-tries* 0)
+;;               (ACL2::setf *profile.cache-hits* 0)
+;;               nil)
+
+
+
+;;  (ACL2::defun profile.update-stored-costs (rune cost)
+;;               ;; Arframe is the frame we just popped from the active rule stack.
+;;               (let* ((entry              (ACL2::hons-assoc-equal rune *profile.stored-costs*))
+;;                      (old-cost-and-tries (cdr entry))
+;;                      (old-cost           (first old-cost-and-tries))
+;;                      (old-tries          (second old-cost-and-tries))
+;;                      (new-cost           (+ cost old-cost))
+;;                      (new-tries          (+ old-tries 1)))
+;;                 (ACL2::setf *profile.stored-costs*
+;;                             (ACL2::hons-acons rune (list new-cost new-tries) *profile.stored-costs*))))
+
+;;  (ACL2::defun profile.push-rune (rune)
+;;               (ACL2::setf *profile.active-rules*
+;;                           (cons 1 (cons rune *profile.active-rules*))))
+
+;;  (ACL2::defun profile.pop-rune ()
+;;               (let ((cost (ACL2::pop *profile.active-rules*))
+;;                     (rune (ACL2::pop *profile.active-rules*)))
+;;                 (ACL2::progn
+;;                  ;; Update cost2 if it exists
+;;                  (if (consp *profile.active-rules*)
+;;                      (let ((cost2 (ACL2::pop *profile.active-rules*)))
+;;                        (ACL2::push (ACL2::+ cost cost2) *profile.active-rules*))
+;;                    nil)
+;;                  ;; Update the stored costs
+;;                  (profile.update-stored-costs rune cost))))
+
+;;  (ACL2::defun profile.pop-all ()
+;;               (if (consp *profile.active-rules*)
+;;                   (ACL2::prog2$ (profile.pop-rune)
+;;                                 (profile.pop-all))
+;;                 nil))
+
+;;  (ACL2::defun remove-shadowed-pairs (x acc)
+;;               (if (consp x)
+;;                   (remove-shadowed-pairs (cdr x)
+;;                                          (if (ACL2::assoc (car (car x)) acc)
+;;                                              acc
+;;                                            (cons (car x) acc)))
+;;                 acc))
+
+;;  (ACL2::defun profile.report-line (entry)
+;;               (let ((rune  (car entry))
+;;                     (cost  (second entry))
+;;                     (tries (third entry)))
+;;                 (ACL2::cw! "  ~c0  ~c1   (~c2.~f3~f4)   ~x5~%"
+;;                            (cons cost 10)
+;;                            (cons tries 10)
+;;                            (cons (ACL2::floor cost tries) 7)
+;;                            (mod  (floor (* 10 cost) tries) 10)
+;;                            (mod  (floor (* 100 cost) tries) 10)
+;;                            rune)))
+
+;;  (ACL2::defun profile.report-lines (alist)
+;;               (if (consp alist)
+;;                   (ACL2::prog2$ (profile.report-line (car alist))
+;;                                 (profile.report-lines (cdr alist)))
+;;                 nil))
+
+;;  (ACL2::defun %profile.report ()
+;;               (ACL2::cw "~% ~
+;;               - Frames is how many rules were tried due to this rule backchaining.~% ~
+;;               - Tries is the actual number of times this rule was tried.~% ~
+;;               - Ratio is the average frames per try.~%~%      ~
+;;                   Frames       Tries          Ratio   Rule~%~%")
+;;               ;; If we were interrupted, there may be entries on the active rule
+;;               ;; stack.  We pop them all to put them into stored costs.
+;;               (profile.pop-all)
+;;               ;; We now remove all the shadowed pairs and sort the list so that
+;;               ;; the rules are presented in a sensible order, and print the report.
+;;               (profile.report-lines (ACL2::sort (remove-shadowed-pairs *profile.stored-costs* nil)
+;;                                                 #'(lambda (x y) (ACL2::> (second x) (second y)))))
+;;               (ACL2::cw "~%")
+;;               (ACL2::cw "Note: the unconditional rules mentioned above are probably underreported, ~
+;;              because they are tracked only in \"crewrite\" and not in \"urewrite.\"~%~
+;;              Crewrite cache statistics: ~x0 hits in ~x1 tries (~x2%).~%~%"
+;;                         *profile.cache-hits*
+;;                         *profile.cache-tries*
+;;                         (floor (* 100 *profile.cache-hits*) *profile.cache-tries*))
+;;               ;; We have mangled the halist breaking the hons-acons discipline.  We
+;;               ;; clear out the stack in case someone wants to profile further.
+;;               (%profile.clear)
+;;               nil)
+
+;;  (ACL2::defun %profile-enter-rw.flag-crewrite (flag rule[s])
+;;               (if (equal flag 'match)
+;;                   (profile.push-rune (rw.rule->name rule[s]))
+;;                 nil))
+
+;;  (ACL2::defun %profile-exit-rw.flag-crewrite (flag)
+;;               (if (equal flag 'match)
+;;                   (profile.pop-rune)
+;;                 nil))
+
+;;  (ACL2::defun %profile-exit-rw.cache-lookup (answer)
+;;               (ACL2::incf *profile.cache-tries*)
+;;               (ACL2::when answer
+;;                           (ACL2::incf *profile.cache-hits*)))
+
+;;  (ACL2::defun %profile ()
+;;               (ACL2::redef-notinline rw.flag-crewrite)
+;;               (%profile.clear)
+;;               #-openmcl
+;;               (ACL2::eval '(ACL2::trace$ (rw.flag-crewrite
+;;                                           :entry (%profile-enter-rw.flag-crewrite flag rule[s])
+;;                                           :exit (%profile-exit-rw.flag-crewrite flag))))
+;;               #-openmcl
+;;               (ACL2::eval '(ACL2::trace$ (rw.cache-lookup :exit (%profile-exit-rw.cache-lookup ACL2::value))))
+;;               #+opemcl
+;;               (CCL:advise rw.flag-crewrite
+;;                           (%profile-enter-rw.flag-crewrite (ACL2::car CCL::arglist)
+;;                                                            (ACL2::fourth CCL::arglist))
+;;                           :when :before)
+;;               #+openmcl
+;;               (CCL:advise rw.flag-crewrite
+;;                           (%profile-exit-rw.flag-crewrite (ACL2::car CCL::arglist))
+;;                           :when :after)
+;;               #+openmcl
+;;               (CCL:advise rw.cache-lookup
+;;                           (%profile-exit-rw.cache-lookup (ACL2::car CCL::values))
+;;                           :when :after)
+;;               nil)
+
+;;  (ACL2::defun %profile.stop ()
+;;               (ACL2::redef-original rw.flag-crewrite)
+;;               (ACL2::untrace$ rw.flag-crewrite)
+;;               (ACL2::untrace$ rw.cache-lookup)
+;;               nil))
+
+
+;; stupid crap thing won't let me use ccl::advise in raw mode??!
+
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+ (let* ((tacdir  (ACL2::extend-pathname ACL2::*path-to-milawa-acl2-directory* "interface"       ACL2::*the-live-state*))
+        (rawfile (ACL2::extend-pathname tacdir                                "profile-raw.lsp" ACL2::*the-live-state*)))
+   (ACL2::load rawfile)))
+
+;;  (ACL2::defparameter *profile.active-rules* nil)
+;;  (ACL2::defparameter *profile.stored-costs* nil)
+;;  (ACL2::defparameter *profile.cache-tries* 0)
+;;  (ACL2::defparameter *profile.cache-hits* 0)
+
+;;  (ACL2::defun profile.update-stored-costs (rune cost)
+;;               ;; Arframe is the frame we just popped from the active rule stack.
+;;               (let* ((entry              (ACL2::hons-assoc-equal rune *profile.stored-costs*))
+;;                      (old-cost-and-tries (cdr entry))
+;;                      (old-cost           (first old-cost-and-tries))
+;;                      (old-tries          (second old-cost-and-tries))
+;;                      (new-cost           (+ cost old-cost))
+;;                      (new-tries          (+ old-tries 1)))
+;;                 (ACL2::setf *profile.stored-costs*
+;;                             (ACL2::hons-acons rune (list new-cost new-tries) *profile.stored-costs*))))
+
+;;  ;; (ACL2::defun profile.increment-arstack-aux (arstack acc)
+;;  ;;              ;; Arstack is the active rules stack.  We want to increment every cost.
+;;  ;;              (if (consp arstack)
+;;  ;;                  (profile.increment-arstack-aux (cdr arstack)
+;;  ;;                                                 (let* ((entry (car arstack))
+;;  ;;                                                        (rune  (car entry))
+;;  ;;                                                        (cost  (cdr entry)))
+;;  ;;                                                   (cons (cons rune (ACL2::+ 1 cost))
+;;  ;;                                                         acc)))
+;;  ;;                (ACL2::reverse acc)))
+
+;;  ;; (ACL2::defun profile.increment-arstack ()
+;;  ;;              (ACL2::setf *profile.active-rules*
+;;  ;;                          (profile.increment-arstack-aux *profile.active-rules* nil)))
+
+;;  (ACL2::defun profile.push-rune (rune)
+;;               (ACL2::setf *profile.active-rules*
+;;                           (cons 1 (cons rune *profile.active-rules*))))
+
+;;  (ACL2::defun profile.pop-rune ()
+;;               (let ((cost (ACL2::pop *profile.active-rules*))
+;;                     (rune (ACL2::pop *profile.active-rules*)))
+;;                 (ACL2::progn
+;;                  ;; Update cost2 if it exists
+;;                  (if (consp *profile.active-rules*)
+;;                      (let ((cost2 (ACL2::pop *profile.active-rules*)))
+;;                        (ACL2::push (ACL2::+ cost cost2) *profile.active-rules*))
+;;                    nil)
+;;                  ;; Update the stored costs
+;;                  (profile.update-stored-costs rune cost))))
+
+;;  (ACL2::defun profile.pop-all ()
+;;               (if (consp *profile.active-rules*)
+;;                   (ACL2::prog2$ (profile.pop-rune)
+;;                                 (profile.pop-all))
+;;                 nil))
+
+;;  (ACL2::defun remove-shadowed-pairs (x acc)
+;;               (if (consp x)
+;;                   (remove-shadowed-pairs (cdr x)
+;;                                          (if (ACL2::assoc (car (car x)) acc)
+;;                                              acc
+;;                                            (cons (car x) acc)))
+;;                 acc))
+
+;;  (ACL2::defun profile.report-line (entry)
+;;               (let ((rune  (car entry))
+;;                     (cost  (second entry))
+;;                     (tries (third entry)))
+;;                 (ACL2::cw! "  ~c0  ~c1   (~c2.~f3~f4)   ~x5~%"
+;;                            (cons cost 10)
+;;                            (cons tries 10)
+;;                            (cons (ACL2::floor cost tries) 7)
+;;                            (mod  (floor (* 10 cost) tries) 10)
+;;                            (mod  (floor (* 100 cost) tries) 10)
+;;                            rune)))
+
+;;  (ACL2::defun profile.report-lines (alist)
+;;               (if (consp alist)
+;;                   (ACL2::prog2$ (profile.report-line (car alist))
+;;                                 (profile.report-lines (cdr alist)))
+;;                 nil))
+
+;;  (ACL2::defun %profile.clear ()
+;;               (ACL2::progn
+;;                (ACL2::setf *profile.active-rules* nil)
+;;                (ACL2::setf *profile.stored-costs* nil)
+;;                (ACL2::setf *profile.cache-tries* 0)
+;;                (ACL2::setf *profile.cache-hits* 0)
+;;                nil))
+
+;;  (ACL2::defun %profile.report ()
+;;               (ACL2::progn
+;;                (ACL2::cw "~% ~
+;;                           - Frames is how many rules were tried due to this rule backchaining.~% ~
+;;                           - Tries is the actual number of times this rule was tried.~% ~
+;;                           - Ratio is the average frames per try.~%~%      ~
+;;                          Frames       Tries          Ratio   Rule~%~%")
+;;                ;; If we were interrupted, there may be entries on the active rule
+;;                ;; stack.  We pop them all to put them into stored costs.
+;;                (profile.pop-all)
+;;                ;; We now remove all the shadowed pairs and sort the list so that
+;;                ;; the rules are presented in a sensible order, and print the report.
+;;                (profile.report-lines (ACL2::sort (remove-shadowed-pairs *profile.stored-costs* nil)
+;;                                                  #'(lambda (x y) (ACL2::> (second x) (second y)))))
+;;                (ACL2::cw "~%")
+;;                (ACL2::cw "Note: the unconditional rules mentioned above are probably underreported, ~
+;;                          because they are tracked only in \"crewrite\" and not in \"urewrite.\"~%~
+;;                          Crewrite cache statistics: ~x0 hits in ~x1 tries (~x2%).~%~%"
+;;                          *profile.cache-hits*
+;;                          *profile.cache-tries*
+;;                          (floor (* 100 *profile.cache-hits*) *profile.cache-tries*))
+;;                ;; We have mangled the halist breaking the hons-acons discipline.  We
+;;                ;; clear out the stack in case someone wants to profile further.
+;;                (%profile.clear)
+;;                nil))
+
+
+;;  (ACL2::defun %profile ()
+;;               (ACL2::progn
+;;                (ACL2::redef-notinline rw.flag-crewrite)
+;;                (%profile.clear)
+;;                (CCL:advise rw.flag-crewrite
+;;                            (let* ((arglist  CCL::arglist)
+;;                                   (flag     (nth 0 arglist))
+;;                                   (assms    (nth 1 arglist))
+;;                                   (x        (nth 2 arglist))
+;;                                   (rule[s]  (nth 3 arglist))
+;;                                   (sigma[s] (nth 4 arglist))
+;;                                   (cache    (nth 5 arglist))
+;;                                   (iffp     (nth 6 arglist))
+;;                                   (blimit   (nth 7 arglist))
+;;                                   (rlimit   (nth 8 arglist))
+;;                                   (anstack  (nth 9 arglist))
+;;                                   (control  (nth 10 arglist)))
+;;                              (declare (ACL2::ignorable flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control))
+;;                              (if (equal flag 'match)
+;;                                  (profile.push-rune (rw.rule->name rule[s]))
+;;                                nil))
+;;                            :when :before)
+;;                (CCL:advise rw.flag-crewrite
+;;                            (let* ((arglist  CCL::arglist)
+;;                                   (flag     (nth 0 arglist))
+;;                                   (assms    (nth 1 arglist))
+;;                                   (x        (nth 2 arglist))
+;;                                   (rule[s]  (nth 3 arglist))
+;;                                   (sigma[s] (nth 4 arglist))
+;;                                   (cache    (nth 5 arglist))
+;;                                   (iffp     (nth 6 arglist))
+;;                                   (blimit   (nth 7 arglist))
+;;                                   (rlimit   (nth 8 arglist))
+;;                                   (anstack  (nth 9 arglist))
+;;                                   (control  (nth 10 arglist)))
+;;                              (declare (ACL2::ignorable flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control))
+;;                              (if (equal flag 'match)
+;;                                  (profile.pop-rune)
+;;                                nil))
+;;                            :when :after)
+;;                (CCL:advise rw.cache-lookup
+;;                            (let* ((values  CCL::values)
+;;                                   (answer  (first values)))
+;;                              (ACL2::incf *profile.cache-tries*)
+;;                              (ACL2::when answer
+;;                                          (ACL2::incf *profile.cache-hits*)))
+;;                            :when :after)
+;;                nil))
+
+;;  (ACL2::defun %profile.stop ()
+;;               (ACL2::progn
+;;                (CCL:unadvise rw.crewrite-entry)
+;;                (CCL:unadvise rw.crewrite-note-fn)
+;;                (CCL:unadvise rw.cache-lookup)
+;;                (ACL2::redef-original rw.flag-crewrite)
+;;                nil)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/read-file-raw.lsp acl2-6.3/books/milawa/ACL2/interface/read-file-raw.lsp
--- acl2-6.2/books/milawa/ACL2/interface/read-file-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/read-file-raw.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,102 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "CL-USER")
+
+(defmacro report-time (message form)
+  `(let* ((start-time (get-internal-real-time))
+          (value      ,form)
+          (stop-time  (get-internal-real-time))
+          (elapsed    (/ (coerce (- stop-time start-time) 'float)
+                         internal-time-units-per-second)))
+     (format t ";; ~A took ~$ seconds~%" ,message elapsed)
+     value))
+
+(defvar *milawa-readtable* (copy-readtable *readtable*))
+(declaim (readtable *milawa-readtable*))
+
+(defvar *milawa-abbreviations-hash-table*)
+(declaim (type hash-table *milawa-abbreviations-hash-table*))
+
+(defun milawa-sharp-equal-reader (stream subchar arg)
+  (declare (ignore subchar))
+  (multiple-value-bind
+   (value presentp)
+   (gethash arg *milawa-abbreviations-hash-table*)
+   (declare (ignore value))
+   (when presentp
+     (error "#~A= is already defined." arg))
+   (let ((object (read stream)))
+     (setf (gethash arg *milawa-abbreviations-hash-table*) object))))
+
+(defun milawa-sharp-sharp-reader (stream subchar arg)
+  (declare (ignore stream subchar))
+  (or (gethash arg *milawa-abbreviations-hash-table*)
+      (error "#~A# used but not defined." arg)))
+
+(let ((*readtable* *milawa-readtable*))
+  (set-dispatch-macro-character #\# #\# #'milawa-sharp-sharp-reader)
+  (set-dispatch-macro-character #\# #\= #'milawa-sharp-equal-reader))
+
+(defconstant unique-cons-for-eof (cons 'unique-cons 'for-eof))
+
+(defun milawa-read-file-aux (stream)
+   (let ((obj (read stream nil unique-cons-for-eof)))
+     (cond ((eq obj unique-cons-for-eof)
+            nil)
+           (t
+            (cons obj (milawa-read-file-aux stream))))))
+
+(defun MILAWA::milawa-read-file (filename)
+  (format t ";; Reading from ~A~%" filename)
+  (report-time "Reading the file"
+    (let* ((*milawa-abbreviations-hash-table* (make-hash-table
+                                               :size 10000
+                                               :rehash-size 100000
+                                               :test 'eql))
+           (*readtable* *milawa-readtable*)
+           (*package*   (find-package "MILAWA"))
+           (stream (open filename
+                         :direction :input
+                         :if-does-not-exist :error))
+           (contents (milawa-read-file-aux stream)))
+      (close stream)
+      ;; the actual version of this for the proof checker includes
+      ;; an acceptable-objectp check, but in this case we don't
+      ;; really care.
+      contents)))
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/read-file.lisp acl2-6.3/books/milawa/ACL2/interface/read-file.lisp
--- acl2-6.2/books/milawa/ACL2/interface/read-file.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/read-file.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,50 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tools/include-raw" :dir :system)
+
+; Obviously unsound, but we don't care about the soundness of ACL2 at
+; this point.
+
+(acl2::defun milawa-read-file (filename)
+  (declare (xargs :guard t)
+           (ignore filename))
+  (acl2::er acl2::hard? 'milawa-read-file
+            "raw lisp definition not installed?"))
+
+(acl2::defttag read-write)
+
+(acl2::include-raw "read-file-raw.lsp")
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/rewrite-tactics.lisp acl2-6.3/books/milawa/ACL2/interface/rewrite-tactics.lisp
--- acl2-6.2/books/milawa/ACL2/interface/rewrite-tactics.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/rewrite-tactics.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,739 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "simple-tactics")
+
+
+;; Rewriting control variables
+;;
+;; Our rewriting tactics have several parameters.  We use more variables to
+;; hold these parameters and provide some functions for setting them.
+
+
+;; UFASTP is the flag for using the fast unconditional rewriter.  This is kind
+;; of subtle.
+;;
+;;   - At low levels, it will improve proof-finding times, but slow down
+;;     overall proof time (because the slow urewrite has to be used during the
+;;     build.)
+;;
+;;   - At high levels, it will improve proof-finding and building times, and
+;;     result in much smaller proofs (urewriting is one step).  It's not clear
+;;     whether the generated proofs would take longer to check or not; it's a
+;;     question of whether looking up the rules and doing the pattern matching
+;;     is more expensive than checking many steps in a trace.
+;;
+;; CFASTP is the same, for the fast conditional rewriter.
+
+(ACL2::table tactic-harness 'ufastp nil)
+(ACL2::table tactic-harness 'cfastp nil)
+
+(defun tactic.harness->ufastp (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'ufastp (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->cfastp (acl2-world)
+  (declare (xargs :mode :program))
+  (cdr (lookup 'cfastp (ACL2::table-alist 'tactic-harness acl2-world))))
+
+(defun tactic.harness->noexec (acl2-world)
+  (declare (xargs :mode :program))
+  (tactic.world->noexec (tactic.harness->world acl2-world)))
+
+(defun tactic.update-noexec-wrapper (add rem world)
+  (declare (xargs :mode :program))
+  (tactic.update-noexec add rem world))
+
+(defun tactic.update-noexec-tac-wrapper (skelly add rem)
+  (declare (xargs :mode :program))
+  (tactic.update-noexec-tac skelly add rem))
+
+(defmacro %noexec (&rest names)
+  ;; %noexec instructs the rewriter not to try to evaluate terms whose leading
+  ;; function symbol is name.
+  `(ACL2::progn
+    ;; Step 1: Update the global world.
+    (ACL2::table tactic-harness 'world
+                 (let* ((add        ',names)
+                        (rem        nil)
+                        (world      (tactic.harness->world ACL2::world)))
+                   (tactic.update-noexec-wrapper add rem world)))
+    ;; Step 2: Update the skeleton, if there currently is one.
+    (ACL2::table tactic-harness 'skeleton
+                 (let* ((add        ',names)
+                        (rem        nil)
+                        (skelly     (tactic.harness->skeleton ACL2::world)))
+                   (and skelly
+                        (tactic.update-noexec-tac-wrapper skelly add rem))))))
+
+(defmacro %exec (&rest names)
+  ;; %exec permits the rewriter not to try to evaluate terms whose leading
+  ;; function symbol is name.
+  `(ACL2::progn
+    ;; Step 1: Update the global world.
+    (ACL2::table tactic-harness 'world
+                 (let* ((add        nil)
+                        (rem        ',names)
+                        (world      (tactic.harness->world ACL2::world)))
+                   (tactic.update-noexec-wrapper add rem world)))
+    ;; Step 2: Update the skeleton, if there currently is one.
+    (ACL2::table tactic-harness 'skeleton
+                 (let* ((add        nil)
+                        (rem        ',names)
+                        (skelly     (tactic.harness->skeleton ACL2::world)))
+                   (and skelly
+                        (tactic.update-noexec-tac-wrapper skelly add rem))))))
+
+
+
+(defmacro %betamode (&optional (betamode 'once))
+  ;; %betamode can be used to change the current beta-reduction mode
+  ;;
+  ;; This might be useful if you have a lambda expression with a complex
+  ;; actual, and the corresponding formal occurs several times in the body.
+  ;; You could first rewrite without beta reduction to simplify the actual, and
+  ;; only later enable beta reduction so that the already-simplified actual is
+  ;; substituted into the body.  This may help avoid rewriting the same actual
+  ;; over and over.
+  ;;
+  ;; Usage:
+  ;;   (%betamode 'once)   Enable a single beta-reduction (the default)
+  ;;   (%betamode t)       Enable recursive beta-reduction
+  ;;   (%betamode nil)     Disable beta-reduction
+  ;;
+  (%simple-world-change-fn (list (cons 'betamode betamode))))
+
+(defmacro %forcingp (&optional (forcingp 't))
+  ;; %forcingp can be used to enable or disable forcing by crewrite.
+  ;;
+  ;; Usage:
+  ;;   (%forcingp)      Enable forcing (the default)
+  ;;   (%forcingp nil)  Disable forcing
+  ;;
+  (%simple-world-change-fn (list (cons 'forcingp (if forcingp t nil)))))
+
+(defmacro %blimit (&optional (n '50))
+  ;; %blimit can be used to change the backchain limit for our rewriters.
+  ;;
+  ;; Each time we try to apply a rule with hypotheses, we must show the hyps
+  ;; are true.  We do this by recursively rewriting each hyp.  To ensure this
+  ;; type of recursion terminates, we decrease the blimit each time we enter
+  ;; the rewriter to relieve a hyp, and we are not allowed to recur if the
+  ;; blimit reaches zero.
+  ;;
+  ;; Each hypothesis of a rewrite rule can also specify its own limit.  When
+  ;; this occurs, we use the minimum of the current backchain limit and the
+  ;; hyp's limit.  The intended effect is to allow rules to say, "This hyp
+  ;; might be expensive, so only try to prove it if you can do so cheaply."
+  ;;
+  ;; Usage:
+  ;;   (%blimit)      Revert to the default backchain limit
+  ;;   (%blimit n)    Change the backchain limit to n
+  ;;
+  (%simple-world-change-fn (list (cons 'blimit (nfix n)))))
+
+(defmacro %rlimit (&optional (n '100))
+  ;; %rlimit can be used to change the rewrite limit for our rewriters.
+  ;;
+  ;; Whenever we successfully rewrite a term to term', we immediately try to
+  ;; rewrite term' again.  To prevent an infinite recursion, we only do this
+  ;; if the rlimit has not been reached.
+  ;;
+  ;; Why not just rewrite it in the next pass?  As one example, suppose we are
+  ;; trying to relieve a hypothesis like (subsetp (rev a) a).  We might apply
+  ;; the rule (subsetp (rev x) x) = (subsetp x x) to obtain (subsetp a a), but
+  ;; now unless we also try to rewrite this result we will not notice that it
+  ;; is t.  By rewriting it again, we can relieve the hyp and make more
+  ;; progress.
+  ;;
+  ;; Hitting the rlimit should be very rare, so we print a warning if you
+  ;; manage to do it.
+  ;;
+  ;; Usage:
+  ;;   (%rlimit)      Revert to the default backchain limit
+  ;;   (%rlimit n)    Change the backchain limit to n
+  ;;
+  (%simple-world-change-fn (list (cons 'rlimit (nfix n)))))
+
+
+(defmacro %depth (&optional (n '500))
+  ;; %depth can be used to change the stack depth for evaulation.
+  ;;
+  ;; A message is printed if you hit the depth.
+  ;;
+  ;; Usage:
+  ;;   (%depth)      Revert to the default stack depth
+  ;;   (%depth n)    Change the backchain limit to n
+  ;;
+  (%simple-world-change-fn (list (cons 'depth (nfix n)))))
+
+(defmacro %rwn (&optional (n '20))
+  ;; %rwn can be used to change the number of rewriting passes which will be
+  ;; attempted by crewrite.
+  ;;
+  ;; A warning will be printed if you run out of steps.  If you see such a
+  ;; warning, you can decide if you want to apply additional passes.
+  ;;
+  ;; Usage:
+  ;;   (%rwn)      Revert to the default number of passes
+  ;;   (%rwn n)    Change to number of passes to n
+  ;;
+  (%simple-world-change-fn (list (cons 'rwn (nfix n)))))
+
+(defmacro %urwn (&optional (n '20))
+  ;; %urwn can be used to change the number of rewriting passes which will be
+  ;; attempted by urewrite.
+  ;;
+  ;; A warning will be printed if you run out of steps.  If you see such a
+  ;; warning, you can decide if you want to apply additional passes.
+  ;;
+  ;; Usage:
+  ;;   (%urwn)      Revert to the default number of passes
+  ;;   (%urwn n)    Change to number of passes to n
+  ;;
+  (%simple-world-change-fn (list (cons 'urwn (nfix n)))))
+
+
+(defmacro %assmctrl (&key (primaryp 't)
+                          (secondaryp 't)
+                          (directp 't)
+                          (negativep 't))
+  ;; %assmctrl can be used to configure the kinds of inference the assumptions
+  ;; system makes.  Turning off some of these may make it faster to construct
+  ;; the initial assumptions.  On the other hand, it may result in a weaker
+  ;; assumptions system which may be less useful, or which will require the
+  ;; rewriter to do more on its own.
+  ;;
+  ;; Usage:
+  ;;   (%assmctrl)  -- use the default (all on)
+  ;;   (%assmctrl :primaryp nil :secondaryp nil :directp nil :negativep nil)
+  ;;      -- turn them all off, or pick and choose
+  ;;
+  (%simple-world-change-fn (list (cons 'assm-primaryp   (if primaryp t nil))
+                                 (cons 'assm-secondaryp (if secondaryp t nil))
+                                 (cons 'assm-directp    (if directp t nil))
+                                 (cons 'assm-negativep  (if negativep t nil)))))
+
+
+
+
+
+
+;; The rewriting tactics
+
+(defun %tactic.urewrite-first-tac-wrapper (x theoryname fastp world warnp)
+  (declare (xargs :mode :program))
+  (tactic.urewrite-first-tac x theoryname fastp world warnp))
+
+(defun %tactic.urewrite-all-tac-wrapper (x theoryname fastp world warnp)
+  (declare (xargs :mode :program))
+  (tactic.urewrite-all-tac x theoryname fastp world warnp))
+
+(defmacro %urewrite (theoryname &rest args)
+  ;; Rewrite some goals using only unconditional rules.
+  ;;
+  ;; Usage:
+  ;;   (%urewrite <theoryname>)             Rewrite all of the goals
+  ;;   (%urewrite <theoryname> first)       Rewrite only the first goal
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (world      (tactic.harness->world    ACL2::world))
+                               (fastp      (tactic.harness->ufastp   ACL2::world))
+                               (theoryname ',theoryname)
+                               (warnp      (tactic.harness->warnp    ACL2::world))
+                               (new-skelly (if (memberp 'first ',args)
+                                               (%tactic.urewrite-first-tac-wrapper skelly theoryname fastp world warnp)
+                                             (%tactic.urewrite-all-tac-wrapper skelly theoryname fastp world warnp))))
+                          (or new-skelly skelly))))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))
+    (local (%print))))
+
+
+
+;; I did not find much worth memoizing, though I looked a fair amount.
+;; Anything you add here should also be added to %unmemoize-for-crewrite.
+;;
+;; At various points I tried to memoize these functions with negative
+;; results.  I take away two lessons from this.  One, it's not good to
+;; memoize the following functions.  Two, if other functions seem like they
+;; might be worth memoizing, be sure to run actual tests to make sure there
+;; is an improvement.
+;;
+;;   logic.flag-patmatch :condition '(ACL2::eq flag 'term)
+;;   logic.flag-substitute :condition '(ACL2::eq flag 'term)
+;;   rw.theory-lookup
+;;   rw.rule-syntax-okp
+;;   rw.worse-than-or-equal-termp
+;;   rw.create-sigmas-to-try
+;;   rw.assumptions-trace (even with clearing its table after each rewrite)
+;;
+;; These following give almost no advantage in the tests I've done, but
+;; maybe they'll help in other proofs that make more use of term-<.  And in
+;; any event, they leave this convenient hook for memoizing crewrite.  BOZO
+;; try to do some big proofs without these, later on.
+
+;(ACL2::memoize 'logic.flag-count-function-occurrences :condition '(ACL2::eq flag 'term))
+;(ACL2::memoize 'logic.flag-count-variable-occurrences :condition '(ACL2::eq flag 'term))
+;(ACL2::memoize 'logic.flag-count-constant-sizes :condition '(ACL2::eq flag 'term))
+
+(ACL2::memoize 'logic.count-term-sizes)
+
+(defun %tactic.crewrite-first-tac-wrapper (x theoryname fastp world warnp)
+  (declare (xargs :mode :program))
+  (tactic.crewrite-first-tac x theoryname fastp world warnp))
+
+(defun %tactic.crewrite-all-tac-wrapper (x theoryname fastp world warnp)
+  (declare (xargs :mode :program))
+  (tactic.crewrite-all-tac x theoryname fastp world warnp))
+
+(defmacro %crewrite (theoryname &rest args)
+  ;; Rewrite some goals using conditional and unconditional rules.
+  ;;
+  ;; Usage:
+  ;;   (%crewrite <theoryname>)             Rewrite all of the goals
+  ;;   (%crewrite <theoryname> first)       Rewrite only the first goal
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (world      (tactic.harness->world    ACL2::world))
+                               (theoryname ',theoryname)
+                               (warnp      (tactic.harness->warnp    ACL2::world))
+                               (cfastp     (tactic.harness->cfastp   ACL2::world))
+                               (new-skelly (if (memberp 'first ',args)
+                                               (%tactic.crewrite-first-tac-wrapper skelly theoryname cfastp world warnp)
+                                             (%tactic.crewrite-all-tac-wrapper skelly theoryname cfastp world warnp))))
+                          (or new-skelly skelly))))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))
+    (local (%print))))
+
+
+(defun %tactic.waterfall-tac-wrapper (x strategy maxdepth theoryname cfastp ufastp world warnp)
+  (declare (xargs :mode :program))
+  (tactic.waterfall-tac x strategy maxdepth theoryname cfastp ufastp world warnp))
+
+(defmacro %waterfall (theoryname maxdepth &key (strategy '(urewrite crewrite-once nolift-split split crewrite)))
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (world      (tactic.harness->world    ACL2::world))
+                               (ufastp     (tactic.harness->ufastp   ACL2::world))
+                               (cfastp     (tactic.harness->cfastp   ACL2::world))
+                               (theoryname ',theoryname)
+                               (strategy   ',strategy)
+                               (maxdepth   ',maxdepth)
+                               (warnp      (tactic.harness->warnp    ACL2::world))
+                               (new-skelly (%tactic.waterfall-tac-wrapper skelly strategy maxdepth theoryname
+                                                                          cfastp ufastp world warnp)))
+                          (or new-skelly skelly))))
+    (local (ACL2::value-triple (ACL2::clear-memoize-tables)))
+    (local (%print))))
+
+
+
+
+
+
+(ACL2::defttag rw.crewrite-mods)
+
+;; (ACL2::progn!
+;;  (ACL2::set-raw-mode t)
+;;  (ACL2::defun rw.crewrite-clause-list (x blimit rlimit control n)
+;;               (if (consp x)
+;;                   (let* ((start-time (ACL2::get-internal-run-time))
+;;                          (rewritten  (rw.crewrite-clause (car x) blimit rlimit control n))
+;;                          (end-time   (ACL2::get-internal-run-time)))
+;;                     (ACL2::prog2$
+;;                      (ACL2::format t "; Rewrote clause #~a in ~a seconds. (~a)~%"
+;;                                    (ACL2::length x)
+;;                                    (COMMON-LISP::/
+;;                                     (COMMON-LISP::coerce (ACL2::- end-time start-time) 'COMMON-LISP::float)
+;;                                     ACL2::internal-time-units-per-second)
+;;                                    ;; rewritten is an rw.ccstep-listp
+;;                                    (cond ((rw.ccstep->provedp (first rewritten))
+;;                                           "proved")
+;;                                          ((equal (rw.ccstep->t1prime (first rewritten))
+;;                                                  (first (first rewritten)))
+;;                                           "failed")
+;;                                          (t
+;;                                           "progress")))
+;;                      (cons rewritten
+;;                            (rw.crewrite-clause-list (cdr x) blimit rlimit control n))))
+;;                 nil)))
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+
+
+ ;; Step timing.
+ ;; Regular crewrite step.
+
+ (ACL2::defparameter *assms-acc* 0)
+ (ACL2::defparameter *rw-acc* 0)
+
+ (ACL2::declaim (ACL2::inline rw.crewrite-take-step))
+ (ACL2::defun rw.crewrite-take-step (todo done blimit rlimit control n)
+              (let* ((astart-time (ACL2::get-internal-run-time))
+                     (assms (rw.empty-assms (rw.control->assmctrl control)))
+                     (assms (rw.assume-left-list (cdr todo) assms))
+                     (assms (rw.assume-right-list done assms))
+                     (contr (rw.assms->contradiction assms))
+                     (aend-time (ACL2::get-internal-run-time))
+                     (up        (ACL2::incf *assms-acc* (ACL2::- aend-time astart-time))))
+                (declare (ignore up))
+                (rw.ccstep (car todo)
+                           (rw.assms->hypbox assms)
+                           contr
+                           (if (not contr)
+                               (let* ((start-time (ACL2::get-internal-run-time))
+                                      (val (rw.crewrite assms (car todo) t blimit rlimit control n))
+                                      (end-time (ACL2::get-internal-run-time))
+                                      (up (ACL2::incf *rw-acc* (ACL2::- end-time start-time))))
+                                 (declare (ignore up))
+                                 val)
+                              nil))))
+
+ (ACL2::defun rw.crewrite-clause-aux (todo done blimit rlimit control n acc)
+              (if (consp todo)
+                  (let ((step1 (rw.crewrite-take-step todo done blimit rlimit control n)))
+                    (if (rw.ccstep->provedp step1)
+                        (cons step1 acc)
+                      (rw.crewrite-clause-aux (cdr todo)
+                                              (cons (rw.ccstep->t1prime step1) done)
+                                              blimit rlimit control n
+                                              (cons step1 acc))))
+                acc))
+
+ (ACL2::defun rw.crewrite-clause (clause blimit rlimit control n)
+              (rw.crewrite-clause-aux clause nil blimit rlimit control n nil))
+
+ ;; Fast crewrite steps.
+
+ (ACL2::declaim (ACL2::inline rw.fast-crewrite-take-step))
+ (ACL2::defun rw.fast-crewrite-take-step (todo done blimit rlimit control n)
+              (let* ((astart-time (ACL2::get-internal-run-time))
+                     (assms (rw.empty-fast-assms (rw.control->assmctrl control)))
+                     (assms (rw.fast-assume-left-list (cdr todo) assms))
+                     (assms (rw.fast-assume-right-list done assms))
+                     (contr (rw.fast-assms->contradiction assms))
+                     (aend-time (ACL2::get-internal-run-time))
+                     (up        (ACL2::incf *assms-acc* (ACL2::- aend-time astart-time))))
+                (declare (ignore up))
+                (rw.fast-ccstep contr
+                                (if contr
+                                    nil
+                                  (let* ((start-time (ACL2::get-internal-run-time))
+                                         (val        (rw.fast-crewrite assms (car todo) t blimit
+                                                                       rlimit control n))
+                                         (end-time (ACL2::get-internal-run-time))
+                                         (up (ACL2::incf *rw-acc* (ACL2::- end-time start-time))))
+                                    (declare (ignore up))
+                                    val)))))
+
+ (acl2::defun rw.fast-crewrite-clause-aux (todo done blimit rlimit control n fgacc)
+              (if (consp todo)
+                  (let* ((step1          (rw.fast-crewrite-take-step todo done blimit rlimit control n))
+                         (step1-contr    (rw.fast-ccstep->contradictionp step1))
+                         (step1-provedp  (rw.fast-ccstep->provedp step1))
+                         (step1-ftrace   (rw.fast-ccstep->ftrace step1))
+                         (step1-fgoals   (and (not step1-contr)
+                                              (rw.ftrace->fgoals step1-ftrace))))
+                    (if step1-provedp
+                        (list t nil (fast-app step1-fgoals fgacc))
+                      (rw.fast-crewrite-clause-aux (cdr todo)
+                                                   (cons (rw.fast-ccstep->t1prime step1) done)
+                                                   blimit rlimit control n
+                                                   (fast-app step1-fgoals fgacc))))
+                (list nil done fgacc)))
+
+ (acl2::defun rw.fast-crewrite-clause (clause blimit rlimit control n)
+              (rw.fast-crewrite-clause-aux clause nil blimit rlimit control n nil))
+
+
+
+ (acl2::defun rw.make-crewrite-clause-plan-list (x fastp theoryname world)
+              (if (consp x)
+                  (let* ((reset1     (COMMON-LISP::setf *assms-acc* 0))
+                         (reset2     (COMMON-LISP::setf *rw-acc* 0))
+                         (start-time (ACL2::get-internal-run-time))
+                         (plan1      (rw.make-crewrite-clause-plan (car x) fastp theoryname world))
+                         (end-time   (ACL2::get-internal-run-time))
+                         (elapsed    (ACL2::- end-time start-time)))
+                    (declare (ignore reset1 reset2))
+                    (ACL2::prog2$
+                     (let* ((total    (common-lisp::coerce (ACL2::+ *assms-acc* *rw-acc*) 'COMMON-LISP::float))
+                            (total    (if (common-lisp::= total 0) 1 total))
+                            (assmspct (common-lisp::* (common-lisp::/ *assms-acc* total) 100))
+                            (rwpct    (common-lisp::* (common-lisp::/ *rw-acc* total) 100))
+                            (wall     (COMMON-LISP::/
+                                       (COMMON-LISP::coerce elapsed 'COMMON-LISP::float)
+                                       ACL2::internal-time-units-per-second)))
+                       (ACL2::format t
+                                     "; Rewrote clause #~a in ~a seconds (~a), ~4,2f% assm ~4,2f% rw~%"
+                                     (ACL2::length x)
+                                     wall
+                                     (cond ((rw.crewrite-clause-plan->provedp plan1)
+                                            "proved")
+                                           ((rw.crewrite-clause-plan->progressp plan1)
+                                            "progress")
+                                           (t
+                                            "failed"))
+                                     assmspct
+                                     rwpct))
+                     (cons plan1
+                           (rw.make-crewrite-clause-plan-list (cdr x) fastp theoryname world))))
+                nil)))
+
+
+
+(defund rw.stop-loop-debugging ()
+  (declare (xargs :guard t))
+  (ACL2::cw "rw.stop-loop-debugging has not yet been redefined.~%"))
+
+(defun rw.disable-loop-debugging ()
+  (declare (xargs :guard t))
+  ;; This may be useful if you want to do tricks with rlimit.
+  (ACL2::cw "rw.disable-loop-debugging not yet redefined!~%"))
+
+(defun rw.enable-loop-debugging ()
+  (declare (xargs :guard t))
+  ;; This may be useful if you want to do tricks with rlimit.
+  (ACL2::cw "rw.enable-loop-debugging not yet redefined!~%"))
+
+(defmacro %disable-loop-debugging ()
+  `(ACL2::value-triple (rw.disable-loop-debugging)))
+
+(defmacro %enable-loop-debugging ()
+  `(ACL2::value-triple (rw.enable-loop-debugging)))
+
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+
+ (ACL2::defparameter *rw.loop-debugging-enabled* t)
+ (ACL2::defparameter *rw.rlimit-was-reached* nil)
+
+ (ACL2::defun rw.disable-loop-debugging ()
+              (ACL2::setf *rw.loop-debugging-enabled* nil)
+              (ACL2::setf *rw.rlimit-was-reached* nil)
+              (ACL2::cw "Disabling loop debugging altogether.~%"))
+
+ (ACL2::defun rw.enable-loop-debugging ()
+              (ACL2::setf *rw.loop-debugging-enabled* t)
+              (ACL2::cw "Enabling loop debugging.~%"))
+
+ (ACL2::defun rw.stop-loop-debugging ()
+              (ACL2::setf *rw.rlimit-was-reached* nil)
+              (ACL2::cw "Stopping loop debugging.~%"))
+
+ ;; When we reach the rlimit we set the flag, and print a message to the user.
+ (ACL2::defun rw.rlimit-warn ()
+              (if *rw.loop-debugging-enabled*
+                  (ACL2::progn
+                    (ACL2::cw "WARNING: rlimit exhausted -- the rewriter may be looping!~%")
+                    (ACL2::cw "Be sure to run (rw.stop-loop-debugging) if you interrupt!~%")
+                    (ACL2::setf *rw.rlimit-was-reached* t)
+                    nil)
+                nil))
+
+ ;; If the rlimit has been reached, we print a quick summary of each rule we use.
+ (ACL2::defun rw.crewrite-rule-trace (hypbox lhs rule sigma iffp traces)
+              (ACL2::progn
+               (or (not *rw.rlimit-was-reached*)
+                   (ACL2::cw "~x0: ~x1~%"
+                             (rw.rule->name rule)
+                             (logic.substitute (rw.rule->rhs rule) sigma)))
+               ;; Keep in sync with rw.crewrite-rule-trace
+               (rw.trace 'crewrite-rule hypbox lhs
+                         (logic.substitute (rw.rule->rhs rule) sigma)
+                         iffp traces (list rule sigma))))
+
+ ;; We stop printing when we get back to an rlimit of five.
+ (ACL2::defun rw.rlimit-exit (rlimit trace)
+              (declare (ignore trace))
+              (if (and *rw.rlimit-was-reached* (ACL2::= rlimit 5))
+                  (rw.stop-loop-debugging)
+                nil)))
+
+
+
+
+
+#||
+
+;; Testing out the loop debugger (after loading utilities):
+
+(defsection app-of-app-alt
+  (%prove (%rule app-of-app-alt
+                 :lhs (app x (app y z))
+                 :rhs (app (app x y) z)))
+  (%auto)
+  (%qed)
+  (%enable default app-of-app-alt))
+
+(%prove (%rule demo
+               :lhs (app a (app b (app c d)))
+               :rhs (app a (app (app b c) d))))
+(%crewrite default)
+
+||#
+
+
+
+;; We have sometimes wanted to investigate the performance benefits of using
+;; caching.  It is tricky to properly redefine the caching functions (we found
+;; that just using :redef didn't always seem to work), so we provide these
+;; events for enabling and disabling the cache.
+
+(defun rw.disable-caching-fn ()
+  (declare (xargs :guard t))
+  (ACL2::cw "Error: rw.disable-caching-fn has not been redefined ``under the hood.''~%"))
+
+(defun rw.enable-caching-fn ()
+  (declare (xargs :guard t))
+  (ACL2::cw "Error: rw.enable-caching-fn has not been redefined ``under the hood.''~%"))
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+ (ACL2::defun rw.disable-caching-fn ()
+              (ACL2::cw "Note: disabling the cache.  This cannot be undone with :u -- ~
+                         use (rw.enable-caching) instead.~%")
+              (ACL2::cw "Note: ACL2 proofs about rw.cache-update and rw.cache-lookup ~
+                         can no longer be trusted!~%")
+              (ACL2::eval '(ACL2::defun rw.cache-update (term trace cache)
+                                        (declare (ignore term trace))
+                                        cache))
+              (ACL2::eval '(ACL2::defun rw.cache-lookup (term iffp cache)
+                                        (declare (ignore term iffp cache))
+                                        nil))
+              nil)
+ (ACL2::defun rw.enable-caching-fn ()
+              (ACL2::cw "Note: restoring the original definitions of rw.cache-update ~
+                         and rw.cache-lookup.~%")
+              (ACL2::eval '(ACL2::defun rw.cache-update (term trace cache)
+                                        (let ((blockp (rw.cache->blockp cache))
+                                              (data   (rw.cache->data cache)))
+                                          (if (and blockp
+                                                   (not (logic.constantp (rw.trace->rhs trace))))
+                                              cache
+                                            (let* ((entry          (hons-lookup term data))
+                                                   (new-cache-line (if (rw.trace->iffp trace)
+                                                                       (rw.cacheline (and entry (rw.cacheline->eqltrace (cdr entry))) trace)
+                                                                     (rw.cacheline trace (and entry (rw.cacheline->ifftrace (cdr entry))))))
+                                                   (new-data       (hons-update term new-cache-line data)))
+                                              (rw.cache blockp new-data))))))
+              (ACL2::eval '(ACL2::defun rw.cache-lookup (term iffp cache)
+                                        (let ((entry (hons-lookup term (rw.cache->data cache))))
+                                          (and entry
+                                               (if iffp
+                                                   (rw.cacheline->ifftrace (cdr entry))
+                                                 (rw.cacheline->eqltrace (cdr entry)))))))
+              nil))
+
+(defmacro rw.disable-caching ()
+  `(ACL2::value-triple (rw.disable-caching-fn)))
+
+(defmacro rw.enable-caching ()
+  `(ACL2::value-triple (rw.enable-caching-fn)))
+
+
+
+; provide waterfall timing info
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+
+ (ACL2::defun rw.waterfall-list-wrapper (x theoryname cfastp ufastp world steps strategy n)
+              (if (consp x)
+                  (let* ((start-time (ACL2::get-internal-run-time))
+                         (result     (rw.waterfall (car x) theoryname cfastp ufastp world steps strategy n))
+                         (end-time   (ACL2::get-internal-run-time))
+                         (elapsed    (ACL2::- end-time start-time))
+                         (wall       (COMMON-LISP::/
+                                      (COMMON-LISP::coerce elapsed 'COMMON-LISP::float)
+                                      ACL2::internal-time-units-per-second)))
+                    (ACL2::prog2$
+                     (ACL2::format t
+                                   ";; Waterfall: clause #~a took ~a seconds, producing ~a subgoals~%"
+                                   (ACL2::length x)
+                                   wall
+                                   (ACL2::length (rw.waterfall-subgoals result)))
+                     (cons result
+                           (rw.waterfall-list-wrapper (cdr x) theoryname cfastp ufastp world steps strategy n))))
+                nil)))
+
+
+; urewrite timing
+
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+
+ (ACL2::defun rw.world-urewrite-list-list (X THEORYNAME WORLD)
+              (if (consp x)
+                  (let* ((start-time (ACL2::get-internal-run-time))
+                         (result     (rw.world-urewrite-list (car x) theoryname world))
+                         (end-time   (ACL2::get-internal-run-time))
+                         (elapsed    (ACL2::- end-time start-time))
+                         (wall       (COMMON-LISP::/
+                                      (COMMON-LISP::coerce elapsed 'COMMON-LISP::float)
+                                      ACL2::internal-time-units-per-second)))
+                    (ACL2::prog2$
+                     (ACL2::format t
+                                   ";; Urewrite #~a: ~a seconds.~%"
+                                   (ACL2::length x)
+                                   wall)
+                     (cons result
+                           (rw.world-urewrite-list-list (cdr x) theoryname world))))
+                nil))
+
+ (ACL2::DEFUN RW.FAST-WORLD-UREWRITE-LIST-LIST (X THEORYNAME WORLD)
+              (IF (CONSP X)
+                  (let* ((start-time (ACL2::get-internal-run-time))
+                         (result     (rw.fast-world-urewrite-list (car x) theoryname world))
+                         (end-time   (ACL2::get-internal-run-time))
+                         (elapsed    (ACL2::- end-time start-time))
+                         (wall       (COMMON-LISP::/
+                                      (COMMON-LISP::coerce elapsed 'COMMON-LISP::float)
+                                      ACL2::internal-time-units-per-second)))
+                    (ACL2::prog2$
+                     (ACL2::format t
+                                   ";; Fast urewrite #~a: ~a seconds.~%"
+                                   (ACL2::length x)
+                                   wall)
+                     (cons result
+                           (rw.fast-world-urewrite-list-list (cdr x) theoryname world))))
+                  nil)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/rule.lisp acl2-6.3/books/milawa/ACL2/interface/rule.lisp
--- acl2-6.2/books/milawa/ACL2/interface/rule.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/rule.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,116 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Rule structure creation
+;;
+;; We provide some macros for generating rewrite rule structures.
+
+(defmacro %hyp (term &key force limit)
+  `(%hyp-fn ',term ,force ,limit))
+
+(defun %hyp-fn (term force limit)
+  (declare (xargs :mode :program))
+  (let ((term-trans (logic.translate term)))
+    (cond ((not term-trans)
+           (ACL2::er hard '%hyp "The proposed hyp, ~x0, is not translatable.~%" term))
+          ((not (rw.force-modep force))
+           (ACL2::er hard '%hyp "The proposed force mode, ~x0, is invalid.~%" force))
+          (t
+           (rw.hyp term-trans
+                   force
+                   (if limit t nil)
+                   (nfix limit))))))
+
+(defun %hyps-fn-aux (terms force limit)
+  (declare (xargs :mode :program))
+  (if (consp terms)
+      (cons `(%hyps ,(car terms) :force ,force :limit ,limit)
+            (%hyps-fn-aux (cdr terms) force limit))
+    nil))
+
+(defun %hyps-fn (flag hyp force limit)
+  (declare (xargs :mode :program))
+  (if (equal flag 'term)
+      (if (and (consp hyp)
+               (equal (car hyp) 'and))
+          (%hyps-fn 'list (cdr hyp) force limit)
+        (list `(%hyp ,hyp :force ,force :limit ,limit)))
+    (if (consp hyp)
+        (fast-app (%hyps-fn 'term (car hyp) force limit)
+                  (%hyps-fn 'list (cdr hyp) force limit))
+      nil)))
+
+(defmacro %hyps (hyp &key force limit)
+  (cons 'list (%hyps-fn 'term hyp force limit)))
+
+(defmacro %rule (name &key (type 'inside) hyps lhs rhs (equiv 'equal) syntax)
+  `(%rule-fn ',name ',type ,hyps ',lhs ',rhs ',equiv ',syntax))
+
+(defun %rule-fn (name type hyps lhs rhs equiv syntax)
+  (declare (xargs :mode :program))
+  (let ((lhs-trans (logic.translate lhs))
+        (rhs-trans (logic.translate rhs))
+        (syntax-trans (logic.translate-list syntax)))
+    (cond ((not (symbolp name))
+           (ACL2::er hard '%rule "The proposed name, ~x0, is not a symbol.~%" name))
+          ((not (memberp type '(inside outside manual)))
+           (ACL2::er hard '%rule "The proposed type, ~x0, is not supported.~%" type))
+          ((not lhs-trans)
+           (ACL2::er hard '%rule "The proposed lhs, ~x0, is not translatable.~%" lhs))
+          ((not rhs-trans)
+           (ACL2::er hard '%rule "The proposed rhs, ~x0, is not translatable.~%" rhs))
+          ((not (car syntax-trans))
+           (ACL2::er hard '%rule "The proposed syntax, ~x0, is not translatable.~%" syntax))
+          ((not (logic.all-functionsp (cdr syntax-trans)))
+           (ACL2::er hard '%rule "The proposed syntax, ~x0, is not a list of function calls.~%" syntax))
+          ((not (memberp equiv '(iff equal)))
+           (ACL2::er hard '%rule "The proposed equiv, ~x0, is not equal or iff.~%" equiv))
+          (t
+           (rw.rule name
+                    type
+                    (rw.limit-hyps lhs-trans hyps)
+                    equiv
+                    lhs-trans
+                    rhs-trans
+                    (cdr syntax-trans)
+                    (rw.critical-hyps lhs-trans hyps))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/interface/simple-tactics.lisp acl2-6.3/books/milawa/ACL2/interface/simple-tactics.lisp
--- acl2-6.2/books/milawa/ACL2/interface/simple-tactics.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/simple-tactics.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,474 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "core")
+
+
+;; Simple tactics
+;;
+;; We now introduce some of the simple tactics which don't make use of any
+;; theories.  All of our tactics make only local changes to the skeleton.  This
+;; way, they are skipped when the already-certified books are being included.
+
+(defun %tactic.skip-all-tac-wrapper (skelly)
+  (declare (xargs :mode :program))
+  (tactic.skip-all-tac skelly))
+
+(defun %tactic.skip-first-tac-wrapper (skelly)
+  (declare (xargs :mode :program))
+  (tactic.skip-first-tac skelly))
+
+(defmacro %skip (&rest args)
+  ;; Pretend that you have proven some goals.
+  ;;
+  ;; Usage:
+  ;;   (%skip)            Skip the current goal.
+  ;;   (%skip all)        Skip all of the goals.
+  ;;
+  ;; Note: This is not a sound tactic to apply.  It relies upon the special and
+  ;; "skipping" mechanism only available in the ACL2 version of proofp, which is
+  ;; not available in the core Milawa proof checker.
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (new-skelly (if ',(memberp 'all args)
+                                               (%tactic.skip-all-tac-wrapper skelly)
+                                             (%tactic.skip-first-tac-wrapper skelly))))
+                          (or new-skelly skelly))))
+    (local (%print))))
+
+
+
+(defun %tactic.cleanup-tac-wrapper (skelly warnp)
+  (declare (xargs :mode :program))
+  (tactic.cleanup-tac skelly warnp))
+
+(defmacro %cleanup ()
+  ;; Apply basic cleaning to all the goals.  We try to:
+  ;;
+  ;;   - Eliminate double negation from the tops of literals,
+  ;;   - Standardize all not-variants to (not x),
+  ;;   - Eliminate any clauses with "obvious" literals,
+  ;;   - Eliminate any clauses with complementary literals,
+  ;;   - Remove any "absurd" literals from each clause,
+  ;;   - Remove any duplicate literals within each clause, and
+  ;;   - Eliminate any "subsumed" clauses from the list.
+  ;;
+  ;; There are no configurable options.
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (warnp      (tactic.harness->warnp ACL2::world))
+                               (new-skelly (%tactic.cleanup-tac-wrapper skelly warnp)))
+                          (or new-skelly skelly))))
+    (local (%print))))
+
+
+
+(defun tactic.simple-world-change-wrapper (changes world)
+  (declare (xargs :mode :program))
+  (tactic.simple-world-change changes world))
+
+(defun tactic.simple-change-world-tac-wrapper (skelly changes)
+  (declare (xargs :mode :program))
+  (tactic.simple-change-world-tac skelly changes))
+
+(defun %simple-world-change-fn (changes)
+  (declare (xargs :mode :program))
+  `(ACL2::progn
+    (ACL2::table tactic-harness 'world
+                 (tactic.simple-world-change-wrapper ',changes
+                                                     (tactic.harness->world acl2::world)))
+    (ACL2::table tactic-harness 'skeleton
+                 (let ((skelly (tactic.harness->skeleton ACL2::world)))
+                   (and skelly
+                        (tactic.simple-change-world-tac-wrapper skelly ',changes))))))
+
+(defmacro %liftlimit (&optional (limit '0))
+  ;; Change the lift limit (used by %split).  Setting a low liftlimit may
+  ;; help reduce case splitting by preventing "if" expressions from being
+  ;; lifted out of other terms.  Normally, terms like (foo (if x y z)) are
+  ;; first "lifted" to (if x (foo y) (foo z)), and then case-split on x.  A
+  ;; liftlimit prevents this from happening after a certain depth.
+  ;;
+  ;; Usage:
+  ;;   (%liftlimit)          Change the liftlimit to unlimited.
+  ;;   (%liftlimit 10)       Change the liftlimit to 10.
+  ;;
+  ;; I have found that (%liftlimit 1) produces the smallest proofs during the
+  ;; early stages of bootstrapping.  However, after the split tactic is
+  ;; verified in Level 7, a higher limit is better.
+  (%simple-world-change-fn (list (cons 'liftlimit limit))))
+
+(defmacro %splitlimit (&optional (limit '0))
+  ;; Change the split limit (used by %split).  Setting a low splitlimit may
+  ;; help control case-splitting by not looking for "if" expressions in the
+  ;; later parts of the clause.
+  ;;
+  ;; Usage:
+  ;;   (%splitlimit)         Change the splitlimit to unlimitd.
+  ;;   (%splitlimit 10)      Change the splitlimit to 10.
+  (%simple-world-change-fn (list (cons 'splitlimit limit))))
+
+(defun %tactic.split-first-tac-wrapper (liftp liftlimit splitlimit skelly)
+  (declare (xargs :mode :program))
+  (tactic.split-first-tac liftp liftlimit splitlimit skelly))
+
+(defun %tactic.split-all-tac-wrapper (liftp liftlimit splitlimit skelly warnp)
+  (declare (xargs :mode :program))
+  (tactic.split-all-tac liftp liftlimit splitlimit skelly warnp))
+
+(defmacro %split (&key (what 'all) liftlimit splitlimit (liftp 't))
+  ;; Case-split goals which have terms of the form (if a b c).
+  ;;
+  ;; WHAT controls what gets split.  The default, :what all, means all the
+  ;; clauses should be split.  Alternately, :what first can be used to limit
+  ;; splitting to the first clause.
+  ;;
+  ;; LIFTP controls whether or not the clauses will be if-lifted.  Lifting is
+  ;; permitted by default and is generally desirable, and typically produces
+  ;; larger numbers of simpler clauses.  However, sometimes it can be too
+  ;; expensive, so you can turn it off with :liftp nil, or limit it using the
+  ;; :limit keyword (described below).
+  ;;
+  ;; The LIFTLIMIT and SPLITLIMITED are inherited from %liftlimit and
+  ;; %splitlimit by default, but can be overridden using your own keys.
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (warnp      (tactic.harness->warnp ACL2::world))
+                               (world      (tactic.harness->world ACL2::world))
+                               (liftlimit  (if ,liftlimit
+                                               ,liftlimit
+                                             (tactic.world->liftlimit world)))
+                               (splitlimit (if ,splitlimit
+                                               ,splitlimit
+                                             (tactic.world->splitlimit world)))
+                               (new-skelly (if ,(equal what 'first)
+                                               (%tactic.split-first-tac-wrapper ,liftp liftlimit splitlimit skelly)
+                                             (%tactic.split-all-tac-wrapper ,liftp liftlimit splitlimit skelly warnp))))
+                          (or new-skelly skelly))))
+    (local (%print))))
+
+
+
+(defun %tactic.generalize-first-tac-wrapper (skelly expr var)
+  (declare (xargs :mode :program :guard (and (logic.termp expr) (logic.variablep var))))
+  (tactic.generalize-first-tac skelly expr var))
+
+(defun %tactic.generalize-all-tac-wrapper (skelly expr var)
+  (declare (xargs :mode :program :guard (and (logic.termp expr) (logic.variablep var))))
+  (tactic.generalize-all-tac skelly expr var))
+
+(defmacro %generalize (&rest args)
+  ;; Replace any occurrences of some expression with a new variable.
+  ;;
+  ;; Usage:
+  ;;   (%generalize expr var)         Try to generalize every goal.
+  ;;   (%generalize first expr var)   Only try to generalize the first goal.
+  ;;
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((firstp     (memberp 'first ',args))
+                               (others     (remove-all 'first ',args))
+                               (skelly     (tactic.harness->skeleton ACL2::world))
+                               (expr       (first others))
+                               (var        (second others))
+                               (new-skelly (if firstp
+                                               (%tactic.generalize-first-tac-wrapper skelly expr var)
+                                             (%tactic.generalize-all-tac-wrapper skelly expr var))))
+                          (or new-skelly skelly))))
+    (local (%print))))
+
+
+
+
+(defun %tactic.conditional-eqsubst-tac-wrapper (skelly hyp old new)
+  (declare (xargs :mode :program
+                  :guard (and (logic.termp hyp)
+                              (logic.termp old)
+                              (logic.termp new))))
+  (tactic.conditional-eqsubst-tac skelly hyp old new))
+
+(defun %tactic.conditional-eqsubst-all-tac-wrapper (skelly hyp old new warnp)
+  (declare (xargs :mode :program
+                  :guard (and (logic.termp hyp)
+                              (logic.termp old)
+                              (logic.termp new))))
+  (tactic.conditional-eqsubst-all-tac skelly hyp old new warnp))
+
+(defmacro %eqsubst (hyp old new &rest args)
+  ;; Use a conditional equality to simplify the goals.
+  ;;
+  ;; Suppose the first goal has the form (implies (and h1 ... hN) concl).
+  ;; Then, we create three new subgoals:
+  ;;
+  ;;   (1) (implies hyp (equal old new))    "subst correctness"
+  ;;
+  ;;   (2) (implies (and (not hyp)          "subst applicability"
+  ;;                     h1 ... hn)
+  ;;                concl)
+  ;;
+  ;;   (3) (implies (and h1/[old<-new]      "post substitution"
+  ;;                     ...
+  ;;                     hn/[old<-new])
+  ;;                concl/[old<-new])
+  ;;
+  ;; Usage:
+  ;;   (%eqsubst hyp old new)        Perform the substitution on every goal.
+  ;;   (%eqsubst hyp old new first)  Perform the substition on only the first goal.
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (new-skelly ,(if (memberp 'first args)
+                                                `(%tactic.conditional-eqsubst-tac-wrapper skelly ',hyp ',old ',new)
+                                              `(%tactic.conditional-eqsubst-all-tac-wrapper skelly ',hyp ',old ',new
+                                                                                            (tactic.harness->warnp ACL2::world)))))
+                          (or new-skelly skelly))))
+    (local (%print))))
+
+
+
+(defun %tactic.elim-first-tac-wrapper (x names)
+  (declare (xargs :mode :program))
+  (tactic.elim-first-tac x names))
+
+(defun %tactic.elim-all-tac-wrapper (x names warnp)
+  (declare (xargs :mode :program))
+  (tactic.elim-all-tac x names warnp))
+
+(defun tactic.harness->create-names (root n acc)
+  (declare (xargs :mode :program))
+  (if (zp n)
+      acc
+    (tactic.harness->create-names root
+                                  (- n 1)
+                                  (cons (ACL2::intern-in-package-of-symbol
+                                         (STR::ncat root n)
+                                         'foo)
+                                        acc))))
+
+(defconst *tactic.harness-unpreferred-names*
+  (tactic.harness->create-names "ELIM" 100 nil))
+
+(defun tactic.harness->infer-preferred-names (vars acc)
+  (declare (xargs :mode :program))
+  (if (consp vars)
+      (tactic.harness->infer-preferred-names
+       (cdr vars)
+       (cons (cons (car vars) (tactic.harness->create-names (ACL2::symbol-name (car vars)) 2 nil))
+             acc))
+    acc))
+
+(defun tactic.harness->create-elim-names (goals)
+  (declare (xargs :mode :program))
+  (let ((all-clause-vars (remove-duplicates (logic.fast-term-list-list-vars goals nil))))
+    (tactic.harness->infer-preferred-names all-clause-vars
+                                           (list (cons 'unpreferred *tactic.harness-unpreferred-names*)))))
+
+(defun %tactic.harness->create-elim-names-wrapper (goals)
+  (declare (xargs :mode :program))
+  (tactic.harness->create-elim-names goals))
+
+(defmacro %car-cdr-elim (&rest args)
+  ;; Perform car/cdr elimination.
+  ;;
+  ;; Usage:
+  ;;  (%car-cdr-elim)             Auto-eliminate in every goal.
+  ;;  (%car-cdr-elim first)       Auto-eliminate in the first goal.
+  ;;  (%car-cdr-elim x)           Manual-eliminate x in every goal.
+  ;;  (%car-cdr-elim x first)     Manual-eliminate x in the first goal.
+  (let* ((firstp     (memberp 'first args))
+         (args-prime (remove-all 'first args)))
+    (if (consp args-prime)
+        ;; Manual elimination.
+        (let ((var (first args-prime)))
+          (if firstp
+              `(%eqsubst (consp ,var) ,var (cons (car ,var) (cdr ,var)) first)
+            `(%eqsubst (consp ,var) ,var (cons (car ,var) (cdr ,var)))))
+      ;; Automatic elimination.
+      `(ACL2::progn
+        (local (ACL2::table tactic-harness 'skeleton
+                            (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                                   (warnp      (tactic.harness->warnp ACL2::world))
+                                   (names      (%tactic.harness->create-elim-names-wrapper (tactic.skeleton->goals skelly)))
+                                   (new-skelly (if ,firstp
+                                                   (%tactic.elim-first-tac-wrapper skelly names)
+                                                 (%tactic.elim-all-tac-wrapper skelly names warnp))))
+                              (or new-skelly skelly))))
+        (local (%print))))))
+
+(defun %tactic.distribute-all-tac-wrapper (skelly warnp)
+  (declare (xargs :mode :program))
+  (tactic.distribute-all-tac skelly warnp))
+
+(defmacro %distribute ()
+  ;; Distribute trivial equivalences throughout the clauses.  Eventually we should add a
+  ;; single-clause version of this, but for now we only do all clauses.
+  ;;
+  ;; Usage:
+  ;;  (%distribute)
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (warnp      (tactic.harness->warnp ACL2::world))
+                               (new-skelly (%tactic.distribute-all-tac-wrapper skelly warnp)))
+                          (or new-skelly skelly))))
+    (local (%print))))
+
+
+
+(defun %tactic.fertilize-tac-wrapper (skelly target replacement)
+  (declare (xargs :mode :program
+                  :guard (and (logic.termp target)
+                              (logic.termp replacement))))
+  (tactic.fertilize-tac skelly target replacement))
+
+(defmacro %fertilize (target replacement)
+  ;; Replace all instances of one term with an equal term.
+  ;;
+  ;; Usage:
+  ;;  (%fertilize target replacement)     Replace target with replacement in the first goal
+  ;;
+  ;; Note:
+  ;;   (equal target replacement) must be among the current hyps for this to be a valid
+  ;;   transformation.  Equivalently, (not (equal target replacement)) can be the conclusion.
+  ;;
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (new-skelly (%tactic.fertilize-tac-wrapper skelly ',target ',replacement)))
+                          (or new-skelly skelly))))
+    (local (%print))))
+
+
+
+(defun %tactic.use-tac-wrapper (skelly proof)
+  (declare (xargs :mode :program
+                  :guard (logic.appealp proof)))
+  (tactic.use-tac skelly proof))
+
+(defmacro %use (proof)
+  ;; Add a fact into the first goal.
+  ;;
+  ;; Proof is an arbitrary proof of any formula.  We compile the formula and
+  ;; add its negation into the clause.  This is a useful way to bring some
+  ;; relevant but perhaps disabled fact to the attention of the rewriter, etc.
+  ;;
+  ;; The argument to %use is evaluated and should result in a proof.  By far
+  ;; the most common way to generate such proofs is with the %instance and
+  ;; %thm macros below.  For example:
+  ;;
+  ;;  (%use (%instance (%thm {name-of-theorem})
+  ;;                   ({var} {replacement})
+  ;;                   ...
+  ;;                   ({var} {replacement})))
+  ;;
+  ;; But advanced users can use explicit proof builders here, e.g.,
+  ;;
+  ;;  (%use (build.cut ...))
+  ;;
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (new-skelly (%tactic.use-tac-wrapper skelly ,proof)))
+                          (or new-skelly skelly))))
+    (local (%print))))
+
+(defmacro %thm (name)
+  `(build.theorem
+    (clause.clause-formula
+     (rw.rule-clause (tactic.find-rule ',name (tactic.harness->world ACL2::world))))))
+
+(defun %instance-fn (thm untranslated-sigma)
+  (declare (xargs :mode :program))
+  (let ((translated-sigma+ (logic.translate-sigma untranslated-sigma)))
+    (and translated-sigma+
+         `(build.instantiation ,thm ',(cdr translated-sigma+)))))
+
+(defmacro %instance (thm &rest pairs)
+  (%instance-fn thm pairs))
+
+
+
+
+
+(defun tactic.induct-casep (x)
+  (declare (xargs :mode :program))
+  (and (tuplep 2 x)
+       (logic.translate (first x))
+       (logic.translate-sigma-list (second x))))
+
+(defun tactic.induct-case-listp (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (and (tactic.induct-casep (car x))
+           (tactic.induct-case-listp (cdr x)))
+    t))
+
+(defun %tactic.induct-tac-wrapper (skelly m qs all-sigmas)
+  (declare (xargs :mode :program
+                  :guard (and (logic.termp m)
+                              (logic.term-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (same-lengthp qs all-sigmas))))
+  (tactic.induct-tac skelly m qs all-sigmas))
+
+(defmacro %induct (m &rest cases)
+  ;; Low level manual induction.
+  ;;
+  ;; You have to give a measure and then a list of cases of the form
+  ;; (<tests governing this case> <list of sigmas that form the inductive hypotheses>)
+  ;;
+  ;;   (%induct (rank x)
+  ;;      ((not (consp x))
+  ;;       nil)                           ;; no inductions for the base case
+  ;;      ((consp x)
+  ;;       (((x (cdr x)) (y (cdr x)))     ;; IH1:  P( cdr(x), cdr(y) )
+  ;;        ((x (cdr x)) (y (car x))))    ;; IH2:  P( cdr(x), car(y) )
+  `(ACL2::progn
+    (local (ACL2::table tactic-harness 'skeleton
+                        (let* ((skelly     (tactic.harness->skeleton ACL2::world))
+                               (cases      (if (tactic.induct-case-listp ',cases)
+                                               ',cases
+                                             (ACL2::er hard '%induct "The proposed cases are invalid.~%")))
+                               (m          (if (logic.termp ',m)
+                                               ',m
+                                             (ACL2::er hard '%induct "The proposed measure is invalid.~%")))
+                               (qs         (cdr (logic.translate-list (strip-firsts cases))))
+                               (sigmas     (cdr (logic.translate-sigma-list-list (strip-seconds cases))))
+                               (new-skelly (%tactic.induct-tac-wrapper skelly m qs sigmas)))
+                          (or new-skelly skelly))))
+    (local (%print))))
diff -Nru acl2-6.2/books/milawa/ACL2/interface/top.lisp acl2-6.3/books/milawa/ACL2/interface/top.lisp
--- acl2-6.2/books/milawa/ACL2/interface/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/top.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,50 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(include-book "acl2-connection")
+(include-book "auto-tactic")
+(include-book "core")
+(include-book "debug-split")
+(include-book "debug-rewrite-cost")
+(include-book "describe-theory")
+(include-book "evaluator")
+(include-book "hons-proofs")
+(include-book "pcert")
+(include-book "profile")
+(include-book "rewrite-tactics")
+(include-book "rule")
+(include-book "simple-tactics")
+(include-book "trace-crewrite")
diff -Nru acl2-6.2/books/milawa/ACL2/interface/trace-crewrite-raw.lsp acl2-6.3/books/milawa/ACL2/interface/trace-crewrite-raw.lsp
--- acl2-6.2/books/milawa/ACL2/interface/trace-crewrite-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/trace-crewrite-raw.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,163 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(ACL2::set-current-package "MILAWA" ACL2::*the-live-state*)
+
+(ACL2::defun ACL2::to-flat-string (x)
+  (let ((ACL2::*print-circle* nil)
+        (ACL2::*print-escape* t)
+        #+DRAFT-ANSI-CL-2 (ACL2::*print-lines* nil)
+        #+DRAFT-ANSI-CL-2 (ACL2::*print-miser-width* nil)
+        #+DRAFT-ANSI-CL-2 (ACL2::*print-pprint-dispatch* nil)
+        #+DRAFT-ANSI-CL-2 (ACL2::*print-readably* t)
+        #+DRAFT-ANSI-CL-2 (ACL2::*print-right-margin* nil)
+        (ACL2::*readtable* ACL2::*acl2-readtable*)
+        (ACL2::*print-case* :upcase)
+        (ACL2::*print-pretty* nil)
+        (ACL2::*print-level* nil)
+        (ACL2::*print-length* nil))
+    (ACL2::prin1-to-string x)))
+
+(ACL2::defparameter MILAWA::*rw.crewrite-depth* 0)
+
+(ACL2::defun %untrace-crewrite ()
+  (ACL2::progn
+   (CCL:unadvise tactic.crewrite-first-tac)
+   (CCL:unadvise tactic.crewrite-all-tac)
+   (CCL:unadvise rw.crewrite-entry)
+   (CCL:unadvise rw.crewrite-note-fn)
+   nil))
+
+(ACL2::defun %trace-crewrite ()
+  (ACL2::progn
+   (CCL:advise tactic.crewrite-first-tac
+               (ACL2::setf *rw.crewrite-depth* 0)
+               :when :before)
+   (CCL:advise tactic.crewrite-all-tac
+               (ACL2::setf *rw.crewrite-depth* 0)
+               :when :before)
+   (CCL:advise rw.crewrite-entry
+               (let* ((arglist  CCL::arglist)
+                      (flag     (nth 0 arglist))
+                      (assms    (nth 1 arglist))
+                      (x        (nth 2 arglist))
+                      (rule[s]  (nth 3 arglist))
+                      (sigma[s] (nth 4 arglist))
+                      (hypcache (nth 5 arglist))
+                      (iffp     (nth 6 arglist))
+                      (blimit   (nth 7 arglist))
+                      (rlimit   (nth 8 arglist))
+                      (anstack  (nth 9 arglist))
+                      (control  (nth 10 arglist)))
+                 (declare (ACL2::ignorable flag assms x rule[s] sigma[s] hypcache iffp blimit rlimit anstack control))
+                 (cond ((equal flag 'term)
+                        (ACL2::prog2$
+                         (ACL2::setf *rw.crewrite-depth* (+ *rw.crewrite-depth* 1))
+                         (ACL2::fmt1! "~s0~x1> ~x2 ~s3~%~
+                                   ~s0~x1> Assms ~s4~%"
+                                      (list (cons #\0 (ACL2::coerce (repeat #\Space *rw.crewrite-depth*) 'ACL2::string))
+                                            (cons #\1 *rw.crewrite-depth*)
+                                            (cons #\2 (if iffp 'RW_IFF 'RW_EQL))
+                                            (cons #\3 (ACL2::to-flat-string x))
+                                            (cons #\4 (ACL2::to-flat-string (%print-negate-hyps
+                                                                             (fast-app
+                                                                              (rw.hypbox->left (rw.assms->hypbox assms))
+                                                                              (rw.hypbox->right (rw.assms->hypbox assms)))))))
+                                      0
+                                      ACL2::*standard-co*
+                                      ACL2::*the-live-state*
+                                      nil)))
+                       ((equal flag 'rule)
+                        (ACL2::fmt1! "~s0~x1> ~x2: try matching ~s3~%"
+                                     (list (cons #\0 (ACL2::coerce (repeat #\Space *rw.crewrite-depth*) 'ACL2::string))
+                                           (cons #\1 *rw.crewrite-depth*)
+                                           (cons #\2 (rw.rule->name rule[s]))
+                                           (cons #\3 (ACL2::to-flat-string (rw.rule->lhs rule[s]))))
+                                     0
+                                     ACL2::*standard-co*
+                                     ACL2::*the-live-state*
+                                     nil))
+                       ((equal flag 'match)
+                        (ACL2::fmt1! "~s0~x1> ~x2: try sigma ~s3~%"
+                                     (list (cons #\0 (ACL2::coerce (repeat #\Space *rw.crewrite-depth*) 'ACL2::string))
+                                           (cons #\1 *rw.crewrite-depth*)
+                                           (cons #\2 (rw.rule->name rule[s]))
+                                           (cons #\3 (ACL2::to-flat-string sigma[s])))
+                                     0
+                                     ACL2::*standard-co*
+                                     ACL2::*the-live-state*
+                                     nil))
+                       ((equal flag 'hyp)
+                        (let ((goal (logic.substitute (rw.hyp->term x) sigma[s])))
+                          (ACL2::fmt1! "~s0~x1> ~x2: hyp instance: ~s3~%"
+                                       (list (cons #\0 (ACL2::coerce (repeat #\Space *rw.crewrite-depth*) 'ACL2::string))
+                                             (cons #\1 *rw.crewrite-depth*)
+                                             (cons #\2 (rw.rule->name rule[s]))
+                                             (cons #\3 (ACL2::to-flat-string goal)))
+                                       0
+                                       ACL2::*standard-co*
+                                       ACL2::*the-live-state*
+                                       nil)))
+                       (t nil)))
+               :when :before)
+   (CCL:advise rw.crewrite-note-fn
+               (let* ((arglist  CCL::arglist)
+                      (flag     (nth 0 arglist))
+                      (assms    (nth 1 arglist))
+                      (x        (nth 2 arglist))
+                      (rule[s]  (nth 3 arglist))
+                      (sigma[s] (nth 4 arglist))
+                      (hypcache (nth 5 arglist))
+                      (iffp     (nth 6 arglist))
+                      (blimit   (nth 7 arglist))
+                      (rlimit   (nth 8 arglist))
+                      (anstack  (nth 9 arglist))
+                      (control  (nth 10 arglist))
+                      (note     (nth 11 arglist)))
+                 (declare (ACL2::ignorable flag assms x rule[s] sigma[s] hypcache iffp blimit rlimit anstack control note))
+                 (ACL2::prog2$
+                  (ACL2::fmt1! "~s0<~x1 NOTE: ~s2~%"
+                               (list (cons #\0 (ACL2::coerce (repeat #\Space *rw.crewrite-depth*) 'ACL2::string))
+                                     (cons #\1 *rw.crewrite-depth*)
+                                     (cons #\2 (ACL2::to-flat-string note)))
+                               0
+                               ACL2::*standard-co*
+                               ACL2::*the-live-state*
+                               nil)
+                  (if (equal (car note) 'rewrote-to)
+                      (ACL2::setf *rw.crewrite-depth* (- *rw.crewrite-depth* 1))
+                    nil)))
+               :when :before)
+   nil))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/interface/trace-crewrite.lisp acl2-6.3/books/milawa/ACL2/interface/trace-crewrite.lisp
--- acl2-6.2/books/milawa/ACL2/interface/trace-crewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/interface/trace-crewrite.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,58 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(defun %trace-crewrite ()
+  ;; Has an "under the hood" implementation.
+  (declare (xargs :mode :program))
+  nil)
+
+(defun %untrace-crewrite ()
+  ;; Has an "under the hood" implementation.
+  (declare (xargs :mode :program))
+  nil)
+
+(ACL2::defttag trace-crewrite)
+
+#|
+
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+ (let* ((tacdir  (ACL2::extend-pathname ACL2::*path-to-milawa-acl2-directory* "tactics"                ACL2::state))
+        (rawfile (ACL2::extend-pathname tacdir                                "trace-crewrite-raw.lsp" ACL2::state)))
+   (ACL2::load rawfile)))
+
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/levels/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/levels/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/levels/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/acl2-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,38 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(ld "cert.acl2")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/levels/cert.acl2 acl2-6.3/books/milawa/ACL2/levels/cert.acl2
--- acl2-6.2/books/milawa/ACL2/levels/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/cert.acl2	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,38 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level10.lisp acl2-6.3/books/milawa/ACL2/levels/level10.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level10.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level10.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,327 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level9")
+(include-book "../tactics/crewrite-world")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund level10.step-okp (x worlds defs axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (tactic.world-listp worlds)
+                              (definition-listp defs)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ((equal method 'rw.crewrite-clause-plan-compiler)
+      (rw.crewrite-clause-plan-compiler-okp x worlds atbl))
+     (t
+      (level9.step-okp x worlds defs axioms thms atbl)))))
+
+(defobligations level10.step-okp
+  (rw.crewrite-clause-plan-compiler
+   level9.step-okp))
+
+(encapsulate
+ ()
+ (local (in-theory (enable level10.step-okp)))
+
+ (defthm@ soundness-of-level10.step-okp
+   (implies (and (level10.step-okp x worlds defs axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (tactic.world-listp worlds)
+                             (tactic.world-list-atblp worlds atbl)
+                             (tactic.world-list-env-okp worlds axioms thms)
+                             (logic.formula-list-atblp defs atbl)
+                             (definition-listp defs)
+                             (subsetp defs axioms)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (mapp atbl)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (@obligations level10.step-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level10.step-okp-when-level9.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level9.step-okp x worlds defs axioms thms atbl)
+            (level10.step-okp x worlds defs axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level9.step-okp
+                                     level8.step-okp
+                                     level7.step-okp
+                                     level6.step-okp
+                                     level5.step-okp
+                                     level4.step-okp
+                                     level3.step-okp
+                                     level2.step-okp
+                                     logic.appeal-step-okp))))
+
+ (defthm level10.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level10.step-okp x worlds defs axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+
+(encapsulate
+ ()
+(defund level10.flag-proofp-aux (flag x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x) (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level10.step-okp x worlds defs axioms thms atbl)
+            (level10.flag-proofp-aux 'list (logic.subproofs x) worlds defs axioms thms atbl))
+     (if (consp x)
+         (and (level10.flag-proofp-aux 'proof (car x) worlds defs axioms thms atbl)
+              (level10.flag-proofp-aux 'list (cdr x) worlds defs axioms thms atbl))
+       t)))
+
+(definlined level10.proofp-aux (x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level10.flag-proofp-aux 'proof x worlds defs axioms thms atbl))
+
+(definlined level10.proof-listp-aux (x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level10.flag-proofp-aux 'list x worlds defs axioms thms atbl))
+
+(defthmd definition-of-level10.proofp-aux
+   (equal (level10.proofp-aux x worlds defs axioms thms atbl)
+          (and (level10.step-okp x worlds defs axioms thms atbl)
+               (level10.proof-listp-aux (logic.subproofs x) worlds defs axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level10.proofp-aux level10.proof-listp-aux level10.flag-proofp-aux))))
+
+(defthmd definition-of-level10.proof-listp-aux
+   (equal (level10.proof-listp-aux x worlds defs axioms thms atbl)
+          (if (consp x)
+              (and (level10.proofp-aux (car x) worlds defs axioms thms atbl)
+                   (level10.proof-listp-aux (cdr x) worlds defs axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level10.proofp-aux level10.proof-listp-aux level10.flag-proofp-aux))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition level10.proofp-aux))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition level10.proof-listp)))))
+
+
+
+(defthm level10.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level10.proofp-aux x worlds defs axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level10.proofp-aux))))
+
+(defthm level10.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level10.proof-listp-aux x worlds defs axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level10.proof-listp-aux))))
+
+(defthm level10.proof-listp-aux-of-cons
+  (equal (level10.proof-listp-aux (cons a x) worlds defs axioms thms atbl)
+         (and (level10.proofp-aux a worlds defs axioms thms atbl)
+              (level10.proof-listp-aux x worlds defs axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level10.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level10.proofp-aux
+                (equal (booleanp (level10.proofp-aux x worlds defs axioms thms atbl))
+                       t))
+         (t booleanp-of-level10.proof-listp-aux
+            (equal (booleanp (level10.proof-listp-aux x worlds defs axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level10.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level10.proof-listp-aux (x worlds defs axioms thms atbl)
+  (level10.proofp-aux x worlds defs axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level10.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level10.step-okp)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'if atbl)) 3)
+                   (logic.formula-list-atblp defs atbl)
+                   (definition-listp defs)
+                   (subsetp defs axioms)
+                   (mapp atbl)
+                   (tactic.world-listp worlds)
+                   (tactic.world-list-atblp worlds atbl)
+                   (tactic.world-list-env-okp worlds axioms thms)
+                   )
+  :thms ((proof logic.provablep-when-level10.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level10.proofp-aux x worlds defs axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level10.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level10.proof-listp-aux x worlds defs axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level10.proofp-aux))))
+
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level10.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level10.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level10.proofp-aux x worlds defs axioms thms atbl)
+                                t)))
+         (t level10.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level10.proof-listp-aux x worlds defs axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level10.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level10.proofp-aux-when-logic.proofp
+                    level10.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level10.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level10.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level10.proofp-aux (logic.provable-witness formula axioms thms atbl) worlds defs axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level10.proofp-aux-when-logic.proofp))))
+
+
+;; The level 10 adapter trace will be named level10.proofp and will have, as its extras,
+;; a list of the form (defs worlds core).
+
+(defun@ level10.static-checksp (worlds defs axioms thms atbl)
+  ;; NOTE!  We leave this enabled!
+  (declare (xargs :guard (and (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (and (mapp atbl)
+       (@obligations level10.step-okp)
+       (equal (cdr (lookup 'not atbl)) 1)
+       (equal (cdr (lookup 'equal atbl)) 2)
+       (equal (cdr (lookup 'iff atbl)) 2)
+       (equal (cdr (lookup 'if atbl)) 3)
+       (definition-listp defs)
+       (logic.fast-arities-okp (logic.formula-list-arities defs nil) atbl)
+       (ordered-list-subsetp (mergesort defs) (mergesort axioms))
+       (tactic.world-listp worlds)
+       (tactic.fast-world-list-atblp worlds atbl)
+       (tactic.fast-world-list-env-okp worlds axioms thms)))
+
+(defund@ level10.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'level10.proofp)
+         (not subproofs)
+         (tuplep 3 extras)
+         (let ((defs   (first extras))
+               (worlds (second extras))
+               (core   (third extras)))
+           (and
+            (ACL2::time$ (level10.static-checksp worlds defs axioms thms atbl))
+            (logic.appealp core)
+            (equal conclusion (logic.conclusion core))
+            (level10.proofp-aux core worlds defs axioms thms atbl))))))
+
+(defthm booleanp-of-level10.proofp
+  (equal (booleanp (level10.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level10.proofp))))
+
+(defthm logic.provablep-when-level10.proofp
+  (implies (and (logic.appealp x)
+                (level10.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (e/d (level10.proofp)
+                          (logic.provablep-when-level10.proofp-aux))
+          :use ((:instance logic.provablep-when-level10.proofp-aux
+                           (x      (third (logic.extras x)))
+                           (defs   (first (logic.extras x)))
+                           (worlds (second (logic.extras x))))))))
+
+(defun level10.adapter (proof defs initial-world all-worlds)
+  (declare (xargs :mode :program)
+           (ignore initial-world))
+  (logic.appeal 'level10.proofp
+                (logic.conclusion proof)
+                nil
+                (list defs all-worlds proof)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level11.lisp acl2-6.3/books/milawa/ACL2/levels/level11.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level11.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level11.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,345 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level10")
+(include-book "../tactics/compiler")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund level11.step-okp (x worlds defs axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (tactic.world-listp worlds)
+                              (definition-listp defs)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ((equal method 'tactic.compile-skeleton)
+      (tactic.compile-skeleton-okp x worlds axioms thms atbl))
+     (t
+      (level10.step-okp x worlds defs axioms thms atbl)))))
+
+(defobligations level11.step-okp
+  (tactic.compile-skeleton
+   level10.step-okp))
+
+(encapsulate
+ ()
+ (local (in-theory (enable level11.step-okp)))
+
+ (defthm@ soundness-of-level11.step-okp
+   (implies (and (level11.step-okp x worlds defs axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (tactic.world-listp worlds)
+                             (tactic.world-list-atblp worlds atbl)
+                             (tactic.world-list-env-okp worlds axioms thms)
+                             (logic.formula-list-atblp defs atbl)
+                             (definition-listp defs)
+                             (subsetp defs axioms)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (mapp atbl)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'ordp atbl)) 1)
+                             (equal (cdr (lookup 'ord< atbl)) 2)
+                             (equal (cdr (lookup 'car atbl)) 1)
+                             (equal (cdr (lookup 'cdr atbl)) 1)
+                             (equal (cdr (lookup 'consp atbl)) 1)
+                             (equal (cdr (lookup 'cons atbl)) 2)
+                             (@obligations level11.step-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level11.step-okp-when-level10.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level10.step-okp x worlds defs axioms thms atbl)
+            (level11.step-okp x worlds defs axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level10.step-okp
+                                     level9.step-okp
+                                     level8.step-okp
+                                     level7.step-okp
+                                     level6.step-okp
+                                     level5.step-okp
+                                     level4.step-okp
+                                     level3.step-okp
+                                     level2.step-okp
+                                     logic.appeal-step-okp))))
+
+ (defthm level11.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level11.step-okp x worlds defs axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+
+(encapsulate
+ ()
+ (defund level11.flag-proofp-aux (flag x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x) (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level11.step-okp x worlds defs axioms thms atbl)
+            (level11.flag-proofp-aux 'list (logic.subproofs x) worlds defs axioms thms atbl))
+     (if (consp x)
+         (and (level11.flag-proofp-aux 'proof (car x) worlds defs axioms thms atbl)
+              (level11.flag-proofp-aux 'list (cdr x) worlds defs axioms thms atbl))
+       t)))
+
+ (definlined level11.proofp-aux (x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level11.flag-proofp-aux 'proof x worlds defs axioms thms atbl))
+
+ (definlined level11.proof-listp-aux (x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level11.flag-proofp-aux 'list x worlds defs axioms thms atbl))
+
+ (defthmd definition-of-level11.proofp-aux
+   (equal (level11.proofp-aux x worlds defs axioms thms atbl)
+          (and (level11.step-okp x worlds defs axioms thms atbl)
+               (level11.proof-listp-aux (logic.subproofs x) worlds defs axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level11.proofp-aux level11.proof-listp-aux level11.flag-proofp-aux))))
+
+ (defthmd definition-of-level11.proof-listp-aux
+   (equal (level11.proof-listp-aux x worlds defs axioms thms atbl)
+          (if (consp x)
+              (and (level11.proofp-aux (car x) worlds defs axioms thms atbl)
+                   (level11.proof-listp-aux (cdr x) worlds defs axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level11.proofp-aux level11.proof-listp-aux level11.flag-proofp-aux))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level11.proofp-aux))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level11.proof-listp)))))
+
+
+
+(defthm level11.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level11.proofp-aux x worlds defs axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level11.proofp-aux))))
+
+(defthm level11.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level11.proof-listp-aux x worlds defs axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level11.proof-listp-aux))))
+
+(defthm level11.proof-listp-aux-of-cons
+  (equal (level11.proof-listp-aux (cons a x) worlds defs axioms thms atbl)
+         (and (level11.proofp-aux a worlds defs axioms thms atbl)
+              (level11.proof-listp-aux x worlds defs axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level11.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level11.proofp-aux
+                (equal (booleanp (level11.proofp-aux x worlds defs axioms thms atbl))
+                       t))
+         (t booleanp-of-level11.proof-listp-aux
+            (equal (booleanp (level11.proof-listp-aux x worlds defs axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level11.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level11.proof-listp-aux (x worlds defs axioms thms atbl)
+  (level11.proofp-aux x worlds defs axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level11.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level11.step-okp)
+                   (equal (cdr (lookup 'if atbl)) 3)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'ordp atbl)) 1)
+                   (equal (cdr (lookup 'ord< atbl)) 2)
+                   (equal (cdr (lookup 'car atbl)) 1)
+                   (equal (cdr (lookup 'cdr atbl)) 1)
+                   (equal (cdr (lookup 'consp atbl)) 1)
+                   (equal (cdr (lookup 'cons atbl)) 2)
+                   (logic.formula-list-atblp defs atbl)
+                   (definition-listp defs)
+                   (subsetp defs axioms)
+                   (mapp atbl)
+                   (tactic.world-listp worlds)
+                   (tactic.world-list-atblp worlds atbl)
+                   (tactic.world-list-env-okp worlds axioms thms)
+                   )
+  :thms ((proof logic.provablep-when-level11.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level11.proofp-aux x worlds defs axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level11.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level11.proof-listp-aux x worlds defs axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level11.proofp-aux))))
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level11.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level11.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level11.proofp-aux x worlds defs axioms thms atbl)
+                                t)))
+         (t level11.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level11.proof-listp-aux x worlds defs axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level11.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level11.proofp-aux-when-logic.proofp
+                    level11.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level11.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level11.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level11.proofp-aux (logic.provable-witness formula axioms thms atbl) worlds defs axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level11.proofp-aux-when-logic.proofp))))
+
+
+;; The level 11 adapter trace will be named level11.proofp and will have, as its extras,
+;; a list of the form (defs worlds core).
+
+(defun@ level11.static-checksp (worlds defs axioms thms atbl)
+  ;; NOTE!  We leave this enabled!
+  (declare (xargs :guard (and (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (and (mapp atbl)
+       (@obligations level11.step-okp)
+       (equal (cdr (lookup 'if atbl)) 3)
+       (equal (cdr (lookup 'equal atbl)) 2)
+       (equal (cdr (lookup 'iff atbl)) 2)
+       (equal (cdr (lookup 'not atbl)) 1)
+       (equal (cdr (lookup 'ordp atbl)) 1)
+       (equal (cdr (lookup 'ord< atbl)) 2)
+       (equal (cdr (lookup 'car atbl)) 1)
+       (equal (cdr (lookup 'cdr atbl)) 1)
+       (equal (cdr (lookup 'consp atbl)) 1)
+       (equal (cdr (lookup 'cons atbl)) 2)
+       (definition-listp defs)
+       (logic.fast-arities-okp (logic.formula-list-arities defs nil) atbl)
+       (ordered-list-subsetp (mergesort defs) (mergesort axioms))
+       (tactic.world-listp worlds)
+       (tactic.fast-world-list-atblp worlds atbl)
+       (tactic.fast-world-list-env-okp worlds axioms thms)))
+
+(defund@ level11.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'level11.proofp)
+         (not subproofs)
+         (tuplep 3 extras)
+         (let ((defs   (first extras))
+               (worlds (second extras))
+               (core   (third extras)))
+           (and
+            (ACL2::time$ (level11.static-checksp worlds defs axioms thms atbl))
+            (logic.appealp core)
+            (equal conclusion (logic.conclusion core))
+            (level11.proofp-aux core worlds defs axioms thms atbl))))))
+
+(defthm booleanp-of-level11.proofp
+  (equal (booleanp (level11.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level11.proofp))))
+
+(defthm logic.provablep-when-level11.proofp
+  (implies (and (logic.appealp x)
+                (level11.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (e/d (level11.proofp)
+                          (logic.provablep-when-level11.proofp-aux))
+          :use ((:instance logic.provablep-when-level11.proofp-aux
+                           (x      (third (logic.extras x)))
+                           (defs   (first (logic.extras x)))
+                           (worlds (second (logic.extras x))))))))
+
+(defun level11.adapter (proof defs initial-world all-worlds)
+  (declare (xargs :mode :program)
+           (ignore initial-world))
+  (logic.appeal 'level11.proofp
+                (logic.conclusion proof)
+                nil
+                (list defs all-worlds proof)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level2.lisp acl2-6.3/books/milawa/ACL2/levels/level2.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level2.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,247 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../build/prop")
+(include-book "../clauses/prop")
+(include-book "../rewrite/prop")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund level2.step-okp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond ((equal method 'build.commute-or)                     (build.commute-or-okp x atbl))
+          ((equal method 'build.right-expansion)                (build.right-expansion-okp x atbl))
+          ((equal method 'build.modus-ponens)                   (build.modus-ponens-okp x atbl))
+          ((equal method 'build.modus-ponens-2)                 (build.modus-ponens-2-okp x atbl))
+          ((equal method 'build.right-associativity)            (build.right-associativity-okp x atbl))
+          ((equal method 'build.disjoined-left-expansion)       (build.disjoined-left-expansion-okp x atbl))
+          ((equal method 'build.disjoined-right-expansion)      (build.disjoined-right-expansion-okp x atbl))
+          ((equal method 'build.disjoined-contraction)          (build.disjoined-contraction-okp x atbl))
+          ((equal method 'build.cancel-neg-neg)                 (build.cancel-neg-neg-okp x atbl))
+          ((equal method 'build.insert-neg-neg)                 (build.insert-neg-neg-okp x atbl))
+          ((equal method 'build.lhs-insert-neg-neg)             (build.lhs-insert-neg-neg-okp x atbl))
+          ((equal method 'build.merge-negatives)                (build.merge-negatives-okp x atbl))
+          ((equal method 'build.merge-implications)             (build.merge-implications-okp x atbl))
+          ((equal method 'build.disjoined-commute-or)           (build.disjoined-commute-or-okp x atbl))
+          ((equal method 'build.disjoined-right-associativity)  (build.disjoined-right-associativity-okp x atbl))
+          ((equal method 'build.disjoined-associativity)        (build.disjoined-associativity-okp x atbl))
+          ((equal method 'build.disjoined-cut)                  (build.disjoined-cut-okp x atbl))
+          ((equal method 'build.disjoined-modus-ponens)         (build.disjoined-modus-ponens-okp x atbl))
+          ((equal method 'build.disjoined-modus-ponens-2)       (build.disjoined-modus-ponens-2-okp x atbl))
+          ((equal method 'build.lhs-commute-or-then-rassoc)     (build.lhs-commute-or-then-rassoc-okp x atbl))
+          ((equal method 'rw.crewrite-twiddle-bldr)             (rw.crewrite-twiddle-bldr-okp x atbl))
+          ((equal method 'rw.crewrite-twiddle2-bldr)            (rw.crewrite-twiddle2-bldr-okp x atbl))
+          ((equal method 'clause.aux-split-twiddle)             (clause.aux-split-twiddle-okp x atbl))
+          ((equal method 'clause.aux-split-twiddle2)            (clause.aux-split-twiddle2-okp x atbl))
+          ((equal method 'clause.aux-split-default-3-bldr)      (clause.aux-split-default-3-bldr-okp x atbl))
+          ((equal method 'clause.aux-limsplit-cutoff-step-bldr) (clause.aux-limsplit-cutoff-step-bldr-okp x atbl))
+          (t
+           (logic.appeal-step-okp x axioms thms atbl)))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable level2.step-okp)))
+
+ (defthm soundness-of-level2.step-okp
+   (implies (and (logic.appealp x)
+                 (level2.step-okp x axioms thms atbl)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level2.step-okp-when-logic.appeal-step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (logic.appeal-step-okp x axioms thms atbl)
+            (level2.step-okp x axioms thms atbl))
+   :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+ (defthm level2.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level2.step-okp x axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+(encapsulate
+ ()
+ (defund level2.flag-proofp (flag x axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x)
+                                              (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level2.step-okp x axioms thms atbl)
+            (level2.flag-proofp 'list (logic.subproofs x) axioms thms atbl))
+     (if (consp x)
+         (and (level2.flag-proofp 'proof (car x) axioms thms atbl)
+              (level2.flag-proofp 'list (cdr x) axioms thms atbl))
+       t)))
+
+ (definlined level2.proofp (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level2.flag-proofp 'proof x axioms thms atbl))
+
+ (definlined level2.proof-listp (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level2.flag-proofp 'list x axioms thms atbl))
+
+ (defthmd definition-of-level2.proofp
+   (equal (level2.proofp x axioms thms atbl)
+          (and (level2.step-okp x axioms thms atbl)
+               (level2.proof-listp (logic.subproofs x) axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level2.proofp level2.proof-listp level2.flag-proofp))))
+
+ (defthmd definition-of-level2.proof-listp
+   (equal (level2.proof-listp x axioms thms atbl)
+          (if (consp x)
+              (and (level2.proofp (car x) axioms thms atbl)
+                   (level2.proof-listp (cdr x) axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level2.proofp level2.proof-listp level2.flag-proofp))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level2.proofp))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition demo.proof-list)))))
+
+
+(defthm level2.proofp-when-not-consp
+  (implies (not (consp x))
+           (equal (level2.proofp x axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level2.proofp))))
+
+(defthm level2.proof-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (level2.proof-listp x axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level2.proof-listp))))
+
+(defthm level2.proof-listp-of-cons
+  (equal (level2.proof-listp (cons a x) axioms thms atbl)
+         (and (level2.proofp a axioms thms atbl)
+              (level2.proof-listp x axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level2.proof-listp))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level2.proofp
+                (equal (booleanp (level2.proofp x axioms thms atbl))
+                       t))
+         (t booleanp-of-level2.proof-listp
+            (equal (booleanp (level2.proof-listp x axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level2.proofp)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level2.proof-listp (x axioms thms atbl)
+  (level2.proofp x axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level2.proofp is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :thms ((proof logic.provablep-when-level2.proofp
+                (implies (and (logic.appealp x)
+                              (level2.proofp x axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level2.proof-listp
+            (implies (and (logic.appeal-listp x)
+                          (level2.proof-listp x axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level2.proofp))))
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level2.proofp is "strictly more capable" than logic.proofp.
+  ;;
+  ;; WARNING: THESE THEOREMS MUST BE LEFT DISABLED!
+  ;;
+  ;; Suppose this rule is enabled, and we are trying to prove (level2.proofp X
+  ;; ...)  Using this rule, we backchain and try to show (logic.proofp X ...),
+  ;; which causes our forcing rules to kick in and assert that the subproofs of
+  ;; X are acceptable using logic.proofp.
+  ;;
+  ;; But this is horrible; if any of the subproofs are derived rules that only
+  ;; level2.proofp understands, we end up stuck in forcing rounds that we cannot
+  ;; relieve.  So, we should always be reasoning about some single layer and
+  ;; never about previous layers.
+  :thms ((proof level2.proofp-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level2.proofp x axioms thms atbl)
+                                t)))
+         (t level2.proof-listp-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level2.proof-listp x axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level2.proofp
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level2.proofp-when-logic.proofp
+                    level2.proof-listp-when-logic.proof-listp))
+
+(defthm forcing-level2.proofp-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level2.proofp.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level2.proofp (logic.provable-witness formula axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level2.proofp-when-logic.proofp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level3-help.lisp acl2-6.3/books/milawa/ACL2/levels/level3-help.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level3-help.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level3-help.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,38 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; BOZO not needed anymore, eliminate this file
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level3.lisp acl2-6.3/books/milawa/ACL2/levels/level3.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level3.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,465 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level2")
+(include-book "../build/prop-list")
+(include-book "../build/disjoined-subset")
+(include-book "../build/equal")
+(include-book "../build/iff")
+(include-book "../build/if")
+(include-book "../build/not")
+(include-book "../clauses/disjoined-update-clause-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund level3.step-okp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ;; Propositional rules
+     ((equal method 'build.modus-ponens-list)                     (build.modus-ponens-list-okp x))
+     ((equal method 'build.disjoined-modus-ponens-list)           (build.disjoined-modus-ponens-list-okp x))
+     ((equal method 'build.generic-subset)                        (build.generic-subset-okp x atbl))
+     ((equal method 'build.multi-assoc-expansion)                 (build.multi-assoc-expansion-okp x atbl))
+     ((equal method 'clause.aux-disjoined-update-clause-twiddle)  (clause.aux-disjoined-update-clause-twiddle-okp x atbl))
+
+     ;; Pequal rules
+     ((equal method 'build.reflexivity)                           (build.reflexivity-okp x atbl))
+     ((equal method 'build.commute-pequal)                        (build.commute-pequal-okp x atbl))
+     ((equal method 'build.disjoined-commute-pequal)              (build.disjoined-commute-pequal-okp x atbl))
+     ((equal method 'build.commute-not-pequal)                    (build.commute-not-pequal-okp x atbl))
+     ((equal method 'build.disjoined-commute-not-pequal)          (build.disjoined-commute-not-pequal-okp x atbl))
+     ((equal method 'build.substitute-into-not-pequal)            (build.substitute-into-not-pequal-okp x atbl))
+     ((equal method 'build.disjoined-substitute-into-not-pequal)  (build.disjoined-substitute-into-not-pequal-okp x atbl))
+     ((equal method 'build.transitivity-of-pequal)                (build.transitivity-of-pequal-okp x atbl))
+     ((equal method 'build.disjoined-transitivity-of-pequal)      (build.disjoined-transitivity-of-pequal-okp x atbl))
+     ((equal method 'build.not-nil-from-t)                        (build.not-nil-from-t-okp x atbl))
+     ((equal method 'build.disjoined-not-nil-from-t)              (build.disjoined-not-nil-from-t-okp x atbl))
+     ((equal method 'build.not-t-from-nil)                        (build.not-t-from-nil-okp x atbl))
+     ((equal method 'build.disjoined-not-t-from-nil)              (build.disjoined-not-t-from-nil-okp x atbl))
+
+     ;; Equal rules
+     ((equal method 'build.equal-reflexivity)                     (build.equal-reflexivity-okp x atbl))
+     ((equal method 'build.equal-t-from-not-nil)                  (build.equal-t-from-not-nil-okp x atbl))
+     ((equal method 'build.disjoined-equal-t-from-not-nil)        (build.disjoined-equal-t-from-not-nil-okp x atbl))
+     ((equal method 'build.equal-nil-from-not-t)                  (build.equal-nil-from-not-t-okp x atbl))
+     ((equal method 'build.disjoined-equal-nil-from-not-t)        (build.disjoined-equal-nil-from-not-t-okp x atbl))
+     ((equal method 'build.pequal-from-equal)                     (build.pequal-from-equal-okp x atbl))
+     ((equal method 'build.disjoined-pequal-from-equal)           (build.disjoined-pequal-from-equal-okp x atbl))
+     ((equal method 'build.not-equal-from-not-pequal)             (build.not-equal-from-not-pequal-okp x atbl))
+     ((equal method 'build.disjoined-not-equal-from-not-pequal)   (build.disjoined-not-equal-from-not-pequal-okp x atbl))
+     ((equal method 'build.commute-equal)                         (build.commute-equal-okp x atbl))
+     ((equal method 'build.disjoined-commute-equal)               (build.disjoined-commute-equal-okp x atbl))
+     ((equal method 'build.equal-from-pequal)                     (build.equal-from-pequal-okp x atbl))
+     ((equal method 'build.disjoined-equal-from-pequal)           (build.disjoined-equal-from-pequal-okp x atbl))
+     ((equal method 'build.not-pequal-from-not-equal)             (build.not-pequal-from-not-equal-okp x atbl))
+     ((equal method 'build.disjoined-not-pequal-from-not-equal)   (build.disjoined-not-pequal-from-not-equal-okp x atbl))
+     ((equal method 'build.transitivity-of-equal)                 (build.transitivity-of-equal-okp x atbl))
+     ((equal method 'build.disjoined-transitivity-of-equal)       (build.disjoined-transitivity-of-equal-okp x atbl))
+     ((equal method 'build.not-pequal-constants)                  (build.not-pequal-constants-okp x atbl))
+
+     ;; If rules
+     ((equal method 'build.if-when-not-nil)                       (build.if-when-not-nil-okp x atbl))
+     ((equal method 'build.if-when-nil)                           (build.if-when-nil-okp x atbl))
+
+     ;; Iff rules
+     ((equal method 'build.iff-t-from-not-pequal-nil)             (build.iff-t-from-not-pequal-nil-okp x atbl))
+     ((equal method 'build.disjoined-iff-t-from-not-pequal-nil)   (build.disjoined-iff-t-from-not-pequal-nil-okp x atbl))
+     ((equal method 'build.not-pequal-nil-from-iff-t)             (build.not-pequal-nil-from-iff-t-okp x atbl))
+     ((equal method 'build.disjoined-not-pequal-nil-from-iff-t)   (build.disjoined-not-pequal-nil-from-iff-t-okp x atbl))
+     ((equal method 'build.iff-t-from-not-nil)                    (build.iff-t-from-not-nil-okp x atbl))
+     ((equal method 'build.disjoined-iff-t-from-not-nil)          (build.disjoined-iff-t-from-not-nil-okp x atbl))
+     ((equal method 'build.iff-reflexivity)                       (build.iff-reflexivity-okp x atbl))
+     ((equal method 'build.commute-iff)                           (build.commute-iff-okp x atbl))
+     ((equal method 'build.disjoined-commute-iff)                 (build.disjoined-commute-iff-okp x atbl))
+     ((equal method 'build.transitivity-of-iff)                   (build.transitivity-of-iff-okp x atbl))
+     ((equal method 'build.disjoined-transitivity-of-iff)         (build.disjoined-transitivity-of-iff-okp x atbl))
+     ((equal method 'build.iff-from-pequal)                       (build.iff-from-pequal-okp x atbl))
+     ((equal method 'build.disjoined-iff-from-pequal)             (build.disjoined-iff-from-pequal-okp x atbl))
+     ((equal method 'build.iff-from-equal)                        (build.iff-from-equal-okp x atbl))
+     ((equal method 'build.disjoined-iff-from-equal)              (build.disjoined-iff-from-equal-okp x atbl))
+
+     ;; dead rules now, i think
+     ;;((equal method 'build.pequal-nil-from-iff-nil)               (build.pequal-nil-from-iff-nil-okp x atbl))
+     ;;((equal method 'build.disjoined-pequal-nil-from-iff-nil)     (build.disjoined-pequal-nil-from-iff-nil-okp x atbl))
+     ;;((equal method 'build.not-equal-from-not-iff)                (build.not-equal-from-not-iff-okp x atbl))
+     ;;((equal method 'build.iff-nil-from-not-t)                    (build.iff-nil-from-not-t-okp x atbl))
+     ;;((equal method 'build.disjoined-iff-nil-from-not-t)          (build.disjoined-iff-nil-from-not-t-okp x atbl))
+
+     ;; Not rules
+     ((equal method 'build.disjoined-negative-lit-from-pequal-nil)   (build.disjoined-negative-lit-from-pequal-nil-okp x atbl))
+     ((equal method 'build.disjoined-pequal-nil-from-negative-lit)   (build.disjoined-pequal-nil-from-negative-lit-okp x atbl))
+     ((equal method 'build.disjoined-iff-when-not-nil)               (build.disjoined-iff-when-not-nil-okp x atbl))
+
+     ;; Extended propositional rules
+     ;; Other rules
+     (t
+      (level2.step-okp x axioms thms atbl)))))
+
+(defobligations level3.step-okp
+  (build.modus-ponens-list
+   build.disjoined-modus-ponens-list
+   build.generic-subset
+   build.multi-assoc-expansion
+   clause.aux-disjoined-update-clause-twiddle
+
+   build.reflexivity
+   build.commute-pequal
+   build.disjoined-commute-pequal
+   build.commute-not-pequal
+   build.disjoined-commute-not-pequal
+   build.substitute-into-not-pequal
+   build.disjoined-substitute-into-not-pequal
+   build.transitivity-of-pequal
+   build.disjoined-transitivity-of-pequal
+   build.not-nil-from-t
+   build.disjoined-not-nil-from-t
+   build.not-t-from-nil
+   build.disjoined-not-t-from-nil
+
+   build.equal-reflexivity
+   build.equal-t-from-not-nil
+   build.disjoined-equal-t-from-not-nil
+   build.equal-nil-from-not-t
+   build.disjoined-equal-nil-from-not-t
+   build.pequal-from-equal
+   build.disjoined-pequal-from-equal
+   build.not-equal-from-not-pequal
+   build.disjoined-not-equal-from-not-pequal
+   build.commute-equal
+   build.disjoined-commute-equal
+   build.equal-from-pequal
+   build.disjoined-equal-from-pequal
+   build.not-pequal-from-not-equal
+   build.disjoined-not-pequal-from-not-equal
+   build.transitivity-of-equal
+   build.disjoined-transitivity-of-equal
+   build.not-pequal-constants
+
+   build.if-when-not-nil
+   build.if-when-nil
+
+   build.iff-t-from-not-pequal-nil
+   build.disjoined-iff-t-from-not-pequal-nil
+   build.not-pequal-nil-from-iff-t
+   build.disjoined-not-pequal-nil-from-iff-t
+   build.iff-t-from-not-nil
+   build.disjoined-iff-t-from-not-nil
+   build.iff-reflexivity
+   build.commute-iff
+   build.disjoined-commute-iff
+   build.transitivity-of-iff
+   build.disjoined-transitivity-of-iff
+   build.iff-from-pequal
+   build.disjoined-iff-from-pequal
+   build.iff-from-equal
+   build.disjoined-iff-from-equal
+
+   build.disjoined-negative-lit-from-pequal-nil
+   build.disjoined-pequal-nil-from-negative-lit
+   build.disjoined-iff-when-not-nil))
+
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable level3.step-okp)))
+
+ (defthm@ soundness-of-level3.step-okp
+   (implies (and (logic.appealp x)
+                 (level3.step-okp x axioms thms atbl)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'if atbl)) 3)
+                 (@obligations level3.step-okp))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level3.step-okp-when-level2.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level2.step-okp x axioms thms atbl)
+            (level3.step-okp x axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level2.step-okp logic.appeal-step-okp))))
+
+ (defthm level3.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level3.step-okp x axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+(encapsulate
+ ()
+ (defund level3.flag-proofp-aux (flag x axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x)
+                                              (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level3.step-okp x axioms thms atbl)
+            (level3.flag-proofp-aux 'list (logic.subproofs x) axioms thms atbl))
+     (if (consp x)
+         (and (level3.flag-proofp-aux 'proof (car x) axioms thms atbl)
+              (level3.flag-proofp-aux 'list (cdr x) axioms thms atbl))
+       t)))
+
+ (definlined level3.proofp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level3.flag-proofp-aux 'proof x axioms thms atbl))
+
+ (definlined level3.proof-listp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level3.flag-proofp-aux 'list x axioms thms atbl))
+
+ (defthmd definition-of-level3.proofp-aux
+   (equal (level3.proofp-aux x axioms thms atbl)
+          (and (level3.step-okp x axioms thms atbl)
+               (level3.proof-listp-aux (logic.subproofs x) axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level3.proofp-aux level3.proof-listp-aux level3.flag-proofp-aux))))
+
+ (defthmd definition-of-level3.proof-listp-aux
+   (equal (level3.proof-listp-aux x axioms thms atbl)
+          (if (consp x)
+              (and (level3.proofp-aux (car x) axioms thms atbl)
+                   (level3.proof-listp-aux (cdr x) axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level3.proofp-aux level3.proof-listp-aux level3.flag-proofp-aux))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level3.proofp-aux))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition demo.proof-list)))))
+
+
+
+(defthm level3.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level3.proofp-aux x axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level3.proofp-aux))))
+
+(defthm level3.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level3.proof-listp-aux x axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level3.proof-listp-aux))))
+
+(defthm level3.proof-listp-aux-of-cons
+  (equal (level3.proof-listp-aux (cons a x) axioms thms atbl)
+         (and (level3.proofp-aux a axioms thms atbl)
+              (level3.proof-listp-aux x axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level3.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level3.proofp-aux
+                (equal (booleanp (level3.proofp-aux x axioms thms atbl))
+                       t))
+         (t booleanp-of-level3.proof-listp-aux
+            (equal (booleanp (level3.proof-listp-aux x axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level3.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level3.proof-listp-aux (x axioms thms atbl)
+  (level3.proofp-aux x axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level3.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level3.step-okp)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'if atbl)) 3))
+  :thms ((proof logic.provablep-when-level3.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level3.proofp-aux x axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level3.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level3.proof-listp-aux x axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level3.proofp-aux))))
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level3.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level3.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level3.proofp-aux x axioms thms atbl)
+                                t)))
+         (t level3.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level3.proof-listp-aux x axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level3.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level3.proofp-aux-when-logic.proofp
+                    level3.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level3.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level3.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level3.proofp-aux (logic.provable-witness formula axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level3.proofp-aux-when-logic.proofp))))
+
+
+
+
+(definlined@ level3.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (and (@obligations level3.step-okp)
+       (equal (cdr (lookup 'not atbl)) 1)
+       (equal (cdr (lookup 'equal atbl)) 2)
+       (equal (cdr (lookup 'iff atbl)) 2)
+       (equal (cdr (lookup 'if atbl)) 3)
+       (level3.proofp-aux x axioms thms atbl)))
+
+(defthm booleanp-of-level3.proofp
+  (equal (booleanp (level3.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level3.proofp))))
+
+(defthm logic.provablep-when-level3.proofp
+  (implies (and (logic.appealp x)
+                (level3.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level3.proofp))))
+
+
+
+
+;; The reflective transition to Level 3.
+;;
+;; This is a particularly interesting transition because the generic subset
+;; builder can be used to replace a whole lot of other builders.
+
+(defund build.generic-subset-high (as bs proof)
+  (declare (xargs :guard (and (logic.formula-listp bs)
+                              (subsetp as bs)
+                              (consp as)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (logic.disjoin-formulas as)))))
+  (if (equal as bs)
+      ;; Important optimization since clause cleaning will apply this to each clause,
+      ;; and often clauses are unchanged.
+      proof
+    (logic.appeal 'build.generic-subset
+                  (logic.disjoin-formulas bs)
+                  (list proof)
+                  (list as bs))))
+
+(defund@ build.multi-expansion-high (x as)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp as)
+                              (@match (proof x A_i))
+                              (memberp (@formula A_i) as))))
+  (build.generic-subset-high (@formulas A_i) as x))
+
+(defund@ build.multi-or-expansion-step-high (base as)
+  (declare (xargs :guard (and (logic.appealp base)
+                              (logic.formula-listp as)
+                              (@match (proof base (v P Ai)))
+                              (memberp (@formula Ai) as))))
+  (build.generic-subset-high (@formulas P Ai) (cons (@formula P) as) base))
+
+(defund@ build.multi-or-expansion-high (base as)
+  (declare (xargs :guard (and (logic.appealp base)
+                              (logic.formula-listp as)
+                              (@match (proof base (v Ai Aj)))
+                              (memberp (@formula Ai) as)
+                              (memberp (@formula Aj) as))))
+  (build.generic-subset-high (@formulas Ai Aj) as base))
+
+(defund build.rev-disjunction-high (x proof)
+  (declare (xargs :guard (and (consp x)
+                              (logic.formula-listp x)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (logic.disjoin-formulas x)))))
+  (build.generic-subset-high x (fast-rev x) proof))
+
+(defund build.ordered-subset-high (sub sup proof)
+  (declare (xargs :guard (and (logic.formula-listp sup)
+                              (logic.appealp proof)
+                              (consp sub)
+                              (ordered-subsetp sub sup)
+                              (equal (logic.conclusion proof) (logic.disjoin-formulas sub)))))
+  (build.generic-subset-high sub sup proof))
+
+(defund build.disjoined-rev-disjunction-high (x proof)
+  (declare (xargs :guard (and (consp x)
+                              (logic.formula-listp x)
+                              (logic.appealp proof)
+                              (equal (logic.fmtype (logic.conclusion proof)) 'por*)
+                              (equal (logic.vrhs (logic.conclusion proof))
+                                     (logic.disjoin-formulas x)))))
+  (let ((P (logic.vlhs (logic.conclusion proof))))
+    (build.generic-subset-high (cons P x) (cons P (fast-rev x)) proof)))
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level4-help.lisp acl2-6.3/books/milawa/ACL2/levels/level4-help.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level4-help.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level4-help.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; BOZO delete this file, not needed anymore
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level4.lisp acl2-6.3/books/milawa/ACL2/levels/level4.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level4.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level4.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,362 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level3")
+(include-book "../rewrite/ccsteps")
+(include-book "../rewrite/traces/trace-arities")
+(include-book "../clauses/aux-split-support")
+(include-book "../clauses/aux-limsplit-bldr")
+(include-book "../clauses/if-lifting/casesplit-bldr")
+(include-book "../clauses/update-clause-bldr")
+(include-book "../clauses/compiler")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund level4.step-okp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ;; Clause basics
+     ((equal method 'clause.substitute-iff-into-literal-bldr)            (clause.substitute-iff-into-literal-bldr-okp x atbl))
+     ((equal method 'clause.disjoined-substitute-iff-into-literal-bldr)  (clause.disjoined-substitute-iff-into-literal-bldr-okp x atbl))
+     ((equal method 'clause.standardize-negative-term-bldr)              (clause.standardize-negative-term-bldr-okp x atbl))
+     ((equal method 'clause.standardize-double-negative-term-bldr)       (clause.standardize-double-negative-term-bldr-okp x atbl))
+
+     ;; Aux split
+     ((equal method 'clause.aux-split-double-negate-lemma1-bldr)         (clause.aux-split-double-negate-lemma1-bldr-okp x atbl))
+     ((equal method 'clause.aux-split-double-negate-lemma2-bldr)         (clause.aux-split-double-negate-lemma2-bldr-okp x atbl))
+     ((equal method 'clause.aux-split-positive-bldr)                     (clause.aux-split-positive-bldr-okp x atbl))
+     ((equal method 'clause.aux-split-positive-1-bldr)                   (clause.aux-split-positive-1-bldr-okp x atbl))
+     ((equal method 'clause.aux-split-positive-2-bldr)                   (clause.aux-split-positive-2-bldr-okp x atbl))
+     ((equal method 'clause.aux-split-negative-bldr)                     (clause.aux-split-negative-bldr-okp x atbl))
+     ((equal method 'clause.disjoined-aux-split-negative-bldr)           (clause.disjoined-aux-split-negative-bldr-okp x atbl))
+     ;((equal method 'clause.aux-split-negative-1-bldr)                   (clause.aux-split-negative-1-bldr-okp x))
+     ;((equal method 'clause.aux-split-negative-2-bldr)                   (clause.aux-split-negative-2-bldr-okp x))
+     ((equal method 'clause.aux-split-default-1-bldr)                    (clause.aux-split-default-1-bldr-okp x atbl))
+     ((equal method 'clause.aux-split-default-2-bldr)                    (clause.aux-split-default-2-bldr-okp x atbl))
+     ((equal method 'clause.limsplit-cutoff-bldr-nice)                   (clause.limsplit-cutoff-bldr-nice-okp x))
+
+     ;; Case splitting
+     ((equal method 'clause.cases-lemma1-bldr)                       (clause.cases-lemma1-bldr-okp x atbl))
+     ((equal method 'clause.disjoined-cases-lemma1-bldr)             (clause.disjoined-cases-lemma1-bldr-okp x atbl))
+
+     ;; Update clause
+     ((equal method 'clause.aux-update-clause-lemma1-bldr)               (clause.aux-update-clause-lemma1-bldr-okp x atbl))
+     ((equal method 'clause.aux-update-clause-lemma2-bldr)               (clause.aux-update-clause-lemma2-bldr-okp x atbl))
+     ((equal method 'clause.aux-update-clause-iff-lemma1-bldr)           (clause.aux-update-clause-iff-lemma1-bldr-okp x atbl))
+     ((equal method 'clause.aux-update-clause-iff-lemma2-bldr)           (clause.aux-update-clause-iff-lemma2-bldr-okp x atbl))
+
+     ;; Ccstep lemmas
+     ((equal method 'rw.ccstep-lemma-1)                                  (rw.ccstep-lemma-1-okp x atbl))
+     ((equal method 'rw.ccstep-lemma-2)                                  (rw.ccstep-lemma-2-okp x atbl))
+     ((equal method 'rw.ccstep-lemma-3)                                  (rw.ccstep-lemma-3-okp x atbl))
+     ((equal method 'rw.ccstep-lemma-4)                                  (rw.ccstep-lemma-4-okp x atbl))
+
+     ;; Clean clauses
+     ((equal method 'clause.obvious-term-bldr)                           (clause.obvious-term-bldr-okp x atbl))
+
+     ;; Eval
+     ((equal method 'eval-lemma-1-bldr)                                  (eval-lemma-1-bldr-okp x atbl))
+     ((equal method 'eval-lemma-2-bldr)                                  (eval-lemma-2-bldr-okp x atbl))
+
+     ;; Rewrite rules
+     ((equal method 'rw.compile-crewrite-rule-trace-lemma1)              (rw.compile-crewrite-rule-trace-lemma1-okp x thms atbl))
+     ((equal method 'rw.compile-crewrite-rule-trace-lemma2)              (rw.compile-crewrite-rule-trace-lemma2-okp x thms atbl))
+
+     ;; Factor
+     ((equal method 'clause.factor-bldr-lemma-1)                         (clause.factor-bldr-lemma-1-okp x atbl))
+     ((equal method 'clause.factor-bldr-lemma-2)                         (clause.factor-bldr-lemma-2-okp x atbl))
+
+     ;; Equal by args
+     ((equal method 'build.equal-by-args)                                (build.equal-by-args-okp x atbl))
+     ((equal method 'build.disjoined-equal-by-args)                      (build.disjoined-equal-by-args-okp x atbl))
+
+     ;; Compiling formulas
+     ((equal method 'clause.prove-arbitrary-formula-from-its-clause)
+      (clause.prove-arbitrary-formula-from-its-clause-okp x))
+
+     (t
+      (level3.step-okp x axioms thms atbl)))))
+
+(defobligations level4.step-okp
+  (clause.substitute-iff-into-literal-bldr
+   clause.disjoined-substitute-iff-into-literal-bldr
+   clause.standardize-negative-term-bldr
+   clause.standardize-double-negative-term-bldr
+
+   clause.aux-split-double-negate-lemma1-bldr
+   clause.aux-split-double-negate-lemma2-bldr
+   clause.aux-split-positive-bldr
+   clause.aux-split-positive-1-bldr
+   clause.aux-split-positive-2-bldr
+   clause.aux-split-negative-bldr
+   clause.disjoined-aux-split-negative-bldr
+;   clause.aux-split-negative-1-bldr
+;   clause.aux-split-negative-2-bldr
+   clause.aux-split-default-1-bldr
+   clause.aux-split-default-2-bldr
+   clause.limsplit-cutoff-bldr-nice-okp
+
+   clause.cases-lemma1-bldr
+   clause.disjoined-cases-lemma1-bldr
+
+   clause.aux-update-clause-lemma1-bldr
+   clause.aux-update-clause-lemma2-bldr
+   clause.aux-update-clause-iff-lemma1-bldr
+   clause.aux-update-clause-iff-lemma2-bldr
+
+   rw.ccstep-lemma-1
+   rw.ccstep-lemma-2
+   rw.ccstep-lemma-3
+   rw.ccstep-lemma-4
+
+   clause.obvious-term-bldr
+
+   eval-lemma-1-bldr
+   eval-lemma-2-bldr
+
+   rw.compile-crewrite-rule-trace-lemma1
+   rw.compile-crewrite-rule-trace-lemma2
+
+   clause.factor-bldr-lemma-1
+   clause.factor-bldr-lemma-2
+
+   build.equal-by-args
+   build.disjoined-equal-by-args
+
+   clause.prove-arbitrary-formula-from-its-clause
+
+   level3.step-okp))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable level4.step-okp)))
+
+ (defthm@ soundness-of-level4.step-okp
+   (implies (and (level4.step-okp x axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (@obligations level4.step-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level4.step-okp-when-level3.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level3.step-okp x axioms thms atbl)
+            (level4.step-okp x axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level3.step-okp level2.step-okp logic.appeal-step-okp))))
+
+ (defthm level4.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level4.step-okp x axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+(encapsulate
+ ()
+ (defund level4.flag-proofp-aux (flag x axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x)
+                                              (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level4.step-okp x axioms thms atbl)
+            (level4.flag-proofp-aux 'list (logic.subproofs x) axioms thms atbl))
+     (if (consp x)
+         (and (level4.flag-proofp-aux 'proof (car x) axioms thms atbl)
+              (level4.flag-proofp-aux 'list (cdr x) axioms thms atbl))
+       t)))
+
+ (definlined level4.proofp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level4.flag-proofp-aux 'proof x axioms thms atbl))
+
+ (definlined level4.proof-listp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level4.flag-proofp-aux 'list x axioms thms atbl))
+
+ (defthmd definition-of-level4.proofp-aux
+   (equal (level4.proofp-aux x axioms thms atbl)
+          (and (level4.step-okp x axioms thms atbl)
+               (level4.proof-listp-aux (logic.subproofs x) axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level4.proofp-aux level4.proof-listp-aux level4.flag-proofp-aux))))
+
+ (defthmd definition-of-level4.proof-listp-aux
+   (equal (level4.proof-listp-aux x axioms thms atbl)
+          (if (consp x)
+              (and (level4.proofp-aux (car x) axioms thms atbl)
+                   (level4.proof-listp-aux (cdr x) axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level4.proofp-aux level4.proof-listp-aux level4.flag-proofp-aux))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level4.proofp-aux))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition demo.proof-list)))))
+
+
+
+(defthm level4.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level4.proofp-aux x axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level4.proofp-aux))))
+
+(defthm level4.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level4.proof-listp-aux x axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level4.proof-listp-aux))))
+
+(defthm level4.proof-listp-aux-of-cons
+  (equal (level4.proof-listp-aux (cons a x) axioms thms atbl)
+         (and (level4.proofp-aux a axioms thms atbl)
+              (level4.proof-listp-aux x axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level4.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level4.proofp-aux
+                (equal (booleanp (level4.proofp-aux x axioms thms atbl))
+                       t))
+         (t booleanp-of-level4.proof-listp-aux
+            (equal (booleanp (level4.proof-listp-aux x axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level4.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level4.proof-listp-aux (x axioms thms atbl)
+  (level4.proofp-aux x axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level4.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level4.step-okp)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'if atbl)) 3))
+  :thms ((proof logic.provablep-when-level4.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level4.proofp-aux x axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level4.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level4.proof-listp-aux x axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level4.proofp-aux))))
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level4.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level4.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level4.proofp-aux x axioms thms atbl)
+                                t)))
+         (t level4.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level4.proof-listp-aux x axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level4.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level4.proofp-aux-when-logic.proofp
+                    level4.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level4.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level4.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level4.proofp-aux (logic.provable-witness formula axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level4.proofp-aux-when-logic.proofp))))
+
+
+
+(definlined@ level4.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (and (@obligations level4.step-okp)
+       (equal (cdr (lookup 'not atbl)) 1)
+       (equal (cdr (lookup 'equal atbl)) 2)
+       (equal (cdr (lookup 'iff atbl)) 2)
+       (equal (cdr (lookup 'if atbl)) 3)
+       (level4.proofp-aux x axioms thms atbl)))
+
+(defthm booleanp-of-level4.proofp
+  (equal (booleanp (level4.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level4.proofp))))
+
+(defthm logic.provablep-when-level4.proofp
+  (implies (and (logic.appealp x)
+                (level4.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level4.proofp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level5-help.lisp acl2-6.3/books/milawa/ACL2/levels/level5-help.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level5-help.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level5-help.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,44 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; BOZO this file isn't needed anymore, delete it
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level5.lisp acl2-6.3/books/milawa/ACL2/levels/level5.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level5.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level5.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,303 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level4")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund level5.step-okp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ((equal method 'rw.eqtrace-bldr)                                         (rw.eqtrace-bldr-okp x atbl))
+     ((equal method 'rw.eqtrace-contradiction-bldr)                           (rw.eqtrace-contradiction-bldr-okp x atbl))
+     ((equal method 'clause.update-clause-bldr)                               (clause.update-clause-bldr-okp x))
+     ((equal method 'clause.update-clause-iff-bldr)                           (clause.update-clause-iff-bldr-okp x))
+     ((equal method 'clause.disjoined-update-clause-bldr)                     (clause.disjoined-update-clause-bldr-okp x))
+     ((equal method 'build.lambda-pequal-by-args)                             (build.lambda-pequal-by-args-okp x atbl))
+     ((equal method 'build.disjoined-lambda-pequal-by-args)                   (build.disjoined-lambda-pequal-by-args-okp x atbl))
+     ((equal method 'clause.aux-split-negative-1-bldr)                        (clause.aux-split-negative-1-bldr-okp x atbl))
+     ((equal method 'clause.aux-split-negative-2-bldr)                        (clause.aux-split-negative-2-bldr-okp x atbl))
+     ((equal method 'rw.iff-implies-equal-if-specialcase-nil-bldr)            (rw.iff-implies-equal-if-specialcase-nil-bldr-okp x atbl))
+     ((equal method 'rw.iff-implies-iff-if-specialcase-nil-bldr)              (rw.iff-implies-iff-if-specialcase-nil-bldr-okp x atbl))
+     ((equal method 'rw.iff-implies-equal-if-specialcase-t-bldr)              (rw.iff-implies-equal-if-specialcase-t-bldr-okp x atbl))
+     ((equal method 'rw.iff-implies-iff-if-specialcase-t-bldr)                (rw.iff-implies-iff-if-specialcase-t-bldr-okp x atbl))
+     ((equal method 'rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr)  (rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr-okp x atbl))
+     ((equal method 'rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr)    (rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr-okp x atbl))
+     ((equal method 'rw.disjoined-iff-implies-equal-if-specialcase-t-bldr)    (rw.disjoined-iff-implies-equal-if-specialcase-t-bldr-okp x atbl))
+     ((equal method 'rw.disjoined-iff-implies-iff-if-specialcase-t-bldr)      (rw.disjoined-iff-implies-iff-if-specialcase-t-bldr-okp x atbl))
+     ((equal method 'rw.iff-implies-equal-if-bldr)                            (rw.iff-implies-equal-if-bldr-okp x atbl))
+     ((equal method 'rw.iff-implies-iff-if-bldr)                              (rw.iff-implies-iff-if-bldr-okp x atbl))
+     ((equal method 'rw.equal-of-if-x-y-y-bldr)                               (rw.equal-of-if-x-y-y-bldr-okp x atbl))
+     ((equal method 'rw.iff-of-if-x-y-y-bldr)                                 (rw.iff-of-if-x-y-y-bldr-okp x atbl))
+     ((equal method 'rw.disjoined-iff-implies-equal-if-bldr)                  (rw.disjoined-iff-implies-equal-if-bldr-okp x atbl))
+     ((equal method 'rw.disjoined-iff-implies-iff-if-bldr)                    (rw.disjoined-iff-implies-iff-if-bldr-okp x atbl))
+     ((equal method 'rw.disjoined-equal-of-if-x-y-y-bldr)                     (rw.disjoined-equal-of-if-x-y-y-bldr-okp x atbl))
+     ((equal method 'rw.disjoined-iff-of-if-x-y-y-bldr)                       (rw.disjoined-iff-of-if-x-y-y-bldr-okp x atbl))
+     (t
+      (level4.step-okp x axioms thms atbl)))))
+
+(defobligations level5.step-okp
+  (rw.eqtrace-bldr
+   rw.eqtrace-contradiction-bldr
+   clause.update-clause-bldr
+   clause.update-clause-iff-bldr
+   clause.disjoined-update-clause-bldr
+   build.lambda-pequal-by-args
+   build.disjoined-lambda-pequal-by-args
+   clause.aux-split-negative-1-bldr
+   clause.aux-split-negative-2-bldr
+   rw.iff-implies-equal-if-specialcase-nil-bldr
+   rw.iff-implies-iff-if-specialcase-nil-bldr
+   rw.iff-implies-equal-if-specialcase-t-bldr
+   rw.iff-implies-iff-if-specialcase-t-bldr
+   rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr
+   rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr
+   rw.disjoined-iff-implies-equal-if-specialcase-t-bldr
+   rw.disjoined-iff-implies-iff-if-specialcase-t-bldr
+   rw.iff-implies-equal-if-bldr
+   rw.iff-implies-iff-if-bldr
+   rw.equal-of-if-x-y-y-bldr
+   rw.iff-of-if-x-y-y-bldr
+   rw.disjoined-iff-implies-equal-if-bldr
+   rw.disjoined-iff-implies-iff-if-bldr
+   rw.disjoined-equal-of-if-x-y-y-bldr
+   rw.disjoined-iff-of-if-x-y-y-bldr
+   level4.step-okp))
+
+(encapsulate
+ ()
+ (local (in-theory (enable level5.step-okp)))
+
+ (defthm@ soundness-of-level5.step-okp
+   (implies (and (level5.step-okp x axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (mapp atbl)
+                             (@obligations level5.step-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level5.step-okp-when-level4.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level4.step-okp x axioms thms atbl)
+            (level5.step-okp x axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level4.step-okp level3.step-okp level2.step-okp logic.appeal-step-okp))))
+
+ (defthm level5.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level5.step-okp x axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+
+
+(encapsulate
+ ()
+ (defund level5.flag-proofp-aux (flag x axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x)
+                                              (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level5.step-okp x axioms thms atbl)
+            (level5.flag-proofp-aux 'list (logic.subproofs x) axioms thms atbl))
+     (if (consp x)
+         (and (level5.flag-proofp-aux 'proof (car x) axioms thms atbl)
+              (level5.flag-proofp-aux 'list (cdr x) axioms thms atbl))
+       t)))
+
+ (definlined level5.proofp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level5.flag-proofp-aux 'proof x axioms thms atbl))
+
+ (definlined level5.proof-listp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level5.flag-proofp-aux 'list x axioms thms atbl))
+
+ (defthmd definition-of-level5.proofp-aux
+   (equal (level5.proofp-aux x axioms thms atbl)
+          (and (level5.step-okp x axioms thms atbl)
+               (level5.proof-listp-aux (logic.subproofs x) axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level5.proofp-aux level5.proof-listp-aux level5.flag-proofp-aux))))
+
+ (defthmd definition-of-level5.proof-listp-aux
+   (equal (level5.proof-listp-aux x axioms thms atbl)
+          (if (consp x)
+              (and (level5.proofp-aux (car x) axioms thms atbl)
+                   (level5.proof-listp-aux (cdr x) axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level5.proofp-aux level5.proof-listp-aux level5.flag-proofp-aux))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level5.proofp-aux))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition demo.proof-list)))))
+
+
+
+(defthm level5.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level5.proofp-aux x axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level5.proofp-aux))))
+
+(defthm level5.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level5.proof-listp-aux x axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level5.proof-listp-aux))))
+
+(defthm level5.proof-listp-aux-of-cons
+  (equal (level5.proof-listp-aux (cons a x) axioms thms atbl)
+         (and (level5.proofp-aux a axioms thms atbl)
+              (level5.proof-listp-aux x axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level5.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level5.proofp-aux
+                (equal (booleanp (level5.proofp-aux x axioms thms atbl))
+                       t))
+         (t booleanp-of-level5.proof-listp-aux
+            (equal (booleanp (level5.proof-listp-aux x axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level5.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level5.proof-listp-aux (x axioms thms atbl)
+  (level5.proofp-aux x axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level5.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level5.step-okp)
+                   (mapp atbl)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'if atbl)) 3))
+  :thms ((proof logic.provablep-when-level5.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level5.proofp-aux x axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level5.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level5.proof-listp-aux x axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level5.proofp-aux))))
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level5.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level5.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level5.proofp-aux x axioms thms atbl)
+                                t)))
+         (t level5.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level5.proof-listp-aux x axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level5.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level5.proofp-aux-when-logic.proofp
+                    level5.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level5.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level5.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level5.proofp-aux (logic.provable-witness formula axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level5.proofp-aux-when-logic.proofp))))
+
+
+
+(definlined@ level5.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (and (@obligations level5.step-okp)
+       (mapp atbl)
+       (equal (cdr (lookup 'not atbl)) 1)
+       (equal (cdr (lookup 'equal atbl)) 2)
+       (equal (cdr (lookup 'iff atbl)) 2)
+       (equal (cdr (lookup 'if atbl)) 3)
+       (level5.proofp-aux x axioms thms atbl)))
+
+(defthm booleanp-of-level5.proofp
+  (equal (booleanp (level5.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level5.proofp))))
+
+(defthm logic.provablep-when-level5.proofp
+  (implies (and (logic.appealp x)
+                (level5.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level5.proofp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level6-help.lisp acl2-6.3/books/milawa/ACL2/levels/level6-help.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level6-help.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level6-help.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; bozo delete this file, it's not needed anymore
+
+
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level6.lisp acl2-6.3/books/milawa/ACL2/levels/level6.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level6.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level6.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,261 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level5")
+(include-book "../clauses/aux-split-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund level6.step-okp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ((equal method 'clause.simple-split-bldr)     (clause.simple-split-bldr-okp x atbl))
+     ((equal method 'clause.simple-limsplit-bldr)  (clause.simple-limsplit-bldr-okp x atbl))
+     ((equal method 'clause.factor-bldr)           (clause.factor-bldr-okp x atbl))
+     (t
+      (level5.step-okp x axioms thms atbl)))))
+
+(defobligations level6.step-okp
+  (clause.simple-split-bldr
+   clause.simple-limsplit-bldr
+   clause.factor-bldr
+   level5.step-okp))
+
+(encapsulate
+ ()
+ (local (in-theory (enable level6.step-okp)))
+
+ (defthm@ soundness-of-level6.step-okp
+   (implies (and (level6.step-okp x axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (mapp atbl)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (@obligations level6.step-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level6.step-okp-when-level5.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level5.step-okp x axioms thms atbl)
+            (level6.step-okp x axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level5.step-okp level4.step-okp level3.step-okp level2.step-okp logic.appeal-step-okp))))
+
+ (defthm level6.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level6.step-okp x axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+
+
+(encapsulate
+ ()
+ (defund level6.flag-proofp-aux (flag x axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x)
+                                              (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level6.step-okp x axioms thms atbl)
+            (level6.flag-proofp-aux 'list (logic.subproofs x) axioms thms atbl))
+     (if (consp x)
+         (and (level6.flag-proofp-aux 'proof (car x) axioms thms atbl)
+              (level6.flag-proofp-aux 'list (cdr x) axioms thms atbl))
+       t)))
+
+ (definlined level6.proofp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level6.flag-proofp-aux 'proof x axioms thms atbl))
+
+ (definlined level6.proof-listp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level6.flag-proofp-aux 'list x axioms thms atbl))
+
+ (defthmd definition-of-level6.proofp-aux
+   (equal (level6.proofp-aux x axioms thms atbl)
+          (and (level6.step-okp x axioms thms atbl)
+               (level6.proof-listp-aux (logic.subproofs x) axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level6.proofp-aux level6.proof-listp-aux level6.flag-proofp-aux))))
+
+ (defthmd definition-of-level6.proof-listp-aux
+   (equal (level6.proof-listp-aux x axioms thms atbl)
+          (if (consp x)
+              (and (level6.proofp-aux (car x) axioms thms atbl)
+                   (level6.proof-listp-aux (cdr x) axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level6.proofp-aux level6.proof-listp-aux level6.flag-proofp-aux))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level6.proofp-aux))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition demo.proof-list)))))
+
+
+
+(defthm level6.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level6.proofp-aux x axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level6.proofp-aux))))
+
+(defthm level6.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level6.proof-listp-aux x axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level6.proof-listp-aux))))
+
+(defthm level6.proof-listp-aux-of-cons
+  (equal (level6.proof-listp-aux (cons a x) axioms thms atbl)
+         (and (level6.proofp-aux a axioms thms atbl)
+              (level6.proof-listp-aux x axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level6.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level6.proofp-aux
+                (equal (booleanp (level6.proofp-aux x axioms thms atbl))
+                       t))
+         (t booleanp-of-level6.proof-listp-aux
+            (equal (booleanp (level6.proof-listp-aux x axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level6.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level6.proof-listp-aux (x axioms thms atbl)
+  (level6.proofp-aux x axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level6.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level6.step-okp)
+                   (mapp atbl)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'if atbl)) 3))
+  :thms ((proof logic.provablep-when-level6.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level6.proofp-aux x axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level6.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level6.proof-listp-aux x axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level6.proofp-aux))))
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level6.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level6.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level6.proofp-aux x axioms thms atbl)
+                                t)))
+         (t level6.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level6.proof-listp-aux x axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level6.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level6.proofp-aux-when-logic.proofp
+                    level6.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level6.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level6.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level6.proofp-aux (logic.provable-witness formula axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level6.proofp-aux-when-logic.proofp))))
+
+
+
+(definlined@ level6.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (and (@obligations level6.step-okp)
+       (mapp atbl)
+       (equal (cdr (lookup 'not atbl)) 1)
+       (equal (cdr (lookup 'equal atbl)) 2)
+       (equal (cdr (lookup 'iff atbl)) 2)
+       (equal (cdr (lookup 'if atbl)) 3)
+       (level6.proofp-aux x axioms thms atbl)))
+
+(defthm booleanp-of-level6.proofp
+  (equal (booleanp (level6.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level6.proofp))))
+
+(defthm logic.provablep-when-level6.proofp
+  (implies (and (logic.appealp x)
+                (level6.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level6.proofp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level7.lisp acl2-6.3/books/milawa/ACL2/levels/level7.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level7.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level7.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,262 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level6")
+(include-book "../clauses/split-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund level7.step-okp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ((equal method 'clause.split-bldr)     (clause.split-bldr-okp x atbl))
+     (t
+      (level6.step-okp x axioms thms atbl)))))
+
+(defobligations level7.step-okp
+  (clause.split-bldr
+   level6.step-okp))
+
+(encapsulate
+ ()
+ (local (in-theory (enable level7.step-okp)))
+
+ (defthm@ soundness-of-level7.step-okp
+   (implies (and (level7.step-okp x axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (mapp atbl)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (@obligations level7.step-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level7.step-okp-when-level6.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level6.step-okp x axioms thms atbl)
+            (level7.step-okp x axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level6.step-okp
+                                     level5.step-okp
+                                     level4.step-okp
+                                     level3.step-okp
+                                     level2.step-okp
+                                     logic.appeal-step-okp))))
+
+ (defthm level7.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level7.step-okp x axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+
+
+(encapsulate
+ ()
+ (defund level7.flag-proofp-aux (flag x axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x)
+                                              (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level7.step-okp x axioms thms atbl)
+            (level7.flag-proofp-aux 'list (logic.subproofs x) axioms thms atbl))
+     (if (consp x)
+         (and (level7.flag-proofp-aux 'proof (car x) axioms thms atbl)
+              (level7.flag-proofp-aux 'list (cdr x) axioms thms atbl))
+       t)))
+
+ (definlined level7.proofp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level7.flag-proofp-aux 'proof x axioms thms atbl))
+
+ (definlined level7.proof-listp-aux (x axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level7.flag-proofp-aux 'list x axioms thms atbl))
+
+ (defthmd definition-of-level7.proofp-aux
+   (equal (level7.proofp-aux x axioms thms atbl)
+          (and (level7.step-okp x axioms thms atbl)
+               (level7.proof-listp-aux (logic.subproofs x) axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level7.proofp-aux level7.proof-listp-aux level7.flag-proofp-aux))))
+
+ (defthmd definition-of-level7.proof-listp-aux
+   (equal (level7.proof-listp-aux x axioms thms atbl)
+          (if (consp x)
+              (and (level7.proofp-aux (car x) axioms thms atbl)
+                   (level7.proof-listp-aux (cdr x) axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level7.proofp-aux level7.proof-listp-aux level7.flag-proofp-aux))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level7.proofp-aux))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition demo.proof-list)))))
+
+
+
+(defthm level7.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level7.proofp-aux x axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level7.proofp-aux))))
+
+(defthm level7.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level7.proof-listp-aux x axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level7.proof-listp-aux))))
+
+(defthm level7.proof-listp-aux-of-cons
+  (equal (level7.proof-listp-aux (cons a x) axioms thms atbl)
+         (and (level7.proofp-aux a axioms thms atbl)
+              (level7.proof-listp-aux x axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level7.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level7.proofp-aux
+                (equal (booleanp (level7.proofp-aux x axioms thms atbl))
+                       t))
+         (t booleanp-of-level7.proof-listp-aux
+            (equal (booleanp (level7.proof-listp-aux x axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level7.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level7.proof-listp-aux (x axioms thms atbl)
+  (level7.proofp-aux x axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level7.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level7.step-okp)
+                   (mapp atbl)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'if atbl)) 3))
+  :thms ((proof logic.provablep-when-level7.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level7.proofp-aux x axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level7.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level7.proof-listp-aux x axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level7.proofp-aux))))
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level7.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level7.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level7.proofp-aux x axioms thms atbl)
+                                t)))
+         (t level7.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level7.proof-listp-aux x axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level7.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level7.proofp-aux-when-logic.proofp
+                    level7.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level7.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level7.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level7.proofp-aux (logic.provable-witness formula axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level7.proofp-aux-when-logic.proofp))))
+
+
+
+(definlined@ level7.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (and (@obligations level7.step-okp)
+       (mapp atbl)
+       (equal (cdr (lookup 'not atbl)) 1)
+       (equal (cdr (lookup 'equal atbl)) 2)
+       (equal (cdr (lookup 'iff atbl)) 2)
+       (equal (cdr (lookup 'if atbl)) 3)
+       (level7.proofp-aux x axioms thms atbl)))
+
+(defthm booleanp-of-level7.proofp
+  (equal (booleanp (level7.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level7.proofp))))
+
+(defthm logic.provablep-when-level7.proofp
+  (implies (and (logic.appealp x)
+                (level7.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level7.proofp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level8-help.lisp acl2-6.3/books/milawa/ACL2/levels/level8-help.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level8-help.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level8-help.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; oops
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level8.lisp acl2-6.3/books/milawa/ACL2/levels/level8.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level8.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level8.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,312 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level7")
+(include-book "../rewrite/ccstep-check")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund level8.step-okp (x defs axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (definition-listp defs)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ;; The ccstep-list-bldr is the most significant new step and subsumes compile-trace
+     ;; whenever crewrite is being used.  But we also add rw.compile-trace as a new rule,
+     ;; since, for example, urewrite builds traces but does not use ccsteps to rewrite the
+     ;; clauses.
+     ((equal method 'rw.ccstep-list-bldr)     (rw.ccstep-list-bldr-okp x defs thms atbl))
+     ((equal method 'rw.compile-trace)        (rw.compile-trace-okp x defs thms atbl))
+     (t
+      (level7.step-okp x axioms thms atbl)))))
+
+(defobligations level8.step-okp
+  (rw.compile-trace
+   rw.ccstep-list-bldr
+   level7.step-okp))
+
+(encapsulate
+ ()
+ (local (in-theory (enable level8.step-okp)))
+
+ (defthm@ soundness-of-level8.step-okp
+   (implies (and (level8.step-okp x defs axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.formula-list-atblp defs atbl)
+                             (definition-listp defs)
+                             (subsetp defs axioms)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (mapp atbl)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (@obligations level8.step-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level8.step-okp-when-level7.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level7.step-okp x axioms thms atbl)
+            (level8.step-okp x defs axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level7.step-okp
+                                     level6.step-okp
+                                     level5.step-okp
+                                     level4.step-okp
+                                     level3.step-okp
+                                     level2.step-okp
+                                     logic.appeal-step-okp))))
+
+ (defthm level8.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level8.step-okp x defs axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+
+
+(encapsulate
+ ()
+ (defund level8.flag-proofp-aux (flag x defs axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x) (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level8.step-okp x defs axioms thms atbl)
+            (level8.flag-proofp-aux 'list (logic.subproofs x) defs axioms thms atbl))
+     (if (consp x)
+         (and (level8.flag-proofp-aux 'proof (car x) defs axioms thms atbl)
+              (level8.flag-proofp-aux 'list (cdr x) defs axioms thms atbl))
+       t)))
+
+ (definlined level8.proofp-aux (x defs axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level8.flag-proofp-aux 'proof x defs axioms thms atbl))
+
+ (definlined level8.proof-listp-aux (x defs axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level8.flag-proofp-aux 'list x defs axioms thms atbl))
+
+ (defthmd definition-of-level8.proofp-aux
+   (equal (level8.proofp-aux x defs axioms thms atbl)
+          (and (level8.step-okp x defs axioms thms atbl)
+               (level8.proof-listp-aux (logic.subproofs x) defs axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level8.proofp-aux level8.proof-listp-aux level8.flag-proofp-aux))))
+
+ (defthmd definition-of-level8.proof-listp-aux
+   (equal (level8.proof-listp-aux x defs axioms thms atbl)
+          (if (consp x)
+              (and (level8.proofp-aux (car x) defs axioms thms atbl)
+                   (level8.proof-listp-aux (cdr x) defs axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level8.proofp-aux level8.proof-listp-aux level8.flag-proofp-aux))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level8.proofp-aux))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level8.proof-listp)))))
+
+
+
+(defthm level8.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level8.proofp-aux x defs axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level8.proofp-aux))))
+
+(defthm level8.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level8.proof-listp-aux x defs axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level8.proof-listp-aux))))
+
+(defthm level8.proof-listp-aux-of-cons
+  (equal (level8.proof-listp-aux (cons a x) defs axioms thms atbl)
+         (and (level8.proofp-aux a defs axioms thms atbl)
+              (level8.proof-listp-aux x defs axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level8.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level8.proofp-aux
+                (equal (booleanp (level8.proofp-aux x defs axioms thms atbl))
+                       t))
+         (t booleanp-of-level8.proof-listp-aux
+            (equal (booleanp (level8.proof-listp-aux x defs axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level8.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level8.proof-listp-aux (x defs axioms thms atbl)
+  (level8.proofp-aux x defs axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level8.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level8.step-okp)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'if atbl)) 3)
+                   (mapp atbl)
+                   (logic.formula-list-atblp defs atbl)
+                   (definition-listp defs)
+                   (subsetp defs axioms))
+  :thms ((proof logic.provablep-when-level8.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level8.proofp-aux x defs axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level8.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level8.proof-listp-aux x defs axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level8.proofp-aux))))
+
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level8.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level8.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level8.proofp-aux x defs axioms thms atbl)
+                                t)))
+         (t level8.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level8.proof-listp-aux x defs axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level8.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level8.proofp-aux-when-logic.proofp
+                    level8.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level8.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level8.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level8.proofp-aux (logic.provable-witness formula axioms thms atbl) defs axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level8.proofp-aux-when-logic.proofp))))
+
+
+
+
+(defund@ level8.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'level8.proofp)
+         (not subproofs)
+         (tuplep 2 extras)
+         (let ((defs (first extras))
+               (core (second extras)))
+           (and
+            ;; (1) General requirements for level8.
+            (@obligations level8.step-okp)
+            (mapp atbl)
+            (equal (cdr (lookup 'not atbl)) 1)
+            (equal (cdr (lookup 'equal atbl)) 2)
+            (equal (cdr (lookup 'iff atbl)) 2)
+            (equal (cdr (lookup 'if atbl)) 3)
+            ;; (2) Top-level check that the definitions are okay.
+            (definition-listp defs)
+            (logic.formula-list-atblp defs atbl)
+            (subsetp defs axioms)
+            ;; (3) Actual proof checking with defs pre-checked and included.
+            (logic.appealp core)
+            (equal conclusion (logic.conclusion core))
+            (level8.proofp-aux core defs axioms thms atbl))))))
+
+(defthm booleanp-of-level8.proofp
+  (equal (booleanp (level8.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level8.proofp))))
+
+(defthm logic.provablep-when-level8.proofp
+  (implies (and (logic.appealp x)
+                (level8.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (e/d (level8.proofp)
+                          (logic.provablep-when-level8.proofp-aux))
+          :use ((:instance logic.provablep-when-level8.proofp-aux
+                           (x    (second (logic.extras x)))
+                           (defs (first (logic.extras x))))))))
+
+
+
+(defun level8.adapter (proof defs initial-world all-worlds)
+  (declare (xargs :mode :program)
+           (ignore initial-world all-worlds))
+  (logic.appeal 'level8.proofp
+                (logic.conclusion proof)
+                nil
+                (list defs proof)))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/levels/level9.lisp acl2-6.3/books/milawa/ACL2/levels/level9.lisp
--- acl2-6.2/books/milawa/ACL2/levels/level9.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/levels/level9.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,397 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "level8")
+(include-book "../tactics/rewrite-world")
+(include-book "../tactics/world-check")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Essay on Theories and the Level 9 Adapter
+;;
+;; Developing high-level rewriter traces turns out to be somewhat difficult to
+;; do in an efficient way.
+;;
+;; The most straightforward thing to do would be to save the control structure
+;; used for the rewrite alongside of each term that was rewritten.  But the
+;; control structure includes the entire theory, which is generally quite
+;; large.  We really do not want to redundantly repeat a whole huge list of
+;; rewrite rules all the time, because then we would have to check them all the
+;; time.
+;;
+;; The adapter for rewrite traces addressed a similar problem with the list of
+;; definitions.  But theories are harder, because while the definitions don't
+;; change during the course of a proof, we're always adding and removing rules
+;; from theories or rewriting with different theories altogether.
+;;
+;; The first idea I had about addressing this was to introduce dynamic adapters
+;; which would allow you to change a theory on the fly as you descended into
+;; the proof.  This would require extending skeletons with annotations about
+;; the changes being made to theories, and altering %enable and %disable to
+;; actually affect skeletons when a skeleton is active.
+;;
+;; But this suggests a slightly different strategy.  Rather than complicate the
+;; level 9 proof checker with dynamically changing theories that it must pass
+;; around and handle, why not just preprocess the skeleton, gathering all the
+;; theories which will be used ahead of time and then refer back to them by
+;; name.  Then, nothing need be changed dynamically.  This approach also works
+;; for the noexec list, giving us very tight, simple urewrite traces.
+;;
+;; Of course, we still need a way to record the changes we've made to the
+;; theories we are using and present the level 9 proof checker with the list of
+;; theories we will be using.
+;;
+;; It was at this point that I moved a lot of previously "interface" code into
+;; the logic in the form of tactic.worldp, and developed the current system to
+;; update worlds using tactics that don't change the goals.  The worlds contain
+;; all of the flags and things that we need to generate the control structures
+;; being used at any given point.  And the whole collection of worlds can be
+;; generated from the initial world and the instructions in the tactics,
+;; themselves.  So this seems good, because it allows us to avoid repeating all
+;; of the rules over and over for each different world.
+;;
+;; But unfortunately, it seems hard to reconcile this dynamically changing
+;; world with our current high-level traces.  Consider that previously, every
+;; time we have installed a high-level builder we have done so by just
+;; "redefining" the existing ACL2 function, without making any changes to its
+;; interface.  But now we are talking about trying to get at the current list
+;; of worlds somehow.  I guess we really don't want to change urewrite or
+;; crewrite, but we certainly COULD try to change their tactics around a bit so
+;; that different information is recorded.  In particular, we should just
+;; record change the way their tactics work.
+;;
+;; Indeed, at the moment, the tactics don't contain any information about the
+;; current world they were developed in.  Rather, they expect that world to be
+;; passed in, implicitly.  We could change them pretty easily to take, rather
+;; than a world, a list of worlds, which have unique indexes so that the tactic
+;; knows which world to use.
+;;
+;; This seems really good in terms of a multi-level thing.  In the level 9
+;; proof checker, we can just record the entire list of worlds used.  But
+;; later, we will actually verify our tactic system, and we can stop storing
+;; the whole preprocessed list of worlds and just begin compiling them on the
+;; fly.
+
+
+(defund level9.step-okp (x worlds defs axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (tactic.world-listp worlds)
+                              (definition-listp defs)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method (logic.method x)))
+    (cond
+     ;; The ccstep-list-bldr is the most significant new step and subsumes compile-trace
+     ;; whenever crewrite is being used.  But we also add rw.compile-trace as a new rule,
+     ;; since, for example, urewrite builds traces but does not use ccsteps to rewrite the
+     ;; clauses.
+     ((equal method 'rw.world-urewrite-list-bldr) (rw.world-urewrite-list-bldr-okp x worlds atbl))
+     (t
+      (level8.step-okp x defs axioms thms atbl)))))
+
+(defobligations level9.step-okp
+  (rw.world-urewrite-list-bldr
+   level8.step-okp))
+
+(encapsulate
+ ()
+ (local (in-theory (enable level9.step-okp)))
+
+ (defthm@ soundness-of-level9.step-okp
+   (implies (and (level9.step-okp x worlds defs axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (tactic.world-listp worlds)
+                             (tactic.world-list-atblp worlds atbl)
+                             (tactic.world-list-env-okp worlds axioms thms)
+                             (logic.formula-list-atblp defs atbl)
+                             (definition-listp defs)
+                             (subsetp defs axioms)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (mapp atbl)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (@obligations level9.step-okp))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t)))
+
+ (defthm level9.step-okp-when-level8.step-okp
+   ;; This shows that our new step checker is "complete" in the sense that all
+   ;; previously acceptable appeals are still acceptable.
+   (implies (level8.step-okp x defs axioms thms atbl)
+            (level9.step-okp x worlds defs axioms thms atbl))
+   :hints(("Goal" :in-theory (enable level8.step-okp
+                                     level7.step-okp
+                                     level6.step-okp
+                                     level5.step-okp
+                                     level4.step-okp
+                                     level3.step-okp
+                                     level2.step-okp
+                                     logic.appeal-step-okp))))
+
+ (defthm level9.step-okp-when-not-consp
+   (implies (not (consp x))
+            (equal (level9.step-okp x worlds defs axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable logic.method)))))
+
+
+(encapsulate
+ ()
+ (defund level9.flag-proofp-aux (flag x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (if (equal flag 'proof)
+                                   (logic.appealp x)
+                                 (and (equal flag 'list)
+                                      (logic.appeal-listp x)))
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))
+                   :measure (two-nats-measure (rank x) (if (equal flag 'proof) 1 0))))
+   (if (equal flag 'proof)
+       (and (level9.step-okp x worlds defs axioms thms atbl)
+            (level9.flag-proofp-aux 'list (logic.subproofs x) worlds defs axioms thms atbl))
+     (if (consp x)
+         (and (level9.flag-proofp-aux 'proof (car x) worlds defs axioms thms atbl)
+              (level9.flag-proofp-aux 'list (cdr x) worlds defs axioms thms atbl))
+       t)))
+
+ (definlined level9.proofp-aux (x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (logic.appealp x)
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level9.flag-proofp-aux 'proof x worlds defs axioms thms atbl))
+
+ (definlined level9.proof-listp-aux (x worlds defs axioms thms atbl)
+   (declare (xargs :guard (and (logic.appeal-listp x)
+                               (tactic.world-listp worlds)
+                               (definition-listp defs)
+                               (logic.formula-listp axioms)
+                               (logic.formula-listp thms)
+                               (logic.arity-tablep atbl))))
+   (level9.flag-proofp-aux 'list x worlds defs axioms thms atbl))
+
+ (defthmd definition-of-level9.proofp-aux
+   (equal (level9.proofp-aux x worlds defs axioms thms atbl)
+          (and (level9.step-okp x worlds defs axioms thms atbl)
+               (level9.proof-listp-aux (logic.subproofs x) worlds defs axioms thms atbl)))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level9.proofp-aux level9.proof-listp-aux level9.flag-proofp-aux))))
+
+ (defthmd definition-of-level9.proof-listp-aux
+   (equal (level9.proof-listp-aux x worlds defs axioms thms atbl)
+          (if (consp x)
+              (and (level9.proofp-aux (car x) worlds defs axioms thms atbl)
+                   (level9.proof-listp-aux (cdr x) worlds defs axioms thms atbl))
+            t))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable level9.proofp-aux level9.proof-listp-aux level9.flag-proofp-aux))))
+
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level9.proofp-aux))))
+ (ACL2::theory-invariant (not (ACL2::active-runep '(:definition level9.proof-listp)))))
+
+
+
+(defthm level9.proofp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level9.proofp-aux x worlds defs axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-level9.proofp-aux))))
+
+(defthm level9.proof-listp-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (level9.proof-listp-aux x worlds defs axioms thms atbl)
+                  t))
+  :hints (("Goal" :in-theory (enable definition-of-level9.proof-listp-aux))))
+
+(defthm level9.proof-listp-aux-of-cons
+  (equal (level9.proof-listp-aux (cons a x) worlds defs axioms thms atbl)
+         (and (level9.proofp-aux a worlds defs axioms thms atbl)
+              (level9.proof-listp-aux x worlds defs axioms thms atbl)))
+  :hints (("Goal" :in-theory (enable definition-of-level9.proof-listp-aux))))
+
+(defthms-flag
+  :thms ((proof booleanp-of-level9.proofp-aux
+                (equal (booleanp (level9.proofp-aux x worlds defs axioms thms atbl))
+                       t))
+         (t booleanp-of-level9.proof-listp-aux
+            (equal (booleanp (level9.proof-listp-aux x worlds defs axioms thms atbl))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-level9.proofp-aux)
+          :induct (logic.appeal-induction flag x))))
+
+(deflist level9.proof-listp-aux (x worlds defs axioms thms atbl)
+  (level9.proofp-aux x worlds defs axioms thms atbl)
+  :already-definedp t)
+
+(defthms-flag
+  ;; We now prove that level9.proofp-aux is sound.  I.e., it only accepts appeals
+  ;; whose conclusions are provable in the sense of logic.proofp.
+  :@contextp t
+  :shared-hyp (and (@obligations level9.step-okp)
+                   (mapp atbl)
+                   (equal (cdr (lookup 'not atbl)) 1)
+                   (equal (cdr (lookup 'equal atbl)) 2)
+                   (equal (cdr (lookup 'iff atbl)) 2)
+                   (equal (cdr (lookup 'if atbl)) 3)
+                   (logic.formula-list-atblp defs atbl)
+                   (definition-listp defs)
+                   (subsetp defs axioms)
+                   (tactic.world-listp worlds)
+                   (tactic.world-list-atblp worlds atbl)
+                   (tactic.world-list-env-okp worlds axioms thms)
+                   )
+  :thms ((proof logic.provablep-when-level9.proofp-aux
+                (implies (and (logic.appealp x)
+                              (level9.proofp-aux x worlds defs axioms thms atbl))
+                         (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                                t)))
+         (t logic.provable-listp-when-level9.proof-listp-aux
+            (implies (and (logic.appeal-listp x)
+                          (level9.proof-listp-aux x worlds defs axioms thms atbl))
+                     (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-level9.proofp-aux))))
+
+
+(defthms-flag
+  ;; We also show that any proof accepted by logic.proofp is still accepted,
+  ;; i.e., level9.proofp-aux is "strictly more capable" than logic.proofp.
+  ;; THESE THEOREMS MUST BE LEFT DISABLED!
+  :thms ((proof level9.proofp-aux-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (level9.proofp-aux x worlds defs axioms thms atbl)
+                                t)))
+         (t level9.proof-listp-aux-when-logic.proof-listp
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (level9.proof-listp-aux x worlds defs axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.appeal-induction flag x)
+           :in-theory (enable definition-of-level9.proofp-aux
+                              definition-of-logic.proofp))))
+
+(in-theory (disable level9.proofp-aux-when-logic.proofp
+                    level9.proof-listp-aux-when-logic.proof-listp))
+
+(defthm forcing-level9.proofp-aux-of-logic.provable-witness
+  ;; Corollary: Suppose F is any provable formula.  Then, the witnessing
+  ;; proof of F is acceptable by level9.proofp-aux.
+  (implies (force (logic.provablep formula axioms thms atbl))
+           (equal (level9.proofp-aux (logic.provable-witness formula axioms thms atbl) worlds defs axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable level9.proofp-aux-when-logic.proofp))))
+
+
+;; The level 9 adapter trace will be named level9.proofp and will have, as its extras,
+;; a list of the form (defs worlds core).
+
+(defun@ level9.static-checksp (worlds defs axioms thms atbl)
+  ;; NOTE!  We leave this enabled!
+  (declare (xargs :guard (and (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (and (mapp atbl)
+       (@obligations level9.step-okp)
+       (equal (cdr (lookup 'not atbl)) 1)
+       (equal (cdr (lookup 'equal atbl)) 2)
+       (equal (cdr (lookup 'iff atbl)) 2)
+       (equal (cdr (lookup 'if atbl)) 3)
+       (definition-listp defs)
+       (logic.fast-arities-okp (logic.formula-list-arities defs nil) atbl)
+       (ordered-list-subsetp (mergesort defs) (mergesort axioms))
+       (tactic.world-listp worlds)
+       (tactic.fast-world-list-atblp worlds atbl)
+       (tactic.fast-world-list-env-okp worlds axioms thms)))
+
+(defund@ level9.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'level9.proofp)
+         (not subproofs)
+         (tuplep 3 extras)
+         (let ((defs   (first extras))
+               (worlds (second extras))
+               (core   (third extras)))
+           (and
+            (ACL2::time$ (level9.static-checksp worlds defs axioms thms atbl))
+            (logic.appealp core)
+            (equal conclusion (logic.conclusion core))
+            (level9.proofp-aux core worlds defs axioms thms atbl))))))
+
+(defthm booleanp-of-level9.proofp
+  (equal (booleanp (level9.proofp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable level9.proofp))))
+
+(defthm logic.provablep-when-level9.proofp
+  (implies (and (logic.appealp x)
+                (level9.proofp x axioms thms atbl))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (e/d (level9.proofp)
+                          (logic.provablep-when-level9.proofp-aux))
+          :use ((:instance logic.provablep-when-level9.proofp-aux
+                           (x      (third (logic.extras x)))
+                           (defs   (first (logic.extras x)))
+                           (worlds (second (logic.extras x))))))))
+
+(defun level9.adapter (proof defs initial-world all-worlds)
+  (declare (xargs :mode :program)
+           (ignore initial-world))
+  (logic.appeal 'level9.proofp
+                (logic.conclusion proof)
+                nil
+                (list defs all-worlds proof)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/logic/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/logic/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/logic/appeal-identity.lisp acl2-6.3/books/milawa/ACL2/logic/appeal-identity.lisp
--- acl2-6.2/books/milawa/ACL2/logic/appeal-identity.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/appeal-identity.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,159 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund logic.appeal-identity (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (if (consp x)
+      x
+    (cons nil nil)))
+
+(defthm logic.appeal-identity-under-iff
+  (iff (logic.appeal-identity x)
+       t)
+  :hints(("Goal" :in-theory (enable logic.appeal-identity))))
+
+(defthm logic.method-of-logic.appeal-identity
+  (equal (logic.method (logic.appeal-identity x))
+         (logic.method x))
+  :hints(("Goal" :in-theory (enable logic.method logic.appeal-identity))))
+
+(defthm logic.conclusion-of-logic.appeal-identity
+  (equal (logic.conclusion (logic.appeal-identity x))
+         (logic.conclusion x))
+  :hints(("Goal" :in-theory (enable logic.conclusion logic.appeal-identity))))
+
+(defthm logic.subproofs-of-logic.appeal-identity
+  (equal (logic.subproofs (logic.appeal-identity x))
+         (logic.subproofs x))
+  :hints(("Goal" :in-theory (enable logic.subproofs logic.appeal-identity))))
+
+(defthm logic.extras-of-logic.appeal-identity
+  (equal (logic.extras (logic.appeal-identity x))
+         (logic.extras x))
+  :hints(("Goal" :in-theory (enable logic.extras logic.appeal-identity))))
+
+(local (in-theory (disable forcing-true-listp-of-logic.subproofs)))
+
+(defthm logic.skip-okp-of-logic.appeal-identity
+  (equal (logic.skip-okp (logic.appeal-identity x) atbl)
+         (logic.skip-okp x atbl))
+  :hints(("Goal" :in-theory (enable logic.skip-okp))))
+
+(defthm logic.axiom-okp-of-logic.appeal-identity
+  (equal (logic.axiom-okp (logic.appeal-identity x) axioms atbl)
+         (logic.axiom-okp x axioms atbl))
+  :hints(("Goal" :in-theory (enable logic.axiom-okp))))
+
+(defthm logic.theorem-okp-of-logic.appeal-identity
+  (equal (logic.theorem-okp (logic.appeal-identity x) theorems atbl)
+         (logic.theorem-okp x theorems atbl))
+  :hints(("Goal" :in-theory (enable logic.theorem-okp))))
+
+(defthm logic.propositional-schema-okp-of-logic.appeal-identity
+  (equal (logic.propositional-schema-okp (logic.appeal-identity x) atbl)
+         (logic.propositional-schema-okp x atbl))
+  :hints(("Goal" :in-theory (e/d (logic.propositional-schema-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm logic.functional-equality-okp-of-logic.appeal-identity
+  (equal (logic.functional-equality-okp (logic.appeal-identity x) atbl)
+         (logic.functional-equality-okp x atbl))
+  :hints(("Goal" :in-theory (enable logic.functional-equality-okp))))
+
+(defthm logic.expansion-okp-of-logic.appeal-identity
+  (equal (logic.expansion-okp (logic.appeal-identity x) atbl)
+         (logic.expansion-okp x atbl))
+  :hints(("Goal" :in-theory (e/d (logic.expansion-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm logic.contraction-okp-of-logic.appeal-identity
+  (equal (logic.contraction-okp (logic.appeal-identity x))
+         (logic.contraction-okp x))
+  :hints(("Goal" :in-theory (enable logic.contraction-okp))))
+
+(defthm logic.associativity-okp-of-logic.appeal-identity
+  (equal (logic.associativity-okp (logic.appeal-identity x))
+         (logic.associativity-okp x))
+  :hints(("Goal" :in-theory (enable logic.associativity-okp))))
+
+(defthm logic.cut-okp-of-logic.appeal-identity
+  (equal (logic.cut-okp (logic.appeal-identity x))
+         (logic.cut-okp x))
+  :hints(("Goal" :in-theory (enable logic.cut-okp))))
+
+(defthm logic.instantiation-okp-of-logic.appeal-identity
+  (equal (logic.instantiation-okp (logic.appeal-identity x) atbl)
+         (logic.instantiation-okp x atbl))
+  :hints(("Goal" :in-theory (enable logic.instantiation-okp))))
+
+(defthm logic.beta-reduction-okp-of-logic.appeal-identity
+  (equal (logic.beta-reduction-okp (logic.appeal-identity x) atbl)
+         (logic.beta-reduction-okp x atbl))
+  :hints(("Goal" :in-theory (enable logic.beta-reduction-okp))))
+
+(defthm logic.induction-okp-of-logic.appeal-identity
+  (equal (logic.induction-okp (logic.appeal-identity x))
+         (logic.induction-okp x))
+  :hints(("Goal" :in-theory (enable logic.induction-okp))))
+
+(defthm logic.base-eval-okp-of-logic.appeal-identity
+  (equal (logic.base-eval-okp (logic.appeal-identity x) atbl)
+         (logic.base-eval-okp x atbl))
+  :hints(("Goal" :in-theory (e/d (logic.base-eval-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm logic.appeal-step-okp-of-logic.appeal-identity
+  (equal (logic.appeal-step-okp (logic.appeal-identity x) axioms thms atbl)
+         (logic.appeal-step-okp x axioms thms atbl))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appealp-of-logic.appeal-identity
+  (equal (logic.appealp (logic.appeal-identity x))
+         (logic.appealp x))
+  :hints(("Goal" :in-theory (enable logic.appeal-identity
+                                    definition-of-logic.appealp))))
+
+(defthm logic.proofp-of-logic.appeal-identity
+  (equal (logic.proofp (logic.appeal-identity x) axioms thms atbl)
+         (logic.proofp x axioms thms atbl))
+  :hints(("Goal" :use ((:instance definition-of-logic.proofp (x (logic.appeal-identity x)))
+                       (:instance definition-of-logic.proofp)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/arities-okp.lisp acl2-6.3/books/milawa/ACL2/logic/arities-okp.lisp
--- acl2-6.2/books/milawa/ACL2/logic/arities-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/arities-okp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,716 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Arity checking of large structures (e.g., worlds and traces) using simple
+;; functions in the logic.term-atblp style can become quite expensive.  That
+;; is, this approach is O(n*m) where n is the number of functions named in
+;; the structure, and m is the number of functions in the arity table.
+;;
+;; Since these structures often have repeated function names, we can
+;; drastically reduce n by first collecting up all a list of "obligations" --
+;; the function names encountered in the structure, paired with the number of
+;; arguments they have been given -- and then sorting it to remove duplicates.
+
+(defund logic.arities-okp (arities atbl)
+  (declare (xargs :guard (logic.arity-tablep atbl)))
+
+;; This function checks whether a list of collected up arities, which should be
+;; a list of (function-name . length) pairs, are all okay according to an arity
+;; table.
+;;
+;; We do not expect to actually run this function, and it is only a convenient
+;; definition for reasoning.  Instead, see below for logic.fast-arities-okp, an
+;; equivalent version that implements some important optimizations.
+
+  (if (consp arities)
+      (and (consp (car arities))
+           (equal (lookup (car (car arities)) atbl)
+                  (car arities))
+           (logic.arities-okp (cdr arities) atbl))
+    t))
+
+(defthm logic.arities-okp-when-not-consp
+  (implies (not (consp arities))
+           (equal (logic.arities-okp arities atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.arities-okp))))
+
+(defthm logic.arities-okp-of-cons
+  (equal (logic.arities-okp (cons a x) atbl)
+         (and (consp a)
+              (equal (lookup (car a) atbl) a)
+              (logic.arities-okp x atbl)))
+  :hints(("Goal" :in-theory (enable logic.arities-okp))))
+
+(defthm booleanp-of-logic.arities-okp
+  (equal (booleanp (logic.arities-okp arities atbl))
+         t)
+  :hints(("Goal" :induct (cdr-induction arities))))
+
+(defthm logic.arities-okp-of-list-fix
+  (equal (logic.arities-okp (list-fix x) atbl)
+         (logic.arities-okp x atbl))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.arities-okp-of-app
+  (equal (logic.arities-okp (app x y) atbl)
+         (and (logic.arities-okp x atbl)
+              (logic.arities-okp y atbl)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.arities-okp-of-rev
+  (equal (logic.arities-okp (rev x) atbl)
+         (logic.arities-okp x atbl))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.arities-okp-of-cdr
+  (implies (logic.arities-okp x atbl)
+           (equal (logic.arities-okp (cdr x) atbl)
+                  t)))
+
+(defthmd lemma-1-for-logic.arities-okp-when-subsetp
+  (implies (and (LOGIC.ARITIES-OKP x ATBL)
+                (memberp a x))
+           (consp a))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd lemma-2-for-logic.arities-okp-when-subsetp
+  (implies (and (logic.arities-okp x atbl)
+                (memberp a x))
+           (EQUAL (LOOKUP (FIRST a) ATBL)
+                  a))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.arities-okp-when-subsetp-1
+  (implies (and (subsetp x y)
+                (logic.arities-okp y atbl))
+           (equal (logic.arities-okp x atbl)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable lemma-1-for-logic.arities-okp-when-subsetp
+                             lemma-2-for-logic.arities-okp-when-subsetp))))
+
+(defthm logic.arities-okp-when-subsetp-2
+  (implies (and (logic.arities-okp y atbl)
+                (subsetp x y))
+           (equal (logic.arities-okp x atbl)
+                  t)))
+
+
+
+;; We are now ready for our fast version of logic.arities-okp.  We sort the
+;; collected obligations and also sort the arity table.  Then we can just use
+;; the ordered list subsetp check, which is O(n) instead of O(n^2) like
+;; ordinary subsetp, to perform the check.  Hence, our total time becomes O(n
+;; log_2 n) for the sorting.
+;;
+;; The most heavy optimization we can do is to sort both the obligations and
+;; also to sort the arity table.  This allows us to use an ordered list subset
+;; check, which is O(n) instead of O(n^2) like the ordinary subset routine, to
+;; perform the check.  Hence, the total time is essentially O( max (n log_2 n ,
+;; m log_2 m) ).
+;;
+;; In certain cases, it may be more expensive to sort the arity table than to
+;; perform the actual check.  To try to get a feel for this, we looked at how
+;; long it took to sort the arity table in the bare level10 directory.  Sorting
+;; it 1000 times took 5.37 seconds, so we are going to estimate the cost of
+;; mergesort-map at .005 seconds.
+;;
+;; (defconstant *atbl* (MILAWA::tactic.harness->atbl (w state)))
+;; (progn
+;;   (ccl::gc)
+;;   (time (loop for i fixnum from 1 to 1000
+;;               do
+;;               (MILAWA::mergesort-map *atbl*)))
+;;   nil)
+;;
+;; The question then is: when will using the ordered-subsetp check save us more
+;; than .005 seconds.  We can pick n objects that are "evenly spaced" through
+;; the arity table via every-nth-entry.
+;;
+;; (defun every-nth-entry-aux (n i x)
+;;   (declare (xargs :guard (and (natp n)
+;;                               (natp i))))
+;;   (if (not (consp x))
+;;       nil
+;;     (if (zp i)
+;;         (cons (car x)
+;;               (every-nth-entry-aux n n (cdr x)))
+;;       (every-nth-entry-aux n (- i 1) (cdr x)))))
+;;
+;; (defun every-nth-entry (n x)
+;;   (declare (xargs :guard (natp n)))
+;;   (every-nth-entry-aux n 0 x))
+;;
+;; Now, we can do some timing checks, such as shown below, varying the number
+;; of entries we take, to get some data.
+;;
+;; (defparameter *subset* nil)
+;; (progn
+;;   (ccl::gc)
+;;   (setf *subset* (every-nth-entry 8 *atbl*))
+;;   (format t "Length of subset is ~a.~%" (len *subset*))
+;;   (time (loop for i fixnum from 1 to 1000
+;;               do
+;;               (MILAWA::logic.arities-okp *subset* *atbl*)))
+;;   nil)
+;;
+;; We find the following results.
+;;
+;;   Length    Time     Time-per-call
+;;   154       3.46s    .0034
+;;   189       4.26s    .0042
+;;   212       4.76s    .0047
+;;   242       5.42s    .0054
+;;   283       6.37s    .0063
+;;
+;; So, as a rough heuristic, we will say that if there are at least 250
+;; functions to check, we'd prefer to do sort the atbl and do an ordered check.
+;; Otherwise, we'll just do the logic.arities-okp call.
+;;
+;; In the end, our check is as follows.
+
+(defund logic.fast-arities-okp (x atbl)
+  (declare (xargs :guard (logic.arity-tablep atbl)))
+  (let ((sorted-x (mergesort x)))
+    (if (len-over-250p sorted-x)
+        (ordered-list-subsetp (mergesort x)
+                              (mergesort-map atbl))
+      (logic.arities-okp sorted-x atbl))))
+
+
+
+;; Optimization Lemma #1.  Sorting the list of collected obligations, before we
+;; check them, does not affect the result.  This is a big improvement since our
+;; mergesort operation eats duplicates, and is O(n log_2 n) instead of O(n^2).
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthm logic.arities-okp-of-halve-list
+   (equal (logic.arities-okp x atbl)
+          (and (logic.arities-okp (car (halve-list x)) atbl)
+               (logic.arities-okp (cdr (halve-list x)) atbl)))
+   :rule-classes nil
+   :hints(("Goal"
+           :in-theory (disable halve-list-correct
+                               logic.arities-okp-of-list-fix
+                               logic.arities-okp-when-subsetp-1
+                               logic.arities-okp-when-subsetp-2)
+          :use ((:instance halve-list-correct)
+                (:instance logic.arities-okp-of-list-fix))))))
+
+(defthm logic.arities-okp-of-merge-lists
+  (equal (logic.arities-okp (merge-lists x y) atbl)
+         (and (logic.arities-okp x atbl)
+              (logic.arities-okp y atbl)))
+  :hints(("Goal"
+          :in-theory (e/d (merge-lists)
+                          (logic.arities-okp-when-subsetp-1
+                           logic.arities-okp-when-subsetp-2)))))
+
+(defthm logic.arities-okp-of-mergesort
+  (equal (logic.arities-okp (mergesort x) atbl)
+         (logic.arities-okp x atbl))
+  :hints(("Goal" :in-theory (enable mergesort))
+         ("Subgoal *1/3" :use ((:instance logic.arities-okp-of-halve-list)))))
+
+
+
+;; Optimization Lemma #2.  Sorting the arity table (using mergesort-map) does
+;; not affect the result.  This is mainly a lemma for our next optimization.
+
+(defthm logic.arities-okp-of-mergesort-map
+  (equal (logic.arities-okp x (mergesort-map atbl))
+         (logic.arities-okp x atbl))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+;; Optimization Lemma #3.  Logic.arities-okp can be replaced by an ordinary
+;; subset check, as long as the arity table has unique keys.  (And via our use
+;; of mergesort-map, we know that the keys are unique).
+
+(defthm mapp-of-cdr-when-mapp
+  (implies (mapp x)
+           (equal (mapp (cdr x))
+                  t))
+  :hints(("Goal" :in-theory (enable mapp))))
+
+(defthm memberp-of-nil-when-mapp
+  (implies (mapp x)
+           (equal (memberp nil x)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd lemma-1-for-logic.arities-okp-when-subsetp-of-unique-atbl
+  (implies (and (mapp x)
+                (uniquep (domain x))
+                (memberp a x))
+           (equal (lookup (first a) x)
+                  (cons-fix a)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd lemma-2-for-logic.arities-okp-when-subsetp-of-unique-atbl
+  (implies (subsetp (cdr x) y)
+           (equal (subsetp x y)
+                  (if (consp x)
+                      (memberp (car x) y)
+                    t))))
+
+(defthmd lemma-3-for-logic.arities-okp-when-subsetp-of-unique-atbl
+   (implies (and (equal (lookup key x) val)
+                 (mapp x)
+                 (consp val))
+            (equal (memberp val x)
+                   t))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd lemma-4-for-logic.arities-okp-when-subsetp-of-unique-atbl
+  (implies (and (memberp a x)
+                (mapp x))
+           (equal (consp a)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd logic.arities-okp-when-subsetp-of-unique-atbl
+  (implies (and (mapp atbl)
+                (uniquep (domain atbl)))
+           (equal (logic.arities-okp x atbl)
+                  (subsetp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable lemma-1-for-logic.arities-okp-when-subsetp-of-unique-atbl
+                             lemma-2-for-logic.arities-okp-when-subsetp-of-unique-atbl
+                             lemma-3-for-logic.arities-okp-when-subsetp-of-unique-atbl
+                             lemma-4-for-logic.arities-okp-when-subsetp-of-unique-atbl
+                             ))))
+
+
+;; Finally, we have the main correctness result for logic.fast-arities-okp.
+
+(defthm logic.fast-arities-okp-removal
+  (implies (force (mapp atbl))
+           (equal (logic.fast-arities-okp x atbl)
+                  (logic.arities-okp x atbl)))
+  :hints(("Goal"
+          :in-theory (enable logic.fast-arities-okp)
+          :use ((:instance logic.arities-okp-when-subsetp-of-unique-atbl
+                           (atbl (mergesort-map atbl))
+                           (x x))))))
+
+
+
+
+
+
+;; Now we move on to the matter of actually collecting the obligations.
+;;
+;; This can be done pretty efficiently using tail-recursive functions that just
+;; throw all of the obligations they find into an accumualtor.  But for
+;; reasoning, we also introduce slow functions based on app.  Handling terms is
+;; irritatingly verbose because of the mutual recursion, but after that it's
+;; not so bad.
+
+(defund logic.flag-slow-term-arities (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (and (equal flag 'list)
+                                (logic.term-listp x)))))
+  (if (equal flag 'term)
+      (cond ((logic.variablep x) nil)
+            ((logic.constantp x) nil)
+            ((logic.functionp x)
+             (let ((args (logic.function-args x)))
+               ;; This looks goofy, but it works out with the accumulator
+               ;; version so that we can make a tail call here.
+               (app (logic.flag-slow-term-arities 'list args)
+                    (list (cons (logic.function-name x)
+                                (fast-len args 0))))))
+            ((logic.lambdap x)
+             (let ((actuals (logic.lambda-actuals x))
+                   (body    (logic.lambda-body x)))
+               (app (logic.flag-slow-term-arities 'term body)
+                    (logic.flag-slow-term-arities 'list actuals))))
+            (t nil))
+    (if (consp x)
+        (app (logic.flag-slow-term-arities 'term (car x))
+             (logic.flag-slow-term-arities 'list (cdr x)))
+      nil)))
+
+(defund logic.slow-term-arities (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.flag-slow-term-arities 'term x))
+
+(defund logic.slow-term-list-arities (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (logic.flag-slow-term-arities 'list x))
+
+(defthmd definition-of-logic.slow-term-arities
+  (equal (logic.slow-term-arities x)
+         (cond ((logic.variablep x) nil)
+               ((logic.constantp x) nil)
+               ((logic.functionp x)
+                (let ((args (logic.function-args x)))
+                  (app (logic.slow-term-list-arities args)
+                       (list (cons (logic.function-name x)
+                                   (fast-len args 0))))))
+               ((logic.lambdap x)
+                (let ((actuals (logic.lambda-actuals x))
+                      (body    (logic.lambda-body x)))
+                  (app (logic.slow-term-arities body)
+                       (logic.slow-term-list-arities actuals))))
+               (t nil)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable logic.slow-term-arities
+                             logic.slow-term-list-arities)
+          :expand ((logic.flag-slow-term-arities 'term x)))))
+
+(defthmd definition-of-logic.slow-term-list-arities
+  (equal (logic.slow-term-list-arities x)
+         (if (consp x)
+             (app (logic.slow-term-arities (car x))
+                  (logic.slow-term-list-arities (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable logic.slow-term-arities
+                             logic.slow-term-list-arities)
+          :expand ((logic.flag-slow-term-arities 'list x)))))
+
+(defthm logic.flag-slow-term-arities-of-term
+  (equal (logic.flag-slow-term-arities 'term x)
+         (logic.slow-term-arities x))
+  :hints(("Goal" :in-theory (enable logic.slow-term-arities))))
+
+(defthm logic.flag-slow-term-arities-of-list
+  (equal (logic.flag-slow-term-arities 'list x)
+         (logic.slow-term-list-arities x))
+  :hints(("Goal" :in-theory (enable logic.slow-term-list-arities))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.slow-term-arities))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.slow-term-list-arities))))
+
+(defthm logic.slow-term-list-arities-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.slow-term-list-arities x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.slow-term-list-arities))))
+
+(defthm logic.slow-term-list-arities-of-cons
+  (equal (logic.slow-term-list-arities (cons a x))
+         (app (logic.slow-term-arities a)
+              (logic.slow-term-list-arities x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.slow-term-list-arities))))
+
+
+
+
+(defund logic.flag-term-arities (flag x acc)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (true-listp acc))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.variablep x) acc)
+            ((logic.constantp x) acc)
+            ((logic.functionp x)
+             (let ((args (logic.function-args x)))
+               (logic.flag-term-arities 'list args
+                                        (cons (cons (logic.function-name x)
+                                                    (fast-len args 0))
+                                              acc))))
+            ((logic.lambdap x)
+             (logic.flag-term-arities 'term
+                                      (logic.lambda-body x)
+                                      (logic.flag-term-arities 'list
+                                                               (logic.lambda-actuals x)
+                                                               acc)))
+            (t acc))
+    (if (consp x)
+        (logic.flag-term-arities 'term (car x)
+                                 (logic.flag-term-arities 'list (cdr x) acc))
+      acc)))
+
+(in-theory (enable (:induction logic.flag-term-arities)))
+
+(defund logic.term-arities (x acc)
+  (declare (xargs :guard (and (logic.termp x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (logic.flag-term-arities 'term x acc))
+
+(defund logic.term-list-arities (x acc)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (logic.flag-term-arities 'list x acc))
+
+(defthmd definition-of-logic.term-arities
+  (equal (logic.term-arities x acc)
+         (cond ((logic.variablep x) acc)
+               ((logic.constantp x) acc)
+               ((logic.functionp x)
+                (let ((args (logic.function-args x)))
+                  (logic.term-list-arities args
+                                           (cons (cons (logic.function-name x)
+                                                       (fast-len args 0))
+                                                 acc))))
+               ((logic.lambdap x)
+                (let ((actuals (logic.lambda-actuals x))
+                      (body    (logic.lambda-body x)))
+                  (logic.term-arities body
+                                      (logic.term-list-arities actuals acc))))
+               (t acc)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable logic.term-arities
+                             logic.term-list-arities)
+          :expand ((logic.flag-term-arities 'term x acc)))))
+
+(defthmd definition-of-logic.term-list-arities
+  (equal (logic.term-list-arities x acc)
+         (if (consp x)
+             (logic.term-arities (car x)
+                                 (logic.term-list-arities (cdr x) acc))
+           acc))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable logic.term-arities
+                             logic.term-list-arities)
+          :expand ((logic.flag-term-arities 'list x acc)))))
+
+(defthm logic.flag-term-arities-of-term
+  (equal (logic.flag-term-arities 'term x acc)
+         (logic.term-arities x acc))
+  :hints(("Goal" :in-theory (enable logic.term-arities))))
+
+(defthm logic.flag-term-arities-of-list
+  (equal (logic.flag-term-arities 'list x acc)
+         (logic.term-list-arities x acc))
+  :hints(("Goal" :in-theory (enable logic.term-list-arities))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-arities))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-list-arities))))
+
+(defthm logic.term-list-arities-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.term-list-arities x acc)
+                  acc))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-list-arities))))
+
+(defthm logic.term-list-arities-of-cons
+  (equal (logic.term-list-arities (cons a x) acc)
+         (logic.term-arities a (logic.term-list-arities x acc)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-list-arities))))
+
+
+(defthms-flag
+  :thms ((term true-listp-of-logic.slow-term-arities
+               (true-listp (logic.slow-term-arities x)))
+         (t true-listp-of-logic.slow-term-list-arities
+            (true-listp (logic.slow-term-list-arities x))))
+  :hints(("Goal"
+          :induct (logic.term-induction flag x)
+          :expand (logic.slow-term-arities x))))
+
+(defthms-flag
+  :thms ((term true-listp-of-logic.term-arities
+               (equal (true-listp (logic.term-arities x acc))
+                      (true-listp acc)))
+         (t true-listp-of-logic.term-list-arities
+            (equal (true-listp (logic.term-list-arities x acc))
+                   (true-listp acc))))
+  :hints(("Goal"
+          :induct (logic.flag-term-arities flag x acc)
+          :expand (logic.term-arities x acc))))
+
+(verify-guards logic.flag-term-arities)
+(verify-guards logic.term-arities)
+(verify-guards logic.term-list-arities)
+
+(defthms-flag
+  :shared-hyp (force (true-listp acc))
+  :thms ((term logic.term-arities-removal
+               (equal (logic.term-arities x acc)
+                      (app (logic.slow-term-arities x)
+                           acc)))
+         (t logic.term-list-arities-removal
+            (equal (logic.term-list-arities x acc)
+                   (app (logic.slow-term-list-arities x)
+                        acc))))
+  :hints(("Goal"
+          :induct (logic.flag-term-arities flag x acc)
+          :expand ((logic.term-arities x acc)
+                   (logic.slow-term-arities x)))))
+
+(defthmd lemma-2-for-logic.term-atblp-when-logic.arities-okp-of-logic.slow-term-arities
+  (implies (and (EQUAL n (CDR (LOOKUP NAME ATBL)))
+                (natp n))
+           (iff (lookup name atbl)
+                t)))
+
+(defthms-flag
+  :thms ((term logic.slow-term-arities-correct
+               (implies (force (logic.termp x))
+                        (equal (logic.arities-okp (logic.slow-term-arities x) atbl)
+                               (logic.term-atblp x atbl))))
+         (t logic.slow-term-list-arities-correct
+            (implies (force (logic.term-listp x))
+                     (equal (logic.arities-okp (logic.slow-term-list-arities x) atbl)
+                            (logic.term-list-atblp x atbl)))))
+  :hints(("Goal"
+          :in-theory (e/d (lemma-2-for-logic.term-atblp-when-logic.arities-okp-of-logic.slow-term-arities)
+                          (FORCING-LOGIC.TERM-LIST-ATBLP-OF-LOGIC.FUNCTION-ARGS
+                           FORCING-LOOKUP-OF-LOGIC.FUNCTION-NAME))
+          :induct (logic.term-induction flag x)
+          :expand ((logic.slow-term-arities x)
+                   (logic.term-atblp x atbl)))))
+
+
+
+
+;; We now move on to the rest of the structures we need to arity-check.
+
+(defund logic.slow-formula-arities (x)
+  (declare (xargs :guard (logic.formulap x)))
+  (let ((type (logic.fmtype x)))
+    (cond ((equal type 'por*)
+           (app (logic.slow-formula-arities (logic.vlhs x))
+                (logic.slow-formula-arities (logic.vrhs x))))
+          ((equal type 'pnot*)
+           (logic.slow-formula-arities (logic.~arg x)))
+          ((equal type 'pequal*)
+           (app (logic.slow-term-arities (logic.=lhs x))
+                (logic.slow-term-arities (logic.=rhs x))))
+          (t
+           nil))))
+
+(defund logic.formula-arities (x acc)
+  (declare (xargs :guard (and (logic.formulap x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (let ((type (logic.fmtype x)))
+    (cond ((equal type 'por*)
+           (logic.formula-arities (logic.vlhs x)
+                                  (logic.formula-arities (logic.vrhs x) acc)))
+          ((equal type 'pnot*)
+           (logic.formula-arities (logic.~arg x) acc))
+          ((equal type 'pequal*)
+           (logic.term-arities (logic.=lhs x)
+                               (logic.term-arities (logic.=rhs x) acc)))
+          (t
+           acc))))
+
+(defthm true-listp-of-logic.formula-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (logic.formula-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-arities))))
+
+(verify-guards logic.formula-arities)
+
+(defthm logic.formula-arities-removal
+  (implies (force (true-listp acc))
+           (equal (logic.formula-arities x acc)
+                  (app (logic.slow-formula-arities x) acc)))
+  :hints(("Goal" :in-theory (enable logic.formula-arities
+                                    logic.slow-formula-arities))))
+
+(defthm logic.slow-formula-arities-correct
+  (implies (force (logic.formulap x))
+           (equal (logic.arities-okp (logic.slow-formula-arities x) atbl)
+                  (logic.formula-atblp x atbl)))
+  :hints(("Goal"
+          :in-theory (e/d (logic.slow-formula-arities)
+                          (forcing-logic.formula-atblp-of-logic.~arg
+                           forcing-logic.formula-atblp-of-logic.vlhs
+                           forcing-logic.formula-atblp-of-logic.vrhs
+                           forcing-logic.term-atblp-of-logic.=lhs
+                           forcing-logic.term-atblp-of-logic.=rhs))
+          :expand (logic.formula-atblp x atbl))))
+
+
+
+(defund logic.slow-formula-list-arities (x)
+  (declare (xargs :guard (logic.formula-listp x)))
+  (if (consp x)
+      ;; Reverse order gives us a tail call in the fast version
+      (app (logic.slow-formula-list-arities (cdr x))
+           (logic.slow-formula-arities (car x)))
+    nil))
+
+(defund logic.formula-list-arities (x acc)
+  (declare (xargs :guard (and (logic.formula-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (logic.formula-list-arities (cdr x)
+                                  (logic.formula-arities (car x) acc))
+    acc))
+
+(defthm true-listp-of-logic.formula-list-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (logic.formula-list-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-list-arities))))
+
+(defthm logic.formula-list-arities-removal
+  (implies (force (true-listp acc))
+           (equal (logic.formula-list-arities x acc)
+                  (app (logic.slow-formula-list-arities x) acc)))
+  :hints(("Goal" :in-theory (enable logic.formula-list-arities
+                                    logic.slow-formula-list-arities))))
+
+(defthm logic.slow-formula-list-arities-correct
+  (implies (force (logic.formula-listp x))
+           (equal (logic.arities-okp (logic.slow-formula-list-arities x) atbl)
+                  (logic.formula-list-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((logic.formula-list-atblp x atbl)
+                   (logic.slow-formula-list-arities x)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/base-evaluator.lisp acl2-6.3/books/milawa/ACL2/logic/base-evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/logic/base-evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/base-evaluator.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,212 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund logic.initial-arity-table ()
+  ;; We create the arity table for the base functions.
+  (declare (xargs :guard t))
+  '((if . 3)
+    (equal . 2)
+    (consp . 1)
+    (cons . 2)
+    (car . 1)
+    (cdr . 1)
+    (symbolp . 1)
+    (symbol-< . 2)
+    (natp . 1)
+    (< . 2)
+    (+ . 2)
+    (- . 2)
+    ;(* . 2)
+    ;(floor . 2)
+    ;(mod . 2)
+    ;(expt . 2)
+    ;(bitwise-shl . 2)
+    ;(bitwise-shr . 2)
+    ;(bitwise-and . 2)
+    ;(bitwise-or . 2)
+    ;(bitwise-xor . 2)
+    ;(bitwise-nth . 2)
+    ))
+
+(defthm logic.arity-tablep-of-logic.initial-arity-table
+  (equal (logic.arity-tablep (logic.initial-arity-table))
+         t))
+
+(in-theory (disable (:executable-counterpart logic.initial-arity-table)))
+
+
+
+
+
+(defund logic.base-evaluablep (x)
+  ;; We decide if a term is of the form (f c1 ... cn), where f is one of the
+  ;; base functions, c1...cn are constants, and the arity of f is n.
+  (declare (xargs :guard (logic.termp x)))
+  (and (logic.functionp x)
+       (let ((fn   (logic.function-name x))
+             (args (logic.function-args x)))
+         (let ((entry (lookup fn (logic.initial-arity-table))))
+           (and entry
+                (logic.constant-listp args)
+                (tuplep (cdr entry) args))))))
+
+(defthm booleanp-of-logic.base-evaluablep
+  (equal (booleanp (logic.base-evaluablep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.base-evaluablep)
+                                 (forcing-lookup-of-logic.function-name
+                                  forcing-true-listp-of-logic.function-args)))))
+
+(defthm forcing-logic.functionp-when-logic.base-evaluablep
+  (implies (and (logic.base-evaluablep x)
+                (force (logic.termp x)))
+           (equal (logic.functionp x)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.base-evaluablep))))
+
+(defthm logic.constant-listp-of-logic.function-args-when-logic.base-evaluablep
+  (implies (and (logic.base-evaluablep x)
+                (force (logic.termp x)))
+           (equal (logic.constant-listp (logic.function-args x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.base-evaluablep logic.function-args))))
+
+(defthm lookup-logic.function-name-in-logic.initial-arity-table-when-logic.base-evaluablep
+  (implies (and (logic.base-evaluablep x)
+                (force (logic.termp x)))
+           (equal (lookup (logic.function-name x) (logic.initial-arity-table))
+                  (cons (logic.function-name x)
+                        (len (logic.function-args x)))))
+  :hints(("Goal" :in-theory (e/d (logic.base-evaluablep)
+                                 (forcing-lookup-of-logic.function-name)))))
+
+
+(defthmd lemma-for-logic.term-atblp-when-logic.base-evaluablep
+  (implies (and (logic.function-namep fn)
+                (memberp fn (domain (logic.initial-arity-table)))
+                (true-listp args)
+                (logic.constant-listp args)
+                (equal (len args) (cdr (lookup fn (logic.initial-arity-table)))))
+           (equal (logic.term-atblp (logic.function fn args) (logic.initial-arity-table))
+                  t)))
+
+(defthm logic.term-atblp-when-logic.base-evaluablep
+  (implies (and (logic.base-evaluablep term)
+                (force (logic.termp term)))
+           (equal (logic.term-atblp term (logic.initial-arity-table))
+                  t))
+  :hints(("Goal"
+          :in-theory (enable logic.base-evaluablep
+                             lemma-for-logic.term-atblp-when-logic.base-evaluablep)
+          :use ((:instance lemma-for-logic.term-atblp-when-logic.base-evaluablep
+                            (fn (logic.function-name term))
+                            (args (logic.function-args term)))))))
+
+
+(defthm logic.base-evaluablep-when-preliminary-fn-applied-to-constants
+  (implies (and (logic.function-namep fn)
+                (memberp fn (domain (logic.initial-arity-table)))
+                (true-listp args)
+                (logic.constant-listp args)
+                (equal (len args) (cdr (lookup fn (logic.initial-arity-table)))))
+           (equal (logic.base-evaluablep (logic.function fn args))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.base-evaluablep))))
+
+(defthm logic.base-evaluablep-of-logic.function-equal
+  (equal (logic.base-evaluablep (logic.function 'equal args))
+         (and (tuplep 2 args)
+              (logic.constant-listp args)))
+  :hints(("Goal" :in-theory (enable logic.base-evaluablep logic.initial-arity-table))))
+
+
+
+
+
+(defund logic.base-evaluator (x)
+  ;; We run a base function on its arguments and return the result as a quoted
+  ;; constant (i.e., a logic.constantp).
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.base-evaluablep x))))
+  (let ((fn   (logic.function-name x))
+        (vals (logic.unquote-list (logic.function-args x))))
+    (list 'quote
+          (cond ((equal fn 'if)          (if (first vals) (second vals) (third vals)))
+                ((equal fn 'equal)       (equal (first vals) (second vals)))
+                ((equal fn 'consp)       (consp (first vals)))
+                ((equal fn 'cons)        (cons (first vals) (second vals)))
+                ((equal fn 'car)         (car (first vals)))
+                ((equal fn 'cdr)         (cdr (first vals)))
+                ((equal fn 'symbolp)     (symbolp (first vals)))
+                ((equal fn 'symbol-<)    (symbol-< (first vals) (second vals)))
+                ((equal fn 'natp)        (natp (first vals)))
+                ((equal fn '<)           (< (first vals) (second vals)))
+                ((equal fn '+)           (+ (first vals) (second vals)))
+                ((equal fn '-)           (- (first vals) (second vals)))
+                ;((equal fn '*)           (* (first vals) (second vals)))
+                ;((equal fn 'expt)        (expt (first vals) (second vals)))
+                ;((equal fn 'floor)       (floor (first vals) (second vals)))
+                ;((equal fn 'mod)         (mod (first vals) (second vals)))
+                ;((equal fn 'bitwise-shl) (bitwise-shl (first vals) (second vals)))
+                ;((equal fn 'bitwise-shr) (bitwise-shr (first vals) (second vals)))
+                ;((equal fn 'bitwise-and) (bitwise-and (first vals) (second vals)))
+                ;((equal fn 'bitwise-or)  (bitwise-or (first vals) (second vals)))
+                ;((equal fn 'bitwise-xor) (bitwise-xor (first vals) (second vals)))
+                ;((equal fn 'bitwise-nth) (bitwise-xor (first vals) (second vals)))
+                ))))
+
+(defthm forcing-logic.constantp-of-logic.base-evaluator
+  (equal (logic.constantp (logic.base-evaluator term))
+         t)
+  :hints(("Goal" :in-theory (enable logic.initial-arity-table logic.base-evaluator))))
+
+(defthm forcing-logic.constantp-of-logic.base-evaluator-free
+  ;; BOZO move to base evaluator
+  (implies (equal free (logic.base-evaluator term))
+           (equal (logic.constantp free)
+                  t)))
+
+(defthm logic.base-evaluator-of-logic.function-equal
+  (equal (logic.base-evaluator (logic.function 'equal args))
+         (list 'quote (equal (logic.unquote (first args))
+                             (logic.unquote (second args)))))
+  :hints(("Goal" :in-theory (enable logic.base-evaluator))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/cert.acl2 acl2-6.3/books/milawa/ACL2/logic/cert.acl2
--- acl2-6.2/books/milawa/ACL2/logic/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/cert.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/logic/disjoin-formulas.lisp acl2-6.3/books/milawa/ACL2/logic/disjoin-formulas.lisp
--- acl2-6.2/books/milawa/ACL2/logic/disjoin-formulas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/disjoin-formulas.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,246 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (logic.disjoin-formulas x) takes a non-empty list of formulas, [A1,...,An],
+;; and produces their disjunction A1 v A2 v ... v An.
+
+(defund logic.disjoin-formulas (x)
+  (declare (xargs :guard (and (logic.formula-listp x)
+                              (consp x))))
+  (if (consp x)
+      (if (consp (cdr x))
+          (logic.por (car x)
+               (logic.disjoin-formulas (cdr x)))
+        (car x))
+    nil))
+
+(defthm logic.disjoin-formulas-when-singleton-list
+  (implies (and (consp x)
+                (not (consp (cdr x))))
+           (equal (logic.disjoin-formulas x)
+                  (car x)))
+  :hints(("Goal" :in-theory (enable logic.disjoin-formulas))))
+
+(defthm logic.disjoin-formulas-of-cons-onto-consp
+  (implies (consp x)
+           (equal (logic.disjoin-formulas (cons a x))
+                  (logic.por a (logic.disjoin-formulas x))))
+  :hints(("Goal" :in-theory (enable logic.disjoin-formulas))))
+
+(defthm logic.disjoin-formulas-of-list-fix
+  (equal (logic.disjoin-formulas (list-fix x))
+         (logic.disjoin-formulas x))
+  :hints(("Goal" :in-theory (e/d (logic.disjoin-formulas)
+                                 ;; wow yucky!
+                                 (forcing-equal-of-logic.por-rewrite
+                                  forcing-equal-of-logic.por-rewrite-two)))))
+
+(defthm forcing-logic.formulap-of-logic.disjoin-formulas
+  (implies (force (consp x))
+           (equal (logic.formulap (logic.disjoin-formulas x))
+                  (logic.formula-listp x)))
+  :hints(("Goal"
+          :in-theory (enable logic.disjoin-formulas
+                             logic.formulap-of-logic.por-expensive)
+          :induct (logic.disjoin-formulas x))))
+
+(defthm forcing-logic.formula-atblp-of-logic.disjoin-formulas
+  (implies (force (consp x))
+           (equal (logic.formula-atblp (logic.disjoin-formulas x) atbl)
+                  (logic.formula-list-atblp x atbl)))
+  :hints(("Goal"
+          :in-theory (enable logic.disjoin-formulas
+                             logic.formula-atblp-of-logic.por-expensive)
+          :induct (logic.disjoin-formulas x))))
+
+(defthm logic.formula-listp-when-logic.formulap-of-logic.disjoin-formulas-free
+  (implies (and (equal (logic.disjoin-formulas as) x)
+                (logic.formulap x))
+           (equal (logic.formula-listp as)
+                  t)))
+
+(defthm logic.formula-list-atblp-when-logic.formula-atblp-of-logic.disjoin-formulas-free
+  (implies (and (equal (logic.disjoin-formulas as) x)
+                (logic.formula-atblp x atbl))
+           (equal (logic.formula-list-atblp as atbl)
+                  t)))
+
+(defthm forcing-logic.fmtype-of-logic.disjoin-formulas
+  (implies (force (logic.formula-listp x))
+           (equal (logic.fmtype (logic.disjoin-formulas x))
+                  (if (consp (cdr x))
+                      'por*
+                    (logic.fmtype (car x)))))
+  :hints(("Goal" :in-theory (enable logic.disjoin-formulas))))
+
+(defthm forcing-logic.vlhs-of-logic.disjoin-formulas
+  (implies (force (logic.formula-listp x))
+           (equal (logic.vlhs (logic.disjoin-formulas x))
+                  (if (consp (cdr x))
+                      (car x)
+                    (logic.vlhs (car x)))))
+  :hints(("Goal" :in-theory (enable logic.disjoin-formulas))))
+
+(defthm forcing-logic.vrhs-of-logic.disjoin-formulas
+  (implies (force (logic.formula-listp x))
+           (equal (logic.vrhs (logic.disjoin-formulas x))
+                  (if (consp (cdr x))
+                      (logic.disjoin-formulas (cdr x))
+                    (logic.vrhs (car x)))))
+  :hints(("Goal" :in-theory (enable logic.disjoin-formulas))))
+
+
+(defthm forcing-logic.fmtype-of-logic.disjoin-formulas-free
+  ;; The odd syntaxp restriction prevents obscure rewriting loops that can be
+  ;; formed if free is ever instantiated with (car x).  Before adding this
+  ;; restriction, we actually found such a loop in Milawa's proof of
+  ;; equal-of-logic.disjoin-formulas-and-logic.disjoin-formulas-when-same-len.
+  (implies (and (equal free (logic.disjoin-formulas x))
+                (force (logic.formula-listp x))
+                (ACL2::syntaxp (not (equal free '(car x)))))
+           (equal (logic.fmtype free)
+                  (if (consp (cdr x))
+                      'por*
+                    (logic.fmtype (car x))))))
+
+(defthm forcing-logic.vlhs-of-logic.disjoin-formulas-free
+  (implies (and (equal free (logic.disjoin-formulas x))
+                (force (logic.formula-listp x)))
+           (equal (logic.vlhs free)
+                  (if (consp (cdr x))
+                      (car x)
+                    (logic.vlhs (car x))))))
+
+(defthm forcing-logic.vrhs-of-logic.disjoin-formulas-free
+  (implies (and (equal free (logic.disjoin-formulas x))
+                (force (logic.formula-listp x)))
+           (equal (logic.vrhs free)
+                  (if (consp (cdr x))
+                      (logic.disjoin-formulas (cdr x))
+                    (logic.vrhs (car x))))))
+
+
+
+(defthm forcing-logic.disjoin-formulas-of-two-element-list
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y))
+                (not (consp z)))
+           (equal (logic.disjoin-formulas (list* x y z))
+                  (logic.por x y))))
+
+(defthm equal-of-logic.disjoin-formulas-and-logic.disjoin-formulas-when-same-len
+  (implies (and (equal (len x) (len y))
+                (force (logic.formula-listp x))
+                (force (logic.formula-listp y)))
+           (equal (equal (logic.disjoin-formulas x)
+                         (logic.disjoin-formulas y))
+                  (equal (list-fix x)
+                         (list-fix y))))
+  :hints(("Goal"
+          :induct (cdr-cdr-induction x y)
+          :in-theory (enable logic.disjoin-formulas))))
+
+
+
+
+(defprojection
+  :list (logic.disjoin-each-formula-list x)
+  :element (logic.disjoin-formulas x)
+  :guard (and (logic.formula-list-listp x)
+              (cons-listp x))
+  :nil-preservingp t)
+
+(defthm forcing-logic.formula-listp-of-logic.disjoin-each-formula-list
+  (implies (force (cons-listp x))
+           (equal (logic.formula-listp (logic.disjoin-each-formula-list x))
+                  (logic.formula-list-listp x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.disjoin-each-formula-list
+  (implies (force (cons-listp x))
+           (equal (logic.formula-list-atblp (logic.disjoin-each-formula-list x) atbl)
+                  (logic.formula-list-list-atblp x atbl)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.disjoin-each-formula-list-of-listify-each
+  (equal (logic.disjoin-each-formula-list (listify-each x))
+         (list-fix x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+;; (encapsulate
+;;  ()
+;;  (local (in-theory (disable (:executable-counterpart ACL2::force))))
+
+;;  (defthmd logic.formula-atblp-of-logic.por-left-refution-dangerous
+;;    (implies (and (logic.formulap x)
+;;                  (logic.formulap y)
+;;                  (not (logic.formula-atblp y atbl)))
+;;             (equal (logic.formula-atblp (logic.por x y) atbl)
+;;                    nil))
+;;    :hints(("Goal" :in-theory (enable logic.formula-atblp))))
+
+;;  (defthmd logic.formula-atblp-of-logic.por-right-refution-dangerous
+;;    (implies (and (logic.formulap x)
+;;                  (logic.formulap y)
+;;                  (not (logic.formula-atblp x atbl)))
+;;             (equal (logic.formula-atblp (logic.por x y) atbl)
+;;                    nil))
+;;    :hints(("Goal" :in-theory (enable logic.formula-atblp))))
+
+;;  (defthmd logic.formula-atblp-of-disjoin-formulas-refutation-dangerous
+;;    (implies (and (logic.formula-listp x)
+;;                  (not (logic.formula-list-atblp x atbl)))
+;;             (equal (logic.formula-atblp (logic.disjoin-formulas x) atbl)
+;;                    nil))
+;;    :hints(("Goal" :in-theory (enable logic.disjoin-formulas
+;;                                      logic.formula-atblp-of-logic.por-left-refution-dangerous
+;;                                      logic.formula-atblp-of-logic.por-right-refution-dangerous))))
+
+;;  (defthmd logic.formula-list-atblp-backwards-through-disjoin-formulas-dangerous
+;;    (implies (and (logic.formula-listp x)
+;;                  (logic.formula-atblp (logic.disjoin-formulas x) atbl))
+;;             (logic.formula-list-atblp x atbl))
+;;    :hints(("Goal"
+;;            :in-theory (enable logic.formula-atblp-of-disjoin-formulas-refutation-dangerous)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/find-proof.lisp acl2-6.3/books/milawa/ACL2/logic/find-proof.lisp
--- acl2-6.2/books/milawa/ACL2/logic/find-proof.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/find-proof.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,122 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; BOZO implement a deffinder sort of macro?
+
+(defund logic.find-proof (a x)
+  ;; We return the first proof in x which concludes a, or nil if no such proof
+  ;; is present.
+  (declare (xargs :guard (and (logic.formulap a)
+                              (logic.appeal-listp x))))
+  (if (consp x)
+      (if (equal (logic.conclusion (car x)) a)
+          (car x)
+        (logic.find-proof a (cdr x)))
+    nil))
+
+
+(defthm logic.find-proof-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.find-proof a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.find-proof))))
+
+(defthm logic.find-proof-of-cons
+  (equal (logic.find-proof a (cons b x))
+         (if (equal (logic.conclusion b) a)
+             b
+           (logic.find-proof a x)))
+  :hints(("Goal" :in-theory (enable logic.find-proof))))
+
+(defthm logic.find-proof-of-list-fix
+  (equal (logic.find-proof a (list-fix x))
+         (logic.find-proof a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.find-proof-of-app
+  (implies (and (force (logic.appeal-listp x))
+                (force (logic.appeal-listp y)))
+           (equal (logic.find-proof a (app x y))
+                  (or (logic.find-proof a x)
+                      (logic.find-proof a y))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm conclusion-of-logic.find-proof
+  (implies (logic.find-proof a x)
+           (equal (logic.conclusion (logic.find-proof a x))
+                  a))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.find-proof-under-iff-when-memberp-of-logic.strip-conclusions
+  (implies (and (memberp a (logic.strip-conclusions x))
+                (force (logic.appeal-listp x)))
+           (iff (logic.find-proof a x)
+                t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-memberp-of-logic.strip-conclusions-when-logic.find-proof
+  (implies (and (logic.find-proof a x)
+                (force (logic.appeal-listp x)))
+           (equal (memberp a (logic.strip-conclusions x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.appealp-of-logic.find-proof
+  (implies (and (logic.find-proof a x)
+                (force (logic.appeal-listp x)))
+           (equal (logic.appealp (logic.find-proof a x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.proofp-of-logic.find-proof
+  (implies (and (logic.find-proof a x)
+                (force (logic.proof-listp x axioms thms atbl)))
+           (logic.proofp (logic.find-proof a x) axioms thms atbl))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defprojection :list (logic.find-proofs x proofs)
+               :element (logic.find-proof x proofs)
+               :guard (and (logic.formula-listp x)
+                           (logic.appeal-listp proofs)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/formula-size.lisp acl2-6.3/books/milawa/ACL2/logic/formula-size.lisp
--- acl2-6.2/books/milawa/ACL2/logic/formula-size.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/formula-size.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,163 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund logic.formula-size (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cond ((equal (car x) 'por*)
+             (+ 1
+                (+ (if (consp (cdr x))
+                       (logic.formula-size (second x))
+                     1)
+                   (if (and (consp (cdr x))
+                            (consp (cdr (cdr x))))
+                       (logic.formula-size (third x))
+                     1))))
+            ((equal (car x) 'pnot*)
+             (+ 1
+                (if (consp (cdr x))
+                    (logic.formula-size (second x))
+                  1)))
+            (t
+             (+ 1
+                (+ (if (consp (cdr x))
+                       (logic.formula-size (second x))
+                     1)
+                   (if (and (consp (cdr x))
+                            (consp (cdr (cdr x))))
+                       (logic.formula-size (third x))
+                     1)))))
+    1))
+
+(defthm natp-of-logic.formula-size
+  (natp (logic.formula-size x))
+  :hints(("Goal" :in-theory (e/d (logic.formula-size)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm logic.formula-size-nonzero
+  (equal (equal (logic.formula-size x) 0)
+         nil)
+  :hints(("Goal" :in-theory (enable logic.formula-size))))
+
+(defthm ordp-of-logic.formula-size
+  (equal (ordp (logic.formula-size x))
+         t))
+
+(defthm forcing-logic.formula-size-of-logic.=lhs
+  (implies (force (equal (logic.fmtype x) 'pequal*))
+           (equal (< (logic.formula-size (logic.=lhs x))
+                     (logic.formula-size x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.=lhs))))
+
+(defthm forcing-logic.formula-size-of-logic.=rhs
+  (implies (force (equal (logic.fmtype x) 'pequal*))
+           (equal (< (logic.formula-size (logic.=rhs x))
+                     (logic.formula-size x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.=rhs))))
+
+(defthm forcing-logic.formula-size-of-logic.~arg
+  (implies (force (equal (logic.fmtype x) 'pnot*))
+           (equal (< (logic.formula-size (logic.~arg x))
+                     (logic.formula-size x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.~arg))))
+
+(defthm forcing-logic.formula-size-of-logic.vlhs
+  (implies (force (equal (logic.fmtype x) 'por*))
+           (equal (< (logic.formula-size (logic.vlhs x))
+                     (logic.formula-size x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.vlhs))))
+
+(defthm forcing-logic.formula-size-of-logic.vrhs
+  (implies (force (equal (logic.fmtype x) 'por*))
+           (equal (< (logic.formula-size (logic.vrhs x))
+                     (logic.formula-size x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-size logic.fmtype logic.vrhs))))
+
+(defthm logic.formula-size-of-logic.pnot
+  (equal (logic.formula-size (logic.pnot x))
+         (+ 1 (logic.formula-size x)))
+  :hints(("Goal" :in-theory (enable logic.formula-size logic.pnot))))
+
+(defthm logic.formula-size-of-logic.por
+  (equal (logic.formula-size (logic.por x y))
+         (+ 1 (+ (logic.formula-size x) (logic.formula-size y))))
+  :hints(("Goal" :in-theory (enable logic.formula-size logic.por))))
+
+(defthm logic.formula-size-of-pequal
+  (equal (logic.formula-size (logic.pequal x y))
+         (+ 1 (+ (logic.formula-size x) (logic.formula-size y))))
+  :hints(("Goal" :in-theory (enable logic.formula-size logic.pequal))))
+
+
+
+(defund logic.formula-list-size (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (+ (logic.formula-size (car x))
+         (logic.formula-list-size (cdr x)))
+    0))
+
+(defthm logic.formula-list-size-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.formula-list-size x)
+                  0))
+  :hints(("Goal" :in-theory (enable logic.formula-list-size))))
+
+(defthm logic.formula-list-size-of-cons
+  (equal (logic.formula-list-size (cons a x))
+         (+ (logic.formula-size a)
+            (logic.formula-list-size x)))
+  :hints(("Goal" :in-theory (enable logic.formula-list-size))))
+
+(defthm natp-of-logic.formula-list-size
+  (equal (natp (logic.formula-list-size x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm ordp-of-logic.formula-list-size
+  (equal (ordp (logic.formula-list-size x))
+         t))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/formulas.lisp acl2-6.3/books/milawa/ACL2/logic/formulas.lisp
--- acl2-6.2/books/milawa/ACL2/logic/formulas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/formulas.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,873 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (logic.formulap x) recognizes the encoded formulas of our logic.
+;; Formulas are either:
+;;
+;;   - Equalities between terms t1 = t2, written as ('pequal* t1 t2),
+;;   - Negations of other formulas ~F, written as ('pnot* F), or
+;;   - Disjunctions of other formulas F v G, written as ('por* F G).
+
+(defund logic.formulap (x)
+  (declare (xargs :guard t))
+  (cond ((equal (first x) 'pequal*)
+         (and (tuplep 3 x)
+              (logic.termp (second x))
+              (logic.termp (third x))))
+        ((equal (first x) 'pnot*)
+         (and (tuplep 2 x)
+              (logic.formulap (second x))))
+        ((equal (first x) 'por*)
+         (and (tuplep 3 x)
+              (logic.formulap (second x))
+              (logic.formulap (third x))))
+        (t nil)))
+
+(defthm booleanp-of-logic.formulap
+  (equal (booleanp (logic.formulap x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.formulap))))
+
+(defthm logic.formulap-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.formulap x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.formulap))))
+
+(deflist logic.formula-listp (x)
+  (logic.formulap x)
+  :elementp-of-nil nil)
+
+(defthm forcing-logic.formula-listp-of-app
+  ;; BOZO, I prefer this more aggressive rule for app.  Maybe we want to add
+  ;; an :aggressivep flag to deflist to support this?
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.formula-listp y)))
+           (equal (logic.formula-listp (app x y))
+                  t)))
+
+(in-theory (disable logic.formula-listp-of-app))
+
+(defthm logic.formulap-of-second-when-logic.formula-listp
+  ;; BOZO consider adding something like this to deflist.
+  (implies (logic.formula-listp x)
+           (equal (logic.formulap (second x))
+                  (consp (cdr x)))))
+
+
+(defthm logic.formula-listp-of-ordered-subsetp
+  ;; BOZO consider reorganizing so that deflist can know about this
+  (implies (and (ordered-subsetp x y)
+                (logic.formula-listp y))
+           (equal (logic.formula-listp x)
+                  t)))
+
+
+(deflist logic.formula-list-listp (x)
+  (logic.formula-listp x)
+  :elementp-of-nil t)
+
+(defthm forcing-logic.formula-listp-of-simple-flatten
+  (implies (force (logic.formula-list-listp x))
+           (equal (logic.formula-listp (simple-flatten x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(encapsulate
+ ()
+ ;; Theorem: the formulas and terms are distinct.  This is true because we have
+ ;; required that the special symbols pequal*, pnot*, and por* are not allowed
+ ;; to be function names.
+ (defthm lemma-1-for-logic.formulap-when-logic.termp
+   (implies (logic.formulap x)
+            (or (equal (first x) 'pequal*)
+                (equal (first x) 'pnot*)
+                (equal (first x) 'por*)))
+   :rule-classes nil
+   :hints(("Goal" :in-theory (enable logic.formulap))))
+
+ (defthm lemma-2-for-logic.formulap-when-logic.termp
+   (implies (logic.termp x)
+            (or (not (first x))
+                (equal (first x) 'quote)
+                (logic.function-namep (first x))
+                (consp (first x))))
+   :rule-classes nil
+   :hints(("Goal"
+           :in-theory (e/d (definition-of-logic.termp logic.variablep logic.constantp)
+                           (logic.lambdap-when-not-anything-else-maybe-expensive)))))
+
+ (defthm logic.formulap-when-logic.termp
+   (implies (logic.termp x)
+            (equal (logic.formulap x)
+                   nil))
+   :hints(("Goal" :use ((:instance lemma-1-for-logic.formulap-when-logic.termp)
+                        (:instance lemma-2-for-logic.formulap-when-logic.termp))))))
+
+(defthm logic.termp-when-logic.formulap
+  (implies (logic.formulap x)
+           (equal (logic.termp x)
+                  nil)))
+
+
+
+(definlined logic.fmtype (x)
+  ;; Returns the type of the formula, i.e., pequal*, pnot*, or por*.
+  (declare (xargs :guard (logic.formulap x)
+                  :guard-hints(("Goal" :in-theory (enable logic.formulap)))))
+  (first x))
+
+
+
+(defthmd logic.fmtype-normalizer-cheap
+  ;; BOZO i am really doubting that we want this stupid rule.
+  ;; BOZO try to disable it
+  ;; BOZO trying to disable it; took it out of the Milawa model
+  ;;
+  ;; We occassionally write functions that need to consider what kind of formula
+  ;; they have been given.  Such functions might be written something like this:
+  ;;
+  ;; (cond ((equal (logic.fmtype x) 'por*) ...)
+  ;;       ((equal (logic.fmtype x) 'pnot*) ...)
+  ;;       (t ...))
+  ;;
+  ;; In this "otherwise" case, we would like to know that the logic.fmtype of x is
+  ;; actually 'pequal*.  (This will be true as long as we can show that x is a
+  ;; logic.formulap.)  Unfortunately, it's hard to actually get this to
+  ;; happen, because we usually see this as our goal:
+  ;;
+  ;; (implies (and (not (equal (logic.fmtype x) 'por*))
+  ;;               (not (equal (logic.fmtype x) 'pnot*))
+  ;;               ...)
+  ;;          ...)
+  ;;
+  ;; Unfortunately there is no easy way to target these hypotheses with a rewrite
+  ;; rule.  I call this the "logic.fmtype normalization problem" and discuss a few
+  ;; solutions to it in the file three-values.lisp found in the junk directory.
+  ;;
+  ;; I have not found any solution which is really acceptable for all cases.  So,
+  ;; I try to write such functions using the case structure above, that is, where
+  ;; the 'pequal* case is always the implicit one.  That way, we don't need to
+  ;; actually normalize the other cases, and we can get away with just the rule
+  ;; logic.fmtype-normalizer-cheap.
+  (implies (and (force (logic.formulap x))
+                (not (equal (logic.fmtype x) 'por*)))
+           (equal (equal (logic.fmtype x) 'pnot*)
+                  (not (equal (logic.fmtype x) 'pequal*))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.formulap logic.fmtype))))
+
+
+
+
+(definlined logic.pequal (a b)
+  ;; Constructs an equality formula, i.e., a = b
+  (declare (xargs :guard (and (logic.termp a)
+                              (logic.termp b))))
+  (list 'pequal* a b))
+
+(definlined logic.pnot (a)
+  ;; Constructs a negation formula, i.e., !a
+  (declare (xargs :guard (logic.formulap a)))
+  (list 'pnot* a))
+
+(definlined logic.por (a b)
+  ;; Constructs a disjunction formula, i.e., a v b
+  (declare (xargs :guard (and (logic.formulap a)
+                              (logic.formulap b))))
+  (list 'por* a b))
+
+(in-theory (disable (:e logic.pequal)))
+(in-theory (disable (:e logic.pnot)))
+(in-theory (disable (:e logic.por)))
+
+
+
+(defthm logic.pequal-under-iff
+  (iff (logic.pequal x y)
+       t)
+  :hints(("Goal" :in-theory (enable logic.pequal))))
+
+(defthm logic.pnot-under-iff
+  (iff (logic.pnot x)
+       t)
+  :hints(("Goal" :in-theory (enable logic.pnot))))
+
+(defthm logic.por-under-iff
+  (iff (logic.por x y)
+       t)
+  :hints(("Goal" :in-theory (enable logic.por))))
+
+
+
+(definlined logic.=lhs (x)
+  ;; Retrieves lhs from lhs = rhs.
+  (declare (xargs :guard (and (logic.formulap x)
+                              (equal (logic.fmtype x) 'pequal*))
+                  :guard-hints(("Goal" :in-theory (enable logic.formulap
+                                                          logic.fmtype)))))
+  (second x))
+
+(definlined logic.=rhs (x)
+  ;; Retrieves rhs from lhs = rhs.
+  (declare (xargs :guard (and (logic.formulap x)
+                              (equal (logic.fmtype x) 'pequal*))
+                  :guard-hints(("Goal" :in-theory (enable logic.formulap
+                                                          logic.fmtype)))))
+  (third x))
+
+(definlined logic.~arg (x)
+  ;; Retrieves F from !F.
+  (declare (xargs :guard (and (logic.formulap x)
+                              (equal (logic.fmtype x) 'pnot*))
+                  :guard-hints(("Goal" :in-theory (enable logic.formulap
+                                                          logic.fmtype)))))
+  (second x))
+
+(definlined logic.vlhs (x)
+  ;; Retrieves lhs from lhs v rhs.
+  (declare (xargs :guard (and (logic.formulap x)
+                              (equal (logic.fmtype x) 'por*))
+                  :guard-hints(("Goal" :in-theory (enable logic.formulap
+                                                          logic.fmtype)))))
+  (second x))
+
+(definlined logic.vrhs (x)
+  ;; Retrieves rhs from lhs v rhs.
+  (declare (xargs :guard (and (logic.formulap x)
+                              (equal (logic.fmtype x) 'por*))
+                  :guard-hints(("Goal" :in-theory (enable logic.formulap
+                                                          logic.fmtype)))))
+  (third x))
+
+
+
+
+
+;; Measure Theorems for Recursion on Formulas
+
+(defthm rank-of-logic.=lhs-strong
+  ;; BOZO we used to use case-split on all these rank-strong theormes;
+  ;; trying to get rid of it.
+  (implies (equal (logic.fmtype x) 'pequal*)
+           (equal (< (rank (logic.=lhs x)) (rank x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.=lhs logic.fmtype logic.formulap))))
+
+(defthm rank-of-logic.=rhs-strong
+  (implies (equal (logic.fmtype x) 'pequal*)
+           (equal (< (rank (logic.=rhs x)) (rank x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.=rhs logic.fmtype logic.formulap))))
+
+(defthm rank-of-logic.~arg-strong
+  (implies (equal (logic.fmtype x) 'pnot*)
+           (equal (< (rank (logic.~arg x)) (rank x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.~arg logic.fmtype logic.formulap))))
+
+(defthm rank-of-logic.vlhs-strong
+  (implies (equal (logic.fmtype x) 'por*)
+           (equal (< (rank (logic.vlhs x)) (rank x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.vlhs logic.fmtype logic.formulap))))
+
+(defthm rank-of-logic.vrhs-strong
+  (implies (equal (logic.fmtype x) 'por*)
+           (equal (< (rank (logic.vrhs x)) (rank x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.vrhs logic.fmtype logic.formulap))))
+
+
+
+(defthm rank-of-logic.pnot
+  (equal (rank (logic.pnot x))
+         (+ 2 (rank x)))
+  :hints(("Goal" :in-theory (enable logic.pnot))))
+
+(defthm rank-of-logic.pequal
+  (equal (rank (logic.pequal x y))
+         (+ 3 (+ (rank x) (rank y))))
+  :hints(("Goal" :in-theory (enable logic.pequal))))
+
+(defthm rank-of-logic.por
+  (equal (rank (logic.por x y))
+         (+ 3 (+ (rank x) (rank y))))
+  :hints(("Goal" :in-theory (enable logic.por))))
+
+
+
+
+(defthm forcing-logic.termp-of-logic.=lhs
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.termp (logic.=lhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formulap logic.fmtype logic.=lhs))))
+
+(defthm forcing-logic.termp-of-logic.=rhs
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.termp (logic.=rhs x))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.=rhs)
+                                 (forcing-logic.termp-of-logic.=lhs)))))
+
+(defthm forcing-logic.formulap-of-logic.~arg
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pnot*)))
+           (equal (logic.formulap (logic.~arg x))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.~arg)
+                                 (forcing-logic.termp-of-logic.=lhs
+                                  forcing-logic.termp-of-logic.=rhs)))))
+
+(defthm forcing-logic.formulap-of-logic.vlhs
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'por*)))
+           (equal (logic.formulap (logic.vlhs x))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.vlhs)
+                                 (forcing-logic.formulap-of-logic.~arg
+                                  forcing-logic.termp-of-logic.=rhs
+                                  forcing-logic.termp-of-logic.=lhs)))))
+
+(defthm forcing-logic.formulap-of-logic.vrhs
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'por*)))
+           (equal (logic.formulap (logic.vrhs x))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.vrhs)
+                                 (forcing-logic.formulap-of-logic.vlhs
+                                  forcing-logic.formulap-of-logic.~arg
+                                  forcing-logic.termp-of-logic.=rhs
+                                  forcing-logic.termp-of-logic.=lhs)))))
+
+(defthm forcing-logic.=lhs-under-iff
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (iff (logic.=lhs x)
+                t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.=lhs)))))
+
+(defthm forcing-logic.=rhs-under-iff
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (iff (logic.=rhs x)
+                t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.=rhs)))))
+
+(defthm forcing-logic.~arg-under-iff
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pnot*)))
+           (iff (logic.~arg x)
+                t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.~arg)))))
+
+(defthm forcing-logic.vlhs-under-iff
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'por*)))
+           (iff (logic.vlhs x)
+                t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.vlhs)))))
+
+(defthm forcing-logic.vrhs-under-iff
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'por*)))
+           (iff (logic.vrhs x)
+                t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.fmtype logic.vrhs)))))
+
+(defthm forcing-logic.formulap-of-logic.pequal
+  (implies (and (force (logic.termp a))
+                (force (logic.termp b)))
+           (equal (logic.formulap (logic.pequal a b))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.pequal)))))
+
+(defthm forcing-logic.formulap-of-logic.pnot
+  (implies (force (logic.formulap a))
+           (equal (logic.formulap (logic.pnot a))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.pnot logic.formulap)))))
+
+(defthm forcing-logic.formulap-of-logic.por
+  (implies (and (force (logic.formulap a))
+                (force (logic.formulap b)))
+           (equal (logic.formulap (logic.por a b))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formulap logic.por)))))
+
+
+(defthm logic.fmtype-of-logic.pequal
+  (equal (logic.fmtype (logic.pequal a b))
+         'pequal*)
+  :hints(("Goal" :in-theory (enable logic.fmtype logic.pequal))))
+
+(defthm logic.fmtype-of-logic.pnot
+  (equal (logic.fmtype (logic.pnot a))
+         'pnot*)
+  :hints(("Goal" :in-theory (enable logic.fmtype logic.pnot))))
+
+(defthm logic.fmtype-of-logic.por
+  (equal (logic.fmtype (logic.por a b))
+         'por*)
+  :hints(("Goal" :in-theory (enable logic.fmtype logic.por))))
+
+(defthm logic.=lhs-of-logic.pequal
+  (equal (logic.=lhs (logic.pequal a b))
+         a)
+  :hints(("Goal" :in-theory (enable logic.=lhs logic.pequal))))
+
+(defthm logic.=rhs-of-logic.pequal
+  (equal (logic.=rhs (logic.pequal a b))
+         b)
+  :hints(("Goal" :in-theory (enable logic.=rhs logic.pequal))))
+
+(defthm logic.~arg-of-logic.pnot
+  (equal (logic.~arg (logic.pnot a))
+         a)
+  :hints(("Goal" :in-theory (enable logic.~arg logic.pnot))))
+
+(defthm logic.vlhs-of-logic.por
+  (equal (logic.vlhs (logic.por a b))
+         a)
+  :hints(("Goal" :in-theory (enable logic.vlhs logic.por))))
+
+(defthm logic.vrhs-of-logic.por
+  (equal (logic.vrhs (logic.por a b))
+         b)
+  :hints(("Goal" :in-theory (enable logic.vrhs logic.por))))
+
+(defthm logic.=lhs-of-logic.pequal-free
+  (implies (equal x (logic.pequal lhs rhs))
+           (equal (logic.=lhs x)
+                  lhs)))
+
+(defthm logic.=rhs-of-logic.pequal-free
+  (implies (equal x (logic.pequal lhs rhs))
+           (equal (logic.=rhs x)
+                  rhs)))
+
+(defthm logic.fmtype-of-logic.pequal-free
+  (implies (equal x (logic.pequal lhs rhs))
+           (equal (logic.fmtype x)
+                  'pequal*)))
+
+
+
+
+
+(defthm forcing-equal-of-logic.pequal-rewrite
+  (implies (and (force (logic.termp a))
+                (force (logic.termp b)))
+           (equal (equal (logic.pequal a b) x)
+                  (and (logic.formulap x)
+                       (equal (logic.fmtype x) 'pequal*)
+                       (equal (logic.=lhs x) a)
+                       (equal (logic.=rhs x) b))))
+  :hints(("Goal" :in-theory (enable logic.formulap tuplep logic.fmtype logic.pequal
+                                    logic.=lhs logic.=rhs))))
+
+(defthm forcing-equal-of-logic.pequal-rewrite-two
+  (implies (and (force (logic.termp a))
+                (force (logic.termp b)))
+           (equal (equal x (logic.pequal a b))
+                  (and (logic.formulap x)
+                       (equal (logic.fmtype x) 'pequal*)
+                       (equal (logic.=lhs x) a)
+                       (equal (logic.=rhs x) b)))))
+
+(defthm forcing-equal-of-logic.pnot-rewrite
+  (implies (force (logic.formulap a))
+           (equal (equal (logic.pnot a) x)
+                  (and (logic.formulap x)
+                       (equal (logic.fmtype x) 'pnot*)
+                       (equal (logic.~arg x) a))))
+  :hints(("Goal" :in-theory (enable logic.formulap
+                                    tuplep logic.fmtype logic.pnot logic.~arg))))
+
+(defthm forcing-equal-of-logic.pnot-rewrite-two
+  (implies (force (logic.formulap a))
+           (equal (equal x (logic.pnot a))
+                  (and (logic.formulap x)
+                       (equal (logic.fmtype x) 'pnot*)
+                       (equal (logic.~arg x) a)))))
+
+(defthm forcing-equal-of-logic.por-rewrite
+  (implies (and (force (logic.formulap a))
+                (force (logic.formulap b)))
+           (equal (equal (logic.por a b) x)
+                  (and (logic.formulap x)
+                       (equal (logic.fmtype x) 'por*)
+                       (equal (logic.vlhs x) a)
+                       (equal (logic.vrhs x) b))))
+  :hints(("Goal" :in-theory (enable logic.formulap
+                                    tuplep logic.fmtype logic.vlhs logic.vrhs logic.por))))
+
+(defthm forcing-equal-of-logic.por-rewrite-two
+  (implies (and (force (logic.formulap a))
+                (force (logic.formulap b)))
+           (equal (equal x (logic.por a b))
+                  (and (logic.formulap x)
+                       (equal (logic.fmtype x) 'por*)
+                       (equal (logic.vlhs x) a)
+                       (equal (logic.vrhs x) b)))))
+
+
+(defthm aggressive-equal-of-logic.pors
+  (implies (and (equal (logic.fmtype x) 'por*)
+                (equal (logic.fmtype y) 'por*)
+                (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (equal x y)
+                  (and (equal (logic.vlhs x) (logic.vlhs y))
+                       (equal (logic.vrhs x) (logic.vrhs y)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.formulap logic.fmtype logic.vlhs logic.vrhs))))
+
+(defthm aggressive-equal-of-logic.pnots
+  (implies (and (equal (logic.fmtype x) 'pnot*)
+                (equal (logic.fmtype y) 'pnot*)
+                (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (equal x y)
+                  (equal (logic.~arg x) (logic.~arg y))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.formulap logic.fmtype logic.~arg))))
+
+(defthm aggressive-equal-of-logic.pequals
+  (implies (and (equal (logic.fmtype x) 'pequal*)
+                (equal (logic.fmtype y) 'pequal*)
+                (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (equal x y)
+                  (and (equal (logic.=lhs x) (logic.=lhs y))
+                       (equal (logic.=rhs x) (logic.=rhs y)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.formulap logic.fmtype logic.=lhs logic.=rhs))))
+
+
+
+
+(defthm forcing-logic.pnot-of-logic.~arg
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pnot*)))
+           (equal (logic.pnot (logic.~arg x))
+                  x)))
+
+(defthm forcing-logic.por-of-logic.vlhs-and-logic.vrhs
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'por*)))
+           (equal (logic.por (logic.vlhs x) (logic.vrhs x))
+                  x)))
+
+(defthm forcing-logic.pequal-of-logic.=lhs-and-logic.=rhs
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.pequal (logic.=lhs x) (logic.=rhs x))
+                  x)))
+
+
+
+(defthm equal-logic.pequal-logic.pequal-rewrite
+  (equal (equal (logic.pequal a b) (logic.pequal c d))
+         (and (equal a c)
+              (equal b d)))
+  :hints(("Goal" :in-theory (enable logic.pequal))))
+
+(defthm equal-logic.pnot-logic.pnot-rewrite
+  (equal (equal (logic.pnot a) (logic.pnot b))
+         (equal a b))
+  :hints(("Goal" :in-theory (enable logic.pnot))))
+
+(defthm equal-logic.por-logic.por-rewrite
+  (equal (equal (logic.por a b) (logic.por c d))
+         (and (equal a c)
+              (equal b d)))
+  :hints(("Goal" :in-theory (enable logic.por))))
+
+
+
+;; These rules fix some problems with overly aggressive forcing which arise in
+;; bizarre cases.
+
+(defthm logic.formulap-of-logic.pequal-of-nil-one
+  (equal (logic.formulap (logic.pequal nil x))
+         nil)
+  :hints(("Goal" :in-theory (enable logic.formulap logic.pequal))))
+
+(defthm logic.formulap-of-logic.pequal-of-nil-two
+  (equal (logic.formulap (logic.pequal x nil))
+         nil)
+  :hints(("Goal" :in-theory (enable logic.formulap logic.pequal))))
+
+(defthm logic.formulap-of-logic.pnot-of-logic.pequal-of-nil-one
+  (equal (logic.formulap (logic.pnot (logic.pequal nil x)))
+         nil)
+  :hints(("Goal" :in-theory (enable logic.formulap logic.pnot))))
+
+(defthm logic.formulap-of-logic.pnot-of-logic.pequal-of-nil-two
+  (equal (logic.formulap (logic.pnot (logic.pequal x nil)))
+         nil)
+  :hints(("Goal" :in-theory (enable logic.formulap logic.pnot))))
+
+
+
+
+
+(defthmd logic.formulap-of-logic.por-expensive
+  (equal (logic.formulap (logic.por x y))
+         (and (logic.formulap x)
+              (logic.formulap y)))
+  :hints(("Goal" :in-theory (enable logic.formulap logic.por))))
+
+
+
+
+(defund logic.formula-atblp (x atbl)
+  (declare (xargs :guard (and (logic.formulap x)
+                              (logic.arity-tablep atbl))))
+  (let ((type (logic.fmtype x)))
+    (cond ((equal type 'por*)
+           (and (logic.formula-atblp (logic.vlhs x) atbl)
+                (logic.formula-atblp (logic.vrhs x) atbl)))
+          ((equal type 'pnot*)
+           (logic.formula-atblp (logic.~arg x) atbl))
+          ((equal type 'pequal*)
+           (and (logic.term-atblp (logic.=lhs x) atbl)
+                (logic.term-atblp (logic.=rhs x) atbl)))
+          (t nil))))
+
+(defthm booleanp-of-logic.formula-atblp
+  (equal (booleanp (logic.formula-atblp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.formula-atblp)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm logic.formula-atblp-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.formula-atblp x atbl)
+                  nil))
+  ;; We're a little sloppy here and just allow fmtype to open up
+  :hints(("Goal" :in-theory (enable logic.formula-atblp logic.fmtype))))
+
+(deflist logic.formula-list-atblp (x atbl)
+  (logic.formula-atblp x atbl)
+  :elementp-of-nil nil
+  :guard (and (logic.formula-listp x)
+              (logic.arity-tablep atbl)))
+
+(defthm forcing-logic.formula-list-atblp-of-app
+  ;; BOZO we prefer this more aggressive app rule.  Add a :aggressivep to deflist?
+  (implies (and (force (logic.formula-list-atblp x atbl))
+                (force (logic.formula-list-atblp y atbl)))
+           (equal (logic.formula-list-atblp (app x y) atbl)
+                  t)))
+
+(in-theory (disable logic.formula-list-atblp-of-app))
+
+(defthm logic.formula-atblp-of-second-when-logic.formula-list-atblp
+  ;; BOZO consider adding something like this to deflist.
+  (implies (logic.formula-list-atblp x atbl)
+           (equal (logic.formula-atblp (second x) atbl)
+                  (consp (cdr x)))))
+
+(defthm logic.formula-atbl-listp-of-ordered-subsetp
+  ;; BOZO consider figuring out how to add something like this to deflist.
+  (implies (and (ordered-subsetp x y)
+                (logic.formula-list-atblp y atbl))
+           (equal (logic.formula-list-atblp x atbl)
+                  t)))
+
+(deflist logic.formula-list-list-atblp (x atbl)
+  (logic.formula-list-atblp x atbl)
+  :elementp-of-nil t
+  :guard (and (logic.formula-list-listp x)
+              (logic.arity-tablep atbl)))
+
+(defthm forcing-logic.term-atblp-of-logic.=lhs
+  (implies (and (force (logic.formula-atblp x atbl))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.term-atblp (logic.=lhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-atblp))))
+
+(defthm forcing-logic.term-atblp-of-logic.=rhs
+  (implies (and (force (logic.formula-atblp x atbl))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.term-atblp (logic.=rhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formula-atblp)
+                                 (forcing-logic.term-atblp-of-logic.=lhs)))))
+
+(defthm forcing-logic.formula-atblp-of-logic.~arg
+  (implies (and (force (logic.formula-atblp x atbl))
+                (force (equal (logic.fmtype x) 'pnot*)))
+           (equal (logic.formula-atblp (logic.~arg x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-atblp))))
+
+(defthm forcing-logic.formula-atblp-of-logic.vlhs
+  (implies (and (force (logic.formula-atblp x atbl))
+                (force (equal (logic.fmtype x) 'por*)))
+           (equal (logic.formula-atblp (logic.vlhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-atblp))))
+
+(defthm forcing-logic.formula-atblp-of-logic.vrhs
+  (implies (and (force (logic.formula-atblp x atbl))
+                (force (equal (logic.fmtype x) 'por*)))
+           (equal (logic.formula-atblp (logic.vrhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formula-atblp)
+                                 (forcing-logic.formula-atblp-of-logic.vlhs)))))
+
+
+
+
+(defthm forcing-logic.formula-atblp-of-logic.pequal
+  (implies (and (force (logic.term-atblp a atbl))
+                (force (logic.term-atblp b atbl)))
+           (equal (logic.formula-atblp (logic.pequal a b) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-atblp))))
+
+(defthm forcing-logic.formula-atblp-of-logic.pnot
+  (implies (force (logic.formula-atblp a atbl))
+           (equal (logic.formula-atblp (logic.pnot a) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formula-atblp)
+                                 (forcing-logic.formula-atblp-of-logic.~arg)))))
+
+(defthm forcing-logic.formula-atblp-of-logic.por
+  (implies (and (force (logic.formula-atblp a atbl))
+                (force (logic.formula-atblp b atbl)))
+           (equal (logic.formula-atblp (logic.por a b) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.formula-atblp)
+                                 (forcing-logic.formula-atblp-of-logic.vlhs
+                                  forcing-logic.formula-atblp-of-logic.vrhs)))))
+
+
+
+(defthm logic.formulap-when-malformed-cheap
+  (implies (and (not (equal (logic.fmtype x) 'por*))
+                (not (equal (logic.fmtype x) 'pnot*))
+                (not (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.formulap x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.formulap logic.fmtype))))
+
+(defthm logic.formula-atblp-when-malformed-cheap
+  (implies (and (not (equal (logic.fmtype x) 'por*))
+                (not (equal (logic.fmtype x) 'pnot*))
+                (not (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.formula-atblp x atbl)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (e/d (logic.formula-atblp)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+
+
+(deftheory forcing-logic.formula-atblp-rules
+  '(forcing-logic.term-atblp-of-logic.=lhs
+    forcing-logic.term-atblp-of-logic.=rhs
+    forcing-logic.formula-atblp-of-logic.~arg
+    forcing-logic.formula-atblp-of-logic.vlhs
+    forcing-logic.formula-atblp-of-logic.vrhs
+    forcing-logic.formula-atblp-of-logic.pequal
+    forcing-logic.formula-atblp-of-logic.pnot
+    forcing-logic.formula-atblp-of-logic.por))
+
+
+(encapsulate
+ ()
+ (local (in-theory (e/d (logic.formula-atblp)
+                        (forcing-logic.formula-atblp-rules))))
+
+ (defthmd logic.formula-atblp-when-por-expensive
+   (implies (equal (logic.fmtype x) 'por*)
+            (equal (logic.formula-atblp x atbl)
+                   (and (logic.formula-atblp (logic.vlhs x) atbl)
+                        (logic.formula-atblp (logic.vrhs x) atbl)))))
+
+ (defthmd logic.formula-atblp-when-pnot-expensive
+   (implies (equal (logic.fmtype x) 'pnot*)
+            (equal (logic.formula-atblp x atbl)
+                   (logic.formula-atblp (logic.~arg x) atbl))))
+
+ (defthmd logic.formula-atblp-when-pequal-expensive
+   (implies (equal (logic.fmtype x) 'pequal*)
+            (equal (logic.formula-atblp x atbl)
+                   (and (logic.term-atblp (logic.=lhs x) atbl)
+                        (logic.term-atblp (logic.=rhs x) atbl)))))
+
+ (defthmd logic.formula-atblp-of-logic.por-expensive
+   (equal (logic.formula-atblp (logic.por x y) atbl)
+          (and (logic.formula-atblp x atbl)
+               (logic.formula-atblp y atbl))))
+
+ (defthmd logic.formula-atblp-of-logic.pequal-expensive
+   (equal (logic.formula-atblp (logic.pequal x y) atbl)
+          (and (logic.term-atblp x atbl)
+               (logic.term-atblp y atbl))))
+
+ (defthmd logic.formula-atblp-of-logic.pnot-expensive
+   (equal (logic.formula-atblp (logic.pnot x) atbl)
+          (logic.formula-atblp x atbl)))
+
+ )
+
+(deftheory backtracking-logic.formula-atblp-rules
+  '(logic.formula-atblp-when-por-expensive
+    logic.formula-atblp-when-pnot-expensive
+    logic.formula-atblp-when-pequal-expensive
+    logic.formula-atblp-of-logic.por-expensive
+    logic.formula-atblp-of-logic.pnot-expensive
+    logic.formula-atblp-of-logic.pequal-expensive
+    ))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/fterm-lists.lisp acl2-6.3/books/milawa/ACL2/logic/fterm-lists.lisp
--- acl2-6.2/books/milawa/ACL2/logic/fterm-lists.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/fterm-lists.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,190 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(deflist logic.all-functionsp (x)
+  (logic.functionp x)
+  :elementp-of-nil nil
+  :guard (logic.term-listp x))
+
+(defprojection :list (logic.strip-function-names x)
+               :element (logic.function-name x)
+               :guard (and (logic.term-listp x)
+                           (logic.all-functionsp x))
+               :nil-preservingp t)
+
+(defthm forcing-logic.function-symbol-listp-of-logic.strip-function-names
+  (implies (and (force (logic.term-listp x))
+                (force (logic.all-functionsp x)))
+           (equal (logic.function-symbol-listp (logic.strip-function-names x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defprojection :list (logic.strip-function-args x)
+               :element (logic.function-args x)
+               :guard (and (logic.term-listp x)
+                           (logic.all-functionsp x))
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-list-listp-of-logic.strip-function-args
+  (implies (and (force (logic.term-listp x))
+                (force (logic.all-functionsp x)))
+           (equal (logic.term-list-listp (logic.strip-function-args x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atblp-of-logic.strip-function-args
+  (implies (and (force (logic.term-list-atblp x atbl))
+                (force (logic.all-functionsp x)))
+           (equal (logic.term-list-list-atblp (logic.strip-function-args x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-true-list-listp-of-logic.strip-function-args
+  (implies (and (force (logic.term-listp x))
+                (force (logic.all-functionsp x)))
+           (equal (true-list-listp (logic.strip-function-args x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-listp-of-strip-firsts-when-all-lens-2
+  (implies (and (logic.all-functionsp x)
+                (logic.term-listp x)
+                (all-equalp 2 (strip-lens (logic.strip-function-args x))))
+           (equal (logic.term-listp (strip-firsts (logic.strip-function-args x)))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-listp-of-strip-seconds-when-all-lens-2
+  (implies (and (logic.all-functionsp x)
+                (logic.term-listp x)
+                (all-equalp 2 (strip-lens (logic.strip-function-args x))))
+           (equal (logic.term-listp (strip-seconds (logic.strip-function-args x)))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-atblp-of-strip-firsts-when-all-lens-2
+  (implies (and (logic.all-functionsp x)
+                (all-equalp 2 (strip-lens (logic.strip-function-args x)))
+                (force (logic.term-listp x))
+                (force (logic.term-list-atblp x atbl)))
+           (equal (logic.term-list-atblp (strip-firsts (logic.strip-function-args x)) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-atblp-of-strip-seconds-when-all-lens-2
+  (implies (and (logic.all-functionsp x)
+                (all-equalp 2 (strip-lens (logic.strip-function-args x)))
+                (force (logic.term-listp x))
+                (force (logic.term-list-atblp x atbl)))
+           (equal (logic.term-list-atblp (strip-seconds (logic.strip-function-args x)) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(encapsulate
+ ()
+ (local (in-theory (disable equal-of-logic.function-rewrite)))
+ (defprojection
+   :list (logic.function-list name x)
+   :element (logic.function name x)
+   :guard (and (logic.function-namep name)
+               (logic.term-list-listp x)
+               (true-list-listp x))))
+
+(defthm forcing-logic.term-listp-of-logic.function-list
+  (implies (and (force (logic.function-namep name))
+                (force (logic.term-list-listp x))
+                (force (true-list-listp x)))
+           (equal (logic.term-listp (logic.function-list name x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-logic.function-list
+  (implies (and (force (logic.function-namep name))
+                (force (logic.term-list-list-atblp x atbl))
+                (force (all-equalp (cdr (lookup name atbl)) (strip-lens x))))
+           (equal (logic.term-list-atblp (logic.function-list name x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.all-functionsp-of-logic.function-list
+  (implies (and (force (logic.function-namep name))
+                (force (logic.term-list-listp x))
+                (force (true-list-listp x)))
+           (equal (logic.all-functionsp (logic.function-list name x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.strip-function-names-of-logic.function-list
+  (implies (and (force (logic.function-namep name))
+                (force (logic.term-list-listp x))
+                (force (true-list-listp x)))
+           (equal (logic.strip-function-names (logic.function-list name x))
+                  (repeat name (len x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.strip-function-args-of-logic.function-list
+  (implies (and (force (logic.function-namep name))
+                (force (logic.term-list-listp x))
+                (force (true-list-listp x)))
+           (equal (logic.strip-function-args (logic.function-list name x))
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthm forcing-logic.term-listp-list-of-list2-list
+  (implies (and (force (logic.term-listp x))
+                (force (logic.term-listp y)))
+           (equal (logic.term-list-listp (list2-list x y))
+                  t))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.term-list-atblp-list-of-list2-list
+  (implies (and (force (logic.term-list-atblp x atbl))
+                (force (logic.term-list-atblp y atbl)))
+           (equal (logic.term-list-list-atblp (list2-list x y) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/functional-axiom.lisp acl2-6.3/books/milawa/ACL2/logic/functional-axiom.lisp
--- acl2-6.2/books/milawa/ACL2/logic/functional-axiom.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/functional-axiom.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,138 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund logic.functional-axiom (fn ti si)
+  ;; Create the functional axiom instance for fn, ti, and si.
+  (declare (xargs :guard (and (logic.function-namep fn)
+                              (logic.term-listp ti)
+                              (logic.term-listp si)
+                              (equal (len ti) (len si)))))
+  (logic.disjoin-formulas (fast-app (logic.negate-formulas (logic.pequal-list ti si))
+                                    (list (logic.pequal (logic.function fn (list-fix ti))
+                                                        (logic.function fn (list-fix si)))))))
+
+(defthm forcing-logic.formulap-of-logic.functional-axiom
+  (implies (force (and (logic.function-namep fn)
+                       (equal (len ti) (len si))
+                       (logic.term-listp ti)
+                       (logic.term-listp si)))
+           (equal (logic.formulap (logic.functional-axiom fn ti si))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.functional-axiom))))
+
+(defthm forcing-logic.formula-atblp-of-logic.functional-axiom
+  (implies (force (and (logic.function-namep fn)
+                       (logic.term-list-atblp ti atbl)
+                       (logic.term-list-atblp si atbl)
+                       (equal (cdr (lookup fn atbl)) (len ti))
+                       (equal (len ti) (len si))))
+           (equal (logic.formula-atblp (logic.functional-axiom fn ti si) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.functional-axiom))))
+
+
+
+;; We introduce two intermediate functions to bridge the gap between our axiom
+;; generator and the checker in proofp.
+
+(defund logic.functional-axiom-alt1 (fn ti si tacc sacc)
+  (declare (xargs :verify-guards nil))
+  (if (and (consp ti)
+           (consp si))
+      (logic.por (logic.pnot (logic.pequal (car ti) (car si)))
+                 (logic.functional-axiom-alt1 fn (cdr ti) (cdr si) (cons (car ti) tacc) (cons (car si) sacc)))
+    (logic.pequal (logic.function fn (rev tacc))
+                  (logic.function fn (rev sacc)))))
+
+(defthm logic.check-functional-axiom-of-logic.functional-axiom-alt1
+  (implies (and (logic.function-namep fn)
+                (equal (len ti) (len si)))
+           (equal (logic.check-functional-axiom (logic.functional-axiom-alt1 fn ti si tacc sacc) tacc sacc)
+                  t))
+  :hints(("Goal"
+          :in-theory (enable logic.check-functional-axiom
+                             logic.functional-axiom-alt1)
+          :induct (logic.functional-axiom-alt1 fn ti si tacc sacc))))
+
+(defund logic.functional-axiom-alt2 (fn ti si tacc sacc)
+  (declare (xargs :verify-guards nil))
+  (logic.disjoin-formulas
+   (app (logic.negate-formulas (logic.pequal-list ti si))
+        (list (logic.pequal (logic.function fn (rev (revappend ti tacc)))
+                            (logic.function fn (rev (revappend si sacc))))))))
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthm logic.functional-axiom-alt1/alt2-equivalence
+   (implies (and (logic.function-namep fn)
+                 (equal (len ti) (len si))
+                 (true-listp tacc)
+                 (true-listp sacc))
+            (equal (logic.functional-axiom-alt1 fn ti si tacc sacc)
+                   (logic.functional-axiom-alt2 fn ti si tacc sacc)))
+   :hints(("Goal"
+           :in-theory (e/d (logic.functional-axiom-alt2
+                            logic.functional-axiom-alt1)
+                           (forcing-logic.formulap-of-logic.pequal
+                            forcing-logic.formulap-of-logic.pnot
+                            forcing-equal-of-logic.por-rewrite-two
+                            forcing-equal-of-logic.por-rewrite))
+           :induct (logic.functional-axiom-alt1 fn ti si tacc sacc)))))
+
+(defthm logic.functional-axiom-alt2/main-equivalence
+  (implies (and (logic.function-namep fn)
+                (equal (len ti) (len si)))
+           (equal (logic.functional-axiom-alt2 fn ti si nil nil)
+                  (logic.functional-axiom fn ti si)))
+  :hints(("Goal" :in-theory (enable logic.functional-axiom-alt2
+                                    logic.functional-axiom))))
+
+(defthm forcing-logic.check-functional-axiom-of-logic.functional-axiom
+   (implies (force (and (logic.function-namep fn)
+                        (equal (len ti) (len si))))
+            (equal (logic.check-functional-axiom (logic.functional-axiom fn ti si) nil nil)
+                   t))
+   :hints(("Goal"
+           :use ((:instance logic.check-functional-axiom-of-logic.functional-axiom-alt1
+                            (tacc nil)
+                            (sacc nil))))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/fuse.lisp acl2-6.3/books/milawa/ACL2/logic/fuse.lisp
--- acl2-6.2/books/milawa/ACL2/logic/fuse.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/fuse.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,176 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; We introduce some fused operations for greater efficiency.  IMO the compiler
+;; should be smart enough to do this, but IRL it isn't.  I guess TANSTAAFL,
+;; after all.
+
+(defund logic.=rhses-of-strip-conclusions (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-atomicp (logic.strip-conclusions x)))))
+  (if (consp x)
+      (cons (logic.=rhs (logic.conclusion (car x)))
+            (logic.=rhses-of-strip-conclusions (cdr x)))
+    nil))
+
+(defthm logic.=rhses-of-strip-conclusions-removal
+  (equal (logic.=rhses-of-strip-conclusions x)
+         (logic.=rhses (logic.strip-conclusions x)))
+  :hints(("Goal" :in-theory (enable logic.=rhses-of-strip-conclusions))))
+
+
+
+(defund logic.=lhses-of-strip-conclusions (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-atomicp (logic.strip-conclusions x)))))
+  (if (consp x)
+      (cons (logic.=lhs (logic.conclusion (car x)))
+            (logic.=lhses-of-strip-conclusions (cdr x)))
+    nil))
+
+(defthm logic.=lhses-of-strip-conclusions-removal
+  (equal (logic.=lhses-of-strip-conclusions x)
+         (logic.=lhses (logic.strip-conclusions x)))
+  :hints(("Goal" :in-theory (enable logic.=lhses-of-strip-conclusions))))
+
+
+
+
+(defund logic.vrhses-of-strip-conclusions (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-disjunctionsp (logic.strip-conclusions x)))))
+  (if (consp x)
+      (cons (logic.vrhs (logic.conclusion (car x)))
+            (logic.vrhses-of-strip-conclusions (cdr x)))
+    nil))
+
+(defthm logic.vrhses-of-strip-conclusions-removal
+  (equal (logic.vrhses-of-strip-conclusions x)
+         (logic.vrhses (logic.strip-conclusions x)))
+  :hints(("Goal" :in-theory (enable logic.vrhses-of-strip-conclusions))))
+
+
+(defund logic.vlhses-of-strip-conclusions (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-disjunctionsp (logic.strip-conclusions x)))))
+  (if (consp x)
+      (cons (logic.vlhs (logic.conclusion (car x)))
+            (logic.vlhses-of-strip-conclusions (cdr x)))
+    nil))
+
+(defthm logic.vlhses-of-strip-conclusions-removal
+  (equal (logic.vlhses-of-strip-conclusions x)
+         (logic.vlhses (logic.strip-conclusions x)))
+  :hints(("Goal" :in-theory (enable logic.vlhses-of-strip-conclusions))))
+
+
+(defund logic.=lhses-of-vrhses-of-strip-conclusions (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-disjunctionsp (logic.strip-conclusions x))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x))))))
+  (if (consp x)
+      (cons (logic.=lhs (logic.vrhs (logic.conclusion (car x))))
+            (logic.=lhses-of-vrhses-of-strip-conclusions (cdr x)))
+    nil))
+
+(defthm logic.=lhses-of-vrhses-of-strip-conclusions-removal
+  (equal (logic.=lhses-of-vrhses-of-strip-conclusions x)
+         (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+  :hints(("Goal" :in-theory (enable logic.=lhses-of-vrhses-of-strip-conclusions))))
+
+
+(defund logic.=rhses-of-vrhses-of-strip-conclusions (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-disjunctionsp (logic.strip-conclusions x))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x))))))
+  (if (consp x)
+      (cons (logic.=rhs (logic.vrhs (logic.conclusion (car x))))
+            (logic.=rhses-of-vrhses-of-strip-conclusions (cdr x)))
+    nil))
+
+(defthm logic.=rhses-of-vrhses-of-strip-conclusions-removal
+  (equal (logic.=rhses-of-vrhses-of-strip-conclusions x)
+         (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))
+  :hints(("Goal" :in-theory (enable logic.=rhses-of-vrhses-of-strip-conclusions))))
+
+
+
+
+(defund logic.all-atomicp-of-strip-conclusions (x)
+  (declare (xargs :guard (logic.appeal-listp x)))
+  (if (consp x)
+      (and (equal (logic.fmtype (logic.conclusion (car x))) 'pequal*)
+           (logic.all-atomicp-of-strip-conclusions (cdr x)))
+    t))
+
+(defthm logic.all-atomicp-of-strip-conclusions-removal
+  (equal (logic.all-atomicp-of-strip-conclusions x)
+         (logic.all-atomicp (logic.strip-conclusions x)))
+  :hints(("Goal" :in-theory (enable logic.all-atomicp-of-strip-conclusions))))
+
+
+
+(defund logic.all-disjunctionsp-of-strip-conclusions (x)
+  (declare (xargs :guard (logic.appeal-listp x)))
+  (if (consp x)
+      (and (equal (logic.fmtype (logic.conclusion (car x))) 'por*)
+           (logic.all-disjunctionsp-of-strip-conclusions (cdr x)))
+    t))
+
+(defthm logic.all-disjunctionsp-of-strip-conclusions-removal
+  (equal (logic.all-disjunctionsp-of-strip-conclusions x)
+         (logic.all-disjunctionsp (logic.strip-conclusions x)))
+  :hints(("Goal" :in-theory (enable logic.all-disjunctionsp-of-strip-conclusions))))
+
+
+(defund logic.all-atomicp-of-vrhses-of-strip-conclusions (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-disjunctionsp (logic.strip-conclusions x)))))
+  (if (consp x)
+      (and (equal (logic.fmtype (logic.vrhs (logic.conclusion (car x)))) 'pequal*)
+           (logic.all-atomicp-of-vrhses-of-strip-conclusions (cdr x)))
+    t))
+
+(defthm logic.all-atomicp-of-vrhses-of-strip-conclusions-removal
+  (equal (logic.all-atomicp-of-vrhses-of-strip-conclusions x)
+         (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x))))
+  :hints(("Goal" :in-theory (enable logic.all-atomicp-of-vrhses-of-strip-conclusions))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/groundp.lisp acl2-6.3/books/milawa/ACL2/logic/groundp.lisp
--- acl2-6.2/books/milawa/ACL2/logic/groundp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/groundp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,236 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (logic.groundp x)             (also logic.fast-groundp)
+;; (logic.ground-listp x)        (also logic.fast-ground-listp)
+;;
+;; Recognizers for variable-free ("ground") terms and term lists.
+
+(defund logic.flag-groundp (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             t)
+            ((logic.variablep x)
+             nil)
+            ((logic.functionp x)
+             (logic.flag-groundp 'list (logic.function-args x)))
+            ((logic.lambdap x)
+             (logic.flag-groundp 'list (logic.lambda-actuals x)))
+            (t nil))
+    (if (consp x)
+        (and (logic.flag-groundp 'term (car x))
+             (logic.flag-groundp 'list (cdr x)))
+      t)))
+
+(definlined logic.groundp (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.flag-groundp 'term x))
+
+(definlined logic.ground-listp (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (logic.flag-groundp 'list x))
+
+(defthmd definition-of-logic.groundp
+  (equal (logic.groundp x)
+         (cond ((logic.constantp x)
+                t)
+               ((logic.variablep x)
+                nil)
+               ((logic.functionp x)
+                (logic.ground-listp (logic.function-args x)))
+               ((logic.lambdap x)
+                (logic.ground-listp (logic.lambda-actuals x)))
+               (t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-groundp
+                                    logic.groundp
+                                    logic.ground-listp))))
+
+(defthmd definition-of-logic.ground-listp
+  (equal (logic.ground-listp x)
+         (if (consp x)
+             (and (logic.groundp (car x))
+                  (logic.ground-listp (cdr x)))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-groundp
+                                    logic.groundp
+                                    logic.ground-listp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.groundp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.ground-listp))))
+
+(defthm logic.ground-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.ground-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.ground-listp))))
+
+(defthm logic.ground-listp-of-cons
+  (equal (logic.ground-listp (cons a x))
+         (and (logic.groundp a)
+              (logic.ground-listp x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.ground-listp))))
+
+(defthm booleanp-of-logic.ground-listp
+  (equal (booleanp (logic.ground-listp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm booleanp-of-logic.groundp
+  (equal (booleanp (logic.groundp x))
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-logic.groundp))))
+
+(defthm logic.groundp-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (logic.groundp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.groundp))))
+
+(defthm forcing-logic.ground-listp-of-logic.function-args-when-logic.groundp
+  (implies (and (logic.groundp x)
+                (force (logic.functionp x)))
+           (equal (logic.ground-listp (logic.function-args x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.groundp))))
+
+(defthm forcing-logic.ground-listp-of-logic.lambda-actuals-when-logic.groundp
+  (implies (and (logic.groundp x)
+                (force (logic.lambdap x)))
+           (equal (logic.ground-listp (logic.lambda-actuals x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.groundp))))
+
+
+
+(deflist logic.ground-listp (x)
+  (logic.groundp x)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(defthm logic.ground-listp-when-logic.constant-listp
+  (implies (logic.constant-listp x)
+           (equal (logic.ground-listp x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.groundp-of-logic.function
+  (implies (and (force (logic.function-namep name))
+                (force (true-listp args))
+                (force (logic.term-listp args)))
+           (equal (logic.groundp (logic.function name args))
+                  (logic.ground-listp args)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.groundp))))
+
+(defthm forcing-logic.groundp-of-logic.lambda
+  (implies (and (force (true-listp formals))
+                (force (logic.variable-listp formals))
+                (force (uniquep formals))
+                (force (logic.termp body))
+                (force (subsetp (logic.term-vars body) formals))
+                (force (equal (len formals) (len actuals)))
+                (force (true-listp actuals))
+                (force (logic.term-listp actuals)))
+           (equal (logic.groundp (logic.lambda formals body actuals))
+                  (logic.ground-listp actuals)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.groundp))))
+
+
+;; Theorem: Suppose that x is some arbitrary term (perhaps with variables) and
+;; sigma is substitution list which binds every variable mentioned in x to some
+;; ground term.  Then, x/sigma is a ground term.
+
+(defthmd lemma-2-for-forcing-logic.groundp-of-logic.substitute
+  (implies (logic.ground-listp (range sigma))
+           (equal (logic.groundp (cdr (lookup x sigma)))
+                  (memberp x (domain sigma))))
+  :hints(("Goal" :induct (cdr-induction sigma))))
+
+(defthms-flag
+  :shared-hyp (and (logic.sigmap sigma)
+                   (logic.ground-listp (range sigma)))
+  :thms ((term forcing-logic.groundp-of-logic.substitute
+               (implies (and (logic.termp x)
+                             (subsetp (logic.term-vars x) (domain sigma)))
+                        (equal (logic.groundp (logic.substitute x sigma))
+                               t)))
+         (t forcing-logic.ground-listp-of-logic.substitute-list
+            (implies (and (logic.term-listp x)
+                          (subsetp (logic.term-list-vars x) (domain sigma)))
+                     (equal (logic.ground-listp (logic.substitute-list x sigma))
+                            t))))
+  :hints (("Goal"
+           :induct (logic.term-induction flag x)
+           :in-theory (enable lemma-2-for-forcing-logic.groundp-of-logic.substitute))))
+
+
+
+;; BOZO -- do we really want just logic.constant-listp in the following rules, or
+;; would logic.ground-listp be better since it could still backchain to
+;; logic.constant-listp?
+
+(defthm forcing-logic.groundp-when-logic.constant-listp-of-logic.function-args
+  (implies (and (logic.constant-listp (logic.function-args term))
+                (force (logic.termp term))
+                (force (logic.functionp term)))
+           (equal (logic.groundp term)
+                  t))
+  :hints(("Goal"
+          :use ((:instance forcing-logic.groundp-of-logic.function
+                           (name (logic.function-name term))
+                           (args (logic.function-args term)))))))
+
+(defthm forcing-logic.groundp-when-logic.constant-listp-of-logic.lambda-actuals
+  (implies (and (logic.constant-listp (logic.lambda-actuals term))
+                (force (logic.termp term))
+                (force (logic.lambdap term)))
+           (equal (logic.groundp term)
+                  t))
+  :hints(("Goal"
+          :use ((:instance forcing-logic.groundp-of-logic.lambda
+                           (formals (logic.lambda-formals term))
+                           (body    (logic.lambda-body term))
+                           (actuals (logic.lambda-actuals term)))))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/lambda-count.lisp acl2-6.3/books/milawa/ACL2/logic/lambda-count.lisp
--- acl2-6.2/books/milawa/ACL2/logic/lambda-count.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/lambda-count.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,225 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+#|
+
+(include-book "terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defun ord.simple-increment (depth amount x)
+  ;; Returns the ordinal x + amount * w^depth
+  (declare (xargs :guard (and (ordp depth)
+                              (natp amount)
+                              (ordp x))))
+  (if (consp x)
+      (if (equal (car x)
+
+
+
+
+;; A size-alist is a mapping of ranks to values, where all of the ranks and
+;; values are natural numbers.
+
+(defund simple-ordinalp (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (natp (car (car x)))
+           (natp (cdr (car x)))
+           (simple-ordinalp (cdr x)))
+    (equal x 0)))
+
+(defthm simple-ordinalp-when-not-consp
+  (implies (not (consp x))
+           (equal (simple-ordinalp x)
+                  (equal x 0)))
+  :hints(("Goal" :in-theory (enable simple-ordinalp))))
+
+(defthm simple-ordinalp-of-cons
+  (equal (simple-ordinalp (cons a x))
+         (and (natp (car a))
+              (natp (cdr a))
+              (simple-ordinalp x)))
+  :hints(("Goal" :in-theory (enable simple-ordinalp))))
+
+(defthm booleanp-of-simple-ordinalp
+  (equal (booleanp (simple-ordinalp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm ordp-when-simple-ordinalp
+  (implies (simple-ordinalp x)
+           (equal (ordp x)
+                  t))
+  :hints(("Goal"
+          :in-theory (enable ordp)
+          :induct (cdr-induction x))))
+
+
+(defmap :map (size-alistp x)
+        :key (natp x)
+        :val (natp x)
+        :key-list (nat-listp x)
+        :val-list (nat-listp x)
+        :val-of-nil nil)
+
+(defthm forcing-size-alistp-of-update
+  ;; BOZO add to defmap?
+  (implies (force (and (size-alistp map)
+                       (natp key)
+                       (natp val)))
+           (equal (size-alistp (update key val map))
+                  t))
+  :hints(("Goal" :in-theory (enable update))))
+
+;; Adding two size-alists means adding the values associated with each rank.
+
+(defund size-alist-add-aux (domain x y)
+  (declare (xargs :guard (and (nat-listp domain)
+                              (size-alistp x)
+                              (size-alistp y))
+                  :verify-guards nil))
+  (if (consp domain)
+      (let ((x-value (cdr (lookup (car domain) x)))
+            (y-value (cdr (lookup (car domain) y))))
+        (update (car domain)
+                (+ x-value y-value)
+                (size-alist-add-aux (cdr domain) x y)))
+    nil))
+
+(defthm forcing-size-alistp-of-size-alist-add-aux
+  (implies (force (and (nat-listp domain)
+                       (size-alistp x)
+                       (size-alistp y)))
+           (equal (size-alistp (size-alist-add-aux domain x y))
+                  t))
+  :hints(("Goal"
+          :in-theory (enable size-alist-add-aux))))
+
+(verify-guards size-alist-add-aux)
+
+
+
+
+
+
+
+
+;; A challenge.  Walk over a term and do the beta-reduction in place, but still
+;; know that your function terminates.  Let's just write a function that counts the
+;; beta-reduced size of a term.
+
+
+;; we want to devise a measure which satisfies four properties.
+
+;; the measure we are looking at is consider the "depth" of each lambda as follows.
+;; a top level lambda has depth 0
+;; an embedded lambda has depth 1
+;; etc.
+;; so each lambda's depth is the number of lambdas above it.  we want to show that
+;; the depth of our lambdas decreases.
+
+;; is it equivalent to consider the depth of each lambda as the maximum depth of
+;; any subterm plus one?  i think so, then the top level lambda has the highest
+;; depth and things work out more nicely.
+
+
+(defmap
+
+(defund alist-plus (x y)
+  (declare
+
+
+(defund lambda-count (flag x)
+  ;; We return an ordinal that describes the number and ranks of lambdas in this
+  ;; term.
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) 0)
+            ((logic.variablep x) 0)
+            ((logic.functionp x)
+
+             (flag-beta-depth 'list (logic.function-args x)))
+            ((logic.lambdap x)
+             ;; one more than maximum of any argument or body's depth
+             (+ 1 (max (flag-beta-depth 'term (logic.lambda-body x))
+                       (flag-beta-depth 'list (logic.lambda-actuals x)))))
+            (t 0))
+    (if (consp x)
+        (max (flag-beta-depth 'term (car x))
+             (flag-beta-depth 'list (cdr x)))
+      0)))
+
+
+
+
+
+
+
+
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund flag-beta-depth (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) 0)
+            ((logic.variablep x) 0)
+            ((logic.functionp x)
+             ;; maximum of any argument's depth
+             (flag-beta-depth 'list (logic.function-args x)))
+            ((logic.lambdap x)
+             ;; one more than maximum of any argument or body's depth
+             (+ 1 (max (flag-beta-depth 'term (logic.lambda-body x))
+                       (flag-beta-depth 'list (logic.lambda-actuals x)))))
+            (t 0))
+    (if (consp x)
+        (max (flag-beta-depth 'term (car x))
+             (flag-beta-depth 'list (cdr x)))
+      0)))
+
+(
+
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/logic/negate-formulas.lisp acl2-6.3/books/milawa/ACL2/logic/negate-formulas.lisp
--- acl2-6.2/books/milawa/ACL2/logic/negate-formulas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/negate-formulas.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,268 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(deflist logic.all-negationsp (x)
+  (equal (logic.fmtype x) 'pnot*)
+  :elementp-of-nil nil
+  :guard (logic.formula-listp x))
+
+
+;; Some of the rules that are generated aren't very good because they're
+;; for the general case; we replace them.
+(in-theory (disable equal-of-car-when-logic.all-negationsp
+                    equal-when-memberp-of-logic.all-negationsp
+                    equal-when-memberp-of-logic.all-negationsp-alt))
+
+(defthm logic.fmtype-of-car-when-logic.all-negationsp
+  (implies (and (logic.all-negationsp x)
+                (consp x))
+           (equal (logic.fmtype (car x))
+                  'pnot*)))
+
+(defthm logic.fmtype-when-memberp-of-logic.all-negationsp
+  (implies (and (memberp a x)
+                (logic.all-negationsp x))
+           (equal (logic.fmtype a)
+                  'pnot*))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-when-memberp-of-logic.all-negationsp-alt
+  (implies (and (logic.all-negationsp x)
+                (memberp a x))
+           (equal (logic.fmtype a)
+                  'pnot*)))
+
+
+
+
+
+(defprojection :list (logic.~args x)
+               :element (logic.~arg x)
+               :guard (and (logic.formula-listp x)
+                           (logic.all-negationsp x))
+               :nil-preservingp t)
+
+(defthm forcing-logic.formula-listp-of-logic.~args
+  (implies (and (force (logic.all-negationsp x))
+                (force (logic.formula-listp x)))
+           (equal (logic.formula-listp (logic.~args x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.~args
+  (implies (and (force (logic.all-negationsp x))
+                (force (logic.formula-list-atblp x atbl)))
+           (equal (logic.formula-list-atblp (logic.~args x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.~arg-of-car-when-all-equalp-of-logic.~args
+  (implies (all-equalp p (logic.~args x))
+           (equal (logic.~arg (car x))
+                  (if (consp x)
+                      p
+                    nil))))
+
+
+;; (logic.negate-formulas x) takes a list of formulas [A1, ..., An] and
+;; produces the list [~A1, ..., ~An].
+
+(encapsulate
+ ()
+
+ (local (in-theory (disable forcing-equal-of-logic.pnot-rewrite
+                            forcing-equal-of-logic.pnot-rewrite-two)))
+
+ (defprojection :list (logic.negate-formulas x)
+                :element (logic.pnot x)
+                :guard (logic.formula-listp x)))
+
+
+
+(defthm memberp-of-logic.pnot-in-logic.negate-formulas
+  ;; BOZO.  We can develop a stronger version of what the macro generated
+  ;; because our transformer was one-to-one.  Maybe we should add a flag to
+  ;; deflist for this?
+  (equal (memberp (logic.pnot a) (logic.negate-formulas x))
+         (memberp a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(in-theory (disable memberp-of-logic.pnot-in-logic.negate-formulas-when-memberp))
+
+
+(defthm logic.formula-listp-of-logic.negate-formulas
+  (implies (force (logic.formula-listp x))
+           (equal (logic.formula-listp (logic.negate-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.formula-list-atblp-of-logic.negate-formulas
+  (implies (force (logic.formula-list-atblp x atbl))
+           (equal (logic.formula-list-atblp (logic.negate-formulas x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm equal-of-logic.negate-formulas-and-logic.negate-formulas
+  (equal (equal (logic.negate-formulas x)
+                (logic.negate-formulas y))
+         (equal (list-fix x)
+                (list-fix y)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.~args-of-logic.negate-formulas
+  (implies (force (logic.formula-listp x))
+           (equal (logic.~args (logic.negate-formulas x))
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.~args-of-logic.negate-formulas-free
+  (implies (and (equal x (logic.negate-formulas y))
+                (force (logic.formula-listp y)))
+           (equal (logic.~args x)
+                  (list-fix y))))
+
+(defthm forcing-logic.all-negationsp-of-logic.negate-formulas
+  (equal (logic.all-negationsp (logic.negate-formulas x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.all-negationsp-of-logic.negate-formulas-free
+  (implies (equal x (logic.negate-formulas y))
+           (equal (logic.all-negationsp x)
+                  t)))
+
+
+
+
+;; Smart-negate-formulas is the same as negate-formulas, except that it
+;; converts formulas of the form ~A into A instead of ~~A.
+
+(defund logic.smart-negate-formulas (x)
+  (declare (xargs :guard (logic.formula-listp x)))
+  (if (consp x)
+      (cons (if (equal (logic.fmtype (car x)) 'pnot*)
+                (logic.~arg (car x))
+              (logic.pnot (car x)))
+            (logic.smart-negate-formulas (cdr x)))
+    nil))
+
+(defthm logic.smart-negate-formulas-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.smart-negate-formulas x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.smart-negate-formulas))))
+
+(defthm logic.smart-negate-formulas-of-cons
+  (equal (logic.smart-negate-formulas (cons a x))
+         (cons (if (equal (logic.fmtype a) 'pnot*)
+                   (logic.~arg a)
+                 (logic.pnot a))
+               (logic.smart-negate-formulas x)))
+  :hints(("Goal" :in-theory (enable logic.smart-negate-formulas))))
+
+(defthm true-listp-of-logic.smart-negate-formulas
+  (equal (true-listp (logic.smart-negate-formulas x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.smart-negate-formulas-of-list-fix
+  (equal (logic.smart-negate-formulas (list-fix x))
+         (logic.smart-negate-formulas x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.smart-negate-formulas-of-app
+  (equal (logic.smart-negate-formulas (app x y))
+         (app (logic.smart-negate-formulas x)
+              (logic.smart-negate-formulas y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-logic.smart-negate-formulas
+  (equal (len (logic.smart-negate-formulas x))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-of-logic.smart-negate-formulas
+  (equal (consp (logic.smart-negate-formulas x))
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.smart-negate-formulas-under-iff
+  (iff (logic.smart-negate-formulas x)
+       (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-listp-of-logic.smart-negate-formulas
+  (implies (force (logic.formula-listp x))
+           (equal (logic.formula-listp (logic.smart-negate-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.smart-negate-formulas
+  (implies (force (logic.formula-list-atblp x atbl))
+           (equal (logic.formula-list-atblp (logic.smart-negate-formulas x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+;; Reasoning about membership in smart-negate-formulas is tricky because you
+;; could obtain ~A from either A or ~~A.
+
+(defthm memberp-of-logic.pnot-in-logic.smart-negate-formulas
+  (implies (and (equal (logic.fmtype a) 'pequal*)
+                (memberp a x))
+           (equal (memberp (logic.pnot a) (logic.smart-negate-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-logic.pequal-in-logic.smart-negate-formulas
+  (implies (and (memberp (logic.pnot (logic.pequal a b)) x)
+                (force (logic.termp a))
+                (force (logic.termp b)))
+           (equal (memberp (logic.pequal a b) (logic.smart-negate-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-logic.~arg-in-logic.smart-negate-formulas
+  (implies (and (equal (logic.fmtype a) 'pnot*)
+                (memberp a x))
+           (equal (memberp (logic.~arg a) (logic.smart-negate-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/negate-term.lisp acl2-6.3/books/milawa/ACL2/logic/negate-term.lisp
--- acl2-6.2/books/milawa/ACL2/logic/negate-term.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/negate-term.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,91 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund logic.negate-term (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.function 'not (list x)))
+
+(defthm forcing-logic.termp-of-logic.negate-term
+  (implies (force (logic.termp x))
+           (equal (logic.termp (logic.negate-term x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.negate-term))))
+
+(defthm forcing-logic.term-atblp-of-logic.negate-term
+  (implies (force (and (logic.term-atblp x atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-atblp (logic.negate-term x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.negate-term))))
+
+
+
+(defprojection :list (logic.negate-term-list x)
+               :element (logic.negate-term x)
+               :guard (logic.term-listp x))
+
+(defthm forcing-logic.term-listp-of-logic.negate-term-list
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (logic.negate-term-list x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.negate-term-list))))
+
+(defthm forcing-logic.term-list-atblp-of-logic.negate-term-list
+  (implies (force (and (logic.term-list-atblp x atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-list-atblp (logic.negate-term-list x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.negate-term-list))))
+
+
+
+(defthm logic.substitute-of-logic.negate-term
+  (equal (logic.substitute (logic.negate-term x) sigma)
+         (logic.negate-term (logic.substitute x sigma)))
+  :hints(("Goal" :in-theory (enable logic.negate-term))))
+
+(defthm logic.substitute-list-of-logic.negate-term-list
+  (equal (logic.substitute-list (logic.negate-term-list x) sigma)
+         (logic.negate-term-list (logic.substitute-list x sigma)))
+  :hints(("Goal" :induct (cdr-induction x))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/logic/pand.lisp acl2-6.3/books/milawa/ACL2/logic/pand.lisp
--- acl2-6.2/books/milawa/ACL2/logic/pand.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/pand.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,158 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; BOZO Dammit I hate this stupid file.  I wish it would die.
+
+
+;; We interpret F ^ G as an abbreviation for ~(~F v ~G).  We write the function
+;; logic.and-structurep to recognize formulas of this form.
+
+(defund logic.and-structurep (x)
+  ;; BOZO this should be guarded with formulap instead of checking it
+  (declare (xargs :guard t))
+  (and (logic.formulap x)
+       (equal (logic.fmtype x) 'pnot*)
+       (let ((or-not-f-not-g (logic.~arg x)))
+         (and (equal (logic.fmtype or-not-f-not-g) 'por*)
+              (let ((not-f (logic.vlhs or-not-f-not-g))
+                    (not-g (logic.vrhs or-not-f-not-g)))
+                (and (equal (logic.fmtype not-f) 'pnot*)
+                     (equal (logic.fmtype not-g) 'pnot*)))))))
+
+(defthm booleanp-of-logic.and-structurep
+  (equal (booleanp (logic.and-structurep x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.and-structurep))))
+
+(defund logic.andlhs (x)
+  (declare (xargs :guard (logic.and-structurep x)
+                  :guard-hints (("Goal" :in-theory (enable logic.and-structurep)))))
+  (logic.~arg          ;; F
+   (logic.vlhs         ;; ~F
+    (logic.~arg        ;; ~F v ~G
+     x))))       ;; ~(~F v ~G)
+
+(defund logic.andrhs (x)
+  (declare (xargs :guard (logic.and-structurep x)
+                  :guard-hints (("Goal" :in-theory (enable logic.and-structurep)))))
+  (logic.~arg          ;; G
+   (logic.vrhs         ;; ~G
+    (logic.~arg        ;; ~F v ~G
+     x))))       ;; ~(~F v ~G)
+
+(defund logic.pand (x y)
+  (declare (xargs :guard (and (logic.formulap x)
+                              (logic.formulap y))))
+  (logic.pnot (logic.por (logic.pnot x)
+                         (logic.pnot y))))
+
+(in-theory (disable (:executable-counterpart logic.pand)))
+
+(defthm logic.pand-under-iff
+  (iff (logic.pand x y)
+       t)
+  :hints(("Goal" :in-theory (enable logic.pand))))
+
+(defthm forcing-logic.and-structurep-of-logic.pand
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (logic.and-structurep (logic.pand x y))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.pand logic.and-structurep))))
+
+(defthm forcing-logic.formulap-of-logic.pand
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (logic.formulap (logic.pand x y))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.pand))))
+
+(defthm forcing-logic.formula-atblp-of-logic.pand
+  (implies (and (force (logic.formula-atblp x atbl))
+                (force (logic.formula-atblp y atbl)))
+           (equal (logic.formula-atblp (logic.pand x y) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.pand))))
+
+(defthm forcing-logic.formulap-of-logic.andlhs
+  (implies (force (logic.and-structurep x))
+           (equal (logic.formulap (logic.andlhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.andlhs logic.and-structurep))))
+
+(defthm forcing-logic.formulap-of-logic.andrhs
+  (implies (force (logic.and-structurep x))
+           (equal (logic.formulap (logic.andrhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.andrhs logic.and-structurep))))
+
+(defthm forcing-logic.formula-atblp-of-logic.andlhs
+  (implies (and (force (logic.and-structurep x))
+                (force (logic.formula-atblp x atbl)))
+           (equal (logic.formula-atblp (logic.andlhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.andlhs logic.and-structurep))))
+
+(defthm forcing-logic.formula-atblp-of-logic.andrhs
+  (implies (and (force (logic.and-structurep x))
+                (force (logic.formula-atblp x atbl)))
+           (equal (logic.formula-atblp (logic.andrhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.andrhs logic.and-structurep))))
+
+(defthm forcing-logic.andlhs-of-logic.pand
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (logic.andlhs (logic.pand x y))
+                  x))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.andlhs logic.pand))))
+
+(defthm forcing-logic.andrhs-of-logic.pand
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (logic.andrhs (logic.pand x y))
+                  y))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.andrhs logic.pand))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/patmatch-formula.lisp acl2-6.3/books/milawa/ACL2/logic/patmatch-formula.lisp
--- acl2-6.2/books/milawa/ACL2/logic/patmatch-formula.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/patmatch-formula.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,299 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "patmatch-term")
+(include-book "substitute-formula")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (logic.formula-vars x) retrieves a list which contains all of the variables
+;; mentioned everywhere throughout a formula
+
+(defund logic.formula-vars (x)
+  (declare (xargs :guard (logic.formulap x)))
+  (cond ((equal (logic.fmtype x) 'por*)
+         (app (logic.formula-vars (logic.vlhs x))
+              (logic.formula-vars (logic.vrhs x))))
+        ((equal (logic.fmtype x) 'pnot*)
+         (logic.formula-vars (logic.~arg x)))
+        ((equal (logic.fmtype x) 'pequal*)
+         (app (logic.term-vars (logic.=lhs x))
+              (logic.term-vars (logic.=rhs x))))
+        (t nil)))
+
+(defthm true-listp-of-logic.formula-vars
+  (equal (true-listp (logic.formula-vars x))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.formula-vars)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm logic.formula-vars-when-logic.por
+  (implies (equal (logic.fmtype x) 'por*)
+           (equal (logic.formula-vars x)
+                  (app (logic.formula-vars (logic.vlhs x))
+                       (logic.formula-vars (logic.vrhs x)))))
+  :hints(("Goal" :in-theory (enable logic.formula-vars))))
+
+(defthm logic.formula-vars-when-logic.pnot
+  (implies (equal (logic.fmtype x) 'pnot*)
+           (equal (logic.formula-vars x)
+                  (logic.formula-vars (logic.~arg x))))
+  :hints(("Goal" :in-theory (enable logic.formula-vars))))
+
+(defthm logic.formula-vars-when-pequal
+  (implies (equal (logic.fmtype x) 'pequal*)
+           (equal (logic.formula-vars x)
+                  (app (logic.term-vars (logic.=lhs x))
+                       (logic.term-vars (logic.=rhs x)))))
+  :hints(("Goal" :in-theory (enable logic.formula-vars))))
+
+(defthm logic.formula-vars-when-degenerate
+  (implies (and (not (equal (logic.fmtype x) 'pequal*))
+                (not (equal (logic.fmtype x) 'pnot*))
+                (not (equal (logic.fmtype x) 'por*)))
+           (equal (logic.formula-vars x)
+                  nil))
+  :hints(("Goal" :in-theory (e/d (logic.formula-vars)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm logic.formula-vars-of-pequal
+  (equal (logic.formula-vars (logic.pequal x y))
+         (app (logic.term-vars x)
+              (logic.term-vars y))))
+
+(defthm logic.formula-vars-of-logic.pnot
+  (equal (logic.formula-vars (logic.pnot x))
+         (logic.formula-vars x)))
+
+(defthm logic.formula-vars-of-logic.por
+  (equal (logic.formula-vars (logic.por x y))
+         (app (logic.formula-vars x)
+              (logic.formula-vars y))))
+
+(defthm logic.variable-listp-of-logic.formula-vars
+  (implies (force (logic.formulap x))
+           (equal (logic.variable-listp (logic.formula-vars x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.formula-vars))))
+
+(defthm equal-of-logic.substitute-formulas-of-expansion
+  (implies (and (subsetp (logic.formula-vars x) (domain sigma1))
+                (submapp sigma1 sigma2))
+           (equal (equal (logic.substitute-formula x sigma1)
+                         (logic.substitute-formula x sigma2))
+                   t))
+  :hints(("Goal" :in-theory (e/d (logic.substitute-formula)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+
+
+
+
+
+;; (logic.patmatch-formula pattern target sigma)
+;;
+;; We extends our simple term-based pattern matching function to formulas.
+
+(defund logic.patmatch-formula (pattern target sigma)
+  (declare (xargs :guard (and (logic.formulap pattern)
+                              (logic.formulap target)
+                              (logic.sigmap sigma))
+                  :verify-guards nil))
+  (cond
+   ((equal (logic.fmtype pattern) 'pequal*)
+    (if (equal (logic.fmtype target) 'pequal*)
+        (let ((match-lhs (logic.patmatch (logic.=lhs pattern) (logic.=lhs target) sigma)))
+          (if (equal match-lhs 'fail)
+              'fail
+            (logic.patmatch (logic.=rhs pattern) (logic.=rhs target) match-lhs)))
+      'fail))
+   ((equal (logic.fmtype pattern) 'pnot*)
+    (if (equal (logic.fmtype target) 'pnot*)
+        (logic.patmatch-formula (logic.~arg pattern) (logic.~arg target) sigma)
+      'fail))
+   ((equal (logic.fmtype pattern) 'por*)
+    (if (equal (logic.fmtype target) 'por*)
+        (let ((match-lhs (logic.patmatch-formula (logic.vlhs pattern) (logic.vlhs target) sigma)))
+          (if (equal match-lhs 'fail)
+              'fail
+            (logic.patmatch-formula (logic.vrhs pattern) (logic.vrhs target) match-lhs)))
+      'fail))
+   (t
+    'fail)))
+
+(defthm forcing-logic.sigmap-of-cdr-of-logic.patmatch-formula
+  (implies (and (force (logic.formulap pattern))
+                (force (logic.formulap target))
+                (force (logic.sigmap sigma)))
+           (equal (logic.sigmap (logic.patmatch-formula pattern target sigma))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.patmatch-formula))))
+
+(defthm forcing-logic.sigma-atblp-of-cdr-of-logic.patmatch-formula
+  (implies (and (force (logic.formula-atblp pattern atbl))
+                (force (logic.formula-atblp target atbl))
+                (force (logic.sigma-atblp sigma atbl)))
+           (equal (logic.sigma-atblp (logic.patmatch-formula pattern target sigma) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.patmatch-formula)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(verify-guards logic.patmatch-formula)
+
+(defthm submapp-of-logic.patmatch-formula
+  (implies (not (equal 'fail (logic.patmatch-formula x y sigma)))
+           (equal (submapp sigma (logic.patmatch-formula x y sigma))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.patmatch-formula)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm memberp-of-domain-of-logic.patmatch-formula
+  (implies (and (memberp a (logic.formula-vars x))
+                (not (equal 'fail (logic.patmatch-formula x y sigma))))
+           (equal (memberp a (domain (logic.patmatch-formula x y sigma)))
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.patmatch-formula)
+                                 (memberp-of-domain-under-iff
+                                  logic.fmtype-normalizer-cheap)))))
+
+(defthm lookup-of-logic.patmatch-formula
+  (implies (and (memberp a (logic.formula-vars x))
+                (not (equal 'fail (logic.patmatch-formula x y sigma))))
+           (iff (lookup a (logic.patmatch-formula x y sigma))
+                t))
+  :hints(("Goal"
+          :in-theory (disable memberp-of-domain-of-logic.patmatch-formula)
+          :use ((:instance memberp-of-domain-of-logic.patmatch-formula)))))
+
+(defthm subsetp-of-logic.formula-vars-with-domain-of-logic.patmatch-formula
+  (implies (not (equal 'fail (logic.patmatch-formula x y sigma)))
+           (equal (subsetp (logic.formula-vars x)
+                           (domain (logic.patmatch-formula x y sigma)))
+                  t))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (logic.formula-vars x))
+                                  (y (domain (logic.patmatch-formula x y sigma))))))))
+
+
+(encapsulate
+ ()
+ (defthmd lemma1-for-forcing-logic.substitute-formula-of-logic.patmatch-formula
+   (implies (and (logic.formulap y)
+                 (equal (logic.fmtype x) 'por*)
+                 (equal (logic.fmtype y) 'por*)
+                 (not (equal 'fail (logic.patmatch-formula (logic.vlhs x) (logic.vlhs y) sigma)))
+                 (equal (logic.substitute-formula (logic.vlhs x) (logic.patmatch-formula (logic.vlhs x) (logic.vlhs y) sigma))
+                        (logic.vlhs y))
+                 (equal (logic.substitute-formula (logic.vrhs x)
+                                                  (logic.patmatch-formula
+                                                   (logic.vrhs x)
+                                                   (logic.vrhs y)
+                                                   (logic.patmatch-formula (logic.vlhs x) (logic.vlhs y) sigma)))
+                        (logic.vrhs y))
+                 (logic.sigmap sigma)
+                 (not (equal 'fail (logic.patmatch-formula (logic.vrhs x)
+                                                           (logic.vrhs y)
+                                                           (logic.patmatch-formula (logic.vlhs x) (logic.vlhs y) sigma)))))
+            (equal (logic.substitute-formula
+                    x
+                    (logic.patmatch-formula (logic.vrhs x)
+                                            (logic.vrhs y)
+                                            (logic.patmatch-formula (logic.vlhs x) (logic.vlhs y) sigma)))
+                   y))
+   :hints(("Goal"
+           :in-theory (e/d (logic.substitute-formula)
+                           (equal-of-logic.substitute-formulas-of-expansion))
+           :use ((:instance equal-of-logic.substitute-formulas-of-expansion
+                            (x (logic.vlhs x))
+                            (sigma1 (logic.patmatch-formula (logic.vlhs x) (logic.vlhs y) sigma))
+                            (sigma2 (logic.patmatch-formula (logic.vrhs x)
+                                                            (logic.vrhs y)
+                                                            (logic.patmatch-formula (logic.vlhs x)
+                                                                                    (logic.vlhs y)
+                                                                                    sigma))))))))
+
+ (defthmd lemma2-for-forcing-logic.substitute-formula-of-logic.patmatch-formula
+   (implies (and (logic.formulap y)
+                 (equal (logic.fmtype x) 'pnot*)
+                 (equal (logic.fmtype y) 'pnot*)
+                 (equal (logic.substitute-formula (logic.~arg x)
+                                                  (logic.patmatch-formula (logic.~arg x) (logic.~arg y) sigma))
+                        (logic.~arg y))
+                 (logic.sigmap sigma)
+                 (not (equal 'fail (logic.patmatch-formula (logic.~arg x) (logic.~arg y) sigma))))
+            (equal (logic.substitute-formula x (logic.patmatch-formula (logic.~arg x) (logic.~arg y) sigma))
+                   y))
+   :hints(("Goal"
+           :in-theory (enable logic.substitute-formula))))
+
+ (defthmd lemma3-for-forcing-logic.substitute-formula-of-logic.patmatch-formula
+   (implies (and (logic.formulap y)
+                 (equal (logic.fmtype x) 'pequal*)
+                 (equal (logic.fmtype y) 'pequal*)
+                 (not (equal 'fail (logic.patmatch (logic.=lhs x) (logic.=lhs y) sigma)))
+                 (logic.sigmap sigma)
+                 (not (equal 'fail (logic.patmatch (logic.=rhs x)
+                                                   (logic.=rhs y)
+                                                   (logic.patmatch (logic.=lhs x) (logic.=lhs y) sigma)))))
+            (equal (logic.substitute-formula x (logic.patmatch (logic.=rhs x)
+                                                               (logic.=rhs y)
+                                                               (logic.patmatch (logic.=lhs x) (logic.=lhs y) sigma)))
+                   y))
+   :hints(("Goal"
+           :in-theory (e/d (logic.substitute-formula)
+                           (forcing-logic.substitute-of-logic.patmatch-expansion))
+           :use ((:instance forcing-logic.substitute-of-logic.patmatch-expansion
+                            (x (logic.=lhs x))
+                            (y (logic.=lhs y))
+                            (sigma sigma)
+                            (sigma2 (logic.patmatch (logic.=rhs x) (logic.=rhs y) (logic.patmatch (logic.=lhs x)
+                                                                                                  (logic.=lhs y)
+                                                                                                  sigma))))))))
+
+ (defthm forcing-logic.substitute-formula-of-logic.patmatch-formula
+   (implies (and (not (equal 'fail (logic.patmatch-formula x y sigma)))
+                 (force (logic.formulap x))
+                 (force (logic.formulap y))
+                 (force (logic.sigmap sigma)))
+            (equal (logic.substitute-formula x (logic.patmatch-formula x y sigma))
+                   y))
+   :hints(("Goal" :in-theory (enable logic.patmatch-formula
+                                     lemma1-for-forcing-logic.substitute-formula-of-logic.patmatch-formula
+                                     lemma2-for-forcing-logic.substitute-formula-of-logic.patmatch-formula
+                                     lemma3-for-forcing-logic.substitute-formula-of-logic.patmatch-formula)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/patmatch-term.lisp acl2-6.3/books/milawa/ACL2/logic/patmatch-term.lisp
--- acl2-6.2/books/milawa/ACL2/logic/patmatch-term.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/patmatch-term.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,411 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defun logic.flag-patmatch (flag pat term sigma)
+  ;; We attempt to match a pattern term (list) against a target term (list)
+  ;; under some sigma.  That is, we try to find a new sigma', which is a
+  ;; supermap of sigma, which can be substituted into the pattern term in order
+  ;; to obtain the target term.
+  ;;
+  ;; We return a pair of values, e.g., (successp . sigma'), where successp is a
+  ;; boolean indicator of success, and if successp is t, then sigma' extends
+  ;; sigma in an acceptable way as described above.
+  (declare (xargs :guard (if (equal flag 'term)
+                             (and (logic.termp pat)
+                                  (logic.termp term)
+                                  (logic.sigmap sigma))
+                           (and (logic.term-listp pat)
+                                (logic.term-listp term)
+                                (logic.sigmap sigma)))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp pat)
+             (if (equal term pat)
+                 sigma
+               'fail))
+            ((logic.variablep pat)
+             (let ((value (lookup pat sigma)))
+               (if (consp value)
+                   (if (equal term (cdr value))
+                       sigma
+                     'fail)
+                 (cons (cons pat term) sigma))))
+            ((logic.functionp pat)
+             (if (and (logic.functionp term)
+                      (equal (logic.function-name term) (logic.function-name pat)))
+                 (logic.flag-patmatch 'list (logic.function-args pat) (logic.function-args term) sigma)
+               'fail))
+            ((logic.lambdap pat)
+             'fail)
+            (t 'fail))
+    ;; List case
+    (if (or (not (consp pat))
+            (not (consp term)))
+        (if (and (not (consp pat))
+                 (not (consp term)))
+            sigma
+          'fail)
+      (let* ((match-car (logic.flag-patmatch 'term (car pat) (car term) sigma)))
+        (if (equal match-car 'fail)
+            'fail
+          (logic.flag-patmatch 'list (cdr pat) (cdr term) match-car))))))
+
+(definlined logic.patmatch (pat term sigma)
+  (declare (xargs :guard (and (logic.termp pat)
+                              (logic.termp term)
+                              (logic.sigmap sigma))
+                  :verify-guards nil))
+  (logic.flag-patmatch 'term pat term sigma))
+
+(definlined logic.patmatch-list (pat term sigma)
+  (declare (xargs :guard (and (logic.term-listp pat)
+                              (logic.term-listp term)
+                              (logic.sigmap sigma))
+                  :verify-guards nil))
+  (logic.flag-patmatch 'list pat term sigma))
+
+(defthmd definition-of-logic.patmatch
+  (equal (logic.patmatch pat term sigma)
+         (cond ((logic.constantp pat)
+                (if (equal term pat)
+                    sigma
+                  'fail))
+               ((logic.variablep pat)
+                (let ((value (lookup pat sigma)))
+                  (if (consp value)
+                      (if (equal term (cdr value))
+                          sigma
+                        'fail)
+                    (cons (cons pat term) sigma))))
+               ((logic.functionp pat)
+                (if (and (logic.functionp term)
+                         (equal (logic.function-name term) (logic.function-name pat)))
+                    (logic.patmatch-list (logic.function-args pat) (logic.function-args term) sigma)
+                  'fail))
+               ((logic.lambdap pat)
+                'fail)
+               (t 'fail)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-patmatch
+                                    logic.patmatch
+                                    logic.patmatch-list))))
+
+(defthmd definition-of-logic.patmatch-list
+  (equal (logic.patmatch-list pat term sigma)
+         (if (or (not (consp pat))
+                 (not (consp term)))
+             (if (and (not (consp pat))
+                      (not (consp term)))
+                 sigma
+               'fail)
+           (let* ((match-car (logic.patmatch (car pat) (car term) sigma)))
+             (if (equal match-car 'fail)
+                 'fail
+               (logic.patmatch-list (cdr pat) (cdr term) match-car)))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-patmatch
+                                    logic.patmatch
+                                    logic.patmatch-list))))
+
+(defthm logic.flag-patmatch-term-removal
+  (equal (logic.flag-patmatch 'term pat term sigma)
+         (logic.patmatch pat term sigma))
+  :hints(("Goal" :in-theory (enable logic.patmatch))))
+
+(defthm logic.flag-patmatch-list-removal
+  (equal (logic.flag-patmatch 'list pat term sigma)
+         (logic.patmatch-list pat term sigma))
+  :hints(("Goal" :in-theory (enable logic.patmatch-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.patmatch))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.patmatch-list))))
+
+
+
+
+(defthms-flag
+  :shared-hyp (force (logic.sigmap sigma))
+  :thms ((term forcing-logic.sigmap-of-logic.patmatch
+               (implies (and (force (logic.termp x))
+                             (force (logic.termp y)))
+                        (equal (logic.sigmap (logic.patmatch x y sigma))
+                               t)))
+         (t forcing-logic.sigmap-of-logic.patmatch-list
+            (implies (and (force (logic.term-listp x))
+                          (force (logic.term-listp y)))
+                     (equal (logic.sigmap (logic.patmatch-list x y sigma))
+                            t))))
+  :hints (("Goal"
+           :induct (logic.flag-patmatch flag x y sigma)
+           :in-theory (enable definition-of-logic.patmatch
+                              definition-of-logic.patmatch-list))))
+
+
+(defthms-flag
+  :shared-hyp (force (logic.sigma-atblp sigma atbl))
+  :thms ((term forcing-logic.sigma-atblp-of-logic.patmatch
+               (implies (and (force (logic.term-atblp x atbl))
+                             (force (logic.term-atblp y atbl)))
+                        (equal (logic.sigma-atblp (logic.patmatch x y sigma) atbl)
+                               t)))
+         (t forcing-logic.sigma-atblp-of-logic.patmatch-list
+            (implies (and (force (logic.term-list-atblp x atbl))
+                          (force (logic.term-list-atblp y atbl)))
+                     (equal (logic.sigma-atblp (logic.patmatch-list x y sigma) atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.flag-patmatch flag x y sigma)
+           :in-theory (enable definition-of-logic.patmatch
+                              definition-of-logic.patmatch-list))))
+
+(verify-guards logic.flag-patmatch)
+(verify-guards logic.patmatch)
+(verify-guards logic.patmatch-list)
+
+
+(defthms-flag
+  ;; BOZO these are called forcing, but they don't have any forced hyps
+  ;; I think they used to have hyps that I got rid of.
+  :thms ((term forcing-submapp-of-logic.patmatch
+               (implies (not (equal 'fail (logic.patmatch x y sigma)))
+                        (equal (submapp sigma (logic.patmatch x y sigma))
+                               t)))
+         (t forcing-submapp-of-logic.patmatch-list
+            (implies (not (equal 'fail (logic.patmatch-list x y sigma)))
+                     (equal (submapp sigma (logic.patmatch-list x y sigma))
+                            t))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-logic.patmatch
+                              definition-of-logic.patmatch-list)
+           :induct (logic.flag-patmatch flag x y sigma))))
+
+(defthm two-deep-submapp-of-logic.patmatch
+  (implies (and (not (equal 'fail (logic.patmatch a b sigma)))
+                (not (equal 'fail (logic.patmatch c d (logic.patmatch a b sigma)))))
+           (equal (submapp sigma (logic.patmatch c d (logic.patmatch a b sigma)))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable forcing-submapp-of-logic.patmatch)
+          :use ((:instance forcing-submapp-of-logic.patmatch
+                           (x a) (y b) (sigma sigma))
+                (:instance forcing-submapp-of-logic.patmatch
+                           (x c) (y d) (sigma (logic.patmatch a b sigma)))))))
+
+(defthmd lemma-2-for-memberp-of-domain-of-logic.patmatch
+  (implies (not (equal 'fail (logic.patmatch-list x y (cons (cons key val) sigma))))
+           (equal (lookup key (logic.patmatch-list x y (cons (cons key val) sigma)))
+                  (cons key val)))
+  :hints(("Goal"
+          :in-theory (disable equal-of-lookups-when-submapp)
+          :use ((:instance equal-of-lookups-when-submapp
+                           (a key)
+                           (x (cons (cons key val) sigma))
+                           (y (logic.patmatch-list x y (cons (cons key val) sigma))))))))
+
+(defthms-flag
+  ;; BOZO add -when... to these names?
+  :thms ((term memberp-of-domain-of-logic.patmatch
+               (implies (and (not (equal 'fail (logic.patmatch x y sigma)))
+                             (memberp a (logic.term-vars x)))
+                        (equal (memberp a (domain (logic.patmatch x y sigma)))
+                               t)))
+         (t memberp-of-domain-of-logic.patmatch-list
+            (implies (and (not (equal 'fail (logic.patmatch-list x y sigma)))
+                          (memberp a (logic.term-list-vars x)))
+                     (equal (memberp a (domain (logic.patmatch-list x y sigma)))
+                            t))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-logic.patmatch
+                              definition-of-logic.patmatch-list
+                              lemma-2-for-memberp-of-domain-of-logic.patmatch)
+           :induct (logic.flag-patmatch flag x y sigma))))
+
+(defthm two-deep-memberp-of-logic.patmatch
+  (implies (and (memberp e (logic.term-vars a))
+                (not (equal 'fail (logic.patmatch a b sigma)))
+                (not (equal 'fail (logic.patmatch c d (logic.patmatch a b sigma)))))
+           (equal (memberp e (domain (logic.patmatch c d (logic.patmatch a b sigma))))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable memberp-of-domain-of-logic.patmatch)
+          :use ((:instance memberp-of-domain-of-logic.patmatch
+                           (a e) (x a) (y b) (sigma sigma))
+                (:instance memberp-of-domain-of-logic.patmatch
+                           (a e) (x c) (y d) (sigma (logic.patmatch a b sigma)))))))
+
+(defthm subsetp-of-logic.term-vars-and-domain-of-logic.patmatch
+  (implies (not (equal 'fail (logic.patmatch x y sigma)))
+           (equal (subsetp (logic.term-vars x) (domain (logic.patmatch x y sigma)))
+                  t))
+  :hints(("Goal"
+          ;; yuck, but we don't want to think of this as a mapp right now.
+          :in-theory (disable memberp-of-domain-under-iff)
+          :use ((:instance subsetp-badguy-membership-property
+                           (x (logic.term-vars x))
+                           (y (domain (logic.patmatch x y sigma))))))))
+
+(defthm subsetp-of-logic.term-list-vars-and-domain-of-logic.patmatch-list
+  (implies (not (equal (logic.patmatch-list x y sigma) 'fail))
+           (equal (subsetp (logic.term-list-vars x)
+                           (domain (logic.patmatch-list x y sigma)))
+                  t))
+  :hints(("Goal"
+          ;; yuck, but we don't want to think of this as a mapp right now.
+          :in-theory (disable memberp-of-domain-under-iff)
+          :use ((:instance subsetp-badguy-membership-property
+                           (x (logic.term-list-vars x))
+                           (y (domain (logic.patmatch-list x y sigma))))))))
+
+(defthm two-deep-subsetp-of-logic.patmatch
+  (implies (and (not (equal 'fail (logic.patmatch a b sigma)))
+                (not (equal 'fail (logic.patmatch c d (logic.patmatch a b sigma)))))
+           (equal (subsetp (logic.term-vars a)
+                           (domain (logic.patmatch c d (logic.patmatch a b sigma))))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable subsetp-of-logic.term-vars-and-domain-of-logic.patmatch)
+          :use ((:instance subsetp-of-logic.term-vars-and-domain-of-logic.patmatch
+                           (x a) (y b) (sigma sigma))
+                (:instance subsetp-of-logic.term-vars-and-domain-of-logic.patmatch
+                           (x c) (y d) (sigma (logic.patmatch a b sigma)))))))
+
+
+
+(encapsulate
+ ()
+ (defthmd lemma-1-for-forcing-logic.substitute-of-logic.patmatch
+   ;; This isn't needed by Milawa for some reason
+   (implies (and (not (equal 'fail (logic.patmatch-list x y sigma)))
+                 (lookup key sigma))
+            (equal (lookup key (logic.patmatch-list x y sigma))
+                   (lookup key sigma)))
+   :hints(("Goal"
+           :in-theory (disable equal-of-lookups-when-submapp)
+           :use ((:instance equal-of-lookups-when-submapp
+                            (a key)
+                            (x sigma)
+                            (y (logic.patmatch-list x y sigma)))))))
+
+ (defthmd lemma-2-for-forcing-logic.substitute-of-logic.patmatch
+   (implies (and (consp x)
+                 (consp y)
+                 (not (equal 'fail (logic.patmatch (car x) (car y) sigma)))
+                 (not (equal 'fail (logic.patmatch-list (cdr x) (cdr y) (logic.patmatch (car x) (car y) sigma))))
+                 (equal (logic.substitute (car x) (logic.patmatch (car x) (car y) sigma)) (car y))
+                 (equal (logic.substitute-list (cdr x) (logic.patmatch-list (cdr x) (cdr y) (logic.patmatch (car x) (car y) sigma)))
+                        (list-fix (cdr y))))
+            (equal (logic.substitute-list x (logic.patmatch-list (cdr x) (cdr y) (logic.patmatch (car x) (car y) sigma)))
+                   (list-fix y)))
+   :hints(("Goal"
+           :in-theory (e/d (lemma-1-for-forcing-logic.substitute-of-logic.patmatch
+                            definition-of-logic.patmatch
+                            definition-of-logic.patmatch-list)
+                           (equal-of-logic.substitutes-of-expansion))
+           :use ((:instance equal-of-logic.substitutes-of-expansion
+                            (x (car x))
+                            (sigma1 (logic.patmatch (car x) (car y) sigma))
+                            (sigma2 (logic.patmatch-list (cdr x) (cdr y) (logic.patmatch (car x) (car y) sigma))))))))
+
+ (defthms-flag
+   :thms ((term forcing-logic.substitute-of-logic.patmatch
+                (implies (and (not (equal 'fail (logic.patmatch x y sigma)))
+                              (force (logic.termp y)))
+                         (equal (logic.substitute x (logic.patmatch x y sigma))
+                                y)))
+          (t forcing-logic.substitute-list-of-logic.patmatch-list
+             (implies (and (not (equal 'fail (logic.patmatch-list x y sigma)))
+                           (force (logic.term-listp y)))
+                      (equal (logic.substitute-list x (logic.patmatch-list x y sigma))
+                             (list-fix y)))))
+   :hints (("Goal"
+            :induct (logic.flag-patmatch flag x y sigma)
+            :in-theory (enable definition-of-logic.patmatch
+                               definition-of-logic.patmatch-list))
+           ("Subgoal *1/13"
+            :use ((:instance lemma-2-for-forcing-logic.substitute-of-logic.patmatch))))))
+
+
+
+
+;; Theorem: In fact, if any extension of the sigma returned by logic.patmatch(-list)
+;; is substituted into the pattern term, we still obtain the target term.
+
+(defthm forcing-logic.substitute-of-logic.patmatch-expansion
+  (implies (and (not (equal 'fail (logic.patmatch x y sigma)))
+                (submapp (logic.patmatch x y sigma) sigma2)
+                (force (logic.termp y)))
+            (equal (logic.substitute x sigma2)
+                   y))
+  :hints(("Goal"
+          :in-theory (disable equal-of-logic.substitutes-of-expansion)
+          :use ((:instance equal-of-logic.substitutes-of-expansion
+                           (x x)
+                           (sigma1 (logic.patmatch x y sigma))
+                           (sigma2 sigma2))))))
+
+(defthm forcing-logic.substitute-of-logic.patmatch-list-expansion
+  (implies (and (not (equal 'fail (logic.patmatch-list x y sigma)))
+                (submapp (logic.patmatch-list x y sigma) sigma2)
+                (force (logic.term-listp y)))
+            (equal (logic.substitute-list x sigma2)
+                   (list-fix y)))
+  :hints(("Goal"
+          :in-theory (disable equal-of-logic.substitute-lists-of-expansion)
+          :use ((:instance equal-of-logic.substitute-lists-of-expansion
+                           (x x)
+                           (sigma1 (logic.patmatch-list x y sigma))
+                           (sigma2 sigma2))))))
+
+(defthms-flag
+  :shared-hyp (force (uniquep (domain sigma)))
+  :thms ((term forcing-uniquep-of-domain-of-cdr-of-logic.patmatch
+               (equal (uniquep (domain (logic.patmatch x y sigma)))
+                      t))
+         (t forcing-uniquep-of-domain-of-cdr-of-logic.patmatch-list
+            (equal (uniquep (domain (logic.patmatch-list x y sigma)))
+                   t)))
+  :hints (("Goal"
+           :in-theory (enable definition-of-logic.patmatch
+                              definition-of-logic.patmatch-list)
+           :induct (logic.flag-patmatch flag x y sigma))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/pequal-list.lisp acl2-6.3/books/milawa/ACL2/logic/pequal-list.lisp
--- acl2-6.2/books/milawa/ACL2/logic/pequal-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/pequal-list.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,339 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund logic.pequal-list (x y)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.term-listp y)
+                              (equal (len x) (len y)))))
+  (if (and (consp x)
+           (consp y))
+      (cons (logic.pequal (car x) (car y))
+            (logic.pequal-list (cdr x) (cdr y)))
+    nil))
+
+(defthm logic.pequal-list-when-not-consp-one
+  (implies (not (consp x))
+           (equal (logic.pequal-list x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.pequal-list))))
+
+(defthm logic.pequal-list-when-not-consp-two
+  (implies (not (consp y))
+           (equal (logic.pequal-list x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.pequal-list))))
+
+(defthm logic.pequal-list-of-cons-and-cons
+  (equal (logic.pequal-list (cons a x) (cons b y))
+         (cons (logic.pequal a b)
+               (logic.pequal-list x y)))
+  :hints(("Goal" :in-theory (enable logic.pequal-list))))
+
+(defthm logic.pequal-list-under-iff
+  (iff (logic.pequal-list x y)
+       (and (consp x)
+            (consp y)))
+  :hints(("Goal" :in-theory (enable logic.pequal-list))))
+
+(defthm logic.pequal-list-of-list-fix-one
+  (equal (logic.pequal-list (list-fix x) y)
+         (logic.pequal-list x y))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm logic.pequal-list-of-list-fix-two
+  (equal (logic.pequal-list x (list-fix y))
+         (logic.pequal-list x y))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm true-listp-of-logic.pequal-list
+  (equal (true-listp (logic.pequal-list x y))
+         t)
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.formulap-of-logic.pequal-list
+  (implies (and (force (logic.term-listp x))
+                (force (logic.term-listp y)))
+           (equal (logic.formula-listp (logic.pequal-list x y))
+                  t))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.formula-atblp-of-logic.pequal-list
+  (implies (and (force (logic.term-list-atblp x atbl))
+                (force (logic.term-list-atblp y atbl)))
+           (equal (logic.formula-list-atblp (logic.pequal-list x y) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm consp-of-logic.pequal-list
+  (equal (consp (logic.pequal-list x y))
+         (and (consp x)
+              (consp y))))
+
+(defthm car-of-logic.pequal-list
+  (equal (car (logic.pequal-list x y))
+         (if (and (consp x)
+                  (consp y))
+             (logic.pequal (car x) (car y))
+           nil))
+  :hints(("Goal" :expand (logic.pequal-list x y))))
+
+(defthm cdr-of-logic.pequal-list
+  (equal (cdr (logic.pequal-list x y))
+         (logic.pequal-list (cdr x) (cdr y))))
+
+(defthm len-of-logic.pequal-list
+  (equal (len (logic.pequal-list x y))
+         (if (< (len x) (len y))
+             (len x)
+           (len y)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm logic.pequal-list-of-cons-and-repeat-plus-one
+  (equal (logic.pequal-list (cons a x) (repeat b (+ 1 n)))
+         (cons (logic.pequal a b)
+               (logic.pequal-list x (repeat b n)))))
+
+(defthm equal-of-logic.pequal-list-and-logic.pequal-list
+  (implies (force (and (logic.term-listp a)
+                       (logic.term-listp b)
+                       (logic.term-listp c)
+                       (logic.term-listp d)
+                       (equal (len a) (len b))
+                       (equal (len c) (len d))))
+           (equal (equal (logic.pequal-list a b)
+                         (logic.pequal-list c d))
+                  (and (equal (list-fix a) (list-fix c))
+                       (equal (list-fix b) (list-fix d)))))
+  :hints(("Goal" :induct (four-cdrs-induction a b c d))))
+
+(defthm logic.pequal-list-of-app-and-app
+  (implies (equal (len a) (len c))
+           (equal (logic.pequal-list (app a b) (app c d))
+                  (app (logic.pequal-list a c)
+                       (logic.pequal-list b d))))
+  :hints(("Goal" :induct (cdr-cdr-induction a c))))
+
+(defthm rev-of-logic.pequal-list
+  (implies (force (equal (len a) (len b)))
+           (equal (rev (logic.pequal-list a b))
+                  (logic.pequal-list (rev a) (rev b))))
+  :hints(("Goal" :induct (cdr-cdr-induction a b))))
+
+
+
+
+;; We call formulas of the form t1 = t2 atomic.  Given a list of atomic
+;; formula, [t1 = s1, t2 = s2, ..., tn = sn], it is sometimes useful to
+;; consider the lists of left and right hand sides.  That is, the lists [t1,
+;; t2, ..., tn] and [s1, s2, ..., sn].  The functions logic.=lhses and
+;; logic.=rhses will do this for us.
+
+(deflist logic.all-atomicp (x)
+  (equal (logic.fmtype x) 'pequal*)
+  :elementp-of-nil nil
+  :guard (logic.formula-listp x))
+
+;; Some of the rules that are generated aren't very good because they're
+;; for the general case; we replace them.
+(in-theory (disable equal-of-car-when-logic.all-atomicp
+                    equal-when-memberp-of-logic.all-atomicp
+                    equal-when-memberp-of-logic.all-atomicp-alt))
+
+(defthm logic.fmtype-of-car-when-logic.all-atomicp
+  (implies (and (logic.all-atomicp x)
+                (consp x))
+           (equal (logic.fmtype (car x))
+                  'pequal*)))
+
+(defthm logic.fmtype-when-memberp-of-logic.all-atomicp
+  (implies (and (memberp a x)
+                (logic.all-atomicp x))
+           (equal (logic.fmtype a)
+                  'pequal*))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-when-memberp-of-logic.all-atomicp-alt
+  (implies (and (logic.all-atomicp x)
+                (memberp a x))
+           (equal (logic.fmtype a)
+                  'pequal*)))
+
+(defthm forcing-logic.all-atomicp-of-logic.pequal-list
+  (implies (and (force (logic.term-listp x))
+                (force (logic.term-listp y)))
+           (equal (logic.all-atomicp (logic.pequal-list x y))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.pequal-list))))
+
+(defthm forcing-logic.all-atomicp-of-logic.pequal-list-free
+  (implies (and (equal a (logic.pequal-list x y))
+                (force (logic.term-listp x))
+                (force (logic.term-listp y)))
+           (equal (logic.all-atomicp a)
+                  t)))
+
+(defthm logic.fmtype-of-nth-when-logic.all-atomicp
+  (implies (logic.all-atomicp x)
+           (equal (logic.fmtype (nth n x))
+                  (if (< (nfix n) (len x))
+                      'pequal*
+                    nil)))
+  :hints(("Goal" :in-theory (enable nth))))
+
+
+
+
+(defprojection :list (logic.=lhses x)
+               :element (logic.=lhs x)
+               :guard (and (logic.formula-listp x)
+                           (logic.all-atomicp x))
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-logic.=lhses
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.all-atomicp x)))
+           (equal (logic.term-listp (logic.=lhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-logic.=lhses
+  (implies (and (force (logic.formula-list-atblp x atbl))
+                (force (logic.all-atomicp x)))
+           (equal (logic.term-list-atblp (logic.=lhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.=lhses-of-logic.pequal-list
+  (implies (and (force (logic.term-listp x))
+                (force (logic.term-listp y))
+                (force (equal (len x) (len y))))
+           (equal (logic.=lhses (logic.pequal-list x y))
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.=lhses-of-logic.pequal-list-free
+  (implies (and (equal a (logic.pequal-list x y))
+                (force (logic.term-listp x))
+                (force (logic.term-listp y))
+                (force (equal (len x) (len y))))
+           (equal (logic.=lhses a)
+                  (list-fix x))))
+
+
+
+
+
+(defprojection :list (logic.=rhses x)
+               :element (logic.=rhs x)
+               :guard (and (logic.formula-listp x)
+                           (logic.all-atomicp x))
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-logic.=rhses
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.all-atomicp x)))
+           (equal (logic.term-listp (logic.=rhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-logic.=rhses
+  (implies (and (force (logic.formula-list-atblp x atbl))
+                (force (logic.all-atomicp x)))
+           (equal (logic.term-list-atblp (logic.=rhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-logic.=rhses-free
+  (implies (and (equal x (logic.=rhses y))
+                (force (logic.formula-list-atblp y atbl))
+                (force (logic.all-atomicp y)))
+           (equal (logic.term-list-atblp x atbl)
+                  t)))
+
+(defthm forcing-logic.=rhses-of-logic.pequal-list
+  (implies (and (force (logic.term-listp x))
+                (force (logic.term-listp y))
+                (force (equal (len x) (len y))))
+           (equal (logic.=rhses (logic.pequal-list x y))
+                  (list-fix y)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.=rhses-of-logic.pequal-list-free
+  (implies (and (equal a (logic.pequal-list x y))
+                (force (logic.term-listp x))
+                (force (logic.term-listp y))
+                (force (equal (len x) (len y))))
+           (equal (logic.=rhses a)
+                  (list-fix y))))
+
+(defthm forcing-logic.pequal-list-of-logic.=lhses-and-logic.=rhses
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.all-atomicp x)))
+           (equal (logic.pequal-list (logic.=lhses x)
+                                     (logic.=rhses x))
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthm forcing-equal-of-logic.pequal-list-rewrite
+  (implies (and (force (equal (len x) (len y)))
+                (force (logic.term-listp x))
+                (force (logic.term-listp y)))
+           (equal (equal (logic.pequal-list x y) z)
+                  (and (true-listp z)
+                       (logic.formula-listp z)
+                       (logic.all-atomicp z)
+                       (equal (list-fix x) (logic.=lhses z))
+                       (equal (list-fix y) (logic.=rhses z)))))
+  :hints(("Goal" :induct (cdr-cdr-cdr-induction x y z))))
+
+(defthm logic.pequal-list-of-app-with-repeat
+  (implies (and (force (equal n (+ (len x) (len y))))
+                (force (logic.term-listp y))
+                (force (logic.term-listp x))
+                (force (logic.termp a)))
+           (equal (logic.pequal-list (app x y) (repeat a n))
+                  (app (logic.pequal-list x (repeat a (len x)))
+                       (logic.pequal-list y (repeat a (len y))))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/piff.lisp acl2-6.3/books/milawa/ACL2/logic/piff.lisp
--- acl2-6.2/books/milawa/ACL2/logic/piff.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/piff.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,153 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "pand")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; BOZO Dammit I hate this stupid file too.  I wish it would die in a fire.
+
+;; Recall that F <-> G is an abbreviation for (F -> G) ^ (G -> F).
+;; I.e., (~F v G) ^ (~G v F)
+
+(defund logic.iff-structurep (x)
+  (declare (xargs :guard t))
+  (and (logic.and-structurep x)
+       (let ((or-not-f-g (logic.andlhs x))
+             (or-not-g-f (logic.andrhs x)))
+         (and (equal (logic.fmtype or-not-f-g) 'por*)
+              (equal (logic.fmtype or-not-g-f) 'por*)
+              (let ((not-f (logic.vlhs or-not-f-g))
+                    (not-g (logic.vlhs or-not-g-f)))
+                (and (equal (logic.fmtype not-f) 'pnot*)
+                     (equal (logic.fmtype not-g) 'pnot*)
+                     (equal (logic.~arg not-f) (logic.vrhs or-not-g-f))
+                     (equal (logic.~arg not-g) (logic.vrhs or-not-f-g))))))))
+
+(defthm booleanp-of-logic.iff-structurep
+  (booleanp (logic.iff-structurep x))
+  :hints(("Goal" :in-theory (enable logic.iff-structurep))))
+
+(defund logic.ifflhs (x)
+  (declare (xargs :guard (logic.iff-structurep x)
+                  :guard-hints (("Goal" :in-theory (enable logic.iff-structurep)))))
+  (logic.vrhs      ;; F
+   (logic.andrhs   ;; (~G v F)
+    x)))           ;; (~F v G) ^ (~G v F)
+
+(defund logic.iffrhs (x)
+  (declare (xargs :guard (logic.iff-structurep x)
+                  :guard-hints (("Goal" :in-theory (enable logic.iff-structurep)))))
+  (logic.vrhs      ;; G
+   (logic.andlhs   ;; (~F v G)
+    x)))           ;; (~F v G) ^ (~G v F)
+
+(defund logic.piff (x y)
+  (declare (xargs :guard (and (logic.formulap x)
+                              (logic.formulap y))))
+  (logic.pand (logic.por (logic.pnot x) y)
+              (logic.por (logic.pnot y) x)))
+
+(in-theory (disable (:executable-counterpart logic.piff)))
+
+(defthm logic.piff-under-iff
+  (iff (logic.piff x y)
+       t)
+  :hints(("Goal" :in-theory (enable logic.piff))))
+
+(defthm forcing-logic.iff-structurep-of-logic.piff
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (logic.iff-structurep (logic.piff x y))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.piff logic.iff-structurep))))
+
+(defthm forcing-logic.formulap-of-logic.piff
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (logic.formulap (logic.piff x y))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.piff))))
+
+(defthm forcing-logic.formula-atblp-of-logic.piff
+  (implies (and (force (logic.formula-atblp x atbl))
+                (force (logic.formula-atblp y atbl)))
+           (equal (logic.formula-atblp (logic.piff x y) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.piff))))
+
+(defthm forcing-logic.formulap-of-logic.ifflhs
+  (implies (force (logic.iff-structurep x))
+           (equal (logic.formulap (logic.ifflhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.ifflhs logic.iff-structurep))))
+
+(defthm forcing-logic.formulap-of-logic.iffrhs
+  (implies (force (logic.iff-structurep x))
+           (equal (logic.formulap (logic.iffrhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.iffrhs logic.iff-structurep))))
+
+(defthm forcing-logic.formula-atblp-of-logic.ifflhs
+  (implies (and (force (logic.iff-structurep x))
+                (force (logic.formula-atblp x atbl)))
+           (equal (logic.formula-atblp (logic.ifflhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.ifflhs logic.iff-structurep))))
+
+(defthm forcing-logic.formula-atblp-of-logic.iffrhs
+  (implies (and (force (logic.iff-structurep x))
+                (force (logic.formula-atblp x atbl)))
+           (equal (logic.formula-atblp (logic.iffrhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.iffrhs logic.iff-structurep))))
+
+(defthm forcing-logic.ifflhs-of-logic.piff
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (logic.ifflhs (logic.piff x y))
+                  x))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.ifflhs logic.piff))))
+
+(defthm forcing-logic.iffrhs-of-logic.piff
+  (implies (and (force (logic.formulap x))
+                (force (logic.formulap y)))
+           (equal (logic.iffrhs (logic.piff x y))
+                  y))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.iffrhs logic.piff))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/por-list.lisp acl2-6.3/books/milawa/ACL2/logic/por-list.lisp
--- acl2-6.2/books/milawa/ACL2/logic/por-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/por-list.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,287 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund logic.por-list (x y)
+  (declare (xargs :guard (and (logic.formula-listp x)
+                              (logic.formula-listp y)
+                              (same-lengthp x y))))
+  (if (and (consp x)
+           (consp y))
+      (cons (logic.por (car x) (car y))
+            (logic.por-list (cdr x) (cdr y)))
+    nil))
+
+(defthm logic.por-list-when-not-consp-one
+  (implies (not (consp x))
+           (equal (logic.por-list x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.por-list))))
+
+(defthm logic.por-list-when-not-consp-two
+  (implies (not (consp y))
+           (equal (logic.por-list x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.por-list))))
+
+(defthm logic.por-list-of-cons-and-cons
+  (equal (logic.por-list (cons a x) (cons b y))
+         (cons (logic.por a b)
+               (logic.por-list x y)))
+  :hints(("Goal" :in-theory (enable logic.por-list))))
+
+(defthm logic.por-list-under-iff
+  (iff (logic.por-list x y)
+       (and (consp x)
+            (consp y)))
+  :hints(("Goal" :in-theory (enable logic.por-list))))
+
+(defthm logic.por-list-of-list-fix-one
+  (equal (logic.por-list (list-fix x) y)
+         (logic.por-list x y))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm logic.por-list-of-list-fix-two
+  (equal (logic.por-list x (list-fix y))
+         (logic.por-list x y))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm true-listp-of-logic.por-list
+  (equal (true-listp (logic.por-list x y))
+         t)
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.formulap-of-logic.por-list
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.formula-listp y)))
+           (equal (logic.formula-listp (logic.por-list x y))
+                  t))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.formula-atblp-of-logic.por-list
+  (implies (and (force (logic.formula-list-atblp x atbl))
+                (force (logic.formula-list-atblp y atbl)))
+           (equal (logic.formula-list-atblp (logic.por-list x y) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm consp-of-logic.por-list
+  (equal (consp (logic.por-list x y))
+         (and (consp x)
+              (consp y))))
+
+(defthm car-of-logic.por-list
+  (equal (car (logic.por-list x y))
+         (if (and (consp x)
+                  (consp y))
+             (logic.por (car x) (car y))
+           nil))
+  :hints(("Goal" :expand (logic.por-list x y))))
+
+(defthm cdr-of-logic.por-list
+  (equal (cdr (logic.por-list x y))
+         (logic.por-list (cdr x) (cdr y))))
+
+(defthm len-of-logic.por-list
+  (equal (len (logic.por-list x y))
+         (if (< (len x) (len y))
+             (len x)
+           (len y)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.por-list-of-singleton-lhs
+  (implies (force (consp rhs))
+           (equal (logic.por-list (list lhs) rhs)
+                  (list (logic.por lhs (car rhs))))))
+
+
+
+
+(deflist logic.all-disjunctionsp (x)
+  (equal (logic.fmtype x) 'por*)
+  :elementp-of-nil nil
+  :guard (logic.formula-listp x))
+
+;; Some of the rules that are generated aren't very good because they're
+;; for the general case; we replace them.
+(in-theory (disable equal-of-car-when-logic.all-disjunctionsp
+                    equal-when-memberp-of-logic.all-disjunctionsp
+                    equal-when-memberp-of-logic.all-disjunctionsp-alt))
+
+(defthm logic.fmtype-of-car-when-logic.all-disjunctionsp
+  (implies (and (logic.all-disjunctionsp x)
+                (consp x))
+           (equal (logic.fmtype (car x))
+                  'por*)))
+
+(defthm logic.fmtype-when-memberp-of-logic.all-disjunctionsp
+  (implies (and (memberp a x)
+                (logic.all-disjunctionsp x))
+           (equal (logic.fmtype a)
+                  'por*))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-when-memberp-of-logic.all-disjunctionsp-alt
+  (implies (and (logic.all-disjunctionsp x)
+                (memberp a x))
+           (equal (logic.fmtype a)
+                  'por*)))
+
+(defthm forcing-logic.all-disjunctionsp-of-logic.por-list
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.formula-listp y)))
+           (logic.all-disjunctionsp (logic.por-list x y)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.all-disjunctionsp-of-logic.por-list-free
+  (implies (and (equal x (logic.por-list lhs rhs))
+                (force (logic.formula-listp lhs))
+                (force (logic.formula-listp rhs))
+                (force (equal (len lhs) (len rhs))))
+           (equal (logic.all-disjunctionsp x)
+                  t)))
+
+(defthm logic.fmtype-of-nth-when-logic.all-disjunctionsp
+  (implies (logic.all-disjunctionsp x)
+           (equal (logic.fmtype (nth n x))
+                  (if (< (nfix n) (len x))
+                      'por*
+                      nil)))
+  :hints (("Goal" :in-theory (enable nth))))
+
+
+
+
+
+(defprojection :list (logic.vlhses x)
+               :element (logic.vlhs x)
+               :guard (and (logic.formula-listp x)
+                           (logic.all-disjunctionsp x))
+               :nil-preservingp t)
+
+(defthm forcing-logic.formula-listp-of-logic.vlhses
+  (implies (and (force (logic.all-disjunctionsp x))
+                (force (logic.formula-listp x)))
+           (equal (logic.formula-listp (logic.vlhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.vlhses
+  (implies (and (force (logic.all-disjunctionsp x))
+                (force (logic.formula-list-atblp x atbl)))
+           (equal (logic.formula-list-atblp (logic.vlhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.vlhses-of-logic.por-list
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.formula-listp y))
+                (force (equal (len x) (len y))))
+           (equal (logic.vlhses (logic.por-list x y))
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.vlhses-of-logic.por-list-free
+  (implies (and (equal x (logic.por-list lhs rhs))
+                (force (logic.formula-listp lhs))
+                (force (logic.formula-listp rhs))
+                (force (equal (len lhs) (len rhs))))
+           (equal (logic.vlhses x)
+                  (list-fix lhs))))
+
+(defthm logic.vlhs-of-car-when-all-equalp-of-logic.vlhses
+  (implies (all-equalp p (logic.vlhses x))
+           (equal (logic.vlhs (car x))
+                  (if (consp x)
+                      p
+                    nil))))
+
+
+
+(defprojection :list (logic.vrhses x)
+               :element (logic.vrhs x)
+               :guard (and (logic.formula-listp x)
+                           (logic.all-disjunctionsp x))
+               :nil-preservingp t)
+
+(defthm forcing-logic.formula-listp-of-logic.vrhses
+  (implies (and (force (logic.all-disjunctionsp x))
+                (force (logic.formula-listp x)))
+           (equal (logic.formula-listp (logic.vrhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.vrhses
+  (implies (and (force (logic.all-disjunctionsp x))
+                (force (logic.formula-list-atblp x atbl)))
+           (equal (logic.formula-list-atblp (logic.vrhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.vrhses-of-logic.por-list
+  (implies (and (force (logic.formula-listp x))
+                (force (logic.formula-listp y))
+                (force (equal (len x) (len y))))
+           (equal (logic.vrhses (logic.por-list x y))
+                  (list-fix y)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-logic.vrhses-of-logic.por-list-free
+  (implies (and (equal x (logic.por-list lhs rhs))
+                (force (logic.formula-listp lhs))
+                (force (logic.formula-listp rhs))
+                (force (equal (len lhs) (len rhs))))
+           (equal (logic.vrhses x)
+                  (list-fix rhs))))
+
+
+
+
+(defthm forcing-equal-of-logic.por-list-rewrite
+  (implies (and (force (equal (len x) (len y)))
+                (force (logic.formula-listp x))
+                (force (logic.formula-listp y)))
+           (equal (equal (logic.por-list x y) z)
+                  (and (true-listp z)
+                       (logic.formula-listp z)
+                       (logic.all-disjunctionsp z)
+                       (equal (list-fix x) (logic.vlhses z))
+                       (equal (list-fix y) (logic.vrhses z)))))
+  :hints(("Goal" :induct (cdr-cdr-cdr-induction x y z))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/proofp.lisp acl2-6.3/books/milawa/ACL2/logic/proofp.lisp
--- acl2-6.2/books/milawa/ACL2/logic/proofp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/proofp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1788 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "base-evaluator")
+(include-book "substitute-formula")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; The core proof checker
+;;
+;; Our proof checker, logic.proofp, takes as arguments:
+;;
+;;   - an "appeal" to check,
+;;   - a list of axioms (formulas) which are assumed to be true,
+;;   - a list of theorems (formulas) which have been previously proven, and
+;;   - an arity table that specifies the valid functions.
+;;
+;; An appeal is a tree of proof steps.  Each proof step is a tuple of the form
+;; (method conclusion [subproofs] [extras]), where:
+;;
+;;   - method is the name of the rule used to justify this step,
+;;   - conclusion is the formula that we're claiming to prove with this step,
+;;   - subproofs are a list of appeals that we are building upon, and
+;;   - extras hold any additional information we need, e.g., substitution lists
+;;     for instantiation appeals.
+;;
+;; An appeal is "stepwise ok" if, assuming all of its subproofs are actually
+;; legitimate proofs, its conclusion would be provable by the specified method.
+;; This is a convenient notion, because we can easily write functions to check
+;; that a particular kind of proof step is valid in this sense. Our proof
+;; checker recursively extends this stepwise check throughout the tree of
+;; appeals.
+
+(defund logic.flag-appealp (flag x)
+  (declare (xargs :guard (or (equal flag 'proof)
+                             (equal flag 'list))))
+  (if (equal flag 'proof)
+      (and (true-listp x)
+           (<= (len x) 4)
+           (symbolp (first x))
+           (logic.formulap (second x))
+           (true-listp (third x))
+           (logic.flag-appealp 'list (third x)))
+    (if (consp x)
+        (and (logic.flag-appealp 'proof (car x))
+             (logic.flag-appealp 'list (cdr x)))
+      t)))
+
+(definlined logic.appealp (x)
+  (declare (xargs :guard t))
+  (logic.flag-appealp 'proof x))
+
+(definlined logic.appeal-listp (x)
+  (declare (xargs :guard t))
+  (logic.flag-appealp 'list x))
+
+(defthmd definition-of-logic.appealp
+  (equal (logic.appealp x)
+         (and (true-listp x)
+              (<= (len x) 4)
+              (symbolp (first x))
+              (logic.formulap (second x))
+              (true-listp (third x))
+              (logic.appeal-listp (third x))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-appealp
+                                    logic.appealp
+                                    logic.appeal-listp))))
+
+(defthmd definition-of-logic.appeal-listp
+  (equal (logic.appeal-listp x)
+         (if (consp x)
+             (and (logic.appealp (car x))
+                  (logic.appeal-listp (cdr x)))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-appealp
+                                    logic.appealp
+                                    logic.appeal-listp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.appealp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.appeal-listp))))
+
+
+(definlined logic.method (x)
+  ;; BOZO consider renaming, e.g., logic.appeal->method, etc.
+  (declare (xargs :guard (logic.appealp x)
+                  :guard-hints(("Goal" :in-theory (enable logic.appealp)))))
+  (first x))
+
+(definlined logic.conclusion (x)
+  (declare (xargs :guard (logic.appealp x)
+                  :guard-hints(("Goal" :in-theory (enable logic.appealp)))))
+  (second x))
+
+(definlined logic.subproofs (x)
+  (declare (xargs :guard (logic.appealp x)
+                  :guard-hints(("Goal" :in-theory (enable logic.appealp)))))
+  (third x))
+
+(definlined logic.extras (x)
+  (declare (xargs :guard (logic.appealp x)
+                  :guard-hints(("Goal" :in-theory (enable logic.appealp)))))
+  (fourth x))
+
+(defund logic.appeal (method conclusion subproofs extras)
+  (declare (xargs :guard (and (symbolp method)
+                              (logic.formulap conclusion)
+                              (logic.appeal-listp subproofs)
+                              (true-listp subproofs))))
+  (if extras
+      (list method conclusion subproofs extras)
+    (if subproofs
+        (list method conclusion subproofs)
+      (list method conclusion))))
+
+
+
+
+(defun logic.appeal-induction (flag x)
+  ;; This just defines an induction scheme we can use to reason about appeals.
+  (declare (xargs :verify-guards nil
+                  :measure (two-nats-measure (rank x) (if (equal flag 'list) 0 1))
+                  :hints (("Goal" :in-theory (enable logic.subproofs)))))
+  (if (equal flag 'proof)
+      (logic.appeal-induction 'list (logic.subproofs x))
+    (if (consp x)
+        (list (logic.appeal-induction 'proof (car x))
+              (logic.appeal-induction 'list (cdr x)))
+      nil)))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'proof)
+              (booleanp (logic.appealp x))
+            (booleanp (logic.appeal-listp x)))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.appeal-induction flag x)
+                  :in-theory (enable definition-of-logic.appealp
+                                     definition-of-logic.appeal-listp
+                                     logic.subproofs)))))
+
+ (defthm booleanp-of-logic.appealp
+   (equal (booleanp (logic.appealp x))
+          t)
+   :hints(("Goal" :use ((:instance lemma (flag 'proof))))))
+
+ (defthm booleanp-of-logic.appeal-listp
+   (equal (booleanp (logic.appeal-listp x))
+          t)
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(defthm logic.appeal-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.appeal-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.appeal-listp))))
+
+(defthm logic.appeal-listp-of-cons
+  (equal (logic.appeal-listp (cons a x))
+         (and (logic.appealp a)
+              (logic.appeal-listp x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.appeal-listp))))
+
+(deflist logic.appeal-listp (x)
+  (logic.appealp x)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(defthm logic.appealp-of-nth-when-logic.appeal-listp
+  ;; BOZO consider adding something like this rule to deflist.
+  (implies (logic.appeal-listp x)
+           (equal (logic.appealp (nth n x))
+                  (< n (len x)))))
+
+(defthm logic.appealp-of-second-when-logic.appeal-listp
+  ;; BOZO consider adding something like this rule to deflist
+  (implies (logic.appeal-listp x)
+           (equal (logic.appealp (second x))
+                  (consp (cdr x)))))
+
+(defthm forcing-logic.appeal-listp-of-firstn
+  (implies (force (logic.appeal-listp x))
+           (equal (logic.appeal-listp (firstn n x))
+                  t)))
+
+(defthm forcing-logic.appeal-listp-of-restn
+  (implies (force (logic.appeal-listp x))
+           (equal (logic.appeal-listp (restn n x))
+                  t)))
+
+
+
+
+(defthm logic.method-of-logic.appeal
+  (equal (logic.method (logic.appeal method conclusion subproofs extras))
+         method)
+  :hints(("Goal" :in-theory (enable logic.appeal logic.method))))
+
+(defthm logic.conclusion-of-logic.appeal
+  (equal (logic.conclusion (logic.appeal method conclusion subproofs extras))
+         conclusion)
+  :hints(("Goal" :in-theory (enable logic.appeal logic.conclusion))))
+
+(defthm logic.subproofs-of-logic.appeal
+  (equal (logic.subproofs (logic.appeal method conclusion subproofs extras))
+         subproofs)
+  :hints(("Goal" :in-theory (enable logic.appeal logic.subproofs))))
+
+(defthm logic.extras-of-logic.appeal
+  (equal (logic.extras (logic.appeal method conclusion subproofs extras))
+         extras)
+  :hints(("Goal" :in-theory (enable logic.appeal logic.extras))))
+
+(defthm logic.appeal-under-iff
+  (iff (logic.appeal method conclusion subproofs extras)
+       t)
+  :hints(("Goal" :in-theory (enable logic.appeal))))
+
+(defthm forcing-logic.appealp-of-logic.appeal
+  (implies (force (and (symbolp method)
+                       (logic.formulap conclusion)
+                       (logic.appeal-listp subproofs)
+                       (true-listp subproofs)))
+           (equal (logic.appealp (logic.appeal method conclusion subproofs extras))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.appealp logic.appeal))))
+
+
+
+(defthm forcing-symbolp-of-logic.method
+  (implies (force (logic.appealp x))
+           (equal (symbolp (logic.method x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.method definition-of-logic.appealp))))
+
+(defthm forcing-logic.formulap-of-logic.conclusion
+  (implies (force (logic.appealp x))
+           (equal (logic.formulap (logic.conclusion x))
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.conclusion definition-of-logic.appealp))))
+
+(defthm forcing-true-listp-of-logic.subproofs
+  (implies (force (logic.appealp x))
+           (equal (true-listp (logic.subproofs x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.subproofs definition-of-logic.appealp))))
+
+(defthm forcing-logic.appeal-listp-of-logic.subproofs
+  (implies (force (logic.appealp x))
+           (equal (logic.appeal-listp (logic.subproofs x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.subproofs definition-of-logic.appealp))))
+
+(defthm rank-of-logic.subproofs
+  (implies (logic.appealp x)
+           (equal (< (rank (logic.subproofs x)) (rank x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.subproofs definition-of-logic.appealp))))
+
+(defthm rank-of-logic.subproofs-weak
+  (equal (< (rank x) (rank (logic.subproofs x)))
+         nil)
+  :hints(("Goal" :in-theory (enable logic.subproofs))))
+
+(defthm rank-of-logic.subproofs-strong-via-consp
+  ;; This rule lets us admit functions that recur on subproofs without having
+  ;; to call logic.appealp on every recursive invocation; we just
+  ;; need to ensure that the object is a consp.
+  ;;
+  ;; BOZO.  We can often avoid this by just using two-nats-measure.  Maybe we
+  ;; don't really want this rule around?
+  (implies (consp x)
+           (equal (< (rank (logic.subproofs x)) (rank x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.subproofs))))
+
+(defthm rank-of-first-of-logic.subproofs
+  (implies (logic.appealp x)
+           (equal (< (rank (first (logic.subproofs x))) (rank x))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable rank-of-logic.subproofs)
+          :use ((:instance rank-of-logic.subproofs)))))
+
+(defthm rank-of-second-of-logic.subproofs
+  (implies (logic.appealp x)
+           (equal (< (rank (second (logic.subproofs x))) (rank x))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable rank-of-logic.subproofs)
+          :use ((:instance rank-of-logic.subproofs)))))
+
+
+
+
+(defprojection :list (logic.strip-conclusions x)
+               :element (logic.conclusion x)
+               :guard (logic.appeal-listp x)
+               :nil-preservingp t)
+
+(defthm second-of-logic.strip-conclusions
+  ;; BOZO consider adding this to deflist
+  (equal (second (logic.strip-conclusions x))
+         (logic.conclusion (second x))))
+
+(defthm forcing-logic.formula-listp-of-logic.strip-conclusions
+  (implies (force (logic.appeal-listp x))
+           (equal (logic.formula-listp (logic.strip-conclusions x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.fmtype-of-logic.conclusion-of-nth-when-logic.all-disjunctionsp
+  (implies (logic.all-disjunctionsp (logic.strip-conclusions x))
+           (equal (logic.fmtype (logic.conclusion (nth n x)))
+                  (if (< (nfix n) (len x))
+                      'por*
+                    nil)))
+  :hints(("Goal" :use ((:instance logic.fmtype-of-nth-when-logic.all-disjunctionsp
+                                  (x (logic.strip-conclusions x)))))))
+
+(defthm logic.fmtype-of-logic.conclusion-of-nth-when-logic.all-atomicp
+  (implies (logic.all-atomicp (logic.strip-conclusions x))
+           (equal (logic.fmtype (logic.conclusion (nth n x)))
+                  (if (< (nfix n) (len x))
+                      'pequal*
+                    nil)))
+  :hints(("Goal" :use ((:instance logic.fmtype-of-nth-when-logic.all-atomicp
+                                  (x (logic.strip-conclusions x)))))))
+
+(defthm logic.vlhs-of-logic.conclusion-of-car-when-all-equalp
+  (implies (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+           (equal (logic.vlhs (logic.conclusion (car x)))
+                  (if (consp x)
+                      p
+                    nil))))
+
+(defthm logic.vlhs-of-logic.conclusion-of-nth-when-all-equalp-of-logic.vlhses
+  (implies (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+           (equal (logic.vlhs (logic.conclusion (nth n x)))
+                  (if (< (nfix n) (len x))
+                      p
+                    nil)))
+  :hints(("Goal"
+          :in-theory (enable nth)
+          :induct (nth n x))))
+
+(defthm logic.fmtype-of-logic.vrhs-of-logic.conclusion-of-nth-when-logic.all-disjunctionsp-of-logic.all-atomicp
+  (implies (and (logic.all-disjunctionsp (logic.strip-conclusions x))
+                (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x))))
+           (equal (logic.fmtype (logic.vrhs (logic.conclusion (nth n x))))
+                  (if (< (nfix n) (len x))
+                      'pequal*
+                    nil)))
+  :hints(("Goal" :use ((:instance logic.fmtype-of-nth-when-logic.all-atomicp
+                                  (x (logic.vrhses (logic.strip-conclusions x))))))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-of-car
+  (implies (logic.formula-list-atblp (logic.strip-conclusions x) atbl)
+           (equal (logic.formula-atblp (logic.conclusion (car x)) atbl)
+                  (consp x))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-of-second
+  (implies (logic.formula-list-atblp (logic.strip-conclusions x) atbl)
+           (equal (logic.formula-atblp (logic.conclusion (second x)) atbl)
+                  (consp (cdr x)))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-of-third
+  (implies (logic.formula-list-atblp (logic.strip-conclusions x) atbl)
+           (equal (logic.formula-atblp (logic.conclusion (third x)) atbl)
+                  (consp (cdr (cdr x))))))
+
+(defthmd logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1
+  (implies (equal (len x) 1)
+           (equal (logic.formula-list-atblp (logic.strip-conclusions x) atbl)
+                  (logic.formula-atblp (logic.conclusion (car x)) atbl))))
+
+(defthmd logic.formula-list-atblp-of-logic.strip-conclusions-when-len-2
+  (implies (equal (len x) 2)
+           (equal (logic.formula-list-atblp (logic.strip-conclusions x) atbl)
+                  (and (logic.formula-atblp (logic.conclusion (first x)) atbl)
+                       (logic.formula-atblp (logic.conclusion (second x)) atbl)))))
+
+
+
+;; The Individual Proof-Step Checkers
+
+(defund logic.axiom-okp (x axioms atbl)
+  ;; We ensure the conclusion of x is among axioms.
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'axiom)
+         (equal subproofs nil)
+         (equal extras nil)
+         (memberp conclusion axioms)
+         (logic.formula-atblp conclusion atbl))))
+
+(defthm booleanp-of-logic.axiom-okp
+  (equal (booleanp (logic.axiom-okp x axioms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable logic.axiom-okp))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.axiom-okp
+  (implies (logic.axiom-okp x axioms atbl)
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.axiom-okp))))
+
+
+
+(defund logic.theorem-okp (x thms atbl)
+  ;; We ensure the conclusion of x is among thms.
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'theorem)
+         (equal subproofs nil)
+         (equal extras nil)
+         (memberp conclusion thms)
+         (logic.formula-atblp conclusion atbl))))
+
+(defthm booleanp-of-logic.theorem-okp
+  (equal (booleanp (logic.theorem-okp x axioms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable logic.theorem-okp))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.theorem-okp
+  (implies (logic.theorem-okp x theorems atbl)
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.theorem-okp))))
+
+
+
+(defund logic.propositional-schema-okp (x atbl)
+  ;; Propositional axiom schema: ~A v A
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'propositional-schema)
+         (equal subproofs nil)
+         (equal extras nil)
+         (equal (logic.fmtype conclusion) 'por*)
+         (let ((not-a (logic.vlhs conclusion))
+               (a     (logic.vrhs conclusion)))
+           (and (equal (logic.fmtype not-a) 'pnot*)
+                (equal (logic.~arg not-a) a)
+                (logic.formula-atblp a atbl))))))
+
+(defthm booleanp-of-logic.propositional-schema-okp
+  (equal (booleanp (logic.propositional-schema-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.propositional-schema-okp)
+                                 ((:executable-counterpart ACL2::force))))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.propositional-schema-okp
+  (implies (logic.propositional-schema-okp x atbl)
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.propositional-schema-okp backtracking-logic.formula-atblp-rules)
+                                 (forcing-logic.formula-atblp-rules)))))
+
+
+
+
+(defund logic.check-functional-axiom (x ti si)
+  ;; The functional equality axiom schema is:
+  ;;
+  ;; (t1 = s1) -> ((t2 = s2) -> ... -> ((tn = sn)
+  ;;   -> (f t1 t2 ... tn) = (f s1 s2 ... sn) ... ))
+  ;;
+  ;; In other words, it should look like this:
+  ;;
+  ;; (por* (pnot* (pequal* t1 s1)
+  ;;       (por* (pnot* (pequal* t2 s2))
+  ;;             ...
+  ;;             (por* (pnot* (pequal* tn sn))
+  ;;                   (pequal* (f t1 t2 ... tn)
+  ;;                            (f s1 s2 ... sn))) ...))
+  ;;
+  ;; We walk through the formula and accumulate the t's and s's we have seen on
+  ;; our way down, until we reach the pequal*.  Then, it is easy to see if we
+  ;; have (f t1 ... tn) = (f s1 ... sn) at the bottom.
+  (declare (xargs :guard (and (logic.formulap x)
+                              (logic.term-listp ti)
+                              (logic.term-listp si))))
+  (if (equal (logic.fmtype x) 'pequal*)
+      ;; Reached the end, match (f t1 ... tn) = (f s1 ... sn)
+      (and (logic.functionp (logic.=lhs x))
+           (logic.functionp (logic.=rhs x))
+           (equal (logic.function-name (logic.=lhs x)) (logic.function-name (logic.=rhs x)))
+           (equal (logic.function-args (logic.=lhs x)) (rev ti))
+           (equal (logic.function-args (logic.=rhs x)) (rev si)))
+    ;; Still traversing, match ti != si v [...]
+    (and (equal (logic.fmtype x) 'por*)
+         (equal (logic.fmtype (logic.vlhs x)) 'pnot*)
+         (equal (logic.fmtype (logic.~arg (logic.vlhs x))) 'pequal*)
+         (logic.check-functional-axiom (logic.vrhs x)
+                                       (cons (logic.=lhs (logic.~arg (logic.vlhs x))) ti)
+                                       (cons (logic.=rhs (logic.~arg (logic.vlhs x))) si)))))
+
+(defund logic.functional-equality-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'functional-equality)
+         (equal subproofs nil)
+         (equal extras nil)
+         (logic.check-functional-axiom conclusion nil nil)
+         (logic.formula-atblp conclusion atbl))))
+
+(defthm booleanp-of-logic.check-functional-axiom
+  (equal (booleanp (logic.check-functional-axiom x ti si))
+         t)
+  :hints(("Goal" :in-theory (enable logic.check-functional-axiom))))
+
+(defthm booleanp-of-logic.functional-equality-okp
+  (equal (booleanp (logic.functional-equality-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable logic.functional-equality-okp))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.functional-equality-okp
+  (implies (logic.functional-equality-okp x atbl)
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.functional-equality-okp))))
+
+
+
+
+(defund logic.expansion-okp (x atbl)
+  ;; Expansion: Derive A v B from B
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'expansion)
+         (equal extras nil)
+         (tuplep 1 subproofs)
+         (let ((b (logic.conclusion (first subproofs))))
+           (and (equal (logic.fmtype conclusion) 'por*)
+                (equal (logic.vrhs conclusion) b)
+                (logic.formula-atblp (logic.vlhs conclusion) atbl))))))
+
+(defthm booleanp-of-logic.expansion-okp
+  (equal (booleanp (logic.expansion-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.expansion-okp)
+                                 (forcing-true-listp-of-logic.subproofs
+                                  forcing-logic.formula-atblp-rules)))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.expansion-okp
+  (implies (and (logic.expansion-okp x atbl)
+                (logic.formula-list-atblp (logic.strip-conclusions (logic.subproofs x)) atbl))
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.expansion-okp
+                                  backtracking-logic.formula-atblp-rules
+                                  logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+                                 (forcing-logic.formula-atblp-rules
+                                  forcing-true-listp-of-logic.subproofs
+                                  )))))
+
+
+
+
+(defund logic.contraction-okp (x)
+  ;; Contraction: Derive A from A v A
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'contraction)
+         (equal extras nil)
+         (tuplep 1 subproofs)
+         (let ((or-a-a (logic.conclusion (first subproofs))))
+           (and (equal (logic.fmtype or-a-a) 'por*)
+                (equal (logic.vlhs or-a-a) conclusion)
+                (equal (logic.vrhs or-a-a) conclusion))))))
+
+(defthm booleanp-of-logic.contraction-okp
+  (equal (booleanp (logic.contraction-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.contraction-okp)
+                                 (forcing-true-listp-of-logic.subproofs)))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.contraction-okp
+  (implies (and (logic.contraction-okp x)
+                (logic.formula-list-atblp (logic.strip-conclusions (logic.subproofs x)) atbl))
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.contraction-okp
+                                  backtracking-logic.formula-atblp-rules
+                                  logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+                                 (forcing-logic.formula-atblp-rules
+                                  forcing-true-listp-of-logic.subproofs
+                                  )))))
+
+
+
+
+(defund logic.associativity-okp (x)
+  ;; Associativity: Derive (A v B) v C from A v (B v C)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'associativity)
+         (equal extras nil)
+         (tuplep 1 subproofs)
+         (let ((sub-or-a-or-b-c (logic.conclusion (first subproofs))))
+           (and (equal (logic.fmtype conclusion) 'por*)
+                (equal (logic.fmtype sub-or-a-or-b-c) 'por*)
+                (let ((conc-or-a-b (logic.vlhs conclusion))
+                      (conc-c      (logic.vrhs conclusion))
+                      (sub-a       (logic.vlhs sub-or-a-or-b-c))
+                      (sub-or-b-c  (logic.vrhs sub-or-a-or-b-c)))
+                  (and (equal (logic.fmtype conc-or-a-b) 'por*)
+                       (equal (logic.fmtype sub-or-b-c) 'por*)
+                       (let ((conc-a (logic.vlhs conc-or-a-b))
+                             (conc-b (logic.vrhs conc-or-a-b))
+                             (sub-b  (logic.vlhs sub-or-b-c))
+                             (sub-c  (logic.vrhs sub-or-b-c)))
+                         (and (equal conc-a sub-a)
+                              (equal conc-b sub-b)
+                              (equal conc-c sub-c))))))))))
+
+(defthm booleanp-of-logic.associativity-okp
+  (equal (booleanp (logic.associativity-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.associativity-okp)
+                                 (forcing-true-listp-of-logic.subproofs)))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.associativity-okp
+  (implies (and (logic.associativity-okp x)
+                (logic.formula-list-atblp (logic.strip-conclusions (logic.subproofs x)) atbl))
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.associativity-okp
+                                  backtracking-logic.formula-atblp-rules
+                                  logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+                                 (forcing-logic.formula-atblp-rules
+                                  forcing-true-listp-of-logic.subproofs
+                                  )))))
+
+
+
+
+(defund logic.cut-okp (x)
+  ;; Cut: Derive B v C from A v B and ~A v C
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'cut)
+         (equal extras nil)
+         (tuplep 2 subproofs)
+         (let ((or-a-b     (logic.conclusion (first subproofs)))
+               (or-not-a-c (logic.conclusion (second subproofs))))
+             (and (equal (logic.fmtype or-a-b) 'por*)
+                  (equal (logic.fmtype or-not-a-c) 'por*)
+                  (let ((a     (logic.vlhs or-a-b))
+                        (b     (logic.vrhs or-a-b))
+                        (not-a (logic.vlhs or-not-a-c))
+                        (c     (logic.vrhs or-not-a-c)))
+                    (and (equal (logic.fmtype not-a) 'pnot*)
+                         (equal (logic.~arg not-a) a)
+                         (equal (logic.fmtype conclusion) 'por*)
+                         (equal (logic.vlhs conclusion) b)
+                         (equal (logic.vrhs conclusion) c))))))))
+
+(defthm booleanp-of-logic.cut-okp
+  (equal (booleanp (logic.cut-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.cut-okp)
+                                 (forcing-true-listp-of-logic.subproofs)))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.cut-okp
+  (implies (and (logic.cut-okp x)
+                (logic.formula-list-atblp (logic.strip-conclusions (logic.subproofs x)) atbl))
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.cut-okp
+                                  backtracking-logic.formula-atblp-rules
+                                  logic.formula-list-atblp-of-logic.strip-conclusions-when-len-2)
+                                 (forcing-logic.formula-atblp-rules
+                                  forcing-true-listp-of-logic.subproofs
+                                  )))))
+
+
+
+(defund logic.instantiation-okp (x atbl)
+  ;; Instantiation: Derive A/sigma from A
+  ;;
+  ;; Why don't we take an arity table?  The conclusion gets arity checked for
+  ;; us by proofp, and if a malformed term is being used it will show up in the
+  ;; conclusion.
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))  ;; We put the sigma into "extras"
+    (and (equal method 'instantiation)
+         (logic.sigmap extras)
+         (tuplep 1 subproofs)
+         (equal (logic.substitute-formula (logic.conclusion (first subproofs)) extras) conclusion)
+         (logic.formula-atblp conclusion atbl))))
+
+(defthm booleanp-of-logic.instantiation-okp
+  (equal (booleanp (logic.instantiation-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.instantiation-okp)
+                                 (forcing-true-listp-of-logic.subproofs)))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.instantiation-okp
+  (implies (and (logic.instantiation-okp x atbl)
+                (logic.formula-list-atblp (logic.strip-conclusions (logic.subproofs x)) atbl))
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.instantiation-okp
+                                  backtracking-logic.formula-atblp-rules
+                                  logic.formula-list-atblp-of-logic.strip-conclusions-when-len-1)
+                                 (forcing-logic.formula-atblp-rules
+                                  forcing-true-listp-of-logic.subproofs
+                                  )))))
+
+
+
+
+(defund logic.beta-reduction-okp (x atbl)
+  ;; Beta Reduction (Schema): ((lambda (x1 ... xn) B) t1 ... tn) = B/[x1 <- t1, ..., xn <- tn]
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'beta-reduction)
+         (equal subproofs nil)
+         (equal extras nil)
+         (logic.formula-atblp conclusion atbl)
+         (equal (logic.fmtype conclusion) 'pequal*)
+         (let ((lhs (logic.=lhs conclusion))
+               (rhs (logic.=rhs conclusion)))
+           (and (logic.lambdap lhs)
+                (let ((formals (logic.lambda-formals lhs))
+                      (body    (logic.lambda-body lhs))
+                      (actuals (logic.lambda-actuals lhs)))
+                  (equal (logic.substitute body (pair-lists formals actuals)) rhs)))))))
+
+(defthm booleanp-of-logic.beta-reduction-okp
+  (equal (booleanp (logic.beta-reduction-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable logic.beta-reduction-okp))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.beta-reduction-okp
+  (implies (logic.beta-reduction-okp x atbl)
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.beta-reduction-okp))))
+
+
+
+
+(defund logic.base-eval-okp (x atbl)
+  ;; Base evaluation: Derive (f c1 ... cn) = result, where f is one of the base
+  ;; functions such as if, equal, consp, etc., c1..cn are constants, and result
+  ;; is the "correct" value for f applied to these constants.
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'base-eval)
+         (equal subproofs nil)
+         (equal extras nil)
+         (equal (logic.fmtype conclusion) 'pequal*)
+         (let ((lhs (logic.=lhs conclusion))
+               (rhs (logic.=rhs conclusion)))
+           (and (logic.base-evaluablep lhs)
+                (equal (logic.base-evaluator lhs) rhs)
+                (logic.term-atblp lhs atbl))))))
+
+(defthm booleanp-of-logic.base-eval-okp
+  (equal (booleanp (logic.base-eval-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.base-eval-okp)
+                                 ((:executable-counterpart ACL2::force))))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.base-eval-okp
+  (implies (logic.base-eval-okp x atbl)
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.base-eval-okp
+                                  backtracking-logic.formula-atblp-rules)
+                                 (forcing-logic.formula-atblp-rules
+                                  forcing-true-listp-of-logic.subproofs
+                                  )))))
+
+
+
+
+
+;; The Induction Rule.
+;;
+;; Derive F from:
+;;
+;;   - A term, m, called the measure,
+;;
+;;   - A set of formulas, {q1, ..., qk}, and
+;;
+;;   - For each formula qi, a set of sigmas
+;;       Sigma-i = { sigma_<i,1>, ..., sigma_<i,hi> }, and
+;;
+;;   - Proofs of each of the following formulas:
+;;
+;;     * Basis Step:       F v q1 v ... v qk
+;;
+;;     * Inductive Steps:  For each 1 <= i <= k,
+;;                             F v ~qi v ~F/sigma_<i,1> v ... v ~F/sigma_<i,hi>
+;;
+;;     * Ordinal Step:     (ordp m) = t
+;;
+;;     * Measure Steps:    For each 1 <= i <= k and 1 <= j <= hi,
+;;                             ~qi v (ord< m/sigma_<i,j> m) = t
+
+(definlined logic.make-basis-step (f qs)
+  (declare (xargs :guard (and (logic.formulap f)
+                              (logic.formula-listp qs))))
+  (logic.disjoin-formulas (cons f qs)))
+
+(definlined logic.make-induction-step (f q-i sigmas-i)
+  (declare (xargs :guard (and (logic.formulap f)
+                              (logic.formulap q-i)
+                              (logic.sigma-listp sigmas-i))))
+  (logic.disjoin-formulas
+   (cons f (cons (logic.pnot q-i) (logic.substitute-each-sigma-into-formula (logic.pnot f) sigmas-i)))))
+
+(defund logic.make-induction-steps (f qs all-sigmas)
+  (declare (xargs :guard (and (logic.formulap f)
+                              (logic.formula-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas)))))
+  (if (consp qs)
+      (cons (logic.make-induction-step f (car qs) (car all-sigmas))
+            (logic.make-induction-steps f (cdr qs) (cdr all-sigmas)))
+    nil))
+
+(definlined logic.make-ordinal-step (m)
+  (declare (xargs :guard (logic.termp m)))
+  (logic.pequal (logic.function 'ordp (list m)) ''t))
+
+(definlined logic.make-measure-step (m q-i sigma-i-j)
+  (declare (xargs :guard (and (logic.termp m)
+                              (logic.formulap q-i)
+                              (logic.sigmap sigma-i-j))))
+  (logic.por (logic.pnot q-i)
+             (logic.pequal (logic.function 'ord< (list (logic.substitute m sigma-i-j) m)) ''t)))
+
+(defund logic.make-measure-steps (m q-i sigmas-i)
+  (declare (xargs :guard (and (logic.termp m)
+                              (logic.formulap q-i)
+                              (logic.sigma-listp sigmas-i))))
+  (if (consp sigmas-i)
+      (cons (logic.make-measure-step m q-i (car sigmas-i))
+            (logic.make-measure-steps m q-i (cdr sigmas-i)))
+    nil))
+
+(defund logic.make-all-measure-steps (m qs all-sigmas)
+  (declare (xargs :guard (and (logic.termp m)
+                              (logic.formula-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas)))))
+  (if (consp all-sigmas)
+      (app (logic.make-measure-steps m (car qs) (car all-sigmas))
+           (logic.make-all-measure-steps m (cdr qs) (cdr all-sigmas)))
+    nil))
+
+(defund logic.induction-okp (x)
+  (declare (xargs :guard (logic.appealp x)))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'induction)
+         (tuplep 3 extras)
+         (let ((m          (first extras))
+               (qs         (second extras))
+               (all-sigmas (third extras))
+               (subconcs   (logic.strip-conclusions subproofs)))
+           (and (logic.termp m)
+                (logic.formula-listp qs)
+                (logic.sigma-list-listp all-sigmas)
+                (equal (len qs) (len all-sigmas))
+                (memberp (logic.make-basis-step conclusion qs) subconcs)
+                (subsetp (logic.make-induction-steps conclusion qs all-sigmas) subconcs)
+                (memberp (logic.make-ordinal-step m) subconcs)
+                (subsetp (logic.make-all-measure-steps m qs all-sigmas) subconcs))))))
+
+(defthm booleanp-of-logic.induction-okp
+  (equal (booleanp (logic.induction-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.induction-okp))))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-logic.formula-atblp-of-logic.conclusion-when-logic.induction-okp
+   (implies (logic.formula-atblp (logic.make-basis-step f qs) atbl)
+            (equal (logic.formula-atblp f atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable logic.make-basis-step))))
+
+ (defthm logic.formula-atblp-of-logic.conclusion-when-logic.induction-okp
+   (implies (and (logic.induction-okp x)
+                 (logic.formula-list-atblp (logic.strip-conclusions (logic.subproofs x)) atbl))
+            (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                   t))
+   :hints(("Goal"
+           :in-theory (e/d (logic.induction-okp
+                            lemma-for-logic.formula-atblp-of-logic.conclusion-when-logic.induction-okp)
+                           (logic.formula-atblp-when-memberp-of-logic.formula-list-atblp
+                            logic.formula-atblp-when-memberp-of-logic.formula-list-atblp-alt))
+           :use ((:instance logic.formula-atblp-when-memberp-of-logic.formula-list-atblp
+                            (a (logic.make-basis-step (logic.conclusion x) (second (logic.extras x))))
+                            (x (logic.strip-conclusions (logic.subproofs x)))))))))
+
+
+;; BOZO reorder this stuff, it should be up near the definitions instead of after induction-okp.
+
+(defthm forcing-logic.formulap-of-logic.make-basis-step
+  (implies (force (and (logic.formulap f)
+                       (logic.formula-listp qs)))
+           (equal (logic.formulap (logic.make-basis-step f qs))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-basis-step))))
+
+(defthm forcing-logic.formula-atblp-of-logic.make-basis-step
+  (implies (force (and (logic.formula-atblp f atbl)
+                       (logic.formula-list-atblp qs atbl)))
+           (equal (logic.formula-atblp (logic.make-basis-step f qs) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-basis-step))))
+
+(defthm forcing-logic.formulap-of-logic.make-induction-step
+  (implies (force (and (logic.formulap f)
+                       (logic.formulap q-i)
+                       (logic.sigma-listp sigmas-i)))
+           (equal (logic.formulap (logic.make-induction-step f q-i sigmas-i))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-induction-step))))
+
+(defthm forcing-logic.formula-atblp-of-logic.make-induction-step
+  (implies (force (and (logic.formula-atblp f atbl)
+                       (logic.formula-atblp q-i atbl)
+                       (logic.sigma-list-atblp sigmas-i atbl)))
+           (equal (logic.formula-atblp (logic.make-induction-step f q-i sigmas-i) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-induction-step))))
+
+(defthm true-listp-of-logic.make-induction-steps
+  (equal (true-listp (logic.make-induction-steps f qs all-sigmas))
+         t)
+  :hints(("Goal" :in-theory (enable logic.make-induction-steps))))
+
+(defthm len-of-logic.make-induction-steps
+  (equal (len (logic.make-induction-steps f qs all-sigmas))
+         (len qs))
+  :hints(("Goal" :in-theory (enable logic.make-induction-steps))))
+
+(defthm forcing-logic.formula-listp-of-logic.make-induction-steps
+  (implies (force (and (logic.formulap f)
+                       (logic.formula-listp qs)
+                       (logic.sigma-list-listp all-sigmas)
+                       (equal (len qs) (len all-sigmas))))
+           (equal (logic.formula-listp (logic.make-induction-steps f qs all-sigmas))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-induction-steps))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.make-induction-steps
+  (implies (force (and (logic.formula-atblp f atbl)
+                       (logic.formula-list-atblp qs atbl)
+                       (logic.sigma-list-list-atblp all-sigmas atbl)))
+           (equal (logic.formula-list-atblp (logic.make-induction-steps f qs all-sigmas) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-induction-steps))))
+
+(defthm forcing-logic.formulap-of-logic.make-ordinal-step
+  (implies (force (logic.termp m))
+           (equal (logic.formulap (logic.make-ordinal-step m))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-ordinal-step))))
+
+(defthm forcing-logic.formula-atblp-of-logic.make-ordinal-step
+  (implies (force (and (logic.term-atblp m atbl)
+                       (equal (cdr (lookup 'ordp atbl)) 1)))
+           (equal (logic.formula-atblp (logic.make-ordinal-step m) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-ordinal-step))))
+
+
+(defthm forcing-logic.formulap-of-logic.make-measure-step
+  (implies (force (and (logic.termp m)
+                       (logic.formulap q-i)
+                       (logic.sigmap sigma-i-j)))
+           (equal (logic.formulap (logic.make-measure-step m q-i sigma-i-j))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-measure-step))))
+
+(defthm forcing-logic.formula-atblp-of-logic.make-measure-step
+  (implies (force (and (logic.term-atblp m atbl)
+                       (logic.formula-atblp q-i atbl)
+                       (logic.sigma-atblp sigma-i-j atbl)
+                       (equal (cdr (lookup 'ord< atbl)) 2)))
+           (equal (logic.formula-atblp (logic.make-measure-step m q-i sigma-i-j) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-measure-step))))
+
+
+(defthm forcing-logic.formula-listp-of-logic.make-measure-steps
+  (implies (force (and (logic.termp m)
+                       (logic.formulap q-i)
+                       (logic.sigma-listp sigmas-i)))
+           (equal (logic.formula-listp (logic.make-measure-steps m q-i sigmas-i))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-measure-steps))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.make-measure-steps
+  (implies (force (and (logic.term-atblp m atbl)
+                       (logic.formula-atblp q-i atbl)
+                       (logic.sigma-list-atblp sigmas-i atbl)
+                       (equal (cdr (lookup 'ord< atbl)) 2)))
+           (equal (logic.formula-list-atblp (logic.make-measure-steps m q-i sigmas-i) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-measure-steps))))
+
+
+(defthm true-listp-of-logic.make-all-measure-steps
+  (equal (true-listp (logic.make-all-measure-steps m qs all-sigmas))
+         t)
+  :hints(("Goal" :in-theory (enable logic.make-all-measure-steps))))
+
+(defthm forcing-logic.formula-listp-of-logic.make-all-measure-steps
+  (implies (force (and (logic.termp m)
+                       (logic.formula-listp qs)
+                       (logic.sigma-list-listp all-sigmas)
+                       (equal (len qs) (len all-sigmas))))
+           (equal (logic.formula-listp (logic.make-all-measure-steps m qs all-sigmas))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-all-measure-steps))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.make-all-measure-steps
+  (implies (force (and (logic.term-atblp m atbl)
+                       (logic.formula-list-atblp qs atbl)
+                       (logic.sigma-list-list-atblp all-sigmas atbl)
+                       (equal (cdr (lookup 'ord< atbl)) 2)
+                       (equal (len qs) (len all-sigmas))))
+           (equal (logic.formula-list-atblp (logic.make-all-measure-steps m qs all-sigmas) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.make-all-measure-steps))))
+
+
+
+
+(defund logic.skip-okp (x atbl)
+  ;; BOZO THIS IS UNSOUND!!!
+  ;; This needs to be removed eventually, but for now it's damn convenient.
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'skip)
+         (not subproofs)
+         (not extras)
+         (logic.formula-atblp conclusion atbl))))
+
+(defthm booleanp-of-logic.skip-okp
+  (equal (booleanp (logic.skip-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable logic.skip-okp))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.skip-okp
+  (implies (logic.skip-okp x atbl)
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.skip-okp))))
+
+
+
+
+(defund logic.appeal-step-okp (x axioms thms atbl)
+  ;; We check to see if an appeal step is ok using the basic proof methods.
+  ;; This is our step function and doesn't do anything recursive.  Sometimes I
+  ;; think of this as a virtual method call or a higher order function lookup
+  ;; ni a table.  But in our first order system, we have to make an explicit
+  ;; case statement.
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :export (let ((how (logic.method x)))
+                            (cond ((equal how 'axiom)                (logic.axiom-okp x axioms atbl))
+                                  ((equal how 'theorem)              (logic.theorem-okp x thms atbl))
+                                  ((equal how 'propositional-schema) (logic.propositional-schema-okp x atbl))
+                                  ((equal how 'functional-equality)  (logic.functional-equality-okp x atbl))
+                                  ((equal how 'beta-reduction)       (logic.beta-reduction-okp x atbl))
+                                  ((equal how 'expansion)            (logic.expansion-okp x atbl))
+                                  ((equal how 'contraction)          (logic.contraction-okp x))
+                                  ((equal how 'associativity)        (logic.associativity-okp x))
+                                  ((equal how 'cut)                  (logic.cut-okp x))
+                                  ((equal how 'instantiation)        (logic.instantiation-okp x atbl))
+                                  ((equal how 'induction)            (logic.induction-okp x))
+                                  ((equal how 'base-eval)            (logic.base-eval-okp x atbl))
+                                  ;; We don't provide :skip for Milawa itself
+                                  (t nil)))
+                  ))
+  (let ((how (logic.method x)))
+    (cond ((equal how 'axiom)                (logic.axiom-okp x axioms atbl))
+          ((equal how 'theorem)              (logic.theorem-okp x thms atbl))
+          ((equal how 'propositional-schema) (logic.propositional-schema-okp x atbl))
+          ((equal how 'functional-equality)  (logic.functional-equality-okp x atbl))
+          ((equal how 'beta-reduction)       (logic.beta-reduction-okp x atbl))
+          ((equal how 'expansion)            (logic.expansion-okp x atbl))
+          ((equal how 'contraction)          (logic.contraction-okp x))
+          ((equal how 'associativity)        (logic.associativity-okp x))
+          ((equal how 'cut)                  (logic.cut-okp x))
+          ((equal how 'instantiation)        (logic.instantiation-okp x atbl))
+          ((equal how 'induction)            (logic.induction-okp x))
+          ((equal how 'base-eval)            (logic.base-eval-okp x atbl))
+          ;; BOZO eventually remove skip from even the ACL2 model
+          ((equal how 'skip)                 (logic.skip-okp x atbl))
+          (t nil))))
+
+(defthm booleanp-of-logic.appeal-step-okp
+  (equal (booleanp (logic.appeal-step-okp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthm logic.appeal-step-okp-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.appeal-step-okp x axioms thms atbl)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp logic.method))))
+
+(defthm logic.formula-atblp-of-logic.conclusion-when-logic.appeal-step-okp
+  (implies (and (logic.appeal-step-okp x axioms thms atbl)
+                (logic.formula-list-atblp (logic.strip-conclusions (logic.subproofs x)) atbl))
+           (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+
+
+
+(defund logic.flag-proofp (flag x axioms thms atbl)
+  ;; We check that all of our conclusions throughout the proof are valid with
+  ;; respect to the arity table, and that every step throughout the proof is
+  ;; stepwise ok.
+  (declare (xargs :guard (and (if (equal flag 'proof)
+                                  (logic.appealp x)
+                                (and (equal flag 'list)
+                                     (logic.appeal-listp x)))
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'proof) 1 0))))
+  (if (equal flag 'proof)
+      (and (logic.appeal-step-okp x axioms thms atbl)
+           (logic.flag-proofp 'list (logic.subproofs x) axioms thms atbl))
+    (if (consp x)
+        (and (logic.flag-proofp 'proof (car x) axioms thms atbl)
+             (logic.flag-proofp 'list (cdr x) axioms thms atbl))
+      t)))
+
+(definlined logic.proofp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (logic.flag-proofp 'proof x axioms thms atbl))
+
+(definlined logic.proof-listp (x axioms thms atbl)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (logic.flag-proofp 'list x axioms thms atbl))
+
+(defthmd definition-of-logic.proofp
+  (equal (logic.proofp x axioms thms atbl)
+         (and (logic.appeal-step-okp x axioms thms atbl)
+              (logic.proof-listp (logic.subproofs x) axioms thms atbl)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-proofp
+                                    logic.proofp
+                                    logic.proof-listp))))
+
+(defthmd definition-of-logic.proof-listp
+  (equal (logic.proof-listp x axioms thms atbl)
+         (if (consp x)
+             (and (logic.proofp (car x) axioms thms atbl)
+                  (logic.proof-listp (cdr x) axioms thms atbl))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-proofp
+                                    logic.proofp
+                                    logic.proof-listp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.proofp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.proof-listp))))
+
+
+
+(defthm logic.proofp-when-not-consp
+   (implies (not (consp x))
+            (equal (logic.proofp x axioms thms atbl)
+                   nil))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp))))
+
+(defthm logic.proof-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.proof-listp x axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.proof-listp))))
+
+(defthm logic.proof-listp-of-cons
+  (equal (logic.proof-listp (cons a x) axioms thms atbl)
+         (and (logic.proofp a axioms thms atbl)
+              (logic.proof-listp x axioms thms atbl)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.proof-listp))))
+
+
+(defthms-flag
+  :thms ((proof booleanp-of-logic.proofp
+                (equal (booleanp (logic.proofp x axioms thms atbl))
+                       t))
+         (list booleanp-of-logic.proof-listp
+               (equal (booleanp (logic.proof-listp x axioms thms atbl))
+                      t)))
+  :hints (("Goal"
+           :in-theory (enable definition-of-logic.proofp)
+           :induct (logic.appeal-induction flag x))))
+
+(deflist logic.proof-listp (x axioms thms atbl)
+  (logic.proofp x axioms thms atbl)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(defthm logic.proofp-of-nth-when-logic.proof-listp
+  ;; BOZO consider adding me to deflist
+  (implies (logic.proof-listp x axioms thms atbl)
+           (equal (logic.proofp (nth n x) axioms thms atbl)
+                  (if (natp n)
+                      (< n (len x))
+                    (consp x))))
+  :hints(("Goal" :in-theory (enable nth))))
+
+(defthm forcing-logic.proof-listp-of-firstn
+  (implies (force (logic.proof-listp x axioms thms atbl))
+           (equal (logic.proof-listp (firstn n x) axioms thms atbl)
+                  t)))
+
+(defthm forcing-logic.proof-listp-of-restn
+  (implies (force (logic.proof-listp x axioms thms atbl))
+           (equal (logic.proof-listp (restn n x) axioms thms atbl)
+                  t)))
+
+
+(defthms-flag
+  :thms ((proof logic.formula-atblp-of-logic.conclusion-when-logic.proofp
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (logic.formula-atblp (logic.conclusion x) atbl)
+                                t)))
+         (list logic.formula-list-atblp-of-logic.strip-conclusions-when-logic.proof-listp
+               (implies (logic.proof-listp x axioms thms atbl)
+                        (equal (logic.formula-list-atblp (logic.strip-conclusions x) atbl)
+                               t))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-logic.proofp)
+           :induct (logic.appeal-induction flag x))))
+
+(defthm logic.proof-listp-of-logic.subproofs-when-logic.proofp
+   (implies (logic.proofp x axioms thms atbl)
+            (equal (logic.proof-listp (logic.subproofs x) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp))))
+
+
+(encapsulate
+ ()
+ (defun-sk logic.provablep (x axioms thms atbl)
+   ;; A formula is provable if there exists some proof of it.
+   (exists proof
+           (and (logic.appealp proof)
+                (logic.proofp proof axioms thms atbl)
+                (equal (logic.conclusion proof) x)))
+   :witness-dcls
+   #-skip-guards
+   ((declare (xargs ;:non-executable t
+
+              ;; ACL2 4.0 change: must verify guards later to avoid new
+              ;; checking about guards inside encapsulates.
+              :verify-guards nil
+              :guard (and (logic.formulap x)
+                          (logic.formula-listp axioms)
+                          (logic.formula-listp thms)
+                          (logic.arity-tablep atbl)))))
+   #+skip-guards
+   ((declare (xargs ;:non-executable t
+              :verify-guards nil)))
+   :skolem-name logic.provable-witness)
+
+ ;; ACL2 4.0 change: verify guards here instead of inline
+ (verify-guards logic.provablep)
+
+ (in-theory (disable logic.provablep)))
+
+
+(defthm booleanp-of-logic.provablep
+  (equal (booleanp (logic.provablep x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable logic.provablep))))
+
+(defthm forcing-logic.appealp-of-logic.provable-witness
+  (implies (force (logic.provablep x axioms thms atbl))
+           (equal (logic.appealp (logic.provable-witness x axioms thms atbl))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.provablep))))
+
+(defthm forcing-logic.proofp-of-logic.provable-witness
+  (implies (force (logic.provablep x axioms thms atbl))
+           (equal (logic.proofp (logic.provable-witness x axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.provablep)
+                                 (forcing-logic.appealp-of-logic.provable-witness)))))
+
+(defthm forcing-logic.conclusion-of-logic.provable-witness
+  (implies (force (logic.provablep x axioms thms atbl))
+           (equal (logic.conclusion (logic.provable-witness x axioms thms atbl))
+                  x))
+  :hints(("Goal" :in-theory (e/d (logic.provablep)
+                                 (forcing-logic.appealp-of-logic.provable-witness
+                                  forcing-logic.proofp-of-logic.provable-witness)))))
+
+(defthm logic.formulap-when-logic.provablep
+  ;; Hrmn.  We might not want this rule, since we probably want to know ahead of
+  ;; time that the formula is well-formed before we give it to provablep.
+  (implies (logic.provablep x axioms thms atbl)
+           (equal (logic.formulap x)
+                  t))
+  :hints(("Goal"
+          :in-theory (disable forcing-logic.formulap-of-logic.conclusion)
+          :use ((:instance forcing-logic.formulap-of-logic.conclusion
+                           (x (logic.provable-witness x axioms thms atbl)))))))
+
+(defthm logic.formula-atblp-when-logic.provablep
+  ;; Hrmn.  We might not want this rule, since we probably want to know ahead of
+  ;; time that the formula is well-formed before we give it to provablep.
+  (implies (logic.provablep x axioms thms atbl)
+           (equal (logic.formula-atblp x atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (disable logic.formula-atblp-of-logic.conclusion-when-logic.proofp)
+          :use ((:instance logic.formula-atblp-of-logic.conclusion-when-logic.proofp
+                           (x (logic.provable-witness x axioms thms atbl)))))))
+
+(defthm logic.provablep-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.provablep x axioms thms atbl)
+                  nil))
+  :hints(("Goal"
+          :in-theory (disable logic.formulap-when-not-consp)
+          :use ((:instance logic.formulap-when-not-consp)))))
+
+(defthm forcing-logic.provablep-when-logic.proofp
+  (implies (and (logic.proofp x axioms thms atbl)
+                (force (logic.appealp x)))
+           (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :use (:instance logic.provablep-suff
+                                 (proof x)
+                                 (x (logic.conclusion x))))))
+
+
+
+
+(deflist logic.provable-listp (x axioms thms atbl)
+  (logic.provablep x axioms thms atbl)
+  :elementp-of-nil nil
+  :guard (and (logic.formula-listp x)
+              (logic.formula-listp axioms)
+              (logic.formula-listp thms)
+              (logic.arity-tablep atbl)))
+
+(defthm logic.provablep-of-car-when-logic.provable-listp-free
+  (implies (and (equal free (logic.conclusion (car x)))
+                (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl))
+           (equal (logic.provablep free axioms thms atbl)
+                  (consp x))))
+
+(defthm logic.provablep-of-second-when-logic.provable-listp
+  ;; BOZO consider adding this to deflist.
+  (implies (logic.provable-listp x axioms thms atbl)
+           (equal (logic.provablep (second x) axioms thms atbl)
+                  (consp (cdr x)))))
+
+(defthm forcing-logic.provable-listp-of-logic.strip-conclusions-when-logic.proof-listp
+  (implies (and (logic.proof-listp x axioms thms atbl)
+                (force (logic.appeal-listp x)))
+           (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.provable-listp-of-logic.subproofs-when-logic.proofp
+   (implies (and (logic.proofp x axioms thms atbl)
+                 (force (logic.appealp x)))
+            (equal (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-logic.proofp))))
+
+(defthm logic.formula-list-atblp-of-when-logic.provable-listp
+  (implies (logic.provable-listp x axioms thms atbl)
+           (equal (logic.formula-list-atblp x atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defprojection :list (logic.provable-list-witness x axioms thms atbl)
+               :element (logic.provable-witness x axioms thms atbl)
+               :guard (and (logic.formula-listp x)
+                           (logic.formula-listp axioms)
+                           (logic.formula-listp thms)
+                           (logic.arity-tablep atbl)))
+
+(defthm forcing-logic.appeal-listp-of-logic.provable-list-witness
+  (implies (force (logic.provable-listp x axioms thms atbl))
+           (equal (logic.appeal-listp (logic.provable-list-witness x axioms thms atbl))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm force-logic.proof-listp-of-logic.provable-list-witness
+  (implies (force (logic.provable-listp x axioms thms atbl))
+           (equal (logic.proof-listp (logic.provable-list-witness x axioms thms atbl) axioms thms atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.strip-conclusions-of-logic.provable-list-witness
+  (implies (force (logic.provable-listp x axioms thms atbl))
+           (equal (logic.strip-conclusions (logic.provable-list-witness x axioms thms atbl))
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.provablep-of-logic.conclusion-of-first-when-logic.provable-listp
+  (implies (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+           (equal (logic.provablep (logic.conclusion (car x)) axioms thms atbl)
+                  (consp x))))
+
+(defthm logic.provablep-of-logic.conclusion-of-second-when-logic.provable-listp
+  (implies (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+           (equal (logic.provablep (logic.conclusion (second x)) axioms thms atbl)
+                  (consp (cdr x)))))
+
+(defthm logic.provablep-of-logic.conclusion-of-third-when-logic.provable-listp
+  (implies (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+           (equal (logic.provablep (logic.conclusion (third x)) axioms thms atbl)
+                  (consp (cdr (cdr x))))))
+
+(defthm logic.provablep-of-logic.conclusion-of-fourth-when-logic.provable-listp
+  (implies (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+           (equal (logic.provablep (logic.conclusion (fourth x)) axioms thms atbl)
+                  (consp (cdr (cdr (cdr x)))))))
+
+
+
+
+;; BOZO fix proofp.lisp to unlocalize these
+;; Skip can stay local
+
+(defthmd lemma-axiom-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.axiom-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) axioms atbl)
+                  (logic.axiom-okp x axioms atbl)))
+  :hints(("Goal" :in-theory (enable logic.axiom-okp))))
+
+(defthmd lemma-theorem-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.theorem-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) thms atbl)
+                  (logic.theorem-okp x thms atbl)))
+  :hints(("Goal" :in-theory (enable logic.theorem-okp))))
+
+(defthmd lemma-propositional-schema-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.propositional-schema-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                  (logic.propositional-schema-okp x atbl)))
+  :hints(("Goal" :in-theory (e/d (logic.propositional-schema-okp)
+                                 ((:executable-counterpart ACL2::force))))))
+
+(defthmd lemma-functional-equality-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.functional-equality-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                  (logic.functional-equality-okp x atbl)))
+  :hints(("Goal" :in-theory (enable logic.functional-equality-okp))))
+
+(defthmd lemma-beta-reduction-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.beta-reduction-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                  (logic.beta-reduction-okp x atbl)))
+  :hints(("Goal" :in-theory (enable logic.beta-reduction-okp))))
+
+(defthmd lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (equal (logic.strip-conclusions a) (logic.strip-conclusions b))
+           (equal (equal (len a) (len b))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable len-of-logic.strip-conclusions)
+          :use ((:instance len-of-logic.strip-conclusions (x a))
+                (:instance len-of-logic.strip-conclusions (x b))))))
+
+(defthmd lemma-expansion-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.expansion-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                  (logic.expansion-okp x atbl)))
+  :hints(("Goal"
+          :in-theory (e/d (logic.expansion-okp)
+                          ((:executable-counterpart ACL2::force)))
+          :use ((:instance lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable
+                           (a (logic.subproofs x))
+                           (b new-subproofs))))))
+
+(defthmd lemma-contraction-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.contraction-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)))
+                  (logic.contraction-okp x)))
+  :hints(("Goal"
+          :in-theory (enable logic.contraction-okp)
+          :use ((:instance lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable
+                           (a (logic.subproofs x))
+                           (b new-subproofs))))))
+
+(defthmd lemma-associativity-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.associativity-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)))
+                  (logic.associativity-okp x)))
+  :hints(("Goal"
+          :in-theory (enable logic.associativity-okp)
+          :use ((:instance lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable
+                           (a (logic.subproofs x))
+                           (b new-subproofs))))))
+
+(defthmd lemma-cut-for-forcing-logic.provablep-when-logic.subproofs-provable
+          (implies (and (logic.appealp x)
+                        (logic.appeal-listp new-subproofs)
+                        (true-listp new-subproofs)
+                        (equal (logic.strip-conclusions (logic.subproofs x))
+                               (logic.strip-conclusions new-subproofs)))
+                   (equal (logic.cut-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)))
+                          (logic.cut-okp x)))
+          :hints(("Goal"
+                  :in-theory (enable logic.cut-okp)
+                  :use ((:instance lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                   (a (logic.subproofs x))
+                                   (b new-subproofs))))))
+
+(defthmd lemma-instantiation-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.instantiation-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                  (logic.instantiation-okp x atbl)))
+  :hints(("Goal"
+          :in-theory (enable logic.instantiation-okp)
+          :use ((:instance lemma-equal-lens-of-logic.strip-conclusions-for-forcing-logic.provablep-when-logic.subproofs-provable
+                           (a (logic.subproofs x))
+                           (b new-subproofs))))))
+
+(defthmd lemma-induction-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.induction-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)))
+                  (logic.induction-okp x)))
+  :hints(("Goal" :in-theory (enable logic.induction-okp))))
+
+(defthmd lemma-base-eval-for-forcing-logic.provablep-when-logic.subproofs-provable
+  (implies (and (logic.appealp x)
+                (logic.appeal-listp new-subproofs)
+                (true-listp new-subproofs)
+                (equal (logic.strip-conclusions (logic.subproofs x))
+                       (logic.strip-conclusions new-subproofs)))
+           (equal (logic.base-eval-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                  (logic.base-eval-okp x atbl)))
+  :hints(("Goal" :in-theory (e/d (logic.base-eval-okp)
+                                 ((:executable-counterpart ACL2::force))))))
+
+(encapsulate
+ ()
+ (local (defthm lemma-skip
+          ;; BOZO remove me eventually
+          (implies (and (logic.appealp x)
+                        (logic.appeal-listp new-subproofs)
+                        (true-listp new-subproofs)
+                        (equal (logic.strip-conclusions (logic.subproofs x))
+                               (logic.strip-conclusions new-subproofs)))
+                   (equal (logic.skip-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) atbl)
+                          (logic.skip-okp x atbl)))
+          :hints(("Goal" :in-theory (enable logic.skip-okp)))))
+
+ (defthmd lemma-appeal-step-for-forcing-logic.provablep-when-logic.subproofs-provable
+   (implies (and (logic.appealp x)
+                 (logic.appeal-listp new-subproofs)
+                 (true-listp new-subproofs)
+                 (equal (logic.strip-conclusions (logic.subproofs x))
+                        (logic.strip-conclusions new-subproofs)))
+            (equal (logic.appeal-step-okp (logic.appeal (logic.method x) (logic.conclusion x) new-subproofs (logic.extras x)) axioms thms atbl)
+                   (logic.appeal-step-okp x axioms thms atbl)))
+   :hints(("Goal" :in-theory (enable logic.appeal-step-okp
+                                     lemma-axiom-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-theorem-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-propositional-schema-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-functional-equality-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-beta-reduction-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-expansion-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-contraction-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-associativity-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-cut-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-instantiation-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-induction-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                     lemma-base-eval-for-forcing-logic.provablep-when-logic.subproofs-provable)))))
+
+(defthmd lemma-main-for-forcing-logic.provablep-when-logic.subproofs-provable
+  ;; If we have a step-wise ok appeal, and all of its subproofs are
+  ;; provable, then we can prove its conclusion by applying this step to
+  ;; the witnessing proofs for its subproofs.
+  (implies (and (logic.appealp x)
+                (logic.appeal-step-okp x axioms thms atbl)
+                (logic.formula-atblp (logic.conclusion x) atbl)
+                (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+           (equal (logic.proofp
+                   (logic.appeal (logic.method x)
+                                 (logic.conclusion x)
+                                 (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                              axioms thms atbl)
+                                 (logic.extras x))
+                   axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable lemma-appeal-step-for-forcing-logic.provablep-when-logic.subproofs-provable
+                                    definition-of-logic.proofp))))
+
+
+
+(defthm forcing-logic.provablep-when-logic.subproofs-provable
+   (implies (and (logic.appeal-step-okp x axioms thms atbl)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (force (logic.appealp x))
+                 (force (logic.formula-atblp (logic.conclusion x) atbl)))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints(("Goal"
+           :in-theory (enable lemma-main-for-forcing-logic.provablep-when-logic.subproofs-provable)
+           :use (:instance forcing-logic.provablep-when-logic.proofp
+                           (x (logic.appeal (logic.method x)
+                                            (logic.conclusion x)
+                                            (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                         axioms thms atbl)
+                                            (logic.extras x)))))))
+
+
+
+(defthm logic.provable-listp-of-logic.strip-conclusions-when-provable-first-and-rest
+  ;; BOZO What in the world is this rule for?
+  (implies (and (logic.provablep (logic.conclusion (car x)) axioms thms atbl)
+                (logic.provable-listp (logic.strip-conclusions (cdr x)) axioms thms atbl))
+           (equal (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+                  t)))
+
+
+(defthm logic.formula-list-atblp-of-logic.strip-conclusions-of-cdr-when-logic.provable-listp
+  ;; BOZO add to backchaining rules
+  (implies (logic.provable-listp (logic.strip-conclusions x) axioms thms atbl)
+           (equal (logic.formula-list-atblp (logic.strip-conclusions (cdr x)) atbl)
+                  t)))
+
+
+
+(defund logic.soundness-claim (name)
+  (declare (xargs :guard (logic.function-namep name)))
+  (logic.por '(pequal* (logic.appealp x) 'nil)
+   (logic.por (logic.pequal (logic.function name '(x axioms thms atbl)) ''nil)
+              '(pnot* (pequal* (logic.provablep (logic.conclusion x) axioms thms atbl) 'nil)))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/quote-range.lisp acl2-6.3/books/milawa/ACL2/logic/quote-range.lisp
--- acl2-6.2/books/milawa/ACL2/logic/quote-range.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/quote-range.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,113 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "groundp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Walk through a map, quoting every element in the range.
+
+(defund logic.quote-range (x)
+  (declare (xargs :guard (mapp x)))
+  (if (consp x)
+      (cons (cons (car (car x))
+                  (list 'quote (cdr (car x))))
+            (logic.quote-range (cdr x)))
+    nil))
+
+(defthm logic.quote-range-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.quote-range x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.quote-range))))
+
+(defthm logic.quote-range-of-cons
+  (equal (logic.quote-range (cons a x))
+         (cons (cons (car a) (list 'quote (cdr a)))
+               (logic.quote-range x)))
+  :hints(("Goal" :in-theory (enable logic.quote-range))))
+
+(defthm true-listp-of-logic.quote-range
+  (equal (true-listp (logic.quote-range x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.quote-range-of-list-fix
+  (equal (logic.quote-range (list-fix x))
+         (logic.quote-range x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-logic.quote-range
+  (equal (len (logic.quote-range x))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.quote-range-of-app
+  (equal (logic.quote-range (app x y))
+         (app (logic.quote-range x)
+              (logic.quote-range y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.sigmap-of-logic.quote-range
+  (implies (force (logic.sigmap x))
+           (equal (logic.sigmap (logic.quote-range x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.sigma-atblp-of-logic.quote-range
+  (implies (force (logic.variable-listp (domain sigma)))
+           (equal (logic.sigma-atblp (logic.quote-range sigma) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction sigma))))
+
+(defthm forcing-logic.constant-listp-of-range-of-logic.quote-range
+  (implies (force (logic.sigmap x))
+           (equal (logic.constant-listp (range (logic.quote-range x)))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.ground-listp-of-range-of-logic.quote-range
+  (implies (force (logic.sigmap x))
+           (equal (logic.ground-listp (range (logic.quote-range x)))
+                  t)))
+
+(defthm forcing-domain-of-logic.quote-range
+  (equal (domain (logic.quote-range x))
+         (domain x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/replace-proofs.lisp acl2-6.3/books/milawa/ACL2/logic/replace-proofs.lisp
--- acl2-6.2/books/milawa/ACL2/logic/replace-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/replace-proofs.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,331 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "find-proof")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+; Proof Replacement.
+;
+; A basic goal of this file is to be able to support reasoning of the form,
+;
+;  Given: BLDR is sound as long as FOO is a theorem.
+;  Given: A proof of FOO.
+;  Conclude: BLDR's conclusions are sound even when FOO is not a theorem.
+;
+; To carry out this sort of thing, we introduce a proof-replacing function,
+; which walks through an appeal and replaces any conclusions of some form
+; with a new proof.  Then, we see that
+;
+;   Replace(BLDR's output, Proof of FOO)
+;
+; Is a proof of BLDR's output which is true even without having FOO as a
+; theorem of the history.
+
+(defund logic.flag-replace-proofs (flag x proofs)
+  (declare (xargs :guard (and (if (equal flag 'proof)
+                                  (logic.appealp x)
+                                (and (equal flag 'list)
+                                     (logic.appeal-listp x)))
+                              (logic.appeal-listp proofs))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'proof) 1 0))
+                  :verify-guards nil))
+  (if (equal flag 'proof)
+      (or (logic.find-proof (logic.conclusion x) proofs)
+          (logic.appeal (logic.method x)
+                        (logic.conclusion x)
+                        (logic.flag-replace-proofs 'list (logic.subproofs x) proofs)
+                        (logic.extras x)))
+    (if (consp x)
+        (cons (logic.flag-replace-proofs 'proof (car x) proofs)
+              (logic.flag-replace-proofs 'list (cdr x) proofs))
+      nil)))
+
+(defund logic.replace-proofs (x proofs)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.appeal-listp proofs))
+                  :verify-guards nil))
+  (logic.flag-replace-proofs 'proof x proofs))
+
+(defund logic.replace-proofs-list (x proofs)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.appeal-listp proofs))
+                  :verify-guards nil))
+  (logic.flag-replace-proofs 'list x proofs))
+
+(defthmd definition-of-logic.replace-proofs
+  (equal (logic.replace-proofs x proofs)
+         (or (logic.find-proof (logic.conclusion x) proofs)
+             (logic.appeal (logic.method x)
+                           (logic.conclusion x)
+                           (logic.replace-proofs-list (logic.subproofs x) proofs)
+                           (logic.extras x))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-replace-proofs
+                                    logic.replace-proofs
+                                    logic.replace-proofs-list))))
+
+(defthmd definition-of-logic.replace-proofs-list
+  (equal (logic.replace-proofs-list x proofs)
+         (if (consp x)
+             (cons (logic.replace-proofs (car x) proofs)
+                   (logic.replace-proofs-list (cdr x) proofs))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable logic.flag-replace-proofs
+                             logic.replace-proofs
+                             logic.replace-proofs-list)
+          :expand (logic.flag-replace-proofs 'list x proofs))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.replace-proofs))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.replace-proofs-list))))
+
+(defthm logic.replace-proofs-list-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.replace-proofs-list x proofs)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.replace-proofs-list))))
+
+(defthm logic.replace-proofs-list-of-cons
+  (equal (logic.replace-proofs-list (cons a x) proofs)
+         (cons (logic.replace-proofs a proofs)
+               (logic.replace-proofs-list x proofs)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.replace-proofs-list))))
+
+(defprojection
+  :list (logic.replace-proofs-list x proofs)
+  :element (logic.replace-proofs x proofs)
+  :already-definedp t)
+
+
+
+(defthms-flag
+  :shared-hyp (force (logic.appeal-listp proofs))
+  :thms ((proof logic.appealp-of-logic.replace-proofs
+                (implies (force (logic.appealp x))
+                         (equal (logic.appealp (logic.replace-proofs x proofs))
+                                t)))
+         (t logic.appeal-listp-of-logic.replace-proofs-list
+            (implies (force (logic.appeal-listp x))
+                     (equal (logic.appeal-listp (logic.replace-proofs-list x proofs))
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (e/d (definition-of-logic.replace-proofs)
+                          ((ACL2::force))))))
+
+(defthms-flag
+  :shared-hyp (force (logic.appeal-listp proofs))
+  :thms ((proof logic.conclusion-of-logic.replace-proofs
+                (implies (force (logic.appealp x))
+                         (equal (logic.conclusion (logic.replace-proofs x proofs))
+                                (logic.conclusion x))))
+         (t logic.strip-conclusions-of-logic.replace-proofs-list
+            (implies (force (logic.appeal-listp x))
+                     (equal (logic.strip-conclusions (logic.replace-proofs-list x proofs))
+                            (logic.strip-conclusions x)))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (e/d (definition-of-logic.replace-proofs)
+                          ((ACL2::force))))))
+
+(defthmd lemma-1-for-logic.proofp-of-logic.replace-proofs
+  (implies (and (not (equal (logic.method x) 'axiom))
+                (not (equal (logic.method x) 'theorem)))
+           (equal
+            (logic.appeal-step-okp x
+                                   (difference axioms remove)
+                                   (difference thms remove)
+                                   atbl)
+            (logic.appeal-step-okp x axioms thms atbl)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp))))
+
+(defthmd lemma-2-for-logic.proofp-of-logic.replace-proofs
+  (implies (and (or (equal (logic.method x) 'axiom)
+                    (equal (logic.method x) 'theorem))
+                (not (memberp (logic.conclusion x) remove)))
+           (equal
+            (logic.appeal-step-okp x
+                                   (difference axioms remove)
+                                   (difference thms remove)
+                                   atbl)
+            (logic.appeal-step-okp x axioms thms atbl)))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp
+                                    logic.axiom-okp
+                                    logic.theorem-okp))))
+
+(defthmd lemma-3-for-logic.proofp-of-logic.replace-proofs
+  (implies (not (memberp (logic.conclusion x) remove))
+           (equal (logic.appeal-step-okp x
+                                         (difference axioms remove)
+                                         (difference thms remove)
+                                         atbl)
+                  (logic.appeal-step-okp x axioms thms atbl)))
+  :hints(("Goal" :use ((:instance lemma-1-for-logic.proofp-of-logic.replace-proofs)
+                       (:instance lemma-2-for-logic.proofp-of-logic.replace-proofs)))))
+
+(defthmd lemma-4-for-logic.proofp-of-logic.replace-proofs
+  (implies (and (logic.proof-listp (logic.replace-proofs-list (logic.subproofs x) proofs)
+                                   (difference axioms (logic.strip-conclusions proofs))
+                                   (difference thms (logic.strip-conclusions proofs))
+                                   atbl)
+                (logic.appeal-listp proofs)
+                (logic.proof-listp proofs
+                                   (difference axioms (logic.strip-conclusions proofs))
+                                   (difference thms (logic.strip-conclusions proofs))
+                                   atbl)
+                (logic.appealp x)
+                (logic.appeal-step-okp x axioms thms atbl)
+                (logic.proof-listp (logic.subproofs x) axioms thms atbl)
+                (not (logic.find-proof (logic.conclusion x) proofs)))
+           (logic.proofp (logic.appeal (logic.method x)
+                                       (logic.conclusion x)
+                                       (logic.replace-proofs-list (logic.subproofs x)
+                                                                  proofs)
+                                       (logic.extras x))
+                         (difference axioms (logic.strip-conclusions proofs))
+                         (difference thms (logic.strip-conclusions proofs))
+                         atbl))
+  :hints(("Goal"
+          :in-theory (enable definition-of-logic.proofp)
+          :use ((:instance lemma-appeal-step-for-forcing-logic.provablep-when-logic.subproofs-provable
+                           (new-subproofs (logic.replace-proofs-list (logic.subproofs x) proofs)))
+                (:instance lemma-3-for-logic.proofp-of-logic.replace-proofs
+                           (x (logic.appeal (logic.method x)
+                                            (logic.conclusion x)
+                                            (logic.replace-proofs-list (logic.subproofs x) proofs)
+                                            (logic.extras x)))
+                           (remove (logic.strip-conclusions proofs)))))))
+
+(defthms-flag
+  :shared-hyp (and (force (logic.appeal-listp proofs))
+                   (force (logic.proof-listp proofs
+                                             (difference axioms (logic.strip-conclusions proofs))
+                                             (difference thms (logic.strip-conclusions proofs))
+                                             atbl)))
+  :thms ((proof logic.proofp-of-logic.replace-proofs
+                (implies (and (force (logic.appealp x))
+                              (force (logic.proofp x axioms thms atbl)))
+                         (equal (logic.proofp (logic.replace-proofs x proofs)
+                                              (difference axioms (logic.strip-conclusions proofs))
+                                              (difference thms (logic.strip-conclusions proofs))
+                                              atbl)
+                                t)))
+
+         (t logic.proof-listp-of-logic.replace-proofs-list
+            (implies (and (force (logic.appeal-listp x))
+                          (force (logic.proof-listp x axioms thms atbl)))
+                     (equal (logic.proof-listp (logic.replace-proofs-list x proofs)
+                                               (difference axioms (logic.strip-conclusions proofs))
+                                               (difference thms (logic.strip-conclusions proofs))
+                                               atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-logic.replace-proofs
+                             definition-of-logic.proofp
+                             lemma-4-for-logic.proofp-of-logic.replace-proofs))))
+
+
+
+(defthm logic.appeal-step-okp-in-larger-axiom-set
+  (implies (and (subsetp axioms more-axioms)
+                (logic.appeal-step-okp x axioms thms atbl))
+           (equal (logic.appeal-step-okp x more-axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp
+                                    logic.axiom-okp))))
+
+(defthms-flag
+  :shared-hyp (subsetp axioms more-axioms)
+  :thms ((proof logic.proofp-in-larger-axiom-set
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (logic.proofp x more-axioms thms atbl)
+                                t)))
+         (t logic.proof-listp-in-larger-axiom-set
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (logic.proof-listp x more-axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-logic.proofp))))
+
+(defthm logic-provablep-in-larger-axiom-set
+  (implies (and (subsetp axioms more-axioms)
+                (logic.provablep x axioms thms atbl))
+           (equal (logic.provablep x more-axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.provablep)
+                                 ((ACL2::force))))))
+
+
+
+(defthm logic.appeal-step-okp-in-larger-theorem-set
+  (implies (and (subsetp thms more-thms)
+                (logic.appeal-step-okp x axioms thms atbl))
+           (equal (logic.appeal-step-okp x axioms more-thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.appeal-step-okp
+                                    logic.theorem-okp))))
+
+(defthms-flag
+  :shared-hyp (subsetp thms more-thms)
+  :thms ((proof logic.proofp-in-larger-theorem-set
+                (implies (logic.proofp x axioms thms atbl)
+                         (equal (logic.proofp x axioms more-thms atbl)
+                                t)))
+         (t logic.proof-listp-in-larger-theorem-set
+            (implies (logic.proof-listp x axioms thms atbl)
+                     (equal (logic.proof-listp x axioms more-thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (logic.appeal-induction flag x)
+          :in-theory (enable definition-of-logic.proofp))))
+
+(defthm logic-provablep-in-larger-theorem-set
+  (implies (and (subsetp thms more-thms)
+                (logic.provablep x axioms thms atbl))
+           (equal (logic.provablep x axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.provablep)
+                                 ((ACL2::force))))))
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/replace-subterm.lisp acl2-6.3/books/milawa/ACL2/logic/replace-subterm.lisp
--- acl2-6.2/books/milawa/ACL2/logic/replace-subterm.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/replace-subterm.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,239 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund logic.flag-replace-subterm (flag x old new)
+   ;; Replace all occurrences of old with new in x.  We don't descend into
+   ;; lambda bodies.
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (logic.termp old)
+                              (logic.termp new))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((equal x old) new)
+            ((logic.constantp x) x)
+            ((logic.variablep x) x)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (logic.function name (logic.flag-replace-subterm 'list args old new))))
+            ((logic.lambdap x)
+             (let ((formals (logic.lambda-formals x))
+                   (body    (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               (logic.lambda formals body (logic.flag-replace-subterm 'list actuals old new))))
+            (t nil))
+    (if (consp x)
+        (cons (logic.flag-replace-subterm 'term (car x) old new)
+              (logic.flag-replace-subterm 'list (cdr x) old new))
+      nil)))
+
+(definlined logic.replace-subterm (x old new)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp old)
+                              (logic.termp new))
+                  :verify-guards nil))
+  (logic.flag-replace-subterm 'term x old new))
+
+(definlined logic.replace-subterm-list (x old new)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.termp old)
+                              (logic.termp new))
+                  :verify-guards nil))
+  (logic.flag-replace-subterm 'list x old new))
+
+(defthmd definition-of-logic.replace-subterm
+  (equal (logic.replace-subterm x old new)
+         (cond ((equal x old) new)
+               ((logic.constantp x) x)
+               ((logic.variablep x) x)
+               ((logic.functionp x)
+                (let ((name (logic.function-name x))
+                      (args (logic.function-args x)))
+                  (logic.function name (logic.replace-subterm-list args old new))))
+               ((logic.lambdap x)
+                (let ((formals (logic.lambda-formals x))
+                      (body    (logic.lambda-body x))
+                      (actuals (logic.lambda-actuals x)))
+                  (logic.lambda formals body (logic.replace-subterm-list actuals old new))))
+               (t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-replace-subterm
+                                    logic.replace-subterm
+                                    logic.replace-subterm-list))))
+
+(defthmd definition-of-logic.replace-subterm-list
+  (equal (logic.replace-subterm-list x old new)
+         (if (consp x)
+             (cons (logic.replace-subterm (car x) old new)
+                   (logic.replace-subterm-list (cdr x) old new))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.flag-replace-subterm
+                                    logic.replace-subterm
+                                    logic.replace-subterm-list))))
+
+(defthm logic.flag-replace-subterm-of-term-removal
+  (equal (logic.flag-replace-subterm 'term x old new)
+         (logic.replace-subterm x old new))
+  :hints(("Goal" :in-theory (enable logic.replace-subterm))))
+
+(defthm logic.flag-replace-subterm-of-list-removal
+  (equal (logic.flag-replace-subterm 'list x old new)
+         (logic.replace-subterm-list x old new))
+  :hints(("Goal" :in-theory (enable logic.replace-subterm-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.replace-subterm))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.replace-subterm-list))))
+
+(defthm logic.replace-subterm-list-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.replace-subterm-list x old new)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.replace-subterm-list))))
+
+(defthm logic.replace-subterm-list-of-cons
+  (equal (logic.replace-subterm-list (cons a x) old new)
+         (cons (logic.replace-subterm a old new)
+               (logic.replace-subterm-list x old new)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.replace-subterm-list))))
+
+(defprojection :list (logic.replace-subterm-list x old new)
+               :element (logic.replace-subterm x old new)
+               :already-definedp t)
+
+
+
+(defthms-flag
+  :shared-hyp (force (logic.termp new))
+  :thms ((term forcing-logic.termp-of-logic.replace-subterm
+               (implies (force (logic.termp x))
+                        (equal (logic.termp (logic.replace-subterm x old new))
+                               t)))
+         (t forcing-logic.term-listp-of-logic.replace-subterm-list
+            (implies (force (logic.term-listp x))
+                     (equal (logic.term-listp (logic.replace-subterm-list x old new))
+                            t))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-logic.replace-subterm)
+           :restrict ((definition-of-logic.replace-subterm ((x x))))
+           :induct (logic.term-induction flag x))))
+
+(defthms-flag
+   :shared-hyp (force (logic.term-atblp new atbl))
+   :thms ((term forcing-logic.term-atblp-of-logic.replace-subterm
+                (implies (force (logic.term-atblp x atbl))
+                         (equal (logic.term-atblp (logic.replace-subterm x old new) atbl)
+                                t)))
+          (t forcing-logic.term-list-atblp-of-logic.replace-subterm-list
+             (implies (force (logic.term-list-atblp x atbl))
+                      (equal (logic.term-list-atblp (logic.replace-subterm-list x old new) atbl)
+                             t))))
+   :hints (("Goal"
+            :in-theory (enable definition-of-logic.replace-subterm)
+            :induct (logic.term-induction flag x)
+            :restrict ((definition-of-logic.replace-subterm ((x x)))))))
+
+(defthms-flag
+  :shared-hyp (logic.variablep new)
+  :thms ((term forcing-logic.substitute-of-logic.replace-subterm-with-fresh-variable
+               (implies (and (not (memberp new (logic.term-vars x)))
+                             (force (logic.termp x)))
+                        (equal (logic.substitute (logic.replace-subterm x old new)
+                                                 (list (cons new old)))
+                               x)))
+         (t forcing-logic.substitute-of-logic.replace-subterm-list-with-fresh-variable
+            (implies (and (not (memberp new (logic.term-list-vars x)))
+                          (force (logic.term-listp x)))
+                     (equal (logic.substitute-list (logic.replace-subterm-list x old new)
+                                                   (list (cons new old)))
+                            (list-fix x)))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-logic.replace-subterm)
+           :induct (logic.term-induction flag x)
+           :restrict ((definition-of-logic.replace-subterm-list ((x x)))))))
+
+
+
+(verify-guards logic.flag-replace-subterm)
+(verify-guards logic.replace-subterm)
+(verify-guards logic.replace-subterm-list)
+
+
+
+
+(defprojection :list (logic.replace-subterm-list-list x old new)
+               :element (logic.replace-subterm-list x old new)
+               :guard (and (logic.term-list-listp x)
+                           (logic.termp old)
+                           (logic.termp new)))
+
+(defthm forcing-logic.term-list-listp-of-logic.replace-subterm-list-list
+  (implies (force (and (logic.term-list-listp x)
+                       (logic.termp new)))
+           (equal (logic.term-list-listp (logic.replace-subterm-list-list x old new))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atblp-of-logic.replace-subterm-list-list
+  (implies (force (and (logic.term-list-list-atblp x atbl)
+                       (logic.term-atblp new atbl)))
+           (equal (logic.term-list-list-atblp (logic.replace-subterm-list-list x old new) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-logic.replace-subterm-list-list
+  (equal (cons-listp (logic.replace-subterm-list-list x old new))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.substitute-of-logic.replace-subterm-list-list-with-fresh-variable
+   (implies (and (not (memberp new (logic.term-list-list-vars x)))
+                 (logic.variablep new)
+                 (force (logic.term-list-listp x)))
+            (equal (logic.substitute-list-list (logic.replace-subterm-list-list x old new)
+                                               (list (cons new old)))
+                   (list-list-fix x)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/substitute-formula.lisp acl2-6.3/books/milawa/ACL2/logic/substitute-formula.lisp
--- acl2-6.2/books/milawa/ACL2/logic/substitute-formula.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/substitute-formula.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,251 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(include-book "formulas")
+(include-book "disjoin-formulas")
+(include-book "negate-formulas")
+(include-book "pequal-list")
+(include-book "por-list")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; [logic.substitute-formula] extends our ability to substitute into terms, by
+;; allowing us now to substitute into formulas.  Instead of taking a term as
+;; its first input, it takes a formula instead.
+(defund logic.substitute-formula (formula sigma)
+  (declare (xargs :guard (and (logic.formulap formula)
+                              (logic.sigmap sigma))
+                  :verify-guards nil))
+  (let ((type (logic.fmtype formula)))
+    (cond ((equal type 'por*)
+           (logic.por (logic.substitute-formula (logic.vlhs formula) sigma)
+                      (logic.substitute-formula (logic.vrhs formula) sigma)))
+          ((equal type 'pnot*)
+           (logic.pnot (logic.substitute-formula (logic.~arg formula) sigma)))
+          ((equal type 'pequal*)
+           (logic.pequal (logic.substitute (logic.=lhs formula) sigma)
+                         (logic.substitute (logic.=rhs formula) sigma)))
+          (t nil))))
+
+(defthm logic.substitute-formula-of-logic.por
+  (equal (logic.substitute-formula (logic.por x y) sigma)
+         (logic.por (logic.substitute-formula x sigma)
+                    (logic.substitute-formula y sigma)))
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+(defthm logic.substitute-formula-of-logic.pnot
+  (equal (logic.substitute-formula (logic.pnot x) sigma)
+         (logic.pnot (logic.substitute-formula x sigma)))
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+(defthm logic.substitute-formula-of-logic.pequal
+  (equal (logic.substitute-formula (logic.pequal x y) sigma)
+         (logic.pequal (logic.substitute x sigma)
+                       (logic.substitute y sigma)))
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+(defthm logic.substitute-formula-when-malformed-cheap
+  (implies (and (not (equal (logic.fmtype formula) 'por*))
+                (not (equal (logic.fmtype formula) 'pnot*))
+                (not (equal (logic.fmtype formula) 'pequal*)))
+           (equal (logic.substitute-formula formula sigma)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (e/d (logic.substitute-formula)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(defthm logic.substitute-formula-of-nil
+  (equal (logic.substitute-formula nil sigma)
+         nil)
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+(defthm forcing-logic.formulap-of-logic.substitute-formula
+  (implies (and (force (logic.formulap formula))
+                (force (logic.sigmap sigma)))
+           (equal (logic.formulap (logic.substitute-formula formula sigma))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+(defthm forcing-logic.formula-atblp-of-logic.substitute-formula
+  (implies (and (force (logic.formula-atblp formula atbl))
+                (force (logic.sigma-atblp sigma atbl)))
+           (equal (logic.formula-atblp (logic.substitute-formula formula sigma) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (logic.substitute-formula)
+                                 (logic.fmtype-normalizer-cheap)))))
+
+(verify-guards logic.substitute-formula)
+
+
+(defthm forcing-logic.substitute-formula-under-iff
+  (implies (force (logic.formulap formula))
+           (iff (logic.substitute-formula formula sigma)
+                t))
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+(defthm forcing-logic.fmtype-of-logic.substitute-formula
+  (implies (force (logic.formulap x))
+           (equal (logic.fmtype (logic.substitute-formula x sigma))
+                  (logic.fmtype x)))
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+(defthm forcing-logic.=lhs-of-logic.substitute-formula
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.=lhs (logic.substitute-formula x sigma))
+                  (logic.substitute (logic.=lhs x) sigma)))
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+(defthm forcing-logic.=rhs-of-logic.substitute-formula
+  (implies (and (force (logic.formulap x))
+                (force (equal (logic.fmtype x) 'pequal*)))
+           (equal (logic.=rhs (logic.substitute-formula x sigma))
+                  (logic.substitute (logic.=rhs x) sigma)))
+  :hints(("Goal" :in-theory (enable logic.substitute-formula))))
+
+
+
+
+(defprojection :list (logic.substitute-formula-list x sigma)
+               :element (logic.substitute-formula x sigma)
+               :guard (and (logic.formula-listp x)
+                           (logic.sigmap sigma))
+               :nil-preservingp t)
+
+(defthm forcing-logic.formula-listp-of-logic.substitute-formula-list
+  (implies (force (and (logic.formula-listp x)
+                       (logic.sigmap sigma)))
+           (equal (logic.formula-listp (logic.substitute-formula-list x sigma))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.substitute-formula-list
+  (implies (force (and (logic.formula-list-atblp x atbl)
+                       (logic.sigma-atblp sigma atbl)))
+           (equal (logic.formula-list-atblp (logic.substitute-formula-list x sigma) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.substitute-formula-of-logic.disjoin-formulas
+  (equal (logic.substitute-formula (logic.disjoin-formulas x) sigma)
+         (logic.disjoin-formulas (logic.substitute-formula-list x sigma)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable logic.substitute-formula logic.disjoin-formulas))))
+
+(defthm logic.substitute-formula-list-of-logic.negate-formulas
+  (equal (logic.substitute-formula-list (logic.negate-formulas x) sigma)
+         (logic.negate-formulas (logic.substitute-formula-list x sigma)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.substitute-formula-list-of-logic.pequal-list
+  (equal (logic.substitute-formula-list (logic.pequal-list x y) sigma)
+         (logic.pequal-list (logic.substitute-list x sigma)
+                            (logic.substitute-list y sigma)))
+  :hints(("Goal"
+          :induct (cdr-cdr-induction x y)
+          :in-theory (disable forcing-equal-of-logic.pequal-list-rewrite))))
+
+(defthm logic.substitute-formula-list-of-logic.por-list
+  (equal (logic.substitute-formula-list (logic.por-list x y) sigma)
+         (logic.por-list (logic.substitute-formula-list x sigma)
+                         (logic.substitute-formula-list y sigma)))
+  :hints(("Goal"
+          :induct (cdr-cdr-induction x y)
+          :in-theory (disable forcing-equal-of-logic.por-list-rewrite))))
+
+
+
+
+(defprojection :list (logic.substitute-formula-list-list x sigma)
+               :element (logic.substitute-formula-list x sigma)
+               :guard (and (logic.formula-list-listp x)
+                           (logic.sigmap sigma)))
+
+(defthm forcing-logic.formula-list-listp-of-logic.substitute-formula-list-list
+  (implies (force (and (logic.formula-list-listp x)
+                       (logic.sigmap sigma)))
+           (equal (logic.formula-list-listp (logic.substitute-formula-list-list x sigma))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-list-atblp-of-logic.substitute-formula-list-list
+  (implies (force (and (logic.formula-list-list-atblp x atbl)
+                       (logic.sigma-atblp sigma atbl)))
+           (equal (logic.formula-list-list-atblp (logic.substitute-formula-list-list x sigma) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.substitute-formula-list-of-logic.disjoin-each-formula-list
+  (equal (logic.substitute-formula-list (logic.disjoin-each-formula-list x) sigma)
+         (logic.disjoin-each-formula-list (logic.substitute-formula-list-list x sigma)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.substitute-formula-list-of-logic.disjoin-each-formula-list-free
+  (implies (equal x (logic.disjoin-each-formula-list y))
+           (equal (logic.substitute-formula-list x sigma)
+                  (logic.disjoin-each-formula-list (logic.substitute-formula-list-list y sigma)))))
+
+
+
+
+
+;; [logic.substitute-each-sigma-into-formula] takes two inputs: a formula F and
+;; a list of sigmas, i.e., (sigma1 ... sigmaN).  It produces a list of formulas
+;; as outputs, i.e., (F/sigma1 ... F/sigmaN)
+
+(defprojection :list (logic.substitute-each-sigma-into-formula f x)
+               :element (logic.substitute-formula f x)
+               :guard (and (logic.formulap f)
+                           (logic.sigma-listp x))
+               :nil-preservingp nil)
+
+(defthm logic.formula-listp-of-logic.substitute-each-sigma-into-formula
+  (implies (and (force (logic.formulap f))
+                (force (logic.sigma-listp sigmas)))
+           (equal (logic.formula-listp (logic.substitute-each-sigma-into-formula f sigmas))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.substitute-each-sigma-into-formula))))
+
+(defthm logic.formula-list-atblp-of-logic.substitute-each-sigma-into-formula
+  (implies (and (force (logic.formula-atblp f atbl))
+                (force (logic.sigma-list-atblp sigmas atbl)))
+           (equal (logic.formula-list-atblp (logic.substitute-each-sigma-into-formula f sigmas) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.substitute-each-sigma-into-formula))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/substitute-term.lisp acl2-6.3/books/milawa/ACL2/logic/substitute-term.lisp
--- acl2-6.2/books/milawa/ACL2/logic/substitute-term.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/substitute-term.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,485 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (logic.sigmap x)
+;;
+;; A sigma is a mapping from variables to term structures.  Normally these are
+;; called "substitution lists", but we think sigmas is a better name since,
+;; e.g., "sigma list" seems more clear than "substitution list list", etc.
+
+(defmap :map (logic.sigmap x)
+        :key (logic.variablep x)
+        :val (logic.termp x)
+        :key-list (logic.variable-listp x)
+        :val-list (logic.term-listp x)
+        :val-of-nil nil)
+
+;; BOZO consider adding something like this to defmap
+(defthm forcing-logic.sigmap-of-pair-lists
+  (implies (and (force (logic.variable-listp x))
+                (force (logic.term-listp y))
+                (force (equal (len x) (len y))))
+           (equal (logic.sigmap (pair-lists x y))
+                  t))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(deflist logic.sigma-listp (x)
+  (logic.sigmap x)
+  :elementp-of-nil t)
+
+;; BOZO consider adding something like this to deflist
+(defthm logic.sigmap-of-second-when-logic.sigma-listp
+  (implies (logic.sigma-listp x)
+           (equal (logic.sigmap (second x))
+                  t)))
+
+(defthm forcing-logic.sigma-listp-of-revappend-onto-each
+  (implies (force (and (logic.sigmap a)
+                       (logic.sigma-listp x)
+                       (true-list-listp x)))
+           (equal (logic.sigma-listp (revappend-onto-each a x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(deflist logic.sigma-list-listp (x)
+  (logic.sigma-listp x)
+  :elementp-of-nil t)
+
+;; BOZO consider adding something like this to deflist
+(defthm logic.sigma-listp-of-second-when-logic.sigma-list-listp
+  (implies (logic.sigma-list-listp x)
+           (equal (logic.sigma-listp (second x))
+                  t)))
+
+(defthm forcing-logic.sigma-listp-of-simple-flatten
+  (implies (force (logic.sigma-list-listp x))
+           (equal (logic.sigma-listp (simple-flatten x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defmap :map (logic.sigma-atblp x atbl)
+        :key (logic.variablep x)
+        :val (logic.term-atblp x atbl)
+        :key-list (logic.variable-listp x)
+        :val-list (logic.term-list-atblp x atbl)
+        :guard (and (logic.sigmap x)
+                    (logic.arity-tablep atbl))
+        :val-of-nil nil)
+
+;; BOZO consider adding something like this to defmap
+(defthm forcing-logic.sigma-atblp-of-pair-lists
+  (implies (and (force (logic.variable-listp x))
+                (force (logic.term-list-atblp y atbl))
+                (force (equal (len x) (len y))))
+           (equal (logic.sigma-atblp (pair-lists x y) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+
+
+(deflist logic.sigma-list-atblp (x atbl)
+  (logic.sigma-atblp x atbl)
+  :elementp-of-nil t
+  :guard (and (logic.sigma-listp x)
+              (logic.arity-tablep atbl)))
+
+;; BOZO consider adding something like this to deflist
+(defthm logic.sigma-atblp-of-second-when-logic.sigma-list-atblp
+  (implies (logic.sigma-list-atblp x atbl)
+           (equal (logic.sigma-atblp (second x) atbl)
+                  t)))
+
+(defthm forcing-logic.sigma-list-atblp-of-revappend-onto-each
+  (implies (force (and (logic.sigma-atblp a atbl)
+                       (logic.sigma-list-atblp x atbl)
+                       (true-list-listp x)))
+           (equal (logic.sigma-list-atblp (revappend-onto-each a x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(deflist logic.sigma-list-list-atblp (x atbl)
+  (logic.sigma-list-atblp x atbl)
+  :elementp-of-nil t
+  :guard (and (logic.sigma-list-listp x)
+              (logic.arity-tablep atbl)))
+
+
+
+
+
+
+(defund logic.flag-substitute (flag x sigma)
+  ;; We walk through the term x, "simultaneously" replacing all occurrences of
+  ;; all variables bound by the sigma with their replacements, and leaving the
+  ;; rest of the term unchanged.
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (logic.sigmap sigma))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.variablep x)
+             (if (lookup x sigma)
+                 (cdr (lookup x sigma))
+               x))
+            ((logic.constantp x)
+             x)
+            ((logic.functionp x)
+             (let ((fn   (logic.function-name x))
+                   (args (logic.function-args x)))
+               (logic.function fn (logic.flag-substitute 'list args sigma))))
+            ((logic.lambdap x)
+             (let ((formals (logic.lambda-formals x))
+                   (body    (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               (logic.lambda formals body (logic.flag-substitute 'list actuals sigma))))
+            (t nil))
+    (if (consp x)
+        (cons (logic.flag-substitute 'term (car x) sigma)
+              (logic.flag-substitute 'list (cdr x) sigma))
+     nil)))
+
+(definlined logic.substitute (x sigma)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.sigmap sigma))
+                  :verify-guards nil))
+  (logic.flag-substitute 'term x sigma))
+
+(definlined logic.substitute-list (x sigma)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.sigmap sigma))
+                  :verify-guards nil))
+  (logic.flag-substitute 'list x sigma))
+
+(defthmd definition-of-logic.substitute
+  (equal (logic.substitute x sigma)
+         (cond ((logic.variablep x)
+                (if (lookup x sigma)
+                    (cdr (lookup x sigma))
+                  x))
+               ((logic.constantp x)
+                x)
+               ((logic.functionp x)
+                (let ((fn   (logic.function-name x))
+                      (args (logic.function-args x)))
+                  (logic.function fn (logic.substitute-list args sigma))))
+               ((logic.lambdap x)
+                (let ((formals (logic.lambda-formals x))
+                      (body    (logic.lambda-body x))
+                      (actuals (logic.lambda-actuals x)))
+                  (logic.lambda formals body (logic.substitute-list actuals sigma))))
+               (t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.substitute
+                                    logic.substitute-list
+                                    logic.flag-substitute))))
+
+(defthmd definition-of-logic.substitute-list
+  (equal (logic.substitute-list x sigma)
+         (if (consp x)
+             (cons (logic.substitute (car x) sigma)
+                   (logic.substitute-list (cdr x) sigma))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.substitute
+                                    logic.substitute-list
+                                    logic.flag-substitute))))
+
+(defthm logic.flag-substitute-of-term
+  (equal (logic.flag-substitute 'term x sigma)
+         (logic.substitute x sigma))
+  :hints(("Goal" :in-theory (enable logic.substitute))))
+
+(defthm logic.flag-substitute-of-term-list
+  (equal (logic.flag-substitute 'list x sigma)
+         (logic.substitute-list x sigma))
+  :hints(("Goal" :in-theory (enable logic.substitute-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.substitute))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.substitute-list))))
+
+
+
+(defthm logic.substitute-when-malformed-cheap
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (logic.substitute x sigma)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm logic.substitute-list-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.substitute-list x sigma)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute-list))))
+
+(defthm logic.substitute-list-of-cons
+  (equal (logic.substitute-list (cons a x) sigma)
+         (cons (logic.substitute a sigma)
+               (logic.substitute-list x sigma)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute-list))))
+
+(defprojection :list (logic.substitute-list x sigma)
+               :element (logic.substitute x sigma)
+               :nil-preservingp t
+               :already-definedp t)
+
+
+
+(defthm logic.substitute-when-logic.constantp
+  ;; BOZO why is this not cheap while the function and lambda cases are cheap?
+  (implies (logic.constantp x)
+           (equal (logic.substitute x sigma)
+                  x))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm logic.substitute-when-logic.variablep
+  ;; BOZO why is this not cheap while the function and lambda cases are cheap?
+  (implies (logic.variablep x)
+           (equal (logic.substitute x sigma)
+                  (if (lookup x sigma)
+                      (cdr (lookup x sigma))
+                    x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm logic.substitute-when-logic.functionp-cheap
+  (implies (logic.functionp x)
+           (equal (logic.substitute x sigma)
+                  (logic.function (logic.function-name x)
+                                  (logic.substitute-list (logic.function-args x) sigma))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm logic.substitute-when-logic.lambdap-cheap
+  (implies (logic.lambdap x)
+           (equal (logic.substitute x sigma)
+                  (logic.lambda (logic.lambda-formals x)
+                                (logic.lambda-body x)
+                                (logic.substitute-list (logic.lambda-actuals x) sigma))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm forcing-logic.substitute-of-logic.function
+  (implies (force (logic.function-namep fn))
+           (equal (logic.substitute (logic.function fn args) sigma)
+                  (logic.function fn (logic.substitute-list args sigma)))))
+
+(defthm forcing-logic.function-name-of-logic.substitute
+  (implies (force (logic.functionp x))
+           (equal (logic.function-name (logic.substitute x sigma))
+                  (logic.function-name x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm forcing-logic.function-args-of-logic.substitute
+  (implies (force (logic.functionp x))
+           (equal (logic.function-args (logic.substitute x sigma))
+                  (logic.substitute-list (logic.function-args x) sigma)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm forcing-logic.substitute-of-logic.lambda
+  (equal (logic.substitute (logic.lambda formals body actuals) sigma)
+         (logic.lambda formals body (logic.substitute-list actuals sigma)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm forcing-logic.lambda-formals-of-logic.substitute
+  (implies (force (logic.lambdap x))
+           (equal (logic.lambda-formals (logic.substitute x sigma))
+                  (logic.lambda-formals x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm forcing-logic.lambda-body-of-logic.substitute
+  (implies (force (logic.lambdap x))
+           (equal (logic.lambda-body (logic.substitute x sigma))
+                  (logic.lambda-body x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm forcing-logic.lambda-actuals-of-logic.substitute
+  (implies (force (logic.lambdap x))
+           (equal (logic.lambda-actuals (logic.substitute x sigma))
+                  (logic.substitute-list (logic.lambda-actuals x) sigma)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+
+
+(defthm forcing-logic.substitute-under-iff
+  (implies (and (force (logic.termp term))
+                (force (logic.sigmap sigma)))
+           (iff (logic.substitute term sigma)
+                t))
+  :hints(("Goal"
+          :in-theory (e/d (definition-of-logic.substitute)
+                          (logic.termp-of-cdr-of-lookup-when-logic.sigmap))
+          :use ((:instance logic.termp-of-cdr-of-lookup-when-logic.sigmap (x term))))))
+
+
+
+(defthms-flag
+  :thms ((term forcing-logic.termp-of-logic.substitute
+               (implies (and (force (logic.termp x))
+                             (force (logic.sigmap sigma)))
+                        (equal (logic.termp (logic.substitute x sigma))
+                               t)))
+         (t forcing-logic.term-listp-of-logic.substitute-list
+            (implies (and (force (logic.term-listp x))
+                          (force (logic.sigmap sigma)))
+                     (equal (logic.term-listp (logic.substitute-list x sigma))
+                            t))))
+  :hints(("Goal" :induct (logic.term-induction flag x))))
+
+(defthms-flag
+  :thms ((term forcing-logic.term-atblp-of-logic.substitute
+               (implies (and (force (logic.term-atblp x atbl))
+                             (force (logic.sigma-atblp sigma atbl)))
+                        (equal (logic.term-atblp (logic.substitute x sigma) atbl)
+                               t)))
+         (t forcing-logic.term-list-atblp-of-logic.substitute-list
+            (implies (and (force (logic.term-list-atblp x atbl))
+                          (force (logic.sigma-atblp sigma atbl)))
+                     (equal (logic.term-list-atblp (logic.substitute-list x sigma) atbl)
+                            t))))
+  :hints (("Goal" :induct (logic.term-induction flag x))))
+
+(verify-guards logic.flag-substitute)
+(verify-guards logic.substitute)
+(verify-guards logic.substitute-list)
+
+(defthms-flag
+  :shared-hyp (not (consp sigma))
+  :thms ((term forcing-logic.substitute-of-empty-sigma
+               (implies (force (logic.termp x))
+                        (equal (logic.substitute x sigma)
+                               x)))
+         (t forcing-logic.substitute-list-of-empty-sigma
+            (implies (force (logic.term-listp x))
+                     (equal (logic.substitute-list x sigma)
+                            (list-fix x)))))
+  :hints (("Goal"
+           :induct (logic.term-induction flag x))))
+
+(defthms-flag
+  ;; If some sigma contains all of the variables mentioned in x, and some sigma'
+  ;; is a supermap of sigma, then we obtain exactly the same result when we
+  ;; instantiate x with sigma or sigma'.
+  :shared-hyp (submapp sigma1 sigma2)
+  :thms ((term equal-of-logic.substitutes-of-expansion
+               (implies (subsetp (logic.term-vars x) (domain sigma1))
+                        (equal (equal (logic.substitute x sigma1)
+                                      (logic.substitute x sigma2))
+                               t)))
+         (t equal-of-logic.substitute-lists-of-expansion
+            (implies (subsetp (logic.term-list-vars x) (domain sigma1))
+                     (equal (equal (logic.substitute-list x sigma1)
+                                   (logic.substitute-list x sigma2))
+                            t))))
+  :hints (("Goal" :induct (logic.term-induction flag x))))
+
+(defthms-flag
+  ;; Suppose x is a term and sigma is [v1 <- t1, ..., vn <- tn].  If the
+  ;; free variables of x are a subset of these v's, then
+  ;;     (x/sigma)/sigma2 = x/[v1<-t1/sigma2, ..., vn<-tn/sigma2]
+  :thms ((term logic.substitute-of-logic.substitute-when-all-bound
+               (implies (subsetp (logic.term-vars x) (domain sig1))
+                        (equal (logic.substitute (logic.substitute x sig1) sig2)
+                               (logic.substitute x (pair-lists (domain sig1) (logic.substitute-list (range sig1) sig2))))))
+         (t logic.substitute-list-of-logic.substitute-list-when-all-bound
+            (implies (subsetp (logic.term-list-vars x) (domain sig1))
+                     (equal (logic.substitute-list (logic.substitute-list x sig1) sig2)
+                            (logic.substitute-list x (pair-lists (domain sig1) (logic.substitute-list (range sig1) sig2)))))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-logic.substitute)
+           :induct (logic.term-induction flag x))))
+
+
+(encapsulate
+ ()
+ ;; Suppose vars is a list of unique variables, i.e., [v1, ..., vn].
+ ;; Then, (v1 ... vn)/[v1<-t1, ..., vn<-tn] = (t1 ... tn).
+ (defthmd lemma-for-logic.substitute-list-of-vars-with-pair-lists
+   (implies (and (equal (len vars) (len vals))
+                 (logic.variable-listp vars)
+                 (uniquep vars))
+            (prefixp (logic.substitute-list vars (pair-lists vars vals))
+                     vals))
+   :hints(("Goal"
+           :use ((:instance prefixp-badguy-index-property
+                            (x (logic.substitute-list vars (pair-lists vars vals)))
+                            (y vals))))))
+
+ (defthm logic.substitute-list-of-vars-with-pair-lists
+   (implies (and (equal (len vars) (len vals))
+                 (logic.variable-listp vars)
+                 (uniquep vars))
+            (equal (logic.substitute-list vars (pair-lists vars vals))
+                   (list-fix vals)))
+   :hints(("Goal" :in-theory (enable lemma-for-logic.substitute-list-of-vars-with-pair-lists)))))
+
+
+
+
+(defprojection :list (logic.substitute-list-list x sigma)
+               :element (logic.substitute-list x sigma)
+               :guard (and (logic.term-list-listp x)
+                           (logic.sigmap sigma))
+               :nil-preservingp t)
+
+(defthm strip-lens-of-logic.substitute-list-list
+  (equal (strip-lens (logic.substitute-list-list x sigma))
+         (strip-lens x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthm logic.substitute-list-of-repeat
+  (equal (logic.substitute-list (repeat x n) sigma)
+         (repeat (logic.substitute x sigma) n))
+  :hints(("Goal" :in-theory (enable repeat))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/subtermp.lisp acl2-6.3/books/milawa/ACL2/logic/subtermp.lisp
--- acl2-6.2/books/milawa/ACL2/logic/subtermp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/subtermp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,350 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund logic.flag-subtermp (flag x y)
+  ;; X is a subterm of y if it occurs somewhere inside of y.  Every term is a
+  ;; subterm of itself.  We treat lambda bodies as "opaque" and do not look
+  ;; inside of them, so (+ 1 2) is not a subterm of ((lambda (x) (+ x (+ 1 2)))
+  ;; 3), because it only occurs inside the body of a lambda.  We make no effort
+  ;; to detect alpha-equivalent lambdas.
+  (declare (xargs :guard (if (equal flag 'term)
+                             (and (logic.termp x)
+                                  (logic.termp y))
+                           (and (equal flag 'list)
+                                (logic.termp x)
+                                (logic.term-listp y)))
+                  :measure (rank y)))
+  (if (equal flag 'term)
+      ;; Check if x is a subterm of y.
+      (cond ((logic.variablep y)
+             (equal x y))
+            ((logic.constantp y)
+             (equal x y))
+            ((logic.functionp y)
+             (or (equal x y)
+                 (logic.flag-subtermp 'list x (logic.function-args y))))
+            ((logic.lambdap y)
+             (or (equal x y)
+                 (logic.flag-subtermp 'list x (logic.lambda-actuals y))))
+            (t
+             ;; Sneaky hack for hypless reflexivity
+             (equal x y)))
+    ;; Check if x is a subterm of any member of y.
+    (if (consp y)
+        (or (logic.flag-subtermp 'term x (car y))
+            (logic.flag-subtermp 'list x (cdr y)))
+      nil)))
+
+(definlined logic.subtermp (x y)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y))))
+  (logic.flag-subtermp 'term x y))
+
+(definlined logic.subterm-of-somep (x y)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.term-listp y))))
+  (logic.flag-subtermp 'list x y))
+
+(defthmd definition-of-logic.subtermp
+  (equal (logic.subtermp x y)
+         (cond ((logic.variablep y)
+                (equal x y))
+               ((logic.constantp y)
+                (equal x y))
+               ((logic.functionp y)
+                (or (equal x y)
+                    (logic.subterm-of-somep x (logic.function-args y))))
+               ((logic.lambdap y)
+                (or (equal x y)
+                    (logic.subterm-of-somep x (logic.lambda-actuals y))))
+               (t
+                (equal x y))))
+  :rule-classes :rewrite
+  :hints(("Goal" :in-theory (enable logic.subtermp
+                                    logic.subterm-of-somep
+                                    logic.flag-subtermp))))
+
+(defthmd definition-of-logic.subterm-of-somep
+  (equal (logic.subterm-of-somep x y)
+         (if (consp y)
+             (or (logic.subtermp x (car y))
+                 (logic.subterm-of-somep x (cdr y)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.subtermp
+                                    logic.subterm-of-somep
+                                    logic.flag-subtermp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.subtermp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.subterm-of-somep))))
+
+(defthm logic.subterm-of-somep-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.subterm-of-somep a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.subterm-of-somep))))
+
+(defthm logic.subterm-of-somep-of-cons
+  (equal (logic.subterm-of-somep a (cons b y))
+         (or (logic.subtermp a b)
+             (logic.subterm-of-somep a y)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.subterm-of-somep))))
+
+
+
+(defthms-flag
+  :thms ((term booleanp-of-logic.subtermp
+               (equal (booleanp (logic.subtermp x y))
+                      t))
+         (t booleanp-of-logic.subterm-of-somep
+            (equal (booleanp (logic.subterm-of-somep x y))
+                   t)))
+  :hints (("Goal"
+           :induct (logic.term-induction flag y)
+           :in-theory (enable definition-of-logic.subtermp))))
+
+(defthm logic.subterm-of-somep-when-memberp-is-logic.subtermp
+  (implies (and (logic.subtermp a b)
+                (memberp b x))
+           (equal (logic.subterm-of-somep a x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.subterm-of-somep-when-memberp-is-logic.subtermp-alt
+  (implies (and (memberp b x)
+                (logic.subtermp a b))
+           (equal (logic.subterm-of-somep a x)
+                  t)))
+
+(defthm logic.subtermp-is-reflexive
+  (equal (logic.subtermp x x)
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-logic.subtermp))))
+
+
+
+(defthms-flag
+  :thms ((term logic.subtermp-is-transitive
+               (implies (and (logic.subtermp x y)
+                             (logic.subtermp y z))
+                        (equal (logic.subtermp x z)
+                               t)))
+         (t logic.subterm-of-somep-when-logic.subtermp-and-logic.subterm-of-somep
+            (implies (and (logic.subtermp x y)
+                          (logic.subterm-of-somep y z))
+                     (equal (logic.subterm-of-somep x z)
+                            t))))
+  :hints (("Goal"
+           :induct (logic.term-induction flag z)
+           :in-theory (enable definition-of-logic.subtermp))))
+
+(defthm logic.subtermp-is-transitive-two
+  (implies (and (logic.subtermp y z)
+                (logic.subtermp x y))
+           (equal (logic.subtermp x z)
+                  t)))
+
+(defthm logic.subterm-of-somep-when-logic.subtermp-and-logic.subterm-of-somep-alt
+  (implies (and (logic.subterm-of-somep y z)
+                (logic.subtermp x y))
+           (equal (logic.subterm-of-somep x z)
+                  t)))
+
+
+;; The easiest way I could think of showing that logic.subtermp is antisymmetric was
+;; to consider the size of terms.
+
+(defthms-flag
+  :thms ((term rank-when-logic.subtermp-weak
+               (implies (logic.subtermp x y)
+                        (equal (< (rank y) (rank x))
+                               nil)))
+         (t rank-when-logic.subterm-of-somep
+            (implies (logic.subterm-of-somep x y)
+                     (equal (< (rank x) (rank y))
+                            t))))
+  :hints (("Goal"
+           :induct (logic.term-induction flag y)
+           :in-theory (enable definition-of-logic.subtermp))))
+
+(defthm rank-when-logic.subterm-of-somep-weak
+  (implies (logic.subterm-of-somep x y)
+           (equal (< (rank y) (rank x))
+                  nil)))
+
+
+
+(defthm rank-when-logic.subtermp
+  (implies (logic.subtermp x y)
+           (equal (< (rank x) (rank y))
+                  (not (equal x y))))
+  :hints(("Goal"
+          :in-theory (enable definition-of-logic.subtermp))
+         ("Subgoal 3"  ;; Yuck!
+          :in-theory (disable rank-when-logic.subterm-of-somep)
+          :use ((:instance rank-when-logic.subterm-of-somep
+                           (x x)
+                           (y (logic.function-args y)))))
+         ("Subgoal 1"  ;; Yuck!
+          :in-theory (disable rank-when-logic.subterm-of-somep)
+          :use ((:instance rank-when-logic.subterm-of-somep
+                           (x x)
+                           (y (logic.lambda-actuals y)))))))
+
+(defthm logic.subtermp-is-weakly-antisymmetric
+  (implies (logic.subtermp x y)
+           (equal (logic.subtermp y x)
+                  (equal x y)))
+  :hints(("Goal"
+          :in-theory (disable rank-when-logic.subtermp)
+          :use ((:instance rank-when-logic.subtermp)))))
+
+(defthm logic.subtermp-of-logic.functionp
+  (implies (and (force (logic.function-namep fn))
+                (force (logic.term-listp args))
+                (force (true-listp args)))
+           (equal (logic.subtermp x (logic.function fn args))
+                  (or (equal x (logic.function fn args))
+                      (logic.subterm-of-somep x args))))
+  :hints(("Goal" :in-theory (enable definition-of-logic.subtermp))))
+
+(defthm logic.subtermp-of-logic.lambda
+  (equal (logic.subtermp x (logic.lambda xs b ts))
+         (or (equal x (logic.lambda xs b ts))
+             (logic.subterm-of-somep x ts)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.subtermp))))
+
+
+
+
+
+(defthm logic.subterm-of-somep-of-list-fix
+  (equal (logic.subterm-of-somep a (list-fix x))
+         (logic.subterm-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.subterm-of-somep-of-app
+  (equal (logic.subterm-of-somep a (app x y))
+         (or (logic.subterm-of-somep a x)
+             (logic.subterm-of-somep a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.subterm-of-somep-of-rev
+  (equal (logic.subterm-of-somep a (rev x))
+         (logic.subterm-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+(deflist logic.all-subterm-of-somep (x others)
+  (logic.subterm-of-somep x others)
+  :guard (and (logic.term-listp x)
+              (logic.term-listp others)))
+
+(defthm logic.all-subterm-of-somep-when-not-consp-two
+  (implies (not (consp y))
+           (equal (logic.all-subterm-of-somep x y)
+                  (not (consp x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-subterm-of-somep-of-cons-two
+  (implies (logic.all-subterm-of-somep x y)
+           (equal (logic.all-subterm-of-somep x (cons a y))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-subterm-of-somep-of-list-fix-two
+  (equal (logic.all-subterm-of-somep x (list-fix y))
+         (logic.all-subterm-of-somep x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-subterm-of-somep-of-app-two
+  (implies (logic.all-subterm-of-somep x y)
+           (equal (logic.all-subterm-of-somep x (app y z))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-subterm-of-somep-of-app-two-alt
+  (implies (logic.all-subterm-of-somep x y)
+           (equal (logic.all-subterm-of-somep x (app z y))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-subterm-of-somep-of-rev-two
+  (equal (logic.all-subterm-of-somep x (rev y))
+         (logic.all-subterm-of-somep x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-subterm-of-somep-is-reflexive
+  (equal (logic.all-subterm-of-somep x x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.subterm-of-somep-when-subterm-and-logic.all-subterm-of-somep
+  (implies (and (logic.subterm-of-somep a x)
+                (logic.all-subterm-of-somep x y))
+           (equal (logic.subterm-of-somep a y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.subterm-of-somep-when-subterm-and-logic.all-subterm-of-somep-alt
+  (implies (and (logic.all-subterm-of-somep x y)
+                (logic.subterm-of-somep a x))
+           (equal (logic.subterm-of-somep a y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-subterm-of-somep-is-transitive
+  (implies (and (logic.all-subterm-of-somep x y)
+                (logic.all-subterm-of-somep y z))
+           (equal (logic.all-subterm-of-somep x z)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-subterm-of-somep-is-transitive-alt
+  (implies (and (logic.all-subterm-of-somep y z)
+                (logic.all-subterm-of-somep x y))
+           (equal (logic.all-subterm-of-somep x z)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/term-formula.lisp acl2-6.3/books/milawa/ACL2/logic/term-formula.lisp
--- acl2-6.2/books/milawa/ACL2/logic/term-formula.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/term-formula.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,167 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-formula")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; We sometimes think of a term, A, as if it were the formula A != nil.  We now
+;; provide some functions to transform terms into these formulas.
+
+
+(definlined logic.term-formula (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.pnot (logic.pequal x ''nil)))
+
+(defthm forcing-logic.formulap-of-logic.term-formula
+  (implies (force (logic.termp x))
+           (equal (logic.formulap (logic.term-formula x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.term-formula))))
+
+(defthm forcing-logic.formula-atblp-of-logic.term-formula
+  (implies (force (logic.term-atblp x atbl))
+           (equal (logic.formula-atblp (logic.term-formula x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.term-formula))))
+
+(defthm logic.substitute-formula-of-logic.term-formula
+  (equal (logic.substitute-formula (logic.term-formula x) sigma)
+         (logic.term-formula (logic.substitute x sigma)))
+  :hints(("Goal" :in-theory (enable logic.term-formula))))
+
+
+
+
+(defprojection :list (logic.term-list-formulas x)
+               :element (logic.term-formula x)
+               :guard (logic.term-listp x))
+
+(defthmd redefinition-of-logic.term-list-formulas
+  (equal (logic.term-list-formulas x)
+         (logic.negate-formulas (logic.pequal-list x (repeat ''nil (len x)))))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable logic.term-formula))))
+
+(defthm forcing-logic.formula-listp-of-logic.term-list-formulas
+  (implies (force (logic.term-listp x))
+           (equal (logic.formula-listp (logic.term-list-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-logic.term-list-formulas
+  (implies (force (logic.term-list-atblp x atbl))
+           (equal (logic.formula-list-atblp (logic.term-list-formulas x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-logic.term-formula-and-logic.term-list-formulas
+  (equal (memberp (logic.term-formula a) (logic.term-list-formulas x))
+         (memberp a x))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable logic.term-formula))))
+
+(defthm memberp-of-logic.pnot-of-logic.pequal-nil-in-logic.term-list-formulas
+  (equal (memberp (logic.pnot (logic.pequal a ''nil)) (logic.term-list-formulas x))
+         (memberp a x))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable logic.term-formula))))
+
+(defthm subsetp-of-logic.term-list-formulas-and-logic.term-list-formulas
+  (equal (subsetp (logic.term-list-formulas x) (logic.term-list-formulas y))
+         (subsetp x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.substitute-formula-list-of-logic.term-list-formulas
+  (equal (logic.substitute-formula-list (logic.term-list-formulas x) sigma)
+         (logic.term-list-formulas (logic.substitute-list x sigma)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defprojection :list (logic.term-list-list-formulas x)
+               :element (logic.term-list-formulas x)
+               :guard (logic.term-list-listp x))
+
+(defthm forcing-logic.formula-list-listp-of-logic.term-list-list-formulas
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.formula-list-listp (logic.term-list-list-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-list-atblp-of-logic.term-list-list-formulas
+  (implies (force (logic.term-list-list-atblp x atbl))
+           (equal (logic.formula-list-list-atblp (logic.term-list-list-formulas x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-logic.term-list-list-formulas
+  (equal (cons-listp (logic.term-list-list-formulas x))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm supserset-of-somep-of-logic.term-list-formulas-and-logic.term-list-list-formulas
+  (equal (superset-of-somep (logic.term-list-formulas a) (logic.term-list-list-formulas x))
+         (superset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-logic.term-list-list-formulas
+  (equal (all-superset-of-somep (logic.term-list-list-formulas x) (logic.term-list-list-formulas y))
+         (all-superset-of-somep x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-list-formulas-of-list-list-fix
+  (equal (logic.term-list-list-formulas (list-list-fix x))
+         (logic.term-list-list-formulas x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.substitute-formula-list-list-of-logic.term-list-list-formulas
+  (equal (logic.substitute-formula-list-list (logic.term-list-list-formulas x) sigma)
+         (logic.term-list-list-formulas (logic.substitute-list-list x sigma)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-list-formulas-of-listify-each
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-list-list-formulas (listify-each x))
+                  (listify-each (logic.negate-formulas (logic.pequal-list x (repeat ''nil (len x)))))))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable logic.term-formula))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/term-order.lisp acl2-6.3/books/milawa/ACL2/logic/term-order.lisp
--- acl2-6.2/books/milawa/ACL2/logic/term-order.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/term-order.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,909 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (logic.term-< x y) allows us to compare the "sizes" of terms.  This function
+;; is inspired by ACL2's term-order, although the particulars of the order are
+;; somewhat different.  We order the terms according to three criteria:
+;;
+;; 1. Our first consideration is the number of variable occurrences in a term.
+;; If x has more variable occurrences than y, we say that x is bigger than y.
+;;
+;; 2. If x and y have the same number of variables, our next consideration is
+;; the number of function name occurrences.  If x has more function name
+;; occurrences than y, we say that x is bigger than y.
+;;
+;; 3. If x and y have the same number of variable and functions symbol
+;; occurrences, we count sizes of constants within the terms, where sizes are
+;; given as follows:
+;;
+;;   - The size of a natural number is its value
+;;   - The size of a symbol is 1
+;;   - The size of a cons is one more than the sizes of its car and cdr
+;;
+;; 4. As a last resort, if x and y have the same sizes of constants, we order
+;; them "arbitrarily" according to <<, which is a total order on Milawa
+;; objects.
+
+(defund logic.fast-constant-size (x acc)
+  (declare (xargs :guard (natp acc)
+                  :verify-guards nil
+                  :export (cond ((symbolp x)
+                                 (+ 1 acc))
+                                ((natp x)
+                                 (+ x acc))
+                                (t
+                                 (logic.fast-constant-size (cdr x)
+                                                           (logic.fast-constant-size (car x) (+ 1 acc)))))))
+  (cond ((symbolp x)
+         (+ 1 acc))
+        ((natp x)
+         (+ x acc))
+        ((not (consp x))
+         ;; HACK: Special case for ACL2 compatibility.  We should not need
+         ;; this case in Milawa.
+         (nfix acc))
+        (t
+         (logic.fast-constant-size (cdr x)
+                                   (logic.fast-constant-size (car x) (+ 1 acc))))))
+
+(defthm forcing-natp-of-logic.fast-constant-size
+  (implies (force (natp acc))
+           (equal (natp (logic.fast-constant-size x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.fast-constant-size))))
+
+(verify-guards logic.fast-constant-size)
+
+(definlined logic.constant-size (x)
+  (declare (xargs :guard t))
+  (logic.fast-constant-size x 0))
+
+(defund logic.slow-constant-size (x)
+  (declare (xargs :guard t
+                  :export (cond ((symbolp x)
+                                 1)
+                                ((natp x)
+                                 x)
+                                (t
+                                 (+ 1 (+ (logic.slow-constant-size (car x))
+                                         (logic.slow-constant-size (cdr x))))))))
+  (cond ((symbolp x)
+         1)
+        ((natp x)
+         x)
+        ((not (consp x))
+         ;; HACK: Special case for ACL2 compatibility.  We should not need
+         ;; this case in Milawa.
+         0)
+        (t
+         (+ 1 (+ (logic.slow-constant-size (car x))
+                 (logic.slow-constant-size (cdr x)))))))
+
+(defthm natp-of-logic.slow-constant-size
+  (equal (natp (logic.slow-constant-size x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.slow-constant-size))))
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthmd lemma-for-definition-of-logic.constant-size
+   (implies (force (natp acc))
+            (equal (logic.fast-constant-size x acc)
+                   (+ (logic.slow-constant-size x) acc)))
+   :hints(("Goal"
+           :in-theory (enable logic.fast-constant-size logic.slow-constant-size)
+           :induct (logic.fast-constant-size x acc)))))
+
+(defthmd definition-of-logic.constant-size
+  (equal (logic.constant-size x)
+         (cond ((symbolp x) 1)
+               ((natp x) x)
+               ((not (consp x))
+                ;; HACK: Special case for ACL2 compatibility.  We should not need
+                ;; this case in Milawa.
+                0)
+               (t
+                (+ 1 (+ (logic.constant-size (car x))
+                        (logic.constant-size (cdr x)))))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.constant-size
+                                    logic.slow-constant-size
+                                    lemma-for-definition-of-logic.constant-size))))
+
+(defthm forcing-fast-constant-size-removal
+  (implies (force (natp acc))
+           (equal (logic.fast-constant-size x acc)
+                  (+ (logic.constant-size x) acc)))
+  :hints(("Goal" :in-theory (enable logic.constant-size
+                                    lemma-for-definition-of-logic.constant-size))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.constant-size))))
+
+(defthm natp-of-logic.constant-size
+  (equal (natp (logic.constant-size x))
+         t)
+  :hints(("Goal"
+          :in-theory (enable definition-of-logic.constant-size)
+          :induct (car-cdr-induction x))))
+
+
+
+
+(defund logic.flag-count-variable-occurrences (flag x acc)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (logic.term-listp x))
+                              (natp acc))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) acc)
+            ((logic.variablep x) (+ 1 acc))
+            ((logic.functionp x)
+             (logic.flag-count-variable-occurrences 'list (logic.function-args x) acc))
+            ((logic.lambdap x)
+             (logic.flag-count-variable-occurrences 'list (logic.lambda-actuals x) acc))
+            (t acc))
+    (if (consp x)
+        (logic.flag-count-variable-occurrences 'list (cdr x)
+                                               (logic.flag-count-variable-occurrences 'term (car x) acc))
+      acc)))
+
+(defthm forcing-natp-of-logic.flag-count-variable-occurrences
+  (implies (force (natp acc))
+           (equal (natp (logic.flag-count-variable-occurrences flag x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.flag-count-variable-occurrences))))
+
+(verify-guards logic.flag-count-variable-occurrences)
+
+(definlined logic.count-variable-occurrences (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.flag-count-variable-occurrences 'term x 0))
+
+(definlined logic.count-variable-occurrences-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (logic.flag-count-variable-occurrences 'list x 0))
+
+(defund logic.slow-count-variable-occurrences (flag x)
+  (declare (xargs :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) 0)
+            ((logic.variablep x) 1)
+            ((logic.functionp x)
+             (logic.slow-count-variable-occurrences 'list (logic.function-args x)))
+            ((logic.lambdap x)
+             (logic.slow-count-variable-occurrences 'list (logic.lambda-actuals x)))
+            (t 0))
+    (if (consp x)
+        (+ (logic.slow-count-variable-occurrences 'term (car x))
+           (logic.slow-count-variable-occurrences 'list (cdr x)))
+      0)))
+
+(defthmd lemma-logic.flag-count-variable-occurrences-removal
+  (implies (force (natp acc))
+           (equal (logic.flag-count-variable-occurrences flag x acc)
+                  (+ (logic.slow-count-variable-occurrences flag x) acc)))
+  :hints(("Goal"
+          :in-theory (enable logic.flag-count-variable-occurrences
+                             logic.slow-count-variable-occurrences)
+          :induct (logic.flag-count-variable-occurrences flag x acc))))
+
+(defthmd definition-of-logic.count-variable-occurrences
+  (equal (logic.count-variable-occurrences x)
+         (cond ((logic.constantp x) 0)
+               ((logic.variablep x) 1)
+               ((logic.functionp x)
+                (logic.count-variable-occurrences-list (logic.function-args x)))
+               ((logic.lambdap x)
+                (logic.count-variable-occurrences-list (logic.lambda-actuals x)))
+               (t 0)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.count-variable-occurrences
+                                    logic.count-variable-occurrences-list
+                                    logic.slow-count-variable-occurrences
+                                    lemma-logic.flag-count-variable-occurrences-removal
+                                    ))))
+
+(defthmd definition-of-logic.count-variable-occurrences-list
+  (equal (logic.count-variable-occurrences-list x)
+         (if (consp x)
+             (+ (logic.count-variable-occurrences (car x))
+                (logic.count-variable-occurrences-list (cdr x)))
+           0))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.count-variable-occurrences
+                                    logic.count-variable-occurrences-list
+                                    logic.slow-count-variable-occurrences
+                                    lemma-logic.flag-count-variable-occurrences-removal
+                                    ))))
+
+(defthm logic.flag-count-variable-occurrences-removal
+  (implies (force (natp acc))
+           (equal (logic.flag-count-variable-occurrences flag x acc)
+                  (if (equal flag 'term)
+                      (+ (logic.count-variable-occurrences x) acc)
+                    (+ (logic.count-variable-occurrences-list x) acc))))
+  :hints(("Goal"
+          :in-theory (enable lemma-logic.flag-count-variable-occurrences-removal
+                             logic.count-variable-occurrences
+                             logic.count-variable-occurrences-list
+                             logic.slow-count-variable-occurrences))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.count-variable-occurrences))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.count-variable-occurrences-list))))
+
+
+(defthm logic.count-variables-occurrences-list-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.count-variable-occurrences-list x)
+                  0))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-variable-occurrences-list))))
+
+(defthm logic.count-variables-occurrences-list-of-cons
+  (equal (logic.count-variable-occurrences-list (cons a x))
+         (+ (logic.count-variable-occurrences a)
+            (logic.count-variable-occurrences-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-variable-occurrences-list))))
+
+(defthms-flag
+  :thms ((term natp-of-logic.count-variable-occurrences
+               (equal (natp (logic.count-variable-occurrences x))
+                      t))
+         (t natp-of-logic.count-variable-occurrences-list
+            (equal (natp (logic.count-variable-occurrences-list x))
+                   t)))
+  :hints (("Goal"
+           :induct (logic.term-induction flag x)
+           :in-theory (enable definition-of-logic.count-variable-occurrences))))
+
+(defthm logic.count-variable-occurrences-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (logic.count-variable-occurrences x)
+                  0))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-variable-occurrences))))
+
+(defthm logic.count-variable-occurrences-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (logic.count-variable-occurrences x)
+                  1))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-variable-occurrences))))
+
+
+
+
+
+(defund logic.flag-count-function-occurrences (flag x acc)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (logic.term-listp x))
+                              (natp acc))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) acc)
+            ((logic.variablep x) acc)
+            ((logic.functionp x)
+             (logic.flag-count-function-occurrences 'list (logic.function-args x) (+ 1 acc)))
+            ((logic.lambdap x)
+             (logic.flag-count-function-occurrences 'list (logic.lambda-actuals x) (+ 1 acc)))
+            (t acc))
+    (if (consp x)
+        (logic.flag-count-function-occurrences 'list (cdr x)
+         (logic.flag-count-function-occurrences 'term (car x) acc))
+      acc)))
+
+(defthm forcing-natp-of-logic.flag-count-function-occurrences
+  (implies (force (natp acc))
+           (equal (natp (logic.flag-count-function-occurrences flag x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.flag-count-function-occurrences))))
+
+(verify-guards logic.flag-count-function-occurrences)
+
+(definlined logic.count-function-occurrences (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.flag-count-function-occurrences 'term x 0))
+
+(definlined logic.count-function-occurrences-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (logic.flag-count-function-occurrences 'list x 0))
+
+(defund logic.slow-count-function-occurrences (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) 0)
+            ((logic.variablep x) 0)
+            ((logic.functionp x)
+             (+ 1 (logic.slow-count-function-occurrences 'list (logic.function-args x))))
+            ((logic.lambdap x)
+             (+ 1 (logic.slow-count-function-occurrences 'list (logic.lambda-actuals x))))
+            (t 0))
+    (if (consp x)
+        (+ (logic.slow-count-function-occurrences 'term (car x))
+           (logic.slow-count-function-occurrences 'list (cdr x)))
+      0)))
+
+(defthmd lemma-forcing-logic.flag-count-function-occurrences-removal
+  (implies (force (natp acc))
+           (equal (logic.flag-count-function-occurrences flag x acc)
+                  (+ (logic.slow-count-function-occurrences flag x) acc)))
+  :hints(("Goal"
+          :in-theory (enable logic.flag-count-function-occurrences
+                             logic.slow-count-function-occurrences)
+          :induct (logic.flag-count-function-occurrences flag x acc))))
+
+(defthmd definition-of-logic.count-function-occurrences
+  (equal (logic.count-function-occurrences x)
+         (cond ((logic.constantp x) 0)
+               ((logic.variablep x) 0)
+               ((logic.functionp x)
+                (+ 1 (logic.count-function-occurrences-list (logic.function-args x))))
+               ((logic.lambdap x)
+                (+ 1 (logic.count-function-occurrences-list (logic.lambda-actuals x))))
+               (t 0)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.count-function-occurrences
+                                    logic.count-function-occurrences-list
+                                    logic.slow-count-function-occurrences
+                                    lemma-forcing-logic.flag-count-function-occurrences-removal))))
+
+(defthmd definition-of-logic.count-function-occurrences-list
+  (equal (logic.count-function-occurrences-list x)
+         (if (consp x)
+             (+ (logic.count-function-occurrences (car x))
+                (logic.count-function-occurrences-list (cdr x)))
+           0))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.count-function-occurrences
+                                    logic.count-function-occurrences-list
+                                    logic.slow-count-function-occurrences
+                                    lemma-forcing-logic.flag-count-function-occurrences-removal))))
+
+(defthm logic.flag-count-function-occurrences-removal
+  (implies (force (natp acc))
+           (equal (logic.flag-count-function-occurrences flag x acc)
+                  (if (equal flag 'term)
+                      (+ (logic.count-function-occurrences x) acc)
+                    (+ (logic.count-function-occurrences-list x) acc))))
+  :hints(("Goal" :in-theory (enable lemma-forcing-logic.flag-count-function-occurrences-removal
+                                    logic.count-function-occurrences
+                                    logic.count-function-occurrences-list
+                                    logic.slow-count-function-occurrences
+                                    ))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.count-function-occurrences))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.count-function-occurrences-list))))
+
+(defthm logic.count-function-occurrences-list-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.count-function-occurrences-list x)
+                  0))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-function-occurrences-list))))
+
+(defthm logic.count-function-occurrences-list-of-cons
+  (equal (logic.count-function-occurrences-list (cons a x))
+         (+ (logic.count-function-occurrences a)
+            (logic.count-function-occurrences-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-function-occurrences-list))))
+
+(defthms-flag
+  :thms ((term natp-of-logic.count-function-occurrences
+               (equal (natp (logic.count-function-occurrences x))
+                      t))
+         (t natp-of-logic.count-function-occurrences-list
+            (equal (natp (logic.count-function-occurrences-list x))
+                   t)))
+  :hints (("Goal"
+           :induct (logic.term-induction flag x)
+           :in-theory (enable definition-of-logic.count-function-occurrences))))
+
+(defthm logic.count-function-occurrences-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (logic.count-function-occurrences x)
+                  0))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-function-occurrences))))
+
+(defthm logic.count-function-occurrences-positive-when-logic.functionp
+  (implies (logic.functionp x)
+           (equal (equal (logic.count-function-occurrences x) 0)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-function-occurrences))))
+
+(defthm logic.count-function-occurrences-positive-when-logic.lambdap
+  (implies (logic.lambdap x)
+           (equal (equal (logic.count-function-occurrences x) 0)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-function-occurrences))))
+
+
+
+
+(defund logic.flag-count-constant-sizes (flag x acc)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (logic.term-listp x))
+                              (natp acc))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             (logic.fast-constant-size (logic.unquote x) acc))
+            ((logic.variablep x)
+             acc)
+            ((logic.functionp x)
+             (logic.flag-count-constant-sizes 'list (logic.function-args x) acc))
+            ((logic.lambdap x)
+             (logic.flag-count-constant-sizes 'list (logic.lambda-actuals x) acc))
+            (t acc))
+    (if (consp x)
+        (logic.flag-count-constant-sizes 'list (cdr x)
+                                         (logic.flag-count-constant-sizes 'term (car x) acc))
+      acc)))
+
+(defthm forcing-natp-of-logic.flag-count-constant-sizes
+  (implies (force (natp acc))
+           (equal (natp (logic.flag-count-constant-sizes flag x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.flag-count-constant-sizes))))
+
+(verify-guards logic.flag-count-constant-sizes)
+
+(definlined logic.count-constant-sizes (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.flag-count-constant-sizes 'term x 0))
+
+(definlined logic.count-constant-sizes-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (logic.flag-count-constant-sizes 'list x 0))
+
+(defund logic.slow-count-constant-sizes (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             (logic.constant-size (logic.unquote x)))
+            ((logic.variablep x)
+             0)
+            ((logic.functionp x)
+             (logic.slow-count-constant-sizes 'list (logic.function-args x)))
+            ((logic.lambdap x)
+             (logic.slow-count-constant-sizes 'list (logic.lambda-actuals x)))
+            (t 0))
+    (if (consp x)
+        (+ (logic.slow-count-constant-sizes 'term (car x))
+           (logic.slow-count-constant-sizes 'list (cdr x)))
+      0)))
+
+(defthm natp-of-logic.slow-count-constant-sizes
+  (equal (natp (logic.slow-count-constant-sizes flag x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.slow-count-constant-sizes))))
+
+(defthm lemma-forcing-logic.flag-count-constant-sizes-removal
+  (implies (force (natp acc))
+           (equal (logic.flag-count-constant-sizes flag x acc)
+                  (+ (logic.slow-count-constant-sizes flag x) acc)))
+  :hints(("Goal"
+          :in-theory (enable logic.flag-count-constant-sizes
+                             logic.slow-count-constant-sizes)
+          :induct (logic.flag-count-constant-sizes flag x acc))))
+
+(defthmd definition-of-logic.count-constant-sizes
+  (equal (logic.count-constant-sizes x)
+         (cond ((logic.constantp x)
+                (logic.constant-size (logic.unquote x)))
+               ((logic.variablep x)
+                0)
+               ((logic.functionp x)
+                (logic.count-constant-sizes-list (logic.function-args x)))
+               ((logic.lambdap x)
+                (logic.count-constant-sizes-list (logic.lambda-actuals x)))
+               (t 0)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.count-constant-sizes
+                                    logic.count-constant-sizes-list
+                                    logic.slow-count-constant-sizes))))
+
+(defthmd definition-of-logic.count-constant-sizes-list
+  (equal (logic.count-constant-sizes-list x)
+         (if (consp x)
+             (+ (logic.count-constant-sizes (car x))
+                (logic.count-constant-sizes-list (cdr x)))
+           0))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.count-constant-sizes
+                                    logic.count-constant-sizes-list
+                                    logic.slow-count-constant-sizes))))
+
+(defthm logic.flag-count-constant-sizes-removal
+  (implies (force (natp acc))
+           (equal (logic.flag-count-constant-sizes flag x acc)
+                  (if (equal flag 'term)
+                      (+ (logic.count-constant-sizes x) acc)
+                    (+ (logic.count-constant-sizes-list x) acc))))
+  :hints(("Goal" :in-theory (enable logic.count-constant-sizes-list
+                                    logic.count-constant-sizes
+                                    lemma-forcing-logic.flag-count-constant-sizes-removal
+                                    logic.slow-count-constant-sizes))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.count-constant-sizes))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.count-constant-sizes-list))))
+
+(defthm logic.count-constant-sizes-list-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.count-constant-sizes-list x)
+                  0))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-constant-sizes-list))))
+
+(defthm logic.count-constant-sizes-list-of-cons
+  (equal (logic.count-constant-sizes-list (cons a x))
+         (+ (logic.count-constant-sizes a)
+            (logic.count-constant-sizes-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.count-constant-sizes-list))))
+
+(defthms-flag
+  :thms ((term natp-of-logic.count-constant-sizes
+               (equal (natp (logic.count-constant-sizes x))
+                      t))
+         (t natp-of-logic.count-constant-sizes-list
+            (equal (natp (logic.count-constant-sizes-list x))
+                   t)))
+  :hints (("Goal"
+           :induct (logic.term-induction flag x)
+           :in-theory (enable definition-of-logic.count-constant-sizes))))
+
+
+
+
+
+(defund logic.flag-count-term-sizes (flag x var-acc fn-acc const-acc)
+  ;; This is a combined count that only does one recursive pass over x.
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (logic.term-listp x))
+                              (natp var-acc)
+                              (natp fn-acc)
+                              (natp const-acc))
+                  :verify-guards nil))
+  ;; Returns (CONS VAR-ACC (CONS FN-ACC CONST-ACC))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             (cons var-acc
+                   (cons fn-acc
+                         (logic.fast-constant-size (logic.unquote x) const-acc))))
+            ((logic.variablep x)
+             (cons (+ 1 var-acc) (cons fn-acc const-acc)))
+            ((logic.functionp x)
+             (logic.flag-count-term-sizes 'list
+                                          (logic.function-args x)
+                                          var-acc (+ 1 fn-acc) const-acc))
+            ((logic.lambdap x)
+             (logic.flag-count-term-sizes 'list
+                                          (logic.lambda-actuals x)
+                                          var-acc (+ 1 fn-acc) const-acc))
+            (t
+             (cons var-acc (cons fn-acc const-acc))))
+    (if (consp x)
+        (let ((car-counts (logic.flag-count-term-sizes 'term
+                                                       (car x)
+                                                       var-acc fn-acc const-acc)))
+          (logic.flag-count-term-sizes 'list
+                                       (cdr x)
+                                       (car car-counts)
+                                       (car (cdr car-counts))
+                                       (cdr (cdr car-counts))))
+      (cons var-acc
+            (cons fn-acc const-acc)))))
+
+(defthm natp-of-car-of-logic.flag-count-term-sizes
+  (implies (natp var-acc)
+           (natp (car (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc))))
+  :hints(("Goal" :in-theory (e/d (logic.flag-count-term-sizes)
+                                 ((acl2::force))))))
+
+(defthm natp-of-cdar-of-logic.flag-count-term-sizes
+  (implies (natp fn-acc)
+           (natp (car (cdr (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc)))))
+  :hints(("Goal" :in-theory (e/d (logic.flag-count-term-sizes)
+                                 ((acl2::force))))))
+
+(defthm natp-of-cddr-of-logic.flag-count-term-sizes
+  (implies (natp const-acc)
+           (natp (cdr (cdr (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc)))))
+  :hints(("Goal" :in-theory (e/d (logic.flag-count-term-sizes)
+                                 ((acl2::force))))))
+
+(verify-guards logic.flag-count-term-sizes)
+
+(defthm car-of-logic.flag-count-term-sizes
+  (equal (car (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc))
+         (logic.flag-count-variable-occurrences flag x var-acc))
+  :hints(("Goal"
+          :in-theory (e/d (logic.flag-count-term-sizes
+                           logic.flag-count-variable-occurrences)
+                          ((acl2::force))))))
+
+(defthm cadr-of-logic.flag-count-term-sizes
+  (equal (car (cdr (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc)))
+         (logic.flag-count-function-occurrences flag x fn-acc))
+  :hints(("Goal"
+          :in-theory (e/d (logic.flag-count-term-sizes
+                           logic.flag-count-function-occurrences)
+                          ((acl2::force))))))
+
+(defthm cddr-of-logic.flag-count-term-sizes
+  (equal (cdr (cdr (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc)))
+         (logic.flag-count-constant-sizes flag x const-acc))
+  :hints(("Goal"
+          :in-theory (e/d (logic.flag-count-term-sizes
+                           logic.flag-count-constant-sizes)
+                          ((acl2::force))))))
+
+(defthmd consp-of-logic.flag-count-term-sizes-1
+  (consp (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc))
+  :hints(("Goal" :in-theory (e/d (logic.flag-count-term-sizes)
+                                 ((acl2::force))))))
+
+(defthmd consp-of-logic.flag-count-term-sizes-2
+  (consp (cdr (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc)))
+  :hints(("Goal" :in-theory (e/d (logic.flag-count-term-sizes)
+                                 ((acl2::force))))))
+
+(defthmd consp-of-logic.flag-count-term-sizes-3
+  (implies (natp const-acc)
+           (equal (consp (cdr (cdr (logic.flag-count-term-sizes flag x var-acc fn-acc const-acc))))
+                  nil))
+  :hints(("Goal" :in-theory (e/d (logic.flag-count-term-sizes)
+                                 ((acl2::force))))))
+
+(defund logic.count-term-sizes (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.flag-count-term-sizes 'term x 0 0 0))
+
+(defthm definition-of-logic.count-term-sizes
+  (implies (logic.termp x)
+           (equal (logic.count-term-sizes x)
+                  (cons (logic.count-variable-occurrences x)
+                        (cons (logic.count-function-occurrences x)
+                              (logic.count-constant-sizes x)))))
+  :hints(("Goal" :in-theory (enable logic.count-term-sizes
+                                    consp-of-logic.flag-count-term-sizes-1
+                                    consp-of-logic.flag-count-term-sizes-2
+                                    consp-of-logic.flag-count-term-sizes-3))))
+
+
+
+
+
+(defund logic.term-< (x y)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y))))
+  (let ((counts-x (logic.count-term-sizes x))
+        (counts-y (logic.count-term-sizes y)))
+    (let ((x-numvars (car counts-x))
+          (y-numvars (car counts-y)))
+      (cond
+       ((< x-numvars y-numvars) t)
+       ((< y-numvars x-numvars) nil)
+       (t
+        (let ((x-numfuns (car (cdr counts-x)))
+              (y-numfuns (car (cdr counts-y))))
+          (cond
+           ((< x-numfuns y-numfuns) t)
+           ((< y-numfuns x-numfuns) nil)
+           (t
+            (let ((x-const-sizes (cdr (cdr counts-x)))
+                  (y-const-sizes (cdr (cdr counts-y))))
+              (cond
+               ((< x-const-sizes y-const-sizes) t)
+               ((< y-const-sizes x-const-sizes) nil)
+               (t
+                (<< x y))))))))))))
+
+(defthmd definition-of-logic.term-<
+  (equal (logic.term-< x y)
+         (let ((x-numvars (logic.count-variable-occurrences x))
+               (y-numvars (logic.count-variable-occurrences y)))
+           (cond
+            ((< x-numvars y-numvars) t)
+            ((< y-numvars x-numvars) nil)
+            (t
+             (let ((x-numfuns (logic.count-function-occurrences x))
+                   (y-numfuns (logic.count-function-occurrences y)))
+               (cond
+                ((< x-numfuns y-numfuns) t)
+                ((< y-numfuns x-numfuns) nil)
+                (t
+                 (let ((x-const-sizes (logic.count-constant-sizes x))
+                       (y-const-sizes (logic.count-constant-sizes y)))
+                   (cond
+                    ((< x-const-sizes y-const-sizes) t)
+                    ((< y-const-sizes x-const-sizes) nil)
+                    (t
+                     (<< x y)))))))))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.term-<
+                                    logic.count-term-sizes))))
+
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-<))))
+
+(defthm booleanp-of-logic.term-<
+  (equal (booleanp (logic.term-< x y))
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-<))))
+
+(defthm irreflexivity-of-logic.term-<
+  (equal (logic.term-< x x)
+         nil)
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-<))))
+
+(defthm antisymmetry-of-logic.term-<
+  (implies (logic.term-< x y)
+           (equal (logic.term-< y x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-<))))
+
+(defthm transitivity-of-logic.term-<
+  (implies (and (logic.term-< x y)
+                (logic.term-< y z))
+           (equal (logic.term-< x z)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-<))))
+
+(defthm trichotomy-of-logic.term-<
+  (implies (and (not (logic.term-< x y))
+                (not (equal x y)))
+           (equal (logic.term-< y x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-<))))
+
+(defthm transitivity-of-logic.term-<-two
+  (implies (and (logic.term-< x y)
+                (not (logic.term-< z y)))
+           (equal (logic.term-< x z)
+                  t))
+  :hints(("Goal" :cases ((logic.term-< y z)))
+         ("Subgoal 2"
+          :in-theory (disable trichotomy-of-logic.term-<)
+          :use ((:instance trichotomy-of-logic.term-<
+                           (x y)
+                           (y z))))))
+
+(defthm forcing-transitivity-of-logic.term-<-three
+  (implies (and (not (logic.term-< y x))
+                (logic.term-< y z))
+           (equal (logic.term-< x z)
+                  t)))
+
+(defthm forcing-transitivity-of-logic.term-<-four
+  (implies (and (not (logic.term-< y x))
+                (not (logic.term-< z y)))
+           (equal (logic.term-< x z)
+                  (not (equal x z)))))
+
+(defthm forcing-minimality-of-constants-under-logic.term-<
+  (implies (and (logic.constantp x)
+                (not (logic.constantp y))
+                (force (logic.termp x))
+                (force (logic.termp y)))
+           (equal (logic.term-< x y)
+                  t))
+  :hints(("Goal"
+          :in-theory (enable definition-of-logic.term-<)
+          :cases ((logic.variablep y)
+                  (logic.functionp y)))))
+
+
+
+(deflist logic.all-terms-largerp (b x)
+  (logic.term-< b x)
+  :guard (and (logic.termp b)
+              (logic.term-listp x)))
+
+(defthm all-terms-larger-when-all-terms-larger-than-something-bigger
+  (implies (and (logic.all-terms-largerp a x)
+                (logic.term-< b a))
+           (equal (logic.all-terms-largerp b x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-<-when-memberp-of-logic.all-terms-largerp-two
+  (implies (and (logic.all-terms-largerp a x)
+                (memberp b x))
+           (equal (logic.term-< b a)
+                  nil)))
+
+(defthm logic.term-<-when-memberp-of-logic.all-terms-largerp-two-alt
+  (implies (and (memberp b x)
+                (logic.all-terms-largerp a x))
+           (equal (logic.term-< b a)
+                  nil)))
+
+(defthm memberp-when-logic.all-terms-larger-cheap
+   (implies (logic.all-terms-largerp a x)
+            (equal (memberp a x)
+                   nil))
+   :rule-classes ((:rewrite :backchain-limit-lst 1))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+(defund logic.all-terms-largerp-badguy (a x)
+  (declare (xargs :guard (and (logic.termp a)
+                              (logic.term-listp x))))
+  (if (consp x)
+      (if (logic.term-< a (car x))
+          (logic.all-terms-largerp-badguy a (cdr x))
+        (car x))
+    nil))
+
+(defthm logic.all-terms-largerp-badguy-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.all-terms-largerp-badguy a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.all-terms-largerp-badguy))))
+
+(defthm logic.all-terms-largerp-badguy-of-cons
+  (equal (logic.all-terms-largerp-badguy a (cons b x))
+         (if (logic.term-< a b)
+             (logic.all-terms-largerp-badguy a x)
+           b))
+  :hints(("Goal" :in-theory (enable logic.all-terms-largerp-badguy))))
+
+(defthmd logic.all-terms-largerp-badguy-membership-property
+  (implies (logic.all-terms-largerp-badguy a x)
+           (and (memberp (logic.all-terms-largerp-badguy a x) x)
+                (not (logic.term-< a (logic.all-terms-largerp-badguy a x)))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.all-terms-largerp-when-not-logic.all-terms-largerp-badguy
+  (implies (and (not (logic.all-terms-largerp-badguy a x))
+                (force (logic.term-listp x)))
+           (equal (logic.all-terms-largerp a x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/termination.lisp acl2-6.3/books/milawa/ACL2/logic/termination.lisp
--- acl2-6.2/books/milawa/ACL2/logic/termination.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/termination.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,694 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "substitute-term")
+(include-book "negate-term")
+(include-book "pequal-list")
+(include-book "disjoin-formulas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Termination of Function Definitions.
+;;
+;; Milawa permits a definitional extension principle which allows new functions
+;; to be introduced as axioms in the logic.  If we are not careful, this could
+;; lead to inconsistency, e.g., one should not be permitted to define (f x) as
+;; (not (f x)), as this would be inconsistent.  So, we will allow definition to
+;; be admitted only when they can be shown to be terminating for all inputs.
+;;
+;; To keep this simple, Milawa does not support mutually recursive functions.
+;; So, suppose we are trying to admit a recursive function, (f x1 ... xn).
+;; Our goal is to find a term, m, called the "measure" of f, which satisfies
+;; the following obligations:
+;;
+;;   1. The free variables of m are a subset of { x1 ... xn },
+;;
+;;   2. We can prove (ordp m), and
+;;
+;;   3. We can prove (ord< m/[xi<-ai] m) whenever (f a1 ... an) is called
+;;      recursively in the body of f.
+
+
+
+;; Example.  The function "len" is defined as follows.
+;;
+;;  (len x) = (if (consp x) (+ 1 (len (cdr x))) 0)
+;;
+;; To see that m = (rank x) is sufficient, we need to check:
+;;
+;;   1. The free variables of (cdr x) are a subset of { x },
+;;
+;;   2. We can prove (ordp (rank x)), and
+;;
+;;   3. We can prove (consp x) --> (ord< (rank (cdr x)) (rank x)) = t.
+;;
+;; We are allowed to assume (consp x) != nil in the #3 above, because the
+;; recursive call is only made in the "true" branch of the if-expression.
+
+
+
+;; These Obligations are Sufficient.
+;;
+;; Returning now to the general case, let us show these conditions are
+;; sufficient to ensure that every all of (f x1 ... xn) terminates.
+;;
+;; Lemma.  Suppose the above conditions hold and that all previously-defined
+;; functions are total.  If (f z1 ... zn) does not terminate, then there
+;; exists z1' ... zn' such that (f z1' ... zn') also does not terminate, with
+;; (ord< m/[xi<-zi'] m/[xi<-zi]).
+;;
+;; Proof.  Assume (f z1 ... zn) does not terminate.  Since all the previously
+;; defined functions terminate, we must not be in a base case.  Indeed, there
+;; must be some recursive call, (f a1 ... an), which itself does not terminate.
+;;
+;; Since property #3 holds, we know (ord< m/[xi<-ai] m).  Instantiating this
+;; with [xi<-zi], we see that: (ord< (m/[xi<-ai])/[xi<-zi] m/[xi<-zi]).  So,
+;; letting zi'=ai/zi, we are done.
+;;
+;; Q.E.D.
+;;
+;; Theorem.  Suppose the above conditions hold, and all the previously
+;; defined functions terminate.  Then, f terminates as well.
+;;
+;; Proof by contradiction.  If (f z1 ... zn) does not terminate, then by our
+;; lemma we can find inputs z1' ... zn' such that (f z1' ... zn') does not
+;; terminate.  Continuing like this, we can find inputs z1'' ... zn'' so that
+;; (f z1'' ... zn'') does not terminate, and so on forever to infinity.
+;;
+;; Now, by condition #2, we know that each of m/[xi<-zi], m/[xi<-zi'],
+;; m/[xi<-zi''], and so on are ordinals.  Furthermore, by our lemma we know
+;; that m/[xi<-zi] > m/[xi<-zi'] > m/[xi<-zi''], ..., where > denotes ordinal
+;; greater-than.
+;;
+;; Hence, we have constructed an infinite, strictly decreasing sequence of
+;; ordinals, which contradicts the well-foundedness of the ordinals.  This
+;; cannot be, so (f z1 ... zn) must terminate for all choices of inputs.
+;;
+;; Q.E.D.
+
+
+
+;; Computing Termination Obligations with Call Maps.
+;;
+;; Obligation #1 is straightforward to check, and Obligation #2 is easy to
+;; generate.  But the conditions for Obligation #3 take some work to generate.
+;; We use a structure called a Call Map to do this.
+;;
+;; The Call Map associates each recursive call in the function's body with a
+;; list of all the terms ruling it.  Once we have such a map, we can easily
+;; generate the measure conditions we need to prove.  The call map is just a
+;; regular map, i.e., a list of (key . value) pairs.
+;;
+;; The "key" of each entry is a list of the actuals for this function call,
+;; e.g., for the call (len (cdr x)) in our example, the key would be the
+;; singleton list containing (cdr x).
+;;
+;; The "value" of each entry is a list of terms which are the rulers of this
+;; recursive call.  For example, it would be the singleton list containing
+;; (consp x) in our "len" example.
+
+(defmap :map (logic.callmapp x)
+        :key (logic.term-listp x)
+        :val (logic.term-listp x)
+        :key-list (logic.term-list-listp x)
+        :val-list (logic.term-list-listp x)
+        :val-of-nil t)
+
+(defthm forcing-logic.callmapp-of-cons-onto-ranges
+  (implies (force (and (logic.callmapp x)
+                       (logic.termp a)))
+           (equal (logic.callmapp (cons-onto-ranges a x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defmap :map (logic.callmap-atblp x atbl)
+        :key (logic.term-list-atblp x atbl)
+        :val (logic.term-list-atblp x atbl)
+        :key-list (logic.term-list-list-atblp x atbl)
+        :val-list (logic.term-list-list-atblp x atbl)
+        :val-of-nil t
+        :guard (and (logic.callmapp x)
+                    (logic.arity-tablep atbl)))
+
+(defthm forcing-logic.callmap-atblp-of-cons-onto-ranges
+  (implies (force (and (logic.callmap-atblp x atbl)
+                       (logic.term-atblp a atbl)))
+           (equal (logic.callmap-atblp (cons-onto-ranges a x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defund logic.substitute-callmap (x sigma)
+  ;; X is a callmap and sigma is a substitution list.  We apply sigma to every
+  ;; actual and every ruler throughout the entire map.
+  (declare (xargs :guard (and (logic.callmapp x)
+                              (logic.sigmap sigma))))
+  (if (consp x)
+      (let ((actuals (car (car x)))
+            (rulers  (cdr (car x))))
+        (cons (cons (logic.substitute-list actuals sigma)
+                    (logic.substitute-list rulers sigma))
+              (logic.substitute-callmap (cdr x) sigma)))
+    nil))
+
+(defthm logic.substitute-callmap-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.substitute-callmap x sigma)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.substitute-callmap))))
+
+(defthm logic.substitute-callmap-of-cons
+  (equal (logic.substitute-callmap (cons a x) sigma)
+         (cons (cons (logic.substitute-list (car a) sigma)
+                     (logic.substitute-list (cdr a) sigma))
+               (logic.substitute-callmap x sigma)))
+  :hints(("Goal" :in-theory (enable logic.substitute-callmap))))
+
+(defthm true-listp-of-logic.substitute-callmap
+  (equal (true-listp (logic.substitute-callmap x sigma))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-logic.substitute-callmap
+  (equal (len (logic.substitute-callmap x sigma))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.substitute-callmap-of-list-fix
+  (equal (logic.substitute-callmap (list-fix x) sigma)
+         (logic.substitute-callmap x sigma))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.substitute-callmap-of-app
+  (equal (logic.substitute-callmap (app x y) sigma)
+         (app (logic.substitute-callmap x sigma)
+              (logic.substitute-callmap y sigma)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm domain-of-logic.substitute-callmap
+  (equal (domain (logic.substitute-callmap x sigma))
+         (logic.substitute-list-list (domain x) sigma))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm range-of-logic.substitute-callmap
+  (equal (range (logic.substitute-callmap x sigma))
+         (logic.substitute-list-list (range x) sigma))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm mapp-of-logic.substitute-callmapp
+  (equal (mapp (logic.substitute-callmap x sigma))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.callmapp-of-logic.substitute-callmapp
+  (implies (force (and (logic.callmapp x)
+                       (logic.sigmap sigma)))
+           (equal (logic.callmapp (logic.substitute-callmap x sigma))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.callmap-atblp-of-logic.substitute-callmapp
+  (implies (force (and (logic.callmap-atblp x atbl)
+                       (logic.sigma-atblp sigma atbl)))
+           (equal (logic.callmap-atblp (logic.substitute-callmap x sigma) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+;; Building Call Maps.
+;;
+;; We construct the call map for a function using the mutually-recursive
+;; logic.flag-callmap function, below.
+;;
+;; We work inside-out.  Each time we encounter a recursive call of f, we add
+;; its actuals to the callmap, associating an empty set of rulers with this
+;; call.  As our recursion unwinds, we add in the appropriate rulers from any
+;; "if" expressions we pass by.
+;;
+;; We also considered using an outside-in approach, i.e., where we keep a list
+;; of rulers we have seen so far as we descend the term.  But this did not seem
+;; to work well in the lambda case, where we need to account for the new
+;; bindings in the body of the lambda.
+
+(defun logic.flag-callmap (flag f x)
+  ;; We build a callmap for the function f in the term(-list) x.
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (logic.function-namep f))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             ;; There are no calls of f in a constant
+             nil)
+            ((logic.variablep x)
+             ;; There are no calls of f in a variable
+             nil)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (cond ((and (equal name 'if)
+                           (equal (len args) 3))
+                      ;; Special handling for (if test true else):
+                      ;;  -- We collect all the calls of f in test, leaving their rulers intact
+                      ;;  -- We collect all the calls of f in the true branch, adding test as an extra ruler to each such call
+                      ;;  -- We collect all the calls of f in the else branch, adding (not test) as an extra ruler to each such call
+                      (let ((test-calls (logic.flag-callmap 'term f (first args)))
+                            (true-calls (cons-onto-ranges (first args)
+                                                          (logic.flag-callmap 'term f (second args))))
+                            (else-calls (cons-onto-ranges (logic.function 'not (list (first args)))
+                                                          (logic.flag-callmap 'term f (third args)))))
+                        (app test-calls (app true-calls else-calls))))
+                     ((equal name f)
+                      ;; Special handling for (f x1 ... xn):
+                      ;;  -- We collect this call of f
+                      ;;  -- We collect all the calls of f in x1...xn
+                      ;; We leave the rulers of this-call empty; they are added in as the recursion unwinds.
+                      (let ((this-call   (cons args nil))
+                            (child-calls (logic.flag-callmap 'list f args)))
+                        (cons this-call child-calls)))
+                     (t
+                      ;; Generic handling for other functions:
+                      ;;  -- We just collect all the calls of f in the arguments
+                      (logic.flag-callmap 'list f args)))))
+            ((logic.lambdap x)
+             (let ((formals (logic.lambda-formals x))
+                   (body    (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               ;; Handling of Lambdas.
+               ;;  -- We collect all the calls of f in the lambda's actuals, then
+               ;;  -- We collect all the calls of f in the lambda's body and correct them to remove the "temporary formals"
+               ;; Why do we separately collect the actuals?
+               ;;  -- Some actuals might not make it into the body, e.g., (f x) = (let ((temp (f x))) (+ x 1)),
+               ;;     so we want to make sure we collect them too.  (They don't affect soundness, but we want our
+               ;;     computations to terminate.)
+               (let ((actuals-calls (logic.flag-callmap 'list f actuals))
+                     (body-calls    (logic.flag-callmap 'term f body))
+                     (sigma         (pair-lists formals actuals)))
+                 (app actuals-calls
+                      (logic.substitute-callmap body-calls sigma))))))
+    (if (consp x)
+        (app (logic.flag-callmap 'term f (car x))
+             (logic.flag-callmap 'list f (cdr x)))
+       nil)))
+
+(definlined logic.callmap (f x)
+  (declare (xargs :guard (and (logic.function-namep f)
+                              (logic.termp x))
+                  :verify-guards nil))
+  (logic.flag-callmap 'term f x))
+
+(definlined logic.callmap-list (f x)
+  (declare (xargs :guard (and (logic.function-namep f)
+                              (logic.term-listp x))
+                  :verify-guards nil))
+  (logic.flag-callmap 'list f x))
+
+(defthmd definition-of-logic.callmap
+  (equal (logic.callmap f x)
+         (cond ((logic.constantp x) nil)
+               ((logic.variablep x) nil)
+               ((logic.functionp x)
+                (let ((name (logic.function-name x))
+                      (args (logic.function-args x)))
+                  (cond ((and (equal name 'if)
+                              (equal (len args) 3))
+                         (let ((test-calls (logic.callmap f (first args)))
+                               (true-calls (cons-onto-ranges (first args)
+                                                             (logic.callmap f (second args))))
+                               (else-calls (cons-onto-ranges (logic.function 'not (list (first args)))
+                                                             (logic.callmap f (third args)))))
+                           (app test-calls (app true-calls else-calls))))
+                        ((equal name f)
+                         (let ((this-call   (cons args nil))
+                               (child-calls (logic.callmap-list f args)))
+                           (cons this-call child-calls)))
+                        (t
+                         (logic.callmap-list f args)))))
+               ((logic.lambdap x)
+                (let ((formals (logic.lambda-formals x))
+                      (body    (logic.lambda-body x))
+                      (actuals (logic.lambda-actuals x)))
+                  (let ((actuals-calls (logic.callmap-list f actuals))
+                        (body-calls    (logic.callmap f body))
+                        (sigma         (pair-lists formals actuals)))
+                    (app actuals-calls
+                         (logic.substitute-callmap body-calls sigma)))))))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable logic.callmap logic.callmap-list)
+          :expand (logic.flag-callmap 'term f x))))
+
+(defthmd definition-of-logic.callmap-list
+  (equal (logic.callmap-list f x)
+         (if (consp x)
+             (app (logic.callmap f (car x))
+                  (logic.callmap-list f (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable logic.callmap logic.callmap-list)
+          :expand (logic.flag-callmap 'list f x))))
+
+(defthm logic.flag-callmap-of-term
+  (equal (logic.flag-callmap 'term f x)
+         (logic.callmap f x))
+  :hints(("Goal" :in-theory (enable logic.callmap))))
+
+(defthm logic.flag-callmap-of-term-list
+  (equal (logic.flag-callmap 'list f x)
+         (logic.callmap-list f x))
+  :hints(("Goal" :in-theory (enable logic.callmap-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.callmap))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.callmap-list))))
+
+
+
+
+(defthm mapp-of-rev
+  ;; BOZO move this to utilities.lisp
+  (equal (mapp (rev x))
+         (mapp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+;; Well-Formedness of Logic.Flag-Callmap
+;;
+;; We prove that logic.flag-callmap always produces a true-listp, a mapp, a
+;; callmapp, and a callmap-atblp.
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (true-listp (logic.callmap f x))
+            (true-listp (logic.callmap-list f x)))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.flag-callmap flag f x)
+                  :expand ((:free (f) (logic.callmap f x))
+                           (:free (f) (logic.callmap-list f x)))))))
+
+ (defthm true-listp-of-logic.callmap
+   (equal (true-listp (logic.callmap f x))
+          t)
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm true-listp-of-logic.callmap-list
+   (equal (true-listp (logic.callmap-list f x))
+          t)
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (mapp (logic.callmap f x))
+            (mapp (logic.callmap-list f x)))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.flag-callmap flag f x)
+                  :expand ((:free (f) (logic.callmap f x))
+                           (:free (f) (logic.callmap-list f x)))))))
+
+ (defthm mapp-of-logic.callmap
+   (equal (mapp (logic.callmap f x))
+          t)
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm mapp-of-logic.callmap-list
+   (equal (mapp (logic.callmap-list f x))
+          t)
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (implies (logic.termp x)
+                       (logic.callmapp (logic.callmap f x)))
+            (implies (logic.term-listp x)
+                     (logic.callmapp (logic.callmap-list f x))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.flag-callmap flag f x)
+                  :expand ((:free (f) (logic.callmap f x))
+                           (:free (f) (logic.callmap-list f x)))))))
+
+ (defthm forcing-logic.callmapp-of-logic.callmap
+   (implies (force (logic.termp x))
+            (equal (logic.callmapp (logic.callmap f x))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm forcing-logic.callmapp-of-logic.callmap-list
+   (implies (force (logic.term-listp x))
+            (equal (logic.callmapp (logic.callmap-list f x))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (implies (and (logic.arity-tablep atbl)
+                            (logic.termp x)
+                            (logic.term-atblp x atbl)
+                            (equal (cdr (lookup 'not atbl)) 1))
+                       (logic.callmap-atblp (logic.callmap f x) atbl))
+            (implies (and (logic.arity-tablep atbl)
+                          (logic.term-listp x)
+                          (logic.term-list-atblp x atbl)
+                          (equal (cdr (lookup 'not atbl)) 1))
+                     (logic.callmap-atblp (logic.callmap-list f x) atbl)))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.flag-callmap flag f x)
+                  :expand ((:free (f) (logic.callmap f x))
+                           (:free (f) (logic.callmap-list f x)))))))
+
+ (defthm forcing-logic.callmap-atblp-of-logic.callmap
+   (implies (force (and (logic.arity-tablep atbl)
+                        (logic.termp x)
+                        (logic.term-atblp x atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)))
+            (equal (logic.callmap-atblp (logic.callmap f x) atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm forcing-logic.callmap-atblp-of-logic.callmap-list
+   (implies (force (and (logic.arity-tablep atbl)
+                        (logic.term-listp x)
+                        (logic.term-list-atblp x atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)))
+            (equal (logic.callmap-atblp (logic.callmap-list f x) atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(verify-guards logic.flag-callmap)
+(verify-guards logic.callmap)
+(verify-guards logic.callmap-list)
+
+
+
+
+;; Theorem: the actuals produced by logic.flag-callmap always have the same arity,
+;; given that the term was well-formed to begin with.
+
+(encapsulate
+ ()
+ (local (in-theory (e/d (domain-of-rev)
+                        (rev-of-domain))))
+
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (implies (and (logic.arity-tablep atbl)
+                            (logic.termp x)
+                            (logic.term-atblp x atbl))
+                       (all-equalp (cdr (lookup f atbl))
+                                   (strip-lens (domain (logic.callmap f x)))))
+            (implies (and (logic.arity-tablep atbl)
+                          (logic.term-listp x)
+                          (logic.term-list-atblp x atbl))
+                     (all-equalp (cdr (lookup f atbl))
+                                 (strip-lens (domain (logic.callmap-list f x))))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (logic.flag-callmap flag f x)
+                  :expand ((:free (f) (logic.callmap f x))
+                           (:free (f) (logic.callmap-list f x)))))))
+
+ (defthm forcing-all-equalp-of-lengths-of-domain-of-callmap
+   (implies (force (and (logic.arity-tablep atbl)
+                        (logic.termp x)
+                        (logic.term-atblp x atbl)))
+            (equal (all-equalp (cdr (lookup f atbl))
+                               (strip-lens (domain (logic.callmap f x))))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm forcing-all-equalp-of-lengths-of-domain-of-callmap-list
+   (implies (force (and (logic.arity-tablep atbl)
+                        (logic.term-listp x)
+                        (logic.term-list-atblp x atbl)))
+            (equal (all-equalp (cdr (lookup f atbl))
+                               (strip-lens (domain (logic.callmap-list f x))))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+
+
+
+(defund logic.progress-obligation (measure formals actuals rulers)
+  ;; We create the clause for a single callmap entry's obligation.
+  ;;  -- Measure is the measure of the function we want to admit
+  ;;  -- Formals are the formals of the function we want to admit
+  ;;  -- Actuals are the arguments to the recursive call we found
+  ;;  -- Rulers are the terms which rule this recursive call
+  ;; We need to show the measure decreases for this recursive call. That is,
+  ;;    rulers --> (ord< measure/[formals<-actuals] measure)
+  ;; Suppose rulers are (r1 ... rn).  Then our obligation is the clause:
+  ;;    (not r1) v ... v (not rn) v (ord< measure/[formals<-actuals] measure)
+  (declare (xargs :guard (and (logic.termp measure)
+                              (logic.variable-listp formals)
+                              (logic.term-listp actuals)
+                              (logic.term-listp rulers)
+                              (equal (len actuals) (len formals))
+                              )))
+  (let* ((sigma    (pair-lists formals actuals))
+         (m/sigma  (logic.substitute measure sigma))
+         (ord-term (logic.function 'ord< (list m/sigma measure))))
+    (logic.disjoin-formulas
+     (cons (logic.pequal ord-term ''t)
+           (logic.pequal-list rulers (repeat ''nil (len rulers)))))))
+
+(defthm forcing-logic.formulap-of-logic.progress-obligation
+  (implies (force (and (logic.termp measure)
+                       (logic.variable-listp formals)
+                       (logic.term-listp actuals)
+                       (logic.term-listp rulers)
+                       (equal (len formals) (len actuals))))
+           (equal (logic.formulap (logic.progress-obligation measure formals actuals rulers))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.progress-obligation))))
+
+
+
+(defund logic.progress-obligations (measure formals callmap)
+  ;; We create the clauses for all the obligations in this callmap.
+  ;;  -- Measure is the measure of the function we want to admit
+  ;;  -- Formals are the formals of the function we want to admit
+  (declare (xargs :guard (and (logic.termp measure)
+                              (logic.variable-listp formals)
+                              (logic.callmapp callmap)
+                              (all-equalp (len formals) (strip-lens (domain callmap))))))
+  (if (consp callmap)
+      (let* ((entry   (car callmap))
+             (actuals (car entry))
+             (rulers  (cdr entry)))
+        (cons (logic.progress-obligation measure formals actuals rulers)
+              (logic.progress-obligations measure formals (cdr callmap))))
+    nil))
+
+(defthm forcing-logic.formula-list-of-logic.progress-obligations
+  (implies (force (and (logic.termp measure)
+                       (logic.variable-listp formals)
+                       (logic.callmapp callmap)
+                       (all-equalp (len formals) (strip-lens (domain callmap)))))
+           (equal (logic.formula-listp (logic.progress-obligations measure formals callmap))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.progress-obligations))))
+
+
+
+;; BOZO Horrible --- we can verify the guards of this function if we assume
+;; that body and measure are well-formed w.r.t. an arity table, atbl.  But the
+;; atbl isn't used for anything else, so that sucks and is hard to explain when
+;; we write up the core Milawa proof checker.  Hence, we drop the atbl and use
+;; ACL2's EC-CALL mechanism to get verified guards here.
+
+(defund logic.termination-obligations (name formals body measure)
+   ;; We create the clauses for obligations #2 and #3 for a new definition.
+   ;;  -- We take the Name, Formals, Measure, and Body of the new definition
+   (declare (xargs :guard (and (logic.function-namep name)
+                               (logic.variable-listp formals)
+                               (logic.termp body)
+                               (logic.termp measure)
+                               ;(logic.arity-tablep atbl)
+                               ;(logic.term-atblp body atbl)
+                               ;(logic.term-atblp measure atbl)
+                               (uniquep formals)
+                               (subsetp (logic.term-vars body) formals)
+                               (subsetp (logic.term-vars measure) formals)
+                               ;(equal (cdr (lookup name atbl)) (len formals))
+                               )))
+   (let ((callmap (logic.callmap name body)))
+     (if callmap
+         (cons (logic.pequal (logic.function 'ordp (list measure)) ''t)
+               (ACL2::ec-call
+                (logic.progress-obligations measure formals callmap)))
+       nil)))
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthm forcing-logic.formula-listp-of-logic.termination-obligations
+   (implies (force (and (logic.function-namep name)
+                        (logic.variable-listp formals)
+                        (logic.termp body)
+                        (logic.termp measure)
+                        (logic.arity-tablep atbl)
+                        (uniquep formals)
+                        (subsetp (logic.term-vars body) formals)
+                        (subsetp (logic.term-vars measure) formals)
+                        (logic.term-atblp body atbl)
+                        (logic.term-atblp measure atbl)
+                        (equal (cdr (lookup name atbl)) (len formals))))
+            (equal (logic.formula-listp (logic.termination-obligations name formals body measure))
+                   t))
+   :hints(("Goal" :in-theory (enable logic.termination-obligations)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/terms.lisp acl2-6.3/books/milawa/ACL2/logic/terms.lisp
--- acl2-6.2/books/milawa/ACL2/logic/terms.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/terms.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1672 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../utilities/top")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(definlined logic.variablep (x)
+  (declare (xargs :guard t))
+  (and (symbolp x)
+       (not (equal x t))
+       (not (equal x nil))))
+
+(defthm booleanp-of-logic.variablep
+  (equal (booleanp (logic.variablep x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.variablep))))
+
+(defthm symbolp-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (symbolp x)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.variablep))))
+
+(defthm logic.variablep-when-consp
+  (implies (consp x)
+           (equal (logic.variablep x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.variablep))))
+
+
+(deflist logic.variable-listp (x)
+  (logic.variablep x)
+  :elementp-of-nil nil)
+
+(defthm logic.variable-listp-of-sort-symbols-insert
+  (equal (logic.variable-listp (sort-symbols-insert a x))
+         (and (logic.variablep a)
+              (logic.variable-listp x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.variable-listp-of-sort-symbols
+  (equal (logic.variable-listp (sort-symbols x))
+         (logic.variable-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(definlined logic.constantp (x)
+  (declare (xargs :guard t))
+  (and (tuplep 2 x)
+       (equal (first x) 'quote)))
+
+(defthm booleanp-of-logic.constantp
+  (equal (booleanp (logic.constantp x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.constantp))))
+
+(defthm logic.constantp-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.constantp x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.constantp))))
+
+(defthm logic.constantp-of-list-quote
+  (equal (logic.constantp (list 'quote x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.constantp))))
+
+
+
+(definlined logic.unquote (x)
+  (declare (xargs :guard (logic.constantp x)))
+  (second x))
+
+(defthm logic.unquote-of-list-quote
+  (equal (logic.unquote (list 'quote x))
+         x)
+  :hints(("Goal" :in-theory (enable logic.unquote))))
+
+(defthm logic.unquote-under-iff-when-logic.constantp
+  (implies (logic.constantp x)
+           (iff (logic.unquote x)
+                (not (equal x ''NIL))))
+  :hints(("Goal" :in-theory (enable logic.constantp logic.unquote))))
+
+(defthm equal-of-logic.unquote-and-logic.unquote
+  (implies (and (logic.constantp x)
+                (logic.constantp y))
+           (equal (equal (logic.unquote x) (logic.unquote y))
+                  (equal x y)))
+  :hints(("Goal" :in-theory (enable logic.constantp logic.unquote))))
+
+
+
+(deflist logic.constant-listp (x)
+  (logic.constantp x)
+  :elementp-of-nil nil)
+
+(defthm logic.constantp-of-second-when-logic.constant-listp
+  ;; BOZO move to deflist?
+  (implies (logic.constant-listp x)
+           (equal (logic.constantp (second x))
+                  (consp (cdr x)))))
+
+(defthm logic.constantp-of-third-when-logic.constant-listp
+  ;; BOZO move to deflist?
+  (implies (logic.constant-listp x)
+           (equal (logic.constantp (third x))
+                  (consp (cdr (cdr x))))))
+
+
+(deflist logic.none-constantp (x)
+  (logic.constantp x)
+  :elementp-of-nil nil
+  :negatedp t)
+
+
+(defprojection :list (logic.unquote-list x)
+               :element (logic.unquote x)
+               :guard (logic.constant-listp x)
+               :nil-preservingp t)
+
+
+
+(defthm logic.variablep-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (logic.variablep x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.variablep logic.constantp))))
+
+(defthm logic.constantp-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (logic.constantp x)
+                  nil)))
+
+
+
+
+(definlined logic.function-namep (x)
+  (declare (xargs :guard t))
+  (and (symbolp x)
+       (not (memberp x '(nil quote pequal* pnot* por*
+                             first second third fourth fifth
+                             and or list cond let let*)))))
+
+(defthm booleanp-of-logic.function-namep
+  (equal (booleanp (logic.function-namep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (logic.function-namep)
+                                 (memberp-of-cons)))))
+
+(defthm symbolp-when-logic.function-namep
+  ;; BOZO these got real expensive somehow
+  (implies (logic.function-namep x)
+           (equal (symbolp x)
+                  t))
+  :hints(("Goal" :in-theory (enable logic.function-namep))))
+
+(defthm logic.function-namep-when-consp
+  (implies (consp x)
+           (equal (logic.function-namep x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.function-namep))))
+
+(defthm logic.constantp-when-cons-of-logic.function-namep
+  (implies (logic.function-namep name)
+           (equal (logic.constantp (cons name x))
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.constantp))))
+
+(defthm logic.variablep-of-cons-when-logic.function-namep
+  (implies (logic.function-namep name)
+           (equal (logic.variablep (cons name x))
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.variablep))))
+
+
+(deflist logic.function-symbol-listp (x)
+  (logic.function-namep x)
+  :elementp-of-nil nil)
+
+
+
+
+(defund logic.flag-term-vars (flag x acc)
+  ;; Compute the free variables that occur in a term or term list.  This is
+  ;; tail recursive, so we add these variables to the accumulator, acc.
+  ;;
+  ;; It's odd to introduce this concept here, since we haven't yet defined what
+  ;; a term is.  But to define terms, we need to be able to talk about free
+  ;; variables within the body of a lambda to ensure they are all bound, which
+  ;; is why we need this definition first.
+  (declare (xargs :guard (and (or (equal flag 'term)
+                                  (equal flag 'list))
+                              (true-listp acc))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) acc)
+            ((logic.variablep x) (cons x acc))
+            ((not (consp x))     acc)
+            (t                   (logic.flag-term-vars 'list (cdr x) acc)))
+    (if (consp x)
+        (logic.flag-term-vars 'term (car x)
+                              (logic.flag-term-vars 'list (cdr x) acc))
+      acc)))
+
+(defthm true-listp-of-logic.flag-term-vars
+  (equal (true-listp (logic.flag-term-vars flag x acc))
+         (true-listp acc))
+  :hints(("Goal" :in-theory (enable logic.flag-term-vars))))
+
+(verify-guards logic.flag-term-vars)
+
+(definlined logic.term-vars (x)
+  ;; Compute the free variables that occur in a term.
+  (declare (xargs :guard t))
+  (logic.flag-term-vars 'term x nil))
+
+(definlined logic.term-list-vars (x)
+  ;; Compute the free variables that occur in a term list.
+  (declare (xargs :guard t))
+  (logic.flag-term-vars 'list x nil))
+
+
+(defund logic.slow-term-vars (flag x)
+  ;; Non-tail-recursive version of logic.flag-term-vars
+  (declare (xargs :guard (or (equal flag 'term)
+                             (equal flag 'list))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) nil)
+            ((logic.variablep x) (list x))
+            ((not (consp x))     nil)
+            (t                   (logic.slow-term-vars 'list (cdr x))))
+    (if (consp x)
+        (app (logic.slow-term-vars 'term (car x))
+             (logic.slow-term-vars 'list (cdr x)))
+      nil)))
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-definition-of-logic.term-vars
+   (implies (force (true-listp acc))
+            (equal (logic.flag-term-vars flag x acc)
+                   (app (logic.slow-term-vars flag x) acc)))
+   :hints(("Goal"
+           :in-theory (enable logic.flag-term-vars
+                              logic.slow-term-vars)
+           :induct (logic.flag-term-vars flag x acc))))
+
+ (local (in-theory (enable lemma-for-definition-of-logic.term-vars)))
+
+ (defthmd definition-of-logic.term-vars
+   (equal (logic.term-vars x)
+          (cond ((logic.constantp x) nil)
+                ((logic.variablep x) (list x))
+                ((not (consp x))     nil)
+                (t                   (logic.term-list-vars (cdr x)))))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable logic.term-vars
+                                     logic.term-list-vars
+                                     logic.slow-term-vars))))
+
+ (defthmd definition-of-logic.term-list-vars
+   (equal (logic.term-list-vars x)
+          (if (consp x)
+              (app (logic.term-vars (car x))
+                   (logic.term-list-vars (cdr x)))
+            nil))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable logic.term-vars
+                                     logic.term-list-vars
+                                     logic.slow-term-vars))))
+
+ (defthm logic.flag-term-vars-of-term-removal
+   (implies (force (true-listp acc))
+            (equal (logic.flag-term-vars 'term x acc)
+                   (app (logic.term-vars x) acc)))
+   :hints(("Goal" :in-theory (enable logic.term-vars
+                                     logic.slow-term-vars))))
+
+ (defthm logic.flag-term-vars-of-list-removal
+   (implies (force (true-listp acc))
+            (equal (logic.flag-term-vars 'list x acc)
+                   (app (logic.term-list-vars x) acc)))
+   :hints(("Goal" :in-theory (enable logic.term-list-vars
+                                     logic.slow-term-vars)))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-vars))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-list-vars))))
+
+
+
+
+(defund logic.flag-termp (flag x)
+  ;; Recognizer for terms and term lists.  This is only a structural check that
+  ;; does no arity checking.
+  (declare (xargs :guard (or (equal flag 'term)
+                             (equal flag 'list))))
+  (if (equal flag 'term)
+      ;; Check if x is a term.
+      (or (logic.variablep x)
+          (logic.constantp x)
+          (and (consp x)
+               (if (logic.function-namep (car x))
+                   (let ((args (cdr x)))
+                     (and (true-listp args)
+                          (logic.flag-termp 'list args)))
+                 (and (tuplep 3 (car x))
+                      (let ((lambda-symbol (first (car x)))
+                            (formals       (second (car x)))
+                            (body          (third (car x)))
+                            (actuals       (cdr x)))
+                        (and (equal lambda-symbol 'lambda)
+                             (true-listp formals)
+                             (logic.variable-listp formals)
+                             (uniquep formals)
+                             (logic.flag-termp 'term body)
+                             (subsetp (logic.term-vars body) formals)
+                             (equal (len formals) (len actuals))
+                             (true-listp actuals)
+                             (logic.flag-termp 'list actuals)))))))
+    ;; Check if x is a term list.
+    (if (consp x)
+        (and (logic.flag-termp 'term (car x))
+             (logic.flag-termp 'list (cdr x)))
+      t)))
+
+(definlined logic.termp (x)
+  (declare (xargs :guard t))
+  (logic.flag-termp 'term x))
+
+(definlined logic.term-listp (x)
+  (declare (xargs :guard t))
+  (logic.flag-termp 'list x))
+
+(defthmd definition-of-logic.termp
+  (equal (logic.termp x)
+         (or (logic.variablep x)
+             (logic.constantp x)
+             (and (consp x)
+                  (if (logic.function-namep (car x))
+                      (let ((args (cdr x)))
+                        (and (true-listp args)
+                             (logic.term-listp args)))
+                    (and (tuplep 3 (car x))
+                         (let ((lambda-symbol (first (car x)))
+                               (formals       (second (car x)))
+                               (body          (third (car x)))
+                               (actuals       (cdr x)))
+                           (and (equal lambda-symbol 'lambda)
+                                (true-listp formals)
+                                (logic.variable-listp formals)
+                                (uniquep formals)
+                                (logic.termp body)
+                                (subsetp (logic.term-vars body) formals)
+                                (equal (len formals) (len actuals))
+                                (true-listp actuals)
+                                (logic.term-listp actuals))))))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.termp
+                                    logic.term-listp
+                                    logic.flag-termp))))
+
+(defthmd definition-of-logic.term-listp
+  (equal (logic.term-listp x)
+         (if (consp x)
+             (and (logic.termp (car x))
+                  (logic.term-listp (cdr x)))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.termp
+                                    logic.term-listp
+                                    logic.flag-termp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.termp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-listp))))
+
+
+(defthm logic.termp-when-not-consp-cheap
+  (implies (not (consp x))
+           (equal (logic.termp x)
+                  (logic.variablep x)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-logic.termp))))
+
+(defthm logic.termp-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (logic.termp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.termp))))
+
+(defthm logic.termp-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (logic.termp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.termp))))
+
+(defthm logic.term-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.term-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-listp))))
+
+(defthm logic.term-listp-of-cons
+  (equal (logic.term-listp (cons a x))
+         (and (logic.termp a)
+              (logic.term-listp x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-listp))))
+
+(defthm booleanp-of-logic.term-listp
+  (equal (booleanp (logic.term-listp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm booleanp-of-logic.termp
+  (equal (booleanp (logic.termp x))
+         t)
+  :hints(("Goal"
+          :in-theory (enable definition-of-logic.termp)
+          :expand (logic.termp x))))
+
+
+(deflist logic.term-listp (x)
+  (logic.termp x)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(defthm logic.term-listp-when-logic.constant-listp-cheap
+  (implies (logic.constant-listp x)
+           (equal (logic.term-listp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-listp-when-logic.variable-listp-cheap
+  (implies (logic.variable-listp x)
+           (logic.term-listp x))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-listp-of-sort-symbols-when-logic.variable-listp
+  (implies (logic.variable-listp x)
+           (logic.term-listp (sort-symbols x))))
+
+
+
+(definlined logic.functionp (x)
+  (declare (xargs :guard (logic.termp x)))
+  (logic.function-namep (car x)))
+
+(definlined logic.function (name args)
+  (declare (xargs :guard (and (logic.function-namep name)
+                              (true-listp args)
+                              (logic.term-listp args))))
+  (cons name args))
+
+(definlined logic.function-name (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.functionp x))))
+  (car x))
+
+(definlined logic.function-args (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.functionp x))))
+  (cdr x))
+
+(in-theory (disable (:e logic.function)))
+
+(defthm booleanp-of-logic.functionp
+  (equal (booleanp (logic.functionp x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.functionp))))
+
+(defthm consp-when-logic.functionp-cheap
+  (implies (logic.functionp x)
+           (equal (consp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.functionp))))
+
+(defthm logic.variablep-when-logic.functionp
+  (implies (logic.functionp x)
+           (equal (logic.variablep x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.functionp))))
+
+(defthm logic.constantp-when-logic.functionp
+  (implies (logic.functionp x)
+           (equal (logic.constantp x)
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.functionp))))
+
+(defthm consp-of-logic.function
+  (equal (consp (logic.function name args))
+         t)
+  :hints(("Goal" :in-theory (enable logic.function))))
+
+(defthm logic.function-under-iff
+  (iff (logic.function name args)
+       t)
+  :hints(("Goal" :in-theory (enable logic.function))))
+
+(defthm forcing-logic.constantp-of-logic.function
+  (implies (force (logic.function-namep name))
+           (equal (logic.constantp (logic.function name args))
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.function))))
+
+(defthm forcing-logic.variablep-of-logic.function
+  (implies (force (logic.function-namep name))
+           (equal (logic.variablep (logic.function name args))
+                  nil))
+  :hints(("Goal" :in-theory (enable logic.function))))
+
+(defthm forcing-logic.termp-of-logic.function
+  (implies (and (force (logic.function-namep name))
+                (force (true-listp args))
+                (force (logic.term-listp args)))
+           (equal (logic.termp (logic.function name args))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.function
+                                    definition-of-logic.termp))))
+
+(defthm forcing-logic.functionp-of-logic.function
+  (implies (force (logic.function-namep name))
+           (equal (logic.functionp (logic.function name args))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.functionp
+                                    logic.function))))
+
+(defthm forcing-logic.function-namep-of-logic.function-name
+  (implies (force (logic.functionp x))
+           (equal (logic.function-namep (logic.function-name x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.functionp
+                                    logic.function-name
+                                    definition-of-logic.termp))))
+
+(defthm logic.function-name-of-logic.function
+  (equal (logic.function-name (logic.function name args))
+         name)
+  :hints(("Goal" :in-theory (enable logic.function-name
+                                    logic.function))))
+
+(defthm forcing-true-listp-of-logic.function-args
+  (implies (and (force (logic.functionp x))
+                (force (logic.termp x)))
+           (equal (true-listp (logic.function-args x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.functionp
+                                    logic.function-args
+                                    definition-of-logic.termp))))
+
+(defthm forcing-logic.term-listp-of-logic.function-args
+  (implies (and (force (logic.functionp x))
+                (force (logic.termp x)))
+           (equal (logic.term-listp (logic.function-args x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.functionp
+                                    logic.function-args
+                                    definition-of-logic.termp))))
+
+(defthm logic.function-args-of-logic.function
+  (equal (logic.function-args (logic.function name args))
+         args)
+  :hints(("Goal" :in-theory (enable logic.function-args
+                                    logic.function))))
+
+(defthm forcing-logic.function-of-logic.function-name-and-logic.function-args
+  (implies (force (logic.functionp x))
+           (equal (logic.function (logic.function-name x) (logic.function-args x))
+                  x))
+  :hints(("Goal" :in-theory (enable logic.functionp
+                                    logic.function
+                                    logic.function-name
+                                    logic.function-args))))
+
+(defthm logic.function-of-logic.function-name-and-nil-when-nil-logic.function-args
+  (implies (and (not (logic.function-args x))
+                (force (logic.functionp x)))
+           (equal (logic.function (logic.function-name x) nil)
+                  x))
+  :hints(("Goal" :in-theory (enable logic.functionp
+                                    logic.function-name
+                                    logic.function
+                                    logic.function-args))))
+
+(defthm forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+  (implies (and (equal name (logic.function-name term))
+                (equal args (logic.function-args term))
+                (force (logic.functionp term)))
+           (equal (logic.function name args)
+                  term))
+  :hints(("Goal" :in-theory (enable logic.functionp))))
+
+(defthm rank-of-logic.function-args
+  (equal (< (rank (logic.function-args x)) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.function-args))))
+
+(defthm rank-of-first-of-logic.function-args
+  (equal (< (rank (first (logic.function-args x))) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.function-args))))
+
+(defthm rank-of-second-of-logic.function-args
+  (equal (< (rank (second (logic.function-args x))) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.function-args))))
+
+(defthm rank-of-third-of-logic.function-args
+  (equal (< (rank (third (logic.function-args x))) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.function-args))))
+
+(defthm equal-of-logic.function-rewrite
+  (implies (force (logic.function-namep name))
+           (equal (equal (logic.function name args) x)
+                  (and (logic.functionp x)
+                       (equal (logic.function-name x) name)
+                       (equal (logic.function-args x) args))))
+  :hints(("Goal" :in-theory (enable logic.function
+                                    logic.functionp
+                                    logic.function-name
+                                    logic.function-args))))
+
+(defthm equal-of-logic.function-and-logic.function
+  (equal (equal (logic.function name1 args1)
+                (logic.function name2 args2))
+         (and (equal name1 name2)
+              (equal args1 args2)))
+  :hints(("Goal" :in-theory (enable logic.function))))
+
+(defthm logic.function-args-under-iff-with-len-free
+  (implies (and (equal (len (logic.function-args term)) n)
+                (syntaxp (ACL2::quotep n))
+                (< 0 n))
+           (iff (logic.function-args term)
+                t)))
+
+(defthm forcing-equal-of-logic.function-with-two-args
+   (implies (and (equal (len (logic.function-args x)) 2)
+                 (force (logic.termp x))
+                 (force (logic.functionp x)))
+            (equal (equal (logic.function name (list a b)) x)
+                   (and (equal name (logic.function-name x))
+                        (equal a (first (logic.function-args x)))
+                        (equal b (second (logic.function-args x)))))))
+
+(defthm forcing-equal-of-logic.function-with-three-args
+  (implies (and (equal (len (logic.function-args x)) 3)
+                (force (logic.termp x))
+                (force (logic.functionp x)))
+           (equal (equal (logic.function name (list a b c)) x)
+                  (and (equal name (logic.function-name x))
+                       (equal a (first (logic.function-args x)))
+                       (equal b (second (logic.function-args x)))
+                       (equal c (third (logic.function-args x)))))))
+
+
+
+
+(definlined logic.lambdap (x)
+  (declare (xargs :guard (logic.termp x)))
+  (consp (car x)))
+
+(defthm booleanp-of-logic.lambdap
+  (equal (booleanp (logic.lambdap x))
+         t)
+  :hints(("Goal" :in-theory (enable logic.lambdap))))
+
+(defthm consp-when-logic.lambdap-cheap
+  (implies (logic.lambdap x)
+           (equal (consp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable logic.lambdap))))
+
+(defthm logic.variablep-when-logic.lambdap-cheap
+  (implies (logic.lambdap x)
+           (equal (logic.variablep x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable logic.lambdap logic.variablep))))
+
+(defthm logic.constantp-when-logic.lambdap-cheap
+  (implies (logic.lambdap x)
+           (equal (logic.constantp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable logic.lambdap logic.constantp))))
+
+(defthm logic.functionp-when-logic.lambdap-cheap
+  (implies (logic.lambdap x)
+           (equal (logic.functionp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable logic.lambdap logic.functionp))))
+
+(defthm logic.lambdap-when-logic.functionp-cheap
+  (implies (logic.functionp x)
+           (equal (logic.lambdap x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable logic.lambdap))))
+
+
+
+
+(definlined logic.lambda (xs b ts)
+  (declare (xargs :guard (and (true-listp xs)
+                              (logic.variable-listp xs)
+                              (uniquep xs)
+                              (logic.termp b)
+                              (true-listp ts)
+                              (logic.term-listp ts))))
+  (cons (list 'lambda xs b) ts))
+
+
+(in-theory (disable (:e logic.lambda)))
+
+(defthm consp-of-logic.lambda
+  (equal (consp (logic.lambda formals body actuals))
+         t)
+  :hints(("Goal" :in-theory (enable logic.lambda))))
+
+(defthm logic.lambda-under-iff
+  (iff (logic.lambda formals body actuals)
+       t)
+  :hints(("Goal" :in-theory (enable logic.lambda))))
+
+(defthm logic.constantp-of-logic.lambda
+  (equal (logic.constantp (logic.lambda formals body actuals))
+         nil)
+  :hints(("Goal" :in-theory (enable logic.lambda logic.constantp))))
+
+(defthm logic.variablep-of-logic.lambda
+  (equal (logic.variablep (logic.lambda formals body actuals))
+         nil)
+  :hints(("Goal" :in-theory (enable logic.lambda
+                                    logic.variablep))))
+
+(defthm logic.functionp-of-logic.lambda
+  (equal (logic.functionp (logic.lambda formals body actuals))
+         nil)
+  :hints(("Goal" :in-theory (enable logic.lambda
+                                    logic.functionp
+                                    logic.function-namep))))
+
+(defthm forcing-logic.termp-of-logic.lambda
+  (implies (and (force (true-listp formals))
+                (force (logic.variable-listp formals))
+                (force (uniquep formals))
+                (force (logic.termp body))
+                (force (subsetp (logic.term-vars body) formals))
+                (force (true-listp actuals))
+                (force (logic.term-listp actuals))
+                (force (equal (len formals) (len actuals))))
+           (equal (logic.termp (logic.lambda formals body actuals))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.lambda
+                                    definition-of-logic.termp))))
+
+(defthm logic.lambdap-of-logic.lambda
+  (equal (logic.lambdap (logic.lambda formals body actuals))
+         t)
+  :hints(("Goal" :in-theory (enable logic.lambdap logic.lambda))))
+
+(defthm equal-of-logic.lambda-and-logic.lambda
+  (equal (equal (logic.lambda formals1 body1 actuals1)
+                (logic.lambda formals2 body2 actuals2))
+         (and (equal formals1 formals2)
+              (equal body1 body2)
+              (equal actuals1 actuals2)))
+  :hints(("Goal" :in-theory (enable logic.lambda))))
+
+
+
+
+(definlined logic.lambda-formals (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.lambdap x))))
+  (second (car x)))
+
+(defthm forcing-true-listp-of-logic.lambda-formals
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (equal (true-listp (logic.lambda-formals x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.lambdap
+                                    logic.lambda-formals
+                                    definition-of-logic.termp))))
+
+(defthm forcing-logic.variable-listp-of-logic.lambda-formals
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (logic.variable-listp (logic.lambda-formals x)))
+  :hints(("Goal" :in-theory (enable logic.lambdap
+                                    logic.lambda-formals
+                                    definition-of-logic.termp))))
+
+(defthm forcing-uniquep-of-logic.lambda-formals
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (uniquep (logic.lambda-formals x)))
+  :hints(("Goal" :in-theory (enable logic.lambdap
+                                    logic.lambda-formals
+                                    definition-of-logic.termp))))
+
+(defthm logic.lambda-formals-of-logic.lambda
+  (equal (logic.lambda-formals (logic.lambda formals body actuals))
+         formals)
+  :hints(("Goal" :in-theory (enable logic.lambda-formals
+                                    logic.lambda))))
+
+
+
+
+
+
+(definlined logic.lambda-body (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.lambdap x))))
+  (third (car x)))
+
+(defthm forcing-logic.termp-of-logic.lambda-body
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (logic.termp (logic.lambda-body x)))
+  :hints(("Goal" :in-theory (enable logic.lambdap
+                                    logic.lambda-body
+                                    definition-of-logic.termp))))
+
+(defthm logic.lambda-body-of-logic.lambda
+  (equal (logic.lambda-body (logic.lambda formals body actuals))
+         body)
+  :hints(("Goal" :in-theory (enable logic.lambda-body logic.lambda))))
+
+(defthm rank-of-logic.lambda-body
+  (equal (< (rank (logic.lambda-body x)) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.lambda-body))))
+
+(defthm forcing-subsetp-of-logic.term-vars-of-logic.lambda-body-with-logic.lambda-formals
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (equal (subsetp (logic.term-vars (logic.lambda-body x))
+                           (logic.lambda-formals x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.termp
+                                    logic.lambdap
+                                    logic.lambda-body
+                                    logic.lambda-formals))))
+
+
+
+(definlined logic.lambda-actuals (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.lambdap x))))
+  (cdr x))
+
+(defthm forcing-true-listp-of-logic.lambda-actuals
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (equal (true-listp (logic.lambda-actuals x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.lambdap
+                                    logic.lambda-actuals
+                                    definition-of-logic.termp))))
+
+(defthm forcing-logic.term-listp-of-logic.lambda-actuals
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (equal (logic.term-listp (logic.lambda-actuals x))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.lambdap
+                                    logic.lambda-actuals
+                                    definition-of-logic.termp))))
+
+(defthm logic.lambda-actuals-of-logic.lambda
+  (equal (logic.lambda-actuals (logic.lambda formals body actuals))
+         actuals)
+  :hints(("Goal" :in-theory (enable logic.lambda-actuals logic.lambda))))
+
+
+
+
+
+(defthm forcing-equal-lens-of-logic.lambda-formals-and-logic.lambda-actuals
+  ;; The lengths of the actuals and formals are equal, so we choose to
+  ;; canonicalize one to the other.  Originally I had chosen the length of the
+  ;; formals as the normal form.  But in obscure cases, this could lead the
+  ;; rewriter to loop.  For example, suppose the rewriter has discovered on
+  ;; its own that the lengths are equal.  Then, we can get the following loop:
+  ;;
+  ;;   1. Rewrite (len actuals) to (len formals)
+  ;;   2. Canonicalize (len formals) back to (len actuals), since
+  ;;      "(len (logic.lambda-actuals x))" is term-< than "(len (logic.lambda-formals x))"
+  ;;
+  ;; So, now we use the length of the actuals as the normal form, since now
+  ;; term-< canonicalization agrees with the way we are trying to normalize.
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (equal (len (logic.lambda-formals x))
+                  (len (logic.lambda-actuals x))))
+  :hints(("Goal" :in-theory (enable definition-of-logic.termp
+                                    logic.lambdap
+                                    logic.lambda-formals
+                                    logic.lambda-actuals))))
+
+(defthm forcing-logic.lambda-of-logic.lambda-formals-body-and-actuals
+  (implies (and (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (equal (logic.lambda (logic.lambda-formals x)
+                                (logic.lambda-body x)
+                                (logic.lambda-actuals x))
+                  x))
+  :hints(("Goal" :in-theory (enable logic.lambdap
+                                    logic.lambda
+                                    logic.lambda-formals
+                                    logic.lambda-body
+                                    logic.lambda-actuals
+                                    definition-of-logic.termp))))
+
+(defthm forcing-logic.lambda-of-logic.lambda-formals-body-and-actuals-free
+  (implies (and (equal formals (logic.lambda-formals x))
+                (equal body (logic.lambda-body x))
+                (equal actuals (logic.lambda-actuals x))
+                (force (logic.lambdap x))
+                (force (logic.termp x)))
+           (equal (logic.lambda formals body actuals)
+                  x)))
+
+(defthm rank-of-logic.lambda-actuals
+  (equal (< (rank (logic.lambda-actuals x)) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.lambda-actuals))))
+
+(defthm rank-of-first-of-logic.lambda-actuals
+  (equal (< (rank (logic.lambda-actuals x)) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.lambda-actuals))))
+
+(defthm rank-of-second-of-logic.lambda-actuals
+  (equal (< (rank (second (logic.lambda-actuals x))) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.lambda-actuals))))
+
+(defthm rank-of-third-of-logic.lambda-actuals
+  (equal (< (rank (third (logic.lambda-actuals x))) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable logic.lambda-actuals))))
+
+
+(defthm logic.function-namep-of-car-when-logic.termp-and-not-logic.variablep
+  (implies (and (logic.termp x)
+                (not (logic.variablep x)))
+           (equal (logic.function-namep (car x))
+                  (logic.functionp x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.termp
+                                    logic.functionp))))
+
+(defthm logic.lambdap-when-not-anything-else-maybe-expensive
+  (implies (and (logic.termp x)
+                (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x)))
+           (equal (logic.lambdap x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable definition-of-logic.termp
+                                    logic.lambdap
+                                    logic.functionp))))
+
+(defthm logic.termp-when-invalid-maybe-expensive
+  (implies (and (not (logic.variablep x))
+                (not (logic.constantp x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (logic.termp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm logic.functionp-when-not-other-stuff-cheap
+  (implies (and (logic.termp x)
+                (not (logic.variablep x))
+                (not (logic.constantp x))
+                (not (logic.lambdap x)))
+           (equal (logic.functionp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm logic.lambdap-when-not-other-stuff-cheap
+  (implies (and (logic.termp x)
+                (not (logic.variablep x))
+                (not (logic.constantp x))
+                (not (logic.functionp x)))
+           (equal (logic.lambdap x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm logic.lambdap-when-consp-of-car-cheap
+  (implies (and (logic.termp x)
+                (consp (car x)))
+           (equal (logic.lambdap x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable logic.lambdap))))
+
+
+
+
+
+
+
+(defun logic.term-induction (flg x)
+  (declare (xargs :verify-guards nil))
+  (if (equal flg 'term)
+      (cond ((logic.variablep x) nil)
+            ((logic.constantp x) nil)
+            ((logic.functionp x)
+             (logic.term-induction 'list (logic.function-args x)))
+            ((logic.lambdap x)
+             (list (logic.term-induction 'term (logic.lambda-body x))
+                   (logic.term-induction 'list (logic.lambda-actuals x))))
+            (t nil))
+    (if (consp x)
+        (list (logic.term-induction 'term (car x))
+              (logic.term-induction 'list (cdr x)))
+      nil)))
+
+
+
+
+
+(defthm logic.term-list-vars-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.term-list-vars x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-list-vars))))
+
+(defthm logic.term-list-vars-of-cons
+  (equal (logic.term-list-vars (cons a x))
+         (app (logic.term-vars a)
+              (logic.term-list-vars x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-list-vars))))
+
+(defthm true-listp-of-logic.term-list-vars
+  (equal (true-listp (logic.term-list-vars x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-logic.term-vars
+  (equal (true-listp (logic.term-vars x))
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-vars))))
+
+(defthm logic.term-vars-when-variable
+  (implies (logic.variablep x)
+           (equal (logic.term-vars x)
+                  (list x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-vars))))
+
+(defthm logic.term-vars-when-constant
+  (implies (logic.constantp x)
+           (equal (logic.term-vars x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-vars))))
+
+(defthm logic.term-vars-when-bad
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (consp x)))
+           (equal (logic.term-vars x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-vars))))
+
+(defthm logic.term-vars-when-function-call
+  (implies (logic.functionp x)
+           (equal (logic.term-vars x)
+                  (logic.term-list-vars (logic.function-args x))))
+  :hints(("Goal" :in-theory (enable logic.function-args
+                                    definition-of-logic.term-vars))))
+
+(defthm logic.term-vars-when-logic.lambda
+  (implies (logic.lambdap x)
+           (equal (logic.term-vars x)
+                  (logic.term-list-vars (logic.lambda-actuals x))))
+  :hints(("Goal"
+          :in-theory (enable logic.lambdap logic.lambda-actuals definition-of-logic.term-vars))))
+
+(defthm subsetp-of-logic.term-list-vars-of-cdr-with-logic.term-list-vars
+  (equal (subsetp (logic.term-list-vars (cdr x))
+                  (logic.term-list-vars x))
+         t))
+
+(defthm subsetp-of-logic.term-vars-of-car-with-logic.term-list-vars
+  (equal (subsetp (logic.term-vars (car x))
+                  (logic.term-list-vars x))
+         t))
+
+(defthms-flag
+  :thms ((term forcing-logic.variable-listp-of-logic.term-vars
+               (implies (force (logic.termp x))
+                        (equal (logic.variable-listp (logic.term-vars x))
+                               t)))
+         (t forcing-logic.variable-listp-of-logic.term-list-vars
+            (implies (force (logic.term-listp x))
+                     (equal (logic.variable-listp (logic.term-list-vars x))
+                            t))))
+  :hints(("Goal"
+          :induct (logic.term-induction flag x)
+          :in-theory (enable definition-of-logic.term-vars))))
+
+(defthm logic.term-list-vars-when-logic.variable-listp
+  (implies (logic.variable-listp x)
+           (equal (logic.term-list-vars x)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-subsetp-of-logic.term-list-vars-and-remove-duplicates
+   (implies (memberp a x)
+            (subsetp (logic.term-vars a) (logic.term-list-vars x)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm subsetp-of-logic.term-list-vars-and-remove-duplicates
+   (subsetp (logic.term-list-vars x)
+            (logic.term-list-vars (remove-duplicates x)))
+   :hints(("Goal"
+           :induct (cdr-induction x)
+           :in-theory (enable lemma-for-subsetp-of-logic.term-list-vars-and-remove-duplicates)))))
+
+(defthm subsetp-of-logic.term-list-vars-and-remove-duplicates-two
+  (subsetp (logic.term-list-vars (remove-duplicates x))
+           (logic.term-list-vars x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(deflist logic.term-list-listp (x)
+  (logic.term-listp x)
+  :elementp-of-nil t)
+
+(defthm logic.term-listp-when-subset-of-somep
+  (implies (and (subset-of-somep a x)
+                (logic.term-list-listp x))
+           (equal (logic.term-listp a)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-listp-when-subset-of-somep-alt
+  (implies (and (logic.term-list-listp x)
+                (subset-of-somep a x))
+           (equal (logic.term-listp a)
+                  t)))
+
+(defthm logic.term-list-listp-when-all-superset-of-somep
+  (implies (and (all-subset-of-somep x y)
+                (logic.term-list-listp y))
+           (equal (logic.term-list-listp x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-listp-when-all-superset-of-somep-alt
+  (implies (and (logic.term-list-listp y)
+                (all-subset-of-somep x y))
+           (equal (logic.term-list-listp x)
+                  t)))
+
+(defthm forcing-logic.term-list-listp-of-remove-supersets1
+  (implies (and (force (logic.term-list-listp todo))
+                (force (logic.term-list-listp done)))
+           (equal (logic.term-list-listp (remove-supersets1 todo done))
+                  t))
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+(defthm forcing-logic.term-list-listp-of-remove-supersets
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.term-list-listp (remove-supersets x))
+                  t))
+  :hints(("Goal" :in-theory (enable remove-supersets))))
+
+(defthm forcing-logic.term-list-listp-of-remove-duplicates-list
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.term-list-listp (remove-duplicates-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-listp-of-strip-firsts-when-logic.term-list-listp
+  (implies (force (and (logic.term-list-listp x)
+                       (all-at-leastp 1 (strip-lens x))))
+           (equal (logic.term-listp (strip-firsts x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-listp-of-listify-each
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-list-listp (listify-each x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-listp-of-simple-flatten
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.term-listp (simple-flatten x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-listp-of-multicons
+  (implies (and (force (logic.termp e))
+                (force (logic.term-list-listp x)))
+           (equal (logic.term-list-listp (multicons e x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund logic.fast-term-list-list-vars (x acc)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (if (consp x)
+      (logic.flag-term-vars 'list (car x)
+                            (logic.fast-term-list-list-vars (cdr x) acc))
+    acc))
+
+(defthm true-listp-of-logic.fast-term-list-list-vars
+  (equal (true-listp (logic.fast-term-list-list-vars x acc))
+         (true-listp acc))
+  :hints(("Goal" :in-theory (enable logic.fast-term-list-list-vars))))
+
+(verify-guards logic.fast-term-list-list-vars)
+
+
+(definlined logic.term-list-list-vars (x)
+  (declare (xargs :guard (logic.term-list-listp x)))
+  (logic.fast-term-list-list-vars x nil))
+
+(defthmd definition-of-logic.term-list-list-vars
+  (equal (logic.term-list-list-vars x)
+         (if (consp x)
+             (app (logic.term-list-vars (car x))
+                  (logic.term-list-list-vars (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.term-list-list-vars
+                                    logic.fast-term-list-list-vars))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-list-list-vars))))
+
+(defthm true-listp-of-logic.term-list-list-vars
+  (equal (true-listp (logic.term-list-list-vars x))
+         t)
+  :hints(("Goal"
+          :in-theory (enable definition-of-logic.term-list-list-vars)
+          :induct (cdr-induction x))))
+
+(defthm logic.term-list-list-vars-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.term-list-list-vars x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-list-list-vars))))
+
+(defthm logic.term-list-list-vars-of-cons
+  (equal (logic.term-list-list-vars (cons a x))
+         (app (logic.term-list-vars a)
+              (logic.term-list-list-vars x)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-list-list-vars))))
+
+(defthm forcing-logic.variable-listp-of-logic.term-list-list-vars
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.variable-listp (logic.term-list-list-vars x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defthm first-under-iff-when-logic.term-listp-with-len-free
+  (implies (and (equal (len x) n)
+                (syntaxp (ACL2::quotep n))
+                (logic.term-listp x)
+                (< 0 n))
+           (iff (first x)
+                t)))
+
+(defthm second-under-iff-when-logic.term-listp-with-len-free
+  (implies (and (equal (len x) n)
+                (syntaxp (ACL2::quotep n))
+                (logic.term-listp x)
+                (< 1 n))
+           (iff (second x)
+                t)))
+
+(defthm third-under-iff-when-logic.term-listp-with-len-free
+  (implies (and (equal (len x) n)
+                (syntaxp (ACL2::quotep n))
+                (logic.term-listp x)
+                (< 2 n))
+           (iff (third x)
+                t)))
+
+
+
+
+(defmap :map (logic.arity-tablep x)
+        :key (logic.function-namep x)
+        :val (natp x)
+        :key-list (logic.function-symbol-listp x)
+        :val-list (nat-listp x)
+        :val-of-nil nil)
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthm logic.arity-tablep-of-halve-list
+   (equal (logic.arity-tablep x)
+          (and (logic.arity-tablep (car (halve-list x)))
+               (logic.arity-tablep (cdr (halve-list x)))))
+   :rule-classes nil
+   :hints(("Goal"
+           :in-theory (disable halve-list-correct
+                               logic.arity-tablep-of-list-fix
+                               logic.arity-tablep-of-subset-when-logic.arity-tablep)
+           :use ((:instance halve-list-correct)
+                 (:instance logic.arity-tablep-of-list-fix)))))
+
+ (defthm logic.arity-tablep-of-halve-list-1
+   (implies (logic.arity-tablep x)
+            (logic.arity-tablep (car (halve-list x))))
+   :hints(("Goal" :use ((:instance logic.arity-tablep-of-halve-list)))))
+
+ (defthm logic.arity-tablep-of-halve-list-2
+   (implies (logic.arity-tablep x)
+            (logic.arity-tablep (cdr (halve-list x))))
+   :hints(("Goal" :use ((:instance logic.arity-tablep-of-halve-list))))))
+
+(defthm logic.arity-tablep-of-merge-maps
+  (implies (and (force (logic.arity-tablep x))
+                (force (logic.arity-tablep y)))
+           (equal (logic.arity-tablep (merge-maps x y))
+                  t))
+  :hints(("Goal" :in-theory (enable merge-maps))))
+
+(defthm logic.arity-tablep-of-mergesort-map
+  (implies (logic.arity-tablep x)
+           (logic.arity-tablep (mergesort-map x)))
+  :hints(("Goal"
+          :in-theory (enable mergesort-map))))
+
+
+
+(defund logic.flag-term-atblp (flag x atbl)
+  ;; Check if every function call throughout the term(-list) has the arity
+  ;; specified in the arity table.
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (logic.termp x)
+                                (and (equal flag 'list)
+                                     (logic.term-listp x)))
+                              (logic.arity-tablep atbl))))
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             t)
+            ((logic.variablep x)
+             t)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (and (equal (len args) (cdr (lookup name atbl)))
+                    (logic.flag-term-atblp 'list args atbl))))
+            ((logic.lambdap x)
+             (let ((body (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               (and (logic.flag-term-atblp 'term body atbl)
+                    (logic.flag-term-atblp 'list actuals atbl))))
+            (t nil))
+    (if (consp x)
+        (and (logic.flag-term-atblp 'term (car x) atbl)
+             (logic.flag-term-atblp 'list (cdr x) atbl))
+     t)))
+
+(definlined logic.term-atblp (x atbl)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.arity-tablep atbl))))
+  (logic.flag-term-atblp 'term x atbl))
+
+(definlined logic.term-list-atblp (x atbl)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.arity-tablep atbl))))
+  (logic.flag-term-atblp 'list x atbl))
+
+(defthmd definition-of-logic.term-atblp
+  (equal (logic.term-atblp x atbl)
+         (cond ((logic.constantp x)
+                t)
+               ((logic.variablep x)
+                t)
+               ((logic.functionp x)
+                (let ((name (logic.function-name x))
+                      (args (logic.function-args x)))
+                  (and (equal (len args) (cdr (lookup name atbl)))
+                       (logic.term-list-atblp args atbl))))
+               ((logic.lambdap x)
+                (let ((body (logic.lambda-body x))
+                      (actuals (logic.lambda-actuals x)))
+               (and (logic.term-atblp body atbl)
+                    (logic.term-list-atblp actuals atbl))))
+               (t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.term-atblp
+                                    logic.term-list-atblp
+                                    logic.flag-term-atblp))))
+
+(defthmd definition-of-logic.term-list-atblp
+  (equal (logic.term-list-atblp x atbl)
+         (if (consp x)
+             (and (logic.term-atblp (car x) atbl)
+                  (logic.term-list-atblp (cdr x) atbl))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.term-atblp
+                                    logic.term-list-atblp
+                                    logic.flag-term-atblp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-atblp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.term-list-atblp))))
+
+
+(defthm logic.term-list-atblp-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.term-list-atblp x atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-list-atblp))))
+
+(defthm logic.term-list-atblp-of-cons
+  (equal (logic.term-list-atblp (cons a x) atbl)
+         (and (logic.term-atblp a atbl)
+              (logic.term-list-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-list-atblp))))
+
+(defthms-flag
+  :thms ((term booleanp-of-logic.term-atblp
+               (equal (booleanp (logic.term-atblp x atbl))
+                      t))
+         (t booleanp-of-logic.term-list-atblp
+            (equal (booleanp (logic.term-list-atblp x atbl))
+                   t)))
+  :hints(("Goal"
+          :induct (logic.term-induction flag x)
+          :in-theory (enable definition-of-logic.term-atblp))))
+
+(defthm logic.term-atblp-of-nil
+  (equal (logic.term-atblp nil atbl)
+         nil)
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-atblp))))
+
+(deflist logic.term-list-atblp (x atbl)
+  (logic.term-atblp x atbl)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(deflist logic.term-list-list-atblp (x atbl)
+  (logic.term-list-atblp x atbl)
+  :elementp-of-nil t
+  :guard (and (logic.term-list-listp x)
+              (logic.arity-tablep atbl)))
+
+(defthm logic.term-atblp-when-logic.variablep
+  (implies (logic.variablep x)
+           (equal (logic.term-atblp x atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-atblp))))
+
+(defthm logic.term-atblp-when-logic.constantp
+  (implies (logic.constantp x)
+           (equal (logic.term-atblp x atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-atblp))))
+
+(defthm logic.term-list-atblp-when-logic.constant-listp
+  (implies (logic.constant-listp x)
+           (equal (logic.term-list-atblp x atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-atblp-when-logic.variable-listp
+  (implies (logic.variable-listp x)
+           (equal (logic.term-list-atblp x atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-atblp-of-logic.function
+  (implies (and (force (logic.function-namep name))
+                (force (logic.term-list-atblp args atbl))
+                (force (equal (cdr (lookup name atbl)) (len args))))
+           (equal (logic.term-atblp (logic.function name args) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-atblp))))
+
+(defthm forcing-logic.term-atblp-of-logic.lambda
+  (implies (and (force (logic.term-atblp body atbl))
+                (force (logic.term-list-atblp actuals atbl)))
+           (equal (logic.term-atblp (logic.lambda formals body actuals) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (definition-of-logic.term-atblp)
+                                 ;; Leads to inappropriate forcing
+                                 (logic.lambdap-when-not-anything-else-maybe-expensive)))))
+
+(defthm forcing-logic.term-list-atblp-of-logic.function-args
+  ;; BOZO why aren't we forcing both hyps?
+  ;; I'm now trying to force them both.  Previously I wasn't forcing the first one
+  ;; for some reason.
+  (implies (and (force (logic.term-atblp x atbl))
+                (force (logic.functionp x)))
+           (equal (logic.term-list-atblp (logic.function-args x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-atblp))))
+
+(defthm forcing-logic.term-list-atblp-of-logic.lambda-actuals
+  ;; BOZO why aren't we forcing both hyps?
+  ;; Same as above.
+  (implies (and (force (logic.term-atblp x atbl))
+                (force (logic.lambdap x)))
+           (equal (logic.term-list-atblp (logic.lambda-actuals x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-atblp))))
+
+(defthm forcing-logic.term-atblp-of-logic.lambda-body
+  ;; I've sometimes had trouble with this rule forcibly picking up the wrong
+  ;; arity table.  I prefer to still force it, and use a :restrict hint when it
+  ;; gets into trouble.
+  (implies (and (force (logic.term-atblp x atbl))
+                (force (logic.lambdap x)))
+           (equal (logic.term-atblp (logic.lambda-body x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-atblp))))
+
+(defthm logic.term-list-atblp-of-strip-firsts-when-logic.term-list-listp
+  (implies (force (and (logic.term-list-list-atblp x atbl)
+                       (all-at-leastp 1 (strip-lens x))))
+           (equal (logic.term-list-atblp (strip-firsts x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-forcing-lookup-of-logic.function-name
+   (implies (and (equal (cdr (lookup key map)) value)
+                 (natp value))
+            (lookup key map)))
+
+ (defthm forcing-lookup-of-logic.function-name
+   ;; I've sometimes had trouble with this rule forcibly picking up the wrong
+   ;; arity table.  I prefer to still force it, and use a :restrict hint when it
+   ;; gets into trouble.
+   ;; Bleh, I'm going to change it to restricted atbls here.
+   (implies (and (syntaxp (equal atbl 'atbl))
+                 (force (logic.term-atblp x atbl))
+                 (force (logic.functionp x)))
+            (equal (lookup (logic.function-name x) atbl)
+                   (cons (logic.function-name x) (len (logic.function-args x)))))
+   :hints(("Goal" :in-theory (e/d (definition-of-logic.term-atblp
+                                    lemma-for-forcing-lookup-of-logic.function-name)
+                                  (forcing-logic.term-list-atblp-of-logic.function-args))))))
+
+(defthm forcing-lookup-of-logic.function-name-free
+  ;; Added syntaxp here too.
+  (implies (and (syntaxp (equal atbl 'atbl))
+                (equal (logic.function-name x) name)
+                (force (logic.term-atblp x atbl))
+                (force (logic.functionp x)))
+           (equal (lookup name atbl)
+                  (cons name (len (logic.function-args x))))))
+
+
+
+(encapsulate
+ ()
+ (defthmd lemma-1-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table
+   (implies (natp (cdr (lookup name atbl)))
+            (equal (consp (lookup name atbl))
+                   t)))
+
+ (defthmd lemma-2-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table
+   (implies (and (submapp atbl atbl2)
+                 (natp (cdr (lookup name atbl))))
+            (equal (lookup name atbl2)
+                   (lookup name atbl)))
+   :hints(("Goal"
+           :in-theory (disable equal-of-lookups-when-submapp)
+           :use ((:instance equal-of-lookups-when-submapp
+                            (a name) (x atbl) (y atbl2))))))
+
+ (defthms-flag
+   :thms ((term logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table
+                (implies (and (submapp atbl atbl2)
+                              (logic.term-atblp x atbl))
+                         (equal (logic.term-atblp x atbl2)
+                                t)))
+          (t logic.term-list-atblp-when-logic.term-list-atblp-in-smaller-arity-table
+             (implies (and (submapp atbl atbl2)
+                           (logic.term-list-atblp x atbl))
+                      (equal (logic.term-list-atblp x atbl2)
+                             t))))
+   :hints(("Goal"
+           :induct (logic.term-induction flag x)
+           :in-theory (e/d (definition-of-logic.term-atblp
+                             lemma-1-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table
+                             lemma-2-for-logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table)
+                           (forcing-logic.term-atblp-of-logic.lambda-body))))))
+
+(defthm logic.term-atblp-when-logic.term-atblp-in-smaller-arity-table-alt
+  (implies (and (logic.term-atblp x atbl)
+                (submapp atbl atbl2))
+           (equal (logic.term-atblp x atbl2)
+                  t)))
+
+(defthm logic.term-list-atblp-when-logic.term-list-atblp-in-smaller-arity-table-alt
+  (implies (and (logic.term-list-atblp x atbl)
+                (submapp atbl atbl2))
+           (equal (logic.term-list-atblp x atbl2)
+                  t)))
+
+
+(defthm logic.term-atblp-when-malformed-cheap
+  (implies (and (not (logic.constantp x))
+                (not (logic.variablep x))
+                (not (logic.functionp x))
+                (not (logic.lambdap x)))
+           (equal (logic.term-atblp x atbl)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 0))
+  :hints(("Goal" :in-theory (enable definition-of-logic.term-atblp))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/top.lisp acl2-6.3/books/milawa/ACL2/logic/top.lisp
--- acl2-6.2/books/milawa/ACL2/logic/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/top.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,70 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(include-book "arities-okp")
+(include-book "appeal-identity")
+(include-book "base-evaluator")
+(include-book "disjoin-formulas")
+(include-book "find-proof")
+(include-book "formula-size")
+(include-book "formulas")
+(include-book "fterm-lists")
+(include-book "functional-axiom")
+(include-book "fuse")
+(include-book "groundp")
+(include-book "negate-formulas")
+(include-book "negate-term")
+(include-book "pand")
+(include-book "patmatch-formula")
+(include-book "patmatch-term")
+(include-book "pequal-list")
+(include-book "piff")
+(include-book "por-list")
+(include-book "proofp")
+(include-book "quote-range")
+(include-book "replace-subterm")
+(include-book "replace-proofs")
+(include-book "substitute-formula")
+(include-book "substitute-term")
+(include-book "subtermp")
+(include-book "termination")
+(include-book "term-formula")
+(include-book "term-order")
+(include-book "terms")
+(include-book "trace-proofp")
+(include-book "translate")
+(include-book "translate-sigma")
+
diff -Nru acl2-6.2/books/milawa/ACL2/logic/trace-proofp.lisp acl2-6.3/books/milawa/ACL2/logic/trace-proofp.lisp
--- acl2-6.2/books/milawa/ACL2/logic/trace-proofp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/trace-proofp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,72 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "proofp")
+
+(defmacro trace-proofp ()
+  ;; Trace proofp, but show only the conclusions and hide the axioms, theorems,
+  ;; and arity table.
+  `(acl2::trace$ (logic.proofp :entry (list (logic.conclusion (car acl2::arglist))))))
+
+(defmacro untrace$ ()
+  `(acl2::untrace$))
+
+(defun collect-axioms-aux (x)
+  ;; Collect the appeals to axioms and theorems used throughout a proof, which
+  ;; might be useful for debugging.
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (cond ((equal (car x) 'axiom)
+             (if (equal (len x) 2)
+                 (cons (list (second x)) nil)
+               (cons (list 'ERROR-AXIOM-NOT-LEN-2) nil)))
+            ((equal (car x) 'theorem)
+             (if (equal (len x) 2)
+                 (cons nil (list (second x)))
+               (cons nil (list 'ERROR-THEOREM-NOT-LEN-2))))
+            (t
+             (let ((car-part (collect-axioms-aux (car x)))
+                   (cdr-part (collect-axioms-aux (cdr x))))
+               (cons (app (car car-part)
+                          (car cdr-part))
+                     (app (cdr car-part)
+                          (cdr cdr-part))))))
+    nil))
+
+(defun collect-axioms (x)
+  (declare (xargs :mode :program))
+  (let ((data (collect-axioms-aux x)))
+    (list (cons 'axioms (remove-duplicates (car data)))
+          (cons 'theorems (remove-duplicates (cdr data))))))
diff -Nru acl2-6.2/books/milawa/ACL2/logic/translate-sigma.lisp acl2-6.3/books/milawa/ACL2/logic/translate-sigma.lisp
--- acl2-6.2/books/milawa/ACL2/logic/translate-sigma.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/translate-sigma.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,116 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "translate")
+(include-book "substitute-term")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund logic.translate-sigma (x)
+  ;; We should be given a true-list of (var term) 2-tuples, where each var is a
+  ;; variable symbol and each term is an untranslated term.  We translate each
+  ;; term and call the resulting (var . translated term) pairs the answer.
+  ;;
+  ;; We return (t . answer) if all the terms are successfully translated, or
+  ;; nil otherwise.  If we return nil, a message will be printed indicating
+  ;; where the error occurs.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (tuplep 2 (car x))
+           (let* ((var        (first (car x)))
+                  (term       (second (car x)))
+                  (trans-term (logic.translate term)))
+             (and (logic.variablep var)
+                  trans-term
+                  (let ((others (logic.translate-sigma (cdr x))))
+                    (and others
+                         (let* ((others-answer (cdr others))
+                                (answer        (cons (cons var trans-term) others-answer)))
+                           (cons t answer)))))))
+    (if (equal x nil)
+        (cons t nil)
+      nil)))
+
+(defthm logic.sigmap-of-cdr-of-logic.translate-sigma
+  (equal (logic.sigmap (cdr (logic.translate-sigma x)))
+         t)
+  :hints(("Goal" :in-theory (enable logic.translate-sigma))))
+
+
+(defund logic.translate-sigma-list (x)
+  ;; We should be given a true-list of translatable sigmas.  We translate them
+  ;; all, producing answer = (sigma1 ... sigmaN), and return (t . answer) upon
+  ;; success.  If any sigma is not translatable, we return nil.
+  (if (consp x)
+      (let ((part1 (logic.translate-sigma (car x))))
+        (and part1
+             (let ((part2 (logic.translate-sigma-list (cdr x))))
+               (and part2
+                    (let ((answer (cons (cdr part1) (cdr part2))))
+                      (cons t answer))))))
+    (if (equal x nil)
+        (cons t nil)
+      nil)))
+
+(defthm logic.sigma-listp-of-cdr-of-logic.translate-sigma-list
+  (equal (logic.sigma-listp (cdr (logic.translate-sigma-list x)))
+         t)
+  :hints(("Goal" :in-theory (enable logic.translate-sigma-list))))
+
+
+
+(defund logic.translate-sigma-list-list (x)
+  ;; We should be given a true-list of translatable sigma lists.  We translate
+  ;; them all, producing answer = (sigmas1 ... sigmasN), and return (t
+  ;; . answer) upon success.  If any sigma is not translatable, we return nil.
+  (if (consp x)
+      (let ((part1 (logic.translate-sigma-list (car x))))
+        (and part1
+             (let ((part2 (logic.translate-sigma-list-list (cdr x))))
+               (and part2
+                    (let ((answer (cons (cdr part1) (cdr part2))))
+                      (cons t answer))))))
+    (if (equal x nil)
+        (cons t nil)
+      nil)))
+
+(defthm logic.sigma-list-listp-of-cdr-of-logic.translate-sigma-list-list
+  (equal (logic.sigma-list-listp (cdr (logic.translate-sigma-list-list x)))
+         t)
+  :hints(("Goal" :in-theory (enable logic.translate-sigma-list-list))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/logic/translate.lisp acl2-6.3/books/milawa/ACL2/logic/translate.lisp
--- acl2-6.2/books/milawa/ACL2/logic/translate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/logic/translate.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1062 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "terms")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund logic.translate-and-term (args)
+  ;; Args are a list of terms.  We build an if-expression corresponding to the
+  ;; conjunction of these terms, lazily evaluated in order.  The result of this
+  ;; if expression will be the value of the last argument, if all arguments are
+  ;; non-nil, or nil otherwise.
+  ;;
+  ;; Examples
+  ;;
+  ;;   (AND) => T
+  ;;   (AND X1) => X1
+  ;;   (AND X1 X2) => (IF X1 X2 'NIL)
+  ;;   (AND X1 X2 X3) => (IF X1 (IF X2 X3 'NIL) 'NIL)
+  ;;   ...
+  (declare (xargs :guard (logic.term-listp args)))
+  (if (consp args)
+      (if (consp (cdr args))
+          ;; At least two arguments.
+          (logic.function 'if (list (first args)
+                                    (logic.translate-and-term (cdr args))
+                                    ''nil))
+        ;; Only a single argument.
+        (first args))
+    ;; No arguments.
+    ''t))
+
+(defthm logic.termp-of-logic.translate-and-term
+  (implies (force (logic.term-listp args))
+           (equal (logic.termp (logic.translate-and-term args))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.translate-and-term))))
+
+
+
+(defund logic.translate-let-term (vars terms body)
+  ;; Body is a term, vars is a list of variables, and terms is a list of terms
+  ;; with equal length to vars.  We want to translate:
+  ;;
+  ;;  (let ((var1 term1) (var2 term2) ... (varN termN)) body)
+  ;;
+  ;; into a lambda term, i.e.,
+  ;;
+  ;;  ((lambda (var1 ... varN) body) term1 ... termN)
+  ;;
+  ;; Except that, unlike lambdas, we don't require every variable used in body
+  ;; to be bound by the let variables, so we need to "fill in" these extra
+  ;; variables when we create the lambda.  Hence, the actual lambda we will
+  ;; create is:
+  ;;
+  ;;  ((lambda (extra1 ... extraM var1 ... varN) body)
+  ;;   extra1 ... extraM term1 ... termN)
+  ;;
+  ;; Where extra1, ..., extraM are the variables which occur in body other than
+  ;; var1, ..., varN.  We just bind each of these variables to themselves in
+  ;; the lambda we produce.
+  (declare (xargs :guard (and (true-listp vars)
+                              (logic.variable-listp vars)
+                              (uniquep vars)
+                              (logic.termp body)
+                              (true-listp terms)
+                              (logic.term-listp terms)
+                              (same-lengthp vars terms))))
+  (let* ((body-vars (remove-duplicates (logic.term-vars body)))
+         (id-vars   (sort-symbols (difference body-vars vars)))
+         (formals   (app id-vars vars))
+         (actuals   (app id-vars terms)))
+    (logic.lambda formals body actuals)))
+
+(defthmd lemma-for-logic.termp-of-logic.translate-let-term
+  (equal (subsetp x (app (sort-symbols (difference (remove-duplicates x) y)) y))
+         t)
+  :hints(("Goal"
+          :use ((:instance subsetp-badguy-membership-property
+                           (x x)
+                           (y (app (sort-symbols (difference (remove-duplicates x) y))
+                                   y)))))))
+
+(defthm logic.termp-of-logic.translate-let-term
+   (implies (and (force (true-listp vars))
+                 (force (logic.variable-listp vars))
+                 (force (uniquep vars))
+                 (force (logic.termp body))
+                 (force (true-listp terms))
+                 (force (logic.term-listp terms))
+                 (force (equal (len vars) (len terms))))
+            (equal (logic.termp (logic.translate-let-term vars terms body))
+                   t))
+   :hints(("Goal"
+           :in-theory (enable logic.translate-let-term
+                              lemma-for-logic.termp-of-logic.translate-let-term))))
+
+
+
+; SPECIAL ENHANCEMENT FOR MLISP
+;
+; As of my dissertation, logic.translate-or-term built its IF-expression in a
+; relatively simple way.  In particular, we had:
+;
+;   (OR) => NIL
+;   (OR X1) => X1
+;   (OR X1 X2) => (IF X1 X1 X2)
+;   (OR X1 X2 X3) => (IF X1 X1 (IF X2 X2 X3))
+;   ...
+;
+; However, when we tried to port the system to MLISP, we wanted to avoid this
+; naive expansion to avoid recomputation when X1 is expensive to compute.  The
+; basic idea is to now interpret:
+;
+;   (OR X1 X2) => (LET ((SPECIAL-VAR-FOR-OR X1))
+;                   (IF SPECIAL-VAR-FOR-OR
+;                       SPECIAL-VAR-FOR-OR
+;                     ...))
+;
+; For this to be sound, we need to ensure that SPECIAL-VAR-FOR-OR is not free
+; within the dots.  If this is not the case, we default to the previous
+; behavior, which is sub-optimal but sound.  We also print a warning message in
+; this case.
+
+(defund logic.translate-or-term (args)
+  ;; Args are a list of terms.  We build an if-expression corresponding to the
+  ;; disjunction of these terms, lazily evaluated in order.  The result of this
+  ;; if expression is the value of the first non-nil argument, or nil if all of
+  ;; the arguments are nil.
+  (declare (xargs :guard (logic.term-listp args)))
+  (if (consp args)
+      (if (consp (cdr args))
+          (let* ((else-term (logic.translate-or-term (cdr args)))
+                 (cheap-p   (or (logic.variablep (car args))
+                                (logic.constantp (car args)))))
+            (if (or cheap-p
+                    (memberp 'special-var-for-or (logic.term-vars else-term)))
+                ;; Use (IF X1 X1 ...) style expansion
+                (ACL2::prog2$
+                 (or cheap-p
+                     (ACL2::cw "TRANSLATE WARNING: using suboptimal 'or' translation.~%"))
+                 (logic.function 'if (list (car args) (car args) else-term)))
+              ;; Use (LET ((SPECIAL-VAR-FOR-OR X1))
+              ;;       (IF SPECIAL-VAR-FOR-OR
+              ;;           SPECIAL-VAR-FOR-OR
+              ;;         ...))
+              (logic.translate-let-term (list 'special-var-for-or)
+                                        (list (car args))
+                                        (logic.function 'if (list 'special-var-for-or
+                                                                  'special-var-for-or
+                                                                  else-term)))))
+        ;; Only a single argument.
+        (first args))
+    ;; No arguments.
+    ''nil))
+
+
+(defthm logic.termp-of-logic.translate-or-term
+  (implies (force (logic.term-listp args))
+           (equal (logic.termp (logic.translate-or-term args))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.translate-or-term))))
+
+
+
+
+(defund logic.translate-list-term (args)
+  ;; Args is a list of terms.  We build a term which corresponds to the expansion
+  ;; of (list arg1 ... argN) into calls of cons.
+  ;;
+  ;; Examples
+  ;;
+  ;;   (LIST) => NIL
+  ;;   (LIST X1) => (CONS X1 NIL)
+  ;;   (LIST X1 X2) => (CONS X1 (CONS X2 NIL))
+  ;;   (LIST X1 X2 X3) => (CONS X1 (CONS X2 (CONS X3 NIL)))
+  ;;   ...
+  (declare (xargs :guard (logic.term-listp args)))
+  (if (consp args)
+      (logic.function 'cons (list (car args)
+                                  (logic.translate-list-term (cdr args))))
+    ''nil))
+
+(defthm logic.termp-of-logic.translate-list-term
+  (implies (force (logic.term-listp args))
+           (equal (logic.termp (logic.translate-list-term args))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.translate-list-term))))
+
+
+
+
+(defund logic.translate-cond-term (tests thens)
+  ;; Tests and thens are equal-length lists of terms.  We build an
+  ;; if-expression of the form, If TEST<1>, then THEN<1>, else if TEST<2>, then
+  ;; THEN<2>, ..., otherwise NIL.
+  ;;
+  ;; (COND) => NIL
+  ;;
+  ;; (COND (TEST1 THEN1)) =>
+  ;;  (IF TEST1 THEN1 NIL)
+  ;;
+  ;; (COND (TEST1 THEN1) (TEST2 THEN2)) =>
+  ;;  (IF TEST1 THEN1 (IF TEST2 THEN2 NIL))
+  ;;
+  ;; (COND (TEST1 THEN1) (TEST2 THEN2) (TEST3 THEN3)) =>
+  ;;  (IF TEST1 THEN1 (IF TEST2 THEN2 (IF TEST3 THEN3 NIL)))
+  ;;
+  ;; ...
+  (declare (xargs :guard (and (logic.term-listp tests)
+                              (logic.term-listp thens)
+                              (equal (len tests) (len thens)))))
+  (if (consp tests)
+      (let ((test1 (car tests))
+            (then1 (car thens)))
+        ;; Previously we did an optimization, where if test1 is ''t then we just
+        ;; use then1.  But now we'll go ahead and construct the if anyway, because
+        ;; that makes this simpler and lets us explain cond more simply.
+        ;(if (equal test1 ''t)
+            ;; Optimization: if we encounter (t foo) as a pair, we know the
+            ;; test will be true, so we just construct the term foo.
+         ;   then1
+          ;; Otherwise, we construct the whole if term.
+        (logic.function 'if (list test1
+                                  then1
+                                  (logic.translate-cond-term (cdr tests) (cdr thens)))))
+    ''nil))
+
+(defthm logic.termp-of-logic.translate-cond-term
+  (implies (and (force (logic.term-listp tests))
+                (force (logic.term-listp thens))
+                (force (equal (len tests) (len thens))))
+           (equal (logic.termp (logic.translate-cond-term thens tests))
+                  t))
+  :hints(("Goal"
+          :induct (cdr-cdr-induction thens tests)
+          :in-theory (enable logic.translate-cond-term))))
+
+
+
+(defund logic.translate-let*-term (vars terms body)
+  ;; Body is a term, vars is a list of variables, and terms is a list of terms
+  ;; with equal length to vars.  We want to translate:
+  ;;
+  ;;   (let* ((var1 term1) (var2 term2) ... (varN termN)) body)
+  ;;
+  ;; into
+  ;;
+  ;;   (let ((var1 term1))
+  ;;     (let* ((var2 term2) ... (varN termN)) body))
+  (declare (xargs :guard (and (true-listp vars)
+                              (logic.variable-listp vars)
+                              (true-listp terms)
+                              (logic.term-listp terms)
+                              (same-lengthp vars terms)
+                              (logic.termp body))
+                  :verify-guards nil))
+  (if (consp vars)
+      (logic.translate-let-term
+       (list (car vars))
+       (list (car terms))
+       (logic.translate-let*-term (cdr vars)
+                                  (cdr terms)
+                                  body))
+    body))
+
+(defthm logic.termp-of-logic.translate-let*-term
+   (implies (and (force (true-listp vars))
+                 (force (logic.variable-listp vars))
+                 (force (logic.termp body))
+                 (force (true-listp terms))
+                 (force (logic.term-listp terms))
+                 (force (equal (len vars) (len terms))))
+            (equal (logic.termp (logic.translate-let*-term vars terms body))
+                   t))
+   :hints(("Goal" :in-theory (enable logic.translate-let*-term))))
+
+(verify-guards logic.translate-let*-term)
+
+
+
+
+
+;; (defund logic.translate-lambda-term (vars body terms)
+;;   ;; Body is a term; vars is a list of variables; terms is a list of terms with
+;;   ;; equal length to vars.
+;;   ;;
+;;   ;; We are to create the lambda term which is essentially:
+;;   ;;
+;;   ;;   ((lambda vars body) terms)
+;;   ;;
+;;   ;; But we permit vars to not include all of the variables mentioned in the
+;;   ;; body.  To fix this, we will actually write something like this instead:
+;;   ;;
+;;   ;;   ((lambda (var1 ... varN free1 ... freeM) body)
+;;   ;;    (act1 ... actN free1 ... freeM))
+;;   ;;
+;;   ;; Where free1 ... freeM are the free variables in the body other than var1
+;;   ;; ... varN.  In other words, we bind miscellaneous free variables to
+;;   ;; themselves.
+;;   (declare (xargs :guard (and (true-listp vars)
+;;                               (logic.variable-listp vars)
+;;                               (uniquep vars)
+;;                               (logic.termp body)
+;;                               (true-listp terms)
+;;                               (logic.term-listp terms)
+;;                               (same-lengthp vars terms))))
+;;   (let* ((body-vars     (remove-duplicates (logic.term-vars body)))
+;;          (identity-vars (fast-difference$ body-vars vars nil))
+;;          (formals       (revappend identity-vars vars))
+;;          (actuals       (revappend identity-vars terms)))
+;;     (logic.lambda formals body actuals)))
+
+;; (encapsulate
+;;  ()
+;;  (local (defthm lemma
+;;           (subsetp (logic.term-vars body)
+;;                    (app (difference (remove-duplicates (logic.term-vars body)) vars)
+;;                         vars))
+;;           :hints(("goal"
+;;                   :use ((:instance subsetp-badguy-membership-property
+;;                                    (x (logic.term-vars body))
+;;                                    (y (app (difference
+;;                                             (remove-duplicates (logic.term-vars body))
+;;                                             vars)
+;;                                            vars))))))))
+
+;;  (defthm logic.termp-of-logic.translate-lambda-term
+;;    (implies (and (force (true-listp vars))
+;;                  (force (logic.variable-listp vars))
+;;                  (force (uniquep vars))
+;;                  (force (logic.termp body))
+;;                  (force (true-listp actuals))
+;;                  (force (logic.term-listp actuals))
+;;                  (force (equal (len vars) (len actuals))))
+;;             (equal (logic.termp (logic.translate-lambda-term vars body actuals))
+;;                    t))
+;;    :hints(("Goal" :in-theory (enable logic.translate-lambda-term)))))
+
+
+
+
+
+(defun logic.flag-translate (flag x)
+  ;; X is an "untranslated" term(-list), which are the same as terms except:
+  ;;
+  ;;   1. In untranslated terms, numbers, keyword symbols, and the symbols t and
+  ;;      nil can be used as constants without quoting them.
+  ;;
+  ;;   2. In untranslated terms, the abbreviations first, second, third, fourth,
+  ;;      fifth, and, or, list, cond, let, and let* may be used.
+  ;;
+  ;; Given an untranslated term(-list), we insert these missing quotes and
+  ;; replace the abbreviations with their expansions.
+  ;;
+  ;; In the term case, we either return a genuine logic.termp corresponding to x
+  ;; (when x is valid), or nil (when x is invalid).  For the list case, we return
+  ;; (successp . x'), where x' are the translated terms if successp is true.
+  (declare (xargs :guard (or (equal flag 'term)
+                             (equal flag 'list))
+                  :verify-guards nil
+                  ;; yucky huge horrible thing, but oh well.  skip case for ACL2
+                  ;; compatibility.
+                  :export (if (equal flag 'term)
+                              (cond ((natp x)
+                                     ;; Automatically quote numbers.
+                                     (list 'quote x))
+                                    ((symbolp x)
+                                     ;; Automatically quote t and nil, leave other variables alone.
+                                     (if (or (equal x nil)
+                                             (equal x t))
+                                         (list 'quote x)
+                                       x))
+                                    ((symbolp (car x))
+                                     (let ((fn (car x)))
+                                       (cond ((equal fn 'quote)
+                                              ;; Keep proper constants; other uses of quote are invalid.
+                                              (if (tuplep 2 x)
+                                                  x
+                                                nil))
+                                             ((memberp fn '(first second third fourth fifth))
+                                              ;; Translate away "first", "second", "third', "fourth", and "fifth"
+                                              (and (tuplep 2 x)
+                                                   (let ((arg (logic.flag-translate 'term (second x))))
+                                                     (and arg
+                                                          (let* ((1cdr (logic.function 'cdr (list arg)))
+                                                                 (2cdr (logic.function 'cdr (list 1cdr)))
+                                                                 (3cdr (logic.function 'cdr (list 2cdr)))
+                                                                 (4cdr (logic.function 'cdr (list 3cdr))))
+                                                            (logic.function
+                                                             'car
+                                                             (list (cond ((equal fn 'first)  arg)
+                                                                         ((equal fn 'second) 1cdr)
+                                                                         ((equal fn 'third)  2cdr)
+                                                                         ((equal fn 'fourth) 3cdr)
+                                                                         (t                  4cdr)))))))))
+
+                                             ((memberp fn '(and or list))
+                                              ;; Translate away "and", "or", and "list"
+                                              (and (true-listp (cdr x))
+                                                   (let ((arguments+ (logic.flag-translate 'list (cdr x))))
+                                                     (and (car arguments+)
+                                                          (cond ((equal fn 'and)
+                                                                 (logic.translate-and-term (cdr arguments+)))
+                                                                ((equal fn 'or)
+                                                                 (logic.translate-or-term (cdr arguments+)))
+                                                                (t
+                                                                 (logic.translate-list-term (cdr arguments+))))))))
+                                             ((equal fn 'cond)
+                                              ;; Translate away "cond"
+                                              (and (true-listp (cdr x))
+                                                   (tuple-listp 2 (cdr x))
+                                                   (let* ((tests  (strip-firsts (cdr x)))
+                                                          (thens  (strip-seconds (cdr x)))
+                                                          (tests+ (logic.flag-translate 'list tests))
+                                                          (thens+ (logic.flag-translate 'list thens)))
+                                                     (and (car tests+)
+                                                          (car thens+)
+                                                          (logic.translate-cond-term (cdr tests+)
+                                                                                     (cdr thens+))))))
+
+                                             ((memberp fn '(let let*))
+                                              ;; Translate away "let" and "let*"
+                                              (and (tuplep 3 x)
+                                                   (let ((pairs (second x))
+                                                         (body  (logic.flag-translate 'term (third x))))
+                                                     (and body
+                                                          (true-listp pairs)
+                                                          (tuple-listp 2 pairs)
+                                                          (let* ((vars   (strip-firsts pairs))
+                                                                 (terms  (strip-seconds pairs))
+                                                                 (terms+ (logic.flag-translate 'list terms)))
+                                                            (and (car terms+)
+                                                                 (logic.variable-listp vars)
+                                                                 (cond ((equal fn 'let)
+                                                                        (and (uniquep vars)
+                                                                             (logic.translate-let-term vars
+                                                                                                       (cdr terms+)
+                                                                                                       body)))
+                                                                       (t (logic.translate-let*-term vars
+                                                                                                     (cdr terms+)
+                                                                                                     body)))))))))
+                                             ((logic.function-namep fn)
+                                              ;; Recursively translate the arguments to functions.
+                                              (and (true-listp (cdr x))
+                                                   (let ((arguments+ (logic.flag-translate 'list (cdr x))))
+                                                     (and (car arguments+)
+                                                          (logic.function fn (cdr arguments+))))))
+                                             (t
+                                              ;; Anything else is invalid.
+                                              nil))))
+
+
+                                    ((and (tuplep 3 (car x))
+                                          (true-listp (cdr x)))
+                                     ;; Lambdas are the only other valid possibility.
+                                     (let* ((lambda-symbol (first (car x)))
+                                            (vars          (second (car x)))
+                                            (body          (third (car x)))
+                                            (new-body      (logic.flag-translate 'term body))
+                                            (actuals+      (logic.flag-translate 'list (cdr x))))
+                                       (and (equal lambda-symbol 'lambda)
+                                            (true-listp vars)
+                                            (logic.variable-listp vars)
+                                            (uniquep vars)
+                                            new-body
+                                            (subsetp (logic.term-vars new-body) vars)
+                                            (car actuals+)
+                                            (equal (len vars) (len (cdr actuals+)))
+                                            (logic.lambda vars new-body (cdr actuals+)))))
+
+                                    (t
+                                     ;; Nothing else is a valid untranslated term.
+                                     nil))
+                            ;; List case.
+                            (if (consp x)
+                                (let ((first (logic.flag-translate 'term (car x)))
+                                      (rest  (logic.flag-translate 'list (cdr x))))
+                                  (if (and first (car rest))
+                                      (cons t (cons first (cdr rest)))
+                                    (cons nil nil)))
+                              (cons t nil)))))
+  (if (equal flag 'term)
+      (cond ((natp x)
+             ;; Automatically quote numbers.
+             (list 'quote x))
+            ((symbolp x)
+             ;; Automatically quote t and nil, leave other variables alone.
+             (if (or (equal x nil)
+                     (equal x t))
+                 (list 'quote x)
+               x))
+            #+acl2
+            ((not (consp x))
+             ;; HACK: Special case for ACL2 compatibility; we shouldn't need this
+             ;; case in Milawa.
+             nil)
+            ((symbolp (car x))
+             (let ((fn (car x)))
+               (cond ((equal fn 'quote)
+                      ;; Keep proper constants; other uses of quote are invalid.
+                      (if (tuplep 2 x)
+                          x
+                        nil))
+                     ((memberp fn '(first second third fourth fifth))
+                      ;; Translate away "first", "second", "third', "fourth", and "fifth"
+                      (and (tuplep 2 x)
+                           (let ((arg (logic.flag-translate 'term (second x))))
+                             (and arg
+                                  (let* ((1cdr (logic.function 'cdr (list arg)))
+                                         (2cdr (logic.function 'cdr (list 1cdr)))
+                                         (3cdr (logic.function 'cdr (list 2cdr)))
+                                         (4cdr (logic.function 'cdr (list 3cdr))))
+                                    (logic.function
+                                     'car
+                                     (list (cond ((equal fn 'first)  arg)
+                                                 ((equal fn 'second) 1cdr)
+                                                 ((equal fn 'third)  2cdr)
+                                                 ((equal fn 'fourth) 3cdr)
+                                                 (t                  4cdr)))))))))
+
+                     ((memberp fn '(and or list))
+                      ;; Translate away "and", "or", and "list"
+                      (and (true-listp (cdr x))
+                           (let ((arguments+ (logic.flag-translate 'list (cdr x))))
+                             (and (car arguments+)
+                                  (cond ((equal fn 'and)
+                                         (logic.translate-and-term (cdr arguments+)))
+                                        ((equal fn 'or)
+                                         (logic.translate-or-term (cdr arguments+)))
+                                        (t
+                                         (logic.translate-list-term (cdr arguments+))))))))
+                     ((equal fn 'cond)
+                      ;; Translate away "cond"
+                      (and (true-listp (cdr x))
+                           (tuple-listp 2 (cdr x))
+                           (let* ((tests  (strip-firsts (cdr x)))
+                                  (thens  (strip-seconds (cdr x)))
+                                  (tests+ (logic.flag-translate 'list tests))
+                                  (thens+ (logic.flag-translate 'list thens)))
+                             (and (car tests+)
+                                  (car thens+)
+                                  (logic.translate-cond-term (cdr tests+)
+                                                             (cdr thens+))))))
+
+                     ((memberp fn '(let let*))
+                      ;; Translate away "let" and "let*"
+                      (and (tuplep 3 x)
+                           (let ((pairs (second x))
+                                 (body  (logic.flag-translate 'term (third x))))
+                             (and body
+                                  (true-listp pairs)
+                                  (tuple-listp 2 pairs)
+                                  (let* ((vars   (strip-firsts pairs))
+                                         (terms  (strip-seconds pairs))
+                                         (terms+ (logic.flag-translate 'list terms)))
+                                    (and (car terms+)
+                                         (logic.variable-listp vars)
+                                         (cond ((equal fn 'let)
+                                                (and (uniquep vars)
+                                                     (logic.translate-let-term vars
+                                                                               (cdr terms+)
+                                                                               body)))
+                                               (t (logic.translate-let*-term vars
+                                                                             (cdr terms+)
+                                                                             body)))))))))
+                     ((logic.function-namep fn)
+                      ;; Recursively translate the arguments to functions.
+                      (and (true-listp (cdr x))
+                           (let ((arguments+ (logic.flag-translate 'list (cdr x))))
+                             (and (car arguments+)
+                                  (logic.function fn (cdr arguments+))))))
+                     (t
+                      ;; Anything else is invalid.
+                      nil))))
+
+
+             ((and (tuplep 3 (car x))
+                   (true-listp (cdr x)))
+              ;; Lambdas are the only other valid possibility.
+              (let* ((lambda-symbol (first (car x)))
+                     (vars          (second (car x)))
+                     (body          (third (car x)))
+                     (new-body      (logic.flag-translate 'term body))
+                     (actuals+      (logic.flag-translate 'list (cdr x))))
+                (and (equal lambda-symbol 'lambda)
+                     (true-listp vars)
+                     (logic.variable-listp vars)
+                     (uniquep vars)
+                     new-body
+                     (subsetp (logic.term-vars new-body) vars)
+                     (car actuals+)
+                     (equal (len vars) (len (cdr actuals+)))
+                     (logic.lambda vars new-body (cdr actuals+)))))
+
+            (t
+             ;; Nothing else is a valid untranslated term.
+             nil))
+    ;; List case.
+   (if (consp x)
+       (let ((first (logic.flag-translate 'term (car x)))
+             (rest  (logic.flag-translate 'list (cdr x))))
+         (if (and first (car rest))
+             (cons t (cons first (cdr rest)))
+           (cons nil nil)))
+     (cons t nil))))
+
+(definlined logic.translate (x)
+  (declare (xargs :guard t :verify-guards nil))
+  (logic.flag-translate 'term x))
+
+(definlined logic.translate-list (x)
+  (declare (xargs :guard t :verify-guards nil))
+  (logic.flag-translate 'list x))
+
+(defthmd definition-of-logic.translate
+  (equal (logic.translate x)
+         (cond ((natp x)
+                (list 'quote x))
+               ((symbolp x)
+                (if (or (equal x nil)
+                        (equal x t))
+                    (list 'quote x)
+                  x))
+               ((not (consp x))
+                nil)
+               ((symbolp (car x))
+                (let ((fn (car x)))
+                  (cond ((equal fn 'quote)
+                         (if (tuplep 2 x)
+                             x
+                           nil))
+                        ((memberp fn '(first second third fourth fifth))
+                         (and (tuplep 2 x)
+                              (let ((arg (logic.translate (second x))))
+                                (and arg
+                                     (let* ((1cdr (logic.function 'cdr (list arg)))
+                                            (2cdr (logic.function 'cdr (list 1cdr)))
+                                            (3cdr (logic.function 'cdr (list 2cdr)))
+                                            (4cdr (logic.function 'cdr (list 3cdr))))
+                                       (logic.function 'car (list (cond ((equal fn 'first)  arg)
+                                                                        ((equal fn 'second) 1cdr)
+                                                                        ((equal fn 'third)  2cdr)
+                                                                        ((equal fn 'fourth) 3cdr)
+                                                                        (t                  4cdr)))))))))
+                        ((memberp fn '(and or list))
+                         (and (true-listp (cdr x))
+                              (let ((arguments+ (logic.translate-list (cdr x))))
+                                (and (car arguments+)
+                                     (cond ((equal fn 'and) (logic.translate-and-term (cdr arguments+)))
+                                           ((equal fn 'or)  (logic.translate-or-term (cdr arguments+)))
+                                           (t               (logic.translate-list-term (cdr arguments+))))))))
+                        ((equal fn 'cond)
+                         (and (true-listp (cdr x))
+                              (tuple-listp 2 (cdr x))
+                              (let* ((tests  (strip-firsts (cdr x)))
+                                     (thens  (strip-seconds (cdr x)))
+                                     (tests+ (logic.translate-list tests))
+                                     (thens+ (logic.translate-list thens)))
+                                (and (car tests+)
+                                     (car thens+)
+                                     (logic.translate-cond-term (cdr tests+) (cdr thens+))))))
+                        ((memberp fn '(let let*))
+                         (and (tuplep 3 x)
+                              (let ((pairs (second x))
+                                    (body  (logic.translate (third x))))
+                                (and body
+                                     (true-listp pairs)
+                                     (tuple-listp 2 pairs)
+                                     (let* ((vars   (strip-firsts pairs))
+                                            (terms  (strip-seconds pairs))
+                                            (terms+ (logic.translate-list terms)))
+                                       (and (car terms+)
+                                            (logic.variable-listp vars)
+                                            (cond ((equal fn 'let)
+                                                   (and (uniquep vars)
+                                                        (logic.translate-let-term vars (cdr terms+) body)))
+                                                  (t (logic.translate-let*-term vars (cdr terms+) body)))))))))
+                        ((logic.function-namep fn)
+                         (and (true-listp (cdr x))
+                              (let ((arguments+ (logic.translate-list (cdr x))))
+                                (and (car arguments+)
+                                     (logic.function fn (cdr arguments+))))))
+                        (t nil))))
+            ((and (tuplep 3 (car x))
+                  (true-listp (cdr x)))
+             (let* ((lambda-symbol (first (car x)))
+                    (vars          (second (car x)))
+                    (body          (third (car x)))
+                    (new-body      (logic.translate body))
+                    (actuals+      (logic.translate-list (cdr x))))
+               (and (equal lambda-symbol 'lambda)
+                    (true-listp vars)
+                    (logic.variable-listp vars)
+                    (uniquep vars)
+                    new-body
+                    (subsetp (logic.term-vars new-body) vars)
+                    (car actuals+)
+                    (equal (len vars) (len (cdr actuals+)))
+                    (logic.lambda vars new-body (cdr actuals+)))))
+            (t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (e/d (logic.translate logic.translate-list)
+                                 (forcing-true-listp-of-logic.function-args
+                                  equal-of-cons-rewrite
+                                  equal-of-logic.function-rewrite)))))
+
+(defthmd definition-of-logic.translate-list
+  (equal (logic.translate-list x)
+         (if (consp x)
+             (let ((first (logic.translate (car x)))
+                   (rest  (logic.translate-list (cdr x))))
+               (if (and first (car rest))
+                   (cons t (cons first (cdr rest)))
+                 (cons nil nil)))
+           (cons t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logic.translate logic.translate-list))))
+
+(defthm logic.flag-translate-of-term-removal
+  (equal (logic.flag-translate 'term x)
+         (logic.translate x))
+  :hints(("Goal" :in-theory (enable logic.translate))))
+
+(defthm logic.flag-translate-of-list-removal
+  (equal (logic.flag-translate 'list x)
+         (logic.translate-list x))
+  :hints(("Goal" :in-theory (enable logic.translate-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.translate))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition logic.translate-list))))
+
+(defthm logic.translate-list-when-not-consp
+  (implies (not (consp x))
+           (equal (logic.translate-list x)
+                  (cons t nil)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.translate-list))))
+
+(defthm logic.translate-list-of-cons
+  (equal (logic.translate-list (cons a x))
+         (if (and (logic.translate a) (car (logic.translate-list x)))
+             (cons t (cons (logic.translate a) (cdr (logic.translate-list x))))
+           (cons nil nil)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.translate-list))))
+
+(defthm consp-of-logic.translate-list
+  (equal (consp (logic.translate-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-cdr-of-logic.translate-list
+  (implies (car (logic.translate-list x))
+           (equal (len (cdr (logic.translate-list x)))
+                  (len x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-cdr-of-logic.translate-list
+  (true-listp (cdr (logic.translate-list x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm booleanp-of-car-of-logic.translate-list
+  (equal (booleanp (car (logic.translate-list x)))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(encapsulate
+ ()
+ (local (defthm logic.termp-when-symbolp-cheap
+          (implies (symbolp x)
+                   (equal (logic.termp x)
+                          (and (not (equal x nil))
+                               (not (equal x t)))))
+          :rule-classes ((:rewrite :backchain-limit-lst 0))
+          :hints(("Goal" :in-theory (enable logic.variablep
+                                            definition-of-logic.termp)))))
+
+ (local (defthm logic.termp-of-cons-quote
+          (equal (logic.termp (cons 'quote x))
+                 (tuplep 1 x))
+          :hints(("Goal" :in-theory (enable definition-of-logic.termp
+                                            logic.constantp
+                                            logic.variablep)))))
+
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (implies (logic.translate x)
+                       (logic.termp (logic.translate x)))
+            (logic.term-listp (cdr (logic.translate-list x))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :in-theory (enable definition-of-logic.translate)
+                  :induct (logic.flag-translate flag x)))))
+
+ (defthm logic.termp-of-logic.translate
+   (implies (logic.translate x)
+            (equal (logic.termp (logic.translate x))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm logic.term-listp-of-cdr-of-logic.translate-list
+   (equal (logic.term-listp (cdr (logic.translate-list x)))
+          t)
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+
+
+(encapsulate
+ ()
+ (local (defthm natp-when-logic.lambdap
+          (implies (logic.lambdap x)
+                   (equal (natp x)
+                          nil))
+          :hints(("Goal" :in-theory (enable logic.lambdap)))))
+
+ (local (defthm car-when-logic.lambdap
+          (implies (and (logic.lambdap x)
+                        (force (logic.termp x)))
+                   (equal (car x)
+                          (list 'lambda
+                                (logic.lambda-formals x)
+                                (logic.lambda-body x))))
+          :hints(("Goal" :in-theory (enable logic.lambdap
+                                            logic.lambda-formals
+                                            logic.lambda-body
+                                            definition-of-logic.termp)))))
+
+ (local (defthm cdr-when-logic.lambdap
+          (implies (logic.lambdap x)
+                   (equal (cdr x)
+                          (logic.lambda-actuals x)))
+          :hints(("Goal" :in-theory (enable logic.lambdap
+                                            logic.lambda-actuals
+                                            definition-of-logic.termp)))))
+
+ (local (defthm forcing-equal-of-logic.lambda-rewrite
+          (implies (force (logic.termp x))
+                   (equal (equal (logic.lambda formals body actuals) x)
+                          (and (logic.lambdap x)
+                               (equal (logic.lambda-formals x) formals)
+                               (equal (logic.lambda-body x) body)
+                               (equal (logic.lambda-actuals x) actuals))))))
+
+ (local (defthm natp-when-logic.functionp
+          (implies (logic.functionp x)
+                   (equal (natp x)
+                          nil))
+          :hints(("Goal" :in-theory (enable logic.functionp)))))
+
+ (local (defthm car-when-logic.functionp
+          (implies (logic.functionp x)
+                   (equal (car x)
+                          (logic.function-name x)))
+          :hints(("Goal" :in-theory (enable logic.function-name logic.functionp)))))
+
+ (local (defthm cdr-when-logic.functionp
+          (implies (logic.functionp x)
+                   (equal (cdr x)
+                          (logic.function-args x)))
+          :hints(("Goal" :in-theory (enable logic.function-args logic.functionp)))))
+
+ (local (defthm equal-of-logic.function-name-when-not-function-namep
+          (implies (and (not (logic.function-namep name))
+                        (force (logic.termp x))
+                        (force (logic.functionp x)))
+                   (equal (equal (logic.function-name x) name)
+                          nil))))
+
+ (local (defthm lemma
+          (if (equal flag 'term)
+              (implies (logic.termp x)
+                       (equal (logic.translate x) x))
+            (implies (logic.term-listp x)
+                     (and (car (logic.translate-list x))
+                          (equal (cdr (logic.translate-list x))
+                                 (list-fix x)))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :in-theory (enable definition-of-logic.translate)
+                  :induct (logic.term-induction flag x)
+                  :expand (logic.translate x)
+                  :do-not-induct t)
+                 ("Subgoal *1/2"
+                  :in-theory (enable logic.constantp)
+                  :expand (logic.translate x))
+                 ("Subgoal *1/1"
+                  :in-theory (enable logic.variablep)
+                  :expand (logic.translate x)))))
+
+ (defthm logic.translate-when-logic.termp
+   (implies (logic.termp x)
+            (equal (logic.translate x)
+                   x))
+   :hints(("Goal" :use ((:instance lemma (flag 'term))))))
+
+ (defthm logic.translate-when-logic.term-listp
+   (implies (logic.term-listp x)
+            (equal (logic.translate-list x)
+                   (cons t (list-fix x))))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+
+(verify-guards logic.flag-translate)
+(verify-guards logic.translate)
+(verify-guards logic.translate-list)
+
+
+
+
+(defmacro assert (thing-that-must-be-true)
+  `(ACL2::make-event (if ,thing-that-must-be-true
+                         '(ACL2::value-triple :assert-ok)
+                       (ACL2::er hard 'assert "Assertation failed: ~x0~%" ',thing-that-must-be-true))))
+
+
+
+;; We run some basic tests to make sure that translate seems to be working
+;; correctly.  We might eventually want to expand this test suite.
+(local
+ (encapsulate
+  ()
+
+  (assert (equal (logic.translate nil) ''nil))
+  (assert (equal (logic.translate t) ''t))
+  (assert (equal (logic.translate 0) ''0))
+  (assert (equal (logic.translate 3) ''3))
+  (assert (equal (logic.translate ''4) ''4))
+  (assert (equal (logic.translate 'foo) 'foo))
+  (assert (equal (logic.translate ''foo) ''foo))
+  (assert (equal (logic.translate ''t) ''t))
+  (assert (equal (logic.translate ''(1 . 2)) ''(1 . 2)))
+
+  ;; Malformed objects
+
+  ;; (assert (not (logic.translate :foo)))  ;; heh, this actually broke when i unsoundly
+  ;;                                           redefined symbolp.  taking it out.
+
+  (assert (not (logic.translate (list 'quote 1 2))))
+  (assert (not (logic.translate -1)))
+  (assert (not (logic.translate "string")))
+  (assert (not (logic.translate 3/2)))
+
+  (assert (equal (logic.translate '(list))         ''nil))
+  (assert (equal (logic.translate '(list 1))       '(cons '1 'nil)))
+  (assert (equal (logic.translate '(list 1 2))     '(cons '1 (cons '2 'nil))))
+  (assert (equal (logic.translate '(list 1 2 3))   '(cons '1 (cons '2 (cons '3 'nil)))))
+  (assert (equal (logic.translate '(list 1 2 3 4)) '(cons '1 (cons '2 (cons '3 (cons '4 'nil))))))
+
+  (assert (equal (logic.translate '(and))         ''t))
+  (assert (equal (logic.translate '(and 1))       ''1))
+  (assert (equal (logic.translate '(and 1 2))     '(if '1 '2 'nil)))
+  (assert (equal (logic.translate '(and 1 2 3))   '(if '1 (if '2 '3 'nil) 'nil)))
+  (assert (equal (logic.translate '(and 1 2 3 4)) '(if '1 (if '2 (if '3 '4 'nil) 'nil) 'nil)))
+
+  (assert (equal (logic.translate '(or))         ''nil))
+  (assert (equal (logic.translate '(or 1))       ''1))
+  (assert (equal (logic.translate '(or 1 2))     '(if '1 '1 '2)))
+  (assert (equal (logic.translate '(or 1 2 3))   '(if '1 '1 (if '2 '2 '3))))
+  (assert (equal (logic.translate '(or 1 2 3 4)) '(if '1 '1 (if '2 '2 (if '3 '3 '4)))))
+
+  (assert (equal (logic.translate '(or (f x) (f y)))
+                 (logic.translate '(let ((special-var-for-or (f x)))
+                                     (if special-var-for-or
+                                         special-var-for-or
+                                       (f y))))))
+
+  (assert (equal (logic.translate '(or (f x) (f y) (f z)))
+                 (logic.translate '(let ((special-var-for-or (f x)))
+                                     (if special-var-for-or
+                                         special-var-for-or
+                                       (let ((special-var-for-or (f y)))
+                                         (if special-var-for-or
+                                             special-var-for-or
+                                           (f z))))))))
+
+  (assert (equal (logic.translate '(first x))    '(car x)))
+  (assert (equal (logic.translate '(second x))   '(car (cdr x))))
+  (assert (equal (logic.translate '(third x))    '(car (cdr (cdr x)))))
+  (assert (equal (logic.translate '(fourth x))   '(car (cdr (cdr (cdr x))))))
+  (assert (equal (logic.translate '(fifth x))    '(car (cdr (cdr (cdr (cdr x)))))))
+
+  (assert (not (logic.translate '(cond x)))) ;; malformed cond
+
+  (assert (equal (logic.translate '(cond))                         ''nil))
+  (assert (equal (logic.translate '(cond (x 1)))                   '(if x '1 'nil)))
+  (assert (equal (logic.translate '(cond (x 1) (y 2)))             '(if x '1 (if y '2 'nil))))
+  (assert (equal (logic.translate '(cond (x 1) (y 2) (z 3)))       '(if x '1 (if y '2 (if z '3 'nil)))))
+  (assert (equal (logic.translate '(cond (x 1) (y 2) (z 3) (t 4))) '(if x '1 (if y '2 (if z '3 (if 't '4 'nil))))))
+  (assert (equal (logic.translate '(cond (x 1) (y 2) (t 3) (z 4))) '(if x '1 (if y '2 (if 't '3 (if z '4 'nil))))))
+
+  ;; Malformed lets
+  (assert (not (logic.translate '(let))))
+  (assert (not (logic.translate '(let ()))))
+  (assert (not (logic.translate '(let ((1 2)) (+ x y)))))
+  (assert (not (logic.translate '(let ((x 1) (x 2)) (+ x y)))))
+
+  (assert (equal (logic.translate '(let () nil))                      '((lambda () 'nil))))
+  (assert (equal (logic.translate '(let ((a 1)) (+ x y)))             '((lambda (x y a) (+ x y)) x y '1)))
+  (assert (equal (logic.translate '(let ((a 1) (b 2)) (+ x y)))       '((lambda (x y a b) (+ x y)) x y '1 '2)))
+  (assert (equal (logic.translate '(let ((a 1) (b 2) (c 3)) (+ x y))) '((lambda (x y a b c) (+ x y)) x y '1 '2 '3)))
+
+  ;; Malformed let*s
+  (assert (not (logic.translate '(let*))))
+  (assert (not (logic.translate '(let* ()))))
+  (assert (not (logic.translate '(let* ((1 2)) (+ x y)))))
+
+  (assert (equal (logic.translate '(let* () nil))                       ''nil))
+
+  (assert (equal (logic.translate '(let* ((a 1)) (+ x y)))
+                 '((lambda (x y a) (+ x y)) x y '1)))
+
+  (assert (equal (logic.translate '(let* ((a 1) (b 2)) (+ x y)))
+                 '((lambda (x y a) ((lambda (x y b) (+ x y)) x y '2)) x y '1)))
+
+  (assert (equal (logic.translate '(let* ((a 1) (b 2) (c 3)) (+ x y)))
+                 '((lambda (x y a) ((lambda (x y b) ((lambda (x y c) (+ x y)) x y '3)) x y '2)) x y '1)))
+
+  (assert (equal (logic.translate '(let* ((x 1) (x 2)) (+ x y)))
+                 '((lambda (y x) ((lambda (y x) (+ x y)) y '2)) y '1)))
+
+  (assert (equal (logic.translate '(let* ((x 1) (x (+ x 1))) (+ x y)))
+                 '((lambda (y x) ((lambda (y x) (+ x y)) y (+ x '1))) y '1)))
+
+  (assert (equal (logic.translate '(foo x y z))       '(foo x y z)))
+  (assert (equal (logic.translate '(foo x 1 nil y 2)) '(foo x '1 'nil y '2)))
+
+  ))
diff -Nru acl2-6.2/books/milawa/ACL2/make-autodoc.sh acl2-6.3/books/milawa/ACL2/make-autodoc.sh
--- acl2-6.2/books/milawa/ACL2/make-autodoc.sh	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/make-autodoc.sh	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,57 @@
+#!/bin/sh
+
+set -e
+
+HERE=`pwd`
+
+echo "Make sure autodoc is up to date."
+omake .PHONY/build/all .PHONY/clauses/all .PHONY/tactics/all .PHONY/rewrite/all -j 64
+
+echo "Remove old autodoc archives"
+
+rm -f $HERE/build-autodoc.tar.gz
+rm -f $HERE/clauses-autodoc.tar.gz
+rm -f $HERE/lift-autodoc.tar.gz
+rm -f $HERE/traces-autodoc.tar.gz
+rm -f $HERE/assms-autodoc.tar.gz
+rm -f $HERE/rewrite-autodoc.tar.gz
+rm -f $HERE/tactic-autodoc.tar.gz
+rm -f $HERE/diss-autodoc.tar.gz
+
+echo "Build new autodoc archives"
+
+cd $HERE/build; tar cvfz $HERE/build-autodoc.tar.gz autodoc
+cd $HERE/clauses; tar cvfz $HERE/clauses-autodoc.tar.gz autodoc
+cd $HERE/clauses/if-lifting; tar cvfz $HERE/lift-autodoc.tar.gz autodoc
+cd $HERE/rewrite/assms; tar cvfz $HERE/assms-autodoc.tar.gz autodoc
+cd $HERE/rewrite/traces; tar cvfz $HERE/traces-autodoc.tar.gz autodoc
+cd $HERE/rewrite; tar cvfz $HERE/rewrite-autodoc.tar.gz autodoc
+cd $HERE/tactics; tar cvfz $HERE/tactic-autodoc.tar.gz autodoc
+
+
+echo "Build consolidated autodoc archive."
+
+cd $HERE
+
+tar cvfz \
+    diss-autodoc.tar.gz \
+    build-autodoc.tar.gz \
+    clauses-autodoc.tar.gz \
+    lift-autodoc.tar.gz \
+    traces-autodoc.tar.gz \
+    assms-autodoc.tar.gz \
+    rewrite-autodoc.tar.gz \
+    tactic-autodoc.tar.gz
+
+echo "Clean up intermediate archives"
+
+rm -f $HERE/build-autodoc.tar.gz
+rm -f $HERE/clauses-autodoc.tar.gz
+rm -f $HERE/lift-autodoc.tar.gz
+rm -f $HERE/traces-autodoc.tar.gz
+rm -f $HERE/assms-autodoc.tar.gz
+rm -f $HERE/rewrite-autodoc.tar.gz
+rm -f $HERE/tactic-autodoc.tar.gz
+
+
+echo "All done"
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/milawa-acl2-raw.lsp acl2-6.3/books/milawa/ACL2/milawa-acl2-raw.lsp
--- acl2-6.2/books/milawa/ACL2/milawa-acl2-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/milawa-acl2-raw.lsp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,41 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+; This is raw ACL2 code that gets loaded by portcullis.lisp.
+
+(push :acl2 *features*)
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/package.lsp acl2-6.3/books/milawa/ACL2/package.lsp
--- acl2-6.2/books/milawa/ACL2/package.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/package.lsp	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,107 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ld "str/package.lsp" :dir :system)
+
+(defpkg "MILAWA"
+  '(nil
+    t
+    quote
+    if
+    equal
+    consp
+    cons
+    implies
+    iff
+    not
+    lambda
+
+    in-package
+    declare
+    ignore
+    xargs
+
+    defthm
+    defthmd
+    defmacro
+    &rest
+    &optional
+    &whole
+    &key
+    &body
+    let
+    let*
+    and
+    or
+    list
+    list*
+    cond
+    case
+    otherwise
+
+    ;; Some convenient ACL2 features
+    good-bye
+    exit
+    quit
+    deftheory
+    defun-sk
+    defconst
+    set-guard-checking
+    set-verify-guards-eagerness
+    set-case-split-limitations
+    set-well-founded-relation
+    set-measure-function
+    set-state-ok
+    set-ignore-okp
+    verify-termination
+    in-theory
+    theory
+    enable
+    disable
+    e/d
+    ld
+    encapsulate
+    local
+    i-am-here
+
+    ;; These should probably be removed
+    syntaxp
+    mbe
+    mbt
+    case-split
+))
+
+(defmacro MILAWA::include-book (&rest args)
+  `(ACL2::include-book ,@args :ttags :all))
+
diff -Nru acl2-6.2/books/milawa/ACL2/pcert-scan.pl acl2-6.3/books/milawa/ACL2/pcert-scan.pl
--- acl2-6.2/books/milawa/ACL2/pcert-scan.pl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/pcert-scan.pl	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,102 @@
+#!/usr/bin/env perl
+
+# Milawa pcert.pl
+# Copyright (C) 2005-2012 by Jared Davis <jared@cs.utexas.edu>
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.  This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.  You should have received a copy of the GNU General Public
+# License along with this program (see the file COPYING); if not, write to the
+# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+
+use strict;
+use warnings;
+use File::Spec;
+use FindBin qw($RealBin);
+use Cwd;
+
+my $MODIFIED_ACL2 = File::Spec->rel2abs("$RealBin/modified-acl2");
+(do "$RealBin/pcert-util.pl") or die ("Error loading $RealBin/pcert-util.pl:\n!: $!\n\@: $@\n");
+
+sub build_depgraph
+{
+    my $path = shift;      # Should be /path/to/bookname {with no extension}
+    my $deps = shift;      # Hash, main graph, bookname -> deps hash
+    my $deporder = shift;  # Array, dependency ordered list of books
+
+#    print "Starting $path\n";
+
+    my ($vol, $dir, $file) = File::Spec->splitpath($path);
+    my $look = $deps->{$path} || "";
+    die "Circular dependencies for $path" if ($look eq "EXPLORING");
+    return if $look; # already dealt with this book
+    $deps->{$path} = "EXPLORING";
+
+    my %selfdeps = ();
+    my $includes = collect_include_books("$path.lisp");
+    foreach my $entry (@$includes)
+    {
+	my $bookname = $entry->[0];
+	my $dirpart = $entry->[1];
+	if ($dirpart) { die "Add :dir support\n"; }
+	my $subbook = File::Spec->catpath($vol, $dir, $bookname);
+	$selfdeps{$subbook} = 1;
+#	print "$path: $subbook\n";
+	build_depgraph($subbook, $deps, $deporder);
+	# Assuming we fully explored subbook and got all its deps, we
+	# just need to jam them into our own deps.
+	my $subdeps = $deps->{$subbook};
+	if ($subdeps) {
+	    foreach(keys %$subdeps) {
+#		print "$path: inheriting $_ from $subbook\n";
+		$selfdeps{$_} = 1;
+	    }
+	}
+    }
+
+    push(@$deporder, $path);
+    $deps->{$path} = \%selfdeps;
+
+#    print "Done $path\n";
+}
+
+my %deps = ();
+my @deporder = ();
+foreach(@ARGV) {
+    build_depgraph($_, \%deps, \@deporder);
+}
+
+my $ndeps = @deporder;
+print "# pcert-scan.pl deps for $ndeps files\n\n";
+
+
+foreach my $book (@deporder)
+{
+    my $bookdeps = $deps{$book};
+    my $bookimg = infer_book_image($book, $MODIFIED_ACL2);
+    my $relimg = File::Spec->abs2rel($bookimg);
+    my $mangle = $book;
+    $mangle =~ s|/|__|g;
+    print "PCDEPS_FOR_$mangle := \\\n";
+    print "    $book.lisp \\\n";
+    foreach(keys %$bookdeps) {
+	print "    $_.lisp \\\n";
+    }
+    # BOZO path stuff isn't very general here.
+    print "    acl2-images/$relimg\n\n";
+
+    print "$book.mpcert : \$(PCDEPS_FOR_$mangle)\n\n";
+}
+
+
+print "ALL_PCERTS := \\\n";
+foreach my $book (@deporder)
+{
+    print "    $book.mpcert \\\n";
+}
+print "\n\n";
diff -Nru acl2-6.2/books/milawa/ACL2/pcert-util.pl acl2-6.3/books/milawa/ACL2/pcert-util.pl
--- acl2-6.2/books/milawa/ACL2/pcert-util.pl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/pcert-util.pl	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,112 @@
+#!/usr/bin/env perl
+
+# Milawa pcert-util.pl
+# Copyright (C) 2005-2012 by Jared Davis <jared@cs.utexas.edu>
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.  This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.  You should have received a copy of the GNU General Public
+# License along with this program (see the file COPYING); if not, write to the
+# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+
+# pcert-util.pl
+# Helper routines for pcert.pl and pcert-scan.pl
+
+use strict;
+use warnings;
+
+sub trim
+{
+    my $str = shift;
+    $str =~ s/^\s+//;
+    $str =~ s/\s+$//;
+    return $str;
+}
+
+sub read_image_file
+{
+    my $path = shift;
+    open (my $fh, "<", $path) or die "Can't open file: $!";
+    local $/ = undef;
+    my $content = <$fh>;
+    close $fh;
+    $content = trim($content);
+    return $content if ($content =~ m/^[A-Za-z0-9_\-.\/]+$/);
+    die "Image file $path contains invalid content $content";
+}
+
+sub infer_book_image
+{
+    my $bookname = shift; # bookname with no extension
+    my $default_img = shift;
+    my ($vol, $dir, $file) = File::Spec->splitpath($bookname);
+    my $base     = File::Spec->catpath($vol, $dir, "");
+    my $bookimg  = File::Spec->catpath($vol, $dir, "$bookname.image");
+    my $certimg  = File::Spec->catpath($vol, $dir, "cert.image");
+    my $relimage = (-f $bookimg) ? read_image_file($bookimg)
+	         : (-f $certimg) ? read_image_file($certimg)
+   	         : $default_img;
+    # Quick hack to make this work for Milawa.  In general we should
+    # add support for a --bindir as in cert.pl
+    # my $absimage = File::Spec->rel2abs($relimage, $base);
+    return $relimage;
+}
+
+sub collect_include_books
+{
+    # Returns an array of [bookname . dir] entries
+    my $filename = shift;
+    open(my $fd, "<", $filename) or die("can't open $filename: $!");
+    my $regexp = "^[^;]*\\(include-book[\\s]*\"([^\"]*)\"(?:.*:dir[\\s]*:([^\\s)]*))?";
+    my @ret = ();
+    while(<$fd>) {
+	my @tmp = ($_ =~ m/$regexp/i);
+	if (@tmp) {
+	    push(@ret, [$tmp[0], $tmp[1] || ""])
+	}
+    }
+    close($fd);
+    return \@ret;
+}
+
+sub pcert_book
+{
+    my $bookname = shift; # bookname with no extension
+    my $absimage = shift; # full path to book image
+
+    if (! -x $absimage) {
+	die "$absimage (needed for $bookname) is not executable!";
+    }
+
+    my ($vol, $dir, $file) = File::Spec->splitpath($bookname);
+    my $base = File::Spec->catpath($vol, $dir, "");
+    chdir($base);
+
+    $ENV{"ACL2_CUSTOMIZATION"} = "NONE";
+
+    my $instrs = "(in-package \"ACL2\")
+(provisionally-certify \"$file\")
+(exit 0)
+";
+
+#    print "INSTRS = \n$instrs\n";
+
+    $SIG{PIPE} = 'IGNORE';
+    open(my $fd, "|$absimage") or die("can't run $absimage: $!");
+    print $fd $instrs;
+    close($fd);
+
+    my $status = $? >> 8;
+    if ($status == 44) {
+        # see interface/pcert.lisp -- we return 44 only on success.
+        return 1;
+    }
+    return 0;
+}
+
+1;
diff -Nru acl2-6.2/books/milawa/ACL2/pcert.pl acl2-6.3/books/milawa/ACL2/pcert.pl
--- acl2-6.2/books/milawa/ACL2/pcert.pl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/pcert.pl	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,70 @@
+#!/usr/bin/env perl
+
+# Milawa pcert.pl
+# Copyright (C) 2005-2012 by Jared Davis <jared@cs.utexas.edu>
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.  This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.  You should have received a copy of the GNU General Public
+# License along with this program (see the file COPYING); if not, write to the
+# Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+
+
+# pcert.pl -- This is a new implementation of Milawa's pcert mechanism which is
+# separated from OMake.  Milawa's pcert system predates that of ACL2's.  It is
+# rather specialized and probably doesn't make sense for projects other than
+# Milawa.  This requires that the book's dependencies are up to date.
+
+use strict;
+use warnings;
+use File::Spec;
+use FindBin qw($RealBin);
+
+my $MODIFIED_ACL2 = File::Spec->rel2abs("$RealBin/modified-acl2");
+(do "$RealBin/pcert-util.pl") or die ("Error loading $RealBin/pcert-util.pl:\n!: $!\n\@: $@\n");
+
+my $HELP = <<END;
+Usage: pcert.pl bookname
+Milawa\'s provisional certification system.
+END
+
+if (@ARGV != 1)
+{
+    print "Error: Expected exactly one argument.\n";
+    print $HELP;
+    exit(1);
+}
+
+# Bookname without extension
+my $BOOKNAME = ($ARGV[0] =~ m/(.*)\.lisp$/) ? $1
+             : ($ARGV[0] =~ m/(.*)\.mpcert$/) ? $1
+             : $ARGV[0];
+
+if (! -f "$BOOKNAME.lisp") {
+    print "Error: $BOOKNAME.lisp does not exist.\n";
+    print $HELP;
+    exit(1);
+}
+
+my $RELIMAGE = infer_book_image($BOOKNAME, $MODIFIED_ACL2);
+
+my ($vol, $dir, $file) = File::Spec->splitpath($BOOKNAME);
+my $base     = File::Spec->catpath($vol, $dir, "");
+my $ABSIMAGE = File::Spec->rel2abs("../../acl2-images/$RELIMAGE", $base);
+
+#print "BOOKNAME is $BOOKNAME\n";
+#print "ABSIMAGE is $ABSIMAGE\n";
+
+my $okp = pcert_book($BOOKNAME, $ABSIMAGE);
+
+if ($okp) {
+    exit(0);
+}
+
+exit(1);
+
diff -Nru acl2-6.2/books/milawa/ACL2/portcullis.acl2 acl2-6.3/books/milawa/ACL2/portcullis.acl2
--- acl2-6.2/books/milawa/ACL2/portcullis.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/portcullis.acl2	2013-09-30 17:53:18.000000000 +0000
@@ -0,0 +1,36 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ld "package.lsp")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/portcullis.lisp acl2-6.3/books/milawa/ACL2/portcullis.lisp
--- acl2-6.2/books/milawa/ACL2/portcullis.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/portcullis.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,48 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tools/include-raw" :dir :system)
+; (depends-on "milawa-acl2-raw.lsp")
+
+#!ACL2
+(make-event
+ (let ((cbd (cbd)))
+   `(defconst *path-to-milawa-acl2-directory* ',cbd)))
+
+#!ACL2
+(defttag :milawa)
+
+#!ACL2
+(include-raw "milawa-acl2-raw.lsp")
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/rewrite/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/rewrite/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/acl2-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/ancestors.lisp acl2-6.3/books/milawa/ACL2/rewrite/ancestors.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/ancestors.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/ancestors.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,233 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "rulep")
+(include-book "worse-termp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Ancestors Checking
+;;
+;; Sometimes rewrite rules can cause backchaining loops.  For example, if we
+;; have this rule:
+;;
+;;   (true-listp (cdr x)) --> (true-listp x)
+;;
+;; We might repeatedly try to apply it and get ourselves stuck in a loop:
+;;
+;;  *1 (true-listp a)                   ;; initial goal goal
+;;  *2 (true-listp (cdr a))             ;; goal after applying to *1
+;;  *3 (true-listp (cdr (cdr a)))       ;; goal after applying to *2
+;;  *4 (true-listp (cdr (cdr (cdr a)))) ;; goal after applying to *3
+;;  ...
+;;
+;; Similar loops can be caused by multiple rules, too.  For example:
+;;
+;;  a. (foo (cdr x)) --> (bar x)
+;;  b. (bar (cdr x)) --> (foo x)
+;;
+;;  *1 (foo a)                          ;; initial goal
+;;  *2 (bar (cdr a))                    ;; try b to rewrite *1
+;;  *3 (foo (cdr (cdr a)))              ;; try a to rewrite *2
+;;  *4 (bar (cdr (cdr (cdr a))))        ;; try b to rewrite *3
+;;  ...
+;;
+;; Eventually these loops will hit the backchain limits, but it might be very
+;; expensive to let them wander that long.  ACL2 avoids the ill effects of such
+;; rules by using a heuristic "ancestors check" that sometimes prevents rules
+;; from firing.  We implement a similar heuristic here.
+;;
+;; Our implementation of ancestors checking works much like ACL2's.  Each time
+;; we backchain, we push a frame onto the ANCESTORS STACK.  These frames keep
+;; track of the current hypothesis we are trying to relieve, the name of the
+;; rule are backchaining on behalf of, and some other information.  Then,
+;; before we backchain to relieve a new hyp, we check the hyp against the stack
+;; of ancestors.  If it seems worse than a prior goal, we heuristically prevent
+;; the backchain from occurring.
+
+(definlined rw.anframep (x)
+  (declare (xargs :guard t))
+  (and (tuplep 4 x)
+       (let ((term   (first x))
+             (guts   (second x))
+             (fcount (third x))
+             (tokens (fourth x)))
+         (declare (ignore tokens))
+         (and (logic.termp term)
+              (equal guts (if (clause.negative-termp term)
+                              (clause.negative-term-guts term)
+                            term))
+              (equal (logic.count-function-occurrences guts) fcount)))))
+
+(defthm booleanp-of-rw.anframep
+  (equal (booleanp (rw.anframep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.anframep))))
+
+
+(deflist rw.anstackp (x)
+  (rw.anframep x)
+  :elementp-of-nil nil)
+
+
+(definlined rw.anframe->term (x)
+  (declare (xargs :guard (rw.anframep x)
+                  :guard-hints (("Goal" :in-theory (enable rw.anframep)))))
+  (first x))
+
+(definlined rw.anframe->guts (x)
+  (declare (xargs :guard (rw.anframep x)
+                  :guard-hints (("Goal" :in-theory (enable rw.anframep)))))
+  (second x))
+
+(definlined rw.anframe->fcount (x)
+  (declare (xargs :guard (rw.anframep x)
+                  :guard-hints (("Goal" :in-theory (enable rw.anframep)))))
+  (third x))
+
+(definlined rw.anframe->tokens (x)
+  (declare (xargs :guard (rw.anframep x)
+                  :guard-hints (("Goal" :in-theory (enable rw.anframep)))))
+  (fourth x))
+
+
+(defthm forcing-logic.termp-of-rw.anframe->term
+  (implies (force (rw.anframep x))
+           (equal (logic.termp (rw.anframe->term x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.anframe->term rw.anframep))))
+
+(defthm forcing-logic.termp-of-rw.anframe->guts
+  (implies (force (rw.anframep x))
+           (equal (logic.termp (rw.anframe->guts x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.anframe->guts rw.anframep))))
+
+(defthm forcing-rw.anframe->fcount-elimination
+  (implies (force (rw.anframep x))
+           (equal (rw.anframe->fcount x)
+                  (logic.count-function-occurrences (rw.anframe->guts x))))
+  :hints(("Goal" :in-theory (enable rw.anframep rw.anframe->fcount rw.anframe->guts))))
+
+
+
+(definlined rw.anframe (term tokens)
+  (declare (xargs :guard (logic.termp term)))
+  (let* ((guts   (if (clause.negative-termp term)
+                     (clause.negative-term-guts term)
+                   term))
+         (fcount (logic.count-function-occurrences guts)))
+    (list term guts fcount tokens)))
+
+(defthm rw.anframep-of-rw.anframe
+  (implies (logic.termp term)
+           (equal (rw.anframep (rw.anframe term tokens))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.anframe rw.anframep))))
+
+
+
+(defund rw.earlier-ancestor-biggerp (guts fcount tokens ancestors)
+  (declare (xargs :guard (and (logic.termp guts)
+                              (equal (logic.count-function-occurrences guts) fcount)
+                              (rw.anstackp ancestors))))
+  (if (consp ancestors)
+      (let* ((ancestor1        (car ancestors))
+             (ancestor1-guts   (rw.anframe->guts ancestor1))
+             (ancestor1-fcount (rw.anframe->fcount ancestor1))
+             (ancestor1-tokens (rw.anframe->tokens ancestor1)))
+        (or (and (not (disjointp tokens ancestor1-tokens))
+                 (or (< fcount ancestor1-fcount)
+                     (and (equal fcount ancestor1-fcount)
+                          (rw.worse-than-or-equal-termp guts ancestor1-guts))))
+            (rw.earlier-ancestor-biggerp guts fcount tokens (cdr ancestors))))
+    nil))
+
+(defund rw.ancestors-check-aux (term guts fcount tokens ancestors)
+  (declare (xargs :guard (and (logic.termp term)
+                              (equal guts (if (clause.negative-termp term)
+                                              (clause.negative-term-guts term)
+                                            term))
+                              (equal (logic.count-function-occurrences guts) fcount)
+                              (rw.anstackp ancestors))))
+  (if (consp ancestors)
+      (let* ((ancestor1        (car ancestors))
+             (ancestor1-term   (rw.anframe->term ancestor1))
+             (ancestor1-guts   (rw.anframe->guts ancestor1))
+             (ancestor1-fcount (rw.anframe->fcount ancestor1))
+             (ancestor1-tokens (rw.anframe->tokens ancestor1)))
+        (cond ((or (equal term ancestor1-term)
+                   (equal guts ancestor1-guts))
+               ;; Stop early, this hyp or its negation are already on the stack.
+               t)
+              ((not (disjointp tokens ancestor1-tokens))
+               ;; Overlapping tokens case.  If the term has gotten worse and we
+               ;; are comparing calls of the same function or lambda, then stop
+               ;; early.
+               (or (and (or (< ancestor1-fcount fcount)
+                            (and (equal ancestor1-fcount fcount)
+                                 (rw.worse-than-or-equal-termp guts ancestor1-guts)))
+                        (or (and (logic.functionp guts)
+                                 (logic.functionp ancestor1-guts)
+                                 (equal (logic.function-name guts) (logic.function-name ancestor1-guts)))
+                            (and (logic.lambdap guts)
+                                 (logic.lambdap ancestor1-guts)
+                                 (equal (logic.lambda-formals guts) (logic.lambda-formals ancestor1-guts))
+                                 (equal (logic.lambda-body guts) (logic.lambda-body ancestor1-guts)))))
+                   (rw.ancestors-check-aux term guts fcount tokens (cdr ancestors))))
+              ((and (or (< ancestor1-fcount fcount)
+                        (equal ancestor1-fcount fcount))
+                    (rw.worse-than-or-equal-termp guts ancestor1-guts)
+                    ;; Here we are blindly reimplementing what ACL2 does.  I
+                    ;; only halfway understand this after reading the comments
+                    ;; in the ACL2 sources, so I will not try to explain it.
+                    (not (rw.earlier-ancestor-biggerp guts fcount ancestor1-tokens (cdr ancestors))))
+               t)
+              (t
+               (rw.ancestors-check-aux term guts fcount tokens (cdr ancestors)))))
+    nil))
+
+(definlined rw.ancestors-check (term tokens ancestors)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.anstackp ancestors))))
+  (let* ((guts (if (clause.negative-termp term)
+                   (clause.negative-term-guts term)
+                 term))
+         (fcount (logic.count-function-occurrences guts)))
+    (rw.ancestors-check-aux term guts fcount tokens ancestors)))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/rewrite/assms/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/acl2-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/add-equality.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/add-equality.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/add-equality.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/add-equality.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1113 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqdatabasep")
+(include-book "try-equiv-database")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defthm forcing-uniquep-of-remove-all
+  (implies (force (uniquep x))
+           (equal (uniquep (remove-all a x))
+                  t)))
+
+
+(defthmd memberp-when-not-memberp-of-cdr
+  (implies (not (memberp a (cdr x)))
+           (equal (memberp a x)
+                  (and (consp x)
+                       (equal a (car x))))))
+
+(defthm equal-of-rw.eqset->heads-when-uniquep-of-rw.eqset-list-heads
+  (implies (and (uniquep (rw.eqset-list-heads eqsets))
+                (memberp a eqsets)
+                (memberp b eqsets))
+           (equal (equal (rw.eqset->head a) (rw.eqset->head b))
+                  (equal a b)))
+  :hints(("Goal"
+          :induct (cdr-induction eqsets)
+          :in-theory (enable memberp-when-not-memberp-of-cdr))))
+
+
+
+(defthm uniquep-when-mutually-disjointp-and-cons-listp
+  ;; BOZO move to mutually-disjoint.lisp
+  (implies (and (mutually-disjointp x)
+                (cons-listp x))
+           (equal (uniquep x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthm rw.eqset-list-heads-of-remove-all
+  (implies (and (memberp a x)
+                (uniquep (rw.eqset-list-heads x)))
+           (equal (rw.eqset-list-heads (remove-all a x))
+                  (remove-all (rw.eqset->head a)
+                              (rw.eqset-list-heads x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-rw.eqset-list-rhses-when-memberp
+  (implies (memberp a eqsets)
+           (memberp (rw.eqtrace-list-rhses (rw.eqset->tail a))
+                    (rw.eqset-list-rhses eqsets)))
+  :hints(("Goal"
+          :in-theory (enable rw.eqset->rhses)
+          :induct (cdr-induction eqsets))))
+
+(defthm cons-listp-of-rw.eqset-list-rhses
+  (implies (rw.eqset-listp eqsets)
+           (equal (cons-listp (rw.eqset-list-rhses eqsets))
+                  t))
+  :hints(("Goal"
+          :in-theory (enable rw.eqset->rhses)
+          :induct (cdr-induction eqsets))))
+
+(defthm uniquep-of-rw.eqset-list-rhses-when-mutually-disjointp
+  (implies (and (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                (force (rw.eqset-listp eqsets)))
+           (equal (uniquep (rw.eqset-list-rhses eqsets))
+                  t)))
+
+
+
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-rw.eqset-list-rhses-of-remove-all-when-mutually-disjointp
+   (implies (memberp a x)
+            (equal (equal (rw.eqset-list-rhses (remove-all a x))
+                          (rw.eqset-list-rhses x))
+                   nil))
+   :hints(("Goal" :use ((:instance equal-when-length-different
+                                   (a (rw.eqset-list-rhses (remove-all a x)))
+                                   (b (rw.eqset-list-rhses x)))))))
+
+ (defthm rw.eqset-list-rhses-of-remove-all-when-mutually-disjointp
+   (implies (and (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                 (all-equalp (rw.eqset->iffp set) (rw.eqset-list-iffps eqsets))
+                 (memberp set eqsets)
+                 (rw.eqset-listp eqsets))
+            (equal (rw.eqset-list-rhses (remove-all set eqsets))
+                   (remove-all (rw.eqset->rhses set) (rw.eqset-list-rhses eqsets))))
+   :hints(("Goal"
+           :induct (cdr-induction eqsets)
+           :in-theory (enable lemma-for-rw.eqset-list-rhses-of-remove-all-when-mutually-disjointp)))))
+
+
+
+
+
+
+(defthmd lemma-for-disjointp-of-rw.eqtrace-list-rhses-when-mutually-disjointp-of-rw.eqset-list-rhses
+  (implies (and (memberp a eqsets)
+                (memberp b eqsets)
+                (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                (rw.eqset-listp eqsets))
+           (equal (equal (rw.eqtrace-list-rhses (rw.eqset->tail a))
+                         (rw.eqtrace-list-rhses (rw.eqset->tail b)))
+                  (equal a b)))
+  :hints(("Goal"
+          :induct (cdr-induction eqsets)
+          :in-theory (enable rw.eqset->rhses
+                             memberp-when-not-memberp-of-cdr))))
+
+(defthm disjointp-of-rw.eqtrace-list-rhses-when-mutually-disjointp-of-rw.eqset-list-rhses
+  (implies (and (rw.eqset-listp eqsets)
+                (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                (memberp a eqsets)
+                (memberp b eqsets)
+                (not (equal a b)))
+           (equal (disjointp (rw.eqtrace-list-rhses (rw.eqset->tail a))
+                             (rw.eqtrace-list-rhses (rw.eqset->tail b)))
+                  t))
+  :hints(("Goal" :in-theory (enable lemma-for-disjointp-of-rw.eqtrace-list-rhses-when-mutually-disjointp-of-rw.eqset-list-rhses))))
+
+
+
+
+(defprojection :list (rw.eqtrace-list-update iffp e x)
+               :element (rw.trans1-eqtrace iffp e x)
+               :guard (and (booleanp iffp)
+                           (rw.eqtracep e)
+                           (rw.eqtrace-listp x)
+                           (all-equalp (rw.eqtrace->rhs e) (rw.eqtrace-list-lhses x))
+                           (implies (not iffp)
+                                    (and (not (rw.eqtrace->iffp e))
+                                         (all-equalp nil (rw.eqtrace-list-iffps x))))))
+
+(defthm rw.eqtrace-list-iffps-of-rw.eqtrace-list-update
+  (equal (rw.eqtrace-list-iffps (rw.eqtrace-list-update iffp e x))
+         (repeat iffp (len x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.eqtrace-list-lhses-of-rw.eqtrace-list-update
+  (equal (rw.eqtrace-list-lhses (rw.eqtrace-list-update iffp e x))
+         (repeat (rw.eqtrace->lhs e) (len x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.eqtrace-list-rhses-of-rw.eqtrace-list-update
+  (equal (rw.eqtrace-list-rhses (rw.eqtrace-list-update iffp e x))
+         (rw.eqtrace-list-rhses x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.eqtrace-listp-of-rw.eqtrace-list-update
+  (implies (force (and (booleanp iffp)
+                       (rw.eqtracep e)
+                       (rw.eqtrace-listp x)
+                       (all-equalp (rw.eqtrace->rhs e) (rw.eqtrace-list-lhses x))))
+           (equal (rw.eqtrace-listp (rw.eqtrace-list-update iffp e x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.eqtrace-list-atblp-of-rw.eqtrace-list-update
+  (implies (force (and (rw.eqtrace-atblp e atbl)
+                       (rw.eqtrace-list-atblp x atbl)))
+           (equal (rw.eqtrace-list-atblp (rw.eqtrace-list-update iffp e x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.eqtrace-list-okp-of-rw.eqtrace-list-update
+  (implies (force (and (rw.eqtrace-okp e box)
+                       (rw.eqtrace-list-okp x box)
+                       (all-equalp (rw.eqtrace->rhs e) (rw.eqtrace-list-lhses x))
+                       (implies (not iffp)
+                                (and (not (rw.eqtrace->iffp e))
+                                     (all-equalp nil (rw.eqtrace-list-iffps x))))))
+           (equal (rw.eqtrace-list-okp (rw.eqtrace-list-update iffp e x) box)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+
+(definlined rw.eqset-relevant (term eqset)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.eqsetp eqset))))
+  (or (equal (rw.eqset->head eqset) term)
+      (rw.eqset-lookup term eqset)))
+
+(defund rw.find-relevant-eqset (term eqsets)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.eqset-listp eqsets))))
+  (if (consp eqsets)
+      (if (rw.eqset-relevant term (car eqsets))
+          (car eqsets)
+        (rw.find-relevant-eqset term (cdr eqsets)))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.find-relevant-eqset
+                           rw.eqset-relevant)))
+
+ (defthm forcing-rw.eqsetp-of-rw.find-relevant-eqset
+   (implies (force (and (rw.find-relevant-eqset term eqsets)
+                        (rw.eqset-listp eqsets)))
+            (equal (rw.eqsetp (rw.find-relevant-eqset term eqsets))
+                   t)))
+
+ (defthm forcing-rw.eqset-lookup-of-rw.find-relevant-eqset-under-iff
+   (implies (force (and (rw.find-relevant-eqset term eqsets)
+                        (not (equal (rw.eqset->head (rw.find-relevant-eqset term eqsets)) term))))
+            (iff (rw.eqset-lookup term (rw.find-relevant-eqset term eqsets))
+                 t)))
+
+ (defthm forcing-memberp-of-rw.find-relevant-eqset
+   (implies (force (rw.eqset-listp eqsets))
+            (equal (memberp (rw.find-relevant-eqset term eqsets) eqsets)
+                   (if (rw.find-relevant-eqset term eqsets)
+                       t
+                     nil))))
+
+ (defthm forcing-rw.eqeqset-relevant-of-rw.find-relevant-eqset
+   (implies (and (logic.termp term)
+                 (rw.eqset-listp eqsets))
+            (iff (rw.eqset-relevant term (rw.find-relevant-eqset term eqsets))
+                 (rw.find-relevant-eqset term eqsets))))
+
+ (defthm forcing-rw.eqset->iffp-of-rw.find-relevant-eqset-when-all-equalp
+   (implies (and (all-equalp iffp (rw.eqset-list-iffps eqsets))
+                 (force (rw.find-relevant-eqset term eqsets))
+                 (force (rw.eqset-listp eqsets)))
+            (equal (rw.eqset->iffp (rw.find-relevant-eqset term eqsets))
+                   iffp)))
+
+ (defthm memberp-of-rw.eqtrace-list-rhses-when-irrelevant
+   (implies (and (not (rw.eqset-relevant term eqset))
+                 (force (rw.eqsetp eqset)))
+            (equal (memberp term (rw.eqtrace-list-rhses (rw.eqset->tail eqset)))
+                   nil))
+   :hints(("Goal" :in-theory (enable rw.eqset-lookup))))
+
+ (defthm memberp-of-rw.eqtrace-list-rhses-when-irrelevant-from-all
+   (implies (and (not (rw.find-relevant-eqset term eqsets))
+                 (force (rw.eqset-listp eqsets)))
+            (equal (member-of-nonep term (rw.eqset-list-rhses eqsets))
+                   t))
+   :hints(("Goal"
+           :induct (cdr-induction eqsets)
+           :in-theory (enable rw.eqset->rhses))))
+
+ (defthm memberp-of-rw.eqtrace-list-rhses-when-memberp-of-irrelevant-from-all
+   (implies (and (not (rw.find-relevant-eqset term eqsets))
+                 (memberp eqset eqsets)
+                 (force (rw.eqset-listp eqsets)))
+            (equal (memberp term (rw.eqtrace-list-rhses (rw.eqset->tail eqset)))
+                   nil))
+   :hints(("Goal" :induct (cdr-induction eqsets))))
+
+ (defthm equal-to-rw.eqset->head-when-memberp-of-irrelevant-from-all
+   (implies (and (not (rw.find-relevant-eqset term eqsets))
+                 (memberp eqset eqsets)
+                 (force (rw.eqset-listp eqsets)))
+            (equal (equal term (rw.eqset->head eqset))
+                   nil))
+   :hints(("Goal" :induct (cdr-induction eqsets))))
+
+ (defthm memberp-of-rw.eqset-list-heads-when-all-irrelevant
+   (implies (and (not (rw.find-relevant-eqset term eqsets))
+                 (force (rw.eqset-listp eqsets)))
+            (equal (memberp term (rw.eqset-list-heads eqsets))
+                   nil))
+   :hints(("Goal" :induct (cdr-induction eqsets))))
+
+ (defthm memberp-of-rw.eqtrace->lhs-in-rw.eqset-list-heads-when-no-relevant-sets
+   (implies (and (not (rw.find-relevant-eqset (rw.eqtrace->lhs trace) eqsets))
+                 (force (rw.eqset-listp eqsets)))
+            (equal (memberp (rw.eqtrace->lhs trace) (rw.eqset-list-heads eqsets))
+                   nil)))
+
+ (defthm rw.eqset->head-of-rw.find-relevant-eqset-when-among-heads
+   (implies (and (memberp term (rw.eqset-list-heads eqsets))
+                 (disjoint-from-allp (rw.eqset-list-heads eqsets)
+                                     (rw.eqset-list-rhses eqsets))
+                 (force (rw.eqset-listp eqsets)))
+            (equal (rw.eqset->head (rw.find-relevant-eqset term eqsets))
+                   term))
+   :hints(("Goal"
+           :in-theory (enable rw.eqset-lookup
+                              rw.eqset->rhses)
+           :induct (cdr-induction eqsets)))))
+
+
+
+
+(definlined rw.join-eqsets (trace lhs-set rhs-set)
+  ;; We are given a trace, say lhs equiv rhs, and two distinct eqsets which are
+  ;; relevant to lhs and rhs, respectively.  We are to union these eqsets using
+  ;; trace as a bridge.
+  (declare (xargs :guard (and (rw.eqtracep trace)
+                              (rw.eqsetp lhs-set)
+                              (rw.eqsetp rhs-set)
+                              (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp lhs-set))
+                              (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp rhs-set))
+                              (rw.eqset-relevant (rw.eqtrace->lhs trace) lhs-set)
+                              (rw.eqset-relevant (rw.eqtrace->rhs trace) rhs-set)
+                              (not (equal (rw.eqset->head lhs-set)
+                                          (rw.eqset->head rhs-set)))
+                              (disjointp (rw.eqset->rhses lhs-set)
+                                         (rw.eqset->rhses rhs-set)))
+                  :verify-guards nil))
+  (let* ((lhs      (rw.eqtrace->lhs trace))
+         (rhs      (rw.eqtrace->rhs trace))
+         (iffp     (rw.eqtrace->iffp trace))
+         (lhs*     (rw.eqset->head lhs-set))
+         (rhs*     (rw.eqset->head rhs-set)))
+    (if (logic.term-< lhs* rhs*)
+        (let ((lhs*=rhs* (cond ((and (equal lhs lhs*)
+                                     (equal rhs rhs*))
+                                trace)
+                               ((equal lhs lhs*)
+                                (let ((rhs*=rhs (rw.eqset-lookup rhs rhs-set)))
+                                  ;;   lhs* = rhs      trace
+                                  ;;   rhs* = rhs      rhs*=rhs
+                                  ;; ---------------
+                                  ;;   lhs* = rhs*
+                                  (rw.trans3-eqtrace iffp trace rhs*=rhs)))
+                               ((equal rhs rhs*)
+                                (let ((lhs*=lhs (rw.eqset-lookup lhs lhs-set)))
+                                  ;;   lhs* = lhs      lhs*=lhs
+                                  ;;   lhs = rhs*      trace
+                                  ;; ---------------
+                                  ;;   lhs* = rhs*
+                                  (rw.trans1-eqtrace iffp lhs*=lhs trace)))
+                               (t
+                                (let* ((lhs*=lhs (rw.eqset-lookup lhs lhs-set))
+                                       (rhs*=rhs (rw.eqset-lookup rhs rhs-set))
+                                       ;;   lhs* = lhs     lhs*=lhs
+                                       ;;   lhs = rhs      trace
+                                       ;; --------------
+                                       ;;   lhs* = rhs
+                                       (lhs*=rhs (rw.trans1-eqtrace iffp lhs*=lhs trace)))
+                                  ;;   lhs* = rhs     lhs*=rhs
+                                  ;;   rhs* = rhs     rhs*=rhs
+                                  ;; ---------------
+                                  ;;   lhs* = rhs*
+                                  (rw.trans3-eqtrace iffp lhs*=rhs rhs*=rhs))))))
+          (rw.eqset lhs* iffp
+                    (revappend (rw.eqset->tail lhs-set)
+                               (rw.eqtrace-list-update iffp lhs*=rhs*
+                                                       (rw.eqset->tail rhs-set)))))
+      ;; Otherwise, we know rhs* < lhs*.
+      ;;
+      ;; We can assume rhs != rhs*, since otherwise we have the following
+      ;; contradiction:
+      ;;    lhs* < lhs < rhs = rhs* < lhs*
+      (let ((rhs*=lhs* (if (equal lhs lhs*)
+                           (let ((rhs*=rhs (rw.eqset-lookup rhs rhs-set)))
+                             ;;   rhs* = rhs      rhs*=rhs
+                             ;;   lhs* = rhs      trace
+                             ;; ---------------
+                             ;;   rhs* = lhs*
+                             (rw.trans3-eqtrace iffp rhs*=rhs trace))
+                         (let* ((lhs*=lhs (rw.eqset-lookup lhs lhs-set))
+                                (rhs*=rhs (rw.eqset-lookup rhs rhs-set))
+                                ;;   lhs* = lhs     lhs*=lhs
+                                ;;   lhs = rhs      trace
+                                ;; --------------
+                                ;;   lhs* = rhs
+                                (lhs*=rhs (rw.trans1-eqtrace iffp lhs*=lhs trace)))
+                           ;;   rhs* = rhs      rhs*=rhs
+                           ;;   lhs* = rhs      lhs*=rhs
+                           ;; ---------------
+                           ;;   rhs* = lhs*
+                           (rw.trans3-eqtrace iffp rhs*=rhs lhs*=rhs)))))
+        (rw.eqset rhs* iffp
+                  (revappend (rw.eqtrace-list-update iffp rhs*=lhs*
+                                                     (rw.eqset->tail lhs-set))
+                             (rw.eqset->tail rhs-set)))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.join-eqsets
+                           rw.eqset-relevant
+                           rw.eqset->rhses)))
+
+ (local (in-theory (e/d (rw.eqtrace-list-iffps-of-rev
+                         rw.eqtrace-list-lhses-of-rev
+                         rw.eqtrace-list-rhses-of-rev)
+                        (rev-of-rw.eqtrace-list-iffps
+                         rev-of-rw.eqtrace-list-lhses
+                         rev-of-rw.eqtrace-list-rhses))))
+
+ (encapsulate
+  ()
+  (local (ACL2::allow-fertilize t))
+  (defthmd lemma-for-rw.join-eqsets
+    (implies (and (not (equal (rw.eqset->head lhs-set)
+                              (rw.eqset->head rhs-set)))
+                  (equal (rw.eqset->head rhs-set)
+                         (rw.eqtrace->rhs trace))
+                  (rw.eqset-lookup (rw.eqtrace->lhs trace) lhs-set)
+                  (rw.eqtracep trace)
+                  (rw.eqsetp lhs-set)
+                  (rw.eqsetp rhs-set))
+             (equal (logic.term-< (rw.eqset->head lhs-set)
+                                  (rw.eqset->head rhs-set))
+                    t))
+    :hints(("Goal"
+            :in-theory (disable transitivity-of-logic.term-<
+                                forcing-transitivity-of-logic.term-<-three)
+            :use ((:instance transitivity-of-logic.term-<
+                             (x (rw.eqset->head lhs-set))
+                             (y (rw.eqtrace->lhs trace))
+                             (z (rw.eqtrace->rhs trace))))))))
+
+ (local (in-theory (enable lemma-for-rw.join-eqsets)))
+
+ (verify-guards rw.join-eqsets)
+
+ (defthm forcing-rw.eqsetp-of-rw.join-eqsets
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqsetp lhs-set)
+                        (rw.eqsetp rhs-set)
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp lhs-set))
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp rhs-set))
+                        (rw.eqset-relevant (rw.eqtrace->lhs trace) lhs-set)
+                        (rw.eqset-relevant (rw.eqtrace->rhs trace) rhs-set)
+                        (not (equal (rw.eqset->head lhs-set) (rw.eqset->head rhs-set)))
+                        (disjointp (rw.eqset->rhses lhs-set) (rw.eqset->rhses rhs-set))))
+            (equal (rw.eqsetp (rw.join-eqsets trace lhs-set rhs-set))
+                   t)))
+
+ (defthm forcing-rw.eqset-atblp-of-rw.join-eqsets
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqsetp lhs-set)
+                        (rw.eqsetp rhs-set)
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp lhs-set))
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp rhs-set))
+                        (rw.eqset-relevant (rw.eqtrace->lhs trace) lhs-set)
+                        (rw.eqset-relevant (rw.eqtrace->rhs trace) rhs-set)
+                        (not (equal (rw.eqset->head lhs-set) (rw.eqset->head rhs-set)))
+                        (disjointp (rw.eqset->rhses lhs-set) (rw.eqset->rhses rhs-set))
+                        ;; ---
+                        (rw.eqtrace-atblp trace atbl)
+                        (rw.eqset-atblp lhs-set atbl)
+                        (rw.eqset-atblp rhs-set atbl)))
+            (equal (rw.eqset-atblp (rw.join-eqsets trace lhs-set rhs-set) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqset-okp-of-rw.join-eqsets
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqsetp lhs-set)
+                        (rw.eqsetp rhs-set)
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp lhs-set))
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp rhs-set))
+                        (rw.eqset-relevant (rw.eqtrace->lhs trace) lhs-set)
+                        (rw.eqset-relevant (rw.eqtrace->rhs trace) rhs-set)
+                        (not (equal (rw.eqset->head lhs-set) (rw.eqset->head rhs-set)))
+                        (disjointp (rw.eqset->rhses lhs-set) (rw.eqset->rhses rhs-set))
+                        ;; ---
+                        (rw.eqtrace-okp trace box)
+                        (rw.eqset-okp lhs-set box)
+                        (rw.eqset-okp rhs-set box)))
+            (equal (rw.eqset-okp (rw.join-eqsets trace lhs-set rhs-set) box)
+                   t)))
+
+ (defthm forcing-rw.eqset->iffp-of-rw.join-eqsets
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqsetp lhs-set)
+                        (rw.eqsetp rhs-set)
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp lhs-set))
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp rhs-set))
+                        (rw.eqset-relevant (rw.eqtrace->lhs trace) lhs-set)
+                        (rw.eqset-relevant (rw.eqtrace->rhs trace) rhs-set)
+                        (not (equal (rw.eqset->head lhs-set) (rw.eqset->head rhs-set)))
+                        (disjointp (rw.eqset->rhses lhs-set) (rw.eqset->rhses rhs-set))))
+            (equal (rw.eqset->iffp (rw.join-eqsets trace lhs-set rhs-set))
+                   (rw.eqset->iffp lhs-set))))
+
+ (defthm forcing-rw.eqtrace-list-rhses-of-rw.eqset->tail-of-rw.join-eqsets
+   (implies (force (and (rw.eqsetp lhs-set)
+                        (rw.eqsetp rhs-set)))
+            (equal (rw.eqtrace-list-rhses
+                    (rw.eqset->tail
+                     (rw.join-eqsets trace lhs-set rhs-set)))
+                   (app
+                    (rw.eqtrace-list-rhses (rev (rw.eqset->tail lhs-set)))
+                    (rw.eqtrace-list-rhses (rw.eqset->tail rhs-set))))))
+
+ (defthm forcing-rw.eqset->head-of-rw.join-eqsets
+   (implies (force (rw.eqtracep trace))
+            (equal (rw.eqset->head (rw.join-eqsets trace lhs-set rhs-set))
+                   (if (logic.term-< (rw.eqset->head rhs-set)
+                                     (rw.eqset->head lhs-set))
+                       (rw.eqset->head rhs-set)
+                     (rw.eqset->head lhs-set))))))
+
+
+
+
+
+(definlined rw.eqset-extend (trace eqset)
+  ;; Try to extend an eqset using a new trace.  The eqset is only actually
+  ;; extended if the trace is relevant, i.e., if the trace's lhs or rhs occurs
+  ;; somewhere in the set.
+  (declare (xargs :guard (and (rw.eqtracep trace)
+                              (rw.eqsetp eqset)
+                              (equal (rw.eqtrace->iffp trace)
+                                     (rw.eqset->iffp eqset)))
+                  :verify-guards nil))
+  (let* ((iffp      (rw.eqtrace->iffp trace))
+         (trace-lhs (rw.eqtrace->lhs trace))
+         (trace-rhs (rw.eqtrace->rhs trace))
+         (set-head  (rw.eqset->head eqset))
+         (set-tail  (rw.eqset->tail eqset)))
+    (cond ((equal trace-lhs set-head)
+           ;; Special case.
+           ;;  * The set's head need not change.
+           ;;  * The set's tail needs to be extended with trace-rhs exactly
+           ;;    when trace-rhs is not already present.
+           (if (rw.eqtrace-list-lookup trace-rhs set-tail)
+               eqset
+             (rw.eqset set-head iffp (cons trace set-tail))))
+          ((equal trace-rhs set-head)
+           ;; Special case.
+           ;;  * The set's head needs to change from trace-rhs to trace-lhs.
+           ;;  * All current members of the tail are currently of the form
+           ;;    trace-rhs ~ x, and must be updated to trace-lhs ~ x.
+           ;;  * The set's tail does not currently include trace-rhs, since
+           ;;    trace-rhs is the set-head.  Hence, we need to add trace itself
+           ;;    to the tail, to preserve trace-lhs ~ trace-rhs.
+           (rw.eqset trace-lhs
+                     iffp
+                     (cons trace (rw.eqtrace-list-update iffp trace set-tail))))
+          (t
+           (let ((lhs-lookup (rw.eqtrace-list-lookup trace-lhs set-tail))
+                 (rhs-lookup (rw.eqtrace-list-lookup trace-rhs set-tail)))
+             (cond ((and lhs-lookup rhs-lookup)
+                    ;; Trace-lhs and trace-rhs are already in the set.  There's
+                    ;; no new information being added by this trace.
+                    eqset)
+                   (lhs-lookup
+                    ;; Trace-lhs is in the set, but trace-rhs is not.  We need
+                    ;; to add rhs to the set.
+                    ;;  * The set's head will not change, since head < lhs < rhs
+                    ;;    and we are only adding rhs.
+                    ;;  * We need to add head ~ rhs to the set's tail.
+                    (rw.eqset set-head
+                              iffp
+                              (cons (rw.trans1-eqtrace iffp lhs-lookup trace)
+                                    set-tail)))
+                   (rhs-lookup
+                    ;; Trace-rhs is in the set, but trace-lhs is not.
+                    (if (logic.term-< set-head trace-lhs)
+                        ;; Case 1.
+                        ;;  * The set's head will not change
+                        ;;  * We need to add head ~ lhs to the set's tail.
+                        (rw.eqset set-head
+                                  iffp
+                                  (cons (rw.trans3-eqtrace iffp rhs-lookup trace) set-tail))
+                      ;; Case 2.
+                      ;; We know that trace-lhs < set-head, since we already ruled
+                      ;; out the possibility that they are equal, and we know that
+                      ;; set-head is not less than trace-lhs.
+                      ;;  * The set's head needs to become trace-lhs
+                      ;;  * All the existing traces in the tail are currently of
+                      ;;    the from set-head ~ x, and need to be updated to
+                      ;;    become trace-lhs ~ x.
+                      ;;  * We don't add trace-lhs ~ trace-rhs, because trace-rhs
+                      ;;    is already a member of the tail.
+                      ;;  * But trace-lhs ~ set-head needs to be added to the tail,
+                      ;;    since it is not yet present.
+                      (rw.eqset trace-lhs
+                                iffp
+                                (cons (rw.trans3-eqtrace iffp trace rhs-lookup)
+                                      (rw.eqtrace-list-update iffp (rw.trans3-eqtrace iffp trace rhs-lookup) set-tail)))))
+                   (t
+                    ;; Neither trace-lhs nor trace-rhs are in the set.  The
+                    ;; trace is not related to this set, so we won't need to
+                    ;; change the set.
+                    eqset)))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqset-extend)))
+
+ (verify-guards rw.eqset-extend)
+
+ (defthm forcing-rw.eqsetp-of-rw.eqset-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqsetp eqset)
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp eqset))))
+            (equal (rw.eqsetp (rw.eqset-extend trace eqset))
+                   t)))
+
+ (defthm forcing-rw.eqset-atblp-of-rw.eqset-extend
+   (implies (force (and (rw.eqtrace-atblp trace atbl)
+                        (rw.eqsetp eqset)
+                        (rw.eqset-atblp eqset atbl)
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp eqset))))
+            (equal (rw.eqset-atblp (rw.eqset-extend trace eqset) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqset-okp-of-rw.eqset-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqtrace-okp trace box)
+                        (rw.eqsetp eqset)
+                        (rw.eqset-okp eqset box)
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp eqset))))
+            (equal (rw.eqset-okp (rw.eqset-extend trace eqset) box)
+                   t)))
+
+ (defthm forcing-rw.eqset->iffp-of-rw.eqset-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqsetp eqset)
+                        (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp eqset))))
+            (equal (rw.eqset->iffp (rw.eqset-extend trace eqset))
+                   (rw.eqtrace->iffp trace))))
+
+ (defthmd choices-for-rw.eqset->head-of-rw.eqset-extend
+   (memberp (rw.eqset->head (rw.eqset-extend trace eqset))
+            (list (rw.eqset->head eqset)
+                  (rw.eqtrace->lhs trace)))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force))))))
+
+
+
+
+
+(definlined rw.eqsets-extend (trace eqsets)
+  ;; Eqsets are a proper, disjoint-set data structure, and trace is a new piece
+  ;; of information we want to infer.  We want to create a new list of eqsets
+  ;; which incorporates the new inference.
+  (declare (xargs :guard (and (rw.eqtracep trace)
+                              (rw.eqset-listp eqsets)
+                              (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                              (uniquep (rw.eqset-list-heads eqsets))
+                              (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                              (disjoint-from-allp (rw.eqset-list-heads eqsets)
+                                                  (rw.eqset-list-rhses eqsets)))
+                  :verify-guards nil))
+  (let* ((lhs     (rw.eqtrace->lhs trace))
+         (rhs     (rw.eqtrace->rhs trace))
+         (iffp    (rw.eqtrace->iffp trace))
+         (lhs-set (rw.find-relevant-eqset lhs eqsets))
+         (rhs-set (rw.find-relevant-eqset rhs eqsets)))
+    (cond ((and (not lhs-set) (not rhs-set))
+           ;; Neither term occurs in any existing set, so we want to create
+           ;; a new set for these terms.
+           (cons (rw.eqset lhs iffp (list trace)) eqsets))
+          ((not lhs-set)
+           ;; Only the rhs occurs in any set.  Update that set to include the
+           ;; lhs.  There is no chance that this merges sets, since only one
+           ;; set is relevant to the trace.
+           (cons (rw.eqset-extend trace rhs-set)
+                 (remove-all rhs-set eqsets)))
+          ((not rhs-set)
+           ;; Only the lhs occurs in any set. Update the set to include the
+           ;; lhs.  As before, there is no chance that we need to merge sets,
+           ;; since only one set is relevant.
+           (cons (rw.eqset-extend trace lhs-set)
+                 (remove-all lhs-set eqsets)))
+          ((equal lhs-set rhs-set)
+           ;; Both terms already occur in the same set, so we already know
+           ;; they are equal.  No updates are necessary.
+           eqsets)
+          (t
+           ;; Otherwise each term occurs in its own set.  This trace must now
+           ;; be used to merge the sets.
+           (cons (rw.join-eqsets trace lhs-set rhs-set)
+                 (remove-all lhs-set
+                             (remove-all rhs-set eqsets)))))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqsets-extend)))
+ (local (in-theory (enable rw.eqset->rhses)))
+
+ (verify-guards rw.eqsets-extend)
+
+ (defthm forcing-rw.eqset-listp-of-rw.eqsets-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqset-listp eqsets)
+                        (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                        (uniquep (rw.eqset-list-heads eqsets))
+                        (mutually-disjointp (rw.eqset-list-rhses eqsets))))
+            (equal (rw.eqset-listp (rw.eqsets-extend trace eqsets))
+                   t)))
+
+ (defthm forcing-rw.eqset-list-atblp-of-rw.eqsets-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqset-listp eqsets)
+                        (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                        (uniquep (rw.eqset-list-heads eqsets))
+                        (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                        ;; ---
+                        (rw.eqtrace-atblp trace atbl)
+                        (rw.eqset-list-atblp eqsets atbl)))
+            (equal (rw.eqset-list-atblp (rw.eqsets-extend trace eqsets) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqrow-list-okp-of-rw.eqsets-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqset-listp eqsets)
+                        (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                        (uniquep (rw.eqset-list-heads eqsets))
+                        (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                        ;; ---
+                        (rw.eqtrace-okp trace box)
+                        (rw.eqset-list-okp eqsets box)))
+            (equal (rw.eqset-list-okp (rw.eqsets-extend trace eqsets) box)
+                   t)))
+
+ (encapsulate
+  ()
+  (defthmd lemma-for-forcing-rw.eqset-list-iffps-of-rw.eqsets-extend
+    (implies (force (and (rw.eqtracep trace)
+                         (rw.eqset-listp eqsets)
+                         (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                         (uniquep (rw.eqset-list-heads eqsets))
+                         (mutually-disjointp (rw.eqset-list-rhses eqsets))))
+             (equal (all-equalp (rw.eqtrace->iffp trace)
+                                (rw.eqset-list-iffps (rw.eqsets-extend trace eqsets)))
+                    t)))
+
+  (defthm forcing-rw.eqset-list-iffps-of-rw.eqsets-extend
+    (implies (force (and (rw.eqtracep trace)
+                         (rw.eqset-listp eqsets)
+                         (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                         (uniquep (rw.eqset-list-heads eqsets))
+                         (mutually-disjointp (rw.eqset-list-rhses eqsets))))
+             (equal (rw.eqset-list-iffps (rw.eqsets-extend trace eqsets))
+                    (repeat (rw.eqtrace->iffp trace)
+                            (len (rw.eqsets-extend trace eqsets)))))
+    :hints(("Goal"
+            :use ((:instance lemma-for-forcing-rw.eqset-list-iffps-of-rw.eqsets-extend))
+            :in-theory (e/d (all-equalp-as-repeat)
+                            (rw.eqsets-extend))))))
+
+ (defthm forcing-uniquep-of-rw.eqset-list-heads-of-rw.eqsets-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqset-listp eqsets)
+                        (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                        (uniquep (rw.eqset-list-heads eqsets))
+                        (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                        (disjoint-from-allp (rw.eqset-list-heads eqsets)
+                                            (rw.eqset-list-rhses eqsets))))
+            (equal (uniquep (rw.eqset-list-heads (rw.eqsets-extend trace eqsets)))
+                   t))
+   :hints(("Subgoal 4"
+           :use ((:instance choices-for-rw.eqset->head-of-rw.eqset-extend
+                            (trace trace)
+                            (eqset (rw.find-relevant-eqset (rw.eqtrace->rhs trace) eqsets)))))
+          ("Subgoal 3"
+           :use ((:instance choices-for-rw.eqset->head-of-rw.eqset-extend
+                            (trace trace)
+                            (eqset (rw.find-relevant-eqset (rw.eqtrace->lhs trace) eqsets)))))))
+
+ (defthmd lemma-for-forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqsets-extend
+   (implies (and (equal term (rw.eqset->head eqset))
+                 (memberp eqset eqsets)
+                 (disjoint-from-allp (rw.eqset-list-heads eqsets)
+                                     (rw.eqset-list-rhses eqsets))
+                 (force (rw.eqset-listp eqsets)))
+            (equal (MEMBER-OF-NONEP term (RW.EQSET-LIST-RHSES EQSETS))
+                   t))
+   :hints(("Goal" :induct (cdr-induction eqsets))))
+
+ (defthm forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqsets-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqset-listp eqsets)
+                        (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                        (uniquep (rw.eqset-list-heads eqsets))
+                        (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                        (disjoint-from-allp (rw.eqset-list-heads eqsets)
+                                            (rw.eqset-list-rhses eqsets))))
+            (equal (mutually-disjointp (rw.eqset-list-rhses (rw.eqsets-extend trace eqsets)))
+                   t))
+   :hints(("Goal"
+           :in-theory (e/d (rw.eqset-extend
+                            rw.eqtrace-list-rhses-of-rev
+                            lemma-for-forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqsets-extend)
+                           (rev-of-rw.eqtrace-list-rhses)))))
+
+ (defthm disjoint-from-allp-of-rw.eqrow-list-heads-and-rw.eqrow-list-rhses-of-rw.eqsets-extend
+   (implies (force (and (rw.eqtracep trace)
+                        (rw.eqset-listp eqsets)
+                        (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                        (uniquep (rw.eqset-list-heads eqsets))
+                        (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                        (disjoint-from-allp (rw.eqset-list-heads eqsets)
+                                            (rw.eqset-list-rhses eqsets))))
+            (equal (disjoint-from-allp (rw.eqset-list-heads (rw.eqsets-extend trace eqsets))
+                                       (rw.eqset-list-rhses (rw.eqsets-extend trace eqsets)))
+                   t))
+   :hints(("Goal"
+           :in-theory (e/d (rw.eqset-extend
+                            rw.eqtrace-list-rhses-of-rev
+                            lemma-for-forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqsets-extend)
+                           (rev-of-rw.eqtrace-list-rhses))))))
+
+
+
+
+
+
+(definlined rw.eqdatabase-extend (nhyp database primaryp secondaryp directp negativep)
+  (declare (xargs :guard (and (logic.termp nhyp)
+                              (rw.eqdatabasep database)
+                              (booleanp primaryp)
+                              (booleanp secondaryp)
+                              (booleanp directp)
+                              (booleanp negativep))))
+  (let ((trace1 (rw.primary-eqtrace primaryp nhyp))
+        (trace2 (rw.secondary-eqtrace secondaryp nhyp))
+        (trace3 (rw.direct-iff-eqtrace directp nhyp))
+        (trace4 (rw.negative-iff-eqtrace negativep nhyp))
+        (iffp   (or directp negativep)))
+    (if (or trace1 trace2 trace3 trace4)
+        (let* ((equalsets        (rw.eqdatabase->equalsets database))
+               (iffsets          (rw.eqdatabase->iffsets database))
+               (contradiction    (rw.eqdatabase->contradiction database))
+               (equalsets-prime  (if trace1 (rw.eqsets-extend trace1 equalsets) equalsets))
+               (equalsets-prime  (if trace2 (rw.eqsets-extend trace2 equalsets-prime) equalsets-prime))
+               (iffsets-prime    (if (and iffp trace1)
+                                     (rw.eqsets-extend (rw.weakening-eqtrace trace1) iffsets)
+                                   iffsets))
+               (iffsets-prime    (if (and iffp trace2)
+                                     (rw.eqsets-extend (rw.weakening-eqtrace trace2) iffsets-prime)
+                                   iffsets-prime))
+               (iffsets-prime    (if trace3 (rw.eqsets-extend trace3 iffsets-prime) iffsets-prime))
+               (iffsets-prime    (if trace4 (rw.eqsets-extend trace4 iffsets-prime) iffsets-prime)))
+          (rw.eqdatabase equalsets-prime
+                         iffsets-prime
+                         (or contradiction
+                             (rw.find-contradiction-in-eqset-list equalsets-prime)
+                             (rw.find-contradiction-in-eqset-list iffsets-prime))))
+      database)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqdatabase-extend)))
+
+ (defthm rw.eqdatabasep-of-rw.eqdatabase-extend
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqdatabasep database)))
+            (equal (rw.eqdatabasep (rw.eqdatabase-extend nhyp database primaryp secondaryp directp negativep))
+                   t)))
+
+ (defthm rw.eqdatabase-atblp-of-rw.eqdatabase-extend
+   (implies (force (and (rw.eqdatabasep database)
+                        (rw.eqdatabase-atblp database atbl)
+                        (logic.termp nhyp)
+                        (logic.term-atblp nhyp atbl)))
+            (equal (rw.eqdatabase-atblp (rw.eqdatabase-extend nhyp database primaryp secondaryp directp negativep) atbl)
+                   t)))
+
+ (defthm rw.eqdatabase-okp-of-rw.eqdatabase-extend
+   (implies (force (and (logic.termp nhyp)
+                        (rw.hypboxp box)
+                        (rw.eqdatabasep database)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))
+                        (rw.eqdatabase-okp database box)))
+            (equal (rw.eqdatabase-okp (rw.eqdatabase-extend nhyp database primaryp secondaryp directp negativep) box)
+                   t))))
+
+
+
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (equal (rw.primary-eqtrace t nhyp) trace)
+                        (memberp nhyp x)
+                        (force (logic.term-listp x)))
+                   (iff (rw.find-nhyp-for-primary-eqtracep x trace)
+                        t))
+          :hints(("Goal" :in-theory (enable rw.find-nhyp-for-primary-eqtracep)))))
+
+ (local (defthm lemma2
+          (implies (and (subsetp sub sup)
+                        (rw.find-nhyp-for-primary-eqtracep sub trace)
+                        (force (logic.term-listp sub))
+                        (force (logic.term-listp sup)))
+                   (iff (rw.find-nhyp-for-primary-eqtracep sup trace)
+                        t))
+          :hints(("Goal" :use ((:instance lemma
+                                          (nhyp (rw.find-nhyp-for-primary-eqtracep sub trace))
+                                          (x sup)))))))
+
+ (defthm rw.primary-eqtrace-okp-in-extended-hypbox
+   (implies (and (rw.primary-eqtrace-okp trace sub)
+                 (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                 (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                 (force (rw.hypboxp sub))
+                 (force (rw.hypboxp sup)))
+            (equal (rw.primary-eqtrace-okp trace sup)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.primary-eqtrace-okp)))))
+
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (equal (rw.secondary-eqtrace t nhyp) trace)
+                        (memberp nhyp x)
+                        (force (logic.term-listp x)))
+                   (iff (rw.find-nhyp-for-secondary-eqtracep x trace)
+                        t))
+          :hints(("Goal" :in-theory (enable rw.find-nhyp-for-secondary-eqtracep)))))
+
+ (local (defthm lemma2
+          (implies (and (subsetp sub sup)
+                        (rw.find-nhyp-for-secondary-eqtracep sub trace)
+                        (force (logic.term-listp sub))
+                        (force (logic.term-listp sup)))
+                   (iff (rw.find-nhyp-for-secondary-eqtracep sup trace)
+                        t))
+          :hints(("Goal" :use ((:instance lemma
+                                          (nhyp (rw.find-nhyp-for-secondary-eqtracep sub trace))
+                                          (x sup)))))))
+
+ (defthm rw.secondary-eqtrace-okp-in-extended-hypbox
+   (implies (and (rw.secondary-eqtrace-okp trace sub)
+                 (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                 (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                 (force (rw.hypboxp sub))
+                 (force (rw.hypboxp sup)))
+            (equal (rw.secondary-eqtrace-okp trace sup)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.secondary-eqtrace-okp)))))
+
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (equal (rw.direct-iff-eqtrace t nhyp) trace)
+                        (memberp nhyp x)
+                        (force (logic.term-listp x)))
+                   (iff (rw.find-nhyp-for-direct-iff-eqtracep x trace)
+                        t))
+          :hints(("Goal" :in-theory (enable rw.find-nhyp-for-direct-iff-eqtracep)))))
+
+ (local (defthm lemma2
+          (implies (and (subsetp sub sup)
+                        (rw.find-nhyp-for-direct-iff-eqtracep sub trace)
+                        (force (logic.term-listp sub))
+                        (force (logic.term-listp sup)))
+                   (iff (rw.find-nhyp-for-direct-iff-eqtracep sup trace)
+                        t))
+          :hints(("Goal" :use ((:instance lemma
+                                          (nhyp (rw.find-nhyp-for-direct-iff-eqtracep sub trace))
+                                          (x sup)))))))
+
+ (defthm rw.direct-iff-eqtrace-okp-in-extended-hypbox
+   (implies (and (rw.direct-iff-eqtrace-okp trace sub)
+                 (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                 (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                 (force (rw.hypboxp sub))
+                 (force (rw.hypboxp sup)))
+            (equal (rw.direct-iff-eqtrace-okp trace sup)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.direct-iff-eqtrace-okp)))))
+
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (equal (rw.negative-iff-eqtrace t nhyp) trace)
+                        (memberp nhyp x)
+                        (force (logic.term-listp x)))
+                   (iff (rw.find-nhyp-for-negative-iff-eqtracep x trace)
+                        t))
+          :hints(("Goal" :in-theory (enable rw.find-nhyp-for-negative-iff-eqtracep)))))
+
+ (local (defthm lemma2
+          (implies (and (subsetp sub sup)
+                        (rw.find-nhyp-for-negative-iff-eqtracep sub trace)
+                        (force (logic.term-listp sub))
+                        (force (logic.term-listp sup)))
+                   (iff (rw.find-nhyp-for-negative-iff-eqtracep sup trace)
+                        t))
+          :hints(("Goal" :use ((:instance lemma
+                                          (nhyp (rw.find-nhyp-for-negative-iff-eqtracep sub trace))
+                                          (x sup)))))))
+
+ (defthm rw.negative-iff-eqtrace-okp-in-extended-hypbox
+   (implies (and (rw.negative-iff-eqtrace-okp trace sub)
+                 (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                 (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                 (force (rw.hypboxp sub))
+                 (force (rw.hypboxp sup)))
+            (equal (rw.negative-iff-eqtrace-okp trace sup)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.negative-iff-eqtrace-okp)))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (disable forcing-rw.eqtrace-list-okp-of-rw.eqtrace-subtraces)))
+
+ (local (defthm lemma
+          (implies (and (rw.hypboxp sub)
+                        (rw.hypboxp sup)
+                        (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                        (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup)))
+                   (if (equal flag 'trace)
+                       (implies (rw.eqtrace-okp x sub)
+                                (rw.eqtrace-okp x sup))
+                     (implies (rw.eqtrace-list-okp x sub)
+                              (rw.eqtrace-list-okp x sup))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (rw.flag-eqtrace-okp flag x sub)
+                  :in-theory (enable definition-of-rw.eqtrace-okp
+                                     rw.eqtrace-step-okp)))))
+
+ (defthm forcing-rw.eqtrace-okp-in-extended-hypbox
+   (implies (and (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                 (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                 (rw.eqtrace-okp x sub)
+                 (force (rw.hypboxp sub))
+                 (force (rw.hypboxp sup)))
+            (equal (rw.eqtrace-okp x sup)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'trace))))))
+
+ (defthm forcing-rw.eqtrace-list-okp-in-extended-hypbox
+   (implies (and (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                 (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                 (rw.eqtrace-list-okp x sub)
+                 (force (rw.hypboxp sub))
+                 (force (rw.hypboxp sup)))
+            (equal (rw.eqtrace-list-okp x sup)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+
+(defthm rw.eqset-okp-in-extended-hypbox
+  (implies (and (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                (rw.eqset-okp x sub)
+                (force (rw.hypboxp sub))
+                (force (rw.hypboxp sup)))
+           (equal (rw.eqset-okp x sup)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.eqset-okp)
+                                 ((:executable-counterpart ACL2::force))))))
+
+(defthm rw.eqset-list-okp-in-extended-hypbox
+  (implies (and (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                (rw.eqset-list-okp x sub)
+                (force (rw.hypboxp sub))
+                (force (rw.hypboxp sup)))
+           (equal (rw.eqset-list-okp x sup)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.eqdatabase-okp-in-extended-hypbox
+  (implies (and (subsetp (rw.hypbox->left sub) (rw.hypbox->left sup))
+                (subsetp (rw.hypbox->right sub) (rw.hypbox->right sup))
+                (rw.eqdatabase-okp x sub)
+                (force (rw.hypboxp sub))
+                (force (rw.hypboxp sup)))
+           (equal (rw.eqdatabase-okp x sup)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.eqdatabase-okp)
+                                 (forcing-rw.eqset-list-okp-of-rw.eqdatabase->equalsets
+                                  forcing-rw.eqset-list-okp-of-rw.eqdatabase->iffsets
+                                  forcing-rw.trace-okp-of-rw.eqdatabase->contradiction)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/assmctrl.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/assmctrl.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/assmctrl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/assmctrl.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,48 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../../utilities/defaggregate")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defaggregate rw.assmctrl
+  (primaryp secondaryp directp negativep)
+  :require ((booleanp-of-rw.assmctrl->primaryp   (booleanp primaryp))
+            (booleanp-of-rw.assmctrl->secondaryp (booleanp secondaryp))
+            (booleanp-of-rw.assmctrl->directp    (booleanp directp))
+            (booleanp-of-rw.assmctrl->negativep  (booleanp negativep)))
+  :legiblep nil)
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/assmsp.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/assmsp.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/assmsp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/assmsp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,781 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hypboxp")
+(include-book "add-equality")
+(include-book "assmctrl")
+(include-book "../../clauses/smart-negate")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Introduction to assumptions.
+;;
+;; Assumptions allow our conditional rewriter to make more progress by knowing
+;; that certain things are true.
+;;
+;; Where do assumptions come from?  Normally we are rewriting a term which
+;; occurs in a clause.  Say the clause is T1 v ... v Tn, and we are rewriting
+;; T1.  Then we can think of the clause as an implication:
+;;
+;;    [| ~T2 ; ... ; ~Tn |] ==> T1
+;;
+;; We can thus assume ~T2, ..., and ~Tn while rewriting T1.  We call these
+;; assumptions CLAUSE ASSUMPTIONS since they come from the clause.  This is one
+;; of the reasons clause splitting is so great: splitting up complex literals
+;; into lots of simple literals gives us more assumptions to work with.
+;;
+;; Another source of assumptions is from unsplit literals.  As we are
+;; descending through T1, we might encounter (if x y z).  Then, when we rewrite
+;; y we can additionally assume x is true, and when we rewrite z we can assume
+;; x is false.  We call these CASE ASSUMPTIONS since they come from cases
+;; within the term we're rewriting.  Note that case assumptions can occur even
+;; if we fully split the clause before rewriting, since ifs can occur in the
+;; replacement term in a rewrite rule or in a hypothesis.
+;;
+;; Unlike ACL2, we don't make assumptions when we backchain.  This may cause us
+;; to miss some things, but, along with some other design decisions, it
+;; entirely prevents tail biting even without our having to track the literals
+;; which lead to our assumptions.
+;;
+;;
+;;
+;; Assumption structures and hypboxes.
+;;
+;; Before we begin rewriting a term, we assume all the other literals in the
+;; clause are false and build an "assms" structure for these assumptions.  Each
+;; assms structure has three key pieces:
+;;
+;;   - A "hypbox" where we put the actual terms we have assumed false,
+;;   - Additional databases of "inferred" information, and
+;;   - A list of terms we believe are true (which are used heuristically
+;;     by the rewriter)
+;;
+;; For obscure efficiency reasons (see crewrite-clause.lisp for details) each
+;; hypbox has two "sides", called left and right.  Each side is just a list of
+;; terms which we are assuming false, and together the union of left and right
+;; gives us all of the terms which have been assumed false.
+;;
+;; The additional databases are used to "strengthen" our assumptions before we
+;; begin rewriting with them.  The idea is that we may want to infer additional
+;; information from our assumptions, e.g., if we have assumed a = b and b = c,
+;; then we would like to infer a = c.  We keep these databases separate from
+;; our hypbox, so that new things may be inferred while leaving predicatable
+;; the set of things we have assumed.
+;;
+;; New assumptions are added to the assumptiosn structure using the following
+;; functions:
+;;
+;;    (rw.assume-left  nhyp assms) ==> assms'
+;;    (rw.assume-right nhyp assms) ==> assms'
+;;
+;; Each of these assumes nhyp is false.  So, if you want to assume that "hyp"
+;; is true, you need to assume its negation is false.  The assumption is put
+;; into the left or right side of the hypbox as appropriate.  Note that adding
+;; new assumptions might contradict previous assumptions, and we discuss this
+;; in detail below.
+;;
+;; Once the database has been created, we can use it to simplify terms with the
+;; following function:
+;;
+;;    (rw.try-assms term iffp assms) ==> eqtrace or nil
+;;
+;; Nil is returned on failure, and an "eqtrace" is returned when we can
+;; simplify term in some way under the given iffp context.  These traces are
+;; similar to rewriter traces in that they can be compiled into an actual proof
+;; of their conclusion---see eqtracep.lisp for more details.  When an eqtrace
+;; is returned, the compiled proof will conclude:
+;;
+;;    hypbox-formula v (equiv term term') = t
+;;
+;; Where the hypbox-formula is either:
+;;
+;;    (clause.clause-formula nhyps-left) v (clause.clause-formula nhyps-right)
+;;
+;; Or is just the appropriate part of this if the other part is empty.  If both
+;; the left and right sides of the hypbox are empty, then rw.try-assums always
+;; fails, i.e., returns nil.
+;;
+;;
+;;
+;; Dealing with contradictions.
+;;
+;; Before we rewrite a term, we make clause assumptions for the other literals
+;; in the clause.  This might produce a contradiction.  If so, we don't need to
+;; do rewriting at all, because it means some Ti and Tj cannot both be false at
+;; the same time, so the clause must be true.
+;;
+;; But we could also encounter a contradiction while making a case assumption.
+;; For example, perhaps we are rewriting (if x y z) and we want to assume x is
+;; true before rewriting y.  Here, assuming x is true might lead us to discover
+;; a contradiction.  Then x must be false, so you might think we should rewrite
+;; the whole term (if x y z) to z.
+;;
+;; But this is so messy that I consider it to be degenerate.  Before we go to
+;; rewrite y or z, we should have tried to rewrite x.  If assuming x is true
+;; causes a contradiction, then it's my opinion that x should have just been
+;; rewritten to nil in the first place.  It might be interesting to try to
+;; formalize this idea later, but I haven't tried to do this yet.
+;;
+;; We can check for a contradiction using the function:
+;;
+;;   (rw.assms->contradiction assms) ==> nil or proof
+;;
+;; Nil is returned when there is no contradiction, and otherwise a proof of the
+;; hypbox-formula is returned.  If we have an assms structure which already has
+;; a contradiction, the contradiction will of course be preserved as we add
+;; more assumptions to it.  Hence, during the initial assms setup we can just
+;; dump in all the literals from the clause, and check at the end if any
+;; contradiction has occurred.
+
+
+(defsection rw.assmsp
+
+  (defund rw.assmsp (x)
+    (declare (xargs :guard t))
+    ;; We'd like to use defaggregate but the "implies" is pretty complicated.
+    ;; Instead, we use a custom cons structure.
+    ;;  (hypbox . contradiction) . ((eqdatabase . trueterms) . ctrl)
+    (and (consp (car x)) ;; apparently we care about the consp-ness later on
+         (consp (cdr x)) ;; for forcing-equal-of-rw.assms-one
+         (consp (car (cdr x)))
+         (let ((hypbox        (car (car x)))
+               (contradiction (cdr (car x)))
+               (eqdatabase    (car (car (cdr x))))
+               (trueterms     (cdr (car (cdr x))))
+               (ctrl          (cdr (cdr x))))
+           (and (rw.hypboxp hypbox)
+                (rw.eqdatabasep eqdatabase)
+                (rw.eqdatabase-okp eqdatabase hypbox)
+                (or (not contradiction)
+                    (and (rw.eqtracep contradiction)
+                         (rw.eqtrace-contradictionp contradiction)
+                         (rw.eqtrace-okp contradiction hypbox)))
+                (logic.term-listp trueterms)
+                (rw.assmctrlp ctrl)))))
+
+  (definlined rw.assms (hypbox contradiction eqdatabase trueterms ctrl)
+    (declare (xargs :guard (and (rw.hypboxp hypbox)
+                                (rw.eqdatabasep eqdatabase)
+                                (rw.eqdatabase-okp eqdatabase hypbox)
+                                (or (not contradiction)
+                                    (and (rw.eqtracep contradiction)
+                                         (rw.eqtrace-contradictionp contradiction)
+                                         (rw.eqtrace-okp contradiction hypbox)))
+                                (logic.term-listp trueterms)
+                                (rw.assmctrlp ctrl))))
+    (cons (cons hypbox contradiction)
+          (cons (cons eqdatabase trueterms)
+                ctrl)))
+
+  (definlined rw.assms->hypbox (x)
+    (declare (xargs :guard (rw.assmsp x)))
+    (car (car x)))
+
+  (definlined rw.assms->contradiction (x)
+    (declare (xargs :guard (rw.assmsp x)))
+    (cdr (car x)))
+
+  (definlined rw.assms->eqdatabase (x)
+    (declare (xargs :guard (rw.assmsp x)))
+    (car (car (cdr x))))
+
+  (definlined rw.assms->trueterms (x)
+    (declare (xargs :guard (rw.assmsp x)))
+    (cdr (car (cdr x))))
+
+  (definlined rw.assms->ctrl (x)
+    (declare (xargs :guard (rw.assmsp x)))
+    (cdr (cdr x)))
+
+
+  (definlined rw.assms-atblp (x atbl)
+    (declare (xargs :guard (and (rw.assmsp x)
+                                (logic.arity-tablep atbl))
+                    :guard-hints (("Goal" :in-theory (enable rw.assmsp
+                                                             rw.assms->hypbox
+                                                             rw.assms->eqdatabase
+                                                             rw.assms->contradiction
+                                                             rw.assms->trueterms)))))
+    (let ((hypbox        (rw.assms->hypbox x))
+          (eqdatabase    (rw.assms->eqdatabase x))
+          (contradiction (rw.assms->contradiction x))
+          (trueterms     (rw.assms->trueterms x)))
+      (and (rw.hypbox-atblp hypbox atbl)
+           (rw.eqdatabase-atblp eqdatabase atbl)
+           (or (not contradiction)
+               (rw.eqtrace-atblp contradiction atbl))
+           (logic.term-list-atblp trueterms atbl))))
+
+  (local (in-theory (enable rw.assmsp
+                            rw.assms
+                            rw.assms->hypbox
+                            rw.assms->contradiction
+                            rw.assms->eqdatabase
+                            rw.assms->trueterms
+                            rw.assms->ctrl
+                            rw.assms-atblp)))
+
+  (defthm booleanp-of-rw.assmsp
+    (equal (booleanp (rw.assmsp x))
+           t))
+
+  (defthm booleanp-of-rw.assms-atblp
+    (equal (booleanp (rw.assms-atblp x atbl))
+           t))
+
+  (defthm forcing-rw.assmsp-of-rw.assms
+    (implies (force (and (rw.hypboxp hypbox)
+                         (rw.eqdatabasep eqdatabase)
+                         (rw.eqdatabase-okp eqdatabase hypbox)
+                         (or (not contradiction)
+                             (and (rw.eqtracep contradiction)
+                                  (rw.eqtrace-contradictionp contradiction)
+                                  (rw.eqtrace-okp contradiction hypbox)))
+                         (logic.term-listp trueterms)
+                         (rw.assmctrlp ctrl)))
+             (equal (rw.assmsp (rw.assms hypbox contradiction eqdatabase trueterms ctrl))
+                    t)))
+
+  (defthm forcing-rw.assms-atblp-of-rw.assms
+    (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                         (rw.eqdatabase-atblp eqdatabase atbl)
+                         (or (not contradiction)
+                             (rw.eqtrace-atblp contradiction atbl))
+                         (logic.term-list-atblp trueterms atbl)))
+             (equal (rw.assms-atblp (rw.assms hypbox contradiction eqdatabase trueterms ctrl) atbl)
+                    t)))
+
+  (defthm rw.assms->hypbox-of-rw.assms
+    (equal (rw.assms->hypbox (rw.assms hypbox contradiction eqdatabase trueterms ctrl))
+           hypbox))
+
+  (defthm rw.assms->contradiction-of-rw.assms
+    (equal (rw.assms->contradiction (rw.assms hypbox contradiction eqdatabase trueterms ctrl))
+           contradiction))
+
+  (defthm rw.assms->eqdatabase-of-rw.assms
+    (equal (rw.assms->eqdatabase (rw.assms hypbox contradiction eqdatabase trueterms ctrl))
+           eqdatabase))
+
+  (defthm rw.assms->trueterms-of-rw.assms
+    (equal (rw.assms->trueterms (rw.assms hypbox contradiction eqdatabase trueterms ctrl))
+           trueterms))
+
+  (defthm rw.assms->ctrl-of-rw.assms
+    (equal (rw.assms->ctrl (rw.assms hypbox contradiction eqdatabase trueterms ctrl))
+           ctrl))
+
+  (defthm forcing-rw.hypboxp-of-rw.assms->hypbox
+    (implies (force (rw.assmsp x))
+             (equal (rw.hypboxp (rw.assms->hypbox x))
+                    t)))
+
+  (defthm forcing-rw.hypbox-atblp-of-rw.assms->hypbox
+    (implies (force (rw.assms-atblp x atbl))
+             (equal (rw.hypbox-atblp (rw.assms->hypbox x) atbl)
+                    t)))
+
+  (defthm forcing-rw.eqdatabasep-of-rw.assms->eqdatabase
+    (implies (force (rw.assmsp x))
+             (equal (rw.eqdatabasep (rw.assms->eqdatabase x))
+                    t)))
+
+  (defthm forcing-rw.eqdatabase-okp-of-rw.assms->eqdatabase
+    (implies (force (rw.assmsp x))
+             (equal (rw.eqdatabase-okp (rw.assms->eqdatabase x)
+                                       (rw.assms->hypbox x))
+                    t)))
+
+  (defthm forcing-rw.eqdatabase-atblp-of-rw.assms->eqdatabase
+    (implies (force (rw.assms-atblp x atbl))
+             (equal (rw.eqdatabase-atblp (rw.assms->eqdatabase x) atbl)
+                    t)))
+
+  (defthm rw.assms->contradiction-when-no-assumptions
+    (implies (and (not (rw.hypbox->left (rw.assms->hypbox x)))
+                  (not (rw.hypbox->right (rw.assms->hypbox x)))
+                  (force (rw.assmsp x)))
+             (equal (rw.assms->contradiction x)
+                    nil)))
+
+  (defthm forcing-rw.eqtracep-of-rw.assms->contradiction
+    (implies (force (and (rw.assmsp x)
+                         (rw.assms->contradiction x)))
+             (equal (rw.eqtracep (rw.assms->contradiction x))
+                    t)))
+
+  (defthm forcing-rw.eqtrace-contradictionp-of-rw.assms->contradiction
+    (implies (force (and (rw.assmsp x)
+                         (rw.assms->contradiction x)))
+             (equal (rw.eqtrace-contradictionp (rw.assms->contradiction x))
+                    t)))
+
+  (defthm forcing-rw.eqtrace-okp-of-rw.assms->contradiction-and-rw.assms->hypbox
+    (implies (force (and (rw.assmsp x)
+                         (rw.assms->contradiction x)))
+             (equal (rw.eqtrace-okp (rw.assms->contradiction x) (rw.assms->hypbox x))
+                    t)))
+
+  (defthm forcing-logic.term-listp-of-rw.assms->trueterms
+    (implies (force (rw.assmsp x))
+             (equal (logic.term-listp (rw.assms->trueterms x))
+                    t)))
+
+  (defthm forcing-logic.term-list-atblp-of-rw.assms->trueterms
+    (implies (force (rw.assms-atblp x atbl))
+             (equal (logic.term-list-atblp (rw.assms->trueterms x) atbl)
+                    t)))
+
+  (defthm forcing-rw.assmctrlp-of-rw.assms->ctrl
+    (implies (force (rw.assmsp x))
+             (equal (rw.assmctrlp (rw.assms->ctrl x))
+                    t)))
+
+  (defthm forcing-equal-of-rw.assms-one
+    (implies (force (rw.assmsp x))
+             (equal (equal x (rw.assms hypbox contradiction eqdatabase trueterms ctrl))
+                    (and (equal (rw.assms->hypbox x) hypbox)
+                         (equal (rw.assms->contradiction x) contradiction)
+                         (equal (rw.assms->eqdatabase x) eqdatabase)
+                         (equal (rw.assms->trueterms x) trueterms)
+                         (equal (rw.assms->ctrl x) ctrl)))))
+
+  (defthm forcing-equal-of-rw.assms-two
+    (implies (force (rw.assmsp x))
+             (equal (equal (rw.assms hypbox contradiction eqdatabase trueterms ctrl) x)
+                    (and (equal (rw.assms->hypbox x) hypbox)
+                         (equal (rw.assms->contradiction x) contradiction)
+                         (equal (rw.assms->eqdatabase x) eqdatabase)
+                         (equal (rw.assms->trueterms x) trueterms)
+                         (equal (rw.assms->ctrl x) ctrl)
+                         ))))
+
+  (defthm rw.assms-atblp-of-nil
+    (equal (rw.assms-atblp nil atbl)
+           t)))
+
+(deflist rw.assms-listp (x)
+  (rw.assmsp x)
+  :elementp-of-nil nil
+  :guard t)
+
+(deflist rw.assms-list-atblp (x atbl)
+  (rw.assms-atblp x atbl)
+  :elementp-of-nil t
+  :guard (and (rw.assms-listp x)
+              (logic.arity-tablep atbl)))
+
+
+
+(definlined rw.empty-eqdatabase ()
+  (declare (xargs :guard t))
+  (rw.eqdatabase nil nil nil))
+
+(in-theory (disable (:e rw.empty-eqdatabase)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.empty-eqdatabase
+                           rw.eqdatabase-atblp
+                           rw.eqdatabase-okp)))
+
+ (defthm rw.eqdatabasep-of-rw.empty-eqdatabase
+   (equal (rw.eqdatabasep (rw.empty-eqdatabase))
+          t))
+
+ (defthm rw.eqdatabase-atblp-of-rw.empty-eqdatabase
+   (equal (rw.eqdatabase-atblp (rw.empty-eqdatabase) atbl)
+          t))
+
+ (defthm rw.eqdatabase-okp-of-rw.empty-eqdatabase
+   (equal (rw.eqdatabase-okp (rw.empty-eqdatabase) box)
+          t))
+
+ (defthm rw.eqdatabase->equalsets-of-rw.empty-eqdatabase
+   (equal (rw.eqdatabase->equalsets (rw.empty-eqdatabase))
+          nil))
+
+ (defthm rw.eqdatabase->contradiction-of-rw.empty-eqdatabase
+   (equal (rw.eqdatabase->contradiction (rw.empty-eqdatabase))
+          nil)))
+
+
+
+(definlined rw.empty-assms (ctrl)
+  (declare (xargs :guard (rw.assmctrlp ctrl)))
+  (rw.assms (rw.hypbox nil nil)
+            nil
+            (rw.empty-eqdatabase)
+            nil
+            ctrl))
+
+(in-theory (disable (:e rw.empty-assms)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.empty-assms)))
+
+ (defthm rw.assmsp-of-rw.empty-assms
+   (implies (force (rw.assmctrlp ctrl))
+            (equal (rw.assmsp (rw.empty-assms ctrl))
+                   t)))
+
+ (defthm rw.assms-atblp-of-rw.empty-assms
+   (equal (rw.assms-atblp (rw.empty-assms ctrl) atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.assms-atblp))))
+
+ (defthm rw.assms->hypbox-of-rw.empty-assms
+   (equal (rw.assms->hypbox (rw.empty-assms ctrl))
+          (rw.hypbox nil nil)))
+
+ (defthm rw.assms->contradiction-of-rw.empty-assms
+   (equal (rw.assms->contradiction (rw.empty-assms ctrl))
+          nil))
+
+ (defthm rw.assms->eqdatabase-of-rw.empty-assms
+   (equal (rw.assms->eqdatabase (rw.empty-assms ctrl))
+          (rw.empty-eqdatabase)))
+
+ (defthm rw.assms->trueterms-of-rw.empty-assms
+   (equal (rw.assms->trueterms (rw.empty-assms ctrl))
+          nil))
+
+ (defthm rw.assms->ctrl-of-rw.empty-assms
+   (equal (rw.assms->ctrl (rw.empty-assms ctrl))
+          ctrl)))
+
+
+
+
+
+;; MAKING ASSUMPTIONS.
+
+
+(defthm rw.eqset-atblp-when-not-consp
+  ;; BOZO find me a proper home
+  (implies (not (consp x))
+           (equal (rw.eqset-atblp x atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.eqset-atblp
+                                  rw.eqset->tail)
+                                 ((:e ACL2::force))))))
+
+(defthm forcing-rw.eqset-atblp-of-rw.find-relevant-set
+  ;; BOZO find me a proper home
+  (implies (force (rw.eqset-list-atblp sets atbl))
+           (equal (rw.eqset-atblp (rw.find-relevant-eqset term sets) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-relevant-eqset))))
+
+
+
+(defsection rw.assume-left
+
+  (definlined rw.assume-left (nhyp assms)
+    (declare (xargs :guard (and (logic.termp nhyp)
+                                (rw.assmsp assms))
+                    :verify-guards nil))
+    (let* ((hypbox     (rw.assms->hypbox assms))
+           (eqdb       (rw.assms->eqdatabase assms))
+           (new-hypbox (rw.hypbox (cons nhyp (rw.hypbox->left hypbox))
+                                  (rw.hypbox->right hypbox)))
+           (ctrl       (rw.assms->ctrl assms))
+           (new-eqdb   (rw.eqdatabase-extend nhyp eqdb
+                                             (rw.assmctrl->primaryp ctrl)
+                                             (rw.assmctrl->secondaryp ctrl)
+                                             (rw.assmctrl->directp ctrl)
+                                             (rw.assmctrl->negativep ctrl)))
+           (cont       (rw.eqdatabase->contradiction new-eqdb))
+           ;; We considered using the iff-t set, but found negating the equal-nil set to
+           ;; be a better bet since it gives us (not x) terms as well.  Is this a bug
+           ;; with our iff sets, or do we handle this?
+           (false-set  (rw.find-relevant-eqset ''nil (rw.eqdatabase->equalsets new-eqdb)))
+           (trueterms  (if false-set
+                           (clause.smart-negate-list (rw.eqset->rhses false-set))
+                         nil)))
+      (rw.assms new-hypbox cont new-eqdb trueterms ctrl)))
+
+  (defthmd lemma-for-rw.assume-left
+    (implies (and (force (rw.assmsp assms))
+                  (force (logic.termp nhyp)))
+             (equal (rw.eqdatabase-okp (rw.assms->eqdatabase assms)
+                                       (rw.hypbox (cons nhyp (rw.hypbox->left (rw.assms->hypbox assms)))
+                                                  (rw.hypbox->right (rw.assms->hypbox assms))))
+                    t))
+    :hints(("Goal"
+            :in-theory (disable rw.eqdatabase-okp-in-extended-hypbox)
+            :use ((:instance rw.eqdatabase-okp-in-extended-hypbox
+                             (sub (rw.assms->hypbox assms))
+                             (sup (rw.hypbox (cons nhyp (rw.hypbox->left (rw.assms->hypbox assms)))
+                                             (rw.hypbox->right (rw.assms->hypbox assms))))
+                             (x (rw.assms->eqdatabase assms)))))))
+
+  (local (in-theory (enable rw.assume-left
+                            lemma-for-rw.assume-left)))
+
+  (verify-guards rw.assume-left
+                 :hints(("Goal" :in-theory (enable rw.eqtrace-formula))))
+
+  (defthm forcing-rw.assmsp-of-rw.assume-left
+    (implies (force (and (logic.termp nhyp)
+                         (rw.assmsp assms)))
+             (equal (rw.assmsp (rw.assume-left nhyp assms))
+                    t)))
+
+  (defthm forcing-rw.assms-atblp-of-rw.assume-left
+    (implies (force (and (logic.termp nhyp)
+                         (logic.term-atblp nhyp atbl)
+                         (rw.assmsp assms)
+                         (rw.assms-atblp assms atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.assms-atblp (rw.assume-left nhyp assms) atbl)
+                    t)))
+
+  (defthm rw.assms->hypbox-of-rw.assume-left
+    (equal (rw.assms->hypbox (rw.assume-left nhyp assms))
+           (rw.hypbox (cons nhyp (rw.hypbox->left (rw.assms->hypbox assms)))
+                      (rw.hypbox->right (rw.assms->hypbox assms))))))
+
+
+
+
+(defsection rw.assume-right
+
+  (definlined rw.assume-right (nhyp assms)
+    (declare (xargs :guard (and (logic.termp nhyp)
+                                (rw.assmsp assms))
+                    :verify-guards nil))
+    (let* ((hypbox     (rw.assms->hypbox assms))
+           (eqdb       (rw.assms->eqdatabase assms))
+           (new-hypbox (rw.hypbox (rw.hypbox->left hypbox)
+                                  (cons nhyp (rw.hypbox->right hypbox))))
+           (ctrl       (rw.assms->ctrl assms))
+           (new-eqdb   (rw.eqdatabase-extend nhyp eqdb
+                                             (rw.assmctrl->primaryp ctrl)
+                                             (rw.assmctrl->secondaryp ctrl)
+                                             (rw.assmctrl->directp ctrl)
+                                             (rw.assmctrl->negativep ctrl)))
+           (cont       (rw.eqdatabase->contradiction new-eqdb))
+           (false-row  (rw.find-relevant-eqset ''nil (rw.eqdatabase->equalsets new-eqdb)))
+           (trueterms  (if false-row
+                           (clause.smart-negate-list (rw.eqset->rhses false-row))
+                         nil)))
+      (rw.assms new-hypbox cont new-eqdb trueterms ctrl)))
+
+  (defthmd lemma-for-rw.assume-right
+    (implies (and (force (rw.assmsp assms))
+                  (force (logic.termp nhyp)))
+             (equal (rw.eqdatabase-okp (rw.assms->eqdatabase assms)
+                                       (rw.hypbox (rw.hypbox->left (rw.assms->hypbox assms))
+                                                  (cons nhyp (rw.hypbox->right (rw.assms->hypbox assms)))))
+                    t))
+    :hints(("Goal"
+            :in-theory (disable rw.eqdatabase-okp-in-extended-hypbox)
+            :use ((:instance rw.eqdatabase-okp-in-extended-hypbox
+                             (sub (rw.assms->hypbox assms))
+                             (sup (rw.hypbox (rw.hypbox->left (rw.assms->hypbox assms))
+                                             (cons nhyp (rw.hypbox->right (rw.assms->hypbox assms)))))
+                             (x (rw.assms->eqdatabase assms)))))))
+
+  (local (in-theory (enable rw.assume-right
+                            lemma-for-rw.assume-right)))
+
+  (verify-guards rw.assume-right)
+
+  (defthm forcing-rw.assmsp-of-rw.assume-right
+    (implies (force (and (logic.termp nhyp)
+                         (rw.assmsp assms)))
+             (equal (rw.assmsp (rw.assume-right nhyp assms))
+                    t)))
+
+  (defthm forcing-rw.assms-atblp-of-rw.assume-right
+    (implies (force (and (logic.termp nhyp)
+                         (logic.term-atblp nhyp atbl)
+                         (rw.assmsp assms)
+                         (rw.assms-atblp assms atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.assms-atblp (rw.assume-right nhyp assms) atbl)
+                    t)))
+
+  (defthm rw.assms->hypbox-of-rw.assume-right
+    (equal (rw.assms->hypbox (rw.assume-right nhyp assms))
+           (rw.hypbox (rw.hypbox->left (rw.assms->hypbox assms))
+                      (cons nhyp (rw.hypbox->right (rw.assms->hypbox assms)))))
+    :hints(("Goal" :in-theory (enable rw.assume-right)))))
+
+
+
+(defsection rw.assume-left-list
+
+  (defund rw.assume-left-list (nhyps assms)
+    (declare (xargs :guard (and (logic.term-listp nhyps)
+                                (rw.assmsp assms))))
+    (if (consp nhyps)
+        (rw.assume-left (car nhyps)
+                        (rw.assume-left-list (cdr nhyps) assms))
+      assms))
+
+  (defthm rw.assume-left-list-when-not-consp
+    (implies (not (consp nhyps))
+             (equal (rw.assume-left-list nhyps assms)
+                    assms))
+    :hints(("Goal" :in-theory (enable rw.assume-left-list))))
+
+  (defthm rw.assume-left-list-of-cons
+    (equal (rw.assume-left-list (cons nhyp nhyps) assms)
+           (rw.assume-left nhyp (rw.assume-left-list nhyps assms)))
+    :hints(("Goal" :in-theory (enable rw.assume-left-list))))
+
+  (defthm forcing-rw.assmsp-of-rw.assume-left-list
+    (implies (force (and (logic.term-listp nhyps)
+                         (rw.assmsp assms)))
+             (equal (rw.assmsp (rw.assume-left-list nhyps assms))
+                    t))
+    :hints(("Goal" :induct (cdr-induction nhyps))))
+
+  (defthm forcing-rw.assms-atblp-of-rw.assume-left-list
+    (implies (force (and (logic.term-listp nhyps)
+                         (logic.term-list-atblp nhyps atbl)
+                         (rw.assmsp assms)
+                         (rw.assms-atblp assms atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.assms-atblp (rw.assume-left-list nhyps assms) atbl)
+                    t))
+    :hints(("Goal" :induct (cdr-induction nhyps))))
+
+  (defthm forcing-rw.assms->nhyps-of-rw.assume-left-list
+    (implies (force (and (logic.term-listp nhyps)
+                         (rw.assmsp assms)))
+             (equal (rw.assms->hypbox (rw.assume-left-list nhyps assms))
+                    (rw.hypbox (app nhyps (rw.hypbox->left (rw.assms->hypbox assms)))
+                               (rw.hypbox->right (rw.assms->hypbox assms)))))
+    :hints(("Goal" :induct (cdr-induction nhyps)))))
+
+
+
+
+(defsection rw.assume-right-list
+
+  (defund rw.assume-right-list (nhyps assms)
+    (declare (xargs :guard (and (logic.term-listp nhyps)
+                                (rw.assmsp assms))))
+    (if (consp nhyps)
+        (rw.assume-right (car nhyps)
+                         (rw.assume-right-list (cdr nhyps) assms))
+      assms))
+
+  (defthm rw.assume-right-list-when-not-consp
+    (implies (not (consp nhyps))
+             (equal (rw.assume-right-list nhyps assms)
+                    assms))
+    :hints(("Goal" :in-theory (enable rw.assume-right-list))))
+
+  (defthm rw.assume-right-list-of-cons
+    (equal (rw.assume-right-list (cons nhyp nhyps) assms)
+           (rw.assume-right nhyp (rw.assume-right-list nhyps assms)))
+    :hints(("Goal" :in-theory (enable rw.assume-right-list))))
+
+  (defthm forcing-rw.assmsp-of-rw.assume-right-list
+    (implies (force (and (logic.term-listp nhyps)
+                         (rw.assmsp assms)))
+             (equal (rw.assmsp (rw.assume-right-list nhyps assms))
+                    t))
+    :hints(("Goal" :induct (cdr-induction nhyps))))
+
+  (defthm forcing-rw.assms-atblp-of-rw.assume-right-list
+    (implies (force (and (logic.term-listp nhyps)
+                         (logic.term-list-atblp nhyps atbl)
+                         (rw.assmsp assms)
+                         (rw.assms-atblp assms atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.assms-atblp (rw.assume-right-list nhyps assms) atbl)
+                    t))
+    :hints(("Goal" :induct (cdr-induction nhyps))))
+
+  (defthm forcing-rw.assms->hypbox-right-of-rw.assume-right-list
+    (implies (force (and (logic.term-listp nhyps)
+                         (rw.assmsp assms)))
+             (equal (rw.assms->hypbox (rw.assume-right-list nhyps assms))
+                    (rw.hypbox (rw.hypbox->left (rw.assms->hypbox assms))
+                               (app nhyps (rw.hypbox->right (rw.assms->hypbox assms))))))
+    :hints(("Goal" :induct (cdr-induction nhyps)))))
+
+
+
+
+
+(definlined rw.assms-emptyp (assms)
+  (declare (xargs :guard (rw.assmsp assms)))
+  (let ((hypbox (rw.assms->hypbox assms)))
+    (and (not (rw.hypbox->left hypbox))
+         (not (rw.hypbox->right hypbox)))))
+
+(defthm booleanp-of-rw.assms-emptyp
+  (equal (booleanp (rw.assms-emptyp assms))
+         t)
+  :hints(("Goal" :in-theory (enable rw.assms-emptyp))))
+
+(defthm rw.assms-emptyp-of-rw.empty-assms
+  (equal (rw.assms-emptyp (rw.empty-assms ctrl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.assms-emptyp))))
+
+
+
+(definlined rw.assms-formula (assms)
+  (declare (xargs :guard (and (rw.assmsp assms)
+                              (not (rw.assms-emptyp assms)))
+                  :guard-hints (("Goal" :in-theory (enable rw.assms-emptyp)))))
+  (rw.hypbox-formula (rw.assms->hypbox assms)))
+
+(defthm forcing-logic.formulap-of-rw.assms-formula
+  (implies (force (and (rw.assmsp assms)
+                       (not (rw.assms-emptyp assms))))
+           (equal (logic.formulap (rw.assms-formula assms))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.assms-formula rw.assms-emptyp))))
+
+(defthm forcing-logic.formula-atblp-of-rw.assms-formula
+  (implies (force (and (rw.assmsp assms)
+                       (rw.assms-atblp assms atbl)
+                       (not (rw.assms-emptyp assms))))
+           (equal (logic.formula-atblp (rw.assms-formula assms) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.assms-formula rw.assms-emptyp))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/cert.acl2 acl2-6.3/books/milawa/ACL2/rewrite/assms/cert.acl2
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/cert.acl2	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/contradiction-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/contradiction-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/contradiction-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/contradiction-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,509 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "contradictionp")
+(include-book "eqtrace-compiler")
+(include-book "../../clauses/basic-bldrs")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(deftheorem theorem-inequality-of-not-x-and-x
+  :derive (!= (not x) x)
+  :proof  (@derive
+           ((v (= x nil) (= (if x y z) y))       (build.axiom (axiom-if-when-not-nil)))
+           ((v (= x nil) (= (if x nil t) nil))   (build.instantiation @- (@sigma (y . nil) (z . t)))   *1a)
+           ((v (!= nil x) (= nil x))             (build.propositional-schema (@formula (= nil x))))
+           ((v (!= nil x) (= x nil))             (build.disjoined-commute-pequal @-))
+           ((v (= x nil) (!= nil x))             (build.commute-or @-))
+           ((v (= x nil) (!= (if x nil t) x))    (build.disjoined-substitute-into-not-pequal @- *1a)   *1)
+           ;; ---
+           ((v (!= x nil) (= (if x y z) z))      (build.axiom (axiom-if-when-nil)))
+           ((v (!= x nil) (= (if x nil t) t))    (build.instantiation @- (@sigma (y . nil) (z . t)))   *2a)
+           ((v (!= x nil) (= x nil))             (build.propositional-schema (@formula (= x nil))))
+           ((v (!= x nil) (!= x t))              (build.disjoined-not-t-from-nil @-))
+           ((v (!= x nil) (!= t x))              (build.disjoined-commute-not-pequal @-))
+           ((v (!= x nil) (!= (if x nil t) x))   (build.disjoined-substitute-into-not-pequal @- *2a)   *2)
+           ;; ---
+           ((v (!= (if x nil t) x)
+               (!= (if x nil t) x))              (build.cut *1 *2))
+           ((!= (if x nil t) x)                  (build.contraction @-))
+           ((= (not x) (if x nil t))             (build.axiom (definition-of-not)))
+           ((!= (not x) x)                       (build.substitute-into-not-pequal @-- @-)))
+  :minatbl ((not . 1)
+            (if . 3)))
+
+(deftheorem theorem-not-x-and-x-under-iff
+  :derive (= (iff (not x) x) nil)
+  :proof  (@derive
+           ((= (iff x y) (if x (if y t nil) (if y nil t)))                             (build.axiom (definition-of-iff)))
+           ((= (iff (not x) x) (if (not x) (if x t nil) (if x nil t)))                 (build.instantiation @- (@sigma (x . (not x)) (y . x)))                        *0)
+           ;; ---
+           ((v (!= x nil) (= (not x) t))                                               (build.theorem (theorem-not-when-nil))                                         *1a)
+           ((v (!= x nil) (= (if x y z) z))                                            (build.axiom (axiom-if-when-nil)))
+           ((v (!= x nil) (= (if x t nil) nil))                                        (build.instantiation @- (@sigma (y . t) (z . nil)))                            *1b)
+           ((v (!= x nil) (= (if x nil t) t))                                          (build.instantiation @-- (@sigma (y . nil) (z . t)))                           *1c)
+           ((v (!= x nil) (= (if (not x) (if x t nil) (if x nil t)) (if t nil t)))     (build.disjoined-pequal-by-args 'if (@formula (!= x nil)) (list *1a *1b *1c))  *1d)
+           ((= (if t y z) y)                                                           (build.theorem (theorem-if-redux-t)))
+           ((= (if t nil t) nil)                                                       (build.instantiation @- (@sigma (y . nil) (z . t))))
+           ((v (!= x nil) (= (if t nil t) nil))                                        (build.expansion (@formula (!= x nil)) @-))
+           ((v (!= x nil) (= (if (not x) (if x t nil) (if x nil t)) nil))              (build.disjoined-transitivity-of-pequal *1d @-))
+           ((v (!= x nil) (= (iff (not x) x) (if (not x) (if x t nil) (if x nil t))))  (build.expansion (@formula (!= x nil)) *0))
+           ((v (!= x nil) (= (iff (not x) x) nil))                                     (build.disjoined-transitivity-of-pequal @- @--)                                *1)
+           ;; ---
+           ((v (= x nil) (= (not x) nil))                                              (build.theorem (theorem-not-when-not-nil))                                     *2a)
+           ((v (= x nil) (= (if x y z) y))                                             (build.axiom (axiom-if-when-not-nil)))
+           ((v (= x nil) (= (if x t nil) t))                                           (build.instantiation @- (@sigma (y . t) (z . nil)))                            *2b)
+           ((v (= x nil) (= (if x nil t) nil))                                         (build.instantiation @-- (@sigma (y . nil) (z . t)))                           *2c)
+           ((v (= x nil) (= (if (not x) (if x t nil) (if x nil t)) (if nil t nil)))    (build.disjoined-pequal-by-args 'if (@formula (= x nil)) (list *2a *2b *2c))   *2d)
+           ((= (if nil y z) z)                                                         (build.theorem (theorem-if-redux-nil)))
+           ((= (if nil t nil) nil)                                                     (build.instantiation @- (@sigma (y . t) (z . nil))))
+           ((v (= x nil) (= (if nil t nil) nil))                                       (build.expansion (@formula (= x nil)) @-))
+           ((v (= x nil) (= (if (not x) (if x t nil) (if x nil t)) nil))               (build.disjoined-transitivity-of-pequal *2d @-))
+           ((v (= x nil) (= (iff (not x) x) (if (not x) (if x t nil) (if x nil t))))   (build.expansion (@formula (= x nil)) *0))
+           ((v (= x nil) (= (iff (not x) x) nil))                                      (build.disjoined-transitivity-of-pequal @- @--)                                *2)
+           ;; ---
+           ((v (= (iff (not x) x) nil) (= (iff (not x) x) nil))                        (build.cut *2 *1))
+           ((= (iff (not x) x) nil)                                                    (build.contraction @-)))
+  :minatbl ((iff . 2)
+            (not . 1)
+            (if . 3)))
+
+(deftheorem rw.eqtrace-contradiction-lemma1
+  :derive (!= (iff nil t) t)
+  :proof  (@derive
+           ((v (!= x nil) (= (iff x t) nil))      (build.theorem (theorem-iff-t-when-nil)))
+           ((v (!= nil nil) (= (iff nil t) nil))  (build.instantiation @- (@sigma (x . nil))))
+           ((= nil nil)                           (build.reflexivity (@term nil)))
+           ((= (iff nil t) nil)                   (build.modus-ponens @- @--))
+           ((!= (iff nil t) t)                    (build.not-t-from-nil @-)))
+  :minatbl ((iff . 2)))
+
+(defund@ rw.eqtrace-contradiction-lemma2 (lhs rhs)
+  (declare (xargs :guard (and (logic.termp lhs)
+                              (logic.termp rhs)
+                              (clause.negative-termp rhs)
+                              (equal (clause.negative-term-guts rhs) lhs))
+                  :verify-guards nil))
+  (@derive ((= lhs lhs)                            (build.reflexivity lhs))
+           ((= rhs (not lhs))                      (clause.standardize-negative-term-bldr rhs))
+           ((= (iff rhs lhs) (iff (not lhs) lhs))  (build.pequal-by-args 'iff (list @- @--))                    *1)
+           ((= (iff (not x) x) nil)                (build.theorem (theorem-not-x-and-x-under-iff)))
+           ((= (iff (not lhs) lhs) nil)            (build.instantiation @- (list (cons 'x lhs))))
+           ((= (iff rhs lhs) nil)                  (build.transitivity-of-pequal *1 @-)                         *2)
+           ((= (iff x y) (iff y x))                (build.theorem (theorem-symmetry-of-iff)))
+           ((= (iff lhs rhs) (iff rhs lhs))        (build.instantiation @- (list (cons 'x lhs) (cons 'y rhs))))
+           ((= (iff lhs rhs) nil)                  (build.transitivity-of-pequal @- *2))
+           ((!= (iff lhs rhs) t)                   (build.not-t-from-nil @-))))
+
+(defobligations rw.eqtrace-contradiction-lemma2
+  (build.reflexivity
+   clause.standardize-negative-term-bldr
+   build.pequal-by-args
+   build.transitivity-of-pequal
+   build.not-t-from-nil)
+  :extra-thms ((theorem-not-x-and-x-under-iff)
+               (theorem-symmetry-of-iff)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-contradiction-lemma2
+                           theorem-not-x-and-x-under-iff
+                           theorem-symmetry-of-iff)))
+
+ (defthm rw.eqtrace-contradiction-lemma2-under-iff
+   (iff (rw.eqtrace-contradiction-lemma2 lhs rhs)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.eqtrace-contradiction-lemma2
+   (implies (force (and (logic.termp lhs)
+                        (logic.termp rhs)
+                        (clause.negative-termp rhs)
+                        (equal (clause.negative-term-guts rhs) lhs)))
+            (equal (logic.appealp (rw.eqtrace-contradiction-lemma2 lhs rhs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.eqtrace-contradiction-lemma2
+   (implies (force (and (logic.termp lhs)
+                        (logic.termp rhs)
+                        (clause.negative-termp rhs)
+                        (equal (clause.negative-term-guts rhs) lhs)))
+            (equal (logic.conclusion (rw.eqtrace-contradiction-lemma2 lhs rhs))
+                   (logic.pnot (logic.pequal (logic.function 'iff (list lhs rhs)) ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.eqtrace-contradiction-lemma2
+   (implies (force (and (logic.termp lhs)
+                        (logic.termp rhs)
+                        (clause.negative-termp rhs)
+                        (equal (clause.negative-term-guts rhs) lhs)
+                        ;; --
+                        (logic.term-atblp lhs atbl)
+                        (logic.term-atblp rhs atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.eqtrace-contradiction-lemma2)))
+            (equal (logic.proofp (rw.eqtrace-contradiction-lemma2 lhs rhs) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.eqtrace-contradiction-lemma2))
+
+
+
+
+(defderiv rw.eqtrace-contradiction-bldr-lemma3a
+  :derive (!= (equal (? lhs) (? rhs)) t)
+  :from   ((proof x (= (? rhs) (not (? lhs)))))
+  :proof  (@derive
+           ((!= (not x) x)                                (build.theorem (theorem-inequality-of-not-x-and-x)))
+           ((!= (not (? lhs)) (? lhs))                    (build.instantiation @- (@sigma (x . (? lhs)))))
+           ((= (? rhs) (not (? lhs)))                     (@given x))
+           ((!= (? rhs) (? lhs))                          (build.substitute-into-not-pequal @-- @-))
+           ((!= (? lhs) (? rhs))                          (build.commute-not-pequal @-))
+           ((= (equal (? lhs) (? rhs)) nil)               (build.not-equal-from-not-pequal @-))
+           ((!= (equal (? lhs) (? rhs)) t)                (build.not-t-from-nil @-)))
+  :minatbl ((equal . 2)))
+
+(defderiv rw.eqtrace-contradiction-bldr-lemma3
+  :derive P
+  :from   ((proof x (v P (= (equal (? lhs) (? rhs)) t)))
+           (proof y (= (? rhs) (not (? lhs)))))
+  :proof (@derive
+          ((v P (= (equal (? lhs) (? rhs)) t))           (@given x))
+          ((v (= (equal (? lhs) (? rhs)) t) P)           (build.commute-or @-) *1)
+          ((= (? rhs) (not (? lhs)))                     (@given y))
+          ((!= (equal (? lhs) (? rhs)) t)                (rw.eqtrace-contradiction-bldr-lemma3a @-))
+          (P                                             (build.modus-ponens-2 @- *1))))
+
+
+(defund@ rw.eqtrace-contradiction-bldr (x box)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.eqtrace-contradictionp x)
+                              (rw.hypboxp box)
+                              (rw.eqtrace-okp x box))
+                  :verify-guards nil))
+  (let ((lhs  (rw.eqtrace->lhs x))
+        (rhs  (rw.eqtrace->rhs x))
+        (iffp (rw.eqtrace->iffp x)))
+    (cond ((and iffp
+                (equal lhs ''nil)
+                (equal rhs ''t))
+           (@derive
+            ((v hyps (= (iff nil t) t))            (rw.eqtrace-bldr x box))
+            ((v (= (iff nil t) t) hyps)            (build.commute-or @-))
+            ((!= (iff nil t) t)                    (build.theorem (rw.eqtrace-contradiction-lemma1)))
+            (hyps                                  (build.modus-ponens-2 @- @--))))
+          ((and (not iffp)
+                (logic.constantp lhs)
+                (logic.constantp rhs)
+                (not (equal lhs rhs)))
+           (@derive
+            ((v hyps (= (equal lhs rhs) t))        (rw.eqtrace-bldr x box))
+            ((v (= (equal lhs rhs) t) hyps)        (build.commute-or @-) *1)
+            ((= (equal lhs rhs) nil)               (build.base-eval (logic.function 'equal (list lhs rhs))))
+            ((!= (equal lhs rhs) t)                (build.not-t-from-nil @-))
+            ;((!= lhs rhs)                          (build.not-pequal-constants lhs rhs))
+            ;((= (equal lhs rhs) nil)               (build.not-equal-from-not-pequal @-))
+            ;((!= (equal lhs rhs) t)                (build.not-t-from-nil @-))
+            (hyps                                  (build.modus-ponens-2 @- *1))))
+          (iffp
+           ;; The trace is (iff x (not* x)) = t
+           (@derive
+            ((v hyps (= (iff lhs rhs) t))           (rw.eqtrace-bldr x box))
+            ((v (= (iff lhs rhs) t) hyps)           (build.commute-or @-)                                        *0)
+            ((!= (iff lhs rhs) t)                   (rw.eqtrace-contradiction-lemma2 lhs rhs))
+            (hyps                                   (build.modus-ponens-2 @- *0))))
+          (t
+           ;; The trace is (equal x (not* x)) = t
+           (@derive
+            ((v hyps (= (equal lhs rhs) t))        (rw.eqtrace-bldr x box))
+            ((= rhs (not lhs))                     (clause.standardize-negative-term-bldr rhs))
+            (hyps                                  (rw.eqtrace-contradiction-bldr-lemma3 @-- @-)))))))
+
+(defobligations rw.eqtrace-contradiction-bldr
+ (rw.eqtrace-bldr
+   build.commute-or
+   build.modus-ponens-2
+   build.base-eval
+   ;build.not-pequal-constants
+   ;build.not-equal-from-not-pequal
+   build.not-t-from-nil
+   rw.eqtrace-contradiction-lemma2
+   rw.eqtrace-contradiction-bldr-lemma3)
+  :extra-thms ((rw.eqtrace-contradiction-lemma1)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-contradictionp
+                           rw.eqtrace-contradiction-bldr
+                           rw.eqtrace-formula
+                           rw.eqtrace-contradiction-lemma1)))
+
+ (defthm rw.eqtrace-contradiction-bldr-under-iff
+   (iff (rw.eqtrace-contradiction-bldr x box)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.eqtrace-contradiction-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.eqtrace-contradictionp x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)))
+            (equal (logic.appealp (rw.eqtrace-contradiction-bldr x box))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.eqtrace-contradiction-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.eqtrace-contradictionp x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)))
+            (equal (logic.conclusion (rw.eqtrace-contradiction-bldr x box))
+                   (rw.hypbox-formula box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.eqtrace-contradiction-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.eqtrace-contradictionp x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)
+                        ;; ---
+                        (rw.eqtrace-atblp x atbl)
+                        (rw.hypbox-atblp box atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.eqtrace-contradiction-bldr)))
+            (equal (logic.proofp (rw.eqtrace-contradiction-bldr x box) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.eqtrace-contradiction-bldr))
+
+
+
+(defund rw.eqtrace-contradiction-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'rw.eqtrace-contradiction-bldr)
+         (tuplep 2 extras)
+         (let ((trace (first extras))
+               (box   (second extras)))
+           (and (rw.eqtracep trace)
+                (rw.eqtrace-contradictionp trace)
+                (rw.eqtrace-atblp trace atbl)
+                (rw.hypboxp box)
+                (rw.hypbox-atblp box atbl)
+                (rw.eqtrace-okp trace box)
+                (equal conclusion (rw.hypbox-formula box))
+                (not subproofs))))))
+
+(defund rw.eqtrace-contradiction-bldr-high (x box)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.eqtrace-contradictionp x)
+                              (rw.hypboxp box)
+                              (rw.eqtrace-okp x box))))
+  (logic.appeal 'rw.eqtrace-contradiction-bldr
+                (rw.hypbox-formula box)
+                nil
+                (list x box)))
+
+(defobligations rw.eqtrace-contradiction-bldr-okp
+  (rw.eqtrace-contradiction-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-contradiction-bldr-okp)))
+
+ (defthm booleanp-of-rw.eqtrace-contradiction-bldr-okp
+   (equal (booleanp (rw.eqtrace-contradiction-bldr-okp x atbl))
+          t))
+
+ (defthm rw.eqtrace-contradiction-bldr-okp-of-logic.appeal-identity
+   (equal (rw.eqtrace-contradiction-bldr-okp (logic.appeal-identity x) atbl)
+          (rw.eqtrace-contradiction-bldr-okp x atbl)))
+
+ (local (in-theory (enable backtracking-logic.formula-atblp-rules)))
+ (local (in-theory (disable forcing-logic.formula-atblp-rules
+                            forcing-lookup-of-logic.function-name-free
+                            forcing-logic.term-list-atblp-of-logic.function-args)))
+
+ (defthm lemma-1-for-soundness-of-rw.eqtrace-contradiction-bldr-okp
+   (implies (and (rw.eqtrace-contradiction-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (rw.eqtrace-contradiction-bldr (first (logic.extras x))
+                                                   (second (logic.extras x))))
+                   (logic.conclusion x))))
+
+ (defthm@ lemma-2-for-soundness-of-rw.eqtrace-contradiction-bldr-okp
+   (implies (and (rw.eqtrace-contradiction-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 ;; ---
+                 (@obligations rw.eqtrace-contradiction-bldr-okp)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'equal atbl)) 2))
+            (equal (logic.proofp
+                    (rw.eqtrace-contradiction-bldr (first (logic.extras x))
+                                                   (second (logic.extras x)))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-rw.eqtrace-contradiction-bldr-okp
+   (implies (and (rw.eqtrace-contradiction-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)))
+                 ;; ---
+                 (@obligations rw.eqtrace-contradiction-bldr-okp)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'equal atbl)) 2))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-rw.eqtrace-contradiction-bldr-okp
+                               lemma-2-for-soundness-of-rw.eqtrace-contradiction-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (rw.eqtrace-contradiction-bldr (first (logic.extras x))
+                                                               (second (logic.extras x))))))))))
+
+
+
+
+;; (defund@ rw.eqtrace-contradiction-bldr-alt (x box)
+;;   (declare (xargs :guard (and (rw.eqtracep x)
+;;                               (rw.eqtrace-contradictionp x)
+;;                               (rw.hypboxp box)
+;;                               (rw.eqtrace-okp x box))
+;;                   :verify-guards nil))
+;;   (let ((lhs  (rw.eqtrace->lhs x))
+;;         (rhs  (rw.eqtrace->rhs x))
+;;         (iffp (rw.eqtrace->iffp x)))
+;;     (cond ((and iffp
+;;                 (equal lhs ''nil)
+;;                 (equal rhs ''t))
+;;            (@derive
+;;             ((v hyps (= (iff nil t) t))            (rw.eqtrace-bldr x box))
+;;             ((v (= (iff nil t) t) hyps)            (build.commute-or @-))
+;;             ((!= (iff nil t) t)                    (build.theorem (rw.eqtrace-contradiction-lemma1)))
+;;             (hyps                                  (build.modus-ponens-2 @- @--))))
+;;           ((and (not iffp)
+;;                 (logic.constantp lhs)
+;;                 (logic.constantp rhs)
+;;                 (not (equal lhs rhs)))
+;;            (@derive
+;;             ((v hyps (= (equal lhs rhs) t))        (rw.eqtrace-bldr x box))
+;;             ((v (= (equal lhs rhs) t) hyps)        (build.commute-or @-) *1)
+;;             ((!= lhs rhs)                          (build.not-pequal-constants lhs rhs))
+;;             ((= (equal lhs rhs) nil)               (build.not-equal-from-not-pequal @-))
+;;             ((!= (equal lhs rhs) t)                (build.not-t-from-nil @-))
+;;             (hyps                                  (build.modus-ponens-2 @- *1))))
+;;           (iffp
+;;            ;; The trace is (iff x (not* x)) = t
+;;            (@derive
+;;             ((v hyps (= (iff lhs rhs) t))           (rw.eqtrace-bldr x box))
+;;             ((v (= (iff lhs rhs) t) hyps)           (build.commute-or @-)                                        *0)
+;;             ((!= (iff lhs rhs) t)                   (rw.eqtrace-contradiction-lemma2 lhs rhs))
+;;             (hyps                                   (build.modus-ponens-2 @- *0))))
+;;           (t
+;;            ;; The trace is (equal x (not* x)) = t
+;;            (@derive
+;;             ((v hyps (= (equal lhs rhs) t))        (rw.eqtrace-bldr x box))
+;;             ((= rhs (not lhs))                     (clause.standardize-negative-term-bldr rhs))
+;;             (hyps                                  (rw.eqtrace-contradiction-bldr-lemma3 @-- @-)))))))
+
+;; (defobligations rw.eqtrace-contradiction-bldr-alt
+;;   (rw.eqtrace-bldr
+;;    build.commute-or
+;;    build.modus-ponens-2
+;;    build.not-pequal-constants
+;;    build.not-equal-from-not-pequal
+;;    build.not-t-from-nil
+;;    rw.eqtrace-contradiction-lemma2
+;;    rw.eqtrace-contradiction-bldr-lemma3)
+;;   :extra-thms ((rw.eqtrace-contradiction-lemma1)))
+
+;; (encapsulate
+;;  ()
+;;  (local (in-theory (enable rw.eqtrace-contradictionp
+;;                            rw.eqtrace-contradiction-bldr-alt
+;;                            rw.eqtrace-formula
+;;                            rw.eqtrace-contradiction-lemma1
+;;                            theorem-inequality-of-not-x-and-x)))
+
+;;  (defthm rw.eqtrace-contradiction-bldr-alt-under-iff
+;;    (iff (rw.eqtrace-contradiction-bldr-alt x box)
+;;         t))
+
+;;  (defthm forcing-logic.appealp-of-rw.eqtrace-contradiction-bldr-alt
+;;    (implies (force (and (rw.eqtracep x)
+;;                         (rw.eqtrace-contradictionp x)
+;;                         (rw.hypboxp box)
+;;                         (rw.eqtrace-okp x box)))
+;;             (equal (logic.appealp (rw.eqtrace-contradiction-bldr-alt x box))
+;;                    t)))
+
+;;  (defthm forcing-logic.conclusion-of-rw.eqtrace-contradiction-bldr-alt
+;;    (implies (force (and (rw.eqtracep x)
+;;                         (rw.eqtrace-contradictionp x)
+;;                         (rw.hypboxp box)
+;;                         (rw.eqtrace-okp x box)))
+;;             (equal (logic.conclusion (rw.eqtrace-contradiction-bldr-alt x box))
+;;                    (rw.hypbox-formula box)))
+;;    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+;;  (defthm@ forcing-logic.proofp-of-rw.eqtrace-contradiction-bldr-alt
+;;    (implies (force (and (rw.eqtracep x)
+;;                         (rw.eqtrace-contradictionp x)
+;;                         (rw.hypboxp box)
+;;                         (rw.eqtrace-okp x box)
+;;                         ;; ---
+;;                         (rw.eqtrace-atblp x atbl)
+;;                         (rw.hypbox-atblp box atbl)
+;;                         (equal (cdr (lookup 'not atbl)) 1)
+;;                         (equal (cdr (lookup 'equal atbl)) 2)
+;;                         (equal (cdr (lookup 'iff atbl)) 2)
+;;                         (@obligations rw.eqtrace-contradiction-bldr-alt)))
+;;             (equal (logic.proofp (rw.eqtrace-contradiction-bldr-alt x box) axioms thms atbl)
+;;                    t)))
+
+;;  (verify-guards rw.eqtrace-contradiction-bldr-alt))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/contradictionp.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/contradictionp.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/contradictionp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/contradictionp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,111 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund rw.eqtrace-contradictionp (x)
+  ;; We recognize traces of the following forms as contradictions:
+  ;;  -- (equal c1 c2) = t
+  ;;       Where c1,c2 are unequal constants
+  ;;  -- (equal x (not* x)) = t
+  ;;       By the term order, this also checks (equal (not* x) x) = t
+  ;;  -- (iff nil t) = t
+  ;;       By the term order, this also checks (iff t nil) = t
+  ;;       By the canonicalization of constants, this also checks for all other
+  ;;       non-nil constants besides t
+  ;;  -- (iff x (not* x)) = t
+  ;;       By the term order, this also checks (iff (not* x) x) = t
+  (declare (xargs :guard (rw.eqtracep x)))
+  (let ((lhs  (rw.eqtrace->lhs x))
+        (rhs  (rw.eqtrace->rhs x))
+        (iffp (rw.eqtrace->iffp x)))
+    (or ;; Perhaps there is a contradiction from a constant
+        (if iffp
+            (and (equal lhs ''nil)
+                 (equal rhs ''t))
+          (and (logic.constantp lhs)
+               (logic.constantp rhs)
+               (not (equal lhs rhs))))
+        ;; Perhaps there is a contradiction from (equiv x (not* x))
+        (and (clause.negative-termp rhs)
+             (equal (clause.negative-term-guts rhs) lhs)))))
+
+(defthm booleanp-of-rw.eqtrace-contradictionp
+  (equal (booleanp (rw.eqtrace-contradictionp x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqtrace-contradictionp))))
+
+
+
+(defund rw.find-eqtrace-contradiction (x)
+  (declare (xargs :guard (rw.eqtrace-listp x)))
+  (if (consp x)
+      (if (rw.eqtrace-contradictionp (car x))
+          (car x)
+        (rw.find-eqtrace-contradiction (cdr x)))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.find-eqtrace-contradiction)))
+
+ (defthm forcing-rw.eqtracep-of-rw.find-eqtrace-contradiction
+   (implies (and (rw.find-eqtrace-contradiction x)
+                 (force (rw.eqtrace-listp x)))
+            (equal (rw.eqtracep (rw.find-eqtrace-contradiction x))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.find-eqtrace-contradiction
+   (implies (and (rw.find-eqtrace-contradiction x)
+                 (force (rw.eqtrace-list-atblp x atbl)))
+            (equal (rw.eqtrace-atblp (rw.find-eqtrace-contradiction x) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.find-eqtrace-contradiction
+   (implies (and (rw.find-eqtrace-contradiction x)
+                 (force (rw.eqtrace-list-okp x box)))
+            (equal (rw.eqtrace-okp (rw.find-eqtrace-contradiction x) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-contradictionp-of-rw.find-eqtrace-contradiction
+   (implies (rw.find-eqtrace-contradiction x)
+            (equal (rw.eqtrace-contradictionp (rw.find-eqtrace-contradiction x))
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/direct-iff-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/direct-iff-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/direct-iff-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/direct-iff-eqtrace-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,222 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(include-book "../../clauses/basic-bldrs")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defderiv rw.direct-iff-eqtrace-nhyp-bldr-lemma-1
+  :derive (v (!= (iff (? a) (? b)) nil) (!= (? nhyp) nil))
+  :from   ((proof x (= (? nhyp) (not (iff (? a) (? b))))))
+  :proof  (@derive
+           ((v (!= x nil) (= (not x) t))                                         (build.theorem (theorem-not-when-nil)))
+           ((v (!= (iff (? a) (? b)) nil) (= (not (iff (? a) (? b))) t))         (build.instantiation @- (@sigma (x . (iff (? a) (? b))))) *1)
+           ((= (? nhyp) (not (iff (? a) (? b))))                                 (@given x))
+           ((v (!= (iff (? a) (? b)) nil) (= (? nhyp) (not (iff (? a) (? b)))))  (build.expansion (@formula (!= (iff (? a) (? b)) nil)) @-))
+           ((v (!= (iff (? a) (? b)) nil) (= (? nhyp) t))                        (build.disjoined-transitivity-of-pequal @- *1))
+           ((v (!= (iff (? a) (? b)) nil) (!= (? nhyp) nil))                     (build.disjoined-not-nil-from-t @-))))
+
+(defderiv rw.direct-iff-eqtrace-nhyp-bldr-lemma-2
+  :derive (v (!= (? nhyp) nil) (= (iff (? a) (? b)) t))
+  :from   ((proof x (= (? nhyp) (not (iff (? a) (? b))))))
+  :proof  (@derive
+           ((= (? nhyp) (not (iff (? a) (? b))))                                 (@given x))
+           ((v (!= (iff (? a) (? b)) nil) (!= (? nhyp) nil))                     (rw.direct-iff-eqtrace-nhyp-bldr-lemma-1 @-))
+           ((v (!= (? nhyp) nil) (!= (iff (? a) (? b)) nil))                     (build.commute-or @-))
+           ((v (!= (? nhyp) nil) (= (iff (? a) (? b)) t))                        (build.disjoined-iff-t-from-not-nil @-))))
+
+(defund@ rw.direct-iff-eqtrace-nhyp-bldr (nhyp x)
+  ;; Given an nhyp that matches a direct-iff eqtrace, prove:
+  ;;   nhyp != nil v (equal lhs rhs) = t
+  (declare (xargs :guard (and (logic.termp nhyp)
+                              (rw.eqtracep x)
+                              (equal (rw.direct-iff-eqtrace t nhyp) x))
+                  :verify-guards nil))
+  ;; Let nhyp be (not* (equal a b)).
+  (let* ((guts (clause.negative-term-guts nhyp))
+         (args (logic.function-args guts))
+         (a    (first args))
+         (main-proof (@derive
+                      ((= nhyp (not (iff a b)))                         (clause.standardize-negative-term-bldr nhyp))
+                      ((v (!= nhyp nil) (= (iff a b) t))                (rw.direct-iff-eqtrace-nhyp-bldr-lemma-2 @-)))))
+    (if (equal a (rw.eqtrace->lhs x))
+        main-proof
+      (build.disjoined-commute-iff main-proof))))
+
+(defobligations rw.direct-iff-eqtrace-nhyp-bldr
+  (clause.standardize-negative-term-bldr
+   rw.direct-iff-eqtrace-nhyp-bldr-lemma-2
+   build.disjoined-commute-iff))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.direct-iff-eqtrace
+                           rw.direct-iff-eqtrace-nhyp-bldr
+                           theorem-not-when-nil
+                           logic.term-formula)))
+
+ (local (in-theory (disable forcing-equal-of-logic.pequal-rewrite-two
+                            forcing-equal-of-logic.pequal-rewrite
+                            forcing-equal-of-logic.por-rewrite-two
+                            forcing-equal-of-logic.por-rewrite
+                            forcing-equal-of-logic.pnot-rewrite-two
+                            forcing-equal-of-logic.pnot-rewrite)))
+
+ (defthm rw.direct-iff-eqtrace-nhyp-bldr-under-iff
+   (iff (rw.direct-iff-eqtrace-nhyp-bldr nhyp x)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.direct-iff-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.direct-iff-eqtrace t nhyp) x)))
+            (equal (logic.appealp (rw.direct-iff-eqtrace-nhyp-bldr nhyp x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.direct-iff-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.direct-iff-eqtrace t nhyp) x)))
+            (equal (logic.conclusion (rw.direct-iff-eqtrace-nhyp-bldr nhyp x))
+                   (logic.por (logic.term-formula nhyp)
+                              (logic.pequal (logic.function 'iff
+                                                            (list (rw.eqtrace->lhs x)
+                                                                  (rw.eqtrace->rhs x)))
+                                            ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.direct-iff-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.direct-iff-eqtrace t nhyp) x)
+                        ;; ---
+                        (logic.term-atblp nhyp atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.direct-iff-eqtrace-nhyp-bldr)))
+            (equal (logic.proofp (rw.direct-iff-eqtrace-nhyp-bldr nhyp x) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.direct-iff-eqtrace-nhyp-bldr))
+
+
+(defund rw.direct-iff-eqtrace-bldr (x box)
+  ;; Given a direct-iff eqtrace that is box-okp, prove
+  ;;   hypbox-formula v (iff lhs rhs) = t
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.direct-iff-eqtrace-okp x box))
+                  :verify-guards nil))
+  (let* ((left      (rw.hypbox->left box))
+         (right     (rw.hypbox->right box))
+         (nhyp-left (rw.find-nhyp-for-direct-iff-eqtracep left x)))
+    ;; First search for a working hyp on the left.
+    (if nhyp-left
+        ;; 1. nhyp-left v (iff lhs rhs) = t      Direct-Iff eqtrace nhyp bldr
+        ;; 2. Left v (iff lhs rhs) = t           Multi assoc expansion
+        (let* ((line-1 (rw.direct-iff-eqtrace-nhyp-bldr nhyp-left x))
+               (line-2 (build.multi-assoc-expansion line-1 (logic.term-list-formulas left))))
+          (if right
+              ;; 3. Left v (Right v (iff lhs rhs) = t)    DJ Left Expansion
+              ;; 4. (Left v Right) v (iff lhs rhs) = t    Associativity
+              (build.associativity (build.disjoined-left-expansion line-2 (clause.clause-formula right)))
+            ;; Else we're done already
+            line-2))
+      ;; Else we know there must be a matching hyp on the right, since our guard
+      ;; requires we are a box-okp direct-iff eqtrace.
+      ;;
+      ;; 1. nhyp-right v (iff lhs rhs) = t       Direct-Iff eqtrace nhyp bldr
+      ;; 2. Right v (iff lhs rhs) = t            Multi assoc expansion.
+      (let* ((nhyp-right (rw.find-nhyp-for-direct-iff-eqtracep right x))
+             (line-1     (rw.direct-iff-eqtrace-nhyp-bldr nhyp-right x))
+             (line-2     (build.multi-assoc-expansion line-1 (logic.term-list-formulas right))))
+        (if left
+            ;; 3. Left v (Right v (iff lhs rhs) = t)    Expansion
+            ;; 4. (Left v Right) v (iff lhs rhs) = t    Associativity
+            (build.associativity
+             (build.expansion (clause.clause-formula left) line-2))
+          ;; Else we're done already.
+          line-2)))))
+
+(defobligations rw.direct-iff-eqtrace-bldr
+  (rw.direct-iff-eqtrace-nhyp-bldr
+   build.multi-assoc-expansion
+   build.disjoined-left-expansion))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.direct-iff-eqtrace-bldr
+                           rw.direct-iff-eqtrace-okp
+                           rw.hypbox-formula
+                           rw.eqtrace-formula
+                           )))
+
+ (defthm rw.direct-iff-eqtrace-bldr-under-iff
+   (iff (rw.direct-iff-eqtrace-bldr x box)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.direct-iff-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.direct-iff-eqtrace-okp x box)))
+            (equal (logic.appealp (rw.direct-iff-eqtrace-bldr x box))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.direct-iff-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.direct-iff-eqtrace-okp x box)))
+            (equal (logic.conclusion (rw.direct-iff-eqtrace-bldr x box))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.direct-iff-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.direct-iff-eqtrace-okp x box)
+                        ;; ---
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (rw.hypbox-atblp box atbl)
+                        (@obligations rw.direct-iff-eqtrace-bldr)))
+            (equal (logic.proofp (rw.direct-iff-eqtrace-bldr x box) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.direct-iff-eqtrace-bldr))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/direct-iff-eqtrace.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/direct-iff-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/direct-iff-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/direct-iff-eqtrace.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,199 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(definlined rw.direct-iff-eqtrace (okp nhyp)
+  ;; Try to generate a direct eqtrace from an nhyp.
+  ;; The nhyp should have one of these forms:
+  ;;   -- (not* (iff lhs rhs))
+  ;;   -- (not* (iff rhs lhs))
+  ;; Where lhs and rhs are distinct.
+  (declare (xargs :guard (logic.termp nhyp)))
+  (and okp
+       (clause.negative-termp nhyp)
+       (let ((guts (clause.negative-term-guts nhyp)))
+         (and (logic.functionp guts)
+              (equal (logic.function-name guts) 'iff)
+              (let ((args (logic.function-args guts)))
+                (and (equal (len args) 2)
+                     (let ((lhs (first args))
+                           (rhs (second args)))
+                       (cond ((logic.term-< lhs rhs)
+                              (rw.eqtrace 'direct-iff t lhs rhs nil))
+                             ((logic.term-< rhs lhs)
+                              (rw.eqtrace 'direct-iff t rhs lhs nil))
+                             (t
+                              ;; Lhs and rhs are not distinct.  We would be
+                              ;; assuming lhs iff lhs, which is useless.
+                              nil)))))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.direct-iff-eqtrace)))
+
+ (defthm forcing-rw.eqtrace->method-of-rw.direct-iff-eqtrace
+   (implies (force (rw.direct-iff-eqtrace okp nhyp))
+            (equal (rw.eqtrace->method (rw.direct-iff-eqtrace okp nhyp))
+                   'direct-iff)))
+
+ (defthm forcing-rw.eqtrace->iffp-of-rw.direct-iff-eqtrace
+   (implies (force (rw.direct-iff-eqtrace okp nhyp))
+            (equal (rw.eqtrace->iffp (rw.direct-iff-eqtrace okp nhyp))
+                   t)))
+
+ (defthm forcing-rw.eqtrace->subtraces-of-rw.direct-iff-eqtrace
+   (implies (force (rw.direct-iff-eqtrace okp nhyp))
+            (equal (rw.eqtrace->subtraces (rw.direct-iff-eqtrace okp nhyp))
+                   nil)))
+
+ (defthm forcing-rw.eqtracep-of-rw.direct-iff-eqtrace
+   (implies (force (and (rw.direct-iff-eqtrace okp nhyp)
+                        (logic.termp nhyp)))
+            (equal (rw.eqtracep (rw.direct-iff-eqtrace okp nhyp))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.direct-iff-eqtrace
+   (implies (force (and (rw.direct-iff-eqtrace okp nhyp)
+                        (logic.termp nhyp)
+                        (logic.term-atblp nhyp atbl)))
+            (equal (rw.eqtrace-atblp (rw.direct-iff-eqtrace okp nhyp) atbl)
+                   t)))
+
+
+ (defthm rw.direct-iff-eqtrace-normalize-okp-1
+   (implies (and (rw.direct-iff-eqtrace okp nhyp)
+                 (syntaxp (not (equal okp ''t))))
+            (equal (rw.direct-iff-eqtrace okp nhyp)
+                   (rw.direct-iff-eqtrace t nhyp))))
+
+ (defthm rw.direct-iff-eqtrace-normalize-okp-2
+   (implies (not (rw.direct-iff-eqtrace t nhyp))
+            (equal (rw.direct-iff-eqtrace okp nhyp)
+                   nil)))
+
+ (defthm rw.direct-iff-eqtrace-normalize-okp-3
+   (equal (rw.direct-iff-eqtrace nil nhyp)
+          nil)))
+
+
+
+
+
+(defund rw.find-nhyp-for-direct-iff-eqtracep (nhyps x)
+  ;; Find the first nhyp in a list that would generate this direct-iff eqtrace.
+  (declare (xargs :guard (and (logic.term-listp nhyps)
+                              (rw.eqtracep x))))
+  (if (consp nhyps)
+      (if (equal (rw.direct-iff-eqtrace t (car nhyps)) x)
+          (car nhyps)
+        (rw.find-nhyp-for-direct-iff-eqtracep (cdr nhyps) x))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.find-nhyp-for-direct-iff-eqtracep)))
+
+ (defthm rw.find-nhyp-for-direct-iff-eqtracep-of-nil
+   (equal (rw.find-nhyp-for-direct-iff-eqtracep nil x)
+          nil))
+
+ (defthm forcing-logic.termp-of-rw.find-nhyp-for-direct-iff-eqtracep
+   (implies (force (and (rw.find-nhyp-for-direct-iff-eqtracep nhyps x)
+                        (logic.term-listp nhyps)))
+            (equal (logic.termp (rw.find-nhyp-for-direct-iff-eqtracep nhyps x))
+                   t)))
+
+ (defthm forcing-logic.term-atblp-of-rw.find-nhyp-for-direct-iff-eqtracep
+   (implies (force (and (rw.find-nhyp-for-direct-iff-eqtracep nhyps x)
+                        (logic.term-list-atblp nhyps atbl)))
+            (equal (logic.term-atblp (rw.find-nhyp-for-direct-iff-eqtracep nhyps x) atbl)
+                   t)))
+
+ (defthm forcing-memberp-of-rw.find-nhyp-for-direct-iff-eqtracep
+   (implies (force (rw.find-nhyp-for-direct-iff-eqtracep nhyps x))
+            (equal (memberp (rw.find-nhyp-for-direct-iff-eqtracep nhyps x) nhyps)
+                   t)))
+
+ (defthm forcing-rw.direct-iff-eqtrace-of-rw.find-nhyp-for-direct-iff-eqtracep
+   (implies (force (rw.find-nhyp-for-direct-iff-eqtracep nhyps x))
+            (equal (rw.direct-iff-eqtrace t (rw.find-nhyp-for-direct-iff-eqtracep nhyps x))
+                   x))))
+
+
+
+
+(defund rw.direct-iff-eqtrace-okp (x box)
+  ;; Check if any nhyp in the hypbox would generate this direct-iff eqtrace.
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box))))
+  (and (equal (rw.eqtrace->method x) 'direct-iff)
+       (equal (rw.eqtrace->iffp x) t)
+       (if (or (rw.find-nhyp-for-direct-iff-eqtracep (rw.hypbox->left box) x)
+               (rw.find-nhyp-for-direct-iff-eqtracep (rw.hypbox->right box) x))
+           t
+         nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.direct-iff-eqtrace-okp)))
+
+ (defthm booleanp-of-rw.direct-iff-eqtrace-okp
+   (equal (booleanp (rw.direct-iff-eqtrace-okp x box))
+          t)
+   :hints(("Goal" :in-theory (disable forcing-booleanp-of-rw.eqtrace->iffp))))
+
+ (defthmd lemma-for-forcing-rw.direct-iff-eqtrace-okp-rw.direct-iff-eqtrace
+   (implies (and (memberp nhyp nhyps)
+                 (rw.direct-iff-eqtrace okp nhyp))
+            (iff (rw.find-nhyp-for-direct-iff-eqtracep nhyps (rw.direct-iff-eqtrace okp nhyp))
+                 nhyp))
+   :hints(("Goal" :in-theory (enable rw.find-nhyp-for-direct-iff-eqtracep))))
+
+ (defthm forcing-rw.direct-iff-eqtrace-okp-rw.direct-iff-eqtrace
+   (implies (force (and (rw.direct-iff-eqtrace okp nhyp)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))))
+            (equal (rw.direct-iff-eqtrace-okp (rw.direct-iff-eqtrace okp nhyp) box)
+                   t))
+   :hints(("Goal" :in-theory (e/d (lemma-for-forcing-rw.direct-iff-eqtrace-okp-rw.direct-iff-eqtrace)
+                                  (rw.direct-iff-eqtrace-normalize-okp-1))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/eqdatabasep.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/eqdatabasep.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/eqdatabasep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/eqdatabasep.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,693 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "contradictionp")
+(include-book "eqtrace-okp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthmd all-equalp-as-repeat
+  ;; BOZO move me to all-equalp.lisp
+  (equal (all-equalp a x)
+         (equal (list-fix x)
+                (repeat a (len x))))
+  :hints(("Goal"
+          :in-theory (enable repeat)
+          :induct (cdr-induction x))))
+
+
+
+
+;; The equivalence database.
+;;
+;; We now are ready to introduce our equivalence database.  This structure
+;; tracks equalities and boolean equivalences using two disjoined-set data
+;; structures (sometimes called a union-find structures).  One of these is used
+;; for equalities, and the other is used for iff-equivalences.  But we can
+;; share a lot of code between the two.
+
+
+;; Each equivalence set is simple aggregate containing:
+;;   - head, a term which acts as the canonical member for this set
+;;   - iffp, a flag indicating if the equivalence relation is equal or iff
+;;   - traces, a list of eqtraces of the form (equiv lhs rhs), whose rhses
+;;     are all unique
+
+(defund rw.eqsetp (x)
+  ;; BOZO why aren't we using defaggregate?
+  ;; We use the custom cons structure (head . (iffp . tail))
+  (let ((head (car x))
+        (iffp (car (cdr x)))
+        (tail (cdr (cdr x))))
+    (and (logic.termp head)
+         (booleanp iffp)
+         (consp tail)
+         (true-listp tail)
+         (rw.eqtrace-listp tail)
+         (all-equalp iffp (rw.eqtrace-list-iffps tail))
+         (all-equalp head (rw.eqtrace-list-lhses tail))
+         (uniquep (rw.eqtrace-list-rhses tail)))))
+
+(definlined rw.eqset->head (x)
+  (declare (xargs :guard (rw.eqsetp x)
+                  :guard-hints (("Goal" :in-theory (enable rw.eqsetp)))))
+  (car x))
+
+(definlined rw.eqset->iffp (x)
+  (declare (xargs :guard (rw.eqsetp x)
+                  :guard-hints (("Goal" :in-theory (enable rw.eqsetp)))))
+  (car (cdr x)))
+
+(definlined rw.eqset->tail (x)
+  (declare (xargs :guard (rw.eqsetp x)
+                  :guard-hints (("Goal" :in-theory (enable rw.eqsetp)))))
+  (cdr (cdr x)))
+
+(definlined rw.eqset (head iffp tail)
+  (declare (xargs :guard (and (logic.termp head)
+                              (booleanp iffp)
+                              (rw.eqtrace-listp tail)
+                              (consp tail)
+                              (all-equalp iffp (rw.eqtrace-list-iffps tail))
+                              (all-equalp head (rw.eqtrace-list-lhses tail))
+                              (uniquep (rw.eqtrace-list-rhses tail)))))
+  (cons head
+        (cons iffp tail)))
+
+(defthm booleanp-of-rw.eqsetp
+  (equal (booleanp (rw.eqsetp x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqsetp))))
+
+(defthm rw.eqset->head-of-rw.eqset
+  (equal (rw.eqset->head (rw.eqset head iffp tail))
+         head)
+  :hints(("Goal" :in-theory (enable rw.eqset rw.eqset->head))))
+
+(defthm rw.eqset->iffp-of-rw.eqset
+  (equal (rw.eqset->iffp (rw.eqset head iffp tail))
+         iffp)
+  :hints(("Goal" :in-theory (enable rw.eqset rw.eqset->iffp))))
+
+(defthm rw.eqset->tail-of-rw.eqset
+  (equal (rw.eqset->tail (rw.eqset head iffp tail))
+         tail)
+  :hints(("Goal" :in-theory (enable rw.eqset rw.eqset->tail))))
+
+(defthm forcing-rw.eqsetp-of-rw.eqset
+  (implies (force (and (logic.termp head)
+                       (booleanp iffp)
+                       (consp tail)
+                       (true-listp tail)
+                       (rw.eqtrace-listp tail)
+                       (all-equalp iffp (rw.eqtrace-list-iffps tail))
+                       (all-equalp head (rw.eqtrace-list-lhses tail))
+                       (uniquep (rw.eqtrace-list-rhses tail))))
+           (equal (rw.eqsetp (rw.eqset head iffp tail))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset))))
+
+(defthm forcing-logic.termp-of-rw.eqset->head
+  (implies (force (rw.eqsetp x))
+           (equal (logic.termp (rw.eqset->head x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset->head))))
+
+(defthm forcing-booleanp-of-rw.eqset->iffp
+  (implies (force (rw.eqsetp x))
+           (equal (booleanp (rw.eqset->iffp x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset->iffp))))
+
+(defthm forcing-consp-of-rw.eqset->tail
+  (implies (force (rw.eqsetp x))
+           (equal (consp (rw.eqset->tail x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset->tail))))
+
+(defthm forcing-true-listp-of-rw.eqset->tail
+  (implies (force (rw.eqsetp x))
+           (equal (true-listp (rw.eqset->tail x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset->tail))))
+
+(defthm forcing-rw.eqtrace-listp-of-rw.eqset->tail
+  (implies (force (rw.eqsetp x))
+           (equal (rw.eqtrace-listp (rw.eqset->tail x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset->tail))))
+
+(defthm forcing-rw.eqtrace-list-iffps-of-rw.eqset->tail
+  (implies (force (rw.eqsetp x))
+           (equal (rw.eqtrace-list-iffps (rw.eqset->tail x))
+                  (repeat (rw.eqset->iffp x) (len (rw.eqset->tail x)))))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset->iffp rw.eqset->tail all-equalp-as-repeat))))
+
+(defthm forcing-rw.eqtrace-list-lhses-of-rw.eqset->tail
+  (implies (force (rw.eqsetp x))
+           (equal (rw.eqtrace-list-lhses (rw.eqset->tail x))
+                  (repeat (rw.eqset->head x) (len (rw.eqset->tail x)))))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset->head rw.eqset->tail all-equalp-as-repeat))))
+
+(defthm forcing-uniquep-of-rw.eqtrace-list-rhses-of-rw.eqset->tail
+  (implies (force (rw.eqsetp x))
+           (equal (uniquep (rw.eqtrace-list-rhses (rw.eqset->tail x)))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqsetp rw.eqset->tail))))
+
+(deflist rw.eqset-listp (x)
+  (rw.eqsetp x)
+  :elementp-of-nil nil
+  :guard t)
+
+
+
+
+(definlined rw.eqset-atblp (x atbl)
+  (declare (xargs :guard (and (rw.eqsetp x)
+                              (logic.arity-tablep atbl))))
+  (rw.eqtrace-list-atblp (rw.eqset->tail x) atbl))
+
+(defthm booleanp-of-rw.eqset-atblp
+  (equal (booleanp (rw.eqset-atblp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqset-atblp))))
+
+(defthm forcing-rw.eqset-atblp-of-rw.eqset
+  (implies (force (rw.eqtrace-list-atblp tail atbl))
+           (equal (rw.eqset-atblp (rw.eqset head iffp tail) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqset-atblp))))
+
+(defthm forcing-rw.eqtrace-list-atblp-of-rw.eqset->tail
+  (implies (force (rw.eqset-atblp x atbl))
+           (equal (rw.eqtrace-list-atblp (rw.eqset->tail x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqset-atblp))))
+
+(defthmd lemma-for-forcing-logic.term-atblp-of-rw.eqset->head
+  (implies (and (logic.term-list-atblp x atbl)
+                (equal x (repeat term len))
+                (not (zp len)))
+           (equal (logic.term-atblp term atbl)
+                  t)))
+
+(defthm forcing-logic.term-atblp-of-rw.eqset->head
+  (implies (force (and (rw.eqsetp x)
+                       (rw.eqset-atblp x atbl)))
+           (equal (logic.term-atblp (rw.eqset->head x) atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (disable forcing-rw.eqtrace-list-atblp-of-rw.eqset->tail
+                              forcing-rw.eqtrace-list-lhses-of-rw.eqset->tail)
+          :use ((:instance lemma-for-forcing-logic.term-atblp-of-rw.eqset->head
+                           (x    (rw.eqtrace-list-lhses (rw.eqset->tail x)))
+                           (term (rw.eqset->head x))
+                           (len  (len (rw.eqset->tail x))))
+                (:instance forcing-rw.eqtrace-list-lhses-of-rw.eqset->tail)))))
+
+(defthm rw.eqset-atblp-of-nil
+  (equal (rw.eqset-atblp nil atbl)
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqset-atblp))))
+
+(deflist rw.eqset-list-atblp (x atbl)
+  (rw.eqset-atblp x atbl)
+  :elementp-of-nil t
+  :guard (and (rw.eqset-listp x)
+              (logic.arity-tablep atbl)))
+
+
+
+(definlined rw.eqset-okp (x box)
+  (declare (xargs :guard (and (rw.eqsetp x)
+                              (rw.hypboxp box))))
+  (rw.eqtrace-list-okp (rw.eqset->tail x) box))
+
+(defthm booleanp-of-rw.eqset-okp
+  (equal (booleanp (rw.eqset-okp x box))
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqset-okp))))
+
+(defthm forcing-rw.eqtrace-list-okp-of-rw.eqset->tail
+  (implies (force (rw.eqset-okp x box))
+           (equal (rw.eqtrace-list-okp (rw.eqset->tail x) box)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqset-okp))))
+
+(defthm rw.eqset-okp-of-rw.eqset
+  (implies (force (rw.eqtrace-list-okp tail box))
+           (equal (rw.eqset-okp (rw.eqset head iffp tail) box)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqset-okp))))
+
+(defthm rw.eqset-okp-of-nil
+  (equal (rw.eqset-okp nil box)
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqset-okp))))
+
+
+(deflist rw.eqset-list-okp (x box)
+  (rw.eqset-okp x box)
+  :elementp-of-nil t
+  :guard (and (rw.eqset-listp x)
+              (rw.hypboxp box)))
+
+
+
+
+
+(defprojection :list (rw.eqset-list-heads x)
+               :element (rw.eqset->head x)
+               :guard (rw.eqset-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-rw.eqset-list-heads
+  (implies (force (rw.eqset-listp x))
+           (equal (logic.term-listp (rw.eqset-list-heads x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.eqset-list-heads
+  (implies (force (and (rw.eqset-listp x)
+                       (rw.eqset-list-atblp x atbl)))
+           (equal (logic.term-list-atblp (rw.eqset-list-heads x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defprojection :list (rw.eqset-list-iffps x)
+               :element (rw.eqset->iffp x)
+               :guard (rw.eqset-listp x)
+               :nil-preservingp t)
+
+
+
+
+
+(definlined rw.eqset->rhses (x)
+  (declare (xargs :guard (rw.eqsetp x)))
+  (rw.eqtrace-list-rhses (rw.eqset->tail x)))
+
+(defthm forcing-logic.term-listp-of-rw.eqset->rhses
+  (implies (force (rw.eqsetp x))
+           (equal (logic.term-listp (rw.eqset->rhses x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqset->rhses))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.eqset->rhses
+  (implies (force (rw.eqset-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.eqset->rhses x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqset->rhses))))
+
+
+
+(defprojection :list (rw.eqset-list-rhses x)
+               :element (rw.eqset->rhses x)
+               :guard (rw.eqset-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-list-listp-of-rw.eqset-list-rhses
+  (implies (force (rw.eqset-listp x))
+           (equal (logic.term-list-listp (rw.eqset-list-rhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.eqrow-list-rhses
+  (implies (force (rw.eqset-list-atblp x atbl))
+           (equal (logic.term-list-list-atblp (rw.eqset-list-rhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(definlined rw.find-contradiction-in-eqset-list (x)
+  (declare (xargs :guard (rw.eqset-listp x)
+                  :guard-hints (("Goal" :in-theory (enable rw.eqsetp)))))
+  (if (consp x)
+      (or (rw.find-eqtrace-contradiction (rw.eqset->tail (car x)))
+          (rw.find-contradiction-in-eqset-list (cdr x)))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.find-contradiction-in-eqset-list)))
+
+ (defthm forcing-rw.eqtracep-of-rw.find-contradiction-in-eqrow-list
+   (implies (and (rw.find-contradiction-in-eqset-list x)
+                 (force (rw.eqset-listp x)))
+            (equal (rw.eqtracep (rw.find-contradiction-in-eqset-list x))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.find-contradiction-in-eqset-list
+   (implies (and (rw.find-contradiction-in-eqset-list x)
+                 (force (rw.eqset-list-atblp x atbl)))
+            (equal (rw.eqtrace-atblp (rw.find-contradiction-in-eqset-list x) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.find-contradiction-in-eqset-list
+   (implies (and (rw.find-contradiction-in-eqset-list x)
+                 (force (rw.eqset-list-okp x box)))
+            (equal (rw.eqtrace-okp (rw.find-contradiction-in-eqset-list x) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-contradictionp-of-rw.find-contradiction-in-eqset-list
+   (implies (rw.find-contradiction-in-eqset-list x)
+            (equal (rw.eqtrace-contradictionp (rw.find-contradiction-in-eqset-list x))
+                   t))))
+
+
+
+(defund rw.eqdatabasep (x)
+  (declare (xargs :guard t))
+  ;; We use the cons structure (equalsets . (iffsets . contradiction))
+  (and (consp x)
+       (consp (cdr x))
+       (let ((equalsets     (car x))
+             (iffsets       (car (cdr x)))
+             (contradiction (cdr (cdr x))))
+         (and (rw.eqset-listp equalsets)
+              (rw.eqset-listp iffsets)
+              (let ((heads (rw.eqset-list-heads equalsets))
+                    (iffps (rw.eqset-list-iffps equalsets))
+                    (rhses (rw.eqset-list-rhses equalsets)))
+                (and (all-equalp nil iffps)
+                     (uniquep heads)
+                     (mutually-disjointp rhses)
+                     (disjoint-from-allp heads rhses)))
+              (let ((heads (rw.eqset-list-heads iffsets))
+                    (rhses (rw.eqset-list-rhses iffsets))
+                    (iffps (rw.eqset-list-iffps iffsets)))
+                (and (all-equalp t iffps)
+                     (uniquep heads)
+                     (mutually-disjointp rhses)
+                     (disjoint-from-allp heads rhses)))
+              (or (not contradiction)
+                  (and (rw.eqtracep contradiction)
+                       (rw.eqtrace-contradictionp contradiction)))))))
+
+(definlined rw.eqdatabase->equalsets (x)
+  (declare (xargs :guard (rw.eqdatabasep x)))
+  (car x))
+
+(definlined rw.eqdatabase->iffsets (x)
+  (declare (xargs :guard (rw.eqdatabasep x)))
+  (car (cdr x)))
+
+(definlined rw.eqdatabase->contradiction (x)
+  (declare (xargs :guard (rw.eqdatabasep x)))
+  (cdr (cdr x)))
+
+(definlined rw.eqdatabase (equalsets iffsets contradiction)
+  (declare (xargs :guard (and (rw.eqset-listp equalsets)
+                              (rw.eqset-listp iffsets)
+                              (let ((heads (rw.eqset-list-heads equalsets))
+                                    (iffps (rw.eqset-list-iffps equalsets))
+                                    (rhses (rw.eqset-list-rhses equalsets)))
+                                (and (all-equalp nil iffps)
+                                     (uniquep heads)
+                                     (mutually-disjointp rhses)
+                                     (disjoint-from-allp heads rhses)))
+                              (let ((heads (rw.eqset-list-heads iffsets))
+                                    (rhses (rw.eqset-list-rhses iffsets))
+                                    (iffps (rw.eqset-list-iffps iffsets)))
+                                (and (all-equalp t iffps)
+                                     (uniquep heads)
+                                     (mutually-disjointp rhses)
+                                     (disjoint-from-allp heads rhses)))
+                              (or (not contradiction)
+                                  (and (rw.eqtracep contradiction)
+                                       (rw.eqtrace-contradictionp contradiction))))))
+  (cons equalsets
+        (cons iffsets contradiction)))
+
+(defthm booleanp-of-rw.eqdatabasep
+  (equal (booleanp (rw.eqdatabasep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep))))
+
+(defthm rw.eqdatabase->equalsets-of-rw.eqdatabase
+  (equal (rw.eqdatabase->equalsets (rw.eqdatabase equalsets iffsets contradiction))
+         equalsets)
+  :hints(("Goal" :in-theory (enable rw.eqdatabase rw.eqdatabase->equalsets))))
+
+(defthm rw.eqdatabase->iffsets-of-rw.eqdatabase
+  (equal (rw.eqdatabase->iffsets (rw.eqdatabase equalsets iffsets contradiction))
+         iffsets)
+  :hints(("Goal" :in-theory (enable rw.eqdatabase rw.eqdatabase->iffsets))))
+
+(defthm rw.eqdatabase->contradiction-of-rw.eqdatabase
+  (equal (rw.eqdatabase->contradiction (rw.eqdatabase equalsets iffsets contradiction))
+         contradiction)
+  :hints(("Goal" :in-theory (enable rw.eqdatabase rw.eqdatabase->contradiction))))
+
+(defthm forcing-rw.eqdatabasep-of-rw.eqdatabase
+  (implies (force (and (rw.eqset-listp equalsets)
+                       (rw.eqset-listp iffsets)
+                       (let ((heads (rw.eqset-list-heads equalsets))
+                             (iffps (rw.eqset-list-iffps equalsets))
+                             (rhses (rw.eqset-list-rhses equalsets)))
+                         (and (all-equalp nil iffps)
+                              (uniquep heads)
+                              (mutually-disjointp rhses)
+                              (disjoint-from-allp heads rhses)))
+                       (let ((heads (rw.eqset-list-heads iffsets))
+                             (rhses (rw.eqset-list-rhses iffsets))
+                             (iffps (rw.eqset-list-iffps iffsets)))
+                         (and (all-equalp t iffps)
+                              (uniquep heads)
+                              (mutually-disjointp rhses)
+                              (disjoint-from-allp heads rhses)))
+                       (or (not contradiction)
+                           (and (rw.eqtracep contradiction)
+                                (rw.eqtrace-contradictionp contradiction)))))
+           (equal (rw.eqdatabasep (rw.eqdatabase equalsets iffsets contradiction))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase))))
+
+(defthm forcing-rw.eqset-listp-of-rw.eqdatabase->equalsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (rw.eqset-listp (rw.eqdatabase->equalsets x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->equalsets))))
+
+(defthm forcing-uniquep-of-rw.eqset-list-heads-of-rw.eqdatabase->equalsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (uniquep (rw.eqset-list-heads (rw.eqdatabase->equalsets x)))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->equalsets))))
+
+(defthm forcing-disjoint-from-allp-of-rw.eqrow-list-heads-of-rw.eqdatabase->equalsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (disjoint-from-allp (rw.eqset-list-heads (rw.eqdatabase->equalsets x))
+                                      (rw.eqset-list-rhses (rw.eqdatabase->equalsets x)))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->equalsets))))
+
+(defthm forcing-mutually-disjointp-of-rw.eqrow-list-rhses-of-rw.eqdatabase->equalsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (mutually-disjointp (rw.eqset-list-rhses (rw.eqdatabase->equalsets x)))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->equalsets))))
+
+(defthm forcing-rw.eqset-list-iffps-of-rw.eqdatabase->equalsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (rw.eqset-list-iffps (rw.eqdatabase->equalsets x))
+                  (repeat nil (len (rw.eqdatabase->equalsets x)))))
+  :hints(("Goal"
+          :in-theory (enable rw.eqdatabasep rw.eqdatabase->equalsets all-equalp-as-repeat))))
+
+
+
+(defthm forcing-rw.eqset-listp-of-rw.eqdatabase->iffsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (rw.eqset-listp (rw.eqdatabase->iffsets x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->iffsets))))
+
+(defthm forcing-uniquep-of-rw.eqset-list-heads-of-rw.eqdatabase->iffsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (uniquep (rw.eqset-list-heads (rw.eqdatabase->iffsets x)))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->iffsets))))
+
+(defthm forcing-disjoint-from-allp-of-rw.eqset-list-heads-of-rw.eqdatabase->iffsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (disjoint-from-allp (rw.eqset-list-heads (rw.eqdatabase->iffsets x))
+                                      (rw.eqset-list-rhses (rw.eqdatabase->iffsets x)))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->iffsets))))
+
+(defthm forcing-mutually-disjointp-of-rw.eqset-list-rhses-of-rw.eqdatabase->iffsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (mutually-disjointp (rw.eqset-list-rhses (rw.eqdatabase->iffsets x)))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->iffsets))))
+
+(defthm forcing-rw.eqset-list-iffps-of-rw.eqdatabase->iffsets
+  (implies (force (rw.eqdatabasep x))
+           (equal (rw.eqset-list-iffps (rw.eqdatabase->iffsets x))
+                  (repeat t (len (rw.eqdatabase->iffsets x)))))
+  :hints(("Goal"
+          :in-theory (enable rw.eqdatabasep rw.eqdatabase->iffsets all-equalp-as-repeat))))
+
+
+
+(defthm forcing-rw.eqtracep-of-rw.eqdatabase->contradiction
+  (implies (and (rw.eqdatabase->contradiction x)
+                (force (rw.eqdatabasep x)))
+           (equal (rw.eqtracep (rw.eqdatabase->contradiction x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->contradiction))))
+
+(defthm forcing-rw.eqtrace-contradictionp-of-rw.eqdatabase->contradiction
+  (implies (and (rw.eqdatabase->contradiction x)
+                (force (rw.eqdatabasep x)))
+           (equal (rw.eqtrace-contradictionp (rw.eqdatabase->contradiction x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep rw.eqdatabase->contradiction))))
+
+
+
+
+(definlined rw.eqdatabase-atblp (x atbl)
+  (declare (xargs :guard (and (rw.eqdatabasep x)
+                              (logic.arity-tablep atbl))))
+  (let ((equalsets     (rw.eqdatabase->equalsets x))
+        (iffsets       (rw.eqdatabase->iffsets x))
+        (contradiction (rw.eqdatabase->contradiction x)))
+    (and (rw.eqset-list-atblp equalsets atbl)
+         (rw.eqset-list-atblp iffsets atbl)
+         (or (not contradiction)
+             (rw.eqtrace-atblp contradiction atbl)))))
+
+(defthm rw.eqdatabase-atblp-of-nil
+  (equal (rw.eqdatabase-atblp nil atbl)
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-atblp))))
+
+(defthm booleanp-of-rw.eqdatabase-atblp
+  (equal (booleanp (rw.eqdatabase-atblp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-atblp))))
+
+(defthm forcing-rw.eqdatabase-atblp-of-rw.eqdatabase
+  (implies (force (and (rw.eqset-list-atblp equalsets atbl)
+                       (rw.eqset-list-atblp iffsets atbl)
+                       (or (not contradiction)
+                           (rw.eqtrace-atblp contradiction atbl))))
+           (equal (rw.eqdatabase-atblp (rw.eqdatabase equalsets iffsets contradiction) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-atblp))))
+
+(defthm forcing-rw.eqset-list-atblp-of-rw.eqdatabase->equalsets
+  (implies (force (rw.eqdatabase-atblp x atbl))
+           (equal (rw.eqset-list-atblp (rw.eqdatabase->equalsets x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-atblp))))
+
+(defthm forcing-rw.eqset-list-atblp-of-rw.eqdatabase->iffsets
+  (implies (force (rw.eqdatabase-atblp x atbl))
+           (equal (rw.eqset-list-atblp (rw.eqdatabase->iffsets x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.eqdatabase-atblp)
+                                 (forcing-rw.eqset-list-atblp-of-rw.eqdatabase->equalsets)))))
+
+(defthm forcing-rw.trace-atblp-of-rw.eqdatabase->contradiction
+  (implies (force (and (rw.eqdatabase->contradiction x)
+                       (rw.eqdatabase-atblp x atbl)))
+           (equal (rw.eqtrace-atblp (rw.eqdatabase->contradiction x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.eqdatabase-atblp)
+                                 (forcing-rw.eqset-list-atblp-of-rw.eqdatabase->equalsets
+                                  forcing-rw.eqset-list-atblp-of-rw.eqdatabase->iffsets)))))
+
+
+
+(definlined rw.eqdatabase-okp (x box)
+  (declare (xargs :guard (and (rw.eqdatabasep x)
+                              (rw.hypboxp box))))
+  (let ((equalsets     (rw.eqdatabase->equalsets x))
+        (iffsets       (rw.eqdatabase->iffsets x))
+        (contradiction (rw.eqdatabase->contradiction x)))
+    (and (rw.eqset-list-okp equalsets box)
+         (rw.eqset-list-okp iffsets box)
+         (or (not contradiction)
+             (rw.eqtrace-okp contradiction box)))))
+
+(defthm booleanp-of-rw.eqdatabase-okp
+  (equal (booleanp (rw.eqdatabase-okp x box))
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-okp))))
+
+(defthm forcing-rw.eqdatabase-okp-of-rw.eqdatabase
+  (implies (force (and (rw.eqset-list-okp equalsets box)
+                       (rw.eqset-list-okp iffsets box)
+                       (or (not contradiction)
+                           (rw.eqtrace-okp contradiction box))))
+           (equal (rw.eqdatabase-okp (rw.eqdatabase equalsets iffsets contradiction) box)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-okp))))
+
+(defthm forcing-rw.eqset-list-okp-of-rw.eqdatabase->equalsets
+  (implies (force (rw.eqdatabase-okp x box))
+           (equal (rw.eqset-list-okp (rw.eqdatabase->equalsets x) box)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-okp))))
+
+(defthm forcing-rw.eqset-list-okp-of-rw.eqdatabase->iffsets
+  (implies (force (rw.eqdatabase-okp x box))
+           (equal (rw.eqset-list-okp (rw.eqdatabase->iffsets x) box)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.eqdatabase-okp)
+                                 (forcing-rw.eqset-list-okp-of-rw.eqdatabase->equalsets)))))
+
+(defthm forcing-rw.trace-okp-of-rw.eqdatabase->contradiction
+  (implies (force (and (rw.eqdatabase->contradiction x)
+                       (rw.eqdatabase-okp x box)))
+           (equal (rw.eqtrace-okp (rw.eqdatabase->contradiction x) box)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.eqdatabase-okp)
+                                 (forcing-rw.eqset-list-okp-of-rw.eqdatabase->equalsets
+                                  forcing-rw.eqset-list-okp-of-rw.eqdatabase->iffsets)))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/eqtrace-arities.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/eqtrace-arities.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/eqtrace-arities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/eqtrace-arities.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,232 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(include-book "hypbox-arities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund rw.slow-flag-eqtrace-arities (flag x)
+  (declare (xargs :guard (if (equal flag 'trace)
+                             (rw.eqtracep x)
+                           (rw.eqtrace-listp x))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'trace) 1 0))))
+  (if (equal flag 'trace)
+      (app (rw.slow-flag-eqtrace-arities 'list (rw.eqtrace->subtraces x))
+           (app (logic.slow-term-arities (rw.eqtrace->rhs x))
+                (logic.slow-term-arities (rw.eqtrace->lhs x))))
+    (if (consp x)
+        (app (rw.slow-flag-eqtrace-arities 'trace (car x))
+             (rw.slow-flag-eqtrace-arities 'list (cdr x)))
+      nil)))
+
+(definlined rw.slow-eqtrace-arities (x)
+  (declare (xargs :guard (rw.eqtracep x)))
+  (rw.slow-flag-eqtrace-arities 'trace x))
+
+(definlined rw.slow-eqtrace-list-arities (x)
+  (declare (xargs :guard (rw.eqtrace-listp x)))
+  (rw.slow-flag-eqtrace-arities 'list x))
+
+(defthmd definition-of-rw.slow-eqtrace-arities
+  (equal (rw.slow-eqtrace-arities x)
+         (app (rw.slow-eqtrace-list-arities (rw.eqtrace->subtraces x))
+              (app (logic.slow-term-arities (rw.eqtrace->rhs x))
+                   (logic.slow-term-arities (rw.eqtrace->lhs x)))))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand ((rw.slow-flag-eqtrace-arities 'trace x))
+          :in-theory (enable rw.slow-eqtrace-list-arities rw.slow-eqtrace-arities))))
+
+(defthmd definition-of-rw.slow-eqtrace-list-arities
+  (equal (rw.slow-eqtrace-list-arities x)
+         (if (consp x)
+             (app (rw.slow-eqtrace-arities (car x))
+                  (rw.slow-eqtrace-list-arities (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand ((rw.slow-flag-eqtrace-arities 'list x))
+          :in-theory (enable rw.slow-eqtrace-list-arities rw.slow-eqtrace-arities))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.slow-eqtrace-arities))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.slow-eqtrace-arities-list))))
+
+(defthm rw.slow-eqtrace-list-arities-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.slow-eqtrace-list-arities x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-rw.slow-eqtrace-list-arities))))
+
+(defthm rw.slow-eqtrace-list-arities-of-cons
+  (equal (rw.slow-eqtrace-list-arities (cons a x))
+         (app (rw.slow-eqtrace-arities a)
+              (rw.slow-eqtrace-list-arities x)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.slow-eqtrace-list-arities))))
+
+
+
+(defund rw.flag-eqtrace-arities (flag x acc)
+  (declare (xargs :guard (and (if (equal flag 'trace)
+                                  (rw.eqtracep x)
+                                (rw.eqtrace-listp x))
+                              (true-listp acc))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'trace) 1 0))
+                  :verify-guards nil))
+  (if (equal flag 'trace)
+      (let* ((acc (logic.term-arities (rw.eqtrace->lhs x) acc))
+             (acc (logic.term-arities (rw.eqtrace->rhs x) acc)))
+        (rw.flag-eqtrace-arities 'list (rw.eqtrace->subtraces x) acc))
+    (if (consp x)
+        (rw.flag-eqtrace-arities 'trace (car x)
+                                 (rw.flag-eqtrace-arities 'list (cdr x) acc))
+      acc)))
+
+(definlined rw.eqtrace-arities (x acc)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (rw.flag-eqtrace-arities 'trace x acc))
+
+(definlined rw.eqtrace-list-arities (x acc)
+  (declare (xargs :guard (and (rw.eqtrace-listp x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (rw.flag-eqtrace-arities 'list x acc))
+
+(defthmd definition-of-rw.eqtrace-arities
+  (equal (rw.eqtrace-arities x acc)
+         (let* ((acc (logic.term-arities (rw.eqtrace->lhs x) acc))
+                (acc (logic.term-arities (rw.eqtrace->rhs x) acc)))
+           (rw.eqtrace-list-arities (rw.eqtrace->subtraces x) acc)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (e/d (rw.eqtrace-arities rw.eqtrace-list-arities)
+                          ((:executable-counterpart acl2::force)))
+          :expand (rw.flag-eqtrace-arities 'trace x acc))))
+
+(defthmd definition-of-rw.eqtrace-list-arities
+  (equal (rw.eqtrace-list-arities x acc)
+         (if (consp x)
+             (rw.eqtrace-arities (car x)
+                                 (rw.eqtrace-list-arities (cdr x) acc))
+           acc))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (e/d (rw.eqtrace-arities rw.eqtrace-list-arities)
+                          ((:executable-counterpart acl2::force)))
+          :expand (rw.flag-eqtrace-arities 'list x acc))))
+
+(defthm rw.flag-eqtrace-arities-of-trace
+  (equal (rw.flag-eqtrace-arities 'trace x acc)
+         (rw.eqtrace-arities x acc))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-arities))))
+
+(defthm rw.flag-eqtrace-arities-of-list
+  (equal (rw.flag-eqtrace-arities 'list x acc)
+         (rw.eqtrace-list-arities x acc))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-list-arities))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-arities))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-list-arities))))
+
+(defthm rw.eqtrace-list-arities-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.eqtrace-list-arities x acc)
+                  acc))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-list-arities))))
+
+(defthm rw.eqtrace-list-arities-of-cons
+  (equal (rw.eqtrace-list-arities (cons a x) acc)
+         (rw.eqtrace-arities a
+                             (rw.eqtrace-list-arities x acc)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-list-arities))))
+
+
+(defthms-flag
+  :shared-hyp (force (true-listp acc))
+  :thms ((trace true-listp-of-rw.eqtrace-arities
+               (equal (true-listp (rw.eqtrace-arities x acc))
+                      t))
+         (t true-listp-of-rw.eqtrace-list-arities
+            (equal (true-listp (rw.eqtrace-list-arities x acc))
+                   t)))
+  :hints(("Goal"
+          :induct (rw.flag-eqtrace-arities flag x acc)
+          :in-theory (enable (:induction rw.flag-eqtrace-arities))
+          :expand ((rw.eqtrace-arities x acc)))))
+
+(verify-guards rw.flag-eqtrace-arities)
+(verify-guards rw.eqtrace-arities)
+(verify-guards rw.eqtrace-list-arities)
+
+
+(defthms-flag
+  :shared-hyp (force (true-listp acc))
+  :thms ((trace rw.eqtrace-arities-removal
+               (equal (rw.eqtrace-arities x acc)
+                      (app (rw.slow-eqtrace-arities x)
+                           acc)))
+         (t rw.eqtrace-list-arities-removal
+            (equal (rw.eqtrace-list-arities x acc)
+                   (app (rw.slow-eqtrace-list-arities x)
+                        acc))))
+  :hints(("Goal"
+          :induct (rw.flag-eqtrace-arities flag x acc)
+          :in-theory (enable (:induction rw.flag-eqtrace-arities))
+          :expand ((rw.eqtrace-arities x acc)
+                   (rw.slow-eqtrace-arities x)))))
+
+(defthms-flag
+  :thms ((trace rw.slow-eqtrace-arities-correct
+               (implies (force (rw.eqtracep x))
+                        (equal (logic.arities-okp (rw.slow-eqtrace-arities x) atbl)
+                               (rw.eqtrace-atblp x atbl))))
+         (t rw.slow-eqtrace-list-arities-correct
+            (implies (force (rw.eqtrace-listp x))
+                     (equal (logic.arities-okp (rw.slow-eqtrace-list-arities x) atbl)
+                            (rw.eqtrace-list-atblp x atbl)))))
+  :hints(("Goal"
+          :induct (rw.flag-eqtrace-atblp flag x atbl)
+          :expand ((rw.eqtrace-atblp x atbl)
+                   (rw.slow-eqtrace-arities x))
+          :in-theory (e/d ((:induction rw.flag-eqtrace-atblp)
+                           (:executable-counterpart acl2::force))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/eqtrace-compiler.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/eqtrace-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/eqtrace-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/eqtrace-compiler.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,442 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(include-book "primary-eqtrace-bldr")
+(include-book "secondary-eqtrace-bldr")
+(include-book "trans1-eqtrace-bldr")
+(include-book "trans2-eqtrace-bldr")
+(include-book "trans3-eqtrace-bldr")
+(include-book "weakening-eqtrace-bldr")
+(include-book "direct-iff-eqtrace-bldr")
+(include-book "negative-iff-eqtrace-bldr")
+(include-book "hypbox-arities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund rw.eqtrace-step-bldr (x box proofs)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.eqtrace-okp x box)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box)))
+                  :verify-guards nil))
+  (let ((method (rw.eqtrace->method x)))
+    (cond ((equal method 'primary)    (rw.primary-eqtrace-bldr x box))
+          ((equal method 'secondary)  (rw.secondary-eqtrace-bldr x box))
+          ((equal method 'trans1)     (rw.trans1-eqtrace-bldr x box proofs))
+          ((equal method 'trans2)     (rw.trans2-eqtrace-bldr x box proofs))
+          ((equal method 'trans3)     (rw.trans3-eqtrace-bldr x box proofs))
+          ((equal method 'weakening)  (rw.weakening-eqtrace-bldr x box proofs))
+          ((equal method 'direct-iff) (rw.direct-iff-eqtrace-bldr x box))
+          ((equal method 'negative-iff) (rw.negative-iff-eqtrace-bldr x box))
+          ;; Sneaky twiddle for hypless iff theorem.
+          (t t))))
+
+(defobligations rw.eqtrace-step-bldr
+  (rw.primary-eqtrace-bldr
+   rw.secondary-eqtrace-bldr
+   rw.trans1-eqtrace-bldr
+   rw.trans2-eqtrace-bldr
+   rw.trans3-eqtrace-bldr
+   rw.weakening-eqtrace-bldr
+   rw.direct-iff-eqtrace-bldr
+   rw.negative-iff-eqtrace-bldr
+   ))
+
+(encapsulate
+ ()
+ (local (in-theory (e/d (rw.eqtrace-step-bldr
+                         definition-of-rw.eqtrace-okp
+                         rw.eqtrace-step-okp)
+                        (forcing-rw.eqtrace-list-okp-of-rw.eqtrace-subtraces))))
+
+ (defthm rw.eqtrace-step-bldr-under-iff
+   (iff (rw.eqtrace-step-bldr x box proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.eqtrace-step-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.appealp (rw.eqtrace-step-bldr x box proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.eqtrace-step-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.conclusion (rw.eqtrace-step-bldr x box proofs))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.eqtrace-step-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))
+                        ;; ---
+                        (rw.hypbox-atblp box atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations rw.eqtrace-step-bldr)
+                        ))
+            (equal (logic.proofp (rw.eqtrace-step-bldr x box proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.eqtrace-step-bldr))
+
+
+
+
+(defun rw.flag-eqtrace-bldr (flag x box)
+  (declare (xargs :guard (if (equal flag 'trace)
+                             (and (rw.eqtracep x)
+                                  (rw.hypboxp box)
+                                  (rw.eqtrace-okp x box))
+                           (and (equal flag 'list)
+                                (rw.eqtrace-listp x)
+                                (rw.hypboxp box)
+                                (rw.eqtrace-list-okp x box)))
+                  :verify-guards nil
+                  :measure (two-nats-measure (rank x) (if (equal flag 'trace) 1 0))))
+  (if (equal flag 'trace)
+      (rw.eqtrace-step-bldr x box
+                            (rw.flag-eqtrace-bldr 'list (rw.eqtrace->subtraces x) box))
+    (if (consp x)
+        (cons (rw.flag-eqtrace-bldr 'trace (car x) box)
+              (rw.flag-eqtrace-bldr 'list (cdr x) box))
+      nil)))
+
+(defund rw.eqtrace-bldr (x box)
+  ;; Don't inline this since we want to redefine it.
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.eqtrace-okp x box))
+                  :verify-guards nil))
+  (rw.flag-eqtrace-bldr 'trace x box))
+
+(defund rw.eqtrace-list-bldr (x box)
+  (declare (xargs :guard (and (rw.eqtrace-listp x)
+                              (rw.hypboxp box)
+                              (rw.eqtrace-list-okp x box))
+                  :verify-guards nil))
+  (rw.flag-eqtrace-bldr 'list x box))
+
+(defobligations rw.flag-eqtrace-bldr
+  (rw.eqtrace-step-bldr))
+
+(defobligations rw.eqtrace-bldr
+  (rw.flag-eqtrace-bldr))
+
+(defobligations rw.eqtrace-list-bldr
+  (rw.flag-eqtrace-bldr))
+
+(defthmd definition-of-rw.eqtrace-bldr
+  (equal (rw.eqtrace-bldr x box)
+         (rw.eqtrace-step-bldr x box (rw.eqtrace-list-bldr (rw.eqtrace->subtraces x) box)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.eqtrace-bldr rw.eqtrace-list-bldr))))
+
+(defthmd definition-of-rw.eqtrace-list-bldr
+  (equal (rw.eqtrace-list-bldr x box)
+         (if (consp x)
+             (cons (rw.eqtrace-bldr (car x) box)
+                   (rw.eqtrace-list-bldr (cdr x) box))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.eqtrace-bldr rw.eqtrace-list-bldr))))
+
+(defthm rw.flag-eqtrace-bldr-of-trace
+  (equal (rw.flag-eqtrace-bldr 'trace x box)
+         (rw.eqtrace-bldr x box))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-bldr))))
+
+(defthm rw.flag-eqtrace-bldr-of-list
+  (equal (rw.flag-eqtrace-bldr 'list x box)
+         (rw.eqtrace-list-bldr x box))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-list-bldr))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-bldr))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-list-bldr))))
+
+(encapsulate
+ ()
+ (defthm rw.eqtrace-list-bldr-when-not-consp
+   (implies (not (consp x))
+            (equal (rw.eqtrace-list-bldr x box)
+                   nil))
+   :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-list-bldr))))
+
+ (defthm rw.eqtrace-list-bldr-of-cons
+   (equal (rw.eqtrace-list-bldr (cons a x) box)
+          (cons (rw.eqtrace-bldr a box)
+                (rw.eqtrace-list-bldr x box)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-list-bldr))))
+
+ (defprojection
+   :list (rw.eqtrace-list-bldr x box)
+   :element (rw.eqtrace-bldr x box)
+   :already-definedp t))
+
+
+
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (if (equal flag 'trace)
+              (implies (and (rw.eqtracep x)
+                            (rw.hypboxp box)
+                            (rw.eqtrace-okp x box))
+                       (and (logic.appealp (rw.eqtrace-bldr x box))
+                            (equal (logic.conclusion (rw.eqtrace-bldr x box))
+                                   (rw.eqtrace-formula x box))))
+            (implies (and (rw.eqtrace-listp x)
+                          (rw.hypboxp box)
+                          (rw.eqtrace-list-okp x box))
+                     (and (logic.appeal-listp (rw.eqtrace-list-bldr x box))
+                          (equal (logic.strip-conclusions (rw.eqtrace-list-bldr x box))
+                                 (rw.eqtrace-formula-list x box)))))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (rw.flag-eqtrace-bldr flag x box)
+                  :expand (rw.eqtrace-bldr x box)))))
+
+ (defthm forcing-logic.appealp-of-rw.eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)))
+            (equal (logic.appealp (rw.eqtrace-bldr x box))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'trace))))))
+
+ (defthm forcing-logic.conclusion-of-rw.eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)))
+            (equal (logic.conclusion (rw.eqtrace-bldr x box))
+                   (rw.eqtrace-formula x box)))
+   :hints(("Goal" :use ((:instance lemma (flag 'trace))))))
+
+ (defthm forcing-logic.appeal-listp-of-rw.eqtrace-list-bldr
+   (implies (force (and (rw.eqtrace-listp x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-list-okp x box)))
+            (equal (logic.appeal-listp (rw.eqtrace-list-bldr x box))
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list))))))
+
+ (defthm forcing-logic.strip-conclusions-of-rw.eqtrace-list-bldr
+   (implies (force (and (rw.eqtrace-listp x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-list-okp x box)))
+            (equal (logic.strip-conclusions (rw.eqtrace-list-bldr x box))
+                   (rw.eqtrace-formula-list x box)))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+(verify-guards rw.flag-eqtrace-bldr)
+(verify-guards rw.eqtrace-bldr)
+(verify-guards rw.eqtrace-list-bldr)
+
+(encapsulate
+ ()
+ (local (defthm@ lemma
+          (if (equal flag 'trace)
+              (implies (and (rw.eqtracep x)
+                            (rw.hypboxp box)
+                            (rw.eqtrace-okp x box)
+                            ;; ---
+                            (rw.hypbox-atblp box atbl)
+                            (equal (cdr (lookup 'not atbl)) 1)
+                            (equal (cdr (lookup 'equal atbl)) 2)
+                            (equal (cdr (lookup 'iff atbl)) 2)
+                            (@obligations rw.eqtrace-bldr))
+                       (equal (logic.proofp (rw.eqtrace-bldr x box) axioms thms atbl)
+                              t))
+            (implies (and (rw.eqtrace-listp x)
+                          (rw.hypboxp box)
+                          (rw.eqtrace-list-okp x box)
+                          ;; ---
+                          (rw.hypbox-atblp box atbl)
+                          (equal (cdr (lookup 'not atbl)) 1)
+                          (equal (cdr (lookup 'equal atbl)) 2)
+                          (equal (cdr (lookup 'iff atbl)) 2)
+                          (@obligations rw.eqtrace-list-bldr))
+                     (equal (logic.proof-listp (rw.eqtrace-list-bldr x box) axioms thms atbl)
+                            t)))
+          :rule-classes nil
+          :hints(("Goal"
+                  :induct (rw.flag-eqtrace-bldr flag x box)
+                  :expand (rw.eqtrace-bldr x box)))))
+
+ (defthm@ forcing-logic.proofp-of-rw.eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-okp x box)
+                        ;; ---
+                        (rw.hypbox-atblp box atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.eqtrace-bldr)))
+            (equal (logic.proofp (rw.eqtrace-bldr x box) axioms thms atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'trace))))))
+
+ (defthm@ forcing-logic.proof-listp-of-rw.eqtrace-list-bldr
+   (implies (force (and (rw.eqtrace-listp x)
+                        (rw.hypboxp box)
+                        (rw.eqtrace-list-okp x box)
+                        ;; ---
+                        (rw.hypbox-atblp box atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.eqtrace-list-bldr)))
+            (equal (logic.proof-listp (rw.eqtrace-list-bldr x box) axioms thms atbl)
+                   t))
+   :hints(("Goal" :use ((:instance lemma (flag 'list)))))))
+
+
+
+(defund rw.eqtrace-bldr-okp (x atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'rw.eqtrace-bldr)
+         (tuplep 2 extras)
+         (let ((trace (first extras))
+               (box   (second extras)))
+           (and (rw.eqtracep trace)
+                (rw.hypboxp box)
+                (rw.fast-hypbox-atblp box atbl)
+                (rw.eqtrace-okp trace box)
+                (equal conclusion (rw.eqtrace-formula trace box))
+                (not subproofs))))))
+
+(defund rw.eqtrace-bldr-high (x box)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.eqtrace-okp x box))))
+  (logic.appeal 'rw.eqtrace-bldr
+                (rw.eqtrace-formula x box)
+                nil
+                (list x box)))
+
+(defobligations rw.eqtrace-bldr-okp
+  (rw.eqtrace-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-bldr-okp)))
+
+ (defthm booleanp-of-rw.eqtrace-bldr-okp
+   (equal (booleanp (rw.eqtrace-bldr-okp x atbl))
+          t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm rw.eqtrace-bldr-okp-of-logic.appeal-identity
+   (equal (rw.eqtrace-bldr-okp (logic.appeal-identity x) atbl)
+          (rw.eqtrace-bldr-okp x atbl))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (local (in-theory (enable backtracking-logic.formula-atblp-rules)))
+ (local (in-theory (disable forcing-logic.formula-atblp-rules
+                            forcing-lookup-of-logic.function-name-free
+                            forcing-logic.term-list-atblp-of-logic.function-args)))
+
+ (defthm lemma-1-for-soundness-of-rw.eqtrace-bldr-okp
+   (implies (and (rw.eqtrace-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (rw.eqtrace-bldr (first (logic.extras x))
+                                     (second (logic.extras x))))
+                   (logic.conclusion x)))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm@ lemma-2-for-soundness-of-rw.eqtrace-bldr-okp
+   (implies (and (rw.eqtrace-bldr-okp x atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 ;; ---
+                 (@obligations rw.eqtrace-bldr-okp)
+                 (mapp atbl)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'equal atbl)) 2))
+            (equal (logic.proofp
+                    (rw.eqtrace-bldr (first (logic.extras x))
+                                     (second (logic.extras x)))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-rw.eqtrace-bldr-okp
+   (implies (and (rw.eqtrace-bldr-okp x atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)))
+                 ;; ---
+                 (force (mapp atbl))
+                 (force (@obligations rw.eqtrace-bldr-okp))
+                 (force (equal (cdr (lookup 'not atbl)) 1))
+                 (force (equal (cdr (lookup 'iff atbl)) 2))
+                 (force (equal (cdr (lookup 'equal atbl)) 2)))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-rw.eqtrace-bldr-okp
+                               lemma-2-for-soundness-of-rw.eqtrace-bldr-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (rw.eqtrace-bldr (first (logic.extras x))
+                                                 (second (logic.extras x))))))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/eqtrace-okp.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/eqtrace-okp.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/eqtrace-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/eqtrace-okp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,339 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primary-eqtrace")
+(include-book "secondary-eqtrace")
+(include-book "transitivity-eqtraces")
+(include-book "weakening-eqtrace")
+(include-book "direct-iff-eqtrace")
+(include-book "negative-iff-eqtrace")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund rw.eqtrace-step-okp (x box)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box))))
+  (let ((method (rw.eqtrace->method x)))
+    (cond ((equal method 'primary)      (rw.primary-eqtrace-okp x box))
+          ((equal method 'secondary)    (rw.secondary-eqtrace-okp x box))
+          ((equal method 'trans1)       (rw.trans1-eqtrace-okp x))
+          ((equal method 'trans2)       (rw.trans2-eqtrace-okp x))
+          ((equal method 'trans3)       (rw.trans3-eqtrace-okp x))
+          ((equal method 'weakening)    (rw.weakening-eqtrace-okp x))
+          ((equal method 'direct-iff)   (rw.direct-iff-eqtrace-okp x box))
+          ((equal method 'negative-iff) (rw.negative-iff-eqtrace-okp x box))
+          (t nil))))
+
+(defthm booleanp-of-rw.eqtrace-step-okp
+  (equal (booleanp (rw.eqtrace-step-okp x box))
+         t)
+  :hints(("Goal" :in-theory (enable rw.eqtrace-step-okp))))
+
+
+
+(defun rw.flag-eqtrace-okp (flag x box)
+  (declare (xargs :guard (if (equal flag 'trace)
+                             (and (rw.eqtracep x)
+                                  (rw.hypboxp box))
+                           (and (equal flag 'list)
+                                (rw.eqtrace-listp x)
+                                (rw.hypboxp box)))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'trace) 1 0))))
+  (if (equal flag 'trace)
+      (and (rw.eqtrace-step-okp x box)
+           (rw.flag-eqtrace-okp 'list (rw.eqtrace->subtraces x) box))
+    (if (consp x)
+        (and (rw.flag-eqtrace-okp 'trace (car x) box)
+             (rw.flag-eqtrace-okp 'list (cdr x) box))
+      t)))
+
+(definlined rw.eqtrace-okp (x box)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box))))
+  (rw.flag-eqtrace-okp 'trace x box))
+
+(definlined rw.eqtrace-list-okp (x box)
+  (declare (xargs :guard (and (rw.eqtrace-listp x)
+                              (rw.hypboxp box))))
+  (rw.flag-eqtrace-okp 'list x box))
+
+(defthmd definition-of-rw.eqtrace-okp
+  (equal (rw.eqtrace-okp x box)
+         (and (rw.eqtrace-step-okp x box)
+              (rw.eqtrace-list-okp (rw.eqtrace->subtraces x) box)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.eqtrace-okp rw.eqtrace-list-okp))))
+
+(defthmd definition-of-rw.eqtrace-list-okp
+  (equal (rw.eqtrace-list-okp x box)
+         (if (consp x)
+             (and (rw.eqtrace-okp (car x) box)
+                  (rw.eqtrace-list-okp (cdr x) box))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.eqtrace-okp rw.eqtrace-list-okp))))
+
+(defthm rw.flag-eqtrace-okp-of-trace
+  (equal (rw.flag-eqtrace-okp 'trace x box)
+         (rw.eqtrace-okp x box))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-okp))))
+
+(defthm rw.flag-eqtrace-okp-of-list
+  (equal (rw.flag-eqtrace-okp 'list x box)
+         (rw.eqtrace-list-okp x box))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-list-okp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-okp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-list-okp))))
+
+(defthms-flag
+  :thms ((trace booleanp-of-rw.eqtrace-okp
+                (equal (booleanp (rw.eqtrace-okp x box))
+                       t))
+         (t booleanp-of-rw.eqtrace-list-okp
+            (equal (booleanp (rw.eqtrace-list-okp x box))
+                   t)))
+  :hints (("Goal"
+           :induct (rw.flag-eqtrace-okp flag x box)
+           :in-theory (enable definition-of-rw.eqtrace-okp
+                              definition-of-rw.eqtrace-list-okp))))
+
+(defthm rw.eqtrace-list-okp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.eqtrace-list-okp x box)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-list-okp))))
+
+(defthm rw.eqtrace-list-okp-of-cons
+  (equal (rw.eqtrace-list-okp (cons a x) box)
+         (and (rw.eqtrace-okp a box)
+              (rw.eqtrace-list-okp x box)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-list-okp))))
+
+(defthm rw.eqtrace-step-okp-of-nil
+  (equal (rw.eqtrace-step-okp nil box)
+         nil)
+  :hints(("Goal" :in-theory (enable rw.eqtrace-step-okp))))
+
+(defthm rw.eqtrace-okp-of-nil
+  (equal (rw.eqtrace-okp nil box)
+         nil)
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-okp))))
+
+(deflist rw.eqtrace-list-okp (x box)
+  (rw.eqtrace-okp x box)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(defthm forcing-rw.eqtrace-list-okp-of-rw.eqtrace-subtraces
+  (implies (force (rw.eqtrace-okp x box))
+           (equal (rw.eqtrace-list-okp (rw.eqtrace->subtraces x) box)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-okp))))
+
+
+(defthm rw.primary-eqtrace-okp-when-empty-box
+  (implies (and (not (rw.hypbox->left box))
+                (not (rw.hypbox->right box)))
+           (equal (rw.primary-eqtrace-okp x box)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.primary-eqtrace-okp))))
+
+(defthm rw.secondary-eqtrace-okp-when-empty-box
+  (implies (and (not (rw.hypbox->left box))
+                (not (rw.hypbox->right box)))
+           (equal (rw.secondary-eqtrace-okp x box)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.secondary-eqtrace-okp))))
+
+
+
+(defthms-flag
+  :shared-hyp (and (not (rw.hypbox->left box))
+                   (not (rw.hypbox->right box)))
+  :thms ((trace rw.eqtrace-okp-when-empty-box
+                (equal (rw.eqtrace-okp x box)
+                       nil))
+         (t rw.eqtrace-list-okp-when-empty-box
+            (equal (rw.eqtrace-list-okp x box)
+                   (not (consp x)))))
+  :hints(("Goal"
+          :induct (rw.flag-eqtrace-okp flag x box)
+          :in-theory (enable definition-of-rw.eqtrace-okp
+                             rw.eqtrace-step-okp
+                             rw.trans1-eqtrace-okp
+                             rw.trans2-eqtrace-okp
+                             rw.trans3-eqtrace-okp
+                             rw.weakening-eqtrace-okp
+                             rw.direct-iff-eqtrace-okp
+                             rw.negative-iff-eqtrace-okp
+                             ))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (e/d (definition-of-rw.eqtrace-okp
+                          rw.eqtrace-step-okp)
+                        (forcing-rw.eqtrace-list-okp-of-rw.eqtrace-subtraces))))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.primary-eqtrace
+   (implies (force (and (rw.primary-eqtrace okp nhyp)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))))
+            (equal (rw.eqtrace-okp (rw.primary-eqtrace okp nhyp) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.secondary-eqtrace
+   (implies (force (and (rw.secondary-eqtrace okp nhyp)
+                        (rw.hypboxp box)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))))
+            (equal (rw.eqtrace-okp (rw.secondary-eqtrace okp nhyp) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.trans1-eqtrace
+   (implies (force (and (rw.eqtrace-okp x box)
+                        (rw.eqtrace-okp y box)
+                        (equal (rw.eqtrace->rhs x) (rw.eqtrace->lhs y))
+                        (implies (not iffp)
+                                 (and (not (rw.eqtrace->iffp x))
+                                      (not (rw.eqtrace->iffp y))))))
+            (equal (rw.eqtrace-okp (rw.trans1-eqtrace iffp x y) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.trans2-eqtrace
+   (implies (force (and (rw.eqtrace-okp x box)
+                        (rw.eqtrace-okp y box)
+                        (equal (rw.eqtrace->lhs x) (rw.eqtrace->lhs y))
+                        (implies (not iffp)
+                                 (and (not (rw.eqtrace->iffp x))
+                                      (not (rw.eqtrace->iffp y))))))
+            (equal (rw.eqtrace-okp (rw.trans2-eqtrace iffp x y) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.trans3-eqtrace
+   (implies (force (and (rw.eqtrace-okp x box)
+                        (rw.eqtrace-okp y box)
+                        (equal (rw.eqtrace->rhs x) (rw.eqtrace->rhs y))
+                        (implies (not iffp)
+                                 (and (not (rw.eqtrace->iffp x))
+                                      (not (rw.eqtrace->iffp y))))))
+            (equal (rw.eqtrace-okp (rw.trans3-eqtrace iffp x y) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.weakening-eqtrace
+   (implies (force (and (rw.eqtrace-okp x box)
+                        (rw.eqtracep x)))
+            (equal (rw.eqtrace-okp (rw.weakening-eqtrace x) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.direct-iff-eqtrace
+   (implies (force (and (rw.direct-iff-eqtrace okp nhyp)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))))
+            (equal (rw.eqtrace-okp (rw.direct-iff-eqtrace okp nhyp) box)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.negative-iff-eqtrace
+   (implies (force (and (rw.negative-iff-eqtrace okp nhyp)
+                        (rw.hypboxp box)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))))
+            (equal (rw.eqtrace-okp (rw.negative-iff-eqtrace okp nhyp) box)
+                   t))))
+
+
+
+
+
+(defund rw.eqtrace-formula (x box)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.eqtrace-okp x box))))
+  (logic.por (rw.hypbox-formula box)
+             (logic.pequal (logic.function (if (rw.eqtrace->iffp x) 'iff 'equal)
+                                           (list (rw.eqtrace->lhs x)
+                                                 (rw.eqtrace->rhs x)))
+                           ''t)))
+
+(defthm forcing-logic.formulap-of-rw.eqtrace-formula
+  (implies (and (rw.eqtracep x)
+                (rw.hypboxp box)
+                (rw.eqtrace-okp x box))
+           (equal (logic.formulap (rw.eqtrace-formula x box))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-formula))))
+
+(defthm forcing-logic.formula-atblp-of-rw.eqtrace-formula
+  (implies (and (rw.eqtrace-atblp x atbl)
+                (rw.hypboxp box)
+                (rw.hypbox-atblp box atbl)
+                (rw.eqtrace-okp x box)
+                (equal (cdr (lookup 'iff atbl)) 2)
+                (equal (cdr (lookup 'equal atbl)) 2))
+           (equal (logic.formula-atblp (rw.eqtrace-formula x box) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-formula))))
+
+(defprojection
+  :list (rw.eqtrace-formula-list x box)
+  :element (rw.eqtrace-formula x box)
+  :guard (and (rw.eqtrace-listp x)
+              (rw.hypboxp box)
+              (rw.eqtrace-list-okp x box)))
+
+(defthm forcing-logic.formula-listp-of-rw.eqtrace-formula-list
+  (implies (and (rw.eqtrace-listp x)
+                (rw.hypboxp box)
+                (rw.eqtrace-list-okp x box))
+           (equal (logic.formula-listp (rw.eqtrace-formula-list x box))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-rw.eqtrace-formula
+  (implies (and (rw.eqtrace-list-atblp x atbl)
+                (rw.hypboxp box)
+                (rw.hypbox-atblp box atbl)
+                (rw.eqtrace-list-okp x box)
+                (equal (cdr (lookup 'iff atbl)) 2)
+                (equal (cdr (lookup 'equal atbl)) 2))
+           (equal (logic.formula-list-atblp (rw.eqtrace-formula-list x box) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-formula-list))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/eqtracep.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/eqtracep.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/eqtracep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/eqtracep.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,471 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hypboxp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Equivalence traces.
+;;
+;; Much like our rewriter, our assumptions system builds traces which can be
+;; compiled into actual proofs.  This file introduces the generic recognizer
+;; for syntactically valid equivalence traces.  (Object-oriented folks can
+;; think of this as an abstract base class.)  See also eqtrace-okp, which
+;; introduces the concrete kinds of traces (i.e., the subclasses), and finally
+;; eqtrace-compiler.lisp, which defines the compilers for these subclasses.
+
+(defun rw.flag-eqtracep (flag x)
+  (declare (xargs :guard (or (equal flag 'trace)
+                             (equal flag 'list))))
+  (if (equal flag 'trace)
+      ;; We use the cons structure (lhs . rhs) . (iffp . (method . subtraces))
+      (let ((lhs       (car (car x)))
+            (rhs       (cdr (car x)))
+            (iffp      (car (cdr x)))
+            (method    (car (cdr (cdr x))))
+            (subtraces (cdr (cdr (cdr x)))))
+        (and (symbolp method)
+             (booleanp iffp)
+             (logic.termp lhs)
+             (logic.termp rhs)
+             (logic.term-< lhs rhs)
+             (rw.flag-eqtracep 'list subtraces)))
+    (if (consp x)
+        (and (rw.flag-eqtracep 'trace (car x))
+             (rw.flag-eqtracep 'list (cdr x)))
+      t)))
+
+(definlined rw.eqtracep (x)
+  (declare (xargs :guard t))
+  (rw.flag-eqtracep 'trace x))
+
+(definlined rw.eqtrace-listp (x)
+  (declare (xargs :guard t))
+  (rw.flag-eqtracep 'list x))
+
+(defthmd definition-of-rw.eqtracep
+  (equal (rw.eqtracep x)
+         (let ((lhs       (car (car x)))
+               (rhs       (cdr (car x)))
+               (iffp      (car (cdr x)))
+               (method    (car (cdr (cdr x))))
+               (subtraces (cdr (cdr (cdr x)))))
+           (and (symbolp method)
+                (booleanp iffp)
+                (logic.termp lhs)
+                (logic.termp rhs)
+                (logic.term-< lhs rhs)
+                (rw.eqtrace-listp subtraces))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.eqtracep rw.eqtrace-listp))))
+
+(defthmd definition-of-rw.eqtrace-listp
+  (equal (rw.eqtrace-listp x)
+         (if (consp x)
+             (and (rw.eqtracep (car x))
+                  (rw.eqtrace-listp (cdr x)))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.eqtracep rw.eqtrace-listp))))
+
+(defthm rw.flag-eqtracep-of-trace
+  (equal (rw.flag-eqtracep 'trace x)
+         (rw.eqtracep x))
+  :hints(("Goal" :in-theory (enable rw.eqtracep))))
+
+(defthm rw.flag-eqtracep-of-list
+  (equal (rw.flag-eqtracep 'list x)
+         (rw.eqtrace-listp x))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-listp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtracep))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-listp))))
+
+(defthms-flag
+  :thms ((trace booleanp-of-rw.eqtracep
+                (equal (booleanp (rw.eqtracep x))
+                       t))
+         (t booleanp-of-rw.eqtrace-listp
+            (equal (booleanp (rw.eqtrace-listp x))
+                   t)))
+  :hints(("Goal"
+          :induct (rw.flag-eqtracep flag x)
+          :in-theory (enable definition-of-rw.eqtracep
+                             definition-of-rw.eqtrace-listp))))
+
+(defthm rw.eqtrace-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.eqtrace-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-listp))))
+
+(defthm rw.eqtrace-listp-of-cons
+  (equal (rw.eqtrace-listp (cons a x))
+         (and (rw.eqtracep a)
+              (rw.eqtrace-listp x)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-listp))))
+
+(deflist rw.eqtrace-listp (x)
+  (rw.eqtracep x)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+
+
+(definlined rw.eqtrace->method (x)
+  (declare (xargs :guard (rw.eqtracep x)))
+  (car (cdr (cdr x))))
+
+(definlined rw.eqtrace->iffp (x)
+  (declare (xargs :guard (rw.eqtracep x)))
+  (car (cdr x)))
+
+(definlined rw.eqtrace->lhs (x)
+  (declare (xargs :guard (rw.eqtracep x)))
+  (car (car x)))
+
+(definlined rw.eqtrace->rhs (x)
+  (declare (xargs :guard (rw.eqtracep x)))
+  (cdr (car x)))
+
+(definlined rw.eqtrace->subtraces (x)
+  (declare (xargs :guard (rw.eqtracep x)))
+  (cdr (cdr (cdr x))))
+
+(defthm forcing-symbolp-of-rw.eqtrace->method
+  (implies (force (rw.eqtracep x))
+           (equal (symbolp (rw.eqtrace->method x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtracep rw.eqtrace->method))))
+
+(defthm forcing-booleanp-of-rw.eqtrace->iffp
+  (implies (force (rw.eqtracep x))
+           (equal (booleanp (rw.eqtrace->iffp x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtracep rw.eqtrace->iffp))))
+
+(defthm forcing-logic.termp-of-rw.eqtrace->lhs
+  (implies (force (rw.eqtracep x))
+           (equal (logic.termp (rw.eqtrace->lhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtracep rw.eqtrace->lhs))))
+
+(defthm forcing-logic.termp-of-rw.eqtrace->rhs
+  (implies (force (rw.eqtracep x))
+           (equal (logic.termp (rw.eqtrace->rhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtracep rw.eqtrace->rhs))))
+
+(defthm forcing-rw.eqtrace-listp-of-rw.eqtrace->subtraces
+  (implies (force (rw.eqtracep x))
+           (equal (rw.eqtrace-listp (rw.eqtrace->subtraces x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtracep rw.eqtrace->subtraces))))
+
+(defthm forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs
+  (implies (force (rw.eqtracep x))
+           (equal (logic.term-< (rw.eqtrace->lhs x)
+                                (rw.eqtrace->rhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtracep
+                                    rw.eqtrace->lhs
+                                    rw.eqtrace->rhs))))
+
+(defthm forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs-free
+  (implies (and (equal (rw.eqtrace->lhs x) lhs)
+                (equal (rw.eqtrace->rhs x) rhs)
+                (force (rw.eqtracep x)))
+           (equal (logic.term-< lhs rhs)
+                  t)))
+
+
+(defthm |(< a (+ b c d e f a g))|
+  (equal (< a (+ b (+ c (+ d (+ e (+ f (+ a g)))))))
+         (< 0 (+ b (+ c (+ d (+ e (+ f g))))))))
+
+(defthm rank-of-rw.eqtrace->subtraces-weak
+  (equal (< (rank x) (rank (rw.eqtrace->subtraces x)))
+         nil)
+  :hints(("Goal" :in-theory (enable rw.eqtrace->subtraces))))
+
+
+
+
+(defun rw.flag-eqtrace-atblp (flag x atbl)
+  (declare (xargs :guard (if (equal flag 'trace)
+                             (and (rw.eqtracep x)
+                                  (logic.arity-tablep atbl))
+                           (and (equal flag 'list)
+                                (rw.eqtrace-listp x)
+                                (logic.arity-tablep atbl)))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'trace) 1 0))))
+  (if (equal flag 'trace)
+      (and (logic.term-atblp (rw.eqtrace->lhs x) atbl)
+           (logic.term-atblp (rw.eqtrace->rhs x) atbl)
+           (rw.flag-eqtrace-atblp 'list (rw.eqtrace->subtraces x) atbl))
+    (if (consp x)
+        (and (rw.flag-eqtrace-atblp 'trace (car x) atbl)
+             (rw.flag-eqtrace-atblp 'list (cdr x) atbl))
+      t)))
+
+(definlined rw.eqtrace-atblp (x atbl)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (logic.arity-tablep atbl))))
+  (rw.flag-eqtrace-atblp 'trace x atbl))
+
+(definlined rw.eqtrace-list-atblp (x atbl)
+  (declare (xargs :guard (and (rw.eqtrace-listp x)
+                              (logic.arity-tablep atbl))))
+  (rw.flag-eqtrace-atblp 'list x atbl))
+
+(defthmd definition-of-rw.eqtrace-atblp
+  (equal (rw.eqtrace-atblp x atbl)
+         (and (logic.term-atblp (rw.eqtrace->lhs x) atbl)
+              (logic.term-atblp (rw.eqtrace->rhs x) atbl)
+              (rw.eqtrace-list-atblp (rw.eqtrace->subtraces x) atbl)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.eqtrace-atblp
+                                    rw.eqtrace-list-atblp))))
+
+(defthmd definition-of-rw.eqtrace-list-atblp
+  (equal (rw.eqtrace-list-atblp x atbl)
+         (if (consp x)
+             (and (rw.eqtrace-atblp (car x) atbl)
+                  (rw.eqtrace-list-atblp (cdr x) atbl))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.eqtrace-atblp
+                                    rw.eqtrace-list-atblp))))
+
+(defthm rw.flag-eqtrace-atblp-of-trace
+  (equal (rw.flag-eqtrace-atblp 'trace x atbl)
+         (rw.eqtrace-atblp x atbl))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-atblp))))
+
+(defthm rw.flag-eqtrace-atblp-of-list
+  (equal (rw.flag-eqtrace-atblp 'list x atbl)
+         (rw.eqtrace-list-atblp x atbl))
+  :hints(("Goal" :in-theory (enable rw.eqtrace-list-atblp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-atblp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.eqtrace-list-atblp))))
+
+(defthms-flag
+  :thms ((trace booleanp-of-rw.eqtrace-atblp
+                (equal (booleanp (rw.eqtrace-atblp x atbl))
+                       t))
+         (t booleanp-of-rw.eqtrace-list-atblp
+            (equal (booleanp (rw.eqtrace-list-atblp x atbl))
+                   t)))
+  :hints(("Goal"
+          :induct (rw.flag-eqtrace-atblp flag x atbl)
+          :in-theory (enable definition-of-rw.eqtrace-atblp
+                             definition-of-rw.eqtrace-list-atblp))))
+
+(defthm rw.eqtrace-list-atblp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.eqtrace-list-atblp x atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-list-atblp))))
+
+(defthm rw.eqtrace-list-atblp-of-cons
+  (equal (rw.eqtrace-list-atblp (cons a x) atbl)
+         (and (rw.eqtrace-atblp a atbl)
+              (rw.eqtrace-list-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-list-atblp))))
+
+(defthm rw.eqtrace-atblp-of-nil
+  (equal (rw.eqtrace-atblp nil atbl)
+         nil)
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-atblp))))
+
+(deflist rw.eqtrace-list-atblp (x atbl)
+  (rw.eqtrace-atblp x atbl)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(defthm forcing-logic.term-atblp-of-rw.eqtrace->lhs
+  (implies (force (rw.eqtrace-atblp x atbl))
+           (equal (logic.term-atblp (rw.eqtrace->lhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-atblp))))
+
+(defthm forcing-logic.term-atblp-of-rw.eqtrace->rhs
+  (implies (force (rw.eqtrace-atblp x atbl))
+           (equal (logic.term-atblp (rw.eqtrace->rhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-atblp))))
+
+(defthm forcing-rw.eqtrace-list-atblp-of-rw.eqtrace->subtraces
+  (implies (force (rw.eqtrace-atblp x atbl))
+           (equal (rw.eqtrace-list-atblp (rw.eqtrace->subtraces x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-atblp))))
+
+
+
+
+(defund rw.eqtrace (method iffp lhs rhs subtraces)
+  (declare (xargs :guard (and (symbolp method)
+                              (booleanp iffp)
+                              (logic.termp lhs)
+                              (logic.termp rhs)
+                              (logic.term-< lhs rhs)
+                              (rw.eqtrace-listp subtraces))))
+  (cons (cons lhs rhs)
+        (cons iffp
+              (cons method subtraces))))
+
+(defthm rw.eqtrace->method-of-rw.eqtrace
+  (equal (rw.eqtrace->method (rw.eqtrace method iffp lhs rhs subtraces))
+         method)
+  :hints(("Goal" :in-theory (enable rw.eqtrace rw.eqtrace->method))))
+
+(defthm rw.eqtrace->iffp-of-rw.eqtrace
+  (equal (rw.eqtrace->iffp (rw.eqtrace method iffp lhs rhs subtraces))
+         iffp)
+  :hints(("Goal" :in-theory (enable rw.eqtrace rw.eqtrace->iffp))))
+
+(defthm rw.eqtrace->lhs-of-rw.eqtrace
+  (equal (rw.eqtrace->lhs (rw.eqtrace method iffp lhs rhs subtraces))
+         lhs)
+  :hints(("Goal" :in-theory (enable rw.eqtrace rw.eqtrace->lhs))))
+
+(defthm rw.eqtrace->rhs-of-rw.eqtrace
+  (equal (rw.eqtrace->rhs (rw.eqtrace method iffp lhs rhs subtraces))
+         rhs)
+  :hints(("Goal" :in-theory (enable rw.eqtrace rw.eqtrace->rhs))))
+
+(defthm rw.eqtrace->subtraces-of-rw.eqtrace
+  (equal (rw.eqtrace->subtraces (rw.eqtrace method iffp lhs rhs subtraces))
+         subtraces)
+  :hints(("Goal" :in-theory (enable rw.eqtrace rw.eqtrace->subtraces))))
+
+(defthm forcing-rw.eqtracep-of-rw.eqtrace
+  (implies (force (and (symbolp method)
+                       (booleanp iffp)
+                       (logic.termp lhs)
+                       (logic.termp rhs)
+                       (logic.term-< lhs rhs)
+                       (rw.eqtrace-listp subtraces)))
+           (equal (rw.eqtracep (rw.eqtrace method iffp lhs rhs subtraces))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqtrace definition-of-rw.eqtracep))))
+
+(defthm forcing-rw.eqtrace-atblp-of-rw.eqtrace
+  (implies (force (and (logic.term-atblp lhs atbl)
+                       (logic.term-atblp rhs atbl)
+                       (rw.eqtrace-list-atblp subtraces atbl)))
+           (equal (rw.eqtrace-atblp (rw.eqtrace method iffp lhs rhs subtraces) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-atblp))))
+
+(defthm rw.eqtrace-under-iff
+  (iff (rw.eqtrace method iffp lhs rhs subtraces)
+       t)
+  :hints(("Goal" :in-theory (enable rw.eqtrace))))
+
+(defprojection :list (rw.eqtrace-list-iffps x)
+               :element (rw.eqtrace->iffp x)
+               :guard (rw.eqtrace-listp x)
+               :nil-preservingp t)
+
+(defprojection :list (rw.eqtrace-list-lhses x)
+               :element (rw.eqtrace->lhs x)
+               :guard (rw.eqtrace-listp x)
+               :nil-preservingp t)
+
+(defprojection :list (rw.eqtrace-list-rhses x)
+               :element (rw.eqtrace->rhs x)
+               :guard (rw.eqtrace-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-logic.term-listp-of-rw.eqtrace-list-lhses
+  (implies (force (rw.eqtrace-listp x))
+           (equal (logic.term-listp (rw.eqtrace-list-lhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-listp-of-rw.eqtrace-list-rhses
+  (implies (force (rw.eqtrace-listp x))
+           (equal (logic.term-listp (rw.eqtrace-list-rhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.eqtrace-list-lhses
+  (implies (force (rw.eqtrace-list-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.eqtrace-list-lhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.eqtrace-list-rhses
+  (implies (force (rw.eqtrace-list-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.eqtrace-list-rhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defthm rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps
+  (implies (and (all-equalp iffp (rw.eqtrace-list-iffps x))
+                (memberp a x))
+           (equal (rw.eqtrace->iffp a)
+                  iffp))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps-alt
+  (implies (and (memberp a x)
+                (all-equalp iffp (rw.eqtrace-list-iffps x)))
+           (equal (rw.eqtrace->iffp a)
+                  iffp)))
+
+(defthm rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses
+  (implies (and (all-equalp lhs (rw.eqtrace-list-lhses x))
+                (memberp a x))
+           (equal (rw.eqtrace->lhs a)
+                  lhs))
+  :hints (("Goal" :induct (cdr-induction x))))
+
+(defthm rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses-alt
+  (implies (and (memberp a x)
+                (all-equalp lhs (rw.eqtrace-list-lhses x)))
+           (equal (rw.eqtrace->lhs a)
+                  lhs))
+  :hints (("Goal" :induct (cdr-induction x))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/fast.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/fast.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/fast.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/fast.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1354 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "top")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Fast Assumptions System.
+;;
+;; We now introduce a cut-down version of our assumptions system where instead
+;; of storing eqtraces, we only store the relevant terms.  It's actually quite
+;; a bit easier to develop the fast-assms system than the full-blown assms,
+;; because we can just introduce the notion of an FAST IMAGE and work from
+;; that.
+;;
+;; The fast image of an assumptions structure is a similar structure where all
+;; of the traces are gone and only the terms remain.  We basically only need to
+;; develop fast analogues of all the assumptions-manipulating routines, and
+;; then show that the image of each routine is the same as the fast-routine.
+;;
+;; This lets us "piggy back" on the proofs we've already done about the assms
+;; system, and frees us from proving all manner of things (e.g., about sets
+;; being mutually disjoint, etc.).  It's actually convenient to define our fast
+;; version of eqsets so that it doesn't need a unique tail, etc.
+
+(defaggregate rw.fast-eqset
+  (head iffp tail)
+  :require ((logic.termp-of-rw.fast-eqset->head      (logic.termp head))
+            (booleanp-of-rw.fast-eqset->iffp         (booleanp iffp))
+            (consp-of-rw.fast-eqset->tail            (consp tail))
+            (true-listp-of-rw.fast-eqset->tail       (true-listp tail))
+            (logic.term-listp-of-rw.fast-eqset->tail (logic.term-listp tail)))
+  :legiblep nil)
+
+(defthm equal-of-rw.fast-eqset-and-rw.fast-eqset
+  (equal (equal (rw.fast-eqset head iffp tail)
+                (rw.fast-eqset head2 iffp2 tail2))
+         (and (equal head head2)
+              (equal iffp iffp2)
+              (equal tail tail2)))
+  :hints(("Goal" :in-theory (enable rw.fast-eqset))))
+
+(deflist rw.fast-eqset-listp (x)
+  (rw.fast-eqsetp x)
+  :elementp-of-nil nil)
+
+(defprojection
+  :list (rw.fast-eqset-list-heads x)
+  :element (rw.fast-eqset->head x)
+  :guard (rw.fast-eqset-listp x)
+  :nil-preservingp t)
+
+(defprojection
+  :list (rw.fast-eqset-list-iffps x)
+  :element (rw.fast-eqset->iffp x)
+  :guard (rw.fast-eqset-listp x)
+  :nil-preservingp t)
+
+(defprojection
+  :list (rw.fast-eqset-list-tails x)
+  :element (rw.fast-eqset->tail x)
+  :guard (rw.fast-eqset-listp x)
+  :nil-preservingp t)
+
+
+
+
+(defund rw.eqset-fast-image (x)
+  (declare (xargs :guard (rw.eqsetp x)))
+  (rw.fast-eqset (rw.eqset->head x)
+                 (rw.eqset->iffp x)
+                 (rw.eqtrace-list-rhses (rw.eqset->tail x))))
+
+(defthm rw.eqset-fast-image-under-iff
+  (iff (rw.eqset-fast-image x)
+       t)
+  :hints(("Goal" :in-theory (enable rw.eqset-fast-image))))
+
+(defthm rw.eqset-fast-image-of-rw.eqset
+  (equal (rw.eqset-fast-image (rw.eqset head iffp tail))
+         (rw.fast-eqset head iffp (rw.eqtrace-list-rhses tail)))
+  :hints(("Goal" :in-theory (enable rw.eqset-fast-image))))
+
+(defthm rw.fast-eqsetp-of-rw.eqset-fast-image
+  (implies (force (rw.eqsetp x))
+           (equal (rw.fast-eqsetp (rw.eqset-fast-image x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqset-fast-image))))
+
+(defthm rw.fast-eqset->head-of-rw.eqset-fast-image
+  (equal (rw.fast-eqset->head (rw.eqset-fast-image x))
+         (rw.eqset->head x))
+  :hints(("Goal" :in-theory (enable rw.eqset-fast-image))))
+
+(defthm rw.fast-eqset->iffp-of-rw.eqset-fast-image
+  (equal (rw.fast-eqset->iffp (rw.eqset-fast-image x))
+         (rw.eqset->iffp x))
+  :hints(("Goal" :in-theory (enable rw.eqset-fast-image))))
+
+(defthm rw.fast-eqset->tail-of-rw.eqset-fast-image
+  (equal (rw.fast-eqset->tail (rw.eqset-fast-image x))
+         (rw.eqtrace-list-rhses (rw.eqset->tail x)))
+  :hints(("Goal" :in-theory (enable rw.eqset-fast-image))))
+
+
+
+
+(defprojection :list (rw.eqset-list-fast-image x)
+               :element (rw.eqset-fast-image x)
+               :guard (rw.eqset-listp x))
+
+(defthm rw.fast-eqset-listp-of-rw.eqset-list-fast-image
+  (implies (force (rw.eqset-listp x))
+           (equal (rw.fast-eqset-listp (rw.eqset-list-fast-image x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.fast-eqset-list-heads-of-rw.eqset-list-fast-image
+  (equal (rw.fast-eqset-list-heads (rw.eqset-list-fast-image x))
+         (rw.eqset-list-heads x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+(definlined rw.fast-eqtrace-contradictionp (iffp lhs rhs)
+  (declare (xargs :guard (and (booleanp iffp)
+                              (logic.termp lhs)
+                              (logic.termp rhs))))
+  (or (if iffp
+          (and (equal lhs ''nil) (equal rhs ''t))
+        (and (logic.constantp lhs)
+             (logic.constantp rhs)
+             (not (equal lhs rhs))))
+      (and (clause.negative-termp rhs)
+           (equal (clause.negative-term-guts rhs) lhs))))
+
+(defthm booleanp-of-rw.fast-eqtrace-contradictionp
+  (equal (booleanp (rw.fast-eqtrace-contradictionp iffp lhs rhs))
+         t)
+  :hints(("Goal" :in-theory (enable rw.fast-eqtrace-contradictionp))))
+
+(defthm rw.fast-eqtrace-contradictionp-when-rw.eqtrace-contradictionp
+  (equal (rw.fast-eqtrace-contradictionp (rw.eqtrace->iffp x) (rw.eqtrace->lhs x) (rw.eqtrace->rhs x))
+         (rw.eqtrace-contradictionp x))
+  :hints(("Goal" :in-theory (enable rw.fast-eqtrace-contradictionp
+                                    rw.eqtrace-contradictionp))))
+
+
+
+(definlined rw.fast-find-eqtrace-contradiction (iffp lhs rhses)
+  (declare (xargs :guard (and (booleanp iffp)
+                              (logic.termp lhs)
+                              (logic.term-listp rhses))))
+  (if (consp rhses)
+      (or (rw.fast-eqtrace-contradictionp iffp lhs (car rhses))
+          (rw.fast-find-eqtrace-contradiction iffp lhs (cdr rhses)))
+    nil))
+
+(defthm booleanp-of-rw.fast-find-eqtrace-contradiction
+  (equal (booleanp (rw.fast-find-eqtrace-contradiction iffp lhs rhses))
+         t)
+  :hints(("Goal" :in-theory (enable rw.fast-find-eqtrace-contradiction))))
+
+(defthm rw.fast-find-eqtrace-contradiction-when-rw.find-eqtrace-contradiction
+  (implies (and (force (all-equalp lhs (rw.eqtrace-list-lhses x)))
+                (force (all-equalp iffp (rw.eqtrace-list-iffps x))))
+           (equal (rw.fast-find-eqtrace-contradiction iffp lhs (rw.eqtrace-list-rhses x))
+                  (if (rw.find-eqtrace-contradiction x)
+                      t
+                    nil)))
+  :hints(("Goal"
+          :in-theory (enable rw.find-eqtrace-contradiction
+                             rw.fast-find-eqtrace-contradiction)
+          :induct (cdr-induction x))))
+
+
+
+(definlined rw.find-contradiction-in-fast-eqset-list (x)
+  (declare (xargs :guard (rw.fast-eqset-listp x)))
+  (if (consp x)
+      (or (rw.fast-find-eqtrace-contradiction (rw.fast-eqset->iffp (car x))
+                                              (rw.fast-eqset->head (car x))
+                                              (rw.fast-eqset->tail (car x)))
+          (rw.find-contradiction-in-fast-eqset-list (cdr x)))
+    nil))
+
+(defthm booleanp-of-rw.find-contradiction-in-fast-eqset-list
+  (equal (booleanp (rw.find-contradiction-in-fast-eqset-list x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.find-contradiction-in-fast-eqset-list))))
+
+(defthm rw.find-contradiction-in-fast-eqset-list-of-rw.eqset-list-fast-image
+  (implies (force (rw.eqset-listp eqsets))
+           (equal (rw.find-contradiction-in-fast-eqset-list (rw.eqset-list-fast-image eqsets))
+                  (if (rw.find-contradiction-in-eqset-list eqsets)
+                      t
+                    nil)))
+  :hints(("Goal"
+          :in-theory (enable rw.find-contradiction-in-fast-eqset-list
+                             rw.find-contradiction-in-eqset-list)
+          :induct (cdr-induction eqsets))))
+
+
+
+
+
+(defaggregate rw.fast-eqdatabase
+  (equalsets iffsets contradiction)
+  :require ((rw.fast-eqset-listp-of-rw.fast-eqdatabase->equalsets                 (rw.fast-eqset-listp equalsets))
+            (rw.fast-eqset-listp-of-rw.fast-eqdatabase->iffsets                   (rw.fast-eqset-listp iffsets))
+            (booleanp-of-rw.fast-eqdatabase->contradiction                        (booleanp contradiction))
+            ;(uniquep-of-rw.fast-eqset-list-heads-of-rw.fast-eqdatabase->equalsets (uniquep (rw.fast-eqset-list-heads equalsets)))
+            ;(uniquep-of-rw.fast-eqset-list-heads-of-rw.fast-eqdatabase->iffsets   (uniquep (rw.fast-eqset-list-heads iffsets)))
+            )
+  :legiblep nil)
+
+(defthm equal-of-rw.fast-eqdatabase-rewrite
+    (implies (force (and (rw.fast-eqset-listp equalsets)
+                         (rw.fast-eqset-listp iffsets)
+                         (booleanp contradiction)))
+             (equal (equal (rw.fast-eqdatabase equalsets iffsets contradiction) db)
+                    (and (rw.fast-eqdatabasep db)
+                         (equal (rw.fast-eqdatabase->equalsets db) equalsets)
+                         (equal (rw.fast-eqdatabase->iffsets db) iffsets)
+                         (equal (rw.fast-eqdatabase->contradiction db) contradiction))))
+    :hints(("Goal" :in-theory (enable rw.fast-eqdatabase
+                                      rw.fast-eqdatabasep
+                                      rw.fast-eqdatabase->equalsets
+                                      rw.fast-eqdatabase->iffsets
+                                      rw.fast-eqdatabase->contradiction))))
+
+
+;; (defthmd lemma-for-uniquep-of-rw.fast-eqset-list-heads-of-rw.eqset-list-fast-image
+;;   (equal (memberp a (rw.fast-eqset-list-heads (rw.eqset-list-fast-image x)))
+;;          (memberp a (rw.eqset-list-heads x)))
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+;; (defthm uniquep-of-rw.fast-eqset-list-heads-of-rw.eqset-list-fast-image
+;;   (equal (uniquep (rw.fast-eqset-list-heads (rw.eqset-list-fast-image eqsets)))
+;;          (uniquep (rw.eqset-list-heads eqsets)))
+;;   :hints(("Goal"
+;;           :induct (cdr-induction eqsets))
+;;           :in-theory (enable rw.eqset-fast-image
+;;                              lemma-for-uniquep-of-rw.fast-eqset-list-heads-of-rw.eqset-list-fast-image)))
+
+(defund rw.eqdatabase-fast-image (x)
+  (declare (xargs :guard (rw.eqdatabasep x)))
+  (rw.fast-eqdatabase (rw.eqset-list-fast-image (rw.eqdatabase->equalsets x))
+                      (rw.eqset-list-fast-image (rw.eqdatabase->iffsets x))
+                      (if (rw.eqdatabase->contradiction x)
+                          t
+                        nil)))
+
+(defthm rw.fast-eqdatabasep-of-rw.eqdatabase-fast-image
+  (implies (force (and (rw.eqdatabasep db)))
+           (equal (rw.fast-eqdatabasep (rw.eqdatabase-fast-image db))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-fast-image))))
+
+
+
+
+
+
+(definlined rw.fast-eqset-lookup (term eqset)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.fast-eqsetp eqset))
+                  :guard-hints (("Goal" :in-theory (enable rw.fast-eqsetp)))))
+  (if (logic.term-< term (rw.fast-eqset->head eqset))
+      nil
+    (if (memberp term (rw.fast-eqset->tail eqset))
+        (rw.fast-eqset->head eqset)
+      nil)))
+
+(defthm rw.fast-eqset-lookup-of-rw.eqset-fast-image
+  (implies (force (rw.eqsetp x))
+           (equal (rw.fast-eqset-lookup term (rw.eqset-fast-image x))
+                  (if (rw.eqset-lookup term x)
+                      (rw.eqtrace->lhs (rw.eqset-lookup term x))
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-eqset-lookup
+                                    rw.eqset-lookup
+                                    rw.eqset-fast-image))))
+
+(defund rw.fast-eqset-list-lookup (term eqsets)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.fast-eqset-listp eqsets))))
+  (if (consp eqsets)
+      (or (rw.fast-eqset-lookup term (car eqsets))
+          (rw.fast-eqset-list-lookup term (cdr eqsets)))
+    nil))
+
+(defthm rw.eqset->head-under-iff
+  (implies (force (rw.eqsetp x))
+           (iff (rw.eqset->head x)
+                t))
+  :hints(("Goal" :in-theory (enable rw.eqsetp
+                                    rw.eqset->head))))
+
+(defthm rw.fast-eqset-list-lookup-of-rw.eqset-list-fast-image
+  (implies (force (rw.eqset-listp x))
+           (equal (rw.fast-eqset-list-lookup term (rw.eqset-list-fast-image x))
+                  (if (rw.eqset-list-lookup term x)
+                      (rw.eqtrace->lhs (rw.eqset-list-lookup term x))
+                    nil)))
+  :hints(("Goal"
+          :in-theory (enable rw.eqset-list-lookup
+                             rw.fast-eqset-list-lookup)
+          :induct (cdr-induction x))))
+
+(definlined rw.fast-try-equiv-database (term database iffp)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.fast-eqdatabasep database)
+                              (booleanp iffp))))
+  (if iffp
+      (rw.fast-eqset-list-lookup term (rw.fast-eqdatabase->iffsets database))
+    (rw.fast-eqset-list-lookup term (rw.fast-eqdatabase->equalsets database))))
+
+(defthm rw.fast-try-equiv-database-of-rw.eqdatabase-image
+  (implies (rw.eqdatabasep database)
+           (equal (rw.fast-try-equiv-database term (rw.eqdatabase-fast-image database) iffp)
+                  (if (rw.try-equiv-database term database iffp)
+                      (rw.eqtrace->lhs (rw.try-equiv-database term database iffp))
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.eqdatabase-fast-image
+                                    rw.try-equiv-database
+                                    rw.fast-try-equiv-database))))
+
+(defthm logic.termp-of-rw.fast-eqset-lookup
+  (implies (force (rw.fast-eqsetp eqset))
+           (equal (logic.termp (rw.fast-eqset-lookup term eqset))
+                  (if (rw.fast-eqset-lookup term eqset)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-eqset-lookup))))
+
+(defthm logic.termp-of-rw.fast-eqset-list-lookup
+  (implies (force (rw.fast-eqset-listp eqsets))
+           (equal (logic.termp (rw.fast-eqset-list-lookup term eqsets))
+                  (if (rw.fast-eqset-list-lookup term eqsets)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-eqset-list-lookup))))
+
+(defthm logic.termp-of-rw.fast-try-equiv-database
+  (implies (force (rw.fast-eqdatabasep database))
+           (equal (logic.termp (rw.fast-try-equiv-database term database iffp))
+                  (if (rw.fast-try-equiv-database term database iffp)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-try-equiv-database))))
+
+
+
+
+(definlined rw.fast-eqset-relevant (term eqset)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.fast-eqsetp eqset))))
+  (or (equal (rw.fast-eqset->head eqset) term)
+      (rw.fast-eqset-lookup term eqset)))
+
+(defthm rw.fast-eqset-relevant-of-rw.eqset-fast-image
+  (implies (force (rw.eqsetp x))
+           (iff (rw.fast-eqset-relevant term (rw.eqset-fast-image x))
+                (rw.eqset-relevant term x)))
+  :hints(("Goal" :in-theory (enable rw.fast-eqset-relevant
+                                    rw.eqset-relevant
+                                    ))))
+
+(definlined rw.find-relevant-fast-eqset (term eqsets)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.fast-eqset-listp eqsets))))
+  (if (consp eqsets)
+      (if (rw.fast-eqset-relevant term (car eqsets))
+          (car eqsets)
+        (rw.find-relevant-fast-eqset term (cdr eqsets)))
+    nil))
+
+(defthm rw.fast-eqsetp-of-rw.find-relevant-fast-eqset
+  (implies (force (rw.fast-eqset-listp eqsets))
+           (equal (rw.fast-eqsetp (rw.find-relevant-fast-eqset term eqsets))
+                  (if (rw.find-relevant-fast-eqset term eqsets)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.find-relevant-fast-eqset))))
+
+(defthm rw.find-relevant-fast-eqset-of-rw.eqset-list-fast-image
+  (implies (force (rw.eqset-listp eqsets))
+           (equal (rw.find-relevant-fast-eqset term (rw.eqset-list-fast-image eqsets))
+                  (if (rw.find-relevant-eqset term eqsets)
+                      (rw.eqset-fast-image (rw.find-relevant-eqset term eqsets))
+                    nil)))
+  :hints(("Goal"
+          :in-theory (enable rw.fast-eqset-relevant
+                             rw.eqset-relevant
+                             rw.find-relevant-fast-eqset
+                             rw.find-relevant-eqset))))
+
+(defthm memberp-of-rw.find-relevant-fast-eqset
+  (implies (force (rw.fast-eqset-listp x))
+           (equal (memberp (rw.find-relevant-fast-eqset a x) x)
+                  (if (rw.find-relevant-fast-eqset a x)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.find-relevant-fast-eqset))))
+
+
+
+
+(definlined rw.join-fast-eqsets (lhs-set rhs-set)
+  ;; We are given a trace, say lhs equiv rhs, and two distinct eqsets which are
+  ;; relevant to lhs and rhs, respectively.  We are to union these eqsets.
+  (declare (xargs :guard (and (rw.fast-eqsetp lhs-set)
+                              (rw.fast-eqsetp rhs-set))))
+  (let* ((lhs* (rw.fast-eqset->head lhs-set))
+         (rhs* (rw.fast-eqset->head rhs-set))
+         (iffp (rw.fast-eqset->iffp lhs-set)))
+    (if (logic.term-< lhs* rhs*)
+        (rw.fast-eqset lhs* iffp
+                       (revappend (rw.fast-eqset->tail lhs-set)
+                                  (rw.fast-eqset->tail rhs-set)))
+      (rw.fast-eqset rhs* iffp
+                     (revappend (rw.fast-eqset->tail lhs-set)
+                                (rw.fast-eqset->tail rhs-set))))))
+
+(defthm rw.fast-eqsetp-of-rw.join-fast-eqsets
+  (implies (force (and (rw.fast-eqsetp lhs-set)
+                       (rw.fast-eqsetp rhs-set)))
+           (equal (rw.fast-eqsetp (rw.join-fast-eqsets lhs-set rhs-set))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.join-fast-eqsets))))
+
+(defthm rw.eqset-fast-image-of-rw.join-eqsets
+  (implies (force (and (rw.eqtracep trace)
+                       (rw.eqsetp lhs-set)
+                       (rw.eqsetp rhs-set)
+                       (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp lhs-set))
+                       (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp rhs-set))
+                       (rw.eqset-relevant (rw.eqtrace->lhs trace) lhs-set)
+                       (rw.eqset-relevant (rw.eqtrace->rhs trace) rhs-set)))
+           (equal (rw.eqset-fast-image (rw.join-eqsets trace lhs-set rhs-set))
+                  (rw.join-fast-eqsets (rw.eqset-fast-image lhs-set)
+                                       (rw.eqset-fast-image rhs-set))))
+  :hints(("Goal"
+          :in-theory (enable rw.join-eqsets rw.join-fast-eqsets))))
+
+
+
+
+(definlined rw.fast-eqset-extend (lhs rhs eqset)
+  ;; Try to extend an eqset with lhs = rhs.  The eqset is only actually
+  ;; extended if this equality is relevant, i.e., lhs or rhs occur in the set
+  ;; somewhere.
+  (declare (xargs :guard (and (logic.termp lhs)
+                              (logic.termp rhs)
+                              (rw.fast-eqsetp eqset))))
+  (let* ((set-head  (rw.fast-eqset->head eqset))
+         (set-tail  (rw.fast-eqset->tail eqset))
+         (iffp      (rw.fast-eqset->iffp eqset)))
+    (cond ((equal lhs set-head)
+           ;; Special case.
+           ;;  * The set's head need not change.
+           ;;  * The set's tail needs to be extended with rhs exactly
+           ;;    when trace-rhs is not already present.
+           (if (memberp rhs set-tail)
+               eqset
+             (rw.fast-eqset set-head iffp (cons rhs set-tail))))
+          ((equal rhs set-head)
+           ;; Special case.
+           ;;  * The set's head needs to change from rhs to lhs.
+           ;;  * The set's tail does not currently include rhs, since rhs is
+           ;;    the set-head.  Hence, we need to add rhs to the tail.
+           (rw.fast-eqset lhs iffp (cons rhs set-tail)))
+          (t
+           (let ((lhs-lookup (memberp lhs set-tail))
+                 (rhs-lookup (memberp rhs set-tail)))
+             (cond ((and lhs-lookup rhs-lookup)
+                    ;; lhs and rhs are already in the set.  We already know they
+                    ;; are equal, and this trace adds nothing.
+                    eqset)
+                   (lhs-lookup
+                    ;; lhs is in the set, but rhs is not.
+                    ;;  * The set's head will not change, since head < lhs < rhs
+                    ;;    and we are only adding rhs.
+                    (rw.fast-eqset set-head iffp (cons rhs set-tail)))
+                   (rhs-lookup
+                    ;; rhs is in the set, but lhs is not.
+                    (if (logic.term-< set-head lhs)
+                        ;; Case 1.
+                        ;;  * The set's head will not change
+                        ;;  * We need to add lhs to the set's tail.
+                        (rw.fast-eqset set-head iffp (cons lhs set-tail))
+                      ;; Case 2.
+                      ;; We know lhs < set-head, since we already ruled out the possibility
+                      ;; that they are equal, and we know that set-head is not less than lhs.
+                      ;;  * The set's head needs to become lhs.
+                      ;;  * All the existing traces in the tail are currently of
+                      ;;    the from set-head ~ x, and need to be updated to
+                      ;;    become trace-lhs ~ x.
+                      ;;  * We don't add trace-lhs ~ trace-rhs, because trace-rhs
+                      ;;    is already a member of the tail.
+                      ;;  * But trace-lhs ~ set-head needs to be added to the tail,
+                      ;;    since it is not yet present.
+                      (rw.fast-eqset lhs
+                                     iffp
+                                     (cons set-head set-tail))))
+                   (t
+                    ;; Neither trace-lhs nor trace-rhs are in the set.  The
+                    ;; trace is not related to this set, so we won't need to
+                    ;; change the set.
+                    eqset)))))))
+
+(defthm rw.fast-eqsetp-of-rw.fast-eqset-extend
+  (implies (force (and (logic.termp lhs)
+                       (logic.termp rhs)
+                       (rw.fast-eqsetp eqset)))
+           (equal (rw.fast-eqsetp (rw.fast-eqset-extend lhs rhs eqset))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-eqset-extend))))
+
+(defthm rw.eqset-fast-image-of-rw.eqset-extend
+  (implies (force (and (rw.eqtracep trace)
+                       (rw.eqsetp eqset)
+                       (equal (rw.eqtrace->iffp trace) (rw.eqset->iffp eqset))))
+           (equal (rw.eqset-fast-image (rw.eqset-extend trace eqset))
+                  (rw.fast-eqset-extend (rw.eqtrace->lhs trace)
+                                        (rw.eqtrace->rhs trace)
+                                        (rw.eqset-fast-image eqset))))
+  :hints(("Goal" :in-theory (enable rw.eqset-extend
+                                    rw.fast-eqset-extend))))
+
+
+
+
+(defund rw.remove-fast-eqset-by-head (head eqsets)
+  (declare (xargs :guard (and (logic.termp head)
+                              (rw.fast-eqset-listp eqsets))))
+  (if (consp eqsets)
+      (if (equal head (rw.fast-eqset->head (car eqsets)))
+          (rw.remove-fast-eqset-by-head head (cdr eqsets))
+        (cons (car eqsets)
+              (rw.remove-fast-eqset-by-head head (cdr eqsets))))
+    nil))
+
+(defthm rw.fast-eqset-listp-of-rw.remove-fast-eqset-by-head
+  (implies (force (rw.fast-eqset-listp eqsets))
+           (equal (rw.fast-eqset-listp (rw.remove-fast-eqset-by-head head eqsets))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.remove-fast-eqset-by-head))))
+
+
+
+(definlined rw.fast-eqsets-extend (lhs rhs iffp eqsets)
+  (declare (xargs :guard (and (logic.termp lhs)
+                              (logic.termp rhs)
+                              (booleanp iffp)
+                              (rw.fast-eqset-listp eqsets)
+                              ;(uniquep (rw.fast-eqset-list-heads eqsets))
+                              )
+                  :verify-guards nil))
+  (let* ((lhs-set (rw.find-relevant-fast-eqset lhs eqsets))
+         (rhs-set (rw.find-relevant-fast-eqset rhs eqsets)))
+    (cond ((and (not lhs-set) (not rhs-set))
+           ;; Neither term occurs in any existing set, so we want to create
+           ;; a new set for these terms.
+           (cons (rw.fast-eqset lhs iffp (list rhs)) eqsets))
+          ((not lhs-set)
+           ;; Only the rhs occurs in any set.  Update that set to include the
+           ;; lhs.  There is no chance that this merges sets, since only one
+           ;; set is relevant to the trace.
+           (cons (rw.fast-eqset-extend lhs rhs rhs-set)
+                 (rw.remove-fast-eqset-by-head (rw.fast-eqset->head rhs-set) eqsets)))
+          ((not rhs-set)
+           ;; Only the lhs occurs in any set. Update the set to include the
+           ;; lhs.  As before, there is no chance that we need to merge sets,
+           ;; since only one set is relevant.
+           (cons (rw.fast-eqset-extend lhs rhs lhs-set)
+                 (rw.remove-fast-eqset-by-head (rw.fast-eqset->head lhs-set) eqsets)))
+          ((equal lhs-set rhs-set)
+           ;; Both terms already occur in the same set, so we already know
+           ;; they are equal.  No updates are necessary.
+           eqsets)
+          (t
+           ;; Otherwise each term occurs in its own set.  This trace must now
+           ;; be used to merge the sets.
+           (let ((lhs-head (rw.fast-eqset->head lhs-set))
+                 (rhs-head (rw.fast-eqset->head rhs-set)))
+             (cons (rw.join-fast-eqsets lhs-set rhs-set)
+                   (rw.remove-fast-eqset-by-head lhs-head
+                    (rw.remove-fast-eqset-by-head rhs-head eqsets))))))))
+
+(encapsulate
+ ()
+ (local (defthm crock
+          (implies (and (not (memberp a cr0))
+                        (memberp b cr0))
+                   (equal (equal a b)
+                          nil))))
+
+ (local (defthm lemma
+          (implies (and (uniquep (rw.fast-eqset-list-heads eqsets))
+                        (memberp a eqsets)
+                        (memberp b eqsets)
+                        (rw.fast-eqset-listp eqsets))
+                   (equal (equal (rw.fast-eqset->head a)
+                                 (rw.fast-eqset->head b))
+                          (equal a b)))
+          :hints(("goal"
+                  :induct (cdr-induction eqsets)))))
+
+ (verify-guards rw.fast-eqsets-extend))
+
+
+
+(defthm rw.fast-eqset-listp-of-rw.fast-eqsets-extend
+  (implies (force (and (logic.termp lhs)
+                       (logic.termp rhs)
+                       (booleanp iffp)
+                       (rw.fast-eqset-listp eqsets)))
+           (equal (rw.fast-eqset-listp (rw.fast-eqsets-extend lhs rhs iffp eqsets))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-eqsets-extend))))
+
+
+
+(defsection rw.eqset-fast-image-of-rw.eqsets-extend
+
+  (defthmd lemma-0-for-rw.eqset-fast-image-of-rw.eqsets-extend
+    (implies (not (memberp (rw.eqset->head a)
+                           (rw.eqset-list-heads x)))
+             (equal (remove-all a x)
+                    (list-fix x)))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthmd lemma-0b-for-rw.eqset-fast-image-of-rw.eqsets-extend
+    (implies (not (memberp head (rw.fast-eqset-list-heads x)))
+             (equal (rw.remove-fast-eqset-by-head head x)
+                    (list-fix x)))
+    :hints(("Goal" :in-theory (enable rw.remove-fast-eqset-by-head))))
+
+  (defthmd lemma-1-for-rw.eqset-fast-image-of-rw.eqsets-extend
+    (implies (and (uniquep (rw.eqset-list-heads x))
+                  (memberp a x))
+             (equal (rw.remove-fast-eqset-by-head (rw.eqset->head a) (rw.eqset-list-fast-image x))
+                    (rw.eqset-list-fast-image (remove-all a x))))
+    :hints(("Goal"
+            :induct (cdr-induction x)
+            :in-theory (enable rw.remove-fast-eqset-by-head
+                               lemma-0-for-rw.eqset-fast-image-of-rw.eqsets-extend
+                               lemma-0b-for-rw.eqset-fast-image-of-rw.eqsets-extend))))
+
+  (defthmd lemma-2-for-rw.eqset-fast-image-of-rw.eqsets-extend
+    (implies (and (uniquep (rw.eqset-list-heads x))
+                  (memberp a x)
+                  (memberp b x)
+                  (not (equal a b)))
+             (equal (equal (rw.eqset-fast-image a)
+                           (rw.eqset-fast-image b))
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.eqset-fast-image))))
+
+  (defthm rw.eqset-fast-image-of-rw.eqsets-extend
+    (implies (force (and (rw.eqtracep trace)
+                         (rw.eqset-listp eqsets)
+                         (all-equalp (rw.eqtrace->iffp trace) (rw.eqset-list-iffps eqsets))
+                         (uniquep (rw.eqset-list-heads eqsets))
+                         (mutually-disjointp (rw.eqset-list-rhses eqsets))
+                         (disjoint-from-allp (rw.eqset-list-heads eqsets)
+                                             (rw.eqset-list-rhses eqsets))))
+             (equal (rw.eqset-list-fast-image (rw.eqsets-extend trace eqsets))
+                    (rw.fast-eqsets-extend (rw.eqtrace->lhs trace)
+                                           (rw.eqtrace->rhs trace)
+                                           (rw.eqtrace->iffp trace)
+                                           (rw.eqset-list-fast-image eqsets))))
+    :hints(("Goal" :in-theory (enable rw.fast-eqsets-extend
+                                      rw.eqsets-extend
+                                      lemma-1-for-rw.eqset-fast-image-of-rw.eqsets-extend
+                                      lemma-2-for-rw.eqset-fast-image-of-rw.eqsets-extend)))))
+
+
+
+(defsection rw.fast-eqdatabase-extend
+
+  (definlined rw.fast-eqdatabase-extend (nhyp database primaryp secondaryp directp negativep)
+    (declare (xargs :guard (and (logic.termp nhyp)
+                                (rw.fast-eqdatabasep database)
+                                (booleanp primaryp)
+                                (booleanp secondaryp)
+                                (booleanp directp)
+                                (booleanp negativep))))
+    ;; BOZO building eqtraces here isn't really necessary, and we could avoid it by
+    ;; writing some cut-down versions.  But this really isn't too much consing, and
+    ;; it's hard to imagine that it would matter.
+    (let ((trace1 (rw.primary-eqtrace primaryp nhyp))
+          (trace2 (rw.secondary-eqtrace secondaryp nhyp))
+          (trace3 (rw.direct-iff-eqtrace directp nhyp))
+          (trace4 (rw.negative-iff-eqtrace negativep nhyp))
+          (iffp   (or directp negativep)))
+      (if (or trace1 trace2 trace3 trace4)
+          (let* ((equalsets        (rw.fast-eqdatabase->equalsets database))
+                 (iffsets          (rw.fast-eqdatabase->iffsets database))
+                 (contradiction    (rw.fast-eqdatabase->contradiction database))
+                 (equalsets-prime  (if trace1
+                                       (rw.fast-eqsets-extend (rw.eqtrace->lhs trace1)
+                                                              (rw.eqtrace->rhs trace1)
+                                                              nil
+                                                              equalsets)
+                                     equalsets))
+                 (equalsets-prime  (if trace2
+                                       (rw.fast-eqsets-extend (rw.eqtrace->lhs trace2)
+                                                              (rw.eqtrace->rhs trace2)
+                                                              nil
+                                                              equalsets-prime)
+                                     equalsets-prime))
+                 (iffsets-prime    (if (and iffp trace1)
+                                       (rw.fast-eqsets-extend (rw.eqtrace->lhs trace1)
+                                                              (rw.eqtrace->rhs trace1)
+                                                              t
+                                                              iffsets)
+                                     iffsets))
+                 (iffsets-prime    (if (and iffp trace2)
+                                       (rw.fast-eqsets-extend (rw.eqtrace->lhs trace2)
+                                                              (rw.eqtrace->rhs trace2)
+                                                              t
+                                                              iffsets-prime)
+                                     iffsets-prime))
+                 (iffsets-prime    (if trace3
+                                       (rw.fast-eqsets-extend (rw.eqtrace->lhs trace3)
+                                                              (rw.eqtrace->rhs trace3)
+                                                              t
+                                                              iffsets-prime)
+                                     iffsets-prime))
+                 (iffsets-prime    (if trace4
+                                       (rw.fast-eqsets-extend (rw.eqtrace->lhs trace4)
+                                                              (rw.eqtrace->rhs trace4)
+                                                              t
+                                                              iffsets-prime)
+                                     iffsets-prime)))
+            (rw.fast-eqdatabase equalsets-prime
+                                iffsets-prime
+                                (or contradiction
+                                    (rw.find-contradiction-in-fast-eqset-list equalsets-prime)
+                                    (rw.find-contradiction-in-fast-eqset-list iffsets-prime))))
+        database)))
+
+
+  ;; This proof was kind of hard.  I introduced some auxilliary functions to
+  ;; help me break it down into pieces.
+
+  (defund rw.fast-eqdatabase-extend-equalsets (nhyp database primaryp secondaryp)
+    (declare (xargs :verify-guards nil))
+    (let* ((trace1           (rw.primary-eqtrace primaryp nhyp))
+           (trace2           (rw.secondary-eqtrace secondaryp nhyp))
+           (equalsets        (rw.fast-eqdatabase->equalsets database))
+           (equalsets-prime  (if trace1
+                                 (rw.fast-eqsets-extend (rw.eqtrace->lhs trace1)
+                                                        (rw.eqtrace->rhs trace1)
+                                                        nil
+                                                        equalsets)
+                               equalsets))
+           (equalsets-prime  (if trace2
+                                 (rw.fast-eqsets-extend (rw.eqtrace->lhs trace2)
+                                                        (rw.eqtrace->rhs trace2)
+                                                        nil
+                                                        equalsets-prime)
+                               equalsets-prime)))
+      (if (or trace1 trace2)
+          equalsets-prime
+        equalsets)))
+
+  (defund rw.fast-eqdatabase-extend-iffsets (nhyp database primaryp secondaryp directp negativep)
+    (declare (xargs :verify-guards nil))
+    (let* ((trace1           (rw.primary-eqtrace primaryp nhyp))
+           (trace2           (rw.secondary-eqtrace secondaryp nhyp))
+           (trace3           (rw.direct-iff-eqtrace directp nhyp))
+           (trace4           (rw.negative-iff-eqtrace negativep nhyp))
+           (iffp             (or directp negativep))
+           (iffsets          (rw.fast-eqdatabase->iffsets database))
+           (iffsets-prime    (if (and trace1 iffp)
+                                 (rw.fast-eqsets-extend (rw.eqtrace->lhs trace1)
+                                                        (rw.eqtrace->rhs trace1)
+                                                        t
+                                                        iffsets)
+                               iffsets))
+           (iffsets-prime    (if (and trace2 iffp)
+                                 (rw.fast-eqsets-extend (rw.eqtrace->lhs trace2)
+                                                        (rw.eqtrace->rhs trace2)
+                                                        t
+                                                        iffsets-prime)
+                               iffsets-prime))
+           (iffsets-prime    (if trace3
+                                 (rw.fast-eqsets-extend (rw.eqtrace->lhs trace3)
+                                                        (rw.eqtrace->rhs trace3)
+                                                        t
+                                                        iffsets-prime)
+                               iffsets-prime))
+           (iffsets-prime    (if trace4
+                                 (rw.fast-eqsets-extend (rw.eqtrace->lhs trace4)
+                                                        (rw.eqtrace->rhs trace4)
+                                                        t
+                                                        iffsets-prime)
+                               iffsets-prime)))
+      (if (or trace1 trace2 trace3 trace4)
+          iffsets-prime
+        iffsets)))
+
+  (defund rw.fast-eqdatabase-extend-contradiction (nhyp database primaryp secondaryp directp negativep)
+    (declare (xargs :verify-guards nil))
+    (let ((trace1 (rw.primary-eqtrace primaryp nhyp))
+          (trace2 (rw.secondary-eqtrace secondaryp nhyp))
+          (trace3 (rw.direct-iff-eqtrace directp nhyp))
+          (trace4 (rw.negative-iff-eqtrace negativep nhyp)))
+      (if (or trace1 trace2 trace3 trace4)
+          (or (rw.fast-eqdatabase->contradiction database)
+              (rw.find-contradiction-in-fast-eqset-list
+               (rw.fast-eqdatabase-extend-equalsets nhyp database primaryp secondaryp))
+              (rw.find-contradiction-in-fast-eqset-list
+               (rw.fast-eqdatabase-extend-iffsets nhyp database primaryp secondaryp directp negativep)))
+        (rw.fast-eqdatabase->contradiction database))))
+
+  (defthm booleanp-of-rw.fast-eqdatabase-extend-contradiction
+    (implies (force (and (logic.termp nhyp)
+                         (rw.fast-eqdatabasep database)))
+             (equal (booleanp (rw.fast-eqdatabase-extend-contradiction nhyp database primaryp secondaryp directp negativep))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.fast-eqdatabase-extend-contradiction))))
+
+  (defthmd rw.fast-eqdatabase-extend-redefinition
+    (implies (force (and (logic.termp nhyp)
+                         (rw.fast-eqdatabasep database)))
+             (equal (rw.fast-eqdatabase-extend nhyp database primaryp secondaryp directp negativep)
+                    (rw.fast-eqdatabase (rw.fast-eqdatabase-extend-equalsets nhyp database primaryp secondaryp)
+                                        (rw.fast-eqdatabase-extend-iffsets nhyp database primaryp secondaryp directp negativep)
+                                        (rw.fast-eqdatabase-extend-contradiction nhyp database primaryp secondaryp directp negativep))))
+    :hints(("Goal" :in-theory (enable rw.fast-eqdatabase-extend
+                                      rw.fast-eqdatabase-extend-equalsets
+                                      rw.fast-eqdatabase-extend-iffsets
+                                      rw.fast-eqdatabase-extend-contradiction))))
+
+  (local (in-theory (enable rw.fast-eqdatabase-extend-redefinition)))
+
+
+  ;; And here come analogues for the non-fast version.
+
+  (defund rw.eqdatabase-extend-equalsets (nhyp database primaryp secondaryp)
+    (declare (xargs :verify-guards nil))
+    (let* ((trace1           (rw.primary-eqtrace primaryp nhyp))
+           (trace2           (rw.secondary-eqtrace secondaryp nhyp))
+           (equalsets        (rw.eqdatabase->equalsets database))
+           (equalsets-prime  (if trace1 (rw.eqsets-extend trace1 equalsets) equalsets))
+           (equalsets-prime  (if trace2 (rw.eqsets-extend trace2 equalsets-prime) equalsets-prime)))
+      (if (or trace1 trace2)
+          equalsets-prime
+        equalsets)))
+
+  (defund rw.eqdatabase-extend-iffsets (nhyp database primaryp secondaryp directp negativep)
+    (declare (xargs :verify-guards nil))
+    (let* ((trace1        (rw.primary-eqtrace primaryp nhyp))
+           (trace2        (rw.secondary-eqtrace secondaryp nhyp))
+           (trace3        (rw.direct-iff-eqtrace directp nhyp))
+           (trace4        (rw.negative-iff-eqtrace negativep nhyp))
+           (iffp          (or directp negativep))
+           (iffsets       (rw.eqdatabase->iffsets database))
+           (iffsets-prime (if (and iffp trace1) (rw.eqsets-extend (rw.weakening-eqtrace trace1) iffsets) iffsets))
+           (iffsets-prime (if (and iffp trace2) (rw.eqsets-extend (rw.weakening-eqtrace trace2) iffsets-prime) iffsets-prime))
+           (iffsets-prime (if trace3 (rw.eqsets-extend trace3 iffsets-prime) iffsets-prime))
+           (iffsets-prime (if trace4 (rw.eqsets-extend trace4 iffsets-prime) iffsets-prime)))
+      (if (or trace1 trace2 trace3 trace4)
+          iffsets-prime
+        iffsets)))
+
+  (defund rw.eqdatabase-extend-contradiction (nhyp database primaryp secondaryp directp negativep)
+    (declare (xargs :verify-guards nil))
+    (let* ((trace1 (rw.primary-eqtrace primaryp nhyp))
+           (trace2 (rw.secondary-eqtrace secondaryp nhyp))
+           (trace3 (rw.direct-iff-eqtrace directp nhyp))
+           (trace4 (rw.negative-iff-eqtrace negativep nhyp)))
+      (if (or trace1 trace2 trace3 trace4)
+          (or (rw.eqdatabase->contradiction database)
+              (rw.find-contradiction-in-eqset-list (rw.eqdatabase-extend-equalsets nhyp database primaryp secondaryp))
+              (rw.find-contradiction-in-eqset-list (rw.eqdatabase-extend-iffsets nhyp database primaryp secondaryp directp negativep)))
+        (rw.eqdatabase->contradiction database))))
+
+  (defthmd equal-of-rw.eqdatabase-rewrite
+    ;; BOZO consider moving this to the main eqdatabase stuff.
+    (implies (force (rw.eqdatabasep db))
+             (equal (equal (rw.eqdatabase equalsets iffsets contradiction) db)
+                    (and (equal (rw.eqdatabase->equalsets db) equalsets)
+                         (equal (rw.eqdatabase->iffsets db) iffsets)
+                         (equal (rw.eqdatabase->contradiction db) contradiction))))
+    :hints(("Goal" :in-theory (enable rw.eqdatabase
+                                      rw.eqdatabasep
+                                      rw.eqdatabase->equalsets
+                                      rw.eqdatabase->iffsets
+                                      rw.eqdatabase->contradiction))))
+
+  (local (in-theory (enable equal-of-rw.eqdatabase-rewrite)))
+
+  (defthmd rw.eqdatabase-extend-redefinition
+    (implies (force (and (logic.termp nhyp)
+                         (rw.eqdatabasep database)))
+             (equal (rw.eqdatabase-extend nhyp database primaryp secondaryp directp negativep)
+                    (rw.eqdatabase (rw.eqdatabase-extend-equalsets nhyp database primaryp secondaryp)
+                                   (rw.eqdatabase-extend-iffsets nhyp database primaryp secondaryp directp negativep)
+                                   (rw.eqdatabase-extend-contradiction nhyp database primaryp secondaryp directp negativep))))
+    :hints(("Goal" :in-theory (enable rw.eqdatabase-extend
+                                      rw.eqdatabase-extend-equalsets
+                                      rw.eqdatabase-extend-iffsets
+                                      rw.eqdatabase-extend-contradiction))))
+
+  (local (in-theory (enable rw.eqdatabase-extend-redefinition)))
+
+  (defthm rw.fast-eqdatabasep-of-rw.fast-eqdatabase-extend
+    (implies (force (and (logic.termp nhyp)
+                         (rw.fast-eqdatabasep database)))
+             (equal (rw.fast-eqdatabasep (rw.fast-eqdatabase-extend nhyp database primaryp secondaryp directp negativep))
+                    t))
+    :hints(("Goal" :in-theory (e/d (rw.fast-eqdatabase-extend)
+                                   (rw.fast-eqdatabase-extend-redefinition)))))
+
+  (defthm rw.eqset-listp-of-rw.eqdatabase-extend-equalsets
+    (implies (force (and (logic.termp nhyp)
+                         (rw.eqdatabasep database)))
+             (equal (rw.eqset-listp (rw.eqdatabase-extend-equalsets nhyp database primaryp secondaryp))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.eqdatabase-extend-equalsets))))
+
+  (defthm rw.eqset-listp-of-rw.eqdatabase-extend-iffsets
+    (implies (force (and (logic.termp nhyp)
+                         (rw.eqdatabasep database)))
+             (equal (rw.eqset-listp (rw.eqdatabase-extend-iffsets nhyp database primaryp secondaryp directp negativep))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.eqdatabase-extend-iffsets))))
+
+  (defthmd lemma-1-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+    (implies (force (and (logic.termp nhyp)
+                         (rw.eqdatabasep database)))
+             (equal (rw.fast-eqdatabase-extend-equalsets nhyp (rw.eqdatabase-fast-image database) primaryp secondaryp)
+                    (rw.eqset-list-fast-image (rw.eqdatabase-extend-equalsets nhyp database primaryp secondaryp))))
+    :hints(("Goal" :in-theory (enable rw.fast-eqdatabase-extend-equalsets
+                                      rw.eqdatabase-extend-equalsets
+                                      rw.eqdatabase-fast-image))))
+
+  (defthmd lemma-2-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+    (implies (force (and (logic.termp nhyp)
+                         (rw.eqdatabasep database)))
+             (equal (rw.fast-eqdatabase-extend-iffsets nhyp (rw.eqdatabase-fast-image database) primaryp secondaryp directp negativep)
+                    (rw.eqset-list-fast-image (rw.eqdatabase-extend-iffsets nhyp database primaryp secondaryp directp negativep))))
+    :hints(("Goal" :in-theory (enable rw.fast-eqdatabase-extend-iffsets
+                                      rw.eqdatabase-extend-iffsets
+                                      rw.eqdatabase-fast-image))))
+
+  (defthmd lemma-3-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+    (implies (and (rw.eqdatabase-extend-contradiction nhyp database primaryp secondaryp directp negativep)
+                  (force (logic.termp nhyp))
+                  (force (rw.eqdatabasep database)))
+             (equal (rw.fast-eqdatabase-extend-contradiction nhyp (rw.eqdatabase-fast-image database) primaryp secondaryp directp negativep)
+                    t))
+    :hints(("Goal"
+            :in-theory (enable rw.fast-eqdatabase-extend-contradiction
+                               rw.eqdatabase-extend-contradiction
+                               lemma-1-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                               lemma-2-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend))
+           (if (not (memberp (acl2::string-for-tilde-@-clause-id-phrase acl2::id) '("Goal" "Goal'")))
+               '(:expand (RW.EQDATABASE-FAST-IMAGE DATABASE))
+             nil)))
+
+  (defthmd lemma-4-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+    (implies (and (not (rw.eqdatabase-extend-contradiction nhyp database primaryp secondaryp directp negativep))
+                  (force (logic.termp nhyp))
+                  (force (rw.eqdatabasep database)))
+             (equal (rw.fast-eqdatabase-extend-contradiction nhyp (rw.eqdatabase-fast-image database) primaryp secondaryp directp negativep)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.fast-eqdatabase-extend-contradiction
+                                      rw.eqdatabase-extend-contradiction
+                                      lemma-1-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                                      lemma-2-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend))
+           (if (not (memberp (acl2::string-for-tilde-@-clause-id-phrase acl2::id) '("Goal" "Goal'")))
+               '(:expand (RW.EQDATABASE-FAST-IMAGE DATABASE))
+             nil)))
+
+  (defthm rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+    (implies (force (and (logic.termp nhyp)
+                         (rw.eqdatabasep database)))
+             (equal (rw.eqdatabase-fast-image (rw.eqdatabase-extend nhyp database primaryp secondaryp directp negativep))
+                    (rw.fast-eqdatabase-extend nhyp (rw.eqdatabase-fast-image database) primaryp secondaryp directp negativep)))
+    :hints(("Goal"
+            :in-theory (enable lemma-1-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                               lemma-2-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                               lemma-3-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend
+                               lemma-4-for-rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)
+            :expand (rw.eqdatabase-fast-image
+                     (rw.eqdatabase (rw.eqdatabase-extend-equalsets nhyp database primaryp secondaryp)
+                                    (rw.eqdatabase-extend-iffsets nhyp database primaryp secondaryp directp negativep)
+                                    (rw.eqdatabase-extend-contradiction nhyp database primaryp secondaryp directp negativep)))))))
+
+;; Note: encapsulate ends.
+
+(defthm rw.fast-eqdatabase->contradiction-of-rw.fast-eqdatabase-extend-of-rw.eqdatabase-fast-image
+  (implies (force (and (logic.termp nhyp)
+                       (rw.eqdatabasep database)))
+           (equal (rw.fast-eqdatabase->contradiction (rw.fast-eqdatabase-extend nhyp (rw.eqdatabase-fast-image database) primaryp secondaryp directp negativep))
+                  (if (rw.eqdatabase->contradiction (rw.eqdatabase-extend nhyp database primaryp secondaryp directp negativep))
+                      t
+                    nil)))
+  :hints(("Goal"
+          :in-theory (e/d (rw.eqdatabase-fast-image)
+                          (rw.eqdatabase-fast-image-of-rw.eqdatabase-extend))
+          :use ((:instance rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)))))
+
+(defthm rw.fast-eqdatabase->equalsets-of-rw.fast-eqdatabase-extend-of-rw.eqdatabase-fast-image
+  (implies (force (and (logic.termp nhyp)
+                       (rw.eqdatabasep database)))
+           (equal (rw.fast-eqdatabase->equalsets (rw.fast-eqdatabase-extend nhyp (rw.eqdatabase-fast-image database) primaryp secondaryp directp negativep))
+                  (rw.eqset-list-fast-image (rw.eqdatabase->equalsets (rw.eqdatabase-extend nhyp database primaryp secondaryp directp negativep)))))
+  :hints(("Goal"
+          :in-theory (e/d (rw.eqdatabase-fast-image)
+                          (rw.eqdatabase-fast-image-of-rw.eqdatabase-extend))
+          :use ((:instance rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)))))
+
+(defthm rw.fast-eqdatabase->iffsets-of-rw.fast-eqdatabase-extend-of-rw.eqdatabase-fast-image
+  (implies (force (and (logic.termp nhyp)
+                       (rw.eqdatabasep database)))
+           (equal (rw.fast-eqdatabase->iffsets (rw.fast-eqdatabase-extend nhyp (rw.eqdatabase-fast-image database) primaryp secondaryp directp negativep))
+                  (rw.eqset-list-fast-image (rw.eqdatabase->iffsets (rw.eqdatabase-extend nhyp database primaryp secondaryp directp negativep)))))
+  :hints(("Goal"
+          :in-theory (e/d (rw.eqdatabase-fast-image)
+                          (rw.eqdatabase-fast-image-of-rw.eqdatabase-extend))
+          :use ((:instance rw.eqdatabase-fast-image-of-rw.eqdatabase-extend)))))
+
+
+
+
+
+(defaggregate rw.fast-assms
+  (hypbox contradiction eqdatabase trueterms ctrl)
+  :require ((rw.hypboxp-of-rw.fast-assms->hypbox              (rw.hypboxp hypbox))
+            (booleanp-of-rw.fast-assms->contradiction         (booleanp contradiction))
+            (rw.fast-eqdatabasep-of-rw.fast-assms->eqdatabase (rw.fast-eqdatabasep eqdatabase))
+            (logic.term-listp-of-rw.fast-assms->trueterms     (logic.term-listp trueterms))
+            (rw.assmctrlp-of-rw.fast-assms->ctrl              (rw.assmctrlp ctrl)))
+  :legiblep nil)
+
+
+(defund rw.assms-fast-image (x)
+  (declare (xargs :guard (rw.assmsp x)))
+  (rw.fast-assms (rw.assms->hypbox x)
+                 (if (rw.assms->contradiction x) t nil)
+                 (rw.eqdatabase-fast-image (rw.assms->eqdatabase x))
+                 (rw.assms->trueterms x)
+                 (rw.assms->ctrl x)))
+
+(defthm rw.fast-assms->contradiction-of-rw.assms-fast-image
+  (equal (rw.fast-assms->contradiction (rw.assms-fast-image assms))
+         (if (rw.assms->contradiction assms)
+             t
+           nil))
+  :hints(("Goal" :in-theory (enable rw.assms-fast-image))))
+
+(defthm rw.fast-assms->hypbox-of-rw.assms-fast-image
+  (equal (rw.fast-assms->hypbox (rw.assms-fast-image assms))
+         (rw.assms->hypbox assms))
+  :hints(("Goal" :in-theory (enable rw.assms-fast-image))))
+
+(defthm rw.fast-assms->trueterms-of-rw.assms-fast-image
+  (equal (rw.fast-assms->trueterms (rw.assms-fast-image assms))
+         (rw.assms->trueterms assms))
+  :hints(("goal" :in-theory (enable rw.assms-fast-image))))
+
+(defthm rw.fast-assms->ctrl-of-rw.assms-fast-image
+  (equal (rw.fast-assms->ctrl (rw.assms-fast-image assms))
+         (rw.assms->ctrl assms))
+  :hints(("Goal" :in-theory (enable rw.assms-fast-image))))
+
+
+(defthm equal-of-rw.fast-assms
+  (implies (force (rw.fast-assmsp assms))
+           (equal (equal (rw.fast-assms hypbox contradiction eqdatabase trueterms ctrl) assms)
+                  (and (equal (rw.fast-assms->hypbox assms) hypbox)
+                       (equal (rw.fast-assms->contradiction assms) contradiction)
+                       (equal (rw.fast-assms->eqdatabase assms) eqdatabase)
+                       (equal (rw.fast-assms->trueterms assms) trueterms)
+                       (equal (rw.fast-assms->ctrl assms) ctrl))))
+  :hints(("Goal" :in-theory (enable rw.fast-assms
+                                    rw.fast-assmsp
+                                    rw.fast-assms->hypbox
+                                    rw.fast-assms->contradiction
+                                    rw.fast-assms->eqdatabase
+                                    rw.fast-assms->trueterms
+                                    rw.fast-assms->ctrl))))
+
+(defund rw.fast-assume-left (nhyp assms)
+  (declare (xargs :guard (and (logic.termp nhyp)
+                              (rw.fast-assmsp assms))))
+  (let* ((hypbox     (rw.fast-assms->hypbox assms))
+         (eqdb       (rw.fast-assms->eqdatabase assms))
+         (ctrl       (rw.fast-assms->ctrl assms))
+         (new-hypbox (rw.hypbox (cons nhyp (rw.hypbox->left hypbox))
+                                (rw.hypbox->right hypbox)))
+         (new-eqdb   (rw.fast-eqdatabase-extend nhyp eqdb
+                                                (rw.assmctrl->primaryp ctrl)
+                                                (rw.assmctrl->secondaryp ctrl)
+                                                (rw.assmctrl->directp ctrl)
+                                                (rw.assmctrl->negativep ctrl)))
+         (cont       (rw.fast-eqdatabase->contradiction new-eqdb))
+         ;; We considered using the iff-t set, but found negating the equal-nil set to
+         ;; be a better bet since it gives us (not x) terms as well.  Is this a bug
+         ;; with our iff sets, or do we handle this?
+         (false-set  (rw.find-relevant-fast-eqset ''nil (rw.fast-eqdatabase->equalsets new-eqdb)))
+         (trueterms  (if false-set
+                         (clause.smart-negate-list (rw.fast-eqset->tail false-set))
+                       nil)))
+    (rw.fast-assms new-hypbox cont new-eqdb trueterms ctrl)))
+
+(defthm rw.assms-fast-image-of-rw.assume-left
+  (implies (force (and (logic.termp nhyp)
+                       (rw.assmsp assms)))
+           (equal (rw.assms-fast-image (rw.assume-left nhyp assms))
+                  (rw.fast-assume-left nhyp (rw.assms-fast-image assms))))
+  :hints(("Goal" :in-theory (enable rw.assms-fast-image
+                                    rw.assume-left
+                                    rw.fast-assume-left
+                                    rw.eqset->rhses))))
+
+(defthm rw.fast-assmsp-of-rw.fast-assume-left
+  (implies (force (and (logic.termp nhyp)
+                       (rw.fast-assmsp assms)))
+           (equal (rw.fast-assmsp (rw.fast-assume-left nhyp assms))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-assume-left))))
+
+
+
+(definlined rw.fast-assume-right (nhyp assms)
+  (declare (xargs :guard (and (logic.termp nhyp)
+                              (rw.fast-assmsp assms))))
+  (let* ((hypbox     (rw.fast-assms->hypbox assms))
+         (eqdb       (rw.fast-assms->eqdatabase assms))
+         (ctrl       (rw.fast-assms->ctrl assms))
+         (new-hypbox (rw.hypbox (rw.hypbox->left hypbox)
+                                (cons nhyp (rw.hypbox->right hypbox))))
+         (new-eqdb   (rw.fast-eqdatabase-extend nhyp eqdb
+                                                (rw.assmctrl->primaryp ctrl)
+                                                (rw.assmctrl->secondaryp ctrl)
+                                                (rw.assmctrl->directp ctrl)
+                                                (rw.assmctrl->negativep ctrl)))
+         (cont       (rw.fast-eqdatabase->contradiction new-eqdb))
+         (false-row  (rw.find-relevant-fast-eqset ''nil (rw.fast-eqdatabase->equalsets new-eqdb)))
+         (trueterms  (if false-row
+                         (clause.smart-negate-list (rw.fast-eqset->tail false-row))
+                       nil)))
+    (rw.fast-assms new-hypbox cont new-eqdb trueterms ctrl)))
+
+(defthm rw.assms-fast-image-of-rw.assume-right
+  (implies (force (and (logic.termp nhyp)
+                       (rw.assmsp assms)))
+           (equal (rw.assms-fast-image (rw.assume-right nhyp assms))
+                  (rw.fast-assume-right nhyp (rw.assms-fast-image assms))))
+  :hints(("Goal" :in-theory (enable rw.assms-fast-image
+                                    rw.assume-right
+                                    rw.fast-assume-right
+                                    rw.eqset->rhses))))
+
+(defthm rw.fast-assmsp-of-rw.fast-assume-right
+  (implies (force (and (logic.termp nhyp)
+                       (rw.fast-assmsp assms)))
+           (equal (rw.fast-assmsp (rw.fast-assume-right nhyp assms))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-assume-right))))
+
+
+
+(defund rw.fast-assume-left-list (nhyps assms)
+  (declare (xargs :guard (and (logic.term-listp nhyps)
+                              (rw.fast-assmsp assms))))
+  (if (consp nhyps)
+      (rw.fast-assume-left (car nhyps)
+                           (rw.fast-assume-left-list (cdr nhyps) assms))
+    assms))
+
+(defthm rw.assms-fast-image-of-rw.assume-left-list
+  (implies (force (and (logic.term-listp nhyps)
+                       (rw.assmsp assms)))
+           (equal (rw.assms-fast-image (rw.assume-left-list nhyps assms))
+                  (rw.fast-assume-left-list nhyps (rw.assms-fast-image assms))))
+  :hints(("Goal" :in-theory (enable rw.fast-assume-left-list))))
+
+(defthm rw.fast-assmsp-of-rw.fast-assume-left-list
+  (implies (force (and (logic.term-listp nhyps)
+                       (rw.fast-assmsp assms)))
+           (equal (rw.fast-assmsp (rw.fast-assume-left-list nhyps assms))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-assume-left-list))))
+
+
+
+(defund rw.fast-assume-right-list (nhyps assms)
+  (declare (xargs :guard (and (logic.term-listp nhyps)
+                              (rw.fast-assmsp assms))))
+  (if (consp nhyps)
+      (rw.fast-assume-right (car nhyps)
+                            (rw.fast-assume-right-list (cdr nhyps) assms))
+    assms))
+
+(defthm rw.assms-fast-image-of-rw.assume-right-list
+  (implies (force (and (logic.term-listp nhyps)
+                       (rw.assmsp assms)))
+           (equal (rw.assms-fast-image (rw.assume-right-list nhyps assms))
+                  (rw.fast-assume-right-list nhyps (rw.assms-fast-image assms))))
+  :hints(("Goal" :in-theory (enable rw.fast-assume-right-list))))
+
+(defthm rw.fast-assmsp-of-rw.fast-assume-right-list
+  (implies (force (and (logic.term-listp nhyps)
+                       (rw.fast-assmsp assms)))
+           (equal (rw.fast-assmsp (rw.fast-assume-right-list nhyps assms))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-assume-right-list))))
+
+
+
+(definlined rw.empty-fast-assms (ctrl)
+  (declare (xargs :guard (rw.assmctrlp ctrl)))
+  (rw.fast-assms (rw.hypbox nil nil)
+                 nil
+                 (rw.fast-eqdatabase nil nil nil)
+                 nil
+                 ctrl))
+
+(in-theory (disable (:e rw.empty-fast-assms)))
+
+(defthm rw.assms-fast-image-of-rw.empty-assms
+  (equal (rw.assms-fast-image (rw.empty-assms ctrl))
+         (rw.empty-fast-assms ctrl))
+  :hints(("Goal" :in-theory (e/d (rw.assms-fast-image
+                                  rw.empty-fast-assms
+                                  rw.empty-assms
+                                  rw.eqdatabase-fast-image
+                                  rw.empty-eqdatabase
+                                  )
+                                 ((:e ACL2::force))))))
+
+(defthm rw.fast-assmsp-of-rw.empty-assms
+  (implies (force (rw.assmctrlp ctrl))
+           (equal (rw.fast-assmsp (rw.empty-fast-assms ctrl))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.empty-fast-assms))))
+
+
+
+
+(definlined rw.fast-assms-emptyp (assms)
+  (declare (xargs :guard (rw.fast-assmsp assms)))
+  (let ((hypbox (rw.fast-assms->hypbox assms)))
+    (and (not (rw.hypbox->left hypbox))
+         (not (rw.hypbox->right hypbox)))))
+
+(defthm rw.fast-assms-emptyp-of-rw.assms-fast-image
+  (equal (rw.fast-assms-emptyp (rw.assms-fast-image assms))
+         (rw.assms-emptyp assms))
+  :hints(("Goal" :in-theory (enable rw.fast-assms-emptyp
+                                    rw.assms-emptyp
+                                    rw.assms-fast-image))))
+
+
+
+(defund rw.fast-assms-formula (assms)
+  (declare (xargs :guard (and (rw.fast-assmsp assms)
+                              (not (rw.fast-assms-emptyp assms)))
+                  :guard-hints (("Goal" :in-theory (enable rw.fast-assms-emptyp)))))
+  (rw.hypbox-formula (rw.fast-assms->hypbox assms)))
+
+(defthm rw.fast-assms-formula-of-rw.assms-fast-image
+  (equal (rw.fast-assms-formula (rw.assms-fast-image assms))
+         (rw.assms-formula assms))
+  :hints(("Goal" :in-theory (enable rw.fast-assms-formula
+                                    rw.assms-formula
+                                    rw.assms-fast-image))))
+
+
+
+(definlined rw.fast-try-assms (assms term iffp)
+  (declare (xargs :guard (and (rw.fast-assmsp assms)
+                              (logic.termp term)
+                              (booleanp iffp))))
+  (let* ((iffp (and iffp
+                    (let ((ctrl (rw.fast-assms->ctrl assms)))
+                      (or (rw.assmctrl->directp ctrl)
+                          (rw.assmctrl->negativep ctrl))))))
+    (rw.fast-try-equiv-database term (rw.fast-assms->eqdatabase assms) iffp)))
+
+(defthm rw.fast-try-assms-of-rw.assms-fast-image
+  (implies (force (rw.assmsp assms))
+           (equal (rw.fast-try-assms (rw.assms-fast-image assms) term iffp)
+                  (rw.try-assms assms term iffp)))
+  :hints(("Goal" :in-theory (enable rw.fast-try-assms
+                                    rw.try-assms
+                                    rw.assms-fast-image))))
+
+
+
+(defconst *rw.fast-assms-sigma*
+  (list (cons '(rw.try-assms ?assms ?term ?iffp)
+              '(rw.fast-try-assms ?assms ?term ?iffp))
+        (cons '(rw.assume-left ?nhyp ?assms)
+              '(rw.fast-assume-left ?nhyp ?assms))
+        (cons '(rw.assume-left-list ?nhyps ?assms)
+              '(rw.fast-assume-left-list ?nhyps ?assms))
+        (cons '(rw.assume-right ?nhyp ?assms)
+              '(rw.fast-assume-right ?nhyp ?assms))
+        (cons '(rw.assume-right-list ?nhyps ?assms)
+              '(rw.fast-assume-right-list ?nhyps ?assms))
+        (cons '(rw.assms->trueterms ?assms)
+              '(rw.fast-assms->trueterms ?assms))
+        (cons '(rw.assms->hypbox ?assms)
+              '(rw.fast-assms->hypbox ?assms))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/hypbox-arities.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/hypbox-arities.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/hypbox-arities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/hypbox-arities.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,131 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "hypboxp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund rw.slow-hypbox-arities (x)
+  (declare (xargs :guard (rw.hypboxp x)))
+  (app (logic.slow-term-list-arities (rw.hypbox->left x))
+       (logic.slow-term-list-arities (rw.hypbox->right x))))
+
+(defund rw.hypbox-arities (x acc)
+  (declare (xargs :guard (and (rw.hypboxp x)
+                              (true-listp acc))))
+  (logic.term-list-arities (rw.hypbox->left x)
+                           (logic.term-list-arities (rw.hypbox->right x)
+                                                    acc)))
+
+(defthm true-listp-of-rw.hypbox-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.hypbox-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hypbox-arities))))
+
+(defthm rw.hypbox-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.hypbox-arities x acc)
+                  (app (rw.slow-hypbox-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.hypbox-arities
+                                    rw.slow-hypbox-arities))))
+
+(defthm rw.slow-hypbox-arities-correct
+  (implies (force (rw.hypboxp x))
+           (equal (logic.arities-okp (rw.slow-hypbox-arities x) atbl)
+                  (rw.hypbox-atblp x atbl)))
+  :hints(("Goal"
+          :in-theory (e/d (rw.slow-hypbox-arities
+                           rw.hypbox-atblp)
+                          ((:executable-counterpart acl2::force))))))
+
+(definlined rw.fast-hypbox-atblp (x atbl)
+  (declare (xargs :guard (and (rw.hypboxp x)
+                              (logic.arity-tablep atbl))))
+  (logic.fast-arities-okp (rw.hypbox-arities x nil) atbl))
+
+(defthm rw.fast-hypbox-atblp-removal
+  (implies (and (force (rw.hypboxp x))
+                (force (mapp atbl)))
+           (equal (rw.fast-hypbox-atblp x atbl)
+                  (rw.hypbox-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable rw.fast-hypbox-atblp))))
+
+
+
+
+
+
+(defund rw.slow-hypbox-list-arities (x)
+  (declare (xargs :guard (rw.hypbox-listp x)))
+  (if (consp x)
+      ;; Reverse order gives us a tail call in the fast version
+      (app (rw.slow-hypbox-list-arities (cdr x))
+           (rw.slow-hypbox-arities (car x)))
+    nil))
+
+(defund rw.hypbox-list-arities (x acc)
+  (declare (xargs :guard (and (rw.hypbox-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.hypbox-list-arities (cdr x)
+                              (rw.hypbox-arities (car x) acc))
+    acc))
+
+(defthm true-listp-of-rw.hypbox-list-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.hypbox-list-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hypbox-list-arities))))
+
+(defthm rw.hypbox-list-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.hypbox-list-arities x acc)
+                  (app (rw.slow-hypbox-list-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.hypbox-list-arities
+                                    rw.slow-hypbox-list-arities))))
+
+(defthm rw.slow-hypbox-list-arities-correct
+  (implies (force (rw.hypbox-listp x))
+           (equal (logic.arities-okp (rw.slow-hypbox-list-arities x) atbl)
+                  (rw.hypbox-list-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.hypbox-list-atblp x atbl)
+                   (rw.slow-hypbox-list-arities x)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/hypboxp.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/hypboxp.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/hypboxp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/hypboxp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,239 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../../clauses/basic")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(definlined rw.hypboxp (x)
+  (declare (xargs :guard t))
+  (and (consp x)
+       (logic.term-listp (car x))
+       (logic.term-listp (cdr x))
+       (true-listp (car x))
+       (true-listp (cdr x))))
+
+(definlined rw.hypbox (left right)
+  (declare (xargs :guard (and (logic.term-listp left)
+                              (logic.term-listp right)
+                              (true-listp left)
+                              (true-listp right))))
+  (cons left right))
+
+(definlined rw.hypbox->left (x)
+  (declare (xargs :guard (rw.hypboxp x)))
+  (car x))
+
+(definlined rw.hypbox->right (x)
+  (declare (xargs :guard (rw.hypboxp x)))
+  (cdr x))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.hypboxp
+                           rw.hypbox
+                           rw.hypbox->left
+                           rw.hypbox->right)))
+
+ (defthm booleanp-of-rw.hypboxp
+   (equal (booleanp (rw.hypboxp x))
+          t))
+
+ (defthm forcing-rw.hypboxp-of-rw.hypbox
+   (implies (force (and (logic.term-listp left)
+                        (logic.term-listp right)
+                        (true-listp left)
+                        (true-listp right)))
+            (equal (rw.hypboxp (rw.hypbox left right))
+                   t)))
+
+ (defthm rw.hypbox->left-of-rw.hypbox
+   (equal (rw.hypbox->left (rw.hypbox left right))
+          left))
+
+ (defthm rw.hypbox->right-of-rw.hypbox
+   (equal (rw.hypbox->right (rw.hypbox left right))
+          right))
+
+ (defthm forcing-logic.term-listp-of-rw.hypbox->left
+   (implies (force (rw.hypboxp x))
+            (equal (logic.term-listp (rw.hypbox->left x))
+                   t)))
+
+ (defthm forcing-logic.term-listp-of-rw.hypbox->right
+   (implies (force (rw.hypboxp x))
+            (equal (logic.term-listp (rw.hypbox->right x))
+                   t)))
+
+ (defthm forcing-true-listp-of-rw.hypbox->left
+   (implies (force (rw.hypboxp x))
+            (equal (true-listp (rw.hypbox->left x))
+                   t)))
+
+ (defthm forcing-true-listp-of-rw.hypbox->right
+   (implies (force (rw.hypboxp x))
+            (equal (true-listp (rw.hypbox->right x))
+                   t)))
+
+ (defthm forcing-equal-of-rw.hypbox-one
+   (implies (force (rw.hypboxp x))
+            (equal (equal x (rw.hypbox left right))
+                   (and (equal left (rw.hypbox->left x))
+                        (equal right (rw.hypbox->right x))))))
+
+ (defthm forcing-equal-of-rw.hypbox-two
+   (implies (force (rw.hypboxp x))
+            (equal (equal (rw.hypbox left right) x)
+                   (and (equal left (rw.hypbox->left x))
+                        (equal right (rw.hypbox->right x)))))))
+
+
+(definlined rw.hypbox-atblp (x atbl)
+  (declare (xargs :guard (and (rw.hypboxp x)
+                              (logic.arity-tablep atbl))))
+  (and (logic.term-list-atblp (rw.hypbox->left x) atbl)
+       (logic.term-list-atblp (rw.hypbox->right x) atbl)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.hypbox-atblp)))
+
+ (defthm booleanp-of-rw.hypbox-atblp
+   (equal (booleanp (rw.hypbox-atblp x atbl))
+          t))
+
+ (defthm forcing-rw.hypbox-atblp-of-quote-nil
+   (equal (rw.hypbox-atblp '(nil) atbl)
+          t))
+
+ (defthm forcing-logic.term-list-atblp-of-rw.hypbox->left
+   (implies (force (rw.hypbox-atblp x atbl))
+            (equal (logic.term-list-atblp (rw.hypbox->left x) atbl)
+                   t)))
+
+ (defthm forcing-logic.term-list-atblp-of-rw.hypbox->right
+   (implies (force (rw.hypbox-atblp x atbl))
+            (equal (logic.term-list-atblp (rw.hypbox->right x) atbl)
+                   t)))
+
+ (defthm forcing-rw.hypbox-atblp-of-rw.hypbox
+   (implies (force (and (logic.term-list-atblp left atbl)
+                        (logic.term-list-atblp right atbl)))
+            (equal (rw.hypbox-atblp (rw.hypbox left right) atbl)
+                   t)))
+
+ (defthm rw.hypbox-atblp-of-nil
+   (equal (rw.hypbox-atblp nil atbl)
+          t)))
+
+
+
+
+
+(definlined rw.hypbox-formula (x)
+  (declare (xargs :guard (and (rw.hypboxp x)
+                              (or (rw.hypbox->left x)
+                                  (rw.hypbox->right x)))))
+  (let ((left  (rw.hypbox->left x))
+        (right (rw.hypbox->right x)))
+    (cond ((and left right)
+           (logic.por (clause.clause-formula left)
+                      (clause.clause-formula right)))
+          (left
+           (clause.clause-formula left))
+          (right
+           (clause.clause-formula right))
+          (t nil))))
+
+(defthm forcing-logic.formulap-of-rw.hypbox-formula
+  (implies (force (and (rw.hypboxp x)
+                       (or (rw.hypbox->left x)
+                           (rw.hypbox->right x))))
+           (equal (logic.formulap (rw.hypbox-formula x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hypbox-formula))))
+
+(defthm forcing-logic.formula-atblp-of-rw.hypbox-formula
+  (implies (force (and (rw.hypboxp x)
+                       (rw.hypbox-atblp x atbl)
+                       (or (rw.hypbox->left x)
+                           (rw.hypbox->right x))))
+           (equal (logic.formula-atblp (rw.hypbox-formula x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hypbox-formula))))
+
+
+
+(deflist rw.hypbox-listp (x)
+  (rw.hypboxp x)
+  :guard t
+  :elementp-of-nil nil)
+
+(deflist rw.hypbox-list-atblp (x atbl)
+  (rw.hypbox-atblp x atbl)
+  :guard (and (rw.hypbox-listp x)
+              (logic.arity-tablep atbl))
+  :elementp-of-nil t)
+
+
+
+
+(defund logic.true-term-listp (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (logic.termp (car x))
+           (logic.true-term-listp (cdr x)))
+    (not x)))
+
+(defthm logic.true-term-listp-removal
+  (equal (logic.true-term-listp x)
+         (and (true-listp x)
+              (logic.term-listp x)))
+  :hints(("Goal" :in-theory (enable logic.true-term-listp))))
+
+(defund rw.faster-hypboxp (x)
+  (declare (xargs :guard t))
+  (and (consp x)
+       (logic.true-term-listp (car x))
+       (logic.true-term-listp (cdr x))))
+
+(defthm rw.faster-hypboxp-removal
+  (equal (rw.faster-hypboxp x)
+         (rw.hypboxp x))
+  :hints(("Goal" :in-theory (enable rw.faster-hypboxp rw.hypboxp))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/negative-iff-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/negative-iff-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/negative-iff-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/negative-iff-eqtrace-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,214 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(include-book "../../clauses/basic-bldrs")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defderiv rw.negative-iff-eqtrace-nhyp-bldr-lemma-1
+  :from   ((proof x (= (? a) (not (? b)))))
+  :derive (v (!= (? a) nil) (= (iff (? b) t) t))
+  :proof  (@derive
+           ((v (!= x nil) (= (not x) t))                  (build.theorem (theorem-not-when-nil)))
+           ((v (!= (? b) nil) (= (not (? b)) t))          (build.instantiation @- (@sigma (x . (? b)))) *1a)
+           ((= (? a) (not (? b)))                         (@given x))
+           ((v (!= (? b) nil) (= (? a) (not (? b))))      (build.expansion (@formula (!= (? b) nil)) @-))
+           ((v (!= (? b) nil) (= (? a) t))                (build.disjoined-transitivity-of-pequal @- *1a))
+           ((v (!= (? b) nil) (!= (? a) nil))             (build.disjoined-not-nil-from-t @-) *1)
+           ((v (= x nil) (= (iff x t) t))                 (build.theorem (theorem-iff-t-when-not-nil)))
+           ((v (= (? b) nil) (= (iff (? b) t) t))         (build.instantiation @- (@sigma (x . (? b)))))
+           ((v (= (iff (? b) t) t) (!= (? a) nil))        (build.cut @- *1))
+           ((v (!= (? a) nil) (= (iff (? b) t) t))        (build.commute-or @-)))
+  :minatbl ((iff . 2)))
+
+(defund@ rw.negative-iff-eqtrace-nhyp-bldr (nhyp)
+  ;; Given an nhyp that matches a negative-iff eqtrace, prove:
+  ;;   nhyp != nil v (equal lhs rhs) = t
+  (declare (xargs :guard (and (logic.termp nhyp)
+                              (rw.negative-iff-eqtrace t nhyp))
+                  :verify-guards nil))
+  ;; Let nhyp be (not* (equal a b)).
+  (let* ((guts (clause.negative-term-guts nhyp))
+         (main-proof (@derive
+                      ((= nhyp (not guts))                           (clause.standardize-negative-term-bldr nhyp))
+                      ((v (!= nhyp nil) (= (iff guts t) t))          (rw.negative-iff-eqtrace-nhyp-bldr-lemma-1 @-)))))
+    (if (logic.term-< ''t guts)
+        (build.disjoined-commute-iff main-proof)
+      main-proof)))
+
+(defobligations rw.negative-iff-eqtrace-nhyp-bldr
+  (clause.standardize-negative-term-bldr
+   rw.negative-iff-eqtrace-nhyp-bldr-lemma-1
+   build.disjoined-commute-iff))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.negative-iff-eqtrace
+                           rw.negative-iff-eqtrace-nhyp-bldr
+                           theorem-not-when-nil
+                           theorem-iff-t-when-not-nil
+                           logic.term-formula)))
+
+ (local (in-theory (disable forcing-equal-of-logic.pequal-rewrite-two
+                            forcing-equal-of-logic.pequal-rewrite
+                            forcing-equal-of-logic.por-rewrite-two
+                            forcing-equal-of-logic.por-rewrite
+                            forcing-equal-of-logic.pnot-rewrite-two
+                            forcing-equal-of-logic.pnot-rewrite)))
+
+ (defthm rw.negative-iff-eqtrace-nhyp-bldr-under-iff
+   (iff (rw.negative-iff-eqtrace-nhyp-bldr nhyp)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.negative-iff-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.negative-iff-eqtrace t nhyp)))
+            (equal (logic.appealp (rw.negative-iff-eqtrace-nhyp-bldr nhyp))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.negative-iff-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.negative-iff-eqtrace t nhyp)))
+            (equal (logic.conclusion (rw.negative-iff-eqtrace-nhyp-bldr nhyp))
+                   (logic.por (logic.term-formula nhyp)
+                              (logic.pequal (logic.function 'iff
+                                                            (list (rw.eqtrace->lhs (rw.negative-iff-eqtrace t nhyp))
+                                                                  (rw.eqtrace->rhs (rw.negative-iff-eqtrace t nhyp))))
+                                            ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.negative-iff-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.negative-iff-eqtrace t nhyp)
+                        ;; ---
+                        (logic.term-atblp nhyp atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.negative-iff-eqtrace-nhyp-bldr)))
+            (equal (logic.proofp (rw.negative-iff-eqtrace-nhyp-bldr nhyp) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.negative-iff-eqtrace-nhyp-bldr))
+
+
+
+(defund rw.negative-iff-eqtrace-bldr (x box)
+  ;; Given a negative-iff eqtrace that is box-okp, prove
+  ;;   hypbox-formula v (equal lhs rhs) = t
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.negative-iff-eqtrace-okp x box))
+                  :verify-guards nil))
+  (let* ((left      (rw.hypbox->left box))
+         (right     (rw.hypbox->right box))
+         (nhyp-left (rw.find-nhyp-for-negative-iff-eqtracep left x)))
+    ;; First search for a working hyp on the left.
+    (if nhyp-left
+        ;; 1. nhyp-left v (iff lhs rhs) = t      Negative-Iff eqtrace nhyp bldr
+        ;; 2. Left v (iff lhs rhs) = t           Multi assoc expansion
+        (let* ((line-1 (rw.negative-iff-eqtrace-nhyp-bldr nhyp-left))
+               (line-2 (build.multi-assoc-expansion line-1 (logic.term-list-formulas left))))
+          (if right
+              ;; 3. Left v (Right v (iff lhs rhs) = t)    DJ Left Expansion
+              ;; 4. (Left v Right) v (iff lhs rhs) = t    Associativity
+              (build.associativity (build.disjoined-left-expansion line-2 (clause.clause-formula right)))
+            ;; Else we're done already
+            line-2))
+      ;; Else we know there must be a matching hyp on the right, since our guard
+      ;; requires we are a box-okp negative-iff eqtrace.
+      ;;
+      ;; 1. nhyp-right v (equal lhs rhs) = t       Negative-Iff eqtrace nhyp bldr
+      ;; 2. Right v (equal lhs rhs) = t            Multi assoc expansion.
+      (let* ((nhyp-right (rw.find-nhyp-for-negative-iff-eqtracep right x))
+             (line-1     (rw.negative-iff-eqtrace-nhyp-bldr nhyp-right))
+             (line-2     (build.multi-assoc-expansion line-1 (logic.term-list-formulas right))))
+        (if left
+            ;; 3. Left v (Right v (iff lhs rhs) = t)    Expansion
+            ;; 4. (Left v Right) v (iff lhs rhs) = t    Associativity
+            (build.associativity
+             (build.expansion (clause.clause-formula left) line-2))
+          ;; Else we're done already.
+          line-2)))))
+
+(defobligations rw.negative-iff-eqtrace-bldr
+  (rw.negative-iff-eqtrace-nhyp-bldr
+   build.multi-assoc-expansion
+   build.disjoined-left-expansion))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.negative-iff-eqtrace-bldr
+                           rw.negative-iff-eqtrace-okp
+                           rw.hypbox-formula
+                           rw.eqtrace-formula
+                           )))
+
+ (defthm rw.negative-iff-eqtrace-bldr-under-iff
+   (iff (rw.negative-iff-eqtrace-bldr x box)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.negative-iff-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.negative-iff-eqtrace-okp x box)))
+            (equal (logic.appealp (rw.negative-iff-eqtrace-bldr x box))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.negative-iff-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.negative-iff-eqtrace-okp x box)))
+            (equal (logic.conclusion (rw.negative-iff-eqtrace-bldr x box))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.negative-iff-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.negative-iff-eqtrace-okp x box)
+                        ;; ---
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (rw.hypbox-atblp box atbl)
+                        (@obligations rw.negative-iff-eqtrace-bldr)))
+            (equal (logic.proofp (rw.negative-iff-eqtrace-bldr x box) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.negative-iff-eqtrace-bldr))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/negative-iff-eqtrace.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/negative-iff-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/negative-iff-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/negative-iff-eqtrace.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,202 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(definlined rw.negative-iff-eqtrace (okp nhyp)
+  ;; Generate a negative-iff eqtrace from an nhyp.
+  (declare (xargs :guard (logic.termp nhyp)))
+  (and okp
+       (clause.negative-termp nhyp)
+       (let ((guts (clause.negative-term-guts nhyp)))
+         (if (and (logic.constantp guts)
+                  (not (equal guts ''nil)))
+             ;; The nhyp is (not const) and const is non-nil
+             ;; Effectively the nhyp is (not t).  So we are trying to
+             ;; assume (not t) = nil.  That's useless.
+             nil
+           ;; Else the hyp is (not nil), which is an instant contradiction and
+           ;; of course is interesting, or it's (not foo) for some non-constant
+           ;; called foo, which we want to observe.
+           (if (logic.term-< ''t guts)
+               (rw.eqtrace 'negative-iff t ''t guts nil)
+             (rw.eqtrace 'negative-iff t guts ''t nil))))))
+
+(encapsulate
+ ()
+ (local (in-theory (e/d (rw.negative-iff-eqtrace)
+                        (forcing-booleanp-of-rw.eqtrace->iffp
+                         (:e rw.eqtrace)))))
+
+ (defthm forcing-rw.eqtrace->method-of-rw.negative-iff-eqtrace
+   (implies (force (rw.negative-iff-eqtrace okp nhyp))
+            (equal (rw.eqtrace->method (rw.negative-iff-eqtrace okp nhyp))
+                   'negative-iff)))
+
+ (defthm forcing-rw.eqtrace->iffp-of-rw.negative-iff-eqtrace
+   (implies (force (rw.negative-iff-eqtrace okp nhyp))
+            (equal (rw.eqtrace->iffp (rw.negative-iff-eqtrace okp nhyp))
+                   t)))
+
+ (defthm forcing-rw.eqtrace->subtraces-of-rw.negative-iff-eqtrace
+   (implies (force (rw.negative-iff-eqtrace okp nhyp))
+            (equal (rw.eqtrace->subtraces (rw.negative-iff-eqtrace okp nhyp))
+                   nil)))
+
+ (defthm forcing-rw.eqtracep-of-rw.negative-iff-eqtrace
+   (implies (force (and (rw.negative-iff-eqtrace okp nhyp)
+                        (logic.termp nhyp)))
+            (equal (rw.eqtracep (rw.negative-iff-eqtrace okp nhyp))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.negative-iff-eqtrace
+   (implies (force (and (rw.negative-iff-eqtrace okp nhyp)
+                        (logic.termp nhyp)
+                        (logic.term-atblp nhyp atbl)))
+            (equal (rw.eqtrace-atblp (rw.negative-iff-eqtrace okp nhyp) atbl)
+                   t)))
+
+ (defthm rw.negative-iff-eqtrace-normalize-okp-1
+   (implies (and (rw.negative-iff-eqtrace okp nhyp)
+                 (syntaxp (not (equal okp ''t))))
+            (equal (rw.negative-iff-eqtrace okp nhyp)
+                   (rw.negative-iff-eqtrace t nhyp))))
+
+ (defthm rw.negative-iff-eqtrace-normalize-okp-2
+   (implies (not (rw.negative-iff-eqtrace t nhyp))
+            (equal (rw.negative-iff-eqtrace okp nhyp)
+                   nil))
+   :hints(("Goal" :in-theory (disable (:e ACL2::force)))))
+
+ (defthm rw.negative-iff-eqtrace-normalize-okp-3
+   (equal (rw.negative-iff-eqtrace nil nhyp)
+          nil)))
+
+
+
+
+(defund rw.find-nhyp-for-negative-iff-eqtracep (nhyps x)
+  ;; Find the first nhyp in a list that would generate this negative-iff eqtrace.
+  (declare (xargs :guard (and (logic.term-listp nhyps)
+                              (rw.eqtracep x))))
+  (if (consp nhyps)
+      (if (equal (rw.negative-iff-eqtrace t (car nhyps)) x)
+          (car nhyps)
+        (rw.find-nhyp-for-negative-iff-eqtracep (cdr nhyps) x))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.find-nhyp-for-negative-iff-eqtracep)))
+
+ (defthm rw.find-nhyp-for-negative-iff-eqtracep-of-nil
+   (equal (rw.find-nhyp-for-negative-iff-eqtracep nil x)
+          nil))
+
+ (defthm forcing-logic.termp-of-rw.find-nhyp-for-negative-iff-eqtracep
+   (implies (force (and (rw.find-nhyp-for-negative-iff-eqtracep nhyps x)
+                        (logic.term-listp nhyps)))
+            (equal (logic.termp (rw.find-nhyp-for-negative-iff-eqtracep nhyps x))
+                   t)))
+
+ (defthm forcing-logic.term-atblp-of-rw.find-nhyp-for-negative-iff-eqtracep
+   (implies (force (and (rw.find-nhyp-for-negative-iff-eqtracep nhyps x)
+                        (logic.term-list-atblp nhyps atbl)))
+            (equal (logic.term-atblp (rw.find-nhyp-for-negative-iff-eqtracep nhyps x) atbl)
+                   t)))
+
+ (defthm forcing-memberp-of-rw.find-nhyp-for-negative-iff-eqtracep
+   (implies (force (rw.find-nhyp-for-negative-iff-eqtracep nhyps x))
+            (equal (memberp (rw.find-nhyp-for-negative-iff-eqtracep nhyps x) nhyps)
+                   t)))
+
+ (defthm forcing-rw.negative-iff-eqtrace-of-rw.find-nhyp-for-negative-iff-eqtracep
+   (implies (force (rw.find-nhyp-for-negative-iff-eqtracep nhyps x))
+            (equal (rw.negative-iff-eqtrace t (rw.find-nhyp-for-negative-iff-eqtracep nhyps x))
+                   x))))
+
+
+
+
+(defund rw.negative-iff-eqtrace-okp (x box)
+  ;; Check if any nhyp in the hypbox would generate this negative-iff eqtrace.
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box))))
+  (and (equal (rw.eqtrace->method x) 'negative-iff)
+       (equal (rw.eqtrace->iffp x) t)
+       (if (or (rw.find-nhyp-for-negative-iff-eqtracep (rw.hypbox->left box) x)
+               (rw.find-nhyp-for-negative-iff-eqtracep (rw.hypbox->right box) x))
+           t
+         nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.negative-iff-eqtrace-okp)))
+
+ (defthm booleanp-of-rw.negative-iff-eqtrace-okp
+   (equal (booleanp (rw.negative-iff-eqtrace-okp x box))
+          t)
+   :hints(("Goal" :in-theory (disable forcing-booleanp-of-rw.eqtrace->iffp))))
+
+ (defthmd lemma-for-forcing-rw.negative-iff-eqtrace-okp-rw.negative-iff-eqtrace
+   (implies (and (logic.termp nhyp)
+                 (logic.term-listp nhyps)
+                 (memberp nhyp nhyps)
+                 (rw.negative-iff-eqtrace okp nhyp))
+            (iff (rw.find-nhyp-for-negative-iff-eqtracep nhyps (rw.negative-iff-eqtrace okp nhyp))
+                 t))
+   :hints(("Goal"
+           :in-theory (e/d (rw.find-nhyp-for-negative-iff-eqtracep)
+                           ((:e rw.negative-iff-eqtrace)))
+           :induct (cdr-induction nhyps))))
+
+ (defthm forcing-rw.negative-iff-eqtrace-okp-rw.negative-iff-eqtrace
+   (implies (force (and (rw.negative-iff-eqtrace okp nhyp)
+                        (rw.hypboxp box)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))))
+            (equal (rw.negative-iff-eqtrace-okp (rw.negative-iff-eqtrace okp nhyp) box)
+                   t))
+   :hints(("Goal" :in-theory (e/d (lemma-for-forcing-rw.negative-iff-eqtrace-okp-rw.negative-iff-eqtrace)
+                                  (rw.negative-iff-eqtrace-normalize-okp-1))))))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/primary-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/primary-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/primary-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/primary-eqtrace-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,222 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(include-book "../../clauses/basic-bldrs")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defderiv rw.primary-eqtrace-nhyp-bldr-lemma-1
+  :derive (v (!= (equal (? a) (? b)) nil) (!= (? nhyp) nil))
+  :from   ((proof x (= (? nhyp) (not (equal (? a) (? b))))))
+  :proof  (@derive
+           ((v (!= x nil) (= (not x) t))                                             (build.theorem (theorem-not-when-nil)))
+           ((v (!= (equal (? a) (? b)) nil) (= (not (equal (? a) (? b))) t))         (build.instantiation @- (@sigma (x . (equal (? a) (? b))))) *1)
+           ((= (? nhyp) (not (equal (? a) (? b))))                                   (@given x))
+           ((v (!= (equal (? a) (? b)) nil) (= (? nhyp) (not (equal (? a) (? b)))))  (build.expansion (@formula (!= (equal (? a) (? b)) nil)) @-))
+           ((v (!= (equal (? a) (? b)) nil) (= (? nhyp) t))                          (build.disjoined-transitivity-of-pequal @- *1))
+           ((v (!= (equal (? a) (? b)) nil) (!= (? nhyp) nil))                       (build.disjoined-not-nil-from-t @-))))
+
+(defderiv rw.primary-eqtrace-nhyp-bldr-lemma-2
+  :derive (v (!= (? nhyp) nil) (= (equal (? a) (? b)) t))
+  :from   ((proof x (= (? nhyp) (not (equal (? a) (? b))))))
+  :proof  (@derive
+           ((= (? nhyp) (not (equal (? a) (? b))))                                   (@given x))
+           ((v (!= (equal (? a) (? b)) nil) (!= (? nhyp) nil))                       (rw.primary-eqtrace-nhyp-bldr-lemma-1 @-))
+           ((v (!= (? nhyp) nil) (!= (equal (? a) (? b)) nil))                       (build.commute-or @-))
+           ((v (!= (? nhyp) nil) (= (equal (? a) (? b)) t))                          (build.disjoined-equal-t-from-not-nil @-))))
+
+(defund@ rw.primary-eqtrace-nhyp-bldr (nhyp x)
+  ;; Given an nhyp that matches a primary eqtrace, prove:
+  ;;   nhyp != nil v (equal lhs rhs) = t
+  (declare (xargs :guard (and (logic.termp nhyp)
+                              (rw.eqtracep x)
+                              (equal (rw.primary-eqtrace t nhyp) x))
+                  :verify-guards nil))
+  ;; Let nhyp be (not* (equal a b)).
+  (let* ((guts (clause.negative-term-guts nhyp))
+         (args (logic.function-args guts))
+         (a    (first args))
+         (main-proof (@derive
+                      ((= nhyp (not (equal a b)))                           (clause.standardize-negative-term-bldr nhyp))
+                      ((v (!= nhyp nil) (= (equal a b) t))                  (rw.primary-eqtrace-nhyp-bldr-lemma-2 @-)))))
+    (if (equal a (rw.eqtrace->lhs x))
+        main-proof
+      (build.disjoined-commute-equal main-proof))))
+
+(defobligations rw.primary-eqtrace-nhyp-bldr
+  (clause.standardize-negative-term-bldr
+   rw.primary-eqtrace-nhyp-bldr-lemma-2
+   build.disjoined-commute-equal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.primary-eqtrace
+                           rw.primary-eqtrace-nhyp-bldr
+                           theorem-not-when-nil
+                           logic.term-formula)))
+
+ (local (in-theory (disable forcing-equal-of-logic.pequal-rewrite-two
+                            forcing-equal-of-logic.pequal-rewrite
+                            forcing-equal-of-logic.por-rewrite-two
+                            forcing-equal-of-logic.por-rewrite
+                            forcing-equal-of-logic.pnot-rewrite-two
+                            forcing-equal-of-logic.pnot-rewrite)))
+
+ (defthm rw.primary-eqtrace-nhyp-bldr-under-iff
+   (iff (rw.primary-eqtrace-nhyp-bldr nhyp x)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.primary-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.primary-eqtrace t nhyp) x)))
+            (equal (logic.appealp (rw.primary-eqtrace-nhyp-bldr nhyp x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.primary-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.primary-eqtrace t nhyp) x)))
+            (equal (logic.conclusion (rw.primary-eqtrace-nhyp-bldr nhyp x))
+                   (logic.por (logic.term-formula nhyp)
+                              (logic.pequal (logic.function 'equal
+                                                            (list (rw.eqtrace->lhs x)
+                                                                  (rw.eqtrace->rhs x)))
+                                            ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.primary-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.primary-eqtrace t nhyp) x)
+                        ;; ---
+                        (logic.term-atblp nhyp atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.primary-eqtrace-nhyp-bldr)))
+            (equal (logic.proofp (rw.primary-eqtrace-nhyp-bldr nhyp x) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.primary-eqtrace-nhyp-bldr))
+
+
+(defund rw.primary-eqtrace-bldr (x box)
+  ;; Given a primary eqtrace that is box-okp, prove
+  ;;   hypbox-formula v (equal lhs rhs) = t
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.primary-eqtrace-okp x box))
+                  :verify-guards nil))
+  (let* ((left      (rw.hypbox->left box))
+         (right     (rw.hypbox->right box))
+         (nhyp-left (rw.find-nhyp-for-primary-eqtracep left x)))
+    ;; First search for a working hyp on the left.
+    (if nhyp-left
+        ;; 1. nhyp-left v (equal lhs rhs) = t      Primary eqtrace nhyp bldr
+        ;; 2. Left v (equal lhs rhs) = t           Multi assoc expansion
+        (let* ((line-1 (rw.primary-eqtrace-nhyp-bldr nhyp-left x))
+               (line-2 (build.multi-assoc-expansion line-1 (logic.term-list-formulas left))))
+          (if right
+              ;; 3. Left v (Right v (equal lhs rhs) = t)    DJ Left Expansion
+              ;; 4. (Left v Right) v (equal lhs rhs) = t    Associativity
+              (build.associativity (build.disjoined-left-expansion line-2 (clause.clause-formula right)))
+            ;; Else we're done already
+            line-2))
+      ;; Else we know there must be a matching hyp on the right, since our guard
+      ;; requires we are a box-okp primary eqtrace.
+      ;;
+      ;; 1. nhyp-right v (equal lhs rhs) = t       Primary eqtrace nhyp bldr
+      ;; 2. Right v (equal lhs rhs) = t            Multi assoc expansion.
+      (let* ((nhyp-right (rw.find-nhyp-for-primary-eqtracep right x))
+             (line-1 (rw.primary-eqtrace-nhyp-bldr nhyp-right x))
+             (line-2 (build.multi-assoc-expansion line-1 (logic.term-list-formulas right))))
+        (if left
+            ;; 3. Left v (Right v (equal lhs rhs) = t)    Expansion
+            ;; 4. (Left v Right) v (equal lhs rhs) = t    Associativity
+            (build.associativity
+             (build.expansion (clause.clause-formula left) line-2))
+          ;; Else we're done already.
+          line-2)))))
+
+(defobligations rw.primary-eqtrace-bldr
+  (rw.primary-eqtrace-nhyp-bldr
+   build.multi-assoc-expansion
+   build.disjoined-left-expansion))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.primary-eqtrace-bldr
+                           rw.primary-eqtrace-okp
+                           rw.hypbox-formula
+                           rw.eqtrace-formula
+                           )))
+
+ (defthm rw.primary-eqtrace-bldr-under-iff
+   (iff (rw.primary-eqtrace-bldr x box)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.primary-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.primary-eqtrace-okp x box)))
+            (equal (logic.appealp (rw.primary-eqtrace-bldr x box))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.primary-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.primary-eqtrace-okp x box)))
+            (equal (logic.conclusion (rw.primary-eqtrace-bldr x box))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.primary-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.primary-eqtrace-okp x box)
+                        ;; ---
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (rw.hypbox-atblp box atbl)
+                        (@obligations rw.primary-eqtrace-bldr)))
+            (equal (logic.proofp (rw.primary-eqtrace-bldr x box) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.primary-eqtrace-bldr))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/primary-eqtrace.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/primary-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/primary-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/primary-eqtrace.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,200 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(definlined rw.primary-eqtrace (okp nhyp)
+  ;; We try to assume lhs = rhs from an nhyp of one of the following forms:
+  ;;   -- (not* (equal lhs rhs))
+  ;;   -- (not* (equal rhs lhs))
+  ;; This is only useful if lhs and rhs are distinct.  Otherwise, we would
+  ;; just be assuming lhs = lhs, which is not very informative.
+  ;;
+  ;; We only try to build the trace when okp is true.  This allows us to
+  ;; turn off trace construction easily, at a high level, without adding
+  ;; case splits.
+  (declare (xargs :guard (and (booleanp okp)
+                              (logic.termp nhyp))))
+  (and okp
+       (clause.negative-termp nhyp)
+       (let ((guts (clause.negative-term-guts nhyp)))
+         (and (logic.functionp guts)
+              (equal (logic.function-name guts) 'equal)
+              (let ((args (logic.function-args guts)))
+                (and (equal (len args) 2)
+                     (let ((lhs (first args))
+                           (rhs (second args)))
+                       (cond ((logic.term-< lhs rhs)
+                              (rw.eqtrace 'primary nil lhs rhs nil))
+                             ((logic.term-< rhs lhs)
+                              (rw.eqtrace 'primary nil rhs lhs nil))
+                             (t
+                              nil)))))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.primary-eqtrace)))
+
+ (defthm forcing-rw.eqtrace->method-of-rw.primary-eqtrace
+   (implies (force (rw.primary-eqtrace okp nhyp))
+            (equal (rw.eqtrace->method (rw.primary-eqtrace okp nhyp))
+                   'primary)))
+
+ (defthm forcing-rw.eqtrace->iffp-of-rw.primary-eqtrace
+   (implies (force (rw.primary-eqtrace okp nhyp))
+            (equal (rw.eqtrace->iffp (rw.primary-eqtrace okp nhyp))
+                   nil)))
+
+ (defthm forcing-rw.eqtrace->subtraces-of-rw.primary-eqtrace
+   (implies (force (rw.primary-eqtrace okp nhyp))
+            (equal (rw.eqtrace->subtraces (rw.primary-eqtrace okp nhyp))
+                   nil)))
+
+ (defthm forcing-rw.eqtracep-of-rw.primary-eqtrace
+   (implies (force (and (rw.primary-eqtrace okp nhyp)
+                        (logic.termp nhyp)))
+            (equal (rw.eqtracep (rw.primary-eqtrace okp nhyp))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.primary-eqtrace
+   (implies (force (and (rw.primary-eqtrace okp nhyp)
+                        (logic.termp nhyp)
+                        (logic.term-atblp nhyp atbl)))
+            (equal (rw.eqtrace-atblp (rw.primary-eqtrace okp nhyp) atbl)
+                   t)))
+
+ (defthm rw.primary-eqtrace-normalize-okp-1
+   (implies (and (rw.primary-eqtrace okp nhyp)
+                 (syntaxp (not (equal okp ''t))))
+            (equal (rw.primary-eqtrace okp nhyp)
+                   (rw.primary-eqtrace t nhyp))))
+
+ (defthm rw.primary-eqtrace-normalize-okp-2
+   (implies (not (rw.primary-eqtrace t nhyp))
+            (equal (rw.primary-eqtrace okp nhyp)
+                   nil)))
+
+ (defthm rw.primary-eqtrace-normalize-okp-3
+   (equal (rw.primary-eqtrace nil nhyp)
+          nil)))
+
+
+
+
+(defund rw.find-nhyp-for-primary-eqtracep (nhyps x)
+  ;; Find the first nhyp in a list that would generate this primary eqtrace.
+  (declare (xargs :guard (and (logic.term-listp nhyps)
+                              (rw.eqtracep x))))
+  (if (consp nhyps)
+      (if (equal (rw.primary-eqtrace t (car nhyps)) x)
+          (car nhyps)
+        (rw.find-nhyp-for-primary-eqtracep (cdr nhyps) x))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.find-nhyp-for-primary-eqtracep)))
+
+ (defthm rw.find-nhyp-for-primary-eqtracep-of-nil
+   (equal (rw.find-nhyp-for-primary-eqtracep nil x)
+          nil))
+
+ (defthm forcing-logic.termp-of-rw.find-nhyp-for-primary-eqtracep
+   (implies (force (and (rw.find-nhyp-for-primary-eqtracep nhyps x)
+                        (logic.term-listp nhyps)))
+            (equal (logic.termp (rw.find-nhyp-for-primary-eqtracep nhyps x))
+                   t)))
+
+ (defthm forcing-logic.term-atblp-of-rw.find-nhyp-for-primary-eqtracep
+   (implies (force (and (rw.find-nhyp-for-primary-eqtracep nhyps x)
+                        (logic.term-list-atblp nhyps atbl)))
+            (equal (logic.term-atblp (rw.find-nhyp-for-primary-eqtracep nhyps x) atbl)
+                   t)))
+
+ (defthm forcing-memberp-of-rw.find-nhyp-for-primary-eqtracep
+   (implies (force (rw.find-nhyp-for-primary-eqtracep nhyps x))
+            (equal (memberp (rw.find-nhyp-for-primary-eqtracep nhyps x) nhyps)
+                   t)))
+
+ (defthm forcing-rw.primary-eqtrace-of-rw.find-nhyp-for-primary-eqtracep
+   (implies (force (rw.find-nhyp-for-primary-eqtracep nhyps x))
+            (equal (rw.primary-eqtrace t (rw.find-nhyp-for-primary-eqtracep nhyps x))
+                   x))))
+
+
+
+
+(defund rw.primary-eqtrace-okp (x box)
+  ;; Check if any nhyp in the hypbox would generate this primary eqtrace.
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box))))
+  (and (equal (rw.eqtrace->method x) 'primary)
+       (equal (rw.eqtrace->iffp x) nil)
+       (if (or (rw.find-nhyp-for-primary-eqtracep (rw.hypbox->left box) x)
+               (rw.find-nhyp-for-primary-eqtracep (rw.hypbox->right box) x))
+           t
+         nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.primary-eqtrace-okp)))
+
+ (defthm booleanp-of-rw.primary-eqtrace-okp
+   (equal (booleanp (rw.primary-eqtrace-okp x box))
+          t))
+
+ (defthmd lemma-for-forcing-rw.primary-eqtrace-okp-rw.primary-eqtrace
+   (implies (and (memberp nhyp nhyps)
+                 (rw.primary-eqtrace okp nhyp))
+            (iff (rw.find-nhyp-for-primary-eqtracep nhyps (rw.primary-eqtrace okp nhyp))
+                 nhyp))
+   :hints(("Goal" :in-theory (enable rw.find-nhyp-for-primary-eqtracep))))
+
+
+ (defthm forcing-rw.primary-eqtrace-okp-rw.primary-eqtrace
+   (implies (force (and (rw.primary-eqtrace okp nhyp)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))))
+            (equal (rw.primary-eqtrace-okp (rw.primary-eqtrace okp nhyp) box)
+                   t))
+   :hints(("Goal" :in-theory (e/d (lemma-for-forcing-rw.primary-eqtrace-okp-rw.primary-eqtrace)
+                                  (rw.primary-eqtrace-normalize-okp-1)
+                                  )))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/secondary-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/secondary-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/secondary-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/secondary-eqtrace-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,189 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(include-book "../../clauses/basic-bldrs")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund@ rw.secondary-eqtrace-nhyp-bldr (nhyp x)
+  ;; Given an nhyp that matches a secondary eqtrace, prove:
+  ;;   nhyp != nil v (equal lhs rhs) = t
+  (declare (xargs :guard (and (logic.termp nhyp)
+                              (rw.eqtracep x)
+                              (equal (rw.secondary-eqtrace t nhyp) x))
+                  :verify-guards nil))
+  (if (equal (rw.eqtrace->lhs x) nhyp)
+      ;; The args are already in order.
+      (@derive
+       ((v (!= nhyp nil) (= nhyp nil))                (build.propositional-schema (logic.pequal nhyp ''nil)))
+       ((v (!= nhyp nil) (= (equal nhyp nil) t))      (build.disjoined-equal-from-pequal @-)))
+    ;; The args are out of order.
+    (@derive
+     ((v (!= nhyp nil) (= nhyp nil))                  (build.propositional-schema (logic.pequal nhyp ''nil)))
+     ((v (!= nhyp nil) (= nil nhyp))                  (build.disjoined-commute-pequal @-))
+     ((v (!= nhyp nil) (= (equal nil nhyp) t))        (build.disjoined-equal-from-pequal @-)))))
+
+(defobligations rw.secondary-eqtrace-nhyp-bldr
+  (build.propositional-schema
+   build.disjoined-equal-from-pequal
+   build.disjoined-commute-pequal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.secondary-eqtrace
+                           rw.secondary-eqtrace-nhyp-bldr
+                           logic.term-formula)))
+
+ (local (in-theory (disable forcing-equal-of-logic.pequal-rewrite-two
+                            forcing-equal-of-logic.pequal-rewrite
+                            forcing-equal-of-logic.por-rewrite-two
+                            forcing-equal-of-logic.por-rewrite
+                            forcing-equal-of-logic.pnot-rewrite-two
+                            forcing-equal-of-logic.pnot-rewrite)))
+
+ (defthm rw.secondary-eqtrace-nhyp-bldr-under-iff
+   (iff (rw.secondary-eqtrace-nhyp-bldr nhyp x)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.secondary-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.secondary-eqtrace t nhyp) x)))
+            (equal (logic.appealp (rw.secondary-eqtrace-nhyp-bldr nhyp x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.secondary-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.secondary-eqtrace t nhyp) x)))
+            (equal (logic.conclusion (rw.secondary-eqtrace-nhyp-bldr nhyp x))
+                   (logic.por (logic.term-formula nhyp)
+                              (logic.pequal (logic.function 'equal
+                                                            (list (rw.eqtrace->lhs x)
+                                                                  (rw.eqtrace->rhs x)))
+                                            ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.secondary-eqtrace-nhyp-bldr
+   (implies (force (and (logic.termp nhyp)
+                        (rw.eqtracep x)
+                        (equal (rw.secondary-eqtrace t nhyp) x)
+                        ;; ---
+                        (logic.term-atblp nhyp atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations rw.secondary-eqtrace-nhyp-bldr)))
+            (equal (logic.proofp (rw.secondary-eqtrace-nhyp-bldr nhyp x) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.secondary-eqtrace-nhyp-bldr))
+
+
+
+
+(defund rw.secondary-eqtrace-bldr (x box)
+  ;; Given a secondary eqtrace that is box-okp, prove
+  ;;   hypbox-formula v (equal lhs rhs) = t
+  ;;
+  ;; This is basically identical to the primary-eqtrace bldr.
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.secondary-eqtrace-okp x box))
+                  :verify-guards nil))
+  (let* ((left      (rw.hypbox->left box))
+         (right     (rw.hypbox->right box))
+         (nhyp-left (rw.find-nhyp-for-secondary-eqtracep left x)))
+    (if nhyp-left
+        (let* ((line-1 (rw.secondary-eqtrace-nhyp-bldr nhyp-left x))
+               (line-2 (build.multi-assoc-expansion line-1 (logic.term-list-formulas left))))
+          (if right
+              (build.associativity (build.disjoined-left-expansion line-2 (clause.clause-formula right)))
+            line-2))
+      (let* ((nhyp-right (rw.find-nhyp-for-secondary-eqtracep right x))
+             (line-1 (rw.secondary-eqtrace-nhyp-bldr nhyp-right x))
+             (line-2 (build.multi-assoc-expansion line-1 (logic.term-list-formulas right))))
+        (if left
+            (build.associativity (build.expansion (clause.clause-formula left) line-2))
+          line-2)))))
+
+(defobligations rw.secondary-eqtrace-bldr
+  (rw.secondary-eqtrace-nhyp-bldr
+   build.multi-assoc-expansion
+   build.disjoined-left-expansion))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.secondary-eqtrace-bldr
+                           rw.secondary-eqtrace-okp
+                           rw.hypbox-formula
+                           rw.eqtrace-formula)))
+
+ (defthm rw.secondary-eqtrace-bldr-under-iff
+   (iff (rw.secondary-eqtrace-bldr x box)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.secondary-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.secondary-eqtrace-okp x box)))
+            (equal (logic.appealp (rw.secondary-eqtrace-bldr x box))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.secondary-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.secondary-eqtrace-okp x box)))
+            (equal (logic.conclusion (rw.secondary-eqtrace-bldr x box))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.secondary-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.secondary-eqtrace-okp x box)
+                        ;; ---
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (rw.hypbox-atblp box atbl)
+                        (@obligations rw.secondary-eqtrace-bldr)))
+            (equal (logic.proofp (rw.secondary-eqtrace-bldr x box) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.secondary-eqtrace-bldr))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/secondary-eqtrace.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/secondary-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/secondary-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/secondary-eqtrace.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,204 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(definlined rw.secondary-eqtrace (okp nhyp)
+  ;; Generate a secondary eqtrace from an nhyp.  No matter what the nhyp is, we
+  ;; are assuming it is false, so we infer nhyp = nil.  We don't bother to do
+  ;; this if nhyp is nil, since nil = nil is trivially known.
+  (declare (xargs :guard (logic.termp nhyp)))
+  (and okp
+       (not (equal nhyp ''nil))
+       (if (logic.term-< ''nil nhyp)
+           (rw.eqtrace 'secondary nil ''nil nhyp nil)
+         (rw.eqtrace 'secondary nil nhyp ''nil nil))))
+
+(encapsulate
+ ()
+ (local (in-theory (e/d (rw.secondary-eqtrace)
+                        (forcing-booleanp-of-rw.eqtrace->iffp))))
+
+ (defthm forcing-rw.eqtrace->method-of-rw.secondary-eqtrace
+   (implies (force (rw.secondary-eqtrace okp nhyp))
+            (equal (rw.eqtrace->method (rw.secondary-eqtrace okp nhyp))
+                   'secondary)))
+
+ (defthm forcing-rw.eqtrace->iffp-of-rw.secondary-eqtrace
+   (implies (force (rw.secondary-eqtrace okp nhyp))
+            (equal (rw.eqtrace->iffp (rw.secondary-eqtrace okp nhyp))
+                   nil)))
+
+ (defthm forcing-rw.eqtrace->subtraces-of-rw.secondary-eqtrace
+   (implies (force (rw.secondary-eqtrace okp nhyp))
+            (equal (rw.eqtrace->subtraces (rw.secondary-eqtrace okp nhyp))
+                   nil)))
+
+ (defthm forcing-rw.eqtracep-of-rw.secondary-eqtrace
+   (implies (force (and (rw.secondary-eqtrace okp nhyp)
+                        (logic.termp nhyp)))
+            (equal (rw.eqtracep (rw.secondary-eqtrace okp nhyp))
+                   t)))
+
+ (defthm rw.secondary-eqtrace-normalize-okp-1
+   (implies (and (rw.secondary-eqtrace okp nhyp)
+                 (syntaxp (not (equal okp ''t))))
+            (equal (rw.secondary-eqtrace okp nhyp)
+                   (rw.secondary-eqtrace t nhyp))))
+
+ (defthm rw.secondary-eqtrace-normalize-okp-2
+   (implies (not (rw.secondary-eqtrace t nhyp))
+            (equal (rw.secondary-eqtrace okp nhyp)
+                   nil)))
+
+ (defthm rw.secondary-eqtrace-normalize-okp-3
+   (equal (rw.secondary-eqtrace nil nhyp)
+          nil))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.secondary-eqtrace
+   (implies (force (and (rw.secondary-eqtrace okp nhyp)
+                        (logic.term-atblp nhyp atbl)))
+            (equal (rw.eqtrace-atblp (rw.secondary-eqtrace okp nhyp) atbl)
+                   t))))
+
+
+
+
+
+(defund rw.find-nhyp-for-secondary-eqtracep (nhyps x)
+  ;; Find the first nhyp in a list that would generate this secondary eqtrace.
+  (declare (xargs :guard (and (logic.term-listp nhyps)
+                              (rw.eqtracep x))))
+  (if (consp nhyps)
+      (if (equal (rw.secondary-eqtrace t (car nhyps)) x)
+          (car nhyps)
+        (rw.find-nhyp-for-secondary-eqtracep (cdr nhyps) x))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.find-nhyp-for-secondary-eqtracep)))
+
+ (defthm rw.find-nhyp-for-secondary-eqtracep-of-nil
+   (equal (rw.find-nhyp-for-secondary-eqtracep nil x)
+          nil))
+
+ (defthm forcing-logic.termp-of-rw.find-nhyp-for-secondary-eqtracep
+   (implies (force (and (rw.find-nhyp-for-secondary-eqtracep nhyps x)
+                        (logic.term-listp nhyps)))
+            (equal (logic.termp (rw.find-nhyp-for-secondary-eqtracep nhyps x))
+                   t)))
+
+ (defthm forcing-logic.term-atblp-of-rw.find-nhyp-for-secondary-eqtracep
+   (implies (force (and (rw.find-nhyp-for-secondary-eqtracep nhyps x)
+                        (logic.term-list-atblp nhyps atbl)))
+            (equal (logic.term-atblp (rw.find-nhyp-for-secondary-eqtracep nhyps x) atbl)
+                   t)))
+
+ (defthm forcing-memberp-of-rw.find-nhyp-for-secondary-eqtracep
+   (implies (force (rw.find-nhyp-for-secondary-eqtracep nhyps x))
+            (equal (memberp (rw.find-nhyp-for-secondary-eqtracep nhyps x) nhyps)
+                   t)))
+
+ (defthm forcing-rw.secondary-eqtrace-of-rw.find-nhyp-for-secondary-eqtracep
+   (implies (force (rw.find-nhyp-for-secondary-eqtracep nhyps x))
+            (equal (rw.secondary-eqtrace t (rw.find-nhyp-for-secondary-eqtracep nhyps x))
+                   x))))
+
+
+
+
+
+(defund rw.secondary-eqtrace-okp (x box)
+  ;; Check if any nhyp in the hypbox would generate this secondary eqtrace.
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box))))
+  (and (equal (rw.eqtrace->method x) 'secondary)
+       (equal (rw.eqtrace->iffp x) nil)
+       (if (or (rw.find-nhyp-for-secondary-eqtracep (rw.hypbox->left box) x)
+               (rw.find-nhyp-for-secondary-eqtracep (rw.hypbox->right box) x))
+           t
+         nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.secondary-eqtrace-okp)))
+
+ (defthm booleanp-of-rw.secondary-eqtrace-okp
+   (equal (booleanp (rw.secondary-eqtrace-okp x box))
+          t))
+
+ (defthmd lemma-1-for-forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace
+   (implies (and (logic.termp a)
+                 (logic.termp b))
+            (equal (equal (rw.secondary-eqtrace okp a)
+                          (rw.secondary-eqtrace okp b))
+                   (if okp
+                       (equal a b)
+                     t)))
+   :hints(("Goal" :in-theory (enable rw.secondary-eqtrace rw.eqtrace))))
+
+ (defthmd lemma-2-for-forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace
+   (implies (and (logic.termp nhyp)
+                 (logic.term-listp nhyps)
+                 (memberp nhyp nhyps)
+                 (rw.secondary-eqtrace okp nhyp))
+            (iff (rw.find-nhyp-for-secondary-eqtracep nhyps (rw.secondary-eqtrace okp nhyp))
+                 t))
+   :hints(("Goal"
+           :in-theory (e/d (rw.find-nhyp-for-secondary-eqtracep)
+                           ((:e rw.secondary-eqtrace)))
+           :induct (cdr-induction nhyps))))
+
+(defthm forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace
+   (implies (force (and (rw.secondary-eqtrace okp nhyp)
+                        (rw.hypboxp box)
+                        (or (memberp nhyp (rw.hypbox->left box))
+                            (memberp nhyp (rw.hypbox->right box)))))
+            (equal (rw.secondary-eqtrace-okp (rw.secondary-eqtrace okp nhyp) box)
+                   t))
+   :hints(("Goal"
+           :in-theory (e/d (lemma-1-for-forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace
+                            lemma-2-for-forcing-rw.secondary-eqtrace-okp-rw.secondary-eqtrace)
+                           (rw.secondary-eqtrace-normalize-okp-1))
+           ))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/top.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/top.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/top.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,230 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "assmsp")
+(include-book "contradiction-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; BOZO move this stuff to eqdatabasep.
+
+(defthm forcing-rw.eqset-okp-when-empty-box
+  (implies (and (not (rw.hypbox->left box))
+                (not (rw.hypbox->right box))
+                (force (rw.eqsetp x)))
+           (equal (rw.eqset-okp x box)
+                  nil))
+  :hints(("Goal" :in-theory (e/d (rw.eqset-okp rw.eqsetp)
+                                 ((:e acl2::force))))))
+
+(defthm forcing-rw.eqset-list-okp-when-empty-box
+  (implies (and (not (rw.hypbox->left box))
+                (not (rw.hypbox->right box))
+                (force (rw.eqset-listp x)))
+           (equal (rw.eqset-list-okp x box)
+                  (not (consp x))))
+  :hints(("Goal" :in-theory (enable rw.eqset-list-okp))))
+
+(defthm forcing-rw.eqdatabase-okp-when-empty-box
+  (implies (and (not (rw.hypbox->left box))
+                (not (rw.hypbox->right box))
+                (force (rw.eqdatabasep eqdatabase)))
+           (equal (rw.eqdatabase-okp eqdatabase box)
+                  (and (not (consp (rw.eqdatabase->equalsets eqdatabase)))
+                       (not (consp (rw.eqdatabase->iffsets eqdatabase)))
+                       (not (rw.eqdatabase->contradiction eqdatabase)))))
+  :hints(("Goal" :in-theory (enable rw.eqdatabasep
+                                    rw.eqdatabase-okp
+                                    rw.eqdatabase->equalsets
+                                    rw.eqdatabase->contradiction))))
+
+(defthm rw.eqrow-list-lookup-when-not-consp
+  (implies (not (consp eqsets))
+           (equal (rw.eqset-list-lookup term eqsets)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.eqset-list-lookup))))
+
+(defthm forcing-rw.try-equalities-when-empty-box
+  (implies (and (not (rw.hypbox->left box))
+                (not (rw.hypbox->right box))
+                (force (rw.eqdatabasep eqdatabase))
+                (force (rw.eqdatabase-okp eqdatabase box)))
+           (equal (rw.try-equiv-database term eqdatabase iffp)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.try-equiv-database))))
+
+
+
+
+
+
+;; USING ASSUMPTIONS.
+
+(definlined rw.try-assms (assms term iffp)
+  (declare (xargs :guard (and (rw.assmsp assms)
+                              (logic.termp term)
+                              (booleanp iffp))))
+
+  ;; When I originally designed this, I was expecting the iff database to always
+  ;; be better than the equal database, because of weakening traces, etc.  But now,
+  ;; since you can turn on/off various kinds of traces, it might be the case that
+  ;; direct/negative traces are both off, in which case we are only building equal
+  ;; traces.  Then, I don't want to look in the iff database even if iffp is true,
+  ;; because it will be empty.  Instead, look only in the equal database, which is
+  ;; sound since we can weaken it afterwards.
+
+  (let* ((iffp (and iffp
+                    (let ((ctrl (rw.assms->ctrl assms)))
+                      (or (rw.assmctrl->directp ctrl)
+                          (rw.assmctrl->negativep ctrl)))))
+         (eqtrace (rw.try-equiv-database term (rw.assms->eqdatabase assms) iffp)))
+    (and eqtrace
+         ;; The trace has the form term' = term, so we want the left hand side.
+         (rw.eqtrace->lhs eqtrace))))
+
+(defthm forcing-logic.termp-of-rw.try-assms
+  (implies (and (rw.try-assms assms term iffp)
+                (force (logic.termp term))
+                (force (rw.assmsp assms)))
+           (equal (logic.termp (rw.try-assms assms term iffp))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.try-assms))))
+
+(defthm forcing-logic.term-atblp-of-rw.try-assms
+  (implies (and (rw.try-assms assms term iffp)
+                (force (logic.term-atblp term atbl))
+                (force (rw.assms-atblp assms atbl)))
+           (equal (logic.term-atblp (rw.try-assms assms term iffp) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.try-assms))))
+
+(defthm forcing-rw.try-assms-when-empty-hypbox
+  (implies (and (not (rw.hypbox->left (rw.assms->hypbox assms)))
+                (not (rw.hypbox->right (rw.assms->hypbox assms)))
+                (force (rw.assmsp assms)))
+           (equal (rw.try-assms assms term iffp)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.try-assms
+                                    rw.assmsp
+                                    rw.assms->eqdatabase
+                                    rw.assms->hypbox))))
+
+
+
+
+(defund rw.try-assms-bldr (assms term iffp)
+  (declare (xargs :guard (and (rw.assmsp assms)
+                              (logic.termp term)
+                              (booleanp iffp)
+                              (rw.try-assms assms term iffp))
+                  :verify-guards nil))
+  (let* ((new-iffp (and iffp
+                        (let ((ctrl (rw.assms->ctrl assms)))
+                          (or (rw.assmctrl->directp ctrl)
+                              (rw.assmctrl->negativep ctrl)))))
+         (eqtrace (rw.try-equiv-database term (rw.assms->eqdatabase assms) new-iffp)))
+    (and eqtrace
+         (cond ((and new-iffp iffp)
+                ;; Case 1.  We really did look in the iff database, and we wanted
+                ;; to find an iff trace there.
+                ;; 1. hypbox v (iff term' term) = t         Eqtrace Builder
+                ;; 2. hypbox v (iff term term') = t         DJ Commute Equal
+                (build.disjoined-commute-iff
+                 (rw.eqtrace-bldr eqtrace (rw.assms->hypbox assms))))
+               (iffp
+                ;; Case 2. We want an iff-trace, but we actually looked in the
+                ;; equal database (because iff is disabled in this assms structure).
+                ;; Now, get the eqtrace and weaken it.
+                ;; 1. hypbox v (equal term' term) = t       Eqtrace Builder
+                ;; 2. hypbox v (equal term term') = t       DJ Commute Equal
+                ;; 3. hypbox v (iff term term') = t         DJ IFF from Equal
+                (build.disjoined-iff-from-equal
+                 (build.disjoined-commute-equal
+                  (rw.eqtrace-bldr eqtrace (rw.assms->hypbox assms)))))
+               (t
+                ;; Case 3. We want an equal trace and got one.
+                ;; 1. hypbox v (equal term' term) = t       Eqtrace Builder
+                ;; 2. hypbox v (equal term term') = t       DJ Commute Equal
+                (build.disjoined-commute-equal
+                 (rw.eqtrace-bldr eqtrace (rw.assms->hypbox assms))))))))
+
+(defobligations rw.try-assms-bldr
+  (rw.eqtrace-bldr
+   build.disjoined-commute-iff
+   build.disjoined-commute-equal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.try-assms
+                           rw.try-assms-bldr
+                           rw.eqtrace-formula)))
+
+ (verify-guards rw.try-assms-bldr)
+
+ (defthm forcing-logic.appealp-of-rw.try-assms-bldr
+   (implies (force (and (rw.try-assms assms term iffp)
+                        (logic.termp term)
+                        (rw.assmsp assms)))
+            (equal (logic.appealp (rw.try-assms-bldr assms term iffp))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.try-assms-bldr
+   (implies (force (and (rw.try-assms assms term iffp)
+                        (logic.termp term)
+                        (rw.assmsp assms)))
+            (equal (logic.conclusion (rw.try-assms-bldr assms term iffp))
+                   (logic.por (rw.hypbox-formula (rw.assms->hypbox assms))
+                              (logic.pequal (logic.function (if iffp 'iff 'equal)
+                                                            (list term (rw.try-assms assms term iffp)))
+                                            ''t))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.try-assms-bldr
+   (implies (force (and (rw.try-assms assms term iffp)
+                        (logic.termp term)
+                        (rw.assmsp assms)
+                        ;; ---
+                        (rw.assms-atblp assms atbl)
+                        (logic.term-atblp term atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations rw.try-assms-bldr)))
+            (equal (logic.proofp (rw.try-assms-bldr assms term iffp) axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/trans1-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/trans1-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/trans1-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/trans1-eqtrace-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,140 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtrace-okp")
+(include-book "transitivity-eqtraces")
+(include-book "../../clauses/basic-bldrs")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund rw.trans1-eqtrace-bldr (x box proofs)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.trans1-eqtrace-okp x)
+                              (rw.eqtrace-okp x box)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box)))
+                  :verify-guards nil)
+           (ignore box))
+  (if (rw.eqtrace->iffp x)
+      (let ((proof1 (if (rw.eqtrace->iffp (first (rw.eqtrace->subtraces x)))
+                        (first proofs)
+                      (build.disjoined-iff-from-equal (first proofs))))
+            (proof2 (if (rw.eqtrace->iffp (second (rw.eqtrace->subtraces x)))
+                        (second proofs)
+                      (build.disjoined-iff-from-equal (second proofs)))))
+        (build.disjoined-transitivity-of-iff proof1 proof2))
+    (build.disjoined-transitivity-of-equal (first proofs) (second proofs))))
+
+(defobligations rw.trans1-eqtrace-bldr
+  (build.disjoined-iff-from-equal
+   build.disjoined-transitivity-of-equal
+   build.disjoined-transitivity-of-iff))
+
+(defthmd lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+  (implies (and (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list x box))
+                (force (consp x)))
+           (equal (logic.conclusion (car proofs))
+                  (rw.eqtrace-formula (car x) box))))
+
+(defthmd lemma-2-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+  (implies (and (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list x box))
+                (force (consp (cdr x))))
+           (equal (logic.conclusion (second proofs))
+                  (rw.eqtrace-formula (second x) box))))
+
+(defthmd lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+  (implies (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list x box))
+           (equal (consp proofs)
+                  (consp x))))
+
+(defthmd lemma-4-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+  (implies (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list x box))
+           (equal (consp (cdr proofs))
+                  (consp (cdr x)))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-formula
+                           rw.trans1-eqtrace-bldr
+                           rw.trans1-eqtrace-okp
+                           lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-2-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-4-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr)))
+
+ (defthm forcing-rw.trans1-eqtrace-bldr-under-iff
+   (iff (rw.trans1-eqtrace-bldr x box proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans1-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.appealp (rw.trans1-eqtrace-bldr x box proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.trans1-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans1-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.conclusion (rw.trans1-eqtrace-bldr x box proofs))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.trans1-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans1-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))
+                        ;; ---
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.trans1-eqtrace-bldr)))
+            (equal (logic.proofp (rw.trans1-eqtrace-bldr x box proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.trans1-eqtrace-bldr))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/trans2-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/trans2-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/trans2-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/trans2-eqtrace-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,120 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trans1-eqtrace-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund rw.trans2-eqtrace-bldr (x box proofs)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.trans2-eqtrace-okp x)
+                              (rw.eqtrace-okp x box)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box)))
+                  :verify-guards nil)
+           (ignore box))
+  (if (rw.eqtrace->iffp x)
+      (let ((proof1 (if (rw.eqtrace->iffp (first (rw.eqtrace->subtraces x)))
+                        (first proofs)
+                      (build.disjoined-iff-from-equal (first proofs))))
+            (proof2 (if (rw.eqtrace->iffp (second (rw.eqtrace->subtraces x)))
+                        (second proofs)
+                      (build.disjoined-iff-from-equal (second proofs)))))
+        (build.disjoined-transitivity-of-iff (build.disjoined-commute-iff proof1)
+                                             proof2))
+    (build.disjoined-transitivity-of-equal (build.disjoined-commute-equal (first proofs))
+                                           (second proofs))))
+
+(defobligations rw.trans2-eqtrace-bldr
+  (build.disjoined-iff-from-equal
+   build.disjoined-transitivity-of-equal
+   build.disjoined-transitivity-of-iff
+   build.disjoined-commute-equal
+   build.disjoined-commute-iff))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-formula
+                           rw.trans2-eqtrace-bldr
+                           rw.trans2-eqtrace-okp
+                           lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-2-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-4-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr)))
+
+ (defthm rw.trans2-eqtrace-bldr-under-iff
+   (iff (rw.trans2-eqtrace-bldr x box proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.trans2-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans2-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.appealp (rw.trans2-eqtrace-bldr x box proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.trans2-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans2-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.conclusion (rw.trans2-eqtrace-bldr x box proofs))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.trans2-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans2-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))
+                        ;; ---
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.trans2-eqtrace-bldr)))
+            (equal (logic.proofp (rw.trans2-eqtrace-bldr x box proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.trans2-eqtrace-bldr))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/trans3-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/trans3-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/trans3-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/trans3-eqtrace-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,119 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trans1-eqtrace-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund rw.trans3-eqtrace-bldr (x box proofs)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.trans3-eqtrace-okp x)
+                              (rw.eqtrace-okp x box)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box)))
+                  :verify-guards nil)
+           (ignore box))
+  (if (rw.eqtrace->iffp x)
+      (let ((proof1 (if (rw.eqtrace->iffp (first (rw.eqtrace->subtraces x)))
+                        (first proofs)
+                      (build.disjoined-iff-from-equal (first proofs))))
+            (proof2 (if (rw.eqtrace->iffp (second (rw.eqtrace->subtraces x)))
+                        (second proofs)
+                      (build.disjoined-iff-from-equal (second proofs)))))
+        (build.disjoined-transitivity-of-iff proof1 (build.disjoined-commute-iff proof2)))
+    (build.disjoined-transitivity-of-equal (first proofs)
+                                           (build.disjoined-commute-equal (second proofs)))))
+
+(defobligations rw.trans3-eqtrace-bldr
+  (build.disjoined-iff-from-equal
+   build.disjoined-transitivity-of-equal
+   build.disjoined-transitivity-of-iff
+   build.disjoined-commute-equal
+   build.disjoined-commute-iff))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-formula
+                           rw.trans3-eqtrace-bldr
+                           rw.trans3-eqtrace-okp
+                           lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-2-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-4-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr)))
+
+ (defthm rw.trans3-eqtrace-bldr-under-iff
+   (iff (rw.trans3-eqtrace-bldr x box proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.trans3-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans3-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.appealp (rw.trans3-eqtrace-bldr x box proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.trans3-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans3-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.conclusion (rw.trans3-eqtrace-bldr x box proofs))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.trans3-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.trans3-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))
+                        ;; ---
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.trans3-eqtrace-bldr)))
+            (equal (logic.proofp (rw.trans3-eqtrace-bldr x box proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.trans3-eqtrace-bldr))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/transitivity-eqtraces.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/transitivity-eqtraces.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/transitivity-eqtraces.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/transitivity-eqtraces.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,389 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(definlined rw.trans1-eqtrace-okp (x)
+  ;; A equiv B, B equiv C --> A equiv C
+  (declare (xargs :guard (rw.eqtracep x)))
+  (let ((method    (rw.eqtrace->method x))
+        (iffp      (rw.eqtrace->iffp x))
+        (lhs       (rw.eqtrace->lhs x))
+        (rhs       (rw.eqtrace->rhs x))
+        (subtraces (rw.eqtrace->subtraces x)))
+    (and (equal method 'trans1)
+         (equal (len subtraces) 2)
+         (let* ((sub1 (first subtraces))
+                (sub2 (second subtraces)))
+           (and (equal lhs (rw.eqtrace->lhs sub1))
+                (equal (rw.eqtrace->rhs sub1) (rw.eqtrace->lhs sub2))
+                (equal rhs (rw.eqtrace->rhs sub2))
+                (implies (not iffp)
+                         (and (not (rw.eqtrace->iffp sub1))
+                              (not (rw.eqtrace->iffp sub2)))))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.trans1-eqtrace-okp)))
+
+ (defthm booleanp-of-rw.trans1-eqtrace-okp
+   (equal (booleanp (rw.trans1-eqtrace-okp x))
+          t))
+
+ (defthm rw.eqtrace->rhs-of-sub1-when-rw.trans1-eqtrace-okp
+   (implies (rw.trans1-eqtrace-okp x)
+            (equal (rw.eqtrace->rhs (first (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->lhs (second (rw.eqtrace->subtraces x))))))
+
+ (defthm rw.eqtrace->lhs-of-sub1-when-rw.trans1-eqtrace-okp
+   (implies (rw.trans1-eqtrace-okp x)
+            (equal (rw.eqtrace->lhs (first (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->lhs x))))
+
+ (defthm rw.eqtrace->rhs-of-sub2-when-rw.trans1-eqtrace-okp
+   (implies (rw.trans1-eqtrace-okp x)
+            (equal (rw.eqtrace->rhs (second (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->rhs x)))))
+
+
+
+(definlined rw.trans1-eqtrace (iffp x y)
+  (declare (xargs :guard (and (booleanp iffp)
+                              (rw.eqtracep x)
+                              (rw.eqtracep y)
+                              (equal (rw.eqtrace->rhs x) (rw.eqtrace->lhs y))
+                              (implies (not iffp)
+                                       (and (not (rw.eqtrace->iffp x))
+                                            (not (rw.eqtrace->iffp y)))))
+                  :verify-guards nil))
+  (rw.eqtrace 'trans1
+              iffp
+              (rw.eqtrace->lhs x)
+              (rw.eqtrace->rhs y)
+              (list x y)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.trans1-eqtrace)))
+
+ (defthmd lemma-for-forcing-rw.eqtracep-of-rw.trans1-eqtrace
+   (implies (and (rw.eqtracep x)
+                 (rw.eqtracep y)
+                 (equal (rw.eqtrace->rhs x) (rw.eqtrace->lhs y)))
+            (logic.term-< (rw.eqtrace->lhs x) (rw.eqtrace->rhs y)))
+   :hints(("Goal"
+           :in-theory (disable forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs)
+           :use ((:instance forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs (x x))
+                 (:instance forcing-logic.term-<-of-rw.eqtrace->lhs-and-rw.eqtrace->rhs (x y))))))
+
+ (local (in-theory (enable lemma-for-forcing-rw.eqtracep-of-rw.trans1-eqtrace)))
+
+ (verify-guards rw.trans1-eqtrace)
+
+ (defthm rw.eqtrace->method-of-rw.trans1-eqtrace
+   (equal (rw.eqtrace->method (rw.trans1-eqtrace iffp x y))
+          'trans1))
+
+ (defthm rw.eqtrace->iffp-of-rw.trans1-eqtrace
+   (equal (rw.eqtrace->iffp (rw.trans1-eqtrace iffp x y))
+          iffp))
+
+ (defthm rw.eqtrace->lhs-of-rw.trans1-eqtrace
+   (equal (rw.eqtrace->lhs (rw.trans1-eqtrace iffp x y))
+          (rw.eqtrace->lhs x)))
+
+ (defthm rw.eqtrace->rhs-of-rw.trans1-eqtrace
+   (equal (rw.eqtrace->rhs (rw.trans1-eqtrace iffp x y))
+          (rw.eqtrace->rhs y)))
+
+ (defthm rw.eqtrace->subtraces-of-rw.trans1-eqtrace
+   (equal (rw.eqtrace->subtraces (rw.trans1-eqtrace iffp x y))
+          (list x y)))
+
+ (defthm forcing-rw.eqtracep-of-rw.trans1-eqtrace
+   (implies (force (and (rw.eqtracep x)
+                        (rw.eqtracep y)
+                        (booleanp iffp)
+                        (equal (rw.eqtrace->rhs x) (rw.eqtrace->lhs y))))
+            (equal (rw.eqtracep (rw.trans1-eqtrace iffp x y))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.trans1-eqtrace
+   (implies (force (and (rw.eqtrace-atblp x atbl)
+                        (rw.eqtrace-atblp y atbl)))
+            (equal (rw.eqtrace-atblp (rw.trans1-eqtrace iffp x y) atbl)
+                   t)))
+
+ (defthm forcing-rw.trans1-eqtrace-okp-of-rw.trans1-eqtrace
+   (implies (force (and (equal (rw.eqtrace->rhs x) (rw.eqtrace->lhs y))
+                        (implies (not iffp)
+                                 (and (not (rw.eqtrace->iffp x))
+                                      (not (rw.eqtrace->iffp y))))))
+            (equal (rw.trans1-eqtrace-okp (rw.trans1-eqtrace iffp x y))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trans1-eqtrace-okp)))))
+
+
+
+
+(definlined rw.trans2-eqtrace-okp (x)
+  ;; A equiv B, A equiv C --> B equiv C
+  (declare (xargs :guard (rw.eqtracep x)))
+  (let ((method    (rw.eqtrace->method x))
+        (iffp      (rw.eqtrace->iffp x))
+        (lhs       (rw.eqtrace->lhs x))
+        (rhs       (rw.eqtrace->rhs x))
+        (subtraces (rw.eqtrace->subtraces x)))
+    (and (equal method 'trans2)
+         (equal (len subtraces) 2)
+         (let* ((sub1 (first subtraces))
+                (sub2 (second subtraces)))
+           (and (equal (rw.eqtrace->lhs sub1) (rw.eqtrace->lhs sub2))
+                (equal lhs (rw.eqtrace->rhs sub1))
+                (equal rhs (rw.eqtrace->rhs sub2))
+                (implies (not iffp)
+                         (and (not (rw.eqtrace->iffp sub1))
+                              (not (rw.eqtrace->iffp sub2)))))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.trans2-eqtrace-okp)))
+
+ (defthm booleanp-of-rw.trans2-eqtrace-okp
+   (equal (booleanp (rw.trans2-eqtrace-okp x))
+          t))
+
+ (defthm rw.eqtrace->lhs-of-sub1-when-rw.trans2-eqtrace-okp
+   (implies (rw.trans2-eqtrace-okp x)
+            (equal (rw.eqtrace->lhs (first (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->lhs (second (rw.eqtrace->subtraces x))))))
+
+ (defthm rw.eqtrace->rhs-of-sub1-when-rw.trans2-eqtrace-okp
+   (implies (rw.trans2-eqtrace-okp x)
+            (equal (rw.eqtrace->rhs (first (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->lhs x))))
+
+ (defthm rw.eqtrace->rhs-of-sub2-when-rw.trans2-eqtrace-okp
+   (implies (rw.trans2-eqtrace-okp x)
+            (equal (rw.eqtrace->rhs (second (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->rhs x)))))
+
+
+
+(definlined rw.trans2-eqtrace (iffp x y)
+  (declare (xargs :guard (and (booleanp iffp)
+                              (rw.eqtracep x)
+                              (rw.eqtracep y)
+                              (equal (rw.eqtrace->lhs x) (rw.eqtrace->lhs y))
+                              (logic.term-< (rw.eqtrace->rhs x) (rw.eqtrace->rhs y))
+                              (implies (not iffp)
+                                       (and (not (rw.eqtrace->iffp x))
+                                            (not (rw.eqtrace->iffp y)))))
+                  :verify-guards nil))
+  (rw.eqtrace 'trans2
+              iffp
+              (rw.eqtrace->rhs x)
+              (rw.eqtrace->rhs y)
+              (list x y)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.trans2-eqtrace)))
+
+ (verify-guards rw.trans2-eqtrace)
+
+ (defthm rw.eqtrace->method-of-rw.trans2-eqtrace
+   (equal (rw.eqtrace->method (rw.trans2-eqtrace iffp x y))
+          'trans2))
+
+ (defthm rw.eqtrace->iffp-of-rw.trans2-eqtrace
+   (equal (rw.eqtrace->iffp (rw.trans2-eqtrace iffp x y))
+          iffp))
+
+ (defthm rw.eqtrace->lhs-of-rw.trans2-eqtrace
+   (equal (rw.eqtrace->lhs (rw.trans2-eqtrace iffp x y))
+          (rw.eqtrace->rhs x)))
+
+ (defthm rw.eqtrace->rhs-of-rw.trans2-eqtrace
+   (equal (rw.eqtrace->rhs (rw.trans2-eqtrace iffp x y))
+          (rw.eqtrace->rhs y)))
+
+ (defthm rw.eqtrace->subtraces-of-rw.trans2-eqtrace
+   (equal (rw.eqtrace->subtraces (rw.trans2-eqtrace iffp x y))
+          (list x y)))
+
+ (defthm forcing-rw.eqtracep-of-rw.trans2-eqtrace
+   (implies (force (and (booleanp iffp)
+                        (rw.eqtracep x)
+                        (rw.eqtracep y)
+                        (equal (rw.eqtrace->lhs x) (rw.eqtrace->lhs y))
+                        (logic.term-< (rw.eqtrace->rhs x) (rw.eqtrace->rhs y))))
+            (equal (rw.eqtracep (rw.trans2-eqtrace iffp x y))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.trans2-eqtrace
+   (implies (force (and (rw.eqtrace-atblp x atbl)
+                        (rw.eqtrace-atblp y atbl)))
+            (equal (rw.eqtrace-atblp (rw.trans2-eqtrace iffp x y) atbl)
+                   t)))
+
+ (defthm forcing-rw.trans2-eqtrace-okp-of-rw.trans2-eqtrace
+   (implies (force (and (equal (rw.eqtrace->lhs x) (rw.eqtrace->lhs y))
+                        (implies (not iffp)
+                                 (and (not (rw.eqtrace->iffp x))
+                                      (not (rw.eqtrace->iffp y))))))
+            (equal (rw.trans2-eqtrace-okp (rw.trans2-eqtrace iffp x y))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trans2-eqtrace-okp)))))
+
+
+
+
+
+(definlined rw.trans3-eqtrace-okp (x)
+  ;; A equiv C, B equiv C --> A equiv B
+  (declare (xargs :guard (rw.eqtracep x)))
+  (let ((method    (rw.eqtrace->method x))
+        (iffp      (rw.eqtrace->iffp x))
+        (lhs       (rw.eqtrace->lhs x))
+        (rhs       (rw.eqtrace->rhs x))
+        (subtraces (rw.eqtrace->subtraces x)))
+    (and (equal method 'trans3)
+         (equal (len subtraces) 2)
+         (let* ((sub1 (first subtraces))
+                (sub2 (second subtraces)))
+           (and (equal lhs (rw.eqtrace->lhs sub1))
+                (equal rhs (rw.eqtrace->lhs sub2))
+                (equal (rw.eqtrace->rhs sub1) (rw.eqtrace->rhs sub2))
+                (implies (not iffp)
+                         (and (not (rw.eqtrace->iffp sub1))
+                              (not (rw.eqtrace->iffp sub2)))))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.trans3-eqtrace-okp)))
+
+ (defthm booleanp-of-rw.trans3-eqtrace-okp
+   (equal (booleanp (rw.trans3-eqtrace-okp x))
+          t))
+
+ (defthm rw.eqtrace->rhs-of-sub1-when-rw.trans3-eqtrace-okp
+   (implies (rw.trans3-eqtrace-okp x)
+            (equal (rw.eqtrace->rhs (first (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->rhs (second (rw.eqtrace->subtraces x))))))
+
+ (defthm rw.eqtrace->lhs-of-sub1-when-rw.trans3-eqtrace-okp
+   (implies (rw.trans3-eqtrace-okp x)
+            (equal (rw.eqtrace->lhs (first (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->lhs x))))
+
+ (defthm rw.eqtrace->lhs-of-sub2-when-rw.trans3-eqtrace-okp
+   (implies (rw.trans3-eqtrace-okp x)
+            (equal (rw.eqtrace->lhs (second (rw.eqtrace->subtraces x)))
+                   (rw.eqtrace->rhs x)))))
+
+
+
+(definlined rw.trans3-eqtrace (iffp x y)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.eqtracep y)
+                              (booleanp iffp)
+                              (equal (rw.eqtrace->rhs x) (rw.eqtrace->rhs y))
+                              (logic.term-< (rw.eqtrace->lhs x) (rw.eqtrace->lhs y))
+                              (implies (not iffp)
+                                       (and (not (rw.eqtrace->iffp x))
+                                            (not (rw.eqtrace->iffp y)))))
+                  :verify-guards nil))
+  (rw.eqtrace 'trans3
+              iffp
+              (rw.eqtrace->lhs x)
+              (rw.eqtrace->lhs y)
+              (list x y)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.trans3-eqtrace)))
+
+ (verify-guards rw.trans3-eqtrace)
+
+ (defthm rw.eqtrace->method-of-rw.trans3-eqtrace
+   (equal (rw.eqtrace->method (rw.trans3-eqtrace iffp x y))
+          'trans3))
+
+ (defthm rw.eqtrace->iffp-of-rw.trans3-eqtrace
+   (equal (rw.eqtrace->iffp (rw.trans3-eqtrace iffp x y))
+          iffp))
+
+ (defthm rw.eqtrace->lhs-of-rw.trans3-eqtrace
+   (equal (rw.eqtrace->lhs (rw.trans3-eqtrace iffp x y))
+          (rw.eqtrace->lhs x)))
+
+ (defthm rw.eqtrace->rhs-of-rw.trans3-eqtrace
+   (equal (rw.eqtrace->rhs (rw.trans3-eqtrace iffp x y))
+          (rw.eqtrace->lhs y)))
+
+ (defthm rw.eqtrace->subtraces-of-rw.trans3-eqtrace
+   (equal (rw.eqtrace->subtraces (rw.trans3-eqtrace iffp x y))
+          (list x y)))
+
+ (defthm forcing-rw.eqtracep-of-rw.trans3-eqtrace
+   (implies (force (and (booleanp iffp)
+                        (rw.eqtracep x)
+                        (rw.eqtracep y)
+                        (equal (rw.eqtrace->rhs x) (rw.eqtrace->rhs y))
+                        (logic.term-< (rw.eqtrace->lhs x) (rw.eqtrace->lhs y))))
+            (equal (rw.eqtracep (rw.trans3-eqtrace iffp x y))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.trans3-eqtrace
+   (implies (force (and (rw.eqtrace-atblp x atbl)
+                        (rw.eqtrace-atblp y atbl)))
+            (equal (rw.eqtrace-atblp (rw.trans3-eqtrace iffp x y) atbl)
+                   t)))
+
+ (defthm forcing-rw.trans3-eqtrace-okp-of-rw.trans3-eqtrace
+   (implies (force (and (equal (rw.eqtrace->rhs x) (rw.eqtrace->rhs y))
+                        (implies (not iffp)
+                                 (and (not (rw.eqtrace->iffp x))
+                                      (not (rw.eqtrace->iffp y))))))
+            (equal (rw.trans3-eqtrace-okp (rw.trans3-eqtrace iffp x y))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trans3-eqtrace-okp)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/try-equiv-database.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/try-equiv-database.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/try-equiv-database.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/try-equiv-database.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,367 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqdatabasep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund rw.eqtrace-list-lookup (term eqtraces)
+  ;; Find the first eqtrace whose rhs is term.
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.eqtrace-listp eqtraces))))
+  (if (consp eqtraces)
+      (if (equal term (rw.eqtrace->rhs (car eqtraces)))
+          (car eqtraces)
+        (rw.eqtrace-list-lookup term (cdr eqtraces)))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-list-lookup)))
+
+ (defthm forcing-rw.eqtrace-list-lookup-under-iff
+   (implies (force (rw.eqtrace-listp eqtraces))
+            (iff (rw.eqtrace-list-lookup x eqtraces)
+                 (memberp x (rw.eqtrace-list-rhses eqtraces)))))
+
+ (local (in-theory (disable forcing-rw.eqtrace-list-lookup-under-iff)))
+
+ (defthm forcing-rw.eqtracep-of-rw.eqtrace-list-lookup
+   (implies (force (and (rw.eqtrace-list-lookup term eqtraces)
+                        (rw.eqtrace-listp eqtraces)))
+            (equal (rw.eqtracep (rw.eqtrace-list-lookup term eqtraces))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.eqtrace-list-lookup
+   (implies (force (and (rw.eqtrace-list-lookup term eqtraces)
+                        (rw.eqtrace-list-atblp eqtraces atbl)))
+            (equal (rw.eqtrace-atblp (rw.eqtrace-list-lookup term eqtraces) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.eqtrace-list-lookup
+   (implies (force (and (rw.eqtrace-list-lookup term eqtraces)
+                        (rw.eqtrace-list-okp eqtraces box)))
+            (equal (rw.eqtrace-okp (rw.eqtrace-list-lookup term eqtraces) box)
+                   t)))
+
+ (defthm forcing-memberp-of-rw.eqtrace-list-lookup
+   (implies (force (rw.eqtrace-list-lookup term eqtraces))
+            (equal (memberp (rw.eqtrace-list-lookup term eqtraces) eqtraces)
+                   t)))
+
+ (defthm forcing-eqtrace->rhs-of-rw.eqtrace-list-lookup
+   (implies (force (rw.eqtrace-list-lookup term eqtraces))
+            (equal (rw.eqtrace->rhs (rw.eqtrace-list-lookup term eqtraces))
+                   term)))
+
+ (defthm rw.eqtrace->lhs-of-rw.eqtrace-list-lookup-when-all-equalp
+   (implies (and (all-equalp lhs (rw.eqtrace-list-lhses x))
+                 (force (rw.eqtrace-list-lookup a x)))
+            (equal (rw.eqtrace->lhs (rw.eqtrace-list-lookup a x))
+                   lhs))))
+
+(defthm forcing-rw.eqtrace->iffp-of-rw.eqtrace-list-lookup-in-rw.eqset->tail
+   (implies (and (rw.eqtrace-list-lookup term (rw.eqset->tail eqset))
+                 (force (rw.eqsetp eqset)))
+            (equal (rw.eqtrace->iffp (rw.eqtrace-list-lookup term (rw.eqset->tail eqset)))
+                   (rw.eqset->iffp eqset)))
+   :hints(("Goal"
+           :in-theory (disable rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps
+                               rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps-alt)
+           :use ((:instance rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps
+                            (a    (rw.eqtrace-list-lookup term (rw.eqset->tail eqset)))
+                            (x    (rw.eqset->tail eqset))
+                            (iffp (rw.eqset->iffp eqset)))))))
+
+(defthm forcing-rw.eqtrace->lhs-of-rw.eqtrace-list-lookup-in-rw.eqset->tail
+   (implies (and (rw.eqtrace-list-lookup term (rw.eqset->tail eqset))
+                 (force (rw.eqsetp eqset)))
+            (equal (rw.eqtrace->lhs (rw.eqtrace-list-lookup term (rw.eqset->tail eqset)))
+                   (rw.eqset->head eqset)))
+   :hints(("Goal"
+           :in-theory (disable rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses
+                               rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses-alt)
+           :use ((:instance rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses
+                            (a    (rw.eqtrace-list-lookup term (rw.eqset->tail eqset)))
+                            (x    (rw.eqset->tail eqset))
+                            (lhs  (rw.eqset->head eqset)))))))
+
+
+
+
+(definlined rw.eqset-lookup (term eqset)
+  ;; Find the relevant eqtrace from an eqset.
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.eqsetp eqset))
+                  :guard-hints (("Goal" :in-theory (enable rw.eqsetp)))))
+  (if (logic.term-< term (rw.eqset->head eqset))
+      ;; Optimization: we don't bother looking if term < head, since head < rhs
+      ;; for every rhs in the tail.
+      nil
+    (rw.eqtrace-list-lookup term (rw.eqset->tail eqset))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqset-lookup)))
+
+ (defthm rw.eqset-lookup-of-term-and-nil
+   (equal (rw.eqset-lookup term nil)
+          nil))
+
+ (local (in-theory (disable (:executable-counterpart ACL2::force))))
+
+ (defthm forcing-rw.eqtracep-of-rw.eqset-lookup
+   (implies (force (and (rw.eqset-lookup term eqset)
+                        (rw.eqsetp eqset)))
+            (equal (rw.eqtracep (rw.eqset-lookup term eqset))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.eqset-lookup
+   (implies (force (and (rw.eqset-lookup term eqset)
+                        (rw.eqset-atblp eqset atbl)))
+            (equal (rw.eqtrace-atblp (rw.eqset-lookup term eqset) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.eqset-lookup
+   (implies (force (and (rw.eqset-lookup term eqset)
+                        (rw.eqset-okp eqset box)))
+            (equal (rw.eqtrace-okp (rw.eqset-lookup term eqset) box)
+                   t)))
+
+ (defthm forcing-memberp-of-rw.eqset-lookup
+   (implies (force (rw.eqset-lookup term eqset))
+            (equal (memberp (rw.eqset-lookup term eqset)
+                            (rw.eqset->tail eqset))
+                   t)))
+
+ (defthm forcing-eqtrace->iffp-of-rw.eqset-lookup
+   (implies (force (and (rw.eqset-lookup term eqset)
+                        (rw.eqsetp eqset)))
+            (equal (rw.eqtrace->iffp (rw.eqset-lookup term eqset))
+                   (rw.eqset->iffp eqset)))
+   :hints(("Goal"
+           :in-theory (disable rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps
+                               rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps-alt)
+           :use ((:instance rw.eqtrace->iffp-when-all-equalp-of-rw.eqtrace-list-iffps
+                            (a    (rw.eqset-lookup term eqset))
+                            (x    (rw.eqset->tail eqset))
+                            (iffp (rw.eqset->iffp eqset)))))))
+
+ (defthm forcing-eqtrace->rhs-of-rw.eqset-lookup
+   (implies (force (rw.eqset-lookup term eqset))
+            (equal (rw.eqtrace->rhs (rw.eqset-lookup term eqset))
+                   term)))
+
+ (defthm forcing-eqtrace->lhs-of-rw.eqset-lookup
+   (implies (force (and (rw.eqset-lookup term eqset)
+                        (rw.eqsetp eqset)))
+            (equal (rw.eqtrace->lhs (rw.eqset-lookup term eqset))
+                   (rw.eqset->head eqset)))
+   :hints(("Goal"
+           :in-theory (disable rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses
+                               rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses-alt)
+           :use ((:instance rw.eqtrace->lhs-when-all-equalp-of-rw.eqtrace-list-lhses
+                            (a   (rw.eqset-lookup term eqset))
+                            (x   (rw.eqset->tail eqset))
+                            (lhs (rw.eqset->head eqset))))))))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-rw.eqset-lookup-of-rw.eqset->head
+   (implies (and (rw.eqtrace-listp x)
+                 (all-equalp lhs (rw.eqtrace-list-lhses x)))
+            (equal (logic.all-terms-largerp lhs (rw.eqtrace-list-rhses x))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthmd lemma-2-for-rw.eqset-lookup-of-rw.eqset->head
+   (implies (and (logic.all-terms-largerp a (rw.eqtrace-list-rhses x))
+                 (force (rw.eqtrace-listp x)))
+            (equal (rw.eqtrace-list-lookup a x)
+                   nil))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm forcing-rw.eqset-lookup-of-rw.eqset->head
+   (implies (force (rw.eqsetp x))
+            (equal (rw.eqset-lookup (rw.eqset->head x) x)
+                   nil))
+   :hints(("Goal" :in-theory (enable rw.eqset-lookup
+                                     lemma-for-rw.eqset-lookup-of-rw.eqset->head
+                                     lemma-2-for-rw.eqset-lookup-of-rw.eqset->head))))
+
+ (defthm forcing-rw.eqset-lookup-of-rw.eqset->head-free
+   (implies (and (equal (rw.eqset->head x) head)
+                 (force (rw.eqsetp x)))
+            (equal (rw.eqset-lookup head x)
+                   nil)))
+
+ (defthm forcing-memberp-of-rw.eqset->head-in-rw.eqtrace-list-rhses-of-rw.eqset->tail
+   (implies (force (rw.eqsetp eqset))
+            (equal (memberp (rw.eqset->head eqset)
+                            (rw.eqtrace-list-rhses (rw.eqset->tail eqset)))
+                   nil))
+   :hints(("Goal" :use ((:instance lemma-for-rw.eqset-lookup-of-rw.eqset->head
+                                   (lhs (rw.eqset->head eqset))
+                                   (x   (rw.eqset->tail eqset)))))))
+
+ (defthm forcing-memberp-of-rw.eqset->head-in-rw.eqtrace-list-rhses-of-rw.eqset->tail-free
+   (implies (and (equal (rw.eqset->head eqset) free)
+                 (force (rw.eqsetp eqset)))
+            (equal (memberp free (rw.eqtrace-list-rhses (rw.eqset->tail eqset)))
+                   nil)))
+
+ (defthm forcing-memberp-of-rw.eqtrace-list-rhses-of-rw.eqset->tail-when-smaller-than-head
+   (implies (and (logic.term-< term (rw.eqset->head eqset))
+                 (force (rw.eqsetp eqset)))
+            (equal (memberp term (rw.eqtrace-list-rhses (rw.eqset->tail eqset)))
+                   nil))
+   :hints(("Goal" :use ((:instance lemma-for-rw.eqset-lookup-of-rw.eqset->head
+                                   (lhs (rw.eqset->head eqset))
+                                   (x   (rw.eqset->tail eqset)))))))
+
+ (defthm forcing-logic.term-<-of-rw.eqset->head-when-rw.eqset-lookup
+   (implies (and (rw.eqset-lookup term eqset)
+                 (force (rw.eqsetp eqset)))
+            (logic.term-< (rw.eqset->head eqset)
+                          term))
+   :hints(("Goal" :in-theory (enable rw.eqset-lookup
+                                     lemma-for-rw.eqset-lookup-of-rw.eqset->head
+                                     lemma-2-for-rw.eqset-lookup-of-rw.eqset->head)))))
+
+
+
+
+
+
+(defund rw.eqset-list-lookup (term eqsets)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.eqset-listp eqsets))))
+  (if (consp eqsets)
+      (or (rw.eqset-lookup term (car eqsets))
+          (rw.eqset-list-lookup term (cdr eqsets)))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqset-list-lookup)))
+
+ (defthm forcing-rw.eqtracep-of-rw.eqset-list-lookup
+   (implies (force (and (rw.eqset-list-lookup term eqsets)
+                        (rw.eqset-listp eqsets)))
+            (equal (rw.eqtracep (rw.eqset-list-lookup term eqsets))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.eqset-list-lookup
+   (implies (force (and (rw.eqset-list-lookup term eqsets)
+                        (rw.eqset-list-atblp eqsets atbl)))
+            (equal (rw.eqtrace-atblp (rw.eqset-list-lookup term eqsets) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.eqset-list-lookup
+   (implies (force (and (rw.eqset-list-lookup term eqsets)
+                        (rw.eqset-list-okp eqsets box)))
+            (equal (rw.eqtrace-okp (rw.eqset-list-lookup term eqsets) box)
+                   t)))
+
+ (defthm forcing-eqtrace->rhs-of-rw.eqset-list-lookup
+   (implies (force (rw.eqset-list-lookup term eqsets))
+            (equal (rw.eqtrace->rhs (rw.eqset-list-lookup term eqsets))
+                   term)))
+
+ (defthm forcing-rw.eqtrace->iffp-of-rw.eqset-list-lookup-when-all-equalp
+   (implies (and (all-equalp iffp (rw.eqset-list-iffps eqsets))
+                 (force (rw.eqset-list-lookup term eqsets))
+                 (force (rw.eqset-listp eqsets)))
+            (equal (rw.eqtrace->iffp (rw.eqset-list-lookup term eqsets))
+                   iffp))))
+
+
+
+(definlined rw.try-equiv-database (term database iffp)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.eqdatabasep database)
+                              (booleanp iffp))))
+  (if iffp
+      (rw.eqset-list-lookup term (rw.eqdatabase->iffsets database))
+    (rw.eqset-list-lookup term (rw.eqdatabase->equalsets database))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.try-equiv-database)))
+
+ (defthm forcing-rw.eqtracep-of-rw.try-equiv-database
+   (implies (force (and (rw.try-equiv-database term database iffp)
+                        (rw.eqdatabasep database)))
+            (equal (rw.eqtracep (rw.try-equiv-database term database iffp))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.try-equiv-database
+   (implies (force (and (rw.try-equiv-database term database iffp)
+                        (rw.eqdatabase-atblp database atbl)))
+            (equal (rw.eqtrace-atblp (rw.try-equiv-database term database iffp) atbl)
+                   t)))
+
+ (defthm forcing-rw.eqtrace-okp-of-rw.try-equiv-database
+   (implies (force (and (rw.try-equiv-database term database iffp)
+                        (rw.eqdatabase-okp database box)))
+            (equal (rw.eqtrace-okp (rw.try-equiv-database term database iffp) box)
+                   t)))
+
+ (defthm forcing-eqtrace->rhs-of-rw.try-equiv-database
+   (implies (force (rw.try-equiv-database term database iffp))
+            (equal (rw.eqtrace->rhs (rw.try-equiv-database term database iffp))
+                   term)))
+
+ (defthm forcing-eqtrace->iffp-of-rw.try-equiv-database
+   (implies (force (and (rw.try-equiv-database term database iffp)
+                        (rw.eqdatabasep database)))
+            (equal (rw.eqtrace->iffp (rw.try-equiv-database term database iffp))
+                   (if iffp
+                       t
+                     nil)))
+   :hints(("Goal"
+           :use ((:instance forcing-rw.eqtrace->iffp-of-rw.eqset-list-lookup-when-all-equalp
+                            (iffp nil)
+                            (eqsets (rw.eqdatabase->equalsets database))
+                            (term term))
+                 (:instance forcing-rw.eqtrace->iffp-of-rw.eqset-list-lookup-when-all-equalp
+                            (iffp t)
+                            (eqsets (rw.eqdatabase->iffsets database))
+                            (term term)))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/weakening-eqtrace-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/weakening-eqtrace-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/weakening-eqtrace-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/weakening-eqtrace-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,107 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trans1-eqtrace-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund rw.weakening-eqtrace-bldr (x box proofs)
+  (declare (xargs :guard (and (rw.eqtracep x)
+                              (rw.hypboxp box)
+                              (rw.weakening-eqtrace-okp x)
+                              (rw.eqtrace-okp x box)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box)))
+                  :verify-guards nil)
+           (ignore box))
+  (if (rw.eqtrace->iffp (first (rw.eqtrace->subtraces x)))
+      (logic.appeal-identity (first proofs))
+    (build.disjoined-iff-from-equal (first proofs))))
+
+(defobligations rw.weakening-eqtrace-bldr
+  (build.disjoined-iff-from-equal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.eqtrace-formula
+                           rw.weakening-eqtrace-bldr
+                           rw.weakening-eqtrace-okp
+                           lemma-1-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr
+                           lemma-3-for-forcing-logic.appealp-of-rw.trans1-eqtrace-bldr)))
+
+ (defthm forcing-rw.weakening-eqtrace-bldr-under-iff
+   (iff (rw.weakening-eqtrace-bldr x box proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.weakening-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.weakening-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.appealp (rw.weakening-eqtrace-bldr x box proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.weakening-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.weakening-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))))
+            (equal (logic.conclusion (rw.weakening-eqtrace-bldr x box proofs))
+                   (rw.eqtrace-formula x box)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.weakening-eqtrace-bldr
+   (implies (force (and (rw.eqtracep x)
+                        (rw.hypboxp box)
+                        (rw.weakening-eqtrace-okp x)
+                        (rw.eqtrace-okp x box)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.eqtrace-formula-list (rw.eqtrace->subtraces x) box))
+                        ;; ---
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.weakening-eqtrace-bldr)))
+            (equal (logic.proofp (rw.weakening-eqtrace-bldr x box proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.weakening-eqtrace-bldr))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assms/weakening-eqtrace.lisp acl2-6.3/books/milawa/ACL2/rewrite/assms/weakening-eqtrace.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assms/weakening-eqtrace.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assms/weakening-eqtrace.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,109 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "eqtracep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+(defund rw.weakening-eqtrace (x)
+  ;; Infer (iff lhs rhs) from (equiv lhs rhs).
+  (declare (xargs :guard (rw.eqtracep x)))
+  (rw.eqtrace 'weakening t (rw.eqtrace->lhs x) (rw.eqtrace->rhs x) (list x)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.weakening-eqtrace)))
+
+ (defthm forcing-rw.eqtrace->method-of-rw.weakening-eqtrace
+   (equal (rw.eqtrace->method (rw.weakening-eqtrace x))
+          'weakening))
+
+ (defthm forcing-rw.eqtrace->iffp-of-rw.weakening-eqtrace
+   (equal (rw.eqtrace->iffp (rw.weakening-eqtrace x))
+          t))
+
+ (defthm forcing-rw.eqtrace->lhs-of-rw.weakening-eqtrace
+   (equal (rw.eqtrace->lhs (rw.weakening-eqtrace x))
+          (rw.eqtrace->lhs x)))
+
+ (defthm forcing-rw.eqtrace->rhs-of-rw.weakening-eqtrace
+   (equal (rw.eqtrace->rhs (rw.weakening-eqtrace x))
+          (rw.eqtrace->rhs x)))
+
+ (defthm forcing-rw.eqtrace->subtraces-of-rw.weakening-eqtrace
+   (equal (rw.eqtrace->subtraces (rw.weakening-eqtrace x))
+          (list x)))
+
+ (defthm forcing-rw.eqtracep-of-rw.weakening-eqtrace
+   (implies (force (rw.eqtracep x))
+            (equal (rw.eqtracep (rw.weakening-eqtrace x))
+                   t)))
+
+ (defthm forcing-rw.eqtrace-atblp-of-rw.weakening-eqtrace
+   (implies (force (rw.eqtrace-atblp x atbl))
+            (equal (rw.eqtrace-atblp (rw.weakening-eqtrace x) atbl)
+                   t))))
+
+
+
+(defund rw.weakening-eqtrace-okp (x)
+  ;; Check if any nhyp in the hypbox would generate this weakening eqtrace.
+  (declare (xargs :guard (and (rw.eqtracep x))))
+  (let ((method    (rw.eqtrace->method x))
+        (iffp      (rw.eqtrace->iffp x))
+        (lhs       (rw.eqtrace->lhs x))
+        (rhs       (rw.eqtrace->rhs x))
+        (subtraces (rw.eqtrace->subtraces x)))
+    (and (equal method 'weakening)
+         (equal iffp t)
+         (equal (len subtraces) 1)
+         (equal lhs (rw.eqtrace->lhs (first subtraces)))
+         (equal rhs (rw.eqtrace->rhs (first subtraces))))))
+
+(defthm booleanp-of-rw.weakening-eqtrace-okp
+  (equal (booleanp (rw.weakening-eqtrace-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.weakening-eqtrace-okp)
+                                 (forcing-booleanp-of-rw.eqtrace->iffp)))))
+
+(defthm forcing-rw.weakening-eqtrace-okp-of-rw.weakening-eqtrace
+  (equal (rw.weakening-eqtrace-okp (rw.weakening-eqtrace x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.weakening-eqtrace rw.weakening-eqtrace-okp))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/assume.lisp acl2-6.3/books/milawa/ACL2/rewrite/assume.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/assume.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/assume.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,159 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+(defdoc assume
+  ":Doc-Section Events
+
+   a system for sharing assumptions across many theorems~/
+
+   We provide a simple table-based system for reusable assumptions.  To the
+   user, this system takes on the following interface:
+   ~bv[]
+     (assume <term>)
+        adds term to the local assumptions
+
+     (unassume <term>)
+        removes <term> from the local assumptions
+
+     (conclude <name> <thm> :hints ... :rule-classes ...)
+        like defth, but proves <thm> under the current assumptions
+   ~ev[]
+
+   For example, consider the following ACL2 rules:
+   ~bv[]
+     (defthm natp-of-plus
+       (implies (and (natp x)
+                     (natp y))
+                (natp (+ x y))))
+
+     (defthm natp-of-minus
+       (implies (and (natp x)
+                     (natp y)
+                     (< y x))
+                (natp (- x y))))
+   ~ev[]
+
+   We can convert these into the assume/conclude style as follows:
+   ~ev[]
+     (assume (natp x))
+     (assume (natp y))
+     (conclude natp-of-plus (natp (+ x y)))
+     (conclude natp-of-minus (implies (< y x) (natp (- x y))))
+   ~ev[]~/
+
+   The ~c[assume] and ~c[unassume] commands are implicitly ~il[local], so you
+   can use ~il[encapsulate] in addition to ~c[unassume] to limit the scope of
+   your assumptions.
+
+   The ~c[conclude] command recognizes ~c[thm]s of the following forms:
+   ~bv[]
+      (implies (and hyp1 ... hypN) concl)
+      (implies hyp1 concl)
+      concl
+   ~ev[]
+
+   It augments the <thm> by injecting the current assumptions after the last
+   hyp.  That is, we produce:
+   ~bv[]
+     (implies (and hyp1 ... hypN assm1 ... assmK) concl)
+     (implies (and hyp1 assm1 ... assmK) concl)
+     (implies (and assm1 ... assmK) concl)
+   ~ev[]
+
+   We expect this to be appropriate most of the time, since shared hyps tend to
+   be ``common'' sorts of things, e.g., type constraints, etc.  Meanwhile, the
+   unshared hyps should tend to be more complicated and unusual, so we place
+   them at the front of the rule in an effort to make ``fast failing'' rules.")
+
+
+(table assume.table 'assumptions nil)
+
+(defun assume.get-assumptions (world)
+  (declare (xargs :mode :program))
+  (cdr (assoc-eq 'assumptions (table-alist 'assume.table world))))
+
+(defun assume.assume-fn (assm)
+  `(local (table assume.table 'assumptions
+                 (cons ',assm (assume.get-assumptions world)))))
+
+(defmacro assume (assm)
+  (assume.assume-fn assm))
+
+
+
+(defun assume.unassume-fn (assm)
+  (declare (xargs :mode :program))
+  `(local (table assume.table 'assumptions
+                 (remove-equal ',assm (assume.get-assumptions world)))))
+
+(defmacro unassume (assm)
+  (assume.unassume-fn assm))
+
+
+
+(defun assume.conclude-fn (name thm extra-args world)
+  (declare (xargs :mode :program))
+  (cond ((and (consp thm)
+              (equal (first thm) 'implies)
+              (consp (second thm))
+              (equal (first (second thm)) 'and))
+         ;; Thm has the form (implies (and hyp1 ... hypN) concl)
+         (let ((hyps  (cdr (second thm)))
+               (concl (third thm)))
+           `(defthm ,name
+              (implies (and ,@(append hyps (assume.get-assumptions world)))
+                       ,concl)
+              ,@extra-args)))
+        ((and (consp thm)
+              (equal (first thm) 'implies))
+         ;; Thm has the form (implies hyp1 concl)
+         (let ((hyps  (list (second thm)))
+               (concl (third thm)))
+           `(defthm ,name
+              (implies (and ,@(append hyps (assume.get-assumptions world)))
+                       ,concl)
+              ,@extra-args)))
+        (t
+         ;; Thm has the form concl
+         `(defthm ,name
+            (implies (and ,@(assume.get-assumptions world))
+                     ,thm)
+            ,@extra-args))))
+
+(defmacro conclude (name thm &rest extra-args)
+  `(make-event (assume.conclude-fn ',name ',thm ',extra-args (w state))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/cachep.lisp acl2-6.3/books/milawa/ACL2/rewrite/cachep.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/cachep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/cachep.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1035 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "assms/top")
+(include-book "traces/trace-okp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Essay on Rewriting Caching
+;;
+;; We use a cache to avoid repeatedly rewriting the same term.  The cache acts
+;; like an accumulator: crewrite takes the current cache as an input, and when
+;; it returns its resulting term, it also returns an updated cache.
+;;
+;; The cache remembers how previously-rewritten terms were simplified.  For now
+;; just think of the cache as a mapping from terms to traces.  For example, if
+;; (foo x) previously rewrote to true, our cache might contain an entry such as
+;; (foo x) -> [trace of how (foo x) rewrites to true].  Now, when we encounter
+;; (foo x) again, we can simply reuse this trace.
+;;
+;;
+;; Introduction.
+;;
+;; Caching is a subtle business.  Lets first review the arguments taken by
+;; crewrite.  We omit the cache, since it's what we're discussing, and we also
+;; omit the control structure, since it never changes.  This leaves us with:
+;;
+;;   - x, the term to rewrite
+;;   - assms, the current assumptions we're rewriting with
+;;   - iffp, the context we're in
+;;   - blimit, the backchain limit (how hard to try when relieving hyps?)
+;;   - rlimit, the rewrite limit (how many times can we successively rewrite x?)
+;;   - anstack, the ancestors stack
+;;
+;; As these arguments change, we need to identify (1) it is sound to reuse the
+;; previous results, and (2) when it is desirable to reuse the previous
+;; results.
+;;
+;; Soundness.  A fundamental limitation of our implementation is that all
+;; traces in the cache use the current assms structure.  It might be possible
+;; to reimplement the cache to also reuse traces which contain fewer
+;; assumptions, but this seemed too complicated.
+;;
+;; This restriction is not very severe.  The only place the rewriter changes
+;; assumptions is when we encounter (if x y z).  Here, y is rewritten with the
+;; extra assumption that x is true, and z is rewritten with the extra
+;; assumption that x is false; when we encounter y and z, we create fresh,
+;; empty caches which are thrown away after we are done rewriting y and z.  But
+;; in all the other cases, the assms structure is unchanged and we can keep
+;; using and adding to our evolving cache.
+;;
+;; Desirability.  A couple of ideas are implicit when we say "cache."  First,
+;; we want to avoid expensive computation by remembering the work we've already
+;; done.  Second, we want to know something like "using the cache does not
+;; change our output term."
+;;
+;; Actually we want to take a more permissive view of the cache.  Arguments
+;; like the backchain limit and rewrite limit are always changing as we recur,
+;; and we don't want to throw out a whole lot of previous work just because it
+;; was done with blimit 1000, and now we're at blimit 999.
+;;
+;;
+;; Handling argument variation.
+;;
+;; RLIMIT.  Even though the rlimit can be reached if it is set low enough or
+;; loopy rules are present, we think of hitting the rlimit as a degenerate
+;; behavior.  In fact, the rewriter even prints out a warning if this occurs.
+;; So in the caching code, we completely ignore the rlimit, even though this
+;; could in principle cause a different term' to be produced.
+;;
+;; IFFP.  Suppose term has been rewritten to term' under equal and this result
+;; has been cached.  Now suppose term is being rewritten under iff for the
+;; first time.  We feel that it's fair to just rewrite term' under iff, instead
+;; of starting with term.  This might lead to a different result, but we think
+;; a "good" rewrite strategy shouldn't be bothered by this kind of variation,
+;; and we would like to take advantage of the previous attempt.
+;;
+;; BLIMIT. There are two ways that the backchain limit can decrease:
+;;
+;;  (a) If the hyp has no explicit limit, the blimit is decreased by one;
+;;  (b) Else, the blimit is decreased to min(explicit-limit, blimit-1).
+;;
+;; I think of explicit backchain limits as a technique to make rules "cheap"
+;; even though they might have expensive hypotheses.  In fact, I have never
+;; used a backchain limit over 3.  And, I don't expect the backchain limit to
+;; ever be reached unless a "cheap" rule has fired to artificially lower it.
+;;
+;; Accordingly, I implement the following strategy for dealing with the blimit.
+;; Until a case such as (b) is encountered, results are cached without regard
+;; to the blimit.  This of course might violate "strict correctness" as even a
+;; high blimit could be reached by ordinary rules, but I don't expect this case
+;; to ever occur.  On the other hand, once we artificially lower the blimit, we
+;; totally disable caching of rewrites.  This way, hyps which are to be
+;; relieved "cheaply" are never cached, which shouldn't be a big deal since
+;; they are "cheap" to relieve anyway.
+;;
+;; Of course, if we're relieving some hypothesis (foo x) with a backchain limit
+;; of 1, and we have "(foo x) rewrites to (bar x)" in our cache, we still use
+;; this fact even if it was obtained using a high backchain limit; we already
+;; did the work, we might as well use it!
+;;
+;; ANSTACK.  Handling the ancestors stack is the most complicated thing we need
+;; to do.  The problem here is that we can have diverging anstacks which
+;; restrict different things.  That is, suppose we apply some rule of the form
+;; (implies (and hyp1 hyp2) (equal lhs rhs)).  Then terms we reach while
+;; backchaining to prove hyp1 will have hyp1 on their anstack, while terms we
+;; reach while backchaining to prove hyp2 will have hyp2 on their anstack.
+;; This "divergence" is potentially bad because each anstack will prevent
+;; backchaining to relieve different sets of terms.  This makes caching
+;; dangerous: we might cache a "poor" result becuase of anstack restrictions,
+;; then reuse it in a later context where more backchaining would have been
+;; permitted.
+;;
+;; Fortunately, it is somewhat rare for ancestors to prevent rewrites from
+;; occurring, so we adopt a pretty simple strategy of not caching traces which
+;; have failed because of ancestors.  More formally, let us introduce a new
+;; notion of "ancestors-limited" rewrites.  We define this notion on a
+;; per-rewriting-step basis:
+;;
+;;  - relieve-hyp is alimited if the ancestors-check causes it to fail, or if
+;;    the attempt to rewrite its term fails and is alimited
+;;  - relieve-hyps is alimited if any of its calls to relieve-hyp are alimited
+;;  - match is alimited if its relieve-hyps fails and is alimited
+;;  - matches is alimited if all of its matches fail and any of them is alimited
+;;  - rule is alimited if all its matches fail and any of them is alimited
+;;  - rules is alimited if all its rules fail and any of them is alimited
+;;  - term is alimited if (1) simplification fails, (2) rules were tried, and
+;;    some rule was alimited
+;;  - termlist is alimited if any of its terms are alimited
+;;
+;; This definition allows us to cache some terms even when ancestor limits have
+;; been hit in the course of rewriting them.  For example, if there are two
+;; rules which can be used to simplify (foo x), and only one of them is
+;; ancestor limited, we are rewriting (foo x) and ancestors prevent us from
+;; applying a rule, but another rule can still be used to simplify foo.
+
+;; (defthm range-of-update
+;;   ;; BOZO move to utilities
+;;   (equal (range (update key val map))
+;;          (cons val (range map)))
+;;   :hints(("Goal" :in-theory (enable update))))
+
+
+
+(defun hons-lookup (key map)
+  ;; Alias for lookup; gets redefined to hons-assoc-equal "under the hood" for bootstrapping
+  (declare (xargs :guard (mapp map)))
+  (lookup key map))
+
+(defun hons-update (key val map)
+  ;; Alias for update; gets redefined to hons-acons "under the hood" for bootstrapping
+  (declare (xargs :guard (mapp map)))
+  (cons (cons key val) map))
+
+
+
+(defund rw.cachelinep (x)
+  (declare (xargs :guard t))
+  (and (consp x)
+       (let ((eqltrace (car x))
+             (ifftrace (cdr x)))
+         (and (implies eqltrace
+                       (and (rw.tracep eqltrace)
+                            (equal (rw.trace->iffp eqltrace) nil)))
+              (implies ifftrace
+                       (and (rw.tracep ifftrace)
+                            (equal (rw.trace->iffp ifftrace) t)))))))
+
+(defund rw.cacheline (eqltrace ifftrace)
+  (declare (xargs :guard (and (or (not eqltrace)
+                                  (and (rw.tracep eqltrace)
+                                       (equal (rw.trace->iffp eqltrace) nil)))
+                              (or (not ifftrace)
+                                  (and (rw.tracep ifftrace)
+                                       (equal (rw.trace->iffp ifftrace) t))))))
+  (cons eqltrace ifftrace))
+
+(defund rw.cacheline->eqltrace (x)
+  (declare (xargs :guard (rw.cachelinep x)))
+  (car x))
+
+(defund rw.cacheline->ifftrace (x)
+  (declare (xargs :guard (rw.cachelinep x)))
+  (cdr x))
+
+(defthm booleanp-of-rw.cachelinep
+  (equal (booleanp (rw.cachelinep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cachelinep))))
+
+(defthm forcing-rw.cachelinep-of-rw.cacheline
+  (implies (force (and (or (not eqltrace)
+                           (and (rw.tracep eqltrace)
+                                (equal (rw.trace->iffp eqltrace) nil)))
+                       (or (not ifftrace)
+                           (and (rw.tracep ifftrace)
+                                (equal (rw.trace->iffp ifftrace) t)))))
+           (equal (rw.cachelinep (rw.cacheline eqltrace ifftrace))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cachelinep rw.cacheline))))
+
+(defthm rw.cacheline->eqltrace-of-rw.cacheline
+  (equal (rw.cacheline->eqltrace (rw.cacheline eqltrace ifftrace))
+         eqltrace)
+  :hints(("Goal" :in-theory (enable rw.cacheline rw.cacheline->eqltrace))))
+
+(defthm rw.cacheline->ifftrace-of-rw.cacheline
+  (equal (rw.cacheline->ifftrace (rw.cacheline eqltrace ifftrace))
+         ifftrace)
+  :hints(("Goal" :in-theory (enable rw.cacheline rw.cacheline->ifftrace))))
+
+(defthm forcing-rw.tracep-of-rw.cacheline->eqltrace
+  (implies (force (rw.cachelinep x))
+           (equal (rw.tracep (rw.cacheline->eqltrace x))
+                  (if (rw.cacheline->eqltrace x)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.cacheline->eqltrace rw.cachelinep))))
+
+(defthm forcing-rw.trace->iffp-of-rw.cacheline->eqltrace
+  (implies (force (and (rw.cachelinep x)
+                       (rw.cacheline->eqltrace x)))
+           (equal (rw.trace->iffp (rw.cacheline->eqltrace x))
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.cacheline->eqltrace rw.cachelinep))))
+
+(defthm forcing-rw.tracep-of-rw.cacheline->ifftrace
+  (implies (force (rw.cachelinep x))
+           (equal (rw.tracep (rw.cacheline->ifftrace x))
+                  (if (rw.cacheline->ifftrace x)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.cacheline->ifftrace rw.cachelinep))))
+
+(defthm forcing-rw.trace->iffp-of-rw.cacheline->ifftrace
+  (implies (force (and (rw.cachelinep x)
+                       (rw.cacheline->ifftrace x)))
+           (equal (rw.trace->iffp (rw.cacheline->ifftrace x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cacheline->ifftrace rw.cachelinep))))
+
+(deflist rw.cacheline-listp (x)
+  (rw.cachelinep x)
+  :elementp-of-nil nil)
+
+
+
+(defund rw.cacheline-assmsp (line assms)
+  ;; BOZO probably get rid of this and change it to hypboxp
+  (declare (xargs :guard (and (rw.cachelinep line)
+                              (rw.assmsp assms))))
+  (let ((ifftrace (rw.cacheline->ifftrace line))
+        (eqltrace (rw.cacheline->eqltrace line)))
+    (and (or (not ifftrace)
+             (equal (rw.trace->hypbox ifftrace)
+                    (rw.assms->hypbox assms)))
+         (or (not eqltrace)
+             (equal (rw.trace->hypbox eqltrace)
+                    (rw.assms->hypbox assms))))))
+
+(defthm booleanp-of-rw.cacheline-assmsp
+  (equal (booleanp (rw.cacheline-assmsp line assms))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cacheline-assmsp))))
+
+(deflist rw.cacheline-list-assmsp (x assms)
+  (rw.cacheline-assmsp x assms)
+  :guard (and (rw.cacheline-listp x)
+              (rw.assmsp assms)))
+
+(defthm forcing-rw.trace->assms-of-rw.cacheline->ifftrace
+  (implies (force (and (rw.cacheline->ifftrace x)
+                       (rw.cacheline-assmsp x assms)))
+           (equal (rw.trace->hypbox (rw.cacheline->ifftrace x))
+                  (rw.assms->hypbox assms)))
+  :hints(("Goal" :in-theory (enable rw.cacheline-assmsp))))
+
+(defthm forcing-rw.trace->assms-of-rw.cacheline->eqltrace
+  (implies (force (and (rw.cacheline->eqltrace x)
+                       (rw.cacheline-assmsp x assms)))
+           (equal (rw.trace->hypbox (rw.cacheline->eqltrace x))
+                  (rw.assms->hypbox assms)))
+  :hints(("Goal" :in-theory (enable rw.cacheline-assmsp))))
+
+(defthm forcing-rw.cacheline-assmsp-of-rw.cacheline
+  (implies (force (and (or (not eqltrace)
+                           (equal (rw.trace->hypbox eqltrace)
+                                  (rw.assms->hypbox assms)))
+                       (or (not ifftrace)
+                           (equal (rw.trace->hypbox ifftrace)
+                                  (rw.assms->hypbox assms)))))
+           (equal (rw.cacheline-assmsp (rw.cacheline eqltrace ifftrace) assms)
+                  t))
+  ;; BOZO ugly disables
+  :hints(("Goal" :in-theory (enable rw.cacheline-assmsp rw.cacheline rw.cacheline->eqltrace rw.cacheline->ifftrace))))
+
+(defthm rw.trace->assms-of-rw.cacheline->eqltrace-of-lookup
+  (implies (and (rw.cacheline-list-assmsp (range data) assms)
+                (rw.cacheline->eqltrace (cdr (lookup term data))))
+           (equal (rw.trace->hypbox (rw.cacheline->eqltrace (cdr (lookup term data))))
+                  (rw.assms->hypbox assms)))
+  :hints(("Goal" :induct (cdr-induction data))))
+
+(defthm rw.trace->assms-of-rw.cacheline->ifftrace-of-lookup
+  (implies (and (rw.cacheline-list-assmsp (range data) assms)
+                (rw.cacheline->ifftrace (cdr (lookup term data))))
+           (equal (rw.trace->hypbox (rw.cacheline->ifftrace (cdr (lookup term data))))
+                  (rw.assms->hypbox assms)))
+  :hints(("Goal" :induct (cdr-induction data))))
+
+
+
+(defund rw.cacheline-traces-okp (line defs)
+  (declare (xargs :guard (and (rw.cachelinep line)
+                              (definition-listp defs))))
+  (let ((ifftrace (rw.cacheline->ifftrace line))
+        (eqltrace (rw.cacheline->eqltrace line)))
+    (and (or (not ifftrace)
+             (rw.trace-okp ifftrace defs))
+         (or (not eqltrace)
+             (rw.trace-okp eqltrace defs)))))
+
+(defthm booleanp-of-rw.cacheline-traces-okp
+  (equal (booleanp (rw.cacheline-traces-okp line defs))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cacheline-traces-okp))))
+
+(deflist rw.cacheline-list-traces-okp (x defs)
+  (rw.cacheline-traces-okp x defs)
+  :guard (and (rw.cacheline-listp x)
+              (definition-listp defs)))
+
+(defthm forcing-rw.trace-okp-of-rw.cacheline->ifftrace
+  (implies (force (and (rw.cacheline->ifftrace x)
+                       (rw.cacheline-traces-okp x defs)))
+           (equal (rw.trace-okp (rw.cacheline->ifftrace x) defs)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cacheline-traces-okp))))
+
+(defthm forcing-rw.trace-okp-of-rw.cacheline->eqltrace
+  (implies (force (and (rw.cacheline->eqltrace x)
+                       (rw.cacheline-traces-okp x defs)))
+           (equal (rw.trace-okp (rw.cacheline->eqltrace x) defs)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.cacheline-traces-okp)
+                                 (forcing-rw.trace-okp-of-rw.cacheline->ifftrace)))))
+
+(defthm forcing-rw.cacheline-traces-okp-of-rw.cacheline
+  (implies (force (and (or (not eqltrace)
+                           (rw.trace-okp eqltrace defs))
+                       (or (not ifftrace)
+                           (rw.trace-okp ifftrace defs))))
+           (equal (rw.cacheline-traces-okp (rw.cacheline eqltrace ifftrace) defs)
+                  t))
+  ;; BOZO ugly disables
+  :hints(("Goal" :in-theory (enable rw.cacheline-traces-okp rw.cacheline rw.cacheline->eqltrace rw.cacheline->ifftrace))))
+
+(defthm rw.trace-okp-of-rw.cacheline->eqltrace-of-lookup
+  (implies (and (rw.cacheline-list-traces-okp (range data) defs)
+                (rw.cacheline->eqltrace (cdr (lookup term data))))
+           (equal (rw.trace-okp (rw.cacheline->eqltrace (cdr (lookup term data))) defs)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction data)
+          :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthm rw.trace-okp-of-rw.cacheline->ifftrace-of-lookup
+  (implies (and (rw.cacheline-list-traces-okp (range data) defs)
+                (rw.cacheline->ifftrace (cdr (lookup term data))))
+           (equal (rw.trace-okp (rw.cacheline->ifftrace (cdr (lookup term data))) defs)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction data)
+          :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+
+
+
+(defund rw.cacheline-atblp (line atbl)
+  (declare (xargs :guard (and (rw.cachelinep line)
+                              (logic.arity-tablep atbl))))
+  (let ((ifftrace (rw.cacheline->ifftrace line))
+        (eqltrace (rw.cacheline->eqltrace line)))
+    (and (or (not ifftrace)
+             (rw.trace-atblp ifftrace atbl))
+         (or (not eqltrace)
+             (rw.trace-atblp eqltrace atbl)))))
+
+(defthm booleanp-of-rw.cacheline-atblp
+  (equal (booleanp (rw.cacheline-atblp line atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cacheline-atblp))))
+
+(deflist rw.cacheline-list-atblp (x atbl)
+  (rw.cacheline-atblp x atbl)
+  :guard (and (rw.cacheline-listp x)
+              (logic.arity-tablep atbl)))
+
+(defthm forcing-rw.trace-atblp-of-rw.cacheline->ifftrace
+  (implies (force (and (rw.cacheline->ifftrace x)
+                       (rw.cacheline-atblp x atbl)))
+           (equal (rw.trace-atblp (rw.cacheline->ifftrace x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cacheline-atblp))))
+
+(defthm forcing-rw.trace-atblp-of-rw.cacheline->eqltrace
+  (implies (force (and (rw.cacheline->eqltrace x)
+                       (rw.cacheline-atblp x atbl)))
+           (equal (rw.trace-atblp (rw.cacheline->eqltrace x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.cacheline-atblp)
+                                 (forcing-rw.trace-atblp-of-rw.cacheline->ifftrace)))))
+
+(defthm forcing-rw.cacheline-atblp-of-rw.cacheline
+  (implies (force (and (or (not eqltrace)
+                           (rw.trace-atblp eqltrace atbl))
+                       (or (not ifftrace)
+                           (rw.trace-atblp ifftrace atbl))))
+           (equal (rw.cacheline-atblp (rw.cacheline eqltrace ifftrace) atbl)
+                  t))
+  ;; BOZO ugly disables
+  :hints(("Goal" :in-theory (enable rw.cacheline-atblp rw.cacheline rw.cacheline->eqltrace rw.cacheline->ifftrace))))
+
+(defthm rw.trace-atblp-of-rw.cacheline->eqltrace-of-lookup
+  (implies (and (rw.cacheline-list-atblp (range data) atbl)
+                (rw.cacheline->eqltrace (cdr (lookup term data))))
+           (equal (rw.trace-atblp (rw.cacheline->eqltrace (cdr (lookup term data))) atbl)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction data)
+          :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthm rw.trace-atblp-of-rw.cacheline->ifftrace-of-lookup
+  (implies (and (rw.cacheline-list-atblp (range data) atbl)
+                (rw.cacheline->ifftrace (cdr (lookup term data))))
+           (equal (rw.trace-atblp (rw.cacheline->ifftrace (cdr (lookup term data))) atbl)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction data)
+          :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+
+
+
+(defund rw.cacheline-env-okp (line defs thms atbl)
+  (declare (xargs :guard (and (rw.cachelinep line)
+                              (definition-listp defs)
+                              (rw.cacheline-traces-okp line defs)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((ifftrace (rw.cacheline->ifftrace line))
+        (eqltrace (rw.cacheline->eqltrace line)))
+    (and (or (not ifftrace)
+             (rw.trace-env-okp ifftrace defs thms atbl))
+         (or (not eqltrace)
+             (rw.trace-env-okp eqltrace defs thms atbl)))))
+
+(defthm booleanp-of-rw.cacheline-env-okp
+  (equal (booleanp (rw.cacheline-env-okp line defs thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cacheline-env-okp))))
+
+(deflist rw.cacheline-list-env-okp (x defs thms atbl)
+  (rw.cacheline-env-okp x defs thms atbl)
+  :guard (and (rw.cacheline-listp x)
+              (definition-listp defs)
+              (rw.cacheline-list-traces-okp x defs)
+              (logic.formula-listp thms)
+              (logic.arity-tablep atbl)))
+
+(defthm forcing-rw.trace-env-okp-of-rw.cacheline->ifftrace
+  (implies (force (and (rw.cacheline->ifftrace x)
+                       (rw.cacheline-env-okp x defs thms atbl)))
+           (equal (rw.trace-env-okp (rw.cacheline->ifftrace x) defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cacheline-env-okp))))
+
+(defthm forcing-rw.trace-env-okp-of-rw.cacheline->eqltrace
+  (implies (force (and (rw.cacheline->eqltrace x)
+                       (rw.cacheline-env-okp x defs thms atbl)))
+           (equal (rw.trace-env-okp (rw.cacheline->eqltrace x) defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.cacheline-env-okp)
+                                 (forcing-rw.trace-env-okp-of-rw.cacheline->ifftrace)))))
+
+(defthm forcing-rw.cacheline-env-okp-of-rw.cacheline
+  (implies (force (and (or (not eqltrace)
+                           (rw.trace-env-okp eqltrace defs thms atbl))
+                       (or (not ifftrace)
+                           (rw.trace-env-okp ifftrace defs thms atbl))))
+           (equal (rw.cacheline-env-okp (rw.cacheline eqltrace ifftrace) defs thms atbl)
+                  t))
+  ;; BOZO ugly disables
+  :hints(("Goal" :in-theory (enable rw.cacheline-env-okp rw.cacheline rw.cacheline->eqltrace rw.cacheline->ifftrace))))
+
+(defthm rw.trace-env-okp-of-rw.cacheline->eqltrace-of-lookup
+  (implies (and (rw.cacheline-list-env-okp (range data) defs thms atbl)
+                (rw.cacheline->eqltrace (cdr (lookup term data))))
+           (equal (rw.trace-env-okp (rw.cacheline->eqltrace (cdr (lookup term data))) defs thms atbl)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction data)
+          :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthm rw.trace-env-okp-of-rw.cacheline->ifftrace-of-lookup
+  (implies (and (rw.cacheline-list-env-okp (range data) defs thms atbl)
+                (rw.cacheline->ifftrace (cdr (lookup term data))))
+           (equal (rw.trace-env-okp (rw.cacheline->ifftrace (cdr (lookup term data))) defs thms atbl)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction data)
+          :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+
+(defmap :map (rw.cachemapp x)
+        :key (logic.termp x)
+        :val (rw.cachelinep x)
+        :key-list (logic.term-listp x)
+        :val-list (rw.cacheline-listp x)
+        :val-of-nil nil)
+
+;; (defthm forcing-rw.cachemapp-of-update
+;;   ;; BOZO add something like this to defmap?
+;;   (implies (force (and (logic.termp key)
+;;                        (rw.cachelinep val)
+;;                        (rw.cachemapp x)))
+;;            (equal (rw.cachemapp (update key val x))
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable update))))
+
+
+
+(defund rw.cachemap-lhses-okp (x)
+  (declare (xargs :guard (rw.cachemapp x)))
+  (if (consp x)
+      (and (let* ((term     (car (car x)))
+                  (line     (cdr (car x)))
+                  (eqltrace (rw.cacheline->eqltrace line))
+                  (ifftrace (rw.cacheline->ifftrace line)))
+             (and (or (not eqltrace)
+                      (equal (rw.trace->lhs eqltrace) term))
+                  (or (not ifftrace)
+                      (equal (rw.trace->lhs ifftrace) term))))
+           (rw.cachemap-lhses-okp (cdr x)))
+    t))
+
+(defthm rw.cachemap-lhses-okp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.cachemap-lhses-okp x)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cachemap-lhses-okp))))
+
+(defthm rw.cachemap-lhses-okp-of-cons
+  (equal (rw.cachemap-lhses-okp (cons a x))
+         (and (let* ((term     (car a))
+                     (line     (cdr a))
+                     (eqltrace (rw.cacheline->eqltrace line))
+                     (ifftrace (rw.cacheline->ifftrace line)))
+                (and (or (not eqltrace)
+                         (equal (rw.trace->lhs eqltrace) term))
+                     (or (not ifftrace)
+                         (equal (rw.trace->lhs ifftrace) term))))
+              (rw.cachemap-lhses-okp x)))
+  :hints(("Goal" :in-theory (enable rw.cachemap-lhses-okp))))
+
+(defthm booleanp-of-rw.cachemap-lhses-okp
+  (equal (booleanp (rw.cachemap-lhses-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cachemap-lhses-okp))))
+
+(defthm rw.trace->lhs-of-rw.cacheline->eqltrace-of-lookup
+  (implies (and (rw.cachemap-lhses-okp data)
+                (rw.cacheline->eqltrace (cdr (lookup term data))))
+           (equal (rw.trace->lhs (rw.cacheline->eqltrace (cdr (lookup term data))))
+                  term))
+  :hints(("Goal" :induct (cdr-induction data))))
+
+(defthm rw.trace->lhs-of-rw.cacheline->ifftrace-of-lookup
+  (implies (and (rw.cachemap-lhses-okp data)
+                (rw.cacheline->ifftrace (cdr (lookup term data))))
+           (equal (rw.trace->lhs (rw.cacheline->ifftrace (cdr (lookup term data))))
+                  term))
+  :hints(("Goal" :induct (cdr-induction data))))
+
+
+
+
+
+(defaggregate rw.cache
+  (blockp data)
+  :require ((booleanp-of-rw.cache->blockp   (booleanp blockp))
+            (rw.cachemapp-of-rw.cache->data (rw.cachemapp data)))
+  :legiblep nil)
+
+
+(defund rw.cache-assmsp (cache assms)
+  (declare (xargs :guard (and (rw.cachep cache)
+                              (rw.assmsp assms))))
+  (rw.cacheline-list-assmsp (range (rw.cache->data cache)) assms))
+
+(defthm booleanp-of-rw.cache-assmsp
+  (equal (booleanp (rw.cache-assmsp x assms))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cache-assmsp))))
+
+
+(defund rw.cache-traces-okp (cache defs)
+  (declare (xargs :guard (and (rw.cachep cache)
+                              (definition-listp defs))))
+  (rw.cacheline-list-traces-okp (range (rw.cache->data cache)) defs))
+
+(defthm booleanp-of-rw.cache-traces-okp
+  (equal (booleanp (rw.cache-traces-okp cache defs))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cache-traces-okp))))
+
+
+
+(defund rw.cache-atblp (cache atbl)
+  (declare (xargs :guard (and (rw.cachep cache)
+                              (logic.arity-tablep atbl))))
+  (rw.cacheline-list-atblp (range (rw.cache->data cache)) atbl))
+
+(defthm booleanp-of-rw.cache-atblp
+  (equal (booleanp (rw.cache-atblp cache atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cache-atblp))))
+
+
+(defund rw.cache-env-okp (cache defs thms atbl)
+  (declare (xargs :guard (and (rw.cachep cache)
+                              (definition-listp defs)
+                              (rw.cache-traces-okp cache defs)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable rw.cache-traces-okp)))))
+  (rw.cacheline-list-env-okp (range (rw.cache->data cache)) defs thms atbl))
+
+(defthm booleanp-of-rw.cache-env-okp
+  (equal (booleanp (rw.cache-env-okp cache defs thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cache-env-okp))))
+
+
+
+(defund rw.cache-lhses-okp (cache)
+  (declare (xargs :guard (rw.cachep cache)))
+  (rw.cachemap-lhses-okp (rw.cache->data cache)))
+
+(defthm booleanp-of-rw.cache-lhses-okp
+  (equal (booleanp (rw.cache-lhses-okp cache))
+         t)
+  :hints(("Goal" :in-theory (enable rw.cache-lhses-okp))))
+
+
+
+(defund rw.set-blockedp (blockedp cache)
+  (declare (xargs :guard (and (booleanp blockedp)
+                              (rw.cachep cache))))
+  (rw.cache blockedp (rw.cache->data cache)))
+
+(defthm forcing-rw.cachep-of-rw.set-blockedp
+  (implies (force (and (booleanp blockedp)
+                       (rw.cachep cache)))
+           (equal (rw.cachep (rw.set-blockedp blockedp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.set-blockedp))))
+
+(defthm forcing-rw.cache-assmsp-of-rw.set-blockedp
+  (implies (force (and (booleanp blockedp)
+                       (rw.cache-assmsp cache assms)))
+           (equal (rw.cache-assmsp (rw.set-blockedp blockedp cache) assms)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.set-blockedp rw.cache-assmsp))))
+
+(defthm forcing-rw.cache-traces-okp-of-rw.set-blockedp
+  (implies (force (and (booleanp blockedp)
+                       (rw.cache-traces-okp cache defs)))
+           (equal (rw.cache-traces-okp (rw.set-blockedp blockedp cache) defs)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.set-blockedp rw.cache-traces-okp))))
+
+(defthm forcing-rw.cache-atblp-of-rw.set-blockedp
+  (implies (force (and (booleanp blockedp)
+                       (rw.cache-atblp cache atbl)))
+           (equal (rw.cache-atblp (rw.set-blockedp blockedp cache) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.set-blockedp rw.cache-atblp))))
+
+(defthm forcing-rw.cache-env-okp-of-rw.set-blockedp
+  (implies (force (and (booleanp blockedp)
+                       (rw.cache-env-okp cache defs thms atbl)))
+           (equal (rw.cache-env-okp (rw.set-blockedp blockedp cache) defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.set-blockedp rw.cache-env-okp))))
+
+(defthm forcing-rw.cache-lhses-okp-of-rw.set-blockedp
+  (implies (force (and (booleanp blockedp)
+                       (rw.cache-lhses-okp cache)))
+           (equal (rw.cache-lhses-okp (rw.set-blockedp blockedp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.set-blockedp rw.cache-lhses-okp))))
+
+
+
+
+(defund rw.cache-update (term trace iffp cache)
+  ;; We make a special exception so that rewriting to a constant is permitted
+  ;; even when the cache is blocked.
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.tracep trace)
+                              (equal iffp (rw.trace->iffp trace))
+                              (rw.cachep cache))))
+  (let ((blockp (rw.cache->blockp cache))
+        (data   (rw.cache->data cache)))
+    (if (and blockp
+             (not (logic.constantp (rw.trace->rhs trace))))
+        ;; Not allowed to change the cache.
+        cache
+    ;; Allowed to write to the cache.
+    (let* ((entry          (hons-lookup term data))
+           (new-cache-line (if iffp
+                               (rw.cacheline (and entry (rw.cacheline->eqltrace (cdr entry))) trace)
+                             (rw.cacheline trace (and entry (rw.cacheline->ifftrace (cdr entry))))))
+           (new-data       (hons-update term new-cache-line data)))
+      (rw.cache blockp new-data)))))
+
+(defthm forcing-rw.cachep-of-rw.cache-update
+  (implies (force (and (logic.termp term)
+                       (rw.tracep trace)
+                       (equal iffp (rw.trace->iffp trace))
+                       (rw.cachep cache)))
+           (equal (rw.cachep (rw.cache-update term trace iffp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-update))))
+
+(defthm forcing-rw.cache-assmsp-of-rw.cache-update
+  (implies (force (and (logic.termp term)
+                       (rw.tracep trace)
+                       (equal iffp (rw.trace->iffp trace))
+                       (rw.cachep cache)
+                       (equal (rw.trace->hypbox trace)
+                              (rw.assms->hypbox assms))
+                       (rw.cache-assmsp cache assms)))
+           (equal (rw.cache-assmsp (rw.cache-update term trace iffp cache) assms)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-update rw.cache-assmsp))))
+
+(defthm forcing-rw.cache-traces-okp-of-rw.cache-update
+  (implies (force (and (logic.termp term)
+                       (rw.tracep trace)
+                       (equal iffp (rw.trace->iffp trace))
+                       (rw.cachep cache)
+                       (rw.trace-okp trace defs)
+                       (rw.cache-traces-okp cache defs)))
+           (equal (rw.cache-traces-okp (rw.cache-update term trace iffp cache) defs)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-update rw.cache-traces-okp))))
+
+(defthm forcing-rw.cache-atblp-of-rw.cache-update
+  (implies (force (and (logic.termp term)
+                       (rw.tracep trace)
+                       (equal iffp (rw.trace->iffp trace))
+                       (rw.cachep cache)
+                       (rw.trace-atblp trace atbl)
+                       (rw.cache-atblp cache atbl)))
+           (equal (rw.cache-atblp (rw.cache-update term trace iffp cache) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-update rw.cache-atblp))))
+
+(defthm forcing-rw.cache-env-okp-of-rw.cache-update
+  (implies (force (and (logic.termp term)
+                       (rw.tracep trace)
+                       (equal iffp (rw.trace->iffp trace))
+                       (rw.cachep cache)
+                       (rw.trace-env-okp trace defs thms atbl)
+                       (rw.cache-env-okp cache defs thms atbl)))
+           (equal (rw.cache-env-okp (rw.cache-update term trace iffp cache) defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-update rw.cache-env-okp))))
+
+(defthm forcing-rw.cache-lhses-okp-of-rw.cache-update
+  (implies (force (and (logic.termp term)
+                       (rw.tracep trace)
+                       (equal iffp (rw.trace->iffp trace))
+                       (rw.cachep cache)
+                       (equal (rw.trace->lhs trace) term)
+                       (rw.cache-lhses-okp cache)))
+           (equal (rw.cache-lhses-okp (rw.cache-update term trace iffp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-update rw.cache-lhses-okp))))
+
+
+
+
+
+(defund rw.cache-lookup (term iffp cache)
+  (declare (xargs :guard (and (logic.termp term)
+                              (booleanp iffp)
+                              (rw.cachep cache))))
+  (let ((entry (hons-lookup term (rw.cache->data cache))))
+    (and entry
+         (if iffp
+             (rw.cacheline->ifftrace (cdr entry))
+           (rw.cacheline->eqltrace (cdr entry))))))
+
+(defthm forcing-rw.tracep-of-rw.cache-lookup
+  (implies (force (and (rw.cache-lookup term iffp cache)
+                       (logic.termp term)
+                       (rw.cachep cache)))
+           (equal (rw.tracep (rw.cache-lookup term iffp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-lookup))))
+
+(defthm forcing-rw.trace->iffp-of-rw.cache-lookup
+  (implies (force (and (rw.cache-lookup term iffp cache)
+                       (logic.termp term)
+                       (rw.cachep cache)
+                       (booleanp iffp)))
+           (equal (rw.trace->iffp (rw.cache-lookup term iffp cache))
+                  iffp))
+  :hints(("Goal" :in-theory (enable rw.cache-lookup))))
+
+(defthm forcing-rw.trace->hypbox-of-rw.cache-lookup
+  (implies (force (and (rw.cache-lookup term iffp cache)
+                       (logic.termp term)
+                       (rw.cachep cache)
+                       (booleanp iffp)
+                       (rw.cache-assmsp cache assms)))
+           (equal (rw.trace->hypbox (rw.cache-lookup term iffp cache))
+                  (rw.assms->hypbox assms)))
+  :hints(("Goal" :in-theory (enable rw.cache-lookup rw.cache-assmsp))))
+
+(defthm forcing-rw.trace->lhs-of-rw.cache-lookup
+  (implies (force (and (rw.cache-lookup term iffp cache)
+                       (logic.termp term)
+                       (rw.cachep cache)
+                       (booleanp iffp)
+                       (rw.cache-lhses-okp cache)))
+           (equal (rw.trace->lhs (rw.cache-lookup term iffp cache))
+                  term))
+  :hints(("Goal" :in-theory (enable rw.cache-lookup rw.cache-lhses-okp))))
+
+(defthm forcing-rw.trace-okp-of-rw.cache-lookup
+  (implies (force (and (rw.cache-lookup term iffp cache)
+                       (logic.termp term)
+                       (rw.cachep cache)
+                       (booleanp iffp)
+                       (rw.cache-traces-okp cache defs)))
+           (equal (rw.trace-okp (rw.cache-lookup term iffp cache) defs)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-lookup rw.cache-traces-okp))))
+
+(defthm forcing-rw.trace-atblp-of-rw.cache-lookup
+  (implies (force (and (rw.cache-lookup term iffp cache)
+                       (logic.termp term)
+                       (rw.cachep cache)
+                       (booleanp iffp)
+                       (rw.cache-atblp cache atbl)))
+           (equal (rw.trace-atblp (rw.cache-lookup term iffp cache) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-lookup rw.cache-atblp))))
+
+(defthm forcing-rw.trace-env-okp-of-rw.cache-lookup
+  (implies (force (and (rw.cache-lookup term iffp cache)
+                       (logic.termp term)
+                       (rw.cachep cache)
+                       (booleanp iffp)
+                       (rw.cache-env-okp cache defs thms atbl)))
+           (equal (rw.trace-env-okp (rw.cache-lookup term iffp cache) defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-lookup rw.cache-env-okp))))
+
+
+
+
+(defund rw.empty-cache ()
+  (declare (xargs :guard t))
+  (rw.cache nil nil))
+
+(in-theory (disable (:executable-counterpart rw.empty-cache)))
+
+(defthm rw.cachep-of-rw.empty-cache
+  (equal (rw.cachep (rw.empty-cache))
+         t)
+  :hints(("Goal" :in-theory (enable rw.empty-cache))))
+
+(defthm rw.cache-assmsp-of-rw.empty-cache
+  (equal (rw.cache-assmsp (rw.empty-cache) assms)
+         t)
+  :hints(("Goal" :in-theory (enable rw.empty-cache rw.cache-assmsp))))
+
+(defthm rw.cache-traces-okp-of-rw.empty-cache
+  (equal (rw.cache-traces-okp (rw.empty-cache) defs)
+         t)
+  :hints(("Goal" :in-theory (enable rw.empty-cache rw.cache-traces-okp))))
+
+(defthm rw.cache-atblp-of-rw.empty-cache
+  (equal (rw.cache-atblp (rw.empty-cache) atbl)
+         t)
+  :hints(("Goal" :in-theory (enable rw.empty-cache rw.cache-atblp))))
+
+(defthm rw.cache-env-okp-of-rw.empty-cache
+  (equal (rw.cache-env-okp (rw.empty-cache) defs thms atbl)
+         t)
+  :hints(("Goal" :in-theory (enable rw.empty-cache rw.cache-env-okp))))
+
+(defthm rw.cache-lhses-okp-rw.empty-cache
+  (equal (rw.cache-lhses-okp (rw.empty-cache))
+         t)
+  :hints(("Goal" :in-theory (enable rw.empty-cache rw.cache-lhses-okp))))
+
+
+
+
+(defund rw.maybe-update-cache (condition term trace iffp cache)
+  ;; We can't just use an alias for if, because we need to update the cache
+  ;; lazily
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.cachep cache)
+                              (or (not condition)
+                                  (and (rw.tracep trace)
+                                       (equal (rw.trace->iffp trace) iffp)
+                                       (equal (rw.trace->lhs trace) term))))))
+  (if condition
+      (rw.cache-update term trace iffp cache)
+    cache))
+
+(defthm forcing-rw.cachep-of-rw.maybe-update-cache
+  (implies (force (and (logic.termp term)
+                       (rw.cachep cache)
+                       (or (not condition)
+                           (and (rw.tracep trace)
+                                (equal (rw.trace->iffp trace) iffp)))))
+           (equal (rw.cachep (rw.maybe-update-cache condition term trace iffp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.maybe-update-cache))))
+
+(defthm forcing-rw.cache-assmsp-of-rw.maybe-update-cache
+   (implies (force (and (logic.termp term)
+                        (rw.cachep cache)
+                        (rw.cache-assmsp cache assms)
+                        (or (not condition)
+                            (and (rw.tracep trace)
+                                 (equal (rw.trace->iffp trace) iffp)
+                                 (equal (rw.trace->hypbox trace)
+                                        (rw.assms->hypbox assms))))))
+            (equal (rw.cache-assmsp (rw.maybe-update-cache condition term trace iffp cache) assms)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.maybe-update-cache))))
+
+(defthm forcing-rw.cache-traces-okp-of-rw.maybe-update-cache
+  (implies (force (and (logic.termp term)
+                       (rw.cachep cache)
+                       (rw.cache-traces-okp cache defs)
+                       (or (not condition)
+                           (and (rw.tracep trace)
+                                (rw.trace-okp trace defs)
+                                (equal (rw.trace->iffp trace) iffp)))))
+           (equal (rw.cache-traces-okp (rw.maybe-update-cache condition term trace iffp cache) defs)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.maybe-update-cache))))
+
+(defthm forcing-rw.cache-atblp-of-rw.maybe-update-cache
+  (implies (force (and (logic.termp term)
+                       (rw.cachep cache)
+                       (rw.cache-atblp cache atbl)
+                       (or (not condition)
+                           (and (rw.tracep trace)
+                                (rw.trace-atblp trace atbl)
+                                (equal (rw.trace->iffp trace) iffp)))))
+           (equal (rw.cache-atblp (rw.maybe-update-cache condition term trace iffp cache) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.maybe-update-cache))))
+
+(defthm forcing-rw.cache-env-okp-of-rw.maybe-update-cache
+  (implies (force (and (logic.termp term)
+                       (rw.cachep cache)
+                       (rw.cache-env-okp cache defs thms atbl)
+                       (or (not condition)
+                           (and (rw.tracep trace)
+                                (rw.trace-env-okp trace defs thms atbl)
+                                (equal (rw.trace->iffp trace) iffp)))))
+           (equal (rw.cache-env-okp (rw.maybe-update-cache condition term trace iffp cache) defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.maybe-update-cache))))
+
+(defthm forcing-rw.cache-lhses-okp-of-rw.maybe-update-cache
+  (implies (force (and (logic.termp term)
+                       (rw.cachep cache)
+                       (rw.cache-lhses-okp cache)
+                       (or (not condition)
+                           (and (rw.tracep trace)
+                                (equal (rw.trace->iffp trace) iffp)
+                                (equal (rw.trace->lhs trace) term)))))
+           (equal (rw.cache-lhses-okp (rw.maybe-update-cache condition term trace iffp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.maybe-update-cache))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/ccstep-arities.lisp acl2-6.3/books/milawa/ACL2/rewrite/ccstep-arities.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/ccstep-arities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/ccstep-arities.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,169 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "assms/eqtrace-arities")
+(include-book "traces/trace-arities")
+(include-book "ccsteps")
+(set-verify-guards-eagerness 2)
+(set-measure-function rank)
+(set-well-founded-relation ord<)
+(set-case-split-limitations nil)
+
+
+
+(defund rw.faster-ccstepp (x)
+  (declare (xargs :guard t))
+  (let ((term (car (car x)))
+        (hypbox (cdr (car x)))
+        (contradiction (car (cdr x)))
+        (trace (cdr (cdr x))))
+    (and (logic.termp term)
+         (rw.faster-hypboxp hypbox)
+         (if contradiction
+             (and (rw.eqtracep contradiction)
+                  (rw.eqtrace-contradictionp contradiction)
+                  (rw.eqtrace-okp contradiction hypbox)
+                  (not trace))
+           (and (rw.faster-tracep trace hypbox)
+                (rw.trace->iffp trace)
+                (equal (rw.trace->hypbox trace) hypbox)
+                (equal (rw.trace->lhs trace) term))))))
+
+(defthm rw.faster-ccstep-removal
+  (equal (rw.faster-ccstepp x)
+         (rw.ccstepp x))
+  :hints(("Goal" :in-theory (enable rw.ccstepp rw.faster-ccstepp))))
+
+(defund rw.faster-ccstep-listp (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (rw.faster-ccstepp (car x))
+           (rw.faster-ccstep-listp (cdr x)))
+    t))
+
+(defthm rw.faster-ccstep-list-removal
+  (equal (rw.faster-ccstep-listp x)
+         (rw.ccstep-listp x))
+  :hints(("Goal" :in-theory (enable rw.faster-ccstep-listp))))
+
+
+
+
+(defund rw.slow-ccstep-arities (x)
+  (declare (xargs :guard (rw.ccstepp x)))
+  (let* ((term          (rw.ccstep->term x))
+         (hypbox        (rw.ccstep->hypbox x))
+         (contradiction (rw.ccstep->contradiction x))
+         (acc           (logic.slow-term-arities term))
+         (acc           (app (rw.slow-hypbox-arities hypbox) acc)))
+    (if contradiction
+        (app (rw.slow-eqtrace-arities contradiction) acc)
+      (app (rw.slow-faster-trace-arities (rw.ccstep->trace x) hypbox) acc))))
+
+(defthm rw.slow-ccsteps-arities-correct
+  (implies (force (rw.ccstepp x))
+           (equal (logic.arities-okp (rw.slow-ccstep-arities x) atbl)
+                  (and (logic.term-atblp (rw.ccstep->term x) atbl)
+                       (rw.hypbox-atblp (rw.ccstep->hypbox x) atbl)
+                       (if (rw.ccstep->contradiction x)
+                           (rw.eqtrace-atblp (rw.ccstep->contradiction x) atbl)
+                         (rw.trace-atblp (rw.ccstep->trace x) atbl)))))
+  :hints(("Goal" :in-theory (e/d (rw.slow-ccstep-arities)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund rw.ccstep-arities (x acc)
+  (declare (xargs :guard (and (rw.ccstepp x)
+                              (true-listp acc))))
+  (let* ((term          (rw.ccstep->term x))
+         (hypbox        (rw.ccstep->hypbox x))
+         (contradiction (rw.ccstep->contradiction x))
+         (acc           (logic.term-arities term acc))
+         (acc           (rw.hypbox-arities hypbox acc)))
+    (if contradiction
+        (rw.eqtrace-arities contradiction acc)
+      (rw.faster-flag-trace-arities 'term (rw.ccstep->trace x) hypbox acc))))
+
+(defthm rw.cstep-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.ccstep-arities x acc)
+                  (app (rw.slow-ccstep-arities x) acc)))
+  :hints(("Goal"
+          :in-theory (enable rw.ccstep-arities rw.slow-ccstep-arities))))
+
+
+
+(defund rw.slow-ccstep-list-arities (x)
+  (declare (xargs :guard (rw.ccstep-listp x)))
+  (if (consp x)
+      (app (rw.slow-ccstep-arities (car x))
+           (rw.slow-ccstep-list-arities (cdr x)))
+    nil))
+
+(defthm rw.slow-ccstep-list-arities-correct
+  (implies (force (rw.ccstep-listp x))
+           (equal (logic.arities-okp (rw.slow-ccstep-list-arities x) atbl)
+                  (and (logic.term-list-atblp (rw.ccstep-list-terms x) atbl)
+                       (rw.hypbox-list-atblp (rw.ccstep-list-hypboxes x) atbl)
+                       (rw.eqtrace-list-atblp (rw.ccstep-list-gather-contradictions x) atbl)
+                       (rw.trace-list-atblp (rw.ccstep-list-gather-traces x) atbl))))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.slow-ccstep-list-arities x)))))
+
+
+
+(defund rw.ccstep-list-arities (x acc)
+  (declare (xargs :guard (and (rw.ccstep-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.ccstep-arities (car x)
+                         (rw.ccstep-list-arities (cdr x) acc))
+    acc))
+
+(defthm true-listp-of-rw.ccstep-list-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.ccstep-list-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-arities))))
+
+(defthm rw.ccstep-list-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.ccstep-list-arities x acc)
+                  (app (rw.slow-ccstep-list-arities x) acc)))
+  :hints(("Goal"
+          :in-theory (enable rw.slow-ccstep-list-arities
+                             rw.ccstep-list-arities))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/ccstep-check.lisp acl2-6.3/books/milawa/ACL2/rewrite/ccstep-check.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/ccstep-check.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/ccstep-check.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,295 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "ccsteps")
+(include-book "ccstep-arities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defthm forcing-rw.hypbox-listp-of-rw.ccstep-list-hypboxes
+  (implies (force (rw.ccstep-listp x))
+           (equal (rw.hypbox-listp (rw.ccstep-list-hypboxes x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-listp-of-rw.ccstep-list-terms
+  (implies (force (rw.ccstep-listp x))
+           (equal (logic.term-listp (rw.ccstep-list-terms x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.trace-listp-of-rw.ccstep-list-gather-traces
+  (implies (force (rw.ccstep-listp x))
+           (equal (rw.trace-listp (rw.ccstep-list-gather-traces x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.eqtrace-listp-of-rw.ccstep-list-gather-contradictions
+   (implies (force (rw.ccstep-listp x))
+            (equal (rw.eqtrace-listp (rw.ccstep-list-gather-contradictions x))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formulap-of-rw.ccstep-list->original-goal
+  (implies (force (and (rw.ccstep-listp x)
+                       (consp x)))
+           (equal (logic.formulap (rw.ccstep-list->original-goal x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list->original-goal rw.ccstep->original-goal))))
+
+(defthm logic.provable-listp-of-remove-duplicates-when-logic.provable-listp-free
+  (implies (and (equal (remove-duplicates x) free)
+                (logic.provable-listp free axioms thms atbl))
+           (equal (logic.provable-listp x axioms thms atbl)
+                  t)))
+
+
+(defsection rw.ccstep-list-bldr-okp
+
+  (defund rw.ccstep-list-bldr-okp (x defs thms atbl)
+    (declare (xargs :guard (and (logic.appealp x)
+                                (definition-listp defs)
+                                (logic.formula-listp thms)
+                                (logic.arity-tablep atbl))))
+    (let ((method     (logic.method x))
+          (conclusion (logic.conclusion x))
+          (subproofs  (logic.subproofs x))
+          (extras     (logic.extras x)))
+      (and (equal method 'rw.ccstep-list-bldr)
+           ;; extras holds the list of ccsteps
+           (consp extras)
+           (rw.faster-ccstep-listp extras)
+           (rw.ccstep-list->compatiblep extras)
+           (equal conclusion (rw.ccstep-list->original-goal extras))
+           ;; BOZO we could develop a much more efficient test here.
+           (let ((traces         (rw.ccstep-list-gather-traces extras))
+                 (forced-goals   (remove-duplicates (rw.ccstep-list-forced-goals extras))))
+             (and
+              (logic.fast-arities-okp (rw.ccstep-list-arities extras nil) atbl)
+              (rw.trace-list-okp traces defs)
+              (rw.trace-list-env-okp traces defs thms atbl)
+              (if (rw.ccstep->provedp (first extras))
+                  (equal (logic.strip-conclusions subproofs) forced-goals)
+                (and (consp subproofs)
+                     (equal (logic.conclusion (car subproofs)) (rw.ccstep->result-goal (first extras)))
+                     (equal (logic.strip-conclusions (cdr subproofs)) forced-goals))))))))
+
+  (defund rw.ccstep-list-bldr-high (x defs proof fproofs)
+    (declare (xargs :guard (and (consp x)
+                                (rw.ccstep-listp x)
+                                (rw.ccstep-list->compatiblep x)
+                                (definition-listp defs)
+                                (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                                (if (rw.ccstep->provedp (first x))
+                                    (not proof)
+                                  (and (logic.appealp proof)
+                                       (equal (logic.conclusion proof) (rw.ccstep->result-goal (first x)))))
+                                (logic.appeal-listp fproofs)
+                                (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs))))
+             (ignore defs))
+    (let* ((forced-goals         (rw.ccstep-list-forced-goals x))
+           (cleaned-forced-goals (remove-duplicates forced-goals)))
+      (ACL2::prog2$
+       (if (same-lengthp forced-goals cleaned-forced-goals)
+           nil
+         (ACL2::cw! ";;; Removing forced duplicates reduced ~x0 goals to ~x1. (ccstep-list)~%"
+                    (fast-len forced-goals 0)
+                    (fast-len cleaned-forced-goals 0)))
+       (logic.appeal 'rw.ccstep-list-bldr
+                     (rw.ccstep-list->original-goal x)
+                     (if (rw.ccstep->provedp (first x))
+                         (logic.find-proofs cleaned-forced-goals fproofs)
+                       (cons proof (logic.find-proofs cleaned-forced-goals fproofs)))
+                     x))))
+
+  (defthmd rw.ccstep-list-bldr-okp-of-rw.ccstep-list-bldr-high
+    ;; we don't really need this, but it makes us sure everything's okay.
+    (implies (and (consp x)
+                  (rw.ccstep-listp x)
+                  (rw.ccstep-list->compatiblep x)
+                  (definition-listp defs)
+                  (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                  (if (rw.ccstep->provedp (first x))
+                      (not proof)
+                    (and (logic.appealp proof)
+                         (equal (logic.conclusion proof) (rw.ccstep->result-goal (first x)))))
+                  (logic.appeal-listp fproofs)
+                  (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs))
+                  ;; ---
+                  (mapp atbl)
+                  (logic.term-list-atblp (rw.ccstep-list-terms x) atbl)
+                  (rw.hypbox-list-atblp (rw.ccstep-list-hypboxes x) atbl)
+                  (rw.eqtrace-list-atblp (rw.ccstep-list-gather-contradictions x) atbl)
+                  (rw.trace-list-atblp (rw.ccstep-list-gather-traces x) atbl)
+                  (rw.trace-list-env-okp (rw.ccstep-list-gather-traces x) defs thms atbl)
+                  )
+             (equal (rw.ccstep-list-bldr-okp (rw.ccstep-list-bldr-high x defs proof fproofs)
+                                             defs thms atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-bldr-okp
+                                      rw.ccstep-list-bldr-high))))
+
+  (local (in-theory (enable rw.ccstep-list-bldr-okp)))
+
+  (defthm booleanp-of-rw.ccstep-list-bldr-okp
+    (equal (booleanp (rw.ccstep-list-bldr-okp x defs thms atbl))
+           t)
+    :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+  (defthm rw.ccstep-list-bldr-okp-of-logic.appeal-identity
+    (equal (rw.ccstep-list-bldr-okp (logic.appeal-identity x) defs thms atbl)
+           (rw.ccstep-list-bldr-okp x defs thms atbl))
+    :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+  (defthmd lemma-1-for-soundness-of-rw.ccstep-list-bldr-okp
+    (implies (and (rw.ccstep-list-bldr-okp x defs thms atbl)
+                  (logic.appealp x)
+                  (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                  (definition-listp defs))
+             (equal (logic.conclusion
+                     (rw.ccstep-list-bldr (logic.extras x)
+                                          defs
+                                          (if (rw.ccstep->provedp (first (logic.extras x)))
+                                              nil
+                                            (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                                                    axioms thms atbl))
+                                          (logic.provable-list-witness (RW.CCSTEP-LIST-FORCED-GOALS (LOGIC.EXTRAS X))
+                                                                       axioms thms atbl)))
+                    (logic.conclusion x))))
+
+  (defthmd@ lemma-2-for-soundness-of-rw.ccstep-list-bldr-okp
+    (implies (and (rw.ccstep-list-bldr-okp x defs thms atbl)
+                  (logic.appealp x)
+                  (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                  (definition-listp defs)
+                  ;; ---
+                  (mapp atbl)
+                  (logic.formula-list-atblp defs atbl)
+                  (subsetp defs axioms)
+                  (@obligations rw.ccstep-list-bldr)
+                  (equal (cdr (lookup 'not atbl)) 1)
+                  (equal (cdr (lookup 'equal atbl)) 2)
+                  (equal (cdr (lookup 'iff atbl)) 2)
+                  (equal (cdr (lookup 'if atbl)) 3))
+             (equal (logic.proofp
+                     (rw.ccstep-list-bldr (logic.extras x)
+                                          defs
+                                          (if (rw.ccstep->provedp (first (logic.extras x)))
+                                              nil
+                                            (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                                                    axioms thms atbl))
+                                          (logic.provable-list-witness (RW.CCSTEP-LIST-FORCED-GOALS (LOGIC.EXTRAS X))
+                                                                       axioms thms atbl))
+                     axioms thms atbl)
+                    t)))
+
+  (defthm@ forcing-soundness-of-rw.ccstep-list-bldr-okp
+    (implies (and (rw.ccstep-list-bldr-okp x defs thms atbl)
+                  (force (and (logic.appealp x)
+                              (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                              (mapp atbl)
+                              (definition-listp defs)
+                              (logic.formula-list-atblp defs atbl)
+                              (subsetp defs axioms)
+                              (@obligations rw.ccstep-list-bldr)
+                              (equal (cdr (lookup 'not atbl)) 1)
+                              (equal (cdr (lookup 'iff atbl)) 2)
+                              (equal (cdr (lookup 'equal atbl)) 2)
+                              (equal (cdr (lookup 'if atbl)) 3))))
+             (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                    t))
+    :hints (("Goal"
+             :use ((:instance lemma-1-for-soundness-of-rw.ccstep-list-bldr-okp)
+                   (:instance lemma-2-for-soundness-of-rw.ccstep-list-bldr-okp)
+                   (:instance forcing-logic.provablep-when-logic.proofp
+                              (x (rw.ccstep-list-bldr (logic.extras x)
+                                                      defs
+                                                      (if (rw.ccstep->provedp (first (logic.extras x)))
+                                                          nil
+                                                        (logic.provable-witness (logic.conclusion (car (logic.subproofs x)))
+                                                                                axioms thms atbl))
+                                                      (logic.provable-list-witness (RW.CCSTEP-LIST-FORCED-GOALS (LOGIC.EXTRAS X))
+                                                                                   axioms thms atbl)))))))))
+
+
+
+
+
+
+;; Original check is below.  The new check is much faster.
+;;
+;; (defund rw.ccstep-list-bldr-okp (x defs thms atbl)
+;;     (declare (xargs :guard (and (logic.appealp x)
+;;                                 (definition-listp defs)
+;;                                 (logic.formula-listp thms)
+;;                                 (logic.arity-tablep atbl))))
+;;     (let ((method     (logic.method x))
+;;           (conclusion (logic.conclusion x))
+;;           (subproofs  (logic.subproofs x))
+;;           (extras     (logic.extras x)))
+;;       (and (equal method 'rw.ccstep-list-bldr)
+;;            ;; extras holds the list of ccsteps
+;;            (consp extras)
+;;            (rw.ccstep-listp extras)
+;;            (rw.ccstep-list->compatiblep extras)
+;;            (equal conclusion (rw.ccstep-list->original-goal extras))
+;;            ;; BOZO we could develop a much more efficient test here.
+;;            (let ((terms          (rw.ccstep-list-terms extras))
+;;                  (hypboxes       (rw.ccstep-list-hypboxes extras))
+;;                  (traces         (rw.ccstep-list-gather-traces extras))
+;;                  (contradictions (rw.ccstep-list-gather-contradictions extras))
+;;                  (forced-goals   (remove-duplicates (rw.ccstep-list-forced-goals extras))))
+;;              ;; Efficient arity check:
+;;              ;; This replaces
+;;              ;;    (and (logic.term-list-atblp terms atbl)
+;;              ;;         (rw.hypbox-list-atblp hypboxes atbl)
+;;              ;;         (rw.eqtrace-list-atblp contradictions atbl)
+;;              ;;         (rw.fast-trace-list-atblp traces atbl))
+;;              (and
+;;               (let* ((acc (logic.term-list-arities terms nil))
+;;                      (acc (rw.hypbox-list-arities hypboxes acc))
+;;                      (acc (rw.eqtrace-list-arities contradictions acc))
+;;                      (acc (rw.trace-list-arities traces acc)))
+;;                 (logic.fast-arities-okp acc atbl))
+;;               (rw.trace-list-okp traces defs)
+;;               (rw.trace-list-env-okp traces defs thms atbl)
+;;               (if (rw.ccstep->provedp (first extras))
+;;                   (equal (logic.strip-conclusions subproofs) forced-goals)
+;;                 (and (consp subproofs)
+;;                      (equal (logic.conclusion (car subproofs)) (rw.ccstep->result-goal (first extras)))
+;;                      (equal (logic.strip-conclusions (cdr subproofs)) forced-goals))))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/ccsteps.lisp acl2-6.3/books/milawa/ACL2/rewrite/ccsteps.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/ccsteps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/ccsteps.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1260 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../clauses/clean-clauses")
+(include-book "../build/top")
+(include-book "traces/trace-compiler")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Essay on conditionally rewriting clauses
+;;
+;; We now extend our conditional rewriter across a clause.  We use an
+;; accumulator-style function which treats the clause as two pieces, todo and
+;; done.  To begin we load all the literals into the todo list, and at each
+;; step, we rewrite the first todo literal and move it to the done list.
+;;
+;; Suppose we are given the lists of literals todo = [t1, ..., tn] and done =
+;; [d1, ..., dm].  We say the goal for this step is to prove the "step
+;; formula", (t1 v ... v tn) v (d1 v ... v dn).  Since todo is initially set to
+;; the whole clause we want to rewrite, the "original goal" (i.e., the goal for
+;; the first step) will be to prove t1 v ... v tn.  That is, initially we want
+;; to prove the whole clause we are rewriting.  Each step "reduces" this goal,
+;; which is probably hard to prove, into a new goal which is hopefully easier
+;; to prove because some literal has been rewritten.  In the end, all of the
+;; rewritten literals are in done, so our final goal is to prove the rewritten
+;; clause.
+;;
+;; When we build the proof corresponding to this rewriting, the process gets
+;; reversed.  That is, assume we have a proof of the fully rewritten clause.
+;; We now need to "unwind" each step, building a proof of each step-goal by
+;; starting with the final step and working our way towards the original goal.
+;; That is, given a proof of the fully rewritten clause, we work backwards to
+;; construct a proof of the original clause.
+;;
+;; So how does each step work?  To make progress, we are first going to rewrite
+;; t1 to t1' and then move t1' over to the done list.
+;;
+;; To rewrite t1, we can assume:
+;;
+;;    (1) [t2, ..., tn] are false, and
+;;    (2) [d1, ..., dm] are false.
+;;
+;; As we assume these things, we might notice that we have contradictory assms,
+;; in which case we can use the contradiction to immediately prove the clause
+;; and we can stop early.
+;;
+;; Otherwise, we rewrite t1 to t1' under these assumptions.  We might notice
+;; that t1' is obviously true, which means we have proven the goal and we can
+;; stop without doing any more rewriting.  But usually this is not the case, so
+;; we create a new todo and done list:
+;;
+;;   Todo': [t2, ..., tn]
+;;   Done': [t1', d1, ..., dm]
+;;
+;; And these lists mark the beginning of the next step.
+
+
+
+;; Representation of steps
+;;
+;; When we take each step, we need to record enough information to build a
+;; proof of the step goal, given a proof of the next-step's goal.  We do
+;; this using a ccstep ("crewrite clause step") structure.
+;;
+;; These structures contain:
+;;
+;;   - the term we rewrite, i.e., "t1",
+;;   - the hypbox we were using, and then either:
+;;       1. a proof of the hypbox formula, if there is a contradiction, or
+;;       2. a trace of how t1 gets rewritten, otherwise.
+;;
+;; Note that from this, we can also recover:
+;;
+;;   - todo, by adding t1 to the "left nhyps" from the hypbox
+;;   - done, by taking the "right nhyps" from the hypbox, and
+;;   - (if there was no contradiction) t1-prime, by taking the rhs of the trace
+
+(defsection rw.ccstepp
+
+  (definlined rw.ccstepp (x)
+    ;; ((term . hypbox) . (contradiction? . trace?))
+    (declare (xargs :guard t))
+    (let ((term          (car (car x)))
+          (hypbox        (cdr (car x)))
+          (contradiction (car (cdr x)))
+          (trace         (cdr (cdr x))))
+      (and (logic.termp term)
+           (rw.hypboxp hypbox)
+           (if contradiction
+               (and (rw.eqtracep contradiction)
+                    (rw.eqtrace-contradictionp contradiction)
+                    (rw.eqtrace-okp contradiction hypbox)
+                    (not trace))
+             (and (rw.tracep trace)
+                  (rw.trace->iffp trace)
+                  (equal (rw.trace->hypbox trace) hypbox)
+                  (equal (rw.trace->lhs trace) term))))))
+
+  (definlined rw.ccstep->term (x)
+    (declare (xargs :guard (rw.ccstepp x)))
+    (car (car x)))
+
+  (definlined rw.ccstep->hypbox (x)
+    (declare (xargs :guard (rw.ccstepp x)))
+    (cdr (car x)))
+
+  (definlined rw.ccstep->contradiction (x)
+    (declare (xargs :guard (rw.ccstepp x)))
+    (car (cdr x)))
+
+  (definlined rw.ccstep->trace (x)
+    (declare (xargs :guard (rw.ccstepp x)))
+    (cdr (cdr x)))
+
+  (definlined rw.ccstep (term hypbox contradiction trace)
+    (declare (xargs :guard (and (logic.termp term)
+                                (rw.hypboxp hypbox)
+                                (if contradiction
+                                    (and (rw.eqtracep contradiction)
+                                         (rw.eqtrace-contradictionp contradiction)
+                                         (rw.eqtrace-okp contradiction hypbox)
+                                         (not trace))
+                                  (and (rw.tracep trace)
+                                       (rw.trace->iffp trace)
+                                       (equal (rw.trace->hypbox trace) hypbox)
+                                       (equal (rw.trace->lhs trace) term))))))
+    (cons (cons term hypbox)
+          (cons contradiction trace)))
+
+  (local (in-theory (enable rw.ccstepp
+                            rw.ccstep
+                            rw.ccstep->term
+                            rw.ccstep->hypbox
+                            rw.ccstep->contradiction
+                            rw.ccstep->trace)))
+
+  (defthm booleanp-of-rw.ccstepp
+    (equal (booleanp (rw.ccstepp x))
+           t))
+
+  (defthm forcing-rw.ccstepp-of-rw.ccstep
+    (implies (force (and (logic.termp term)
+                         (rw.hypboxp hypbox)
+                         (if contradiction
+                             (and (rw.eqtracep contradiction)
+                                  (rw.eqtrace-contradictionp contradiction)
+                                  (rw.eqtrace-okp contradiction hypbox)
+                                  (not trace))
+                           (and (rw.tracep trace)
+                                (rw.trace->iffp trace)
+                                (equal (rw.trace->hypbox trace) hypbox)
+                                (equal (rw.trace->lhs trace) term)))))
+             (equal (rw.ccstepp (rw.ccstep term hypbox contradiction trace))
+                    t)))
+
+  (defthm rw.ccstep->term-of-rw.ccstep
+    (equal (rw.ccstep->term (rw.ccstep term hypbox contradiction trace))
+           term))
+
+  (defthm rw.ccstep->hypbox-of-rw.ccstep
+    (equal (rw.ccstep->hypbox (rw.ccstep term hypbox contradiction trace))
+           hypbox))
+
+  (defthm rw.ccstep->contradiction-of-rw.ccstep
+    (equal (rw.ccstep->contradiction (rw.ccstep term hypbox contradiction trace))
+           contradiction))
+
+  (defthm rw.ccstep->trace-of-rw.ccstep
+    (equal (rw.ccstep->trace (rw.ccstep term hypbox contradiction trace))
+           trace))
+
+  (defthm forcing-logic.termp-of-rw.ccstep->term
+    (implies (force (rw.ccstepp x))
+             (equal (logic.termp (rw.ccstep->term x))
+                    t)))
+
+  (defthm forcing-rw.hypboxp-of-rw.ccstep->hypbox
+    (implies (force (rw.ccstepp x))
+             (equal (rw.hypboxp (rw.ccstep->hypbox x))
+                    t)))
+
+  (defthm forcing-rw.eqtracep-of-rw.ccstep->contradiction
+    (implies (force (and (rw.ccstep->contradiction x)
+                         (rw.ccstepp x)))
+             (equal (rw.eqtracep (rw.ccstep->contradiction x))
+                    t)))
+
+  (defthm forcing-rw.eqtrace-contradictionp-of-rw.ccstep->contradiction
+    (implies (force (and (rw.ccstep->contradiction x)
+                         (rw.ccstepp x)))
+             (equal (rw.eqtrace-contradictionp (rw.ccstep->contradiction x))
+                    t)))
+
+  (defthm forcing-rw.eqtrace-okp-of-rw.ccstep->contradiction
+    (implies (force (and (rw.ccstep->contradiction x)
+                         (rw.ccstepp x)))
+             (equal (rw.eqtrace-okp (rw.ccstep->contradiction x) (rw.ccstep->hypbox x))
+                    t)))
+
+  (defthm forcing-rw.hypbox->right-of-rw.ccstep->hypbox-when-rw.ccstep->contradiction
+    (implies (and (rw.ccstep->contradiction x)
+                  (force (rw.ccstepp x))
+                  (not (rw.hypbox->left (rw.ccstep->hypbox x))))
+             (iff (rw.hypbox->right (rw.ccstep->hypbox x))
+                  t)))
+
+  (defthm forcing-rw.tracep-of-rw.ccstep->trace
+    (implies (force (and (not (rw.ccstep->contradiction x))
+                         (rw.ccstepp x)))
+             (equal (rw.tracep (rw.ccstep->trace x))
+                    t)))
+
+  (defthm forcing-rw.trace->iffp-of-rw.ccstep->trace
+    (implies (force (and (not (rw.ccstep->contradiction x))
+                         (rw.ccstepp x)))
+             (equal (rw.trace->iffp (rw.ccstep->trace x))
+                    t)))
+
+  (defthm forcing-rw.trace->hypbox-of-rw.ccstep->trace
+    (implies (force (and (not (rw.ccstep->contradiction x))
+                         (rw.ccstepp x)))
+             (equal (rw.trace->hypbox (rw.ccstep->trace x))
+                    (rw.ccstep->hypbox x))))
+
+  (defthm forcing-rw.trace->lhs-of-rw.ccstep->trace
+    (implies (force (and (not (rw.ccstep->contradiction x))
+                         (rw.ccstepp x)))
+             (equal (rw.trace->lhs (rw.ccstep->trace x))
+                    (rw.ccstep->term x)))))
+
+
+;; (defthm rw.ccstepp-when-not-consp
+;;   (implies (not (consp x))
+;;            (equal (rw.ccstepp x)
+;;                   nil))
+;;   :hints(("Goal" :in-theory (enable rw.ccstepp))))
+
+;; (defthm consp-of-rw.ccstep
+;;   (equal (consp (rw.ccstep term hypbox contradiction trace))
+;;          t)
+;;   :hints(("Goal" :in-theory (enable rw.ccstep))))
+
+
+
+(deflist rw.ccstep-listp (x)
+  (rw.ccstepp x)
+  :elementp-of-nil nil)
+
+(deflist rw.ccstep-list-listp (x)
+  (rw.ccstep-listp x)
+  :elementp-of-nil t)
+
+(defprojection :list (rw.ccstep-list-terms x)
+               :element (rw.ccstep->term x)
+               :guard (rw.ccstep-listp x)
+               :nil-preservingp t)
+
+(defprojection :list (rw.ccstep-list-list-terms x)
+               :element (rw.ccstep-list-terms x)
+               :guard (rw.ccstep-list-listp x)
+               :nil-preservingp t)
+
+(defprojection :list (rw.ccstep-list-hypboxes x)
+               :element (rw.ccstep->hypbox x)
+               :guard (rw.ccstep-listp x)
+               :nil-preservingp t)
+
+(defprojection :list (rw.ccstep-list-list-hypboxes x)
+               :element (rw.ccstep-list-hypboxes x)
+               :guard (rw.ccstep-list-listp x)
+               :nil-preservingp t)
+
+
+
+
+(defsection rw.ccstep-list-gather-traces
+
+  (defund rw.ccstep-list-gather-traces (x)
+    ;; BOZO tail-recursive version?
+    (declare (xargs :guard (rw.ccstep-listp x)))
+    (if (consp x)
+        (if (rw.ccstep->contradiction (car x))
+            (rw.ccstep-list-gather-traces (cdr x))
+          (cons (rw.ccstep->trace (car x))
+                (rw.ccstep-list-gather-traces (cdr x))))
+      nil))
+
+  (defthm rw.ccstep-list-gather-traces-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.ccstep-list-gather-traces x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-gather-traces))))
+
+  (defthm rw.ccstep-list-gather-traces-of-cons
+    (equal (rw.ccstep-list-gather-traces (cons a x))
+           (if (rw.ccstep->contradiction a)
+               (rw.ccstep-list-gather-traces x)
+             (cons (rw.ccstep->trace a)
+                   (rw.ccstep-list-gather-traces x))))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-gather-traces))))
+
+  (defthm true-listp-of-rw.ccstep-list-gather-traces
+    (equal (true-listp (rw.ccstep-list-gather-traces x))
+           t)
+    :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+(defsection rw.ccstep-list-list-gather-traces
+
+  (defund rw.ccstep-list-list-gather-traces (x)
+    ;; BOZO tail-recursive version?
+    (declare (xargs :guard (rw.ccstep-list-listp x)))
+    (if (consp x)
+        (fast-app (rw.ccstep-list-gather-traces (car x))
+                  (rw.ccstep-list-list-gather-traces (cdr x)))
+      nil))
+
+  (defthm rw.ccstep-list-list-gather-traces-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.ccstep-list-list-gather-traces x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-list-gather-traces))))
+
+  (defthm true-listp-of-rw.ccstep-list-list-gather-traces
+    (equal (true-listp (rw.ccstep-list-list-gather-traces x))
+           t)
+    :hints(("Goal"
+            :expand (rw.ccstep-list-list-gather-traces x)
+            :induct (cdr-induction x))))
+
+  (defthm rw.ccstep-list-list-gather-traces-of-cons
+    (equal (rw.ccstep-list-list-gather-traces (cons a x))
+           (app (rw.ccstep-list-gather-traces a)
+                (rw.ccstep-list-list-gather-traces x)))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-list-gather-traces)))))
+
+
+
+(defsection rw.ccstep-list-gather-contradictions
+
+  (defund rw.ccstep-list-gather-contradictions (x)
+    ;; BOZO tail-recursive version?
+    (declare (xargs :guard (rw.ccstep-listp x)))
+    (if (consp x)
+        (if (rw.ccstep->contradiction (car x))
+            (cons (rw.ccstep->contradiction (car x))
+                  (rw.ccstep-list-gather-contradictions (cdr x)))
+          (rw.ccstep-list-gather-contradictions (cdr x)))
+      nil))
+
+  (defthm rw.ccstep-list-gather-contradictions-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.ccstep-list-gather-contradictions x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-gather-contradictions))))
+
+  (defthm rw.ccstep-list-gather-contradictions-of-cons
+    (equal (rw.ccstep-list-gather-contradictions (cons a x))
+           (if (rw.ccstep->contradiction a)
+               (cons (rw.ccstep->contradiction a)
+                     (rw.ccstep-list-gather-contradictions x))
+             (rw.ccstep-list-gather-contradictions x)))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-gather-contradictions))))
+
+  (defthm true-listp-of-rw.ccstep-list-gather-contradictions
+    (equal (true-listp (rw.ccstep-list-gather-contradictions x))
+           t)
+    :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+(defsection rw.ccstep-list-list-gather-contradictions
+
+  (defund rw.ccstep-list-list-gather-contradictions (x)
+    ;; BOZO tail-recursive version?
+    (declare (xargs :guard (rw.ccstep-list-listp x)))
+    (if (consp x)
+        (fast-app (rw.ccstep-list-gather-contradictions (car x))
+                  (rw.ccstep-list-list-gather-contradictions (cdr x)))
+      nil))
+
+ (defthm rw.ccstep-list-list-gather-contradictions-when-not-consp
+   (implies (not (consp x))
+            (equal (rw.ccstep-list-list-gather-contradictions x)
+                   nil))
+   :hints(("Goal" :in-theory (enable rw.ccstep-list-list-gather-contradictions))))
+
+ (defthm true-listp-of-rw.ccstep-list-list-gather-contradictions
+   (equal (true-listp (rw.ccstep-list-list-gather-contradictions x))
+          t)
+   :hints(("Goal"
+           :expand (rw.ccstep-list-list-gather-contradictions x)
+           :induct (cdr-induction x))))
+
+ (defthm rw.ccstep-list-list-gather-contradictions-of-cons
+   (equal (rw.ccstep-list-list-gather-contradictions (cons a x))
+          (app (rw.ccstep-list-gather-contradictions a)
+               (rw.ccstep-list-list-gather-contradictions x)))
+   :hints(("Goal" :in-theory (enable rw.ccstep-list-list-gather-contradictions)))))
+
+
+
+
+
+(definlined rw.ccstep->provedp (x)
+  ;; Did this step prove the clause?  That is, did we notice a contradictory
+  ;; assms or rewrite t1 into an obviously true literal?
+  (declare (xargs :guard (rw.ccstepp x)))
+    (if (rw.ccstep->contradiction x)
+        t
+      (clause.obvious-termp (rw.trace->rhs (rw.ccstep->trace x)))))
+
+(definlined rw.ccstep->terminalp (x)
+  ;; Was this our final step?  That is, did we prove the clause, or run out
+  ;; of literals to rewrite?
+  (declare (xargs :guard (rw.ccstepp x)))
+    (if (rw.ccstep->contradiction x)
+        t
+      (or (clause.obvious-termp (rw.trace->rhs (rw.ccstep->trace x)))
+          (not (rw.hypbox->left (rw.ccstep->hypbox x))))))
+
+(defthm rw.ccstep->terminalp-when-rw.ccstep->provedp
+  (implies (rw.ccstep->provedp x)
+           (equal (rw.ccstep->terminalp x)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep->terminalp rw.ccstep->provedp))))
+
+(definlined rw.ccstep->original-goal (x)
+  ;; What formula was this step originally intended to prove?
+  (declare (xargs :guard (rw.ccstepp x)))
+  (let* ((t1     (rw.ccstep->term x))
+         (hypbox (rw.ccstep->hypbox x))
+         (t2-tn  (rw.hypbox->left hypbox))
+         (todo   (cons t1 t2-tn))
+         (done   (rw.hypbox->right hypbox)))
+    (if (consp done)
+        (logic.por (clause.clause-formula todo)
+                   (clause.clause-formula done))
+      (clause.clause-formula todo))))
+
+(definlined rw.ccstep->result-goal (x)
+  ;; What will be the goal formula for the next step, after taking this one?
+  ;; (We assume this step did not prove the clause.)
+  (declare (xargs :guard (and (rw.ccstepp x)
+                              (not (rw.ccstep->provedp x)))
+                  :guard-hints (("Goal" :in-theory (enable rw.ccstep->provedp)))))
+  (let* ((hypbox   (rw.ccstep->hypbox x))
+         (trace    (rw.ccstep->trace x))
+         (t1-prime (rw.trace->rhs trace))
+         (t2-tn    (rw.hypbox->left hypbox))
+         (done     (rw.hypbox->right hypbox)))
+    (if (consp t2-tn)
+        (logic.por (clause.clause-formula t2-tn)
+                   (clause.clause-formula (cons t1-prime done)))
+      (clause.clause-formula (cons t1-prime done)))))
+
+(definlined rw.ccstep->clause-prime (x)
+  ;; Given a terminal step, what is the "fully reduced clause" that remains to
+  ;; be proved?
+  (declare (xargs :guard (and (rw.ccstepp x)
+                              ;; BOZO Trying to remove: (rw.ccstep->terminalp x)
+                              )))
+  (let ((hypbox        (rw.ccstep->hypbox x))
+        (contradiction (rw.ccstep->contradiction x))
+        (trace         (rw.ccstep->trace x)))
+    (cond (contradiction
+           ;; Proved it, clause-prime is empty
+           nil)
+          ((clause.obvious-termp (rw.trace->rhs trace))
+           ;; Proved it, clause-prime is empty
+           nil)
+          (t
+           ;; Didn't prove it, done list is just the nhyps-right.
+           (cons (rw.trace->rhs trace)
+                 (rw.hypbox->right hypbox))))))
+
+(defthm booleanp-of-rw.ccsetp->provedp
+  ;; BOZO misnamed
+  (equal (booleanp (rw.ccstep->provedp x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.ccstep->provedp))))
+
+(defthm forcing-logic.term-listp-of-rw.ccstep->clause-prime
+  (implies (force (rw.ccstepp x))
+           (equal (logic.term-listp (rw.ccstep->clause-prime x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep->clause-prime))))
+
+(defthm forcing-true-listp-of-rw.ccstep->clause-prime
+  (implies (force (rw.ccstepp x))
+           (equal (true-listp (rw.ccstep->clause-prime x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep->clause-prime))))
+
+(defthm forcing-rw.ccstep->result-goal-when-rw.ccstep->terminalp
+  (implies (and (rw.ccstep->terminalp x)
+                (not (rw.ccstep->provedp x))
+                (force (rw.ccstepp x)))
+           (equal (rw.ccstep->result-goal x)
+                  (clause.clause-formula (rw.ccstep->clause-prime x))))
+  :hints(("Goal" :in-theory (enable rw.ccstep->result-goal
+                                    rw.ccstep->terminalp
+                                    rw.ccstep->provedp
+                                    rw.ccstep->clause-prime))))
+
+(definlined rw.ccstep->t1prime (x)
+  ;; What did t1 rewrite to?  (We assume x is not a provedp step)
+  (declare (xargs :guard (and (rw.ccstepp x)
+                              (not (rw.ccstep->provedp x)))
+                  :guard-hints (("Goal" :in-theory (enable rw.ccstep->provedp)))))
+  (rw.trace->rhs (rw.ccstep->trace x)))
+
+(defthm forcing-logic.termp-of-rw.ccstep->t1prime
+  (implies (force (and (rw.ccstepp x)
+                       (not (rw.ccstep->provedp x))))
+           (equal (logic.termp (rw.ccstep->t1prime x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep->provedp rw.ccstep->t1prime))))
+
+(defthm forcing-logic.term-atblp-of-rw.ccstep->t1prime
+  (implies (force (rw.trace-atblp (rw.ccstep->trace x) atbl))
+           (equal (logic.term-atblp (rw.ccstep->t1prime x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep->provedp rw.ccstep->t1prime))))
+
+
+
+
+
+
+;; Collecting forced hyps from ccsteps
+;;
+;; We now introduce the simple functions to extract the forced goals out of our
+;; list of ccsteps.  We have put in a little effort to make this efficient, so
+;; this is slightly long due to introducing fast functions and proving
+;; equivalences.  Sorry.
+
+(defsection rw.ccstep-forced-goals
+
+  (definlined rw.ccstep-forced-goals (x)
+    (declare (xargs :guard (rw.ccstepp x)
+                    :guard-hints (("Goal" :in-theory (enable rw.ccstepp)))))
+    (if (rw.ccstep->contradiction x)
+        nil
+      (rw.collect-forced-goals (rw.ccstep->trace x))))
+
+  (defthm true-listp-of-rw.ccstep-forced-goals
+    (equal (true-listp (rw.ccstep-forced-goals x))
+           t)
+    :hints(("Goal" :in-theory (enable rw.ccstep-forced-goals))))
+
+  (defthm rw.ccstep-forced-goals-when-contradiction
+    (implies (rw.ccstep->contradiction x)
+             (equal (rw.ccstep-forced-goals x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.ccstep-forced-goals))))
+
+  (defthm forcing-logic.formula-listp-of-rw.ccstep-forced-goals
+    (implies (force (rw.ccstepp x))
+             (equal (logic.formula-listp (rw.ccstep-forced-goals x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.ccstep-forced-goals))))
+
+  (defthm forcing-logic.formula-list-atblp-of-rw.ccstep-forced-goals
+    (implies (force (and (rw.ccstepp x)
+                         (rw.trace-atblp (rw.ccstep->trace x) atbl)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)))
+             (equal (logic.formula-list-atblp (rw.ccstep-forced-goals x) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.ccstep-forced-goals)))))
+
+
+
+(defsection rw.fast-ccstep-list-forced-goals
+
+  (defund rw.ccstep-list-forced-goals (x)
+    (declare (xargs :guard (rw.ccstep-listp x)))
+    (if (consp x)
+        (fast-app (rw.ccstep-forced-goals (car x))
+                  (rw.ccstep-list-forced-goals (cdr x)))
+      nil))
+
+  (defthm true-listp-of-rw.crewrite-clause-step-list-forced-goals
+    (equal (true-listp (rw.ccstep-list-forced-goals x))
+           t)
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-forced-goals))))
+
+  (defthm rw.ccstep-list-forced-goals-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.ccstep-list-forced-goals x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-forced-goals))))
+
+  (defthm rw.ccstep-list-forced-goals-of-cons
+    (equal (rw.ccstep-list-forced-goals (cons a x))
+           (app (rw.ccstep-forced-goals a)
+                (rw.ccstep-list-forced-goals x)))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-forced-goals))))
+
+  (defthm rw.ccstep-list-forced-goals-of-list-fix
+    (equal (rw.ccstep-list-forced-goals (list-fix x))
+           (rw.ccstep-list-forced-goals x))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm rw.ccstep-list-forced-goals-of-app
+    (equal (rw.ccstep-list-forced-goals (app x y))
+           (app (rw.ccstep-list-forced-goals x)
+                (rw.ccstep-list-forced-goals y)))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm logic.formula-listp-of-rw.ccstep-list-forced-goals
+    (implies (force (rw.ccstep-listp x))
+             (equal (logic.formula-listp (rw.ccstep-list-forced-goals x))
+                    t))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm logic.formula-list-atblp-of-rw.ccstep-list-forced-goals
+    (implies (force (and (rw.ccstep-listp x)
+                         (rw.trace-list-atblp (rw.ccstep-list-gather-traces x) atbl)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)))
+             (equal (logic.formula-list-atblp (rw.ccstep-list-forced-goals x) atbl)
+                    t))
+    :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+
+(defsection rw.ccstep-list-list-forced-goals
+
+  (defund rw.ccstep-list-list-forced-goals (x)
+    (declare (xargs :guard (rw.ccstep-list-listp x)))
+    (if (consp x)
+        (fast-app (rw.ccstep-list-forced-goals (car x))
+                  (rw.ccstep-list-list-forced-goals (cdr x)))
+      nil))
+
+  (defthm true-listp-of-rw.ccstep-list-list-forced-goals
+    (equal (true-listp (rw.ccstep-list-list-forced-goals x))
+           t)
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-list-forced-goals))))
+
+  (defthm rw.ccstep-list-list-forced-goals-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.ccstep-list-list-forced-goals x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-list-forced-goals))))
+
+  (defthm rw.ccstep-list-list-forced-goals-of-cons
+    (equal (rw.ccstep-list-list-forced-goals (cons a x))
+           (app (rw.ccstep-list-forced-goals a)
+                (rw.ccstep-list-list-forced-goals x)))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list-list-forced-goals))))
+
+  (defthm logic.formula-listp-of-rw.ccstep-list-list-forced-goals
+    (implies (force (rw.ccstep-list-listp x))
+             (equal (logic.formula-listp (rw.ccstep-list-list-forced-goals x))
+                    t))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm logic.formula-list-atblp-of-rw.ccstep-list-list-forced-goals
+    (implies (force (and (rw.ccstep-list-listp x)
+                         (rw.trace-list-atblp (rw.ccstep-list-list-gather-traces x) atbl)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)))
+             (equal (logic.formula-list-atblp (rw.ccstep-list-list-forced-goals x) atbl)
+                    t))
+    :hints(("Goal"
+            :induct (cdr-induction x)))))
+
+
+
+
+(defderiv rw.ccstep-lemma-1
+  :derive (v (v (!= (? t1) nil) L) R)
+  :from   ((proof x (v L (v (!= (? t2) nil) R)))
+           (proof y (v (v L R) (= (iff (? t1) (? t2)) t))))
+  :proof  (@derive
+           ((v L (v (!= (? t2) nil) R))            (@given x))
+           ((v L (v R (!= (? t2) nil)))            (build.disjoined-commute-or @-))
+           ((v (v L R) (!= (? t2) nil))            (build.associativity @-))
+           ((v (v L R) (= (iff (? t1) (? t2)) t))  (@given y))
+           ((v (v L R) (!= (? t1) nil))            (clause.disjoined-substitute-iff-into-literal-bldr @-- @-))
+           ((v (!= (? t1) nil) (v L R))            (build.commute-or @-))
+           ((v (v (!= (? t1) nil) L) R)            (build.associativity @-))))
+
+(defderiv rw.ccstep-lemma-2
+  :derive (v (!= (? t1) nil) L)
+  :from   ((proof x (v L (!= (? t2) nil)))
+           (proof y (v L (= (iff (? t1) (? t2)) t))))
+  :proof  (@derive
+           ((v L (!= (? t2) nil))             (@given x))
+           ((v L (= (iff (? t1) (? t2)) t))   (@given y))
+           ((v L (!= (? t1) nil))             (clause.disjoined-substitute-iff-into-literal-bldr @-- @-))
+           ((v (!= (? t1) nil) L)             (build.commute-or @-))))
+
+(defderiv rw.ccstep-lemma-3
+  :derive (v (!= (? t1) nil) R)
+  :from   ((proof x (v (!= (? t2) nil) R))
+           (proof y (v R (= (iff (? t1) (? t2)) t))))
+  :proof  (@derive
+           ((v (!= (? t2) nil) R)              (@given x))
+           ((v R (!= (? t2) nil))              (build.commute-or @-))
+           ((v R (= (iff (? t1) (? t2)) t))    (@given y))
+           ((v R (!= (? t1) nil))              (clause.disjoined-substitute-iff-into-literal-bldr @-- @-))
+           ((v (!= (? t1) nil) R)              (build.commute-or @-))))
+
+(defderiv rw.ccstep-lemma-4
+  :derive (v (!= (? t1) nil) P)
+  :from   ((proof x (!= (? t2) nil))
+           (proof y (v P (= (iff (? t1) (? t2)) t))))
+  :proof  (@derive
+           ((!= (? t2) nil)                   (@given x))
+           ((v P (!= (? t2) nil))             (build.expansion (@formula P) @-))
+           ((v P (= (iff (? t1) (? t2)) t))   (@given y))
+           ((v P (!= (? t1) nil))             (clause.disjoined-substitute-iff-into-literal-bldr @-- @-))
+           ((v (!= (? t1) nil) P)             (build.commute-or @-))))
+
+
+
+(defsection rw.proved-ccstep-bldr
+
+  (defund@ rw.proved-ccstep-bldr (x defs fproofs)
+    ;; Prove the step's original goal, given a proof of its result goal if necessary.
+    (declare (xargs :guard (and (rw.ccstepp x)
+                                (rw.ccstep->provedp x)
+                                (definition-listp defs)
+                                (or (rw.ccstep->contradiction x)
+                                    (rw.trace-okp (rw.ccstep->trace x) defs))
+                                (logic.appeal-listp fproofs)
+                                (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs)))
+                    :verify-guards nil))
+    (let* ((t1            (rw.ccstep->term x))
+           (hypbox        (rw.ccstep->hypbox x))
+           (contradiction (rw.ccstep->contradiction x))
+           (trace         (rw.ccstep->trace x))
+           (left          (rw.hypbox->left hypbox))
+           (right         (rw.hypbox->right hypbox)))
+      (if contradiction
+          ;; Note: at least one of left or right must be a consp.
+          (if (and (consp left) (consp right))
+              (@derive
+               ((v L R)                       (rw.eqtrace-contradiction-bldr contradiction hypbox))
+               ((v (!= t1 nil) (v L R))       (build.expansion (logic.term-formula t1) @-))
+               ((v (v (!= t1 nil) L) R)       (build.associativity @-)))
+            (@derive
+             (LR                              (rw.eqtrace-contradiction-bldr contradiction hypbox))
+             ((v (!= t1 nil) LR)              (build.expansion (logic.term-formula t1) @-))))
+        (if (or (consp left)
+                (consp right))
+            (let ((lemma (rw.ccstep-lemma-4 (clause.obvious-term-bldr (rw.trace->rhs trace))
+                                            (rw.compile-trace trace defs fproofs))))
+              (if (and (consp left)
+                       (consp right))
+                  ;; Lemma is t1 != nil v (Left v Right)
+                  (build.associativity lemma)
+                ;; Lemma is t1 != nil v [Left | Right]
+                lemma))
+          ;; Else there are no assms.
+          (@derive ((!= t1-prime nil)                         (clause.obvious-term-bldr (rw.trace->rhs trace)))
+                   ((= (iff t1 t1-prime) t)                   (rw.compile-trace trace defs fproofs))
+                   ((!= t1 nil)                               (clause.substitute-iff-into-literal-bldr @-- @-)))))))
+
+  (defobligations rw.proved-ccstep-bldr
+    (rw.eqtrace-contradiction-bldr
+     clause.obvious-term-bldr
+     rw.compile-trace
+     clause.substitute-iff-into-literal-bldr))
+
+  (local (in-theory (enable rw.proved-ccstep-bldr
+                            rw.ccstep->result-goal
+                            rw.ccstep->provedp
+                            rw.ccstep->original-goal
+                            rw.ccstep-forced-goals
+                            rw.hypbox-formula
+                            logic.term-formula
+                            rw.trace-formula
+                            rw.trace-conclusion-formula)))
+
+  (defthm rw.proved-ccstep-bldr-under-iff
+    (iff (rw.proved-ccstep-bldr x defs fproofs)
+         t)
+    :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+  (defthm forcing-logic.appealp-of-rw.proved-ccstep-bldr
+    (implies (force (and (rw.ccstepp x)
+                         (rw.ccstep->provedp x)
+                         (definition-listp defs)
+                         (or (rw.ccstep->contradiction x)
+                             (rw.trace-okp (rw.ccstep->trace x) defs))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs))))
+             (equal (logic.appealp (rw.proved-ccstep-bldr x defs fproofs))
+                    t)))
+
+  (defthm forcing-logic.conclusion-of-rw.proved-ccstep-bldr
+    (implies (force (and (rw.ccstepp x)
+                         (rw.ccstep->provedp x)
+                         (definition-listp defs)
+                         (or (rw.ccstep->contradiction x)
+                             (rw.trace-okp (rw.ccstep->trace x) defs))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs))))
+             (equal (logic.conclusion (rw.proved-ccstep-bldr x defs fproofs))
+                    (rw.ccstep->original-goal x)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm@ forcing-logic.proofp-of-rw.proved-ccstep-bldr
+    (implies (force (and (rw.ccstepp x)
+                         (rw.ccstep->provedp x)
+                         (definition-listp defs)
+                         (if (rw.ccstep->contradiction x)
+                             (rw.eqtrace-atblp (rw.ccstep->contradiction x) atbl)
+                           (and (rw.trace-okp (rw.ccstep->trace x) defs)
+                                (rw.trace-atblp (rw.ccstep->trace x) atbl)
+                                (rw.trace-env-okp (rw.ccstep->trace x) defs thms atbl)))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs))
+                         ;; ---
+                         (logic.term-atblp (rw.ccstep->term x) atbl)
+                         (rw.hypbox-atblp (rw.ccstep->hypbox x) atbl)
+                         (logic.proof-listp fproofs axioms thms atbl)
+                         (logic.formula-list-atblp defs atbl)
+                         (subsetp defs axioms)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)
+                         (equal (cdr (lookup 'if atbl)) 3)
+                         (@obligations rw.proved-ccstep-bldr)))
+             (equal (logic.proofp (rw.proved-ccstep-bldr x defs fproofs) axioms thms atbl)
+                    t)))
+
+  (verify-guards rw.proved-ccstep-bldr))
+
+
+
+
+(defsection rw.usual-ccstep-bldr
+
+  (defund@ rw.usual-ccstep-bldr (x defs proof fproofs)
+    ;; Prove the step's original goal, given a proof of its result goal if necessary.
+    (declare (xargs :guard (and (rw.ccstepp x)
+                                (not (rw.ccstep->provedp x))
+                                (definition-listp defs)
+                                (rw.trace-okp (rw.ccstep->trace x) defs)
+                                (logic.appealp proof)
+                                (equal (logic.conclusion proof) (rw.ccstep->result-goal x))
+                                (logic.appeal-listp fproofs)
+                                (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs)))
+                    :verify-guards nil))
+    (let* ((hypbox        (rw.ccstep->hypbox x))
+           (trace         (rw.ccstep->trace x))
+           (left          (rw.hypbox->left hypbox))
+           (right         (rw.hypbox->right hypbox)))
+      (cond ((and (consp left) (consp right))
+             (rw.ccstep-lemma-1 proof (rw.compile-trace trace defs fproofs)))
+            ((consp left)
+             (rw.ccstep-lemma-2 proof (rw.compile-trace trace defs fproofs)))
+            ((consp right)
+             (rw.ccstep-lemma-3 proof (rw.compile-trace trace defs fproofs)))
+            (t
+             (@derive ((!= t1-prime nil)                    (@given proof))
+                      ((= (iff t1 t1-prime) t)              (rw.compile-trace trace defs fproofs))
+                      ((!= t1 nil)                          (clause.substitute-iff-into-literal-bldr @-- @-)))))))
+
+  (defobligations rw.usual-ccstep-bldr
+    (rw.compile-trace
+     clause.substitute-iff-into-literal-bldr))
+
+  (local (in-theory (enable rw.usual-ccstep-bldr
+                            rw.ccstep->result-goal
+                            rw.ccstep->provedp
+                            rw.ccstep->original-goal
+                            rw.ccstep-forced-goals
+                            rw.hypbox-formula
+                            logic.term-formula
+                            rw.trace-formula
+                            rw.trace-conclusion-formula)))
+
+  (defthm rw.usual-ccstep-bldr-under-iff
+    (iff (rw.usual-ccstep-bldr x defs proof fproofs)
+         t)
+    :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+  (defthm forcing-logic.appealp-of-rw.usual-ccstep-bldr
+    (implies (force (and (rw.ccstepp x)
+                         (definition-listp defs)
+                         (not (rw.ccstep->provedp x))
+                         (rw.trace-okp (rw.ccstep->trace x) defs)
+                         (logic.appealp proof)
+                         (equal (logic.conclusion proof) (rw.ccstep->result-goal x))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs))))
+             (equal (logic.appealp (rw.usual-ccstep-bldr x defs proof fproofs))
+                    t)))
+
+  (defthm forcing-logic.conclusion-of-rw.usual-ccstep-bldr
+    (implies (force (and (rw.ccstepp x)
+                         (definition-listp defs)
+                         (not (rw.ccstep->provedp x))
+                         (rw.trace-okp (rw.ccstep->trace x) defs)
+                         (logic.appealp proof)
+                         (equal (logic.conclusion proof) (rw.ccstep->result-goal x))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs))))
+             (equal (logic.conclusion (rw.usual-ccstep-bldr x defs proof fproofs))
+                    (rw.ccstep->original-goal x)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm@ forcing-logic.proofp-of-rw.usual-ccstep-bldr
+    (implies (force (and (rw.ccstepp x)
+                         (definition-listp defs)
+                         (not (rw.ccstep->provedp x))
+                         (rw.trace-okp (rw.ccstep->trace x) defs)
+                         (rw.trace-okp (rw.ccstep->trace x) defs)
+                         (rw.trace-atblp (rw.ccstep->trace x) atbl)
+                         (rw.trace-env-okp (rw.ccstep->trace x) defs thms atbl)
+                         (logic.appealp proof)
+                         (equal (logic.conclusion proof) (rw.ccstep->result-goal x))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs))
+                         (logic.appealp proof)
+                         (equal (logic.conclusion proof) (rw.ccstep->result-goal x))
+                         (logic.proofp proof axioms thms atbl)
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-forced-goals x) (logic.strip-conclusions fproofs))
+                         ;; ---
+                         (logic.term-atblp (rw.ccstep->term x) atbl)
+                         (rw.hypbox-atblp (rw.ccstep->hypbox x) atbl)
+                         (logic.proof-listp fproofs axioms thms atbl)
+                         (logic.formula-list-atblp defs atbl)
+                         (subsetp defs axioms)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)
+                         (equal (cdr (lookup 'if atbl)) 3)
+                         (@obligations rw.usual-ccstep-bldr)))
+             (equal (logic.proofp (rw.usual-ccstep-bldr x defs proof fproofs) axioms thms atbl)
+                    t)))
+
+  (verify-guards rw.usual-ccstep-bldr))
+
+
+
+
+(defund rw.ccstep-list->original-goal (x)
+  ;; We say the original goal for a list of steps is the original goal of the
+  ;; final step.
+  (declare (xargs :guard (and (consp x)
+                              (rw.ccstep-listp x))))
+  (if (and (consp x)
+           (consp (cdr x)))
+      (rw.ccstep-list->original-goal (cdr x))
+    (rw.ccstep->original-goal (car x))))
+
+
+
+(defsection rw.ccstep-list->none-provedp
+
+  (defund rw.ccstep-list->none-provedp (x)
+    (declare (xargs :guard (rw.ccstep-listp x)))
+    (if (consp x)
+        (and (not (rw.ccstep->provedp (car x)))
+             (rw.ccstep-list->none-provedp (cdr x)))
+      t))
+
+  (defthm rw.ccstep-list->none-provedp-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.ccstep-list->none-provedp x)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list->none-provedp))))
+
+  (defthm rw.ccstep-list->none-provedp-of-cons
+    (equal (rw.ccstep-list->none-provedp (cons a x))
+           (and (not (rw.ccstep->provedp a))
+                (rw.ccstep-list->none-provedp x)))
+    :hints(("Goal" :in-theory (enable rw.ccstep-list->none-provedp))))
+
+  (defthm booleanp-of-rw.ccstep-list->none-provedp
+    (equal (booleanp (rw.ccstep-list->none-provedp x))
+           t)
+    :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+(defsection rw.ccstep-list->compatiblep
+
+  (defund rw.ccstep-list->compatiblep (x)
+    (declare (xargs :guard (rw.ccstep-listp x)))
+    (if (and (consp x)
+             (consp (cdr x)))
+        (and (not (rw.ccstep->provedp (second x)))
+             (equal (rw.ccstep->original-goal (first x))
+                    (rw.ccstep->result-goal (second x)))
+             (rw.ccstep-list->compatiblep (cdr x)))
+      t))
+
+  (local (in-theory (enable rw.ccstep-list->compatiblep)))
+
+  (defthm booleanp-of-rw.ccstep-list->compatiblep
+    (equal (booleanp (rw.ccstep-list->compatiblep x))
+           t))
+
+  (defthm rw.ccstep-list->compatiblep-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.ccstep-list->compatiblep x)
+                    t)))
+
+  (defthm rw.ccstep-list->compatiblep-when-not-of-cdr
+    (implies (not (consp (cdr x)))
+             (equal (rw.ccstep-list->compatiblep x)
+                    t))))
+
+
+
+(defsection rw.usual-ccstep-list-bldr
+
+  (defund rw.usual-ccstep-list-bldr (x defs proof fproofs)
+    (declare (xargs :guard (and (consp x)
+                                (rw.ccstep-listp x)
+                                (rw.ccstep-list->none-provedp x)
+                                (rw.ccstep-list->compatiblep x)
+                                (definition-listp defs)
+                                (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                                (logic.appealp proof)
+                                (equal (logic.conclusion proof) (rw.ccstep->result-goal (first x)))
+                                (logic.appeal-listp fproofs)
+                                (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs)))
+                    :verify-guards nil))
+    (if (and (consp x)
+             (consp (cdr x)))
+        (rw.usual-ccstep-list-bldr (cdr x)
+                                   defs
+                                   (rw.usual-ccstep-bldr (car x) defs proof fproofs)
+                                   fproofs)
+      (rw.usual-ccstep-bldr (car x) defs proof fproofs)))
+
+  (defobligations rw.usual-ccstep-list-bldr
+    (rw.usual-ccstep-bldr))
+
+  (local (in-theory (enable rw.usual-ccstep-list-bldr
+                            rw.ccstep->provedp
+                            rw.ccstep-list->compatiblep
+                            rw.ccstep-list->original-goal)))
+
+  (defthm forcing-logic.appealp-of-rw.usual-ccstep-list-bldr
+    (implies (force (and (consp x)
+                         (rw.ccstep-listp x)
+                         (rw.ccstep-list->none-provedp x)
+                         (rw.ccstep-list->compatiblep x)
+                         (definition-listp defs)
+                         (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                         (logic.appealp proof)
+                         (equal (logic.conclusion proof) (rw.ccstep->result-goal (first x)))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs))))
+             (equal (logic.appealp (rw.usual-ccstep-list-bldr x defs proof fproofs))
+                    t)))
+
+  (defthm forcing-logic.conclusion-of-rw.usual-ccstep-list-bldr
+    (implies (force (and (consp x)
+                         (rw.ccstep-listp x)
+                         (rw.ccstep-list->none-provedp x)
+                         (rw.ccstep-list->compatiblep x)
+                         (definition-listp defs)
+                         (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                         (logic.appealp proof)
+                         (equal (logic.conclusion proof) (rw.ccstep->result-goal (first x)))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs))))
+             (equal (logic.conclusion (rw.usual-ccstep-list-bldr x defs proof fproofs))
+                    (rw.ccstep-list->original-goal x)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm@ forcing-logic.proofp-of-rw.usual-ccstep-list-bldr
+    (implies (force (and (consp x)
+                         (rw.ccstep-listp x)
+                         (rw.ccstep-list->none-provedp x)
+                         (rw.ccstep-list->compatiblep x)
+                         (definition-listp defs)
+                         (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                         (rw.trace-list-atblp (rw.ccstep-list-gather-traces x) atbl)
+                         (rw.trace-list-env-okp (rw.ccstep-list-gather-traces x) defs thms atbl)
+                         (logic.appealp proof)
+                         (equal (logic.conclusion proof) (rw.ccstep->result-goal (first x)))
+                         (logic.proofp proof axioms thms atbl)
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs))
+                         ;; ---
+                         (logic.term-list-atblp (rw.ccstep-list-terms x) atbl)
+                         (rw.hypbox-list-atblp (rw.ccstep-list-hypboxes x) atbl)
+                         (logic.proof-listp fproofs axioms thms atbl)
+                         (logic.formula-list-atblp defs atbl)
+                         (subsetp defs axioms)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)
+                         (equal (cdr (lookup 'if atbl)) 3)
+                         (@obligations rw.usual-ccstep-list-bldr)))
+             (equal (logic.proofp (rw.usual-ccstep-list-bldr x defs proof fproofs) axioms thms atbl)
+                    t)))
+
+  (verify-guards rw.usual-ccstep-list-bldr))
+
+
+
+(defsection rw.ccstep-list-bldr
+
+  (defund rw.ccstep-list-bldr (x defs proof fproofs)
+    (declare (xargs :guard (and (consp x)
+                                (rw.ccstep-listp x)
+                                (rw.ccstep-list->compatiblep x)
+                                (definition-listp defs)
+                                (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                                (if (rw.ccstep->provedp (first x))
+                                    (not proof)
+                                  (and (logic.appealp proof)
+                                       (equal (logic.conclusion proof)
+                                              (rw.ccstep->result-goal (first x)))))
+                                (logic.appeal-listp fproofs)
+                                (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs)))
+                    :verify-guards nil))
+    (if (rw.ccstep->provedp (first x))
+        (if (consp (cdr x))
+            (rw.usual-ccstep-list-bldr (cdr x)
+                                       defs
+                                       (rw.proved-ccstep-bldr (first x) defs fproofs)
+                                       fproofs)
+          (rw.proved-ccstep-bldr (first x) defs fproofs))
+      (rw.usual-ccstep-list-bldr x defs proof fproofs)))
+
+  (defobligations rw.ccstep-list-bldr
+    (rw.proved-ccstep-bldr
+     rw.usual-ccstep-list-bldr))
+
+  (local (in-theory (enable rw.ccstep-list-bldr
+                            rw.ccstep-list->compatiblep
+                            rw.ccstep-list->original-goal)))
+
+  (defthmd lemma-1-for-rw.ccstep-list-bldr
+    (implies (rw.ccstep-list->compatiblep x)
+             (equal (rw.ccstep-list->none-provedp (cdr x))
+                    t)))
+
+  (defthmd lemma-2-for-rw.ccstep-list-bldr
+    (implies (rw.ccstep-list->compatiblep x)
+             (equal (rw.ccstep-list->none-provedp x)
+                    (if (consp x)
+                        (not (rw.ccstep->provedp (car x)))
+                      t)))
+    :hints(("goal"
+            :in-theory (disable rw.ccstep-list->compatiblep)
+            :use ((:instance lemma-1-for-rw.ccstep-list-bldr)))))
+
+  (local (in-theory (enable lemma-2-for-rw.ccstep-list-bldr)))
+
+  (defthm forcing-logic.appealp-of-rw.ccstep-list-bldr
+    (implies (force (and (consp x)
+                         (rw.ccstep-listp x)
+                         (rw.ccstep-list->compatiblep x)
+                         (definition-listp defs)
+                         (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                         (if (rw.ccstep->provedp (first x))
+                             (not proof)
+                           (and (logic.appealp proof)
+                                (equal (logic.conclusion proof)
+                                       (rw.ccstep->result-goal (first x)))))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs))))
+             (equal (logic.appealp (rw.ccstep-list-bldr x defs proof fproofs))
+                    t)))
+
+  (defthm forcing-logic.conclusion-of-rw.ccstep-list-bldr
+    (implies (force (and (consp x)
+                         (rw.ccstep-listp x)
+                         (rw.ccstep-list->compatiblep x)
+                         (definition-listp defs)
+                         (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                         (if (rw.ccstep->provedp (first x))
+                             (not proof)
+                           (and (logic.appealp proof)
+                                (equal (logic.conclusion proof)
+                                       (rw.ccstep->result-goal (first x)))))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs))))
+             (equal (logic.conclusion (rw.ccstep-list-bldr x defs proof fproofs))
+                    (rw.ccstep-list->original-goal x)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm@ forcing-logic.proofp-of-rw.ccstep-list-bldr
+    (implies (force (and (consp x)
+                         (rw.ccstep-listp x)
+                         (rw.ccstep-list->compatiblep x)
+                         (definition-listp defs)
+                         (rw.trace-list-okp (rw.ccstep-list-gather-traces x) defs)
+                         (rw.trace-list-atblp (rw.ccstep-list-gather-traces x) atbl)
+                         (rw.trace-list-env-okp (rw.ccstep-list-gather-traces x) defs thms atbl)
+                         (rw.eqtrace-list-atblp (rw.ccstep-list-gather-contradictions x) atbl)
+                         (if (rw.ccstep->provedp (first x))
+                             (not proof)
+                           (and (logic.appealp proof)
+                                (equal (logic.conclusion proof)
+                                       (rw.ccstep->result-goal (first x)))
+                                (logic.proofp proof axioms thms atbl)))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals x) (logic.strip-conclusions fproofs))
+                         ;; ---
+                         (logic.term-list-atblp (rw.ccstep-list-terms x) atbl)
+                         (rw.hypbox-list-atblp (rw.ccstep-list-hypboxes x) atbl)
+                         (logic.proof-listp fproofs axioms thms atbl)
+                         (logic.formula-list-atblp defs atbl)
+                         (subsetp defs axioms)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)
+                         (equal (cdr (lookup 'if atbl)) 3)
+                         (@obligations rw.ccstep-list-bldr)))
+             (equal (logic.proofp (rw.ccstep-list-bldr x defs proof fproofs) axioms thms atbl)
+                    t)))
+
+  (verify-guards rw.ccstep-list-bldr))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/cert.acl2 acl2-6.3/books/milawa/ACL2/rewrite/cert.acl2
--- acl2-6.2/books/milawa/ACL2/rewrite/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/cert.acl2	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/controlp.lisp acl2-6.3/books/milawa/ACL2/rewrite/controlp.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/controlp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/controlp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,338 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "theoryp")
+(include-book "syntax-evaluator")
+(include-book "assms/assmctrl")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; A rewriter control is an aggregate of the invariant arguments used by our
+;; rewriters:
+;;
+;;   - A list of function definitions to use during execution,
+;;   - A list of the function names we should not try to execute,
+;;   - A stack depth to use when executing functions,
+;;   - A flag to control whether to use forcing,
+;;   - A flag to control whether or not we should beta-reduce lambdas,
+;;   - A theory for the rewrite rules,
+;;   - Settings for the assumptions system.
+;;
+;; This may be expanded on in the future to support new features, so you should
+;; not assume that these are the only fields.
+
+(defaggregate rw.control
+  (noexec forcingp betamode theory defs depth assmctrl)
+  :require ((logic.function-symbol-listp-of-rw.control->noexec  (logic.function-symbol-listp noexec))
+            (booleanp-of-rw.control->forcingp                   (booleanp forcingp))
+            (symbolp-of-rw.control->betamode                    (symbolp betamode))
+            (rw.theoryp-of-rw.control->theory                   (rw.theoryp theory))
+            (definition-listp-of-rw.control->defs               (definition-listp defs))
+            (natp-of-rw.control->depth                          (natp depth))
+            (rw.assmctrlp-of-rw.control->assmctrl               (rw.assmctrlp assmctrl)))
+  :legiblep nil)
+
+
+(definlined rw.control-atblp (x atbl)
+  (declare (xargs :guard (and (rw.controlp x)
+                              (logic.arity-tablep atbl))))
+  (and (rw.theory-atblp (rw.control->theory x) atbl)
+       (logic.formula-list-atblp (rw.control->defs x) atbl)))
+
+(defthm booleanp-of-rw.control-atblp
+  (equal (booleanp (rw.control-atblp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.control-atblp))))
+
+(defthm forcing-rw.control-atblp-of-rw.control
+  (implies (force (and (rw.theory-atblp theory atbl)
+                       (logic.formula-list-atblp defs atbl)))
+           (equal (rw.control-atblp (rw.control noexec forcingp betamode theory defs depth assmctrl) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.control-atblp))))
+
+(defthm forcing-rw.theory-atblp-of-rw.control->theory
+  (implies (force (rw.control-atblp x atbl))
+           (equal (rw.theory-atblp (rw.control->theory x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.control-atblp))))
+
+(defthm forcing-logic.formula-list-atblp-of-rw.control->defs
+  (implies (force (rw.control-atblp x atbl))
+           (equal (logic.formula-list-atblp (rw.control->defs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.control-atblp))))
+
+
+
+(definlined rw.control-env-okp (x axioms thms)
+  (declare (xargs :guard (and (rw.controlp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms))))
+  (and (subsetp (rw.control->defs x) axioms)
+       (rw.theory-env-okp (rw.control->theory x) thms)))
+
+(defthm booleanp-of-rw.control-env-okp
+  (equal (booleanp (rw.control-env-okp x axioms thms))
+         t)
+  :hints(("Goal" :in-theory (enable rw.control-env-okp))))
+
+(defthm forcing-rw.control-env-okp-of-rw.control
+  (implies (force (and (subsetp defs axioms)
+                       (rw.theory-env-okp theory thms)))
+           (equal (rw.control-env-okp (rw.control noexec forcingp betamode theory defs depth assmctrl) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.control-env-okp))))
+
+(defthm forcing-rw.theory-env-okp-of-rw.control->theory
+  (implies (force (rw.control-env-okp x axioms thms))
+           (equal (rw.theory-env-okp (rw.control->theory x) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.control-env-okp))))
+
+(defthm forcing-subsetp-of-rw.control-defs-and-axioms
+  ;; Well, this is hyper-aggressive.
+  (implies (force (rw.control-env-okp x axioms thms))
+           (equal (subsetp (rw.control->defs x) axioms)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.control-env-okp))))
+
+
+
+
+;; Checking Syntactic Restrictions
+;;
+;; We can add syntactic restrictions to prevent rules from being instantiated
+;; with some sigmas.  Suppose we are trying to use [x1 <- s1, ..., xn <- sn] to
+;; instantiate some rule, and the rule has a syntactic restriction, R.  Such
+;; restrictions are just terms, so say the variables of R are [v1, ..., vm].
+;;
+;; Let [u1, ..., uk] be the vi which do not occur among the xi.  These vars do
+;; not occur in our sigma's domain, so as far as instantiation is concerned, we
+;; can think of sigma as [u1 <- u1, ..., uk <- uk, x1 <- s1, ..., xn <- sn].
+;;
+;; We begin by creating a Grounding Sigma by quoting the range of this new and
+;; extended sigma.  That is, we create:
+;;
+;;   Grounding Sigma = [u1 <- (quote u1), ..., uk <- (quote uk),
+;;                      x1 <- (quote s1), ..., xn <- (quote sn)]
+;;
+;; We now apply this sigma to R.  Observe that this produces a ground term,
+;; since all the variables of R are in the domain of the grounding sigma, and
+;; the range of the grounding sigma is entirely ground terms.  We then evaluate
+;; the resulting term, and we say the restriction is satisfied if the result is
+;; non-nil.
+
+(defund rw.grounding-sigma-fragment (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (cons (car x) (list 'quote (car x)))
+            (rw.grounding-sigma-fragment (cdr x)))
+    nil))
+
+(defthm rw.grounding-sigma-fragment-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.grounding-sigma-fragment x)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.grounding-sigma-fragment))))
+
+(defthm rw.grounding-sigma-fragment-of-cons
+  (equal (rw.grounding-sigma-fragment (cons a x))
+         (cons (cons a (list 'quote a))
+               (rw.grounding-sigma-fragment x)))
+  :hints(("Goal" :in-theory (enable rw.grounding-sigma-fragment))))
+
+(defthm forcing-logic.sigmap-of-rw.grounding-sigma-fragment
+  (implies (force (logic.variable-listp x))
+           (equal (logic.sigmap (rw.grounding-sigma-fragment x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.sigma-atblp-of-rw.grounding-sigma-fragment
+  (implies (force (logic.variable-listp x))
+           (equal (logic.sigma-atblp (rw.grounding-sigma-fragment x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.ground-listp-of-range-of-rw.grounding-sigma-fragment
+  (equal (logic.ground-listp (range (rw.grounding-sigma-fragment x)))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm domain-of-rw.grounding-sigma-fragment
+  (equal (domain (rw.grounding-sigma-fragment x))
+         (list-fix x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.grounding-sigma-fragment-of-list-fix
+  (equal (rw.grounding-sigma-fragment (list-fix x))
+         (rw.grounding-sigma-fragment x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-rw.grounding-sigma-fragment
+  (equal (true-listp (rw.grounding-sigma-fragment x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.grounding-sigma-fragment-of-app
+  (equal (rw.grounding-sigma-fragment (app x y))
+         (app (rw.grounding-sigma-fragment x)
+              (rw.grounding-sigma-fragment y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd rw.grounding-sigma-fragment-of-rev
+  (equal (rw.grounding-sigma-fragment (rev x))
+         (rev (rw.grounding-sigma-fragment x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rev-of-rw.grounding-sigma-fragment
+  (equal (rev (rw.grounding-sigma-fragment x))
+         (rw.grounding-sigma-fragment (rev x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defund rw.aux-extend-grounding-sigma (vars acc)
+  (declare (xargs :guard (and (logic.variable-listp vars)
+                              (logic.sigmap acc))))
+  (if (consp vars)
+      (rw.aux-extend-grounding-sigma (cdr vars)
+                                     (cons (cons (car vars) (list 'quote (car vars))) acc))
+    acc))
+
+(defthm forcing-rw.aux-extend-grounding-sigma-removal
+  (implies (force (true-listp acc))
+           (equal (rw.aux-extend-grounding-sigma vars acc)
+                  (revappend (rw.grounding-sigma-fragment vars) acc)))
+  :hints(("Goal" :in-theory (enable rw.aux-extend-grounding-sigma
+                                    rw.grounding-sigma-fragment))))
+
+
+
+
+(defund rw.extend-grounding-sigma (restriction sigma)
+  (declare (xargs :guard (and (logic.termp restriction)
+                              (logic.sigmap sigma)
+                              (logic.ground-listp (range sigma))
+                              (true-listp sigma))))
+  (let* ((vs (logic.term-vars restriction))
+         (xs (fast-domain$ sigma nil))
+         (us (fast-difference$ vs xs nil)))
+    (rw.aux-extend-grounding-sigma us sigma)))
+
+(defthm forcing-logic.sigmap-of-rw.extend-grounding-sigma
+  (implies (force (and (logic.termp restriction)
+                       (logic.sigmap sigma)
+                       (true-listp sigma)))
+           (equal (logic.sigmap (rw.extend-grounding-sigma restriction sigma))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.extend-grounding-sigma))))
+
+(defthm forcing-logic.sigma-atblp-of-rw.extend-grounding-sigma
+  (implies (force (and (logic.termp restriction)
+                       (logic.sigmap sigma)
+                       (logic.sigma-atblp sigma atbl)
+                       (true-listp sigma)))
+           (equal (logic.sigma-atblp (rw.extend-grounding-sigma restriction sigma) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.extend-grounding-sigma))))
+
+(defthm forcing-logic.ground-listp-of-range-of-rw.extend-grounding-sigma
+  (implies (force (and (logic.termp restriction)
+                       (logic.sigmap sigma)
+                       (logic.ground-listp (range sigma))
+                       (true-listp sigma)))
+           (equal (logic.ground-listp (range (rw.extend-grounding-sigma restriction sigma)))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.extend-grounding-sigma))))
+
+(defthm subsetp-of-logic.term-vars-and-domain-of-rw.extend-grounding-sigma
+  (implies (force (true-listp sigma))
+           (equal (subsetp (logic.term-vars restriction)
+                           (domain (rw.extend-grounding-sigma restriction sigma)))
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.extend-grounding-sigma domain-of-rev)
+                                 (rev-of-domain)))))
+
+
+
+(defund rw.aux-rule-syntax-okp (name restrictions partial-grounding-sigma defs depth)
+  (declare (xargs :guard (and (symbolp name)
+                              (logic.term-listp restrictions)
+                              (logic.sigmap partial-grounding-sigma)
+                              (logic.ground-listp (range partial-grounding-sigma))
+                              (true-listp partial-grounding-sigma)
+                              (definition-listp defs)
+                              (natp depth))))
+  (if (consp restrictions)
+      (let* ((grounding-sigma (rw.extend-grounding-sigma (car restrictions) partial-grounding-sigma))
+             (target          (logic.substitute (car restrictions) grounding-sigma))
+             (valuation       (rewrite.syntaxp-evaluator target defs depth)))
+        (if (not valuation)
+            (ACL2::cw "Note: we won't apply ~s0 since we failed to evaluate the syntactic ~
+                       restriction ~q1.~%"
+                      name target)
+          (and (logic.unquote valuation)
+               (rw.aux-rule-syntax-okp name (cdr restrictions) partial-grounding-sigma defs depth))))
+    t))
+
+(defund rw.rule-syntax-okp (rule sigma control)
+  (declare (xargs :guard (and (rw.rulep rule)
+                              (logic.sigmap sigma)
+                              (subsetp (logic.term-vars (rw.rule->lhs rule)) (domain sigma))
+                              (rw.controlp control))))
+  (let ((restrictions (rw.rule->syntax rule)))
+    (if (consp restrictions)
+        (rw.aux-rule-syntax-okp (rw.rule->name rule)
+                                restrictions
+                                (logic.quote-range sigma)
+                                (rw.control->defs control)
+                                (rw.control->depth control))
+      t)))
+
+(defthm booleanp-of-rw.aux-rule-syntax-okp
+  (equal (booleanp (rw.aux-rule-syntax-okp name terms partial-grounding-sigma defs depth))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.aux-rule-syntax-okp)
+                                 ((:executable-counterpart ACL2::force))))))
+
+(defthm booleanp-of-rw.rule-syntax-okp
+  (equal (booleanp (rw.rule-syntax-okp rule sigma control))
+         t)
+  :hints(("Goal" :in-theory (enable rw.rule-syntax-okp))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/crewrite-clause.lisp acl2-6.3/books/milawa/ACL2/rewrite/crewrite-clause.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/crewrite-clause.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/crewrite-clause.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,952 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "ccsteps")
+(include-book "crewrite")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm rw.ccstep->clause-prime-under-iff
+  (iff (rw.ccstep->clause-prime x)
+       (not (rw.ccstep->provedp x)))
+  :hints(("Goal" :in-theory (enable rw.ccstep->clause-prime
+                                    rw.ccstep->provedp))))
+
+(defthm forcing-rw.eqtrace-okp-of-rw.assms->contradiction-and-rw.assms->hypbox-free
+  ;; bozo move to assms
+  (implies (and (equal free (rw.assms->hypbox x))
+                (force (and (rw.assmsp x)
+                            (rw.assms->contradiction x))))
+           (equal (rw.eqtrace-okp (rw.assms->contradiction x) free)
+                  t)))
+
+
+(defthm forcing-rw.eqtrace-atblp-of-rw.assms->contradiction-of-rw.assume-right
+  (implies (force (and (rw.assmsp assms)
+                       (rw.assms-atblp assms atbl)
+                       (logic.termp nhyp)
+                       (logic.term-atblp nhyp atbl)
+                       (or (not (rw.assms->contradiction assms))
+                           (rw.eqtrace-atblp (rw.assms->contradiction assms) atbl))
+                       (rw.assms->contradiction (rw.assume-right nhyp assms))))
+           (equal (rw.eqtrace-atblp (rw.assms->contradiction (rw.assume-right nhyp assms)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.assume-right))))
+
+(defthm forcing-rw.eqtrace-atblp-of-rw.assms->contradiction-of-rw.assume-right-list
+  (implies (force (and (rw.assmsp assms)
+                       (rw.assms-atblp assms atbl)
+                       (logic.term-listp nhyps)
+                       (logic.term-list-atblp nhyps atbl)
+                       (or (not (rw.assms->contradiction assms))
+                           (rw.eqtrace-atblp (rw.assms->contradiction assms) atbl))
+                       (rw.assms->contradiction (rw.assume-right-list nhyps assms))
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (rw.eqtrace-atblp (rw.assms->contradiction (rw.assume-right-list nhyps assms)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.assume-right-list))))
+
+(defthm forcing-rw.eqtrace-atblp-of-rw.assms->contradiction-of-rw.assume-left
+  (implies (force (and (rw.assmsp assms)
+                       (rw.assms-atblp assms atbl)
+                       (logic.termp nhyp)
+                       (logic.term-atblp nhyp atbl)
+                       (or (not (rw.assms->contradiction assms))
+                           (rw.eqtrace-atblp (rw.assms->contradiction assms) atbl))
+                       (rw.assms->contradiction (rw.assume-left nhyp assms))))
+           (equal (rw.eqtrace-atblp (rw.assms->contradiction (rw.assume-left nhyp assms)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.assume-left))))
+
+(defthm forcing-rw.eqtrace-atblp-of-rw.assms->contradiction-of-rw.assume-left-list
+  (implies (force (and (rw.assmsp assms)
+                       (rw.assms-atblp assms atbl)
+                       (logic.term-listp nhyps)
+                       (logic.term-list-atblp nhyps atbl)
+                       (or (not (rw.assms->contradiction assms))
+                           (rw.eqtrace-atblp (rw.assms->contradiction assms) atbl))
+                       (rw.assms->contradiction (rw.assume-left-list nhyps assms))
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (rw.eqtrace-atblp (rw.assms->contradiction (rw.assume-left-list nhyps assms)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.assume-left-list))))
+
+
+
+
+
+;; Taking steps
+;;
+;; It is straightforward to take an individual step and create the ccstep
+;; record of it.
+
+(defsection rw.crewrite-take-step
+
+  (definlined rw.crewrite-take-step (todo done blimit rlimit control n)
+    (declare (xargs :guard (and (consp todo)
+                                (logic.term-listp todo)
+                                (logic.term-listp done)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.controlp control)
+                                (natp n))))
+    (let* ((assms (rw.empty-assms (rw.control->assmctrl control)))
+           (assms (rw.assume-left-list (cdr todo) assms))
+           (assms (rw.assume-right-list done assms))
+           (contr (rw.assms->contradiction assms)))
+      (rw.ccstep (car todo)
+                 (rw.assms->hypbox assms)
+                 contr
+                 (if (not contr)
+                     (rw.crewrite assms (car todo) t blimit rlimit control n)
+                   nil))))
+
+  (local (in-theory (enable rw.crewrite-take-step)))
+
+  (defthm forcing-rw.ccstepp-of-rw.crewrite-take-step
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)))
+             (equal (rw.ccstepp (rw.crewrite-take-step todo done blimit rlimit control n))
+                    t)))
+
+  (defthm forcing-rw.trace-okp-of-rw.ccstep->trace-of-rw.crewrite-take-step
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)))
+             (equal (rw.trace-okp (rw.ccstep->trace (rw.crewrite-take-step todo done blimit rlimit control n))
+                                  (rw.control->defs control))
+                    (not (rw.ccstep->contradiction (rw.crewrite-take-step todo done blimit rlimit control n))))))
+
+  (defthm forcing-rw.trace-atblp-of-rw.ccstep->trace-of-rw.crewrite-take-step
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (logic.term-list-atblp todo atbl)
+                         (logic.term-list-atblp done atbl)
+                         (rw.control-atblp control atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.trace-atblp (rw.ccstep->trace (rw.crewrite-take-step todo done blimit rlimit control n)) atbl)
+                    (not (rw.ccstep->contradiction (rw.crewrite-take-step todo done blimit rlimit control n))))))
+
+  (defthm forcing-rw.ccstep-trace-env-okp-of-rw.ccstep->trace-of-rw.crewrite-take-step
+    (implies (and (consp todo)
+                  (logic.term-listp todo)
+                  (logic.term-listp done)
+                  (rw.controlp control)
+                  (logic.term-list-atblp todo atbl)
+                  (logic.term-list-atblp done atbl)
+                  (rw.control-atblp control atbl)
+                  (rw.control-env-okp control axioms thms)
+                  (equal (cdr (lookup 'not atbl)) 1))
+             (equal (rw.trace-env-okp (rw.ccstep->trace (rw.crewrite-take-step todo done blimit rlimit control n))
+                                      (rw.control->defs control)
+                                      thms atbl)
+                    t)))
+
+  (defthm forcing-rw.eqtrace-atblp-of-rw.ccstep->contradiction-of-rw.crewrite-take-step
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (logic.term-list-atblp todo atbl)
+                         (logic.term-list-atblp done atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.eqtrace-atblp (rw.ccstep->contradiction (rw.crewrite-take-step todo done blimit rlimit control n)) atbl)
+                    (if (rw.ccstep->contradiction (rw.crewrite-take-step todo done blimit rlimit control n))
+                        t
+                      nil))))
+
+  (defthm forcing-logic.term-atblp-of-rw.ccstep->term-of-rw.crewrite-take-step
+    (implies (force (and (consp todo)
+                         (rw.controlp control)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (logic.term-list-atblp todo atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (logic.term-atblp (rw.ccstep->term (rw.crewrite-take-step todo done blimit rlimit control n)) atbl)
+                    t)))
+
+  (defthm forcing-rw.hypbox-atblp-of-rw.ccstep->hypbox-of-rw.crewrite-take-step
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (logic.term-list-atblp todo atbl)
+                         (logic.term-list-atblp done atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.hypbox-atblp (rw.ccstep->hypbox (rw.crewrite-take-step todo done blimit rlimit control n)) atbl)
+                    t))))
+
+
+
+
+;; Rewriting the clause
+;;
+;; We now are finally ready to introduce our main function, which takes steps
+;; until it the clause is proved or has been entirely rewritten.
+
+(defsection rw.crewrite-clause-aux
+
+  (defund rw.crewrite-clause-aux (todo done blimit rlimit control n acc)
+    (declare (xargs :guard (and (logic.term-listp todo)
+                                (logic.term-listp done)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.controlp control)
+                                (natp n)
+                                (rw.ccstep-listp acc))))
+    (if (consp todo)
+        (let ((step1 (rw.crewrite-take-step todo done blimit rlimit control n)))
+          (if (rw.ccstep->provedp step1)
+              (cons step1 acc)
+            (rw.crewrite-clause-aux (cdr todo)
+                                    (cons (rw.ccstep->t1prime step1) done)
+                                    blimit rlimit control n
+                                    (cons step1 acc))))
+      acc))
+
+  (defobligations rw.crewrite-clause-aux
+    (rw.crewrite-take-step))
+
+  (local (in-theory (enable rw.crewrite-clause-aux
+                            rw.ccstep->provedp)))
+
+  (defthm consp-of-rw.crewrite-clause-aux
+    (equal (consp (rw.crewrite-clause-aux todo done blimit rlimit control n acc))
+           (or (consp todo)
+               (consp acc))))
+
+  (defthm forcing-rw.ccstep-listp-of-rw.crewrite-clause-aux
+    (implies (force (and (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (rw.ccstep-listp acc)))
+             (equal (rw.ccstep-listp (rw.crewrite-clause-aux todo done blimit rlimit control n acc))
+                    t)))
+
+  (defthm forcing-rw.trace-list-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-aux
+    (implies (force (and (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (rw.ccstep-listp acc)
+                         (rw.trace-list-okp (rw.ccstep-list-gather-traces acc) (rw.control->defs control))))
+             (equal (rw.trace-list-okp (rw.ccstep-list-gather-traces (rw.crewrite-clause-aux todo done blimit rlimit control n acc))
+                                       (rw.control->defs control))
+                    t)))
+
+  (defthm forcing-rw.trace-list-atblp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-aux
+    (implies (force (and (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (rw.ccstep-listp acc)
+                         (rw.trace-list-atblp (rw.ccstep-list-gather-traces acc) atbl)
+                         (logic.term-list-atblp todo atbl)
+                         (logic.term-list-atblp done atbl)
+                         (rw.control-atblp control atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.trace-list-atblp (rw.ccstep-list-gather-traces (rw.crewrite-clause-aux todo done blimit rlimit control n acc)) atbl)
+                    t)))
+
+  (defthm forcing-rw.trace-list-env-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-aux
+    (implies (force (and (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (rw.ccstep-listp acc)
+                         (rw.trace-list-atblp (rw.ccstep-list-gather-traces acc) atbl)
+                         (rw.trace-list-env-okp (rw.ccstep-list-gather-traces acc)
+                                                (rw.control->defs control)
+                                                thms atbl)
+                         (logic.term-list-atblp todo atbl)
+                         (logic.term-list-atblp done atbl)
+                         (rw.control-atblp control atbl)
+                         (rw.control-env-okp control axioms thms)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.trace-list-env-okp (rw.ccstep-list-gather-traces
+                                            (rw.crewrite-clause-aux todo done blimit rlimit control n acc))
+                                           (rw.control->defs control)
+                                           thms atbl)
+                    t)))
+
+  (local (defthm lemma
+           (implies (and (consp todo)
+                         (consp (cdr todo))
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (not (rw.ccstep->provedp (rw.crewrite-take-step todo done blimit rlimit control n))))
+                    (equal
+                     (rw.ccstep->result-goal
+                      (rw.crewrite-take-step todo done blimit rlimit control n))
+                     (rw.ccstep->original-goal
+                      (rw.crewrite-take-step (cdr todo)
+                                             (cons (rw.ccstep->t1prime
+                                                    (rw.crewrite-take-step todo done blimit rlimit control n))
+                                                   done)
+                                             blimit rlimit control n))))
+           :hints(("Goal"
+                   :in-theory (enable rw.crewrite-take-step
+                                      rw.ccstep->result-goal
+                                      rw.ccstep->original-goal
+                                      rw.ccstep->t1prime
+                                      rw.ccstep->provedp)
+                   :do-not-induct t))))
+
+  (defthm forcing-rw.ccstep-list->compatiblep-of-rw.crewrite-clause-aux
+    (implies (force (and (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (rw.ccstep-listp acc)
+                         (rw.ccstep-list->compatiblep acc)
+                         ;; ---
+                         (or (not (consp todo))
+                             (not (consp acc))
+                             (and (not (rw.ccstep->provedp (first acc)))
+                                  (equal (rw.ccstep->result-goal (first acc))
+                                         (rw.ccstep->original-goal
+                                          (rw.crewrite-take-step todo done blimit rlimit control n)))))))
+             (equal (rw.ccstep-list->compatiblep (rw.crewrite-clause-aux todo done blimit rlimit control n acc))
+                    t))
+    :hints(("Goal"
+            :induct (rw.crewrite-clause-aux todo done blimit rlimit control n acc)
+            :in-theory (enable rw.ccstep-list->compatiblep)
+            :do-not-induct t)))
+
+  (defthm forcing-rw.ccstep-list->original-goal-of-rw.crewrite-clause-aux
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)
+                         (rw.ccstep-listp acc)))
+             (equal (rw.ccstep-list->original-goal (rw.crewrite-clause-aux todo done blimit rlimit control n acc))
+                    (if (consp acc)
+                        (rw.ccstep-list->original-goal acc)
+                      (rw.ccstep->original-goal
+                       (rw.crewrite-take-step todo done blimit rlimit control n)))))
+    :hints(("Goal"
+            :induct (rw.crewrite-clause-aux todo done blimit rlimit control n acc)
+            :in-theory (enable rw.ccstep-list->original-goal))))
+
+;;   (defthm forcing-consp-of-rw.crewrite-clause-aux
+;;     (implies (force (consp todo))
+;;              (equal (consp (rw.crewrite-clause-aux todo done blimit rlimit control n acc))
+;;                     t)))
+
+  (local (defthm lemma2
+           (implies (force (and (rw.controlp control)
+                                (logic.term-listp todo)
+                                (logic.term-listp done)))
+                    (iff (rw.hypbox->left (rw.ccstep->hypbox (rw.crewrite-take-step todo done blimit rlimit control n)))
+                         (consp (cdr todo))))
+           :hints(("Goal" :in-theory (enable rw.crewrite-take-step)))))
+
+  (defthm forcing-rw.ccstep->terminalp-of-car-of-rw.crewrite-clause-aux
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (rw.controlp control)))
+             (equal (rw.ccstep->terminalp (car (rw.crewrite-clause-aux todo done blimit rlimit control n acc)))
+                    t))
+    :hints(("Goal"
+            :induct (rw.crewrite-clause-aux todo done blimit rlimit control n acc)
+            :in-theory (enable rw.ccstep->terminalp
+                               rw.ccstep->provedp)
+            :do-not-induct t)))
+
+  (defthm forcing-rw.eqtrace-list-atblp-of-rw.ccstep-list-gather-contradictions-of-rw.crewrite-clause-aux
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (logic.term-list-atblp todo atbl)
+                         (logic.term-list-atblp done atbl)
+                         (rw.controlp control)
+                         (rw.control-atblp control atbl)
+                         (rw.eqtrace-list-atblp (rw.ccstep-list-gather-contradictions acc) atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.eqtrace-list-atblp (rw.ccstep-list-gather-contradictions (rw.crewrite-clause-aux todo done blimit rlimit control n acc)) atbl)
+                    t)))
+
+  (defthm forcing-logic.term-list-atblp-of-rw.ccstep-list-terms-of-rw.crewrite-clause-aux
+    (implies (force (and (consp todo)
+                         (rw.controlp control)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (logic.term-list-atblp todo atbl)
+                         (logic.term-list-atblp (rw.ccstep-list-terms acc) atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (logic.term-list-atblp (rw.ccstep-list-terms (rw.crewrite-clause-aux todo done blimit rlimit control n acc)) atbl)
+                    t)))
+
+  (defthm forcing-rw.hypbox-list-atblp-of-rw.ccstep-list-hypboxes-of-rw.crewrite-clause-aux
+    (implies (force (and (consp todo)
+                         (logic.term-listp todo)
+                         (logic.term-listp done)
+                         (logic.term-list-atblp todo atbl)
+                         (logic.term-list-atblp done atbl)
+                         (rw.hypbox-list-atblp (rw.ccstep-list-hypboxes acc) atbl)
+                         (rw.controlp control)
+                         (rw.control-atblp control atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.hypbox-list-atblp (rw.ccstep-list-hypboxes (rw.crewrite-clause-aux todo done blimit rlimit control n acc)) atbl)
+                    t))))
+
+
+
+(defsection rw.crewrite-clause
+
+  (definlined rw.crewrite-clause (clause blimit rlimit control n)
+    ;; This is just a simple wrapper for crewrite-clause-aux
+    (declare (xargs :guard (and (logic.term-listp clause)
+                                (consp clause)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.controlp control)
+                                (natp n))))
+    (rw.crewrite-clause-aux clause nil blimit rlimit control n nil))
+
+  (defobligations rw.crewrite-clause
+    (rw.crewrite-clause-aux))
+
+  (local (in-theory (enable rw.crewrite-clause)))
+
+  (defthm forcing-rw.ccstep-listp-of-rw.crewrite-clause
+    (implies (force (and (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)))
+             (equal (rw.ccstep-listp (rw.crewrite-clause clause blimit rlimit control n))
+                    t)))
+
+  (defthm forcing-rw.ccstep-listp-of-rw.crewrite-clause-free
+    (implies (and (equal free (rw.crewrite-clause clause blimit rlimit control n))
+                  (force (and (logic.term-listp clause)
+                              (consp clause)
+                              (rw.controlp control))))
+             (equal (rw.ccstep-listp free)
+                    t)))
+
+  (defthm forcing-rw.trace-list-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause
+    (implies (force (and (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)))
+             (equal (rw.trace-list-okp (rw.ccstep-list-gather-traces (rw.crewrite-clause clause blimit rlimit control n))
+                                       (rw.control->defs control))
+                    t)))
+
+  (defthm forcing-rw.trace-list-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-free
+    (implies (and (equal free (rw.crewrite-clause clause blimit rlimit control n))
+                  (force (and (logic.term-listp clause)
+                              (consp clause)
+                              (rw.controlp control))))
+             (equal (rw.trace-list-okp (rw.ccstep-list-gather-traces free) (rw.control->defs control))
+                    t)))
+
+  (defthm forcing-rw.trace-list-atblp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause
+    (implies (force (and (logic.term-listp clause)
+                         (logic.term-list-atblp clause atbl)
+                         (consp clause)
+                         (rw.controlp control)
+                         (rw.control-atblp control atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.trace-list-atblp (rw.ccstep-list-gather-traces (rw.crewrite-clause clause blimit rlimit control n)) atbl)
+                    t)))
+
+  (defthm forcing-rw.trace-list-atblp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-free
+    (implies (and (equal free (rw.crewrite-clause clause blimit rlimit control n))
+                  (force (and (logic.term-listp clause)
+                              (logic.term-list-atblp clause atbl)
+                              (consp clause)
+                              (rw.controlp control)
+                              (rw.control-atblp control atbl)
+                              (equal (cdr (lookup 'not atbl)) 1))))
+             (equal (rw.trace-list-atblp (rw.ccstep-list-gather-traces free) atbl)
+                    t)))
+
+  (defthm forcing-rw.trace-list-env-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause
+    (implies (force (and (logic.term-listp clause)
+                         (logic.term-list-atblp clause atbl)
+                         (consp clause)
+                         (rw.controlp control)
+                         (rw.control-atblp control atbl)
+                         (rw.control-env-okp control axioms thms)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.trace-list-env-okp (rw.ccstep-list-gather-traces (rw.crewrite-clause clause blimit rlimit control n))
+                                           (rw.control->defs control)
+                                           thms atbl)
+                    t)))
+
+  (defthm forcing-rw.trace-list-env-okp-of-rw.ccstep-list-gather-traces-of-rw.crewrite-clause-free
+    (implies (and (equal free (rw.crewrite-clause clause blimit rlimit control n))
+                  (force (and (logic.term-listp clause)
+                              (logic.term-list-atblp clause atbl)
+                              (consp clause)
+                              (rw.controlp control)
+                              (rw.control-atblp control atbl)
+                              (rw.control-env-okp control axioms thms)
+                              (equal (cdr (lookup 'not atbl)) 1))))
+             (equal (rw.trace-list-env-okp (rw.ccstep-list-gather-traces free)
+                                           (rw.control->defs control)
+                                           thms atbl)
+                    t)))
+
+  (defthm forcing-rw.ccstep-list->compatiblep-of-rw.crewrite-clause
+    (implies (force (and (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)))
+             (equal (rw.ccstep-list->compatiblep (rw.crewrite-clause clause blimit rlimit control n))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.crewrite-clause))))
+
+  (local (defthm lemma
+           (implies (force (and (logic.term-listp clause)
+                                (rw.controlp control)
+                                (consp clause)))
+                    (equal (rw.ccstep->original-goal (rw.crewrite-take-step clause nil blimit rlimit control n))
+                           (clause.clause-formula clause)))
+           :hints(("Goal" :in-theory (enable rw.ccstep->original-goal
+                                             rw.crewrite-take-step)))))
+
+  (defthm forcing-rw.ccstep-list->original-goal-of-rw.crewrite-clause
+    (implies (force (and (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)))
+             (equal (rw.ccstep-list->original-goal (rw.crewrite-clause clause blimit rlimit control n))
+                    (clause.clause-formula clause))))
+
+  (defthm forcing-consp-of-rw.crewrite-clause
+    (implies (force (consp clause))
+             (equal (consp (rw.crewrite-clause clause blimit rlimit control n))
+                    t)))
+
+  (local (defthm lemma2
+           (implies (and (not (rw.ccstep->provedp (car (rw.crewrite-clause clause blimit rlimit control n))))
+                         (force (and (logic.term-listp clause)
+                                     (consp clause)
+                                     (rw.controlp control))))
+                    (equal (rw.ccstep->result-goal (car (rw.crewrite-clause clause blimit rlimit control n)))
+                           (clause.clause-formula
+                            (rw.ccstep->clause-prime
+                             (car (rw.crewrite-clause clause blimit rlimit control n))))))
+           :hints(("Goal" :in-theory (enable rw.crewrite-clause)))))
+
+  (defthm forcing-rw.ccstep->result-goal-of-car-of-cdr-of-rw.crewrite-clause
+    (implies (force (and (not (rw.ccstep->provedp (car (rw.crewrite-clause clause blimit rlimit control n))))
+                         (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)))
+             (equal (rw.ccstep->result-goal (car (rw.crewrite-clause clause blimit rlimit control n)))
+                    (clause.clause-formula
+                     (rw.ccstep->clause-prime
+                      (car (rw.crewrite-clause clause blimit rlimit control n)))))))
+
+  (defthm forcing-rw.ccstep->terminalp-of-car-of-rw.crewrite-clause
+    (implies (force (and (consp clause)
+                         (force (logic.term-listp clause))
+                         (force (rw.controlp control))))
+             (equal (rw.ccstep->terminalp (car (rw.crewrite-clause clause blimit rlimit control n)))
+                    t)))
+
+  (defthm forcing-rw.eqtrace-list-atblp-of-rw.ccstep-list-gather-contradictions-of-rw.crewrite-clause
+    (implies (force (and (consp clause)
+                         (logic.term-listp clause)
+                         (logic.term-list-atblp clause atbl)
+                         (rw.controlp control)
+                         (rw.control-atblp control atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.eqtrace-list-atblp (rw.ccstep-list-gather-contradictions (rw.crewrite-clause clause blimit rlimit control n)) atbl)
+                    t)))
+
+  (defthm forcing-logic.term-list-atblp-of-rw.ccstep-list-terms-of-rw.crewrite-clause
+    (implies (force (and (consp clause)
+                         (rw.controlp control)
+                         (logic.term-listp clause)
+                         (logic.term-list-atblp clause atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (logic.term-list-atblp (rw.ccstep-list-terms (rw.crewrite-clause clause blimit rlimit control n)) atbl)
+                    t)))
+
+  (defthm forcing-rw.hypbox-list-atblp-of-rw.ccstep-list-hypboxes-of-rw.crewrite-clause
+    (implies (force (and (consp clause)
+                         (logic.term-listp clause)
+                         (logic.term-list-atblp clause atbl)
+                         (rw.controlp control)
+                         (rw.control-atblp control atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)))
+             (equal (rw.hypbox-list-atblp (rw.ccstep-list-hypboxes (rw.crewrite-clause clause blimit rlimit control n)) atbl)
+                    t))))
+
+
+
+
+(defsection rw.crewrite-clause-bldr
+
+  (defund rw.crewrite-clause-bldr (clause blimit rlimit control n record proof fproofs)
+    ;; Prove the clause given:
+    ;;  - the same arguments as rw.crewrite-clause,
+    ;;  - the record produced by rw.crewrite-clause,
+    ;;  - a proof of the clause-prime it produced (if it was nonempty), and
+    ;;  - proofs of all the forced goals from the clause-prime
+    (declare (xargs :guard (and (logic.term-listp clause)
+                                (consp clause)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.controlp control)
+                                (natp n)
+                                (equal record (rw.crewrite-clause clause blimit rlimit control n))
+                                (if (not (rw.ccstep->provedp (car record)))
+                                    (and (logic.appealp proof)
+                                         (equal (logic.conclusion proof)
+                                                (clause.clause-formula (rw.ccstep->clause-prime (car record)))))
+                                  (not proof))
+                                (logic.appeal-listp fproofs)
+                                (subsetp (rw.ccstep-list-forced-goals record) (logic.strip-conclusions fproofs)))
+                    :verify-guards nil))
+    (declare (ignore clause blimit rlimit n))
+    (rw.ccstep-list-bldr record (rw.control->defs control) proof fproofs))
+
+  (defobligations rw.crewrite-clause-bldr
+    (rw.crewrite-clause
+     rw.ccstep-list-bldr))
+
+  (local (in-theory (enable rw.crewrite-clause-bldr)))
+
+  (verify-guards rw.crewrite-clause-bldr)
+
+  (defthm forcing-logic.appealp-of-rw.crewrite-clause-bldr
+    (implies (force (and (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)
+                         (equal record (rw.crewrite-clause clause blimit rlimit control n))
+                         (if (not (rw.ccstep->provedp (car record)))
+                             (and (logic.appealp proof)
+                                  (equal (logic.conclusion proof)
+                                         (clause.clause-formula (rw.ccstep->clause-prime (car record)))))
+                           (not proof))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals record) (logic.strip-conclusions fproofs))))
+             (equal (logic.appealp (rw.crewrite-clause-bldr clause blimit rlimit control n record proof fproofs))
+                    t)))
+
+  (defthm forcing-logic.conclusion-of-rw.crewrite-clause-bldr
+    (implies (force (and (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)
+                         (equal record (rw.crewrite-clause clause blimit rlimit control n))
+                         (if (not (rw.ccstep->provedp (car record)))
+                             (and (logic.appealp proof)
+                                  (equal (logic.conclusion proof)
+                                         (clause.clause-formula (rw.ccstep->clause-prime (car record)))))
+                           (not proof))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals record) (logic.strip-conclusions fproofs))))
+             (equal (logic.conclusion (rw.crewrite-clause-bldr clause blimit rlimit control n record proof fproofs))
+                    (clause.clause-formula clause)))
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm@ forcing-logic.proofp-of-rw.crewrite-clause-bldr
+    (implies (force (and (logic.term-listp clause)
+                         (consp clause)
+                         (rw.controlp control)
+                         (equal record (rw.crewrite-clause clause blimit rlimit control n))
+                         (if (not (rw.ccstep->provedp (car record)))
+                             (and (logic.appealp proof)
+                                  (equal (logic.conclusion proof)
+                                         (clause.clause-formula (rw.ccstep->clause-prime (car record))))
+                                  ;; ---
+                                  (logic.proofp proof axioms thms atbl))
+                           (not proof))
+                         (logic.appeal-listp fproofs)
+                         (subsetp (rw.ccstep-list-forced-goals record) (logic.strip-conclusions fproofs))
+                         ;; ---
+                         (logic.proof-listp fproofs axioms thms atbl)
+                         (logic.term-list-atblp clause atbl)
+                         (rw.control-atblp control atbl)
+                         (rw.control-env-okp control axioms thms)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)
+                         (equal (cdr (lookup 'if atbl)) 3)
+                         (@obligations rw.crewrite-clause-bldr)))
+             (equal (logic.proofp (rw.crewrite-clause-bldr clause blimit rlimit control n record proof fproofs) axioms thms atbl)
+                    t))))
+
+
+
+
+(defprojection :list (rw.crewrite-clause-list x blimit rlimit control n)
+               :element (rw.crewrite-clause x blimit rlimit control n)
+               :guard (and (logic.term-list-listp x)
+                           (cons-listp x)
+                           (natp blimit)
+                           (natp rlimit)
+                           (rw.controlp control)
+                           (natp n)))
+
+(defthm forcing-cons-listp-of-rw.crewrite-clause-list
+  (implies (force (cons-listp x))
+           (equal (cons-listp (rw.crewrite-clause-list x blimit rlimit control n))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.ccstep-list-listp-of-rw.crewrite-clause-list
+  (implies (force (and (logic.term-list-listp x)
+                       (cons-listp x)
+                       (rw.controlp control)))
+           (equal (rw.ccstep-list-listp (rw.crewrite-clause-list x blimit rlimit control n))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.ccstep-list-listp-of-rw.crewrite-clause-list-free
+  (implies (and (equal free (rw.crewrite-clause-list x blimit rlimit control n))
+                (force (and (logic.term-list-listp x)
+                            (cons-listp x)
+                            (rw.controlp control))))
+           (equal (rw.ccstep-list-listp free)
+                  t)))
+
+(defthm forcing-rw.trace-list-atblp-of-rw.ccstep-list-list-gather-traces-of-rw.crewrite-clause-list
+  (implies (force (and (logic.term-list-listp x)
+                       (logic.term-list-list-atblp x atbl)
+                       (cons-listp x)
+                       (rw.controlp control)
+                       (rw.control-atblp control atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (rw.trace-list-atblp (rw.ccstep-list-list-gather-traces (rw.crewrite-clause-list x blimit rlimit control n)) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.trace-list-atblp-of-rw.ccstep-list-list-gather-traces-of-rw.crewrite-clause-list-free
+  (implies (and (equal free (rw.crewrite-clause-list x blimit rlimit control n))
+                (force (and (logic.term-list-listp x)
+                            (logic.term-list-list-atblp x atbl)
+                            (cons-listp x)
+                            (rw.controlp control)
+                            (rw.control-atblp control atbl)
+                            (equal (cdr (lookup 'not atbl)) 1))))
+           (equal (rw.trace-list-atblp (rw.ccstep-list-list-gather-traces free) atbl)
+                  t)))
+
+
+
+(defund rw.ccstep-list-list-terminalp (x)
+  (declare (xargs :guard (and (rw.ccstep-list-listp x)
+                              (cons-listp x))))
+  (if (consp x)
+      (and (rw.ccstep->terminalp (car (car x)))
+           (rw.ccstep-list-list-terminalp (cdr x)))
+    t))
+
+(defthm rw.ccstep-list-list-terminalp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.ccstep-list-list-terminalp x)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-list-terminalp))))
+
+(defthm rw.ccstep-list-list-terminalp-of-cons
+  (equal (rw.ccstep-list-list-terminalp (cons a x))
+         (and (rw.ccstep->terminalp (car a))
+              (rw.ccstep-list-list-terminalp x)))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-list-terminalp))))
+
+(defthm rw.ccstep-list-list-terminalp-of-rw.crewrite-clause-list
+  (implies (force (and (cons-listp x)
+                       (logic.term-list-listp x)
+                       (rw.controlp control)))
+           (equal (rw.ccstep-list-list-terminalp (rw.crewrite-clause-list x blimit rlimit control n))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defund rw.ccstep-list-list-obligations (x)
+  (declare (xargs :guard (and (rw.ccstep-list-listp x)
+                              (cons-listp x)
+                              (rw.ccstep-list-list-terminalp x))))
+  (if (consp x)
+      (let* ((entry1       (car x))
+             (entry1-step1 (car entry1)))
+        (if (rw.ccstep->provedp entry1-step1)
+            (rw.ccstep-list-list-obligations (cdr x))
+          (cons (rw.ccstep->clause-prime entry1-step1)
+                (rw.ccstep-list-list-obligations (cdr x)))))
+    nil))
+
+(defthm true-listp-of-rw.ccstep-list-list-obligations
+  (equal (true-listp (rw.ccstep-list-list-obligations x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-list-obligations))))
+
+(defthm forcing-cons-listp-of-rw.ccstep-list-list-obligations
+  (implies (force (and (rw.ccstep-list-listp x)
+                       (cons-listp x)))
+           (equal (cons-listp (rw.ccstep-list-list-obligations x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-list-obligations))))
+
+(defthm forcing-logic.term-list-listp-of-rw.ccstep-list-list-obligations
+  (implies (force (and (rw.ccstep-list-listp x)
+                       (cons-listp x)))
+           (equal (logic.term-list-listp (rw.ccstep-list-list-obligations x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-list-obligations))))
+
+(defthm forcing-logic.term-list-listp-of-rw.ccstep-list-list-obligations-free
+  (implies (force (and (equal free (rw.ccstep-list-list-obligations x))
+                       (rw.ccstep-list-listp x)
+                       (cons-listp x)))
+           (equal (logic.term-list-listp free)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-list-obligations))))
+
+
+(defund rw.crewrite-clause-list-bldr (clauses blimit rlimit control n results proofs fproofs)
+  ;; Prove clauses given:
+  ;;  - the same arguments as rw.crewrite-clause-list,
+  ;;  - the results it produced,
+  ;;  - proofs of the obligations for its results
+  (declare (xargs :guard (and (logic.term-list-listp clauses)
+                              (cons-listp clauses)
+                              (natp blimit)
+                              (natp rlimit)
+                              (rw.controlp control)
+                              (natp n)
+                              (equal results (rw.crewrite-clause-list clauses blimit rlimit control n))
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (rw.ccstep-list-list-obligations results)))
+                              (logic.appeal-listp fproofs)
+                              (subsetp (rw.ccstep-list-list-forced-goals results)
+                                       (logic.strip-conclusions fproofs)))
+                  :verify-guards nil))
+  (if (consp clauses)
+      (let* ((entry1       (car results))
+             (entry1-step1 (car entry1)))
+        (if (rw.ccstep->provedp entry1-step1)
+            ;; We proved clause1 directly; use nil as its input proof
+            (cons (ACL2::prog2$ (ACL2::cw! ";; Compiling winning rewrite for clause ~x0.~%" (fast-len clauses 0))
+                                (rw.crewrite-clause-bldr (car clauses) blimit rlimit control n entry1 nil fproofs))
+                  (rw.crewrite-clause-list-bldr (cdr clauses) blimit rlimit control n (cdr results) proofs fproofs))
+          ;; We need the input proof to prove clause1
+          (cons (ACL2::prog2$ (ACL2::cw! ";; Compiling rewrite for clause ~x0.~%" (fast-len clauses 0))
+                              (rw.crewrite-clause-bldr (car clauses) blimit rlimit control n entry1 (car proofs) fproofs))
+                (rw.crewrite-clause-list-bldr (cdr clauses) blimit rlimit control n (cdr results) (cdr proofs) fproofs))))
+    nil))
+
+(defobligations rw.crewrite-clause-list-bldr
+  (rw.crewrite-clause-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-clause-list-bldr
+                           rw.ccstep-list-list-obligations)))
+
+ (verify-guards rw.crewrite-clause-list-bldr)
+
+ (defthm forcing-logic.appeal-listp-of-rw.crewrite-clause-list-bldr
+   (implies (force (and (logic.term-list-listp clauses)
+                        (cons-listp clauses)
+                        (rw.controlp control)
+                        (equal results (rw.crewrite-clause-list clauses blimit rlimit control n))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (rw.ccstep-list-list-obligations results)))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.ccstep-list-list-forced-goals results)
+                                 (logic.strip-conclusions fproofs))))
+            (equal (logic.appeal-listp (rw.crewrite-clause-list-bldr clauses blimit rlimit control n results proofs fproofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-rw.crewrite-clause-list-bldr
+   (implies (force (and (logic.term-list-listp clauses)
+                        (cons-listp clauses)
+                        (rw.controlp control)
+                        (equal results (rw.crewrite-clause-list clauses blimit rlimit control n))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (rw.ccstep-list-list-obligations results)))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.ccstep-list-list-forced-goals results)
+                                 (logic.strip-conclusions fproofs))))
+            (equal (logic.strip-conclusions (rw.crewrite-clause-list-bldr clauses blimit rlimit control n results proofs fproofs))
+                   (clause.clause-list-formulas clauses)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-rw.crewrite-clause-list-bldr
+   (implies (force (and (logic.term-list-listp clauses)
+                        (cons-listp clauses)
+                        (rw.controlp control)
+                        (equal results (rw.crewrite-clause-list clauses blimit rlimit control n))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (rw.ccstep-list-list-obligations results)))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.ccstep-list-list-forced-goals results)
+                                 (logic.strip-conclusions fproofs))
+                        ;; ---
+                        (logic.term-list-list-atblp clauses atbl)
+                        (rw.control-atblp control atbl)
+                        (rw.control-env-okp control axioms thms)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (logic.proof-listp fproofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations rw.crewrite-clause-list-bldr)))
+            (equal (logic.proof-listp (rw.crewrite-clause-list-bldr clauses blimit rlimit control n results proofs fproofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund rw.crewrite-records-show-progressp (original-goals new-obligations)
+  (declare (xargs :guard (and (logic.term-list-listp original-goals)
+                              (cons-listp original-goals)
+                              (logic.term-list-listp new-obligations)
+                              (cons-listp new-obligations))))
+  ;; If rewriting fails to make any progress, then it leaves each clause intact
+  ;; but reversed.  So, we see if new-obligations are the same as original-goals,
+  ;; except that each is reversed.
+  (if (consp original-goals)
+      (or (not (consp new-obligations))
+          (not (equal (fast-rev (car new-obligations)) (car original-goals)))
+          (rw.crewrite-records-show-progressp (cdr original-goals) (cdr new-obligations)))
+    nil))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/crewrite.lisp acl2-6.3/books/milawa/ACL2/rewrite/crewrite.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/crewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/crewrite.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,2984 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "traces/crewrite-builders")
+(include-book "urewrite")
+(include-book "ancestors")
+(include-book "match-free")
+(include-book "cachep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund four-nats-measure (a b c d)
+  ;; We create the ordinal w^3(1+a) + w^2(1+b) + w*(1+c) + d.  When ord< is
+  ;; applied to such ordinals, the lexiographic ordering of <a, b, c, d> is
+  ;; induced.
+  (declare (xargs :guard t))
+  (cons (cons 3 (+ 1 (nfix a)))
+        (cons (cons 2 (+ 1 (nfix b)))
+              (cons (cons 1 (+ 1 (nfix c)))
+                    (nfix d)))))
+
+(defthm ordp-of-four-nats-measure
+  (equal (ordp (four-nats-measure a b c d))
+         t)
+  :hints(("Goal" :in-theory (enable four-nats-measure ordp))))
+
+(defthm ord<-of-four-nats-measure
+  (equal (ord< (four-nats-measure a1 b1 c1 d1)
+               (four-nats-measure a2 b2 c2 d2))
+         (or (< a1 a2)
+             (and (equal (nfix a1) (nfix a2))
+                  (or (< b1 b2)
+                      (and (equal (nfix b1) (nfix b2))
+                           (or (< c1 c2)
+                               (and (equal (nfix c1) (nfix c2))
+                                    (< d1 d2))))))))
+  :hints(("Goal" :in-theory (enable four-nats-measure ord<))))
+
+
+
+
+
+
+(defsection rw.cresult
+
+  (definlined rw.cresult (data cache alimitedp)
+    (declare (xargs :guard t))
+    (cons data (cons cache alimitedp)))
+
+  (definlined rw.cresult->data (x)
+    (declare (xargs :guard t))
+    (car x))
+
+  (definlined rw.cresult->cache (x)
+    (declare (xargs :guard t))
+    (car (cdr x)))
+
+  (definlined rw.cresult->alimitedp (x)
+    (declare (xargs :guard t))
+    (cdr (cdr x)))
+
+  (local (in-theory (enable rw.cresult
+                            rw.cresult->data
+                            rw.cresult->cache
+                            rw.cresult->alimitedp)))
+
+  (defthm rw.cresult-under-iff
+          (iff (rw.cresult data cache alimitedp)
+               t))
+
+  (defthm rw.cresult->data-of-rw.cresult
+          (equal (rw.cresult->data (rw.cresult data cache alimitedp))
+                 data))
+
+  (defthm rw.cresult->cache-of-rw.cresult
+          (equal (rw.cresult->cache (rw.cresult data cache alimitedp))
+                 cache))
+
+  (defthm rw.cresult->alimitedp-of-rw.cresult
+    (equal (rw.cresult->alimitedp (rw.cresult data cache alimitedp))
+           alimitedp)))
+
+
+(defsection rw.hypresult
+
+  (definlined rw.hypresult (successp traces cache alimitedp)
+    (declare (xargs :guard t))
+    (cons (cons successp traces)
+          (cons cache alimitedp)))
+
+  (definlined rw.hypresult->successp (x)
+    (declare (xargs :guard t))
+    (car (car x)))
+
+  (definlined rw.hypresult->traces (x)
+    (declare (xargs :guard t))
+    (cdr (car x)))
+
+  (definlined rw.hypresult->cache (x)
+    (declare (xargs :guard t))
+    (car (cdr x)))
+
+  (definlined rw.hypresult->alimitedp (x)
+    (declare (xargs :guard t))
+    (cdr (cdr x)))
+
+  (local (in-theory (enable rw.hypresult
+                            rw.hypresult->successp
+                            rw.hypresult->traces
+                            rw.hypresult->cache
+                            rw.hypresult->alimitedp)))
+
+  (defthm rw.hypresult-under-iff
+    (iff (rw.hypresult successp traces cache alimitedp)
+         t))
+
+  (defthm rw.hypresult->successp-of-rw.hypresult
+    (equal (rw.hypresult->successp (rw.hypresult successp traces cache alimitedp))
+           successp))
+
+  (defthm rw.hypresult->traces-of-rw.hypresult
+    (equal (rw.hypresult->traces (rw.hypresult successp traces cache alimitedp))
+           traces))
+
+  (defthm rw.hypresult->cache-of-rw.hypresult
+    (equal (rw.hypresult->cache (rw.hypresult successp traces cache alimitedp))
+           cache))
+
+  (defthm rw.hypresult->alimitedp-of-rw.hypresult
+    (equal (rw.hypresult->alimitedp (rw.hypresult successp traces cache alimitedp))
+           alimitedp)))
+
+
+
+
+
+(defsection invoke-macros
+
+  ;; Our Conditional Rewriter
+  ;;
+  ;; We introduce our rewriter as a clique of mutually recursive functions.  As
+  ;; usual, we begin with a "flag" function encompassing the entire clique, then
+  ;; introduce the individual functions as wrappers for this flag function.
+  ;;
+  ;; We have often wanted to expand our rewriter with new functionality, and
+  ;; sometimes this has required changing its arguments.  For example, in order
+  ;; to support ancestors checking and memoization for free-variable hyps, we
+  ;; needed to add the anstack and memhyps arguments.  Because of the large
+  ;; number of function calls and arguments, we've introduced the following
+  ;; macros which allow us to more easily perform these updates.
+
+  (defmacro rw.crewrite-core$ (term &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.flag-crewrite 'term ,assms ,term nil nil ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.crewrite-core ,assms ,term ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.crewrite-core-list$ (term-list &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.flag-crewrite 'list ,assms ,term-list nil nil ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.crewrite-core-list ,assms ,term-list ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.crewrite-try-rule$ (term rule &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.flag-crewrite 'rule ,assms ,term ,rule nil ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.crewrite-try-rule ,assms ,term ,rule ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.crewrite-try-rules$ (term rules &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.flag-crewrite 'rules ,assms ,term ,rules nil ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.crewrite-try-rules ,assms ,term ,rules ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.crewrite-try-match$ (term rule sigma &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.flag-crewrite 'match ,assms ,term ,rule ,sigma ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.crewrite-try-match ,assms ,term ,rule ,sigma ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.crewrite-try-matches$ (term rule sigmas &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.flag-crewrite 'matches ,assms ,term ,rule ,sigmas ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.crewrite-try-matches ,assms ,term ,rule ,sigmas ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.crewrite-relieve-hyp$ (hyp rule sigma &key flagp (assms 'assms) (cache 'cache) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.flag-crewrite 'hyp ,assms ,hyp ,rule ,sigma ,cache t ,blimit ,rlimit ,anstack ,control)
+      `(rw.crewrite-relieve-hyp ,assms ,hyp ,rule ,sigma ,cache ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.crewrite-relieve-hyps$ (hyps rule sigma &key flagp (assms 'assms) (cache 'cache) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.flag-crewrite 'hyps ,assms ,hyps ,rule ,sigma ,cache t ,blimit ,rlimit ,anstack ,control)
+      `(rw.crewrite-relieve-hyps ,assms ,hyps ,rule ,sigma ,cache ,blimit ,rlimit ,anstack ,control))))
+
+
+
+;; We use ACL2::defun below so that the functions are not exported.
+
+(ACL2::defun rw.rlimit-warn ()
+  (declare (xargs :guard t))
+  (ACL2::cw ";;; rw.rlimit-warn has not been redefined!!"))
+
+(ACL2::defun rw.rlimit-exit (rlimit trace)
+  (declare (xargs :guard t)
+           (ignore rlimit trace))
+  nil)
+
+
+
+;; See also at the end of this file for alternate versions of the core, etc.
+(defconst *rw.crewrite-core*
+  ;; Rewrite a term; returns (list trace new-cache limitedp)
+  '(cond ((logic.constantp x)
+          ;; We don't consult/modify the cache since this is cheap.
+          (let* ((hypbox    (rw.assms->hypbox assms))
+                 (ret-trace (or (and iffp
+                                     (rw.try-ground-simplify hypbox x iffp control))
+                                (rw.fail-trace hypbox x iffp))))
+            (rw.cresult ret-trace cache nil)))
+         ((logic.variablep x)
+          ;; We don't consult/modify the cache since this is cheap.
+          (let* ((ret-trace (or (rw.assumptions-trace assms x iffp)
+                                (rw.fail-trace (rw.assms->hypbox assms) x iffp))))
+            (rw.cresult ret-trace cache nil)))
+         ((and (logic.functionp x)
+               (equal (logic.function-name x) 'if)
+               (equal (len (logic.function-args x)) 3))
+          ;; We don't cache "if" expressions, so there's no need to consult the cache
+          (let* ((args         (logic.function-args x))
+                 (arg1         (first args))
+                 (arg2         (second args))
+                 (arg3         (third args))
+                 (arg1-rw      (rw.crewrite-core$ arg1 :iffp t))
+                 (arg1-trace   (rw.cresult->data arg1-rw))
+                 (arg1-cache   (rw.cresult->cache arg1-rw))
+                 (arg1-limited (rw.cresult->alimitedp arg1-rw))
+                 (arg1-prime   (rw.trace->rhs arg1-trace)))
+            (if (logic.constantp arg1-prime)
+                ;; Here we don't have to use a new cache, because we don't make a new assm
+                ;; We say we are limited if arg2/3 is limited.
+                (if (logic.unquote arg1-prime)
+                    (let* ((arg2-rw      (rw.crewrite-core$ arg2 :cache arg1-cache))
+                           (arg2-trace   (rw.cresult->data arg2-rw))
+                           (arg2-cache   (rw.cresult->cache arg2-rw))
+                           (arg2-limited (rw.cresult->alimitedp arg2-rw))
+                           (ret-trace    (rw.if-specialcase-t-trace arg1-trace arg2-trace arg3)))
+                      (rw.cresult ret-trace arg2-cache arg2-limited))
+                  (let* ((arg3-rw      (rw.crewrite-core$ arg3 :cache arg1-cache))
+                         (arg3-trace   (rw.cresult->data arg3-rw))
+                         (arg3-cache   (rw.cresult->cache arg3-rw))
+                         (arg3-limited (rw.cresult->alimitedp arg3-rw))
+                         (ret-trace    (rw.if-specialcase-nil-trace arg1-trace arg3-trace arg2)))
+                    (rw.cresult ret-trace arg3-cache arg3-limited)))
+              ;; Here we have to start new caches because we make new assumptions.
+              (let* ((arg2-rw      (rw.crewrite-core$ arg2 :cache (rw.empty-cache) :assms (rw.assume-left (logic.function 'not (list arg1-prime)) assms)))
+                     (arg2-trace   (rw.cresult->data arg2-rw))
+                     (arg2-limited (rw.cresult->alimitedp arg2-rw))
+                     (arg3-rw      (rw.crewrite-core$ arg3 :cache (rw.empty-cache) :assms (rw.assume-left arg1-prime assms)))
+                     (arg3-trace   (rw.cresult->data arg3-rw))
+                     (arg3-limited (rw.cresult->alimitedp arg3-rw)))
+                (ACL2::prog2$
+                 ;; free the temp caches we made for the arg rewrites
+                 (ACL2::prog2$ (ACL2::flush-hons-get-hash-table-link (rw.cresult->cache arg2-rw))
+                               (ACL2::flush-hons-get-hash-table-link (rw.cresult->cache arg3-rw)))
+                 (if (equal (rw.trace->rhs arg2-trace) (rw.trace->rhs arg3-trace))
+                     ;; Produced (if x y y); canonicalize to y
+                     (let ((ret-trace (rw.crewrite-if-specialcase-same-trace arg1-trace arg2-trace arg3-trace)))
+                       (rw.cresult ret-trace arg1-cache (and arg2-limited arg3-limited)))
+                   (let* ((general-trace (rw.crewrite-if-generalcase-trace arg1-trace arg2-trace arg3-trace))
+                          (gt-args       (logic.function-args (rw.trace->rhs general-trace))))
+                     (if (and (equal (second gt-args) ''nil)
+                              (equal (third gt-args) ''t))
+                         ;; Produced (if x nil t); canonicalize to (not x)
+                         (let* ((can-trace (rw.negative-if-trace (first gt-args) iffp (rw.assms->hypbox assms)))
+                                (ret-trace (rw.transitivity-trace general-trace can-trace)))
+                           (rw.cresult ret-trace arg1-cache arg1-limited))
+                       ;; Produced (if x' y' z')
+                       (rw.cresult general-trace arg1-cache (or arg1-limited arg2-limited arg3-limited))))))))))
+         ((and (logic.functionp x)
+               (equal (logic.function-name x) 'not)
+               (equal (len (logic.function-args x)) 1))
+          ;; We don't cache "not" expressions, so there's no need to consult the cache
+          (let* ((args          (logic.function-args x))
+                 (arg1          (first args))
+                 (arg1-rw       (rw.crewrite-core$ arg1 :iffp t))
+                 (arg1-trace    (rw.cresult->data arg1-rw))
+                 (arg1-cache    (rw.cresult->cache arg1-rw))
+                 (arg1-limitedp (rw.cresult->alimitedp arg1-rw))
+                 (main-trace    (rw.not-trace arg1-trace iffp))
+                 ;; -- We don't try rules; you shouldn't target "not" with a rewrite rule
+                 ;; -- We don't try evaluation; rw.not-trace already evaluates (not t) and (not nil)
+                 (main-rhs      (rw.trace->rhs main-trace))
+                 ;; I'm not sure if we should use assms here or not, but "why not?"
+                 (assm-trace    (and (not (logic.constantp main-rhs))
+                                     (rw.assumptions-trace assms main-rhs iffp)))
+                 (ret-trace     (rw.maybe-extend-trace main-trace assm-trace))
+                 (ret-limitedp  (if assm-trace
+                                    (and arg1-limitedp (not (logic.constantp (rw.trace->rhs assm-trace))))
+                                  arg1-limitedp)))
+            (rw.cresult ret-trace arg1-cache ret-limitedp)))
+         ((logic.functionp x)
+          ;; Generic handling for other functions than "if".
+          (let* ((name       (logic.function-name x))
+                 (args       (logic.function-args x))
+                 (hypbox     (rw.assms->hypbox assms))
+                 ;; We immediately try evaluation.  Without this, "constant-gathering" rules that
+                 ;; break normal forms can get into loops with outside-in rules.
+                 (eval-trace (and (logic.constant-listp args)
+                                  (rw.try-ground-simplify hypbox x iffp control))))
+            (if eval-trace
+                ;; The term was evaluated.  We know the result is a constant and is canonical under iffp.
+                ;; No more work can be done, so just return it.
+                (rw.cresult eval-trace cache nil)
+              ;; Now we try to use outside-in rewrite rules.
+              (let* ((theory       (rw.control->theory control))
+                     (rulemap      (rw.theory-lookup x theory))
+                     (out-rules    (cdr (lookup 'outside rulemap)))
+                     (out-rw       (rw.crewrite-try-rules$ x out-rules))
+                     (out-trace    (rw.cresult->data out-rw))
+                     (out-cache    (rw.cresult->cache out-rw))
+                     (out-limitedp (rw.cresult->alimitedp out-rw)))
+                (if out-trace
+                    ;; An outside-in rule worked.  We don't have any idea what the result looks like, so
+                    ;; we recur if we're allowed to.
+                    (if (zp rlimit)
+                        (ACL2::prog2$ (rw.rlimit-warn)
+                                      (rw.cresult out-trace out-cache out-limitedp))
+                      (let* ((next-rw       (rw.crewrite-core$ (rw.trace->rhs out-trace) :rlimit (- rlimit 1) :cache out-cache))
+                             (next-trace    (rw.cresult->data next-rw))
+                             (next-cache    (rw.cresult->cache next-rw))
+                             (next-limitedp (rw.cresult->alimitedp next-rw))
+                             (ret-trace     (rw.transitivity-trace out-trace next-trace)))
+                        (rw.cresult ret-trace next-cache next-limitedp)))
+                  ;; Otherwise, no outside-in rules applied.  Rewrite the arguments.
+                  (let* ((args-rw       (rw.crewrite-core-list$ args :iffp nil))
+                         (args-traces   (rw.cresult->data args-rw))
+                         (args-cache    (rw.cresult->cache args-rw))
+                         (args-limited  (rw.cresult->alimitedp args-rw))
+                         (part1-trace   (rw.equiv-by-args-trace hypbox name iffp args-traces)) ;; (f args) == (f args')
+                         (term-prime    (rw.trace->rhs part1-trace))
+                         (args-prime    (logic.function-args term-prime))
+                         (cache-trace   (rw.cache-lookup term-prime iffp args-cache)))
+                    (if cache-trace
+                        ;; (f args') is cached; we assume the result is fully rewritten
+                        (let ((final-trace (rw.transitivity-trace part1-trace cache-trace)))
+                          (rw.cresult final-trace args-cache nil))
+                      (let ((eval-trace (and (logic.constant-listp args-prime)
+                                             (rw.try-ground-simplify hypbox term-prime iffp control))))
+                        (if eval-trace
+                            ;; (f args') can be evaluated; we cache the result
+                            (let ((final-trace (rw.transitivity-trace part1-trace eval-trace))
+                                  (new-cache   (rw.cache-update term-prime eval-trace iffp args-cache)))
+                              (rw.cresult final-trace new-cache nil))
+                          ;; We still might be able to use rules or assms.
+                          (let* ((in-rules       (cdr (lookup 'inside rulemap)))
+                                 ;; The "part2 trace" is the rewrite from (f args') to the result
+                                 ;; Initially it's just a failure trace.  We extend it with rules,
+                                 ;; assumptions, and more rewriting if applicable.
+                                 (part2-trace    (rw.fail-trace hypbox term-prime iffp))
+                                 ;; Maybe we can use some rules to make more progress.
+                                 (in-rw          (rw.crewrite-try-rules$ term-prime in-rules :cache args-cache))
+                                 (in-trace       (rw.cresult->data in-rw))
+                                 (in-cache       (rw.cresult->cache in-rw))
+                                 (in-limitedp    (rw.cresult->alimitedp in-rw))
+                                 (part2-trace    (rw.maybe-extend-trace part2-trace in-trace))
+                                 ;; Maybe we can use an assumption to make more progress.
+                                 (assm-trace     (rw.assumptions-trace assms (rw.trace->rhs part2-trace) iffp))
+                                 (part2-trace    (rw.maybe-extend-trace part2-trace assm-trace))
+                                 ;; Maybe we're allowed to take another pass?
+                                 ;; BOZO -- reconsider how this decision is made.  We may be able to avoid loops in
+                                 ;; some cases by checking for looping rules here somehow.
+                                 (another-passp  (and (or in-trace assm-trace) (not (zp rlimit)))))
+                            (if (not another-passp)
+                                (let* ((final-trace (rw.transitivity-trace part1-trace part2-trace))
+                                       (limitedp    (or args-limited in-limitedp))
+                                       (new-cache   (rw.maybe-update-cache (not limitedp) term-prime part2-trace iffp in-cache)))
+                                  (ACL2::prog2$
+                                   (if (or in-trace assm-trace)
+                                       ;; We call a separate function to print the rlimit warning.  This function
+                                       ;; gets modified with "advise" when we want to debug loops.
+                                       (rw.rlimit-warn)
+                                     nil)
+                                   (rw.cresult final-trace new-cache limitedp)))
+                              (let* ((next-rw       (rw.crewrite-core$ (rw.trace->rhs part2-trace) :rlimit (- rlimit 1) :cache in-cache))
+                                     (next-trace    (rw.cresult->data next-rw))
+                                     (next-cache    (rw.cresult->cache next-rw))
+                                     (next-limitedp (rw.cresult->alimitedp next-rw))
+                                     (part2-trace   (rw.transitivity-trace part2-trace next-trace))
+                                     (final-trace   (rw.transitivity-trace part1-trace part2-trace))
+                                     (new-cache     (ACL2::prog2$ (rw.rlimit-exit rlimit final-trace)
+                                                                  ;; The result is limited only if the next-rw is limited
+                                                                  (rw.maybe-update-cache (not next-limitedp) term-prime part2-trace iffp next-cache))))
+                                (rw.cresult final-trace new-cache next-limitedp)))))))))))))
+         ((logic.lambdap x)
+          (let* ((formals       (logic.lambda-formals x))
+                 (body          (logic.lambda-body x))
+                 (actuals       (logic.lambda-actuals x))
+                 (betamode      (rw.control->betamode control))
+                 (args-rw       (rw.crewrite-core-list$ actuals :iffp nil))
+                 (args-traces   (rw.cresult->data args-rw))
+                 (args-cache    (rw.cresult->cache args-rw))
+                 (args-limitedp (rw.cresult->alimitedp args-rw))
+                 ;; We'll return the best "ret trace" we can come up with.
+                 (hypbox        (rw.assms->hypbox assms))
+                 (ret-trace1    (rw.lambda-equiv-by-args-trace hypbox formals body iffp args-traces))
+                 (term-prime    (rw.trace->rhs ret-trace1))
+                 (args-prime    (logic.lambda-actuals term-prime))
+                 ;; First try evaluation if all the actuals are constants.
+                 (eval-trace    (and (logic.constant-listp args-prime)
+                                     (rw.try-ground-simplify hypbox term-prime iffp control))))
+            (cond (eval-trace
+                   ;; We evaluated the term successfully so it's a constant; nothing more to do.
+                   (let ((final-trace (rw.transitivity-trace ret-trace1 eval-trace)))
+                     (rw.cresult final-trace args-cache nil)))
+                  ((not betamode)
+                   ;; Failed to evaluate and beta-reduction is not allowed.  This typically means we are in a
+                   ;; huge proof and don't want to spend the time to look at lambdas yet.  Don't try anything
+                   ;; else, just return the lambda with its updated actuals.
+                   (rw.cresult ret-trace1 args-cache args-limitedp))
+                  (t
+                   ;; Time to beta-reduce.
+                   (let* ((beta-trace  (rw.beta-reduction-trace hypbox term-prime iffp))
+                          (part1-trace (rw.transitivity-trace ret-trace1 beta-trace)))
+                     ;; We try to recursively rewrite, if we haven't hit the rlimit.  This can be too expensive
+                     ;; in some proofs, so betamode can be set to once to only beta reduction without recursive
+                     ;; rewriting.
+                     (if (or (zp rlimit)
+                             (equal betamode 'once))
+                         (rw.cresult part1-trace args-cache args-limitedp)
+                       (let* ((next-rw       (rw.crewrite-core$ (rw.trace->rhs beta-trace) :rlimit (- rlimit 1) :cache args-cache))
+                              (next-trace    (rw.cresult->data next-rw))
+                              (next-cache    (rw.cresult->cache next-rw))
+                              (next-limitedp (rw.cresult->alimitedp next-rw))
+                              (final-trace   (rw.transitivity-trace part1-trace next-trace)))
+                         (rw.cresult final-trace next-cache next-limitedp))))))))
+         (t nil)))
+
+(defconst *rw.crewrite-list*
+  ;; Rewrite a term list.  Return (list trace-list new-cache limitedp)
+  '(if (consp x)
+       (let* ((term1-rw       (rw.crewrite-core$ (car x)))
+              (term1-trace    (rw.cresult->data term1-rw))
+              (term1-cache    (rw.cresult->cache term1-rw))
+              (term1-limited  (rw.cresult->alimitedp term1-rw))
+              (others-rw      (rw.crewrite-core-list$ (cdr x) :cache term1-cache))
+              (others-traces  (rw.cresult->data others-rw))
+              (others-cache   (rw.cresult->cache others-rw))
+              (others-limited (rw.cresult->alimitedp others-rw)))
+         (rw.cresult (cons term1-trace others-traces)
+                     others-cache
+                     ;; A list of terms is limited when any of them is limited.
+                     (or term1-limited others-limited)))
+     (rw.cresult nil cache nil)))
+
+(defconst *rw.crewrite-rule*
+  ;; Try to use a rule.  Return (list trace/nil new-cache limitedp)
+  '(let ((equiv (rw.rule->equiv rule[s])))
+     (if (not (or (equal equiv 'equal)
+                  (and (equal equiv 'iff) iffp)))
+         (rw.cresult nil cache nil)
+       (let ((match-result (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+         (if (equal 'fail match-result)
+             (rw.cresult nil cache nil)
+           (let ((sigmas (rw.create-sigmas-to-try rule[s] match-result
+                                                  (rw.assms->trueterms assms))))
+             ;; A rule is limited when its matches are limited.
+             (rw.crewrite-try-matches$ x rule[s] sigmas)))))))
+
+(defconst *rw.crewrite-rules*
+  ;; Try to use a list of rules.  Return (list trace/nil new-cache limitedp)
+  '(if (consp rule[s])
+       (let* ((rule1-rw      (rw.crewrite-try-rule$ x (car rule[s])))
+              (rule1-trace   (rw.cresult->data rule1-rw))
+              (rule1-cache   (rw.cresult->cache rule1-rw))
+              (rule1-limited (rw.cresult->alimitedp rule1-rw)))
+         (if rule1-trace
+             rule1-rw
+           (let* ((others-rw      (rw.crewrite-try-rules$ x (cdr rule[s]) :cache rule1-cache))
+                  (others-trace   (rw.cresult->data others-rw))
+                  (others-cache   (rw.cresult->cache others-rw))
+                  (others-limited (rw.cresult->alimitedp others-rw)))
+             (if others-trace
+                 others-rw
+               ;; No rules worked.  The rules are limited if any of them is limited
+               (rw.cresult nil others-cache (or rule1-limited others-limited))))))
+     (rw.cresult nil cache nil)))
+
+(defconst *rw.crewrite-match*
+  ;; Try to use a rule and sigma.  Returns (list trace/nil new-cache limitedp)
+  '(if (not (rw.rule-syntax-okp rule[s] sigma[s] control))
+       (rw.cresult nil cache nil)
+     (let* ((hyps          (rw.rule->hyps rule[s]))
+            (hyps-rw       (rw.crewrite-relieve-hyps$ hyps rule[s] sigma[s]))
+            (hyps-successp (rw.hypresult->successp hyps-rw))
+            (hyps-traces   (rw.hypresult->traces hyps-rw))
+            (hyps-cache    (rw.hypresult->cache hyps-rw))
+            (hyps-limited  (rw.hypresult->alimitedp hyps-rw)))
+       (if hyps-successp
+           (let ((trace (rw.crewrite-rule-trace (rw.assms->hypbox assms) x rule[s] sigma[s] iffp hyps-traces)))
+             (rw.cresult trace hyps-cache nil))
+         (rw.cresult nil hyps-cache hyps-limited)))))
+
+(defconst *rw.crewrite-matches*
+  ;; Try to use a rule and sigma list.  Returns (list trace/nil new-cache limitedp)
+  '(if (consp sigma[s])
+       (let* ((match1-rw      (rw.crewrite-try-match$ x rule[s] (car sigma[s])))
+              (match1-trace   (rw.cresult->data match1-rw))
+              (match1-cache   (rw.cresult->cache match1-rw))
+              (match1-limited (rw.cresult->alimitedp match1-rw)))
+         (if match1-trace
+             match1-rw
+           (let* ((others-rw      (rw.crewrite-try-matches$ x rule[s] (cdr sigma[s]) :cache match1-cache))
+                  (others-trace   (rw.cresult->data others-rw))
+                  (others-cache   (rw.cresult->cache others-rw))
+                  (others-limited (rw.cresult->alimitedp others-rw)))
+             (if others-trace
+                 others-rw
+               ;; No matches worked.  The matches are limited if any of them is limited
+               (rw.cresult nil others-cache (or match1-limited others-limited))))))
+     (rw.cresult nil cache nil)))
+
+(defconst *rw.crewrite-hyp*
+  ;; Try to relieve a hyp.  Returns (list trace/nil new-cache limitedp)
+  '(let ((goal   (logic.substitute (rw.hyp->term x) sigma[s]))
+         (hypbox (rw.assms->hypbox assms)))
+     (or
+      ;; Perhaps the hyp is cached?
+      (let ((cache-trace (rw.cache-lookup goal t cache)))
+        (and cache-trace
+             (let ((rhs (rw.trace->rhs cache-trace)))
+               (cond ((equal rhs ''t)
+                      (rw.cresult cache-trace cache nil))
+                     ((equal rhs ''nil)
+                      (let ((fmode (and (rw.control->forcingp control)
+                                        (rw.hyp->fmode x))))
+                        (cond ((not fmode)
+                               (rw.cresult nil cache nil))
+                              ((equal fmode 'weak)
+                               (rw.cresult nil cache nil))
+                              (t ;; The fmode is strong
+                               (let* ((ret-trace (rw.force-trace hypbox goal))
+                                      (new-cache (rw.cache-update goal ret-trace t cache)))
+                                 (rw.cresult ret-trace new-cache nil))))))
+                     (t
+                      ;; The cache knows something about goal, but not whether it's true or false.
+                      ;; Try to relieve it some other way.
+                      nil)))))
+      ;; Perhaps we can just evaluate the hyp?
+      (let ((eval-trace (and (logic.groundp goal)
+                             (rw.try-ground-simplify hypbox goal t control))))
+        (and eval-trace
+             (cond ((equal (rw.trace->rhs eval-trace) ''t)
+                    (rw.cresult eval-trace cache nil))
+                   (t
+                    (let ((fmode (and (rw.control->forcingp control)
+                                      (rw.hyp->fmode x))))
+                      (cond ((not fmode)
+                             (rw.cresult nil cache nil))
+                            ((equal fmode 'weak)
+                             (rw.cresult nil cache nil))
+                            (t ;; The fmode is strong
+                             (let* ((ret-trace (rw.force-trace hypbox goal))
+                                    (new-cache (rw.cache-update goal ret-trace t cache)))
+                               (rw.cresult ret-trace new-cache nil)))))))))
+      ;; Perhaps we can use assms?
+      (let ((assm-trace (rw.assumptions-trace assms goal t)))
+        (and assm-trace
+             (let ((rhs (rw.trace->rhs assm-trace)))
+               (cond ((equal rhs ''t)
+                      (rw.cresult assm-trace cache nil))
+                     ((equal rhs ''nil)
+                      (let ((fmode (and (rw.control->forcingp control)
+                                        (rw.hyp->fmode x))))
+                        (cond ((not fmode)
+                               (rw.cresult nil cache nil))
+                              ((equal fmode 'weak)
+                               (rw.cresult nil cache nil))
+                              (t ;; The fmode is strong
+                               (let* ((ret-trace (rw.force-trace hypbox goal))
+                                      (new-cache (rw.cache-update goal ret-trace t cache)))
+                                 (rw.cresult ret-trace new-cache nil))))))
+                     (t
+                      ;; The assms know something about goal, but not whether it's true or false.
+                      ;; Try to relieve it some other way.
+                      nil)))))
+      ;; Perhaps we can use backchaining to rewrite the hyp?
+      (cond ((zp blimit)
+             ;; Nope, the backchain limit has already been hit.  At one point, I tried calling
+             ;; urewrite here as a last-ditch effort, but this *doubled* the time crewrite took
+             ;; on some examples.  Now, my strategy is to give up right away unless it's forced,
+             ;; in which case we'll try urewrite so that we force a prettier goal.
+             (if (and (rw.hyp->fmode x)
+                      (rw.control->forcingp control))
+                 (let* ((urw-trace (rw.urewrite goal t control 100))
+                        (new-goal  (rw.trace->rhs urw-trace)))
+                   (cond ((equal new-goal ''t)
+                          (rw.cresult (rw.weakening-trace hypbox urw-trace) cache nil))
+                         ((equal new-goal ''nil)
+                          (rw.cresult nil cache nil))
+                         (t
+                          (let* ((force-trace (rw.force-trace hypbox new-goal))
+                                 (ret-trace   (rw.transitivity-trace (rw.weakening-trace hypbox urw-trace) force-trace))
+                                 (new-cache   (rw.cache-update goal ret-trace t cache)))
+                            (rw.cresult ret-trace new-cache nil)))))
+               (rw.cresult nil cache nil)))
+
+
+            ((rw.ancestors-check goal (list rule[s]) anstack)
+             ;; We are allowed to backchain, but the new goal looks "worse" than something we were
+             ;; trying to prove before.
+             (if (and (rw.hyp->fmode x)
+                      (rw.control->forcingp control))
+                 (let* ((ret-trace (rw.force-trace hypbox goal))
+                        (new-cache (rw.cache-update goal ret-trace t cache)))
+                   (rw.cresult ret-trace new-cache nil))
+               (rw.cresult nil cache t)))
+
+            (t
+             ;; Time to backchain.  If the hyp has a backchain limit and the cache is not yet
+             ;; blocked, we block it until we are finished rewriting.
+             (let* ((must-blockp  (and (rw.hyp->limitp x)
+                                       (not (rw.cache->blockp cache))))
+                    (new-anstack  (cons (rw.anframe goal (list rule[s])) anstack))
+                    (new-blimit   (if (rw.hyp->limitp x)
+                                      (min (rw.hyp->limit x) (- blimit 1))
+                                    (- blimit 1)))
+                    (new-cache    (if must-blockp ;; could use if alias to avoid split
+                                      (rw.set-blockedp t cache)
+                                    cache))
+                    (goal-rw      (rw.crewrite-core$ goal
+                                                     :iffp t
+                                                     :blimit new-blimit
+                                                     :anstack new-anstack
+                                                     :cache new-cache))
+                    (goal-trace   (rw.cresult->data goal-rw))
+                    (goal-cache   (rw.cresult->cache goal-rw))
+                    (goal-limited (rw.cresult->alimitedp goal-rw))
+                    (final-rhs    (rw.trace->rhs goal-trace))
+                    (ret-cache    (if must-blockp ;; could use if alias to avoid split
+                                      (rw.set-blockedp nil goal-cache)
+                                    goal-cache)))
+               (cond ((equal final-rhs ''t)
+                      (rw.cresult goal-trace ret-cache nil))
+                     ((and (rw.hyp->fmode x)
+                           (rw.control->forcingp control))
+                      (let* ((ret-trace (rw.force-trace hypbox goal))
+                             (new-cache (rw.cache-update goal ret-trace t goal-cache)))
+                        (rw.cresult ret-trace new-cache nil)))
+                     (t
+                      (rw.cresult nil ret-cache goal-limited)))))))))
+
+(defconst *rw.crewrite-hyps*
+  ;; Try to relieve a list of hyps.  Returns (list successp trace-list new-cache limitedp).
+  '(if (not (consp x))
+       (rw.hypresult t nil cache nil)
+     (let* ((hyp1-rw      (rw.crewrite-relieve-hyp$ (car x) rule[s] sigma[s]))
+            (hyp1-trace   (rw.cresult->data hyp1-rw))
+            (hyp1-cache   (rw.cresult->cache hyp1-rw))
+            (hyp1-limited (rw.cresult->alimitedp hyp1-rw)))
+       (if (not hyp1-trace)
+           ;; We are being a little conservative here: if hyp1 is limited, it might still be
+           ;; that some other hyp would have failed without being limited.  So, we might prevent
+           ;; some caching, but this way we can stop early and don't have to look at the rest
+           ;; of the hyps.
+           (rw.hypresult nil nil hyp1-cache hyp1-limited)
+         (let* ((others-rw       (rw.crewrite-relieve-hyps$ (cdr x) rule[s] sigma[s] :cache hyp1-cache))
+                (others-successp (rw.hypresult->successp others-rw))
+                (others-traces   (rw.hypresult->traces others-rw))
+                (others-cache    (rw.hypresult->cache others-rw))
+                (others-limited  (rw.hypresult->alimitedp others-rw)))
+           (if others-successp
+               ;; Can't be limited, because everything was successful
+               (rw.hypresult t (cons hyp1-trace others-traces) others-cache nil)
+             ;; Otherwise, we know hyp1 is not limited (it was successful), so we are limited
+             ;; only if one of the others is limited.
+             (rw.hypresult nil nil others-cache others-limited)))))))
+
+(defconst *rw.crewrite-flag-sigma*
+  ;; Substitutions used to generate the flag function's definition.
+  (list (cons '(rw.crewrite-core$ ?x)
+              '(rw.flag-crewrite 'term assms ?x nil nil cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :iffp ?iffp)
+              '(rw.flag-crewrite 'term assms ?x nil nil cache ?iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :rlimit ?rlimit :cache ?cache)
+              '(rw.flag-crewrite 'term assms ?x nil nil ?cache iffp blimit ?rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :cache ?cache)
+              '(rw.flag-crewrite 'term assms ?x nil nil ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :cache ?cache :assms ?assms)
+              '(rw.flag-crewrite 'term ?assms ?x nil nil ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :iffp ?iffp :blimit ?blimit :anstack ?anstack :cache ?cache)
+              '(rw.flag-crewrite 'term assms ?x nil nil ?cache ?iffp ?blimit rlimit ?anstack control))
+        (cons '(rw.crewrite-core-list$ ?x :iffp ?iffp)
+              '(rw.flag-crewrite 'list assms ?x nil nil cache ?iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core-list$ ?x :cache ?cache)
+              '(rw.flag-crewrite 'list assms ?x nil nil ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rule$ ?x ?rules)
+              '(rw.flag-crewrite 'rule assms ?x ?rules nil cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rules$ ?x ?rules)
+              '(rw.flag-crewrite 'rules assms ?x ?rules nil cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rules$ ?x ?rules :cache ?cache)
+              '(rw.flag-crewrite 'rules assms ?x ?rules nil ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-match$ ?x ?rules ?sigmas)
+              '(rw.flag-crewrite 'match assms ?x ?rules ?sigmas cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-matches$ ?x ?rules ?sigmas)
+              '(rw.flag-crewrite 'matches assms ?x ?rules ?sigmas cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-matches$ ?x ?rules ?sigmas :cache ?cache)
+              '(rw.flag-crewrite 'matches assms ?x ?rules ?sigmas ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyp$ ?x ?rules ?sigmas)
+              '(rw.flag-crewrite 'hyp assms ?x ?rules ?sigmas cache t blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyps$ ?x ?rules ?sigmas)
+              '(rw.flag-crewrite 'hyps assms ?x ?rules ?sigmas cache t blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyps$ ?x ?rules ?sigmas :cache ?cache)
+              '(rw.flag-crewrite 'hyps assms ?x ?rules ?sigmas ?cache t blimit rlimit anstack control))))
+
+(defconst *rw.crewrite-noflag-sigma*
+  ;; Substitutions used to generate the flagless :definition rules
+  (list (cons '(rw.crewrite-core$ ?x)
+              '(rw.crewrite-core assms ?x cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :iffp ?iffp)
+              '(rw.crewrite-core assms ?x cache ?iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :rlimit ?rlimit :cache ?cache)
+              '(rw.crewrite-core assms ?x ?cache iffp blimit ?rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :cache ?cache)
+              '(rw.crewrite-core assms ?x ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :cache ?cache :assms ?assms)
+              '(rw.crewrite-core ?assms ?x ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :iffp ?iffp :blimit ?blimit :anstack ?anstack :cache ?cache)
+              '(rw.crewrite-core assms ?x ?cache ?iffp ?blimit rlimit ?anstack control))
+        (cons '(rw.crewrite-core-list$ ?x :iffp ?iffp)
+              '(rw.crewrite-core-list assms ?x cache ?iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core-list$ ?x :cache ?cache)
+              '(rw.crewrite-core-list assms ?x ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rule$ ?x ?rules)
+              '(rw.crewrite-try-rule assms ?x ?rules cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rules$ ?x ?rules)
+              '(rw.crewrite-try-rules assms ?x ?rules cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rules$ ?x ?rules :cache ?cache)
+              '(rw.crewrite-try-rules assms ?x ?rules ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-match$ ?x ?rules ?sigmas)
+              '(rw.crewrite-try-match assms ?x ?rules ?sigmas cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-matches$ ?x ?rules ?sigmas)
+              '(rw.crewrite-try-matches assms ?x ?rules ?sigmas cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-matches$ ?x ?rules ?sigmas :cache ?cache)
+              '(rw.crewrite-try-matches assms ?x ?rules ?sigmas ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyp$ ?x ?rules ?sigmas)
+              '(rw.crewrite-relieve-hyp assms ?x ?rules ?sigmas cache blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyps$ ?x ?rules ?sigmas)
+              '(rw.crewrite-relieve-hyps assms ?x ?rules ?sigmas cache blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyps$ ?x ?rules ?sigmas :cache ?cache)
+              '(rw.crewrite-relieve-hyps assms ?x ?rules ?sigmas ?cache blimit rlimit anstack control))))
+
+
+(ACL2::make-event
+ `(defun rw.flag-crewrite (flag ;; which mode we are in (we're really 8 mutually recursive functions)
+                            assms ;; the current assumptions
+                            x ;; the term we are rewriting (or the hyp we are relieving)
+                            rule[s] ;; the rule (or list of rules) we want to try
+                            sigma[s] ;; the sigma (or sigma list) we want to try (once we've already chosen a rule)
+                            cache ;; rewrite cache to avoid repeated relieve-hyps from match-free
+                            iffp ;; t if we can use iff rules, nil if we can only use equal rules
+                            blimit ;; limit on backchaining depth (how hard may we try to relieving hyps?)
+                            rlimit ;; limit on successful rewrites (how many rules can we successively apply?)
+                            anstack ;; the ancestors stack (used to control backchaining; see ancestors.lisp)
+                            control ;; the rewriter control object (stores rules, definitions, etc.; see controlp.lisp)
+                            )
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control)
+                                (cond ((equal flag 'term)
+                                       (logic.termp x))
+                                      ((equal flag 'list)
+                                       (logic.term-listp x))
+                                      ((equal flag 'match)
+                                       (and (logic.termp x)
+                                            (rw.rulep rule[s])
+                                            (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                                (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                            (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                            (logic.sigmap sigma[s])
+                                            (submapp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])))
+                                      ((equal flag 'matches)
+                                       (and (logic.termp x)
+                                            (rw.rulep rule[s])
+                                            (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                                (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                            (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                            (logic.sigma-listp sigma[s])
+                                            (submap-of-eachp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])))
+                                      ((equal flag 'rule)
+                                       (and (logic.termp x)
+                                            (rw.rulep rule[s])))
+                                      ((equal flag 'rules)
+                                       (and (logic.termp x)
+                                            (rw.rule-listp rule[s])))
+                                      ((equal flag 'hyp)
+                                       (and (rw.hypp x)
+                                            (rw.rulep rule[s])
+                                            (logic.sigmap sigma[s])))
+                                      (t
+                                       (and (equal flag 'hyps)
+                                            (rw.hyp-listp x)
+                                            (rw.rulep rule[s])
+                                            (logic.sigmap sigma[s])))))
+                    :verify-guards nil
+                    :measure (cond ((or (equal flag 'term)
+                                        (equal flag 'list))
+                                    (four-nats-measure rlimit (nfix blimit) 4 (rank x)))
+                                   ((or (equal flag 'rule)
+                                        (equal flag 'rules))
+                                    (four-nats-measure rlimit (nfix blimit) 3 (rank rule[s])))
+                                   ((or (equal flag 'match)
+                                        (equal flag 'matches))
+                                    (four-nats-measure rlimit (nfix blimit) 2 (rank sigma[s])))
+                                   (t
+                                    (four-nats-measure rlimit (nfix blimit) 1 (rank x))))
+                    :hints (("Goal" :in-theory (disable (:executable-counterpart ACL2::force))))))
+    (cond ((equal flag 'term)
+           ,(ACL2::jared-rewrite *rw.crewrite-core* *rw.crewrite-flag-sigma*))
+          ((equal flag 'list)
+           ,(ACL2::jared-rewrite *rw.crewrite-list* *rw.crewrite-flag-sigma*))
+          ((equal flag 'rule)
+           ,(ACL2::jared-rewrite *rw.crewrite-rule* *rw.crewrite-flag-sigma*))
+          ((equal flag 'rules)
+           ,(ACL2::jared-rewrite *rw.crewrite-rules* *rw.crewrite-flag-sigma*))
+          ((equal flag 'match)
+           ,(ACL2::jared-rewrite *rw.crewrite-match* *rw.crewrite-flag-sigma*))
+          ((equal flag 'matches)
+           ,(ACL2::jared-rewrite *rw.crewrite-matches* *rw.crewrite-flag-sigma*))
+          ((equal flag 'hyp)
+           ,(ACL2::jared-rewrite *rw.crewrite-hyp* *rw.crewrite-flag-sigma*))
+          (t
+           ,(ACL2::jared-rewrite *rw.crewrite-hyps* *rw.crewrite-flag-sigma*)))))
+
+
+
+
+(defsection irrelevant-argument-reduction
+
+  ;; Some of the functions do not use all the arguments here, so we provide
+  ;; reduction theorems to show which arguments are irrelevant.
+
+ (local (in-theory (disable (:executable-counterpart ACL2::force))))
+
+ (defthmd rw.flag-crewrite-of-term-reduction
+   (equal (rw.flag-crewrite 'term assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-core$ x :flagp t))
+   :hints(("Goal"
+           :expand ((rw.flag-crewrite 'term assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.crewrite-core$ x :flagp t)))))
+
+ (defthmd rw.flag-crewrite-of-list-reduction
+   (equal (rw.flag-crewrite 'list assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-core-list$ x :flagp t))
+   :hints(("Goal"
+           :expand ((rw.flag-crewrite 'list assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.crewrite-core-list$ x :flagp t)))))
+
+ (defthmd rw.flag-crewrite-of-rule-reduction
+   (equal (rw.flag-crewrite 'rule assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-try-rule$ x rule[s] :flagp t))
+   :hints(("Goal"
+           :expand ((rw.flag-crewrite 'rule assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.crewrite-try-rule$ x rule[s] :flagp t)))))
+
+ (defthmd rw.flag-crewrite-of-rules-reduction
+   (equal (rw.flag-crewrite 'rules assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-try-rules$ x rule[s] :flagp t))
+   :hints(("Goal"
+           :expand ((rw.flag-crewrite 'rules assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.crewrite-try-rules$ x rule[s] :flagp t)))))
+
+ (defthmd rw.flag-crewrite-of-hyp-reduction
+   (equal (rw.flag-crewrite 'hyp assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-relieve-hyp$ x rule[s] sigma[s] :flagp t))
+   :hints(("Goal"
+           :expand ((rw.flag-crewrite 'hyp assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.crewrite-relieve-hyp$ x rule[s] sigma[s] :flagp t)))))
+
+ (defthmd rw.flag-crewrite-of-hyps-reduction
+   (equal (rw.flag-crewrite 'hyps assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-relieve-hyps$ x rule[s] sigma[s] :flagp t))
+   :hints(("Goal"
+           :expand ((rw.flag-crewrite 'hyps assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.crewrite-relieve-hyps$ x rule[s] sigma[s] :flagp t))))))
+
+
+
+(defsection flag-wrapper-functions
+
+  ;; We now introduce wrappers for the various functions inside the nest.
+
+  (definlined rw.crewrite-core (assms x cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (logic.termp x)
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.crewrite-core$ x :flagp t))
+
+  (definlined rw.crewrite-core-list (assms x cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (logic.term-listp x)
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.crewrite-core-list$ x :flagp t))
+
+  (definlined rw.crewrite-try-rule (assms x rule[s] cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (logic.termp x)
+                                (rw.rulep rule[s])
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.crewrite-try-rule$ x rule[s] :flagp t))
+
+  (definlined rw.crewrite-try-rules (assms x rule[s] cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (logic.termp x)
+                                (rw.rule-listp rule[s])
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.crewrite-try-rules$ x rule[s] :flagp t))
+
+  (definlined rw.crewrite-try-match (assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (logic.termp x)
+                                (rw.rulep rule[s])
+                                (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                    (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                (logic.sigmap sigma[s])
+                                (submapp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.crewrite-try-match$ x rule[s] sigma[s] :flagp t))
+
+  (definlined rw.crewrite-try-matches (assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (logic.termp x)
+                                (rw.rulep rule[s])
+                                (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                    (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                (logic.sigma-listp sigma[s])
+                                (submap-of-eachp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.crewrite-try-matches$ x rule[s] sigma[s] :flagp t))
+
+  (definlined rw.crewrite-relieve-hyp (assms x rule[s] sigma[s] cache blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (rw.hypp x)
+                                (rw.rulep rule[s])
+                                (logic.sigmap sigma[s])
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.crewrite-relieve-hyp$ x rule[s] sigma[s] :flagp t))
+
+  (definlined rw.crewrite-relieve-hyps (assms x rule[s] sigma[s] cache blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.assmsp assms)
+                                (rw.hyp-listp x)
+                                (rw.rulep rule[s])
+                                (logic.sigmap sigma[s])
+                                (rw.cachep cache)
+                                (rw.cache-assmsp cache assms)
+                                (rw.cache-lhses-okp cache)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.crewrite-relieve-hyps$ x rule[s] sigma[s] :flagp t)))
+
+
+
+
+(defsection rw.flag-crewrite-removal
+
+  ;; We now prove the elimination rules for flag-crewrite to transform it into
+  ;; calls of these wrapper functions.
+
+ (defthm rw.flag-crewrite-of-term
+   (equal (rw.flag-crewrite 'term assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-core$ x))
+   :hints(("Goal"
+           :in-theory (enable rw.crewrite-core)
+           :use ((:instance rw.flag-crewrite-of-term-reduction)))))
+
+ (defthm rw.flag-crewrite-of-list
+   (equal (rw.flag-crewrite 'list assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-core-list$ x))
+   :hints(("Goal"
+           :in-theory (enable rw.crewrite-core-list)
+           :use ((:instance rw.flag-crewrite-of-list-reduction)))))
+
+ (defthm rw.flag-crewrite-of-rule
+   (equal (rw.flag-crewrite 'rule assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-try-rule$ x rule[s]))
+   :hints(("Goal"
+           :in-theory (enable rw.crewrite-try-rule)
+           :use ((:instance rw.flag-crewrite-of-rule-reduction)))))
+
+ (defthm rw.flag-crewrite-of-rules
+   (equal (rw.flag-crewrite 'rules assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-try-rules$ x rule[s]))
+   :hints(("Goal"
+           :in-theory (enable rw.crewrite-try-rules)
+           :use ((:instance rw.flag-crewrite-of-rules-reduction)))))
+
+ (defthm rw.flag-crewrite-of-match
+   (equal (rw.flag-crewrite 'match assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-try-match$ x rule[s] sigma[s]))
+   :hints(("Goal" :in-theory (enable rw.crewrite-try-match))))
+
+ (defthm rw.flag-crewrite-of-matches
+   (equal (rw.flag-crewrite 'matches assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+   :hints(("Goal" :in-theory (enable rw.crewrite-try-matches))))
+
+ (defthm rw.flag-crewrite-of-hyp
+   (equal (rw.flag-crewrite 'hyp assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+   :hints(("Goal"
+           :in-theory (enable rw.crewrite-relieve-hyp)
+           :use ((:instance rw.flag-crewrite-of-hyp-reduction)))))
+
+ (defthm rw.flag-crewrite-of-hyps
+   (equal (rw.flag-crewrite 'hyps assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+   :hints(("Goal"
+           :in-theory (enable rw.crewrite-relieve-hyps)
+           :use ((:instance rw.flag-crewrite-of-hyps-reduction))))))
+
+
+
+
+(defthm equal-with-quoted-list-of-nil
+  (equal (equal x '(nil))
+         (and (consp x)
+              (equal (car x) nil)
+              (equal (cdr x) nil))))
+
+(ACL2::make-event
+ `(encapsulate
+   ()
+   (defthmd definition-of-rw.crewrite-core
+     (equal (rw.crewrite-core$ x)
+            ,(ACL2::jared-rewrite *rw.crewrite-core* *rw.crewrite-noflag-sigma*))
+     :rule-classes :definition
+     :hints(("Goal"
+             :use ((:instance rw.flag-crewrite (flag 'term))))))
+
+   (defthmd definition-of-rw.crewrite-core-list
+     (equal (rw.crewrite-core-list$ x)
+            ,(ACL2::jared-rewrite *rw.crewrite-list* *rw.crewrite-noflag-sigma*))
+     :rule-classes :definition
+     :hints(("Goal" :use ((:instance rw.flag-crewrite (flag 'list))))))
+
+   (defthmd definition-of-rw.crewrite-try-rule
+     (equal (rw.crewrite-try-rule$ x rule[s])
+            ,(ACL2::jared-rewrite *rw.crewrite-rule* *rw.crewrite-noflag-sigma*))
+     :rule-classes :definition
+     :hints(("Goal" :use ((:instance rw.flag-crewrite (flag 'rule))))))
+
+   (defthmd definition-of-rw.crewrite-try-rules
+     (equal (rw.crewrite-try-rules$ x rule[s])
+            ,(ACL2::jared-rewrite *rw.crewrite-rules* *rw.crewrite-noflag-sigma*))
+     :rule-classes :definition
+     :hints(("Goal" :use ((:instance rw.flag-crewrite (flag 'rules))))))
+
+   (defthmd definition-of-rw.crewrite-try-match
+     (equal (rw.crewrite-try-match$ x rule[s] sigma[s])
+            ,(ACL2::jared-rewrite *rw.crewrite-match* *rw.crewrite-noflag-sigma*))
+     :rule-classes :definition
+     :hints(("Goal" :use ((:instance rw.flag-crewrite (flag 'match))))))
+
+   (defthmd definition-of-rw.crewrite-try-matches
+     (equal (rw.crewrite-try-matches$ x rule[s] sigma[s])
+            ,(ACL2::jared-rewrite *rw.crewrite-matches* *rw.crewrite-noflag-sigma*))
+     :rule-classes :definition
+     :hints(("Goal" :use ((:instance rw.flag-crewrite (flag 'matches))))))
+
+   (defthmd definition-of-rw.crewrite-relieve-hyp
+     (equal (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])
+            ,(ACL2::jared-rewrite *rw.crewrite-hyp* *rw.crewrite-noflag-sigma*))
+     :rule-classes :definition
+     :hints(("Goal" :use ((:instance rw.flag-crewrite (flag 'hyp))))))
+
+   (defthmd definition-of-rw.crewrite-relieve-hyps
+     (equal (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])
+            ,(ACL2::jared-rewrite *rw.crewrite-hyps* *rw.crewrite-noflag-sigma*))
+     :rule-classes :definition
+     :hints(("Goal" :use ((:instance rw.flag-crewrite (flag 'hyps))))))))
+
+
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.crewrite-core))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.crewrite-core-list))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.crewrite-try-rule))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.crewrite-try-rules))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.crewrite-try-match))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.crewrite-try-matches))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.crewrite-relieve-hyp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.crewrite-relieve-hyps))))
+
+
+
+
+
+
+(defthm rw.crewrite-core-list-when-not-consp
+   (implies (not (consp x))
+            (equal (rw.crewrite-core-list$ x)
+                   (rw.cresult nil cache nil)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.crewrite-core-list))))
+
+(defthm rw.crewrite-core-list-of-cons
+   (equal (rw.crewrite-core-list$ (cons a x))
+          (let* ((term1-rw      (rw.crewrite-core$ a))
+                 (term1-trace   (rw.cresult->data term1-rw))
+                 (term1-cache   (rw.cresult->cache term1-rw))
+                 (term1-limited (rw.cresult->alimitedp term1-rw))
+                 (others-rw      (rw.crewrite-core-list$ x :cache term1-cache))
+                 (others-traces  (rw.cresult->data others-rw))
+                 (others-cache   (rw.cresult->cache others-rw))
+                 (others-limited (rw.cresult->alimitedp others-rw)))
+            (rw.cresult (cons term1-trace others-traces)
+                        others-cache
+                        (or term1-limited others-limited))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.crewrite-core-list))))
+
+(defun rw.crewrite-list-induction (assms x cache iffp blimit rlimit anstack control)
+   (declare (xargs :verify-guards nil))
+   (if (consp x)
+       (rw.crewrite-list-induction assms (cdr x)
+                                   (rw.cresult->cache (rw.crewrite-core$ (car x)))
+                                   iffp blimit rlimit anstack control)
+     (list assms x cache iffp blimit rlimit anstack control)))
+
+(defmacro rw.crewrite-list-induction$ (x &key (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+   `(rw.crewrite-list-induction ,assms ,x ,cache ,iffp ,blimit ,rlimit ,anstack ,control))
+
+(defthm true-listp-of-rw.cresult->data-of-rw.crewrite-core-list
+   (equal (true-listp (rw.cresult->data (rw.crewrite-core-list$ x)))
+          t)
+   :hints(("Goal" :induct (rw.crewrite-list-induction$ x))))
+
+(defthm len-of-rw.cresult->data-of-rw.crewrite-core-list$
+   (equal (len (rw.cresult->data (rw.crewrite-core-list$ x)))
+          (len x))
+   :hints(("Goal" :induct (rw.crewrite-list-induction$ x))))
+
+
+
+
+
+(defthm rw.crewrite-try-rules-when-not-consp
+   (implies (not (consp rule[s]))
+            (equal (rw.crewrite-try-rules$ x rule[s])
+                   (rw.cresult nil cache nil)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.crewrite-try-rules))))
+
+(defthm rw.crewrite-try-rules-of-cons
+   (equal (rw.crewrite-try-rules$ x (cons rule rules))
+          (let* ((rule1-rw      (rw.crewrite-try-rule$ x rule))
+                 (rule1-trace   (rw.cresult->data rule1-rw))
+                 (rule1-cache   (rw.cresult->cache rule1-rw))
+                 (rule1-limited (rw.cresult->alimitedp rule1-rw)))
+            (if rule1-trace
+                rule1-rw
+              (let* ((others-rw      (rw.crewrite-try-rules$ x rules :cache rule1-cache))
+                     (others-trace   (rw.cresult->data others-rw))
+                     (others-cache   (rw.cresult->cache others-rw))
+                     (others-limited (rw.cresult->alimitedp others-rw)))
+                (if others-trace
+                    others-rw
+                  (rw.cresult nil others-cache (or rule1-limited others-limited)))))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.crewrite-try-rules))))
+
+(defun rw.crewrite-try-rules-induction (assms x rule[s] cache iffp blimit rlimit anstack control)
+   (declare (xargs :verify-guards nil))
+   (if (consp rule[s])
+       (rw.crewrite-try-rules-induction assms x (cdr rule[s])
+                                        (rw.cresult->cache (rw.crewrite-try-rule$ x (car rule[s])))
+                                        iffp blimit rlimit anstack control)
+     (list assms x rule[s] cache iffp blimit rlimit anstack control)))
+
+(defmacro rw.crewrite-try-rules-induction$ (x &key (assms 'assms) (rule[s] 'rule[s]) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+   `(rw.crewrite-try-rules-induction ,assms ,x ,rule[s] ,cache ,iffp ,blimit ,rlimit ,anstack ,control))
+
+
+
+
+
+
+(defthm rw.crewrite-try-matches-when-not-consp
+   (implies (not (consp sigma[s]))
+            (equal (rw.crewrite-try-matches$ x rule[s] sigma[s])
+                   (rw.cresult nil cache nil)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.crewrite-try-matches))))
+
+(defthm rw.crewrite-try-matches-of-cons
+   (equal (rw.crewrite-try-matches$ x rule[s] (cons sigma sigmas))
+          (let* ((match1-rw      (rw.crewrite-try-match$ x rule[s] sigma))
+                 (match1-trace   (rw.cresult->data match1-rw))
+                 (match1-cache   (rw.cresult->cache match1-rw))
+                 (match1-limited (rw.cresult->alimitedp match1-rw)))
+            (if match1-trace
+                match1-rw
+              (let* ((others-rw      (rw.crewrite-try-matches$ x rule[s] sigmas :cache match1-cache))
+                     (others-trace   (rw.cresult->data others-rw))
+                     (others-cache   (rw.cresult->cache others-rw))
+                     (others-limited (rw.cresult->alimitedp others-rw)))
+                (if others-trace
+                    others-rw
+                  (rw.cresult nil others-cache (or match1-limited others-limited)))))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.crewrite-try-matches))))
+
+
+
+
+(defthm rw.crewrite-relieve-hyps-when-not-consp
+   (implies (not (consp x))
+            (equal (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])
+                   (rw.hypresult t nil cache nil)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.crewrite-relieve-hyps))))
+
+(defthm rw.crewrite-relieve-hyps-of-cons
+   (equal (rw.crewrite-relieve-hyps$ (cons a x) rule[s] sigma[s])
+          (let* ((hyp1-rw      (rw.crewrite-relieve-hyp$ a rule[s] sigma[s]))
+                 (hyp1-trace   (rw.cresult->data hyp1-rw))
+                 (hyp1-cache   (rw.cresult->cache hyp1-rw))
+                 (hyp1-limited (rw.cresult->alimitedp hyp1-rw)))
+            (if (not hyp1-trace)
+                (rw.hypresult nil nil hyp1-cache hyp1-limited)
+              (let* ((others-rw       (rw.crewrite-relieve-hyps$ x rule[s] sigma[s] :cache hyp1-cache))
+                     (others-successp (rw.hypresult->successp others-rw))
+                     (others-traces   (rw.hypresult->traces others-rw))
+                     (others-cache    (rw.hypresult->cache others-rw))
+                     (others-limited  (rw.hypresult->alimitedp others-rw)))
+                (if others-successp
+                    (rw.hypresult t (cons hyp1-trace others-traces) others-cache nil)
+                  (rw.hypresult nil nil others-cache others-limited))))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.crewrite-relieve-hyps))))
+
+(defthm booleanp-of-rw.hypresult->successp-of-rw.crewrite-relieve-hyps
+   (equal (booleanp (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+          t)
+   :hints(("Goal" :use ((:instance definition-of-rw.crewrite-relieve-hyps)))))
+
+
+
+ ;; BOZO.  We should remove this rule or disable it by default.  There's no
+ ;; reason that we should care what rw.assumptions-trace produces as its rhs.
+;; (local (in-theory (disable rw.trace->rhs-of-rw.assumptions-trace)))
+
+
+ ;; Let's just let it go and see how long it takes
+ ;; Then we can change the numbers are try to find a semi-optimal solution
+ ;; We can also look at AP output
+;(set-case-split-limitations '(500 100))  ;; 264.16 seconds, i think it's 400+ with nil limit
+;(set-case-split-limitations '(1000 100)) ;; 269.78 seconds
+;(set-case-split-limitations '(500 200))  ;; 284.32 seconds
+;(set-case-split-limitations '(250 100))  ;; 268.45 seconds
+
+(local (defthm rw.trace-list-rhses-when-not-consp-cheap
+         (implies (not (consp x))
+                  (equal (rw.trace-list-rhses x)
+                         nil))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(local (defthm rw.crewrite-core-list-when-not-consp-cheap
+         (implies (not (consp x))
+                  (equal (rw.crewrite-core-list$ x)
+                         (rw.cresult nil cache nil)))
+         :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+(local (in-theory (disable rw.trace-list-rhses-when-not-consp)))
+(local (in-theory (disable rw.crewrite-core-list-when-not-consp)))
+
+(local (deftheory my-disables-for-extra-speed
+          '(consp-when-memberp-of-logic.sigmap
+            consp-when-memberp-of-logic.sigmap-alt
+            consp-when-memberp-of-logic.sigma-atblp
+            consp-when-memberp-of-logic.sigma-atblp-alt
+            consp-when-memberp-of-logic.arity-tablep
+            consp-when-memberp-of-logic.arity-tablep-alt
+            consp-when-memberp-of-logic.callmapp
+            consp-when-memberp-of-logic.callmapp-alt
+            consp-when-memberp-of-logic.callmap-atblp
+            consp-when-memberp-of-logic.callmap-atblp-alt
+            consp-when-memberp-of-rw.cachemapp
+            consp-when-memberp-of-rw.cachemapp-alt
+            consp-when-memberp-of-none-consp
+            consp-when-memberp-of-none-consp-alt
+            consp-when-memberp-of-cons-listp
+            consp-when-memberp-of-cons-listp-alt
+
+            same-length-prefixes-equal-cheap
+
+            car-when-not-consp
+            cdr-when-not-consp
+            consp-when-natp-cheap
+            forcing-logic.groundp-of-logic.substitute
+            consp-when-logic.lambdap-cheap
+            consp-when-logic.functionp-cheap
+            consp-when-nonempty-subset-cheap
+            consp-when-memberp-cheap
+            logic.substitute-when-malformed-cheap
+            logic.constant-listp-when-not-consp
+            subsetp-when-not-consp
+            subsetp-when-not-consp-two
+            cons-listp-when-not-consp
+            none-consp-when-not-consp
+            forcing-logic.substitute-of-empty-sigma
+            not-equal-when-less
+            trichotomy-of-<
+            natp-of-len-free
+            transitivity-of-<
+            transitivity-of-<-three
+            transitivity-of-<-two
+            less-completion-left
+            less-of-one-right)))
+
+(local (in-theory (disable my-disables-for-extra-speed)))
+
+
+(defthm zp-of-one-plus
+  (equal (zp (+ 1 x))
+         nil))
+
+(local (in-theory (disable zp min)))
+
+(DEFTHM RW.CREWRITE-TRY-RULES-WHEN-NOT-CONSP-CHEAP
+  (IMPLIES (NOT (CONSP RULE[S]))
+           (EQUAL (RW.CREWRITE-TRY-RULES$ X RULE[S])
+                  (RW.CRESULT NIL CACHE NIL)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+;; new disables for MORE SPEED
+(local (in-theory (disable RW.CREWRITE-TRY-RULES-WHEN-NOT-CONSP
+                           FORCING-LOGIC.FUNCTION-OF-LOGIC.FUNCTION-NAME-AND-LOGIC.FUNCTION-ARGS-FREE
+                           CONSP-WHEN-TRUE-LISTP-CHEAP
+                           LOOKUP-WHEN-NOT-CONSP
+                           MINUS-WHEN-NOT-LESS
+                           LESS-OF-ONE-LEFT
+                           NOT-EQUAL-WHEN-LESS-TWO)))
+
+(defthms-flag
+  :shared-hyp (force (and (rw.assmsp assms)
+                          (rw.controlp control)
+                          (rw.cachep cache)))
+  :thms ((term forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.tracep (rw.cresult->data (rw.crewrite-core$ x)))
+                               t)))
+         (term forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cachep (rw.cresult->cache (rw.crewrite-core$ x)))
+                               t)))
+
+         (list forcing-rw.trace-listp-of-rw.cresult->data-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-listp (rw.cresult->data (rw.crewrite-core-list$ x)))
+                               t)))
+         (list forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cachep (rw.cresult->cache (rw.crewrite-core-list$ x)))
+                               t)))
+
+         (rule forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-try-rule
+               (implies (force (and (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                    (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.tracep (rw.cresult->data (rw.crewrite-try-rule$ x rule[s])))
+                               t)))
+         (rule forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-try-rule
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.cachep (rw.cresult->cache (rw.crewrite-try-rule$ x rule[s])))
+                               t)))
+
+         (rules forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-try-rules
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.tracep (rw.cresult->data (rw.crewrite-try-rules$ x rule[s])))
+                                t)))
+         (rules forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-try-rules
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.cachep (rw.cresult->cache (rw.crewrite-try-rules$ x rule[s])))
+                                t)))
+
+         (match forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-try-match
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.tracep (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s])))
+                                t)))
+         (match forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-try-match
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.cachep (rw.cresult->cache (rw.crewrite-try-match$ x rule[s] sigma[s])))
+                                t)))
+
+         (matches forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-try-matches
+                  (implies (force (and (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                       (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.tracep (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s])))
+                                  t)))
+         (matches forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-try-matches
+                  (implies (force (and (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.cachep (rw.cresult->cache (rw.crewrite-try-matches$ x rule[s] sigma[s])))
+                                  t)))
+
+         (hyp forcing-rw.tracep-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                   (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.tracep (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                              t)))
+         (hyp forcing-rw.cachep-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.cachep (rw.cresult->cache (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                              t)))
+
+         (t forcing-rw.trace-listp-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                 (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.trace-listp (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                            t)))
+         (t forcing-rw.cachep-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.cachep (rw.hypresult->cache (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                            t))))
+  :hints (("Goal"
+           :induct (rw.flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+           :expand ((:free (iffp rlimit) (rw.crewrite-core$ x))
+                    (:free (iffp)        (rw.crewrite-try-rule$ x rule[s]))
+                    (:free ()            (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                    (:free (blimit)      (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+           :in-theory (disable forcing-lookup-of-logic.function-name
+                               forcing-lookup-of-logic.function-name-free)
+           :do-not-induct t)))
+
+(defthms-flag
+  :shared-hyp (force (and (rw.assmsp assms)
+                          (rw.controlp control)
+                          (rw.cachep cache)))
+  :thms ((term forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace->iffp (rw.cresult->data (rw.crewrite-core$ x)))
+                               iffp)))
+
+         (list forcing-rw.trace-list-iffps-of-rw.cresult->data-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-list-iffps (rw.cresult->data (rw.crewrite-core-list$ x)))
+                               (repeat iffp (len x)))))
+
+         (rule forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-try-rule
+               (implies (force (and (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                    (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.trace->iffp (rw.cresult->data (rw.crewrite-try-rule$ x rule[s])))
+                               iffp)))
+
+         (rules forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-try-rules
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.trace->iffp (rw.cresult->data (rw.crewrite-try-rules$ x rule[s])))
+                                iffp)))
+
+         (match forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-try-match
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.trace->iffp (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s])))
+                                iffp)))
+
+         (matches forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-try-matches
+                  (implies (force (and (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                       (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.trace->iffp (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s])))
+                                  iffp)))
+
+         (hyp forcing-rw.trace->iffp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                   (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.trace->iffp (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                              t)))
+
+         (t forcing-rw.trace-list-iffps-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                 (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.trace-list-iffps (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                            (repeat t (len x))))))
+  :hints(("Goal"
+          :induct (rw.flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          :expand ((:free (iffp rlimit) (rw.crewrite-core$ x))
+                   (:free (iffp)        (rw.crewrite-try-rule$ x rule[s]))
+                   (:free ()            (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                   (:free (blimit)      (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+          :in-theory (disable forcing-lookup-of-logic.function-name
+                              forcing-lookup-of-logic.function-name-free)
+          :do-not-induct t)))
+
+
+(defthms-flag
+  :shared-hyp (force (and (rw.assmsp assms)
+                          (rw.controlp control)
+                          (rw.cachep cache)
+                          (rw.cache-assmsp cache assms)))
+  :thms ((term forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace->hypbox (rw.cresult->data (rw.crewrite-core$ x)))
+                               (rw.assms->hypbox assms))))
+         (term forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-assmsp (rw.cresult->cache (rw.crewrite-core$ x)) assms)
+                               t)))
+
+         (list forcing-rw.trace-list-hypboxes-of-rw.cresult->data-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-list-hypboxes (rw.cresult->data (rw.crewrite-core-list$ x)))
+                               (repeat (rw.assms->hypbox assms) (len x)))))
+         (list forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-assmsp (rw.cresult->cache (rw.crewrite-core-list$ x)) assms)
+                               t)))
+
+         (rule forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-try-rule
+               (implies (force (and (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                    (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.trace->hypbox (rw.cresult->data (rw.crewrite-try-rule$ x rule[s])))
+                               (rw.assms->hypbox assms))))
+         (rule forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.cache-assmsp (rw.cresult->cache (rw.crewrite-try-rule$ x rule[s])) assms)
+                               t)))
+
+         (rules forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-try-rules
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.trace->hypbox (rw.cresult->data (rw.crewrite-try-rules$ x rule[s])))
+                                (rw.assms->hypbox assms))))
+         (rules forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.cache-assmsp (rw.cresult->cache (rw.crewrite-try-rules$ x rule[s])) assms)
+                                t)))
+
+         (match forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-try-match
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.trace->hypbox (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s])))
+                                (rw.assms->hypbox assms))))
+         (match forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-try-match
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.cache-assmsp (rw.cresult->cache (rw.crewrite-try-match$ x rule[s] sigma[s])) assms)
+                                t)))
+
+         (matches forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-try-matches
+                  (implies (force (and (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                       (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.trace->hypbox (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s])))
+                                  (rw.assms->hypbox assms))))
+         (matches forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+                  (implies (force (and (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.cache-assmsp (rw.cresult->cache (rw.crewrite-try-matches$ x rule[s] sigma[s])) assms)
+                                  t)))
+
+         (hyp forcing-rw.trace->hypbox-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                   (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.trace->hypbox (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                              (rw.assms->hypbox assms))))
+         (hyp forcing-rw.cache-assmsp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.cache-assmsp (rw.cresult->cache (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])) assms)
+                              t)))
+
+         (t forcing-rw.trace-list-hypboxes-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                 (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.trace-list-hypboxes (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                            (repeat (rw.assms->hypbox assms) (len x)))))
+         (t forcing-rw.cache-assmsp-of-rw.hyprseult->cache-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.cache-assmsp (rw.hypresult->cache (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])) assms)
+                            t))))
+  :hints (("Goal"
+           :induct (rw.flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+           :expand ((:free (iffp rlimit) (rw.crewrite-core$ x))
+                    (:free (iffp)        (rw.crewrite-try-rule$ x rule[s]))
+                    (:free ()            (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                    (:free (blimit)      (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+           :in-theory (disable forcing-lookup-of-logic.function-name
+                               forcing-lookup-of-logic.function-name-free)
+           :do-not-induct t)))
+
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable consp-when-true-listp-cheap
+                           forcing-logic.function-of-logic.function-name-and-logic.function-args-free
+                           )))
+
+ (local (in-theory (disable equal-of-logic.function-rewrite)))
+
+ (defthms-flag
+   :shared-hyp (and (rw.assmsp assms)
+                    (rw.controlp control)
+                    (rw.cachep cache)
+                    (rw.cache-lhses-okp cache))
+   :thms ((term forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-core
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)))
+                         (equal (rw.trace->lhs (rw.cresult->data (rw.crewrite-core$ x)))
+                                x)))
+          (term forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-core
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)))
+                         (equal (rw.cache-lhses-okp (rw.cresult->cache (rw.crewrite-core$ x)))
+                                t)))
+
+          (list forcing-rw.trace-list-lhses-of-rw.cresult->data-of-rw.crewrite-core-list
+                (implies (force (and (logic.term-listp x)
+                                     (booleanp iffp)))
+                         (equal (rw.trace-list-lhses (rw.cresult->data (rw.crewrite-core-list$ x)))
+                                (list-fix x))))
+          (list forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-core-list
+                (implies (force (and (logic.term-listp x)
+                                     (booleanp iffp)))
+                         (equal (rw.cache-lhses-okp (rw.cresult->cache (rw.crewrite-core-list$ x)))
+                                t)))
+
+          (rule forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-try-rule
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])))
+                         (equal (rw.trace->lhs (rw.cresult->data (rw.crewrite-try-rule$ x rule[s])))
+                                x)))
+          (rule forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])))
+                         (equal (rw.cache-lhses-okp (rw.cresult->cache (rw.crewrite-try-rule$ x rule[s])))
+                                t)))
+
+          (rules forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-try-rules
+                 (implies (force (and (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                      (booleanp iffp)
+                                      (logic.termp x)
+                                      (rw.rule-listp rule[s])))
+                          (equal (rw.trace->lhs (rw.cresult->data (rw.crewrite-try-rules$ x rule[s])))
+                                 x)))
+          (rules forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+                 (implies (force (and (booleanp iffp)
+                                      (logic.termp x)
+                                      (rw.rule-listp rule[s])))
+                          (equal (rw.cache-lhses-okp (rw.cresult->cache (rw.crewrite-try-rules$ x rule[s])))
+                                 t)))
+
+          (match forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-try-match
+                 (implies (force (and (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                      (logic.termp x)
+                                      (booleanp iffp)
+                                      (rw.rulep rule[s])
+                                      (logic.sigmap sigma[s])))
+                          (equal (rw.trace->lhs (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s])))
+                                 x)))
+          (match forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-try-match
+                 (implies (force (and (logic.termp x)
+                                      (booleanp iffp)
+                                      (rw.rulep rule[s])
+                                      (logic.sigmap sigma[s])))
+                          (equal (rw.cache-lhses-okp (rw.cresult->cache (rw.crewrite-try-match$ x rule[s] sigma[s])))
+                                 t)))
+
+          (matches forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-try-matches
+                   (implies (force (and (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                        (logic.termp x)
+                                        (booleanp iffp)
+                                        (rw.rulep rule[s])
+                                        (logic.sigma-listp sigma[s])))
+                            (equal (rw.trace->lhs (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s])))
+                                   x)))
+          (matches forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+                   (implies (force (and (logic.termp x)
+                                        (booleanp iffp)
+                                        (rw.rulep rule[s])
+                                        (logic.sigma-listp sigma[s])))
+                            (equal (rw.cache-lhses-okp (rw.cresult->cache (rw.crewrite-try-matches$ x rule[s] sigma[s])))
+                                   t)))
+
+          (hyp forcing-rw.trace->lhs-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+               (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                    (rw.hypp x)
+                                    (rw.rulep rule[s])
+                                    (logic.sigmap sigma[s])))
+                        (equal (rw.trace->lhs (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                               (logic.substitute (rw.hyp->term x) sigma[s]))))
+          (hyp forcing-rw.cache-lhses-okp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+               (implies (force (and (rw.hypp x)
+                                    (rw.rulep rule[s])
+                                    (logic.sigmap sigma[s])))
+                        (equal (rw.cache-lhses-okp (rw.cresult->cache (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                               t)))
+
+          (t forcing-rw.trace-list-lhses-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+             (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                  (rw.hyp-listp x)
+                                  (rw.rulep rule[s])
+                                  (logic.sigmap sigma[s])))
+                      (equal (rw.trace-list-lhses (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                             (logic.substitute-list (rw.hyp-list-terms x) sigma[s]))))
+          (t forcing-rw.cache-lhses-okp-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+             (implies (force (and (rw.hyp-listp x)
+                                  (rw.rulep rule[s])
+                                  (logic.sigmap sigma[s])))
+                      (equal (rw.cache-lhses-okp (rw.hypresult->cache (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                             t))))
+   :hints (("Goal"
+            :induct (rw.flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+            :expand ((:free (iffp rlimit) (rw.crewrite-core$ x))
+                     (:free (iffp)        (rw.crewrite-try-rule$ x rule[s]))
+                     (:free ()            (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                     (:free (blimit)      (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+            :in-theory (disable forcing-lookup-of-logic.function-name
+                                forcing-lookup-of-logic.function-name-free)
+            :do-not-induct t))))
+
+
+
+(defthm forcing-rw.trace->rhs-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+  (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                       (rw.hypp x)
+                       (rw.rulep rule[s])
+                       (logic.sigmap sigma[s])
+                       (rw.cachep cache)
+                       (rw.assmsp assms)
+                       (rw.controlp control)))
+           (equal (rw.trace->rhs (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                  ''t))
+  :hints(("Goal" :expand (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))))
+
+(encapsulate
+ ()
+ (local (defun rw.crewrite-relieve-hyps-induction (assms x rule[s] sigma[s] cache blimit rlimit anstack control)
+          (declare (xargs :verify-guards nil))
+          (if (consp x)
+              (rw.crewrite-relieve-hyps-induction assms (cdr x) rule[s] sigma[s]
+                                                  (rw.cresult->cache (rw.crewrite-relieve-hyp assms (car x) rule[s] sigma[s] cache
+                                                                                              blimit rlimit anstack control))
+                                                  blimit rlimit anstack control)
+            (list assms x rule[s] sigma[s] cache blimit rlimit anstack control))))
+
+ (defthm forcing-rw.trace-list-rhses-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+   (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                        (rw.hyp-listp x)
+                        (rw.rulep rule[s])
+                        (logic.sigmap sigma[s])
+                        (rw.cachep cache)
+                        (rw.assmsp assms)
+                        (rw.controlp control)))
+            (equal (rw.trace-list-rhses (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                   (repeat ''t (len x))))
+   :hints(("Goal" :induct (rw.crewrite-relieve-hyps-induction assms x rule[s] sigma[s] cache blimit rlimit anstack control)))))
+
+
+(defthms-flag
+  :shared-hyp (force (and (rw.assmsp assms)
+                          (rw.controlp control)
+                          (rw.cachep cache)
+                          (rw.cache-traces-okp cache (rw.control->defs control))
+                          (rw.cache-lhses-okp cache)
+                          (rw.cache-assmsp cache assms)))
+  :thms ((term forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-okp (rw.cresult->data (rw.crewrite-core$ x))
+                                             (rw.control->defs control))
+                               t)))
+         (term forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-traces-okp (rw.cresult->cache (rw.crewrite-core$ x))
+                                                    (rw.control->defs control))
+                               t)))
+
+         (list forcing-rw.trace-list-okp-of-rw.cresult->data-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-list-okp (rw.cresult->data (rw.crewrite-core-list$ x))
+                                                  (rw.control->defs control))
+                               t)))
+         (list forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-traces-okp (rw.cresult->cache (rw.crewrite-core-list$ x))
+                                                    (rw.control->defs control))
+                               t)))
+
+         (rule forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-try-rule
+               (implies (force (and (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                    (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.trace-okp (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                             (rw.control->defs control))
+                               t)))
+         (rule forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.cache-traces-okp (rw.cresult->cache (rw.crewrite-try-rule$ x rule[s]))
+                                                    (rw.control->defs control))
+                               t)))
+
+         (rules forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-try-rules
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.trace-okp (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                              (rw.control->defs control))
+                                t)))
+         (rules forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.cache-traces-okp (rw.cresult->cache (rw.crewrite-try-rules$ x rule[s]))
+                                                     (rw.control->defs control))
+                                t)))
+
+         (match forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-try-match
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])
+                                     (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                         (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                     (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                     (submapp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])))
+                         (equal (rw.trace-okp (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                              (rw.control->defs control))
+                                t)))
+         (match forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-try-match
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])
+                                     (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                         (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                     (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                     (submapp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])))
+                         (equal (rw.cache-traces-okp (rw.cresult->cache (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                                     (rw.control->defs control))
+                                t)))
+
+         (matches forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-try-matches
+                  (implies (force (and (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                       (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                           (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                       (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                       (logic.sigma-listp sigma[s])
+                                       (submap-of-eachp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])))
+                           (equal (rw.trace-okp (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                                (rw.control->defs control))
+                                  t)))
+         (matches forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+                  (implies (force (and (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                           (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                       (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                       (logic.sigma-listp sigma[s])
+                                       (submap-of-eachp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])))
+                           (equal (rw.cache-traces-okp (rw.cresult->cache (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                                       (rw.control->defs control))
+                                  t)))
+
+         (hyp forcing-rw.trace-okp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                   (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.trace-okp (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                            (rw.control->defs control))
+                              t)))
+         (hyp forcing-rw.cache-traces-okp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.cache-traces-okp (rw.cresult->cache (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                                   (rw.control->defs control))
+                              t)))
+
+         (t forcing-rw.trace-list-okp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                 (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.trace-list-okp (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                               (rw.control->defs control))
+                            t)))
+         (t forcing-rw.cache-traces-okp-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.cache-traces-okp (rw.hypresult->cache (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                                 (rw.control->defs control))
+                            t))))
+
+  :hints (("Goal"
+           :induct (rw.flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+           :expand ((:free (iffp rlimit) (rw.crewrite-core$ x))
+                    (:free (iffp)        (rw.crewrite-try-rule$ x rule[s]))
+                    (:free ()            (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                    (:free (blimit)      (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+           :in-theory (disable forcing-lookup-of-logic.function-name
+                               forcing-lookup-of-logic.function-name-free
+
+                               )
+           :restrict ((forcing-rw.trace->hypbox-of-rw.cache-lookup ((assms assms))))
+           :do-not-induct t)))
+
+
+(defthms-flag
+  :shared-hyp (force (and (rw.assmsp assms)
+                          (rw.assms-atblp assms atbl)
+                          (rw.controlp control)
+                          (rw.control-atblp control atbl)
+                          (rw.cachep cache)
+                          (rw.cache-atblp cache atbl)
+                          (equal (cdr (lookup 'not atbl)) 1)))
+  :thms ((term forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-atblp (rw.cresult->data (rw.crewrite-core$ x)) atbl)
+                               t)))
+         (term forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-atblp (rw.cresult->cache (rw.crewrite-core$ x)) atbl)
+                               t)))
+
+         (list forcing-rw.trace-list-atblp-of-rw.cresult->data-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (logic.term-list-atblp x atbl)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-list-atblp (rw.cresult->data (rw.crewrite-core-list$ x)) atbl)
+                               t)))
+         (list forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (logic.term-list-atblp x atbl)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-atblp (rw.cresult->cache (rw.crewrite-core-list$ x)) atbl)
+                               t)))
+
+         (rule forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-try-rule
+               (implies (force (and (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                    (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])
+                                    (rw.rule-atblp rule[s] atbl)))
+                        (equal (rw.trace-atblp (rw.cresult->data (rw.crewrite-try-rule$ x rule[s])) atbl)
+                               t)))
+         (rule forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])
+                                    (rw.rule-atblp rule[s] atbl)))
+                        (equal (rw.cache-atblp (rw.cresult->cache (rw.crewrite-try-rule$ x rule[s])) atbl)
+                               t)))
+
+         (rules forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-try-rules
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                     (logic.termp x)
+                                     (logic.term-atblp x atbl)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])
+                                     (rw.rule-list-atblp rule[s] atbl)))
+                         (equal (rw.trace-atblp (rw.cresult->data (rw.crewrite-try-rules$ x rule[s])) atbl)
+                                t)))
+         (rules forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+                (implies (force (and (logic.termp x)
+                                     (logic.term-atblp x atbl)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])
+                                     (rw.rule-list-atblp rule[s] atbl)))
+                         (equal (rw.cache-atblp (rw.cresult->cache (rw.crewrite-try-rules$ x rule[s])) atbl)
+                                t)))
+
+         (match forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-try-match
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                     (logic.termp x)
+                                     (logic.term-atblp x atbl)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (rw.rule-atblp rule[s] atbl)
+                                     (logic.sigmap sigma[s])
+                                     (logic.sigma-atblp sigma[s] atbl)))
+                         (equal (rw.trace-atblp (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s])) atbl)
+                                t)))
+         (match forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-try-match
+                (implies (force (and (logic.termp x)
+                                     (logic.term-atblp x atbl)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (rw.rule-atblp rule[s] atbl)
+                                     (logic.sigmap sigma[s])
+                                     (logic.sigma-atblp sigma[s] atbl)))
+                         (equal (rw.cache-atblp (rw.cresult->cache (rw.crewrite-try-match$ x rule[s] sigma[s])) atbl)
+                                t)))
+
+         (matches forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-try-matches
+                  (implies (force (and (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                       (logic.termp x)
+                                       (logic.term-atblp x atbl)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (rw.rule-atblp rule[s] atbl)
+                                       (logic.sigma-listp sigma[s])
+                                       (logic.sigma-list-atblp sigma[s] atbl)))
+                           (equal (rw.trace-atblp (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s])) atbl)
+                                  t)))
+         (matches forcing-rw.cache-atblp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+                  (implies (force (and (logic.termp x)
+                                       (logic.term-atblp x atbl)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (rw.rule-atblp rule[s] atbl)
+                                       (logic.sigma-listp sigma[s])
+                                       (logic.sigma-list-atblp sigma[s] atbl)))
+                           (equal (rw.cache-atblp (rw.cresult->cache (rw.crewrite-try-matches$ x rule[s] sigma[s])) atbl)
+                                  t)))
+
+         (hyp forcing-rw.trace-atblp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                   (rw.hypp x)
+                                   (rw.hyp-atblp x atbl)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])
+                                   (logic.sigma-atblp sigma[s] atbl)))
+                       (equal (rw.trace-atblp (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])) atbl)
+                              t)))
+         (hyp forcing-rw.cache-atblp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.hypp x)
+                                   (rw.hyp-atblp x atbl)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])
+                                   (logic.sigma-atblp sigma[s] atbl)))
+                       (equal (rw.cache-atblp (rw.cresult->cache (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])) atbl)
+                              t)))
+
+         (t forcing-rw.trace-list-atblp-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                 (rw.hyp-listp x)
+                                 (rw.hyp-list-atblp x atbl)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])
+                                 (logic.sigma-atblp sigma[s] atbl)))
+                     (equal (rw.trace-list-atblp (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])) atbl)
+                            t)))
+         (t forcing-rw.cache-atblp-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.hyp-list-atblp x atbl)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])
+                                 (logic.sigma-atblp sigma[s] atbl)))
+                     (equal (rw.cache-atblp (rw.hypresult->cache (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])) atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (rw.flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+           :expand ((:free (iffp rlimit) (rw.crewrite-core$ x))
+                    (:free ()            (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                    (:free (iffp)        (rw.crewrite-try-rule$ x rule[s]))
+                    (:free (blimit)      (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+           :restrict ((forcing-lookup-of-logic.function-name ((atbl atbl)))
+                      (forcing-lookup-of-logic.function-name-free ((atbl atbl))))
+           :do-not-induct t)))
+
+
+(defthms-flag
+  :shared-hyp (force (and (rw.assmsp assms)
+                          (rw.assms-atblp assms atbl)
+                          (rw.controlp control)
+                          (rw.control-atblp control atbl)
+                          (rw.control-env-okp control axioms thms)
+                          (rw.cachep cache)
+                          (rw.cache-atblp cache atbl)
+                          (rw.cache-env-okp cache defs thms atbl)
+                          (equal (cdr (lookup 'not atbl)) 1)))
+  :thms ((term forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-env-okp (rw.cresult->data (rw.crewrite-core$ x)) defs thms atbl)
+                               t)))
+         (term forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-env-okp (rw.cresult->cache (rw.crewrite-core$ x)) defs thms atbl)
+                               t)))
+
+         (list forcing-rw.trace-list-env-okp-of-rw.cresult->data-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (logic.term-list-atblp x atbl)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-list-env-okp (rw.cresult->data (rw.crewrite-core-list$ x)) defs thms atbl)
+                               t)))
+         (list forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (logic.term-list-atblp x atbl)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-env-okp (rw.cresult->cache (rw.crewrite-core-list$ x)) defs thms atbl)
+                               t)))
+
+         (rule forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-try-rule
+               (implies (force (and (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                    (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])
+                                    (rw.rule-atblp rule[s] atbl)
+                                    (rw.rule-env-okp rule[s] thms)))
+                        (equal (rw.trace-env-okp (rw.cresult->data (rw.crewrite-try-rule$ x rule[s])) defs thms atbl)
+                               t)))
+         (rule forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-try-rule
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])
+                                    (rw.rule-atblp rule[s] atbl)
+                                    (rw.rule-env-okp rule[s] thms)))
+                        (equal (rw.cache-env-okp (rw.cresult->cache (rw.crewrite-try-rule$ x rule[s])) defs thms atbl)
+                               t)))
+
+         (rules forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-try-rules
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                     (logic.termp x)
+                                     (logic.term-atblp x atbl)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])
+                                     (rw.rule-list-atblp rule[s] atbl)
+                                     (rw.rule-list-env-okp rule[s] thms)))
+                         (equal (rw.trace-env-okp (rw.cresult->data (rw.crewrite-try-rules$ x rule[s])) defs thms atbl)
+                                t)))
+         (rules forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-try-rules
+                (implies (force (and (logic.termp x)
+                                     (logic.term-atblp x atbl)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])
+                                     (rw.rule-list-atblp rule[s] atbl)
+                                     (rw.rule-list-env-okp rule[s] thms)))
+                         (equal (rw.cache-env-okp (rw.cresult->cache (rw.crewrite-try-rules$ x rule[s])) defs thms atbl)
+                                t)))
+
+         (match forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-try-match
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                     (logic.termp x)
+                                     (logic.term-atblp x atbl)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (rw.rule-atblp rule[s] atbl)
+                                     (rw.rule-env-okp rule[s] thms)
+                                     (logic.sigmap sigma[s])
+                                     (logic.sigma-atblp sigma[s] atbl)))
+                         (equal (rw.trace-env-okp (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s])) defs thms atbl)
+                                t)))
+         (match forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-try-match
+                (implies (force (and (logic.termp x)
+                                     (logic.term-atblp x atbl)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (rw.rule-atblp rule[s] atbl)
+                                     (rw.rule-env-okp rule[s] thms)
+                                     (logic.sigmap sigma[s])
+                                     (logic.sigma-atblp sigma[s] atbl)))
+                         (equal (rw.cache-env-okp (rw.cresult->cache (rw.crewrite-try-match$ x rule[s] sigma[s])) defs thms atbl)
+                                t)))
+
+         (matches forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-try-matches
+                  (implies (force (and (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                       (logic.termp x)
+                                       (logic.term-atblp x atbl)
+                                       (booleanp iffp)
+                                       (logic.sigma-listp sigma[s])
+                                       (logic.sigma-list-atblp sigma[s] atbl)
+                                       (rw.rulep rule[s])
+                                       (rw.rule-atblp rule[s] atbl)
+                                       (rw.rule-env-okp rule[s] thms)))
+                           (equal (rw.trace-env-okp (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s])) defs thms atbl)
+                                  t)))
+         (matches forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-try-matches
+                  (implies (force (and (logic.termp x)
+                                       (logic.term-atblp x atbl)
+                                       (booleanp iffp)
+                                       (logic.sigma-listp sigma[s])
+                                       (logic.sigma-list-atblp sigma[s] atbl)
+                                       (rw.rulep rule[s])
+                                       (rw.rule-atblp rule[s] atbl)
+                                       (rw.rule-env-okp rule[s] thms)))
+                           (equal (rw.cache-env-okp (rw.cresult->cache (rw.crewrite-try-matches$ x rule[s] sigma[s])) defs thms atbl)
+                                  t)))
+
+         (hyp forcing-rw.trace-env-okp-of-rw.cresult->data-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                   (rw.hypp x)
+                                   (rw.hyp-atblp x atbl)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])
+                                   (logic.sigma-atblp sigma[s] atbl)))
+                       (equal (rw.trace-env-okp (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])) defs thms atbl)
+                              t)))
+         (hyp forcing-rw.cache-env-okp-of-rw.cresult->cache-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.hypp x)
+                                   (rw.hyp-atblp x atbl)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])
+                                   (logic.sigma-atblp sigma[s] atbl)))
+                       (equal (rw.cache-env-okp (rw.cresult->cache (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])) defs thms atbl)
+                              t)))
+
+         (t forcing-rw.trace-list-env-okp-of-rw.hypresult->traces-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                 (rw.hyp-listp x)
+                                 (rw.hyp-list-atblp x atbl)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])
+                                 (logic.sigma-atblp sigma[s] atbl)))
+                     (equal (rw.trace-list-env-okp (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])) defs thms atbl)
+                            t)))
+         (t forcing-rw.cache-env-okp-of-rw.hypresult->cache-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.hyp-list-atblp x atbl)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])
+                                 (logic.sigma-atblp sigma[s] atbl)))
+                     (equal (rw.cache-env-okp (rw.hypresult->cache (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])) defs thms atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (rw.flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+           :expand ((:free (iffp rlimit) (rw.crewrite-core$ x))
+                    (:free ()            (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                    (:free (iffp)        (rw.crewrite-try-rule$ x rule[s]))
+                    (:free (blimit)      (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+           :restrict ((forcing-lookup-of-logic.function-name ((atbl atbl))))
+           :do-not-induct t)))
+
+
+
+(defthm map-listp-when-logic.sigma-listp
+  (implies (logic.sigma-listp x)
+           (map-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(local (in-theory (enable zp)))
+
+
+
+(encapsulate
+ ()
+ (verify-guards rw.flag-crewrite
+                :hints(("Goal"
+                        :in-theory (disable subsetp-of-logic.term-vars-and-domain-of-logic.patmatch)
+                        :use ((:instance subsetp-of-logic.term-vars-and-domain-of-logic.patmatch
+                                         (x (RW.RULE->LHS RULE[S]))
+                                         (y x)
+                                         (sigma nil)))
+                        :restrict ((forcing-rw.trace->hypbox-of-rw.cache-lookup ((assms assms)))))))
+
+ (verify-guards rw.crewrite-core)
+ (verify-guards rw.crewrite-core-list)
+ (verify-guards rw.crewrite-try-rule)
+ (verify-guards rw.crewrite-try-rules)
+ (verify-guards rw.crewrite-try-match)
+ (verify-guards rw.crewrite-try-matches)
+ (verify-guards rw.crewrite-relieve-hyp)
+ (verify-guards rw.crewrite-relieve-hyps))
+
+
+
+
+#||
+
+;; For a long time, I thought it was necessary to perform multiple passes of
+;; rewriting on each literal.  I no longer think this is the case, and just
+;; wish to rewrite each literal once.
+
+
+
+(defund rw.aux-crewrite (assms x cache iffp blimit rlimit control n)
+  ;; We perform (up to) n+1 inside-out passes of conditional rewriting, and
+  ;; produce a trace of our progress.
+  (declare (xargs :guard (and (rw.assmsp assms)
+                              (logic.termp x)
+                              (rw.cachep cache)
+                              (rw.cache-assmsp cache assms)
+                              (rw.controlp control)
+                              (rw.cache-traces-okp cache (rw.control->defs control))
+                              (rw.cache-lhses-okp cache)
+                              (booleanp iffp)
+                              (natp blimit)
+                              (natp rlimit)
+                              (natp n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (let* ((pass1-rw    (rw.crewrite-core assms x cache iffp blimit rlimit nil control))
+         (pass1-trace (rw.cresult->data pass1-rw))
+         (pass1-cache (rw.cresult->cache pass1-rw)))
+    (cond ((equal x (rw.trace->rhs pass1-trace))
+           ;; Originally, we instead checked if the method was 'fail.  But when
+           ;; we started to develop fast-crewrite, we adopted the above approach
+           ;; instead.
+           ;;
+           ;; This gives us a wonderful property: our rewriter never looks at
+           ;; the method of a trace.  Because of this, we can omit the method
+           ;; from fast-traces.  (The method is still needed for regular traces
+           ;; because of the trace compilers.)
+           ;;
+           ;; This also allows further optimization.  For instance, the method
+           ;; of (rw.transitivity-trace x y) might be 'fail or 'transitivity,
+           ;; but to compute this we must have the lhs of x to compare against
+           ;; the lhs of y.  By obviating the method computation, we can (1)
+           ;; omit lhses from fast-traces entirely, and (2) eliminate the
+           ;; overhead of these equality checks.
+           (ACL2::prog2$
+            (ACL2::flush-hons-get-hash-table-link pass1-cache)
+            (ACL2::prog2$
+             (ACL2::cw ";;; rw.aux-crewrite reached fixed-point with n = ~x0.~%" n)
+             pass1-trace)))
+
+          ((zp n)
+           ;; We cannot further simplify becuase we have run out of steps.
+           (ACL2::prog2$ (ACL2::cw "[rw.crewrite] Warning: ran out of rewriting steps.~%")
+                         (ACL2::prog2$
+                          (ACL2::flush-hons-get-hash-table-link pass1-cache)
+                          pass1-trace)))
+
+          (t
+           ;; Perhaps we can simplify it further?
+           (rw.transitivity-trace pass1-trace
+                                  (rw.aux-crewrite assms (rw.trace->rhs pass1-trace) pass1-cache iffp blimit rlimit control (- n 1)))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.aux-crewrite)))
+
+ (defthm forcing-rw.tracep-of-rw.aux-crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (logic.termp x)
+                        (booleanp iffp)
+                        (rw.cachep cache)
+                        (rw.controlp control)))
+            (equal (rw.tracep (rw.aux-crewrite assms x cache iffp blimit rlimit control n))
+                   t)))
+
+ (defthm forcing-rw.trace->hypbox-of-rw.aux-crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (logic.termp x)
+                        (booleanp iffp)
+                        (rw.cachep cache)
+                        (rw.cache-assmsp cache assms)
+                        (rw.controlp control)))
+            (equal (rw.trace->hypbox (rw.aux-crewrite assms x cache iffp blimit rlimit control n))
+                   (rw.assms->hypbox assms))))
+
+ (defthm forcing-rw.trace->lhs-of-rw.aux-crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (logic.termp x)
+                        (booleanp iffp)
+                        (rw.cachep cache)
+                        (rw.cache-lhses-okp cache)
+                        (rw.controlp control)))
+            (equal (rw.trace->lhs (rw.aux-crewrite assms x cache iffp blimit rlimit control n))
+                   x)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.aux-crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (logic.termp x)
+                        (booleanp iffp)
+                        (rw.cachep cache)
+                        (rw.controlp control)))
+            (equal (rw.trace->iffp (rw.aux-crewrite assms x cache iffp blimit rlimit control n))
+                   iffp)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.aux-crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (rw.assms-atblp assms atbl)
+                        (logic.termp x)
+                        (logic.term-atblp x atbl)
+                        (booleanp iffp)
+                        (rw.cachep cache)
+                        (rw.cache-atblp cache atbl)
+                        (rw.controlp control)
+                        (rw.control-atblp control atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)))
+            (equal (rw.trace-atblp (rw.aux-crewrite assms x cache iffp blimit rlimit control n) atbl)
+                   t)))
+
+ (verify-guards rw.aux-crewrite)
+
+ (defthm forcing-rw.trace-okp-of-rw.aux-crewrite
+   (implies (force (and (logic.termp x)
+                        (rw.assmsp assms)
+                        (booleanp iffp)
+                        (rw.cachep cache)
+                        (rw.cache-lhses-okp cache)
+                        (rw.cache-traces-okp cache (rw.control->defs control))
+                        (rw.cache-assmsp cache assms)
+                        (rw.controlp control)))
+            (equal (rw.trace-okp (rw.aux-crewrite assms x cache iffp blimit rlimit control n)
+                                 (rw.control->defs control))
+                   t)))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.aux-crewrite
+   (implies (force (and (logic.termp x)
+                        (logic.term-atblp x atbl)
+                        (rw.assmsp assms)
+                        (rw.assms-atblp assms atbl)
+                        (booleanp iffp)
+                        (rw.cachep cache)
+                        (rw.cache-atblp cache atbl)
+                        (rw.cache-env-okp cache (rw.control->defs control) thms atbl)
+                        (rw.controlp control)
+                        (rw.control-atblp control atbl)
+                        (rw.control-env-okp control axioms thms)
+                        (equal (cdr (lookup 'not atbl)) 1)))
+            (equal (rw.trace-env-okp (rw.aux-crewrite assms x cache iffp blimit rlimit control n)
+                                     (rw.control->defs control)
+                                     thms atbl)
+                   t))))
+
+||#
+
+;; BOZO eventually we should remove n, since it isn't used.  For now I'm leaving it
+;; so I can verify that this really is okay.
+
+(defund rw.crewrite (assms x iffp blimit rlimit control n)
+  (declare (xargs :guard (and (rw.assmsp assms)
+                              (logic.termp x)
+                              (booleanp iffp)
+                              (natp blimit)
+                              (natp rlimit)
+                              (rw.controlp control)
+                              (natp n))
+                  :verify-guards nil)
+           (ignore n))
+  ;; Old definition:
+  ;;  (rw.aux-crewrite assms x (rw.empty-cache) iffp blimit rlimit control n))
+  ;; New definition:
+  (let ((result (rw.crewrite-core assms x (rw.empty-cache) iffp blimit rlimit nil control)))
+    (ACL2::prog2$
+     (ACL2::flush-hons-get-hash-table-link (rw.cresult->cache result))
+     (rw.cresult->data result))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite)))
+
+ (defthm forcing-rw.tracep-of-rw.crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (logic.termp x)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.tracep (rw.crewrite assms x iffp blimit rlimit control n))
+                   t)))
+
+ (defthm forcing-rw.trace->hypbox-of-rw.crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (logic.termp x)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.trace->hypbox (rw.crewrite assms x iffp blimit rlimit control n))
+                   (rw.assms->hypbox assms))))
+
+ (defthm forcing-rw.trace->lhs-of-rw.crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (logic.termp x)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.trace->lhs (rw.crewrite assms x iffp blimit rlimit control n))
+                   x)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (logic.termp x)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.trace->iffp (rw.crewrite assms x iffp blimit rlimit control n))
+                   iffp)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.crewrite
+   (implies (force (and (rw.assmsp assms)
+                        (rw.assms-atblp assms atbl)
+                        (logic.termp x)
+                        (logic.term-atblp x atbl)
+                        (booleanp iffp)
+                        (rw.controlp control)
+                        (rw.control-atblp control atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)))
+            (equal (rw.trace-atblp (rw.crewrite assms x iffp blimit rlimit control n) atbl)
+                   t)))
+
+ (verify-guards rw.crewrite)
+
+ (defthm forcing-rw.trace-okp-of-rw.crewrite
+   (implies (force (and (logic.termp x)
+                        (rw.assmsp assms)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.trace-okp (rw.crewrite assms x iffp blimit rlimit control n)
+                                 (rw.control->defs control))
+                   t)))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.crewrite
+   (implies (force (and (logic.termp x)
+                        (logic.term-atblp x atbl)
+                        (rw.assmsp assms)
+                        (rw.assms-atblp assms atbl)
+                        (booleanp iffp)
+                        (rw.controlp control)
+                        (rw.control-atblp control atbl)
+                        (rw.control-env-okp control axioms thms)
+                        (equal (cdr (lookup 'not atbl)) 1)))
+            (equal (rw.trace-env-okp (rw.crewrite assms x iffp blimit rlimit control n)
+                                     (rw.control->defs control)
+                                     thms atbl)
+                   t))))
+
+
+
+
+
+
+
+#||
+
+;; This was a new version of the core that I tried to use at one point.  It pretty much works, but
+;; it fails to prove a lemma in functional-axiom.lisp and has some trouble later in level8.  I am
+;; not very happy with the current handling of assumptions.  Oh well.
+
+(defconst *rw.crewrite-core*
+  ;; Rewrite a term; returns (list trace new-cache limitedp)
+  '(cond ((logic.constantp x)
+          ;; We don't consult/modify the cache since this is cheap.
+          (let* ((hypbox    (rw.assms->hypbox assms))
+                 (ret-trace (or (rw.try-ground-simplify hypbox x iffp control)
+                                (rw.fail-trace hypbox x iffp))))
+            (rw.cresult ret-trace cache nil)))
+         ((logic.variablep x)
+          ;; We don't consult/modify the cache since this is cheap.
+          (let* ((ret-trace (or (rw.assumptions-trace assms x iffp)
+                                (rw.fail-trace (rw.assms->hypbox assms) x iffp))))
+            (rw.cresult ret-trace cache nil)))
+         ((and (logic.functionp x)
+               (equal (logic.function-name x) 'if)
+               (equal (len (logic.function-args x)) 3))
+          ;; We don't cache "if" expressions, so there's no need to consult the cache
+          (let* ((args         (logic.function-args x))
+                 (arg1         (first args))
+                 (arg2         (second args))
+                 (arg3         (third args))
+                 (arg1-rw      (rw.crewrite-core$ arg1 :iffp t))
+                 (arg1-trace   (rw.cresult->data arg1-rw))
+                 (arg1-cache   (rw.cresult->cache arg1-rw))
+                 (arg1-limited (rw.cresult->alimitedp arg1-rw))
+                 (arg1-prime   (rw.trace->rhs arg1-trace)))
+            (if (logic.constantp arg1-prime)
+                ;; Here we don't have to use a new cache, because we don't make a new assm
+                ;; We say we are limited if arg2/3 is limited.
+                (if (logic.unquote arg1-prime)
+                    (let* ((arg2-rw      (rw.crewrite-core$ arg2 :cache arg1-cache))
+                           (arg2-trace   (rw.cresult->data arg2-rw))
+                           (arg2-cache   (rw.cresult->cache arg2-rw))
+                           (arg2-limited (rw.cresult->alimitedp arg2-rw))
+                           (ret-trace    (rw.if-specialcase-t-trace arg1-trace arg2-trace arg3)))
+                      (rw.cresult ret-trace arg2-cache arg2-limited))
+                  (let* ((arg3-rw      (rw.crewrite-core$ arg3 :cache arg1-cache))
+                         (arg3-trace   (rw.cresult->data arg3-rw))
+                         (arg3-cache   (rw.cresult->cache arg3-rw))
+                         (arg3-limited (rw.cresult->alimitedp arg3-rw))
+                         (ret-trace    (rw.if-specialcase-nil-trace arg1-trace arg3-trace arg2)))
+                    (rw.cresult ret-trace arg3-cache arg3-limited)))
+              ;; Here we have to start new caches because we make new assumptions.
+              (let* ((arg2-rw      (rw.crewrite-core$ arg2 :cache (rw.empty-cache) :assms (rw.assume-left (logic.function 'not (list arg1-prime)) assms)))
+                     (arg2-trace   (rw.cresult->data arg2-rw))
+                     (arg2-limited (rw.cresult->alimitedp arg2-rw))
+                     (arg3-rw      (rw.crewrite-core$ arg3 :cache (rw.empty-cache) :assms (rw.assume-left arg1-prime assms)))
+                     (arg3-trace   (rw.cresult->data arg3-rw))
+                     (arg3-limited (rw.cresult->alimitedp arg3-rw)))
+                (if (equal (rw.trace->rhs arg2-trace) (rw.trace->rhs arg3-trace))
+                    ;; Produced (if x y y); canonicalize to y
+                    (let ((ret-trace (rw.crewrite-if-specialcase-same-trace arg1-trace arg2-trace arg3-trace)))
+                      (rw.cresult ret-trace arg1-cache (and arg2-limited arg3-limited)))
+                  (let* ((general-trace (rw.crewrite-if-generalcase-trace arg1-trace arg2-trace arg3-trace))
+                         (gt-args       (logic.function-args (rw.trace->rhs general-trace))))
+                    (if (and (equal (second gt-args) ''nil)
+                             (equal (third gt-args) ''t))
+                        ;; Produced (if x nil t); canonicalize to (not x)
+                        (let* ((can-trace (rw.negative-if-trace (first gt-args) iffp (rw.assms->hypbox assms)))
+                               (ret-trace (rw.transitivity-trace general-trace can-trace)))
+                          (rw.cresult ret-trace arg1-cache arg1-limited))
+                      ;; Produced (if x' y' z')
+                      (rw.cresult general-trace arg1-cache (or arg1-limited arg2-limited arg3-limited)))))))))
+         ((and (logic.functionp x)
+               (equal (logic.function-name x) 'not)
+               (equal (len (logic.function-args x)) 1))
+          ;; We don't cache "not" expressions, so there's no need to consult the cache
+          (let* ((args          (logic.function-args x))
+                 (arg1          (first args))
+                 (arg1-rw       (rw.crewrite-core$ arg1 :iffp t))
+                 (arg1-trace    (rw.cresult->data arg1-rw))
+                 (arg1-cache    (rw.cresult->cache arg1-rw))
+                 (arg1-limitedp (rw.cresult->alimitedp arg1-rw))
+                 (main-trace    (rw.not-trace arg1-trace iffp))
+                 ;; -- We don't try rules; you shouldn't target "not" with a rewrite rule
+                 ;; -- We don't try evaluation; rw.not-trace already evaluates (not t) and (not nil)
+                 (main-rhs      (rw.trace->rhs main-trace))
+                 ;; I'm not sure if we should use assms here or not, but "why not?"
+                 (assm-trace    (and (not (logic.constantp main-rhs))
+                                     (rw.assumptions-trace assms main-rhs iffp)))
+                 (ret-trace     (rw.maybe-extend-trace main-trace assm-trace))
+                 (ret-limitedp  (if assm-trace
+                                    (and arg1-limitedp (not (logic.constantp (rw.trace->rhs assm-trace))))
+                                  arg1-limitedp)))
+            (rw.cresult ret-trace arg1-cache ret-limitedp)))
+
+         ((logic.functionp x)
+          ;; Generic handling for other functions than "if".
+          (let* ((name       (logic.function-name x))
+                 (args       (logic.function-args x))
+                 (hypbox     (rw.assms->hypbox assms))
+                 ;; We immediately try evaluation.  Without this, "constant-gathering" rules that
+                 ;; break normal forms can get into loops with outside-in rules.
+                 (eval-trace (and (logic.constant-listp args)
+                                  (rw.try-ground-simplify hypbox x iffp control))))
+            (if eval-trace
+                ;; The term was evaluated.  We know the result is a constant and is canonical under iffp.
+                ;; No more work can be done, so just return it.
+                (rw.cresult eval-trace cache nil)
+              ;; Now we try to use outside-in rewrite rules.
+              (let* ((theory       (rw.control->theory control))
+                     (rulemap      (rw.theory-lookup x theory))
+                     (out-rules    (cdr (lookup 'outside rulemap)))
+                     (out-rw       (rw.crewrite-try-rules$ x out-rules))
+                     (out-trace    (rw.cresult->data out-rw))
+                     (out-cache    (rw.cresult->cache out-rw))
+                     (out-limitedp (rw.cresult->alimitedp out-rw)))
+                (if out-trace
+                    ;; An outside-in rule worked.  We don't have any idea what the result looks like, so
+                    ;; we recur if we're allowed to.
+                    (if (zp rlimit)
+                        (ACL2::prog2$ (rw.rlimit-warn)
+                                      (rw.cresult out-trace out-cache out-limitedp))
+                      (let* ((next-rw       (rw.crewrite-core$ (rw.trace->rhs out-trace) :rlimit (- rlimit 1) :cache out-cache))
+                             (next-trace    (rw.cresult->data next-rw))
+                             (next-cache    (rw.cresult->cache next-rw))
+                             (next-limitedp (rw.cresult->alimitedp next-rw))
+                             (ret-trace     (rw.transitivity-trace out-trace next-trace)))
+                        (rw.cresult ret-trace next-cache next-limitedp)))
+                  ;; Otherwise, no outside-in rules applied.  Rewrite the arguments.
+                  (let* ((args-rw        (rw.crewrite-core-list$ args :iffp nil))
+                         (args-traces    (rw.cresult->data args-rw))
+                         (args-cache     (rw.cresult->cache args-rw))
+                         (args-limitedp  (rw.cresult->alimitedp args-rw))
+                         (part1-trace    (rw.equiv-by-args-trace hypbox name iffp args-traces)) ;; (f args) == (f args')
+                         (term-prime     (rw.trace->rhs part1-trace))
+                         (args-prime     (logic.function-args term-prime))
+                         (cache-trace    (rw.cache-lookup term-prime iffp args-cache)))
+                    (if cache-trace
+                        ;; (f args') is cached; we assume the result is fully rewritten
+                        (let ((final-trace (rw.transitivity-trace part1-trace cache-trace)))
+                          (rw.cresult final-trace args-cache nil))
+                      (let ((eval-trace (and (logic.constant-listp args-prime)
+                                             (rw.try-ground-simplify hypbox term-prime iffp control))))
+                        (if eval-trace
+                            ;; (f args') can be evaluated; we cache the result
+                            (let ((final-trace (rw.transitivity-trace part1-trace eval-trace))
+                                  (new-cache   (rw.cache-update term-prime eval-trace iffp args-cache)))
+                              (rw.cresult final-trace new-cache nil))
+
+                          ;; We still might be able to use rules or assms.
+                          (let* ((in-rules       (cdr (lookup 'inside rulemap)))
+                                 (in-rw          (rw.crewrite-try-rules$ term-prime in-rules :cache args-cache))
+                                 (in-trace       (rw.cresult->data in-rw))
+                                 (in-cache       (rw.cresult->cache in-rw))
+                                 (in-limitedp    (rw.cresult->alimitedp in-rw)))
+
+                            (if in-trace
+                                ;; part1-trace: (f args) == (f args')
+                                ;; in-trace:    (f args') == alpha
+                                ;; we don't know anything about alpha, so recursively rewrite it, if allowed.
+                                (if (zp rlimit)
+                                    (let ((ret-trace (rw.transitivity-trace part1-trace in-trace)))
+                                      (ACL2::prog2$
+                                       ;; we call a rw.rlimit-warn to print the rlimit warning.  this function gets modified
+                                       ;; via "advise" when we want to debug loops.
+                                       (rw.rlimit-warn)
+                                       (rw.cresult ret-trace in-cache (or args-limitedp in-limitedp))))
+                                  ;; allowed to recur
+                                  (let* ((next-rw       (rw.crewrite-core$ (rw.trace->rhs in-trace) :rlimit (- rlimit 1) :cache in-cache))
+                                         ;; next-trace: alpha == alpha'
+                                         (next-trace    (rw.cresult->data next-rw))
+                                         (next-cache    (rw.cresult->cache next-rw))
+                                         (next-limitedp (rw.cresult->alimitedp next-rw))
+                                         ;; part2-trace: (f args') == alpha'
+
+                                         ;; HORRIBLE.  SUBTLE.  In the proof, to show that rw.maybe-update-cache makes
+                                         ;; a legitimage cachep, we need to know that the trace we give it agrees with
+                                         ;; the iffp we give it.  but we don't prove the property of iffp until after
+                                         ;; we prove cachep.  Horrible.
+                                         ;;
+                                         ;; We can't just use (rw.trace->iffp part2-trace), because the fast rewriter's
+                                         ;; traces have no such concept.
+                                         ;;
+                                         ;; So what we do is "seed" part2-trace by creating a failure trace to begin
+                                         ;; with, and then maybe-extending it.  This gives us a trace which we know
+                                         ;; agrees with iffp, whereas if we start with in-trace, we can't be sure
+                                         ;; until we've done the whole analysis on the crewrite nest.
+
+                                         (part2-trace   (rw.fail-trace hypbox term-prime iffp))         ;; (f args') == (f args')
+                                         (part2-trace   (rw.transitivity-trace part2-trace in-trace))   ;; (f args') == alpha
+                                         (part2-trace   (rw.transitivity-trace part2-trace next-trace)) ;; (f args') == alpha'
+
+                                         ;; final-trace: (f args) == alpha'
+                                         (final-trace   (rw.transitivity-trace part1-trace part2-trace)) ;; (f args) == alpha'
+
+                                         ;; acl2 seems upset about this new cache.
+                                         (new-cache     (ACL2::prog2$ (rw.rlimit-exit rlimit final-trace)
+                                                                      ;; The result is limited only if the next-rw is limited
+                                                                      ;; New cache adds (f args') == alpha'
+                                                                      (rw.maybe-update-cache (not next-limitedp)
+                                                                                             term-prime
+                                                                                             part2-trace
+                                                                                             iffp
+                                                                                             next-cache))))
+
+                                    (rw.cresult final-trace new-cache next-limitedp)))
+
+
+                              ;; Otherwise, rules failed.  Try assumptions.
+                             (let ((assm-trace (rw.assumptions-trace assms term-prime iffp)))
+                                (if assm-trace
+                                    ;; part1-trace: (f args) == (f args')
+                                    ;; assm-trace: (f args') == alpha
+                                    ;; Again we know nothing about alpha, so recursively rewrite it, if allowed.
+                                    (if (zp rlimit)
+                                        ;; Not allowed to recur.  As before.
+                                        (let ((ret-trace (rw.transitivity-trace part1-trace assm-trace)))
+                                          (ACL2::prog2$ (rw.rlimit-warn)
+                                                        (rw.cresult ret-trace in-cache (or args-limitedp in-limitedp))))
+                                      ;; Allowed to recur.
+                                      (let* ((next-rw       (rw.crewrite-core$ (rw.trace->rhs assm-trace) :rlimit (- rlimit 1) :cache in-cache))
+                                             ;; next-trace: alpha == alpha'
+                                             (next-trace    (rw.cresult->data next-rw))
+                                             (next-cache    (rw.cresult->cache next-rw))
+                                             (next-limitedp (rw.cresult->alimitedp next-rw))
+                                             ;; part2-trace: (f args') == alpha'
+                                             (part2-trace   (rw.transitivity-trace assm-trace next-trace))
+                                             ;; final-trace: (f args) == alpha'
+                                             (final-trace   (rw.transitivity-trace part1-trace part2-trace))
+                                             (new-cache     (ACL2::prog2$ (rw.rlimit-exit rlimit final-trace)
+                                                                          ;; The result is limited only if the next-rw is limited
+                                                                          ;; New cache adds (f args') == alpha'
+                                                                          (rw.maybe-update-cache (not next-limitedp) term-prime part2-trace iffp next-cache))))
+                                        (rw.cresult final-trace new-cache next-limitedp)))
+
+                                  ;; Otherwise, assms and rules failed.
+                                  ;; We'll just use the result of rewriting the args.
+                                  (let* ((limitedp   (or args-limitedp in-limitedp))
+                                         (fail-trace (rw.fail-trace hypbox term-prime iffp))
+                                         (new-cache  (rw.maybe-update-cache (not limitedp) term-prime fail-trace iffp in-cache)))
+                                    (ACL2::prog2$ (rw.rlimit-exit rlimit part1-trace)
+                                                  (rw.cresult part1-trace new-cache limitedp))))))))))))))))
+
+         ((logic.lambdap x)
+          (let* ((formals       (logic.lambda-formals x))
+                 (body          (logic.lambda-body x))
+                 (actuals       (logic.lambda-actuals x))
+                 (args-rw       (rw.crewrite-core-list$ actuals :iffp nil))
+                 (args-traces   (rw.cresult->data args-rw))
+                 (args-cache    (rw.cresult->cache args-rw))
+                 (args-limitedp (rw.cresult->alimitedp args-rw))
+                 ;; We'll return the best "ret trace" we can come up with.
+                 (hypbox        (rw.assms->hypbox assms))
+                 (ret-trace1    (rw.lambda-equiv-by-args-trace hypbox formals body iffp args-traces))
+                 (term-prime    (rw.trace->rhs ret-trace1))
+                 (args-prime    (logic.lambda-actuals term-prime))
+                 ;; First try evaluation if all the actuals are constants.
+                 (eval-trace    (and (logic.constant-listp args-prime)
+                                     (rw.try-ground-simplify hypbox term-prime iffp control))))
+            (if eval-trace
+                ;; We evaluated the term successfully so it's a constant; nothing more to do.
+                (let ((final-trace (rw.transitivity-trace ret-trace1 eval-trace)))
+                  (rw.cresult final-trace args-cache nil))
+              ;; Else we might be allowed to beta reduce it. We've decided not to do anything else here.
+              ;; BOZO this seems weird; don't we want to recursively rewrite?  I guess we'll get it on the next pass?
+              (if (rw.control->betap control)
+                  (let ((final-trace (rw.transitivity-trace ret-trace1 (rw.beta-reduction-trace hypbox term-prime iffp))))
+                    (rw.cresult final-trace args-cache args-limitedp))
+                (rw.cresult ret-trace1 args-cache args-limitedp)))))
+         (t nil)))
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/definitions.lisp acl2-6.3/books/milawa/ACL2/rewrite/definitions.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/definitions.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/definitions.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,188 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../logic/top")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Function definitions are formulas of the form
+;;
+;;  (fn arg1 ... argn) = body
+;;
+;; Where fn is some function symbol, arg1, ..., argn are a list of distinct
+;; variables, and body is a term which only mentions the variables arg1, ...,
+;; argn.
+;;
+;; BOZO shouldn't this be guarded with formulap?  I guess for now
+;; we'll leave it alone. It's sort of strange that we're re-using formulas
+;; instead of writing a new data structure, but I guess it's simple enough.
+
+(defund definitionp (x)
+  (declare (xargs :guard t))
+  (and (logic.formulap x)
+       (equal (logic.fmtype x) 'pequal*)
+       (let ((lhs (logic.=lhs x))
+             (rhs (logic.=rhs x)))
+         (and (logic.functionp lhs)
+              (let ((formals (logic.function-args lhs)))
+                (and (logic.variable-listp formals)
+                     (uniquep formals)
+                     (subsetp (logic.term-vars rhs) formals)))))))
+
+(defthm booleanp-of-definitionp
+  (equal (booleanp (definitionp x))
+         t)
+  :hints(("Goal" :in-theory (enable definitionp))))
+
+(defthm logic.formulap-when-definitionp
+  (implies (definitionp x)
+           (equal (logic.formulap x)
+                  t))
+  :hints(("Goal" :in-theory (enable definitionp))))
+
+(defthm logic.fmtype-when-definitionp
+  (implies (definitionp x)
+           (equal (logic.fmtype x) 'pequal*))
+  :hints(("Goal" :in-theory (enable definitionp))))
+
+(defthm logic.functionp-of-logic.=lhs-when-definitionp
+  (implies (definitionp x)
+           (equal (logic.functionp (logic.=lhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable definitionp))))
+
+(defthm logic.variable-listp-of-logic.function-args-of-logic.=lhs-when-definitionp
+  (implies (definitionp x)
+           (equal (logic.variable-listp (logic.function-args (logic.=lhs x)))
+                  t))
+  :hints(("Goal" :in-theory (enable definitionp))))
+
+(defthm uniquep-of-logic.function-args-of-logic.=lhs-when-definitionp
+  (implies (definitionp x)
+           (equal (uniquep (logic.function-args (logic.=lhs x)))
+                  t))
+  :hints(("Goal" :in-theory (enable definitionp))))
+
+(defthm subsetp-of-logic.term-vars-of-logic.=rhs-when-definitionp
+  (implies (definitionp x)
+           (equal (subsetp (logic.term-vars (logic.=rhs x))
+                           (logic.function-args (logic.=lhs x)))
+                  t))
+  :hints(("Goal" :in-theory (enable definitionp))))
+
+
+
+(deflist definition-listp (x)
+  (definitionp x)
+  :elementp-of-nil nil)
+
+(defthm logic.formula-listp-when-definition-listp
+  (implies (definition-listp x)
+           (equal (logic.formula-listp x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund definition-list-lookup (fn x)
+  (declare (xargs :guard (and (logic.function-namep fn)
+                              (definition-listp x))))
+  (if (consp x)
+      (if (equal fn (logic.function-name (logic.=lhs (car x))))
+          (car x)
+        (definition-list-lookup fn (cdr x)))
+    nil))
+
+(defthm definition-list-lookup-when-not-consp
+  (implies (not (consp x))
+           (equal (definition-list-lookup fn x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-list-lookup))))
+
+(defthm definition-list-lookup-of-cons
+  (equal (definition-list-lookup fn (cons a x))
+         (if (equal fn (logic.function-name (logic.=lhs a)))
+             a
+           (definition-list-lookup fn x)))
+  :hints(("Goal" :in-theory (enable definition-list-lookup))))
+
+(defthm definitionp-of-definition-list-lookup
+  (implies (force (definition-listp x))
+           (equal (definitionp (definition-list-lookup fn x))
+                  (if (definition-list-lookup fn x)
+                      t
+                    nil)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.formula-atblp-of-definition-list-lookup
+  (implies (and (force (definition-listp x))
+                (force (logic.formula-list-atblp x atbl)))
+           (equal (logic.formula-atblp (definition-list-lookup fn x) atbl)
+                  (if (definition-list-lookup fn x)
+                      t
+                    nil)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-definition-list-lookup
+  (implies (and (definition-listp defs)
+                (definition-list-lookup fn defs))
+           (equal (memberp (definition-list-lookup fn defs) defs)
+                  t))
+  :hints(("Goal" :induct (cdr-induction defs))))
+
+(defthm forcing-logic.fmtype-of-definition-list-lookup
+  (implies (and (force (definition-listp defs))
+                (definition-list-lookup name defs))
+           (equal (logic.fmtype (definition-list-lookup name defs))
+                  'pequal*))
+  :hints(("Goal" :in-theory (enable definition-list-lookup definitionp))))
+
+(defthm forcing-logic.function-name-of-logic.=lhs-of-definition-list-lookup
+  (implies (definition-list-lookup name defs)
+           (equal (logic.function-name (logic.=lhs (definition-list-lookup name defs)))
+                  name))
+  :hints(("Goal" :in-theory (enable definition-list-lookup))))
+
+(defthm forcing-logic.functionp-of-logic.=lhs-of-definition-list-lookup
+  (implies (and (definition-list-lookup name defs)
+                (force (definition-listp defs)))
+           (equal (logic.functionp (logic.=lhs (definition-list-lookup name defs)))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-list-lookup definitionp))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/evaluator-bldr.lisp acl2-6.3/books/milawa/ACL2/rewrite/evaluator-bldr.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/evaluator-bldr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/evaluator-bldr.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,576 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "evaluator")
+(include-book "../build/lambda")
+(include-book "../build/equal")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; We now work to prove that the generic-evaluator is sound.  That is, if all
+;; of the guards are satisfied (we have a ground term, we have definitional
+;; axioms for each definition in the database, etc.) and the generic-evaluator
+;; does not fail (i.e., the "n" used is sufficient, etc.), then it follows that
+;; the input term is provably equal to the value produced by the generic
+;; evaluator.
+;;
+;; Our proof strategy should not be surprising if you have read through the
+;; previous extensions, such as tautology checking.  We will write a new
+;; function, generic-evaluator-bldr (and its mutually recursive counterpart)
+;; which will build a proof that an input term is equal to its value whenever
+;; generic-evaluator is able to evaluate it.
+
+(defderiv eval-lemma-1-bldr
+  :derive (= (if (? a) (? b) (? c)) (? b2))
+  :from   ((proof x (= (? a) (? a2)))
+           (proof y (= (? b) (? b2)))
+           (term c (? c)))
+  :where  ((logic.constantp (@term (? a2)))
+           (iff (logic.unquote (@term (? a2))) t))
+  :proof (@derive
+          ((!= (? a2) nil)                                     (build.not-pequal-constants (@term (? a2)) (@term nil)))
+          ((= (? a) (? a2))                                    (@given x))
+          ((!= (? a) nil)                                      (build.substitute-into-not-pequal @-- @-)     *1)
+          ((v (= x nil) (= (if x y z) y))                      (build.axiom (axiom-if-when-not-nil)))
+          ((v (= (? a) nil) (= (if (? a) (? b) (? c)) (? b)))  (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+          ((= (if (? a) (? b) (? c)) (? b))                    (build.modus-ponens-2 *1 @-))
+          ((= (? b) (? b2))                                    (@given y))
+          ((= (if (? a) (? b) (? c)) (? b2))                   (build.transitivity-of-pequal @-- @-)))
+  :minatbl ((if . 3)
+            (equal . 2)))
+
+(defderiv eval-lemma-2-bldr
+  :derive (= (if (? a) (? b) (? c)) (? c2))
+  :from   ((proof x (= (? a) nil))
+           (proof y (= (? c) (? c2)))
+           (term then (? b)))
+  :proof (@derive
+          ((v (!= x nil) (= (if x y z) z))                       (build.axiom (axiom-if-when-nil)))
+          ((v (!= (? a) nil) (= (if (? a) (? b) (? c)) (? c)))   (build.instantiation @- (@sigma (x . (? a)) (y . (? b)) (z . (? c)))))
+          ((= (? a) nil)                                         (@given x))
+          ((= (if (? a) (? b) (? c)) (? c))                      (build.modus-ponens @- @--))
+          ((= (? c) (? c2))                                      (@given y))
+          ((= (if (? a) (? b) (? c)) (? c2))                     (build.transitivity-of-pequal @-- @-)))
+  :minatbl ((if . 3)))
+
+
+
+
+
+;: generic-evaluator-bldr
+;: Derive (f c1 ... cn) = val
+;:   where c1,...,cn are constants and
+;:   the computation successfully completes.
+;:
+;; We are finally ready to introduce the function that can build a proof that
+;; the input term is equal to the evaluator's output.
+;;
+;; Note that generic-evaluator can fail.  If it fails, our builder will return
+;; nil.  Otherwise, we will produce a proof that term = result.  (In the list
+;; case, we return nil or (cons t proofs), where proofs is a list of proofs
+;; which conclude arg1=val1, ..., argn=valn.)
+
+(defund flag-generic-evaluator-bldr (flag x defs n)
+  (declare (xargs :guard (and (definition-listp defs)
+                              (natp n)
+                              (if (equal flag 'term)
+                                  (and (logic.termp x)
+                                       (logic.groundp x)
+                                       (generic-evaluator x defs n))
+                                (and (logic.term-listp x)
+                                     (logic.ground-listp x)
+                                     (generic-evaluator-list x defs n))))
+                  :measure (two-nats-measure n (rank x))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((zp n)
+             ;; Insufficient "n" to evaluate this term.
+             nil)
+            ((logic.constantp x)
+             ;; Constants evaluate to themselves.
+             (build.reflexivity x))
+            ((logic.variablep x)
+             ;; Not a ground term.
+             nil)
+            ((logic.functionp x)
+             (let ((fn   (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (equal fn 'if)
+                   ;; Special lazy handling of the if function for recursive termination.
+                   (and (equal (len args) 3)
+                        (let ((arg1-proof (flag-generic-evaluator-bldr 'term (first args) defs n)))
+                          (and arg1-proof
+                               (let ((arg1-prime (logic.=rhs (logic.conclusion arg1-proof))))
+                                 (if (logic.unquote arg1-prime)
+                                     ;; Arg1 evaluted to a non-nil constant.
+                                     (let ((arg2-proof (flag-generic-evaluator-bldr 'term (second args) defs n)))
+                                       (and arg2-proof
+                                            (eval-lemma-1-bldr arg1-proof arg2-proof (third args))))
+                                   ;; Arg1 evaluated to nil.
+                                   (let ((arg3-proof (flag-generic-evaluator-bldr 'term (third args) defs n)))
+                                     (and arg3-proof
+                                          (eval-lemma-2-bldr arg1-proof arg3-proof (second args)))))))))
+                 ;; We eagerly evaluate the arguments to functions other than "if".
+                 (let ((aproofs+ (flag-generic-evaluator-bldr 'list args defs n)))
+                   (and aproofs+
+                        ;; Arguments successfully evaluated; aproofs+ is of the form
+                        ;; (t . [proofs of arg1=val1 ... argn=valn])
+                        (let* ((aproofs (cdr aproofs+))
+                               (vals    (logic.=rhses (logic.strip-conclusions aproofs))))
+                          (if (memberp fn (domain (logic.initial-arity-table)))
+                              ;; We found a base function
+                              (and (equal (cdr (lookup fn (logic.initial-arity-table))) (len aproofs))
+                                   ;; Goal: (fn arg1 ... argn) = result.
+                                   ;;   1. (fn arg1 ... argn) = (fn val1 ... valn) by logic.pequal by args
+                                   ;;   2. (fn val1 ... valn) = result             by base evaluation
+                                   ;;   3. (fn arg1 ... argn) = result             by transitivity of =
+                                   ;; Q.E.D.
+                                   (build.transitivity-of-pequal (build.pequal-by-args fn aproofs)
+                                                                 (build.base-eval (logic.function fn vals))))
+                            ;; We found a defined function
+                            (let* ((def (definition-list-lookup fn defs)))
+                              (and def
+                                   (let ((formals (logic.function-args (logic.=lhs def)))
+                                         (body    (logic.=rhs def)))
+                                     (and (equal (len formals) (len aproofs))
+                                          ;; Substitute the values into the body and recursively evaluate the result.
+                                          (let* ((sigma       (pair-lists formals vals))
+                                                 (ground-body (logic.substitute body sigma))
+                                                 (body-proof  (flag-generic-evaluator-bldr 'term ground-body defs (- n 1))))
+                                            (and body-proof
+                                                 ;; Goal: (fn arg1 ... argn) = value
+                                                 ;;  1. body/sigma = value                      by our body-proof
+                                                 ;;  2. (fn val1 ... valn) = body/sigma         by instantiation fn's definition
+                                                 ;;  3. (fn val1 ... valn) = value              by transitivity of =
+                                                 ;;  4. arg1=val1 ... argn=valn                 by aproofs
+                                                 ;;  5. (fn arg1 ... argn) = (fn val1 ... valn) by pequal-by-args
+                                                 ;;  6. (fn arg1 ... argn) = value              by transitivity of =
+                                                 ;; Q.E.D.
+                                                 (build.transitivity-of-pequal (build.pequal-by-args fn aproofs)
+                                                                               (build.transitivity-of-pequal
+                                                                                (build.instantiation (build.axiom def) sigma)
+                                                                                body-proof)))))))))))))))
+            ((logic.lambdap x)
+             (let ((formals  (logic.lambda-formals x))
+                   (body     (logic.lambda-body x))
+                   (actuals  (logic.lambda-actuals x)))
+               (let ((aproofs+ (flag-generic-evaluator-bldr 'list actuals defs n)))
+                 (and aproofs+
+                      (let* ((vals       (logic.=rhses (logic.strip-conclusions (cdr aproofs+))))
+                             (sigma      (pair-lists formals vals))
+                             (body-proof (flag-generic-evaluator-bldr 'term (logic.substitute body sigma) defs (- n 1))))
+                        (and body-proof
+                             ;; Goal: ((lambda formals body) actuals) = result
+                             ;;  1. actuals[i] = values[i]                                            by aproofs
+                             ;;  2. ((lambda formals body) actuals) = ((lambda formals body) values)  by logic.pequal by args
+                             ;;  3. ((lambda formals body) values) = body/[formals<-values]           by beta reduction
+                             ;;  4. ((lambda formals body) actuals) = body/[formals<-values]          by transitivity of =
+                             ;;  5. body/[formals<-values] = result                                   by body-proof
+                             ;;  6. ((lambda formals body) actuals) = result                          by transitivity of =
+                             ;;
+                             ;; Q.E.D.
+                             (build.transitivity-of-pequal (build.transitivity-of-pequal
+                                                            (build.lambda-pequal-by-args formals body (cdr aproofs+))
+                                                            (build.beta-reduction formals body vals))
+                                                           body-proof)))))))
+            (t nil))
+    (if (consp x)
+        ;; Try to evaluate the first argument and then, recursively, the rest of
+        ;; the arguments.
+        (let ((first (flag-generic-evaluator-bldr 'term (car x) defs n))
+              (rest  (flag-generic-evaluator-bldr 'list (cdr x) defs n)))
+          (if (and first rest)
+              ;; SUCCESS: evaluated the first and all other arguments.
+              (cons t (cons first (cdr rest)))
+            ;; FAILURE: couldn't evaluate some argument.
+            nil))
+      ;; SUCCESS: the empty list can always be evaluted.
+      (cons t nil))))
+
+(definlined generic-evaluator-bldr (x defs n)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.groundp x)
+                              (definition-listp defs)
+                              (natp n)
+                              (generic-evaluator x defs n))
+                  :verify-guards nil))
+  (flag-generic-evaluator-bldr 'term x defs n))
+
+(definlined generic-evaluator-list-bldr (x defs n)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.ground-listp x)
+                              (definition-listp defs)
+                              (natp n)
+                              (generic-evaluator-list x defs n))
+                  :verify-guards nil))
+  (flag-generic-evaluator-bldr 'list x defs n))
+
+(defthmd definition-of-generic-evaluator-bldr
+  (equal (generic-evaluator-bldr x defs n)
+         (cond ((zp n)
+                ;; Insufficient "n" to evaluate this term.
+                nil)
+               ((logic.constantp x)
+                ;; Constants evaluate to themselves.
+                (build.reflexivity x))
+               ((logic.variablep x)
+                ;; Not a ground term.
+                nil)
+               ((logic.functionp x)
+                (let ((fn   (logic.function-name x))
+                      (args (logic.function-args x)))
+                  (if (equal fn 'if)
+                      ;; Special lazy handling of the if function for recursive termination.
+                      (and (equal (len args) 3)
+                           (let ((arg1-proof (generic-evaluator-bldr (first args) defs n)))
+                             (and arg1-proof
+                                  (let ((arg1-prime (logic.=rhs (logic.conclusion arg1-proof))))
+                                    (if (logic.unquote arg1-prime)
+                                        ;; Arg1 evaluted to a non-nil constant.
+                                        (let ((arg2-proof (generic-evaluator-bldr (second args) defs n)))
+                                          (and arg2-proof
+                                               (eval-lemma-1-bldr arg1-proof arg2-proof (third args))))
+                                      ;; Arg1 evaluated to nil.
+                                      (let ((arg3-proof (generic-evaluator-bldr (third args) defs n)))
+                                        (and arg3-proof
+                                             (eval-lemma-2-bldr arg1-proof arg3-proof (second args)))))))))
+
+                    ;; We eagerly evaluate the arguments to functions other than "if".
+                    (let ((aproofs+ (generic-evaluator-list-bldr args defs n)))
+                      (and aproofs+
+                           ;; Arguments successfully evaluated; aproofs+ is of the form
+                           ;; (t . [proofs of arg1=val1 ... argn=valn])
+                           (let* ((aproofs (cdr aproofs+))
+                                  (vals    (logic.=rhses (logic.strip-conclusions aproofs))))
+
+                             (if (memberp fn (domain (logic.initial-arity-table)))
+                                 ;; We found a base function
+                                 (and (equal (cdr (lookup fn (logic.initial-arity-table))) (len aproofs))
+                                      ;; Goal: (fn arg1 ... argn) = result.
+                                      ;;   1. (fn arg1 ... argn) = (fn val1 ... valn) by logic.pequal by args
+                                      ;;   2. (fn val1 ... valn) = result             by base evaluation
+                                      ;;   3. (fn arg1 ... argn) = result             by transitivity of =
+                                      ;; Q.E.D.
+                                      (build.transitivity-of-pequal (build.pequal-by-args fn aproofs)
+                                                                    (build.base-eval (logic.function fn vals))))
+                               ;; We found a defined function
+                               (let* ((def (definition-list-lookup fn defs)))
+                                 (and def
+                                      (let ((formals (logic.function-args (logic.=lhs def)))
+                                            (body    (logic.=rhs def)))
+                                        (and (equal (len formals) (len aproofs))
+                                             ;; Substitute the values into the body and recursively evaluate the result.
+                                             (let* ((sigma       (pair-lists formals vals))
+                                                    (ground-body (logic.substitute body sigma))
+                                                    (body-proof  (generic-evaluator-bldr ground-body defs (- n 1))))
+                                               (and body-proof
+                                                    ;; Goal: (fn arg1 ... argn) = value
+                                                    ;;  1. body/sigma = value                      by our body-proof
+                                                    ;;  2. (fn val1 ... valn) = body/sigma         by instantiation fn's definition
+                                                    ;;  3. (fn val1 ... valn) = value              by transitivity of =
+                                                    ;;  4. arg1=val1 ... argn=valn                 by aproofs
+                                                    ;;  5. (fn arg1 ... argn) = (fn val1 ... valn) by pequal-by-args
+                                                    ;;  6. (fn arg1 ... argn) = value              by transitivity of =
+                                                    ;; Q.E.D.
+                                                    (build.transitivity-of-pequal (build.pequal-by-args fn aproofs)
+                                                                                  (build.transitivity-of-pequal
+                                                                                   (build.instantiation (build.axiom def) sigma)
+                                                                                   body-proof)))))))))))))))
+               ((logic.lambdap x)
+                (let ((formals  (logic.lambda-formals x))
+                      (body     (logic.lambda-body x))
+                      (actuals  (logic.lambda-actuals x)))
+                  (let ((aproofs+ (generic-evaluator-list-bldr actuals defs n)))
+                    (and aproofs+
+                         (let* ((vals       (logic.=rhses (logic.strip-conclusions (cdr aproofs+))))
+                                (sigma      (pair-lists formals vals))
+                                (body-proof (generic-evaluator-bldr (logic.substitute body sigma) defs (- n 1))))
+                           (and body-proof
+                                ;; Goal: ((lambda formals body) actuals) = result
+                                ;;  1. actuals[i] = values[i]                                            by aproofs
+                                ;;  2. ((lambda formals body) actuals) = ((lambda formals body) values)  by logic.pequal by args
+                                ;;  3. ((lambda formals body) values) = body/[formals<-values]           by beta reduction
+                                ;;  4. ((lambda formals body) actuals) = body/[formals<-values]          by transitivity of =
+                                ;;  5. body/[formals<-values] = result                                   by body-proof
+                                ;;  6. ((lambda formals body) actuals) = result                          by transitivity of =
+                                ;;
+                                ;; Q.E.D.
+                                (build.transitivity-of-pequal (build.transitivity-of-pequal
+                                                               (build.lambda-pequal-by-args formals body (cdr aproofs+))
+                                                               (build.beta-reduction formals body vals))
+                                                              body-proof)))))))
+               (t nil)))
+  :rule-classes :definition
+  :hints (("Goal"
+           :in-theory (enable generic-evaluator-bldr
+                              generic-evaluator-list-bldr
+                              flag-generic-evaluator-bldr)
+           :expand ((flag-generic-evaluator-bldr 'term x defs n)))))
+
+(defthmd definition-of-generic-evaluator-list-bldr
+  (equal (generic-evaluator-list-bldr x defs n)
+         (if (consp x)
+             ;; Try to evaluate the first argument and then, recursively, the rest of
+             ;; the arguments.
+             (let ((first (generic-evaluator-bldr (car x) defs n))
+                   (rest  (generic-evaluator-list-bldr (cdr x) defs n)))
+               (if (and first rest)
+                   ;; SUCCESS: evaluated the first and all other arguments.
+                   (cons t (cons first (cdr rest)))
+                 ;; FAILURE: couldn't evaluate some argument.
+                 nil))
+           ;; SUCCESS: the empty list can always be evaluted.
+           (cons t nil)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable generic-evaluator-bldr
+                             generic-evaluator-list-bldr
+                             flag-generic-evaluator-bldr))))
+
+(defthm flag-generic-evaluator-bldr-of-term
+  (equal (flag-generic-evaluator-bldr 'term x defs n)
+         (generic-evaluator-bldr x defs n))
+  :hints(("Goal" :in-theory (enable generic-evaluator-bldr))))
+
+(defthm flag-generic-evaluator-bldr-of-list
+  (equal (flag-generic-evaluator-bldr 'list x defs n)
+         (generic-evaluator-list-bldr x defs n))
+  :hints(("Goal" :in-theory (enable generic-evaluator-list-bldr))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition generic-evaluator-bldr))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition generic-evaluator-list-bldr))))
+
+(defobligations generic-evaluator-bldr
+  (build.reflexivity eval-lemma-1-bldr eval-lemma-2-bldr build.transitivity-of-pequal
+   build.pequal-by-args build.base-eval build.lambda-pequal-by-args))
+
+(defobligations generic-evaluator-list-bldr
+  (generic-evaluator-bldr))
+
+
+
+(defthm forcing-len-of-cdr-of-generic-evaluator-list-bldr
+  (implies (force (generic-evaluator-list-bldr x defs n))
+           (equal (len (cdr (generic-evaluator-list-bldr x defs n)))
+                  (len x)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable definition-of-generic-evaluator-list-bldr))))
+
+(local (defthm crock
+         (implies (submapp (logic.initial-arity-table) atbl)
+                  (equal (lookup 'if atbl)
+                         '(if . 3)))
+         :hints(("Goal"
+                 :in-theory (enable logic.initial-arity-table)
+                 :use ((:instance equal-of-lookups-when-submapp
+                                  (x (logic.initial-arity-table))
+                                  (y atbl)
+                                  (a 'if)))))))
+
+(defthms-flag
+  :shared-hyp (force (definition-listp defs))
+  :thms ((term forcing-logic.appealp-of-generic-evaluator-bldr
+               (implies (and (force (logic.termp x))
+                             (force (generic-evaluator x defs n)))
+                        (equal (logic.appealp (generic-evaluator-bldr x defs n))
+                               t)))
+         (term forcing-logic.conclusion-of-generic-evaluator-bldr
+               (implies (and (force (logic.termp x))
+                             (force (generic-evaluator x defs n)))
+                        (equal (logic.conclusion (generic-evaluator-bldr x defs n))
+                               (logic.pequal x (generic-evaluator x defs n)))))
+         (t forcing-consp-of-generic-evaluator-list-bldr
+            (implies (and (force (logic.term-listp x))
+                          (force (generic-evaluator-list x defs n)))
+                     (equal (consp (generic-evaluator-list-bldr x defs n))
+                            t)))
+         (t forcing-logic.appeal-listp-of-generic-evaluator-list-bldr
+            (implies (and (force (logic.term-listp x))
+                          (force (generic-evaluator-list x defs n)))
+                     (equal (logic.appeal-listp (cdr (generic-evaluator-list-bldr x defs n)))
+                            t)))
+         (t forcing-logic.strip-conclusions-of-generic-evaluator-list-bldr
+            (implies (and (force (logic.term-listp x))
+                          (force (generic-evaluator-list x defs n)))
+                     (equal (logic.strip-conclusions (cdr (generic-evaluator-list-bldr x defs n)))
+                            (logic.pequal-list x (cdr (generic-evaluator-list x defs n)))))))
+  :hints (("Goal"
+           :in-theory (e/d (definition-of-generic-evaluator
+                             definition-of-generic-evaluator-list
+                             definition-of-generic-evaluator-bldr
+                             definition-of-generic-evaluator-list-bldr
+                             flag-generic-evaluator)
+                           (forcing-lookup-of-logic.function-name))
+           :induct (flag-generic-evaluator flag x defs n))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (disable logic.unquote-under-iff-when-logic.constantp)))
+ (local (in-theory (disable forcing-lookup-of-logic.function-name)))
+
+ (local (defthm lemma1
+          (implies (and (generic-evaluator term defs n)
+                        (logic.termp term)
+                        (logic.functionp term)
+                        (equal (logic.function-name term) 'if)
+                        (logic.unquote (generic-evaluator (first (logic.function-args term)) defs n)))
+                   (generic-evaluator (second (logic.function-args term)) defs n))
+          :hints(("Goal" :in-theory (enable definition-of-generic-evaluator)))))
+
+ (local (defthm lemma2
+          (implies (and (generic-evaluator term defs n)
+                        (logic.functionp term)
+                        (equal (logic.function-name term) 'if)
+                        (not (logic.unquote (generic-evaluator (first (logic.function-args term)) defs n))))
+                   (generic-evaluator (third (logic.function-args term)) defs n))
+          :hints(("Goal" :in-theory (enable definition-of-generic-evaluator)))))
+
+ (local (defthm lemma3
+          (implies (and (generic-evaluator term defs n)
+                        (logic.functionp term)
+                        (equal (logic.function-name term) 'if))
+                   (generic-evaluator (first (logic.function-args term)) defs n))
+          :hints(("Goal" :in-theory (enable definition-of-generic-evaluator)))))
+
+ (local (defthm lemma4
+          (implies (and (generic-evaluator term defs n)
+                        (logic.functionp term)
+                        (not (equal (logic.function-name term) 'if))
+                        (not (lookup (logic.function-name term) (logic.initial-arity-table))))
+                   (generic-evaluator
+                    (logic.substitute
+                     (logic.=rhs (definition-list-lookup (logic.function-name term) defs))
+                     (pair-lists (logic.function-args (logic.=lhs (definition-list-lookup (logic.function-name term) defs)))
+                                 (cdr (generic-evaluator-list (logic.function-args term) defs n))))
+                    defs (- n 1)))
+          :hints(("Goal" :in-theory (enable definition-of-generic-evaluator)))))
+
+ (local (defthm lemma5
+          (implies (and (generic-evaluator term defs n)
+                        (logic.functionp term)
+                        (not (equal (logic.function-name term) 'if)))
+                   (generic-evaluator-list (logic.function-args term) defs n))
+          :hints(("Goal" :in-theory (enable definition-of-generic-evaluator)))))
+
+ (local (defthm lemma6
+          (implies (and (generic-evaluator term defs n)
+                        (not (logic.constantp term))
+                        (not (logic.variablep term))
+                        (not (logic.functionp term))
+                        (logic.termp term))
+                   (iff (generic-evaluator
+                         (logic.substitute (logic.lambda-body term)
+                                           (pair-lists (logic.lambda-formals term)
+                                                       (cdr (generic-evaluator-list (logic.lambda-actuals term) defs n))))
+                         defs (- n 1))
+                        t))
+          :hints(("Goal" :in-theory (enable definition-of-generic-evaluator)))))
+
+ (local (defthm lemma7
+          (implies (and (generic-evaluator term defs n)
+                        (not (logic.constantp term))
+                        (not (logic.variablep term))
+                        (not (logic.functionp term))
+                        (logic.termp term))
+                   (iff (generic-evaluator-list (logic.lambda-actuals term) defs n)
+                        t))
+          :hints(("Goal" :in-theory (enable definition-of-generic-evaluator)))))
+
+ (local (in-theory (enable logic.unquote-under-iff-when-logic.constantp)))
+
+ (verify-guards flag-generic-evaluator-bldr)
+ (verify-guards generic-evaluator-bldr
+                :hints(("Goal" :in-theory (enable definition-of-generic-evaluator
+                                                  definition-of-generic-evaluator-list)))))
+
+(defthm forcing-generic-evaluator-bldr-under-iff
+  (implies (and (force (logic.termp x))
+                (force (definition-listp defs))
+                (force (generic-evaluator x defs n)))
+           (iff (generic-evaluator-bldr x defs n)
+                t))
+  :hints(("Goal"
+          :in-theory (disable forcing-logic.appealp-of-generic-evaluator-bldr)
+          :use ((:instance forcing-logic.appealp-of-generic-evaluator-bldr)))))
+
+(defthm forcing-generic-evaluator-list-bldr-under-iff
+  (implies (and (force (logic.term-listp x))
+                (force (definition-listp defs))
+                (force (generic-evaluator-list x defs n)))
+           (iff (generic-evaluator-list-bldr x defs n)
+                t))
+  :hints(("Goal"
+          :in-theory (disable forcing-consp-of-generic-evaluator-list-bldr)
+          :use ((:instance forcing-consp-of-generic-evaluator-list-bldr)))))
+
+
+
+(defthms-flag
+  :@contextp t
+  :shared-hyp (force (and (definition-listp defs)
+                          (logic.formula-list-atblp defs atbl)
+                          (equal (cdr (lookup 'if atbl)) 3)
+                          (equal (cdr (lookup 'equal atbl)) 2)
+                          (subsetp defs axioms)
+                          (@obligations generic-evaluator-bldr)))
+  :thms ((term forcing-logic.proofp-of-generic-evaluator-bldr
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)
+                                    (generic-evaluator x defs n)))
+                        (equal (logic.proofp (generic-evaluator-bldr x defs n) axioms thms atbl)
+                               t)))
+         (t forcing-logic.proof-listp-of-generic-evaluator-list-bldr
+            (implies (force (and (logic.term-listp x)
+                                 (logic.term-list-atblp x atbl)
+                                 (generic-evaluator-list x defs n)))
+                     (equal (logic.proof-listp (cdr (generic-evaluator-list-bldr x defs n)) axioms thms atbl)
+                            t))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-generic-evaluator
+                              definition-of-generic-evaluator-list
+                              definition-of-generic-evaluator-bldr
+                              definition-of-generic-evaluator-list-bldr
+                              flag-generic-evaluator
+                              )
+           ;; :restrict ((forcing-lookup-of-logic.function-name ((atbl atbl))))
+           :induct (flag-generic-evaluator flag x defs n))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/evaluator.lisp acl2-6.3/books/milawa/ACL2/rewrite/evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/evaluator.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,313 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "definitions")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Below we introduce a generic evaluator function, and its mutually recursive
+;; counterpart.  There are three arguments:
+;;
+;;   term(-list)   A ground term(-list) that we want to evaluate
+;;   db            A database of definitions that we will use
+;;   n             An "artificial" counter to ensure termination
+;;
+;; Like any other Milawa function, our evaluator is total and is defined for
+;; all combinations of these inputs.  When the arguments are invalid in certain
+;; ways, these functions "fail".  For example, what does it mean to evaluate
+;; (f 1 2) if f is a function of arity 3?  Or suppose that our counter is too
+;; small to successfully complete a computation.
+;;
+;; If we cannot evaluate a term successfully, then our term evaluator returns
+;; nil.  In the list case, if *any* of our input terms cannot be evaluated
+;; successfully, we return nil to signal failure for the whole list.
+;;
+;; Otherwise, if we are able to successfully evaluate a term, we return the
+;; pair a (quoted) constant which represents this term's value.  For successful
+;; list cases, we return (t . [x1 ... xn]), where x1...xn are the values
+;; obtained by successively evaluating each term in the list.
+
+(defund flag-generic-evaluator (flag x defs n)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (and (logic.termp x)
+                                       (logic.groundp x))
+                                (and (logic.term-listp x)
+                                     (logic.ground-listp x)))
+                              (definition-listp defs)
+                              (natp n))
+                  :measure (two-nats-measure n (rank x))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond
+       ((zp n)
+        (ACL2::prog2$ (ACL2::cw "Warning: insufficient n given to generic-evaluator~%")
+                      nil))
+       ((logic.constantp x)
+        ;; SUCCESS: Constants evaluate to themselves.
+        x)
+       ((logic.variablep x)
+        ;; FAILURE: Not a ground term.
+        nil)
+       ((logic.functionp x)
+        (let ((name (logic.function-name x))
+              (args (logic.function-args x)))
+          (if (and (equal name 'if)
+                   (equal (len args) 3))
+              ;; "if" must be handled specially with lazy evaluation.
+              (let ((eval-test (flag-generic-evaluator 'term (first args) defs n)))
+                (and eval-test
+                     (if (logic.unquote eval-test)
+                         (flag-generic-evaluator 'term (second args) defs n)
+                       (flag-generic-evaluator 'term (third args) defs n))))
+            ;; other functions are eagerly evaluated.
+            (let ((eval-args (flag-generic-evaluator 'list args defs n)))
+              (and eval-args
+                   ;; eval-args is (t . ((quote val1) ... (quote valn)))
+                   (let* ((values     (cdr eval-args))
+                          (atbl-entry (lookup name (logic.initial-arity-table))))
+                     (if atbl-entry
+                         ;; found a base function
+                         (and (equal (cdr atbl-entry) (len values))
+                              (logic.base-evaluator (logic.function name values)))
+
+                       ;; found a non-base function
+                       (let* ((def (definition-list-lookup name defs)))
+                         (and def
+                              (let ((formals (logic.function-args (logic.=lhs def)))
+                                    (body    (logic.=rhs def)))
+                                (and (equal (len formals) (len values))
+                                     (flag-generic-evaluator 'term
+                                                             (logic.substitute body (pair-lists formals values))
+                                                             defs (- n 1)))))))))))))
+       ((logic.lambdap x)
+        ;; Eagerly evaluate the arguments to a lambda, then substitute them into
+        ;; the lambda's body.
+        (let ((formals (logic.lambda-formals x))
+              (body    (logic.lambda-body x))
+              (actuals (logic.lambda-actuals x)))
+          (let ((eval-actuals (flag-generic-evaluator 'list actuals defs n)))
+            (and eval-actuals
+                 ;; eval-actuals is (t . ((quote val1) ... (quote valn)))
+                 (let ((values (cdr eval-actuals)))
+                   (flag-generic-evaluator 'term
+                                           (logic.substitute body (pair-lists formals values))
+                                           defs
+                                           (- n 1)))))))
+       (t
+        ;; FAILURE: cannot evaluate malformed terms
+        nil))
+    (if (consp x)
+        ;; Try to evaluate the first argument and then, recursively, the rest of
+        ;; the arguments.
+        (let ((first (flag-generic-evaluator 'term (car x) defs n))
+              (rest  (flag-generic-evaluator 'list (cdr x) defs n)))
+          (if (and first rest)
+              ;; SUCCESS: evaluated the first and all other arguments.
+              (cons t (cons first (cdr rest)))
+            ;; FAILURE: couldn't evaluate some argument.
+            nil))
+      ;; SUCCESS: the empty list can always be evaluted.
+      (cons t nil))))
+
+(defund generic-evaluator (x defs n)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.groundp x)
+                              (definition-listp defs)
+                              (natp n))
+                  :verify-guards nil))
+  (flag-generic-evaluator 'term x defs n))
+
+(defund generic-evaluator-list (x defs n)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.ground-listp x)
+                              (definition-listp defs)
+                              (natp n))
+                  :verify-guards nil))
+  (flag-generic-evaluator 'list x defs n))
+
+(defthmd definition-of-generic-evaluator
+  (equal (generic-evaluator x defs n)
+         (cond
+          ((zp n)
+           ;; FAILURE: Insufficient "n" to evaluate this term.
+           nil)
+          ((logic.constantp x)
+           ;; SUCCESS: Constants evaluate to themselves.
+           x)
+          ((logic.variablep x)
+           ;; FAILURE: Not a ground term.
+           nil)
+          ((logic.functionp x)
+           (let ((name (logic.function-name x))
+                 (args (logic.function-args x)))
+             (if (and (equal name 'if)
+                      (equal (len args) 3))
+                 ;; "if" must be handled specially with lazy evaluation.
+                 (let ((eval-test (generic-evaluator (first args) defs n)))
+                   (and eval-test
+                        (if (logic.unquote eval-test)
+                            (generic-evaluator (second args) defs n)
+                          (generic-evaluator (third args) defs n))))
+               ;; other functions are eagerly evaluated.
+               (let ((eval-args (generic-evaluator-list args defs n)))
+                 (and eval-args
+                      ;; eval-args is (t . ((quote val1) ... (quote valn)))
+                      (let ((values (cdr eval-args)))
+                        (if (lookup name (logic.initial-arity-table))
+                            ;; found a base function
+                            (and (equal (cdr (lookup name (logic.initial-arity-table))) (len values))
+                                 (logic.base-evaluator (logic.function name values)))
+                          ;; found a non-base function
+                          (let* ((def (definition-list-lookup name defs)))
+                            (and def
+                                 (let ((formals (logic.function-args (logic.=lhs def)))
+                                       (body    (logic.=rhs def)))
+                                   (and (equal (len formals) (len values))
+                                        (generic-evaluator (logic.substitute body (pair-lists formals values))
+                                                           defs (- n 1)))))))))))))
+          ((logic.lambdap x)
+           ;; Eagerly evaluate the arguments to a lambda, then substitute them into
+           ;; the lambda's body.
+           (let ((formals (logic.lambda-formals x))
+                 (body    (logic.lambda-body x))
+                 (actuals (logic.lambda-actuals x)))
+             (let ((eval-actuals (generic-evaluator-list actuals defs n)))
+               (and eval-actuals
+                    ;; eval-actuals is (t . ((quote val1) ... (quote valn)))
+                    (let ((values (cdr eval-actuals)))
+                      (generic-evaluator (logic.substitute body (pair-lists formals values)) defs (- n 1)))))))
+          (t
+           ;; FAILURE: cannot evaluate malformed terms
+           nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable generic-evaluator
+                                    generic-evaluator-list
+                                    flag-generic-evaluator)
+          :expand (flag-generic-evaluator 'term x defs n))))
+
+(defthmd definition-of-generic-evaluator-list
+  (equal (generic-evaluator-list x defs n)
+         (if (consp x)
+             ;; Try to evaluate the first argument and then, recursively, the rest of
+             ;; the arguments.
+             (let ((first (generic-evaluator (car x) defs n))
+                   (rest  (generic-evaluator-list (cdr x) defs n)))
+               (if (and first rest)
+                   ;; SUCCESS: evaluated the first and all other arguments.
+                   (cons t (cons first (cdr rest)))
+                 ;; FAILURE: couldn't evaluate some argument.
+                 nil))
+           ;; SUCCESS: the empty list can always be evaluted.
+           (cons t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable generic-evaluator
+                                    generic-evaluator-list
+                                    flag-generic-evaluator))))
+
+(defthm flag-generic-evaluator-when-term
+  (equal (flag-generic-evaluator 'term x defs n)
+         (generic-evaluator x defs n))
+  :hints(("Goal" :in-theory (enable generic-evaluator))))
+
+(defthm flag-generic-evaluator-when-list
+  (equal (flag-generic-evaluator 'list x defs n)
+         (generic-evaluator-list x defs n))
+  :hints(("Goal" :in-theory (enable generic-evaluator-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition generic-evaluator))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition generic-evaluator-list))))
+
+(defthm generic-evaluator-list-when-not-consp
+  (implies (not (consp x))
+           (equal (generic-evaluator-list x defs n)
+                  (cons t nil)))
+  :hints(("Goal" :in-theory (enable definition-of-generic-evaluator-list))))
+
+(defthm generic-evaluator-list-of-cons
+  (equal (generic-evaluator-list (cons a x) defs n)
+         (if (and (generic-evaluator a defs n)
+                  (generic-evaluator-list x defs n))
+             (cons t
+                   (cons (generic-evaluator a defs n)
+                         (cdr (generic-evaluator-list x defs n))))
+           nil))
+  :hints(("Goal" :in-theory (enable definition-of-generic-evaluator-list))))
+
+(defthm true-listp-of-generic-evaluator-list
+  (equal (true-listp (generic-evaluator-list x defs n))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-len-of-cdr-of-generic-evaluator-list
+  (implies (force (generic-evaluator-list x defs n))
+           (equal (len (cdr (generic-evaluator-list x defs n)))
+                  (len x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-of-generic-evaluator-list
+  (equal (consp (generic-evaluator-list x defs n))
+         (if (generic-evaluator-list x defs n)
+             t
+           nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthms-flag
+  :shared-hyp (force (definition-listp defs))
+  :thms ((term forcing-logic.constantp-of-cdr-of-generic-evaluator
+               (implies (force (and (generic-evaluator x defs n)
+                                    (logic.termp x)))
+                        (equal (logic.constantp (generic-evaluator x defs n))
+                               t)))
+         (t forcing-logic.constant-listp-of-cdr-of-generic-evaluator-list
+            (implies (force (and (logic.term-listp x)
+                                 (generic-evaluator-list x defs n)))
+                     (equal (logic.constant-listp (cdr (generic-evaluator-list x defs n)))
+                            t))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-generic-evaluator
+                              flag-generic-evaluator)
+           :expand ((generic-evaluator x defs n))
+           :induct (flag-generic-evaluator flag x defs n))))
+
+(verify-guards flag-generic-evaluator
+               :hints(("Goal" :in-theory (disable forcing-lookup-of-logic.function-name))))
+
+(verify-guards generic-evaluator)
+(verify-guards generic-evaluator-list)
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/fast-cache.lisp acl2-6.3/books/milawa/ACL2/rewrite/fast-cache.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/fast-cache.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/fast-cache.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,392 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cachep")
+(include-book "fast-traces")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund rw.fast-cachelinep (x)
+  (declare (xargs :guard t))
+  (and (consp x)
+       (let ((eqltrace (car x))
+             (ifftrace (cdr x)))
+         (and (implies eqltrace (rw.ftracep eqltrace))
+              (implies ifftrace (rw.ftracep ifftrace))))))
+
+(defund rw.fast-cacheline (eqltrace ifftrace)
+  (declare (xargs :guard (and (or (not eqltrace)
+                                  (rw.ftracep eqltrace))
+                              (or (not ifftrace)
+                                  (rw.ftracep ifftrace)))))
+  (cons eqltrace ifftrace))
+
+(defund rw.fast-cacheline->eqltrace (x)
+  (declare (xargs :guard (rw.fast-cachelinep x)))
+  (car x))
+
+(defund rw.fast-cacheline->ifftrace (x)
+  (declare (xargs :guard (rw.fast-cachelinep x)))
+  (cdr x))
+
+(defthm booleanp-of-rw.fast-cachelinep
+  (equal (booleanp (rw.fast-cachelinep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.fast-cachelinep))))
+
+(defthm forcing-rw.fast-cachelinep-of-rw.cacheline
+  (implies (force (and (or (not eqltrace)
+                           (rw.ftracep eqltrace))
+                       (or (not ifftrace)
+                           (rw.ftracep ifftrace))))
+           (equal (rw.fast-cachelinep (rw.fast-cacheline eqltrace ifftrace))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-cachelinep rw.fast-cacheline))))
+
+(defthm rw.fast-cacheline->eqltrace-of-rw.fast-cacheline
+  (equal (rw.fast-cacheline->eqltrace (rw.fast-cacheline eqltrace ifftrace))
+         eqltrace)
+  :hints(("Goal" :in-theory (enable rw.fast-cacheline
+                                    rw.fast-cacheline->eqltrace))))
+
+(defthm rw.fast-cacheline->ifftrace-of-rw.cacheline
+  (equal (rw.fast-cacheline->ifftrace (rw.fast-cacheline eqltrace ifftrace))
+         ifftrace)
+  :hints(("Goal" :in-theory (enable rw.fast-cacheline
+                                    rw.fast-cacheline->ifftrace))))
+
+(defthm forcing-rw.ftracep-of-rw.fast-cacheline->eqltrace
+  (implies (force (rw.fast-cachelinep x))
+           (equal (rw.ftracep (rw.fast-cacheline->eqltrace x))
+                  (if (rw.fast-cacheline->eqltrace x)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-cacheline->eqltrace
+                                    rw.fast-cachelinep))))
+
+(defthm forcing-rw.ftracep-of-rw.fast-cacheline->ifftrace
+  (implies (force (rw.fast-cachelinep x))
+           (equal (rw.ftracep (rw.fast-cacheline->ifftrace x))
+                  (if (rw.fast-cacheline->ifftrace x)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-cacheline->ifftrace rw.fast-cachelinep))))
+
+(deflist rw.fast-cacheline-listp (x)
+  (rw.fast-cachelinep x)
+  :elementp-of-nil nil)
+
+
+
+
+(defund rw.cacheline-fast-image (cacheline)
+  (declare (xargs :guard (rw.cachelinep cacheline)))
+  (let ((eqltrace (rw.cacheline->eqltrace cacheline))
+        (ifftrace (rw.cacheline->ifftrace cacheline)))
+    (rw.fast-cacheline (and eqltrace
+                            (rw.trace-fast-image eqltrace))
+                       (and ifftrace
+                            (rw.trace-fast-image ifftrace)))))
+
+(defthm rw.fast-cachelinep-of-rw.cacheline-fast-image
+  (implies (force (rw.cachelinep cacheline))
+           (equal (rw.fast-cachelinep (rw.cacheline-fast-image cacheline))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cacheline-fast-image))))
+
+
+(defprojection :list (rw.cacheline-list-fast-image x)
+               :element (rw.cacheline-fast-image x)
+               :guard (rw.cacheline-listp x)
+               :nil-preservingp nil)
+
+(defthm rw.fast-cacheline-listp-of-rw.cacheline-list-fast-image
+  (implies (force (rw.cacheline-listp x))
+           (equal (rw.fast-cacheline-listp (rw.cacheline-list-fast-image x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defmap :map (rw.fast-cachemapp x)
+        :key (logic.termp x)
+        :val (rw.fast-cachelinep x)
+        :key-list (logic.term-listp x)
+        :val-list (rw.fast-cacheline-listp x)
+        :val-of-nil nil)
+
+(defund rw.cachemap-fast-image (x)
+  (declare (xargs :guard (rw.cachemapp x)))
+  (if (consp x)
+      (let ((key (car (car x)))
+            (val (cdr (car x))))
+        (cons (cons key (rw.cacheline-fast-image val))
+              (rw.cachemap-fast-image (cdr x))))
+    nil))
+
+(defthm rw.fast-cachemapp-of-rw.cachemap-fast-image
+  (implies (force (rw.cachemapp x))
+           (equal (rw.fast-cachemapp (rw.cachemap-fast-image x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cachemap-fast-image))))
+
+
+
+
+(defaggregate rw.fast-cache
+  (blockp data)
+  :require ((booleanp-of-rw.fast-cache->blockp   (booleanp blockp))
+            (rw.cachemapp-of-rw.fast-cache->data (rw.fast-cachemapp data)))
+  :legiblep nil)
+
+(defund rw.cache-fast-image (x)
+  (declare (xargs :guard (rw.cachep x)))
+  (rw.fast-cache (rw.cache->blockp x)
+                 (rw.cachemap-fast-image (rw.cache->data x))))
+
+(defthm rw.fast-cachep-of-rw.cache-fast-image
+  (implies (force (rw.cachep x))
+           (equal (rw.fast-cachep (rw.cache-fast-image x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.cache-fast-image))))
+
+(defthm rw.fast-cache->blockp-of-rw.cache-fast-image
+  (equal (rw.fast-cache->blockp (rw.cache-fast-image cache))
+         (rw.cache->blockp cache))
+  :hints(("Goal" :in-theory (enable rw.cache-fast-image))))
+
+(defthm equal-of-rw.fast-cache-rewrite
+  (implies (force (rw.fast-cachep cache))
+           (equal (equal (rw.fast-cache blockp data) cache)
+                  (and (equal (rw.fast-cache->blockp cache) blockp)
+                       (equal (rw.fast-cache->data cache) data))))
+  :hints(("Goal" :in-theory (enable rw.fast-cachep
+                                    rw.fast-cache
+                                    rw.fast-cache->blockp
+                                    rw.fast-cache->data))))
+
+
+
+(defund rw.fast-set-blockedp (blockedp cache)
+  (declare (xargs :guard (and (booleanp blockedp)
+                              (rw.fast-cachep cache))))
+  (rw.fast-cache blockedp (rw.fast-cache->data cache)))
+
+(defthm forcing-rw.fast-cachep-of-rw.set-blockedp
+  (implies (force (and (booleanp blockedp)
+                       (rw.fast-cachep cache)))
+           (equal (rw.fast-cachep (rw.fast-set-blockedp blockedp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-set-blockedp))))
+
+(defthm rw.cache-fast-image-of-rw.set-blockedp
+  (equal (rw.cache-fast-image (rw.set-blockedp blockedp x))
+         (rw.fast-set-blockedp blockedp (rw.cache-fast-image x)))
+  :hints(("Goal" :in-theory (enable rw.fast-set-blockedp
+                                    rw.set-blockedp
+                                    rw.cache-fast-image))))
+
+
+
+
+(defund rw.fast-cache-update (term trace iffp cache)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.ftracep trace)
+                              (rw.fast-cachep cache))))
+  (let ((blockp (rw.fast-cache->blockp cache))
+        (data   (rw.fast-cache->data cache)))
+    (if (and blockp
+             (not (logic.constantp (rw.ftrace->rhs trace))))
+        cache
+    (let* ((entry          (hons-lookup term data))
+           (new-cache-line (if iffp
+                               (rw.fast-cacheline (and entry (rw.fast-cacheline->eqltrace (cdr entry))) trace)
+                             (rw.fast-cacheline trace (and entry (rw.fast-cacheline->ifftrace (cdr entry))))))
+           (new-data       (hons-update term new-cache-line data)))
+      (rw.fast-cache blockp new-data)))))
+
+(defthm forcing-rw.fast-cachep-of-rw.cache-update
+  (implies (force (and (logic.termp term)
+                       (rw.ftracep trace)
+                       (rw.fast-cachep cache)))
+           (equal (rw.fast-cachep (rw.fast-cache-update term trace iffp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-cache-update))))
+
+(defthm cdr-of-lookup-of-term-in-rw.cachemap-fast-image
+  (implies (force (rw.cachemapp x))
+           (equal (cdr (lookup term (rw.cachemap-fast-image x)))
+                  (if (lookup term (rw.cachemap-fast-image x))
+                      (rw.cacheline-fast-image (cdr (lookup term x)))
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.cachemap-fast-image))))
+
+(defthm lookup-of-term-in-rw.cachemap-fast-image
+  (implies (force (rw.cachemapp x))
+           (iff (lookup term (rw.cachemap-fast-image x))
+                (lookup term x)))
+  :hints(("Goal" :in-theory (enable rw.cachemap-fast-image))))
+
+(defthm rw.cache-fast-image-of-rw.cache-update
+  (implies (force (and (rw.cachep cache)
+                       (logic.termp term)
+                       (rw.tracep trace)))
+           (equal (rw.cache-fast-image (rw.cache-update term trace iffp cache))
+                  (rw.fast-cache-update term
+                                        (rw.trace-fast-image trace)
+                                        iffp
+                                        (rw.cache-fast-image cache))))
+  :hints(("Goal" :in-theory (enable rw.fast-cache-update
+                                    rw.cache-update
+                                    rw.cachemap-fast-image
+                                    rw.cacheline-fast-image
+                                    rw.cache-fast-image
+                                    rw.trace-fast-image))))
+
+
+
+
+(defund rw.maybe-update-fast-cache (condition term ftrace iffp fcache)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.fast-cachep fcache)
+                              (or (not condition)
+                                  (rw.ftracep ftrace)))))
+  (if condition
+      (rw.fast-cache-update term ftrace iffp fcache)
+    fcache))
+
+(defthm forcing-rw.fast-cachep-of-rw.maybe-update-fast-cache
+  (implies (force (and (logic.termp term)
+                       (rw.ftracep trace)
+                       (rw.fast-cachep cache)))
+           (equal (rw.fast-cachep (rw.maybe-update-fast-cache condition term trace iffp cache))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.maybe-update-fast-cache))))
+
+(defthm rw.cache-fast-image-of-rw.maybe-update-cache
+  (implies (force (AND (LOGIC.TERMP TERM)
+                       (RW.CACHEP CACHE)
+                       (OR (NOT CONDITION)
+                           (AND (RW.TRACEP TRACE)
+                                (EQUAL (RW.TRACE->IFFP TRACE) IFFP)
+                                (EQUAL (RW.TRACE->LHS TRACE) TERM)))))
+           (equal (rw.cache-fast-image (rw.maybe-update-cache condition term trace iffp cache))
+                  (rw.maybe-update-fast-cache condition
+                                              term
+                                              (rw.trace-fast-image trace)
+                                              iffp
+                                              (rw.cache-fast-image cache))))
+  :hints(("Goal" :in-theory (enable rw.maybe-update-fast-cache
+                                    rw.maybe-update-cache))))
+
+
+
+
+
+
+(defund rw.fast-cache-lookup (term iffp cache)
+  (declare (xargs :guard (and (logic.termp term)
+                              (booleanp iffp)
+                              (rw.fast-cachep cache))))
+  (let ((entry (hons-lookup term (rw.fast-cache->data cache))))
+       (and entry
+            (if iffp
+                (rw.fast-cacheline->ifftrace (cdr entry))
+              (rw.fast-cacheline->eqltrace (cdr entry))))))
+
+(defthm forcing-rw.ftracep-of-rw.fast-cache-lookup
+  (implies (force (rw.fast-cachep cache))
+           (equal (rw.ftracep (rw.fast-cache-lookup term iffp cache))
+                  (if (rw.fast-cache-lookup term iffp cache)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-cache-lookup))))
+
+(defthm rw.fast-cache-lookup-of-rw.cache-fast-image
+  (implies (force (and (logic.termp term)
+                       (booleanp iffp)
+                       (rw.cachep cache)))
+           (equal (rw.fast-cache-lookup term iffp (rw.cache-fast-image cache))
+                  (if (rw.cache-lookup term iffp cache)
+                      (rw.trace-fast-image (rw.cache-lookup term iffp cache))
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-cache-lookup
+                                    rw.cache-lookup
+                                    rw.cache-fast-image
+                                    rw.cacheline-fast-image
+                                    rw.cachemap-fast-image))))
+
+
+
+(defund rw.fast-empty-cache ()
+  (declare (xargs :guard t))
+  (rw.fast-cache nil nil))
+
+(in-theory (disable (:executable-counterpart rw.fast-empty-cache)))
+
+(defthm rw.fast-cachep-of-rw.fast-empty-cache
+  (equal (rw.fast-cachep (rw.fast-empty-cache))
+         t)
+  :hints(("Goal" :in-theory (enable rw.fast-empty-cache))))
+
+(defthm rw.cache-fast-image-of-rw.empty-cache
+  (equal (rw.cache-fast-image (rw.empty-cache))
+         (rw.fast-empty-cache))
+  :hints(("Goal" :in-theory (enable rw.empty-cache rw.fast-empty-cache))))
+
+
+
+
+
+
+(defconst *rw.fast-cache-sigma*
+  ;; Substitutions to switch over to a fast cache.
+  (list (cons '(rw.empty-cache)
+              '(rw.fast-empty-cache))
+        (cons '(rw.cache-lookup ?term ?iffp ?cache)
+              '(rw.fast-cache-lookup ?term ?iffp ?cache))
+        (cons '(rw.cache-update ?term ?trace ?iffp ?cache)
+              '(rw.fast-cache-update ?term ?trace ?iffp ?cache))
+        (cons '(rw.maybe-update-cache ?condition ?term ?trace ?iffp ?cache)
+              '(rw.maybe-update-fast-cache ?condition ?term ?trace ?iffp ?cache))
+        (cons '(rw.set-blockedp ?blockedp ?cache)
+              '(rw.fast-set-blockedp ?blockedp ?cache))
+        (cons '(rw.cache->blockp ?cache)
+              '(rw.fast-cache->blockp ?cache))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/fast-crewrite-clause.lisp acl2-6.3/books/milawa/ACL2/rewrite/fast-crewrite-clause.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/fast-crewrite-clause.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/fast-crewrite-clause.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,602 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "crewrite-clause")
+(include-book "fast-crewrite")
+(include-book "fast-traces")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(definlined rw.fast-ccstepp (x)
+  (declare (xargs :guard t))
+  (and (consp x)
+       ;; (contradictionp . ftrace)
+       (let ((contradictionp (car x))
+             (ftrace         (cdr x)))
+         (and (booleanp contradictionp)
+              (if contradictionp
+                  (not ftrace)
+                (rw.ftracep ftrace))))))
+
+(definlined rw.fast-ccstep (contradictionp ftrace)
+  (declare (xargs :guard (and (booleanp contradictionp)
+                              (if contradictionp
+                                  (not ftrace)
+                                (rw.ftracep ftrace)))))
+  (cons contradictionp ftrace))
+
+(definlined rw.fast-ccstep->contradictionp (x)
+  (declare (xargs :guard (rw.fast-ccstepp x)))
+  (car x))
+
+(definlined rw.fast-ccstep->ftrace (x)
+  (declare (xargs :guard (rw.fast-ccstepp x)))
+  (cdr x))
+
+(defthm rw.fast-ccstep->contradictionp-of-rw.fast-ccstep
+  (equal (rw.fast-ccstep->contradictionp (rw.fast-ccstep contradictionp ftrace))
+         contradictionp)
+  :hints(("Goal" :in-theory (enable rw.fast-ccstep
+                                    rw.fast-ccstep->contradictionp))))
+
+(defthm rw.fast-ccstep->ftrace-of-rw.fast-ccstep
+  (equal (rw.fast-ccstep->ftrace (rw.fast-ccstep contradictionp ftrace))
+         ftrace)
+  :hints(("Goal" :in-theory (enable rw.fast-ccstep
+                                    rw.fast-ccstep->ftrace))))
+
+(defthm booleanp-of-rw.fast-ccstepp
+  (equal (booleanp (rw.fast-ccstepp x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.fast-ccstepp))))
+
+(defthm rw.fast-ccstepp-of-rw.fast-ccstep
+  (implies (force (and (booleanp contradictionp)
+                       (if contradictionp
+                           (not ftrace)
+                         (rw.ftracep ftrace))))
+           (equal (rw.fast-ccstepp (rw.fast-ccstep contradictionp ftrace))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-ccstepp rw.fast-ccstep))))
+
+(defthm booleanp-of-rw.fast-ccstep->contradictionp
+  (implies (force (rw.fast-ccstepp x))
+           (equal (booleanp (rw.fast-ccstep->contradictionp x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-ccstepp
+                                    rw.fast-ccstep->contradictionp))))
+
+(defthm rw.ftracep-of-rw.fast-ccstep->ftrace
+  (implies (and (force (rw.fast-ccstepp x))
+                (force (not (rw.fast-ccstep->contradictionp x))))
+           (equal (rw.ftracep (rw.fast-ccstep->ftrace x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-ccstepp
+                                    rw.fast-ccstep->contradictionp
+                                    rw.fast-ccstep->ftrace))))
+
+
+
+
+
+(definlined rw.ccstep-fast-image (x)
+  (declare (xargs :guard (rw.ccstepp x)))
+  (let* ((contradictionp (if (rw.ccstep->contradiction x) t nil))
+         (trace          (if contradictionp
+                             nil
+                           (rw.trace-fast-image (rw.ccstep->trace x)))))
+    (rw.fast-ccstep contradictionp trace)))
+
+(defthm rw.fast-ccstepp-of-rw.ccstep-fast-image
+  (implies (force (rw.ccstepp x))
+           (equal (rw.fast-ccstepp (rw.ccstep-fast-image x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-fast-image))))
+
+(defthm rw.fast-ccstep->contradictionp-of-rw.ccstep-fast-image
+  (equal (rw.fast-ccstep->contradictionp (rw.ccstep-fast-image x))
+         (if (rw.ccstep->contradiction x) t nil))
+  :hints(("Goal" :in-theory (enable rw.ccstep-fast-image))))
+
+(defthm rw.fast-ccstep->ftrace-of-rw.ccstep-fast-image
+  (equal (rw.fast-ccstep->ftrace (rw.ccstep-fast-image x))
+         (if (rw.ccstep->contradiction x)
+             nil
+           (rw.trace-fast-image (rw.ccstep->trace x))))
+  :hints(("Goal" :in-theory (enable rw.ccstep-fast-image))))
+
+
+
+(defund rw.fast-crewrite-take-step (todo done blimit rlimit control n)
+  ;; Note: redefined to add timing information in interface/rewrite-tactics.lisp
+  (declare (xargs :guard (and (consp todo)
+                              (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (natp blimit)
+                              (natp rlimit)
+                              (rw.controlp control)
+                              (natp n))))
+  (let* ((assms (rw.empty-fast-assms (rw.control->assmctrl control)))
+         (assms (rw.fast-assume-left-list (cdr todo) assms))
+         (assms (rw.fast-assume-right-list done assms))
+         (contr (rw.fast-assms->contradiction assms)))
+    (rw.fast-ccstep contr
+                    (if contr
+                        nil
+                      (rw.fast-crewrite assms (car todo) t blimit rlimit control n)))))
+
+(defthm rw.fast-ccstepp-of-rw.fast-crewrite-take-step
+  (implies (force (and (consp todo)
+                       (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (rw.controlp control)))
+           (equal (rw.fast-ccstepp (rw.fast-crewrite-take-step todo done blimit rlimit control n))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-crewrite-take-step))))
+
+(defthm rw.ccstep-fast-image-of-rw.crewrite-take-step
+  (implies (force (and (consp todo)
+                       (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (rw.controlp control)))
+           (equal (rw.ccstep-fast-image (rw.crewrite-take-step todo done blimit rlimit control n))
+                  (rw.fast-crewrite-take-step todo done blimit rlimit control n)))
+  :hints(("Goal"
+          :in-theory (e/d (rw.ccstep-fast-image
+                           rw.crewrite-take-step
+                           rw.fast-crewrite-take-step)
+                          (rw.fast-assms->contradiction-of-rw.assms-fast-image))
+          :use ((:instance rw.fast-assms->contradiction-of-rw.assms-fast-image
+                           (assms (rw.assume-right-list
+                                   done
+                                   (rw.assume-left-list (cdr todo)
+                                                        (rw.empty-assms (rw.control->assmctrl control))))))))))
+
+(defthm rw.fast-ccstep->contradictionp-of-rw.fast-crewrite-take-step
+  (implies (force (and (consp todo)
+                       (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (rw.controlp control)))
+           (equal (rw.fast-ccstep->contradictionp
+                   (rw.fast-crewrite-take-step todo done blimit rlimit control n))
+                  (if (rw.ccstep->contradiction
+                       (rw.crewrite-take-step todo done blimit rlimit control n))
+                      t
+                    nil)))
+  :hints(("Goal"
+          :in-theory (disable rw.fast-ccstep->contradictionp-of-rw.ccstep-fast-image)
+          :use ((:instance rw.fast-ccstep->contradictionp-of-rw.ccstep-fast-image
+                           (x (rw.crewrite-take-step todo done blimit rlimit control n)))))))
+
+(defthm rw.fast-ccstep->ftrace-of-rw.fast-crewrite-take-step
+  (implies (force (and (consp todo)
+                       (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (rw.controlp control)))
+           (equal (rw.fast-ccstep->ftrace
+                   (rw.fast-crewrite-take-step todo done blimit rlimit control n))
+                  (if (rw.ccstep->contradiction
+                       (rw.crewrite-take-step todo done blimit rlimit control n))
+                      nil
+                    (rw.trace-fast-image
+                     (rw.ccstep->trace
+                      (rw.crewrite-take-step todo done blimit rlimit control n))))))
+  :hints(("Goal"
+          :in-theory (e/d (rw.fast-crewrite-take-step
+                           rw.crewrite-take-step)
+                          (rw.fast-assms->contradiction-of-rw.assms-fast-image))
+          :use ((:instance rw.fast-assms->contradiction-of-rw.assms-fast-image
+                           (assms (rw.assume-right-list
+                                   done
+                                   (rw.assume-left-list (cdr todo)
+                                                        (rw.empty-assms (rw.control->assmctrl control))))))))))
+
+
+
+;; (deflist rw.fast-ccstep-listp (x)
+;;   (rw.fast-ccstepp x)
+;;   :elementp-of-nil nil)
+
+;; (defprojection :list (rw.ccstep-list-fast-image x)
+;;                :element (rw.ccstep-fast-image x)
+;;                :guard (rw.ccstep-listp x))
+
+
+
+(defund rw.fast-ccstep->provedp (x)
+  (declare (xargs :guard (rw.fast-ccstepp x)))
+  (or (rw.fast-ccstep->contradictionp x)
+      (clause.obvious-termp (rw.ftrace->rhs (rw.fast-ccstep->ftrace x)))))
+
+(defthm rw.fast-ccstep->provedp-of-rw.ccstep-fast-image
+  (equal (rw.fast-ccstep->provedp (rw.ccstep-fast-image x))
+         (rw.ccstep->provedp x))
+  :hints(("Goal" :in-theory (enable rw.fast-ccstep->provedp
+                                    rw.ccstep->provedp))))
+
+(defthm rw.fast-ccstep->contradictionp-when-not-rw.fast-ccstep->provedp
+  (implies (not (rw.fast-ccstep->provedp x))
+           (equal (rw.fast-ccstep->contradictionp x)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.fast-ccstep->provedp))))
+
+(defthm rw.fast-ccstep->provedp-of-rw.fast-crewrite-take-step
+  (implies (force (and (consp todo)
+                       (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (rw.controlp control)))
+           (equal (rw.fast-ccstep->provedp
+                   (rw.fast-crewrite-take-step todo done blimit rlimit control n))
+                  (rw.ccstep->provedp
+                   (rw.crewrite-take-step todo done blimit rlimit control n))))
+  :hints(("Goal"
+          :in-theory (disable rw.fast-ccstep->provedp-of-rw.ccstep-fast-image)
+          :use ((:instance rw.fast-ccstep->provedp-of-rw.ccstep-fast-image
+                           (x (rw.crewrite-take-step todo done blimit rlimit control n)))))))
+
+
+
+(defund rw.fast-ccstep->t1prime (x)
+  (declare (xargs :guard (and (rw.fast-ccstepp x)
+                              (not (rw.fast-ccstep->provedp x)))
+                  :guard-hints (("Goal" :in-theory (enable rw.fast-ccstep->provedp)))))
+  (rw.ftrace->rhs (rw.fast-ccstep->ftrace x)))
+
+(defthm rw.fast-ccstep->t1prime-of-rw.ccstep-fast-image
+  (implies (force (not (rw.ccstep->contradiction x)))
+           (equal (rw.fast-ccstep->t1prime (rw.ccstep-fast-image x))
+                  (rw.ccstep->t1prime x)))
+  :hints(("Goal" :in-theory (enable rw.fast-ccstep->t1prime
+                                    rw.ccstep->t1prime))))
+
+(defthm logic.termp-of-rw.fast-ccstep->t1prime
+  (implies (force (and (not (rw.fast-ccstep->contradictionp x))
+                       (rw.fast-ccstepp x)))
+           (equal (logic.termp (rw.fast-ccstep->t1prime x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-ccstep->t1prime))))
+
+(defthm rw.fast-ccstep->t1prime-of-rw.fast-crewrite-take-step
+  (implies (and (not (rw.ccstep->provedp (rw.crewrite-take-step todo done blimit rlimit control n)))
+                (force (and (consp todo)
+                            (logic.term-listp todo)
+                            (logic.term-listp done)
+                            (rw.controlp control))))
+           (equal (rw.fast-ccstep->t1prime
+                   (rw.fast-crewrite-take-step todo done blimit rlimit control n))
+                  (rw.ccstep->t1prime
+                   (rw.crewrite-take-step todo done blimit rlimit control n))))
+  :hints(("Goal"
+          :in-theory (e/d (rw.ccstep->provedp)
+                          (rw.fast-ccstep->t1prime-of-rw.ccstep-fast-image))
+          :use ((:instance rw.fast-ccstep->t1prime-of-rw.ccstep-fast-image
+                           (x (rw.crewrite-take-step todo done blimit rlimit control n)))))))
+
+
+
+
+
+
+
+
+;; Fast clause crewriting.
+;;
+;; This has been kind of tricky.  We don't really care about building any
+;; intermediate steps.  All we want to know is (1) whether the clause gets
+;; proved, (2) what is clause-prime, if the clause wasn't proved, and (2) what
+;; goals were forced?  We begin by introducing three functions to compute
+;; exactly these answers.  We won't run these functions, we just use them to do
+;; the reasoning.
+
+(defund rw.crewrite-clause-aux-provedp (todo done blimit rlimit control n)
+  (declare (xargs :verify-guards nil))
+  (if (consp todo)
+      (let ((step1 (rw.crewrite-take-step todo done blimit rlimit control n)))
+        (or (rw.ccstep->provedp step1)
+            (rw.crewrite-clause-aux-provedp (cdr todo)
+                                            (cons (rw.ccstep->t1prime step1) done)
+                                            blimit rlimit control n)))
+    nil))
+
+(defund rw.crewrite-clause-aux-todo-primes (todo done blimit rlimit control n)
+  (declare (xargs :verify-guards nil))
+  (if (consp todo)
+      (let ((step1 (rw.crewrite-take-step todo done blimit rlimit control n)))
+        (cons (rw.ccstep->t1prime step1)
+              (rw.crewrite-clause-aux-todo-primes (cdr todo)
+                                                  (cons (rw.ccstep->t1prime step1) done)
+                                                  blimit rlimit control n)))
+    nil))
+
+(defund rw.crewrite-clause-aux-fgoals (todo done blimit rlimit control n)
+  (declare (xargs :verify-guards nil))
+  (if (consp todo)
+      (let ((step1 (rw.crewrite-take-step todo done blimit rlimit control n)))
+        (if (rw.ccstep->provedp step1)
+            (rw.ccstep-forced-goals step1)
+          (app (rw.crewrite-clause-aux-fgoals (cdr todo)
+                                              (cons (rw.ccstep->t1prime step1) done)
+                                              blimit rlimit control n)
+               (rw.ccstep-forced-goals step1))))
+    nil))
+
+;; We now re-phrase rw.crewrite-clause-aux in terms of these functions.  The
+;; accumulator gets in the way, so we actually introduce an auxilliary function
+;; first that does the same thing as rw.crewrite-clause-aux, without tail
+;; recursion.  Again, we never intend to run this function.
+
+(defund rw.crewrite-clause-aux-noacc (todo done blimit rlimit control n)
+  (declare (xargs :verify-guards nil))
+  (if (consp todo)
+      (let ((step1 (rw.crewrite-take-step todo done blimit rlimit control n)))
+        (if (rw.ccstep->provedp step1)
+            (list step1)
+          (app (rw.crewrite-clause-aux-noacc (cdr todo)
+                                             (cons (rw.ccstep->t1prime step1) done)
+                                             blimit
+                                             rlimit control n)
+               (list step1))))
+    nil))
+
+(defthm consp-of-rw.crewrite-clause-aux-noacc
+  (equal (consp (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n))
+         (consp todo))
+  :hints(("Goal" :in-theory (enable rw.crewrite-clause-aux-noacc))))
+
+(defthmd rw.crewrite-clause-aux-removal
+  (implies (true-listp acc)
+           (equal (rw.crewrite-clause-aux todo done blimit rlimit control n acc)
+                  (app (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n)
+                       acc)))
+  :hints(("Goal"
+          :in-theory (e/d (rw.crewrite-clause-aux
+                           rw.crewrite-clause-aux-noacc)
+                          ((:executable-counterpart acl2::force))))))
+
+
+(defthmd car-of-app
+  ;; Probably not something to keep enabled normally
+  (equal (car (app x y))
+         (if (consp x)
+             (car x)
+           (car y))))
+
+(defthmd cdr-of-app
+  ;; Probably not something to keep enabled normally
+  (equal (cdr (app x y))
+         (if (consp x)
+             (app (cdr x) y)
+           (cdr (list-fix y)))))
+
+(local (in-theory (enable car-of-app cdr-of-app)))
+
+
+
+(defthm rw.crewrite-clause-aux-provedp-correct
+  (equal (rw.ccstep->provedp (car (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n)))
+         (rw.crewrite-clause-aux-provedp todo done blimit rlimit control n))
+  :hints(("Goal"
+          :expand ((rw.crewrite-clause-aux-provedp todo done blimit rlimit control n)
+                   (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n))
+          :in-theory (enable (:induction rw.crewrite-clause-aux-noacc)))))
+
+
+
+(defthm consp-of-rw.crewrite-clause-aux-todo-primes
+  (equal (consp (rw.crewrite-clause-aux-todo-primes todo done blimit rlimit control n))
+         (consp todo))
+  :hints(("Goal" :in-theory (enable rw.crewrite-clause-aux-todo-primes))))
+
+(defthm rw.ccstep->clause-prime-of-rw.crewrite-take-step
+  (implies (force (and (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (rw.controlp control)))
+           (equal (rw.ccstep->clause-prime (rw.crewrite-take-step todo done blimit rlimit control n))
+                  (if (rw.ccstep->provedp (rw.crewrite-take-step todo done blimit rlimit control n))
+                      nil
+                    (cons (rw.ccstep->t1prime (rw.crewrite-take-step todo done blimit rlimit control n))
+                          (list-fix done)))))
+  :hints(("Goal" :in-theory (e/d (rw.ccstep->clause-prime
+                                  rw.ccstep->provedp
+                                  rw.ccstep->t1prime
+                                  rw.crewrite-take-step)))))
+
+(defthm rw.crewrite-clause-aux-todo-primes-correct
+  (implies (force (and (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (consp todo)
+                       (rw.controlp control)
+                       (not (rw.crewrite-clause-aux-provedp todo done blimit rlimit control n))))
+           (equal (rw.ccstep->clause-prime
+                   (car (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n)))
+                  (app (rev (rw.crewrite-clause-aux-todo-primes todo done blimit rlimit control n))
+                       done)))
+  :hints(("Goal"
+          :induct (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n)
+          :expand ((rw.crewrite-clause-aux-todo-primes todo done blimit rlimit control n)
+                   (rw.crewrite-clause-aux-provedp todo done blimit rlimit control n)
+                   (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n))
+          :in-theory (enable (:induction rw.crewrite-clause-aux-noacc)))))
+
+
+
+(defthm true-listp-of-rw.crewrite-clause-aux-fgoals
+  (equal (true-listp (rw.crewrite-clause-aux-fgoals todo done blimit rlimit control n))
+         t)
+  :hints(("Goal" :in-theory (enable rw.crewrite-clause-aux-fgoals))))
+
+(defthm rw.crewrite-clause-aux-fgoals-correct
+  (equal (rw.ccstep-list-forced-goals (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n))
+         (rw.crewrite-clause-aux-fgoals todo done blimit rlimit control n))
+  :hints(("Goal"
+          :induct (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n)
+          :expand ((rw.crewrite-clause-aux-fgoals todo done blimit rlimit control n)
+                   (rw.crewrite-clause-aux-noacc todo done blimit rlimit control n))
+          :in-theory (enable (:induction rw.crewrite-clause-aux-noacc)))))
+
+
+
+;; We're now ready to present the fast version of crewrite-clause-aux.  Here,
+;; we return (LIST PROVEDP CLAUSE-PRIME FGOALS).  We then show that this
+;; function is correct with respect to our simplified vesions of what
+;; rw.crewrite-clause-aux returns.
+
+(defund rw.fast-crewrite-clause-aux (todo done blimit rlimit control n fgacc)
+  ;; Note: redefined in interface/rewrite-tactics.lisp to add timing information
+  (declare (xargs :guard (and (logic.term-listp todo)
+                              (logic.term-listp done)
+                              (natp blimit)
+                              (natp rlimit)
+                              (rw.controlp control)
+                              (natp n)
+                              (true-listp fgacc))
+                  :verify-guards nil))
+  (if (consp todo)
+      (let* ((step1          (rw.fast-crewrite-take-step todo done blimit rlimit control n))
+             (step1-contr    (rw.fast-ccstep->contradictionp step1))
+             (step1-provedp  (rw.fast-ccstep->provedp step1))
+             (step1-ftrace   (rw.fast-ccstep->ftrace step1))
+             (step1-fgoals   (and (not step1-contr)
+                                  (rw.ftrace->fgoals step1-ftrace))))
+        (if step1-provedp
+            (list t nil (fast-app step1-fgoals fgacc))
+          (rw.fast-crewrite-clause-aux (cdr todo)
+                                       (cons (rw.fast-ccstep->t1prime step1) done)
+                                       blimit rlimit control n
+                                       (fast-app step1-fgoals fgacc))))
+    (list nil done fgacc)))
+
+(defthm provedp-of-rw.fast-crewrite-clause-aux
+  (implies (force (and (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (rw.controlp control)
+                       (true-listp fgacc)))
+           (equal (car (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc))
+                  (rw.crewrite-clause-aux-provedp todo done blimit rlimit control n)))
+  :hints(("Goal"
+          :induct (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc)
+          :expand ((rw.crewrite-clause-aux-provedp todo done blimit rlimit control n)
+                   (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc))
+          :in-theory (e/d ((:induction rw.fast-crewrite-clause-aux))
+                          (rw.crewrite-clause-aux-provedp-correct)))))
+
+(defthm clause-prime-of-rw.fast-crewrite-clause-aux
+  (implies (force (and (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (true-listp done)
+                       (rw.controlp control)
+                       (true-listp fgacc)))
+           (equal (second (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc))
+                  (if (rw.crewrite-clause-aux-provedp todo done blimit rlimit control n)
+                      nil
+                    (app (rev (rw.crewrite-clause-aux-todo-primes todo done blimit rlimit control n))
+                         done))))
+  :hints(("Goal"
+          :induct (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc)
+          :expand ((rw.crewrite-clause-aux-provedp todo done blimit rlimit control n)
+                   (rw.crewrite-clause-aux-todo-primes todo done blimit rlimit control n)
+                   (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc))
+          :in-theory (e/d ((:induction rw.fast-crewrite-clause-aux))
+                          ()))))
+
+(defthm forced-goals-of-rw.fast-crewrite-clause-aux
+  (implies (force (and (logic.term-listp todo)
+                       (logic.term-listp done)
+                       (true-listp done)
+                       (rw.controlp control)
+                       (true-listp fgacc)))
+           (equal (third (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc))
+                  (app (rw.crewrite-clause-aux-fgoals todo done blimit rlimit control n)
+                       fgacc)))
+  :hints(("Goal"
+          :induct (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc)
+          :expand ((rw.crewrite-clause-aux-fgoals todo done blimit rlimit control n)
+                   (rw.fast-crewrite-clause-aux todo done blimit rlimit control n fgacc))
+          :in-theory (e/d ((:induction rw.fast-crewrite-clause-aux)
+                           rw.ccstep-forced-goals)
+                          ()))))
+
+(verify-guards rw.fast-crewrite-clause-aux)
+
+
+
+
+(defund rw.fast-crewrite-clause (clause blimit rlimit control n)
+  ;; Note: redefined in interface/rewrite-tactics to add timing info
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (natp blimit)
+                              (natp rlimit)
+                              (rw.controlp control)
+                              (natp n))))
+  ;; Returns (LIST PROVEDP CLAUSE-PRIME FGOALS).  Immediately below, we show
+  ;; below these are the same as the provedp, clause-prime, and fgoals produced
+  ;; by rw.crewrite-clause.
+  (rw.fast-crewrite-clause-aux clause nil blimit rlimit control n nil))
+
+(defthm first-of-rw.fast-crewrite-clause
+  (implies (force (and (logic.term-listp clause)
+                       (rw.controlp control)))
+           (equal (first (rw.fast-crewrite-clause clause blimit rlimit control n))
+                  (rw.ccstep->provedp (car (rw.crewrite-clause clause blimit rlimit control n)))))
+  :hints(("Goal" :in-theory (enable rw.fast-crewrite-clause
+                                    rw.crewrite-clause
+                                    rw.crewrite-clause-aux-removal))))
+
+(defthm second-of-rw.fast-crewrite-clause
+  (implies (force (and (logic.term-listp clause)
+                       (consp clause)
+                       (rw.controlp control)
+                       ))
+           (equal (second (rw.fast-crewrite-clause clause blimit rlimit control n))
+                  (if (rw.ccstep->provedp (car (rw.crewrite-clause clause blimit rlimit control n)))
+                      nil
+                    (rw.ccstep->clause-prime (car (rw.crewrite-clause clause blimit rlimit control n))))))
+  :hints(("Goal" :in-theory (enable rw.fast-crewrite-clause
+                                    rw.crewrite-clause
+                                    rw.crewrite-clause-aux-removal))))
+
+(defthm third-of-rw.fast-crewrite-clause
+  (implies (force (and (logic.term-listp clause)
+                       (rw.controlp control)))
+           (equal (third (rw.fast-crewrite-clause clause blimit rlimit control n))
+                  (rw.ccstep-list-forced-goals (rw.crewrite-clause clause blimit rlimit control n))))
+    :hints(("Goal" :in-theory (enable rw.fast-crewrite-clause
+                                    rw.crewrite-clause
+                                    rw.crewrite-clause-aux-removal))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/fast-crewrite.lisp acl2-6.3/books/milawa/ACL2/rewrite/fast-crewrite.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/fast-crewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/fast-crewrite.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1431 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fast-urewrite")
+(include-book "fast-cache")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defconst *rw.fast-crewrite-flag-sigma*
+  ;; Substitutions used to generate the fast flag function's definition.
+  (list (cons '(rw.urewrite ?x ?iffp ?control ?n)
+              '(rw.fast-urewrite ?x ?iffp ?control ?n))
+        (cons '(rw.crewrite-core$ ?x)
+              '(rw.fast-flag-crewrite 'term assms ?x nil nil cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :iffp ?iffp)
+              '(rw.fast-flag-crewrite 'term assms ?x nil nil cache ?iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :rlimit ?rlimit :cache ?cache)
+              '(rw.fast-flag-crewrite 'term assms ?x nil nil ?cache iffp blimit ?rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :cache ?cache)
+              '(rw.fast-flag-crewrite 'term assms ?x nil nil ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :cache ?cache :assms ?assms)
+              '(rw.fast-flag-crewrite 'term ?assms ?x nil nil ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :iffp ?iffp :blimit ?blimit :anstack ?anstack :cache ?cache)
+              '(rw.fast-flag-crewrite 'term assms ?x nil nil ?cache ?iffp ?blimit rlimit ?anstack control))
+        (cons '(rw.crewrite-core-list$ ?x :iffp ?iffp)
+              '(rw.fast-flag-crewrite 'list assms ?x nil nil cache ?iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core-list$ ?x :cache ?cache)
+              '(rw.fast-flag-crewrite 'list assms ?x nil nil ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rule$ ?x ?rules)
+              '(rw.fast-flag-crewrite 'rule assms ?x ?rules nil cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rules$ ?x ?rules)
+              '(rw.fast-flag-crewrite 'rules assms ?x ?rules nil cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rules$ ?x ?rules :cache ?cache)
+              '(rw.fast-flag-crewrite 'rules assms ?x ?rules nil ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-match$ ?x ?rules ?sigmas)
+              '(rw.fast-flag-crewrite 'match assms ?x ?rules ?sigmas cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-matches$ ?x ?rules ?sigmas)
+              '(rw.fast-flag-crewrite 'matches assms ?x ?rules ?sigmas cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-matches$ ?x ?rules ?sigmas :cache ?cache)
+              '(rw.fast-flag-crewrite 'matches assms ?x ?rules ?sigmas ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyp$ ?x ?rules ?sigmas)
+              '(rw.fast-flag-crewrite 'hyp assms ?x ?rules ?sigmas cache t blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyps$ ?x ?rules ?sigmas)
+              '(rw.fast-flag-crewrite 'hyps assms ?x ?rules ?sigmas cache t blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyps$ ?x ?rules ?sigmas :cache ?cache)
+              '(rw.fast-flag-crewrite 'hyps assms ?x ?rules ?sigmas ?cache t blimit rlimit anstack control))))
+
+
+(defconst *rw.fast-crewrite-noflag-sigma*
+  ;; Substitutions used to generate the flagless :definition rules
+  (list (cons '(rw.urewrite ?x ?iffp ?control ?n)
+              '(rw.fast-urewrite ?x ?iffp ?control ?n))
+        (cons '(rw.crewrite-core$ ?x)
+              '(rw.fast-crewrite-core assms ?x cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :iffp ?iffp)
+              '(rw.fast-crewrite-core assms ?x cache ?iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :rlimit ?rlimit :cache ?cache)
+              '(rw.fast-crewrite-core assms ?x ?cache iffp blimit ?rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :cache ?cache)
+              '(rw.fast-crewrite-core assms ?x ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :cache ?cache :assms ?assms)
+              '(rw.fast-crewrite-core ?assms ?x ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core$ ?x :iffp ?iffp :blimit ?blimit :anstack ?anstack :cache ?cache)
+              '(rw.fast-crewrite-core assms ?x ?cache ?iffp ?blimit rlimit ?anstack control))
+        (cons '(rw.crewrite-core-list$ ?x :iffp ?iffp)
+              '(rw.fast-crewrite-core-list assms ?x cache ?iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-core-list$ ?x :cache ?cache)
+              '(rw.fast-crewrite-core-list assms ?x ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rule$ ?x ?rules)
+              '(rw.fast-crewrite-try-rule assms ?x ?rules cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rules$ ?x ?rules)
+              '(rw.fast-crewrite-try-rules assms ?x ?rules cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-rules$ ?x ?rules :cache ?cache)
+              '(rw.fast-crewrite-try-rules assms ?x ?rules ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-match$ ?x ?rules ?sigmas)
+              '(rw.fast-crewrite-try-match assms ?x ?rules ?sigmas cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-matches$ ?x ?rules ?sigmas)
+              '(rw.fast-crewrite-try-matches assms ?x ?rules ?sigmas cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-try-matches$ ?x ?rules ?sigmas :cache ?cache)
+              '(rw.fast-crewrite-try-matches assms ?x ?rules ?sigmas ?cache iffp blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyp$ ?x ?rules ?sigmas)
+              '(rw.fast-crewrite-relieve-hyp assms ?x ?rules ?sigmas cache blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyps$ ?x ?rules ?sigmas)
+              '(rw.fast-crewrite-relieve-hyps assms ?x ?rules ?sigmas cache blimit rlimit anstack control))
+        (cons '(rw.crewrite-relieve-hyps$ ?x ?rules ?sigmas :cache ?cache)
+              '(rw.fast-crewrite-relieve-hyps assms ?x ?rules ?sigmas ?cache blimit rlimit anstack control))))
+
+
+(defconst *rw.fast-crewrite-list*
+  ;; This is hacky, but we need to switch to ftraces here.
+  (ACL2::jared-rewrite *rw.crewrite-list*
+                       (list (cons '(cons term1-trace others-traces)
+                                   '(rw.ftraces (cons (rw.ftrace->rhs term1-trace)
+                                                      (rw.ftraces->rhses others-traces))
+                                                (fast-merge (rw.ftrace->fgoals term1-trace)
+                                                            (rw.ftraces->fgoals others-traces))))
+                             (cons '(rw.cresult nil cache nil)
+                                   '(rw.cresult (rw.ftraces nil nil) cache nil)))))
+
+
+(defconst *rw.fast-crewrite-hyps*
+  ;; This is hacky, but we need to switch to ftraces here.
+  (ACL2::jared-rewrite *rw.crewrite-hyps*
+                       (list (cons '(cons hyp1-trace others-traces)
+                                   '(rw.ftraces (cons (rw.ftrace->rhs hyp1-trace)
+                                                      (rw.ftraces->rhses others-traces))
+                                                (fast-merge (rw.ftrace->fgoals hyp1-trace)
+                                                            (rw.ftraces->fgoals others-traces))))
+                             (cons '(rw.hypresult ?successp nil ?cache ?limitedp)
+                                   '(rw.hypresult ?successp (rw.ftraces nil nil) ?cache ?limitedp)))))
+
+
+
+(ACL2::make-event
+ (let ((sigma (ACL2::append *rw.fast-cache-sigma*
+                            *rw.fast-assms-sigma*
+                            *rw.fast-traces-sigma*
+                            *rw.fast-crewrite-flag-sigma*)))
+   `(encapsulate
+     ()
+     (acl2::set-ignore-ok t)
+     (defun rw.fast-flag-crewrite (flag ;; which mode we are in (we're really 8 mutually recursive functions)
+                                   assms ;; the current assumptions
+                                   x ;; the term we are rewriting (or the hyp we are relieving)
+                                   rule[s] ;; the rule (or list of rules) we want to try
+                                   sigma[s] ;; the sigma (or sigma list) we want to try (once we've already chosen a rule)
+                                   cache ;; rewrite cache to avoid repeated relieve-hyps from match-free
+                                   iffp ;; t if we can use iff rules, nil if we can only use equal rules
+                                   blimit ;; limit on backchaining depth (how hard may we try to relieving hyps?)
+                                   rlimit ;; limit on successful rewrites (how many rules can we successively apply?)
+                                   anstack ;; the ancestors stack (used to control backchaining; see ancestors.lisp)
+                                   control ;; the rewriter control object (stores rules, definitions, etc.; see controlp.lisp)
+                                   )
+       (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                   (rw.fast-cachep cache)
+                                   (booleanp iffp)
+                                   (natp blimit)
+                                   (natp rlimit)
+                                   (rw.anstackp anstack)
+                                   (rw.controlp control)
+                                   (cond ((equal flag 'term)
+                                          (logic.termp x))
+                                         ((equal flag 'list)
+                                          (logic.term-listp x))
+                                         ((equal flag 'match)
+                                          (and (logic.termp x)
+                                               (rw.rulep rule[s])
+                                               (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                                   (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                               (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                               (logic.sigmap sigma[s])
+                                               (submapp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])))
+                                         ((equal flag 'matches)
+                                          (and (logic.termp x)
+                                               (rw.rulep rule[s])
+                                               (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                                   (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                               (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                               (logic.sigma-listp sigma[s])
+                                               (submap-of-eachp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])))
+                                         ((equal flag 'rule)
+                                          (and (logic.termp x)
+                                               (rw.rulep rule[s])))
+                                         ((equal flag 'rules)
+                                          (and (logic.termp x)
+                                               (rw.rule-listp rule[s])))
+                                         ((equal flag 'hyp)
+                                          (and (rw.hypp x)
+                                               (rw.rulep rule[s])
+                                               (logic.sigmap sigma[s])))
+                                         (t
+                                          (and (equal flag 'hyps)
+                                               (rw.hyp-listp x)
+                                               (rw.rulep rule[s])
+                                               (logic.sigmap sigma[s])))))
+                       :verify-guards nil
+                       :measure (cond ((or (equal flag 'term)
+                                           (equal flag 'list))
+                                       (four-nats-measure rlimit (nfix blimit) 4 (rank x)))
+                                      ((or (equal flag 'rule)
+                                           (equal flag 'rules))
+                                       (four-nats-measure rlimit (nfix blimit) 3 (rank rule[s])))
+                                      ((or (equal flag 'match)
+                                           (equal flag 'matches))
+                                       (four-nats-measure rlimit (nfix blimit) 2 (rank sigma[s])))
+                                      (t
+                                       (four-nats-measure rlimit (nfix blimit) 1 (rank x))))
+                       :hints (("Goal" :in-theory (disable (:executable-counterpart ACL2::force))))))
+       (cond ((equal flag 'term)
+              ,(ACL2::jared-rewrite *rw.crewrite-core* sigma))
+             ((equal flag 'list)
+              ,(ACL2::jared-rewrite *rw.fast-crewrite-list* sigma))
+             ((equal flag 'rule)
+              ,(ACL2::jared-rewrite *rw.crewrite-rule* sigma))
+             ((equal flag 'rules)
+              ,(ACL2::jared-rewrite *rw.crewrite-rules* sigma))
+             ((equal flag 'match)
+              ,(ACL2::jared-rewrite *rw.crewrite-match* sigma))
+             ((equal flag 'matches)
+              ,(ACL2::jared-rewrite *rw.crewrite-matches* sigma))
+             ((equal flag 'hyp)
+              ,(ACL2::jared-rewrite *rw.crewrite-hyp* sigma))
+             (t
+              ,(ACL2::jared-rewrite *rw.fast-crewrite-hyps* sigma)))))))
+
+
+
+
+(defsection fast-invoke-macros
+
+  (defmacro rw.fast-crewrite-core$ (term &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.fast-flag-crewrite 'term ,assms ,term nil nil ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.fast-crewrite-core ,assms ,term ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.fast-crewrite-core-list$ (term-list &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.fast-flag-crewrite 'list ,assms ,term-list nil nil ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.fast-crewrite-core-list ,assms ,term-list ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.fast-crewrite-try-rule$ (term rule &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.fast-flag-crewrite 'rule ,assms ,term ,rule nil ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.fast-crewrite-try-rule ,assms ,term ,rule ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.fast-crewrite-try-rules$ (term rules &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.fast-flag-crewrite 'rules ,assms ,term ,rules nil ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.fast-crewrite-try-rules ,assms ,term ,rules ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.fast-crewrite-try-match$ (term rule sigma &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.fast-flag-crewrite 'match ,assms ,term ,rule ,sigma ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.fast-crewrite-try-match ,assms ,term ,rule ,sigma ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.fast-crewrite-try-matches$ (term rule sigmas &key flagp (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.fast-flag-crewrite 'matches ,assms ,term ,rule ,sigmas ,cache ,iffp ,blimit ,rlimit ,anstack ,control)
+      `(rw.fast-crewrite-try-matches ,assms ,term ,rule ,sigmas ,cache ,iffp ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.fast-crewrite-relieve-hyp$ (hyp rule sigma &key flagp (assms 'assms) (cache 'cache) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.fast-flag-crewrite 'hyp ,assms ,hyp ,rule ,sigma ,cache t ,blimit ,rlimit ,anstack ,control)
+      `(rw.fast-crewrite-relieve-hyp ,assms ,hyp ,rule ,sigma ,cache ,blimit ,rlimit ,anstack ,control)))
+
+  (defmacro rw.fast-crewrite-relieve-hyps$ (hyps rule sigma &key flagp (assms 'assms) (cache 'cache) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+    (declare (xargs :guard (booleanp flagp)))
+    (if flagp
+        `(rw.fast-flag-crewrite 'hyps ,assms ,hyps ,rule ,sigma ,cache t ,blimit ,rlimit ,anstack ,control)
+      `(rw.fast-crewrite-relieve-hyps ,assms ,hyps ,rule ,sigma ,cache ,blimit ,rlimit ,anstack ,control))))
+
+
+
+
+(defsection fast-irrelevant-argument-reduction
+
+  ;; Some of the functions do not use all the arguments here, so we provide
+  ;; reduction theorems to show which arguments are irrelevant.
+
+ (local (in-theory (disable (:executable-counterpart ACL2::force))))
+
+ (defthmd rw.fast-flag-crewrite-of-term-reduction
+   (equal (rw.fast-flag-crewrite 'term assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-core$ x :flagp t))
+   :hints(("Goal"
+           :expand ((rw.fast-flag-crewrite 'term assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.fast-crewrite-core$ x :flagp t)))))
+
+ (defthmd rw.fast-flag-crewrite-of-list-reduction
+   (equal (rw.fast-flag-crewrite 'list assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-core-list$ x :flagp t))
+   :hints(("Goal"
+           :expand ((rw.fast-flag-crewrite 'list assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.fast-crewrite-core-list$ x :flagp t)))))
+
+ (defthmd rw.fast-flag-crewrite-of-rule-reduction
+   (equal (rw.fast-flag-crewrite 'rule assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-try-rule$ x rule[s] :flagp t))
+   :hints(("Goal"
+           :expand ((rw.fast-flag-crewrite 'rule assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.fast-crewrite-try-rule$ x rule[s] :flagp t)))))
+
+ (defthmd rw.fast-flag-crewrite-of-rules-reduction
+   (equal (rw.fast-flag-crewrite 'rules assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-try-rules$ x rule[s] :flagp t))
+   :hints(("Goal"
+           :expand ((rw.fast-flag-crewrite 'rules assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.fast-crewrite-try-rules$ x rule[s] :flagp t)))))
+
+ (defthmd rw.fast-flag-crewrite-of-hyp-reduction
+   (equal (rw.fast-flag-crewrite 'hyp assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s] :flagp t))
+   :hints(("Goal"
+           :expand ((rw.fast-flag-crewrite 'hyp assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s] :flagp t)))))
+
+ (defthmd rw.fast-flag-crewrite-of-hyps-reduction
+   (equal (rw.fast-flag-crewrite 'hyps assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s] :flagp t))
+   :hints(("Goal"
+           :expand ((rw.fast-flag-crewrite 'hyps assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+                    (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s] :flagp t))))))
+
+
+
+
+(defsection fast-flag-wrapper-functions
+
+  ;; We now introduce wrappers for the various functions inside the nest.
+
+  (definlined rw.fast-crewrite-core (assms x cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (logic.termp x)
+                                (rw.fast-cachep cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.fast-crewrite-core$ x :flagp t))
+
+  (definlined rw.fast-crewrite-core-list (assms x cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (logic.term-listp x)
+                                (rw.fast-cachep cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.fast-crewrite-core-list$ x :flagp t))
+
+  (definlined rw.fast-crewrite-try-rule (assms x rule[s] cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (logic.termp x)
+                                (rw.rulep rule[s])
+                                (rw.fast-cachep cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.fast-crewrite-try-rule$ x rule[s] :flagp t))
+
+  (definlined rw.fast-crewrite-try-rules (assms x rule[s] cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (logic.termp x)
+                                (rw.rule-listp rule[s])
+                                (rw.fast-cachep cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.fast-crewrite-try-rules$ x rule[s] :flagp t))
+
+  (definlined rw.fast-crewrite-try-match (assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (logic.termp x)
+                                (rw.rulep rule[s])
+                                (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                    (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                (logic.sigmap sigma[s])
+                                (submapp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])
+                                (rw.fast-cachep cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.fast-crewrite-try-match$ x rule[s] sigma[s] :flagp t))
+
+  (definlined rw.fast-crewrite-try-matches (assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (logic.termp x)
+                                (rw.rulep rule[s])
+                                (or (equal (rw.rule->equiv rule[s]) 'equal)
+                                    (and iffp (equal (rw.rule->equiv rule[s]) 'iff)))
+                                (not (equal 'fail (logic.patmatch (rw.rule->lhs rule[s]) x nil)))
+                                (logic.sigma-listp sigma[s])
+                                (submap-of-eachp (logic.patmatch (rw.rule->lhs rule[s]) x nil) sigma[s])
+                                (rw.fast-cachep cache)
+                                (booleanp iffp)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.fast-crewrite-try-matches$ x rule[s] sigma[s] :flagp t))
+
+  (definlined rw.fast-crewrite-relieve-hyp (assms x rule[s] sigma[s] cache blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (rw.hypp x)
+                                (rw.rulep rule[s])
+                                (logic.sigmap sigma[s])
+                                (rw.fast-cachep cache)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s] :flagp t))
+
+  (definlined rw.fast-crewrite-relieve-hyps (assms x rule[s] sigma[s] cache blimit rlimit anstack control)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (rw.hyp-listp x)
+                                (rw.rulep rule[s])
+                                (logic.sigmap sigma[s])
+                                (rw.fast-cachep cache)
+                                (natp blimit)
+                                (natp rlimit)
+                                (rw.anstackp anstack)
+                                (rw.controlp control))
+                    :verify-guards nil))
+    (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s] :flagp t)))
+
+
+
+
+(defsection rw.fast-flag-crewrite-removal
+
+  ;; We now prove the elimination rules for flag-crewrite to transform it into
+  ;; calls of these wrapper functions.
+
+ (defthm rw.fast-flag-crewrite-of-term
+   (equal (rw.fast-flag-crewrite 'term assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-core$ x))
+   :hints(("Goal"
+           :in-theory (enable rw.fast-crewrite-core)
+           :use ((:instance rw.fast-flag-crewrite-of-term-reduction)))))
+
+ (defthm rw.fast-flag-crewrite-of-list
+   (equal (rw.fast-flag-crewrite 'list assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-core-list$ x))
+   :hints(("Goal"
+           :in-theory (enable rw.fast-crewrite-core-list)
+           :use ((:instance rw.fast-flag-crewrite-of-list-reduction)))))
+
+ (defthm rw.fast-flag-crewrite-of-rule
+   (equal (rw.fast-flag-crewrite 'rule assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-try-rule$ x rule[s]))
+   :hints(("Goal"
+           :in-theory (enable rw.fast-crewrite-try-rule)
+           :use ((:instance rw.fast-flag-crewrite-of-rule-reduction)))))
+
+ (defthm rw.fast-flag-crewrite-of-rules
+   (equal (rw.fast-flag-crewrite 'rules assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-try-rules$ x rule[s]))
+   :hints(("Goal"
+           :in-theory (enable rw.fast-crewrite-try-rules)
+           :use ((:instance rw.fast-flag-crewrite-of-rules-reduction)))))
+
+ (defthm rw.fast-flag-crewrite-of-match
+   (equal (rw.fast-flag-crewrite 'match assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-try-match$ x rule[s] sigma[s]))
+   :hints(("Goal" :in-theory (enable rw.fast-crewrite-try-match))))
+
+ (defthm rw.fast-flag-crewrite-of-matches
+   (equal (rw.fast-flag-crewrite 'matches assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-try-matches$ x rule[s] sigma[s]))
+   :hints(("Goal" :in-theory (enable rw.fast-crewrite-try-matches))))
+
+ (defthm rw.fast-flag-crewrite-of-hyp
+   (equal (rw.fast-flag-crewrite 'hyp assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s]))
+   :hints(("Goal"
+           :in-theory (enable rw.fast-crewrite-relieve-hyp)
+           :use ((:instance rw.fast-flag-crewrite-of-hyp-reduction)))))
+
+ (defthm rw.fast-flag-crewrite-of-hyps
+   (equal (rw.fast-flag-crewrite 'hyps assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+          (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s]))
+   :hints(("Goal"
+           :in-theory (enable rw.fast-crewrite-relieve-hyps)
+           :use ((:instance rw.fast-flag-crewrite-of-hyps-reduction))))))
+
+
+
+
+(ACL2::make-event
+ (let ((sigma (ACL2::append *rw.fast-cache-sigma*
+                            *rw.fast-assms-sigma*
+                            *rw.fast-traces-sigma*
+                            *rw.fast-crewrite-noflag-sigma*)))
+   `(encapsulate
+     ()
+     (ACL2::set-ignore-ok t)
+
+     (defthmd definition-of-rw.fast-crewrite-core
+       (equal (rw.fast-crewrite-core$ x)
+              ,(ACL2::jared-rewrite *rw.crewrite-core* sigma))
+       :rule-classes :definition
+       :hints(("Goal"
+               :use ((:instance rw.fast-flag-crewrite (flag 'term))))))
+
+     (defthmd definition-of-rw.fast-crewrite-core-list
+       (equal (rw.fast-crewrite-core-list$ x)
+              ,(ACL2::jared-rewrite *rw.fast-crewrite-list* sigma))
+       :rule-classes :definition
+       :hints(("Goal" :use ((:instance rw.fast-flag-crewrite (flag 'list))))))
+
+     (defthmd definition-of-rw.fast-crewrite-try-rule
+       (equal (rw.fast-crewrite-try-rule$ x rule[s])
+              ,(ACL2::jared-rewrite *rw.crewrite-rule* sigma))
+       :rule-classes :definition
+       :hints(("Goal" :use ((:instance rw.fast-flag-crewrite (flag 'rule))))))
+
+     (defthmd definition-of-rw.fast-crewrite-try-rules
+       (equal (rw.fast-crewrite-try-rules$ x rule[s])
+              ,(ACL2::jared-rewrite *rw.crewrite-rules* sigma))
+       :rule-classes :definition
+       :hints(("Goal" :use ((:instance rw.fast-flag-crewrite (flag 'rules))))))
+
+     (defthmd definition-of-rw.fast-crewrite-try-match
+       (equal (rw.fast-crewrite-try-match$ x rule[s] sigma[s])
+              ,(ACL2::jared-rewrite *rw.crewrite-match* sigma))
+       :rule-classes :definition
+       :hints(("Goal" :use ((:instance rw.fast-flag-crewrite (flag 'match))))))
+
+     (defthmd definition-of-rw.fast-crewrite-try-matches
+       (equal (rw.fast-crewrite-try-matches$ x rule[s] sigma[s])
+              ,(ACL2::jared-rewrite *rw.crewrite-matches* sigma))
+       :rule-classes :definition
+       :hints(("Goal" :use ((:instance rw.fast-flag-crewrite (flag 'matches))))))
+
+     (defthmd definition-of-rw.fast-crewrite-relieve-hyp
+       (equal (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s])
+              ,(ACL2::jared-rewrite *rw.crewrite-hyp* sigma))
+       :rule-classes :definition
+       :hints(("Goal" :use ((:instance rw.fast-flag-crewrite (flag 'hyp))))))
+
+     (defthmd definition-of-rw.fast-crewrite-relieve-hyps
+       (equal (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s])
+              ,(ACL2::jared-rewrite *rw.fast-crewrite-hyps* sigma))
+       :rule-classes :definition
+       :hints(("Goal" :use ((:instance rw.fast-flag-crewrite (flag 'hyps)))))))))
+
+
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-crewrite-core))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-crewrite-core-list))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-crewrite-try-rule))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-crewrite-try-rules))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-crewrite-try-match))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-crewrite-try-matches))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-crewrite-relieve-hyp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-crewrite-relieve-hyps))))
+
+
+
+
+
+(defthm rw.fast-crewrite-core-list-when-not-consp
+   (implies (not (consp x))
+            (equal (rw.fast-crewrite-core-list$ x)
+                   (rw.cresult (rw.ftraces nil nil) cache nil)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.fast-crewrite-core-list))))
+
+(defthm rw.fast-crewrite-core-list-of-cons
+   (equal (rw.fast-crewrite-core-list$ (cons a x))
+          (let* ((term1-rw      (rw.fast-crewrite-core$ a))
+                 (term1-trace   (rw.cresult->data term1-rw))
+                 (term1-cache   (rw.cresult->cache term1-rw))
+                 (term1-limited (rw.cresult->alimitedp term1-rw))
+                 (others-rw      (rw.fast-crewrite-core-list$ x :cache term1-cache))
+                 (others-traces  (rw.cresult->data others-rw))
+                 (others-cache   (rw.cresult->cache others-rw))
+                 (others-limited (rw.cresult->alimitedp others-rw)))
+            (rw.cresult (rw.ftraces (cons (rw.ftrace->rhs term1-trace)
+                                          (rw.ftraces->rhses others-traces))
+                                    (fast-merge (rw.ftrace->fgoals term1-trace)
+                                                (rw.ftraces->fgoals others-traces)))
+                        others-cache
+                        (or term1-limited others-limited))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.fast-crewrite-core-list))))
+
+(defun rw.fast-crewrite-list-induction (assms x cache iffp blimit rlimit anstack control)
+   (declare (xargs :verify-guards nil))
+   (if (consp x)
+       (rw.fast-crewrite-list-induction assms (cdr x)
+                                        (rw.cresult->cache (rw.fast-crewrite-core$ (car x)))
+                                        iffp blimit rlimit anstack control)
+     (list assms x cache iffp blimit rlimit anstack control)))
+
+(defmacro rw.fast-crewrite-list-induction$ (x &key (assms 'assms) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+   `(rw.fast-crewrite-list-induction ,assms ,x ,cache ,iffp ,blimit ,rlimit ,anstack ,control))
+
+(defthm len-of-rw.ftraces->rhses-of-rw.cresult->data-of-rw.fast-crewrite-core-list$
+  (equal (len (rw.ftraces->rhses (rw.cresult->data (rw.fast-crewrite-core-list$ x))))
+         (len x))
+  :hints(("Goal"
+          :induct (rw.fast-crewrite-list-induction$ x)
+          :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthm rw.fast-crewrite-try-rules-when-not-consp
+   (implies (not (consp rule[s]))
+            (equal (rw.fast-crewrite-try-rules$ x rule[s])
+                   (rw.cresult nil cache nil)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.fast-crewrite-try-rules))))
+
+(defthm rw.fast-crewrite-try-rules-of-cons
+   (equal (rw.fast-crewrite-try-rules$ x (cons rule rules))
+          (let* ((rule1-rw      (rw.fast-crewrite-try-rule$ x rule))
+                 (rule1-trace   (rw.cresult->data rule1-rw))
+                 (rule1-cache   (rw.cresult->cache rule1-rw))
+                 (rule1-limited (rw.cresult->alimitedp rule1-rw)))
+            (if rule1-trace
+                rule1-rw
+              (let* ((others-rw      (rw.fast-crewrite-try-rules$ x rules :cache rule1-cache))
+                     (others-trace   (rw.cresult->data others-rw))
+                     (others-cache   (rw.cresult->cache others-rw))
+                     (others-limited (rw.cresult->alimitedp others-rw)))
+                (if others-trace
+                    others-rw
+                  (rw.cresult nil others-cache (or rule1-limited others-limited)))))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.fast-crewrite-try-rules))))
+
+(defun rw.fast-crewrite-try-rules-induction (assms x rule[s] cache iffp blimit rlimit anstack control)
+   (declare (xargs :verify-guards nil))
+   (if (consp rule[s])
+       (rw.fast-crewrite-try-rules-induction assms x (cdr rule[s])
+                                        (rw.cresult->cache (rw.fast-crewrite-try-rule$ x (car rule[s])))
+                                        iffp blimit rlimit anstack control)
+     (list assms x rule[s] cache iffp blimit rlimit anstack control)))
+
+(defmacro rw.fast-crewrite-try-rules-induction$ (x &key (assms 'assms) (rule[s] 'rule[s]) (cache 'cache) (iffp 'iffp) (blimit 'blimit) (rlimit 'rlimit) (anstack 'anstack) (control 'control))
+   `(rw.fast-crewrite-try-rules-induction ,assms ,x ,rule[s] ,cache ,iffp ,blimit ,rlimit ,anstack ,control))
+
+(defthm rw.fast-crewrite-try-matches-when-not-consp
+   (implies (not (consp sigma[s]))
+            (equal (rw.fast-crewrite-try-matches$ x rule[s] sigma[s])
+                   (rw.cresult nil cache nil)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.fast-crewrite-try-matches))))
+
+(defthm rw.fast-crewrite-try-matches-of-cons
+   (equal (rw.fast-crewrite-try-matches$ x rule[s] (cons sigma sigmas))
+          (let* ((match1-rw      (rw.fast-crewrite-try-match$ x rule[s] sigma))
+                 (match1-trace   (rw.cresult->data match1-rw))
+                 (match1-cache   (rw.cresult->cache match1-rw))
+                 (match1-limited (rw.cresult->alimitedp match1-rw)))
+            (if match1-trace
+                match1-rw
+              (let* ((others-rw      (rw.fast-crewrite-try-matches$ x rule[s] sigmas :cache match1-cache))
+                     (others-trace   (rw.cresult->data others-rw))
+                     (others-cache   (rw.cresult->cache others-rw))
+                     (others-limited (rw.cresult->alimitedp others-rw)))
+                (if others-trace
+                    others-rw
+                  (rw.cresult nil others-cache (or match1-limited others-limited)))))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.fast-crewrite-try-matches))))
+
+
+(defthm rw.fast-crewrite-relieve-hyps-when-not-consp
+   (implies (not (consp x))
+            (equal (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s])
+                   (rw.hypresult t (rw.ftraces nil nil) cache nil)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.fast-crewrite-relieve-hyps))))
+
+(defthm rw.fast-crewrite-relieve-hyps-of-cons
+   (equal (rw.fast-crewrite-relieve-hyps$ (cons a x) rule[s] sigma[s])
+          (let* ((hyp1-rw      (rw.fast-crewrite-relieve-hyp$ a rule[s] sigma[s]))
+                 (hyp1-trace   (rw.cresult->data hyp1-rw))
+                 (hyp1-cache   (rw.cresult->cache hyp1-rw))
+                 (hyp1-limited (rw.cresult->alimitedp hyp1-rw)))
+            (if (not hyp1-trace)
+                (rw.hypresult nil (rw.ftraces nil nil) hyp1-cache hyp1-limited)
+              (let* ((others-rw       (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s] :cache hyp1-cache))
+                     (others-successp (rw.hypresult->successp others-rw))
+                     (others-traces   (rw.hypresult->traces others-rw))
+                     (others-cache    (rw.hypresult->cache others-rw))
+                     (others-limited  (rw.hypresult->alimitedp others-rw)))
+                (if others-successp
+                    (rw.hypresult t (rw.ftraces (cons (rw.ftrace->rhs hyp1-trace)
+                                                      (rw.ftraces->rhses others-traces))
+                                                (fast-merge (rw.ftrace->fgoals hyp1-trace)
+                                                            (rw.ftraces->fgoals others-traces)))
+                                  others-cache nil)
+                  (rw.hypresult nil (rw.ftraces nil nil) others-cache others-limited))))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.fast-crewrite-relieve-hyps))))
+
+(defthm booleanp-of-rw.hypresult->successp-of-rw.fast-crewrite-relieve-hyps
+   (equal (booleanp (rw.hypresult->successp (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s])))
+          t)
+   :hints(("Goal"
+           :in-theory (disable (:executable-counterpart ACL2::force))
+           :use ((:instance definition-of-rw.fast-crewrite-relieve-hyps)))))
+
+
+
+
+(local (deftheory my-disables-for-extra-speed
+          '(consp-when-memberp-of-logic.sigmap
+            consp-when-memberp-of-logic.sigmap-alt
+            consp-when-memberp-of-logic.sigma-atblp
+            consp-when-memberp-of-logic.sigma-atblp-alt
+            consp-when-memberp-of-logic.arity-tablep
+            consp-when-memberp-of-logic.arity-tablep-alt
+            consp-when-memberp-of-logic.callmapp
+            consp-when-memberp-of-logic.callmapp-alt
+            consp-when-memberp-of-logic.callmap-atblp
+            consp-when-memberp-of-logic.callmap-atblp-alt
+            consp-when-memberp-of-rw.cachemapp
+            consp-when-memberp-of-rw.cachemapp-alt
+            consp-when-memberp-of-none-consp
+            consp-when-memberp-of-none-consp-alt
+            consp-when-memberp-of-cons-listp
+            consp-when-memberp-of-cons-listp-alt
+
+            same-length-prefixes-equal-cheap
+
+            car-when-not-consp
+            cdr-when-not-consp
+            consp-when-natp-cheap
+            forcing-logic.groundp-of-logic.substitute
+            consp-when-logic.lambdap-cheap
+            consp-when-logic.functionp-cheap
+            consp-when-nonempty-subset-cheap
+            consp-when-memberp-cheap
+            logic.substitute-when-malformed-cheap
+            logic.constant-listp-when-not-consp
+            subsetp-when-not-consp
+            subsetp-when-not-consp-two
+            cons-listp-when-not-consp
+            none-consp-when-not-consp
+            forcing-logic.substitute-of-empty-sigma
+            not-equal-when-less
+            trichotomy-of-<
+            natp-of-len-free
+            transitivity-of-<
+            transitivity-of-<-three
+            transitivity-of-<-two
+            less-completion-left
+            less-of-one-right)))
+
+(local (in-theory (disable my-disables-for-extra-speed)))
+
+(local (in-theory (disable zp min)))
+
+
+(defthms-flag
+  :shared-hyp (force (and (rw.fast-assmsp assms)
+                          (rw.controlp control)
+                          (rw.fast-cachep cache)))
+  :thms ((term forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.ftracep (rw.cresult->data (rw.fast-crewrite-core$ x)))
+                               t)))
+         (term forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.fast-cachep (rw.cresult->cache (rw.fast-crewrite-core$ x)))
+                               t)))
+
+         (list forcing-rw.ftracesp-of-rw.cresult->data-of-rw.fast-crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.ftracesp (rw.cresult->data (rw.fast-crewrite-core-list$ x)))
+                               t)))
+         (list forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.fast-cachep (rw.cresult->cache (rw.fast-crewrite-core-list$ x)))
+                               t)))
+
+         (rule forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-try-rule
+               (implies (force (and (rw.cresult->data (rw.fast-crewrite-try-rule$ x rule[s]))
+                                    (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.ftracep (rw.cresult->data (rw.fast-crewrite-try-rule$ x rule[s])))
+                               t)))
+         (rule forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-try-rule
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.fast-cachep (rw.cresult->cache (rw.fast-crewrite-try-rule$ x rule[s])))
+                               t)))
+
+         (rules forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-try-rules
+                (implies (force (and (rw.cresult->data (rw.fast-crewrite-try-rules$ x rule[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.ftracep (rw.cresult->data (rw.fast-crewrite-try-rules$ x rule[s])))
+                                t)))
+         (rules forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-try-rules
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.fast-cachep (rw.cresult->cache (rw.fast-crewrite-try-rules$ x rule[s])))
+                                t)))
+
+         (match forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-try-match
+                (implies (force (and (rw.cresult->data (rw.fast-crewrite-try-match$ x rule[s] sigma[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.ftracep (rw.cresult->data (rw.fast-crewrite-try-match$ x rule[s] sigma[s])))
+                                t)))
+         (match forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-try-match
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.fast-cachep (rw.cresult->cache (rw.fast-crewrite-try-match$ x rule[s] sigma[s])))
+                                t)))
+
+         (matches forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-try-matches
+                  (implies (force (and (rw.cresult->data (rw.fast-crewrite-try-matches$ x rule[s] sigma[s]))
+                                       (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.ftracep (rw.cresult->data (rw.fast-crewrite-try-matches$ x rule[s] sigma[s])))
+                                  t)))
+         (matches forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-try-matches
+                  (implies (force (and (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.fast-cachep (rw.cresult->cache (rw.fast-crewrite-try-matches$ x rule[s] sigma[s])))
+                                  t)))
+
+         (hyp forcing-rw.ftracep-of-rw.cresult->data-of-rw.fast-crewrite-relieve-hyp
+              (implies (force (and (rw.cresult->data (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                   (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.ftracep (rw.cresult->data (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                              t)))
+         (hyp forcing-rw.fast-cachep-of-rw.cresult->cache-of-rw.fast-crewrite-relieve-hyp
+              (implies (force (and (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.fast-cachep (rw.cresult->cache (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                              t)))
+
+         (t forcing-rw.ftracesp-of-rw.hypresult->traces-of-rw.fast-crewrite-relieve-hyps
+            (implies (force (and (rw.hypresult->successp (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                 (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.ftracesp (rw.hypresult->traces (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                            t)))
+         (t forcing-rw.fast-cachep-of-rw.hypresult->cache-of-rw.fast-crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.fast-cachep (rw.hypresult->cache (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                            t))))
+  :hints (("Goal"
+           :induct (rw.fast-flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+           :expand ((:free (iffp rlimit) (rw.fast-crewrite-core$ x))
+                    (:free (iffp)        (rw.fast-crewrite-try-rule$ x rule[s]))
+                    (:free ()            (rw.fast-crewrite-try-match$ x rule[s] sigma[s]))
+                    (:free (blimit)      (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s])))
+           :in-theory (disable forcing-lookup-of-logic.function-name
+                               forcing-lookup-of-logic.function-name-free)
+           :do-not-induct t)))
+
+(verify-guards rw.fast-flag-crewrite
+               :hints(("Goal"
+                       :in-theory (disable subsetp-of-logic.term-vars-and-domain-of-logic.patmatch)
+                       :use ((:instance subsetp-of-logic.term-vars-and-domain-of-logic.patmatch
+                                        (x (rw.rule->lhs rule[s]))
+                                        (y x)
+                                        (sigma nil))))))
+
+
+
+(defthms-flag
+
+  ;; I am giant!
+
+  ;; This is a big theorem because we effectively have to prove everything at
+  ;; once.  The induction scheme takes up almost 5,000 lines when ACL2 prints
+  ;; it.  It splits into 60 inductive subgoals, some of which then split into
+  ;; thousands of subcases.
+
+  ;; But don't complain.  I did a lot of work to introduce these "fast image"
+  ;; functions and to get the rewriters to perfectly line up in this way.  My
+  ;; original plan was to introduce an image relation, e.g., ftrace is related
+  ;; to trace if their rhses are the same and ftrace's fgoals are a superset of
+  ;; trace's.  If I had done that, then you'd be looking at a merged induction
+  ;; scheme that walked both definitions simultaneously, and it would be even
+  ;; worse than the horrific mess below.
+
+  ;; If something breaks, the best thing to do is immediately go to the
+  ;; CONCLUSION of the goal that has arisen.  Typically, this has the form
+  ;; (equal lhs rhs).  Do a compare-windows on lhs and rhs to figure out the
+  ;; first place they differ, and then try to think of why the different parts
+  ;; should rewrite to the same thing.  If instead the conclusion is just a
+  ;; term or a (NOT x) term, then look for the "related" term (i.e., about
+  ;; rw.assumptions-trace instead of rw.fast-assumptions-trace) among the hyps,
+  ;; and see if some rewrite rule can connect the two.
+
+  ;; If this doesn't work, you'll have to dig through the hyps.  If you start
+  ;; at the bottom of the hyps, it usually has the basic information about what
+  ;; the main assumptions are.  That's a good place to start, because the upper
+  ;; hyps will contain the numerous inductive hyps that you don't really want
+  ;; to look at.
+
+  :shared-hyp (force (and (rw.assmsp assms)
+                          (rw.controlp control)
+                          (rw.cachep cache)))
+
+  :thms ((term rw.trace-fast-image-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-fast-image (rw.cresult->data (rw.crewrite-core$ x)))
+                               (rw.cresult->data (rw.fast-crewrite-core$ x
+                                                  :assms (rw.assms-fast-image assms)
+                                                  :cache (rw.cache-fast-image cache))))))
+
+         (term rw.cache-fast-image-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-fast-image (rw.cresult->cache (rw.crewrite-core$ x)))
+                               (rw.cresult->cache (rw.fast-crewrite-core$ x
+                                                   :assms (rw.assms-fast-image assms)
+                                                   :cache (rw.cache-fast-image cache))))))
+
+         (term rw.cresult->alimitedp-of-rw.crewrite-core
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cresult->alimitedp (rw.crewrite-core$ x))
+                               (rw.cresult->alimitedp (rw.fast-crewrite-core$ x
+                                                       :assms (rw.assms-fast-image assms)
+                                                       :cache (rw.cache-fast-image cache))))))
+
+
+
+         (list rw.trace-list-fast-image-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.trace-list-fast-image (rw.cresult->data (rw.crewrite-core-list$ x)))
+                               (rw.cresult->data (rw.fast-crewrite-core-list$ x
+                                                  :assms (rw.assms-fast-image assms)
+                                                  :cache (rw.cache-fast-image cache))))))
+
+         (list rw.cache-fast-image-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cache-fast-image (rw.cresult->cache (rw.crewrite-core-list$ x)))
+                               (rw.cresult->cache (rw.fast-crewrite-core-list$ x
+                                                   :assms (rw.assms-fast-image assms)
+                                                   :cache (rw.cache-fast-image cache))))))
+
+         (list rw.cresult->alimitedp-of-rw.crewrite-core-list
+               (implies (force (and (logic.term-listp x)
+                                    (booleanp iffp)))
+                        (equal (rw.cresult->alimitedp (rw.crewrite-core-list$ x))
+                               (rw.cresult->alimitedp (rw.fast-crewrite-core-list$ x
+                                                       :assms (rw.assms-fast-image assms)
+                                                       :cache (rw.cache-fast-image cache))))))
+
+
+
+         (rule rw.crewrite-try-rule-under-iff
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (iff (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                             (rw.cresult->data (rw.fast-crewrite-try-rule$ x rule[s]
+                                                :assms (rw.assms-fast-image assms)
+                                                :cache (rw.cache-fast-image cache))))))
+
+         (rule rw.trace-fast-image-of-rw.crewrite-try-rule
+               (implies (force (and (rw.cresult->data (rw.crewrite-try-rule$ x rule[s]))
+                                    (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.trace-fast-image (rw.cresult->data (rw.crewrite-try-rule$ x rule[s])))
+                               (rw.cresult->data (rw.fast-crewrite-try-rule$ x rule[s]
+                                                  :assms (rw.assms-fast-image assms)
+                                                  :cache (rw.cache-fast-image cache))))))
+
+         (rule rw.cache-fast-image-of-rw.crewrite-try-rule
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.cache-fast-image (rw.cresult->cache (rw.crewrite-try-rule$ x rule[s])))
+                               (rw.cresult->cache (rw.fast-crewrite-try-rule$ x rule[s]
+                                                   :assms (rw.assms-fast-image assms)
+                                                   :cache (rw.cache-fast-image cache))))))
+
+         (rule rw.cresult->alimitedp-of-rw.crewrite-try-rule
+               (implies (force (and (logic.termp x)
+                                    (booleanp iffp)
+                                    (rw.rulep rule[s])))
+                        (equal (rw.cresult->alimitedp (rw.crewrite-try-rule$ x rule[s]))
+                               (rw.cresult->alimitedp (rw.fast-crewrite-try-rule$ x rule[s]
+                                                       :assms (rw.assms-fast-image assms)
+                                                       :cache (rw.cache-fast-image cache))))))
+
+
+
+         (rules rw.crewrite-try-rules-under-iff
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (iff (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                              (rw.cresult->data (rw.fast-crewrite-try-rules$ x rule[s]
+                                                 :assms (rw.assms-fast-image assms)
+                                                 :cache (rw.cache-fast-image cache))))))
+
+         (rules rw.trace-fast-image-of-rw.crewrite-try-rules
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-rules$ x rule[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.trace-fast-image (rw.cresult->data (rw.crewrite-try-rules$ x rule[s])))
+                                (rw.cresult->data (rw.fast-crewrite-try-rules$ x rule[s]
+                                                  :assms (rw.assms-fast-image assms)
+                                                  :cache (rw.cache-fast-image cache))))))
+
+         (rules rw.cache-fast-image-of-rw.crewrite-try-rules
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.cache-fast-image (rw.cresult->cache (rw.crewrite-try-rules$ x rule[s])))
+                                (rw.cresult->cache (rw.fast-crewrite-try-rules$ x rule[s]
+                                                    :assms (rw.assms-fast-image assms)
+                                                    :cache (rw.cache-fast-image cache))))))
+
+         (rules rw.cresult->alimitedp-of-rw.crewrite-try-rules
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rule-listp rule[s])))
+                         (equal (rw.cresult->alimitedp (rw.crewrite-try-rules$ x rule[s]))
+                                (rw.cresult->alimitedp (rw.fast-crewrite-try-rules$ x rule[s]
+                                                        :assms (rw.assms-fast-image assms)
+                                                        :cache (rw.cache-fast-image cache))))))
+
+
+
+         (match rw.crewrite-try-match-under-iff
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (iff (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                              (rw.cresult->data (rw.fast-crewrite-try-match$ x rule[s] sigma[s]
+                                                 :assms (rw.assms-fast-image assms)
+                                                 :cache (rw.cache-fast-image cache))))))
+
+         (match rw.trace-fast-image-of-rw.crewrite-try-match
+                (implies (force (and (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                     (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.trace-fast-image (rw.cresult->data (rw.crewrite-try-match$ x rule[s] sigma[s])))
+                                (rw.cresult->data (rw.fast-crewrite-try-match$ x rule[s] sigma[s]
+                                                   :assms (rw.assms-fast-image assms)
+                                                   :cache (rw.cache-fast-image cache))))))
+
+         (match rw.cache-fast-image-of-rw.crewrite-try-match
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.cache-fast-image (rw.cresult->cache (rw.crewrite-try-match$ x rule[s] sigma[s])))
+                                (rw.cresult->cache (rw.fast-crewrite-try-match$ x rule[s] sigma[s]
+                                                    :assms (rw.assms-fast-image assms)
+                                                    :cache (rw.cache-fast-image cache))))))
+
+         (match rw.cresult->alimitedp-of-rw.crewrite-try-match
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigmap sigma[s])))
+                         (equal (rw.cresult->alimitedp (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                                (rw.cresult->alimitedp (rw.fast-crewrite-try-match$ x rule[s] sigma[s]
+                                                        :assms (rw.assms-fast-image assms)
+                                                        :cache (rw.cache-fast-image cache))))))
+
+
+
+         (matches rw.crewrite-try-matches-under-iff
+                  (implies (force (and (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (iff (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                (rw.cresult->data (rw.fast-crewrite-try-matches$ x rule[s] sigma[s]
+                                                   :assms (rw.assms-fast-image assms)
+                                                   :cache (rw.cache-fast-image cache))))))
+
+         (matches rw.trace-fast-image-of-rw.crewrite-try-matches
+                  (implies (force (and (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                       (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.trace-fast-image (rw.cresult->data (rw.crewrite-try-matches$ x rule[s] sigma[s])))
+                                  (rw.cresult->data (rw.fast-crewrite-try-matches$ x rule[s] sigma[s]
+                                                     :assms (rw.assms-fast-image assms)
+                                                     :cache (rw.cache-fast-image cache))))))
+
+         (matches rw.cache-fast-image-of-rw.crewrite-try-matches
+                  (implies (force (and (logic.termp x)
+                                       (booleanp iffp)
+                                       (rw.rulep rule[s])
+                                       (logic.sigma-listp sigma[s])))
+                           (equal (rw.cache-fast-image (rw.cresult->cache (rw.crewrite-try-matches$ x rule[s] sigma[s])))
+                                  (rw.cresult->cache (rw.fast-crewrite-try-matches$ x rule[s] sigma[s]
+                                                      :assms (rw.assms-fast-image assms)
+                                                      :cache (rw.cache-fast-image cache))))))
+
+         (matches rw.cresult->alimitedp-of-rw.crewrite-try-matches
+                (implies (force (and (logic.termp x)
+                                     (booleanp iffp)
+                                     (rw.rulep rule[s])
+                                     (logic.sigma-listp sigma[s])))
+                         (equal (rw.cresult->alimitedp (rw.crewrite-try-matches$ x rule[s] sigma[s]))
+                                (rw.cresult->alimitedp (rw.fast-crewrite-try-matches$ x rule[s] sigma[s]
+                                                        :assms (rw.assms-fast-image assms)
+                                                        :cache (rw.cache-fast-image cache))))))
+
+
+
+         (hyp rw.crewrite-relieve-hyp-under-iff
+              (implies (force (and (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (iff (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                            (rw.cresult->data (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s]
+                                               :assms (rw.assms-fast-image assms)
+                                               :cache (rw.cache-fast-image cache))))))
+
+         (hyp rw.trace-fast-image-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                                   (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.trace-fast-image (rw.cresult->data (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                              (rw.cresult->data (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s]
+                                                 :assms (rw.assms-fast-image assms)
+                                                 :cache (rw.cache-fast-image cache))))))
+
+         (hyp rw.cache-fast-image-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.cache-fast-image (rw.cresult->cache (rw.crewrite-relieve-hyp$ x rule[s] sigma[s])))
+                              (rw.cresult->cache (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s]
+                                                  :assms (rw.assms-fast-image assms)
+                                                  :cache (rw.cache-fast-image cache))))))
+
+         (hyp rw.cresult->alimitedp-of-rw.crewrite-relieve-hyp
+              (implies (force (and (rw.hypp x)
+                                   (rw.rulep rule[s])
+                                   (logic.sigmap sigma[s])))
+                       (equal (rw.cresult->alimitedp (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                              (rw.cresult->alimitedp (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s]
+                                                      :assms (rw.assms-fast-image assms)
+                                                      :cache (rw.cache-fast-image cache))))))
+
+
+
+         (t rw.hypresult->successp-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                            (rw.hypresult->successp (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s]
+                                                     :assms (rw.assms-fast-image assms)
+                                                     :cache (rw.cache-fast-image cache))))))
+
+         (t rw.trace-list-fast-image-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hypresult->successp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                                 (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.trace-list-fast-image (rw.hypresult->traces (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                            (rw.hypresult->traces (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s]
+                                                   :assms (rw.assms-fast-image assms)
+                                                   :cache (rw.cache-fast-image cache))))))
+
+         (t rw.cache-fast-image-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.cache-fast-image (rw.hypresult->cache (rw.crewrite-relieve-hyps$ x rule[s] sigma[s])))
+                            (rw.hypresult->cache (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s]
+                                                  :assms (rw.assms-fast-image assms)
+                                                  :cache (rw.cache-fast-image cache))))))
+
+         (t rw.hypresult->alimitedp-of-rw.crewrite-relieve-hyps
+            (implies (force (and (rw.hyp-listp x)
+                                 (rw.rulep rule[s])
+                                 (logic.sigmap sigma[s])))
+                     (equal (rw.hypresult->alimitedp (rw.crewrite-relieve-hyps$ x rule[s] sigma[s]))
+                            (rw.hypresult->alimitedp (rw.fast-crewrite-relieve-hyps$ x rule[s] sigma[s]
+                                                      :assms (rw.assms-fast-image assms)
+                                                      :cache (rw.cache-fast-image cache)))))))
+
+  :hints (("Goal"
+           :induct (rw.flag-crewrite flag assms x rule[s] sigma[s] cache iffp blimit rlimit anstack control)
+           :expand ((:free (iffp rlimit) (rw.fast-crewrite-core$ x
+                                                                 :assms (rw.assms-fast-image assms)
+                                                                 :cache (rw.cache-fast-image cache)))
+                    (:free (iffp)        (rw.fast-crewrite-try-rule$ x rule[s]
+                                                                 :assms (rw.assms-fast-image assms)
+                                                                 :cache (rw.cache-fast-image cache)))
+                    (:free ()            (rw.fast-crewrite-try-match$ x rule[s] sigma[s]
+                                                                 :assms (rw.assms-fast-image assms)
+                                                                 :cache (rw.cache-fast-image cache)))
+                    (:free (blimit)      (rw.fast-crewrite-relieve-hyp$ x rule[s] sigma[s]
+                                                                 :assms (rw.assms-fast-image assms)
+                                                                 :cache (rw.cache-fast-image cache)))
+                    ;; ---
+                    (:free (iffp rlimit) (rw.crewrite-core$ x))
+                    (:free (iffp)        (rw.crewrite-try-rule$ x rule[s]))
+                    (:free ()            (rw.crewrite-try-match$ x rule[s] sigma[s]))
+                    (:free (blimit)      (rw.crewrite-relieve-hyp$ x rule[s] sigma[s]))
+                    )
+           :in-theory (e/d (rw.trace-fast-image-equivalence-lemmas
+                            rw.fast-weakening-trace)
+                           (forcing-lookup-of-logic.function-name
+                            forcing-lookup-of-logic.function-name-free))
+           :do-not-induct t
+           )))
+
+
+
+(defthm rw.ftrace->rhs-of-rw.fast-crewrite-core
+  (implies (force (and (logic.termp x)
+                       (booleanp iffp)
+                       (rw.assmsp assms)
+                       (rw.controlp control)
+                       (rw.cachep cache)))
+           (equal (rw.ftrace->rhs (rw.cresult->data (rw.fast-crewrite-core$ x
+                                                     :assms (rw.assms-fast-image assms)
+                                                     :cache (rw.cache-fast-image cache))))
+                  (rw.trace->rhs (rw.cresult->data (rw.crewrite-core$ x)))))
+  :hints(("Goal"
+          :in-theory (disable rw.trace-fast-image-of-rw.crewrite-core)
+          :use ((:instance rw.trace-fast-image-of-rw.crewrite-core)))))
+
+
+#||
+
+;; As in crewrite, this is no longer necessary...
+
+(defund rw.aux-fast-crewrite (assms x cache iffp blimit rlimit control n)
+  (declare (xargs :guard (and (rw.fast-assmsp assms)
+                              (logic.termp x)
+                              (rw.fast-cachep cache)
+                              (rw.controlp control)
+                              (booleanp iffp)
+                              (natp blimit)
+                              (natp rlimit)
+                              (natp n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (let* ((pass1-rw    (rw.fast-crewrite-core assms x cache iffp blimit rlimit nil control))
+         (pass1-trace (rw.cresult->data pass1-rw))
+         (pass1-cache (rw.cresult->cache pass1-rw)))
+    (cond ((equal x (rw.ftrace->rhs pass1-trace))
+           ;; Originally, we instead checked if the method was 'fail.  But when
+           ;; we started to develop fast-crewrite, we adopted the above approach
+           ;; instead.
+           ;;
+           ;; This gives us a wonderful property: our rewriter never looks at
+           ;; the method of a trace.  Because of this, we can omit the method
+           ;; from fast-traces.  (The method is still needed for regular traces
+           ;; because of the trace compilers.)
+           ;;
+           ;; This also allows further optimization.  For instance, the method
+           ;; of (rw.transitivity-trace x y) might be 'fail or 'transitivity,
+           ;; but to compute this we must have the lhs of x to compare against
+           ;; the lhs of y.  By obviating the method computation, we can (1)
+           ;; omit lhses from fast-traces entirely, and (2) eliminate the
+           ;; overhead of these equality checks.
+           pass1-trace)
+
+          ((zp n)
+           ;; We cannot further simplify becuase we have run out of steps.
+           (ACL2::prog2$ (ACL2::cw "[rw.fast-crewrite] Warning: ran out of rewriting steps.~%")
+                         pass1-trace))
+
+          (t
+           ;; Perhaps we can simplify it further?
+           (rw.fast-transitivity-trace pass1-trace
+                                       (rw.aux-fast-crewrite assms (rw.ftrace->rhs pass1-trace) pass1-cache iffp
+                                                             blimit rlimit control (- n 1)))))))
+
+(defthm rw.ftracep-of-rw.aux-fast-crewrite
+  (implies (force (and (rw.fast-assmsp assms)
+                       (rw.fast-cachep cache)
+                       (rw.controlp control)
+                       (booleanp iffp)
+                       (logic.termp x)
+                   ))
+           (equal (rw.ftracep (rw.aux-fast-crewrite assms x cache iffp blimit rlimit control n))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.aux-fast-crewrite))))
+
+(defthm rw.trace-fast-image-of-rw.aux-crewrite
+  (implies (force (and (logic.termp x)
+                       (booleanp iffp)
+                       (rw.assmsp assms)
+                       (rw.cachep cache)
+                       (rw.controlp control)))
+           (equal (rw.trace-fast-image (rw.aux-crewrite assms x cache iffp blimit rlimit control n))
+                  (rw.aux-fast-crewrite (rw.assms-fast-image assms)
+                                        x
+                                        (rw.cache-fast-image cache)
+                                        iffp blimit rlimit control n)))
+  :hints(("Goal" :in-theory (enable rw.aux-crewrite
+                                    rw.aux-fast-crewrite))))
+
+
+||#
+
+
+(defund rw.fast-crewrite (assms x iffp blimit rlimit control n)
+  (declare (xargs :guard (and (rw.fast-assmsp assms)
+                              (logic.termp x)
+                              (booleanp iffp)
+                              (natp blimit)
+                              (natp rlimit)
+                              (rw.controlp control)
+                              (natp n))
+                  :verify-guards nil)
+           (ignore n))
+  ;; Old code:
+  ;; (rw.aux-fast-crewrite assms x (rw.fast-empty-cache) iffp blimit rlimit control n))
+  ;; New code:
+  (let ((result (rw.fast-crewrite-core assms x (rw.fast-empty-cache) iffp blimit rlimit nil control)))
+    (ACL2::prog2$
+     (ACL2::flush-hons-get-hash-table-link (rw.cresult->cache result))
+     (rw.cresult->data result))))
+
+(defthm rw.ftracep-of-rw.fast-crewrite
+  (implies (force (and (rw.fast-assmsp assms)
+                       (rw.controlp control)
+                       (booleanp iffp)
+                       (logic.termp x)))
+           (equal (rw.ftracep (rw.fast-crewrite assms x iffp blimit rlimit control n))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.fast-crewrite))))
+
+(defthm rw.trace-fast-image-of-rw.crewrite
+  (implies (force (and (logic.termp x)
+                       (booleanp iffp)
+                       (rw.assmsp assms)
+                       (rw.controlp control)))
+           (equal (rw.trace-fast-image (rw.crewrite assms x iffp blimit rlimit control n))
+                  (rw.fast-crewrite (rw.assms-fast-image assms)
+                                    x iffp blimit rlimit control n)))
+  :hints(("Goal" :in-theory (enable rw.crewrite
+                                    rw.fast-crewrite))))
+
+(defthm rw.ftrace->rhs-of-rw.fast-crewrite
+  (implies (force (and (logic.termp x)
+                       (booleanp iffp)
+                       (rw.assmsp assms)
+                       (rw.controlp control)))
+           (equal (rw.ftrace->rhs (rw.fast-crewrite (rw.assms-fast-image assms) x iffp blimit rlimit control n))
+                  (rw.trace->rhs (rw.crewrite assms x iffp blimit rlimit control n))))
+  :hints(("Goal"
+          :in-theory (disable rw.trace-fast-image-of-rw.crewrite)
+          :use ((:instance rw.trace-fast-image-of-rw.crewrite)))))
+
+(defthm rw.ftrace->fgoals-of-rw.fast-crewrite
+  (implies (force (and (logic.termp x)
+                       (booleanp iffp)
+                       (rw.assmsp assms)
+                       (rw.controlp control)))
+           (equal (rw.ftrace->fgoals (rw.fast-crewrite (rw.assms-fast-image assms) x iffp blimit rlimit control n))
+                  (rw.collect-forced-goals (rw.crewrite assms x iffp blimit rlimit control n))))
+  :hints(("Goal"
+          :in-theory (disable rw.trace-fast-image-of-rw.crewrite)
+          :use ((:instance rw.trace-fast-image-of-rw.crewrite)))))
+
+(verify-guards rw.fast-crewrite-core)
+(verify-guards rw.fast-crewrite)
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/fast-traces.lisp acl2-6.3/books/milawa/ACL2/rewrite/fast-traces.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/fast-traces.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/fast-traces.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1266 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "traces/basic-builders")
+(include-book "traces/urewrite-builders")
+(include-book "traces/crewrite-builders")
+(include-book "assms/fast")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defthm lookup-of-rev-when-uniquep-of-domain
+  (implies (uniquep (domain x))
+           (equal (lookup a (rev x))
+                  (lookup a x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthms-flag
+  :shared-hyp (uniquep (domain sigma))
+  :thms ((term logic.substitute-of-rev-when-unique
+               (implies (subsetp (logic.term-vars x) (domain sigma))
+                        (equal (logic.substitute x (rev sigma))
+                               (logic.substitute x sigma))))
+         (t logic.substitute-list-of-rev-when-unique
+            (implies (subsetp (logic.term-list-vars x) (domain sigma))
+                     (equal (logic.substitute-list x (rev sigma))
+                            (logic.substitute-list x sigma)))))
+  :hints(("Goal"
+          :induct (logic.term-induction flag x)
+          :expand ((logic.substitute x (rev sigma))
+                   (logic.substitute x sigma)))))
+
+
+
+;; FAST TRACES.
+;;
+;; The fast crewriter uses "fast traces" in place of the regular traces that
+;; are constructed by crewrite.
+;;
+;; Whereas a regular trace includes everything we need to prove that the
+;; rewrite was conducted correctly, fast traces contain almost nothing --
+;; just the resulting "right hand side" and any goals that were forced along
+;; the way.
+;;
+;; Compared to regular traces, they are:
+;;
+;;   - Much smaller in terms of memory usage (because there is nothing recursive
+;;     about a fast trace, so previous work can be thrown away immediately),
+;;
+;;   - Faster to construct (because there is much less consing), and
+;;
+;;   - Less useful during bootstrapping (because we have no method of compiling
+;;     a fast trace into a proof, so we can't make use of the fast crewriter
+;;     until we verify it.)
+
+(defaggregate rw.ftrace
+  ;; An FTRACE ("fast trace") records the rhs resulting from taking a crewrite
+  ;; step and a list of all the forced goals we need to prove in order to have
+  ;; gotten this far.
+  (rhs fgoals)
+  :require ((logic.termp-of-rw.ftrace->rhs            (logic.termp rhs))
+            (logic.formula-listp-of-rw.ftrace->fgoals (logic.formula-listp fgoals))
+            (true-listp-of-rw.ftrace->fgoals          (true-listp fgoals)))
+  :legiblep nil)
+
+(defaggregate rw.ftraces
+  ;; Originally, we just used a deflist to introduce fast-trace-listp.  But
+  ;; then we realized that all we ever wanted to do with such a list was look
+  ;; at its list of rhses and its list of fgoals.  This was inefficient, since
+  ;; to inspect these lists we had to cons them up each time.
+  ;;
+  ;; An FTRACES ("fast traces") is a more efficient version of fast-trace-listp.
+  ;; It keeps all of the rhses together in a list so they can be accessed with
+  ;; no consing.  It also merges together the fgoals from all of the traces.
+  (rhses fgoals)
+  :require ((logic.term-listp-of-rw.ftraces->rhses     (logic.term-listp rhses))
+            (true-listp-of-rw.ftraces->rhses           (true-listp rhses))
+            (logic.formula-listp-of-rw.ftraces->fgoals (logic.formula-listp fgoals))
+            (true-listp-of-rw.ftraces->fgoals          (true-listp fgoals)))
+  :legiblep nil)
+
+(defthm equal-of-rw.ftraces-and-rw.ftraces
+  (equal (equal (rw.ftraces rhses fgoals)
+                (rw.ftraces rhses2 fgoals2))
+         (and (equal rhses rhses2)
+              (equal fgoals fgoals2)))
+  :hints(("Goal" :in-theory (enable rw.ftraces))))
+
+
+
+
+(defsection rw.trace-fast-image
+
+  (defund rw.trace-fast-image (x)
+    (declare (xargs :guard (rw.tracep x)))
+    (rw.ftrace (rw.trace->rhs x)
+               (rw.collect-forced-goals x)))
+
+  (local (in-theory (enable rw.trace-fast-image)))
+
+  (defthm rw.trace-fast-image-under-iff
+    (iff (rw.trace-fast-image x)
+         t))
+
+  (defthm rw.ftracep-of-rw.trace-fast-image
+    (implies (force (rw.tracep x))
+             (equal (rw.ftracep (rw.trace-fast-image x))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.trace-fast-image
+    (equal (rw.ftrace->rhs (rw.trace-fast-image trace))
+           (rw.trace->rhs trace)))
+
+  (defthm rw.ftrace->rhs-of-rw.trace-fast-image-free
+    (implies (equal (rw.trace-fast-image trace) ftrace)
+             (equal (rw.ftrace->rhs ftrace)
+                    (rw.trace->rhs trace))))
+
+  (defthm rw.ftrace->fgoals-of-rw.trace-fast-image
+    (equal (rw.ftrace->fgoals (rw.trace-fast-image trace))
+           (rw.collect-forced-goals trace)))
+
+  (defthm rw.ftrace->fgoals-of-rw.trace-fast-image-free
+    (implies (equal (rw.trace-fast-image trace) ftrace)
+             (equal (rw.ftrace->fgoals ftrace)
+                    (rw.collect-forced-goals trace)))))
+
+
+
+(defsection rw.trace-list-fast-image
+
+  (defund rw.trace-list-fast-image (x)
+    (declare (xargs :guard (rw.trace-listp x)))
+    (rw.ftraces (rw.trace-list-rhses x)
+                (rw.collect-forced-goals-list x)))
+
+  (local (in-theory (enable rw.trace-list-fast-image)))
+
+  (defthm rw.ftracesp-of-rw.trace-list-fast-image
+    (implies (force (rw.trace-listp x))
+             (equal (rw.ftracesp (rw.trace-list-fast-image x))
+                    t)))
+
+  (defthm rw.ftraces->rhses-of-rw.trace-list-fast-image
+    (equal (rw.ftraces->rhses (rw.trace-list-fast-image traces))
+           (rw.trace-list-rhses traces)))
+
+  (defthm rw.ftraces->fgoals-of-rw.trace-list-fast-image
+    (equal (rw.ftraces->fgoals (rw.trace-list-fast-image traces))
+           (rw.collect-forced-goals-list traces)))
+
+  (defthm rw.ftraces->rhses-of-rw.trace-list-fast-image-free
+    (implies (equal (rw.trace-list-fast-image traces) ftraces)
+             (equal (rw.ftraces->rhses ftraces)
+                    (rw.trace-list-rhses traces))))
+
+  (defthm rw.ftraces->fgoals-of-rw.trace-list-fast-image-free
+    (implies (equal (rw.trace-list-fast-image traces) ftraces)
+             (equal (rw.ftraces->fgoals ftraces)
+                    (rw.collect-forced-goals-list traces))))
+
+  (defthm rw.trace-list-fast-image-of-cons
+    (equal (rw.trace-list-fast-image (cons a x))
+           (rw.ftraces (cons (rw.trace->rhs a)
+                             (rw.trace-list-rhses x))
+                       (fast-merge (rw.collect-forced-goals a)
+                                   (rw.collect-forced-goals-list x))))))
+
+
+
+
+
+(defsection rw.fast-fail-trace
+
+  (definlined rw.fast-fail-trace (term)
+    (declare (xargs :guard (logic.termp term)))
+    (rw.ftrace term nil))
+
+  (local (in-theory (e/d (rw.fast-fail-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-fail-trace-under-iff
+    (iff (rw.fast-fail-trace x)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-fail-trace
+    (implies (force (logic.termp x))
+             (equal (rw.ftracep (rw.fast-fail-trace x))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-fail-trace
+    (equal (rw.ftrace->rhs (rw.fast-fail-trace x))
+           x))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-fail-trace
+    (equal (rw.ftrace->fgoals (rw.fast-fail-trace x))
+           nil))
+
+  (defthm rw.trace-fast-image-of-rw.fail-trace
+    (equal (rw.trace-fast-image (rw.fail-trace hypbox x iffp))
+           (rw.fast-fail-trace x))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+(defsection rw.fast-transitivity-trace
+
+  (definlined rw.fast-transitivity-trace (x y)
+    (declare (xargs :guard (and (rw.ftracep x)
+                                (rw.ftracep y))))
+    (rw.ftrace (rw.ftrace->rhs y)
+               (fast-merge (rw.ftrace->fgoals x)
+                           (rw.ftrace->fgoals y))))
+
+  (local (in-theory (e/d (rw.fast-transitivity-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-transitivity-trace-under-iff
+    (iff (rw.fast-transitivity-trace x y)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-transitivity-trace
+    (implies (force (and (rw.ftracep x)
+                         (rw.ftracep y)))
+             (equal (rw.ftracep (rw.fast-transitivity-trace x y))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-transitivity-trace
+    (equal (rw.ftrace->rhs (rw.fast-transitivity-trace x y))
+           (rw.ftrace->rhs y)))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-transitivity-trace
+    (equal (rw.ftrace->fgoals (rw.fast-transitivity-trace x y))
+           (fast-merge (rw.ftrace->fgoals x)
+                      (rw.ftrace->fgoals y))))
+
+  (defthm rw.trace-fast-image-of-rw.transitivity-trace
+    (equal (rw.trace-fast-image (rw.transitivity-trace x y))
+           (rw.fast-transitivity-trace (rw.trace-fast-image x)
+                                       (rw.trace-fast-image y)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+(defsection rw.fast-equiv-by-args-trace
+
+  (definlined rw.fast-equiv-by-args-trace (f traces)
+    (declare (xargs :guard (and (logic.function-namep f)
+                                (rw.ftracesp traces))))
+    (rw.ftrace (logic.function f (rw.ftraces->rhses traces))
+               (rw.ftraces->fgoals traces)))
+
+  (local (in-theory (e/d (rw.fast-equiv-by-args-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-equiv-by-args-trace-under-iff
+    (iff (rw.fast-equiv-by-args-trace f traces)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.equiv-by-args-trace
+    (implies (force (and (logic.function-namep f)
+                         (rw.ftracesp traces)))
+             (equal (rw.ftracep (rw.fast-equiv-by-args-trace f traces))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-equiv-by-args-trace
+    (equal (rw.ftrace->rhs (rw.fast-equiv-by-args-trace f traces))
+           (logic.function f (rw.ftraces->rhses traces))))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-equiv-by-args-trace
+    (equal (rw.ftrace->fgoals (rw.fast-equiv-by-args-trace f traces))
+           (rw.ftraces->fgoals traces)))
+
+  (defthm rw.trace-fast-image-of-rw.equiv-by-args-trace
+    (equal (rw.trace-fast-image (rw.equiv-by-args-trace hypbox f iffp traces))
+           (rw.fast-equiv-by-args-trace f (rw.trace-list-fast-image traces)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image rw.trace-list-fast-image)))))
+
+
+
+
+(defsection rw.fast-lambda-equiv-by-args-trace
+
+  (definlined rw.fast-lambda-equiv-by-args-trace (formals body traces)
+    (declare (xargs :guard (and (true-listp formals)
+                                (logic.variable-listp formals)
+                                (uniquep formals)
+                                (logic.termp body)
+                                (subsetp (logic.term-vars body) formals)
+                                (rw.ftracesp traces)
+                                (equal (len (rw.ftraces->rhses traces)) (len formals)))))
+    (rw.ftrace (logic.lambda formals body (rw.ftraces->rhses traces))
+               (rw.ftraces->fgoals traces)))
+
+  (local (in-theory (e/d (rw.fast-lambda-equiv-by-args-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-lambda-equiv-by-args-trace-under-iff
+    (iff (rw.fast-lambda-equiv-by-args-trace formals body traces)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-lambda-equiv-by-args-trace
+    (implies (force (and (true-listp formals)
+                         (logic.variable-listp formals)
+                         (uniquep formals)
+                         (logic.termp body)
+                         (subsetp (logic.term-vars body) formals)
+                         (rw.ftracesp traces)
+                         (equal (len (rw.ftraces->rhses traces))
+                                (len formals))))
+             (equal (rw.ftracep (rw.fast-lambda-equiv-by-args-trace formals body traces))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-lambda-equiv-by-args-trace
+    (equal (rw.ftrace->rhs (rw.fast-lambda-equiv-by-args-trace formals body traces))
+           (logic.lambda formals body (rw.ftraces->rhses traces))))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-lambda-equiv-by-args-trace
+    (equal (rw.ftrace->fgoals (rw.fast-lambda-equiv-by-args-trace formals body traces))
+           (rw.ftraces->fgoals traces)))
+
+  (defthm rw.trace-fast-image-of-rw.lambda-equiv-by-args-trace
+    (equal (rw.trace-fast-image (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+           (rw.fast-lambda-equiv-by-args-trace formals body (rw.trace-list-fast-image traces)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image rw.trace-list-fast-image)))))
+
+
+
+
+(defsection rw.fast-beta-reduction-trace
+
+  (definlined rw.fast-beta-reduction-trace (term)
+    (declare (xargs :guard (and (logic.termp term)
+                                (logic.lambdap term))))
+    (rw.ftrace (logic.substitute (logic.lambda-body term)
+                                 (fast-pair-lists$ (logic.lambda-formals term)
+                                                   (logic.lambda-actuals term)
+                                                   nil))
+               nil))
+
+  (local (in-theory (e/d (rw.fast-beta-reduction-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-beta-reduction-trace-under-iff
+    (iff (rw.fast-beta-reduction-trace term)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-beta-reduction-trace
+    (implies (force (and (logic.termp term)
+                         (logic.lambdap term)))
+             (equal (rw.ftracep (rw.fast-beta-reduction-trace term))
+                    t)))
+
+  (defthm forcing-rw.ftrace->rhs-of-rw.fast-beta-reduction-trace
+    (implies (force (and (logic.termp term)
+                         (logic.lambdap term)))
+             (equal (rw.ftrace->rhs (rw.fast-beta-reduction-trace term))
+                    (logic.substitute (logic.lambda-body term)
+                                      (pair-lists (logic.lambda-formals term)
+                                                  (logic.lambda-actuals term))))))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-beta-reduction-trace
+    (equal (rw.ftrace->fgoals (rw.fast-beta-reduction-trace term))
+           nil))
+
+  (defthm rw.trace-fast-image-of-rw.beta-reduction-trace
+    (implies (force (and (logic.termp term)
+                         (logic.lambdap term)))
+             (equal (rw.trace-fast-image (rw.beta-reduction-trace hypbox term iffp))
+                    (rw.fast-beta-reduction-trace term)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+
+(defsection rw.fast-try-ground-simplify
+
+  (definlined rw.fast-try-ground-simplify (x iffp control)
+    (declare (xargs :guard (and (logic.termp x)
+                                (logic.groundp x)
+                                (booleanp iffp)
+                                (rw.controlp control))))
+    (if (and (logic.functionp x)
+             (memberp (logic.function-name x) (rw.control->noexec control)))
+        nil
+      (let* ((defs   (rw.control->defs control))
+             (depth  (rw.control->depth control))
+             (result (generic-evaluator x defs depth)))
+        (and result
+             (let ((real-result (if (and iffp (not (equal (logic.unquote result) nil)))
+                                    ''t
+                                  result)))
+               (and (not (equal real-result x))
+                    (rw.ftrace real-result nil)))))))
+
+  (local (in-theory (enable rw.fast-try-ground-simplify)))
+
+  (defthm rw.ftracep-of-rw.fast-try-ground-simplify
+    (implies (force (and (logic.termp x)
+                         (logic.groundp x)
+                         (rw.controlp control)))
+             (equal (rw.ftracep (rw.fast-try-ground-simplify x iffp control))
+                    (if (rw.fast-try-ground-simplify x iffp control)
+                        t
+                      nil))))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-try-ground-simplify
+    (equal (rw.ftrace->fgoals (rw.fast-try-ground-simplify x iffp control))
+           nil))
+
+  (defthm rw.trace-fast-image-of-rw.try-ground-simplify
+    (implies (force (rw.try-ground-simplify hypbox x iffp control))
+             (equal (rw.trace-fast-image (rw.try-ground-simplify hypbox x iffp control))
+                    (rw.fast-try-ground-simplify x iffp control)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image
+                                      rw.try-ground-simplify
+                                      definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defsection rw.fast-if-specialcase-nil-trace
+
+  (definlined rw.fast-if-specialcase-nil-trace (x y)
+    (declare (xargs :guard (and (rw.ftracep x)
+                                (rw.ftracep y))))
+    (rw.ftrace (rw.ftrace->rhs y)
+               (fast-merge (rw.ftrace->fgoals x)
+                           (rw.ftrace->fgoals y))))
+
+  (local (in-theory (e/d (rw.fast-if-specialcase-nil-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-if-specialcase-nil-trace-under-iff
+    (iff (rw.fast-if-specialcase-nil-trace x y)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-if-specialcase-nil-trace
+    (implies (force (and (rw.ftracep x)
+                         (rw.ftracep y)))
+             (equal (rw.ftracep (rw.fast-if-specialcase-nil-trace x y))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-if-specialcase-nil-trace
+    (equal (rw.ftrace->rhs (rw.fast-if-specialcase-nil-trace x y))
+           (rw.ftrace->rhs y)))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-if-specialcase-nil-trace
+    (equal (rw.ftrace->fgoals (rw.fast-if-specialcase-nil-trace x y))
+           (fast-merge (rw.ftrace->fgoals x)
+                       (rw.ftrace->fgoals y))))
+
+  (defthm rw.trace-fast-image-of-rw.if-specialcase-nil-trace
+    (equal (rw.trace-fast-image (rw.if-specialcase-nil-trace x y b1))
+           (rw.fast-if-specialcase-nil-trace (rw.trace-fast-image x)
+                                             (rw.trace-fast-image y)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+(defsection rw.fast-if-specialcase-t-trace
+
+  (definlined rw.fast-if-specialcase-t-trace (x y)
+    (declare (xargs :guard (and (rw.ftracep x)
+                                (rw.ftracep y))))
+    (rw.ftrace (rw.ftrace->rhs y)
+               (fast-merge (rw.ftrace->fgoals x)
+                           (rw.ftrace->fgoals y))))
+
+  (local (in-theory (e/d (rw.fast-if-specialcase-t-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-if-specialcase-t-trace-under-iff
+    (iff (rw.fast-if-specialcase-t-trace x y)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-if-specialcase-t-trace
+    (implies (force (and (rw.ftracep x)
+                         (rw.ftracep y)))
+             (equal (rw.ftracep (rw.fast-if-specialcase-t-trace x y))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-if-specialcase-t-trace
+    (equal (rw.ftrace->rhs (rw.fast-if-specialcase-t-trace x y))
+           (rw.ftrace->rhs y)))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-if-specialcase-t-trace
+    (equal (rw.ftrace->fgoals (rw.fast-if-specialcase-t-trace x y))
+           (fast-merge (rw.ftrace->fgoals x)
+                       (rw.ftrace->fgoals y))))
+
+  (defthm rw.trace-fast-image-of-rw.if-specialcase-t-trace
+    (equal (rw.trace-fast-image (rw.if-specialcase-t-trace x y c1))
+           (rw.fast-if-specialcase-t-trace (rw.trace-fast-image x)
+                                           (rw.trace-fast-image y)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+
+(defsection rw.fast-not-trace
+
+  (definlined rw.fast-not-trace (x)
+    (declare (xargs :guard (rw.ftracep x)))
+    (rw.ftrace (let ((rhs (rw.ftrace->rhs x)))
+                 (cond ((equal rhs ''nil) ''t)
+                       ((equal rhs ''t)   ''nil)
+                       (t                 (logic.function 'not (list rhs)))))
+               (rw.ftrace->fgoals x)))
+
+  (local (in-theory (e/d (rw.fast-not-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-not-trace-under-iff
+    (iff (rw.fast-not-trace x)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-not-trace
+    (implies (force (rw.ftracep x))
+             (equal (rw.ftracep (rw.fast-not-trace x))
+                    t)))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-not-trace
+    (equal (rw.ftrace->fgoals (rw.fast-not-trace x))
+           (rw.ftrace->fgoals x)))
+
+  (defthm rw.trace-fast-image-of-rw.not-trace
+    (equal (rw.trace-fast-image (rw.not-trace x iffp))
+           (rw.fast-not-trace (rw.trace-fast-image x)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image
+                                      rw.not-trace
+                                      definition-of-rw.collect-forced-goals
+                                      rw.fast-fail-trace)))))
+
+
+
+
+
+(defsection rw.fast-negative-if-trace
+
+  (definlined rw.fast-negative-if-trace (x)
+    (declare (xargs :guard (logic.termp x)))
+    (rw.ftrace (logic.function 'not (list x))
+               nil))
+
+  (local (in-theory (e/d (rw.fast-negative-if-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-negative-if-trace-under-iff
+    (iff (rw.fast-negative-if-trace x)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-negative-if-trace
+    (implies (force (logic.termp x))
+             (equal (rw.ftracep (rw.fast-negative-if-trace x))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-negative-if-trace
+    (equal (rw.ftrace->rhs (rw.fast-negative-if-trace x))
+           (logic.function 'not (list x))))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-negative-if-trace
+    (equal (rw.ftrace->fgoals (rw.fast-negative-if-trace x))
+           nil))
+
+  (defthm rw.trace-fast-image-of-rw.negative-if-trace
+    (equal (rw.trace-fast-image (rw.negative-if-trace x iffp hypbox))
+           (rw.fast-negative-if-trace x))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+(defsection rw.fast-crewrite-if-specialcase-same-trace
+
+  (definlined rw.fast-crewrite-if-specialcase-same-trace (x y z)
+    (declare (xargs :guard (and (rw.ftracep x)
+                                (rw.ftracep y)
+                                (rw.ftracep z))))
+    (rw.ftrace (rw.ftrace->rhs y)
+               (fast-merge (rw.ftrace->fgoals x)
+                           (fast-merge (rw.ftrace->fgoals y)
+                                       (rw.ftrace->fgoals z)))))
+
+  (local (in-theory (e/d (rw.fast-crewrite-if-specialcase-same-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-crewrite-if-specialcase-same-trace-under-iff
+    (iff (rw.fast-crewrite-if-specialcase-same-trace x y z)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-crewrite-if-specialcase-same-trace
+    (implies (force (and (rw.ftracep x)
+                         (rw.ftracep y)
+                         (rw.ftracep z)))
+             (equal (rw.ftracep (rw.fast-crewrite-if-specialcase-same-trace x y z))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-crewrite-if-specialcase-same-trace
+    (equal (rw.ftrace->rhs (rw.fast-crewrite-if-specialcase-same-trace x y z))
+           (rw.ftrace->rhs y)))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-crewrite-if-specialcase-same-trace
+    (equal (rw.ftrace->fgoals (rw.fast-crewrite-if-specialcase-same-trace x y z))
+           (fast-merge (rw.ftrace->fgoals x)
+                       (fast-merge (rw.ftrace->fgoals y)
+                                   (rw.ftrace->fgoals z)))))
+
+  (defthm rw.trace-fast-image-of-rw.crewrite-if-specialcase-same-trace
+    (equal (rw.trace-fast-image (rw.crewrite-if-specialcase-same-trace x y z))
+           (rw.fast-crewrite-if-specialcase-same-trace (rw.trace-fast-image x)
+                                                       (rw.trace-fast-image y)
+                                                       (rw.trace-fast-image z)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+
+(defsection rw.fast-crewrite-if-generalcase-trace
+
+  (definlined rw.fast-crewrite-if-generalcase-trace (x y z)
+    (declare (xargs :guard (and (rw.ftracep x)
+                                (rw.ftracep y)
+                                (rw.ftracep z))))
+    (rw.ftrace (logic.function 'if (list (rw.ftrace->rhs x)
+                                         (rw.ftrace->rhs y)
+                                         (rw.ftrace->rhs z)))
+               (fast-merge (rw.ftrace->fgoals x)
+                           (fast-merge (rw.ftrace->fgoals y)
+                                       (rw.ftrace->fgoals z)))))
+
+  (local (in-theory (e/d (rw.fast-crewrite-if-generalcase-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-crewrite-if-generalcase-trace-under-iff
+    (iff (rw.fast-crewrite-if-generalcase-trace x y z)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-crewrite-if-generalcase-trace
+    (implies (force (and (rw.ftracep x)
+                         (rw.ftracep y)
+                         (rw.ftracep z)))
+             (equal (rw.ftracep (rw.fast-crewrite-if-generalcase-trace x y z))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-crewrite-if-generalcase-trace
+    (equal (rw.ftrace->rhs (rw.fast-crewrite-if-generalcase-trace x y z))
+           (logic.function 'if (list (rw.ftrace->rhs x)
+                                     (rw.ftrace->rhs y)
+                                     (rw.ftrace->rhs z)))))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-crewrite-if-generalcase-trace
+    (equal (rw.ftrace->fgoals (rw.fast-crewrite-if-generalcase-trace x y z))
+           (fast-merge (rw.ftrace->fgoals x)
+                       (fast-merge (rw.ftrace->fgoals y)
+                                   (rw.ftrace->fgoals z)))))
+
+  (defthm rw.trace-fast-image-of-rw.crewrite-if-generalcase-trace
+    (equal (rw.trace-fast-image (rw.crewrite-if-generalcase-trace x y z))
+           (rw.fast-crewrite-if-generalcase-trace (rw.trace-fast-image x)
+                                                       (rw.trace-fast-image y)
+                                                       (rw.trace-fast-image z)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+(defsection rw.fast-assumptions-trace
+
+  (definlined rw.fast-assumptions-trace (assms lhs iffp)
+    (declare (xargs :guard (and (rw.fast-assmsp assms)
+                                (logic.termp lhs)
+                                (booleanp iffp))))
+    (let ((result (rw.fast-try-equiv-database lhs (rw.fast-assms->eqdatabase assms) iffp)))
+      (and result
+           (rw.ftrace result nil))))
+
+  (local (in-theory (e/d (rw.fast-assumptions-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-assumptions-trace
+    (implies (force (rw.fast-assmsp assms))
+             (equal (rw.ftracep (rw.fast-assumptions-trace assms lhs iffp))
+                    (if (rw.fast-assumptions-trace assms lhs iffp)
+                        t
+                      nil))))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-assumptions-trace
+    (equal (rw.ftrace->fgoals (rw.fast-assumptions-trace assms lhs iffp))
+           nil))
+
+  (defthm rw.trace-fast-image-of-rw.assumptions-trace
+    (implies (force (and (rw.assumptions-trace assms lhs iffp)
+                         (rw.assmsp assms)))
+             (equal (rw.trace-fast-image (rw.assumptions-trace assms lhs iffp))
+                    (rw.fast-assumptions-trace (rw.assms-fast-image assms) lhs iffp)))
+    :hints(("Goal"
+            ;; Stupid hack to see that it's non-nil.
+            :use ((:instance forcing-logic.termp-of-rw.eqtrace->lhs
+                             (x (RW.TRY-EQUIV-DATABASE LHS (RW.ASSMS->EQDATABASE ASSMS) IFFP))))
+            ;; Gah, ugly.  Oh well.
+            :in-theory (e/d (rw.trace-fast-image
+                             rw.assms-fast-image
+                             rw.assumptions-trace
+                             definition-of-rw.collect-forced-goals)
+                            (forcing-logic.termp-of-rw.eqtrace->lhs)))))
+
+  ;; We want the theorem below instead for the connection proof.  I'm not sure why.
+
+  (defthmd lemma-for-rw.fast-assumptions-trace-of-rw.assms-fast-image
+    (implies (rw.eqtracep x)
+             (iff (rw.eqtrace->lhs x)
+                  t))
+    :hints(("Goal" :in-theory (enable definition-of-rw.eqtracep rw.eqtrace->lhs))))
+
+  (defthm rw.fast-assumptions-trace-of-rw.assms-fast-image
+    (implies (and (rw.assmsp assms)
+                  (logic.termp x)
+                  (booleanp iffp))
+             (equal (rw.fast-assumptions-trace (rw.assms-fast-image assms) x iffp)
+                    (if (rw.assumptions-trace assms x iffp)
+                        (rw.trace-fast-image (rw.assumptions-trace assms x iffp))
+                      nil)))
+    :hints(("Goal" :in-theory (enable rw.assumptions-trace
+                                      rw.fast-assumptions-trace
+                                      rw.assms-fast-image
+                                      rw.trace-fast-image
+                                      definition-of-rw.collect-forced-goals
+                                      lemma-for-rw.fast-assumptions-trace-of-rw.assms-fast-image
+                                      ))))
+
+  ;; This loops with the above, now.
+  (in-theory (disable rw.trace-fast-image-of-rw.assumptions-trace)))
+
+
+
+
+(defsection rw.fast-crewrite-rule-trace
+
+  (definlined rw.fast-crewrite-rule-trace (rule sigma traces)
+    (declare (xargs :guard (and (rw.rulep rule)
+                                (logic.sigmap sigma)
+                                (rw.ftracesp traces))))
+    (rw.ftrace (logic.substitute (rw.rule->rhs rule) sigma)
+               (rw.ftraces->fgoals traces)))
+
+  (local (in-theory (e/d (rw.fast-crewrite-rule-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-crewrite-rule-trace-under-iff
+    (iff (rw.fast-crewrite-rule-trace rule sigma traces)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-crewrite-rule-trace
+    (implies (force (and (rw.rulep rule)
+                         (logic.sigmap sigma)
+                         (rw.ftracesp traces)))
+             (equal (rw.ftracep (rw.fast-crewrite-rule-trace rule sigma traces))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-crewrite-rule-trace
+    (equal (rw.ftrace->rhs (rw.fast-crewrite-rule-trace rule sigma traces))
+           (logic.substitute (rw.rule->rhs rule) sigma)))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-crewrite-rule-trace
+    (equal (rw.ftrace->fgoals (rw.fast-crewrite-rule-trace rule sigma traces))
+           (rw.ftraces->fgoals traces)))
+
+  (defthm rw.trace-fast-image-of-rw.crewrite-rule-trace
+    (equal (rw.trace-fast-image (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+           (rw.fast-crewrite-rule-trace rule sigma
+                                        (rw.trace-list-fast-image traces)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image
+                                      rw.trace-list-fast-image)))))
+
+
+
+
+(defsection rw.fast-force-trace
+
+  (definlined rw.fast-force-trace (hypbox lhs)
+    (declare (xargs :guard (and (rw.hypboxp hypbox)
+                                (logic.termp lhs))))
+    (rw.ftrace ''t
+               (list (let ((main (logic.pequal (logic.function 'iff (list lhs ''t)) ''t)))
+                       (if (or (rw.hypbox->left hypbox)
+                               (rw.hypbox->right hypbox))
+                           (logic.por (rw.hypbox-formula hypbox) main)
+                         main)))))
+
+  (local (in-theory (e/d (rw.fast-force-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-force-trace-under-iff
+    (iff (rw.fast-force-trace hypbox lhs)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-force-trace
+    (implies (force (and (rw.hypboxp hypbox)
+                         (logic.termp lhs)))
+             (equal (rw.ftracep (rw.fast-force-trace hypbox lhs))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-force-trace
+    (equal (rw.ftrace->rhs (rw.fast-force-trace hypbox lhs))
+           ''t))
+
+  (defthm rw.trace-fast-image-of-rw.force-trace
+    (equal (rw.trace-fast-image (rw.force-trace hypbox lhs))
+           (rw.fast-force-trace hypbox lhs))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image
+                                      rw.trace-formula
+                                      rw.trace-conclusion-formula)))))
+
+
+
+(defsection rw.fast-weakening-trace
+
+  (definlined rw.fast-weakening-trace (trace)
+    (declare (xargs :guard (rw.ftracep trace)))
+    trace)
+
+  (local (in-theory (e/d (rw.fast-weakening-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-weakening-trace-under-iff
+    (iff (rw.fast-weakening-trace x)
+         x))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-weakening-trace
+    (implies (force (rw.ftracep x))
+             (equal (rw.ftracep (rw.fast-weakening-trace x))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-weakening-trace
+      (equal (rw.ftrace->rhs (rw.fast-weakening-trace x))
+             (rw.ftrace->rhs x)))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-weakening-trace
+      (equal (rw.ftrace->fgoals (rw.fast-weakening-trace x))
+             (rw.ftrace->fgoals x)))
+
+  (defthm rw.trace-fast-image-of-rw.weakening-trace
+    (equal (rw.trace-fast-image (rw.weakening-trace hypbox x))
+           (rw.trace-fast-image x))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+(defsection rw.fast-urewrite-if-specialcase-same-trace
+
+  (definlined rw.fast-urewrite-if-specialcase-same-trace (x y)
+    (declare (xargs :guard (and (rw.ftracep x)
+                                (rw.ftracep y))))
+    (rw.ftrace (rw.ftrace->rhs x)
+               (fast-merge (rw.ftrace->fgoals x)
+                           (rw.ftrace->fgoals y))))
+
+  (local (in-theory (e/d (rw.fast-urewrite-if-specialcase-same-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-urewrite-if-specialcase-same-trace-under-iff
+    (iff (rw.fast-urewrite-if-specialcase-same-trace x y)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-urewrite-if-specialcase-same-trace
+    (implies (force (and (rw.ftracep x)
+                         (rw.ftracep y)))
+             (equal (rw.ftracep (rw.fast-urewrite-if-specialcase-same-trace x y))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-urewrite-if-specialcase-same-trace
+    (equal (rw.ftrace->rhs (rw.fast-urewrite-if-specialcase-same-trace x y))
+           (rw.ftrace->rhs x)))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-urewrite-if-specialcase-same-trace
+    (equal (rw.ftrace->fgoals (rw.fast-urewrite-if-specialcase-same-trace x y))
+           (fast-merge (rw.ftrace->fgoals x)
+                       (rw.ftrace->fgoals y))))
+
+  (defthm rw.trace-fast-image-of-rw.urewrite-if-specialcase-same-trace
+    (equal (rw.trace-fast-image (rw.urewrite-if-specialcase-same-trace x y a))
+           (rw.fast-urewrite-if-specialcase-same-trace (rw.trace-fast-image x)
+                                                       (rw.trace-fast-image y)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+
+
+(defsection rw.fast-urewrite-if-generalcase-trace
+
+  (definlined rw.fast-urewrite-if-generalcase-trace (x y z)
+    (declare (xargs :guard (and (rw.ftracep x)
+                                (rw.ftracep y)
+                                (rw.ftracep z))))
+    (rw.ftrace (logic.function 'if (list (rw.ftrace->rhs x)
+                                         (rw.ftrace->rhs y)
+                                         (rw.ftrace->rhs z)))
+               (fast-merge (rw.ftrace->fgoals x)
+                           (fast-merge (rw.ftrace->fgoals y)
+                                       (rw.ftrace->fgoals z)))))
+
+  (local (in-theory (e/d (rw.fast-urewrite-if-generalcase-trace)
+                         ((:executable-counterpart ACL2::force)))))
+
+  (defthm rw.fast-urewrite-if-generalcase-trace-under-iff
+    (iff (rw.fast-urewrite-if-generalcase-trace x y z)
+         t))
+
+  (defthm forcing-rw.ftracep-of-rw.fast-urewrite-if-generalcase-trace
+    (implies (force (and (rw.ftracep x)
+                         (rw.ftracep y)
+                         (rw.ftracep z)))
+             (equal (rw.ftracep (rw.fast-urewrite-if-generalcase-trace x y z))
+                    t)))
+
+  (defthm rw.ftrace->rhs-of-rw.fast-urewrite-if-generalcase-trace
+    (equal (rw.ftrace->rhs (rw.fast-urewrite-if-generalcase-trace x y z))
+           (logic.function 'if (list (rw.ftrace->rhs x)
+                                     (rw.ftrace->rhs y)
+                                     (rw.ftrace->rhs z)))))
+
+  (defthm rw.ftrace->fgoals-of-rw.fast-urewrite-if-generalcase-trace
+    (equal (rw.ftrace->fgoals (rw.fast-urewrite-if-generalcase-trace x y z))
+           (fast-merge (rw.ftrace->fgoals x)
+                       (fast-merge (rw.ftrace->fgoals y)
+                                   (rw.ftrace->fgoals z)))))
+
+  (defthm rw.trace-fast-image-of-rw.urewrite-if-generalcase-trace
+    (equal (rw.trace-fast-image (rw.urewrite-if-generalcase-trace x y z))
+           (rw.fast-urewrite-if-generalcase-trace (rw.trace-fast-image x)
+                                                  (rw.trace-fast-image y)
+                                                  (rw.trace-fast-image z)))
+    :hints(("Goal" :in-theory (enable rw.trace-fast-image)))))
+
+
+
+
+(definlined rw.fast-try-urewrite-rule (term rule iffp control)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.rulep rule)
+                              (booleanp iffp)
+                              (rw.controlp control))))
+  (and (not (rw.rule->hyps rule))
+       (let ((equiv (rw.rule->equiv rule)))
+         (or (equal equiv 'equal)
+             (and (equal equiv 'iff) iffp)))
+       (let ((match-result (logic.patmatch (rw.rule->lhs rule) term nil)))
+         (and (not (equal 'fail match-result))
+              (rw.rule-syntax-okp rule match-result control)
+              (rw.ftrace (logic.substitute (rw.rule->rhs rule) match-result)
+                         nil)))))
+
+(defthm forcing-rw.ftracep-of-rw.fast-try-urewrite-rule
+  (implies (force (and (logic.termp term)
+                       (rw.rulep rule)))
+           (equal (rw.ftracep (rw.fast-try-urewrite-rule term rule iffp control))
+                  (if (rw.fast-try-urewrite-rule term rule iffp control)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-try-urewrite-rule))))
+
+(defthm rw.ftrace->fgoals-of-rw.fast-try-urewrite-rule
+  (equal (rw.ftrace->fgoals (rw.fast-try-urewrite-rule term rule iffp control))
+         nil)
+  :hints(("Goal" :in-theory (enable rw.fast-try-urewrite-rule))))
+
+(defthm rw.trace-fast-image-of-rw.try-urewrite-rule
+  (implies (rw.try-urewrite-rule hypbox term rule iffp control)
+           (equal (rw.trace-fast-image (rw.try-urewrite-rule hypbox term rule iffp control))
+                  (rw.fast-try-urewrite-rule term rule iffp control)))
+  :hints(("Goal" :in-theory (enable rw.trace-fast-image
+                                    rw.fast-try-urewrite-rule
+                                    rw.try-urewrite-rule
+                                    definition-of-rw.collect-forced-goals))))
+
+
+
+(defund rw.fast-try-urewrite-rule-list (term rules iffp control)
+  (declare (xargs :guard (and (logic.termp term)
+                              (rw.rule-listp rules)
+                              (booleanp iffp)
+                              (rw.controlp control))))
+  (if (consp rules)
+      (or (rw.fast-try-urewrite-rule term (car rules) iffp control)
+          (rw.fast-try-urewrite-rule-list term (cdr rules) iffp control))
+    nil))
+
+(defthm forcing-rw.ftracep-of-rw.fast-try-urewrite-rule-list
+  (implies (force (and (logic.termp term)
+                       (rw.rule-listp rules)))
+           (equal (rw.ftracep (rw.fast-try-urewrite-rule-list term rules iffp control))
+                  (if (rw.fast-try-urewrite-rule-list term rules iffp control)
+                      t
+                    nil)))
+  :hints(("Goal"
+          :expand (rw.fast-try-urewrite-rule-list term rules iffp control)
+          :induct (cdr-induction rules))))
+
+(defthm rw.ftrace->fgoals-of-rw.fast-try-urewrite-rule-list
+  (equal (rw.ftrace->fgoals (rw.fast-try-urewrite-rule-list term rule iffp control))
+         nil)
+  :hints(("Goal" :in-theory (enable rw.fast-try-urewrite-rule-list))))
+
+(defthm rw.trace-fast-image-of-rw.try-urewrite-rule-list
+  (implies (rw.try-urewrite-rule-list hypbox term rules iffp control)
+           (equal (rw.trace-fast-image (rw.try-urewrite-rule-list hypbox term rules iffp control))
+                  (rw.fast-try-urewrite-rule-list term rules iffp control)))
+  :hints(("Goal"
+          :in-theory (enable rw.fast-try-urewrite-rule-list
+                             rw.try-urewrite-rule-list
+                             rw.try-urewrite-rule
+                             rw.fast-try-urewrite-rule
+                             rw.trace-fast-image))))
+
+
+
+
+
+
+(defund rw.fast-try-urewrite-rules (term type iffp control)
+  (declare (xargs :guard (and (logic.termp term)
+                              (or (equal type 'inside)
+                                  (equal type 'outside))
+                              (booleanp iffp)
+                              (rw.controlp control))))
+  (let* ((rulemap (rw.theory-lookup term (rw.control->theory control)))
+         (rules (cdr (lookup type rulemap))))
+    (rw.fast-try-urewrite-rule-list term rules iffp control)))
+
+(defthm forcing-rw.ftracep-of-rw.fast-try-urewrite-rules
+  (implies (force (and (logic.termp term)
+                       (rw.controlp control)))
+           (equal (rw.ftracep (rw.fast-try-urewrite-rules term type iffp control))
+                  (if (rw.fast-try-urewrite-rules term type iffp control)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable rw.fast-try-urewrite-rules))))
+
+(defthm rw.ftrace->fgoals-of-rw.fast-try-urewrite-rules
+  (equal (rw.ftrace->fgoals (rw.fast-try-urewrite-rules term type iffp control))
+         nil)
+  :hints(("Goal" :in-theory (enable rw.fast-try-urewrite-rules))))
+
+(defthm rw.trace-fast-image-of-rw.try-urewrite-rules
+  (implies (force (rw.try-urewrite-rules hypbox term type iffp control))
+           (equal (rw.trace-fast-image (rw.try-urewrite-rules hypbox term type iffp control))
+                  (rw.fast-try-urewrite-rules term type iffp control)))
+  :hints(("Goal" :in-theory (enable rw.try-urewrite-rules
+                                    rw.fast-try-urewrite-rules))))
+
+
+
+
+
+(defund rw.maybe-extend-fast-trace (original extension)
+  (declare (xargs :guard (and (rw.ftracep original)
+                              (or (not extension)
+                                  (rw.ftracep extension)))))
+  (if extension
+      (rw.fast-transitivity-trace original extension)
+    original))
+
+(defthm rw.ftracep-of-rw.maybe-extend-fast-trace
+  (implies (and (rw.ftracep original)
+                (or (not extension)
+                    (rw.ftracep extension)))
+           (equal (rw.ftracep (rw.maybe-extend-fast-trace original extension))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.maybe-extend-fast-trace))))
+
+(defthm rw.trace-fast-image-of-rw.maybe-extend-trace
+  (equal (rw.trace-fast-image (rw.maybe-extend-trace original extension))
+         (rw.maybe-extend-fast-trace (rw.trace-fast-image original)
+                                     (and extension
+                                          (rw.trace-fast-image extension))))
+  :hints(("Goal" :in-theory (enable rw.maybe-extend-fast-trace
+                                    rw.maybe-extend-trace))))
+
+
+
+
+
+(defconst *rw.fast-traces-sigma*
+  ;; Substitutions used to switch from regular traces to fast traces.
+  (list (cons '(rw.trace->rhs ?x)
+              '(rw.ftrace->rhs ?x))
+        (cons '(rw.fail-trace ?hypbox ?x ?iffp)
+              '(rw.fast-fail-trace ?x))
+        (cons '(rw.transitivity-trace ?x ?y)
+              '(rw.fast-transitivity-trace ?x ?y))
+        (cons '(rw.equiv-by-args-trace ?hypbox ?f ?iffp ?traces)
+              '(rw.fast-equiv-by-args-trace ?f ?traces))
+        (cons '(rw.lambda-equiv-by-args-trace ?hypbox ?formals ?body ?iffp ?traces)
+              '(rw.fast-lambda-equiv-by-args-trace ?formals ?body ?traces))
+        (cons '(rw.beta-reduction-trace ?hypbox ?x ?iffp)
+              '(rw.fast-beta-reduction-trace ?x))
+        (cons '(rw.try-ground-simplify ?hypbox ?x ?iffp ?control)
+              '(rw.fast-try-ground-simplify ?x ?iffp ?control))
+        (cons '(rw.if-specialcase-nil-trace ?x ?y ?b1)
+              '(rw.fast-if-specialcase-nil-trace ?x ?y))
+        (cons '(rw.if-specialcase-t-trace ?x ?y ?c1)
+              '(rw.fast-if-specialcase-t-trace ?x ?y))
+        (cons '(rw.not-trace ?x ?iffp)
+              '(rw.fast-not-trace ?x))
+        (cons '(rw.negative-if-trace ?x ?iffp ?hypbox)
+              '(rw.fast-negative-if-trace ?x))
+        (cons '(rw.crewrite-if-specialcase-same-trace ?x ?y ?z)
+              '(rw.fast-crewrite-if-specialcase-same-trace ?x ?y ?z))
+        (cons '(rw.crewrite-if-generalcase-trace ?x ?y ?z)
+              '(rw.fast-crewrite-if-generalcase-trace ?x ?y ?z))
+        (cons '(rw.assumptions-trace ?assms ?lhs ?iffp)
+              '(rw.fast-assumptions-trace ?assms ?lhs ?iffp))
+        (cons '(rw.crewrite-rule-trace ?hypbox ?lhs ?rule ?sigma ?iffp ?traces)
+              '(rw.fast-crewrite-rule-trace ?rule ?sigma ?traces))
+        (cons '(rw.force-trace ?hypbox ?lhs)
+              '(rw.fast-force-trace ?hypbox ?lhs))
+        (cons '(rw.weakening-trace ?hypbox ?trace)
+              '(rw.fast-weakening-trace ?trace))
+        (cons '(rw.urewrite-if-specialcase-same-trace ?x ?y ?a)
+              '(rw.fast-urewrite-if-specialcase-same-trace ?x ?y))
+        (cons '(rw.urewrite-if-generalcase-trace ?x ?y ?z)
+              '(rw.fast-urewrite-if-generalcase-trace ?x ?y ?z))
+        (cons '(rw.try-urewrite-rule ?hypbox ?term ?rule ?iffp ?control)
+              '(rw.fast-try-urewrite-rule ?x ?rule ?iffp ?control))
+        (cons '(rw.try-urewrite-rule-list ?hypbox ?x ?rules ?iffp ?control)
+              '(rw.fast-try-urewrite-rule-list ?x ?rules ?iffp ?control))
+        (cons '(rw.try-urewrite-rules ?hypbox ?term ?type ?iffp ?control)
+              '(rw.fast-try-urewrite-rules ?term ?type ?iffp ?control))
+        (cons '(rw.maybe-extend-trace ?original ?extension)
+              '(rw.maybe-extend-fast-trace ?original ?extension))))
+
+
+
+(defsection rw.trace-fast-image-equivalence-lemmas
+
+  (defthmd equiv-lemma-rw.try-ground-simplify-under-iff
+    (iff (rw.try-ground-simplify hypbox x iffp control)
+         (rw.fast-try-ground-simplify x iffp control))
+    :hints(("Goal" :in-theory (enable rw.try-ground-simplify
+                                      rw.fast-try-ground-simplify))))
+
+  (defthmd equiv-lemma-rw.trace->rhs-of-rw.try-ground-simplify
+    (equal (rw.trace->rhs (rw.try-ground-simplify hypbox x iffp control))
+           (rw.ftrace->rhs (rw.fast-try-ground-simplify x iffp control)))
+    :hints(("Goal" :in-theory (enable rw.try-ground-simplify
+                                      rw.fast-try-ground-simplify))))
+
+
+  (defthmd equiv-lemma-rw.try-urewrite-rule-list-under-iff
+    (iff (rw.try-urewrite-rule-list hypbox term rules iffp control)
+         (rw.fast-try-urewrite-rule-list term rules iffp control))
+    :hints(("Goal" :in-theory (enable rw.try-urewrite-rule-list
+                                      rw.fast-try-urewrite-rule-list
+                                      rw.try-urewrite-rule
+                                      rw.fast-try-urewrite-rule))))
+
+  (defthmd equiv-lemma-rw.try-urewrite-rules-under-iff
+    (iff (rw.try-urewrite-rules hypbox term type iffp control)
+         (rw.fast-try-urewrite-rules term type iffp control))
+    :hints(("Goal" :in-theory (enable equiv-lemma-rw.try-urewrite-rule-list-under-iff
+                                      rw.try-urewrite-rules
+                                      rw.fast-try-urewrite-rules))))
+
+  (defthmd equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rule-list
+    (equal (rw.trace->rhs (rw.try-urewrite-rule-list hypbox term rules iffp control))
+           (rw.ftrace->rhs (rw.fast-try-urewrite-rule-list term rules iffp control)))
+    :hints(("Goal" :in-theory (enable rw.try-urewrite-rule-list
+                                      rw.fast-try-urewrite-rule-list
+                                      rw.try-urewrite-rule
+                                      rw.fast-try-urewrite-rule))))
+
+  (defthmd equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rules
+    (equal (rw.trace->rhs (rw.try-urewrite-rules hypbox term type iffp control))
+           (rw.ftrace->rhs (rw.fast-try-urewrite-rules term type iffp control)))
+    :hints(("Goal" :in-theory (enable equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rule-list
+                                      rw.try-urewrite-rules
+                                      rw.fast-try-urewrite-rules))))
+
+
+
+  (defthmd equiv-lemma-rw.trace->rhs-of-rw.not-trace
+    (equal (rw.trace->rhs (rw.not-trace x iffp))
+           (rw.ftrace->rhs (rw.fast-not-trace (rw.trace-fast-image x))))
+    :hints(("Goal" :in-theory (enable rw.not-trace
+                                      rw.fast-not-trace))))
+
+
+
+  (defthmd equiv-lemma-rw.ftrace->rhs-of-rw.maybe-extend-fast-trace
+    ;; Can we avoid this case split somehow?
+    (equal (rw.ftrace->rhs (rw.maybe-extend-fast-trace x y))
+           (if y
+               (rw.ftrace->rhs y)
+             (rw.ftrace->rhs x)))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace
+                                      rw.maybe-extend-fast-trace))))
+
+  (defthmd equiv-lemma-rw.trace->rhs-of-rw.maybe-extend-trace
+    ;; Can we avoid this case split somehow?
+    (equal (rw.trace->rhs (rw.maybe-extend-trace x y))
+           (if y
+               (rw.trace->rhs y)
+             (rw.trace->rhs x)))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace))))
+
+  (defthmd equiv-lemma-rw.ftrace->rhs-of-rw.maybe-extend-fast-trace-of-rw.trace-fast-image
+    (equal (rw.ftrace->rhs (rw.maybe-extend-fast-trace x (rw.trace-fast-image y)))
+           (rw.trace->rhs y))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace
+                                      rw.maybe-extend-fast-trace))))
+
+  (deftheory rw.trace-fast-image-equivalence-lemmas
+    '(equiv-lemma-rw.try-ground-simplify-under-iff
+      equiv-lemma-rw.trace->rhs-of-rw.try-ground-simplify
+      equiv-lemma-rw.try-urewrite-rule-list-under-iff
+      equiv-lemma-rw.try-urewrite-rules-under-iff
+      equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rule-list
+      equiv-lemma-rw.trace->rhs-of-rw.try-urewrite-rules
+      equiv-lemma-rw.trace->rhs-of-rw.not-trace
+      equiv-lemma-rw.ftrace->rhs-of-rw.maybe-extend-fast-trace
+      equiv-lemma-rw.trace->rhs-of-rw.maybe-extend-trace
+      equiv-lemma-rw.ftrace->rhs-of-rw.maybe-extend-fast-trace-of-rw.trace-fast-image)))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/fast-urewrite.lisp acl2-6.3/books/milawa/ACL2/rewrite/fast-urewrite.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/fast-urewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/fast-urewrite.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,253 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "urewrite")
+(include-book "crewrite")
+(include-book "fast-traces")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; The Fast, Unconditional Rewriter
+;;
+;; We now introduce a version of urewrite which produces fast traces instead of
+;; full-blown traces.  We prove it mirrors the operation of urewrite, in that
+;; the ftrace it produces:
+;;
+;;   - has no fgoals (just like urewrite) and also
+;;   - has the same rhs as the trace produced by urewrite
+;;
+;; Thus, the fast version of urewrite can be used when we do not need to
+;; produce a full-blown trace.
+
+(defconst *rw.fast-flag-urewrite-sigma*
+  (list (cons '(rw.flag-urewrite 'term ?x ?iffp ?control ?n)
+              '(rw.fast-flag-urewrite 'term ?x ?iffp ?control ?n))
+        (cons '(rw.flag-urewrite 'list ?x ?iffp ?control ?n)
+              '(rw.fast-flag-urewrite 'list ?x ?iffp ?control ?n))))
+
+(ACL2::make-event
+ `(encapsulate
+   ()
+   (defun rw.fast-flag-urewrite (flag x iffp control n)
+    (declare (xargs :guard (and (booleanp iffp)
+                                (rw.controlp control)
+                                (natp n)
+                                (if (equal flag 'term)
+                                    (logic.termp x)
+                                  (and (equal flag 'list)
+                                       (logic.term-listp x))))
+                    :measure (two-nats-measure (nfix n) (rank x))
+                    :verify-guards nil))
+    (if (equal flag 'term)
+        ,(ACL2::jared-rewrite *rw.flag-urewrite*
+                              (revappend *rw.fast-flag-urewrite-sigma* *rw.fast-traces-sigma*))
+      (if (consp x)
+          (let ((car-rw (rw.fast-flag-urewrite 'term (car x) iffp control n))
+                (cdr-rw (rw.fast-flag-urewrite 'list (cdr x) iffp control n)))
+            (rw.ftraces (cons (rw.ftrace->rhs car-rw) (rw.ftraces->rhses cdr-rw))
+                        nil))
+        (rw.ftraces nil nil))))))
+
+(defund rw.fast-urewrite (x iffp control n)
+  (declare (xargs :guard (and (logic.termp x)
+                              (booleanp iffp)
+                              (rw.controlp control)
+                              (natp n))
+                  :verify-guards nil))
+  (rw.fast-flag-urewrite 'term x iffp control n))
+
+(defund rw.fast-urewrite-list (x iffp control n)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (booleanp iffp)
+                              (rw.controlp control)
+                              (natp n))
+                  :verify-guards nil))
+  (rw.fast-flag-urewrite 'list x iffp control n))
+
+
+(defconst *rw.fast-flagless-urewrite-sigma*
+  (list (cons '(ACL2::prog2$ ?x ?y)
+              '?y)
+        (cons '(rw.flag-urewrite 'term ?x ?iffp ?control ?n)
+              '(rw.fast-urewrite ?x ?iffp ?control ?n))
+        (cons '(rw.flag-urewrite 'list ?x ?iffp ?control ?n)
+              '(rw.fast-urewrite-list ?x ?iffp ?control ?n))))
+
+
+(ACL2::make-event
+ `(defthmd definition-of-rw.fast-urewrite
+    (equal (rw.fast-urewrite x iffp control n)
+           ,(ACL2::jared-rewrite *rw.flag-urewrite*
+                                 (revappend *rw.fast-flagless-urewrite-sigma*
+                                            *rw.fast-traces-sigma*)))
+    :rule-classes :definition
+    :hints(("Goal"
+            :in-theory (enable rw.fast-urewrite
+                               rw.fast-urewrite-list)
+            :expand (rw.fast-flag-urewrite 'term x iffp control n)))))
+
+(defthmd definition-of-rw.fast-urewrite-list
+  (equal (rw.fast-urewrite-list x iffp control n)
+         (if (consp x)
+             (let ((car-rw (rw.fast-flag-urewrite 'term (car x) iffp control n))
+                   (cdr-rw (rw.fast-flag-urewrite 'list (cdr x) iffp control n)))
+               (rw.ftraces (cons (rw.ftrace->rhs car-rw) (rw.ftraces->rhses cdr-rw))
+                           nil))
+           (rw.ftraces nil nil)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.fast-urewrite
+                             rw.fast-urewrite-list)
+          :expand (rw.fast-flag-urewrite 'list x iffp control n))))
+
+(defthm rw.fast-flag-urewrite-of-term
+  (equal (rw.fast-flag-urewrite 'term x iffp control n)
+         (rw.fast-urewrite x iffp control n))
+  :hints(("Goal" :in-theory (enable rw.fast-urewrite))))
+
+(defthm rw.fast-flag-urewrite-of-list
+  (equal (rw.fast-flag-urewrite 'list x iffp control n)
+         (rw.fast-urewrite-list x iffp control n))
+  :hints(("Goal" :in-theory (enable rw.fast-urewrite-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-urewrite))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.fast-urewrite-list))))
+
+
+(defthm rw.fast-urewrite-under-iff
+  (implies (force (logic.termp x))
+           (iff (rw.fast-urewrite x iffp control n)
+                t))
+  :hints(("Goal"
+          :expand (rw.fast-urewrite x iffp control n)
+          :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthm len-of-rw.ftraces->rhses-of-rw.fast-urewrite-list
+  (equal (len (rw.ftraces->rhses (rw.fast-urewrite-list x iffp control n)))
+         (len x))
+  :hints(("Goal"
+          :expand (rw.fast-urewrite-list x iffp control n)
+          :induct (cdr-induction x))))
+
+
+
+(defthms-flag
+  :shared-hyp (force (rw.controlp control))
+  :thms ((term forcing-rw.ftracep-of-rw.fast-urewrite
+               (implies (force (logic.termp x))
+                        (equal (rw.ftracep (rw.fast-urewrite x iffp control n))
+                               t)))
+         (t forcing-rw.ftrace-listp-of-rw.fast-urewrite-list
+            (implies (force (logic.term-listp x))
+                     (equal (rw.ftracesp (rw.fast-urewrite-list x iffp control n))
+                            t))))
+  :hints(("Goal"
+          :expand ((:free (iffp) (rw.fast-urewrite x iffp control n))
+                   (:free (iffp) (rw.fast-urewrite-list x iffp control n)))
+          :induct (rw.fast-flag-urewrite flag x iffp control n)
+          :in-theory (disable forcing-lookup-of-logic.function-name))))
+
+
+
+(defthms-flag
+  :shared-hyp (force (and (rw.controlp control)
+                          (booleanp iffp)))
+  :thms ((term forcing-rw.trace-fast-image-of-rw.urewrite
+               (implies (force (logic.termp x))
+                        (equal (rw.trace-fast-image (rw.urewrite x iffp control n))
+                               (rw.fast-urewrite x iffp control n))))
+         (t forcing-rw.trace-list-fast-image-of-rw.urewrite-list
+            (implies (force (logic.term-listp x))
+                     (equal (rw.trace-list-fast-image (rw.urewrite-list x iffp control n))
+                            (rw.fast-urewrite-list x iffp control n)))))
+  :hints(("Goal"
+          :expand ((:free (iffp) (rw.fast-urewrite x iffp control n))
+                   (:free (iffp) (rw.urewrite x iffp control n))
+                   (:free (iffp) (rw.fast-urewrite-list x iffp control n))
+                   (:free (iffp) (rw.urewrite-list x iffp control n)))
+          :induct (rw.flag-urewrite flag x iffp control n)
+          :in-theory (e/d (rw.trace-fast-image-equivalence-lemmas)
+                          (forcing-lookup-of-logic.function-name)))))
+
+
+(defthm forcing-rw.ftrace->rhs-of-rw.fast-urewrite
+  (implies (force (and (logic.termp x)
+                       (booleanp iffp)
+                       (rw.controlp control)))
+           (equal (rw.ftrace->rhs (rw.fast-urewrite x iffp control n))
+                  (rw.trace->rhs (rw.urewrite x iffp control n))))
+  :hints(("Goal"
+          :in-theory (disable forcing-rw.trace-fast-image-of-rw.urewrite)
+          :use ((:instance forcing-rw.trace-fast-image-of-rw.urewrite)))))
+
+(defthm forcing-rw.ftraces->rhses-of-rw.fast-urewrite-list
+  (implies (force (and (logic.term-listp x)
+                       (booleanp iffp)
+                       (rw.controlp control)))
+           (equal (rw.ftraces->rhses (rw.fast-urewrite-list x iffp control n))
+                  (rw.trace-list-rhses (rw.urewrite-list x iffp control n))))
+  :hints(("Goal"
+          :in-theory (disable forcing-rw.trace-list-fast-image-of-rw.urewrite-list)
+          :use ((:instance forcing-rw.trace-list-fast-image-of-rw.urewrite-list)))))
+
+
+(defthm forcing-rw.ftrace->fgoals-of-rw.fast-urewrite
+  (implies (force (and (logic.termp x)
+                       (booleanp iffp)
+                       (rw.controlp control)))
+           (equal (rw.ftrace->fgoals (rw.fast-urewrite x iffp control n))
+                  nil))
+  :hints(("Goal"
+          :in-theory (disable forcing-rw.trace-fast-image-of-rw.urewrite)
+          :use ((:instance forcing-rw.trace-fast-image-of-rw.urewrite)))))
+
+(defthm forcing-rw.ftraces->fgoals-of-rw.fast-urewrite-list
+  (implies (force (and (logic.term-listp x)
+                       (booleanp iffp)
+                       (rw.controlp control)))
+           (equal (rw.ftraces->fgoals (rw.fast-urewrite-list x iffp control n))
+                  nil))
+  :hints(("Goal"
+          :in-theory (disable forcing-rw.trace-list-fast-image-of-rw.urewrite-list)
+          :use ((:instance forcing-rw.trace-list-fast-image-of-rw.urewrite-list)))))
+
+(verify-guards rw.fast-flag-urewrite)
+(verify-guards rw.fast-urewrite)
+(verify-guards rw.fast-urewrite-list)
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/gather.lisp acl2-6.3/books/milawa/ACL2/rewrite/gather.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/gather.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/gather.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,221 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "theoryp")
+(include-book "evaluator")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defun rw.rule-components ()
+  (declare (xargs :guard t))
+  '(name type hyps equiv lhs rhs syntax crithyps))
+
+(defund rw.consider-rule (rule criteria defs)
+  ;; A generally useful thing to be able to do is ask, "does this rule fit some
+  ;; certain criteria?"  There might be good reasons to ask all kinds of things
+  ;; about a rule -- does it have a certain name, does it have an "if" on the
+  ;; right-hand side, does it have any free variables, does etc.  Rather than
+  ;; try to write a separate function to answer each of these questions, we
+  ;; allow you to specify an arbitrary term as a CRITERIA.
+  ;;
+  ;; The criteria can include variables for each of the rule's components.
+  ;; That is, it can mention: name, type, hyps, equiv, lhs, rhs, syntax, and
+  ;; crithyps.  We'll substitute the quoted name, type, etc., from the rule in
+  ;; for these variables before evaluating the term.  So for example, to match
+  ;; a rule whose name is FOO, you can use the criteria (equal name 'FOO); to
+  ;; match a rule whose lhs is (foo x y), use (equal lhs '(foo x y)); and so
+  ;; forth.
+  (declare (xargs :guard (and (rw.rulep rule)
+                              (logic.termp criteria)
+                              (subsetp (logic.term-vars criteria) (rw.rule-components))
+                              (definition-listp defs))))
+  (not (equal (generic-evaluator (logic.substitute criteria
+                                                   (list (cons 'name (list 'quote (rw.rule->name rule)))
+                                                         (cons 'type (list 'quote (rw.rule->type rule)))
+                                                         (cons 'hyps (list 'quote (rw.rule->hyps rule)))
+                                                         (cons 'equiv (list 'quote (rw.rule->equiv rule)))
+                                                         (cons 'lhs (list 'quote (rw.rule->lhs rule)))
+                                                         (cons 'rhs (list 'quote (rw.rule->rhs rule)))
+                                                         (cons 'syntax (list 'quote (rw.rule->syntax rule)))
+                                                         (cons 'crithyps (list 'quote (rw.rule->crithyps rule)))))
+                                 defs
+                                 200)
+              ''nil)))
+
+(defthm booleanp-of-rw.consider-rule
+  (equal (booleanp (rw.consider-rule rule criteria defs))
+         t)
+  :hints(("Goal" :in-theory (enable rw.consider-rule))))
+
+
+
+(defund rw.gather-rules-from-list (rules criteria defs acc)
+  ;; We collect up all the rules that match the given criteria.  See
+  ;; rw.consider-rule for more details about what valid criteria are like.
+  (declare (xargs :guard (and (rw.rule-listp rules)
+                              (logic.termp criteria)
+                              (subsetp (logic.term-vars criteria) (rw.rule-components))
+                              (definition-listp defs)
+                              (rw.rule-listp acc))))
+  (if (consp rules)
+      (rw.gather-rules-from-list (cdr rules) criteria defs
+                                 (if (rw.consider-rule (car rules) criteria defs)
+                                     (cons (car rules) acc)
+                                   acc))
+    acc))
+
+(defthm true-listp-of-rw.gather-rules-from-list
+  (equal (true-listp (rw.gather-rules-from-list rules criteria defs acc))
+         (true-listp acc))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-list))))
+
+(defthm forcing-rw.rule-listp-of-rw.gather-rules-from-list
+  (implies (force (and (rw.rule-listp rules)
+                       (rw.rule-listp acc)))
+           (equal (rw.rule-listp (rw.gather-rules-from-list rules criteria defs acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-list))))
+
+(defthm forcing-rw.rule-list-atblp-of-rw.gather-rules-from-list
+  (implies (force (and (rw.rule-list-atblp rules atbl)
+                       (rw.rule-list-atblp acc atbl)))
+           (equal (rw.rule-list-atblp (rw.gather-rules-from-list rules criteria defs acc) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-list))))
+
+(defthm forcing-rw.rule-list-env-okp-of-rw.gather-rules-from-list
+  (implies (force (and (rw.rule-list-env-okp rules thms)
+                       (rw.rule-list-env-okp acc thms)))
+           (equal (rw.rule-list-env-okp (rw.gather-rules-from-list rules criteria defs acc) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-list))))
+
+
+
+(defund rw.gather-rules-from-map (rulemap criteria defs acc)
+  ;; We collect up all the rules that match the given criteria.  See
+  ;; rw.consider-rule for more details about what valid criteria are like.
+  (declare (xargs :guard (and (rw.typed-rulemapp rulemap)
+                              (logic.termp criteria)
+                              (subsetp (logic.term-vars criteria) (rw.rule-components))
+                              (definition-listp defs)
+                              (rw.rule-listp acc))))
+  (if (consp rulemap)
+      (rw.gather-rules-from-map (cdr rulemap) criteria defs
+                                (rw.gather-rules-from-list (cdr (car rulemap)) criteria defs acc))
+    acc))
+
+(defthm true-listp-of-rw.gather-rules-from-map
+  (equal (true-listp (rw.gather-rules-from-map rulemap criteria defs acc))
+         (true-listp acc))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-map))))
+
+(defthm rw.rule-listp-of-rw.gather-rules-from-map
+  (implies (force (and (rw.typed-rulemapp rulemap)
+                       (rw.rule-listp acc)))
+           (equal (rw.rule-listp (rw.gather-rules-from-map rulemap criteria defs acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-map))))
+
+(defthm rw.rule-list-atblp-of-rw.gather-rules-from-map
+  (implies (force (and (rw.rule-list-list-atblp (range rulemap) atbl)
+                       (rw.rule-list-atblp acc atbl)
+                       (rw.typed-rulemapp rulemap)
+                       (rw.rule-listp acc)))
+           (equal (rw.rule-list-atblp (rw.gather-rules-from-map rulemap criteria defs acc) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-map))))
+
+(defthm rw.rule-list-env-okp-of-rw.gather-rules-from-map
+  (implies (force (and (rw.rule-list-list-env-okp (range rulemap) thms)
+                       (rw.rule-list-env-okp acc thms)
+                       (rw.typed-rulemapp rulemap)
+                       (rw.rule-listp acc)))
+           (equal (rw.rule-list-env-okp (rw.gather-rules-from-map rulemap criteria defs acc) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-map))))
+
+
+
+(defund rw.gather-rules-from-theory (theory criteria defs acc)
+  ;; We keep all the rules that match the given criteria.  See rw.consider-rule
+  ;; for more details about what valid criteria look like.
+  (declare (xargs :guard (and (rw.theoryp theory)
+                              (logic.termp criteria)
+                              (subsetp (logic.term-vars criteria) (rw.rule-components))
+                              (definition-listp defs)
+                              (rw.rule-listp acc))
+                  :verify-guards nil))
+  (if (consp theory)
+      (rw.gather-rules-from-theory (rw.theory->left theory) criteria defs
+       (rw.gather-rules-from-theory (rw.theory->right theory) criteria defs
+        (rw.gather-rules-from-map (rw.theory->rulemap theory) criteria defs acc)))
+    acc))
+
+(defthm true-listp-of-rw.gather-rules-from-theory
+  (equal (true-listp (rw.gather-rules-from-theory theory criteria defs acc))
+         (true-listp acc))
+  :hints(("Goal" :in-theory (enable rw.gather-rules-from-theory))))
+
+(defthm rw.rule-listp-of-rw.gather-rules-from-theory
+   (implies (force (and (rw.theoryp theory)
+                        (rw.rule-listp acc)))
+            (equal (rw.rule-listp (rw.gather-rules-from-theory theory criteria defs acc))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.gather-rules-from-theory))))
+
+(verify-guards rw.gather-rules-from-theory)
+
+(defthm rw.rule-list-atblp-of-rw.gather-rules-from-theory
+  (implies (force (and (rw.theory-atblp theory atbl)
+                       (rw.rule-list-atblp acc atbl)
+                       (rw.theoryp theory)
+                       (rw.rule-listp acc)))
+            (equal (rw.rule-list-atblp (rw.gather-rules-from-theory theory criteria defs acc) atbl)
+                   t))
+ :hints(("Goal" :in-theory (enable rw.gather-rules-from-theory))))
+
+(defthm rw.rule-list-env-okp-of-rw.gather-rules-from-theory
+  (implies (force (and (rw.theory-env-okp theory thms)
+                       (rw.rule-list-env-okp acc thms)
+                       (rw.theoryp theory)
+                       (rw.rule-listp acc)))
+            (equal (rw.rule-list-env-okp (rw.gather-rules-from-theory theory criteria defs acc) thms)
+                   t))
+ :hints(("Goal" :in-theory (enable rw.gather-rules-from-theory))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/magic-evaluator.lisp acl2-6.3/books/milawa/ACL2/rewrite/magic-evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/magic-evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/magic-evaluator.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,132 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "evaluator-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; The magic-evaluator is very magical.
+;;
+;; It's like the generic-evaluator, except
+;;   - You don't have to worry about how many steps it will take, and
+;;   - It calls raw lisp eval under the hood so it runs much faster.
+;;
+;; Similarly, there is a magic-evaluator-bldr which doesn't need to take a
+;; number of steps.
+;;
+;; There are some limitations to the magic.
+;;   - You can only use the magic evaluator in conjunction with the
+;;     tactic harness and only with
+;;       (1) the currently defined functions, or
+;;       (2) the currently defined syntactic functions (syndefs)
+;;   - You can only use its builder with the currently defined functions.
+;;
+;; Attempting to break these rules will result in a hard error.
+
+(encapsulate
+ ()
+ (set-verify-guards-eagerness 0)
+
+ (defun-sk evaluable-termp (x defs)
+   (exists n (generic-evaluator x defs n)))
+
+ (set-verify-guards-eagerness 2))
+
+
+(defund magic-evaluator (x defs)
+  ;; This eventually gets replaced with a thin wrapper for common lisp "eval"
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.groundp x)
+                              (definition-listp defs))))
+  (ACL2::prog2$ (ACL2::cw "Warning: magic-evaluator has not yet been redefined!!~%")
+                (generic-evaluator x defs (nfix (evaluable-termp-witness x defs)))))
+
+(defthm forcing-logic.constantp-of-magic-evaluator
+  (implies (force (and (magic-evaluator x defs)
+                       (logic.termp x)
+                       (definition-listp defs)))
+           (logic.constantp (magic-evaluator x defs)))
+  :hints(("Goal" :in-theory (enable magic-evaluator))))
+
+
+
+
+(defund magic-evaluator-bldr (x defs)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.groundp x)
+                              (definition-listp defs)
+                              (magic-evaluator x defs))
+                  :guard-hints (("Goal" :in-theory (enable magic-evaluator)))))
+  ;; This eventually gets replaced with a thing wrapper for an "unbounded"
+  ;; version of the generic-evaluator-bldr.
+  (ACL2::prog2$ (ACL2::cw "Warning: magic-evaluator-bldr has not yet been redefined!!~%")
+                (generic-evaluator-bldr x defs (nfix (evaluable-termp-witness x defs)))))
+
+(defobligations magic-evaluator-bldr
+  (generic-evaluator-bldr))
+
+(defthm forcing-logic.appealp-of-magic-evaluator-bldr
+  (implies (force (and (magic-evaluator x defs)
+                       (logic.termp x)
+                       (definition-listp defs)))
+           (equal (logic.appealp (magic-evaluator-bldr x defs))
+                  t))
+  :hints(("Goal" :in-theory (enable magic-evaluator magic-evaluator-bldr))))
+
+(defthm forcing-logic.conclusion-of-magic-evaluator-bldr
+  (implies (force (and (magic-evaluator x defs)
+                       (logic.termp x)
+                       (definition-listp defs)))
+           (equal (logic.conclusion (magic-evaluator-bldr x defs))
+                  (logic.pequal x (magic-evaluator x defs))))
+  :hints(("Goal" :in-theory (enable magic-evaluator magic-evaluator-bldr))))
+
+(defthm@ forcing-logic.proofp-of-magic-evaluator-bldr
+  (implies (force (and (magic-evaluator x defs)
+                       (logic.termp x)
+                       (logic.term-atblp x atbl)
+                       (definition-listp defs)
+                       (logic.formula-list-atblp defs atbl)
+                       (subsetp defs axioms)
+                       (equal (cdr (lookup 'if atbl)) 3)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (@obligations generic-evaluator-bldr)))
+           (equal (logic.proofp (magic-evaluator-bldr x defs) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable magic-evaluator magic-evaluator-bldr))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/match-free.lisp acl2-6.3/books/milawa/ACL2/rewrite/match-free.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/match-free.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/match-free.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,448 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "assms/top")
+(include-book "rulep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm submap-of-eachp-when-submapp
+  ;; BOZO find me a home
+  (implies (and (submapp a b)
+                (submap-of-eachp b x))
+           (equal (submap-of-eachp a x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm submap-of-eachp-when-submapp-alt
+  ;; BOZO find me a home
+  (implies (and (submap-of-eachp b x)
+                (submapp a b))
+           (equal (submap-of-eachp a x)
+                  t)))
+
+
+
+;; Free-variable matching
+;;
+;; The FREE VARIABLES of the rewrite rule hyps ==> (equiv lhs rhs) are all the
+;; variables which occur in hyps but not in lhs.  The classic example of a
+;; rule with free variables is a transitivity rule, e.g.,
+;;
+;;    [| subsetp x y; subsetp y z |] ==> (subsetp x z) = true
+;;
+;; Here, x and z are bound because they are mentioned in lhs, but y is free.
+;;
+;; If a rule does not contain any free variables, it is fairly straightforward
+;; to apply it.  We match its lhs against our goal term, then use the resulting
+;; sigma to instantiate all the hyps.  If all the hyps can be relieved, then we
+;; replace the goal (which was lhs/sigma) with rhs/sigma.
+;;
+;; This strategy breaks down with free variables.  For example, suppose we know
+;; (subsetp a b) and (subsetp b c), and we want to rewrite (subsetp a c).  We
+;; match the pattern (subsetp x z) against our goal term, (subsetp a c),
+;; producing the substitution { x <- a, z <- c }.  But this substitution does
+;; not give us a sensible binding for y, so we are left with the unprovable
+;; hyps (subsetp a y) and (subsetp y c).  Since we can't relieve these hyps, we
+;; fail to rewrite (subsetp a c).
+;;
+;; What we need to do, of course, is to somehow also bind y <- b.  Identifying
+;; this binding is the job of our free-variable matching code.  More generally,
+;; imagine we have a rule, with free variables, whose left-hand side matches a
+;; goal term to rewrite.  Our free-variable code is responsible for suggesting
+;; some appropriate bindings for the free variables in our rule.
+;;
+;; Now we run into some tension in our design.
+;;
+;;   - Every sigma we suggest is more work for the rewriter (because it needs
+;;     to try to relieve each hyp/sigma), so we want to suggest relatively few
+;;     sigmas for efficiency.
+;;
+;;   - On the other hand, if there is a working sigma we fail to suggest, the
+;;     rule will not be applied and we may stupidly fail to make progress just
+;;     because we are too dumb to see the right sigma.
+;;
+;; We want to make the useful and obvious suggestions, but in general we are
+;; happier to err on the side of stupidity than slow our rewriter to a crawl
+;; trying probably-useless sigmas.  Our strategy is intended to be similar in
+;; spirit to ACL2's approach, although it is not implemented in the same way.
+;;
+;; Suppose there are k free variables, v1 through vk.  Let crit(vi) refer to
+;; the first hypothesis which mentions vi.  Call the set of all such hyps the
+;; CRICTICAL HYPS.  Our strategy is to suggest only sigmas which, in a fairly
+;; trivial way, can be sure to satisfy all the critical hyps.  We accomplish
+;; this by consulting our assms.  The assms structure stores all of the things
+;; we can assume while performing the rewrite.  We can ask the assumptions
+;; system for a list of the terms which are known to be true, and try to see if
+;; any of these terms can match our critical hyp.
+
+(defund rw.collect-critical-hyps (freevars hyps)
+  ;; Freevars are a list of variables, and hyps are terms.  We keep the "first"
+  ;; hyp for each free variable.
+  (declare (xargs :guard (and (logic.variable-listp freevars)
+                              (logic.term-listp hyps))))
+  (if (and (consp hyps)
+           (consp freevars))
+      (let ((hypvars (logic.term-vars (car hyps))))
+        (if (disjointp hypvars freevars)
+            ;; None of the freevars are in this hyp; this hyp is not critical.
+            (rw.collect-critical-hyps freevars (cdr hyps))
+          ;; Some of the freevars are here; this hyp is critical.
+          (cons (car hyps) (rw.collect-critical-hyps (fast-difference$ freevars hypvars nil) (cdr hyps)))))
+    ;; Otherwise, if we have run out of hyps or freevars, so nothing else can be
+    ;; critical.
+    nil))
+
+(defthm subsetp-of-rw.collect-critical-hyps
+  (subsetp (rw.collect-critical-hyps freevars hyps) hyps)
+  :hints(("Goal" :in-theory (enable rw.collect-critical-hyps))))
+
+
+
+(defund rw.critical-hyps (lhs hyps)
+  ;; Given the lhs and hyps from a rule, we construct the list of crithyps.
+  ;; This should be used when creating rewrite rules as the value for the
+  ;; crithyps parameter.
+  (declare (xargs :guard (and (logic.termp lhs)
+                              (rw.hyp-listp hyps))))
+  (let* ((hypterms (rw.hyp-list-terms hyps))
+         (hypvars  (logic.term-list-vars hypterms))
+         (lhsvars  (logic.term-vars lhs))
+         (freevars (fast-difference$ hypvars lhsvars nil)))
+    (rw.collect-critical-hyps freevars hypterms)))
+
+(defthm subsetp-of-rw.critical-hyps
+  (subsetp (rw.critical-hyps lhs hyps) (rw.hyp-list-terms hyps))
+  :hints(("Goal" :in-theory (enable rw.critical-hyps))))
+
+(defthm logic.term-listp-of-rw.critical-hyps
+  (implies (rw.hyp-listp hyps)
+           (logic.term-listp (rw.critical-hyps lhs hyps)))
+  :hints(("Goal"
+          :in-theory (disable subsetp-of-rw.critical-hyps)
+          :use ((:instance subsetp-of-rw.critical-hyps)))))
+
+
+
+
+(defund rw.limit-hyps-aux (freevars hyps)
+  ;; Freevars are a list of variables and hyps are the hypp structures from the
+  ;; rule.  We add a blimit of 0 to every critical hyp.
+  (declare (xargs :guard (and (logic.variable-listp freevars)
+                              (rw.hyp-listp hyps))))
+  (if (consp hyps)
+      (let ((hypvars (logic.term-vars (rw.hyp->term (car hyps)))))
+        (if (disjointp hypvars freevars)
+            ;; This hyp is not critical.
+            (cons (car hyps) (rw.limit-hyps-aux freevars (cdr hyps)))
+          ;; Some of the freevars are here; this hyp is critical.
+          (cons (rw.hyp (rw.hyp->term (car hyps))
+                        (rw.hyp->fmode (car hyps))
+                        t ;; limitp
+                        0 ;; limit
+                        )
+                (rw.limit-hyps-aux (fast-difference$ freevars hypvars nil) (cdr hyps)))))
+    nil))
+
+(defund rw.limit-hyps (lhs hyps)
+  ;; Given the lhs and the hyps from a rule, we construct a new list of hyps
+  ;; where each crithyp has been backchain-limited to 0.  This seems to make
+  ;; our free-variable rules cheaper.
+  ;;
+  ;; BOZO why is this necessary?  Shouldn't the rules get rewritten to true
+  ;; by virtue of our find-extensions code?
+  (declare (xargs :guard (and (logic.termp lhs)
+                              (rw.hyp-listp hyps))))
+  (let* ((hypterms (rw.hyp-list-terms hyps))
+         (hypvars  (logic.term-list-vars hypterms))
+         (lhsvars  (logic.term-vars lhs))
+         (freevars (fast-difference$ hypvars lhsvars nil)))
+    (rw.limit-hyps-aux freevars hyps)))
+
+
+
+
+(defund rw.find-extensions-for-sigma-aux (hyp trueterms sigma acc)
+  ;; - Hyp is a hypothesis from our rule (one of the critical hyps) which
+  ;;   does not have one of the special "equal" or "iff" forms.
+  ;; - Trueterms are the list of all the terms we "know" are true, and
+  ;; - Sigma is a substitution list which probably binds some of the
+  ;;   variables in hyp, but probably does not bind them all.
+  ;;
+  ;; We try to match our hyp against each trueterm under sigma.  A successful
+  ;; match will result in a new sigma that gives bindings to the other
+  ;; variables in hyp.  We return the a list of all these extended sigmas.
+  (declare (xargs :guard (and (logic.termp hyp)
+                              (logic.term-listp trueterms)
+                              (logic.sigmap sigma)
+                              (logic.sigma-listp acc))))
+  (if (consp trueterms)
+      (let ((match-result (logic.patmatch hyp (car trueterms) sigma)))
+        (rw.find-extensions-for-sigma-aux hyp (cdr trueterms) sigma
+                                          (if (and (not (equal 'fail match-result))
+                                                   (not (memberp match-result acc)))
+                                              (cons match-result acc)
+                                            acc)))
+    acc))
+
+(defthm forcing-logic.sigma-listp-of-rw.find-extensions-for-sigma-aux
+  (implies (force (and (logic.termp hyp)
+                       (logic.term-listp trueterms)
+                       (logic.sigmap sigma)
+                       (logic.sigma-listp acc)))
+           (equal (logic.sigma-listp (rw.find-extensions-for-sigma-aux hyp trueterms sigma acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma-aux))))
+
+(defthm forcing-logic.sigma-list-atblp-of-rw.find-extensions-for-sigma-aux
+  (implies (force (and (logic.term-atblp hyp atbl)
+                       (logic.term-list-atblp trueterms atbl)
+                       (logic.sigma-atblp sigma atbl)
+                       (logic.sigma-list-atblp acc atbl)))
+           (equal (logic.sigma-list-atblp (rw.find-extensions-for-sigma-aux hyp trueterms sigma acc) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma-aux))))
+
+(defthm submap-of-eachp-of-rw.find-extensions-for-sigma-aux
+  (implies (submap-of-eachp sigma acc)
+           (submap-of-eachp sigma (rw.find-extensions-for-sigma-aux hyp trueterms sigma acc)))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma-aux))))
+
+(defthm submap-of-eachp-of-rw.find-extensions-for-sigma-aux-free
+  (implies (and (submapp sig sigma)
+                (submap-of-eachp sig acc))
+           (equal (submap-of-eachp sig (rw.find-extensions-for-sigma-aux hyp trueterms sigma acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma-aux))))
+
+
+
+(defund rw.find-extensions-for-sigma (hyp trueterms sigma acc)
+  ;; - Hyp is a hypothesis from our rule (one of the critical hyps) which
+  ;;   does not have one of the special "equal" or "iff" forms.
+  ;; - Trueterms are the list of all the terms we "know" are true, and
+  ;; - Sigma is a substitution list which probably binds some of the
+  ;;   variables in hyp, but probably does not bind them all.
+  (declare (xargs :guard (and (logic.termp hyp)
+                              (logic.term-listp trueterms)
+                              (logic.sigmap sigma)
+                              (logic.sigma-listp acc))))
+  (if (and (logic.functionp hyp)
+           (memberp (logic.function-name hyp) '(equal iff))
+           (tuplep 2 (logic.function-args hyp)))
+      ;; As a special consideration for (equal x y) and (iff x y), we try to also
+      ;; find matches for (equal y x) and (iff y x).
+      (let ((commuted-hyp (logic.function (logic.function-name hyp)
+                                          (list (second (logic.function-args hyp))
+                                                (first  (logic.function-args hyp))))))
+        (rw.find-extensions-for-sigma-aux commuted-hyp trueterms sigma
+         (rw.find-extensions-for-sigma-aux hyp trueterms sigma acc)))
+    ;; All other functions we just search for normally.
+    (rw.find-extensions-for-sigma-aux hyp trueterms sigma acc)))
+
+(defthm forcing-logic.sigma-listp-of-rw.find-extensions-for-sigma
+  (implies (force (and (logic.termp hyp)
+                       (logic.term-listp trueterms)
+                       (logic.sigmap sigma)
+                       (logic.sigma-listp acc)))
+           (equal (logic.sigma-listp (rw.find-extensions-for-sigma hyp trueterms sigma acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma))))
+
+(defthm forcing-logic.sigma-list-atblp-of-rw.find-extensions-for-sigma
+  (implies (force (and (logic.termp hyp)
+                       (logic.term-atblp hyp atbl)
+                       (logic.term-list-atblp trueterms atbl)
+                       (logic.sigma-atblp sigma atbl)
+                       (logic.sigma-list-atblp acc atbl)))
+           (equal (logic.sigma-list-atblp (rw.find-extensions-for-sigma hyp trueterms sigma acc) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma))))
+
+(defthm submap-of-eachp-of-rw.find-extensions-for-sigma
+  (implies (submap-of-eachp sigma acc)
+           (submap-of-eachp sigma (rw.find-extensions-for-sigma hyp trueterms sigma acc)))
+  :hints(("Goal" :in-theory (e/d (rw.find-extensions-for-sigma)
+                                 ((:executable-counterpart ACL2::force))))))
+
+(defthm submap-of-eachp-of-rw.find-extensions-for-sigma-free
+  (implies (and (submapp sig sigma)
+                (submap-of-eachp sig acc))
+           (equal (submap-of-eachp sig (rw.find-extensions-for-sigma hyp trueterms sigma acc))
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.find-extensions-for-sigma)
+                                 ((:executable-counterpart ACL2::force))))))
+
+
+
+
+
+(defund rw.find-extensions-for-sigma-list (hyp trueterms sigmas acc)
+  ;; - Hyp is a hypothesis from our rule (one of the critical hyps),
+  ;; - Trueterms are the list of all the terms we "know" are true, and
+  ;; - Sigmas are the a list of sigmas that work so far.
+  ;;
+  ;; We try to match our hyp against each trueterm under each sigma.  Each
+  ;; successful match results in a new sigma that binds all the variables
+  ;; in hyp.  We return the list of all these extended sigmas.
+  (declare (xargs :guard (and (logic.termp hyp)
+                              (logic.term-listp trueterms)
+                              (logic.sigma-listp sigmas)
+                              (logic.sigma-listp acc))))
+  (if (consp sigmas)
+      (rw.find-extensions-for-sigma-list hyp trueterms (cdr sigmas)
+                                         (rw.find-extensions-for-sigma hyp trueterms (car sigmas) acc))
+    acc))
+
+(defthm forcing-logic.sigma-listp-of-rw.find-extensions-for-sigma-list
+  (implies (force (and (logic.termp hyp)
+                       (logic.term-listp trueterms)
+                       (logic.sigma-listp sigmas)
+                       (logic.sigma-listp acc)))
+           (equal (logic.sigma-listp (rw.find-extensions-for-sigma-list hyp trueterms sigmas acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma-list))))
+
+(defthm forcing-logic.sigma-list-atblp-of-rw.find-extensions-for-sigma-list
+  (implies (force (and (logic.termp hyp)
+                       (logic.term-atblp hyp atbl)
+                       (logic.term-list-atblp trueterms atbl)
+                       (logic.sigma-list-atblp sigmas atbl)
+                       (logic.sigma-list-atblp acc atbl)))
+           (equal (logic.sigma-list-atblp (rw.find-extensions-for-sigma-list hyp trueterms sigmas acc) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma-list))))
+
+(defthm submap-of-eachp-of-rw.find-extensions-for-sigma-list
+  (implies (and (submap-of-eachp sig sigmas)
+                (submap-of-eachp sig acc))
+           (equal (submap-of-eachp sig (rw.find-extensions-for-sigma-list hyp trueterms sigmas acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-sigma-list))))
+
+
+
+
+(defund rw.find-extensions-for-crit-hyps (hyps trueterms sigmas)
+  ;; - Hyps are the critical hyps we have not yet dealt with
+  ;; - Trueterms are the list of all the terms we "know" are true, and
+  ;; - Sigmas are a list of all the sigmas that work so far
+  ;;
+  ;; We try to find all the extensions of our sigmas which satisfy all these
+  ;; hyps.
+  (declare (xargs :guard (and (logic.term-listp hyps)
+                              (logic.term-listp trueterms)
+                              (logic.sigma-listp sigmas))))
+  (if (consp hyps)
+      (let ((new-sigmas (rw.find-extensions-for-sigma-list (car hyps) trueterms sigmas nil)))
+        (if new-sigmas
+            (rw.find-extensions-for-crit-hyps (cdr hyps) trueterms new-sigmas)
+          ;; None of the sigmas could be extended to satisfy the first hyp.
+          ;; Well then, certainly none of them will satisfy all of our hyps.
+          nil))
+    sigmas))
+
+(defthm forcing-logic.sigma-listp-of-rw.find-extensions-for-crit-hyps
+  (implies (force (and (logic.term-listp hyps)
+                       (logic.term-listp trueterms)
+                       (logic.sigma-listp sigmas)))
+           (equal (logic.sigma-listp (rw.find-extensions-for-crit-hyps hyps trueterms sigmas))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-crit-hyps))))
+
+(defthm forcing-logic.sigma-list-atblp-of-rw.find-extensions-for-crit-hyps
+  (implies (force (and (logic.term-listp hyps)
+                       (logic.term-list-atblp hyps atbl)
+                       (logic.term-list-atblp trueterms atbl)
+                       (logic.sigma-list-atblp sigmas atbl)))
+           (equal (logic.sigma-list-atblp (rw.find-extensions-for-crit-hyps hyps trueterms sigmas) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-crit-hyps))))
+
+(defthm submap-of-eachp-of-rw.find-extensions-for-crit-hyps
+  (implies (submap-of-eachp sig sigmas)
+           (equal (submap-of-eachp sig (rw.find-extensions-for-crit-hyps hyps trueterms sigmas))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.find-extensions-for-crit-hyps))))
+
+
+
+
+(defund rw.create-sigmas-to-try (rule sigma trueterms)
+  ;; - Rule is the rewrite rule we are using.
+  ;; - Sigma is the partial substitution which unifies the target term with our rule's lhs.
+  ;; - Assms are the current assumptions.
+  ;;
+  ;; We create a list of all the sigmas we want to try matching with.
+  (declare (xargs :guard (and (rw.rulep rule)
+                              (logic.sigmap sigma)
+                              (logic.term-listp trueterms))))
+  (let ((crithyps (rw.rule->crithyps rule)))
+    (if crithyps
+        ;; There are crithyps so there are free variables to match.  Try to fill them in
+        ;; using the assms structure to make our guesses.
+        (rw.find-extensions-for-crit-hyps crithyps
+                                          trueterms
+                                          (list sigma))
+      ;; There are no crithyps so there are no freevars to match; we just try the
+      ;; sigma that matches the whole lhs.
+      (list sigma))))
+
+(defthm forcing-logic.sigma-listp-of-rw.create-sigmas-to-try
+  (implies (force (and (rw.rulep rule)
+                       (logic.sigmap sigma)
+                       (logic.term-listp trueterms)))
+           (equal (logic.sigma-listp (rw.create-sigmas-to-try rule sigma trueterms))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.create-sigmas-to-try))))
+
+(defthm forcing-logic.sigma-list-atblp-of-rw.create-sigmas-to-try
+  (implies (force (and (rw.rulep rule)
+                       (rw.rule-atblp rule atbl)
+                       (logic.sigma-atblp sigma atbl)
+                       (logic.term-listp trueterms)
+                       (logic.term-list-atblp trueterms atbl)))
+           (equal (logic.sigma-list-atblp (rw.create-sigmas-to-try rule sigma trueterms) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.create-sigmas-to-try))))
+
+(defthm submap-of-eachp-of-rw.create-sigmas-to-try
+  (equal (submap-of-eachp sigma (rw.create-sigmas-to-try rule sigma trueterms))
+         t)
+  :hints(("Goal" :in-theory (enable rw.create-sigmas-to-try))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/prop.lisp acl2-6.3/books/milawa/ACL2/rewrite/prop.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/prop.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/prop.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,72 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../build/prop")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defderiv rw.crewrite-twiddle-bldr
+  :derive (v B (v A C))
+  :from   ((proof x (v (v A B) C)))
+  :proof  (@derive
+           ((v (v A B) C)    (@given x))
+           ((v C (v A B))    (build.commute-or @-))
+           ((v (v C A) B)    (build.associativity @-))
+           ((v B (v C A))    (build.commute-or @-))
+           ((v B (v A C))    (build.disjoined-commute-or @-))))
+
+(defderiv rw.crewrite-twiddle2-lemma
+  :derive (v B (v (v C D) A))
+  :from   ((proof x (v (v (v A B) C) D)))
+  :proof  (@derive
+           ((v (v (v A B) C) D)    (@given x))
+           ((v D (v (v A B) C))    (build.commute-or @-))
+           ((v (v D (v A B)) C)    (build.associativity @-))
+           ((v C (v D (v A B)))    (build.commute-or @-))
+           ((v (v C D) (v A B))    (build.associativity @-))
+           ((v (v (v C D) A) B)    (build.associativity @-))
+           ((v B (v (v C D) A))    (build.commute-or @-))))
+
+(defderiv rw.crewrite-twiddle2-bldr
+  :derive (v (v B C) (v A D))
+  :from   ((proof x (v (v (v A B) C) D)))
+  :proof  (@derive
+           ((v (v (v A B) C) D)    (@given x))
+           ((v B (v (v C D) A))    (rw.crewrite-twiddle2-lemma @-))
+           ((v B (v C (v D A)))    (build.disjoined-right-associativity @-))
+           ((v (v B C) (v D A))    (build.associativity @-))
+           ((v (v B C) (v A D))    (build.disjoined-commute-or @-))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/rulep.lisp acl2-6.3/books/milawa/ACL2/rewrite/rulep.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/rulep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/rulep.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,452 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "evaluator") ;; why?
+(include-book "../clauses/basic")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Each hypothesis has a force-mode.  Here is what these modes mean:
+;;
+;;   - nil     never force it
+;;   - weak    force it unless it rewrites to nil (like ACL2)
+;;   - strong  force it no matter what it rewrites to
+
+(defund rw.force-modep (x)
+  (memberp x '(nil weak strong)))
+
+(defthm booleanp-of-rw.force-modep
+  (equal (booleanp (rw.force-modep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.force-modep))))
+
+
+
+;; A hypothesis is an aggregate of:
+;;
+;;   - A term which must be proven before the rule can be used,
+;;   - A force mode (described above),
+;;   - A limit flag that indicates if we should only search in a limited way
+;;     during the attempt to relieve this hyp, and
+;;   - A limit (if the limit flag is set) that indicates how much searching to
+;;     tolerate during the relief of this hyp.
+;;
+;; This may be expanded on in the future to support new features, so you should
+;; not assume that these are the only fields.
+
+(defaggregate rw.hyp
+  (term fmode limitp limit)
+  :require ((logic.termp-of-rw.hyp->term     (logic.termp term))
+            (rw.force-modep-of-rw.hyp->fmode (rw.force-modep fmode))
+            (booleanp-of-rw.hyp->limitp      (booleanp limitp))
+            (natp-of-rw.hyp->limit           (natp limit)))
+  :legiblep nil)
+
+(deflist rw.hyp-listp (x)
+  (rw.hypp x)
+  :elementp-of-nil nil)
+
+
+
+(definlined rw.hyp-atblp (x atbl)
+  (declare (xargs :guard (and (rw.hypp x)
+                              (logic.arity-tablep atbl))))
+  (logic.term-atblp (rw.hyp->term x) atbl))
+
+(defthm booleanp-of-rw.hyp-atblp
+  (equal (booleanp (rw.hyp-atblp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.hyp-atblp))))
+
+(defthm forcing-logic.term-atblp-of-rw.hyp
+  (implies (force (rw.hyp-atblp x atbl))
+           (equal (logic.term-atblp (rw.hyp->term x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hyp-atblp))))
+
+(defthm rw.hyp-atblp-of-rw.hyp
+  (implies (force (logic.term-atblp term atbl))
+           (equal (rw.hyp-atblp (rw.hyp term fmode limitp limit) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hyp-atblp))))
+
+(defthm rw.hyp-atblp-of-nil
+  (equal (rw.hyp-atblp nil atbl)
+         nil)
+  :hints(("Goal" :in-theory (enable rw.hyp-atblp))))
+
+(deflist rw.hyp-list-atblp (x atbl)
+  (rw.hyp-atblp x atbl)
+  :elementp-of-nil nil
+  :guard (and (rw.hyp-listp x)
+              (logic.arity-tablep atbl)))
+
+
+(defprojection :list (rw.hyp-list-terms x)
+               :element (rw.hyp->term x)
+               :guard (rw.hyp-listp x))
+
+(defthm forcing-logic.term-listp-of-rw.hyp-list-terms
+  (implies (force (rw.hyp-listp x))
+           (equal (logic.term-listp (rw.hyp-list-terms x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.hyp-list-terms
+  (implies (force (rw.hyp-list-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.hyp-list-terms x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+;; A rewrite rule is an aggregate of:
+;;
+;;   - A symbolic name which is used to identify the rule,
+;;   - A type that identifies what kind of rule it is.
+;;   - A list of hypotheses which govern when the rule can be used,
+;;   - A target term, lhs, which describes the terms we want to rewrite,
+;;   - A replacement term, rhs, which describes the result of rewriting,
+;;   - An equivalence relation that relates the lhs and rhs, i.e., "equal",
+;;   - A list of syntactic restrictions on the rule's application, and
+;;   - A list of "critical hyps" used in free-variable matching.
+;;
+;; This may be expanded on in the future to support new features, so you should
+;; not assume that these are the only fields.
+
+(defaggregate rw.rule
+  (name type hyps equiv lhs rhs syntax crithyps)
+  :require ((symbolp-of-rw.rule->name                (symbolp name))
+            (symbolp-of-rw.rule->type                (symbolp type))
+            (rw.hyp-listp-of-rw.rule->hyps           (rw.hyp-listp hyps))
+            (logic.function-namep-of-rw.rule->equiv  (logic.function-namep equiv))
+            (logic.termp-of-rw.rule->lhs             (logic.termp lhs))
+            (logic.termp-of-rw.rule->rhs             (logic.termp rhs))
+            (logic.term-listp-of-rw.rule->syntax     (logic.term-listp syntax))
+            ;; BOZO this is not named correctly
+            (subsetp-of-rw.rule->crithyps            (logic.term-listp crithyps))
+            )
+  :legiblep nil)
+
+(deflist rw.rule-listp (x)
+  (rw.rulep x)
+  :elementp-of-nil nil)
+
+(deflist rw.rule-list-listp (x)
+  (rw.rule-listp x)
+  :elementp-of-nil t)
+
+(defthm forcing-rw.rule-listp-of-simple-flatten
+  (implies (force (rw.rule-list-listp x))
+           (equal (rw.rule-listp (simple-flatten x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defund rw.rule-atblp (x atbl)
+  (declare (xargs :guard (and (rw.rulep x)
+                              (logic.arity-tablep atbl))))
+  (and (rw.hyp-list-atblp (rw.rule->hyps x) atbl)
+       (equal (cdr (lookup (rw.rule->equiv x) atbl)) 2)
+       (logic.term-atblp (rw.rule->lhs x) atbl)
+       (logic.term-atblp (rw.rule->rhs x) atbl)
+       (logic.term-list-atblp (rw.rule->crithyps x) atbl)
+       ;; We don't check syntax restrictions; they're only used to decide if
+       ;; the rule should be applied.
+       ))
+
+(defthm rw.rule-atblp-of-nil
+  (equal (rw.rule-atblp nil atbl)
+         nil)
+  :hints(("Goal" :in-theory (enable rw.rule-atblp))))
+
+(defthm booleanp-of-rw.rule-atblp
+  (equal (booleanp (rw.rule-atblp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.rule-atblp))))
+
+(defthm forcing-rw.hyp-list-atblp-of-rw.rule->hyps
+  (implies (force (rw.rule-atblp x atbl))
+           (equal (rw.hyp-list-atblp (rw.rule->hyps x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-atblp))))
+
+(defthm forcing-logic.term-atblp-of-rw.rule->lhs
+  (implies (force (rw.rule-atblp x atbl))
+           (equal (logic.term-atblp (rw.rule->lhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-atblp))))
+
+(defthm forcing-logic.term-atblp-of-rw.rule->rhs
+  (implies (force (rw.rule-atblp x atbl))
+           (equal (logic.term-atblp (rw.rule->rhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-atblp))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.rule->crithyps
+  (implies (force (rw.rule-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.rule->crithyps x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-atblp))))
+
+(defthm forcing-lookup-of-rw.rule-equiv
+  (implies (force (rw.rule-atblp x atbl))
+           (equal (lookup (rw.rule->equiv x) atbl)
+                  (cons (rw.rule->equiv x) 2)))
+  :hints(("Goal" :in-theory (enable rw.rule-atblp))))
+
+(defthm forcing-rw.rule-atblp-of-rw.rule
+  (implies (and (force (rw.hyp-list-atblp hyps atbl))
+                (force (equal (cdr (lookup equiv atbl)) 2))
+                (force (logic.term-atblp lhs atbl))
+                (force (logic.term-atblp rhs atbl))
+                (force (logic.term-list-atblp crithyps atbl)))
+           (equal (rw.rule-atblp (rw.rule name type hyps equiv lhs rhs syntax crithyps) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-atblp))))
+
+(deflist rw.rule-list-atblp (x atbl)
+  (rw.rule-atblp x atbl)
+  :guard (and (rw.rule-listp x)
+              (logic.arity-tablep atbl))
+  :elementp-of-nil nil)
+
+(deflist rw.rule-list-list-atblp (x atbl)
+  (rw.rule-list-atblp x atbl)
+  :guard (and (rw.rule-list-listp x)
+              (logic.arity-tablep atbl))
+  :elementp-of-nil t)
+
+
+
+
+
+;; Interpreting rules as clauses/formulas.
+;;
+;; A rule loosely means "hyps imply (equiv lhs rhs)."  I have flip-flopped a
+;; bit on how to represent this as a formula, but now I prefer to represent it
+;; as a clause.  This makes it "compatible" with the tactic harness directly,
+;; rather than having to involve the formula compiler or anything like that.
+;; The clause for a rule is:
+;;
+;;   If there are no hyps:  (equiv lhs rhs)
+;;
+;;   If there are hyps:     (not hyp1) v ... v (not hypN) v (equiv lhs rhs)
+
+(defund rw.rule-clause (x)
+  (declare (xargs :guard (rw.rulep x)))
+  (let* ((hyps  (rw.rule->hyps x))
+         (equiv (rw.rule->equiv x))
+         (lhs   (rw.rule->lhs x))
+         (rhs   (rw.rule->rhs x)))
+    (fast-app (logic.negate-term-list (rw.hyp-list-terms hyps))
+              (list (logic.function equiv (list lhs rhs))))))
+
+(defthm consp-of-rw.rule-clause
+  (equal (consp (rw.rule-clause x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.rule-clause))))
+
+(defthm forcing-logic.term-listp-of-rw.rule-clause
+  (implies (force (rw.rulep x))
+           (equal (logic.term-listp (rw.rule-clause x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-clause))))
+
+(defthm forcing-logic.term-list-atbp-of-rw.rule-clause
+  (implies (force (and (rw.rule-atblp x atbl)
+                       (rw.rulep x)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-list-atblp (rw.rule-clause x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-clause))))
+
+(defthm forcing-rw.rule-clause-when-no-hyps
+  (implies (not (rw.rule->hyps x))
+           (equal (rw.rule-clause x)
+                  (list (logic.function (rw.rule->equiv x)
+                                        (list (rw.rule->lhs x)
+                                              (rw.rule->rhs x))))))
+  :hints(("Goal" :in-theory (enable rw.rule-clause))))
+
+
+
+(defprojection :list (rw.rule-list-clauses x)
+               :element (rw.rule-clause x)
+               :guard (rw.rule-listp x))
+
+(defthm cons-listp-of-rw.rule-list-clauses
+  (equal (cons-listp (rw.rule-list-clauses x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-listp-of-rw.rule-list-clauses
+  (implies (force (rw.rule-listp x))
+           (equal (logic.term-list-listp (rw.rule-list-clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atbp-of-rw.rule-list-clauses
+  (implies (force (and (rw.rule-list-atblp x atbl)
+                       (rw.rule-listp x)
+                       (equal (cdr (lookup 'not atbl)) 1)))
+           (equal (logic.term-list-list-atblp (rw.rule-list-clauses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defprojection
+  :list (rw.rule-list-lhses x)
+  :element (rw.rule->lhs x)
+  :guard (rw.rule-listp x))
+
+(defthm forcing-logic.term-listp-of-rw.rule-list-lhses
+  (implies (force (rw.rule-listp x))
+           (equal (logic.term-listp (rw.rule-list-lhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.rule-list-lhses
+  (implies (force (rw.rule-list-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.rule-list-lhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defprojection
+  :list (rw.rule-list-names x)
+  :element (rw.rule->name x)
+  :guard (rw.rule-listp x))
+
+(defthm forcing-symbol-listp-of-rw.rule-list-names
+  (implies (force (rw.rule-listp x))
+           (equal (symbol-listp (rw.rule-list-names x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(definlined rw.rule-env-okp (x thms)
+  (declare (xargs :guard (and (rw.rulep x)
+                              (logic.formula-listp thms))))
+  (memberp (clause.clause-formula (rw.rule-clause x)) thms))
+
+(defthm booleanp-of-rw.rule-env-okp
+  (equal (booleanp (rw.rule-env-okp x thms))
+         t)
+  :hints(("Goal" :in-theory (enable rw.rule-env-okp))))
+
+
+(deflist rw.rule-list-env-okp (x thms)
+  (rw.rule-env-okp x thms)
+  :guard (and (rw.rule-listp x)
+              (logic.formula-listp thms)))
+
+(deflist rw.rule-list-list-env-okp (x thms)
+  (rw.rule-list-env-okp x thms)
+  :guard (and (rw.rule-list-listp x)
+              (logic.formula-listp thms))
+  :elementp-of-nil t)
+
+
+
+
+
+
+
+(defund rw.rule-list-lookup (rulename rules)
+  (declare (xargs :guard (rw.rule-listp rules)))
+  (if (consp rules)
+      (if (equal (rw.rule->name (car rules)) rulename)
+          (car rules)
+        (rw.rule-list-lookup rulename (cdr rules)))
+    nil))
+
+(defthm rw.rule-list-lookup-when-not-consp
+  (implies (not (consp rules))
+           (equal (rw.rule-list-lookup rulename rules)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.rule-list-lookup))))
+
+(defthm rw.rule-list-lookup-of-cons
+  (equal (rw.rule-list-lookup rulename (cons rule rules))
+         (if (equal (rw.rule->name rule) rulename)
+             rule
+           (rw.rule-list-lookup rulename rules)))
+  :hints(("Goal" :in-theory (enable rw.rule-list-lookup))))
+
+(defthm rw.rulep-of-rw.rule-list-lookup
+  (implies (force (rw.rule-listp rules))
+           (equal (rw.rulep (rw.rule-list-lookup name rules))
+                  (if (rw.rule-list-lookup name rules)
+                      t
+                    nil)))
+  :hints(("Goal" :induct (cdr-induction rules))))
+
+(defthm rw.rule-atblp-of-rw.rule-list-lookup
+  (implies (force (rw.rule-list-atblp rules atbl))
+           (equal (rw.rule-atblp (rw.rule-list-lookup name rules) atbl)
+                  (if (rw.rule-list-lookup name rules)
+                      t
+                    nil)))
+  :hints(("Goal" :induct (cdr-induction rules))))
+
+(defthm rw.rule-env-okp-of-rw.rule-list-lookup
+  (implies (force (and (rw.rule-list-env-okp rules thms)
+                       (rw.rule-list-lookup name rules)))
+           (equal (rw.rule-env-okp (rw.rule-list-lookup name rules) thms)
+                  t))
+  :hints(("Goal" :induct (cdr-induction rules))))
+
+
+
+(defthm rw.rule-list-atblp-of-cdr-of-lookup
+  (implies (force (rw.rule-list-list-atblp (range map) atbl))
+           (rw.rule-list-atblp (cdr (lookup name map)) atbl))
+  :hints(("Goal" :induct (cdr-induction map))))
+
+(defthm rw.rule-list-env-okp-of-cdr-of-lookup
+  (implies (force (rw.rule-list-list-env-okp (range map) thms))
+           (rw.rule-list-env-okp (cdr (lookup name map)) thms))
+  :hints(("Goal" :induct (cdr-induction map))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/syntax-evaluator.lisp acl2-6.3/books/milawa/ACL2/rewrite/syntax-evaluator.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/syntax-evaluator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/syntax-evaluator.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,460 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "definitions")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+; The syntax evaluator is the same as the generic evaluator, except we don't
+; prove anything about it and it optimizes for logic.term-< and
+; logic.constantp.  Having logic.term-< built-in is particularly important
+; since we use that a lot in syntactically restricted rewrite rules, and it is
+; a very slow function that has to call the various counting routines, which we
+; want to have memoized, etc.
+
+(defund rewrite.syntaxp-arity-table ()
+  (declare (xargs :guard t))
+  '((logic.term-< . 2)
+    (logic.constantp . 1)
+    (if . 3)
+    (equal . 2)
+    (consp . 1)
+    (cons . 2)
+    (car . 1)
+    (cdr . 1)
+    (symbolp . 1)
+    (symbol-< . 2)
+    (natp . 1)
+    (< . 2)
+    (+ . 2)
+    (- . 2)))
+
+(defthm logic.arity-tablep-of-rewrite.syntaxp-arity-table
+  (equal (logic.arity-tablep (rewrite.syntaxp-arity-table))
+         t))
+
+(in-theory (disable (:executable-counterpart rewrite.syntaxp-arity-table)))
+
+
+
+(defund rewrite.syntaxp-base-evaluablep (x)
+  ;; We decide if a term is of the form (f c1 ... cn), where f is one of the
+  ;; base functions, c1...cn are constants, and the arity of f is n.
+  (declare (xargs :guard (logic.termp x)))
+  (and (logic.functionp x)
+       (let ((fn   (logic.function-name x))
+             (args (logic.function-args x)))
+         (let ((entry (lookup fn (rewrite.syntaxp-arity-table))))
+           (and entry
+                (logic.constant-listp args)
+                (tuplep (cdr entry) args))))))
+
+(defthm booleanp-of-rewrite.syntaxp-base-evaluablep
+  (equal (booleanp (rewrite.syntaxp-base-evaluablep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rewrite.syntaxp-base-evaluablep)
+                                 (forcing-lookup-of-logic.function-name
+                                  forcing-true-listp-of-logic.function-args)))))
+
+(defthm forcing-logic.functionp-when-rewrite.syntaxp-base-evaluablep
+  (implies (and (rewrite.syntaxp-base-evaluablep x)
+                (force (logic.termp x)))
+           (equal (logic.functionp x)
+                  t))
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-base-evaluablep))))
+
+(defthm logic.constant-listp-of-logic.function-args-when-rewrite.syntaxp-base-evaluablep
+  (implies (and (rewrite.syntaxp-base-evaluablep x)
+                (force (logic.termp x)))
+           (equal (logic.constant-listp (logic.function-args x))
+                  t))
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-base-evaluablep logic.function-args))))
+
+(defthm lookup-logic.function-name-in-rewrite.syntaxp-arity-table-when-rewrite.syntaxp-base-evaluablep
+  (implies (and (rewrite.syntaxp-base-evaluablep x)
+                (force (logic.termp x)))
+           (equal (lookup (logic.function-name x) (rewrite.syntaxp-arity-table))
+                  (cons (logic.function-name x)
+                        (len (logic.function-args x)))))
+  :hints(("Goal" :in-theory (e/d (rewrite.syntaxp-base-evaluablep)
+                                 (forcing-lookup-of-logic.function-name)))))
+
+(defthmd lemma-for-logic.term-atblp-when-rewrite.syntaxp-base-evaluablep
+  (implies (and (logic.function-namep fn)
+                (memberp fn (domain (rewrite.syntaxp-arity-table)))
+                (true-listp args)
+                (logic.constant-listp args)
+                (equal (len args) (cdr (lookup fn (rewrite.syntaxp-arity-table)))))
+           (equal (logic.term-atblp (logic.function fn args) (rewrite.syntaxp-arity-table))
+                  t)))
+
+(defthm logic.term-atblp-when-rewrite.syntaxp-base-evaluablep
+  (implies (and (rewrite.syntaxp-base-evaluablep term)
+                (force (logic.termp term)))
+           (equal (logic.term-atblp term (rewrite.syntaxp-arity-table))
+                  t))
+  :hints(("Goal"
+          :in-theory (enable rewrite.syntaxp-base-evaluablep
+                             lemma-for-logic.term-atblp-when-rewrite.syntaxp-base-evaluablep)
+          :use ((:instance lemma-for-logic.term-atblp-when-rewrite.syntaxp-base-evaluablep
+                            (fn (logic.function-name term))
+                            (args (logic.function-args term)))))))
+
+(defthm rewrite.syntaxp-base-evaluablep-when-preliminary-fn-applied-to-constants
+  (implies (and (logic.function-namep fn)
+                (memberp fn (domain (rewrite.syntaxp-arity-table)))
+                (true-listp args)
+                (logic.constant-listp args)
+                (equal (len args) (cdr (lookup fn (rewrite.syntaxp-arity-table)))))
+           (equal (rewrite.syntaxp-base-evaluablep (logic.function fn args))
+                  t))
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-base-evaluablep))))
+
+(defthm rewrite.syntaxp-base-evaluablep-of-logic.function-equal
+  (equal (rewrite.syntaxp-base-evaluablep (logic.function 'equal args))
+         (and (tuplep 2 args)
+              (logic.constant-listp args)))
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-base-evaluablep rewrite.syntaxp-arity-table))))
+
+
+
+(defund rewrite.syntaxp-base-evaluator (x)
+  ;; We run a base function on its arguments and return the result as a quoted
+  ;; constant (i.e., a logic.constantp).
+  (declare (xargs :guard (and (logic.termp x)
+                              (rewrite.syntaxp-base-evaluablep x))
+                  :guard-hints(("Goal" :in-theory (enable rewrite.syntaxp-base-evaluablep
+                                                          rewrite.syntaxp-arity-table)))))
+  (let ((fn   (logic.function-name x))
+        (vals (logic.unquote-list (logic.function-args x))))
+    (list 'quote
+          ;; yucky ec calls shouldn't be exported
+          (cond ((equal fn 'logic.term-<)    (ACL2::ec-call (logic.term-< (first vals) (second vals))))
+                ((equal fn 'logic.constantp) (ACL2::ec-call
+                                              (logic.constantp (first vals))))
+                ((equal fn 'if)              (if (first vals) (second vals) (third vals)))
+                ((equal fn 'equal)           (equal (first vals) (second vals)))
+                ((equal fn 'consp)           (consp (first vals)))
+                ((equal fn 'cons)            (cons (first vals) (second vals)))
+                ((equal fn 'car)             (car (first vals)))
+                ((equal fn 'cdr)             (cdr (first vals)))
+                ((equal fn 'symbolp)         (symbolp (first vals)))
+                ((equal fn 'symbol-<)        (symbol-< (first vals) (second vals)))
+                ((equal fn 'natp)            (natp (first vals)))
+                ((equal fn '<)               (< (first vals) (second vals)))
+                ((equal fn '+)               (+ (first vals) (second vals)))
+                ((equal fn '-)               (- (first vals) (second vals)))
+                ;((equal fn '*)           (* (first vals) (second vals)))
+                ;((equal fn 'expt)        (expt (first vals) (second vals)))
+                ;((equal fn 'floor)       (floor (first vals) (second vals)))
+                ;((equal fn 'mod)         (mod (first vals) (second vals)))
+                ;((equal fn 'bitwise-shl) (bitwise-shl (first vals) (second vals)))
+                ;((equal fn 'bitwise-shr) (bitwise-shr (first vals) (second vals)))
+                ;((equal fn 'bitwise-and) (bitwise-and (first vals) (second vals)))
+                ;((equal fn 'bitwise-or)  (bitwise-or (first vals) (second vals)))
+                ;((equal fn 'bitwise-xor) (bitwise-xor (first vals) (second vals)))
+                ;((equal fn 'bitwise-nth) (bitwise-xor (first vals) (second vals)))
+                (t nil)))))
+
+(defthm forcing-logic.constantp-of-rewrite.syntaxp-base-evaluator
+  (equal (logic.constantp (rewrite.syntaxp-base-evaluator term))
+         t)
+  :hints(("Goal" :in-theory (enable logic.initial-arity-table rewrite.syntaxp-base-evaluator))))
+
+(defthm forcing-logic.constantp-of-rewrite.syntaxp-base-evaluator-free
+  ;; BOZO move to base evaluator
+  (implies (equal free (rewrite.syntaxp-base-evaluator term))
+           (equal (logic.constantp free)
+                  t)))
+
+(defthm rewrite.syntaxp-base-evaluator-of-logic.function-equal
+  (equal (rewrite.syntaxp-base-evaluator (logic.function 'equal args))
+         (list 'quote (equal (logic.unquote (first args))
+                             (logic.unquote (second args)))))
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-base-evaluator))))
+
+
+
+(defund rewrite.flag-syntaxp-evaluator (flag x defs n)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (and (logic.termp x)
+                                       (logic.groundp x))
+                                (and (logic.term-listp x)
+                                     (logic.ground-listp x)))
+                              (definition-listp defs)
+                              (natp n))
+                  :measure (two-nats-measure n (rank x))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond
+       ((zp n)
+        (ACL2::prog2$ (ACL2::cw "Warning: insufficient n given to syntaxp-evaluator~%")
+                      nil))
+       ((logic.constantp x)
+        ;; SUCCESS: Constants evaluate to themselves.
+        x)
+       ((logic.variablep x)
+        ;; FAILURE: Not a ground term.
+        nil)
+       ((logic.functionp x)
+        (let ((name (logic.function-name x))
+              (args (logic.function-args x)))
+          (if (and (equal name 'if)
+                   (equal (len args) 3))
+              ;; "if" must be handled specially with lazy evaluation.
+              (let ((eval-test (rewrite.flag-syntaxp-evaluator 'term (first args) defs n)))
+                (and eval-test
+                     (if (logic.unquote eval-test)
+                         (rewrite.flag-syntaxp-evaluator 'term (second args) defs n)
+                       (rewrite.flag-syntaxp-evaluator 'term (third args) defs n))))
+            ;; other functions are eagerly evaluated.
+            (let ((eval-args (rewrite.flag-syntaxp-evaluator 'list args defs n)))
+              (and eval-args
+                   ;; eval-args is (t . ((quote val1) ... (quote valn)))
+                   (let* ((values     (cdr eval-args))
+                          (atbl-entry (lookup name (rewrite.syntaxp-arity-table))))
+                     (if atbl-entry
+                         ;; found a base function
+                         (and (equal (cdr atbl-entry) (len values))
+                              (rewrite.syntaxp-base-evaluator (logic.function name values)))
+
+                       ;; found a non-base function
+                       (let* ((def (definition-list-lookup name defs)))
+                         (and def
+                              (let ((formals (logic.function-args (logic.=lhs def)))
+                                    (body    (logic.=rhs def)))
+                                (and (equal (len formals) (len values))
+                                     (rewrite.flag-syntaxp-evaluator 'term
+                                                             (logic.substitute body (pair-lists formals values))
+                                                             defs (- n 1)))))))))))))
+       ((logic.lambdap x)
+        ;; Eagerly evaluate the arguments to a lambda, then substitute them into
+        ;; the lambda's body.
+        (let ((formals (logic.lambda-formals x))
+              (body    (logic.lambda-body x))
+              (actuals (logic.lambda-actuals x)))
+          (let ((eval-actuals (rewrite.flag-syntaxp-evaluator 'list actuals defs n)))
+            (and eval-actuals
+                 ;; eval-actuals is (t . ((quote val1) ... (quote valn)))
+                 (let ((values (cdr eval-actuals)))
+                   (rewrite.flag-syntaxp-evaluator 'term
+                                           (logic.substitute body (pair-lists formals values))
+                                           defs
+                                           (- n 1)))))))
+       (t
+        ;; FAILURE: cannot evaluate malformed terms
+        nil))
+    (if (consp x)
+        ;; Try to evaluate the first argument and then, recursively, the rest of
+        ;; the arguments.
+        (let ((first (rewrite.flag-syntaxp-evaluator 'term (car x) defs n))
+              (rest  (rewrite.flag-syntaxp-evaluator 'list (cdr x) defs n)))
+          (if (and first rest)
+              ;; SUCCESS: evaluated the first and all other arguments.
+              (cons t (cons first (cdr rest)))
+            ;; FAILURE: couldn't evaluate some argument.
+            nil))
+      ;; SUCCESS: the empty list can always be evaluted.
+      (cons t nil))))
+
+(defund rewrite.syntaxp-evaluator (x defs n)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.groundp x)
+                              (definition-listp defs)
+                              (natp n))
+                  :verify-guards nil))
+  (rewrite.flag-syntaxp-evaluator 'term x defs n))
+
+(defund rewrite.syntaxp-evaluator-list (x defs n)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.ground-listp x)
+                              (definition-listp defs)
+                              (natp n))
+                  :verify-guards nil))
+  (rewrite.flag-syntaxp-evaluator 'list x defs n))
+
+(defthmd definition-of-rewrite.syntaxp-evaluator
+  (equal (rewrite.syntaxp-evaluator x defs n)
+         (cond
+          ((zp n)
+           ;; FAILURE: Insufficient "n" to evaluate this term.
+           nil)
+          ((logic.constantp x)
+           ;; SUCCESS: Constants evaluate to themselves.
+           x)
+          ((logic.variablep x)
+           ;; FAILURE: Not a ground term.
+           nil)
+          ((logic.functionp x)
+           (let ((name (logic.function-name x))
+                 (args (logic.function-args x)))
+             (if (and (equal name 'if)
+                      (equal (len args) 3))
+                 ;; "if" must be handled specially with lazy evaluation.
+                 (let ((eval-test (rewrite.syntaxp-evaluator (first args) defs n)))
+                   (and eval-test
+                        (if (logic.unquote eval-test)
+                            (rewrite.syntaxp-evaluator (second args) defs n)
+                          (rewrite.syntaxp-evaluator (third args) defs n))))
+               ;; other functions are eagerly evaluated.
+               (let ((eval-args (rewrite.syntaxp-evaluator-list args defs n)))
+                 (and eval-args
+                      ;; eval-args is (t . ((quote val1) ... (quote valn)))
+                      (let ((values (cdr eval-args)))
+                        (if (lookup name (rewrite.syntaxp-arity-table))
+                            ;; found a base function
+                            (and (equal (cdr (lookup name (rewrite.syntaxp-arity-table))) (len values))
+                                 (rewrite.syntaxp-base-evaluator (logic.function name values)))
+                          ;; found a non-base function
+                          (let* ((def (definition-list-lookup name defs)))
+                            (and def
+                                 (let ((formals (logic.function-args (logic.=lhs def)))
+                                       (body    (logic.=rhs def)))
+                                   (and (equal (len formals) (len values))
+                                        (rewrite.syntaxp-evaluator (logic.substitute body (pair-lists formals values))
+                                                           defs (- n 1)))))))))))))
+          ((logic.lambdap x)
+           ;; Eagerly evaluate the arguments to a lambda, then substitute them into
+           ;; the lambda's body.
+           (let ((formals (logic.lambda-formals x))
+                 (body    (logic.lambda-body x))
+                 (actuals (logic.lambda-actuals x)))
+             (let ((eval-actuals (rewrite.syntaxp-evaluator-list actuals defs n)))
+               (and eval-actuals
+                    ;; eval-actuals is (t . ((quote val1) ... (quote valn)))
+                    (let ((values (cdr eval-actuals)))
+                      (rewrite.syntaxp-evaluator (logic.substitute body (pair-lists formals values)) defs (- n 1)))))))
+          (t
+           ;; FAILURE: cannot evaluate malformed terms
+           nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-evaluator
+                                    rewrite.syntaxp-evaluator-list
+                                    rewrite.flag-syntaxp-evaluator)
+          :expand (rewrite.flag-syntaxp-evaluator 'term x defs n))))
+
+(defthmd definition-of-rewrite.syntaxp-evaluator-list
+  (equal (rewrite.syntaxp-evaluator-list x defs n)
+         (if (consp x)
+             ;; Try to evaluate the first argument and then, recursively, the rest of
+             ;; the arguments.
+             (let ((first (rewrite.syntaxp-evaluator (car x) defs n))
+                   (rest  (rewrite.syntaxp-evaluator-list (cdr x) defs n)))
+               (if (and first rest)
+                   ;; SUCCESS: evaluated the first and all other arguments.
+                   (cons t (cons first (cdr rest)))
+                 ;; FAILURE: couldn't evaluate some argument.
+                 nil))
+           ;; SUCCESS: the empty list can always be evaluted.
+           (cons t nil)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-evaluator
+                                    rewrite.syntaxp-evaluator-list
+                                    rewrite.flag-syntaxp-evaluator))))
+
+(defthm rewrite.flag-syntaxp-evaluator-when-term
+  (equal (rewrite.flag-syntaxp-evaluator 'term x defs n)
+         (rewrite.syntaxp-evaluator x defs n))
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-evaluator))))
+
+(defthm rewrite.flag-syntaxp-evaluator-when-list
+  (equal (rewrite.flag-syntaxp-evaluator 'list x defs n)
+         (rewrite.syntaxp-evaluator-list x defs n))
+  :hints(("Goal" :in-theory (enable rewrite.syntaxp-evaluator-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rewrite.syntaxp-evaluator))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rewrite.syntaxp-evaluator-list))))
+
+(defthm rewrite.syntaxp-evaluator-list-when-not-consp
+  (implies (not (consp x))
+           (equal (rewrite.syntaxp-evaluator-list x defs n)
+                  (cons t nil)))
+  :hints(("Goal" :in-theory (enable definition-of-rewrite.syntaxp-evaluator-list))))
+
+(defthm rewrite.syntaxp-evaluator-list-of-cons
+  (equal (rewrite.syntaxp-evaluator-list (cons a x) defs n)
+         (if (and (rewrite.syntaxp-evaluator a defs n)
+                  (rewrite.syntaxp-evaluator-list x defs n))
+             (cons t
+                   (cons (rewrite.syntaxp-evaluator a defs n)
+                         (cdr (rewrite.syntaxp-evaluator-list x defs n))))
+           nil))
+  :hints(("Goal" :in-theory (enable definition-of-rewrite.syntaxp-evaluator-list))))
+
+(defthm true-listp-of-rewrite.syntaxp-evaluator-list
+  (equal (true-listp (rewrite.syntaxp-evaluator-list x defs n))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-len-of-cdr-of-rewrite.syntaxp-evaluator-list
+  (implies (force (rewrite.syntaxp-evaluator-list x defs n))
+           (equal (len (cdr (rewrite.syntaxp-evaluator-list x defs n)))
+                  (len x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-of-rewrite.syntaxp-evaluator-list
+  (equal (consp (rewrite.syntaxp-evaluator-list x defs n))
+         (if (rewrite.syntaxp-evaluator-list x defs n)
+             t
+           nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthms-flag
+  :shared-hyp (force (definition-listp defs))
+  :thms ((term forcing-logic.constantp-of-cdr-of-rewrite.syntaxp-evaluator
+               (implies (force (and (rewrite.syntaxp-evaluator x defs n)
+                                    (logic.termp x)))
+                        (equal (logic.constantp (rewrite.syntaxp-evaluator x defs n))
+                               t)))
+         (t forcing-logic.constant-listp-of-cdr-of-rewrite.syntaxp-evaluator-list
+            (implies (force (and (logic.term-listp x)
+                                 (rewrite.syntaxp-evaluator-list x defs n)))
+                     (equal (logic.constant-listp (cdr (rewrite.syntaxp-evaluator-list x defs n)))
+                            t))))
+  :hints (("Goal"
+           :in-theory (enable definition-of-rewrite.syntaxp-evaluator
+                              rewrite.flag-syntaxp-evaluator)
+           :expand ((rewrite.syntaxp-evaluator x defs n))
+           :induct (rewrite.flag-syntaxp-evaluator flag x defs n))))
+
+(verify-guards rewrite.flag-syntaxp-evaluator
+               :hints(("Goal" :in-theory (disable forcing-lookup-of-logic.function-name))))
+
+(verify-guards rewrite.syntaxp-evaluator)
+(verify-guards rewrite.syntaxp-evaluator-list)
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/test-evaluator.lsp acl2-6.3/books/milawa/ACL2/rewrite/test-evaluator.lsp
--- acl2-6.2/books/milawa/ACL2/rewrite/test-evaluator.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/test-evaluator.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,55 @@
+(in-package "MILAWA")
+(include-book "evaluator")
+(include-book "../builders/evaluator")
+
+(defconst *fib*
+  (pequal '(fib x)
+          '(if (zp x)
+               '1
+             (if (equal x '1)
+                 '1
+               (+ (fib (- x '1))
+                  (fib (- x '2)))))))
+
+(defconst *zp*
+  (pequal '(zp x)
+          '(if (natp x)
+               (equal x '0)
+             't)))
+
+(defconst *<=*
+  (pequal '(<= x y)
+          '(not (< y x))))
+
+(defconst *not*
+  (pequal '(not p)
+          '(if p 'nil 't)))
+
+(defconst *defs*
+  (list *fib* *zp* *<=* *not*))
+
+
+(ACL2::time$ (ACL2::prog2$ (generic-evaluator '(fib '19) *defs* 25) nil))      ;; 0.70 seconds
+(ACL2::time$ (ACL2::prog2$ (generic-evaluator-bldr '(fib '19) *defs* 25) nil)) ;; 9.66 seconds
+
+
+(conclusion (generic-evaluator-bldr '(fib '2) *defs* 25))
+(rank (generic-evaluator-bldr '(fib  '0) *defs* 25)) ;; 5,858
+(rank (generic-evaluator-bldr '(fib  '1) *defs* 25)) ;; 8,255
+(rank (generic-evaluator-bldr '(fib  '2) *defs* 25)) ;; 25,385         (originally 790 million)
+(rank (generic-evaluator-bldr '(fib  '5) *defs* 25)) ;; 137,753
+(rank (generic-evaluator-bldr '(fib '10) *defs* 25)) ;; 1,645,133
+(rank (generic-evaluator-bldr '(fib '15) *defs* 25)) ;; 18,358,208
+(rank (generic-evaluator-bldr '(fib '16) *defs* 25)) ;; 29,711,177
+(rank (generic-evaluator-bldr '(fib '17) *defs* 25)) ;; 48,080,657
+(rank (generic-evaluator-bldr '(fib '18) *defs* 25)) ;; 77,803,106
+(rank (generic-evaluator-bldr '(fib '19) *defs* 25)) ;; 125,895,035
+
+;; cons space exhausted (with 131,072 max pages)
+(rank (generic-evaluator-bldr '(fib '20) *defs* 25))
+
+;; (ACL2::trace$ (transitivity-of-pequal-bldr
+;;                :entry (list (equal (get-conclusion (first acl2::arglist))
+;;                                    (get-conclusion (second acl2::arglist))))
+;;                :exit nil))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/theory-arities.lisp acl2-6.3/books/milawa/ACL2/rewrite/theory-arities.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/theory-arities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/theory-arities.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,384 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "theoryp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+(defund rw.slow-hyp-arities (x)
+  (declare (xargs :guard (rw.hypp x)))
+  (logic.slow-term-arities (rw.hyp->term x)))
+
+(defund rw.hyp-arities (x acc)
+  (declare (xargs :guard (and (rw.hypp x)
+                              (true-listp acc))))
+  (logic.term-arities (rw.hyp->term x) acc))
+
+(defthm true-listp-of-rw.hyp-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.hyp-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hyp-arities))))
+
+(defthm rw.hyp-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.hyp-arities x acc)
+                  (app (rw.slow-hyp-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.hyp-arities
+                                    rw.slow-hyp-arities))))
+
+(defthm logic.slow-hyp-arities-correct
+  (implies (force (rw.hypp x))
+           (equal (logic.arities-okp (rw.slow-hyp-arities x) atbl)
+                  (rw.hyp-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.hyp-atblp x atbl)
+                   (rw.slow-hyp-arities x))
+          :in-theory (disable FORCING-LOGIC.TERM-ATBLP-OF-RW.HYP))))
+
+
+
+
+(defund rw.slow-hyp-list-arities (x)
+  (declare (xargs :guard (rw.hyp-listp x)))
+  (if (consp x)
+      ;; Reverse order gives us a tail call in the fast version
+      (app (rw.slow-hyp-list-arities (cdr x))
+           (rw.slow-hyp-arities (car x)))
+    nil))
+
+(defund rw.hyp-list-arities (x acc)
+  (declare (xargs :guard (and (rw.hyp-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.hyp-list-arities (cdr x)
+                           (rw.hyp-arities (car x) acc))
+    acc))
+
+(defthm true-listp-of-rw.hyp-list-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.hyp-list-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.hyp-list-arities))))
+
+(defthm rw.hyp-list-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.hyp-list-arities x acc)
+                  (app (rw.slow-hyp-list-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.hyp-list-arities
+                                    rw.slow-hyp-list-arities))))
+
+(defthm rw.slow-hyp-list-arities-correct
+  (implies (force (rw.hyp-listp x))
+           (equal (logic.arities-okp (rw.slow-hyp-list-arities x) atbl)
+                  (rw.hyp-list-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.hyp-list-atblp x atbl)
+                   (rw.slow-hyp-list-arities x)))))
+
+
+
+
+(defund rw.slow-rule-arities (x)
+  (declare (xargs :guard (rw.rulep x)))
+  (let* ((res (rw.slow-hyp-list-arities (rw.rule->hyps x)))
+         (res (app (list (cons (rw.rule->equiv x) 2))                   res))
+         (res (app (logic.slow-term-arities (rw.rule->lhs x))           res))
+         (res (app (logic.slow-term-arities (rw.rule->rhs x))           res))
+         (res (app (logic.slow-term-list-arities (rw.rule->crithyps x)) res)))
+    res))
+
+(defund rw.rule-arities (x acc)
+  (declare (xargs :guard (and (rw.rulep x)
+                              (true-listp acc))))
+  (let* ((acc (rw.hyp-list-arities (rw.rule->hyps x) acc))
+         (acc (cons (cons (rw.rule->equiv x) 2) acc))
+         (acc (logic.term-arities (rw.rule->lhs x) acc))
+         (acc (logic.term-arities (rw.rule->rhs x) acc)))
+    ;; BOZO why do we care about crithyps arities?
+    (logic.term-list-arities (rw.rule->crithyps x) acc)))
+
+(defthm true-listp-of-rw.rule-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.rule-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-arities))))
+
+(defthm rw.rule-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.rule-arities x acc)
+                  (app (rw.slow-rule-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.rule-arities
+                                    rw.slow-rule-arities))))
+
+(defthm rw.slow-rule-arities-correct
+  (implies (force (rw.rulep x))
+           (equal (logic.arities-okp (rw.slow-rule-arities x) atbl)
+                  (rw.rule-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.rule-atblp x atbl)
+                   (rw.slow-rule-arities x))
+          :in-theory (disable LOGIC.ARITIES-OKP-WHEN-SUBSETP-1
+                              LOGIC.ARITIES-OKP-WHEN-SUBSETP-2
+                              forcing-logic.term-list-atblp-of-rw.rule->crithyps
+                              forcing-logic.term-atblp-of-rw.rule->lhs
+                              forcing-logic.term-atblp-of-rw.rule->rhs
+                              forcing-lookup-of-rw.rule-equiv
+                              forcing-rw.hyp-list-atblp-of-rw.rule->hyps))))
+
+
+
+
+(defund rw.slow-rule-list-arities (x)
+  (declare (xargs :guard (rw.rule-listp x)))
+  (if (consp x)
+      ;; Reverse order gives us a tail call in the fast version
+      (app (rw.slow-rule-list-arities (cdr x))
+           (rw.slow-rule-arities (car x)))
+    nil))
+
+(defund rw.rule-list-arities (x acc)
+  (declare (xargs :guard (and (rw.rule-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.rule-list-arities (cdr x)
+                           (rw.rule-arities (car x) acc))
+    acc))
+
+(defthm true-listp-of-rw.rule-list-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.rule-list-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-list-arities))))
+
+(defthm rw.rule-list-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.rule-list-arities x acc)
+                  (app (rw.slow-rule-list-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.rule-list-arities
+                                    rw.slow-rule-list-arities))))
+
+(defthm rw.slow-rule-list-arities-correct
+  (implies (force (rw.rule-listp x))
+           (equal (logic.arities-okp (rw.slow-rule-list-arities x) atbl)
+                  (rw.rule-list-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.rule-list-atblp x atbl)
+                   (rw.slow-rule-list-arities x)))))
+
+
+
+
+
+(defund rw.slow-rule-list-list-arities (x)
+  (declare (xargs :guard (rw.rule-list-listp x)))
+  (if (consp x)
+      ;; Reverse order gives us a tail call in the fast version
+      (app (rw.slow-rule-list-list-arities (cdr x))
+           (rw.slow-rule-list-arities (car x)))
+    nil))
+
+(defund rw.rule-list-list-arities (x acc)
+  (declare (xargs :guard (and (rw.rule-list-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.rule-list-list-arities (cdr x)
+                           (rw.rule-list-arities (car x) acc))
+    acc))
+
+(defthm true-listp-of-rw.rule-list-list-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.rule-list-list-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.rule-list-list-arities))))
+
+(defthm rw.rule-list-list-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.rule-list-list-arities x acc)
+                  (app (rw.slow-rule-list-list-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.rule-list-list-arities
+                                    rw.slow-rule-list-list-arities))))
+
+(defthm rw.slow-rule-list-list-arities-correct
+  (implies (force (rw.rule-list-listp x))
+           (equal (logic.arities-okp (rw.slow-rule-list-list-arities x) atbl)
+                  (rw.rule-list-list-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.rule-list-list-atblp x atbl)
+                   (rw.slow-rule-list-list-arities x)))))
+
+
+
+
+
+(defund rw.slow-typed-rulemap-arities (x)
+  (declare (xargs :guard (rw.typed-rulemapp x)))
+  (if (consp x)
+      (app (rw.slow-typed-rulemap-arities (cdr x))
+           (rw.slow-rule-list-arities (cdr (car x))))
+    nil))
+
+(defund rw.typed-rulemap-arities (x acc)
+  (declare (xargs :guard (and (rw.typed-rulemapp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.typed-rulemap-arities (cdr x)
+                                (rw.rule-list-arities (cdr (car x))
+                                                      acc))
+    acc))
+
+(defthm true-listp-of-rw.typed-rulemap-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.typed-rulemap-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.typed-rulemap-arities))))
+
+(defthm rw.typed-rulemap-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.typed-rulemap-arities x acc)
+                  (app (rw.slow-typed-rulemap-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.typed-rulemap-arities
+                                    rw.slow-typed-rulemap-arities))))
+
+(defthm rw.slow-typed-rulemap-arities-correct
+  (implies (force (rw.typed-rulemapp x))
+           (equal (logic.arities-okp (rw.slow-typed-rulemap-arities x) atbl)
+                  (rw.rule-list-list-atblp (range x) atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.slow-typed-rulemap-arities x)))))
+
+
+
+
+(defund rw.slow-theory-arities (x)
+  (declare (xargs :guard (rw.theoryp x)))
+  (if (consp x)
+      (let* ((res (rw.slow-typed-rulemap-arities (rw.theory->rulemap x)))
+             (res (app (rw.slow-theory-arities (rw.theory->left x)) res))
+             (res (app (rw.slow-theory-arities (rw.theory->right x)) res)))
+        res)
+    nil))
+
+(defund rw.theory-arities (x acc)
+  (declare (xargs :guard (and (rw.theoryp x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (if (consp x)
+      (let* ((acc (rw.typed-rulemap-arities (rw.theory->rulemap x) acc))
+             (acc (rw.theory-arities (rw.theory->left x) acc)))
+        (rw.theory-arities (rw.theory->right x) acc))
+    acc))
+
+(defthm true-listp-of-rw.theory-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.theory-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.theory-arities))))
+
+(verify-guards rw.theory-arities)
+
+(defthm rw.theory-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.theory-arities x acc)
+                  (app (rw.slow-theory-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.theory-arities
+                                    rw.slow-theory-arities))))
+
+(defthm rw.slow-theory-arities-correct
+  (implies (force (rw.theoryp x))
+           (equal (logic.arities-okp (rw.slow-theory-arities x) atbl)
+                  (rw.theory-atblp x atbl)))
+  :hints(("Goal"
+          :expand ((rw.slow-theory-arities x)
+                   (rw.theory-atblp x atbl))
+          :in-theory (e/d (rw.slow-theory-arities)
+                          (logic.arities-okp-when-subsetp-1
+                           logic.arities-okp-when-subsetp-2
+                           forcing-rw.rule-list-list-atblp-of-of-range-of-rw.theory->rulemap
+                           forcing-theory-atblp-of-rw.theory->left
+                           forcing-theory-atblp-of-rw.theory->right)))))
+
+
+
+
+(defund rw.slow-theory-map-arities (x)
+  (declare (xargs :guard (rw.theory-mapp x)))
+  (if (consp x)
+      (app (rw.slow-theory-map-arities (cdr x))
+           (rw.slow-theory-arities (cdr (car x))))
+    nil))
+
+(defund rw.theory-map-arities (x acc)
+  (declare (xargs :guard (and (rw.theory-mapp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.theory-map-arities (cdr x)
+                              (rw.theory-arities (cdr (car x)) acc))
+    acc))
+
+(defthm true-listp-of-rw.theory-map-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (rw.theory-map-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.theory-map-arities))))
+
+(verify-guards rw.theory-map-arities)
+
+(defthm rw.theory-map-arities-removal
+  (implies (force (true-listp acc))
+           (equal (rw.theory-map-arities x acc)
+                  (app (rw.slow-theory-map-arities x) acc)))
+  :hints(("Goal" :in-theory (enable rw.theory-map-arities
+                                    rw.slow-theory-map-arities))))
+
+(defthm rw.slow-theory-map-arities-correct
+  (implies (force (rw.theory-mapp x))
+           (equal (logic.arities-okp (rw.slow-theory-map-arities x) atbl)
+                  (rw.theory-list-atblp (range x) atbl)))
+  :hints(("Goal"
+          :in-theory (e/d (rw.slow-theory-map-arities)
+                          (logic.arities-okp-when-subsetp-1
+                           logic.arities-okp-when-subsetp-2)))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/theoryp.lisp acl2-6.3/books/milawa/ACL2/rewrite/theoryp.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/theoryp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/theoryp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1732 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "rulep")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Theories.
+;;
+;; A theory represents a collection of rules.  The rules are stored in a search
+;; structure so that, given a term, we can quickly look up the rules which
+;; might apply to the term.
+;;
+;; The "public" functions for interfacing with theories are the following:
+;;
+;;    rw.theoryp         : any --> bool
+;;    rw.theory-atblp    : thy * atbl --> bool
+;;    rw.theory-env-okp  : thy * thms --> bool
+;;
+;;    rw.theory-insert      : rule * thy --> thy
+;;    rw.theory-delete      : rule * thy --> thy
+;;    rw.theory-insert-list : rulelist * thy --> thy
+;;    rw.theory-delete-list : rulelist * thy --> thy
+;;    rw.theory-union       : thy * thy --> thy
+;;    rw.theory-difference  : thy * thy --> thy
+;;
+;;    rw.theory-allrules : thy --> rulelist
+;;    rw.theory-lookup   : term * thy --> map of symbols to rulelists
+;;
+;;
+;; Theory construction is straightforward.  The empty theory is simply nil, and
+;; subsequent theories are built using the insert function.  Note that insert
+;; is smart enough not to add the same rule multiple times.  We also provide a
+;; delete function since "disabling" rules is often useful, and wrappers for
+;; inserting or deleting entire lists or theories of rules.
+;;
+;; The allrules function retrieves a list of all the rules in the theory.  This
+;; is a slow operation (we have to cons together all the rules) and should not
+;; normally be used by functions.  But it's useful when proving theorems about
+;; the theory, since it lets you say things like, "suppose all of the rules in
+;; the theory are theorems..."
+;;
+;; Finally, the most important operation is lookup, which takes a term we wish
+;; to rewrite as its input, and quickly throws away a lot of rules that can't
+;; possibly apply to this term.  The rules are returned in a map based upon
+;; their type, e.g., the map will look like:
+;;
+;;   ((inside . [list of potentially applicable inside-out rules])
+;;    (outside . [list of potentially applicable outside-in rules])
+;;    (... maybe other kinds of rules, in the future ...)
+;;    )
+;;
+;; It's my understanding that ACL2 uses a raw-lisp properly list lookup on the
+;; leading function symbol to achieve a similar effect.  In both systems, the
+;; rules returned by lookup don't necessarily match with the term you gave it,
+;; but you know for sure that other rules don't apply.  So, it's just a very
+;; cheap way to avoid trying to pattern-match your term against every single
+;; rule in the theory.  It's also implemented efficiently; it returns a pointer
+;; into the internals of the theory structure, so it doesn't have to do any
+;; consing.
+;;
+;; Future work.
+;;
+;; Orderedp recognizers.  Theories are intended to be ordered search trees.
+;; That is, the leading symbol for each node is intended to be greater than all
+;; the nodes on its left, and less than all the nodes on its right.  We tried
+;; to implement a fast orderedness check and prove it equivalent to a simpler
+;; version, but the equivalence proof was difficult so we have skipped that for
+;; now.
+;;
+;; Showing order-preservingness.  We have not shown that the insert and delete
+;; functions are order preserving, although this is obviously our intent.  If
+;; the tree is not ordered correctly, our lookup function may "miss" rules.  It
+;; would be nice to show that lookup retrieves all the rules with a compatible
+;; leading function symbol, but this is not crucial to using theories so we
+;; have skipped it for now.
+;;
+;; Rebalancing.  We have not implemented a rebalancing function, and our insert
+;; operation does nothing to maintain balance.  If the tree becoems severely
+;; unbalanced, our lookup operation may suffer a performance penalty.  But
+;; again this has not become a problem yet, so we have skipped it for now.
+;;
+;; Inspection.  It would be nice to have functions to inspect theories and
+;; print out summaries of what the theory contains.
+
+(defthmd alternate-trichotomy-of-symbol-<
+  ;; BOZO consider moving this to arithmetic
+  (implies (and (not (symbol-< a b))
+                (not (equal a b))
+                (force (symbolp a))
+                (force (symbolp b)))
+           (equal (symbol-< b a)
+                  t)))
+
+(defthmd all-equalp-removal
+  ;; BOZO consider moving this to utilities.
+  ;; This might break some things, but it might also be really good.
+  (equal (all-equalp a x)
+         (equal (list-fix x) (repeat a (len x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(local (in-theory (enable alternate-trichotomy-of-symbol-<
+                          all-equalp-removal)))
+
+
+
+
+(definlined rw.leading-symbol (x)
+  ;; We are going to group rules by "which function they are about".  We say
+  ;; the leading symbol for a function term is its outermost function symbol,
+  ;; e.g., "f" in (f ... (g ...) ...).
+  (declare (xargs :guard (logic.termp x)))
+  (if (logic.functionp x)
+      (logic.function-name x)
+    nil))
+
+(defprojection :list (rw.leading-symbol-list x)
+               :element (rw.leading-symbol x)
+               :guard (logic.term-listp x)
+               :nil-preservingp t)
+
+(defthm forcing-symbolp-of-rw.leading-symbol
+  (implies (force (logic.termp x))
+           (equal (symbolp (rw.leading-symbol x))
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.leading-symbol)
+                                 (forcing-lookup-of-logic.function-name)))))
+
+(defthm forcing-symbol-listp-of-rw.leading-symbol-list
+  (implies (force (logic.term-listp x))
+           (equal (symbol-listp (rw.leading-symbol-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defmap
+  :map (rw.typed-rulemapp x)
+  :key (symbolp x)
+  :val (rw.rule-listp x)
+  :key-list (symbol-listp x)
+  :val-list (rw.rule-list-listp x)
+  :val-of-nil t)
+
+
+
+
+
+(defund rw.rule-list-consistent-leading-symbolsp (name rules)
+  (declare (xargs :guard (rw.rule-listp rules)))
+  (if (consp rules)
+      (and (equal name (rw.leading-symbol (rw.rule->lhs (car rules))))
+           (rw.rule-list-consistent-leading-symbolsp name (cdr rules)))
+    t))
+
+(defthm rw.rule-list-consistent-leading-symbolsp-removal
+  (equal (rw.rule-list-consistent-leading-symbolsp name rules)
+         (all-equalp name (rw.leading-symbol-list (rw.rule-list-lhses rules))))
+  :hints(("Goal" :in-theory (enable rw.rule-list-consistent-leading-symbolsp))))
+
+(defund rw.rulemap-consistent-leading-symbolsp (name rulemap)
+  (declare (xargs :guard (rw.typed-rulemapp rulemap)))
+  (if (consp rulemap)
+      (and (rw.rule-list-consistent-leading-symbolsp name (cdr (car rulemap)))
+           (rw.rulemap-consistent-leading-symbolsp name (cdr rulemap)))
+    t))
+
+(defthm rw.rulemap-consistent-leading-symbolsp-removal
+  (equal (rw.rulemap-consistent-leading-symbolsp name rulemap)
+         (all-equalp name
+                     (rw.leading-symbol-list
+                      (rw.rule-list-lhses
+                       (simple-flatten
+                        (range rulemap))))))
+  :hints(("Goal" :in-theory (e/d (rw.rulemap-consistent-leading-symbolsp)
+                                 (all-equalp-removal)))))
+
+
+(defsection rw.theroyp
+
+  (defund rw.theoryp (x)
+    ;; A theory is a search tree for rules.  Each theory is either empty,
+    ;; represented by nil, or is an aggregate of:
+    ;;
+    ;;  - Rules, a list of rules which agree on the leading symbol of their lhses,
+    ;;  - Name, the "leading symbol" that these rules agree upon,
+    ;;  - Left, recursively a rule finder for "smaller" rules, and
+    ;;  - Right, recursively a rule finder for "larger" rules.
+    ;;
+    ;; All the rules whose leading symbol is "f" are thrown into the same bucket,
+    ;; which then has to be linearly searched.
+    (declare (xargs :guard t))
+    (or (equal x nil)
+        (and (tuplep 4 x)
+             (let ((name     (first x))
+                   (left     (second x))
+                   (right    (third x))
+                   (rulemap (fourth x)))
+               (and (symbolp name)
+                    (rw.theoryp left)
+                    (rw.theoryp right)
+                    (rw.typed-rulemapp rulemap)
+                    (rw.rulemap-consistent-leading-symbolsp name rulemap))))))
+
+  (definlined rw.theory->name (x)
+    (declare (xargs :guard (rw.theoryp x)))
+    (first x))
+
+  (definlined rw.theory->left (x)
+    (declare (xargs :guard (rw.theoryp x)))
+    (second x))
+
+  (definlined rw.theory->right (x)
+    (declare (xargs :guard (rw.theoryp x)))
+    (third x))
+
+  (definlined rw.theory->rulemap (x)
+    (declare (xargs :guard (rw.theoryp x)))
+    (fourth x))
+
+  (definlined rw.theory (name left right rulemap)
+    (declare (xargs :guard (and (symbolp name)
+                                (rw.theoryp left)
+                                (rw.theoryp right)
+                                (rw.typed-rulemapp rulemap)
+                                (rw.rulemap-consistent-leading-symbolsp name rulemap))))
+    (list name left right rulemap))
+
+  (defthm booleanp-of-rw.theoryp
+    (equal (booleanp (rw.theoryp x))
+           t)
+    :hints(("Goal" :in-theory (enable rw.theoryp))))
+
+  (defthm consp-of-rw.theory
+    (equal (consp (rw.theory name left right rulemap))
+           t)
+    :hints(("Goal" :in-theory (enable rw.theory))))
+
+  (defthm rw.theory-under-iff
+    (iff (rw.theory name left right rulemap)
+         t)
+    :hints(("Goal" :in-theory (enable rw.theory))))
+
+  (defthm forcing-rw.theoryp-of-rw.theory
+    (implies (force (and (symbolp name)
+                         (rw.theoryp left)
+                         (rw.theoryp right)
+                         (rw.typed-rulemapp rulemap)
+                         (rw.rulemap-consistent-leading-symbolsp name rulemap)))
+             (equal (rw.theoryp (rw.theory name left right rulemap))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory rw.theoryp rw.theory->name))))
+
+  (defthm rw.theory->name-of-rw.theory
+    (equal (rw.theory->name (rw.theory name left right rulemap))
+           name)
+    :hints(("Goal" :in-theory (enable rw.theory rw.theory->name))))
+
+  (defthm rw.theory->left-of-rw.theory
+    (equal (rw.theory->left (rw.theory name left right rulemap))
+           left)
+    :hints(("Goal" :in-theory (enable rw.theory rw.theory->left))))
+
+  (defthm rw.theory->right-of-rw.theory
+    (equal (rw.theory->right (rw.theory name left right rulemap))
+           right)
+    :hints(("Goal" :in-theory (enable rw.theory rw.theory->right))))
+
+  (defthm rw.theory->rulemap-of-rw.theory
+    (equal (rw.theory->rulemap (rw.theory name left right rulemap))
+           rulemap)
+    :hints(("Goal" :in-theory (enable rw.theory rw.theory->rulemap))))
+
+  (defthm forcing-symbolp-of-rw.theory->name
+    (implies (force (rw.theoryp x))
+             (equal (symbolp (rw.theory->name x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theoryp rw.theory->name))))
+
+  (defthm forcing-theoryp-of-rw.theory->left
+    (implies (force (rw.theoryp x))
+             (equal (rw.theoryp (rw.theory->left x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theoryp rw.theory->left))))
+
+  (defthm forcing-theoryp-of-rw.theory->right
+    (implies (force (rw.theoryp x))
+             (equal (rw.theoryp (rw.theory->right x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theoryp rw.theory->right))))
+
+  (defthm forcing-rw.typed-rulemapp-of-rw.theory->rulemap
+    (implies (force (rw.theoryp x))
+             (equal (rw.typed-rulemapp (rw.theory->rulemap x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theoryp rw.theory->rulemap))))
+
+  (defthm forcing-leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-rw.theory->rulemap
+    (implies (force (rw.theoryp x))
+             (equal (rw.leading-symbol-list (rw.rule-list-lhses (simple-flatten (range (rw.theory->rulemap x)))))
+                    (repeat (rw.theory->name x) (len (simple-flatten (range (rw.theory->rulemap x)))))))
+    :hints(("Goal" :in-theory (enable rw.theoryp rw.theory->rulemap rw.theory->name))))
+
+  (defthm rank-of-rw.theory->left
+    (implies (consp x)
+             (< (rank (rw.theory->left x))
+                (rank x)))
+    :hints(("Goal" :in-theory (enable rw.theory->left))))
+
+  (defthm rank-of-rw.theory->right
+    (implies (consp x)
+             (< (rank (rw.theory->right x))
+                (rank x)))
+    :hints(("Goal" :in-theory (enable rw.theory->right))))
+
+  (defthm rw.theory->left-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.theory->left x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.theory->left))))
+
+  (defthm rw.theory->right-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.theory->right x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.theory->right)))))
+
+
+
+(defsection rw.theory-atblp
+
+  (defund rw.theory-atblp (x atbl)
+    ;; Check that every rule throughout the finder is a rule-atblp.
+    (declare (xargs :guard (and (rw.theoryp x)
+                                (logic.arity-tablep atbl))))
+    (if (consp x)
+        (let ((left  (rw.theory->left x))
+              (right (rw.theory->right x))
+              (rulemap (rw.theory->rulemap x)))
+          (and (rw.rule-list-list-atblp (range rulemap) atbl)
+               (rw.theory-atblp left atbl)
+               (rw.theory-atblp right atbl)))
+      t))
+
+  (defthm booleanp-of-rw.theory-atblp
+    (equal (booleanp (rw.theory-atblp x atbl))
+           t)
+    :hints(("Goal" :in-theory (enable rw.theory-atblp))))
+
+  (defthm rw.theory-atblp-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.theory-atblp x atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-atblp))))
+
+  (defthm forcing-theory-atblp-of-rw.theory->left
+    (implies (force (rw.theory-atblp x atbl))
+             (equal (rw.theory-atblp (rw.theory->left x) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-atblp rw.theory->left))))
+
+  (defthm forcing-theory-atblp-of-rw.theory->right
+    (implies (force (rw.theory-atblp x atbl))
+             (equal (rw.theory-atblp (rw.theory->right x) atbl)
+                    t))
+    :hints(("Goal" :in-theory (e/d (rw.theory-atblp rw.theory->right)
+                                   (forcing-theory-atblp-of-rw.theory->left)))))
+
+  (defthm forcing-rw.rule-list-list-atblp-of-of-range-of-rw.theory->rulemap
+    (implies (force (rw.theory-atblp x atbl))
+             (equal (rw.rule-list-list-atblp (range (rw.theory->rulemap x)) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-atblp rw.theory->rulemap))))
+
+  (defthm forcing-rw.theory-atblp-of-rw.theory
+    (implies (force (and (rw.theory-atblp left atbl)
+                         (rw.theory-atblp right atbl)
+                         (rw.rule-list-list-atblp (range rules) atbl)))
+             (equal (rw.theory-atblp (rw.theory name left right rules) atbl)
+                    t))
+    :hints(("Goal" :in-theory (e/d (rw.theory-atblp)
+                                   ((:executable-counterpart acl2::force)))))))
+
+
+
+
+(defsection rw.theory-env-okp
+
+  (defund rw.theory-env-okp (x thms)
+    ;; Check that every rule throughout the finder is a rule-atblp.
+    (declare (xargs :guard (and (rw.theoryp x)
+                                (logic.formula-listp thms))))
+    (if (consp x)
+        (let ((left    (rw.theory->left x))
+              (right   (rw.theory->right x))
+              (rulemap (rw.theory->rulemap x)))
+          (and (rw.rule-list-list-env-okp (range rulemap) thms)
+               (rw.theory-env-okp left thms)
+               (rw.theory-env-okp right thms)))
+      t))
+
+  (defthm booleanp-of-rw.theory-env-okp
+    (equal (booleanp (rw.theory-env-okp x thms))
+           t)
+    :hints(("Goal" :in-theory (enable rw.theory-env-okp))))
+
+  (defthm rw.theory-env-okp-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.theory-env-okp x thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-env-okp))))
+
+  (defthm forcing-theory-env-okp-of-rw.theory->left
+    (implies (force (rw.theory-env-okp x thms))
+             (equal (rw.theory-env-okp (rw.theory->left x) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-env-okp rw.theory->left))))
+
+  (defthm forcing-theory-env-okp-of-rw.theory->right
+    (implies (force (rw.theory-env-okp x thms))
+             (equal (rw.theory-env-okp (rw.theory->right x) thms)
+                    t))
+    :hints(("Goal" :in-theory (e/d (rw.theory-env-okp rw.theory->right)
+                                   (forcing-theory-env-okp-of-rw.theory->left)))))
+
+  (defthm forcing-rw.rule-list-list-env-okp-of-range-of-rw.theory->rulemap
+    (implies (force (rw.theory-env-okp x thms))
+             (equal (rw.rule-list-list-env-okp (range (rw.theory->rulemap x)) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-env-okp rw.theory->rulemap))))
+
+  (defthm forcing-rw.theory-env-okp-of-rw.theory
+    (implies (force (and (rw.theory-env-okp left thms)
+                         (rw.theory-env-okp right thms)
+                         (rw.rule-list-list-env-okp (range rules) thms)))
+             (equal (rw.theory-env-okp (rw.theory name left right rules) thms)
+                    t))
+    :hints(("Goal" :in-theory (e/d (rw.theory-env-okp)
+                                   ((:executable-counterpart acl2::force)))))))
+
+
+
+
+
+;; BOZO misplaced.
+(defthm rw.rule-list-atblp-of-simple-flatten
+  (equal (rw.rule-list-atblp (simple-flatten x) atbl)
+         (rw.rule-list-list-atblp x atbl))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.rule-list-env-okp-of-simple-flatten
+  (equal (rw.rule-list-env-okp (simple-flatten x) thms)
+         (rw.rule-list-list-env-okp x thms))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defsection rw.theory-allrules
+
+  (defund rw.fast-theory-all-rules (x acc)
+    (declare (xargs :guard (and (rw.theoryp x)
+                                (true-listp acc))
+                    :verify-guards nil))
+    (if (consp x)
+        (let ((local-rules (fast-simple-flatten-of-range$ (rw.theory->rulemap x) nil)))
+          (rw.fast-theory-all-rules (rw.theory->left x)
+                                    (rw.fast-theory-all-rules (rw.theory->right x)
+                                                              (revappend local-rules acc))))
+      acc))
+
+  (defun rw.slow-theory-all-rules (x)
+    (declare (xargs :guard (rw.theoryp x)))
+    (if (consp x)
+        (app (rw.slow-theory-all-rules (rw.theory->left x))
+             (app (rw.slow-theory-all-rules (rw.theory->right x))
+                  (simple-flatten (range (rw.theory->rulemap x)))))
+      nil))
+
+  (definlined rw.theory-allrules (x)
+    ;; Make a list of all the rules in the finder.
+    (declare (xargs :guard (rw.theoryp x)
+                    :verify-guards nil))
+    (rw.fast-theory-all-rules x nil))
+
+  (defthm true-listp-of-rw.fast-theory-all-rules
+    (implies (force (true-listp acc))
+             (equal (true-listp (rw.fast-theory-all-rules x acc))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.fast-theory-all-rules))))
+
+  (verify-guards rw.fast-theory-all-rules)
+  (verify-guards rw.theory-allrules)
+
+  (defthmd lemma-for-definition-of-rw.theory-allrules
+    (implies (force (true-listp acc))
+             (equal (rw.fast-theory-all-rules x acc)
+                    (app (rw.slow-theory-all-rules x) acc)))
+    :hints(("Goal"
+            :in-theory (enable rw.fast-theory-all-rules
+                               rw.slow-theory-all-rules)
+            :induct (rw.fast-theory-all-rules x acc))))
+
+  (defthmd definition-of-rw.theory-allrules
+    (equal (rw.theory-allrules x)
+           (if (consp x)
+               (app (rw.theory-allrules (rw.theory->left x))
+                    (app (rw.theory-allrules (rw.theory->right x))
+                         (simple-flatten (range (rw.theory->rulemap x)))))
+             nil))
+    :rule-classes :definition
+    :hints(("Goal" :in-theory (enable rw.theory-allrules
+                                      rw.slow-theory-all-rules
+                                      lemma-for-definition-of-rw.theory-allrules
+                                      ))))
+
+  (defthm induction-for-rw.theory-allrules
+    t
+    :rule-classes ((:induction :corollary t
+                               :pattern (rw.theory-allrules x)
+                               :scheme (rw.slow-theory-all-rules x))))
+
+  (defthm rw.fast-theory-all-rules-elim
+    (implies (force (true-listp acc))
+             (equal (rw.fast-theory-all-rules x acc)
+                    (app (rw.theory-allrules x) acc)))
+    :hints(("Goal" :in-theory (enable rw.theory-allrules
+                                      lemma-for-definition-of-rw.theory-allrules))))
+
+  (ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.theory-allrules))))
+
+  (defthm forcing-true-listp-of-rw.theory-allrules
+    (implies (force (rw.theoryp x))
+             (equal (true-listp (rw.theory-allrules x))
+                    t))
+    :hints(("Goal" :in-theory (enable definition-of-rw.theory-allrules))))
+
+  (defthm forcing-rw.rule-listp-of-rw.theory-allrules
+    (implies (force (rw.theoryp x))
+             (equal (rw.rule-listp (rw.theory-allrules x))
+                    t))
+    :hints(("Goal" :in-theory (enable definition-of-rw.theory-allrules))))
+
+  (defthm forcing-rw.rule-listp-atblp-of-rw.theory-allrules
+    (implies (and (force (rw.theoryp x))
+                  (force (rw.theory-atblp x atbl)))
+             (equal (rw.rule-list-atblp (rw.theory-allrules x) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable definition-of-rw.theory-allrules))))
+
+  (defthm forcing-rw.rule-listp-env-okp-of-rw.theory-allrules
+    (implies (and (force (rw.theoryp x))
+                  (force (rw.theory-env-okp x thms)))
+             (equal (rw.rule-list-env-okp (rw.theory-allrules x) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable definition-of-rw.theory-allrules)))))
+
+
+
+
+(defsection rw.theory-lookup
+
+  (defund rw.theory-lookup-aux (goal x)
+    (declare (xargs :guard (and (symbolp goal)
+                                (rw.theoryp x))))
+    (if (consp x)
+        (let ((this (rw.theory->name x)))
+          (cond ((symbol-< goal this)
+                 (rw.theory-lookup-aux goal (rw.theory->left x)))
+                ((symbol-< this goal)
+                 (rw.theory-lookup-aux goal (rw.theory->right x)))
+                (t
+                 (rw.theory->rulemap x))))
+      nil))
+
+  (definlined rw.theory-lookup (term x)
+    ;; List all the rules that might apply to term.
+    ;;
+    ;; This is the main operation of a rule finder.  We cache the term's leading
+    ;; symbol, then perform a binary search and return the rules attached to this
+    ;; node.  This should be quite fast, since the search is tail recursive and
+    ;; we do not need to do any consing.
+    (declare (xargs :guard (and (logic.termp term)
+                                (rw.theoryp x))))
+    (rw.theory-lookup-aux (rw.leading-symbol term) x))
+
+  (defthm rw.theory-lookup-aux-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.theory-lookup-aux goal x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup-aux))))
+
+  (defthm forcing-rw.typed-rulemapp-of-rw.theory-lookup-aux
+    (implies (force (rw.theoryp x))
+             (equal (rw.typed-rulemapp (rw.theory-lookup-aux goal x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup-aux))))
+
+  (defthm forcing-rw.rule-list-list-atblp-of-range-of-rw.theory-lookup-aux
+    (implies (and (force (rw.theoryp x))
+                  (force (rw.theory-atblp x atbl)))
+             (equal (rw.rule-list-list-atblp (range (rw.theory-lookup-aux goal x)) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup-aux))))
+
+  (defthm forcing-rw.rule-list-list-env-okp-of-range-of-rw.theory-lookup-aux
+    (implies (and (force (rw.theoryp x))
+                  (force (rw.theory-env-okp x thms)))
+             (equal (rw.rule-list-list-env-okp (range (rw.theory-lookup-aux goal x)) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup-aux))))
+
+  (defthm rw.theory-lookup-aux-of-rw.theory
+    (equal (rw.theory-lookup-aux goal (rw.theory name left right rules))
+           (cond ((symbol-< goal name)
+                  (rw.theory-lookup-aux goal left))
+                 ((symbol-< name goal)
+                  (rw.theory-lookup-aux goal right))
+                 (t
+                  rules)))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup-aux))))
+
+  (defthm forcing-rw.typed-rulemapp-of-rw.theory-lookup
+    (implies (force (rw.theoryp x))
+             (equal (rw.typed-rulemapp (rw.theory-lookup term x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup))))
+
+  (defthm forcing-rw.rule-list-listp-atblp-of-range-of-rw.theory-lookup
+    (implies (and (force (rw.theoryp x))
+                  (force (rw.theory-atblp x atbl)))
+             (equal (rw.rule-list-list-atblp (range (rw.theory-lookup term x)) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup))))
+
+  (defthm forcing-rw.rule-list-list-env-okp-of-range-of-rw.theory-lookup
+    (implies (and (force (rw.theoryp x))
+                  (force (rw.theory-env-okp x thms)))
+             (equal (rw.rule-list-list-env-okp (range (rw.theory-lookup term x)) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup)))))
+
+
+
+(defsection rw.extend-typed-rulemap
+
+  (defund rw.extend-typed-rulemap (rule rulemap)
+    (declare (xargs :guard (and (rw.rulep rule)
+                                (rw.typed-rulemapp rulemap))))
+    (if (consp rulemap)
+        (let* ((entry (car rulemap))
+               (entry-type (car entry))
+               (entry-rules (cdr entry)))
+          (if (equal (rw.rule->type rule) entry-type)
+              ;; This is the proper row for this rule.  Add it only if it does
+              ;; not already exist.
+              (if (memberp rule entry-rules)
+                  rulemap
+                (cons (cons entry-type (cons rule entry-rules))
+                      (cdr rulemap)))
+            ;; Not the proper row yet.  Keep looking.
+            (cons entry (rw.extend-typed-rulemap rule (cdr rulemap)))))
+      ;; Out of rows.  Create a new row for this type.
+      (list (cons (rw.rule->type rule)
+                  (list rule)))))
+
+  (defthm forcing-rw.typed-rulemapp-of-rw.extend-typed-rulemap
+    (implies (force (and (rw.rulep rule)
+                         (rw.typed-rulemapp rulemap)))
+             (equal (rw.typed-rulemapp (rw.extend-typed-rulemap rule rulemap))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.extend-typed-rulemap))))
+
+  (defthm forcing-rw.rule-list-list-atblp-of-range-of-rw.extend-typed-rulemap
+    (implies (force (and (rw.rulep rule)
+                         (rw.typed-rulemapp rulemap)
+                         (rw.rule-atblp rule atbl)
+                         (rw.rule-list-list-atblp (range rulemap) atbl)))
+             (equal (rw.rule-list-list-atblp (range (rw.extend-typed-rulemap rule rulemap)) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.extend-typed-rulemap))))
+
+  (defthm forcing-rw.rule-list-list-env-okp-of-range-of-rw.extend-typed-rulemap
+    (implies (force (and (rw.rulep rule)
+                         (rw.typed-rulemapp rulemap)
+                         (rw.rule-env-okp rule thms)
+                         (rw.rule-list-list-env-okp (range rulemap) thms)))
+             (equal (rw.rule-list-list-env-okp (range (rw.extend-typed-rulemap rule rulemap)) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.extend-typed-rulemap))))
+
+  (defthm lemma-for-forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-rw.extend-typed-rulemap
+    (implies (all-equalp (rw.leading-symbol (rw.rule->lhs rule))
+                         (rw.leading-symbol-list
+                          (rw.rule-list-lhses
+                           (simple-flatten
+                            (range rulemap)))))
+             (all-equalp (rw.leading-symbol (rw.rule->lhs rule))
+                         (rw.leading-symbol-list
+                          (rw.rule-list-lhses
+                           (simple-flatten
+                            (range (rw.extend-typed-rulemap rule rulemap)))))))
+    :rule-classes nil
+    :hints(("Goal" :in-theory (e/d (rw.extend-typed-rulemap)
+                                   (all-equalp-removal)))))
+
+  (defthm forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-rw.extend-typed-rulemap
+    (implies (force (all-equalp (rw.leading-symbol (rw.rule->lhs rule))
+                                (rw.leading-symbol-list
+                                 (rw.rule-list-lhses
+                                  (simple-flatten
+                                   (range rulemap))))))
+             (equal (rw.leading-symbol-list
+                     (rw.rule-list-lhses
+                      (simple-flatten
+                       (range (rw.extend-typed-rulemap rule rulemap)))))
+                    (repeat (rw.leading-symbol (rw.rule->lhs rule))
+                            (len (simple-flatten
+                                  (range (rw.extend-typed-rulemap rule rulemap)))))))
+    :hints(("Goal"
+            :use ((:instance lemma-for-forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-rw.extend-typed-rulemap)))))
+
+  (defthm rw.extend-typed-rulemap-of-nil
+    (equal (rw.extend-typed-rulemap rule nil)
+           (list (cons (rw.rule->type rule)
+                       (list rule))))
+    :hints(("Goal" :in-theory (enable rw.extend-typed-rulemap)))))
+
+
+
+(defsection rw.theory-insert
+
+  (defund rw.theory-insert-aux (goal rule x)
+    (declare (xargs :guard (and (rw.rulep rule)
+                                (equal goal (rw.leading-symbol (rw.rule->lhs rule)))
+                                (rw.theoryp x))
+                    :verify-guards nil))
+    (if (consp x)
+        (let ((name    (rw.theory->name x))
+              (left    (rw.theory->left x))
+              (right   (rw.theory->right x))
+              (rulemap (rw.theory->rulemap x)))
+          (cond ((symbol-< goal name)
+                 (rw.theory name (rw.theory-insert-aux goal rule left) right rulemap))
+                ((symbol-< name goal)
+                 (rw.theory name left (rw.theory-insert-aux goal rule right) rulemap))
+                (t
+                 (rw.theory name left right (rw.extend-typed-rulemap rule rulemap)))))
+      (rw.theory goal nil nil (rw.extend-typed-rulemap rule nil))))
+
+  (definlined rw.theory-insert (rule x)
+    ;; Add a rule to the finder.
+    (declare (xargs :guard (and (rw.rulep rule)
+                                (rw.theoryp x))
+                    :verify-guards nil))
+    (rw.theory-insert-aux (rw.leading-symbol (rw.rule->lhs rule)) rule x))
+
+  (defthm rw.theory-insert-aux-under-iff
+    (iff (rw.theory-insert-aux goal rule x)
+         t)
+    :hints(("Goal" :in-theory (enable rw.theory-insert-aux))))
+
+  (defthm lemma-for-forcing-rw.theoryp-of-rw.theory-insert-aux
+    (implies (and (rw.rulep rule)
+                  (rw.theoryp x)
+                  (equal goal (rw.leading-symbol (rw.rule->lhs rule))))
+             (and (rw.theoryp (rw.theory-insert-aux goal rule x))
+                  (equal (rw.theory->name (rw.theory-insert-aux goal rule x))
+                         (if (consp x)
+                             (rw.theory->name x)
+                           goal))))
+    :rule-classes nil
+    :hints(("Goal"
+            :in-theory (enable rw.theory-insert-aux)
+            :induct (rw.theory-insert-aux goal rule x))))
+
+  (defthm forcing-rw.theoryp-of-rw.theory-insert-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theoryp (rw.theory-insert-aux goal rule x))
+                    t))
+    :hints(("Goal" :use ((:instance lemma-for-forcing-rw.theoryp-of-rw.theory-insert-aux)))))
+
+  (defthm forcing-rw.theory-name-of-rw.theory-insert-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory->name (rw.theory-insert-aux goal rule x))
+                    (if (consp x)
+                        (rw.theory->name x)
+                      goal)))
+    :hints(("Goal" :use ((:instance lemma-for-forcing-rw.theoryp-of-rw.theory-insert-aux)))))
+
+  (verify-guards rw.theory-insert-aux)
+  (verify-guards rw.theory-insert)
+
+  (defthm forcing-rw.theory-atblp-of-rw.theory-insert-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.rule-atblp rule atbl))
+                  (force (rw.theoryp x))
+                  (force (rw.theory-atblp x atbl))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory-atblp (rw.theory-insert-aux goal rule x) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-insert-aux))))
+
+  (defthm forcing-rw.theory-env-okp-of-rw.theory-insert-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.rule-env-okp rule thms))
+                  (force (rw.theoryp x))
+                  (force (rw.theory-env-okp x thms))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory-env-okp (rw.theory-insert-aux goal rule x) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-insert-aux))))
+
+
+  (defthmd lemma-for-forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux
+    (implies (and (symbolp get-goal)
+                  (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal put-goal (rw.leading-symbol (rw.rule->lhs rule))))
+                  (not (equal put-goal get-goal)))
+             (equal (rw.theory-lookup-aux get-goal (rw.theory-insert-aux put-goal rule x))
+                    (rw.theory-lookup-aux get-goal x)))
+    :hints(("Goal"
+            :in-theory (enable rw.theory-lookup-aux
+                               rw.theory-insert-aux)
+            :induct (rw.theory-insert-aux put-goal rule x))))
+
+  (defthmd lemma-2-for-forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory-lookup-aux goal (rw.theory-insert-aux goal rule x))
+                    (rw.extend-typed-rulemap rule (rw.theory-lookup-aux goal x))))
+    :hints(("Goal"
+            :in-theory (enable rw.theory-lookup-aux
+                               rw.theory-insert-aux)
+            :induct (rw.theory-insert-aux goal rule x))))
+
+  (defthm forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux
+    (implies (and (force (symbolp get-goal))
+                  (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal put-goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory-lookup-aux get-goal (rw.theory-insert-aux put-goal rule x))
+                    (if (equal put-goal get-goal)
+                        (rw.extend-typed-rulemap rule (rw.theory-lookup-aux get-goal x))
+                      (rw.theory-lookup-aux get-goal x))))
+    :hints(("Goal"
+            :use ((:instance lemma-2-for-forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux (goal get-goal))
+                  (:instance lemma-for-forcing-rw.theory-lookup-aux-of-rw.theory-insert-aux)))))
+
+
+  (defthm forcing-rw.theoryp-of-rw.theory-insert
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.theoryp x)))
+             (equal (rw.theoryp (rw.theory-insert rule x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-insert))))
+
+  (defthm forcing-rw.theory-atblp-of-rw.theory-insert
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.rule-atblp rule atbl))
+                  (force (rw.theoryp x))
+                  (force (rw.theory-atblp x atbl)))
+             (equal (rw.theory-atblp (rw.theory-insert rule x) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-insert))))
+
+  (defthm forcing-rw.theory-env-okp-of-rw.theory-insert
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.rule-env-okp rule thms))
+                  (force (rw.theoryp x))
+                  (force (rw.theory-env-okp x thms)))
+             (equal (rw.theory-env-okp (rw.theory-insert rule x) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-insert))))
+
+  (defthm forcing-rw.theory-lookup-of-rw.theory-insert
+    (implies (and (force (logic.termp term))
+                  (force (rw.rulep rule))
+                  (force (rw.theoryp x)))
+             (equal (rw.theory-lookup term (rw.theory-insert rule x))
+                    (if (equal (rw.leading-symbol term)
+                               (rw.leading-symbol (rw.rule->lhs rule)))
+                        (rw.extend-typed-rulemap rule (rw.theory-lookup term x))
+                      (rw.theory-lookup term x))))
+    :hints(("Goal" :in-theory (enable rw.theory-insert rw.theory-lookup))))
+
+  (defthm forcing-subsetp-of-rw.theory-lookup-aux-and-rw.theory-allrules
+    (implies (force (rw.theoryp x))
+             (equal (subsetp (simple-flatten (range (rw.theory-lookup-aux goal x)))
+                             (rw.theory-allrules x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup-aux
+                                      definition-of-rw.theory-allrules))))
+
+  (defthm forcing-subsetp-of-rw.theory-lookup-and-rw.theory-allrules
+    (implies (force (rw.theoryp x))
+             (equal (subsetp (simple-flatten (range (rw.theory-lookup goal x)))
+                             (rw.theory-allrules x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-lookup)))))
+
+
+
+
+(defthm forcing-rw.typed-rulemapp-of-remove-all-from-ranges
+  (implies (force (rw.typed-rulemapp x))
+           (equal (rw.typed-rulemapp (remove-all-from-ranges a x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.rule-list-list-atblp-of-range-of-remove-all-from-ranges
+  (implies (force (and (rw.rulep rule)
+                       (rw.typed-rulemapp rulemap)
+                       (rw.rule-list-list-atblp (range rulemap) atbl)))
+           (equal (rw.rule-list-list-atblp (range (remove-all-from-ranges rule rulemap)) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction rulemap))))
+
+(defthm forcing-rw.rule-list-env-okp-of-range-of-remove-all-from-ranges
+  (implies (force (and (rw.rulep rule)
+                       (rw.typed-rulemapp rulemap)
+                       (rw.rule-list-list-env-okp (range rulemap) thms)))
+           (equal (rw.rule-list-list-env-okp (range (remove-all-from-ranges rule rulemap)) thms)
+                  t))
+  :hints(("Goal" :induct (cdr-induction rulemap))))
+
+
+
+(defthm lemma-for-forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-remove-all-from-ranges
+  (implies (all-equalp name (rw.leading-symbol-list
+                             (rw.rule-list-lhses
+                              (simple-flatten
+                               (range rulemap)))))
+           (all-equalp name (rw.leading-symbol-list
+                             (rw.rule-list-lhses
+                              (simple-flatten
+                               (range
+                                (remove-all-from-ranges rule rulemap)))))))
+  :rule-classes nil
+  :hints(("Goal"
+          :induct (cdr-induction rulemap)
+          :in-theory (disable all-equalp-removal))))
+
+(defthm forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-remove-all-from-ranges
+  (implies (all-equalp (rw.leading-symbol (rw.rule->lhs rule))
+                       (rw.leading-symbol-list
+                        (rw.rule-list-lhses
+                         (simple-flatten
+                          (range rulemap)))))
+           (equal (rw.leading-symbol-list
+                   (rw.rule-list-lhses
+                    (simple-flatten
+                     (range
+                      (remove-all-from-ranges rule rulemap)))))
+                  (repeat (rw.leading-symbol (rw.rule->lhs rule))
+                          (len (simple-flatten
+                                (range
+                                 (remove-all-from-ranges rule rulemap)))))))
+  :hints(("Goal"
+          :use ((:instance lemma-for-forcing-rw.leading-symbol-list-of-rw.rule-list-lhses-of-simple-flatten-of-range-of-remove-all-from-ranges
+                           (name (rw.leading-symbol (rw.rule->lhs rule))))))))
+
+
+
+(defsection rw.theory-delete
+
+  (defund rw.theory-delete-aux (goal rule x)
+    (declare (xargs :guard (and (rw.rulep rule)
+                                (equal goal (rw.leading-symbol (rw.rule->lhs rule)))
+                                (rw.theoryp x))
+                    :verify-guards nil))
+    (if (consp x)
+        (let ((name    (rw.theory->name x))
+              (left    (rw.theory->left x))
+              (right   (rw.theory->right x))
+              (rulemap (rw.theory->rulemap x)))
+          (cond ((symbol-< goal name)
+                 (rw.theory name (rw.theory-delete-aux goal rule left) right rulemap))
+                ((symbol-< name goal)
+                 (rw.theory name left (rw.theory-delete-aux goal rule right) rulemap))
+                (t
+                 ;; We could remove the node entirely if we remove all its rules,
+                 ;; but this seems easier.
+                 (rw.theory name left right (remove-all-from-ranges rule rulemap)))))
+      nil))
+
+  (definlined rw.theory-delete (rule x)
+    ;; Delete a rule from the finder.
+    (declare (xargs :guard (and (rw.rulep rule)
+                                (rw.theoryp x))
+                    :verify-guards nil))
+    (rw.theory-delete-aux (rw.leading-symbol (rw.rule->lhs rule)) rule x))
+
+  (defthm rw.theory-delete-aux-when-not-consp
+    (implies (not (consp x))
+             (equal (rw.theory-delete-aux goal rule x)
+                    nil))
+    :hints(("Goal" :in-theory (enable rw.theory-delete-aux))))
+
+  (defthm lemma-for-forcing-rw.theoryp-of-rw.theory-delete-aux
+    (implies (and (rw.rulep rule)
+                  (rw.theoryp x)
+                  (equal goal (rw.leading-symbol (rw.rule->lhs rule))))
+             (and (rw.theoryp (rw.theory-delete-aux goal rule x))
+                  (or (not (rw.theory-delete-aux goal rule x))
+                      (equal (rw.theory->name (rw.theory-delete-aux goal rule x))
+                             (rw.theory->name x)))))
+    :rule-classes nil
+    :hints(("Goal"
+            :in-theory (enable rw.theory-delete-aux)
+            :induct (rw.theory-delete-aux goal rule x))))
+
+  (defthm forcing-rw.theoryp-of-rw.theory-delete-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theoryp (rw.theory-delete-aux goal rule x))
+                    t))
+    :hints(("Goal" :use ((:instance lemma-for-forcing-rw.theoryp-of-rw.theory-delete-aux)))))
+
+  (defthm forcing-rw.theory-name-of-rw.theory-delete-aux
+    (implies (and (rw.theory-delete-aux goal rule x)
+                  (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory->name (rw.theory-delete-aux goal rule x))
+                    (rw.theory->name x)))
+    :hints(("Goal" :use ((:instance lemma-for-forcing-rw.theoryp-of-rw.theory-delete-aux)))))
+
+  (verify-guards rw.theory-delete-aux)
+  (verify-guards rw.theory-delete)
+
+  (defthm forcing-rw.theory-atblp-of-rw.theory-delete-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.rule-atblp rule atbl))
+                  (force (rw.theoryp x))
+                  (force (rw.theory-atblp x atbl))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory-atblp (rw.theory-delete-aux goal rule x) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-delete-aux))))
+
+  (defthm forcing-rw.theory-env-okp-of-rw.theory-delete-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.rule-env-okp rule thms))
+                  (force (rw.theoryp x))
+                  (force (rw.theory-env-okp x thms))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory-env-okp (rw.theory-delete-aux goal rule x) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-delete-aux))))
+
+  (defthmd lemma-for-forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux
+    (implies (and (symbolp get-goal)
+                  (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal put-goal (rw.leading-symbol (rw.rule->lhs rule))))
+                  (not (equal put-goal get-goal)))
+             (equal (rw.theory-lookup-aux get-goal (rw.theory-delete-aux put-goal rule x))
+                    (rw.theory-lookup-aux get-goal x)))
+    :hints(("Goal"
+            :in-theory (enable rw.theory-lookup-aux
+                               rw.theory-delete-aux)
+            :induct (rw.theory-delete-aux put-goal rule x)
+            :do-not-induct t)))
+
+  (defthmd lemma-2-for-forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory-lookup-aux goal (rw.theory-delete-aux goal rule x))
+                    (remove-all-from-ranges rule (rw.theory-lookup-aux goal x))))
+    :hints(("Goal"
+            :in-theory (enable rw.theory-lookup-aux
+                               rw.theory-delete-aux)
+            :induct (rw.theory-delete-aux goal rule x))))
+
+  (defthm forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux
+    (implies (and (force (symbolp get-goal))
+                  (force (rw.rulep rule))
+                  (force (rw.theoryp x))
+                  (force (equal put-goal (rw.leading-symbol (rw.rule->lhs rule)))))
+             (equal (rw.theory-lookup-aux get-goal (rw.theory-delete-aux put-goal rule x))
+                    (if (equal put-goal get-goal)
+                        (remove-all-from-ranges rule (rw.theory-lookup-aux get-goal x))
+                      (rw.theory-lookup-aux get-goal x))))
+    :hints(("Goal" :in-theory (enable lemma-2-for-forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux
+                                      lemma-for-forcing-rw.theory-lookup-aux-of-rw.theory-delete-aux))))
+
+  (defthm forcing-rw.theoryp-of-rw.theory-delete
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.theoryp x)))
+             (equal (rw.theoryp (rw.theory-delete rule x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-delete))))
+
+  (defthm forcing-rw.theory-atblp-of-rw.theory-delete
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.rule-atblp rule atbl))
+                  (force (rw.theoryp x))
+                  (force (rw.theory-atblp x atbl)))
+             (equal (rw.theory-atblp (rw.theory-delete rule x) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-delete))))
+
+  (defthm forcing-rw.theory-env-okp-of-rw.theory-delete
+    (implies (and (force (rw.rulep rule))
+                  (force (rw.rule-env-okp rule thms))
+                  (force (rw.theoryp x))
+                  (force (rw.theory-env-okp x thms)))
+             (equal (rw.theory-env-okp (rw.theory-delete rule x) thms)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-delete))))
+
+  (defthm forcing-rw.theory-lookup-of-rw.theory-delete
+    (implies (and (force (logic.termp term))
+                  (force (rw.rulep rule))
+                  (force (rw.theoryp x)))
+             (equal (rw.theory-lookup term (rw.theory-delete rule x))
+                    (if (equal (rw.leading-symbol term)
+                               (rw.leading-symbol (rw.rule->lhs rule)))
+                        (remove-all-from-ranges rule (rw.theory-lookup term x))
+                      (rw.theory-lookup term x))))
+    :hints(("Goal" :in-theory (enable rw.theory-delete rw.theory-lookup)))))
+
+
+
+
+(defsection rw.theory-insert-list
+
+  (defund rw.theory-insert-list (rules x)
+    (declare (xargs :guard (and (rw.rule-listp rules)
+                                (rw.theoryp x))))
+    (if (consp rules)
+        (rw.theory-insert-list (cdr rules)
+                               (rw.theory-insert (car rules) x))
+      x))
+
+  (defthm rw.theory-insert-list-when-not-consp
+    (implies (not (consp rules))
+             (equal (rw.theory-insert-list rules theory)
+                    theory))
+    :hints(("Goal" :in-theory (enable rw.theory-insert-list))))
+
+  (defthm rw.theory-insert-list-of-cons
+    (equal (rw.theory-insert-list (cons rule rules) theory)
+           (rw.theory-insert-list rules
+                                  (rw.theory-insert rule theory)))
+    :hints(("Goal" :in-theory (enable rw.theory-insert-list))))
+
+  (defthm forcing-rw.theoryp-of-rw.theory-insert-list
+    (implies (force (and (rw.rule-listp rules)
+                         (rw.theoryp x)))
+             (equal (rw.theoryp (rw.theory-insert-list rules x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-insert-list))))
+
+  (defthm forcing-rw.theory-atblp-of-rw.theory-insert-list
+    (implies (force (and (rw.theory-atblp theory atbl)
+                         (rw.rule-list-atblp rules atbl)
+                         (rw.theoryp theory)
+                         (rw.rule-listp rules)))
+             (equal (rw.theory-atblp (rw.theory-insert-list rules theory) atbl)
+                    t))
+    :hints(("Goal"
+            :induct (rw.theory-insert-list rules theory)
+            :in-theory (enable (:induction rw.theory-insert-list)))))
+
+  (defthm forcing-rw.theory-env-okp-of-rw.theory-insert-list
+    (implies (force (and (rw.theory-env-okp theory thms)
+                         (rw.rule-list-env-okp rules thms)
+                         (rw.theoryp theory)
+                         (rw.rule-listp rules)))
+             (equal (rw.theory-env-okp (rw.theory-insert-list rules theory) thms)
+                    t))
+    :hints(("Goal"
+            :induct (rw.theory-insert-list rules theory)
+            :in-theory (enable (:induction rw.theory-insert-list))))))
+
+
+
+
+(defsection rw.theory-delete-list
+
+  (defund rw.theory-delete-list (rules x)
+    (declare (xargs :guard (and (rw.rule-listp rules)
+                                (rw.theoryp x))))
+    (if (consp rules)
+        (rw.theory-delete-list (cdr rules)
+                               (rw.theory-delete (car rules) x))
+      x))
+
+  (defthm rw.theory-delete-list-when-not-consp
+    (implies (not (consp rules))
+             (equal (rw.theory-delete-list rules theory)
+                    theory))
+    :hints(("Goal" :in-theory (enable rw.theory-delete-list))))
+
+  (defthm rw.theory-delete-list-of-cons
+    (equal (rw.theory-delete-list (cons rule rules) theory)
+           (rw.theory-delete-list rules
+                                  (rw.theory-delete rule theory)))
+    :hints(("Goal" :in-theory (enable rw.theory-delete-list))))
+
+  (defthm forcing-rw.theoryp-of-rw.theory-delete-list
+    (implies (force (and (rw.rule-listp rules)
+                         (rw.theoryp x)))
+             (equal (rw.theoryp (rw.theory-delete-list rules x))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.theory-delete-list))))
+
+  (defthm forcing-rw.theory-atblp-of-rw.theory-delete-list
+    (implies (force (and (rw.theory-atblp theory atbl)
+                         (rw.rule-list-atblp rules atbl)
+                         (rw.theoryp theory)
+                         (rw.rule-listp rules)
+                         ))
+             (equal (rw.theory-atblp (rw.theory-delete-list rules theory) atbl)
+                    t))
+    :hints(("Goal"
+            :induct (rw.theory-delete-list rules theory)
+            :in-theory (enable (:induction rw.theory-delete-list)))))
+
+  (defthm forcing-rw.theory-env-okp-of-rw.theory-delete-list
+    (implies (force (and (rw.theory-env-okp theory thms)
+                         (rw.rule-list-env-okp rules thms)
+                         (rw.theoryp theory)
+                         (rw.rule-listp rules)))
+             (equal (rw.theory-env-okp (rw.theory-delete-list rules theory) thms)
+                    t))
+    :hints(("Goal"
+            :induct (rw.theory-delete-list rules theory)
+            :in-theory (enable (:induction rw.theory-delete-list))))))
+
+
+
+
+
+
+;; Never used, I think
+
+;; (definlined rw.theory-union (x y)
+;;   (declare (xargs :guard (and (rw.theoryp x)
+;;                               (rw.theoryp y))))
+;;   (rw.theory-insert-list (rw.theory-allrules y) x))
+
+;; (defthm forcing-rw.theoryp-of-rw.theory-union
+;;   (implies (force (and (rw.theoryp x)
+;;                        (rw.theoryp y)))
+;;            (equal (rw.theoryp (rw.theory-union x y))
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable rw.theory-union))))
+
+
+
+
+
+;; (definlined rw.theory-difference (x y)
+;;   (declare (xargs :guard (and (rw.theoryp x)
+;;                               (rw.theoryp y))))
+;;   (rw.theory-delete-list (rw.theory-allrules y) x))
+
+;; (defthm forcing-rw.theoryp-of-rw.theory-difference
+;;   (implies (force (and (rw.theoryp x)
+;;                        (rw.theoryp y)))
+;;            (equal (rw.theoryp (rw.theory-difference x y))
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable rw.theory-difference))))
+
+
+
+
+;; Hopefully not needed anymore.
+
+;; (defthm rw.rule-list-atblp-of-lookup-when-rw.rule-list-atblp-of-simple-flatten-of-range
+;;   (implies (rw.rule-list-atblp (simple-flatten (range rulemap)) atbl)
+;;            (equal (rw.rule-list-atblp (cdr (lookup type rulemap)) atbl)
+;;                   t))
+;;   :hints(("Goal" :induct (cdr-induction rulemap))))
+
+;; (defthm rw.rule-list-env-okp-of-lookup-when-rw.rule-list-atblp-of-simple-flatten-of-range
+;;   (implies (rw.rule-list-env-okp (simple-flatten (range rulemap)) thms)
+;;            (equal (rw.rule-list-env-okp (cdr (lookup type rulemap)) thms)
+;;                   t))
+;;   :hints(("Goal" :induct (cdr-induction rulemap))))
+
+
+
+
+
+
+(deflist rw.theory-listp (x)
+  (rw.theoryp x)
+  :guard t
+  :elementp-of-nil t)
+
+(deflist rw.theory-list-atblp (x atbl)
+  (rw.theory-atblp x atbl)
+  :guard (and (rw.theory-listp x)
+              (logic.arity-tablep atbl))
+  :elementp-of-nil t)
+
+(deflist rw.theory-list-env-okp (x thms)
+  (rw.theory-env-okp x thms)
+  :guard (and (rw.theory-listp x)
+              (logic.formula-listp thms))
+  :elementp-of-nil t)
+
+(defsection rw.theory-list-allrules
+
+  (defund rw.fast-theory-list-all-rules (x acc)
+    (declare (xargs :guard (and (rw.theory-listp x)
+                                (true-listp acc))
+                    :verify-guards nil))
+    (if (consp x)
+        (rw.fast-theory-all-rules (car x)
+                                  (rw.fast-theory-list-all-rules (cdr x) acc))
+      acc))
+
+  (defund rw.slow-theory-list-all-rules (x)
+    (declare (xargs :guard (rw.theory-listp x)))
+    (if (consp x)
+        (app (rw.theory-allrules (car x))
+             (rw.slow-theory-list-all-rules (cdr x)))
+      nil))
+
+  (defund rw.theory-list-allrules (x)
+    (declare (xargs :guard (rw.theory-listp x)
+                    :verify-guards nil))
+    (rw.fast-theory-list-all-rules x nil))
+
+  (defthm true-listp-of-rw.fast-theory-list-all-rules
+    (implies (force (true-listp acc))
+             (equal (true-listp (rw.fast-theory-list-all-rules x acc))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.fast-theory-list-all-rules))))
+
+  (verify-guards rw.fast-theory-list-all-rules)
+  (verify-guards rw.theory-list-allrules)
+
+  (defthmd lemma-for-definition-of-rw.theory-list-allrules
+    (implies (force (true-listp acc))
+             (equal (rw.fast-theory-list-all-rules x acc)
+                    (app (rw.slow-theory-list-all-rules x) acc)))
+    :hints(("Goal"
+            :in-theory (enable rw.fast-theory-list-all-rules
+                               rw.slow-theory-list-all-rules)
+            :induct (rw.fast-theory-list-all-rules x acc))))
+
+  (defthmd definition-of-rw.theory-list-allrules
+    (equal (rw.theory-list-allrules x)
+           (if (consp x)
+               (app (rw.theory-allrules (car x))
+                    (rw.theory-list-allrules (cdr x)))
+             nil))
+    :rule-classes :definition
+    :hints(("Goal" :in-theory (enable rw.theory-list-allrules
+                                      rw.slow-theory-list-all-rules
+                                      lemma-for-definition-of-rw.theory-list-allrules))))
+
+  (defthm rw.fast-theory-list-all-rules-elim
+    (implies (force (true-listp acc))
+             (equal (rw.fast-theory-list-all-rules x acc)
+                    (app (rw.theory-list-allrules x) acc)))
+    :hints(("Goal" :in-theory (enable rw.theory-list-allrules
+                                      lemma-for-definition-of-rw.theory-list-allrules))))
+
+  (ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.theory-list-allrules))))
+
+  (defthm forcing-true-listp-of-rw.theory-list-allrules
+    (equal (true-listp (rw.theory-list-allrules x))
+           t)
+    :hints(("Goal"
+            :in-theory (enable definition-of-rw.theory-list-allrules)
+            :induct (cdr-induction x))))
+
+  (defthm forcing-rw.rule-listp-of-rw.theory-list-allrules
+    (implies (force (rw.theory-listp x))
+             (equal (rw.rule-listp (rw.theory-list-allrules x))
+                    t))
+    :hints(("Goal"
+            :in-theory (enable definition-of-rw.theory-list-allrules)
+            :induct (cdr-induction x))))
+
+  (defthm forcing-rw.rule-listp-atblp-of-rw.theory-list-allrules
+    (implies (and (force (rw.theory-listp x))
+                  (force (rw.theory-list-atblp x atbl)))
+             (equal (rw.rule-list-atblp (rw.theory-list-allrules x) atbl)
+                    t))
+    :hints(("Goal"
+            :in-theory (enable definition-of-rw.theory-list-allrules)
+            :induct (cdr-induction x))))
+
+  (defthm forcing-rw.rule-listp-env-okp-of-rw.theory-list-allrules
+    (implies (and (force (rw.theory-listp x))
+                  (force (rw.theory-list-env-okp x thms)))
+             (equal (rw.rule-list-env-okp (rw.theory-list-allrules x) thms)
+                    t))
+    :hints(("Goal"
+            :in-theory (enable definition-of-rw.theory-list-allrules)
+            :induct (cdr-induction x)))))
+
+
+
+(defmap :map (rw.theory-mapp x)
+        :key (symbolp x)
+        :val (rw.theoryp x)
+        :key-list (symbol-listp x)
+        :val-list (rw.theory-listp x))
+
+(defthm rw.theory-mapp-of-clean-update
+  (implies (force (and (rw.theory-mapp map)
+                       (symbolp key)
+                       (rw.theoryp val)))
+           (equal (rw.theory-mapp (clean-update key val map))
+                  t))
+  :hints(("Goal"
+          :induct (clean-update key val map)
+          :in-theory (enable (:induction clean-update)))))
+
+
+
+(defund rw.theory-list-atblp-of-range (x atbl)
+  (declare (xargs :guard (and (rw.theory-mapp x)
+                              (logic.arity-tablep atbl))))
+  (if (consp x)
+      (and (rw.theory-atblp (cdr (car x)) atbl)
+           (rw.theory-list-atblp-of-range (cdr x) atbl))
+    t))
+
+(defthm rw.theory-list-atblp-of-range-removal
+  (equal (rw.theory-list-atblp-of-range x atbl)
+         (rw.theory-list-atblp (range x) atbl))
+  :hints(("Goal" :in-theory (enable rw.theory-list-atblp-of-range))))
+
+
+(defund rw.theory-list-env-okp-of-range (x thms)
+  (declare (xargs :guard (and (rw.theory-mapp x)
+                              (logic.formula-listp thms))))
+  (if (consp x)
+      (and (rw.theory-env-okp (cdr (car x)) thms)
+           (rw.theory-list-env-okp-of-range (cdr x) thms))
+    t))
+
+(defthm rw.theory-list-env-okp-of-range-removal
+  (equal (rw.theory-list-env-okp-of-range x thms)
+         (rw.theory-list-env-okp (range x) thms))
+  :hints(("Goal" :in-theory (enable rw.theory-list-env-okp-of-range))))
+
+
+
+
+
+
+
+
+(defund rw.slow-rule-list-thms (x)
+  (declare (xargs :guard (rw.rule-listp x)))
+  (if (consp x)
+      (app (rw.slow-rule-list-thms (cdr x))
+           (list (clause.clause-formula (rw.rule-clause (car x)))))
+    nil))
+
+(defund rw.rule-list-thms (x acc)
+  (declare (xargs :guard (and (rw.rule-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.rule-list-thms (cdr x)
+                         (cons (clause.clause-formula (rw.rule-clause (car x)))
+                               acc))
+    acc))
+
+(defthm true-listp-of-rw.rule-list-thms
+  (implies (force (true-listp acc))
+           (true-listp (rw.rule-list-thms x acc)))
+  :hints(("Goal" :in-theory (enable rw.rule-list-thms))))
+
+(defthm rw.rule-list-thms-removal
+  (implies (force (true-listp acc))
+           (equal (rw.rule-list-thms x acc)
+                  (app (rw.slow-rule-list-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable rw.rule-list-thms
+                                    rw.slow-rule-list-thms))))
+
+(defthm rw.slow-rule-list-thms-correct
+  (equal (subsetp (rw.slow-rule-list-thms x) thms)
+         (rw.rule-list-env-okp x thms))
+  :hints(("Goal"
+          :in-theory (e/d (rw.slow-rule-list-thms
+                           rw.rule-list-env-okp
+                           rw.rule-env-okp)))))
+
+
+
+
+(defund rw.slow-rule-list-list-thms (x)
+  (declare (xargs :guard (rw.rule-list-listp x)))
+  (if (consp x)
+      (app (rw.slow-rule-list-list-thms (cdr x))
+           (rw.slow-rule-list-thms (car x)))
+    nil))
+
+(defund rw.rule-list-list-thms (x acc)
+  (declare (xargs :guard (and (rw.rule-list-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.rule-list-list-thms (cdr x)
+                              (rw.rule-list-thms (car x) acc))
+    acc))
+
+(defthm true-listp-of-rw.rule-list-list-thms
+  (implies (force (true-listp acc))
+           (true-listp (rw.rule-list-list-thms x acc)))
+  :hints(("Goal" :in-theory (enable rw.rule-list-list-thms))))
+
+(defthm rw.rule-list-list-thms-removal
+  (implies (force (true-listp acc))
+           (equal (rw.rule-list-list-thms x acc)
+                  (app (rw.slow-rule-list-list-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable rw.rule-list-list-thms
+                                    rw.slow-rule-list-list-thms))))
+
+(defthm rw.slow-rule-list-list-thms-correct
+  (equal (subsetp (rw.slow-rule-list-list-thms x) thms)
+         (rw.rule-list-list-env-okp x thms))
+  :hints(("Goal"
+          :in-theory (e/d (rw.slow-rule-list-list-thms
+                           rw.rule-list-list-env-okp
+                           rw.rule-list-env-okp)))))
+
+
+
+
+
+
+(defund rw.slow-typed-rulemap-thms (x)
+  (declare (xargs :guard (rw.typed-rulemapp x)))
+  (if (consp x)
+      (app (rw.slow-typed-rulemap-thms (cdr x))
+           (rw.slow-rule-list-thms (cdr (car x))))
+    nil))
+
+(defund rw.typed-rulemap-thms (x acc)
+  (declare (xargs :guard (and (rw.typed-rulemapp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.typed-rulemap-thms (cdr x)
+                             (rw.rule-list-thms (cdr (car x)) acc))
+    acc))
+
+(defthm true-listp-of-rw.typed-rulemap-thms
+  (implies (force (true-listp acc))
+           (true-listp (rw.typed-rulemap-thms x acc)))
+  :hints(("Goal" :in-theory (enable rw.typed-rulemap-thms))))
+
+(defthm rw.typed-rulemap-thms-removal
+  (implies (force (true-listp acc))
+           (equal (rw.typed-rulemap-thms x acc)
+                  (app (rw.slow-typed-rulemap-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable rw.typed-rulemap-thms
+                                    rw.slow-typed-rulemap-thms))))
+
+(defthm rw.slow-typed-rulemap-thms-correct
+  (equal (subsetp (rw.slow-typed-rulemap-thms x) thms)
+         (rw.rule-list-list-env-okp (range x) thms))
+  :hints(("Goal"
+          :in-theory (e/d (rw.slow-typed-rulemap-thms
+                           rw.rule-list-list-env-okp)))))
+
+
+
+
+(defund rw.slow-theory-thms (x)
+  (declare (xargs :guard (rw.theoryp x)))
+  (if (consp x)
+      (let* ((res (rw.slow-typed-rulemap-thms (rw.theory->rulemap x)))
+             (res (app (rw.slow-theory-thms (rw.theory->left x)) res))
+             (res (app (rw.slow-theory-thms (rw.theory->right x)) res)))
+        res)
+    nil))
+
+(defund rw.theory-thms (x acc)
+  (declare (xargs :guard (and (rw.theoryp x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (if (consp x)
+      (let* ((acc (rw.typed-rulemap-thms (rw.theory->rulemap x) acc))
+             (acc (rw.theory-thms (rw.theory->left x) acc)))
+        (rw.theory-thms (rw.theory->right x) acc))
+    acc))
+
+(defthm true-listp-of-rw.theory-thms
+  (implies (force (true-listp acc))
+           (true-listp (rw.theory-thms x acc)))
+  :hints(("Goal" :in-theory (enable rw.theory-thms))))
+
+(verify-guards rw.theory-thms)
+
+(defthm rw.theory-thms-removal
+  (implies (force (true-listp acc))
+           (equal (rw.theory-thms x acc)
+                  (app (rw.slow-theory-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable rw.theory-thms
+                                    rw.slow-theory-thms))))
+
+(defthm rw.slow-theory-thms-correct
+  (equal (subsetp (rw.slow-theory-thms x) thms)
+         (rw.theory-env-okp x thms))
+  :hints(("Goal"
+          :in-theory (e/d (rw.slow-theory-thms
+                           rw.theory-env-okp)
+                          (forcing-theory-env-okp-of-rw.theory->left
+                           forcing-theory-env-okp-of-rw.theory->right
+                           forcing-rw.rule-list-list-env-okp-of-range-of-rw.theory->rulemap)))))
+
+
+
+
+(defund rw.slow-theory-list-thms (x)
+  (declare (xargs :guard (rw.theory-listp x)))
+  (if (consp x)
+      (app (rw.slow-theory-list-thms (cdr x))
+           (rw.slow-theory-thms (car x)))
+    nil))
+
+(defund rw.theory-list-thms (x acc)
+  (declare (xargs :guard (and (rw.theory-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.theory-list-thms (cdr x)
+                           (rw.theory-thms (car x) acc))
+    acc))
+
+(defthm true-listp-of-rw.theory-list-thms
+  (implies (force (true-listp acc))
+           (true-listp (rw.theory-list-thms x acc)))
+  :hints(("Goal" :in-theory (enable rw.theory-list-thms))))
+
+(defthm rw.theory-list-thms-removal
+  (implies (force (true-listp acc))
+           (equal (rw.theory-list-thms x acc)
+                  (app (rw.slow-theory-list-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable rw.theory-list-thms
+                                    rw.slow-theory-list-thms))))
+
+(defthm rw.slow-theory-list-thms-correct
+  (equal (subsetp (rw.slow-theory-list-thms x) thms)
+         (rw.theory-list-env-okp x thms))
+  :hints(("Goal"
+          :in-theory (e/d (rw.slow-theory-list-thms)))))
+
+
+
+
+(defund rw.slow-theory-map-thms (x)
+  (declare (xargs :guard (rw.theory-mapp x)))
+  (if (consp x)
+      (app (rw.slow-theory-map-thms (cdr x))
+           (rw.slow-theory-thms (cdr (car x))))
+    nil))
+
+(defund rw.theory-map-thms (x acc)
+  (declare (xargs :guard (and (rw.theory-mapp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (rw.theory-map-thms (cdr x)
+                          (rw.theory-thms (cdr (car x)) acc))
+    acc))
+
+(defthm true-listp-of-rw.theory-map-thms
+  (implies (force (true-listp acc))
+           (true-listp (rw.theory-map-thms x acc)))
+  :hints(("Goal" :in-theory (enable rw.theory-map-thms))))
+
+(defthm rw.theory-map-thms-removal
+  (implies (force (true-listp acc))
+           (equal (rw.theory-map-thms x acc)
+                  (app (rw.slow-theory-map-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable rw.theory-map-thms
+                                    rw.slow-theory-map-thms))))
+
+(defthm rw.slow-theory-map-thms-correct
+  (equal (subsetp (rw.slow-theory-map-thms x) thms)
+         (rw.theory-list-env-okp (range x) thms))
+  :hints(("Goal" :in-theory (e/d (rw.slow-theory-map-thms)))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/rewrite/traces/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/acl2-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/basic-builders.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/basic-builders.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/basic-builders.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/basic-builders.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1281 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(include-book "collect-forced-goals")
+(include-book "../controlp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defthmd booleanp-of-rw.trace->iffp
+  (implies (rw.tracep x)
+           (equal (booleanp (rw.trace->iffp x))
+                  t)))
+
+(ACL2::theory-invariant (ACL2::incompatible (:rewrite booleanp-of-rw.trace->iffp)
+                                            (:rewrite forcing-booleanp-of-rw.trace->iffp)))
+
+(local (in-theory (e/d (booleanp-of-rw.trace->iffp)
+                       (forcing-booleanp-of-rw.trace->iffp))))
+
+
+
+
+(defund rw.fail-trace (hypbox term iffp)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.termp term)
+                              (booleanp iffp))))
+  (rw.trace 'fail hypbox term term iffp nil nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.fail-trace)))
+
+ (defthm rw.trace->method-of-rw.fail-trace
+   (equal (rw.trace->method (rw.fail-trace hypbox term iffp))
+          'fail))
+
+ (defthm rw.trace->hypbox-of-rw.fail-trace
+   (equal (rw.trace->hypbox (rw.fail-trace hypbox term iffp))
+          hypbox))
+
+ (defthm rw.trace->lhs-of-rw.fail-trace
+   (equal (rw.trace->lhs (rw.fail-trace hypbox term iffp))
+          term))
+
+ (defthm rw.trace->rhs-of-rw.fail-trace
+   (equal (rw.trace->rhs (rw.fail-trace hypbox term iffp))
+          term))
+
+ (defthm rw.trace->iffp-of-rw.fail-trace
+   (equal (rw.trace->iffp (rw.fail-trace hypbox term iffp))
+          iffp))
+
+ (defthm rw.trace->subtraces-of-rw.fail-trace
+   (equal (rw.trace->subtraces (rw.fail-trace hypbox term iffp))
+          nil))
+
+ (defthm rw.trace->extras-of-rw.fail-trace
+   (equal (rw.trace->extras (rw.fail-trace hypbox term iffp))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.fail-trace
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.termp term)
+                        (booleanp iffp)))
+            (equal (rw.tracep (rw.fail-trace hypbox term iffp))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.fail-trace
+   (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                        (logic.term-atblp term atbl)))
+            (equal (rw.trace-atblp (rw.fail-trace hypbox term iffp) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.fail-trace)))
+
+ (defthm rw.fail-tracep-of-rw.fail-trace
+   (equal (rw.fail-tracep (rw.fail-trace hypbox term iffp))
+          t)
+   :hints(("Goal" :in-theory (enable rw.fail-tracep))))
+
+ (defthm rw.trace-step-okp-of-rw.fail-trace
+   (equal (rw.trace-step-okp (rw.fail-trace hypbox term iffp) defs)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp))))
+
+ (defthm rw.trace-step-env-okp-of-rw.fail-trace
+   (equal (rw.trace-step-env-okp (rw.fail-trace hypbox term iffp) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-okp-of-rw.fail-trace
+   (equal (rw.trace-okp (rw.fail-trace hypbox term iffp) defs)
+          t)
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.fail-trace
+   (equal (rw.trace-env-okp (rw.fail-trace hypbox term iffp) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-env-okp))))
+
+ (defthm rw.collect-forced-goals-of-rw.fail-trace
+   (equal (rw.collect-forced-goals (rw.fail-trace hypbox term iffp))
+          nil)
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+
+(defund rw.transitivity-trace (x y)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.tracep y)
+                              (equal (rw.trace->iffp x) (rw.trace->iffp y))
+                              (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                              (equal (rw.trace->rhs x) (rw.trace->lhs y)))))
+  ;; Historical note.  Originally I checked to see if x.lhs == y.rhs, and if so
+  ;; just used a fail trace.  Now I drop this optimization in favor of having
+  ;; consistent fgoals, which helps in the proof of the fast rewriter.
+  (let ((a     (rw.trace->lhs x))
+        (c     (rw.trace->rhs y))
+        (hypbox (rw.trace->hypbox x))
+        (iffp  (rw.trace->iffp x)))
+    (rw.trace 'transitivity hypbox a c iffp (list x y) nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.transitivity-trace)))
+
+ (defthm rw.transitivity-trace-under-iff
+   (iff (rw.transitivity-trace x y)
+        t))
+
+ (defthm rw.trace->method-of-rw.transitivity-trace
+   (equal (rw.trace->method (rw.transitivity-trace x y))
+          'transitivity))
+
+ (defthm rw.trace->hypbox-of-rw.transitivity-trace
+   (equal (rw.trace->hypbox (rw.transitivity-trace x y))
+          (rw.trace->hypbox x)))
+
+ (defthm rw.trace->lhs-of-rw.transitivity-trace
+   (equal (rw.trace->lhs (rw.transitivity-trace x y))
+          (rw.trace->lhs x)))
+
+ (defthm rw.trace->rhs-of-rw.transitivity-trace
+   (equal (rw.trace->rhs (rw.transitivity-trace x y))
+          (rw.trace->rhs y)))
+
+ (defthm rw.trace->iffp-of-rw.transitivity-trace
+   (equal (rw.trace->iffp (rw.transitivity-trace x y))
+          (rw.trace->iffp x)))
+
+ (defthm rw.trace->subtraces-of-rw.transitivity-trace
+   (equal (rw.trace->subtraces (rw.transitivity-trace x y))
+          (list x y)))
+
+ (defthm rw.trace->extras-of-rw.transitivity-trace
+   (equal (rw.trace->extras (rw.transitivity-trace x y))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.transitivity-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)))
+            (equal (rw.tracep (rw.transitivity-trace x y))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.transitivity-trace
+   (implies (force (and (rw.trace-atblp x atbl)
+                        (rw.trace-atblp y atbl)))
+            (equal (rw.trace-atblp (rw.transitivity-trace x y) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.transitivity-trace)))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.transitivity-trace
+   (implies (force (and (equal (rw.trace->iffp x) (rw.trace->iffp y))
+                        (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                        (equal (rw.trace->rhs x) (rw.trace->lhs y))))
+            (equal (rw.trace-step-okp (rw.transitivity-trace x y) defs)
+                   t))
+   :hints(("Goal"
+           :in-theory (enable rw.transitivity-tracep)
+           :expand (rw.trace-step-okp (rw.transitivity-trace x y) defs))))
+
+ (defthm forcing-rw.trace-okp-of-rw.transitivity-trace
+   (implies (force (and (equal (rw.trace->iffp x) (rw.trace->iffp y))
+                        (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                        (equal (rw.trace->rhs x) (rw.trace->lhs y))
+                        (rw.trace-okp x defs)
+                        (rw.trace-okp y defs)))
+            (equal (rw.trace-okp (rw.transitivity-trace x y) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.transitivity-trace x y) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.transitivity-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.transitivity-trace
+   (equal (rw.trace-step-env-okp (rw.transitivity-trace x y) defs thms atbl)
+          t)
+   :hints(("Goal"
+           :in-theory (enable rw.transitivity-tracep)
+           :expand (rw.trace-step-env-okp (rw.transitivity-trace x y) defs thms atbl))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.transitivity-trace
+   (implies (force (and (rw.trace-env-okp x defs thms atbl)
+                        (rw.trace-env-okp y defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.transitivity-trace x y) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand (rw.trace-env-okp (rw.transitivity-trace x y) defs thms atbl)
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.transitivity-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.transitivity-trace
+   (equal (rw.collect-forced-goals (rw.transitivity-trace x y))
+          (fast-merge (rw.collect-forced-goals x)
+                      (rw.collect-forced-goals y)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.equiv-by-args-trace (hypbox f iffp traces)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.function-namep f)
+                              (booleanp iffp)
+                              (rw.trace-listp traces)
+                              (all-equalp nil (rw.trace-list-iffps traces))
+                              (all-equalp hypbox (rw.trace-list-hypboxes traces)))))
+  (let ((lhses (rw.trace-list-lhses traces))
+        (rhses (rw.trace-list-rhses traces)))
+    (rw.trace 'equiv-by-args
+              hypbox
+              (logic.function f lhses)
+              (logic.function f rhses)
+              iffp
+              traces
+              nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.equiv-by-args-trace)))
+
+ (defthm lemma-rw.trace->method-of-rw.equiv-by-args-trace
+   (equal (rw.trace->method (rw.equiv-by-args-trace hypbox f iffp traces))
+          'equiv-by-args))
+
+ (defthm forcing-rw.trace->hypbox-of-rw.equiv-by-args-trace
+   (equal (rw.trace->hypbox (rw.equiv-by-args-trace hypbox f iffp traces))
+          hypbox))
+
+ (defthm forcing-rw.trace->lhs-of-rw.equiv-by-args-trace
+   (equal (rw.trace->lhs (rw.equiv-by-args-trace hypbox f iffp traces))
+          (logic.function f (rw.trace-list-lhses traces)))
+   :hints(("Goal" :in-theory (disable equal-of-logic.function-rewrite))))
+
+ (defthm forcing-rw.trace->rhs-of-rw.equiv-by-args-trace
+   (equal (rw.trace->rhs (rw.equiv-by-args-trace hypbox f iffp traces))
+          (logic.function f (rw.trace-list-rhses traces)))
+   :hints(("Goal" :in-theory (disable equal-of-logic.function-rewrite))))
+
+ (defthm rw.trace->iffp-of-rw.equiv-by-args-trace
+   (equal (rw.trace->iffp (rw.equiv-by-args-trace hypbox f iffp traces))
+          iffp))
+
+ (defthm rw.trace->subtraces-of-rw.equiv-by-args-trace
+   (equal (rw.trace->subtraces (rw.equiv-by-args-trace hypbox f iffp traces))
+          traces))
+
+ (defthm rw.trace->extras-of-rw.equiv-by-args-trace
+   (equal (rw.trace->extras (rw.equiv-by-args-trace hypbox f iffp traces))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.equiv-by-args-trace
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.function-namep f)
+                        (booleanp iffp)
+                        (rw.trace-listp traces)))
+            (equal (rw.tracep (rw.equiv-by-args-trace hypbox f iffp traces))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.equiv-by-args-trace
+   (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                        (logic.function-namep f)
+                        (equal (len traces) (cdr (lookup f atbl)))
+                        (rw.trace-list-atblp traces atbl)))
+            (equal (rw.trace-atblp (rw.equiv-by-args-trace hypbox f iffp traces) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.equiv-by-args-trace)))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.equiv-by-args-trace
+   (implies (force (and (logic.function-namep f)
+                        (all-equalp hypbox (rw.trace-list-hypboxes traces))
+                        (all-equalp nil (rw.trace-list-iffps traces))))
+            (equal (rw.trace-step-okp (rw.equiv-by-args-trace hypbox f iffp traces) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.equiv-by-args-tracep rw.trace-step-okp))))
+
+ (defthm forcing-rw.trace-okp-of-rw.equiv-by-args-trace
+   (implies (force (and (logic.function-namep f)
+                        (all-equalp hypbox (rw.trace-list-hypboxes traces))
+                        (all-equalp nil (rw.trace-list-iffps traces))
+                        (rw.trace-list-okp traces defs)))
+            (equal (rw.trace-okp (rw.equiv-by-args-trace hypbox f iffp traces) defs)
+                   t))
+   :hints(("Goal"
+           :in-theory (enable definition-of-rw.trace-okp
+                              lemma-forcing-rw.trace-step-okp-of-rw.equiv-by-args-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.equiv-by-args-trace
+   (equal (rw.trace-step-env-okp (rw.equiv-by-args-trace hypbox f iffp traces) defs thms abtl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.equiv-by-args-tracep rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.equiv-by-args-trace
+   (implies (force (rw.trace-list-env-okp traces defs thms atbl))
+            (equal (rw.trace-env-okp (rw.equiv-by-args-trace hypbox f iffp traces) defs thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-env-okp
+                                     lemma-forcing-rw.trace-step-env-okp-of-rw.equiv-by-args-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.equiv-by-args-trace
+   (equal (rw.collect-forced-goals (rw.equiv-by-args-trace hypbox f iffp traces))
+          (rw.collect-forced-goals-list traces))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.lambda-equiv-by-args-trace (hypbox formals body iffp traces)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (true-listp formals)
+                              (logic.variable-listp formals)
+                              (uniquep formals)
+                              (logic.termp body)
+                              (subsetp (logic.term-vars body) formals)
+                              (booleanp iffp)
+                              (rw.trace-listp traces)
+                              (all-equalp hypbox (rw.trace-list-hypboxes traces))
+                              (all-equalp nil (rw.trace-list-iffps traces))
+                              (equal (len traces) (len formals)))))
+  (let ((lhses (rw.trace-list-lhses traces))
+        (rhses (rw.trace-list-rhses traces)))
+    ; same rationale as before.
+    ;(if (equal lhses rhses)
+    ;    (rw.fail-trace hypbox (logic.lambda formals body lhses) iffp)
+    (rw.trace 'lambda-equiv-by-args
+              hypbox
+              (logic.lambda formals body lhses)
+              (logic.lambda formals body rhses)
+              iffp
+              traces
+              nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.lambda-equiv-by-args-trace)))
+
+ (defthm rw.trace->method-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.trace->method (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+          'lambda-equiv-by-args))
+
+ (defthm rw.trace->hypbox-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.trace->hypbox (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+          hypbox))
+
+ (defthm rw.trace->lhs-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.trace->lhs (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+          (logic.lambda formals body (rw.trace-list-lhses traces))))
+
+ (defthm rw.trace->rhs-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.trace->rhs (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+          (logic.lambda formals body (rw.trace-list-rhses traces))))
+
+ (defthm rw.trace->iffp-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.trace->iffp (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+          iffp))
+
+ (defthm rw.trace->subtraces-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.trace->subtraces (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+          traces))
+
+ (defthm rw.trace->extras-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.trace->extras (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.lambda-equiv-by-args-trace
+   (implies (force (and (rw.hypboxp hypbox)
+                        (true-listp formals)
+                        (logic.variable-listp formals)
+                        (uniquep formals)
+                        (logic.termp body)
+                        (subsetp (logic.term-vars body) formals)
+                        (booleanp iffp)
+                        (rw.trace-listp traces)
+                        (equal (len traces) (len formals))))
+            (equal (rw.tracep (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.lambda-equiv-by-args-trace
+   (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                        (logic.term-atblp body atbl)
+                        (rw.trace-list-atblp traces atbl)))
+            (equal (rw.trace-atblp (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.lambda-equiv-by-args-trace)))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.lambda-equiv-by-args-trace
+   (implies (force (and (all-equalp nil (rw.trace-list-iffps traces))
+                        (all-equalp hypbox (rw.trace-list-hypboxes traces))))
+            (equal (rw.trace-step-okp (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces) defs)
+                   t))
+   :hints(("Goal" :in-theory (e/d (rw.trace-step-okp
+                                   rw.lambda-equiv-by-args-tracep)
+                                  (forcing-logic.termp-of-logic.lambda)))))
+
+ (defthm forcing-rw.trace-okp-of-rw.lambda-equiv-by-args-trace
+   (implies (force (and (all-equalp nil (rw.trace-list-iffps traces))
+                        (all-equalp hypbox (rw.trace-list-hypboxes traces))
+                        (rw.trace-list-okp traces defs)))
+            (equal (rw.trace-okp (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-okp
+                                     lemma-forcing-rw.trace-step-okp-of-rw.lambda-equiv-by-args-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.trace-step-env-okp (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp rw.lambda-equiv-by-args-tracep))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.lambda-equiv-by-args-trace
+   (implies (force (rw.trace-list-env-okp traces defs thms atbl))
+            (equal (rw.trace-env-okp (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces) defs thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-env-okp
+                                     lemma-forcing-rw.trace-step-env-okp-of-rw.lambda-equiv-by-args-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.lambda-equiv-by-args-trace
+   (equal (rw.collect-forced-goals (rw.lambda-equiv-by-args-trace hypbox formals body iffp traces))
+          (rw.collect-forced-goals-list traces))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.beta-reduction-trace (hypbox term iffp)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.termp term)
+                              (logic.lambdap term)
+                              (booleanp iffp))))
+  (rw.trace 'beta-reduction
+            hypbox
+            term
+            (logic.substitute (logic.lambda-body term)
+                              (pair-lists (logic.lambda-formals term)
+                                          (logic.lambda-actuals term)))
+            iffp
+            nil
+            nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.beta-reduction-trace)))
+
+ (defthm rw.trace->method-of-rw.beta-reduction-trace
+   (equal (rw.trace->method (rw.beta-reduction-trace hypbox term iffp))
+          'beta-reduction))
+
+ (defthm rw.trace->hypbox-of-rw.beta-reduction-trace
+   (equal (rw.trace->hypbox (rw.beta-reduction-trace hypbox term iffp))
+          hypbox))
+
+ (defthm rw.trace->lhs-of-rw.beta-reduction-trace
+   (equal (rw.trace->lhs (rw.beta-reduction-trace hypbox term iffp))
+          term))
+
+ (defthm rw.trace->rhs-of-rw.beta-reduction-trace
+   (equal (rw.trace->rhs (rw.beta-reduction-trace hypbox term iffp))
+          (logic.substitute (logic.lambda-body term)
+                            (pair-lists (logic.lambda-formals term)
+                                        (logic.lambda-actuals term)))))
+
+ (defthm rw.trace->iffp-of-rw.beta-reduction-trace
+   (equal (rw.trace->iffp (rw.beta-reduction-trace hypbox term iffp))
+          iffp))
+
+ (defthm rw.trace->subtraces-of-rw.beta-reduction-trace
+   (equal (rw.trace->subtraces (rw.beta-reduction-trace hypbox term iffp))
+          nil))
+
+ (defthm rw.trace->extras-of-rw.beta-reduction-trace
+   (equal (rw.trace->extras (rw.beta-reduction-trace hypbox term iffp))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.beta-reduction-trace
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.termp term)
+                        (logic.lambdap term)
+                        (booleanp iffp)))
+            (equal (rw.tracep (rw.beta-reduction-trace hypbox term iffp))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.beta-reduction-trace
+   (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                        (logic.lambdap term)
+                        (logic.termp term)
+                        (logic.term-atblp term atbl)))
+            (equal (rw.trace-atblp (rw.beta-reduction-trace hypbox term iffp) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.beta-reduction-trace)))
+
+ (defthmd lemma-forcing-rw.beta-reduction-tracep-of-rw.beta-reduction-trace
+   (implies (force (logic.lambdap term))
+            (equal (rw.beta-reduction-tracep (rw.beta-reduction-trace hypbox term iffp))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.beta-reduction-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.beta-reduction-trace
+   (implies (force (logic.lambdap term))
+            (equal (rw.trace-step-okp (rw.beta-reduction-trace hypbox term iffp) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.beta-reduction-tracep-of-rw.beta-reduction-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.beta-reduction-trace
+   (implies (force (logic.lambdap term))
+            (equal (rw.trace-okp (rw.beta-reduction-trace hypbox term iffp) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-okp
+                                     lemma-forcing-rw.trace-step-okp-of-rw.beta-reduction-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.beta-reduction-trace
+   (equal (rw.trace-step-env-okp (rw.beta-reduction-trace hypbox term iffp) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.beta-reduction-trace
+   (equal (rw.trace-env-okp (rw.beta-reduction-trace hypbox term iffp) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-env-okp
+                                     lemma-forcing-rw.trace-step-env-okp-of-rw.beta-reduction-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.beta-reduction-trace
+   (equal (rw.collect-forced-goals (rw.beta-reduction-trace hypbox term iffp))
+          nil)
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.try-ground-simplify (hypbox x iffp control)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.termp x)
+                              (logic.groundp x)
+                              (booleanp iffp)
+                              (rw.controlp control))))
+  (if (and (logic.functionp x)
+           (memberp (logic.function-name x) (rw.control->noexec control)))
+      nil
+    (let* ((defs   (rw.control->defs control))
+           (depth  (rw.control->depth control))
+           (result (generic-evaluator x defs depth)))
+      (and result
+           (let ((real-result (if (and iffp (not (equal (logic.unquote result) nil)))
+                                  ''t
+                                result)))
+             (and (not (equal real-result x))
+                  (rw.trace 'ground hypbox x real-result iffp nil depth)))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.try-ground-simplify)))
+
+ (defthm rw.trace->method-of-rw.try-ground-simplify
+   (implies (force (rw.try-ground-simplify hypbox x iffp control))
+            (equal (rw.trace->method (rw.try-ground-simplify hypbox x iffp control))
+                   'ground)))
+
+ (defthm rw.trace->hypbox-of-rw.try-ground-simplify
+   (implies (force (rw.try-ground-simplify hypbox x iffp control))
+            (equal (rw.trace->hypbox (rw.try-ground-simplify hypbox x iffp control))
+                   hypbox)))
+
+ (defthm forcing-rw.trace->lhs-of-rw.try-ground-simplify
+   (implies (force (rw.try-ground-simplify hypbox x iffp control))
+            (equal (rw.trace->lhs (rw.try-ground-simplify hypbox x iffp control))
+                   x)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.try-ground-simplify
+   (implies (force (rw.try-ground-simplify hypbox x iffp control))
+            (equal (rw.trace->iffp (rw.try-ground-simplify hypbox x iffp control))
+                   iffp)))
+
+ (defthm rw.trace->subtraces-of-rw.try-ground-simplify
+   (implies (force (rw.try-ground-simplify hypbox x iffp control))
+            (equal (rw.trace->subtraces (rw.try-ground-simplify hypbox x iffp control))
+                   nil)))
+
+ (defthm forcing-rw.trace->extras-of-rw.try-ground-simplify
+   (implies (force (rw.try-ground-simplify hypbox x iffp control))
+            (equal (rw.trace->extras (rw.try-ground-simplify hypbox x iffp control))
+                   (rw.control->depth control))))
+
+ (defthmd lemma-forcing-logic.constantp-of-rw.trace->rhs
+   (implies (force (and (rw.try-ground-simplify hypbox x iffp control)
+                        (logic.termp x)
+                        (rw.controlp control)))
+            (equal (logic.constantp (rw.trace->rhs (rw.try-ground-simplify hypbox x iffp control)))
+                   t)))
+
+ (defthm forcing-rw.tracep-of-rw.try-ground-simplify
+   (implies (force (and (rw.try-ground-simplify hypbox x iffp control)
+                        (rw.hypboxp hypbox)
+                        (logic.termp x)
+                        (logic.groundp x)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.tracep (rw.try-ground-simplify hypbox x iffp control))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.try-ground-simplify
+   (implies (force (and (rw.try-ground-simplify hypbox x iffp control)
+                        (rw.hypbox-atblp hypbox atbl)
+                        (logic.term-atblp x atbl)
+                        (logic.termp x)
+                        (rw.controlp control)))
+            (equal (rw.trace-atblp (rw.try-ground-simplify hypbox x iffp control) atbl)
+                   t)))
+
+ (defthmd lemma-forcing-rw.ground-tracep-of-rw.try-ground-simplify
+   (implies (force (and (rw.try-ground-simplify hypbox x iffp control)
+                        (logic.groundp x)
+                        (rw.controlp control)))
+            (equal (rw.ground-tracep (rw.try-ground-simplify hypbox x iffp control)
+                                     (rw.control->defs control))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.ground-tracep))))
+
+ (local (in-theory (disable rw.try-ground-simplify)))
+ (local (in-theory (enable lemma-forcing-logic.constantp-of-rw.trace->rhs
+                           lemma-forcing-rw.ground-tracep-of-rw.try-ground-simplify)))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.try-ground-simplify
+   (implies (force (and (rw.try-ground-simplify hypbox x iffp control)
+                        (logic.groundp x)
+                        (rw.controlp control)))
+            (equal (rw.trace-step-okp (rw.try-ground-simplify hypbox x iffp control)
+                                      (rw.control->defs control))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp))))
+
+ (defthm forcing-rw.trace-okp-of-rw.try-ground-simplify
+   (implies (force (and (rw.try-ground-simplify hypbox x iffp control)
+                        (logic.groundp x)
+                        (rw.controlp control)))
+            (equal (rw.trace-okp (rw.try-ground-simplify hypbox x iffp control)
+                                 (rw.control->defs control))
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-okp
+                                     lemma-forcing-rw.trace-step-okp-of-rw.try-ground-simplify))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.try-ground-simplify
+   (implies (force (and (rw.try-ground-simplify hypbox x iffp control)
+                        (logic.groundp x)
+                        (rw.controlp control)
+                        (rw.control-atblp control atbl)))
+            (equal (rw.trace-step-env-okp (rw.try-ground-simplify hypbox x iffp control)
+                                          defs thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.try-ground-simplify
+   (implies (force (and (rw.try-ground-simplify hypbox x iffp control)
+                        (logic.groundp x)
+                        (rw.controlp control)
+                        (rw.control-atblp control atbl)))
+            (equal (rw.trace-env-okp (rw.try-ground-simplify hypbox x iffp control) defs thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable definition-of-rw.trace-env-okp
+                                     lemma-forcing-rw.trace-step-env-okp-of-rw.try-ground-simplify))))
+
+ (defthm forcing-rw.collect-forced-goals-of-rw.try-ground-simplify
+   (implies (force (rw.try-ground-simplify hypbox x iffp control))
+            (equal (rw.collect-forced-goals (rw.try-ground-simplify hypbox x iffp control))
+                   nil))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.if-specialcase-nil-trace (x y b1)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.tracep y)
+                              (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                              (logic.termp b1)
+                              (rw.trace->iffp x)
+                              (equal (rw.trace->rhs x) ''nil))))
+  (rw.trace 'if-specialcase-nil
+            (rw.trace->hypbox x)
+            (logic.function 'if (list (rw.trace->lhs x) b1 (rw.trace->lhs y)))
+            (rw.trace->rhs y)
+            (rw.trace->iffp y)
+            (list x y)
+            nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.if-specialcase-nil-trace)))
+
+ (defthm rw.trace->method-of-rw.if-specialcase-nil-trace
+   (equal (rw.trace->method (rw.if-specialcase-nil-trace x y b1))
+          'if-specialcase-nil))
+
+ (defthm rw.trace->hypbox-of-rw.if-specialcase-nil-trace
+   (equal (rw.trace->hypbox (rw.if-specialcase-nil-trace x y b1))
+          (rw.trace->hypbox x)))
+
+ (defthm rw.trace->lhs-of-rw.if-specialcase-nil-trace
+   (equal (rw.trace->lhs (rw.if-specialcase-nil-trace x y b1))
+          (logic.function 'if (list (rw.trace->lhs x) b1 (rw.trace->lhs y)))))
+
+ (defthm rw.trace->rhs-of-rw.if-specialcase-nil-trace
+   (equal (rw.trace->rhs (rw.if-specialcase-nil-trace x y b1))
+          (rw.trace->rhs y)))
+
+ (defthm rw.trace->iffp-of-rw.if-specialcase-nil-trace
+   (equal (rw.trace->iffp (rw.if-specialcase-nil-trace x y b1))
+          (rw.trace->iffp y)))
+
+ (defthm rw.trace->subtraces-of-rw.if-specialcase-nil-trace
+   (equal (rw.trace->subtraces (rw.if-specialcase-nil-trace x y b1))
+          (list x y)))
+
+ (defthm rw.trace->extras-of-rw.if-specialcase-nil-trace
+   (equal (rw.trace->extras (rw.if-specialcase-nil-trace x y b1))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.if-specialcase-nil-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (logic.termp b1)))
+            (equal (rw.tracep (rw.if-specialcase-nil-trace x y b1))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.if-specialcase-nil-trace
+   (implies (force (and (rw.trace-atblp x atbl)
+                        (rw.trace-atblp y atbl)
+                        (logic.term-atblp b1 atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (rw.trace-atblp (rw.if-specialcase-nil-trace x y b1) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.if-specialcase-nil-trace)))
+
+ (defthmd lemma-forcing-rw.if-specialcase-nil-tracep-of-rw.if-specialcase-nil-trace
+   (implies (force (and (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->rhs x) ''nil)))
+            (equal (rw.if-specialcase-nil-tracep (rw.if-specialcase-nil-trace x y b1))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.if-specialcase-nil-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.if-specialcase-nil-trace
+   (implies (force (and (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->rhs x) ''nil)))
+            (equal (rw.trace-step-okp (rw.if-specialcase-nil-trace x y b1) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.if-specialcase-nil-tracep-of-rw.if-specialcase-nil-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.if-specialcase-nil-trace
+   (implies (force (and (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->rhs x) ''nil)
+                        (rw.trace-okp x defs)
+                        (rw.trace-okp y defs)))
+            (equal (rw.trace-okp (rw.if-specialcase-nil-trace x y b1) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.if-specialcase-nil-trace x y b1) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.if-specialcase-nil-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.if-specialcase-nil-trace
+   (equal (rw.trace-step-env-okp (rw.if-specialcase-nil-trace x y b1) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.if-specialcase-nil-trace
+   (implies (force (and (rw.trace-env-okp x defs thms atbl)
+                        (rw.trace-env-okp y defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.if-specialcase-nil-trace x y b1) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.if-specialcase-nil-trace x y b1) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.if-specialcase-nil-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.if-specialcase-nil-trace
+   (equal (rw.collect-forced-goals (rw.if-specialcase-nil-trace x y b1))
+          (fast-merge (rw.collect-forced-goals x)
+                      (rw.collect-forced-goals y)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.if-specialcase-t-trace (x y c1)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.tracep y)
+                              (logic.termp c1)
+                              (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                              (rw.trace->iffp x)
+                              (logic.constantp (rw.trace->rhs x))
+                              (not (equal (logic.unquote (rw.trace->rhs x)) nil)))))
+  (rw.trace 'if-specialcase-t
+            (rw.trace->hypbox x)
+            (logic.function 'if (list (rw.trace->lhs x) (rw.trace->lhs y) c1))
+            (rw.trace->rhs y)
+            (rw.trace->iffp y)
+            (list x y)
+            nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.if-specialcase-t-trace)))
+
+ (defthm rw.trace->method-of-rw.if-specialcase-t-trace
+   (equal (rw.trace->method (rw.if-specialcase-t-trace x y c1))
+          'if-specialcase-t))
+
+ (defthm rw.trace->hypbox-of-rw.if-specialcase-t-trace
+   (equal (rw.trace->hypbox (rw.if-specialcase-t-trace x y c1))
+          (rw.trace->hypbox x)))
+
+ (defthm rw.trace->lhs-of-rw.if-specialcase-t-trace
+   (equal (rw.trace->lhs (rw.if-specialcase-t-trace x y c1))
+          (logic.function 'if (list (rw.trace->lhs x) (rw.trace->lhs y) c1))))
+
+ (defthm rw.trace->rhs-of-rw.if-specialcase-t-trace
+   (equal (rw.trace->rhs (rw.if-specialcase-t-trace x y c1))
+          (rw.trace->rhs y)))
+
+ (defthm rw.trace->iffp-of-rw.if-specialcase-t-trace
+   (equal (rw.trace->iffp (rw.if-specialcase-t-trace x y c1))
+          (rw.trace->iffp y)))
+
+ (defthm rw.trace->subtraces-of-rw.if-specialcase-t-trace
+   (equal (rw.trace->subtraces (rw.if-specialcase-t-trace x y c1))
+          (list x y)))
+
+ (defthm rw.trace->extras-of-rw.if-specialcase-t-trace
+   (equal (rw.trace->extras (rw.if-specialcase-t-trace x y c1))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.if-specialcase-t-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (logic.termp c1)))
+            (equal (rw.tracep (rw.if-specialcase-t-trace x y c1))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.if-specialcase-t-trace
+   (implies (force (and (rw.trace-atblp x atbl)
+                        (rw.trace-atblp y atbl)
+                        (logic.term-atblp c1 atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (rw.trace-atblp (rw.if-specialcase-t-trace x y c1) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.if-specialcase-t-trace)))
+
+ (defthmd lemma-forcing-rw.if-specialcase-t-tracep-of-rw.if-specialcase-t-trace
+   (implies (force (and (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                        (rw.trace->iffp x)
+                        (logic.constantp (rw.trace->rhs x))
+                        (not (equal (logic.unquote (rw.trace->rhs x)) nil))))
+            (equal (rw.if-specialcase-t-tracep (rw.if-specialcase-t-trace x y c1))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.if-specialcase-t-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.if-specialcase-t-trace
+   (implies (force (and (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                        (rw.trace->iffp x)
+                        (logic.constantp (rw.trace->rhs x))
+                        (not (equal (logic.unquote (rw.trace->rhs x)) nil))))
+            (equal (rw.trace-step-okp (rw.if-specialcase-t-trace x y c1) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.if-specialcase-t-tracep-of-rw.if-specialcase-t-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.if-specialcase-t-trace
+   (implies (force (and (equal (rw.trace->hypbox x) (rw.trace->hypbox y))
+                        (rw.trace->iffp x)
+                        (logic.constantp (rw.trace->rhs x))
+                        (not (equal (logic.unquote (rw.trace->rhs x)) nil))
+                        (rw.trace-okp x defs)
+                        (rw.trace-okp y defs)))
+            (equal (rw.trace-okp (rw.if-specialcase-t-trace x y c1) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.if-specialcase-t-trace x y c1) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.if-specialcase-t-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.if-specialcase-t-trace
+   (equal (rw.trace-step-env-okp (rw.if-specialcase-t-trace x y c1) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.if-specialcase-t-trace
+   (implies (force (and (rw.trace-env-okp x defs thms atbl)
+                        (rw.trace-env-okp y defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.if-specialcase-t-trace x y c1) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.if-specialcase-t-trace x y c1) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.if-specialcase-t-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.if-specialcase-t-trace
+   (equal (rw.collect-forced-goals (rw.if-specialcase-t-trace x y c1))
+          (fast-merge (rw.collect-forced-goals x)
+                      (rw.collect-forced-goals y)))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+(defund rw.not-trace (x iffp)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (booleanp iffp)
+                              (rw.trace->iffp x))))
+  (rw.trace 'not
+            (rw.trace->hypbox x)
+            (logic.function 'not (list (rw.trace->lhs x)))
+            (let ((rhs (rw.trace->rhs x)))
+              (cond ((equal rhs ''nil) ''t)
+                    ((equal rhs ''t)   ''nil)
+                    (t                 (logic.function 'not (list rhs)))))
+            iffp
+            (list x)
+            nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.not-trace)))
+
+ (defthm rw.trace->method-of-rw.not-trace
+   (equal (rw.trace->method (rw.not-trace x iffp))
+          'not))
+
+ (defthm rw.trace->hypbox-of-rw.not-trace
+   (equal (rw.trace->hypbox (rw.not-trace x iffp))
+          (rw.trace->hypbox x))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->lhs-of-rw.not-trace
+   (equal (rw.trace->lhs (rw.not-trace x iffp))
+          (logic.function 'not (list (rw.trace->lhs x))))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-rw.trace->rhs-of-rw.not-trace
+   (equal (rw.trace->rhs (rw.not-trace x iffp))
+          (cond ((and (equal (rw.trace->lhs x) (rw.trace->rhs x))
+                      (not (equal (rw.trace->rhs x) ''t))
+                      (not (equal (rw.trace->rhs x) ''nil)))
+                 (logic.function 'not (list (rw.trace->rhs x))))
+                ((equal (rw.trace->rhs x) ''nil)
+                 ''t)
+                ((equal (rw.trace->rhs x) ''t)
+                 ''nil)
+                (t
+                 (logic.function 'not (list (rw.trace->rhs x))))))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm forcing-rw.trace->iffp-of-rw.not-trace
+   (equal (rw.trace->iffp (rw.not-trace x iffp))
+          iffp)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->subtraces-of-rw.not-trace
+   (equal (rw.trace->subtraces (rw.not-trace x iffp))
+          (list x))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->extras-of-rw.not-trace
+   (equal (rw.trace->extras (rw.not-trace x iffp))
+          nil)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm forcing-rw.tracep-of-rw.not-trace
+   (implies (force (and (rw.tracep x)
+                        (booleanp iffp)))
+            (equal (rw.tracep (rw.not-trace x iffp))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.not-trace
+   (implies (force (and (rw.trace-atblp x atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)))
+            (equal (rw.trace-atblp (rw.not-trace x iffp) atbl)
+                   t))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (disable rw.not-trace)))
+ (local (in-theory (enable lemma-rw.trace->rhs-of-rw.not-trace)))
+
+ (defthmd lemma-forcing-rw.not-tracep-of-rw.not-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.trace->iffp x)))
+            (equal (rw.not-tracep (rw.not-trace x iffp))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.not-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.not-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.trace->iffp x)))
+            (equal (rw.trace-step-okp (rw.not-trace x iffp) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.not-tracep-of-rw.not-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.not-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.trace-okp x defs)
+                        (rw.trace->iffp x)))
+            (equal (rw.trace-okp (rw.not-trace x iffp) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.not-trace x iffp) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.not-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.not-trace
+   (equal (rw.trace-step-env-okp (rw.not-trace x iffp) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.not-trace
+   (implies (force (and (rw.trace-env-okp x defs thms atbl)
+                        (rw.trace-env-okp y defs thms atbl)
+                        (rw.trace-env-okp z defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.not-trace x iffp) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.not-trace x iffp) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.not-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.not-trace
+   (equal (rw.collect-forced-goals (rw.not-trace x iffp))
+          (rw.collect-forced-goals x))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.negative-if-trace (x iffp hypbox)
+  (declare (xargs :guard (and (logic.termp x)
+                              (booleanp iffp)
+                              (rw.hypboxp hypbox))))
+  (rw.trace 'negative-if
+            hypbox
+            (logic.function 'if (list x ''nil ''t))
+            (logic.function 'not (list x))
+            iffp
+            nil
+            nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.negative-if-trace)))
+
+ (defthm rw.trace->method-of-rw.negative-if-trace
+   (equal (rw.trace->method (rw.negative-if-trace x iffp hypbox))
+          'negative-if))
+
+ (defthm rw.trace->hypbox-of-rw.negative-if-trace
+   (equal (rw.trace->hypbox (rw.negative-if-trace x iffp hypbox))
+          hypbox)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->lhs-of-rw.negative-if-trace
+   (equal (rw.trace->lhs (rw.negative-if-trace x iffp hypbox))
+          (logic.function 'if (list x ''nil ''t)))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->rhs-of-rw.negative-if-trace
+   (equal (rw.trace->rhs (rw.negative-if-trace x iffp hypbox))
+          (logic.function 'not (list x)))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->iffp-of-rw.negative-if-trace
+   (equal (rw.trace->iffp (rw.negative-if-trace x iffp hypbox))
+          iffp)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->subtraces-of-rw.negative-if-trace
+   (equal (rw.trace->subtraces (rw.negative-if-trace x iffp hypbox))
+          nil)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->extras-of-rw.negative-if-trace
+   (equal (rw.trace->extras (rw.negative-if-trace x iffp hypbox))
+          nil)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm forcing-rw.tracep-of-rw.negative-if-trace
+   (implies (force (and (logic.termp x)
+                        (booleanp iffp)
+                        (rw.hypboxp hypbox)))
+            (equal (rw.tracep (rw.negative-if-trace x iffp hypbox))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.negative-if-trace
+   (implies (force (and (logic.term-atblp x atbl)
+                        (rw.hypbox-atblp hypbox atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (rw.trace-atblp (rw.negative-if-trace x iffp hypbox) atbl)
+                   t))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (disable rw.negative-if-trace)))
+
+ (defthmd lemma-forcing-rw.negative-if-tracep-of-rw.negative-if-trace
+   (equal (rw.negative-if-tracep (rw.negative-if-trace x iffp hypbox))
+          t)
+   :hints(("Goal" :in-theory (enable rw.negative-if-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.negative-if-trace
+   (equal (rw.trace-step-okp (rw.negative-if-trace x iffp hypbox) defs)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.negative-if-tracep-of-rw.negative-if-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.negative-if-trace
+   (equal (rw.trace-okp (rw.negative-if-trace x iffp hypbox) defs)
+          t)
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.negative-if-trace x iffp hypbox) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.negative-if-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.negative-if-trace
+   (equal (rw.trace-step-env-okp (rw.negative-if-trace x iffp hypbox) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.negative-if-trace
+   (equal (rw.trace-env-okp (rw.negative-if-trace x iffp hypbox) defs thms atbl)
+          t)
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.negative-if-trace x iffp hypbox) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.negative-if-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.negative-if-trace
+   (equal (rw.collect-forced-goals (rw.negative-if-trace x iffp hypbox))
+          nil)
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defsection rw.maybe-extend-trace
+
+  ;; Wrapper to avoid introducing ifs when extending traces.
+
+  (defund rw.maybe-extend-trace (original extension)
+    (declare (xargs :guard (and (rw.tracep original)
+                                (or (not extension)
+                                    (and (rw.tracep extension)
+                                         (equal (rw.trace->iffp original)
+                                                (rw.trace->iffp extension))
+                                         (equal (rw.trace->hypbox original)
+                                                (rw.trace->hypbox extension))
+                                         (equal (rw.trace->rhs original)
+                                                (rw.trace->lhs extension)))))))
+    (if extension
+        (rw.transitivity-trace original extension)
+      original))
+
+  (defthm forcing-rw.tracep-of-rw.maybe-extend-trace
+    (implies (force (and (rw.tracep original)
+                         (or (not extension)
+                             (rw.tracep extension))))
+             (equal (rw.tracep (rw.maybe-extend-trace original extension))
+                    t))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace))))
+
+  (defthm forcing-rw.trace-okp-of-rw.maybe-extend-trace
+    (implies (force (and (rw.tracep original)
+                         (rw.trace-okp original defs)
+                         (or (not extension)
+                             (and (rw.tracep extension)
+                                  (rw.trace-okp extension defs)
+                                  (equal (rw.trace->iffp original)
+                                         (rw.trace->iffp extension))
+                                  (equal (rw.trace->hypbox original)
+                                         (rw.trace->hypbox extension))
+                                  (equal (rw.trace->rhs original)
+                                         (rw.trace->lhs extension))))))
+             (equal (rw.trace-okp (rw.maybe-extend-trace original extension) defs)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace))))
+
+  (defthm forcing-rw.trace-atblp-of-rw.maybe-extend-trace
+    (implies (force (and (rw.tracep original)
+                         (rw.trace-atblp original atbl)
+                         (or (not extension)
+                             (and (rw.tracep extension)
+                                  (rw.trace-atblp extension atbl)))))
+             (equal (rw.trace-atblp (rw.maybe-extend-trace original extension) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace))))
+
+  (defthm forcing-rw.trace-env-okp-of-rw.maybe-extend-trace
+    (implies (force (and (rw.tracep original)
+                         (rw.trace-env-okp original defs thms atbl)
+                         (or (not extension)
+                             (and (rw.tracep extension)
+                                  (rw.trace-env-okp extension defs thms atbl)))))
+             (equal (rw.trace-env-okp (rw.maybe-extend-trace original extension) defs thms atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace))))
+
+  (defthm forcing-rw.trace->iffp-of-rw.maybe-extend-trace
+    (implies (force (and (rw.tracep original)
+                         (or (not extension)
+                             (rw.tracep extension))))
+             (equal (rw.trace->iffp (rw.maybe-extend-trace original extension))
+                    (rw.trace->iffp original)))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace))))
+
+  (defthm forcing-rw.trace->assms-of-rw.maybe-extend-trace
+    (implies (force (and (rw.tracep original)
+                         (or (not extension)
+                             (rw.tracep extension))))
+             (equal (rw.trace->hypbox (rw.maybe-extend-trace original extension))
+                    (rw.trace->hypbox original)))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace))))
+
+  (defthm forcing-rw.trace->lhs-of-rw.maybe-extend-trace
+    (implies (force (and (rw.tracep original)
+                         (or (not extension)
+                             (rw.tracep extension))))
+             (equal (rw.trace->lhs (rw.maybe-extend-trace original extension))
+                    (rw.trace->lhs original)))
+    :hints(("Goal" :in-theory (enable rw.maybe-extend-trace)))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/basic-compilers.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/basic-compilers.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/basic-compilers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/basic-compilers.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,797 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(include-book "basic-if-lemmas")
+(include-book "../evaluator-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthmd equal-of-2-and-len
+  (equal (equal 2 (len x))
+         (and (consp x)
+              (consp (cdr x))
+              (not (consp (cdr (cdr x)))))))
+
+(local (in-theory (enable rw.trace-conclusion-formula
+                          rw.trace-formula
+                          equal-of-2-and-len)))
+
+;; (defthmd forcing-equal-when-equal-of-logic.function-name-and-logic.function-args
+;;   (implies (and (equal (logic.function-name x) (logic.function-name y))
+;;                 (equal (logic.function-args x) (logic.function-args y))
+;;                 (force (logic.functionp x))
+;;                 (force (logic.functionp y)))
+;;            (equal (equal x y)
+;;                   t))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0))
+;;   :hints(("Goal" :in-theory (enable logic.function-name logic.function-args))))
+
+
+;; (defthmd forcing-logic.lambda-formals-when-not-logic.lambda-actuals
+;;   (implies (and (not (logic.lambda-actuals x))
+;;                 (force (logic.termp x))
+;;                 (force (logic.lambdap x)))
+;;            (equal (logic.lambda-formals x)
+;;                   nil))
+;;   :hints(("Goal"
+;;           :in-theory (disable forcing-equal-lens-of-logic.lambda-formals-and-logic.lambda-actuals)
+;;           :use ((:instance forcing-equal-lens-of-logic.lambda-formals-and-logic.lambda-actuals)))))
+
+;; (defthmd forcing-logic.term-vars-of-logic.lambda-body-when-not-logic.lambda-actuals
+;;   (implies (and (not (logic.lambda-actuals x))
+;;                 (force (logic.termp x))
+;;                 (force (logic.lambdap x)))
+;;            (equal (logic.term-vars (logic.lambda-body x))
+;;                   nil))
+;;   :hints(("Goal"
+;;           :in-theory (e/d (forcing-logic.lambda-formals-when-not-logic.lambda-actuals)
+;;                           (forcing-subsetp-of-logic.term-vars-of-logic.lambda-body-with-logic.lambda-formals))
+;;           :use ((:instance forcing-subsetp-of-logic.term-vars-of-logic.lambda-body-with-logic.lambda-formals)))))
+
+;; (defthmd forcing-equal-of-logic.lambda-rewrite
+;;   (implies (force (logic.termp x))
+;;            (equal (equal (logic.lambda formals body actuals) x)
+;;                   (and (logic.lambdap x)
+;;                        (equal (logic.lambda-formals x) formals)
+;;                        (equal (logic.lambda-body x) body)
+;;                        (equal (logic.lambda-actuals x) actuals)))))
+
+;; (local (in-theory (enable forcing-equal-when-equal-of-logic.function-name-and-logic.function-args
+;;                           forcing-equal-when-equal-of-logic.lambda-parts
+;;                           forcing-logic.lambda-formals-when-not-logic.lambda-actuals
+;;                           forcing-logic.term-vars-of-logic.lambda-body-when-not-logic.lambda-actuals
+;;                           forcing-equal-of-logic.lambda-rewrite
+;;                           len-2-when-not-cdr-of-cdr
+;;                           )))
+
+;; (defthmd len-2-when-not-cdr-of-cdr
+;;   (implies (not (cdr (cdr x)))
+;;            (equal (equal (len x) 2)
+;;                   (consp (cdr x))))
+;;   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+
+
+(defund rw.compile-fail-trace (x)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.fail-tracep x))))
+  (let* ((hypbox (rw.trace->hypbox x))
+         (iffp   (rw.trace->iffp x))
+         (lhs    (rw.trace->lhs x)))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (if iffp
+            (build.iff-reflexivity lhs)
+          (build.equal-reflexivity lhs))
+      (if iffp
+          (build.expansion (rw.hypbox-formula hypbox) (build.iff-reflexivity lhs))
+        (build.expansion (rw.hypbox-formula hypbox) (build.equal-reflexivity lhs))))))
+
+(defobligations rw.compile-fail-trace
+  (build.expansion build.iff-reflexivity build.equal-reflexivity))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.fail-tracep rw.compile-fail-trace)))
+
+ (defthm rw.compile-fail-trace-under-iff
+   (iff (rw.compile-fail-trace x)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-fail-trace
+   (implies (force (and (rw.fail-tracep x)
+                        (rw.tracep x)))
+            (equal (logic.appealp (rw.compile-fail-trace x))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-fail-trace
+   (implies (force (and (rw.fail-tracep x)
+                        (rw.tracep x)))
+            (equal (logic.conclusion (rw.compile-fail-trace x))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-fail-trace
+   (implies (force (and (rw.fail-tracep x)
+                        (rw.tracep x)
+                        (rw.trace-atblp x atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations rw.compile-fail-trace)))
+            (equal (logic.proofp (rw.compile-fail-trace x) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund rw.compile-transitivity-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.transitivity-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox (rw.trace->hypbox x))
+         (iffp   (rw.trace->iffp x))
+         (proof1 (first proofs))
+         (proof2 (second proofs)))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (if iffp
+            (build.transitivity-of-iff proof1 proof2)
+          (build.transitivity-of-equal proof1 proof2))
+      (if iffp
+          (build.disjoined-transitivity-of-iff proof1 proof2)
+        (build.disjoined-transitivity-of-equal proof1 proof2)))))
+
+(defobligations rw.compile-transitivity-trace
+  (build.disjoined-transitivity-of-iff
+   build.disjoined-transitivity-of-pequal
+   build.transitivity-of-iff
+   build.transitivity-of-equal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.transitivity-tracep rw.compile-transitivity-trace)))
+
+ (verify-guards rw.compile-transitivity-trace)
+
+ (defthm rw.compile-transitivity-trace-under-iff
+   (iff (rw.compile-transitivity-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+
+ (defthm logic.appealp-of-rw.compile-transitivity-trace
+   (implies (force (and (rw.transitivity-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-transitivity-trace x proofs))
+                   t))
+   :hints(("Goal"
+           :expand ((logic.strip-conclusions x)
+                    (logic.strip-conclusions (cdr x))
+                    (rw.trace-list-formulas (rw.trace->subtraces x))
+                    (rw.trace-list-formulas (cdr (rw.trace->subtraces x)))))))
+
+ (defthm logic.conclusion-of-rw.compile-transitivity-trace
+   (implies (force (and (rw.transitivity-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-transitivity-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal"
+           :expand ((logic.strip-conclusions x)
+                    (logic.strip-conclusions (cdr x))
+                    (rw.trace-list-formulas (rw.trace->subtraces x))
+                    (rw.trace-list-formulas (cdr (rw.trace->subtraces x)))))))
+
+
+ (defthm@ logic.proofp-of-rw.compile-transitivity-trace
+   (implies (force (and (rw.transitivity-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations rw.compile-transitivity-trace)))
+            (equal (logic.proofp (rw.compile-transitivity-trace x proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((logic.strip-conclusions x)
+                    (logic.strip-conclusions (cdr x))
+                    (rw.trace-list-formulas (rw.trace->subtraces x))
+                    (rw.trace-list-formulas (cdr (rw.trace->subtraces x))))))))
+
+
+
+
+(defund rw.compile-equiv-by-args-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.equiv-by-args-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox (rw.trace->hypbox x))
+         (iffp   (rw.trace->iffp x))
+         (name   (logic.function-name (rw.trace->lhs x))))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (if iffp
+            (build.iff-from-equal (build.equal-by-args name proofs))
+          (build.equal-by-args name proofs))
+      ;; Optimization: we can usually avoid rebuilding the rw.hypbox-formula
+      (let ((assms-formula (if (consp proofs)
+                               (logic.vlhs (logic.conclusion (car proofs)))
+                             (rw.hypbox-formula hypbox))))
+        (if iffp
+            (build.disjoined-iff-from-equal (build.disjoined-equal-by-args name assms-formula proofs))
+          (build.disjoined-equal-by-args name assms-formula proofs))))))
+
+(defobligations rw.compile-equiv-by-args-trace
+  (build.disjoined-iff-from-equal
+   build.disjoined-equal-by-args
+   build.iff-from-equal
+   build.equal-by-args))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.equiv-by-args-tracep rw.compile-equiv-by-args-trace)))
+
+ (verify-guards rw.compile-equiv-by-args-trace)
+
+ (defthm rw.compile-equiv-by-args-trace-under-iff
+   (iff (rw.compile-equiv-by-args-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-equiv-by-args-trace
+   (implies (force (and (rw.equiv-by-args-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-equiv-by-args-trace x proofs))
+                   t)))
+
+ (defthmd lemma-for-logic.conclusion-of-rw.compile-equiv-by-args-trace
+   (implies (and (equal (logic.function-name lhs) (logic.function-name rhs))
+                 (logic.functionp lhs)
+                 (logic.functionp rhs)
+                 (force (logic.termp lhs))
+                 (force (logic.termp rhs)))
+            (equal (equal lhs rhs)
+                   (equal (logic.function-args lhs)
+                          (logic.function-args rhs))))
+   :hints(("Goal" :in-theory (enable logic.function-name logic.function-args))))
+
+ (local (in-theory (enable lemma-for-logic.conclusion-of-rw.compile-equiv-by-args-trace)))
+
+ (defthm logic.conclusion-of-rw.compile-equiv-by-args-trace
+   (implies (force (and (rw.equiv-by-args-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-equiv-by-args-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+ (defthmd lemma-1-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+   (implies (equal (rw.trace-list-conclusion-formulas (rw.trace->subtraces x))
+                   (logic.strip-conclusions proofs))
+            (equal (len (rw.trace->subtraces x))
+                   (len proofs)))
+   :hints(("Goal"
+           :in-theory (disable len-of-rw.trace-list-conclusion-formulas)
+           :use ((:instance len-of-rw.trace-list-conclusion-formulas
+                            (x (rw.trace->subtraces x)))))))
+
+ (defthmd lemma-2-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+   (implies (equal (rw.trace-list-conclusion-formulas (rw.trace->subtraces x))
+                   (logic.vrhses (logic.strip-conclusions proofs)))
+            (equal (len (rw.trace->subtraces x))
+                   (len proofs)))
+   :hints(("Goal"
+           :in-theory (disable len-of-rw.trace-list-conclusion-formulas)
+           :use ((:instance len-of-rw.trace-list-conclusion-formulas
+                            (x (rw.trace->subtraces x)))))))
+
+ (defthmd lemma-3-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+   (implies (equal (rw.trace-list-rhses (rw.trace->subtraces x)) free)
+            (equal (len free)
+                   (len (rw.trace->subtraces x)))))
+
+ (local (in-theory (enable lemma-1-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+                           lemma-2-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+                           lemma-3-for-logic.proofp-of-rw.compile-equiv-by-args-trace)))
+
+ (defthm@ logic.proofp-of-rw.compile-equiv-by-args-trace
+   (implies (force (and (rw.equiv-by-args-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.compile-equiv-by-args-trace)))
+            (equal (logic.proofp (rw.compile-equiv-by-args-trace x proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+
+
+
+
+
+
+(defund rw.compile-lambda-equiv-by-args-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.lambda-equiv-by-args-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox  (rw.trace->hypbox x))
+         (iffp    (rw.trace->iffp x))
+         (lhs     (rw.trace->lhs x))
+         (formals (logic.lambda-formals lhs))
+         (body    (logic.lambda-body lhs)))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (if iffp
+            (build.iff-from-equal (build.lambda-equal-by-args formals body proofs))
+          (build.lambda-equal-by-args formals body proofs))
+      ;; Optimization: we can usually avoid rebuilding the rw.assms-formula
+      (let ((assms-formula (if (consp proofs)
+                               (logic.vlhs (logic.conclusion (car proofs)))
+                             (rw.hypbox-formula hypbox))))
+        (if iffp
+            (build.disjoined-iff-from-equal (build.disjoined-lambda-equal-by-args formals body assms-formula proofs))
+          (build.disjoined-lambda-equal-by-args formals body assms-formula proofs))))))
+
+(defobligations rw.compile-lambda-equiv-by-args-trace
+  (build.disjoined-iff-from-equal
+   build.disjoined-lambda-equal-by-args
+   build.iff-from-equal
+   build.lambda-equal-by-args))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.lambda-equiv-by-args-tracep
+                           rw.compile-lambda-equiv-by-args-trace)))
+
+ (defthmd lemma-for-rw.compile-lambda-equiv-by-args-trace
+   ;; BOZO we changed the normal form to (len (lambda-actuals x)).  Do we still
+   ;; want to target lambda-formals?  Do we still even need this rule?
+   (implies (and (logic.termp x)
+                 (logic.lambdap x))
+            (implies (equal (logic.lambda-actuals x) (rw.trace-list-lhses y))
+                     (equal (len (logic.lambda-formals x))
+                            (len y))))
+   :hints(("Goal"
+           :in-theory (disable len-of-rw.trace-list-lhses)
+           :use ((:instance len-of-rw.trace-list-lhses (x y))))))
+
+ (local (in-theory (enable lemma-for-rw.compile-lambda-equiv-by-args-trace
+                           lemma-1-for-logic.proofp-of-rw.compile-equiv-by-args-trace
+                           lemma-2-for-logic.proofp-of-rw.compile-equiv-by-args-trace)))
+ (local (in-theory (disable forcing-logic.vrhses-of-logic.por-list-free)))
+
+ (verify-guards rw.compile-lambda-equiv-by-args-trace)
+
+ (defthm rw.compile-lambda-equiv-by-args-trace-under-iff
+   (iff (rw.compile-lambda-equiv-by-args-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-lambda-equiv-by-args-trace
+   (implies (force (and (rw.lambda-equiv-by-args-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-lambda-equiv-by-args-trace x proofs))
+                   t)))
+
+ (defthmd forcing-equal-when-equal-of-logic.lambda-parts
+   (implies (and (equal (logic.lambda-formals x) (logic.lambda-formals y))
+                 (equal (logic.lambda-body x) (logic.lambda-body y))
+                 (equal (logic.lambda-actuals x) (logic.lambda-actuals y))
+                 (force (logic.lambdap x))
+                 (force (logic.lambdap y))
+                 (force (logic.termp x))
+                 (force (logic.termp y)))
+            (equal (equal x y)
+                   t))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :in-theory (enable logic.lambda-formals
+                                     logic.lambda-body
+                                     logic.lambda-actuals
+                                     logic.lambdap
+                                     definition-of-logic.termp))))
+
+ (local (in-theory (enable forcing-equal-when-equal-of-logic.lambda-parts)))
+
+ (defthm logic.conclusion-of-rw.compile-lambda-equiv-by-args-trace
+   (implies (force (and (rw.lambda-equiv-by-args-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-lambda-equiv-by-args-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-lambda-equiv-by-args-trace
+   (implies (force (and (rw.lambda-equiv-by-args-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.compile-lambda-equiv-by-args-trace)))
+            (equal (logic.proofp (rw.compile-lambda-equiv-by-args-trace x proofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund rw.compile-beta-reduction-trace (x)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.beta-reduction-tracep x))
+                  :guard-hints (("Goal" :in-theory (enable rw.beta-reduction-tracep)))))
+  (let* ((hypbox  (rw.trace->hypbox x))
+         (iffp    (rw.trace->iffp x))
+         (lhs     (rw.trace->lhs x))
+         (formals (logic.lambda-formals lhs))
+         (body    (logic.lambda-body lhs))
+         (actuals (logic.lambda-actuals lhs)))
+    (let ((main-proof (if iffp
+                          (build.iff-from-pequal (build.beta-reduction formals body actuals))
+                        (build.equal-from-pequal (build.beta-reduction formals body actuals)))))
+      (if (and (not (rw.hypbox->left hypbox))
+               (not (rw.hypbox->right hypbox)))
+          main-proof
+        (build.expansion (rw.hypbox-formula hypbox) main-proof)))))
+
+(defobligations rw.compile-beta-reduction-trace
+  (build.iff-from-pequal
+   build.equal-from-pequal
+   build.expansion
+   build.beta-reduction))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.beta-reduction-tracep
+                           rw.compile-beta-reduction-trace)))
+
+ (defthm rw.compile-beta-reduction-trace-under-iff
+   (iff (rw.compile-beta-reduction-trace x)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-beta-reduction-trace
+   (implies (force (and (rw.beta-reduction-tracep x)
+                        (rw.tracep x)))
+            (equal (logic.appealp (rw.compile-beta-reduction-trace x))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-beta-reduction-trace
+   (implies (force (and (rw.beta-reduction-tracep x)
+                        (rw.tracep x)))
+            (equal (logic.conclusion (rw.compile-beta-reduction-trace x))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-beta-reduction-trace
+   (implies (force (and (rw.beta-reduction-tracep x)
+                        (rw.tracep x)
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.compile-beta-reduction-trace)))
+            (equal (logic.proofp (rw.compile-beta-reduction-trace x) axioms thms atbl)
+                   t))))
+
+
+
+(defund@ rw.compile-ground-trace (x defs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs)
+                              (rw.ground-tracep x defs))
+                  :verify-guards nil))
+  (let* ((hypbox    (rw.trace->hypbox x))
+         (iffp      (rw.trace->iffp x))
+         (lhs       (rw.trace->lhs x))
+         (depth     (rw.trace->extras x))
+         (proof     (generic-evaluator-bldr lhs defs depth)) ;; lhs = lhs'
+         (lhs-prime (logic.=rhs (logic.conclusion proof))))
+    (let ((main-proof (cond ((not iffp)
+                             ;; Already canonical under equal
+                             (build.equal-from-pequal proof))
+                            ((or (equal lhs-prime ''t)
+                                 (equal lhs-prime ''nil))
+                             ;; Already canonical under iff
+                             (build.iff-from-pequal proof))
+                            (t
+                             ;; Not canonical under iff
+                             (@derive
+                              ((= lhs lhs-prime)                  (@given proof))
+                              ((!= lhs-prime nil)                 (build.not-pequal-constants lhs-prime ''nil))
+                              ((!= lhs nil)                       (build.substitute-into-not-pequal @- @--)   *1)
+                              ((v (= x nil) (= (iff x t) t))      (build.theorem (theorem-iff-t-when-not-nil)))
+                              ((v (= lhs nil) (= (iff lhs t) t))  (build.instantiation @- (list (cons 'x lhs))))
+                              ((= (iff lhs t) t)                  (build.modus-ponens-2 *1 @-)))))))
+      (if (and (not (rw.hypbox->left hypbox))
+               (not (rw.hypbox->right hypbox)))
+          main-proof
+        (build.expansion (rw.hypbox-formula hypbox) main-proof)))))
+
+(defobligations rw.compile-ground-trace
+  (generic-evaluator-bldr
+   build.equal-from-pequal
+   build.iff-from-pequal
+   build.not-pequal-constants
+   build.substitute-into-not-pequal
+   build.instantiation
+   build.modus-ponens-2)
+  :extra-thms ((theorem-iff-t-when-not-nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.ground-tracep
+                           rw.compile-ground-trace
+                           theorem-iff-t-when-not-nil)))
+
+ (defthmd lemma-for-rw.compile-ground-trace
+   (implies (and (equal (generic-evaluator term defs depth) x)
+                 (logic.termp x)
+                 (force (definition-listp defs))
+                 (force (logic.termp term))
+                 (force (generic-evaluator term defs depth)))
+            (equal (logic.constantp x)
+                   t)))
+
+ (local (in-theory (enable lemma-for-rw.compile-ground-trace)))
+
+ (verify-guards rw.compile-ground-trace)
+
+ (defthm rw.compile-ground-trace-under-iff
+   (iff (rw.compile-ground-trace x defs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm forcing-logic.appealp-of-rw.compile-ground-trace
+   (implies (force (and (rw.tracep x)
+                        (definition-listp defs)
+                        (rw.ground-tracep x defs)))
+            (equal (logic.appealp (rw.compile-ground-trace x defs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.compile-ground-trace
+   (implies (force (and (rw.tracep x)
+                        (definition-listp defs)
+                        (rw.ground-tracep x defs)))
+            (equal (logic.conclusion (rw.compile-ground-trace x defs))
+                   (rw.trace-formula x))))
+
+ (defthm@ forcing-logic.proofp-of-rw.compile-ground-trace
+   ;; Wait -- we don't really need all the axioms, just the defs.  So, if we
+   ;; just take the defs instead of the axioms, we could require that they are
+   ;; all ok; would that be better?
+   (implies (force (and (rw.tracep x)
+                        (definition-listp defs)
+                        (rw.ground-tracep x defs)
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (subsetp defs axioms)
+                        (logic.formula-list-atblp defs atbl)
+                        (@obligations rw.compile-ground-trace)))
+            (equal (logic.proofp (rw.compile-ground-trace x defs) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund rw.compile-if-specialcase-nil-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.if-specialcase-nil-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox (rw.trace->hypbox x))
+         (iffp   (rw.trace->iffp x))
+         (lhs    (rw.trace->lhs x)) ;; (if a1 b1 c1)
+         (b1     (second (logic.function-args lhs))))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (if iffp
+            (rw.iff-implies-iff-if-specialcase-nil-bldr (first proofs) (second proofs) b1)
+          (rw.iff-implies-equal-if-specialcase-nil-bldr (first proofs) (second proofs) b1))
+      (if iffp
+          (rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr (first proofs) (second proofs) b1)
+        (rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr (first proofs) (second proofs) b1)))))
+
+(defobligations rw.compile-if-specialcase-nil-trace
+  (rw.iff-implies-iff-if-specialcase-nil-bldr
+   rw.iff-implies-equal-if-specialcase-nil-bldr
+   rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr
+   rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.if-specialcase-nil-tracep
+                           rw.compile-if-specialcase-nil-trace)))
+
+ (local (defthm lemma
+          ;; We normally don't break up constants, but this one gets in the way if we don't.
+          (equal (equal x '('nil))
+                 (and (consp x)
+                      (equal (car x) ''nil)
+                      (not (cdr x))))))
+
+ (verify-guards rw.compile-if-specialcase-nil-trace)
+
+ (defthm rw.compile-if-specialcase-nil-trace-under-iff
+   (iff (rw.compile-if-specialcase-nil-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+
+ (defthm logic.appealp-of-rw.compile-if-specialcase-nil-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.if-specialcase-nil-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-if-specialcase-nil-trace x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-if-specialcase-nil-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.if-specialcase-nil-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-if-specialcase-nil-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-if-specialcase-nil-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.if-specialcase-nil-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations rw.compile-if-specialcase-nil-trace)))
+            (equal (logic.proofp (rw.compile-if-specialcase-nil-trace x proofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund rw.compile-if-specialcase-t-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.if-specialcase-t-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox      (rw.trace->hypbox x))
+         (iffp        (rw.trace->iffp x))
+         (subtraces   (rw.trace->subtraces x))
+         (subtrace1   (first subtraces))                          ;; [hyps ->] (iff a1 const) = t
+         (const       (rw.trace->rhs subtrace1))
+         (const-proof (build.not-pequal-constants const ''nil))   ;; const != nil
+         (lhs         (rw.trace->lhs x))                          ;; (if a1 b1 c1)
+         (c1          (third (logic.function-args lhs))))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (if iffp
+            (rw.iff-implies-iff-if-specialcase-t-bldr (first proofs) const-proof (second proofs) c1)
+          (rw.iff-implies-equal-if-specialcase-t-bldr (first proofs) const-proof (second proofs) c1))
+      ;; We need to expand const-proof with assms-formula.  But we can just
+      ;; grab the formula out of the first proof instead of reconstructing it.
+      (let* ((assms-formula   (logic.vlhs (logic.conclusion (first proofs))))
+             (new-const-proof (build.expansion assms-formula const-proof)))
+        (if iffp
+            (rw.disjoined-iff-implies-iff-if-specialcase-t-bldr (first proofs) new-const-proof (second proofs) c1)
+          (rw.disjoined-iff-implies-equal-if-specialcase-t-bldr (first proofs) new-const-proof (second proofs) c1))))))
+
+(defobligations rw.compile-if-specialcase-t-trace
+  (build.not-pequal-constants
+   rw.iff-implies-iff-if-specialcase-t-bldr
+   rw.iff-implies-equal-if-specialcase-t-bldr
+   rw.disjoined-iff-implies-iff-if-specialcase-t-bldr
+   rw.disjoined-iff-implies-equal-if-specialcase-t-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.if-specialcase-t-tracep
+                           rw.compile-if-specialcase-t-trace)))
+
+ (verify-guards rw.compile-if-specialcase-t-trace)
+
+ (defthm rw.compile-if-specialcase-t-trace-under-iff
+   (iff (rw.compile-if-specialcase-t-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-if-specialcase-t-trace
+   (implies (force (and (rw.if-specialcase-t-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-if-specialcase-t-trace x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-if-specialcase-t-trace
+   (implies (force (and (rw.if-specialcase-t-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-if-specialcase-t-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-if-specialcase-t-trace
+   (implies (force (and (rw.if-specialcase-t-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; --
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations rw.compile-if-specialcase-t-trace)))
+            (equal (logic.proofp (rw.compile-if-specialcase-t-trace x proofs) axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/basic-if-lemmas.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/basic-if-lemmas.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/basic-if-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/basic-if-lemmas.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,166 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "if-lemmas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "basic-trace-if-lemmas.tex")
+
+(defderiv rw.iff-implies-equal-if-specialcase-nil-bldr
+  :derive (= (equal (if (? a1) (? b1) (? c1)) (? c2)) t)
+  :from   ((proof x (= (iff (? a1) nil) t))
+           (proof y (= (equal (? c1) (? c2)) t))
+           (term b1 (? b1)))
+  :proof  (@derive
+           ((= (iff (? a1) nil) t)                                                                                        (@given x) *1)
+           ((= (equal (? c1) (? c2)) t)                                                                                   (@given y) *2)
+           ((v (!= (iff x1 nil) t) (v (!= (equal z1 z2) t) (= (equal (if x1 y1 z1) z2) t)))                               (build.theorem (rw.theorem-iff-implies-equal-if-specialcase-nil)))
+           ((v (!= (iff (? a1) nil) t) (v (!= (equal (? c1) (? c2)) t) (= (equal (if (? a1) (? b1) (? c1)) (? c2)) t)))   (build.instantiation @- (@sigma (x1 . (? a1)) (y1 . (? b1)) (z1 . (? c1)) (z2 . (? c2)))))
+           ((= (equal (if (? a1) (? b1) (? c1)) (? c2)) t)                                                                (rw.two-modus-ponens *1 *2 @-)))
+  :minatbl ((if . 3)
+            (equal . 2)))
+
+(defderiv rw.iff-implies-iff-if-specialcase-nil-bldr
+  :derive (= (iff (if (? a1) (? b1) (? c1)) (? c2)) t)
+  :from   ((proof x (= (iff (? a1) nil) t))
+           (proof y (= (iff (? c1) (? c2)) t))
+           (term b1 (? b1)))
+  :proof  (@derive
+           ((= (iff (? a1) nil) t)                                                                                     (@given x) *1)
+           ((= (iff (? c1) (? c2)) t)                                                                                  (@given y) *2)
+           ((v (!= (iff x1 nil) t) (v (!= (iff z1 z2) t) (= (iff (if x1 y1 z1) z2) t)))                                (build.theorem (rw.theorem-iff-implies-iff-if-specialcase-nil)))
+           ((v (!= (iff (? a1) nil) t) (v (!= (iff (? c1) (? c2)) t) (= (iff (if (? a1) (? b1) (? c1)) (? c2)) t)))    (build.instantiation @- (@sigma (x1 . (? a1)) (y1 . (? b1)) (z1 . (? c1)) (z2 . (? c2)))))
+           ((= (iff (if (? a1) (? b1) (? c1)) (? c2)) t)                                                               (rw.two-modus-ponens *1 *2 @-)))
+  :minatbl ((if . 3)))
+
+
+
+(defderiv rw.iff-implies-equal-if-specialcase-t-bldr
+  :derive (= (equal (if (? a1) (? b1) (? c1)) (? b2)) t)
+  :from   ((proof x (= (iff (? a1) (? a2)) t))
+           (proof y (!= (? a2) nil))
+           (proof z (= (equal (? b1) (? b2)) t))
+           (term c1 (? c1)))
+  :proof  (@derive
+           ((= (iff (? a1) (? a2)) t)                                                                                                           (@given x) *1)
+           ((!= (? a2) nil)                                                                                                                     (@given y) *2)
+           ((= (equal (? b1) (? b2)) t)                                                                                                         (@given z) *3)
+           ((v (!= (iff x1 x2) t) (v (= x2 nil) (v (!= (equal y1 y2) t) (= (equal (if x1 y1 z1) y2) t))))                                       (build.theorem (rw.theorem-iff-implies-equal-if-specialcase-t)))
+           ((v (!= (iff (? a1) (? a2)) t) (v (= (? a2) nil) (v (!= (equal (? b1) (? b2)) t) (= (equal (if (? a1) (? b1) (? c1)) (? b2)) t))))   (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y1 . (? b1)) (y2 . (? b2)) (z1 . (? c1)))))
+           ((= (equal (if (? a1) (? b1) (? c1)) (? b2)) t)                                                                                      (rw.mp-mp2-mp *1 *2 *3 @-)))
+  :minatbl ((equal . 2)
+            (if . 3)))
+
+(defderiv rw.iff-implies-iff-if-specialcase-t-bldr
+  :derive (= (iff (if (? a1) (? b1) (? c1)) (? b2)) t)
+  :from   ((proof x (= (iff (? a1) (? a2)) t))
+           (proof y (!= (? a2) nil))
+           (proof z (= (iff (? b1) (? b2)) t))
+           (term c1 (? c1)))
+  :proof  (@derive
+           ((= (iff (? a1) (? a2)) t)                                                                                                       (@given x) *1)
+           ((!= (? a2) nil)                                                                                                                 (@given y) *2)
+           ((= (iff (? b1) (? b2)) t)                                                                                                       (@given z) *3)
+           ((v (!= (iff x1 x2) t) (v (= x2 nil) (v (!= (iff y1 y2) t) (= (iff (if x1 y1 z1) y2) t))))                                       (build.theorem (rw.theorem-iff-implies-iff-if-specialcase-t)))
+           ((v (!= (iff (? a1) (? a2)) t) (v (= (? a2) nil) (v (!= (iff (? b1) (? b2)) t) (= (iff (if (? a1) (? b1) (? c1)) (? b2)) t))))   (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y1 . (? b1)) (y2 . (? b2)) (z1 . (? c1)))))
+           ((= (iff (if (? a1) (? b1) (? c1)) (? b2)) t)                                                                                    (rw.mp-mp2-mp *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+
+
+(defderiv rw.disjoined-iff-implies-equal-if-specialcase-nil-bldr
+  :derive (v P (= (equal (if (? a1) (? b1) (? c1)) (? c2)) t))
+  :from   ((proof x (v P (= (iff (? a1) nil) t)))
+           (proof y (v P (= (equal (? c1) (? c2)) t)))
+           (term b1 (? b1)))
+  :proof  (@derive
+           ((v P (= (iff (? a1) nil) t))                                                                                        (@given x) *1)
+           ((v P (= (equal (? c1) (? c2)) t))                                                                                   (@given y) *2)
+           ((v (!= (iff x1 nil) t) (v (!= (equal z1 z2) t) (= (equal (if x1 y1 z1) z2) t)))                                     (build.theorem (rw.theorem-iff-implies-equal-if-specialcase-nil)))
+           ((v (!= (iff (? a1) nil) t) (v (!= (equal (? c1) (? c2)) t) (= (equal (if (? a1) (? b1) (? c1)) (? c2)) t)))         (build.instantiation @- (@sigma (x1 . (? a1)) (y1 . (? b1)) (z1 . (? c1)) (z2 . (? c2)))))
+           ((v P (= (equal (if (? a1) (? b1) (? c1)) (? c2)) t))                                                                (rw.two-disjoined-modus-ponens *1 *2 @-)))
+  :minatbl ((if . 3)
+            (equal . 2)))
+
+(defderiv rw.disjoined-iff-implies-iff-if-specialcase-nil-bldr
+  :derive (v P (= (iff (if (? a1) (? b1) (? c1)) (? c2)) t))
+  :from   ((proof x (v P (= (iff (? a1) nil) t)))
+           (proof y (v P (= (iff (? c1) (? c2)) t)))
+           (term b1 (? b1)))
+  :proof  (@derive
+           ((v P (= (iff (? a1) nil) t))                                                                                   (@given x) *1)
+           ((v P (= (iff (? c1) (? c2)) t))                                                                                (@given y) *2)
+           ((v (!= (iff x1 nil) t) (v (!= (iff z1 z2) t) (= (iff (if x1 y1 z1) z2) t)))                                    (build.theorem (rw.theorem-iff-implies-iff-if-specialcase-nil)))
+           ((v (!= (iff (? a1) nil) t) (v (!= (iff (? c1) (? c2)) t) (= (iff (if (? a1) (? b1) (? c1)) (? c2)) t)))        (build.instantiation @- (@sigma (x1 . (? a1)) (y1 . (? b1)) (z1 . (? c1)) (z2 . (? c2)))))
+           ((v P (= (iff (if (? a1) (? b1) (? c1)) (? c2)) t))                                                             (rw.two-disjoined-modus-ponens *1 *2 @-)))
+  :minatbl ((if . 3)))
+
+
+
+(defderiv rw.disjoined-iff-implies-equal-if-specialcase-t-bldr
+  :derive (v P (= (equal (if (? a1) (? b1) (? c1)) (? b2)) t))
+  :from   ((proof x (v P (= (iff (? a1) (? a2)) t)))
+           (proof y (v P (!= (? a2) nil)))
+           (proof z (v P (= (equal (? b1) (? b2)) t)))
+           (term c1 (? c1)))
+  :proof  (@derive
+           ((v P (= (iff (? a1) (? a2)) t))                                                                                                          (@given x) *1)
+           ((v P (!= (? a2) nil))                                                                                                                    (@given y) *2)
+           ((v P (= (equal (? b1) (? b2)) t))                                                                                                        (@given z) *3)
+           ((v (!= (iff x1 x2) t) (v (= x2 nil) (v (!= (equal y1 y2) t) (= (equal (if x1 y1 z1) y2) t))))                                            (build.theorem (rw.theorem-iff-implies-equal-if-specialcase-t)))
+           ((v (!= (iff (? a1) (? a2)) t) (v (= (? a2) nil) (v (!= (equal (? b1) (? b2)) t) (= (equal (if (? a1) (? b1) (? c1)) (? b2)) t))))        (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y1 . (? b1)) (y2 . (? b2)) (z1 . (? c1)))))
+           ((v P (= (equal (if (? a1) (? b1) (? c1)) (? b2)) t))                                                                                     (rw.disjoined-mp-mp2-mp *1 *2 *3 @-)))
+  :minatbl ((equal . 2)
+            (if . 3)))
+
+(defderiv rw.disjoined-iff-implies-iff-if-specialcase-t-bldr
+  :derive (v P (= (iff (if (? a1) (? b1) (? c1)) (? b2)) t))
+  :from   ((proof x (v P (= (iff (? a1) (? a2)) t)))
+           (proof y (v P (!= (? a2) nil)))
+           (proof z (v P (= (iff (? b1) (? b2)) t)))
+           (term c1 (? c1)))
+  :proof  (@derive
+           ((v P (= (iff (? a1) (? a2)) t))                                                                                                      (@given x) *1)
+           ((v P (!= (? a2) nil))                                                                                                                (@given y) *2)
+           ((v P (= (iff (? b1) (? b2)) t))                                                                                                      (@given z) *3)
+           ((v (!= (iff x1 x2) t) (v (= x2 nil) (v (!= (iff y1 y2) t) (= (iff (if x1 y1 z1) y2) t))))                                            (build.theorem (rw.theorem-iff-implies-iff-if-specialcase-t)))
+           ((v (!= (iff (? a1) (? a2)) t) (v (= (? a2) nil) (v (!= (iff (? b1) (? b2)) t) (= (iff (if (? a1) (? b1) (? c1)) (? b2)) t))))        (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y1 . (? b1)) (y2 . (? b2)) (z1 . (? c1)))))
+           ((v P (= (iff (if (? a1) (? b1) (? c1)) (? b2)) t))                                                                                   (rw.disjoined-mp-mp2-mp *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/basic-recognizers.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/basic-recognizers.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/basic-recognizers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/basic-recognizers.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,367 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tracep")
+(include-book "../evaluator")
+(include-book "../../defderiv/defderiv")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund rw.fail-tracep (x)
+  ;;
+  ;; -----------------------------
+  ;;   [hyps ->] (equiv x x) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let ((method    (rw.trace->method x))
+        (lhs       (rw.trace->lhs x))
+        (rhs       (rw.trace->rhs x))
+        (subtraces (rw.trace->subtraces x))
+        (extras    (rw.trace->extras x)))
+    (and (equal method 'fail)
+         (equal lhs rhs)
+         (not subtraces)
+         (not extras))))
+
+(defthm booleanp-of-rw.fail-tracep
+  (equal (booleanp (rw.fail-tracep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.fail-tracep))))
+
+
+
+(defund rw.transitivity-tracep (x)
+  ;;   [hyps ->] (equiv a b) = t
+  ;;   [hyps ->] (equiv b c) = t
+  ;; -----------------------------
+  ;;   [hyps ->] (equiv a c) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let ((method    (rw.trace->method x))
+        (hypbox    (rw.trace->hypbox x))
+        (lhs       (rw.trace->lhs x))
+        (rhs       (rw.trace->rhs x))
+        (iffp      (rw.trace->iffp x))
+        (subtraces (rw.trace->subtraces x))
+        (extras    (rw.trace->extras x)))
+    (and (equal method 'transitivity)
+         (equal (len subtraces) 2)
+         (not extras)
+         (let ((equiv-a-b (first subtraces))
+               (equiv-b-c (second subtraces)))
+           (and (equal (rw.trace->iffp equiv-a-b) iffp)
+                (equal (rw.trace->iffp equiv-b-c) iffp)
+                (equal (rw.trace->hypbox equiv-a-b) hypbox)
+                (equal (rw.trace->hypbox equiv-b-c) hypbox)
+                (equal (rw.trace->lhs equiv-a-b) lhs)
+                (equal (rw.trace->rhs equiv-a-b) (rw.trace->lhs equiv-b-c))
+                (equal (rw.trace->rhs equiv-b-c) rhs))))))
+
+(defthm booleanp-of-rw.transitivity-tracep
+  (equal (booleanp (rw.transitivity-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.transitivity-tracep)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund rw.equiv-by-args-tracep (x)
+  ;;   [hyps ->] (equal a1 a1') = t
+  ;;   ...
+  ;;   [hyps ->] (equal an an') = t
+  ;; -------------------------------------------------------
+  ;;   [hyps ->] (equiv (f a1 ... an) (f a1' ... an')) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let ((method    (rw.trace->method x))
+        (hypbox    (rw.trace->hypbox x))
+        (lhs       (rw.trace->lhs x))
+        (rhs       (rw.trace->rhs x))
+        (subtraces (rw.trace->subtraces x))
+        (extras    (rw.trace->extras x)))
+    (and (equal method 'equiv-by-args)
+         (logic.functionp lhs)
+         (logic.functionp rhs)
+         (equal (logic.function-name lhs) (logic.function-name rhs))
+         (equal (logic.function-args lhs) (rw.trace-list-lhses subtraces))
+         (equal (logic.function-args rhs) (rw.trace-list-rhses subtraces))
+         (all-equalp nil (rw.trace-list-iffps subtraces))
+         (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+         (not extras))))
+
+(defthm booleanp-of-rw.equiv-by-args-tracep
+  (equal (booleanp (rw.equiv-by-args-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.equiv-by-args-tracep)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund rw.lambda-equiv-by-args-tracep (x)
+  ;;   [hyps ->] (equal a1 a1') = t
+  ;;   ...
+  ;;   [hyps ->] (equal an an') = t
+  ;; -------------------------------------------------------------------------------------------------
+  ;;   [hyps ->] (equiv ((lambda (x1 ... xn) B) a1 ... an) ((lambda (x1 ... xn) B) a1' ... an')) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let ((method    (rw.trace->method x))
+        (hypbox    (rw.trace->hypbox x))
+        (lhs       (rw.trace->lhs x))
+        (rhs       (rw.trace->rhs x))
+        (subtraces (rw.trace->subtraces x))
+        (extras    (rw.trace->extras x)))
+    (and (equal method 'lambda-equiv-by-args)
+         (logic.lambdap lhs)
+         (logic.lambdap rhs)
+         (equal (logic.lambda-formals lhs) (logic.lambda-formals rhs))
+         (equal (logic.lambda-body lhs) (logic.lambda-body rhs))
+         (equal (logic.lambda-actuals lhs) (rw.trace-list-lhses subtraces))
+         (equal (logic.lambda-actuals rhs) (rw.trace-list-rhses subtraces))
+         (all-equalp nil (rw.trace-list-iffps subtraces))
+         (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+         (not extras))))
+
+(defthm booleanp-of-rw.lambda-equiv-by-args-tracep
+  (equal (booleanp (rw.lambda-equiv-by-args-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.lambda-equiv-by-args-tracep)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund rw.beta-reduction-tracep (x)
+  ;;
+  ;; ---------------------------------------------------------------------
+  ;; [hyps ->] (equiv ((lambda (x1 ... xn) B) a1 ... an) B/[Xi<-Ai]) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let ((method    (rw.trace->method x))
+        (lhs       (rw.trace->lhs x))
+        (rhs       (rw.trace->rhs x))
+        (subtraces (rw.trace->subtraces x))
+        (extras    (rw.trace->extras x)))
+    (and (equal method 'beta-reduction)
+         (logic.lambdap lhs)
+         (let ((formals (logic.lambda-formals lhs))
+               (body    (logic.lambda-body lhs))
+               (actuals (logic.lambda-actuals lhs)))
+           (equal (logic.substitute body (pair-lists formals actuals)) rhs))
+         (not subtraces)
+         (not extras))))
+
+(defthm booleanp-of-rw.beta-reduction-tracep
+  (equal (booleanp (rw.beta-reduction-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.beta-reduction-tracep)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund rw.ground-tracep (x defs)
+  ;;
+  ;; ------------------------------     where x is a ground term that simplifies to x'
+  ;;   [hyps ->] (equiv x x') = t
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs))))
+  (let ((method    (rw.trace->method x))
+        (lhs       (rw.trace->lhs x))
+        (rhs       (rw.trace->rhs x))
+        (iffp      (rw.trace->iffp x))
+        (subtraces (rw.trace->subtraces x))
+        (extras    (rw.trace->extras x))) ;; the depth
+    (and (equal method 'ground)
+         (logic.groundp lhs)
+         (not subtraces)
+         (natp extras)
+         (let ((result (generic-evaluator lhs defs extras)))
+           (and result
+                (equal rhs (if (and iffp (not (equal (logic.unquote result) nil)))
+                               ''t ;; Results should be canonical when iffp is set
+                             result)))))))
+
+(defthm booleanp-of-rw.ground-tracep
+  (equal (booleanp (rw.ground-tracep x defs))
+         t)
+  :hints(("Goal" :in-theory (enable rw.ground-tracep))))
+
+
+
+
+(defund@ rw.if-specialcase-nil-tracep (x)
+  ;;   [hyps ->] (iff a1 nil) = t
+  ;;   [hyps ->] (equiv c1 c2) = t
+  ;; ------------------------------------------
+  ;;   [hyps ->] (equiv (if a1 b1 c1) c2) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (hypbox    (rw.trace->hypbox x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'if-specialcase-nil)
+         (equal (len subtraces) 2)
+         (equal (rw.trace->hypbox (first subtraces)) hypbox)
+         (equal (rw.trace->hypbox (second subtraces)) hypbox)
+         (rw.trace->iffp (first subtraces))
+         (equal (rw.trace->iffp (second subtraces)) iffp)
+         (@match (term (rw.trace->lhs (first subtraces)) (? a1))
+                 (term (rw.trace->rhs (first subtraces)) nil)
+                 (term (rw.trace->lhs (second subtraces)) (? c1))
+                 (term (rw.trace->rhs (second subtraces)) (? c2))
+                 (term lhs (if (? a1) (? b1) (? c1)))
+                 (term rhs (? c2)))
+         (not extras))))
+
+(defthm booleanp-of-rw.if-specialcase-nil-tracep
+  (equal (booleanp (rw.if-specialcase-nil-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.if-specialcase-nil-tracep)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund@ rw.if-specialcase-t-tracep (x)
+  ;;   [hyps ->] (iff a1 const) = t
+  ;;   [hyps ->] (equiv b1 b2) = t
+  ;; ------------------------------------------   where const is a non-nil constant
+  ;;   [hyps ->] (equiv (if a1 b1 c1) b2) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (hypbox    (rw.trace->hypbox x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'if-specialcase-t)
+         (equal (len subtraces) 2)
+         (equal (rw.trace->hypbox (first subtraces)) hypbox)
+         (equal (rw.trace->hypbox (second subtraces)) hypbox)
+         (rw.trace->iffp (first subtraces))
+         (equal (rw.trace->iffp (second subtraces)) iffp)
+         (@match (term (rw.trace->lhs (first subtraces)) (? a1))
+                 (term (rw.trace->rhs (first subtraces)) (? const))
+                 (term (rw.trace->lhs (second subtraces)) (? b1))
+                 (term (rw.trace->rhs (second subtraces)) (? b2))
+                 (term lhs (if (? a1) (? b1) (? c1)))
+                 (term rhs (? b2)))
+         (logic.constantp (@term (? const)))
+         (not (equal (logic.unquote (@term (? const))) nil))
+         (not extras))))
+
+(defthm booleanp-of-rw.if-specialcase-t-tracep
+  (equal (booleanp (rw.if-specialcase-t-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.if-specialcase-t-tracep)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+
+(defund@ rw.not-tracep (x)
+  ;;      [hyps ->] (iff x x-prime) = t
+  ;;    -----------------------------------------------
+  ;;      [hyps ->] (equiv (not x) (not x-prime)) = t     General Case
+  ;; or   [hyps ->] (equiv (not x) t) = t                 When x-prime is nil
+  ;; or   [hyps ->] (equiv (not x) nil) = t               When x-prime is t
+  (declare (xargs :guard (rw.tracep x)))
+  (let ((method    (rw.trace->method x))
+        (hypbox    (rw.trace->hypbox x))
+        (lhs       (rw.trace->lhs x))
+        (rhs       (rw.trace->rhs x))
+        (subtraces (rw.trace->subtraces x)))
+    (and (equal method 'not)
+         (logic.functionp lhs)
+         (let ((name (logic.function-name lhs))
+               (args (logic.function-args lhs)))
+           (and (equal name 'not)
+                (equal (len args) 1)
+                (equal (len subtraces) 1)
+                (let ((guts (first args))
+                      (sub1 (first subtraces)))
+                  (and (equal (rw.trace->hypbox sub1) hypbox)
+                       (equal (rw.trace->iffp sub1) t)
+                       (equal (rw.trace->lhs sub1) guts)
+                       (let ((sub1-rhs (rw.trace->rhs sub1)))
+                         (cond ((equal sub1-rhs ''t)
+                                (equal rhs ''nil))
+                               ((equal sub1-rhs ''nil)
+                                (equal rhs ''t))
+                               (t
+                                (equal rhs (logic.function 'not (list sub1-rhs)))))))))))))
+
+(defthm booleanp-of-rw.not-tracep
+  (equal (booleanp (rw.not-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.not-tracep)
+                                 ((:executable-counterpart ACL2::force))))))
+
+
+
+
+(defund@ rw.negative-if-tracep (x)
+  ;;
+  ;; ----------------------------------------------
+  ;;   [hyps ->] (equiv (if x nil t) (not x)) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let ((method    (rw.trace->method x))
+        (lhs       (rw.trace->lhs x))
+        (rhs       (rw.trace->rhs x))
+        (subtraces (rw.trace->subtraces x))
+        (extras    (rw.trace->extras x)))
+    (and (equal method 'negative-if)
+         (not subtraces)
+         (not extras)
+         (logic.functionp lhs)
+         (logic.functionp rhs)
+         (let ((lhs-name (logic.function-name lhs))
+               (lhs-args (logic.function-args lhs))
+               (rhs-name (logic.function-name rhs))
+               (rhs-args (logic.function-args rhs)))
+           (and (equal lhs-name 'if)
+                (equal (len lhs-args) 3)
+                (equal (second lhs-args) ''nil)
+                (equal (third lhs-args) ''t)
+                (equal rhs-name 'not)
+                (equal (len rhs-args) 1)
+                (equal (first lhs-args) (first rhs-args)))))))
+
+(defthm booleanp-of-rw.negative-if-tracep
+  (equal (booleanp (rw.negative-if-tracep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.negative-if-tracep))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/cert.acl2 acl2-6.3/books/milawa/ACL2/rewrite/traces/cert.acl2
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/cert.acl2	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/collect-forced-goals.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/collect-forced-goals.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/collect-forced-goals.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/collect-forced-goals.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,421 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defthm revappend-under-iff
+  (iff (revappend x acc)
+       (or (consp x)
+           acc))
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+(defthm consp-of-revappend
+  (equal (consp (revappend x acc))
+         (or (consp x)
+             (consp acc)))
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+(defthm memberp-of-revappend
+  (equal (memberp a (revappend x acc))
+         (or (memberp a x)
+             (memberp a acc)))
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+(defthm subsetp-of-revappend-one
+  (equal (subsetp x (revappend x acc))
+         t)
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+(defthm subsetp-of-revappend-two
+  (equal (subsetp acc (revappend x acc))
+         t)
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+(defthm true-listp-of-revappend
+  (equal (true-listp (revappend x acc))
+         (true-listp acc))
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+(defthm logic.formula-listp-of-revappend
+  (implies (force (and (logic.formula-listp x)
+                       (logic.formula-listp acc)))
+           (equal (logic.formula-listp (revappend x acc))
+                  t))
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+(defthm logic.formula-list-atblp-of-revappend
+  (implies (force (and (logic.formula-list-atblp x atbl)
+                       (logic.formula-list-atblp acc atbl)))
+           (equal (logic.formula-list-atblp (revappend x acc) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+
+
+(definlined fast-merge (x y)
+  ;; This is never worse and is sometimes faster than revappend.  But unlike
+  ;; revappend is does not produce a very predictable result.  You may be able
+  ;; to use it when the only thing you care about is that the joined list has
+  ;; all the members of x and y.
+  (declare (xargs :guard (and (true-listp x)
+                              (true-listp y))))
+  (if (consp x)
+      (if (consp y)
+          ;; This is just an inlined call of revappend.
+          (revappend (cdr x) (cons (car x) y))
+        x)
+    y))
+
+(defthm consp-of-fast-merge
+  (equal (consp (fast-merge x y))
+         (or (consp x)
+             (consp y)))
+  :hints(("Goal" :in-theory (e/d (fast-merge)
+                                 (forcing-revappend-removal)))))
+
+(defthm true-listp-of-fast-merge
+  (implies (force (and (true-listp x)
+                       (true-listp y)))
+           (equal (true-listp (fast-merge x y))
+                  t))
+  :hints(("Goal" :in-theory (enable fast-merge))))
+
+(defthm memberp-of-fast-merge
+  (equal (memberp a (fast-merge x y))
+         (or (memberp a x)
+             (memberp a y)))
+  :hints(("Goal" :in-theory (e/d (fast-merge)
+                                 (forcing-revappend-removal)))))
+
+(defthm subsetp-of-fast-merge-one
+  (equal (subsetp x (fast-merge x y))
+         t)
+  :hints(("Goal" :in-theory (e/d (fast-merge)
+                                 (forcing-revappend-removal)))))
+
+(defthm subsetp-of-fast-merge-two
+  (equal (subsetp y (fast-merge x y))
+         t)
+  :hints(("Goal"
+          :in-theory (e/d (fast-merge)
+                          (forcing-revappend-removal
+                           subsetp-of-revappend-two))
+          :use ((:instance subsetp-of-revappend-two
+                           (x x)
+                           (acc y)))
+          :expand (revappend x y))))
+
+(defthm logic.formula-listp-of-fast-merge
+  (implies (force (and (logic.formula-listp x)
+                       (logic.formula-listp y)))
+           (equal (logic.formula-listp (fast-merge x y))
+                  t))
+  :hints(("Goal" :in-theory (e/d (fast-merge)
+                                 (forcing-revappend-removal)))))
+
+(defthm logic.formula-list-atblp-of-fast-merge
+  (implies (force (and (logic.formula-list-atblp x atbl)
+                       (logic.formula-list-atblp y atbl)))
+           (equal (logic.formula-list-atblp (fast-merge x y) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (fast-merge)
+                                 (forcing-revappend-removal)))))
+
+(defthm fast-merge-when-not-consp-left
+  (implies (not (consp x))
+           (equal (fast-merge x y)
+                  y))
+  :hints(("Goal" :in-theory (enable fast-merge))))
+
+(defthm fast-merge-with-nil-left
+  (equal (fast-merge nil x)
+         x)
+  :hints(("Goal" :in-theory (enable fast-merge))))
+
+(defthm fast-merge-when-not-consp-right
+  (implies (not (consp y))
+           (equal (fast-merge x y)
+                  (if (consp x)
+                      x
+                    y)))
+  :hints(("Goal" :in-theory (enable fast-merge))))
+
+(defthm fast-merge-with-nil-right
+  (equal (fast-merge x nil)
+         (if (consp x)
+             x
+           nil))
+  :hints(("Goal" :in-theory (enable fast-merge))))
+
+
+;; Collecting forced goals from traces.
+;;
+;; I originally implemented the forced-goals collection with the following very
+;; fast, tail-recursive, accumulator-style routine:
+;;
+;;   (defund rw.flag-collect-forced-goals (flag x acc)
+;;     (declare (xargs :guard (if (equal flag 'term)
+;;                                (rw.tracep x)
+;;                              (rw.trace-listp x))
+;;                     :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+;;     (if (equal flag 'term)
+;;         (cond ((equal (rw.trace->method x) 'force)
+;;                (cons (rw.trace-formula x) acc))
+;;               (t
+;;                (rw.flag-collect-forced-goals 'list (rw.trace->subtraces x) acc)))
+;;       (if (consp x)
+;;           (rw.flag-collect-forced-goals 'term
+;;                                         (car x)
+;;                                         (rw.flag-collect-forced-goals 'list (cdr x) acc))
+;;         acc)))
+;;
+;; This routine is provably equal to:
+;;
+;;   (defund rw.slow-collect-forced-goals (flag x)
+;;     (declare (xargs :guard (if (equal flag 'term)
+;;                                (rw.tracep x)
+;;                              (rw.trace-listp x))
+;;                     :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+;;     (if (equal flag 'term)
+;;         (cond ((equal (rw.trace->method x) 'force)
+;;                (list (rw.trace-formula x)))
+;;               (t
+;;                (rw.slow-collect-forced-goals 'list (rw.trace->subtraces x))))
+;;       (if (consp x)
+;;           (app (rw.slow-collect-forced-goals 'term (car x))
+;;                (rw.slow-collect-forced-goals 'list (cdr x)))
+;;         nil)))
+;;
+;; But now I use a less-optimized routine based on revappend.  Why?  The
+;; problem is that we want to compute exactly the same forced goals on fast
+;; traces as for regular traces.  But in the fast traces, we have to collect
+;; the forced goals incrementally as we construct the trace, and we do not have
+;; the benefit of an accumulator.  This means that the fast rewriter would have
+;; to aggregate its forced goals with app (or fast-app), as above in
+;; slow-collect-forced-goals.  But we would prefer to make the fast rewriter
+;; faster by using revappend, even though it means making the regular rewriter
+;; slightly slower.
+
+(defund rw.flag-collect-forced-goals (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (rw.tracep x)
+                           (rw.trace-listp x))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (cond ((equal (rw.trace->method x) 'force)
+             (list (rw.trace-formula x)))
+            (t
+             (rw.flag-collect-forced-goals 'list (rw.trace->subtraces x))))
+    (if (consp x)
+        (fast-merge (rw.flag-collect-forced-goals 'term (car x))
+                    (rw.flag-collect-forced-goals 'list (cdr x)))
+      nil)))
+
+(defthm true-listp-of-rw.flag-collect-forced-goals
+  (equal (true-listp (rw.flag-collect-forced-goals flag x))
+         t)
+   :hints(("Goal" :in-theory (enable rw.flag-collect-forced-goals))))
+
+(verify-guards rw.flag-collect-forced-goals)
+
+
+(definlined rw.collect-forced-goals (x)
+  (declare (xargs :guard (rw.tracep x)))
+  (rw.flag-collect-forced-goals 'term x))
+
+(definlined rw.collect-forced-goals-list (x)
+  (declare (xargs :guard (rw.trace-listp x)))
+  (rw.flag-collect-forced-goals 'list x))
+
+(defthmd definition-of-rw.collect-forced-goals
+  (equal (rw.collect-forced-goals x)
+         (cond ((equal (rw.trace->method x) 'force)
+                (list (rw.trace-formula x)))
+               (t
+                (rw.collect-forced-goals-list (rw.trace->subtraces x)))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.collect-forced-goals
+                                    rw.collect-forced-goals-list
+                                    rw.flag-collect-forced-goals))))
+
+(defthmd definition-of-rw.collect-forced-goals-list
+  (equal (rw.collect-forced-goals-list x)
+         (if (consp x)
+             (fast-merge (rw.collect-forced-goals (car x))
+                         (rw.collect-forced-goals-list (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.collect-forced-goals
+                                    rw.collect-forced-goals-list
+                                    rw.flag-collect-forced-goals))))
+
+(defthm rw.flag-collect-forced-goals-of-term
+  (equal (rw.flag-collect-forced-goals 'term x)
+         (rw.collect-forced-goals x))
+  :hints(("Goal" :in-theory (enable rw.collect-forced-goals))))
+
+(defthm rw.flag-collect-forced-goals-of-list
+  (equal (rw.flag-collect-forced-goals 'list x)
+         (rw.collect-forced-goals-list x))
+  :hints(("Goal" :in-theory (enable rw.collect-forced-goals-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.collect-forced-goals))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.collect-forced-goals-list))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.flag-collect-forced-goals))))
+
+(defthm rw.collect-forced-goals-list-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.collect-forced-goals-list x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals-list))))
+
+(defthm rw.collect-forced-goals-list-of-cons
+  (equal (rw.collect-forced-goals-list (cons a x))
+         (fast-merge (rw.collect-forced-goals a)
+                     (rw.collect-forced-goals-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals-list))))
+
+(defthms-flag
+  :thms ((term true-listp-of-rw.collect-forced-goals
+               (equal (true-listp (rw.collect-forced-goals x))
+                      t))
+         (t true-listp-of-rw.collect-forced-goals-list
+            (equal (true-listp (rw.collect-forced-goals-list x))
+                   t)))
+  :hints (("Goal"
+           :induct (rw.trace-induction flag x)
+           :in-theory (enable definition-of-rw.collect-forced-goals))))
+
+(defthms-flag
+  :thms ((term forcing-logic.formula-listp-of-rw.collect-forced-goals
+               (implies (force (rw.tracep x))
+                        (equal (logic.formula-listp (rw.collect-forced-goals x))
+                               t)))
+         (t forcing-logic.formula-listp-of-rw.collect-forced-goals-list
+            (implies (force (rw.trace-listp x))
+                     (equal (logic.formula-listp (rw.collect-forced-goals-list x))
+                            t))))
+  :hints (("Goal"
+           :induct (rw.trace-induction flag x)
+           :in-theory (enable definition-of-rw.collect-forced-goals))))
+
+(defthms-flag
+  :shared-hyp (force (and (equal (cdr (lookup 'equal atbl)) 2)
+                          (equal (cdr (lookup 'iff atbl)) 2)))
+  :thms ((term forcing-logic.formula-list-atblp-of-rw.collect-forced-goals
+               (implies (force (and (rw.tracep x)
+                                    (rw.trace-atblp x atbl)))
+                        (equal (logic.formula-list-atblp (rw.collect-forced-goals x) atbl)
+                               t)))
+         (t forcing-logic.formula-list-atblp-of-rw.collect-forced-goals-list
+            (implies (force (and (rw.trace-listp x)
+                                 (rw.trace-list-atblp x atbl)))
+                     (equal (logic.formula-list-atblp (rw.collect-forced-goals-list x) atbl)
+                            t))))
+  :hints (("Goal"
+           :induct (rw.trace-induction flag x)
+           :in-theory (enable definition-of-rw.collect-forced-goals))))
+
+(defthm memberp-of-rw.trace-conclusion-formula-in-rw.collect-forced-goals
+  (implies (force (equal (rw.trace->method x) 'force))
+           (equal (memberp (rw.trace-formula x) (rw.collect-forced-goals x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals))))
+
+(defthm forcing-subsetp-of-rw.collect-forced-goals-list-of-subtraces
+  (implies (force (and (rw.tracep x)
+                       (rw.trace-okp x defs)))
+           (subsetp (rw.collect-forced-goals-list (rw.trace->subtraces x))
+                    (rw.collect-forced-goals x)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals
+                                    definition-of-rw.trace-okp
+                                    rw.trace-step-okp
+                                    rw.force-tracep))))
+
+
+
+(defund rw.collect-forced-goals-list-list (x)
+  (declare (xargs :guard (rw.trace-list-listp x)))
+  (if (consp x)
+      (fast-merge (rw.collect-forced-goals-list (car x))
+                  (rw.collect-forced-goals-list-list (cdr x)))
+    nil))
+
+(defthm true-listp-of-rw.collect-forced-goals-list-list
+   (equal (true-listp (rw.collect-forced-goals-list-list x))
+          t)
+   :hints(("Goal" :in-theory (enable rw.collect-forced-goals-list-list))))
+
+(defthm rw.collect-forced-goals-list-list-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.collect-forced-goals-list-list x)
+                  nil))
+  :hints(("Goal" :in-theory (enable rw.collect-forced-goals-list-list))))
+
+(defthm rw.collect-forced-goals-list-list-of-cons
+  (equal (rw.collect-forced-goals-list-list (cons a x))
+         (fast-merge (rw.collect-forced-goals-list a)
+                     (rw.collect-forced-goals-list-list x)))
+  :hints(("Goal" :in-theory (enable rw.collect-forced-goals-list-list))))
+
+(defthm forcing-rw.formula-listp-of-rw.collect-forced-goals-list-list
+  (implies (force (rw.trace-list-listp x))
+           (equal (logic.formula-listp (rw.collect-forced-goals-list-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+;; BOZO errr, don't have a trace-list-list-atblp, maybe we won't need it.
+;; (defthm forcing-rw.formula-list-atblp-of-rw.collect-forced-goals-list-list
+;;   (implies (force (rw.trace-list-list-atblp x atbl))
+;;            (equal (logic.formula-list-atblp (rw.collect-forced-goals-list-list x) atbl)
+;;                   t))
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-builders.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-builders.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-builders.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-builders.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,931 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-builders") ;; for fail-trace
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(local (in-theory (e/d (booleanp-of-rw.trace->iffp)
+                       (forcing-booleanp-of-rw.trace->iffp))))
+
+
+
+(defund rw.crewrite-if-specialcase-same-trace (x y z)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.tracep y)
+                              (rw.tracep z)
+                              (rw.trace->iffp x)
+                              (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                              (equal (rw.trace->rhs y) (rw.trace->rhs z))
+                              (equal (rw.hypbox->left (rw.trace->hypbox y))
+                                     (cons (logic.function 'not (list (rw.trace->rhs x)))
+                                           (rw.hypbox->left (rw.trace->hypbox x))))
+                              (equal (rw.hypbox->left (rw.trace->hypbox z))
+                                     (cons (rw.trace->rhs x)
+                                           (rw.hypbox->left (rw.trace->hypbox x))))
+                              (equal (rw.hypbox->right (rw.trace->hypbox y))
+                                     (rw.hypbox->right (rw.trace->hypbox x)))
+                              (equal (rw.hypbox->right (rw.trace->hypbox z))
+                                     (rw.hypbox->right (rw.trace->hypbox x))))))
+  (rw.trace 'crewrite-if-specialcase-same
+            (rw.trace->hypbox x)
+            (logic.function 'if (list (rw.trace->lhs x) (rw.trace->lhs y) (rw.trace->lhs z)))
+            (rw.trace->rhs y)
+            (rw.trace->iffp y)
+            (list x y z)
+            nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-if-specialcase-same-trace)))
+
+ (defthmd lemma-rw.trace->method-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.trace->method (rw.crewrite-if-specialcase-same-trace x y z))
+          'crewrite-if-specialcase-same))
+
+ (defthm rw.trace->hypbox-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.trace->hypbox (rw.crewrite-if-specialcase-same-trace x y z))
+          (rw.trace->hypbox x)))
+
+ (defthm rw.trace->lhs-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.trace->lhs (rw.crewrite-if-specialcase-same-trace x y z))
+          (logic.function 'if (list (rw.trace->lhs x) (rw.trace->lhs y) (rw.trace->lhs z)))))
+
+ (defthm rw.trace->rhs-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.trace->rhs (rw.crewrite-if-specialcase-same-trace x y z))
+          (rw.trace->rhs y)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.trace->iffp (rw.crewrite-if-specialcase-same-trace x y z))
+          (rw.trace->iffp y)))
+
+ (defthmd lemma-rw.trace->subtraces-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.trace->subtraces (rw.crewrite-if-specialcase-same-trace x y z))
+          (list x y z)))
+
+ (defthmd lemma-rw.trace->extras-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.trace->extras (rw.crewrite-if-specialcase-same-trace x y z))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)))
+            (equal (rw.tracep (rw.crewrite-if-specialcase-same-trace x y z))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.trace-atblp x atbl)
+                        (rw.trace-atblp y atbl)
+                        (rw.trace-atblp z atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (rw.trace-atblp (rw.crewrite-if-specialcase-same-trace x y z) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.crewrite-if-specialcase-same-trace)))
+ (local (in-theory (enable lemma-rw.trace->method-of-rw.crewrite-if-specialcase-same-trace
+                           lemma-rw.trace->subtraces-of-rw.crewrite-if-specialcase-same-trace
+                           lemma-rw.trace->extras-of-rw.crewrite-if-specialcase-same-trace)))
+
+ (defthmd lemma-forcing-rw.crewrite-if-specialcase-same-tracep-of-rw.crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                        (equal (rw.trace->rhs y) (rw.trace->rhs z))
+                        (equal (rw.hypbox->left (rw.trace->hypbox y))
+                               (cons (logic.function 'not (list (rw.trace->rhs x)))
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->left (rw.trace->hypbox z))
+                               (cons (rw.trace->rhs x)
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->right (rw.trace->hypbox y))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        (equal (rw.hypbox->right (rw.trace->hypbox z))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        ))
+            (equal (rw.crewrite-if-specialcase-same-tracep (rw.crewrite-if-specialcase-same-trace x y z))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.crewrite-if-specialcase-same-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                        (equal (rw.trace->rhs y) (rw.trace->rhs z))
+                        (equal (rw.hypbox->left (rw.trace->hypbox y))
+                               (cons (logic.function 'not (list (rw.trace->rhs x)))
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->left (rw.trace->hypbox z))
+                               (cons (rw.trace->rhs x)
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->right (rw.trace->hypbox y))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        (equal (rw.hypbox->right (rw.trace->hypbox z))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        ))
+            (equal (rw.trace-step-okp (rw.crewrite-if-specialcase-same-trace x y z) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.crewrite-if-specialcase-same-tracep-of-rw.crewrite-if-specialcase-same-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                        (equal (rw.trace->rhs y) (rw.trace->rhs z))
+                        (equal (rw.hypbox->left (rw.trace->hypbox y))
+                               (cons (logic.function 'not (list (rw.trace->rhs x)))
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->left (rw.trace->hypbox z))
+                               (cons (rw.trace->rhs x)
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->right (rw.trace->hypbox y))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        (equal (rw.hypbox->right (rw.trace->hypbox z))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        ;; ---
+                        (rw.trace-okp x defs)
+                        (rw.trace-okp y defs)
+                        (rw.trace-okp z defs)))
+            (equal (rw.trace-okp (rw.crewrite-if-specialcase-same-trace x y z) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.crewrite-if-specialcase-same-trace x y z) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.crewrite-if-specialcase-same-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.trace-step-env-okp (rw.crewrite-if-specialcase-same-trace x y z) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.trace-env-okp x defs thms atbl)
+                        (rw.trace-env-okp y defs thms atbl)
+                        (rw.trace-env-okp z defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.crewrite-if-specialcase-same-trace x y z) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.crewrite-if-specialcase-same-trace x y z) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-if-specialcase-same-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.crewrite-if-specialcase-same-trace
+   (equal (rw.collect-forced-goals (rw.crewrite-if-specialcase-same-trace x y z))
+          (fast-merge (rw.collect-forced-goals x)
+                      (fast-merge (rw.collect-forced-goals y)
+                                  (rw.collect-forced-goals z))))
+   :hints(("Goal" :expand (rw.collect-forced-goals (rw.crewrite-if-specialcase-same-trace x y z))))))
+
+
+
+
+(defund rw.crewrite-if-generalcase-trace (x y z)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.tracep y)
+                              (rw.tracep z)
+                              (rw.trace->iffp x)
+                              (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                              (equal (rw.hypbox->left (rw.trace->hypbox y))
+                                     (cons (logic.function 'not (list (rw.trace->rhs x)))
+                                           (rw.hypbox->left (rw.trace->hypbox x))))
+                              (equal (rw.hypbox->left (rw.trace->hypbox z))
+                                     (cons (rw.trace->rhs x)
+                                           (rw.hypbox->left (rw.trace->hypbox x))))
+                              (equal (rw.hypbox->right (rw.trace->hypbox y))
+                                     (rw.hypbox->right (rw.trace->hypbox x)))
+                              (equal (rw.hypbox->right (rw.trace->hypbox z))
+                                     (rw.hypbox->right (rw.trace->hypbox x)))
+                              )))
+  (let ((hypbox (rw.trace->hypbox x))
+        (iffp   (rw.trace->iffp y))
+        (lhs    (logic.function 'if (list (rw.trace->lhs x) (rw.trace->lhs y) (rw.trace->lhs z))))
+        (rhs    (logic.function 'if (list (rw.trace->rhs x) (rw.trace->rhs y) (rw.trace->rhs z)))))
+    ;; Another optimization it's too bad we lose.
+    ;(if (equal lhs rhs)
+    ;    (rw.fail-trace hypbox lhs iffp)
+    (rw.trace 'crewrite-if-generalcase hypbox lhs rhs iffp (list x y z) nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-if-generalcase-trace)))
+
+ (defthm rw.trace->method-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.trace->method (rw.crewrite-if-generalcase-trace x y z))
+          'crewrite-if-generalcase))
+
+ (defthm rw.trace->hypbox-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.trace->hypbox (rw.crewrite-if-generalcase-trace x y z))
+          (rw.trace->hypbox x))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->lhs-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.trace->lhs (rw.crewrite-if-generalcase-trace x y z))
+          (logic.function 'if (list (rw.trace->lhs x) (rw.trace->lhs y) (rw.trace->lhs z))))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->rhs-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.trace->rhs (rw.crewrite-if-generalcase-trace x y z))
+          (logic.function 'if (list (rw.trace->rhs x) (rw.trace->rhs y) (rw.trace->rhs z))))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm forcing-rw.trace->iffp-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.trace->iffp (rw.crewrite-if-generalcase-trace x y z))
+          (rw.trace->iffp y))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->subtraces-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.trace->subtraces (rw.crewrite-if-generalcase-trace x y z))
+          (list x y z))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.trace->extras-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.trace->extras (rw.crewrite-if-generalcase-trace x y z))
+          nil)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm forcing-rw.tracep-of-rw.crewrite-if-generalcase-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)))
+            (equal (rw.tracep (rw.crewrite-if-generalcase-trace x y z))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.crewrite-if-generalcase-trace
+   (implies (force (and (rw.trace-atblp x atbl)
+                        (rw.trace-atblp y atbl)
+                        (rw.trace-atblp z atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (rw.trace-atblp (rw.crewrite-if-generalcase-trace x y z) atbl)
+                   t))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (disable rw.crewrite-if-generalcase-trace)))
+
+ (defthmd lemma-forcing-rw.crewrite-if-generalcase-tracep-of-rw.crewrite-if-generalcase-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                        (equal (rw.hypbox->left (rw.trace->hypbox y))
+                               (cons (logic.function 'not (list (rw.trace->rhs x)))
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->left (rw.trace->hypbox z))
+                               (cons (rw.trace->rhs x)
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->right (rw.trace->hypbox y))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        (equal (rw.hypbox->right (rw.trace->hypbox z))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        ))
+            (equal (rw.crewrite-if-generalcase-tracep (rw.crewrite-if-generalcase-trace x y z))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.crewrite-if-generalcase-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.crewrite-if-generalcase-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                        (equal (rw.hypbox->left (rw.trace->hypbox y))
+                               (cons (logic.function 'not (list (rw.trace->rhs x)))
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->left (rw.trace->hypbox z))
+                               (cons (rw.trace->rhs x)
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->right (rw.trace->hypbox y))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        (equal (rw.hypbox->right (rw.trace->hypbox z))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        ))
+            (equal (rw.trace-step-okp (rw.crewrite-if-generalcase-trace x y z) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.crewrite-if-generalcase-tracep-of-rw.crewrite-if-generalcase-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.crewrite-if-generalcase-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)
+                        (rw.trace->iffp x)
+                        (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                        (equal (rw.hypbox->left (rw.trace->hypbox y))
+                               (cons (logic.function 'not (list (rw.trace->rhs x)))
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->left (rw.trace->hypbox z))
+                               (cons (rw.trace->rhs x)
+                                     (rw.hypbox->left (rw.trace->hypbox x))))
+                        (equal (rw.hypbox->right (rw.trace->hypbox y))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        (equal (rw.hypbox->right (rw.trace->hypbox z))
+                               (rw.hypbox->right (rw.trace->hypbox x)))
+                        ;; ---
+                        (rw.trace-okp x defs)
+                        (rw.trace-okp y defs)
+                        (rw.trace-okp z defs)))
+            (equal (rw.trace-okp (rw.crewrite-if-generalcase-trace x y z) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.crewrite-if-generalcase-trace x y z) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.crewrite-if-generalcase-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.trace-step-env-okp (rw.crewrite-if-generalcase-trace x y z) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.crewrite-if-generalcase-trace
+   (implies (force (and (rw.trace-env-okp x defs thms atbl)
+                        (rw.trace-env-okp y defs thms atbl)
+                        (rw.trace-env-okp z defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.crewrite-if-generalcase-trace x y z) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.crewrite-if-generalcase-trace x y z) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-if-generalcase-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.crewrite-if-generalcase-trace
+   (equal (rw.collect-forced-goals (rw.crewrite-if-generalcase-trace x y z))
+          (fast-merge (rw.collect-forced-goals x)
+                      (fast-merge (rw.collect-forced-goals y)
+                                  (rw.collect-forced-goals z))))
+   :hints(("Goal" :expand (rw.collect-forced-goals (rw.crewrite-if-generalcase-trace x y z))))))
+
+
+
+
+
+(defund rw.assumptions-trace (assms lhs iffp)
+  (declare (xargs :guard (and (rw.assmsp assms)
+                              (logic.termp lhs)
+                              (booleanp iffp))))
+  (let ((eqtrace (rw.try-equiv-database lhs (rw.assms->eqdatabase assms) iffp)))
+    (and eqtrace
+         (rw.trace 'assumptions
+                   (rw.assms->hypbox assms)
+                   lhs
+                   (rw.eqtrace->lhs eqtrace)
+                   iffp
+                   nil
+                   eqtrace))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.assumptions-trace)))
+
+ (defthmd lemma-rw.trace->method-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace->method (rw.assumptions-trace assms lhs iffp))
+                   'assumptions)))
+
+ (defthm rw.trace->assms-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace->hypbox (rw.assumptions-trace assms lhs iffp))
+                   (rw.assms->hypbox assms))))
+
+ (defthm rw.trace->lhs-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace->lhs (rw.assumptions-trace assms lhs iffp))
+                   lhs)))
+
+ (defthmd lemma-rw.trace->rhs-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace->rhs (rw.assumptions-trace assms lhs iffp))
+                   (rw.eqtrace->lhs (rw.try-equiv-database lhs (rw.assms->eqdatabase assms) iffp)))))
+
+ (defthm rw.trace->iffp-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace->iffp (rw.assumptions-trace assms lhs iffp))
+                   iffp)))
+
+ (defthmd lemma-rw.trace->subtraces-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace->subtraces (rw.assumptions-trace assms lhs iffp))
+                   nil)))
+
+ (defthmd lemma-rw.trace->extras-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace->extras (rw.assumptions-trace assms lhs iffp))
+                   (rw.try-equiv-database lhs (rw.assms->eqdatabase assms) iffp))))
+
+ (defthm forcing-rw.tracep-of-rw.assumptions-trace
+   (implies (force (and (logic.termp lhs)
+                        (booleanp iffp)
+                        (rw.assmsp assms)
+                        (rw.assumptions-trace assms lhs iffp)))
+            (equal (rw.tracep (rw.assumptions-trace assms lhs iffp))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.assumptions-trace
+   (implies (force (and (logic.term-atblp lhs atbl)
+                        (rw.assms-atblp assms atbl)
+                        (rw.assumptions-trace assms lhs iffp)))
+            (equal (rw.trace-atblp (rw.assumptions-trace assms lhs iffp) atbl)
+                   t)))
+
+ (defthmd lemma-rw.eqtracep-of-rw.eqtrace->extras-of-rw.assumptions-trace
+   (implies (force (and (rw.assumptions-trace assms lhs iffp)
+                        (rw.assmsp assms)))
+            (equal (rw.eqtracep (rw.trace->extras (rw.assumptions-trace assms lhs iffp)))
+                   t)))
+
+ (local (in-theory (disable rw.assumptions-trace)))
+ (local (in-theory (enable lemma-rw.trace->method-of-rw.assumptions-trace
+                           lemma-rw.trace->rhs-of-rw.assumptions-trace
+                           lemma-rw.trace->subtraces-of-rw.assumptions-trace
+                           lemma-rw.trace->extras-of-rw.assumptions-trace
+                           lemma-rw.eqtracep-of-rw.eqtrace->extras-of-rw.assumptions-trace)))
+
+ (defthmd lemma-forcing-rw.assumptions-tracep-of-rw.assumptions-trace
+   (implies (force (and (logic.termp lhs)
+                        (booleanp iffp)
+                        (rw.assmsp assms)
+                        (rw.assumptions-trace assms lhs iffp)))
+            (equal (rw.assumptions-tracep (rw.assumptions-trace assms lhs iffp))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.assumptions-tracep
+                                     rw.assumptions-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.assumptions-trace
+   (implies (force (and (logic.termp lhs)
+                        (booleanp iffp)
+                        (rw.assmsp assms)
+                        (rw.assumptions-trace assms lhs iffp)))
+            (equal (rw.trace-step-okp (rw.assumptions-trace assms lhs iffp) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.assumptions-tracep-of-rw.assumptions-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.assumptions-trace
+   (implies (force (and (logic.termp lhs)
+                        (booleanp iffp)
+                        (rw.assmsp assms)
+                        (rw.assumptions-trace assms lhs iffp)))
+            (equal (rw.trace-okp (rw.assumptions-trace assms lhs iffp) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.assumptions-trace assms lhs iffp) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.assumptions-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace-step-env-okp (rw.assumptions-trace assms lhs iffp) defs thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.assumptions-trace
+   (implies (force (rw.assumptions-trace assms lhs iffp))
+            (equal (rw.trace-env-okp (rw.assumptions-trace assms lhs iffp) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.assumptions-trace assms lhs iffp) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.assumptions-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.assumptions-trace
+   (equal (rw.collect-forced-goals (rw.assumptions-trace assms lhs iffp))
+          nil)
+   :hints(("Goal"
+           :cases ((rw.assumptions-trace assms lhs iffp))
+           :expand (rw.collect-forced-goals (rw.assumptions-trace assms lhs iffp))
+           :in-theory (disable (:executable-counterpart ACL2::force))))))
+
+
+
+
+
+(defund rw.crewrite-rule-trace (hypbox lhs rule sigma iffp traces)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.termp lhs)
+                              (rw.rulep rule)
+                              (logic.sigmap sigma)
+                              (booleanp iffp)
+                              (rw.trace-listp traces)
+                              (or (equal (rw.rule->equiv rule) 'equal)
+                                  (and iffp (equal (rw.rule->equiv rule) 'iff)))
+                              (not (equal 'fail (logic.patmatch (rw.rule->lhs rule) lhs nil)))
+                              (submapp (logic.patmatch (rw.rule->lhs rule) lhs nil) sigma)
+                              (all-equalp hypbox (rw.trace-list-hypboxes traces))
+                              (all-equalp t (rw.trace-list-iffps traces))
+                              (all-equalp ''t (rw.trace-list-rhses traces))
+                              (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                                     (rw.trace-list-lhses traces)))))
+  (rw.trace 'crewrite-rule
+            hypbox
+            lhs
+            (logic.substitute (rw.rule->rhs rule) sigma)
+            iffp
+            traces
+            (list rule sigma)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-rule-trace)))
+
+ (defthm rw.crewrite-rule-trace-under-iff
+   (iff (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces)
+        t))
+
+ (defthmd lemma-rw.trace->method-of-rw.crewrite-rule-trace
+   (equal (rw.trace->method (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+          'crewrite-rule))
+
+ (defthm rw.trace->hypbox-of-rw.crewrite-rule-trace
+   (equal (rw.trace->hypbox (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+          hypbox))
+
+ (defthm rw.trace->lhs-of-rw.crewrite-rule-trace
+   (equal (rw.trace->lhs (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+          lhs))
+
+ (defthm rw.trace->rhs-of-rw.crewrite-rule-trace
+   (equal (rw.trace->rhs (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+          (logic.substitute (rw.rule->rhs rule) sigma)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.crewrite-rule-trace
+   (equal (rw.trace->iffp (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+          iffp))
+
+ (defthmd lemma-rw.trace->subtraces-of-rw.crewrite-rule-trace
+   (equal (rw.trace->subtraces (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+          traces))
+
+ (defthmd lemma-rw.trace->extras-of-rw.crewrite-rule-trace
+   (equal (rw.trace->extras (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+          (list rule sigma)))
+
+ (defthm forcing-rw.tracep-of-rw.crewrite-rule-trace
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.termp lhs)
+                        (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (booleanp iffp)
+                        (rw.trace-listp traces)))
+            (equal (rw.tracep (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.crewrite-rule-trace
+   (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                        (logic.term-atblp lhs atbl)
+                        (rw.rule-atblp rule atbl)
+                        (logic.sigma-atblp sigma atbl)
+                        (rw.trace-list-atblp traces atbl)))
+            (equal (rw.trace-atblp (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.crewrite-rule-trace)))
+ (local (in-theory (enable lemma-rw.trace->method-of-rw.crewrite-rule-trace
+                           lemma-rw.trace->subtraces-of-rw.crewrite-rule-trace
+                           lemma-rw.trace->extras-of-rw.crewrite-rule-trace)))
+
+ (defthmd lemma-forcing-rw.crewrite-rule-tracep-of-rw.crewrite-rule-trace
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.termp lhs)
+                        (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (booleanp iffp)
+                        (rw.trace-listp traces)
+                        (or (equal (rw.rule->equiv rule) 'equal)
+                            (and iffp (equal (rw.rule->equiv rule) 'iff)))
+                        (not (equal 'fail (logic.patmatch (rw.rule->lhs rule) lhs nil)))
+                        (submapp (logic.patmatch (rw.rule->lhs rule) lhs nil) sigma)
+                        (all-equalp hypbox (rw.trace-list-hypboxes traces))
+                        (all-equalp t (rw.trace-list-iffps traces))
+                        (all-equalp ''t (rw.trace-list-rhses traces))
+                        (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                               (rw.trace-list-lhses traces))))
+            (equal (rw.crewrite-rule-tracep (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.crewrite-rule-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.crewrite-rule-trace
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.termp lhs)
+                        (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (booleanp iffp)
+                        (rw.trace-listp traces)
+                        (or (equal (rw.rule->equiv rule) 'equal)
+                            (and iffp (equal (rw.rule->equiv rule) 'iff)))
+                        (not (equal 'fail (logic.patmatch (rw.rule->lhs rule) lhs nil)))
+                        (submapp (logic.patmatch (rw.rule->lhs rule) lhs nil) sigma)
+                        (all-equalp hypbox (rw.trace-list-hypboxes traces))
+                        (all-equalp t (rw.trace-list-iffps traces))
+                        (all-equalp ''t (rw.trace-list-rhses traces))
+                        (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                               (rw.trace-list-lhses traces))))
+            (equal (rw.trace-step-okp (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.crewrite-rule-tracep-of-rw.crewrite-rule-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.crewrite-rule-trace
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.termp lhs)
+                        (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (booleanp iffp)
+                        (rw.trace-listp traces)
+                        (or (equal (rw.rule->equiv rule) 'equal)
+                            (and iffp (equal (rw.rule->equiv rule) 'iff)))
+                        (not (equal 'fail (logic.patmatch (rw.rule->lhs rule) lhs nil)))
+                        (submapp (logic.patmatch (rw.rule->lhs rule) lhs nil) sigma)
+                        (all-equalp hypbox (rw.trace-list-hypboxes traces))
+                        (all-equalp t (rw.trace-list-iffps traces))
+                        (all-equalp ''t (rw.trace-list-rhses traces))
+                        (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                               (rw.trace-list-lhses traces))
+                        ;; ---
+                        (rw.trace-list-okp traces defs)))
+            (equal (rw.trace-okp (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.crewrite-rule-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-rule-trace
+   (implies (force (and (rw.rule-atblp rule atbl)
+                        (rw.rule-env-okp rule thms)
+                        (logic.sigma-atblp sigma atbl)))
+            (equal (rw.trace-step-env-okp (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces) defs thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp
+                                     rw.crewrite-rule-trace-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.crewrite-rule-trace
+   (implies (force (and (rw.rule-atblp rule atbl)
+                        (rw.rule-env-okp rule thms)
+                        (logic.sigma-atblp sigma atbl)
+                        (rw.trace-list-env-okp traces defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.crewrite-rule-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.crewrite-rule-trace
+   (equal (rw.collect-forced-goals (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))
+          (rw.collect-forced-goals-list traces))
+   :hints(("Goal" :expand (rw.collect-forced-goals (rw.crewrite-rule-trace hypbox lhs rule sigma iffp traces))))))
+
+
+
+
+
+(defund rw.force-trace (hypbox lhs)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.termp lhs))))
+  (rw.trace 'force hypbox lhs ''t t nil nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.force-trace)))
+
+ (defthm rw.force-trace-under-iff
+   (iff (rw.force-trace hypbox lhs)
+        t))
+
+ (defthmd lemma-rw.trace->method-of-rw.force-trace
+   (equal (rw.trace->method (rw.force-trace hypbox lhs))
+          'force))
+
+ (defthm rw.trace->hypbox-of-rw.force-trace
+   (equal (rw.trace->hypbox (rw.force-trace hypbox lhs))
+          hypbox))
+
+ (defthm rw.trace->lhs-of-rw.force-trace
+   (equal (rw.trace->lhs (rw.force-trace hypbox lhs))
+          lhs))
+
+ (defthm rw.trace->rhs-of-rw.force-trace
+   (equal (rw.trace->rhs (rw.force-trace hypbox lhs))
+          ''t))
+
+ (defthm forcing-rw.trace->iffp-of-rw.force-trace
+   (equal (rw.trace->iffp (rw.force-trace hypbox lhs))
+          t))
+
+ (defthmd lemma-rw.trace->subtraces-of-rw.force-trace
+   (equal (rw.trace->subtraces (rw.force-trace hypbox lhs))
+          nil))
+
+ (defthmd lemma-rw.trace->extras-of-rw.force-trace
+   (equal (rw.trace->extras (rw.force-trace hypbox lhs))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.force-trace
+   (implies (force (and (logic.termp lhs)
+                        (rw.hypboxp hypbox)))
+            (equal (rw.tracep (rw.force-trace hypbox lhs))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.force-trace
+   (implies (force (and (logic.term-atblp lhs atbl)
+                        (rw.hypbox-atblp hypbox atbl)))
+            (equal (rw.trace-atblp (rw.force-trace hypbox lhs) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.force-trace)))
+ (local (in-theory (enable lemma-rw.trace->method-of-rw.force-trace
+                           lemma-rw.trace->subtraces-of-rw.force-trace
+                           lemma-rw.trace->extras-of-rw.force-trace)))
+
+ (defthmd lemma-forcing-rw.force-tracep-of-rw.force-trace
+   (implies (force (and (logic.termp lhs)
+                        (rw.hypboxp hypbox)))
+            (equal (rw.force-tracep (rw.force-trace hypbox lhs))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.force-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.force-trace
+   (implies (force (and (logic.termp lhs)
+                        (rw.hypboxp hypbox)))
+            (equal (rw.trace-step-okp (rw.force-trace hypbox lhs) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.force-tracep-of-rw.force-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.force-trace
+   (implies (force (and (logic.termp lhs)
+                        (rw.hypboxp hypbox)))
+            (equal (rw.trace-okp (rw.force-trace hypbox lhs) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.force-trace hypbox lhs) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.force-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.force-trace
+   (equal (rw.trace-step-env-okp (rw.force-trace hypbox lhs) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.force-trace
+   (equal (rw.trace-env-okp (rw.force-trace hypbox lhs) defs thms atbl)
+          t)
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.force-trace hypbox lhs) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.force-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.force-trace
+   (equal (rw.collect-forced-goals (rw.force-trace hypbox lhs))
+          (list (rw.trace-formula (rw.force-trace hypbox lhs))))
+   :hints(("Goal" :expand (rw.collect-forced-goals (rw.force-trace hypbox lhs))))))
+
+
+
+
+
+(defund rw.weakening-trace (hypbox trace)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (rw.tracep trace)
+                              (not (rw.hypbox->left (rw.trace->hypbox trace)))
+                              (not (rw.hypbox->right (rw.trace->hypbox trace))))))
+  (rw.trace 'weakening
+            hypbox
+            (rw.trace->lhs trace)
+            (rw.trace->rhs trace)
+            (rw.trace->iffp trace)
+            (list trace)
+            nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.weakening-trace)))
+
+ (defthm rw.weakening-trace-under-iff
+   (iff (rw.weakening-trace hypbox x)
+        t))
+
+ (defthmd lemma-rw.trace->method-of-rw.weakening-trace
+   (equal (rw.trace->method (rw.weakening-trace hypbox trace))
+          'weakening))
+
+ (defthm rw.trace->hypbox-of-rw.weakening-trace
+   (equal (rw.trace->hypbox (rw.weakening-trace hypbox trace))
+          hypbox))
+
+ (defthm rw.trace->lhs-of-rw.weakening-trace
+   (equal (rw.trace->lhs (rw.weakening-trace hypbox trace))
+          (rw.trace->lhs trace)))
+
+ (defthm rw.trace->rhs-of-rw.weakening-trace
+   (equal (rw.trace->rhs (rw.weakening-trace hypbox trace))
+          (rw.trace->rhs trace)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.weakening-trace
+   (equal (rw.trace->iffp (rw.weakening-trace hypbox trace))
+          (rw.trace->iffp trace)))
+
+ (defthmd lemma-rw.trace->subtraces-of-rw.weakening-trace
+   (equal (rw.trace->subtraces (rw.weakening-trace hypbox trace))
+          (list trace)))
+
+ (defthmd lemma-rw.trace->extras-of-rw.weakening-trace
+   (equal (rw.trace->extras (rw.weakening-trace hypbox trace))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.weakening-trace
+   (implies (force (and (rw.tracep trace)
+                        (rw.hypboxp hypbox)))
+            (equal (rw.tracep (rw.weakening-trace hypbox trace))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.weakening-trace
+   (implies (force (and (rw.trace-atblp trace atbl)
+                        (rw.hypbox-atblp hypbox atbl)))
+            (equal (rw.trace-atblp (rw.weakening-trace hypbox trace) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.weakening-trace)))
+ (local (in-theory (enable lemma-rw.trace->method-of-rw.weakening-trace
+                           lemma-rw.trace->subtraces-of-rw.weakening-trace
+                           lemma-rw.trace->extras-of-rw.weakening-trace)))
+
+ (defthmd lemma-forcing-rw.weakening-tracep-of-rw.weakening-trace
+   (implies (force (and (rw.tracep trace)
+                        (rw.hypboxp hypbox)
+                        (not (rw.hypbox->left (rw.trace->hypbox trace)))
+                        (not (rw.hypbox->right (rw.trace->hypbox trace)))))
+            (equal (rw.weakening-tracep (rw.weakening-trace hypbox trace))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.weakening-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.weakening-trace
+   (implies (force (and (rw.tracep trace)
+                        (rw.hypboxp hypbox)
+                        (not (rw.hypbox->left (rw.trace->hypbox trace)))
+                        (not (rw.hypbox->right (rw.trace->hypbox trace)))))
+            (equal (rw.trace-step-okp (rw.weakening-trace hypbox trace) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.weakening-tracep-of-rw.weakening-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.weakening-trace
+   (implies (force (and (rw.tracep trace)
+                        (rw.trace-okp trace defs)
+                        (rw.hypboxp hypbox)
+                        (not (rw.hypbox->left (rw.trace->hypbox trace)))
+                        (not (rw.hypbox->right (rw.trace->hypbox trace)))))
+            (equal (rw.trace-okp (rw.weakening-trace hypbox trace) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.weakening-trace hypbox trace) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.weakening-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.weakening-trace
+   (equal (rw.trace-step-env-okp (rw.weakening-trace hypbox trace) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.weakening-trace
+   (equal (rw.trace-env-okp (rw.weakening-trace hypbox trace) defs thms atbl)
+          (rw.trace-env-okp trace defs thms atbl))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.weakening-trace hypbox trace) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.weakening-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.weakening-trace
+   (equal (rw.collect-forced-goals (rw.weakening-trace hypbox trace))
+          (rw.collect-forced-goals trace))
+   :hints(("Goal" :expand (rw.collect-forced-goals (rw.weakening-trace hypbox trace))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-compilers.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-compilers.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-compilers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-compilers.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,594 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../prop")
+(include-book "trace-okp")
+(include-book "urewrite-if-lemmas")
+(include-book "crewrite-if-lemmas")
+(include-book "crewrite-if-lemmas2")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(local (in-theory (enable rw.trace-conclusion-formula rw.trace-formula)))
+
+(defund rw.compile-crewrite-if-specialcase-same-trace-iff (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.trace->iffp x)
+                              (rw.crewrite-if-specialcase-same-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox (rw.trace->hypbox x))
+         (left   (rw.hypbox->left hypbox))
+         (right  (rw.hypbox->right hypbox)))
+    (cond ((and left right)
+           ;; Proof1 is (L v R) v (iff a1 a2) = t
+           ;; Proof2 is (( (not a2) != nil v L) v R) v (equiv b d) = t
+           ;; Proof3 is ((    a2 != nil    v L) v R) v (equiv c d) = t
+           (let ((proof2* (rw.crewrite-twiddle2-bldr (second proofs))) ;; (L v R) v (not a2) != nil (equiv b d) = t
+                 (proof3* (rw.crewrite-twiddle2-bldr (third proofs)))) ;; (L v R) v a2 != nil v (equiv b d) = t
+             (rw.disjoined-iff-of-if-x-y-y-bldr (first proofs) proof2* proof3*)))
+          ((or left right)
+           ;; Proof1 is L/R v (iff a1 a2) = t
+           ;; Proof2 is ( (not a2) != nil v L/R ) v (equiv b d) = t
+           ;; Proof3 is (    a2 != nil    v L/R ) v (equiv c d) = t
+           (let ((proof2* (rw.crewrite-twiddle-bldr (second proofs))) ;; L/R v (not a2) != nil v (equiv b d) = t
+                 (proof3* (rw.crewrite-twiddle-bldr (third proofs)))) ;; L/R v a2 != nil v (equiv c d) = t
+             (rw.disjoined-iff-of-if-x-y-y-bldr (first proofs) proof2* proof3*)))
+          (t
+           ;; Proof1 is (iff a1 a2) = t
+           ;; Proof2 is (not a2) != nil v (equiv b d) = t
+           ;; Proof3 is a2 != nil v (equiv c d) = t
+           (rw.iff-of-if-x-y-y-bldr (first proofs) (second proofs) (third proofs))))))
+
+(defund rw.compile-crewrite-if-specialcase-same-trace-equal (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (not (rw.trace->iffp x))
+                              (rw.crewrite-if-specialcase-same-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox (rw.trace->hypbox x))
+         (left   (rw.hypbox->left hypbox))
+         (right  (rw.hypbox->right hypbox)))
+    (cond ((and left right)
+           (let ((proof2* (rw.crewrite-twiddle2-bldr (second proofs)))
+                 (proof3* (rw.crewrite-twiddle2-bldr (third proofs))))
+             (rw.disjoined-equal-of-if-x-y-y-bldr (first proofs) proof2* proof3*)))
+          ((or left right)
+           (let ((proof2* (rw.crewrite-twiddle-bldr (second proofs)))
+                 (proof3* (rw.crewrite-twiddle-bldr (third proofs))))
+             (rw.disjoined-equal-of-if-x-y-y-bldr (first proofs) proof2* proof3*)))
+          (t
+           (rw.equal-of-if-x-y-y-bldr (first proofs) (second proofs) (third proofs))))))
+
+
+(defund rw.compile-crewrite-if-specialcase-same-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.crewrite-if-specialcase-same-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (if (rw.trace->iffp x)
+      (rw.compile-crewrite-if-specialcase-same-trace-iff x proofs)
+    (rw.compile-crewrite-if-specialcase-same-trace-equal x proofs)))
+
+(defobligations rw.compile-crewrite-if-specialcase-same-trace-iff
+  (rw.crewrite-twiddle-bldr
+   rw.crewrite-twiddle2-bldr
+   rw.iff-of-if-x-y-y-bldr
+   rw.disjoined-iff-of-if-x-y-y-bldr))
+
+(defobligations rw.compile-crewrite-if-specialcase-same-trace-equal
+  (rw.crewrite-twiddle-bldr
+   rw.crewrite-twiddle2-bldr
+   rw.equal-of-if-x-y-y-bldr
+   rw.disjoined-equal-of-if-x-y-y-bldr))
+
+(defobligations rw.compile-crewrite-if-specialcase-same-trace
+  (rw.compile-crewrite-if-specialcase-same-trace-iff
+   rw.compile-crewrite-if-specialcase-same-trace-equal))
+
+
+
+(defthmd lemma-1-for-rw.compile-crewrite-if-specialcase-same-trace
+  (implies (and (equal (rw.trace-list-formulas (rw.trace->subtraces x)) (logic.strip-conclusions proofs))
+                (equal (len (rw.trace->subtraces x)) 3))
+           (equal (consp proofs)
+                  t)))
+
+(defthmd lemma-2-for-rw.compile-crewrite-if-specialcase-same-trace
+  (implies (and (equal (rw.trace-list-formulas (rw.trace->subtraces x)) (logic.strip-conclusions proofs))
+                (equal (len (rw.trace->subtraces x)) 3))
+           (equal (consp (cdr proofs))
+                  t))
+  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthmd lemma-3-for-rw.compile-crewrite-if-specialcase-same-trace
+  (implies (and (equal (rw.trace-list-formulas (rw.trace->subtraces x)) (logic.strip-conclusions proofs))
+                (equal (len (rw.trace->subtraces x)) 3))
+           (equal (consp (cdr (cdr proofs)))
+                  t))
+  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+(defthmd lemma-4-for-rw.compile-crewrite-if-specialcase-same-trace
+  (implies (and (equal (rw.trace-list-formulas (rw.trace->subtraces x)) (logic.strip-conclusions proofs))
+                (equal (len (rw.trace->subtraces x)) 3))
+           (equal (logic.conclusion (first proofs))
+                  (rw.trace-formula (first (rw.trace->subtraces x)))))
+  :hints(("Goal" :in-theory (disable rw.trace-formula))))
+
+(defthmd lemma-5-for-rw.compile-crewrite-if-specialcase-same-trace
+  (implies (and (equal (rw.trace-list-formulas (rw.trace->subtraces x)) (logic.strip-conclusions proofs))
+                (equal (len (rw.trace->subtraces x)) 3))
+           (equal (logic.conclusion (second proofs))
+                  (rw.trace-formula (second (rw.trace->subtraces x)))))
+  :hints(("Goal" :in-theory (disable rw.trace-formula))))
+
+(defthmd lemma-6-for-rw.compile-crewrite-if-specialcase-same-trace
+  (implies (and (equal (rw.trace-list-formulas (rw.trace->subtraces x)) (logic.strip-conclusions proofs))
+                (equal (len (rw.trace->subtraces x)) 3))
+           (equal (logic.conclusion (third proofs))
+                  (rw.trace-formula (third (rw.trace->subtraces x)))))
+  :hints(("Goal" :in-theory (disable rw.trace-formula))))
+
+(defthmd lemma-7-for-rw.compile-crewrite-if-specialcase-same-trace
+  (equal (equal (len (logic.function-args x)) 1)
+         (and (consp (logic.function-args x))
+              (not (consp (cdr (logic.function-args x))))))
+  :hints(("Goal" :expand (len (logic.function-args x)))))
+
+(local (in-theory (enable
+                   lemma-1-for-rw.compile-crewrite-if-specialcase-same-trace
+                   lemma-2-for-rw.compile-crewrite-if-specialcase-same-trace
+                   lemma-3-for-rw.compile-crewrite-if-specialcase-same-trace
+                   lemma-4-for-rw.compile-crewrite-if-specialcase-same-trace
+                   lemma-5-for-rw.compile-crewrite-if-specialcase-same-trace
+                   lemma-6-for-rw.compile-crewrite-if-specialcase-same-trace
+                   lemma-7-for-rw.compile-crewrite-if-specialcase-same-trace)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-if-specialcase-same-tracep
+                           rw.compile-crewrite-if-specialcase-same-trace-iff
+                           logic.term-formula
+                           rw.assms-formula
+                           rw.hypbox-formula
+                           rw.assms-emptyp)))
+
+ (verify-guards rw.compile-crewrite-if-specialcase-same-trace-iff)
+
+ (defthm rw.compile-crewrite-if-specialcase-same-trace-iff-under-iff
+   (iff (rw.compile-crewrite-if-specialcase-same-trace-iff x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace-iff
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (rw.trace->iffp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-crewrite-if-specialcase-same-trace-iff x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-crewrite-if-specialcase-same-trace-iff
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (rw.trace->iffp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-crewrite-if-specialcase-same-trace-iff x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-crewrite-if-specialcase-same-trace-iff
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (rw.trace->iffp x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations rw.compile-crewrite-if-specialcase-same-trace-iff)))
+            (equal (logic.proofp (rw.compile-crewrite-if-specialcase-same-trace-iff x proofs) axioms thms atbl)
+                   t))))
+
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-if-specialcase-same-tracep
+                           rw.compile-crewrite-if-specialcase-same-trace-equal
+                           logic.term-formula
+                           rw.assms-formula
+                           rw.hypbox-formula
+                           rw.assms-emptyp)))
+
+ (verify-guards rw.compile-crewrite-if-specialcase-same-trace-equal)
+
+ (defthm rw.compile-crewrite-if-specialcase-same-trace-equal-under-equal
+   (iff (rw.compile-crewrite-if-specialcase-same-trace-equal x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace-equal
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (not (rw.trace->iffp x))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-crewrite-if-specialcase-same-trace-equal x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-crewrite-if-specialcase-same-trace-equal
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (not (rw.trace->iffp x))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-crewrite-if-specialcase-same-trace-equal x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-crewrite-if-specialcase-same-trace-equal
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (not (rw.trace->iffp x))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations rw.compile-crewrite-if-specialcase-same-trace-equal)))
+            (equal (logic.proofp (rw.compile-crewrite-if-specialcase-same-trace-equal x proofs) axioms thms atbl)
+                   t))))
+
+
+(encapsulate
+ ()
+ (verify-guards rw.compile-crewrite-if-specialcase-same-trace)
+
+ (local (in-theory (enable rw.compile-crewrite-if-specialcase-same-trace)))
+
+ (defthm rw.compile-crewrite-if-specialcase-same-trace-under-equal
+   (iff (rw.compile-crewrite-if-specialcase-same-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-crewrite-if-specialcase-same-trace x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-crewrite-if-specialcase-same-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-crewrite-if-specialcase-same-trace
+   (implies (force (and (rw.crewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations rw.compile-crewrite-if-specialcase-same-trace)))
+            (equal (logic.proofp (rw.compile-crewrite-if-specialcase-same-trace x proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+
+
+(defund rw.compile-crewrite-if-generalcase-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.crewrite-if-generalcase-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox (rw.trace->hypbox x))
+         (iffp   (rw.trace->iffp x))
+         (left   (rw.hypbox->left hypbox))
+         (right  (rw.hypbox->right hypbox)))
+    (cond ((and left right)
+           ;; Proof1 is (L v R) v (iff a1 a2) = t
+           ;; Proof2 is (( (not a2) != nil v L) v R) v (equiv b1 b2) = t
+           ;; Proof3 is ((    a2 != nil    v L) v R) v (equiv c1 c2) = t
+           (let ((proof2* ;; (L v R) v (not a2) != nil (equiv b1 v2) = t
+                  (rw.crewrite-twiddle2-bldr (second proofs)))
+                 (proof3* ;; (L v R) v a2 != nil v (equiv c1 c2) = t
+                  (rw.crewrite-twiddle2-bldr (third proofs))))
+             (if iffp
+                 (rw.disjoined-iff-implies-iff-if-bldr (first proofs) proof2* proof3*)
+               (rw.disjoined-iff-implies-equal-if-bldr (first proofs) proof2* proof3*))))
+          ((or left right)
+           ;; Proof1 is L/R v (iff a1 a2) = t
+           ;; Proof2 is ( (not a2) != nil v L/R ) v (equiv b1 b2) = t
+           ;; Proof3 is (    a2 != nil    v L/R ) v (equiv c1 c2) = t
+           (let ((proof2* ;; L/R v (not a2) != nil (equiv b1 v2) = t
+                  (rw.crewrite-twiddle-bldr (second proofs)))
+                 (proof3* ;; L/R v a2 != nil v (equiv c1 c2) = t
+                  (rw.crewrite-twiddle-bldr (third proofs))))
+             (if iffp
+                 (rw.disjoined-iff-implies-iff-if-bldr (first proofs) proof2* proof3*)
+               (rw.disjoined-iff-implies-equal-if-bldr (first proofs) proof2* proof3*))))
+           (t
+            ;; Proof1 is (iff a1 a2) = t
+            ;; Proof2 is (not a2) != nil v (equiv b1 b2) = t
+            ;; Proof3 is a2 != nil v (equiv c1 c2) = t
+            (if iffp
+                (rw.iff-implies-iff-if-bldr (first proofs) (second proofs) (third proofs))
+              (rw.iff-implies-equal-if-bldr (first proofs) (second proofs) (third proofs)))))))
+
+(defobligations rw.compile-crewrite-if-generalcase-trace
+  (rw.crewrite-twiddle-bldr
+   rw.iff-implies-iff-if-bldr
+   rw.iff-implies-equal-if-bldr
+   rw.disjoined-iff-implies-iff-if-bldr
+   rw.disjoined-iff-implies-equal-if-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-if-generalcase-tracep
+                           rw.compile-crewrite-if-generalcase-trace
+                           logic.term-formula
+                           rw.assms-formula
+                           rw.hypbox-formula
+                           rw.assms-emptyp)))
+
+ (verify-guards rw.compile-crewrite-if-generalcase-trace)
+
+ (defthm rw.compile-crewrite-if-generalcase-trace-under-iff
+   (iff (rw.compile-crewrite-if-generalcase-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-crewrite-if-generalcase-trace
+   (implies (force (and (rw.crewrite-if-generalcase-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-crewrite-if-generalcase-trace x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-crewrite-if-generalcase-trace
+   (implies (force (and (rw.crewrite-if-generalcase-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-crewrite-if-generalcase-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-crewrite-if-generalcase-trace
+   (implies (force (and (rw.crewrite-if-generalcase-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations rw.compile-crewrite-if-generalcase-trace)))
+            (equal (logic.proofp (rw.compile-crewrite-if-generalcase-trace x proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund@ rw.compile-assumptions-trace (x)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.assumptions-tracep x))
+                  :verify-guards nil))
+  (let* ((hypbox     (rw.trace->hypbox x))
+         (extras     (rw.trace->extras x))
+         (iffp       (rw.trace->iffp x))
+         (main-proof (rw.eqtrace-bldr extras hypbox)))
+    (if iffp
+        (build.disjoined-commute-iff main-proof)
+      (build.disjoined-commute-equal main-proof))))
+
+(defobligations rw.compile-assumptions-trace
+  (rw.eqtrace-bldr
+   build.disjoined-commute-equal
+   build.disjoined-commute-iff))
+
+(defthm rw.eqtrace-bldr-under-iff
+  ;; BOZO move to assms
+  (iff (rw.eqtrace-bldr x box)
+       t)
+  :hints(("Goal" :in-theory (enable definition-of-rw.eqtrace-bldr))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.assumptions-tracep
+                           rw.compile-assumptions-trace
+                           rw.trace-formula
+                           rw.eqtrace-formula)))
+
+ (verify-guards rw.compile-assumptions-trace)
+
+ (defthm rw.compile-assumptions-trace-under-iff
+   (iff (rw.compile-assumptions-trace x)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm forcing-logic.appealp-of-rw.compile-assumptions-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.assumptions-tracep x)))
+            (equal (logic.appealp (rw.compile-assumptions-trace x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.compile-assumptions-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.assumptions-tracep x)))
+            (equal (logic.conclusion (rw.compile-assumptions-trace x))
+                   (rw.trace-formula x))))
+
+ (defthm@ forcing-logic.proofp-of-rw.compile-assumptions-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.assumptions-tracep x)
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.compile-assumptions-trace)))
+            (equal (logic.proofp (rw.compile-assumptions-trace x) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund rw.compile-force-trace (x fproofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.force-tracep x)
+                              (logic.appeal-listp fproofs)
+                              (memberp (rw.trace-formula x)
+                                       (logic.strip-conclusions fproofs)))))
+  (logic.appeal-identity
+   (logic.find-proof (rw.trace-formula x) fproofs)))
+
+(defthm rw.compile-force-trace-under-iff
+  (iff (rw.compile-force-trace x fproofs)
+       t)
+  :hints(("Goal" :in-theory (enable rw.compile-force-trace))))
+
+(defthm forcing-logic.appealp-of-rw.compile-force-trace
+  (implies (force (and (rw.tracep x)
+                       (rw.force-tracep x)
+                       (logic.appeal-listp fproofs)
+                       (memberp (rw.trace-formula x) (logic.strip-conclusions fproofs))))
+           (equal (logic.appealp (rw.compile-force-trace x fproofs))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.compile-force-trace))))
+
+(defthm forcing-logic.conclusion-of-rw.compile-force-trace
+  (implies (force (and (rw.tracep x)
+                       (rw.force-tracep x)
+                       (logic.appeal-listp fproofs)
+                       (memberp (rw.trace-formula x) (logic.strip-conclusions fproofs))))
+           (equal (logic.conclusion (rw.compile-force-trace x fproofs))
+                  (rw.trace-formula x)))
+  :hints(("Goal" :in-theory (enable rw.compile-force-trace))))
+
+(defthm forcing-logic.proofp-of-rw.compile-force-trace
+  (implies (force (and (rw.tracep x)
+                       (rw.force-tracep x)
+                       (logic.appeal-listp fproofs)
+                       (logic.proof-listp fproofs axioms thms atbl)
+                       (memberp (rw.trace-formula x) (logic.strip-conclusions fproofs))))
+           (equal (logic.proofp (rw.compile-force-trace x fproofs) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.compile-force-trace))))
+
+
+
+
+(defund rw.compile-weakening-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.weakening-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :guard-hints (("Goal" :in-theory (enable rw.weakening-tracep)))))
+  (let ((hypbox (rw.trace->hypbox x)))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (logic.appeal-identity (first proofs))
+      (build.expansion (rw.hypbox-formula hypbox)
+                       (first proofs)))))
+
+(defthm rw.compile-weakening-trace-under-iff
+  (iff (rw.compile-weakening-trace x proofs)
+       t)
+  :hints(("Goal" :in-theory (enable rw.compile-weakening-trace))))
+
+(defthm forcing-logic.appealp-of-rw.compile-weakening-trace
+  (implies (force (and (rw.tracep x)
+                       (rw.weakening-tracep x)
+                       (logic.appeal-listp proofs)
+                       (equal (logic.strip-conclusions proofs)
+                              (rw.trace-list-formulas (rw.trace->subtraces x)))))
+           (equal (logic.appealp (rw.compile-weakening-trace x proofs))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.weakening-tracep
+                                    rw.compile-weakening-trace))))
+
+(defthm forcing-logic.conclusion-of-rw.compile-weakening-trace
+  (implies (force (and (rw.tracep x)
+                       (rw.weakening-tracep x)
+                       (logic.appeal-listp proofs)
+                       (equal (logic.strip-conclusions proofs)
+                              (rw.trace-list-formulas (rw.trace->subtraces x)))))
+           (equal (logic.conclusion (rw.compile-weakening-trace x proofs))
+                  (rw.trace-formula x)))
+  :hints(("Goal" :in-theory (enable rw.weakening-tracep
+                                    rw.trace-formula
+                                    rw.trace-conclusion-formula
+                                    rw.compile-weakening-trace))))
+
+(defthm forcing-logic.proofp-of-rw.compile-weakening-trace
+  (implies (force (and (rw.tracep x)
+                       (rw.weakening-tracep x)
+                       (logic.appeal-listp proofs)
+                       (equal (logic.strip-conclusions proofs)
+                              (rw.trace-list-formulas (rw.trace->subtraces x)))
+                       (logic.proof-listp proofs axioms thms atbl)
+                       (rw.trace-atblp x atbl)))
+           (equal (logic.proofp (rw.compile-weakening-trace x proofs) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.weakening-tracep
+                                    rw.compile-weakening-trace))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-if-lemmas.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-if-lemmas.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-if-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-if-lemmas.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,85 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "if-lemmas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "crewrite-trace-if-lemmas.tex")
+
+
+(defderiv rw.disjoined-iff-implies-equal-if-bldr
+  :derive (v P (= (equal (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t))
+  :from   ((proof x (v P (= (iff (? a1) (? a2)) t)))
+           (proof y (v P (v (!= (not (? a2)) nil) (= (equal (? b1) (? b2)) t))))
+           (proof z (v P (v (!= (? a2) nil) (= (equal (? c1) (? c2)) t)))))
+  :proof  (@derive
+           ((v P (= (iff (? a1) (? a2)) t))                                                  (@given x) *1)
+           ((v P (v (!= (not (? a2)) nil) (= (equal (? b1) (? b2)) t)))                      (@given y) *2)
+           ((v P (v (!= (? a2) nil) (= (equal (? c1) (? c2)) t)))                            (@given z) *3)
+           ((v (!= (iff x1 x2) t)
+              (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                 (v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                    (= (equal (if x1 y1 z1) (if x2 y2 z2)) t))))                             (build.theorem (rw.theorem-iff-implies-equal-if-combined)))
+           ((v (!= (iff (? a1) (? a2)) t)
+               (v (! (v (!= (not (? a2)) nil) (= (equal (? b1) (? b2)) t)))
+                  (v (! (v (!= (? a2) nil) (= (equal (? c1) (? c2)) t)))
+                     (= (equal (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t))))    (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y1 . (? b1)) (y2 . (? b2)) (z1 . (? c1)) (z2 . (? c2)))))
+           ((v P (= (equal (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t))          (rw.three-disjoined-modus-ponens *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+(defderiv rw.disjoined-iff-implies-iff-if-bldr
+  :derive (v P (= (iff (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t))
+  :from   ((proof x (v P (= (iff (? a1) (? a2)) t)))
+           (proof y (v P (v (!= (not (? a2)) nil) (= (iff (? b1) (? b2)) t))))
+           (proof z (v P (v (!= (? a2) nil) (= (iff (? c1) (? c2)) t)))))
+  :proof  (@derive
+           ((v P (= (iff (? a1) (? a2)) t))                                                (@given x)  *1)
+           ((v P (v (!= (not (? a2)) nil) (= (iff (? b1) (? b2)) t)))                      (@given y)  *2)
+           ((v P (v (!= (? a2) nil) (= (iff (? c1) (? c2)) t)))                            (@given z)  *3)
+           ((v (!= (iff x1 x2) t)
+               (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                  (v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                     (= (iff (if x1 y1 z1) (if x2 y2 z2)) t))))                            (build.theorem (rw.theorem-iff-implies-iff-if-combined)))
+           ((v (!= (iff (? a1) (? a2)) t)
+               (v (! (v (!= (not (? a2)) nil) (= (iff (? b1) (? b2)) t)))
+                  (v (! (v (!= (? a2) nil) (= (iff (? c1) (? c2)) t)))
+                     (= (iff (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t))))    (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y1 . (? b1)) (y2 . (? b2)) (z1 . (? c1)) (z2 . (? c2)))))
+           ((v P (= (iff (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t))          (rw.three-disjoined-modus-ponens *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-if-lemmas2.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-if-lemmas2.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-if-lemmas2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-if-lemmas2.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,85 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "if-lemmas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "crewrite-trace-if-lemmas2.tex")
+
+
+(defderiv rw.disjoined-equal-of-if-x-y-y-bldr
+  :derive (v P (= (equal (if (? a1) (? b) (? c)) (? d)) t))
+  :from   ((proof x (v P (= (iff (? a1) (? a2)) t)))
+           (proof y (v P (v (!= (not (? a2)) nil) (= (equal (? b) (? d)) t))))
+           (proof z (v P (v (!= (? a2) nil) (= (equal (? c) (? d)) t)))))
+  :proof  (@derive
+           ((v P (= (iff (? a1) (? a2)) t))                                     (@given x) *1)
+           ((v P (v (!= (not (? a2)) nil) (= (equal (? b) (? d)) t)))           (@given y) *2)
+           ((v P (v (!= (? a2) nil) (= (equal (? c) (? d)) t)))                 (@given z) *3)
+           ((v (!= (iff x1 x2) t)
+               (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                  (v (! (v (!= x2 nil) (= (equal z w) t)))
+                     (= (equal (if x1 y z) w) t))))                             (build.theorem (rw.theorem-equal-of-if-x-y-y)))
+           ((v (!= (iff (? a1) (? a2)) t)
+               (v (! (v (!= (not (? a2)) nil) (= (equal (? b) (? d)) t)))
+                  (v (! (v (!= (? a2) nil) (= (equal (? c) (? d)) t)))
+                     (= (equal (if (? a1) (? b) (? c)) (? d)) t))))             (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y . (? b)) (z . (? c)) (w . (? d)))))
+           ((v P (= (equal (if (? a1) (? b) (? c)) (? d)) t))                   (rw.three-disjoined-modus-ponens *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+(defderiv rw.disjoined-iff-of-if-x-y-y-bldr
+  :derive (v P (= (iff (if (? a1) (? b) (? c)) (? d)) t))
+  :from   ((proof x (v P (= (iff (? a1) (? a2)) t)))
+           (proof y (v P (v (!= (not (? a2)) nil) (= (iff (? b) (? d)) t))))
+           (proof z (v P (v (!= (? a2) nil) (= (iff (? c) (? d)) t)))))
+  :proof  (@derive
+           ((v P (= (iff (? a1) (? a2)) t))                                    (@given x) *1)
+           ((v P (v (!= (not (? a2)) nil) (= (iff (? b) (? d)) t)))            (@given y) *2)
+           ((v P (v (!= (? a2) nil) (= (iff (? c) (? d)) t)))                  (@given z) *3)
+           ((v (!= (iff x1 x2) t)
+               (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                  (v (! (v (!= x2 nil) (= (iff z w) t)))
+                     (= (iff (if x1 y z) w) t))))                              (build.theorem (rw.theorem-iff-of-if-x-y-y)))
+           ((v (!= (iff (? a1) (? a2)) t)
+               (v (! (v (!= (not (? a2)) nil) (= (iff (? b) (? d)) t)))
+                  (v (! (v (!= (? a2) nil) (= (iff (? c) (? d)) t)))
+                     (= (iff (if (? a1) (? b) (? c)) (? d)) t))))              (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y . (? b)) (z . (? c)) (w . (? d)))))
+           ((v P (= (iff (if (? a1) (? b) (? c)) (? d)) t))                    (rw.three-disjoined-modus-ponens *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-recognizers.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-recognizers.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-recognizers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-recognizers.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,310 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tracep")
+(include-book "../rulep")
+(include-book "../../defderiv/context")
+(include-book "../assms/top")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund@ rw.crewrite-if-specialcase-same-tracep (x)
+  ;; The idea here is:
+  ;;
+  ;;   hyps --> (iff a1 a2) = t
+  ;;   [a2, hyps] --> (equiv b d) = t
+  ;;   [~a2, hyps] --> (equiv c d) = t
+  ;; ---------------------------------------
+  ;;   hyps --> (equiv (if a1 b c) d) = t
+  ;;
+  ;; We want to add a2 and ~a2 to hyps for the subtraces.  But our traces store
+  ;; nhyps, not hyps, so we actually want to do something like this:
+  ;;
+  ;;   nhyps v (iff a1 a2) = t
+  ;;   [(not a2), nhyps] v (equiv b d) = t
+  ;;   [a2, nhyps] v (equiv c d) = t
+  ;; ---------------------------------------
+  ;;   nhyps v (equiv (if a1 b c) d) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (hypbox    (rw.trace->hypbox x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'crewrite-if-specialcase-same)
+         (equal (len subtraces) 3)
+         (equal (rw.trace->iffp (first subtraces)) t)
+         (equal (rw.trace->iffp (second subtraces)) iffp)
+         (equal (rw.trace->iffp (third subtraces)) iffp)
+         (@match (term lhs (if (? a1) (? b) (? c)))
+                 (term rhs (? d))
+                 (term (rw.trace->lhs (first subtraces)) (? a1))
+                 (term (rw.trace->rhs (first subtraces)) (? a2))
+                 (term (rw.trace->lhs (second subtraces)) (? b))
+                 (term (rw.trace->rhs (second subtraces)) (? d))
+                 (term (rw.trace->lhs (third subtraces)) (? c))
+                 (term (rw.trace->rhs (third subtraces)) (? d)))
+         (equal (rw.trace->hypbox (first subtraces)) hypbox)
+         (equal (rw.hypbox->left (rw.trace->hypbox (second subtraces)))
+                (cons (logic.function 'not (list (@term (? a2))))
+                      (rw.hypbox->left hypbox)))
+         (equal (rw.hypbox->left (rw.trace->hypbox (third subtraces)))
+                (cons (@term (? a2))
+                      (rw.hypbox->left hypbox)))
+         (equal (rw.hypbox->right (rw.trace->hypbox (second subtraces)))
+                (rw.hypbox->right hypbox))
+         (equal (rw.hypbox->right (rw.trace->hypbox (third subtraces)))
+                (rw.hypbox->right hypbox))
+         (not extras))))
+
+(defthm booleanp-of-rw.crewrite-if-specialcase-same-tracep
+  (equal (booleanp (rw.crewrite-if-specialcase-same-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.crewrite-if-specialcase-same-tracep)
+                                 ((:executable-counterpart ACL2::force))))))
+
+
+
+(defund@ rw.crewrite-if-generalcase-tracep (x)
+  ;; The idea here is:
+  ;;
+  ;;   hyps --> (iff a1 a2) = t
+  ;;   [a2, hyps] --> (equiv b1 b2) = t
+  ;;   [~a2, hyps] --> (equiv c1 c2) = t
+  ;; ----------------------------------------------------
+  ;;   hyps --> (equiv (if a1 b1 c1) (if a2 b2 c2)) = t
+  ;;
+  ;; As above we actually deal with nhyps, so this is:
+  ;;
+  ;;   nhyps v (iff a1 a2) = t
+  ;;   [(not a2), nhyps] v (equiv b1 b2) = t
+  ;;   [a2, nhyps] v (equiv c1 c2) = t
+  ;; ---------------------------------------------------
+  ;;   nhyps v (equiv (if a1 b1 c1) (if a2 b2 c2)) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (hypbox    (rw.trace->hypbox x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'crewrite-if-generalcase)
+         (equal (len subtraces) 3)
+         (equal (rw.trace->iffp (first subtraces)) t)
+         (equal (rw.trace->iffp (second subtraces)) iffp)
+         (equal (rw.trace->iffp (third subtraces)) iffp)
+         (@match (term lhs (if (? a1) (? b1) (? c1)))
+                 (term rhs (if (? a2) (? b2) (? c2)))
+                 (term (rw.trace->lhs (first subtraces)) (? a1))
+                 (term (rw.trace->rhs (first subtraces)) (? a2))
+                 (term (rw.trace->lhs (second subtraces)) (? b1))
+                 (term (rw.trace->rhs (second subtraces)) (? b2))
+                 (term (rw.trace->lhs (third subtraces)) (? c1))
+                 (term (rw.trace->rhs (third subtraces)) (? c2)))
+         (equal (rw.trace->hypbox (first subtraces)) hypbox)
+         (equal (rw.hypbox->left (rw.trace->hypbox (second subtraces)))
+                (cons (logic.function 'not (list (@term (? a2))))
+                      (rw.hypbox->left hypbox)))
+         (equal (rw.hypbox->left (rw.trace->hypbox (third subtraces)))
+                (cons (@term (? a2))
+                      (rw.hypbox->left hypbox)))
+         (equal (rw.hypbox->right (rw.trace->hypbox (second subtraces)))
+                (rw.hypbox->right hypbox))
+         (equal (rw.hypbox->right (rw.trace->hypbox (third subtraces)))
+                (rw.hypbox->right hypbox))
+         (not extras))))
+
+(defthm booleanp-of-rw.crewrite-if-generalcase-tracep
+  (equal (booleanp (rw.crewrite-if-generalcase-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.crewrite-if-generalcase-tracep)
+                                 ((:executable-counterpart ACL2::force))))))
+
+
+
+
+(defund rw.crewrite-rule-tracep (x)
+  ;;   [hyps ->] (iff rule-hyp1 t) = t
+  ;;   ...
+  ;;   [hyps ->] (iff rule-hypN t) = t
+  ;; ---------------------------------------------  as justified by some rule
+  ;;   [hyps ->] (equiv lhs/sigma rhs/sigma) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (hypbox    (rw.trace->hypbox x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'crewrite-rule)
+         (tuplep 2 extras)
+         (let ((rule      (first extras))
+               (sigma     (second extras)))
+           (and (rw.rulep rule)
+                (logic.sigmap sigma)
+                ;; Check that the equivalence relation is acceptable
+                (let ((equiv (rw.rule->equiv rule)))
+                  (or (equal equiv 'equal)
+                      (and (equal equiv 'iff) iffp)))
+                ;; Check that the LHS matches and that the RHS is correctly instantiated
+                (let* ((match-result (logic.patmatch (rw.rule->lhs rule) lhs nil)))
+                  (and (not (equal match-result 'fail))
+                       (submapp match-result sigma)
+                       (equal (logic.substitute (rw.rule->rhs rule) sigma) rhs)))
+                ;; Check that all the hyps are relieved under iff.
+                (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+                (all-equalp t (rw.trace-list-iffps subtraces))
+                (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                       (rw.trace-list-lhses subtraces))
+                (all-equalp ''t (rw.trace-list-rhses subtraces)))))))
+
+(defthm booleanp-of-rw.crewrite-rule-tracep
+  (equal (booleanp (rw.crewrite-rule-tracep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.crewrite-rule-tracep))))
+
+
+
+
+(defund rw.crewrite-rule-trace-env-okp (x thms atbl)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.crewrite-rule-tracep x)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable rw.crewrite-rule-tracep)))))
+  (let* ((extras (rw.trace->extras x))
+         (rule   (first extras))
+         (sigma  (second extras)))
+    (and (rw.rule-atblp rule atbl)
+         (rw.rule-env-okp rule thms)
+         (logic.sigma-atblp sigma atbl))))
+
+(defthm booleanp-of-rw.crewrite-rule-trace-env-okp
+  (equal (booleanp (rw.crewrite-rule-trace-env-okp x thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.crewrite-rule-trace-env-okp))))
+
+
+
+
+(defund rw.assumptions-tracep (x)
+  ;;
+  ;; ------------------------------- as justified by the assumptions system
+  ;;   hyps -> (equiv lhs rhs) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (hypbox    (rw.trace->hypbox x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'assumptions)
+         (rw.eqtracep extras)
+         (rw.eqtrace-okp extras hypbox)
+         (not subtraces)
+         ;; An eqtrace has the form [hyps ->] (equiv rhs lhs).  We'll need to
+         ;; change that around.
+         (equal iffp (rw.eqtrace->iffp extras))
+         (equal rhs (rw.eqtrace->lhs extras))
+         (equal lhs (rw.eqtrace->rhs extras)))))
+
+(defthm booleanp-of-rw.assumptions-tracep
+  (equal (booleanp (rw.assumptions-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.assumptions-tracep)
+                                 ((:executable-counterpart ACL2::force))))))
+
+
+
+
+(defund rw.force-tracep (x)
+  ;;
+  ;; ------------------------------- as justified by our forcing system
+  ;;  [hyps ->] (iff lhs t) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'force)
+         (equal rhs ''t)
+         iffp
+         (not subtraces)
+         (not extras))))
+
+(defthm booleanp-of-rw.force-tracep
+  (equal (booleanp (rw.force-tracep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.force-tracep))))
+
+
+
+
+(defund rw.weakening-tracep (x)
+  ;;       (equiv lhs rhs) = t
+  ;; ---------------------------------
+  ;;   [hyps ->] (equiv lhs rhs) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'weakening)
+         (not extras)
+         (tuplep 1 subtraces)
+         (let ((subtrace (car subtraces)))
+           (and (not (rw.hypbox->left (rw.trace->hypbox subtrace)))
+                (not (rw.hypbox->right (rw.trace->hypbox subtrace)))
+                (equal iffp (rw.trace->iffp subtrace))
+                (equal lhs (rw.trace->lhs subtrace))
+                (equal rhs (rw.trace->rhs subtrace)))))))
+
+(defthm booleanp-of-rw.weakening-tracep
+  (equal (booleanp (rw.weakening-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.weakening-tracep)
+                                 ((:executable-counterpart ACL2::force))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-rule-compiler.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-rule-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/crewrite-rule-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/crewrite-rule-compiler.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,951 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(include-book "../../build/iff")
+(include-book "../../build/not")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; BOZO find these a home.
+
+(local (in-theory (enable rw.trace-conclusion-formula rw.trace-formula)))
+
+(defthm logic.strip-function-names-of-rw.trace-list-conclusion-formulas-when-all-iffp
+  (implies (and (all-equalp t (rw.trace-list-iffps x))
+                (force (rw.trace-listp x)))
+           (equal (logic.strip-function-names (logic.=lhses (rw.trace-list-conclusion-formulas x)))
+                  (repeat 'iff (len x))))
+  :hints(("Goal" :in-theory (enable rw.trace-list-conclusion-formulas))))
+
+(defthm logic.strip-lens-of-logic.strip-function-args-of-rw.trace-list-conclusion-formulas
+  (equal (strip-lens (logic.strip-function-args (logic.=lhses (rw.trace-list-conclusion-formulas x))))
+         (repeat 2 (len x)))
+  :hints(("Goal" :in-theory (enable rw.trace-list-conclusion-formulas))))
+
+
+(deftheorem rw.crewrite-rule-lemma
+  :derive  (v (!= (iff x t) t)
+              (= (not x) nil))
+  :proof   (@derive
+            ((v (!= x nil) (= (iff x t) nil))      (build.theorem (theorem-iff-t-when-nil)))
+            ((v (!= x nil) (!= (iff x t) t))       (build.disjoined-not-t-from-nil @-))
+            ((v (= x nil) (= (not x) nil))         (build.theorem (theorem-not-when-not-nil)))
+            ((v (= (not x) nil) (!= (iff x t) t))  (build.cut @- @--))
+            ((v (!= (iff x t) t) (= (not x) nil))  (build.commute-or @-)))
+  :minatbl ((iff . 2)
+            (not  . 1)))
+
+(defderiv rw.crewrite-rule-lemma-bldr
+  :derive (= (not (? a)) nil)
+  :from   ((proof x (= (iff (? a) t) t)))
+  :proof  (@derive
+           ((v (!= (iff x t) t) (= (not x) nil))           (build.theorem (rw.crewrite-rule-lemma)))
+           ((v (!= (iff (? a) t) t) (= (not (? a)) nil))   (build.instantiation @- (@sigma (x . (? a)))))
+           ((= (iff (? a) t) t)                            (@given x))
+           ((= (not (? a)) nil)                            (build.modus-ponens @- @--)))
+  :minatbl ((iff . 2)
+            (not . 1)))
+
+(defderiv rw.disjoined-crewrite-rule-lemma-bldr
+  :derive (v P (= (not (? a)) nil))
+  :from   ((proof x (v P (= (iff (? a) t) t))))
+  :proof  (@derive
+           ((v (!= (iff x t) t) (= (not x) nil))                (build.theorem (rw.crewrite-rule-lemma)))
+           ((v (!= (iff (? a) t) t) (= (not (? a)) nil))        (build.instantiation @- (@sigma (x . (? a)))))
+           ((v P (v (!= (iff (? a) t) t) (= (not (? a)) nil)))  (build.expansion (@formula P) @-))
+           ((v P (= (iff (? a) t) t))                           (@given x))
+           ((v P (= (not (? a)) nil))                           (build.disjoined-modus-ponens @- @--)))
+  :minatbl ((iff . 2)
+            (not . 1)))
+
+(defund rw.crewrite-rule-lemma-list-bldr (x)
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.all-atomicp (logic.strip-conclusions x))
+                              (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                              (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                              (all-equalp ''t (logic.=rhses (logic.strip-conclusions x))))))
+  (if (consp x)
+      (cons (rw.crewrite-rule-lemma-bldr (car x))
+            (rw.crewrite-rule-lemma-list-bldr (cdr x)))
+    nil))
+
+(defobligations rw.crewrite-rule-lemma-list-bldr
+  (rw.crewrite-rule-lemma-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-rule-lemma-list-bldr)))
+
+ (defthm len-of-rw.crewrite-rule-lemma-list-bldr
+   (equal (len (rw.crewrite-rule-lemma-list-bldr x))
+          (len x)))
+
+ (defthm forcing-logic.appeal-listp-of-rw.crewrite-rule-lemma-list-bldr
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))))
+            (equal (logic.appeal-listp (rw.crewrite-rule-lemma-list-bldr x))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-rw.crewrite-rule-lemma-list-bldr
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))))
+            (equal (logic.strip-conclusions (rw.crewrite-rule-lemma-list-bldr x))
+                   (logic.pequal-list (logic.negate-term-list (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                                      (repeat ''nil (len x)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :in-theory (enable logic.negate-term))))
+
+ (defthm@ forcing-logic.proof-listp-of-rw.crewrite-rule-lemma-list-bldr
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.all-atomicp (logic.strip-conclusions x))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions x)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions x))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions x)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions x)))
+                        ;; ---
+                        (logic.proof-listp x axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.crewrite-rule-lemma-list-bldr)
+                        ))
+            (equal (logic.proof-listp (rw.crewrite-rule-lemma-list-bldr x) axioms thms atbl)
+                   t))))
+
+
+
+(defund rw.disjoined-crewrite-rule-lemma-list-bldr (p x)
+  (declare (xargs :guard (and (logic.formulap p)
+                              (logic.appeal-listp x)
+                              (logic.all-disjunctionsp (logic.strip-conclusions x))
+                              (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                              (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                              (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                              (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x)))))))
+  (if (consp x)
+      (cons (rw.disjoined-crewrite-rule-lemma-bldr (car x))
+            (rw.disjoined-crewrite-rule-lemma-list-bldr p (cdr x)))
+    nil))
+
+(defobligations rw.disjoined-crewrite-rule-lemma-list-bldr
+  (rw.disjoined-crewrite-rule-lemma-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.disjoined-crewrite-rule-lemma-list-bldr)))
+
+ (defthm len-of-rw.disjoined-crewrite-rule-lemma-list-bldr
+   (equal (len (rw.disjoined-crewrite-rule-lemma-list-bldr p x))
+          (len x)))
+
+ (defthm forcing-logic.appeal-listp-of-rw.disjoined-crewrite-rule-lemma-list-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))))
+            (equal (logic.appeal-listp (rw.disjoined-crewrite-rule-lemma-list-bldr p x))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-rw.disjoined-crewrite-rule-lemma-list-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))))
+            (equal (logic.strip-conclusions (rw.disjoined-crewrite-rule-lemma-list-bldr p x))
+                   (logic.por-list (repeat p (len x))
+                                   (logic.pequal-list (logic.negate-term-list (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                                                      (repeat ''nil (len x))))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))
+   :hints(("Goal" :in-theory (enable logic.negate-term))))
+
+ (defthm@ forcing-logic.proof-listp-of-rw.disjoined-crewrite-rule-lemma-list-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.appeal-listp x)
+                        (logic.all-disjunctionsp (logic.strip-conclusions x))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions x)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions x)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions x)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions x))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions x))))
+                        ;; ---
+                        (logic.proof-listp x axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.disjoined-crewrite-rule-lemma-list-bldr)
+                        ))
+            (equal (logic.proof-listp (rw.disjoined-crewrite-rule-lemma-list-bldr p x) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund rw.compile-crewrite-rule-trace-lemma1 (rule sigma proofs)
+  (declare (xargs :guard (and (rw.rulep rule)
+                              (logic.sigmap sigma)
+                              (logic.appeal-listp proofs)
+                              (logic.all-atomicp (logic.strip-conclusions proofs))
+                              (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                              (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs))))
+                                     (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                              (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                              (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs))))
+                  :verify-guards nil))
+  ;; 1. (not hyp1) != nil v ... v (not hypN) != nil v (equiv lhs rhs) != nil                          Given (Rule's theorem)
+  ;; 2. (not hyp1/sigma) != nil v ... v (not hypN/sigma) != nil v (equiv lhs/sigma rhs/sigma) != nil  Instantiation
+  ;; 3. [[ (iff hyp1/sigma t) = t, ..., (iff hypN/sigma t) = t ]]                                     Givens (Proofs)
+  ;; 4. [[ (not hyp1/sigma) = nil, ..., (not hypN/sigma) = nil ]]                                     CRewrite Rule Lemma List Bldr
+  ;; 5. (equiv lhs/sigma rhs/sigma) != nil                                                            Modus Ponens List
+  (let* ((lhs    (rw.rule->lhs rule))
+         (rhs    (rw.rule->rhs rule))
+         (equiv  (rw.rule->equiv rule))
+         (line-1 (build.theorem (clause.clause-formula (rw.rule-clause rule))))
+         (line-2 (build.instantiation line-1 sigma))
+         (line-4 (rw.crewrite-rule-lemma-list-bldr proofs))
+         (line-5 (build.modus-ponens-list (logic.pnot (logic.pequal (logic.function equiv (list (logic.substitute lhs sigma)
+                                                                                                (logic.substitute rhs sigma)))
+                                                                    ''nil))
+                                          line-4 line-2)))
+    line-5))
+
+(defobligations rw.compile-crewrite-rule-trace-lemma1
+  (build.instantiation
+   rw.crewrite-rule-lemma-list-bldr
+   build.modus-ponens-list))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.compile-crewrite-rule-trace-lemma1
+                           rw.rule-clause
+                           redefinition-of-logic.term-list-formulas)))
+
+ (local (defthm crock
+          (implies (and (logic.all-negationsp a)
+                        (logic.all-negationsp c)
+                        (force (equal (len a) (len c))) ;; not always true, we force anyway
+                        (force (equal (len b) (len d))) ;; not always true, we force anyway
+                        (force (logic.formula-listp a))
+                        (force (logic.formula-listp b))
+                        (force (logic.formula-listp c))
+                        (force (logic.formula-listp d)))
+                   (equal (equal (logic.disjoin-formulas (app a b))
+                                 (logic.disjoin-formulas (app c d)))
+                          (and (equal (list-fix a) (list-fix c))
+                               (equal (list-fix b) (list-fix d)))))))
+
+ (local (defthm crock2
+          (implies (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                          (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                   (equal (len proofs)
+                          (len (rw.rule->hyps rule))))
+          :hints(("Goal"
+                  :in-theory (disable len-of-strip-firsts len-of-logic.substitute-list)
+                  :use ((:instance len-of-strip-firsts
+                                   (x (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (:instance len-of-logic.substitute-list
+                                   (x (rw.hyp-list-terms (rw.rule->hyps rule)))))))))
+
+
+
+ (defthm logic.appealp-of-rw.compile-crewrite-rule-trace-lemma1
+   (implies (force (and (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (logic.appeal-listp proofs)
+                        (logic.all-atomicp (logic.strip-conclusions proofs))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs))))
+                               (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs)))))
+            (equal (logic.appealp (rw.compile-crewrite-rule-trace-lemma1 rule sigma proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-crewrite-rule-trace-lemma1
+   (implies (force (and (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (logic.appeal-listp proofs)
+                        (logic.all-atomicp (logic.strip-conclusions proofs))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs))))
+                               (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs)))))
+            (equal (logic.conclusion (rw.compile-crewrite-rule-trace-lemma1 rule sigma proofs))
+                   (logic.pnot
+                    (logic.pequal (logic.function (rw.rule->equiv rule)
+                                                  (list (logic.substitute (rw.rule->lhs rule) sigma)
+                                                        (logic.substitute (rw.rule->rhs rule) sigma)))
+                                  ''nil))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (local (in-theory (enable rw.rule-env-okp)))
+
+ (defthm@ logic.proofp-of-rw.compile-crewrite-rule-trace-lemma1
+   (implies (force (and (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (logic.appeal-listp proofs)
+                        (logic.all-atomicp (logic.strip-conclusions proofs))
+                        (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs))))
+                               (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                        (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs)))
+                        ;; ---
+                        (rw.rule-atblp rule atbl)
+                        (rw.rule-env-okp rule thms)
+                        (logic.sigma-atblp sigma atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.compile-crewrite-rule-trace-lemma1)))
+            (equal (logic.proofp (rw.compile-crewrite-rule-trace-lemma1 rule sigma proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.compile-crewrite-rule-trace-lemma1))
+
+
+
+(defund rw.compile-crewrite-rule-trace-lemma1-okp (x thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'rw.compile-crewrite-rule-trace-lemma1)
+         (tuplep 2 extras)
+         (let ((rule (first extras))
+               (sigma (second extras)))
+           (and (rw.rulep rule)
+                (rw.rule-atblp rule atbl)
+                (rw.rule-env-okp rule thms)
+                (logic.sigmap sigma)
+                (logic.sigma-atblp sigma atbl)
+                (let ((conclusions (logic.strip-conclusions subproofs)))
+                  (and (logic.all-atomicp conclusions)
+                       (let ((lhses (logic.=lhses conclusions)))
+                         (and (logic.all-functionsp lhses)
+                              (let ((names (logic.strip-function-names lhses))
+                                    (args  (logic.strip-function-args lhses)))
+                                (and (all-equalp 'iff names)
+                                     (all-equalp 2 (strip-lens args))
+                                     (equal (strip-firsts args)
+                                            (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                                     (all-equalp ''t (strip-seconds args))
+                                     (all-equalp ''t (logic.=rhses conclusions))
+                                     (equal conclusion
+                                            (logic.pnot
+                                             (logic.pequal (logic.function (rw.rule->equiv rule)
+                                                                           (list (logic.substitute (rw.rule->lhs rule) sigma)
+                                                                                 (logic.substitute (rw.rule->rhs rule) sigma)))
+                                                           ''nil))))))))))))))
+
+(defund rw.compile-crewrite-rule-trace-lemma1-high (rule sigma proofs)
+  (declare (xargs :guard (and (rw.rulep rule)
+                              (logic.sigmap sigma)
+                              (logic.appeal-listp proofs)
+                              (logic.all-atomicp (logic.strip-conclusions proofs))
+                              (logic.all-functionsp (logic.=lhses (logic.strip-conclusions proofs)))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.strip-conclusions proofs))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                              (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs))))
+                                     (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                              (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.strip-conclusions proofs)))))
+                              (all-equalp ''t (logic.=rhses (logic.strip-conclusions proofs))))))
+  (logic.appeal 'rw.compile-crewrite-rule-trace-lemma1
+                (logic.pnot (logic.pequal (logic.function (rw.rule->equiv rule)
+                                                          (list (logic.substitute (rw.rule->lhs rule) sigma)
+                                                                (logic.substitute (rw.rule->rhs rule) sigma)))
+                                          ''nil))
+                (list-fix proofs)
+                (list rule sigma)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.compile-crewrite-rule-trace-lemma1-okp)))
+
+ (defthm booleanp-of-rw.compile-crewrite-rule-trace-lemma1-okp
+   (equal (booleanp (rw.compile-crewrite-rule-trace-lemma1-okp x thms atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.compile-crewrite-rule-trace-lemma1-okp-of-logic.appeal-identity
+   (equal (rw.compile-crewrite-rule-trace-lemma1-okp (logic.appeal-identity x) thms atbl)
+          (rw.compile-crewrite-rule-trace-lemma1-okp x thms atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (local (in-theory (e/d (backtracking-logic.formula-atblp-rules)
+                        (forcing-logic.formula-atblp-rules
+                         forcing-lookup-of-logic.function-name-free))))
+
+ (defthmd lemma-1-for-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp
+   (implies (and (rw.compile-crewrite-rule-trace-lemma1-okp x thms atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (rw.compile-crewrite-rule-trace-lemma1 (first (logic.extras x))
+                                                           (second (logic.extras x))
+                                                           (logic.provable-list-witness
+                                                            (logic.strip-conclusions (logic.subproofs x))
+                                                            axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp
+   (implies (and (rw.compile-crewrite-rule-trace-lemma1-okp x thms atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations rw.compile-crewrite-rule-trace-lemma1)
+                 (equal (cdr (lookup 'not atbl)) 1))
+            (equal (logic.proofp
+                    (rw.compile-crewrite-rule-trace-lemma1 (first (logic.extras x))
+                                                           (second (logic.extras x))
+                                                           (logic.provable-list-witness
+                                                            (logic.strip-conclusions (logic.subproofs x))
+                                                            axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp
+   (implies (and (rw.compile-crewrite-rule-trace-lemma1-okp x thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations rw.compile-crewrite-rule-trace-lemma1)
+                             (equal (cdr (lookup 'not atbl)) 1))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp
+                               lemma-2-for-soundness-of-rw.compile-crewrite-rule-trace-lemma1-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (rw.compile-crewrite-rule-trace-lemma1 (first (logic.extras x))
+                                                                       (second (logic.extras x))
+                                                                       (logic.provable-list-witness
+                                                                        (logic.strip-conclusions (logic.subproofs x))
+                                                                        axioms thms atbl)))))))))
+
+
+
+
+
+(defund rw.compile-crewrite-rule-trace-lemma2 (p rule sigma proofs)
+  (declare (xargs :guard (and (logic.formulap p)
+                              (rw.rulep rule)
+                              (logic.sigmap sigma)
+                              (logic.appeal-listp proofs)
+                              (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                              (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                              (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                              (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                                     (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                              (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                              (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                  :verify-guards nil))
+  ;; 1. (not hyp1) != nil v ... v (not hypN) != nil v (equiv lhs rhs) != nil                              Given (Rule's theorem)
+  ;; 2. (not hyp1/sigma) != nil v ... v (not hypN/sigma) != nil v (equiv lhs/sigma rhs/sigma) != nil      Instantiation
+  ;; 3. P v (not hyp1/sigma) != nil v ... v (not hypN/sigma) != nil v (equiv lhs/sigma rhs/sigma) != nil  Expansion
+  ;; 4. [[ P v (iff hyp1/sigma t) = t, ..., P v (iff hypN/sigma t) = t ]]                                 Givens (Proofs)
+  ;; 5. [[ P v (not hyp1/sigma) = nil, ..., P v (not hypN/sigma) = nil ]]                                 DJ CRewrite Rule Lemma List Bldr
+  ;; 6. P v (equiv lhs/sigma rhs/sigma) != nil                                                            DJ Modus Ponens List
+  (let* ((lhs    (rw.rule->lhs rule))
+         (rhs    (rw.rule->rhs rule))
+         (equiv  (rw.rule->equiv rule))
+         (line-1 (build.theorem (clause.clause-formula (rw.rule-clause rule))))
+         (line-2 (build.instantiation line-1 sigma))
+         (line-3 (build.expansion P line-2))
+         (line-5 (rw.disjoined-crewrite-rule-lemma-list-bldr p proofs))
+         (line-6 (build.disjoined-modus-ponens-list
+                  (logic.pnot (logic.pequal (logic.function equiv (list (logic.substitute lhs sigma)
+                                                                        (logic.substitute rhs sigma)))
+                                            ''nil))
+                  line-5 line-3)))
+    line-6))
+
+(defobligations rw.compile-crewrite-rule-trace-lemma2
+  (build.expansion
+   rw.disjoined-crewrite-rule-lemma-list-bldr
+   build.disjoined-modus-ponens-list))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.compile-crewrite-rule-trace-lemma2
+                           rw.rule-clause
+                           redefinition-of-logic.term-list-formulas)))
+
+ (local (defthm crock
+          (implies (and (logic.all-negationsp a)
+                        (logic.all-negationsp c)
+                        (force (equal (len a) (len c))) ;; not always true, we force anyway
+                        (force (equal (len b) (len d))) ;; not always true, we force anyway
+                        (force (logic.formula-listp a))
+                        (force (logic.formula-listp b))
+                        (force (logic.formula-listp c))
+                        (force (logic.formula-listp d)))
+                   (equal (equal (logic.disjoin-formulas (app a b))
+                                 (logic.disjoin-formulas (app c d)))
+                          (and (equal (list-fix a) (list-fix c))
+                               (equal (list-fix b) (list-fix d)))))))
+
+ (local (defthm crock2
+          (implies (equal (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma)
+                          (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                   (equal (len proofs)
+                          (len (rw.rule->hyps rule))))
+          :hints(("Goal"
+                  :in-theory (disable len-of-strip-firsts len-of-logic.substitute-list)
+                  :use ((:instance len-of-strip-firsts
+                                   (x (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (:instance len-of-logic.substitute-list
+                                   (x (rw.hyp-list-terms (rw.rule->hyps rule)))))))))
+
+ (defthm forcing-logic.appealp-of-rw.compile-crewrite-rule-trace-lemma2
+   (implies (force (and (logic.formulap p)
+                        (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (logic.appeal-listp proofs)
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                               (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        ))
+            (equal (logic.appealp (rw.compile-crewrite-rule-trace-lemma2 p rule sigma proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.compile-crewrite-rule-trace-lemma2
+   (implies (force (and (logic.formulap p)
+                        (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (logic.appeal-listp proofs)
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                               (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        ))
+            (equal (logic.conclusion (rw.compile-crewrite-rule-trace-lemma2 p rule sigma proofs))
+                   (logic.por p
+                              (logic.pnot
+                               (logic.pequal (logic.function (rw.rule->equiv rule)
+                                                             (list (logic.substitute (rw.rule->lhs rule) sigma)
+                                                                   (logic.substitute (rw.rule->rhs rule) sigma)))
+                                             ''nil)))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.compile-crewrite-rule-trace-lemma2
+   (implies (force (and (logic.formulap p)
+                        (rw.rulep rule)
+                        (logic.sigmap sigma)
+                        (logic.appeal-listp proofs)
+                        (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                        (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                        (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                        (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                        (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                               (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                        (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                        (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs))))
+                        ;; ---
+                        (logic.formula-atblp p atbl)
+                        (rw.rule-atblp rule atbl)
+                        (rw.rule-env-okp rule thms)
+                        (logic.sigma-atblp sigma atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.compile-crewrite-rule-trace-lemma2)
+                        ))
+            (equal (logic.proofp (rw.compile-crewrite-rule-trace-lemma2 p rule sigma proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.rule-env-okp))))
+
+ (verify-guards rw.compile-crewrite-rule-trace-lemma2))
+
+
+
+(defund rw.compile-crewrite-rule-trace-lemma2-okp (x thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'rw.compile-crewrite-rule-trace-lemma2)
+         (tuplep 3 extras)
+         (let ((p     (first extras))
+               (rule  (second extras))
+               (sigma (third extras)))
+           (and (logic.formulap p)
+                (logic.formula-atblp p atbl)
+                (rw.rulep rule)
+                (rw.rule-atblp rule atbl)
+                (rw.rule-env-okp rule thms)
+                (logic.sigmap sigma)
+                (logic.sigma-atblp sigma atbl)
+                (let ((conclusions (logic.strip-conclusions subproofs)))
+                  (and (logic.all-disjunctionsp conclusions)
+                       (let ((rhses (logic.vrhses conclusions)))
+                         (and (all-equalp p (logic.vlhses conclusions))
+                              (logic.all-atomicp rhses)
+                              (let ((lhses-of-rhses (logic.=lhses rhses)))
+                                (and (logic.all-functionsp lhses-of-rhses)
+                                     (all-equalp 'iff (logic.strip-function-names lhses-of-rhses))
+                                     (let ((args (logic.strip-function-args lhses-of-rhses)))
+                                       (and (all-equalp 2 (strip-lens args))
+                                            (equal (strip-firsts args)
+                                                   (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                                            (all-equalp ''t (strip-seconds args))
+                                            (all-equalp ''t (logic.=rhses rhses))
+                                            (equal conclusion
+                                                   (logic.por p
+                                                              (logic.pnot
+                                                               (logic.pequal (logic.function (rw.rule->equiv rule)
+                                                                                             (list (logic.substitute (rw.rule->lhs rule) sigma)
+                                                                                                   (logic.substitute (rw.rule->rhs rule) sigma)))
+                                                                             ''nil)))))))))))))))))
+
+
+(defund rw.compile-crewrite-rule-trace-lemma2-high (p rule sigma proofs)
+  (declare (xargs :guard (and (logic.formulap p)
+                              (rw.rulep rule)
+                              (logic.sigmap sigma)
+                              (logic.appeal-listp proofs)
+                              (logic.all-disjunctionsp (logic.strip-conclusions proofs))
+                              (all-equalp p (logic.vlhses (logic.strip-conclusions proofs)))
+                              (logic.all-atomicp (logic.vrhses (logic.strip-conclusions proofs)))
+                              (logic.all-functionsp (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                              (all-equalp 'iff (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                              (all-equalp 2 (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                              (equal (strip-firsts (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                                     (logic.substitute-list (rw.hyp-list-terms (rw.rule->hyps rule)) sigma))
+                              (all-equalp ''t (strip-seconds (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))))
+                              (all-equalp ''t (logic.=rhses (logic.vrhses (logic.strip-conclusions proofs)))))))
+  (logic.appeal 'rw.compile-crewrite-rule-trace-lemma2
+                (logic.por p (logic.pnot (logic.pequal (logic.function (rw.rule->equiv rule)
+                                                                       (list (logic.substitute (rw.rule->lhs rule) sigma)
+                                                                             (logic.substitute (rw.rule->rhs rule) sigma)))
+                                                       ''nil)))
+                (list-fix proofs)
+                (list p rule sigma)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.compile-crewrite-rule-trace-lemma2-okp)))
+
+ (defthm booleanp-of-rw.compile-crewrite-rule-trace-lemma2-okp
+   (equal (booleanp (rw.compile-crewrite-rule-trace-lemma2-okp x thms atbl))
+          t)
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.compile-crewrite-rule-trace-lemma2-okp-of-logic.appeal-identity
+   (equal (rw.compile-crewrite-rule-trace-lemma2-okp (logic.appeal-identity x) thms atbl)
+          (rw.compile-crewrite-rule-trace-lemma2-okp x thms atbl))
+   :hints(("goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-1-for-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp
+   (implies (and (rw.compile-crewrite-rule-trace-lemma2-okp x thms atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl))
+            (equal (logic.conclusion
+                    (rw.compile-crewrite-rule-trace-lemma2 (first (logic.extras x))
+                                                           (second (logic.extras x))
+                                                           (third (logic.extras x))
+                                                           (logic.provable-list-witness
+                                                            (logic.strip-conclusions (logic.subproofs x))
+                                                            axioms thms atbl)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp
+   (implies (and (rw.compile-crewrite-rule-trace-lemma2-okp x thms atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (@obligations rw.compile-crewrite-rule-trace-lemma2)
+                 (equal (cdr (lookup 'not atbl)) 1))
+            (equal (logic.proofp
+                    (rw.compile-crewrite-rule-trace-lemma2 (first (logic.extras x))
+                                                           (second (logic.extras x))
+                                                           (third (logic.extras x))
+                                                           (logic.provable-list-witness
+                                                            (logic.strip-conclusions (logic.subproofs x))
+                                                            axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp
+   (implies (and (rw.compile-crewrite-rule-trace-lemma2-okp x thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (@obligations rw.compile-crewrite-rule-trace-lemma2)
+                             (equal (cdr (lookup 'not atbl)) 1))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp
+                               lemma-2-for-soundness-of-rw.compile-crewrite-rule-trace-lemma2-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (rw.compile-crewrite-rule-trace-lemma2 (first (logic.extras x))
+                                                                       (second (logic.extras x))
+                                                                       (third (logic.extras x))
+                                                                       (logic.provable-list-witness
+                                                                        (logic.strip-conclusions (logic.subproofs x))
+                                                                        axioms thms atbl)))))))))
+
+
+
+
+
+
+
+
+(defund@ rw.compile-crewrite-rule-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.crewrite-rule-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  ;; Let the rule be [| rhyp1, ..., rhypN |] ==> (REQUIV rlhs rrhs) = t.
+  ;; Goal: assms v (TEQUIV rlhs/sigma rrhs/sigma) = t
+  ;; Proofs are: assms v (iff rhypi/sigma t) = t
+  (let* ((hypbox  (rw.trace->hypbox x))
+         (iffp    (rw.trace->iffp x))
+         (extras  (rw.trace->extras x))
+         (rule    (first extras))
+         (sigma   (second extras)))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (let (;; (REQUIV lhs/sigma rhs/sigma) != nil
+              (main-proof (rw.compile-crewrite-rule-trace-lemma1 rule sigma proofs)))
+          (if iffp
+              (if (equal (rw.rule->equiv rule) 'equal)
+                  ;; to cause problems, try (equal (rw.rule->equiv x) 'equal) instead
+                  (build.iff-from-equal (build.equal-t-from-not-nil main-proof))
+                (build.iff-t-from-not-nil main-proof))
+            (build.equal-t-from-not-nil main-proof)))
+      (let* ((f-nhyps    (rw.hypbox-formula hypbox))
+             ;; nhyps v (REQUIV lhs/sigma rhs/sigma) != nil
+             (main-proof (rw.compile-crewrite-rule-trace-lemma2 f-nhyps rule sigma proofs)))
+          (if iffp
+              (if (equal (rw.rule->equiv rule) 'equal)
+                  ;; to cause problems, try (equal (rw.rule->equiv x) 'equal) instead
+                  (build.disjoined-iff-from-equal (build.disjoined-equal-t-from-not-nil main-proof))
+                (build.disjoined-iff-t-from-not-nil main-proof))
+            (build.disjoined-equal-t-from-not-nil main-proof))))))
+
+(defobligations rw.compile-crewrite-rule-trace
+  (rw.compile-crewrite-rule-trace-lemma1
+   rw.compile-crewrite-rule-trace-lemma2
+   build.disjoined-equal-t-from-not-nil
+   build.disjoined-iff-t-from-not-nil
+   build.disjoined-iff-from-equal
+   build.equal-t-from-not-nil
+   build.iff-t-from-not-nil
+   build.iff-from-equal))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.compile-crewrite-rule-trace rw.crewrite-rule-tracep)))
+
+ (defthmd lemma-1-for-rw.compile-crewrite-rule-trace
+   (implies (and (equal (rw.trace-list-conclusion-formulas subtraces)
+                        (logic.vrhses (logic.strip-conclusions proofs)))
+                 (all-equalp t (rw.trace-list-iffps subtraces))
+                 (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+                 (rw.hypbox->right hypbox)
+                 (force (rw.trace-listp subtraces)))
+            (equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                   (repeat 'iff (len subtraces)))))
+
+ (defthmd lemma-2-for-rw.compile-crewrite-rule-trace
+   (implies (and (equal (rw.trace-list-conclusion-formulas subtraces)
+                        (logic.vrhses (logic.strip-conclusions proofs)))
+                 (all-equalp t (rw.trace-list-iffps subtraces))
+                 (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+                 (rw.hypbox->left hypbox)
+                 (force (rw.trace-listp subtraces)))
+            (equal (logic.strip-function-names (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs))))
+                   (repeat 'iff (len subtraces)))))
+
+ (defthmd lemma-3-for-rw.compile-crewrite-rule-trace
+   (implies (and (equal (rw.trace-list-conclusion-formulas subtraces)
+                        (logic.vrhses (logic.strip-conclusions proofs)))
+                 (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+                 (rw.hypbox->right hypbox)
+                 (force (rw.trace-listp subtraces)))
+            (equal (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                   (repeat '2 (len subtraces)))))
+
+ (defthmd lemma-4-for-rw.compile-crewrite-rule-trace
+   (implies (and (equal (rw.trace-list-conclusion-formulas subtraces)
+                        (logic.vrhses (logic.strip-conclusions proofs)))
+                 (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+                 (rw.hypbox->left hypbox)
+                 (force (rw.trace-listp subtraces)))
+            (equal (strip-lens (logic.strip-function-args (logic.=lhses (logic.vrhses (logic.strip-conclusions proofs)))))
+                   (repeat '2 (len subtraces)))))
+
+ (defthmd lemma-5-for-rw.compile-crewrite-rule-trace
+   (IMPLIES (AND (EQUAL (RW.TRACE-LIST-CONCLUSION-FORMULAS subtraces)
+                        (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                 (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+                 (all-equalp t (rw.trace-list-iffps subtraces))
+                 (not (rw.hypbox->left hypbox))
+                 (not (rw.hypbox->right hypbox))
+                 (force (rw.trace-listp subtraces)))
+            (equal (LOGIC.STRIP-FUNCTION-NAMES (LOGIC.=LHSES (LOGIC.STRIP-CONCLUSIONS PROOFS)))
+                   (repeat 'iff (len subtraces))))
+   :hints(("Goal"
+           :in-theory (disable LOGIC.STRIP-FUNCTION-NAMES-OF-RW.TRACE-LIST-CONCLUSION-FORMULAS-WHEN-ALL-IFFP)
+           :use ((:instance LOGIC.STRIP-FUNCTION-NAMES-OF-RW.TRACE-LIST-CONCLUSION-FORMULAS-WHEN-ALL-IFFP
+                            (x subtraces))))))
+
+ (defthmd lemma-6-for-rw.compile-crewrite-rule-trace
+   (IMPLIES (AND (EQUAL (RW.TRACE-LIST-CONCLUSION-FORMULAS subtraces)
+                        (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                 (all-equalp hypbox (rw.trace-list-hypboxes subtraces))
+                 (not (rw.hypbox->left hypbox))
+                 (not (rw.hypbox->right hypbox))
+                 (force (rw.trace-listp subtraces)))
+            (equal (STRIP-LENS (LOGIC.STRIP-FUNCTION-ARGS (LOGIC.=LHSES (LOGIC.STRIP-CONCLUSIONS PROOFS))))
+                   (repeat 2 (len subtraces))))
+   :hints(("Goal"
+           :in-theory (disable LOGIC.STRIP-LENS-OF-LOGIC.STRIP-FUNCTION-ARGS-OF-RW.TRACE-LIST-CONCLUSION-FORMULAS)
+           :use ((:instance LOGIC.STRIP-LENS-OF-LOGIC.STRIP-FUNCTION-ARGS-OF-RW.TRACE-LIST-CONCLUSION-FORMULAS
+                            (x subtraces))))))
+
+ (local (in-theory (enable lemma-1-for-rw.compile-crewrite-rule-trace
+                           lemma-2-for-rw.compile-crewrite-rule-trace
+                           lemma-3-for-rw.compile-crewrite-rule-trace
+                           lemma-4-for-rw.compile-crewrite-rule-trace
+                           lemma-5-for-rw.compile-crewrite-rule-trace
+                           lemma-6-for-rw.compile-crewrite-rule-trace)))
+
+ (defthm rw.compile-crewrite-rule-trace-under-iff
+   (iff (rw.compile-crewrite-rule-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm forcing-logic.appealp-of-rw.compile-crewrite-rule-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.crewrite-rule-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-crewrite-rule-trace x proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.compile-crewrite-rule-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.crewrite-rule-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-crewrite-rule-trace x proofs))
+                   (rw.trace-formula x))))
+
+ (defthm@ forcing-logic.proofp-of-rw.compile-crewrite-rule-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.crewrite-rule-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (rw.crewrite-rule-trace-env-okp x thms atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (@obligations rw.compile-crewrite-rule-trace)
+                        ))
+            (equal (logic.proofp (rw.compile-crewrite-rule-trace x proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.crewrite-rule-trace-env-okp))))
+
+ (verify-guards rw.compile-crewrite-rule-trace))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/if-lemmas.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/if-lemmas.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/if-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/if-lemmas.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,797 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../../build/iff")
+(include-book "../../build/not")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(dd.open "if-lemmas.tex")
+
+
+(deftheorem rw.theorem-iff-implies-pequal-if-1
+ :derive (v (!= (iff x1 x2) t)
+            (= (if x1 y z) (if x2 y z)))
+ :proof  (@derive
+          ((v (= (iff x y) nil)
+              (= (if x a b) (if y a b)))    (build.theorem (theorem-iff-congruent-if-1)))
+          ((v (= (if x a b) (if y a b))
+              (= (iff x y) nil))            (build.commute-or @-))
+          ((v (= (if x a b) (if y a b))
+              (!= (iff x y) t))             (build.disjoined-not-t-from-nil @-))
+          ((v (!= (iff x y) t)
+              (= (if x a b) (if y a b)))    (build.commute-or @-))
+          ((v (!= (iff x1 x2) t)
+              (= (if x1 y z) (if x2 y z)))    (build.instantiation @-
+                                                                   (@sigma (x . x1) (y . x2) (a . y) (b . z)))))
+ :minatbl ((if . 3)
+           (iff . 2)))
+
+(deftheorem rw.theorem-equal-implies-pequal-if-2
+ :derive (v (= x nil)
+            (v (!= (equal y1 y2) t)
+               (= (if x y1 z1) (if x y2 z2))))
+ :proof  (@derive
+          ((v (= x nil) (= (if x y z) y))                                         (build.axiom (axiom-if-when-not-nil))                                              *1)
+          ((v (= x nil) (= (if x y1 z1) y1))                                      (build.instantiation @- (@sigma (y . y1) (z . z1))))
+          ((v (v (= x nil) (!= (equal y1 y2) t)) (= (if x y1 z1) y1))             (build.multi-assoc-expansion @- (@formulas (= x nil) (!= (equal y1 y2) t)))   *2)
+          ;; ---
+          ((v (!= y1 y2) (= y1 y2))                                               (build.propositional-schema (@formula (= y1 y2))))
+          ((v (= y1 y2) (!= y1 y2))                                               (build.commute-or @-))
+          ((v (= y1 y2) (= (equal y1 y2) nil))                                    (build.disjoined-not-equal-from-not-pequal @-))
+          ((v (= y1 y2) (!= (equal y1 y2) t))                                     (build.disjoined-not-t-from-nil @-))
+          ((v (!= (equal y1 y2) t) (= y1 y2))                                     (build.commute-or @-))
+          ((v (v (= x nil) (!= (equal y1 y2) t)) (= y1 y2))                       (build.multi-assoc-expansion @- (@formulas (= x nil) (!= (equal y1 y2) t))))
+          ((v (v (= x nil) (!= (equal y1 y2) t)) (= (if x y1 z1) y2))             (build.disjoined-transitivity-of-pequal *2 @-)                                *3)
+          ;; ---
+          ((v (= x nil) (= (if x y2 z2) y2))                                      (build.instantiation *1 (@sigma (y . y2) (z . z2))))
+          ((v (v (= x nil) (!= (equal y1 y2) t)) (= (if x y2 z2) y2))             (build.multi-assoc-expansion @- (@formulas (= x nil) (!= (equal y1 y2) t))))
+          ((v (v (= x nil) (!= (equal y1 y2) t)) (= y2 (if x y2 z2)))             (build.disjoined-commute-pequal @-))
+          ((v (v (= x nil) (!= (equal y1 y2) t)) (= (if x y1 z2) (if x y2 z2)))   (build.disjoined-transitivity-of-pequal *3 @-))
+          ((v (= x nil) (v (!= (equal y1 y2) t) (= (if x y1 z2) (if x y2 z2))))   (build.right-associativity @-)))
+ :minatbl ((if . 3)
+           (equal . 2)))
+
+(deftheorem rw.theorem-equal-implies-pequal-if-3
+ :derive (v (!= x nil)
+            (v (!= (equal z1 z2) t)
+               (= (if x y1 z1) (if x y2 z2))))
+ :proof  (@derive
+          ((v (!= x nil) (= (if x y z) z))                                        (build.axiom (axiom-if-when-nil))                                                   *1)
+          ((v (!= x nil) (= (if x y1 z1) z1))                                     (build.instantiation @- (@sigma (y . y1) (z . z1))))
+          ((v (v (!= x nil) (!= (equal z1 z2) t)) (= (if x y1 z1) z1))            (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= (equal z1 z2) t)))   *2)
+          ;; ---
+          ((v (!= z1 z2) (= z1 z2))                                               (build.propositional-schema (@formula (= z1 z2))))
+          ((v (= z1 z2) (!= z1 z2))                                               (build.commute-or @-))
+          ((v (= z1 z2) (= (equal z1 z2) nil))                                    (build.disjoined-not-equal-from-not-pequal @-))
+          ((v (= z1 z2) (!= (equal z1 z2) t))                                     (build.disjoined-not-t-from-nil @-))
+          ((v (!= (equal z1 z2) t) (= z1 z2))                                     (build.commute-or @-))
+          ((v (v (!= x nil) (!= (equal z1 z2) t)) (= z1 z2))                      (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= (equal z1 z2) t))))
+          ((v (v (!= x nil) (!= (equal z1 z2) t)) (= (if x y1 z1) z2))            (build.disjoined-transitivity-of-pequal *2 @-)                                 *3)
+          ;; ---
+          ((v (!= x nil) (= (if x y2 z2) z2))                                     (build.instantiation *1 (@sigma (y . y2) (z . z2))))
+          ((v (v (!= x nil) (!= (equal z1 z2) t)) (= (if x y2 z2) z2))            (build.multi-assoc-expansion @- (@formulas (!= x nil) (!= (equal z1 z2) t))))
+          ((v (v (!= x nil) (!= (equal z1 z2) t)) (= z2 (if x y2 z2)))            (build.disjoined-commute-pequal @-))
+          ((v (v (!= x nil) (!= (equal z1 z2) t)) (= (if x y1 z1) (if x y2 z2)))  (build.disjoined-transitivity-of-pequal *3 @-))
+          ((v (!= x nil) (v (!= (equal z1 z2) t) (= (if x y1 z1) (if x y2 z2))))  (build.right-associativity @-)))
+ :minatbl ((if . 3)
+           (equal . 2)))
+
+(deftheorem rw.theorem-iff-implies-equal-if-combined
+  :derive (v (!= (iff x1 x2) t)
+             (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                (v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                   (= (equal (if x1 y1 z1) (if x2 y2 z2)) t))))
+  :proof (let* ((hyp1 (@formula (!= (iff x1 x2) t)))
+                (hyp2 (@formula (! (v (!= (not x2) nil) (= (equal y1 y2) t)))))
+                (hyp3 (@formula (! (v (!= x2 nil) (= (equal z1 z2) t)))))
+                (hyps (list hyp1 hyp2 hyp3)))
+           (@derive
+            ((v (!= (iff x1 x2) t) (= (if x1 y z) (if x2 y z)))       (build.theorem (rw.theorem-iff-implies-pequal-if-1)))
+            ((v (!= (iff x1 x2) t) (= (if x1 y1 z1) (if x2 y1 z1)))   (build.instantiation @- (@sigma (y . y1) (z . z1))))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                      (! (v (!= x2 nil) (= (equal z1 z2) t)))))
+                (= (if x1 y1 z1) (if x2 y1 z1)))                      (build.multi-assoc-expansion @- hyps)                                                  *0)
+            ;; ---
+            ((v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                (v (!= (not x2) nil) (= (equal y1 y2) t)))                                (build.propositional-schema (@formula (v (!= (not x2) nil) (= (equal y1 y2) t)))))
+            ((v (v (!= (not x2) nil) (= (equal y1 y2) t))
+                (! (v (!= (not x2) nil) (= (equal y1 y2) t))))                            (build.commute-or @-))
+            ((v (!= (not x2) nil)
+                (v (= (equal y1 y2) t) (! (v (!= (not x2) nil) (= (equal y1 y2) t)))))    (build.right-associativity @-))
+            ((v (v (= (equal y1 y2) t) (! (v (!= (not x2) nil) (= (equal y1 y2) t))))
+                (!= (not x2) nil))                                                        (build.commute-or @-))
+            ((v (v (= (equal y1 y2) t) (! (v (!= (not x2) nil) (= (equal y1 y2) t))))
+                (= x2 nil))                                                               (build.disjoined-pequal-nil-from-negative-lit @-))
+            ((v (= x2 nil)
+                (v (= (equal y1 y2) t) (! (v (!= (not x2) nil) (= (equal y1 y2) t)))))    (build.commute-or @-))
+            ((v (v (= x2 nil) (= (equal y1 y2) t))
+                (! (v (!= (not x2) nil) (= (equal y1 y2) t))))                            (build.associativity @-))
+            ((v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                (v (= x2 nil) (= (equal y1 y2) t)))                                       (build.commute-or @-))
+            ((v (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                   (= x2 nil))
+                (= (equal y1 y2) t))                                                      (build.associativity @-)                                                                    *1a)
+            ((v (= x nil) (v (!= (equal y1 y2) t) (= (if x y1 z1) (if x y2 z2))))         (build.theorem (rw.theorem-equal-implies-pequal-if-2)))
+            ((v (= x2 nil) (v (!= (equal y1 y2) t) (= (if x2 y1 z1) (if x2 y2 z2))))      (build.instantiation @- (@sigma (x . x2))))
+            ((v (v (! (v (!= (not x2) nil) (= (equal y1 y2) t))) (= x2 nil))
+                (v (!= (equal y1 y2) t) (= (if x2 y1 z1) (if x2 y2 z2))))                 (build.multi-assoc-expansion @- (@formulas (! (v (!= (not x2) nil) (= (equal y1 y2) t))) (= x2 nil))))
+            ((v (v (! (v (!= (not x2) nil) (= (equal y1 y2) t))) (= x2 nil))
+                (= (if x2 y1 z1) (if x2 y2 z2)))                                          (build.disjoined-modus-ponens *1a @-))
+            ((v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                (v (= x2 nil)
+                   (= (if x2 y1 z1) (if x2 y2 z2))))                                      (build.right-associativity @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                      (! (v (!= x2 nil) (= (equal z1 z2) t)))))
+                (v (= x2 nil)
+                   (= (if x2 y1 z1) (if x2 y2 z2))))                                      (build.multi-assoc-expansion @- hyps)                                                  *1)
+
+            ;; ---
+            ((v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                (v (!= x2 nil) (= (equal z1 z2) t)))                  (build.propositional-schema (@formula (v (!= x2 nil) (= (equal z1 z2) t)))))
+            ((v (v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                   (!= x2 nil))
+                (= (equal z1 z2) t))                                  (build.associativity @-)                                                                    *2a)
+            ((v (!= x nil)
+                (v (!= (equal z1 z2) t)
+                   (= (if x y1 z1) (if x y2 z2))))                    (build.theorem (rw.theorem-equal-implies-pequal-if-3)))
+            ((v (!= x2 nil)
+                (v (!= (equal y1 y2) t)
+                   (= (if x2 y1 z1) (if x2 y2 z2))))                  (build.instantiation @- (@sigma (x . x2))))
+            ((v (v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                   (!= x2 nil))
+                (v (!= (equal z1 z2) t)
+                   (= (if x2 y1 z1) (if x2 y2 z2))))                  (build.multi-assoc-expansion @- (@formulas (! (v (!= x2 nil) (= (equal z1 z2) t))) (!= x2 nil))))
+            ((v (v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                   (!= x2 nil))
+                (= (if x2 y1 z1) (if x2 y2 z2)))                      (build.disjoined-modus-ponens *2a @-))
+            ((v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                (v (!= x2 nil)
+                   (= (if x2 y1 z1) (if x2 y2 z2))))                  (build.right-associativity @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                      (! (v (!= x2 nil) (= (equal z1 z2) t)))))
+                (v (!= x2 nil)
+                   (= (if x2 y1 z1) (if x2 y2 z2))))                  (build.multi-assoc-expansion @- hyps)                                                  *2)
+            ;; ---
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                      (! (v (!= x2 nil) (= (equal z1 z2) t)))))
+                (v (= (if x2 y1 z1) (if x2 y2 z2))
+                   (= (if x2 y1 z1) (if x2 y2 z2))))                  (build.disjoined-cut *1 *2))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                      (! (v (!= x2 nil) (= (equal z1 z2) t)))))
+                (= (if x2 y1 z1) (if x2 y2 z2)))                      (build.disjoined-contraction @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                      (! (v (!= x2 nil) (= (equal z1 z2) t)))))
+                (= (if x1 y1 z1) (if x2 y2 z2)))                      (build.disjoined-transitivity-of-pequal *0 @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                      (! (v (!= x2 nil) (= (equal z1 z2) t)))))
+                (= (equal (if x1 y1 z1) (if x2 y2 z2)) t))            (build.disjoined-equal-from-pequal @-))
+            ((v (!= (iff x1 x2) t)
+                (v (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                      (! (v (!= x2 nil) (= (equal z1 z2) t))))
+                   (= (equal (if x1 y1 z1) (if x2 y2 z2)) t)))        (build.right-associativity @-))
+            ((v (!= (iff x1 x2) t)
+                (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                   (v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                      (= (equal (if x1 y1 z1) (if x2 y2 z2)) t))))    (build.disjoined-right-associativity @-))))
+  :minatbl ((if . 3)
+            (equal . 2)
+            (iff . 2)
+            (not . 1)))
+
+
+
+
+;; Note: theorem-iff-implies-iff-if-2 isn't needed, just use theorem-iff-implies-pequal-if-1.
+
+(deftheorem rw.theorem-iff-implies-iff-if-2
+ :derive (v (= x nil) (v (!= (iff y1 y2) t) (= (iff (if x y1 z1) (if x y2 z2)) t)))
+ :proof  (@derive
+          ((v (= x nil) (= (if x y z) y))                                                                            (build.axiom (axiom-if-when-not-nil)))
+          ((v (= x nil) (= (if x y1 z1) y1))                                                                         (build.instantiation @- (@sigma (y . y1) (z . z1))))
+          ((v (= x nil) (= (if x y2 z2) y2))                                                                         (build.instantiation @-- (@sigma (y . y2) (z . z2))))
+          ((v (= x nil) (= (iff (if x y1 z1) (if x y2 z2)) (iff y1 y2)))                                             (build.disjoined-pequal-by-args 'iff (@formula (= x nil)) (list @-- @-)))
+          ((v (= x nil) (= (iff y1 y2) (iff (if x y1 z1) (if x y2 z2))))                                             (build.disjoined-commute-pequal @-))
+          ((v (v (= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)) (= (iff y1 y2) (iff (if x y1 z1) (if x y2 z2))))   (build.multi-assoc-expansion @- (@formulas (= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)))    *1)
+          ;; ---
+          ((v (= (iff x y) nil) (= (iff x y) t))                                                                     (build.theorem (theorem-iff-nil-or-t)))
+          ((v (= (iff (if x y1 z1) (if x y2 z2)) nil) (= (iff (if x y1 z1) (if x y2 z2)) t))                         (build.instantiation @- (@sigma (x . (if x y1 z1)) (y . (if x y2 z2)))))
+          ((v (= (iff (if x y1 z1) (if x y2 z2)) t) (= (iff (if x y1 z1) (if x y2 z2)) nil))                         (build.commute-or @-))
+          ((v (v (= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)) (= (iff (if x y1 z1) (if x y2 z2)) nil))           (build.multi-assoc-expansion @- (@formulas (= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t))))
+          ;; ---
+          ((v (v (= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)) (= (iff y1 y2) nil))                               (build.disjoined-transitivity-of-pequal *1 @-))
+          ((v (v (= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)) (!= (iff y1 y2) t))                                (build.disjoined-not-t-from-nil @-))
+          ((v (= x nil) (v (= (iff (if x y1 z1) (if x y2 z2)) t) (!= (iff y1 y2) t)))                                (build.right-associativity @-))
+          ((v (= x nil) (v (!= (iff y1 y2) t) (= (iff (if x y1 z1) (if x y2 z2)) t)))                                (build.disjoined-commute-or @-)))
+ :minatbl ((if . 3)
+           (iff . 2)))
+
+(deftheorem rw.theorem-iff-implies-iff-if-3
+ :derive (v (!= x nil)
+            (v (!= (iff z1 z2) t)
+               (= (iff (if x y1 z1) (if x y2 z2)) t)))
+ :proof  (@derive
+          ((v (!= x nil) (= (if x y z) z))                                                                           (build.axiom (axiom-if-when-nil)))
+          ((v (!= x nil) (= (if x y1 z1) z1))                                                                        (build.instantiation @- (@sigma (y . y1) (z . z1))))
+          ((v (!= x nil) (= (if x y2 z2) z2))                                                                        (build.instantiation @-- (@sigma (y . y2) (z . z2))))
+          ((v (!= x nil) (= (iff (if x y1 z1) (if x y2 z2)) (iff z1 z2)))                                            (build.disjoined-pequal-by-args 'iff (@formula (!= x nil)) (list @-- @-)))
+          ((v (!= x nil) (= (iff z1 z2) (iff (if x y1 z1) (if x y2 z2))))                                            (build.disjoined-commute-pequal @-))
+          ((v (v (!= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)) (= (iff z1 z2) (iff (if x y1 z1) (if x y2 z2))))  (build.multi-assoc-expansion @- (@formulas (!= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)))   *1)
+          ;; ---
+          ((v (= (iff x y) nil) (= (iff x y) t))                                                                     (build.theorem (theorem-iff-nil-or-t)))
+          ((v (= (iff (if x y1 z1) (if x y2 z2)) nil) (= (iff (if x y1 z1) (if x y2 z2)) t))                         (build.instantiation @- (@sigma (x . (if x y1 z1)) (y . (if x y2 z2)))))
+          ((v (= (iff (if x y1 z1) (if x y2 z2)) t) (= (iff (if x y1 z1) (if x y2 z2)) nil))                         (build.commute-or @-))
+          ((v (v (!= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)) (= (iff (if x y1 z1) (if x y2 z2)) nil))          (build.multi-assoc-expansion @- (@formulas (!= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t))))
+          ;; ---
+          ((v (v (!= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)) (= (iff z1 z2) nil))                              (build.disjoined-transitivity-of-pequal *1 @-))
+          ((v (v (!= x nil) (= (iff (if x y1 z1) (if x y2 z2)) t)) (!= (iff z1 z2) t))                               (build.disjoined-not-t-from-nil @-))
+          ((v (!= x nil) (v (= (iff (if x y1 z1) (if x y2 z2)) t) (!= (iff z1 z2) t)))                               (build.right-associativity @-))
+          ((v (!= x nil) (v (!= (iff z1 z2) t) (= (iff (if x y1 z1) (if x y2 z2)) t)))                               (build.disjoined-commute-or @-)))
+ :minatbl ((if . 3)
+           (iff . 2)))
+
+(deftheorem rw.theorem-iff-implies-iff-if-combined
+  :derive (v (!= (iff x1 x2) t)
+             (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                (v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                   (= (iff (if x1 y1 z1) (if x2 y2 z2)) t))))
+  :proof (let* ((hyp1 (@formula (!= (iff x1 x2) t)))
+                (hyp2 (@formula (! (v (!= (not x2) nil) (= (iff y1 y2) t)))))
+                (hyp3 (@formula (! (v (!= x2 nil) (= (iff z1 z2) t)))))
+                (hyps (list hyp1 hyp2 hyp3)))
+           (@derive
+            ((v (!= (iff x1 x2) t) (= (if x1 y z) (if x2 y z)))          (build.theorem (rw.theorem-iff-implies-pequal-if-1)))
+            ((v (!= (iff x1 x2) t) (= (if x1 y1 z1) (if x2 y1 z1)))      (build.instantiation @- (@sigma (y . y1) (z . z1))))
+            ((v (!= (iff x1 x2) t)
+                (= (iff (if x1 y1 z1) (if x2 y1 z1)) t))                 (build.disjoined-iff-from-pequal @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                      (! (v (!= x2 nil) (= (iff z1 z2) t)))))
+                (= (iff (if x1 y1 z1) (if x2 y1 z1)) t))                 (build.multi-assoc-expansion @- hyps)                                                  *0)
+            ;; ---
+            ((v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                (v (!= (not x2) nil) (= (iff y1 y2) t)))                 (build.propositional-schema (@formula (v (!= (not x2) nil) (= (iff y1 y2) t)))))
+            ((v (v (!= (not x2) nil) (= (iff y1 y2) t))
+                (! (v (!= (not x2) nil) (= (iff y1 y2) t))))             (build.commute-or @-))
+            ((v (!= (not x2) nil)
+                (v (= (iff y1 y2) t) (! (v (!= (not x2) nil) (= (iff y1 y2) t)))))         (build.right-associativity @-))
+            ((v (v (= (iff y1 y2) t) (! (v (!= (not x2) nil) (= (iff y1 y2) t))))
+                (!= (not x2) nil))                                                         (build.commute-or @-))
+            ((v (v (= (iff y1 y2) t) (! (v (!= (not x2) nil) (= (iff y1 y2) t))))
+                (= x2 nil))                                                                (build.disjoined-pequal-nil-from-negative-lit @-))
+            ((v (= x2 nil)
+                (v (= (iff y1 y2) t) (! (v (!= (not x2) nil) (= (iff y1 y2) t)))))         (build.commute-or @-))
+            ((v (v (= x2 nil) (= (iff y1 y2) t))
+                (! (v (!= (not x2) nil) (= (iff y1 y2) t))))                               (build.associativity @-))
+            ((v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                (v (= x2 nil) (= (iff y1 y2) t)))                                          (build.commute-or @-))
+            ((v (v (! (v (!= (not x2) nil) (= (iff y1 y2) t))) (= x2 nil))
+                (= (iff y1 y2) t))                                                         (build.associativity @-)                                              *1a)
+
+            ((v (= x nil)
+                (v (!= (iff y1 y2) t)
+                   (= (iff (if x y1 z1) (if x y2 z2)) t)))               (build.theorem (rw.theorem-iff-implies-iff-if-2)))
+            ((v (= x2 nil)
+                (v (!= (iff y1 y2) t)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)))             (build.instantiation @- (@sigma (x . x2))))
+            ((v (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                   (= x2 nil))
+                (v (!= (iff y1 y2) t)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)))             (build.multi-assoc-expansion @- (@formulas (! (v (!= (not x2) nil) (= (iff y1 y2) t))) (= x2 nil))))
+            ((v (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                   (= x2 nil))
+                (= (iff (if x2 y1 z1) (if x2 y2 z2)) t))                 (build.disjoined-modus-ponens *1a @-))
+            ((v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                (v (= x2 nil)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)))             (build.right-associativity @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                      (! (v (!= x2 nil) (= (iff z1 z2) t)))))
+                (v (= x2 nil)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)))             (build.multi-assoc-expansion @- hyps)                                                  *1)
+            ;; ---
+            ((v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                (v (!= x2 nil) (= (iff z1 z2) t)))                       (build.propositional-schema (@formula (v (!= x2 nil) (= (iff z1 z2) t)))))
+            ((v (v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                   (!= x2 nil))
+                (= (iff z1 z2) t))                                       (build.associativity @-)                                                                    *2a)
+            ((v (!= x nil)
+                (v (!= (iff z1 z2) t)
+                   (= (iff (if x y1 z1) (if x y2 z2)) t)))               (build.theorem (rw.theorem-iff-implies-iff-if-3)))
+            ((v (!= x2 nil)
+                (v (!= (iff y1 y2) t)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)))             (build.instantiation @- (@sigma (x . x2))))
+            ((v (v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                   (!= x2 nil))
+                (v (!= (iff z1 z2) t)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) 2)))             (build.multi-assoc-expansion @- (@formulas (! (v (!= x2 nil) (= (iff z1 z2) t))) (!= x2 nil))))
+            ((v (v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                   (!= x2 nil))
+                (= (iff (if x2 y1 z1) (if x2 y2 z2)) t))                 (build.disjoined-modus-ponens *2a @-))
+            ((v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                (v (!= x2 nil)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)))             (build.right-associativity @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                      (! (v (!= x2 nil) (= (iff z1 z2) t)))))
+                (v (!= x2 nil)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)))             (build.multi-assoc-expansion @- hyps)                                                  *2)
+            ;; ---
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                      (! (v (!= x2 nil) (= (iff z1 z2) t)))))
+                (v (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)
+                   (= (iff (if x2 y1 z1) (if x2 y2 z2)) t)))             (build.disjoined-cut *1 *2))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                      (! (v (!= x2 nil) (= (iff z1 z2) t)))))
+                (= (iff (if x2 y1 z1) (if x2 y2 z2)) t))                 (build.disjoined-contraction @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                      (! (v (!= x2 nil) (= (iff z1 z2) t)))))
+                (= (iff (if x1 y1 z1) (if x2 y2 z2)) t))                 (build.disjoined-transitivity-of-iff *0 @-))
+            ((v (!= (iff x1 x2) t)
+                (v (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                      (! (v (!= x2 nil) (= (iff z1 z2) t))))
+                   (= (iff (if x1 y1 z1) (if x2 y2 z2)) t)))             (build.right-associativity @-))
+            ((v (!= (iff x1 x2) t)
+                (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                   (v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                      (= (iff (if x1 y1 z1) (if x2 y2 z2)) t))))         (build.disjoined-right-associativity @-))))
+  :minatbl ((if . 3)
+            (equal . 2)
+            (iff . 2)
+            (not . 1)))
+
+
+
+(deftheorem rw.theorem-iff-implies-equal-if-specialcase-nil
+  :derive (v (!= (iff x1 nil) t)
+             (v (!= (equal z1 z2) t)
+                (= (equal (if x1 y1 z1) z2) t)))
+  :proof (@derive
+          ((v (= x nil) (= (iff x nil) nil))                             (build.theorem (theorem-iff-nil-when-not-nil)))
+          ((v (= x nil) (!= (iff x nil) t))                              (build.disjoined-not-t-from-nil @-))
+          ((v (!= (iff x nil) t) (= x nil))                              (build.commute-or @-))
+          ((v (!= (iff x1 nil) t) (= x1 nil))                            (build.instantiation @- (@sigma (x . x1)))                                                  *1)
+          ;; ---
+          ((v (!= x nil) (= (if x y z) z))                               (build.axiom (axiom-if-when-nil)))
+          ((v (!= x1 nil) (= (if x1 y1 z1) z1))                          (build.instantiation @- (@sigma (x . x1) (y . y1) (z . z1))))
+          ((v (!= (iff x1 nil) t) (v (!= x1 nil) (= (if x1 y1 z1) z1)))  (build.expansion (@formula (!= (iff x1 nil) t)) @-))
+          ((v (!= (iff x1 nil) t) (= (if x1 y1 z1) z1))                  (build.disjoined-modus-ponens *1 @-))
+          ((v (v (!= (iff x1 nil) t) (!= (equal z1 z2) t))
+              (= (if x1 y1 z1) z1))                                      (build.multi-assoc-expansion @- (@formulas (!= (iff x1 nil) t) (!= (equal z1 z2) t)))  *2)
+          ;; ---
+          ((v (!= z1 z2) (= z1 z2))                                      (build.propositional-schema (@formula (= z1 z2))))
+          ((v (= z1 z2) (!= z1 z2))                                      (build.commute-or @-))
+          ((v (= z1 z2) (= (equal z1 z2) nil))                           (build.disjoined-not-equal-from-not-pequal @-))
+          ((v (= z1 z2) (!= (equal z1 z2) t))                            (build.disjoined-not-t-from-nil @-))
+          ((v (!= (equal z1 z2) t) (= z1 z2))                            (build.commute-or @-))
+          ((v (v (!= (iff x1 nil) t) (!= (equal z1 z2) t)) (= z1 z2))    (build.multi-assoc-expansion @- (@formulas (!= (iff x1 nil) t) (!= (equal z1 z2) t))))
+          ((v (v (!= (iff x1 nil) t) (!= (equal z1 z2) t))
+              (= (if x1 y1 z1) z2))                                      (build.disjoined-transitivity-of-pequal *2 @-))
+          ((v (v (!= (iff x1 nil) t) (!= (equal z1 z2) t))
+              (= (equal (if x1 y1 z1) z2) t))                            (build.disjoined-equal-from-pequal @-))
+          ((v (!= (iff x1 nil) t)
+              (v (!= (equal z1 z2) t)
+                 (= (equal (if x1 y1 z1) z2) t)))                        (build.right-associativity @-)))
+  :minatbl ((iff . 2)
+            (equal . 2)
+            (if . 3)))
+
+(deftheorem rw.theorem-iff-implies-iff-if-specialcase-nil
+  :derive (v (!= (iff x1 nil) t)
+             (v (!= (iff z1 z2) t)
+                (= (iff (if x1 y1 z1) z2) t)))
+  :proof  (@derive
+           ((v (= x nil) (= (iff x nil) nil))                                    (build.theorem (theorem-iff-nil-when-not-nil)))
+           ((v (= x1 nil) (= (iff x1 nil) nil))                                  (build.instantiation @- (@sigma (x . x1))))
+           ((v (= x1 nil) (!= (iff x1 nil) t))                                   (build.disjoined-not-t-from-nil @-)                                          *1)
+           ;; ---
+           ((v (!= x nil) (= (if x y z) z))                                      (build.axiom (axiom-if-when-nil)))
+           ((v (!= x1 nil) (= (if x1 y1 z1) z1))                                 (build.instantiation @- (@sigma (x . x1) (y . y1) (z . z1)))                      *2)
+           ((= z2 z2)                                                            (build.reflexivity (@term z2)))
+           ((v (!= x1 nil) (= z2 z2))                                            (build.expansion (@formula (!= x1 nil)) @-))
+           ((v (!= x1 nil) (= (iff (if x1 y1 z1) z2) (iff z1 z2)))               (build.disjoined-pequal-by-args 'iff (@formula (!= x1 nil)) (list *2 @-)))
+           ((v (v (!= x1 nil) (!= (iff z1 z2) t))
+               (= (iff (if x1 y1 z1) z2) (iff z1 z2)))                           (build.multi-assoc-expansion @- (@formulas (!= x1 nil) (!= (iff z1 z2) t)))  *3)
+           ;; ---
+           ((v (!= (iff z1 z2) t) (= (iff z1 z2) t))                             (build.propositional-schema (@formula (= (iff z1 z2) t))))
+           ((v (v (!= x1 nil) (!= (iff z1 z2) t)) (= (iff z1 z2) t))             (build.multi-assoc-expansion @- (@formulas (!= x1 nil) (!= (iff z1 z2) t))))
+           ((v (v (!= x1 nil) (!= (iff z1 z2) t)) (= (iff (if x1 y1 z1) z2) t))  (build.disjoined-transitivity-of-pequal *3 @-))
+           ((v (!= x1 nil) (v (!= (iff z1 z2) t) (= (iff (if x1 y1 z1) z2) t)))  (build.right-associativity @-))
+           ((v (!= (iff x1 nil) t)
+               (v (!= (iff z1 z2) t)
+                  (= (iff (if x1 y1 z1) z2) t)))                                 (build.cut *1 @-)))
+  :minatbl ((iff . 2)
+            (if . 3)))
+
+
+
+
+(deftheorem rw.theorem-iff-implies-equal-if-specialcase-t
+ :derive (v (!= (iff x1 x2) t)
+            (v (= x2 nil)
+               (v (!= (equal y1 y2) t)
+                  (= (equal (if x1 y1 z1) y2) t))))
+ :proof  (@derive
+          ((v (= x nil) (v (!= (equal y1 y2) t) (= (if x y1 z1) (if x y2 z2))))         (build.theorem (rw.theorem-equal-implies-pequal-if-2)))
+          ((v (= x1 nil) (v (!= (equal y1 y2) t) (= (if x1 y1 z1) (if x1 y2 z2))))      (build.instantiation @- (@sigma (x . x1))))
+          ((v (v (= x1 nil) (!= (equal y1 y2) t)) (= (if x1 y1 z1) (if x1 y2 z2)))      (build.associativity @-)                                                   *1)
+          ;; ---
+          ((v (= x nil) (= (if x y z) y))                                               (build.axiom (axiom-if-when-not-nil)))
+          ((v (= x1 nil) (= (if x1 y2 z2) y2))                                          (build.instantiation @- (@sigma (x . x1) (y . y2) (z . z2))))
+          ((v (v (= x1 nil) (!= (equal y1 y2) t)) (= (if x1 y2 z2) y2))                 (build.multi-assoc-expansion @- (@formulas (= x1 nil) (!= (equal y1 y2) t))))
+          ((v (v (= x1 nil) (!= (equal y1 y2) t)) (= (if x1 y1 z1) y2))                 (build.disjoined-transitivity-of-pequal *1 @-))
+          ((v (v (= x1 nil) (!= (equal y1 y2) t)) (= (equal (if x1 y1 z1) y2) t))       (build.disjoined-equal-from-pequal @-))
+          ((v (= x1 nil) (v (!= (equal y1 y2) t) (= (if x1 y1 z1) y2)))                 (build.right-associativity @-)                                        *2)
+          ;; ---
+          ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))                               (build.theorem (theorem-iff-false-true)))
+          ((v (v (!= x nil) (= y nil)) (= (iff x y) nil))                               (build.associativity @-))
+          ((v (v (!= x nil) (= y nil)) (!= (iff x y) t))                                (build.disjoined-not-t-from-nil @-))
+          ((v (!= x nil) (v (= y nil) (!= (iff x y) t)))                                (build.right-associativity @-))
+          ((v (!= x1 nil) (v (= x2 nil) (!= (iff x1 x2) t)))                            (build.instantiation @- (@sigma (x . x1) (y . x2))))
+          ((v (!= x1 nil) (v (!= (iff x1 x2) t) (= x2 nil)))                            (build.disjoined-commute-or @-))
+          ;; ---
+          ((v (v (!= (equal y1 y2) t)
+                 (= (equal (if x1 y1 z1) y2) t)) (v (!= (iff x1 x2) t) (= x2 nil)))     (build.cut *2 @-))
+          ((v (v (!= (iff x1 x2) t) (= x2 nil))
+              (v (!= (equal y1 y2) t) (= (equal (if x1 y1 z1) y2) t)))                  (build.commute-or @-))
+          ((v (!= (iff x1 x2) t)
+              (v (= x2 nil)
+                 (v (!= (equal y1 y2) t)
+                    (= (equal (if x1 y1 z1) y2) t))))                                   (build.right-associativity @-)))
+ :minatbl ((iff . 2)
+           (equal . 2)
+           (if . 3)))
+
+(deftheorem rw.theorem-iff-implies-iff-if-specialcase-t
+  :derive (v (!= (iff x1 x2) t)
+             (v (= x2 nil)
+                (v (!= (iff y1 y2) t)
+                   (= (iff (if x1 y1 z1) y2) t))))
+  :proof  (@derive
+           ((v (= x nil) (= (if x y z) y))                                           (build.axiom (axiom-if-when-not-nil)))
+           ((v (= x1 nil) (= (if x1 y1 z1) y1))                                      (build.instantiation @- (@sigma (x . x1) (y . y1) (z . z1)))                      *1)
+           ((= y2 y2)                                                                (build.reflexivity (@term y2)))
+           ((v (= x1 nil) (= y2 y2))                                                 (build.expansion (@formula (= x1 nil)) @-))
+           ((v (= x1 nil) (= (iff (if x1 y1 z1) y2) (iff y1 y2)))                    (build.disjoined-pequal-by-args 'iff (@formula (= x1 nil)) (list *1 @-)))
+           ((v (v (= x1 nil) (!= (iff y1 y2) t))
+               (= (iff (if x1 y1 z1) y2) (iff y1 y2)))                               (build.multi-assoc-expansion @- (@formulas (= x1 nil) (!= (iff y1 y2) t)))   *2)
+           ((v (!= (iff y1 y2) t) (= (iff y1 y2) t))                                 (build.propositional-schema (@formula (= (iff y1 y2) t))))
+           ((v (v (= x1 nil) (!= (iff y1 y2) t))
+               (= (iff y1 y2) t))                                                    (build.multi-assoc-expansion @- (@formulas (= x1 nil) (!= (iff y1 y2) t))))
+           ((v (v (= x1 nil) (!= (iff y1 y2) t))
+               (= (iff (if x1 y1 z1) y2) t))                                         (build.disjoined-transitivity-of-pequal *2 @-))
+           ((v (= x1 nil) (v (!= (iff y1 y2) t) (= (iff (if x1 y1 z1) y2) t)))       (build.right-associativity @-)                                               *3)
+           ;; ---
+           ((v (!= x nil) (v (= y nil) (= (iff x y) nil)))                           (build.theorem (theorem-iff-false-true)))
+           ((v (v (!= x nil) (= y nil)) (= (iff x y) nil))                           (build.associativity @-))
+           ((v (v (!= x nil) (= y nil)) (!= (iff x y) t))                            (build.disjoined-not-t-from-nil @-))
+           ((v (!= x nil) (v (= y nil) (!= (iff x y) t)))                            (build.right-associativity @-))
+           ((v (!= x1 nil) (v (= x2 nil) (!= (iff x1 x2) t)))                        (build.instantiation @- (@sigma (x . x1) (y . x2))))
+           ((v (!= x1 nil) (v (!= (iff x1 x2) t) (= x2 nil)))                        (build.disjoined-commute-or @-))
+           ((v (v (!= (iff y1 y2) t) (= (iff (if x1 y1 z1) y2) t))
+               (v (!= (iff x1 x2) t) (= x2 nil)))                                    (build.cut *3 @-))
+           ((v (v (!= (iff x1 x2) t) (= x2 nil))
+               (v (!= (iff y1 y2) t) (= (iff (if x1 y1 z1) y2) t)))                  (build.commute-or @-))
+           ((v (!= (iff x1 x2) t) (v (= x2 nil) (v (!= (iff y1 y2) t)
+                                                   (= (iff (if x1 y1 z1) y2) t))))   (build.right-associativity @-)))
+  :minatbl ((iff . 2)
+            (if . 3)))
+
+
+
+
+(deftheorem rw.theorem-equal-of-if-x-y-y
+  :derive (v (!= (iff x1 x2) t)
+             (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                (v (! (v (!= x2 nil) (= (equal z w) t)))
+                   (= (equal (if x1 y z) w) t))))
+  :proof (let* ((hyp1 (@formula (!= (iff x1 x2) t)))
+                (hyp2 (@formula (! (v (!= (not x2) nil) (= (equal y w) t)))))
+                (hyp3 (@formula (! (v (!= x2 nil) (= (equal z w) t)))))
+                (hyps (list hyp1 hyp2 hyp3)))
+           (@derive
+            ((v (!= (iff x1 x2) t) (= (if x1 y z) (if x2 y z)))           (build.theorem (rw.theorem-iff-implies-pequal-if-1)))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                      (! (v (!= x2 nil) (= (equal z w) t)))))
+                (= (if x1 y z) (if x2 y z)))                              (build.multi-assoc-expansion @- hyps)                                                                *0)
+            ;; ---
+            ((v (! (v (!= (not x2) nil) (= (equal y w) t))) (v (!= (not x2) nil) (= (equal y w) t)))  (build.propositional-schema (logic.~arg hyp2)))
+            ((v (v (!= (not x2) nil) (= (equal y w) t)) (! (v (!= (not x2) nil) (= (equal y w) t))))  (build.commute-or @-))
+            ((v (!= (not x2) nil) (v (= (equal y w) t) (! (v (!= (not x2) nil) (= (equal y w) t)))))  (build.right-associativity @-))
+            ((v (v (= (equal y w) t) (! (v (!= (not x2) nil) (= (equal y w) t)))) (!= (not x2) nil))  (build.commute-or @-))
+            ((v (v (= (equal y w) t) (! (v (!= (not x2) nil) (= (equal y w) t)))) (= x2 nil))         (build.disjoined-pequal-nil-from-negative-lit @-))
+            ((v (= x2 nil) (v (= (equal y w) t) (! (v (!= (not x2) nil) (= (equal y w) t)))))         (build.commute-or @-))
+            ((v (= x2 nil) (v (! (v (!= (not x2) nil) (= (equal y w) t))) (= (equal y w) t)))         (build.disjoined-commute-or @-))
+            ((v (v (= x2 nil) (! (v (!= (not x2) nil) (= (equal y w) t)))) (= (equal y w) t))         (build.associativity @-))
+            ((v (v (= x2 nil) (! (v (!= (not x2) nil) (= (equal y w) t)))) (= y w))                   (build.disjoined-pequal-from-equal @-)                                   *1a)
+            ((v (= x nil) (= (if x y z) y))                                                           (build.axiom (axiom-if-when-not-nil)))
+            ((v (= x2 nil) (= (if x2 y z) y))                                                         (build.instantiation @- (@sigma (x . x2))))
+            ((v (v (= x2 nil) (! (v (!= (not x2) nil) (= (equal y w) t)))) (= (if x2 y z) y))         (build.multi-assoc-expansion @- (list (@formula (= x2 nil)) hyp2)))
+            ((v (v (= x2 nil) (! (v (!= (not x2) nil) (= (equal y w) t)))) (= (if x2 y z) w))         (build.disjoined-transitivity-of-pequal @- *1a))
+            ((v (= x2 nil) (v (! (v (!= (not x2) nil) (= (equal y w) t))) (= (if x2 y z) w)))         (build.right-associativity @-)                                               *1)
+            ;; ---
+            ((v (! (v (!= x2 nil) (= (equal z w) t))) (v (!= x2 nil) (= (equal z w) t)))          (build.propositional-schema (logic.~arg hyp3)))
+            ((v (v (!= x2 nil) (= (equal z w) t)) (! (v (!= x2 nil) (= (equal z w) t))))          (build.commute-or @-))
+            ((v (!= x2 nil) (v (= (equal z w) t) (! (v (!= x2 nil) (= (equal z w) t)))))          (build.right-associativity @-))
+            ((v (!= x2 nil) (v (! (v (!= x2 nil) (= (equal z w) t))) (= (equal z w) t)))          (build.disjoined-commute-or @-))
+            ((v (v (!= x2 nil) (! (v (!= x2 nil) (= (equal z w) t)))) (= (equal z w) t))          (build.associativity @-))
+            ((v (v (!= x2 nil) (! (v (!= x2 nil) (= (equal z w) t)))) (= z w))                    (build.disjoined-pequal-from-equal @-)                                       *2a)
+            ((v (!= x nil) (= (if x y z) z))                                                      (build.axiom (axiom-if-when-nil)))
+            ((v (!= x2 nil) (= (if x2 y z) z))                                                    (build.instantiation @- (@sigma (x . x2))))
+            ((v (v (!= x2 nil) (! (v (!= x2 nil) (= (equal z w) t)))) (= (if x2 y z) z))          (build.multi-assoc-expansion @- (list (@formula (!= x2 nil)) hyp3)))
+            ((v (v (!= x2 nil) (! (v (!= x2 nil) (= (equal z w) t)))) (= (if x2 y z) w))          (build.disjoined-transitivity-of-pequal @- *2a))
+            ((v (!= x2 nil) (v (! (v (!= x2 nil) (= (equal z w) t))) (= (if x2 y z) w)))          (build.right-associativity @-))
+            ((v (!= x2 nil) (v (= (if x2 y z) w) (! (v (!= x2 nil) (= (equal z w) t)))))          (build.disjoined-commute-or @-)                                              *2)
+            ;; ---
+            ((v (v (! (v (!= (not x2) nil) (= (equal y w) t))) (= (if x2 y z) w))
+                (v (= (if x2 y z) w) (! (v (!= x2 nil) (= (equal z w) t)))))                      (build.cut *1 *2))
+            ((v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                (v (= (if x2 y z) w)
+                   (v (= (if x2 y z) w)
+                      (! (v (!= x2 nil) (= (equal z w) t))))))                                    (build.right-associativity @-))
+            ((v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                (v (v (= (if x2 y z) w) (= (if x2 y z) w))
+                   (! (v (!= x2 nil) (= (equal z w) t)))))                                        (build.disjoined-associativity @-))
+            ((v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                (v (! (v (!= x2 nil) (= (equal z w) t)))
+                   (v (= (if x2 y z) w) (= (if x2 y z) w))))                                      (build.disjoined-commute-or @-))
+            ((v (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                   (! (v (!= x2 nil) (= (equal z w) t))))
+                (v (= (if x2 y z) w) (= (if x2 y z) w)))                                          (build.associativity @-))
+            ((v (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                   (! (v (!= x2 nil) (= (equal z w) t))))
+                (= (if x2 y z) w))                                                                (build.disjoined-contraction @-))
+            ((v (!= (iff x1 x2) t)
+                (v (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                      (! (v (!= x2 nil) (= (equal z w) t))))
+                   (= (if x2 y z) w)))                                                            (build.expansion (@formula (!= (iff x1 x2) t)) @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                      (! (v (!= x2 nil) (= (equal z w) t)))))
+                (= (if x2 y z) w))                                                                (build.associativity @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                      (! (v (!= x2 nil) (= (equal z w) t)))))
+                (= (if x1 y z) w))                                                                (build.disjoined-transitivity-of-pequal *0 @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                      (! (v (!= x2 nil) (= (equal z w) t)))))
+                (= (equal (if x1 y w) w) t))                                                      (build.disjoined-equal-from-pequal @-))
+            ((v (!= (iff x1 x2) t)
+                (v (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                      (! (v (!= x2 nil) (= (equal z w) t))))
+                   (= (equal (if x1 y z) w) t)))                                                  (build.right-associativity @-))
+            ((v (!= (iff x1 x2) t)
+                (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                   (v (! (v (!= x2 nil) (= (equal z w) t)))
+                      (= (equal (if x1 y z) w) t))))                                              (build.disjoined-right-associativity @-))))
+  :minatbl ((if . 3)
+            (equal . 2)
+            (iff . 2)
+            (not . 1)))
+
+
+(deftheorem rw.theorem-iff-of-if-x-y-y
+  :derive (v (!= (iff x1 x2) t)
+             (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                (v (! (v (!= x2 nil) (= (iff z w) t)))
+                   (= (iff (if x1 y z) w) t))))
+  :proof (let* ((hyp1 (@formula (!= (iff x1 x2) t)))
+                (hyp2 (@formula (! (v (!= (not x2) nil) (= (iff y w) t)))))
+                (hyp3 (@formula (! (v (!= x2 nil) (= (iff z w) t)))))
+                (hyps (list hyp1 hyp2 hyp3)))
+           (@derive
+            ((v (!= (iff x1 x2) t) (= (if x1 y z) (if x2 y z)))                                       (build.theorem (rw.theorem-iff-implies-pequal-if-1)))
+            ((v (!= (iff x1 x2) t) (= (iff (if x1 y z) (if x2 y z)) t))                               (build.disjoined-iff-from-pequal @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                      (! (v (!= x2 nil) (= (equal z w) t)))))
+                (= (iff (if x1 y z) (if x2 y z)) t))                                                  (build.multi-assoc-expansion @- hyps)   *0)
+            ;; ---
+            ((v (! (v (!= (not x2) nil) (= (iff y w) t))) (v (!= (not x2) nil) (= (iff y w) t)))          (build.propositional-schema (logic.~arg hyp2)))
+            ((v (v (!= (not x2) nil) (= (iff y w) t)) (! (v (!= (not x2) nil) (= (iff y w) t))))          (build.commute-or @-))
+            ((v (!= (not x2) nil) (v (= (iff y w) t) (! (v (!= (not x2) nil) (= (iff y w) t)))))          (build.right-associativity @-))
+            ((v (v (= (iff y w) t) (! (v (!= (not x2) nil) (= (iff y w) t)))) (!= (not x2) nil))          (build.commute-or @-))
+            ((v (v (= (iff y w) t) (! (v (!= (not x2) nil) (= (iff y w) t)))) (= x2 nil))                 (build.disjoined-pequal-nil-from-negative-lit @-))
+            ((v (= x2 nil) (v (= (iff y w) t) (! (v (!= (not x2) nil) (= (iff y w) t)))))                 (build.commute-or @-))
+            ((v (= x2 nil) (v (! (v (!= (not x2) nil) (= (iff y w) t))) (= (iff y w) t)))                 (build.disjoined-commute-or @-))
+            ((v (v (= x2 nil) (! (v (!= (not x2) nil) (= (iff y w) t)))) (= (iff y w) t))                 (build.associativity @-)                                                          *1a)
+            ((v (= x nil) (= (if x y z) y))                                                               (build.axiom (axiom-if-when-not-nil)))
+            ((v (= x2 nil) (= (if x2 y z) y))                                                             (build.instantiation @- (@sigma (x . x2))))
+            ((v (v (= x2 nil) (! (v (!= (not x2) nil) (= (iff y w) t)))) (= (if x2 y z) y))               (build.multi-assoc-expansion @- (list (@formula (= x2 nil)) hyp2)))
+            ((v (v (= x2 nil) (! (v (!= (not x2) nil) (= (iff y w) t)))) (= (iff (if x2 y z) y) t))       (build.disjoined-iff-from-pequal @-))
+            ((v (v (= x2 nil) (! (v (!= (not x2) nil) (= (iff y w) t)))) (= (iff (if x2 y z) w) t))       (build.disjoined-transitivity-of-iff @- *1a))
+            ((v (= x2 nil) (v (! (v (!= (not x2) nil) (= (iff y w) t))) (= (iff (if x2 y z) w) t)))       (build.right-associativity @-)                                               *1)
+            ;; ---
+            ((v (! (v (!= x2 nil) (= (iff z w) t))) (v (!= x2 nil) (= (iff z w) t)))                     (build.propositional-schema (logic.~arg hyp3)))
+            ((v (v (!= x2 nil) (= (iff z w) t)) (! (v (!= x2 nil) (= (iff z w) t))))                     (build.commute-or @-))
+            ((v (!= x2 nil) (v (= (iff z w) t) (! (v (!= x2 nil) (= (iff z w) t)))))                     (build.right-associativity @-))
+            ((v (!= x2 nil) (v (! (v (!= x2 nil) (= (iff z w) t))) (= (iff z w) t)))                     (build.disjoined-commute-or @-))
+            ((v (v (!= x2 nil) (! (v (!= x2 nil) (= (iff z w) t)))) (= (iff z w) t))                     (build.associativity @-)                                                          *2a)
+            ((v (!= x nil) (= (if x y z) z))                                                             (build.axiom (axiom-if-when-nil)))
+            ((v (!= x2 nil) (= (if x2 y z) z))                                                           (build.instantiation @- (@sigma (x . x2))))
+            ((v (v (!= x2 nil) (! (v (!= x2 nil) (= (iff z w) t)))) (= (if x2 y z) z))                   (build.multi-assoc-expansion @- (list (@formula (!= x2 nil)) hyp3)))
+            ((v (v (!= x2 nil) (! (v (!= x2 nil) (= (iff z w) t)))) (= (iff (if x2 y z) z) t))           (build.disjoined-iff-from-pequal @-))
+            ((v (v (!= x2 nil) (! (v (!= x2 nil) (= (iff z w) t)))) (= (iff (if x2 y z) w) t))           (build.disjoined-transitivity-of-iff @- *2a))
+            ((v (!= x2 nil) (v (! (v (!= x2 nil) (= (iff z w) t))) (= (iff (if x2 y z) w) t)))           (build.right-associativity @-))
+            ((v (!= x2 nil) (v (= (if x2 y z) w) (! (v (!= x2 nil) (= (iff z w) t)))))                   (build.disjoined-commute-or @-)                                              *2)
+            ;; ---
+            ((v (v (! (v (!= (not x2) nil) (= (iff y w) t))) (= (iff (if x2 y z) w) t))
+                (v (= (iff (if x2 y z) w) t) (! (v (!= x2 nil) (= (iff z w) t)))))                    (build.cut *1 *2))
+            ((v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                (v (= (iff (if x2 y z) w) t)
+                   (v (= (iff (if x2 y z) w) t)
+                      (! (v (!= x2 nil) (= (iff z w) t))))))                                          (build.right-associativity @-))
+            ((v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                (v (v (= (iff (if x2 y z) w) t) (= (iff (if x2 y z) w) t))
+                   (! (v (!= x2 nil) (= (iff z w) t)))))                                              (build.disjoined-associativity @-))
+            ((v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                (v (! (v (!= x2 nil) (= (iff z w) t)))
+                   (v (= (iff (if x2 y z) w) t) (= (iff (if x2 y z) w) t))))                          (build.disjoined-commute-or @-))
+            ((v (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                   (! (v (!= x2 nil) (= (iff z w) t))))
+                (v (= (iff (if x2 y z) w) t) (= (iff (if x2 y z) w) t)))                              (build.associativity @-))
+            ((v (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                   (! (v (!= x2 nil) (= (iff z w) t))))
+                (= (iff (if x2 y z) w) t))                                                            (build.disjoined-contraction @-))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                      (! (v (!= x2 nil) (= (iff z w) t)))))
+                (= (iff (if x2 y z) w) t))                                                            (build.multi-assoc-expansion @- (list hyp1 (logic.por hyp2 hyp3))))
+            ((v (v (!= (iff x1 x2) t)
+                   (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                      (! (v (!= x2 nil) (= (iff z w) t)))))
+                (= (iff (if x1 y z) w) t))                                                            (build.disjoined-transitivity-of-iff *0 @-))
+            ((v (!= (iff x1 x2) t)
+                (v (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                      (! (v (!= x2 nil) (= (iff z w) t))))
+                   (= (iff (if x1 y z) w) t)))                                                        (build.right-associativity @-))
+            ((v (!= (iff x1 x2) t)
+                (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                   (v (! (v (!= x2 nil) (= (iff z w) t)))
+                      (= (iff (if x1 y z) w) t))))                                                    (build.disjoined-right-associativity @-))
+           ))
+  :minatbl ((iff . 2)
+            (if . 3)
+            (not . 1)))
+
+
+(defderiv rw.two-modus-ponens
+  :derive C
+  :from   ((proof x A)
+           (proof y B)
+           (proof z (v (! A) (v (! B) C))))
+  :proof  (@derive
+           ((v (! A) (v (! B) C))    (@given z))
+           (A                        (@given x))
+           ((v (! B) C)              (build.modus-ponens @- @--))
+           (B                        (@given y))
+           (C                        (build.modus-ponens @- @--))))
+
+(defderiv rw.two-disjoined-modus-ponens
+  :derive (v P C)
+  :from   ((proof x (v P A))
+           (proof y (v P B))
+           (proof z (v (! A) (v (! B) C))))
+  :proof  (@derive
+           ((v (! A) (v (! B) C))         (@given z))
+           ((v P (v (! A) (v (! B) C)))   (build.expansion (@formula P) @-))
+           ((v P A)                       (@given x))
+           ((v P (v (! B) C))             (build.disjoined-modus-ponens @- @--))
+           ((v P B)                       (@given y))
+           ((v P C)                       (build.disjoined-modus-ponens @- @--))))
+
+
+(defderiv rw.three-modus-ponens
+  :derive D
+  :from   ((proof w A)
+           (proof x B)
+           (proof y C)
+           (proof z (v (! A) (v (! B) (v (! C) D)))))
+  :proof  (@derive
+           ((v (! A) (v (! B) (v (! C) D)))     (@given z))
+           (A                                   (@given w))
+           ((v (! B) (v (! C) D))               (build.modus-ponens @- @--))
+           (B                                   (@given x))
+           ((v (! C) D)                         (build.modus-ponens @- @--))
+           (C                                   (@given y))
+           (D                                   (build.modus-ponens @- @--))))
+
+(defderiv rw.three-disjoined-modus-ponens
+  :derive (v P D)
+  :from   ((proof w (v P A))
+           (proof x (v P B))
+           (proof y (v P C))
+           (proof z (v (! A) (v (! B) (v (! C) D)))))
+  :proof  (@derive
+           ((v (! A) (v (! B) (v (! C) D)))            (@given z))
+           ((v P (v (! A) (v (! B) (v (! C) D))))      (build.expansion (@formula P) @-))
+           ((v P A)                                    (@given w))
+           ((v P (v (! B) (v (! C) D)))                (build.disjoined-modus-ponens @- @--))
+           ((v P B)                                    (@given x))
+           ((v P (v (! C) D))                          (build.disjoined-modus-ponens @- @--))
+           ((v P C)                                    (@given y))
+           ((v P D)                                    (build.disjoined-modus-ponens @- @--))))
+
+
+(defderiv rw.mp-mp2-mp
+  :derive D
+  :from   ((proof w A)
+           (proof x (! B))
+           (proof y C)
+           (proof z (v (! A) (v B (v (! C) D)))))
+  :proof  (@derive
+           ((v (! A) (v B (v (! C) D)))   (@given z))
+           (A                             (@given w))
+           ((v B (v (! C) D))             (build.modus-ponens @- @--))
+           ((! B)                         (@given x))
+           ((v (! C) D)                   (build.modus-ponens-2 @- @--))
+           (C                             (@given y))
+           (D                             (build.modus-ponens @- @--))))
+
+(defderiv rw.disjoined-mp-mp2-mp
+  :derive (v P D)
+  :from   ((proof w (v P A))
+           (proof x (v P (! B)))
+           (proof y (v P C))
+           (proof z (v (! A) (v B (v (! C) D)))))
+  :proof  (@derive
+           ((v (! A) (v B (v (! C) D)))         (@given z))
+           ((v P (v (! A) (v B (v (! C) D))))   (build.expansion (@formula P) @-))
+           ((v P A)                             (@given w))
+           ((v P (v B (v (! C) D)))             (build.disjoined-modus-ponens @- @--))
+           ((v P (! B))                         (@given x))
+           ((v P (v (! C) D))                   (build.disjoined-modus-ponens-2 @- @--))
+           ((v P C)                             (@given y))
+           ((v P D)                             (build.disjoined-modus-ponens @- @--))))
+
+
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/not-compiler.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/not-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/not-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/not-compiler.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,335 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(include-book "if-lemmas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund@ rw.compile-negative-if-trace (x)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.negative-if-tracep x))
+                  :verify-guards nil))
+  (let* ((hypbox   (rw.trace->hypbox x))
+         (iffp     (rw.trace->iffp x))
+         (lhs      (rw.trace->lhs x))
+         (guts     (first (logic.function-args lhs)))
+         (lemma    (@derive
+                    ((= (not x) (if x nil t))       (build.axiom (definition-of-not)))
+                    ((= (if x nil t) (not x))       (build.commute-pequal @-))
+                    ((= (if guts nil t) (not guts)) (build.instantiation @- (list (cons 'x guts))))))
+         (lemma2   (if iffp
+                       (build.iff-from-pequal lemma)
+                     (build.equal-from-pequal lemma))))
+    (if (or (rw.hypbox->left hypbox)
+            (rw.hypbox->right hypbox))
+        (build.expansion (rw.hypbox-formula hypbox) lemma2)
+      lemma2)))
+
+(defobligations rw.compile-negative-if-trace
+  (build.commute-pequal
+   build.iff-from-pequal
+   build.equal-from-pequal)
+  :extra-axioms ((definition-of-not)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.compile-negative-if-trace
+                           rw.negative-if-tracep
+                           logic.term-formula
+                           rw.assms-formula
+                           rw.hypbox-formula)))
+
+ (local (in-theory (enable definition-of-not)))
+
+ (local (in-theory (enable rw.trace-conclusion-formula
+                           rw.trace-formula)))
+
+ (defthm rw.compile-negative-if-trace-under-iff
+   (iff (rw.compile-negative-if-trace x)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.compile-negative-if-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.negative-if-tracep x)))
+            (equal (logic.appealp (rw.compile-negative-if-trace x))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-negative-if-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.negative-if-tracep x)))
+            (equal (logic.conclusion (rw.compile-negative-if-trace x))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-negative-if-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.negative-if-tracep x)
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations rw.compile-negative-if-trace)))
+            (equal (logic.proofp (rw.compile-negative-if-trace x) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.compile-negative-if-trace))
+
+
+
+
+
+
+
+(deftheorem rw.compile-not-lemma1
+  :derive (v (!= (iff x y) t) (= (not x) (not y)))
+  :proof  (@derive
+
+           ((v (!= (iff x1 x2) t) (= (if x1 y z) (if x2 y z)))     (build.theorem (rw.theorem-iff-implies-pequal-if-1)))
+           ((v (!= (iff x y) t) (= (if x nil t) (if y nil t)))     (build.instantiation @- (@sigma (x1 . x) (x2 . y) (y . nil) (z . t))) *1)
+
+           ((= (not x) (if x nil t))                               (build.axiom (definition-of-not)))
+           ((= (if x nil t) (not x))                               (build.commute-pequal @-)  *2)
+
+           ((= (if y nil t) (not y))                               (build.instantiation @- (@sigma (x . y))))
+           ((v (!= (iff x y) t) (= (if y nil t) (not y)))          (build.expansion (@formula (!= (iff x y) t)) @-))
+           ((v (!= (iff x y) t) (= (if x nil t) (not y)))          (build.disjoined-transitivity-of-pequal *1 @-))
+           ((v (!= (iff x y) t) (= (not y) (if x nil t)))          (build.disjoined-commute-pequal @-))
+
+           ((v (!= (iff x y) t) (= (if x nil t) (not x)))          (build.expansion (@formula (!= (iff x y) t)) *2))
+           ((v (!= (iff x y) t) (= (not y) (not x)))               (build.disjoined-transitivity-of-pequal @-- @-))
+           ((v (!= (iff x y) t) (= (not x) (not y)))               (build.disjoined-commute-pequal @-)))
+
+  :minatbl ((iff . 2)
+            (not . 1)
+            (if . 3)))
+
+(defderiv rw.compile-not-trace-lemma-0a
+  ;; Assumptions; general case
+  :from   ((proof x (v P (= (iff (? lhs) (? rhs)) t))))
+  :derive (v P (= (not (? lhs)) (not (? rhs))))
+  :proof  (@derive
+           ((v (!= (iff x y) t) (= (not x) (not y)))                                 (build.theorem (rw.compile-not-lemma1)))
+           ((v (!= (iff (? lhs) (? rhs)) t) (= (not (? lhs)) (not (? rhs))))         (build.instantiation @- (@sigma (x . (? lhs)) (y . (? rhs)))))
+           ((v P (v (!= (iff (? lhs) (? rhs)) t) (= (not (? lhs)) (not (? rhs)))))   (build.expansion (@formula P) @-))
+           ((v P (= (iff (? lhs) (? rhs)) t))                                        (@given x))
+           ((v P (= (not (? lhs)) (not (? rhs))))                                    (build.disjoined-modus-ponens @- @--)))
+  :minatbl ((not . 1)))
+
+(defderiv rw.compile-not-trace-lemma-1a
+  ;; Assumptions; special case when rhs is T
+  :from   ((proof x (v P (= (iff (? lhs) t) t))))
+  :derive (v P (= (not (? lhs)) nil))
+  :proof  (@derive
+           ((v (= x nil) (= (not x) nil))      (build.theorem (theorem-not-when-not-nil)))
+           ((v (= t nil) (= (not t) nil))      (build.instantiation @- (@sigma (x . t))))
+           ((!= t nil)                         (build.axiom (axiom-t-not-nil)))
+           ((= (not t) nil)                    (build.modus-ponens-2 @- @--))
+           ((v P (= (not t) nil))              (build.expansion (@formula P) @-)    *1)
+           ((v P (= (iff (? lhs) t) t))        (@given x))
+           ((v P (= (not (? lhs)) (not t)))    (rw.compile-not-trace-lemma-0a @-))
+           ((v P (= (not (? lhs)) nil))        (build.disjoined-transitivity-of-pequal @- *1)))
+  :minatbl ((not . 1)))
+
+(defderiv rw.compile-not-trace-lemma-2a
+  ;; Assumptions; special case when rhs is NIL
+  :from   ((proof x (v P (= (iff (? lhs) nil) t))))
+  :derive (v P (= (not (? lhs)) t))
+  :proof  (@derive
+           ((v (!= x nil) (= (not x) t))              (build.theorem (theorem-not-when-nil)))
+           ((v (!= nil nil) (= (not nil) t))          (build.instantiation @- (@sigma (x . nil))))
+           ((= nil nil)                               (build.reflexivity ''nil))
+           ((= (not nil) t)                           (build.modus-ponens @- @--))
+           ((v P (= (not nil) t))                     (build.expansion (@formula P) @-) *1)
+           ((v P (= (iff (? lhs) nil) t))             (@given x))
+           ((v P (= (not (? lhs)) (not nil)))         (rw.compile-not-trace-lemma-0a @-))
+           ((v P (= (not (? lhs)) t))                 (build.disjoined-transitivity-of-pequal @- *1)))
+  :minatbl ((not . 1)))
+
+(defderiv rw.compile-not-trace-lemma-0b
+  ;; No assumptions; general case
+  :from   ((proof x (= (iff (? lhs) (? rhs)) t)))
+  :derive (= (not (? lhs)) (not (? rhs)))
+  :proof  (@derive
+           ((v (!= (iff x y) t) (= (not x) (not y)))                          (build.theorem (rw.compile-not-lemma1)))
+           ((v (!= (iff (? lhs) (? rhs)) t) (= (not (? lhs)) (not (? rhs))))  (build.instantiation @- (@sigma (x . (? lhs)) (y . (? rhs)))))
+           ((= (iff (? lhs) (? rhs)) t)                                       (@given x))
+           ((= (not (? lhs)) (not (? rhs)))                                   (build.modus-ponens @- @--)))
+  :minatbl ((not . 1)))
+
+(defderiv rw.compile-not-trace-lemma-1b
+  ;; No assumptions; special case when rhs is T
+  :from   ((proof x (= (iff (? lhs) t) t)))
+  :derive (= (not (? lhs)) nil)
+  :proof  (@derive
+           ((v (= x nil) (= (not x) nil))      (build.theorem (theorem-not-when-not-nil)))
+           ((v (= t nil) (= (not t) nil))      (build.instantiation @- (@sigma (x . t))))
+           ((!= t nil)                         (build.axiom (axiom-t-not-nil)))
+           ((= (not t) nil)                    (build.modus-ponens-2 @- @--) *1)
+           ((= (iff (? lhs) t) t)              (@given x))
+           ((= (not (? lhs)) (not t))          (rw.compile-not-trace-lemma-0b @-))
+           ((= (not (? lhs)) nil)              (build.transitivity-of-pequal @- *1)))
+  :minatbl ((not . 1)))
+
+(defderiv rw.compile-not-trace-lemma-2b
+  ;; No assumptions; special case when rhs is NIL
+  :from   ((proof x (= (iff (? lhs) nil) t)))
+  :derive (= (not (? lhs)) t)
+  :proof  (@derive
+           ((v (!= x nil) (= (not x) t))       (build.theorem (theorem-not-when-nil)))
+           ((v (!= nil nil) (= (not nil) t))   (build.instantiation @- (@sigma (x . nil))))
+           ((= nil nil)                        (build.reflexivity ''nil))
+           ((= (not nil) t)                    (build.modus-ponens @- @--) *1)
+           ((= (iff (? lhs) nil) t)            (@given x))
+           ((= (not (? lhs)) (not nil))        (rw.compile-not-trace-lemma-0b @-))
+           ((= (not (? lhs)) t)                (build.transitivity-of-pequal @- *1)))
+  :minatbl ((not . 1)))
+
+(defund@ rw.compile-not-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.not-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((hypbox  (rw.trace->hypbox x))
+         (iffp    (rw.trace->iffp x))
+         (sub1    (first (rw.trace->subtraces x)))
+         (rhs     (rw.trace->rhs sub1))
+         (proof1  (first proofs)))
+    (if (or (rw.hypbox->left hypbox)
+            (rw.hypbox->right hypbox))
+        (let ((lemma (cond ((equal rhs ''t)
+                            (rw.compile-not-trace-lemma-1a proof1))
+                           ((equal rhs ''nil)
+                            (rw.compile-not-trace-lemma-2a proof1))
+                           (t
+                            (rw.compile-not-trace-lemma-0a proof1)))))
+          (if iffp
+              (build.disjoined-iff-from-pequal lemma)
+            (build.disjoined-equal-from-pequal lemma)))
+      (let ((lemma (cond ((equal rhs ''t)
+                          (rw.compile-not-trace-lemma-1b proof1))
+                         ((equal rhs ''nil)
+                          (rw.compile-not-trace-lemma-2b proof1))
+                         (t
+                          (rw.compile-not-trace-lemma-0b proof1)))))
+        (if iffp
+            (build.iff-from-pequal lemma)
+          (build.equal-from-pequal lemma))))))
+
+(defobligations rw.compile-not-trace
+  (rw.compile-not-trace-lemma-1a
+   rw.compile-not-trace-lemma-2a
+   rw.compile-not-trace-lemma-0a
+   build.disjoined-iff-from-pequal
+   build.disjoined-equal-from-pequal
+   rw.compile-not-trace-lemma-1b
+   rw.compile-not-trace-lemma-2b
+   rw.compile-not-trace-lemma-0b
+   build.iff-from-pequal
+   build.equal-from-pequal))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.compile-not-trace
+                           rw.not-tracep
+                           logic.term-formula
+                           rw.hypbox-formula)))
+
+ (local (in-theory (enable rw.trace-conclusion-formula
+                           rw.trace-formula)))
+
+ (defthmd lemma-1-for-rw.compile-not-trace
+   (implies (and (equal (rw.trace-list-formulas (rw.trace->subtraces x)) (logic.strip-conclusions proofs))
+                 (equal (len (rw.trace->subtraces x)) 1))
+            (equal (consp proofs)
+                   t)))
+
+ (defthmd lemma-2-for-rw.compile-not-trace
+   (implies (and (equal (rw.trace-list-formulas (rw.trace->subtraces x)) (logic.strip-conclusions proofs))
+                 (equal (len (rw.trace->subtraces x)) 1))
+            (equal (logic.conclusion (first proofs))
+                   (rw.trace-formula (first (rw.trace->subtraces x)))))
+   :hints(("Goal" :in-theory (disable rw.trace-formula))))
+
+ (local (in-theory (enable lemma-1-for-rw.compile-not-trace
+                           lemma-2-for-rw.compile-not-trace)))
+
+ (defthm rw.compile-not-trace-under-iff
+   (iff (rw.compile-not-trace x proofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.compile-not-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.not-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-not-trace x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-not-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.not-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-not-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-not-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.not-tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations rw.compile-not-trace)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (logic.proofp (rw.compile-not-trace x proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards rw.compile-not-trace))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/trace-arities.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/trace-arities.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/trace-arities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/trace-arities.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,499 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tracep")
+(include-book "../assms/hypbox-arities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund rw.slow-flag-trace-arities (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (rw.tracep x)
+                           (rw.trace-listp x))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+  (if (equal flag 'term)
+      (let* ((res (rw.slow-hypbox-arities (rw.trace->hypbox x)))
+             (res (app (logic.slow-term-arities (rw.trace->lhs x)) res))
+             (res (app (logic.slow-term-arities (rw.trace->rhs x)) res))
+             (res (app (rw.slow-flag-trace-arities 'list (rw.trace->subtraces x)) res)))
+        res)
+    (if (consp x)
+        (app (rw.slow-flag-trace-arities 'term (car x))
+             (rw.slow-flag-trace-arities 'list (cdr x)))
+      nil)))
+
+(definlined rw.slow-trace-arities (x)
+  (declare (xargs :guard (rw.tracep x)))
+  (rw.slow-flag-trace-arities 'term x))
+
+(definlined rw.slow-trace-list-arities (x)
+  (declare (xargs :guard (rw.trace-listp x)))
+  (rw.slow-flag-trace-arities 'list x))
+
+(defthmd definition-of-rw.slow-trace-arities
+  (equal (rw.slow-trace-arities x)
+         (let* ((res (rw.slow-hypbox-arities (rw.trace->hypbox x)))
+                (res (app (logic.slow-term-arities (rw.trace->lhs x)) res))
+                (res (app (logic.slow-term-arities (rw.trace->rhs x)) res))
+                (res (app (rw.slow-trace-list-arities (rw.trace->subtraces x)) res)))
+           res))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand ((rw.slow-flag-trace-arities 'term x))
+          :in-theory (enable rw.slow-trace-list-arities rw.slow-trace-arities))))
+
+(defthmd definition-of-rw.slow-trace-list-arities
+  (equal (rw.slow-trace-list-arities x)
+         (if (consp x)
+             (app (rw.slow-trace-arities (car x))
+                  (rw.slow-trace-list-arities (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand ((rw.slow-flag-trace-arities 'list x))
+          :in-theory (enable rw.slow-trace-list-arities rw.slow-trace-arities))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.slow-trace-arities))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.slow-trace-arities-list))))
+
+(defthm rw.slow-trace-list-arities-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.slow-trace-list-arities x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-rw.slow-trace-list-arities))))
+
+(defthm rw.slow-trace-list-arities-of-cons
+  (equal (rw.slow-trace-list-arities (cons a x))
+         (app (rw.slow-trace-arities a)
+              (rw.slow-trace-list-arities x)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.slow-trace-list-arities))))
+
+
+
+(defund rw.flag-trace-arities (flag x acc)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (rw.tracep x)
+                                (rw.trace-listp x))
+                              (true-listp acc))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (let* ((acc (rw.hypbox-arities (rw.trace->hypbox x) acc))
+             (acc (logic.term-arities (rw.trace->lhs x) acc))
+             (acc (logic.term-arities (rw.trace->rhs x) acc)))
+        (rw.flag-trace-arities 'list (rw.trace->subtraces x) acc))
+    (if (consp x)
+        (rw.flag-trace-arities 'term (car x)
+                               (rw.flag-trace-arities 'list (cdr x) acc))
+      acc)))
+
+(definlined rw.trace-arities (x acc)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (rw.flag-trace-arities 'term x acc))
+
+(definlined rw.trace-list-arities (x acc)
+  (declare (xargs :guard (and (rw.trace-listp x)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (rw.flag-trace-arities 'list x acc))
+
+(defthmd definition-of-rw.trace-arities
+  (equal (rw.trace-arities x acc)
+         (let* ((acc (rw.hypbox-arities (rw.trace->hypbox x) acc))
+                (acc (logic.term-arities (rw.trace->lhs x) acc))
+                (acc (logic.term-arities (rw.trace->rhs x) acc)))
+           (rw.trace-list-arities (rw.trace->subtraces x) acc)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (e/d (rw.trace-arities
+                           rw.trace-list-arities)
+                          ((:executable-counterpart acl2::force)))
+          :expand (rw.flag-trace-arities 'term x acc))))
+
+(defthmd definition-of-rw.trace-list-arities
+  (equal (rw.trace-list-arities x acc)
+         (if (consp x)
+             (rw.trace-arities (car x)
+                               (rw.trace-list-arities (cdr x) acc))
+           acc))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (e/d (rw.trace-arities
+                           rw.trace-list-arities)
+                          ((:executable-counterpart acl2::force)))
+          :expand (rw.flag-trace-arities 'list x acc))))
+
+(defthm rw.flag-trace-arities-of-term
+  (equal (rw.flag-trace-arities 'term x acc)
+         (rw.trace-arities x acc))
+  :hints(("Goal" :in-theory (enable rw.trace-arities))))
+
+(defthm rw.flag-trace-arities-of-list
+  (equal (rw.flag-trace-arities 'list x acc)
+         (rw.trace-list-arities x acc))
+  :hints(("Goal" :in-theory (enable rw.trace-list-arities))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-arities))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-list-arities))))
+
+(defthm rw.trace-list-arities-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.trace-list-arities x acc)
+                  acc))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-list-arities))))
+
+(defthm rw.trace-list-arities-of-cons
+  (equal (rw.trace-list-arities (cons a x) acc)
+         (rw.trace-arities a
+                           (rw.trace-list-arities x acc)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-list-arities))))
+
+
+(defthms-flag
+  :shared-hyp (force (true-listp acc))
+  :thms ((term true-listp-of-rw.trace-arities
+               (equal (true-listp (rw.trace-arities x acc))
+                      t))
+         (t true-listp-of-rw.trace-list-arities
+            (equal (true-listp (rw.trace-list-arities x acc))
+                   t)))
+  :hints(("Goal"
+          :induct (rw.flag-trace-arities flag x acc)
+          :in-theory (enable (:induction rw.flag-trace-arities))
+          :expand ((rw.trace-arities x acc)))))
+
+(verify-guards rw.flag-trace-arities)
+(verify-guards rw.trace-arities)
+(verify-guards rw.trace-list-arities)
+
+
+(defthms-flag
+  :shared-hyp (force (true-listp acc))
+  :thms ((term rw.trace-arities-removal
+               (equal (rw.trace-arities x acc)
+                      (app (rw.slow-trace-arities x)
+                           acc)))
+         (t rw.trace-list-arities-removal
+            (equal (rw.trace-list-arities x acc)
+                   (app (rw.slow-trace-list-arities x)
+                        acc))))
+  :hints(("Goal"
+          :induct (rw.flag-trace-arities flag x acc)
+          :in-theory (enable (:induction rw.flag-trace-arities))
+          :expand ((rw.trace-arities x acc)
+                   (rw.slow-trace-arities x)))))
+
+(defthms-flag
+  :thms ((term rw.slow-trace-arities-correct
+               (implies (force (rw.tracep x))
+                        (equal (logic.arities-okp (rw.slow-trace-arities x) atbl)
+                               (rw.trace-atblp x atbl))))
+         (t rw.slow-trace-list-arities-correct
+            (implies (force (rw.trace-listp x))
+                     (equal (logic.arities-okp (rw.slow-trace-list-arities x) atbl)
+                            (rw.trace-list-atblp x atbl)))))
+  :hints(("Goal"
+          :induct (rw.trace-induction flag x)
+          :expand ((rw.trace-atblp x atbl)
+                   (rw.slow-trace-arities x))
+          :in-theory (disable (:executable-counterpart acl2::force)))))
+
+
+(definlined rw.fast-trace-atblp (x atbl)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (logic.arity-tablep atbl))))
+  (logic.fast-arities-okp (rw.trace-arities x nil) atbl))
+
+(defthm rw.fast-trace-atblp-removal
+  (implies (and (force (rw.tracep x))
+                (force (mapp atbl)))
+           (equal (rw.fast-trace-atblp x atbl)
+                  (rw.trace-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable rw.fast-trace-atblp))))
+
+
+
+
+(defund rw.fast-trace-list-atblp (x atbl)
+  (declare (xargs :guard (and (rw.trace-listp x)
+                              (logic.arity-tablep atbl))))
+  (logic.fast-arities-okp (rw.trace-list-arities x nil) atbl))
+
+(defthm rw.fast-trace-list-atblp-removal
+  (implies (force (and (rw.trace-listp x)
+                       (mapp atbl)))
+           (equal (rw.fast-trace-list-atblp x atbl)
+                  (rw.trace-list-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable rw.fast-trace-list-atblp))))
+
+
+
+
+
+
+; Now we want to do develop a similar arity table check that avoids redundantly gathering
+; arities from equal hypboxes.
+
+(defund rw.slow-faster-flag-trace-arities (flag x ext-hypbox)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (rw.tracep x)
+                                (rw.trace-listp x))
+                              (rw.hypboxp ext-hypbox))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+  (if (equal flag 'term)
+      (let* ((hypbox (rw.trace->hypbox x))
+             (res (if (equal hypbox ext-hypbox)
+                      nil
+                    (rw.slow-hypbox-arities hypbox)))
+             (res (app (logic.slow-term-arities (rw.trace->lhs x)) res))
+             (res (app (logic.slow-term-arities (rw.trace->rhs x)) res))
+             (res (app (rw.slow-faster-flag-trace-arities 'list (rw.trace->subtraces x) hypbox) res)))
+        res)
+    (if (consp x)
+        (app (rw.slow-faster-flag-trace-arities 'term (car x) ext-hypbox)
+             (rw.slow-faster-flag-trace-arities 'list (cdr x) ext-hypbox))
+      nil)))
+
+(defund rw.slow-faster-trace-arities (x ext-hypbox)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.hypboxp ext-hypbox))))
+  (rw.slow-faster-flag-trace-arities 'term x ext-hypbox))
+
+(defund rw.slow-faster-trace-list-arities (x ext-hypbox)
+  (declare (xargs :guard (and (rw.trace-listp x)
+                              (rw.hypboxp ext-hypbox))))
+  (rw.slow-faster-flag-trace-arities 'list x ext-hypbox))
+
+(defthmd definition-of-rw.slow-faster-trace-arities
+  (equal (rw.slow-faster-trace-arities x ext-hypbox)
+         (let* ((hypbox (rw.trace->hypbox x))
+                (res (if (equal hypbox ext-hypbox)
+                         nil
+                       (rw.slow-hypbox-arities hypbox)))
+                (res (app (logic.slow-term-arities (rw.trace->lhs x)) res))
+                (res (app (logic.slow-term-arities (rw.trace->rhs x)) res))
+                (res (app (rw.slow-faster-trace-list-arities (rw.trace->subtraces x) hypbox) res)))
+           res))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand ((rw.slow-faster-flag-trace-arities 'term x ext-hypbox))
+          :in-theory (enable rw.slow-faster-trace-arities
+                             rw.slow-faster-trace-list-arities ))))
+
+(defthmd definition-of-rw.slow-faster-trace-list-arities
+  (equal (rw.slow-faster-trace-list-arities x ext-hypbox)
+         (if (consp x)
+             (app (rw.slow-faster-trace-arities (car x) ext-hypbox)
+                  (rw.slow-faster-trace-list-arities (cdr x) ext-hypbox))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand ((rw.slow-faster-flag-trace-arities 'list x ext-hypbox))
+          :in-theory (enable rw.slow-faster-trace-arities
+                             rw.slow-faster-trace-list-arities))))
+
+(defthm rw.slow-faster-flag-trace-arities-of-term
+  (equal (rw.slow-faster-flag-trace-arities 'term x ext-hypbox)
+         (rw.slow-faster-trace-arities x ext-hypbox))
+  :hints(("Goal" :in-theory (enable rw.slow-faster-trace-arities))))
+
+(defthm rw.slow-faster-flag-trace-arities-of-list
+  (equal (rw.slow-faster-flag-trace-arities 'list x ext-hypbox)
+         (rw.slow-faster-trace-list-arities x ext-hypbox))
+  :hints(("Goal" :in-theory (enable rw.slow-faster-trace-list-arities))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.slow-faster-trace-arities))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.slow-faster-trace-list-arities))))
+
+(defthm rw.slow-faster-trace-list-arities-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.slow-faster-trace-list-arities x ext-hypbox)
+                  nil))
+  :hints(("Goal" :expand (rw.slow-faster-trace-list-arities x ext-hypbox))))
+
+(defthm rw.slow-faster-trace-list-arities-of-cons
+  (equal (rw.slow-faster-trace-list-arities (cons a x) ext-hypbox)
+         (app (rw.slow-faster-trace-arities a ext-hypbox)
+              (rw.slow-faster-trace-list-arities x ext-hypbox)))
+  :hints(("Goal" :expand (rw.slow-faster-trace-list-arities (cons a x) ext-hypbox))))
+
+(defthms-flag
+  :shared-hyp (force (and (rw.hypboxp hypbox)
+                          (rw.hypbox-atblp hypbox atbl)))
+  :thms ((term rw.slow-faster-trace-arities-correct
+               (implies (rw.tracep x)
+                        (equal (logic.arities-okp (rw.slow-faster-trace-arities x hypbox) atbl)
+                               (rw.trace-atblp x atbl))))
+         (t rw.slow-faster-trace-list-arities-correct
+            (implies (rw.trace-listp x)
+                     (equal (logic.arities-okp (rw.slow-faster-trace-list-arities x hypbox) atbl)
+                            (rw.trace-list-atblp x atbl)))))
+  :hints(("Goal"
+          :in-theory (e/d ((:induction rw.slow-faster-flag-trace-arities))
+                          ((:executable-counterpart acl2::force)))
+          :induct (rw.slow-faster-flag-trace-arities flag x hypbox)
+          :expand ((rw.slow-faster-trace-arities x hypbox)
+                   (rw.trace-atblp x atbl)))))
+
+
+
+
+(defund rw.faster-flag-trace-arities (flag x ext-hypbox acc)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (rw.tracep x)
+                                (rw.trace-listp x))
+                              (rw.hypboxp ext-hypbox)
+                              (true-listp acc))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (let* ((hypbox (rw.trace->hypbox x))
+             (acc    (if (equal hypbox ext-hypbox)
+                         acc
+                       (rw.hypbox-arities (rw.trace->hypbox x) acc)))
+             (acc    (logic.term-arities (rw.trace->lhs x) acc))
+             (acc    (logic.term-arities (rw.trace->rhs x) acc)))
+        (rw.faster-flag-trace-arities 'list (rw.trace->subtraces x) hypbox acc))
+    (if (consp x)
+        (rw.faster-flag-trace-arities 'term (car x) ext-hypbox
+                                      (rw.faster-flag-trace-arities 'list (cdr x) ext-hypbox acc))
+      acc)))
+
+(defund rw.faster-trace-arities (x ext-hypbox acc)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.hypboxp ext-hypbox)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (rw.faster-flag-trace-arities 'term x ext-hypbox acc))
+
+(defund rw.faster-trace-list-arities (x ext-hypbox acc)
+  (declare (xargs :guard (and (rw.trace-listp x)
+                              (rw.hypboxp ext-hypbox)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (rw.faster-flag-trace-arities 'list x ext-hypbox acc))
+
+(defthmd definition-of-rw.faster-trace-arities
+  (equal (rw.faster-trace-arities x ext-hypbox acc)
+         (let* ((hypbox (rw.trace->hypbox x))
+                (acc    (if (equal hypbox ext-hypbox)
+                            acc
+                          (rw.hypbox-arities (rw.trace->hypbox x) acc)))
+                (acc    (logic.term-arities (rw.trace->lhs x) acc))
+                (acc    (logic.term-arities (rw.trace->rhs x) acc)))
+           (rw.faster-trace-list-arities (rw.trace->subtraces x) hypbox acc)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand (rw.faster-flag-trace-arities 'term x ext-hypbox acc)
+          ::in-theory (enable rw.faster-trace-arities rw.faster-trace-list-arities))))
+
+(defthmd definition-of-rw.faster-trace-list-arities
+  (equal (rw.faster-trace-list-arities x ext-hypbox acc)
+         (if (consp x)
+             (rw.faster-trace-arities (car x) ext-hypbox
+              (rw.faster-trace-list-arities (cdr x) ext-hypbox acc))
+           acc))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand (rw.faster-flag-trace-arities 'list x ext-hypbox acc)
+          ::in-theory (enable rw.faster-trace-arities rw.faster-trace-list-arities))))
+
+(defthm rw.faster-flag-trace-arities-of-term
+  (equal (rw.faster-flag-trace-arities 'term x ext-hypbox acc)
+         (rw.faster-trace-arities x ext-hypbox acc))
+  :hints(("Goal" :in-theory (enable rw.faster-trace-arities))))
+
+(defthm rw.faster-flag-trace-arities-of-list
+  (equal (rw.faster-flag-trace-arities 'list x ext-hypbox acc)
+         (rw.faster-trace-list-arities x ext-hypbox acc))
+  :hints(("Goal" :in-theory (enable rw.faster-trace-list-arities))))
+
+(defthm rw.faster-trace-list-arities-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.faster-trace-list-arities x ext-hypbox acc)
+                  acc))
+  :hints(("Goal" :expand (rw.faster-trace-list-arities x ext-hypbox acc))))
+
+(defthm rw.faster-trace-list-arities-of-cons
+  (equal (rw.faster-trace-list-arities (cons a x) ext-hypbox acc)
+         (rw.faster-trace-arities a ext-hypbox
+                                  (rw.faster-trace-list-arities x ext-hypbox acc)))
+  :hints(("Goal"
+          :expand (rw.faster-trace-list-arities (cons a x) ext-hypbox acc)
+          :in-theory (disable (:executable-counterpart acl2::force))
+          )))
+
+(defthms-flag
+  :shared-hyp (force (true-listp acc))
+  :thms ((term true-listp-of-rw.faster-trace-arities
+               (equal (true-listp (rw.faster-trace-arities x ext-hypbox acc))
+                      t))
+         (t true-listp-of-rw.faster-trace-list-arities
+            (equal (true-listp (rw.faster-trace-list-arities x ext-hypbox acc))
+                   t)))
+  :hints(("Goal"
+          :induct (rw.faster-flag-trace-arities flag x ext-hypbox acc)
+          :in-theory (e/d ((:induction rw.faster-flag-trace-arities)))
+          :expand ((rw.faster-trace-arities x ext-hypbox acc)
+                   (rw.slow-faster-trace-arities x ext-hypbox)))))
+
+(defthms-flag
+  :shared-hyp (force (true-listp acc))
+  :thms ((term rw.faster-trace-arities-removal
+               (equal (rw.faster-trace-arities x ext-hypbox acc)
+                      (app (rw.slow-faster-trace-arities x ext-hypbox)
+                           acc)))
+         (t rw.faster-trace-list-arities-removal
+            (equal (rw.faster-trace-list-arities x ext-hypbox acc)
+                   (app (rw.slow-faster-trace-list-arities x ext-hypbox)
+                        acc))))
+  :hints(("Goal"
+          :induct (rw.faster-flag-trace-arities flag x ext-hypbox acc)
+          :in-theory (e/d ((:induction rw.faster-flag-trace-arities))
+                          ;((:executable-counterpart acl2::force)))
+                          )
+          :expand ((rw.faster-trace-arities x ext-hypbox acc)
+                   (rw.slow-faster-trace-arities x ext-hypbox)))))
+
+(verify-guards rw.faster-flag-trace-arities)
+(verify-guards rw.faster-trace-arities)
+(verify-guards rw.faster-trace-list-arities)
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/trace-compiler.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/trace-compiler.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/trace-compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/trace-compiler.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,491 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-compilers")
+(include-book "urewrite-compilers")
+(include-book "crewrite-compilers")
+(include-book "crewrite-rule-compiler")
+(include-book "not-compiler")
+(include-book "collect-forced-goals")
+(include-book "trace-arities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund rw.compile-trace-step (x defs proofs fproofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs)
+                              (rw.trace-step-okp x defs)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                              (logic.appeal-listp fproofs)
+                              (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs)))
+                  :verify-guards nil))
+  (let ((method (rw.trace->method x)))
+    (cond ((equal method 'fail)                          (rw.compile-fail-trace x))
+          ((equal method 'transitivity)                  (rw.compile-transitivity-trace x proofs))
+          ((equal method 'equiv-by-args)                 (rw.compile-equiv-by-args-trace x proofs))
+          ((equal method 'lambda-equiv-by-args)          (rw.compile-lambda-equiv-by-args-trace x proofs))
+          ((equal method 'beta-reduction)                (rw.compile-beta-reduction-trace x))
+          ((equal method 'ground)                        (rw.compile-ground-trace x defs))
+          ((equal method 'if-specialcase-nil)            (rw.compile-if-specialcase-nil-trace x proofs))
+          ((equal method 'if-specialcase-t)              (rw.compile-if-specialcase-t-trace x proofs))
+          ((equal method 'not)                           (rw.compile-not-trace x proofs))
+          ((equal method 'negative-if)                   (rw.compile-negative-if-trace x))
+          ;; ---
+          ((equal method 'urewrite-if-specialcase-same)  (rw.compile-urewrite-if-specialcase-same-trace x proofs))
+          ((equal method 'urewrite-if-generalcase)       (rw.compile-urewrite-if-generalcase-trace x proofs))
+          ((equal method 'urewrite-rule)                 (rw.compile-urewrite-rule-trace x))
+          ;; ---
+          ((equal method 'crewrite-if-specialcase-same)  (rw.compile-crewrite-if-specialcase-same-trace x proofs))
+          ((equal method 'crewrite-if-generalcase)       (rw.compile-crewrite-if-generalcase-trace x proofs))
+          ((equal method 'crewrite-rule)                 (rw.compile-crewrite-rule-trace x proofs))
+          ((equal method 'assumptions)                   (rw.compile-assumptions-trace x))
+          ((equal method 'force)                         (rw.compile-force-trace x fproofs))
+          ((equal method 'weakening)                     (rw.compile-weakening-trace x proofs))
+          ;; Sneaky twiddle for hypless iff theorem
+          (t t))))
+
+(defobligations rw.compile-trace-step
+  (rw.compile-fail-trace
+   rw.compile-transitivity-trace
+   rw.compile-equiv-by-args-trace
+   rw.compile-lambda-equiv-by-args-trace
+   rw.compile-beta-reduction-trace
+   rw.compile-ground-trace
+   rw.compile-if-specialcase-nil-trace
+   rw.compile-if-specialcase-t-trace
+   rw.compile-not-trace
+   rw.compile-negative-if-trace
+   ;; ---
+   rw.compile-urewrite-if-specialcase-same-trace
+   rw.compile-urewrite-if-generalcase-trace
+   rw.compile-urewrite-rule-trace
+   ;; ---
+   rw.compile-crewrite-if-specialcase-same-trace
+   rw.compile-crewrite-if-generalcase-trace
+   rw.compile-crewrite-rule-trace
+   rw.compile-assumptions-trace
+   rw.compile-force-trace
+   rw.compile-weakening-trace
+   ))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.trace-step-okp
+                           rw.trace-step-env-okp
+                           rw.compile-trace-step)))
+
+ (verify-guards rw.compile-trace-step)
+
+ (defthm rw.compile-trace-step-under-iff
+   (iff (rw.compile-trace-step x defs proofs fproofs)
+        t))
+
+ (defthm forcing-logic.appealp-of-rw.compile-trace-step
+   (implies (force (and (rw.tracep x)
+                        (definition-listp defs)
+                        (rw.trace-step-okp x defs)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs))))
+            (equal (logic.appealp (rw.compile-trace-step x defs proofs fproofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.compile-trace-step
+   (implies (force (and (rw.tracep x)
+                        (definition-listp defs)
+                        (rw.trace-step-okp x defs)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs))))
+            (equal (logic.conclusion (rw.compile-trace-step x defs proofs fproofs))
+                   (rw.trace-formula x))))
+
+ (defthm@ forcing-logic.proofp-of-rw.compile-trace-step
+   (implies (force (and (rw.tracep x)
+                        (definition-listp defs)
+                        (rw.trace-step-okp x defs)
+                        (rw.trace-step-env-okp x defs thms atbl)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (logic.proof-listp fproofs axioms thms atbl)
+                        (logic.formula-list-atblp defs atbl)
+                        (subsetp defs axioms)
+                        (@obligations rw.compile-trace-step)))
+            (equal (logic.proofp (rw.compile-trace-step x defs proofs fproofs) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund rw.flag-compile-trace (flag x defs fproofs)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (and (rw.tracep x)
+                                  (definition-listp defs)
+                                  (rw.trace-okp x defs)
+                                  (logic.appeal-listp fproofs)
+                                  (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs)))
+                           (and (rw.trace-listp x)
+                                (definition-listp defs)
+                                (rw.trace-list-okp x defs)
+                                (logic.appeal-listp fproofs)
+                                (subsetp (rw.collect-forced-goals-list x) (logic.strip-conclusions fproofs))))
+                  :measure (two-nats-measure (rank x)
+                                             (if (equal flag 'term) 1 0))
+                  :verify-guards nil))
+  (if (equal flag 'term)
+      (rw.compile-trace-step x
+                             defs
+                             (rw.flag-compile-trace 'list (rw.trace->subtraces x) defs fproofs)
+                             fproofs)
+    (if (consp x)
+        (cons (rw.flag-compile-trace 'term (car x) defs fproofs)
+              (rw.flag-compile-trace 'list (cdr x) defs fproofs))
+      nil)))
+
+(defund rw.compile-trace (x defs fproofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs)
+                              (rw.trace-okp x defs)
+                              (logic.appeal-listp fproofs)
+                              (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs)))
+                  :verify-guards nil))
+  (rw.flag-compile-trace 'term x defs fproofs))
+
+(defund rw.compile-trace-list (x defs fproofs)
+  (declare (xargs :guard (and (rw.trace-listp x)
+                              (definition-listp defs)
+                              (rw.trace-list-okp x defs)
+                              (logic.appeal-listp fproofs)
+                              (subsetp (rw.collect-forced-goals-list x) (logic.strip-conclusions fproofs)))
+                  :verify-guards nil))
+  (rw.flag-compile-trace 'list x defs fproofs))
+
+(defthmd definition-of-rw.compile-trace
+  (equal (rw.compile-trace x defs fproofs)
+         (rw.compile-trace-step x
+                                defs
+                                (rw.compile-trace-list (rw.trace->subtraces x) defs fproofs)
+                                fproofs))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.flag-compile-trace
+                                    rw.compile-trace
+                                    rw.compile-trace-list))))
+
+(defthmd definition-of-rw.compile-trace-list
+  (equal (rw.compile-trace-list x defs fproofs)
+         (if (consp x)
+             (cons (rw.compile-trace (car x) defs fproofs)
+                   (rw.compile-trace-list (cdr x) defs fproofs))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.flag-compile-trace
+                                    rw.compile-trace
+                                    rw.compile-trace-list))))
+
+(defthm rw.flag-compile-trace-of-term-removal
+  (equal (rw.flag-compile-trace 'term x defs fproofs)
+         (rw.compile-trace x defs fproofs))
+  :hints(("Goal" :in-theory (enable rw.compile-trace))))
+
+(defthm rw.flag-compile-trace-of-list-removal
+  (equal (rw.flag-compile-trace 'list x defs fproofs)
+         (rw.compile-trace-list x defs fproofs))
+  :hints(("Goal" :in-theory (enable rw.compile-trace-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.compile-trace))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.compile-trace-list))))
+
+
+(defobligations rw.flag-compile-trace
+  (rw.compile-trace-step))
+
+(defobligations rw.compile-trace
+  (rw.flag-compile-trace))
+
+(defobligations rw.compile-trace-list
+  (rw.flag-compile-trace))
+
+
+(defthms-flag
+  :shared-hyp (force (and (logic.appeal-listp fproofs)
+                          (definition-listp defs)))
+  :thms ((term forcing-logic.appealp-of-rw.compile-trace
+               (implies (force (and (rw.tracep x)
+                                    (rw.trace-okp x defs)
+                                    (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs))))
+                        (equal (logic.appealp (rw.compile-trace x defs fproofs))
+                               t)))
+         (term forcing-logic.conclusion-of-rw.compile-trace
+               (implies (force (and (rw.tracep x)
+                                    (rw.trace-okp x defs)
+                                    (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs))))
+                        (equal (logic.conclusion (rw.compile-trace x defs fproofs))
+                               (rw.trace-formula x))))
+         (t forcing-logic.appeal-listp-of-rw.compile-trace-list
+            (implies (force (and (rw.trace-listp x)
+                                 (rw.trace-list-okp x defs)
+                                 (subsetp (rw.collect-forced-goals-list x) (logic.strip-conclusions fproofs))))
+                     (equal (logic.appeal-listp (rw.compile-trace-list x defs fproofs))
+                            t)))
+         (t forcing-logic.strip-conclusions-of-rw.compile-trace-list
+            (implies (force (and (rw.trace-listp x)
+                                 (rw.trace-list-okp x defs)
+                                 (subsetp (rw.collect-forced-goals-list x) (logic.strip-conclusions fproofs))))
+                     (equal (logic.strip-conclusions (rw.compile-trace-list x defs fproofs))
+                            (rw.trace-list-formulas x)))))
+  :hints(("Goal"
+          :in-theory (enable definition-of-rw.compile-trace
+                             definition-of-rw.compile-trace-list)
+          :expand ((rw.compile-trace x defs fproofs)
+                   (rw.compile-trace-list x defs fproofs))
+          :induct (rw.trace-induction flag x))))
+
+(verify-guards rw.flag-compile-trace)
+(verify-guards rw.compile-trace)
+(verify-guards rw.compile-trace-list)
+
+(defthms-flag
+  :shared-hyp (force (and (logic.appeal-listp fproofs)
+                          (logic.proof-listp fproofs axioms thms atbl)
+                          (definition-listp defs)
+                          (logic.formula-list-atblp defs atbl)
+                          (subsetp defs axioms)
+                          (equal (cdr (lookup 'equal atbl)) 2)
+                          (equal (cdr (lookup 'iff atbl)) 2)
+                          (equal (cdr (lookup 'if atbl)) 3)
+                          (equal (cdr (lookup 'not atbl)) 1)))
+  :thms ((term forcing-logic.proofp-of-rw.compile-trace
+               (implies (force (and (rw.tracep x)
+                                    (rw.trace-okp x defs)
+                                    (subsetp (rw.collect-forced-goals x) (logic.strip-conclusions fproofs))
+                                    ;; ---
+                                    (rw.trace-atblp x atbl)
+                                    (rw.trace-env-okp x defs thms atbl)
+                                    (@obligations rw.compile-trace)))
+                        (equal (logic.proofp (rw.compile-trace x defs fproofs) axioms thms atbl)
+                               t)))
+         (t forcing-logic.proof-listp-of-rw.compile-trace
+            (implies (force (and (rw.trace-listp x)
+                                 (rw.trace-list-okp x defs)
+                                 (subsetp (rw.collect-forced-goals-list x) (logic.strip-conclusions fproofs))
+                                 ;; ---
+                                 (rw.trace-list-atblp x atbl)
+                                 (rw.trace-list-env-okp x defs thms atbl)
+                                 (@obligations rw.compile-trace-list)))
+                     (equal (logic.proof-listp (rw.compile-trace-list x defs fproofs) axioms thms atbl)
+                            t))))
+  :@contextp t
+  :hints (("Goal"
+           :in-theory (enable definition-of-rw.compile-trace
+                              definition-of-rw.compile-trace-list)
+           :expand ((rw.compile-trace x defs fproofs)
+                    (rw.compile-trace-list x defs fproofs))
+           :induct (rw.trace-induction flag x))))
+
+
+
+
+
+(defund rw.compile-trace-okp (x defs thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (definition-listp defs)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x))
+        (hypbox     (rw.hypbox nil nil)) ;; silly, used for fast checks
+        )
+    (and (equal method 'rw.compile-trace)
+         ;; extras is a valid trace
+         (rw.faster-tracep extras hypbox)
+         (logic.fast-arities-okp (rw.faster-trace-arities extras hypbox nil) atbl)
+         (rw.trace-okp extras defs)
+         (rw.trace-env-okp extras defs thms atbl)
+         ;; the trace has the right conclusion
+         (equal conclusion (rw.trace-formula extras))
+         ;; subproofs are the fproofs
+         (equal (remove-duplicates (rw.collect-forced-goals extras))
+                (logic.strip-conclusions subproofs)))))
+
+(defthm forcing-logic.appeal-listp-of-logic.find-proofs
+  ;; BOZO move to logic.find-proofs
+  (implies (force (and (logic.appeal-listp proofs)
+                       (subsetp formulas (logic.strip-conclusions proofs))))
+           (equal (logic.appeal-listp (logic.find-proofs formulas proofs))
+                  t))
+  :hints(("Goal" :induct (cdr-induction formulas))))
+
+(defthm forcing-logic.strip-conclusions-of-logic.find-proofs
+  ;; BOZO move to logic.find-proofs
+  (implies (force (and (logic.appeal-listp proofs)
+                       (subsetp formulas (logic.strip-conclusions proofs))))
+           (equal (logic.strip-conclusions (logic.find-proofs formulas proofs))
+                  (list-fix formulas)))
+  :hints(("Goal" :induct (cdr-induction formulas))))
+
+(defund rw.compile-trace-high (x defs fproofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs)
+                              (rw.trace-okp x defs)
+                              (logic.appeal-listp fproofs)
+                              (subsetp (rw.collect-forced-goals x)
+                                       (logic.strip-conclusions fproofs))))
+           (ignore defs))
+  (let* ((forced-goals         (rw.collect-forced-goals x))
+         (cleaned-forced-goals (remove-duplicates forced-goals)))
+    (ACl2::prog2$
+     (or (same-lengthp forced-goals cleaned-forced-goals)
+         (ACL2::cw! ";;; Removing forced duplicates reduced ~x0 goals to ~x1. (single trace)~%"
+                    (fast-len forced-goals 0)
+                    (fast-len cleaned-forced-goals 0)))
+     (logic.appeal 'rw.compile-trace
+                   (rw.trace-formula x)
+                   (logic.find-proofs cleaned-forced-goals fproofs)
+                   x))))
+
+(defthm rw.compile-trace-okp-of-rw.compile-trace-high
+  ;; Sanity check to make sure the high-level builder is going to work.
+  (implies (and (rw.tracep x)
+                (mapp atbl)
+                (definition-listp defs)
+                (rw.trace-okp x defs)
+                (logic.appeal-listp fproofs)
+                (subsetp (rw.collect-forced-goals x)
+                         (logic.strip-conclusions fproofs))
+                (rw.trace-atblp x atbl)
+                (rw.trace-env-okp x defs thms atbl))
+           (equal (rw.compile-trace-okp (rw.compile-trace-high x defs fproofs) defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.compile-trace-high
+                                    rw.compile-trace-okp))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.compile-trace-okp)))
+
+ (defthm booleanp-of-rw.compile-trace-okp
+   (equal (booleanp (rw.compile-trace-okp x defs thms atbl))
+          t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm rw.compile-trace-okp-of-logic.appeal-identity
+   (equal (rw.compile-trace-okp (logic.appeal-identity x) axioms thms atbl)
+          (rw.compile-trace-okp x axioms thms atbl))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthmd lemma-0-for-soundness-of-rw.compile-trace-okp
+   (implies (equal (remove-duplicates x) y)
+            (equal (subsetp x y)
+                   t)))
+
+ (local (in-theory (enable lemma-0-for-soundness-of-rw.compile-trace-okp)))
+
+ (defthmd lemma-1-for-soundness-of-rw.compile-trace-okp
+   (implies (and (rw.compile-trace-okp x defs thms atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (definition-listp defs))
+            (equal (logic.conclusion
+                    (rw.compile-trace (logic.extras x)
+                                      defs
+                                      (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                   axioms thms atbl)))
+                   (logic.conclusion x)))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthmd@ lemma-2-for-soundness-of-rw.compile-trace-okp
+   (implies (and (rw.compile-trace-okp x defs thms atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 ;; --
+                 (mapp atbl)
+                 (definition-listp defs)
+                 (logic.formula-list-atblp defs atbl)
+                 (subsetp defs axioms)
+                 (@obligations rw.compile-trace)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'if atbl)) 3))
+            (equal (logic.proofp
+                    (rw.compile-trace (logic.extras x)
+                                      defs
+                                      (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                   axioms thms atbl))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-rw.compile-trace-okp
+   (implies (and (rw.compile-trace-okp x defs thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (mapp atbl)
+                             (definition-listp defs)
+                             (logic.formula-list-atblp defs atbl)
+                             (subsetp defs axioms)
+                             (@obligations rw.compile-trace)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'if atbl)) 3))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :in-theory (enable lemma-1-for-soundness-of-rw.compile-trace-okp
+                               lemma-2-for-soundness-of-rw.compile-trace-okp)
+            :use ((:instance forcing-logic.provablep-when-logic.proofp
+                             (x (rw.compile-trace (logic.extras x)
+                                                  defs
+                                                  (logic.provable-list-witness (logic.strip-conclusions (logic.subproofs x))
+                                                                               axioms thms atbl)))))))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/trace-okp.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/trace-okp.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/trace-okp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/trace-okp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,306 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-recognizers")
+(include-book "urewrite-recognizers")
+(include-book "crewrite-recognizers")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund rw.trace-step-okp (x defs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs))))
+  (let ((method (rw.trace->method x)))
+    (cond ((equal method 'fail)                          (rw.fail-tracep x))
+          ((equal method 'transitivity)                  (rw.transitivity-tracep x))
+          ((equal method 'equiv-by-args)                 (rw.equiv-by-args-tracep x))
+          ((equal method 'lambda-equiv-by-args)          (rw.lambda-equiv-by-args-tracep x))
+          ((equal method 'beta-reduction)                (rw.beta-reduction-tracep x))
+          ((equal method 'ground)                        (rw.ground-tracep x defs))
+          ((equal method 'if-specialcase-nil)            (rw.if-specialcase-nil-tracep x))
+          ((equal method 'if-specialcase-t)              (rw.if-specialcase-t-tracep x))
+          ((equal method 'not)                           (rw.not-tracep x))
+          ((equal method 'negative-if)                   (rw.negative-if-tracep x))
+          ;; ---
+          ((equal method 'urewrite-if-specialcase-same)  (rw.urewrite-if-specialcase-same-tracep x))
+          ((equal method 'urewrite-if-generalcase)       (rw.urewrite-if-generalcase-tracep x))
+          ((equal method 'urewrite-rule)                 (rw.urewrite-rule-tracep x))
+          ;; ---
+          ((equal method 'crewrite-if-specialcase-same)  (rw.crewrite-if-specialcase-same-tracep x))
+          ((equal method 'crewrite-if-generalcase)       (rw.crewrite-if-generalcase-tracep x))
+          ((equal method 'crewrite-rule)                 (rw.crewrite-rule-tracep x))
+          ((equal method 'assumptions)                   (rw.assumptions-tracep x))
+          ((equal method 'force)                         (rw.force-tracep x))
+          ((equal method 'weakening)                     (rw.weakening-tracep x))
+          (t nil))))
+
+(defund rw.trace-step-env-okp (x defs thms atbl)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs)
+                              (rw.trace-step-okp x defs)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable rw.trace-step-okp))))
+           (ignore defs))
+  (let ((method (rw.trace->method x)))
+    (cond ((equal method 'urewrite-rule)  (rw.urewrite-rule-trace-env-okp x thms atbl))
+          ((equal method 'crewrite-rule)  (rw.crewrite-rule-trace-env-okp x thms atbl))
+          (t t))))
+
+(defthm booleanp-of-rw.trace-step-okp
+  (equal (booleanp (rw.trace-step-okp x defs))
+         t)
+  :hints(("Goal" :in-theory (enable rw.trace-step-okp))))
+
+(defthm booleanp-of-rw.trace-step-env-okp
+  (equal (booleanp (rw.trace-step-env-okp x defs thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+
+
+(defund rw.flag-trace-okp (flag x defs)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (rw.tracep x)
+                                (rw.trace-listp x))
+                              (definition-listp defs))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+  (if (equal flag 'term)
+      (and (rw.trace-step-okp x defs)
+           (rw.flag-trace-okp 'list (rw.trace->subtraces x) defs))
+    (if (consp x)
+        (and (rw.flag-trace-okp 'term (car x) defs)
+             (rw.flag-trace-okp 'list (cdr x) defs))
+      t)))
+
+(definlined rw.trace-okp (x defs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs))))
+  (rw.flag-trace-okp 'term x defs))
+
+(definlined rw.trace-list-okp (x defs)
+  (declare (xargs :guard (and (rw.trace-listp x)
+                              (definition-listp defs))))
+  (rw.flag-trace-okp 'list x defs))
+
+(defthmd definition-of-rw.trace-okp
+  (equal (rw.trace-okp x defs)
+         (and (rw.trace-step-okp x defs)
+              (rw.trace-list-okp (rw.trace->subtraces x) defs)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.trace-okp
+                                    rw.trace-list-okp
+                                    rw.flag-trace-okp))))
+
+(defthmd definition-of-rw.trace-list-okp
+  (equal (rw.trace-list-okp x defs)
+         (if (consp x)
+             (and (rw.trace-okp (car x) defs)
+                  (rw.trace-list-okp (cdr x) defs))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.trace-okp
+                                    rw.trace-list-okp
+                                    rw.flag-trace-okp))))
+
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-okp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-list-okp))))
+
+(defthm rw.trace-step-okp-of-nil
+  (equal (rw.trace-step-okp nil defs)
+         nil)
+  :hints(("Goal" :in-theory (enable rw.trace-step-okp))))
+
+(defthm rw.trace-okp-of-nil
+  (equal (rw.trace-okp nil defs)
+         nil)
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-okp))))
+
+(defthm rw.trace-list-okp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.trace-list-okp x defs)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-list-okp))))
+
+(defthm rw.trace-list-okp-of-cons
+  (equal (rw.trace-list-okp (cons a x) defs)
+         (and (rw.trace-okp a defs)
+              (rw.trace-list-okp x defs)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-list-okp))))
+
+(defthms-flag
+  :thms ((term booleanp-of-rw.trace-okp
+               (equal (booleanp (rw.trace-okp x defs))
+                      t))
+         (t booleanp-of-rw.trace-list-okp
+            (equal (booleanp (rw.trace-list-okp x defs))
+                   t)))
+  :hints(("Goal"
+          :in-theory (enable definition-of-rw.trace-okp)
+          :induct (rw.trace-induction flag x))))
+
+(deflist rw.trace-list-okp (x defs)
+  (rw.trace-okp x defs)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(defthm rw.trace-step-okp-when-rw.trace-okp
+  (implies (rw.trace-okp x defs)
+           (equal (rw.trace-step-okp x defs)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-okp))))
+
+(defthm rw.trace-list-okp-of-rw.trace->subtraces-when-rw.trace-okp
+  (implies (rw.trace-okp x defs)
+           (equal (rw.trace-list-okp (rw.trace->subtraces x) defs)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-okp))))
+
+
+
+
+
+(defund rw.flag-trace-env-okp (flag x defs thms atbl)
+  (declare (xargs :guard (and (definition-listp defs)
+                              (if (equal flag 'term)
+                                  (and (rw.tracep x)
+                                       (rw.trace-okp x defs))
+                                (and (rw.trace-listp x)
+                                     (rw.trace-list-okp x defs)))
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+  (if (equal flag 'term)
+      (and (rw.trace-step-env-okp x defs thms atbl)
+           (rw.flag-trace-env-okp 'list (rw.trace->subtraces x) defs thms atbl))
+    (if (consp x)
+        (and (rw.flag-trace-env-okp 'term (car x) defs thms atbl)
+             (rw.flag-trace-env-okp 'list (cdr x) defs thms atbl))
+      t)))
+
+(definlined rw.trace-env-okp (x defs thms atbl)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (definition-listp defs)
+                              (rw.trace-okp x defs)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (rw.flag-trace-env-okp 'term x defs thms atbl))
+
+(definlined rw.trace-list-env-okp (x defs thms atbl)
+  (declare (xargs :guard (and (rw.trace-listp x)
+                              (definition-listp defs)
+                              (rw.trace-list-okp x defs)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :measure (two-nats-measure (rank x) 0)))
+  (rw.flag-trace-env-okp 'list x defs thms atbl))
+
+(defthmd definition-of-rw.trace-env-okp
+  (equal (rw.trace-env-okp x defs thms atbl)
+         (and (rw.trace-step-env-okp x defs thms atbl)
+              (rw.trace-list-env-okp (rw.trace->subtraces x) defs thms atbl)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.flag-trace-env-okp
+                                    rw.trace-env-okp
+                                    rw.trace-list-env-okp))))
+
+(defthmd definition-of-rw.trace-list-env-okp
+  (equal (rw.trace-list-env-okp x defs thms atbl)
+         (if (consp x)
+             (and (rw.trace-env-okp (car x) defs thms atbl)
+                  (rw.trace-list-env-okp (cdr x) defs thms atbl))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.flag-trace-env-okp
+                                    rw.trace-env-okp
+                                    rw.trace-list-env-okp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-env-okp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-list-env-okp))))
+
+(defthm rw.trace-list-env-okp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.trace-list-env-okp x defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-list-env-okp))))
+
+(defthm rw.trace-list-env-okp-of-cons
+  (equal (rw.trace-list-env-okp (cons a x) defs thms atbl)
+         (and (rw.trace-env-okp a defs thms atbl)
+              (rw.trace-list-env-okp x defs thms atbl)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-list-env-okp))))
+
+(defthms-flag
+  :thms ((term booleanp-of-rw.trace-env-okp
+                (equal (booleanp (rw.trace-env-okp x defs thms atbl))
+                       t))
+         (t booleanp-of-rw.trace-list-env-okp
+            (equal (booleanp (rw.trace-list-env-okp x defs thms atbl))
+                   t)))
+  :hints (("Goal"
+           :in-theory (enable definition-of-rw.trace-env-okp)
+           :induct (rw.trace-induction flag x))))
+
+(defthm rw.trace-step-env-okp-of-nil
+  (equal (rw.trace-step-env-okp nil defs thms atbl)
+         t)
+  :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+(defthm rw.trace-env-okp-of-nil
+  (equal (rw.trace-env-okp nil defs thms atbl)
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-env-okp))))
+
+(deflist rw.trace-list-env-okp (x defs thms atbl)
+  (rw.trace-env-okp x defs thms atbl)
+  :elementp-of-nil t
+  :already-definedp t)
+
+(defthm rw.trace-step-env-okp-when-rw.trace-env-okp
+  (implies (rw.trace-env-okp x defs thms atbl)
+           (equal (rw.trace-step-env-okp x defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-env-okp))))
+
+(defthm rw.trace-list-env-okp-of-rw.trace->subtraces-when-rw.trace-env-okp
+  (implies (rw.trace-env-okp x defs thms atbl)
+           (equal (rw.trace-list-env-okp (rw.trace->subtraces x) defs thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-env-okp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/tracep.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/tracep.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/tracep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/tracep.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,913 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../assms/hypboxp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm rank-of-cdr-of-lookup-weak
+  ;; BOZO move me to utilities
+  ;; BOZO we don't actually need this anymore.
+  (equal (< (rank map)
+            (rank (cdr (lookup key map))))
+         nil)
+  :hints(("Goal" :induct (cdr-induction map))))
+
+(defthm rank-of-cdr-of-cdr-of-cdr-of-cdr-weak
+  (equal (< (rank x)
+            (rank (cdr (cdr (cdr (cdr x))))))
+         nil))
+
+
+
+;; Essay on rewrite traces.
+;;
+;; When we rewrite x ==> x', we don't just return x'.  Instead, we return a
+;; "trace" of the rewriter's evaluation.
+;;
+;; Each trace is an aggregate:
+;;
+;;   - Method is a symbol that just says what we did,
+;;   - Hypbox stores the assumptions being used (see the rewrite/assms directory),
+;;   - Lhs is the term we rewrote, e.g., x,
+;;   - Rhs is the term we produced, e.g., x',
+;;   - Iffp says if we rewrote w.r.t. iff or equal,
+;;   - Subtraces are recursively a list of traces that we built upon, and
+;;   - Extras are any additional information for this step.
+;;
+;; These traces are often convenient.  Here are a few comments:
+;;
+;;   (1) Traces unify successful rewrites with failures, by always returning a
+;;       single entity, which means the rewriter is simpler and need not ask
+;;       "was the rewriting attempt successful?" and can instead just ask for
+;;       the rhs of the trace.
+;;
+;;   (2) It splits the verification of the rewriter into two independent
+;;       components: building traces and compiling traces.  This makes it much
+;;       easier to change the rewriter, because we just need to show that it
+;;       produces a valid trace.
+;;
+;;   (3) It provides a convenient place to store forced hypotheses.
+;;
+;;   (4) It gives certain efficiencies.  For example, when we are trying to
+;;       apply a rule and some hyp fails, we don't record this effort in the
+;;       trace.  So, when we are compiling the trace, we only build proofs for
+;;       the "useful" steps in our rewriting.  Also, when we do use a rule, we
+;;       can record which rule we have used so that we don't have to try all of
+;;       our rules a second time.  You can look at this as separating search
+;;       from proof construction as Boulton advocated in his dissertation.
+;;
+;; There are a lot of similarities between traces and appeals.  Our generic
+;; trace recognizer, tracep, mirrors the generic appealp recognizer.  We have
+;; step recognizers (fail-tracep, trans-tracep, etc.) that are like the
+;; primitive appeal recognizers (axiom-okp, cut-okp, etc.), and combine these
+;; into our trace-okp function which is similar to proofp.
+
+(defund rw.flag-tracep (flag x)
+  (declare (xargs :guard t
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+  (if (equal flag 'term)
+      ;; We use the following custom cons structure.  We would like to build this
+      ;; with defaggregate, but subtraces need to be mutually recursive.
+      ;;
+      ;;                   .
+      ;;    (method . rhs)                  .
+      ;;                       (lhs . iffp)           .
+      ;;                                       hypbox   (extras . subtraces)
+      ;;
+      ;; This gives 2-link access to method and rhs, which are needed during
+      ;; rewriting, while giving 3 or 4 point access to the other fields which
+      ;; aren't needed as often.
+      (let ((method    (car (car x)))
+            (rhs       (cdr (car x)))
+            (lhs       (car (car (cdr x))))
+            (iffp      (cdr (car (cdr x))))
+            (hypbox    (car (cdr (cdr x))))
+            ;(extras    (car (cdr (cdr (cdr x)))))
+            (subtraces (cdr (cdr (cdr (cdr x))))))
+        (and (symbolp method)
+             (rw.hypboxp hypbox)
+             (logic.termp lhs)
+             (logic.termp rhs)
+             (booleanp iffp)
+             (rw.flag-tracep 'list subtraces)))
+    (if (consp x)
+        (and (rw.flag-tracep 'term (car x))
+             (rw.flag-tracep 'list (cdr x)))
+      t)))
+
+(definlined rw.tracep (x)
+  (declare (xargs :guard t))
+  (rw.flag-tracep 'term x))
+
+(definlined rw.trace-listp (x)
+  (declare (xargs :guard t))
+  (rw.flag-tracep 'list x))
+
+(defthmd definition-of-rw.tracep
+  (equal (rw.tracep x)
+         (let ((method    (car (car x)))
+               (rhs       (cdr (car x)))
+               (lhs       (car (car (cdr x))))
+               (iffp      (cdr (car (cdr x))))
+               (hypbox    (car (cdr (cdr x))))
+               ;(extras    (car (cdr (cdr (cdr x)))))
+               (subtraces (cdr (cdr (cdr (cdr x))))))
+           (and (symbolp method)
+                (rw.hypboxp hypbox)
+                (logic.termp lhs)
+                (logic.termp rhs)
+                (booleanp iffp)
+                (rw.trace-listp subtraces))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.tracep
+                                    rw.trace-listp
+                                    rw.flag-tracep))))
+
+(defthmd definition-of-rw.trace-listp
+  (equal (rw.trace-listp x)
+         (if (consp x)
+             (and (rw.tracep (car x))
+                  (rw.trace-listp (cdr x)))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.tracep
+                                    rw.trace-listp
+                                    rw.flag-tracep))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.tracep))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-listp))))
+
+
+
+(defun rw.raw-trace-induction (flag x)
+  (declare (xargs :verify-guards nil
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+  (if (equal flag 'term)
+      (rw.raw-trace-induction 'list (cdr (cdr (cdr (cdr x)))))
+    (if (consp x)
+        (list (rw.raw-trace-induction 'term (car x))
+              (rw.raw-trace-induction 'list (cdr x)))
+      nil)))
+
+
+(defthm rw.trace-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.trace-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-listp))))
+
+(defthm rw.trace-listp-of-cons
+  (equal (rw.trace-listp (cons a x))
+         (and (rw.tracep a)
+              (rw.trace-listp x)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-listp))))
+
+(defthms-flag
+  :thms ((term booleanp-of-rw.tracep
+               (equal (booleanp (rw.tracep x))
+                      t))
+         (t booleanp-of-rw.trace-listp
+            (equal (booleanp (rw.trace-listp x))
+                   t)))
+  :hints (("Goal"
+           :in-theory (enable definition-of-rw.tracep)
+           :induct (rw.raw-trace-induction flag x))))
+
+(deflist rw.trace-listp (x)
+  (rw.tracep x)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(deflist rw.trace-list-listp (x)
+  (rw.trace-listp x)
+  :elementp-of-nil t)
+
+
+
+(definlined rw.trace->method (x)
+  (declare (xargs :guard (rw.tracep x)
+                  :guard-hints (("Goal" :in-theory (enable definition-of-rw.tracep)))))
+  (car (car x)))
+
+(definlined rw.trace->hypbox (x)
+  (declare (xargs :guard (rw.tracep x)
+                  :guard-hints (("Goal" :in-theory (enable definition-of-rw.tracep)))))
+  (car (cdr (cdr x))))
+
+(definlined rw.trace->lhs (x)
+  (declare (xargs :guard (rw.tracep x)
+                  :guard-hints (("Goal" :in-theory (enable definition-of-rw.tracep)))))
+  (car (car (cdr x))))
+
+(definlined rw.trace->rhs (x)
+  (declare (xargs :guard (rw.tracep x)
+                  :guard-hints (("Goal" :in-theory (enable definition-of-rw.tracep)))))
+  (cdr (car x)))
+
+(definlined rw.trace->iffp (x)
+  (declare (xargs :guard (rw.tracep x)
+                  :guard-hints (("Goal" :in-theory (enable definition-of-rw.tracep)))))
+  (cdr (car (cdr x))))
+
+(definlined rw.trace->subtraces (x)
+  (declare (xargs :guard (rw.tracep x)
+                  :guard-hints (("Goal" :in-theory (enable definition-of-rw.tracep)))))
+  (cdr (cdr (cdr (cdr x)))))
+
+(definlined rw.trace->extras (x)
+  (declare (xargs :guard (rw.tracep x)
+                  :guard-hints (("Goal" :in-theory (enable definition-of-rw.tracep)))))
+  (car (cdr (cdr (cdr x)))))
+
+(defprojection :list (rw.trace-list-iffps x)
+               :element (rw.trace->iffp x)
+               :guard (rw.trace-listp x))
+
+(defprojection :list (rw.trace-list-lhses x)
+               :element (rw.trace->lhs x)
+               :guard (rw.trace-listp x))
+
+(defprojection :list (rw.trace-list-rhses x)
+               :element (rw.trace->rhs x)
+               :guard (rw.trace-listp x))
+
+(defprojection :list (rw.trace-list-hypboxes x)
+               :element (rw.trace->hypbox x)
+               :guard (rw.trace-listp x))
+
+(defprojection :list (rw.trace-list-list-rhses x)
+               :element (rw.trace-list-rhses x)
+               :guard (rw.trace-list-listp x))
+
+
+(definlined rw.trace (method hypbox lhs rhs iffp subtraces extras)
+  (declare (xargs :guard (and (symbolp method)
+                              (rw.hypboxp hypbox)
+                              (logic.termp lhs)
+                              (logic.termp rhs)
+                              (booleanp iffp)
+                              (rw.trace-listp subtraces))))
+  (cons (cons method rhs)
+        (cons (cons lhs iffp)
+              (cons hypbox
+                    (cons extras subtraces)))))
+
+(defthm rw.trace-under-iff
+  (iff (rw.trace method hypbox lhs rhs iffp subtraces extras)
+       t)
+  :hints(("Goal" :in-theory (enable rw.trace))))
+
+(defthm rw.trace->method-of-rw.trace
+  (equal (rw.trace->method (rw.trace method hypbox lhs rhs iffp subtraces extras))
+         method)
+  :hints(("Goal" :in-theory (enable rw.trace rw.trace->method))))
+
+(defthm rw.trace->hypbox-of-rw.trace
+  (equal (rw.trace->hypbox (rw.trace method hypbox lhs rhs iffp subtraces extras))
+         hypbox)
+  :hints(("Goal" :in-theory (enable rw.trace rw.trace->hypbox))))
+
+(defthm rw.trace->lhs-of-rw.trace
+  (equal (rw.trace->lhs (rw.trace method hypbox lhs rhs iffp subtraces extras))
+         lhs)
+  :hints(("Goal" :in-theory (enable rw.trace rw.trace->lhs))))
+
+(defthm rw.trace->rhs-of-rw.trace
+  (equal (rw.trace->rhs (rw.trace method hypbox lhs rhs iffp subtraces extras))
+         rhs)
+  :hints(("Goal" :in-theory (enable rw.trace rw.trace->rhs))))
+
+(defthm rw.trace->iffp-of-rw.trace
+  (equal (rw.trace->iffp (rw.trace method hypbox lhs rhs iffp subtraces extras))
+         iffp)
+  :hints(("Goal" :in-theory (enable rw.trace rw.trace->iffp))))
+
+(defthm rw.trace->subtraces-of-rw.trace
+  (equal (rw.trace->subtraces (rw.trace method hypbox lhs rhs iffp subtraces extras))
+         subtraces)
+  :hints(("Goal" :in-theory (enable rw.trace rw.trace->subtraces))))
+
+(defthm rw.trace->extras-of-rw.trace
+  (equal (rw.trace->extras (rw.trace method hypbox lhs rhs iffp subtraces extras))
+         extras)
+  :hints(("Goal" :in-theory (enable rw.trace rw.trace->extras))))
+
+(defthm forcing-rw.tracep-of-rw.trace
+  (implies (force (and (symbolp method)
+                       (rw.hypboxp hypbox)
+                       (logic.termp lhs)
+                       (logic.termp rhs)
+                       (booleanp iffp)
+                       (rw.trace-listp subtraces)))
+           (equal (rw.tracep (rw.trace method hypbox lhs rhs iffp subtraces extras))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.trace definition-of-rw.tracep))))
+
+(defthm forcing-symbolp-of-rw.trace->method
+  (implies (force (rw.tracep x))
+           (equal (symbolp (rw.trace->method x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.tracep rw.trace->method))))
+
+(defthm forcing-rw.hypboxp-of-rw.trace->hypbox
+  (implies (force (rw.tracep x))
+           (equal (rw.hypboxp (rw.trace->hypbox x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.tracep rw.trace->hypbox))))
+
+(defthm forcing-logic.termp-of-rw.trace->lhs
+  (implies (force (rw.tracep x))
+           (equal (logic.termp (rw.trace->lhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.tracep rw.trace->lhs))))
+
+(defthm forcing-logic.termp-of-rw.trace->rhs
+  (implies (force (rw.tracep x))
+           (equal (logic.termp (rw.trace->rhs x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.tracep rw.trace->rhs))))
+
+(defthm forcing-booleanp-of-rw.trace->iffp
+  (implies (force (rw.tracep x))
+           (equal (booleanp (rw.trace->iffp x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.tracep rw.trace->iffp))))
+
+(defthm forcing-rw.trace-listp-of-rw.trace->subtraces
+  (implies (force (rw.tracep x))
+           (equal (rw.trace-listp (rw.trace->subtraces x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.tracep rw.trace->subtraces))))
+
+(defthm forcing-logic.term-listp-of-rw.trace-list-lhses
+  (implies (force (rw.trace-listp x))
+           (equal (logic.term-listp (rw.trace-list-lhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-listp-of-rw.trace-list-rhses
+  (implies (force (rw.trace-listp x))
+           (equal (logic.term-listp (rw.trace-list-rhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-listp-of-rw.trace-list-list-rhses
+  (implies (force (rw.trace-list-listp x))
+           (equal (logic.term-list-listp (rw.trace-list-list-rhses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-rw.trace-list-list-rhses
+  (equal (cons-listp (rw.trace-list-list-rhses x))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defthm rw.trace->lhs-under-iff
+  (implies (rw.tracep x)
+           (iff (rw.trace->lhs x)
+                t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.tracep rw.trace->lhs))))
+
+(defthm rw.trace->rhs-under-iff
+  (implies (rw.tracep x)
+           (iff (rw.trace->rhs x)
+                t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.tracep rw.trace->rhs))))
+
+
+
+(defthm rank-of-rw.trace->subtraces-weak
+  (equal (< (rank x)
+            (rank (rw.trace->subtraces x)))
+         nil)
+  :hints(("Goal" :in-theory (enable rw.trace->subtraces))))
+
+
+
+
+(defund rw.flag-trace-atblp (flag x atbl)
+  (declare (xargs :guard (and (if (equal flag 'term)
+                                  (rw.tracep x)
+                                (rw.trace-listp x))
+                              (logic.arity-tablep atbl))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+  (if (equal flag 'term)
+      (and (rw.hypbox-atblp (rw.trace->hypbox x) atbl)
+           (logic.term-atblp (rw.trace->lhs x) atbl)
+           (logic.term-atblp (rw.trace->rhs x) atbl)
+           (rw.flag-trace-atblp 'list (rw.trace->subtraces x) atbl))
+    (if (consp x)
+        (and (rw.flag-trace-atblp 'term (car x) atbl)
+             (rw.flag-trace-atblp 'list (cdr x) atbl))
+      t)))
+
+(definlined rw.trace-atblp (x atbl)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (logic.arity-tablep atbl))))
+  (rw.flag-trace-atblp 'term x atbl))
+
+(definlined rw.trace-list-atblp (x atbl)
+  (declare (xargs :guard (and (rw.trace-listp x)
+                              (logic.arity-tablep atbl))))
+  (rw.flag-trace-atblp 'list x atbl))
+
+(defthmd definition-of-rw.trace-atblp
+  (equal (rw.trace-atblp x atbl)
+         (and (rw.hypbox-atblp (rw.trace->hypbox x) atbl)
+              (logic.term-atblp (rw.trace->lhs x) atbl)
+              (logic.term-atblp (rw.trace->rhs x) atbl)
+              (rw.trace-list-atblp (rw.trace->subtraces x) atbl)))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.trace-atblp
+                                    rw.trace-list-atblp
+                                    rw.flag-trace-atblp))))
+
+(defthmd definition-of-rw.trace-list-atblp
+  (equal (rw.trace-list-atblp x atbl)
+         (if (consp x)
+             (and (rw.trace-atblp (car x) atbl)
+                  (rw.trace-list-atblp (cdr x) atbl))
+           t))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable rw.trace-atblp
+                                    rw.trace-list-atblp
+                                    rw.flag-trace-atblp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-atblp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.trace-list-atblp))))
+
+(defthm rw.trace-atblp-of-nil
+  (equal (rw.trace-atblp nil atbl)
+         nil)
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-atblp))))
+
+(defun rw.trace-induction (flag x)
+  (declare (xargs :verify-guards nil
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+  (if (equal flag 'term)
+      (rw.trace-induction 'list (rw.trace->subtraces x))
+    (if (consp x)
+        (list (rw.trace-induction 'term (car x))
+              (rw.trace-induction 'list (cdr x)))
+      nil)))
+
+(defthm rw.trace-list-atblp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.trace-list-atblp x atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-list-atblp))))
+
+(defthm rw.trace-list-atblp-of-cons
+  (equal (rw.trace-list-atblp (cons a x) atbl)
+         (and (rw.trace-atblp a atbl)
+              (rw.trace-list-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-list-atblp))))
+
+(defthms-flag
+  :thms ((term booleanp-of-rw.trace-atblp
+               (equal (booleanp (rw.trace-atblp x atbl))
+                      t))
+         (t booleanp-of-rw.trace-list-atblp
+            (equal (booleanp (rw.trace-list-atblp x atbl))
+                   t)))
+  :hints (("Goal"
+           :in-theory (enable definition-of-rw.trace-atblp)
+           :induct (rw.trace-induction flag x))))
+
+(deflist rw.trace-list-atblp (x atbl)
+  (rw.trace-atblp x atbl)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+(defthm forcing-rw.hypbox-atblp-of-rw.trace->hypbox
+  (implies (force (rw.trace-atblp x atbl))
+           (equal (rw.hypbox-atblp (rw.trace->hypbox x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-atblp))))
+
+(defthm forcing-logic.term-atblp-of-rw.trace->lhs
+  (implies (force (rw.trace-atblp x atbl))
+           (equal (logic.term-atblp (rw.trace->lhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (definition-of-rw.trace-atblp)
+                                 (forcing-rw.hypbox-atblp-of-rw.trace->hypbox)))))
+
+(defthm forcing-logic.term-atblp-of-rw.trace->rhs
+  (implies (force (rw.trace-atblp x atbl))
+           (equal (logic.term-atblp (rw.trace->rhs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (definition-of-rw.trace-atblp)
+                                 (forcing-rw.hypbox-atblp-of-rw.trace->hypbox
+                                  forcing-logic.term-atblp-of-rw.trace->lhs)))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.trace->subtraces
+  (implies (force (rw.trace-atblp x atbl))
+           (equal (rw.trace-list-atblp (rw.trace->subtraces x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (definition-of-rw.trace-atblp)
+                                 (forcing-rw.hypbox-atblp-of-rw.trace->hypbox
+                                  forcing-logic.term-atblp-of-rw.trace->lhs
+                                  forcing-logic.term-atblp-of-rw.trace->rhs)))))
+
+;; no equivalent of this for hypboxes
+;; (defthm forcing-logic.term-list-list-atblp-of-rw.trace-list-assms
+;;   (implies (force (rw.trace-list-atblp x atbl))
+;;            (equal (rw.assms-list-atblp (rw.trace-list-assms x) atbl)
+;;                   t))
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.trace-list-lhses
+  (implies (force (rw.trace-list-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.trace-list-lhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-atblp-of-rw.trace-list-rhses
+  (implies (force (rw.trace-list-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.trace-list-rhses x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.trace-atblp-of-rw.trace
+  (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                       (logic.term-atblp lhs atbl)
+                       (logic.term-atblp rhs atbl)
+                       (rw.trace-list-atblp subtraces atbl)))
+           (equal (rw.trace-atblp (rw.trace method hypbox lhs rhs iffp subtraces extras) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.trace-atblp))))
+
+
+
+
+
+;; Trace Formulas.
+;;
+;; We say each trace represents the goal formula:
+;;
+;;    [hyps ->] (equiv lhs rhs) = t.
+;;
+;; If there are no nhyps, by this we mean:
+;;
+;;    (equiv lhs rhs) = t
+;;
+;; Otherwise, we mean:
+;;
+;;    assms-formula v (equiv lhs rhs) = t
+
+(definlined rw.trace-conclusion-formula (x)
+  ;; Construct (equiv lhs rhs) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (logic.pequal (logic.function (if (rw.trace->iffp x) 'iff 'equal)
+                                (list (rw.trace->lhs x)
+                                      (rw.trace->rhs x)))
+                ''t))
+
+(in-theory (disable (:e rw.trace-conclusion-formula)))
+
+(defthm forcing-logic.formulap-of-rw.trace-conclusion-formula
+  (implies (force (rw.tracep x))
+           (equal (logic.formulap (rw.trace-conclusion-formula x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.trace-conclusion-formula))))
+
+(defthm forcing-logic.formula-atblp-of-rw.trace-conclusion-formula
+  (implies (force (and (rw.trace-atblp x atbl)
+                       (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'equal atbl)) 2)))
+           (equal (logic.formula-atblp (rw.trace-conclusion-formula x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.trace-conclusion-formula))))
+
+
+
+(defprojection
+  :list (rw.trace-list-conclusion-formulas x)
+  :element (rw.trace-conclusion-formula x)
+  :guard (rw.trace-listp x))
+
+(defthm forcing-logic.formula-listp-of-rw.trace-list-conclusion-formulas
+  (implies (force (rw.trace-listp x))
+           (equal (logic.formula-listp (rw.trace-list-conclusion-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-rw.trace-list-conclusion-formulas
+  (implies (force (and (rw.trace-list-atblp x atbl)
+                       (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'equal atbl)) 2)))
+           (equal (logic.formula-list-atblp (rw.trace-list-conclusion-formulas x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(definlined rw.trace-formula (x)
+  ;; Construct [hyps ->] (equiv lhs rhs) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let ((hypbox (rw.trace->hypbox x)))
+    (if (and (not (rw.hypbox->left hypbox))
+             (not (rw.hypbox->right hypbox)))
+        (rw.trace-conclusion-formula x)
+      (logic.por (rw.hypbox-formula hypbox)
+                 (rw.trace-conclusion-formula x)))))
+
+(defthm forcing-logic.formulap-of-rw.trace-formula
+  (implies (force (rw.tracep x))
+           (equal (logic.formulap (rw.trace-formula x))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.trace-formula))))
+
+(defthm forcing-logic.formula-atblp-of-rw.trace-formula
+  (implies (force (and (rw.tracep x)
+                       (rw.trace-atblp x atbl)
+                       (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'equal atbl)) 2)))
+           (equal (logic.formula-atblp (rw.trace-formula x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.trace-formula))))
+
+(defprojection :list (rw.trace-list-formulas x)
+               :element (rw.trace-formula x)
+               :guard (rw.trace-listp x))
+
+(defthm forcing-logic.formula-listp-of-rw.trace-list-formulas
+  (implies (force (rw.trace-listp x))
+           (equal (logic.formula-listp (rw.trace-list-formulas x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.formula-list-atblp-of-rw.trace-list-formulas
+  (implies (force (and (rw.trace-listp x)
+                       (rw.trace-list-atblp x atbl)
+                       (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'equal atbl)) 2)))
+           (equal (logic.formula-list-atblp (rw.trace-list-formulas x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.trace-conclusion-formula
+                           rw.trace-formula)))
+
+ (defthm logic.all-atomicp-of-rw.trace-list-conclusion-formulas
+   (equal (logic.all-atomicp (rw.trace-list-conclusion-formulas x))
+          t)
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm logic.all-atomicp-of-rw.trace-list-conclusion-formulas-free
+   (implies (equal conclusions (rw.trace-list-conclusion-formulas x))
+            (equal (logic.all-atomicp conclusions)
+                   t)))
+
+ (defthm logic.=rhses-of-rw.trace-list-conclusion-formulas
+   (equal (logic.=rhses (rw.trace-list-conclusion-formulas x))
+          (repeat ''t (len x)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm logic.=rhses-of-rw.trace-list-conclusion-formulas-free
+   (implies (equal conclusions (rw.trace-list-conclusion-formulas x))
+            (equal (logic.=rhses conclusions)
+                   (repeat ''t (len x))))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm logic.all-functionsp-of-logic.=lhses-of-rw.trace-list-conclusion-formulas
+   (equal (logic.all-functionsp (logic.=lhses (rw.trace-list-conclusion-formulas x)))
+          t)
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm logic.all-functionsp-of-logic.=lhses-of-rw.trace-list-conclusion-formulas-free
+   (implies (equal conclusions (rw.trace-list-conclusion-formulas x))
+            (equal (logic.all-functionsp (logic.=lhses conclusions))
+                   t)))
+
+ (defthm logic.strip-function-names-of-logic.=lhses-of-rw.trace-list-conclusion-formulas
+   (implies (all-equalp nil (rw.trace-list-iffps x))
+            (equal (logic.strip-function-names (logic.=lhses (rw.trace-list-conclusion-formulas x)))
+                   (repeat 'equal (len x))))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm logic.strip-function-names-of-logic.=lhses-of-rw.trace-list-conclusion-formulas-free
+   (implies (and (all-equalp nil (rw.trace-list-iffps x))
+                 (equal conclusions (rw.trace-list-conclusion-formulas x)))
+            (equal (logic.strip-function-names (logic.=lhses conclusions))
+                   (repeat 'equal (len conclusions)))))
+
+ (defthm strip-lens-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-conclusion-formulas
+   (implies (all-equalp nil (rw.trace-list-iffps x))
+            (equal (strip-lens (logic.strip-function-args (logic.=lhses (rw.trace-list-conclusion-formulas x))))
+                   (repeat 2 (len x))))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm strip-lens-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-conclusion-formulas-free
+   (implies (and (all-equalp nil (rw.trace-list-iffps x))
+                 (equal conclusions (rw.trace-list-conclusion-formulas x)))
+            (equal (strip-lens (logic.strip-function-args (logic.=lhses conclusions)))
+                   (repeat 2 (len conclusions)))))
+
+ (defthm strip-firsts-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-lhses
+   (equal (strip-firsts (logic.strip-function-args (logic.=lhses (rw.trace-list-conclusion-formulas x))))
+          (rw.trace-list-lhses x))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm strip-firsts-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-lhses-free
+   (implies (equal conclusions (rw.trace-list-conclusion-formulas x))
+            (equal (strip-firsts (logic.strip-function-args (logic.=lhses conclusions)))
+                   (rw.trace-list-lhses x))))
+
+ (defthm strip-seconds-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-lhses
+   (equal (strip-seconds (logic.strip-function-args (logic.=lhses (rw.trace-list-conclusion-formulas x))))
+          (rw.trace-list-rhses x))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm strip-seconds-of-logic.strip-function-args-of-logic.=lhses-of-rw.trace-list-lhses-free
+   (implies (equal conclusions (rw.trace-list-conclusion-formulas x))
+            (equal (strip-seconds (logic.strip-function-args (logic.=lhses conclusions)))
+                   (rw.trace-list-rhses x))))
+
+ (local (in-theory (disable forcing-equal-of-logic.por-list-rewrite)))
+
+ (defthm rw.trace-list-formulas-when-all-equalp-of-rw.trace-list-hypboxes
+   (implies (and (all-equalp hypbox (rw.trace-list-hypboxes x))
+                 (force (rw.trace-listp x)))
+            (equal (rw.trace-list-formulas x)
+                   (cond ((not (consp x))
+                          nil)
+                         ((and (not (rw.hypbox->left hypbox))
+                               (not (rw.hypbox->right hypbox)))
+                          (rw.trace-list-conclusion-formulas x))
+                         (t
+                          (logic.por-list
+                           (repeat (rw.hypbox-formula hypbox) (len x))
+                           (rw.trace-list-conclusion-formulas x))))))
+   :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+
+
+(defund rw.faster-flag-tracep (flag x ext-hypbox)
+  (declare (xargs :guard (rw.hypboxp ext-hypbox)
+                  :measure (two-nats-measure (rank x) (if (equal flag 'term) 1 0))))
+
+; This is a fancy, fast tracep check.  We take an "external hypbox" as an extra
+; argument.  Before we check whether our hypbox is a valid hypbox, we check
+; whether it is equal to this external box.  If so, we do not need to check
+; whether it is valid.  Note that when we check our subtraces, we use our own
+; hypbox, not the ext-hypbox.
+;
+; Why is this fast?  In practice, traces other than the "if" traces share the
+; same hypbox.  So most of the time we should be able to say, "Yes, they are
+; the same," by a simple pointer-equality check, and thus avoid the more
+; expensive hypboxp check.  Also note that for "if" traces such as
+; crewrite-if-generalcase, the equality can be settled fairly quickly.  The net
+; result is that putting this in, instead of tracep, in ccstep-listp, led to
+; about a 6x speedup in our ccstep-listp check.
+
+  (if (equal flag 'term)
+      (let* ((method    (car (car x)))
+             (rhs       (cdr (car x)))
+             (lhs       (car (car (cdr x))))
+             (iffp      (cdr (car (cdr x))))
+             (hypbox    (car (cdr (cdr x))))
+             (subtraces (cdr (cdr (cdr (cdr x))))))
+        (and (symbolp method)
+             (or (equal hypbox ext-hypbox)
+                 (rw.faster-hypboxp hypbox))
+             (logic.termp lhs)
+             (logic.termp rhs)
+             (booleanp iffp)
+             (rw.faster-flag-tracep 'list subtraces hypbox)))
+    (if (consp x)
+        (and (rw.faster-flag-tracep 'term (car x) ext-hypbox)
+             (rw.faster-flag-tracep 'list (cdr x) ext-hypbox))
+      t)))
+
+(defund rw.faster-tracep (x ext-hypbox)
+  (declare (xargs :guard (rw.hypboxp ext-hypbox)))
+  (rw.faster-flag-tracep 'term x ext-hypbox))
+
+(defund rw.faster-trace-listp (x ext-hypbox)
+  (declare (xargs :guard (rw.hypboxp ext-hypbox)))
+  (rw.faster-flag-tracep 'list x ext-hypbox))
+
+(defthmd definition-of-rw.faster-tracep
+  (equal (rw.faster-tracep x ext-hypbox)
+         (let* ((method    (car (car x)))
+                (rhs       (cdr (car x)))
+                (lhs       (car (car (cdr x))))
+                (iffp      (cdr (car (cdr x))))
+                (hypbox    (car (cdr (cdr x))))
+                (subtraces (cdr (cdr (cdr (cdr x))))))
+           (and (symbolp method)
+                (or (equal hypbox ext-hypbox)
+                    (rw.faster-hypboxp hypbox))
+                (logic.termp lhs)
+                (logic.termp rhs)
+                (booleanp iffp)
+                (rw.faster-trace-listp subtraces hypbox))))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand (rw.faster-flag-tracep 'term x ext-hypbox)
+          :in-theory (enable rw.faster-tracep rw.faster-trace-listp))))
+
+(defthmd definition-of-rw.faster-trace-listp
+  (equal (rw.faster-trace-listp x ext-hypbox)
+         (if (consp x)
+             (and (rw.faster-tracep (car x) ext-hypbox)
+                  (rw.faster-trace-listp (cdr x) ext-hypbox))
+           t))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand (rw.faster-flag-tracep 'list x ext-hypbox)
+          :in-theory (enable rw.faster-tracep rw.faster-trace-listp))))
+
+(defthm rw.faster-flag-tracep-of-term
+  (equal (rw.faster-flag-tracep 'term x hypbox)
+         (rw.faster-tracep x hypbox))
+  :hints(("Goal" :in-theory (enable rw.faster-tracep))))
+
+(defthm rw.faster-flag-tracep-of-list
+  (equal (rw.faster-flag-tracep 'list x hypbox)
+         (rw.faster-trace-listp x hypbox))
+  :hints(("Goal" :in-theory (enable rw.faster-trace-listp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.faster-tracep))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.faster-trace-listp))))
+
+(defthm rw.faster-trace-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.faster-trace-listp x ext-hypbox)
+                  t))
+  :hints(("Goal" :expand ((rw.faster-trace-listp x ext-hypbox)))))
+
+(defthm rw.faster-trace-listp-of-cons
+  (equal (rw.faster-trace-listp (cons a x) ext-hypbox)
+         (and (rw.faster-tracep a ext-hypbox)
+              (rw.faster-trace-listp x ext-hypbox)))
+  :hints(("Goal"
+          :expand ((rw.faster-trace-listp (cons a x) ext-hypbox)))))
+
+;; (defthm rw.faster-tracep-of-nil
+;;   (equal (rw.faster-tracep nil ext-hypbox)
+;;          nil)
+;;   :hints(("Goal" :expand (rw.faster-tracep nil ext-hypbox))))
+
+;; (deflist rw.faster-trace-listp (x ext-hypbox)
+;;   (rw.faster-tracep x ext-hypbox)
+;;   :elementp-of-nil nil
+;;   :already-definedp t)
+
+(defthms-flag
+  :shared-hyp (force (rw.hypboxp hypbox))
+  :thms ((term rw.faster-tracep-removal
+               (equal (rw.faster-tracep x hypbox)
+                      (rw.tracep x)))
+         (t rw.faster-trace-listp-removal
+            (equal (rw.faster-trace-listp x hypbox)
+                   (rw.trace-listp x))))
+  :hints(("Goal"
+          :induct (rw.faster-flag-tracep flag x hypbox)
+          :in-theory (e/d ((:i rw.faster-flag-tracep))
+                          ((:e acl2::force)))
+          :expand ((rw.faster-tracep x hypbox)
+                   (rw.tracep x)))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/urewrite-builders.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/urewrite-builders.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/urewrite-builders.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/urewrite-builders.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,611 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "basic-builders") ;; for fail-trace
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(local (in-theory (e/d (booleanp-of-rw.trace->iffp)
+                       (forcing-booleanp-of-rw.trace->iffp))))
+
+
+
+(defund rw.urewrite-if-specialcase-same-trace (x y a)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.tracep y)
+                              (logic.termp a)
+                              (not (rw.hypbox->left (rw.trace->hypbox x)))
+                              (not (rw.hypbox->right (rw.trace->hypbox x)))
+                              (not (rw.hypbox->left (rw.trace->hypbox y)))
+                              (not (rw.hypbox->right (rw.trace->hypbox y)))
+                              (equal (rw.trace->iffp x) (rw.trace->iffp y))
+                              (equal (rw.trace->rhs x) (rw.trace->rhs y)))))
+  (rw.trace 'urewrite-if-specialcase-same
+            (rw.trace->hypbox x)
+            (logic.function 'if (list a (rw.trace->lhs x) (rw.trace->lhs y)))
+            (rw.trace->rhs x)
+            (rw.trace->iffp x)
+            (list x y)
+            nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.urewrite-if-specialcase-same-trace)))
+
+ (defthm rw.trace->method-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.trace->method (rw.urewrite-if-specialcase-same-trace x y a))
+          'urewrite-if-specialcase-same))
+
+ (defthm rw.trace->hypbox-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.trace->hypbox (rw.urewrite-if-specialcase-same-trace x y a))
+          (rw.trace->hypbox x)))
+
+ (defthm rw.trace->lhs-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.trace->lhs (rw.urewrite-if-specialcase-same-trace x y a))
+          (logic.function 'if (list a (rw.trace->lhs x) (rw.trace->lhs y)))))
+
+ (defthm rw.trace->rhs-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.trace->rhs (rw.urewrite-if-specialcase-same-trace x y a))
+          (rw.trace->rhs x)))
+
+ (defthm rw.trace->iffp-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.trace->iffp (rw.urewrite-if-specialcase-same-trace x y a))
+          (rw.trace->iffp x)))
+
+ (defthm rw.trace->subtraces-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.trace->subtraces (rw.urewrite-if-specialcase-same-trace x y a))
+          (list x y)))
+
+ (defthm rw.trace->extras-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.trace->extras (rw.urewrite-if-specialcase-same-trace x y a))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.urewrite-if-specialcase-same-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (logic.termp a)))
+            (equal (rw.tracep (rw.urewrite-if-specialcase-same-trace x y a))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.urewrite-if-specialcase-same-trace
+   (implies (force (and (rw.trace-atblp x atbl)
+                        (rw.trace-atblp y atbl)
+                        (logic.term-atblp a atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (rw.trace-atblp (rw.urewrite-if-specialcase-same-trace x y a) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.urewrite-if-specialcase-same-trace)))
+
+ (defthmd lemma-forcing-rw.urewrite-if-specialcase-same-tracep-of-rw.urewrite-if-specialcase-same-trace
+   (implies (force (and (not (rw.hypbox->left (rw.trace->hypbox x)))
+                        (not (rw.hypbox->right (rw.trace->hypbox x)))
+                        (not (rw.hypbox->left (rw.trace->hypbox y)))
+                        (not (rw.hypbox->right (rw.trace->hypbox y)))
+                        (equal (rw.trace->iffp x) (rw.trace->iffp y))
+                        (equal (rw.trace->rhs x) (rw.trace->rhs y))))
+            (equal (rw.urewrite-if-specialcase-same-tracep (rw.urewrite-if-specialcase-same-trace x y a))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.urewrite-if-specialcase-same-tracep))))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.urewrite-if-specialcase-same-trace
+   (implies (force (and (not (rw.hypbox->left (rw.trace->hypbox x)))
+                        (not (rw.hypbox->right (rw.trace->hypbox x)))
+                        (not (rw.hypbox->left (rw.trace->hypbox y)))
+                        (not (rw.hypbox->right (rw.trace->hypbox y)))
+                        (equal (rw.trace->iffp x) (rw.trace->iffp y))
+                        (equal (rw.trace->rhs x) (rw.trace->rhs y))))
+            (equal (rw.trace-step-okp (rw.urewrite-if-specialcase-same-trace x y a) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp
+                                     lemma-forcing-rw.urewrite-if-specialcase-same-tracep-of-rw.urewrite-if-specialcase-same-trace))))
+
+ (defthm forcing-rw.trace-okp-of-rw.urewrite-if-specialcase-same-trace
+   (implies (force (and (not (rw.hypbox->left (rw.trace->hypbox x)))
+                        (not (rw.hypbox->right (rw.trace->hypbox x)))
+                        (not (rw.hypbox->left (rw.trace->hypbox y)))
+                        (not (rw.hypbox->right (rw.trace->hypbox y)))
+                        (equal (rw.trace->iffp x) (rw.trace->iffp y))
+                        (equal (rw.trace->rhs x) (rw.trace->rhs y))
+                        (rw.trace-okp x defs)
+                        (rw.trace-okp y defs)))
+            (equal (rw.trace-okp (rw.urewrite-if-specialcase-same-trace x y a) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.urewrite-if-specialcase-same-trace x y a) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.urewrite-if-specialcase-same-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.trace-step-env-okp (rw.urewrite-if-specialcase-same-trace x y a) defs thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.urewrite-if-specialcase-same-trace
+   (implies (force (and (rw.trace-env-okp x defs thms atbl)
+                        (rw.trace-env-okp y defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.urewrite-if-specialcase-same-trace x y a) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.urewrite-if-specialcase-same-trace x y a) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.urewrite-if-specialcase-same-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.urewrite-if-specialcase-same-trace
+   (equal (rw.collect-forced-goals (rw.urewrite-if-specialcase-same-trace x y a))
+          (fast-merge (rw.collect-forced-goals x)
+                      (rw.collect-forced-goals y)))
+   :hints(("Goal" :expand (rw.collect-forced-goals (rw.urewrite-if-specialcase-same-trace x y a))))))
+
+
+
+
+(defund rw.urewrite-if-generalcase-trace (x y z)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.tracep y)
+                              (rw.tracep z)
+                              (not (rw.hypbox->left (rw.trace->hypbox x)))
+                              (not (rw.hypbox->right (rw.trace->hypbox x)))
+                              (not (rw.hypbox->left (rw.trace->hypbox y)))
+                              (not (rw.hypbox->right (rw.trace->hypbox y)))
+                              (not (rw.hypbox->left (rw.trace->hypbox z)))
+                              (not (rw.hypbox->right (rw.trace->hypbox z)))
+                              (equal (rw.trace->iffp x) t)
+                              (equal (rw.trace->iffp y) (rw.trace->iffp z)))))
+  (let ((a1 (rw.trace->lhs x))
+        (a2 (rw.trace->rhs x))
+        (b1 (rw.trace->lhs y))
+        (b2 (rw.trace->rhs y))
+        (c1 (rw.trace->lhs z))
+        (c2 (rw.trace->rhs z))
+        (iffp (rw.trace->iffp y)))
+    ;(if (and (equal a1 a2)
+    ;         (equal b1 b2)
+    ;         (equal c1 c2))
+    ;    (rw.fail-trace (rw.trace->hypbox x) (logic.function 'if (list a1 b1 c1)) iffp)
+    (rw.trace 'urewrite-if-generalcase
+              (rw.trace->hypbox x)
+              (logic.function 'if (list a1 b1 c1))
+              (logic.function 'if (list a2 b2 c2))
+              iffp
+              (list x y z)
+              nil)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.urewrite-if-generalcase-trace)))
+
+ (defthm rw.trace->method-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.trace->method (rw.urewrite-if-generalcase-trace x y z))
+          'urewrite-if-generalcase))
+
+ (defthm rw.trace->hypbox-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.trace->hypbox (rw.urewrite-if-generalcase-trace x y z))
+          (rw.trace->hypbox x)))
+
+ (defthm rw.trace->lhs-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.trace->lhs (rw.urewrite-if-generalcase-trace x y z))
+          (logic.function 'if (list (rw.trace->lhs x) (rw.trace->lhs y) (rw.trace->lhs z))))
+   :hints(("Goal" :in-theory (disable forcing-true-listp-of-logic.function-args))))
+
+ (defthm rw.trace->rhs-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.trace->rhs (rw.urewrite-if-generalcase-trace x y z))
+          (logic.function 'if (list (rw.trace->rhs x) (rw.trace->rhs y) (rw.trace->rhs z))))
+   :hints(("Goal" :in-theory (disable forcing-true-listp-of-logic.function-args))))
+
+ (defthm rw.trace->iffp-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.trace->iffp (rw.urewrite-if-generalcase-trace x y z))
+          (rw.trace->iffp y)))
+
+ (defthm rw.trace->subtraces-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.trace->subtraces (rw.urewrite-if-generalcase-trace x y z))
+          (list x y z)))
+
+ (defthm rw.trace->extras-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.trace->extras (rw.urewrite-if-generalcase-trace x y z))
+          nil))
+
+ (defthm forcing-rw.tracep-of-rw.urewrite-if-generalcase-trace
+   (implies (force (and (rw.tracep x)
+                        (rw.tracep y)
+                        (rw.tracep z)))
+            (equal (rw.tracep (rw.urewrite-if-generalcase-trace x y z))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.urewrite-if-generalcase-trace
+   (implies (force (and (rw.trace-atblp x atbl)
+                        (rw.trace-atblp y atbl)
+                        (rw.trace-atblp z atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (rw.trace-atblp (rw.urewrite-if-generalcase-trace x y z) atbl)
+                   t)))
+
+ (local (in-theory (disable rw.urewrite-if-generalcase-trace)))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.urewrite-if-generalcase-trace
+   (implies (force (and (not (rw.hypbox->left (rw.trace->hypbox x)))
+                        (not (rw.hypbox->right (rw.trace->hypbox x)))
+                        (not (rw.hypbox->left (rw.trace->hypbox y)))
+                        (not (rw.hypbox->right (rw.trace->hypbox y)))
+                        (not (rw.hypbox->left (rw.trace->hypbox z)))
+                        (not (rw.hypbox->right (rw.trace->hypbox z)))
+                        (equal (rw.trace->iffp x) t)
+                        (equal (rw.trace->iffp y) (rw.trace->iffp z))))
+            (equal (rw.trace-step-okp (rw.urewrite-if-generalcase-trace x y z) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp rw.urewrite-if-generalcase-tracep))))
+
+ (defthm forcing-rw.trace-okp-of-rw.urewrite-if-generalcase-trace
+   (implies (force (and (not (rw.hypbox->left (rw.trace->hypbox x)))
+                        (not (rw.hypbox->right (rw.trace->hypbox x)))
+                        (not (rw.hypbox->left (rw.trace->hypbox y)))
+                        (not (rw.hypbox->right (rw.trace->hypbox y)))
+                        (not (rw.hypbox->left (rw.trace->hypbox z)))
+                        (not (rw.hypbox->right (rw.trace->hypbox z)))
+                        (equal (rw.trace->iffp x) t)
+                        (equal (rw.trace->iffp y) (rw.trace->iffp z))
+                        (rw.trace-okp x defs)
+                        (rw.trace-okp y defs)
+                        (rw.trace-okp z defs)))
+            (equal (rw.trace-okp (rw.urewrite-if-generalcase-trace x y z) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.urewrite-if-generalcase-trace x y z) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.urewrite-if-generalcase-trace))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.trace-step-env-okp (rw.urewrite-if-generalcase-trace x y z) axioms thms atbl)
+          t)
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp rw.urewrite-if-generalcase-tracep))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.urewrite-if-generalcase-trace
+   (implies (force (and (rw.trace-env-okp x defs thms atbl)
+                        (rw.trace-env-okp y defs thms atbl)
+                        (rw.trace-env-okp z defs thms atbl)))
+            (equal (rw.trace-env-okp (rw.urewrite-if-generalcase-trace x y z) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.urewrite-if-generalcase-trace x y z) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.urewrite-if-generalcase-trace))))
+
+ (defthm rw.collect-forced-goals-of-rw.urewrite-if-generalcase-trace
+   (equal (rw.collect-forced-goals (rw.urewrite-if-generalcase-trace x y z))
+          (fast-merge (rw.collect-forced-goals x)
+                      (fast-merge (rw.collect-forced-goals y)
+                                  (rw.collect-forced-goals z))))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.try-urewrite-rule (hypbox term rule iffp control)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.termp term)
+                              (rw.rulep rule)
+                              (booleanp iffp)
+                              (rw.controlp control))))
+  (and
+   ;; The rule must be unconditional
+   (not (rw.rule->hyps rule))
+   ;; The equivalence relation must be acceptable
+   (let ((equiv (rw.rule->equiv rule)))
+     (or (equal equiv 'equal)
+         (and (equal equiv 'iff) iffp)))
+   ;; Note: we ignore esigmas completely for urewrite rules
+   (let ((match-result (logic.patmatch (rw.rule->lhs rule) term nil)))
+     (and
+      ;; We must have a match
+      (not (equal 'fail match-result))
+      ;; The syntactic restrictions must be satisfied.
+      (rw.rule-syntax-okp rule match-result control)
+      ;; Everything's ok; build the trace.
+      (rw.trace 'urewrite-rule
+                hypbox
+                term
+                (logic.substitute (rw.rule->rhs rule) match-result)
+                iffp
+                nil
+                (list rule match-result))))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.try-urewrite-rule)))
+
+ (defthmd lemma-forcing-rw.trace->method-of-rw.try-urewrite-rule
+   (implies (force (rw.try-urewrite-rule hypbox term rule iffp control))
+            (equal (rw.trace->method (rw.try-urewrite-rule hypbox term rule iffp control))
+                   'urewrite-rule)))
+
+ (defthm forcing-rw.trace->hypbox-of-rw.try-urewrite-rule
+   (implies (force (rw.try-urewrite-rule hypbox term rule iffp control))
+            (equal (rw.trace->hypbox (rw.try-urewrite-rule hypbox term rule iffp control))
+                   hypbox)))
+
+ (defthm forcing-rw.trace->lhs-of-rw.try-urewrite-rule
+   (implies (force (rw.try-urewrite-rule hypbox term rule iffp control))
+            (equal (rw.trace->lhs (rw.try-urewrite-rule hypbox term rule iffp control))
+                   term)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.try-urewrite-rule
+   (implies (force (rw.try-urewrite-rule hypbox term rule iffp control))
+            (equal (rw.trace->iffp (rw.try-urewrite-rule hypbox term rule iffp control))
+                   iffp)))
+
+ (defthmd lemma-forcing-rw.trace->subtraces-of-rw.try-urewrite-rule
+   (implies (force (rw.try-urewrite-rule hypbox term rule iffp control))
+            (equal (rw.trace->subtraces (rw.try-urewrite-rule hypbox term rule iffp control))
+                   nil)))
+
+ (defthmd lemma-forcing-rw.trace->extras-of-rw.try-urewrite-rule
+   (implies (force (rw.try-urewrite-rule hypbox term rule iffp control))
+            (equal (rw.trace->extras (rw.try-urewrite-rule hypbox term rule iffp control))
+                   (list rule (logic.patmatch (rw.rule->lhs rule) term nil)))))
+
+ (defthm forcing-rw.tracep-of-rw.try-urewrite-rule
+   (implies (force (and (rw.try-urewrite-rule hypbox term rule iffp control)
+                        (rw.hypboxp hypbox)
+                        (logic.termp term)
+                        (rw.rulep rule)
+                        (booleanp iffp)))
+            (equal (rw.tracep (rw.try-urewrite-rule hypbox term rule iffp control))
+                   t)))
+
+ (defthm forcing-rw.trace-atblp-of-rw.try-urewrite-rule
+   (implies (force (and (rw.try-urewrite-rule hypbox term rule iffp control)
+                        (rw.hypbox-atblp hypbox atbl)
+                        (logic.term-atblp term atbl)
+                        (rw.rule-atblp rule atbl)))
+            (equal (rw.trace-atblp (rw.try-urewrite-rule hypbox term rule iffp control) atbl)
+                   t)))
+
+ (defthmd lemma-forcing-rw.urewrite-rule-tracep-of-rw.try-urewrite-rule
+   (implies (force (and (rw.try-urewrite-rule hypbox term rule iffp control)
+                        (logic.termp term)
+                        (rw.rulep rule)
+                        (rw.controlp control)))
+            (equal (rw.urewrite-rule-tracep (rw.try-urewrite-rule hypbox term rule iffp control))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.urewrite-rule-tracep))))
+
+ (local (in-theory (disable rw.try-urewrite-rule)))
+ (local (in-theory (enable lemma-forcing-rw.trace->method-of-rw.try-urewrite-rule
+                           lemma-forcing-rw.trace->subtraces-of-rw.try-urewrite-rule
+                           lemma-forcing-rw.trace->extras-of-rw.try-urewrite-rule
+                           lemma-forcing-rw.urewrite-rule-tracep-of-rw.try-urewrite-rule)))
+
+ (defthmd lemma-forcing-rw.trace-step-okp-of-rw.try-urewrite-rule
+   (implies (force (and (rw.try-urewrite-rule hypbox term rule iffp control)
+                        (logic.termp term)
+                        (rw.rulep rule)
+                        (rw.controlp control)))
+            (equal (rw.trace-step-okp (rw.try-urewrite-rule hypbox term rule iffp control) defs)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-okp))))
+
+ (defthm forcing-rw.trace-okp-of-rw.try-urewrite-rule
+   (implies (force (and (rw.try-urewrite-rule hypbox term rule iffp control)
+                        (logic.termp term)
+                        (rw.rulep rule)
+                        (rw.controlp control)))
+            (equal (rw.trace-okp (rw.try-urewrite-rule hypbox term rule iffp control) defs)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-okp (rw.try-urewrite-rule hypbox term rule iffp control) defs))
+           :in-theory (enable lemma-forcing-rw.trace-step-okp-of-rw.try-urewrite-rule))))
+
+ (defthmd lemma-forcing-rw.trace-step-env-okp-of-rw.try-urewrite-rule
+   (implies (force (and (rw.try-urewrite-rule hypbox term rule iffp control)
+                        (logic.termp term)
+                        (logic.term-atblp term atbl)
+                        (rw.rulep rule)
+                        (rw.rule-atblp rule atbl)
+                        (rw.rule-env-okp rule thms)
+                        (rw.controlp control)))
+            (equal (rw.trace-step-env-okp (rw.try-urewrite-rule hypbox term rule iffp control) defs thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.trace-step-env-okp rw.urewrite-rule-trace-env-okp))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.try-urewrite-rule
+   (implies (force (and (rw.try-urewrite-rule hypbox term rule iffp control)
+                        (logic.termp term)
+                        (logic.term-atblp term atbl)
+                        (rw.rulep rule)
+                        (rw.rule-atblp rule atbl)
+                        (rw.rule-env-okp rule thms)
+                        (rw.controlp control)))
+            (equal (rw.trace-env-okp (rw.try-urewrite-rule hypbox term rule iffp control) defs thms atbl)
+                   t))
+   :hints(("Goal"
+           :expand ((rw.trace-env-okp (rw.try-urewrite-rule hypbox term rule iffp control) defs thms atbl))
+           :in-theory (enable lemma-forcing-rw.trace-step-env-okp-of-rw.try-urewrite-rule))))
+
+ (defthm forcing-rw.collect-forced-goals-of-rw.try-urewrite-rule
+   (implies (force (rw.try-urewrite-rule hypbox term rule iffp control))
+            (equal (rw.collect-forced-goals (rw.try-urewrite-rule hypbox term rule iffp control))
+                   nil))
+   :hints(("Goal" :in-theory (enable definition-of-rw.collect-forced-goals)))))
+
+
+
+
+(defund rw.try-urewrite-rule-list (hypbox term rules iffp control)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.termp term)
+                              (rw.rule-listp rules)
+                              (booleanp iffp)
+                              (rw.controlp control))))
+  (if (consp rules)
+      (or (rw.try-urewrite-rule hypbox term (car rules) iffp control)
+          (rw.try-urewrite-rule-list hypbox term (cdr rules) iffp control))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.try-urewrite-rule-list)))
+
+ (defthm forcing-rw.trace->lhs-of-rw.try-urewrite-rule-list
+   (implies (force (rw.try-urewrite-rule-list hypbox term rules iffp control))
+            (equal (rw.trace->lhs (rw.try-urewrite-rule-list hypbox term rules iffp control))
+                   term)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.try-urewrite-rule-list
+   (implies (force (rw.try-urewrite-rule-list hypbox term rules iffp control))
+            (equal (rw.trace->iffp (rw.try-urewrite-rule-list hypbox term rules iffp control))
+                   iffp)))
+
+ (defthm forcing-rw.trace->hypbox-of-rw.try-urewrite-rule-list
+   (implies (force (rw.try-urewrite-rule-list hypbox term rules iffp control))
+            (equal (rw.trace->hypbox (rw.try-urewrite-rule-list hypbox term rules iffp control))
+                   hypbox)))
+
+ (defthm forcing-rw.tracep-of-rw.try-urewrite-rule-list
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.termp term)
+                        (rw.rule-listp rules)
+                        (booleanp iffp)))
+            (equal (rw.tracep (rw.try-urewrite-rule-list hypbox term rules iffp control))
+                   (if (rw.try-urewrite-rule-list hypbox term rules iffp control)
+                       t
+                     nil))))
+
+ (defthm forcing-rw.trace-atblp-of-rw.try-urewrite-rule-list
+   (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                        (logic.term-atblp term atbl)
+                        (rw.rule-list-atblp rules atbl)))
+            (equal (rw.trace-atblp (rw.try-urewrite-rule-list hypbox term rules iffp control) atbl)
+                   (if (rw.try-urewrite-rule-list hypbox term rules iffp control)
+                       t
+                     nil))))
+
+ (defthm forcing-rw.trace-okp-of-rw.try-urewrite-rule-list
+   (implies (force (and (logic.termp term)
+                        (rw.rule-listp rules)
+                        (rw.controlp control)))
+            (equal (rw.trace-okp (rw.try-urewrite-rule-list hypbox term rules iffp control) defs)
+                   (if (rw.try-urewrite-rule-list hypbox term rules iffp control)
+                       t
+                     nil))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.try-urewrite-rule-list
+   (implies (force (and (logic.termp term)
+                        (logic.term-atblp term atbl)
+                        (rw.rule-listp rules)
+                        (rw.rule-list-atblp rules atbl)
+                        (rw.rule-list-env-okp rules thms)
+                        (rw.controlp control)))
+            (equal (rw.trace-env-okp (rw.try-urewrite-rule-list hypbox term rules iffp control) defs thms atbl)
+                   t)))
+
+ (defthm forcing-rw.collect-forced-goals-of-rw.try-urewrite-rule-list
+   (implies (force (rw.try-urewrite-rule-list hypbox term rules iffp control))
+            (equal (rw.collect-forced-goals (rw.try-urewrite-rule-list hypbox term rules iffp control))
+                   nil))))
+
+
+
+(defund rw.try-urewrite-rules (hypbox term type iffp control)
+  (declare (xargs :guard (and (rw.hypboxp hypbox)
+                              (logic.termp term)
+                              (or (equal type 'inside)
+                                  (equal type 'outside))
+                              (booleanp iffp)
+                              (rw.controlp control))))
+  (let* ((rulemap (rw.theory-lookup term (rw.control->theory control)))
+         (rules   (cdr (lookup type rulemap))))
+    (rw.try-urewrite-rule-list hypbox term rules iffp control)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.try-urewrite-rules)))
+
+ (defthm forcing-rw.trace->lhs-of-rw.try-urewrite-rules
+   (implies (force (rw.try-urewrite-rules hypbox term type iffp control))
+            (equal (rw.trace->lhs (rw.try-urewrite-rules hypbox term type iffp control))
+                   term)))
+
+ (defthm forcing-rw.trace->iffp-of-rw.try-urewrite-rules
+   (implies (force (rw.try-urewrite-rules hypbox term type iffp control))
+            (equal (rw.trace->iffp (rw.try-urewrite-rules hypbox term type iffp control))
+                   iffp)))
+
+ (defthm forcing-rw.trace->hypbox-of-rw.try-urewrite-rules
+   (implies (force (rw.try-urewrite-rules hypbox term type iffp control))
+            (equal (rw.trace->hypbox (rw.try-urewrite-rules hypbox term type iffp control))
+                   hypbox)))
+
+ (defthm forcing-rw.tracep-of-rw.try-urewrite-rules
+   (implies (force (and (rw.hypboxp hypbox)
+                        (logic.termp term)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.tracep (rw.try-urewrite-rules hypbox term type iffp control))
+                   (if (rw.try-urewrite-rules hypbox term type iffp control)
+                       t
+                     nil))))
+
+ (defthm forcing-rw.trace-atblp-of-rw.try-urewrite-rules
+   (implies (force (and (rw.hypbox-atblp hypbox atbl)
+                        (logic.term-atblp term atbl)
+                        (rw.controlp control)
+                        (rw.control-atblp control atbl)))
+            (equal (rw.trace-atblp (rw.try-urewrite-rules hypbox term type iffp control) atbl)
+                   (if (rw.try-urewrite-rules hypbox term type iffp control)
+                       t
+                     nil))))
+
+ (defthm forcing-rw.trace-okp-of-rw.try-urewrite-rules
+   (implies (force (and (logic.termp term)
+                        (rw.controlp control)))
+            (equal (rw.trace-okp (rw.try-urewrite-rules hypbox term type iffp control) defs)
+                   (if (rw.try-urewrite-rules hypbox term type iffp control)
+                       t
+                     nil))))
+
+ (defthm forcing-rw.trace-env-okp-of-rw.try-urewrite-rules
+   (implies (force (and (logic.termp term)
+                        (logic.term-atblp term atbl)
+                        (rw.controlp control)
+                        (rw.control-atblp control atbl)
+                        (rw.control-env-okp control axioms thms)))
+            (equal (rw.trace-env-okp (rw.try-urewrite-rules hypbox term type iffp control) defs thms atbl)
+                   t)))
+
+ (defthm forcing-rw.collect-forced-goals-of-rw.try-urewrite-rules
+   (implies (force (rw.try-urewrite-rules hypbox term type iffp control))
+            (equal (rw.collect-forced-goals (rw.try-urewrite-rules hypbox term type iffp control))
+                   nil))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/urewrite-compilers.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/urewrite-compilers.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/urewrite-compilers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/urewrite-compilers.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,258 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "trace-okp")
+(include-book "urewrite-if-lemmas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(local (in-theory (enable rw.trace-conclusion-formula rw.trace-formula)))
+
+
+(defund rw.compile-urewrite-if-specialcase-same-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.urewrite-if-specialcase-same-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((lhs (rw.trace->lhs x))   ;; (if a b c)
+         (a   (first (logic.function-args lhs)))
+         ;; This is sort of goofy.  Basically, our builder function is set up to handle assumptions
+         ;; for the conditional rewriter.  But we don't use assumptions, so we need to fake having an
+         ;; assumption about the condition.
+         (test-proof (build.iff-reflexivity a))
+         (then-proof (build.expansion (logic.pnot (logic.pequal (logic.function 'not (list a)) ''nil))
+                                      (first proofs)))
+         (else-proof (build.expansion (logic.pnot (logic.pequal a ''nil))
+                                      (second proofs))))
+    (if (rw.trace->iffp x)
+        (rw.iff-of-if-x-y-y-bldr test-proof then-proof else-proof)
+      (rw.equal-of-if-x-y-y-bldr test-proof then-proof else-proof))))
+
+(defobligations rw.compile-urewrite-if-specialcase-same-trace
+  (build.iff-reflexivity
+   build.expansion
+   rw.iff-of-if-x-y-y-bldr
+   rw.equal-of-if-x-y-y-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.urewrite-if-specialcase-same-tracep rw.compile-urewrite-if-specialcase-same-trace)))
+
+ (verify-guards rw.compile-urewrite-if-specialcase-same-trace)
+
+ (defthm rw.compile-urewrite-if-specialcase-same-trace-under-iff
+   (iff (rw.compile-urewrite-if-specialcase-same-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-urewrite-if-specialcase-same-trace
+   (implies (force (and (rw.urewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-urewrite-if-specialcase-same-trace x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-urewrite-if-specialcase-same-trace
+   (implies (force (and (rw.urewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-urewrite-if-specialcase-same-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-urewrite-if-specialcase-same-trace
+   (implies (force (and (rw.urewrite-if-specialcase-same-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.compile-urewrite-if-specialcase-same-trace)))
+            (equal (logic.proofp (rw.compile-urewrite-if-specialcase-same-trace x proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund rw.compile-urewrite-if-generalcase-trace (x proofs)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.urewrite-if-generalcase-tracep x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x))))
+                  :verify-guards nil))
+  (let* ((rhs        (rw.trace->rhs x))  ;; (if a2 b2 c2)
+         (a2         (first (logic.function-args rhs)))
+         (test-proof (first proofs))
+         (then-proof (build.expansion (logic.pnot (logic.pequal (logic.function 'not (list a2)) ''nil))
+                                      (second proofs)))
+         (else-proof (build.expansion (logic.pnot (logic.pequal a2 ''nil))
+                                      (third proofs))))
+    (if (rw.trace->iffp x)
+        (rw.iff-implies-iff-if-bldr test-proof then-proof else-proof)
+      (rw.iff-implies-equal-if-bldr test-proof then-proof else-proof))))
+
+(defobligations rw.compile-urewrite-if-generalcase-trace
+  (build.expansion
+   rw.iff-implies-iff-if-bldr
+   rw.iff-implies-equal-if-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.urewrite-if-generalcase-tracep rw.compile-urewrite-if-generalcase-trace)))
+
+ (verify-guards rw.compile-urewrite-if-generalcase-trace)
+
+ (defthm rw.compile-urewrite-if-generalcase-trace-under-iff
+   (iff (rw.compile-urewrite-if-generalcase-trace x proofs)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm logic.appealp-of-rw.compile-urewrite-if-generalcase-trace
+   (implies (force (and (rw.urewrite-if-generalcase-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.appealp (rw.compile-urewrite-if-generalcase-trace x proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.compile-urewrite-if-generalcase-trace
+   (implies (force (and (rw.urewrite-if-generalcase-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))))
+            (equal (logic.conclusion (rw.compile-urewrite-if-generalcase-trace x proofs))
+                   (rw.trace-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ logic.proofp-of-rw.compile-urewrite-if-generalcase-trace
+   (implies (force (and (rw.urewrite-if-generalcase-tracep x)
+                        (rw.tracep x)
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (rw.trace-list-formulas (rw.trace->subtraces x)))
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.compile-urewrite-if-generalcase-trace)))
+            (equal (logic.proofp (rw.compile-urewrite-if-generalcase-trace x proofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund@ rw.compile-urewrite-rule-trace (x)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.urewrite-rule-tracep x))
+                  :verify-guards nil))
+  (let* ((hypbox (rw.trace->hypbox x))
+         (iffp   (rw.trace->iffp x))
+         (extras (rw.trace->extras x))
+         (rule   (first extras))
+         (sigma  (second extras)))
+    (let ((main-proof
+           (cond ((and iffp (equal (rw.rule->equiv rule) 'equal))
+                  ;; The rule uses equal, but we just want iff.
+                  (@derive ((!= (equal rule-lhs rule-rhs) nil)  (build.theorem (clause.clause-formula (rw.rule-clause rule))))
+                           ((= (equal rule-lhs rule-rhs) t)     (build.equal-t-from-not-nil @-))
+                           ((= (equal lhs rhs) t)               (build.instantiation @- sigma))
+                           ((= (iff lhs rhs) t)                 (build.iff-from-equal @-))))
+                 (iffp
+                  ;; The rule uses iff and we want iff.
+                  (@derive ((!= (iff rule-lhs rule-rhs) nil)    (build.theorem (clause.clause-formula (rw.rule-clause rule))))
+                           ((= (iff rule-lhs rule-rhs) t)       (build.iff-t-from-not-nil @-))
+                           ((= (iff lhs rhs) t)                 (build.instantiation @- sigma))))
+                 (t
+                  ;; The rule uses equal and we want equal.
+                  (@derive ((!= (equal rule-lhs rule-rhs) nil)  (build.theorem (clause.clause-formula (rw.rule-clause rule))))
+                           ((= (equal rule-lhs rule-rhs) t)     (build.equal-t-from-not-nil @-))
+                           ((= (equal lhs rhs) t)               (build.instantiation @- sigma)))))))
+      (if (and (not (rw.hypbox->left hypbox))
+               (not (rw.hypbox->right hypbox)))
+          main-proof
+        (build.expansion (rw.hypbox-formula hypbox) main-proof)))))
+
+(defobligations rw.compile-urewrite-rule-trace
+  (build.expansion
+   build.instantiation
+   build.iff-from-equal
+   build.equal-t-from-not-nil
+   build.iff-t-from-not-nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable logic.term-formula
+                           rw.rule-env-okp
+                           rw.urewrite-rule-tracep
+                           rw.urewrite-rule-trace-env-okp
+                           rw.compile-urewrite-rule-trace)))
+
+ (verify-guards rw.compile-urewrite-rule-trace)
+
+ (defthm rw.compile-urewrite-rule-trace-under-iff
+   (iff (rw.compile-urewrite-rule-trace x)
+        t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm forcing-logic.appealp-of-rw.compile-urewrite-rule-trace
+   (implies (force (and (rw.urewrite-rule-tracep x)
+                        (rw.tracep x)))
+            (equal (logic.appealp (rw.compile-urewrite-rule-trace x))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.compile-urewrite-rule-trace
+   (implies (force (and (rw.urewrite-rule-tracep x)
+                        (rw.tracep x)))
+            (equal (logic.conclusion (rw.compile-urewrite-rule-trace x))
+                   (rw.trace-formula x))))
+
+ (defthm@ forcing-logic.proofp-of-rw.compile-urewrite-rule-trace
+   (implies (force (and (rw.urewrite-rule-trace-env-okp x thms atbl)
+                        (rw.urewrite-rule-tracep x)
+                        (rw.tracep x)
+                        ;; ---
+                        (rw.trace-atblp x atbl)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations rw.compile-urewrite-rule-trace)))
+            (equal (logic.proofp (rw.compile-urewrite-rule-trace x) axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/urewrite-if-lemmas.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/urewrite-if-lemmas.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/urewrite-if-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/urewrite-if-lemmas.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,126 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "if-lemmas")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(dd.open "urewrite-trace-if-lemmas.tex")
+
+
+(defderiv rw.iff-implies-equal-if-bldr
+  :derive (= (equal (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t)
+  :from   ((proof x (= (iff (? a1) (? a2)) t))
+           (proof y (v (!= (not (? a2)) nil) (= (equal (? b1) (? b2)) t)))
+           (proof z (v (!= (? a2) nil) (= (equal (? c1) (? c2)) t))))
+  :proof  (@derive
+           ((= (iff (? a1) (? a2)) t)                                                       (@given x) *1)
+           ((v (!= (not (? a2)) nil) (= (equal (? b1) (? b2)) t))                           (@given y) *2)
+           ((v (!= (? a2) nil) (= (equal (? c1) (? c2)) t))                                 (@given z) *3)
+           ((v (!= (iff x1 x2) t)
+              (v (! (v (!= (not x2) nil) (= (equal y1 y2) t)))
+                 (v (! (v (!= x2 nil) (= (equal z1 z2) t)))
+                    (= (equal (if x1 y1 z1) (if x2 y2 z2)) t))))                            (build.theorem (rw.theorem-iff-implies-equal-if-combined)))
+           ((v (!= (iff (? a1) (? a2)) t)
+               (v (! (v (!= (not (? a2)) nil) (= (equal (? b1) (? b2)) t)))
+                  (v (! (v (!= (? a2) nil) (= (equal (? c1) (? c2)) t)))
+                     (= (equal (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t))))   (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y1 . (? b1)) (y2 . (? b2)) (z1 . (? c1)) (z2 . (? c2)))))
+           ((= (equal (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t)               (rw.three-modus-ponens *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+(defderiv rw.iff-implies-iff-if-bldr
+  :derive (= (iff (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t)
+  :from   ((proof x (= (iff (? a1) (? a2)) t))
+           (proof y (v (!= (not (? a2)) nil) (= (iff (? b1) (? b2)) t)))
+           (proof z (v (!= (? a2) nil) (= (iff (? c1) (? c2)) t))))
+  :proof  (@derive
+           ((= (iff (? a1) (? a2)) t)                                                    (@given x) *1)
+           ((v (!= (not (? a2)) nil) (= (iff (? b1) (? b2)) t))                          (@given y) *2)
+           ((v (!= (? a2) nil) (= (iff (? c1) (? c2)) t))                                (@given z) *3)
+           ((v (!= (iff x1 x2) t)
+               (v (! (v (!= (not x2) nil) (= (iff y1 y2) t)))
+                  (v (! (v (!= x2 nil) (= (iff z1 z2) t)))
+                     (= (iff (if x1 y1 z1) (if x2 y2 z2)) t))))                          (build.theorem (rw.theorem-iff-implies-iff-if-combined)))
+           ((v (!= (iff (? a1) (? a2)) t)
+               (v (! (v (!= (not (? a2)) nil) (= (iff (? b1) (? b2)) t)))
+                  (v (! (v (!= (? a2) nil) (= (iff (? c1) (? c2)) t)))
+                     (= (iff (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t))))  (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y1 . (? b1)) (y2 . (? b2)) (z1 . (? c1)) (z2 . (? c2)))))
+           ((= (iff (if (? a1) (? b1) (? c1)) (if (? a2) (? b2) (? c2))) t)              (rw.three-modus-ponens *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+(defderiv rw.equal-of-if-x-y-y-bldr
+  :derive (= (equal (if (? a1) (? b) (? c)) (? d)) t)
+  :from   ((proof x (= (iff (? a1) (? a2)) t))
+           (proof y (v (!= (not (? a2)) nil) (= (equal (? b) (? d)) t)))
+           (proof z (v (!= (? a2) nil) (= (equal (? c) (? d)) t))))
+  :proof  (@derive
+           ((= (iff (? a1) (? a2)) t)                                          (@given x) *1)
+           ((v (!= (not (? a2)) nil) (= (equal (? b) (? d)) t))                (@given y) *2)
+           ((v (!= (? a2) nil) (= (equal (? c) (? d)) t))                      (@given z) *3)
+           ((v (!= (iff x1 x2) t)
+                (v (! (v (!= (not x2) nil) (= (equal y w) t)))
+                   (v (! (v (!= x2 nil) (= (equal z w) t)))
+                      (= (equal (if x1 y z) w) t))))                           (build.theorem (rw.theorem-equal-of-if-x-y-y)))
+           ((v (!= (iff (? a1) (? a2)) t)
+               (v (! (v (!= (not (? a2)) nil) (= (equal (? b) (? d)) t)))
+                  (v (! (v (!= (? a2) nil) (= (equal (? c) (? d)) t)))
+                     (= (equal (if (? a1) (? b) (? c)) (? d)) t))))            (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y . (? b)) (z . (? c)) (w . (? d)))))
+           ((= (equal (if (? a1) (? b) (? c)) (? d)) t)                        (rw.three-modus-ponens *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+(defderiv rw.iff-of-if-x-y-y-bldr
+  :derive (= (iff (if (? a1) (? b) (? c)) (? d)) t)
+  :from   ((proof x (= (iff (? a1) (? a2)) t))
+           (proof y (v (!= (not (? a2)) nil) (= (iff (? b) (? d)) t)))
+           (proof z (v (!= (? a2) nil) (= (iff (? c) (? d)) t))))
+  :proof  (@derive
+           ((= (iff (? a1) (? a2)) t)                                      (@given x) *1)
+           ((v (!= (not (? a2)) nil) (= (iff (? b) (? d)) t))              (@given y) *2)
+           ((v (!= (? a2) nil) (= (iff (? c) (? d)) t))                    (@given z) *3)
+           ((v (!= (iff x1 x2) t)
+             (v (! (v (!= (not x2) nil) (= (iff y w) t)))
+                (v (! (v (!= x2 nil) (= (iff z w) t)))
+                   (= (iff (if x1 y z) w) t))))                            (build.theorem (rw.theorem-iff-of-if-x-y-y)))
+           ((v (!= (iff (? a1) (? a2)) t)
+               (v (! (v (!= (not (? a2)) nil) (= (iff (? b) (? d)) t)))
+                  (v (! (v (!= (? a2) nil) (= (iff (? c) (? d)) t)))
+                     (= (iff (if (? a1) (? b) (? c)) (? d)) t))))          (build.instantiation @- (@sigma (x1 . (? a1)) (x2 . (? a2)) (y . (? b)) (z . (? c)) (w . (? d)))))
+           ((= (iff (if (? a1) (? b) (? c)) (? d)) t)                      (rw.three-modus-ponens *1 *2 *3 @-)))
+  :minatbl ((if . 3)))
+
+
+(dd.close)
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/traces/urewrite-recognizers.lisp acl2-6.3/books/milawa/ACL2/rewrite/traces/urewrite-recognizers.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/traces/urewrite-recognizers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/traces/urewrite-recognizers.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,184 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tracep")
+(include-book "../rulep")
+(include-book "../../defderiv/defderiv")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+(defund@ rw.urewrite-if-specialcase-same-tracep (x)
+  ;;   (equiv b d) = t
+  ;;   (equiv c d) = t
+  ;; ----------------------------
+  ;;   (equiv (if a b c) d) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (hypbox    (rw.trace->hypbox x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'urewrite-if-specialcase-same)
+         (equal (len subtraces) 2)
+         (not (rw.hypbox->left hypbox))
+         (not (rw.hypbox->right hypbox))
+         (not (rw.hypbox->left (rw.trace->hypbox (first subtraces))))
+         (not (rw.hypbox->right (rw.trace->hypbox (first subtraces))))
+         (not (rw.hypbox->left (rw.trace->hypbox (second subtraces))))
+         (not (rw.hypbox->right (rw.trace->hypbox (second subtraces))))
+         (equal (rw.trace->iffp (first subtraces)) iffp)
+         (equal (rw.trace->iffp (second subtraces)) iffp)
+         (@match (term (rw.trace->lhs (first subtraces)) (? b))
+                 (term (rw.trace->rhs (first subtraces)) (? d))
+                 (term (rw.trace->lhs (second subtraces)) (? c))
+                 (term (rw.trace->rhs (second subtraces)) (? d))
+                 (term lhs (if (? a) (? b) (? c)))
+                 (term rhs (? d)))
+         (not extras))))
+
+(defthm booleanp-of-rw.urewrite-if-specialcase-same-tracep
+  (equal (booleanp (rw.urewrite-if-specialcase-same-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.urewrite-if-specialcase-same-tracep)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+
+(defund@ rw.urewrite-if-generalcase-tracep (x)
+  ;;   (iff a1 a2) = t
+  ;;   (equiv b1 b2) = t
+  ;;   (equiv c1 c2) = t
+  ;; -------------------------------------------
+  ;;   (equiv (if a1 b1 c1) (if a2 b2 c2)) = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (hypbox     (rw.trace->hypbox x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'urewrite-if-generalcase)
+         (equal (len subtraces) 3)
+         (not (rw.hypbox->left hypbox))
+         (not (rw.hypbox->right hypbox))
+         (not (rw.hypbox->left (rw.trace->hypbox (first subtraces))))
+         (not (rw.hypbox->right (rw.trace->hypbox (first subtraces))))
+         (not (rw.hypbox->left (rw.trace->hypbox (second subtraces))))
+         (not (rw.hypbox->right (rw.trace->hypbox (second subtraces))))
+         (not (rw.hypbox->left (rw.trace->hypbox (third subtraces))))
+         (not (rw.hypbox->right (rw.trace->hypbox (third subtraces))))
+         (equal (rw.trace->iffp (first subtraces)) t)
+         (equal (rw.trace->iffp (second subtraces)) iffp)
+         (equal (rw.trace->iffp (third subtraces)) iffp)
+         (@match (term (rw.trace->lhs (first subtraces)) (? a1))
+                 (term (rw.trace->rhs (first subtraces)) (? a2))
+                 (term (rw.trace->lhs (second subtraces)) (? b1))
+                 (term (rw.trace->rhs (second subtraces)) (? b2))
+                 (term (rw.trace->lhs (third subtraces)) (? c1))
+                 (term (rw.trace->rhs (third subtraces)) (? c2))
+                 (term lhs (if (? a1) (? b1) (? c1)))
+                 (term rhs (if (? a2) (? b2) (? c2))))
+         (not extras))))
+
+(defthm booleanp-of-rw.urewrite-if-generalcase-tracep
+  (equal (booleanp (rw.urewrite-if-generalcase-tracep x))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.urewrite-if-generalcase-tracep)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund rw.urewrite-rule-tracep (x)
+  ;;
+  ;; ------------------------------   via some unconditional rewrite rule
+  ;;   [hyps ->] (equiv x x') = t
+  (declare (xargs :guard (rw.tracep x)))
+  (let* ((method    (rw.trace->method x))
+         (lhs       (rw.trace->lhs x))
+         (rhs       (rw.trace->rhs x))
+         (iffp      (rw.trace->iffp x))
+         (subtraces (rw.trace->subtraces x))
+         (extras    (rw.trace->extras x)))
+    (and (equal method 'urewrite-rule)
+         (tuplep 2 extras)
+         (let ((rule      (first extras))
+               (sigma     (second extras)))
+           (and (rw.rulep rule)
+                (logic.sigmap sigma)
+                (not (rw.rule->hyps rule))
+                (let ((equiv (rw.rule->equiv rule)))
+                  (or (equal equiv 'equal)
+                      (and (equal equiv 'iff) iffp)))
+                (let ((match-result (logic.patmatch (rw.rule->lhs rule) lhs nil)))
+                  (and (not (equal 'fail match-result))
+                       (submapp match-result sigma)
+                       (equal (logic.substitute (rw.rule->rhs rule) sigma) rhs)))
+                (not subtraces))))))
+
+(defthm booleanp-of-rw.urewrite-rule-tracep
+  (equal (booleanp (rw.urewrite-rule-tracep x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.urewrite-rule-tracep))))
+
+
+
+(defund rw.urewrite-rule-trace-env-okp (x thms atbl)
+  (declare (xargs :guard (and (rw.tracep x)
+                              (rw.urewrite-rule-tracep x)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable rw.urewrite-rule-tracep)))))
+  (let* ((extras (rw.trace->extras x))
+         (rule   (first extras))
+         (sigma  (second extras)))
+    (and (rw.rule-atblp rule atbl)
+         (rw.rule-env-okp rule thms)
+         (logic.sigma-atblp sigma atbl)
+         )))
+
+(defthm booleanp-of-rw.urewrite-rule-trace-env-okp
+  (equal (booleanp (rw.urewrite-rule-trace-env-okp x thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable rw.urewrite-rule-trace-env-okp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/urewrite-clause.lisp acl2-6.3/books/milawa/ACL2/rewrite/urewrite-clause.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/urewrite-clause.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/urewrite-clause.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,183 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "urewrite")
+(include-book "traces/trace-compiler")
+(include-book "../clauses/update-clause-iff-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+(defund rw.urewrite-clause-bldr (x control n traces proof)
+  ;; Suppose x is a clause, [T1...Tn], which rewrites to [T1'...Tn'].
+  ;; Suppose proof is a proof of T1' v ... v Tn'.
+  ;; We prove T1 v ... v Tn.
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x)
+                              (rw.controlp control)
+                              (natp n)
+                              (equal traces (rw.urewrite-list x t control n))
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (clause.clause-formula (rw.trace-list-rhses traces)))))
+           (ignore x n))
+  (clause.update-clause-iff-bldr (rw.trace-list-rhses traces)
+                                 proof
+                                 ;; We know that urewrite generates no forced goals, so we can use nil as
+                                 ;; our fproofs.
+                                 (rw.compile-trace-list traces (rw.control->defs control) nil)))
+
+(defobligations rw.urewrite-clause-bldr
+  (rw.compile-trace-list
+   clause.update-clause-iff-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.urewrite-clause-bldr)))
+
+ (defthm forcing-logic.appealp-of-rw.urewrite-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (rw.controlp control)
+                        (equal traces (rw.urewrite-list x t control n))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (clause.clause-formula (rw.trace-list-rhses traces)))))
+            (equal (logic.appealp (rw.urewrite-clause-bldr x control n traces proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-rw.urewrite-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (rw.controlp control)
+                        (equal traces (rw.urewrite-list x t control n))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (clause.clause-formula (rw.trace-list-rhses traces)))))
+            (equal (logic.conclusion (rw.urewrite-clause-bldr x control n traces proof))
+                   (clause.clause-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-rw.urewrite-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (consp x)
+                        (rw.controlp control)
+                        (equal traces (rw.urewrite-list x t control n))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (clause.clause-formula (rw.trace-list-rhses traces)))
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (rw.control-atblp control atbl)
+                        (rw.control-env-okp control axioms thms)
+                        (logic.proofp proof axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.urewrite-clause-bldr)
+                        ))
+            (equal (logic.proofp (rw.urewrite-clause-bldr x control n traces proof) axioms thms atbl)
+                   t))))
+
+
+
+(defund rw.urewrite-clause-list-bldr (x control n traces proofs)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x)
+                              (rw.controlp control)
+                              (natp n)
+                              (equal traces (rw.urewrite-list-list x t control n))
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (rw.trace-list-list-rhses traces))))))
+  (if (consp x)
+      (cons (rw.urewrite-clause-bldr (car x) control n (car traces) (car proofs))
+            (rw.urewrite-clause-list-bldr (cdr x) control n (cdr traces) (cdr proofs)))
+    nil))
+
+(defobligations rw.urewrite-clause-list-bldr
+  (rw.urewrite-clause-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.urewrite-clause-list-bldr)))
+
+ (defthm forcing-logic.appeal-listp-of-rw.urewrite-clause-list-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (rw.controlp control)
+                        (equal traces (rw.urewrite-list-list x t control n))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (rw.trace-list-list-rhses traces)))))
+            (equal (logic.appeal-listp (rw.urewrite-clause-list-bldr x control n traces proofs))
+                   t))
+   :hints(("Goal" :in-theory (enable rw.urewrite-clause-list-bldr))))
+
+ (defthm forcing-logic.strip-conclusions-of-rw.urewrite-clause-list-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (rw.controlp control)
+                        (equal traces (rw.urewrite-list-list x t control n))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (rw.trace-list-list-rhses traces)))))
+            (equal (logic.strip-conclusions (rw.urewrite-clause-list-bldr x control n traces proofs))
+                   (clause.clause-list-formulas x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-rw.urewrite-clause-list-bldr
+   (implies (force (and (logic.term-list-listp x)
+                        (cons-listp x)
+                        (rw.controlp control)
+                        (equal traces (rw.urewrite-list-list x t control n))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (rw.trace-list-list-rhses traces)))
+                        ;; ---
+                        (logic.term-list-list-atblp x atbl)
+                        (rw.control-atblp control atbl)
+                        (rw.control-env-okp control axioms thms)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.urewrite-clause-list-bldr)))
+            (equal (logic.proof-listp (rw.urewrite-clause-list-bldr x control n traces proofs) axioms thms atbl)
+                   t))
+   :hints(("Goal" :in-theory (enable rw.urewrite-clause-list-bldr)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/urewrite.lisp acl2-6.3/books/milawa/ACL2/rewrite/urewrite.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/urewrite.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/urewrite.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,611 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "traces/urewrite-builders")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(definline rw.empty-hypbox ()
+  (declare (xargs :guard t))
+  (rw.hypbox nil nil))
+
+
+(defconst *rw.flag-urewrite*
+  '(cond
+    ((zp n)
+     (ACL2::prog2$ (ACL2::cw! "[rw.urewrite]: ran out of steps on ~x0.!~%" x)
+                   (rw.fail-trace (rw.empty-hypbox) x iffp)))
+
+    ((logic.constantp x)
+     ;; we might be able to canonicalize constants under iffp
+     (or (rw.try-ground-simplify (rw.empty-hypbox) x iffp control)
+         (rw.fail-trace (rw.empty-hypbox) x iffp)))
+
+    ((logic.variablep x)
+     ;; can't simplify variables since we have no assumptions
+     (rw.fail-trace (rw.empty-hypbox) x iffp))
+
+    ((logic.functionp x)
+     (let ((name (logic.function-name x))
+           (args (logic.function-args x)))
+       (if (and (equal name 'if)
+                (equal (len args) 3))
+           (let* ((arg1 (first args))
+                  (arg2 (second args))
+                  (arg3 (third args))
+                  (arg1-trace (rw.flag-urewrite 'term arg1 t control n))
+                  (arg1-prime (rw.trace->rhs arg1-trace)))
+             (if (logic.constantp arg1-prime)
+                 (if (logic.unquote arg1-prime)
+                     (rw.if-specialcase-t-trace arg1-trace (rw.flag-urewrite 'term arg2 iffp control n) arg3)
+                   (rw.if-specialcase-nil-trace arg1-trace (rw.flag-urewrite 'term arg3 iffp control n) arg2))
+               (let* ((arg2-trace (rw.flag-urewrite 'term arg2 iffp control n))
+                      (arg3-trace (rw.flag-urewrite 'term arg3 iffp control n))
+                      (arg2-prime (rw.trace->rhs arg2-trace))
+                      (arg3-prime (rw.trace->rhs arg3-trace)))
+                 (if (equal arg2-prime arg3-prime)
+                     (rw.urewrite-if-specialcase-same-trace arg2-trace arg3-trace arg1)
+                   (let ((general-trace (rw.urewrite-if-generalcase-trace arg1-trace arg2-trace arg3-trace)))
+                     (if (and (equal arg2-prime ''nil)
+                              (equal arg3-prime ''t))
+                         (rw.transitivity-trace general-trace (rw.negative-if-trace arg1-prime iffp (rw.empty-hypbox)))
+                       general-trace))))))
+         (or
+          ;; Try evaluation.  This prevents loops with constant-gathering rules and
+          ;; outside-in rewrite rules.  If we win, we're canonical and can stop.
+          (and (logic.constant-listp args)
+               (rw.try-ground-simplify (rw.empty-hypbox) x iffp control))
+          ;; Try outside-in rules.  If we win, we need to keep rewriting because we
+          ;; probably aren't canonical yet.
+          (let ((outside-trace (rw.try-urewrite-rules (rw.empty-hypbox) x 'outside iffp control)))
+            (and outside-trace
+                 (rw.transitivity-trace outside-trace
+                                        (rw.flag-urewrite 'term (rw.trace->rhs outside-trace) iffp control (- n 1)))))
+          ;; Try working inside out.
+          (let* ((arg-traces (rw.flag-urewrite 'list args nil control n))
+                 (main-trace (rw.equiv-by-args-trace (rw.empty-hypbox) name iffp arg-traces)) ;; (f args) == (f args')
+                 (term-prime (rw.trace->rhs main-trace))
+                 (args-prime (logic.function-args term-prime)))
+            (or
+             ;; If all the args turned into constants, try evaluation.  If we win, we
+             ;; can stop because we're canonical.
+             (let ((ground-trace (and (logic.constant-listp args-prime)
+                                      (rw.try-ground-simplify (rw.empty-hypbox) term-prime iffp control))))
+               (and ground-trace
+                    (rw.transitivity-trace main-trace ground-trace)))
+             ;; Otherwise, try using inside-out rules.  If we win, we need to keep
+             ;; rewriting because we may not be canonical yet.
+             (let ((rule-trace (rw.try-urewrite-rules (rw.empty-hypbox) term-prime 'inside iffp control)))
+               (and rule-trace
+                    (let ((next-trace (rw.flag-urewrite 'term (rw.trace->rhs rule-trace) iffp control (- n 1))))
+                      (rw.transitivity-trace main-trace
+                                             (rw.transitivity-trace rule-trace next-trace)))))
+             ;; Otherwise nothing works, maybe some argument simplified.
+             main-trace))))))
+
+    ((logic.lambdap x)
+     (let* ((formals    (logic.lambda-formals x))
+            (body       (logic.lambda-body x))
+            (actuals    (logic.lambda-actuals x))
+            (arg-traces (rw.flag-urewrite 'list actuals nil control n))
+            (main-trace (rw.lambda-equiv-by-args-trace (rw.empty-hypbox) formals body iffp arg-traces)) ;; (lambda ... args) == (lambda ... args')
+            (term-prime (rw.trace->rhs main-trace))
+            (args-prime (logic.lambda-actuals term-prime)))
+       (or
+        ;; Perhaps we can just evaluate it?
+        (and (logic.constant-listp args-prime)
+             (let ((ground-trace (rw.try-ground-simplify (rw.empty-hypbox) term-prime iffp control)))
+               (and ground-trace
+                    (rw.transitivity-trace main-trace ground-trace))))
+        ;; Perhaps we're allowed to beta reduce?
+        ;; We haven't bothered to implement recursive simplification, i.e., we treat t as 'once.
+        (and (rw.control->betamode control)
+             (let* ((trace1 (rw.beta-reduction-trace (rw.empty-hypbox) term-prime iffp)) ;; (lambda ... args') == body/args'
+                    (trace2 (rw.transitivity-trace main-trace trace1)) ;; (lambda ... args) == body/args'
+                    (trace3 (rw.flag-urewrite 'term (rw.trace->rhs trace1) iffp control (- n 1)))) ;; body/args' == result
+               (rw.transitivity-trace trace2 trace3))) ;; (lambda ... args) == result
+        ;; Otherwise we can only hope an argument simplified.
+        main-trace)))))
+
+(defconst *rw.flag-urewrite-list*
+  '(if (consp x)
+       (cons (rw.flag-urewrite 'term (car x) iffp control n)
+             (rw.flag-urewrite 'list (cdr x) iffp control n))
+     nil))
+
+
+(ACL2::make-event
+ `(defun rw.flag-urewrite (flag x iffp control n)
+    ;; We perform up to n passes of unconditional rewriting.
+    (declare (xargs :guard (and (booleanp iffp)
+                                (rw.controlp control)
+                                (natp n)
+                                (if (equal flag 'term)
+                                    (logic.termp x)
+                                  (and (equal flag 'list)
+                                       (logic.term-listp x))))
+                    :measure (two-nats-measure (nfix n) (rank x))
+                    :verify-guards nil))
+    (if (equal flag 'term)
+        ,*rw.flag-urewrite*
+      ,*rw.flag-urewrite-list*)))
+
+(defund rw.urewrite (x iffp control n)
+  (declare (xargs :guard (and (logic.termp x)
+                              (booleanp iffp)
+                              (rw.controlp control)
+                              (natp n))
+                  :verify-guards nil))
+  (rw.flag-urewrite 'term x iffp control n))
+
+(defund rw.urewrite-list (x iffp control n)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (booleanp iffp)
+                              (rw.controlp control)
+                              (natp n))
+                  :verify-guards nil))
+  (rw.flag-urewrite 'list x iffp control n))
+
+(defconst *rw.flagless-urewrite-sigma*
+  (list (cons '(ACL2::prog2$ ?x ?y)
+              '?y)
+        (cons '(rw.flag-urewrite 'term ?x ?iffp ?control ?n)
+              '(rw.urewrite ?x ?iffp ?control ?n))
+        (cons '(rw.flag-urewrite 'list ?x ?iffp ?control ?n)
+              '(rw.urewrite-list ?x ?iffp ?control ?n))))
+
+(ACL2::make-event
+ `(defthmd definition-of-rw.urewrite
+    (equal (rw.urewrite x iffp control n)
+           ,(ACL2::jared-rewrite *rw.flag-urewrite* *rw.flagless-urewrite-sigma*))
+    :rule-classes :definition
+    :hints(("Goal"
+            :in-theory (enable rw.urewrite rw.urewrite-list)
+            :expand (rw.flag-urewrite 'term x iffp control n)))))
+
+(ACL2::make-event
+ `(defthmd definition-of-rw.urewrite-list
+    (equal (rw.urewrite-list x iffp control n)
+           ,(ACL2::jared-rewrite *rw.flag-urewrite-list* *rw.flagless-urewrite-sigma*))
+    :rule-classes :definition
+    :hints(("Goal"
+            :in-theory (enable rw.urewrite rw.urewrite-list)
+            :expand (rw.flag-urewrite 'list x iffp control n)))))
+
+(defthm rw.flag-urewrite-of-term
+  (equal (rw.flag-urewrite 'term x iffp control n)
+         (rw.urewrite x iffp control n))
+  :hints(("Goal" :in-theory (enable rw.urewrite))))
+
+(defthm rw.flag-urewrite-of-list
+  (equal (rw.flag-urewrite 'list x iffp control n)
+         (rw.urewrite-list x iffp control n))
+  :hints(("Goal" :in-theory (enable rw.urewrite-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.urewrite))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.urewrite-list))))
+
+(defthm rw.urewrite-list-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.urewrite-list x iffp control n)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-rw.urewrite-list))))
+
+(defthm rw.urewrite-list-of-cons
+  (equal (rw.urewrite-list (cons a x) iffp control n)
+         (cons (rw.urewrite a iffp control n)
+               (rw.urewrite-list x iffp control n)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.urewrite-list))))
+
+(defprojection
+  :list (rw.urewrite-list x iffp control n)
+  :element (rw.urewrite x iffp control n)
+  :already-definedp t)
+
+(defthms-flag
+  :shared-hyp (force (and (booleanp iffp)
+                          (rw.controlp control)))
+  :thms ((term forcing-rw.tracep-of-rw.urewrite
+               (implies (force (logic.termp x))
+                        (equal (rw.tracep (rw.urewrite x iffp control n))
+                               t)))
+         (t forcing-rw.trace-listp-of-rw.urewrite-list
+            (implies (force (logic.term-listp x))
+                     (equal (rw.trace-listp (rw.urewrite-list x iffp control n))
+                            t))))
+  :hints (("Goal"
+           :expand (rw.urewrite x iffp control n)
+           :in-theory (disable forcing-lookup-of-logic.function-name)
+           :induct (rw.flag-urewrite flag x iffp control n))))
+
+(defthms-flag
+  :shared-hyp (force (and (booleanp iffp)
+                          (rw.controlp control)))
+  :thms ((term forcing-rw.trace->iffp-of-rw.urewrite
+               (implies (force (logic.termp x))
+                        (equal (rw.trace->iffp (rw.urewrite x iffp control n))
+                               iffp)))
+         (t forcing-rw.trace-list-iffps-of-rw.urewrite-list
+            (implies (force (logic.term-listp x))
+                     (equal (rw.trace-list-iffps (rw.urewrite-list x iffp control n))
+                            (repeat iffp (len x))))))
+  :hints (("Goal"
+           :expand (rw.urewrite x iffp control n)
+           :in-theory (disable forcing-lookup-of-logic.function-name)
+           :induct (rw.flag-urewrite flag x iffp control n))))
+
+(defthms-flag
+  :shared-hyp (force (and (booleanp iffp)
+                          (rw.controlp control)))
+  :thms ((term forcing-rw.trace->lhs-of-rw.urewrite
+               (implies (force (logic.termp x))
+                        (equal (rw.trace->lhs (rw.urewrite x iffp control n))
+                               x)))
+         (t forcing-rw.trace-list-lhses-of-rw.urewrite-list
+            (implies (force (logic.term-listp x))
+                     (equal (rw.trace-list-lhses (rw.urewrite-list x iffp control n))
+                            (list-fix x)))))
+  :hints (("Goal"
+           :expand (rw.urewrite x iffp control n)
+           :in-theory (disable forcing-lookup-of-logic.function-name)
+           :induct (rw.flag-urewrite flag x iffp control n))))
+
+(defthms-flag
+  :shared-hyp (force (and (booleanp iffp)
+                          (rw.controlp control)))
+  :thms ((term forcing-rw.trace->nhyps-of-rw.urewrite
+               (implies (force (logic.termp x))
+                        (equal (rw.trace->hypbox (rw.urewrite x iffp control n))
+                               (rw.empty-hypbox))))
+         (t forcing-rw.trace-list-nhyps-of-rw.urewrite-list
+            (implies (force (logic.term-listp x))
+                     (equal (rw.trace-list-hypboxes (rw.urewrite-list x iffp control n))
+                            (repeat (rw.empty-hypbox) (len x))))))
+  :hints (("Goal"
+           :expand (rw.urewrite x iffp control n)
+           :in-theory (disable forcing-lookup-of-logic.function-name)
+           :induct (rw.flag-urewrite flag x iffp control n))))
+
+(verify-guards rw.flag-urewrite)
+(verify-guards rw.urewrite)
+(verify-guards rw.urewrite-list)
+
+(defthms-flag
+  :shared-hyp (force (and (booleanp iffp)
+                          (rw.controlp control)
+                          (rw.control-atblp control atbl)
+                          (equal (cdr (lookup 'not atbl)) 1)))
+  :thms ((term forcing-rw.trace-atblp-of-rw.urewrite
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)))
+                        (equal (rw.trace-atblp (rw.urewrite x iffp control n) atbl)
+                               t)))
+         (t forcing-rw.trace-list-atblp-of-rw.urewrite-list
+            (implies (force (and (logic.term-listp x)
+                                 (logic.term-list-atblp x atbl)))
+                     (equal (rw.trace-list-atblp (rw.urewrite-list x iffp control n) atbl)
+                            t))))
+  :hints (("Goal"
+           :expand (rw.urewrite x iffp control n)
+           :induct (rw.flag-urewrite flag x iffp control n))))
+
+(defthms-flag
+  :shared-hyp (force (and (booleanp iffp)
+                          (rw.controlp control)
+                          (rw.control-atblp control atbl)
+                          (rw.control-env-okp control axioms thms)
+                          (equal (cdr (lookup 'not atbl)) 1)))
+  :thms ((term forcing-rw.trace-env-okp-of-rw.urewrite
+               (implies (force (and (logic.termp x)
+                                    (logic.term-atblp x atbl)))
+                        (equal (rw.trace-env-okp (rw.urewrite x iffp control n) defs thms atbl)
+                               t)))
+         (t forcing-rw.trace-list-env-okp-of-rw.urewrite-list
+            (implies (force (and (logic.term-listp x)
+                                 (logic.term-list-atblp x atbl)))
+                     (equal (rw.trace-list-env-okp (rw.urewrite-list x iffp control n) defs thms atbl)
+                            t))))
+  :hints (("Goal"
+           :expand (rw.urewrite x iffp control n)
+           :induct (rw.flag-urewrite flag x iffp control n))))
+
+(defthms-flag
+  :shared-hyp (force (and (booleanp iffp)
+                          (rw.controlp control)))
+  :thms ((term forcing-rw.trace-okp-of-rw.urewrite
+               (implies (force (logic.termp x))
+                        (equal (rw.trace-okp (rw.urewrite x iffp control n)
+                                             (rw.control->defs control))
+                               t)))
+         (t forcing-rw.trace-list-okp-of-rw.urewrite-list
+            (implies (force (logic.term-listp x))
+                     (equal (rw.trace-list-okp (rw.urewrite-list x iffp control n)
+                                               (rw.control->defs control))
+                            t))))
+  :hints (("Goal"
+           :expand (rw.urewrite x iffp control n)
+           :induct (rw.flag-urewrite flag x iffp control n))))
+
+(defthms-flag
+  :shared-hyp (force (and (booleanp iffp)
+                          (rw.controlp control)))
+  :thms ((term forcing-rw.collect-forced-goals-of-rw.urewrite
+               (implies (force (logic.termp x))
+                        (equal (rw.collect-forced-goals (rw.urewrite x iffp control n))
+                               nil)))
+         (t forcing-rw.collect-forced-goals-list-of-rw.urewrite-list
+            (implies (force (logic.term-listp x))
+                     (equal (rw.collect-forced-goals-list (rw.urewrite-list x iffp control n))
+                            nil))))
+  :hints (("Goal"
+           :expand (rw.urewrite x iffp control n)
+           :induct (rw.flag-urewrite flag x iffp control n))))
+
+
+
+;; (defund rw.urewrite (x iffp control n)
+;;   ;; We perform (up to) n+1 inside-out passes of unconditional rewriting, and
+;;   ;; produce a trace of our progress.
+;;   (declare (xargs :guard (and (logic.termp x)
+;;                               (booleanp iffp)
+;;                               (rw.controlp control)
+;;                               (natp n))
+;;                   :measure (nfix n)
+;;                   :verify-guards nil))
+;;   (let ((first-trace (rw.urewrite-core x iffp control)))
+;;     (cond ((equal (rw.trace->method first-trace) 'fail)
+;;            ;; No simplification was possible
+;;            first-trace)
+
+;;           ((zp n)
+;;            ;; We cannot further simplify becuase we have run out of steps.
+;;            (ACL2::prog2$ (ACL2::cw "[rw.urewrite] Warning: ran out of rewriting steps.~%")
+;;                          first-trace))
+
+;;           (t
+;;            ;; Perhaps we can simplify it further?
+;;            (rw.transitivity-trace first-trace
+;;                                   (rw.urewrite (rw.trace->rhs first-trace) iffp control (- n 1)))))))
+
+
+;; (encapsulate
+;;  ()
+;;  (local (in-theory (enable rw.urewrite)))
+
+;;  (defthm forcing-rw.tracep-of-rw.urewrite
+;;    (implies (force (and (logic.termp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.tracep (rw.urewrite x iffp control n))
+;;                    t)))
+
+;;  (defthm forcing-rw.trace-atblp-of-rw.urewrite
+;;    (implies (force (and (logic.termp x)
+;;                         (logic.term-atblp x atbl)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)
+;;                         (rw.control-atblp control atbl)
+;;                         (equal (cdr (lookup 'not atbl)) 1)))
+;;             (equal (rw.trace-atblp (rw.urewrite x iffp control n) atbl)
+;;                    t)))
+
+;;  (defthm forcing-rw.trace->lhs-of-rw.urewrite
+;;    (implies (force (and (logic.termp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace->lhs (rw.urewrite x iffp control n))
+;;                    x)))
+
+;;  (defthm forcing-rw.trace->hypbox-of-rw.urewrite
+;;    (implies (force (and (logic.termp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace->hypbox (rw.urewrite x iffp control n))
+;;                    (rw.empty-hypbox))))
+
+;;  (defthm forcing-rw.trace->iffp-of-rw.urewrite
+;;    (implies (force (and (logic.termp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace->iffp (rw.urewrite x iffp control n))
+;;                    iffp)))
+
+;;  (verify-guards rw.urewrite)
+
+;;  (defthm forcing-rw.trace-okp-of-rw.urewrite
+;;    (implies (force (and (logic.termp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace-okp (rw.urewrite x iffp control n))
+;;                    t)))
+
+;;  (defthm forcing-rw.trace-env-okp-of-rw.urewrite
+;;    (implies (force (and (logic.termp x)
+;;                         (logic.term-atblp x atbl)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)
+;;                         (rw.control-atblp control atbl)
+;;                         (rw.control-env-okp control axioms thms)
+;;                         (equal (cdr (lookup 'not atbl)) 1)))
+;;             (equal (rw.trace-env-okp (rw.urewrite x iffp control n) axioms thms atbl)
+;;                    t)))
+
+;;  (defthm forcing-rw.collect-forced-goals-of-rw.urewrite
+;;    (implies (force (and (logic.termp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.collect-forced-goals (rw.urewrite x iffp control n))
+;;                    nil))))
+
+
+
+
+;; (defprojection :list (rw.urewrite-list x iffp control n)
+;;                :element (rw.urewrite x iffp control n)
+;;                :guard (and (logic.term-listp x)
+;;                            (booleanp iffp)
+;;                            (rw.controlp control)
+;;                            (natp n)))
+
+;; (encapsulate
+;;  ()
+;;  (defthm forcing-rw.trace-listp-of-rw.urewrite-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace-listp (rw.urewrite-list x iffp control n))
+;;                    t))
+;;    :hints(("Goal" :induct (cdr-induction x))))
+
+;;  (defthm forcing-rw.trace-list-atblp-of-rw.urewrite-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         (logic.term-list-atblp x atbl)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)
+;;                         (rw.control-atblp control atbl)
+;;                         (equal (cdr (lookup 'not atbl)) 1)))
+;;             (equal (rw.trace-list-atblp (rw.urewrite-list x iffp control n) atbl)
+;;                    t))
+;;    :hints(("Goal" :induct (cdr-induction x))))
+
+;;  (defthm forcing-rw.trace-list-lhses-of-rw.urewrite-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace-list-lhses (rw.urewrite-list x iffp control n))
+;;                    (list-fix x)))
+;;    :hints(("Goal" :induct (cdr-induction x))))
+
+;;  (defthm forcing-rw.trace-list-iffps-of-rw.urewrite-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace-list-iffps (rw.urewrite-list x iffp control n))
+;;                    (repeat iffp (len x))))
+;;    :hints(("Goal" :induct (cdr-induction x))))
+
+;;  (defthm forcing-rw.trace-list-hypboxes-of-rw.urewrite-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace-list-hypboxes (rw.urewrite-list x iffp control n))
+;;                    (repeat (rw.empty-hypbox) (len x))))
+;;    :hints(("Goal" :induct (cdr-induction x))))
+
+;;  (defthm forcing-rw.trace-list-okp-of-rw.urewrite-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.trace-list-okp (rw.urewrite-list x iffp control n))
+;;                    t))
+;;    :hints(("Goal" :induct (cdr-induction x))))
+
+;;  (defthm forcing-rw.trace-list-env-okp-of-rw.urewrite-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         (logic.term-list-atblp x atbl)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)
+;;                         (rw.control-atblp control atbl)
+;;                         (rw.control-env-okp control axioms thms)
+;;                         (equal (cdr (lookup 'not atbl)) 1)))
+;;             (equal (rw.trace-list-env-okp (rw.urewrite-list x iffp control n) axioms thms atbl)
+;;                    t))
+;;    :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.trace-list-formulas-of-rw.urewrite-list
+   (implies (force (and (logic.term-listp x)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.trace-list-formulas (rw.urewrite-list x iffp control n))
+                   (rw.trace-list-conclusion-formulas (rw.urewrite-list x iffp control n))))
+   :hints(("Goal"
+           :use ((:instance rw.trace-list-formulas-when-all-equalp-of-rw.trace-list-hypboxes
+                            (hypbox (rw.empty-hypbox))
+                            (x (rw.urewrite-list x iffp control n)))))))
+
+(defthm forcing-rw.trace-list-conclusion-formulas-of-rw.urewrite-list
+   (implies (force (and (logic.term-listp x)
+                        (booleanp iffp)
+                        (rw.controlp control)))
+            (equal (rw.trace-list-conclusion-formulas (rw.urewrite-list x iffp control n))
+                   (logic.pequal-list
+                    (logic.function-list (if iffp 'iff 'equal)
+                                         (list2-list (rw.trace-list-lhses (rw.urewrite-list x iffp control n))
+                                                     (rw.trace-list-rhses (rw.urewrite-list x iffp control n))))
+                    (repeat ''t (len x)))))
+   :hints(("Goal"
+           :induct (cdr-induction x)
+           :in-theory (enable rw.trace-conclusion-formula rw.trace-list-conclusion-formulas))))
+
+;;  (defthm forcing-rw.collect-forced-goals-list-of-rw.urewrite-list
+;;    (implies (force (and (logic.term-listp x)
+;;                         (booleanp iffp)
+;;                         (rw.controlp control)))
+;;             (equal (rw.collect-forced-goals-list (rw.urewrite-list x iffp control n))
+;;                    nil))
+;;    :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+(defprojection :list (rw.urewrite-list-list x iffp control n)
+               :element (rw.urewrite-list x iffp control n)
+               :guard (and (logic.term-list-listp x)
+                           (booleanp iffp)
+                           (rw.controlp control)
+                           (natp n)))
+
+(defthm cons-listp-of-rw.urewrite-list-list
+  (equal (cons-listp (rw.urewrite-list-list x iffp control n))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.trace-list-listp-of-rw.urewrite-list-list
+  (implies (force (and (logic.term-list-listp x)
+                       (rw.controlp control)
+                       (booleanp iffp)))
+           (equal (rw.trace-list-listp (rw.urewrite-list-list x iffp control n))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-rw.collect-forced-goals-list-list-of-rw.urewrite-list-list
+  (implies (force (and (logic.term-list-listp x)
+                       (rw.controlp control)
+                       (booleanp iffp)))
+           (equal (rw.collect-forced-goals-list-list (rw.urewrite-list-list x iffp control n))
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/worse-termp-patch.lsp acl2-6.3/books/milawa/ACL2/rewrite/worse-termp-patch.lsp
--- acl2-6.2/books/milawa/ACL2/rewrite/worse-termp-patch.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/worse-termp-patch.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,234 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;                                                                           ;;
+;; EXTRA COPYRIGHT NOTICE.                                                   ;;
+;;                                                                           ;;
+;; This file is derived from type-set-b.lisp in the ACL2 3.1 sources.  I     ;;
+;; have copied or adapted many of the comments verbatim, and the functions   ;;
+;; have also been adapted to my system.  Of course, ACL2 is also GPL'd       ;;
+;; software, so there is no impact on Milawa's license.                      ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; worse-termp-patch.lsp
+;;
+;; This file can be used to patch your ACL2 image so that it logs all calls of
+;; ACL2::worse-than to the file /tmp/worse-than.log.  Your image will be much
+;; slower and you will potentially need many gigabytes of free disk space to do
+;; this.
+;;
+;; Instructions for use:
+;;
+;;  1. Load this file in acl2-patches.lisp and create a new ACL2 image.
+;;
+;;  2. Certify whichever books you want to track the calls of worse-than for.
+;;
+;;  3. DESTROY THE MODIFIED IMAGE.  That is, create a new image without the
+;;     tracing so that you don't get an infinite loop in step 5.
+;;
+;;  4. cd rewrite; omake worse-termp.cert
+;;
+;;  5. cd rewrite; ../modified-acl2 < worse-termp-tests.lsp to perform the
+;;     tests.
+;;
+;; The test harness makes sure that our rw.worse-termp agrees with acl2's
+;; worse-than function for all the "purely milawa" inputs you generate.  That
+;; is, we throw out all tests which include rationals, strings, etc.
+
+(mutual-recursion
+
+(defun old-worse-than (term1 term2)
+
+; Term1 is old-worse-than term2 if it is basic-old-worse-than term2 or some
+; proper subterm of it is old-worse-than or equal to term2.  However, we
+; know that if two terms are pseudo-variants of eachother, then the
+; old-worse-than relation does not hold.
+
+  (cond ((basic-old-worse-than term1 term2) t)
+        ((pseudo-variantp term1 term2) nil)
+        ((variablep term1)
+
+; If term1 is a variable and not basic-old-worse-than term2, what do we know
+; about term2?  Term2 might be a variable.  Term2 cannot be quote.
+; Term2 might be a function application.  So is X old-worse-than X or Y or
+; (F X Y)?  No.
+
+         nil)
+        ((fquotep term1)
+
+; If term1 is a quote and not basic-old-worse-than term2, what do we know
+; about term2?  Term2 might be a variable.  Also, term2 might be a
+; quote, but if it is, term2 is bigger than term1.  Term2 might be a
+; function application.  So is term1 old-worse-than a bigger quote?  No.
+; Is term1 old-worse-than a variable or function application?  No.
+
+         nil)
+
+        (t (old-worse-than-lst (fargs term1) term2))))
+
+
+
+(defun old-worse-than-or-equal (term1 term2)
+
+; This function is not really mutually recursive and could be removed
+; from this nest.  It determines whether term1 is term2 or worse than
+; term2.  This nest defines old-worse-than and does not use this function
+; despite the use of similarly named functions.
+
+; Note:  This function is supposed to be equivalent to
+; (or (equal term1 term2) (old-worse-than term1 term2)).
+
+; Clearly, that is equivalent to
+
+; (if (pseudo-variantp term1 term2)
+;     (or (equal term1 term2) (old-worse-than term1 term2))
+;     (or (equal term1 term2) (old-worse-than term1 term2)))
+
+; But if pseudo-variantp is true, then old-worse-than must return nil.
+; And if pseudo-variantp is nil, then the equal returns nil.  So we
+; can simplify the if above to:
+
+  (if (pseudo-variantp term1 term2)
+      (equal term1 term2)
+    (old-worse-than term1 term2)))
+
+(defun basic-old-worse-than-lst1 (args1 args2)
+
+; Is some element of args2 ``uglier'' than the corresponding element
+; of args1.  Technically, a2 is uglier than a1 if a1 is atomic (a
+; variable or constant) and a2 is not or a2 is old-worse-than a1.
+
+  (cond ((null args1) nil)
+        ((or (and (or (variablep (car args1))
+                      (fquotep (car args1)))
+                  (not (or (variablep (car args2))
+                           (fquotep (car args2)))))
+             (old-worse-than (car args2) (car args1)))
+         t)
+        (t (basic-old-worse-than-lst1 (cdr args1) (cdr args2)))))
+
+(defun basic-old-worse-than-lst2 (args1 args2)
+
+; Is some element of arg1 old-worse-than the corresponding element of args2?
+
+  (cond ((null args1) nil)
+        ((old-worse-than (car args1) (car args2)) t)
+        (t (basic-old-worse-than-lst2 (cdr args1) (cdr args2)))))
+
+(defun basic-old-worse-than (term1 term2)
+
+; We say that term1 is basic-old-worse-than term2 if
+
+; * term2 is a variable and term1 properly contains it, e.g., (F A B)
+;   is basic-old-worse-than A;
+
+; * term2 is a quote and term1 is either not a quote or is a bigger
+;   quote, e.g., both X and '124 are basic-old-worse-than '17 and '(A B C D
+;   E) is worse than 'X; or
+
+; * term1 and term2 are applications of the same function and
+;   no argument of term2 is uglier than the corresponding arg of term1, and
+;   some argument of term1 is old-worse-than the corresponding arg of term2.
+
+; The last case is illustrated by the fact that (F A B) is
+; basic-old-worse-than (F A '17), because B is worse than '17, but (F '17
+; B) is not basic-old-worse-than (F A '17) because A is worse than '17.
+; Think of term2 as the old goal and term1 as the new goal.  Do we
+; want to cut off backchaining?  Yes, if term1 is basic-old-worse-than
+; term2.  So would we backchain from (F A '17) to (F '17 B)?  Yes,
+; because even though one argument (the second) got worse (it went
+; from 17 to B) another argument (the first) got better (it went from
+; A to 17).
+
+  (cond ((variablep term2)
+         (cond ((eq term1 term2) nil)
+               (t (occur term2 term1))))
+        ((fquotep term2)
+         (cond ((variablep term1) t)
+               ((fquotep term1)
+                (> (fn-count-evg (cadr term1))
+                   (fn-count-evg (cadr term2))))
+               (t t)))
+        ((variablep term1) nil)
+        ((fquotep term1) nil)
+        ((cond ((flambda-applicationp term1)
+                (equal (ffn-symb term1) (ffn-symb term2)))
+               (t (eq (ffn-symb term1) (ffn-symb term2))))
+         (cond ((pseudo-variantp term1 term2) nil)
+               ((basic-old-worse-than-lst1 (fargs term1) (fargs term2)) nil)
+               (t (basic-old-worse-than-lst2 (fargs term1) (fargs term2)))))
+        (t nil)))
+
+(defun some-subterm-old-worse-than-or-equal (term1 term2)
+
+; Returns t if some subterm of term1 is old-worse-than or equal to term2.
+
+  (cond ((variablep term1) (eq term1 term2))
+        ((if (pseudo-variantp term1 term2)  ; see old-worse-than-or-equal
+             (equal term1 term2)
+           (basic-old-worse-than term1 term2))
+         t)
+        ((fquotep term1) nil)
+        (t (some-subterm-old-worse-than-or-equal-lst (fargs term1) term2))))
+
+(defun some-subterm-old-worse-than-or-equal-lst (args term2)
+  (cond ((null args) nil)
+        (t (or (some-subterm-old-worse-than-or-equal (car args) term2)
+               (some-subterm-old-worse-than-or-equal-lst (cdr args) term2)))))
+
+(defun old-worse-than-lst (args term2)
+
+; We determine whether some element of args contains a subterm that is
+; old-worse-than or equal to term2.  The subterm in question may be the
+; element of args itself.  That is, we use ``subterm'' in the ``not
+; necessarily proper subterm'' sense.
+
+  (cond ((null args) nil)
+        (t (or (some-subterm-old-worse-than-or-equal (car args) term2)
+               (old-worse-than-lst (cdr args) term2)))))
+
+)
+
+
+(defun worse-than (term1 term2)
+  ;; Write (test-worse-than term1 term2) to the log file
+  (with-open-file
+   (logfile "/tmp/worse-than.log"
+            :direction :output
+            :if-exists :append
+            :if-does-not-exist :create)
+   (format logfile "~a~%" (list 'test-worse-than term1 term2)))
+  ;; Return the old value of worse-than.
+  (old-worse-than term1 term2))
+
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/worse-termp-tests.lsp acl2-6.3/books/milawa/ACL2/rewrite/worse-termp-tests.lsp
--- acl2-6.2/books/milawa/ACL2/rewrite/worse-termp-tests.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/worse-termp-tests.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,80 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; We run the tests generated by worse-termp-patch.lsp and stored in
+;; /tmp/worse-than.log.
+;;
+;; Usage:
+;;    ../modified-acl2 < worse-termp-tests.lsp
+;;
+;; We print a message after every 100,000 successful tests.  On my 2.8 GHz
+;; Pentium D, I estimate about 12 minutes per gigabyte of testing text.
+
+(include-book "worse-termp")
+
+:q
+
+(in-package "MILAWA")
+
+(ACL2::defun milawa-objectp (x)
+  (or (symbolp x)
+      (natp x)
+      (and (consp x)
+           (milawa-objectp (car x))
+           (milawa-objectp (cdr x)))))
+
+(ACL2::defparameter *n* 0)
+
+(ACL2::defun test-worse-than-fn (x y)
+  (cond ((not (and (milawa-objectp x)
+                   (milawa-objectp y)))
+         nil)
+        ((not (and (logic.term-structurep x)
+                   (logic.term-structurep y)))
+         (ACL2::er hard 'test-worse-than-fn "~x0 or ~x1 are not terms.~%" x y))
+        ((not (equal (ACL2::worse-than x y)
+                     (rw.worse-termp x y)))
+         (ACL2::cw "Mismatch for (worse-than ~x0 ~x1)~%" x y))
+        (t
+         (ACL2::progn (ACL2::incf *n*)
+                      (if (equal (ACL2::mod *n* 100000) 0)
+                          (ACL2::cw "~x0 tests successfully executed~%" *n*))))))
+
+(ACL2::defmacro test-worse-than (x y)
+  `(test-worse-than-fn ',x ',y))
+
+(ACL2::compile 'milawa-objectp)
+(ACL2::compile 'test-worse-than-fn)
+
+(ACL2::load "/tmp/worse-than.log")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/rewrite/worse-termp.lisp acl2-6.3/books/milawa/ACL2/rewrite/worse-termp.lisp
--- acl2-6.2/books/milawa/ACL2/rewrite/worse-termp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/rewrite/worse-termp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,474 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;                                                                           ;;
+;; EXTRA COPYRIGHT NOTICE.                                                   ;;
+;;                                                                           ;;
+;; This file is derived from type-set-b.lisp in the ACL2 3.1 sources.  I     ;;
+;; have copied or adapted many of the comments verbatim, and the functions   ;;
+;; have also been adapted to my system.  Of course, ACL2 is also GPL'd       ;;
+;; software, so there is no impact on Milawa's license.                      ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../logic/subtermp")
+(include-book "../logic/term-order")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; (rw.pseudo-variantp x y)
+;;
+;; According to ACL2's comments, this function is supposed to check that y is
+;; the same as x "up to the variables".  For example:
+;;
+;;   (rw.pseudo-variantp '(f a) '(f (g b))) = t
+;;   (rw.pseudo-variantp '(f (g b)) '(f a)) = nil
+;;
+;; But this is not quite what the function does.  As a special twist, it
+;; doesn't allow variables to be replaced by constants.
+;;
+;;   (rw.pseudo-variantp '(f a) '(f '3)) = nil
+;;
+;; This is apparently done to ensure that rw.pseudo-variantp never returns true
+;; if x is worse than y.
+
+(defund rw.flag-pseudo-variantp (flag x y)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (and (logic.termp x)
+                                  (logic.termp y))
+                           (and (equal flag 'list)
+                                (logic.term-listp x)
+                                (logic.term-listp y)))))
+  (if (equal flag 'term)
+      (cond ((logic.variablep x)
+             (not (logic.constantp y)))
+            ((logic.constantp x)
+             (equal x y))
+            ((logic.functionp x)
+             (and (logic.functionp y)
+                  (equal (logic.function-name x) (logic.function-name y))
+                  (rw.flag-pseudo-variantp 'list (logic.function-args x) (logic.function-args y))))
+            ((logic.lambdap x)
+             (and (logic.lambdap y)
+                  (equal (logic.lambda-formals x) (logic.lambda-formals y))
+                  (equal (logic.lambda-body x) (logic.lambda-body y))
+                  (rw.flag-pseudo-variantp 'list (logic.lambda-actuals x) (logic.lambda-actuals y))))
+            (t nil))
+    (if (and (consp x)
+             (consp y))
+        (and (rw.flag-pseudo-variantp 'term (car x) (car y))
+             (rw.flag-pseudo-variantp 'list (cdr x) (cdr y)))
+     t)))
+
+(definlined rw.pseudo-variantp (x y)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y))))
+  (rw.flag-pseudo-variantp 'term x y))
+
+(definlined rw.pseudo-variant-listp (x y)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.term-listp y))))
+  (rw.flag-pseudo-variantp 'list x y))
+
+
+
+
+
+;; (rw.worse-termp x y)
+;;
+;; This is a heuristic function for ancestor checking.  It is based on ACL2's
+;; basic-worse-than function.  This function was redesigned in ACL2 2.6 when
+;; performance problems were encountered, and we base our version on ACL2
+;; 3.1's, which is really quite complex and still has potentially bad cases for
+;; its performance.
+;;
+;; We do not implement ACL2's evg-occur and occur functions, which are based on
+;; the funny idea of constants as (s (s (s 0))) and so forth.  This probably
+;; won't affect much in practice, since we don't have strings, rationals,
+;; negative numbers, and so forth which actually cause those issues.  Instead,
+;; we just use our subterm function.
+
+(defund rw.flag-worsep (flag x y)
+  (declare (xargs :guard (cond ((or (equal flag 'worse-termp)
+                                    (equal flag 'some-subterm-worse-than-or-equalp)
+                                    (equal flag 'basic-worse-termp))
+                                (and (logic.termp x)
+                                     (logic.termp y)))
+
+                               ((or (equal flag 'worse-than-listp)
+                                    (equal flag 'some-subterm-worse-than-or-equal-listp))
+                                (and (logic.term-listp x)
+                                     (logic.termp y)))
+
+                               (t ;; (or (equal flag 'some-less-ugly-than-correspondingp)
+                                  ;;     (equal flag 'some-worse-than-correspondingp))
+                                (and (logic.term-listp x)
+                                     (logic.term-listp y))))
+                  :measure (two-nats-measure (+ (rank x) (rank y))
+                                             (if (equal flag 'basic-worse-termp) 1 2))))
+  (cond ((equal flag 'worse-termp)
+         (cond ((rw.flag-worsep 'basic-worse-termp x y)
+                t)
+               ((rw.pseudo-variantp x y)
+                nil)
+               ((logic.functionp x)
+                (rw.flag-worsep 'worse-than-listp (logic.function-args x) y))
+               ((logic.lambdap x)
+                (rw.flag-worsep 'worse-than-listp (logic.lambda-actuals x) y))
+               (t nil)))
+
+        ((equal flag 'worse-than-listp)
+         ;; "We determine whether some element of x contains a subterm that is
+         ;; worse-than or equal to y.  The subterm in question may be the
+         ;; element of x itself.  That is, we use ``subterm'' in the ``not
+         ;; necessarily proper subterm'' sense."
+         (if (consp x)
+             (or (rw.flag-worsep 'some-subterm-worse-than-or-equalp (car x) y)
+                 (rw.flag-worsep 'worse-than-listp (cdr x) y))
+           nil))
+
+        ((equal flag 'some-subterm-worse-than-or-equalp)
+         (cond ((logic.variablep x)
+                (equal x y))
+               ((if (rw.pseudo-variantp x y) ; like worse-than-or-equal, below
+                    (equal x y)
+                  (rw.flag-worsep 'basic-worse-termp x y))
+                t)
+               ((logic.constantp x)
+                nil)
+               ((logic.functionp x)
+                (rw.flag-worsep 'some-subterm-worse-than-or-equal-listp (logic.function-args x) y))
+               ((logic.lambdap x)
+                (rw.flag-worsep 'some-subterm-worse-than-or-equal-listp (logic.lambda-actuals x) y))
+               (t nil)))
+
+        ((equal flag 'some-subterm-worse-than-or-equal-listp)
+         (if (consp x)
+             (or (rw.flag-worsep 'some-subterm-worse-than-or-equalp (car x) y)
+                 (rw.flag-worsep 'some-subterm-worse-than-or-equal-listp (cdr x) y))
+           nil))
+
+        ((equal flag 'basic-worse-termp)
+         ;; "We say that x is basic-worse-than y if:
+         ;;
+         ;;   - y is a variable and x properly contains it, e.g., (F A B) is
+         ;;     basic-worse-than A;
+         ;;
+         ;;   - y is a quote and x is either not a quote or is a bigger quote, e.g.,
+         ;;     both X and '124 are basic-worse-than '17 and '(A B C D E) is worse
+         ;;     than 'X; or
+         ;;
+         ;;   - x and y are applications of the same function and no argument of y is
+         ;;     uglier than the corresponding arg of x, and some argument of x is
+         ;;     worse-than the corresponding arg of y.
+         ;;
+         ;; The last case is illustrated by the fact that (F A B) is basic-worse-than
+         ;; (F A '17), because B is worse than '17, but (F '17 B) is not
+         ;; basic-worse-than (F A '17) because A is worse than '17.
+         ;;
+         ;; Think of y as the old goal and x as the new goal.  Do we want to cut off
+         ;; backchaining?  Yes, if x is basic-worse-than y.  So would we backchain
+         ;; from (F A '17) to (F '17 B)?  Yes, because even though one argument (the
+         ;; second) got worse (it went from 17 to B) another argument (the first) got
+         ;; better (it went from A to 17)."
+         (cond ((logic.constantp x)
+                ;; A constant is only worse than a smaller constant.
+                (and (logic.constantp y)
+                     (<< (logic.unquote y) (logic.unquote x))))
+               ((logic.variablep x)
+                ;; A variable is only worse than a constant.
+                (logic.constantp y))
+               ((logic.constantp y)
+                ;; Any non-constant is worse than a constant.
+                t)
+               ((logic.variablep y)
+                ;; A term is only worse than a variable if it properly contains
+                ;; the variable.  We don't have to check equality because we
+                ;; know x is not a variable already.
+                (logic.subtermp y x))
+               ((logic.functionp x)
+                (and (logic.functionp y)
+                     (equal (logic.function-name x) (logic.function-name y))
+                     (not (rw.pseudo-variantp x y))
+                     (let ((args-x (logic.function-args x))
+                           (args-y (logic.function-args y)))
+                       (and (not (rw.flag-worsep 'some-less-ugly-than-correspondingp args-x args-y))
+                            (rw.flag-worsep 'some-worse-than-correspondingp args-x args-y)))))
+               ((logic.lambdap x)
+                (and (logic.lambdap y)
+                     (equal (logic.lambda-formals x) (logic.lambda-formals y))
+                     (equal (logic.lambda-body x) (logic.lambda-body y))
+                     (not (rw.pseudo-variantp x y))
+                     (let ((args-x (logic.lambda-actuals x))
+                           (args-y (logic.lambda-actuals y)))
+                       (and (not (rw.flag-worsep 'some-less-ugly-than-correspondingp args-x args-y))
+                            (rw.flag-worsep 'some-worse-than-correspondingp args-x args-y)))))
+               (t nil)))
+
+        ((equal flag 'some-less-ugly-than-correspondingp)
+         ;; "Is some element of y uglier than the corresponding element of x?
+         ;; Technically, bi is uglier than ai if ai is atomic (a variable or
+         ;; constant) and bi is not, or bi is worse-than ai."
+         (and (consp x)
+              (consp y)
+              (or (and (or (logic.variablep (car x))
+                           (logic.constantp (car x)))
+                       (not (or (logic.variablep (car y))
+                                (logic.constantp (car y)))))
+                  (rw.flag-worsep 'worse-termp (car y) (car x))
+                  (rw.flag-worsep 'some-less-ugly-than-correspondingp (cdr x) (cdr y)))))
+
+        (t ;; some-worse-than-correspondingp
+         (and (consp x)
+              (consp y)
+              (or (rw.flag-worsep 'worse-termp (car x) (car y))
+                  (rw.flag-worsep 'some-worse-than-correspondingp (cdr x) (cdr y)))))))
+
+(definlined rw.worse-termp (x y)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y))))
+  (rw.flag-worsep 'worse-termp x y))
+
+(definlined rw.worse-than-listp (x y)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.termp y))))
+  (rw.flag-worsep 'worse-than-listp x y))
+
+(definlined rw.some-subterm-worse-than-or-equalp (x y)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y))))
+  (rw.flag-worsep 'some-subterm-worse-than-or-equalp x y))
+
+(definlined rw.some-subterm-worse-than-or-equal-listp (x y)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.termp y))))
+  (rw.flag-worsep 'some-subterm-worse-than-or-equal-listp x y))
+
+(definlined rw.basic-worse-termp (x y)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y))))
+  (rw.flag-worsep 'basic-worse-termp x y))
+
+(definlined rw.some-less-ugly-than-correspondingp (x y)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.term-listp y))))
+  (rw.flag-worsep 'some-less-ugly-than-correspondingp x y))
+
+(definlined rw.some-worse-than-correspondingp (x y)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (logic.term-listp y))))
+  (rw.flag-worsep 'some-worse-than-correspondingp x y))
+
+
+
+(definlined rw.worse-than-or-equal-termp (x y)
+  (declare (xargs :guard (and (logic.termp x)
+                              (logic.termp y))))
+  ;; "This function is supposed to be equivalent to
+  ;; (or (equal term1 term2) (worse-than term1 term2)).
+  ;;
+  ;; Clearly, that is equivalent to
+  ;;
+  ;; (if (pseudo-variantp term1 term2)
+  ;;     (or (equal term1 term2) (worse-than term1 term2))
+  ;;     (or (equal term1 term2) (worse-than term1 term2)))
+  ;;
+  ;; But if pseudo-variantp is true, then worse-than must return nil.
+  ;; And if pseudo-variantp is nil, then the equal returns nil.  So we
+  ;; can simplify the if above to:"
+  (if (rw.pseudo-variantp x y)
+      (equal x y)
+    (rw.worse-termp x y)))
+
+
+
+
+
+
+#|
+
+;; Here are some comments and tests from the ACL2 sources.  My adapted
+;; functions are apparently somewhat slower than ACL2's, even though I'm using
+;; a 2.8 GHz Pentium D instead of a 330 MHz Pentium II.
+
+; It turns out that without the use of pseudo-variantp in the definition of
+; worse-than, below, worse-than's cost grows exponentially on pseudo-variant
+; terms.  Consider the sequence of terms (f a a), (f a (f a a)), ..., and the
+; corresponding sequence with variable symbol b used in place of a.  Call these
+; terms a1, a2, ..., and b1, b2, ...  Then if pseudo-variantp were redefined to
+; return nil, here are the real times taken to do (worse-than a1 b1),
+; (worse-than a2 b2), ...  0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000,
+; 0.020, 0.080, 0.300, 1.110, 4.230, 16.390.  This was measured on a 330 MHz
+; Pentium II.
+
+(ACL2::comp t)
+
+(list (ACL2::time$ (rw.worse-termp '(f a a)
+                                   '(f b b)))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a a))
+                                   '(f b (f b b))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a a)))
+                                   '(f b (f b (f b b)))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a a))))
+                                   '(f b (f b (f b (f b b))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a a)))))
+                                   '(f b (f b (f b (f b (f b b)))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a a))))))
+                                   '(f b (f b (f b (f b (f b (f b b))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a a)))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b b)))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a a))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b b))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a (f a a))))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a (f a (f a (f a a))))))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))))
+      )
+
+; If pseudo-variantp is defined so that instead of (not (quotep term2)) it
+; insists of (variablep term2) when (variablep term1), then the following
+; sequence goes exponential even though the preceding one does not.
+
+(list (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))
+                                   '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))))))))
+      )
+
+; With times of 0.000, 0.120, 0.250, 0.430, etc.  But with the current
+; definition of pseudo-variantp, the sequence above is flat.  However, the
+; sequence with the terms commuted grows exponentially, still:
+
+(list (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (rw.worse-termp '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))))))
+                                   '(f a (f a (f a (f a (f a (f a (f a (f a (f a a))))))))))))
+
+; Real times: 0.000, 0.000, 0.010, 0.000, 0.010, 0.020, 0.040, 0.100, 0.210,
+; ...
+
+
+(list (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b))))))))))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a)))))))))))
+
+      (ACL2::time$ (ACL2::worse-than '(f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b (f b b)))))))))))))))))
+                                     '(f a (f a (f a (f a (f a (f a (f a (f a (f a a))))))))))))
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/acl2 acl2-6.3/books/milawa/ACL2/tactics/acl2
--- acl2-6.2/books/milawa/ACL2/tactics/acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/acl2	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,2 @@
+#!/bin/sh
+../acl2-images/tactics-acl2
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/tactics/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/tactics/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/acl2-customization.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,35 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/cert.acl2 acl2-6.3/books/milawa/ACL2/tactics/cert.acl2
--- acl2-6.2/books/milawa/ACL2/tactics/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/cert.acl2	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1 @@
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/cert.image acl2-6.3/books/milawa/ACL2/tactics/cert.image
--- acl2-6.2/books/milawa/ACL2/tactics/cert.image	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/cert.image	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1 @@
+tactics-acl2
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/cleanup.lisp acl2-6.3/books/milawa/ACL2/tactics/cleanup.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/cleanup.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/cleanup.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,158 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund tactic.cleanup-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'cleanup)
+         (not extras)
+         (let* ((old-goals   (tactic.skeleton->goals history))
+                (cleanup     (clause.fast-clean-clauses old-goals))
+                (unprovablep (first cleanup))
+                (progressp   (second cleanup))
+                (new-goals   (third cleanup)))
+           (and (not unprovablep)
+                progressp
+                (equal goals new-goals))))))
+
+(defthm booleanp-of-tactic.cleanup-okp
+  (equal (booleanp (tactic.cleanup-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.cleanup-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.cleanup-tac (x warnp)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (booleanp warnp))))
+  (let* ((goals       (tactic.skeleton->goals x))
+         (cleanup     (clause.fast-clean-clauses goals))
+         (unprovablep (first cleanup))
+         (progressp   (second cleanup))
+         (new-goals   (third cleanup)))
+    (cond (unprovablep
+           ;; We print this out even if the warnings are off.
+           (ACL2::cw "~s0Cleanup-tac failure~s1: unprovable clause discovered.~%" *red* *black*))
+          ((not progressp)
+           (and warnp
+                (ACL2::cw "~s0Cleanup-tac failure~s1: the goal is already clean.~%" *red* *black*)))
+          (t
+           (tactic.extend-skeleton new-goals 'cleanup nil x)))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.cleanup-tac
+  (implies (and (tactic.cleanup-tac x warnp)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.cleanup-tac x warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cleanup-tac))))
+
+(defthm forcing-tactic.cleanup-okp-of-tactic.cleanup-tac
+  (implies (and (tactic.cleanup-tac x warnp)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.cleanup-okp (tactic.cleanup-tac x warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cleanup-tac tactic.cleanup-okp))))
+
+
+
+
+(defund tactic.cleanup-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.cleanup-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history   (tactic.skeleton->history x))
+         (old-goals (tactic.skeleton->goals history)))
+    (clause.clean-clauses-bldr old-goals proofs)))
+
+(defobligations tactic.cleanup-compile
+  (clause.clean-clauses-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.cleanup-okp tactic.cleanup-compile)))
+
+ (verify-guards tactic.cleanup-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.cleanup-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.cleanup-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.cleanup-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.cleanup-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.cleanup-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.cleanup-compile x proofs))
+                   (clause.clause-list-formulas
+                    (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.cleanup-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.cleanup-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.cleanup-compile)
+                        ))
+            (equal (logic.proof-listp (tactic.cleanup-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/colors.lisp acl2-6.3/books/milawa/ACL2/tactics/colors.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/colors.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/colors.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,47 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; ANSI colors for printing.
+;;
+;; If you don't want colored output, you can redefine these to the empty
+;; string.
+
+(defconst *escape* (ACL2::coerce (list (ACL2::code-char 27)) 'COMMON-LISP::string))
+(defconst *green* (ACL2::concatenate 'COMMON-LISP::string *escape* "[32m"))
+(defconst *purple* (ACL2::concatenate 'COMMON-LISP::string *escape* "[35;1m"))
+(defconst *blue* (ACL2::concatenate 'COMMON-LISP::string *escape* "[34;1m"))
+(defconst *black* (ACL2::concatenate 'COMMON-LISP::string *escape* "[0m"))
+(defconst *red* (ACL2::concatenate 'COMMON-LISP::string *escape* "[31;5;1m"))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/compiler.lisp acl2-6.3/books/milawa/ACL2/tactics/compiler.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/compiler.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/compiler.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,894 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+;; Main Tactics
+(include-book "cleanup")
+(include-book "conditional-eqsubst")
+(include-book "conditional-eqsubst-all")
+(include-book "crewrite-all")
+(include-book "crewrite-first")
+(include-book "elim")
+(include-book "distribute-all")
+(include-book "fertilize")
+(include-book "generalize-all")
+(include-book "generalize-first")
+(include-book "induct")
+(include-book "skip-all")
+(include-book "skip-first")
+(include-book "split-all")
+(include-book "split-first")
+(include-book "urewrite-all")
+(include-book "urewrite-first")
+(include-book "use")
+(include-book "waterfall")
+
+;; World-changing tactics
+(include-book "simple-world-change")
+(include-book "theory-change")
+
+;; Other stuff
+(include-book "world-check")
+
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+;; BOZO move to arith?
+
+(defthm |(< b d) when (= (+ a (+ b c)) d)|
+  (implies (equal (+ a (+ b c)) d)
+           (equal (< b d)
+                  (not (and (zp a)
+                            (zp c))))))
+
+(defthm |(< a c) when (= (+ a b) c)|
+  (implies (equal (+ a b) c)
+           (equal (< a c)
+                  (not (zp b)))))
+
+(defthm |(< b c) when (= (+ a b) c)|
+  (implies (equal (+ a b) c)
+           (equal (< b c)
+                  (not (zp a)))))
+
+
+
+; COMPILING SKELETONS
+;
+; Our tactic interface creates an initial skeleton (which has the original
+; goals to prove) and also records the initial world that was being used at the
+; time these goals were proposed.  Then, as we apply tactics, the skeleton is
+; extended so that the new steps/goals are at the front.  Ultimately we are
+; left with a skeleton whose first step has no outstanding goals.
+;
+; To compile a skeleton, we want to walk from the "front" (the step with no
+; outstanding goals) to the "back" (the step with the original goals).  At each
+; step we are to be given a list of proofs that prove our outstanding goals,
+; and our job is to prove the outstanding goals of the next step.  All of our
+; step compilers are built to fit this framework, so this is mainly a job of
+; gluing them all together.
+;
+; Until the addition of worlds, this was the entire story.  But now things are
+; a little bit more complicated, because we need keep track of the world that
+; was being used at the time the tactic was run.
+;
+; So compiling skeletons is now a two-pass process.
+;
+; In the first pass, we are going to generate a list of worlds that will be
+; used in the second pass.  To do this, we walk the skeleton "backwards" (by
+; doing the computation as the recursion unwinds).  So, we start with the very
+; first skeleton step and assign it the initial world (which the proof building
+; interface will record for us).  As we unwind, we apply the changes that were
+; made to the world (such as enabling or disabling rules, etc.), so that we
+; have the later worlds that were in use on later steps.  The result is a list
+; of worlds that were used during the proof.  To keep this list small, we do
+; not repeat the world for skeleton steps that don't change it, e.g., the
+; application of most tactics.
+;
+; Finally, once we have generated the list of worlds that were to be used at
+; each step, we then do the regular front-to-back walk of the skeleton, at each
+; step compiling the proofs that are the goals for the next step.  The use of
+; world indexes, which are incremented by each world changing step, allows us
+; to find the proper world to use during each tactic.
+
+(defund tactic.world-stepp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((tacname (tactic.skeleton->tacname x)))
+    (or (equal tacname 'simple-change-world)
+        (equal tacname 'e/d)
+        (equal tacname 'create-theory)
+        (equal tacname 'restrict)
+        (equal tacname 'update-noexec)
+        (equal tacname 'cheapen)
+        )))
+
+(defthm booleanp-of-tactic.world-stepp
+  (equal (booleanp (tactic.world-stepp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.world-stepp))))
+
+
+
+(defund tactic.world-step-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((tacname (tactic.skeleton->tacname x)))
+    (cond ((equal tacname 'simple-change-world)  (tactic.simple-change-world-okp x))
+          ((equal tacname 'e/d)                  (tactic.e/d-okp x))
+          ((equal tacname 'create-theory)        (tactic.create-theory-okp x))
+          ((equal tacname 'restrict)             (tactic.restrict-okp x))
+          ((equal tacname 'update-noexec)        (tactic.update-noexec-okp x))
+          ((equal tacname 'cheapen)              (tactic.cheapen-okp x))
+          (t                                     t))))
+
+(defthm booleanp-of-tactic.world-step-okp
+  (equal (booleanp (tactic.world-step-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.world-step-okp))))
+
+(defund tactic.worlds-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (and (tactic.world-step-okp x)
+       (or (not (tactic.skeleton->tacname x))
+           (tactic.worlds-okp (tactic.skeleton->history x)))))
+
+
+
+
+;; Our skeleton compiler takes a list of worlds.  This is where we generate
+;; that list.
+
+(defund tactic.compile-worlds-step (x world)
+  ;; World is the initial world before we take this step.  We produce the new
+  ;; world which should be used after the step.
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.worldp world)
+                              (tactic.world-step-okp x))
+                  :guard-hints (("Goal" :in-theory (enable tactic.world-step-okp)))))
+  (let ((tacname (tactic.skeleton->tacname x)))
+    (cond ((equal tacname 'simple-change-world) (tactic.simple-change-world-compile-world x world))
+          ((equal tacname 'e/d)                 (tactic.e/d-compile-world x world))
+          ((equal tacname 'create-theory)       (tactic.create-theory-compile-world x world))
+          ((equal tacname 'restrict)            (tactic.restrict-compile-world x world))
+          ((equal tacname 'update-noexec)       (tactic.update-noexec-compile-world x world))
+          ((equal tacname 'cheapen)             (tactic.cheapen-compile-world x world))
+          (t
+           ;; Many tactics don't change the world.  This makes it so that we
+           ;; don't have to bother listing them.
+           world))))
+
+(defthm tactic.worldp-of-tactic.compile-worlds-step
+  (implies (force (and (tactic.skeletonp x)
+                       (tactic.worldp world)
+                       (tactic.world-step-okp x)))
+           (equal (tactic.worldp (tactic.compile-worlds-step x world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.compile-worlds-step
+                                    tactic.world-step-okp))))
+
+(defthm tactic.world-atblp-of-tactic.compile-worlds-step
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.skeletonp x)
+                       (tactic.worldp world)
+                       (tactic.world-step-okp x)))
+           (equal (tactic.world-atblp (tactic.compile-worlds-step x world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.compile-worlds-step
+                                    tactic.world-step-okp))))
+
+(defthm tactic.world-env-okp-of-tactic.compile-worlds-step
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (tactic.skeletonp x)
+                       (tactic.world-step-okp x)))
+           (equal (tactic.world-env-okp (tactic.compile-worlds-step x world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.compile-worlds-step
+                                    tactic.world-step-okp))))
+
+(defthm tactic.world->index-of-tactic.compile-worlds-step
+  (implies (and (tactic.world-stepp x)
+                (tactic.worldp world))
+           (equal (tactic.world->index (tactic.compile-worlds-step x world))
+                  (+ 1 (tactic.world->index world))))
+  :hints(("Goal" :in-theory (enable tactic.world-stepp
+                                    tactic.compile-worlds-step
+                                    tactic.simple-change-world-compile-world
+                                    tactic.update-noexec-compile-world
+                                    tactic.create-theory-compile-world
+                                    tactic.e/d-compile-world
+                                    tactic.restrict-compile-world
+                                    tactic.cheapen-compile-world
+                                    ))))
+
+
+
+(defund tactic.compile-worlds (x initial-world)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.worldp initial-world)
+                              (tactic.worlds-okp x))
+                  :verify-guards nil))
+  (if (not (tactic.skeleton->tacname x))
+      (list initial-world)
+    (if (tactic.world-stepp x)
+        (let* ((prev-worlds (tactic.compile-worlds (tactic.skeleton->history x)
+                                                   initial-world))
+               (prev-world  (car prev-worlds)))
+          (cons (tactic.compile-worlds-step x prev-world)
+                prev-worlds))
+      (tactic.compile-worlds (tactic.skeleton->history x) initial-world))))
+
+(defthm consp-of-tactic.compile-worlds
+  (equal (consp (tactic.compile-worlds x world))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.compile-worlds))))
+
+(defthm tactic.world-listp-of-tactic.compile-worlds
+  (implies (force (and (tactic.worldp world)
+                       (tactic.skeletonp x)
+                       (tactic.worlds-okp x)))
+           (equal (tactic.world-listp (tactic.compile-worlds x world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.compile-worlds
+                                    tactic.worlds-okp))))
+
+(defthm tactic.world-list-atblp-of-tactic.compile-worlds
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (tactic.skeletonp x)
+                       (tactic.worlds-okp x)))
+           (equal (tactic.world-list-atblp (tactic.compile-worlds x world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.compile-worlds
+                                    tactic.worlds-okp))))
+
+(defthm tactic.world-list-env-okp-of-tactic.compile-worlds
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (tactic.skeletonp x)
+                       (tactic.worlds-okp x)))
+           (equal (tactic.world-list-env-okp (tactic.compile-worlds x world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.compile-worlds
+                                    tactic.worlds-okp))))
+
+
+
+(defund tactic.skeleton-step-okp (x worlds)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds))
+                  :export
+                  (let ((tacname (tactic.skeleton->tacname x)))
+                    (cond ((not tacname)                            t)
+                          ((equal tacname 'cleanup)                 (tactic.cleanup-okp x))
+                          ((equal tacname 'conditional-eqsubst)     (tactic.conditional-eqsubst-okp x))
+                          ((equal tacname 'conditional-eqsubst-all) (tactic.conditional-eqsubst-all-okp x))
+                          ((equal tacname 'crewrite-all)            (tactic.crewrite-all-okp x worlds))
+                          ((equal tacname 'crewrite-first)          (tactic.crewrite-first-okp x worlds))
+                          ((equal tacname 'elim-first)              (tactic.elim-first-okp x))
+                          ((equal tacname 'elim-all)                (tactic.elim-all-okp x))
+                          ((equal tacname 'distribute-all)          (tactic.distribute-all-okp x))
+                          ((equal tacname 'fertilize)               (tactic.fertilize-okp x))
+                          ((equal tacname 'generalize-all)          (tactic.generalize-all-okp x))
+                          ((equal tacname 'generalize-first)        (tactic.generalize-first-okp x))
+                          ((equal tacname 'induct)                  (tactic.induct-okp x))
+                          ;((equal tacname 'skip-all)                (tactic.skip-all-okp x))
+                          ;((equal tacname 'skip-first)              (tactic.skip-first-okp x))
+                          ((equal tacname 'split-all)               (tactic.split-all-okp x))
+                          ((equal tacname 'split-first)             (tactic.split-first-okp x))
+                          ((equal tacname 'urewrite-all)            (tactic.urewrite-all-okp x worlds))
+                          ((equal tacname 'urewrite-first)          (tactic.urewrite-first-okp x worlds))
+                          ((equal tacname 'use)                     (tactic.use-okp x))
+                          ((equal tacname 'waterfall)               (tactic.waterfall-okp x worlds))
+                          ((tactic.world-stepp x)                   (tactic.world-step-okp x))
+                          (t nil)))))
+  (let ((tacname (tactic.skeleton->tacname x)))
+    (cond ((not tacname)                            t)
+          ((equal tacname 'cleanup)                 (tactic.cleanup-okp x))
+          ((equal tacname 'conditional-eqsubst)     (tactic.conditional-eqsubst-okp x))
+          ((equal tacname 'conditional-eqsubst-all) (tactic.conditional-eqsubst-all-okp x))
+          ((equal tacname 'crewrite-all)            (tactic.crewrite-all-okp x worlds))
+          ((equal tacname 'crewrite-first)          (tactic.crewrite-first-okp x worlds))
+          ((equal tacname 'elim-first)              (tactic.elim-first-okp x))
+          ((equal tacname 'elim-all)                (tactic.elim-all-okp x))
+          ((equal tacname 'distribute-all)          (tactic.distribute-all-okp x))
+          ((equal tacname 'fertilize)               (tactic.fertilize-okp x))
+          ((equal tacname 'generalize-all)          (tactic.generalize-all-okp x))
+          ((equal tacname 'generalize-first)        (tactic.generalize-first-okp x))
+          ((equal tacname 'induct)                  (tactic.induct-okp x))
+          ((equal tacname 'skip-all)                (tactic.skip-all-okp x))
+          ((equal tacname 'skip-first)              (tactic.skip-first-okp x))
+          ((equal tacname 'split-all)               (tactic.split-all-okp x))
+          ((equal tacname 'split-first)             (tactic.split-first-okp x))
+          ((equal tacname 'urewrite-all)            (tactic.urewrite-all-okp x worlds))
+          ((equal tacname 'urewrite-first)          (tactic.urewrite-first-okp x worlds))
+          ((equal tacname 'use)                     (tactic.use-okp x))
+          ((equal tacname 'waterfall)               (tactic.waterfall-okp x worlds))
+          ((tactic.world-stepp x)                   (tactic.world-step-okp x))
+          (t nil))))
+
+(defund tactic.skeleton-step-env-okp (x worlds axioms thms atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (tactic.skeleton-step-okp x worlds)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.skeleton-step-okp))))
+           (ignore worlds))
+  (let ((tacname (tactic.skeleton->tacname x)))
+    (cond ((equal tacname 'conditional-eqsubst)     (tactic.conditional-eqsubst-env-okp x atbl))
+          ((equal tacname 'conditional-eqsubst-all) (tactic.conditional-eqsubst-all-env-okp x atbl))
+          ((equal tacname 'fertilize)               (tactic.fertilize-env-okp x atbl))
+          ((equal tacname 'generalize-all)          (tactic.generalize-all-env-okp x atbl))
+          ((equal tacname 'generalize-first)        (tactic.generalize-first-env-okp x atbl))
+          ((equal tacname 'induct)                  (tactic.induct-env-okp x atbl))
+          ((equal tacname 'use)                     (tactic.use-env-okp x axioms thms atbl))
+          (t t))))
+
+(defthm booleanp-of-tactic.skeleton-step-okp
+  (equal (booleanp (tactic.skeleton-step-okp x worlds))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.skeleton-step-okp))))
+
+(defthm booleanp-of-tactic.skeleton-step-env-okp
+  (equal (booleanp (tactic.skeleton-step-env-okp x worlds axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.skeleton-step-env-okp))))
+
+
+
+
+(defund tactic.skeleton-length (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (if (tactic.skeleton->tacname x)
+      (+ 1 (tactic.skeleton-length (tactic.skeleton->history x)))
+    1))
+
+(defthm natp-of-tactic.skeleton-length
+  (equal (natp (tactic.skeleton-length x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.skeleton-length))))
+
+(defthm tactic.skeleton-length-zero
+  (equal (equal 0 (tactic.skeleton-length x))
+         nil)
+  :hints(("Goal" :in-theory (enable tactic.skeleton-length))))
+
+(defthm tactic.skeleton-length-one
+  (equal (equal 1 (tactic.skeleton-length x))
+         (not (tactic.skeleton->tacname x)))
+  :hints(("Goal" :in-theory (enable tactic.skeleton-length))))
+
+(defthm tactic.skeleton-length-of-tactic.skeleton->history
+  (implies (tactic.skeleton->tacname x)
+           (equal (tactic.skeleton-length (tactic.skeleton->history x))
+                  (- (tactic.skeleton-length x) 1)))
+  :hints(("Goal" :in-theory (enable tactic.skeleton-length))))
+
+(defund tactic.compile-skeleton-step (x worlds proofs)
+  (declare
+   (xargs
+    :guard (and (tactic.skeletonp x)
+                (tactic.world-listp worlds)
+                (tactic.skeleton-step-okp x worlds)
+                (logic.appeal-listp proofs)
+                (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                       (logic.strip-conclusions proofs)))
+    :guard-hints (("Goal" :in-theory (enable tactic.skeleton-step-okp)))
+    :export
+    (let* ((tacname    (tactic.skeleton->tacname x))
+           (new-proofs (cond ((not tacname)                             proofs)
+
+                             ;; Main tactics
+                             ((equal tacname 'cleanup)                  (tactic.cleanup-compile x proofs))
+                             ((equal tacname 'conditional-eqsubst)      (tactic.conditional-eqsubst-compile x proofs))
+                             ((equal tacname 'conditional-eqsubst-all)  (tactic.conditional-eqsubst-all-compile x proofs))
+                             ((equal tacname 'crewrite-all)             (tactic.crewrite-all-compile x worlds proofs))
+                             ((equal tacname 'crewrite-first)           (tactic.crewrite-first-compile x worlds proofs))
+                             ((equal tacname 'distribute-all)           (tactic.distribute-all-compile x proofs))
+                             ((equal tacname 'elim-first)               (tactic.elim-first-compile x proofs))
+                             ((equal tacname 'elim-all)                 (tactic.elim-all-compile x proofs))
+                             ((equal tacname 'fertilize)                (tactic.fertilize-compile x proofs))
+                             ((equal tacname 'generalize-all)           (tactic.generalize-all-compile x proofs))
+                             ((equal tacname 'generalize-first)         (tactic.generalize-first-compile x proofs))
+                             ((equal tacname 'induct)                   (tactic.induct-compile x proofs))
+                             ;;((equal tacname 'skip-all)                 (tactic.skip-all-compile x proofs))
+                             ;;((equal tacname 'skip-first)               (tactic.skip-first-compile x proofs))
+                             ((equal tacname 'split-all)                (tactic.split-all-compile x proofs))
+                             ((equal tacname 'split-first)              (tactic.split-first-compile x proofs))
+                             ((equal tacname 'urewrite-all)             (tactic.urewrite-all-compile x worlds proofs))
+                             ((equal tacname 'urewrite-first)           (tactic.urewrite-first-compile x worlds proofs))
+                             ((equal tacname 'use)                      (tactic.use-compile x proofs))
+                             ((equal tacname 'waterfall)                (tactic.waterfall-compile x worlds proofs))
+
+                             ((tactic.world-stepp x)                    proofs)
+                             (t nil))))
+      new-proofs)))
+  (let* ((tacname    (tactic.skeleton->tacname x))
+         (new-proofs
+          (ACL2::prog2$
+           (ACL2::cw! "; Compiling skeleton step #~x0: ~x1.~|" (tactic.skeleton-length x) tacname)
+           (cond ((not tacname)                             proofs)
+
+                 ;; Main tactics
+                 ((equal tacname 'cleanup)                  (tactic.cleanup-compile x proofs))
+                 ((equal tacname 'conditional-eqsubst)      (tactic.conditional-eqsubst-compile x proofs))
+                 ((equal tacname 'conditional-eqsubst-all)  (tactic.conditional-eqsubst-all-compile x proofs))
+                 ((equal tacname 'crewrite-all)             (tactic.crewrite-all-compile x worlds proofs))
+                 ((equal tacname 'crewrite-first)           (tactic.crewrite-first-compile x worlds proofs))
+                 ((equal tacname 'distribute-all)           (tactic.distribute-all-compile x proofs))
+                 ((equal tacname 'elim-first)               (tactic.elim-first-compile x proofs))
+                 ((equal tacname 'elim-all)                 (tactic.elim-all-compile x proofs))
+                 ((equal tacname 'fertilize)                (tactic.fertilize-compile x proofs))
+                 ((equal tacname 'generalize-all)           (tactic.generalize-all-compile x proofs))
+                 ((equal tacname 'generalize-first)         (tactic.generalize-first-compile x proofs))
+                 ((equal tacname 'induct)                   (tactic.induct-compile x proofs))
+                 ((equal tacname 'skip-all)                 (tactic.skip-all-compile x proofs))
+                 ((equal tacname 'skip-first)               (tactic.skip-first-compile x proofs))
+                 ((equal tacname 'split-all)                (tactic.split-all-compile x proofs))
+                 ((equal tacname 'split-first)              (tactic.split-first-compile x proofs))
+                 ((equal tacname 'urewrite-all)             (tactic.urewrite-all-compile x worlds proofs))
+                 ((equal tacname 'urewrite-first)           (tactic.urewrite-first-compile x worlds proofs))
+                 ((equal tacname 'use)                      (tactic.use-compile x proofs))
+                 ((equal tacname 'waterfall)                (tactic.waterfall-compile x worlds proofs))
+
+                 ((tactic.world-stepp x)                    proofs)
+                 (t nil)))))
+    (ACL2::prog2$
+     (ACL2::cw! "; Finishing ~x0.  Incremental Cost: ~s1.  Total cost: ~s2~|"
+                tacname
+                (STR::pretty-number (- (unbounded-rank new-proofs)
+                                       (unbounded-rank proofs)))
+                (STR::pretty-number (unbounded-rank new-proofs)))
+     new-proofs)))
+
+(defobligations tactic.compile-skeleton-step
+  (tactic.cleanup-compile
+   tactic.conditional-eqsubst-compile
+   tactic.conditional-eqsubst-compile-all
+   tactic.crewrite-all-compile
+   tactic.crewrite-first-compile
+   tactic.distribute-all-compile
+   tactic.elim-first-compile
+   tactic.elim-all-compile
+   tactic.fertilize-compile
+   tactic.generalize-all-compile
+   tactic.generalize-first-compile
+   tactic.induct-compile
+   tactic.skip-all-compile
+   tactic.skip-first-compile
+   tactic.split-all-compile
+   tactic.split-first-compile
+   tactic.urewrite-all-compile
+   tactic.urewrite-first-compile
+   tactic.use-compile
+   tactic.waterfall-compile
+   ))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.skeleton-step-okp
+                           tactic.skeleton-step-env-okp
+                           tactic.compile-skeleton-step
+                           tactic.world-stepp
+                           tactic.world-step-okp
+                           )))
+
+ (defthm forcing-logic.appeal-listp-of-tactic.compile-skeleton-step
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.skeleton-step-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.compile-skeleton-step x worlds proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.compile-skeleton-step
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.skeleton-step-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.compile-skeleton-step x worlds proofs))
+                   (if (tactic.skeleton->tacname x)
+                       (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x)))
+                     (clause.clause-list-formulas (tactic.skeleton->goals x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.compile-skeleton-step
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.skeleton-step-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-step-env-okp x worlds axioms thms atbl)
+                        (tactic.skeleton-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (tactic.world-list-atblp worlds atbl)
+                        (tactic.world-list-env-okp worlds axioms thms)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'ord< atbl)) 2)
+                        (equal (cdr (lookup 'ordp atbl)) 1)
+                        (equal (cdr (lookup 'car atbl)) 1)
+                        (equal (cdr (lookup 'cdr atbl)) 1)
+                        (equal (cdr (lookup 'consp atbl)) 1)
+                        (equal (cdr (lookup 'cons atbl)) 2)
+                        (@obligations tactic.compile-skeleton-step)))
+            (equal (logic.proof-listp (tactic.compile-skeleton-step x worlds proofs) axioms thms atbl)
+                   t))))
+
+
+
+(defund tactic.skeleton-okp (x worlds)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds))))
+  (if (tactic.skeleton->tacname x)
+      (and (tactic.skeleton-step-okp x worlds)
+           (tactic.skeleton-okp (tactic.skeleton->history x) worlds))
+    t))
+
+(defthm booleanp-of-tactic.skeleton-okp
+  (equal (booleanp (tactic.skeleton-okp x worlds))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.skeleton-okp))))
+
+
+
+(defund tactic.skeleton-env-okp (x worlds axioms thms atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (tactic.skeleton-okp x worlds)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.skeleton-okp)))))
+  (if (tactic.skeleton->tacname x)
+      (and (tactic.skeleton-step-env-okp x worlds axioms thms atbl)
+           (tactic.skeleton-env-okp (tactic.skeleton->history x) worlds axioms thms atbl))
+    t))
+
+(defthm booleanp-of-tactic.skeleton-env-okp
+  (equal (booleanp (tactic.skeleton-env-okp x worlds axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.skeleton-env-okp))))
+
+
+
+
+(defund tactic.compile-skeleton (x worlds proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (tactic.skeleton-okp x worlds)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (if (not (tactic.skeleton->tacname x))
+      proofs
+    (tactic.compile-skeleton (tactic.skeleton->history x) worlds
+                             (tactic.compile-skeleton-step x worlds proofs))))
+
+(defobligations tactic.compile-skeleton
+  (tactic.compile-skeleton-step))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.skeleton-okp
+                           tactic.skeleton-env-okp
+                           tactic.compile-skeleton)))
+
+ (verify-guards tactic.compile-skeleton
+                :hints(("Goal" :do-not-induct t)))
+
+ (defthm forcing-logic.appeal-listp-of-tactic.compile-skeleton
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.skeleton-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.compile-skeleton x worlds proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.compile-skeleton
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.skeleton-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.compile-skeleton x worlds proofs))
+                   (clause.clause-list-formulas (tactic.original-conclusions x))))
+   :hints(("Goal" :in-theory (enable tactic.original-conclusions))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.compile-skeleton
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.skeleton-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.skeleton-env-okp x worlds axioms thms atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (tactic.world-list-atblp worlds atbl)
+                        (tactic.world-list-env-okp worlds axioms thms)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'ordp atbl)) 1)
+                        (equal (cdr (lookup 'ord< atbl)) 2)
+                        (equal (cdr (lookup 'car atbl)) 1)
+                        (equal (cdr (lookup 'cdr atbl)) 1)
+                        (equal (cdr (lookup 'consp atbl)) 1)
+                        (equal (cdr (lookup 'cons atbl)) 2)
+                        (@obligations tactic.compile-skeleton)))
+            (equal (logic.proof-listp (tactic.compile-skeleton x worlds proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+;; The high-level version of our skeleton compiler is kind of strange.  Note
+;; that the low-level one produces a list of proofs, and we have never
+;; redefined a function that produces a list of proofs before.
+;;
+;; In practice, the obligations of the skeleton are always a singleton list for
+;; %autoprove and %prove events.  But in %admit, we sometimes have termination
+;; obligations which are put into multiple goals.
+;;
+;; One solution to this, which would be fairly nice, would be to change the
+;; way admission obligations are done, and basically "and" together all of the
+;; obligations into a single formula.  Then, there would always be only one
+;; formula for each skeleton.
+;;
+;; We use perhaps a worse alternative, which is to create a separate "skeleton
+;; step" for each obligation in the skeleton.  The bad part of this if a skeleton
+;; proves F1, F2, ..., FN, then we have to check the whole skeleton N times.
+;;
+;; As mentioned, N != 1 only when we are admitting functions, and usually those
+;; are not bad proofs.  So, for now we just accept that.  If it ever becomes
+;; a problem, we should switch the way termination obligations are handled.
+
+(defund tactic.compile-skeleton-okp (x worlds axioms thms atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (tactic.world-listp worlds)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'tactic.compile-skeleton)
+         (acl2::time$ (tactic.skeletonp extras))
+         (acl2::time$ (tactic.skeleton-okp extras worlds))
+         (acl2::time$ (tactic.fast-skeleton-atblp extras atbl))
+         (acl2::time$ (tactic.skeleton-env-okp extras worlds axioms thms atbl))
+         (memberp conclusion
+                  (clause.clause-list-formulas (tactic.original-conclusions extras)))
+         (equal (logic.strip-conclusions subproofs)
+                (clause.clause-list-formulas (tactic.skeleton->goals extras))))))
+
+(defthm booleanp-of-tactic.compile-skeleton-okp
+  (equal (booleanp (tactic.compile-skeleton-okp x worlds axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.compile-skeleton-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+;; Funny to make a list of same-typed, same-subproofs, same-extras appeals, but
+;; I guess that's what we want.
+(defprojection :list (logic.appeal-list method x subproofs extras)
+               :element (logic.appeal method x subproofs extras)
+               :guard (and (symbolp method)
+                           (logic.formula-listp x)
+                           (logic.appeal-listp subproofs)
+                           (true-listp subproofs)))
+
+(defund tactic.compile-skeleton-high (x worlds proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (tactic.skeleton-okp x worlds)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs))))
+           (ignore worlds))
+  (logic.appeal-list 'tactic.compile-skeleton
+                     (clause.clause-list-formulas (tactic.original-conclusions x))
+                     (list-fix proofs)
+                     x))
+
+
+;; Just to show that tactic.compile-skeleton-high works as expected, we introduce
+;; this notion.
+
+(deflist tactic.compile-skeleton-list-okp (x worlds axioms thms atbl)
+  (tactic.compile-skeleton-okp x worlds axioms thms atbl)
+  :guard (and (logic.appeal-listp x)
+              (tactic.world-listp worlds)
+              (logic.formula-listp axioms)
+              (logic.formula-listp thms)
+              (logic.arity-tablep atbl)))
+
+(defthm tactic.compile-skeleton-list-okp-of-logic.appeal-list
+  (implies (force (and (symbolp method)
+                       (logic.formula-listp conclusions)
+                       (logic.appeal-listp subproofs)
+                       (true-listp subproofs)
+                       (mapp atbl)
+                       ))
+           (equal (tactic.compile-skeleton-list-okp
+                   (logic.appeal-list method conclusions subproofs extras)
+                   worlds axioms thms atbl)
+                  (or
+                   (not (consp conclusions))
+                   (and
+                    (equal method 'tactic.compile-skeleton)
+                    (tactic.skeletonp extras)
+                    (tactic.skeleton-okp extras worlds)
+                    (tactic.skeleton-atblp extras atbl)
+                    (tactic.skeleton-env-okp extras worlds axioms thms atbl)
+                    (subsetp conclusions (clause.clause-list-formulas (tactic.original-conclusions extras)))
+                    (equal (logic.strip-conclusions subproofs)
+                           (clause.clause-list-formulas (tactic.skeleton->goals extras)))))))
+  :hints(("Goal"
+          :in-theory (enable tactic.compile-skeleton-okp)
+          :induct (cdr-induction conclusions))))
+
+(defthm tactic.compile-skeleton-list-okp-of-tactic.compile-skeleton-high
+  (implies (and (tactic.skeletonp x)
+                (tactic.world-listp worlds)
+                (tactic.skeleton-okp x worlds)
+                (logic.appeal-listp proofs)
+                (mapp atbl)
+                (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                       (logic.strip-conclusions proofs))
+                ;; -----
+                ;; hrmn, non-guard things that need to hold.
+                (tactic.skeleton-atblp x atbl)
+                (tactic.skeleton-env-okp x worlds axioms thms atbl)
+                )
+           (equal (tactic.compile-skeleton-list-okp
+                   (tactic.compile-skeleton-high x worlds proofs)
+                   worlds axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.compile-skeleton-high))))
+
+
+
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.compile-skeleton-okp)))
+
+ (defthm tactic.compile-skeleton-okp-of-logic.appeal-identity
+   (equal (tactic.compile-skeleton-okp (logic.appeal-identity x) worlds axioms thms atbl)
+          (tactic.compile-skeleton-okp x worlds axioms thms atbl))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-1-for-soundness-of-tactic.compile-skeleton-okp
+   (implies (and (tactic.compile-skeleton-okp x worlds axioms thms atbl)
+                 (logic.appealp x)
+                 (mapp atbl)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (tactic.world-listp worlds)
+                 (tactic.world-list-atblp worlds atbl)
+                 (tactic.world-list-env-okp worlds axioms thms))
+            (equal (logic.conclusion
+                    (let* ((skelly     (logic.extras x))
+                           (in-proofs  (logic.provable-list-witness
+                                        (logic.strip-conclusions (logic.subproofs x))
+                                        axioms thms atbl))
+                           (out-proofs (tactic.compile-skeleton skelly worlds in-proofs)))
+                      (logic.find-proof (logic.conclusion x) out-proofs)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-tactic.compile-skeleton-okp
+   (implies (and (tactic.compile-skeleton-okp x worlds axioms thms atbl)
+                 (logic.appealp x)
+                 (mapp atbl)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (tactic.world-listp worlds)
+                 (tactic.world-list-atblp worlds atbl)
+                 (tactic.world-list-env-okp worlds axioms thms)
+                 (equal (cdr (lookup 'if atbl)) 3)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'ordp atbl)) 1)
+                 (equal (cdr (lookup 'ord< atbl)) 2)
+                 (equal (cdr (lookup 'car atbl)) 1)
+                 (equal (cdr (lookup 'cdr atbl)) 1)
+                 (equal (cdr (lookup 'consp atbl)) 1)
+                 (equal (cdr (lookup 'cons atbl)) 2)
+                 (@obligations tactic.compile-skeleton))
+            (equal (logic.proofp
+                    (let* ((skelly     (logic.extras x))
+                           (in-proofs  (logic.provable-list-witness
+                                        (logic.strip-conclusions (logic.subproofs x))
+                                        axioms thms atbl))
+                           (out-proofs (tactic.compile-skeleton skelly worlds in-proofs)))
+                      (logic.find-proof (logic.conclusion x) out-proofs))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-tactic.compile-skeleton-okp
+   (implies (and (tactic.compile-skeleton-okp x worlds axioms thms atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (mapp atbl)
+                             (tactic.world-listp worlds)
+                             (tactic.world-list-atblp worlds atbl)
+                             (tactic.world-list-env-okp worlds axioms thms)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'ordp atbl)) 1)
+                             (equal (cdr (lookup 'ord< atbl)) 2)
+                             (equal (cdr (lookup 'car atbl)) 1)
+                             (equal (cdr (lookup 'cdr atbl)) 1)
+                             (equal (cdr (lookup 'consp atbl)) 1)
+                             (equal (cdr (lookup 'cons atbl)) 2)
+                             (@obligations tactic.compile-skeleton))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :use ((:instance lemma-1-for-soundness-of-tactic.compile-skeleton-okp)
+                  (:instance lemma-2-for-soundness-of-tactic.compile-skeleton-okp)
+                  (:instance forcing-logic.provablep-when-logic.proofp
+                             (x (let* ((skelly     (logic.extras x))
+                                       (in-proofs  (logic.provable-list-witness
+                                                    (logic.strip-conclusions (logic.subproofs x))
+                                                    axioms thms atbl))
+                                       (out-proofs (tactic.compile-skeleton skelly worlds in-proofs)))
+                                  (logic.find-proof (logic.conclusion x) out-proofs)))))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/conditional-eqsubst-all.lisp acl2-6.3/books/milawa/ACL2/tactics/conditional-eqsubst-all.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/conditional-eqsubst-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/conditional-eqsubst-all.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,420 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "conditional-eqsubst")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund tactic.conditional-eqsubst-all-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'conditional-eqsubst-all)
+         (tuplep 3 extras)
+         (let ((hypterm    (first extras))
+               (lhs        (second extras))
+               (rhs        (third extras))
+               (orig-goals (tactic.skeleton->goals history)))
+           (and (logic.termp hypterm)
+                (logic.termp lhs)
+                (logic.termp rhs)
+                (let ((correctness-of-subst (list (logic.function 'not (list hypterm))
+                                                  (logic.function 'equal (list lhs rhs))))
+                      (subst-is-applicable  (multicons hypterm orig-goals))
+                      (post-subst-goals     (logic.replace-subterm-list-list orig-goals lhs rhs)))
+                  (equal goals (cons correctness-of-subst
+                                     (app subst-is-applicable post-subst-goals)))))))))
+
+(defund tactic.conditional-eqsubst-all-env-okp (x atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.conditional-eqsubst-all-okp x)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.conditional-eqsubst-all-okp)))))
+  (let* ((extras  (tactic.skeleton->extras x))
+         (hypterm (first extras))
+         (lhs     (second extras))
+         (rhs     (third extras)))
+    (and (logic.term-atblp hypterm atbl)
+         (logic.term-atblp lhs atbl)
+         (logic.term-atblp rhs atbl))))
+
+(defthm booleanp-of-tactic.conditional-eqsubst-all-okp
+  (equal (booleanp (tactic.conditional-eqsubst-all-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.conditional-eqsubst-all-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm booleanp-of-tactic.conditional-eqsubst-all-env-okp
+  (equal (booleanp (tactic.conditional-eqsubst-all-env-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.conditional-eqsubst-all-env-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+;; (local (defthm forcing-logic.term-list-listp-of-multicons
+;;          (implies (force (and (logic.termp a)
+;;                               (logic.term-list-listp x)))
+;;                   (equal (logic.term-list-listp (multicons a x))
+;;                          t))
+;;          :hints(("Goal" :induct (cdr-induction x)))))
+
+(local (defthm forcing-logic.term-list-list-atblp-of-multicons
+         (implies (force (and (logic.term-atblp a atbl)
+                              (logic.term-list-list-atblp x atbl)))
+                  (equal (logic.term-list-list-atblp (multicons a x) atbl)
+                         t))
+         :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+
+(defund tactic.conditional-eqsubst-all-tac (x hypterm lhs rhs warnp)
+  ;; Replace occurrences of expr with var, a new variable
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.termp hypterm)
+                              (logic.termp lhs)
+                              (logic.termp rhs)
+                              (booleanp warnp))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (and warnp
+             (ACL2::cw "~s0Conditional-eqsubst-all-tac failure~s1: all clauses have already been proven.~%" *red* *black*))
+      (let* ((correctness-of-subst (list (logic.function 'not (list hypterm))
+                                         (logic.function 'equal (list lhs rhs))))
+             (subst-is-applicable  (multicons hypterm goals))
+             (post-subst-goals     (logic.replace-subterm-list-list goals lhs rhs)))
+        (tactic.extend-skeleton (cons correctness-of-subst (fast-app subst-is-applicable post-subst-goals))
+                                'conditional-eqsubst-all
+                                (list hypterm lhs rhs)
+                                x)))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.conditional-eqsubst-all-tac
+  (implies (and (tactic.conditional-eqsubst-all-tac x hypterm lhs rhs warnp)
+                (force (logic.termp hypterm))
+                (force (logic.termp lhs))
+                (force (logic.termp rhs))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.conditional-eqsubst-all-tac x hypterm lhs rhs warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.conditional-eqsubst-all-tac))))
+
+(defthm forcing-tactic.conditional-eqsubst-all-okp-of-tactic.conditional-eqsubst-all-tac
+  (implies (and (tactic.conditional-eqsubst-all-tac x hypterm lhs rhs warnp)
+                (force (logic.termp hypterm))
+                (force (logic.termp lhs))
+                (force (logic.termp rhs))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.conditional-eqsubst-all-okp (tactic.conditional-eqsubst-all-tac x hypterm lhs rhs warnp))
+                  t))
+  :hints(("Goal" :in-theory (e/d (tactic.conditional-eqsubst-all-tac
+                                  tactic.conditional-eqsubst-all-okp)))))
+
+(defthm forcing-tactic.conditional-eqsubst-all-env-okp-of-tactic.conditional-eqsubst-all-tac
+  (implies (and (tactic.conditional-eqsubst-all-tac x hypterm lhs rhs warnp)
+                (force (logic.term-atblp hypterm atbl))
+                (force (logic.term-atblp lhs atbl))
+                (force (logic.term-atblp rhs atbl))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.conditional-eqsubst-all-env-okp (tactic.conditional-eqsubst-all-tac x hypterm lhs rhs warnp) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.conditional-eqsubst-all-tac
+                                    tactic.conditional-eqsubst-all-env-okp))))
+
+
+
+(defund tactic.conditional-eqsubst-list-bldr (p orig-goals proof1 proofs2 proofs3 lhs rhs)
+  (declare (xargs :guard (and (logic.formulap p)
+                              (logic.term-list-listp orig-goals)
+                              (cons-listp orig-goals)
+                              (logic.appealp proof1)
+                              (logic.appeal-listp proofs2)
+                              (logic.appeal-listp proofs3)
+                              (logic.termp lhs)
+                              (logic.termp rhs)
+                              (equal (logic.conclusion proof1) (logic.por p (logic.pequal lhs rhs)))
+                              (equal (logic.strip-conclusions proofs2)
+                                     (logic.por-list (repeat (logic.pnot p) (len orig-goals))
+                                                     (clause.clause-list-formulas orig-goals)))
+                              (equal (logic.strip-conclusions proofs3)
+                                     (clause.clause-list-formulas (logic.replace-subterm-list-list orig-goals lhs rhs))))))
+  (if (consp orig-goals)
+      (cons (tactic.conditional-eqsubst-bldr p (car orig-goals) proof1 (car proofs2) (car proofs3) lhs rhs)
+            (tactic.conditional-eqsubst-list-bldr p (cdr orig-goals) proof1 (cdr proofs2) (cdr proofs3) lhs rhs))
+    nil))
+
+(defobligations tactic.conditional-eqsubst-list-bldr
+  (tactic.conditional-eqsubst-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.conditional-eqsubst-list-bldr)))
+
+ (defthm forcing-logic.appeal-listp-of-tactic.conditional-eqsubst-list-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-list-listp orig-goals)
+                        (cons-listp orig-goals)
+                        (logic.appealp proof1)
+                        (logic.appeal-listp proofs2)
+                        (logic.appeal-listp proofs3)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (equal (logic.conclusion proof1) (logic.por p (logic.pequal lhs rhs)))
+                        (equal (logic.strip-conclusions proofs2)
+                               (logic.por-list (repeat (logic.pnot p) (len orig-goals))
+                                               (clause.clause-list-formulas orig-goals)))
+                        (equal (logic.strip-conclusions proofs3)
+                               (clause.clause-list-formulas (logic.replace-subterm-list-list orig-goals lhs rhs)))))
+            (equal (logic.appeal-listp (tactic.conditional-eqsubst-list-bldr p orig-goals proof1 proofs2 proofs3 lhs rhs))
+                   t))
+   :hints(("Goal" :induct (cdr-cdr-cdr-induction orig-goals proofs2 proofs3))))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.conditional-eqsubst-list-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-list-listp orig-goals)
+                        (cons-listp orig-goals)
+                        (logic.appealp proof1)
+                        (logic.appeal-listp proofs2)
+                        (logic.appeal-listp proofs3)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (equal (logic.conclusion proof1) (logic.por p (logic.pequal lhs rhs)))
+                        (equal (logic.strip-conclusions proofs2)
+                               (logic.por-list (repeat (logic.pnot p) (len orig-goals))
+                                               (clause.clause-list-formulas orig-goals)))
+                        (equal (logic.strip-conclusions proofs3)
+                               (clause.clause-list-formulas (logic.replace-subterm-list-list orig-goals lhs rhs)))))
+            (equal (logic.strip-conclusions (tactic.conditional-eqsubst-list-bldr p orig-goals proof1 proofs2 proofs3 lhs rhs))
+                   (clause.clause-list-formulas orig-goals)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.conditional-eqsubst-list-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-list-listp orig-goals)
+                        (cons-listp orig-goals)
+                        (logic.appealp proof1)
+                        (logic.appeal-listp proofs2)
+                        (logic.appeal-listp proofs3)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (equal (logic.conclusion proof1) (logic.por p (logic.pequal lhs rhs)))
+                        (equal (logic.strip-conclusions proofs2)
+                               (logic.por-list (repeat (logic.pnot p) (len orig-goals))
+                                               (clause.clause-list-formulas orig-goals)))
+                        (equal (logic.strip-conclusions proofs3)
+                               (clause.clause-list-formulas (logic.replace-subterm-list-list orig-goals lhs rhs)))
+                        ;; ---
+                        (logic.term-list-list-atblp orig-goals atbl)
+                        (logic.proofp proof1 axioms thms atbl)
+                        (logic.proof-listp proofs2 axioms thms atbl)
+                        (logic.proof-listp proofs3 axioms thms atbl)
+                        (@obligations tactic.conditional-eqsubst-list-bldr)))
+            (equal (logic.proof-listp (tactic.conditional-eqsubst-list-bldr p orig-goals proof1 proofs2 proofs3 lhs rhs) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund tactic.conditional-eqsubst-all-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.conditional-eqsubst-all-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras       (tactic.skeleton->extras x))
+         (history      (tactic.skeleton->history x))
+         (orig-goals   (tactic.skeleton->goals history))
+         (hypterm      (first extras))
+         (lhs          (second extras))
+         (rhs          (third extras))
+         (len          (len orig-goals)))
+    (tactic.conditional-eqsubst-list-bldr (logic.pequal hypterm ''nil)
+                                          orig-goals
+                                          (tactic.conditional-eqsubst-lemma1 (car proofs))
+                                          (firstn len (cdr proofs))
+                                          (restn len (cdr proofs))
+                                          lhs
+                                          rhs)))
+
+(defobligations tactic.conditional-eqsubst-all-compile
+  (tactic.conditional-eqsubst-lemma1
+   tactic.conditional-eqsubst-list-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.conditional-eqsubst-all-okp
+                           tactic.conditional-eqsubst-all-env-okp
+                           tactic.conditional-eqsubst-all-compile
+                           logic.term-formula)))
+
+ (local (defthm len-1-when-not-cdr
+          (implies (not (cdr x))
+                   (equal (equal (len x) 1)
+                          (consp x)))
+          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+ (local (defthm crock1
+          (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                          (logic.strip-conclusions proofs))
+                   (equal (logic.conclusion (first proofs))
+                          (logic.disjoin-formulas (logic.term-list-formulas (car goals)))))))
+
+ (local (defthm crock2
+          (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                          (logic.strip-conclusions proofs))
+                   (equal (logic.strip-conclusions (firstn n proofs))
+                          (logic.disjoin-each-formula-list (logic.term-list-list-formulas (firstn n goals)))))
+          :hints(("Goal" :in-theory (enable firstn)))))
+
+ (local (defthm crock3
+          (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                          (logic.strip-conclusions proofs))
+                   (equal (logic.strip-conclusions (restn n proofs))
+                          (logic.disjoin-each-formula-list (logic.term-list-list-formulas (restn n goals)))))
+          :hints(("Goal" :in-theory (enable restn)))))
+
+ (local (defthm crock4
+          (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                          (logic.strip-conclusions proofs))
+                   (equal (logic.strip-conclusions (firstn n (cdr proofs)))
+                          (logic.disjoin-each-formula-list (logic.term-list-list-formulas (firstn n (cdr goals))))))))
+
+ (local (defthm crock5
+          (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                          (logic.strip-conclusions proofs))
+                   (equal (logic.strip-conclusions (restn n (cdr proofs)))
+                          (logic.disjoin-each-formula-list (logic.term-list-list-formulas (restn n (cdr goals))))))))
+
+ (local (defthm crock6
+          (implies (equal (app a b) x)
+                   (equal (firstn (len a) x)
+                          (list-fix a)))))
+
+ (local (defthm crock7
+          (implies (equal (app a b) x)
+                   (equal (restn (len a) x)
+                          (list-fix b)))))
+
+ (local (defthm crock8
+          (implies (equal (app a (app b c)) x)
+                   (equal (firstn (len b) (restn (len a) x))
+                          (list-fix b)))))
+
+ (local (defthm crock9
+          (implies (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                          (logic.strip-conclusions proofs))
+                   (equal (consp proofs)
+                          (consp goals)))))
+
+ (local (defthm crock10
+          (implies (EQUAL (APP (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))) Y)
+                          (CDR (TACTIC.SKELETON->GOALS X)))
+                   (EQUAL (FIRSTN (LEN (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X)))
+                                  (CDR (TACTIC.SKELETON->GOALS X)))
+                          (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X))
+                                     (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X)))))
+          :hints(("Goal" :use ((:instance crock6
+                                          (a (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))))
+                                          (b y)
+                                          (x (CDR (TACTIC.SKELETON->GOALS X)))))))))
+
+ (local (defthm crock11
+          (implies (EQUAL (APP (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))) Y)
+                          (CDR (TACTIC.SKELETON->GOALS X)))
+                   (EQUAL (RESTN (LEN (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X)))
+                                 (CDR (TACTIC.SKELETON->GOALS X)))
+                          (list-fix Y)))
+          :hints(("Goal" :use ((:instance crock7
+                                          (a (MULTICONS (FIRST (TACTIC.SKELETON->EXTRAS X)) (TACTIC.SKELETON->GOALS (TACTIC.SKELETON->HISTORY X))))
+                                          (b y)
+                                          (x (CDR (TACTIC.SKELETON->GOALS X)))))))))
+
+ (local (defthm stupid
+          (implies (cons-listp x)
+                   (LOGIC.ALL-DISJUNCTIONSP (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (MULTICONS a x)))))
+          :hints(("Goal" :induct (cdr-induction x)))))
+
+ (local (defthm stupid2
+          (implies (cons-listp x)
+                   (equal (LOGIC.VLHSES (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (MULTICONS a x))))
+                          (repeat (logic.term-formula a) (len x))))
+          :hints(("Goal" :induct (cdr-induction x)))))
+
+ (local (defthm stupid3
+          (implies (cons-listp x)
+                   (equal (LOGIC.VRHSES (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (MULTICONS a x))))
+                          (logic.disjoin-each-formula-list (logic.term-list-list-formulas x))))
+          :hints(("Goal" :induct (cdr-induction x)))))
+
+ (defthm forcing-logic.appeal-listp-of-tactic.conditional-eqsubst-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.conditional-eqsubst-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.conditional-eqsubst-all-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.conditional-eqsubst-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.conditional-eqsubst-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.conditional-eqsubst-all-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.conditional-eqsubst-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.conditional-eqsubst-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.conditional-eqsubst-all-env-okp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.conditional-eqsubst-all-compile)))
+            (equal (logic.proof-listp (tactic.conditional-eqsubst-all-compile x proofs) axioms thms atbl)
+                   t)))
+
+ (verify-guards tactic.conditional-eqsubst-all-compile))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/conditional-eqsubst.lisp acl2-6.3/books/milawa/ACL2/tactics/conditional-eqsubst.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/conditional-eqsubst.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/conditional-eqsubst.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,450 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Conditional Equal Substitution Tactic
+;;
+;; This tactic allows you to use a conditional equality to split a goal into
+;; three goals.  Given an alleged equality of the form:
+;;
+;;    hypterm -> (equal lhs rhs)
+;;
+;; We split the current goal, L1 v ... v Ln, into three new subgoals:
+;;
+;;    (1) (not hypterm) v (equal lhs rhs)      "correctness of substitution"
+;;    (2) hypterm v L1 v ... v Ln              "applicability of substitution"
+;;    (3) L1/[lhs<-rhs] v ... v Ln[lhs<-rhs]   "post substitution goal"
+;;
+;; Why is this a sound thing to do?
+;;
+;;   a. From the proof of (1), we can prove the following for each Li (by the
+;;      disjoined replace subterm builder):
+;;
+;;          (not hypterm) v Li = Li/[lhs<-rhs]
+;;
+;;   b. From the proof of (3), we can prove (using simple expansion):
+;;
+;;          (not hypterm) v L1/[lhs<-rhs] v ... v Ln/[lhs<-rhs]
+;;
+;;   c. From a and b, we can prove (by the disjoined update clause builder):
+;;
+;;          (not hypterm) v L1 v ... v Ln
+;;
+;;   d. From c and the proof of (2), we can prove (using cut and contraction):
+;;
+;;          L1 v ... v Ln
+;;
+;; Which was our original goal, and hence what we needed to prove.  Together
+;; with generalization, this tactic allows us to implement destructor
+;; elimination.  For example, suppose we want to prove:
+;;
+;;   (implies (and (consp x)
+;;                 (foo (car x))
+;;                 (bar (cdr x)))
+;;            (baz x y))
+;;
+;; Then we will invoke the equal substitution tactic using:
+;;
+;;    hypterm = (consp x)
+;;    lhs     = x
+;;    rhs     = (cons (car x) (cdr x))
+;;
+;; This generates three new goals.  First, to defend the correctness of our
+;; substitution, we need to show:
+;;
+;;    (1) (implies (consp x) (equal x (cons (car x) (cdr x))))
+;;
+;; This ought to be trivial using the axioms about conses.  Next, we need to
+;; show that the substitution is applicable to the current goal.  This is the
+;; following implication:
+;;
+;;    (2) (implies (and (not (consp x))
+;;                      (consp x)
+;;                      (foo (car x))
+;;                      (bar (cdr x)))
+;;                 (baz x y))
+;;
+;; Obviously that's easy to prove since we now have contradictory hyps.  But
+;; if (consp x) wasn't one of our assumptions to begin with, we might have had
+;; to do some work to prove it.  Finally, we have the more interesting subgoal:
+;;
+;;    (3) (implies (and (consp (cons (car x) (cdr x)))
+;;                      (foo (car (cons (car x) (cdr x))))
+;;                      (bar (cdr (cons (car x) (cdr x)))))
+;;                 (baz (cons (car x) (cdr x)) y))
+;;
+;; At this point, (car x) and (cdr x) would need to be generalized, giving us:
+;;
+;;   (3') (implies (and (consp (cons x1 x2))
+;;                      (foo (car (cons x1 x2)))
+;;                      (bar (cdr (cons x1 x2))))
+;;                 (baz (cons x1 x2) y))
+;;
+;; And now simple unconditional rewriting should immediately yield:
+;;
+;;  (3'') (implies (and (foo x1)
+;;                      (bar x2))
+;;                 (baz (cons x1 x2) y))
+;;
+;; Which is what I'd expect from car-cdr-elim.
+
+(defund tactic.conditional-eqsubst-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'conditional-eqsubst)
+         (tuplep 3 extras)
+         (let ((hypterm    (first extras))
+               (lhs        (second extras))
+               (rhs        (third extras))
+               (prev-goals (tactic.skeleton->goals history)))
+           (and (logic.termp hypterm)
+                (logic.termp lhs)
+                (logic.termp rhs)
+                (consp prev-goals)
+                (let ((new-goal1     (first goals))
+                      (new-goal2     (second goals))
+                      (new-goal3     (third goals))
+                      (other-goals   (cdr (cdr (cdr goals))))
+                      (original-goal (car prev-goals)))
+                  (and (equal new-goal1 (list (logic.function 'not (list hypterm))
+                                              (logic.function 'equal (list lhs rhs))))
+                       (equal new-goal2 (cons hypterm original-goal))
+                       (equal new-goal3 (logic.replace-subterm-list original-goal lhs rhs))
+                       (equal other-goals (cdr prev-goals)))))))))
+
+(defund tactic.conditional-eqsubst-env-okp (x atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.conditional-eqsubst-okp x)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.conditional-eqsubst-okp)))))
+  (let* ((extras  (tactic.skeleton->extras x))
+         (hypterm (first extras))
+         (lhs     (second extras))
+         (rhs     (third extras)))
+    (and (logic.term-atblp hypterm atbl)
+         (logic.term-atblp lhs atbl)
+         (logic.term-atblp rhs atbl))))
+
+(defthm booleanp-of-tactic.conditional-eqsubst-okp
+  (equal (booleanp (tactic.conditional-eqsubst-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.conditional-eqsubst-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm booleanp-of-tactic.conditional-eqsubst-env-okp
+  (equal (booleanp (tactic.conditional-eqsubst-env-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.conditional-eqsubst-env-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.conditional-eqsubst-tac (x hypterm lhs rhs)
+  ;; Replace occurrences of expr with var, a new variable
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.termp hypterm)
+                              (logic.termp lhs)
+                              (logic.termp rhs))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0Conditional-eqsubst-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let* ((original-goal (car goals))
+             (new-goal1     (list (logic.function 'not (list hypterm))
+                                  (logic.function 'equal (list lhs rhs))))
+             (new-goal2     (cons hypterm original-goal))
+             (new-goal3     (logic.replace-subterm-list original-goal lhs rhs)))
+        (tactic.extend-skeleton (cons new-goal1 (cons new-goal2 (cons new-goal3 (cdr goals))))
+                                'conditional-eqsubst
+                                (list hypterm lhs rhs)
+                                x)))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.conditional-eqsubst-tac
+  (implies (and (tactic.conditional-eqsubst-tac x hypterm lhs rhs)
+                (force (logic.termp hypterm))
+                (force (logic.termp lhs))
+                (force (logic.termp rhs))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.conditional-eqsubst-tac x hypterm lhs rhs))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.conditional-eqsubst-tac))))
+
+(defthm forcing-tactic.conditional-eqsubst-okp-of-tactic.conditional-eqsubst-tac
+  (implies (and (tactic.conditional-eqsubst-tac x hypterm lhs rhs)
+                (force (logic.termp hypterm))
+                (force (logic.termp lhs))
+                (force (logic.termp rhs))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.conditional-eqsubst-okp (tactic.conditional-eqsubst-tac x hypterm lhs rhs))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.conditional-eqsubst-tac
+                                    tactic.conditional-eqsubst-okp))))
+
+(defthm forcing-tactic.conditional-eqsubst-env-okp-of-tactic.conditional-eqsubst-tac
+  (implies (and (tactic.conditional-eqsubst-tac x hypterm lhs rhs)
+                (force (logic.term-atblp hypterm atbl))
+                (force (logic.term-atblp lhs atbl))
+                (force (logic.term-atblp rhs atbl))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.conditional-eqsubst-env-okp (tactic.conditional-eqsubst-tac x hypterm lhs rhs) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.conditional-eqsubst-tac
+                                    tactic.conditional-eqsubst-env-okp))))
+
+
+
+
+
+;; Why is this a sound thing to do?
+;;
+;;   a. From the proof of (1), we can prove the following for each Li (by the
+;;      disjoined replace subterm builder):
+;;
+;;          (not hypterm) v Li = Li/[lhs<-rhs]
+;;
+;;   b. From the proof of (3), we can prove (using simple expansion):
+;;
+;;          (not hypterm) v L1/[lhs<-rhs] v ... v Ln/[lhs<-rhs]
+;;
+;;   c. From a and b, we can prove (by the disjoined update clause builder):
+;;
+;;          (not hypterm) v L1 v ... v Ln
+;;
+;;   d. From c and the proof of (2), we can prove (using cut and contraction):
+;;
+;;          L1 v ... v Ln
+
+(defderiv tactic.conditional-eqsubst-lemma1
+  :derive (v (= (? hyp) nil) (= (? a) (? b)))
+  :from   ((proof x (v (!= (not (? hyp)) nil) (!= (equal (? a) (? b)) nil))))
+  :proof  (@derive
+           ((v (!= (not (? hyp)) nil) (!= (equal (? a) (? b)) nil))   (@given x))
+           ((v (!= (not (? hyp)) nil) (= (equal (? a) (? b)) t))      (build.disjoined-equal-t-from-not-nil @-))
+           ((v (!= (not (? hyp)) nil) (= (? a) (? b)))                (build.disjoined-pequal-from-equal @-))
+           ((v (= (? a) (? b)) (!= (not (? hyp)) nil))                (build.commute-or @-))
+           ((v (= (? a) (? b)) (= (? hyp) nil))                       (build.disjoined-pequal-nil-from-negative-lit @-))
+           ((v (= (? hyp) nil) (= (? a) (? b)))                       (build.commute-or @-))))
+
+(defund tactic.conditional-eqsubst-bldr (p orig-goal proof1 proof2 proof3 lhs rhs)
+  (declare (xargs :guard (and (logic.formulap p)
+                              (logic.term-listp orig-goal)
+                              (consp orig-goal)
+                              (logic.appealp proof1)
+                              (logic.appealp proof2)
+                              (logic.appealp proof3)
+                              (logic.termp lhs)
+                              (logic.termp rhs)
+                              (equal (logic.conclusion proof1) (logic.por p (logic.pequal lhs rhs)))
+                              (equal (logic.conclusion proof2) (logic.por (logic.pnot p) (clause.clause-formula orig-goal)))
+                              (equal (logic.conclusion proof3) (clause.clause-formula (logic.replace-subterm-list orig-goal lhs rhs))))))
+
+
+  (let* (;; P v L1 = L1/[lhs<-rhs]; ...; P v Ln = Ln/[lhs<-rhs]
+         (line-1 (build.disjoined-replace-subterm-list orig-goal lhs rhs proof1))
+         ;; P v L1/[lhs<-rhs] v ... v Ln/[lhs<-rhs]
+         (line-2 (build.expansion P proof3))
+         ;; P v L1 v ... v Ln
+         (line-3 (clause.disjoined-update-clause-bldr (logic.replace-subterm-list orig-goal lhs rhs) line-2 line-1))
+         ;; (L1 v ... v Ln) v (L1 v ... v Ln)
+         (line-4 (build.cut line-3 proof2))
+         ;; (L1 v ... v Ln)
+         (line-5 (build.contraction line-4)))
+    line-5))
+
+(defobligations tactic.conditional-eqsubst-bldr
+  (build.disjoined-replace-subterm-list
+   build.expansion
+   clause.disjoined-update-clause-bldr
+   build.cut
+   build.contraction))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.conditional-eqsubst-bldr)))
+
+ (defthm tactic.conditional-eqsubst-bldr-under-iff
+   (iff (tactic.conditional-eqsubst-bldr p orig-goal proof1 proof2 proof3 lhs rhs)
+        t))
+
+ (defthm forcing-logic.appealp-of-tactic.conditional-eqsubst-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-listp orig-goal)
+                        (consp orig-goal)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (logic.appealp proof3)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (equal (logic.conclusion proof1) (logic.por p (logic.pequal lhs rhs)))
+                        (equal (logic.conclusion proof2) (logic.por (logic.pnot p) (clause.clause-formula orig-goal)))
+                        (equal (logic.conclusion proof3) (clause.clause-formula (logic.replace-subterm-list orig-goal lhs rhs)))))
+            (equal (logic.appealp (tactic.conditional-eqsubst-bldr p orig-goal proof1 proof2 proof3 lhs rhs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-tactic.conditional-eqsubst-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-listp orig-goal)
+                        (consp orig-goal)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (logic.appealp proof3)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (equal (logic.conclusion proof1) (logic.por p (logic.pequal lhs rhs)))
+                        (equal (logic.conclusion proof2) (logic.por (logic.pnot p) (clause.clause-formula orig-goal)))
+                        (equal (logic.conclusion proof3) (clause.clause-formula (logic.replace-subterm-list orig-goal lhs rhs)))))
+            (equal (logic.conclusion (tactic.conditional-eqsubst-bldr p orig-goal proof1 proof2 proof3 lhs rhs))
+                   (clause.clause-formula orig-goal)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-tactic.conditional-eqsubst-bldr
+   (implies (force (and (logic.formulap p)
+                        (logic.term-listp orig-goal)
+                        (consp orig-goal)
+                        (logic.appealp proof1)
+                        (logic.appealp proof2)
+                        (logic.appealp proof3)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (equal (logic.conclusion proof1) (logic.por p (logic.pequal lhs rhs)))
+                        (equal (logic.conclusion proof2) (logic.por (logic.pnot p) (clause.clause-formula orig-goal)))
+                        (equal (logic.conclusion proof3) (clause.clause-formula (logic.replace-subterm-list orig-goal lhs rhs)))
+                        ;; ---
+                        (logic.term-list-atblp orig-goal atbl)
+                        (logic.proofp proof1 axioms thms atbl)
+                        (logic.proofp proof2 axioms thms atbl)
+                        (logic.proofp proof3 axioms thms atbl)
+                        (@obligations tactic.conditional-eqsubst-bldr)))
+            (equal (logic.proofp (tactic.conditional-eqsubst-bldr p orig-goal proof1 proof2 proof3 lhs rhs) axioms thms atbl)
+                   t))))
+
+
+
+(defund tactic.conditional-eqsubst-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.conditional-eqsubst-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras       (tactic.skeleton->extras x))
+         (history      (tactic.skeleton->history x))
+         (orig-goal    (car (tactic.skeleton->goals history)))
+         (hypterm      (first extras))
+         (lhs          (second extras))
+         (rhs          (third extras)))
+    (cons (tactic.conditional-eqsubst-bldr (logic.pequal hypterm ''nil)
+                                           orig-goal
+                                           (tactic.conditional-eqsubst-lemma1 (first proofs))
+                                           (second proofs)
+                                           (third proofs)
+                                           lhs rhs)
+          (cdr (cdr (cdr proofs))))))
+
+(defobligations tactic.conditional-eqsubst-compile
+  (tactic.conditional-eqsubst-lemma1
+   tactic.conditional-eqsubst-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.conditional-eqsubst-okp
+                           tactic.conditional-eqsubst-env-okp
+                           tactic.conditional-eqsubst-compile
+                           logic.term-formula)))
+
+ (local (defthm crock
+          (implies (equal (clause.clause-list-formulas goals) (logic.strip-conclusions proofs))
+                   (equal (logic.conclusion (first proofs))
+                          (clause.clause-formula (first goals))))))
+
+ (local (defthm crock2
+          (implies (equal (clause.clause-list-formulas goals) (logic.strip-conclusions proofs))
+                   (equal (logic.conclusion (second proofs))
+                          (clause.clause-formula (second goals))))))
+
+ (local (defthm crock3
+          (implies (equal (clause.clause-list-formulas goals) (logic.strip-conclusions proofs))
+                   (equal (logic.conclusion (third proofs))
+                          (clause.clause-formula (third goals))))))
+
+ (local (defthm len-1-when-not-cdr
+          (implies (not (cdr x))
+                   (equal (equal (len x) 1)
+                          (consp x)))
+          :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+ (verify-guards tactic.conditional-eqsubst-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.conditional-eqsubst-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.conditional-eqsubst-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.conditional-eqsubst-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.conditional-eqsubst-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.conditional-eqsubst-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.conditional-eqsubst-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.conditional-eqsubst-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.conditional-eqsubst-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.conditional-eqsubst-env-okp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.conditional-eqsubst-compile)))
+            (equal (logic.proof-listp (tactic.conditional-eqsubst-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/crewrite-all.lisp acl2-6.3/books/milawa/ACL2/tactics/crewrite-all.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/crewrite-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/crewrite-all.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,244 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "worldp")
+(include-book "crewrite-world")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(local (defthm logic.strip-conclusions-of-restn
+         ;; BOZO this seems to address some of the firstn/restn issues.  Move it where it
+         ;; belongs and try using it globally.
+         (equal (logic.strip-conclusions (restn n x))
+                (restn n (logic.strip-conclusions x)))))
+
+(local (in-theory (disable restn-of-logic.strip-conclusions)))
+
+(local (ACL2::theory-invariant (ACL2::incompatible (:rewrite logic.strip-conclusions-of-restn)
+                                                   (:rewrite restn-of-logic.strip-conclusions))))
+
+
+(local (defthm logic.strip-conclusions-of-firstn
+         ;; BOZO this seems to address some of the firstn/restn issues.  Move it where it
+         ;; belongs and try using it globally.
+         (equal (logic.strip-conclusions (firstn n x))
+                (firstn n (logic.strip-conclusions x)))))
+
+(local (in-theory (disable firstn-of-logic.strip-conclusions)))
+
+(local (ACL2::theory-invariant (ACL2::incompatible (:rewrite logic.strip-conclusions-of-firstn)
+                                                   (:rewrite firstn-of-logic.strip-conclusions))))
+
+
+
+
+
+(defund tactic.crewrite-all-okp (x worlds)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds))))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'crewrite-all)
+         (tuplep 2 extras)
+         (let* ((windex    (first extras))
+                (plans     (second extras))
+                (world     (tactic.find-world windex worlds))
+                (old-goals (tactic.skeleton->goals history)))
+           (and world
+                (consp old-goals)
+                (rw.crewrite-clause-plan-listp plans)
+                (rw.crewrite-clause-plan-list-okp plans world)
+                (rw.crewrite-clause-plan-list->progressp plans)
+                (equal old-goals (rw.crewrite-clause-plan-list->clauses plans))
+                (let* ((clauses-prime (rw.crewrite-clause-plan-list->clauses-prime plans))
+                       (fgoals1       (rw.crewrite-clause-plan-list->forced-goals plans))
+                       (fgoals        (remove-duplicates fgoals1))
+                       (fclauses      (clause.make-clauses-from-arbitrary-formulas fgoals)))
+                  (equal goals (fast-app clauses-prime fclauses))))))))
+
+(defthm booleanp-of-tactic.crewrite-all-okp
+  (equal (booleanp (tactic.crewrite-all-okp x worlds))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.crewrite-all-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.crewrite-all-tac (x theoryname fastp world warnp)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.worldp world)
+                              (booleanp warnp))))
+  (let* ((goals      (tactic.skeleton->goals x))
+         (findtheory (lookup theoryname (tactic.world->theories world)))
+         (windex     (tactic.world->index world)))
+    (cond ((not (consp goals))
+           (and warnp
+                (ACL2::cw "~s0crewrite-all-tac failure~s1: all clauses have already been proven.~%" *red* *black*)))
+          ((not findtheory)
+           (and warnp
+                (ACL2::cw "~s0crewrite-all-tac failure~s1: no theory named ~s2 is defined.~%" *red* *black* theoryname)))
+          (t
+           (let* ((plans         (rw.make-crewrite-clause-plan-list goals fastp theoryname world))
+                  (progressp     (rw.crewrite-clause-plan-list->progressp plans)))
+             (if (not progressp)
+                 (and warnp
+                      (ACL2::cw "~s0crewrite-all-tac failure~s1: no progress was made.~%" *red* *black*))
+               (let* ((clauses-prime (rw.crewrite-clause-plan-list->clauses-prime plans))
+                      (fgoals1       (rw.crewrite-clause-plan-list->forced-goals plans))
+                      (fgoals        (remove-duplicates fgoals1))
+                      (fg1-len       (fast-len fgoals1 0))
+                      (fg-len        (fast-len fgoals 0))
+                      (fclauses      (clause.make-clauses-from-arbitrary-formulas fgoals)))
+                 (ACL2::prog2$
+                  (ACL2::prog2$
+                   (ACL2::cw! "; Rewrote ~x0 clauses; ~x1 (+ ~x2 forced) remain.~%"
+                              (fast-len goals 0)
+                              (fast-len clauses-prime 0)
+                              fg-len)
+                   (or (equal fg-len fg1-len)
+                       (ACL2::cw! ";; global forced-duplicates elimination eats ~x0 goals.~%"
+                                  (- fg1-len fg-len))))
+                  (tactic.extend-skeleton (fast-app clauses-prime fclauses)
+                                          'crewrite-all
+                                          (list windex plans)
+                                          x)))))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.crewrite-all-tac
+  (implies (and (tactic.crewrite-all-tac x theoryname fastp world warnp)
+                (force (tactic.skeletonp x))
+                (force (tactic.worldp world)))
+           (equal (tactic.skeletonp (tactic.crewrite-all-tac x theoryname fastp world warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.crewrite-all-tac))))
+
+(defthm forcing-tactic.crewrite-all-okp-of-tactic.crewrite-all-tac
+  (implies (and (tactic.crewrite-all-tac x theoryname fastp world warnp)
+                (force (tactic.worldp world))
+                (force (tactic.world-listp worlds))
+                (force (tactic.skeletonp x))
+                (force (equal world (tactic.find-world (tactic.world->index world) worlds))))
+           (equal (tactic.crewrite-all-okp
+                   (tactic.crewrite-all-tac x theoryname fastp world warnp)
+                   worlds)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.crewrite-all-tac
+                                    tactic.crewrite-all-okp))))
+
+
+
+
+(defund tactic.crewrite-all-compile (x worlds proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (logic.appeal-listp proofs)
+                              (tactic.crewrite-all-okp x worlds)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras               (tactic.skeleton->extras x))
+         (windex               (first extras))
+         (plans                (second extras))
+         (world                (tactic.find-world windex worlds))
+         (clauses-prime        (rw.crewrite-clause-plan-list->clauses-prime plans))
+         (clauses-prime-len    (fast-len clauses-prime 0))
+         (clauses-prime-proofs (firstn clauses-prime-len proofs))
+         (forced-clause-proofs (restn clauses-prime-len proofs))
+         (forced-goals         (remove-duplicates
+                                (rw.crewrite-clause-plan-list->forced-goals plans)))
+         (forced-goal-proofs   (clause.prove-arbitrary-formulas-from-their-clauses
+                                forced-goals forced-clause-proofs)))
+    (rw.crewrite-clause-plan-list-compiler plans world clauses-prime-proofs forced-goal-proofs)))
+
+(defobligations tactic.crewrite-all-compile
+  (rw.crewrite-clause-plan-list-compiler
+   clause.prove-arbitrary-formulas-from-their-clauses))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.crewrite-all-okp
+                           tactic.crewrite-all-compile)))
+
+ (local (ACL2::allow-fertilize t))
+
+ (verify-guards tactic.crewrite-all-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.crewrite-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.crewrite-all-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.crewrite-all-compile x worlds proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.crewrite-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.crewrite-all-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.crewrite-all-compile x worlds proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.crewrite-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.crewrite-all-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.world-list-atblp worlds atbl)
+                        (tactic.world-list-env-okp worlds axioms thms)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.crewrite-all-compile)))
+            (equal (logic.proof-listp (tactic.crewrite-all-compile x worlds proofs) axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/crewrite-first.lisp acl2-6.3/books/milawa/ACL2/tactics/crewrite-first.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/crewrite-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/crewrite-first.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,252 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "worldp")
+(include-book "crewrite-world")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(local
+ (encapsulate
+  ()
+  (defthm logic.strip-conclusions-of-restn
+    ;; BOZO this seems to address some of the firstn/restn issues.  Move it where it
+    ;; belongs and try using it globally.
+    (equal (logic.strip-conclusions (restn n x))
+           (restn n (logic.strip-conclusions x))))
+
+  (in-theory (disable restn-of-logic.strip-conclusions))
+
+  (ACL2::theory-invariant (ACL2::incompatible (:rewrite logic.strip-conclusions-of-restn)
+                                              (:rewrite restn-of-logic.strip-conclusions)))
+
+
+  (defthm logic.strip-conclusions-of-firstn
+    ;; BOZO this seems to address some of the firstn/restn issues.  Move it where it
+    ;; belongs and try using it globally.
+    (equal (logic.strip-conclusions (firstn n x))
+           (firstn n (logic.strip-conclusions x))))
+
+  (in-theory (disable firstn-of-logic.strip-conclusions))
+
+  (ACL2::theory-invariant (ACL2::incompatible (:rewrite logic.strip-conclusions-of-firstn)
+                                              (:rewrite firstn-of-logic.strip-conclusions)))))
+
+
+
+(defund tactic.crewrite-first-okp (x worlds)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds))
+                  :guard-debug t))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'crewrite-first)
+         (let* ((windex (first extras))
+                (plan   (second extras))
+                (world  (tactic.find-world windex worlds)))
+           (and world
+                (rw.crewrite-clause-planp plan)
+                (rw.crewrite-clause-plan-okp plan world)
+                (rw.crewrite-clause-plan->progressp plan)
+                (let ((old-goals (tactic.skeleton->goals history))
+                      (forced-clauses (clause.make-clauses-from-arbitrary-formulas
+                                       (rw.crewrite-clause-plan->forced-goals plan))))
+                  (and (consp old-goals)
+                       (equal (rw.crewrite-clause-plan->clause plan) (car old-goals))
+                       (equal goals
+                              (if (rw.crewrite-clause-plan->provedp plan)
+                                  (fast-app (cdr old-goals) forced-clauses)
+                                (cons (rw.crewrite-clause-plan->clause-prime plan)
+                                      (fast-app (cdr old-goals) forced-clauses)))))))))))
+
+(defthm booleanp-of-tactic.crewrite-first-okp
+  (equal (booleanp (tactic.crewrite-first-okp x worlds))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.crewrite-first-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+
+(defund tactic.crewrite-first-tac (x theoryname fastp world warnp)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.worldp world)
+                              (booleanp warnp))))
+  (let* ((goals      (tactic.skeleton->goals x))
+         (windex     (tactic.world->index world))
+         (findtheory (lookup theoryname (tactic.world->theories world))))
+    (cond ((not (consp goals))
+           (and warnp
+                (ACL2::cw "~s0crewrite-first-tac failure~s1: all clauses have already been proven.~%" *red* *black*)))
+          ((not findtheory)
+           (and warnp
+                (ACL2::cw "~s0crewrite-first-tac failure~s1: no theory named ~s2 is defined.~%" *red* *black* theoryname)))
+          (t
+           (let* ((plan      (rw.make-crewrite-clause-plan (car goals) fastp theoryname world))
+                  (progressp (rw.crewrite-clause-plan->progressp plan))
+                  (provedp   (rw.crewrite-clause-plan->provedp plan))
+                  (fgoals    (rw.crewrite-clause-plan->forced-goals plan))
+                  (fclauses  (clause.make-clauses-from-arbitrary-formulas fgoals)))
+             (cond ((not progressp)
+                    (ACL2::cw "~s0crewrite-first-tac failure~s1: no progress was made.~%" *red* *black*))
+                   (t
+                    (tactic.extend-skeleton (if provedp
+                                                (app (cdr goals) fclauses)
+                                              (cons (rw.crewrite-clause-plan->clause-prime plan)
+                                                    (app (cdr goals) fclauses)))
+                                            'crewrite-first
+                                            (list windex plan)
+                                            x))))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.crewrite-first-tac
+  (implies (and (tactic.crewrite-first-tac x theoryname fastp world warnp)
+                (force (tactic.skeletonp x))
+                (force (tactic.worldp world)))
+           (equal (tactic.skeletonp (tactic.crewrite-first-tac x theoryname fastp world warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.crewrite-first-tac))))
+
+(defthm forcing-tactic.crewrite-first-okp-of-tactic.crewrite-first-tac
+  (implies (and (tactic.crewrite-first-tac x theoryname fastp world warnp)
+                (force (tactic.worldp world))
+                (force (tactic.world-listp worlds))
+                (force (tactic.skeletonp x))
+                (force (equal world (tactic.find-world (tactic.world->index world) worlds))))
+           (equal (tactic.crewrite-first-okp
+                   (tactic.crewrite-first-tac x theoryname fastp world warnp)
+                   worlds)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.crewrite-first-tac
+                                    tactic.crewrite-first-okp))))
+
+
+
+
+(defund tactic.crewrite-first-compile (x worlds proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (logic.appeal-listp proofs)
+                              (tactic.crewrite-first-okp x worlds)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history        (tactic.skeleton->history x))
+         (old-goals      (tactic.skeleton->goals history))
+         (extras         (tactic.skeleton->extras x))
+         (windex         (first extras))
+         (plan           (second extras))
+         (world          (tactic.find-world windex worlds))
+         (provedp        (rw.crewrite-clause-plan->provedp plan))
+         (fgoals         (rw.crewrite-clause-plan->forced-goals plan))
+         (num-old-proofs (fast-len (cdr old-goals) 0)))
+    (if provedp
+        ;; We need to generate the first proof from scratch
+        (let* ((cdr-old-goals-proofs (firstn num-old-proofs proofs))
+               (forced-proofs        (clause.prove-arbitrary-formulas-from-their-clauses
+                                      fgoals
+                                      (restn num-old-proofs proofs)))
+               (proof1               (rw.crewrite-clause-plan-compiler plan world nil forced-proofs)))
+          (cons proof1 cdr-old-goals-proofs))
+      ;; We need to generate the first proof using an existing proof
+      (let* ((proof1-seed          (car proofs))
+             (cdr-old-goals-proofs (firstn num-old-proofs (cdr proofs)))
+             (forced-proofs        (clause.prove-arbitrary-formulas-from-their-clauses
+                                    fgoals
+                                    (restn num-old-proofs (cdr proofs))))
+             (proof1               (rw.crewrite-clause-plan-compiler plan world proof1-seed
+                                                                     forced-proofs)))
+          (cons proof1 cdr-old-goals-proofs)))))
+
+(defobligations tactic.crewrite-first-compile
+  (rw.crewrite-clause-plan-compiler
+   clause.prove-arbitrary-formulas-from-their-clauses))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.crewrite-first-okp
+                           tactic.crewrite-first-compile)))
+
+ (local (ACL2::allow-fertilize t))
+
+ (verify-guards tactic.crewrite-first-compile
+                :hints(("Goal" :do-not-induct t)))
+
+ (defthm forcing-logic.appeal-listp-of-tactic.crewrite-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.crewrite-first-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.crewrite-first-compile x worlds proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.crewrite-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.crewrite-first-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.crewrite-first-compile x worlds proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.crewrite-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.crewrite-first-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.world-list-atblp worlds atbl)
+                        (tactic.world-list-env-okp worlds axioms thms)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.crewrite-first-compile)))
+            (equal (logic.proof-listp (tactic.crewrite-first-compile x worlds proofs) axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/crewrite-world.lisp acl2-6.3/books/milawa/ACL2/tactics/crewrite-world.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/crewrite-world.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/crewrite-world.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1015 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "rewrite-world") ;; for tactic.world->control, etc.
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+
+;; BOZO move us
+
+(defthm nth-of-cons-when-constantp
+  (implies (syntaxp (acl2::quotep n))
+           (equal (nth n (cons a x))
+                  (if (zp n)
+                      a
+                    (nth (- n 1) x))))
+  :hints(("Goal" :expand (nth n (cons a x)))))
+
+(defthm rw.crewrite-clause-aux-of-nil
+  (equal (rw.crewrite-clause-aux nil done blimit rlimit control n acc)
+         acc)
+  :hints(("Goal" :in-theory (enable rw.crewrite-clause-aux))))
+
+(defthm rw.crewrite-clause-of-nil
+  (equal (rw.crewrite-clause nil blimit rlimit control n)
+         nil)
+  :hints(("Goal" :in-theory (enable rw.crewrite-clause))))
+
+(defthm tactic.world->index-under-iff
+  (implies (force (tactic.worldp x))
+           (iff (tactic.world->index x)
+                t))
+  :hints(("Goal"
+          :in-theory (disable forcing-natp-of-tactic.world->index)
+          :use ((:instance forcing-natp-of-tactic.world->index)))))
+
+(defthm tactic.find-world-of-nil
+  (implies (force (tactic.world-listp worlds))
+           (equal (tactic.find-world nil worlds)
+                  nil))
+  :hints(("Goal"
+          :induct (cdr-induction worlds)
+          :expand (tactic.find-world nil worlds))))
+
+
+
+
+
+;; Clause Rewrite Plans.
+;;
+;; We now develop "plans" which explain how a clause has been rewritten, and
+;; which can be easily and efficiently justified.
+;;
+;; Plans can be either fast or slow.  A fast plan is justified (with a fully
+;; expansive proof) via running the slow rewriter to build the necessary
+;; ccsteps.  A slow plan was produced by using the slow rewriter, and has
+;; the ccsteps to use built in.
+;;
+;; A plan can also be a FAILURE plan, which represents a clause that was not
+;; rewritten successfully.
+
+(defund rw.make-crewrite-clause-plan (clause fastp theoryname world)
+  (declare (xargs :guard (and (consp clause)
+                              (logic.term-listp clause)
+                              (tactic.worldp world))))
+  (if fastp
+      ;; Construct a "fast" plan using the fast crewriter.
+      (let* ((results      (rw.fast-crewrite-clause clause
+                                                    (tactic.world->blimit world)
+                                                    (tactic.world->rlimit world)
+                                                    (tactic.world->control theoryname world)
+                                                    (tactic.world->rwn world)))
+             (provedp      (car results))
+             (clause-prime (if provedp
+                               nil
+                             (second results))))
+        (if (equal (fast-rev clause-prime) clause)
+            (list 'fail clause)
+          (let* ((forced-goals1 (third results))
+                 (forced-goals  (remove-duplicates forced-goals1)))
+            (ACL2::prog2$
+             (or (same-lengthp forced-goals1 forced-goals)
+                 (ACL2::cw! ";; local forced-duplicates elimination eats ~x0 goals.~%"
+                            (- (fast-len forced-goals1 0)
+                               (fast-len forced-goals 0))))
+             (list 'fast
+                   clause
+                   clause-prime
+                   theoryname
+                   forced-goals
+                   nil ;; ccsteps
+                   )))))
+    ;; Construct a "slow" plan using the ordinary crewriter.
+    (let* ((ccsteps (rw.crewrite-clause clause
+                                        (tactic.world->blimit world)
+                                        (tactic.world->rlimit world)
+                                        (tactic.world->control theoryname world)
+                                        (tactic.world->rwn world)))
+           (provedp (rw.ccstep->provedp (car ccsteps)))
+           (clause-prime (if provedp
+                             nil
+                           (rw.ccstep->clause-prime (car ccsteps)))))
+      (if (equal (fast-rev clause-prime) clause)
+          (list 'fail clause)
+        (let* ((forced-goals1 (rw.ccstep-list-forced-goals ccsteps))
+               (forced-goals  (remove-duplicates forced-goals1)))
+          (ACL2::prog2$
+           (or (same-lengthp forced-goals1 forced-goals)
+               (ACL2::cw! ";; local forced-duplicates elimination eats ~x0 goals.~%"
+                          (- (fast-len forced-goals1 0)
+                             (fast-len forced-goals 0))))
+           (list 'slow
+                 clause
+                 clause-prime
+                 theoryname
+                 forced-goals
+                 ccsteps)))))))
+
+(defund rw.crewrite-clause-planp (x)
+  ;; Basic structural well-formedness of plans.
+  (declare (xargs :guard t :verify-guards nil))
+  (and (consp x)
+       (let ((type (car x)))
+         (if (equal type 'fail)
+             ;; Failures are just ('fail <clause>)
+             (and (tuplep 2 x)
+                  (let ((clause (nth 1 x)))
+                    (and (consp clause)
+                         (logic.term-listp clause))))
+           ;; Fast/slow are tuples with (type clause clause-prime theoryname fgoals windex ccsteps)
+           (and (tuplep 6 x)
+                (let ((clause       (nth 1 x))
+                      (clause-prime (nth 2 x))
+                      ;; (theoryname  (nth 3 x))
+                      (forced-goals (nth 4 x))
+                      (ccsteps      (nth 5 x)))
+                  (and
+                   ;; Basic well-formedness for either kind of plan
+                   (consp clause)
+                   (logic.term-listp clause)
+                   (logic.formula-listp forced-goals)
+                   (true-listp forced-goals)
+                   ;; Clause prime is nil if proved, or well-formed
+                   (or (not clause-prime)
+                       (and (consp clause-prime)
+                            (logic.term-listp clause-prime)))
+                   (if (equal type 'fast)
+                       ;; Fast plan need not have ccsteps
+                       (not ccsteps)
+                     ;; Slow plan needs to have ccsteps in agreement with other stuff.
+                     (and (equal type 'slow)
+                          (consp ccsteps)
+                          (rw.ccstep-listp ccsteps)
+                          (equal clause-prime
+                                 (if (rw.ccstep->provedp (car ccsteps))
+                                     nil
+                                   (rw.ccstep->clause-prime (car ccsteps))))
+                          (equal forced-goals
+                                 (remove-duplicates
+                                  (rw.ccstep-list-forced-goals ccsteps))))))))))))
+
+(defund rw.crewrite-clause-plan-okp (x world)
+  ;; Comprehensive, semantic well-formedness check.
+  (declare (xargs :guard (and (rw.crewrite-clause-planp x)
+                              (tactic.worldp world))
+                  :verify-guards nil))
+  (if (equal (car x) 'fail)
+      t
+    (let* ((type         (nth 0 x))
+           (clause       (nth 1 x))
+           (clause-prime (nth 2 x))
+           (theoryname   (nth 3 x))
+           (forced-goals (nth 4 x))
+           (ccsteps      (nth 5 x)))
+      (and world
+           (if (equal type 'fast)
+               ;; Fast steps are right if the clause-prime and forced-goals are
+               ;; right.
+               (let ((results (rw.fast-crewrite-clause clause
+                                                       (tactic.world->blimit world)
+                                                       (tactic.world->rlimit world)
+                                                       (tactic.world->control theoryname world)
+                                                       (tactic.world->rwn world))))
+                 (and (equal clause-prime
+                             (if (first results)
+                                 nil
+                               (second results)))
+                      (equal forced-goals
+                             (remove-duplicates (third results)))))
+             ;; For slow steps, we only need to show that these are the right
+             ;; ccsteps.
+             (equal ccsteps
+                    (rw.crewrite-clause clause
+                                        (tactic.world->blimit world)
+                                        (tactic.world->rlimit world)
+                                        (tactic.world->control theoryname world)
+                                        (tactic.world->rwn world))))))))
+
+(defund rw.crewrite-clause-plan-atblp (x atbl)
+  (declare (xargs :guard (and (rw.crewrite-clause-planp x)
+                              (logic.arity-tablep atbl))
+                  :verify-guards nil))
+  (let ((clause (nth 1 x)))
+    (logic.term-list-atblp clause atbl)))
+
+(defund rw.crewrite-clause-plan->progressp (x)
+  (declare (xargs :guard (rw.crewrite-clause-planp x)
+                  :verify-guards nil))
+  (not (equal (car x) 'fail)))
+
+(defund rw.crewrite-clause-plan->clause (x)
+  (declare (xargs :guard (rw.crewrite-clause-planp x)
+                  :verify-guards nil))
+  (nth 1 x))
+
+(defund rw.crewrite-clause-plan->provedp (x)
+  (declare (xargs :guard (rw.crewrite-clause-planp x)
+                  :verify-guards nil))
+  (and (not (equal (car x) 'fail))
+       (not (nth 2 x))))
+
+(defund rw.crewrite-clause-plan->clause-prime (x)
+  (declare (xargs :guard (and (rw.crewrite-clause-planp x)
+                              (not (rw.crewrite-clause-plan->provedp x)))
+                  :verify-guards nil))
+  (if (equal (car x) 'fail)
+      (nth 1 x)
+    (nth 2 x)))
+
+(defund rw.crewrite-clause-plan->forced-goals (x)
+  (declare (xargs :guard (rw.crewrite-clause-planp x)
+                  :verify-guards nil))
+  (if (equal (car x) 'fail)
+      nil
+    (nth 4 x)))
+
+
+(defund rw.crewrite-clause-plan-compiler (x world proof fproofs)
+  (declare (xargs :guard (and (rw.crewrite-clause-planp x)
+                              (tactic.worldp world)
+                              (rw.crewrite-clause-plan-okp x world)
+                              (if (rw.crewrite-clause-plan->provedp x)
+                                  (not proof)
+                                (and (logic.appealp proof)
+                                     (equal (logic.conclusion proof)
+                                            (clause.clause-formula
+                                             (rw.crewrite-clause-plan->clause-prime x)))))
+                              (logic.appeal-listp fproofs)
+                              (subsetp (rw.crewrite-clause-plan->forced-goals x)
+                                       (logic.strip-conclusions fproofs)))
+                  :verify-guards nil))
+  (let ((type (car x)))
+    (if (equal type 'fail)
+        proof
+      (let* ((clause       (nth 1 x))
+             ;(clause-prime (nth 2 x))
+             (theoryname   (nth 3 x))
+             ;(forced-goals (nth 4 x))
+             (control      (tactic.world->control theoryname world))
+             (blimit       (tactic.world->blimit world))
+             (rlimit       (tactic.world->rlimit world))
+             (rwn          (tactic.world->rwn world))
+             (ccsteps      (if (equal type 'fast)
+                               (ACL2::prog2$
+                                (ACL2::cw "Warning: constructing ccsteps for fast crewrite plan.~%")
+                                (rw.crewrite-clause clause
+                                                    (tactic.world->blimit world)
+                                                    (tactic.world->rlimit world)
+                                                    (tactic.world->control theoryname world)
+                                                    (tactic.world->rwn world)))
+                             (nth 5 x))))
+        (rw.crewrite-clause-bldr clause blimit rlimit control rwn ccsteps
+                                 proof fproofs)))))
+
+(defobligations rw.crewrite-clause-plan-compiler
+  (rw.crewrite-clause-bldr))
+
+
+
+(encapsulate
+ ()
+
+ ;; Ugggggh.... ACL2 is terrible at fertilizing correctly.  We introduce a bunch
+ ;; of free-variable rules to get the job done.  This is so horrible.  Someone
+ ;; really needs to invent a decent way to do this.
+
+ (defthmd lemma-1-for-rw.crewrite-clause-plan
+   (implies (and (equal x (remove-duplicates (rw.ccstep-list-forced-goals y)))
+                 (force (rw.ccstep-listp y)))
+            (equal (logic.formula-listp x)
+                   t)))
+
+ (defthmd lemma-2-for-rw.crewrite-clause-plan
+   (implies (and (equal x (remove-duplicates (rw.ccstep-list-forced-goals y)))
+                 (rw.ccstep-list-forced-goals y))
+            (equal (consp x)
+                   t)))
+
+ (defthmd lemma-3-for-rw.crewrite-clause-plan
+   (implies (equal x (rw.ccstep-list-forced-goals y))
+            (equal (true-listp x)
+                   t)))
+
+ (defthmd lemma-4-for-rw.crewrite-clause-plan
+   (implies (and (equal free (clause.make-clauses-from-arbitrary-formulas formulas))
+                 (force (logic.formula-listp formulas)))
+            (equal (logic.term-list-listp free)
+                   t)))
+
+ (defthmd lemma-5-for-rw.crewrite-clause-plan
+   (implies (and (equal (cdr free) (clause.make-clauses-from-arbitrary-formulas formulas))
+                 (force (logic.formula-listp formulas)))
+            (equal (logic.term-list-listp free)
+                   (logic.term-listp (car free)))))
+
+ (defthmd lemma-6-for-rw.crewrite-clause-plan
+   (implies (and (equal free (rw.ccstep->clause-prime x))
+                 (force (rw.ccstepp x)))
+            (equal (logic.term-listp free)
+                   t)))
+
+ (defthmd lemma-7-for-rw.crewrite-clause-plan
+   (implies (equal free (clause.make-clauses-from-arbitrary-formulas formulas))
+            (equal (cons-listp free)
+                   t)))
+
+ (defthmd lemma-8-for-rw.crewrite-clause-plan
+   (implies (equal (cdr free) (clause.make-clauses-from-arbitrary-formulas formulas))
+            (equal (cons-listp free)
+                   (if (consp free)
+                       (consp (car free))
+                     t))))
+
+ (defthmd lemma-9-for-rw.crewrite-clause-plan
+   (implies (and (equal free (rw.ccstep->clause-prime x))
+                 (force (rw.ccstepp x)))
+            (equal (consp free)
+                   (not (rw.ccstep->provedp x)))))
+
+ (defthmd lemma-10-for-rw.crewrite-clause-plan
+   (implies (equal free (remove-duplicates x))
+            (subsetp x free)))
+
+
+ (defthmd lemma-11-for-rw.crewrite-clause-plan
+   (implies (equal free (remove-duplicates y))
+            (equal (logic.formula-list-atblp free atbl)
+                   (logic.formula-list-atblp y atbl))))
+
+
+ (local (in-theory (enable lemma-1-for-rw.crewrite-clause-plan
+                           lemma-2-for-rw.crewrite-clause-plan
+                           lemma-3-for-rw.crewrite-clause-plan
+                           lemma-4-for-rw.crewrite-clause-plan
+                           lemma-5-for-rw.crewrite-clause-plan
+                           lemma-6-for-rw.crewrite-clause-plan
+                           lemma-7-for-rw.crewrite-clause-plan
+                           lemma-8-for-rw.crewrite-clause-plan
+                           lemma-9-for-rw.crewrite-clause-plan
+                           lemma-10-for-rw.crewrite-clause-plan
+                           lemma-11-for-rw.crewrite-clause-plan
+                           )))
+
+ (local (in-theory (enable rw.make-crewrite-clause-plan
+                           rw.crewrite-clause-planp
+                           rw.crewrite-clause-plan-okp
+                           rw.crewrite-clause-plan-atblp
+                           rw.crewrite-clause-plan->clause
+                           rw.crewrite-clause-plan->provedp
+                           rw.crewrite-clause-plan->clause-prime
+                           rw.crewrite-clause-plan->forced-goals
+                           rw.crewrite-clause-plan-compiler)))
+
+ (verify-guards rw.crewrite-clause-planp)
+ (verify-guards rw.crewrite-clause-plan-atblp)
+ (verify-guards rw.crewrite-clause-plan-okp)
+ (verify-guards rw.crewrite-clause-plan->clause)
+ (verify-guards rw.crewrite-clause-plan->progressp)
+ (verify-guards rw.crewrite-clause-plan->provedp)
+ (verify-guards rw.crewrite-clause-plan->clause-prime)
+ (verify-guards rw.crewrite-clause-plan->forced-goals)
+ (verify-guards rw.crewrite-clause-plan-compiler)
+
+
+ (defthm booleanp-of-rw.crewrite-clause-planp
+   (equal (booleanp (rw.crewrite-clause-planp x))
+          t))
+
+ (defthm booleanp-of-rw.crewrite-clause-plan-okp
+   (equal (booleanp (rw.crewrite-clause-plan-okp x world))
+          t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm booleanp-of-rw.crewrite-clause-plan-atblp
+   (equal (booleanp (rw.crewrite-clause-plan-atblp x atbl))
+          t))
+
+ (defthm consp-of-rw.crewrite-clause-plan->clause-prime
+   (implies (force (and (rw.crewrite-clause-planp x)
+                        (not (rw.crewrite-clause-plan->provedp x))))
+            (equal (consp (rw.crewrite-clause-plan->clause-prime x))
+                   t)))
+
+(defthm logic.term-listp-of-rw.crewrite-clause-plan->clause-prime
+   (implies (force (rw.crewrite-clause-planp x))
+            (equal (logic.term-listp (rw.crewrite-clause-plan->clause-prime x))
+                   t)))
+
+
+(defthm true-listp-of-rw.crewrite-clause-plan->forced-goals
+   (implies (force (rw.crewrite-clause-planp x))
+            (equal (true-listp (rw.crewrite-clause-plan->forced-goals x))
+                   t)))
+
+(defthm logic.formula-listp-of-rw.crewrite-clause-plan->forced-goals
+   (implies (force (rw.crewrite-clause-planp x))
+            (equal (logic.formula-listp (rw.crewrite-clause-plan->forced-goals x))
+                   t)))
+
+(defthm logic.formula-list-atblp-of-rw.crewrite-clause-plan->forced-goals
+   (implies (force (and (rw.crewrite-clause-planp x)
+                        (rw.crewrite-clause-plan-okp x world)
+                        (rw.crewrite-clause-plan-atblp x atbl)
+                        (tactic.worldp world)
+                        (tactic.world-atblp world atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        ))
+            (equal (logic.formula-list-atblp (rw.crewrite-clause-plan->forced-goals x) atbl)
+                   t)))
+
+
+
+
+(defthm rw.crewrite-clause-plan->clause-of-rw.make-crewrite-clause-plan
+   (equal (rw.crewrite-clause-plan->clause (rw.make-crewrite-clause-plan clause fastp theoryname world))
+          clause)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+(defthm rw.crewrite-clause-planp-of-rw.make-crewrite-clause-plan
+   (implies (force (and (consp clause)
+                        (logic.term-listp clause)
+                        (tactic.worldp world)))
+            (equal (rw.crewrite-clause-planp (rw.make-crewrite-clause-plan clause fastp theoryname world))
+                   t)))
+
+ (defthm rw.crewrite-clause-plan-okp-of-rw.make-crewrite-clause-plan
+   (implies (force (and (consp clause)
+                        (logic.term-listp clause)
+                        (tactic.worldp world)))
+            (equal (rw.crewrite-clause-plan-okp
+                    (rw.make-crewrite-clause-plan clause fastp theoryname world)
+                    world)
+                   t)))
+
+ (defthm rw.crewrite-clause-plan-atblp-of-rw.make-crewrite-clause-plan
+   (implies (force (logic.term-list-atblp clause atbl))
+            (equal (rw.crewrite-clause-plan-atblp
+                    (rw.make-crewrite-clause-plan clause fastp theoryname world)
+                    atbl)
+                   t))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart acl2::force)))))
+
+ (defthm logic.appealp-of-rw.crewrite-clause-plan-compiler
+   (implies (force (and (rw.crewrite-clause-planp x)
+                        (tactic.worldp world)
+                        (rw.crewrite-clause-plan-okp x world)
+                        (if (rw.crewrite-clause-plan->provedp x)
+                            (not proof)
+                          (and (logic.appealp proof)
+                               (equal (logic.conclusion proof)
+                                      (clause.clause-formula
+                                       (rw.crewrite-clause-plan->clause-prime x)))))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.crewrite-clause-plan->forced-goals x)
+                                 (logic.strip-conclusions fproofs))))
+            (equal (logic.appealp (rw.crewrite-clause-plan-compiler x world proof fproofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.crewrite-clause-plan-compiler
+   (implies (force (and (rw.crewrite-clause-planp x)
+                        (tactic.worldp world)
+                        (rw.crewrite-clause-plan-okp x world)
+                        (if (rw.crewrite-clause-plan->provedp x)
+                            (not proof)
+                          (and (logic.appealp proof)
+                               (equal (logic.conclusion proof)
+                                      (clause.clause-formula
+                                       (rw.crewrite-clause-plan->clause-prime x)))))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.crewrite-clause-plan->forced-goals x)
+                                 (logic.strip-conclusions fproofs))))
+            (equal (logic.conclusion (rw.crewrite-clause-plan-compiler x world proof fproofs))
+                   (clause.clause-formula (rw.crewrite-clause-plan->clause x)))))
+
+ (defthm@ logic.proofp-of-rw.crewrite-clause-plan-compiler
+   (implies (force (and (rw.crewrite-clause-planp x)
+                        (tactic.worldp world)
+                        (rw.crewrite-clause-plan-okp x world)
+                        (if (rw.crewrite-clause-plan->provedp x)
+                            (not proof)
+                          (and (logic.appealp proof)
+                               (equal (logic.conclusion proof)
+                                      (clause.clause-formula
+                                       (rw.crewrite-clause-plan->clause-prime x)))
+                               ;; ---
+                               (logic.proofp proof axioms thms atbl)
+                               ))
+                        (logic.appeal-listp fproofs)
+                        (subsetp (rw.crewrite-clause-plan->forced-goals x)
+                                 (logic.strip-conclusions fproofs))
+                        ;; ---
+                        (rw.crewrite-clause-plan-atblp x atbl)
+                        (rw.crewrite-clause-plan-okp x world)
+                        (logic.proof-listp fproofs axioms thms atbl)
+                        (tactic.world-atblp world atbl)
+                        (tactic.world-env-okp world axioms thms)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations rw.crewrite-clause-plan-compiler)))
+            (equal (logic.proofp (rw.crewrite-clause-plan-compiler x world proof fproofs)
+                                 axioms thms atbl)
+                   t))))
+
+
+(deflist rw.crewrite-clause-plan-listp (x)
+  (rw.crewrite-clause-planp x)
+  :elementp-of-nil nil)
+
+(deflist rw.crewrite-clause-plan-list-okp (x world)
+  (rw.crewrite-clause-plan-okp x world)
+  :guard (and (rw.crewrite-clause-plan-listp x)
+              (tactic.worldp world)))
+
+(deflist rw.crewrite-clause-plan-list-atblp (x atbl)
+  (rw.crewrite-clause-plan-atblp x atbl)
+  :guard (and (rw.crewrite-clause-plan-listp x)
+              (logic.arity-tablep atbl)))
+
+
+(defprojection
+  ;; Note: redefined in interface/rewrite-tactics to add timing info.
+  :list (rw.make-crewrite-clause-plan-list x fastp theoryname world)
+  :element (rw.make-crewrite-clause-plan x fastp theoryname world)
+  :guard (and (cons-listp x)
+              (logic.term-list-listp x)
+              (tactic.worldp world)))
+
+(defund rw.crewrite-clause-plan-list->progressp (x)
+  (declare (xargs :guard (rw.crewrite-clause-plan-listp x)))
+  (if (consp x)
+      (or (rw.crewrite-clause-plan->progressp (car x))
+          (rw.crewrite-clause-plan-list->progressp (cdr x)))
+    nil))
+
+(defprojection
+  :list (rw.crewrite-clause-plan-list->clauses x)
+  :element (rw.crewrite-clause-plan->clause x)
+  :guard (rw.crewrite-clause-plan-listp x))
+
+(defthm rw.crewrite-clause-plan-list->clauses-of-rw.make-crewrite-clause-plan-list
+  (equal (rw.crewrite-clause-plan-list->clauses
+          (rw.make-crewrite-clause-plan-list x fastp theoryname world))
+         (list-fix x))
+  :hints(("Goal"
+          :induct (cdr-induction x))))
+
+(defund rw.crewrite-clause-plan-list->clauses-prime (x)
+  (declare (xargs :guard (rw.crewrite-clause-plan-listp x)))
+  (if (consp x)
+      (if (rw.crewrite-clause-plan->provedp (car x))
+          (rw.crewrite-clause-plan-list->clauses-prime (cdr x))
+        (cons (rw.crewrite-clause-plan->clause-prime (car x))
+              (rw.crewrite-clause-plan-list->clauses-prime (cdr x))))
+    nil))
+
+(defthm cons-listp-of-rw.crewrite-clause-plan-list->clauses-prime
+  (implies (force (rw.crewrite-clause-plan-listp x))
+           (equal (cons-listp (rw.crewrite-clause-plan-list->clauses-prime x))
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand (rw.crewrite-clause-plan-list->clauses-prime x))))
+
+(defthm logic.term-list-listp-of-rw.crewrite-clause-plan-list->clauses-prime
+  (implies (force (rw.crewrite-clause-plan-listp x))
+           (equal (logic.term-list-listp (rw.crewrite-clause-plan-list->clauses-prime x))
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand (rw.crewrite-clause-plan-list->clauses-prime x))))
+
+
+
+(defund rw.crewrite-clause-plan-list->forced-goals (x)
+  (declare (xargs :guard (rw.crewrite-clause-plan-listp x)))
+  (if (consp x)
+      (revappend (rw.crewrite-clause-plan->forced-goals (car x))
+                 (rw.crewrite-clause-plan-list->forced-goals (cdr x)))
+    nil))
+
+(defthm true-listp-of-rw.crewrite-clause-plan-list->forced-goals
+  (equal (true-listp (rw.crewrite-clause-plan-list->forced-goals x))
+         t)
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand (rw.crewrite-clause-plan-list->forced-goals x))))
+
+(defthm logic.formula-listp-of-rw.crewrite-clause-plan-list->forced-goals
+  (implies (force (rw.crewrite-clause-plan-listp x))
+           (equal (logic.formula-listp (rw.crewrite-clause-plan-list->forced-goals x))
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand (rw.crewrite-clause-plan-list->forced-goals x))))
+
+(defthm logic.formula-list-atblp-of-rw.crewrite-clause-plan-list->forced-goals
+  (implies (force (and (rw.crewrite-clause-plan-listp x)
+                       (rw.crewrite-clause-plan-list-atblp x atbl)
+                       (rw.crewrite-clause-plan-list-okp x world)
+                       (tactic.worldp world)
+                       (tactic.world-atblp world atbl)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (equal (cdr (lookup 'iff atbl)) 2)
+                       (equal (cdr (lookup 'if atbl)) 3)))
+           (equal (logic.formula-list-atblp (rw.crewrite-clause-plan-list->forced-goals x) atbl)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand (rw.crewrite-clause-plan-list->forced-goals x))))
+
+(defthm rw.crewrite-clause-plan-listp-of-rw.make-crewrite-clause-plan-list
+  (implies (force (and (cons-listp x)
+                       (logic.term-list-listp x)
+                       (tactic.worldp world)))
+           (rw.crewrite-clause-plan-listp
+            (rw.make-crewrite-clause-plan-list x fastp theoryname world)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.crewrite-clause-plan-list-okp-of-rw.make-crewrite-clause-plan-list
+  (implies (force (and (cons-listp x)
+                       (logic.term-list-listp x)
+                       (tactic.worldp world)))
+           (equal (rw.crewrite-clause-plan-list-okp
+                   (rw.make-crewrite-clause-plan-list x fastp theoryname world)
+                   world)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rw.crewrite-clause-plan-list-atblp-of-rw.make-crewrite-clause-plan-list
+  (implies (force (logic.term-list-list-atblp x atbl))
+           (equal (rw.crewrite-clause-plan-list-atblp
+                   (rw.make-crewrite-clause-plan-list x fastp theoryname world)
+                    atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defund rw.crewrite-clause-plan-list-compiler (x world proofs fproofs)
+  (declare (xargs :guard (and (rw.crewrite-clause-plan-listp x)
+                              (tactic.worldp world)
+                              (rw.crewrite-clause-plan-list-okp x world)
+                              (logic.appeal-listp proofs)
+                              (logic.appeal-listp fproofs)
+                              (equal (clause.clause-list-formulas
+                                      (rw.crewrite-clause-plan-list->clauses-prime x))
+                                     (logic.strip-conclusions proofs))
+                              (subsetp (rw.crewrite-clause-plan-list->forced-goals x)
+                                       (logic.strip-conclusions fproofs)))
+                  :verify-guards nil))
+  (if (consp x)
+      (if (rw.crewrite-clause-plan->provedp (car x))
+          ;; We proved clause directly; use nil as the input proof.
+          (cons (ACL2::prog2$ (ACL2::cw! ";; Compiling winning rewrite for clause ~x0.~%" (fast-len x 0))
+                              (rw.crewrite-clause-plan-compiler (car x) world nil fproofs))
+                (rw.crewrite-clause-plan-list-compiler (cdr x) world proofs fproofs))
+        ;; We need the input proof.
+        (cons (ACL2::prog2$ (ACL2::cw! ";; Compiling rewrite for clause ~x0.~%" (fast-len x 0))
+                            (rw.crewrite-clause-plan-compiler (car x) world (car proofs) fproofs))
+              (rw.crewrite-clause-plan-list-compiler (cdr x) world (cdr proofs) fproofs)))
+    nil))
+
+(defobligations rw.crewrite-clause-plan-list-compiler
+  (rw.crewrite-clause-plan-compiler))
+
+(verify-guards rw.crewrite-clause-plan-list-compiler
+               :hints(("Goal" :in-theory (enable rw.crewrite-clause-plan-list-compiler
+                                                 rw.crewrite-clause-plan-list->clauses-prime
+                                                 rw.crewrite-clause-plan-list->forced-goals))))
+
+(defthm logic.appeal-listp-of-rw.crewrite-clause-plan-list-compiler
+  (implies (force (and (rw.crewrite-clause-plan-listp x)
+                       (tactic.worldp world)
+                       (rw.crewrite-clause-plan-list-okp x world)
+                       (logic.appeal-listp proofs)
+                       (logic.appeal-listp fproofs)
+                       (equal (clause.clause-list-formulas
+                               (rw.crewrite-clause-plan-list->clauses-prime x))
+                              (logic.strip-conclusions proofs))
+                       (subsetp (rw.crewrite-clause-plan-list->forced-goals x)
+                                (logic.strip-conclusions fproofs))))
+           (equal (logic.appeal-listp
+                   (rw.crewrite-clause-plan-list-compiler x world proofs fproofs))
+                  t))
+  :hints(("Goal"
+          :induct (rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+          :in-theory (enable (:induction rw.crewrite-clause-plan-list-compiler))
+          :expand ((rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+                   (rw.crewrite-clause-plan-list->clauses-prime x)
+                   (rw.crewrite-clause-plan-list->forced-goals x)
+                   ))))
+
+(defthm logic.strip-conclusions-of-rw.crewrite-clause-plan-list-compiler
+  (implies (force (and (rw.crewrite-clause-plan-listp x)
+                       (tactic.worldp world)
+                       (rw.crewrite-clause-plan-list-okp x world)
+                       (logic.appeal-listp proofs)
+                       (logic.appeal-listp fproofs)
+                       (equal (clause.clause-list-formulas
+                               (rw.crewrite-clause-plan-list->clauses-prime x))
+                              (logic.strip-conclusions proofs))
+                       (subsetp (rw.crewrite-clause-plan-list->forced-goals x)
+                                (logic.strip-conclusions fproofs))))
+           (equal (logic.strip-conclusions (rw.crewrite-clause-plan-list-compiler x world proofs fproofs))
+                  (clause.clause-list-formulas
+                   (rw.crewrite-clause-plan-list->clauses x))))
+  :hints(("Goal"
+          :induct (rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+          :in-theory (enable (:induction rw.crewrite-clause-plan-list-compiler))
+          :expand ((rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+                   (rw.crewrite-clause-plan-list->clauses-prime x)
+                   (rw.crewrite-clause-plan-list->forced-goals x)
+                   ))))
+
+(defthm@ logic.proof-listp-of-rw.crewrite-clause-plan-list-compiler
+   (implies (force (and (rw.crewrite-clause-plan-listp x)
+                        (tactic.worldp world)
+                        (rw.crewrite-clause-plan-list-okp x world)
+                        (logic.appeal-listp proofs)
+                        (logic.appeal-listp fproofs)
+                        (equal (clause.clause-list-formulas
+                                (rw.crewrite-clause-plan-list->clauses-prime x))
+                               (logic.strip-conclusions proofs))
+                        (subsetp (rw.crewrite-clause-plan-list->forced-goals x)
+                                 (logic.strip-conclusions fproofs))
+                        ;; ---
+                        (rw.crewrite-clause-plan-list-atblp x atbl)
+                        (rw.crewrite-clause-plan-list-okp x world)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (logic.proof-listp fproofs axioms thms atbl)
+                        (tactic.world-atblp world atbl)
+                        (tactic.world-env-okp world axioms thms)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations rw.crewrite-clause-plan-list-compiler)))
+            (equal (logic.proof-listp (rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+                                      axioms thms atbl)
+                   t))
+    :hints(("Goal"
+          :induct (rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+          :in-theory (enable (:induction rw.crewrite-clause-plan-list-compiler))
+          :expand ((rw.crewrite-clause-plan-list-compiler x world proofs fproofs)
+                   (rw.crewrite-clause-plan-list->clauses-prime x)
+                   (rw.crewrite-clause-plan-list->forced-goals x)
+                   ))))
+
+
+
+(defthm rw.crewrite-clause-plan-atblp-removal
+  (equal (rw.crewrite-clause-plan-atblp plan atbl)
+         (logic.term-list-atblp (rw.crewrite-clause-plan->clause plan) atbl))
+  :hints(("Goal" :in-theory (enable rw.crewrite-clause-plan-atblp
+                                    rw.crewrite-clause-plan->clause))))
+
+
+(defthm rw.crewrite-clause-plan-list-atblp-removal
+  (equal (rw.crewrite-clause-plan-list-atblp x atbl)
+         (logic.term-list-list-atblp (rw.crewrite-clause-plan-list->clauses x) atbl))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((rw.crewrite-clause-plan-list->clauses x)
+                   (rw.crewrite-clause-plan-list-atblp x atbl)))))
+
+
+
+
+
+
+(defthm consp-of-rw.crewrite-clause-plan->clause
+  (implies (rw.crewrite-clause-planp plan)
+           (equal (consp (rw.crewrite-clause-plan->clause plan))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.crewrite-clause-planp
+                                    rw.crewrite-clause-plan->clause))))
+
+(defthm logic.term-listp-of-rw.crewrite-clause-plan->clause
+  (implies (rw.crewrite-clause-planp plan)
+           (equal (logic.term-listp (rw.crewrite-clause-plan->clause plan))
+                  t))
+  :hints(("Goal" :in-theory (enable rw.crewrite-clause-planp
+                                    rw.crewrite-clause-plan->clause))))
+
+
+(defund rw.crewrite-clause-plan-compiler-high (x world proof fproofs)
+  (declare (xargs :guard (and (rw.crewrite-clause-planp x)
+                              (tactic.worldp world)
+                              (rw.crewrite-clause-plan-okp x world)
+                              (if (rw.crewrite-clause-plan->provedp x)
+                                  (not proof)
+                                (and (logic.appealp proof)
+                                     (equal (logic.conclusion proof)
+                                            (clause.clause-formula
+                                             (rw.crewrite-clause-plan->clause-prime x)))))
+                              (logic.appeal-listp fproofs)
+                              (subsetp (rw.crewrite-clause-plan->forced-goals x)
+                                       (logic.strip-conclusions fproofs)))
+                  :guard-hints(("Goal" :in-theory (enable rw.crewrite-clause-planp
+                                                          rw.crewrite-clause-plan->clause)))))
+  (let ((fsubproofs (logic.find-proofs
+                     (rw.crewrite-clause-plan->forced-goals x)
+                     fproofs)))
+    (logic.appeal 'rw.crewrite-clause-plan-compiler
+                  (clause.clause-formula (rw.crewrite-clause-plan->clause x))
+                  (if proof
+                      (cons proof fsubproofs)
+                    fsubproofs)
+                  (list (tactic.world->index world) x))))
+
+(defund rw.crewrite-clause-plan-compiler-okp (x worlds atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (tactic.world-listp worlds)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'rw.crewrite-clause-plan-compiler)
+         (tuplep 2 extras)
+         (let* ((windex  (first extras))
+                (plan    (second extras))
+                (world   (tactic.find-world windex worlds)))
+           (and world
+                ;; Lots of 'fusion'/'deforestation' possibilities here.
+                (rw.crewrite-clause-planp plan)
+                (rw.crewrite-clause-plan-okp plan world)
+                (rw.crewrite-clause-plan-atblp plan atbl)
+                (let ((clause  (rw.crewrite-clause-plan->clause plan))
+                      (provedp (rw.crewrite-clause-plan->provedp plan))
+                      (fgoals  (rw.crewrite-clause-plan->forced-goals plan)))
+                  (and
+                   (equal conclusion (clause.clause-formula clause))
+                   (equal (logic.strip-conclusions subproofs)
+                          (if provedp
+                              fgoals
+                            (cons (clause.clause-formula (rw.crewrite-clause-plan->clause-prime plan))
+                                  fgoals))))))))))
+
+(defthm rw.crewrite-clause-plan-compiler-okp-of-rw.crewrite-clause-plan-compiler-high
+  (implies (and (rw.crewrite-clause-planp x)
+                (tactic.worldp world)
+                (rw.crewrite-clause-plan-okp x world)
+                (if (rw.crewrite-clause-plan->provedp x)
+                    (not proof)
+                  (and (logic.appealp proof)
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula
+                               (rw.crewrite-clause-plan->clause-prime x)))))
+                (logic.appeal-listp fproofs)
+                (subsetp (rw.crewrite-clause-plan->forced-goals x)
+                         (logic.strip-conclusions fproofs))
+                ;; -----
+                ;; hrmn, non-guard things that need to hold.
+                (rw.crewrite-clause-plan-atblp x atbl)
+                (equal (tactic.find-world (TACTIC.WORLD->INDEX WORLD) worlds) world)
+                )
+           (equal (rw.crewrite-clause-plan-compiler-okp
+                   (rw.crewrite-clause-plan-compiler-high x world proof fproofs)
+                   worlds atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable
+                             rw.crewrite-clause-plan-compiler-okp
+                             rw.crewrite-clause-plan-compiler-high))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.crewrite-clause-plan-compiler-okp)))
+
+ (defthm booleanp-of-rw.crewrite-clause-plan-compiler-okp
+   (equal (booleanp (rw.crewrite-clause-plan-compiler-okp x worlds atbl))
+          t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.crewrite-clause-plan-compiler-okp-of-logic.appeal-identity
+   (equal (rw.crewrite-clause-plan-compiler-okp (logic.appeal-identity x) worlds atbl)
+          (rw.crewrite-clause-plan-compiler-okp x worlds atbl))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-1-for-soundness-of-rw.crewrite-clause-plan-compiler-okp
+   (implies (and (rw.crewrite-clause-plan-compiler-okp x worlds atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (tactic.world-listp worlds)
+                 (tactic.world-list-atblp worlds atbl)
+                 (tactic.world-list-env-okp worlds axioms thms))
+            (equal (logic.conclusion
+                    (let* ((plan        (second (logic.extras x)))
+                           (world      (tactic.find-world (first (logic.extras x)) worlds))
+                           (provedp    (rw.crewrite-clause-plan->provedp plan))
+                           (subproofs* (logic.provable-list-witness
+                                        (logic.strip-conclusions (logic.subproofs x))
+                                        axioms thms atbl))
+                           (proof      (if provedp nil (car subproofs*)))
+                           (fproofs    (if provedp subproofs* (cdr subproofs*))))
+                      (rw.crewrite-clause-plan-compiler plan world proof fproofs)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-rw.crewrite-clause-plan-compiler-okp
+   (implies (and (rw.crewrite-clause-plan-compiler-okp x worlds atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (tactic.world-listp worlds)
+                 (tactic.world-list-atblp worlds atbl)
+                 (tactic.world-list-env-okp worlds axioms thms)
+                 (equal (cdr (lookup 'if atbl)) 3)
+                 (equal (cdr (lookup 'not atbl)) 1)
+                 (equal (cdr (lookup 'equal atbl)) 2)
+                 (equal (cdr (lookup 'iff atbl)) 2)
+                 (@obligations rw.crewrite-clause-plan-compiler))
+            (equal (logic.proofp
+                    (let* ((plan        (second (logic.extras x)))
+                           (world      (tactic.find-world (first (logic.extras x)) worlds))
+                           (provedp    (rw.crewrite-clause-plan->provedp plan))
+                           (subproofs* (logic.provable-list-witness
+                                        (logic.strip-conclusions (logic.subproofs x))
+                                        axioms thms atbl))
+                           (proof      (if provedp nil (car subproofs*)))
+                           (fproofs    (if provedp subproofs* (cdr subproofs*))))
+                      (rw.crewrite-clause-plan-compiler plan world proof fproofs))
+                    axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-rw.crewrite-clause-plan-compiler-okp
+   (implies (and (rw.crewrite-clause-plan-compiler-okp x worlds atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (tactic.world-listp worlds)
+                             (tactic.world-list-atblp worlds atbl)
+                             (tactic.world-list-env-okp worlds axioms thms)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (@obligations rw.crewrite-clause-plan-compiler))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :use ((:instance lemma-1-for-soundness-of-rw.crewrite-clause-plan-compiler-okp)
+                  (:instance lemma-2-for-soundness-of-rw.crewrite-clause-plan-compiler-okp)
+                  (:instance forcing-logic.provablep-when-logic.proofp
+                             (x (let* ((plan        (second (logic.extras x)))
+                                       (world      (tactic.find-world (first (logic.extras x)) worlds))
+                                       (provedp    (rw.crewrite-clause-plan->provedp plan))
+                                       (subproofs* (logic.provable-list-witness
+                                                    (logic.strip-conclusions (logic.subproofs x))
+                                                    axioms thms atbl))
+                                       (proof      (if provedp nil (car subproofs*)))
+                                       (fproofs    (if provedp subproofs* (cdr subproofs*))))
+                                  (rw.crewrite-clause-plan-compiler plan world proof fproofs)))))))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/distribute-all.lisp acl2-6.3/books/milawa/ACL2/tactics/distribute-all.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/distribute-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/distribute-all.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,662 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "fertilize")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Distribute All
+;;
+;; In the fertilize tactic, we provide the following capability.  Suppose
+;; (equal t1 t2) is a hypothesis in the clause.  Then, we can replace t1 with
+;; t2 or vice versa everywhere throughout the clause.  We have no good
+;; heuristic for deciding when this is desirable in general, or even which
+;; direction the fertilization should go if we decided we wanted to try it.
+;; However, consider the special cases:
+;;
+;;   (equal var expr)
+;;   (equal expr var)
+;;
+;; Where var does not occur in expr.  Then, we think it is desirable to
+;; entirely eliminate var from the clause, replacing it with expr instead.  We
+;; call this distribution.  ACL2 does this as part of simplification, but has a
+;; much more complicated routine in order to handle equivalence relations.
+;; (See the function "remove-trivial-equivalences", etc.)
+;;
+;; As a special case of fertilization, distribution is easy to justify; we just
+;; reuse the argument there.  The only twist is deciding how to fertilize.
+
+
+
+(defun distribute.type1-literalp (x)
+  ;; We recognize terms of the form (not (equal var expr)) where expr does
+  ;; not contain var.
+  (declare (xargs :guard (logic.termp x)))
+  (and (logic.functionp x)
+       (equal (logic.function-name x) 'not)
+       (equal (len (logic.function-args x)) 1)
+       (let ((body (first (logic.function-args x))))
+         (and (logic.functionp body)
+              (equal (logic.function-name body) 'equal)
+              (equal (len (logic.function-args body)) 2)
+              (let ((var (first (logic.function-args body)))
+                    (expr (second (logic.function-args body))))
+                (and (logic.variablep var)
+                     (not (memberp var (logic.term-vars expr)))))))))
+
+(defthm booleanp-of-distribute.type1-literalp
+  (equal (booleanp (distribute.type1-literalp x))
+         t))
+
+(defun distribute.type1-var (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (distribute.type1-literalp x))
+                  :guard-hints (("Goal" :in-theory (enable distribute.type1-literalp)))))
+  (first (logic.function-args (first (logic.function-args x)))))
+
+(defun distribute.type1-expr (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (distribute.type1-literalp x))
+                  :guard-hints (("Goal" :in-theory (enable distribute.type1-literalp)))))
+  (second (logic.function-args (first (logic.function-args x)))))
+
+(defun distribute.substitute-type1-literal (literal clause)
+  (declare (xargs :guard (and (logic.termp literal)
+                              (distribute.type1-literalp literal)
+                              (logic.term-listp clause)
+                              (memberp literal clause))))
+  (let ((var (distribute.type1-var literal))
+        (expr (distribute.type1-expr literal)))
+    (logic.replace-subterm-list clause var expr)))
+
+(defthm cons-listp-of-distribute.substitute-type1-literal
+  (equal (consp (distribute.substitute-type1-literal literal clause))
+         (consp clause)))
+
+(defthm forcing-logic.term-listp-of-distribute.substitute-type1-literal
+  (implies (force (and (logic.termp literal)
+                       (distribute.type1-literalp literal)
+                       (logic.term-listp clause)))
+           (equal (logic.term-listp (distribute.substitute-type1-literal literal clause))
+                  t)))
+
+(defthm forcing-logic.term-list-atblp-of-distribute.substitute-type1-literal
+  (implies (force (and (logic.termp literal)
+                       (logic.term-atblp literal atbl)
+                       (distribute.type1-literalp literal)
+                       (logic.term-list-atblp clause atbl)))
+           (equal (logic.term-list-atblp (distribute.substitute-type1-literal literal clause) atbl)
+                  t)))
+
+(defun distribute.substitute-type1-literal-bldr (literal clause proof)
+   (declare (xargs :guard (and (logic.termp literal)
+                               (distribute.type1-literalp literal)
+                               (logic.term-listp clause)
+                               (memberp literal clause)
+                               (logic.appealp proof)
+                               (equal (logic.conclusion proof)
+                                      (clause.clause-formula (distribute.substitute-type1-literal literal clause))))))
+   (let ((var (distribute.type1-var literal))
+         (expr (distribute.type1-expr literal)))
+     (tactic.fertilize-bldr var expr clause proof)))
+
+(defobligations distribute.substitute-type1-literal-bldr
+  (tactic.fertilize-bldr))
+
+(defthm distribute.substitute-type1-literal-bldr-under-iff
+  (iff (distribute.substitute-type1-literal-bldr literal clause proof)
+       t))
+
+(defthm forcing-logic.appealp-of-distribute.substitute-type1-literal-bldr
+  (implies (force (and (logic.termp literal)
+                       (distribute.type1-literalp literal)
+                       (logic.term-listp clause)
+                       (memberp literal clause)
+                       (logic.appealp proof)
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (distribute.substitute-type1-literal literal clause)))))
+           (equal (logic.appealp (distribute.substitute-type1-literal-bldr literal clause proof))
+                  t)))
+
+(defthm forcing-logic.conclusion-of-distribute.substitute-type1-literal-bldr
+  (implies (force (and (logic.termp literal)
+                       (distribute.type1-literalp literal)
+                       (logic.term-listp clause)
+                       (memberp literal clause)
+                       (logic.appealp proof)
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (distribute.substitute-type1-literal literal clause)))))
+           (equal (logic.conclusion (distribute.substitute-type1-literal-bldr literal clause proof))
+                  (clause.clause-formula clause)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm@ forcing-logic.proofp-of-distribute.substitute-type1-literal-bldr
+  (implies (force (and (logic.termp literal)
+                       (distribute.type1-literalp literal)
+                       (logic.term-listp clause)
+                       (memberp literal clause)
+                       (logic.appealp proof)
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (distribute.substitute-type1-literal literal clause)))
+                       ;; ---
+                       (logic.term-list-atblp clause atbl)
+                       (logic.term-atblp literal atbl)
+                       (logic.proofp proof axioms thms atbl)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (@obligations distribute.substitute-type1-literal-bldr)))
+           (equal (logic.proofp (distribute.substitute-type1-literal-bldr literal clause proof) axioms thms atbl)
+                  t)))
+
+(in-theory (disable distribute.type1-literalp
+                    distribute.type1-var
+                    distribute.type1-expr
+                    distribute.substitute-type1-literal
+                    distribute.substitute-type1-literal-bldr))
+
+
+
+
+(defun distribute.type2-literalp (x)
+  ;; We recognize terms of the form (not (equal expr var)) where expr does
+  ;; not contain var.
+  (declare (xargs :guard (logic.termp x)))
+  (and (logic.functionp x)
+       (equal (logic.function-name x) 'not)
+       (equal (len (logic.function-args x)) 1)
+       (let ((body (first (logic.function-args x))))
+         (and (logic.functionp body)
+              (equal (logic.function-name body) 'equal)
+              (equal (len (logic.function-args body)) 2)
+              (let ((expr (first (logic.function-args body)))
+                    (var (second (logic.function-args body))))
+                (and (logic.variablep var)
+                     (not (memberp var (logic.term-vars expr)))))))))
+
+(defthm booleanp-of-distribute.type2-literalp
+  (equal (booleanp (distribute.type2-literalp x))
+         t))
+
+(defun distribute.type2-var (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (distribute.type2-literalp x))
+                  :guard-hints (("Goal" :in-theory (enable distribute.type2-literalp)))))
+  (second (logic.function-args (first (logic.function-args x)))))
+
+(defun distribute.type2-expr (x)
+  (declare (xargs :guard (and (logic.termp x)
+                              (distribute.type2-literalp x))
+                  :guard-hints (("Goal" :in-theory (enable distribute.type2-literalp)))))
+  (first (logic.function-args (first (logic.function-args x)))))
+
+(defun distribute.substitute-type2-literal (literal clause)
+  (declare (xargs :guard (and (logic.termp literal)
+                              (distribute.type2-literalp literal)
+                              (logic.term-listp clause)
+                              (memberp literal clause))))
+  (let ((var (distribute.type2-var literal))
+        (expr (distribute.type2-expr literal)))
+    (logic.replace-subterm-list clause var expr)))
+
+(defthm cons-listp-of-distribute.substitute-type2-literal
+  (equal (consp (distribute.substitute-type2-literal literal clause))
+         (consp clause)))
+
+(defthm forcing-logic.term-listp-of-distribute.substitute-type2-literal
+  (implies (force (and (logic.termp literal)
+                       (distribute.type2-literalp literal)
+                       (logic.term-listp clause)))
+           (equal (logic.term-listp (distribute.substitute-type2-literal literal clause))
+                  t)))
+
+(defthm forcing-logic.term-list-atblp-of-distribute.substitute-type2-literal
+  (implies (force (and (logic.termp literal)
+                       (logic.term-atblp literal atbl)
+                       (distribute.type2-literalp literal)
+                       (logic.term-list-atblp clause atbl)))
+           (equal (logic.term-list-atblp (distribute.substitute-type2-literal literal clause) atbl)
+                  t)))
+
+(defun distribute.substitute-type2-literal-bldr (literal clause proof)
+   (declare (xargs :guard (and (logic.termp literal)
+                               (distribute.type2-literalp literal)
+                               (logic.term-listp clause)
+                               (memberp literal clause)
+                               (logic.appealp proof)
+                               (equal (logic.conclusion proof)
+                                      (clause.clause-formula (distribute.substitute-type2-literal literal clause))))))
+   (let ((var (distribute.type2-var literal))
+         (expr (distribute.type2-expr literal)))
+     (tactic.fertilize-bldr var expr clause proof)))
+
+(defobligations distribute.substitute-type2-literal-bldr
+  (tactic.fertilize-bldr))
+
+(defthm distribute.substitute-type2-literal-bldr-under-iff
+  (iff (distribute.substitute-type2-literal-bldr literal clause proof)
+       t))
+
+(defthm forcing-logic.appealp-of-distribute.substitute-type2-literal-bldr
+  (implies (force (and (logic.termp literal)
+                       (distribute.type2-literalp literal)
+                       (logic.term-listp clause)
+                       (memberp literal clause)
+                       (logic.appealp proof)
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (distribute.substitute-type2-literal literal clause)))))
+           (equal (logic.appealp (distribute.substitute-type2-literal-bldr literal clause proof))
+                  t)))
+
+(defthm forcing-logic.conclusion-of-distribute.substitute-type2-literal-bldr
+  (implies (force (and (logic.termp literal)
+                       (distribute.type2-literalp literal)
+                       (logic.term-listp clause)
+                       (memberp literal clause)
+                       (logic.appealp proof)
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (distribute.substitute-type2-literal literal clause)))))
+           (equal (logic.conclusion (distribute.substitute-type2-literal-bldr literal clause proof))
+                  (clause.clause-formula clause)))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm@ forcing-logic.proofp-of-distribute.substitute-type2-literal-bldr
+  (implies (force (and (logic.termp literal)
+                       (distribute.type2-literalp literal)
+                       (logic.term-listp clause)
+                       (memberp literal clause)
+                       (logic.appealp proof)
+                       (equal (logic.conclusion proof)
+                              (clause.clause-formula (distribute.substitute-type2-literal literal clause)))
+                       ;; ---
+                       (logic.term-list-atblp clause atbl)
+                       (logic.term-atblp literal atbl)
+                       (logic.proofp proof axioms thms atbl)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (@obligations distribute.substitute-type2-literal-bldr)))
+           (equal (logic.proofp (distribute.substitute-type2-literal-bldr literal clause proof) axioms thms atbl)
+                  t)))
+
+(in-theory (disable distribute.type2-literalp
+                    distribute.type2-var
+                    distribute.type2-expr
+                    distribute.substitute-type2-literal
+                    distribute.substitute-type2-literal-bldr))
+
+
+
+
+(defund distribute.find-type1-literal (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (if (distribute.type1-literalp (car x))
+          (car x)
+        (distribute.find-type1-literal (cdr x)))
+    nil))
+
+(defthm distribute.type1-literalp-of-distribute.find-type1-literal
+  (equal (distribute.type1-literalp (distribute.find-type1-literal x))
+         (if (distribute.find-type1-literal x)
+             t
+           nil))
+  :hints(("Goal" :in-theory (enable distribute.find-type1-literal))))
+
+(defthm forcing-logic.termp-of-distribute.find-type1-literal
+  (implies (and (distribute.find-type1-literal x)
+                (force (logic.term-listp x)))
+           (equal (logic.termp (distribute.find-type1-literal x))
+                  t))
+  :hints(("Goal" :in-theory (enable distribute.find-type1-literal))))
+
+(defthm memberp-of-distribute.find-type1-literal
+  (implies (distribute.find-type1-literal x)
+           (equal (memberp (distribute.find-type1-literal x) x)
+                  t))
+  :hints(("Goal" :in-theory (enable distribute.find-type1-literal))))
+
+
+
+(defund distribute.find-type2-literal (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (if (distribute.type2-literalp (car x))
+          (car x)
+        (distribute.find-type2-literal (cdr x)))
+    nil))
+
+(defthm distribute.type2-literalp-of-distribute.find-type2-literal
+  (equal (distribute.type2-literalp (distribute.find-type2-literal x))
+         (if (distribute.find-type2-literal x)
+             t
+           nil))
+  :hints(("Goal" :in-theory (enable distribute.find-type2-literal))))
+
+(defthm forcing-logic.termp-of-distribute.find-type2-literal
+  (implies (and (distribute.find-type2-literal x)
+                (force (logic.term-listp x)))
+           (equal (logic.termp (distribute.find-type2-literal x))
+                  t))
+  :hints(("Goal" :in-theory (enable distribute.find-type2-literal))))
+
+(defthm memberp-of-distribute.find-type2-literal
+  (implies (distribute.find-type2-literal x)
+           (equal (memberp (distribute.find-type2-literal x) x)
+                  t))
+  :hints(("Goal" :in-theory (enable distribute.find-type2-literal))))
+
+
+
+
+(defund distribute.try-distributing-clause (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (let ((lit1 (distribute.find-type1-literal x)))
+    (if lit1
+        (distribute.substitute-type1-literal lit1 x)
+      (let ((lit2 (distribute.find-type2-literal x)))
+        (if lit2
+            (distribute.substitute-type2-literal lit2 x)
+          x)))))
+
+(defthm consp-of-distribute.try-distributing-clause
+  (equal (consp (distribute.try-distributing-clause x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable distribute.try-distributing-clause))))
+
+(defthm forcing-logic.term-listp-of-distribute.try-distributing-clause
+  (implies (force (logic.term-listp x))
+           (equal (logic.term-listp (distribute.try-distributing-clause x))
+                  t))
+  :hints(("Goal" :in-theory (enable distribute.try-distributing-clause))))
+
+(defthm forcing-logic.term-list-atblp-of-distribute.try-distributing-clause
+  (implies (force (and (logic.term-listp x)
+                       (logic.term-list-atblp x atbl)))
+           (equal (logic.term-list-atblp (distribute.try-distributing-clause x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable distribute.try-distributing-clause))))
+
+
+
+
+(defund distribute.try-distributing-clause-bldr (x proof)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (consp x)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (clause.clause-formula (distribute.try-distributing-clause x))))
+                  :verify-guards nil))
+  (let ((lit1 (distribute.find-type1-literal x)))
+    (if lit1
+        (distribute.substitute-type1-literal-bldr lit1 x proof)
+      (let ((lit2 (distribute.find-type2-literal x)))
+        (if lit2
+            (distribute.substitute-type2-literal-bldr lit2 x proof)
+          (logic.appeal-identity proof))))))
+
+(defobligations distribute.try-distributing-clause-bldr
+  (distribute.substitute-type1-literal-bldr
+   distribute.substitute-type2-literal-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable distribute.try-distributing-clause
+                           distribute.try-distributing-clause-bldr)))
+
+ (verify-guards distribute.try-distributing-clause-bldr)
+
+ (defthm distribute.try-distributing-clause-bldr-under-iff
+   (iff (distribute.try-distributing-clause-bldr x proof)
+        t))
+
+ (defthm forcing-logic.appealp-of-distribute.try-distributing-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (distribute.try-distributing-clause x)))))
+            (equal (logic.appealp (distribute.try-distributing-clause-bldr x proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-distribute.try-distributing-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (distribute.try-distributing-clause x)))))
+            (equal (logic.conclusion (distribute.try-distributing-clause-bldr x proof))
+                   (clause.clause-formula x)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-distribute.try-distributing-clause-bldr
+   (implies (force (and (logic.term-listp x)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (distribute.try-distributing-clause x)))
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations distribute.try-distributing-clause-bldr)))
+            (equal (logic.proofp (distribute.try-distributing-clause-bldr x proof) axioms thms atbl)
+                   t))))
+
+
+
+(defprojection :list (distribute.try-distributing-clause-list x)
+               :element (distribute.try-distributing-clause x)
+               :guard (logic.term-list-listp x))
+
+(defthm cons-listp-of-distribute.try-distributing-clause-list
+  (equal (cons-listp (distribute.try-distributing-clause-list x))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-listp-of-distribute.try-distributing-clause-list
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.term-list-listp (distribute.try-distributing-clause-list x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-list-atblp-of-distribute.try-distributing-clause-list
+  (implies (force (and (logic.term-list-listp x)
+                       (logic.term-list-list-atblp x atbl)))
+           (equal (logic.term-list-list-atblp (distribute.try-distributing-clause-list x) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defund distribute.try-distributing-clause-list-bldr (x proofs)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (cons-listp x)
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (distribute.try-distributing-clause-list x))))))
+  (if (consp x)
+      (cons (distribute.try-distributing-clause-bldr (car x) (car proofs))
+            (distribute.try-distributing-clause-list-bldr (cdr x) (cdr proofs)))
+    nil))
+
+(defobligations distribute.try-distributing-clause-list-bldr
+  (distribute.try-distributing-clause-bldr))
+
+(defthm forcing-logic.appeal-listp-of-distribute.try-distributing-clause-list-bldr
+  (implies (force (and (logic.term-list-listp x)
+                       (cons-listp x)
+                       (logic.appeal-listp proofs)
+                       (equal (logic.strip-conclusions proofs)
+                              (clause.clause-list-formulas (distribute.try-distributing-clause-list x)))))
+           (equal (logic.appeal-listp (distribute.try-distributing-clause-list-bldr x proofs))
+                  t))
+  :hints(("Goal" :in-theory (enable distribute.try-distributing-clause-list-bldr))))
+
+(defthm forcing-logic.strip-conclusions-of-distribute.try-distributing-clause-list-bldr
+  (implies (force (and (logic.term-list-listp x)
+                       (cons-listp x)
+                       (logic.appeal-listp proofs)
+                       (equal (logic.strip-conclusions proofs)
+                              (clause.clause-list-formulas (distribute.try-distributing-clause-list x)))))
+           (equal (logic.strip-conclusions (distribute.try-distributing-clause-list-bldr x proofs))
+                  (clause.clause-list-formulas x)))
+  :hints(("Goal" :in-theory (enable distribute.try-distributing-clause-list-bldr))))
+
+(defthm@ forcing-logic.proof-listp-of-distribute.try-distributing-clause-list-bldr
+  (implies (force (and (logic.term-list-listp x)
+                       (cons-listp x)
+                       (logic.appeal-listp proofs)
+                       (equal (logic.strip-conclusions proofs)
+                              (clause.clause-list-formulas (distribute.try-distributing-clause-list x)))
+                       ;; ---
+                       (@obligations distribute.try-distributing-clause-list-bldr)
+                       (equal (cdr (lookup 'not atbl)) 1)
+                       (equal (cdr (lookup 'equal atbl)) 2)
+                       (logic.term-list-list-atblp x atbl)
+                       (logic.proof-listp proofs axioms thms atbl)
+                       ))
+           (equal (logic.proof-listp (distribute.try-distributing-clause-list-bldr x proofs) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable distribute.try-distributing-clause-list-bldr))))
+
+
+
+
+(defund tactic.distribute-all-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'distribute-all)
+         (not extras)
+         (let ((prev-goals (tactic.skeleton->goals history)))
+           (equal goals
+                  (distribute.try-distributing-clause-list prev-goals))))))
+
+(defthm booleanp-of-tactic.distribute-all-okp
+  (equal (booleanp (tactic.distribute-all-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.distribute-all-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.distribute-all-tac (x warnp)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (booleanp warnp))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0distribute-all-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let ((new-goals (distribute.try-distributing-clause-list goals)))
+        (if (equal goals new-goals)
+            (and warnp
+                 (ACL2::cw "~s0distribute-all-tac failure~s1: there are no trivial equalities to distribute.~%" *red* *black*))
+          (tactic.extend-skeleton new-goals
+                                  'distribute-all
+                                  nil
+                                  x))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.distribute-all-tac
+  (implies (and (tactic.distribute-all-tac x warnp)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.distribute-all-tac x warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.distribute-all-tac))))
+
+(defthm forcing-tactic.distribute-all-okp-of-tactic.distribute-all-tac
+  (implies (and (tactic.distribute-all-tac x warnp)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.distribute-all-okp (tactic.distribute-all-tac x warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.distribute-all-tac
+                                    tactic.distribute-all-okp))))
+
+
+
+(defund tactic.distribute-all-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.distribute-all-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history      (tactic.skeleton->history x))
+         (orig-goals   (tactic.skeleton->goals history)))
+    (distribute.try-distributing-clause-list-bldr orig-goals proofs)))
+
+(defobligations tactic.distribute-all-compile
+  (distribute.try-distributing-clause-list-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.distribute-all-okp
+                           tactic.distribute-all-compile)))
+
+ (verify-guards tactic.distribute-all-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.distribute-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.distribute-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.distribute-all-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.distribute-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.distribute-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.distribute-all-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.distribute-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.distribute-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations tactic.distribute-all-compile)))
+            (equal (logic.proof-listp (tactic.distribute-all-compile x proofs) axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/elim.lisp acl2-6.3/books/milawa/ACL2/tactics/elim.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/elim.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/elim.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1190 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "conditional-eqsubst")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; BOZO copied and pasted from crewrite-all.  Need to really move this where it belongs.
+
+(local (defthm logic.strip-conclusions-of-restn
+         ;; BOZO this seems to address some of the firstn/restn issues.  Move it where it
+          ;; belongs and try using it globally.
+         (equal (logic.strip-conclusions (restn n x))
+                (restn n (logic.strip-conclusions x)))))
+
+(local (in-theory (disable restn-of-logic.strip-conclusions)))
+
+(local (ACL2::theory-invariant (ACL2::incompatible (:rewrite logic.strip-conclusions-of-restn)
+                                                    (:rewrite restn-of-logic.strip-conclusions))))
+
+
+(local (defthm logic.strip-conclusions-of-firstn
+         ;; BOZO this seems to address some of the firstn/restn issues.  Move it where it
+         ;; belongs and try using it globally.
+         (equal (logic.strip-conclusions (firstn n x))
+                (firstn n (logic.strip-conclusions x)))))
+
+(local (in-theory (disable firstn-of-logic.strip-conclusions)))
+
+(local (ACL2::theory-invariant (ACL2::incompatible (:rewrite logic.strip-conclusions-of-firstn)
+                                                   (:rewrite firstn-of-logic.strip-conclusions))))
+
+
+
+
+
+;; BOZO none of this stuff belongs here.
+
+(defthm logic.substitute-formula-of-logic.disjoin-formulas-free
+  (implies (equal free (logic.disjoin-formulas x))
+           (equal (logic.substitute-formula free sigma)
+                  (logic.disjoin-formulas (logic.substitute-formula-list x sigma)))))
+
+(defthms-flag
+  :thms ((term aggressive-forcing-logic.substitute-of-logic.replace-subterm
+               (implies (and (force (disjointp (logic.term-vars x) (domain sigma)))
+                             (force (logic.termp x))
+                             (force (logic.sigmap sigma)))
+                        (equal (logic.substitute (logic.replace-subterm x old new) sigma)
+                               (logic.replace-subterm x old (logic.substitute new sigma)))))
+         (t    aggressive-forcing-logic.substitute-list-of-logic.replace-subterm-list
+               (implies (and (force (disjointp (logic.term-list-vars x) (domain sigma)))
+                             (force (logic.term-listp x))
+                             (force (logic.sigmap sigma)))
+                        (equal (logic.substitute-list (logic.replace-subterm-list x old new) sigma)
+                               (logic.replace-subterm-list x old (logic.substitute new sigma))))))
+  :hints(("Goal"
+          :induct (logic.term-induction flag x)
+          :expand ((logic.replace-subterm x old new)
+                   (logic.replace-subterm x old (logic.substitute new sigma))))))
+
+(defthms-flag
+  :thms ((term equal-of-logic.replace-subterm-and-logic.replace-subterm-when-same-term-and-old
+               (implies (force (and (logic.termp x)
+                                    (logic.termp old)))
+                        (equal (equal (logic.replace-subterm x old new1)
+                                      (logic.replace-subterm x old new2))
+                               (or (not (logic.subtermp old x))
+                                   (equal new1 new2)))))
+         (t    equal-of-logic.replace-subterm-list-and-logic.replace-subterm-list-when-same-term-and-old
+               (implies (force (and (logic.term-listp x)
+                                    (logic.termp old)))
+                        (equal (equal (logic.replace-subterm-list x old new1)
+                                      (logic.replace-subterm-list x old new2))
+                               (or (not (logic.subterm-of-somep old x))
+                                   (equal new1 new2))))))
+
+  :hints(("Goal"
+          :induct (logic.term-induction flag x)
+          :expand ((logic.replace-subterm x old new1)
+                   (logic.replace-subterm x old new2))
+          ;; BOZO this should be a :definition rule, but is in fact a :rewrite rule
+          ;; instead.
+          :in-theory (enable definition-of-logic.subtermp))))
+
+(defthm forcing-logic.substitute-of-var-when-first-in-sigma
+  (implies (force (logic.variablep var))
+           (equal (logic.substitute var (cons (cons var val) sigma))
+                  val))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm forcing-logic.substitute-of-var-when-second-in-sigma
+  (implies (force (logic.variablep var))
+           (equal (logic.substitute var (cons (cons var1 val1) (cons (cons var val2) sigma)))
+                  (if (equal var1 var)
+                      val1
+                    val2)))
+  :hints(("Goal" :in-theory (enable definition-of-logic.substitute))))
+
+(defthm equal-of-first-and-second-when-uniquep
+  (implies (and (uniquep x)
+                (consp (cdr x)))
+           (equal (equal (first x) (second x))
+                  nil)))
+
+(defthm equal-of-second-and-first-when-uniquep
+  (implies (and (uniquep x)
+                (consp (cdr x)))
+           (equal (equal (second x) (first x))
+                  nil)))
+
+(defthm memberp-of-first-of-difference-in-removed
+  (equal (memberp (first (difference x y)) y)
+         (if (consp (difference x y))
+             nil
+           (memberp nil y)))
+  :hints(("Goal"
+          :in-theory (disable memberp-of-car)
+          :use ((:instance memberp-of-car
+                           (x (difference x y)))))))
+
+(defthm memberp-of-second-of-difference-in-removed
+  (equal (memberp (second (difference x y)) y)
+         (if (consp (cdr (difference x y)))
+             nil
+           (memberp nil y)))
+  :hints(("Goal"
+          :in-theory (disable memberp-of-second)
+          :use ((:instance memberp-of-second
+                           (x (difference x y)))))))
+
+
+
+;; Car-cdr-elim tactic
+;;
+;; This is a lot like the conditional-eqsubst tactic.  In fact, you can implement
+;; a primitive version of car-cdr-elim using conditional-eqsubst; see the comments
+;; in conditional-eqsubst.lisp for the details.  So what we are mostly interested
+;; in here is writing the heuristics that choose WHEN to apply this approach.
+;;
+;; Our code is much simpler than ACL2's for many reasons:
+;;
+;;   - we only support car/cdr elim, rather than arbitrary elimination rules
+;;   - we don't worry about equivalences other than equal
+;;   - we don't worry about infinite loops due to opening recursive functions
+;;   - we don't have any equivalent of :generalize rules
+;;   - we don't try to do multiple elims in a single step
+;;
+;; On the other hand, ACL2 is allowed to just go and generate new variable names,
+;; whereas
+
+
+
+
+;; How do we pick the variable to eliminate?  At one point we tried to just
+;; scan for the first occurrence of (car v) or (cdr v) and pick that v.  But
+;; this failed to trigger elimination on goals when no destructor occurred,
+;; such as
+;;
+;;  (implies (consp x)
+;;           (foo x))
+;;
+;; We tried expanding our search to include occurrences of (consp v), but
+;; this triggered inappropriately sometimes, e.g., on goals like this:
+;;
+;;  (implies (and (not (consp y))
+;;                (consp x))
+;;           (foo (car x) (cdr x)))
+;;
+;; We could see y being triggered for elimination instead of x.  So now we
+;; implement a two-phase approach.  First we collect up all the variables which
+;; have been car'd or cdr'd somewhere in the goal.  If there are any such
+;; variables, we take the maximally-car/cdr'd variable and eliminate it.
+;; Otherwise, we try to choose the first occuring (consp v) hypothesis.
+;; Otherwise, we fail.
+
+(defund elim.flag-collect-destructed-variables (flag x acc)
+  ;; We scan through a term(-list) and try to find any subterms of the form
+  ;; (car v) or (cdr v), where v is any variable symbol.  We accumulate all
+  ;; such v into acc.
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))))
+  (if (equal flag 'term)
+      (if (logic.functionp x)
+          (let ((name (logic.function-name x))
+                (args (logic.function-args x)))
+            (if (and (or (equal name 'car)
+                         (equal name 'cdr))
+                     (equal (len args) 1)
+                     (logic.variablep (first args)))
+                (cons (first args) acc)
+              (elim.flag-collect-destructed-variables 'list args acc)))
+        acc)
+    (if (consp x)
+        (elim.flag-collect-destructed-variables 'term (car x)
+                                                (elim.flag-collect-destructed-variables 'list (cdr x) acc))
+      acc)))
+
+(defund elim.flag-slow-collect-destructed-variables (flag x)
+  (declare (xargs :guard (if (equal flag 'term)
+                             (logic.termp x)
+                           (logic.term-listp x))))
+  (if (equal flag 'term)
+      (if (logic.functionp x)
+          (let ((name (logic.function-name x))
+                (args (logic.function-args x)))
+            (if (and (or (equal name 'car)
+                         (equal name 'cdr))
+                     (equal (len args) 1)
+                     (logic.variablep (first args)))
+                (list (first args))
+              (elim.flag-slow-collect-destructed-variables 'list args)))
+        nil)
+    (if (consp x)
+        (app (elim.flag-slow-collect-destructed-variables 'term (car x))
+             (elim.flag-slow-collect-destructed-variables 'list (cdr x)))
+      nil)))
+
+(definlined elim.collect-destructed-variables (x)
+  (declare (xargs :guard (logic.termp x)))
+  (elim.flag-collect-destructed-variables 'term x nil))
+
+(definlined elim.collect-destructed-variables-list (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (elim.flag-collect-destructed-variables 'list x nil))
+
+(defthm true-listp-of-elim.flag-collect-destructed-variables
+  (implies (true-listp acc)
+           (true-listp (elim.flag-collect-destructed-variables flag x acc)))
+  :hints(("Goal"
+          :induct (elim.flag-collect-destructed-variables flag x acc)
+          :in-theory (enable (:induction elim.flag-collect-destructed-variables))
+          :expand ((:free (flag) (elim.flag-collect-destructed-variables flag x acc))))))
+
+(defthm elim.flag-slow-collect-destructed-variables-equiv
+  (implies (true-listp acc)
+           (equal (elim.flag-collect-destructed-variables flag x acc)
+                  (app (elim.flag-slow-collect-destructed-variables flag x)
+                       acc)))
+  :hints(("Goal"
+          :induct (elim.flag-collect-destructed-variables flag x acc)
+          :in-theory (enable (:induction elim.flag-collect-destructed-variables))
+          :expand ((:free (flag) (elim.flag-collect-destructed-variables flag x acc))
+                   (:free (flag) (elim.flag-slow-collect-destructed-variables flag x))))))
+
+(defthmd definition-of-elim.collect-destructed-variables
+  (equal (elim.collect-destructed-variables x)
+         (if (logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (if (and (or (equal name 'car)
+                            (equal name 'cdr))
+                        (equal (len args) 1)
+                        (logic.variablep (first args)))
+                   (list (first args))
+                 (elim.collect-destructed-variables-list args)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand (elim.flag-slow-collect-destructed-variables 'term x)
+          :in-theory (enable elim.collect-destructed-variables
+                             elim.collect-destructed-variables-list))))
+
+(defthmd definition-of-elim.collect-destructed-variables-list
+  (equal (elim.collect-destructed-variables-list x)
+         (if (consp x)
+             (app (elim.collect-destructed-variables (car x))
+                  (elim.collect-destructed-variables-list (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand (elim.flag-slow-collect-destructed-variables 'list x)
+          :in-theory (enable elim.collect-destructed-variables
+                             elim.collect-destructed-variables-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition elim.flag-collect-destructed-variables))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition elim.flag-slow-collect-destructed-variables))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition elim.collect-destructed-variables))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition elim.collect-destructed-variables-list))))
+
+(defthms-flag
+  :thms ((term logic.variable-listp-of-elim.collect-destructed-variables
+               (equal (logic.variable-listp (elim.collect-destructed-variables x))
+                      t))
+         (t logic.variable-listp-of-elim.collect-destructed-variables-list
+            (equal (logic.variable-listp (elim.collect-destructed-variables-list x))
+                   t)))
+  :hints(("Goal"
+          :induct (logic.term-induction flag x)
+          :expand ((elim.collect-destructed-variables x)
+                   (elim.collect-destructed-variables-list x)))))
+
+
+(defsection count
+
+  (defund fast-count (a x acc)
+    (declare (xargs :guard (natp acc)))
+    (if (consp x)
+        (fast-count a (cdr x) (if (equal a (car x))
+                                  (+ 1 acc)
+                                acc))
+      acc))
+
+  (defund slow-count (a x)
+    (declare (xargs :guard t))
+    (if (consp x)
+        (if (equal a (car x))
+            (+ 1 (slow-count a (cdr x)))
+          (slow-count a (cdr x)))
+      0))
+
+  (defund count (a x)
+    (declare (xargs :guard t))
+    (fast-count a x 0))
+
+  (defthmd fast-count-as-slow-count
+    (implies (natp acc)
+             (equal (fast-count a x acc)
+                    (+ acc (slow-count a x))))
+    :hints(("Goal" :in-theory (enable fast-count slow-count))))
+
+  (defthmd definition-of-count
+    (equal (count a x)
+           (if (consp x)
+               (if (equal a (car x))
+                   (+ 1 (count a (cdr x)))
+                 (count a (cdr x)))
+             0))
+    :rule-classes :definition
+    :hints(("Goal" :in-theory (enable count
+                                      slow-count
+                                      fast-count-as-slow-count))))
+
+  (ACL2::theory-invariant (not (ACL2::active-runep '(:definition count))))
+
+  (defthm count-when-not-consp
+    (implies (not (consp x))
+             (equal (count a x)
+                    0))
+    :hints(("Goal" :expand (count a x))))
+
+  (defthm count-of-cons
+    (equal (count a (cons b x))
+           (if (equal a b)
+               (+ 1 (count a x))
+             (count a x)))
+    :hints(("Goal" :expand (count a (cons b x)))))
+
+  (defthm natp-of-count
+    (equal (natp (count a x))
+           t)
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm count-of-zero
+    (equal (equal 0 (count a x))
+           (not (memberp a x)))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm count-of-list-fix
+    (equal (count a (list-fix x))
+           (count a x))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm count-of-app
+    (equal (count a (app x y))
+           (+ (count a x)
+              (count a y)))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm count-of-rev
+    (equal (count a (rev x))
+           (count a x))
+    :hints(("Goal" :induct (cdr-induction x))))
+
+  (defthm count-when-not-memberp
+    (implies (not (memberp a x))
+             (equal (count a x)
+                    0))
+    :hints(("Goal" :induct (cdr-induction x)))))
+
+
+
+(defund aux-maximal-count (best best-count domain x)
+  (declare (xargs :guard (and (natp best-count)
+                              (equal (count best x) best-count))))
+  (if (consp domain)
+      (let ((car-count (count (car domain) x)))
+        (if (< best-count car-count)
+            (aux-maximal-count (car domain) car-count (cdr domain) x)
+          (aux-maximal-count best best-count (cdr domain) x)))
+    best))
+
+(defthm memberp-of-aux-maximal-count
+  (implies (memberp best x)
+           (equal (memberp (aux-maximal-count best best-count domain x) x)
+                  t))
+  :hints(("Goal" :in-theory (enable aux-maximal-count))))
+
+(defthm aux-maximal-count-when-not-consp-of-x
+  (implies (not (consp x))
+           (equal (aux-maximal-count best best-count domain x)
+                  best))
+  :hints(("Goal" :in-theory (enable aux-maximal-count))))
+
+(defund maximal-count (x)
+  (declare (xargs :guard (consp x)))
+  (aux-maximal-count (car x)
+                     (count (car x) x)
+                     (cdr x)
+                     x))
+
+(defthm maximal-count-when-not-consp
+  (implies (not (consp x))
+           (equal (maximal-count x)
+                  nil))
+  :hints(("Goal" :in-theory (enable maximal-count))))
+
+(defthm memberp-of-maximal-count
+  (equal (memberp (maximal-count x) x)
+         (consp x))
+  :hints(("Goal" :in-theory (enable maximal-count))))
+
+
+
+
+
+(defund elim.find-backup-var (x)
+  ;; If this function is called, we have not found any destructed variables
+  ;; anywhere in the clause.  But before we give up, we look for any literals
+  ;; of the form (not (consp v)).  If such a literal exists, it corresponds
+  ;; to the hypothesis that v is a consp, and we will try to eliminate v.
+  (declare (xargs :guard (logic.term-listp x)))
+  (if (consp x)
+      (or (let ((term1 (car x)))
+            (and (logic.functionp term1)
+                 (equal 'not (logic.function-name term1))
+                 (let ((not-args (logic.function-args term1)))
+                   ;; (not ...)
+                   (and (equal 1 (len not-args))
+                        (logic.functionp (first not-args))
+                        (equal 'consp (logic.function-name (first not-args)))
+                        ;; (consp ...)
+                        (let ((consp-args (logic.function-args (first not-args))))
+                          (and (logic.variablep (first consp-args))
+                               (first consp-args)))))))
+          (elim.find-backup-var (cdr x)))
+    nil))
+
+(defthm logic.variablep-of-elim.find-backup-var
+  (equal (logic.variablep (elim.find-backup-var x))
+         (if (elim.find-backup-var x)
+             t
+           nil))
+  :hints(("Goal" :in-theory (enable elim.find-backup-var))))
+
+
+
+(defund elim.choose-var-to-eliminate (x)
+  (declare (xargs :guard (logic.term-listp x)))
+  (let ((destructed-vars (elim.collect-destructed-variables-list x)))
+    (if (consp destructed-vars)
+        (maximal-count destructed-vars)
+      (elim.find-backup-var x))))
+
+(defthmd lemma-for-logic.variablep-of-elim.choose-var-to-eliminate
+  (implies (logic.variable-listp x)
+           (equal (logic.variablep (maximal-count x))
+                  (consp x)))
+  :hints(("Goal"
+          :in-theory (disable logic.variablep-when-memberp-of-logic.variable-listp)
+          :use ((:instance logic.variablep-when-memberp-of-logic.variable-listp
+                           (a (maximal-count x))
+                           (x x))))))
+
+(defthm logic.variablep-of-elim.choose-var-to-eliminate
+  (equal (logic.variablep (elim.choose-var-to-eliminate x))
+         (if (elim.choose-var-to-eliminate x)
+             t
+           nil))
+  :hints(("Goal" :in-theory (enable elim.choose-var-to-eliminate
+                                    lemma-for-logic.variablep-of-elim.choose-var-to-eliminate))))
+
+
+
+
+
+
+(defsection elim.pick-fresh-vars
+
+  ;; Because our logic provides no means by which to create a new variable, we
+  ;; are left with some difficulty when it comes to generating variable names.
+  ;; To address this, we come up with a clunky and somewhat elaborate scheme for
+  ;; generating new variable names.
+  ;;
+  ;; An elim names structure is a mapping from variables to their "preferred
+  ;; names."  When we want to apply destructor elimination to kill a variable,
+  ;; var, we begin by seeing if there are any preferred names for this variable.
+  ;; If so, we try to use them if we can (i.e., if they are not already in use
+  ;; somewhere in the clause).
+  ;;
+  ;; But sometimes this will fail and there will not be any preferred names
+  ;; available.  In this case, we try to assign from a list of unappealing names,
+  ;; the "unpreferred-names."
+  ;;
+  ;; In our user interface, symmetry, we try to shield the user from ever having
+  ;; to deal with this ugliness.  We use under-the-hood ACL2 calls to generate a
+  ;; suitable elim.namesp structure that can be given to the elim tactic without
+  ;; ever involving the user.  This is like any other part of skeleton
+  ;; management, and is a purely user-interface issue which can be kept away from
+  ;; the logic.
+
+  (deflist logic.variable-list-listp (x)
+    (logic.variable-listp x)
+    :elementp-of-nil t)
+
+  (defmap :map (elim.namesp x)
+    :key (logic.variablep x)
+    :val (logic.variable-listp x)
+    :key-list (logic.variable-listp x)
+    :val-list (logic.variable-list-listp x)
+    :val-of-nil t)
+
+  (defund elim.pick-fresh-vars (var forbidden names)
+    (declare (xargs :guard (and (logic.variablep var)
+                                (logic.variable-listp forbidden)
+                                (elim.namesp names))))
+    (or
+     ;; First we try to find a preferred name.
+     (let ((lookup (lookup var names)))
+       (and lookup
+            (let ((safe-names (remove-duplicates (difference (cdr lookup) forbidden))))
+              (and (consp (cdr safe-names))
+                   (list (first safe-names)
+                         (second safe-names))))))
+     ;; Next we try to use unpreferred names.
+     (let ((lookup (lookup 'unpreferred names)))
+       (and lookup
+            (let ((safe-names (remove-duplicates (difference (cdr lookup) forbidden))))
+              (and (consp (cdr safe-names))
+                   (list (first safe-names)
+                         (second safe-names))))))
+     ;; Otherwise, we fail.
+     (ACL2::prog2$ (ACL2::cw! "~s0Warning:~s1: no fresh variable names available for eliminating ~x2.~%"
+                              *red* *black* var)
+                   nil)))
+
+  (local (in-theory (enable elim.pick-fresh-vars)))
+
+  (defthm forcing-logic.variablep-of-first-of-elim.pick-fresh-vars
+    (implies (and (elim.pick-fresh-vars var forbidden names)
+                  (force (and (logic.variablep var)
+                              (logic.variable-listp forbidden)
+                              (elim.namesp names))))
+             (equal (logic.variablep (first (elim.pick-fresh-vars var forbidden names)))
+                    t)))
+
+  (defthm forcing-logic.variablep-of-second-of-elim.pick-fresh-vars
+    (implies (and (elim.pick-fresh-vars var forbidden names)
+                  (force (and (logic.variablep var)
+                              (logic.variable-listp forbidden)
+                              (elim.namesp names))))
+             (equal (logic.variablep (second (elim.pick-fresh-vars var forbidden names)))
+                    t)))
+
+  (defthm forcing-logic.memberp-of-first-of-elim.pick-fresh-vars
+    (implies (and (elim.pick-fresh-vars var forbidden names)
+                  (force (and (logic.variablep var)
+                              (logic.variable-listp forbidden)
+                              (elim.namesp names))))
+             (equal (memberp (first (elim.pick-fresh-vars var forbidden names)) forbidden)
+                    nil)))
+
+  (defthm forcing-logic.memberp-of-second-of-elim.pick-fresh-vars
+    (implies (and (elim.pick-fresh-vars var forbidden names)
+                  (force (and (logic.variablep var)
+                              (logic.variable-listp forbidden)
+                              (elim.namesp names))))
+             (equal (memberp (second (elim.pick-fresh-vars var forbidden names)) forbidden)
+                    nil)))
+
+  (defthm forcing-equal-of-first-and-second-of-elim.pick-fresh-vars
+    (implies (and (elim.pick-fresh-vars var forbidden names)
+                  (force (and (logic.variablep var)
+                              (logic.variable-listp forbidden)
+                              (elim.namesp names))))
+             (equal (equal (first (elim.pick-fresh-vars var forbidden names))
+                           (second (elim.pick-fresh-vars var forbidden names)))
+                    nil)))
+
+  (defthm forcing-equal-of-second-and-first-of-elim.pick-fresh-vars
+    (implies (and (elim.pick-fresh-vars var forbidden names)
+                  (force (and (logic.variablep var)
+                              (logic.variable-listp forbidden)
+                              (elim.namesp names))))
+             (equal (equal (second (elim.pick-fresh-vars var forbidden names))
+                           (first (elim.pick-fresh-vars var forbidden names)))
+                    nil))))
+
+
+
+(defsection elim.elim-clause
+
+  (defund elim.elim-clause (x names n)
+    ;; X is a clause and unsafe-vars are a list of variables which hopefully do
+    ;; not occur in the clause, but we are not sure of this.  We try to find a
+    ;; destructor term to eliminate, apply the elimination, and return a new list
+    ;; of clauses whose conjunction implies x.
+    (declare (xargs :guard (and (consp x)
+                                (logic.term-listp x)
+                                (elim.namesp names))))
+    (let ((var (elim.choose-var-to-eliminate x)))
+      (if (not var)
+          ;; There are no destructor terms in the clause, and hence nothing for
+          ;; us to do.  Our only resulting clause is the input clause itself.
+          (list x)
+        ;; Otherwise, we have found a term to eliminate.  We need two fresh
+        ;; variables, one for the car and one for the cdr.
+        (let* ((fresh-vars  (elim.pick-fresh-vars var (logic.term-list-vars x) names)))
+          (if (not fresh-vars)
+              ;; No fresh vars available.  We won't try to eliminate.  A complaint
+              ;; has already been printed by elim.pick-fresh-vars.
+              (list x)
+            (let* ((new-car (first fresh-vars))
+                   (new-cdr (second fresh-vars))
+                   (new-var (logic.function 'cons (list new-car new-cdr))))
+              (ACL2::prog2$
+               (or (not n)
+                   (ACL2::cw! ";; Clause #~x0: elim transforms (CAR ~s1), (CDR ~s1) into ~x2, ~x3.~%"
+                              n var new-car new-cdr))
+               ;; We're going to produce two new subgoals.  The first is essentially:
+               ;;
+               ;;    (not (consp var)) --> x              i.e., (consp var) v x
+               ;;
+               ;; Hopefully this is trivial; in any event, it will allow the terms
+               ;; (car var) and (cdr var) to be replaced by nil's, and perhaps some
+               ;; progress will then be possible.
+               ;;
+               ;; The second goal is essentially:
+               ;;
+               ;;    x / { var <- (cons new-car new-cdr) }
+               ;;
+               ;; This is the goal you normally think of as destructor elimination.
+               (let ((1st-clause (cons (logic.function 'consp (list var)) x))
+                     (2nd-clause (logic.replace-subterm-list x var new-var)))
+                 (list 1st-clause 2nd-clause)))))))))
+
+  (defthm forcing-logic.term-list-listp-of-elim.elim-clause
+    (implies (force (and (consp x)
+                         (logic.term-listp x)
+                         (elim.namesp names)))
+             (equal (logic.term-list-listp (elim.elim-clause x names n))
+                    t))
+    :hints(("Goal" :in-theory (enable elim.elim-clause))))
+
+  (defthm forcing-cons-listp-of-elim.elim-clause
+    (implies (force (and (consp x)
+                         (logic.term-listp x)
+                         (elim.namesp names)))
+             (equal (cons-listp (elim.elim-clause x names n))
+                    t))
+    :hints(("Goal" :in-theory (enable elim.elim-clause))))
+
+  (defthm forcing-logic.term-list-list-atblp-of-elim.elim-clause
+    (implies (force (and (consp x)
+                         (logic.term-listp x)
+                         (logic.term-list-atblp x atbl)
+                         (elim.namesp names)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (equal (cdr (lookup 'cons atbl)) 2)
+                         (equal (cdr (lookup 'consp atbl)) 1)))
+             (equal (logic.term-list-list-atblp (elim.elim-clause x names n) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable elim.elim-clause)))))
+
+
+
+
+
+(defsection elim.elim-clause-bldr
+
+  (local (in-theory (enable axiom-cons-of-car-and-cdr
+                            elim.elim-clause
+                            logic.term-formula
+                            redefinition-of-logic.term-list-formulas)))
+
+  (defund elim.elim-clause-bldr (x names proofs n)
+    (declare (xargs :guard (and (consp x)
+                                (logic.term-listp x)
+                                (elim.namesp names)
+                                (logic.appeal-listp proofs)
+                                (equal (logic.strip-conclusions proofs)
+                                       (clause.clause-list-formulas (elim.elim-clause x names n)))))
+             (ignore n))
+    (let ((var (elim.choose-var-to-eliminate x)))
+      (if (not var)
+          (first proofs)
+        (let* ((fresh-vars (elim.pick-fresh-vars var (logic.term-list-vars x) names)))
+          (if (not fresh-vars)
+              (first proofs)
+            (let ((new-car (first fresh-vars))
+                  (new-cdr (second fresh-vars)))
+              ;; This is like conditional-eqsubst with:
+              ;;    hypterm = (consp var)
+              ;;    lhs     = var
+              ;;    rhs     = (cons (car var) (cdr var))
+              (tactic.conditional-eqsubst-bldr
+               (logic.pequal (logic.function 'consp (list var)) ''nil)
+               x
+               ;; Our first proof obligation is (consp var) = nil v var = (cons (car var) (cdr var)).
+               ;; This is easy to prove using the car-cdr-elim axiom
+               (build.instantiation (build.disjoined-commute-pequal (build.axiom (axiom-cons-of-car-and-cdr)))
+                                    (list (cons 'x var)))
+               ;; Our second obligation is the degenerate case, (consp var) v x
+               ;; This is easy because it is our first output clause.
+               (first proofs)
+               ;; Our third obligation is  x/{ var <- (cons (car var) (cdr var)) }
+               ;; But this is just an instance of our generalized second output clause.
+               (build.instantiation (second proofs)
+                                    (list (cons new-car (logic.function 'car (list var)))
+                                          (cons new-cdr (logic.function 'cdr (list var)))))
+               ;; Finally we need to provide the lhs and rhs.
+               var
+               (logic.function 'cons (list (logic.function 'car (list var))
+                                           (logic.function 'cdr (list var)))))))))))
+
+  (defobligations elim.elim-clause-bldr
+    (tactic.conditional-eqsubst-bldr
+     build.disjoined-commute-equal)
+    :extra-axioms ((axiom-cons-of-car-and-cdr)))
+
+  (local (in-theory (enable elim.elim-clause-bldr)))
+
+  (defthm forcing-logic.appealp-of-elim.elim-clause-bldr
+    (implies (force (and (consp x)
+                         (logic.term-listp x)
+                         (elim.namesp names)
+                         (logic.appeal-listp proofs)
+                         (equal (logic.strip-conclusions proofs)
+                                (clause.clause-list-formulas (elim.elim-clause x names n)))))
+             (equal (logic.appealp (elim.elim-clause-bldr x names proofs n))
+                    t)))
+
+  (defthm forcing-logic.conclusion-of-elim.elim-clause-bldr
+    (implies (force (and (consp x)
+                         (logic.term-listp x)
+                         (elim.namesp names)
+                         (logic.appeal-listp proofs)
+                         (equal (logic.strip-conclusions proofs)
+                                (clause.clause-list-formulas (elim.elim-clause x names n)))))
+             (equal (logic.conclusion (elim.elim-clause-bldr x names proofs n))
+                    (clause.clause-formula x))))
+
+  (defthm@ forcing-logic.proofp-of-elim.elim-clause-bldr
+    (implies (force (and (consp x)
+                         (logic.term-listp x)
+                         (elim.namesp names)
+                         (logic.appeal-listp proofs)
+                         (equal (logic.strip-conclusions proofs)
+                                (clause.clause-list-formulas (elim.elim-clause x names n)))
+                         ;; ---
+                         (logic.term-list-atblp x atbl)
+                         (logic.proof-listp proofs axioms thms atbl)
+                         (@obligations elim.elim-clause-bldr)
+                         (equal (cdr (lookup 'consp atbl)) 1)
+                         (equal (cdr (lookup 'cons atbl)) 2)
+                         (equal (cdr (lookup 'car atbl)) 1)
+                         (equal (cdr (lookup 'cdr atbl)) 1)))
+             (equal (logic.proofp (elim.elim-clause-bldr x names proofs n) axioms thms atbl)
+                    t))))
+
+
+
+(defsection elim.elim-clause-list
+
+  (defund elim.elim-clause-list (x names)
+    (declare (xargs :guard (and (cons-listp x)
+                                (logic.term-list-listp x)
+                                (elim.namesp names))))
+    (if (consp x)
+        (fast-app (elim.elim-clause (car x) names (fast-len x 0))
+                  (elim.elim-clause-list (cdr x) names))
+      nil))
+
+  (defthm true-listp-of-elim.elim-clause-list
+    (equal (true-listp (elim.elim-clause-list x names))
+           t)
+    :hints(("Goal" :in-theory (enable elim.elim-clause-list))))
+
+  (defthm forcing-logic.term-list-listp-of-elim.elim-clause-list
+    (implies (force (and (cons-listp x)
+                         (logic.term-list-listp x)
+                         (elim.namesp names)))
+             (equal (logic.term-list-listp (elim.elim-clause-list x names))
+                    t))
+    :hints(("Goal" :in-theory (enable elim.elim-clause-list))))
+
+
+  (defthm forcing-logic.term-list-list-atblp-of-elim.elim-clause-list
+    (implies (force (and (cons-listp x)
+                         (logic.term-list-listp x)
+                         (logic.term-list-list-atblp x atbl)
+                         (elim.namesp names)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (equal (cdr (lookup 'consp atbl)) 1)
+                         (equal (cdr (lookup 'cons atbl)) 2)))
+             (equal (logic.term-list-list-atblp (elim.elim-clause-list x names) atbl)
+                    t))
+    :hints(("Goal" :in-theory (enable elim.elim-clause-list))))
+
+  (defthm forcing-cons-listp-of-elim.elim-clause-list
+    (implies (force (and (cons-listp x)
+                         (logic.term-list-listp x)
+                         (elim.namesp names)))
+             (equal (cons-listp (elim.elim-clause-list x names))
+                    t))
+    :hints(("Goal" :in-theory (enable elim.elim-clause-list)))))
+
+
+
+
+(defsection elim.elim-clause-list-bldr
+
+  (local (in-theory (enable elim.elim-clause-list)))
+
+  (defthmd dangerous-decomposition-of-app
+    (equal (equal x (app a b))
+           (and (true-listp x)
+                (equal (firstn (len a) x) (list-fix a))
+                (equal (restn (len a) x) (list-fix b))))
+    :hints(("Goal"
+            :induct (cdr-cdr-induction x a)
+            :expand ((:free (x) (firstn (len a) x))
+                     (:free (x) (restn (len a) x))))))
+
+  (local (in-theory (enable dangerous-decomposition-of-app)))
+
+  (defund elim.elim-clause-list-bldr (x names proofs)
+    (declare (xargs :guard (and (cons-listp x)
+                                (logic.term-list-listp x)
+                                (elim.namesp names)
+                                (logic.appeal-listp proofs)
+                                (equal (logic.strip-conclusions proofs)
+                                       (clause.clause-list-formulas (elim.elim-clause-list x names))))))
+    (if (consp x)
+        (let* ((clause-n             (fast-len x 0))
+               (elim-first           (elim.elim-clause (car x) names clause-n))
+               (num-proofs           (fast-len elim-first 0)))
+          (cons (elim.elim-clause-bldr (car x) names (firstn num-proofs proofs) clause-n)
+                (elim.elim-clause-list-bldr (cdr x) names (restn num-proofs proofs))))
+      nil))
+
+  (defobligations elim.elim-clause-list-bldr
+    (elim.elim-clause-bldr))
+
+  (local (in-theory (enable elim.elim-clause-list-bldr)))
+
+  (defthm forcing-logic.appeal-listp-of-elim.elim-clause-list-bldr
+    (implies (force (and (cons-listp x)
+                         (logic.term-list-listp x)
+                         (elim.namesp names)
+                         (logic.appeal-listp proofs)
+                         (equal (logic.strip-conclusions proofs)
+                                (clause.clause-list-formulas (elim.elim-clause-list x names)))))
+             (equal (logic.appeal-listp (elim.elim-clause-list-bldr x names proofs))
+                    t)))
+
+  (defthm forcing-logic.strip-conclusions-of-elim.elim-clause-list-bldr
+    (implies (force (and (cons-listp x)
+                         (logic.term-list-listp x)
+                         (elim.namesp names)
+                         (logic.appeal-listp proofs)
+                         (equal (logic.strip-conclusions proofs)
+                                (clause.clause-list-formulas (elim.elim-clause-list x names)))))
+             (equal (logic.strip-conclusions (elim.elim-clause-list-bldr x names proofs))
+                    (clause.clause-list-formulas x))))
+
+  (defthm@ forcing-logic.proof-listp-of-elim.elim-clause-list-bldr
+    (implies (force (and (cons-listp x)
+                         (logic.term-list-listp x)
+                         (elim.namesp names)
+                         (logic.appeal-listp proofs)
+                         (equal (logic.strip-conclusions proofs)
+                                (clause.clause-list-formulas (elim.elim-clause-list x names)))
+                         ;; ---
+                         (logic.term-list-list-atblp x atbl)
+                         (logic.proof-listp proofs axioms thms atbl)
+                         (@obligations elim.elim-clause-list-bldr)
+                         (equal (cdr (lookup 'consp atbl)) 1)
+                         (equal (cdr (lookup 'cons atbl)) 2)
+                         (equal (cdr (lookup 'car atbl)) 1)
+                         (equal (cdr (lookup 'cdr atbl)) 1)
+                         ))
+             (equal (logic.proof-listp (elim.elim-clause-list-bldr x names proofs) axioms thms atbl)
+                    t))))
+
+
+
+
+
+
+
+(defund tactic.elim-first-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'elim-first)
+         (elim.namesp extras)
+         (let ((prev-goals (tactic.skeleton->goals history)))
+           (and (consp prev-goals)
+                (let ((elim-goals (elim.elim-clause (first prev-goals) extras nil)))
+                  (and elim-goals
+                       (equal goals
+                              (fast-app elim-goals (cdr prev-goals))))))))))
+
+(defthm booleanp-of-tactic.elim-first-okp
+  (equal (booleanp (tactic.elim-first-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.elim-first-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.elim-first-tac (x names)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (elim.namesp names))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0elim-first-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let ((elim-goals (elim.elim-clause (first goals) names nil)))
+        (if (not elim-goals)
+            (ACL2::cw "~s0elim-first-tac failure~s1: no subterms of the form (CAR VAR) or (CDR VAR) were found.~%"
+                      *red* *black*)
+          (tactic.extend-skeleton (fast-app (elim.elim-clause (first goals) names nil)
+                                            (cdr goals))
+                                  'elim-first
+                                  names
+                                  x))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.elim-first-tac
+  (implies (and (tactic.elim-first-tac x names)
+                (force (elim.namesp names))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.elim-first-tac x names))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.elim-first-tac))))
+
+(defthm forcing-tactic.elim-first-okp-of-tactic.elim-first-tac
+  (implies (and (tactic.elim-first-tac x names)
+                (force (elim.namesp names))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.elim-first-okp (tactic.elim-first-tac x names))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.elim-first-tac
+                                    tactic.elim-first-okp))))
+
+
+
+
+
+(defund tactic.elim-first-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.elim-first-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras       (tactic.skeleton->extras x))
+         (history      (tactic.skeleton->history x))
+         (orig-goal    (car (tactic.skeleton->goals history)))
+         (elim-goals   (elim.elim-clause orig-goal extras nil))
+         (elim-len     (fast-len elim-goals 0))
+         (elim-proofs  (firstn elim-len proofs))
+         (other-proofs (restn elim-len proofs)))
+    (cons (elim.elim-clause-bldr orig-goal extras elim-proofs nil)
+          other-proofs)))
+
+(defobligations tactic.elim-first-compile
+  (elim.elim-clause-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.elim-first-okp
+                           tactic.elim-first-compile)))
+
+ (local (in-theory (enable dangerous-decomposition-of-app)))
+
+ (local (ACL2::allow-fertilize t))
+
+ (verify-guards tactic.elim-first-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.elim-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.elim-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.elim-first-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.elim-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.elim-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.elim-first-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.elim-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.elim-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.elim-first-compile)
+                        (equal (cdr (lookup 'cdr atbl)) 1)
+                        (equal (cdr (lookup 'car atbl)) 1)
+                        (equal (cdr (lookup 'cons atbl)) 2)
+                        (equal (cdr (lookup 'consp atbl)) 1)
+                        ))
+            (equal (logic.proof-listp (tactic.elim-first-compile x proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+
+
+
+
+
+
+
+
+(defund tactic.elim-all-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'elim-all)
+         (elim.namesp extras)
+         (equal goals (elim.elim-clause-list (tactic.skeleton->goals history) extras)))))
+
+(defthm booleanp-of-tactic.elim-all-okp
+  (equal (booleanp (tactic.elim-all-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.elim-all-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.elim-all-tac (x names warnp)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (elim.namesp names))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0elim-all-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let* ((elim-goals (elim.elim-clause-list goals names))
+             (progressp  ;; Elim always produces two goals for every goal it
+			 ;; encounters.  Hence, we don't have to check equality
+			 ;; of the goals, we can just check same-lengthp.
+                         (not (same-lengthp goals elim-goals))))
+        (cond ((not progressp)
+               (and warnp
+                    (ACL2::cw "~s0elim-all-tac failure~s1: no progress was made.~%" *red* *black*)))
+              (t
+               (tactic.extend-skeleton elim-goals 'elim-all names x)))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.elim-all-tac
+  (implies (and (tactic.elim-all-tac x names warnp)
+                (force (elim.namesp names))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.elim-all-tac x names warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.elim-all-tac))))
+
+(defthm forcing-tactic.elim-all-okp-of-tactic.elim-all-tac
+  (implies (and (tactic.elim-all-tac x names warnp)
+                (force (elim.namesp names))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.elim-all-okp (tactic.elim-all-tac x names warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.elim-all-tac
+                                    tactic.elim-all-okp))))
+
+
+
+(defund tactic.elim-all-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.elim-all-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras       (tactic.skeleton->extras x))
+         (history      (tactic.skeleton->history x)))
+    (elim.elim-clause-list-bldr (tactic.skeleton->goals history) extras proofs)))
+
+(defobligations tactic.elim-all-compile
+  (elim.elim-clause-list-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.elim-all-okp
+                           tactic.elim-all-compile)))
+
+ (verify-guards tactic.elim-all-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.elim-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.elim-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.elim-all-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.elim-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.elim-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.elim-all-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.elim-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.elim-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.elim-all-compile)
+                        (equal (cdr (lookup 'cdr atbl)) 1)
+                        (equal (cdr (lookup 'car atbl)) 1)
+                        (equal (cdr (lookup 'cons atbl)) 2)
+                        (equal (cdr (lookup 'consp atbl)) 1)
+                        ))
+            (equal (logic.proof-listp (tactic.elim-all-compile x proofs) axioms thms atbl)
+                   t))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/fertilize.lisp acl2-6.3/books/milawa/ACL2/tactics/fertilize.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/fertilize.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/fertilize.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,472 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Fertilize Tactic
+;;
+;; Suppose (not (equal x y)) is a member of the clause.  Then, we can think of
+;; the clause as:
+;;
+;;    (implies (and (equal x y)
+;;                  ...)
+;;             ...)
+;;
+;; The fertilize tactic allows us to replace all occurrences of x with y (or
+;; vice versa) throughout the entire clause.
+;;
+;; Why is this a sound thing to do?  Assume our input goal is L1 v ... v Ln, and
+;; that we are replacing x with y.  So the user needs to prove:
+;;
+;;     L1/[x<-y] v ... v Ln[x<-y]
+;;
+;; We can give this proof to our disjoined replace subterm builder, along with
+;; the propositional axiom x != y v x = y, to prove:
+;;
+;;     x != y v L1 v ... v Ln
+;;
+;; All we need to do now is also prove x = y v L1 v ... v Ln, then use cut and
+;; contraction to conclude L1 v ... v Ln.
+;;
+;; To prove x = y v L1 v ... v Ln, notice that we either have,
+;;
+;;    (not (equal x y)) != nil, or
+;;    (not (equal y x)) != nil,
+;;
+;; among our literals.  Either of these is interchangeable for x != y.  So,
+;; begin with the propositional axiom:
+;;
+;;     x != y v x = y                        Propositional axiom
+;;     (not (equal x y)) != nil v x = y      Trivial manipulation
+;;     (L1 v ... v Ln) v x = y               Multi assoc expansion
+;;     x = y v (L1 v ... v Ln)               Commute or
+;;
+;; This entire process has been pretty efficient.  The replacement step can be
+;; expensive, but the other steps are all very cheap.
+
+(local (defthm logic.term-listp-when-tuplep-2-of-logic.termps
+         (implies (and (tuplep 2 x)
+                       (logic.termp (first x))
+                       (logic.termp (second x)))
+                  (equal (logic.term-listp x)
+                         t))
+         :rule-classes ((:rewrite :backchain-limit-lst 1))))
+
+(defund tactic.fertilize-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'fertilize)
+         (tuplep 2 extras)
+         (let ((target      (first extras))
+               (replacement (second extras))
+               (prev-goals  (tactic.skeleton->goals history)))
+           (and (logic.termp target)
+                (logic.termp replacement)
+                (consp prev-goals)
+                (let* ((original-goal (car prev-goals))
+                       (other-goals   (cdr prev-goals))
+                       (eq1           (logic.function 'equal (list target replacement)))
+                       (eq2           (logic.function 'equal (list replacement target)))
+                       (neq1          (logic.function 'not (list eq1)))
+                       (neq2          (logic.function 'not (list eq2))))
+                  (and (or (memberp neq1 original-goal)
+                           (memberp neq2 original-goal))
+                       (equal (car goals) (logic.replace-subterm-list original-goal target replacement))
+                       (equal (cdr goals) other-goals))))))))
+
+(defund tactic.fertilize-env-okp (x atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.fertilize-okp x)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.fertilize-okp)))))
+  (let* ((extras      (tactic.skeleton->extras x))
+         (target      (first extras))
+         (replacement (second extras)))
+    (and (logic.term-atblp target atbl)
+         (logic.term-atblp replacement atbl))))
+
+(defthm booleanp-of-tactic.fertilize-okp
+  (equal (booleanp (tactic.fertilize-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.fertilize-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm booleanp-of-tactic.fertilize-env-okp
+  (equal (booleanp (tactic.fertilize-env-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.fertilize-env-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.fertilize-tac (x target replacement)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.termp target)
+                              (logic.termp replacement))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0fertilize-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let* ((original-goal (car goals))
+             (other-goals   (cdr goals))
+             (eq1           (logic.function 'equal (list target replacement)))
+             (eq2           (logic.function 'equal (list replacement target)))
+             (neq1          (logic.function 'not (list eq1)))
+             (neq2          (logic.function 'not (list eq2))))
+        (cond ((and (not (memberp neq1 original-goal))
+                    (not (memberp neq2 original-goal)))
+               (ACL2::cw "~s0fertilize-tac failure~s1: the proposed equality was not found in the clause.~%" *red* *black*))
+              (t
+               (tactic.extend-skeleton (cons (logic.replace-subterm-list original-goal target replacement)
+                                             other-goals)
+                                       'fertilize
+                                       (list target replacement)
+                                       x)))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.fertilize-tac
+  (implies (and (tactic.fertilize-tac x target replacement)
+                (force (logic.termp target))
+                (force (logic.termp replacement))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.fertilize-tac x target replacement))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.fertilize-tac))))
+
+(defthm forcing-tactic.fertilize-okp-of-tactic.fertilize-tac
+  (implies (and (tactic.fertilize-tac x target replacement)
+                (force (logic.termp target))
+                (force (logic.termp replacement))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.fertilize-okp (tactic.fertilize-tac x target replacement))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.fertilize-tac
+                                    tactic.fertilize-okp))))
+
+(defthm forcing-tactic.fertilize-env-okp-of-tactic.fertilize-tac
+  (implies (and (tactic.fertilize-tac x target replacement)
+                (force (logic.term-atblp target atbl))
+                (force (logic.term-atblp replacement atbl))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.fertilize-env-okp (tactic.fertilize-tac x target replacement) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.fertilize-tac
+                                    tactic.fertilize-env-okp))))
+
+
+
+
+
+(deftheorem tactic.fertilize-lemma1-helper
+  :derive (v (!= (not (equal x y)) nil) (= x y))
+  :proof (@derive
+          ((v (!= x y) (= x y))                    (build.propositional-schema (@formula (= x y))))
+          ((v (= x y) (!= x y))                    (build.commute-or @-))
+          ((v (= x y) (= (equal x y) nil))         (build.disjoined-not-equal-from-not-pequal @-))
+          ((v (= x y) (!= (not (equal x y)) nil))  (build.disjoined-negative-lit-from-pequal-nil @-))
+          ((v (!= (not (equal x y)) nil) (= x y))  (build.commute-or @-)))
+  :minatbl ((equal . 2)
+            (not . 1)))
+
+(defund@ tactic.fertilize-lemma1 (original-goal lhs rhs)
+  (declare (xargs :guard (and (logic.term-listp original-goal)
+                              (logic.termp lhs)
+                              (logic.termp rhs)
+                              (memberp (logic.function 'not (list (logic.function 'equal (list lhs rhs)))) original-goal))
+                  :verify-guards nil))
+  (@derive
+   ((v (!= (not (equal x y)) nil) (= x y))            (build.theorem (tactic.fertilize-lemma1-helper)))
+   ((v (!= (not (equal lhs rhs)) nil) (= lhs rhs))    (build.instantiation @- (list (cons 'x lhs) (cons 'y rhs))))
+   ((v original-goal (= lhs rhs))                     (build.multi-assoc-expansion @- (logic.term-list-formulas original-goal)))))
+
+(defobligations tactic.fertilize-lemma1
+  (build.multi-assoc-expansion
+   build.instantiation)
+  :extra-thms ((tactic.fertilize-lemma1-helper)))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.fertilize-lemma1-helper tactic.fertilize-lemma1)))
+
+ (verify-guards tactic.fertilize-lemma1)
+
+ (defthm tactic.fertilize-lemma1-under-iff
+   (iff (tactic.fertilize-lemma1 original-goal lhs rhs)
+        t))
+
+ (defthm forcing-logic.appealp-of-tactic.fertilize-lemma1
+   (implies (force (and (logic.term-listp original-goal)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (memberp (logic.function 'not (list (logic.function 'equal (list lhs rhs)))) original-goal)))
+            (equal (logic.appealp (tactic.fertilize-lemma1 original-goal lhs rhs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-tactic.fertilize-lemma1
+   (implies (force (and (logic.term-listp original-goal)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (memberp (logic.function 'not (list (logic.function 'equal (list lhs rhs)))) original-goal)))
+            (equal (logic.conclusion (tactic.fertilize-lemma1 original-goal lhs rhs))
+                   (logic.por (clause.clause-formula original-goal)
+                              (logic.pequal lhs rhs)))))
+
+ (defthm@ forcing-logic.proofp-of-tactic.fertilize-lemma1
+   (implies (force (and (logic.term-listp original-goal)
+                        (logic.termp lhs)
+                        (logic.termp rhs)
+                        (memberp (logic.function 'not (list (logic.function 'equal (list lhs rhs)))) original-goal)
+                        ;; ---
+                        (logic.term-list-atblp original-goal atbl)
+                        (logic.term-atblp lhs atbl)
+                        (logic.term-atblp rhs atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (@obligations tactic.fertilize-lemma1)))
+            (equal (logic.proofp (tactic.fertilize-lemma1 original-goal lhs rhs) axioms thms atbl)
+                   t))))
+
+
+
+
+
+
+
+;; Why is this a sound thing to do?  Assume our input goal is L1 v ... v Ln, and
+;; that we are replacing x with y.  So the user needs to prove:
+;;
+;;     L1/[x<-y] v ... v Ln[x<-y]
+;;
+;; We can give this proof to our disjoined replace subterm builder, along with
+;; the propositional axiom x != y v x = y, to prove:
+;;
+;;     x != y v L1 v ... v Ln
+;;
+;; All we need to do now is also prove x = y v L1 v ... v Ln, then use cut and
+;; contraction to conclude L1 v ... v Ln.
+;;
+;; To prove x = y v L1 v ... v Ln, notice that we either have,
+;;
+;;    (not (equal x y)) != nil, or
+;;    (not (equal y x)) != nil,
+;;
+;; among our literals.  Either of these is interchangeable for x != y.  So,
+;; begin with the propositional axiom:
+;;
+;;     x != y v x = y                        Propositional axiom
+;;     (not (equal x y)) != nil v x = y      Trivial manipulation
+;;     (L1 v ... v Ln) v x = y               Multi assoc expansion
+;;     x = y v (L1 v ... v Ln)               Commute or
+
+(defund tactic.fertilize-bldr (target replacement orig-goal proof)
+  (declare (xargs :guard (and (logic.termp target)
+                              (logic.termp replacement)
+                              (logic.term-listp orig-goal)
+                              (or (memberp (logic.function 'not (list (logic.function 'equal (list target replacement)))) orig-goal)
+                                  (memberp (logic.function 'not (list (logic.function 'equal (list replacement target)))) orig-goal))
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (clause.clause-formula (logic.replace-subterm-list orig-goal target replacement))))))
+  (let* (;; target != replacement v target = replacement
+         (line-1 (build.propositional-schema (logic.pequal target replacement)))
+         ;; target != replacement v L1 = L1[target<-replacement]; ...; target != replacement v Ln = Ln[target<-replacement]
+         (line-2 (build.disjoined-replace-subterm-list orig-goal target replacement line-1))
+         ;; target != replacement v L1[target<-replacement] v ... v Ln[target<-replacement]
+         (line-3 (build.expansion (logic.pnot (logic.pequal target replacement)) proof))
+         ;; target != replacement v L1 v ... v Ln
+         (line-4 (clause.disjoined-update-clause-bldr (logic.replace-subterm-list orig-goal target replacement) line-3 line-2))
+         ;; target = replacement v L1 v ... v Ln
+         (line-5 (if (memberp (logic.function 'not (list (logic.function 'equal (list target replacement)))) orig-goal)
+                     (let* (;; (L1 v ... v Ln) v target = replacement
+                            (crock-1 (tactic.fertilize-lemma1 orig-goal target replacement))
+                            ;; target = replacement v L1 v ... v Ln
+                            (crock-2 (build.commute-or crock-1)))
+                       crock-2)
+                   (let* (;; (L1 v ... v Ln) v replacement = target
+                          (crock-1 (tactic.fertilize-lemma1 orig-goal replacement target))
+                          ;; (L1 v ... v Ln) v target = replacement
+                          (crock-2 (build.disjoined-commute-pequal crock-1))
+                          ;; target = replacement v L1 v ... v Ln
+                          (crock-3 (build.commute-or crock-2)))
+                     crock-3)))
+         ;; (L1 v ... v Ln) v (L1 v ... v Ln)
+         (line-6 (build.cut line-5 line-4))
+         ;; L1 v ... v Ln
+         (line-7 (build.contraction line-6)))
+    line-7))
+
+(defobligations tactic.fertilize-bldr
+  (build.propositional-schema
+   build.disjoined-replace-subterm-list
+   build.expansion
+   clause.disjoined-update-clause-bldr
+   tactic.fertilize-lemma1
+   build.commute-or
+   build.disjoined-commute-pequal
+   build.cut
+   build.contraction))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.fertilize-bldr)))
+
+ (defthm tactic.fertilize-bldr-under-iff
+   (iff (tactic.fertilize-bldr target replacement orig-goal proof)
+        t))
+
+ (defthm forcing-logic.appealp-of-tactic.fertilize-bldr
+   (implies (force (and (logic.termp target)
+                        (logic.termp replacement)
+                        (logic.term-listp orig-goal)
+                        (or (memberp (logic.function 'not (list (logic.function 'equal (list target replacement)))) orig-goal)
+                            (memberp (logic.function 'not (list (logic.function 'equal (list replacement target)))) orig-goal))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (logic.replace-subterm-list orig-goal target replacement)))))
+            (equal (logic.appealp (tactic.fertilize-bldr target replacement orig-goal proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-tactic.fertilize-bldr
+   (implies (force (and (logic.termp target)
+                        (logic.termp replacement)
+                        (logic.term-listp orig-goal)
+                        (or (memberp (logic.function 'not (list (logic.function 'equal (list target replacement)))) orig-goal)
+                            (memberp (logic.function 'not (list (logic.function 'equal (list replacement target)))) orig-goal))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (logic.replace-subterm-list orig-goal target replacement)))))
+            (equal (logic.conclusion (tactic.fertilize-bldr target replacement orig-goal proof))
+                   (clause.clause-formula orig-goal)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-tactic.fertilize-bldr
+   (implies (force (and (logic.termp target)
+                        (logic.termp replacement)
+                        (logic.term-listp orig-goal)
+                        (or (memberp (logic.function 'not (list (logic.function 'equal (list target replacement)))) orig-goal)
+                            (memberp (logic.function 'not (list (logic.function 'equal (list replacement target)))) orig-goal))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (logic.replace-subterm-list orig-goal target replacement)))
+                        ;; ---
+                        (logic.term-list-atblp orig-goal atbl)
+                        (logic.term-atblp target atbl)
+                        (logic.term-atblp replacement atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations tactic.fertilize-bldr)))
+            (equal (logic.proofp (tactic.fertilize-bldr target replacement orig-goal proof) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund tactic.fertilize-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.fertilize-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras       (tactic.skeleton->extras x))
+         (history      (tactic.skeleton->history x))
+         (orig-goal    (car (tactic.skeleton->goals history)))
+         (target       (first extras))
+         (replacement  (second extras)))
+    (cons (tactic.fertilize-bldr target
+                                 replacement
+                                 orig-goal
+                                 (first proofs))
+          (cdr proofs))))
+
+(defobligations tactic.fertilize-compile
+  (tactic.fertilize-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.fertilize-okp
+                           tactic.fertilize-env-okp
+                           tactic.fertilize-compile
+                           logic.term-formula)))
+
+ (local (defthm crock
+          (implies (equal (clause.clause-list-formulas goals) (logic.strip-conclusions proofs))
+                   (equal (logic.conclusion (first proofs))
+                          (clause.clause-formula (first goals))))))
+
+ (verify-guards tactic.fertilize-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.fertilize-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.fertilize-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.fertilize-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.fertilize-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.fertilize-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.fertilize-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.fertilize-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.fertilize-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.fertilize-env-okp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations tactic.fertilize-compile)))
+            (equal (logic.proof-listp (tactic.fertilize-compile x proofs) axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/generalize-all.lisp acl2-6.3/books/milawa/ACL2/tactics/generalize-all.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/generalize-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/generalize-all.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,204 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund tactic.generalize-all-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'generalize-all)
+         (consp extras)
+         (let ((expr       (car extras)) ;; the term to generalize
+               (var        (cdr extras)) ;; the new variable to generalize to
+               (prev-goals (tactic.skeleton->goals history)))
+           (and (consp prev-goals)
+                (logic.termp expr)
+                (logic.variablep var)
+                (not (memberp var (logic.term-list-list-vars prev-goals)))
+                (equal goals (logic.replace-subterm-list-list prev-goals expr var)))))))
+
+(defund tactic.generalize-all-env-okp (x atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.generalize-all-okp x)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.generalize-all-okp)))))
+  (let* ((extras  (tactic.skeleton->extras x))
+         (expr    (car extras)))
+    (logic.term-atblp expr atbl)))
+
+
+(defthm booleanp-of-tactic.generalize-all-okp
+  (equal (booleanp (tactic.generalize-all-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.generalize-all-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm booleanp-of-tactic.generalize-all-env-okp
+  (equal (booleanp (tactic.generalize-all-env-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.generalize-all-env-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+
+(defund tactic.generalize-all-tac (x expr var)
+  ;; Replace occurrences of expr with var, a new variable
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.termp expr)
+                              (logic.variablep var))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0generalize-all-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let* ((clause-vars  (logic.term-list-list-vars goals))
+             (replacements (logic.replace-subterm-list-list goals expr var)))
+        (cond ((memberp var clause-vars)
+               (ACL2::cw "~s0generalize-all-tac failure~s1: we need to use a fresh variable, but ~x2 ~
+                          is already mentioned in some clause.~%" *red* *black* var))
+              ((equal replacements goals)
+               (ACL2::cw "~s0generalize-all-tac failure~s1: the clauses did not change due to this ~
+                          generalization.~%" *red* *black*))
+              (t
+               (tactic.extend-skeleton replacements
+                                       'generalize-all
+                                       (cons expr var)
+                                       x)))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.generalize-all-tac
+  (implies (and (tactic.generalize-all-tac x expr var)
+                (force (logic.variablep var))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.generalize-all-tac x expr var))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.generalize-all-tac))))
+
+(defthm forcing-tactic.generalize-all-okp-of-tactic.generalize-all-tac
+  (implies (and (tactic.generalize-all-tac x expr var)
+                (force (logic.termp expr))
+                (force (logic.variablep var))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.generalize-all-okp (tactic.generalize-all-tac x expr var))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.generalize-all-tac
+                                    tactic.generalize-all-okp))))
+
+(defthm forcing-tactic.generalize-all-env-okp-of-tactic.generalize-all-tac
+  (implies (and (tactic.generalize-all-tac x expr var)
+                (force (logic.termp expr))
+                (force (logic.term-atblp expr atbl))
+                (force (logic.variablep var))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.generalize-all-env-okp (tactic.generalize-all-tac x expr var) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.generalize-all-tac
+                                    tactic.generalize-all-env-okp))))
+
+
+
+
+
+(defund tactic.generalize-all-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.generalize-all-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras        (tactic.skeleton->extras x))
+         (expr          (car extras))
+         (var           (cdr extras)))
+    (build.instantiation-list proofs (list (cons var expr)))))
+
+(defobligations tactic.generalize-all-compile
+  (build.instantiation-list))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.generalize-all-okp
+                           tactic.generalize-all-env-okp
+                           tactic.generalize-all-compile)))
+
+ (defthm forcing-logic.substitute-of-logic.replace-subterm-list-list-with-fresh-variable-free
+   (implies (and (equal y (logic.replace-subterm-list-list x old new))
+                 (not (memberp new (logic.term-list-list-vars x)))
+                 (logic.variablep new)
+                 (force (logic.term-list-listp x)))
+            (equal (logic.substitute-list-list y (list (cons new old)))
+                   (list-list-fix x))))
+
+ (verify-guards tactic.generalize-all-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.generalize-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.generalize-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.generalize-all-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.generalize-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.generalize-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.generalize-all-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.generalize-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.generalize-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.generalize-all-env-okp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.generalize-all-compile)))
+            (equal (logic.proof-listp (tactic.generalize-all-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/generalize-first.lisp acl2-6.3/books/milawa/ACL2/tactics/generalize-first.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/generalize-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/generalize-first.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,211 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund tactic.generalize-first-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'generalize-first)
+         (consp extras)
+         (let ((expr       (car extras)) ;; the term to generalize
+               (var        (cdr extras)) ;; the new variable to generalize to
+               (prev-goals (tactic.skeleton->goals history)))
+           (and (consp prev-goals)
+                (logic.termp expr)
+                (logic.variablep var)
+                (let ((clause1 (car prev-goals)))
+                  (and (not (memberp var (logic.term-list-vars clause1)))
+                       (let ((replacement (logic.replace-subterm-list clause1 expr var)))
+                         (and (not (equal replacement clause1))
+                              (equal (car goals) replacement)
+                              (equal (cdr goals) (cdr prev-goals)))))))))))
+
+(defund tactic.generalize-first-env-okp (x atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.generalize-first-okp x)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.generalize-first-okp)))))
+  (let* ((extras (tactic.skeleton->extras x))
+         (expr   (car extras)))
+    (logic.term-atblp expr atbl)))
+
+(defthm booleanp-of-tactic.generalize-first-okp
+  (equal (booleanp (tactic.generalize-first-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.generalize-first-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defthm booleanp-of-tactic.generalize-first-env-okp
+  (equal (booleanp (tactic.generalize-first-env-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.generalize-first-env-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+
+(defund tactic.generalize-first-tac (x expr var)
+  ;; Replace occurrences of expr with var, a new variable
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.termp expr)
+                              (logic.variablep var))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0Generalize-first-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let* ((clause1      (car goals))
+             (clause1-vars (logic.term-list-vars clause1))
+             (replacement  (logic.replace-subterm-list clause1 expr var)))
+        (cond ((memberp var clause1-vars)
+               (ACL2::cw "~s0Generalize-first-tac failure~s1: we need to use a fresh variable, but ~x2 ~
+                          is already mentioned in the clause.~%" *red* *black* var))
+              ((equal replacement clause1)
+               (ACL2::cw "~s0Generalize-first-tac failure~s1: the clause did not change due to this ~
+                          replacement.~%" *red* *black*))
+              (t
+               (tactic.extend-skeleton (cons replacement (cdr goals))
+                                       'generalize-first
+                                       (cons expr var)
+                                       x)))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.generalize-first-tac
+  (implies (and (tactic.generalize-first-tac x expr var)
+                (force (logic.variablep var))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.generalize-first-tac x expr var))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.generalize-first-tac))))
+
+(defthm forcing-tactic.generalize-first-okp-of-tactic.generalize-first-tac
+  (implies (and (tactic.generalize-first-tac x expr var)
+                (force (logic.termp expr))
+                (force (logic.variablep var))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.generalize-first-okp (tactic.generalize-first-tac x expr var))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.generalize-first-tac
+                                    tactic.generalize-first-okp))))
+
+(defthm forcing-tactic.generalize-first-env-okp-of-tactic.generalize-first-tac
+  (implies (and (tactic.generalize-first-tac x expr var)
+                (force (logic.termp expr))
+                (force (logic.term-atblp expr atbl))
+                (force (logic.variablep var))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.generalize-first-env-okp (tactic.generalize-first-tac x expr var) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.generalize-first-tac
+                                    tactic.generalize-first-env-okp))))
+
+
+
+
+(defund tactic.generalize-first-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.generalize-first-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras        (tactic.skeleton->extras x))
+         (expr          (car extras))
+         (var           (cdr extras)))
+    (cons (build.instantiation (car proofs) (list (cons var expr)))
+          (cdr proofs))))
+
+(defobligations tactic.generalize-first-compile
+  (build.instantiation))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.generalize-first-okp
+                           tactic.generalize-first-env-okp
+                           tactic.generalize-first-compile)))
+
+ (local (defthm logic.substitute-formula-of-logic.disjoin-formulas-free
+          (implies (equal x (logic.disjoin-formulas y))
+                   (equal (logic.substitute-formula x sigma)
+                          (logic.disjoin-formulas (logic.substitute-formula-list y sigma))))))
+
+ (local (defthm forcing-logic.substitute-of-logic.replace-subterm-list-with-fresh-variable-free
+          (implies (and (equal terms (logic.replace-subterm-list x old new) )
+                        (not (memberp new (logic.term-list-vars x)))
+                        (logic.variablep new)
+                        (force (logic.term-listp x)))
+                   (equal (logic.substitute-list terms (list (cons new old)))
+                          (list-fix x)))))
+
+ (verify-guards tactic.generalize-first-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.generalize-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.generalize-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.generalize-first-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.generalize-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.generalize-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.generalize-first-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.generalize-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.generalize-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.generalize-first-env-okp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.generalize-first-compile)))
+            (equal (logic.proof-listp (tactic.generalize-first-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/induct.lisp acl2-6.3/books/milawa/ACL2/tactics/induct.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/induct.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/induct.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,991 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+(defund build.stepwise-modus-ponens-2 (x y)
+  ;; X are proofs of [~A1, ..., ~An]
+  ;; Y are proofs of [A1 v B1, ..., An v Bn]
+  ;; -----------------------------------------
+  ;; Prove [B1, ..., Bn]
+  (declare (xargs :guard (and (logic.appeal-listp x)
+                              (logic.appeal-listp y)
+                              (logic.all-negationsp (logic.strip-conclusions x))
+                              (logic.all-disjunctionsp (logic.strip-conclusions y))
+                              (equal (logic.vlhses (logic.strip-conclusions y))
+                                     (logic.~args (logic.strip-conclusions x)))
+                              (equal (len x) (len y)))))
+  (if (and (consp x)
+           (consp y))
+      (cons (build.modus-ponens-2 (car x) (car y))
+            (build.stepwise-modus-ponens-2 (cdr x) (cdr y)))
+    nil))
+
+(encapsulate
+ ()
+ (local (in-theory (enable build.stepwise-modus-ponens-2)))
+
+ (defthm true-listp-of-build.stepwise-modus-ponens-2
+   (equal (true-listp (build.stepwise-modus-ponens-2 x y))
+          t))
+
+ (defthm forcing-logic.appeal-list-of-build.stepwise-modus-ponens-2
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.appeal-listp y)
+                        (logic.all-negationsp (logic.strip-conclusions x))
+                        (logic.all-disjunctionsp (logic.strip-conclusions y))
+                        (equal (logic.vlhses (logic.strip-conclusions y))
+                               (logic.~args (logic.strip-conclusions x)))
+                        (equal (len x) (len y))))
+            (equal (logic.appeal-listp (build.stepwise-modus-ponens-2 x y))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-build.stepwise-modus-ponens-2
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.appeal-listp y)
+                        (logic.all-negationsp (logic.strip-conclusions x))
+                        (logic.all-disjunctionsp (logic.strip-conclusions y))
+                        (equal (logic.vlhses (logic.strip-conclusions y))
+                               (logic.~args (logic.strip-conclusions x)))
+                        (equal (len x) (len y))))
+            (equal (logic.strip-conclusions (build.stepwise-modus-ponens-2 x y))
+                   (logic.vrhses (logic.strip-conclusions y))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm forcing-logic.proof-list-of-build.stepwise-modus-ponens-2
+   (implies (force (and (logic.appeal-listp x)
+                        (logic.appeal-listp y)
+                        (logic.all-negationsp (logic.strip-conclusions x))
+                        (logic.all-disjunctionsp (logic.strip-conclusions y))
+                        (equal (logic.vlhses (logic.strip-conclusions y))
+                               (logic.~args (logic.strip-conclusions x)))
+                        (equal (len x) (len y))
+                        ;; ---
+                        (logic.proof-listp x axioms thms atbl)
+                        (logic.proof-listp y axioms thms atbl)))
+            (equal (logic.proof-listp (build.stepwise-modus-ponens-2 x y) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund tactic.induct-basis-clause (clause qs)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (logic.term-listp qs))))
+  (let* ((clause-as-formula (clause.clause-formula clause))
+         (qs-as-formulas    (logic.term-list-formulas qs))
+         (basis-as-formula  (logic.make-basis-step clause-as-formula qs-as-formulas))
+         (basis-as-term     (logic.compile-formula basis-as-formula))
+         (basis-as-clause   (list basis-as-term)))
+    basis-as-clause))
+
+(defthm forcing-logic.term-listp-of-tactic.induct-basis-clause
+  (implies (force (and (logic.term-listp clause)
+                       (consp clause)
+                       (logic.term-listp qs)))
+           (equal (logic.term-listp (tactic.induct-basis-clause clause qs))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.induct-basis-clause))))
+
+(defthm consp-of-tactic.induct-basis-clause
+  (equal (consp (tactic.induct-basis-clause clause qs))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.induct-basis-clause))))
+
+
+
+(defund@ tactic.compile-induct-basis-clause (clause qs proof)
+  ;; Prove basis-as-formula from a proof of basis-as-clause.
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (logic.term-listp qs)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (clause.clause-formula (tactic.induct-basis-clause clause qs))))
+                  :verify-guards nil))
+  ;; Proof is (clause.clause-formula basis-as-clause)
+  ;;            <-> (logic.term-formula basis-as-term)
+  ;;            <-> (logic.term-formula (logic.compile-formula basis-as-formula))
+  ;;            <-> (logic.compile-formula basis-as-formula) != nil
+  ;;            <-> basis-as-term != nil
+  (let* ((clause-as-formula (clause.clause-formula clause))
+         (qs-as-formulas    (logic.term-list-formulas qs))
+         (basis-as-formula  (logic.make-basis-step clause-as-formula qs-as-formulas)))
+    ;; Let BAF be basis-as-formula
+    ;; Let BAT be basis-as-term
+    (@derive ((v BAF (= BAT nil))  (@given (second (build.compile-formula basis-as-formula))))
+             ((v (= BAT nil) BAF)  (build.commute-or @-))
+             ((!= BAT nil)         (@given proof))
+             (BAF                  (build.modus-ponens-2 @- @--)))))
+
+(defobligations tactic.compile-induct-basis-clause
+  (build.compile-formula
+   build.commute-or
+   build.modus-ponens2))
+
+(encapsulate
+ ()
+ (local (in-theory (enable logic.term-formula
+                           tactic.induct-basis-clause
+                           tactic.compile-induct-basis-clause)))
+
+ (verify-guards tactic.compile-induct-basis-clause)
+
+ (defthm forcing-logic.appealp-of-tactic.compile-induct-basis-clause
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.term-listp qs)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (tactic.induct-basis-clause clause qs)))))
+            (equal (logic.appealp (tactic.compile-induct-basis-clause clause qs proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-tactic.compile-induct-basis-clause
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.term-listp qs)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (tactic.induct-basis-clause clause qs)))))
+            (equal (logic.conclusion (tactic.compile-induct-basis-clause clause qs proof))
+                   (logic.make-basis-step (clause.clause-formula clause)
+                                          (logic.term-list-formulas qs))))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-tactic.compile-induct-basis-clause
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.term-listp qs)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (tactic.induct-basis-clause clause qs)))
+                        ;; ---
+                        (logic.term-list-atblp clause atbl)
+                        (logic.term-list-atblp qs atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (logic.proofp proof axioms thms atbl)
+                        (@obligations tactic.compile-induct-basis-clause)))
+            (equal (logic.proofp (tactic.compile-induct-basis-clause clause qs proof) axioms thms atbl)
+                   t))))
+
+
+
+
+
+(defund tactic.induct-inductive-clauses (clause qs all-sigmas)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (logic.term-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas)))))
+  (let* ((clause-as-formula     (clause.clause-formula clause))
+         (qs-as-formulas        (logic.term-list-formulas qs))
+         (inductive-as-formulas (logic.make-induction-steps clause-as-formula qs-as-formulas all-sigmas))
+         (inductive-as-terms    (logic.compile-formula-list inductive-as-formulas))
+         (inductive-as-clauses  (listify-each inductive-as-terms)))
+    inductive-as-clauses))
+
+(defthm forcing-logic.term-list-listp-of-tactic.induct-inductive-clauses
+  (implies (force (and (logic.term-listp clause)
+                              (consp clause)
+                              (logic.term-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas))))
+           (equal (logic.term-list-listp (tactic.induct-inductive-clauses clause qs all-sigmas))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.induct-inductive-clauses))))
+
+(defthm cons-listp-of-tactic.induct-inductive-clauses
+  (equal (cons-listp (tactic.induct-inductive-clauses clause qs all-sigmas))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.induct-inductive-clauses))))
+
+(defthm true-listp-of-tactic.induct-inductive-clauses
+  (equal (true-listp (tactic.induct-inductive-clauses clause qs all-sigmas))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.induct-inductive-clauses))))
+
+
+
+
+(defund tactic.compile-induct-inductive-clauses (clause qs all-sigmas proofs)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (logic.term-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas))
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (tactic.induct-inductive-clauses clause qs all-sigmas))))
+                  :verify-guards nil))
+  ;; Let G1-f, ..., Gn-f be inductive-as-formulas
+  ;; Let G1-t, ..., Gn-t be inductive-as-terms
+  ;; Let G1-c, ..., Gn-c be inductive-as-clauses
+  ;;
+  ;; We are given proofs of (clause.clause-list-formulas [G1-c, ..., Gn-c])
+  ;;                         <-> (logic.term-list-formulas [G1-t, ..., Gn-t])
+  ;;                         <-> [G1-t != nil, ..., Gn-t != nil]
+  ;;
+  (let* ((clause-as-formula     (clause.clause-formula clause))
+         (qs-as-formulas        (logic.term-list-formulas qs))
+         (inductive-as-formulas (logic.make-induction-steps clause-as-formula qs-as-formulas all-sigmas))
+         ;; compile-lemmas: [G1-t = nil v G1-f, ..., Gn-t = nil v Gn-f]
+         (compile-lemmas        (build.compile-formula-list-comm-2 inductive-as-formulas)))
+    ;; Our goal, then, is just a stepwise-modus-ponens-2 away.
+    (build.stepwise-modus-ponens-2 proofs compile-lemmas)))
+
+(defobligations tactic.compile-induct-inductive-clauses
+  (build.compile-formula-list-comm-2
+   build.stepwise-modus-ponens-2))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.induct-inductive-clauses
+                           tactic.compile-induct-inductive-clauses)))
+
+ (local (defthm lemma
+          (implies (equal (logic.strip-conclusions proofs)
+                          (logic.negate-formulas x))
+                   (equal (len proofs)
+                          (len x)))
+          :hints(("Goal"
+                  :in-theory (disable len-of-logic.negate-formulas
+                                      len-of-logic.strip-conclusions)
+                  :use ((:instance len-of-logic.negate-formulas)
+                        (:instance len-of-logic.strip-conclusions (x proofs)))))))
+
+ (verify-guards tactic.compile-induct-inductive-clauses)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.compile-induct-inductive-clauses
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (tactic.induct-inductive-clauses clause qs all-sigmas)))))
+            (equal (logic.appeal-listp (tactic.compile-induct-inductive-clauses clause qs all-sigmas proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.compile-induct-inductive-clauses
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (tactic.induct-inductive-clauses clause qs all-sigmas)))))
+            (equal (logic.strip-conclusions (tactic.compile-induct-inductive-clauses clause qs all-sigmas proofs))
+                   (logic.make-induction-steps (clause.clause-formula clause)
+                                               (logic.term-list-formulas qs)
+                                               all-sigmas)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.compile-induct-inductive-clauses
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (tactic.induct-inductive-clauses clause qs all-sigmas)))
+                        ;; ---
+                        (logic.term-list-atblp clause atbl)
+                        (logic.term-list-atblp qs atbl)
+                        (logic.sigma-list-list-atblp all-sigmas atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (@obligations tactic.compile-induct-inductive-clauses)
+                        ))
+            (equal (logic.proof-listp (tactic.compile-induct-inductive-clauses clause qs all-sigmas proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund tactic.induct-ordinal-clause (m)
+  (declare (xargs :guard (logic.termp m)))
+  (let* ((ordinal-as-formula (logic.make-ordinal-step m))
+         (ordinal-as-term    (logic.compile-formula ordinal-as-formula))
+         (ordinal-as-clause  (list ordinal-as-term)))
+    ordinal-as-clause))
+
+(defthm forcing-logic.term-listp-of-tactic.induct-ordinal-clause
+  (implies (force (logic.termp m))
+           (equal (logic.term-listp (tactic.induct-ordinal-clause m))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.induct-ordinal-clause))))
+
+(defthm consp-of-tactic.induct-ordinal-clause
+  (equal (consp (tactic.induct-ordinal-clause m))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.induct-ordinal-clause))))
+
+(defund@ tactic.compile-induct-ordinal-clause (m proof)
+  (declare (xargs :guard (and (logic.termp m)
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof)
+                                     (clause.clause-formula (tactic.induct-ordinal-clause m))))
+                  :verify-guards nil))
+  ;; Let OAF be ordinal-as-formula
+  ;; Let OAT be ordinal-as-term
+  (let ((ordinal-as-formula (logic.make-ordinal-step m)))
+    (@derive
+     ((v OAF (= OAT nil))   (@given (second (build.compile-formula ordinal-as-formula))))
+     ((v (= OAT nil) OAF)   (build.commute-or @-))
+     ((!= OAT nil)          (@given proof))
+     (OAF                   (build.modus-ponens-2 @- @--)))))
+
+(defobligations tactic.compile-induct-ordinal-clause
+  (build.compile-formula
+   build.commute-or
+   build.modus-ponens-2))
+
+(encapsulate
+ ()
+ (local (in-theory (enable logic.term-formula
+                           tactic.induct-ordinal-clause
+                           tactic.compile-induct-ordinal-clause)))
+
+ (verify-guards tactic.compile-induct-ordinal-clause)
+
+ (defthm forcing-logic.appealp-of-tactic.compile-induct-ordinal-clause
+   (implies (force (and (logic.termp m)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (tactic.induct-ordinal-clause m)))))
+            (equal (logic.appealp (tactic.compile-induct-ordinal-clause m proof))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-tactic.compile-induct-ordinal-clause
+   (implies (force (and (logic.termp m)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (tactic.induct-ordinal-clause m)))))
+            (equal (logic.conclusion (tactic.compile-induct-ordinal-clause m proof))
+                   (logic.make-ordinal-step m))))
+
+ (defthm@ forcing-logic.proofp-of-tactic.compile-induct-ordinal-clause
+   (implies (force (and (logic.termp m)
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof)
+                               (clause.clause-formula (tactic.induct-ordinal-clause m)))
+                        ;; ---
+                        (logic.term-atblp m atbl)
+                        (logic.proofp proof axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'ordp atbl)) 1)
+                        (@obligations tactic.compile-induct-ordinal-clause)
+                        ))
+            (equal (logic.proofp (tactic.compile-induct-ordinal-clause m proof) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund tactic.induct-measure-clauses (m qs all-sigmas)
+  (declare (xargs :guard (and (logic.termp m)
+                              (logic.term-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas)))))
+  (let* ((qs-as-formulas      (logic.term-list-formulas qs))
+         (measure-as-formulas (logic.make-all-measure-steps m qs-as-formulas all-sigmas))
+         (measure-as-terms    (logic.compile-formula-list measure-as-formulas))
+         (measure-as-clauses  (listify-each measure-as-terms)))
+    measure-as-clauses))
+
+(defthm forcing-logic.term-list-listp-of-tactic.induct-measure-clauses
+  (implies (force (and (logic.termp m)
+                       (logic.term-listp qs)
+                       (logic.sigma-list-listp all-sigmas)
+                       (equal (len qs) (len all-sigmas))))
+           (equal (logic.term-list-listp (tactic.induct-measure-clauses m qs all-sigmas))
+                  t))
+  :hints(("Goal" :in-theory (e/d (tactic.induct-measure-clauses)
+                                 (FORCING-LOGIC.TERM-LIST-ATBLP-OF-LOGIC.COMPILE-FORMULA-LIST)))))
+
+(defthm cons-listp-of-tactic.induct-measure-clauses
+  (equal (cons-listp (tactic.induct-measure-clauses m qs all-sigmas))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.induct-measure-clauses))))
+
+(defthm true-listp-of-tactic.induct-measure-clauses
+  (equal (true-listp (tactic.induct-measure-clauses m qs all-sigmas))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.induct-measure-clauses))))
+
+
+(defund tactic.compile-induct-measure-clauses (m qs all-sigmas proofs)
+  (declare (xargs :guard (and (logic.termp m)
+                              (logic.term-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas))
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs)
+                                     (clause.clause-list-formulas (tactic.induct-measure-clauses m qs all-sigmas))))
+                  :verify-guards nil))
+  ;; Goal is to prove measure-as-formulas.
+  ;;
+  ;; Let [G1-f, ..., Gn-f] be measure-as-formulas
+  ;; Let [G1-t, ..., Gn-t] be measure-as-terms
+  ;; Let [G1-c, ..., Gn-c] be measure-as-clauses
+  ;;
+  ;; Proofs are (clause.clause-list-formulas [G1-c, ..., Gn-c])
+  ;;              <-> (logic.term-list-formulas [G1-t, ..., Gn-t])
+  ;;              <-> [G1-t != nil, ..., Gn-t != nil]
+  ;;
+  (let* ((qs-as-formulas        (logic.term-list-formulas qs))
+         (measure-as-formulas   (logic.make-all-measure-steps m qs-as-formulas all-sigmas))
+         ;; compile-lemmas: [G1-t = nil v G1-f, ..., Gn-t = nil v Gn-f]
+         (compile-lemmas        (build.compile-formula-list-comm-2 measure-as-formulas)))
+    ;; Our goal, then, is just a stepwise-modus-ponens-2 away.
+    (build.stepwise-modus-ponens-2 proofs compile-lemmas)))
+
+(defobligations tactic.compile-induct-measure-clauses
+  (build.compile-formula-list-comm-2
+   build.stepwise-modus-ponens-2))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.induct-measure-clauses tactic.compile-induct-measure-clauses)))
+
+ (local (defthm lemma
+          (implies (equal (logic.strip-conclusions proofs)
+                          (logic.negate-formulas x))
+                   (equal (len proofs)
+                          (len x)))
+          :hints(("Goal"
+                  :in-theory (disable len-of-logic.negate-formulas
+                                      len-of-logic.strip-conclusions)
+                  :use ((:instance len-of-logic.negate-formulas)
+                        (:instance len-of-logic.strip-conclusions (x proofs)))))))
+
+ (verify-guards tactic.compile-induct-measure-clauses)
+
+ (defthm true-listp-of-tactic.compile-induct-measure-clauses
+   (equal (true-listp (tactic.compile-induct-measure-clauses m qs all-sigmas measure-proofs))
+          t))
+
+
+ (defthm forcing-logic.appeal-list-of-tactic.compile-induct-measure-clauses
+   (implies (force (and (logic.termp m)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (tactic.induct-measure-clauses m qs all-sigmas)))))
+            (equal (logic.appeal-listp (tactic.compile-induct-measure-clauses m qs all-sigmas proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.compile-induct-measure-clauses
+   (implies (force (and (logic.termp m)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (tactic.induct-measure-clauses m qs all-sigmas)))))
+            (equal (logic.strip-conclusions (tactic.compile-induct-measure-clauses m qs all-sigmas proofs))
+                   (logic.make-all-measure-steps m (logic.term-list-formulas qs) all-sigmas)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.compile-induct-measure-clauses
+   (implies (force (and (logic.termp m)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs)
+                               (clause.clause-list-formulas (tactic.induct-measure-clauses m qs all-sigmas)))
+                        ;; ---
+                        (logic.term-atblp m atbl)
+                        (logic.term-list-atblp qs atbl)
+                        (logic.sigma-list-list-atblp all-sigmas atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'ord< atbl)) 2)
+                        (@obligations tactic.compile-induct-measure-clauses)
+                        ))
+            (equal (logic.proof-listp (tactic.compile-induct-measure-clauses m qs all-sigmas proofs) axioms thms atbl)
+                   t))
+   :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+
+
+(defund tactic.induct-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'induct)
+         (tuplep 3 extras)
+         (let ((m          (first extras))
+               (qs         (second extras))
+               (all-sigmas (third extras))
+               (old-goals  (tactic.skeleton->goals history)))
+           (and (logic.termp m)
+                ;; We use terms instead of formulas for our qs.
+                (logic.term-listp qs)
+                (logic.sigma-list-listp all-sigmas)
+                (equal (len qs) (len all-sigmas))
+                (consp old-goals)
+                (let ((clause1 (car old-goals)))
+                  (and (consp clause1)
+                       (let ((basis     (tactic.induct-basis-clause clause1 qs))
+                             (ordinal   (tactic.induct-ordinal-clause m))
+                             (inductive (tactic.induct-inductive-clauses clause1 qs all-sigmas))
+                             (measure   (tactic.induct-measure-clauses m qs all-sigmas)))
+                         (equal goals
+                                (cons basis (cons ordinal (fast-app inductive (fast-app measure (cdr old-goals))))))))))))))
+
+(defthm booleanp-of-tactic.induct-okp
+  (equal (booleanp (tactic.induct-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.induct-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defund tactic.induct-env-okp (x atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.induct-okp x)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.induct-okp)))))
+  (let* ((extras     (tactic.skeleton->extras x))
+         (m          (first extras))
+         (qs         (second extras))
+         (all-sigmas (third extras)))
+    (and (logic.term-atblp m atbl)
+         (logic.term-list-atblp qs atbl)
+         (logic.sigma-list-list-atblp all-sigmas atbl))))
+
+(defthm booleanp-of-tactic.induct-env-okp
+  (equal (booleanp (tactic.induct-env-okp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.induct-env-okp))))
+
+
+
+
+(defund tactic.induct-tac (x m qs all-sigmas)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.termp m)
+                              (logic.term-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas)))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (cond ((not (consp goals))
+           (ACL2::cw "~s0induct-tac failure~s1: all clauses have already been proven.~%" *red* *black*))
+          (t
+           (let* ((clause1   (car goals))
+                  (basis     (tactic.induct-basis-clause clause1 qs))
+                  (ordinal   (tactic.induct-ordinal-clause m))
+                  (inductive (tactic.induct-inductive-clauses clause1 qs all-sigmas))
+                  (measure   (tactic.induct-measure-clauses m qs all-sigmas)))
+             (tactic.extend-skeleton (cons basis (cons ordinal (fast-app inductive (fast-app measure (cdr goals)))))
+                                     'induct
+                                     (list m qs all-sigmas)
+                                     x))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.induct-tac
+  (implies (and (tactic.induct-tac x m qs all-sigmas)
+                (force (and (tactic.skeletonp x)
+                            (logic.termp m)
+                            (logic.term-listp qs)
+                            (logic.sigma-list-listp all-sigmas)
+                            (equal (len qs) (len all-sigmas)))))
+           (equal (tactic.skeletonp (tactic.induct-tac x m qs all-sigmas))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.induct-tac))))
+
+(defthm forcing-tactic.induct-okp-of-tactic.induct-tac
+  (implies (and (tactic.induct-tac x m qs all-sigmas)
+                (force (and (tactic.skeletonp x)
+                            (logic.termp m)
+                            (logic.term-listp qs)
+                            (logic.sigma-list-listp all-sigmas)
+                            (equal (len qs) (len all-sigmas)))))
+           (equal (tactic.induct-okp (tactic.induct-tac x m qs all-sigmas))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.induct-tac tactic.induct-okp))))
+
+
+
+
+
+
+(defund tactic.induct-compile-aux (clause m qs all-sigmas basis-proof ordinal-proof inductive-proofs measure-proofs)
+  (declare (xargs :guard (and (logic.term-listp clause)
+                              (consp clause)
+                              (logic.termp m)
+                              (logic.term-listp qs)
+                              (logic.sigma-list-listp all-sigmas)
+                              (equal (len qs) (len all-sigmas))
+                              (logic.appealp basis-proof)
+                              (logic.appealp ordinal-proof)
+                              (logic.appeal-listp inductive-proofs)
+                              (logic.appeal-listp measure-proofs)
+                              (equal (logic.conclusion basis-proof)
+                                     (clause.clause-formula (tactic.induct-basis-clause clause qs)))
+                              (equal (logic.conclusion ordinal-proof)
+                                     (clause.clause-formula (tactic.induct-ordinal-clause m)))
+                              (equal (logic.strip-conclusions inductive-proofs)
+                                     (clause.clause-list-formulas (tactic.induct-inductive-clauses clause qs all-sigmas)))
+                              (equal (logic.strip-conclusions measure-proofs)
+                                     (clause.clause-list-formulas (tactic.induct-measure-clauses m qs all-sigmas))))))
+  ;; We are given proofs of all the clauses that we split into.
+  ;; We start by compiling all these with our step compilers into formulas suitable for build.induction
+  (let ((f-basis-proof      (tactic.compile-induct-basis-clause clause qs basis-proof))
+        (f-ordinal-proof    (tactic.compile-induct-ordinal-clause m ordinal-proof))
+        (f-inductive-proofs (tactic.compile-induct-inductive-clauses clause qs all-sigmas inductive-proofs))
+        (f-measure-proofs   (tactic.compile-induct-measure-clauses m qs all-sigmas measure-proofs))
+        (f-clause           (clause.clause-formula clause))
+        (f-qs               (logic.term-list-formulas qs)))
+    ;; We now use build.induction to prove f-clause.
+    (build.induction f-clause m f-qs all-sigmas
+                     (cons f-basis-proof
+                           (cons f-ordinal-proof
+                                 ;; BOZO revappend would be better, not really important though
+                                 (fast-app f-inductive-proofs f-measure-proofs))))))
+
+(defobligations tactic.induct-compile-aux
+  (tactic.compile-induct-basis-clause
+   tactic.compile-induct-ordinal-clause
+   tactic.compile-induct-inductive-clauses
+   tactic.compile-induct-measure-clauses
+   build.induction))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.induct-compile-aux)))
+
+ (defthm forcing-logic.appealp-of-tactic.induct-compile-aux
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.termp m)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appealp basis-proof)
+                        (logic.appealp ordinal-proof)
+                        (logic.appeal-listp inductive-proofs)
+                        (logic.appeal-listp measure-proofs)
+                        (equal (logic.conclusion basis-proof)
+                               (clause.clause-formula (tactic.induct-basis-clause clause qs)))
+                        (equal (logic.conclusion ordinal-proof)
+                               (clause.clause-formula (tactic.induct-ordinal-clause m)))
+                        (equal (logic.strip-conclusions inductive-proofs)
+                               (clause.clause-list-formulas (tactic.induct-inductive-clauses clause qs all-sigmas)))
+                        (equal (logic.strip-conclusions measure-proofs)
+                               (clause.clause-list-formulas (tactic.induct-measure-clauses m qs all-sigmas)))))
+            (equal (logic.appealp (tactic.induct-compile-aux clause m qs all-sigmas basis-proof ordinal-proof inductive-proofs measure-proofs))
+                   t)))
+
+ (defthm forcing-logic.conclusion-of-tactic.induct-compile-aux
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.termp m)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appealp basis-proof)
+                        (logic.appealp ordinal-proof)
+                        (logic.appeal-listp inductive-proofs)
+                        (logic.appeal-listp measure-proofs)
+                        (equal (logic.conclusion basis-proof)
+                               (clause.clause-formula (tactic.induct-basis-clause clause qs)))
+                        (equal (logic.conclusion ordinal-proof)
+                               (clause.clause-formula (tactic.induct-ordinal-clause m)))
+                        (equal (logic.strip-conclusions inductive-proofs)
+                               (clause.clause-list-formulas (tactic.induct-inductive-clauses clause qs all-sigmas)))
+                        (equal (logic.strip-conclusions measure-proofs)
+                               (clause.clause-list-formulas (tactic.induct-measure-clauses m qs all-sigmas)))))
+            (equal (logic.conclusion (tactic.induct-compile-aux clause m qs all-sigmas basis-proof ordinal-proof inductive-proofs measure-proofs))
+                   (clause.clause-formula clause)))
+   :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+ (defthm@ forcing-logic.proofp-of-tactic.induct-compile-aux
+   (implies (force (and (logic.term-listp clause)
+                        (consp clause)
+                        (logic.termp m)
+                        (logic.term-listp qs)
+                        (logic.sigma-list-listp all-sigmas)
+                        (equal (len qs) (len all-sigmas))
+                        (logic.appealp basis-proof)
+                        (logic.appealp ordinal-proof)
+                        (logic.appeal-listp inductive-proofs)
+                        (logic.appeal-listp measure-proofs)
+                        (equal (logic.conclusion basis-proof)
+                               (clause.clause-formula (tactic.induct-basis-clause clause qs)))
+                        (equal (logic.conclusion ordinal-proof)
+                               (clause.clause-formula (tactic.induct-ordinal-clause m)))
+                        (equal (logic.strip-conclusions inductive-proofs)
+                               (clause.clause-list-formulas (tactic.induct-inductive-clauses clause qs all-sigmas)))
+                        (equal (logic.strip-conclusions measure-proofs)
+                               (clause.clause-list-formulas (tactic.induct-measure-clauses m qs all-sigmas)))
+                        ;; ---
+                        (logic.term-list-atblp clause atbl)
+                        (logic.term-atblp m atbl)
+                        (logic.term-list-atblp qs atbl)
+                        (logic.sigma-list-list-atblp all-sigmas atbl)
+                        (logic.proofp basis-proof axioms thms atbl)
+                        (logic.proofp ordinal-proof axioms thms atbl)
+                        (logic.proof-listp inductive-proofs axioms thms atbl)
+                        (logic.proof-listp measure-proofs axioms thms atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'ordp atbl)) 1)
+                        (equal (cdr (lookup 'ord< atbl)) 2)
+                        (@obligations tactic.induct-compile-aux)))
+            (equal (logic.proofp (tactic.induct-compile-aux clause m qs all-sigmas basis-proof ordinal-proof inductive-proofs measure-proofs) axioms thms atbl)
+                   t))))
+
+
+
+
+(defund tactic.induct-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.induct-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history       (tactic.skeleton->history x))
+         (old-goals     (tactic.skeleton->goals history))
+         (extras        (tactic.skeleton->extras x))
+         (m             (first extras))
+         (qs            (second extras))
+         (all-sigmas    (third extras))
+         (clause1       (car old-goals))
+         ;; Not very optimal; maybe it doesn't matter since we don't induct often.
+         (inductive-len (len (tactic.induct-inductive-clauses clause1 qs all-sigmas)))
+         (measure-len   (len (tactic.induct-measure-clauses m qs all-sigmas)))
+         ;; Extract the appropriate proofs.
+         (basis-proof      (first proofs))
+         (ordinal-proof    (second proofs))
+         (inductive-proofs (firstn inductive-len (cdr (cdr proofs))))
+         (other-proofs     (restn inductive-len (cdr (cdr proofs))))
+         (measure-proofs   (firstn measure-len other-proofs))
+         (cdr-goals-proofs (restn measure-len other-proofs)))
+    (cons (tactic.induct-compile-aux clause1 m qs all-sigmas
+                                     basis-proof ordinal-proof inductive-proofs measure-proofs)
+          cdr-goals-proofs)))
+
+(defobligations tactic.induct-compile
+  (tactic.induct-compile-aux))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.induct-okp
+                           tactic.induct-env-okp
+                           tactic.induct-compile)))
+
+ (local (defthm crock
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.strip-conclusions proofs)
+                          (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))))))
+
+ (local (defthm crock2
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.strip-conclusions (firstn n proofs))
+                          (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (firstn n goals)))))
+          :hints(("Goal"
+                  :in-theory (disable FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                  :use ((:instance FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                                   (Y n)
+                                   (X (LOGIC.TERM-LIST-LIST-FORMULAS goals))))))))
+
+ (local (defthm crock3
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.strip-conclusions (firstn n (cdr (cdr proofs))))
+                          (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (firstn n (cdr (cdr goals)))))))
+          :hints(("Goal"
+                  :in-theory (disable FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                  :use ((:instance FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                                   (Y n)
+                                   (X (LOGIC.TERM-LIST-LIST-FORMULAS (cdr (cdr goals))))))))))
+
+ (local (defthm crock4
+          (implies (equal (app a b) x)
+                   (equal (firstn (len a) x)
+                          (list-fix a)))))
+
+ (local (defthm crock5
+          (implies (equal (app a b) x)
+                   (equal (restn (len a) x)
+                          (list-fix b)))))
+
+ (local (defthm crock6
+          (implies (equal (app a (app b c)) x)
+                   (equal (firstn (len b) (restn (len a) x))
+                          (list-fix b)))))
+
+ (local (defthm crock7
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.conclusion (car proofs))
+                          (logic.disjoin-formulas (logic.term-list-formulas (car goals)))))))
+
+ (local (defthm crock8
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.conclusion (second proofs))
+                          (logic.disjoin-formulas (logic.term-list-formulas (second goals)))))))
+
+ (local (defthm crock9
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (consp proofs)
+                          (consp goals)))))
+
+ (local (defthm crock10
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (consp (cdr proofs))
+                          (consp (cdr goals))))))
+
+ (local (defthm crock11
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.strip-conclusions (restn n (cdr (cdr proofs))))
+                          (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (restn n (cdr (cdr goals)))))))
+          :hints(("Goal"
+                  :in-theory (disable RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                  :use ((:instance RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                                   (Y n)
+                                   (X (LOGIC.TERM-LIST-LIST-FORMULAS (cdr (cdr goals))))))))))
+
+ (local (defthm crock12
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.strip-conclusions (firstn n (restn m proofs)))
+                          (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (firstn n (restn m goals))))))
+          :hints(("Goal"
+                  :in-theory (disable FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                                      RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                  :use ((:instance FIRSTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                                   (Y n)
+                                   (X (LOGIC.TERM-LIST-LIST-FORMULAS (restn m goals))))
+                        (:instance RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                                   (Y m)
+                                   (X (LOGIC.TERM-LIST-LIST-FORMULAS goals))))))))
+
+ (local (defthm crock13
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.strip-conclusions (firstn n (restn m (cdr (cdr proofs)))))
+                          (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (LOGIC.TERM-LIST-LIST-FORMULAS (firstn n (restn m (cdr (cdr goals))))))))))
+
+ (local (defthm crock14
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.strip-conclusions (restn n (restn m proofs)))
+                          (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (restn n (restn m goals))))))
+          :hints(("Goal"
+                  :in-theory (disable RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST)
+                  :use ((:instance RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                                   (Y n)
+                                   (X (LOGIC.TERM-LIST-LIST-FORMULAS (restn m goals))))
+                        (:instance RESTN-OF-LOGIC.DISJOIN-EACH-FORMULA-LIST
+                                   (Y m)
+                                   (X (LOGIC.TERM-LIST-LIST-FORMULAS goals))))))))
+
+ (local (defthm crock15
+          (implies (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS goals))
+                          (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                   (equal (logic.strip-conclusions (restn n (restn m (cdr (cdr proofs)))))
+                          (LOGIC.DISJOIN-EACH-FORMULA-LIST
+                           (LOGIC.TERM-LIST-LIST-FORMULAS (restn n (restn m (cdr (cdr goals))))))))))
+
+ (verify-guards tactic.induct-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.induct-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.induct-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.induct-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.induct-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.induct-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.induct-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.induct-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.induct-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.induct-env-okp x atbl)
+                        (tactic.skeleton-atblp x atbl)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'ordp atbl)) 1)
+                        (equal (cdr (lookup 'ord< atbl)) 2)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.induct-compile)))
+            (equal (logic.proof-listp (tactic.induct-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/make-image.lsp acl2-6.3/books/milawa/ACL2/tactics/make-image.lsp
--- acl2-6.2/books/milawa/ACL2/tactics/make-image.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/make-image.lsp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,12 @@
+(in-package "MILAWA")
+(include-book "../rewrite/fast-crewrite-clause")
+(include-book "../rewrite/traces/trace-arities")
+(include-book "../rewrite/theory-arities")
+(include-book "../rewrite/urewrite-clause")
+(include-book "../clauses/split-bldr")
+(include-book "../clauses/compiler")
+(include-book "../clauses/disjoined-update-clause-bldr")
+(include-book "../rewrite/gather")
+(ACL2::reset-prehistory)
+:q
+(ACL2::save-exec "../acl2-images/tactics-acl2" "Supporting books pre-loaded.")
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/partition.lisp acl2-6.3/books/milawa/ACL2/tactics/partition.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/partition.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/partition.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,336 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defprojection :list (rev-lists x)
+               :element (rev x)
+               :guard t
+               :nil-preservingp t)
+
+(defthm rev-lists-of-rev-lists
+  (equal (rev-lists (rev-lists x))
+         (list-list-fix x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund fast-app-lists$ (x acc)
+  (declare (xargs :guard (true-listp acc)))
+  (if (consp x)
+      (fast-app-lists$ (cdr x)
+                       (revappend (car x) acc))
+    acc))
+
+(definlined app-lists (x)
+  (fast-rev (fast-app-lists$ x nil)))
+
+(defund slow-app-lists (x)
+  (if (consp x)
+      (app (car x)
+           (slow-app-lists (cdr x)))
+    nil))
+
+(defthm slow-app-lists-when-not-consp
+  (implies (not (consp x))
+           (equal (slow-app-lists x)
+                  nil))
+  :hints(("Goal" :in-theory (enable slow-app-lists))))
+
+(defthm slow-app-lists-of-cons
+  (equal (slow-app-lists (cons a x))
+         (app a
+              (slow-app-lists x)))
+  :hints(("Goal" :in-theory (enable slow-app-lists))))
+
+(defthm true-listp-of-slow-app-lists
+  (equal (true-listp (slow-app-lists x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm slow-app-lists-of-list-fix
+  (equal (slow-app-lists (list-fix x))
+         (slow-app-lists x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm slow-app-lists-of-app
+  (equal (slow-app-lists (app x y))
+         (app (slow-app-lists x)
+              (slow-app-lists y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rev-of-slow-app-lists
+  (equal (rev (slow-app-lists x))
+         (slow-app-lists (rev (rev-lists x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm slow-app-lists-of-list-list-fix
+  (equal (slow-app-lists (list-list-fix x))
+         (slow-app-lists x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (true-listp acc)
+                   (equal (fast-app-lists$ x acc)
+                          (app (slow-app-lists (rev (rev-lists x)))
+                               acc)))
+          :hints(("Goal" :in-theory (enable fast-app-lists$)))))
+
+ (local (defthm lemma2
+          (equal (app-lists x)
+                 (slow-app-lists x))
+          :hints(("Goal" :in-theory (enable app-lists)))))
+
+ (defthmd definition-of-app-lists
+   (equal (app-lists x)
+          (if (consp x)
+              (app (car x)
+                   (slow-app-lists (cdr x)))
+            nil))
+   :rule-classes :definition))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition app-lists))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition fast-app-lists$))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition slow-app-lists))))
+
+(defthm app-lists-when-not-consp
+  (implies (not (consp x))
+           (equal (app-lists x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-app-lists))))
+
+(defthm app-lists-of-cons
+  (equal (app-lists (cons a x))
+         (app a (app-lists x)))
+  :hints(("Goal" :in-theory (enable definition-of-app-lists))))
+
+(defthm true-listp-of-app-lists
+  (equal (true-listp (app-lists x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm app-lists-of-list-fix
+  (equal (app-lists (list-fix x))
+         (app-lists x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm app-lists-of-app
+  (equal (app-lists (app x y))
+         (app (app-lists x)
+              (app-lists y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rev-of-app-lists
+  (equal (rev (app-lists x))
+         (app-lists (rev (rev-lists x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm app-lists-of-list-list-fix
+  (equal (app-lists (list-list-fix x))
+         (app-lists x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund fast-sum-list (x acc)
+  (declare (xargs :guard (natp acc)))
+  (if (consp x)
+      (fast-sum-list (cdr x) (+ (car x) acc))
+    acc))
+
+(definlined sum-list (x)
+  (fast-sum-list x 0))
+
+(defund slow-sum-list (x)
+  (if (consp x)
+      (+ (car x)
+         (slow-sum-list (cdr x)))
+    0))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (force (natp acc))
+                   (equal (fast-sum-list x acc)
+                          (+ (slow-sum-list x) acc)))
+          :hints(("Goal" :in-theory (enable fast-sum-list
+                                            slow-sum-list)))))
+
+ (defthmd definition-of-sum-list
+   (equal (sum-list x)
+          (if (consp x)
+              (+ (car x)
+                 (sum-list (cdr x)))
+            0))
+   :rule-classes :definition
+   :hints(("Goal" :in-theory (enable slow-sum-list sum-list)))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition sum-list))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition fast-sum-list))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition slow-sum-list))))
+
+(defthm sum-list-when-not-consp
+  (implies (not (consp x))
+           (equal (sum-list x)
+                  0))
+  :hints(("Goal" :in-theory (enable definition-of-sum-list))))
+
+(defthm sum-list-of-cons
+  (equal (sum-list (cons a x))
+         (+ a (sum-list x)))
+  :hints(("Goal" :in-theory (enable definition-of-sum-list))))
+
+(defthm natp-of-sum-list
+  (equal (natp (sum-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm sum-list-of-list-fix
+  (equal (sum-list (list-fix x))
+         (sum-list x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm sum-list-of-app
+  (equal (sum-list (app x y))
+         (+ (sum-list x) (sum-list y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm sum-list-of-rev
+  (equal (sum-list (rev x))
+         (sum-list x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthm len-of-restn
+  ;; BOZO move to utilities
+  (equal (len (restn n x))
+         (- (len x) n))
+  :hints(("Goal" :in-theory (enable restn))))
+
+(defthm len-of-firstn
+  ;; BOZO move to utilities
+  (equal (len (firstn n x))
+         (min n (len x)))
+  :hints(("Goal" :in-theory (enable firstn))))
+
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defund partition (lens x)
+   ;; Split x into sublists by their lengths.
+   ;; BOZO it would be a good idea to improve this function's efficiency, e.g.,
+   ;; tail recursion, a combined firstn/restn with no list-fixing, etc.
+   (declare (xargs :guard (and (nat-listp lens)
+                               (equal (sum-list lens) (len x)))))
+   (if (consp lens)
+       (cons (firstn (car lens) x)
+             (partition (cdr lens) (restn (car lens) x)))
+     nil)))
+
+(defthm partition-when-not-consp
+  (implies (not (consp lens))
+           (equal (partition lens x)
+                  nil))
+  :hints(("Goal" :in-theory (enable partition))))
+
+(defthm partition-of-cons
+  (equal (partition (cons len lens) x)
+         (cons (firstn len x)
+               (partition lens (restn len x))))
+  :hints(("Goal" :in-theory (enable partition))))
+
+;; I'm just going to be sloppy and enable partition when I need its induction
+;; scheme.
+
+(defthm partition-of-list-fix-one
+  (equal (partition (list-fix lens) x)
+         (partition lens x))
+  :hints(("Goal" :in-theory (enable partition))))
+
+(defthm partition-of-list-fix-two
+  (equal (partition lens (list-fix x))
+         (partition lens x))
+  :hints(("Goal" :in-theory (enable partition))))
+
+(defthm true-listp-of-partition
+  (equal (true-listp (partition lens x))
+         t)
+  :hints(("Goal" :in-theory (enable partition))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          ;; BOZO add to arithmetic?
+          (implies (and (not (zp b))
+                        (not (< a x)))
+                   (equal (equal (+ a b) x)
+                          nil))))
+
+ (defthm forcing-app-lists-of-partition
+   (implies (force (equal (sum-list lens) (len x)))
+            (equal (app-lists (partition lens x))
+                   (list-fix x)))
+   :hints(("Goal"
+           :in-theory (enable partition)
+           :induct (partition lens x)))))
+
+(defthm partition-of-strip-lens-of-app-lists
+  (equal (partition (strip-lens x) (app-lists x))
+         (list-list-fix x))
+  :hints(("Goal"
+          :induct (cdr-induction x))))
+
+(defthm partition-of-strip-lens-of-app-lists-free
+  (implies (equal lens (strip-lens x))
+           (equal (partition lens (app-lists x))
+                  (list-list-fix x))))
+
+(defthm partition-of-simple-flatten
+  (equal (partition (strip-lens x) (simple-flatten x))
+         (list-list-fix x))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable partition))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/rewrite-world.lisp acl2-6.3/books/milawa/ACL2/tactics/rewrite-world.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/rewrite-world.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/rewrite-world.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,570 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "worldp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; BOZO this belongs in fast-urewrite.
+
+(defund rw.fast-urewrite-list-list (x iffp control n)
+  ;; Note: enabled! (via definition rule below)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (booleanp iffp)
+                              (rw.controlp control)
+                              (natp n))
+                  :verify-guards t))
+  (if (consp x)
+      (cons (rw.ftraces->rhses (rw.fast-urewrite-list (car x) iffp control n))
+            (rw.fast-urewrite-list-list (cdr x) iffp control n))
+      nil))
+
+(defthm rw.fast-urewrite-list-list-removal
+  (implies (force (and (logic.term-list-listp x)
+                       (booleanp iffp)
+                       (rw.controlp control)))
+           (equal (rw.fast-urewrite-list-list x iffp control n)
+                  (rw.trace-list-list-rhses (rw.urewrite-list-list x iffp control n))))
+  :hints(("Goal" :in-theory (enable rw.fast-urewrite-list-list))))
+
+
+
+
+;; Rewriting using Worlds.
+;;
+;; Tactic.world->control produces the control structure implied by a world.  We
+;; show it is well-formed when the world is well-formed in the various ways.
+
+(defund tactic.world->control (theoryname world)
+  (declare (xargs :guard (tactic.worldp world)))
+  ;; Creates the control structure implied by a world.
+  (rw.control (tactic.world->noexec world)
+              (tactic.world->forcingp world)
+              (tactic.world->betamode world)
+              (cdr (lookup theoryname (tactic.world->theories world)))
+              (tactic.world->defs world)
+              (tactic.world->depth world)
+              (rw.assmctrl (tactic.world->assm-primaryp world)
+                           (tactic.world->assm-secondaryp world)
+                           (tactic.world->assm-directp world)
+                           (tactic.world->assm-negativep world))))
+
+(defthm rw.controlp-of-tactic.world->control
+  (implies (force (tactic.worldp world))
+           (equal (rw.controlp (tactic.world->control theoryname world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world->control))))
+
+(defthm rw.control-atblp-of-tactic.world->control
+  (implies (force (tactic.world-atblp world atbl))
+           (equal (rw.control-atblp (tactic.world->control theoryname world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world->control))))
+
+(defthm rw.control-env-okp-of-tactic.world->control
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (rw.control-env-okp (tactic.world->control theoryname world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world->control))))
+
+
+
+
+;; World-based wrappers for urewrite.
+;;
+;; These might look trivial, but we may use them as redefinition targets for
+;; our bootstrapping process.  They shouldn't be inlined.
+
+(defun rw.world-urewrite (x theoryname world)
+  ;; Note: enabled!
+  (declare (xargs :guard (and (logic.termp x)
+                              (tactic.worldp world))))
+  (rw.urewrite x t
+               (tactic.world->control theoryname world)
+               (tactic.world->urwn world)))
+
+(defund rw.world-urewrite-list (x theoryname world)
+  ;; Note: enabled!  (via definition rule below)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (tactic.worldp world))))
+  (if (consp x)
+      (cons (rw.world-urewrite (car x) theoryname world)
+            (rw.world-urewrite-list (cdr x) theoryname world))
+    nil))
+
+(defund rw.world-urewrite-list-list (x theoryname world)
+  ;; Note: enabled!  (via definition rule below)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (tactic.worldp world))))
+  ;; Note: don't change this to be non-recursive.  We want to make sure it calls
+  ;; rw.world-urewrite-list repeatedly, for bootstrapping redefinition purposes.
+  (if (consp x)
+      (cons (rw.world-urewrite-list (car x) theoryname world)
+            (rw.world-urewrite-list-list (cdr x) theoryname world))
+    nil))
+
+(defthm rw.world-urewrite-list-redefinition
+  (equal (rw.world-urewrite-list x theoryname world)
+         (rw.urewrite-list x t
+                           (tactic.world->control theoryname world)
+                           (tactic.world->urwn world)))
+  :hints(("Goal" :in-theory (enable rw.world-urewrite-list))))
+
+
+(defthm rw.world-urewrite-list-list-redefinition
+  (equal (rw.world-urewrite-list-list x theoryname world)
+         (rw.urewrite-list-list x t
+                                (tactic.world->control theoryname world)
+                                (tactic.world->urwn world)))
+  :hints(("Goal" :in-theory (enable rw.world-urewrite-list-list))))
+
+
+
+;; World-based wrappers for fast-urewrite.
+;;
+;; Again these shouldn't be inlined since we may want them as redefinition
+;; targets for our bootstrapping process.
+
+(defun rw.fast-world-urewrite (x theoryname world)
+  ;; Note: enabled!
+  (declare (xargs :guard (and (logic.termp x)
+                              (tactic.worldp world))))
+  ;; BOZO why do we return the whole ftrace instead of just a term?
+  (rw.fast-urewrite x t
+                    (tactic.world->control theoryname world)
+                    (tactic.world->urwn world)))
+
+(defund rw.fast-world-urewrite-list (x theoryname world)
+  ;; Note: enabled!  (via definition rule below)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (tactic.worldp world))))
+  (if (consp x)
+      (let ((car-rw (rw.fast-world-urewrite (car x) theoryname world))
+            (cdr-rw (rw.fast-world-urewrite-list (cdr x) theoryname world)))
+        (cons (rw.ftrace->rhs car-rw) cdr-rw))
+    nil))
+
+(defthm definition-of-rw.fast-world-urewrite-list
+  (equal (rw.fast-world-urewrite-list x theoryname world)
+         (rw.ftraces->rhses
+          (rw.fast-urewrite-list x t
+                                 (tactic.world->control theoryname world)
+                                 (tactic.world->urwn world))))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (e/d (rw.fast-world-urewrite-list
+                           definition-of-rw.fast-urewrite-list)
+                          ((:executable-counterpart acl2::force)
+                           tactic.world->control))
+          :restrict ((definition-of-rw.fast-urewrite-list ((x x)))))))
+
+(defund rw.fast-world-urewrite-list-list (x theoryname world)
+  ;; Note: enabled!  (via definition rule below)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (tactic.worldp world))))
+  ;; Note: don't change this to be non-recursive.  We want to make sure it calls
+  ;; rw.fast-world-urewrite-list repeatedly, for bootstrapping redefinition purposes.
+  (if (consp x)
+      (cons (rw.fast-world-urewrite-list (car x) theoryname world)
+            (rw.fast-world-urewrite-list-list (cdr x) theoryname world))
+    nil))
+
+(defthm definition-of-rw.fast-world-urewrite-list-list
+  (equal (rw.fast-world-urewrite-list-list x theoryname world)
+         (rw.fast-urewrite-list-list x t
+                                     (tactic.world->control theoryname world)
+                                     (tactic.world->urwn world)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (e/d (rw.fast-world-urewrite-list-list
+                           rw.fast-urewrite-list-list)
+                          (rw.fast-urewrite-list-list-removal
+                           (:executable-counterpart acl2::force)
+                           tactic.world->control)))))
+
+
+;; Proof-building wrappers
+;;
+;; These are used by the urewrite tactics and our waterfall tactic.  These
+;; functions are not just trivial wrappers.  They provide an important target
+;; for redefinition in the bootstrapping process; see Level 9.
+
+(defund rw.world-urewrite-list-bldr (x result fastp theoryname world traces proof)
+  (declare (xargs :guard (and (consp x)
+                              (logic.term-listp x)
+                              (logic.term-listp result)
+                              (booleanp fastp)
+                              (tactic.worldp world)
+                              (equal result (rw.fast-world-urewrite-list x theoryname world))
+                              (or fastp (equal traces (rw.world-urewrite-list x theoryname world)))
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (clause.clause-formula result))))
+           (ignore result))
+  ;; This is our main builder that gets redefined in level 9.
+  (ACL2::prog2$
+   (or (not fastp)
+       (ACL2::cw "Warning: rw.world-urewrite-list-bldr having to do a slow urewrite to ~
+                  build proofs in fast mode.~%"))
+   (let ((traces (if fastp
+                     (rw.world-urewrite-list x theoryname world)
+                   traces))
+         (control (tactic.world->control theoryname world))
+         (urwn    (tactic.world->urwn world)))
+     (rw.urewrite-clause-bldr x control urwn traces proof))))
+
+(defobligations rw.world-urewrite-list-bldr
+  (rw.urewrite-clause-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.world-urewrite-list-bldr)))
+
+ (defthm logic.appealp-of-rw.world-urewrite-list-bldr
+   (implies (force (and (consp x)
+                        (logic.term-listp x)
+                        (logic.term-listp result)
+                        (booleanp fastp)
+                        (tactic.worldp world)
+                        (equal result (rw.fast-world-urewrite-list x theoryname world))
+                        (or fastp (equal traces (rw.world-urewrite-list x theoryname world)))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (clause.clause-formula result))))
+            (equal (logic.appealp (rw.world-urewrite-list-bldr x result fastp theoryname world traces proof))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.world-urewrite-list-bldr
+   (implies (force (and (consp x)
+                        (logic.term-listp x)
+                        (logic.term-listp result)
+                        (booleanp fastp)
+                        (tactic.worldp world)
+                        (equal result (rw.fast-world-urewrite-list x theoryname world))
+                        (or fastp (equal traces (rw.world-urewrite-list x theoryname world)))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (clause.clause-formula result))))
+            (equal (logic.conclusion (rw.world-urewrite-list-bldr x result fastp theoryname world traces proof))
+                   (clause.clause-formula x))))
+
+ (defthm@ logic.proofp-of-rw.world-urewrite-list-bldr
+   (implies (force (and (consp x)
+                        (logic.term-listp x)
+                        (logic.term-listp result)
+                        (booleanp fastp)
+                        (tactic.worldp world)
+                        (equal result (rw.fast-world-urewrite-list x theoryname world))
+                        (or fastp (equal traces (rw.world-urewrite-list x theoryname world)))
+                        (logic.appealp proof)
+                        (equal (logic.conclusion proof) (clause.clause-formula result))
+                        ;; ---
+                        (logic.term-list-atblp x atbl)
+                        (tactic.world-atblp world atbl)
+                        (tactic.world-env-okp world axioms thms)
+                        (logic.proofp proof axioms thms atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.world-urewrite-list-bldr)))
+            (equal (logic.proofp (rw.world-urewrite-list-bldr x result fastp theoryname world traces proof)
+                                 axioms thms atbl)
+                   t))))
+
+
+
+;; BOZO note if any problems consider tactic.fast-world-list-env-okp-correct in level9.lisp
+
+(defthm logic.term-listp-of-rw.trace-list-rhses-free
+  ;; BOZO find me a home
+  (implies (and (equal free (rw.trace-list-rhses x))
+                (force (rw.trace-listp x)))
+           (equal (logic.term-listp free)
+                  t)))
+
+(defund rw.world-urewrite-list-bldr-high (x result fastp theoryname world traces proof)
+  (declare (xargs :guard (and (consp x)
+                              (logic.term-listp x)
+                              (logic.term-listp result)
+                              (booleanp fastp)
+                              (tactic.worldp world)
+                              (equal result (rw.fast-world-urewrite-list x theoryname world))
+                              (or fastp (equal traces (rw.world-urewrite-list x theoryname world)))
+                              (logic.appealp proof)
+                              (equal (logic.conclusion proof) (clause.clause-formula result))))
+           (ignore fastp traces))
+  (logic.appeal 'rw.world-urewrite-list-bldr
+                (clause.clause-formula x)
+                (list proof)
+                (list x result theoryname (tactic.world->index world))))
+
+(defund rw.world-urewrite-list-bldr-okp (x worlds atbl)
+  (declare (xargs :guard (and (logic.appealp x)
+                              (tactic.world-listp worlds)
+                              (logic.arity-tablep atbl))))
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'rw.world-urewrite-list-bldr)
+         (tuplep 1 subproofs)
+         (tuplep 4 extras)
+         (let* ((orig-clause   (first extras))
+                (result-clause (second extras))
+                (theoryname    (third extras))
+                (windex        (fourth extras))
+                (world         (tactic.find-world windex worlds))
+                (subconc       (logic.conclusion (first subproofs))))
+           (and world
+                (consp orig-clause)
+                (consp result-clause)
+                (logic.term-listp orig-clause)
+                (logic.term-list-atblp orig-clause atbl)
+                (equal (rw.fast-world-urewrite-list orig-clause theoryname world)
+                       result-clause)
+                (equal subconc (clause.clause-formula result-clause))
+                (equal conclusion (clause.clause-formula orig-clause)))))))
+
+(defthm rw.world-urewrite-list-bldr-okp-of-rw.world-urewrite-list-bldr-high
+  ;; This isn't strictly necessary, but helps make sure we haven't screwed
+  ;; anything up.
+  (implies (and (consp x)
+                (logic.term-listp x)
+                (logic.term-listp result)
+                (booleanp fastp)
+                (tactic.worldp world)
+                (equal result (rw.fast-world-urewrite-list x theoryname world))
+                (or fastp (equal traces (rw.world-urewrite-list x theoryname world)))
+                (logic.appealp proof)
+                (equal (logic.conclusion proof) (clause.clause-formula result))
+                ;; --- hrmn, some non-guard things that ought to be true ---
+                (logic.term-list-atblp x atbl)
+                (equal (tactic.find-world (tactic.world->index world) worlds) world))
+           (equal (rw.world-urewrite-list-bldr-okp
+                   (rw.world-urewrite-list-bldr-high x result fastp theoryname world traces proof)
+                   worlds atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (rw.world-urewrite-list-bldr-high
+                                  rw.world-urewrite-list-bldr-okp)))))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.world-urewrite-list-bldr-okp)))
+
+ (defthm booleanp-of-rw.world-urewrite-list-bldr-okp
+   (equal (booleanp (rw.world-urewrite-list-bldr-okp x worlds atbl))
+          t)
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthm rw.world-urewrite-list-bldr-okp-of-logic.appeal-identity
+   (equal (rw.world-urewrite-list-bldr-okp (logic.appeal-identity x) worlds atbl)
+          (rw.world-urewrite-list-bldr-okp x worlds atbl))
+   :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force)))))
+
+ (defthmd lemma-1-for-soundness-of-rw.world-urewrite-list-bldr-okp
+   (implies (and (rw.world-urewrite-list-bldr-okp x worlds atbl)
+                 (logic.appealp x)
+                 (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                 (tactic.world-listp worlds)
+                 (tactic.world-list-atblp worlds atbl)
+                 (tactic.world-list-env-okp worlds axioms thms))
+            (equal (logic.conclusion
+                    (let ((orig-clause   (first (logic.extras x)))
+                          (result-clause (second (logic.extras x)))
+                          (theoryname    (third (logic.extras x)))
+                          (fastp         t) ;; so no traces are needed
+                          (world         (tactic.find-world (fourth (logic.extras x)) worlds))
+                          (traces        nil) ;; since fastp is set
+                          (proof         (logic.provable-witness (logic.conclusion
+                                                                  (first (logic.subproofs x)))
+                                                                 axioms thms atbl)))
+                      (rw.world-urewrite-list-bldr orig-clause result-clause fastp theoryname
+                                                   world traces proof)))
+                   (logic.conclusion x))))
+
+ (defthmd@ lemma-2-for-soundness-of-rw.world-urewrite-list-bldr-okp
+  (implies (and (rw.world-urewrite-list-bldr-okp x worlds atbl)
+                (logic.appealp x)
+                (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                (tactic.world-listp worlds)
+                (tactic.world-list-atblp worlds atbl)
+                (tactic.world-list-env-okp worlds axioms thms)
+                (equal (cdr (lookup 'if atbl)) 3)
+                (equal (cdr (lookup 'not atbl)) 1)
+                (equal (cdr (lookup 'equal atbl)) 2)
+                (equal (cdr (lookup 'iff atbl)) 2)
+                (@obligations rw.world-urewrite-list-bldr))
+           (equal (logic.proofp
+                   (let ((orig-clause   (first (logic.extras x)))
+                         (result-clause (second (logic.extras x)))
+                         (theoryname    (third (logic.extras x)))
+                         (fastp         t) ;; so no traces are needed
+                         (world         (tactic.find-world (fourth (logic.extras x)) worlds))
+                         (traces        nil) ;; since fastp is set
+                         (proof         (logic.provable-witness (logic.conclusion
+                                                                 (first (logic.subproofs x)))
+                                                                axioms thms atbl)))
+                     (rw.world-urewrite-list-bldr orig-clause result-clause fastp theoryname
+                                                  world traces proof))
+                   axioms thms atbl)
+                   t)))
+
+ (defthm@ forcing-soundness-of-rw.world-urewrite-list-bldr-okp
+   (implies (and (rw.world-urewrite-list-bldr-okp x worlds atbl)
+                 (force (and (logic.appealp x)
+                             (logic.provable-listp (logic.strip-conclusions (logic.subproofs x)) axioms thms atbl)
+                             (tactic.world-listp worlds)
+                             (tactic.world-list-atblp worlds atbl)
+                             (tactic.world-list-env-okp worlds axioms thms)
+                             (equal (cdr (lookup 'if atbl)) 3)
+                             (equal (cdr (lookup 'not atbl)) 1)
+                             (equal (cdr (lookup 'equal atbl)) 2)
+                             (equal (cdr (lookup 'iff atbl)) 2)
+                             (@obligations rw.world-urewrite-list-bldr))))
+            (equal (logic.provablep (logic.conclusion x) axioms thms atbl)
+                   t))
+   :hints (("Goal"
+            :use ((:instance lemma-1-for-soundness-of-rw.world-urewrite-list-bldr-okp)
+                  (:instance lemma-2-for-soundness-of-rw.world-urewrite-list-bldr-okp)
+                  (:instance forcing-logic.provablep-when-logic.proofp
+                             (x
+                              (let ((orig-clause   (first (logic.extras x)))
+                                    (result-clause (second (logic.extras x)))
+                                    (theoryname    (third (logic.extras x)))
+                                    (fastp         t) ;; so no traces are needed
+                                    (world         (tactic.find-world (fourth (logic.extras x)) worlds))
+                                    (traces        nil) ;; since fastp is set
+                                    (proof         (logic.provable-witness (logic.conclusion
+                                                                            (first (logic.subproofs x)))
+                                                                           axioms thms atbl)))
+                                (rw.world-urewrite-list-bldr orig-clause result-clause fastp theoryname
+                                                             world traces proof)))))))))
+
+
+
+
+
+(defund rw.world-urewrite-list-list-bldr (x result fastp theoryname world traces proofs)
+  (declare (xargs :guard (and (cons-listp x)
+                              (logic.term-list-listp x)
+                              (logic.term-list-listp result)
+                              (booleanp fastp)
+                              (tactic.worldp world)
+                              (equal result (rw.fast-world-urewrite-list-list x theoryname world))
+                              (or fastp (equal traces (rw.world-urewrite-list-list x theoryname world)))
+                              (logic.appeal-listp proofs)
+                              (equal (logic.strip-conclusions proofs) (clause.clause-list-formulas result)))))
+  ;; BOZO don't change this to be non-recursive.  We want to be sure to call
+  ;; rw.world-urewrite-list-bldr repeatedly, for bootstrapping purposes.  Each
+  ;; rw.world-urewrite-list will become a single proof step at the high levels.
+  ;; But we can't do multiple clauses at once in a regular appeal.
+
+  ;;   ;; Non-recursive version, doesn't work for redef.
+  ;;   (ACL2::prog2$
+  ;;    (or (not fastp)
+  ;;        (ACL2::cw "Warning: rw.world-urewrite-list-list-bldr having to do a slow urewrite to ~
+  ;;                   build proofs in fast mode.~%"))
+  ;;    (let ((traces (if fastp
+  ;;                      (rw.world-urewrite-list-list x t theoryname world)
+  ;;                    traces))
+  ;;          (control (tactic.world->control theoryname world))
+  ;;          (rwn     (tactic.world->rwn world)))
+  ;;      (rw.urewrite-clause-list-bldr x control rwn traces proofs))))
+
+  (if (consp x)
+      (cons (rw.world-urewrite-list-bldr (car x) (car result) fastp theoryname world (car traces) (car proofs))
+            (rw.world-urewrite-list-list-bldr (cdr x) (cdr result) fastp theoryname world (cdr traces) (cdr proofs)))
+    nil))
+
+(defobligations rw.world-urewrite-list-list-bldr
+  (rw.urewrite-clause-list-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable rw.world-urewrite-list-list-bldr)))
+
+ (defthm logic.appeal-listp-of-rw.world-urewrite-list-bldr
+   (implies (force (and (cons-listp x)
+                        (logic.term-list-listp x)
+                        (logic.term-list-listp result)
+                        (booleanp fastp)
+                        (tactic.worldp world)
+                        (equal result (rw.fast-world-urewrite-list-list x theoryname world))
+                        (or fastp (equal traces (rw.world-urewrite-list-list x theoryname world)))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (clause.clause-list-formulas result))))
+            (equal (logic.appeal-listp (rw.world-urewrite-list-list-bldr x result fastp theoryname world traces proofs))
+                   t)))
+
+ (defthm logic.conclusion-of-rw.world-urewrite-list-list-bldr
+   (implies (force (and (cons-listp x)
+                        (logic.term-list-listp x)
+                        (logic.term-list-listp result)
+                        (booleanp fastp)
+                        (tactic.worldp world)
+                        (equal result (rw.fast-world-urewrite-list-list x theoryname world))
+                        (or fastp (equal traces (rw.world-urewrite-list-list x theoryname world)))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (clause.clause-list-formulas result))))
+            (equal (logic.strip-conclusions
+                    (rw.world-urewrite-list-list-bldr x result fastp theoryname world traces proofs))
+                   (clause.clause-list-formulas x))))
+
+ (defthm@ logic.proofp-of-rw.world-urewrite-list-list-bldr
+   (implies (force (and (cons-listp x)
+                        (logic.term-list-listp x)
+                        (logic.term-list-listp result)
+                        (booleanp fastp)
+                        (tactic.worldp world)
+                        (equal result (rw.fast-world-urewrite-list-list x theoryname world))
+                        (or fastp (equal traces (rw.world-urewrite-list-list x theoryname world)))
+                        (logic.appeal-listp proofs)
+                        (equal (logic.strip-conclusions proofs) (clause.clause-list-formulas result))
+                        ;; ---
+                        (logic.term-list-list-atblp x atbl)
+                        (tactic.world-atblp world atbl)
+                        (tactic.world-env-okp world axioms thms)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (@obligations rw.world-urewrite-list-list-bldr)))
+            (equal (logic.proof-listp
+                    (rw.world-urewrite-list-list-bldr x result fastp theoryname world traces proofs)
+                    axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/simple-world-change.lisp acl2-6.3/books/milawa/ACL2/tactics/simple-world-change.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/simple-world-change.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/simple-world-change.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,200 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "worldp")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund tactic.simple-world-change-aux (changes world)
+  (declare (xargs :guard (tactic.worldp world)))
+  (if (consp changes)
+      (let ((field (car (car changes)))
+            (value (cdr (car changes))))
+        (tactic.simple-world-change-aux
+         (cdr changes)
+         (cond ((equal field 'forcingp)   (change-tactic.world world :forcingp (if value t nil)))
+               ((equal field 'betamode)   (change-tactic.world world :betamode (if (symbolp value) value nil)))
+
+               ((equal field 'assm-primaryp)     (change-tactic.world world :assm-primaryp (if value t nil)))
+               ((equal field 'assm-secondaryp)   (change-tactic.world world :assm-secondaryp (if value t nil)))
+               ((equal field 'assm-directp)      (change-tactic.world world :assm-directp (if value t nil)))
+               ((equal field 'assm-negativep)    (change-tactic.world world :assm-negativep (if value t nil)))
+
+               ((equal field 'liftlimit)  (change-tactic.world world :liftlimit (nfix value)))
+               ((equal field 'splitlimit) (change-tactic.world world :splitlimit (nfix value)))
+               ((equal field 'blimit)     (change-tactic.world world :blimit (nfix value)))
+               ((equal field 'rlimit)     (change-tactic.world world :rlimit (nfix value)))
+               ((equal field 'rwn)        (change-tactic.world world :rwn (nfix value)))
+               ((equal field 'urwn)       (change-tactic.world world :urwn (nfix value)))
+               ((equal field 'depth)      (change-tactic.world world :depth (nfix value)))
+
+               (t
+                (ACL2::prog2$
+                 (ACL2::cw "Warning: unknown field for tactic.simple-world-change-aux: ~x0.~%" field)
+                 world)))))
+    world))
+
+(defthm tactic.worldp-of-tactic.simple-world-change-aux
+  (implies (force (tactic.worldp world))
+           (equal (tactic.worldp (tactic.simple-world-change-aux changes world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-world-change-aux))))
+
+(defthm tactic.world-atblp-of-tactic.simple-world-change-aux
+  (implies (force (tactic.world-atblp world atbl))
+           (equal (tactic.world-atblp (tactic.simple-world-change-aux changes world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-world-change-aux))))
+
+(defthm tactic.world-env-okp-of-tactic.simple-world-change-aux
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (tactic.world-env-okp (tactic.simple-world-change-aux changes world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-world-change-aux))))
+
+(defthm tactic.world->index-of-tactic.simple-world-change-aux
+  (equal (tactic.world->index (tactic.simple-world-change-aux changes world))
+         (tactic.world->index world))
+  :hints(("Goal" :in-theory (enable tactic.simple-world-change-aux))))
+
+
+
+(defund tactic.simple-world-change (changes world)
+  (declare (xargs :guard (tactic.worldp world)))
+  (tactic.increment-world-index
+   (tactic.simple-world-change-aux changes world)))
+
+(defthm tactic.worldp-of-tactic.simple-world-change
+  (implies (force (tactic.worldp world))
+           (equal (tactic.worldp (tactic.simple-world-change changes world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-world-change))))
+
+(defthm tactic.world-atblp-of-tactic.simple-world-change
+  (implies (force (tactic.world-atblp world atbl))
+           (equal (tactic.world-atblp (tactic.simple-world-change changes world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-world-change))))
+
+(defthm tactic.world-env-okp-of-tactic.simple-world-change
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (tactic.world-env-okp (tactic.simple-world-change changes world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-world-change))))
+
+(defthm tactic.world->index-of-tactic.simple-world-change
+  (equal (tactic.world->index (tactic.simple-world-change changes world))
+         (+ 1 (tactic.world->index world)))
+  :hints(("Goal" :in-theory (enable tactic.simple-world-change))))
+
+
+
+(defund tactic.simple-change-world-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        ;(extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'simple-change-world)
+         (equal goals (tactic.skeleton->goals history))
+         ;; Extras hold the changes.  But we don't need to know anything about
+         ;; them.
+         )))
+
+(defthm booleanp-of-tactic.simple-change-world-okp
+  (equal (booleanp (tactic.simple-change-world-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.simple-change-world-okp))))
+
+(defthm tactic.skeleton->goals-when-tactic.simple-change-world-okp
+  (implies (tactic.simple-change-world-okp x)
+           (equal (tactic.skeleton->goals x)
+                  (tactic.skeleton->goals (tactic.skeleton->history x))))
+  :hints(("Goal" :in-theory (enable tactic.simple-change-world-okp))))
+
+
+
+(defund tactic.simple-change-world-tac (x changes)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (tactic.extend-skeleton (tactic.skeleton->goals x)
+                          'simple-change-world
+                          changes
+                          x))
+
+(defthm tactic.skeletonp-of-tactic.simple-change-world-tac
+  (implies (force (tactic.skeletonp x))
+           (equal (tactic.skeletonp (tactic.simple-change-world-tac x changes))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-change-world-tac))))
+
+(defthm tactic.simple-change-world-okp-of-tactic.simple-change-world-tac
+  (implies (force (tactic.skeletonp x))
+           (equal (tactic.simple-change-world-okp (tactic.simple-change-world-tac x changes))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-change-world-tac
+                                    tactic.simple-change-world-okp))))
+
+
+
+(defund tactic.simple-change-world-compile-world (x world)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.simple-change-world-okp x)
+                              (tactic.worldp world))))
+  (tactic.simple-world-change (tactic.skeleton->extras x) world))
+
+
+(defthm tactic.worldp-of-tactic.simple-change-world-compile-world
+  (implies (force (tactic.worldp world))
+           (equal (tactic.worldp (tactic.simple-change-world-compile-world x world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-change-world-compile-world))))
+
+(defthm tactic.world-atblp-of-tactic.simple-change-world-compile-world
+  (implies (force (tactic.world-atblp world atbl))
+           (equal (tactic.world-atblp (tactic.simple-change-world-compile-world x world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-change-world-compile-world))))
+
+(defthm tactic.world-env-okp-of-tactic.simple-change-world-compile-world
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (tactic.world-env-okp (tactic.simple-change-world-compile-world x world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.simple-change-world-compile-world))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/skeletonp.lisp acl2-6.3/books/milawa/ACL2/tactics/skeletonp.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/skeletonp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/skeletonp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,428 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Proof skeletons.
+;;
+;; Skeletons are used by our tactics to keep track of our progress and our
+;; remaining obligations during a goal-directed proof attempt.
+;;
+;; Each skeleton includes a list of goals, which are clauses, which we still
+;; need to prove.  If this list is empty, we have proven everything we wanted
+;; to show and we are done.  Otherwise, we should try to apply more tactics to
+;; finish the proof.
+;;
+;; When we begin a proof attempt and we want to prove some clause, Phi, we
+;; create an "initial skeleton" whose only goal is Phi.  Each time we apply a
+;; tactic, we create an "extended skeleton" which aggregates:
+;;
+;;   - A new set of goals to prove,
+;;   - The skeleton for our current goals,
+;;   - The name of the tactic we used,
+;;   - Any additional information the tactic needs to prove the current
+;;     goals, given proofs of the new goals.
+;;
+;; We represent skeletons as simple tuples of the form (goals tacname extras
+;; history), and the initial skeleton uses nil for its name and extras.
+
+(defund tactic.skeletonp (x)
+  (declare (xargs :guard t))
+  (and (tuplep 4 x)
+       (let ((goals   (first x))
+             (tacname (second x))
+             (history (fourth x)))
+         (and (logic.term-list-listp goals)
+              (cons-listp goals)
+              (true-listp goals)
+              (symbolp tacname)
+              (or (not tacname)
+                  (tactic.skeletonp history))))))
+
+(definlined tactic.skeleton->goals (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (first x))
+
+(definlined tactic.skeleton->tacname (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (second x))
+
+(definlined tactic.skeleton->extras (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (third x))
+
+(definlined tactic.skeleton->history (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (fourth x))
+
+
+
+(defthm booleanp-of-tactic.skeletonp
+  (equal (booleanp (tactic.skeletonp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.skeletonp))))
+
+(defthm forcing-logic.term-list-listp-of-tactic.skeleton->goals
+  (implies (force (tactic.skeletonp x))
+           (equal (logic.term-list-listp (tactic.skeleton->goals x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeletonp tactic.skeleton->goals))))
+
+(defthm forcing-cons-listp-of-tactic.skeleton->goals
+  (implies (force (tactic.skeletonp x))
+           (equal (cons-listp (tactic.skeleton->goals x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeletonp tactic.skeleton->goals))))
+
+(defthm forcing-true-listp-of-tactic.skeleton->goals
+  (implies (force (tactic.skeletonp x))
+           (equal (true-listp (tactic.skeleton->goals x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeletonp tactic.skeleton->goals))))
+
+(defthm forcing-symbolp-of-tactic.skeleton->tacname
+  (implies (force (tactic.skeletonp x))
+           (equal (symbolp (tactic.skeleton->tacname x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeletonp tactic.skeleton->tacname))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.skeleton->history
+  (implies (and (tactic.skeleton->tacname x)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.skeleton->history x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeletonp
+                                    tactic.skeleton->history
+                                    tactic.skeleton->tacname))))
+
+(defthm rank-of-tactic.skeleton->history-when-tactic.skeleton->tacname
+  (implies (tactic.skeleton->tacname x)
+           (< (rank (tactic.skeleton->history x))
+              (rank x)))
+  :hints(("Goal" :in-theory (enable tactic.skeleton->tacname tactic.skeleton->history))))
+
+
+
+
+(definlined tactic.initial-skeleton (goals)
+  (declare (xargs :guard (and (logic.term-list-listp goals)
+                              (cons-listp goals)
+                              (true-listp goals))))
+  (list goals nil nil nil))
+
+(defthm tactic.skeleton->goals-of-tactic.initial-skeleton
+  (equal (tactic.skeleton->goals (tactic.initial-skeleton goals))
+         goals)
+  :hints(("Goal" :in-theory (enable tactic.initial-skeleton tactic.skeleton->goals))))
+
+(defthm tactic.skeleton->tacname-of-tactic.initial-skeleton
+  (equal (tactic.skeleton->tacname (tactic.initial-skeleton goals))
+         nil)
+  :hints(("Goal" :in-theory (enable tactic.initial-skeleton tactic.skeleton->tacname))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.initial.skeleton
+  (implies (force (and (logic.term-list-listp goals)
+                       (cons-listp goals)
+                       (true-listp goals)))
+           (equal (tactic.skeletonp (tactic.initial-skeleton goals))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.initial-skeleton tactic.skeletonp))))
+
+
+
+
+(definlined tactic.extend-skeleton (goals tacname extras history)
+  (declare (xargs :guard (and (logic.term-list-listp goals)
+                              (cons-listp goals)
+                              (true-listp goals)
+                              (symbolp tacname)
+                              tacname
+                              (tactic.skeletonp history))))
+  (list goals tacname extras history))
+
+(defthm tactic.skeleton->goals-of-tactic.extend-skeleton
+  (equal (tactic.skeleton->goals (tactic.extend-skeleton goals tacname extras history))
+         goals)
+  :hints(("Goal" :in-theory (enable tactic.extend-skeleton tactic.skeleton->goals))))
+
+(defthm tactic.skeleton->tacname-of-tactic.extend-skeleton
+  (equal (tactic.skeleton->tacname (tactic.extend-skeleton goals tacname extras history))
+         tacname)
+  :hints(("Goal" :in-theory (enable tactic.extend-skeleton tactic.skeleton->tacname))))
+
+(defthm tactic.skeleton->extras-of-tactic.extend-skeleton
+  (equal (tactic.skeleton->extras (tactic.extend-skeleton goals tacname extras history))
+         extras)
+  :hints(("Goal" :in-theory (enable tactic.extend-skeleton tactic.skeleton->extras))))
+
+(defthm tactic.skeleton->history-of-tactic.extend-skeleton
+  (equal (tactic.skeleton->history (tactic.extend-skeleton goals tacname extras history))
+         history)
+  :hints(("Goal" :in-theory (enable tactic.extend-skeleton tactic.skeleton->history))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.extend.skeleton
+  (implies (force (and (logic.term-list-listp goals)
+                       (cons-listp goals)
+                       (true-listp goals)
+                       (symbolp tacname)
+                       tacname
+                       (tactic.skeletonp history)))
+           (equal (tactic.skeletonp (tactic.extend-skeleton goals tacname extras history))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeletonp tactic.extend-skeleton))))
+
+
+
+
+(defund tactic.original-conclusions (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (if (tactic.skeleton->tacname x)
+      (tactic.original-conclusions (tactic.skeleton->history x))
+    (tactic.skeleton->goals x)))
+
+(defthm forcing-logic.term-list-listp-of-tactic.original-conclusion
+  (implies (force (tactic.skeletonp x))
+           (equal (logic.term-list-listp (tactic.original-conclusions x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.original-conclusions))))
+
+(defthm forcing-cons-listp-of-tactic.original-conclusion
+  (implies (force (tactic.skeletonp x))
+           (equal (cons-listp (tactic.original-conclusions x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.original-conclusions))))
+
+(defthm forcing-true-listp-of-tactic.original-conclusion
+  (implies (force (tactic.skeletonp x))
+           (equal (true-listp (tactic.original-conclusions x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.original-conclusions))))
+
+(defthm tactic.original-conclusions-of-tactic.initial-skeleton
+  (equal (tactic.original-conclusions (tactic.initial-skeleton goals))
+         goals)
+  :hints(("Goal" :in-theory (enable tactic.original-conclusions))))
+
+(defthm forcing-tactic.original-conclusions-of-tactic.extend-skeleton
+  (implies (force tacname)
+           (equal (tactic.original-conclusions (tactic.extend-skeleton goals tacname extras history))
+                  (tactic.original-conclusions history)))
+  :hints(("Goal" :in-theory (enable tactic.original-conclusions))))
+
+
+
+
+(defund tactic.skeleton-atblp (x atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.arity-tablep atbl))))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (history (tactic.skeleton->history x)))
+    (and (logic.term-list-list-atblp goals atbl)
+         (or (not tacname)
+             (tactic.skeleton-atblp history atbl)))))
+
+(defthm booleanp-of-tactic.skeleton-atbp
+  (equal (booleanp (tactic.skeleton-atblp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.skeleton-atblp))))
+
+(defthm forcing-logic.term-list-list-atblp-of-tactic.skeleton->goals
+  (implies (force (tactic.skeleton-atblp x atbl))
+           (equal (logic.term-list-list-atblp (tactic.skeleton->goals x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeleton-atblp))))
+
+(defthm forcing-tactic.skeleton-atblp-of-tactic.skeleton->history
+  (implies (force (and (tactic.skeleton-atblp x atbl)
+                       (tactic.skeleton->tacname x)))
+           (equal (tactic.skeleton-atblp (tactic.skeleton->history x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (tactic.skeleton-atblp)
+                                 (forcing-logic.term-list-list-atblp-of-tactic.skeleton->goals)))))
+
+(defthm forcing-tactic.skeleton-atblp-of-tactic.initial.skeleton
+  (implies (force (logic.term-list-list-atblp goals atbl))
+           (equal (tactic.skeleton-atblp (tactic.initial-skeleton goals) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeleton-atblp))))
+
+(defthm forcing-tactic.skeleton-atblp-of-tactic.extend.skeleton
+  (implies (force (and (logic.term-list-list-atblp goals atbl)
+                       (tactic.skeleton-atblp history atbl)))
+           (equal (tactic.skeleton-atblp (tactic.extend-skeleton goals tacname extras history) atbl)
+                  t))
+  :hints(("Goal" :in-theory (e/d (tactic.skeleton-atblp)
+                                 (forcing-logic.term-list-list-atblp-of-tactic.skeleton->goals
+                                  forcing-tactic.skeleton-atblp-of-tactic.skeleton->history)))))
+
+(defthm forcing-logic.term-list-list-atblp-of-tactic.original-conclusion
+  (implies (force (tactic.skeleton-atblp x atbl))
+           (equal (logic.term-list-list-atblp (tactic.original-conclusions x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.original-conclusions))))
+
+
+
+
+(defund tactic.skeleton->len (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (if (tactic.skeleton->tacname x)
+      (+ 1 (tactic.skeleton->len (tactic.skeleton->history x)))
+    1))
+
+(defthm natp-of-tactic.skeleton->len
+  (equal (natp (tactic.skeleton->len x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.skeleton->len))))
+
+(defthm tactic.skeleton->len-nonzero
+  (equal (equal 0 (tactic.skeleton->len x))
+         nil)
+  :hints(("Goal" :in-theory (enable tactic.skeleton->len))))
+
+(defthm tactic.skeleton->len-when-not-tacname
+  (implies (not (tactic.skeleton->tacname x))
+           (equal (tactic.skeleton->len x)
+                  1))
+  :hints(("Goal" :in-theory (enable tactic.skeleton->len))))
+
+
+
+
+(defund logic.slow-term-list-list-arities (x)
+  (declare (xargs :guard (logic.term-list-listp x)))
+  (if (consp x)
+      ;; Reverse order gives us a tail call in the fast version
+      (app (logic.slow-term-list-list-arities (cdr x))
+           (logic.slow-term-list-arities (car x)))
+    nil))
+
+(defund logic.term-list-list-arities (x acc)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (logic.term-list-list-arities (cdr x)
+                                  (logic.term-list-arities (car x) acc))
+    acc))
+
+(defthm true-listp-of-logic.term-list-list-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (logic.term-list-list-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable logic.term-list-list-arities))))
+
+(defthm logic.term-list-list-arities-removal
+  (implies (force (true-listp acc))
+           (equal (logic.term-list-list-arities x acc)
+                  (app (logic.slow-term-list-list-arities x) acc)))
+  :hints(("Goal" :in-theory (enable logic.term-list-list-arities
+                                    logic.slow-term-list-list-arities))))
+
+(defthm logic.slow-term-list-list-arities-correct
+  (implies (force (logic.term-list-listp x))
+           (equal (logic.arities-okp (logic.slow-term-list-list-arities x) atbl)
+                  (logic.term-list-list-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((logic.term-list-list-atblp x atbl)
+                   (logic.slow-term-list-list-arities x)))))
+
+
+
+(defund tactic.slow-skeleton-arities (x)
+  (declare (xargs :guard (tactic.skeletonp x)
+                  :measure (rank x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (history (tactic.skeleton->history x)))
+    (if (not tacname)
+        (logic.slow-term-list-list-arities goals)
+      (app (tactic.slow-skeleton-arities history)
+           (logic.slow-term-list-list-arities goals)))))
+
+(defund tactic.skeleton-arities (x acc)
+   (declare (xargs :guard (and (tactic.skeletonp x)
+                               (true-listp acc))))
+   (let ((goals   (tactic.skeleton->goals x))
+         (tacname (tactic.skeleton->tacname x))
+         (history (tactic.skeleton->history x)))
+     (if (not tacname)
+         (logic.term-list-list-arities goals acc)
+       (tactic.skeleton-arities history
+                                (logic.term-list-list-arities goals acc)))))
+
+(defthm true-listp-of-tactic.skeleton-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (tactic.skeleton-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skeleton-arities))))
+
+(defthm tactic.skeleton-arities-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.skeleton-arities x acc)
+                  (app (tactic.slow-skeleton-arities x) acc)))
+  :hints(("Goal" :in-theory (enable tactic.skeleton-arities
+                                    tactic.slow-skeleton-arities))))
+
+(defthm logic.slow-skeleton-arities-correct
+  (implies (force (tactic.skeletonp x))
+           (equal (logic.arities-okp (tactic.slow-skeleton-arities x) atbl)
+                  (tactic.skeleton-atblp x atbl)))
+  :hints(("Goal"
+          :induct (tactic.skeleton-atblp x atbl)
+          :expand ((tactic.slow-skeleton-arities x)
+                   (tactic.skeleton-atblp x atbl))
+          :in-theory (e/d (tactic.skeleton-atblp)
+                          (FORCING-TACTIC.SKELETON-ATBLP-OF-TACTIC.SKELETON->HISTORY
+                           FORCING-LOGIC.TERM-LIST-LIST-ATBLP-OF-TACTIC.SKELETON->GOALS
+                           )))))
+
+(defund tactic.fast-skeleton-atblp (x atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.arity-tablep atbl))))
+  (logic.fast-arities-okp (tactic.skeleton-arities x nil) atbl))
+
+(defthm tactic.fast-skeleton-atblp-correct
+  (implies (and (force (tactic.skeletonp x))
+                (force (mapp atbl)))
+           (equal (tactic.fast-skeleton-atblp x atbl)
+                  (tactic.skeleton-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable tactic.fast-skeleton-atblp))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/skip-all.lisp acl2-6.3/books/milawa/ACL2/tactics/skip-all.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/skip-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/skip-all.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,141 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "../build/skip")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund tactic.skip-all-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'skip-all)
+         (not extras)
+         (not goals)
+         (let ((prev-goals (tactic.skeleton->goals history)))
+           (consp prev-goals)))))
+
+(defthm booleanp-of-tactic.skip-all-okp
+  (equal (booleanp (tactic.skip-all-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.skip-all-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.skip-all-tac (x)
+  ;; Replace occurrences of expr with var, a new variable
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0skip-all-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (tactic.extend-skeleton nil 'skip-all nil x))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.skip-all-tac
+  (implies (and (tactic.skip-all-tac x)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.skip-all-tac x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skip-all-tac))))
+
+(defthm forcing-tactic.skip-all-okp-of-tactic.skip-all-tac
+  (implies (and (tactic.skip-all-tac x)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skip-all-okp (tactic.skip-all-tac x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skip-all-tac tactic.skip-all-okp))))
+
+
+
+
+(defund tactic.skip-all-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.skip-all-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil)
+           (ignore proofs))
+  (let* ((history    (tactic.skeleton->history x))
+         (prev-goals (tactic.skeleton->goals history)))
+    (build.skip-list (clause.clause-list-formulas prev-goals))))
+
+(defobligations tactic.skip-all-compile
+  (build.skip-all))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.skip-all-okp tactic.skip-all-compile)))
+
+ (verify-guards tactic.skip-all-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.skip-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.skip-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.skip-all-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.skip-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.skip-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.skip-all-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.skip-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.skip-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.skip-all-compile)))
+            (equal (logic.proof-listp (tactic.skip-all-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/skip-first.lisp acl2-6.3/books/milawa/ACL2/tactics/skip-first.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/skip-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/skip-first.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,143 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "../build/skip")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund tactic.skip-first-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'skip-first)
+         (not extras)
+         (let ((prev-goals (tactic.skeleton->goals history)))
+           (and (consp prev-goals)
+                (equal goals (cdr prev-goals)))))))
+
+(defthm booleanp-of-tactic.skip-first-okp
+  (equal (booleanp (tactic.skip-first-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.skip-first-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.skip-first-tac (x)
+  ;; Replace occurrences of expr with var, a new variable
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0skip-first-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (tactic.extend-skeleton (cdr goals)
+                              'skip-first
+                              nil
+                              x))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.skip-first-tac
+  (implies (and (tactic.skip-first-tac x)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.skip-first-tac x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skip-first-tac))))
+
+(defthm forcing-tactic.skip-first-okp-of-tactic.skip-first-tac
+  (implies (and (tactic.skip-first-tac x)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skip-first-okp (tactic.skip-first-tac x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.skip-first-tac tactic.skip-first-okp))))
+
+
+
+
+(defund tactic.skip-first-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.skip-first-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history    (tactic.skeleton->history x))
+         (prev-goals (tactic.skeleton->goals history)))
+    (cons (build.skip (clause.clause-formula (first prev-goals))) proofs)))
+
+(defobligations tactic.skip-first-compile
+  (build.skip))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.skip-first-okp tactic.skip-first-compile)))
+
+ (verify-guards tactic.skip-first-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.skip-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.skip-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.skip-first-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.skip-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.skip-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.skip-first-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.skip-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.skip-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.skip-first-compile)))
+            (equal (logic.proof-listp (tactic.skip-first-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/split-all.lisp acl2-6.3/books/milawa/ACL2/tactics/split-all.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/split-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/split-all.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,317 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "skeletonp")
+(include-book "colors")
+(include-book "../clauses/split-bldr")
+(include-book "partition")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; BOZO all this stuff belongs somewhere else.
+
+(defthm firstn-of-nfix
+  (equal (firstn (nfix n) x)
+         (firstn n x))
+  :hints(("Goal" :in-theory (enable firstn))))
+
+(defthm restn-of-nfix
+  (equal (restn (nfix n) x)
+         (restn n x))
+  :hints(("Goal" :in-theory (enable restn))))
+
+(defthm cons-listp-of-list-list-fix
+  (equal (cons-listp (list-list-fix x))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-list-listp-of-list-list-fix
+  (equal (true-list-listp (list-list-fix x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-listp-of-list-list-fix
+  (equal (logic.term-list-listp (list-list-fix x))
+         (logic.term-list-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-list-atblp-of-list-list-fix
+  (equal (logic.term-list-list-atblp (list-list-fix x) atbl)
+         (logic.term-list-list-atblp x atbl))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.strip-conclusions-list-of-partition
+  (equal (logic.strip-conclusions-list (partition lens x))
+         (partition lens (logic.strip-conclusions x)))
+  :hints(("Goal" :in-theory (enable partition))))
+
+(defthm nat-listp-of-strip-lens-free
+  (implies (equal (strip-lens x) free)
+           (equal (nat-listp free)
+                  t)))
+
+(defthm logic.appeal-list-listp-of-partition
+  (implies (force (logic.appeal-listp proofs))
+           (equal (logic.appeal-list-listp (partition lens proofs))
+                  t))
+  :hints(("Goal" :in-theory (enable partition))))
+
+(defthm true-list-listp-of-cdr-of-clause.split-list
+  (implies (force (and (true-list-listp x)
+                       (logic.term-list-listp x)))
+           (equal (true-list-listp (cdr (clause.split-list liftp liftlimit splitlimit x)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.split-list))))
+
+(defthm list-list-fix-when-true-list-listp
+  (implies (true-list-listp x)
+           (equal (list-list-fix x)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm clause.clause-list-list-formulas-of-partition
+  (equal (clause.clause-list-list-formulas (partition lens x))
+         (partition lens (clause.clause-list-formulas x)))
+  :hints(("Goal" :in-theory (enable partition))))
+
+(defthm logic.proof-list-listp-of-partition
+  (implies (force (logic.proof-listp x axioms thms atbl))
+           (equal (logic.proof-list-listp (partition lens x) axioms thms atbl)
+                  t))
+  :hints(("Goal"
+          :in-theory (enable partition))))
+
+
+
+
+(defund tactic.split-all-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'split-all)
+         (tuplep 4 extras)
+         (let ((liftp      (first extras))
+               (liftlimit  (second extras))
+               (splitlimit (third extras))
+               (lens       (fourth extras)))
+           (and (booleanp liftp)
+                (natp liftlimit)
+                (natp splitlimit)
+                (let* ((old-goals (list-list-fix (tactic.skeleton->goals history)))
+                       (split     (clause.split-list liftp liftlimit splitlimit old-goals))
+                       (new-goals (simple-flatten (cdr split))))
+                  (and (car split)
+                       (equal lens (strip-lens (cdr split)))
+                       (equal goals new-goals))))))))
+
+(defthm booleanp-of-tactic.split-all-okp
+  (equal (booleanp (tactic.split-all-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.split-all-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+
+
+
+(defthm forcing-cons-listp-of-simple-flatten
+  (implies (force (cons-list-listp x))
+           (equal (cons-listp (simple-flatten x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm forcing-logic.term-list-listp-of-simple-flatten
+  (implies (force (logic.term-list-list-listp x))
+           (equal (logic.term-list-listp (simple-flatten x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defund tactic.split-all-tac (liftp liftlimit splitlimit x warnp)
+  (declare (xargs :guard (and (booleanp liftp)
+                              (natp liftlimit)
+                              (natp splitlimit)
+                              (tactic.skeletonp x)
+                              (booleanp warnp))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (and warnp
+             (ACL2::cw "~s0Split-all-tac failure~s1: all clauses have already been proven.~%" *red* *black*))
+      (let* ((split     (clause.split-list liftp liftlimit splitlimit (list-list-fix goals)))
+             (new-goals (simple-flatten (cdr split))))
+        (if (not (car split))
+            (and warnp
+                 (ACL2::cw "~s0split-all-tac failure~s1: the clauses cannot be split further.~%" *red* *black*))
+          (tactic.extend-skeleton new-goals
+                                  'split-all
+                                  (list liftp liftlimit splitlimit (strip-lens (cdr split)))
+                                  x))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.split-all-tac
+  (implies (and (tactic.split-all-tac liftp liftlimit splitlimit x warnp)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.split-all-tac liftp liftlimit splitlimit x warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.split-all-tac))))
+
+(defthm forcing-tactic.split-all-okp-of-tactic.split-all-tac
+  (implies (and (tactic.split-all-tac liftp liftlimit splitlimit x warnp)
+                (force (natp liftlimit))
+                (force (natp splitlimit))
+                (force (booleanp liftp))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.split-all-okp (tactic.split-all-tac liftp liftlimit splitlimit x warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.split-all-tac tactic.split-all-okp))))
+
+
+
+
+
+
+(defund tactic.split-all-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.split-all-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history            (tactic.skeleton->history x))
+         (old-goals          (list-list-fix (tactic.skeleton->goals history)))
+         (extras             (tactic.skeleton->extras x))
+         (liftp              (first extras))
+         (liftlimit          (second extras))
+         (splitlimit         (third extras))
+         (lens               (fourth extras))
+         (partitioned-proofs (partition lens proofs)))
+    (clause.split-list-bldr liftp liftlimit splitlimit old-goals partitioned-proofs)))
+
+(defobligations tactic.split-all-compile
+  (clause.split-list-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.split-all-okp tactic.split-all-compile)))
+
+ (defthm forcing-logic.appeal-listp-of-tactic.split-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.split-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.split-all-compile x proofs))
+                   t))
+   :hints(("[1]Goal"
+           :in-theory (disable partition-of-simple-flatten)
+           :use ((:instance partition-of-simple-flatten
+                            (x (cdr (clause.split-list (first (tactic.skeleton->extras x))
+                                                       (second (tactic.skeleton->extras x))
+                                                       (third (tactic.skeleton->extras x))
+                                                       (list-list-fix (tactic.skeleton->goals (tactic.skeleton->history x)))))))))))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.split-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.split-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.split-all-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x)))))
+   :hints(("[1]Goal"
+           :in-theory (disable partition-of-simple-flatten)
+           :use ((:instance partition-of-simple-flatten
+                            (x (cdr (clause.split-list (first (tactic.skeleton->extras x))
+                                                       (second (tactic.skeleton->extras x))
+                                                       (third (tactic.skeleton->extras x))
+                                                       (list-list-fix (tactic.skeleton->goals (tactic.skeleton->history x)))))))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.split-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.split-all-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.split-all-compile)))
+            (equal (logic.proof-listp (tactic.split-all-compile x proofs) axioms thms atbl)
+                   t))
+   :hints(("[1]Goal"
+           :in-theory (disable partition-of-simple-flatten)
+           :use ((:instance partition-of-simple-flatten
+                            (x (cdr (clause.split-list (first (tactic.skeleton->extras x))
+                                                       (second (tactic.skeleton->extras x))
+                                                       (third (tactic.skeleton->extras x))
+                                                       (list-list-fix (tactic.skeleton->goals (tactic.skeleton->history x)))))))))))
+
+ (local (defthm crock
+          (implies (equal (logic.disjoin-each-formula-list
+                           (logic.term-list-list-formulas (tactic.skeleton->goals x)))
+                          (logic.strip-conclusions proofs))
+                   (equal (len proofs)
+                          (len (tactic.skeleton->goals x))))
+          :hints(("goal"
+                  :in-theory (disable len-of-logic.disjoin-each-formula-list)
+                  :use ((:instance len-of-logic.disjoin-each-formula-list
+                                   (x (logic.term-list-list-formulas (tactic.skeleton->goals x)))))))))
+
+ (local (defthm crock2
+          (equal (sum-list (strip-lens x))
+                 (len (simple-flatten x)))
+          :hints(("Goal" :induct (cdr-induction x)))))
+
+ (local (ACL2::allow-fertilize t))
+
+ (verify-guards tactic.split-all-compile
+                :hints(("Goal"
+                        :in-theory (disable partition-of-simple-flatten)
+                        :use ((:instance partition-of-simple-flatten
+                                         (x (cdr (clause.split-list (first (tactic.skeleton->extras x))
+                                                                    (second (tactic.skeleton->extras x))
+                                                                    (third (tactic.skeleton->extras x))
+                                                                    (list-list-fix (tactic.skeleton->goals (tactic.skeleton->history x))))))))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/split-first.lisp acl2-6.3/books/milawa/ACL2/tactics/split-first.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/split-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/split-first.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,202 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "../clauses/split-bldr")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund tactic.split-first-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'split-first)
+         (tuplep 4 extras)
+         (let ((old-goals  (tactic.skeleton->goals history))
+               (liftp      (first extras))
+               (liftlimit  (second extras))
+               (splitlimit (third extras))
+               (split-len  (fourth extras)))
+           (and (consp old-goals)
+                (booleanp liftp)
+                (natp liftlimit)
+                (natp splitlimit)
+                (let* ((clause1       (list-fix (car old-goals)))
+                       (clause1-split (clause.split liftp liftlimit splitlimit clause1)))
+                  (and (car clause1-split)
+                       (equal split-len (len (cdr clause1-split)))
+                       (equal (firstn split-len goals) (cdr clause1-split))
+                       (equal (restn split-len goals) (cdr old-goals)))))))))
+
+(defthm booleanp-of-tactic.split-first-okp
+  (equal (booleanp (tactic.split-first-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.split-first-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.split-first-tac (liftp liftlimit splitlimit x)
+  (declare (xargs :guard (and (booleanp liftp)
+                              (natp liftlimit)
+                              (natp splitlimit)
+                              (tactic.skeletonp x))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0Split-first-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let* ((clause1       (list-fix (car goals)))
+             (clause1-split (clause.split liftp liftlimit splitlimit clause1))
+             (split-len     (len (cdr clause1-split))))
+        (if (not (car clause1-split))
+            (ACL2::cw "~s0Split-first-tac failure~s1: the clause cannot be split further.~%" *red* *black*)
+          (tactic.extend-skeleton (app (cdr clause1-split) (cdr goals))
+                                  'split-first
+                                  (list liftp liftlimit splitlimit split-len)
+                                  x))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.split-first-tac
+  (implies (and (tactic.split-first-tac liftp liftlimit splitlimit x)
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.split-first-tac liftp liftlimit splitlimit x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.split-first-tac))))
+
+(defthm forcing-tactic.split-first-okp-of-tactic.split-first-tac
+  (implies (and (tactic.split-first-tac liftp liftlimit splitlimit x)
+                (force (booleanp liftp))
+                (force (natp liftlimit))
+                (force (natp splitlimit))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.split-first-okp (tactic.split-first-tac liftp liftlimit splitlimit x))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.split-first-tac tactic.split-first-okp))))
+
+
+
+
+(defund tactic.split-first-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.split-first-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history       (tactic.skeleton->history x))
+         (old-goals     (tactic.skeleton->goals history))
+         (clause1       (list-fix (car old-goals)))
+         (extras        (tactic.skeleton->extras x))
+         (liftp         (first extras))
+         (liftlimit     (second extras))
+         (splitlimit    (third extras))
+         (len           (fourth extras))
+         (split-proofs  (firstn len proofs))
+         (other-proofs  (restn len proofs))
+         (clause1-proof (clause.split-bldr liftp liftlimit splitlimit clause1 split-proofs)))
+    (cons clause1-proof other-proofs)))
+
+(defobligations tactic.split-first-compile
+  (clause.split-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.split-first-okp tactic.split-first-compile)))
+
+ (local (defthm crock
+          (implies (and (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                               (logic.strip-conclusions proofs))
+                        (equal (firstn n goals) y))
+                   (equal (logic.strip-conclusions (firstn n proofs))
+                          (logic.disjoin-each-formula-list (logic.term-list-list-formulas y))))
+          :hints(("Goal"
+                  :in-theory (disable firstn-of-logic.disjoin-each-formula-list)
+                  :use ((:instance firstn-of-logic.disjoin-each-formula-list
+                                   (x (logic.term-list-list-formulas goals))
+                                   (y n)))))))
+
+ (local (defthm crock2
+          (implies (and (equal (logic.disjoin-each-formula-list (logic.term-list-list-formulas goals))
+                               (logic.strip-conclusions proofs))
+                        (equal (restn n goals) y))
+                   (equal (logic.strip-conclusions (restn n proofs))
+                          (logic.disjoin-each-formula-list (logic.term-list-list-formulas y))))
+          :hints(("Goal"
+                  :in-theory (disable restn-of-logic.disjoin-each-formula-list)
+                  :use ((:instance restn-of-logic.disjoin-each-formula-list
+                                   (x (logic.term-list-list-formulas goals))
+                                   (y n)))))))
+
+ (verify-guards tactic.split-first-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.split-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.split-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.split-first-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.split-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.split-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.split-first-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.split-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.split-first-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.split-first-compile)))
+            (equal (logic.proof-listp (tactic.split-first-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/theory-change.lisp acl2-6.3/books/milawa/ACL2/tactics/theory-change.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/theory-change.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/theory-change.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,1115 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "worldp")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; BOZO find us a home.
+
+(defthm rw.theory-list-atblp-of-range-of-clean-update
+  (implies (force (and (rw.theory-list-atblp (range theories) atbl)
+                       (rw.theory-atblp val atbl)))
+           (rw.theory-list-atblp (range (clean-update theoryname val theories)) atbl))
+  :hints(("Goal"
+          :induct (clean-update theoryname val theories)
+          :in-theory (enable (:induction clean-update)))))
+
+(defthm rw.theory-list-env-okp-of-range-of-clean-update
+  (implies (force (and (rw.theory-list-env-okp (range theories) thms)
+                       (rw.theory-env-okp val thms)))
+           (rw.theory-list-env-okp (range (clean-update theoryname val theories)) thms))
+  :hints(("Goal"
+          :induct (clean-update theoryname val theories)
+          :in-theory (enable (:induction clean-update)))))
+
+
+
+
+(defund tactic.find-theory (name world)
+  (declare (xargs :guard (tactic.worldp world)))
+  (lookup name (tactic.world->theories world)))
+
+(defthm rw.theoryp-of-tactic.find-theory
+  (implies (force (tactic.worldp world))
+           (equal (rw.theoryp (cdr (tactic.find-theory name world)))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.find-theory))))
+
+(defthm rw.theory-atblp-of-tactic.find-theory
+  (implies (force (tactic.world-atblp world atbl))
+           (equal (rw.theory-atblp (cdr (tactic.find-theory name world)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.find-theory))))
+
+(defthm rw.theory-env-okp-of-tactic.find-theory
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (rw.theory-env-okp (cdr (tactic.find-theory name world)) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.find-theory))))
+
+
+
+(defund tactic.find-rule (name world)
+  (declare (xargs :guard (and (symbolp name)
+                              (tactic.worldp world))))
+  (rw.rule-list-lookup name (tactic.world->allrules world)))
+
+(defthm rw.rulep-of-tactic.find-rule
+  (implies (force (tactic.worldp world))
+           (equal (rw.rulep (tactic.find-rule name world))
+                  (if (tactic.find-rule name world)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable tactic.find-rule))))
+
+(defthm rw.rule-atblp-of-tactic.find-rule
+  (implies (force (tactic.world-atblp world atbl))
+           (equal (rw.rule-atblp (tactic.find-rule name world) atbl)
+                  (if (tactic.find-rule name world)
+                      t
+                    nil)))
+  :hints(("Goal" :in-theory (enable tactic.find-rule))))
+
+(defthm rw.rule-env-okp-of-tactic.find-rule
+  (implies (and (force (tactic.find-rule name world))
+                (force (tactic.world-env-okp world axioms thms)))
+           (equal (rw.rule-env-okp (tactic.find-rule name world) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.find-rule))))
+
+
+
+;; CREATING THEORIES
+
+(defund tactic.create-theory (newtheoryname copyofname world)
+  ;; Enables, Disables are collection specifiers
+  ;; We enable all the rules indicated by enables, and remove all the rules indicated
+  ;; by Disables, into the theory indicated by theoryname.
+  (declare (xargs :guard (and (tactic.worldp world)
+                              (symbolp newtheoryname)
+                              (symbolp copyofname))))
+  (let ((theory (tactic.find-theory newtheoryname world))
+        (copy   (tactic.find-theory copyofname world)))
+    (tactic.increment-world-index
+     (if theory
+         (ACL2::prog2$
+          (ACL2::cw "Warning: theory ~s0 is already defined.  Not doing anything.~%")
+          world)
+       (change-tactic.world
+        world
+        :theories (clean-update newtheoryname
+                                (ACL2::prog2$
+                                 (if (and copyofname (not copy))
+                                     (ACL2::cw "Warning: theory ~s0 is not defined; not importing anything.~%")
+                                   nil)
+                                 (cdr copy))
+                                (tactic.world->theories world)))))))
+
+(defthm tactic.worldp-of-tactic.create-theory
+  (implies (force (and (tactic.worldp world)
+                       (symbolp newtheoryname)
+                       (symbolp copyofname)))
+           (equal (tactic.worldp (tactic.create-theory newtheoryname copyofname world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.create-theory))))
+
+(defthm tactic.worldp-atblp-of-tactic.create-theory
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (symbolp newtheoryname)
+                       (symbolp copyofname)))
+           (equal (tactic.world-atblp (tactic.create-theory newtheoryname copyofname world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.create-theory))))
+
+(defthm tactic.world-env-okp-of-tactic.create-theory
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (symbolp newtheoryname)
+                       (symbolp copyofname)))
+           (equal (tactic.world-env-okp (tactic.create-theory newtheoryname copyofname world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.create-theory))))
+
+(defthm tactic.world->index-of-tactic.create-theory
+  (equal (tactic.world->index (tactic.create-theory newtheoryname copyofname world))
+         (+ 1 (tactic.world->index world)))
+  :hints(("Goal" :in-theory (enable tactic.create-theory))))
+
+
+
+
+
+(defund tactic.create-theory-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'create-theory)
+         (equal goals (tactic.skeleton->goals history))
+         (tuplep 2 extras)
+         (symbolp (first extras))  ;; the newtheoryname
+         (symbolp (second extras)) ;; the copyofname
+         )))
+
+(defthm booleanp-of-tactic.create-theory-okp
+  (equal (booleanp (tactic.create-theory-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.create-theory-okp))))
+
+(defthm tactic.skeleton->goals-when-tactic.create-theory-okp
+  (implies (tactic.create-theory-okp x)
+           (equal (tactic.skeleton->goals x)
+                  (tactic.skeleton->goals (tactic.skeleton->history x))))
+  :hints(("Goal" :in-theory (enable tactic.create-theory-okp))))
+
+
+
+(defund tactic.create-theory-tac (x newtheoryname copyofname)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (symbolp newtheoryname)
+                              (symbolp copyofname))))
+  (tactic.extend-skeleton (tactic.skeleton->goals x)
+                          'create-theory
+                          (list newtheoryname copyofname)
+                          x))
+
+(defthm tactic.skeletonp-of-tactic.create-theory-tac
+  (implies (force (tactic.skeletonp x))
+           (equal (tactic.skeletonp (tactic.create-theory-tac x newtheoryname copyofname))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.create-theory-tac))))
+
+(defthm tactic.create-theory-okp-of-tactic.create-theory-tac
+  (implies (force (and (tactic.skeletonp x)
+                       (symbolp newtheoryname)
+                       (symbolp copyofname)))
+           (equal (tactic.create-theory-okp (tactic.create-theory-tac x newtheoryname copyofname))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.create-theory-tac
+                                    tactic.create-theory-okp))))
+
+
+
+(defund tactic.create-theory-compile-world (x world)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.create-theory-okp x)
+                              (tactic.worldp world))
+                  :guard-hints(("Goal" :in-theory (enable tactic.create-theory-okp)))))
+  (let ((extras (tactic.skeleton->extras x)))
+    (tactic.create-theory (first extras)
+                          (second extras)
+                          world)))
+
+(defthm tactic.worldp-of-tactic.create-theory-compile-world
+  (implies (force (and (tactic.worldp world)
+                       (tactic.create-theory-okp x)))
+           (equal (tactic.worldp (tactic.create-theory-compile-world x world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.create-theory-compile-world
+                                    tactic.create-theory-okp))))
+
+(defthm tactic.world-atblp-of-tactic.create-theory-compile-world
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (tactic.create-theory-okp x)))
+           (equal (tactic.world-atblp (tactic.create-theory-compile-world x world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.create-theory-compile-world
+                                    tactic.create-theory-okp))))
+
+(defthm tactic.world-env-okp-of-tactic.create-theory-compile-world
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (tactic.create-theory-okp x)))
+           (equal (tactic.world-env-okp (tactic.create-theory-compile-world x world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.create-theory-compile-world
+                                    tactic.create-theory-okp))))
+
+
+
+
+
+
+
+;; ENABLING AND DISABLING RULES
+;;
+;; We specify the rules to add and remove using "collection specifiers".  Each
+;; collection specifier is either:
+;;
+;;   - A plain symbol, which is interpreted as the name of a rule in allrules,
+;;     or a theory in theories.  In effect, these share a namespace.
+;;
+;;   - (gather <CRITERIA>).  Here, we gather up all the rules in allrules which
+;;     satisfy the criteria--a term that may involve the variables: name, type,
+;;     equiv, lhs, rhs, hyps, syntax, and crithyps. For example, (equal name
+;;     'booleanp-of-consp) will gather up all rules whose names are
+;;     booleanp-of-consp from the implicit global scope.
+;;
+;;   - (gather from <THEORY> <CRITERIA>).  This is like (gather <CRITERIA>),
+;;     except that instead of looking in allrules, we only look at the rules
+;;     in the named theory.  For example,
+;;
+;;         (gather from default
+;;           (equal (logic.function-name lhs) 'consp))
+;;
+;;     Will collect up all of the rules "about" consp in the DEFAULT theory,
+;;     but will skip any rules about consp which aren't currently enabled in
+;;     DEFAULT.
+
+(defund tactic.collect-rules (x world acc)
+  ;; X is a list of collection specifiers.  We add all of their rules to acc.
+  (declare (xargs :guard (and (tactic.worldp world)
+                              (rw.rule-listp acc)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (if (consp x)
+      (cond ((symbolp (car x))
+             (let ((theory (tactic.find-theory (car x) world)))
+               (if theory
+                   (tactic.collect-rules (cdr x) world (rw.fast-theory-all-rules (cdr theory) acc))
+                 (let ((rule (tactic.find-rule (car x) world)))
+                   (if rule
+                       (tactic.collect-rules (cdr x) world (cons rule acc))
+                     (ACL2::prog2$ (ACL2::er hard? 'tactic.collect-rules
+                                             "~x0 is not the name of a defined rule or a theory.~%"
+                                             (car x))
+                                   acc))))))
+
+            ((and (consp (car x))
+                  (equal (first (car x)) 'gather))
+             (let ((length (len (car x))))
+               (cond ((not (or (equal length 2)
+                               (and (equal (second (car x)) 'from)
+                                    (equal length 4))))
+                      (ACL2::prog2$
+                       (ACL2::er hard? 'tactic.collect-rules "The valid forms are (gather <criteria>) and ~
+                            (gather from <theoryname> <criteria>).  Hence, a call to gather ~
+                            with with ~n0 arguments, such as ~x1, is invalid.~%" length (car x))
+                       acc))
+
+                      (t
+                       (let* ((criteria       (if (equal length 2) (second (car x)) (fourth (car x))))
+                              (criteria-trans (logic.translate criteria)))
+                         (cond ((not (logic.termp criteria-trans))
+                                (ACL2::prog2$
+                                 (ACL2::er hard? 'tactic.collect-rules "We failed to translate the following <criteria> ~
+                                     for (gather ...) into a term: ~x0.~%" criteria)
+                                 acc))
+                               ((not (subsetp (logic.term-vars criteria-trans) (rw.rule-components)))
+                                (ACL2::prog2$
+                                 (ACL2::er hard? 'tactic.collect-rules "The <criteria> for (gather ...) inappropriately ~
+                                     mentions the variable(s) ~&0.  The only valid variables in <criteria> ~
+                                     are ~&1.~%"
+                                           (remove-duplicates (difference (logic.term-vars criteria-trans)
+                                                                          (rw.rule-components)))
+                                           (rw.rule-components))
+                                 acc))
+                               ((equal length 2)
+                                (tactic.collect-rules (cdr x)
+                                                      world
+                                                      (rw.gather-rules-from-list (tactic.world->allrules world)
+                                                                                 criteria-trans
+                                                                                 (tactic.world->defs world)
+                                                                                 acc)))
+                               (t
+                                (rw.gather-rules-from-theory (cdr (tactic.find-theory (third (car x)) world))
+                                                             criteria-trans
+                                                             (tactic.world->defs world)
+                                                             acc))))))))
+             (t
+              (ACL2::prog2$
+               (ACL2::er hard? 'tactic.collect-rules "Each collection specifier must be the name of a rule, ~
+                  the name of a theory, or an appropriate (gather ...) command.  Hence, ~x0 is invalid.~%" (car x))
+               acc)))
+    acc))
+
+(defthm true-listp-of-tactic.collect-rules
+  (implies (force (true-listp acc))
+           (equal (true-listp (tactic.collect-rules x world acc))
+                  t))
+  :hints(("Goal"
+          :in-theory (enable tactic.collect-rules)
+          :induct (tactic.collect-rules x world acc))))
+
+(defthm rw.rule-listp-of-tactic.collect-rules
+  (implies (force (and (tactic.worldp world)
+                       (rw.rule-listp acc)
+                       (true-listp acc)))
+           (equal (rw.rule-listp (tactic.collect-rules x world acc))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.collect-rules))))
+
+(defthm rw.rule-list-atblp-of-tactic.collect-rules
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (rw.rule-list-atblp acc atbl)
+                       (tactic.worldp world)
+                       (rw.rule-listp acc)
+                       (true-listp acc)))
+           (equal (rw.rule-list-atblp (tactic.collect-rules x world acc) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.collect-rules))))
+
+(defthm rw.rule-list-env-okp-of-tactic.collect-rules
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (rw.rule-list-env-okp acc thms)
+                       (tactic.worldp world)
+                       (rw.rule-listp acc)
+                       (true-listp acc)))
+           (equal (rw.rule-list-env-okp (tactic.collect-rules x world acc) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.collect-rules))))
+
+(verify-guards tactic.collect-rules)
+
+
+
+
+(defund tactic.e/d (theoryname enables disables world)
+  ;; Enables, Disables are collection specifiers
+  ;; We enable all the rules indicated by enables, and remove all the rules indicated
+  ;; by Disables, into the theory indicated by theoryname.
+  (declare (xargs :guard (and (tactic.worldp world)
+                              (symbolp theoryname))))
+  (let ((theory (tactic.find-theory theoryname world)))
+    (tactic.increment-world-index
+     (if (not theory)
+         (ACL2::prog2$
+          (ACL2::cw "Warning: unknown theory ~x0.  Not enabling or disabling any rules.~%"
+                    theoryname)
+          world)
+       (let ((erules (tactic.collect-rules enables world nil))
+             (drules (tactic.collect-rules disables world nil)))
+         (ACL2::prog2$
+          (ACL2::cw (cond ((and (not erules)
+                                (not drules))
+                           "Warning: enable/disable with no rules specified.~%")
+                          (erules
+                           "Adding ~x1 rules to ~s0.~%")
+                          (drules
+                           "Removing ~x2 rules from ~s0.~%")
+                          (t
+                           "Adding ~x1 rules and removing ~x2 rules from ~s0.~%"))
+                    theoryname
+                    (len erules)
+                    (len drules))
+          (change-tactic.world world
+                               :theories (clean-update
+                                          theoryname
+                                          (rw.theory-insert-list erules
+                                           (rw.theory-delete-list drules (cdr theory)))
+                                          (tactic.world->theories world)))))))))
+
+(defthm tactic.worldp-of-tactic.e/d
+  (implies (force (and (tactic.worldp world)
+                       (symbolp theoryname)))
+           (equal (tactic.worldp (tactic.e/d theoryname enables disables world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.e/d))))
+
+
+(defthm tactic.worldp-atblp-of-tactic.e/d
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (symbolp theoryname)))
+           (equal (tactic.world-atblp (tactic.e/d theoryname enables disables world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.e/d))))
+
+(defthm tactic.world-env-okp-of-tactic.e/d
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)))
+           (equal (tactic.world-env-okp (tactic.e/d theoryname enables disables world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.e/d))))
+
+(defthm tactic.world->index-of-tactic.e/d
+  (equal (tactic.world->index (tactic.e/d theoryname enables disables world))
+         (+ 1 (tactic.world->index world)))
+  :hints(("Goal" :in-theory (enable tactic.e/d))))
+
+
+
+
+
+
+(defund tactic.e/d-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'e/d)
+         (equal goals (tactic.skeleton->goals history))
+         (tuplep 3 extras)
+         (symbolp (first extras)) ;; the theoryname
+         ;; (second extras) holds the enables
+         ;; (third extras) holds the disables
+         )))
+
+(defthm booleanp-of-tactic.e/d-okp
+  (equal (booleanp (tactic.e/d-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.e/d-okp))))
+
+(defthm tactic.skeleton->goals-when-tactic.e/d-okp
+  (implies (tactic.e/d-okp x)
+           (equal (tactic.skeleton->goals x)
+                  (tactic.skeleton->goals (tactic.skeleton->history x))))
+  :hints(("Goal" :in-theory (enable tactic.e/d-okp))))
+
+
+
+(defund tactic.e/d-tac (x theoryname enables disables)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (symbolp theoryname))))
+  (tactic.extend-skeleton (tactic.skeleton->goals x)
+                          'e/d
+                          (list theoryname enables disables)
+                          x))
+
+(defthm tactic.skeletonp-of-tactic.e/d-tac
+  (implies (force (tactic.skeletonp x))
+           (equal (tactic.skeletonp (tactic.e/d-tac x theoryname enables disables))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.e/d-tac))))
+
+(defthm tactic.e/d-okp-of-tactic.e/d-tac
+  (implies (force (and (tactic.skeletonp x)
+                       (symbolp theoryname)))
+           (equal (tactic.e/d-okp (tactic.e/d-tac x theoryname enables disables))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.e/d-tac
+                                    tactic.e/d-okp))))
+
+
+
+(defund tactic.e/d-compile-world (x world)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.e/d-okp x)
+                              (tactic.worldp world))
+                  :guard-hints(("Goal" :in-theory (enable tactic.e/d-okp)))))
+  (let ((extras (tactic.skeleton->extras x)))
+    (tactic.e/d (first extras)
+                (second extras)
+                (third extras)
+                world)))
+
+(defthm tactic.worldp-of-tactic.e/d-compile-world
+  (implies (force (and (tactic.worldp world)
+                       (tactic.e/d-okp x)))
+           (equal (tactic.worldp (tactic.e/d-compile-world x world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.e/d-compile-world
+                                    tactic.e/d-okp))))
+
+(defthm tactic.world-atblp-of-tactic.e/d-compile-world
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (tactic.e/d-okp x)))
+           (equal (tactic.world-atblp (tactic.e/d-compile-world x world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.e/d-compile-world
+                                    tactic.e/d-okp))))
+
+(defthm tactic.world-env-okp-of-tactic.e/d-compile-world
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (tactic.e/d-okp x)))
+           (equal (tactic.world-env-okp (tactic.e/d-compile-world x world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.e/d-compile-world
+                                    tactic.e/d-okp))))
+
+
+
+
+
+;; Adding additional syntactic restrictions to rules
+
+(defund tactic.restrict (theoryname rulename syntax world)
+  ;; The caller will want to translate syntax beforehand.
+  (declare (xargs :guard (and (tactic.worldp world)
+                              (symbolp theoryname)
+                              (symbolp rulename)
+                              (logic.term-listp syntax))))
+  (let ((theory (tactic.find-theory theoryname world))
+        (rule   (tactic.find-rule rulename world)))
+    (tactic.increment-world-index
+     (cond ((not theory)
+            (ACL2::prog2$
+             (ACL2::cw "Warning: unknown theory ~x0.  Not restricting anything.~%"
+                       theoryname)
+             world))
+           ((not rule)
+            (ACL2::prog2$
+             (ACL2::cw "Warning: unknown rule ~x0.  Not restricting anything.~%"
+                       theoryname)
+             world))
+           (t
+            (let* ((new-rule (rw.rule (rw.rule->name rule)
+                                      (rw.rule->type rule)
+                                      (rw.rule->hyps rule)
+                                      (rw.rule->equiv rule)
+                                      (rw.rule->lhs rule)
+                                      (rw.rule->rhs rule)
+                                      (app syntax (rw.rule->syntax rule))
+                                      (rw.rule->crithyps rule)))
+                   (theory1  (rw.theory-delete rule (cdr theory)))
+                   (theory2  (rw.theory-insert new-rule theory1)))
+              (change-tactic.world world
+                                   :theories (clean-update theoryname
+                                                           theory2
+                                                           (tactic.world->theories world)))))))))
+
+(defthm tactic.worldp-of-tactic.restrict
+  (implies (force (and (tactic.worldp world)
+                       (symbolp theoryname)
+                       (logic.term-listp syntax)))
+           (equal (tactic.worldp (tactic.restrict theoryname rulename syntax world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.restrict))))
+
+(defthm tactic.worldp-atblp-of-tactic.restrict
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (symbolp theoryname)
+                       (logic.term-listp syntax)))
+           (equal (tactic.world-atblp (tactic.restrict theoryname rulename syntax world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.restrict))))
+
+(defthm lemma-for-tactic.world-env-okp-of-tactic.restrict
+  (equal (rw.rule-env-okp (rw.rule (rw.rule->name rule)
+                                   (rw.rule->type rule)
+                                   (rw.rule->hyps rule)
+                                   (rw.rule->equiv rule)
+                                   (rw.rule->lhs rule)
+                                   (rw.rule->rhs rule)
+                                   (app restrictions (rw.rule->syntax rule))
+                                   (rw.rule->crithyps rule))
+                          thms)
+         (rw.rule-env-okp rule thms))
+  :hints(("Goal" :in-theory (enable rw.rule-env-okp
+                                    rw.rule-clause))))
+
+(defthm tactic.world-env-okp-of-tactic.restrict
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (symbolp theoryname)
+                       (logic.term-listp syntax)))
+           (equal (tactic.world-env-okp (tactic.restrict theoryname rulename syntax world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.restrict))))
+
+(defthm tactic.world->index-of-tactic.restrict
+  (equal (tactic.world->index (tactic.restrict theoryname rulename syntax world))
+         (+ 1 (tactic.world->index world)))
+  :hints(("Goal" :in-theory (enable tactic.restrict))))
+
+
+
+
+(defund tactic.restrict-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'restrict)
+         (equal goals (tactic.skeleton->goals history))
+         (tuplep 3 extras)
+         (symbolp (first extras)) ;; the theoryname
+         (symbolp (second extras)) ;; the rulename
+         (logic.term-listp (third extras)) ;; the restrictions
+         )))
+
+(defthm booleanp-of-tactic.restrict-okp
+  (equal (booleanp (tactic.restrict-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.restrict-okp))))
+
+(defthm tactic.skeleton->goals-when-tactic.restrict-okp
+  (implies (tactic.restrict-okp x)
+           (equal (tactic.skeleton->goals x)
+                  (tactic.skeleton->goals (tactic.skeleton->history x))))
+  :hints(("Goal" :in-theory (enable tactic.restrict-okp))))
+
+
+
+(defund tactic.restrict-tac (x theoryname rulename syntax)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (symbolp theoryname)
+                              (symbolp rulename)
+                              (logic.term-listp syntax))))
+  (tactic.extend-skeleton (tactic.skeleton->goals x)
+                          'restrict
+                          (list theoryname rulename syntax)
+                          x))
+
+(defthm tactic.skeletonp-of-tactic.restrict-tac
+  (implies (force (tactic.skeletonp x))
+           (equal (tactic.skeletonp (tactic.restrict-tac x theoryname rulename syntax))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.restrict-tac))))
+
+(defthm tactic.restrict-okp-of-tactic.restrict-tac
+  (implies (force (and (tactic.skeletonp x)
+                       (symbolp theoryname)
+                       (symbolp rulename)
+                       (logic.term-listp syntax)))
+           (equal (tactic.restrict-okp (tactic.restrict-tac x theoryname rulename syntax))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.restrict-tac
+                                    tactic.restrict-okp))))
+
+
+
+(defund tactic.restrict-compile-world (x world)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.restrict-okp x)
+                              (tactic.worldp world))
+                  :guard-hints(("Goal" :in-theory (enable tactic.restrict-okp)))))
+  (let ((extras (tactic.skeleton->extras x)))
+    (tactic.restrict (first extras)
+                (second extras)
+                (third extras)
+                world)))
+
+(defthm tactic.worldp-of-tactic.restrict-compile-world
+  (implies (force (and (tactic.worldp world)
+                       (tactic.restrict-okp x)))
+           (equal (tactic.worldp (tactic.restrict-compile-world x world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.restrict-compile-world
+                                    tactic.restrict-okp))))
+
+(defthm tactic.world-atblp-of-tactic.restrict-compile-world
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (tactic.restrict-okp x)))
+           (equal (tactic.world-atblp (tactic.restrict-compile-world x world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.restrict-compile-world
+                                    tactic.restrict-okp))))
+
+(defthm tactic.world-env-okp-of-tactic.restrict-compile-world
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (tactic.restrict-okp x)))
+           (equal (tactic.world-env-okp (tactic.restrict-compile-world x world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.restrict-compile-world
+                                    tactic.restrict-okp))))
+
+
+
+
+
+
+
+;; Managing the noexec list
+
+(defund tactic.update-noexec (add rem world)
+  (declare (xargs :guard (and (tactic.worldp world)
+                              (logic.function-symbol-listp add)
+                              (logic.function-symbol-listp rem))))
+  (let* ((old-list (tactic.world->noexec world))
+         (new-list (fast-app add (difference old-list rem))))
+    (tactic.increment-world-index
+     (change-tactic.world world
+                          :noexec new-list))))
+
+(defthm tactic.worldp-of-tactic.update-noexec
+  (implies (force (and (tactic.worldp world)
+                       (logic.function-symbol-listp add)
+                       (logic.function-symbol-listp rem)))
+           (equal (tactic.worldp (tactic.update-noexec add rem world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec))))
+
+(defthm tactic.worldp-atblp-of-tactic.update-noexec
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (logic.function-symbol-listp add)
+                       (logic.function-symbol-listp rem)))
+           (equal (tactic.world-atblp (tactic.update-noexec add rem world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec))))
+
+(defthm tactic.world-env-okp-of-tactic.update-noexec
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (logic.function-symbol-listp add)
+                       (logic.function-symbol-listp rem)))
+           (equal (tactic.world-env-okp (tactic.update-noexec add rem world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec))))
+
+(defthm tactic.world->index-of-tactic.update-noexec
+  (equal (tactic.world->index (tactic.update-noexec add rem world))
+         (+ 1 (tactic.world->index world)))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec))))
+
+
+
+(defund tactic.update-noexec-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'update-noexec)
+         (equal goals (tactic.skeleton->goals history))
+         (tuplep 2 extras)
+         (logic.function-symbol-listp (first extras)) ;; the add list
+         (logic.function-symbol-listp (second extras)) ;; the rem list
+         )))
+
+(defthm booleanp-of-tactic.update-noexec-okp
+  (equal (booleanp (tactic.update-noexec-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.update-noexec-okp))))
+
+(defthm tactic.skeleton->goals-when-tactic.update-noexec-okp
+  (implies (tactic.update-noexec-okp x)
+           (equal (tactic.skeleton->goals x)
+                  (tactic.skeleton->goals (tactic.skeleton->history x))))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec-okp))))
+
+
+
+(defund tactic.update-noexec-tac (x add rem)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.function-symbol-listp add)
+                              (logic.function-symbol-listp rem))))
+  (tactic.extend-skeleton (tactic.skeleton->goals x)
+                          'update-noexec
+                          (list add rem)
+                          x))
+
+(defthm tactic.skeletonp-of-tactic.update-noexec-tac
+  (implies (force (tactic.skeletonp x))
+           (equal (tactic.skeletonp (tactic.update-noexec-tac x add rem))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec-tac))))
+
+(defthm tactic.update-noexec-okp-of-tactic.update-noexec-tac
+  (implies (force (and (tactic.skeletonp x)
+                       (logic.function-symbol-listp add)
+                       (logic.function-symbol-listp rem)))
+           (equal (tactic.update-noexec-okp (tactic.update-noexec-tac x add rem))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec-tac
+                                    tactic.update-noexec-okp))))
+
+
+
+(defund tactic.update-noexec-compile-world (x world)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.update-noexec-okp x)
+                              (tactic.worldp world))
+                  :guard-hints(("Goal" :in-theory (enable tactic.update-noexec-okp)))))
+  (let ((extras (tactic.skeleton->extras x)))
+    (tactic.update-noexec (first extras)
+                          (second extras)
+                          world)))
+
+(defthm tactic.worldp-of-tactic.update-noexec-compile-world
+  (implies (force (and (tactic.worldp world)
+                       (tactic.update-noexec-okp x)))
+           (equal (tactic.worldp (tactic.update-noexec-compile-world x world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec-compile-world
+                                    tactic.update-noexec-okp))))
+
+(defthm tactic.world-atblp-of-tactic.update-noexec-compile-world
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (tactic.update-noexec-okp x)))
+           (equal (tactic.world-atblp (tactic.update-noexec-compile-world x world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec-compile-world
+                                    tactic.update-noexec-okp))))
+
+(defthm tactic.world-env-okp-of-tactic.update-noexec-compile-world
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (tactic.update-noexec-okp x)))
+           (equal (tactic.world-env-okp (tactic.update-noexec-compile-world x world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.update-noexec-compile-world
+                                    tactic.update-noexec-okp))))
+
+
+
+
+
+(defund tactic.cheapen-each-hyp (hyps)
+  (declare (xargs :guard (rw.hyp-listp hyps)))
+  (if (consp hyps)
+      (cons (rw.hyp (rw.hyp->term (car hyps))
+                    (rw.hyp->fmode (car hyps))
+                    t
+                    0)
+            (tactic.cheapen-each-hyp (cdr hyps)))
+    nil))
+
+(defthm rw.hyp-list-terms-of-tactic.cheapen-each-hyp
+  (equal (rw.hyp-list-terms (tactic.cheapen-each-hyp hyps))
+         (rw.hyp-list-terms hyps))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-each-hyp))))
+
+(defthm forcing-rw.hyp-listp-of-tactic.cheapen-each-hyp
+  (implies (force (rw.hyp-listp hyps))
+           (equal (rw.hyp-listp (tactic.cheapen-each-hyp hyps))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-each-hyp))))
+
+(defthm forcing-rw.hyp-list-atblp-of-tactic.cheapen-each-hyp
+  (implies (force (rw.hyp-list-atblp hyps atbl))
+           (equal (rw.hyp-list-atblp (tactic.cheapen-each-hyp hyps) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-each-hyp))))
+
+
+
+(defund tactic.cheapen-rule (rule)
+  (declare (xargs :guard (rw.rulep rule)))
+  (rw.rule (rw.rule->name rule)
+           (rw.rule->type rule)
+           (tactic.cheapen-each-hyp (rw.rule->hyps rule))
+           (rw.rule->equiv rule)
+           (rw.rule->lhs rule)
+           (rw.rule->rhs rule)
+           (rw.rule->syntax rule)
+           (rw.rule->crithyps rule)))
+
+(defthm rw.rulep-of-tactic.cheapen-rule
+  (implies (force (rw.rulep rule))
+           (rw.rulep (tactic.cheapen-rule rule)))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-rule))))
+
+(defthm rw.rule-atblp-of-tactic.cheapen-rule
+  (implies (force (and (rw.rule-atblp rule atbl)
+                       (rw.rulep rule)))
+           (rw.rule-atblp (tactic.cheapen-rule rule) atbl))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-rule))))
+
+(defthm rw.rule-env-okp-of-tactic.cheapen-rule
+  (implies (force (rw.rule-env-okp rule thms))
+           (rw.rule-env-okp (tactic.cheapen-rule rule) thms))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-rule
+                                    rw.rule-env-okp
+                                    rw.rule-clause))))
+
+
+(defun tactic.cheapen-rules (rules)
+  (declare (xargs :guard (rw.rule-listp rules)))
+  (if (consp rules)
+      (cons (tactic.cheapen-rule (car rules))
+            (tactic.cheapen-rules (cdr rules)))
+    nil))
+
+(defthm rw.rule-listp-of-tactic.cheapen-rules
+  (implies (force (rw.rule-listp rules))
+           (rw.rule-listp (tactic.cheapen-rules rules)))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-rules))))
+
+(defthm rw.rule-list-atblp-of-tactic.cheapen-rules
+  (implies (force (and (rw.rule-list-atblp rules atbl)
+                       (rw.rule-listp rules)))
+           (rw.rule-list-atblp (tactic.cheapen-rules rules) atbl))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-rules))))
+
+(defthm rw.rule-list-env-okp-of-tactic.cheapen-rules
+  (implies (force (rw.rule-list-env-okp rules thms))
+           (rw.rule-list-env-okp (tactic.cheapen-rules rules) thms))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-rules))))
+
+
+
+(defund tactic.cheapen (theoryname what world)
+  ;; Enables, Disables are collection specifiers
+  ;; We enable all the rules indicated by enables, and remove all the rules indicated
+  ;; by Disables, into the theory indicated by theoryname.
+  (declare (xargs :guard (and (tactic.worldp world)
+                              (symbolp theoryname))))
+  (let ((theory (tactic.find-theory theoryname world)))
+    (tactic.increment-world-index
+     (if (not theory)
+         (ACL2::prog2$
+          (ACL2::cw "Warning: unknown theory ~x0.  Not cheapening any rules.~%"
+                    theoryname)
+          world)
+       (let* ((rules     (tactic.collect-rules what world nil))
+              (cheapened (tactic.cheapen-rules rules))
+              (removed   (rw.theory-delete-list rules (cdr theory)))
+              (added     (rw.theory-insert-list cheapened removed)))
+         (ACL2::prog2$
+          (ACL2::cw (cond ((not rules)
+                           "Warning: not cheapening any rules.~%")
+                          (t
+                           "Cheapening ~x1 rules in ~s0.~%"))
+                    theoryname
+                    (len rules))
+          (change-tactic.world world
+                               :theories (clean-update
+                                          theoryname
+                                          added
+                                          (tactic.world->theories world)))))))))
+
+(defthm tactic.worldp-of-tactic.cheapen
+  (implies (force (and (tactic.worldp world)
+                       (symbolp theoryname)))
+           (equal (tactic.worldp (tactic.cheapen theoryname what world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen))))
+
+(defthm tactic.worldp-atblp-of-tactic.cheapen
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (symbolp theoryname)))
+           (equal (tactic.world-atblp (tactic.cheapen theoryname what world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen))))
+
+(defthm tactic.world-env-okp-of-tactic.cheapen
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)))
+           (equal (tactic.world-env-okp (tactic.cheapen theoryname what world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen))))
+
+(defthm tactic.world->index-of-tactic.cheapen
+  (equal (tactic.world->index (tactic.cheapen theoryname what world))
+         (+ 1 (tactic.world->index world)))
+  :hints(("Goal" :in-theory (enable tactic.cheapen))))
+
+
+
+
+
+
+(defund tactic.cheapen-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'cheapen)
+         (equal goals (tactic.skeleton->goals history))
+         (tuplep 2 extras)
+         (symbolp (first extras)) ;; the theoryname
+         ;; (second extras) holds the what
+         )))
+
+(defthm booleanp-of-tactic.cheapen-okp
+  (equal (booleanp (tactic.cheapen-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.cheapen-okp))))
+
+(defthm tactic.skeleton->goals-when-tactic.cheapen-okp
+  (implies (tactic.cheapen-okp x)
+           (equal (tactic.skeleton->goals x)
+                  (tactic.skeleton->goals (tactic.skeleton->history x))))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-okp))))
+
+
+
+(defund tactic.cheapen-tac (x theoryname what)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (symbolp theoryname))))
+  (tactic.extend-skeleton (tactic.skeleton->goals x)
+                          'cheapen
+                          (list theoryname what)
+                          x))
+
+(defthm tactic.skeletonp-of-tactic.cheapen-tac
+  (implies (force (tactic.skeletonp x))
+           (equal (tactic.skeletonp (tactic.cheapen-tac x theoryname what))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-tac))))
+
+(defthm tactic.cheapen-okp-of-tactic.cheapen-tac
+  (implies (force (and (tactic.skeletonp x)
+                       (symbolp theoryname)))
+           (equal (tactic.cheapen-okp (tactic.cheapen-tac x theoryname what))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-tac
+                                    tactic.cheapen-okp))))
+
+(defund tactic.cheapen-compile-world (x world)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.cheapen-okp x)
+                              (tactic.worldp world))
+                  :guard-hints(("Goal" :in-theory (enable tactic.cheapen-okp)))))
+  (let ((extras (tactic.skeleton->extras x)))
+    (tactic.cheapen (first extras)
+                    (second extras)
+                    world)))
+
+(defthm tactic.worldp-of-tactic.cheapen-compile-world
+  (implies (force (and (tactic.worldp world)
+                       (tactic.cheapen-okp x)))
+           (equal (tactic.worldp (tactic.cheapen-compile-world x world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-compile-world
+                                    tactic.cheapen-okp))))
+
+(defthm tactic.world-atblp-of-tactic.cheapen-compile-world
+  (implies (force (and (tactic.world-atblp world atbl)
+                       (tactic.worldp world)
+                       (tactic.cheapen-okp x)))
+           (equal (tactic.world-atblp (tactic.cheapen-compile-world x world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-compile-world
+                                    tactic.cheapen-okp))))
+
+(defthm tactic.world-env-okp-of-tactic.cheapen-compile-world
+  (implies (force (and (tactic.world-env-okp world axioms thms)
+                       (tactic.worldp world)
+                       (tactic.cheapen-okp x)))
+           (equal (tactic.world-env-okp (tactic.cheapen-compile-world x world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.cheapen-compile-world
+                                    tactic.cheapen-okp))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/urewrite-all.lisp acl2-6.3/books/milawa/ACL2/tactics/urewrite-all.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/urewrite-all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/urewrite-all.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,208 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "rewrite-world")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+; NOTE: see also the comments at the beginning of urewrite-first.lisp.
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defund tactic.urewrite-all-okp (x worlds)
+   (declare (xargs :guard (and (tactic.skeletonp x)
+                               (tactic.world-listp worlds))))
+   (let ((goals   (tactic.skeleton->goals x))
+         (tacname (tactic.skeleton->tacname x))
+         (extras  (tactic.skeleton->extras x))
+         (history (tactic.skeleton->history x)))
+     (and (equal tacname 'urewrite-all)
+          (tuplep 4 extras)
+          (let* ((theoryname (first extras))
+                 (fastp      (second extras))
+                 (windex     (third extras))
+                 (traces     (fourth extras)) ;; nil when fastp
+                 (world      (tactic.find-world windex worlds))
+                 (old-goals  (tactic.skeleton->goals history)))
+            (and world
+                 (booleanp fastp)
+                 (if fastp
+                     (and (equal goals (rw.fast-world-urewrite-list-list old-goals theoryname world))
+                          (not (equal old-goals goals)))
+                   (and (equal traces (rw.world-urewrite-list-list old-goals theoryname world))
+                        (equal goals (rw.trace-list-list-rhses traces))
+                        (not (equal old-goals goals))))))))))
+
+(defthm booleanp-of-tactic.urewrite-all-okp
+  (equal (booleanp (tactic.urewrite-all-okp x worlds))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.urewrite-all-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+(defund tactic.urewrite-all-tac (x theoryname fastp world warnp)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.worldp world)
+                              (booleanp warnp))))
+  (let ((goals      (tactic.skeleton->goals x))
+        (findtheory (lookup theoryname (tactic.world->theories world)))
+        (windex     (tactic.world->index world)))
+    (cond ((not (consp goals))
+           (and warnp
+                (ACL2::cw "~s0urewrite-all-tac failure~s1: all clauses have already been proven.~%" *red* *black*)))
+          ((not findtheory)
+           (and warnp
+                (ACL2::cw "~s0urewrite-all-tac failure~s1: no theory named ~s2 is defined.~%" *red* *black* theoryname)))
+          (fastp
+           (let* ((new-goals (rw.fast-world-urewrite-list-list goals theoryname world)))
+             (cond ((equal new-goals goals)
+                    (and warnp
+                         (ACL2::cw "~s0urewrite-all-tac failure~s1: no progress was made.~%" *red* *black*)))
+                   (t
+                    (tactic.extend-skeleton new-goals
+                                            'urewrite-all
+                                            (list theoryname t windex nil)
+                                            x)))))
+          (t
+           (let* ((traces    (rw.world-urewrite-list-list goals theoryname world))
+                  (new-goals (rw.trace-list-list-rhses traces)))
+             (cond ((equal new-goals goals)
+                    (and warnp
+                         (ACL2::cw "~s0urewrite-all-tac failure~s1: no progress was made.~%" *red* *black*)))
+                   (t
+                    (tactic.extend-skeleton new-goals
+                                            'urewrite-all
+                                            (list theoryname nil windex traces)
+                                            x))))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.urewrite-all-tac
+  (implies (and (tactic.urewrite-all-tac x theoryname fastp world warnp)
+                (force (tactic.worldp world))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.urewrite-all-tac x theoryname fastp world warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.urewrite-all-tac))))
+
+(defthm forcing-tactic.urewrite-all-okp-of-tactic.urewrite-all-tac
+  (implies (and (tactic.urewrite-all-tac x theoryname fastp world warnp)
+                (force (tactic.worldp world))
+                (force (tactic.world-listp worlds))
+                (force (tactic.skeletonp x))
+                (force (booleanp fastp))
+                (force (equal world (tactic.find-world (tactic.world->index world) worlds))))
+           (equal (tactic.urewrite-all-okp
+                   (tactic.urewrite-all-tac x theoryname fastp world warnp)
+                   worlds)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.urewrite-all-tac
+                                    tactic.urewrite-all-okp))))
+
+
+(defund tactic.urewrite-all-compile (x worlds proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (tactic.urewrite-all-okp x worlds)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history      (tactic.skeleton->history x))
+         (goals        (tactic.skeleton->goals x))
+         (old-goals    (tactic.skeleton->goals history))
+         (extras       (tactic.skeleton->extras x))
+         (theoryname   (first extras))
+         (fastp        (second extras))
+         (windex       (third extras))
+         (traces       (fourth extras))
+         (world        (tactic.find-world windex worlds)))
+    (rw.world-urewrite-list-list-bldr old-goals goals fastp theoryname world traces proofs)))
+
+(defobligations tactic.urewrite-all-compile
+  (rw.world-urewrite-list-list-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.urewrite-all-okp
+                           tactic.urewrite-all-compile)))
+
+ (verify-guards tactic.urewrite-all-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.urewrite-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.urewrite-all-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.urewrite-all-compile x worlds proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.urewrite-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.urewrite-all-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.urewrite-all-compile x worlds proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.urewrite-all-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.urewrite-all-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.world-list-atblp worlds atbl)
+                        (tactic.world-list-env-okp worlds axioms thms)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.urewrite-all-compile)))
+            (equal (logic.proof-listp (tactic.urewrite-all-compile x worlds proofs) axioms thms atbl)
+                   t))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/urewrite-first.lisp acl2-6.3/books/milawa/ACL2/tactics/urewrite-first.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/urewrite-first.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/urewrite-first.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,242 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "rewrite-world")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+; We combine fast and slow unconditional rewriting into a single tactic.
+;
+; Why not just use fast rewriting everywhere?  Fast rewriting is fine, but to
+; emit proofs we need to call the slow rewriter anyway.  So, when we are doing
+; the bootstrapping but before the rewriter is verified, if we used the fast
+; rewriter we'd end up having to run the slow rewriter later on, anyway.  (This
+; is actually convenient if we're just trying to find proofs, but overall it
+; slows us down if we're also building proofs).
+;
+; Instead, we take a fastp flag and only use the fast rewriter if it is set.
+; Effectively, this allows us to avoid the unnecessary "fast" rewrite and just
+; use the slow rewriter to begin with; we then save the traces for the
+; compiler.
+;
+; This approach also gives us a convenient target for redefinition.  That is,
+; the tactic.urewrite-first-compile function can be redefined to build a high
+; level, one-step proof in the later stages of bootstrapping when the rewriter
+; is already verified.  But until then, it'll work just fine and emit low level
+; proofs.
+
+(defund tactic.urewrite-first-okp (x worlds)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds))))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'urewrite-first)
+         (tuplep 4 extras)
+         (let* ((theoryname (first extras))
+                (fastp      (second extras))
+                (windex     (third extras))
+                (traces     (fourth extras)) ;; nil when fastp
+                (world      (tactic.find-world windex worlds))
+                (old-goals  (tactic.skeleton->goals history))
+                (clause1    (car old-goals)))
+           (and world
+                (consp old-goals)
+                (booleanp fastp)
+                (if fastp
+                    (let* ((rhses     (rw.fast-world-urewrite-list clause1 theoryname world))
+                           (progressp (not (equal clause1 rhses))))
+                      (and progressp
+                           (equal (car goals) rhses)
+                           (equal (cdr goals) (cdr old-goals))))
+                  (let* ((clause1-rw (rw.world-urewrite-list clause1 theoryname world))
+                         (rhses      (rw.trace-list-rhses clause1-rw))
+                         (progressp  (not (equal clause1 rhses))))
+                    (and progressp
+                         (equal traces clause1-rw)
+                         (equal (car goals) rhses)
+                         (equal (cdr goals) (cdr old-goals))))))))))
+
+(defthm booleanp-of-tactic.urewrite-first-okp
+  (equal (booleanp (tactic.urewrite-first-okp x worlds))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.urewrite-first-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+(defund tactic.urewrite-first-tac (x theoryname fastp world warnp)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (booleanp fastp)
+                              (tactic.worldp world)
+                              (booleanp warnp))))
+  (let ((goals      (tactic.skeleton->goals x))
+        (findtheory (lookup theoryname (tactic.world->theories world)))
+        (windex     (tactic.world->index world)))
+    (cond ((not (consp goals))
+           (and warnp
+                (ACL2::cw "~s0urewrite-first-tac failure~s1: all clauses have already been proven.~%" *red* *black*)))
+          ((not findtheory)
+           (and warnp
+                (ACL2::cw "~s0urewrite-first-tac failure~s1: no theory named ~s2 is defined.~%" *red* *black* theoryname)))
+          (fastp
+           (let* ((clause1       (car goals))
+                  (clause1-prime (rw.fast-world-urewrite-list clause1 theoryname world))
+                  (progressp     (not (equal clause1 clause1-prime))))
+             (cond ((not progressp)
+                    (and warnp
+                         (ACL2::cw "~s0urewrite-first-tac failure~s1: no progress was made.~%" *red* *black*)))
+                   (t
+                    (tactic.extend-skeleton (cons clause1-prime (cdr goals))
+                                            'urewrite-first
+                                            (list theoryname t windex nil)
+                                            x)))))
+          (t
+           (let* ((clause1       (car goals))
+                  (traces        (rw.world-urewrite-list clause1 theoryname world))
+                  (clause1-prime (rw.trace-list-rhses traces))
+                  (progressp     (not (equal clause1 clause1-prime))))
+             (cond ((not progressp)
+                    (and warnp
+                         (ACL2::cw "~s0urewrite-first-tac failure~s1: no progress was made.~%" *red* *black*)))
+                   (t
+                    (tactic.extend-skeleton (cons clause1-prime (cdr goals))
+                                            'urewrite-first
+                                            (list theoryname nil windex traces)
+                                            x))))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.urewrite-first-tac
+  (implies (and (tactic.urewrite-first-tac x theoryname fastp world warnp)
+                (force (tactic.worldp world))
+                (force (tactic.skeletonp x)))
+           (equal (tactic.skeletonp (tactic.urewrite-first-tac x theoryname fastp world warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.urewrite-first-tac))))
+
+(defthm forcing-tactic.urewrite-first-okp-of-tactic.urewrite-first-tac
+  (implies (and (tactic.urewrite-first-tac x theoryname fastp world warnp)
+                (force (tactic.worldp world))
+                (force (tactic.world-listp worlds))
+                (force (tactic.skeletonp x))
+                (force (booleanp fastp))
+                (force (equal world (tactic.find-world (tactic.world->index world) worlds))))
+           (equal (tactic.urewrite-first-okp
+                   (tactic.urewrite-first-tac x theoryname fastp world warnp)
+                   worlds)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.urewrite-first-tac
+                                    tactic.urewrite-first-okp))))
+
+
+
+
+(defund tactic.urewrite-first-compile (x worlds proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (tactic.urewrite-first-okp x worlds)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((history      (tactic.skeleton->history x))
+         (goals        (tactic.skeleton->goals x))
+         (old-goals    (tactic.skeleton->goals history))
+         (orig-goal1   (car old-goals))
+         (extras       (tactic.skeleton->extras x))
+         (theoryname   (first extras))
+         (fastp        (second extras))
+         (windex       (third extras))
+         (traces       (fourth extras))
+         (world        (tactic.find-world windex worlds)))
+    (cons (rw.world-urewrite-list-bldr orig-goal1 (car goals) fastp theoryname world traces (car proofs))
+          (cdr proofs))))
+
+(defobligations tactic.urewrite-first-compile
+  (rw.world-urewrite-list-bldr))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.urewrite-first-okp
+                           tactic.urewrite-first-compile)))
+
+ (local (ACL2::allow-fertilize t))
+
+ (verify-guards tactic.urewrite-first-compile
+                :hints(("Goal" :do-not-induct t)))
+
+ (defthm forcing-logic.appeal-listp-of-tactic.urewrite-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.urewrite-first-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.urewrite-first-compile x worlds proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.urewrite-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.urewrite-first-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.urewrite-first-compile x worlds proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.urewrite-first-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.urewrite-first-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.world-list-atblp worlds atbl)
+                        (tactic.world-list-env-okp worlds axioms thms)
+                        (tactic.skeleton-atblp x atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.urewrite-first-compile)))
+            (equal (logic.proof-listp (tactic.urewrite-first-compile x worlds proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/use.lisp acl2-6.3/books/milawa/ACL2/tactics/use.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/use.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/use.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,205 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defund tactic.use-okp (x)
+  (declare (xargs :guard (tactic.skeletonp x)))
+  (let ((goals   (tactic.skeleton->goals x))
+        (tacname (tactic.skeleton->tacname x))
+        (extras  (tactic.skeleton->extras x))
+        (history (tactic.skeleton->history x)))
+    (and (equal tacname 'use)
+         (logic.appealp extras)
+         (let ((old-goals (tactic.skeleton->goals history)))
+           (and (consp old-goals)
+                (let* ((clause1    (car old-goals))
+                       (conclterm  (logic.compile-formula (logic.conclusion extras)))
+                       ;; The proof should be valid, so its conclusion should be true.
+                       ;; So (not conclterm) should be a "false" term
+                       ;; And it's always sound to add a false term to a disjunction.
+                       (new-clause1 (cons (logic.function 'not (list conclterm)) clause1)))
+                  (and (consp goals)
+                       (equal (car goals) new-clause1)
+                       (equal (cdr goals) (cdr old-goals)))))))))
+
+(defthm booleanp-of-tactic.use-okp
+  (equal (booleanp (tactic.use-okp x))
+         t)
+  :hints(("Goal" :in-theory (e/d (tactic.use-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+(defund tactic.use-env-okp (x axioms thms atbl)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.use-okp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms)
+                              (logic.arity-tablep atbl))
+                  :guard-hints (("Goal" :in-theory (enable tactic.use-okp)))))
+  (let* ((extras (tactic.skeleton->extras x)))
+    ;; bozo what about later with extended proof checkers?
+    (logic.proofp extras axioms thms atbl)))
+
+(defthm booleanp-of-tactic.use-env-okp
+  (equal (booleanp (tactic.use-env-okp x axioms thms atbl))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.use-env-okp))))
+
+
+
+(defund tactic.use-tac (x proof)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (logic.appealp proof))))
+  (let ((goals (tactic.skeleton->goals x)))
+    (if (not (consp goals))
+        (ACL2::cw "~s0use-tac failure~s1: all clauses have already been proven.~%" *red* *black*)
+      (let* ((clause1       (car goals))
+             (conclterm     (logic.compile-formula (logic.conclusion proof)))
+             (new-clause1   (cons (logic.function 'not (list conclterm)) clause1)))
+        (tactic.extend-skeleton (cons new-clause1 (cdr goals)) 'use proof x)))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.use-tac
+  (implies (and (tactic.use-tac x proof)
+                (force (tactic.skeletonp x))
+                (force (logic.appealp proof)))
+           (equal (tactic.skeletonp (tactic.use-tac x proof))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.use-tac))))
+
+(defthm forcing-tactic.use-okp-of-tactic.use-tac
+  (implies (and (tactic.use-tac x proof)
+                (force (tactic.skeletonp x))
+                (force (logic.appealp proof)))
+           (equal (tactic.use-okp (tactic.use-tac x proof))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.use-tac tactic.use-okp))))
+
+(defthm forcing-tactic.use-env-okp-of-tactic.use-tac
+  (implies (and (tactic.use-tac x proof)
+                (force (tactic.skeletonp x))
+                (force (logic.appealp proof))
+                (force (logic.proofp proof axioms thms atbl)))
+           (equal (tactic.use-env-okp (tactic.use-tac x proof) axioms thms atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.use-tac tactic.use-env-okp))))
+
+
+
+
+(defund@ tactic.use-compile (x proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.use-okp x)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((proof (tactic.skeleton->extras x))
+         (cform (logic.conclusion proof)))
+    (cons (@derive
+           ((v (! cform) (= cterm t))         (@given (first (build.compile-formula cform))))
+           ((v (! cform) (!= cterm nil))      (build.disjoined-not-nil-from-t @-))
+           (cform                             (@given proof))
+           ((!= cterm nil)                    (build.modus-ponens @- @--))
+           ((= (not cterm) nil)               (build.negative-lit-from-not-pequal-nil @-))
+           ((v (!= (not cterm) nil) clause1)  (@given (car proofs)))
+           (clause1                           (build.modus-ponens @-- @-)))
+          (cdr proofs))))
+
+(defobligations tactic.use-compile
+  (build.compile-formula
+   build.modus-ponens
+   build.negative-lit-from-not-pequal-nil))
+
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.use-okp
+                           tactic.use-env-okp
+                           tactic.use-compile
+                           logic.term-formula)))
+
+ (local (defthm crock
+          (implies (and (EQUAL (LOGIC.DISJOIN-EACH-FORMULA-LIST (LOGIC.TERM-LIST-LIST-FORMULAS (TACTIC.SKELETON->GOALS X)))
+                               (LOGIC.STRIP-CONCLUSIONS PROOFS))
+                        (force (tactic.skeletonp x))
+                        (force (consp proofs)))
+                   (equal (logic.conclusion (first proofs))
+                          (logic.disjoin-formulas
+                           (logic.term-list-formulas (first (tactic.skeleton->goals x))))))))
+
+ (verify-guards tactic.use-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.use-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.use-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.use-compile x proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.use-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.use-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.use-compile x proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.use-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.use-okp x)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.use-env-okp x axioms thms atbl)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.use-compile)))
+            (equal (logic.proof-listp (tactic.use-compile x proofs) axioms thms atbl)
+                   t))))
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/waterfall.lisp acl2-6.3/books/milawa/ACL2/tactics/waterfall.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/waterfall.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/waterfall.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,2081 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "colors")
+(include-book "skeletonp")
+(include-book "worldp")
+(include-book "crewrite-world")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+; BOZO find these things a home.
+
+(defthm true-list-listp-of-remove-supersets1
+  (implies (and (true-list-listp acc)
+                (true-list-listp x))
+           (equal (true-list-listp (remove-supersets1 x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+(defthm true-list-listp-of-remove-supersets
+  (implies (force (true-list-listp x))
+           (equal (true-list-listp (remove-supersets x))
+                  t))
+  :hints(("Goal" :in-theory (enable remove-supersets))))
+
+(defthm true-list-listp-of-remove-duplicates-list
+  (equal (true-list-listp (remove-duplicates-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-list-listp-of-third-of-clause.clean-clauses
+  (implies (force (true-list-listp x))
+           (equal (true-list-listp (third (clause.clean-clauses x)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.clean-clauses))))
+
+(defthm true-list-listp-of-third-of-clause.fast-clean-clauses
+  (implies (force (true-list-listp x))
+           (equal (true-list-listp (third (clause.fast-clean-clauses x)))
+                  t))
+  :hints(("Goal" :in-theory (e/d (clause.fast-clean-clauses)
+                                 (clause.fast-clean-clauses-removal
+                                  clause.fast-clean-part1-removal)))))
+
+(defthm true-list-listp-of-revappend
+  (implies (and (force (true-list-listp x))
+                (force (true-list-listp acc)))
+           (true-list-listp (revappend x acc)))
+  :hints(("Goal" :in-theory (e/d (revappend)
+                                 (forcing-revappend-removal)))))
+
+(defthm true-list-listp-of-clause.aux-split
+  (implies (and (true-listp todo)
+                (true-listp done))
+           (true-list-listp (clause.aux-split todo done)))
+  :hints(("Goal" :in-theory (enable clause.aux-split))))
+
+(defthm true-list-listp-of-clause.aux-limsplit
+  (implies (and (true-listp todo)
+                (true-listp done))
+           (true-list-listp (clause.aux-limsplit todo done splitlimit)))
+  :hints(("Goal" :in-theory (enable clause.aux-limsplit))))
+
+(defthm true-list-listp-of-clause.simple-limsplit
+  (implies (true-listp x)
+           (equal (true-list-listp (clause.simple-limsplit x splitlimit))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-limsplit))))
+
+(defthm true-list-listp-of-clause.simple-split
+  (implies (true-listp x)
+           (equal (true-list-listp (clause.simple-split x))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.simple-split))))
+
+(defthm true-list-listp-of-cdr-of-clause.split
+  (implies (force (true-listp x))
+           (equal (true-list-listp (cdr (clause.split liftp liftlimit splitlimit x)))
+                  t))
+  :hints(("Goal" :in-theory (enable clause.split))))
+
+
+(defthm logic.formula-listp-of-remove-duplicates-free
+  (implies (and (equal x (remove-duplicates y))
+                (logic.formula-listp y))
+           (equal (logic.formula-listp x)
+                  t)))
+
+(defthm logic.formula-list-atblp-of-remove-duplicates-free
+  (implies (and (equal x (remove-duplicates y))
+                (logic.formula-list-atblp y atbl))
+           (equal (logic.formula-list-atblp x atbl)
+                  t)))
+
+(defthm subsetp-of-remove-duplicates-one-indirect
+  (implies (equal (remove-duplicates x) y)
+           (equal (subsetp x y)
+                  t))
+  ;; Yikes, this rule is really expensive!
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm cons-listp-of-list-list-fix
+  (equal (cons-listp (list-list-fix x))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-list-listp-of-list-list-fix
+  (equal (true-list-listp (list-list-fix x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-listp-of-list-list-fix
+  (equal (logic.term-list-listp (list-list-fix x))
+         (logic.term-list-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm list-list-fix-when-true-list-listp
+  (implies (true-list-listp x)
+           (equal (list-list-fix x)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-list-atblp-of-list-list-fix
+  (equal (logic.term-list-list-atblp (list-list-fix x) atbl)
+         (logic.term-list-list-atblp x atbl))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+; THE WATERFALL
+;
+; The waterfall here is named after ACL2's waterfall, although it is extemely
+; limited in comparison.  The tactic system we have introduced is ordinarily
+; used in a basically "breadth first" way, where some proof strategy is applied
+; to every goal, producing a new list of goals, and then some other strategy is
+; applied.  See, for instance, the %auto tactic.  By comparison, the waterfall
+; is a "depth first" operation which, upon simplifying some goal clause,
+; immediately begins working to simplify the subgoals which were just produced.
+;
+; The breadth-first approach is often sufficient, especially since generally
+; our techniques will gracefully fail when no progress can be made.  That is,
+; it does not hurt to apply "split" to a fully-split goal, because it just
+; becomes a no-op.  On the other hand, this simplicity sometimes comes at a
+; high performance cost when just a few goals are very complicated and other
+; goals are simple.  One must continually revisit the simple goals instead of
+; focusing on the main, challenging goals.  In such cases the waterfall can
+; sometimes perform much better.
+;
+; To justify the waterfall, we build a record of what has occurred to the goal.
+; Waterfall steps are somewhat similar to tactic skeletons, except that the
+; depth-first nature of the waterfall makes things more difficult.  In
+; particular, we are building a tree rather than a linear structure.
+;
+; Every node in this tree is a waterfall step.  Each such step is an aggreate
+; which includes
+;
+;   - METHOD is which one is being used
+;   - CLAUSE is the clause being proven
+;   - EXTRAS are any extra info we need
+;   - SUBSTEPS, steps for the subgoals which are introduced by method
+;
+; This structure is straightforward and is easy to compile into proofs.  The
+; difficulty comes in creating such structures, where we need to recursively
+; build the substeps and then stuff them into the step we are producing.  None
+; of this is particularly bad, it just makes rw.flag-waterfall more complex.
+;
+; We begin with the usual drivel needed to introduce a structure, accessors,
+; etc.
+
+(defund rw.flag-waterstepp (flag x)
+  (declare (xargs :guard t))
+  (if (equal flag 'clause)
+      (let ((method   (car (car x)))
+            (clause   (cdr (car x)))
+            ;(extras   (car (cdr x)))
+            (substeps (cdr (cdr x))))
+        (and (symbolp method)
+             (logic.term-listp clause)
+             (consp clause)
+             (true-listp clause)
+             (rw.flag-waterstepp 'list substeps)))
+    (if (consp x)
+        (and (rw.flag-waterstepp 'clause (car x))
+             (rw.flag-waterstepp 'list (cdr x)))
+      t)))
+
+(defund rw.waterstepp (x)
+  (declare (xargs :guard t))
+  (rw.flag-waterstepp 'clause x))
+
+(defund rw.waterstep-listp (x)
+  (declare (xargs :guard t))
+  (rw.flag-waterstepp 'list x))
+
+(defthmd definition-of-rw.waterstepp
+  (equal (rw.waterstepp x)
+         (let ((method   (car (car x)))
+               (clause   (cdr (car x)))
+               ;(extras  (car (cdr x))))
+               (substeps (cdr (cdr x))))
+           (and (symbolp method)
+                (logic.term-listp clause)
+                (consp clause)
+                (true-listp clause)
+                (rw.waterstep-listp substeps))))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterstepp rw.waterstep-listp)
+          :expand ((rw.flag-waterstepp 'clause x)))))
+
+(defthmd definition-of-rw.waterstep-listp
+  (equal (rw.waterstep-listp x)
+         (if (consp x)
+             (and (rw.waterstepp (car x))
+                  (rw.waterstep-listp (cdr x)))
+           t))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterstepp rw.waterstep-listp)
+          :expand ((rw.flag-waterstepp 'list x)))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterstepp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterstep-listp))))
+
+(defthm rw.waterstep-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.waterstep-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-listp))))
+
+(defthm rw.waterstep-listp-of-cons
+  (equal (rw.waterstep-listp (cons a x))
+         (and (rw.waterstepp a)
+              (rw.waterstep-listp x)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-listp))))
+
+(defun rw.raw-waterstep-induction (flag x)
+  (declare (xargs :verify-guards nil
+                  :measure (two-nats-measure (rank x) (if (equal flag 'clause) 1 0))))
+  (if (equal flag 'clause)
+      (rw.raw-waterstep-induction 'list (cdr (cdr x)))
+    (if (consp x)
+        (list (rw.raw-waterstep-induction 'clause (car x))
+              (rw.raw-waterstep-induction 'list (cdr x)))
+      nil)))
+
+(defthms-flag
+  :thms ((clause booleanp-of-rw.waterstepp
+                 (equal (booleanp (rw.waterstepp x))
+                        t))
+         (t booleanp-of-rw.waterstep-listp
+            (equal (booleanp (rw.waterstep-listp x))
+                   t)))
+  :hints (("Goal"
+           :in-theory (enable definition-of-rw.waterstepp)
+           :induct (rw.raw-waterstep-induction flag x))))
+
+(deflist rw.waterstep-listp (x)
+  (rw.waterstepp x)
+  :elementp-of-nil nil
+  :already-definedp t)
+
+
+
+(defund rw.waterstep (method clause extras substeps)
+  (declare (xargs :guard (and (symbolp method)
+                              (logic.term-listp clause)
+                              (consp clause)
+                              (rw.waterstep-listp substeps))))
+  (cons (cons method clause)
+        (cons extras substeps)))
+
+(defund rw.waterstep->method (x)
+  (declare (xargs :guard (rw.waterstepp x)))
+  (car (car x)))
+
+(defund rw.waterstep->clause (x)
+  (declare (xargs :guard (rw.waterstepp x)))
+  (cdr (car x)))
+
+(defund rw.waterstep->extras (x)
+  (declare (xargs :guard (rw.waterstepp x)))
+  (car (cdr x)))
+
+(defund rw.waterstep->substeps (x)
+  (declare (xargs :guard (rw.waterstepp x)))
+  (cdr (cdr x)))
+
+(defthm rw.waterstep->method-of-rw.waterstep
+  (equal (rw.waterstep->method (rw.waterstep method clause extras substeps))
+         method)
+  :hints(("Goal" :in-theory (enable rw.waterstep rw.waterstep->method))))
+
+(defthm rw.waterstep->clause-of-rw.waterstep
+  (equal (rw.waterstep->clause (rw.waterstep method clause extras substeps))
+         clause)
+  :hints(("Goal" :in-theory (enable rw.waterstep rw.waterstep->clause))))
+
+(defthm rw.waterstep->extras-of-rw.waterstep
+  (equal (rw.waterstep->extras (rw.waterstep method clause extras substeps))
+         extras)
+  :hints(("Goal" :in-theory (enable rw.waterstep rw.waterstep->extras))))
+
+(defthm rw.waterstep->substeps-of-rw.waterstep
+  (equal (rw.waterstep->substeps (rw.waterstep method clause extras substeps))
+         substeps)
+  :hints(("Goal" :in-theory (enable rw.waterstep rw.waterstep->substeps))))
+
+(defthm rank-of-rw.waterstep->substeps
+  (equal (< (rank x) (rank (rw.waterstep->substeps x)))
+         nil)
+  :hints(("Goal" :in-theory (enable rw.waterstep->substeps))))
+
+(defthm rw.waterstepp-of-rw.waterstep
+  (implies (and (force (symbolp method))
+                (force (logic.term-listp clause))
+                (force (consp clause))
+                (force (true-listp clause))
+                (force (rw.waterstep-listp substeps)))
+           (rw.waterstepp (rw.waterstep method clause extras substeps)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstepp rw.waterstep))))
+
+(defthm symbolp-of-rw.waterstep->method
+  (implies (force (rw.waterstepp x))
+           (equal (symbolp (rw.waterstep->method x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstepp
+                                    rw.waterstep->method))))
+
+(defthm logic.term-listp-of-rw.waterstep->clause
+  (implies (force (rw.waterstepp x))
+           (equal (logic.term-listp (rw.waterstep->clause x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstepp
+                                    rw.waterstep->clause))))
+
+(defthm consp-of-rw.waterstep->clause
+  (implies (force (rw.waterstepp x))
+           (equal (consp (rw.waterstep->clause x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstepp
+                                    rw.waterstep->clause))))
+
+(defthm true-listp-of-rw.waterstep->clause
+  (implies (force (rw.waterstepp x))
+           (equal (true-listp (rw.waterstep->clause x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstepp
+                                    rw.waterstep->clause))))
+
+(defthm rw.waterstep-listp-of-rw.waterstep->substeps
+  (implies (force (rw.waterstepp x))
+           (equal (rw.waterstep-listp (rw.waterstep->substeps x))
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstepp
+                                    rw.waterstep->substeps))))
+
+
+(defprojection
+  :list (rw.waterstep-list->clauses x)
+  :element (rw.waterstep->clause x)
+  :guard (rw.waterstep-listp x)
+  :nil-preservingp t)
+
+(defthm cons-listp-of-rw.waterstep-list->clauses
+  (implies (force (rw.waterstep-listp x))
+           (equal (cons-listp (rw.waterstep-list->clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-list-listp-of-rw.waterstep-list->clauses
+  (implies (force (rw.waterstep-listp x))
+           (equal (true-list-listp (rw.waterstep-list->clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm logic.term-list-listp-of-rw.waterstep-list->clauses
+  (implies (force (rw.waterstep-listp x))
+           (equal (logic.term-list-listp (rw.waterstep-list->clauses x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defun rw.waterstep-induction (flag x)
+  (declare (xargs :measure (two-nats-measure (rank x) (if (equal flag 'clause) 1 0))
+                  :verify-guards nil))
+  (if (equal flag 'clause)
+      (rw.waterstep-induction 'list (rw.waterstep->substeps x))
+    (if (consp x)
+        (list (rw.waterstep-induction 'clause (car x))
+              (rw.waterstep-induction 'list (cdr x)))
+      t)))
+
+
+
+
+
+
+(defun rw.flag-waterstep-atblp (flag x atbl)
+  (declare (xargs :guard (and (if (equal flag 'clause)
+                                  (rw.waterstepp x)
+                                (rw.waterstep-listp x))
+                              (logic.arity-tablep atbl))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'clause) 1 0))))
+
+; We walk through the waterfall steps, collecting the clause for each STOP
+; step.  These are the clauses that still need to be proven before we can
+; compile this waterfall step into a real proof.
+
+  (if (equal flag 'clause)
+      (and (logic.term-list-atblp (rw.waterstep->clause x) atbl)
+           (rw.flag-waterstep-atblp 'list (rw.waterstep->substeps x) atbl))
+    (if (consp x)
+        (and (rw.flag-waterstep-atblp 'clause (car x) atbl)
+             (rw.flag-waterstep-atblp 'list (cdr x) atbl))
+      t)))
+
+(defund rw.waterstep-atblp (x atbl)
+  (declare (xargs :guard (and (rw.waterstepp x)
+                              (logic.arity-tablep atbl))))
+  (rw.flag-waterstep-atblp 'clause x atbl))
+
+(defund rw.waterstep-list-atblp (x atbl)
+  (declare (xargs :guard (and (rw.waterstep-listp x)
+                              (logic.arity-tablep atbl))))
+  (rw.flag-waterstep-atblp 'list x atbl))
+
+(defthmd definition-of-rw.waterstep-atblp
+  (equal (rw.waterstep-atblp x atbl)
+         (and (logic.term-list-atblp (rw.waterstep->clause x) atbl)
+              (rw.waterstep-list-atblp (rw.waterstep->substeps x) atbl)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterstep-atblp rw.waterstep-list-atblp)
+          :expand ((rw.flag-waterstep-atblp 'clause x atbl)))))
+
+(defthmd definition-of-rw.waterstep-list-atblp
+  (equal (rw.waterstep-list-atblp x atbl)
+         (if (consp x)
+             (and (rw.waterstep-atblp (car x) atbl)
+                  (rw.waterstep-list-atblp (cdr x) atbl))
+           t))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterstep-atblp rw.waterstep-list-atblp)
+          :expand ((rw.flag-waterstep-atblp 'list x atbl)))))
+
+(defthm rw.flag-waterstep-atblp-of-clause
+  (equal (rw.flag-waterstep-atblp 'clause x atbl)
+         (rw.waterstep-atblp x atbl))
+  :hints(("Goal" :in-theory (enable rw.waterstep-atblp))))
+
+(defthm rw.flag-waterstep-list-atblp-of-clause
+  (equal (rw.flag-waterstep-atblp 'list x atbl)
+         (rw.waterstep-list-atblp x atbl))
+  :hints(("Goal" :in-theory (enable rw.waterstep-list-atblp))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterstep-atblp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterstep-list-atblp))))
+
+(defthm rw.waterstep-list-atblp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.waterstep-list-atblp x atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-list-atblp))))
+
+(defthm rw.waterstep-list-atblp-of-cons
+  (equal (rw.waterstep-list-atblp (cons a x) atbl)
+         (and (rw.waterstep-atblp a atbl)
+              (rw.waterstep-list-atblp x atbl)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-list-atblp))))
+
+(defthm rw.waterstep-atblp-of-nil
+  (equal (rw.waterstep-atblp nil atbl)
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-atblp))))
+
+(defthms-flag
+  :thms ((clause booleanp-of-rw.waterstep-atblp
+                 (equal (booleanp (rw.waterstep-atblp x atbl))
+                        t))
+         (t booleanp-of-rw.waterstep-list-atblp
+            (equal (booleanp (rw.waterstep-list-atblp x atbl))
+                   t)))
+  :hints(("Goal"
+          :induct (rw.waterstep-induction flag x)
+          :in-theory (enable definition-of-rw.waterstep-atblp))))
+
+(deflist rw.waterstep-list-atblp (x atbl)
+  (rw.waterstep-atblp x atbl)
+  :guard (and (rw.waterstep-listp x)
+              (logic.arity-tablep atbl))
+  :elementp-of-nil t
+  :already-definedp t)
+
+(defthm logic.term-list-atblp-of-rw.waterstep->clause
+  (implies (force (rw.waterstep-atblp x atbl))
+           (equal (logic.term-list-atblp (rw.waterstep->clause x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-atblp))))
+
+(defthm rw.waterstep-list-atblp-of-rw.waterstep->substeps
+  (implies (force (rw.waterstep-atblp x atbl))
+           (equal (rw.waterstep-list-atblp (rw.waterstep->substeps x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-atblp))))
+
+(defthm rw.waterstep-atblp-of-rw.waterstep
+  (implies (force (and (logic.term-list-atblp clause atbl)
+                       (rw.waterstep-list-atblp substeps atbl)))
+           (equal (rw.waterstep-atblp (rw.waterstep method clause extras substeps) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-atblp))))
+
+
+
+
+
+
+; VALID WATERFALL STEPS.
+;
+; At the moment our waterfall is not very flexible, and the only steps it knows
+; about are
+;
+;   STOP,           make no more progress,
+;   UREWRITE,       simplify a clause with unconditional rewriting,
+;   CREWRITE,       simplify a clause with conditional rewriting,
+;   SPLIT,          break up a clause with if-lifting and if-splitting.
+;
+; But the format is pretty flexible and we could add other steps, just by
+; adding more recognizers here, extending the compiler, etc.
+
+(defund rw.stop-waterstep-okp (x)
+  (declare (xargs :guard (rw.waterstepp x)))
+
+; STOP steps are used when we cannot make any more progress or are forced to
+; "artificially" terminate due to hitting the maximum depth.  Their clauses are
+; left outstanding.  See also rw.waterfall-subgoals, which collects up the stop
+; steps so that we can try to prove them later.
+
+  (let ((method   (rw.waterstep->method x))
+        (extras   (rw.waterstep->extras x))
+        (substeps (rw.waterstep->substeps x)))
+    (and (equal method 'stop)
+         (not extras)
+         (not substeps))))
+
+(defthm booleanp-of-rw.stop-waterstep-okp
+  (equal (booleanp (rw.stop-waterstep-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.stop-waterstep-okp))))
+
+
+
+
+(defund rw.urewrite-waterstep-okp (x world)
+  (declare (xargs :guard (and (rw.waterstepp x)
+                              (tactic.worldp world))))
+  (let ((method   (rw.waterstep->method x))
+        (clause   (rw.waterstep->clause x))
+        (extras   (rw.waterstep->extras x))
+        (substeps (rw.waterstep->substeps x)))
+    (and (equal method 'urewrite)
+         ;; extras are (theoryname fastp traces), like in urewrite-first but
+         ;; without the world index (since that's resolved at a higher level)
+         (tuplep 3 extras)
+         (let ((theoryname (first extras))
+               (fastp      (second extras))
+               (traces     (third extras)))  ;; nil when fastp
+           (and (booleanp fastp)
+                (if fastp
+                    (let* ((rhses     (rw.fast-world-urewrite-list clause theoryname world))
+                           (progressp (not (equal clause rhses))))
+                      (and progressp
+                           (equal (rw.waterstep-list->clauses substeps) (list rhses))))
+                  (let* ((clause-rw (rw.world-urewrite-list clause theoryname world))
+                         (rhses     (rw.trace-list-rhses clause-rw))
+                         (progressp (not (equal clause rhses))))
+                    (and progressp
+                         (equal traces clause-rw)
+                         (equal (rw.waterstep-list->clauses substeps) (list rhses))))))))))
+
+(defthm booleanp-of-rw.urewrite-waterstep-okp
+  (equal (booleanp (rw.urewrite-waterstep-okp x world))
+         t)
+  :hints(("Goal" :in-theory (e/d (rw.urewrite-waterstep-okp)
+                                 ((:executable-counterpart acl2::force))))))
+
+
+
+
+(defund rw.crewrite-waterstep-okp (x world)
+  (declare (xargs :guard (and (rw.waterstepp x)
+                              (tactic.worldp world))))
+
+; CREWRITE steps are our uses of the rewriter.  We build the control structure
+; out of the world using the named theory.  This doesn't permit much in the way
+; of staged simplification, but that can be achieved by combining the waterfall
+; with our regular breadth-first tactics.
+
+  (let ((method   (rw.waterstep->method x))
+        (clause   (rw.waterstep->clause x))
+        (extras   (rw.waterstep->extras x))
+        (substeps (rw.waterstep->substeps x)))
+    (and (equal method 'crewrite)
+
+; The extras are similar to those in tactic.crewrite-first-okp.  They are a
+; 4-tuple of the form (theoryname ccsteps clause-prime forced-goals).
+
+         (let ((plan extras))
+           (and
+            (rw.crewrite-clause-planp plan)
+            (rw.crewrite-clause-plan-okp plan world)
+            (rw.crewrite-clause-plan->progressp plan)
+            (equal (rw.crewrite-clause-plan->clause plan) clause)
+            (let* ((fgoals   (rw.crewrite-clause-plan->forced-goals plan))
+                   (fclauses (clause.make-clauses-from-arbitrary-formulas fgoals)))
+              (equal (rw.waterstep-list->clauses substeps)
+                     (if (rw.crewrite-clause-plan->provedp plan)
+                         fclauses
+                       (cons (rw.crewrite-clause-plan->clause-prime plan)
+                             fclauses)))))))))
+
+(defthm booleanp-of-rw.crewrite-waterstep-okp
+  (equal (booleanp (rw.crewrite-waterstep-okp x world))
+         t)
+  :hints(("Goal" :in-theory (enable rw.crewrite-waterstep-okp))))
+
+
+
+(defund rw.split-waterstep-okp (x)
+  (declare (xargs :guard (rw.waterstepp x)))
+  (let ((method   (rw.waterstep->method x))
+        (clause   (rw.waterstep->clause x))
+        (extras   (rw.waterstep->extras x))
+        (substeps (rw.waterstep->substeps x)))
+    (and (equal method 'split)
+         (tuplep 3 extras)
+         (let ((liftp      (first extras))
+               (liftlimit  (second extras))
+               (splitlimit (third extras)))
+           (and (booleanp liftp)
+                (natp liftlimit)
+                (natp splitlimit)
+                (let ((result (clause.split liftp liftlimit splitlimit clause)))
+                  (and (car result)
+                       (equal (rw.waterstep-list->clauses substeps)
+                              (cdr result)))))))))
+
+(defthm booleanp-of-rw.split-waterstep-okp
+  (equal (booleanp (rw.split-waterstep-okp x))
+         t)
+  :hints(("Goal" :in-theory (enable rw.split-waterstep-okp))))
+
+
+
+(defund rw.flag-waterstep-okp (flag x world)
+  (declare (xargs :guard (and (if (equal flag 'clause)
+                                  (rw.waterstepp x)
+                                (rw.waterstep-listp x))
+                              (tactic.worldp world))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'clause) 1 0))))
+  (if (equal flag 'clause)
+      (and (let ((method (rw.waterstep->method x)))
+             (cond ((equal method 'stop)     (rw.stop-waterstep-okp x))
+                   ((equal method 'urewrite) (rw.urewrite-waterstep-okp x world))
+                   ((equal method 'crewrite) (rw.crewrite-waterstep-okp x world))
+                   ((equal method 'split)    (rw.split-waterstep-okp x))
+                   (t nil)))
+           (rw.flag-waterstep-okp 'list (rw.waterstep->substeps x) world))
+    (if (consp x)
+        (and (rw.flag-waterstep-okp 'clause (car x) world)
+             (rw.flag-waterstep-okp 'list (cdr x) world))
+      t)))
+
+(defund rw.waterstep-okp (x world)
+  (declare (xargs :guard (and (rw.waterstepp x)
+                              (tactic.worldp world))))
+  (rw.flag-waterstep-okp 'clause x world))
+
+(defund rw.waterstep-list-okp (x world)
+  (declare (xargs :guard (and (rw.waterstep-listp x)
+                              (tactic.worldp world))))
+  (rw.flag-waterstep-okp 'list x world))
+
+(defthmd definition-of-rw.waterstep-okp
+  (equal (rw.waterstep-okp x world)
+         (and (let ((method (rw.waterstep->method x)))
+                (cond ((equal method 'stop)     (rw.stop-waterstep-okp x))
+                      ((equal method 'urewrite) (rw.urewrite-waterstep-okp x world))
+                      ((equal method 'crewrite) (rw.crewrite-waterstep-okp x world))
+                      ((equal method 'split)    (rw.split-waterstep-okp x))
+                      (t nil)))
+              (rw.waterstep-list-okp (rw.waterstep->substeps x) world)))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterstep-okp rw.waterstep-list-okp)
+          :expand ((rw.flag-waterstep-okp 'clause x world)))))
+
+(defthmd definition-of-rw.waterstep-list-okp
+  (equal (rw.waterstep-list-okp x world)
+         (if (consp x)
+             (and (rw.waterstep-okp (car x) world)
+                  (rw.waterstep-list-okp (cdr x) world))
+           t))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterstep-okp rw.waterstep-list-okp)
+          :expand ((rw.flag-waterstep-okp 'list x world)))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterstep-okp))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterstep-list-okp))))
+
+(defthm rw.waterstep-list-okp-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.waterstep-list-okp x world)
+                  t))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-list-okp))))
+
+(defthm rw.waterstep-list-okp-of-cons
+  (equal (rw.waterstep-list-okp (cons a x) world)
+         (and (rw.waterstep-okp a world)
+              (rw.waterstep-list-okp x world)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-list-okp))))
+
+(defthm rw.waterstep-okp-of-nil
+  (equal (rw.waterstep-okp nil world)
+         nil)
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-okp))))
+
+(defthms-flag
+  :thms ((clause booleanp-of-rw.waterstep-okp
+                 (equal (booleanp (rw.waterstep-okp x world))
+                        t))
+         (t booleanp-of-rw.waterstep-list-okp
+            (equal (booleanp (rw.waterstep-list-okp x world))
+                   t)))
+  :hints(("Goal"
+          :induct (rw.waterstep-induction flag x)
+          :expand ((rw.waterstep-okp x world)))))
+
+(deflist rw.waterstep-list-okp (x world)
+  (rw.waterstep-okp x world)
+  :guard (and (rw.waterstep-listp x)
+              (symbolp theoryname)
+              (tactic.worldp world))
+  :elementp-of-nil nil
+  :already-definedp t)
+
+
+
+; THE WATERFALL
+
+(defun rw.flag-waterfall (flag x theoryname cfastp ufastp world steps strategy n)
+  (declare (xargs :guard (and (if (equal flag 'clause)
+                                  (and (logic.term-listp x)
+                                       (true-listp x)
+                                       (consp x))
+                                (and (logic.term-list-listp x)
+                                     (true-list-listp x)
+                                     (cons-listp x)))
+                              (symbolp theoryname)
+                              (booleanp ufastp)
+                              (booleanp cfastp)
+                              (tactic.worldp world)
+                              (natp n))
+                  :measure (three-nats-measure (nfix n) (len steps) (rank x))
+                  :hints(("Goal" :in-theory (disable (:executable-counterpart ACL2::force))))
+                  :verify-guards nil))
+
+; This is a depth-first way of applying some tactics.
+;
+; The Inputs.
+;
+;  - Flag,       are we working on a 'clause or a 'list of clauses,
+;  - X,          the clause(-list) we are working on,
+;  - Theoryname, the name of the theory to use for rewriting,
+;  - Cfastp,     whether to use fast or slow crewrite,
+;  - Ufastp,     whether to use fast or slow urewrite,
+;  - World,      the world we are in (for rewriting controls, etc.),
+;  - Steps,      the current steps remaining in this application of the strategy
+;  - Strategy,   the (fixed) strategy we are applying
+;  - N,          the maximum depth we can descend to.
+;
+; Basically the idea is that the strategy says what we are going to try to do
+; to each clause.  The strategy is a list of names of techniques to apply, and
+; currently the only supported names are UREWRITE, CREWRITE, CREWRITE-ONCE,
+; SPLIT, and NOLIFT-SPLIT.  The strategy is like a "waterfall", so that, e.g.,
+; given the strategy (crewrite split), we will always try to apply crewrite
+; until the clause is stable under crewrite, then we'll split once and
+; immediatley go back to trying crewrite.  See also the %auto tactic, which
+; uses a similar thing.
+
+  (if (equal flag 'clause)
+      (cond ((zp n)
+             (ACL2::prog2$ (ACL2::cw "; rw.flag-waterfall: ran out of steps~%")
+                           (rw.waterstep 'stop x nil nil)))
+
+            ((not (consp steps))
+             ;; The waterfall has been exhausted, no more steps can be applied
+             (rw.waterstep 'stop x nil nil))
+
+            ((equal (car steps) 'urewrite)
+             (if ufastp
+                 (let* ((x-prime   (rw.fast-world-urewrite-list x theoryname world))
+                        (progressp (not (equal x x-prime))))
+                   (if progressp
+                       (rw.waterstep 'urewrite
+                                     x
+                                     (list theoryname ufastp nil)
+                                     ;; This is like crewerite-once, we fall transparently
+                                     ;; through to the next step since urewrite should pretty
+                                     ;; much canonicalize in one pass.
+                                     (rw.flag-waterfall 'list (list x-prime) theoryname cfastp ufastp
+                                                        world (cdr steps) strategy (- n 1)))
+                     (rw.flag-waterfall 'clause x theoryname cfastp ufastp world (cdr steps) strategy n)))
+
+               (let* ((traces    (rw.world-urewrite-list x theoryname world))
+                      (x-prime   (rw.trace-list-rhses traces))
+                      (progressp (not (equal x x-prime))))
+                 (if progressp
+                     (rw.waterstep 'urewrite
+                                   x
+                                   (list theoryname ufastp traces)
+                                   (rw.flag-waterfall 'list (list x-prime) theoryname cfastp ufastp
+                                                      world (cdr steps) strategy (- n 1)))
+                   (rw.flag-waterfall 'clause x theoryname cfastp ufastp world (cdr steps) strategy n)))))
+
+            ((or (equal (car steps) 'crewrite)      ;; to a fixed-point
+                 (equal (car steps) 'crewrite-once) ;; only once then go on
+                 )
+             (let* ((plan (rw.make-crewrite-clause-plan x cfastp theoryname world)))
+               (if (rw.crewrite-clause-plan->progressp plan)
+                   (let* ((provedp   (rw.crewrite-clause-plan->provedp plan))
+                          (fgoals    (rw.crewrite-clause-plan->forced-goals plan))
+                          (fclauses  (clause.make-clauses-from-arbitrary-formulas fgoals))
+                          (new-goals (if provedp
+                                         fclauses
+                                       (cons (rw.crewrite-clause-plan->clause-prime plan)
+                                             fclauses))))
+                     (rw.waterstep 'crewrite
+                                   x
+                                   plan
+                                   (if (equal (car steps) 'crewrite)
+                                       ;; Restart the waterfall, decreasing depth
+                                       (rw.flag-waterfall 'list new-goals theoryname cfastp ufastp world
+                                                          strategy strategy (- n 1))
+                                     ;; Go on to the next steps.
+                                     (rw.flag-waterfall 'list new-goals theoryname cfastp ufastp world
+                                                        (cdr steps) strategy n))))
+                 ;; Failed to achieve anything.  Continue to the subsequent steps.
+                 (rw.flag-waterfall 'clause x theoryname cfastp ufastp world (cdr steps) strategy n))))
+
+            ((or (equal (car steps) 'split)
+                 (equal (car steps) 'nolift-split))
+             (let* ((liftp       (equal (car steps) 'split))
+                    (liftlimit   (tactic.world->liftlimit world))
+                    (splitlimit  (tactic.world->splitlimit world))
+                    (result      (clause.split liftp liftlimit splitlimit x))
+                    (progressp   (car result))
+                    (new-goals   (cdr result)))
+               (if progressp
+                   ;; Restart the waterfall on the new-goals, decreasing depth.
+                   (rw.waterstep 'split x (list liftp liftlimit splitlimit)
+                                 (rw.flag-waterfall 'list new-goals theoryname cfastp ufastp
+                                                    world strategy strategy (- n 1)))
+                 ;; Failed, continue
+                 (rw.flag-waterfall 'clause x theoryname cfastp ufastp world (cdr steps) strategy n))))
+
+            (t
+             ;; Just keep going if we don't recognize the step.
+             (ACL2::prog2$
+              (ACL2::cw ";; flag-water-clause: skipping unknown step: ~x0.~%" (car steps))
+              (rw.flag-waterfall 'clause x theoryname cfastp ufastp world (cdr steps) strategy n))))
+
+    (if (consp x)
+        (cons (rw.flag-waterfall 'clause (car x) theoryname cfastp ufastp world steps strategy n)
+              (rw.flag-waterfall 'list (cdr x) theoryname cfastp ufastp world steps strategy n))
+      nil)))
+
+(defund rw.waterfall (x theoryname cfastp ufastp world steps strategy n)
+  (declare (xargs :guard (and (logic.term-listp x)
+                              (true-listp x)
+                              (consp x)
+                              (symbolp theoryname)
+                              (booleanp cfastp)
+                              (booleanp ufastp)
+                              (tactic.worldp world)
+                              (natp n))
+                  :verify-guards nil))
+  (rw.flag-waterfall 'clause x theoryname cfastp ufastp world steps strategy n))
+
+(defund rw.waterfall-list (x theoryname cfastp ufastp world steps strategy n)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (true-list-listp x)
+                              (cons-listp x)
+                              (symbolp theoryname)
+                              (booleanp cfastp)
+                              (booleanp ufastp)
+                              (tactic.worldp world)
+                              (natp n))
+                  :verify-guards nil))
+  (rw.flag-waterfall 'list x theoryname cfastp ufastp world steps strategy n))
+
+(defthmd definition-of-rw.waterfall
+  (equal (rw.waterfall x theoryname cfastp ufastp world steps strategy n)
+         (cond ((zp n)
+                (rw.waterstep 'stop x nil nil))
+
+               ((not (consp steps))
+                (rw.waterstep 'stop x nil nil))
+
+               ((equal (car steps) 'urewrite)
+                (if ufastp
+                    (let* ((x-prime   (rw.fast-world-urewrite-list x theoryname world))
+                           (progressp (not (equal x x-prime))))
+                      (if progressp
+                          (rw.waterstep 'urewrite
+                                        x
+                                        (list theoryname ufastp nil)
+                                        (rw.waterfall-list (list x-prime) theoryname cfastp ufastp
+                                                           world (cdr steps) strategy (- n 1)))
+                        (rw.waterfall x theoryname cfastp ufastp world (cdr steps) strategy n)))
+
+               (let* ((traces    (rw.world-urewrite-list x theoryname world))
+                      (x-prime   (rw.trace-list-rhses traces))
+                      (progressp (not (equal x x-prime))))
+                 (if progressp
+                     (rw.waterstep 'urewrite
+                                   x
+                                   (list theoryname ufastp traces)
+                                   (rw.waterfall-list (list x-prime) theoryname cfastp ufastp
+                                                      world (cdr steps) strategy (- n 1)))
+                   (rw.waterfall x theoryname cfastp ufastp world (cdr steps) strategy n)))))
+
+               ((or (equal (car steps) 'crewrite)
+                    (equal (car steps) 'crewrite-once))
+                (let* ((plan (rw.make-crewrite-clause-plan x cfastp theoryname world)))
+                  (if (rw.crewrite-clause-plan->progressp plan)
+                      (let* ((provedp   (rw.crewrite-clause-plan->provedp plan))
+                             (fgoals    (rw.crewrite-clause-plan->forced-goals plan))
+                             (fclauses  (clause.make-clauses-from-arbitrary-formulas fgoals))
+                             (new-goals (if provedp
+                                            fclauses
+                                          (cons (rw.crewrite-clause-plan->clause-prime plan)
+                                                fclauses))))
+                        (rw.waterstep 'crewrite
+                                      x
+                                      plan
+                                      (if (equal (car steps) 'crewrite)
+                                          (rw.waterfall-list new-goals theoryname cfastp ufastp world
+                                                             strategy strategy (- n 1))
+                                        (rw.waterfall-list new-goals theoryname cfastp ufastp world
+                                                           (cdr steps) strategy n))))
+                    (rw.waterfall x theoryname cfastp ufastp world (cdr steps) strategy n))))
+
+               ((or (equal (car steps) 'split)
+                    (equal (car steps) 'nolift-split))
+                (let* ((liftp       (equal (car steps) 'split))
+                       (liftlimit   (tactic.world->liftlimit world))
+                       (splitlimit  (tactic.world->splitlimit world))
+                       (result      (clause.split liftp liftlimit splitlimit x))
+                       (progressp   (car result))
+                       (new-goals   (cdr result)))
+                  (if progressp
+                      (rw.waterstep 'split x (list liftp liftlimit splitlimit)
+                                    (rw.waterfall-list new-goals theoryname cfastp ufastp world
+                                                       strategy strategy (- n 1)))
+                    (rw.waterfall x theoryname cfastp ufastp world (cdr steps) strategy n))))
+
+               (t
+                (rw.waterfall x theoryname cfastp ufastp world (cdr steps) strategy n))))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand ((rw.flag-waterfall 'clause x theoryname cfastp ufastp world steps strategy n))
+          :in-theory (enable rw.waterfall rw.waterfall-list))))
+
+(defthmd definition-of-rw.waterfall-list
+  (equal (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n)
+         (if (consp x)
+             (cons (rw.waterfall (car x) theoryname cfastp ufastp world steps strategy n)
+                   (rw.waterfall-list (cdr x) theoryname cfastp ufastp world steps strategy n))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :expand ((rw.flag-waterfall 'list x theoryname cfastp ufastp world steps strategy n))
+          :in-theory (enable rw.waterfall rw.waterfall-list))))
+
+(defthm rw.flag-waterfall-of-clause
+  (equal (rw.flag-waterfall 'clause x theoryname cfastp ufastp world steps strategy n)
+         (rw.waterfall x theoryname cfastp ufastp world steps strategy n))
+  :hints(("Goal" :in-theory (enable rw.waterfall))))
+
+(defthm rw.flag-waterfall-of-list
+  (equal (rw.flag-waterfall 'list x theoryname cfastp ufastp world steps strategy n)
+         (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n))
+  :hints(("Goal" :in-theory (enable rw.waterfall-list))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterfall))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterfall-list))))
+
+(defthm rw.waterfall-list-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterfall-list))))
+
+(defthm rw.waterfall-list-of-cons
+  (equal (rw.waterfall-list (cons a x) theoryname cfastp ufastp world steps strategy n)
+         (cons (rw.waterfall a theoryname cfastp ufastp world steps strategy n)
+               (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterfall-list))))
+
+(defprojection
+  :list (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n)
+  :element (rw.waterfall x theoryname cfastp ufastp world steps strategy n)
+  :nil-preservingp nil
+  :already-definedp t)
+
+(defthm true-listp-of-clause.make-clause-from-arbitrary-formula
+  (equal (true-listp (clause.make-clause-from-arbitrary-formula x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.make-clause-from-arbitrary-formula))))
+
+(defthm true-list-listp-of-clause.make-clauses-from-arbitrary-formulas
+  (equal (true-list-listp (clause.make-clauses-from-arbitrary-formulas x))
+         t)
+  :hints(("Goal" :in-theory (enable clause.make-clauses-from-arbitrary-formulas))))
+
+
+
+
+(defthmd lemma-2-for-rw.waterstepp-of-rw.waterfall
+  ;; wow horrible gross
+  (implies (force (and (true-listp x)
+                       (logic.term-listp x)
+                       (consp x)
+                       (tactic.worldp world)))
+           (equal (true-listp (rw.crewrite-clause-plan->clause-prime
+                               (rw.make-crewrite-clause-plan x cfastp theoryname world)))
+                  t))
+  :hints(("Goal"
+          :in-theory (e/d (rw.make-crewrite-clause-plan
+                           rw.crewrite-clause-plan->clause-prime)))))
+
+(defthms-flag
+  :shared-hyp (force (and (symbolp theoryname)
+                          (tactic.worldp world)
+                          (natp n)))
+  :thms ((clause rw.waterstepp-of-rw.waterfall
+                 (implies (force (and (logic.term-listp x)
+                                      (true-listp x)
+                                      (consp x)))
+                          (rw.waterstepp (rw.waterfall x theoryname cfastp ufastp world steps strategy n))))
+         (t rw.waterstep-listp-of-rw.waterfall-list
+            (implies (force (and (logic.term-list-listp x)
+                                 (true-list-listp x)
+                                 (cons-listp x)))
+                     (rw.waterstep-listp (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n)))))
+  :hints(("Goal"
+          :induct (rw.flag-waterfall flag x theoryname cfastp ufastp world steps strategy n)
+          :in-theory (enable definition-of-rw.waterfall
+                             lemma-2-for-rw.waterstepp-of-rw.waterfall))))
+
+
+
+(defthmd lemma-1-for-rw.waterstep-atblp-of-rw.waterfall
+  ;; GROSS !!!! Horrible lemmas.  Stupid ccsteps.
+  (implies (force (and (rw.trace-atblp (rw.ccstep->trace x) atbl)
+                       (rw.hypbox-atblp (rw.ccstep->hypbox x) atbl)))
+           (equal (logic.term-list-atblp (rw.ccstep->clause-prime x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep->clause-prime))))
+
+(defthmd lemma-2-for-rw.waterstep-atblp-of-rw.waterfall
+  ;; GROSS !!!! Horrible lemmas.  Stupid ccsteps.
+  (implies (force (and (rw.trace-list-atblp (rw.ccstep-list-gather-traces x) atbl)
+                       (not (rw.ccstep->provedp (car x)))
+                       (consp x)))
+           (equal (rw.trace-atblp (rw.ccstep->trace (car x)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-gather-traces
+                                    rw.ccstep->provedp
+                                    rw.ccstep->contradiction))))
+
+(defthmd lemma-3-for-rw.waterstep-atblp-of-rw.waterfall
+  ;; GROSS !!!! Horrible lemmas.  Stupid ccsteps.
+  (implies (force (rw.hypbox-list-atblp (rw.ccstep-list-hypboxes x) atbl))
+           (equal (rw.hypbox-atblp (rw.ccstep->hypbox (car x)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable rw.ccstep-list-hypboxes))))
+
+(defthmd lemma-4-for-rw.waterstep-atblp-of-rw.waterfall
+  (implies (and (equal free (rw.ccstep->clause-prime x))
+                (force (rw.trace-atblp (rw.ccstep->trace x) atbl))
+                (force (rw.hypbox-atblp (rw.ccstep->hypbox x) atbl)))
+           (equal (logic.term-list-atblp free atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable lemma-1-for-rw.waterstep-atblp-of-rw.waterfall))))
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthmd lemma-5-for-rw.waterstep-atblp-of-rw.waterfall
+   (implies (force (and (rw.crewrite-clause-planp x)
+                        (rw.crewrite-clause-plan-atblp x atbl)
+                        (rw.crewrite-clause-plan-okp x world)
+                        (tactic.worldp world)
+                        (tactic.world-atblp world atbl)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'if atbl)) 3)))
+            (equal (logic.term-list-atblp (rw.crewrite-clause-plan->clause-prime x) atbl)
+                   t))
+   :hints(("Goal"
+           :in-theory (enable rw.crewrite-clause-planp
+                              rw.crewrite-clause-plan-atblp
+                              rw.crewrite-clause-plan-okp
+                              rw.crewrite-clause-plan->clause
+                              rw.crewrite-clause-plan->clause-prime
+                              lemma-1-for-rw.waterstep-atblp-of-rw.waterfall
+                              lemma-2-for-rw.waterstep-atblp-of-rw.waterfall
+                              lemma-3-for-rw.waterstep-atblp-of-rw.waterfall
+                              lemma-4-for-rw.waterstep-atblp-of-rw.waterfall)))))
+
+(defthms-flag
+  :shared-hyp (force (and (symbolp theoryname)
+                          (tactic.worldp world)
+                          (tactic.world-atblp world atbl)
+                          (equal (cdr (lookup 'not atbl)) 1)
+                          (equal (cdr (lookup 'equal atbl)) 2)
+                          (equal (cdr (lookup 'iff atbl)) 2)
+                          (equal (cdr (lookup 'if atbl)) 3)
+                          (natp n)))
+  :thms ((clause rw.waterstep-atblp-of-rw.waterfall
+                 (implies (force (and (logic.term-listp x)
+                                      (logic.term-list-atblp x atbl)
+                                      (true-listp x)
+                                      (consp x)))
+                          (rw.waterstep-atblp (rw.waterfall x theoryname cfastp ufastp world steps strategy n)
+                                              atbl)))
+         (t rw.waterstep-list-atblp-of-rw.waterfall-list
+            (implies (force (and (logic.term-list-listp x)
+                                 (logic.term-list-list-atblp x atbl)
+                                 (true-list-listp x)
+                                 (cons-listp x)))
+                     (rw.waterstep-list-atblp (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n)
+                                              atbl))))
+  :hints(("Goal"
+          :induct (rw.flag-waterfall flag x theoryname cfastp ufastp world steps strategy n)
+          :in-theory (enable lemma-1-for-rw.waterstep-atblp-of-rw.waterfall
+                             lemma-2-for-rw.waterstep-atblp-of-rw.waterfall
+                             lemma-3-for-rw.waterstep-atblp-of-rw.waterfall
+                             lemma-4-for-rw.waterstep-atblp-of-rw.waterfall
+                             lemma-5-for-rw.waterstep-atblp-of-rw.waterfall
+                             lemma-2-for-rw.waterstepp-of-rw.waterfall
+                             )
+          :restrict ((lemma-5-for-rw.waterstep-atblp-of-rw.waterfall
+                      ((world world)))
+                     (logic.formula-list-atblp-of-rw.crewrite-clause-plan->forced-goals
+                      ((world world))))
+          :expand ((:free (n cfastp ufastp)
+                          (rw.waterfall x theoryname cfastp ufastp world steps strategy n))))))
+
+(defthms-flag
+  :thms ((clause rw.waterstep->clause-of-rw.waterfall
+                 (equal (rw.waterstep->clause (rw.waterfall x theoryname cfastp ufastp world steps strategy n))
+                        x))
+         (t rw.waterstep-list->clauses-of-rw.waterfall-list
+            (equal (rw.waterstep-list->clauses (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n))
+                   (list-fix x))))
+  :hints(("Goal"
+          :induct (rw.flag-waterfall flag x theoryname cfastp ufastp world steps strategy n)
+          :in-theory (e/d (definition-of-rw.waterfall)
+                          ((:executable-counterpart acl2::force))))))
+
+
+(ACL2::with-output
+ :gag-mode :goals
+ (defthms-flag
+
+; This proof is kind of lousy.  We don't have a very good way to encapsulate
+; the various steps, so we end up proving them all at once.
+
+   :shared-hyp (force (and (tactic.worldp world)
+                           (booleanp ufastp)
+                           (booleanp cfastp)
+                           (symbolp theoryname)
+                           (natp n)))
+   :thms ((clause rw.waterstep-okp-of-rw.waterfall
+                  (implies (force (and (logic.term-listp x)
+                                       (true-listp x)
+                                       (consp x)))
+                           (rw.waterstep-okp (rw.waterfall x theoryname cfastp ufastp world steps strategy n) world)))
+          (t rw.waterstep-list-okp-of-rw.waterfall-list
+             (implies (force (and (logic.term-list-listp x)
+                                  (true-list-listp x)
+                                  (cons-listp x)))
+                      (rw.waterstep-list-okp (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n) world))))
+   :hints(("Goal"
+           :induct (rw.flag-waterfall flag x theoryname cfastp ufastp world steps strategy n)
+           :in-theory (enable definition-of-rw.waterfall)
+           :expand ((:free (cfastp ufastp) (rw.waterfall x theoryname cfastp ufastp world steps strategy n))))
+          (and ACL2::stable-under-simplificationp
+               '(:in-theory (enable definition-of-rw.waterstep-okp
+                                    rw.stop-waterstep-okp
+                                    rw.crewrite-waterstep-okp
+                                    rw.split-waterstep-okp
+                                    rw.urewrite-waterstep-okp
+                                    lemma-2-for-rw.waterstepp-of-rw.waterfall))))))
+
+(verify-guards rw.flag-waterfall
+               :hints(("Goal" :in-theory (enable lemma-2-for-rw.waterstepp-of-rw.waterfall))))
+
+(verify-guards rw.waterfall)
+(verify-guards rw.waterfall-list)
+
+
+
+
+(defun rw.flag-waterfall-subgoals (flag x)
+  (declare (xargs :guard (if (equal flag 'clause)
+                             (rw.waterstepp x)
+                           (rw.waterstep-listp x))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'clause) 1 0))))
+
+; We walk through the waterfall steps, collecting the clause for each STOP
+; step.  These are the clauses that still need to be proven before we can
+; compile this waterfall step into a real proof.
+
+  (if (equal flag 'clause)
+      (let ((method (rw.waterstep->method x)))
+        (if (equal method 'stop)
+            (list (rw.waterstep->clause x))
+          (rw.flag-waterfall-subgoals 'list (rw.waterstep->substeps x))))
+    (if (consp x)
+        ;; BOZO potentially slow.  On the other hand, maybe there aren't all that many
+        ;; unproven subgoals in practice.  Could optimize using an accumulator, per usual.
+        (app (rw.flag-waterfall-subgoals 'clause (car x))
+             (rw.flag-waterfall-subgoals 'list (cdr x)))
+      nil)))
+
+(defund rw.waterfall-subgoals (x)
+  (declare (xargs :guard (rw.waterstepp x)))
+  (rw.flag-waterfall-subgoals 'clause x))
+
+(defund rw.waterfall-list-subgoals (x)
+  (declare (xargs :guard (rw.waterstep-listp x)))
+  (rw.flag-waterfall-subgoals 'list x))
+
+(defthmd definition-of-rw.waterfall-subgoals
+  (equal (rw.waterfall-subgoals x)
+         (let ((method (rw.waterstep->method x)))
+           (if (equal method 'stop)
+               (list (rw.waterstep->clause x))
+             (rw.waterfall-list-subgoals (rw.waterstep->substeps x)))))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterfall-subgoals
+                             rw.waterfall-list-subgoals)
+          :expand ((rw.flag-waterfall-subgoals 'clause x)))))
+
+(defthmd definition-of-rw.waterfall-list-subgoals
+  (equal (rw.waterfall-list-subgoals x)
+         (if (consp x)
+             (app (rw.waterfall-subgoals (car x))
+                  (rw.waterfall-list-subgoals (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterfall-subgoals
+                             rw.waterfall-list-subgoals)
+          :expand ((rw.flag-waterfall-subgoals 'list x)))))
+
+(defthm rw.flag-waterfall-subgoals-of-clause
+  (equal (rw.flag-waterfall-subgoals 'clause x)
+         (rw.waterfall-subgoals x))
+  :hints(("Goal" :in-theory (enable rw.waterfall-subgoals))))
+
+(defthm rw.flag-waterfall-list-subgoals-of-clause
+  (equal (rw.flag-waterfall-subgoals 'list x)
+         (rw.waterfall-list-subgoals x))
+  :hints(("Goal" :in-theory (enable rw.waterfall-list-subgoals))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterfall-subgoals))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterfall-list-subgoals))))
+
+(defthm rw.waterfall-list-subgoals-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.waterfall-list-subgoals x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterfall-list-subgoals))))
+
+(defthm rw.waterfall-list-subgoals-of-cons
+  (equal (rw.waterfall-list-subgoals (cons a x))
+         (app (rw.waterfall-subgoals a)
+              (rw.waterfall-list-subgoals x)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterfall-list-subgoals))))
+
+(defthms-flag
+  :thms ((clause logic.term-list-listp-of-rw.waterfall-subgoals
+                 (implies (force (rw.waterstepp x))
+                          (equal (logic.term-list-listp (rw.waterfall-subgoals x))
+                                 t)))
+         (t logic.term-list-listp-of-rw.waterfall-list-subgoals
+            (implies (force (rw.waterstep-listp x))
+                     (equal (logic.term-list-listp (rw.waterfall-list-subgoals x))
+                            t))))
+  :hints(("Goal"
+          :induct (rw.flag-waterfall-subgoals flag x)
+          :in-theory (enable definition-of-rw.waterfall-subgoals))))
+
+(defthms-flag
+  :thms ((clause cons-listp-of-rw.waterfall-subgoals
+                 (implies (force (rw.waterstepp x))
+                          (equal (cons-listp (rw.waterfall-subgoals x))
+                                 t)))
+         (t cons-listp-of-rw.waterfall-list-subgoals
+            (implies (force (rw.waterstep-listp x))
+                     (equal (cons-listp (rw.waterfall-list-subgoals x))
+                            t))))
+  :hints(("Goal"
+          :induct (rw.flag-waterfall-subgoals flag x)
+          :in-theory (enable definition-of-rw.waterfall-subgoals))))
+
+(defthms-flag
+  :thms ((clause true-list-listp-of-rw.waterfall-subgoals
+                 (implies (force (rw.waterstepp x))
+                          (equal (true-list-listp (rw.waterfall-subgoals x))
+                                 t)))
+         (t true-list-listp-rw.waterfall-list-subgoals
+            (implies (force (rw.waterstep-listp x))
+                     (equal (true-list-listp (rw.waterfall-list-subgoals x))
+                            t))))
+  :hints(("Goal"
+          :induct (rw.flag-waterfall-subgoals flag x)
+          :in-theory (enable definition-of-rw.waterfall-subgoals))))
+
+(defthms-flag
+  :thms ((clause true-listp-of-rw.waterfall-subgoals
+                 (equal (true-listp (rw.waterfall-subgoals x))
+                        t))
+         (t true-listp-rw.waterfall-list-subgoals
+            (equal (true-listp (rw.waterfall-list-subgoals x))
+                   t)))
+  :hints(("Goal"
+          :induct (rw.flag-waterfall-subgoals flag x)
+          :in-theory (enable definition-of-rw.waterfall-subgoals))))
+
+
+
+
+
+; WATERFALL STEP COMPILER
+;
+; As might be expected, we just introduce a compiler for each kind of step.  We
+; show that given proofs of all of the remaining waterfall-subgoals, we can
+; construct a proof of the clause for this step.
+;
+; In these compilers, we distinguish between RPROOFS and SPROOFS.
+;
+;   RPROOFS are the "remaining proofs" after the entire waterfall completes.
+;   That is, they are the proofs of all the waterfall-subgoals.
+;
+;   SPROOFS are, for non-atomic proof steps, the proofs of the clauses
+;   of the substeps.
+
+(defsection rw.stop-waterstep-compiler
+
+  (defund rw.stop-waterstep-compiler (x rproofs)
+    (declare (xargs :guard (and (rw.waterstepp x)
+                                (rw.stop-waterstep-okp x)
+                                (logic.appeal-listp rproofs)
+                                (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                         (logic.strip-conclusions rproofs)))))
+    (logic.find-proof (clause.clause-formula (rw.waterstep->clause x))
+                      rproofs))
+
+  (local (in-theory (enable rw.stop-waterstep-compiler
+                            rw.stop-waterstep-okp
+                            definition-of-rw.waterfall-subgoals)))
+
+  (defthm logic.appealp-of-rw.stop-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (rw.stop-waterstep-okp x)
+                         (logic.appeal-listp rproofs)
+                         (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                  (logic.strip-conclusions rproofs))))
+             (equal (logic.appealp (rw.stop-waterstep-compiler x rproofs))
+                    t)))
+
+  (defthm logic.conclusion-of-rw.stop-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (rw.stop-waterstep-okp x)
+                         (logic.appeal-listp rproofs)
+                         (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                  (logic.strip-conclusions rproofs))))
+             (equal (logic.conclusion (rw.stop-waterstep-compiler x rproofs))
+                    (clause.clause-formula (rw.waterstep->clause x)))))
+
+  (defthm logic.proofp-of-rw.stop-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (rw.stop-waterstep-okp x)
+                         (logic.appeal-listp rproofs)
+                         (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                  (logic.strip-conclusions rproofs))
+                         ;; ---
+                         (logic.proof-listp rproofs axioms thms atbl)))
+             (equal (logic.proofp (rw.stop-waterstep-compiler x rproofs) axioms thms atbl)
+                    t))))
+
+
+
+(defsection rw.urewrite-waterstep-compiler
+
+  (defund rw.urewrite-waterstep-compiler (x world sproofs)
+    (declare (xargs :guard (and (rw.waterstepp x)
+                                (tactic.worldp world)
+                                (rw.urewrite-waterstep-okp x world)
+                                (logic.appeal-listp sproofs)
+                                (equal (logic.strip-conclusions sproofs)
+                                       (clause.clause-list-formulas
+                                        (rw.waterstep-list->clauses
+                                         (rw.waterstep->substeps x)))))
+                    :verify-guards nil))
+    (let* ((clause       (rw.waterstep->clause x))
+           (extras       (rw.waterstep->extras x))
+           (substeps     (rw.waterstep->substeps x))
+           (clause-prime (rw.waterstep->clause (car substeps)))
+           (theoryname   (first extras))
+           (fastp        (second extras))
+           (traces       (third extras)))
+      (rw.world-urewrite-list-bldr clause clause-prime fastp theoryname world traces (car sproofs))))
+
+  (defobligations rw.urewrite-waterstep-compiler
+    (rw.world-urewrite-list-bldr))
+
+  (local (in-theory (enable rw.urewrite-waterstep-compiler
+                            rw.urewrite-waterstep-okp)))
+
+  (verify-guards rw.urewrite-waterstep-compiler)
+
+  (defthm logic.appealp-of-rw.urewrite-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (tactic.worldp world)
+                         (rw.urewrite-waterstep-okp x world)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))))
+             (equal (logic.appealp (rw.urewrite-waterstep-compiler x world sproofs))
+                    t)))
+
+  (defthm logic.conclusion-of-rw.urewrite-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (tactic.worldp world)
+                         (rw.urewrite-waterstep-okp x world)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))))
+             (equal (logic.conclusion (rw.urewrite-waterstep-compiler x world sproofs))
+                    (clause.clause-formula (rw.waterstep->clause x)))))
+
+  (defthm@ logic.proofp-of-rw.urewrite-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (tactic.worldp world)
+                         (rw.urewrite-waterstep-okp x world)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))
+                         ;; ---
+                         (rw.waterstep-atblp x atbl)
+                         (tactic.world-atblp world atbl)
+                         (tactic.world-env-okp world axioms thms)
+                         (equal (cdr (lookup 'if atbl)) 3)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (logic.proof-listp sproofs axioms thms atbl)
+                         (@obligations rw.urewrite-waterstep-compiler)
+                         ))
+             (equal (logic.proofp (rw.urewrite-waterstep-compiler x world sproofs) axioms thms atbl)
+                    t))))
+
+
+(defsection rw.crewrite-waterstep-compiler
+
+  (defund rw.crewrite-waterstep-compiler (x world sproofs)
+    (declare (xargs :guard (and (rw.waterstepp x)
+                                (tactic.worldp world)
+                                (rw.crewrite-waterstep-okp x world)
+                                (logic.appeal-listp sproofs)
+                                (equal (logic.strip-conclusions sproofs)
+                                       (clause.clause-list-formulas
+                                        (rw.waterstep-list->clauses
+                                         (rw.waterstep->substeps x)))))
+                    :verify-guards nil))
+    (let* ( ;(clause  (rw.waterstep->clause x))
+           (plan    (rw.waterstep->extras x))
+           (provedp (rw.crewrite-clause-plan->provedp plan))
+           (fgoals  (rw.crewrite-clause-plan->forced-goals plan)))
+      (if provedp
+          (let ((fproofs (clause.prove-arbitrary-formulas-from-their-clauses fgoals sproofs)))
+            (rw.crewrite-clause-plan-compiler plan world nil fproofs))
+        (let ((proof1  (car sproofs))
+              (fproofs (clause.prove-arbitrary-formulas-from-their-clauses fgoals (cdr sproofs))))
+          (rw.crewrite-clause-plan-compiler plan world proof1 fproofs)))))
+
+
+  (defobligations rw.crewrite-waterstep-compiler
+    (rw.crewrite-clause-bldr
+     clause.prove-arbitrary-formulas-from-their-clauses))
+
+  (local (in-theory (enable rw.crewrite-waterstep-compiler rw.crewrite-waterstep-okp)))
+
+  (verify-guards rw.crewrite-waterstep-compiler)
+
+  (defthm logic.appealp-of-rw.crewrite-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (tactic.worldp world)
+                         (rw.crewrite-waterstep-okp x world)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))))
+             (equal (logic.appealp (rw.crewrite-waterstep-compiler x world sproofs))
+                    t)))
+
+  (defthm logic.conclusion-of-rw.crewrite-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (tactic.worldp world)
+                         (rw.crewrite-waterstep-okp x world)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))))
+             (equal (logic.conclusion (rw.crewrite-waterstep-compiler x world sproofs))
+                    (clause.clause-formula (rw.waterstep->clause x)))))
+
+  (defthm@ logic.proofp-of-rw.crewrite-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (tactic.worldp world)
+                         (rw.crewrite-waterstep-okp x world)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))
+                         ;; ---
+                         (rw.waterstep-atblp x atbl)
+                         (tactic.world-atblp world atbl)
+                         (tactic.world-env-okp world axioms thms)
+                         (equal (cdr (lookup 'if atbl)) 3)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (logic.proof-listp sproofs axioms thms atbl)
+                         (@obligations rw.crewrite-waterstep-compiler)
+                         ))
+             (equal (logic.proofp (rw.crewrite-waterstep-compiler x world sproofs) axioms thms atbl)
+                    t))))
+
+
+
+(defsection rw.split-waterstep-compiler
+
+  (defund rw.split-waterstep-compiler (x sproofs)
+    (declare (xargs :guard (and (rw.waterstepp x)
+                                (rw.split-waterstep-okp x)
+                                (logic.appeal-listp sproofs)
+                                (equal (logic.strip-conclusions sproofs)
+                                       (clause.clause-list-formulas
+                                        (rw.waterstep-list->clauses
+                                         (rw.waterstep->substeps x)))))
+                    :verify-guards nil))
+    (let* ((clause     (rw.waterstep->clause x))
+           (extras     (rw.waterstep->extras x))
+           (liftp      (first extras))
+           (liftlimit  (second extras))
+           (splitlimit (third extras)))
+      (clause.split-bldr liftp liftlimit splitlimit clause sproofs)))
+
+  (defobligations rw.split-waterstep-compiler
+    (clause.split-bldr))
+
+  (local (in-theory (enable rw.split-waterstep-okp rw.split-waterstep-compiler)))
+
+  (verify-guards rw.split-waterstep-compiler)
+
+  (defthm logic.appealp-of-rw.split-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (rw.split-waterstep-okp x)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))))
+             (equal (logic.appealp (rw.split-waterstep-compiler x sproofs))
+                    t)))
+
+  (defthm logic.conclusion-of-rw.split-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (rw.split-waterstep-okp x)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))))
+             (equal (logic.conclusion (rw.split-waterstep-compiler x sproofs))
+                    (clause.clause-formula (rw.waterstep->clause x)))))
+
+  (defthm@ logic.proofp-of-rw.split-waterstep-compiler
+    (implies (force (and (rw.waterstepp x)
+                         (rw.split-waterstep-okp x)
+                         (logic.appeal-listp sproofs)
+                         (equal (logic.strip-conclusions sproofs)
+                                (clause.clause-list-formulas
+                                 (rw.waterstep-list->clauses
+                                  (rw.waterstep->substeps x))))
+                         ;; ---
+                         (rw.waterstep-atblp x atbl)
+                         (logic.proof-listp sproofs axioms thms atbl)
+                         (equal (cdr (lookup 'not atbl)) 1)
+                         (equal (cdr (lookup 'equal atbl)) 2)
+                         (equal (cdr (lookup 'iff atbl)) 2)
+                         (equal (cdr (lookup 'if atbl)) 3)
+                         (@obligations rw.split-waterstep-compiler)
+                         ))
+             (equal (logic.proofp (rw.split-waterstep-compiler x sproofs) axioms thms atbl)
+                    t))))
+
+
+
+(defund rw.flag-waterstep-compiler (flag x world rproofs)
+  (declare (xargs :guard (and (logic.appeal-listp rproofs)
+                              (tactic.worldp world)
+                              (if (equal flag 'clause)
+                                  (and (rw.waterstepp x)
+                                       (rw.waterstep-okp x world)
+                                       (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                                (logic.strip-conclusions rproofs)))
+                                (and (rw.waterstep-listp x)
+                                     (rw.waterstep-list-okp x world)
+                                     (subsetp (clause.clause-list-formulas (rw.waterfall-list-subgoals x))
+                                              (logic.strip-conclusions rproofs)))))
+                  :measure (two-nats-measure (rank x) (if (equal flag 'clause) 1 0))
+                  :verify-guards nil))
+  (if (equal flag 'clause)
+      (let* ((method   (rw.waterstep->method x))
+             (substeps (rw.waterstep->substeps x))
+             (sproofs  (rw.flag-waterstep-compiler 'list substeps world rproofs)))
+        (cond ((equal method 'stop)
+               (rw.stop-waterstep-compiler x rproofs))
+              ((equal method 'urewrite)
+               (rw.urewrite-waterstep-compiler x world sproofs))
+              ((equal method 'crewrite)
+               (rw.crewrite-waterstep-compiler x world sproofs))
+              ((equal method 'split)
+               (rw.split-waterstep-compiler x sproofs))))
+    (if (consp x)
+        (cons (rw.flag-waterstep-compiler 'clause (car x) world rproofs)
+              (rw.flag-waterstep-compiler 'list (cdr x) world rproofs))
+      nil)))
+
+(defobligations rw.flag-waterstep-compiler
+  (rw.stop-waterstep-compiler
+   rw.urewrite-waterstep-compiler
+   rw.crewrite-waterstep-compiler
+   rw.split-waterstep-compiler))
+
+(defund rw.waterstep-compiler (x world rproofs)
+  (declare (xargs :guard (and (logic.appeal-listp rproofs)
+                              (tactic.worldp world)
+                              (rw.waterstepp x)
+                              (rw.waterstep-okp x world)
+                              (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                       (logic.strip-conclusions rproofs)))
+                  :verify-guards nil))
+  (rw.flag-waterstep-compiler 'clause x world rproofs))
+
+(defund rw.waterstep-list-compiler (x world rproofs)
+  (declare (xargs :guard (and (logic.appeal-listp rproofs)
+                              (tactic.worldp world)
+                              (rw.waterstep-listp x)
+                              (rw.waterstep-list-okp x world)
+                              (subsetp (clause.clause-list-formulas (rw.waterfall-list-subgoals x))
+                                       (logic.strip-conclusions rproofs)))
+                  :verify-guards nil))
+  (rw.flag-waterstep-compiler 'list x world rproofs))
+
+(defobligations rw.waterstep-compiler
+  (rw.flag-waterstep-compiler))
+
+(defobligations rw.waterstep-list-compiler
+  (rw.flag-waterstep-compiler))
+
+(defthmd definition-of-rw.waterstep-compiler
+  (equal (rw.waterstep-compiler x world rproofs)
+         (let* ((method   (rw.waterstep->method x))
+                (substeps (rw.waterstep->substeps x))
+                (sproofs  (rw.waterstep-list-compiler substeps world rproofs)))
+           (cond ((equal method 'stop)
+                  (rw.stop-waterstep-compiler x rproofs))
+                 ((equal method 'urewrite)
+                  (rw.urewrite-waterstep-compiler x world sproofs))
+                 ((equal method 'crewrite)
+                  (rw.crewrite-waterstep-compiler x world sproofs))
+                 ((equal method 'split)
+                  (rw.split-waterstep-compiler x sproofs)))))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterstep-compiler rw.waterstep-list-compiler)
+          :expand (rw.flag-waterstep-compiler 'clause x world rproofs))))
+
+(defthmd definition-of-rw.waterstep-list-compiler
+  (equal (rw.waterstep-list-compiler x world rproofs)
+         (if (consp x)
+             (cons (rw.waterstep-compiler (car x) world rproofs)
+                   (rw.waterstep-list-compiler (cdr x) world rproofs))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable rw.waterstep-compiler rw.waterstep-list-compiler)
+          :expand (rw.flag-waterstep-compiler 'list x world rproofs))))
+
+(defthm rw.flag-waterstep-compiler-of-clause
+  (equal (rw.flag-waterstep-compiler 'clause x world rproofs)
+         (rw.waterstep-compiler x world rproofs))
+  :hints(("Goal" :in-theory (enable rw.waterstep-compiler))))
+
+(defthm rw.flag-waterstep-compiler-of-list
+  (equal (rw.flag-waterstep-compiler 'list x world rproofs)
+         (rw.waterstep-list-compiler x world rproofs))
+  :hints(("Goal" :in-theory (enable rw.waterstep-list-compiler))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterstep-compiler))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition rw.waterstep-list-compiler))))
+
+(defthm rw.waterstep-compiler-of-nil
+  (equal (rw.waterstep-compiler nil world rproofs)
+         nil)
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-compiler))))
+
+(defthm rw.waterstep-list-compiler-when-not-consp
+  (implies (not (consp x))
+           (equal (rw.waterstep-list-compiler x world rproofs)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-list-compiler))))
+
+(defthm rw.waterstep-list-compiler-of-cons
+  (equal (rw.waterstep-list-compiler (cons a x) world rproofs)
+         (cons (rw.waterstep-compiler a world rproofs)
+               (rw.waterstep-list-compiler x world rproofs)))
+  :hints(("Goal" :in-theory (enable definition-of-rw.waterstep-list-compiler))))
+
+(defprojection
+  :list (rw.waterstep-list-compiler x world rproofs)
+  :element (rw.waterstep-compiler x world rproofs)
+  :nil-preservingp t
+  :already-definedp t)
+
+(defthms-flag
+  :shared-hyp (force (and (tactic.worldp world)
+                          (logic.appeal-listp rproofs)))
+  :thms ((clause logic.appealp-of-rw.waterstep-compiler
+                 (implies (force (and (rw.waterstepp x)
+                                      (rw.waterstep-okp x world)
+                                      (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                               (logic.strip-conclusions rproofs))))
+                          (equal (logic.appealp (rw.waterstep-compiler x world rproofs))
+                                 t)))
+         (clause logic.conclusion-of-rw.waterstep-compiler
+                 (implies (force (and (rw.waterstepp x)
+                                      (rw.waterstep-okp x world)
+                                      (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                               (logic.strip-conclusions rproofs))))
+                          (equal (logic.conclusion (rw.waterstep-compiler x world rproofs))
+                                 (clause.clause-formula (rw.waterstep->clause x)))))
+         (t logic.appeal-listp-of-rw.waterstep-list-compiler
+            (implies (force (and (rw.waterstep-listp x)
+                                 (rw.waterstep-list-okp x world)
+                                 (subsetp (clause.clause-list-formulas (rw.waterfall-list-subgoals x))
+                                          (logic.strip-conclusions rproofs))))
+                     (equal (logic.appeal-listp (rw.waterstep-list-compiler x world rproofs))
+                            t)))
+         (t logic.strip-conclusions-of-rw.waterstep-list-compiler
+            (implies (force (and (rw.waterstep-listp x)
+                                 (rw.waterstep-list-okp x world)
+                                 (subsetp (clause.clause-list-formulas (rw.waterfall-list-subgoals x))
+                                          (logic.strip-conclusions rproofs))))
+                     (equal (logic.strip-conclusions (rw.waterstep-list-compiler x world rproofs))
+                            (clause.clause-list-formulas (rw.waterstep-list->clauses x))))))
+  :hints(("Goal"
+          :induct (rw.waterstep-induction flag x)
+          :expand ((rw.waterstep-compiler x world rproofs)
+                   (rw.waterfall-subgoals x)
+                   (rw.waterstep-okp x world)))))
+
+(defthms-flag
+  :@contextp t
+  :shared-hyp (force (and (tactic.worldp world)
+                          (logic.appeal-listp rproofs)
+                          (tactic.world-atblp world atbl)
+                          (tactic.world-env-okp world axioms thms)
+                          (equal (cdr (lookup 'if atbl)) 3)
+                          (equal (cdr (lookup 'equal atbl)) 2)
+                          (equal (cdr (lookup 'iff atbl)) 2)
+                          (equal (cdr (lookup 'not atbl)) 1)
+                          (logic.proof-listp rproofs axioms thms atbl)
+                          (@obligations rw.waterstep-compiler)))
+  :thms ((clause logic.proofp-of-rw.waterstep-compiler
+                 (implies (force (and (rw.waterstepp x)
+                                      (rw.waterstep-atblp x atbl)
+                                      (rw.waterstep-okp x world)
+                                      (subsetp (clause.clause-list-formulas (rw.waterfall-subgoals x))
+                                               (logic.strip-conclusions rproofs))))
+                          (equal (logic.proofp (rw.waterstep-compiler x world rproofs) axioms thms atbl)
+                                 t)))
+         (t logic.proof-listp-of-rw.waterstep-list-compiler
+            (implies (force (and (rw.waterstep-listp x)
+                                 (rw.waterstep-list-atblp x atbl)
+                                 (rw.waterstep-list-okp x world)
+                                 (subsetp (clause.clause-list-formulas (rw.waterfall-list-subgoals x))
+                                          (logic.strip-conclusions rproofs))))
+                     (equal (logic.proof-listp (rw.waterstep-list-compiler x world rproofs) axioms thms atbl)
+                            t))))
+  :hints(("Goal"
+          :induct (rw.waterstep-induction flag x)
+          :expand ((rw.waterstep-compiler x world rproofs)
+                   (rw.waterfall-subgoals x)
+                   (rw.waterstep-okp x world)))))
+
+(verify-guards rw.flag-waterstep-compiler
+               :hints(("Goal"
+                       :in-theory (enable rw.flag-waterstep-compiler)
+                       :expand ((rw.waterstep-okp x world)
+                                (rw.waterfall-subgoals x)
+                                (rw.stop-waterstep-okp x)))))
+
+(verify-guards rw.waterstep-compiler)
+(verify-guards rw.waterstep-list-compiler)
+
+
+; Finally, there is the remaining matter of integrating the waterfall into the
+; breadth-first tactic system.  We think of waterfall-tac as just applying to
+; every goal.
+
+
+(defund tactic.waterfall-okp (x worlds)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds))))
+  (let* ((goals    (tactic.skeleton->goals x))
+         (tacname  (tactic.skeleton->tacname x))
+         ;; The extras are (wsteps theoryname strategy maxdepth windex), which
+         ;; allows us to "recreate" the wsteps here and check they are right.
+         ;; This lets us avoid a separate atbl checker as in fertilize, etc.
+         (extras   (tactic.skeleton->extras x))
+         (history  (tactic.skeleton->history x)))
+    (and (equal tacname 'waterfall)
+         (tuplep 7 extras)
+         (let* ((oldgoals   (list-list-fix (tactic.skeleton->goals history)))
+                (wsteps     (first extras))
+                (theoryname (second extras))
+                (strategy   (third extras))
+                (maxdepth   (fourth extras))
+                (windex     (fifth extras))
+                (ufastp     (nth 5 extras))
+                (cfastp     (nth 6 extras))
+                (world      (tactic.find-world windex worlds)))
+           (and world
+                (booleanp ufastp)
+                (booleanp cfastp)
+                (rw.waterstep-listp wsteps)
+                (equal oldgoals (rw.waterstep-list->clauses wsteps))
+                (equal goals (rw.waterfall-list-subgoals wsteps))
+                (not (equal goals oldgoals))
+                (symbolp theoryname)
+                (natp maxdepth)
+                (equal wsteps
+                       (rw.waterfall-list oldgoals theoryname cfastp ufastp world strategy strategy maxdepth)))))))
+
+(defthm booleanp-of-tactic.waterfall-okp
+  (equal (booleanp (tactic.waterfall-okp x worlds))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.waterfall-okp))))
+
+
+
+(defun rw.waterfall-list-wrapper (x theoryname cfastp ufastp world steps strategy n)
+  (declare (xargs :guard (and (logic.term-list-listp x)
+                              (true-list-listp x)
+                              (cons-listp x)
+                              (symbolp theoryname)
+                              (booleanp cfastp)
+                              (booleanp ufastp)
+                              (tactic.worldp world)
+                              (natp n))))
+
+; We introduce this stupid wrapper so that we can redefine it and report some
+; timing information.
+
+  (rw.waterfall-list x theoryname cfastp ufastp world steps strategy n))
+
+(defund tactic.waterfall-tac (x strategy maxdepth theoryname cfastp ufastp world warnp)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.worldp world)
+                              (symbolp theoryname)
+                              (booleanp cfastp)
+                              (booleanp ufastp)
+                              (natp maxdepth)
+                              (booleanp warnp))))
+  (let* ((goals      (list-list-fix (tactic.skeleton->goals x)))
+         (findtheory (lookup theoryname (tactic.world->theories world)))
+         (windex     (tactic.world->index world)))
+    (cond ((not (consp goals))
+           (and warnp
+                (ACL2::cw "~s0waterfall-tac failure~s1: all clauses have already been proven.~%" *red* *black*)))
+          ((not findtheory)
+           (and warnp
+                (ACL2::cw "~s0waterfall-tac failure~s1: no theory named ~s2 is defined.~%" *red* *black* theoryname)))
+          (t
+           (let* ((wsteps    (acl2::time$
+                              (rw.waterfall-list-wrapper goals theoryname cfastp ufastp world strategy strategy maxdepth)))
+                  (new-goals (rw.waterfall-list-subgoals wsteps))
+                  (progressp (not (equal goals new-goals))))
+             (cond ((not progressp)
+                    (and warnp
+                         (ACL2::cw "~s0waterfall-tac failure~s1: no progress was made.~%" *red* *black*)))
+                   (t
+                    (ACL2::prog2$
+                     (ACL2::cw "; Applied waterfall to ~x0 clauses; ~x1 remain~%"
+                               (fast-len goals 0)
+                               (fast-len new-goals 0))
+                     (tactic.extend-skeleton new-goals
+                                             'waterfall
+                                             (list wsteps theoryname strategy maxdepth windex ufastp cfastp)
+                                             x)))))))))
+
+(defthm forcing-tactic.skeletonp-of-tactic.waterfall-tac
+  (implies (and (tactic.waterfall-tac x strategy maxdepth theoryname cfastp ufastp world warnp)
+                (force (tactic.skeletonp x))
+                (force (tactic.worldp world))
+                (force (symbolp theoryname))
+                (force (natp maxdepth)))
+           (equal (tactic.skeletonp (tactic.waterfall-tac x strategy maxdepth theoryname cfastp ufastp world warnp))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.waterfall-tac))))
+
+(defthm forcing-tactic.waterfall-okp-of-tactic.waterfall-tac
+  (implies (and (tactic.waterfall-tac x strategy maxdepth theoryname cfastp ufastp world warnp)
+                (force (tactic.skeletonp x))
+                (force (tactic.worldp world))
+                (force (tactic.world-listp worlds))
+                (force (symbolp theoryname))
+                (force (booleanp cfastp))
+                (force (booleanp ufastp))
+                (force (natp maxdepth))
+                (force (equal world (tactic.find-world (tactic.world->index world) worlds))))
+           (equal (tactic.waterfall-okp
+                   (tactic.waterfall-tac x strategy maxdepth theoryname cfastp ufastp world warnp)
+                   worlds)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.waterfall-tac
+                                    tactic.waterfall-okp
+                                    nth))))
+
+
+
+(defund tactic.waterfall-compile (x worlds proofs)
+  (declare (xargs :guard (and (tactic.skeletonp x)
+                              (tactic.world-listp worlds)
+                              (tactic.waterfall-okp x worlds)
+                              (logic.appeal-listp proofs)
+                              (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                                     (logic.strip-conclusions proofs)))
+                  :verify-guards nil))
+  (let* ((extras (tactic.skeleton->extras x))
+         (wsteps (first extras))
+         (windex (fifth extras))
+         (world  (tactic.find-world windex worlds)))
+    (rw.waterstep-list-compiler wsteps world proofs)))
+
+(defobligations tactic.waterfall-compile
+  (rw.waterstep-list-compiler))
+
+(encapsulate
+ ()
+ (local (in-theory (enable tactic.waterfall-okp
+                           tactic.waterfall-compile)))
+
+ (local (ACL2::allow-fertilize t))
+
+ (verify-guards tactic.waterfall-compile)
+
+ (defthm forcing-logic.appeal-listp-of-tactic.waterfall-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.waterfall-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.appeal-listp (tactic.waterfall-compile x worlds proofs))
+                   t)))
+
+ (defthm forcing-logic.strip-conclusions-of-tactic.waterfall-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.waterfall-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))))
+            (equal (logic.strip-conclusions (tactic.waterfall-compile x worlds proofs))
+                   (clause.clause-list-formulas (tactic.skeleton->goals (tactic.skeleton->history x))))))
+
+ (defthm@ forcing-logic.proof-listp-of-tactic.waterfall-compile
+   (implies (force (and (tactic.skeletonp x)
+                        (tactic.world-listp worlds)
+                        (tactic.waterfall-okp x worlds)
+                        (logic.appeal-listp proofs)
+                        (equal (clause.clause-list-formulas (tactic.skeleton->goals x))
+                               (logic.strip-conclusions proofs))
+                        ;; ---
+                        (tactic.skeleton-atblp x atbl)
+                        (tactic.world-list-atblp worlds atbl)
+                        (tactic.world-list-env-okp worlds axioms thms)
+                        (equal (cdr (lookup 'if atbl)) 3)
+                        (equal (cdr (lookup 'iff atbl)) 2)
+                        (equal (cdr (lookup 'equal atbl)) 2)
+                        (equal (cdr (lookup 'not atbl)) 1)
+                        (logic.proof-listp proofs axioms thms atbl)
+                        (@obligations tactic.waterfall-compile)))
+            (equal (logic.proof-listp (tactic.waterfall-compile x worlds proofs) axioms thms atbl)
+                   t))))
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/world-check.lisp acl2-6.3/books/milawa/ACL2/tactics/world-check.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/world-check.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/world-check.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,636 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "worldp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund tactic.slow-world-arities (x)
+  (declare (xargs :guard (tactic.worldp x)))
+  (let* ((res (rw.slow-theory-map-arities (tactic.world->theories x)))
+         (res (app (rw.slow-rule-list-arities (tactic.world->allrules x)) res))
+         (res (app (logic.slow-formula-list-arities (tactic.world->defs x)) res)))
+    res))
+
+(defund tactic.world-arities (x acc)
+  (declare (xargs :guard (and (tactic.worldp x)
+                              (true-listp acc))))
+  (let* ((acc (rw.theory-map-arities (tactic.world->theories x) acc))
+         (acc (rw.rule-list-arities (tactic.world->allrules x) acc)))
+    (logic.formula-list-arities (tactic.world->defs x) acc)))
+
+(defthm true-listp-of-tactic.world-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (tactic.world-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-arities))))
+
+(defthm tactic.world-arities-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.world-arities x acc)
+                  (app (tactic.slow-world-arities x) acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-arities
+                                    tactic.slow-world-arities))))
+
+(defthm tactic.slow-world-arities-correct
+  (implies (force (tactic.worldp x))
+           (equal (logic.arities-okp (tactic.slow-world-arities x) atbl)
+                  (tactic.world-atblp x atbl)))
+  :hints(("Goal"
+          :expand ((tactic.slow-world-arities x)
+                   (tactic.world-atblp x atbl))
+          :in-theory (disable rw.rule-list-atblp-of-tactic.world->allrules
+                              logic.formula-list-atblp-of-tactic.world->defs
+                              rw.theory-list-atblp-of-range-of-tactic.world->theories))))
+
+
+
+(defund tactic.slow-world-list-arities (x)
+  (declare (xargs :guard (tactic.world-listp x)))
+  (if (consp x)
+      ;; Reverse order gives us a tail call in the fast version
+      (app (tactic.slow-world-list-arities (cdr x))
+           (tactic.slow-world-arities (car x)))
+    nil))
+
+(defund tactic.world-list-arities (x acc)
+  (declare (xargs :guard (and (tactic.world-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (tactic.world-list-arities (cdr x)
+                                 (tactic.world-arities (car x) acc))
+    acc))
+
+(defthm true-listp-of-tactic.world-list-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (tactic.world-list-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-list-arities))))
+
+(defthm tactic.world-list-arities-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.world-list-arities x acc)
+                  (app (tactic.slow-world-list-arities x) acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-list-arities
+                                    tactic.slow-world-list-arities))))
+
+(defthm tactic.slow-world-list-arities-correct
+  (implies (force (tactic.world-listp x))
+           (equal (logic.arities-okp (tactic.slow-world-list-arities x) atbl)
+                  (tactic.world-list-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand ((tactic.world-list-atblp x atbl)
+                   (tactic.slow-world-list-arities x)))))
+
+
+
+;; One final twist is that if we are checking a list of worlds, it is most
+;; common for the allrules and defs to be the same throughout all of the
+;; worlds.  Rather than repeatedly collect from them, we see this situation and
+;; avoid the redundant gathering.
+
+(defund tactic.slow-world-partial-arities (x)
+  (declare (xargs :guard (tactic.worldp x)))
+  (rw.slow-theory-map-arities (tactic.world->theories x)))
+
+(defund tactic.world-partial-arities (x acc)
+  (declare (xargs :guard (and (tactic.worldp x)
+                              (true-listp acc))))
+  (rw.theory-map-arities (tactic.world->theories x) acc))
+
+(defthm true-listp-of-tactic.world-partial-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (tactic.world-partial-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-partial-arities))))
+
+(defthm tactic.world-partial-arities-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.world-partial-arities x acc)
+                  (app (tactic.slow-world-partial-arities x) acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-partial-arities
+                                    tactic.slow-world-partial-arities))))
+
+(defthm tactic.slow-world-partial-arities-correct
+  (implies (force (and (tactic.worldp x)
+                       (rw.rule-list-atblp (tactic.world->allrules x) atbl)
+                       (logic.formula-list-atblp (tactic.world->defs x) atbl)))
+           (equal (logic.arities-okp (tactic.slow-world-partial-arities x) atbl)
+                  (tactic.world-atblp x atbl)))
+  :hints(("Goal"
+          :expand ((tactic.slow-world-partial-arities x)
+                   (tactic.world-atblp x atbl))
+          :in-theory (disable rw.rule-list-atblp-of-tactic.world->allrules
+                              logic.formula-list-atblp-of-tactic.world->defs
+                              rw.theory-list-atblp-of-range-of-tactic.world->theories))))
+
+
+
+(defund tactic.slow-world-list-partial-arities (x)
+  (declare (xargs :guard (tactic.world-listp x)))
+  (if (consp x)
+      ;; Reverse order gives us a tail call in the fast version
+      (app (tactic.slow-world-list-partial-arities (cdr x))
+           (tactic.slow-world-partial-arities (car x)))
+    nil))
+
+(defund tactic.world-list-partial-arities (x acc)
+  (declare (xargs :guard (and (tactic.world-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (tactic.world-list-partial-arities (cdr x)
+                                 (tactic.world-partial-arities (car x) acc))
+    acc))
+
+(defthm true-listp-of-tactic.world-list-partial-arities
+  (implies (force (true-listp acc))
+           (equal (true-listp (tactic.world-list-partial-arities x acc))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-list-partial-arities))))
+
+(defthm tactic.world-list-partial-arities-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.world-list-partial-arities x acc)
+                  (app (tactic.slow-world-list-partial-arities x) acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-list-partial-arities
+                                    tactic.slow-world-list-partial-arities))))
+
+
+
+(defund tactic.world-list-compatiblep-hack (x)
+  (declare (xargs :guard (tactic.world-listp x)))
+  (if (consp x)
+      (if (consp (cdr x))
+          (and (equal (tactic.world->allrules (first x))
+                      (tactic.world->allrules (second x)))
+               (equal (tactic.world->defs (first x))
+                      (tactic.world->defs (second x)))
+               (tactic.world-list-compatiblep-hack (cdr x)))
+        t)
+    t))
+
+(defthm tactic.slow-world-list-partial-arities-correct
+  (implies (force (and (tactic.world-listp x)
+                       (tactic.world-list-compatiblep-hack x)
+                       (consp x)
+                       (rw.rule-list-atblp (tactic.world->allrules (car x)) atbl)
+                       (logic.formula-list-atblp (tactic.world->defs (car x)) atbl)))
+           (equal (logic.arities-okp (tactic.slow-world-list-partial-arities x) atbl)
+                  (tactic.world-list-atblp x atbl)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (e/d (tactic.world-list-compatiblep-hack
+                           tactic.slow-world-list-partial-arities)
+                          (LOGIC.FORMULA-LIST-ATBLP-OF-TACTIC.WORLD->DEFS
+                           RW.RULE-LIST-ATBLP-OF-TACTIC.WORLD->ALLRULES)))))
+
+
+;; All of this culminates in tactic.fast-world-list-atblp, which is pretty damn
+;; wonderful.
+
+(defund tactic.fast-world-list-atblp (x atbl)
+  (declare (xargs :guard (and (tactic.world-listp x)
+                              (logic.arity-tablep atbl))))
+  (if (and (consp x)
+           (tactic.world-list-compatiblep-hack x))
+      (let* ((acc (rw.rule-list-arities (tactic.world->allrules (car x)) nil))
+             (acc (logic.formula-list-arities (tactic.world->defs (car x)) acc))
+             (acc (tactic.world-list-partial-arities x acc)))
+        (logic.fast-arities-okp acc atbl))
+    (ACL2::prog2$
+     (ACL2::cw "Performance note: fast-world-atblp cannot use compatibility hack.~%")
+     (logic.fast-arities-okp (tactic.world-list-arities x nil) atbl))))
+
+(defthm tactic.fast-world-list-atblp-is-tactic.world-list-atblp
+  (implies (force (and (tactic.world-listp x)
+                       (mapp atbl)))
+           (equal (tactic.fast-world-list-atblp x atbl)
+                  (tactic.world-list-atblp x atbl)))
+  :hints(("Goal"
+          :in-theory (e/d (tactic.fast-world-list-atblp)
+                          ((:executable-counterpart acl2::force))))))
+
+
+;; Here are some performance comparisons, using level9/symmetry.
+
+;; (defun tactic.world-list-atblp-wrapper (x atbl)   ;; to avoid guards
+;;   (declare (xargs :mode :program))
+;;   (tactic.world-list-atblp x atbl))
+
+;; (defun tactic.fast-world-list-atblp-wrapper (x atbl)   ;; to avoid guards
+;;   (declare (xargs :mode :program))
+;;   (tactic.fast-world-list-atblp x atbl))
+
+;; (acl2::time$
+;;  ;; 7.3 seconds, 28 KB allocated
+;;  (tactic.world-list-atblp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 1)
+;;                                   (tactic.harness->atbl (acl2::w acl2::state))))
+
+;; (acl2::time$
+;;  ;; 20.7 seconds, 86 KB allocated
+;;  (tactic.world-list-atblp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 3)
+;;                                   (tactic.harness->atbl (acl2::w acl2::state))))
+
+;; (acl2::time$
+;;  ;; .36 seconds, 62 MB allocated
+;;  (tactic.fast-world-list-atblp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 1)
+;;                                        (tactic.harness->atbl (acl2::w acl2::state))))
+
+;; (acl2::time$
+;;  ;; .6 seconds, 105 MB allocated
+;;  (tactic.fast-world-list-atblp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 3)
+;;                                        (tactic.harness->atbl (acl2::w acl2::state))))
+
+;; (acl2::time$
+;;  ;; .74 seconds, 127 MB allocated
+;;  (tactic.fast-world-list-atblp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 4)
+;;                                        (tactic.harness->atbl (acl2::w acl2::state))))
+
+;; (acl2::time$
+;;  ;; 2.1 seconds, 376 MB allocated
+;;  (tactic.fast-world-list-atblp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 15)
+;;                                        (tactic.harness->atbl (acl2::w acl2::state))))
+
+
+
+
+
+
+
+;; We now turn our attention to developing fast checks for the env-okp
+;; functions.  Our approach is pretty much the same as for the arity table,
+;; except it's a little easier because we don't need to develop any analogue of
+;; logic.arities-okp or anything; it's just a matter of harvesting lists of
+;; formulas and putting them into lists, which we'll then mergesort and do an
+;; ordered comparison against to make sure they're all axioms and/or theorems.
+
+;; We start with the rewrite rules.  We need to show that every rule in the
+;; list of allrules and that all of the rules throughout our theories are
+;; members of *thms*.  As with our atbl checks, we just accumulate the theorems
+;; for all the rules.
+
+
+;; We found it useful to break up tactic.world-env-okp into two functions,
+;; one to check the axioms and one to check the theorems.
+
+(defund tactic.world-thms-okp (x thms)
+  (declare (xargs :guard (and (tactic.worldp x)
+                              (logic.formula-listp thms))))
+  (and (rw.theory-list-env-okp-of-range (tactic.world->theories x) thms)
+       (rw.rule-list-env-okp (tactic.world->allrules x) thms)))
+
+(defund tactic.world-axioms-okp (x axioms)
+  (declare (xargs :guard (and (tactic.worldp x)
+                              (logic.formula-listp axioms))))
+  (subsetp (tactic.world->defs x) axioms))
+
+(defthm booleanp-of-tactic.world-thms-okp
+  (equal (booleanp (tactic.world-thms-okp x thms))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.world-thms-okp))))
+
+(defthm booleanp-of-tactic.world-axioms-okp
+  (equal (booleanp (tactic.world-axioms-okp x thms))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.world-axioms-okp))))
+
+(deflist tactic.world-list-thms-okp (x thms)
+  (tactic.world-thms-okp x thms)
+  :guard (and (tactic.world-listp x)
+              (logic.formula-listp thms)))
+
+(deflist tactic.world-list-axioms-okp (x axioms)
+  (tactic.world-axioms-okp x axioms)
+  :guard (and (tactic.world-listp x)
+              (logic.formula-listp axioms)))
+
+(defthmd tactic.world-env-okp-redefinition
+  (equal (tactic.world-env-okp x axioms thms)
+         (and (tactic.world-thms-okp x thms)
+              (tactic.world-axioms-okp x axioms)))
+  :hints(("Goal" :in-theory (enable tactic.world-env-okp
+                                    tactic.world-thms-okp
+                                    tactic.world-axioms-okp))))
+
+(defthmd tactic.world-list-env-okp-redefinition
+  (equal (tactic.world-list-env-okp x axioms thms)
+         (and (tactic.world-list-thms-okp x thms)
+              (tactic.world-list-axioms-okp x axioms)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable tactic.world-env-okp-redefinition))))
+
+
+
+
+(defund tactic.slow-world-thms (x)
+  (declare (xargs :guard (tactic.worldp x)))
+  (app (rw.slow-theory-map-thms (tactic.world->theories x))
+       (rw.slow-rule-list-thms (tactic.world->allrules x))))
+
+(defund tactic.world-thms (x acc)
+  (declare (xargs :guard (and (tactic.worldp x)
+                              (true-listp acc))))
+  (let ((acc (rw.rule-list-thms (tactic.world->allrules x) acc)))
+    (rw.theory-map-thms (tactic.world->theories x) acc)))
+
+(defthm true-listp-of-tactic.world-thms
+  (implies (force (true-listp acc))
+           (true-listp (tactic.world-thms x acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-thms))))
+
+(defthm tactic.world-thms-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.world-thms x acc)
+                  (app (tactic.slow-world-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-thms
+                                    tactic.slow-world-thms))))
+
+(defthm tactic.slow-world-thms-correct
+  (equal (subsetp (tactic.slow-world-thms x) thms)
+         (tactic.world-thms-okp x thms))
+  :hints(("Goal"
+          :in-theory (e/d (tactic.slow-world-thms
+                           tactic.world-thms-okp)))))
+
+
+
+(defund tactic.slow-world-list-thms (x)
+  (declare (xargs :guard (tactic.world-listp x)))
+  (if (consp x)
+      (app (tactic.slow-world-list-thms (cdr x))
+           (tactic.slow-world-thms (car x)))
+    nil))
+
+(defund tactic.world-list-thms (x acc)
+  (declare (xargs :guard (and (tactic.world-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (tactic.world-list-thms (cdr x)
+                              (tactic.world-thms (car x) acc))
+    acc))
+
+(defthm true-listp-of-tactic.world-list-thms
+  (implies (force (true-listp acc))
+           (true-listp (tactic.world-list-thms x acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-list-thms))))
+
+(defthm tactic.world-list-thms-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.world-list-thms x acc)
+                  (app (tactic.slow-world-list-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-list-thms
+                                    tactic.slow-world-list-thms))))
+
+(defthm tactic.slow-world-list-thms-correct
+  (equal (subsetp (tactic.slow-world-list-thms x) thms)
+         (tactic.world-list-thms-okp x thms))
+  :hints(("Goal"
+          :in-theory (e/d (tactic.slow-world-list-thms
+                           tactic.world-list-thms-okp)))))
+
+
+
+(defund tactic.slow-world-partial-thms (x)
+  (declare (xargs :guard (tactic.worldp x)))
+  (rw.slow-theory-map-thms (tactic.world->theories x)))
+
+(defund tactic.world-partial-thms (x acc)
+  (declare (xargs :guard (and (tactic.worldp x)
+                              (true-listp acc))))
+  (rw.theory-map-thms (tactic.world->theories x) acc))
+
+(defthm true-listp-of-tactic.world-partial-thms
+  (implies (force (true-listp acc))
+           (true-listp (tactic.world-partial-thms x acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-partial-thms))))
+
+(defthm tactic.world-partial-thms-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.world-partial-thms x acc)
+                  (app (tactic.slow-world-partial-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-partial-thms
+                                    tactic.slow-world-partial-thms))))
+
+(defthm tactic.slow-world-partial-thms-correct
+  (implies (subsetp (tactic.slow-world-partial-thms x) thms)
+           (equal (tactic.world-thms-okp x thms)
+                  (rw.rule-list-env-okp (tactic.world->allrules x) thms)))
+  :hints(("Goal"
+          :in-theory (e/d (tactic.slow-world-partial-thms
+                           tactic.world-thms-okp)))))
+
+
+
+
+(defund tactic.slow-world-list-partial-thms (x)
+  (declare (xargs :guard (tactic.world-listp x)))
+  (if (consp x)
+      (app (tactic.slow-world-list-partial-thms (cdr x))
+           (tactic.slow-world-partial-thms (car x)))
+    nil))
+
+(defund tactic.world-list-partial-thms (x acc)
+  (declare (xargs :guard (and (tactic.world-listp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (tactic.world-list-partial-thms (cdr x)
+                                      (tactic.world-partial-thms (car x) acc))
+    acc))
+
+(defthm true-listp-of-tactic.world-list-partial-thms
+  (implies (force (true-listp acc))
+           (true-listp (tactic.world-list-partial-thms x acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-list-partial-thms))))
+
+(defthm tactic.world-list-partial-thms-removal
+  (implies (force (true-listp acc))
+           (equal (tactic.world-list-partial-thms x acc)
+                  (app (tactic.slow-world-list-partial-thms x)
+                       acc)))
+  :hints(("Goal" :in-theory (enable tactic.world-list-partial-thms
+                                    tactic.slow-world-list-partial-thms))))
+
+(defthm tactic.slow-world-list-partial-thms-correct
+  (implies (and (subsetp (tactic.slow-world-list-partial-thms x) thms)
+                (force (tactic.world-list-compatiblep-hack x))
+                (force (consp x)))
+           (equal (tactic.world-list-thms-okp x thms)
+                  (rw.rule-list-env-okp (tactic.world->allrules (car x)) thms)))
+  :hints(("Goal"
+          :in-theory (e/d (tactic.world-list-compatiblep-hack
+                           tactic.slow-world-list-partial-thms
+                           tactic.world-list-thms-okp)))))
+
+
+
+
+
+(defund tactic.world-list-defs (x)
+  (declare (xargs :guard (tactic.world-listp x)))
+  (if (consp x)
+      (revappend (tactic.world->defs (car x))
+                 (tactic.world-list-defs (cdr x)))
+    nil))
+
+(defthm true-listp-of-tactic.world-list-defs
+  (true-listp (tactic.world-list-defs x))
+  :hints(("Goal" :in-theory (enable tactic.world-list-defs))))
+
+(defthm tactic.world-list-defs-correct
+  (equal (subsetp (tactic.world-list-defs x) axioms)
+         (tactic.world-list-axioms-okp x axioms))
+  :hints(("Goal"
+          :in-theory (enable tactic.world-list-defs
+                             tactic.world-list-axioms-okp
+                             tactic.world-axioms-okp))))
+
+(defthm tactic.world-list-partial-defs-correct
+  (implies (and (tactic.world-list-compatiblep-hack x)
+                (consp x))
+           (equal (subsetp (tactic.world->defs (car x)) axioms)
+                  (tactic.world-list-axioms-okp x axioms)))
+  :hints(("Goal" :in-theory (enable tactic.world-axioms-okp
+                                    tactic.world-list-axioms-okp
+                                    tactic.world-list-compatiblep-hack))))
+
+
+
+(defund tactic.fast-world-list-env-okp (x axioms thms)
+  (declare (xargs :guard (and (tactic.world-listp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms))))
+  (if (and (consp x)
+           (tactic.world-list-compatiblep-hack x))
+      (let* ((my-thms (tactic.world-list-partial-thms x nil))
+             (my-thms (rw.rule-list-thms (tactic.world->allrules (car x)) my-thms))
+             (my-defs (tactic.world->defs (car x))))
+        (and (ordered-list-subsetp (mergesort my-thms) (mergesort thms))
+             (ordered-list-subsetp (mergesort my-defs) (mergesort axioms))))
+    (ACL2::prog2$
+     (ACL2::cw "Performance note: fast-world-list-env-okp can't use compatibility hack.~%")
+     (let* ((my-thms (tactic.world-list-thms x nil))
+            (my-defs (tactic.world-list-defs x)))
+       (and (ordered-list-subsetp (mergesort my-thms) (mergesort thms))
+            (ordered-list-subsetp (mergesort my-defs) (mergesort axioms)))))))
+
+(defthmd lemma-1-for-tactic.fast-world-list-env-okp-lemma
+  (implies (TACTIC.WORLD-LIST-THMS-OKP X THMS)
+           (SUBSETP (TACTIC.SLOW-WORLD-LIST-PARTIAL-THMS X) THMS))
+  :hints(("Goal"
+          :in-theory (enable tactic.world-list-thms-okp
+                             tactic.world-thms-okp
+                             TACTIC.SLOW-WORLD-LIST-PARTIAL-THMS
+                             tactic.slow-world-partial-thms))))
+
+(defthmd lemma-2-for-tactic.fast-world-list-env-okp-lemma
+  (implies (tactic.world-list-thms-okp x thms)
+           (rw.rule-list-env-okp (tactic.world->allrules (first x)) thms))
+  :hints(("Goal"
+          :in-theory (enable tactic.world-list-thms-okp
+                             tactic.world-thms-okp))))
+
+(defthmd tactic.fast-world-list-env-okp-lemma
+  (equal (tactic.fast-world-list-env-okp x axioms thms)
+         (and (tactic.world-list-axioms-okp x axioms)
+              (tactic.world-list-thms-okp x thms)))
+  :hints(("Goal"
+          :in-theory (e/d (tactic.fast-world-list-env-okp
+                           lemma-1-for-tactic.fast-world-list-env-okp-lemma
+                           lemma-2-for-tactic.fast-world-list-env-okp-lemma
+                           )))))
+
+(defthm tactic.fast-world-list-env-okp-correct
+  (equal (tactic.fast-world-list-env-okp x axioms thms)
+         (tactic.world-list-env-okp x axioms thms))
+  :hints(("Goal" :in-theory (enable tactic.fast-world-list-env-okp-lemma
+                                    tactic.world-list-env-okp-redefinition))))
+
+
+
+
+;; Here are some performance comparisons, using level9/symmetry.
+;;
+;; (defun tactic.world-list-env-okp-wrapper (x axioms thms)   ;; to avoid guards
+;;   (declare (xargs :mode :program))
+;;   (tactic.world-list-env-okp x axioms thms))
+;;
+;; (defun tactic.fast-world-list-env-okp-wrapper (x axioms thms)   ;; to avoid guards
+;;   (declare (xargs :mode :program))
+;;   (tactic.fast-world-list-env-okp x axioms thms))
+;;
+;; (acl2::time$
+;;  ;; 41.3 seconds, 10 MB
+;;  (tactic.world-list-env-okp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 1)
+;;                                     (tactic.harness->axioms (acl2::w acl2::state))
+;;                                     (tactic.harness->thms (acl2::w acl2::state))))
+;;
+;; (acl2::time$
+;;  ;; 124 seconds, 30 MB
+;;  (tactic.world-list-env-okp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 3)
+;;                                     (tactic.harness->axioms (acl2::w acl2::state))
+;;                                     (tactic.harness->thms (acl2::w acl2::state))))
+;;
+;; (acl2::time$
+;;  ;; .41 seconds, 20 MB
+;;  (tactic.fast-world-list-env-okp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 1)
+;;                                          (tactic.harness->axioms (acl2::w acl2::state))
+;;                                          (tactic.harness->thms (acl2::w acl2::state))))
+;;
+;; (acl2::time$
+;;  ;; .68 seconds, 36 MB
+;;  (tactic.fast-world-list-env-okp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 3)
+;;                                          (tactic.harness->axioms (acl2::w acl2::state))
+;;                                          (tactic.harness->thms (acl2::w acl2::state))))
+;;
+;; (acl2::time$
+;;  ;; .81 seconds, 44 MB
+;;  (tactic.fast-world-list-env-okp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 4)
+;;                                          (tactic.harness->axioms (acl2::w acl2::state))
+;;                                          (tactic.harness->thms (acl2::w acl2::state))))
+;;
+;; (acl2::time$
+;;  ;; 2.2 seconds, 133 MB
+;;  (tactic.fast-world-list-env-okp-wrapper (repeat (tactic.harness->world (acl2::w acl2::state)) 15)
+;;                                          (tactic.harness->axioms (acl2::w acl2::state))
+;;                                          (tactic.harness->thms (acl2::w acl2::state))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/tactics/worldp.lisp acl2-6.3/books/milawa/ACL2/tactics/worldp.lisp
--- acl2-6.2/books/milawa/ACL2/tactics/worldp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/tactics/worldp.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -0,0 +1,345 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm rw.theory-env-okp-of-lookup-when-rw.theory-list-env-okp-of-range
+  ;; BOZO find me a home
+  (implies (rw.theory-list-env-okp (range theories) thms)
+           (rw.theory-env-okp (cdr (lookup name theories)) thms))
+  :hints(("Goal" :induct (cdr-induction theories))))
+
+(defaggregate tactic.world
+  (index
+   forcingp
+   betamode
+   liftlimit
+   splitlimit
+   blimit
+   rlimit
+   rwn
+   urwn
+   noexec
+   theories
+   defs
+   depth
+   allrules
+   assm-primaryp
+   assm-secondaryp
+   assm-directp
+   assm-negativep
+   )
+  :require
+  ((natp-of-tactic.world->index                         (natp index))
+   (booleanp-of-tactic.world->forcingp                  (booleanp forcingp))
+   (symbolp-of-tactic.world->betamode                   (symbolp betamode))
+   (natp-of-tactic.world->liftlimit                     (natp liftlimit))
+   (natp-of-tactic.world->splitlimit                    (natp splitlimit))
+   (natp-of-tactic.world->blimit                        (natp blimit))
+   (natp-of-tactic.world->rlimit                        (natp rlimit))
+   (natp-of-tactic.world->rwn                           (natp rwn))
+   (natp-of-tactic.world->urwn                          (natp urwn))
+   (definition-listp-of-tactic.world->defs              (definition-listp defs))
+   (natp-of-tactic.world->depth                         (natp depth))
+   (rw.theory-mapp-of-tactic.world->theories            (rw.theory-mapp theories))
+   (logic.function-symbol-listp-of-tactic.world->noexec (logic.function-symbol-listp noexec))
+   (rw.rule-listp-of-tactic.world->allrules             (rw.rule-listp allrules))
+   (booleanp-of-tactic.world->assm-primaryp             (booleanp assm-primaryp))
+   (booleanp-of-tactic.world->assm-secondaryp           (booleanp assm-secondaryp))
+   (booleanp-of-tactic.world->assm-directp              (booleanp assm-directp))
+   (booleanp-of-tactic.world->assm-negativep            (booleanp assm-negativep))
+   ))
+
+(deflist tactic.world-listp (x)
+  (tactic.worldp x)
+  :elementp-of-nil nil)
+
+
+
+(defund tactic.world-atblp (x atbl)
+  (declare (xargs :guard (and (tactic.worldp x)
+                              (logic.arity-tablep atbl))))
+  (and (rw.theory-list-atblp-of-range (tactic.world->theories x) atbl)
+       (rw.rule-list-atblp (tactic.world->allrules x) atbl)
+       (logic.formula-list-atblp (tactic.world->defs x) atbl)))
+
+(defthm booleanp-of-tactic.world-atblp
+  (equal (booleanp (tactic.world-atblp x atbl))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.world-atblp))))
+
+(defthm tactic.world-atblp-of-nil
+  (equal (tactic.world-atblp nil atbl)
+         t)
+  :hints(("Goal" :in-theory (enable tactic.world-atblp))))
+
+(defthmd lemma-for-rw.theory-atblp-of-looked-up-theory
+  (implies (rw.theory-list-atblp (range theories) atbl)
+           (equal (rw.theory-atblp (cdr (lookup theory theories)) atbl)
+                  t))
+  :hints(("Goal" :induct (cdr-induction theories))))
+
+(defthm rw.theory-atblp-of-looked-up-theory
+  (implies (force (tactic.world-atblp x atbl))
+           (equal (rw.theory-atblp (cdr (lookup theory (tactic.world->theories x))) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-atblp
+                                    lemma-for-rw.theory-atblp-of-looked-up-theory))))
+
+(defthm tactic.world-atblp-of-tactic.world
+  (implies (and (force (rw.theory-list-atblp (range theories) atbl))
+                (force (logic.formula-list-atblp defs atbl))
+                (force (rw.rule-list-atblp allrules atbl)))
+           (equal (tactic.world-atblp (tactic.world index forcingp betamode liftlimit splitlimit blimit
+                                                    rlimit rwn urwn noexec theories defs depth allrules
+                                                    assm-primaryp assm-secondaryp assm-directp
+                                                    assm-negativep)
+                                      atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-atblp))))
+
+(defthm rw.theory-list-atblp-of-range-of-tactic.world->theories
+  (implies (force (tactic.world-atblp world atbl))
+           (equal (rw.theory-list-atblp (range (tactic.world->theories world)) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-atblp))))
+
+(defthm logic.formula-list-atblp-of-tactic.world->defs
+  (implies (force (tactic.world-atblp x atbl))
+           (equal (logic.formula-list-atblp (tactic.world->defs x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-atblp))))
+
+(defthm rw.rule-list-atblp-of-tactic.world->allrules
+  (implies (force (tactic.world-atblp x atbl))
+           (equal (rw.rule-list-atblp (tactic.world->allrules x) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-atblp))))
+
+
+
+
+(deflist tactic.world-list-atblp (x atbl)
+  (tactic.world-atblp x atbl)
+  :guard (and (tactic.world-listp x)
+              (logic.arity-tablep atbl))
+  :elementp-of-nil t)
+
+
+
+(defund tactic.world-env-okp (x axioms thms)
+  (declare (xargs :guard (and (tactic.worldp x)
+                              (logic.formula-listp axioms)
+                              (logic.formula-listp thms))))
+  (and (rw.theory-list-env-okp-of-range (tactic.world->theories x) thms)
+       (rw.rule-list-env-okp (tactic.world->allrules x) thms)
+       (subsetp (tactic.world->defs x) axioms)))
+
+(defthm booleanp-of-tactic.world-env-okp
+  (equal (booleanp (tactic.world-env-okp x axioms thms))
+         t)
+  :hints(("Goal" :in-theory (enable tactic.world-env-okp))))
+
+(defthm tactic.world-env-okp-of-nil
+  (equal (tactic.world-env-okp nil axioms thms)
+         t)
+  :hints(("Goal" :in-theory (enable tactic.world-env-okp))))
+
+(defthmd lemma-for-rw.theory-env-okp-of-looked-up-theory
+  (implies (rw.theory-list-env-okp (range theories) thms)
+           (equal (rw.theory-env-okp (cdr (lookup theory theories)) thms)
+                  t))
+  :hints(("Goal" :induct (cdr-induction theories))))
+
+(defthm rw.theory-env-okp-of-looked-up-theory
+  (implies (force (tactic.world-env-okp x axioms thms))
+           (equal (rw.theory-env-okp (cdr (lookup theory (tactic.world->theories x))) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-env-okp
+                                    lemma-for-rw.theory-env-okp-of-looked-up-theory))))
+
+(defthm tactic.world-env-okp-of-tactic.world
+  (implies (and (force (rw.theory-list-env-okp (range theories) thms))
+                (force (rw.rule-list-env-okp allrules thms))
+                (force (subsetp defs axioms)))
+           (equal (tactic.world-env-okp (tactic.world index forcingp betamode liftlimit splitlimit blimit
+                                                      rlimit rwn urwn noexec theories defs depth allrules
+                                                      assm-primaryp assm-secondaryp assm-directp
+                                                      assm-negativep)
+                                        axioms
+                                        thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-env-okp))))
+
+(defthm rw.theory-list-env-okp-of-range-of-tactic.world->theories
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (rw.theory-list-env-okp (range (tactic.world->theories world)) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-env-okp))))
+
+(defthm subsetp-of-tactic.world->defs-and-axioms
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (subsetp (tactic.world->defs world) axioms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-env-okp))))
+
+(defthm rw.rule-list-env-okp-of-tactic.world->allrules
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (rw.rule-list-env-okp (tactic.world->allrules world) thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.world-env-okp))))
+
+(deflist tactic.world-list-env-okp (x axioms thms)
+  (tactic.world-env-okp x axioms thms)
+  :guard (and (tactic.world-listp x)
+              (logic.formula-listp axioms)
+              (logic.formula-listp thms))
+  :elementp-of-nil t)
+
+
+
+(defthm subsetp-of-tactic.world->defs-when-memberp
+  (implies (and (memberp world worlds)
+                (tactic.world-list-env-okp worlds axioms thms))
+           (equal (subsetp (tactic.world->defs world) axioms)
+                  t))
+  :hints(("Goal" :induct (cdr-induction worlds))))
+
+(defthm subsetp-of-tactic.world->defs-when-memberp-alt
+  (implies (and (tactic.world-list-env-okp worlds axioms thms)
+                (memberp world worlds))
+           (equal (subsetp (tactic.world->defs world) axioms)
+                  t)))
+
+(defthm rw.theory-env-okp-when-memberp
+  (implies (and (memberp world worlds)
+                (tactic.world-list-env-okp worlds axioms thms))
+           (equal (rw.theory-list-env-okp (range (tactic.world->theories world)) thms)
+                  t))
+  :hints(("Goal" :induct (cdr-induction worlds))))
+
+(defthm rw.theory-env-okp-when-memberp-alt
+  (implies (and (tactic.world-list-env-okp worlds axioms thms)
+                (memberp world worlds))
+           (equal (rw.theory-list-env-okp (range (tactic.world->theories world)) thms)
+                  t))
+  :hints(("Goal" :induct (cdr-induction worlds))))
+
+
+
+(defund tactic.find-world (index worlds)
+  (declare (xargs :guard (tactic.world-listp worlds)))
+  (if (consp worlds)
+      (if (equal (tactic.world->index (car worlds)) index)
+          (car worlds)
+        (tactic.find-world index (cdr worlds)))
+    nil))
+
+(defthm tactic.worldp-of-tactic.find-world-under-iff
+  (implies (force (tactic.world-listp worlds))
+           (iff (tactic.worldp (tactic.find-world index worlds))
+                (tactic.find-world index worlds)))
+  :hints(("Goal" :in-theory (enable tactic.find-world))))
+
+(defthm tactic.world-atblp-of-tactic.find-world-under-iff
+  (implies (force (tactic.world-list-atblp worlds atbl))
+           (equal (tactic.world-atblp (tactic.find-world index worlds) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.find-world))))
+
+(defthm tactic.world-env-okp-of-tactic.find-world-under-iff
+  (implies (force (tactic.world-list-env-okp worlds axioms thms))
+           (equal (tactic.world-env-okp (tactic.find-world index worlds) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.find-world))))
+
+(defthm tactic.world->index-of-tactic.find-world
+  (equal (tactic.world->index (tactic.find-world index worlds))
+         (if (tactic.find-world index worlds)
+             index
+           nil))
+  :hints(("Goal" :in-theory (enable tactic.find-world))))
+
+(defthm subsetp-of-tactic.world->defs-of-tactic.find-world-and-axioms
+  (implies (force (tactic.world-list-env-okp worlds axioms thms))
+           (equal (subsetp (tactic.world->defs (tactic.find-world index worlds)) axioms)
+                  t))
+  :hints(("Goal"
+          :in-theory (disable subsetp-of-tactic.world->defs-and-axioms)
+          :use ((:instance subsetp-of-tactic.world->defs-and-axioms
+                           (world (tactic.find-world index worlds)))))))
+
+(defthm rw.theory-list-env-okp-of-range-of-tactic.world->theories-of-find-world
+  (implies (force (tactic.world-list-env-okp worlds axioms thms))
+           (equal (rw.theory-list-env-okp (range (tactic.world->theories (tactic.find-world world worlds)))
+                                          thms)
+                  t))
+  :hints(("Goal"
+          :in-theory (disable rw.theory-list-env-okp-of-range-of-tactic.world->theories)
+          :use ((:instance rw.theory-list-env-okp-of-range-of-tactic.world->theories
+                           (world (tactic.find-world world worlds)))))))
+
+
+(defund tactic.increment-world-index (world)
+  (declare (xargs :guard (tactic.worldp world)))
+  (change-tactic.world world
+                       :index (+ 1 (tactic.world->index world))))
+
+(defthm tactic.worldp-of-tactic.increment-world-index
+  (implies (force (tactic.worldp world))
+           (equal (tactic.worldp (tactic.increment-world-index world))
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.increment-world-index))))
+
+(defthm tactic.world-atblp-of-tactic.increment-world-index
+  (implies (force (tactic.world-atblp world atbl))
+           (equal (tactic.world-atblp (tactic.increment-world-index world) atbl)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.increment-world-index))))
+
+(defthm tactic.world-env-okp-of-tactic.increment-world-index
+  (implies (force (tactic.world-env-okp world axioms thms))
+           (equal (tactic.world-env-okp (tactic.increment-world-index world) axioms thms)
+                  t))
+  :hints(("Goal" :in-theory (enable tactic.increment-world-index))))
+
+(defthm tactic.world->index-of-tactic.increment-world-index
+  (equal (tactic.world->index (tactic.increment-world-index world))
+         (+ 1 (tactic.world->index world)))
+  :hints(("Goal" :in-theory (enable tactic.increment-world-index))))
diff -Nru acl2-6.2/books/milawa/ACL2/ubdds/core.lisp acl2-6.3/books/milawa/ACL2/ubdds/core.lisp
--- acl2-6.2/books/milawa/ACL2/ubdds/core.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/ubdds/core.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,646 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Milawa implementation of UBDDs
+;;
+;; This file is derived from the ACL2 UBDD library that was originally
+;; developed by Warren Hunt and Bob Boyer, and later extended by Jared Davis
+;; and Sol Swords.  See books/centaur/ubdds/ in an ACL2 distribution.
+
+(in-package "MILAWA")
+(include-book "../utilities/deflist")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(definline hons (x y)
+  ;; BOZO move to primitives
+  (mbe :logic (cons x y)
+       :exec (acl2::hons x y)))
+
+(definline hons-equal (x y)
+  ;; BOZO move to primitives
+  (mbe :logic (equal x y)
+       :exec (acl2::hons-equal x y)))
+
+(definline atom (x)
+  ;; BOZO move to primitives?
+  (not (consp x)))
+
+
+(defsection ubddp
+
+  ;; This is similar to the :exec version of acl2::ubddp, but we take advantage
+  ;; of CAR/CDR's safer Milawa definitions
+
+  (defund ubddp (x)
+    (declare (xargs :guard t))
+    (cond ((equal x t) t)
+          ((equal x nil) t)
+          (t (let ((a (car x))
+                   (d (cdr x)))
+               (cond ((equal a t)
+                      (cond ((equal d nil) t)
+                            ((equal d t) nil)
+                            (t (ubddp d))))
+                     ((equal a nil)
+                      (cond ((equal d nil) nil)
+                            ((equal d t) t)
+                            (t (ubddp d))))
+                     (t (and (ubddp a) (ubddp d))))))))
+
+  (defthm ubddp-when-not-consp
+    (implies (not (consp x))
+             (equal (ubddp x)
+                    (or (equal x t)
+                        (equal x nil))))
+    :hints(("Goal" :expand (ubddp x))))
+
+  (defthm booleanp-of-ubddp
+    (booleanp (ubddp x))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubddp))
+            :expand (ubddp x))))
+
+  (defthm ubddp-of-cons
+    (equal (ubddp (cons a b))
+           (and (ubddp a)
+                (ubddp b)
+                (or (consp a)
+                    (not (equal a b)))))
+    :hints(("Goal" :expand ((ubddp (cons a b)))))))
+
+
+(deflist ubdd-listp (x)
+  (ubddp x)
+  :guard t)
+
+
+(defsection ubdd.eval
+
+  ;; This follows ACL2::eval-bdd, but is slightly simpler because we don't need
+  ;; a special case for (atom values) with Milawa's safer car/cdr behavior.
+
+  (defund ubdd.eval (x values)
+    (declare (xargs :guard t))
+    (if (consp x)
+        (ubdd.eval (if (car values) (car x) (cdr x))
+                   (cdr values))
+      (if x t nil)))
+
+  (defthm ubdd.eval-when-not-consp
+    (implies (not (consp x))
+             (equal (ubdd.eval x values)
+                    (if x t nil)))
+    :hints(("Goal" :expand (ubdd.eval x values))))
+
+  (defthm ubdd.eval-of-nil
+    (equal (ubdd.eval nil values)
+           nil)
+    :hints(("Goal" :expand (ubdd.eval nil values))))
+
+  (defthm ubdd.eval-of-t
+    (equal (ubdd.eval t values)
+           t)
+    :hints(("Goal" :expand (ubdd.eval nil values))))
+
+  (defthm ubdd.eval-when-non-consp-values
+    (implies (and (syntaxp (not (equal values ''nil)))
+                  (not (consp values)))
+             (equal (ubdd.eval x values)
+                    (ubdd.eval x nil)))
+    :hints(("Goal" :expand ((ubdd.eval x values)
+                            (ubdd.eval x nil)))))
+
+  (defthm booleanp-of-ubdd.eval
+    (booleanp (ubdd.eval x values))
+    :hints(("Goal"
+            :expand ((ubdd.eval x values))
+            :in-theory (enable (:induction ubdd.eval))
+            :induct (ubdd.eval x values)))))
+
+(defprojection
+  :list (ubdd.eval-list x values)
+  :element (ubdd.eval x values)
+  :nil-preservingp t)
+
+
+
+(defsection ubdd.max-depth
+
+  (defund ubdd.max-depth (x)
+    (declare (xargs :guard t))
+    (if (consp x)
+        (+ 1 (max (ubdd.max-depth (car x))
+                  (ubdd.max-depth (cdr x))))
+      0))
+
+  (defthm ubdd.max-depth-when-not-consp
+    (implies (not (consp x))
+             (equal (ubdd.max-depth x)
+                    0))
+    :hints(("Goal" :expand (ubdd.max-depth x))))
+
+  (defthm ubdd.max-depth-of-cons
+    (equal (ubdd.max-depth (cons a b))
+           (+ 1 (max (ubdd.max-depth a)
+                     (ubdd.max-depth b))))
+    :hints(("Goal" :expand (ubdd.max-depth (cons a b))))))
+
+
+
+(definline ubdd.truebranch (x)
+  ;; Like acl2::qcar, the true branch of a ubdd.  We generally leave this
+  ;; enabled!
+  (declare (xargs :guard t))
+  (if (consp x) (car x) x))
+
+(definline ubdd.falsebranch (x)
+  ;; Like acl2::ubdd.falsebranch, the false branch of a ubdd.  We generally
+  ;; leave this enabled!
+  (declare (xargs :guard t))
+  (if (consp x) (cdr x) x))
+
+
+
+(defsection ubdd.badguy
+
+  (defund ubdd.badguy-aux (x y)
+    ;; Returns (CONS SUCCESSP VALUES)
+    (declare (xargs :measure (+ (rank x) (rank y))
+                    :hints(("Goal"
+                            :in-theory (enable ubdd.truebranch
+                                               ubdd.falsebranch)))))
+    (if (or (consp x) (consp y))
+        ;; At least one of them is a cons.  We descend both trees and try to
+        ;; discover a path that will break their equality.
+        (let* ((try1 (ubdd.badguy-aux (ubdd.truebranch x) (ubdd.truebranch y)))
+               (try1-successp (car try1))
+               (try1-values   (cdr try1)))
+          (if try1-successp
+              (cons t (cons t try1-values))
+            (let* ((try2          (ubdd.badguy-aux (ubdd.falsebranch x) (ubdd.falsebranch y)))
+                   (try2-successp (car try2))
+                   (try2-values   (cdr try2)))
+              (if try2-successp
+                  (cons t (cons nil try2-values))
+                (cons nil nil)))))
+      ;; Otherwise, both are atoms.  If they are equal, then we have failed to
+      ;; find a conflicting path.  But if they are not equal, then this path
+      ;; violates their success.
+      (cons (not (equal x y)) nil)))
+
+  (defthm ubdd.badguy-aux-when-not-consps
+    (implies (and (not (consp x))
+                  (not (consp y)))
+             (equal (ubdd.badguy-aux x y)
+                    (cons (not (equal x y)) nil)))
+    :hints(("Goal" :expand (ubdd.badguy-aux x y))))
+
+  (defthmd ubdd.badguy-aux-lemma1
+    (implies (and (car (ubdd.badguy-aux x y))
+                  (ubddp x)
+                  (ubddp y))
+             (equal (equal (ubdd.eval x (cdr (ubdd.badguy-aux x y)))
+                           (ubdd.eval y (cdr (ubdd.badguy-aux x y))))
+                    nil))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.badguy-aux))
+            :induct (ubdd.badguy-aux x y)
+            :expand ((ubdd.badguy-aux x y)
+                     (ubdd.badguy-aux x t)
+                     (ubdd.badguy-aux x nil)
+                     (ubdd.badguy-aux t y)
+                     (ubdd.badguy-aux nil y)
+                     (:free (bdd val1 vals)
+                            (ubdd.eval bdd (cons val1 vals)))))))
+
+  (defthmd ubdd.badguy-aux-lemma2
+    (implies (and (ubddp x)
+                  (ubddp y))
+             (equal (car (ubdd.badguy-aux x y))
+                    (not (equal x y))))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.badguy-aux))
+            :induct (ubdd.badguy-aux x y)
+            :expand ((ubdd.badguy-aux x y)
+                     (ubdd.badguy-aux x t)
+                     (ubdd.badguy-aux x nil)
+                     (ubdd.badguy-aux t y)
+                     (ubdd.badguy-aux nil y)))))
+
+  (defthm ubdd.badguy-aux-lemma3
+    (<= (len (cdr (ubdd.badguy-aux x y)))
+        (max (ubdd.max-depth x) (ubdd.max-depth y)))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.badguy-aux))
+            :induct (ubdd.badguy-aux x y)
+            :expand ((ubdd.badguy-aux x y)
+                     ;; not necessary, but these speed up the proof
+                     (ubdd.max-depth x)
+                     (ubdd.max-depth y)))))
+
+
+  (defund ubdd.badguy-extend (lst n)
+    (declare (xargs :guard (natp n)
+                    :measure (nfix n)))
+    (cond ((zp n)
+           lst)
+          ((consp lst)
+           (cons (car lst) (ubdd.badguy-extend (cdr lst) (- n 1))))
+          (t
+           (cons nil (ubdd.badguy-extend lst (- n 1))))))
+
+  (defthm ubdd.badguy-extend-when-zp
+    (implies (zp n)
+             (equal (ubdd.badguy-extend lst n)
+                    lst))
+    :hints(("Goal" :expand (ubdd.badguy-extend lst n))))
+
+  (defthm ubdd.badguy-extend-of-cons
+    (equal (ubdd.badguy-extend (cons a b) n)
+           (cons a (ubdd.badguy-extend b (- n 1))))
+    :hints(("Goal" :expand (ubdd.badguy-extend (cons a b) n))))
+
+  (defthm len-of-ubdd.badguy-extend
+    (equal (len (ubdd.badguy-extend lst n))
+           (max (len lst) n))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.badguy-extend))
+            :expand ((ubdd.badguy-extend lst n)
+                     (ubdd.badguy-extend lst 1)))))
+
+  (local (defun eval-extend-induct (x lst n)
+           (declare (xargs :measure (nfix n)))
+           (if (zp n)
+               (cons lst x)
+             (if (atom lst)
+                 (list (eval-extend-induct (car x) lst (- n 1))
+                       (eval-extend-induct (cdr x) lst (- n 1)))
+               (list (eval-extend-induct (car x) (cdr lst) (- n 1))
+                     (eval-extend-induct (cdr x) (cdr lst) (- n 1)))))))
+
+  (defthm ubdd.eval-of-ubdd.badguy-extend
+    (equal (ubdd.eval x (ubdd.badguy-extend lst n))
+           (ubdd.eval x lst))
+    :hints (("goal"
+             :induct (eval-extend-induct x lst n)
+             :expand ((ubdd.badguy-extend lst n)
+                      (ubdd.eval x lst)
+                      (ubdd.eval x nil)
+                      (:free (x val1 vals)
+                             (ubdd.eval x (cons val1 vals)))))))
+
+
+  (defund ubdd.badguy (x y)
+    ;; like badguy-aux except that we always know the values returned
+    ;; have the max depth allowed
+    (declare (xargs :guard t))
+    (let* ((aux         (ubdd.badguy-aux x y))
+           (different-p (car aux))
+           (values      (ubdd.badguy-extend (cdr aux)
+                                            (max (ubdd.max-depth x)
+                                                 (ubdd.max-depth y)))))
+      (cons different-p values)))
+
+  (defthm len-of-ubdd.badguy
+    (equal (len (cdr (ubdd.badguy x y)))
+           (max (ubdd.max-depth x)
+                (ubdd.max-depth y)))
+    :hints(("Goal" :in-theory (e/d (ubdd.badguy)
+                                   (ubdd.badguy-aux-lemma3))
+            :use ((:instance ubdd.badguy-aux-lemma3)))))
+
+  (defthmd ubdd.badguy-differentiates
+    (implies (and (car (ubdd.badguy x y))
+                  (ubddp x)
+                  (ubddp y))
+             (not (equal (ubdd.eval x (cdr (ubdd.badguy x y)))
+                         (ubdd.eval y (cdr (ubdd.badguy x y))))))
+    :hints(("Goal" :in-theory (enable ubdd.badguy
+                                      ubdd.badguy-aux-lemma1))))
+
+  (defthm car-of-ubdd.badguy
+    (implies (and (ubddp x)
+                  (ubddp y))
+             (equal (car (ubdd.badguy x y))
+                    (not (equal x y))))
+    :hints(("Goal" :in-theory (enable ubdd.badguy
+                                      ubdd.badguy-aux-lemma2)))))
+
+
+
+
+;; [Jared]: It'd probably make sense to automate ubdd.badguy-differentiates
+;; like we do in the ACL2 UBDD library, and if we get into heavy proofs about
+;; UBDD operations (e.g., bddify) then we might well want to do this.  But for
+;; now I'm going to just do things more manually.
+
+(defsection ubdd.not
+
+  (defund ubdd.not (x)
+    (declare (xargs :guard t))
+    (if (consp x)
+        (hons (ubdd.not (car x))
+              (ubdd.not (cdr x)))
+      (if x nil t)))
+
+  (defthm consp-of-ubdd.not
+    (equal (consp (ubdd.not x))
+           (consp x))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.not))
+            :expand (ubdd.not x))))
+
+  (defthmd lemma1-for-ubddp-of-ubdd.not
+    (implies (and (not (equal a t))
+                  (ubddp a))
+             (iff (ubdd.not a)
+                  t))
+    :hints(("Goal" :expand ((ubddp a)
+                            (ubdd.not a)))))
+
+  (defthmd lemma2-for-ubddp-of-ubdd.not
+    (implies (and a
+                  (ubddp a))
+             (equal (equal t (ubdd.not a))
+                    nil))
+    :hints(("Goal" :expand ((ubddp a)
+                            (ubdd.not a)))))
+
+  (defthm ubddp-of-ubdd.not
+    (implies (force (ubddp x))
+             (equal (ubddp (ubdd.not x))
+                    t))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.not)
+                               lemma1-for-ubddp-of-ubdd.not
+                               lemma2-for-ubddp-of-ubdd.not)
+            :expand ((ubdd.not x)))))
+
+  (defthm ubdd.eval-of-ubdd.not
+    (equal (ubdd.eval (ubdd.not x) values)
+           (not (ubdd.eval x values)))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.eval))
+            :expand ((ubdd.not x)
+                     (ubdd.eval x values)
+                     (:free (a b) (ubdd.eval (cons a b) values)))))))
+
+
+(definline ubdd.cons (truebranch falsebranch)
+  ;; Like acl2::qcons, builds a ubdd from the true/false branches.  We generally
+  ;; leave this enabled!
+  (declare (xargs :guard t))
+  (if (if (equal truebranch t)
+          (equal falsebranch t)
+        (and (equal truebranch nil)
+             (equal falsebranch nil)))
+      truebranch
+    (hons truebranch falsebranch)))
+
+
+(defsection ubdd.ite
+
+  ;; This is still more complex than absolutely necessary, e.g., it lets us
+  ;; take advantage of UBDD.NOT where possible.  But it doesn't do quite so
+  ;; much as the ACL2 Q-ITE macro to optimize the order of evaluation, etc.
+
+  (local (in-theory (disable ubdd.eval-when-non-consp-values
+                             same-length-prefixes-equal-cheap
+                             not-equal-when-less
+                             not-equal-when-less-two
+                             car-when-memberp-of-singleton-list-cheap
+                             consp-when-true-listp-cheap
+                             car-when-memberp-and-not-memberp-of-cdr-cheap
+                             consp-when-nonempty-subset-cheap
+                             consp-when-memberp-cheap
+                             cdr-when-true-listp-with-len-free-past-the-end
+                             consp-of-cdr-when-memberp-not-car-cheap
+                             consp-of-cdr-when-len-two-cheap
+                             natp-of-len-free
+                             consp-of-cdr-when-tuplep-2-cheap
+                             consp-of-cdr-when-tuplep-3-cheap
+                             consp-of-cdr-with-len-free
+                             consp-when-natp-cheap
+                             cdr-under-iff-with-len-free-in-bound
+                             cdr-under-iff-when-true-listp-with-len-free)))
+
+  (defund ubdd.ite (x y z)
+    (declare (xargs :guard t))
+    (if (consp x)
+        (let ((y (if (hons-equal x y) t y))               ;; (IF X X Z) = (IF X T Z)
+              (z (if (hons-equal x z) nil z)))            ;; (IF X Y X) = (IF X Y NIL)
+          (cond
+           ((hons-equal y z) y)                           ;; (IF X Y Y) = Y
+           ((and (equal y t) (equal z nil)) x)            ;; (IF X T NIL) = X
+           ((and (equal y nil) (equal z t)) (ubdd.not x)) ;; (IF X NIL T) = (NOT X)
+           (t
+            (ubdd.cons (ubdd.ite (car x)
+                                 (ubdd.truebranch y)
+                                 (ubdd.truebranch z))
+                       (ubdd.ite (cdr x)
+                                 (ubdd.falsebranch y)
+                                 (ubdd.falsebranch z))))))
+      (if (equal x nil)
+          z
+        y)))
+
+  (defthm ubdd.ite-of-t
+    (equal (ubdd.ite t x y)
+           x)
+    :hints(("Goal" :expand (ubdd.ite t x y))))
+
+  (defthm ubdd.ite-of-nil
+    (equal (ubdd.ite nil x y)
+           y)
+    :hints(("Goal" :expand (ubdd.ite nil x y))))
+
+  (local (defun ubdd.ite-induct (x y z)
+           (cond ((not x) (list x y z))
+                 ((atom x) nil)
+                 (t (let ((y (if (equal x y) t y))
+                          (z (if (equal x z) nil z)))
+                      (list (ubdd.ite-induct (car x)
+                                             (ubdd.truebranch y)
+                                             (ubdd.truebranch z))
+                            (ubdd.ite-induct (cdr x)
+                                             (ubdd.falsebranch y)
+                                             (ubdd.falsebranch z))))))))
+
+  (defthm ubddp-of-ubdd.ite
+    (implies (and (force (ubddp x))
+                  (force (ubddp y))
+                  (force (ubddp z)))
+             (equal (ubddp (ubdd.ite x y z))
+                    t))
+    :hints(("Goal"
+            :in-theory (disable car-cdr-elim)
+            :induct (ubdd.ite-induct x y z)
+            :expand ((:free (y z) (ubdd.ite x y z))
+                     (ubddp x)
+                     (ubddp y)
+                     (ubddp z)))))
+
+  (local (defun ubdd.ite-induct-vals (x y z vals)
+           (cond ((not x) (list x y z vals))
+                 ((atom x) nil)
+                 (t (let ((y (if (equal x y) t y))
+                          (z (if (equal x z) nil z)))
+                      (cond ((car vals)
+                             (ubdd.ite-induct-vals (car x)
+                                                   (ubdd.truebranch y)
+                                                   (ubdd.truebranch z)
+                                                   (cdr vals)))
+                            (t
+                             (ubdd.ite-induct-vals (cdr x)
+                                                   (ubdd.falsebranch y)
+                                                   (ubdd.falsebranch z)
+                                                   (cdr vals)))))))))
+
+  (defthm ubdd.eval-of-ubdd.ite
+    (equal (ubdd.eval (ubdd.ite x y z) values)
+           (if (ubdd.eval x values)
+               (ubdd.eval y values)
+             (ubdd.eval z values)))
+    :hints(("Goal"
+            :in-theory (disable car-cdr-elim)
+            :do-not '(generalize fertilize eliminate-destructors)
+            :induct (ubdd.ite-induct-vals x y z values)
+            :expand ((:free (y z) (ubdd.ite x y z))
+                     (:free (a b) (ubdd.eval (cons a b) values))
+                     (ubdd.eval x values)
+                     (ubdd.eval y values)
+                     (ubdd.eval z values))))))
+
+(defthm canonicalize-ubdd.not
+  (implies (force (ubddp x))
+           (equal (ubdd.not x)
+                  (ubdd.ite x nil t)))
+  :hints(("Goal"
+          :use ((:instance ubdd.badguy-differentiates
+                           (x (ubdd.not x))
+                           (y (ubdd.ite x nil t)))))))
+
+
+;; Once we get everything into a ubdd.ite form, we'll often want to apply
+;; some of the simple reductions you would expect.  The order of these
+;; rules is important --- to avoid loops, you want the T and NIL cases
+;; to come last.
+
+;; !!! I think we should maybe be able to get some more of these
+;; hypothesis free if we change ubdd.ite around a bit so that it
+;; coerces atoms into booleans.  Would performance be okay?
+
+(defthm |(ubdd.ite x (ubdd.ite y nil t) z)|
+  (implies (and (syntaxp (not (equal z ''t))) ;; Prevents loops (see next rule)
+                (force (ubddp x))
+                (force (ubddp y))
+                (force (ubddp z)))
+           (equal (ubdd.ite x (ubdd.ite y nil t) z)
+                  (ubdd.ite y
+                         (ubdd.ite x nil z)
+                         (ubdd.ite x t z))))
+  :hints(("Goal"
+          :use ((:instance ubdd.badguy-differentiates
+                           (x (ubdd.ite x (ubdd.ite y nil t) z))
+                           (y (ubdd.ite y
+                                        (ubdd.ite x nil z)
+                                        (ubdd.ite x t z))))))))
+
+
+(defthm |(ubdd.ite x (ubdd.ite y nil t) t)|
+  ;; ACL2's loop-stopper works.
+  (implies (and (force (ubddp x))
+                (force (ubddp y))
+                (force (ubddp z)))
+           (equal (ubdd.ite x (ubdd.ite y nil t) t)
+                  (ubdd.ite y (ubdd.ite x nil t) t)))
+  :hints(("Goal"
+          :use ((:instance ubdd.badguy-differentiates
+                           (x (ubdd.ite x (ubdd.ite y nil t) t))
+                           (y (ubdd.ite y (ubdd.ite x nil t) t)))))))
+
+(defthm |(ubdd.ite (ubdd.ite a b c) x y)|
+  (implies (and (force (ubddp a))
+                (force (ubddp b))
+                (force (ubddp c))
+                (force (ubddp x))
+                (force (ubddp y)))
+           (equal (ubdd.ite (ubdd.ite a b c) x y)
+                  (ubdd.ite a
+                         (ubdd.ite b x y)
+                         (ubdd.ite c x y))))
+  :hints(("Goal"
+          :use ((:instance ubdd.badguy-differentiates
+                           (x (ubdd.ite (ubdd.ite a b c) x y))
+                           (y (ubdd.ite a
+                                        (ubdd.ite b x y)
+                                        (ubdd.ite c x y))))))))
+
+(defthm |(ubdd.ite x y y)|
+  (equal (ubdd.ite x y y)
+         y)
+  :hints(("Goal" :expand (ubdd.ite x y y))))
+
+(defthm |(ubdd.ite x x y)|
+  (implies (and (force (ubddp x))
+                (force (ubddp y)))
+           (equal (ubdd.ite x x y)
+                  (ubdd.ite x t y)))
+  :hints(("Goal"
+          :use ((:instance ubdd.badguy-differentiates
+                           (x (ubdd.ite x x y))
+                           (y (ubdd.ite x t y)))))))
+
+(defthm |(ubdd.ite x y x)|
+  (equal (ubdd.ite x y x)
+         (ubdd.ite x y nil))
+  :hints(("Goal" :expand ((ubdd.ite x y x)
+                          (ubdd.ite x y nil)))))
+
+(defthm |(ubdd.ite x t nil)|
+  (implies (force (ubddp x))
+           (equal (ubdd.ite x t nil)
+                  x))
+  :hints(("Goal" :expand (ubdd.ite x t nil))))
+
+(defthm |(ubdd.ite non-nil y z)|
+  (implies (and (atom x) x)
+           (equal (ubdd.ite x y z)
+                  y))
+  :hints(("Goal" :expand (ubdd.ite x y z))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/ubdds/extra-operations.lisp acl2-6.3/books/milawa/ACL2/ubdds/extra-operations.lisp
--- acl2-6.2/books/milawa/ACL2/ubdds/extra-operations.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/ubdds/extra-operations.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,445 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Milawa implementation of UBDDs
+;;
+;; This file is derived from the ACL2 UBDD library that was originally
+;; developed by Warren Hunt and Bob Boyer, and later extended by Jared Davis
+;; and Sol Swords.  See books/centaur/ubdds/ in an ACL2 distribution.
+
+(in-package "MILAWA")
+(include-book "core")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+; Note: for simplicity I don't reimplement the fancy opportunistic laziness
+; stuff that the ACL2 BDD library uses.  Milawa's UBDD.AND is just a function,
+; and both arguments get evaluated.
+
+(local (defun ubdd.binop-induct (x y vals)
+         (cond ((atom x)
+                (list x y vals))
+               ((atom y)
+                nil)
+               ((car vals)
+                (ubdd.binop-induct (car x) (car y) (cdr vals)))
+               (t
+                (ubdd.binop-induct (cdr x) (cdr y) (cdr vals))))))
+
+(defsection ubdd.and
+
+  (defund ubdd.and (x y)
+    (declare (xargs :guard t))
+    (cond ((atom x)
+           (if x
+               ;; [Jared hack]: normalize in the atom case for fewer hyps
+               (if (atom y)
+                   (if y t nil)
+                 y)
+             nil))
+          ((atom y)
+           ;; We know x is not an atom, so no need to normalize
+           (if y x nil))
+          ((hons-equal x y)
+           x)
+          (t
+           (ubdd.cons (ubdd.and (car x) (car y))
+                      (ubdd.and (cdr x) (cdr y))))))
+
+  (defthm ubdd.and-of-nil-left
+    (equal (ubdd.and nil x) nil)
+    :hints(("Goal" :expand (ubdd.and nil x))))
+
+  (defthm ubdd.and-of-nil-right
+    (equal (ubdd.and x nil) nil)
+    :hints(("Goal" :expand (ubdd.and x nil))))
+
+  (defthm ubdd.and-of-t-left-slow
+    (equal (ubdd.and t x) (if (consp x) x (if x t nil)))
+    :hints(("Goal" :expand (ubdd.and t x))))
+
+  (defthm ubdd.and-of-t-right-slow
+    (equal (ubdd.and x t) (if (consp x) x (if x t nil)))
+    :hints(("Goal" :expand (ubdd.and x t))))
+
+  (defthm ubdd.and-of-self-slow
+    (equal (ubdd.and x x) (if (consp x) x (if x t nil)))
+    :hints(("Goal" :expand (ubdd.and x x))))
+
+  (defthm ubddp-of-ubdd.and
+    (implies (and (force (ubddp x))
+                  (force (ubddp y)))
+             (equal (ubddp (ubdd.and x y))
+                    t))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.and))
+            :expand ((ubdd.and x y)))))
+
+  (defthm ubdd.eval-of-ubdd.and
+    (equal (ubdd.eval (ubdd.and x y) values)
+           (and (ubdd.eval x values)
+                (ubdd.eval y values)))
+    :hints(("Goal"
+            :induct (ubdd.binop-induct x y values)
+            :expand ((ubdd.and x y)
+                     (ubdd.eval x values)
+                     (ubdd.eval y values)
+                     (:free (a b) (ubdd.eval (cons a b) values))))))
+
+  (defthm ubdd.and-symmetric
+    (equal (ubdd.and x y)
+           (ubdd.and y x))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.and))
+            :expand ((ubdd.and x y)
+                     (ubdd.and y x)))))
+
+  (defthm canonicalize-ubdd.and
+    (implies (and (force (ubddp x))
+                  (force (ubddp y)))
+             (equal (ubdd.and x y)
+                    (ubdd.ite x y nil)))
+    :hints(("Goal" :use ((:instance ubdd.badguy-differentiates
+                                    (x (ubdd.and x y))
+                                    (y (ubdd.ite x y nil)))))))
+
+  (defthm ubdd.and-of-t-left-aggressive
+    (implies (force (ubddp x))
+             (equal (ubdd.and t x) x)))
+
+  (defthm ubdd.and-of-t-right-aggressive
+    (implies (force (ubddp x))
+             (equal (ubdd.and x t) x)))
+
+  (defthm ubdd.and-of-self-aggressive
+    (implies (force (ubddp x))
+             (equal (ubdd.and x x) x))))
+
+
+
+(defsection ubdd.or
+
+  (defund ubdd.or (x y)
+    (declare (xargs :guard t))
+    (cond ((atom x)
+           (if x
+               t
+             ;; [Jared hack]: normalize atoms
+             (if (atom y) (if y t nil) y)))
+          ((atom y)
+           ;; We know x is not an atom, so no need to normalize.
+           (if y t x))
+          ((hons-equal x y)
+           x)
+          (t
+           (let ((l (ubdd.or (car x) (car y)))
+                 (r (ubdd.or (cdr x) (cdr y))))
+             (ubdd.cons l r)))))
+
+  (defthm ubdd.or-of-nil-left-slow
+    (equal (ubdd.or nil x) (if (consp x) x (if x t nil)))
+    :hints(("Goal" :expand (ubdd.or nil x))))
+
+  (defthm ubdd.or-of-nil-right-slow
+    (equal (ubdd.or x nil) (if (consp x) x (if x t nil)))
+    :hints(("Goal" :expand (ubdd.or x nil))))
+
+  (defthm ubdd.or-of-t-left
+    (equal (ubdd.or t x) t)
+    :hints(("Goal" :expand (ubdd.or t x))))
+
+  (defthm ubdd.or-of-t-right
+    (equal (ubdd.or x t) t)
+    :hints(("Goal" :expand (ubdd.or x t))))
+
+  (defthm ubdd.or-of-self-slow
+    (equal (ubdd.or x x)
+           (if (consp x) x (if x t nil)))
+    :hints(("Goal" :expand (ubdd.or x x))))
+
+  (defthm ubddp-of-ubdd.or
+    (implies (and (force (ubddp x))
+                  (force (ubddp y)))
+             (equal (ubddp (ubdd.or x y))
+                    t))
+    :hints(("Goal"
+            :induct (ubdd.or x y)
+            :in-theory (enable (:induction ubdd.or))
+            :expand ((ubdd.or x y)))))
+
+  (defthm ubdd.eval-of-ubdd.or
+    (equal (ubdd.eval (ubdd.or x y) values)
+           (or (ubdd.eval x values)
+               (ubdd.eval y values)))
+    :hints(("Goal"
+            :induct (ubdd.binop-induct x y values)
+            :expand ((ubdd.or x y)
+                     (ubdd.eval x values)
+                     (ubdd.eval y values)
+                     (:free (a b) (ubdd.eval (cons a b) values))))))
+
+  (defthm ubdd.or-symmetric
+    (equal (ubdd.or x y)
+           (ubdd.or y x))
+    :hints(("Goal"
+            :induct (ubdd.or x y)
+            :in-theory (enable (:induction ubdd.or))
+            :expand ((ubdd.or x y)
+                     (ubdd.or y x)))))
+
+  (defthm canonicalize-ubdd.or
+    (implies (and (force (ubddp x))
+                  (force (ubddp y)))
+             (equal (ubdd.or x y)
+                    (ubdd.ite x t y)))
+    :hints(("Goal" :use ((:instance ubdd.badguy-differentiates
+                                    (x (ubdd.or x y))
+                                    (y (ubdd.ite x t y)))))))
+
+  (defthm ubdd.or-of-nil-left-aggressive
+    (implies (force (ubddp x))
+             (equal (ubdd.or nil x) x))
+    :hints(("Goal" :use ((:instance ubdd.badguy-differentiates
+                                    (x (ubdd.or nil x))
+                                    (y x))))))
+
+  (defthm ubdd.or-of-nil-right-aggressive
+    (implies (force (ubddp x))
+             (equal (ubdd.or x nil) x))
+    :hints(("Goal" :use ((:instance ubdd.badguy-differentiates
+                                    (x (ubdd.or x nil))
+                                    (y x))))))
+
+  (defthm ubdd.or-of-self-aggressive
+    (implies (force (ubddp x))
+             (equal (ubdd.or x x) x))
+    :hints(("Goal" :use ((:instance ubdd.badguy-differentiates
+                                    (x (ubdd.or x x))
+                                    (y x)))))))
+
+
+
+; BOZO.  The ACL2 ubdd library currently has q-implies, q-or-c2, q-and-c1,
+; etc., as a custom, recursive functions.  But I think it's probably better to
+; implement these as wrappers.  After all, we generally expect ubdd.not to be
+; free, so wouldn't it be better to tap into the ubdd.or memo table?  I should
+; try this at Centaur and see how performance compares, but we probably don't
+; use implies enough to matter.
+
+(definline ubdd.implies (x y)
+  (declare (xargs :guard t))
+  (ubdd.or (ubdd.not x) y))
+
+(definline ubdd.or-c2 (x y)
+  (declare (xargs :guard t))
+  (ubdd.or x (ubdd.not y)))
+
+(definline ubdd.and-c1 (x y)
+  (declare (xargs :guard t))
+  (ubdd.and (ubdd.not x) y))
+
+(definline ubdd.and-c2 (x y)
+  (declare (xargs :guard t))
+  (ubdd.and x (ubdd.not y)))
+
+
+
+(defsection ubdd.xor
+
+  (defund ubdd.xor (x y)
+    (declare (xargs :guard t))
+    (cond ((atom x)
+           (if x (ubdd.not y) y))
+          ((atom y)
+           (if y (ubdd.not x) x))
+          ((hons-equal x y)
+           nil)
+          (t
+           (ubdd.cons (ubdd.xor (car x) (car y))
+                      (ubdd.xor (cdr x) (cdr y))))))
+
+  (local (in-theory (disable canonicalize-ubdd.not)))
+
+  (defthm ubdd.xor-of-self
+    (equal (ubdd.xor x x)
+           nil)
+    :hints(("Goal"
+            :expand ((ubdd.xor x x)
+                     (ubdd.not x)))))
+
+; BOZO these t/nil rules aren't in the ACL2 ubdd library; it would probably be
+; good to add them.
+
+  (defthm ubdd.xor-of-t-left
+    (equal (ubdd.xor t x)
+           (ubdd.not x))
+    :hints(("Goal" :expand (ubdd.xor t x))))
+
+  (defthm ubdd.xor-of-t-right
+    (equal (ubdd.xor x t)
+           (ubdd.not x))
+    :hints(("Goal" :expand ((ubdd.xor x t)
+                            (ubdd.not x)))))
+
+  (defthm ubdd.xor-of-nil-left
+    (equal (ubdd.xor nil x)
+           x)
+    :hints(("Goal" :expand (ubdd.xor nil x))))
+
+  (defthm ubdd.xor-of-nil-right-slow
+    ;; bozo kind of a weird asymmetry here?
+    (equal (ubdd.xor x nil)
+           (if (consp x) x (if x t nil)))
+    :hints(("Goal" :expand ((ubdd.xor x nil)
+                            (ubdd.not x)))))
+
+  (defthm ubddp-of-ubdd.xor
+    (implies (and (force (ubddp x))
+                  (force (ubddp y)))
+             (equal (ubddp (ubdd.xor x y))
+                    t))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.xor))
+            :expand ((ubdd.xor x y)))))
+
+  (defthm ubdd.eval-of-ubdd.xor
+    (equal (ubdd.eval (ubdd.xor x y) values)
+           (if (ubdd.eval x values)
+               (not (ubdd.eval y values))
+             (ubdd.eval y values)))
+    :hints(("Goal"
+            :induct (ubdd.binop-induct x y values)
+            :expand ((ubdd.xor x y)
+                     (ubdd.eval x values)
+                     (ubdd.eval y values)
+                     (:free (a b) (ubdd.eval (cons a b) values))))))
+
+  (defthm canonicalize-ubdd.xor
+    (implies (and (force (ubddp x))
+                  (force (ubddp y)))
+             (equal (ubdd.xor x y)
+                    (ubdd.ite x (ubdd.not y) y)))
+    :hints(("Goal" :use ((:instance ubdd.badguy-differentiates
+                                    (x (ubdd.xor x y))
+                                    (y (ubdd.ite x (ubdd.not y) y))))))))
+
+
+; BOZO the ACL2 ubdd library currently has ubdd.iff as its own recursive
+; function, but I suspect this wrapper aprpoach is better:
+
+(definline ubdd.iff (x y)
+  (ubdd.not (ubdd.xor x y)))
+
+(definline ubdd.nand (x y)
+  (ubdd.not (ubdd.and x y)))
+
+(definline ubdd.nor (x y)
+  (ubdd.not (ubdd.or x y)))
+
+
+(defsection ubdd.var
+
+  (defund ubdd.var (i)
+    ;; Creates the (nfix i)th BDD variable.
+    (declare (xargs :guard t
+                    :measure (nfix i)))
+    (if (zp i)
+        (hons t nil)
+      (let ((prev (ubdd.var (- i 1))))
+        (hons prev prev))))
+
+  (defthm ubdd.var-under-iff
+    (iff (ubdd.var i)
+         t)
+    :hints(("Goal" :expand (ubdd.var i))))
+
+  (defthm consp-of-ubdd.var
+    (equal (consp (ubdd.var i))
+           t)
+    :hints(("Goal" :expand (ubdd.var i))))
+
+  (defthm ubddp-ubdd.var
+    (ubddp (ubdd.var i))
+    :hints(("Goal"
+            :induct (ubdd.var i)
+            :in-theory (enable (:induction ubdd.var))
+            :expand ((ubdd.var i)))))
+
+  (defthm ubdd.eval-of-ubdd.var-and-nil
+    (not (ubdd.eval (ubdd.var i) nil))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.var))
+            :induct (ubdd.var i)
+            :expand ((ubdd.var i)
+                     (:free (a b) (ubdd.eval (cons a b) nil))))))
+
+  (local (defun my-induct (i lst)
+           (declare (xargs :measure (nfix i)))
+           (if (zp i)
+               lst
+             (my-induct (- i 1) (cdr lst)))))
+
+  (defthm ubdd.eval-of-ubdd.var
+    (equal (ubdd.eval (ubdd.var i) lst)
+           (if (nth i lst) t nil))
+    :hints(("Goal"
+            :in-theory (enable (:induction ubdd.var))
+            :induct (my-induct i lst)
+            :expand ((ubdd.var i)
+                     (nth i lst)
+                     (:free (a b) (ubdd.eval (cons a b) lst))))))
+
+  (local (defun ubdd.vars-ind (i j)
+           (declare (xargs :measure (nfix i)))
+           (if (or (zp i) (zp j))
+               i
+             (ubdd.vars-ind (- i 1) (- j 1)))))
+
+  (defthmd equal-of-cons-rewrite-full
+    (equal (equal (cons a b) x)
+           (and (consp x)
+                (equal (car x) a)
+                (equal (cdr x) b))))
+
+  (defthm ubdd.vars-equal
+    (equal (equal (ubdd.var i) (ubdd.var j))
+           (equal (nfix i) (nfix j)))
+    :hints(("Goal"
+            :in-theory (enable equal-of-cons-rewrite-full)
+            :induct (ubdd.vars-ind i j)
+            :expand ((ubdd.var i)
+                     (ubdd.var j))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/utilities/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/utilities/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/all-at-leastp.lisp acl2-6.3/books/milawa/ACL2/utilities/all-at-leastp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/all-at-leastp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/all-at-leastp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,80 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "nat-listp")
+(include-book "all-equalp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; This was previously the following, but now we have :negatedp.
+
+;; (deflist all-at-leastp (n x)
+;;   (<= n x)
+;;   :guard (and (natp n) (nat-listp x)))
+
+(deflist all-at-leastp (n x)
+  (< x n)
+  :negatedp t
+  :guard (and (natp n)
+              (nat-listp x)))
+
+
+;; We previously had this, but with negatedp we don't need it.
+
+;; (defthm <-of-car-when-all-at-leastp
+;;   (implies (all-at-leastp n x)
+;;            (equal (< (car x) n)
+;;                   (and (not (consp x))
+;;                        (< 0 n)))))
+
+;; (in-theory (disable <=-of-car-when-all-at-leastp))
+
+(defthm all-at-leastp-when-all-equalp
+  (implies (all-equalp n x)
+           (equal (all-at-leastp m x)
+                  (if (consp x)
+                      (not (< n m))
+                    t)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-at-leastp-of-zero
+  (equal (all-at-leastp 0 x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/all-equalp.lisp acl2-6.3/books/milawa/ACL2/utilities/all-equalp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/all-equalp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/all-equalp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,68 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(deflist all-equalp (b x)
+  (equal b x))
+
+
+;; This rule is better than the one that the deflist macro generates.  (It's
+;; not a problem to be fixed in deflist, it's just for this special case.)
+
+(defthm car-when-all-equalp
+  (implies (all-equalp b x)
+           (equal (car x)
+                  (if (consp x)
+                      b
+                    nil))))
+
+(in-theory (disable equal-of-car-when-all-equalp))
+
+(defthm all-equalp-of-repeat-free
+  (implies (equal free (repeat a n))
+           (equal (all-equalp a free)
+                  t)))
+
+(defthm all-equalp-when-all-equalp-free
+  (implies (all-equalp a x)
+           (equal (all-equalp b x)
+                  (or (not (consp x))
+                      (equal a b))))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/acl2-customization.lsp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/acl2-customization.lsp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/acl2-customization.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../acl2-customization.lsp")
+(in-package "MILAWA")
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/bitwise-and.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/bitwise-and.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/bitwise-and.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/bitwise-and.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,94 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "expt")
+(include-book "dividesp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(local (in-theory (enable definition-of-bitwise-and)))
+
+
+(defthm natp-of-bitwise-and
+  (equal (natp (bitwise-and a b))
+         t))
+
+(defthm bitwise-and-when-not-natp-left-cheap
+  (implies (not (natp a))
+           (equal (bitwise-and a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm bitwise-and-when-not-natp-right-cheap
+  (implies (not (natp b))
+           (equal (bitwise-and a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm |(bitwise-and 0 a)|
+  (equal (bitwise-and 0 a)
+         0))
+
+(defthm |(bitwise-and a 0)|
+  (equal (bitwise-and a 0)
+         0))
+
+;; (defthm |(bitwise-and 1 a)|
+;;   (equal (bitwise-and 1 a)
+;;          (not (dividesp 2 a)))
+;;   :hints(("Goal" :in-theory (enable dividesp))))
+
+
+
+
+
+(defthm natp-of-bitwise-or
+  (equal (natp (bitwise-or a b))
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-bitwise-or))))
+
+(defthm natp-of-bitwise-xor
+  (equal (natp (bitwise-xor a b))
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-bitwise-xor))))
+
+(defthm booleanp-of-bitwise-nth
+  (equal (booleanp (bitwise-nth a b))
+         t)
+  :hints(("Goal" :in-theory (enable definition-of-bitwise-nth))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/bitwise-support.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/bitwise-support.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/bitwise-support.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/bitwise-support.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,157 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+
+(local (include-book "ihs/logops-lemmas" :dir :system))
+(local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
+(local (in-theory (disable evenp oddp floor mod logior logxor logand logbitp)))
+
+(local (defun floor2-floor2-induction (a b)
+         (declare (xargs :measure (nfix a)))
+         (if (or (zp a)
+                 (zp b))
+             nil
+           (floor2-floor2-induction (floor a 2) (floor b 2)))))
+
+(local (defthm evenp-when-natp
+         (implies (force (natp a))
+                  (equal (evenp a)
+                         (equal (mod a 2)
+                                0)))
+         :hints(("Goal" :in-theory (enable evenp)))))
+
+(local (defthm oddp-when-natp
+         (implies (force (natp a))
+                  (equal (oddp a)
+                         (equal (mod a 2)
+                                1)))
+         :hints(("Goal" :in-theory (enable oddp)))))
+
+
+(defthm logand-positive-when-natps
+  (implies (and (<= 0 a)
+                (<= 0 b)
+                (integerp a)
+                (integerp b))
+           (<= 0 (logand a b)))
+  :hints(("Goal" :in-theory (enable logand))))
+
+(defthm recursive-logand-when-natps
+  (implies (and (natp a)
+                (natp b))
+           (equal (logand a b)
+                  (cond ((zp a) 0)
+                        ((zp b) 0)
+                        (t (+ (if (or (equal (mod a 2) 0)
+                                      (equal (mod b 2) 0))
+                                  0
+                                1)
+                              (* 2 (logand (floor a 2) (floor b 2))))))))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable logand))))
+
+
+(defthm logior-positive-when-natps
+  (implies (and (<= 0 a)
+                (<= 0 b)
+                (integerp a)
+                (integerp b))
+           (<= 0 (logior a b)))
+  :hints(("Goal"
+          :in-theory (enable logior*)
+          :induct (floor2-floor2-induction a b))))
+
+(defthm recursive-logior-when-natps
+   (implies (and (natp a)
+                 (natp b))
+            (equal (logior a b)
+                   (cond ((zp a) b)
+                         ((zp b) a)
+                         (t (+ (if (or (equal (mod a 2) 1)
+                                       (equal (mod b 2) 1))
+                                   1
+                                 0)
+                               (* 2 (logior (floor a 2) (floor b 2))))))))
+   :rule-classes :definition
+   :hints(("Goal"
+           :do-not '(generalize fertilize)
+           :in-theory (enable logior*)
+           :induct (floor2-floor2-induction a b))))
+
+
+(defthm logxor-positive-when-natps
+  (implies (and (<= 0 a)
+                (<= 0 b)
+                (integerp a)
+                (integerp b))
+           (<= 0 (logxor a b)))
+  :hints(("Goal"
+          :in-theory (enable logxor*)
+          :induct (floor2-floor2-induction a b))))
+
+(defthm recursive-logxor-when-natps
+   (implies (and (natp a)
+                 (natp b))
+            (equal (logxor a b)
+                   (cond ((zp a) b)
+                         ((zp b) a)
+                         (t (+ (if (equal (mod a 2) (mod b 2))
+                                   0
+                                 1)
+                               (* 2 (logxor (floor a 2) (floor b 2))))))))
+   :rule-classes :definition
+   :hints(("Goal"
+           :in-theory (enable logxor*)
+           :induct (floor2-floor2-induction a b))))
+
+
+
+(local (defun dec-floor2-induction (n a)
+         (declare (xargs :measure (nfix n)))
+         (if (zp n)
+             a
+           (dec-floor2-induction (- n 1) (floor a 2)))))
+
+(defthm recursive-logbitp-when-natps
+  (implies (and (natp n)
+                (natp a))
+           (equal (logbitp n a)
+                  (if (zp n)
+                      (equal (mod a 2) 1)
+                    (logbitp (- n 1) (floor a 2)))))
+  :rule-classes :definition
+  :hints(("Goal"
+          :in-theory (enable logbitp*)
+          :induct (dec-floor2-induction n a))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/cert.acl2 acl2-6.3/books/milawa/ACL2/utilities/arithmetic/cert.acl2
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/cert.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/dividesp.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/dividesp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/dividesp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/dividesp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,326 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "mod")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(definlined dividesp (a b)
+  ;; By convention we say 0 does not divide anything.  We use a mod-based
+  ;; definition here, but we then immediately introduce definition-of-dividesp
+  ;; which gives it a recursive form.
+  (declare (xargs :guard t))
+  (if (zp a)
+      nil
+    (equal (mod b a) 0)))
+
+(defund recursive-dividesp (a b)
+  (declare (xargs :measure (nfix b)))
+  (cond ((zp a)  nil)
+        ((zp b)  t)
+        ((< b a) nil)
+        (t       (recursive-dividesp a (- b a)))))
+
+(defthmd lemma-for-definition-of-dividesp
+  (equal (equal 0 (mod a b))
+         (if (zp b)
+             (zp a)
+           (recursive-dividesp b a)))
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand ((recursive-dividesp b a)))))
+
+(defthmd lemma-2-for-definition-of-dividesp
+  (equal (dividesp a b)
+         (recursive-dividesp a b))
+  :hints(("Goal"
+          :in-theory (enable dividesp
+                             lemma-for-definition-of-dividesp)
+          :expand (recursive-dividesp a b))))
+
+(defthmd definition-of-dividesp
+   (equal (dividesp a b)
+          (cond ((zp a)  nil)
+                ((zp b)  t)
+                ((< b a) nil)
+                (t       (dividesp a (- b a)))))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (dividesp a b)
+                              :scheme (recursive-dividesp a b)))
+   :hints(("Goal"
+           :in-theory (enable lemma-for-definition-of-dividesp
+                              lemma-2-for-definition-of-dividesp)
+           :expand (recursive-dividesp a b))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition dividesp))))
+
+(defthm recursive-dividesp-removal
+  (equal (recursive-dividesp a b)
+         (dividesp a b))
+  :hints(("Goal" :in-theory (enable lemma-2-for-definition-of-dividesp))))
+
+(defthm |(= 0 (mod a b))|
+  (equal (equal 0 (mod a b))
+         (if (zp b)
+             (zp a)
+           (dividesp b a)))
+  :hints(("Goal" :in-theory (enable lemma-for-definition-of-dividesp))))
+
+(defthm booleanp-of-dividesp
+  (equal (booleanp (dividesp a b))
+         t)
+  :hints(("Goal"
+          :induct (sub-induction b a)
+          :expand (dividesp a b))))
+
+(defthm divides-when-not-natp-left-cheap
+  (implies (not (natp a))
+           (equal (dividesp a b)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (dividesp a b))))
+
+(defthm divides-when-not-natp-right-cheap
+  (implies (not (natp b))
+           (equal (dividesp a b)
+                  (not (zp a))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (dividesp a b))))
+
+(defthm divides-when-zp-left-cheap
+  (implies (zp a)
+           (equal (dividesp a b)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (dividesp a b))))
+
+(defthm divides-when-zp-right-cheap
+  (implies (zp b)
+           (equal (dividesp a b)
+                  (not (zp a))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (dividesp a b))))
+
+(defthm dividesp-of-nfix-left
+  (equal (dividesp (nfix a) b)
+         (dividesp a b))
+  :hints(("Goal" :expand ((dividesp (nfix a) b)
+                          (dividesp a b)))))
+
+(defthm dividesp-of-nfix-right
+  (equal (dividesp a (nfix b))
+         (dividesp a b))
+  :hints(("Goal" :expand ((dividesp a (nfix b))
+                          (dividesp a b)))))
+
+(defthm |(dividesp 0 a)|
+  (equal (dividesp 0 a)
+         nil))
+
+(defthm |(dividesp a 0)|
+  (equal (dividesp a 0)
+         (not (zp a))))
+
+(defthm |(dividesp 1 a)|
+  (equal (dividesp 1 a)
+         t)
+  :hints(("Goal"
+          :induct (sub-induction a 1)
+          :expand (dividesp 1 a))))
+
+(defthm |(dividesp a 1)|
+  (equal (dividesp a 1)
+         (equal a 1))
+  :hints(("Goal" :expand (dividesp a 1))))
+
+(defthm |(dividesp a a)|
+  (equal (dividesp a a)
+         (not (zp a)))
+  :hints(("Goal" :expand (dividesp a a))))
+
+(defthm |(< b a) when (dividesp a b)|
+  (implies (dividesp a b)
+           (equal (< b a)
+                  (zp b)))
+  :hints(("Goal" :expand (dividesp a b))))
+
+(defthm |(< a b) when (dividesp a b)|
+  (implies (dividesp a b)
+           (equal (< a b)
+                  (and (not (zp b))
+                       (not (equal a b)))))
+  :hints(("Goal" :expand (dividesp a b))))
+
+(defthm |(dividesp a (+ a b))|
+  (equal (dividesp a (+ a b))
+         (dividesp a b))
+  :hints(("Goal" :expand (dividesp a (+ a b)))))
+
+(defthm |(dividesp a (+ b a))|
+  (equal (dividesp a (+ b a))
+         (dividesp a b))
+  :hints(("Goal" :expand (dividesp a (+ a b)))))
+
+(defthm mod-when-dividesp
+  (implies (dividesp a b)
+           (equal (mod b a)
+                  0)))
+
+(defthm dividesp-of-plus-when-dividesp
+  (implies (dividesp a b)
+           (equal (dividesp a (+ b c))
+                  (dividesp a c)))
+  :hints(("Goal"
+          :induct (sub-induction b a)
+          :expand ((dividesp a b)
+                   (dividesp a (+ b c))))))
+
+(defthm dividesp-of-plus-when-dividesp-alt
+  (implies (dividesp a b)
+           (equal (dividesp a (+ c b))
+                  (dividesp a c))))
+
+(defthm |(dividesp a (- b a))|
+  (equal (dividesp a (- b a))
+         (if (< b a)
+             t
+           (dividesp a b)))
+  :hints(("Goal"
+          :expand (dividesp a b)
+          :induct (sub-induction a b))))
+
+(defthm |(dividesp a (- a b))|
+  (equal (dividesp a (- a b))
+         (cond ((zp a) nil)
+               ((zp b) t)
+               (t      (not (< b a)))))
+  :hints(("Goal" :expand (dividesp a (- a b)))))
+
+
+
+
+
+
+
+
+
+
+#|
+
+
+(defthm lemma
+  (implies (and (dividesp a b)
+                (dividesp a c))
+           (dividesp a (- b c)))
+  :hints(("Goal" :in-theory (enable definition-of-dividesp))))
+
+
+(defthm dividesp-of-minus-when-dividesp
+  (implies (dividesp a b)
+           (equal (dividesp a (- b c))
+                  (if (< b c)
+                      t
+                    (dividesp a c))))
+  :hints(("Goal"
+          :in-theory (enable dividesp)
+          :induct (dividesp a b))))
+
+
+(defthm equal-zero-of-left-when-dividesp-free
+  (implies (dividesp a b)
+           (equal (equal 0 a)
+                  nil)))
+
+(defthm natp-of-left-when-dividesp-free
+  (implies (dividesp a b)
+           (equal (natp a)
+                  t)))
+
+(defthm positive-of-left-when-dividesp-free
+  (implies (dividesp a b)
+           (equal (< 0 a)
+                  t)))
+
+
+
+
+(defthm crock
+  (implies (and (natp b)
+                (not (equal b 0))
+                (not (< c b)))
+           (equal (< b c)
+                  (not (equal b c))))
+  :hints(("Goal"
+          :use ((:instance trichotomy-of-<
+                           (a b) (b c))))))
+
+(defthm crock2
+  (implies (and (< c b)
+                (< b (+ a c))
+                (dividesp a b))
+           (not (dividesp a c)))
+  :hints(("Goal" :in-theory (enable definition-of-dividesp))))
+
+
+
+(defthm dividesp-of-times-when-divides-left
+  (implies (dividesp a b)
+           (equal (dividesp a (* b c))
+                  t))
+  :hints(("Goal"
+          :induct (dec-induction b)
+          :in-theory (enable definition-of-dividesp))))
+
+(defthm dividesp-mod-when-divides-both
+  (implies (and (dividesp a b)
+                (dividesp a c))
+           (dividesp a (mod b c)))
+  :hints(("Goal"
+          :in-theory (enable dividesp mod)
+          :induct (mod b c))))
+
+(defthm transitivity-of-dividesp
+  (implies (and (dividesp a b)
+                (dividesp b c))
+           (equal (dividesp a c)
+                  t))
+  :hints(("Goal"
+          :in-theory (enable definition-of-dividesp))))
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/expt.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/expt.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/expt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/expt.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,173 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "multiply")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm natp-of-expt
+  (equal (natp (expt a n))
+         t)
+  :hints(("Goal" :expand (expt a n))))
+
+(defthm expt-when-not-natp-left-cheap
+  (implies (not (natp a))
+           (equal (expt a n)
+                  (if (zp n)
+                      1
+                    0)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (expt a n))))
+
+(defthm expt-when-not-natp-right-cheap
+  (implies (not (natp n))
+           (equal (expt a n)
+                  1))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (expt a n))))
+
+(defthm expt-when-zp-left-cheap
+  (implies (zp a)
+           (equal (expt a n)
+                  (if (zp n)
+                      1
+                    0)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (expt a n))))
+
+(defthm expt-when-zp-right-cheap
+  (implies (zp n)
+           (equal (expt a n)
+                  1))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (expt a n))))
+
+(defthm |(expt 0 n)|
+  (equal (expt 0 n)
+         (if (zp n)
+             1
+           0)))
+
+(defthm |(expt a 0)|
+  (equal (expt a 0)
+         1))
+
+(defthm |(expt (nfix a) n)|
+  (equal (expt (nfix a) n)
+         (expt a n))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm |(expt a (nfix n))|
+  (equal (expt a (nfix n))
+         (expt a n))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm |(expt 1 n)|
+  (equal (expt 1 n)
+         1)
+  :hints(("Goal"
+          :induct (dec-induction n)
+          :expand (expt 1 n))))
+
+(defthm |(expt n 1)|
+  (equal (expt n 1)
+         (nfix n))
+  :hints(("Goal" :expand (expt n 1))))
+
+(defthm |(= 0 (expt a n))|
+  (equal (equal 0 (expt a n))
+         (and (zp a)
+              (not (zp n))))
+  :hints(("Goal"
+          :induct (dec-induction n)
+          :expand (expt a n))))
+
+(defthmd lemma-for-expt-of-plus-right
+  (equal (expt a (+ 1 n))
+         (* a (expt a n)))
+  :hints(("Goal"
+          :induct (dec-induction n)
+          :expand ((expt a (+ 1 n))
+                   (expt a 2)))))
+
+(defthm |(expt a (+ n m))|
+  (equal (expt a (+ n m))
+         (* (expt a n)
+            (expt a m)))
+  :hints(("Goal"
+          :induct (dec-induction m)
+          :in-theory (enable lemma-for-expt-of-plus-right)
+          :expand ((expt a (+ m n))
+                   (expt a m)))))
+
+(defthm |(< a (expt a n))|
+  (equal (< a (expt a n))
+         (cond ((zp a) (zp n))
+               ((equal a 1) nil)
+               (t (< 1 n))))
+  :hints(("Goal"
+          :induct (dec-induction n)
+          :expand ((expt a n)
+                   (expt a (- n 1))))))
+
+(defthm |(< (expt a n) a)|
+  (equal (< (expt a n) a)
+         (and (< 1 a)
+              (zp n)))
+  :hints(("Goal"
+          :induct (dec-induction n)
+          :expand (expt a n))))
+
+(defthm |(< (expt a n) (expt a m))|
+  (equal (< (expt a n) (expt a m))
+         (cond ((zp a)      (and (zp m) (not (zp n))))
+               ((equal a 1) nil)
+               (t           (< n m))))
+  :hints(("Goal"
+          :induct (dec-dec-induction n m)
+          :expand ((expt a n)
+                   (expt a m)))))
+
+(defthm |(= 1 (expt a n))|
+  (equal (equal 1 (expt a n))
+         (or (zp n)
+             (equal a 1)))
+  :hints(("Goal"
+          :induct (dec-induction n)
+          :expand (expt a n))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/extended-primitives.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/extended-primitives.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/extended-primitives.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/extended-primitives.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,323 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../primitives")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+;; Extended base functions.
+;;
+;; We also introduce some extended arithmetic support.  This isn't strictly
+;; necessary since we can define these functions in terms of the base
+;; functions.  But, by making these base functions, we can give them far more
+;; efficient Common Lisp implementations.
+
+(definlined * (a b)
+  ;; Multiply a and b.
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::* (nfix a) (nfix b)))
+
+(definlined floor (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (let ((afix (nfix a))
+        (bfix (nfix b)))
+    (if (equal bfix 0)
+        0
+      (COMMON-LISP::floor afix bfix))))
+
+(definlined mod (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (let ((afix (nfix a))
+        (bfix (nfix b)))
+    (if (equal bfix 0)
+        afix
+      (COMMON-LISP::mod afix bfix))))
+
+(definlined expt (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::expt (nfix a) (nfix b)))
+
+(definlined bitwise-shl (a n)
+  ;; Shift a left by n bits.
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::ash (nfix a) (nfix n)))
+
+(definlined bitwise-shr (a n)
+  ;; Shift a right by n bits.
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::ash (nfix a) (COMMON-LISP::- (nfix n))))
+
+(definlined bitwise-and (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::logand (nfix a) (nfix b)))
+
+(definlined bitwise-or (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::logior (nfix a) (nfix b)))
+
+(definlined bitwise-xor (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::logxor (nfix a) (nfix b)))
+
+(definlined bitwise-nth (n a)
+  ;; Is the nth bit of a set?
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::logbitp (nfix n) (nfix a)))
+
+;; Common lisp also provides some other bitwise functions which we do not
+;; support because they are not natural-valued.  For example:
+;;
+;;  (lognand 0 0) = -1
+;;  (lognor 0 0) = -1
+;;  (lognot 0) = -1
+;;  (logorc1 0 0) = -1
+;;  (logorc2 0 0) = -1
+;;  (logeqv 0 0) = -1
+;;
+;; I didn't find an immediate example where logandc1 or logandc2 would produce
+;; a negative value, but I'm not going to add them until someone wants them,
+;; because I think they are weird.
+
+
+
+
+
+
+
+(defun dec-floor2-induction (n a)
+  (declare (xargs :guard t :measure (nfix n)))
+  (if (zp n)
+      a
+    (dec-floor2-induction (- n 1) (floor a 2))))
+
+
+
+;; Axioms for the extended base functions.
+;;
+;; We introduce recursive formulations of each of our extended arithmetic
+;; functions.  This way, we only need one symbolic axiom per added base
+;; function, and everything else is proven from the recursive definition.  It's
+;; vital that we get these right, so we've used ACL2 to prove the equivalence
+;; with our ACL2 definitions.
+
+(encapsulate
+ ()
+ (local (in-theory (enable natp nfix zp < + - * expt floor mod
+                           bitwise-shl bitwise-shr bitwise-and
+                           bitwise-or bitwise-xor bitwise-nth)))
+
+ (local (in-theory (disable ACL2::expt ACL2::floor ACL2::mod
+                            ACL2::ash ACL2::logand
+                            ACL2::logior ACL2::logxor ACL2::logbitp)))
+
+ (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
+ (local (include-book "bitwise-support"))
+
+ (defthmd definition-of-*
+   (equal (* a b)
+          (if (zp a)
+              0
+            (+ b (* (- a 1) b))))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (* a b)
+                              :scheme (dec-induction a))))
+
+ (defthmd definition-of-floor
+   (equal (floor a b)
+          (cond ((zp b) 0)
+                ((< a b) 0)
+                (t (+ 1 (floor (- a b) b)))))
+   :hints(("Goal" :in-theory (disable acl2::prefer-positive-addends-equal)))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (floor a b)
+                              :scheme (sub-induction a b))))
+
+ (defthmd definition-of-mod
+   (equal (mod a b)
+          (cond ((zp b) (nfix a))
+                ((< a b) (nfix a))
+                (t (mod (- a b) b))))
+   :hints(("Goal" :in-theory (disable acl2::prefer-positive-addends-equal)))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (mod a b)
+                              :scheme (sub-induction a b))))
+
+ (defthmd definition-of-expt
+   (equal (expt a b)
+          (if (zp b)
+              1
+            (* a (expt a (- b 1)))))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (expt a b)
+                              :scheme (dec-induction b))))
+
+ (defthmd definition-of-bitwise-shl
+   (equal (bitwise-shl a n)
+          (if (zp n)
+              (nfix a)
+            (* 2 (bitwise-shl a (- n 1)))))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (bitwise-shl a n)
+                              :scheme (dec-induction n)))
+   :hints(("Goal" :in-theory (enable acl2::ash))))
+
+ (defthmd definition-of-bitwise-shr
+   (equal (bitwise-shr a n)
+          (if (zp n)
+              (nfix a)
+            (floor (bitwise-shr a (- n 1)) 2)))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (bitwise-shr a n)
+                              :scheme (dec-induction n)))
+   :hints(("Goal" :in-theory (enable acl2::ash))))
+
+ (encapsulate
+  ()
+  ;; We introduce the floor2-floor2 induction scheme without relying on ACL2
+  ;; arithmetic, so we should be able to recreate this in Milawa.
+  (local (in-theory (disable floor < natp + -)))
+
+  (local (defthm termination-lemma
+           (implies (not (zp a))
+                    (equal (< (floor a 2) a)
+                           t))
+           :hints(("Goal"
+                   :in-theory (e/d (definition-of-floor)
+                                   (floor < natp + -))))))
+
+  (defun floor2-floor2-induction (a b)
+    (declare (xargs :guard t :measure (nfix a)))
+    (if (or (zp a)
+            (zp b))
+        nil
+      (floor2-floor2-induction (floor a 2) (floor b 2)))))
+
+ (defthm definition-of-bitwise-and
+   (equal (bitwise-and a b)
+          (cond ((zp a) 0)
+                ((zp b) 0)
+                (t (+ (if (or (equal (mod a 2) 0)
+                              (equal (mod b 2) 0))
+                          0
+                        1)
+                      (* 2 (bitwise-and (floor a 2) (floor b 2)))))))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (bitwise-and a b)
+                              :scheme (floor2-floor2-induction a b))))
+
+ (defthm definition-of-bitwise-or
+   (equal (bitwise-or a b)
+          (cond ((zp a) (nfix b))
+                ((zp b) (nfix a))
+                (t (+ (if (or (equal (mod a 2) 1)
+                              (equal (mod b 2) 1))
+                          1
+                        0)
+                      (* 2 (bitwise-or (floor a 2) (floor b 2)))))))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (bitwise-or a b)
+                              :scheme (floor2-floor2-induction a b))))
+
+ (defthm definition-of-bitwise-xor
+   (equal (bitwise-xor a b)
+          (cond ((zp a) (nfix b))
+                ((zp b) (nfix a))
+                (t (+ (if (equal (mod a 2) (mod b 2))
+                          0
+                        1)
+                      (* 2 (bitwise-xor (floor a 2) (floor b 2)))))))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (bitwise-xor a b)
+                              :scheme (floor2-floor2-induction a b))))
+
+ (defthm definition-of-bitwise-nth
+   (equal (bitwise-nth n a)
+          (if (zp n)
+              (equal (mod a 2) 1)
+            (bitwise-nth (- n 1) (floor a 2))))
+   :rule-classes ((:definition)
+                  (:induction :corollary t
+                              :pattern (bitwise-nth n a)
+                              :scheme (dec-floor2-induction n a))))
+
+ )
+
+
+;; From this point forward, all reasoning about our extended operations should
+;; be done without referring to their under-the-hood implementations.
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition *))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition expt))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition floor))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition mod))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition bitwise-shl))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition bitwise-shr))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition bitwise-and))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition bitwise-or))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition bitwise-xor))))
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition bitwise-nth))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/floor.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/floor.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/floor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/floor.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,146 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "multiply")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm natp-of-floor
+  (equal (natp (floor a b))
+         t)
+  :hints(("Goal" :expand (floor a b))))
+
+(defthm floor-when-not-natp-left-cheap
+  (implies (not (natp a))
+           (equal (floor a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (floor a b))))
+
+(defthm floor-when-not-natp-right-cheap
+  (implies (not (natp b))
+           (equal (floor a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (floor a b))))
+
+(defthm floor-when-zp-left-cheap
+  (implies (zp a)
+           (equal (floor a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (floor a b))))
+
+(defthm floor-when-zp-right-cheap
+  (implies (zp b)
+           (equal (floor a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (floor a b))))
+
+(defthm |(floor 0 a)|
+  (equal (floor 0 a)
+         0))
+
+(defthm |(floor a 0)|
+  (equal (floor a 0)
+         0))
+
+(defthm floor-when-smaller
+  (implies (< a b)
+           (equal (floor a b)
+                  0))
+  :hints(("Goal" :expand (floor a b))))
+
+(defthm |(floor a a)|
+  (equal (floor a a)
+         (if (zp a)
+             0
+           1))
+  :hints(("Goal" :expand (floor a a))))
+
+(defthm |(floor 1 a)|
+  (equal (floor 1 a)
+         (if (equal a 1)
+             1
+           0))
+  :hints(("Goal" :expand (floor 1 a))))
+
+(defthm |(floor a 1)|
+  (equal (floor a 1)
+         (nfix a))
+  :hints(("Goal"
+          :induct (sub-induction a 1)
+          :expand (floor a 1))))
+
+(defthm |(< a (floor a b))|
+  (equal (< a (floor a b))
+         nil)
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand (floor a b))))
+
+(defthm |(< (floor a b) a)|
+  (equal (< (floor a b) a)
+         (cond ((zp a) nil)
+               ((zp b) t)
+               ((equal a 1) (< a b))
+               ((equal b 1) nil)
+               (t t)))
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand (floor a b))))
+
+(defthm |(floor (* a b) b)|
+  (equal (floor (* a b) b)
+         (if (zp b)
+             0
+           (nfix a)))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand (floor (* a b) b))))
+
+(defthm |(floor (* a b) a)|
+  (equal (floor (* a b) a)
+         (if (zp a)
+             0
+           (nfix b)))
+  :hints(("Goal"
+          :in-theory (disable |(floor (* a b) b)|)
+          :use ((:instance |(floor (* a b) b)| (a b) (b a))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/log2.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/log2.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/log2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/log2.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,81 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "shift")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; We say log2(0) = 0, and for all other n we say log2(n) is the maximum k such
+;; that 2^k <= n.  For example:
+;;
+;;     n           Log2(n)      2^Log2(n)
+;;    ------------------------------------------------
+;;     0-1         0            1
+;;     2-3         1            2
+;;     4-7         2            4
+;;     8-15        3            8
+;;     16-31       4            16
+;;     ...
+;;    ------------------------------------------------
+
+(defun fast-log2 (n acc)
+  (declare (xargs :guard (and (natp n)
+                              (natp acc))
+                  :measure (nfix n)))
+  (if (or (zp n)
+          (equal n 1))
+      acc
+    (fast-log2 (bitwise-shr n 1) (+ 1 acc))))
+
+(definlined log2 (n)
+  (declare (xargs :guard (natp n)))
+  (fast-log2 n 0))
+
+(encapsulate
+ ()
+ (local (defthm natp-of-fast-log2
+          (implies (force (natp acc))
+                   (equal (natp (fast-log2 n acc))
+                          t))
+          :hints(("Goal" :in-theory (enable fast-log2)))))
+
+ (defthm natp-of-log2
+   (equal (natp (log2 n))
+          t)
+   :hints(("Goal" :in-theory (enable log2)))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/mod.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/mod.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/mod.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/mod.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,260 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "floor")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm natp-of-mod
+  (equal (natp (mod a b))
+         t)
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand (mod a b))))
+
+(defthm mod-when-not-natp-left-cheap
+  (implies (not (natp a))
+           (equal (mod a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (mod a b))))
+
+(defthm mod-when-not-natp-right-cheap
+  (implies (not (natp b))
+           (equal (mod a b)
+                  (nfix a)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (mod a b))))
+
+(defthm mod-when-zp-left-cheap
+  (implies (zp a)
+           (equal (mod a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (mod a b))))
+
+(defthm mod-when-zp-right-cheap
+  (implies (zp b)
+           (equal (mod a b)
+                  (nfix a)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (mod a b))))
+
+(defthm mod-of-nfix-left
+  (equal (mod (nfix a) b)
+         (mod a b))
+  :hints(("Goal" :expand ((mod (nfix a) b)
+                          (mod a b)))))
+
+(defthm mod-of-nfix-right
+  (equal (mod a (nfix b))
+         (mod a b))
+  :hints(("Goal" :expand ((mod a (nfix b))
+                          (mod a b)))))
+
+(defthm |(mod 0 a)|
+  (equal (mod 0 a)
+         0))
+
+(defthm |(mod a 0)|
+  (equal (mod a 0)
+         (nfix a)))
+
+(defthm |(mod a 1)|
+  (equal (mod a 1)
+         0)
+  :hints(("Goal"
+          :induct (sub-induction a 1)
+          :expand (mod a 1))))
+
+(defthm |(mod 1 a)|
+  (equal (mod 1 a)
+         (if (equal a 1)
+             0
+           1))
+  :hints(("Goal" :expand (mod 1 a))))
+
+(defthm mod-when-in-range
+  (implies (< a b)
+           (equal (mod a b)
+                  (nfix a)))
+  :hints(("Goal" :expand (mod a b))))
+
+(defthm floor-mod-elim
+  (equal (+ (mod a b) (* b (floor a b)))
+         (nfix a))
+  :hints(("Goal"
+          :expand ((mod a b)
+                   (floor a b))
+          :induct (sub-induction a b))))
+
+(defthm |(< a (* b (floor a b)))|
+  (equal (< a (* b (floor a b)))
+         nil)
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand (floor a b))))
+
+(defthm |(< (* b (floor a b)) a)|
+  (equal (< (* b (floor a b)) a)
+         (not (equal (mod a b) 0)))
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand ((floor a b)
+                   (mod a b)))))
+
+(defthmd eliminate-mod
+  (equal (mod a b)
+         (- a (* b (floor a b)))))
+
+(defthm |(< a (mod a b))|
+  (equal (< a (mod a b))
+         nil)
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand (mod a b))))
+
+(defthm |(< b (mod a b))|
+  (equal (< b (mod a b))
+         (and (zp b)
+              (not (zp a))))
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand (mod a b))))
+
+(defthm |(< (mod a b) b)|
+  (equal (< (mod a b) b)
+         (not (zp b)))
+  :hints(("Goal"
+          :induct (sub-induction a b)
+          :expand (mod a b))))
+
+(defthm |(< (mod a b) a)|
+  (equal (< (mod a b) a)
+         (if (zp b)
+             nil
+           (not (< a b)))))
+
+(defthm |(mod a a)|
+  (equal (mod a a)
+         0)
+  :hints(("Goal" :expand (mod a a))))
+
+(defthm |(mod (+ a b) b)|
+  (equal (mod (+ a b) b)
+         (mod a b))
+  :hints(("Goal" :expand (mod (+ a b) b))))
+
+(defthm |(mod (- a b) b)|
+  (equal (mod (- a b) b)
+         (if (< a b)
+             0
+           (mod a b)))
+  :hints(("Goal" :expand (mod a b))))
+
+
+
+
+#|
+
+
+(defun my-induction (a b x)
+  (declare (xargs :measure (nfix a)))
+  (cond ((zp x) nil)
+        ((or (zp a)
+             (zp b))
+         nil)
+        (t
+         (my-induction (- a x) (- b x) x))))
+
+
+;; (defthm crock
+;;   (equal (equal (mod (- b a) x) 0)
+;;          (equal (mod b x) a)))
+
+(defthm subcrock
+  (implies (and (not (zp x))
+                (not (< b x)))
+           (equal (< b (+ x (mod b x)))
+                  nil))
+  :hints(("Goal"
+          :cases ((equal b x))
+          :do-not-induct t)
+         ("Subgoal 2"
+          :in-theory (disable floor-mod-elim)
+          :do-not '(generalize)
+          :use ((:instance floor-mod-elim (a b) (b x)))))
+
+  :otf-flg t)
+
+
+(defthm crock
+  (implies (and (not (zp x))
+                (equal (mod b x) a))
+           (equal (mod (- b a) x)
+                  0))
+  :hints(("Goal" :induct (mod b x))))
+
+(defthm my-lemma
+  (implies (and (not (zp x))
+                (equal (mod a x) result))
+           (equal (equal (mod b x) result)
+                  (if (< a b)
+                      (equal (mod (- b a) x) 0)
+                    (equal (mod (- a b) x) 0))))
+  :hints(("Goal"
+          :induct (my-induction a b x))))
+
+
+(defthm crock
+  (implies (and (natp b)
+                (not (equal b 0))
+                (not (< c b)))
+           (equal (< b c)
+                  (not (equal b c))))
+  :hints(("Goal"
+          :use ((:instance trichotomy-of-<
+                           (a b) (b c))))))
+
+(defthm |(mod (+ a b) x)|
+  (implies (< (+ (mod a x) (mod b x)) x)
+           (equal (mod (+ a b) x)
+                  (+ (mod a x) (mod b x))))
+  :hints(("Goal" :in-theory (enable definition-of-mod))))
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/multiply.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/multiply.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/multiply.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/multiply.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,232 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "extended-primitives")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defthm natp-of-*
+  (equal (natp (* a b))
+         t)
+  :hints(("Goal" :expand (* a b))))
+
+(defthm *-when-not-natp-left-cheap
+  (implies (not (natp a))
+           (equal (* a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (* a b))))
+
+(defthm *-when-not-natp-right-cheap
+  (implies (not (natp b))
+           (equal (* a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand (* a b))))
+
+(defthm *-when-zp-left-cheap
+  (implies (zp a)
+           (equal (* a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :expand (* a b))))
+
+(defthm *-when-zp-right-cheap
+  (implies (zp b)
+           (equal (* a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand (* a b))))
+
+(defthm |(* 0 a)|
+  (equal (* 0 a)
+         0)
+  :hints(("Goal" :expand (* 0 a))))
+
+(defthm |(* a 0)|
+  (equal (* a 0)
+         0)
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand (* a 0))))
+
+(defthm |(* (nfix a) b)|
+  (equal (* (nfix a) b)
+         (* a b))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm |(* a (nfix b))|
+  (equal (* a (nfix b))
+         (* a b))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm |(* 1 a)|
+  (equal (* 1 a)
+         (nfix a))
+  :hints(("Goal" :expand (* 1 a))))
+
+(defthm |(* a 1)|
+  (equal (* a 1)
+         (nfix a))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand (* a 1))))
+
+(defthm |(equal (* a b) 0)|
+  (equal (equal (* a b) 0)
+         (or (zp a)
+             (zp b)))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand (* a b))))
+
+(defthm |(* (+ a c) b)|
+  (equal (* (+ a c) b)
+         (+ (* a b) (* c b)))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand ((* (+ 1 c) b)
+                   (* (+ a c) b)
+                   (* a b)))))
+
+(defthm |(* a (+ b c))|
+  (equal (* a (+ b c))
+         (+ (* a b) (* a c)))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand ((* a (+ b c))
+                   (* a b)
+                   (* a c)))))
+
+(defthm |(* (- a b) c)|
+  (equal (* (- a b) c)
+         (- (* a c) (* b c)))
+  :hints(("Goal"
+          :induct (dec-dec-induction a b)
+          :expand ((* (- a b) c)
+                   (* a c)
+                   (* b c)))))
+
+(defthm |(* a (- b c))|
+  (equal (* a (- b c))
+         (- (* a b) (* a c)))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand ((* a b)
+                   (* a c)
+                   (* a (- b c)))
+          :in-theory (disable |(* (- a b) c)|)
+          :do-not-induct t)))
+
+(defthm |(< a (* a b))|
+  (equal (< a (* a b))
+         (and (not (zp a))
+              (< 1 b)))
+  :hints(("Goal" :induct (dec-induction a))))
+
+(defthm |(< b (* a b))|
+  (equal (< b (* a b))
+         (and (not (zp b))
+              (< 1 a)))
+  :hints(("Goal"
+          :induct (dec-induction a)
+          :expand (* a b)
+          :in-theory (disable |(* (- a b) c)|))))
+
+(defthm |(< (* a b) a)|
+  (equal (< (* a b) a)
+         (and (not (zp a))
+              (zp b)))
+  :hints(("Goal" :induct (dec-induction a))))
+
+(defthm |(< (* a b) b)|
+  (equal (< (* a b) b)
+         (and (not (zp b))
+              (zp a)))
+  :hints(("Goal" :induct (dec-induction a))))
+
+(defthm |(< (* a c) (* b c))|
+  (equal (< (* a c) (* b c))
+         (and (< a b)
+              (not (zp c))))
+  :hints(("Goal" :induct (dec-dec-induction a b))))
+
+(defthm |(< (* a b) (* a c))|
+  (equal (< (* a b) (* a c))
+         (and (< b c)
+              (not (zp a))))
+  :hints(("Goal" :induct (dec-induction a))))
+
+(defthm associativity-of-*
+  (equal (* (* a b) c)
+         (* a (* b c)))
+  :hints(("Goal" :induct (dec-induction a))))
+
+(defthm commutativity-of-*
+  (equal (* a b)
+         (* b a))
+  :hints(("Goal" :induct (dec-induction a))))
+
+(defthm commutativity-of-*-two
+  (equal (* a (* b c))
+         (* b (* a c)))
+  :hints(("Goal" :use ((:instance commutativity-of-* (a a) (b (* b c)))))))
+
+(defthm |(= a (* a b))|
+  (equal (equal a (* a b))
+         (if (zp a)
+             (natp a)
+           (equal b 1)))
+  :hints(("Goal"
+          :expand ((* a b)
+                   (* b (- a 1)))
+          :in-theory (disable |(* a (- b c))|))))
+
+(defthm |(= 1 (* a b))|
+  (equal (equal 1 (* a b))
+         (and (equal a 1)
+              (equal b 1)))
+  :hints(("Goal"
+          :expand ((* a b))
+          :use ((:instance |(* a (- b c))| (a b) (b a) (c 1)))
+          :in-theory (disable |(* a (- b c))|))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/primep.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/primep.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/primep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/primep.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,234 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "dividesp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(defthm |(< a 2) when not 1|
+  (implies (not (equal a 1))
+           (equal (< a 2)
+                  (zp a)))
+  :hints(("Goal" :use ((:instance squeeze-law-three (a 1) (b a))))))
+
+;; (defthm |(< n 2) when non-zp and not 1|
+;;   (implies (and (not (zp n))
+;;                 (not (equal n 1)))
+;;            (equal (< n 2)
+;;                   nil))
+;;   :hints(("Goal" :use ((:instance squeeze-law-three (a 1) (b n))))))
+
+
+(defund aux-smallest-prime-factor (i n)
+  ;; Returns the smallest factor of n which is greater than i.  In degenerate
+  ;; cases where i > n, we just return n.
+  (declare (xargs :measure (nfix (- n i))
+                  :guard (and (natp i)
+                              (natp n)
+                              (<= i n))))
+
+  (if (<= n i)
+      (nfix n)
+    (if (dividesp i n)
+        (nfix i)
+      (aux-smallest-prime-factor (+ 1 i) n))))
+
+(defund smallest-prime-factor (n)
+  (declare (xargs :guard (and (natp n)
+                              (not (zp n))
+                              (not (equal n 1)))))
+  (if (or (zp n)
+          (equal n 1))
+      nil
+    (aux-smallest-prime-factor 2 n)))
+
+(defthm natp-of-aux-smallest-prime-factor
+  (equal (natp (aux-smallest-prime-factor i n))
+         t)
+  :hints(("Goal" :in-theory (enable aux-smallest-prime-factor))))
+
+(defthm natp-of-smallest-prime-factor
+  (implies (force (and (not (zp n))
+                       (not (equal n 1))))
+           (equal (natp (smallest-prime-factor n))
+                  t))
+  :hints(("Goal" :in-theory (enable smallest-prime-factor))))
+
+(defthmd lemma-for-dividesp-when-no-aux-smallest-prime-factor
+  (implies (and (equal (nfix d) (nfix i))
+                (syntaxp (ACL2::term-order d i)))
+           (equal (dividesp i n)
+                  (dividesp d n)))
+  :hints(("Goal"
+          :in-theory (disable dividesp-of-nfix-left)
+          :use ((:instance dividesp-of-nfix-left
+                           (a d) (b n))
+                (:instance dividesp-of-nfix-left
+                           (a i) (b n))))))
+
+(defthmd dividesp-when-no-aux-smallest-prime-factor
+  (implies (and (equal (aux-smallest-prime-factor i n) n)
+                (<= i d)
+                (< d n))
+           (equal (dividesp d n)
+                  nil))
+  :hints(("Goal"
+          :induct (aux-smallest-prime-factor i n)
+          :in-theory (enable aux-smallest-prime-factor
+                             lemma-for-dividesp-when-no-aux-smallest-prime-factor))))
+
+(defthmd dividesp-when-smallest-prime-factor-is-n
+  (implies (and (not (zp n))
+                (not (equal n 1))
+                (equal (smallest-prime-factor n) n))
+           (equal (dividesp d n)
+                  (or (equal d 1)
+                      (equal d n))))
+  :hints(("Goal"
+          :in-theory (enable smallest-prime-factor)
+          :use ((:instance dividesp-when-no-aux-smallest-prime-factor
+                           (i 2))))))
+
+
+
+(defund primep (n)
+  (declare (xargs :guard (natp n)))
+  (and (not (zp n))
+       (not (equal n 1))
+       (not (equal (smallest-prime-factor n) n))))
+
+(defthm booleanp-of-primep
+  (equal (booleanp (primep n))
+         t)
+  :hints(("Goal" :in-theory (enable primep))))
+
+#|
+
+
+(i-am-here)
+
+(defthm dividesp-when-primep
+  (implies (primep n)
+           (equal (dividesp d n)
+                  (or (equal d 1)
+                      (equal d n))))
+  :hints(("Goal"
+          :in-theory (enable primep)
+          :use ((:instance dividesp-when-smallest-prime-factor-is-n)))))
+
+
+
+
+
+
+
+
+
+
+(defund aux-primep (i n)
+  ;; This is an inefficient primality check via trial division.  We check if n
+  ;; has any divisors in [2, ..., i].
+  (declare (xargs :guard (and (natp i)
+                              (natp n))
+                  :measure (nfix i)))
+  (or (zp i)
+      (equal i 1)
+      (and (not (dividesp i n))
+           (aux-primep (- i 1) n))))
+
+(defund primep (n)
+  ;; We return true if n is a prime number in the true mathematical sense.  That
+  ;; is, [2, 3, 5, 7, ...] are primes, but 0 and 1 are not.
+  (declare (xargs :guard (natp n)))
+  (and (not (zp n))
+       (not (equal n 1))
+       (aux-primep (- n 1) n)))
+
+(defthm booleanp-of-aux-primep
+  (equal (booleanp (aux-primep i n))
+         t)
+  :hints(("Goal"
+          :induct (dec-induction i)
+          :expand (aux-primep i n))))
+
+(defthm booleanp-of-primep
+  (equal (booleanp (primep n))
+         t)
+  :hints(("Goal" :in-theory (enable primep))))
+
+(defthmd dividesp-when-in-aux-primep-range
+  (implies (and (aux-primep i n)
+                (< 1 d)
+                (<= d i))
+           (equal (dividesp d n)
+                  nil))
+  :hints(("Goal"
+          :induct (dec-induction i)
+          :expand ((aux-primep i n)
+                   (aux-primep d n)))))
+
+(defthm dividesp-when-primep
+  (implies (primep n)
+           (equal (dividesp d n)
+                  (or (equal d 1)
+                      (equal d n))))
+  :hints(("Goal"
+          :in-theory (enable primep)
+          :use ((:instance dividesp-when-in-aux-primep-range
+                           (i (- n 1)))))))
+
+
+(defthm primep-of-smallest-prime-factor
+  (implies (force (and (not (zp n))
+                       (not (equal n 1))))
+           (equal (primep (smallest-prime-factor n))
+                  t))
+  :hints(("Goal" :in-theory (enable smallest-prime-factor))))
+
+
+(smallest-prime-factor 3)
+(smallest-prime-factor 17)
+
+
+(defun factor (n)
+  (if (primep n)
+      nil
+
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/arithmetic/shift.lisp acl2-6.3/books/milawa/ACL2/utilities/arithmetic/shift.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/arithmetic/shift.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/arithmetic/shift.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,152 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "expt")
+(include-book "floor")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(local (in-theory (enable definition-of-bitwise-shl
+                          definition-of-bitwise-shr)))
+
+
+;; One option for reasoning about shifting operations is to just remove them
+;; entirely by nonrecursively redefining them in terms of floor, *, and expt.
+;; To do this, just enable the following theorems.
+
+(defthmd bitwise-shl-as-expt
+  (equal (bitwise-shl a n)
+         (* (expt 2 n) a))
+  :hints(("Goal" :in-theory (enable definition-of-expt))))
+
+;; BOZO prove me
+;; (defthmd bitwise-shr-as-expt
+;;    (equal (bitwise-shr a n)
+;;           (floor a (expt 2 n)))
+;;    :hints(("Goal" :in-theory (enable definition-of-expt))))
+
+
+
+;; Otherwise, you can leave the functions in and reason about them directly.
+
+(defthm natp-of-bitwise-shl
+  (equal (natp (bitwise-shl a n))
+         t))
+
+(defthm bitwise-shl-when-not-natp-left-cheap
+  (implies (not (natp a))
+           (equal (bitwise-shl a n)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm bitwise-shl-when-not-natp-right-cheap
+  (implies (not (natp n))
+           (equal (bitwise-shl a n)
+                  (nfix a)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm |(bitwise-shl 0 n)|
+  (equal (bitwise-shl 0 n)
+         0))
+
+(defthm |(bitwise-shl a 0)|
+  (equal (bitwise-shl a 0)
+         (nfix a)))
+
+(defthm |(bitwise-shl (nfix a) n)|
+  (equal (bitwise-shl (nfix a) n)
+         (bitwise-shl a n)))
+
+(defthm |(bitwise-shl a (nfix n))|
+  (equal (bitwise-shl a (nfix n))
+         (bitwise-shl a n)))
+
+(defthm bitwise-shl-of-bitwise-shl
+  (equal (bitwise-shl (bitwise-shl a n) m)
+         (bitwise-shl a (+ n m)))
+  :hints(("Goal" :in-theory (enable bitwise-shl-as-expt))))
+
+(defthm |(= a (bitwise-shl a n))|
+  (equal (equal a (bitwise-shl a n))
+         (if (zp a)
+             (natp a)
+           (zp n)))
+  :hints(("Goal" :in-theory (enable bitwise-shl-as-expt))))
+
+
+
+
+(defthm natp-of-bitwise-shr
+  (equal (natp (bitwise-shr a n))
+         t))
+
+(defthm bitwise-shr-when-not-natp-left-cheap
+  (implies (not (natp a))
+           (equal (bitwise-shr a n)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm bitwise-shr-when-not-natp-right-cheap
+  (implies (not (natp n))
+           (equal (bitwise-shr a n)
+                  (nfix a)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm |(bitwise-shr 0 n)|
+  (equal (bitwise-shr 0 n)
+         0))
+
+(defthm |(bitwise-shr a 0)|
+  (equal (bitwise-shr a 0)
+         (nfix a)))
+
+(defthm |(bitwise-shr (nfix a) n)|
+  (equal (bitwise-shr (nfix a) n)
+         (bitwise-shr a n)))
+
+(defthm |(bitwise-shr a (nfix n))|
+  (equal (bitwise-shr a (nfix n))
+         (bitwise-shr a n)))
+
+(defthm |(< (bitwise-shr a n) a)|
+  (equal (< (bitwise-shr a n) a)
+         (and (not (zp a))
+              (not (zp n))))
+  :hints(("Goal"
+          :in-theory (enable definition-of-bitwise-shr)
+          :induct (dec-induction n))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/cert.acl2 acl2-6.3/books/milawa/ACL2/utilities/cert.acl2
--- acl2-6.2/books/milawa/ACL2/utilities/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/cert.acl2	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,37 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "ACL2")
+(ld "../cert.acl2")
+; cert-flags: ? t :ttags :all :skip-proofs-okp t :defaxioms-okp t
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/clean-update.lisp acl2-6.3/books/milawa/ACL2/utilities/clean-update.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/clean-update.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/clean-update.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,66 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund clean-update (key val map)
+  ;; BOZO move to utilities
+  ;;
+  ;; This is like (update key val map), but it does the update "in place"
+  ;; instead of consing onto the front of the list.
+  (declare (xargs :guard (mapp map)))
+  (if (consp map)
+      (if (equal (car (car map)) key)
+          (cons (cons key val) (cdr map))
+        (cons (car map) (clean-update key val (cdr map))))
+    (list (cons key val))))
+
+(defthm clean-update-when-not-consp
+  (implies (not (consp map))
+           (equal (clean-update key val map)
+                  (list (cons key val))))
+  :hints(("Goal" :in-theory (enable clean-update))))
+
+(defthm clean-update-of-cons
+  (equal (clean-update key val (cons a map))
+         (if (equal (car a) key)
+             (cons (cons key val) map)
+           (cons a
+                 (clean-update key val map))))
+  :hints(("Goal" :in-theory (enable clean-update))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/cons-listp.lisp acl2-6.3/books/milawa/ACL2/utilities/cons-listp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/cons-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/cons-listp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(deflist cons-listp (x)
+  (consp x)
+  :elementp-of-nil nil)
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/cons-onto-ranges.lisp acl2-6.3/books/milawa/ACL2/utilities/cons-onto-ranges.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/cons-onto-ranges.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/cons-onto-ranges.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,96 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; (cons-onto-ranges a x)
+;;
+;; X is a map.  We produce a new map whose entries are (key . (a . value))
+;; for every (key . value) pair in x.
+
+;; BOZO tail recursive version?
+
+;; BOZO more complete theory?
+
+(defund cons-onto-ranges (a x)
+  (declare (xargs :guard (mapp x)))
+  (if (consp x)
+      (cons (cons (car (car x))
+                  (cons a (cdr (car x))))
+            (cons-onto-ranges a (cdr x)))
+    nil))
+
+(defthm cons-onto-ranges-when-not-consp
+  (implies (not (consp x))
+           (equal (cons-onto-ranges a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable cons-onto-ranges))))
+
+(defthm cons-onto-ranges-of-cons
+  (equal (cons-onto-ranges a (cons b x))
+         (cons (cons (car b) (cons a (cdr b)))
+               (cons-onto-ranges a x)))
+  :hints(("Goal" :in-theory (enable cons-onto-ranges))))
+
+(defthm cons-onto-ranges-of-list-fix
+  (equal (cons-onto-ranges a (list-fix x))
+         (cons-onto-ranges a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-cons-onto-ranges
+  (equal (true-listp (cons-onto-ranges a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-onto-ranges-of-app
+  (equal (cons-onto-ranges a (app x y))
+         (app (cons-onto-ranges a x)
+              (cons-onto-ranges a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm mapp-of-cons-onto-ranges
+  (equal (mapp (cons-onto-ranges a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm domain-of-cons-onto-ranges
+  (equal (domain (cons-onto-ranges a x))
+         (domain x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/defaggregate.lisp acl2-6.3/books/milawa/ACL2/utilities/defaggregate.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/defaggregate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/defaggregate.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,400 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "symbol-listp")
+(include-book "tuple-listp")
+(include-book "cons-listp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (defaggregate name
+;;   (field1 ... fieldN)
+;;   :require ((natp-of-field1            (natp field1))
+;;             (less-of-field1-and-field2 (< field1 field2))
+;;              ...
+;;             (barp-of-fieldN            (barp fieldN)))
+;;   :legiblep t)
+
+(defun constructor-name (base-name)
+  (declare (xargs :mode :program))
+  base-name)
+
+(defun accessor-name (base-name field)
+  (declare (xargs :mode :program))
+  (ACL2::mksym base-name '-> field))
+
+(defun recognizer-name (base-name)
+  (declare (xargs :mode :program))
+  (ACL2::mksym base-name 'p))
+
+
+
+;; We can lay out the components of the structure in either "legibly" by using
+;; maps with named keys, or "illegibly" by using a tree structure.  Illegible
+;; structures are more efficient, but are not very convenient when you are
+;; trying to debug your code.  By default, we lay out the structure legibly.
+
+(defun illegible-split-fields (fields)
+  ;; Convert a linear list of fields into a balanced tree with the same fields
+  (declare (xargs :mode :program))
+  (let ((length (len fields)))
+    (cond ((equal length 1)
+           (first fields))
+          ((equal length 2)
+           (cons (first fields) (second fields)))
+          (t
+           (let* ((halfway   (ACL2::floor length 2))
+                  (firsthalf (ACL2::take halfway fields))
+                  (lasthalf  (ACL2::nthcdr halfway fields)))
+             (cons (illegible-split-fields firsthalf)
+                   (illegible-split-fields lasthalf)))))))
+
+(defun illegible-fields-map-aux (split-fields path)
+  ;; Convert the balanced tree into a map from field names to paths, e.g.,
+  ;; field1 might be bound to (car (car x)), field2 to (cdr (car x)), etc.
+  (declare (xargs :mode :program))
+  (if (consp split-fields)
+      (fast-app (illegible-fields-map-aux (car split-fields) `(car ,path))
+                (illegible-fields-map-aux (cdr split-fields) `(cdr ,path)))
+    (list (cons split-fields path))))
+
+(defun illegible-fields-map (fields)
+  ;; Convert a linear list of fields into a map from field names to paths.
+  (declare (xargs :mode :program))
+  (illegible-fields-map-aux (illegible-split-fields fields) 'x))
+
+(defun illegible-structure-checks-aux (split-fields path)
+  ;; Convert the balanced tree into a list of the consp checks we'll need.
+  (declare (xargs :mode :program))
+  (if (consp split-fields)
+      (cons `(consp ,path)
+            (app (illegible-structure-checks-aux (car split-fields) `(car ,path))
+                 (illegible-structure-checks-aux (cdr split-fields) `(cdr ,path))))
+    nil))
+
+(defun illegible-structure-checks (fields)
+  ;; Convert a linear list of fields into the consp checks we'll need.
+  (declare (xargs :mode :program))
+  (illegible-structure-checks-aux (illegible-split-fields fields) 'x))
+
+(defun illegible-pack-aux (split-fields)
+  ;; Convert the tree of split fields into a cons tree for building the struct.
+  (declare (xargs :mode :program))
+  (if (consp split-fields)
+      `(cons ,(illegible-pack-aux (car split-fields))
+             ,(illegible-pack-aux (cdr split-fields)))
+    split-fields))
+
+(defun illegible-pack-fields (fields)
+  ;; Convert a linear list of fields into consing code
+  (declare (xargs :mode :program))
+  (illegible-pack-aux (illegible-split-fields fields)))
+
+
+
+(defun legible-fields-map (fields)
+  ;; Convert a linear list of fields into a map from field names to paths.
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons (cons (car fields) `(cdr (lookup ',(car fields) x)))
+            (legible-fields-map (cdr fields)))
+    nil))
+
+(defun legible-pack-fields-aux (fields)
+  ;; Convert a linear list of fields into the pairs for a list operation
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons `(cons ',(car fields) ,(car fields))
+            (legible-pack-fields-aux (cdr fields)))
+    nil))
+
+(defun legible-pack-fields (fields)
+  ;; Convert a linear list of fields into consing code for a legible map
+  (declare (xargs :mode :program))
+  `(list ,@(legible-pack-fields-aux fields)))
+
+
+
+(defun fields-map (legiblep fields)
+  ;; Create a fields map of the appropriate type
+  (declare (xargs :mode :program))
+  (if legiblep
+      (legible-fields-map fields)
+    (illegible-fields-map fields)))
+
+(defun pack-fields (legiblep fields)
+  ;; Create a fields map of the appropriate type
+  (declare (xargs :mode :program))
+  (if legiblep
+      (legible-pack-fields fields)
+    (illegible-pack-fields fields)))
+
+(defun structure-checks (legiblep fields)
+  ;; Check that the object has the appropriate cons structure
+  (declare (xargs :mode :program))
+  (if legiblep
+      '((mapp x)
+        (consp x))
+    (illegible-structure-checks fields)))
+
+
+
+(defun fields-map-let-bindings (map)
+  ;; Convert a fields map into a list of let bindings
+  (declare (xargs :mode :program))
+  (if (consp map)
+      (let* ((entry (car map))
+             (field (car entry))
+             (path  (cdr entry)))
+        (cons (list field path)
+              (fields-map-let-bindings (cdr map))))
+    nil))
+
+(defun make-constructor (name fields require legiblep)
+  (declare (xargs :mode :program))
+  `(definlined ,(constructor-name name) ,fields
+    (declare (xargs :guard (and ,@(strip-seconds require))))
+    ,(pack-fields legiblep fields)))
+
+(defun make-recognizer (name fields require legiblep)
+  (declare (xargs :mode :program))
+  `(defund ,(recognizer-name name) (x)
+     (declare (xargs :guard t))
+     (and ,@(structure-checks legiblep fields)
+          (let ,(fields-map-let-bindings (fields-map legiblep fields))
+            (declare (ACL2::ignorable ,@fields))
+            (and ,@(strip-seconds require))))))
+
+(defun make-accessor (name field map)
+  (declare (xargs :mode :program))
+  `(definlined ,(accessor-name name field) (x)
+     (declare (xargs :guard (,(recognizer-name name) x)
+                     :guard-hints (("Goal" :in-theory (enable ,(recognizer-name name))))))
+     ,(cdr (lookup field map))))
+
+(defun make-accessors-aux (name fields map)
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons (make-accessor name (car fields) map)
+            (make-accessors-aux name (cdr fields) map))
+    nil))
+
+(defun make-accessors (name fields legiblep)
+  (declare (xargs :mode :program))
+  (make-accessors-aux name fields (fields-map legiblep fields)))
+
+(defun make-accessor-of-constructor (name field all-fields)
+  (declare (xargs :mode :program))
+  `(defthm ,(ACL2::mksym (accessor-name name field) '-of- (constructor-name name))
+     (equal (,(accessor-name name field) (,(constructor-name name) ,@all-fields))
+            ,field)
+     :hints(("Goal" :in-theory (enable ,(accessor-name name field)
+                                       ,(constructor-name name))))))
+
+(defun make-accessors-of-constructor-aux (name fields all-fields)
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons (make-accessor-of-constructor name (car fields) all-fields)
+            (make-accessors-of-constructor-aux name (cdr fields) all-fields))
+    nil))
+
+(defun make-accessors-of-constructor (name fields)
+  (declare (xargs :mode :program))
+  (make-accessors-of-constructor-aux name fields fields))
+
+
+(defun fields-recognizer-map (name fields)
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons (cons (car fields) (list (accessor-name name (car fields)) 'x))
+            (fields-recognizer-map name (cdr fields)))
+    nil))
+
+(defun accessor-names (name fields)
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons (accessor-name name (car fields))
+            (accessor-names name (cdr fields)))
+    nil))
+
+(defun make-requirement-of-recognizer (name require map accnames)
+  (declare (xargs :mode :program))
+  `(defthm ,(ACL2::mksym 'forcing- (first require))
+     (implies (force (,(recognizer-name name) x))
+              (equal ,(ACL2::sublis map (second require))
+                     t))
+     :hints(("Goal" :in-theory (enable ,(recognizer-name name) ,@accnames)))))
+
+(defun make-requirements-of-recognizer-aux (name require map accnames)
+  (declare (xargs :mode :program))
+  (if (consp require)
+      (cons (make-requirement-of-recognizer name (car require) map accnames)
+            (make-requirements-of-recognizer-aux name (cdr require) map accnames))
+    nil))
+
+(defun make-requirements-of-recognizer (name require fields)
+  (declare (xargs :mode :program))
+  (make-requirements-of-recognizer-aux name require
+                                       (fields-recognizer-map name fields)
+                                       (accessor-names name fields)))
+
+
+
+(defun changer-args-to-alist (args valid-fields)
+  (declare (xargs :mode :program))
+  (if (consp args)
+      (and (consp (cdr args))
+           (let ((field (first args))
+                 (value (second args)))
+             (and (or (memberp field valid-fields)
+                      (ACL2::er hard? 'changer-args-to-alist
+                                "~x0 is not among the allowed fields, ~&0." valid-fields))
+                  (cons (cons field value)
+                        (changer-args-to-alist (cdr (cdr args)) valid-fields)))))
+    nil))
+
+(defun make-valid-fields-for-changer (fields)
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (cons (ACL2::intern-in-package-of-symbol (ACL2::symbol-name (car fields)) :keyword)
+            (make-valid-fields-for-changer (cdr fields)))
+    nil))
+
+
+
+(defun changer-fn-name (name)
+  (declare (xargs :mode :program))
+  (ACL2::mksym 'change- name '-fn))
+
+(defun changer-name (name)
+  (declare (xargs :mode :program))
+  (ACL2::mksym 'change- name))
+
+(defun make-changer-fn-aux (name fields)
+  (declare (xargs :mode :program))
+  (if (consp fields)
+      (let ((kwd-name (ACL2::intern-in-package-of-symbol (ACL2::symbol-name (car fields)) :keyword)))
+        (cons `(if (lookup ,kwd-name alist)
+                   (cdr (lookup ,kwd-name alist))
+                 (list ',(accessor-name name (car fields)) x))
+              (make-changer-fn-aux name (cdr fields))))
+    nil))
+
+(defun make-changer-fn (name fields)
+  (declare (xargs :mode :program))
+  `(defun ,(changer-fn-name name) (x alist)
+     (declare (xargs :mode :program))
+     (cons ',(constructor-name name)
+           ,(cons 'list (make-changer-fn-aux name fields)))))
+
+(defun make-changer (name fields)
+  (declare (xargs :mode :program))
+  `(defmacro ,(changer-name name) (x &rest args)
+     (,(changer-fn-name name) x (changer-args-to-alist args ',(make-valid-fields-for-changer fields)))))
+
+
+
+
+
+(defmacro defaggregate (name fields &key require (legiblep ''t))
+  (and (or (symbolp name)
+           (ACL2::er hard 'defaggregate "Name must be a symbol.~%"))
+       (or (symbol-listp fields)
+           (ACL2::er hard 'defaggregate "Fields must be a list of symbols.~%"))
+       (or (uniquep fields)
+           (ACL2::er hard 'defaggregate "Fields must be unique.~%"))
+       (or (consp fields)
+           (ACL2::er hard 'defaggregate "There must be at least one field.~%"))
+       (or (and (tuple-listp 2 require)
+                (symbol-listp (strip-firsts require)))
+           (ACL2::er hard 'defaggregate ":require must be a list of (name requirement) tuples.~%"))
+       (or (uniquep (strip-firsts require))
+           (ACL2::er hard 'defaggregate "The names given to :require must be unique.~%"))
+       (or (cons-listp (strip-seconds require))
+           (ACL2::er hard 'defaggregate "The requirements must be at least conses.~%"))
+       (or (ACL2::pseudo-term-listp (strip-seconds require))
+           (ACL2::er hard 'defaggregate "The requierments must be terms.~%"))
+       (let ((foop (recognizer-name name))
+             (make-foo (constructor-name name)))
+         `(encapsulate
+           ()
+           ,(make-recognizer name fields require legiblep)
+           ,(make-constructor name fields require legiblep)
+           ,@(make-accessors name fields legiblep)
+
+           (defthm ,(ACL2::mksym make-foo '-under-iff)
+             (iff (,make-foo ,@fields)
+                  t)
+             :hints(("Goal" :in-theory (enable ,make-foo))))
+
+           (defthm ,(ACL2::mksym 'booleanp-of- foop)
+             (equal (booleanp (,foop x))
+                    t)
+             :hints(("Goal" :in-theory (enable ,foop))))
+
+           ,(if (consp require)
+                `(defthm ,(ACL2::mksym 'forcing- foop '-of- make-foo)
+                   (implies (force (and ,@(strip-seconds require)))
+                            (equal (,foop (,make-foo ,@fields))
+                                   t))
+                   :hints(("Goal" :in-theory (enable ,foop ,make-foo))))
+              `(defthm ,(ACL2::mksym foop '-of- make-foo)
+                 (equal (,foop (,make-foo ,@fields))
+                        t)
+                 :hints(("Goal" :in-theory (enable ,foop ,make-foo)))))
+
+           ,@(make-accessors-of-constructor name fields)
+
+           ,@(make-requirements-of-recognizer name require fields)
+
+           ,(make-changer-fn name fields)
+           ,(make-changer name fields)
+
+           ))))
+
+#|
+(defaggregate taco
+  (lettuce shell meat cheese)
+  :require
+  ((taco-cheese-is-okay (memberp cheese '(cheddar swiss)))))
+
+(change-taco (taco 'iceberg 'hard 'beans 'cheddar)
+             :lettuce 'arugula
+             :meat 'dog)
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/deflist.lisp acl2-6.3/books/milawa/ACL2/utilities/deflist.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/deflist.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/deflist.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,692 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defun remove-constants (x)
+  (declare (xargs :mode :program))
+  (if (consp x)
+      (if (or (natp (car x))
+              (equal (car x) t)
+              (equal (car x) nil)
+              (equal (car x) 'quote))
+          (remove-constants (cdr x))
+        (cons (car x) (remove-constants (cdr x))))
+    nil))
+
+;; (deflist name formals element
+;;   &key negatedp
+;;        guard
+;;        verify-guards
+;;        already-definedp)
+;;
+;; Examples:
+;;   (deflist integer-listp (x) (integerp x))
+;;   (deflist tuple-listp (n x) (tuplep n x) :guard (natp n))
+;;   (deflist all-subsetp (x super) (subsetp x super))
+;;   (deflist nat-free-listp (x) (natp x) :negatedp t)
+;;
+;; We define a recognizer for a list of elementp's, or, if negatedp is set, a
+;; list of non-elementp's.  We expect that element refers to a boolean-valued
+;; function.
+;;
+;; One of the formals must be named x, and this controls which argument
+;; receives the list to check.  None of the formals may be named a or y,
+;; because we use these names in the theorems we generate.
+;;
+;; The optional :guard and :verify-guards are given to the defund which we
+;; introduce.  I.e., they need to talk about the list recognizer, not the
+;; element recognizer.
+;;
+;; The special :already-definedp keyword can be set if you have already given a
+;; definition of the function.  If this is provided, we will only write down
+;; the deflist theorems and we will not generate a defun event.  This is
+;; sometimes useful when you have mutually recursive functions.
+;;
+;; The special :value-of-nil keyword can be useful when (elementp nil ...) is
+;; always known to be t or nil.  This can produce cleaner theorems.
+
+
+(defun deflist-fn (name formals element negatedp guard verify-guards already-definedp elementp-of-nil)
+  (declare (xargs :mode :program))
+  (and (or (ACL2::symbolp name)
+           (ACL2::er ACL2::hard 'deflist
+                     "Name must be a symbol, but is ~x0.~%" name))
+       (or (and (ACL2::symbol-listp formals)
+                (uniquep formals)
+                (memberp 'x formals))
+           (ACL2::er ACL2::hard 'deflist
+                     "The formals must be a list of unique symbols which ~
+                      contain x, but the formals are ~x0.~%" formals))
+       (or (and (not (memberp 'y formals))
+                (not (memberp 'a formals)))
+           (ACL2::er ACL2::hard 'deflist
+                     "As a special restriction, formals may not mention a, n, or ~
+                      y, but the formals are ~x0.~%" formals))
+       (or (and (ACL2::symbolp (car element))
+                (consp element)
+                ;; BOZO maybe we don't need to be so strict...
+                ;(uniquep (remove-constants (cdr element)))
+                ;(subsetp (remove-constants (cdr element)) formals))
+                )
+           (ACL2::er ACL2::hard 'deflist
+                     "The element transformation must be a function applied ~
+                      to the formals, but is ~x0.~%" element))
+       (or (booleanp negatedp)
+           (ACL2::er ACL2::hard 'deflist
+                     ":negatedp must be a boolean, but is ~x0.~%"
+                     negatedp))
+       (or (booleanp verify-guards)
+           (ACL2::er ACL2::hard 'deflist
+                     ":verify-guards must be a boolean, but is ~x0.~%"
+                     verify-guards))
+  (let ((elementp (car element))
+        (elem-formals (cdr element)))
+
+    `(encapsulate
+      ()
+      ,@(if already-definedp
+            nil
+          `((defund ,name (,@formals)
+              (declare (xargs :guard ,guard
+                              :verify-guards ,verify-guards))
+              (if (consp x)
+                  (and ,(if negatedp
+                            `(not (,elementp ,@(ACL2::subst '(car x) 'x elem-formals)))
+                          `(,elementp ,@(ACL2::subst '(car x) 'x elem-formals)))
+                       (,name    ,@(ACL2::subst '(cdr x) 'x formals)))
+                t))))
+
+      (defthm ,(ACL2::mksym name '-when-not-consp)
+        (implies (not (consp x))
+                 (equal (,name ,@formals)
+                        t))
+        :hints(("Goal" :in-theory (enable ,name))))
+
+      (defthm ,(ACL2::mksym name '-of-cons)
+        (equal (,name ,@(ACL2::subst '(cons a x) 'x formals))
+               (and ,(if negatedp
+                         `(not (,elementp ,@(ACL2::subst 'a 'x elem-formals)))
+                       `(,elementp ,@(ACL2::subst 'a 'x elem-formals)))
+                    (,name ,@formals)))
+        :hints(("Goal" :in-theory (enable ,name))))
+
+      (defthm ,(ACL2::mksym 'booleanp-of- name)
+        (equal (booleanp (,name ,@formals))
+               t)
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym name '-of-list-fix)
+        (equal (,name ,@(ACL2::subst '(list-fix x) 'x formals))
+               (,name ,@formals))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym name '-of-app)
+        (equal (,name ,@(ACL2::subst '(app x y) 'x formals))
+               (and (,name ,@formals)
+                    (,name ,@(ACL2::subst 'y 'x formals))))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym name '-of-rev)
+        (equal (,name ,@(ACL2::subst '(rev x) 'x formals))
+               (,name ,@formals))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym elementp '-of-car-when- name)
+        (implies (,name ,@formals)
+                 (equal (,elementp ,@(ACL2::subst '(car x) 'x elem-formals))
+                        ,(cond ((equal elementp-of-nil nil)
+                                (if negatedp
+                                    ;; If x is a cons, then its car is not an element.
+                                    ;; Else its car is nil, which is not an element.
+                                    nil
+                                  ;; If x is a cons, then its car is an element.
+                                  ;; Else its car is nil, which is not an element.
+                                  `(consp x)))
+                               ((equal elementp-of-nil t)
+                                (if negatedp
+                                    ;; If x is a cons, then its car is not an element.
+                                    ;; Else its car is nil, which is an element.
+                                    `(not (consp x))
+                                  ;; If x is a cons, then its car is an element.
+                                  ;; Else its car is nil, which is an element.
+                                  t))
+                               ((equal elementp-of-nil :unknown)
+                                `(if (consp x)
+                                     ,(not negatedp)
+                                   (,elementp ,@(ACL2::subst nil 'x elem-formals))))
+                               (t
+                                (ACL2::er hard '%deflist "Error: elementp-of-nil must be t or nil."))))))
+
+      (defthm ,(ACL2::mksym name '-of-cdr-when- name)
+        (implies (,name ,@formals)
+                 (equal (,name ,@(ACL2::subst '(cdr x) 'x formals))
+                        t)))
+
+      (defthm ,(ACL2::mksym elementp '-when-memberp-of- name)
+        (implies (and (,name ,@formals)
+                      (memberp a x))
+                 (equal (,elementp ,@(ACL2::subst 'a 'x elem-formals))
+                        ,(not negatedp)))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym elementp '-when-memberp-of- name '-alt)
+        (implies (and (memberp a x)
+                      (,name ,@formals))
+                 (equal (,elementp ,@(ACL2::subst 'a 'x elem-formals))
+                        ,(not negatedp))))
+
+      (defthm ,(ACL2::mksym name '-of-remove-all-when- name)
+        (implies (,name ,@formals)
+                 (equal (,name ,@(ACL2::subst '(remove-all a x) 'x formals))
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym name '-of-remove-duplicates)
+        (equal (,name ,@(ACL2::subst '(remove-duplicates x) 'x formals))
+               (,name ,@formals))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym name '-of-difference-when- name)
+        (implies (,name ,@formals)
+                 (equal (,name ,@(ACL2::subst '(difference x y) 'x formals))
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym name '-of-subsetp-when- name)
+        (implies (and (,name ,@(ACL2::subst 'y 'x formals))
+                      (subsetp x y))
+                 (equal (,name ,@formals)
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym name '-of-subsetp-when- name '-alt)
+        (implies (and (subsetp x y)
+                      (,name ,@(ACL2::subst 'y 'x formals)))
+                 (equal (,name ,@formals)
+                        t)))
+
+      (defthm ,(ACL2::mksym name '-of-repeat)
+        ;; It's sort of ugly to use y here instead of n, but this way we have
+        ;; fewer restrictions on the formals for deflist.
+        (equal (,name ,@(ACL2::subst '(repeat a y) 'x formals))
+               (or ,(if negatedp
+                        `(not (,elementp ,@(ACL2::subst 'a 'x elem-formals)))
+                      `(,elementp ,@(ACL2::subst 'a 'x elem-formals)))
+                   (zp y)))
+        :hints(("Goal" :in-theory (enable repeat))))
+
+      ))))
+
+(defmacro deflist (name formals element
+                        &key
+                        (negatedp 'nil)
+                        (guard 't)
+                        (verify-guards 't)
+                        (already-definedp 'nil)
+                        (elementp-of-nil ':unknown))
+  (deflist-fn name formals element negatedp guard verify-guards already-definedp elementp-of-nil))
+
+
+
+
+;; (defprojection &key list element guard verify-guards nil-preservingp already-definedp)
+;;
+;; Examples.
+;;   (defprojection :list (strip-firsts x)
+;;                  :element (first x)
+;;                  :guard (cons-listp x)
+;;                  :nil-preservingp t)
+;;
+;; We define a projection function which takes the element-transforming
+;; function "element" and applies it across a list.  The new function gets the
+;; name given to it by list.
+;;
+;; We also define a tail-recursive variant of this projection function,
+;; fast-list$, which we prove is basically equal to the reverse of the list
+;; function.
+;;
+;; If the element-transforming function always produces nil when its x argument
+;; is nil, then you should pass :nil-preservingp t, which strengthens certain
+;; theorems.
+
+(defun defprojection-fn (list element nil-preservingp already-definedp guard verify-guards)
+  (declare (xargs :mode :program))
+  (let* ((list-fn   (car list))
+         (list-args (cdr list))
+         (elem-fn   (car element))
+         (elem-args (cdr element))
+         (fast-fn   (if (ACL2::has-namespace list-fn)
+                        (ACL2::mksym (ACL2::extract-namespace list-fn)
+                               '.fast-
+                               (ACL2::extract-nonnamespace list-fn)
+                               '$)
+                      (ACL2::mksym 'fast- list-fn '$))))
+    `(encapsulate
+      ()
+      ,@(if already-definedp
+            nil
+          `((defund ,list-fn (,@list-args)
+              (declare (xargs :guard ,guard
+                              :verify-guards ,verify-guards))
+              (if (consp x)
+                  (cons (,elem-fn ,@(ACL2::subst '(car x) 'x elem-args))
+                        (,list-fn ,@(ACL2::subst '(cdr x) 'x list-args)))
+                nil))
+
+            (defund ,fast-fn (,@list-args acc)
+              (declare (xargs :guard ,(if (equal guard t)
+                                          `(true-listp acc)
+                                        `(and (true-listp acc)
+                                              ,guard))
+                              :verify-guards ,verify-guards))
+              (if (consp x)
+                  (,fast-fn ,@(ACL2::subst '(cdr x) 'x list-args)
+                            (cons (,elem-fn ,@(ACL2::subst '(car x) 'x elem-args))
+                                  acc))
+                acc))))
+
+      (defthm ,(ACL2::mksym list-fn '-when-not-consp)
+        (implies (not (consp x))
+                 (equal (,list-fn ,@list-args)
+                        nil))
+        :hints(("Goal" :in-theory (enable ,list-fn))))
+
+      (defthm ,(ACL2::mksym list-fn '-of-cons)
+        (equal (,list-fn ,@(ACL2::subst '(cons a x) 'x list-args))
+               (cons (,elem-fn ,@(ACL2::subst 'a 'x elem-args))
+                     (,list-fn ,@list-args)))
+        :hints(("Goal" :in-theory (enable ,list-fn))))
+
+      (defthm ,(ACL2::mksym 'true-listp-of- list-fn)
+        (equal (true-listp (,list-fn ,@list-args))
+               t)
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym 'len-of- list-fn)
+        (equal (len (,list-fn ,@list-args))
+               (len x))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym 'consp-of- list-fn)
+        (equal (consp (,list-fn ,@list-args))
+               (consp x))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym 'car-of- list-fn)
+        (equal (car (,list-fn ,@list-args))
+               ,(if nil-preservingp
+                    `(,elem-fn ,@(ACL2::subst '(car x) 'x elem-args))
+                  `(if (consp x)
+                       (,elem-fn ,@(ACL2::subst '(car x) 'x elem-args))
+                     nil))))
+
+      (defthm ,(ACL2::mksym 'cdr-of- list-fn)
+        (equal (cdr (,list-fn ,@list-args))
+               (,list-fn ,@(ACL2::subst '(cdr x) 'x list-args))))
+
+      (defthm ,(ACL2::mksym list-fn '-under-iff)
+        (iff (,list-fn ,@list-args)
+             (consp x))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym list-fn '-of-list-fix)
+        (equal (,list-fn ,@(ACL2::subst '(list-fix x) 'x list-args))
+               (,list-fn ,@list-args))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym list-fn '-of-app)
+        (equal (,list-fn ,@(ACL2::subst '(app x y) 'x list-args))
+               (app (,list-fn ,@list-args)
+                    (,list-fn ,@(ACL2::subst 'y 'x list-args))))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym list-fn '-of-rev)
+        (equal (,list-fn ,@(ACL2::subst '(rev x) 'x list-args))
+               (rev (,list-fn ,@list-args)))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym 'firstn-of- list-fn)
+        (equal (firstn y (,list-fn ,@list-args))
+               (,list-fn ,@(ACL2::subst '(firstn y x) 'x list-args)))
+        :hints(("Goal"
+                :in-theory (enable firstn)
+                :induct (firstn y x))))
+
+      (defthm ,(ACL2::mksym 'restn-of- list-fn)
+        (equal (restn y (,list-fn ,@list-args))
+               (,list-fn ,@(ACL2::subst '(restn y x) 'x list-args)))
+        :hints(("Goal"
+                :in-theory (enable restn)
+                :induct (restn y x))))
+
+      (defthm ,(ACL2::mksym 'rev-of- list-fn)
+        (equal (rev (,list-fn ,@list-args))
+               (,list-fn ,@(ACL2::subst '(rev x) 'x list-args))))
+
+      (in-theory (disable ,(ACL2::mksym list-fn '-of-rev)))
+
+      (ACL2::theory-invariant (ACL2::incompatible (:rewrite ,(ACL2::mksym list-fn '-of-rev))
+                                                  (:rewrite ,(ACL2::mksym 'rev-of- list-fn))))
+
+      (defthm ,(ACL2::mksym 'memberp-of- elem-fn '-in- list-fn '-when-memberp)
+        (implies (memberp a x)
+                 (equal (memberp (,elem-fn ,@(ACL2::subst 'a 'x elem-args))
+                                 (,list-fn ,@list-args))
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym 'subsetp-of- list-fn 's-when-subsetp)
+        (implies (subsetp x y)
+                 (equal (subsetp (,list-fn ,@list-args)
+                                 (,list-fn ,@(ACL2::subst 'y 'x list-args)))
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      ,@(if nil-preservingp
+            `((defthm ,(ACL2::mksym 'nth-of- list-fn)
+                (equal (nth n (,list-fn ,@list-args))
+                       (,elem-fn ,@(ACL2::subst '(nth n x) 'x elem-args)))
+                :hints(("Goal"
+                        :in-theory (enable nth)
+                        :induct (nth n x)))))
+          nil)
+
+      ,@(if already-definedp
+            nil
+          `((defthm ,(ACL2::mksym fast-fn '-removal)
+              (implies (force (true-listp acc))
+                       (equal (,fast-fn ,@list-args acc)
+                              (revappend (,list-fn ,@list-args) acc)))
+              :hints(("Goal" :in-theory (enable ,fast-fn))))))
+
+      )))
+
+(ACL2::defmacro defprojection (&key list element nil-preservingp already-definedp
+                              (guard 't)
+                              (verify-guards 't))
+  (declare (xargs :guard (and (ACL2::symbol-listp list)
+                              (ACL2::symbol-listp element)
+                              (booleanp nil-preservingp)
+                              (booleanp verify-guards)
+                              (booleanp already-definedp)
+                              (consp list)
+                              (consp element)
+                              (uniquep (cdr list))
+                              (let ((element-vars (remove-constants (cdr element))))
+                                (and (uniquep element-vars)
+                                     (memberp 'x element-vars)
+                                     (not (memberp 'a element-vars))
+                                     (not (memberp 'y element-vars))
+                                     (not (memberp 'acc element-vars))
+                                     (subsetp element-vars (cdr list))
+                                     (subsetp (cdr list) element-vars))))))
+  (defprojection-fn list element nil-preservingp already-definedp guard verify-guards))
+
+
+
+
+;; (defmap &key map key val key-list val-list guard verify-guards)
+;;
+;; Example:
+;;
+;; (deflist :list (nat-listp x) :element (natp x))
+;; (deflist :list (sym-listp x) :element (symbolp x))
+;;
+;; (defmap :map (sym-nat-mapp x)
+;;         :key (symbolp x)
+;;         :val (natp x)
+;;         :key-list (sym-listp x)
+;;         :val-list (nat-listp x))
+;;
+;; We define a mapping (alist) from keys to values.  We expect that the key
+;; recognizer and value recognizer are boolean-valued functions.  The key
+;; recognizer doesn't get a chance to look at the value, and similarly the
+;; value recognizer doesn't get to look at the key.
+
+(defun defmap-fn (map key val key-list val-list guard verify-guards val-of-nil)
+  (declare (xargs :mode :program))
+  (let ((mapp (car map))
+        (keyp (car key))
+        (valp (car val))
+        (key-listp (car key-list))
+        (val-listp (car val-list))
+        (map-formals (cdr map))
+        (key-formals (cdr key))
+        (val-formals (cdr val))
+        (key-list-formals (cdr key-list))
+        (val-list-formals (cdr val-list)))
+    `(encapsulate
+      ()
+      (defund ,mapp (,@map-formals)
+        (declare (xargs :guard ,guard
+                        :verify-guards ,verify-guards))
+        (if (consp x)
+            (and (consp (car x))
+                 (,keyp ,@(ACL2::subst '(car (car x)) 'x key-formals))
+                 (,valp ,@(ACL2::subst '(cdr (car x)) 'x val-formals))
+                 (,mapp ,@(ACL2::subst '(cdr x) 'x map-formals)))
+          t))
+
+      (defthm ,(ACL2::mksym mapp '-when-not-consp)
+        (implies (not (consp x))
+                 (equal (,mapp ,@map-formals)
+                        t))
+        :hints(("Goal" :in-theory (enable ,mapp))))
+
+      (defthm ,(ACL2::mksym mapp '-of-cons)
+        (equal (,mapp ,@(ACL2::subst '(cons a x) 'x map-formals))
+               (and (consp a)
+                    (,keyp ,@(ACL2::subst '(car a) 'x key-formals))
+                    (,valp ,@(ACL2::subst '(cdr a) 'x val-formals))
+                    (,mapp ,@map-formals)))
+        :hints(("Goal" :in-theory (enable ,mapp))))
+
+      (defthm ,(ACL2::mksym 'consp-when-memberp-of- mapp)
+        (implies (and (,mapp ,@map-formals)
+                      (memberp a x))
+                 (equal (consp a)
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym 'consp-when-memberp-of- mapp '-alt)
+        (implies (and (memberp a x)
+                      (,mapp ,@map-formals))
+                 (equal (consp a)
+                        t)))
+
+      (defthm ,(ACL2::mksym keyp '-of-car-when-memberp-of- mapp)
+        (implies (and (,mapp ,@map-formals)
+                      (memberp a x))
+                 (equal (,keyp ,@(ACL2::subst '(car a) 'x key-formals))
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym keyp '-when-lookup-in- mapp)
+        (implies (and (,mapp ,@map-formals)
+                      (lookup a x))
+                 (equal (,keyp ,@(ACL2::subst 'a 'x key-formals))
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym valp '-of-cdr-when-memberp-of- mapp)
+        (implies (and (,mapp ,@map-formals)
+                      (memberp a x))
+                 (equal (,valp ,@(ACL2::subst '(cdr a) 'x val-formals))
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym 'booleanp-of- mapp)
+        (equal (booleanp (,mapp ,@map-formals))
+               t)
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym mapp '-of-list-fix)
+        (equal (,mapp ,@(ACL2::subst '(list-fix x) 'x map-formals))
+               (,mapp ,@map-formals))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym mapp '-of-app)
+        (equal (,mapp ,@(ACL2::subst '(app x y) 'x map-formals))
+               (and (,mapp ,@map-formals)
+                    (,mapp ,@(ACL2::subst 'y 'x map-formals))))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym mapp '-of-rev)
+        (equal (,mapp ,@(ACL2::subst '(rev x) 'x map-formals))
+               (,mapp ,@map-formals))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym mapp '-of-remove-all-when- mapp)
+        (implies (,mapp ,@map-formals)
+                 (,mapp ,@(ACL2::subst '(remove-all a x) 'x map-formals)))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym mapp '-of-remove-duplicates)
+        (equal (,mapp ,@(ACL2::subst '(remove-duplicates x) 'x map-formals))
+               (,mapp ,@map-formals))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym mapp '-of-difference-when- mapp)
+        (implies (,mapp ,@map-formals)
+                 (equal (,mapp ,@(ACL2::subst '(difference x y) 'x map-formals))
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym mapp '-of-subset-when- mapp)
+        (implies (and (,mapp ,@(ACL2::subst 'y 'x map-formals))
+                      (subsetp x y))
+                 (equal (,mapp ,@map-formals)
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym mapp '-of-subset-when- mapp '-alt)
+        (implies (and (subsetp x y)
+                      (,mapp ,@(ACL2::subst 'y 'x map-formals)))
+                 (equal (,mapp ,@map-formals)
+                        t)))
+
+      ,@(if (not key-list)
+            nil
+          `((defthm ,(ACL2::mksym key-listp '-of-domain-when- mapp)
+              (implies (,mapp ,@map-formals)
+                       (equal (,key-listp ,@(ACL2::subst '(domain x) 'x key-list-formals))
+                              t))
+              :hints(("Goal" :induct (cdr-induction x))))))
+
+      ,@(if (not val-list)
+            nil
+          `((defthm ,(ACL2::mksym val-listp '-of-range-when- mapp)
+              (implies (,mapp ,@map-formals)
+                       (equal (,val-listp ,@(ACL2::subst '(range x) 'x val-list-formals))
+                              t))
+              :hints(("Goal" :induct (cdr-induction x))))))
+
+      (defthm ,(ACL2::mksym 'mapp-when- mapp)
+        (implies (,mapp ,@map-formals)
+                 (equal (mapp x)
+                        t))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      (defthm ,(ACL2::mksym valp '-of-cdr-of-lookup-when- mapp)
+        (implies (,mapp ,@map-formals)
+                 (equal (,valp ,@(ACL2::subst '(cdr (lookup a x)) 'x val-formals))
+                        ,(if val-of-nil
+                             't
+                           `(if (lookup a x) t nil))))
+        :hints(("Goal" :induct (cdr-induction x))))
+
+      ,@(if val-of-nil
+            nil
+          `((defthm ,(ACL2::mksym 'cdr-of-lookup-under-iff-when- mapp)
+              (implies (,mapp ,@map-formals)
+                       (iff (cdr (lookup a x))
+                            (lookup a x)))
+              :hints(("Goal"
+                      :in-theory (disable ,(ACL2::mksym valp '-of-cdr-of-lookup-when- mapp))
+                      :use ((:instance ,(ACL2::mksym valp '-of-cdr-of-lookup-when- mapp))))))))
+
+
+      ;;       (defthm ,(ACL2::mksym valp '-of-cdr-of-lookup-when- mapp '-hack)
+      ;;         ;; we prove the same rule for cdr, so you can just test the cdr instead
+      ;;         ;; of the whole pair, which is sometimes convenient
+      ;;         (implies (and (,mapp ,@map-formals)
+      ;;                       (cdr (lookup a x)))
+      ;;                  (equal (,valp ,@(ACL2::subst '(cdr (lookup a x)) 'x val-formals))
+      ;;                         t))
+      ;;         :hints(("Goal" :induct (cdr-induction x))))
+
+      )))
+
+(defmacro defmap (&key map key val key-list val-list
+                       (guard 't)
+                       (verify-guards 't)
+                       (val-of-nil 't))
+  (declare (xargs :guard (and (ACL2::symbol-listp map)
+                              (ACL2::symbol-listp key)
+                              (ACL2::symbol-listp val)
+                              (ACL2::symbol-listp key-list)
+                              (ACL2::symbol-listp val-list)
+                              (consp map)
+                              (consp key)
+                              (consp val)
+                              (or (consp key-list) (not key-list))
+                              (or (consp val-list) (not val-list))
+                              ;; Argument lists must all be unique
+                              (uniquep (cdr map))
+                              (uniquep (cdr key))
+                              (uniquep (cdr val))
+                              (uniquep (cdr key-list))
+                              (uniquep (cdr val-list))
+                              ;; Argument lists must contain only the names in
+                              ;; the map formals
+                              (subsetp (cdr key) (cdr map))
+                              (subsetp (cdr val) (cdr map))
+                              (or (not key-list)
+                                  (subsetp (cdr key-list) (cdr map)))
+                              (or (not val-list)
+                                  (subsetp (cdr val-list) (cdr map)))
+                              ;; x must be in each argument list
+                              ;; a,b must not be found in any argument list
+                              (memberp 'x (cdr map))
+                              (not (memberp 'a (cdr map)))
+                              (not (memberp 'y (cdr map))))))
+  (defmap-fn map key val key-list val-list guard verify-guards val-of-nil))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/extended-subsets.lisp acl2-6.3/books/milawa/ACL2/utilities/extended-subsets.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/extended-subsets.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/extended-subsets.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,694 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "cons-listp")
+(include-book "remove-duplicates-list")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; (superset-of-somep a x)
+;;
+;; Return true if there is some subset of a in x.  Note: this is an O(n^3)
+;; operation since subsetp testing is quadratic.
+
+(defund superset-of-somep (a x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (or (subsetp (car x) a)
+          (superset-of-somep a (cdr x)))
+    nil))
+
+(defthm superset-of-somep-when-not-consp
+  (implies (not (consp x))
+           (equal (superset-of-somep a x)
+                  nil))
+  :hints(("Goal" :expand (superset-of-somep a x))))
+
+(defthm superset-of-somep-of-cons
+  (equal (superset-of-somep a (cons b x))
+         (or (subsetp b a)
+             (superset-of-somep a x)))
+  :hints(("Goal" :expand (superset-of-somep a (cons b x)))))
+
+(defthm booleanp-of-superset-of-somep
+  (equal (booleanp (superset-of-somep a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-of-list-fix-one
+  (equal (superset-of-somep (list-fix a) x)
+         (superset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-of-list-fix-two
+  (equal (superset-of-somep a (list-fix x))
+         (superset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-of-app
+  (equal (superset-of-somep a (app x y))
+         (or (superset-of-somep a x)
+             (superset-of-somep a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-of-rev
+  (equal (superset-of-somep a (rev x))
+         (superset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-when-not-superset-of-somep-cheap
+  (implies (not (superset-of-somep a x))
+           (equal (memberp a x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-when-obvious
+  (implies (and (subsetp e a)
+                (memberp e x))
+           (equal (superset-of-somep a x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-when-obvious-alt
+  (implies (and (memberp e x)
+                (subsetp e a))
+           (equal (superset-of-somep a x)
+                  t)))
+
+
+
+;; (find-subset a x)
+;;
+;; A is a list and X is a list of lists.  We return the first list in x which
+;; is a subset of a, or nil if none exists.
+
+(defund find-subset (a x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (subsetp (car x) a)
+          (car x)
+        (find-subset a (cdr x)))
+    nil))
+
+(defthm find-subset-when-not-consp
+  (implies (not (consp x))
+           (equal (find-subset a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable find-subset))))
+
+(defthm find-subset-of-cons
+  (equal (find-subset a (cons b x))
+         (if (subsetp b a)
+             b
+           (find-subset a x)))
+  :hints(("Goal" :in-theory (enable find-subset))))
+
+(defthm find-subset-of-list-fix-one
+  (equal (find-subset (list-fix a) x)
+         (find-subset a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-subset-of-list-fix-two
+  (equal (find-subset a (list-fix x))
+         (find-subset a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-subset-of-rev-one
+  (equal (find-subset (rev a) x)
+         (find-subset a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-find-subset
+  (equal (subsetp (find-subset a x) a)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-find-subset
+  (equal (memberp (find-subset a x) x)
+         (superset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-when-find-subset
+  (implies (find-subset a x)
+           (equal (superset-of-somep a x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-subset-of-app
+  (equal (find-subset a (app x y))
+         (if (memberp (find-subset a x) x)
+             (find-subset a x)
+           (find-subset a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthm find-subset-when-subsetp-two
+  (implies (and (memberp (find-subset a x) x)
+                (subsetp x y))
+           (equal (memberp (find-subset a y) y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-when-subsetp-two
+  (implies (and (superset-of-somep a x)
+                (subsetp x y))
+           (equal (superset-of-somep a y)
+                  t))
+  :hints(("Goal"
+          :in-theory (disable superset-of-somep-when-obvious
+                              superset-of-somep-when-obvious-alt)
+          :use ((:instance superset-of-somep-when-obvious
+                           (a a)
+                           (e (find-subset a x))
+                           (x y))))))
+
+(defthm superset-of-somep-when-subsetp-two-alt
+  (implies (and (subsetp x y)
+                (superset-of-somep a x))
+           (equal (superset-of-somep a y)
+                  t)))
+
+(defthm superset-of-somep-when-superset-of-somep-of-smaller
+  (implies (and (superset-of-somep sub x)
+                (subsetp sub sup))
+           (equal (superset-of-somep sup x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-when-superset-of-somep-of-smaller-alt
+  (implies (and (subsetp sub sup)
+                (superset-of-somep sub x))
+           (equal (superset-of-somep sup x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(deflist all-superset-of-somep (x ys)
+  (superset-of-somep x ys))
+
+(defthm all-superset-of-somep-of-list-fix-two
+  (equal (all-superset-of-somep x (list-fix y))
+         (all-superset-of-somep x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-cons-two
+  (implies (all-superset-of-somep x y)
+           (all-superset-of-somep x (cons a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-all-two
+  (implies (all-superset-of-somep x y)
+           (all-superset-of-somep x (app y z)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-all-two-alt
+  (implies (all-superset-of-somep x y)
+           (all-superset-of-somep x (app z y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-rev-two
+  (equal (all-superset-of-somep x (rev y))
+         (all-superset-of-somep x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-when-subsetp-two
+  (implies (and (all-superset-of-somep x y)
+                (subsetp y z))
+           (all-superset-of-somep x z))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-when-subsetp-two-alt
+  (implies (and (subsetp y z)
+                (all-superset-of-somep x y))
+           (all-superset-of-somep x z))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-cons-two-when-irrelevant
+  (implies (superset-of-somep a y)
+           (equal (all-superset-of-somep x (cons a y))
+                  (all-superset-of-somep x y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-app-two-when-irrelevant
+  ;; BOZO add similar rule for (app z y)?
+  (implies (all-superset-of-somep y z)
+           (equal (all-superset-of-somep x (app y z))
+                  (all-superset-of-somep x z)))
+  :hints(("Goal" :induct (cdr-induction y))))
+
+(defthm superset-of-somep-when-all-superset-of-somep
+  (implies (and (superset-of-somep a x)
+                (all-superset-of-somep x y))
+           (equal (superset-of-somep a y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-when-all-superset-of-somep-alt
+  (implies (and (all-superset-of-somep x y)
+                (superset-of-somep a x))
+           (equal (superset-of-somep a y)
+                  t)))
+
+(defthm all-superset-of-somep-is-reflexive
+  (equal (all-superset-of-somep x x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-is-transitive
+  (implies (and (all-superset-of-somep x y)
+                (all-superset-of-somep y z))
+           (equal (all-superset-of-somep x z)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-remove-duplicates-list
+  (equal (all-superset-of-somep x (remove-duplicates-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-superset-of-somep-of-remove-duplicates-list-gen
+  (implies (all-superset-of-somep x y)
+           (equal (all-superset-of-somep x (remove-duplicates-list y))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+;; (remove-supersets1 todo done)
+;;
+;; Let todo = [t1, ..., tn] and done = [d1, ..., dn].  We produce a list
+;; whose members are:
+;;
+;;   (1) every member of [d1, ..., dn]
+;;   (2) every member of [t1, ..., tn] that is not a superset of any other
+;;       ti or di.
+;;
+;; To do this, we just look at t1, and check if it is a superset of any di
+;; or any tj in [t2, ..., tn].  If so, we throw it out and keep going.
+;; Else, we push it onto the done list and keep going.
+;;
+;; Note: This is an O(n^4) operation since superset-of-somep is O(n^3).
+
+(defund remove-supersets1 (todo done)
+  (declare (xargs :guard t))
+  (if (consp todo)
+      (let ((candidate (car todo))
+            (remaining (cdr todo)))
+        (if (or (superset-of-somep candidate remaining)
+                (superset-of-somep candidate done))
+            ;; It's a superset of something else; drop it.
+            (remove-supersets1 remaining done)
+          ;; Not a superset; keep it.
+          (remove-supersets1 remaining (cons candidate done))))
+    (fast-rev done)))
+
+(defthm remove-supersets1-when-not-consp
+  (implies (not (consp x))
+           (equal (remove-supersets1 x done)
+                  (fast-rev done)))
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+(defthm remove-supersets1-of-cons
+  (equal (remove-supersets1 (cons a x) done)
+         (if (or (superset-of-somep a x)
+                 (superset-of-somep a done))
+             (remove-supersets1 x done)
+           (remove-supersets1 x (cons a done))))
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+(defthm true-listp-of-remove-supersets1
+  (equal (true-listp (remove-supersets1 x done))
+         t)
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+(defthm uniquep-of-remove-supersets1
+  (implies (uniquep done)
+           (uniquep (remove-supersets1 todo done)))
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+(defthm all-superset-of-somep-of-remove-supersets1
+  (equal (all-superset-of-somep x (remove-supersets1 todo done))
+         (all-superset-of-somep x (app todo done)))
+  :hints(("Goal"
+          :in-theory (enable remove-supersets1)
+          :induct (remove-supersets1 todo done))))
+
+(defthm cons-listp-when-not-superset-of-some-is-non-consp
+  (implies (and (superset-of-somep a x)
+                (not (consp a)))
+           (equal (cons-listp x)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-remove-supersets1
+  (equal (cons-listp (remove-supersets1 todo done))
+         (and (cons-listp todo)
+              (cons-listp done)))
+  :hints(("Goal" :in-theory (enable remove-supersets1))))
+
+
+
+;; (remove-supersets x)
+;;
+;; We walk through [x1, ..., xn] and remove any xi which is a superset of xj,
+;; where i != j.
+
+(defund remove-supersets (x)
+  (declare (xargs :guard t))
+  (remove-supersets1 x nil))
+
+(defthm true-listp-of-remove-supersets
+  (equal (true-listp (remove-supersets x))
+         t)
+  :hints(("Goal" :in-theory (enable remove-supersets))))
+
+(defthm all-superset-of-somep-of-remove-supersets
+  (equal (all-superset-of-somep x (remove-supersets x))
+         t)
+  :hints(("Goal" :in-theory (enable remove-supersets))))
+
+(defthm all-superset-of-somep-of-remove-supersets-gen
+  (implies (all-superset-of-somep x y)
+           (equal (all-superset-of-somep x (remove-supersets y))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-remove-supersets
+  (equal (cons-listp (remove-supersets x))
+         (cons-listp x))
+  :hints(("Goal" :in-theory (enable remove-supersets))))
+
+
+
+
+
+
+
+
+
+
+;; (subset-of-somep a x)
+;;
+;; Return true if a is a subset of some b in x.  Note: this is an O(n^3)
+;; operation since subsetp testing is quadratic.
+
+(defund subset-of-somep (a x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (or (subsetp a (car x))
+          (subset-of-somep a (cdr x)))
+    nil))
+
+(defthm subset-of-somep-when-not-consp
+  (implies (not (consp x))
+           (equal (subset-of-somep a x)
+                  nil))
+  :hints(("Goal" :expand (subset-of-somep a x))))
+
+(defthm subset-of-somep-of-cons
+  (equal (subset-of-somep a (cons b x))
+         (or (subsetp a b)
+             (subset-of-somep a x)))
+  :hints(("Goal" :expand (subset-of-somep a (cons b x)))))
+
+(defthm booleanp-of-subset-of-somep
+  (equal (booleanp (subset-of-somep a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-of-list-fix-one
+  (equal (subset-of-somep (list-fix a) x)
+         (subset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-of-list-fix-two
+  (equal (subset-of-somep a (list-fix x))
+         (subset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-of-app
+  (equal (subset-of-somep a (app x y))
+         (or (subset-of-somep a x)
+             (subset-of-somep a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-of-rev
+  (equal (subset-of-somep a (rev x))
+         (subset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-when-not-subset-of-somep-cheap
+  (implies (not (subset-of-somep a x))
+           (equal (memberp a x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-when-obvious
+  (implies (and (subsetp a e)
+                (memberp e x))
+           (equal (subset-of-somep a x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-when-obvious-alt
+  (implies (and (memberp e x)
+                (subsetp a e))
+           (equal (subset-of-somep a x)
+                  t)))
+
+
+
+
+;; (find-superset a x)
+;;
+;; A is a list and X is a list of lists.  We return the first list in x which
+;; is a superset of a, or nil if none exists.
+
+(defund find-superset (a x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (subsetp a (car x))
+          (car x)
+        (find-superset a (cdr x)))
+    nil))
+
+(defthm find-superset-when-not-consp
+  (implies (not (consp x))
+           (equal (find-superset a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable find-superset))))
+
+(defthm find-superset-of-cons
+  (equal (find-superset a (cons b x))
+         (if (subsetp a b)
+             b
+           (find-superset a x)))
+  :hints(("Goal" :in-theory (enable find-superset))))
+
+(defthm find-superset-of-list-fix-one
+  (equal (find-superset (list-fix a) x)
+         (find-superset a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-superset-of-list-fix-two
+  (equal (find-superset a (list-fix x))
+         (find-superset a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-superset-of-rev-one
+  (equal (find-superset (rev a) x)
+         (find-superset a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-find-superset
+  (implies (subset-of-somep a x)
+           (equal (subsetp a (find-superset a x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-find-superset
+  (implies (subset-of-somep a x)
+           (equal (memberp (find-superset a x) x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-when-find-superset
+  (implies (find-superset a x)
+           (equal (subset-of-somep a x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm find-superset-when-subsetp-two
+  (implies (and (memberp (find-superset a x) x)
+                (subsetp x y)
+                (subset-of-somep a x))
+           (equal (memberp (find-superset a y) y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-when-subsetp-two
+  (implies (and (subset-of-somep a x)
+                (subsetp x y))
+           (equal (subset-of-somep a y)
+                  t))
+  :hints(("Goal"
+          :in-theory (disable subset-of-somep-when-obvious
+                              subset-of-somep-when-obvious-alt)
+          :use ((:instance subset-of-somep-when-obvious
+                           (a a)
+                           (e (find-superset a x))
+                           (x y))))))
+
+(defthm subset-of-somep-when-subsetp-two-alt
+  (implies (and (subsetp x y)
+                (subset-of-somep a x))
+           (equal (subset-of-somep a y)
+                  t)))
+
+(defthm subset-of-somep-when-subset-of-somep-of-smaller
+  (implies (and (subset-of-somep a x)
+                (subsetp b a))
+           (equal (subset-of-somep b x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-when-subset-of-somep-of-smaller-alt
+  (implies (and (subsetp b a)
+                (subset-of-somep a x))
+           (equal (subset-of-somep b x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(deflist all-subset-of-somep (x ys)
+  (subset-of-somep x ys))
+
+(defthm all-subset-of-somep-of-list-fix-two
+  (equal (all-subset-of-somep x (list-fix y))
+         (all-subset-of-somep x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-cons-two
+  (implies (all-subset-of-somep x y)
+           (all-subset-of-somep x (cons a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-all-two
+  (implies (all-subset-of-somep x y)
+           (all-subset-of-somep x (app y z)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-all-two-alt
+  (implies (all-subset-of-somep x y)
+           (all-subset-of-somep x (app z y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-rev-two
+  (equal (all-subset-of-somep x (rev y))
+         (all-subset-of-somep x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-when-subsetp-two
+  (implies (and (all-subset-of-somep x y)
+                (subsetp y z))
+           (all-subset-of-somep x z))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-when-subsetp-two-alt
+  (implies (and (subsetp y z)
+                (all-subset-of-somep x y))
+           (all-subset-of-somep x z))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-cons-two-when-irrelevant
+  (implies (subset-of-somep a y)
+           (equal (all-subset-of-somep x (cons a y))
+                  (all-subset-of-somep x y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-app-two-when-irrelevant
+  ;; BOZO add similar rule for (app z y)?
+  (implies (all-subset-of-somep y z)
+           (equal (all-subset-of-somep x (app y z))
+                  (all-subset-of-somep x z)))
+  :hints(("Goal" :induct (cdr-induction y))))
+
+(defthm subset-of-somep-when-all-subset-of-somep
+  (implies (and (subset-of-somep a x)
+                (all-subset-of-somep x y))
+           (equal (subset-of-somep a y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subset-of-somep-when-all-subset-of-somep-alt
+  (implies (and (all-subset-of-somep x y)
+                (subset-of-somep a x))
+           (equal (subset-of-somep a y)
+                  t)))
+
+(defthm all-subset-of-somep-is-reflexive
+  (equal (all-subset-of-somep x x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-is-transitive
+  (implies (and (all-subset-of-somep x y)
+                (all-subset-of-somep y z))
+           (equal (all-subset-of-somep x z)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-remove-duplicates-list
+  (equal (all-subset-of-somep x (remove-duplicates-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm all-subset-of-somep-of-remove-duplicates-list-gen
+  (implies (all-subset-of-somep x y)
+           (equal (all-subset-of-somep x (remove-duplicates-list y))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/fast-remove-supersets.lisp acl2-6.3/books/milawa/ACL2/utilities/fast-remove-supersets.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/fast-remove-supersets.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/fast-remove-supersets.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,276 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "extended-subsets")
+(include-book "mergesort")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+(deflist ordered-list-listp (x)
+  (ordered-listp x)
+  :guard t)
+
+(defprojection :list (mergesort-list x)
+               :element (mergesort x)
+               :guard t
+               :nil-preservingp t)
+
+(defthm ordered-list-listp-of-mergesort-list
+  (equal (ordered-list-listp (mergesort-list x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthm superset-of-somep-of-mergesort-left
+  (equal (superset-of-somep (mergesort a) x)
+         (superset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm superset-of-somep-of-mergesort-list-right
+  (equal (superset-of-somep a (mergesort-list x))
+         (superset-of-somep a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund fast-superset-of-somep (a x)
+  (declare (xargs :guard (and (ordered-listp a)
+                              (ordered-list-listp x))))
+
+; This is the same as superset-of-somep when A has already been mergesorted,
+; and every member of X has already been mergesorted.  This gives us an O(n^2)
+; version of superset-of-somep, instead of the O(n^3) performance when the
+; ordinary subsetp operation is used.
+
+  (if (consp x)
+      (or (ordered-list-subsetp (car x) a)
+          (fast-superset-of-somep a (cdr x)))
+    nil))
+
+(defthmd fast-superset-of-somep-when-not-consp
+  (implies (not (consp x))
+           (equal (fast-superset-of-somep a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable fast-superset-of-somep))))
+
+(defthmd fast-superset-of-somep-of-cons
+  (equal (fast-superset-of-somep a (cons b x))
+         (or (ordered-list-subsetp b a)
+             (fast-superset-of-somep a x)))
+  :hints(("Goal" :in-theory (enable fast-superset-of-somep))))
+
+(defthm fast-superset-of-somep-removal
+  (implies (force (and (ordered-listp a)
+                       (ordered-list-listp x)))
+           (equal (fast-superset-of-somep a x)
+                  (superset-of-somep a x)))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable fast-superset-of-somep-when-not-consp
+                             fast-superset-of-somep-of-cons))))
+
+
+
+
+
+(defund fast-remove-supersets1 (todo done todo-sorted done-sorted)
+  (declare (xargs :guard (and (equal todo-sorted (mergesort-list todo))
+                              (equal done-sorted (mergesort-list done)))))
+
+; This is the same as remove-supersets1 given that the guard holds.  The
+; todo-sorted and done-sorted lists act as caches so we don't have to
+; repeatedly sort things.  We use fast-superset-of-somep, which is O(n^2),
+; repeatedly, so that the total cost is O(n^3).  But this is still better than
+; the O(n^4) behavior of remove-supersets1.
+
+  (if (consp todo-sorted)
+      (let ((candidate (car todo-sorted))
+            (remaining (cdr todo-sorted)))
+        (if (or (fast-superset-of-somep candidate remaining)
+                (fast-superset-of-somep candidate done-sorted))
+            (fast-remove-supersets1 (cdr todo)
+                                    done
+                                    (cdr todo-sorted)
+                                    done-sorted)
+          (fast-remove-supersets1 (cdr todo)
+                                  (cons (car todo) done)
+                                  (cdr todo-sorted)
+                                  (cons (car todo-sorted) done-sorted))))
+    (fast-rev done)))
+
+(defthmd fast-remove-supersets1-when-not-consp
+  (implies (not (consp todo-sorted))
+           (equal (fast-remove-supersets1 todo done todo-sorted done-sorted)
+                  (fast-rev done)))
+  :hints(("Goal" :in-theory (enable fast-remove-supersets1))))
+
+(defthmd fast-remove-supersets1-of-cons
+  (equal (fast-remove-supersets1 todo done (cons a todo-sorted) done-sorted)
+         (let ((candidate a)
+               (remaining todo-sorted))
+           (if (or (fast-superset-of-somep candidate remaining)
+                   (fast-superset-of-somep candidate done-sorted))
+               (fast-remove-supersets1 (cdr todo)
+                                       done
+                                       todo-sorted
+                                       done-sorted)
+             (fast-remove-supersets1 (cdr todo)
+                                     (cons (car todo) done)
+                                     todo-sorted
+                                     (cons a done-sorted)))))
+  :hints(("Goal" :in-theory (enable fast-remove-supersets1))))
+
+(defthm fast-remove-supersets1-removal
+  (equal (fast-remove-supersets1 todo done (mergesort-list todo) (mergesort-list done))
+         (remove-supersets1 todo done))
+  :hints(("Goal"
+          :in-theory (enable (:induction remove-supersets1)
+                             fast-remove-supersets1-when-not-consp
+                             fast-remove-supersets1-of-cons)
+          :induct (remove-supersets1 todo done))))
+
+
+
+;; One minor thing is that because of arithmetic, it would be slightly expensive
+;; to use a function such as len-at-leastp, below, to check the length of a list
+;; against 250.
+;;
+;; (defund len-at-leastp (x n)
+;;   (declare (xargs :guard (natp n)))
+;;   (if (zp n)
+;;       t
+;;     (if (consp x)
+;;         (len-at-leastp (cdr x) (- n 1))
+;;       nil)))
+;;
+;; (defthm len-at-leastp-correct
+;;   (equal (len-at-leastp x n)
+;;          (<= n (len x)))
+;;   :hints(("Goal" :in-theory (enable len-at-leastp))))
+;;
+;; Instead, we come up with a very specialized and funny-looking test.  This
+;; is pretty gross, but it's considerably faster on some sample tests, shown
+;; below.
+
+(definlined cdr-10-times (x)
+  (declare (xargs :guard t))
+  (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr x)))))))))))
+
+(definlined cdr-50-times (x)
+  (declare (xargs :guard t))
+  (let* ((10cdrs (and (consp x) (cdr-10-times x)))
+         (20cdrs (and (consp 10cdrs) (cdr-10-times 10cdrs)))
+         (30cdrs (and (consp 20cdrs) (cdr-10-times 20cdrs)))
+         (40cdrs (and (consp 30cdrs) (cdr-10-times 30cdrs))))
+    (and (consp 40cdrs)
+         (cdr-10-times 40cdrs))))
+
+(definlined cdr-250-times (x)
+  (declare (xargs :guard t))
+  (let* ((50cdrs  (cdr-50-times x))
+         (100cdrs (cdr-50-times 50cdrs))
+         (150cdrs (cdr-50-times 100cdrs))
+         (200cdrs (cdr-50-times 150cdrs)))
+    (cdr-50-times 200cdrs)))
+
+(definlined len-over-250p (x)
+  (declare (xargs :guard t))
+  (consp (cdr-250-times x)))
+
+;; We test the performance of the two functions with the following loop.
+;;
+;; (defparameter *test* nil)
+;; (progn
+;;   (setf *test*
+;;         (loop for i fixnum from 1 to 251 collect i))
+;;   (time (loop for i fixnum from 1 to 1000000
+;;               do
+;;               (MILAWA::len-overp *test* 250)))
+;;   (time (loop for i fixnum from 1 to 1000000
+;;               do
+;;               (MILAWA::len-over-250p *test*)))
+;;   nil)
+;;
+;; Test results are as follows.  Times in seconds.
+;;
+;;   Test size     Len-overp      Len-over-250p
+;;   1             .04            .08
+;;   2             .077           .086
+;;   3             .11            .08
+;;   10            .33            .08
+;;   60            1.9            .33
+;;   100           3.2            .52
+;;   180           5.7            .91
+;;   240           7.6            1.2
+;;   251           7.9            1.2
+;;
+;; So, we're willing to put up with the ugliness to get this good performance.
+
+(defund some-len-over-250p (x)
+  ;; BOZO not used anymore.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (or (len-over-250p (car x))
+          (some-len-over-250p (cdr x)))
+    nil))
+
+
+(defund fast-remove-supersets (x)
+  (declare (xargs :guard t))
+  ;; Is it worth it to mergesort?  Only if we're going to be doing a lot of
+  ;; subset checks.  As a rough heuristic, we will mergesort when there are
+  ;; more than 250 members in the list.  This improved a particularly egregious
+  ;; call of remove-supersets1 in level10/fast-image.lisp, in a use of
+  ;; %cleanup, from 327 to 199 seconds.  We may eventually want to revisit
+  ;; this and think about other heuristics that could make better decisions.
+  (if (len-over-250p x)
+      (fast-remove-supersets1 x nil (mergesort-list x) nil)
+    (remove-supersets x)))
+
+(defthm fast-remove-supersets-removal
+  (equal (fast-remove-supersets x)
+         (remove-supersets x))
+  :hints(("Goal"
+          :in-theory (enable fast-remove-supersets remove-supersets)
+          :use ((:instance fast-remove-supersets1-removal
+                           (todo x)
+                           (done nil))))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/intersect.lisp acl2-6.3/books/milawa/ACL2/utilities/intersect.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/intersect.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/intersect.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,124 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund intersect (x y)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (memberp (car x) y)
+          (cons (car x)
+                (intersect (cdr x) y))
+        (intersect (cdr x) y))
+    nil))
+
+(defthm intersect-when-not-consp-one
+  (implies (not (consp x))
+           (equal (intersect x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable intersect))))
+
+(defthm intersect-of-cons-one
+  (equal (intersect (cons a x) y)
+         (if (memberp a y)
+             (cons a (intersect x y))
+           (intersect x y)))
+  :hints(("Goal" :in-theory (enable intersect))))
+
+(defthm intersect-when-not-consp-two
+  (implies (not (consp y))
+           (equal (intersect x y)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm intersect-under-iff
+  (iff (intersect x y)
+       (not (disjointp x y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-intersect
+  (equal (true-listp (intersect x y))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm intersect-of-list-fix-one
+  (equal (intersect (list-fix x) y)
+         (intersect x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm intersect-of-list-fix-two
+  (equal (intersect x (list-fix y))
+         (intersect x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm intersect-of-app-one
+  (equal (intersect (app x y) z)
+         (app (intersect x z)
+              (intersect y z)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rev-of-intersect
+  (equal (rev (intersect x y))
+         (intersect (rev x) y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm intersect-of-rev-two
+  (equal (intersect x (rev y))
+         (intersect x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-intersect-one
+  (equal (subsetp (intersect x y) x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-intersect-two
+  (equal (subsetp (intersect x y) y)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm intersect-when-subsetp
+  (implies (subsetp x y)
+           (equal (intersect x y)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm intersect-with-self
+  (equal (intersect x x)
+         (list-fix x)))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/list-list-fix.lisp acl2-6.3/books/milawa/ACL2/utilities/list-list-fix.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/list-list-fix.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/list-list-fix.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defprojection :list (list-list-fix x)
+               :element (list-fix x)
+               :guard t
+               :nil-preservingp t)
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/listify-each.lisp acl2-6.3/books/milawa/ACL2/utilities/listify-each.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/listify-each.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/listify-each.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,55 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cons-listp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(encapsulate
+ ()
+ ;; BOZO find me a home
+ (local (in-theory (disable equal-of-cons-rewrite)))
+ (defprojection
+   :list (listify-each x)
+   :element (list x)
+   :guard t))
+
+(defthm cons-listp-of-listify-each
+  (equal (cons-listp (listify-each x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/map-fix.lisp acl2-6.3/books/milawa/ACL2/utilities/map-fix.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/map-fix.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/map-fix.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,162 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(include-book "cons-listp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; NOTE: this isn't actually included in top.lisp yet, because I don't want
+;; to wait an hour for everything to recertify.
+
+(defund map-fix (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (cons-fix (car x))
+            (map-fix (cdr x)))
+    nil))
+
+(defthm map-fix-when-not-consp
+  (implies (not (consp x))
+           (equal (map-fix x)
+                  nil))
+  :hints(("Goal" :in-theory (enable map-fix))))
+
+(defthm map-fix-of-cons
+  (equal (map-fix (cons a x))
+         (cons (cons-fix a)
+               (map-fix x)))
+  :hints(("Goal" :in-theory (enable map-fix))))
+
+(defthm map-fix-under-iff
+  (iff (map-fix x)
+       (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-of-map-fix
+  (equal (consp (map-fix x))
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm mapp-of-map-fix
+  (equal (mapp (map-fix x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-map-fix
+  (equal (true-listp (map-fix x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm map-fix-of-list-fix
+  (equal (map-fix (list-fix x))
+         (map-fix x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm map-fix-of-map-fix
+  (equal (map-fix (map-fix x))
+         (map-fix x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm map-fix-when-mapp
+  (implies (mapp x)
+           (equal (map-fix x)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm map-fix-of-app
+  (equal (map-fix (app x y))
+         (app (map-fix x)
+              (map-fix y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm map-fix-of-rev
+  (equal (map-fix (rev x))
+         (rev (map-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm lookup-of-map-fix
+  (equal (lookup a (map-fix x))
+         (lookup a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm domain-of-map-fix
+  (equal (domain (map-fix x))
+         (domain x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm range-of-map-fix
+  (equal (range (map-fix x))
+         (range x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm submapp1-of-map-fix-left
+  (equal (submapp1 domain (map-fix x) y)
+         (submapp1 domain x y))
+  :hints(("Goal" :induct (cdr-induction domain))))
+
+(defthm submapp1-of-map-fix-right
+  (equal (submapp1 domain x (map-fix y))
+         (submapp1 domain x y))
+  :hints(("Goal" :induct (cdr-induction domain))))
+
+(defthm submapp-of-map-fix-left
+  (equal (submapp (map-fix x) y)
+         (submapp x y))
+  :hints(("Goal" :in-theory (enable submapp))))
+
+(defthm submapp-of-map-fix-right
+  (equal (submapp (map-fix x) y)
+         (submapp x y))
+  :hints(("Goal" :in-theory (enable submapp))))
+
+(defthm cons-listp-of-map-fix
+  (equal (cons-listp (map-fix x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-map-fix-when-memberp
+  (implies (memberp a x)
+           (equal (memberp a (map-fix x))
+                  (consp a)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-map-fix-when-subsetp
+  (implies (subsetp x y)
+           (equal (subsetp x (map-fix y))
+                  (cons-listp x)))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/map-listp.lisp acl2-6.3/books/milawa/ACL2/utilities/map-listp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/map-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/map-listp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,70 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tuple-listp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(deflist map-listp (x)
+  (mapp x)
+  :elementp-of-nil t)
+
+(deflist submap-of-eachp (map x)
+  (submapp map x)
+  :guard (and (mapp map)
+              (map-listp x)))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (true-listp y)
+                   (equal (revappend x y)
+                          (app (rev x) y)))))
+
+ (local (in-theory (disable forcing-revappend-removal)))
+
+ (defprojection :list (revappend-onto-each list x)
+                :element (revappend list x)
+                :guard (true-list-listp x)))
+
+(defthm forcing-submap-of-eachp-of-revappend-onto-each
+  (implies (force (and (uniquep (domain a))
+                       (true-list-listp x)))
+           (equal (submap-of-eachp a (revappend-onto-each a x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/mergesort.lisp acl2-6.3/books/milawa/ACL2/utilities/mergesort.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/mergesort.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/mergesort.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,921 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(include-book "total-order")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; BOZO move to utilities
+
+(defthm mapp-of-rev
+  (equal (mapp (rev x))
+         (mapp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+;; We now introduce a simple mergesort.
+;;
+;; We split the list by walking down it in a funny way; see halve-list.
+;; Initially, mid and x both point to the front of the list.  We walk down x
+;; taking two steps for every one step we take for mid; hence mid stays at the
+;; middle of the list.  As we traverse mid, we puts its members into acc, and
+;; when x runs out we return both acc and the rest of mid.  This effectively
+;; lets us split the list in two (1) without doing any arithmetic, which can be
+;; expensive since we can't use fixnum declarations, and (2) while consing only
+;; (1/2)n times, where n is the length of the list.  This splitting function
+;; performs well, handily beating SETS::split-list from the ordered sets books
+;; on a large list of symbols we used to test it.
+
+(defund halve-list-aux (mid x acc)
+  (declare (xargs :guard t))
+  (if (and (consp x)
+           (consp (cdr x)))
+      (halve-list-aux (cdr mid)
+                      (cdr (cdr x))
+                      (cons (car mid) acc))
+    (cons acc mid)))
+
+(definlined halve-list (x)
+  (declare (xargs :guard t))
+  (halve-list-aux x x nil))
+
+(defthm halve-list-aux-when-not-consp
+  (implies (not (consp x))
+           (equal (halve-list-aux mid x acc)
+                  (cons acc mid)))
+  :hints(("Goal" :in-theory (enable halve-list-aux))))
+
+(defthm halve-list-aux-when-not-consp-of-cdr
+  (implies (not (consp (cdr x)))
+           (equal (halve-list-aux mid x acc)
+                  (cons acc mid)))
+  :hints(("Goal" :in-theory (enable halve-list-aux))))
+
+
+(defthm halve-list-aux-append-property
+  (implies (<= (len x) (len mid))
+           (equal (app (rev (car (halve-list-aux mid x acc)))
+                       (cdr (halve-list-aux mid x acc)))
+                  (app (rev acc)
+                       mid)))
+  :hints(("Goal" :in-theory (enable halve-list-aux))))
+
+(defthm halve-list-aux-len-1
+  (implies (and (<= (len x) (len mid))
+                (consp x)
+                (consp (cdr x)))
+           (< (len (car (halve-list-aux mid x acc)))
+              (+ (len mid) (len acc))))
+  :hints(("Goal" :in-theory (enable halve-list-aux))))
+
+(defthm halve-list-aux-len-2
+  (implies (and (<= (len x) (len mid))
+                (consp x)
+                (consp (cdr x)))
+           (< (len (cdr (halve-list-aux mid x acc)))
+              (len mid)))
+  :hints(("Goal" :in-theory (enable halve-list-aux))))
+
+(defthm halve-list-correct
+  (equal (app (rev (car (halve-list x)))
+              (cdr (halve-list x)))
+         (list-fix x))
+  :hints(("Goal" :in-theory (enable halve-list))))
+
+(defthm halve-list-len-1
+  (implies (and (consp x)
+                (consp (cdr x)))
+           (< (len (car (halve-list x)))
+              (len x)))
+  :hints(("Goal"
+          :in-theory (e/d (halve-list)
+                          (halve-list-aux-len-1))
+          :use ((:instance halve-list-aux-len-1
+                           (mid x) (x x) (acc nil))))))
+
+(defthm halve-list-len-2
+  (implies (and (consp x)
+                (consp (cdr x)))
+           (< (len (cdr (halve-list x)))
+              (len x)))
+  :hints(("Goal" :in-theory (enable halve-list))))
+
+(defthm halve-list-membership-property
+  (equal (memberp a x)
+         (or (memberp a (car (halve-list x)))
+             (memberp a (cdr (halve-list x)))))
+  :rule-classes nil
+  :hints(("Goal"
+          :in-theory (disable memberp-of-app)
+          :use ((:instance memberp-of-app
+                           (x (rev (car (halve-list x))))
+                           (y (cdr (halve-list x))))))))
+
+(defthm halve-list-lookup-property
+  (equal (lookup a x)
+         (or (lookup a (rev (car (halve-list x))))
+             (lookup a (cdr (halve-list x)))))
+  :rule-classes nil
+  :hints(("Goal"
+          :in-theory (disable lookup-of-app)
+          :use ((:instance lookup-of-app
+                           (x (rev (car (halve-list x))))
+                           (y (cdr (halve-list x))))))))
+
+(defthm mapp-of-first-of-halve-list-aux-1
+  (implies (and (<= (len x) (len mid))
+                (mapp mid)
+                (mapp acc))
+           (equal (mapp (car (halve-list-aux mid x acc)))
+                  t))
+  :hints(("Goal"
+          :in-theory (enable halve-list-aux)
+          :induct (halve-list-aux mid x acc))))
+
+(defthm mapp-of-first-of-halve-list-aux-2
+  (implies (and (mapp x)
+                (mapp mid))
+           (equal (mapp (cdr (halve-list-aux mid x acc)))
+                  t))
+  :hints(("Goal"
+          :in-theory (enable halve-list-aux)
+          :induct (halve-list-aux mid x acc))))
+
+(defthm mapp-of-first-of-halve-list-1
+  (implies (mapp x)
+           (equal (mapp (car (halve-list x)))
+                  t))
+  :hints(("Goal" :in-theory (enable halve-list))))
+
+(defthm mapp-of-first-of-halve-list-2
+  (implies (mapp x)
+           (equal (mapp (cdr (halve-list x)))
+                  t))
+  :hints(("Goal" :in-theory (enable halve-list))))
+
+
+
+
+;; Our merging operation is quite conventional.  We have decided to eat
+;; like-elements rather than preserving duplicity, so that mergesort always
+;; produces a list with unique members.  Accordingly, our notion of ordered
+;; lists requires (first x) << (second x) << (third x) << ..., which in turn
+;; means that any ordered list is a unique list.
+
+(defund ordered-listp (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (consp (cdr x))
+          (and (<< (first x) (second x))
+               (ordered-listp (cdr x)))
+        t)
+    t))
+
+(defthm ordered-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (ordered-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable ordered-listp))))
+
+(defthm ordered-listp-when-not-consp-of-cdr
+  (implies (not (consp (cdr x)))
+           (equal (ordered-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable ordered-listp))))
+
+(defthm ordered-listp-of-cons
+  (equal (ordered-listp (cons a x))
+         (if (consp x)
+             (and (<< a (car x))
+                  (ordered-listp x))
+           t))
+  :hints(("Goal" :in-theory (enable ordered-listp))))
+
+(defthm booleanp-of-ordered-listp
+  (equal (booleanp (ordered-listp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd lemma-for-uniquep-when-ordered-listp
+  (implies (and (<< a (first x))
+                (ordered-listp x))
+           (equal (memberp a x)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd uniquep-when-ordered-listp
+  (implies (ordered-listp x)
+           (uniquep x))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable lemma-for-uniquep-when-ordered-listp))))
+
+
+
+
+(defund merge-lists (x y)
+  (declare (xargs :guard (and (ordered-listp x)
+                              (ordered-listp y))
+                  :measure (+ (len x) (len y))))
+  (if (consp x)
+      (if (consp y)
+          (if (<< (car x) (car y))
+              (cons (car x) (merge-lists (cdr x) y))
+            (if (equal (car x) (car y))
+                (cons (car x) (merge-lists (cdr x) (cdr y)))
+              (cons (car y) (merge-lists x (cdr y)))))
+        x)
+    y))
+
+(defthm merge-lists-when-not-consp-left
+  (implies (not (consp x))
+           (equal (merge-lists x y)
+                  y))
+  :hints(("Goal" :in-theory (enable merge-lists))))
+
+(defthm merge-lists-when-not-consp-right
+  (implies (not (consp y))
+           (equal (merge-lists x y)
+                  (if (consp x)
+                      x
+                    y)))
+  :hints(("Goal" :in-theory (enable merge-lists))))
+
+(defthm merge-lists-of-cons-and-cons
+  (equal (merge-lists (cons a x) (cons b y))
+         (if (<< a b)
+             (cons a (merge-lists x (cons b y)))
+           (if (equal a b)
+               (cons a (merge-lists x y))
+             (cons b (merge-lists (cons a x) y)))))
+  :hints(("Goal" :in-theory (enable merge-lists))))
+
+(defthm consp-of-merge-lists
+  (equal (consp (merge-lists x y))
+         (or (consp x)
+             (consp y)))
+  :hints(("Goal" :in-theory (enable merge-lists))))
+
+(defthm smaller-than-merge-lists
+  (implies (and (<< a (car x))
+                (<< a (car y)))
+           (<< a (car (merge-lists x y))))
+  :hints(("Goal" :in-theory (enable merge-lists))))
+
+(defthm ordered-listp-of-merge-lists
+  (implies (and (ordered-listp x)
+                (ordered-listp y))
+           (ordered-listp (merge-lists x y)))
+  :hints(("Goal"
+          :induct (merge-lists x y)
+          :in-theory (enable merge-lists))))
+
+(defthm memberp-of-merge-lists
+  (equal (memberp a (merge-lists x y))
+         (or (memberp a x)
+             (memberp a y)))
+  :hints(("Goal" :in-theory (enable merge-lists))))
+
+
+
+;; Our mergesort seems to be perform pretty well.  It is faster than ACL2's
+;; SETS::mergesort in an experiment involving a long list of symbols; taking
+;; only 2.26 seconds and 308 MB of memory instead of 3.60 seconds and 584 MB.
+;; It also slightly beat ACL2::<<-sort (from books/defsort/uniquep) on time,
+;; 2.26 seconds versus 2.8 seconds, but ACL2::<<-sort seemed to use only about
+;; half the memory.  I'm not sure what trick it's using to accomplish that.
+
+(defund mergesort (x)
+  (declare (xargs :guard t
+                  :measure (len x)
+                  :verify-guards nil))
+  (cond ((not (consp x))
+         nil)
+        ((not (consp (cdr x)))
+         (list (car x)))
+        (t
+         (let ((split (halve-list x)))
+           (merge-lists (mergesort (car split))
+                        (mergesort (cdr split)))))))
+
+(defthm mergesort-when-not-consp
+  (implies (not (consp x))
+           (equal (mergesort x)
+                  nil))
+  :hints(("Goal" :in-theory (enable mergesort))))
+
+(defthm mergesort-when-not-consp-of-cdr
+  (implies (and (not (consp (cdr x)))
+                (consp x))
+           (equal (mergesort x)
+                  (list (car x))))
+  :hints(("Goal" :in-theory (enable mergesort))))
+
+(defthm ordered-listp-of-mergesort
+  (equal (ordered-listp (mergesort x))
+         t)
+  :hints(("Goal" :in-theory (enable mergesort))))
+
+(verify-guards mergesort)
+
+(defthm uniquep-of-mergesort
+  (equal (uniquep (mergesort x))
+         t)
+  :hints(("Goal" :in-theory (enable uniquep-when-ordered-listp))))
+
+
+
+(defthmd lemma-for-memberp-of-mergesort
+  (implies (and (NOT (MEMBERP A (CAR (HALVE-LIST X))))
+                (NOT (MEMBERP A (CDR (HALVE-LIST X)))))
+           (not (MEMBERP A X)))
+  :hints(("Goal" :use ((:instance halve-list-membership-property)))))
+
+(defthmd lemma-2-for-memberp-of-mergesort
+  (implies (or (MEMBERP A (CAR (HALVE-LIST X)))
+               (MEMBERP A (CDR (HALVE-LIST X))))
+           (MEMBERP A X))
+  :hints(("Goal" :use ((:instance halve-list-membership-property)))))
+
+(defthm memberp-of-mergesort
+  (equal (memberp a (mergesort x))
+         (memberp a x))
+  :hints(("Goal"
+          :induct (mergesort x)
+          :in-theory (enable mergesort
+                             lemma-for-memberp-of-mergesort
+                             lemma-2-for-memberp-of-mergesort))))
+
+(defthm subsetp-of-mergesort-left
+  (equal (subsetp (mergesort x) y)
+         (subsetp x y))
+  :hints(("Goal"
+          :use ((:instance subsetp-badguy-membership-property
+                           (x (mergesort x))
+                           (y y))
+                (:instance subsetp-badguy-membership-property
+                           (x x)
+                           (y y))))))
+
+(defthm subsetp-of-mergesort-right
+  (equal (subsetp x (mergesort y))
+         (subsetp x y))
+  :hints(("Goal"
+          :use ((:instance subsetp-badguy-membership-property
+                           (x x)
+                           (y (mergesort y)))))))
+
+
+
+;; An important application of mergesort is to implement an O(n log_2 n) subset
+;; check for use on long lists.  We introducing a linear subset check which can
+;; be used in place of subsetp when both lists are ordered.  We considered
+;; implementing a "fast-subsetp" function that would automatically determine
+;; whether it seemed like mergesorting would likely be useful or not, but in
+;; the end we decided that the criteria for this choice was fairly complex and
+;; we would rather just have the caller figure out which one they thing is
+;; appropriate.
+
+(defund ordered-list-subsetp (x y)
+  (declare (xargs :guard (and (ordered-listp x)
+                              (ordered-listp y))))
+  (if (consp x)
+      (if (consp y)
+          (if (equal (car x) (car y))
+              (ordered-list-subsetp (cdr x) (cdr y))
+            (ordered-list-subsetp x (cdr y)))
+        nil)
+    t))
+
+(defthm booleanp-of-ordered-list-subsetp
+  (equal (booleanp (ordered-list-subsetp x y))
+         t)
+  :hints(("Goal" :in-theory (enable ordered-list-subsetp))))
+
+
+(defthmd lemma-1-for-ordered-list-subsetp-property
+  (implies (and (not (equal a (first y)))
+                (not (consp (cdr y))))
+           (equal (memberp a y)
+                  nil)))
+
+(defthmd lemma-2-for-ordered-list-subsetp-property
+  (implies (and (not (equal (first x) (first y)))
+                (not (consp (cdr y))))
+           (equal (subsetp x y)
+                  (not (consp x)))))
+
+(defthmd lemma-3-for-ordered-list-subsetp-property
+  (implies (and (not (equal (first x) (first y)))
+                (subsetp x y)
+                (ordered-listp x)
+                (ordered-listp y))
+           (equal (subsetp x (cdr y))
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable lemma-2-for-ordered-list-subsetp-property
+                             lemma-for-uniquep-when-ordered-listp
+                             ))))
+
+(defthmd lemma-4-for-ordered-list-subsetp-property
+  (implies (and (equal (first x) (first y))
+                (subsetp x y)
+                (ordered-listp x)
+                (ordered-listp y))
+           (equal (subsetp (cdr x) (cdr y))
+                  t))
+  :hints(("Goal"
+          :in-theory (enable (:induction ordered-listp)
+                             lemma-1-for-ordered-list-subsetp-property
+                             lemma-2-for-ordered-list-subsetp-property
+                             lemma-3-for-ordered-list-subsetp-property))))
+
+(defthm ordered-list-subsetp-property
+  (implies (and (force (ordered-listp x))
+                (force (ordered-listp y)))
+           (equal (ordered-list-subsetp x y)
+                  (subsetp x y)))
+  :hints(("Goal"
+          :in-theory (enable ordered-list-subsetp
+                             lemma-1-for-ordered-list-subsetp-property
+                             lemma-2-for-ordered-list-subsetp-property
+                             lemma-3-for-ordered-list-subsetp-property
+                             lemma-4-for-ordered-list-subsetp-property)
+          :induct (ordered-list-subsetp x y))))
+
+
+
+;; We would now also like to develop a faster submapp check for times when we
+;; are dealing with large maps.  Here, we have a problem with simply using
+;; mergesort.  In particular, so-called "hidden pairs" in the map might be
+;; smaller in the term order than the "visible pairs" in front of them.  For
+;; example, consider (mergesort '((a . 3) (a . 2))).
+;;
+;; We begin by developing mergesort-map, which simultaneously removes any
+;; shadowed pairs and leaves the map sorted by its keys.  This is basically the
+;; same as the mergesort above, except that our merging function only inspects
+;; the keys.
+
+(defund ordered-mapp (x)
+  (declare (xargs :guard (mapp x)))
+  (if (consp x)
+      (if (consp (cdr x))
+          (and (<< (car (first x))
+                   (car (second x)))
+               (ordered-mapp (cdr x)))
+        t)
+    t))
+
+(defthm ordered-mapp-when-not-consp
+  (implies (not (consp x))
+           (equal (ordered-mapp x)
+                  t))
+  :hints(("Goal" :in-theory (enable ordered-mapp))))
+
+(defthm ordered-mapp-when-not-consp-of-cdr
+  (implies (not (consp (cdr x)))
+           (equal (ordered-mapp x)
+                  t))
+  :hints(("Goal" :in-theory (enable ordered-mapp))))
+
+(defthm ordered-mapp-of-cons
+  (equal (ordered-mapp (cons a x))
+         (if (consp x)
+             (and (<< (car a) (car (first x)))
+                  (ordered-mapp x))
+           t))
+  :hints(("Goal" :in-theory (enable ordered-mapp))))
+
+(defthm booleanp-of-ordered-mapp
+  (equal (booleanp (ordered-mapp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm ordered-mapp-of-cdr-when-ordered-mapp
+  (implies (ordered-mapp x)
+           (ordered-mapp (cdr x))))
+
+(defthmd lemma-for-uniquep-when-ordered-mapp
+  (implies (and (<< a (car (first x)))
+                (ordered-mapp x))
+           (equal (lookup a x)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm uniquep-of-domain-when-ordered-mapp
+  (implies (ordered-mapp x)
+           (equal (uniquep (domain x))
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable lemma-for-uniquep-when-ordered-mapp))))
+
+
+
+
+(defund merge-maps (x y)
+  (declare (xargs :guard (and (mapp x)
+                              (mapp y)
+                              (ordered-mapp x)
+                              (ordered-mapp y))
+                  :measure (+ (len x) (len y))
+                  :verify-guards nil))
+  (if (consp x)
+      (if (consp y)
+          (if (<< (car (first x)) (car (first y)))
+              (cons (first x) (merge-maps (cdr x) y))
+            (if (equal (car (first x)) (car (first y)))
+                (cons (first x) (merge-maps (cdr x) (cdr y)))
+              (cons (first y) (merge-maps x (cdr y)))))
+        x)
+    y))
+
+(defthm merge-maps-when-not-consp-left
+  (implies (not (consp x))
+           (equal (merge-maps x y)
+                  y))
+  :hints(("Goal" :in-theory (enable merge-maps))))
+
+(defthm merge-maps-when-not-consp-right
+  (implies (not (consp y))
+           (equal (merge-maps x y)
+                  (if (consp x)
+                      x
+                    y)))
+  :hints(("Goal" :in-theory (enable merge-maps))))
+
+(defthm merge-maps-of-cons-and-cons
+  (equal (merge-maps (cons a x) (cons b y))
+         (if (<< (car a) (car b))
+             (cons a (merge-maps x (cons b y)))
+           (if (equal (car a) (car b))
+               (cons a (merge-maps x y))
+             (cons b (merge-maps (cons a x) y)))))
+  :hints(("Goal" :in-theory (enable merge-maps))))
+
+(defthm consp-of-merge-maps
+  (equal (consp (merge-maps x y))
+         (or (consp x)
+             (consp y)))
+  :hints(("Goal" :in-theory (enable merge-maps))))
+
+(defthm lookup-of-first-of-first
+  (iff (lookup (first (first x)) x)
+       (consp x)))
+
+(defthm lookup-when-not-first-of-first
+  (implies (not (equal a (first (first x))))
+           (equal (lookup a (cdr x))
+                  (lookup a x))))
+
+(defthm smaller-than-merge-maps
+  (implies (and (<< a (car (car x)))
+                (<< a (car (car y))))
+           (<< a (car (car (merge-maps x y)))))
+  :hints(("Goal" :in-theory (enable merge-maps))))
+
+(defthm ordered-mapp-of-merge-maps
+  (implies (and (ordered-mapp x)
+                (ordered-mapp y))
+           (equal (ordered-mapp (merge-maps x y))
+                  t))
+  :hints(("Goal"
+          :induct (merge-maps x y)
+          :expand ((merge-maps x y))
+          :in-theory (enable (:induction merge-maps)))))
+
+(defthm mapp-of-merge-maps
+  (implies (and (mapp x)
+                (mapp y))
+           (equal (mapp (merge-maps x y))
+                  t))
+  :hints(("Goal" :in-theory (enable merge-maps))))
+
+(verify-guards merge-maps)
+
+(defthm lookup-of-merge-maps
+  (implies (and (ordered-mapp x)
+                (ordered-mapp y))
+           (equal (lookup a (merge-maps x y))
+                  (or (lookup a x)
+                      (lookup a y))))
+  :hints(("Goal" :in-theory (enable merge-maps
+                                    lemma-for-uniquep-when-ordered-mapp
+                                    lemma-2-for-ordered-list-subsetp-property))))
+
+
+
+(defund mergesort-map (x)
+  (declare (xargs :guard (mapp x)
+                  :measure (len x)
+                  :verify-guards nil))
+  (cond ((not (consp x))
+         nil)
+        ((not (consp (cdr x)))
+         (list (car x)))
+        (t
+         (let ((split (halve-list x)))
+           ;; Note that halve-list works in an accumulator style and reverses
+           ;; the first half of the list.  We have to un-reverse it for our
+           ;; lookup lemmas to hold.
+           (merge-maps (mergesort-map (fast-rev (car split)))
+                       (mergesort-map (cdr split)))))))
+
+(defthm mergesort-map-when-not-consp
+  (implies (not (consp x))
+           (equal (mergesort-map x)
+                  nil))
+  :hints(("Goal" :in-theory (enable mergesort-map))))
+
+(defthm mergesort-map-when-not-consp-of-cdr
+  (implies (not (consp (cdr x)))
+           (equal (mergesort-map x)
+                  (if (consp x)
+                      (list (car x))
+                    nil)))
+  :hints(("Goal" :in-theory (enable mergesort-map))))
+
+(defthm mapp-of-mergesort-map
+  (implies (mapp x)
+           (equal (mapp (mergesort-map x))
+                  t))
+  :hints(("Goal" :in-theory (enable mergesort-map))))
+
+(defthm ordered-mapp-of-mergesort-map
+  (equal (ordered-mapp (mergesort-map x))
+         t)
+  :hints(("Goal" :in-theory (enable mergesort-map ordered-mapp))))
+
+(verify-guards mergesort-map)
+
+(defthm uniquep-of-domain-of-mergesort-map
+  (equal (uniquep (domain (mergesort-map x)))
+         t))
+
+(defthmd lemma-1-for-lookup-of-mergesort-map
+  (implies (not (lookup a (REV (FIRST (HALVE-LIST X)))))
+           (equal (lookup a (cdr (halve-list x)))
+                  (lookup a x)))
+  :hints(("Goal" :use ((:instance halve-list-lookup-property)))))
+
+(defthmd lemma-2-for-lookup-of-mergesort-map
+  (implies (LOOKUP A (REV (FIRST (HALVE-LIST X))))
+           (equal (LOOKUP A (REV (FIRST (HALVE-LIST X))))
+                  (lookup a x)))
+  :hints(("Goal" :use ((:instance halve-list-lookup-property)))))
+
+(defthm lookup-of-mergesort-map
+  (equal (lookup a (mergesort-map x))
+         (lookup a x))
+  :hints(("Goal"
+          :induct (mergesort-map x)
+          :in-theory (enable mergesort-map
+                             lemma-1-for-lookup-of-mergesort-map
+                             lemma-2-for-lookup-of-mergesort-map))))
+
+(defthm submapp-of-mergesort-map-and-self-left
+  (equal (submapp (mergesort-map x) x)
+         t)
+  :hints(("Goal" :use ((:instance submapp-badguy-membership-property
+                                  (x (mergesort-map x))
+                                  (y x))))))
+
+(defthm submapp-of-mergesort-map-and-self-right
+  (equal (submapp x (mergesort-map x))
+         t)
+  :hints(("Goal" :use ((:instance submapp-badguy-membership-property
+                                  (y (mergesort-map x))
+                                  (x x))))))
+
+(defthm submapp-of-mergesort-map-left
+  (equal (submapp (mergesort-map x) y)
+         (submapp x y)))
+
+(defthm submapp-of-mergesort-map-right
+  (equal (submapp x (mergesort-map y))
+         (submapp x y)))
+
+
+
+;; Here is our fast submapp check that can be applied once the two maps have
+;; been standardized using mergesort-map.  Although there are many lemmas for
+;; the correctness proof here, they're each pretty straightforward and just
+;; address the particular cases.
+
+(defund ordered-map-submapp (x y)
+  (declare (xargs :guard (and (mapp x)
+                              (mapp y)
+                              (ordered-mapp x)
+                              (ordered-mapp y))))
+  (if (consp x)
+      (if (consp y)
+          (if (equal (car (car x))
+                     (car (car y)))
+              (and (equal (cdr (car x))
+                          (cdr (car y)))
+                   (ordered-map-submapp (cdr x) (cdr y)))
+            (if (<< (car (car x))
+                    (car (car y)))
+                nil
+              (ordered-map-submapp x (cdr y))))
+        nil)
+    t))
+
+(defthm ordered-map-submapp-when-not-consp-left
+  (implies (not (consp x))
+           (equal (ordered-map-submapp x y)
+                  t))
+  :hints(("Goal" :in-theory (enable ordered-map-submapp))))
+
+(defthm ordered-map-submapp-when-not-consp-right
+  (implies (not (consp y))
+           (equal (ordered-map-submapp x y)
+                  (not (consp x))))
+  :hints(("Goal" :in-theory (enable ordered-map-submapp))))
+
+(defthm ordered-map-submapp-of-cons-and-cons
+  (equal (ordered-map-submapp (cons a x) (cons b y))
+         (if (equal (car a) (car b))
+             (and (equal (cdr a) (cdr b))
+                  (ordered-map-submapp x y))
+           (if (<< (car a) (car b))
+               nil
+             (ordered-map-submapp (cons a x) y))))
+  :hints(("Goal" :in-theory (enable ordered-map-submapp))))
+
+(defthm booleanp-of-ordered-map-submapp
+  (equal (booleanp (ordered-map-submapp x y))
+         t)
+  :hints(("Goal" :in-theory (enable ordered-map-submapp))))
+
+(defthmd lemma-1-for-ordered-map-submapp-property
+  (implies (and (not (equal a (car (first y))))
+                (not (consp (cdr y))))
+           (equal (lookup a y)
+                  nil)))
+
+(defthmd lemma-2-for-ordered-map-submapp-property
+  (implies (and (not (equal (car (first x)) (car (first y))))
+                (not (consp (cdr y))))
+           (equal (submapp x y)
+                  (not (consp x))))
+  :hints(("Goal" :in-theory (enable submapp))))
+
+(defthmd lemma-3-for-ordered-map-submapp-property
+  (implies (and (consp x)
+                (not (consp y)))
+           (equal (submapp x y)
+                  nil))
+  :hints(("Goal"
+          :in-theory (disable equal-of-lookups-when-submapp)
+          :use ((:instance equal-of-lookups-when-submapp
+                           (x x)
+                           (y y)
+                           (a (car (car x))))))))
+
+(defthmd lemma-4-for-ordered-map-submapp-property-aux
+  (implies (not (memberp (first (first y)) dom))
+           (equal (submapp1 dom x (cdr y))
+                  (submapp1 dom x y)))
+  :hints(("Goal" :in-theory (enable submapp1))))
+
+(defthmd lemma-4-for-ordered-map-submapp-property
+   (implies (and (submapp x y)
+                 (not (equal (first (first x)) (first (first y))))
+                 (not (<< (first (first x)) (first (first y))))
+                 (ordered-mapp x))
+            (equal (submapp x (cdr y))
+                   t))
+   :hints(("Goal"
+           :in-theory (enable lemma-4-for-ordered-map-submapp-property-aux
+                              lemma-for-uniquep-when-ordered-mapp
+                              submapp))))
+
+(defthmd lemma-5-for-ordered-map-submapp-property
+  (implies (and (not (equal (first (first x)) (first (first y))))
+                (<< (first (first x)) (first (first y)))
+                (ordered-mapp y)
+                (consp x))
+           (equal (submapp x y)
+                  nil))
+  :hints(("Goal"
+          :in-theory (disable lemma-for-uniquep-when-ordered-mapp)
+          :use ((:instance lemma-for-uniquep-when-ordered-mapp
+                           (a (first (first x)))
+                           (x y))))))
+
+(defthmd lemma-6-for-ordered-map-submapp-property
+  (implies (and (consp x)
+                (equal (first (first x)) (first (first y)))
+                (not (equal (cdr (first x)) (cdr (first y)))))
+           (equal (submapp x y)
+                  nil))
+  :hints(("Goal"
+          :in-theory (e/d (equal-of-cons-rewrite-constants)
+                          (equal-of-lookups-when-submapp))
+          :use ((:instance equal-of-lookups-when-submapp
+                           (a (first (first x)))
+                           (x x)
+                           (y y))))))
+
+(defthmd lemma-7-for-ordered-map-submapp-property-aux
+  (implies (and (equal (first (first x)) (first (first y)))
+                (equal (cdr (first x)) (cdr (first y)))
+                (consp x)
+                (consp y))
+           (equal (submapp1 (remove-all (first (first x)) dom) (cdr x) (cdr y))
+                  (submapp1 dom x y)))
+  :hints(("Goal" :in-theory (enable submapp1))))
+
+(defthmd lemma-7-for-ordered-map-submapp-property
+  (implies (and (equal (first (first x)) (first (first y)))
+                (equal (cdr (first x)) (cdr (first y)))
+                (ordered-mapp x)
+                (consp x)
+                (consp y))
+           (equal (submapp (cdr x) (cdr y))
+                  (submapp x y)))
+  :hints(("Goal"
+          :in-theory (enable submapp
+                             lemma-for-uniquep-when-ordered-mapp)
+          :use ((:instance lemma-7-for-ordered-map-submapp-property-aux
+                           (dom (domain x)))))))
+
+(defthm ordered-map-submapp-property
+  (implies (and (force (ordered-mapp x))
+                (force (ordered-mapp y)))
+           (equal (ordered-map-submapp x y)
+                  (submapp x y)))
+  :hints(("Goal"
+          :in-theory (enable ordered-map-submapp
+                             lemma-1-for-ordered-map-submapp-property
+                             lemma-2-for-ordered-map-submapp-property
+                             lemma-3-for-ordered-map-submapp-property
+                             lemma-4-for-ordered-map-submapp-property
+                             lemma-5-for-ordered-map-submapp-property
+                             lemma-6-for-ordered-map-submapp-property
+                             lemma-7-for-ordered-map-submapp-property)
+          :induct (ordered-map-submapp x y))))
+
+
+
+(defthmd lemma-for-ordered-listp-when-ordered-mapp
+  (implies (and (<< (car a) (car b))
+                (consp a)
+                (consp b))
+           (equal (<< a b)
+                  t))
+  :hints(("Goal" :in-theory (enable <<))))
+
+(defthm ordered-listp-when-ordered-mapp
+  (implies (and (ordered-mapp x)
+                (force (mapp x)))
+           (equal (ordered-listp x)
+                  t))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :expand (ordered-listp x)
+          :in-theory (enable lemma-for-ordered-listp-when-ordered-mapp))))
+
+(defthm ordered-listp-of-mergesort-map
+  (implies (mapp x)
+           (equal (ordered-listp (mergesort-map x))
+                  t)))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/multicons.lisp acl2-6.3/books/milawa/ACL2/utilities/multicons.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/multicons.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/multicons.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,69 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cons-listp")
+(include-book "mutually-disjoint")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund multicons (e x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (cons e (car x))
+            (multicons e (cdr x)))
+    nil))
+
+;; BOZO the macro isn't proving this on its own??
+(defthm car-of-multicons
+  (equal (car (multicons e x))
+         (if (consp x) (cons e (car x)) nil))
+  :hints(("Goal" :in-theory (enable multicons))))
+
+(defprojection
+  :list (multicons e x)
+  :element (cons e x))
+
+(defthm cons-listp-of-multicons
+  (equal (cons-listp (multicons e x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-nonep-of-multicons
+  (equal (disjoint-from-nonep e (multicons a x))
+         (or (memberp a e)
+             (disjoint-from-nonep e x)))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/mutually-disjoint.lisp acl2-6.3/books/milawa/ACL2/utilities/mutually-disjoint.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/mutually-disjoint.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/mutually-disjoint.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,883 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "cons-listp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; (member-of-nonep a xs)
+;;
+;; a is interpreted as an element and xs is interpreted as a chain.  We return
+;; true if a is not a member of any x in xs.
+
+(deflist member-of-nonep (e x)
+  (memberp e x)
+  :negatedp t
+  :elementp-of-nil nil)
+
+
+
+;; (defund member-of-nonep (a xs)
+;;   (if (consp xs)
+;;       (and (not (memberp a (car xs)))
+;;            (member-of-nonep a (cdr xs)))
+;;     t))
+
+;; (defthm member-of-nonep-when-not-consp
+;;   (implies (not (consp xs))
+;;            (equal (member-of-nonep a xs)
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable member-of-nonep))))
+
+;; (defthm member-of-nonep-of-cons
+;;   (equal (member-of-nonep a (cons x xs))
+;;          (and (not (memberp a x))
+;;               (member-of-nonep a xs)))
+;;   :hints(("Goal" :in-theory (enable member-of-nonep))))
+
+;; (defthm booleanp-of-member-of-nonep
+;;   (equal (booleanp (member-of-nonep a xs))
+;;          t)
+;;   :hints(("Goal" :induct (cdr-induction xs))))
+
+;; (defthm member-of-nonep-of-list-fix
+;;   (equal (member-of-nonep a (list-fix xs))
+;;          (member-of-nonep a xs))
+;;   :hints(("Goal" :induct (cdr-induction xs))))
+
+;; (defthm member-of-nonep-of-app
+;;   (equal (member-of-nonep a (app xs ys))
+;;          (and (member-of-nonep a xs)
+;;               (member-of-nonep a ys)))
+;;   :hints(("Goal" :induct (cdr-induction xs))))
+
+;; (defthm member-of-nonep-of-rev
+;;   (equal (member-of-nonep a (rev xs))
+;;          (member-of-nonep a xs))
+;;   :hints(("Goal" :induct (cdr-induction xs))))
+
+;; (defthm member-of-nonep-of-remove-all-when-member-of-nonep
+;;   (implies (member-of-nonep a xs)
+;;            (equal (member-of-nonep a (remove-all x xs))
+;;                   t))
+;;   :hints(("Goal" :induct (cdr-induction xs))))
+
+;; (defthm memberp-when-memberp-of-member-of-nonep
+;;   (implies (and (member-of-nonep a xs)
+;;                 (memberp x xs))
+;;            (equal (memberp a x)
+;;                   nil))
+;;   :hints(("Goal" :induct (cdr-induction xs))))
+
+;; (defthm memberp-when-memberp-of-member-of-nonep-alt
+;;   (implies (and (memberp x xs)
+;;                 (member-of-nonep a xs))
+;;            (equal (memberp a x)
+;;                   nil)))
+
+;; (defthm member-of-nonep-when-subsetp-of-member-of-nonep
+;;   (implies (and (member-of-nonep a ys)
+;;                 (subsetp xs ys))
+;;            (equal (member-of-nonep a xs)
+;;                   t))
+;;   :hints(("Goal" :induct (cdr-induction xs))))
+
+;; (defthm member-of-nonep-when-subsetp-of-member-of-nonep-two
+;;   (implies (and (subsetp xs ys)
+;;                 (member-of-nonep a ys))
+;;            (equal (member-of-nonep a xs)
+;;                   t)))
+
+;; (thm (implies (member-of-nonep a (remove-all x xs))
+;;                (member-of-nonep a (remove-all x (remove-all y xs)))))
+;;
+;; (thm (implies (member-of-nonep a (remove-all x xs))
+;;               (member-of-nonep a (remove-all y (remove-all x xs)))))
+
+
+
+
+
+
+;; (lists-lookup a xs)
+;;
+;; a is interpreted as an element and xs as a list of lists.  We return the
+;; first x in xs which includes a as a member, or nil if no such list exists.
+
+(defund lists-lookup (a xs)
+  (declare (xargs :guard t))
+  (if (consp xs)
+      (if (memberp a (car xs))
+          (car xs)
+        (lists-lookup a (cdr xs)))
+    nil))
+
+(defthm lists-lookup-when-not-consp
+  (implies (not (consp xs))
+           (equal (lists-lookup a xs)
+                  nil))
+  :hints(("Goal" :in-theory (enable lists-lookup))))
+
+(defthm lists-lookup-of-cons
+  (equal (lists-lookup a (cons x xs))
+         (if (memberp a x)
+             x
+           (lists-lookup a xs)))
+  :hints(("Goal" :in-theory (enable lists-lookup))))
+
+(defthm lists-lookup-of-list-fix
+  (equal (lists-lookup a (list-fix xs))
+         (lists-lookup a xs))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm lists-lookup-of-app
+  (equal (lists-lookup a (app xs ys))
+         (if (lists-lookup a xs)
+             (lists-lookup a xs)
+           (lists-lookup a ys)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm consp-of-lists-lookup
+  (equal (consp (lists-lookup a xs))
+         (not (member-of-nonep a xs)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm lists-lookup-under-iff
+  (iff (lists-lookup a xs)
+       (not (member-of-nonep a xs)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm lists-lookup-of-rev-under-iff
+  (iff (lists-lookup a (rev xs))
+       (not (member-of-nonep a xs)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm memberp-of-element-in-lists-lookup
+  (implies (not (member-of-nonep a xs))
+           (equal (memberp a (lists-lookup a xs))
+                  t))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm memberp-of-in-lists-lookup-in-lists
+  (implies (not (member-of-nonep a xs))
+           (equal (memberp (lists-lookup a xs) xs)
+                  t))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+
+
+
+
+;; (none-consp x)
+;;
+;; x is interpreted as a list.
+;;
+;; We return true if all of x's members are not conses.
+
+(deflist none-consp (x)
+  (consp x)
+  :negatedp t
+  :elementp-of-nil nil)
+
+;; (defund none-consp (x)
+;;   (declare (xargs :guard t))
+;;   (if (consp x)
+;;       (and (not (consp (car x)))
+;;            (none-consp (cdr x)))
+;;     t))
+
+;; (defthm none-consp-when-not-consp
+;;   (implies (not (consp x))
+;;            (equal (none-consp x)
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable none-consp))))
+
+;; (defthm none-consp-of-cons
+;;   (equal (none-consp (cons a x))
+;;          (and (not (consp a))
+;;               (none-consp x)))
+;;   :hints(("Goal" :in-theory (enable none-consp))))
+
+;; (defthm none-consp-of-list-fix
+;;   (equal (none-consp (list-fix x))
+;;          (none-consp x))
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+;; (defthm booleanp-of-none-consp
+;;   (equal (booleanp (none-consp x))
+;;          t)
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+;; (defthm none-consp-of-app
+;;   (equal (none-consp (app x y))
+;;          (and (none-consp x)
+;;               (none-consp y)))
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+;; (defthm none-consp-of-rev
+;;   (equal (none-consp (rev x))
+;;          (none-consp x))
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+;; (defthm none-consp-of-cdr-when-none-consp
+;;   (implies (none-consp x)
+;;            (equal (none-consp (cdr x))
+;;                   t)))
+
+;; (defthm consp-of-car-when-none-consp
+;;   (implies (none-consp x)
+;;            (equal (consp (car x))
+;;                   nil)))
+
+
+
+
+
+
+;; (disjoint-from-allp x ys)
+;;
+;; x is interpreted as a list, and ys is interpreted as a chain.  We return
+;; true if x is disjoint from every list in ys.  We can think about this
+;; function in two ways:
+;;
+;;   - We are checking that each y in ys is disjoint from x.
+;;   - We are checking that each a in x is a member of none of the ys.
+;;
+;; This is a little odd and it leads us to different styles of rules based on
+;; which argument is being manipulated.  I've arbitrarily implemented the
+;; function using the first approach.
+
+(deflist disjoint-from-allp (e x)
+  (disjointp e x)
+  :elementp-of-nil t)
+
+;; (defund disjoint-from-allp (x ys)
+;;   (declare (xargs :guard t))
+;;   (if (consp ys)
+;;       (and (disjointp x (car ys))
+;;            (disjoint-from-allp x (cdr ys)))
+;;     t))
+
+;; (defthm disjoint-from-allp-when-not-consp-two
+;;   (implies (not (consp x))
+;;            (equal (disjoint-from-allp e x)
+;;                   t))
+;;   :hints(("Goal" :in-theory (enable disjoint-from-allp))))
+
+;; (defthm disjoint-from-allp-of-cons-two
+;;   (equal (disjoint-from-allp x (cons y ys))
+;;          (and (disjointp x y)
+;;               (disjoint-from-allp x ys)))
+;;   :hints(("Goal" :in-theory (enable disjoint-from-allp))))
+
+;; (defthm booleanp-of-disjoint-from-allp
+;;   (equal (booleanp (disjoint-from-allp e x))
+;;          t)
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-allp-when-not-consp-left
+  (implies (not (consp e))
+           (equal (disjoint-from-allp e x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-allp-of-cons-left
+  (equal (disjoint-from-allp (cons a e) x)
+         (and (member-of-nonep a x)
+              (disjoint-from-allp e x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-allp-of-cdr-left
+  (implies (disjoint-from-allp e x)
+           (disjoint-from-allp (cdr e) x)))
+
+(defthm member-of-nonep-when-memberp-of-disjoint-from-allp
+  (implies (and (disjoint-from-allp e x)
+                (memberp a e))
+           (equal (member-of-nonep a x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm member-of-nonep-when-memberp-of-disjoint-from-allp-alt
+  (implies (and (memberp a e)
+                (disjoint-from-allp e x))
+           (equal (member-of-nonep a x)
+                  t)))
+
+;; BOZO rename vars
+(defthm disjointp-when-memberp-of-disjoint-from-allp-one
+  (implies (and (disjoint-from-allp x ys)
+                (memberp y ys))
+           (equal (disjointp x y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+;; BOZO rename vars
+(defthm disjointp-when-memberp-of-disjoint-from-allp-two
+  (implies (and (memberp y ys)
+                (disjoint-from-allp x ys))
+           (equal (disjointp x y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+;; BOZO rename vars
+(defthm disjointp-when-memberp-of-disjoint-from-allp-three
+  (implies (and (disjoint-from-allp x ys)
+                (memberp y ys))
+           (equal (disjointp y x)
+                  t)))
+
+;; BOZO rename vars
+(defthm disjointp-when-memberp-of-disjoint-from-allp-four
+  (implies (and (memberp y ys)
+                (disjoint-from-allp x ys))
+           (equal (disjointp y x)
+                  t)))
+
+
+;; disjoint-from-allp-when-subsetp-of-disjoint-from-allp-[one,...]
+;;
+;; If we know that (disjoint-from-allp z zs), then
+;;
+;;   (subsetp x z) -> (disjoint-from-allp x zs)
+;;   (subsetp ys zs) -> (disjoint-from-allp x ys)
+
+;; BOZO rename vars
+(defthm disjoint-from-allp-when-subsetp-of-disjoint-from-allp-one
+  (implies (and (disjoint-from-allp z zs)
+                (subsetp x z))
+           (equal (disjoint-from-allp x zs)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+;; BOZO rename vars
+(defthm disjoint-from-allp-when-subsetp-of-disjoint-from-allp-two
+  (implies (and (subsetp x z)
+                (disjoint-from-allp z zs))
+           (equal (disjoint-from-allp x zs)
+                  t)))
+
+;; BOZO rename vars
+(defthm disjoint-from-allp-when-subsetp-of-disjoint-from-allp-three
+  (implies (and (disjoint-from-allp z zs)
+                (subsetp ys zs))
+           (equal (disjoint-from-allp z ys)
+                  t))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+;; BOZO rename vars
+(defthm disjoint-from-allp-when-subsetp-of-disjoint-from-allp-four
+  (implies (and (subsetp ys zs)
+                (disjoint-from-allp z zs))
+           (equal (disjoint-from-allp z ys)
+                  t)))
+
+;; BOZO rename vars  (im not going to keep writing this, through teh file)
+(defthm disjoint-from-allp-when-memberp
+  (implies (memberp x ys)
+           (equal (disjoint-from-allp x ys)
+                  (not (consp x))))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+
+(defthm disjoint-from-allp-of-list-fix-left
+  (equal (disjoint-from-allp (list-fix x) ys)
+         (disjoint-from-allp x ys)))
+
+;; (defthm disjoint-from-allp-of-list-fix
+;;   (equal (disjoint-from-allp x (list-fix ys))
+;;          (disjoint-from-allp x ys)))
+
+
+(defthm disjoint-from-allp-of-app-left
+  (equal (disjoint-from-allp (app x y) zs)
+         (and (disjoint-from-allp x zs)
+              (disjoint-from-allp y zs)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+;; (defthm disjoint-from-allp-of-app
+;;   (equal (disjoint-from-allp x (app ys zs))
+;;          (and (disjoint-from-allp x ys)
+;;               (disjoint-from-allp x zs)))
+;;   :hints(("Goal" :induct (cdr-induction ys))))
+
+
+(defthm disjoint-from-allp-of-rev-left
+  (equal (disjoint-from-allp (rev x) ys)
+         (disjoint-from-allp x ys))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+;; (defthm disjoint-from-allp-of-rev
+;;   (equal (disjoint-from-allp e (rev x))
+;;          (disjoint-from-allp e x))
+;;   :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-all-when-disjoint-from-allp-and-cons-listp
+  (implies (and (disjoint-from-allp a x)
+                (cons-listp x))
+           (equal (remove-all a x)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+;; These test theorems should prove easily.
+;;
+;; (thm (implies (disjoint-from-allp x ys) (disjoint-from-allp (remove-all a x) ys)))
+;; (thm (implies (disjoint-from-allp x ys) (disjoint-from-allp x (remove-all b ys))))
+
+
+
+
+;; (all-disjoint-from-allp xs ys)
+;;
+;; xs and ys are interpreted as chains.  We return true if every x in xs is
+;; disjoint from every y in ys.
+
+;; BOZO migrate to deflist
+
+(defund all-disjoint-from-allp (xs ys)
+  (declare (xargs :guard t))
+  (if (consp xs)
+      (and (disjoint-from-allp (car xs) ys)
+           (all-disjoint-from-allp (cdr xs) ys))
+    t))
+
+(defthm all-disjoint-from-allp-when-not-consp-one
+  (implies (not (consp xs))
+           (equal (all-disjoint-from-allp xs ys)
+                  t))
+  :hints(("Goal" :in-theory (enable all-disjoint-from-allp))))
+
+(defthm all-disjoint-from-allp-of-cons-one
+  (equal (all-disjoint-from-allp (cons x xs) ys)
+         (and (disjoint-from-allp x ys)
+              (all-disjoint-from-allp xs ys)))
+  :hints(("Goal" :in-theory (enable all-disjoint-from-allp))))
+
+(defthm all-disjoint-from-allp-when-not-consp-two
+  (implies (not (consp ys))
+           (equal (all-disjoint-from-allp xs ys)
+                  t))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm all-disjoint-from-allp-of-cons-two
+  (equal (all-disjoint-from-allp xs (cons y ys))
+         (and (disjoint-from-allp y xs)
+              (all-disjoint-from-allp xs ys)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm booleanp-of-all-disjoint-from-allp
+  (equal (booleanp (all-disjoint-from-allp xs ys))
+         t)
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm symmetry-of-all-disjoint-from-allp
+  (equal (all-disjoint-from-allp xs ys)
+         (all-disjoint-from-allp ys xs))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm all-disjoint-from-allp-of-list-fix-two
+  (equal (all-disjoint-from-allp xs (list-fix ys))
+         (all-disjoint-from-allp xs ys))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+(defthm all-disjoint-from-allp-of-list-fix-one
+  (equal (all-disjoint-from-allp (list-fix xs) ys)
+         (all-disjoint-from-allp xs ys)))
+
+(defthm all-disjoint-from-allp-of-app-two
+  (equal (all-disjoint-from-allp xs (app ys zs))
+         (and (all-disjoint-from-allp xs ys)
+              (all-disjoint-from-allp xs zs)))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+(defthm all-disjoint-from-allp-of-app-one
+  (equal (all-disjoint-from-allp (app xs ys) zs)
+         (and (all-disjoint-from-allp xs zs)
+              (all-disjoint-from-allp ys zs))))
+
+(defthm all-disjoint-from-allp-of-rev-two
+  (equal (all-disjoint-from-allp xs (rev ys))
+         (all-disjoint-from-allp xs ys))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+(defthm all-disjoint-from-allp-of-rev-one
+  (equal (all-disjoint-from-allp (rev xs) ys)
+         (all-disjoint-from-allp xs ys)))
+
+
+(defthm all-disjoint-from-allp-when-subsetp-of-other-one
+  (implies (subsetp xs ys)
+           (equal (all-disjoint-from-allp xs ys)
+                  (none-consp xs)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm all-disjoint-from-allp-when-subsetp-of-other-two
+  (implies (subsetp xs ys)
+           (equal (all-disjoint-from-allp ys xs)
+                  (none-consp xs))))
+
+(defthm disjoint-from-allp-when-memberp-of-all-disjoint-from-allp-one
+  (implies (and (all-disjoint-from-allp xs ys)
+                (memberp x xs))
+           (equal (disjoint-from-allp x ys)
+                  t))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm disjoint-from-allp-when-memberp-of-all-disjoint-from-allp-two
+  (implies (and (all-disjoint-from-allp xs ys)
+                (memberp y ys))
+           (equal (disjoint-from-allp y xs)
+                  t))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+(defthm disjointp-when-members-of-all-disjoint-from-allp
+  (implies (and (all-disjoint-from-allp xs ys)
+                (memberp x xs)
+                (memberp y ys))
+           (equal (disjointp x y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+
+
+;; If (all-disjoint-from-allp ys zs), then:
+;;
+;;   (subsetp xs ys) -> (all-disjoint-from-allp xs zs) and
+;;                      (all-disjoint-from-allp zs xs)
+;;
+;;   (subsetp xs zs) -> (all-disjoint-from-allp ys xs) and
+;;                      (all-disjoint-from-allp xs ys)
+
+(defthm all-disjoint-from-allp-when-subsetp-of-all-disjoint-one
+  (implies (and (all-disjoint-from-allp ys zs)
+                (subsetp xs ys))
+           (equal (all-disjoint-from-allp xs zs)
+                  t))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm all-disjoint-from-allp-when-subsetp-of-all-disjoint-two
+  (implies (and (all-disjoint-from-allp ys zs)
+                (subsetp xs ys))
+           (equal (all-disjoint-from-allp zs xs)
+                  t)))
+
+(defthm all-disjoint-from-allp-when-subsetp-of-all-disjoint-three
+  (implies (and (all-disjoint-from-allp ys zs)
+                (subsetp xs zs))
+           (equal (all-disjoint-from-allp ys zs)
+                  t))
+  :hints(("Goal" :induct (cdr-induction ys))))
+
+(defthm all-disjoint-from-allp-when-subsetp-of-all-disjoint-four
+  (implies (and (all-disjoint-from-allp ys zs)
+                (subsetp xs zs))
+           (equal (all-disjoint-from-allp zs ys)
+                  t)))
+
+
+
+
+
+
+
+
+;; (mutually-disjointp xs)
+;;
+;; xs is interpreted as a chain.  We return true if every list in xs is
+;; disjoint from every other list in xs.
+
+(defund mutually-disjointp (xs)
+  (declare (xargs :guard t))
+  (if (consp xs)
+      (and (disjoint-from-allp (car xs) (cdr xs))
+           (mutually-disjointp (cdr xs)))
+    t))
+
+(defthm mutually-disjointp-when-not-consp
+  (implies (not (consp xs))
+           (equal (mutually-disjointp xs)
+                  t))
+  :hints(("Goal" :in-theory (enable mutually-disjointp))))
+
+(defthm mutually-disjointp-of-cons
+  (equal (mutually-disjointp (cons x xs))
+         (and (disjoint-from-allp x xs)
+              (mutually-disjointp xs)))
+  :hints(("Goal" :in-theory (enable mutually-disjointp))))
+
+(defthm booleanp-of-mutually-disjointp
+  (equal (booleanp (mutually-disjointp xs))
+         t)
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm mutually-disjointp-of-cdr-when-mutually-disjointp
+  (implies (mutually-disjointp xs)
+           (equal (mutually-disjointp (cdr xs))
+                  t))
+  :hints(("Goal" :cases ((consp xs)))))
+
+(defthm mutually-disjointp-of-list-fix
+  (equal (mutually-disjointp (list-fix x))
+         (mutually-disjointp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm mutually-disjointp-of-app
+  (equal (mutually-disjointp (app x y))
+         (and (mutually-disjointp x)
+              (mutually-disjointp y)
+              (all-disjoint-from-allp x y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm mutually-disjointp-of-rev
+  (equal (mutually-disjointp (rev x))
+         (mutually-disjointp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+;; I thought for some time that I might be able to generalize the below to
+;; arbitrary subsets.  But I now realize that this won't be possible, because a
+;; subset might have repeated members which will not be disjoint from their
+;; copies.
+
+(defthm mutually-disjointp-of-remove-all-when-mutually-disjointp
+  (implies (mutually-disjointp x)
+           (equal (mutually-disjointp (remove-all a x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-when-both-membersp-of-mutually-disjointp
+  (implies (and (mutually-disjointp xs)
+                (memberp a xs)
+                (memberp b xs))
+           (equal (disjointp a b)
+                  (if (equal a b)
+                      (not (consp a))
+                    t)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+
+
+
+
+
+
+
+
+(defund disjoint-from-allp-badguy (x ys)
+  (declare (xargs :guard t))
+  (if (consp ys)
+      (if (disjointp x (car ys))
+          (disjoint-from-allp-badguy x (cdr ys))
+        (car ys))
+    nil))
+
+(encapsulate
+ ()
+ (local (defthm disjoint-from-allp-badguy-when-not-consp
+          (implies (not (consp ys))
+                   (equal (disjoint-from-allp-badguy x ys)
+                          nil))
+          :hints(("Goal" :in-theory (enable disjoint-from-allp-badguy)))))
+
+ (local (defthm disjoint-from-allp-badguy-of-cons
+          (equal (disjoint-from-allp-badguy x (cons y ys))
+                 (if (disjointp x y)
+                     (disjoint-from-allp-badguy x ys)
+                   y))
+          :hints(("Goal" :in-theory (enable disjoint-from-allp-badguy)))))
+
+ (defthmd disjoint-from-allp-badguy-property
+   (implies (not (disjoint-from-allp x ys))
+            (and (memberp (disjoint-from-allp-badguy x ys) ys)
+                 (not (disjointp x (disjoint-from-allp-badguy x ys)))))
+   :hints(("Goal" :induct (cdr-induction ys)))))
+
+(defthm disjoint-from-allp-of-remove-all-when-memberp-of-mutually-disjointp
+  (implies (and (mutually-disjointp xs)
+                (memberp x xs))
+           (equal (disjoint-from-allp x (remove-all x xs))
+                  t))
+  :hints(("Goal"
+          :use ((:instance disjoint-from-allp-badguy-property
+                           (x x)
+                           (ys (remove-all x xs)))))))
+
+(defthm member-of-nonep-of-remove-all-when-mutually-disjointp
+  (implies (and (mutually-disjointp xs)
+                (memberp x xs))
+           (equal (member-of-nonep a (remove-all x xs))
+                  (if (member-of-nonep a xs)
+                      t
+                    (memberp a x))))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+
+(defthm disjoint-from-allp-when-subsetp-of-remove-all-of-mutually-disjointp
+  (implies (and (subsetp xs (remove-all y ys))
+                (mutually-disjointp ys)
+                (memberp y ys))
+           (equal (disjoint-from-allp y xs)
+                  t)))
+
+;; YUCK.  This is so damn horrible.
+
+(defthm disjoint-from-allp-when-subsetp-of-remove-all-of-mutually-disjointp-two
+  (implies (and (mutually-disjointp ys)
+                (memberp y ys)
+                (subsetp xs (remove-all y ys)))
+           (equal (disjoint-from-allp y xs)
+                  t)))
+
+
+
+
+
+(defthm lists-lookup-of-rev-when-mutually-disjointp
+  (implies (mutually-disjointp xs)
+           (equal (lists-lookup a (rev xs))
+                  (lists-lookup a xs)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm lists-lookup-when-memberp-in-lists-lookup-when-mutually-disjointp
+  (implies (and (mutually-disjointp xs)
+                (memberp a (lists-lookup b xs)))
+           (equal (lists-lookup a xs)
+                  (lists-lookup b xs)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm lists-lookup-of-remove-all-from-mutually-disjointp
+  (implies (and (mutually-disjointp xs)
+                (memberp x xs))
+           (equal (lists-lookup a (remove-all x xs))
+                  (if (or (member-of-nonep a xs)
+                          (memberp a x))
+                      nil
+                    (lists-lookup a xs))))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm lists-lookup-when-mutually-disjointp
+  (implies (and (mutually-disjointp xs)
+                (memberp x xs)
+                (memberp a x)
+                (memberp b x))
+           (equal (lists-lookup a xs)
+                  (lists-lookup b xs)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm lists-lookup-of-car-of-lists-lookup
+  (implies (and (mutually-disjointp xs)
+                (not (member-of-nonep a xs)))
+           (equal (lists-lookup (car (lists-lookup a xs)) xs)
+                  (lists-lookup a xs)))
+  :hints(("Goal" :use ((:instance lists-lookup-when-mutually-disjointp
+                                  (x (lists-lookup a xs))
+                                  (b (car (lists-lookup a xs))))))))
+
+(defthm member-of-nonep-when-member-of-lists-lookup
+  (implies (memberp a (lists-lookup b xs))
+           (equal (member-of-nonep a xs)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(defthm member-of-nonep-when-member-of-cdr-of-lists-lookup
+  (implies (memberp a (cdr (lists-lookup b xs)))
+           (equal (member-of-nonep a xs)
+                  nil))
+  :hints(("Goal"
+          :in-theory (disable member-of-nonep-when-member-of-lists-lookup)
+          :use ((:instance member-of-nonep-when-member-of-lists-lookup)))))
+
+(defthm member-of-nonep-of-car-of-lists-lookup
+  (equal (member-of-nonep (car (lists-lookup a xs)) xs)
+         (and (member-of-nonep a xs)
+              (member-of-nonep nil xs)))
+  :hints(("Goal" :induct (cdr-induction xs))))
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthm member-of-lists-lookup-when-members-of-mutually-disjointp
+   (implies (and (mutually-disjointp xs)
+                 (not (member-of-nonep a xs))
+                 (not (member-of-nonep c xs)))
+            (equal (memberp c (lists-lookup a xs))
+                   (equal (lists-lookup a xs)
+                          (lists-lookup c xs))))))
+
+
+
+
+(deflist disjoint-from-nonep (e x)
+  (disjointp e x)
+  :negatedp t
+  :elementp-of-nil t)
+
+(defthm disjoint-from-nonep-when-not-consp-left
+  (implies (not (consp e))
+           (equal (disjoint-from-nonep e x)
+                  (not (consp x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-nonep-of-cons-left
+  (implies (disjoint-from-nonep e x)
+           (equal (disjoint-from-nonep (cons a e) x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-nonep-of-list-fix-left
+  (equal (disjoint-from-nonep (list-fix e) x)
+         (disjoint-from-nonep e x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-nonep-of-app-left-one
+  (implies (disjoint-from-nonep e x)
+           (equal (disjoint-from-nonep (app e a) x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-nonep-of-app-left-two
+  (implies (disjoint-from-nonep e x)
+           (equal (disjoint-from-nonep (app a e) x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjoint-from-nonep-of-rev-left
+  (equal (disjoint-from-nonep (rev e) x)
+         (disjoint-from-nonep e x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/nat-listp.lisp acl2-6.3/books/milawa/ACL2/utilities/nat-listp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/nat-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/nat-listp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,45 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(deflist nat-listp (x)
+  (natp x)
+  :elementp-of-nil nil)
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/ordered-subsetp.lisp acl2-6.3/books/milawa/ACL2/utilities/ordered-subsetp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/ordered-subsetp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/ordered-subsetp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,190 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; We say that x is an ordered subset of y when every member of x is also a
+;; member of y, and the elements occur in the same order in x and y.
+
+(defund ordered-subsetp (x y)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (consp y)
+           (if (equal (car x) (car y))
+               (ordered-subsetp (cdr x) (cdr y))
+             (ordered-subsetp x (cdr y))))
+    t))
+
+(defthm ordered-subsetp-when-not-consp-one
+  (implies (not (consp x))
+           (equal (ordered-subsetp x y)
+                  t))
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(defthm ordered-subsetp-when-not-consp-two
+  (implies (not (consp y))
+           (equal (ordered-subsetp x y)
+                  (not (consp x))))
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(defthm ordered-subsetp-of-cons-and-cons
+  (equal (ordered-subsetp (cons a x) (cons b y))
+         (if (equal a b)
+             (ordered-subsetp x y)
+           (ordered-subsetp (cons a x) y)))
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(defthm booleanp-of-ordered-subsetp
+  (equal (booleanp (ordered-subsetp x y))
+         t)
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(encapsulate
+ ()
+ (local (defun my-induction (x y)
+          (declare (xargs :export nil))
+          (if (and (consp x)
+                   (consp y))
+              (list (my-induction x (cdr y))
+                    (my-induction (cdr x) (cdr y)))
+            nil)))
+
+ (defthm ordered-subsetp-of-cdr-when-ordered-subsetp
+   (implies (ordered-subsetp x y)
+            (equal (ordered-subsetp (cdr x) y)
+                   t))
+   :hints(("Goal" :induct (my-induction x y)))))
+
+(defthm ordered-subsetp-when-ordered-subsetp-of-cons
+  (implies (ordered-subsetp (cons a x) y)
+           (equal (ordered-subsetp x y)
+                  t))
+  :hints(("Goal" :use ((:instance ordered-subsetp-of-cdr-when-ordered-subsetp
+                                  (x (cons a x))
+                                  (y y))))))
+
+(defthm ordered-subsetp-of-cons-when-ordered-subsetp
+  (implies (ordered-subsetp x y)
+           (equal (ordered-subsetp x (cons a y))
+                  t))
+  :hints(("Goal" :expand (ordered-subsetp x (cons a y)))))
+
+(defthm ordered-subsetp-when-ordered-subsetp-of-cdr
+  (implies (ordered-subsetp x (cdr y))
+           (equal (ordered-subsetp x y)
+                  t)))
+
+(defthm ordered-subsetp-is-reflexive
+  (equal (ordered-subsetp x x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(encapsulate
+ ()
+ (local (defun my-induction (x y z)
+          (declare (xargs :measure (+ (rank x) (+ (rank y) (rank z)))
+                          :export nil))
+          (if (and (consp x)
+                   (consp y)
+                   (consp z))
+              (list (my-induction (cdr x) (cdr y) (cdr z))
+                    (my-induction (cdr x) (cdr y) z)
+                    (my-induction x (cdr y) (cdr z))
+                    (my-induction x y (cdr z)))
+            nil)))
+
+ (defthm ordered-subsetp-is-transitive
+   (implies (and (ordered-subsetp x y)
+                 (ordered-subsetp y z))
+            (equal (ordered-subsetp x z)
+                   t))
+   :hints(("Goal" :induct (my-induction x y z)))))
+
+(defthm ordered-subsetp-of-list-fix-one
+  (equal (ordered-subsetp (list-fix x) y)
+         (ordered-subsetp x y))
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(defthm ordered-subsetp-of-list-fix-two
+  (equal (ordered-subsetp x (list-fix y))
+         (ordered-subsetp x y))
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(defthm ordered-subsetp-of-app-when-ordered-subsetp-one
+  (implies (ordered-subsetp x y)
+           (ordered-subsetp x (app y z)))
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(defthm ordered-subsetp-of-app-one
+  (equal (ordered-subsetp x (app x y))
+         t))
+
+(defthm ordered-subsetp-of-app-two
+  (equal (ordered-subsetp x (app y x))
+         t)
+  :hints(("Goal" :induct (cdr-induction y))))
+
+(defthm ordered-subsetp-of-app-when-ordered-subsetp-two
+  (implies (ordered-subsetp x y)
+           (ordered-subsetp x (app z y)))
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(defthm subsetp-when-ordered-subsetp
+  (implies (ordered-subsetp x y)
+           (equal (subsetp x y)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable ordered-subsetp))))
+
+(defthm ordered-subsetp-of-remove-duplicates
+  (equal (ordered-subsetp (remove-duplicates x) x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm ordered-subsetp-of-remove-all
+  (equal (ordered-subsetp (remove-all a x) x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm ordered-subsetp-of-difference
+  (equal (ordered-subsetp (difference x y) x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/primitives.lisp acl2-6.3/books/milawa/ACL2/utilities/primitives.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/primitives.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/primitives.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,1849 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "../acl2-hacks/top")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+
+
+(in-theory (disable ACL2::booleanp
+                    (:type-prescription ACL2::not)
+                    (:type-prescription ACL2::iff)
+                    (:type-prescription ACL2::booleanp)
+                    (:executable-counterpart ACL2::tau-system)
+                    ACL2::iff-implies-equal-not
+                    ACL2::iff-implies-equal-implies-1
+                    ACL2::iff-implies-equal-implies-2
+                    ACL2::booleanp-compound-recognizer))
+
+;; After ACL2 4.3, I started seeing these crop up in rare proofs involving
+;; constants, e.g., if the goal involved a term like (equal '(nil) (foo x))
+;; then somehow ACL2 would start using its own rules about car/cdr/cons.  So,
+;; now I just disable these, too.
+(in-theory (disable acl2::car-cons
+                    acl2::cdr-cons
+                    acl2::cons-equal
+                    acl2::default-car
+                    acl2::default-cdr))
+
+(local (in-theory (enable acl2::car-cons
+                          acl2::cdr-cons
+                          acl2::cons-equal
+                          acl2::default-car
+                          acl2::default-cdr)))
+
+
+;; Base functions.
+;;
+;; We now define our base functions like car, cons, natp, and +.  We also
+;; introduce some non-base functions like natp and <= which can be defined
+;; in terms of the other base functions.
+
+(definlined car (x)
+  (declare (xargs :guard t :export nil))
+  (if (consp x)
+      (COMMON-LISP::car x)
+    nil))
+
+(definlined cdr (x)
+  (declare (xargs :guard t :export nil))
+  (if (consp x)
+      (COMMON-LISP::cdr x)
+    nil))
+
+(defmacro first (x)
+  (list 'car x))
+
+(defmacro second (x)
+  (list 'first (list 'cdr x)))
+
+(defmacro third (x)
+  (list 'second (list 'cdr x)))
+
+(defmacro fourth (x)
+  (list 'third (list 'cdr x)))
+
+(defmacro fifth (x)
+  (list 'fourth (list 'cdr x)))
+
+
+;; Symbolp is a tricky case.  We want to have our ACL2 model match with the
+;; logical story of Milawa, and we can accomplish this using the definition
+;; shown below involving intern-in-package-of-symbol.
+
+(defund symbolp (x)
+  (declare (xargs :guard t :export nil))
+  (and (COMMON-LISP::symbolp x)
+       (equal x (ACL2::intern-in-package-of-symbol (COMMON-LISP::symbol-name x) 'MILAWA::foo))))
+
+;; Unfortunately, intern-in-package-of-symbol is horribly slow.  To see just
+;; how bad it is, we ran the following loops on lhug-3.  Using ACL2::symbolp,
+;; the loop completes in .27 seconds.  But using the logical definition of
+;; MILAWA::symbolp, the loop takes 61.17 seconds.  In other words, the damn
+;; intern-in-package-of-symbol is making Milawa's symbolp run 226 times slower
+;; than slower than the regular symbolp from Lisp.
+;;
+;; (in-package "ACL2")
+;; (defparameter *foo* 'MILAWA::foo)
+;; (time$ (loop for i fixnum from 1 to 100000000 do (ACL2::symbolp *foo*)))
+;; (time$ (loop for i fixnum from 1 to 100000000 do (MILAWA::symbolp *foo*)))
+;;
+;; Is this a problem?  Well, yes and no.  For one, note that in our standalone
+;; proof-checking system (Sources/milawa.lisp), that we can use Lisp's symbolp
+;; directly because of the acceptable object invariant.  Hence, the slowness of
+;; our ACL2 symbolp will cause the performance of our ACL2 model to differ from
+;; that of our Milawa model.
+;;
+;; The real question, then, is how often symbolp is called.  After all, the
+;; loop above was done for 100 million calls of symbolp.  But symbolp isn't
+;; really used in any particularly intense way throughout most of the system,
+;; and so we tolerated this performance until we were far into the
+;; bootstrapping process.
+;;
+;; When we decided we wanted to speed up validity checking for worlds, we found
+;; that symbolp's performance was actually meaningful.  In particular, this is
+;; because the symbol-< function must "symbol-fix" its arguments, so for each
+;; symbol-< comparison we must pay the price of interning twice.  This is quite
+;; bad for the performance of mergesorting, search-tree lookups, and the like.
+;;
+;; Since ACL2 is being used only as a tool to sketch out the soundness proof,
+;; we feel justified in unsoundly increasing the performance of symbolp, via
+;; the following ttag.  Its logical definition is still the same as presented
+;; above, but we could easily exploit this ttag to prove nil via the executable
+;; counterpart of symbolp.
+
+(ACL2::defttag unsound-but-faster-symbolp)
+(ACL2::progn!
+ (ACL2::set-raw-mode t)
+ (ACL2::declaim (ACL2::inline MILAWA::symbolp))
+ (ACL2::defun MILAWA::symbolp (x)
+              (ACL2::symbolp x)))
+
+(definlined symbol-< (x y)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable symbolp)))
+                  :export nil))
+  (let ((x-fix (if (symbolp x) x nil))
+        (y-fix (if (symbolp y) y nil)))
+    (if (COMMON-LISP::string< (COMMON-LISP::symbol-name x-fix)
+                              (COMMON-LISP::symbol-name y-fix))
+        t
+      nil)))
+
+(definlined natp (x)
+  (declare (xargs :guard t :export nil))
+  (and (COMMON-LISP::integerp x)
+       (COMMON-LISP::<= 0 x)))
+
+(definlined nfix (x)
+  (declare (xargs :guard t))
+  (if (natp x)
+      x
+    0))
+
+(definlined < (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (COMMON-LISP::< (nfix a) (nfix b)))
+
+(definline <= (a b)
+  ;; Note: we leave <= enabled
+  (declare (xargs :guard t))
+  (not (< b a)))
+
+(definlined zp (x)
+  (declare (xargs :guard t))
+  (if (natp x)
+      (equal x 0)
+    t))
+
+; Originally I defined + with no bounds checking.  But for Magnus Myreen's
+; verifie Lisp, we wanted to ensure that no sums would overflow 30-bit
+; integers.
+
+(definlined + (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (let ((ret (COMMON-LISP::+ (nfix a) (nfix b))))
+    (if (< ret 1073741824)
+        ret
+      (ACL2::prog2$
+       (ACL2::er ACL2::hard? '+ "Sum exceeds 30 bits.")
+       ret))))
+
+; The only overflows we ran into dealt with the RANK function, which we
+; memoized and used to compute proof sizes.  But all of this is just dealing
+; with proof debugging.  So, we make an unbounded version of RANK that we can
+; use in debugging messages.
+
+(acl2::defun unbounded-rank (x)
+  (declare (xargs :guard t
+                  :measure (acl2::acl2-count x)
+                  :hints(("Goal" :in-theory (enable car cdr)))
+                  :guard-hints(("Goal" :in-theory (enable car cdr)))))
+  (if (consp x)
+      (common-lisp::+ 1
+                      (unbounded-rank (car x))
+                      (unbounded-rank (cdr x)))
+    0))
+
+(definlined - (a b)
+  (declare (xargs :guard t
+                  :guard-hints (("Goal" :in-theory (enable natp nfix)))
+                  :export nil))
+  (nfix (COMMON-LISP::- (nfix a) (nfix b))))
+
+
+
+
+(encapsulate
+ ()
+ (local (defthm natp-same-as-in-acl2
+          ;; Just an observation; we never install this as a rule.
+          (equal (natp x) (ACL2::natp x))
+          :rule-classes nil
+          :hints(("Goal" :in-theory (enable natp)))))
+
+ (local (defthm nfix-same-as-in-acl2
+          ;; Just an observation; we never install this as a rule.
+          (equal (nfix x) (ACL2::nfix x))
+          :rule-classes nil
+          :hints(("Goal" :in-theory (enable natp nfix)))))
+
+ (local (defthm zp-same-as-in-acl2
+          ;; Just an observation; we never install this as a rule.
+          (equal (zp x) (ACL2::zp x))
+          :rule-classes nil
+          :hints(("Goal" :in-theory (enable natp zp))))))
+
+
+
+
+(defund booleanp (x)
+  (declare (xargs :guard t))
+  (if (equal x t)
+      t
+    (equal x nil)))
+
+(defthm equal-of-booleans-rewrite
+  ;; This is an important rule which takes care of a lot of cases which would
+  ;; ordinarily require type reasoning.  The basic idea is that we can replace
+  ;; equalities with iff equivalence as long as the arguments are both boolean.
+  ;;
+  ;; When I was at Rockwell, we had this rule with a backchain limit of zero,
+  ;; which effectively means only type reasoning and forward chaining would be
+  ;; used to determine if x and y are booleans.  For Milawa, I use a limit of
+  ;; one instead of zero.  This is important since I disable all of the type
+  ;; prescription rules and don't use forward chaining rules.  Instead, I tend
+  ;; to prove simple rewrite rules of the form (equal (booleanp (fn x)) t).
+  ;; With no hypotheses, these rules will always succeed as long as they are
+  ;; given a chance to fire, but with a backchain limit of 0 they will not get
+  ;; this chance.  Using a backchain limit of 1 fixes this.
+  (implies (and (booleanp x)
+                (booleanp y))
+           (equal (equal x y)
+                  (iff x y)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable booleanp))))
+
+(defthm booleanp-of-booleanp
+  (equal (booleanp (booleanp x))
+         t)
+  :hints(("Goal" :in-theory (enable booleanp))))
+
+(defthm booleanp-of-equal
+  (equal (booleanp (equal x y))
+         t)
+  :hints(("Goal" :in-theory (enable booleanp))))
+
+(defthm booleanp-of-not
+  (equal (booleanp (not x))
+         t))
+
+(defthm booleanp-of-iff
+  (equal (booleanp (iff x y))
+         t))
+
+(defthm booleanp-of-zp
+  (equal (booleanp (zp x))
+         t)
+  :hints(("Goal" :in-theory (enable zp))))
+
+
+
+;; Cons, Car, and Cdr.
+
+(defthm booleanp-of-consp                                             ;; Axiom
+  (equal (booleanp (consp x))
+         t)
+  :hints(("Goal" :in-theory (enable booleanp))))
+
+(defthm car-when-not-consp                                            ;; Axiom
+  (implies (not (consp x))
+           (equal (car x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable car))))
+
+(defthm cdr-when-not-consp                                            ;; Axiom
+  (implies (not (consp x))
+           (equal (cdr x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable cdr))))
+
+(defthm car-of-cons                                                   ;; Axiom
+  (equal (car (cons x y))
+         x)
+  :hints(("Goal" :in-theory (enable car))))
+
+(defthm cdr-of-cons                                                   ;; Axiom
+  (equal (cdr (cons x y))
+         y)
+  :hints(("Goal" :in-theory (enable cdr))))
+
+(defthm car-cdr-elim                                                  ;; Axiom
+  (implies (consp x)
+           (equal (cons (car x) (cdr x))
+                  x))
+  :rule-classes :elim
+  :hints(("Goal" :in-theory (enable car cdr))))
+
+(defthm cons-of-car-and-cdr
+  (implies (consp x)
+           (equal (cons (car x) (cdr x))
+                  x)))
+
+(defthm equal-of-cons-rewrite
+  ;; The syntaxp hypothesis prevents us from splitting up constants such as
+  ;; ''NIL.  This wasn't really a problem as far as proofs succeeding, but it
+  ;; made the proof output difficult to read.
+  (implies (syntaxp (and (not (ACL2::quotep x))
+                         (or (not (ACL2::quotep a))
+                             (not (ACL2::quotep b)))))
+           (equal (equal x (cons a b))
+                  (and (consp x)
+                       (equal (car x) a)
+                       (equal (cdr x) b)))))
+
+(defthmd equal-of-cons-rewrite-constants
+  ;; Porting to ACL2 6.2, I found that lemma-6-for-ordered-map-submapp-property
+  ;; in mergesort.lisp no longer proved, and was stuck on this goal:
+  ;;
+  ;; (IMPLIES (AND (NOT (CONSP CE))
+  ;;               (EQUAL (CONS NIL CE3) '(NIL))
+  ;;               CE3)
+  ;;          (NOT (SUBMAPP (CONS '(NIL) CE2)
+  ;;                        (CONS CE CE0)))).
+  ;;
+  ;; This should be taken care of by equal-of-cons-rewrite, but somehow it was
+  ;; not, I guess because the unifier wasn't matching the constant against
+  ;; Milawa's cons?  At any rate, add a rule that uses acl2::cons instead, to
+  ;; try to help the unifier pick up constants.
+  (equal (equal x (cons a b))
+         (and (consp x)
+              (equal (car x) a)
+              (equal (cdr x) b))))
+
+
+;; Symbolp and Symbol-<.
+
+(defthm booleanp-of-symbolp                                           ;; Axiom
+  (equal (booleanp (symbolp x))
+         t)
+  :hints(("Goal" :in-theory (enable booleanp symbolp))))
+
+(defthm booleanp-of-symbol-<                                          ;; Axiom
+  (equal (booleanp (symbol-< x y))
+         t)
+  :hints(("Goal" :in-theory (enable symbol-<))))
+
+(defthm irreflexivity-of-symbol-<                                     ;; Axiom
+  (equal (symbol-< x x)
+         nil)
+  :hints(("Goal" :in-theory (enable symbol-<))))
+
+(defthm antisymmetry-of-symbol-<                                      ;; Axiom
+  (implies (symbol-< x y)
+           (equal (symbol-< y x)
+                  nil))
+  :hints(("Goal"
+          :in-theory (e/d (symbol-< symbolp COMMON-LISP::string<)
+                          (ACL2::string<-l
+                           str::coerce-to-list-removal)))))
+
+(defthm transitivity-of-symbol-<                                      ;; Axiom
+  (implies (and (symbol-< x y)
+                (symbol-< y z))
+           (equal (symbol-< x z)
+                  t))
+  :hints(("Goal" :in-theory (e/d (symbol-< symbolp COMMON-LISP::string<)
+                                 (ACL2::string<-l
+                                  str::coerce-to-list-removal)))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (ACL2::stringp x)
+                        (ACL2::stringp y))
+                   (equal (equal (ACL2::coerce x 'list)
+                                 (ACL2::coerce y 'list))
+                          (equal x y)))
+          :hints(("Goal"
+                  :in-theory (disable ACL2::coerce-inverse-2)
+                  :use ((:instance ACL2::coerce-inverse-2 (ACL2::x x))
+                        (:instance ACL2::coerce-inverse-2 (ACL2::x y)))))))
+
+ (local (defthm lemma2
+          (implies (and (ACL2::symbolp x)
+                        (ACL2::symbolp y)
+                        (equal (ACL2::symbol-package-name x)
+                               (ACL2::symbol-package-name y)))
+                   (equal (equal x y)
+                          (equal (ACL2::symbol-name x)
+                                 (ACL2::symbol-name y))))
+          :hints(("Goal" :use ((:instance ACL2::symbol-equality
+                                          (ACL2::s1 x)
+                                          (ACL2::s2 y)))))))
+
+ (defthm trichotomy-of-symbol-<                                       ;; Axiom
+   (implies (and (symbolp x)
+                 (symbolp y)
+                 (not (symbol-< x y)))
+            (equal (symbol-< y x)
+                   (not (equal x y))))
+   :hints(("Goal" :in-theory (e/d (symbol-< symbolp COMMON-LISP::string<)
+                                  (ACL2::string<-l
+                                   ACL2::member-symbol-name))))))
+
+(defthm symbol-<-completion-left                                      ;; Axiom
+  (implies (not (symbolp x))
+           (equal (symbol-< x y)
+                  (symbol-< nil y)))
+  :hints(("Goal" :in-theory (enable symbol-<))))
+
+(defthm symbol-<-completion-right                                     ;; Axiom
+  (implies (not (symbolp y))
+           (equal (symbol-< x y)
+                  (symbol-< x nil)))
+  :hints(("Goal" :in-theory (enable symbol-<))))
+
+
+
+
+;; Reasoning about Types.
+
+(defthm booleanp-of-natp                                              ;; Axiom
+  (equal (booleanp (natp x))
+         t)
+  :hints(("Goal" :in-theory (enable natp))))
+
+(defthm symbolp-when-natp-cheap                                       ;; Axiom
+  (implies (natp x)
+           (equal (symbolp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable natp symbolp))))
+
+(defthm symbolp-when-consp-cheap                                      ;; Axiom
+  (implies (consp x)
+           (equal (symbolp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable symbolp))))
+
+(defthm consp-when-natp-cheap                                         ;; Axiom
+  (implies (natp x)
+           (equal (consp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable natp))))
+
+(defthm booleanp-when-natp-cheap
+  (implies (natp x)
+           (equal (booleanp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable booleanp))))
+
+(defthm booleanp-when-consp-cheap
+  (implies (consp x)
+           (equal (booleanp x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable booleanp))))
+
+(defthm symbolp-when-booleanp-cheap
+  (implies (booleanp x)
+           (equal (symbolp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable booleanp))))
+
+
+
+;; Nfix and Zp.
+
+(defthm natp-of-nfix
+  (equal (natp (nfix a))
+         t)
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm nfix-when-natp-cheap
+  (implies (natp x)
+           (equal (nfix x)
+                  x))
+  :hints(("Goal" :in-theory (enable nfix)))
+  :rule-classes ((:rewrite :backchain-limit-lst 2)))
+
+(defthm nfix-when-not-natp-cheap
+  (implies (not (natp x))
+           (equal (nfix x)
+                  0))
+  :hints(("Goal" :in-theory (enable nfix)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm equal-of-nfix-of-self
+  ;; No symmetric rule because of term order
+  (equal (equal x (nfix x))
+         (natp x)))
+
+(defthm equal-of-zero-and-nfix
+  ;; No symmetric rule because of term order
+  (equal (equal 0 (nfix x))
+         (zp x))
+  :hints(("Goal" :in-theory (enable nfix zp))))
+
+(defthm zp-when-natp-cheap
+  (implies (natp x)
+           (equal (zp x)
+                  (equal x 0)))
+  :hints(("Goal" :in-theory (enable zp)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm zp-when-not-natp-cheap
+  (implies (not (natp x))
+           (equal (zp x)
+                  t))
+  :hints(("Goal" :in-theory (enable zp)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm zp-of-nfix
+  (equal (zp (nfix x))
+         (zp x))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm nfix-of-nfix
+  ;; I once wrote a note to myself to get rid of this rule, since we have
+  ;; nfix-when-natp now.  But in retrospect I don't like that idea.  This rule
+  ;; can still be applied by urewrite, etc.
+  (equal (nfix (nfix a))
+         (nfix a)))
+
+(defthm natp-when-not-zp-cheap
+  (implies (not (zp a))
+           (equal (natp a)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm natp-when-zp-cheap
+  (implies (zp a)
+           (equal (natp a)
+                  (equal a 0)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm nfix-when-zp-cheap
+  (implies (zp a)
+           (equal (nfix a)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm equal-of-nfix-with-positive-constant
+  (implies (and (syntaxp (ACL2::quotep c))
+                (not (zp c)))
+           (equal (equal c (nfix a))
+                  (equal c a))))
+
+
+
+
+;; Addition.
+
+(defthm natp-of-plus                                                  ;; Axiom
+  (equal (natp (+ a b))
+         t)
+  :hints(("Goal" :in-theory (enable + natp nfix))))
+
+(defthm plus-under-iff
+  (iff (+ a b)
+       t)
+  :hints(("Goal" :use ((:instance booleanp-when-natp-cheap (x (+ a b)))))))
+
+(defthm commutativity-of-+                                            ;; Axiom
+  (equal (+ a b)
+         (+ b a))
+  :hints(("Goal" :in-theory (enable +))))
+
+(defthm associativity-of-+                                            ;; Axiom
+  (equal (+ (+ a b) c)
+         (+ a (+ b c)))
+  :hints(("Goal" :in-theory (enable + natp nfix))))
+
+(defthm commutativity-of-+-two
+  (equal (+ a (+ b c))
+         (+ b (+ a c)))
+  :hints(("Goal" :use ((:instance commutativity-of-+ (a a) (b (+ b c)))))))
+
+(defthm gather-constants-from-plus-of-plus
+  (implies (and (syntaxp (ACL2::quotep x))
+                (syntaxp (ACL2::quotep y)))
+           (equal (+ x (+ y z))
+                  (+ (+ x y) z))))
+
+
+
+(encapsulate
+ ()
+ (local (defthmd plus-when-not-natp-left                              ;; Axiom
+          (implies (not (natp a))
+                   (equal (+ a b)
+                          (+ 0 b)))
+          :hints(("Goal" :in-theory (enable + natp nfix)))))
+
+ (local (defthmd plus-of-zero-when-natural                            ;; Axiom
+          (implies (natp a)
+                   (equal (+ a 0)
+                          a))
+          :hints(("Goal" :in-theory (enable + natp nfix)))))
+
+ (defthmd plus-completion-left
+   (implies (not (natp a))
+            (equal (+ a b)
+                   (nfix b)))
+   :hints(("Goal"
+           :use ((:instance plus-when-not-natp-left)
+                 (:instance plus-of-zero-when-natural (a b))
+                 (:instance plus-when-not-natp-left (a b) (b 0))))))
+
+ (defthmd plus-completion-right
+   (implies (not (natp b))
+            (equal (+ a b)
+                   (nfix a)))
+   :rule-classes ((:rewrite :backchain-limit-lst 1))
+   :hints(("Goal" :use ((:instance plus-completion-left (a b) (b a))))))
+
+ (defthm plus-of-zero-right
+   (equal (+ a 0)
+          (nfix a))
+   :hints(("Goal"
+           :in-theory (enable plus-completion-right)
+           :use ((:instance plus-of-zero-when-natural)))))
+
+ (defthm plus-of-zero-left
+   (equal (+ 0 a)
+          (nfix a))
+   :hints(("Goal" :use ((:instance commutativity-of-+ (a 0) (b a))))))
+
+ (defthm plus-when-zp-left-cheap
+   (implies (zp a)
+            (equal (+ a b)
+                   (nfix b)))
+   :hints(("Goal" :use ((:instance plus-completion-left))))
+   :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+ (defthm plus-when-zp-right-cheap
+   (implies (zp b)
+            (equal (+ a b)
+                   (nfix a)))
+   :hints(("Goal" :use ((:instance plus-completion-right))))
+   :rule-classes ((:rewrite :backchain-limit-lst 1))))
+
+(defthm plus-of-nfix-left
+  (equal (+ (nfix a) b)
+         (+ a b))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm plus-of-nfix-right
+  (equal (+ a (nfix b))
+         (+ a b))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+
+
+
+;; Less-Than Relation.
+
+(local (defthm booleanp-of-acl2-<
+         (equal (booleanp (ACL2::< x y))
+                t)
+         :hints(("Goal" :in-theory (enable booleanp)))))
+
+(defthm booleanp-of-<                                                 ;; Axiom
+  (equal (booleanp (< x y))
+         t)
+  :hints(("Goal" :in-theory (enable <))))
+
+(defthm irreflexivity-of-<                                            ;; Axiom
+  (equal (< a a)
+         nil)
+  :hints(("Goal" :in-theory (enable <))))
+
+(defthm less-of-zero-right                                            ;; Axiom
+  (equal (< a 0)
+         nil)
+  :hints(("Goal" :in-theory (enable < natp nfix))))
+
+(encapsulate
+ ()
+ (defthmd less-completion-right                                         ;; Axiom
+   (implies (not (natp b))
+            (equal (< a b)
+                   nil))
+   :rule-classes ((:rewrite :backchain-limit-lst 1))
+   :hints(("Goal" :in-theory (enable natp < nfix))))
+
+ (defthm less-when-zp-right-cheap
+   (implies (zp b)
+            (equal (< a b)
+                   nil))
+   :hints(("Goal" :use ((:instance less-completion-right))))
+   :rule-classes ((:rewrite :backchain-limit-lst 1))))
+
+
+(encapsulate
+ ()
+ (local (defthm less-of-zero-left-when-natp                           ;; Axiom
+          (implies (natp a)
+                   (equal (< 0 a)
+                          (not (equal a 0))))
+          :hints(("Goal" :in-theory (enable natp < nfix)))))
+
+ (defthm less-of-zero-left
+   (equal (< 0 a)
+          (not (zp a)))))
+
+
+(encapsulate
+ ()
+ (defthmd less-completion-left                                        ;; Axiom
+   (implies (not (natp a))
+            (equal (< a b)
+                   (< 0 b)))
+   :rule-classes ((:rewrite :backchain-limit-lst 1))
+   :hints(("Goal" :in-theory (enable <))))
+
+ (defthm less-when-zp-left-cheap
+   (implies (zp a)
+            (equal (< a b)
+                   (not (zp b))))
+   :hints(("Goal" :use ((:instance less-completion-left))))))
+
+(defthm less-of-nfix-left
+  (equal (< (nfix a) b)
+         (< a b))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm less-of-nfix-right
+  (equal (< a (nfix b))
+         (< a b))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm transitivity-of-<                                             ;; Axiom
+  (implies (and (< a b)
+                (< b c))
+           (equal (< a c)
+                  t))
+  :hints(("Goal" :in-theory (enable <))))
+
+(defthm antisymmetry-of-<
+  (implies (< a b)
+           (equal (< b a)
+                  nil))
+  :hints(("Goal" :use ((:instance transitivity-of-< (a a) (b b) (c a)))))
+  :rule-classes ((:rewrite :backchain-limit-lst 3)))
+
+(encapsulate
+ ()
+ (local (defthm trichotomy-of-<-when-natp                             ;; Axiom
+          (implies (and (natp a)
+                        (natp b)
+                        (not (< a b))
+                        (not (equal a b)))
+                   (equal (< b a)
+                          t))
+          :hints(("Goal" :in-theory (enable < natp nfix)))))
+
+  (defthm trichotomy-of-<
+    ;; The order of these hyps reduces backchaining
+    (implies (and (not (equal (nfix a) (nfix b)))
+                  (not (< a b)))
+             (equal (< b a)
+                    t))
+    :hints(("Goal" :in-theory (enable nfix)))))
+
+(defthm one-plus-trick                                                ;; Axiom
+  (implies (< a b)
+           (equal (< b (+ 1 a))
+                  nil))
+  :hints(("Goal" :in-theory (enable < + natp nfix))))
+
+(encapsulate
+ ()
+ (defthm natural-less-than-one-is-zero                                ;; Axiom
+   (implies (and (natp a)
+                 (< a 1))
+            (equal a 0))
+   :rule-classes nil
+   :hints(("Goal" :in-theory (enable < + natp nfix))))
+
+ (defthm less-of-one-right
+   (equal (< a 1)
+          (zp a))
+   :hints(("Goal" :use ((:instance natural-less-than-one-is-zero))))))
+
+(defthm less-of-one-left
+  (equal (< 1 a)
+         (and (not (zp a))
+              (not (equal a 1))))
+  :hints(("Goal" :in-theory (enable zp))))
+
+(defthm transitivity-of-<-two
+  (implies (and (< a b)
+                (not (< c b)))
+           (equal (< a c)
+                  t))
+  :hints(("Goal"
+          :in-theory (e/d (nfix)
+                          (trichotomy-of-<))
+          :use ((:instance trichotomy-of-< (a b) (b c))))))
+
+(defthm transitivity-of-<-three
+  (implies (and (not (< b a))
+                (< b c))
+           (equal (< a c)
+                  t)))
+
+(defthm transitivity-of-<-four
+  (implies (and (not (< b a))
+                (not (< c b)))
+           (equal (< c a)
+                  nil)))
+
+
+
+;; Less-Than and Addition.
+
+(defthm |(< (+ a b) (+ a c))|                                         ;; Axiom
+  (equal (< (+ a b) (+ a c))
+         (< b c))
+  :hints(("Goal" :in-theory (enable < + natp nfix))))
+
+(defthm |(< a (+ a b))|
+  (equal (< a (+ a b))
+         (< 0 b))
+  :hints(("Goal" :use ((:instance |(< (+ a b) (+ a c))| (b 0) (c b))))))
+
+(defthm |(< a (+ b a))|
+  (equal (< a (+ b a))
+         (< 0 b)))
+
+(defthm |(< (+ a b) a)|
+  (equal (< (+ a b) a)
+         nil)
+  :hints(("Goal" :use ((:instance |(< (+ a b) (+ a c))| (c 0))))))
+
+(defthm |(< (+ b a) a)|
+  (equal (< (+ b a) a)
+         nil))
+
+(defthm |(< a (+ b c a))|
+  (equal (< a (+ b (+ c a)))
+         (< 0 (+ b c))))
+
+(defthm |(< a (+ b a c))|
+  (equal (< a (+ b (+ a c)))
+         (< 0 (+ b c))))
+
+(defthm |(< a (+ b c d a))|
+  (equal (< a (+ b (+ c (+ d a))))
+         (< 0 (+ b (+ c d)))))
+
+(defthm |(< a (+ b c a d))|
+  (equal (< a (+ b (+ c (+ a d))))
+         (< 0 (+ b (+ c d)))))
+
+(defthm |(< a (+ b c d e a))|
+  (equal (< a (+ b (+ c (+ d (+ e a)))))
+         (< 0 (+ b (+ c (+ d e))))))
+
+(defthm |(< a (+ b c d a e))|
+  (equal (< a (+ b (+ c (+ d (+ a e)))))
+         (< 0 (+ b (+ c (+ d e))))))
+
+(defthm |(< a (+ b c d e f a))|
+  (equal (< a (+ b (+ c (+ d (+ e (+ f a))))))
+         (< 0 (+ b (+ c (+ d (+ e f)))))))
+
+(defthm |(< a (+ b c d e a f))|
+  (equal (< a (+ b (+ c (+ d (+ e (+ a f))))))
+         (< 0 (+ b (+ c (+ d (+ e f)))))))
+
+(defthm |(< (+ a b) (+ c a))|
+  (equal (< (+ a b) (+ c a))
+         (< b c)))
+
+(defthm |(< (+ b a) (+ c a))|
+  (equal (< (+ b a) (+ c a))
+         (< b c)))
+
+(defthm |(< (+ b a) (+ a c))|
+  (equal (< (+ b a) (+ a c))
+         (< b c)))
+
+(defthm |(< (+ a b) (+ c a d))|
+  (equal (< (+ a b) (+ c (+ a d)))
+         (< b (+ c d))))
+
+(defthm |(< (+ b a c) (+ d a))|
+  (equal (< (+ b (+ a c)) (+ d a))
+         (< (+ b c) d)))
+
+(defthm |a <= b, c != 0 --> a < b+c|
+  (implies (and (not (< b a))
+                (not (zp c)))
+           (equal (< a (+ b c))
+                  t))
+  :hints(("Goal" :in-theory (enable zp))))
+
+(defthm |a <= b, c != 0 --> a < c+b|
+  (implies (and (not (< b a))
+                (not (zp c)))
+           (equal (< a (+ c b))
+                  t)))
+
+(defthm |a <= b, c != 0 --> a < c+b+d|
+  (implies (and (not (< b a))
+                (not (zp c)))
+           (equal (< a (+ c (+ b d)))
+                  t)))
+
+(defthm |a <= b, c != 0 --> a < c+d+b|
+  (implies (and (not (< b a))
+                (not (zp c)))
+           (equal (< a (+ c (+ d b)))
+                  t)))
+
+(defthm |c < a, d <= b --> c+d < a+b|
+  (implies (and (< c a)
+                (not (< b d)))
+           (equal (< (+ c d) (+ a b))
+                  t))
+  :hints(("Goal" :use ((:instance transitivity-of-<-three
+                                  (a (+ c d))
+                                  (b (+ c b))
+                                  (c (+ a b)))))))
+
+(defthm |c < a, d <= b --> c+d < b+a|
+  (implies (and (< c a)
+                (not (< b d)))
+           (equal (< (+ c d) (+ b a))
+                  t)))
+
+(defthm |c <= a, d < b --> c+d < a+b|
+  (implies (and (not (< a c))
+                (< d b))
+           (equal (< (+ c d) (+ a b))
+                  t))
+  :hints(("Goal" :use ((:instance |c < a, d <= b --> c+d < a+b|
+                                  (c d) (a b) (d c) (b a))))))
+
+(defthm |c <= a, d < b --> c+d < b+a|
+  (implies (and (not (< a c))
+                (< d b))
+           (equal (< (+ c d) (+ b a))
+                  t)))
+
+(defthm |c <= a, d <= b --> c+d <= a+b|
+  (implies (and (not (< a c))
+                (not (< b d)))
+           (equal (< (+ a b) (+ c d))
+                  nil))
+  :hints(("Goal" :use ((:instance transitivity-of-<-four
+                                  (a (+ c d))
+                                  (b (+ c b))
+                                  (c (+ a b)))))))
+
+(defthm |c <= a, d <= b --> c+d <= b+a|
+  (implies (and (not (< a c))
+                (not (< b d)))
+           (equal (< (+ b a) (+ c d))
+                  nil)))
+
+
+
+
+;; Equalities with Sums.
+
+(defthm |(= a (+ a b))|
+  (equal (equal a (+ a b))
+         (and (natp a)
+              (zp b)))
+  :hints(("Goal"
+          :in-theory (disable |(< a (+ a b))|)
+          :use ((:instance |(< a (+ a b))|)))))
+
+(defthm |(= a (+ b a))|
+  (equal (equal a (+ b a))
+         (and (natp a)
+              (zp b))))
+
+(encapsulate
+ ()
+ (defthm |lemma for (= (+ a b) (+ a c))|
+   (implies (and (natp b)
+                 (natp c)
+                 (equal (+ a b) (+ a c)))
+            (equal b c))
+   :rule-classes nil
+   :hints(("Goal"
+           :in-theory (disable |(< (+ a b) (+ a c))|)
+           :use ((:instance |(< (+ a b) (+ a c))| (a a) (b b) (c c))
+                 (:instance |(< (+ a b) (+ a c))| (a a) (b c) (c b))))))
+
+ (defthm |(= (+ a b) (+ a c))|
+   (equal (equal (+ a b) (+ a c))
+          (equal (nfix b) (nfix c)))
+   :hints(("Goal"
+           :in-theory (enable nfix)
+           :use ((:instance |lemma for (= (+ a b) (+ a c))|
+                            (a a)
+                            (b (nfix b))
+                            (c (nfix c))))))))
+
+(defthm |(= (+ a b) (+ c a))|
+  (equal (equal (+ a b) (+ c a))
+         (equal (nfix b) (nfix c))))
+
+(defthm |(= (+ b a) (+ c a))|
+  (equal (equal (+ b a) (+ c a))
+         (equal (nfix b) (nfix c))))
+
+(defthm |(= (+ b a) (+ a c))|
+  (equal (equal (+ b a) (+ a c))
+         (equal (nfix b) (nfix c))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          ;; Milawa can prove it without this lemma
+          (implies (and (not (zp a))
+                        (not (zp b)))
+                   (equal (equal 0 (+ a b))
+                          nil))
+          :hints (("Goal"
+                   :in-theory (disable |(< (+ a b) (+ a c))|
+                                       |(< (+ b a) (+ c a))|
+                                       |(< a (+ a b))|)
+                   :use ((:instance |(< (+ a b) (+ a c))| (a b) (b 0) (c a)))))))
+
+ (defthm |(= 0 (+ a b))|
+   (equal (equal 0 (+ a b))
+          (and (zp a)
+               (zp b)))
+   :hints(("Goal" :use ((:instance lemma))))))
+
+(encapsulate
+ ()
+ (defthmd |lemma for (= (+ a x b) (+ c x d))|
+   ;; hackery with names to make it commute them nicely
+   (equal (equal (+ e (+ b c))
+                 (+ d (+ b f)))
+          (equal (+ e c)
+                 (+ d f))))
+
+ (defthm |(= (+ a x b) (+ c x d))|
+   (equal (equal (+ a (+ x b))
+                 (+ c (+ x d)))
+          (equal (+ a b)
+                 (+ c d)))
+   :hints(("Goal" :in-theory (enable |lemma for (= (+ a x b) (+ c x d))|)))))
+
+
+
+;; Squeeze laws.
+
+(defthm squeeze-law-one
+  (implies (not (< b a))
+           (equal (< (+ 1 a) b)
+                  (and (not (equal (nfix a) (nfix b)))
+                       (not (equal (+ 1 a) (nfix b))))))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm squeeze-law-two
+  (implies (not (< b a))
+           (equal (< b (+ 1 a))
+                  (equal (nfix b) (nfix a))))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+(defthm squeeze-law-three
+  (implies (< a b)
+           (equal (< (+ 1 a) b)
+                  (not (equal (nfix b) (+ 1 a)))))
+  :hints(("Goal" :in-theory (enable nfix))))
+
+
+
+;; Subtraction.
+
+(defthm natp-of-minus                                                 ;; Axiom
+  (equal (natp (- a b))
+         t)
+  :hints(("Goal" :in-theory (enable -))))
+
+(defthm minus-under-iff
+  (iff (- a b)
+       t)
+  :hints(("Goal" :use ((:instance booleanp-when-natp-cheap
+                                  (x (- a b)))))))
+
+(defthm minus-when-not-less                                           ;; Axiom
+  (implies (not (< b a))
+           (equal (- a b)
+                  0))
+  :hints(("Goal" :in-theory (enable - < natp nfix zp))))
+
+(defthm minus-of-self
+  (equal (- a a)
+         0))
+
+(defthm minus-of-zero-left
+  (equal (- 0 a)
+         0))
+
+(defthm minus-cancels-summand-right                                   ;; Axiom
+  (equal (- (+ a b) b)
+         (nfix a))
+  :hints(("Goal" :in-theory (enable - + < natp nfix))))
+
+(defthm minus-of-zero-right
+  (equal (- a 0)
+         (nfix a))
+  :hints(("Goal"
+          :in-theory (e/d (nfix) (minus-cancels-summand-right))
+          :use ((:instance minus-cancels-summand-right (a a) (b 0))))))
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthm minus-cancels-summand-left
+   (equal (- (+ a b) a)
+          (nfix b))
+   :hints(("Goal"
+           :in-theory (disable commutativity-of-+
+                               |(= (+ b a) (+ a c))|
+                               |(= (+ a b) (+ c a))|)
+           :use ((:instance commutativity-of-+))))))
+
+
+
+(encapsulate
+ ()
+ (local (defthm less-of-minus-less                                    ;; Axiom
+          (implies (< b a)
+                   (equal (< (- a b) c)
+                          (< a (+ b c))))
+          :hints(("Goal" :in-theory (enable < + - natp nfix)))))
+
+ (defthm |(< (- a b) c)|
+   (equal (< (- a b) c)
+          (if (< a b)
+              (< 0 c)
+            (< a (+ b c))))
+   :hints(("Goal" :cases ((< b a))))))
+
+(defthm |(< a (- b c))|                                               ;; Axiom
+  (equal (< a (- b c))
+         (< (+ a c) b))
+  :hints(("Goal" :in-theory (enable < + - natp nfix))))
+
+
+
+(encapsulate
+ ()
+ (local (defthm plus-of-minus-right                                   ;; Axiom
+          (implies (< c b)
+                   (equal (+ a (- b c))
+                          (- (+ a b) c)))
+          :hints(("Goal" :in-theory (enable + - < natp nfix)))))
+
+ (defthm |(+ a (- b c))|
+   (equal (+ a (- b c))
+          (if (< c b)
+              (- (+ a b) c)
+            (nfix a)))))
+
+(defthm |(+ (- a b) c)|
+  (equal (+ (- a b) c)
+         (if (< b a)
+             (- (+ a c) b)
+           (nfix c))))
+
+
+
+(encapsulate
+ ()
+ (local (defthm minus-of-minus-right                                  ;; Axiom
+          (implies (< c b)
+                   (equal (- a (- b c))
+                          (- (+ a c) b)))
+          :hints(("Goal" :in-theory (enable + - < natp nfix)))))
+
+ (defthm |(- a (- b c))|
+   (equal (- a (- b c))
+          (if (< c b)
+              (- (+ a c) b)
+            (nfix a)))))
+
+(defthm |(- (- a b) c)|                                               ;; Axiom
+  (equal (- (- a b) c)
+         (- a (+ b c)))
+  :hints(("Goal" :in-theory (enable + - < natp nfix zp))))
+
+
+
+(encapsulate
+ ()
+ (local (defthm equal-of-minus-property                               ;; Axiom
+          (implies (< b a)
+                   (equal (equal (- a b) c)
+                          (equal a (+ b c))))
+          :hints(("Goal" :in-theory (enable + < - natp nfix)))))
+
+ (defthm |(= (- a b) c)|
+   (equal (equal (- a b) c)
+          (if (< b a)
+              (equal a (+ b c))
+            (equal c 0)))))
+
+(defthm |(= c (- a b))|
+  (equal (equal c (- a b))
+         (if (< b a)
+             (equal a (+ b c))
+           (equal c 0))))
+
+
+
+(defthm |(- (+ a b) (+ a c))|
+  (equal (- (+ a b) (+ a c))
+         (- b c)))
+
+(defthm |(- (+ a b) (+ c a))|
+  (equal (- (+ a b) (+ c a))
+         (- b c)))
+
+(defthm |(- (+ b a) (+ c a))|
+  (equal (- (+ b a) (+ c a))
+         (- b c)))
+
+(defthm |(- (+ b a) (+ a c))|
+  (equal (- (+ b a) (+ a c))
+         (- b c)))
+
+(defthm |(- (+ a b) (+ c d a))|
+  (equal (- (+ a b) (+ c (+ d a)))
+         (- b (+ c d))))
+
+(defthm |a < b --> a <= b-1|
+  (implies (< a b)
+           (equal (< (- b 1) a)
+                  nil)))
+
+
+(defthm minus-when-zp-left-cheap
+  (implies (zp a)
+           (equal (- a b)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm minus-when-zp-right-cheap
+  (implies (zp b)
+           (equal (- a b)
+                  (nfix a)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm minus-of-nfix-left
+  (equal (- (nfix a) b)
+         (- a b)))
+
+(defthm minus-of-nfix-right
+  (equal (- a (nfix b))
+         (- a b)))
+
+
+
+
+
+
+
+
+;; Constant Gathering.  We break our normal forms when we can put two constants
+;; next to one another, since they can then be evaluated away to make progress.
+
+(defthm gather-constants-from-less-of-plus
+  (implies (and (syntaxp (ACL2::quotep const))
+                (syntaxp (ACL2::quotep const2)))
+           (equal (< (+ const x) const2)
+                  (and (< const const2)
+                       (< x (- const2 const))))))
+
+(defthm gather-constants-from-less-of-plus-two
+  (implies (and (syntaxp (ACL2::quotep const))
+                (syntaxp (ACL2::quotep const2)))
+           (equal (< const (+ const2 x))
+                  (or (< const const2)
+                      (< (- const const2) x)))))
+
+(defthm gather-constants-from-less-of-plus-and-plus
+  (implies (and (syntaxp (ACL2::quotep a))
+                (syntaxp (ACL2::quotep b)))
+           (equal (< (+ a x) (+ b y))
+                  (if (< a b)
+                      (< x (+ (- b a) y))
+                    (< (+ (- a b) x) y)))))
+
+(encapsulate
+ ()
+ (defthm lemma-for-gather-constants-from-equal-of-plus-and-plus
+   (implies (< c1 c2)
+            (equal (equal (+ c1 x) (+ c2 y))
+                   (equal (nfix x) (+ (- c2 c1) y))))
+   :rule-classes nil)
+
+ (defthm lemma2-for-gather-constants-from-equal-of-plus-and-plus
+   (implies (and (not (< c1 c2)))
+            (equal (equal (+ c1 x) (+ c2 y))
+                   (equal (+ (- c1 c2) x) (nfix y))))
+   :rule-classes nil
+   :hints(("Goal"
+           :in-theory (e/d (nfix) (trichotomy-of-<))
+           :use ((:instance trichotomy-of-< (a c1) (b c2))))))
+
+ (defthm gather-constants-from-equal-of-plus-and-plus
+   (implies (and (syntaxp (ACL2::quotep c1))
+                 (syntaxp (ACL2::quotep c2)))
+            (equal (equal (+ c1 x) (+ c2 y))
+                   (if (< c1 c2)
+                       (equal (nfix x) (+ (- c2 c1) y))
+                     (equal (+ (- c1 c2) x) (nfix y)))))
+   :hints(("Goal" :use ((:instance lemma-for-gather-constants-from-equal-of-plus-and-plus)
+                        (:instance lemma2-for-gather-constants-from-equal-of-plus-and-plus))))))
+
+(defthm gather-constants-from-equal-of-plus
+  (implies (and (syntaxp (ACL2::quotep const))
+                (syntaxp (ACL2::quotep const2)))
+           (equal (equal (+ const x) const2)
+                  (and (not (< const2 const))
+                       (natp const2)
+                       (equal (nfix x)
+                              (- const2 const))))))
+
+(defthm gather-constants-from-minus-of-plus
+  (implies (and (syntaxp (ACL2::quotep const))
+                (syntaxp (ACL2::quotep const2)))
+           (equal (- (+ const x) const2)
+                  (if (< const2 const)
+                      (+ (- const const2) x)
+                    (- x (- const2 const))))))
+
+(defthm gather-constants-from-minus-of-plus-two
+  (implies (and (syntaxp (ACL2::quotep const))
+                (syntaxp (ACL2::quotep const2)))
+           (equal (- const (+ const2 x))
+                  (if (< const2 const)
+                      (- (- const const2) x)
+                    0))))
+
+(defthm gather-constants-from-minus-of-plus-and-plus
+  (implies (and (syntaxp (ACL2::quotep const))
+                (syntaxp (ACL2::quotep const2)))
+           (equal (- (+ const a) (+ const2 b))
+                  (if (< const const2)
+                      (- a (+ (- const2 const) b))
+                    (- (+ (- const const2) a) b)))))
+
+
+
+
+
+(defthm not-equal-when-less
+  (implies (< x y)
+           (equal (equal x y)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm not-equal-when-less-two
+  (implies (< y x)
+           (equal (equal x y)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+
+
+(defthm |a <= d, b+c <= e --> b+a+c <= d+e|
+  (implies (and (not (< d a))
+                (not (< e (+ b c))))
+           (equal (< (+ d e) (+ b (+ a c)))
+                  nil)))
+
+(defthm |(< (+ a b) (+ c b d))|
+  (equal (< (+ a b) (+ c (+ b d)))
+         (< a (+ c d))))
+
+(defthm |(< (+ a b c)) (+ d c))|
+  (equal (< (+ a (+ b c)) (+ d c))
+         (< (+ a b) d))
+  :hints(("Goal"
+          :in-theory (disable |(< (+ b a c) (+ d a))|)
+          :use ((:instance |(< (+ b a c) (+ d a))|
+                           (a c) (b a) (c b) (d d))))))
+
+(defthm |a <= b, b <= c --> a < 1+c|
+  (implies (and (not (< b a))
+                (not (< c b)))
+           (equal (< a (+ 1 c))
+                  t)))
+
+(defthm |b <= c, a <= b --> a < 1+c|
+  (implies (and (not (< c b))
+                (not (< b a)))
+           (equal (< a (+ 1 c))
+                  t)))
+
+
+
+(definline max (a b)                        ;; note: we leave max enabled
+  (declare (xargs :guard t))
+  (if (< a b)
+      (nfix b)
+    (nfix a)))
+
+(defthm natp-of-max
+  (equal (natp (max a b))
+         t)
+  :hints(("Goal" :in-theory (enable max))))
+
+(defthm equal-of-max-and-zero
+  (equal (equal (max a b) 0)
+         (and (zp a)
+              (zp b)))
+  :hints(("Goal" :in-theory (enable max))))
+
+(defthm max-of-zero-left
+  (equal (max 0 a)
+         (nfix a)))
+
+(defthm max-of-zero-right
+  (equal (max a 0)
+         (nfix a)))
+
+
+
+(definline min (a b)                        ;; note: we leave min enabled
+  (declare (xargs :guard t))
+  (if (< a b)
+      (nfix a)
+    (nfix b)))
+
+(defthm natp-of-min
+  (equal (natp (min a b))
+         t)
+  :hints(("Goal" :in-theory (enable min))))
+
+(defthm equal-of-min-and-zero
+  (equal (equal (min a b) 0)
+         (or (zp a)
+             (zp b)))
+  :hints(("Goal" :in-theory (enable min))))
+
+(defthm min-of-zero-left
+  (equal (min 0 a)
+         0))
+
+(defthm min-of-zero-right
+  (equal (min a 0)
+         0))
+
+
+(definline max3 (a b c)                     ;; note: we leave max3 enabled
+  (declare (xargs :guard t))
+  (max a (max b c)))
+
+
+
+
+
+
+
+
+;; We now introduce ordinals and our rank function.
+
+(defund ord< (x y)
+  (declare (xargs :guard t))
+  (cond ((not (consp x))
+         (if (consp y)
+             t
+           (< x y)))
+        ((not (consp y))
+         nil)
+        ((not (equal (car (car x))
+                     (car (car y))))
+         (ord< (car (car x))
+               (car (car y))))
+        ((not (equal (cdr (car x))
+                     (cdr (car y))))
+         (< (cdr (car x))
+            (cdr (car y))))
+        (t
+          (ord< (cdr x) (cdr y)))))
+
+(defthm booleanp-of-ord<
+  (equal (booleanp (ord< x y))
+         t)
+  :hints(("Goal" :in-theory (enable ord<))))
+
+(defthm ord<-when-naturals
+  (implies (and (natp x)
+                (natp y))
+           (equal (ord< x y)
+                  (< x y)))
+  :hints(("Goal" :in-theory (enable ord<))))
+
+
+
+(defund ordp (x)
+  (declare (xargs :guard t))
+  (if (not (consp x))
+      (natp x)
+    (and (consp (car x))
+         (ordp (car (car x)))
+         (not (equal (car (car x)) 0))
+         (< 0 (cdr (car x)))
+         (ordp (cdr x))
+         (if (consp (cdr x))
+             (ord< (car (car (cdr x)))
+                   (car (car x)))
+          t))))
+
+(defthm booleanp-of-ordp
+  (equal (booleanp (ordp x))
+         t)
+  :hints(("Goal" :in-theory (enable ordp))))
+
+
+(defthm ordp-when-natp
+  (implies (natp x)
+           (equal (ordp x)
+                  t))
+  :hints(("Goal" :in-theory (enable ordp))))
+
+
+
+
+(defund rank (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (+ 1
+         (+ (rank (car x))
+            (rank (cdr x))))
+    0))
+
+(defthm natp-of-rank
+  (equal (natp (rank x))
+         t)
+  :hints(("Goal" :in-theory (enable rank))))
+
+(defthm rank-when-not-consp
+  (implies (not (consp x))
+           (equal (rank x)
+                  0))
+  :hints(("Goal" :in-theory (enable rank))))
+
+(defthm rank-of-cons
+  (equal (rank (cons x y))
+         (+ 1
+            (+ (rank x)
+               (rank y))))
+  :hints(("Goal" :in-theory (enable rank))))
+
+(defthm |(< 0 (rank x))|
+  (equal (< 0 (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable rank))))
+
+(defthm ordp-of-rank
+  (equal (ordp (rank x))
+         t)
+  :hints(("Goal" :in-theory (enable ordp))))
+
+(defthm rank-of-car
+  (equal (< (rank (car x)) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable rank))))
+
+(defthm rank-of-car-weak
+  (equal (< (rank x) (rank (car x)))
+         nil)
+  :hints(("Goal" :in-theory (enable rank))))
+
+(defthm rank-of-cdr
+  (equal (< (rank (cdr x)) (rank x))
+         (consp x))
+  :hints(("Goal" :in-theory (enable rank))))
+
+(defthm rank-of-cdr-weak
+  (equal (< (rank x) (rank (cdr x)))
+         nil)
+  :hints(("Goal" :in-theory (enable rank))))
+
+(defthm rank-of-second
+  (equal (< (rank (second x)) (rank x))
+         (consp x))
+  :hints(("Goal"
+          :in-theory (disable transitivity-of-<-four)
+          :use ((:instance transitivity-of-<-three
+                           (a (rank (car (cdr x))))
+                           (b (rank (cdr x)))
+                           (c (rank x)))))))
+
+(defthm rank-of-second-weak
+  (equal (< (rank x) (rank (second x)))
+         nil)
+  :hints(("Goal"
+          :use ((:instance transitivity-of-<-four
+                           (a (rank (second x)))
+                           (b (rank (cdr x)))
+                           (c (rank x)))))))
+
+(defthm rank-of-third
+  (equal (< (rank (third x)) (rank x))
+         (consp x))
+  :hints(("Goal"
+          :in-theory (disable transitivity-of-<-four)
+          :use ((:instance transitivity-of-<-three
+                           (a (rank (third x)))
+                           (b (rank (cdr x)))
+                           (c (rank x)))))))
+
+(defthm rank-of-third-weak
+  (equal (< (rank x) (rank (third x)))
+         nil)
+  :hints(("Goal"
+          :use ((:instance transitivity-of-<-four
+                           (a (rank (third x)))
+                           (b (rank (cdr x)))
+                           (c (rank x)))))))
+
+(defthm rank-of-fourth
+  (equal (< (rank (fourth x)) (rank x))
+         (consp x))
+  :hints(("Goal"
+          :in-theory (disable transitivity-of-<-two)
+          :use ((:instance transitivity-of-<-two
+                           (a (rank (fourth x)))
+                           (b (rank (cdr x)))
+                           (c (rank x)))))))
+
+(defthm rank-of-fourth-weak
+  (equal (< (rank x) (rank (fourth x)))
+         nil)
+  :hints(("Goal"
+          :use ((:instance transitivity-of-<-four
+                           (a (rank (fourth x)))
+                           (b (rank (cdr x)))
+                           (c (rank x)))))))
+
+
+
+
+(encapsulate
+ ()
+ ;; We now instruct ACL2 to use our ord< function as its well founded relation.
+
+ (local (in-theory (enable car cdr)))
+
+ (local (defthm lemma
+          (implies (and (ordp x)
+                        (ordp y))
+                   (equal (ord< x y)
+                          (acl2::o< x y)))
+          :hints(("Goal" :in-theory (enable ordp ord< < natp nfix zp)))))
+
+ (local (defthm lemma2
+          (equal (ordp x)
+                 (ACL2::o-p x))
+          :hints(("Goal" :in-theory (enable ordp ord< < natp nfix zp)))))
+
+ (defthm ord<-is-well-founded
+   (and (implies (ordp x)
+                 (ACL2::o-p (ACL2::identity x)))
+        (implies (and (ordp x)
+                      (ordp y)
+                      (ord< x y))
+                 (ACL2::o< (ACL2::identity x)
+                           (ACL2::identity y))))
+   :rule-classes :well-founded-relation))
+
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+
+
+(defund two-nats-measure (a b)
+  ;; We create the ordinal w*(1+a) + b.  When ord< is applied to such ordinals,
+  ;; the lexiographic ordering of <a, b> is induced.  So, the two-nats-measure
+  ;; function can be used to admit new functions whose termination relies on
+  ;; two natural-valued expressions together.
+  (declare (xargs :guard t))
+  (cons (cons 1 (+ 1 (nfix a)))
+        (nfix b)))
+
+(defthm ordp-of-two-nats-measure
+  (equal (ordp (two-nats-measure a b))
+         t)
+  :hints(("Goal" :in-theory (enable two-nats-measure ordp))))
+
+(defthm ord<-of-two-nats-measure
+  (equal (ord< (two-nats-measure a1 b1)
+               (two-nats-measure a2 b2))
+         (or (< a1 a2)
+             (and (equal (nfix a1) (nfix a2))
+                  (< b1 b2))))
+  :hints(("Goal" :in-theory (enable two-nats-measure ord<))))
+
+
+
+
+(defund three-nats-measure (a b c)
+  ;; We create the ordinal w^2(1+a) + w*(1+b) + c.  When ord< is applied to
+  ;; such ordinals, the lexiographic ordering of <a, b, c> is induced.
+  (declare (xargs :guard t))
+  (cons (cons 2 (+ 1 (nfix a)))
+        (cons (cons 1 (+ 1 (nfix b)))
+              (nfix c))))
+
+(defthm ordp-of-three-nats-measure
+  (equal (ordp (three-nats-measure a b c))
+         t)
+  :hints(("Goal" :in-theory (enable three-nats-measure ordp))))
+
+(defthm ord<-of-three-nats-measure
+  (equal (ord< (three-nats-measure a1 b1 c1)
+               (three-nats-measure a2 b2 c2))
+         (or (< a1 a2)
+             (and (equal (nfix a1) (nfix a2))
+                  (or (< b1 b2)
+                      (and (equal (nfix b1) (nfix b2))
+                           (< c1 c2))))))
+  :hints(("Goal" :in-theory (enable three-nats-measure ord<))))
+
+
+
+
+
+;; We provide several commonly useful induction scheme.
+
+(defun cdr-induction (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cdr-induction (cdr x))
+    nil))
+
+(defun cdr-cdr-induction (a b)
+  (declare (xargs :guard t))
+  (if (and (consp a)
+           (consp b))
+      (cdr-cdr-induction (cdr a) (cdr b))
+    nil))
+
+(defun cdr-cdr-cdr-induction (x y z)
+  (declare (xargs :guard t))
+  (if (and (consp x)
+           (consp y)
+           (consp z))
+      (cdr-cdr-cdr-induction (cdr x) (cdr y) (cdr z))
+    nil))
+
+(defun four-cdrs-induction (a b c d)
+  (declare (xargs :guard t))
+  (if (and (consp a)
+           (consp b)
+           (consp c)
+           (consp d))
+      (four-cdrs-induction (cdr a) (cdr b) (cdr c) (cdr d))
+    nil))
+
+(defun dec-induction (a)
+  (declare (xargs :guard t :measure (nfix a)))
+  (if (zp a)
+      nil
+    (dec-induction (- a 1))))
+
+(defun dec-dec-induction (a b)
+  (declare (xargs :guard t :measure (nfix a)))
+  (if (or (zp a)
+          (zp b))
+      nil
+    (dec-dec-induction (- a 1) (- b 1))))
+
+(defun sub-induction (a b)
+  (declare (xargs :guard t :measure (nfix a)))
+  (cond ((zp b) nil)
+        ((< a b) nil)
+        (t (sub-induction (- a b) b))))
+
+(defun car-cdr-induction (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (list (car-cdr-induction (car x))
+            (car-cdr-induction (cdr x)))
+    t))
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/remove-all-from-ranges.lisp acl2-6.3/books/milawa/ACL2/utilities/remove-all-from-ranges.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/remove-all-from-ranges.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/remove-all-from-ranges.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,103 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "tuple-listp")
+(include-book "list-list-fix")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund remove-all-from-ranges (a x)
+  (declare (xargs :guard (mapp x)))
+  (if (consp x)
+      (cons (cons (car (car x))
+                  (remove-all a (cdr (car x))))
+            (remove-all-from-ranges a (cdr x)))
+    nil))
+
+(defthm remove-all-from-ranges-when-not-consp
+  (implies (not (consp x))
+           (equal (remove-all-from-ranges a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable remove-all-from-ranges))))
+
+(defthm remove-all-from-ranges-of-cons
+  (equal (remove-all-from-ranges a (cons b x))
+         (cons (cons (car b) (remove-all a (cdr b)))
+               (remove-all-from-ranges a x)))
+  :hints(("Goal" :in-theory (enable remove-all-from-ranges))))
+
+(defthm true-listp-of-remove-all-from-ranges
+  (equal (true-listp (remove-all-from-ranges a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-list-listp-of-remove-all-from-ranges
+  (equal (true-list-listp (remove-all-from-ranges a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm mapp-of-remove-all-from-ranges
+  (equal (mapp (remove-all-from-ranges a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-all-from-ranges-of-list-fix
+  (equal (remove-all-from-ranges a (list-fix x))
+         (remove-all-from-ranges a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-all-from-ranges-of-list-list-fix
+  (equal (remove-all-from-ranges a (list-list-fix x))
+         (remove-all-from-ranges a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-all-from-ranges-of-app
+  (equal (remove-all-from-ranges a (app x y))
+         (app (remove-all-from-ranges a x)
+              (remove-all-from-ranges a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-all-from-ranges-of-rev
+  (equal (remove-all-from-ranges a (rev x))
+         (rev (remove-all-from-ranges a x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-remove-all-from-ranges
+  (equal (len (remove-all-from-ranges a x))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/remove-duplicates-list.lisp acl2-6.3/books/milawa/ACL2/utilities/remove-duplicates-list.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/remove-duplicates-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/remove-duplicates-list.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,54 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "cons-listp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defprojection :list (remove-duplicates-list x)
+               :element (remove-duplicates x)
+               :nil-preservingp t)
+
+(defthm consp-of-remove-duplicates
+  (equal (consp (remove-duplicates x))
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cons-listp-of-remove-duplicates-list
+  (equal (cons-listp (remove-duplicates-list x))
+         (cons-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/simple-flatten.lisp acl2-6.3/books/milawa/ACL2/utilities/simple-flatten.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/simple-flatten.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/simple-flatten.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,173 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "list-list-fix")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund slow-simple-flatten (x)
+  ;; Computes (simple-flatten x) very inefficiently.  There's no reason to ever
+  ;; use this function.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (app (car x)
+           (slow-simple-flatten (cdr x)))
+    nil))
+
+(defthm slow-simple-flatten-when-not-consp
+  (implies (not (consp x))
+           (equal (slow-simple-flatten x)
+                  nil))
+  :hints(("Goal" :in-theory (enable slow-simple-flatten))))
+
+(defthm slow-simple-flatten-of-cons
+  (equal (slow-simple-flatten (cons a x))
+         (app a (slow-simple-flatten x)))
+  :hints(("Goal" :in-theory (enable slow-simple-flatten))))
+
+(defund fast-simple-flatten$ (x acc)
+  ;; Computes (revappend (simple-flatten x) acc).  This is cheaper than calling
+  ;; simple-flatten, saveing you one "fast-rev" call and the associated
+  ;; consing.
+  (declare (xargs :guard (true-listp acc)))
+  (if (consp x)
+      (fast-simple-flatten$ (cdr x)
+                            (revappend (car x) acc))
+    acc))
+
+
+(defund simple-flatten (x)
+  ;; Does one level of list flattening.  This won't flatten a whole tree, it'll
+  ;; just condense a two-level "list of lists" into a regular, one-level list.
+  ;; It takes two linear passes of consing.
+  (declare (xargs :guard t))
+  (fast-rev (fast-simple-flatten$ x nil)))
+
+(defthmd lemma-for-definition-of-simple-flatten
+  (implies (true-listp acc)
+           (equal (fast-simple-flatten$ x acc)
+                  (app (rev (slow-simple-flatten x)) acc)))
+  :hints(("Goal" :in-theory (enable fast-simple-flatten$))))
+
+(defthmd definition-of-simple-flatten
+  (equal (simple-flatten x)
+         (if (consp x)
+             (app (car x)
+                  (simple-flatten (cdr x)))
+           nil))
+  :rule-classes :definition
+  :hints(("Goal" :in-theory (enable simple-flatten
+                                    lemma-for-definition-of-simple-flatten))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition simple-flatten))))
+
+(defthm simple-flatten-when-not-consp
+  (implies (not (consp x))
+           (equal (simple-flatten x)
+                  nil))
+  :hints(("Goal" :in-theory (enable definition-of-simple-flatten))))
+
+(defthm simple-flatten-of-cons
+  (equal (simple-flatten (cons a x))
+         (app a (simple-flatten x)))
+  :hints(("Goal" :in-theory (enable definition-of-simple-flatten))))
+
+(defthm true-listp-of-simple-flatten
+  (equal (true-listp (simple-flatten x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm simple-flatten-of-list-fix
+  (equal (simple-flatten (list-fix x))
+         (simple-flatten x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm simple-flatten-of-app
+  (equal (simple-flatten (app x y))
+         (app (simple-flatten x) (simple-flatten y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm simple-flatten-of-list-list-fix
+  (equal (simple-flatten (list-list-fix x))
+         (simple-flatten x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defthm forcing-fast-simple-flatten$-removal
+  (implies (force (true-listp acc))
+           (equal (fast-simple-flatten$ x acc)
+                  (app (rev (simple-flatten x)) acc)))
+  :hints(("Goal" :in-theory (enable fast-simple-flatten$))))
+
+(ACL2::theory-invariant (not (ACL2::active-runep '(:definition fast-simple-flatten$))))
+
+
+
+
+(defun fast-simple-flatten-of-domain$ (x acc)
+  ;; Calculates (revappend (simple-flatten (domain x)) acc) in a single,
+  ;; tail-recursive linear pass.
+  (declare (xargs :guard (and (mapp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (fast-simple-flatten-of-domain$ (cdr x)
+                                      (revappend (car (car x)) acc))
+    acc))
+
+(defthm fast-simple-flatten-of-domain$-removal
+  (implies (force (true-listp acc))
+           (equal (fast-simple-flatten-of-domain$ x acc)
+                  (app (rev (simple-flatten (domain x))) acc))))
+
+
+
+(defun fast-simple-flatten-of-range$ (x acc)
+  ;; Calculates (revappend (simple-flatten (range x)) acc) in a single,
+  ;; tail-recursive linear pass.
+  (declare (xargs :guard (and (mapp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (fast-simple-flatten-of-range$ (cdr x)
+                                     (revappend (cdr (car x)) acc))
+    acc))
+
+(defthm fast-simple-flatten-of-range$-removal
+  (implies (force (true-listp acc))
+           (equal (fast-simple-flatten-of-range$ x acc)
+                  (app (rev (simple-flatten (range x))) acc))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/sort-symbols.lisp acl2-6.3/books/milawa/ACL2/utilities/sort-symbols.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/sort-symbols.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/sort-symbols.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,175 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "utilities")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund sort-symbols-insert (a x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (symbol-< a (car x))
+          (cons a x)
+        (cons (car x)
+              (sort-symbols-insert a (cdr x))))
+    (list a)))
+
+(defthm sort-symbols-insert-when-not-consp
+  (implies (not (consp x))
+           (equal (sort-symbols-insert a x)
+                  (list a)))
+  :hints(("Goal" :in-theory (enable sort-symbols-insert))))
+
+(defthm sort-symbols-insert-of-cons
+  (equal (sort-symbols-insert a (cons b x))
+         (if (symbol-< a b)
+             (cons a (cons b x))
+           (cons b (sort-symbols-insert a x))))
+  :hints(("Goal" :in-theory (enable sort-symbols-insert))))
+
+(defthm memberp-of-sort-symbols-insert
+  (equal (memberp a (sort-symbols-insert b x))
+         (or (equal a b)
+             (memberp a x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-sort-symbols-insert
+  (equal (len (sort-symbols-insert a x))
+         (+ 1 (len x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-of-sort-symbols-insert
+  (equal (consp (sort-symbols-insert a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm car-of-sort-symbols-insert
+  (equal (car (sort-symbols-insert a x))
+         (if (consp x)
+             (if (symbol-< a (car x))
+                 a
+               (car x))
+           a)))
+
+(defthm uniquep-of-sort-symbols-insert
+  (equal (uniquep (sort-symbols-insert a x))
+         (and (uniquep x)
+              (not (memberp a x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defund sort-symbols (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (sort-symbols-insert (car x)
+                           (sort-symbols (cdr x)))
+    nil))
+
+(defthm sort-symbols-when-not-consp
+  (implies (not (consp x))
+           (equal (sort-symbols x)
+                  nil))
+  :hints(("Goal" :in-theory (enable sort-symbols))))
+
+(defthm sort-symbols-of-cons
+  (equal (sort-symbols (cons a x))
+         (sort-symbols-insert a (sort-symbols x)))
+  :hints(("Goal" :in-theory (enable sort-symbols))))
+
+(defthm memberp-of-sort-symbols
+  (equal (memberp a (sort-symbols x))
+         (memberp a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-sort-symbols
+  (equal (len (sort-symbols x))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-of-sort-symbols
+  (equal (disjointp x (sort-symbols y))
+         (disjointp x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm uniquep-of-sort-symbols
+  (equal (uniquep (sort-symbols x))
+         (uniquep x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+(defund symbol-list-orderedp (x)
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (consp (cdr x))
+          (and (not (symbol-< (second x) (first x)))
+               (symbol-list-orderedp (cdr x)))
+        t)
+    t))
+
+(defthm symbol-list-orderedp-when-not-consp
+  (implies (not (consp x))
+           (equal (symbol-list-orderedp x)
+                  t))
+  :hints(("Goal" :in-theory (enable symbol-list-orderedp))))
+
+(defthm symbol-list-orderedp-when-not-consp-of-cdr
+  (implies (not (consp (cdr x)))
+           (equal (symbol-list-orderedp x)
+                  t))
+  :hints(("Goal" :in-theory (enable symbol-list-orderedp))))
+
+(defthm symbol-list-orderedp-of-cons
+  (equal (symbol-list-orderedp (cons a x))
+         (if (consp x)
+             (and (not (symbol-< (car x) a))
+                  (symbol-list-orderedp x))
+           t))
+  :hints(("Goal" :in-theory (enable symbol-list-orderedp))))
+
+(defthm symbol-list-orderedp-of-sort-symbols-insert
+  (implies (symbol-list-orderedp x)
+           (symbol-list-orderedp (sort-symbols-insert a x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/strip-firsts.lisp acl2-6.3/books/milawa/ACL2/utilities/strip-firsts.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/strip-firsts.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/strip-firsts.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,52 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "strip-lens")
+(include-book "all-at-leastp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defprojection :list (strip-firsts x)
+               :element (first x)
+               :guard (all-at-leastp 1 (strip-lens x))
+               :nil-preservingp t)
+
+(defthm rank-of-strip-firsts-weak
+  (equal (< (rank x) (rank (strip-firsts x)))
+         nil)
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/strip-lens.lisp acl2-6.3/books/milawa/ACL2/utilities/strip-lens.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/strip-lens.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/strip-lens.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,50 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "nat-listp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defprojection :list (strip-lens x)
+               :element (len x))
+
+(defthm nat-listp-of-strip-lens
+  (equal (nat-listp (strip-lens x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/strip-seconds.lisp acl2-6.3/books/milawa/ACL2/utilities/strip-seconds.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/strip-seconds.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/strip-seconds.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,52 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "strip-lens")
+(include-book "all-at-leastp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defprojection :list (strip-seconds x)
+               :element (second x)
+               :guard (all-at-leastp 2 (strip-lens x))
+               :nil-preservingp t)
+
+(defthm rank-of-strip-seconds-weak
+  (equal (< (rank x) (rank (strip-seconds x)))
+         nil)
+  :hints(("Goal" :induct (cdr-induction x))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/strip-thirds.lisp acl2-6.3/books/milawa/ACL2/utilities/strip-thirds.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/strip-thirds.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/strip-thirds.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,53 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "strip-lens")
+(include-book "all-at-leastp")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defprojection :list (strip-thirds x)
+               :element (third x)
+               :guard (all-at-leastp 3 (strip-lens x))
+               :nil-preservingp t)
+
+(defthm rank-of-strip-thirds-weak
+  (equal (< (rank x) (rank (strip-thirds x)))
+         nil)
+  :hints(("Goal" :induct (cdr-induction x))))
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/symbol-listp.lisp acl2-6.3/books/milawa/ACL2/utilities/symbol-listp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/symbol-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/symbol-listp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,44 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(deflist symbol-listp (x)
+  (symbolp x)
+  :elementp-of-nil t)
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/test-utilities.lsp acl2-6.3/books/milawa/ACL2/utilities/test-utilities.lsp
--- acl2-6.2/books/milawa/ACL2/utilities/test-utilities.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/test-utilities.lsp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,261 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; Performance Testing for our Utilities.
+;;
+;; The results mentioned in this file were obtained on a 2.8 GHz Pentium D
+;; (dual core) running Linux.  This is not a certifiable book, nor can you
+;; expect to just run acl2 < test-utilities.lisp because some of the tests
+;; segfault and such.
+;;
+;; All of these tests have been run inside of ACL2.  Actual results in raw
+;; lisps might be different.  Particularly, CMUCL results might improve a lot
+;; with inlining.
+
+(include-book "utilities")
+
+(in-package "MILAWA")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+(defund integers (n acc)
+  (declare (xargs :guard (natp n) :measure (nfix n)))
+  (if (zp n)
+      acc
+    (integers (- n 1)
+              (cons n acc))))
+
+(defun fast-firstn$ (n x acc)
+  (declare (xargs :guard (natp n) :measure (nfix n)))
+  (if (zp n)
+      acc
+    (fast-firstn$ (- n 1) (cdr x) (cons (car x) acc))))
+
+
+(ACL2::comp t)
+
+:q
+
+
+
+
+;; Performance of LEN, FAST-LEN, and SAME-LEN for comparing equal-length lists.
+
+(compile
+ (defun test-len (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i fixnum from 1 to times do
+            (equal (MILAWA::len test)
+                   (MILAWA::len test)))))))
+
+(compile
+ (defun test-fast-len (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i fixnum from 1 to times do
+            (equal (MILAWA::fast-len test 0)
+                   (MILAWA::fast-len test 0)))))))
+
+(compile
+ (defun test-same-len (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i fixnum from 1 to times do
+            (MILAWA::same-len test test))))))
+
+
+
+;; Performance Tests (on Ivan)    ACL2-CMUCL   ACL2-GCL
+
+(test-len      5 20000000)  ; ==> 15.20        33.30
+(test-fast-len 5 20000000)  ; ==> 11.93 (22%)  32.05 (4%)
+(test-same-len 5 20000000)  ; ==>  0.57 (96%)  0.35  (99%)
+
+(test-len      10 10000000) ; ==> 15.82        34.06
+(test-fast-len 10 10000000) ; ==> 11.43 (27%)  31.86 (7%)
+(test-same-len 10 10000000) ; ==>  0.59 (96%)  0.29  (99%)
+
+(test-len      100 1000000) ; ==> 14.67        35.99
+(test-fast-len 100 1000000) ; ==> 10.76 (27%)  30.45 (15%)
+(test-same-len 100 1000000) ; ==>  0.29 (98%)  0.26  (99%)
+
+(test-len      1000 100000) ; ==> 15.22        36.81
+(test-fast-len 1000 100000) ; ==> 10.63 (30%)  30.42 (17%)
+(test-same-len 1000 100000) ; ==>  0.24 (98%)   0.23 (99%)
+
+;; [[ note: gcl starts gc'ing fixnums here for some reason ]]
+
+(test-len      10000 10000) ; ==> 14.97        44.79
+(test-fast-len 10000 10000) ; ==> 10.89 (27%)  38.54 (14%)
+(test-same-len 10000 10000) ; ==>  0.46 (97%)   0.50 (99%)
+
+(test-len      100000 1000) ; ==> 15.62        47.08
+(test-fast-len 100000 1000) ; ==> 10.75 (31%)  38.52 (18%)
+(test-same-len 100000 1000) ; ==>  0.48 (97%)   0.59 (99%)
+
+(test-len      1000000 100) ; ==> 15.02        segfault
+(test-fast-len 1000000 100) ; ==> 10.29 (31%)  42.87
+(test-same-len 1000000 100) ; ==>  0.46 (97%)   0.54
+
+(test-len      10000000 10) ; ==> overflow     segfault
+(test-fast-len 10000000 10) ; ==> 10.34        45.19
+(test-same-len 10000000 10) ; ==>  0.48         0.52
+
+
+
+
+;; Performance of APP, FAST-APP, and REVAPPEND for joining a list to itself.
+
+(compile
+ (defun test-app (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i fixnum from 1 to times do
+            (MILAWA::app test test))))))
+
+(compile
+ (defun test-fast-app (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i fixnum from 1 to times do
+            (MILAWA::fast-app test test))))))
+
+(compile
+ (defun test-revappend (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i fixnum from 1 to times do
+            (MILAWA::revappend test test))))))
+
+
+
+
+;; Performance Tests (on Ivan)     ACL2-CMUCL   ACL2-GCL
+
+(test-app       10 10000000) ; ==> 20.88        8.47
+(test-fast-app  10 10000000) ; ==> 19.87 (5%)   7.68 (9%)
+(test-revappend 10 10000000) ; ==>   9.6 (54%)  3.58 (58%)
+
+(test-app       100 1000000) ; ==> 21.74        10.57
+(test-fast-app  100 1000000) ; ==> 19.14 (11%)  6.89 (35%)
+(test-revappend 100 1000000) ; ==>  9.47 (56%)  3.33 (68%)
+
+(test-app       1000 100000) ; ==> 20.87        10.59
+(test-fast-app  1000 100000) ; ==> 18.79 (10%)  6.41 (39%)
+(test-revappend 1000 100000) ; ==>  9.45 (55%)  3.08 (71%)
+
+(test-app       10000 10000) ; ==> 21.72        11.02
+(test-fast-app  10000 10000) ; ==> 19.45 (10%)  6.46 (41%)
+(test-revappend 10000 10000) ; ==>  9.61 (55%)  3.08 (72%)
+
+(test-app       100000 1000) ; ==> 30.34        11.87
+(test-fast-app  100000 1000) ; ==> 23.07 (24%)  6.77 (43%)
+(test-revappend 100000 1000) ; ==> 10.77 (65%)  3.26 (73%)
+
+(test-app       1000000 100) ; ==> 80.53        segfault
+(test-fast-app  1000000 100) ; ==> 42.18 (48%)  12.71
+(test-revappend 1000000 100) ; ==> 14.26 (82%)  5.75
+
+
+
+
+
+(compile
+ (defun test-rev (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i fixnum from 1 to times do
+            (MILAWA::rev test))))))
+
+
+;; We'll use the same data from revappend above, since it doesn't really matter
+;; what we revappend onto.  Rrev is so slow we can't do the same number of
+;; iterations.  We take this into account and multiply the times below by the
+;; factors on the right.  The data is:
+;;   [raw time for rev]s (revappend is faster by this %)
+
+
+;;                           ACL2-CMUCL       ACL2-GCL
+(test-rev 10 10000000) ; ==> 69.83 (86%)      27.3  (86%)       ; [1x]
+(test-rev 100  100000) ; ==> 52.55 (98%)      20.17 (98%)       ; [10x]
+(test-rev 1000   1000) ; ==> 59.88 (99.8%)    20.05 (99.8%)     ; [100x]
+(test-rev 10000    10) ; ==> 92.88 (99.99%)   19.98 (99.98%)    ; [1000x]
+
+
+
+
+(compile
+ (defun test-remove-all (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i from 1 to times do
+            (MILAWA::remove-all 1 test))))))
+
+(compile
+ (defun test-fast-remove-all$ (n times)
+   (let ((test (MILAWA::integers n nil)))
+     (time
+      (loop for i from 1 to times do
+            (MILAWA::fast-remove-all$ 1 test nil))))))
+
+
+;;                                        ACL2-CMUCL     ACL2-GCL
+(test-remove-all       10 10000000) ; ==> 12.45          5.28
+(test-fast-remove-all$ 10 10000000) ; ==> 10.42 (16%)    5.30 (.3% worse)
+
+(test-remove-all       100 1000000) ; ==> 12.52          5.75
+(test-fast-remove-all$ 100 1000000) ; ==> 10.89 (13%)    4.55 (20%)
+
+(test-remove-all       1000 100000) ; ==> 12.93          5.54
+(test-fast-remove-all$ 1000 100000) ; ==> 11.04 (15%)    4.77 (14%)
+
+(test-remove-all       10000 10000) ; ==> 12.86          5.10
+(test-fast-remove-all$ 10000 10000) ; ==> 10.88 (15%)    4.70 (8%)
+
+(test-remove-all       100000 1000) ; ==> 14.42          7.18
+(test-fast-remove-all$ 100000 1000) ; ==> 12.16 (16%)    5.04 (30%)
+
+(test-remove-all       1000000 100) ; ==> 25.51          segfault
+(test-fast-remove-all$ 1000000 100) ; ==> 16.04 (37%)    7.47
+
+(test-remove-all       10000000 10) ; ==> overflow       segfault
+(test-fast-remove-all$ 10000000 10) ; ==> 30.6           inf. loop (gcl bug?)
+
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/top.lisp acl2-6.3/books/milawa/ACL2/utilities/top.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/top.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,68 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+
+(include-book "all-at-leastp")
+(include-book "all-equalp")
+(include-book "clean-update")
+(include-book "cons-listp")
+(include-book "cons-onto-ranges")
+(include-book "defaggregate")
+(include-book "deflist")
+(include-book "extended-subsets")
+(include-book "fast-remove-supersets")
+(include-book "intersect")
+(include-book "list-list-fix")
+(include-book "listify-each")
+(include-book "map-listp")
+(include-book "mergesort")
+(include-book "multicons")
+(include-book "mutually-disjoint")
+(include-book "nat-listp")
+(include-book "ordered-subsetp")
+(include-book "primitives")
+(include-book "remove-duplicates-list")
+(include-book "remove-all-from-ranges")
+(include-book "simple-flatten")
+(include-book "sort-symbols")
+(include-book "strip-firsts")
+(include-book "strip-lens")
+(include-book "strip-seconds")
+(include-book "strip-thirds")
+(include-book "symbol-listp")
+(include-book "total-order")
+(include-book "tuple-listp")
+(include-book "utilities")
+
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/total-order.lisp acl2-6.3/books/milawa/ACL2/utilities/total-order.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/total-order.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/total-order.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,128 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+(defund << (x y)
+  ;; This is a total order over Milawa objects.
+  ;;
+  ;; We say naturals are smaller than symbols, which are smaller than conses,
+  ;; which are recursively ordered lexiographically.  We include a special hack
+  ;; for ACL2 compatibility to make this a total order on ACL2 objects as well.
+  (declare (xargs :guard t
+                  :export
+                  ;; We export a Milawa definition that doesn't include the
+                  ;; special case for ACL2 compatibility.
+                  (cond ((natp x)
+                         (if (natp y)
+                             (< x y)
+                           t))
+                        ((natp y)
+                         nil)
+                        ((symbolp x)
+                         (if (symbolp y)
+                             (symbol-< x y)
+                           t))
+                        ((symbolp y)
+                         nil)
+                        (t
+                         (if (equal (car x) (car y))
+                             (<< (cdr x) (cdr y))
+                           (<< (car x) (car y)))))))
+  (cond ((natp x)
+         (if (natp y)
+             (< x y)
+           t))
+        ((natp y)
+         nil)
+        ((symbolp x)
+         (if (symbolp y)
+             (symbol-< x y)
+           t))
+        ((symbolp y)
+         nil)
+        ((or (not (consp x))
+             (not (consp y)))
+         ;; HACK: Special case for ACL2 compatibility.  We should not need
+         ;; this case in Milawa.
+         (if (consp x)
+             nil
+           (if (consp y)
+               t
+             (and (ACL2::lexorder x y)   ;; ACL2's usual total order
+                  (not (equal x y))))))
+        (t
+         (if (equal (car x) (car y))
+             (<< (cdr x) (cdr y))
+           (<< (car x) (car y))))))
+
+(local (defthm booleanp-of-acl2-lexorder
+         (equal (booleanp (ACL2::lexorder x y))
+                t)
+         :hints(("Goal" :in-theory (enable booleanp)))))
+
+(defthm booleanp-of-<<
+  (equal (booleanp (<< x y))
+         t)
+  :hints(("Goal" :in-theory (enable <<))))
+
+(defthm irreflexivity-of-<<
+  (equal (<< x x)
+         nil)
+  :hints(("Goal" :in-theory (enable <<))))
+
+(defthm asymmetry-of-<<
+  (implies (<< x y)
+           (equal (<< y x)
+                  nil))
+  :hints(("Goal" :in-theory (enable <<))))
+
+(defthm transitivity-of-<<
+  (implies (and (<< x y)
+                (<< y z))
+           (equal (<< x z)
+                  t))
+  :hints(("Goal" :in-theory (enable <<))))
+
+(defthm forcing-trichotomy-of-<<
+  (implies (and (not (<< x y))
+                (not (equal x y)))
+           (equal (<< y x)
+                  t))
+  :hints(("Goal" :in-theory (enable <<))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/tuple-listp.lisp acl2-6.3/books/milawa/ACL2/utilities/tuple-listp.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/tuple-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/tuple-listp.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,154 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "deflist")
+(include-book "strip-firsts")
+(include-book "strip-seconds")
+(include-book "strip-lens")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+;; BOZO this doesn't really belong here
+(deflist true-list-listp (x)
+  (true-listp x)
+  :elementp-of-nil t)
+
+
+
+(deflist tuple-listp (n x)
+  (tuplep n x)
+  :guard (natp n))
+
+(defthm rank-of-strip-firsts-when-tuple-listp-2
+  (implies (and (tuple-listp 2 x)
+                (consp x))
+           (equal (< (rank (strip-firsts x)) (rank x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rank-of-strip-seconds-when-tuple-listp-2
+  (implies (and (tuple-listp 2 x)
+                (consp x))
+           (equal (< (rank (strip-seconds x)) (rank x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm strip-lens-when-tuple-listp
+  (implies (tuple-listp n x)
+           (equal (strip-lens x)
+                  (repeat (nfix n) (len x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+
+(defund list2-list (x y)
+  (declare (xargs :guard t))
+  (if (and (consp x)
+           (consp y))
+      (cons (list (car x) (car y))
+            (list2-list (cdr x) (cdr y)))
+    nil))
+
+(defthm list2-list-when-not-consp-one
+  (implies (not (consp x))
+           (equal (list2-list x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable list2-list))))
+
+(defthm list2-list-when-not-consp-two
+  (implies (not (consp y))
+           (equal (list2-list x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable list2-list))))
+
+(defthm list2-list-of-cons-and-cons
+  (equal (list2-list (cons a x) (cons b y))
+         (cons (list a b)
+               (list2-list x y)))
+  :hints(("Goal" :in-theory (enable list2-list))))
+
+(defthm true-listp-of-list2-list
+  (equal (true-listp (list2-list x y))
+         t)
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm true-listp-list-of-list2-list
+  (equal (true-list-listp (list2-list x y))
+         t)
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm list2-list-of-list-fix-one
+  (equal (list2-list (list-fix x) y)
+         (list2-list x y))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm list2-list-of-list-fix-two
+  (equal (list2-list x (list-fix y))
+         (list2-list x y))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm len-of-list2-list
+  (equal (len (list2-list x y))
+         (min (len x) (len y)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm strip-lens-of-list2-list
+  (equal (strip-lens (list2-list x y))
+         (repeat 2 (min (len x) (len y))))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+
+(defthm tuple-listp-of-list2-list
+  (equal (tuple-listp n (list2-list x y))
+         (or (not (consp x))
+             (not (consp y))
+             (equal n 2)))
+  :hints(("Goal" :in-theory (enable list2-list)))) ;; yuck
+
+(defthm forcing-strip-firsts-of-list2-list
+  (implies (force (equal (len x) (len y)))
+           (equal (strip-firsts (list2-list x y))
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm forcing-strip-seconds-of-list2-list
+  (implies (force (equal (len x) (len y)))
+           (equal (strip-seconds (list2-list x y))
+                  (list-fix y)))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
diff -Nru acl2-6.2/books/milawa/ACL2/utilities/utilities.lisp acl2-6.3/books/milawa/ACL2/utilities/utilities.lisp
--- acl2-6.2/books/milawa/ACL2/utilities/utilities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/utilities/utilities.lisp	2013-09-30 17:53:16.000000000 +0000
@@ -0,0 +1,3297 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package "MILAWA")
+(include-book "primitives")
+(set-verify-guards-eagerness 2)
+(set-case-split-limitations nil)
+(set-well-founded-relation ord<)
+(set-measure-function rank)
+
+
+;; Common utility functions.
+;;
+;; This file introduces several common functions for operating on lists.
+;;
+;; We find it easier to reason about functions which are not tail recursive.
+;; However, we also provide tail recursive versions of many functions for
+;; greater efficiency.  We typically call these variants fast-<foo>, then prove
+;; fast-<foo> is somehow similar to <foo>.  Sometimes our variants produce
+;; slightly different answers than their simple counterparts, and we mark these
+;; differences with a $ suffix.  For example, fast-range$ computes (rev (range
+;; x)) instead of (range x).
+
+(defund len (x)
+  ;; Compute the length of a list.
+  ;;
+  ;; Performance.  This is a straightforward but inefficient version of the
+  ;; function.  It is not tail-recursive and may cause stack overflows on large
+  ;; lists.  See the functions fast-len and same-lengthp, below, for some
+  ;; performance oriented alternatives.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (+ 1 (len (cdr x)))
+    0))
+
+(defthm len-when-not-consp
+  (implies (not (consp x))
+           (equal (len x)
+                  0))
+  :hints(("Goal" :in-theory (enable len))))
+
+(defthm len-of-cons
+  (equal (len (cons a x))
+         (+ 1 (len x)))
+  :hints(("Goal" :in-theory (enable len))))
+
+(defthm natp-of-len
+  (equal (natp (len x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm natp-of-len-free
+  (implies (equal n (len x))
+           (equal (natp n)
+                  t)))
+
+(defthm len-under-iff
+  (iff (len x)
+       t)
+  :hints(("Goal"
+          :in-theory (disable natp-of-len natp-of-len-free)
+          :use ((:instance natp-of-len)))))
+
+
+
+(defthm |(< 0 (len x))|
+  (equal (< 0 (len x))
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm |(< 1 (len x))|
+  (equal (< 1 (len x))
+         (consp (cdr x))))
+
+(defthm decrement-len-when-consp
+  (implies (consp x)
+           (equal (- (len x) 1)
+                  (len (cdr x)))))
+
+(defthm equal-of-len-and-zero
+  ;; No symmetric rule because of term order.
+  (equal (equal 0 (len x))
+         (not (consp x))))
+
+(defthm consp-of-cdr-when-len-two-cheap
+  (implies (equal (len x) 2)
+           (equal (consp (cdr x))
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(encapsulate
+ ()
+ ;; We can solve (consp (cdr ... (cdr x))) when we know the length of x.
+ (defthm consp-of-cdr-with-len-free
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n)))
+            (equal (consp (cdr x))
+                   (< 1 n))))
+
+ (defthm consp-of-cdr-of-cdr-with-len-free
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n)))
+            (equal (consp (cdr (cdr x)))
+                   (< 2 n))))
+
+ (defthm consp-of-cdr-of-cdr-of-cdr-with-len-free
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n)))
+            (equal (consp (cdr (cdr (cdr x))))
+                   (< 3 n)))))
+
+(encapsulate
+ ()
+ ;; We can solve (cdr ... (cdr x)) under iff when we know the length of x.
+
+ (defthm cdr-under-iff-with-len-free-in-bound
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (< 1 n))
+            (iff (cdr x)
+                 t)))
+
+ (defthm cdr-of-cdr-under-iff-with-len-free-in-bound
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (< 2 n))
+            (iff (cdr (cdr x))
+                 t)))
+
+ (defthm cdr-of-cdr-of-cdr-under-iff-with-len-free-in-bound
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (< 3 n))
+            (iff (cdr (cdr (cdr x)))
+                 t)))
+
+ (defthm cdr-of-cdr-with-len-free-past-the-end
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (< n 2))
+            (equal (cdr (cdr x))
+                   nil)))
+
+ (defthm cdr-of-cdr-of-cdr-with-len-free-past-the-end
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (< n 3))
+            (equal (cdr (cdr (cdr x)))
+                   nil))))
+
+(defthm len-2-when-not-cdr-of-cdr
+  (implies (not (cdr (cdr x)))
+           (equal (equal 2 (len x))
+                  (consp (cdr x))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+
+(defthmd equal-when-length-different
+  (implies (not (equal (len a) (len b)))
+           (equal (equal a b)
+                  nil)))
+
+
+
+
+(defund fast-len (x acc)
+  ;; Compute (+ (len x) acc)
+  ;;
+  ;; Performance.  This is a tail recursive variant of len which avoids stack
+  ;; overflows.  It is between 4-18% faster than len in GCL, and 22-31% faster
+  ;; than len in CMUCL.  Note that the benefits are consistently on the high
+  ;; end of these ranges when the lengths are over 100.
+  (declare (xargs :guard (natp acc)))
+  (if (consp x)
+      (fast-len (cdr x) (+ 1 acc))
+    acc))
+
+(defthm fast-len-removal
+  (implies (force (natp acc))
+           (equal (fast-len x acc)
+                  (+ (len x) acc)))
+  :hints(("Goal" :in-theory (enable fast-len))))
+
+
+
+
+(defund same-lengthp (x y)
+  ;; Are (len x) and (len y) the same?
+  ;;
+  ;; Performance.  We walk down both lists together and check if they end after
+  ;; the same number of steps.  This is tail recursive and requires no
+  ;; arithmetic.  As a result, it is very fast: 99% faster than using "len" in
+  ;; GCL, and 96-97% faster in CMUCL.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (consp y)
+           (same-lengthp (cdr x) (cdr y)))
+    (not (consp y))))
+
+(defthm same-lengthp-removal
+  (equal (same-lengthp x y)
+         (equal (len x) (len y)))
+  :hints(("Goal" :in-theory (enable same-lengthp))))
+
+
+
+
+(defund true-listp (x)
+  ;; Is x a proper list, i.e., does it end with nil?
+  ;;
+  ;; Our standard interpretation of objects as lists ignore the final cdr,
+  ;; e.g., (1 2 . 3) and (1 2 . nil) are both interpreted as the list [1, 2].
+  ;; We think of nil as the canonical choice for this final cdr position, and
+  ;; our list functions will typically create true-lists as their outputs.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (true-listp (cdr x))
+    (equal x nil)))
+
+(defthm true-listp-when-not-consp
+  (implies (not (consp x))
+           (equal (true-listp x)
+                  (equal x nil)))
+  :hints(("Goal" :in-theory (enable true-listp))))
+
+(defthm true-listp-of-cons
+  (equal (true-listp (cons a x))
+         (true-listp x))
+  :hints(("Goal" :in-theory (enable true-listp))))
+
+(defthm booleanp-of-true-listp
+  (equal (booleanp (true-listp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-cdr
+  (implies (true-listp x)
+           (equal (true-listp (cdr x))
+                  t)))
+
+(defthm consp-when-true-listp-cheap
+  (implies (true-listp x)
+           (equal (consp x)
+                  (if x t nil)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm list-of-first-and-second-when-len-2
+  (implies (and (equal (len x) 2)
+                (true-listp x))
+           (equal (list (first x) (second x))
+                  x)))
+
+(defthm list-of-first-and-second-and-third-when-len-3
+  (implies (and (equal (len x) 3)
+                (true-listp x))
+           (equal (list (first x) (second x) (third x))
+                  x)))
+
+(encapsulate
+ ()
+ ;; If we also know x is a true list, then we even know the final cdr (and
+ ;; every cdr past it) is exactly nil.
+
+ (defthm cdr-when-true-listp-with-len-free-past-the-end
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (< n 2)
+                 (true-listp x))
+            (equal (cdr x)
+                   nil)))
+
+ (defthm cdr-of-cdr-when-true-listp-with-len-free-past-the-end
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (< n 3)
+                 (true-listp x))
+            (equal (cdr (cdr x))
+                   nil)))
+
+ (defthm cdr-of-cdr-of-cdr-when-true-listp-with-len-free-past-the-end
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (< n 4)
+                 (true-listp x))
+            (equal (cdr (cdr (cdr x)))
+                   nil))))
+
+
+(encapsulate
+ ()
+ ;; If we only care about iff and we know x is a true list, we can be more
+ ;; precise about exactly when the cdr is nil or non-nil.
+
+ (defthm cdr-under-iff-when-true-listp-with-len-free
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (true-listp x))
+            (iff (cdr x)
+                 (< 1 n))))
+
+ (defthm cdr-of-cdr-under-iff-when-true-listp-with-len-free
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (true-listp x))
+            (iff (cdr (cdr x))
+                 (< 2 n))))
+
+ (defthm cdr-of-cdr-of-cdr-under-iff-when-true-listp-with-len-free
+   (implies (and (equal (len x) n)
+                 (syntaxp (ACL2::quotep n))
+                 (true-listp x))
+            (iff (cdr (cdr (cdr x)))
+                 (< 3 n)))))
+
+
+
+
+(defund list-fix (x)
+  ;; Canonicalize the list x.
+  ;;
+  ;; We keep all of the elements of x in order, but change the final cdr to nil
+  ;; in order to create a proper true-listp.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (car x) (list-fix (cdr x)))
+    nil))
+
+(defthm list-fix-when-not-consp
+  (implies (not (consp x))
+           (equal (list-fix x)
+                  nil))
+  :hints(("Goal" :in-theory (enable list-fix))))
+
+(defthm list-fix-of-cons
+  (equal (list-fix (cons a x))
+         (cons a (list-fix x)))
+  :hints(("Goal" :in-theory (enable list-fix))))
+
+(defthm car-of-list-fix
+  (equal (car (list-fix x))
+         (car x)))
+
+(defthm cdr-of-list-fix
+  (equal (cdr (list-fix x))
+         (list-fix (cdr x))))
+
+(defthm consp-of-list-fix
+  (equal (consp (list-fix x))
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm list-fix-under-iff
+  (iff (list-fix x)
+       (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-list-fix
+  (equal (len (list-fix x))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-list-fix
+  (equal (true-listp (list-fix x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm list-fix-when-true-listp
+  (implies (true-listp x)
+           (equal (list-fix x)
+                  x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm cdr-of-list-fix-under-iff
+  (iff (cdr (list-fix x))
+       (consp (cdr x))))
+
+(defthm equal-of-list-fix-and-self
+  (equal (equal x (list-fix x))
+         (true-listp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+(defund memberp (a x)
+  ;; Is a an element of x?
+  ;;
+  ;; Related functions.  The function first-index tells you the position where
+  ;; the element first occurs in the list.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (or (equal a (car x))
+          (memberp a (cdr x)))
+    nil))
+
+(defthm memberp-when-not-consp
+  (implies (not (consp x))
+           (equal (memberp a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable memberp))))
+
+(defthm memberp-of-cons
+  (equal (memberp a (cons b x))
+         (or (equal a b)
+             (memberp a x)))
+  :hints(("Goal" :in-theory (enable memberp))))
+
+(defthm booleanp-of-memberp
+  (equal (booleanp (memberp a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-list-fix
+  (equal (memberp a (list-fix x))
+         (memberp a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-when-memberp-of-cdr
+  (implies (memberp a (cdr x))
+           (equal (memberp a x)
+                  t)))
+
+(defthm memberp-of-car
+  (equal (memberp (car x) x)
+         (consp x)))
+
+(defthm memberp-of-second
+  (implies (and (consp x)
+                (consp (cdr x)))
+           (equal (memberp (second x) x)
+                  t)))
+
+(defthm car-when-memberp-of-singleton-list-cheap
+  (implies (and (memberp a x)
+                (not (consp (cdr x))))
+           (equal (car x)
+                  a))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm car-when-memberp-and-not-memberp-of-cdr-cheap
+  (implies (and (memberp a x)
+                (not (memberp a (cdr x))))
+           (equal (car x)
+                  a))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm consp-when-memberp-cheap
+  (implies (memberp a x)
+           (equal (consp x)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm consp-of-cdr-when-memberp-not-car-cheap
+  (implies (and (memberp a x)
+                (not (equal (car x) a)))
+           (equal (consp (cdr x))
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm rank-when-memberp
+  (implies (memberp a x)
+           (equal (< (rank a) (rank x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rank-when-memberp-weak
+  (implies (memberp a x)
+           (equal (< (rank x) (rank a))
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund subsetp (x y)
+  ;; Is every element of x an element of y?
+  ;;
+  ;; Related functions.  The function subsetp-badguy returns the first
+  ;; "counterexample" to subsetp, if one exists.  That is, it tries to find an
+  ;; element which is in x but which is not in y.  This is sometimes useful
+  ;; when reasoning about subsets.
+  ;;
+  ;; Performance.  This is a straightforward O(n^2) implementation wherein we
+  ;; just repeatedly call memberp in a loop.  This should be acceptable for
+  ;; small lists, particularly since the function is tail recursive, never
+  ;; needs to cons anything, and never does any arithmetic.  We could
+  ;; eventually implement a variant of subsetp which would sort its inputs,
+  ;; then do a step-wise comparison.  This could be O(n log n), but would
+  ;; require consing and so it would probably not perform well for small lists.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (memberp (car x) y)
+           (subsetp (cdr x) y))
+    t))
+
+(defthm subsetp-when-not-consp
+  (implies (not (consp x))
+           (equal (subsetp x y)
+                  t))
+  :hints(("Goal" :in-theory (enable subsetp))))
+
+(defthm subsetp-when-not-consp-two
+  (implies (not (consp y))
+           (equal (subsetp x y)
+                  (not (consp x))))
+  :hints(("Goal" :in-theory (enable subsetp))))
+
+(defthm subsetp-of-cons
+  (equal (subsetp (cons a x) y)
+         (and (memberp a y)
+              (subsetp x y)))
+  :hints(("Goal" :in-theory (enable subsetp))))
+
+(defthm subsetp-of-cons-two
+  (implies (subsetp x y)
+           (equal (subsetp x (cons a y))
+                  t))
+  :hints(("Goal" :in-theory (enable subsetp))))
+
+(defthm booleanp-of-subsetp
+  (equal (booleanp (subsetp x y))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-list-fix-one
+  (equal (subsetp (list-fix x) y)
+         (subsetp x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-list-fix-two
+  (equal (subsetp x (list-fix y))
+         (subsetp x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-cdr
+  (implies (subsetp x y)
+           (equal (subsetp (cdr x) y)
+                  t)))
+
+(defthm in-superset-when-in-subset-one
+  (implies (and (subsetp x y)
+                (memberp a x))
+           (equal (memberp a y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm in-superset-when-in-subset-two
+  (implies (and (memberp a x)
+                (subsetp x y))
+           (equal (memberp a y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm not-in-subset-when-not-in-superset-one
+  (implies (and (not (memberp a y))
+                (subsetp x y))
+           (equal (memberp a x)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm not-in-subset-when-not-in-superset-two
+  (implies (and (subsetp x y)
+                (not (memberp a y)))
+           (equal (memberp a x)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-when-nonempty-subset-cheap
+  (implies (and (subsetp x y)
+                (consp x))
+           (equal (consp y)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm subsetp-reflexive
+  (equal (subsetp x x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-transitive-one
+  (implies (and (subsetp x y)
+                (subsetp y z))
+           (equal (subsetp x z)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-transitive-two
+  (implies (and (subsetp y z)
+                (subsetp x y))
+           (equal (subsetp x z)
+                  t)))
+
+
+
+
+
+(defund subsetp-badguy (x y)
+  ;; Find a member of x which is not a member of y, if one exists.
+  ;;
+  ;; If we can find such a member, then we see that x is not a subset of y.
+  ;; This is sometimes useful for pick-a-point proofs; search for uses of
+  ;; subsetp-badguy-membership-property for examples, and see also the 2004
+  ;; ACL2 workshop paper, "Finite Set Theory based on Fully Ordered Lists",
+  ;; which you can easily find with Google.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (not (memberp (car x) y))
+          (cons t (car x))
+        (subsetp-badguy (cdr x) y))
+    nil))
+
+(defthm subsetp-badguy-membership-property
+  (implies (subsetp-badguy x y)
+           (and (memberp (cdr (subsetp-badguy x y)) x)
+                (not (memberp (cdr (subsetp-badguy x y)) y))))
+  :rule-classes nil
+  :hints(("Goal"
+          :in-theory (enable subsetp-badguy)
+          :induct (cdr-induction x))))
+
+(defthm subsetp-badguy-under-iff
+  (iff (subsetp-badguy x y)
+       (not (subsetp x y)))
+  :hints(("Goal"
+          :in-theory (enable subsetp-badguy)
+          :induct (cdr-induction x))))
+
+
+
+(defund app (x y)
+  ;; Append the lists x and y.
+  ;;
+  ;; Performance.  This is a straightforward but inefficient version of the
+  ;; function.  It is not tail recursive and may cause stack overflows on large
+  ;; lists.  It also list-fixes its argument, which is nice for us to reason
+  ;; about but will always require (+ (len x) (len y)) conses.  See fast-app
+  ;; and revappend for faster alternatives.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (car x)
+            (app (cdr x) y))
+    (list-fix y)))
+
+(defthm app-when-not-consp
+  (implies (not (consp x))
+           (equal (app x y)
+                  (list-fix y)))
+  :hints(("Goal" :in-theory (enable app))))
+
+(defthm app-of-cons
+  (equal (app (cons a x) y)
+         (cons a (app x y)))
+  :hints(("Goal" :in-theory (enable app))))
+
+(defthm app-of-list-fix-one
+  (equal (app (list-fix x) y)
+         (app x y))
+  :hints(("Goal" :in-theory (enable app))))
+
+(defthm app-of-list-fix-two
+  (equal (app x (list-fix y))
+         (app x y))
+  :hints(("Goal" :in-theory (enable app))))
+
+(defthm app-when-not-consp-two
+  (implies (not (consp y))
+           (equal (app x y)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm app-of-singleton-list-cheap
+  (implies (and (consp xs)
+                (not (consp (cdr xs))))
+           (equal (app xs ys)
+                  (cons (car xs) (list-fix ys))))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm true-listp-of-app
+  (equal (true-listp (app x y))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm app-of-app
+  (equal (app (app x y) z)
+         (app x (app y z)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-app
+  (equal (memberp a (app x y))
+         (or (memberp a x)
+             (memberp a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-of-app
+  (equal (consp (app x y))
+         (or (consp x)
+             (consp y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm app-under-iff
+  (iff (app x y)
+       (or (consp x)
+           (consp y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-app
+  (equal (len (app x y))
+         (+ (len x)
+            (len y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(encapsulate
+ ()
+ (local (defthm lemma
+          (implies (and (subsetp x z)
+                        (subsetp y z))
+                   (subsetp (app x y) z))
+          :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                          (x (app x y))
+                                          (y z)))))))
+
+ (local (defthm lemma2
+          (implies (subsetp (app x y) z)
+                   (subsetp x z))
+          :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                          (x x)
+                                          (y z)))))))
+
+ (local (defthm lemma3
+          (implies (subsetp (app x y) z)
+                   (subsetp y z))
+          :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                          (x y)
+                                          (y z)))))))
+
+ (defthm subsetp-of-app-one
+   (equal (subsetp (app x y) z)
+          (and (subsetp x z)
+               (subsetp y z)))))
+
+(defthm subsetp-of-app-two
+  (equal (subsetp x (app x y))
+         t)
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x x)
+                                  (y (app x y)))))))
+
+(defthm subsetp-of-app-three
+  (equal (subsetp y (app x y))
+         t)
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x y)
+                                  (y (app x y)))))))
+
+(defthm subsetp-of-app-when-subsets
+  (implies (and (subsetp x y)
+                (subsetp w z))
+           (equal (subsetp (app x w) (app y z))
+                  t))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (app x w))
+                                  (y (app y z)))))))
+
+(defthm subsetp-of-symmetric-apps
+  (equal (subsetp (app x y) (app y x))
+         t)
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (app x y))
+                                  (y (app y x)))))))
+
+(defthm weirdo-rule-for-subsetp-of-app-one
+  ;; bozo do we really need this?
+  (equal (subsetp (app (cdr x) (cons (car x) y)) (app x y))
+         (or (consp x)
+             (memberp nil y))))
+
+(defthm weirdo-rule-for-subsetp-of-app-two
+  ;; bozo do we really need this?
+  (equal (subsetp (app (cdr x) (cons (car x) y)) (app y x))
+         (or (consp x)
+             (memberp nil y))))
+
+(defthm cdr-of-app-when-x-is-consp
+  (implies (consp x)
+           (equal (cdr (app x y))
+                  (app (cdr x) y))))
+
+(defthm car-of-app-when-x-is-consp
+  (implies (consp x)
+           (equal (car (app x y))
+                  (car x))))
+
+(defthm memberp-of-app-onto-singleton
+  (equal (memberp a (app x (list b)))
+         (or (memberp a x)
+             (equal a b))))
+
+(defthm subsetp-of-app-onto-singleton-with-cons
+  (equal (subsetp (app x (list a)) (cons a x))
+         t)
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (app x (list a)))
+                                  (y (cons a x)))))))
+
+(defthm subsetp-of-cons-with-app-onto-singleton
+  (equal (subsetp (cons a x) (app x (list a)))
+         t)
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (cons a x))
+                                  (y (app x (list a))))))))
+
+(defthm subsetp-of-cons-of-app-of-app-one
+  (subsetp x (cons b (app y (app x z))))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x x)
+                                  (y (cons b (app y (app x z)))))))))
+
+(defthm subsetp-of-cons-of-app-of-app-two
+  (subsetp x (cons a (app y (app z x))))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x x)
+                                  (y (cons a (app y (app z x)))))))))
+
+(defthm subsetp-of-app-of-app-when-subsetp-one
+  (implies (subsetp x y)
+           (subsetp x (app a (app y b))))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x x)
+                                  (y (app a (app y b))))))))
+
+(defthm subsetp-of-app-of-app-when-subsetp-two
+  (implies (subsetp x y)
+           (subsetp x (app a (app b y))))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x x)
+                                  (y (app a (app b y))))))))
+
+(defthm app-of-cons-of-list-fix-right
+  (equal (app x (cons a (list-fix y)))
+         (app x (cons a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm app-of-cons-when-not-consp-right
+  (implies (and (not (consp y))
+                (syntaxp (not (equal y ''nil))))
+           (equal (app x (cons a y))
+                  (app x (list a))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm equal-of-app-and-app-when-equal-lens
+  (implies (equal (len a) (len c))
+           (equal (equal (app a b)
+                         (app c d))
+                  (and (equal (list-fix a) (list-fix c))
+                       (equal (list-fix b) (list-fix d)))))
+  :hints(("Goal" :induct (cdr-cdr-induction a c))))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-equal-of-app-and-self
+   (equal (equal (cdr x) (list-fix x))
+          (not (consp x)))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm equal-of-app-and-self
+   (equal (equal y (app x y))
+          (and (not (consp x))
+               (true-listp y)))
+   :hints(("Goal"
+           :in-theory (e/d (lemma-for-equal-of-app-and-self)
+                           (len-of-app))
+           :use ((:instance len-of-app)
+                 (:instance len-of-app (x (cdr x))))))))
+
+
+
+
+
+
+(defund rev (x)
+  ;; Reverse the order of the elements of x.
+  ;;
+  ;; Performance.  This is a straightforward but severely inefficient version
+  ;; of the function.  See the function fast-rev for an alternative.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (app (rev (cdr x))
+           (list (car x)))
+    nil))
+
+(defthm rev-when-not-consp
+  (implies (not (consp x))
+           (equal (rev x)
+                  nil))
+  :hints(("Goal" :in-theory (enable rev))))
+
+(defthm rev-of-cons
+  (equal (rev (cons a x))
+         (app (rev x) (list a)))
+  :hints(("Goal" :in-theory (enable rev))))
+
+(defthm rev-of-list-fix
+  (equal (rev (list-fix x))
+         (rev x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-rev
+  (equal (true-listp (rev x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rev-under-iff
+  (iff (rev x)
+       (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-rev
+  (equal (len (rev x))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-rev
+  (equal (memberp a (rev x))
+         (memberp a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-first-of-rev
+  (equal (memberp (first (rev x)) x)
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-rev-one
+  (equal (subsetp (rev x) y)
+         (subsetp x y))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (rev x))
+                                  (y x))
+                       (:instance subsetp-badguy-membership-property
+                                  (x x)
+                                  (y (rev x)))))))
+
+(defthm subsetp-of-rev-two
+  (equal (subsetp x (rev y))
+         (subsetp x y))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x y)
+                                  (y (rev y)))
+                       (:instance subsetp-badguy-membership-property
+                                  (x (rev y))
+                                  (y y))))))
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-rev-of-rev
+   (equal (rev (app x (list a)))
+          (cons a (rev x)))
+   :hints(("Goal" :in-theory (enable rev))))
+
+ (defthm rev-of-rev
+   (equal (rev (rev x))
+          (list-fix x))
+   :hints(("Goal"
+           :in-theory (enable lemma-for-rev-of-rev)
+           :induct (cdr-induction x)))))
+
+(encapsulate
+ ()
+ (local (ACL2::allow-fertilize t))
+ (defthm rev-of-app
+   (equal (rev (app x y))
+          (app (rev y) (rev x)))
+   :hints(("Goal" :induct (cdr-induction x)))))
+
+(defthm subsetp-of-app-of-rev-of-self-one
+  (equal (subsetp x (app (rev x) y))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-app-of-rev-of-self-two
+  (equal (subsetp x (app y (rev x)))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund revappend (x y)
+  ;; Compute (app (rev x) y); almost
+  ;;
+  ;; Performance.  This is the fastest way I know how to join lists together:
+  ;; it is 58-73% faster than app in GCL, and 54-82% faster in CMUCL, with the
+  ;; larger benefits on larger lists.  This is because it is tail recursive, and
+  ;; it does not list-fix y which saves (len y) conses.
+  (declare (xargs :guard (true-listp y)))
+  (if (consp x)
+      (revappend (cdr x) (cons (car x) y))
+    y))
+
+(defthmd revappend-when-not-consp
+  (implies (not (consp x))
+           (equal (revappend x y)
+                  y))
+  :hints(("Goal" :in-theory (enable revappend))))
+
+(defthmd revappend-of-cons
+  (equal (revappend (cons a x) y)
+         (revappend x (cons a y)))
+  :hints(("Goal" :in-theory (enable revappend))))
+
+(defthm forcing-revappend-removal
+   (implies (force (true-listp y))
+            (equal (revappend x y)
+                   (app (rev x) y)))
+   :hints(("Goal" :in-theory (enable revappend))))
+
+
+
+
+(defund fast-rev (x)
+  ;; Compute (rev x)
+  ;;
+  ;; Performance.  We use revappend to perform the reversal.  This gives much
+  ;; better performance than rev.  It's as much as 86% faster on even small
+  ;; lists of 10 elements in both CMUCL and GCL, and rapidly becomes orders of
+  ;; magnitude faster as the size of the list to reverse increases.
+  (declare (xargs :guard t))
+  (revappend x nil))
+
+(defthm fast-rev-removal
+  (equal (fast-rev x)
+         (rev x))
+  :hints(("Goal" :in-theory (enable fast-rev))))
+
+
+
+
+(defund fast-app (x y)
+  ;; Compute (app x y)
+  ;;
+  ;; Performance.  This is a faster version of app which operates by first
+  ;; reversing x, then using revappend to join the lists.  It requires (* 2
+  ;; (len x)) conses, compared to (+ (len x) (len y)) conses for app.  But, it
+  ;; is also tail recursive, so no stack frames are needed and we can process
+  ;; larger lists with it.  It's 9-43% faster than app in GCL, and 5-48% faster
+  ;; in CMUCL, with the larger benefits on larger lists.
+  (declare (xargs :guard (true-listp y)))
+  (revappend (fast-rev x) y))
+
+(defthm fast-app-removal
+  (implies (force (true-listp y))
+           (equal (fast-app x y)
+                  (app x y)))
+  :hints(("Goal" :in-theory (enable fast-app))))
+
+
+
+
+
+(defund remove-all (a x)
+  ;; Remove all occurrences of a from x.
+  ;;
+  ;; Performance.  The function is not tail recursive so it may overflow on
+  ;; large inputs.  See fast-remove-all$ for a faster variant.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (equal a (car x))
+          (remove-all a (cdr x))
+        (cons (car x) (remove-all a (cdr x))))
+    nil))
+
+(defthm remove-all-when-not-consp
+  (implies (not (consp x))
+           (equal (remove-all a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable remove-all))))
+
+(defthm remove-all-of-cons
+  (equal (remove-all a (cons b x))
+         (if (equal a b)
+             (remove-all a x)
+           (cons b (remove-all a x))))
+  :hints(("Goal" :in-theory (enable remove-all))))
+
+(defthm remove-all-of-list-fix
+  (equal (remove-all a (list-fix x))
+         (remove-all a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-remove-all
+  (equal (true-listp (remove-all a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-remove-all
+  (equal (memberp a (remove-all b x))
+         (and (memberp a x)
+              (not (equal a b))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-all-of-app
+  (equal (remove-all a (app x y))
+         (app (remove-all a x)
+              (remove-all a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rev-of-remove-all
+  (equal (rev (remove-all a x))
+         (remove-all a (rev x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-remove-all-with-x
+  (equal (subsetp (remove-all a x) x)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-remove-all-with-remove-all
+  (implies (subsetp x y)
+           (equal (subsetp (remove-all a x)
+                           (remove-all a y))
+                  t))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (remove-all a x))
+                                  (y (remove-all a y)))))))
+
+(defthm subsetp-of-remove-all-when-subsetp
+  (implies (subsetp x y)
+           (subsetp (remove-all a x) y)))
+
+(defthm remove-all-of-non-memberp
+  (implies (not (memberp a x))
+           (equal (remove-all a x)
+                  (list-fix x)))
+  :hints(("Goal" :in-theory (enable remove-all))))
+
+(defthm remove-all-of-remove-all
+  (equal (remove-all a (remove-all b x))
+         (remove-all b (remove-all a x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-cons-and-remove-all-two
+  (equal (subsetp x (cons a (remove-all a y)))
+         (subsetp x (cons a y)))
+  :hints(("Goal"
+          :use ((:instance subsetp-badguy-membership-property
+                           (x (cons a y))
+                           (y (cons a (remove-all a y))))))))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-equal-of-len-of-remove-all-and-len
+   (implies (memberp a x)
+            (equal (< (len (remove-all a x)) (len x))
+                   t))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm equal-of-len-of-remove-all-and-len
+   (equal (equal (len (remove-all a x)) (len x))
+          (not (memberp a x)))
+   :hints(("Goal" :in-theory (enable lemma-for-equal-of-len-of-remove-all-and-len)))))
+
+
+
+
+(defund fast-remove-all$ (a x acc)
+  ;; Compute (app (rev (remove-all a x)) acc)
+  ;;
+  ;; Performance.  This is tail recursive but it returns the elements in
+  ;; reverse order from remove-all.  It's consistently 16% faster in CMUCL for
+  ;; most lists, and up to 37% faster on very long lists.  In GCL it's less
+  ;; inconsistent, but it's usually around 8-30% faster.
+  (declare (xargs :guard (true-listp acc)))
+  (if (consp x)
+      (if (equal a (car x))
+          (fast-remove-all$ a (cdr x) acc)
+        (fast-remove-all$ a (cdr x) (cons (car x) acc)))
+    acc))
+
+(defthmd fast-remove-all$-when-not-consp
+  (implies (not (consp x))
+           (equal (fast-remove-all$ a x acc)
+                  acc))
+  :hints(("Goal" :in-theory (enable fast-remove-all$))))
+
+(defthmd fast-remove-all$-of-cons
+  (equal (fast-remove-all$ a (cons b x) acc)
+         (if (equal a b)
+             (fast-remove-all$ a x acc)
+           (fast-remove-all$ a x (cons b acc))))
+  :hints(("Goal" :in-theory (enable fast-remove-all$))))
+
+(defthm forcing-fast-remove-all$-removal
+   (implies (force (true-listp acc))
+            (equal (fast-remove-all$ a x acc)
+                   (revappend (remove-all a x) acc)))
+   :hints(("Goal" :in-theory (enable fast-remove-all$))))
+
+
+
+
+
+(defund disjointp (x y)
+  ;; Do x and y have no common members?
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (not (memberp (car x) y))
+           (disjointp (cdr x) y))
+    t))
+
+(defthm disjointp-when-not-consp-one
+  (implies (not (consp x))
+           (equal (disjointp x y)
+                  t))
+  :hints(("Goal" :in-theory (enable disjointp))))
+
+(defthm disjointp-of-cons-one
+  (equal (disjointp (cons a x) y)
+         (and (not (memberp a y))
+              (disjointp x y)))
+  :hints(("Goal" :in-theory (enable disjointp))))
+
+(defthm booleanp-of-disjointp
+  (equal (booleanp (disjointp x y))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-when-not-consp-two
+  (implies (not (consp y))
+           (equal (disjointp x y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-of-cons-two
+  (equal (disjointp x (cons a y))
+         (and (not (memberp a x))
+              (disjointp x y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm symmetry-of-disjointp
+  (equal (disjointp x y)
+         (disjointp y x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-of-list-fix-one
+  (equal (disjointp (list-fix x) y)
+         (disjointp x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-of-list-fix-two
+  (equal (disjointp x (list-fix y))
+         (disjointp x y))
+  :hints(("Goal"
+          :in-theory (disable symmetry-of-disjointp)
+          :use ((:instance symmetry-of-disjointp
+                           (x x)
+                           (y (list-fix y)))
+                (:instance symmetry-of-disjointp
+                           (x y)
+                           (y x))))))
+
+(defthm disjointp-of-singleton-one
+  (equal (disjointp (list a) x)
+         (not (memberp a x))))
+
+(defthm disjointp-of-singleton-two
+  (equal (disjointp x (list a))
+         (not (memberp a x))))
+
+(defthm disjointp-when-common-member-one
+  (implies (and (memberp a x)
+                (memberp a y))
+           (equal (disjointp x y)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-when-common-member-two
+  (implies (and (memberp a y)
+                (memberp a x))
+           (equal (disjointp x y)
+                  nil)))
+
+(defthm disjointp-of-app-two
+  (equal (disjointp x (app y z))
+         (and (disjointp x y)
+              (disjointp x z)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-of-app-one
+  (equal (disjointp (app x y) z)
+         (and (disjointp x z)
+              (disjointp y z))))
+
+(defthm disjointp-of-rev-two
+  (equal (disjointp x (rev y))
+         (disjointp x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-of-rev-one
+  (equal (disjointp (rev x) y)
+         (disjointp x y)))
+
+;; disjointp-when-subsetp-of-disjointp[-one,two,three,four]
+;;
+;; If we know (disjointp y z), then:
+;;
+;;   (subsetp x y) -> (disjointp x z) and (disjointp z x)
+;;   (subsetp x z) -> (disjointp x y) and (disjointp y x)
+
+(defthm disjointp-when-subsetp-of-disjointp-one
+  (implies (and (disjointp y z)
+                (subsetp x y))
+           (equal (disjointp x z)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-when-subsetp-of-disjointp-two
+  (implies (and (disjointp y z)
+                (subsetp x y))
+           (equal (disjointp z x)
+                  t)))
+
+(defthm disjointp-when-subsetp-of-disjointp-three
+  (implies (and (disjointp y z)
+                (subsetp x z))
+           (equal (disjointp x y)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-when-subsetp-of-disjointp-four
+  (implies (and (disjointp y z)
+                (subsetp x z))
+           (equal (disjointp y x)
+                  t)))
+
+(defthm disjointp-when-subsetp-of-other-one
+  (implies (subsetp x y)
+           (equal (disjointp x y)
+                  (not (consp x))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-when-subsetp-of-other-two
+  (implies (subsetp y x)
+           (equal (disjointp x y)
+                  (not (consp y))))
+  :hints(("Goal" :induct (cdr-induction y))))
+
+;; (thm (implies (disjointp x y) (disjointp x (remove-all a y))))
+;; (thm (implies (disjointp x y) (disjointp (remove-all a x) y)))
+;; (thm (implies (disjointp x y) (disjointp x (cdr y))))
+;; (thm (implies (disjointp x y) (disjointp (cdr x) y)))
+;; (thm (implies (disjointp x y) (disjointp (cdr x) (cdr y))))
+
+(defthm disjointp-of-remove-all-of-remove-all-when-disjointp-right
+  (implies (disjointp x y)
+           (equal (disjointp x (remove-all a (remove-all b y)))
+                  t)))
+
+(defthm disjointp-of-remove-all-when-disjointp-left
+  (implies (disjointp x y)
+           (equal (disjointp (remove-all a x) y)
+                  t)))
+
+(defthm memberp-when-disjointp-one
+  (implies (and (disjointp x y)
+                (memberp a x))
+           (equal (memberp a y)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-when-disjointp-two
+  (implies (and (disjointp x y)
+                (memberp a y))
+           (equal (memberp a x)
+                  nil)))
+
+
+
+
+
+(defund uniquep (x)
+  ;; Is x free from recurring elements?
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (not (memberp (car x) (cdr x)))
+           (uniquep (cdr x)))
+    t))
+
+(defthm uniquep-when-not-consp
+  (implies (not (consp x))
+           (equal (uniquep x)
+                  t))
+  :hints(("Goal" :in-theory (enable uniquep))))
+
+(defthm uniquep-of-cons
+  (equal (uniquep (cons a x))
+         (and (not (memberp a x))
+              (uniquep x)))
+  :hints(("Goal" :in-theory (enable uniquep))))
+
+(defthm uniquep-of-list-fix
+  (equal (uniquep (list-fix x))
+         (uniquep x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm booleanp-of-uniquep
+  (equal (booleanp (uniquep x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm uniquep-of-cdr-when-uniquep
+  (implies (uniquep x)
+           (equal (uniquep (cdr x))
+                  t)))
+
+(defthm memberp-of-car-in-cdr-when-uniquep
+  (implies (uniquep x)
+           (equal (memberp (car x) (cdr x))
+                  nil)))
+
+(defthm uniquep-of-app
+  (equal (uniquep (app x y))
+         (and (uniquep x)
+              (uniquep y)
+              (disjointp x y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm uniquep-of-rev
+  (equal (uniquep (rev x))
+         (uniquep x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm uniquep-of-remove-all-when-uniquep
+  (implies (uniquep x)
+           (uniquep (remove-all a x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund difference (x y)
+  ;; Collect the members of x which aren't in y.
+  ;;
+  ;; This function is not tail recursive so it may overflow for large inputs.
+  ;; See also fast-difference$ for a tail recursive alternative.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (memberp (car x) y)
+          (difference (cdr x) y)
+        (cons (car x)
+              (difference (cdr x) y)))
+    nil))
+
+(defthm difference-when-not-consp
+  (implies (not (consp x))
+           (equal (difference x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable difference))))
+
+(defthm difference-of-cons
+  (equal (difference (cons a x) y)
+         (if (memberp a y)
+             (difference x y)
+           (cons a (difference x y))))
+  :hints(("Goal" :in-theory (enable difference))))
+
+(defthm true-listp-of-difference
+  (equal (true-listp (difference x y))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm difference-of-list-fix-one
+  (equal (difference (list-fix x) y)
+         (difference x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm difference-of-list-fix-two
+  (equal (difference x (list-fix y))
+         (difference x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm difference-of-app-one
+  (equal (difference (app x y) z)
+         (app (difference x z)
+              (difference y z)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm difference-of-difference
+  (equal (difference (difference x y) z)
+         (difference x (app y z)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm rev-of-difference
+  (equal (rev (difference x y))
+         (difference (rev x) y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd difference-of-rev
+  (equal (difference (rev x) y)
+         (rev (difference x y))))
+
+(ACL2::theory-invariant (ACL2::incompatible (:rewrite difference-of-rev) (:rewrite rev-of-difference)))
+
+(defthm difference-of-rev-two
+  (equal (difference x (rev y))
+         (difference x y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-difference
+  (equal (memberp a (difference x y))
+         (and (memberp a x)
+              (not (memberp a y))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm uniquep-of-difference-when-uniquep
+  (implies (uniquep x)
+           (uniquep (difference x y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-of-difference-with-y
+  (equal (disjointp (difference x y) y)
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm disjointp-of-difference-with-y-alt
+  (equal (disjointp y (difference x y))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm difference-when-subsetp
+  (implies (subsetp x y)
+           (equal (difference x y)
+                  nil))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-with-app-of-difference-onto-takeaway
+  (equal (subsetp x (app (difference x y) y))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund fast-difference$ (x y acc)
+  ;; Compute (app (rev (difference x y)) acc)
+  ;;
+  ;; BOZO how much faster is this function?  Is it faster?
+  (declare (xargs :guard (true-listp acc)))
+  (if (consp x)
+      (if (memberp (car x) y)
+          (fast-difference$ (cdr x) y acc)
+        (fast-difference$ (cdr x) y (cons (car x) acc)))
+    acc))
+
+(defthmd fast-difference$-when-not-consp
+  (implies (not (consp x))
+           (equal (fast-difference$ x y acc)
+                  acc))
+  :hints(("Goal" :in-theory (enable fast-difference$))))
+
+(defthmd fast-difference$-of-cons
+  (equal (fast-difference$ (cons a x) y acc)
+         (if (memberp a y)
+             (fast-difference$ x y acc)
+           (fast-difference$ x y (cons a acc))))
+  :hints(("Goal" :in-theory (enable fast-difference$))))
+
+(defthm forcing-fast-difference$-removal
+  (implies (force (true-listp acc))
+           (equal (fast-difference$ x y acc)
+                  (revappend (difference x y)
+                             acc)))
+  :hints(("Goal" :in-theory (enable fast-difference$))))
+
+
+
+
+(defund remove-duplicates (x)
+  ;; Collect the distinct members of x.
+  ;;
+  ;; Performance.  We looked at writing a fast-remove-duplicates$, but found
+  ;; that the benefits of tail recursion were overwhelmed by the consing and
+  ;; time spent in memberp.  If you need a faster function, consider ordered
+  ;; insertion or sorting.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (memberp (car x) (cdr x))
+          (remove-duplicates (cdr x))
+        (cons (car x) (remove-duplicates (cdr x))))
+    nil))
+
+(defthm remove-duplicates-when-not-consp
+  (implies (not (consp x))
+           (equal (remove-duplicates x)
+                  nil))
+  :hints(("Goal" :in-theory (enable remove-duplicates))))
+
+(defthm remove-duplicates-of-cons
+  (equal (remove-duplicates (cons a x))
+         (if (memberp a x)
+             (remove-duplicates x)
+           (cons a (remove-duplicates x))))
+  :hints(("Goal" :in-theory (enable remove-duplicates))))
+
+(defthm true-listp-of-remove-duplicates
+  (equal (true-listp (remove-duplicates x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-remove-duplicates
+  (equal (< (len x) (len (remove-duplicates x)))
+         nil)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-duplicates-of-list-fix
+  (equal (remove-duplicates (list-fix x))
+         (remove-duplicates x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-remove-duplicates
+  (equal (memberp a (remove-duplicates x))
+         (memberp a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm uniquep-of-remove-duplicates
+  (equal (uniquep (remove-duplicates x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-duplicates-of-difference
+  (equal (remove-duplicates (difference x y))
+         (difference (remove-duplicates x) y))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-duplicates-when-unique
+  (implies (uniquep x)
+           (equal (remove-duplicates x)
+                  (list-fix x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-remove-duplicates-one
+  (equal (subsetp (remove-duplicates x) y)
+         (subsetp x y))
+  :hints(("Goal"
+          :use ((:instance subsetp-badguy-membership-property (x (remove-duplicates x)) (y x))
+                (:instance subsetp-badguy-membership-property (x x) (y (remove-duplicates x)))))))
+
+(defthm subsetp-of-remove-duplicates-two
+  (equal (subsetp x (remove-duplicates y))
+         (subsetp x y))
+  :hints(("Goal"
+          :use ((:instance subsetp-badguy-membership-property (x (remove-duplicates y)) (y y))
+                (:instance subsetp-badguy-membership-property (x y) (y (remove-duplicates y)))))))
+
+(defthm app-of-remove-duplicates-with-unique-and-disjoint
+  (implies (and (uniquep y)
+                (disjointp x y))
+           (equal (remove-duplicates (app x y))
+                  (app (remove-duplicates x) y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm remove-duplicates-of-remove-all
+  (equal (remove-duplicates (remove-all a x))
+         (remove-all a (remove-duplicates x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-cons-onto-remove-duplicates
+  (equal (subsetp x (cons a (remove-duplicates y)))
+         (subsetp x (cons a y))))
+
+(defthm subsetp-of-remove-all-of-remove-duplicates
+  (equal (subsetp (remove-all a (remove-duplicates x)) y)
+         (subsetp (remove-all a x) y)))
+
+
+
+(defund tuplep (n x)
+  ;; Is x a proper n-tuple?
+  ;;
+  ;; That is, we check to see if x is a true-listp whose length is n.  This has
+  ;; a certain performance advantage over testing both separately; we only do
+  ;; one pass over the structure and we have to recur at most n times.
+  ;;
+  ;; BOZO consider rewriting tuplep into (and (true-listp x) (equal (len x) n))
+  ;; and getting rid of all these rules.
+  (declare (xargs :guard (natp n)
+                  :measure (nfix n)))
+  (if (zp n)
+      (equal x nil)
+    (and (consp x)
+         (tuplep (- n 1) (cdr x)))))
+
+(defthm tuplep-when-not-consp
+  (implies (not (consp x))
+           (equal (tuplep n x)
+                  (and (zp n)
+                       (not x))))
+  :hints(("Goal" :in-theory (enable tuplep))))
+
+(defthm tuplep-when-zp
+  (implies (zp n)
+           (equal (tuplep n x)
+                  (equal x nil)))
+  :hints(("Goal" :in-theory (enable tuplep))))
+
+(defthm tuplep-of-cons
+  (equal (tuplep n (cons a x))
+         (and (< 0 n)
+              (tuplep (- n 1) x)))
+  :hints(("Goal" :in-theory (enable tuplep))))
+
+(defthm booleanp-of-tuplep
+  (equal (booleanp (tuplep n x))
+         t)
+  :hints(("Goal" :in-theory (enable tuplep))))
+
+(defthm true-listp-when-tuplep
+  (implies (tuplep n x)
+           (equal (true-listp x)
+                  t))
+  :hints(("Goal" :in-theory (enable tuplep))))
+
+(defthm len-when-tuplep
+  (implies (tuplep n x)
+           (equal (len x)
+                  (nfix n)))
+  :hints(("Goal" :in-theory (enable tuplep))))
+
+(defthm tuplep-when-true-listp
+  (implies (true-listp x)
+           (equal (tuplep n x)
+                  (equal (len x) (nfix n))))
+  :hints(("Goal"
+          :in-theory (enable tuplep)
+          :induct (tuplep n x))))
+
+(defthm consp-of-cdr-when-tuplep-2-cheap
+  (implies (tuplep 2 x)
+           (equal (consp (cdr x))
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm consp-of-cdr-when-tuplep-3-cheap
+  (implies (tuplep 3 x)
+           (equal (consp (cdr x))
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+(defthm consp-of-cdr-of-cdr-when-tuplep-3-cheap
+  (implies (tuplep 3 x)
+           (equal (consp (cdr (cdr x)))
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+
+
+(defund repeat (a n)
+  ;; Create n copies of a in a list.
+  ;;
+  ;; Performance.  This is not tail recursive and requires n conses.  You
+  ;; should typically not need to call repeat, but it is sometimes useful for
+  ;; stating theorems.
+  (declare (xargs :guard (natp n)
+                  :measure (nfix n)))
+  (if (zp n)
+      nil
+    (cons a (repeat a (- n 1)))))
+
+(defthm repeat-of-zero
+  (equal (repeat a 0)
+         nil)
+  :hints(("Goal" :expand (repeat a 0))))
+
+(defthm repeat-of-one
+  (equal (repeat a 1)
+         (list a))
+  :hints(("Goal" :expand (repeat a 1))))
+
+(defthm consp-of-repeat
+  (equal (consp (repeat a n))
+         (not (zp n)))
+  :hints(("Goal" :expand (repeat a n))))
+
+(defthm repeat-under-iff
+  (iff (repeat a n)
+       (not (zp n)))
+  :hints(("Goal" :expand (repeat a n))))
+
+(defthm car-of-repeat
+  (equal (car (repeat a n))
+         (if (zp n)
+             nil
+           a))
+  :hints(("Goal" :expand (repeat a n))))
+
+(defthm cdr-of-repeat
+  (equal (cdr (repeat a n))
+         (if (zp n)
+             nil
+           (repeat a (- n 1))))
+  :hints(("Goal" :expand (repeat a n))))
+
+(defthm repeat-of-nfix
+  (equal (repeat a (nfix n))
+         (repeat a n))
+  :hints(("Goal"
+          :expand (repeat a (nfix n))
+          :induct (dec-induction n))))
+
+(defthm len-of-repeat
+  (equal (len (repeat a n))
+         (nfix n))
+  :hints(("Goal"
+          :expand (repeat a n)
+          :induct (dec-induction n))))
+
+(defthm true-listp-of-repeat
+  (equal (true-listp (repeat a n))
+         t)
+  :hints(("Goal"
+          :expand (repeat a n)
+          :induct (dec-induction n))))
+
+(defthm memberp-of-repeat
+  (equal (memberp a (repeat b n))
+         (and (< 0 (nfix n))
+              (equal a b)))
+  :hints(("Goal"
+          :expand (repeat b n)
+          :induct (dec-induction n))))
+
+(defthm app-of-repeat
+  (equal (app (repeat a n1)
+              (repeat a n2))
+         (repeat a (+ n1 n2)))
+  :hints(("Goal"
+          :expand ((repeat a n1)
+                   (repeat a n2))
+          :induct (dec-induction n1))))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-rev-of-repeat
+   (implies (not (zp n))
+            (equal (app (repeat a (- n 1)) (list a))
+                   (repeat a n)))
+   :hints(("Goal"
+           :in-theory (enable repeat)
+           :induct (dec-induction n))))
+
+ (defthm rev-of-repeat
+   (equal (rev (repeat a n))
+          (repeat a n))
+   :hints(("Goal"
+           :expand (repeat a n)
+           :induct (dec-induction n)
+           :in-theory (enable lemma-for-rev-of-repeat)))))
+
+
+
+
+(defund nth (n x)
+  ;; Retrieve the nth element of a list
+  (declare (xargs :guard (natp n)
+                  :measure (rank x)))
+  (if (consp x)
+      (if (zp n)
+          (car x)
+        (nth (- n 1) (cdr x)))
+    nil))
+
+(defthm nth-when-zp
+  (implies (zp n)
+           (equal (nth n x)
+                  (car x)))
+  :hints(("Goal" :expand (nth n x))))
+
+(defthm nth-of-nfix
+  (equal (nth (nfix n) x)
+         (nth n x))
+  :hints(("Goal" :expand ((nth (nfix n) x)
+                          (nth n x)))))
+
+(defthm nth-of-list-fix
+  (equal (nth n (list-fix x))
+         (nth n x))
+  :hints(("Goal" :in-theory (enable nth))))
+
+(defthm nth-when-index-too-large
+  ;; BOZO consider removing this backchain limit.  We added it because the
+  ;; rule was expensive in Milawa's rewriter, before it had a cache.  Now it
+  ;; may be less expensive.
+  (implies (not (< n (len x)))
+           (equal (nth n x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :in-theory (enable nth))))
+
+(defthm nth-of-increment
+  (equal (nth (+ 1 n) x)
+         (nth n (cdr x)))
+  :hints(("Goal" :in-theory (enable nth))))
+
+(defthm nth-of-app
+  (equal (nth n (app x y))
+         (if (< n (len x))
+             (nth n x)
+           (nth (- n (len x)) y)))
+  :hints(("Goal"
+          :in-theory (enable nth)
+          :induct (nth n x))))
+
+(defthm nth-of-rev
+  (equal (nth n (rev x))
+         (if (< n (len x))
+             (nth (- (len x) (+ 1 n)) x)
+           nil))
+  :hints(("Goal"
+          :in-theory (enable nth)
+          :induct (cdr-induction x))))
+
+(defthm memberp-of-nth
+  (implies (< n (len x))
+           (equal (memberp (nth n x) x)
+                  t))
+  :hints(("Goal" :in-theory (enable nth))))
+
+(encapsulate
+ ()
+ (local (defun my-induction (m n vars)
+          (declare (xargs :measure (rank vars)
+                          :verify-guards nil
+                          :export nil))
+          (if (consp vars)
+              (if (or (zp m)
+                      (zp n))
+                  nil
+                (my-induction (- m 1) (- n 1) (cdr vars)))
+            nil)))
+
+ (local (defthm lemma
+          (implies (and (memberp (nth m vars) vars)
+                        (not (memberp (nth m vars) (cdr vars))))
+                   (equal (nth m vars)
+                          (car vars)))))
+
+ (local (defthm lemma2
+          (implies (and (not (memberp (nth m vars) (cdr vars)))
+                        (consp vars))
+                   (equal (< m (len vars))
+                          (zp m)))
+          :hints(("Goal" :in-theory (enable nth)))))
+
+ (defthm equal-of-nths-when-uniquep
+   (implies (and (uniquep x)
+                 (< n (len x))
+                 (< m (len x)))
+            (equal (equal (nth n x) (nth m x))
+                   (equal (nfix m) (nfix n))))
+   :hints(("Goal"
+           :in-theory (enable nth)
+           :induct (my-induction n m x)))))
+
+
+
+
+(defund prefixp (x y)
+  ;; Do x and y agree on their elements up until x ends?
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (consp y)
+           (equal (car x) (car y))
+           (prefixp (cdr x) (cdr y)))
+    t))
+
+(defthm prefixp-when-not-consp-one
+  (implies (not (consp x))
+           (equal (prefixp x y)
+                  t))
+  :hints(("Goal" :in-theory (enable prefixp))))
+
+(defthm prefixp-when-not-consp-two
+  (implies (not (consp y))
+           (equal (prefixp x y)
+                  (not (consp x))))
+  :hints(("Goal" :in-theory (enable prefixp))))
+
+(defthm prefixp-of-cons-and-cons
+  (equal (prefixp (cons a x) (cons b y))
+         (and (equal a b)
+              (prefixp x y)))
+  :hints(("Goal" :in-theory (enable prefixp))))
+
+(defthm booleanp-of-prefixp
+  (equal (booleanp (prefixp x y))
+         t)
+  :hints(("Goal" :in-theory (enable prefixp))))
+
+(defthm prefixp-of-list-fix-one
+  (equal (prefixp (list-fix x) y)
+         (prefixp x y))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm prefixp-of-list-fix-two
+  (equal (prefixp x (list-fix y))
+         (prefixp x y))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm same-length-prefixes-equal-cheap
+  ;; I tried this rule with no backchain limit for some time, but it was really
+  ;; slow in some cases.  A backchain limit of 0 is too restrictive and was
+  ;; causing some rules to fail, so without much thought I changed it to 1.
+  (implies (and (prefixp x y)
+                (true-listp x)
+                (true-listp y))
+           (equal (equal x y)
+                  (equal (len x) (len y))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+(defthm prefixp-when-lengths-wrong
+  (implies (< (len y) (len x))
+           (equal (prefixp x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable prefixp))))
+
+(defund prefixp-badguy (x y)
+  ;; We search for the index of the first location where x and y differ, i.e.,
+  ;; the first element which violates prefixp.
+  (declare (xargs :guard (<= (len x) (len y))))
+  (if (consp x)
+      (if (equal (car x) (car y))
+          (let ((index (prefixp-badguy (cdr x) (cdr y))))
+            (if index
+                (+ 1 index)
+              nil))
+        0)
+    nil))
+
+(defthmd prefixp-badguy-when-not-consp
+  (implies (not (consp x))
+           (equal (prefixp-badguy x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable prefixp-badguy))))
+
+(defthmd prefixp-badguy-of-cons
+  (equal (prefixp-badguy (cons a x) y)
+         (if (equal a (car y))
+             (let ((index (prefixp-badguy x (cdr y))))
+               (if index
+                   (+ 1 index)
+                 nil))
+           0))
+  :hints(("Goal" :in-theory (enable prefixp-badguy))))
+
+(defthm natp-of-prefixp-badguy
+  (equal (natp (prefixp-badguy x y))
+         (if (prefixp-badguy x y)
+             t
+           nil))
+  :hints(("Goal"
+          :induct (cdr-induction x)
+          :in-theory (enable prefixp-badguy-when-not-consp prefixp-badguy-of-cons))))
+
+(encapsulate
+ ()
+ (defthm lemma-for-prefixp-badguy-index-property
+   (implies (natp (prefixp-badguy x y))
+            (equal (< (prefixp-badguy x y) (len x))
+                   t))
+   :hints(("Goal" :in-theory (enable prefixp-badguy))))
+
+ (defthm lemma-2-for-prefixp-badguy-index-property
+   (implies (natp (prefixp-badguy x y))
+            (not (equal (nth (prefixp-badguy x y) x)
+                        (nth (prefixp-badguy x y) y))))
+   :hints(("Goal" :in-theory (enable prefixp-badguy))))
+
+ (defthm prefixp-badguy-index-property
+   (implies (natp (prefixp-badguy x y))
+            (and (equal (< (prefixp-badguy x y) 0)
+                        nil)
+                 (equal (< (prefixp-badguy x y) (len x))
+                        t)
+                 (not (equal (nth (prefixp-badguy x y) x)
+                             (nth (prefixp-badguy x y) y)))))
+   :rule-classes nil))
+
+(defthm forcing-prefixp-when-not-prefixp-badguy
+  (implies (and (not (prefixp-badguy x y))
+                (force (not (< (len y) (len x)))))
+           (equal (prefixp x y)
+                  t))
+  :hints(("Goal" :in-theory (enable prefixp-badguy))))
+
+(defthm subsetp-when-prefixp-cheap
+  (implies (prefixp x y)
+           (equal (subsetp x y)
+                  t))
+  :rule-classes ((:rewrite :backchain-limit-lst 1))
+  :hints(("Goal" :induct (cdr-cdr-induction x y))))
+
+
+
+
+(defund firstn (n x)
+  ;; Extract the first n elements from x.
+  ;;
+  ;; We stop early if we run out of elements to extract, so that the firstn of
+  ;; x are always a prefix of x.
+  (declare (xargs :guard (natp n) :measure (nfix n)))
+  (if (zp n)
+      nil
+    (if (not (consp x))
+        nil
+      (cons (car x) (firstn (- n 1) (cdr x))))))
+
+(defthm firstn-of-zero
+  (equal (firstn 0 x)
+         nil)
+  :hints(("Goal" :in-theory (enable firstn))))
+
+(defthm true-listp-of-firstn
+  (equal (true-listp (firstn n x))
+         t)
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (firstn n x))))
+
+(defthm consp-of-firstn
+  (equal (consp (firstn n x))
+         (and (< 0 n)
+              (consp x)))
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (firstn n x))))
+
+(defthm firstn-under-iff
+  (iff (firstn n x)
+       (and (< 0 n)
+            (consp x)))
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (firstn n x))))
+
+(defthm firstn-of-list-fix
+  (equal (firstn n (list-fix x))
+         (firstn n x))
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (firstn n x))))
+
+(defthm firstn-of-len
+  (equal (firstn (len x) x)
+         (list-fix x))
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (cdr-induction x))))
+
+(defthm len-of-firstn
+  (equal (len (firstn n x))
+         (min n (len x)))
+  :hints(("Goal" :in-theory (enable firstn))))
+
+(defthm firstn-of-too-many
+  (implies (< (len x) n)
+           (equal (firstn n x)
+                  (list-fix x)))
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (firstn n x))))
+
+(defthm firstn-of-app
+  (equal (firstn n (app x y))
+         (if (< (len x) n)
+             (app x (firstn (- n (len x)) y))
+           (firstn n x)))
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (firstn n x))))
+
+(defthm prefixp-of-firstn
+  (equal (prefixp (firstn n x) x)
+         t)
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (firstn n x))))
+
+(defthm prefixp-of-firstn-unusual
+  (equal (prefixp x (firstn n x))
+         (not (< n (len x))))
+  :hints(("Goal"
+          :in-theory (enable firstn)
+          :induct (firstn n x))))
+
+(defthm subsetp-of-firstn-when-in-range
+  (equal (subsetp (firstn n x) x)
+         t))
+
+
+
+
+(defund restn (n x)
+  ;; Skip the first n elements of x and return the remaining elements.
+  (declare (xargs :guard (natp n) :measure (nfix n)))
+  (if (zp n)
+      (list-fix x)
+    (restn (- n 1) (cdr x))))
+
+(defthm restn-of-zero
+  (equal (restn 0 x)
+         (list-fix x))
+  :hints(("Goal" :in-theory (enable restn))))
+
+(defthm restn-of-one
+  (equal (restn 1 x)
+         (list-fix (cdr x)))
+  :hints(("Goal" :in-theory (enable restn))))
+
+(defthm true-listp-of-restn
+  (equal (true-listp (restn n x))
+         t)
+  :hints(("Goal"
+          :in-theory (enable restn)
+          :induct (restn n x))))
+
+(defthm consp-of-restn
+  (equal (consp (restn n x))
+         (< n (len x)))
+  :hints(("Goal"
+          :in-theory (enable restn)
+          :induct (restn n x))))
+
+(defthm restn-under-iff
+  (iff (restn n x)
+       (< n (len x)))
+  :hints(("Goal"
+          :in-theory (enable restn)
+          :induct (restn n x))))
+
+(defthm restn-of-list-fix
+  (equal (restn n (list-fix x))
+         (restn n x))
+  :hints(("Goal"
+          :in-theory (enable restn)
+          :induct (restn n x))))
+
+(defthm restn-when-not-natp
+  (implies (not (natp n))
+           (equal (restn n x)
+                  (list-fix x)))
+  :hints(("Goal" :in-theory (enable restn))))
+
+(defthm restn-of-app
+  (equal (restn n (app x y))
+         (if (< (len x) n)
+             (restn (- n (len x)) y)
+           (app (restn n x) y)))
+  :hints(("Goal"
+          :in-theory (enable restn)
+          :induct (restn n x))))
+
+(defthm app-of-firstn-and-restn
+  (equal (app (firstn n x) (restn n x))
+         (if (< n (len x))
+             (list-fix x)
+           (firstn n x)))
+  :hints(("Goal"
+          :in-theory (enable firstn restn)
+          :induct (firstn n x))))
+
+(defthm subsetp-of-restn
+  (equal (subsetp (restn n x) x)
+         t)
+  :hints(("Goal"
+          :in-theory (enable restn)
+          :induct (restn n x))))
+
+(defthm restn-of-len
+   (equal (restn (len x) x)
+          nil))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-equal-of-app-with-firstn-and-restn
+   (implies (< n (len x))
+            (equal (app (firstn n x) (restn n x))
+                   (list-fix x))))
+
+ (defthmd lemma-2-for-equal-of-app-with-firstn-and-restn
+   (implies (equal (firstn n x) y)
+            (equal (< (len x) (len y))
+                   nil))
+   :hints(("Goal" :in-theory (enable firstn))))
+
+ (defthmd lemma-3-for-equal-of-app-with-firstn-and-restn
+   (implies (not (< (len x) (len y)))
+            (equal (< (len y) (len x))
+                   (not (equal (len x) (len y))))))
+
+ (defthmd lemma-4-for-equal-of-app-with-firstn-and-restn
+   (implies (and (equal (firstn (len y) x) (list-fix y))
+                 (equal (restn (len y) x) (list-fix z))
+                 (true-listp x))
+            (equal (equal x (app y z))
+                   t))
+   :hints(("Goal"
+           :in-theory (enable lemma-3-for-equal-of-app-with-firstn-and-restn)
+           :use ((:instance lemma-for-equal-of-app-with-firstn-and-restn
+                            (n (len y))
+                            (x x))
+                 (:instance lemma-2-for-equal-of-app-with-firstn-and-restn
+                            (n (len y))
+                            (y (list-fix y)))))))
+
+ (defthmd equal-of-app-with-firstn-and-restn
+   (equal (equal x (app y z))
+          (and (true-listp x)
+               (equal (firstn (len y) x) (list-fix y))
+               (equal (restn (len y) x) (list-fix z))))
+   :hints(("Goal" :use ((:instance lemma-4-for-equal-of-app-with-firstn-and-restn))))))
+
+
+
+
+(defund first-index (a x)
+  ;; We return the smallest index of x which contains element a, or len(x) if
+  ;; no such index exists.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (if (equal (car x) a)
+          0
+        (+ 1 (first-index a (cdr x))))
+    0))
+
+(defthm first-index-when-not-consp
+  (implies (not (consp x))
+           (equal (first-index a x)
+                  0))
+  :hints(("Goal" :in-theory (enable first-index))))
+
+(defthm first-index-of-cons
+  (equal (first-index a (cons b x))
+         (if (equal a b)
+             0
+           (+ 1 (first-index a x))))
+  :hints(("Goal" :in-theory (enable first-index))))
+
+(defthm natp-of-first-index
+  (equal (natp (first-index a x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm first-index-of-list-fix
+  (equal (first-index a (list-fix x))
+         (first-index a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-binds-first-index-range
+  (implies (memberp a x)
+           (equal (< (first-index a x) (len x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm first-index-of-app
+  (equal (first-index a (app x y))
+         (if (memberp a x)
+             (first-index a x)
+           (+ (len x) (first-index a y))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm first-index-of-rev-when-unique
+  (implies (and (uniquep x)
+                (memberp a x))
+           (equal (first-index a (rev x))
+                  (- (len x) (+ 1 (first-index a x)))))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm first-index-of-car
+  (equal (first-index (car x) x)
+         0))
+
+(defthm nth-of-first-index-when-memberp
+  (implies (memberp a x)
+           (equal (nth (first-index a x) x)
+                  a))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm first-index-less-than-len
+  (equal (< (first-index a x) (len x))
+         (memberp a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm first-index-less-than-len-free
+  (implies (and (equal (len x) n)
+                (memberp a x))
+           (equal (< (first-index a x) n)
+                  t)))
+
+(defthm nth-of-first-index-of-nth
+  (implies (< n (len x))
+           (equal (nth (first-index (nth n x) x) x)
+                  (nth n x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm first-index-of-nth-when-unique
+  (implies (and (uniquep x)
+                (< n (len x)))
+           (equal (first-index (nth n x) x)
+                  (nfix n)))
+  :hints(("Goal"
+          :use ((:instance equal-of-nths-when-uniquep
+                           (n (first-index (nth n x) x))
+                           (m n)
+                           (x x))))))
+
+(defthm equal-of-first-index-and-n-when-len
+  ;; BOZO it seems weird that this rule would ever fire.  Don't we want to
+  ;; reorder the n and the first-index?  Or, I guess, we might want to have
+  ;; both rules, since I suppose n could be some big expression instead of
+  ;; just a constant.
+  (implies (equal (len x) n)
+           (equal (equal (first-index a x) n)
+                  (not (memberp a x))))
+  :hints(("Goal" :in-theory (enable first-index))))
+
+
+
+
+
+(defund mapp (x)
+  ;; Is x a list of (key . value) pairs?
+  (declare (xargs :guard t))
+  (if (consp x)
+      (and (consp (car x))
+           (mapp (cdr x)))
+    t))
+
+(defthm mapp-when-not-consp
+  (implies (not (consp x))
+           (equal (mapp x)
+                  t))
+  :hints(("Goal" :in-theory (enable mapp))))
+
+(defthm mapp-of-cons
+  (equal (mapp (cons a x))
+         (and (consp a)
+              (mapp x)))
+  :hints(("Goal" :in-theory (enable mapp))))
+
+(defthm mapp-of-list-fix
+  (equal (mapp (list-fix x))
+         (mapp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm booleanp-of-mapp
+  (equal (booleanp (mapp x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm mapp-of-app
+  (equal (mapp (app x y))
+         (and (mapp x)
+              (mapp y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund cons-fix (x)
+  ;; Compute (cons (car x) (cdr x))
+  (declare (xargs :guard t))
+  (if (consp x)
+      x
+    (cons nil nil)))
+
+(defthm cons-fix-when-not-consp
+  (implies (not (consp x))
+           (equal (cons-fix x)
+                  (cons nil nil)))
+  :hints(("Goal" :in-theory (enable cons-fix))))
+
+(defthm cons-fix-when-consp
+  (implies (consp x)
+           (equal (cons-fix x)
+                  x))
+  :hints(("Goal" :in-theory (enable cons-fix))))
+
+(defthm consp-of-cons-fix
+  (equal (consp (cons-fix x))
+         t)
+  :hints(("Goal" :cases ((consp x)))))
+
+(defthm cons-fix-under-iff
+  (iff (cons-fix x)
+       t)
+  :hints(("Goal" :cases ((consp x)))))
+
+(defthm cons-fix-of-cons
+  (equal (cons-fix (cons x y))
+         (cons x y)))
+
+(defthm car-of-cons-fix
+  (equal (car (cons-fix x))
+         (car x)))
+
+(defthm cdr-of-cons-fix
+  (equal (cdr (cons-fix x))
+         (cdr x)))
+
+
+
+
+(defund lookup (a x)
+  ;; Find the first pair of the form (a . b) in the map x
+  (declare (xargs :guard (mapp x)))
+  (if (consp x)
+      (if (equal a (car (car x)))
+          (if (consp (car x))
+              (car x)
+            (cons (car (car x))
+                  (cdr (car x))))
+        (lookup a (cdr x)))
+    nil))
+
+(defthm lookup-when-not-consp
+  (implies (not (consp x))
+           (equal (lookup a x)
+                  nil))
+  :hints(("Goal" :in-theory (enable lookup))))
+
+(defthm lookup-of-cons
+  (equal (lookup a (cons b x))
+         (if (equal a (car b))
+             (cons-fix b)
+           (lookup a x)))
+  :hints(("Goal" :in-theory (enable lookup))))
+
+(defthm lookup-of-list-fix
+  (equal (lookup a (list-fix x))
+         (lookup a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm lookup-of-app
+  (equal (lookup a (app x y))
+         (if (lookup a x)
+             (lookup a x)
+           (lookup a y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm car-of-lookup-when-found
+  (implies (lookup key map)
+           (equal (car (lookup key map))
+                  key))
+  :hints(("Goal" :induct (cdr-induction map))))
+
+(defthm consp-of-lookup-under-iff
+  (iff (consp (lookup a x))
+       (lookup a x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+
+
+
+(defund update (key val map)
+  ;; Update the map with (key . val)
+  (declare (xargs :guard (mapp map)))
+  (cons (cons key val)
+        (list-fix map)))
+
+(defthm car-of-update
+  (equal (car (update key val map))
+         (cons key val))
+  :hints(("Goal" :in-theory (enable update))))
+
+(defthm cdr-of-update
+  (equal (cdr (update key val map))
+         (list-fix map))
+  :hints(("Goal" :in-theory (enable update))))
+
+(defthm consp-of-update
+  (equal (consp (update key val map))
+         t)
+  :hints(("Goal" :in-theory (enable update))))
+
+(defthm update-of-list-fix
+  (equal (update key val (list-fix map))
+         (update key val map))
+  :hints(("Goal" :in-theory (enable update))))
+
+(defthm mapp-of-update-when-mapp
+  (implies (mapp map)
+           (equal (mapp (update key val map))
+                  t))
+  :hints(("Goal" :in-theory (enable update))))
+
+(defthm lookup-of-update
+  (equal (lookup a (update b val map))
+         (if (equal a b)
+             (cons a val)
+           (lookup a map)))
+  :hints(("Goal" :in-theory (enable update))))
+
+
+
+
+(defund domain (x)
+  ;; List all the keys in a map.
+  ;;
+  ;; Performance.  This function isn't tail recursive and it might overflow
+  ;; on large lists.  See also fast-domain$ for an alternative.
+  (declare (xargs :guard (mapp x)))
+  (if (consp x)
+      (cons (car (car x))
+            (domain (cdr x)))
+    nil))
+
+(defthm domain-when-not-consp
+  (implies (not (consp x))
+           (equal (domain x)
+                  nil))
+  :hints(("Goal" :in-theory (enable domain))))
+
+(defthm domain-of-cons
+  (equal (domain (cons a x))
+         (cons (car a) (domain x)))
+  :hints(("Goal" :in-theory (enable domain))))
+
+(defthm domain-of-list-fix
+  (equal (domain (list-fix x))
+         (domain x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm consp-of-domain
+  (equal (consp (domain x))
+         (consp x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-domain
+  (equal (true-listp (domain x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm domain-of-app
+  (equal (domain (app x y))
+         (app (domain x)
+              (domain y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm domain-of-update
+  (equal (domain (update a x map))
+         (cons a (domain map)))
+  :hints(("Goal" :in-theory (enable update))))
+
+(defthm memberp-of-domain-when-memberp
+  (implies (memberp a x)
+           (equal (memberp (car a) (domain x))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-domain-when-memberp-of-subset-domain
+  (implies (and (memberp a (domain x))
+                (subsetp x y))
+           (equal (memberp a (domain y))
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm subsetp-of-domains
+  (implies (subsetp x y)
+           (equal (subsetp (domain x) (domain y))
+                  t))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (domain x))
+                                  (y (domain y)))))))
+
+(defthm uniquep-when-uniquep-of-domain
+  (implies (uniquep (domain x))
+           (equal (uniquep x)
+                  t))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm memberp-of-domain-under-iff
+  (iff (memberp a (domain x))
+       (lookup a x))
+  :hints(("Goal" :in-theory (enable lookup))))
+
+(defthm rev-of-domain
+  (equal (rev (domain x))
+         (domain (rev x)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthmd domain-of-rev
+  (equal (domain (rev x))
+         (rev (domain x))))
+
+(ACL2::theory-invariant (ACL2::incompatible (:rewrite domain-of-rev) (:rewrite rev-of-domain)))
+
+
+
+(defund fast-domain$ (x acc)
+  ;; Compute (app (rev (domain x)) acc)
+  ;;
+  ;; Performance.  This is tail recursive and was as up to 40-44% faster than
+  ;; domain on GCL for lists of length 100-10000.
+  (declare (xargs :guard (and (mapp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (fast-domain$ (cdr x) (cons (car (car x)) acc))
+    acc))
+
+(defthmd fast-domain$-when-not-consp
+  (implies (not (consp x))
+           (equal (fast-domain$ x acc)
+                  acc))
+  :hints(("Goal" :in-theory (enable fast-domain$))))
+
+(defthmd fast-domain$-of-cons
+  (equal (fast-domain$ (cons a x) acc)
+         (fast-domain$ x (cons (car a) acc)))
+  :hints(("Goal" :in-theory (enable fast-domain$))))
+
+(defthm forcing-fast-domain$-removal
+  (implies (force (true-listp acc))
+           (equal (fast-domain$ x acc)
+                  (revappend (domain x) acc)))
+  :hints(("Goal" :in-theory (enable fast-domain$))))
+
+
+
+
+(defund range (x)
+  ;; List all the values in a map.
+  ;;
+  ;; Performance.  This function isn't tail recursive and it might overflow on
+  ;; large lists.  See also fast-domain$ for an alternative.
+  (declare (xargs :guard (mapp x)))
+  (if (consp x)
+      (cons (cdr (car x))
+            (range (cdr x)))
+    nil))
+
+(defthm range-when-not-consp
+  (implies (not (consp x))
+           (equal (range x)
+                  nil))
+  :hints(("Goal" :in-theory (enable range))))
+
+(defthm range-of-cons
+  (equal (range (cons a x))
+         (cons (cdr a) (range x)))
+  :hints(("Goal" :in-theory (enable range))))
+
+(defthm range-of-list-fix
+  (equal (range (list-fix x))
+         (range x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm true-listp-of-range
+  (equal (true-listp (range x))
+         t)
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm len-of-range
+  (equal (len (range x))
+         (len x))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm range-of-app
+  (equal (range (app x y))
+         (app (range x)
+              (range y)))
+  :hints(("Goal" :induct (cdr-induction x))))
+
+(defthm nth-of-first-index-of-domain-and-range
+  (equal (nth (first-index a (domain x)) (range x))
+         (cdr (lookup a x)))
+  :hints(("Goal"
+          :in-theory (enable first-index)
+          :induct (cdr-induction x))))
+
+
+(defund fast-range$ (x acc)
+  ;; Compute (app (rev (range x)) acc)
+  ;;
+  ;; Performance.  This is tail recursive and was up to 32-41% faster than
+  ;; range on GCL for lists of length 100-10000.  I'm not sure why these
+  ;; numbers are different than fast-domain$'s, since they're almost identical
+  ;; functions.  Whatever.
+  (declare (xargs :guard (and (mapp x)
+                              (true-listp acc))))
+  (if (consp x)
+      (fast-range$ (cdr x) (cons (cdr (car x)) acc))
+    acc))
+
+(defthmd fast-range$-when-not-consp
+  (implies (not (consp x))
+           (equal (fast-range$ x acc)
+                  acc))
+  :hints(("Goal" :in-theory (enable fast-range$))))
+
+(defthmd fast-range$-of-cons
+  (equal (fast-range$ (cons a x) acc)
+         (fast-range$ x (cons (cdr a) acc)))
+  :hints(("Goal" :in-theory (enable fast-range$))))
+
+(defthm forcing-fast-range$-removal
+  (implies (force (true-listp acc))
+           (equal (fast-range$ x acc)
+                  (revappend (range x) acc)))
+  :hints(("Goal" :in-theory (enable fast-range$))))
+
+
+
+
+(defund submapp1 (domain x y)
+  ;; Do x and y agree on the values for all keys in domain?
+  (declare (xargs :guard (and (mapp x) (mapp y))))
+  (if (consp domain)
+      (and (equal (lookup (car domain) x)
+                  (lookup (car domain) y))
+           (submapp1 (cdr domain) x y))
+    t))
+
+(defthm submapp1-when-not-consp
+  (implies (not (consp domain))
+           (equal (submapp1 domain x y)
+                  t))
+  :hints(("Goal" :in-theory (enable submapp1))))
+
+(defthm submapp1-of-cons
+  (equal (submapp1 (cons a domain) x y)
+         (and (equal (lookup a x) (lookup a y))
+              (submapp1 domain x y)))
+  :hints(("Goal" :in-theory (enable submapp1))))
+
+(defthm booleanp-of-submapp1
+  (equal (booleanp (submapp1 domain x y))
+         t)
+  :hints(("Goal" :induct (cdr-induction domain))))
+
+(defthm equal-of-lookups-when-memberp-of-submapp1-domain
+  (implies (and (submapp1 domain x y)
+                (memberp a domain))
+           (equal (equal (lookup a x)
+                         (lookup a y))
+                  t))
+  :hints(("Goal" :induct (cdr-induction domain))))
+
+(defthm lookup-when-memberp-of-submapp1
+  (implies (and (submapp1 domain x y)
+                (memberp a domain)
+                (lookup a x))
+           (iff (lookup a y)
+                t))
+  :hints(("Goal" :induct (cdr-induction domain))))
+
+
+
+
+(defund submapp1-badguy (domain x y)
+  ;; Find the first key in domain for which x and y do not agree.
+  (declare (xargs :guard (and (mapp x) (mapp y))))
+  (if (consp domain)
+      (if (not (equal (lookup (car domain) x)
+                      (lookup (car domain) y)))
+          (cons t (car domain))
+        (submapp1-badguy (cdr domain) x y))
+    nil))
+
+(defthmd submapp1-badguy-when-not-consp
+  (implies (not (consp domain))
+           (equal (submapp1-badguy domain x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable submapp1-badguy))))
+
+(defthmd submapp1-badguy-of-cons
+  (equal (submapp1-badguy (cons a domain) x y)
+         (if (not (equal (lookup a x) (lookup a y)))
+             (cons t a)
+           (submapp1-badguy domain x y)))
+  :hints(("Goal" :in-theory (enable submapp1-badguy))))
+
+(defthm submapp1-badguy-membership-property
+  (implies (submapp1-badguy domain x y)
+           (and (memberp (cdr (submapp1-badguy domain x y)) domain)
+                (not (equal (lookup (cdr (submapp1-badguy domain x y)) x)
+                            (lookup (cdr (submapp1-badguy domain x y)) y)))))
+  :rule-classes nil
+  :hints(("Goal"
+          :in-theory (enable submapp1-badguy)
+          :induct (cdr-induction domain))))
+
+(defthm submapp1-badguy-under-iff
+  (iff (submapp1-badguy domain x y)
+       (not (submapp1 domain x y)))
+  :hints(("Goal"
+          :in-theory (enable submapp1 submapp1-badguy)
+          :induct (cdr-induction domain))))
+
+(defthm submapp1-when-submapp1-of-domain-superset-one
+  (implies (and (subsetp domain1 domain2)
+                (submapp1 domain2 x y))
+           (equal (submapp1 domain1 x y)
+                  t))
+  :hints(("Goal" :use ((:instance submapp1-badguy-membership-property
+                                  (domain domain1)
+                                  (x x)
+                                  (y y))))))
+
+(defthm submapp1-when-submapp1-of-domain-superset-two
+  (implies (and (submapp1 domain2 x y)
+                (subsetp domain1 domain2))
+           (equal (submapp1 domain1 x y)
+                  t)))
+
+(defthm submapp1-of-list-fix-one
+  (equal (submapp1 (list-fix domain) x y)
+         (submapp1 domain x y)))
+
+(defthm submapp1-of-list-fix-two
+  (equal (submapp1 domain (list-fix x) y)
+         (submapp1 domain x y))
+  :hints(("Goal" :induct (cdr-induction domain))))
+
+(defthm submapp1-of-list-fix-three
+  (equal (submapp1 domain x (list-fix y))
+         (submapp1 domain x y))
+  :hints(("Goal" :induct (cdr-induction domain))))
+
+
+
+
+(defund submapp (x y)
+  ;; Do x and y agree on the values of every key in x?
+  (declare (xargs :guard (and (mapp x)
+                              (mapp y))))
+  (submapp1 (domain x) x y))
+
+(defthm booleanp-of-submapp
+  (equal (booleanp (submapp x y))
+         t)
+  :hints(("Goal" :in-theory (enable submapp))))
+
+(defthm submapp-of-list-fix-one
+  (equal (submapp (list-fix x) y)
+         (submapp x y))
+  :hints(("Goal" :in-theory (enable submapp))))
+
+(defthm submapp-of-list-fix-two
+  (equal (submapp x (list-fix y))
+         (submapp x y))
+  :hints(("Goal" :in-theory (enable submapp))))
+
+(defthm equal-of-lookups-when-submapp
+  (implies (and (submapp x y)
+                (lookup a x))
+           (equal (equal (lookup a x) (lookup a y))
+                  t))
+  :hints(("Goal" :in-theory (enable submapp))))
+
+(defthm equal-of-cdrs-of-lookups-when-submapp
+  (implies (and (submapp x y)
+                (lookup a x))
+           (equal (equal (cdr (lookup a x)) (cdr (lookup a y)))
+                  t))
+  :hints(("Goal"
+          :in-theory (disable equal-of-lookups-when-submapp)
+          :use ((:instance equal-of-lookups-when-submapp)))))
+
+(defthm lookup-when-lookup-in-submapp-one
+  (implies (and (submapp x y)
+                (lookup a x))
+           (iff (lookup a y)
+                t))
+  :hints(("Goal" :in-theory (enable submapp))))
+
+(defthm lookup-when-lookup-in-submapp-two
+  (implies (and (lookup a x)
+                (submapp x y))
+           (iff (lookup a y)
+                t))
+  :hints(("Goal" :in-theory (enable submapp))))
+
+
+
+
+(defund submapp-badguy (x y)
+  ;; Find the first key in x such that x and y disagree upon its value
+  (declare (xargs :guard (and (mapp x)
+                              (mapp y))))
+  (submapp1-badguy (domain x) x y))
+
+(defthm submapp-badguy-membership-property
+  (implies (submapp-badguy x y)
+           (and (lookup (cdr (submapp-badguy x y)) x)
+                (not (equal (lookup (cdr (submapp-badguy x y)) x)
+                            (lookup (cdr (submapp-badguy x y)) y)))))
+  :rule-classes nil
+  :hints(("Goal"
+          :in-theory (enable submapp-badguy)
+          :use ((:instance submapp1-badguy-membership-property
+                           (domain (domain x)))))))
+
+(defthm submapp-badguy-under-iff
+  (iff (submapp-badguy x y)
+       (not (submapp x y)))
+  :hints(("Goal" :in-theory (enable submapp submapp-badguy))))
+
+(defthm subsetp-of-domains-when-submap
+  (implies (submapp x y)
+           (equal (subsetp (domain x) (domain y))
+                  t))
+  :hints(("Goal" :use ((:instance subsetp-badguy-membership-property
+                                  (x (domain x))
+                                  (y (domain y)))))))
+
+(defthm submapp-reflexive
+  (equal (submapp x x)
+         t)
+  :hints(("Goal" :use ((:instance submapp-badguy-membership-property
+                                  (x x) (y x))))))
+
+(defthm submapp-transitive
+  (implies (and (submapp x y)
+                (submapp y z))
+           (equal (submapp x z)
+                  t))
+  :hints(("Goal"
+          :in-theory (disable equal-of-lookups-when-submapp)
+          :use ((:instance submapp-badguy-membership-property
+                           (x x) (y z))
+                (:instance equal-of-lookups-when-submapp
+                           (a (cdr (submapp-badguy x z))) (x x) (y y))
+                (:instance equal-of-lookups-when-submapp
+                           (a (cdr (submapp-badguy x z))) (x y) (y z))))))
+
+(defthm submapp-transitive-alt
+  (implies (and (submapp y z)
+                (submapp x y))
+           (equal (submapp x z)
+                  t)))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-submapp1-of-app
+   (implies (and (submapp1 d1 a b)
+                 (submapp1 d2 a b))
+            (equal (submapp1 (app d1 d2) a b)
+                   t))
+   :hints(("Goal"
+           :use ((:instance submapp1-badguy-membership-property
+                            (domain (app d1 d2))
+                            (x a)
+                            (y b))))))
+
+ (defthm submapp1-of-app
+   (equal (submapp1 (app domain1 domain2) a b)
+          (and (submapp1 domain1 a b)
+               (submapp1 domain2 a b)))
+   :hints(("Goal" :in-theory (enable lemma-for-submapp1-of-app)))))
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-submapp-of-cons-onto-map
+   (implies (and (submapp1 x map (cons (cons key val) map2))
+                 (not (lookup key map)))
+            (submapp1 x
+                      (cons entry map)
+                      (cons (cons key val)
+                            (cons entry map2))))
+   :hints(("Goal" :induct (cdr-induction x))))
+
+ (defthm submapp-of-cons-onto-map
+   (implies (not (consp (lookup key map)))
+            (equal (submapp map (cons (cons key val) map))
+                   t))
+   :hints(("Goal"
+           :induct (cdr-induction map)
+           :in-theory (enable submapp submapp1 domain lemma-for-submapp-of-cons-onto-map)))))
+
+(encapsulate
+ ()
+ (defthmd lemma-for-submapp-when-unique-domains-and-subsetp
+   (implies (and (uniquep (domain x))
+                 (memberp a x))
+            (equal (lookup (car a) x)
+                   (cons-fix a)))
+   :hints(("Goal"
+           :in-theory (enable lookup)
+           :induct (lookup (car a) x))))
+
+ (defthmd lemma2-for-submapp-when-unique-domains-and-subsetp
+   (implies (and (uniquep (domain x))
+                 (uniquep (domain y))
+                 (subsetp x y)
+                 (memberp a (domain x)))
+            (equal (equal (lookup a x)
+                          (lookup a y))
+                   t))
+   :hints(("Goal"
+           :induct (cdr-induction x)
+           :in-theory (enable lemma-for-submapp-when-unique-domains-and-subsetp))))
+
+ (defthm submapp-when-unique-domains-and-subsetp
+   (implies (and (uniquep (domain x))
+                 (uniquep (domain y))
+                 (subsetp x y))
+            (equal (submapp x y)
+                   t))
+   :hints(("Goal"
+           :in-theory (enable lemma2-for-submapp-when-unique-domains-and-subsetp)
+           :use ((:instance submapp-badguy-membership-property
+                            (x x)
+                            (y y)))))))
+
+
+(encapsulate
+ ()
+ (defthmd lemma-for-submapp-of-app-when-submapp
+   (implies (and (submapp1 dom a b)
+                 (subsetp dom (domain a)))
+            (submapp1 dom a (app b c)))
+   :hints(("Goal" :induct (cdr-induction dom))))
+
+ (defthm submapp-of-app-when-submapp
+   (implies (submapp a b)
+            (submapp a (app b c)))
+   :hints(("Goal" :in-theory (enable submapp lemma-for-submapp-of-app-when-submapp)))))
+
+
+(defthm submapp-of-rev-when-uniquep
+  (implies (uniquep (domain x))
+           (submapp x (rev x)))
+  :hints(("Goal"
+          :in-theory (e/d (domain-of-rev)
+                          (rev-of-domain)))))
+
+
+
+
+
+(defund pair-lists (x y)
+  ;; Create a list of pairs with cars from x and cdrs from y
+  (declare (xargs :guard t))
+  (if (consp x)
+      (cons (cons (car x) (car y))
+            (pair-lists (cdr x) (cdr y)))
+    nil))
+
+(defthm pair-lists-when-not-consp
+  (implies (not (consp x))
+           (equal (pair-lists x y)
+                  nil))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(defthm pair-lists-of-cons-one
+  (equal (pair-lists (cons a x) y)
+         (cons (cons a (car y))
+               (pair-lists x (cdr y))))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(defthm pair-lists-of-cons-two
+  (equal (pair-lists x (cons a y))
+         (if (consp x)
+             (cons (cons (car x) a)
+                   (pair-lists (cdr x) y))
+           nil))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(defthm true-listp-of-pair-lists
+  (equal (true-listp (pair-lists x y))
+         t)
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(defthm pair-lists-of-list-fix-one
+  (equal (pair-lists (list-fix x) y)
+         (pair-lists x y))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(defthm pair-lists-of-list-fix-two
+  (equal (pair-lists x (list-fix y))
+         (pair-lists x y))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(defthm domain-of-pair-lists
+  (equal (domain (pair-lists x y))
+         (list-fix x))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(defthm range-of-pair-lists
+  (implies (force (equal (len domain) (len range)))
+           (equal (range (pair-lists domain range))
+                  (list-fix range)))
+  :hints(("Goal" :in-theory (enable pair-lists))))
+
+(defthm lookup-of-pair-lists
+  (equal (lookup a (pair-lists keys vals))
+         (if (memberp a keys)
+             (cons a (nth (first-index a keys) vals))
+           nil))
+  :hints(("Goal" :in-theory (enable pair-lists first-index))))
+
+(defthm lookup-of-pair-lists-of-rev
+  (implies (and (uniquep keys)
+                (equal (len keys) (len vals)))
+           (equal (lookup a (pair-lists (rev keys) vals))
+                  (if (memberp a keys)
+                      (cons a (nth (- (len keys)
+                                      (+ 1 (first-index a keys)))
+                                   vals))
+                    nil))))
+
+(encapsulate
+ ()
+ (local (defun my-induction (n vars vals)
+          (declare (xargs :verify-guards nil
+                          :measure (rank vars)
+                          :export nil))
+          (if (or (not (consp vars))
+                  (not (consp vals)))
+              nil
+            (if (zp n)
+                nil
+              (my-induction (- n 1) (cdr vars) (cdr vals))))))
+
+ (defthm lookup-of-nth-in-pair-lists-when-unique-keys
+   (implies (and (uniquep x)
+                 (equal (len x) (len y))
+                 (< n (len x)))
+            (equal (lookup (nth n x) (pair-lists x y))
+                   (cons (nth n x)
+                         (nth n y))))
+   :hints(("Goal" :induct (my-induction n x y)))))
+
+
+
+(defund fast-pair-lists$ (x y acc)
+  ;; Compute (app (rev (pair-lists x y)) acc)
+  ;;
+  ;; This is tail recursive and runs up to 10-21% faster than pair-lists for
+  ;; lists of size 100-10000.
+  (declare (xargs :guard t))
+  (if (consp x)
+      (fast-pair-lists$ (cdr x)
+                        (cdr y)
+                        (cons (cons (car x) (car y)) acc))
+    acc))
+
+(defthmd fast-pair-lists$-when-not-consp
+  (implies (not (consp x))
+           (equal (fast-pair-lists$ x y acc)
+                  acc))
+  :hints(("Goal" :in-theory (enable fast-pair-lists$))))
+
+(defthmd fast-pair-lists$-of-cons
+  (equal (fast-pair-lists$ (cons a x) y acc)
+         (fast-pair-lists$ x (cdr y) (cons (cons a (car y)) acc)))
+  :hints(("Goal" :in-theory (enable fast-pair-lists$))))
+
+(defthm forcing-fast-pair-lists$-removal
+  (implies (force (true-listp acc))
+           (equal (fast-pair-lists$ x y acc)
+                  (revappend (pair-lists x y) acc)))
+  :hints(("Goal" :in-theory (enable fast-pair-lists$))))
+
+
diff -Nru acl2-6.2/books/milawa/ACL2/wait.pl acl2-6.3/books/milawa/ACL2/wait.pl
--- acl2-6.2/books/milawa/ACL2/wait.pl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/ACL2/wait.pl	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,113 @@
+#!/usr/bin/env perl
+
+# wait.pl -- wait for a file to show up on NFS.
+# Adapted from the cert.pl build system
+#
+# Copyright (C) 2008-2011 Centaur Technology
+#
+# Contact:
+#   Centaur Technology Formal Verification Group
+#   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+#   http://www.centtech.com/
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.  This program is distributed in the hope that it will be useful but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.  You should have received a copy of the GNU General Public
+# License along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+#
+# Original authors: Sol Swords <sswords@centtech.com>
+#                   Jared Davis <jared@centtech.com>
+
+use warnings;
+use strict;
+
+if (@ARGV != 1) {
+    usage_error();
+}
+
+my $filename = $ARGV[0];
+
+if (-f $filename) {
+    exit(0);
+}
+
+my $MAX_NFS_LAG = $ENV{"MAX_NFS_LAG"} || 100;
+wait_for_nfs($filename);
+
+sub nfs_file_exists
+{
+    # In theory, this is just -f $filename.  In practice, NFS client caching
+    # may mean that -f $filename does not mean what you think it does.
+    #
+    # Jared's notes.  I originally tried to just use a -f $filename when
+    # waiting for NFS files to come into existence.  But it appears that, at
+    # least under some configurations of NFS, the NFS client (not perl or
+    # something) can cache whether a file exists or not.
+    #
+    # This caching can last for a long time, at least several minutes, perhaps
+    # indefinitely.  (I literally went down the hall and got a lesson on NFS
+    # from the sysamin, and when we came back to my office my "ls" loop was
+    # still running and not seeing the file.)
+    #
+    # For our particular network setup, the file in question was not visible
+    # from fv-hpc, but was visible from the compute nodes.  We used "df" to
+    # investigate which NFS servers the compute nodes and fv-hpc were connected
+    # to for that particular drive, and found that some nodes using the same
+    # server could see the file.  Hence, we concluded it was not a server-side
+    # issue.
+    #
+    # We then did an "ls" in the directory, and suddenly the client got a
+    # refreshed view of the directory and could see the file.  So, it seems
+    # that the client was caching the individual file, but not the directory
+    # list.
+    #
+    # So, to really try to test whether the NFS file exists, we first do an
+    # "ls" which apparently seems to be sufficient to clear the NFS cache for
+    # that directory, and then ask if the file exists.  This seems to be good
+    # enough for our setup.  If it doesn't work for somebody else's setup,
+    # maybe they can figure out a better solution.
+
+    my $filename = shift;
+    my $blah = `ls`; # hit the directory again, to try to get NFS to not cache things
+    return -f $filename;
+
+#    my $output = `test -f '$filename'`;
+#    my $status = $? >> 8;
+#    return $status == 0;
+}
+
+sub wait_for_nfs
+{
+    my $filename = shift;
+    for(my $i = 0; $i < $MAX_NFS_LAG; $i++)
+    {
+	print "NFS Lag?  Waited $i seconds for $filename...\n";
+	sleep(1);
+
+	return 1 if nfs_file_exists($filename);
+    }
+    return 0;
+}
+
+sub usage_error
+{
+    print <<END;
+wait.pl -- Wait for a file to appear over a slow network file system (NFS).
+
+Usage: wait.pl FILENAME
+
+  - Waits up to 100 seconds for FILENAME to appear.
+  - Exit with code 0 as soon as it appears, or with code 1 on timeout.
+  - The timeout can be configured with the environment variable MAX_NFS_LAG.
+
+END
+
+    exit(1);
+}
+
+
diff -Nru acl2-6.2/books/milawa/COPYING acl2-6.3/books/milawa/COPYING
--- acl2-6.2/books/milawa/COPYING	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/COPYING	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,340 @@
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+                       51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff -Nru acl2-6.2/books/milawa/Proofs/clean-proofs.sh acl2-6.3/books/milawa/Proofs/clean-proofs.sh
--- acl2-6.2/books/milawa/Proofs/clean-proofs.sh	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/Proofs/clean-proofs.sh	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,19 @@
+#!/bin/sh
+
+set -e
+
+rm -f *.events
+rm -f utilities/*.*
+rm -f logic/*.*
+rm -f level2/*.*
+rm -f level3/*.*
+rm -f level4/*.*
+rm -f level5/*.*
+rm -f level6/*.*
+rm -f level7/*.*
+rm -f level8/*.*
+rm -f level9/*.*
+rm -f level10/*.*
+rm -f level11/*.*
+rm -f user/*.*
+rm -f milawa-proofs.*
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/Proofs/zip-proofs.sh acl2-6.3/books/milawa/Proofs/zip-proofs.sh
--- acl2-6.2/books/milawa/Proofs/zip-proofs.sh	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/Proofs/zip-proofs.sh	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,50 @@
+#!/bin/sh
+
+# zip-proofs.sh --- run this from the proofs directory after generating all of
+# the proofs to generate the .tar.gz files, .zip files, and so on.
+
+set -e
+
+FILES=""
+FILES="Sources/Proofs/user      Sources/Proofs/user.events   $FILES"
+FILES="Sources/Proofs/level11   Sources/Proofs/level11.events   $FILES"
+FILES="Sources/Proofs/level10   Sources/Proofs/level10.events   $FILES"
+FILES="Sources/Proofs/level9    Sources/Proofs/level9.events    $FILES"
+FILES="Sources/Proofs/level8    Sources/Proofs/level8.events    $FILES"
+FILES="Sources/Proofs/level7    Sources/Proofs/level7.events    $FILES"
+FILES="Sources/Proofs/level6    Sources/Proofs/level6.events    $FILES"
+FILES="Sources/Proofs/level5    Sources/Proofs/level5.events    $FILES"
+FILES="Sources/Proofs/level4    Sources/Proofs/level4.events    $FILES"
+FILES="Sources/Proofs/level3    Sources/Proofs/level3.events    $FILES"
+FILES="Sources/Proofs/level2    Sources/Proofs/level2.events    $FILES"
+FILES="Sources/Proofs/logic     Sources/Proofs/logic.events     $FILES"
+FILES="Sources/Proofs/utilities Sources/Proofs/utilities.events $FILES"
+
+cd /u/jared/Milawa
+
+echo "Making milawa-proofs.tar.gz"
+time tar cf - $FILES | gzip --best -c - > Sources/Proofs/milawa-proofs.tar.gz
+ls -lah Sources/Proofs/milawa-proofs.tar.gz
+
+echo "Making milawa-proofs.tar.bz2"
+time tar cf - $FILES | bzip2 --best > Sources/Proofs/milawa-proofs.tar.bz2
+ls -lah Sources/Proofs/milawa-proofs.tar.bz2
+
+echo "Making milawa-proofs.zip"
+time zip -9 -q -r Sources/Proofs/milawa-proofs.zip $FILES
+ls -lah Sources/Proofs/milawa-proofs.zip
+
+echo "Making milawa-proofs.tar.7z"
+time 7za a -mx9 Sources/Proofs/milawa-proofs.7z $FILES
+ls -lah Sources/Proofs/milawa-proofs.7z
+
+
+echo "All done."
+echo "Summary of archives:"
+
+du -hcs Sources/Proofs/milawa-proofs.tar.gz \
+        Sources/Proofs/milawa-proofs.tar.bz2 \
+        Sources/Proofs/milawa-proofs.7z \
+        Sources/Proofs/milawa-proofs.zip
+
+
diff -Nru acl2-6.2/books/milawa/README acl2-6.3/books/milawa/README
--- acl2-6.2/books/milawa/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/README	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,105 @@
+-------------------------------------------------------------------------------
+
+                               MILAWA README
+
+-------------------------------------------------------------------------------
+
+Milawa is a "self-verifying" theorem prover for an ACL2-like logic, developed
+by Jared Davis for his Ph.D. dissertation.  For information about Milawa, see
+its web site (http://www.cs.utexas.edu/~jared/milawa/Web/).
+
+This directory contains the Milawa source code, which is now part of the ACL2
+Community Books project (https://code.google.com/p/acl2-books/).
+
+-------------------------------------------------------------------------------
+
+                             BUILD INSTRUCTIONS
+
+Milawa is not built during the "make" of the ordinary ACL2 Community Books,
+because building it takes several hours, requires a lot of memory and hard disk
+space, and requires both Clozure Common Lisp (CCL) and ACL2(h).
+
+Instead, to build Milawa, you should:
+
+1. Build CCL and ACL2(h) according to the instructions in:
+       acl2-books/centaur/README.html
+
+2. Then run these commands:
+
+     $ cd acl2-books/milawa/ACL2
+     $ make -j <n>                 # n is how many jobs to run in parallel
+
+    Where <n> is appropriate for your computer, e.g.:
+
+     - As large as possible, but
+     - No more than your number of CPU cores, to avoid excessive
+       task switching overhead.
+     - No more than (Physical_Memory / 4 GB), to avoid death by swapping.
+
+A successful build should result in:
+
+  - Several new ACL2 images in acl2-books/milawa/ACL2/acl2-images/,
+    including one called "user-symmetry"
+
+  - ACL2 certificates (.cert) or "ACL2 Milawa Provisional Certificates"
+    (.mpcert) for files throughout the milawa/ACL2 directory
+
+  - Thousands of proof files throughout the milawa/Proofs directory.
+
+These proof files are the "boostrapping proofs" that can now be checked by the
+Milawa kernel.  There are many options here: Milawa has two kernels:
+
+  - The original kernel, a Common Lisp program that has historically been run
+    successfully on at least CCL, SBCL, CMUCL, and (for the very patient)
+    CLISP, on certain platforms.  In this case, the proof files can be
+    processed directly.
+
+  - The new kernel, either a Common Lisp or Jitawa Lisp program, that can be
+    run on at least CCL, SBCL, and Jitawa (a verified Lisp by Magnus Myreen).
+    In this case, the proof files first need to be further collected and
+    compressed.
+
+Magnus Myreen has used the HOL4 system to prove an unbelievably impressive
+theorem: if you run the simplified Milawa kernel on the Jitawa runtime on an
+64-bit X86 system, it can only accept theorems of formulas that are
+semantically true.  This theorem connects the logical semantics, down through
+the kernel's source code, through the Jitawa Lisp implementation, down to a
+formal HOL model of the x86 machine code!
+
+Since there are so many options for checking the proofs, we do not try to
+explain how to do carry this out in this README.  Instead, see the Milawa web
+site for instructions.
+
+-------------------------------------------------------------------------------
+
+                               FILE GUIDE
+
+Files
+
+  Sources/COPYING
+    -- Obligatory copy of the GNU General Public License
+
+  Sources/milawa.lsp
+    -- The core proof checker (complete and stand-alone), as of my
+       dissertation
+
+  Sources/milawa2.lsp
+    -- Simplified version of milawa.lsp, for use with Magnus's
+       verified Jitawa Lisp runtime
+
+  Sources/report-time.rb
+    -- Tool for seeing which events took longest to process
+
+
+Subdirectories:
+
+  Sources/ACL2/
+    -- Main directory: ACL2 proofs + User Interface + Bootstrapping
+    -- Basically everything you want is here
+
+  Sources/Proofs/
+    -- Proof files that have been generated during the bootstrapping
+       process.  These are the files for our "final checks".
+
+
+-------------------------------------------------------------------------------
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/final-checks.sh acl2-6.3/books/milawa/final-checks.sh
--- acl2-6.2/books/milawa/final-checks.sh	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/final-checks.sh	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,124 @@
+#!/bin/bash
+
+# Final Proof Checking - Jared Davis (jared@cs.utexas.edu)
+
+# This script attempts to perform the final checks on the proofs in your Proofs/
+# directory.  This is done by building a number of Lisp images, one for each
+# subdirectory of Proofs.  It must be run from the Sources directory.
+
+# The script is sort of like a Makefile in that it will only build Lisp images
+# that do not already exist.  So, if you change the contents of the Proofs/
+# directory, you should erase all of the Lisp images in the Sources directory.
+
+set -e
+
+if [ "$#" -ne "2" ]
+then
+    echo "Usage: final-checks.sh <LISPNAME> <IMAGE-EXTENSION>"
+    echo "Where <LISPNAME> is the name of the Lisp to use, e.g., 'acl', 'ccl', etc."
+    echo "Where <IMAGE-EXTENSION> is the extension for the Milawa image"
+    echo ""
+    exit 1
+fi
+
+LISPNAME=$1
+EXT=$2
+
+print_generic_help ()
+{
+    echo "If the reason for this failure is not obvious, please see the instructions"
+    echo "either online at"
+    echo "  - http://www.cs.utexas.edu/users/jared/milawa/Web/checking.html"
+    echo "or, if you installed from Subversion, in the directory"
+    echo "  - Milawa/Web/checking.html"
+    echo ""
+}
+
+if [ ! -e "base.$EXT" ]
+then
+    echo "Error: base.$EXT does not exist."
+    echo ""
+    echo "Possible causes:"
+    echo "  - This is not the right extension for the image you made?"
+    echo "  - You have not yet run (load \"milawa.lsp\") in $LISPNAME?"
+    echo "  - You are not running final-checks.sh from the 'Sources' directory?"
+    echo ""
+    print_generic_help
+    exit 1
+fi
+
+if [ ! -e "milawa-$LISPNAME" ]
+then
+    echo "Error: milawa-$LISPNAME does not exist."
+    echo ""
+    echo "Possible causes:"
+    echo "  - You did not download the milawa-$LISPNAME script yet?"
+    echo "  - You downloaded milawa-$LISPNAME, but it is not in the 'Sources' directory?"
+    echo "  - You are not running final-checks.sh from the 'Sources' directory?"
+    echo ""
+    print_generic_help
+    exit 1
+fi
+
+if [ ! -x "milawa-$LISPNAME" ]
+then
+    echo "Note: making milawa-$LISPNAME executable."
+    chmod +x "milawa-$LISPNAME"
+fi
+
+run_milawa ()
+{
+    CURR=$1   # Current level which is built
+    NEXT=$2   # Next level which is about to be built
+
+    if [ ! -e "$CURR.$EXT" ]
+    then
+	echo "Error: $CURR.$EXT does not exist."
+	echo ""
+	echo "Possible causes:"
+	echo "  - Has someone deleted the file?"
+        echo "  - Has an interrupt been sent, killing the Lisp but not final-checks.sh?"
+	echo "  - Is there a programming error in final-checks.sh?"
+	echo ""
+	exit 1
+    fi
+
+    if [ -e "$NEXT.$EXT" ]
+    then
+       echo "Skipping $NEXT.$EXT since it already exists."
+       return 0
+    fi
+
+    if [ ! -e "Proofs/$NEXT.events" ]
+    then
+	echo "Error: Proofs/$NEXT.events does not exist."
+	echo ""
+	echo "Possible causes:"
+	echo "  - You have not generated/downloaded the proofs for $NEXT yet?"
+	echo "  - The proofs for $NEXT are not in the Sources/Proofs/ directory?"
+	echo ""
+	pring_generic_help
+	exit 1
+    fi
+
+    # Otherwise, everything looks to be set up.
+    echo "Processing $NEXT"
+    { time nice ./milawa-$LISPNAME "$CURR.$EXT" < "Proofs/$NEXT.events"; } \
+       2>&1 | tee $NEXT.$EXT.out
+    echo ""
+}
+
+run_milawa base utilities
+run_milawa utilities logic
+run_milawa logic level2
+run_milawa level2 level3
+run_milawa level3 level4
+run_milawa level4 level5
+run_milawa level5 level6
+run_milawa level6 level7
+run_milawa level7 level8
+run_milawa level8 level9
+run_milawa level9 level10
+run_milawa level10 level11
+run_milawa level11 user
+
diff -Nru acl2-6.2/books/milawa/milawa-acl acl2-6.3/books/milawa/milawa-acl
--- acl2-6.2/books/milawa/milawa-acl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/milawa-acl	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,34 @@
+#!/bin/sh
+
+ALLEGRO="acl"
+
+if [ "$#" -ne "1" ]
+then
+	echo "Usage: milawa-acl <IMAGE-FILE>"
+	echo "Where <IMAGE-FILE> is the name of an Allegro image to use, typically a"
+	echo "\".acl-image\" file, such as \"milawa.acl-image\"."
+	exit 1
+fi
+
+if [ -z "`which $ALLEGRO`" ]
+then
+	echo "Error: Allegro not found."
+	echo ""
+	echo "Possible causes:"
+	echo "  - Allegro Common Lisp is not installed?"
+	echo "  - Allegro is not in your current \$PATH?"
+	echo "  - Allegro is in your path, but is not named '$ALLEGRO'?"
+	echo "  - Allegro is in your path and is named '$ALLEGRO', but is not executable?"
+	echo ""
+	echo "Possible fixes:"
+	echo "  - Add a symlink to Allegro named '$ALLEGRO' somewhere in your \$PATH?"
+	echo "  - Edit the milawa-acl shell script and change ALLEGRO=\"...\" to the name"
+	echo "    of your Allegro executable?"
+	echo "  - Make sure you can start Allegro by typing '$ALLEGRO'"
+	echo ""
+fi
+
+ulimit -s 65535
+exec $ALLEGRO -I $1
+
+
diff -Nru acl2-6.2/books/milawa/milawa-ccl acl2-6.3/books/milawa/milawa-ccl
--- acl2-6.2/books/milawa/milawa-ccl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/milawa-ccl	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+CCL="ccl"
+
+if [ "$#" -ne "1" ]
+then
+	echo "Usage: milawa-ccl <IMAGE-FILE>"
+	echo "Where <IMAGE-FILE> is the name of an CCL image to use, typically a"
+	echo "\".ccl-image\" file, such as \"milawa.ccl-image\"."
+	exit 1
+fi
+
+if [ -z "`which $CCL`" ]
+then
+	echo "Error: CCL not found."
+	echo ""
+	echo "Possible causes:"
+	echo "  - Clozure Common Lisp is not installed?"
+	echo "  - CCL is not in your current \$PATH?"
+	echo "  - CCL is in your path, but is not named '$CCL'?"
+	echo "  - CCL is in your path and is named '$CCL', but is not executable?"
+	echo ""
+	echo "Possible fixes:"
+	echo "  - Add a symlink to CCL named '$CCL' somewhere in your \$PATH?"
+	echo "  - Edit the milawa-ccl shell script and change CCL=\"...\" to the name"
+	echo "    of your CCL executable?"
+	echo "  - Make sure you can start CCL by typing '$CCL'"
+	echo ""
+fi
+
+exec $CCL --batch -I $1
+
diff -Nru acl2-6.2/books/milawa/milawa-clisp acl2-6.3/books/milawa/milawa-clisp
--- acl2-6.2/books/milawa/milawa-clisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/milawa-clisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,33 @@
+#!/bin/sh
+
+CLISP="clisp"
+
+if [ "$#" -ne "1" ]
+then
+	echo "Usage: milawa-clisp <IMAGE-FILE>"
+	echo "Where <IMAGE-FILE> is the name of an CLISP image to use, typically a"
+	echo "\".clisp-image\" file, such as \"milawa.clisp-image\"."
+	exit 1
+fi
+
+if [ -z "`which $CLISP`" ]
+then
+	echo "Error: CLISP not found."
+	echo ""
+	echo "Possible causes:"
+	echo "  - CLISP is not installed?"
+	echo "  - CLISP is not in your current \$PATH?"
+	echo "  - CLISP is in your path, but is not named '$CLISP'?"
+	echo "  - CLISP is in your path and is named '$CLISP', but is not executable?"
+	echo ""
+	echo "Possible fixes:"
+	echo "  - Add a symlink to CLISP named '$CLISP' somewhere in your \$PATH?"
+	echo "  - Edit the milawa-clisp shell script and change CLISP=\"...\" to the name"
+	echo "    of your CLISP executable?"
+	echo "  - Make sure you can start CLISP by typing '$CLISP'"
+	echo ""
+fi
+
+ulimit -s 65535
+exec $CLISP -m 2048MB -M $1
+
diff -Nru acl2-6.2/books/milawa/milawa-cmucl acl2-6.3/books/milawa/milawa-cmucl
--- acl2-6.2/books/milawa/milawa-cmucl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/milawa-cmucl	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,76 @@
+#!/bin/bash
+
+CMUCL="lisp"
+
+if [ "$#" -ne "1" ]
+then
+	echo "Usage: milawa-cmucl <IMAGE-FILE>"
+	echo "Where <IMAGE-FILE> is the name of an CMUCL image to use, typically a"
+	echo "\".cmucl-image\" file, such as \"milawa.cmucl-image\"."
+	exit 1
+fi
+
+if [ -z "`which $CMUCL`" ]
+then
+	echo "Error: CMUCL not found."
+	echo ""
+	echo "Possible causes:"
+	echo "  - CMUCL is not installed?"
+	echo "  - CMUCL is not in your current \$PATH?"
+	echo "  - CMUCL is in your path, but is not named '$CMUCL'?"
+	echo "  - CMUCL is in your path and is named '$CMUCL', but is not executable?"
+	echo ""
+	echo "Possible fixes:"
+	echo "  - Add a symlink to CMUCL named '$CMUCL' somewhere in your \$PATH?"
+	echo "  - Edit the milawa-cmucl shell script and change CMUCL=\"...\" to the name"
+	echo "    of your CMUCL executable?"
+	echo "  - Make sure you can start CMUCL by typing '$CMUCL'"
+	echo ""
+fi
+
+if [ -n "`hostname | grep nemesis`" ]
+then
+    exec $CMUCL -batch -dynamic-space-size 1520 -core $1
+elif [ -n "`hostname | grep lhug`" ]
+then
+    exec $CMUCL -batch -dynamic-space-size 1632 -core $1
+elif [ -n "`hostname | grep jordan`" ]
+then
+    exec $CMUCL -batch -dynamic-space-size 1632 -core $1
+elif [ -n "`hostname | grep moros`" ]
+then
+    exec $CMUCL -batch -dynamic-space-size 1632 -core $1
+elif [ -n "`hostname | grep shadowfax`" ]
+then
+    exec $CMUCL -batch -dynamic-space-size 2800 -core $1
+elif [ -n "`hostname | grep warren`" ]
+then
+    exec $CMUCL -batch -dynamic-space-size 1150 -core $1
+else
+    echo "Error: host not yet configured."
+    echo ""
+    echo "What is this about?"
+    echo "  CMUCL allows the amount of available heap space available to be "
+    echo "  configured via the command-line parameter -dynamic-space-size.  We"
+    echo "  need to know how much space to try to allocate."
+    echo ""
+    echo "How to fix it?"
+    echo "  Before using milawa-cmucl, please determine the appropriate values "
+    echo "  for these parameters on this host, `hostname`.  Then, edit the "
+    echo "  milawa-cmucl script and add a section for your host, which invokes "
+    echo "  cmucl with the proper settings."
+    echo ""
+    echo "How to determine these settings?"
+    echo ""
+    echo "  Just run:"
+    echo "    $CMUCL -dynamic-space-size [N]"
+    echo ""
+    echo "  For your choice of N.  I don't know what the minimums are, "
+    echo "  but probably you want a control-stack of at least 1500.  More "
+    echo "  is better."
+    echo ""
+    echo "  At any rate, if cmucl segfaults right away, then you'll need "
+    echo "  to use a lower setting."
+    echo ""
+fi
+
diff -Nru acl2-6.2/books/milawa/milawa-sbcl acl2-6.3/books/milawa/milawa-sbcl
--- acl2-6.2/books/milawa/milawa-sbcl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/milawa-sbcl	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,77 @@
+#!/bin/sh
+
+SBCL="sbcl"
+
+if [ "$#" -ne "1" ]
+then
+	echo "Usage: milawa-sbcl <IMAGE-FILE>"
+	echo "Where <IMAGE-FILE> is the name of an SBCL image to use, typically a"
+	echo "\".sbcl-image\" file, such as \"milawa.sbcl-image\"."
+	exit 1
+fi
+
+if [ -z "`which $SBCL`" ]
+then
+	echo "Error: SBCL not found."
+	echo ""
+	echo "Possible causes:"
+	echo "  - SBCL is not installed?"
+	echo "  - SBCL is not in your current \$PATH?"
+	echo "  - SBCL is in your path, but is not named '$SBCL'?"
+	echo "  - SBCL is in your path and is named '$SBCL', but is not executable?"
+	echo ""
+	echo "Possible fixes:"
+	echo "  - Add a symlink to SBCL named '$SBCL' somewhere in your \$PATH?"
+	echo "  - Edit the milawa-sbcl shell script and change SBCL=\"...\" to the name"
+	echo "    of your SBCL executable?"
+	echo "  - Make sure you can start SBCL by typing '$SBCL'"
+	echo ""
+fi
+
+if [ -n "`hostname | grep nemesis`" ]
+then
+    exec $SBCL --dynamic-space-size 2048 --control-stack-size 256 --noinform --core $1
+elif [ -n "`hostname | grep moros`" ]
+then
+    exec $SBCL --dynamic-space-size 2048 --control-stack-size 256 --noinform --core $1
+elif [ -n "`hostname | grep jordan`" ]
+then
+    exec $SBCL --dynamic-space-size 2048 --control-stack-size 256 --noinform --core $1
+elif [ -n "`hostname | grep lhug`" ]
+then
+    exec $SBCL --dynamic-space-size 16384 --control-stack-size 1024 --noinform --core $1
+elif [ -n "`hostname | grep shadowfax`" ]
+then
+    exec $SBCL --dynamic-space-size 256 --control-stack-size 1024 --noinform --core $1
+elif [ -n "`hostname | grep warren`" ]
+then
+    exec $SBCL --dynamic-space-size 1800 --control-stack-size 256 --noinform --core $1
+else
+    echo "Error: host not yet configured."
+    echo ""
+    echo "What is this about?"
+    echo "  SBCL allows the amount of available heap and memory space to be "
+    echo "  configured via command-line parameters, --dynamic-space-size (for "
+    echo "  the size of the heap), and --control-stack-size (for the size of "
+    echo "  the control stack."
+    echo ""
+    echo "How to fix it?"
+    echo "  Before using milawa-sbcl, please determine the appropriate values "
+    echo "  for these parameters on this host, `hostname`.  Then, edit the "
+    echo "  milawa-sbcl script and add a section for your host, which invokes "
+    echo "  sbcl with the proper settings."
+    echo ""
+    echo "How to determine these settings?"
+    echo ""
+    echo "  Just run:"
+    echo "    sbcl --dynamic-space-size [N] --control-stack-size [M]"
+    echo ""
+    echo "  For your choice of N and M.  I don't know what the minimums are, "
+    echo "  but probably you want a control-stack of at least 256, and a "
+    echo "  dynamic space size of at least 1500.  More is better."
+    echo ""
+    echo "  At any rate, if sbcl dies with a message about 'cannot allocate "
+    echo "  memory', or says that the dynamic-space-size is too large, you "
+    echo "  will need to lower the settings."
+    echo ""
+fi
diff -Nru acl2-6.2/books/milawa/milawa-scl acl2-6.3/books/milawa/milawa-scl
--- acl2-6.2/books/milawa/milawa-scl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/milawa-scl	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+SCL="scl"
+
+if [ "$#" -ne "1" ]
+then
+	echo "Usage: milawa-scl <IMAGE-FILE>"
+	echo "Where <IMAGE-FILE> is the name of an SCL image to use, typically a"
+	echo "\".scl-image\" file, such as \"milawa.scl-image\"."
+	exit 1
+fi
+
+if [ -z "`which $SCL`" ]
+then
+	echo "Error: Scieneer Common Lisp not found."
+	echo ""
+	echo "Possible causes:"
+	echo "  - SCL is not installed?"
+	echo "  - SCL is not in your current \$PATH?"
+	echo "  - SCL is in your path, but is not named '$SCL'?"
+	echo "  - SCL is in your path and is named '$SCL', but is not executable?"
+	echo ""
+	echo "Possible fixes:"
+	echo "  - Add a symlink to SCL named '$SCL' somewhere in your \$PATH?"
+	echo "  - Edit the milawa-scl shell script and change SCL=\"...\" to the name"
+	echo "    of your SCL executable?"
+	echo "  - Make sure you can start SCL by typing '$SCL'"
+	echo ""
+fi
+
+exec $SCL -core $1
+
diff -Nru acl2-6.2/books/milawa/milawa.lsp acl2-6.3/books/milawa/milawa.lsp
--- acl2-6.2/books/milawa/milawa.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/milawa.lsp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,2007 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+; SPECIAL LISP-SPECIFIC CONFIGURATION
+
+#+allegro
+(progn
+  (defun quit () (exit))              ; "quit" is not defined in allegro
+  (declaim (optimize (debug 0))))
+
+#+clozure
+(progn
+  (setq ccl::*default-control-stack-size* (expt 2 27))
+  (setq ccl::*default-value-stack-size* (expt 2 27))
+  (setq ccl::*default-temp-stack-size* (expt 2 27))
+  (setq ccl::*initial-listener-default-value-stack-size* (expt 2 27))
+  (setq ccl::*initial-listener-default-control-stack-size* (expt 2 27))
+  (setq ccl::*initial-listener-default-temp-stack-size* (expt 2 27))
+  (CCL::egc nil)
+  (CCL::set-lisp-heap-gc-threshold (expt 2 29))
+  (CCL::gc-verbose t t)
+
+  ;; avoid running into bug #622 on save-application
+  (setq ccl::*print-process-whostate* nil))
+
+#+cmucl
+(progn
+  (declaim (optimize (extensions:inhibit-warnings 3) (debug 0) (compilation-speed 0)))
+  (setq extensions:*bytes-consed-between-gcs* (expt 2 29)))
+
+#+sbcl
+(progn
+  ;; SBCL on linux-32 complains about 2^29 being just slightly too big.
+  (setf (sb-ext:bytes-consed-between-gcs) (- (expt 2 29) 10)))
+
+#+scl
+(progn
+  (setf (ext:bytes-consed-between-gcs) (expt 2 29)))
+
+
+; PACKAGE SETUP AND LOGICAL PRIMITIVES
+
+(in-package "CL-USER")
+(declaim (optimize (speed 3) (safety 0) (space 0)))
+
+(defpackage "MILAWA" (:use))
+
+(import '(COMMON-LISP::nil
+          COMMON-LISP::t
+          COMMON-LISP::quote
+          COMMON-LISP::if
+          COMMON-LISP::equal
+          COMMON-LISP::consp
+          COMMON-LISP::cons
+          COMMON-LISP::symbolp
+          COMMON-LISP::let
+          COMMON-LISP::let*
+          COMMON-LISP::list
+          COMMON-LISP::list*
+          COMMON-LISP::and
+          COMMON-LISP::or
+          COMMON-LISP::cond
+          COMMON-LISP::lambda)
+        "MILAWA")
+
+(defconstant milawa-package (find-package "MILAWA"))
+
+
+(defmacro defun-comp (&rest args)
+  `(compile (defun ,@args)))
+
+
+
+
+(defvar *acceptable-object-tbl*)
+(declaim (type hash-table *acceptable-object-tbl*))
+
+(defun-comp aux-acceptable-objectp (x)
+  (or (and (integerp x)
+           (<= 0 x))
+      (and (symbolp x)
+           (equal x (intern (symbol-name x) milawa-package)))
+      (and (consp x)
+           (let ((status (gethash x *acceptable-object-tbl*)))
+             (cond ((eq status t)
+                    t)
+                   ((eq status nil)
+                    (progn (setf (gethash x *acceptable-object-tbl*) 'exploring)
+                           (and (aux-acceptable-objectp (car x))
+                                (aux-acceptable-objectp (cdr x))
+                                (setf (gethash x *acceptable-object-tbl*) t))))
+                   (t
+                    nil))))))
+
+(defun-comp acceptable-objectp (x)
+  (let ((*acceptable-object-tbl* (make-hash-table :test 'eq)))
+    (aux-acceptable-objectp x)))
+
+
+
+
+
+(declaim (inline MILAWA::natp
+                 MILAWA::symbol-<
+                 MILAWA::<
+                 MILAWA::+
+                 MILAWA::-
+                 MILAWA::car
+                 MILAWA::cdr))
+
+(defun-comp MILAWA::natp (x)
+  (integerp x))
+
+(defun-comp MILAWA::symbol-< (x y)
+  (let ((x-fix (if (symbolp x) x nil))
+        (y-fix (if (symbolp y) y nil)))
+    (if (string< (symbol-name x-fix) (symbol-name y-fix))
+        t
+      nil)))
+
+(defun-comp MILAWA::< (x y)
+  (let ((x-fix (if (integerp x) x 0))
+        (y-fix (if (integerp y) y 0)))
+    (< x-fix y-fix)))
+
+(defun-comp MILAWA::+ (x y)
+  (let ((x-fix (if (integerp x) x 0))
+        (y-fix (if (integerp y) y 0)))
+    (+ x-fix y-fix)))
+
+(defun-comp MILAWA::- (x y)
+  (let* ((x-fix (if (integerp x) x 0))
+         (y-fix (if (integerp y) y 0))
+         (ans   (- x-fix y-fix)))
+    (if (< ans 0) 0 ans)))
+
+(defun-comp MILAWA::car (x)
+  (if (consp x) (car x) nil))
+
+(defun-comp MILAWA::cdr (x)
+  (if (consp x) (cdr x) nil))
+
+(defmacro MILAWA::first  (x) `(MILAWA::car ,x))
+(defmacro MILAWA::second (x) `(MILAWA::first (MILAWA::cdr ,x)))
+(defmacro MILAWA::third  (x) `(MILAWA::second (MILAWA::cdr ,x)))
+(defmacro MILAWA::fourth (x) `(MILAWA::third (MILAWA::cdr ,x)))
+(defmacro MILAWA::fifth  (x) `(MILAWA::fourth (MILAWA::cdr ,x)))
+
+
+
+; THE PROOF CHECKER
+
+(defvar *defined-functions-table* nil)
+
+(defun-comp defun-safe-fn (name formals body inlinep)
+  (let ((this-defun (list name formals body inlinep))
+        (prev-defun (assoc name *defined-functions-table*)))
+    (if prev-defun
+        (unless (equal this-defun prev-defun)
+          (error "Attempted redefinition of ~A.~%
+                  Prev: ~A.~%
+                  New: ~A~%"
+                 name prev-defun this-defun))
+      (progn
+        (push this-defun *defined-functions-table*)
+
+        (when inlinep
+          (eval `(declaim (inline ,name))))
+
+        (eval `(compile (defun ,name ,formals
+                          (declare (ignorable ,@formals))
+                          ,body)))
+        ))))
+
+(defmacro defun-safe (name formals body)
+  `(defun-safe-fn ',name ',formals ',body nil))
+
+(defmacro definline-safe (name formals body)
+  `(defun-safe-fn ',name ',formals ',body t))
+
+
+(in-package "MILAWA")
+
+(CL-USER::definline-safe not (x)
+ (if x nil t))
+
+(CL-USER::defun-safe rank (x)
+  (if (consp x)
+      (+ 1
+         (+ (rank (car x))
+            (rank (cdr x))))
+    0))
+
+(CL-USER::defun-safe ord< (x y)
+  (cond ((not (consp x))
+         (if (consp y) t (< x y)))
+        ((not (consp y))
+         nil)
+        ((not (equal (car (car x)) (car (car y))))
+         (ord< (car (car x)) (car (car y))))
+        ((not (equal (cdr (car x)) (cdr (car y))))
+         (< (cdr (car x)) (cdr (car y))))
+        (t
+          (ord< (cdr x) (cdr y)))))
+
+(CL-USER::defun-safe ordp (x)
+  (if (not (consp x))
+      (natp x)
+    (and (consp (car x))
+         (ordp (car (car x)))
+         (not (equal (car (car x)) 0))
+         (< 0 (cdr (car x)))
+         (ordp (cdr x))
+         (if (consp (cdr x))
+             (ord< (car (car (cdr x))) (car (car x)))
+          t))))
+
+
+
+; THE PROOF CHECKER - PRELIMINARIES
+
+(CL-USER::definline-safe nfix (x)
+  (if (natp x)
+      x
+    0))
+
+(CL-USER::definline-safe <= (a b)
+  (not (< b a)))
+
+(CL-USER::definline-safe zp (x)
+  (if (natp x)
+      (equal x 0)
+    t))
+
+(CL-USER::defun-safe true-listp (x)
+  (if (consp x)
+      (true-listp (cdr x))
+    (equal x nil)))
+
+(CL-USER::defun-safe list-fix (x)
+  (if (consp x)
+      (cons (car x) (list-fix (cdr x)))
+    nil))
+
+(CL-USER::defun-safe len (x)
+  (if (consp x)
+      (+ 1 (len (cdr x)))
+    0))
+
+(CL-USER::defun-safe memberp (a x)
+  (if (consp x)
+      (or (equal a (car x))
+          (memberp a (cdr x)))
+    nil))
+
+(CL-USER::defun-safe subsetp (x y)
+  (if (consp x)
+      (and (memberp (car x) y)
+           (subsetp (cdr x) y))
+    t))
+
+(CL-USER::defun-safe uniquep (x)
+  (if (consp x)
+      (and (not (memberp (car x) (cdr x)))
+           (uniquep (cdr x)))
+    t))
+
+(CL-USER::defun-safe app (x y)
+  (if (consp x)
+      (cons (car x) (app (cdr x) y))
+    (list-fix y)))
+
+(CL-USER::defun-safe rev (x)
+  (if (consp x)
+      (app (rev (cdr x)) (list (car x)))
+    nil))
+
+(CL-USER::defun-safe tuplep (n x)
+  (if (zp n)
+      (equal x nil)
+    (and (consp x)
+         (tuplep (- n 1) (cdr x)))))
+
+(CL-USER::defun-safe pair-lists (x y)
+  (if (consp x)
+      (cons (cons (car x) (car y))
+            (pair-lists (cdr x) (cdr y)))
+    nil))
+
+(CL-USER::defun-safe lookup (a x)
+  (if (consp x)
+      (if (equal a (car (car x)))
+          (if (consp (car x))
+              (car x)
+            (cons (car (car x)) (cdr (car x))))
+        (lookup a (cdr x)))
+    nil))
+
+
+
+; THE PROOF CHECKER - TERMS
+
+(CL-USER::definline-safe logic.variablep (x)
+  (and (symbolp x)
+       (not (equal x t))
+       (not (equal x nil))))
+
+(CL-USER::defun-safe logic.variable-listp (x)
+  (if (consp x)
+      (and (logic.variablep (car x))
+           (logic.variable-listp (cdr x)))
+    t))
+
+(CL-USER::definline-safe logic.constantp (x)
+  (and (tuplep 2 x)
+       (equal (first x) 'quote)))
+
+(CL-USER::defun-safe logic.constant-listp (x)
+  (if (consp x)
+      (and (logic.constantp (car x))
+           (logic.constant-listp (cdr x)))
+    t))
+
+(CL-USER::definline-safe logic.function-namep (x)
+  (and (symbolp x)
+       (not (memberp x '(nil quote pequal* pnot*
+                         por* first second third
+                         fourth fifth and or list
+                         cond let let*)))))
+
+(CL-USER::defun-safe logic.flag-term-vars (flag x acc)
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) acc)
+            ((logic.variablep x) (cons x acc))
+            ((not (consp x))     acc)
+            (t
+             (logic.flag-term-vars 'list (cdr x) acc)))
+    (if (consp x)
+        (logic.flag-term-vars 'term (car x)
+         (logic.flag-term-vars 'list (cdr x) acc))
+      acc)))
+
+(CL-USER::definline-safe logic.term-vars (x)
+  (logic.flag-term-vars 'term x nil))
+
+(CL-USER::defun-safe logic.flag-termp (flag x)
+  (if (equal flag 'term)
+      (or (logic.variablep x)
+          (logic.constantp x)
+          (and (consp x)
+               (if (logic.function-namep (car x))
+                   (let ((args (cdr x)))
+                     (and (true-listp args)
+                          (logic.flag-termp 'list args)))
+                 (and (tuplep 3 (car x))
+                      (let ((lambda-symbol (first (car x)))
+                            (formals       (second (car x)))
+                            (body          (third (car x)))
+                            (actuals       (cdr x)))
+                        (and (equal lambda-symbol 'lambda)
+                             (true-listp formals)
+                             (logic.variable-listp formals)
+                             (uniquep formals)
+                             (logic.flag-termp 'term body)
+                             (subsetp (logic.term-vars body) formals)
+                             (equal (len formals) (len actuals))
+                             (true-listp actuals)
+                             (logic.flag-termp 'list actuals)))))))
+    (if (consp x)
+        (and (logic.flag-termp 'term (car x))
+             (logic.flag-termp 'list (cdr x)))
+      t)))
+
+(CL-USER::definline-safe logic.termp (x)
+  (logic.flag-termp 'term x))
+
+(CL-USER::definline-safe logic.unquote (x)
+  (second x))
+
+(CL-USER::defun-safe logic.unquote-list (x)
+  (if (consp x)
+      (cons (logic.unquote (car x))
+            (logic.unquote-list (cdr x)))
+    nil))
+
+(CL-USER::definline-safe logic.functionp (x)
+  (logic.function-namep (car x)))
+
+(CL-USER::definline-safe logic.function-name (x)
+  (car x))
+
+(CL-USER::definline-safe logic.function-args (x)
+  (cdr x))
+
+(CL-USER::definline-safe logic.function (name args)
+  (cons name args))
+
+(CL-USER::definline-safe logic.lambdap (x)
+  (consp (car x)))
+
+(CL-USER::definline-safe logic.lambda-formals (x)
+  (second (car x)))
+
+(CL-USER::definline-safe logic.lambda-body (x)
+  (third (car x)))
+
+(CL-USER::definline-safe logic.lambda-actuals (x)
+  (cdr x))
+
+(CL-USER::definline-safe logic.lambda (xs b ts)
+  (cons (list 'lambda xs b) ts))
+
+(CL-USER::defun-safe logic.flag-term-atblp (flag x atbl)
+  (if (equal flag 'term)
+      (cond ((logic.constantp x) t)
+            ((logic.variablep x) t)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (and (equal (len args) (cdr (lookup name atbl)))
+                    (logic.flag-term-atblp 'list args atbl))))
+            ((logic.lambdap x)
+             (let ((body (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               (and (logic.flag-term-atblp 'term body atbl)
+                    (logic.flag-term-atblp 'list actuals atbl))))
+            (t nil))
+    (if (consp x)
+        (and (logic.flag-term-atblp 'term (car x) atbl)
+             (logic.flag-term-atblp 'list (cdr x) atbl))
+     t)))
+
+(CL-USER::definline-safe logic.term-atblp (x atbl)
+  (logic.flag-term-atblp 'term x atbl))
+
+
+
+; THE PROOF CHECKER - FORMULAS
+
+(CL-USER::defun-safe logic.formulap (x)
+  (cond ((equal (first x) 'pequal*)
+         (and (tuplep 3 x)
+              (logic.termp (second x))
+              (logic.termp (third x))))
+        ((equal (first x) 'pnot*)
+         (and (tuplep 2 x)
+              (logic.formulap (second x))))
+        ((equal (first x) 'por*)
+         (and (tuplep 3 x)
+              (logic.formulap (second x))
+              (logic.formulap (third x))))
+        (t nil)))
+
+(CL-USER::defun-safe logic.formula-listp (x)
+  (if (consp x)
+      (and (logic.formulap (car x))
+           (logic.formula-listp (cdr x)))
+    t))
+
+(CL-USER::definline-safe logic.fmtype (x)
+  (first x))
+
+(CL-USER::definline-safe logic.=lhs (x)
+  (second x))
+
+(CL-USER::definline-safe logic.=rhs (x)
+  (third x))
+
+(CL-USER::definline-safe logic.~arg (x)
+  (second x))
+
+(CL-USER::definline-safe logic.vlhs (x)
+  (second x))
+
+(CL-USER::definline-safe logic.vrhs (x)
+  (third x))
+
+(CL-USER::definline-safe logic.pequal (a b)
+  (list 'pequal* a b))
+
+(CL-USER::definline-safe logic.pnot (a)
+  (list 'pnot* a))
+
+(CL-USER::definline-safe logic.por (a b)
+  (list 'por* a b))
+
+(CL-USER::defun-safe logic.formula-atblp (x atbl)
+  (let ((type (logic.fmtype x)))
+    (cond ((equal type 'por*)
+           (and (logic.formula-atblp (logic.vlhs x) atbl)
+                (logic.formula-atblp (logic.vrhs x) atbl)))
+          ((equal type 'pnot*)
+           (logic.formula-atblp (logic.~arg x) atbl))
+          ((equal type 'pequal*)
+           (and (logic.term-atblp (logic.=lhs x) atbl)
+                (logic.term-atblp (logic.=rhs x) atbl)))
+          (t nil))))
+
+(CL-USER::defun-safe logic.disjoin-formulas (x)
+  (if (consp x)
+      (if (consp (cdr x))
+          (logic.por (car x) (logic.disjoin-formulas (cdr x)))
+        (car x))
+    nil))
+
+
+
+; THE PROOF CHECKER - APPEALS
+
+(CL-USER::defun-safe logic.flag-appealp (flag x)
+  (if (equal flag 'proof)
+      (and (true-listp x)
+           (<= (len x) 4)
+           (symbolp (first x))
+           (logic.formulap (second x))
+           (true-listp (third x))
+           (logic.flag-appealp 'list (third x)))
+    (if (consp x)
+        (and (logic.flag-appealp 'proof (car x))
+             (logic.flag-appealp 'list (cdr x)))
+      t)))
+
+(CL-USER::definline-safe logic.appealp (x)
+  (logic.flag-appealp 'proof x))
+
+(CL-USER::definline-safe logic.appeal-listp (x)
+  (logic.flag-appealp 'list x))
+
+(CL-USER::definline-safe logic.method (x)
+  (first x))
+
+(CL-USER::definline-safe logic.conclusion (x)
+  (second x))
+
+(CL-USER::definline-safe logic.subproofs (x)
+  (third x))
+
+(CL-USER::definline-safe logic.extras (x)
+  (fourth x))
+
+(CL-USER::defun-safe logic.strip-conclusions (x)
+  (if (consp x)
+      (cons (logic.conclusion (car x))
+            (logic.strip-conclusions (cdr x)))
+    nil))
+
+
+
+; THE PROOF CHECKER - STEP CHECKING
+
+(CL-USER::defun-safe logic.axiom-okp (x axioms atbl)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'axiom)
+         (equal subproofs nil)
+         (equal extras nil)
+         (memberp conclusion axioms)
+         (logic.formula-atblp conclusion atbl))))
+
+(CL-USER::defun-safe logic.theorem-okp (x thms atbl)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'theorem)
+         (equal subproofs nil)
+         (equal extras nil)
+         (memberp conclusion thms)
+         (logic.formula-atblp conclusion atbl))))
+
+
+; Basic Rules
+
+(CL-USER::defun-safe logic.associativity-okp (x)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'associativity)
+         (equal extras nil)
+         (tuplep 1 subproofs)
+         (let ((sub-or-a-or-b-c (logic.conclusion (first subproofs))))
+           (and (equal (logic.fmtype conclusion) 'por*)
+                (equal (logic.fmtype sub-or-a-or-b-c) 'por*)
+                (let ((conc-or-a-b (logic.vlhs conclusion))
+                      (conc-c      (logic.vrhs conclusion))
+                      (sub-a       (logic.vlhs sub-or-a-or-b-c))
+                      (sub-or-b-c  (logic.vrhs sub-or-a-or-b-c)))
+                  (and (equal (logic.fmtype conc-or-a-b) 'por*)
+                       (equal (logic.fmtype sub-or-b-c) 'por*)
+                       (let ((conc-a (logic.vlhs conc-or-a-b))
+                             (conc-b (logic.vrhs conc-or-a-b))
+                             (sub-b  (logic.vlhs sub-or-b-c))
+                             (sub-c  (logic.vrhs sub-or-b-c)))
+                         (and (equal conc-a sub-a)
+                              (equal conc-b sub-b)
+                              (equal conc-c sub-c))))))))))
+
+(CL-USER::defun-safe logic.contraction-okp (x)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'contraction)
+         (equal extras nil)
+         (tuplep 1 subproofs)
+         (let ((or-a-a (logic.conclusion (first subproofs))))
+           (and (equal (logic.fmtype or-a-a) 'por*)
+                (equal (logic.vlhs or-a-a) conclusion)
+                (equal (logic.vrhs or-a-a) conclusion))))))
+
+(CL-USER::defun-safe logic.cut-okp (x)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'cut)
+         (equal extras nil)
+         (tuplep 2 subproofs)
+         (let ((or-a-b     (logic.conclusion (first subproofs)))
+               (or-not-a-c (logic.conclusion (second subproofs))))
+             (and (equal (logic.fmtype or-a-b) 'por*)
+                  (equal (logic.fmtype or-not-a-c) 'por*)
+                  (let ((a     (logic.vlhs or-a-b))
+                        (b     (logic.vrhs or-a-b))
+                        (not-a (logic.vlhs or-not-a-c))
+                        (c     (logic.vrhs or-not-a-c)))
+                    (and (equal (logic.fmtype not-a) 'pnot*)
+                         (equal (logic.~arg not-a) a)
+                         (equal (logic.fmtype conclusion) 'por*)
+                         (equal (logic.vlhs conclusion) b)
+                         (equal (logic.vrhs conclusion) c))))))))
+
+(CL-USER::defun-safe logic.expansion-okp (x atbl)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'expansion)
+         (equal extras nil)
+         (tuplep 1 subproofs)
+         (let ((b (logic.conclusion (first subproofs))))
+           (and (equal (logic.fmtype conclusion) 'por*)
+                (equal (logic.vrhs conclusion) b)
+                (logic.formula-atblp (logic.vlhs conclusion) atbl))))))
+
+(CL-USER::defun-safe logic.propositional-schema-okp (x atbl)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'propositional-schema)
+         (equal subproofs nil)
+         (equal extras nil)
+         (equal (logic.fmtype conclusion) 'por*)
+         (let ((not-a (logic.vlhs conclusion))
+               (a     (logic.vrhs conclusion)))
+           (and (equal (logic.fmtype not-a) 'pnot*)
+                (equal (logic.~arg not-a) a)
+                (logic.formula-atblp a atbl))))))
+
+(CL-USER::defun-safe logic.check-functional-axiom (x ti si)
+  (if (equal (logic.fmtype x) 'pequal*)
+      (and (logic.functionp (logic.=lhs x))
+           (logic.functionp (logic.=rhs x))
+           (equal (logic.function-name (logic.=lhs x)) (logic.function-name (logic.=rhs x)))
+           (equal (logic.function-args (logic.=lhs x)) (rev ti))
+           (equal (logic.function-args (logic.=rhs x)) (rev si)))
+    (and (equal (logic.fmtype x) 'por*)
+         (equal (logic.fmtype (logic.vlhs x)) 'pnot*)
+         (equal (logic.fmtype (logic.~arg (logic.vlhs x))) 'pequal*)
+         (logic.check-functional-axiom (logic.vrhs x)
+                                       (cons (logic.=lhs (logic.~arg (logic.vlhs x))) ti)
+                                       (cons (logic.=rhs (logic.~arg (logic.vlhs x))) si)))))
+
+(CL-USER::defun-safe logic.functional-equality-okp (x atbl)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'functional-equality)
+         (equal subproofs nil)
+         (equal extras nil)
+         (logic.check-functional-axiom conclusion nil nil)
+         (logic.formula-atblp conclusion atbl))))
+
+
+; Beta-Reduction, Instantiation
+
+(CL-USER::defun-safe logic.sigmap (x)
+  (if (consp x)
+      (and (consp (car x))
+           (logic.variablep (car (car x)))
+           (logic.termp (cdr (car x)))
+           (logic.sigmap (cdr x)))
+    t))
+
+(CL-USER::defun-safe logic.sigma-listp (x)
+  (if (consp x)
+      (and (logic.sigmap (car x))
+           (logic.sigma-listp (cdr x)))
+    t))
+
+(CL-USER::defun-safe logic.sigma-list-listp (x)
+  (if (consp x)
+      (and (logic.sigma-listp (car x))
+           (logic.sigma-list-listp (cdr x)))
+    t))
+
+(CL-USER::defun-safe logic.flag-substitute (flag x sigma)
+  (if (equal flag 'term)
+      (cond ((logic.variablep x)
+             (if (lookup x sigma)
+                 (cdr (lookup x sigma))
+               x))
+            ((logic.constantp x)
+             x)
+            ((logic.functionp x)
+             (let ((fn   (logic.function-name x))
+                   (args (logic.function-args x)))
+               (logic.function fn (logic.flag-substitute 'list args sigma))))
+            ((logic.lambdap x)
+             (let ((formals (logic.lambda-formals x))
+                   (body    (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               (logic.lambda formals body (logic.flag-substitute 'list actuals sigma))))
+            (t nil))
+    (if (consp x)
+        (cons (logic.flag-substitute 'term (car x) sigma)
+              (logic.flag-substitute 'list (cdr x) sigma))
+     nil)))
+
+(CL-USER::definline-safe logic.substitute (x sigma)
+  (logic.flag-substitute 'term x sigma))
+
+(CL-USER::definline-safe logic.substitute-list (x sigma)
+  (logic.flag-substitute 'list x sigma))
+
+(CL-USER::defun-safe logic.substitute-formula (formula sigma)
+  (let ((type (logic.fmtype formula)))
+    (cond ((equal type 'por*)
+           (logic.por (logic.substitute-formula (logic.vlhs formula) sigma)
+                      (logic.substitute-formula (logic.vrhs formula) sigma)))
+          ((equal type 'pnot*)
+           (logic.pnot (logic.substitute-formula (logic.~arg formula) sigma)))
+          ((equal type 'pequal*)
+           (logic.pequal (logic.substitute (logic.=lhs formula) sigma)
+                         (logic.substitute (logic.=rhs formula) sigma)))
+          (t nil))))
+
+(CL-USER::defun-safe logic.instantiation-okp (x atbl)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'instantiation)
+         (logic.sigmap extras)
+         (tuplep 1 subproofs)
+         (equal (logic.substitute-formula (logic.conclusion (first subproofs)) extras) conclusion)
+         (logic.formula-atblp conclusion atbl))))
+
+(CL-USER::defun-safe logic.beta-reduction-okp (x atbl)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'beta-reduction)
+         (equal subproofs nil)
+         (equal extras nil)
+         (logic.formula-atblp conclusion atbl)
+         (equal (logic.fmtype conclusion) 'pequal*)
+         (let ((lhs (logic.=lhs conclusion))
+               (rhs (logic.=rhs conclusion)))
+           (and (logic.lambdap lhs)
+                (let ((formals (logic.lambda-formals lhs))
+                      (body    (logic.lambda-body lhs))
+                      (actuals (logic.lambda-actuals lhs)))
+                  (equal (logic.substitute body (pair-lists formals actuals)) rhs)))))))
+
+
+; Base Evaluation
+
+(CL-USER::defun-safe logic.initial-arity-table ()
+  '((if . 3)
+    (equal . 2)
+    (consp . 1)
+    (cons . 2)
+    (car . 1)
+    (cdr . 1)
+    (symbolp . 1)
+    (symbol-< . 2)
+    (natp . 1)
+    (< . 2)
+    (+ . 2)
+    (- . 2)))
+
+(CL-USER::defun-safe logic.base-evaluablep (x)
+  (and (logic.functionp x)
+       (let ((fn   (logic.function-name x))
+             (args (logic.function-args x)))
+         (let ((entry (lookup fn (logic.initial-arity-table))))
+           (and entry
+                (logic.constant-listp args)
+                (tuplep (cdr entry) args))))))
+
+(CL-USER::defun-safe logic.base-evaluator (x)
+  (let ((fn   (logic.function-name x))
+        (vals (logic.unquote-list (logic.function-args x))))
+    (list 'quote
+          (cond ((equal fn 'if)
+                 (if (first vals)
+                     (second vals)
+                   (third vals)))
+                ((equal fn 'equal)
+                 (equal (first vals) (second vals)))
+                ((equal fn 'consp)
+                 (consp (first vals)))
+                ((equal fn 'cons)
+                 (cons (first vals) (second vals)))
+                ((equal fn 'car)
+                 (car (first vals)))
+                ((equal fn 'cdr)
+                 (cdr (first vals)))
+                ((equal fn 'symbolp)
+                 (symbolp (first vals)))
+                ((equal fn 'symbol-<)
+                 (symbol-< (first vals) (second vals)))
+                ((equal fn 'natp)
+                 (natp (first vals)))
+                ((equal fn '<)
+                 (< (first vals) (second vals)))
+                ((equal fn '+)
+                 (+ (first vals) (second vals)))
+                ((equal fn '-)
+                 (- (first vals) (second vals)))))))
+
+(CL-USER::defun-safe logic.base-eval-okp (x atbl)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'base-eval)
+         (equal subproofs nil)
+         (equal extras nil)
+         (equal (logic.fmtype conclusion) 'pequal*)
+         (let ((lhs (logic.=lhs conclusion))
+               (rhs (logic.=rhs conclusion)))
+           (and (logic.base-evaluablep lhs)
+                (equal (logic.base-evaluator lhs) rhs)
+                (logic.term-atblp lhs atbl))))))
+
+
+; Induction
+
+(CL-USER::definline-safe logic.make-basis-step (f qs)
+  (logic.disjoin-formulas (cons f qs)))
+
+(CL-USER::defun-safe logic.substitute-each-sigma-into-formula (f x)
+  (if (consp x)
+      (cons (logic.substitute-formula f (car x))
+            (logic.substitute-each-sigma-into-formula f (cdr x)))
+    nil))
+
+(CL-USER::definline-safe logic.make-induction-step (f q-i sigmas-i)
+  (logic.disjoin-formulas
+   (cons f (cons (logic.pnot q-i) (logic.substitute-each-sigma-into-formula (logic.pnot f) sigmas-i)))))
+
+(CL-USER::defun-safe logic.make-induction-steps (f qs all-sigmas)
+  (if (consp qs)
+      (cons (logic.make-induction-step f (car qs) (car all-sigmas))
+            (logic.make-induction-steps f (cdr qs) (cdr all-sigmas)))
+    nil))
+
+(CL-USER::definline-safe logic.make-ordinal-step (m)
+  (logic.pequal (logic.function 'ordp (list m)) ''t))
+
+(CL-USER::definline-safe logic.make-measure-step (m q-i sigma-i-j)
+  (logic.por (logic.pnot q-i)
+             (logic.pequal (logic.function 'ord< (list (logic.substitute m sigma-i-j) m)) ''t)))
+
+(CL-USER::defun-safe logic.make-measure-steps (m q-i sigmas-i)
+  (if (consp sigmas-i)
+      (cons (logic.make-measure-step m q-i (car sigmas-i))
+            (logic.make-measure-steps m q-i (cdr sigmas-i)))
+    nil))
+
+(CL-USER::defun-safe logic.make-all-measure-steps (m qs all-sigmas)
+  (if (consp all-sigmas)
+      (app (logic.make-measure-steps m (car qs) (car all-sigmas))
+           (logic.make-all-measure-steps m (cdr qs) (cdr all-sigmas)))
+    nil))
+
+(CL-USER::defun-safe logic.induction-okp (x)
+  (let ((method     (logic.method x))
+        (conclusion (logic.conclusion x))
+        (subproofs  (logic.subproofs x))
+        (extras     (logic.extras x)))
+    (and (equal method 'induction)
+         (tuplep 3 extras)
+         (let ((m          (first extras))
+               (qs         (second extras))
+               (all-sigmas (third extras))
+               (subconcs   (logic.strip-conclusions subproofs)))
+           (and (logic.termp m)
+                (logic.formula-listp qs)
+                (logic.sigma-list-listp all-sigmas)
+                (equal (len qs) (len all-sigmas))
+                (memberp (logic.make-basis-step conclusion qs) subconcs)
+                (subsetp (logic.make-induction-steps conclusion qs all-sigmas) subconcs)
+                (memberp (logic.make-ordinal-step m) subconcs)
+                (subsetp (logic.make-all-measure-steps m qs all-sigmas) subconcs))))))
+
+
+; Proof Checking
+
+(CL-USER::defun-safe logic.appeal-step-okp (x axioms thms atbl)
+  (let ((how (logic.method x)))
+    (cond ((equal how 'axiom)
+           (logic.axiom-okp x axioms atbl))
+          ((equal how 'theorem)
+           (logic.theorem-okp x thms atbl))
+          ((equal how 'propositional-schema)
+           (logic.propositional-schema-okp x atbl))
+          ((equal how 'functional-equality)
+           (logic.functional-equality-okp x atbl))
+          ((equal how 'beta-reduction)
+           (logic.beta-reduction-okp x atbl))
+          ((equal how 'expansion)
+           (logic.expansion-okp x atbl))
+          ((equal how 'contraction)
+           (logic.contraction-okp x))
+          ((equal how 'associativity)
+           (logic.associativity-okp x))
+          ((equal how 'cut)
+           (logic.cut-okp x))
+          ((equal how 'instantiation)
+           (logic.instantiation-okp x atbl))
+          ((equal how 'induction)
+           (logic.induction-okp x))
+          ((equal how 'base-eval)
+           (logic.base-eval-okp x atbl))
+          (t nil))))
+
+(CL-USER::defun-safe logic.flag-proofp (flag x axioms thms atbl)
+  (if (equal flag 'proof)
+      (and (logic.appeal-step-okp x axioms thms atbl)
+           (logic.flag-proofp 'list (logic.subproofs x) axioms thms atbl))
+    (if (consp x)
+        (and (logic.flag-proofp 'proof (car x) axioms thms atbl)
+             (logic.flag-proofp 'list (cdr x) axioms thms atbl))
+      t)))
+
+(CL-USER::definline-safe logic.proofp (x axioms thms atbl)
+  (logic.flag-proofp 'proof x axioms thms atbl))
+
+(CL-USER::defun-safe logic.provable-witness (x axioms thms atbl)
+  (CL-USER::error "Called witnessing function ~A.~%"
+                  '(logic.provable-witness
+                    proof
+                    (x axioms thms atbl)
+                    (and (logic.appealp proof)
+                         (logic.proofp proof axioms thms atbl)
+                         (equal (logic.conclusion proof) x)))))
+
+(CL-USER::defun-safe logic.provablep (x axioms thms atbl)
+  (let ((proof (logic.provable-witness x axioms thms atbl)))
+    (and (logic.appealp proof)
+         (logic.proofp proof axioms thms atbl)
+         (equal (logic.conclusion proof) x))))
+
+
+
+; SUPPORTING ABBREVIATIONS
+
+(CL-USER::defun-safe remove-all (a x)
+  (if (consp x)
+      (if (equal a (car x))
+          (remove-all a (cdr x))
+        (cons (car x) (remove-all a (cdr x))))
+    nil))
+
+(CL-USER::defun-safe remove-duplicates (x)
+  (if (consp x)
+      (if (memberp (car x) (cdr x))
+          (remove-duplicates (cdr x))
+        (cons (car x) (remove-duplicates (cdr x))))
+    nil))
+
+(CL-USER::defun-safe difference (x y)
+  (if (consp x)
+      (if (memberp (car x) y)
+          (difference (cdr x) y)
+        (cons (car x)
+              (difference (cdr x) y)))
+    nil))
+
+(CL-USER::defun-safe strip-firsts (x)
+  (if (consp x)
+      (cons (first (car x))
+            (strip-firsts (cdr x)))
+      nil))
+
+(CL-USER::defun-safe strip-seconds (x)
+  (if (consp x)
+      (cons (second (car x))
+            (strip-seconds (cdr x)))
+    nil))
+
+(CL-USER::defun-safe tuple-listp (n x)
+  (if (consp x)
+      (and (tuplep n (car x))
+           (tuple-listp n (cdr x)))
+    t))
+
+(CL-USER::defun-safe sort-symbols-insert (a x)
+  (if (consp x)
+      (if (symbol-< a (car x))
+          (cons a x)
+        (cons (car x)
+              (sort-symbols-insert a (cdr x))))
+    (list a)))
+
+(CL-USER::defun-safe sort-symbols (x)
+  (if (consp x)
+      (sort-symbols-insert (car x)
+                           (sort-symbols (cdr x)))
+    nil))
+
+(CL-USER::defun-safe logic.translate-list-term (args)
+  (if (consp args)
+      (logic.function
+       'cons
+       (list (car args)
+             (logic.translate-list-term (cdr args))))
+    ''nil))
+
+
+(CL-USER::defun-safe logic.translate-and-term (args)
+  (if (consp args)
+      (if (consp (cdr args))
+          (logic.function
+           'if
+           (list (first args)
+                 (logic.translate-and-term (cdr args))
+                 ''nil))
+        (first args))
+    ''t))
+
+(CL-USER::defun-safe logic.translate-or-term (args)
+
+; Difference from my dissertation: optimized this for Magnus's lisp, and had
+; to back-port the change.
+
+  (if (consp args)
+      (if (consp (cdr args))
+          (let* ((else-term (logic.translate-or-term (cdr args)))
+                 (cheap-p   (or (logic.variablep (car args))
+                                (logic.constantp (car args)))))
+            (if (or cheap-p
+                    (memberp 'special-var-for-or
+                             (logic.term-vars else-term)))
+                (logic.function 'if (list (car args) (car args) else-term))
+              (logic.translate-let-term
+               (list 'special-var-for-or)
+               (list (car args))
+               (logic.function 'if (list 'special-var-for-or
+                                         'special-var-for-or
+                                         else-term)))))
+        (first args))
+    ''nil))
+
+(CL-USER::defun-safe logic.translate-cond-term (tests thens)
+  (if (consp tests)
+      (let ((test1 (car tests))
+            (then1 (car thens)))
+        (logic.function
+         'if
+         (list test1
+               then1
+               (logic.translate-cond-term (cdr tests)
+                                          (cdr thens)))))
+    ''nil))
+
+(CL-USER::defun-safe logic.translate-let-term (vars terms body)
+  (let* ((body-vars (remove-duplicates (logic.term-vars body)))
+         (id-vars   (sort-symbols (difference body-vars vars)))
+         (formals   (app id-vars vars))
+         (actuals   (app id-vars terms)))
+    (logic.lambda formals body actuals)))
+
+(CL-USER::defun-safe logic.translate-let*-term (vars terms body)
+  (if (consp vars)
+      (logic.translate-let-term
+       (list (car vars))
+       (list (car terms))
+       (logic.translate-let*-term (cdr vars)
+                                  (cdr terms)
+                                  body))
+    body))
+
+(CL-USER::defun-safe logic.flag-translate (flag x)
+  (if (equal flag 'term)
+
+      (cond ((natp x)
+             (list 'quote x))
+
+            ((symbolp x)
+             (if (or (equal x nil)
+                     (equal x t))
+                 (list 'quote x)
+               x))
+
+            ((symbolp (car x))
+             (let ((fn (car x)))
+               (cond ((equal fn 'quote)
+                      (if (tuplep 2 x)
+                          x
+                        nil))
+
+                     ((memberp fn '(first second third fourth fifth))
+                      (and (tuplep 2 x)
+                           (let ((arg (logic.flag-translate 'term (second x))))
+                             (and arg
+                                  (let* ((1cdr (logic.function 'cdr (list arg)))
+                                         (2cdr (logic.function 'cdr (list 1cdr)))
+                                         (3cdr (logic.function 'cdr (list 2cdr)))
+                                         (4cdr (logic.function 'cdr (list 3cdr))))
+                                    (logic.function
+                                     'car
+                                     (list (cond ((equal fn 'first)  arg)
+                                                 ((equal fn 'second) 1cdr)
+                                                 ((equal fn 'third)  2cdr)
+                                                 ((equal fn 'fourth) 3cdr)
+                                                 (t                  4cdr)))))))))
+
+                     ((memberp fn '(and or list))
+                      (and (true-listp (cdr x))
+                           (let ((arguments+ (logic.flag-translate 'list (cdr x))))
+                             (and (car arguments+)
+                                  (cond ((equal fn 'and)
+                                         (logic.translate-and-term (cdr arguments+)))
+                                        ((equal fn 'or)
+                                         (logic.translate-or-term (cdr arguments+)))
+                                        (t
+                                         (logic.translate-list-term (cdr arguments+))))))))
+
+                     ((equal fn 'cond)
+                      (and (true-listp (cdr x))
+                           (tuple-listp 2 (cdr x))
+                           (let* ((tests  (strip-firsts (cdr x)))
+                                  (thens  (strip-seconds (cdr x)))
+                                  (tests+ (logic.flag-translate 'list tests))
+                                  (thens+ (logic.flag-translate 'list thens)))
+                             (and (car tests+)
+                                  (car thens+)
+                                  (logic.translate-cond-term (cdr tests+)
+                                                             (cdr thens+))))))
+
+                     ((memberp fn '(let let*))
+                      (and (tuplep 3 x)
+                           (let ((pairs (second x))
+                                 (body  (logic.flag-translate 'term (third x))))
+                             (and body
+                                  (true-listp pairs)
+                                  (tuple-listp 2 pairs)
+                                  (let* ((vars   (strip-firsts pairs))
+                                         (terms  (strip-seconds pairs))
+                                         (terms+ (logic.flag-translate 'list terms)))
+                                    (and (car terms+)
+                                         (logic.variable-listp vars)
+                                         (cond ((equal fn 'let)
+                                                (and (uniquep vars)
+                                                     (logic.translate-let-term vars
+                                                                               (cdr terms+)
+                                                                               body)))
+                                               (t
+                                                (logic.translate-let*-term vars
+                                                                           (cdr terms+)
+                                                                           body)))))))))
+
+                     ((logic.function-namep fn)
+                      (and (true-listp (cdr x))
+                           (let ((arguments+ (logic.flag-translate 'list (cdr x))))
+                             (and (car arguments+)
+                                  (logic.function fn (cdr arguments+))))))
+
+                     (t
+                      nil))))
+
+
+             ((and (tuplep 3 (car x))
+                   (true-listp (cdr x)))
+              (let* ((lambda-symbol (first (car x)))
+                     (vars          (second (car x)))
+                     (body          (third (car x)))
+                     (new-body      (logic.flag-translate 'term body))
+                     (actuals+      (logic.flag-translate 'list (cdr x))))
+                (and (equal lambda-symbol 'lambda)
+                     (true-listp vars)
+                     (logic.variable-listp vars)
+                     (uniquep vars)
+                     new-body
+                     (subsetp (logic.term-vars new-body) vars)
+                     (car actuals+)
+                     (equal (len vars) (len (cdr actuals+)))
+                     (logic.lambda vars new-body (cdr actuals+)))))
+
+            (t
+             nil))
+
+   (if (consp x)
+       (let ((first (logic.flag-translate 'term (car x)))
+             (rest  (logic.flag-translate 'list (cdr x))))
+         (if (and first (car rest))
+             (cons t (cons first (cdr rest)))
+           (cons nil nil)))
+     (cons t nil))))
+
+
+(CL-USER::definline-safe logic.translate (x)
+  (logic.flag-translate 'term x))
+
+
+
+
+
+; THE HISTORY
+
+(CL-USER::in-package "CL-USER")
+
+(defvar *arity-table* nil)
+(defvar *axioms* nil)
+(defvar *theorems* nil)
+
+(CL-USER::in-package "MILAWA")
+
+(CL-USER::setf CL-USER::*arity-table*
+  (app '((rank . 1)
+         (ordp . 1)
+         (ord< . 2))
+       (logic.initial-arity-table)))
+
+(CL-USER::setf CL-USER::*axioms*
+  (app '(;; reflexivity
+         (pequal* x x)
+
+         ;; equality
+         (por* (pnot* (pequal* x1 y1))
+               (por* (pnot* (pequal* x2 y2))
+                     (por* (pnot* (pequal* x1 x2))
+                           (pequal* y1 y2))))
+
+         ;; t-not-nil
+         (pnot* (pequal* 't 'nil))
+
+         ;; equal-when-same
+         (por* (pnot* (pequal* x y))
+               (pequal* (equal x y) 't))
+
+         ;; equal-when-diff
+         (por* (pequal* x y)
+               (pequal* (equal x y) 'nil))
+
+         ;; if-when-nil
+         (por* (pnot* (pequal* x 'nil))
+               (pequal* (if x y z) z))
+
+         ;; if-when-not-nil
+         (por* (pequal* x 'nil)
+               (pequal* (if x y z) y))
+
+         ;; consp-of-cons
+         (pequal* (consp (cons x y)) 't)
+
+         ;; car-of-cons
+         (pequal* (car (cons x y)) x)
+
+         ;; cdr-of-cons
+         (pequal* (cdr (cons x y)) y)
+
+         ;; consp-nil-or-t
+         (por* (pequal* (consp x) 'nil)
+               (pequal* (consp x) 't))
+
+         ;; car-when-not-consp
+         (por* (pnot* (pequal* (consp x) 'nil))
+               (pequal* (car x) 'nil))
+
+         ;; cdr-when-not-consp
+         (por* (pnot* (pequal* (consp x) 'nil))
+               (pequal* (cdr x) 'nil))
+
+         ;; cons-of-car-and-cdr
+         (por* (pequal* (consp x) 'nil)
+               (pequal* (cons (car x) (cdr x)) x))
+
+         ;; symbolp-nil-or-t
+         (por* (pequal* (symbolp x) 'nil)
+               (pequal* (symbolp x) 't))
+
+         ;; symbol-<-nil-or-t
+         (por* (pequal* (symbol-< x y) 'nil)
+               (pequal* (symbol-< x y) 't))
+
+         ;; irreflexivity-of-symbol-<
+         (pequal* (symbol-< x x) 'nil)
+
+         ;; antisymmetry-of-symbol-<
+         (por* (pequal* (symbol-< x y) 'nil)
+               (pequal* (symbol-< y x) 'nil))
+
+         ;; transitivity-of-symbol-<
+         (por* (pequal* (symbol-< x y) 'nil)
+               (por* (pequal* (symbol-< y z) 'nil)
+                     (pequal* (symbol-< x z) 't)))
+
+         ;; trichotomy-of-symbol-<
+         (por* (pequal* (symbolp x) 'nil)
+               (por* (pequal* (symbolp y) 'nil)
+                     (por* (pequal* (symbol-< x y) 't)
+                           (por* (pequal* (symbol-< y x) 't)
+                                 (pequal* x y)))))
+
+         ;; symbol-<-completion-left
+         (por* (pequal* (symbolp x) 't)
+               (pequal* (symbol-< x y)
+                        (symbol-< 'nil y)))
+
+         ;; symbol-<-completion-right
+         (por* (pequal* (symbolp y) 't)
+               (pequal* (symbol-< x y)
+                        (symbol-< x 'nil)))
+
+         ;; disjoint-symbols-and-naturals
+         (por* (pequal* (symbolp x) 'nil)
+               (pequal* (natp x) 'nil))
+
+         ;; disjoint-symbols-and-conses
+         (por* (pequal* (symbolp x) 'nil)
+               (pequal* (consp x) 'nil))
+
+         ;; disjoint-naturals-and-conses
+         (por* (pequal* (natp x) 'nil)
+               (pequal* (consp x) 'nil))
+
+         ;; natp-nil-or-t
+         (por* (pequal* (natp x) 'nil)
+               (pequal* (natp x) 't))
+
+         ;; natp-of-plus
+         (pequal* (natp (+ a b)) 't)
+
+         ;; commutativity-of-+
+         (pequal* (+ a b) (+ b a))
+
+         ;; associativity-of-+
+         (pequal* (+ (+ a b) c)
+                  (+ a (+ b c)))
+
+         ;; plus-when-not-natp-left
+         (por* (pequal* (natp a) 't)
+               (pequal* (+ a b) (+ '0 b)))
+
+         ;; plus-of-zero-when-natural
+         (por* (pequal* (natp a) 'nil)
+               (pequal* (+ a '0) a))
+
+         ;; <-nil-or-t
+         (por* (pequal* (< x y) 'nil)
+               (pequal* (< x y) 't))
+
+         ;; irreflexivity-of-<
+         (pequal* (< a a) 'nil)
+
+         ;; less-of-zero-right
+         (pequal* (< a '0) 'nil)
+
+         ;; less-of-zero-left-when-natp
+         (por* (pequal* (natp a) 'nil)
+               (pequal* (< '0 a)
+                        (if (equal a '0) 'nil 't)))
+
+         ;; less-completion-left
+         (por* (pequal* (natp a) 't)
+               (pequal* (< a b)
+                        (< '0 b)))
+
+         ;; less-completion-right
+         (por* (pequal* (natp b) 't)
+               (pequal* (< a b)
+                        'nil))
+
+         ;; transitivity-of-<
+         (por* (pequal* (< a b) 'nil)
+               (por* (pequal* (< b c) 'nil)
+                     (pequal* (< a c) 't)))
+
+         ;; trichotomy-of-<-when-natp
+         (por* (pequal* (natp a) 'nil)
+               (por* (pequal* (natp b) 'nil)
+                     (por* (pequal* (< a b) 't)
+                           (por* (pequal* (< b a) 't)
+                                 (pequal* a b)))))
+
+         ;; one-plus-trick
+         (por* (pequal* (< a b) 'nil)
+               (pequal* (< b (+ '1 a)) 'nil))
+
+         ;; natural-less-than-one-is-zero
+         (por* (pequal* (natp a) 'nil)
+               (por* (pequal* (< a '1) 'nil)
+                     (pequal* a '0)))
+
+         ;; less-than-of-plus-and-plus
+         (pequal* (< (+ a b) (+ a c))
+                  (< b c))
+
+         ;; natp-of-minus
+         (pequal* (natp (- a b)) 't)
+
+         ;; minus-when-subtrahend-as-large
+         (por* (pequal* (< b a) 't)
+               (pequal* (- a b) '0))
+
+         ;; minus-cancels-summand-right
+         (pequal* (- (+ a b) b)
+                  (if (natp a) a '0))
+
+         ;; less-of-minus-left
+         (por* (pequal* (< b a) 'nil)
+               (pequal* (< (- a b) c)
+                        (< a (+ b c))))
+
+         ;; less-of-minus-right
+         (pequal* (< a (- b c))
+                  (< (+ a c) b))
+
+         ;; plus-of-minus-right
+         (por* (pequal* (< c b) 'nil)
+               (pequal* (+ a (- b c))
+                        (- (+ a b) c)))
+
+         ;; minus-of-minus-right
+         (por* (pequal* (< c b) 'nil)
+               (pequal* (- a (- b c))
+                        (- (+ a c) b)))
+
+         ;; minus-of-minus-left
+         (pequal* (- (- a b) c)
+                  (- a (+ b c)))
+
+         ;; equal-of-minus-property
+         (por* (pequal* (< b a) 'nil)
+               (pequal* (equal (- a b) c)
+                        (equal a (+ b c))))
+
+         ;; closed-universe
+         (por* (pequal* (natp x) 't)
+               (por* (pequal* (symbolp x) 't)
+                     (pequal* (consp x) 't))))
+
+       (list
+        ;; definition-of-not
+        (logic.pequal '(not x)
+                      (logic.translate '(if x nil t)))
+
+        ;; definition-of-rank
+        (logic.pequal '(rank x)
+                      (logic.translate '(if (consp x)
+                                            (+ 1
+                                               (+ (rank (car x))
+                                                  (rank (cdr x))))
+                                          0)))
+
+        ;; definition-of-ord<
+        (logic.pequal '(ord< x y)
+                      (logic.translate '(cond ((not (consp x))
+                                               (if (consp y)
+                                                   t
+                                                 (< x y)))
+                                              ((not (consp y))
+                                               nil)
+                                              ((not (equal (car (car x))
+                                                           (car (car y))))
+                                               (ord< (car (car x))
+                                                     (car (car y))))
+                                              ((not (equal (cdr (car x))
+                                                           (cdr (car y))))
+                                               (< (cdr (car x))
+                                                  (cdr (car y))))
+                                              (t
+                                               (ord< (cdr x) (cdr y))))))
+
+        ;; definition-of-ordp
+        (logic.pequal '(ordp x)
+                      (logic.translate '(if (not (consp x))
+                                            (natp x)
+                                          (and (consp (car x))
+                                               (ordp (car (car x)))
+                                               (not (equal (car (car x)) 0))
+                                               (< 0 (cdr (car x)))
+                                               (ordp (cdr x))
+                                               (if (consp (cdr x))
+                                                   (ord< (car (car (cdr x)))
+                                                         (car (car x)))
+                                                 t))))))))
+
+
+
+
+; TERMINATION OBLIGATIONS
+
+(CL-USER::in-package "MILAWA")
+
+(CL-USER::defun-safe cons-onto-ranges (a x)
+  (if (consp x)
+      (cons (cons (car (car x))
+                  (cons a (cdr (car x))))
+            (cons-onto-ranges a (cdr x)))
+    nil))
+
+(CL-USER::defun-safe logic.substitute-callmap (x sigma)
+  (if (consp x)
+      (let ((actuals (car (car x)))
+            (rulers  (cdr (car x))))
+        (cons (cons (logic.substitute-list actuals sigma)
+                    (logic.substitute-list rulers sigma))
+              (logic.substitute-callmap (cdr x) sigma)))
+    nil))
+
+(CL-USER::defun-safe logic.flag-callmap (flag f x)
+  (if (equal flag 'term)
+      (cond ((logic.constantp x)
+             nil)
+            ((logic.variablep x)
+             nil)
+            ((logic.functionp x)
+             (let ((name (logic.function-name x))
+                   (args (logic.function-args x)))
+               (cond ((and (equal name 'if)
+                           (equal (len args) 3))
+                      (let ((test-calls
+                             (logic.flag-callmap 'term f (first args)))
+                            (true-calls
+                             (cons-onto-ranges
+                              (first args)
+                              (logic.flag-callmap 'term f (second args))))
+                            (else-calls
+                             (cons-onto-ranges
+                              (logic.function 'not (list (first args)))
+                              (logic.flag-callmap 'term f (third args)))))
+                        (app test-calls (app true-calls else-calls))))
+                     ((equal name f)
+                      (let ((this-call   (cons args nil))
+                            (child-calls (logic.flag-callmap 'list f args)))
+                        (cons this-call child-calls)))
+                     (t
+                      (logic.flag-callmap 'list f args)))))
+            ((logic.lambdap x)
+             (let ((formals (logic.lambda-formals x))
+                   (body    (logic.lambda-body x))
+                   (actuals (logic.lambda-actuals x)))
+               (let ((actuals-calls (logic.flag-callmap 'list f actuals))
+                     (body-calls    (logic.flag-callmap 'term f body))
+                     (sigma         (pair-lists formals actuals)))
+                 (app actuals-calls
+                      (logic.substitute-callmap body-calls sigma))))))
+    (if (consp x)
+        (app (logic.flag-callmap 'term f (car x))
+             (logic.flag-callmap 'list f (cdr x)))
+       nil)))
+
+(CL-USER::definline-safe logic.callmap (f x)
+  (logic.flag-callmap 'term f x))
+
+(CL-USER::defun-safe repeat (a n)
+  (if (zp n)
+      nil
+    (cons a (repeat a (- n 1)))))
+
+(CL-USER::defun-safe logic.pequal-list (x y)
+  (if (and (consp x)
+           (consp y))
+      (cons (logic.pequal (car x) (car y))
+            (logic.pequal-list (cdr x) (cdr y)))
+    nil))
+
+(CL-USER::defun-safe logic.progress-obligation (measure formals actuals rulers)
+  (let* ((sigma    (pair-lists formals actuals))
+         (m/sigma  (logic.substitute measure sigma))
+         (ord-term (logic.function 'ord< (list m/sigma measure))))
+    (logic.disjoin-formulas
+     (cons (logic.pequal ord-term ''t)
+           (logic.pequal-list rulers (repeat ''nil (len rulers)))))))
+
+(CL-USER::defun-safe logic.progress-obligations (measure formals callmap)
+  (if (consp callmap)
+      (let* ((entry   (car callmap))
+             (actuals (car entry))
+             (rulers  (cdr entry)))
+        (cons (logic.progress-obligation measure formals actuals rulers)
+              (logic.progress-obligations measure formals (cdr callmap))))
+    nil))
+
+(CL-USER::defun-safe logic.termination-obligations (name formals body measure)
+   (let ((callmap (logic.callmap name body)))
+     (if callmap
+         (cons (logic.pequal (logic.function 'ordp (list measure)) ''t)
+               (logic.progress-obligations measure formals callmap))
+       nil)))
+
+
+
+; ESTABLISHING PROVABILITY
+
+(CL-USER::in-package "CL-USER")
+
+(defvar *proof-checker* 'MILAWA::logic.proofp)
+
+(defun-comp check-proof (x axioms thms atbl)
+  (funcall *proof-checker* x axioms thms atbl))
+
+(defun-comp check-proof-list (x axioms thms atbl)
+  (if (consp x)
+      (and (check-proof (car x) axioms thms atbl)
+           (check-proof-list (cdr x) axioms thms atbl))
+    t))
+
+(CL-USER::in-package "MILAWA")
+
+(CL-USER::defun-safe logic.fidelity-claim (name)
+  (logic.por
+   '(pequal* (logic.appealp x) 'nil)
+   (logic.por
+    (logic.pequal (logic.function name '(x axioms thms atbl))
+                  ''nil)
+    '(pnot* (pequal* (logic.provablep (logic.conclusion x)
+                                      axioms thms atbl)
+                     'nil)))))
+
+(CL-USER::in-package "CL-USER")
+
+(defun-comp switch-proof-checker (name)
+  (unless (MILAWA::logic.function-namep name)
+    (error "The name is invalid"))
+  (unless (MILAWA::memberp (MILAWA::logic.fidelity-claim name)
+                           *theorems*)
+    (error "The fidelity claim has not been proven"))
+  (setf *proof-checker* name)
+  t)
+
+
+
+
+; READING OBJECTS
+
+(CL-USER::in-package "CL-USER")
+
+(defmacro report-time (message form)
+  `(let* ((start-time (get-internal-real-time))
+          (value      ,form)
+          (stop-time  (get-internal-real-time))
+          (elapsed    (/ (coerce (- stop-time start-time) 'float)
+                         internal-time-units-per-second)))
+     (format t ";; ~A took ~$ seconds~%" ,message elapsed)
+     value))
+
+(defvar *milawa-readtable* (copy-readtable *readtable*))
+(declaim (readtable *milawa-readtable*))
+
+(defvar *milawa-abbreviations-hash-table*)
+(declaim (type hash-table *milawa-abbreviations-hash-table*))
+
+(defun-comp milawa-sharp-equal-reader (stream subchar arg)
+  (declare (ignore subchar))
+  (multiple-value-bind
+   (value presentp)
+   (gethash arg *milawa-abbreviations-hash-table*)
+   (declare (ignore value))
+   (when presentp
+     (error "#~A= is already defined." arg))
+   (let ((object (read stream)))
+     (setf (gethash arg *milawa-abbreviations-hash-table*) object))))
+
+(defun-comp milawa-sharp-sharp-reader (stream subchar arg)
+  (declare (ignore stream subchar))
+  (or (gethash arg *milawa-abbreviations-hash-table*)
+      (error "#~A# used but not defined." arg)))
+
+(let ((*readtable* *milawa-readtable*))
+  (set-dispatch-macro-character #\# #\# #'milawa-sharp-sharp-reader)
+  (set-dispatch-macro-character #\# #\= #'milawa-sharp-equal-reader))
+
+(defconstant unique-cons-for-eof (cons 'unique-cons 'for-eof))
+
+(defun-comp milawa-read-file-aux (stream)
+   (let ((obj (read stream nil unique-cons-for-eof)))
+     (cond ((eq obj unique-cons-for-eof)
+            nil)
+           (t
+            (cons obj (milawa-read-file-aux stream))))))
+
+(defun-comp milawa-read-file (filename)
+  (format t ";; Reading from ~A~%" filename)
+  (report-time "Reading the file"
+    (let* ((*milawa-abbreviations-hash-table* (make-hash-table
+                                               :size 10000
+                                               :rehash-size 100000
+                                               :test 'eql))
+           (*readtable* *milawa-readtable*)
+           (*package* milawa-package)
+           (stream (open filename
+                         :direction :input
+                         :if-does-not-exist :error))
+           (contents (milawa-read-file-aux stream)))
+      (close stream)
+      (if (acceptable-objectp contents)
+          contents
+        (error "unacceptable object encountered")))))
+
+
+
+
+
+; EVENTS
+
+(defun-comp admit-theorem (formula filename)
+  (unless (MILAWA::logic.formulap formula)
+    (error "The conclusion, ~A, is not a formula" formula))
+  (unless (MILAWA::logic.formula-atblp formula *arity-table*)
+    (error "The conclusion, ~A, is not well-formed" formula))
+  #-skip
+  (let ((proof (car (milawa-read-file filename))))
+    (unless (MILAWA::logic.appealp proof)
+      (error "The proof is not a valid appeal"))
+    (unless (equal (MILAWA::logic.conclusion proof) formula)
+      (error "The proof does not have the right conclusion"))
+    (unless (report-time "Checking the proof"
+                         (check-proof proof *axioms* *theorems* *arity-table*))
+      (error "The proof was rejected")))
+  (unless (MILAWA::memberp formula *theorems*)
+    (push formula *theorems*))
+  t)
+
+(defun-comp admit-defun (name formals raw-body raw-measure inlinep filename)
+  (let* ((body      (MILAWA::logic.translate raw-body))
+         (measure   (MILAWA::logic.translate raw-measure))
+         (arity     (MILAWA::len formals))
+         (new-atbl  (cons (cons name arity) *arity-table*)))
+    (unless (MILAWA::logic.function-namep name)
+      (error "The name is invalid"))
+    (unless (MILAWA::logic.variable-listp formals)
+      (error "The formals are not variables"))
+    (unless (MILAWA::uniquep formals)
+      (error "The formals are not unique"))
+    (unless (MILAWA::logic.termp body)
+      (error "The body did not translate to a term"))
+    (unless (MILAWA::logic.termp measure)
+      (error "The measure did not translate to a term"))
+    (unless (MILAWA::subsetp (MILAWA::logic.term-vars body) formals)
+      (error "The body mentions variables besides the formals"))
+    (unless (MILAWA::subsetp (MILAWA::logic.term-vars measure) formals)
+      (error "The measure mentions variables besides the formals"))
+    (unless (MILAWA::logic.term-atblp body new-atbl)
+      (error "The body is not well-formed"))
+    (unless (MILAWA::logic.term-atblp measure new-atbl)
+      (error "The measure is not well-formed"))
+    #-skip
+    (let ((obligations (MILAWA::logic.termination-obligations
+                        name formals body measure))
+          (proofs (car (milawa-read-file filename))))
+      (unless (MILAWA::logic.appeal-listp proofs)
+        (error "The proofs are not a list of appeals"))
+      (unless (equal (MILAWA::logic.strip-conclusions proofs) obligations)
+        (error "The proofs have the wrong conclusions"))
+      (unless (report-time "Checking the proofs"
+                           (check-proof-list proofs *axioms* *theorems* new-atbl))
+        (error "A proof was rejected")))
+    (defun-safe-fn name formals raw-body inlinep)
+    (unless (MILAWA::lookup name *arity-table*)
+      (push (cons name arity) *arity-table*))
+    (let ((new-axiom (MILAWA::logic.pequal (MILAWA::logic.function name formals)
+                                           body)))
+      (unless (MILAWA::memberp new-axiom *axioms*)
+        (push new-axiom *axioms*))))
+  t)
+
+(defun-comp admit-witness (name bound-var free-vars raw-body)
+  (let* ((body     (MILAWA::logic.translate raw-body))
+         (all-vars (cons bound-var free-vars)))
+    (unless (MILAWA::logic.function-namep name)
+      (error "Invalid function name"))
+    (unless (MILAWA::logic.variablep bound-var)
+      (error "The bound-var is not a variable"))
+    (unless (MILAWA::logic.variable-listp free-vars)
+      (error "The free-vars are not variables"))
+    (unless (MILAWA::uniquep (cons bound-var free-vars))
+      (error "The variables are not unique"))
+    (unless (MILAWA::logic.termp body)
+      (error "The body did not translate to a term"))
+    (unless (MILAWA::subsetp (MILAWA::logic.term-vars body) all-vars)
+      (error "The body's variables are not legal"))
+    (unless (MILAWA::logic.term-atblp body *arity-table*)
+      (error "The body is not well-formed"))
+    (defun-safe-fn name free-vars
+      `(CL-USER::error "Called witnessing function ~A.~%"
+                       '(,name ,bound-var ,free-vars ,raw-body))
+      nil)
+    (unless (MILAWA::lookup name *arity-table*)
+      (push (cons name (MILAWA::len free-vars)) *arity-table*))
+    (let ((new-axiom
+           (MILAWA::logic.por
+            (MILAWA::logic.pequal body ''nil)
+            (MILAWA::logic.pnot
+             (MILAWA::logic.pequal
+              (MILAWA::logic.lambda
+               all-vars body
+               (cons (MILAWA::logic.function name free-vars)
+                     free-vars))
+              ''nil)))))
+      (unless (MILAWA::memberp new-axiom *axioms*)
+        (push new-axiom *axioms*))))
+  t)
+
+
+; CHECKPOINTING
+
+(defun-comp save-and-exit (filename)
+
+  #+allegro
+  (progn
+    (setq EXCL::*restart-init-function* 'main)
+    (EXCL::dumplisp :name (concatenate 'string filename "." image-extension))
+    (quit))
+
+  #+clozure
+  (CCL::save-application (concatenate 'string filename "." image-extension)
+                         :toplevel-function #'main
+                         :purify t)
+
+  #+clisp
+  (progn
+    (EXT:saveinitmem (concatenate 'string filename "." image-extension)
+                     :init-function #'main)
+    (quit))
+
+  #+cmu
+  (EXTENSIONS::save-lisp (concatenate 'string filename "." image-extension)
+                         :init-function #'main
+                         :purify t
+                         )
+
+  #+sbcl
+  (SB-EXT:save-lisp-and-die (concatenate 'string filename "." image-extension)
+                            :toplevel #'main
+                            :purify t)
+
+  #+scl
+  (ext:save-lisp (concatenate 'string filename "." image-extension)
+                 :init-function #'main
+                 :gc :full
+                 :purify t)
+
+  ;; handler for other lisps
+  (error "implement save-and-exit on this lisp"))
+
+
+; THE COMMAND LOOP
+
+(defun-comp safe-tuplep (n x)
+  (if (= n 0)
+      (not x)
+    (and (consp x)
+         (safe-tuplep (- n 1) (cdr x)))))
+
+(defvar *event-number* 1)
+
+(defun-comp try-to-accept-command (cmd)
+  (cond ((not (consp cmd))
+         (error "Invalid command ~A.~%" cmd))
+
+        ((eq (car cmd) 'MILAWA::verify)
+         (unless (and (safe-tuplep 4 cmd)
+                      (let ((name     (second cmd))
+                            (formula  (third cmd))
+                            (filename (fourth cmd)))
+                        (format t "~A> VERIFY ~A~%" *event-number* name)
+                        (report-time "VERIFY"
+                                     (and (acceptable-objectp name)
+                                          (acceptable-objectp formula)
+                                          (stringp filename)
+                                          (admit-theorem formula filename)))))
+           (error "Invalid VERIFY: ~A" cmd)))
+
+        ((eq (car cmd) 'MILAWA::DEFINE)
+         (unless (and (safe-tuplep 7 cmd)
+                      (let ((name     (second cmd))
+                            (formals  (third cmd))
+                            (body     (fourth cmd))
+                            (measure  (fifth cmd))
+                            (inlinep  (sixth cmd))
+                            (filename (seventh cmd)))
+                        (format t "~A> DEFINE ~A~%" *event-number* name)
+                        (report-time "DEFINE"
+                                     (and (acceptable-objectp name)
+                                          (acceptable-objectp formals)
+                                          (acceptable-objectp body)
+                                          (acceptable-objectp measure)
+                                          (stringp filename)
+                                          (admit-defun name formals body measure inlinep filename)))))
+           (error "Invalid DEFINE: ~A" cmd)))
+
+        ((eq (car cmd) 'MILAWA::SKOLEM)
+         (unless (and (safe-tuplep 5 cmd)
+                      (let ((name      (second cmd))
+                            (bound-var (third cmd))
+                            (free-vars (fourth cmd))
+                            (body      (fifth cmd)))
+                        (format t "~A> SKOLEM ~A~%" *event-number* name)
+                        (report-time "SKOLEM"
+                                     (and (acceptable-objectp name)
+                                          (acceptable-objectp bound-var)
+                                          (acceptable-objectp free-vars)
+                                          (acceptable-objectp body)
+                                          (admit-witness name bound-var free-vars body)))))
+           (error "Invalid SKOLEM: ~A" cmd)))
+
+        ((eq (car cmd) 'MILAWA::SWITCH)
+         (unless (and (safe-tuplep 2 cmd)
+                      (let ((name (second cmd)))
+                        (format t "~A > SWITCH ~A~%" *event-number* name)
+                        (report-time "SWITCH"
+                                     (switch-proof-checker name))))
+           (error "Invalid SWITCH: ~A" cmd)))
+
+        ((eq (car cmd) 'MILAWA::FINISH)
+         (unless (and (safe-tuplep 2 cmd)
+                      (let ((filename (second cmd)))
+                        (format t "~A > FINISH ~A~%" *event-number* filename)
+                        (and (stringp filename)
+                             (save-and-exit filename))))
+           (error "Invalid FINISH: ~A" cmd)))
+
+        (t
+         (error "Invalid command: ~A" cmd))))
+
+(defun-comp try-to-accept-all-commands ()
+  (let* ((*package* milawa-package)
+         (cmd       (read *standard-input* nil unique-cons-for-eof)))
+    (when (eq cmd unique-cons-for-eof)
+      (format t "All commands have been accepted.~%")
+      (quit))
+    (try-to-accept-command cmd)
+    (incf *event-number*))
+
+  ;; CMUCL does not like to tail-call optimize when a special has been bound,
+  ;; so keep this tail call outside of the let binding for *package*.
+
+  ;; Apparently Allegro does the same?
+  (try-to-accept-all-commands))
+
+(defun-comp main ()
+  (format t "Milawa Proof Checker.~%")
+
+  #+allegro
+  (SYSTEM::set-stack-cushion nil)
+
+  (try-to-accept-all-commands))
+
+(save-and-exit "base")
+
+
+
diff -Nru acl2-6.2/books/milawa/milawa2.lsp acl2-6.3/books/milawa/milawa2.lsp
--- acl2-6.2/books/milawa/milawa2.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/milawa2.lsp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,2003 @@
+; launch ccl
+; (load "milawa2.lisp")
+; -- should produce 'milawa2'
+; then, ccl -I [path to milawa2]
+;  in the same directory as full.events
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;           __    __        __    __                                        ;;
+;;          /  \  /  \      (__)  |  |    ____   ___      __    ____         ;;
+;;         /    \/    \      __   |  |   / _  |  \  \ __ /  /  / _  |        ;;
+;;        /  /\    /\  \    |  |  |  |  / / | |   \  '  '  /  / / | |        ;;
+;;       /  /  \__/  \  \   |  |  |  |  \ \_| |    \  /\  /   \ \_| |        ;;
+;;      /__/          \__\  |__|  |__|   \____|     \/  \/     \____|        ;;
+;; ~ ~~ \  ~ ~  ~_~~ ~/~ /~ | ~|~ | ~| ~ /~_ ~|~ ~  ~\  ~\~ ~  ~ ~  |~~    ~ ;;
+;;  ~ ~  \~ \~ / ~\~ / ~/ ~ |~ | ~|  ~ ~/~/ | |~ ~~/ ~\/ ~~ ~ / / | |~   ~   ;;
+;; ~ ~  ~ \ ~\/ ~  \~ ~/ ~~ ~__|  |~ ~  ~ \_~  ~  ~  .__~ ~\ ~\ ~_| ~  ~ ~~  ;;
+;;  ~~ ~  ~\  ~ /~ ~  ~ ~  ~ __~  |  ~ ~ \~__~| ~/__~   ~\__~ ~~___~| ~ ~    ;;
+;; ~  ~~ ~  \~_/  ~_~/ ~ ~ ~(__~ ~|~_| ~  ~  ~~  ~  ~ ~~    ~  ~   ~~  ~  ~  ;;
+;;                                                                           ;;
+;;            A   R e f l e c t i v e   P r o o f   C h e c k e r            ;;
+;;                                                                           ;;
+;;       Copyright (C) 2005-2009 by Jared Davis <jared@cs.utexas.edu>        ;;
+;;                                                                           ;;
+;; This program is free software; you can redistribute it and/or modify it   ;;
+;; under the terms of the GNU General Public License as published by the     ;;
+;; Free Software Foundation; either version 2 of the License, or (at your    ;;
+;; option) any later version.                                                ;;
+;;                                                                           ;;
+;; This program is distributed in the hope that it will be useful, but       ;;
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABIL-  ;;
+;; ITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public      ;;
+;; License for more details.                                                 ;;
+;;                                                                           ;;
+;; You should have received a copy of the GNU General Public License along   ;;
+;; with this program (see the file COPYING); if not, write to the Free       ;;
+;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA    ;;
+;; 02110-1301, USA.                                                          ;;
+;;                                                                           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; INITIAL SETUP OF THE MILAWA PACKAGE
+
+(in-package "CL-USER")
+(declaim (optimize (speed 3) (space 0) (safety 0)))
+
+#+clozure
+(progn
+  (setq ccl::*default-control-stack-size* (expt 2 27))
+  (setq ccl::*default-value-stack-size* (expt 2 27))
+  (setq ccl::*default-temp-stack-size* (expt 2 27))
+  (setq ccl::*initial-listener-default-value-stack-size* (expt 2 27))
+  (setq ccl::*initial-listener-default-control-stack-size* (expt 2 27))
+  (setq ccl::*initial-listener-default-temp-stack-size* (expt 2 27))
+  (CCL::egc nil)
+  (CCL::set-lisp-heap-gc-threshold (expt 2 34))
+  (CCL::gc-verbose t t))
+
+(defmacro defun-comp (&rest args)
+  `(compile (defun ,@args)))
+
+(defpackage "MILAWA" (:use))
+
+(import '(COMMON-LISP::nil
+          COMMON-LISP::t
+          COMMON-LISP::quote
+          COMMON-LISP::if
+          COMMON-LISP::equal
+          COMMON-LISP::consp
+          COMMON-LISP::cons
+          COMMON-LISP::symbolp
+          COMMON-LISP::let
+          COMMON-LISP::let*
+          COMMON-LISP::list
+          COMMON-LISP::and
+          COMMON-LISP::or
+          COMMON-LISP::cond
+          COMMON-LISP::lambda)
+        "MILAWA")
+
+(defun-comp MILAWA::natp (x)
+  (integerp x))
+
+(defun-comp MILAWA::symbol-< (x y)
+  (let ((x-fix (if (symbolp x) x nil))
+        (y-fix (if (symbolp y) y nil)))
+    (if (string< (symbol-name x-fix) (symbol-name y-fix))
+        t
+      nil)))
+
+(defun-comp MILAWA::< (x y)
+  (let ((x-fix (if (integerp x) x 0))
+        (y-fix (if (integerp y) y 0)))
+    (< x-fix y-fix)))
+
+(defun-comp MILAWA::+ (x y)
+  (let* ((x-fix (if (integerp x) x 0))
+         (y-fix (if (integerp y) y 0))
+         (ret   (+ x-fix y-fix)))
+    (if (< ret 1073741824)
+        ret
+      (progn
+        (error "Overflow in +.")
+        (quit)))))
+
+(defun-comp MILAWA::- (x y)
+  (let* ((x-fix (if (integerp x) x 0))
+         (y-fix (if (integerp y) y 0))
+         (ans   (- x-fix y-fix)))
+    (if (< ans 0) 0 ans)))
+
+(defun-comp MILAWA::car (x)
+  (if (consp x) (car x) nil))
+
+(defun-comp MILAWA::cdr (x)
+  (if (consp x) (cdr x) nil))
+
+(defmacro MILAWA::first  (x) `(MILAWA::car ,x))
+(defmacro MILAWA::second (x) `(MILAWA::first  (MILAWA::cdr ,x)))
+(defmacro MILAWA::third  (x) `(MILAWA::second (MILAWA::cdr ,x)))
+(defmacro MILAWA::fourth (x) `(MILAWA::third  (MILAWA::cdr ,x)))
+(defmacro MILAWA::fifth  (x) `(MILAWA::fourth (MILAWA::cdr ,x)))
+
+
+; SAFE DEFINITION MECHANISM
+
+(defun-comp MILAWA::define (name formals body)
+  ;; Define a function in Raw Lisp.
+  (eval `(compile (defun ,name ,formals
+                    (declare (ignorable ,@formals))
+                    ,body))))
+
+(defun-comp MILAWA::error (description)
+  ;; Abort execution with a run-time error
+  (error "Milawa::error called: ~a" description)
+  (quit))
+
+(defun-comp MILAWA::print (obj)
+  (format t "~a~%" obj)
+  (finish-output)
+  nil)
+
+(in-package "MILAWA")
+
+(define 'lookup '(a x)
+  '(if (consp x)
+       (if (equal a (car (car x)))
+           (if (consp (car x))
+               (car x)
+             (cons (car (car x)) (cdr (car x))))
+         (lookup a (cdr x)))
+     nil))
+
+(define 'define-safe '(ftbl name formals body)
+  ;; Returns FTBL-PRIME or causes an error.
+  '(let ((this-def (list name formals body))
+         (prev-def (lookup name ftbl)))
+     (if prev-def
+         (if (equal prev-def this-def)
+             ftbl
+           (error (list 'redefinition-error prev-def this-def)))
+       (let ((unused (define name formals body)))
+         (cons this-def ftbl)))))
+
+(define 'define-safe-list '(ftbl defs)
+  ;; DEFS are 3-tuples of the form: (name formals body)
+  ;; We define all of these functions, in order.
+  ;; We return FTBL-PRIME or causes an error.
+  '(if (consp defs)
+       (let* ((def1 (car defs))
+              (ftbl (define-safe ftbl (first def1) (second def1) (third def1))))
+         (define-safe-list ftbl (cdr defs)))
+     ftbl))
+
+(define 'milawa-init '()
+  '(define-safe-list
+
+; We start with "ill-formed" definitions for any functions we don't want the
+; user to be able to redefine.  This list includes (1) all of the primitive
+; Milawa functions like IF, EQUAL, etc., and (2) any built-in system functions
+; that the Lisp relies upon.
+;
+; The point of this is to ensure that any attempt by the user to define any of
+; these functions will fail.  No matter what formals and body they try to use,
+; the resulting call of DEFUN-SAFE will insist that (F FORMALS BODY) is in the
+; FTBL, but the actual entry is just (F).
+
+     '(;; Milawa Primitives
+       (if)
+       (equal)
+       (symbolp)
+       (symbol-<)
+       (natp)
+       (<)
+       (+)
+       (-)
+       (consp)
+       (cons)
+       (car)
+       (cdr)
+
+       ;; Extralogical System Functions
+       (error)
+       (print)
+       (define)
+       (define-safe)
+       (define-safe-list)
+       (milawa-init)
+       (milawa-main))
+
+; We now extend the above FTBL wth definitions for all of the functions for our
+; proof-checking system.  Note that the act of defining these functions does
+; not "admit" them and add definitional axioms, but instead merely (1)
+; introduces Lisp definitions of these functions and (2) installs FTBL entries
+; for these functions so that the user may not define them in any other way.
+
+     '((not (x) (if x nil t))
+
+       (rank (x)
+             (if (consp x)
+                 (+ 1
+                    (+ (rank (car x))
+                       (rank (cdr x))))
+               0))
+
+       (ord< (x y)
+             (cond ((not (consp x))
+                    (if (consp y) t (< x y)))
+                   ((not (consp y))
+                    nil)
+                   ((not (equal (car (car x)) (car (car y))))
+                    (ord< (car (car x)) (car (car y))))
+                   ((not (equal (cdr (car x)) (cdr (car y))))
+                    (< (cdr (car x)) (cdr (car y))))
+                   (t
+                    (ord< (cdr x) (cdr y)))))
+
+       (ordp (x)
+             (if (not (consp x))
+                 (natp x)
+               (and (consp (car x))
+                    (ordp (car (car x)))
+                    (not (equal (car (car x)) 0))
+                    (< 0 (cdr (car x)))
+                    (ordp (cdr x))
+                    (if (consp (cdr x))
+                        (ord< (car (car (cdr x))) (car (car x)))
+                      t))))
+
+       (nfix (x) (if (natp x) x 0))
+
+       (<= (a b) (not (< b a)))
+
+       (zp (x) (if (natp x) (equal x 0) t))
+
+       (true-listp (x)
+                   (if (consp x)
+                       (true-listp (cdr x))
+                     (equal x nil)))
+
+       (list-fix (x)
+                 (if (consp x)
+                     (cons (car x) (list-fix (cdr x)))
+                   nil))
+
+       (len (x)
+            (if (consp x)
+                (+ 1 (len (cdr x)))
+              0))
+
+       (memberp (a x)
+                (if (consp x)
+                    (or (equal a (car x))
+                        (memberp a (cdr x)))
+                  nil))
+
+       (subsetp (x y)
+                (if (consp x)
+                    (and (memberp (car x) y)
+                         (subsetp (cdr x) y))
+                  t))
+
+       (uniquep (x)
+                (if (consp x)
+                    (and (not (memberp (car x) (cdr x)))
+                         (uniquep (cdr x)))
+                  t))
+
+       (app (x y)
+            (if (consp x)
+                (cons (car x) (app (cdr x) y))
+              (list-fix y)))
+
+       (rev (x)
+            (if (consp x)
+                (app (rev (cdr x)) (list (car x)))
+              nil))
+
+       (tuplep (n x)
+               (if (zp n)
+                   (equal x nil)
+                 (and (consp x)
+                      (tuplep (- n 1) (cdr x)))))
+
+       (pair-lists (x y)
+                   (if (consp x)
+                       (cons (cons (car x) (car y))
+                             (pair-lists (cdr x) (cdr y)))
+                     nil))
+
+       (lookup (a x)
+               (if (consp x)
+                   (if (equal a (car (car x)))
+                       (if (consp (car x))
+                           (car x)
+                         (cons (car (car x)) (cdr (car x))))
+                     (lookup a (cdr x)))
+                 nil))
+
+       ;; THE PROOF CHECKER - TERMS
+
+       (logic.variablep (x)
+                        (and (symbolp x)
+                             (not (equal x t))
+                             (not (equal x nil))))
+
+       (logic.variable-listp (x)
+                             (if (consp x)
+                                 (and (logic.variablep (car x))
+                                      (logic.variable-listp (cdr x)))
+                               t))
+
+       (logic.constantp (x)
+                        (and (tuplep 2 x)
+                             (equal (first x) 'quote)))
+
+       (logic.constant-listp (x)
+                             (if (consp x)
+                                 (and (logic.constantp (car x))
+                                      (logic.constant-listp (cdr x)))
+                               t))
+
+       (logic.function-namep
+        (x)
+        (and (symbolp x)
+             (not (memberp x '(nil quote pequal* pnot*
+                                   por* first second third
+                                   fourth fifth and or list
+                                   cond let let*)))))
+
+       (logic.flag-term-vars
+        (flag x acc)
+        (if (equal flag 'term)
+            (cond ((logic.constantp x) acc)
+                  ((logic.variablep x) (cons x acc))
+                  ((not (consp x))     acc)
+                  (t
+                   (logic.flag-term-vars 'list (cdr x) acc)))
+          (if (consp x)
+              (logic.flag-term-vars 'term (car x)
+                                    (logic.flag-term-vars 'list (cdr x) acc))
+            acc)))
+
+       (logic.term-vars (x) (logic.flag-term-vars 'term x nil))
+
+       (logic.flag-termp
+        (flag x)
+        (if (equal flag 'term)
+            (or (logic.variablep x)
+                (logic.constantp x)
+                (and (consp x)
+                     (if (logic.function-namep (car x))
+                         (let ((args (cdr x)))
+                           (and (true-listp args)
+                                (logic.flag-termp 'list args)))
+                       (and (tuplep 3 (car x))
+                            (let ((lambda-symbol (first (car x)))
+                                  (formals       (second (car x)))
+                                  (body          (third (car x)))
+                                  (actuals       (cdr x)))
+                              (and (equal lambda-symbol 'lambda)
+                                   (true-listp formals)
+                                   (logic.variable-listp formals)
+                                   (uniquep formals)
+                                   (logic.flag-termp 'term body)
+                                   (subsetp (logic.term-vars body) formals)
+                                   (equal (len formals) (len actuals))
+                                   (true-listp actuals)
+                                   (logic.flag-termp 'list actuals)))))))
+          (if (consp x)
+              (and (logic.flag-termp 'term (car x))
+                   (logic.flag-termp 'list (cdr x)))
+            t)))
+
+       (logic.termp (x) (logic.flag-termp 'term x))
+
+       (logic.unquote (x) (second x))
+
+       (logic.unquote-list (x)
+                           (if (consp x)
+                               (cons (logic.unquote (car x))
+                                     (logic.unquote-list (cdr x)))
+                             nil))
+
+       (logic.functionp (x) (logic.function-namep (car x)))
+       (logic.function-name (x) (car x))
+       (logic.function-args (x) (cdr x))
+       (logic.function (name args) (cons name args))
+
+       (logic.lambdap (x) (consp (car x)))
+       (logic.lambda-formals (x) (second (car x)))
+       (logic.lambda-body    (x) (third (car x)))
+       (logic.lambda-actuals (x) (cdr x))
+       (logic.lambda (xs b ts) (cons (list 'lambda xs b) ts))
+
+       (logic.flag-term-atblp
+        (flag x atbl)
+        (if (equal flag 'term)
+            (cond ((logic.constantp x) t)
+                  ((logic.variablep x) t)
+                  ((logic.functionp x)
+                   (let ((name (logic.function-name x))
+                         (args (logic.function-args x)))
+                     (and (equal (len args) (cdr (lookup name atbl)))
+                          (logic.flag-term-atblp 'list args atbl))))
+                  ((logic.lambdap x)
+                   (let ((body (logic.lambda-body x))
+                         (actuals (logic.lambda-actuals x)))
+                     (and (logic.flag-term-atblp 'term body atbl)
+                          (logic.flag-term-atblp 'list actuals atbl))))
+                  (t nil))
+          (if (consp x)
+              (and (logic.flag-term-atblp 'term (car x) atbl)
+                   (logic.flag-term-atblp 'list (cdr x) atbl))
+            t)))
+
+       (logic.term-atblp (x atbl)
+                         (logic.flag-term-atblp 'term x atbl))
+
+
+       ;; THE PROOF CHECKER - FORMULAS
+
+       (logic.formulap (x)
+                       (cond ((equal (first x) 'pequal*)
+                              (and (tuplep 3 x)
+                                   (logic.termp (second x))
+                                   (logic.termp (third x))))
+                             ((equal (first x) 'pnot*)
+                              (and (tuplep 2 x)
+                                   (logic.formulap (second x))))
+                             ((equal (first x) 'por*)
+                              (and (tuplep 3 x)
+                                   (logic.formulap (second x))
+                                   (logic.formulap (third x))))
+                             (t nil)))
+
+       (logic.formula-listp (x)
+                            (if (consp x)
+                                (and (logic.formulap (car x))
+                                     (logic.formula-listp (cdr x)))
+                              t))
+
+       (logic.fmtype (x) (first x))
+
+       (logic.=lhs (x) (second x))
+       (logic.=rhs (x) (third x))
+       (logic.~arg (x) (second x))
+       (logic.vlhs (x) (second x))
+       (logic.vrhs (x) (third x))
+
+       (logic.pequal (a b) (list 'pequal* a b))
+       (logic.pnot   (a)   (list 'pnot* a))
+       (logic.por    (a b) (list 'por* a b))
+
+       (logic.formula-atblp
+        (x atbl)
+        (let ((type (logic.fmtype x)))
+          (cond ((equal type 'por*)
+                 (and (logic.formula-atblp (logic.vlhs x) atbl)
+                      (logic.formula-atblp (logic.vrhs x) atbl)))
+                ((equal type 'pnot*)
+                 (logic.formula-atblp (logic.~arg x) atbl))
+                ((equal type 'pequal*)
+                 (and (logic.term-atblp (logic.=lhs x) atbl)
+                      (logic.term-atblp (logic.=rhs x) atbl)))
+                (t nil))))
+
+       (logic.disjoin-formulas
+        (x)
+        (if (consp x)
+            (if (consp (cdr x))
+                (logic.por (car x) (logic.disjoin-formulas (cdr x)))
+              (car x))
+          nil))
+
+       ;; THE PROOF CHECKER - APPEALS
+
+       (logic.flag-appealp
+        (flag x)
+        (if (equal flag 'proof)
+            (and (true-listp x)
+                 (<= (len x) 4)
+                 (symbolp (first x))
+                 (logic.formulap (second x))
+                 (true-listp (third x))
+                 (logic.flag-appealp 'list (third x)))
+          (if (consp x)
+              (and (logic.flag-appealp 'proof (car x))
+                   (logic.flag-appealp 'list (cdr x)))
+            t)))
+
+       (logic.appealp (x) (logic.flag-appealp 'proof x))
+       (logic.appeal-listp (x) (logic.flag-appealp 'list x))
+
+       (logic.method (x) (first x))
+       (logic.conclusion (x) (second x))
+       (logic.subproofs (x) (third x))
+       (logic.extras (x) (fourth x))
+
+       (logic.strip-conclusions
+        (x)
+        (if (consp x)
+            (cons (logic.conclusion (car x))
+                  (logic.strip-conclusions (cdr x)))
+          nil))
+
+       ;; THE PROOF CHECKER - STEP CHECKING
+
+       (logic.axiom-okp
+        (x axioms atbl)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'axiom)
+               (equal subproofs nil)
+               (equal extras nil)
+               (memberp conclusion axioms)
+               (logic.formula-atblp conclusion atbl))))
+
+       (logic.theorem-okp
+        (x thms atbl)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'theorem)
+               (equal subproofs nil)
+               (equal extras nil)
+               (memberp conclusion thms)
+               (logic.formula-atblp conclusion atbl))))
+
+       ;; Basic Rules
+
+       (logic.associativity-okp
+        (x)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'associativity)
+               (equal extras nil)
+               (tuplep 1 subproofs)
+               (let ((sub-or-a-or-b-c (logic.conclusion (first subproofs))))
+                 (and (equal (logic.fmtype conclusion) 'por*)
+                      (equal (logic.fmtype sub-or-a-or-b-c) 'por*)
+                      (let ((conc-or-a-b (logic.vlhs conclusion))
+                            (conc-c      (logic.vrhs conclusion))
+                            (sub-a       (logic.vlhs sub-or-a-or-b-c))
+                            (sub-or-b-c  (logic.vrhs sub-or-a-or-b-c)))
+                        (and (equal (logic.fmtype conc-or-a-b) 'por*)
+                             (equal (logic.fmtype sub-or-b-c) 'por*)
+                             (let ((conc-a (logic.vlhs conc-or-a-b))
+                                   (conc-b (logic.vrhs conc-or-a-b))
+                                   (sub-b  (logic.vlhs sub-or-b-c))
+                                   (sub-c  (logic.vrhs sub-or-b-c)))
+                               (and (equal conc-a sub-a)
+                                    (equal conc-b sub-b)
+                                    (equal conc-c sub-c))))))))))
+
+       (logic.contraction-okp
+        (x)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'contraction)
+               (equal extras nil)
+               (tuplep 1 subproofs)
+               (let ((or-a-a (logic.conclusion (first subproofs))))
+                 (and (equal (logic.fmtype or-a-a) 'por*)
+                      (equal (logic.vlhs or-a-a) conclusion)
+                      (equal (logic.vrhs or-a-a) conclusion))))))
+
+       (logic.cut-okp
+        (x)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'cut)
+               (equal extras nil)
+               (tuplep 2 subproofs)
+               (let ((or-a-b     (logic.conclusion (first subproofs)))
+                     (or-not-a-c (logic.conclusion (second subproofs))))
+                 (and (equal (logic.fmtype or-a-b) 'por*)
+                      (equal (logic.fmtype or-not-a-c) 'por*)
+                      (let ((a     (logic.vlhs or-a-b))
+                            (b     (logic.vrhs or-a-b))
+                            (not-a (logic.vlhs or-not-a-c))
+                            (c     (logic.vrhs or-not-a-c)))
+                        (and (equal (logic.fmtype not-a) 'pnot*)
+                             (equal (logic.~arg not-a) a)
+                             (equal (logic.fmtype conclusion) 'por*)
+                             (equal (logic.vlhs conclusion) b)
+                             (equal (logic.vrhs conclusion) c))))))))
+
+       (logic.expansion-okp
+        (x atbl)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'expansion)
+               (equal extras nil)
+               (tuplep 1 subproofs)
+               (let ((b (logic.conclusion (first subproofs))))
+                 (and (equal (logic.fmtype conclusion) 'por*)
+                      (equal (logic.vrhs conclusion) b)
+                      (logic.formula-atblp (logic.vlhs conclusion) atbl))))))
+
+       (logic.propositional-schema-okp
+        (x atbl)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'propositional-schema)
+               (equal subproofs nil)
+               (equal extras nil)
+               (equal (logic.fmtype conclusion) 'por*)
+               (let ((not-a (logic.vlhs conclusion))
+                     (a     (logic.vrhs conclusion)))
+                 (and (equal (logic.fmtype not-a) 'pnot*)
+                      (equal (logic.~arg not-a) a)
+                      (logic.formula-atblp a atbl))))))
+
+       (logic.check-functional-axiom
+        (x ti si)
+        (if (equal (logic.fmtype x) 'pequal*)
+            (and (logic.functionp (logic.=lhs x))
+                 (logic.functionp (logic.=rhs x))
+                 (equal (logic.function-name (logic.=lhs x))
+                        (logic.function-name (logic.=rhs x)))
+                 (equal (logic.function-args (logic.=lhs x)) (rev ti))
+                 (equal (logic.function-args (logic.=rhs x)) (rev si)))
+          (and (equal (logic.fmtype x) 'por*)
+               (equal (logic.fmtype (logic.vlhs x)) 'pnot*)
+               (equal (logic.fmtype (logic.~arg (logic.vlhs x))) 'pequal*)
+               (logic.check-functional-axiom
+                (logic.vrhs x)
+                (cons (logic.=lhs (logic.~arg (logic.vlhs x))) ti)
+                (cons (logic.=rhs (logic.~arg (logic.vlhs x))) si)))))
+
+       (logic.functional-equality-okp
+        (x atbl)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'functional-equality)
+               (equal subproofs nil)
+               (equal extras nil)
+               (logic.check-functional-axiom conclusion nil nil)
+               (logic.formula-atblp conclusion atbl))))
+
+
+       ;; Beta-Reduction, Instantiation
+
+       (logic.sigmap (x)
+                     (if (consp x)
+                         (and (consp (car x))
+                              (logic.variablep (car (car x)))
+                              (logic.termp (cdr (car x)))
+                              (logic.sigmap (cdr x)))
+                       t))
+
+       (logic.sigma-listp (x)
+                          (if (consp x)
+                              (and (logic.sigmap (car x))
+                                   (logic.sigma-listp (cdr x)))
+                            t))
+
+       (logic.sigma-list-listp (x)
+                               (if (consp x)
+                                   (and (logic.sigma-listp (car x))
+                                        (logic.sigma-list-listp (cdr x)))
+                                 t))
+
+       (logic.flag-substitute
+        (flag x sigma)
+        (if (equal flag 'term)
+            (cond ((logic.variablep x)
+                   (if (lookup x sigma)
+                       (cdr (lookup x sigma))
+                     x))
+                  ((logic.constantp x)
+                   x)
+                  ((logic.functionp x)
+                   (let ((fn   (logic.function-name x))
+                         (args (logic.function-args x)))
+                     (logic.function fn (logic.flag-substitute
+                                         'list args sigma))))
+                  ((logic.lambdap x)
+                   (let ((formals (logic.lambda-formals x))
+                         (body    (logic.lambda-body x))
+                         (actuals (logic.lambda-actuals x)))
+                     (logic.lambda formals body (logic.flag-substitute
+                                                 'list actuals sigma))))
+                  (t nil))
+          (if (consp x)
+              (cons (logic.flag-substitute 'term (car x) sigma)
+                    (logic.flag-substitute 'list (cdr x) sigma))
+            nil)))
+
+       (logic.substitute (x sigma)
+                         (logic.flag-substitute 'term x sigma))
+
+       (logic.substitute-list (x sigma)
+                              (logic.flag-substitute 'list x sigma))
+
+       (logic.substitute-formula
+        (formula sigma)
+        (let ((type (logic.fmtype formula)))
+          (cond ((equal type 'por*)
+                 (logic.por
+                  (logic.substitute-formula (logic.vlhs formula) sigma)
+                  (logic.substitute-formula (logic.vrhs formula) sigma)))
+                ((equal type 'pnot*)
+                 (logic.pnot
+                  (logic.substitute-formula (logic.~arg formula) sigma)))
+                ((equal type 'pequal*)
+                 (logic.pequal
+                  (logic.substitute (logic.=lhs formula) sigma)
+                  (logic.substitute (logic.=rhs formula) sigma)))
+                (t nil))))
+
+       (logic.instantiation-okp
+        (x atbl)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'instantiation)
+               (logic.sigmap extras)
+               (tuplep 1 subproofs)
+               (equal (logic.substitute-formula
+                       (logic.conclusion (first subproofs)) extras)
+                      conclusion)
+               (logic.formula-atblp conclusion atbl))))
+
+       (logic.beta-reduction-okp
+        (x atbl)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'beta-reduction)
+               (equal subproofs nil)
+               (equal extras nil)
+               (logic.formula-atblp conclusion atbl)
+               (equal (logic.fmtype conclusion) 'pequal*)
+               (let ((lhs (logic.=lhs conclusion))
+                     (rhs (logic.=rhs conclusion)))
+                 (and (logic.lambdap lhs)
+                      (let ((formals (logic.lambda-formals lhs))
+                            (body    (logic.lambda-body lhs))
+                            (actuals (logic.lambda-actuals lhs)))
+                        (equal (logic.substitute
+                                body (pair-lists formals actuals))
+                               rhs)))))))
+
+       ;; Base Evaluation
+
+       (logic.initial-arity-table
+        ()
+        '((if . 3)
+          (equal . 2)
+          (consp . 1)
+          (cons . 2)
+          (car . 1)
+          (cdr . 1)
+          (symbolp . 1)
+          (symbol-< . 2)
+          (natp . 1)
+          (< . 2)
+          (+ . 2)
+          (- . 2)))
+
+       (logic.base-evaluablep
+        (x)
+        (and (logic.functionp x)
+             (let ((fn   (logic.function-name x))
+                   (args (logic.function-args x)))
+               (let ((entry (lookup fn (logic.initial-arity-table))))
+                 (and entry
+                      (logic.constant-listp args)
+                      (tuplep (cdr entry) args))))))
+
+       (logic.base-evaluator
+        (x)
+        (let ((fn   (logic.function-name x))
+              (vals (logic.unquote-list (logic.function-args x))))
+          (list 'quote
+                (cond ((equal fn 'if)
+                       (if (first vals)
+                           (second vals)
+                         (third vals)))
+                      ((equal fn 'equal)
+                       (equal (first vals) (second vals)))
+                      ((equal fn 'consp)
+                       (consp (first vals)))
+                      ((equal fn 'cons)
+                       (cons (first vals) (second vals)))
+                      ((equal fn 'car)
+                       (car (first vals)))
+                      ((equal fn 'cdr)
+                       (cdr (first vals)))
+                      ((equal fn 'symbolp)
+                       (symbolp (first vals)))
+                      ((equal fn 'symbol-<)
+                       (symbol-< (first vals) (second vals)))
+                      ((equal fn 'natp)
+                       (natp (first vals)))
+                      ((equal fn '<)
+                       (< (first vals) (second vals)))
+                      ((equal fn '+)
+                       (+ (first vals) (second vals)))
+                      ((equal fn '-)
+                       (- (first vals) (second vals)))))))
+
+       (logic.base-eval-okp
+        (x atbl)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and (equal method 'base-eval)
+               (equal subproofs nil)
+               (equal extras nil)
+               (equal (logic.fmtype conclusion) 'pequal*)
+               (let ((lhs (logic.=lhs conclusion))
+                     (rhs (logic.=rhs conclusion)))
+                 (and (logic.base-evaluablep lhs)
+                      (equal (logic.base-evaluator lhs) rhs)
+                      (logic.term-atblp lhs atbl))))))
+
+
+       ;; Induction
+
+       (logic.make-basis-step (f qs)
+                              (logic.disjoin-formulas (cons f qs)))
+
+       (logic.substitute-each-sigma-into-formula
+        (f x)
+        (if (consp x)
+            (cons (logic.substitute-formula f (car x))
+                  (logic.substitute-each-sigma-into-formula f (cdr x)))
+          nil))
+
+       (logic.make-induction-step
+        (f q-i sigmas-i)
+        (logic.disjoin-formulas
+         (cons f (cons (logic.pnot q-i)
+                       (logic.substitute-each-sigma-into-formula
+                        (logic.pnot f) sigmas-i)))))
+
+       (logic.make-induction-steps
+        (f qs all-sigmas)
+        (if (consp qs)
+            (cons (logic.make-induction-step f (car qs) (car all-sigmas))
+                  (logic.make-induction-steps f (cdr qs) (cdr all-sigmas)))
+          nil))
+
+       (logic.make-ordinal-step
+        (m)
+        (logic.pequal (logic.function 'ordp (list m)) ''t))
+
+       (logic.make-measure-step
+        (m q-i sigma-i-j)
+        (logic.por (logic.pnot q-i)
+                   (logic.pequal
+                    (logic.function 'ord<
+                                    (list (logic.substitute m sigma-i-j) m))
+                    ''t)))
+
+       (logic.make-measure-steps
+        (m q-i sigmas-i)
+        (if (consp sigmas-i)
+            (cons (logic.make-measure-step m q-i (car sigmas-i))
+                  (logic.make-measure-steps m q-i (cdr sigmas-i)))
+          nil))
+
+       (logic.make-all-measure-steps
+        (m qs all-sigmas)
+        (if (consp all-sigmas)
+            (app (logic.make-measure-steps m (car qs) (car all-sigmas))
+                 (logic.make-all-measure-steps m (cdr qs) (cdr all-sigmas)))
+          nil))
+
+       (logic.induction-okp
+        (x)
+        (let ((method     (logic.method x))
+              (conclusion (logic.conclusion x))
+              (subproofs  (logic.subproofs x))
+              (extras     (logic.extras x)))
+          (and
+           (equal method 'induction)
+           (tuplep 3 extras)
+           (let ((m          (first extras))
+                 (qs         (second extras))
+                 (all-sigmas (third extras))
+                 (subconcs   (logic.strip-conclusions subproofs)))
+             (and (logic.termp m)
+                  (logic.formula-listp qs)
+                  (logic.sigma-list-listp all-sigmas)
+                  (equal (len qs) (len all-sigmas))
+                  (memberp (logic.make-basis-step conclusion qs) subconcs)
+                  (subsetp (logic.make-induction-steps conclusion qs all-sigmas)
+                           subconcs)
+                  (memberp (logic.make-ordinal-step m) subconcs)
+                  (subsetp (logic.make-all-measure-steps m qs all-sigmas)
+                           subconcs))))))
+
+
+       ;; Proof Checking
+
+       (logic.appeal-step-okp
+        (x axioms thms atbl)
+        (let ((how (logic.method x)))
+          (cond ((equal how 'axiom)
+                 (logic.axiom-okp x axioms atbl))
+                ((equal how 'theorem)
+                 (logic.theorem-okp x thms atbl))
+                ((equal how 'propositional-schema)
+                 (logic.propositional-schema-okp x atbl))
+                ((equal how 'functional-equality)
+                 (logic.functional-equality-okp x atbl))
+                ((equal how 'beta-reduction)
+                 (logic.beta-reduction-okp x atbl))
+                ((equal how 'expansion)
+                 (logic.expansion-okp x atbl))
+                ((equal how 'contraction)
+                 (logic.contraction-okp x))
+                ((equal how 'associativity)
+                 (logic.associativity-okp x))
+                ((equal how 'cut)
+                 (logic.cut-okp x))
+                ((equal how 'instantiation)
+                 (logic.instantiation-okp x atbl))
+                ((equal how 'induction)
+                 (logic.induction-okp x))
+                ((equal how 'base-eval)
+                 (logic.base-eval-okp x atbl))
+                (t nil))))
+
+       (logic.flag-proofp
+        (flag x axioms thms atbl)
+        (if (equal flag 'proof)
+            (and (logic.appeal-step-okp x axioms thms atbl)
+                 (logic.flag-proofp 'list (logic.subproofs x) axioms thms atbl))
+          (if (consp x)
+              (and (logic.flag-proofp 'proof (car x) axioms thms atbl)
+                   (logic.flag-proofp 'list (cdr x) axioms thms atbl))
+            t)))
+
+       (logic.proofp (x axioms thms atbl)
+                     (logic.flag-proofp 'proof x axioms thms atbl))
+
+       (logic.provable-witness
+        (x axioms thms atbl)
+        (error '(logic.provable-witness
+                 proof
+                 (x axioms thms atbl)
+                 (and (logic.appealp proof)
+                      (logic.proofp proof axioms thms atbl)
+                      (equal (logic.conclusion proof) x)))))
+
+       (logic.provablep
+        (x axioms thms atbl)
+        (let ((proof (logic.provable-witness x axioms thms atbl)))
+          (and (logic.appealp proof)
+               (logic.proofp proof axioms thms atbl)
+               (equal (logic.conclusion proof) x))))
+
+       ;; SUPPORTING ABBREVIATIONS
+
+       (remove-all (a x)
+                   (if (consp x)
+                       (if (equal a (car x))
+                           (remove-all a (cdr x))
+                         (cons (car x) (remove-all a (cdr x))))
+                     nil))
+
+       (remove-duplicates (x)
+                          (if (consp x)
+                              (if (memberp (car x) (cdr x))
+                                  (remove-duplicates (cdr x))
+                                (cons (car x) (remove-duplicates (cdr x))))
+                            nil))
+
+       (difference (x y)
+                   (if (consp x)
+                       (if (memberp (car x) y)
+                           (difference (cdr x) y)
+                         (cons (car x)
+                               (difference (cdr x) y)))
+                     nil))
+
+       (strip-firsts (x)
+                     (if (consp x)
+                         (cons (first (car x))
+                               (strip-firsts (cdr x)))
+                       nil))
+
+       (strip-seconds (x)
+                      (if (consp x)
+                          (cons (second (car x))
+                                (strip-seconds (cdr x)))
+                        nil))
+
+       (tuple-listp (n x)
+                    (if (consp x)
+                        (and (tuplep n (car x))
+                             (tuple-listp n (cdr x)))
+                      t))
+
+       (sort-symbols-insert
+        (a x)
+        (if (consp x)
+            (if (symbol-< a (car x))
+                (cons a x)
+              (cons (car x)
+                    (sort-symbols-insert a (cdr x))))
+          (list a)))
+
+       (sort-symbols
+        (x)
+        (if (consp x)
+            (sort-symbols-insert (car x)
+                                 (sort-symbols (cdr x)))
+          nil))
+
+       (logic.translate-and-term
+        (args)
+        (if (consp args)
+            (if (consp (cdr args))
+                (logic.function
+                 'if
+                 (list (first args)
+                       (logic.translate-and-term (cdr args))
+                       ''nil))
+              (first args))
+          ''t))
+
+       (logic.translate-let-term
+        (vars terms body)
+        (let* ((body-vars (remove-duplicates (logic.term-vars body)))
+               (id-vars   (sort-symbols (difference body-vars vars)))
+               (formals   (app id-vars vars))
+               (actuals   (app id-vars terms)))
+          (logic.lambda formals body actuals)))
+
+       (logic.translate-or-term
+        (args)
+        (if (consp args)
+            (if (consp (cdr args))
+                (let* ((else-term (logic.translate-or-term (cdr args)))
+                       (cheap-p   (or (logic.variablep (car args))
+                                      (logic.constantp (car args)))))
+                  (if (or cheap-p
+                          (memberp 'special-var-for-or
+                                   (logic.term-vars else-term)))
+                      (logic.function 'if (list (car args) (car args) else-term))
+                    (logic.translate-let-term
+                     (list 'special-var-for-or)
+                     (list (car args))
+                     (logic.function 'if (list 'special-var-for-or
+                                               'special-var-for-or
+                                               else-term)))))
+              (first args))
+          ''nil))
+
+       (logic.translate-list-term
+        (args)
+        (if (consp args)
+            (logic.function
+             'cons
+             (list (car args)
+                   (logic.translate-list-term (cdr args))))
+          ''nil))
+
+       (logic.translate-cond-term
+        (tests thens)
+        (if (consp tests)
+            (let ((test1 (car tests))
+                  (then1 (car thens)))
+              (logic.function
+               'if
+               (list test1
+                     then1
+                     (logic.translate-cond-term (cdr tests)
+                                                (cdr thens)))))
+          ''nil))
+
+       (logic.translate-let*-term
+        (vars terms body)
+        (if (consp vars)
+            (logic.translate-let-term
+             (list (car vars))
+             (list (car terms))
+             (logic.translate-let*-term (cdr vars)
+                                        (cdr terms)
+                                        body))
+          body))
+
+       (logic.flag-translate
+        (flag x)
+        (if (equal flag 'term)
+            (cond ((natp x)
+                   (list 'quote x))
+                  ((symbolp x)
+                   (if (or (equal x nil)
+                           (equal x t))
+                       (list 'quote x)
+                     x))
+                  ((symbolp (car x))
+                   (let ((fn (car x)))
+                     (cond ((equal fn 'quote)
+                            (if (tuplep 2 x)
+                                x
+                              nil))
+                           ((memberp fn '(first second third fourth fifth))
+                            (and (tuplep 2 x)
+                                 (let ((arg (logic.flag-translate 'term (second x))))
+                                   (and arg
+                                        (let* ((1cdr (logic.function 'cdr (list arg)))
+                                               (2cdr (logic.function 'cdr (list 1cdr)))
+                                               (3cdr (logic.function 'cdr (list 2cdr)))
+                                               (4cdr (logic.function 'cdr (list 3cdr))))
+                                          (logic.function
+                                           'car
+                                           (list (cond ((equal fn 'first)  arg)
+                                                       ((equal fn 'second) 1cdr)
+                                                       ((equal fn 'third)  2cdr)
+                                                       ((equal fn 'fourth) 3cdr)
+                                                       (t                  4cdr)))))))))
+                           ((memberp fn '(and or list))
+                            (and (true-listp (cdr x))
+                                 (let ((arguments+ (logic.flag-translate 'list (cdr x))))
+                                   (and (car arguments+)
+                                        (cond ((equal fn 'and)
+                                               (logic.translate-and-term (cdr arguments+)))
+                                              ((equal fn 'or)
+                                               (logic.translate-or-term (cdr arguments+)))
+                                              (t
+                                               (logic.translate-list-term (cdr arguments+))))))))
+                           ((equal fn 'cond)
+                            (and (true-listp (cdr x))
+                                 (tuple-listp 2 (cdr x))
+                                 (let* ((tests  (strip-firsts (cdr x)))
+                                        (thens  (strip-seconds (cdr x)))
+                                        (tests+ (logic.flag-translate 'list tests))
+                                        (thens+ (logic.flag-translate 'list thens)))
+                                   (and (car tests+)
+                                        (car thens+)
+                                        (logic.translate-cond-term (cdr tests+)
+                                                                   (cdr thens+))))))
+                           ((memberp fn '(let let*))
+                            (and (tuplep 3 x)
+                                 (let ((pairs (second x))
+                                       (body  (logic.flag-translate 'term (third x))))
+                                   (and body
+                                        (true-listp pairs)
+                                        (tuple-listp 2 pairs)
+                                        (let* ((vars   (strip-firsts pairs))
+                                               (terms  (strip-seconds pairs))
+                                               (terms+ (logic.flag-translate 'list terms)))
+                                          (and (car terms+)
+                                               (logic.variable-listp vars)
+                                               (cond ((equal fn 'let)
+                                                      (and (uniquep vars)
+                                                           (logic.translate-let-term vars
+                                                                                     (cdr terms+)
+                                                                                     body)))
+                                                     (t
+                                                      (logic.translate-let*-term vars
+                                                                                 (cdr terms+)
+                                                                                 body)))))))))
+                           ((logic.function-namep fn)
+                            (and (true-listp (cdr x))
+                                 (let ((arguments+ (logic.flag-translate 'list (cdr x))))
+                                   (and (car arguments+)
+                                        (logic.function fn (cdr arguments+))))))
+                           (t
+                            nil))))
+                  ((and (tuplep 3 (car x))
+                        (true-listp (cdr x)))
+                   (let* ((lambda-symbol (first (car x)))
+                          (vars          (second (car x)))
+                          (body          (third (car x)))
+                          (new-body      (logic.flag-translate 'term body))
+                          (actuals+      (logic.flag-translate 'list (cdr x))))
+                     (and (equal lambda-symbol 'lambda)
+                          (true-listp vars)
+                          (logic.variable-listp vars)
+                          (uniquep vars)
+                          new-body
+                          (subsetp (logic.term-vars new-body) vars)
+                          (car actuals+)
+                          (equal (len vars) (len (cdr actuals+)))
+                          (logic.lambda vars new-body (cdr actuals+)))))
+                  (t
+                   nil))
+          (if (consp x)
+              (let ((first (logic.flag-translate 'term (car x)))
+                    (rest  (logic.flag-translate 'list (cdr x))))
+                (if (and first (car rest))
+                    (cons t (cons first (cdr rest)))
+                  (cons nil nil)))
+            (cons t nil))))
+
+       (logic.translate (x) (logic.flag-translate 'term x))
+
+
+       ;; TERMINATION OBLIGATIONS
+
+       (cons-onto-ranges
+        (a x)
+        (if (consp x)
+            (cons (cons (car (car x))
+                        (cons a (cdr (car x))))
+                  (cons-onto-ranges a (cdr x)))
+          nil))
+
+       (logic.substitute-callmap
+        (x sigma)
+        (if (consp x)
+            (let ((actuals (car (car x)))
+                  (rulers  (cdr (car x))))
+              (cons (cons (logic.substitute-list actuals sigma)
+                          (logic.substitute-list rulers sigma))
+                    (logic.substitute-callmap (cdr x) sigma)))
+          nil))
+
+       (logic.flag-callmap
+        (flag f x)
+        (if (equal flag 'term)
+            (cond ((logic.constantp x)
+                   nil)
+                  ((logic.variablep x)
+                   nil)
+                  ((logic.functionp x)
+                   (let ((name (logic.function-name x))
+                         (args (logic.function-args x)))
+                     (cond ((and (equal name 'if)
+                                 (equal (len args) 3))
+                            (let ((test-calls
+                                   (logic.flag-callmap 'term f (first args)))
+                                  (true-calls
+                                   (cons-onto-ranges
+                                    (first args)
+                                    (logic.flag-callmap 'term f (second args))))
+                                  (else-calls
+                                   (cons-onto-ranges
+                                    (logic.function 'not (list (first args)))
+                                    (logic.flag-callmap 'term f (third args)))))
+                              (app test-calls (app true-calls else-calls))))
+                           ((equal name f)
+                            (let ((this-call   (cons args nil))
+                                  (child-calls (logic.flag-callmap 'list f args)))
+                              (cons this-call child-calls)))
+                           (t
+                            (logic.flag-callmap 'list f args)))))
+                  ((logic.lambdap x)
+                   (let ((formals (logic.lambda-formals x))
+                         (body    (logic.lambda-body x))
+                         (actuals (logic.lambda-actuals x)))
+                     (let ((actuals-calls (logic.flag-callmap 'list f actuals))
+                           (body-calls    (logic.flag-callmap 'term f body))
+                           (sigma         (pair-lists formals actuals)))
+                       (app actuals-calls
+                            (logic.substitute-callmap body-calls sigma))))))
+          (if (consp x)
+              (app (logic.flag-callmap 'term f (car x))
+                   (logic.flag-callmap 'list f (cdr x)))
+            nil)))
+
+       (logic.callmap (f x)
+                      (logic.flag-callmap 'term f x))
+
+       (repeat (a n)
+               (if (zp n)
+                   nil
+                 (cons a (repeat a (- n 1)))))
+
+       (logic.pequal-list (x y)
+                          (if (and (consp x)
+                                   (consp y))
+                              (cons (logic.pequal (car x) (car y))
+                                    (logic.pequal-list (cdr x) (cdr y)))
+                            nil))
+
+       (logic.progress-obligation
+        (measure formals actuals rulers)
+        (let* ((sigma    (pair-lists formals actuals))
+               (m/sigma  (logic.substitute measure sigma))
+               (ord-term (logic.function 'ord< (list m/sigma measure))))
+          (logic.disjoin-formulas
+           (cons (logic.pequal ord-term ''t)
+                 (logic.pequal-list rulers (repeat ''nil (len rulers)))))))
+
+       (logic.progress-obligations
+        (measure formals callmap)
+        (if (consp callmap)
+            (let* ((entry   (car callmap))
+                   (actuals (car entry))
+                   (rulers  (cdr entry)))
+              (cons (logic.progress-obligation measure formals actuals rulers)
+                    (logic.progress-obligations measure formals (cdr callmap))))
+          nil))
+
+       (logic.termination-obligations
+        (name formals body measure)
+        (let ((callmap (logic.callmap name body)))
+          (if callmap
+              (cons (logic.pequal (logic.function 'ordp (list measure)) ''t)
+                    (logic.progress-obligations measure formals callmap))
+            nil)))
+
+
+       (core.initial-atbl ()
+                          (app '((rank . 1)
+                                 (ordp . 1)
+                                 (ord< . 2))
+                               (logic.initial-arity-table)))
+
+       (core.initial-axioms
+        ()
+        (app '( ;; reflexivity
+               (pequal* x x)
+
+               ;; equality
+               (por* (pnot* (pequal* x1 y1))
+                     (por* (pnot* (pequal* x2 y2))
+                           (por* (pnot* (pequal* x1 x2))
+                                 (pequal* y1 y2))))
+
+               ;; t-not-nil
+               (pnot* (pequal* 't 'nil))
+
+               ;; equal-when-same
+               (por* (pnot* (pequal* x y))
+                     (pequal* (equal x y) 't))
+
+               ;; equal-when-diff
+               (por* (pequal* x y)
+                     (pequal* (equal x y) 'nil))
+
+               ;; if-when-nil
+               (por* (pnot* (pequal* x 'nil))
+                     (pequal* (if x y z) z))
+
+               ;; if-when-not-nil
+               (por* (pequal* x 'nil)
+                     (pequal* (if x y z) y))
+
+               ;; consp-of-cons
+               (pequal* (consp (cons x y)) 't)
+
+               ;; car-of-cons
+               (pequal* (car (cons x y)) x)
+
+               ;; cdr-of-cons
+               (pequal* (cdr (cons x y)) y)
+
+               ;; consp-nil-or-t
+               (por* (pequal* (consp x) 'nil)
+                     (pequal* (consp x) 't))
+
+               ;; car-when-not-consp
+               (por* (pnot* (pequal* (consp x) 'nil))
+                     (pequal* (car x) 'nil))
+
+               ;; cdr-when-not-consp
+               (por* (pnot* (pequal* (consp x) 'nil))
+                     (pequal* (cdr x) 'nil))
+
+               ;; cons-of-car-and-cdr
+               (por* (pequal* (consp x) 'nil)
+                     (pequal* (cons (car x) (cdr x)) x))
+
+               ;; symbolp-nil-or-t
+               (por* (pequal* (symbolp x) 'nil)
+                     (pequal* (symbolp x) 't))
+
+               ;; symbol-<-nil-or-t
+               (por* (pequal* (symbol-< x y) 'nil)
+                     (pequal* (symbol-< x y) 't))
+
+               ;; irreflexivity-of-symbol-<
+               (pequal* (symbol-< x x) 'nil)
+
+               ;; antisymmetry-of-symbol-<
+               (por* (pequal* (symbol-< x y) 'nil)
+                     (pequal* (symbol-< y x) 'nil))
+
+               ;; transitivity-of-symbol-<
+               (por* (pequal* (symbol-< x y) 'nil)
+                     (por* (pequal* (symbol-< y z) 'nil)
+                           (pequal* (symbol-< x z) 't)))
+
+               ;; trichotomy-of-symbol-<
+               (por* (pequal* (symbolp x) 'nil)
+                     (por* (pequal* (symbolp y) 'nil)
+                           (por* (pequal* (symbol-< x y) 't)
+                                 (por* (pequal* (symbol-< y x) 't)
+                                       (pequal* x y)))))
+
+               ;; symbol-<-completion-left
+               (por* (pequal* (symbolp x) 't)
+                     (pequal* (symbol-< x y)
+                              (symbol-< 'nil y)))
+
+               ;; symbol-<-completion-right
+               (por* (pequal* (symbolp y) 't)
+                     (pequal* (symbol-< x y)
+                              (symbol-< x 'nil)))
+
+               ;; disjoint-symbols-and-naturals
+               (por* (pequal* (symbolp x) 'nil)
+                     (pequal* (natp x) 'nil))
+
+               ;; disjoint-symbols-and-conses
+               (por* (pequal* (symbolp x) 'nil)
+                     (pequal* (consp x) 'nil))
+
+               ;; disjoint-naturals-and-conses
+               (por* (pequal* (natp x) 'nil)
+                     (pequal* (consp x) 'nil))
+
+               ;; natp-nil-or-t
+               (por* (pequal* (natp x) 'nil)
+                     (pequal* (natp x) 't))
+
+               ;; natp-of-plus
+               (pequal* (natp (+ a b)) 't)
+
+               ;; commutativity-of-+
+               (pequal* (+ a b) (+ b a))
+
+               ;; associativity-of-+
+               (pequal* (+ (+ a b) c)
+                        (+ a (+ b c)))
+
+               ;; plus-when-not-natp-left
+               (por* (pequal* (natp a) 't)
+                     (pequal* (+ a b) (+ '0 b)))
+
+               ;; plus-of-zero-when-natural
+               (por* (pequal* (natp a) 'nil)
+                     (pequal* (+ a '0) a))
+
+               ;; <-nil-or-t
+               (por* (pequal* (< x y) 'nil)
+                     (pequal* (< x y) 't))
+
+               ;; irreflexivity-of-<
+               (pequal* (< a a) 'nil)
+
+               ;; less-of-zero-right
+               (pequal* (< a '0) 'nil)
+
+               ;; less-of-zero-left-when-natp
+               (por* (pequal* (natp a) 'nil)
+                     (pequal* (< '0 a)
+                              (if (equal a '0) 'nil 't)))
+
+               ;; less-completion-left
+               (por* (pequal* (natp a) 't)
+                     (pequal* (< a b)
+                              (< '0 b)))
+
+               ;; less-completion-right
+               (por* (pequal* (natp b) 't)
+                     (pequal* (< a b)
+                              'nil))
+
+               ;; transitivity-of-<
+               (por* (pequal* (< a b) 'nil)
+                     (por* (pequal* (< b c) 'nil)
+                           (pequal* (< a c) 't)))
+
+               ;; trichotomy-of-<-when-natp
+               (por* (pequal* (natp a) 'nil)
+                     (por* (pequal* (natp b) 'nil)
+                           (por* (pequal* (< a b) 't)
+                                 (por* (pequal* (< b a) 't)
+                                       (pequal* a b)))))
+
+               ;; one-plus-trick
+               (por* (pequal* (< a b) 'nil)
+                     (pequal* (< b (+ '1 a)) 'nil))
+
+               ;; natural-less-than-one-is-zero
+               (por* (pequal* (natp a) 'nil)
+                     (por* (pequal* (< a '1) 'nil)
+                           (pequal* a '0)))
+
+               ;; less-than-of-plus-and-plus
+               (pequal* (< (+ a b) (+ a c))
+                        (< b c))
+
+               ;; natp-of-minus
+               (pequal* (natp (- a b)) 't)
+
+               ;; minus-when-subtrahend-as-large
+               (por* (pequal* (< b a) 't)
+                     (pequal* (- a b) '0))
+
+               ;; minus-cancels-summand-right
+               (pequal* (- (+ a b) b)
+                        (if (natp a) a '0))
+
+               ;; less-of-minus-left
+               (por* (pequal* (< b a) 'nil)
+                     (pequal* (< (- a b) c)
+                              (< a (+ b c))))
+
+               ;; less-of-minus-right
+               (pequal* (< a (- b c))
+                        (< (+ a c) b))
+
+               ;; plus-of-minus-right
+               (por* (pequal* (< c b) 'nil)
+                     (pequal* (+ a (- b c))
+                              (- (+ a b) c)))
+
+               ;; minus-of-minus-right
+               (por* (pequal* (< c b) 'nil)
+                     (pequal* (- a (- b c))
+                              (- (+ a c) b)))
+
+               ;; minus-of-minus-left
+               (pequal* (- (- a b) c)
+                        (- a (+ b c)))
+
+               ;; equal-of-minus-property
+               (por* (pequal* (< b a) 'nil)
+                     (pequal* (equal (- a b) c)
+                              (equal a (+ b c))))
+
+               ;; closed-universe
+               (por* (pequal* (natp x) 't)
+                     (por* (pequal* (symbolp x) 't)
+                           (pequal* (consp x) 't))))
+
+             (list
+              ;; definition-of-not
+              (logic.pequal '(not x)
+                            (logic.translate '(if x nil t)))
+
+              ;; definition-of-rank
+              (logic.pequal '(rank x)
+                            (logic.translate '(if (consp x)
+                                                  (+ 1
+                                                     (+ (rank (car x))
+                                                        (rank (cdr x))))
+                                                0)))
+
+              ;; definition-of-ord<
+              (logic.pequal '(ord< x y)
+                            (logic.translate '(cond ((not (consp x))
+                                                     (if (consp y)
+                                                         t
+                                                       (< x y)))
+                                                    ((not (consp y))
+                                                     nil)
+                                                    ((not (equal (car (car x))
+                                                                 (car (car y))))
+                                                     (ord< (car (car x))
+                                                           (car (car y))))
+                                                    ((not (equal (cdr (car x))
+                                                                 (cdr (car y))))
+                                                     (< (cdr (car x))
+                                                        (cdr (car y))))
+                                                    (t
+                                                     (ord< (cdr x) (cdr y))))))
+
+              ;; definition-of-ordp
+              (logic.pequal '(ordp x)
+                            (logic.translate '(if (not (consp x))
+                                                  (natp x)
+                                                (and (consp (car x))
+                                                     (ordp (car (car x)))
+                                                     (not (equal (car (car x)) 0))
+                                                     (< 0 (cdr (car x)))
+                                                     (ordp (cdr x))
+                                                     (if (consp (cdr x))
+                                                         (ord< (car (car (cdr x)))
+                                                               (car (car x)))
+                                                       t))))))))
+
+       (core.state (axioms thms atbl checker ftbl)
+                   (list axioms thms atbl checker ftbl))
+
+       (core.axioms  (x) (first x))
+       (core.thms    (x) (second x))
+       (core.atbl    (x) (third x))
+       (core.checker (x) (fourth x))
+       (core.ftbl    (x) (fifth x))
+
+       (core.check-proof
+        (checker proof axioms thms atbl)
+        ;; BOZO for the verified lisp, this will be different.
+        ;; BOZO for now, assume proofs are valid
+        ;; t
+        (CL-USER::funcall checker proof axioms thms atbl)
+        )
+
+       (core.check-proof-list
+        (checker proofs axioms thms atbl)
+        (if (consp proofs)
+            (and (core.check-proof checker (car proofs) axioms thms atbl)
+                 (core.check-proof-list checker (cdr proofs) axioms thms atbl))
+          t))
+
+       (logic.soundness-claim
+        (name)
+        (logic.por
+         '(pequal* (logic.appealp x) 'nil)
+         (logic.por
+          (logic.pequal (logic.function name '(x axioms thms atbl))
+                        ''nil)
+          '(pnot* (pequal* (logic.provablep (logic.conclusion x)
+                                            axioms thms atbl)
+                           'nil)))))
+
+       (core.admit-switch
+        (cmd state)
+        ;; Returns a new state or calls error.
+        ;; CMD should be (SWITCH NAME)
+        (if (or (not (tuplep 2 cmd))
+                (not (equal (first cmd) 'switch)))
+            (error (list 'admit-switch 'invalid-cmd cmd))
+          (let ((axioms  (core.axioms state))
+                (thms    (core.thms state))
+                (atbl    (core.atbl state))
+                (ftbl    (core.ftbl state))
+                (name    (second cmd)))
+            (cond ((not (logic.function-namep name))
+                   (error (list 'admit-switch 'invalid-name name)))
+                  ((not (memberp (logic.soundness-claim name) (core.thms state)))
+                   (error (list 'admit-switch 'not-verified name)))
+                  (t
+                   (core.state axioms thms atbl name ftbl))))))
+
+       (core.admit-theorem
+        (cmd state)
+        ;; Returns a new state or calls error.
+        ;; CMD should be (VERIFY NAME FORMULA PROOF)
+        (if (or (not (tuplep 4 cmd))
+                (not (equal (first cmd) 'verify)))
+            (error (list 'admit-theorem 'invalid-cmd cmd))
+          (let ((axioms  (core.axioms state))
+                (thms    (core.thms state))
+                (atbl    (core.atbl state))
+                (checker (core.checker state))
+                (ftbl    (core.ftbl state))
+                (name    (second cmd))
+                (formula (third cmd))
+                (proof   (fourth cmd)))
+            (cond
+             ((not (logic.formulap formula))
+              (error (list 'admit-theorem 'not-formulap name)))
+             ((not (logic.formula-atblp formula atbl))
+              (error (list 'admit-theorem 'not-formula-atblp
+                           name formula atbl)))
+             ((not (logic.appealp proof))
+              (error (list 'admit-theorem 'not-appealp name)))
+             ((not (equal (logic.conclusion proof) formula))
+              (error (list 'admit-theorem 'wrong-conclusion name)))
+             ((not (core.check-proof checker proof axioms thms atbl))
+              (error (list 'admit-theorem 'proof-rejected name)))
+             (t
+              (if (memberp formula thms)
+                  state
+                (core.state axioms (cons formula thms) atbl checker ftbl)))))))
+
+       (core.admit-defun
+        (cmd state)
+        ;; Returns a new state or calls error.
+        ;; CMD should be (DEFINE NAME FORMALS BODY MEASURE PROOF-LIST)
+        (if (or (not (tuplep 6 cmd))
+                (not (equal (car cmd) 'define)))
+            (error (list 'admit-defun 'invalid-cmd cmd))
+          (let* ((axioms      (core.axioms state))
+                 (thms        (core.thms state))
+                 (atbl        (core.atbl state))
+                 (checker     (core.checker state))
+                 (ftbl        (core.ftbl state))
+                 (name        (second  cmd))
+                 (formals     (third cmd))
+                 (raw-body    (fourth cmd))
+                 (raw-measure (fifth cmd))
+                 (proofs      (fifth (cdr cmd)))
+                 (body        (logic.translate raw-body))
+                 (measure     (logic.translate raw-measure))
+                 (arity       (len formals))
+                 (new-atbl    (cons (cons name arity) atbl))
+                 (obligations (logic.termination-obligations
+                               name formals body measure)))
+            (cond ((not (logic.function-namep name))
+                   (error (list 'admit-defun 'bad-name name)))
+                  ((not (logic.variable-listp formals))
+                   (error (list 'admit-defun 'bad-formals name)))
+                  ((not (uniquep formals))
+                   (error (list 'admit-defun 'duplicated-formals name)))
+                  ((not (logic.termp body))
+                   (error (list 'admit-defun 'bad-body name)))
+                  ((not (logic.termp measure))
+                   (error (list 'admit-defun 'bad-measure name)))
+                  ((not (subsetp (logic.term-vars body) formals))
+                   (error (list 'admit-defun 'free-vars-in-body name)))
+                  ((not (subsetp (logic.term-vars measure) formals))
+                   (error (list 'admit-defun 'free-vars-in-measure name)))
+                  ((not (logic.term-atblp body new-atbl))
+                   (error (list 'admit-defun 'bad-arity-in-body name)))
+                  ((not (logic.term-atblp measure new-atbl))
+                   (error (list 'admit-defun 'bad-arity-in-measure name)))
+                  ((not (logic.appeal-listp proofs))
+                   (error (list 'admit-defun 'proofs-not-appeals name)))
+                  ((not (equal (logic.strip-conclusions proofs) obligations))
+                   (error (list 'admit-defun 'proofs-wrong-conclusions name)))
+                  ((not (core.check-proof-list checker proofs axioms thms
+                                               new-atbl))
+                   (error (list 'admit-defun 'proof-rejected name)))
+                  (t
+                   (let* ((ftbl      (define-safe ftbl name formals raw-body))
+                          (new-axiom (logic.pequal (logic.function name formals)
+                                                   body))
+                          (atbl      (if (lookup name atbl)
+                                         atbl
+                                       new-atbl))
+                          (axioms    (if (memberp new-axiom axioms)
+                                         axioms
+                                       (cons new-axiom axioms))))
+                     (core.state axioms thms atbl checker ftbl)))))))
+
+       (core.admit-witness
+        (cmd state)
+        ;; Returns a new state or calls error
+        ;; CMD should be (SKOLEM NAME BOUND-VAR FREE-VAR BODY)
+        (if (or (not (tuplep 5 cmd))
+                (not (equal (car cmd) 'skolem)))
+            (error (list 'admit-witness 'invalid-cmd cmd))
+          (let* ((axioms    (core.axioms state))
+                 (thms      (core.thms state))
+                 (atbl      (core.atbl state))
+                 (checker   (core.checker state))
+                 (ftbl      (core.ftbl state))
+                 (name      (second cmd))
+                 (bound-var (third cmd))
+                 (free-vars (fourth cmd))
+                 (raw-body  (fifth cmd))
+                 (body      (logic.translate raw-body))
+                 (all-vars  (cons bound-var free-vars)))
+            (cond
+             ((not (logic.function-namep name))
+              (error (list 'admit-witness 'bad-name name)))
+             ((not (logic.variablep bound-var))
+              (error (list 'admit-witness 'bad-bound-var name)))
+             ((not (logic.variable-listp free-vars))
+              (error (list 'admit-witness 'bad-free-vars name)))
+             ((not (uniquep (cons bound-var free-vars)))
+              (error (list 'admit-witness 'duplicate-free-vars name)))
+             ((not (logic.termp body))
+              (error (list 'admit-witness 'bad-body name)))
+             ((not (subsetp (logic.term-vars body) all-vars))
+              (error (list 'admit-witness 'free-vars-in-body name)))
+             ((not (logic.term-atblp body atbl))
+              (error (list 'admit-witness 'bad-arity-in-body name)))
+             (t
+              (let* ((ftbl (define-safe ftbl name free-vars
+                             (list 'error
+                                   (list 'quote
+                                         (list name bound-var
+                                               free-vars raw-body)))))
+                     (atbl (if (lookup name atbl)
+                               atbl
+                             (cons (cons name (len free-vars)) atbl)))
+                     (new-axiom
+                      (logic.por (logic.pequal body ''nil)
+                                 (logic.pnot
+                                  (logic.pequal
+                                   (logic.lambda
+                                    all-vars body
+                                    (cons (logic.function name free-vars)
+                                          free-vars))
+                                   ''nil))))
+                     (axioms (if (memberp new-axiom axioms)
+                                 axioms
+                               (cons new-axiom axioms))))
+                (core.state axioms thms atbl checker ftbl)))))))
+
+       (core.accept-command
+        (cmd state)
+        ;; Returns a new state or calls error
+        (cond ((equal (car cmd) 'verify) (core.admit-theorem cmd state))
+              ((equal (car cmd) 'define) (core.admit-defun cmd state))
+              ((equal (car cmd) 'skolem) (core.admit-witness cmd state))
+              ((equal (car cmd) 'switch) (core.admit-switch cmd state))
+              (t
+               (error (list 'accept-cmd 'invalid-command cmd)))))
+
+       (core.accept-commands
+        (cmds event-number state)
+        ;; Returns a new state or calls error.
+        (if (consp cmds)
+            (let* ((unused (print (list event-number
+                                        (first (car cmds))
+                                        (second (car cmds)))))
+                   (state (core.accept-command (car cmds) state)))
+              (core.accept-commands (cdr cmds)
+                                    (+ 1 event-number)
+                                    state))
+          state)))))
+
+(milawa-init)
+
+(define 'milawa-main '(cmds)
+  '(let* ((ftbl      (milawa-init))
+          (axioms    (core.initial-axioms))
+          (thms      nil)
+          (atbl      (core.initial-atbl))
+          (checker   'logic.proofp)
+          (state     (core.state axioms thms atbl checker ftbl)))
+     (and (core.accept-commands cmds 1 state)
+          'success)))
+
+
+
+; READING THE PROOF FILE
+
+(CL-USER::in-package "CL-USER")
+
+(defun-comp aux-acceptable-objectp (x cache)
+  (or (and (integerp x)
+           (<= 0 x))
+      (and (symbolp x)
+           (equal x (intern (symbol-name x) "MILAWA")))
+      (and (consp x)
+           (let ((status (gethash x cache)))
+             (cond ((eq status t)
+                    t)
+                   ((eq status nil)
+                    (progn (setf (gethash x cache) 'exploring)
+                           (and (aux-acceptable-objectp (car x) cache)
+                                (aux-acceptable-objectp (cdr x) cache)
+                                (setf (gethash x cache) t))))
+                   (t
+                    nil))))))
+
+(defconstant rough-number-of-unique-conses-in-proofs 525000000)
+
+(defun-comp acceptable-objectp (x)
+  (let* ((size (ceiling (* 1.10 rough-number-of-unique-conses-in-proofs)))
+         (cache (make-hash-table :size size :test 'eq)))
+    (aux-acceptable-objectp x cache)))
+
+(defvar *milawa-readtable* (copy-readtable *readtable*))
+(declaim (readtable *milawa-readtable*))
+
+(defvar *milawa-abbreviations-hash-table*)
+(declaim (type hash-table *milawa-abbreviations-hash-table*))
+
+(defun-comp milawa-sharp-equal-reader (stream subchar arg)
+  (declare (ignore subchar))
+  (multiple-value-bind
+   (value presentp)
+   (gethash arg *milawa-abbreviations-hash-table*)
+   (declare (ignore value))
+   (when presentp
+     (error "#~A= is already defined." arg))
+   (let ((object (read stream)))
+     (setf (gethash arg *milawa-abbreviations-hash-table*) object))))
+
+(defun-comp milawa-sharp-sharp-reader (stream subchar arg)
+  (declare (ignore stream subchar))
+  (or (gethash arg *milawa-abbreviations-hash-table*)
+      (error "#~A# used but not defined." arg)))
+
+(let ((*readtable* *milawa-readtable*))
+  (set-dispatch-macro-character #\# #\# #'milawa-sharp-sharp-reader)
+  (set-dispatch-macro-character #\# #\= #'milawa-sharp-equal-reader))
+
+(defconstant unique-cons-for-eof (cons 'unique-cons 'for-eof))
+
+(defun-comp milawa-read-file-aux (stream)
+   (let ((obj (read stream nil unique-cons-for-eof)))
+     (cond ((eq obj unique-cons-for-eof)
+            nil)
+           (t
+            (cons obj (milawa-read-file-aux stream))))))
+
+(defun-comp milawa-read-file (filename)
+  (format t ";; Reading from ~A~%" filename)
+  (finish-output)
+  (let* ((size (ceiling (* 1.10 rough-number-of-unique-conses-in-proofs)))
+         (*milawa-abbreviations-hash-table* (make-hash-table :size size
+                                                             :test 'eql))
+         (*readtable* *milawa-readtable*)
+         (*package* (find-package "MILAWA"))
+         (stream (open filename
+                       :direction :input
+                       :if-does-not-exist :error))
+         (contents (time (milawa-read-file-aux stream))))
+    (close stream)
+    ;; Allow abbrevs table to get gc'd.
+    (setq *milawa-abbreviations-hash-table* (make-hash-table :test 'eql))
+    (ccl::gc)
+    (format t ";; Skipping acceptable-object.")
+;    (format t ";; Checking acceptable-objectp.~%")
+;    (finish-output)
+;    (unless (time (acceptable-objectp contents))
+;      (error "unacceptable object encountered"))
+    (ccl::gc)
+    contents))
+
+
+(defun main ()
+  (handler-case
+   (let ((events (car (milawa-read-file "full.events"))))
+     (MILAWA::milawa-main events))
+   (error (x)
+    (progn
+      (format t "Error: ~a" x)
+      (quit)))))
+
+;; (CCL::save-application "milawa2"
+;;                        :toplevel-function #'main
+;;                        :purify t)
+
+
+#||
+
+
+(defun unique-conses (x ht)
+  ;; ht associates objects with their number of unique conses
+  (if (atom x)
+      nil
+    (or (gethash x ht)
+        (let ((car-count (unique-conses (car x) ht))
+              (cdr-count (unique-conses (cdr x) ht)))
+          (setf (gethash x ht) (+ car-count cdr-count))))))
+
+(unique-conses *events* (make-hash-table
+                         :test #'eq
+                         :size (ceiling (* 1.1 525000000))))
+
+
+(defparameter *events*
+  (car (milawa-read-file "full.events")))
+
+(defparameter *events*
+  (time (car (milawa-read-file "ACL2/bootstrap/verified-lisp/full.events"))))
+
+(- 753.0 (* 12 60.0))
+
+(defun take (n x)
+  (if (= n 0)
+      nil
+    (cons (car x)
+          (take (- n 1) (cdr x)))))
+
+(defparameter *st*
+  (let* ((ftbl      (milawa::milawa-init))
+         (axioms    (milawa::core.initial-axioms))
+         (thms      nil)
+         (atbl      (milawa::core.initial-atbl))
+         (checker   'milawa::logic.proofp)
+         (state     (milawa::core.state axioms thms atbl checker ftbl)))
+    (milawa::core.accept-commands (take 1927 *events*) 0 state)))
+
+(defvar *st2*
+  (milawa::core.accept-commands (list (nth 1927 *events*)) 1927 *st*))
+
+(defvar *st3*
+  (milawa::core.accept-commands (list (nth 1928 *events*)) 1928 *st2*))
+
+(defvar *st3*
+  (milawa::core.accept-commands (list (nth 1928 *events*)) 1928 *st*))
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/milawa/report-time.rb acl2-6.3/books/milawa/report-time.rb
--- acl2-6.2/books/milawa/report-time.rb	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/report-time.rb	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,37 @@
+#!/usr/bin/env ruby
+
+# Milawa Time Report Tool - Jared Davis (jared@cs.utexas.edu)
+#
+# You just feed this the output from Milawa, and it tells you which events tool
+# the longest.  Note that GC performance can randomly make some events look bad
+# even when it's "not their fault."
+#
+# Example Usage:
+#
+#   ./report-time.rb < utilities.ccl-image.out
+#
+# Example Output
+#
+#     43.62   VERIFY FORCING-TRICHOTOMY-OF-<< (#1616)
+#     34.27   VERIFY ORDERED-SUBSETP-IS-TRANSITIVE (#1499)
+#     31.26   VERIFY LEMMA2-FOR-GATHER-CONSTANTS-FROM-EQUAL-OF-PLUS-AND-PLUS (#265)
+#     28.01   VERIFY EQUAL-OF-APP-AND-APP-WHEN-EQUAL-LENS (#446)
+#     27.75   VERIFY CONS-LISTP-OF-REMOVE-SUPERSETS1 (#1000)
+#     ... and so on ...
+
+data = Array.new
+
+while line = STDIN.gets
+   case line
+     when /([0-9]+)> (VERIFY|DEFINE) (.*)/
+        current = { :event => $1, :type => $2, :name => $3 }
+     when /;; (VERIFY|DEFINE) took ([0-9]+\.[0-9]+) seconds/
+        current[:time] = $2.to_f
+        data.push(current)
+   end
+end
+
+sorted = data.sort_by { |x| -x[:time] }
+sorted.each { |x|
+  printf("%10.2f   %s %s (#%s)\n", x[:time], x[:type], x[:name], x[:event])
+}
diff -Nru acl2-6.2/books/milawa/summarize-sizes.rb acl2-6.3/books/milawa/summarize-sizes.rb
--- acl2-6.2/books/milawa/summarize-sizes.rb	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/milawa/summarize-sizes.rb	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,214 @@
+#!/usr/bin/env ruby -w
+
+def fix_string(str)
+  # strip color codes by turning escape char into ?.
+  len = str.length
+  for n in 0..len
+    str[n] = '?' if (str.getbyte(n) == 27)
+  end
+  return str
+end
+
+def pretty_number(n)
+  # insert commas appropriately
+  return n.to_s.reverse.gsub(/...(?=.)/,'\&,').reverse
+end
+
+
+def get_cons_sizes(dir)
+  # read proof sizes from pcert.out files in bootstrap dirs
+  sizes = Array.new
+  Dir["ACL2/bootstrap/#{dir}/*.pcert.out"].each { |path|
+    File.open(path).each { |line|
+      line = fix_string(line)
+      case line
+      when /;; Proof sizes total: ([0-9,]+) conses.*/
+        size = $1.gsub(/\,/,"") # eats commas
+        sizes.push(size.to_i)
+      when /;; Proof size: ?.*m([0-9,]+) conses.*/
+        size = $1.gsub(/\,/,"") # eats commas
+        sizes.push(size.to_i)
+      end
+    }
+  }
+  return sizes
+end
+
+def get_file_sizes(dir)
+  # read actual file sizes from proof files in Proofs dirs
+  sizes = Array.new
+  Dir["Proofs/#{dir}/*.*"].each { |path|
+    sizes.push(File.size(path))
+  }
+  return sizes
+end
+
+def human_file_size(size)
+  # These terms are, of course, ambiguous.  We use powers of 10.
+  kilobyte = 1000
+  megabyte = 1000*kilobyte
+  gigabyte = 1000*megabyte
+  return "#{size} B" if (size < kilobyte)
+  return "#{("%0.1f" % (size.to_f/kilobyte))} KB" if (size < megabyte)
+  return "#{("%0.1f" % (size.to_f/megabyte))} MB" if (size < gigabyte)
+  return "#{("%0.1f" % (size.to_f/gigabyte))} GB"
+end
+
+def human_cons_size(size)
+  kilocons = 1000
+  megacons = 1000*kilocons
+  gigacons = 1000*megacons
+  return "#{size} C" if (size < kilocons)
+  return "#{("%0.1f" % (size.to_f/kilocons))} KC" if (size < megacons)
+  return "#{("%0.1f" % (size.to_f/megacons))} MC" if (size < gigacons)
+  return "#{("%0.1f" % (size.to_f/gigacons))} GC"
+end
+
+def summarize_events(dir)
+  define = 0
+  verify = 0
+  skolem = 0
+  switch = 0
+  finish = 0
+
+  File.open("Proofs/#{dir}.events").each { |line|
+    case line
+    when /\(DEFINE.*/
+      define += 1
+    when /\(VERIFY.*/
+      verify += 1
+    when /\(SKOLEM.*/
+      skolem += 1
+    when /\(SWITCH.*/
+      switch += 1
+    when /\(FINISH.*/
+      finish += 1
+    end
+  }
+
+  total = define + verify + skolem + switch + finish
+  return {:define => define, :verify => verify, :skolem => skolem,
+  	  :switch => switch, :finish => finish, :total => total }
+end
+
+def summarize(dir)
+
+  puts "Processing #{dir}"
+  conses = get_cons_sizes(dir)
+  max_conses = conses.max
+  sum_conses = 0
+  conses.each { |x| sum_conses += x }
+
+  big_conses = Array.new
+  conses.each { |x| big_conses.push(x) if x > 500000000 }
+
+  files = get_file_sizes(dir)
+  max_file = files.max
+  sum_files = 0
+  files.each { |x| sum_files += x }
+
+  events = summarize_events(dir)
+
+  puts "  Found #{conses.size} proof-size lines in ACL2/bootstrap/#{dir}/*.pcert.out"
+  puts "  Found #{files.size} proof files in Proofs/#{dir}"
+  puts "  Maximum proof size is: #{pretty_number(max_conses)}"
+  puts "  Sum of proof sizes is: #{pretty_number(sum_conses)}"
+  puts "  Number of big (over 500 megaconses) proofs is: #{big_conses.size}"
+  puts "  Sizes of big proofs (in conses) are: #{big_conses}"
+  puts "  Total size of proof files on disk is: #{human_file_size(sum_files)}"
+  puts "  Largest individual proof file is: #{human_file_size(max_file)}"
+  puts "  Event counts: #{events}"
+  puts ""
+
+  return {:dir => dir,
+          :definitions => events[:define],
+          :theorems => events[:verify],
+          :max_conses => max_conses,
+          :sum_conses => sum_conses,
+          :total_file_size => sum_files}
+
+
+end
+
+
+def latex_fix_dirname(dir)
+  return "leveltwo" if dir == "level2"
+  return "levelthree" if dir == "level3"
+  return "levelfour" if dir == "level4"
+  return "levelfive" if dir == "level5"
+  return "levelsix" if dir == "level6"
+  return "levelseven" if dir == "level7"
+  return "leveleight" if dir == "level8"
+  return "levelnine" if dir == "level9"
+  return "levelten" if dir == "level10"
+  return "leveleleven" if dir == "level11"
+  return dir
+end
+
+
+dirs = ["utilities", "logic", "level2", "level3", "level4", "level5", "level6",
+        "level7", "level8", "level9", "level10", "level11", "user"]
+
+results = Array.new
+dirs.each { |x| results.push(summarize(x)) }
+
+
+puts ""
+puts "%% Table for LaTeX:"
+puts ""
+
+puts "\\begin{tabular}{lrrrrr}"
+puts "\\textbf{Directory} & \\textbf{Defs} & \\textbf{Thms} &"
+puts "\\textbf{Largest Proof} & \\textbf{All Proofs} & \\textbf{Disk Size} \\\\"
+puts " & & & (megaconses) & (megaconses) & (megabytes) \\\\"
+puts "\\hline"
+
+
+def pretty_float(float)
+  ipart = float.to_i
+  fpart = (float * 10).to_i % 10
+  return "#{pretty_number(ipart)}.#{fpart}"
+end
+
+
+
+
+
+
+totdefs = 0
+totthms = 0
+totsums = 0
+totfile = 0
+
+macros = File.open("size_macros.tex", "w")
+
+results.each { |x|
+
+  totdefs += x[:definitions]
+  totthms += x[:theorems]
+  totsums += x[:sum_conses]
+  totfile += x[:total_file_size]
+
+  dir = x[:dir].capitalize
+  defs = pretty_number(x[:definitions])
+  thms = pretty_number(x[:theorems])
+  mcons = pretty_float(x[:max_conses].to_f/(1000*1000))
+  scons = pretty_float(x[:sum_conses].to_f/(1000*1000))
+  tot =   pretty_float(x[:total_file_size].to_f/(1000*1000))
+  puts "#{dir} \\quad & #{defs} & #{thms} & #{mcons} & #{scons} & #{tot} \\\\"
+
+  ltxdir = latex_fix_dirname(x[:dir])
+  macros.puts("\\newcommand{\\#{ltxdir}numdefs}{#{defs}\\xspace}")
+  macros.puts("\\newcommand{\\#{ltxdir}numthms}{#{thms}\\xspace}")
+  macros.puts("\\newcommand{\\#{ltxdir}maxconses}{#{human_cons_size(x[:max_conses])}\\xspace}")
+  macros.puts("\\newcommand{\\#{ltxdir}sumconses}{#{human_cons_size(x[:sum_conses])}\\xspace}")
+  macros.puts("\\newcommand{\\#{ltxdir}filesize}{#{human_file_size(x[:total_file_size])}\\xspace}")
+}
+
+macros.close
+
+puts "\\hline"
+
+puts "\\textbf{Totals} & #{pretty_number(totdefs)} & #{pretty_number(totthms)} "
+puts "  &              & #{pretty_float(totsums/(1000*1000))} & #{pretty_float(totfile/(1000*1000))} \\\\"
+puts "\\end{tabular}"
diff -Nru acl2-6.2/books/misc/README acl2-6.3/books/misc/README
--- acl2-6.2/books/misc/README	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/README	2013-09-30 17:52:18.000000000 +0000
@@ -1,5 +1,8 @@
-; README  --  introduction to cli-misc directory
+; README  --  introduction to misc directory
+
+; Originally cli-misc directory,
 ; Copyright (C) 1997  Computational Logic, Inc.
+; The following license appeared here:
 
 ; This book is free software; you can redistribute it and/or modify
 ; it under the terms of the GNU General Public License as published by
@@ -15,9 +18,9 @@
 ; along with this book; if not, write to the Free Software
 ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
-This directory contains a bunch of ACL2 books that were created over the
-years at CLI.  They don't have any relation to each other; this is
-really a grab-bag.
+This directory contains a bunch of ACL2 books that were created over
+the years, starting at CLI.  They don't have any relation to each
+other; this is really a grab-bag.
 
 ===============================================================================
 
@@ -40,37 +43,21 @@
 
 ===============================================================================
 
-defattach-bang.lisp -- avoid normal guard verification requirement for a
-                       function to be attached to a constrained function
-
-===============================================================================
-
-defattach-example.lisp -- example use of defattach
-
-===============================================================================
-
-defabsstobj-example-*.lisp -- example uses of defabsstobj
-
-===============================================================================
-
-dijkstra-shortest-path.lisp -- A Proof of the Correctness of Dijkstra's
-                               Shortest Path Algorithm in ACL2
+assert.lisp -- an assertion mechanism for use within books
 
 ===============================================================================
 
-disassemble.lisp -- support for disassemble$, an interface to Common
-                    Lisp's disassemble utility for showing assembly
-                    code for a given function symbol's definition
-
-===============================================================================
-
-bash.lisp -- simplification of top-level goal
+bash-bsd.lisp, bash.lisp -- simplification of top-level goal
 
 If you submit (bash term), you will get back a list of terms produced by the
 ACL2 simplifier.  See the description at the top of bash.lisp for details.
 
 See also defopener.lisp and expander.lisp.
 
+Note: bash.lisp is just bash-bsd.lisp plus xdoc-style documentation.
+If you use bash.lisp, you will be including a GPL'ed book (ACL2
+community book xdoc/top), but not if you only use bash-bsd.lisp.
+
 ===============================================================================
 
 beta-reduce.lisp -- proof of correctness for a beta-reduction routine
@@ -81,10 +68,8 @@
 
 ===============================================================================
 
-book-thms.lisp --         returns theorems and axioms at the top level of an
-                          included book
-
-book-thms-example.lisp -- an example illustrating the use of book-thms.lisp
+book-checks.lisp -- utilities for checking that libraries don't
+                    enable/disable existing rules unexpectedly
 
 ===============================================================================
 
@@ -138,7 +123,16 @@
 
 ===============================================================================
 
-defattach-example.lisp -- illustration of using defattach for system building
+defabsstobj-example-*.lisp -- example uses of defabsstobj
+
+===============================================================================
+
+defattach-bang.lisp -- avoid normal guard verification requirement for a
+                       function to be attached to a constrained function
+
+===============================================================================
+
+defattach-example.lisp -- example use of defattach
 
 ===============================================================================
 
@@ -155,11 +149,6 @@
 
 ===============================================================================
 
-misc2/defpun-exec-domain-example.lisp -- execute partial functions on a
-                                         specified domain
-
-===============================================================================
-
 defopener.lisp -- create theorem equating term with its simplification
 
 For documentation:
@@ -171,6 +160,10 @@
 
 ===============================================================================
 
+defproxy-test.lisp -- examples of the use of defproxy
+
+===============================================================================
+
 defp.lisp   -- define partial functions using defp
 defpun.lisp -- define partial functions using defpun
 
@@ -185,7 +178,8 @@
 
 ===============================================================================
 
-defproxy-test.lisp -- examples of the use of defproxy
+misc2/defpun-exec-domain-example.lisp -- execute partial functions on a
+                                         specified domain
 
 ===============================================================================
 
@@ -223,12 +217,36 @@
 
 ===============================================================================
 
+dijkstra-shortest-path.lisp -- a proof of the correctness of Dijkstra's
+                               shortest path algorithm
+
+===============================================================================
+
+disassemble.lisp -- support for disassemble$, an interface to Common
+                    Lisp's disassemble utility for showing assembly
+                    code for a given function symbol's definition
+
+===============================================================================
+
 equal-by-g.lisp -- a generic theorem for proving that records (in the sense of
 the misc/records book) are equal, by showing that any arbitrary field has the
 same value in both records.
 
 ===============================================================================
 
+eval.lisp -- macros to check evaluation of forms
+
+Utilities defined in this book include the following:
+
+must-eval-to
+must-eval-to-t
+must-succeed
+must-fail
+thm?
+not-thm?
+
+===============================================================================
+
 evalable-printing.lisp -- a
 "beginner-friendly" way of printing objects such that evaluating the
 printed result gives that same result
@@ -240,8 +258,8 @@
 
 ===============================================================================
 
-expander.lisp     --   symbolic expansion utilities for ACL2
 dump-events.lisp  --   file-dumping utility for ACL2
+expander.lisp     --   symbolic expansion utilities for ACL2
 
 See also simplify-defuns.lisp for a related tool.
 
@@ -317,18 +335,15 @@
 
 ===============================================================================
 
-hacker.lisp -- Utilities in support of building ACL2 extensions/modifications
-
-THIS BOOK HAS BEEN REMOVED.  Instead please use
-books/hacking/hacker.lisp in the ACL2 distribution.
+hanoi.lisp -- a solution to the Towers of Hanoi problem
 
 ===============================================================================
 
-hanoi.lisp -- A solution to the Towers of Hanoi problem
+hons-help.lisp and hons-help2.lisp -- support for HONS extension of ACL2
 
 ===============================================================================
 
-hons-help.lisp and hons-help2.lisp -- Support for HONS extension of ACL2
+hons-tests.lisp -- tests of HONS extension of ACL2
 
 ===============================================================================
 
@@ -339,13 +354,14 @@
 
 ===============================================================================
 
-integer-type-set-test.lisp -- Tests of enhancement to integer reasoning
+integer-type-set-test.lisp -- tests of enhancement to integer reasoning
 
 ===============================================================================
 
-invariants.lisp -- Tries to prove lemmas stating that if a certain
-property is true of the arguments to a function, that property will be
-true of the arguments to all its recursive calls.
+invariants.lisp -- tries to prove lemmas stating that if a certain
+                   property is true of the arguments to a function,
+                   that property will be true of the arguments to all
+                   its recursive calls.
 
 ===============================================================================
 
@@ -381,6 +397,10 @@
 
 ===============================================================================
 
+nested-stobj-tests.lisp -- tests for nested stobjs (and stobj-let)
+
+===============================================================================
+
 oprof.lisp -- simple performance profiling tool for OpenMCL
 
 This book only works on the OpenMCL-based version of ACL2.  It implements a 
@@ -413,6 +433,10 @@
 
 ===============================================================================
 
+qi.lisp and qi-correct.lisp -- unlabeled BDDs (ubdds) and correctness thereof
+
+===============================================================================
+
 radix.lisp -- support for radix conversion
 
 ===============================================================================
@@ -475,6 +499,18 @@
 
 ===============================================================================
 
+rtl-untranslate.lisp -- replacement for untranslate suitable rtl functions
+
+===============================================================================
+
+misc2/ruler-extenders-tests.lisp -- tests for ruler-extenders
+
+This suite of tests is mainly for regression, though users interested
+in more information about ruler-extenders, beyond that provided in
+:doc ruler-extenders, may find this file to be interesting.
+
+===============================================================================
+
 save-time.lisp -- utility for saving times into the ACL2 state and for printing
                   those saved times
 
@@ -543,14 +579,6 @@
 
 ===============================================================================
 
-misc2/ruler-extenders-tests.lisp -- tests for ruler-extenders
-
-This suite of tests is mainly for regression, though users interested
-in more information about ruler-extenders, beyond that provided in
-:doc ruler-extenders, may find this file to be interesting.
-
-===============================================================================
-
 total-order.lisp -- total order for ACL2
 total-order-bsd.lisp -- BSD-licensed version of the above
 
diff -Nru acl2-6.2/books/misc/assert.lisp acl2-6.3/books/misc/assert.lisp
--- acl2-6.2/books/misc/assert.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/assert.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; The macro assert!, defined and illustrated below, allows for assertions
 ; within an ACL2 book, as requested by David Rager.
 
diff -Nru acl2-6.2/books/misc/bash-bsd.lisp acl2-6.3/books/misc/bash-bsd.lisp
--- acl2-6.2/books/misc/bash-bsd.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/misc/bash-bsd.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -0,0 +1,413 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (original date October, 2006)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
+(in-package "ACL2")
+
+(program)
+
+(set-state-ok t)
+
+(defun simplify-with-prover (form hints ctx state)
+
+; This is patterned after (define-pc-primitive prove ...).
+
+  (let ((wrld (w state))
+        (ens (ens state))
+        (name-tree 'bash))
+    (er-let*
+     ((thints (translate-hints
+               name-tree
+
+; Keep the following in sync with the definition of the proof-checker :bash
+; command.
+
+               (append
+                *bash-skip-forcing-round-hints*
+                (add-string-val-pair-to-string-val-alist
+                 "Goal"
+                 :do-not
+                 (list 'quote '(generalize eliminate-destructors fertilize
+                                           eliminate-irrelevance))
+                 (add-string-val-pair-to-string-val-alist
+                  "Goal"
+                  :do-not-induct
+                  name-tree
+                  hints))
+                (default-hints wrld))
+               ctx wrld state))
+      (tterm (translate form t t t ctx wrld state)))
+     (mv-let (erp ttree state)
+             (state-global-let*
+              ((guard-checking-on nil)
+               (in-prove-flg t))
+              (pc-prove tterm form thints t ens wrld ctx state))
+             (cond (erp (mv t nil state))
+                   (t (let ((clauses (unproved-pc-prove-clauses ttree)))
+                        (cond ((and (eql (length clauses) 1)
+                                    (eql (length (car clauses)) 1)
+                                    (eql (caar clauses) tterm))
+                               (mv 'no-change nil state))
+                              (t (value clauses))))))))))
+
+(defun bash-fn (form hints verbose ctx state)
+
+; Keep this in sync with bash-term-to-dnf.
+
+  (mv-let
+   (erp clauses state)
+   (cond (verbose
+          (simplify-with-prover form hints ctx state))
+         (t
+          (state-global-let*
+           ((inhibit-output-lst *valid-output-names*))
+           (simplify-with-prover form hints ctx state))))
+   (cond
+    (erp
+     (pprogn
+      (warning$ ctx "bash"
+                "Unable to simplify the input term~@0"
+                (cond ((eq erp 'no-change)
+                       ".")
+                      (t (msg " because an error occurred.~@0"
+                              (cond
+                               (verbose "")
+                               (t "  Try setting the verbose flag to t in ~
+                                    order to see what is going on."))))))
+      (value (list form))))
+    (t
+     (value (prettyify-clause-lst clauses (let*-abstractionp state) (w state)))))))
+
+(defmacro bash (term &key verbose hints)
+  `(bash-fn ',term ',hints ',verbose 'bash state))
+
+; Dave Greve has contributed the following (only slightly modified here), to
+; create a variant bash-term-to-dnf of bash-fn.  This example may suggest other
+; variants; feel free to contribute yours to Matt Kaufmann,
+; kaufmann@cs.utexas.edu.
+
+(defun goals-to-cnf (goals)
+  (cond ((endp goals) nil)
+        (t (cons (append (access goal (car goals) :hyps)
+                         (list (dumb-negate-lit (access goal (car goals)
+                                                        :conc))))
+                 (goals-to-cnf (cdr goals))))))
+
+(defun untranslate-lst-lst (list iff-flg wrld)
+  (cond
+   ((endp list)
+    nil)
+   (t (cons (untranslate-lst (car list) iff-flg wrld)
+            (untranslate-lst-lst (cdr list) iff-flg wrld)))))
+
+(defun bash-term-to-dnf (form hints verbose untranslate-flg state)
+
+; Keep this in sync with bash-fn.
+
+  (let ((ctx 'bash-term-to-dnf))
+    (mv-let
+     (erp clauses state)
+     (cond (verbose
+            (simplify-with-prover form hints ctx state))
+           (t
+            (state-global-let*
+             ((gag-mode nil set-gag-mode-fn)
+              (inhibit-output-lst *valid-output-names*)
+              (print-clause-ids nil))
+             (simplify-with-prover form hints ctx state))))
+     (cond
+      (erp
+       (cond ((eq verbose :all)
+              (pprogn
+               (warning$ ctx "bash"
+                         "Unable to simplify the input term~@0"
+                         (cond ((eq erp 'no-change)
+                                ".")
+                               (t (msg " because an error occurred.~@0"
+                                       (cond
+                                        (verbose "")
+                                        (t "  Try setting the verbose flag to ~
+                                            t in order to see what is going ~
+                                            on."))))))
+               (value (list (list form)))))
+             (t
+              (value (list (list form))))))
+      (untranslate-flg
+       (value (untranslate-lst-lst clauses t (w state))))
+      (t
+       (value clauses))))))
+
+;; When we call bash with hints we may modify the enabled structure.
+;; If we do this inside of a computed hint it may result in slow array
+;; access warnings.  By wrapping the outermost state modifying call
+;; with preserve-pspv you can protect the state.
+
+(defmacro preserve-pspv (call &key (pspv 'pspv))
+  `(let ((pspv ,pspv))
+     (let* ((old-ens (access rewrite-constant
+                             (access prove-spec-var pspv :rewrite-constant)
+                             :current-enabled-structure))
+            (old-name (access enabled-structure old-ens :array-name)))
+       (mv-let (err val state) ,call
+               (let ((ens (compress1 old-name (access enabled-structure old-ens :theory-array))))
+                 (declare (ignore ens))
+                 (mv err val state))))))
+
+; Finally, documentation.  This documentation is in an XML format that can be
+; processed by utilities such as Jared Davis's xdoc processor.
+
+(defconst *bash-xml-doc*
+  '(:parents
+    (proof-automation)
+    :short
+    "<tt>Bash</tt> is a tool that simplifies a term, producing a list of
+simplified terms such that if all output terms are theorems, then so is the
+input term."
+    :long "
+
+<p>This utility is defined in community book <tt>\"misc/bash.lisp\"</tt>.  If
+you submit <tt>(bash term)</tt> then roughly speaking, the result is a list of
+goals produced by ACL2's simplification process.  That is, ACL2 might
+reasonably be expected to produce these goals when simplifying <tt>term</tt>
+during a proof attempt.  In particular, if the result is <tt>nil</tt>, then
+<tt>term</tt> is a theorem.  More accurately: <tt>(bash term)</tt> returns an
+<see topic=@(url ERROR-TRIPLES)>error triple</see>, <tt>(mv nil val
+state)</tt>, where <tt>val</tt> is a list of terms, in
+untranslated (user-level) form, whose provability implies the provability of
+the input term.  If ACL2 cannot simplify the input term (e.g., if there is a
+translation error), then it prints a warning and returns <tt>(mv nil input-term
+state)</tt>.</p>
+
+<p>For a related utility, see @(see bash-term-to-dnf).</p>
+
+<h3>Examples</h3>
+
+<p>First we execute:
+@({(include-book \"misc/bash\" :dir :system)})
+Then:
+@({
+ACL2 !>(bash (equal (append x y) (append (car (cons x a)) z)))
+Goal'
+ ((EQUAL (APPEND X Y) (APPEND X Z)))
+ACL2 !>(set-gag-mode nil) ; optional; turns off printing of goal names
+<state>
+ACL2 !>(bash (equal (append x y) (append (car (cons x a)) z)))
+ ((EQUAL (APPEND X Y) (APPEND X Z)))
+ACL2 !>(bash (equal (car (cons x y)) x))
+ NIL
+ACL2 !>(bash (implies (true-listp x) (equal (append x y) zzz))
+             :hints ((\"Goal\" :expand ((true-listp x)
+                                      (true-listp (cdr x))
+                                      (append x y)))))
+ ((EQUAL Y ZZZ)
+  (IMPLIES (AND (CONSP X)
+                (CONSP (CDR X))
+                (TRUE-LISTP (CDDR X)))
+           (EQUAL (LIST* (CAR X)
+                         (CADR X)
+                         (APPEND (CDDR X) Y))
+                  ZZZ))
+  (IMPLIES (AND (CONSP X) (NOT (CDR X)))
+           (EQUAL (CONS (CAR X) Y) ZZZ)))
+ACL2 !>(bash (equal x y))
+
+ACL2 Warning [bash] in BASH:  Unable to simplify the input term.
+
+ ((EQUAL X Y))
+ACL2 !>(bash (equal x))
+
+ACL2 Warning [bash] in BASH:  Unable to simplify the input term because
+an error occurred.  Try setting the verbose flag to t in order to see
+what is going on.
+
+ ((EQUAL X))
+ACL2 !>(bash (equal x) :verbose t)
+
+
+ACL2 Error in BASH:  EQUAL takes 2 arguments but in the call (EQUAL X)
+it is given 1 argument.   The formal parameters list for EQUAL is (X Y).
+
+
+ACL2 Warning [bash] in BASH:  Unable to simplify the input term because
+an error occurred.
+
+ ((EQUAL X))
+ACL2 !>
+})
+
+Here is how we might use this tool to simplify hypotheses.  First execute:
+
+@({
+ (defstub p1 (x) t)
+ (defstub p2 (x) t)
+ (defun p3 (x) (if (atom x) (p2 x) (p1 (car x))))
+ (include-book
+  \"misc/bash\" :dir :system)
+})
+
+Then:
+
+@({
+  ACL2 !>(bash (implies (and (p1 x) (p3 x))
+                        (hide aaa)))
+   ((IMPLIES (AND (P1 X) (CONSP X) (P1 (CAR X)))
+             (HIDE AAA))
+    (IMPLIES (AND (P1 X) (NOT (CONSP X)) (P2 X))
+             (HIDE AAA)))
+  ACL2 !>
+})
+
+<h3>More details</h3>
+
+<p>This utility is similar to the @(see proof-checker)'s <tt>bash</tt> command,
+but for use in the top-level loop.  The input term can have user-level syntax;
+it need not be translated.  The output is an error triple <tt>(mv nil termlist
+state)</tt> such that either <tt>termlist</tt> is a one-element list containing
+the input term, or else <tt>termlist</tt> is a list of term such that if each
+term in this list is a theorem, then the input term is a theorem.  In practice,
+these terms are produced by calling the prover with non-simplification
+processes --- <tt>generalize</tt>, <tt>eliminate-destructors</tt>,
+<tt>fertilize</tt> (heuristic use of equalities), and
+<tt>eliminate-irrelevance</tt>, as well as induction --- turned off, and with
+forcing rounds skipped (at least the first 15 of them).  A keyword argument,
+<tt>:hints</tt>, can specify @(see hints) using their usual syntax, as with
+@(see defthm).  The other keyword argument, <tt>:verbose</tt>, is <tt>nil</tt>
+by default, to suppress output; use a non-<tt>nil</tt> value if you want
+output, including the proof attempt.  The keyword values are not evaluated, so
+for example <tt>:hints</tt> could be of the form <tt>((\"Goal\" ...))</tt> but
+not <tt>'((\"Goal\" ...))</tt>.</p>
+
+<p>We conclude with an note on the use of @(see hints) that may be important if
+you use computed hints (see @(see computed-hints)).  Consider the following
+example, supplied courtesy of Harsh Raju Chamarthi.
+
+@({
+ (defun drop (n l)
+   (if (zp n)
+     l
+     (drop (1- n) (cdr l))))
+
+ (include-book \"misc/bash\" :dir :system)
+
+ ; Occur-fn returns the term that has fn has its function symbol.
+ (mutual-recursion
+  (defun occur-fn (fn term2)
+    (cond ((variablep term2) nil)
+          ((fquotep term2) nil)
+          (t (or (and (eq fn (ffn-symb term2)) term2)
+                 (occur-fn-lst fn (fargs term2))))))
+  (defun occur-fn-lst (fn args2)
+    (cond ((endp args2) nil)
+          (t (or (occur-fn fn (car args2))
+                 (occur-fn-lst fn (cdr args2)))))))
+
+ ; Doesn't work as you might expect (see below):
+ (bash (drop 3 x)
+       :verbose t
+       :hints ((if (occur-fn-lst 'drop clause)
+                   `(:computed-hint-replacement
+                     t
+                     :expand
+                     (,(occur-fn-lst 'drop clause)))
+                 nil)))
+})
+
+The preceding call of <tt>bash</tt>, at the end of the displayed list of forms
+above, causes the theorem prover to use destructor elimination, even though
+that proof process is presumably turned off by <tt>bash</tt>.  What happened?
+The problem is that the user-supplied hints are put in front of the hints
+generated by <tt>bash</tt> to form the full list of hints given to the prover,
+which cases the <tt>:do-not</tt> hint on \"Goal\" to be ignored.  Here is a
+solution.
+
+@({
+ (bash (drop 3 x)
+       :verbose t
+       :hints ((if (occur-fn-lst 'drop clause)
+                   `(:computed-hint-replacement
+                     t
+                     :do-not-induct :bash
+                     :do-not (set-difference-eq *do-not-processes*
+                                                '(preprocess simplify))
+                     :expand (,(occur-fn-lst 'drop clause)))
+                 '(:do-not-induct
+                   :bash
+                   :do-not
+                   (set-difference-eq *do-not-processes*
+                                      '(preprocess simplify))))))
+})"
+))
+
+(defconst *bash-term-to-dnf-xml-doc*
+  '(:parents
+    (proof-automation)
+    :short
+    "<tt>Bash-term-to-dnf</tt> is a tool that simplifies a term, producing a
+list of clauses such that if all output clauses are theorems, then so is the
+input term."
+    :long "
+
+<p>This utility is defined in community book <tt>\"misc/bash.lisp\"</tt>.  We
+assume here familiarity with the @('bash') tool defined in that book, focusing
+below on how the present tool differs from that one.</p>
+
+<p>If you submit <tt>(bash-term-to-dnf term)</tt> then the result is a list of
+goals produced by ACL2's simplification process, much as for the result of
+<tt>(bash term)</tt>; see @('bash').  However, unlike <tt>bash</tt>,
+<tt>bash-term-to-dnf</tt> returns a list of <i>clauses</i>, where each clause
+is a list of terms that represents the disjunction of those terms, and the list
+of clauses is implicitly conjoined.</p>
+
+<p>Again: For a related utility, see @('bash').</p>
+
+<h3>Example</h3>
+
+<p>First we execute:
+@({(include-book \"misc/bash\" :dir :system)})
+Then:
+@({
+ACL2 !>(bash-term-to-dnf
+        '(implies (true-listp x) (equal (append x y) zzz))
+        '((\"Goal\" :expand ((true-listp x)
+                           (true-listp (cdr x))
+                           (append x y))))
+        nil t state)
+ (((EQUAL Y ZZZ))
+  ((NOT (CONSP X))
+   (NOT (CONSP (CDR X)))
+   (NOT (TRUE-LISTP (CDDR X)))
+   (EQUAL (LIST* (CAR X)
+                 (CADR X)
+                 (APPEND (CDDR X) Y))
+          ZZZ))
+  ((NOT (CONSP X))
+   (CDR X)
+   (EQUAL (CONS (CAR X) Y) ZZZ)))
+ACL2 !>
+})
+
+<h3>General Form:</h3>
+
+<p>@({(bash-term-to-dnf form hints verbose untranslate-flg state)})
+returns a list of clauses, each of which is a list of terms, where:
+
+<ul>
+
+<li><tt>form</tt> is a user-level (untranslated) term;</li>
+
+<li><tt>hints</tt>, if supplied, is a @(see hints) structure (as for
+@('defthm'));</li>
+
+<li><tt>verbose</tt> is <tt>nil</tt> by default, in which case output is
+inhibited; on the other extreme, if <tt>verbose</tt> is <tt>:all</tt> then a
+warning is printed when no simplification takes place; and</li>
+
+<li><tt>untranslate-flg</tt> is <tt>nil</tt> by default, in which case each
+term in each returned clause is a term in internal (translated) form and
+otherwise, each such term is in user-level (untranslated) form;</li>
+
+</ul>
+
+If each returned clause (viewed as a disjunction) is a theorem, then the input
+<tt>form</tt> is a theorem."
+))
diff -Nru acl2-6.2/books/misc/bash.lisp acl2-6.3/books/misc/bash.lisp
--- acl2-6.2/books/misc/bash.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/bash.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,69 +1,64 @@
-; Copyright (C) 2006  University of Texas at Austin
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (original date October, 2006)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
+; NOTE: This book includes GPL community book xdoc/top.  Therefore, as per
+; Section 2(b) of the Gnu Public License Version 2, software distributions of
+; books that include this book must have a GPL license.  If you want to use the
+; software documented in this book under a 3-clause BSD license, consider
+; the book bash-bsd.lisp instead.
 
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of Version 2 of the GNU General Public License as published by the
-; Free Software Foundation.
-
-; This program is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this program; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-; Written by:  Matt Kaufmann
-; email:       Kaufmann@cs.utexas.edu
-; Department of Computer Science
-; University of Texas at Austin
-; Austin, TX 78701 U.S.A.
-
-; October, 2006
-
-; In a nutshell:
-
-; If you submit (bash term), then the result is a list of goals to which ACL2
-; can simplify term when attempting to prove it.  (In particular, if the result
-; is nil, then ACL2 can prove term.)  More accurately: (bash term) returns (mv
-; nil val state), where: val is a list of terms, in untranslated (user-level)
-; form, whose provability implies the provability of the input term.  If ACL2
-; cannot simplify the input term (e.g., if there is a translation error), then
-; it prints a warning and returns (mv nil input-term state).
-
-; More details:
-
-; This book defines a utility similar to the proof-checker's bash command, but
-; for use in the top-level loop.  The input term can be a user-level term,
-; i.e., it need not be translated.  Thus this bash utility is given a term, and
-; it returns an error triple (mv nil termlist state) where if no error occurs
-; in the process, then termlist is the list of goals that ACL2 would get stuck
-; on, if you were to attempt to prove the given term with only simplification,
-; i.e., with a "Goal" hint of :do-not '(generalize eliminate-destructors
-; fertilize eliminate-irrelevance) and with induction turned off.  Bash does
-; all the normal simplification stuff, including forward chaining.  Use :hints
-; to specify hints using the same syntax as for thm and defthm.  Use a non-nil
-; value of :verbose if you want output, including the proof attempt.  The
-; keyword values are not evaluated, so :hints could be of the form (("Goal
-; ...)) but not '(("Goal" ...)).
-
-; This book also includes a functional (non-macro) version of bash, bash-fn.
-; At the end is a variant contributed by Dave Greve, bash-term-to-dnf, that
-; returns a list of goals (implicitly conjoined) where each goal has the form
-; (lit1 lit2 ... litk), for which the goal is equivalent to the negation of the
-; conjunction of the liti.
+(in-package "ACL2")
+
+(include-book "xdoc/top" :dir :system)
+
+(include-book "bash-bsd")
 
-; Examples:
+(defxdoc bash
+  :parents
+  (proof-automation)
+  :short "
+
+<tt>Bash</tt> is a tool that simplifies a term, producing a list of
+simplified terms such that if all output terms are theorems, then so is the
+input term."
+
+  :long "
+
+<p>This utility is defined in community book <tt>\"misc/bash.lisp\"</tt>.  If
+you submit <tt>(bash term)</tt> then roughly speaking, the result is a list of
+goals produced by ACL2's simplification process.  That is, ACL2 might
+reasonably be expected to produce these goals when simplifying <tt>term</tt>
+during a proof attempt.  In particular, if the result is <tt>nil</tt>, then
+<tt>term</tt> is a theorem.  More accurately: <tt>(bash term)</tt> returns an
+<see topic=\"@(url ERROR-TRIPLES)\">error triple</see>, <tt>(mv nil val
+state)</tt>, where <tt>val</tt> is a list of terms, in
+untranslated (user-level) form, whose provability implies the provability of
+the input term.  If ACL2 cannot simplify the input term (e.g., if there is a
+translation error), then it prints a warning and returns <tt>(mv nil input-term
+state)</tt>.</p>
 
-#|
+<p>For a related utility, see @(see bash-term-to-dnf).</p>
+
+<h3>Examples</h3>
+
+<p>First we execute:
+@({(include-book \"misc/bash\" :dir :system)})
+Then:
+@({
+ACL2 !>(bash (equal (append x y) (append (car (cons x a)) z)))
+Goal'
+ ((EQUAL (APPEND X Y) (APPEND X Z)))
+ACL2 !>(set-gag-mode nil) ; optional; turns off printing of goal names
+<state>
 ACL2 !>(bash (equal (append x y) (append (car (cons x a)) z)))
  ((EQUAL (APPEND X Y) (APPEND X Z)))
 ACL2 !>(bash (equal (car (cons x y)) x))
  NIL
 ACL2 !>(bash (implies (true-listp x) (equal (append x y) zzz))
-	     :hints (("Goal" :expand ((true-listp x)
-				      (true-listp (cdr x))
-				      (append x y)))))
+             :hints ((\"Goal\" :expand ((true-listp x)
+                                      (true-listp (cdr x))
+                                      (append x y)))))
  ((EQUAL Y ZZZ)
   (IMPLIES (AND (CONSP X)
                 (CONSP (CDR X))
@@ -74,215 +69,206 @@
                   ZZZ))
   (IMPLIES (AND (CONSP X) (NOT (CDR X)))
            (EQUAL (CONS (CAR X) Y) ZZZ)))
-ACL2 !>(bash-term-to-dnf
-	'(implies (true-listp x) (equal (append x y) zzz))
-	'(("Goal" :expand ((true-listp x)
-			   (true-listp (cdr x))
-			   (append x y))))
-	nil nil state)
- (((EQUAL Y ZZZ))
-  ((NOT (CONSP X))
-   (NOT (CONSP (CDR X)))
-   (NOT (TRUE-LISTP (CDDR X)))
-   (EQUAL (LIST* (CAR X)
-                 (CADR X)
-                 (APPEND (CDDR X) Y))
-          ZZZ))
-  ((NOT (CONSP X))
-   (CDR X)
-   (EQUAL (CONS (CAR X) Y) ZZZ)))
-ACL2 !>
+ACL2 !>(bash (equal x y))
+
+ACL2 Warning [bash] in BASH:  Unable to simplify the input term.
+
+ ((EQUAL X Y))
+ACL2 !>(bash (equal x))
+
+ACL2 Warning [bash] in BASH:  Unable to simplify the input term because
+an error occurred.  Try setting the verbose flag to t in order to see
+what is going on.
 
-.....
+ ((EQUAL X))
+ACL2 !>(bash (equal x) :verbose t)
 
-Here's how one might simplify hypotheses.
 
-(defstub p1 (x) t)
-(defstub p2 (x) t)
-(defun p3 (x) (if (atom x) (p2 x) (p1 (car x))))
-(include-book
- "misc/bash" :dir :system)
+ACL2 Error in BASH:  EQUAL takes 2 arguments but in the call (EQUAL X)
+it is given 1 argument.   The formal parameters list for EQUAL is (X Y).
+
+
+ACL2 Warning [bash] in BASH:  Unable to simplify the input term because
+an error occurred.
+
+ ((EQUAL X))
+ACL2 !>
+})</p>
+
+<p>Here is how we might use this tool to simplify hypotheses.  First execute:
+
+@({
+ (defstub p1 (x) t)
+ (defstub p2 (x) t)
+ (defun p3 (x) (if (atom x) (p2 x) (p1 (car x))))
+ (include-book
+  \"misc/bash\" :dir :system)
+})
 
 Then:
 
+@({
   ACL2 !>(bash (implies (and (p1 x) (p3 x))
-			(hide aaa)))
+                        (hide aaa)))
    ((IMPLIES (AND (P1 X) (CONSP X) (P1 (CAR X)))
-	     (HIDE AAA))
+             (HIDE AAA))
     (IMPLIES (AND (P1 X) (NOT (CONSP X)) (P2 X))
-	     (HIDE AAA)))
+             (HIDE AAA)))
   ACL2 !>
+})</p>
 
-Here's how to do what I think you may want to do.
+<h3>More details</h3>
 
-(defun strip-lastcar (lst)
-  (if (atom lst)
-      lst
-    (cons (butlast (car lst) 1)
-	  (strip-lastcar (cdr lst)))))
+<p>This utility is similar to the @(see proof-checker)'s <tt>bash</tt> command,
+but for use in the top-level loop.  The input term can have user-level syntax;
+it need not be translated.  The output is an error triple <tt>(mv nil termlist
+state)</tt> such that either <tt>termlist</tt> is a one-element list containing
+the input term, or else <tt>termlist</tt> is a list of term such that if each
+term in this list is a theorem, then the input term is a theorem.  In practice,
+these terms are produced by calling the prover with non-simplification
+processes --- <tt>generalize</tt>, <tt>eliminate-destructors</tt>,
+<tt>fertilize</tt> (heuristic use of equalities), and
+<tt>eliminate-irrelevance</tt>, as well as induction --- turned off, and with
+forcing rounds skipped (at least the first 15 of them).  A keyword argument,
+<tt>:hints</tt>, can specify @(see hints) using their usual syntax, as with
+@(see defthm).  The other keyword argument, <tt>:verbose</tt>, is <tt>nil</tt>
+by default, to suppress output; use a non-<tt>nil</tt> value if you want
+output, including the proof attempt.  The keyword values are not evaluated, so
+for example <tt>:hints</tt> could be of the form <tt>((\"Goal\" ...))</tt> but
+not <tt>'((\"Goal\" ...))</tt>.</p>
+
+<p>We conclude with an note on the use of @(see hints) that may be important if
+you use computed hints (see @(see computed-hints)).  Consider the following
+example, supplied courtesy of Harsh Raju Chamarthi.
+
+@({
+ (defun drop (n l)
+   (if (zp n)
+     l
+     (drop (1- n) (cdr l))))
+
+ (include-book \"misc/bash\" :dir :system)
+
+ ; Occur-fn returns the term that has fn has its function symbol.
+ (mutual-recursion
+  (defun occur-fn (fn term2)
+    (cond ((variablep term2) nil)
+          ((fquotep term2) nil)
+          (t (or (and (eq fn (ffn-symb term2)) term2)
+                 (occur-fn-lst fn (fargs term2))))))
+  (defun occur-fn-lst (fn args2)
+    (cond ((endp args2) nil)
+          (t (or (occur-fn fn (car args2))
+                 (occur-fn-lst fn (cdr args2)))))))
+
+ ; Doesn't work as you might expect (see below):
+ (bash (drop 3 x)
+       :verbose t
+       :hints ((if (occur-fn-lst 'drop clause)
+                   `(:computed-hint-replacement
+                     t
+                     :expand
+                     (,(occur-fn-lst 'drop clause)))
+                 nil)))
+})
+
+The preceding call of <tt>bash</tt>, at the end of the displayed list of forms
+above, causes the theorem prover to use destructor elimination, even though
+that proof process is presumably turned off by <tt>bash</tt>.  What happened?
+The problem is that the user-supplied hints are put in front of the hints
+generated by <tt>bash</tt> to form the full list of hints given to the prover,
+which cases the <tt>:do-not</tt> hint on \"Goal\" to be ignored.  Here is a
+solution.
+
+@({
+ (bash (drop 3 x)
+       :verbose t
+       :hints ((if (occur-fn-lst 'drop clause)
+                   `(:computed-hint-replacement
+                     t
+                     :do-not-induct :bash
+                     :do-not (set-difference-eq *do-not-processes*
+                                                '(preprocess simplify))
+                     :expand (,(occur-fn-lst 'drop clause)))
+                 '(:do-not-induct
+                   :bash
+                   :do-not
+                   (set-difference-eq *do-not-processes*
+                                      '(preprocess simplify))))))
+})</p>")
+
+(defxdoc bash-term-to-dnf
+  :parents
+  (proof-automation)
+  :short "
+
+<tt>Bash-term-to-dnf</tt> is a tool that simplifies a term, producing a list of
+clauses such that if all output clauses are theorems, then so is the input
+term."
+
+  :long "
+
+<p>This utility is defined in community book <tt>\"misc/bash.lisp\"</tt>.  We
+assume here familiarity with the @('bash') tool defined in that book, focusing
+below on how the present tool differs from that one.</p>
+
+<p>If you submit <tt>(bash-term-to-dnf term)</tt> then the result is a list of
+goals produced by ACL2's simplification process, much as for the result of
+<tt>(bash term)</tt>; see @('bash').  However, unlike <tt>bash</tt>,
+<tt>bash-term-to-dnf</tt> returns a list of <i>clauses</i>, where each clause
+is a list of terms that represents the disjunction of those terms, and the list
+of clauses is implicitly conjoined.</p>
 
+<p>Again: For a related utility, see @('bash').</p>
+
+<h3>Example</h3>
+
+<p>First we execute:
+@({(include-book \"misc/bash\" :dir :system)})
 Then:
+@({
+ACL2 !>(bash-term-to-dnf
+        '(implies (true-listp x) (equal (append x y) zzz))
+        '((\"Goal\" :expand ((true-listp x)
+                           (true-listp (cdr x))
+                           (append x y))))
+        nil t state)
+ (((EQUAL Y ZZZ))
+  ((NOT (CONSP X))
+   (NOT (CONSP (CDR X)))
+   (NOT (TRUE-LISTP (CDDR X)))
+   (EQUAL (LIST* (CAR X)
+                 (CADR X)
+                 (APPEND (CDDR X) Y))
+          ZZZ))
+  ((NOT (CONSP X))
+   (CDR X)
+   (EQUAL (CONS (CAR X) Y) ZZZ)))
+ACL2 !>
+})</p>
 
-  ACL2 !>(er-let* ((clauses (bash-term-to-dnf
-			     '(implies (and (p1 x) (p3 x))
-				       (hide aaa))
-			     nil nil t state)))
-		  (mv nil (strip-lastcar clauses) state))
-   (((NOT (P1 X))
-     (NOT (CONSP X))
-     (NOT (P1 (CAR X))))
-    ((NOT (P1 X)) (CONSP X) (NOT (P2 X))))
-  ACL2 !>
+<h3>General Form:</h3>
 
-|# ; |
+<p>@({(bash-term-to-dnf form hints verbose untranslate-flg state)})
+returns a list of clauses, each of which is a list of terms, where:
 
-(in-package "ACL2")
+<ul>
+
+<li><tt>form</tt> is a user-level (untranslated) term;</li>
 
-(program)
+<li><tt>hints</tt>, if supplied, is a @(see hints) structure (as for
+@('defthm'));</li>
 
-(set-state-ok t)
+<li><tt>verbose</tt> is <tt>nil</tt> by default, in which case output is
+inhibited; on the other extreme, if <tt>verbose</tt> is <tt>:all</tt> then a
+warning is printed when no simplification takes place; and</li>
 
-(defun simplify-with-prover (form hints ctx state)
+<li><tt>untranslate-flg</tt> is <tt>nil</tt> by default, in which case each
+term in each returned clause is a term in internal (translated) form and
+otherwise, each such term is in user-level (untranslated) form;</li>
 
-; This is patterned after (define-pc-primitive prove ...).
+</ul>
 
-  (let ((wrld (w state))
-        (ens (ens state))
-        (name-tree 'bash))
-    (er-let*
-     ((thints (translate-hints
-               name-tree
-
-; Keep the following in sync with the definition of the proof-checker :bash
-; command.
-
-               (append
-                *bash-skip-forcing-round-hints*
-                (add-string-val-pair-to-string-val-alist
-                 "Goal"
-                 :do-not
-                 (list 'quote '(generalize eliminate-destructors fertilize
-                                           eliminate-irrelevance))
-                 (add-string-val-pair-to-string-val-alist
-                  "Goal"
-                  :do-not-induct
-                  name-tree
-                  hints))
-                (default-hints wrld))
-               ctx wrld state))
-      (tterm (translate form t t t ctx wrld state)))
-     (mv-let (erp ttree state)
-             (state-global-let*
-              ((guard-checking-on nil)
-               (in-prove-flg t))
-              (pc-prove tterm form thints t ens wrld ctx state))
-             (cond (erp (mv t nil state))
-                   (t (let ((clauses (unproved-pc-prove-clauses ttree)))
-                        (cond ((and (eql (length clauses) 1)
-                                    (eql (length (car clauses)) 1)
-                                    (eql (caar clauses) tterm))
-                               (mv 'no-change nil state))
-                              (t (value clauses))))))))))
-
-(defun bash-fn (form hints verbose ctx state)
-
-; Keep this in sync with bash-term-to-dnf.
-
-  (mv-let
-   (erp clauses state)
-   (cond (verbose
-          (simplify-with-prover form hints ctx state))
-         (t
-          (state-global-let*
-           ((inhibit-output-lst *valid-output-names*))
-           (simplify-with-prover form hints ctx state))))
-   (cond
-    (erp
-     (pprogn
-      (warning$ ctx "bash"
-                "Unable to simplify the input term~@0"
-                (cond ((eq erp 'no-change)
-                       ".")
-                      (t (msg " because an error occurred.~@0"
-                              (cond
-                               (verbose "")
-                               (t "  Try setting the verbose flag to t in ~
-                                    order to see what is going on."))))))
-      (value (list form))))
-    (t
-     (value (prettyify-clause-lst clauses (let*-abstractionp state) (w state)))))))
-
-(defmacro bash (term &key verbose hints)
-  `(bash-fn ',term ',hints ',verbose 'bash state))
-
-; Dave Greve has contributed the following (only slightly modified here), to
-; create a variant bash-term-to-dnf of bash-fn.  This example may suggest other
-; variants; feel free to contribute yours to Matt Kaufmann,
-; kaufmann@cs.utexas.edu.
-
-(defun goals-to-cnf (goals)
-  (cond ((endp goals) nil)
-        (t (cons (append (access goal (car goals) :hyps)
-                         (list (dumb-negate-lit (access goal (car goals)
-                                                        :conc))))
-                 (goals-to-cnf (cdr goals))))))
-
-(defun untranslate-lst-lst (list iff-flg wrld)
-  (cond
-   ((endp list)
-    nil)
-   (t (cons (untranslate-lst (car list) iff-flg wrld)
-	    (untranslate-lst-lst (cdr list) iff-flg wrld)))))
-
-(defun bash-term-to-dnf (form hints verbose untranslate-flg state)
-
-; Keep this in sync with bash-fn.
-
-  (let ((ctx 'bash-term-to-dnf))
-    (mv-let
-     (erp clauses state)
-     (cond (verbose
-            (simplify-with-prover form hints ctx state))
-           (t
-            (state-global-let*
-             ((gag-mode nil set-gag-mode-fn)
-              (inhibit-output-lst *valid-output-names*)
-              (print-clause-ids nil))
-             (simplify-with-prover form hints ctx state))))
-     (cond
-      (erp
-       (cond ((eq verbose :all)
-              (pprogn
-               (warning$ ctx "bash"
-                         "Unable to simplify the input term~@0"
-                         (cond ((eq erp 'no-change)
-                                ".")
-                               (t (msg " because an error occurred.~@0"
-                                       (cond
-                                        (verbose "")
-                                        (t "  Try setting the verbose flag to ~
-                                            t in order to see what is going ~
-                                            on."))))))
-               (value (list (list form)))))
-             (t
-              (value (list (list form))))))
-      (untranslate-flg
-       (value (untranslate-lst-lst clauses t (w state))))
-      (t
-       (value clauses))))))
-
-;; When we call bash with hints we may modify the enabled structure.
-;; If we do this inside of a computed hint it may result in slow array
-;; access warnings.  By wrapping the outermost state modifying call
-;; with preserve-pspv you can protect the state.
-
-(defmacro preserve-pspv (call &key (pspv 'pspv))
-  `(let ((pspv ,pspv))
-     (let* ((old-ens (access rewrite-constant
-			     (access prove-spec-var pspv :rewrite-constant)
-			     :current-enabled-structure))
-	    (old-name (access enabled-structure old-ens :array-name)))
-       (mv-let (err val state) ,call
-	       (let ((ens (compress1 old-name (access enabled-structure old-ens :theory-array))))
-		 (declare (ignore ens))
-		 (mv err val state))))))
+If each returned clause (viewed as a disjunction) is a theorem, then the input
+<tt>form</tt> is a theorem.</p>"
+  )
\ No newline at end of file
diff -Nru acl2-6.2/books/misc/beta-reduce.lisp acl2-6.3/books/misc/beta-reduce.lisp
--- acl2-6.2/books/misc/beta-reduce.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/beta-reduce.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -16,6 +16,51 @@
   (if arg (pseudo-term-listp term)
     (pseudo-termp term)))
 
+(local
+ (encapsulate nil
+   (local (defun pos-ac-ind (x n)
+            (if (endp x) n
+              (list (pos-ac-ind (cdr x) (+ 1 n))
+                    (pos-ac-ind (cdr x) 1)))))
+
+   (defthm position-equal-ac-iff-zero
+     (implies (and n
+                   (syntaxp (not (equal n ''0))))
+              (iff (position-equal-ac k x n)
+                   (position-equal-ac k x 0)))
+     :hints (("goal" :induct (pos-ac-ind x n))))
+
+   (local (defthm blah
+            (implies (syntaxp (and (quotep a) (quotep b)))
+                     (equal (+ a b c)
+                            (+ (+ a b) c)))))
+
+   (local (defun pos-ac-ind2 (x n)
+            (if (endp x) n
+              (list (pos-ac-ind2 (cdr x) (+ 1 n))
+                    (pos-ac-ind2 (cdr x) 0)))))
+
+   (defthm position-equal-ac-redef
+     (equal (position-equal-ac k x n)
+            (cond ((endp x) nil)
+                  ((equal k (car x)) n)
+                  (t (let ((res (position-equal-ac k (cdr x) 0)))
+                       (and res (+ 1 n res))))))
+     :hints (("goal" :induct (pos-ac-ind2 x n)))
+     :rule-classes ((:definition :clique (position-equal-ac)
+                     :controller-alist ((position-equal-ac nil t nil)))))
+
+   (defthm position-equal-ac-iff-member
+     (implies n
+              (iff (position-equal-ac k x n)
+                   (member k x))))
+
+   (defthm nth-of-position-is-assoc-of-pairlis
+     (implies (member k x)
+              (equal (nth (position-equal-ac k x 0) y)
+                     (cdr (assoc k (pairlis$ x y)))))
+     :hints (("goal" :induct (pairlis$ x y))))))
+
 (defun beta-reduce-term (arg term keys vals)
   (declare (type (satisfies true-listp) keys vals))
   (declare (xargs :guard (pseudo-termp-key arg term)))
@@ -28,9 +73,12 @@
    (t
     (cond
      ((and (symbolp term) term)
-      (if (member term keys)
-	  (cdr (assoc-eq term (pairlis$ keys vals)))
-	'(quote nil)))
+      (mbe :logic
+           (if (member term keys)
+               (cdr (assoc-eq term (pairlis$ keys vals)))
+             '(quote nil))
+           :exec (let ((pos (position-eq term keys)))
+                   (if pos (nth pos vals) '(quote nil)))))
      ((atom term) term)
      ((eq (car term) 'quote) term)
      ((consp (car term))
diff -Nru acl2-6.2/books/misc/book-checks.lisp acl2-6.3/books/misc/book-checks.lisp
--- acl2-6.2/books/misc/book-checks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/misc/book-checks.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -0,0 +1,213 @@
+; Checking theories for libraries
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+
+; book-checks.lisp
+;
+; Original author: Sol Swords <sswords@centtech.com>
+
+
+(in-package "ACL2")
+
+;; This book provides some utilities for checking that libraries don't
+;; enable/disable existing rules unexpectedly.
+
+;; :RULE-STATUS-CHANGES <command-descriptor> shows a list of rules that
+;;   - existed before the command
+;;   - have a different enabled status after the command than before.
+;; :RULE-STATUS-CHANGES-SINCE <command-descriptor> is similar but shows the
+;;   rules whose status changed after the command.
+;; :FIND-THEORY-CHANGES <rune> <command-descriptor> shows the events within the
+;;   given command that caused the given rune to become enabled/disabled.  Each
+;;   entry shows whether it was enabled/disabled and the hierarchy of nested
+;;   events under which it happened.
+;; :FIND-THEORY-CHANGES-SINCE <rune> <command-descriptor> shows the events since
+;;   the given command that caused the given rune to become enabled/disabled.
+
+;; Here a command-descriptor is the sort of thing you give to ACL2 history
+;; queries like :pcb, :pbt, etc.  So, :x, :x-1, 1, 2, function-name, theorem-name, etc.
+
+(program)
+(set-state-ok t)
+
+;; All this is really doing is computing the two set differences
+;; prev-enabled - (existent ^ post-enabled)
+;; and
+;; (existent ^ post-enabled) - prev-enabled
+;; so this could probably be made quite a bit faster if necessary.
+;; On the other hand, it'd be nice not to include any other books in this book
+;; in order to do so.
+(defun collect-rule-status-changes (existent prev-enabled post-enabled)
+  (if (atom existent)
+      nil
+    (let ((prev (consp (member-equal (car existent) prev-enabled)))
+          (post (consp (member-equal (car existent) post-enabled))))
+      (if (eq prev post)
+          (collect-rule-status-changes (cdr existent) prev-enabled post-enabled)
+        (cons (list (if prev 'disable 'enable) (car existent))
+              (collect-rule-status-changes (cdr existent) prev-enabled post-enabled))))))
+
+(defun rule-status-changes-between (prev-wrld curr-wrld)
+  (declare (xargs :mode :program))
+  (let* ((curr-theory (current-theory1 curr-wrld nil nil))
+         (prev-theory (current-theory1 prev-wrld nil nil))
+         (prev-univ (universal-theory-fn1 prev-wrld nil nil)))
+    (collect-rule-status-changes prev-univ prev-theory curr-theory)))
+
+(defun rule-status-changes-fn (cd state)
+  (declare (xargs :mode :program :stobjs state))
+  (er-let*
+   ((cmd-wrld (acl2::er-decode-cd cd (w state) 'rule-status-changes
+                                  state)))
+   (let ((prev-wrld (scan-to-command (cdr cmd-wrld))))
+     (value (rule-status-changes-between prev-wrld cmd-wrld)))))
+
+(defun rule-status-changes-since-fn (cd state)
+  (declare (xargs :mode :program :stobjs state))
+  (er-let*
+   ((cmd-wrld (acl2::er-decode-cd cd (w state) 'rule-status-changes
+                                  state)))
+   (value (rule-status-changes-between cmd-wrld (w state)))))
+
+(defmacro rule-status-changes (cd)
+  `(rule-status-changes-fn ,cd state))
+
+(defmacro rule-status-changes-since (cd)
+  `(rule-status-changes-since-fn ,cd state))
+
+
+
+
+(defun scan-world-for-theory-changes (rune enabled-before depth stack wrld)
+  (if (atom wrld)
+      (mv enabled-before nil)
+    (case (caar wrld)
+      (CURRENT-THEORY
+       (mv-let (prev-enabled rest)
+         (scan-world-for-theory-changes
+          rune enabled-before depth stack (cdr wrld))
+         (let* ((post-enabled (consp (member-equal rune (cddar wrld)))))
+           (if (eq prev-enabled post-enabled)
+               (mv prev-enabled rest)
+             (mv post-enabled (cons (cons (if post-enabled 'enable 'disable)
+                                          stack)
+                                    rest))))))
+      (acl2::event-landmark
+       (let* ((new-depth (if (consp (caddar wrld))
+                             (cdr (caddar wrld))
+                           0))
+              (stack (cons (nthcdr 4 (car wrld))
+                           (nthcdr (+ 1 (- depth new-depth)) stack))))
+         (scan-world-for-theory-changes
+          rune enabled-before new-depth stack (cdr wrld))))
+      (otherwise
+       (scan-world-for-theory-changes
+        rune enabled-before depth stack (cdr wrld))))))
+
+(defun find-theory-changes-since-fn (rune cd state)
+  (er-let*
+   ((cmd-wrld (acl2::er-decode-cd cd (w state) 'find-theory-change-since
+                                  state)))
+   (let* ((enabled-before (consp (member-equal rune (current-theory1 cmd-wrld nil nil))))
+          (segment (take (- (len (w state)) (len cmd-wrld)) (w state))))
+     (mv-let (enabled res)
+       (scan-world-for-theory-changes rune enabled-before 0 nil segment)
+       (declare (ignore enabled))
+       (value res)))))
+
+(defun find-theory-changes-fn (rune cd state)
+  (er-let*
+   ((cmd-wrld (acl2::er-decode-cd cd (w state) 'find-theory-change-since state)))
+   (let* ((prev-wrld (scan-to-command (cdr cmd-wrld)))
+          (enabled-before (consp (member-equal rune (current-theory1 prev-wrld nil nil))))
+          (segment (take (- (len cmd-wrld) (len prev-wrld)) cmd-wrld)))
+     (mv-let (enabled res)
+       (scan-world-for-theory-changes rune enabled-before 0 nil segment)
+       (declare (ignore enabled))
+       (value res)))))
+
+
+(defmacro find-theory-changes (rune cd)
+  `(find-theory-changes-fn ,rune ,cd state))
+
+(defmacro find-theory-changes-since (rune cd)
+  `(find-theory-changes-since-fn ,rune ,cd state))
+
+;; Example use:
+;; (include-book "misc/book-checks" :dir :system)
+;; (include-book "centaur/gl/gl" :dir :system)
+;; :rule-status-changes :x
+;;   ->
+;; ((DISABLE (:DEFINITION META-EXTRACT-GLOBAL-FACT+))
+;;  (DISABLE (:DEFINITION META-EXTRACT-CONTEXTUAL-FACT))
+;;  (DISABLE (:DEFINITION ACL2::DUMB-NEGATE-LIT))
+;;  (DISABLE (:DEFINITION CONJOIN-CLAUSES))
+;;  (DISABLE (:INDUCTION DISJOIN))
+;;  (DISABLE (:DEFINITION DISJOIN))
+;;  (DISABLE (:DEFINITION ACL2::DISJOIN2))
+;;  (DISABLE (:INDUCTION CONJOIN))
+;;  (DISABLE (:DEFINITION CONJOIN))
+;;  (DISABLE (:DEFINITION ACL2::CONJOIN2))
+;;  (DISABLE (:REWRITE DEFAULT-CDR))
+;;  (DISABLE (:REWRITE DEFAULT-CAR))
+;;  (DISABLE (:INDUCTION INTERSECTION-EQUAL))
+;;  (DISABLE (:DEFINITION INTERSECTION-EQUAL))
+;;  (DISABLE (:INDUCTION MV-NTH))
+;;  (DISABLE (:DEFINITION MV-NTH))
+;;  (DISABLE (:DEFINITION CHAR<))
+;;  (DISABLE (:INDUCTION INTERSECTP-EQUAL))
+;;  (DISABLE (:DEFINITION INTERSECTP-EQUAL))
+;;  (DISABLE (:TYPE-PRESCRIPTION TAKE))
+;;  (DISABLE (:DEFINITION TAKE))
+;;  (DISABLE (:INDUCTION SET-DIFFERENCE-EQUAL))
+;;  (DISABLE (:DEFINITION SET-DIFFERENCE-EQUAL))
+;;  (DISABLE (:REWRITE UPPER-CASE-P-CHAR-UPCASE))
+;;  (DISABLE (:REWRITE LOWER-CASE-P-CHAR-DOWNCASE))
+;;  (DISABLE (:REWRITE COERCE-INVERSE-2))
+;;  (DISABLE (:REWRITE COERCE-INVERSE-1))
+;;  (DISABLE (:INDUCTION SUBSETP-EQUAL))
+;;  (DISABLE (:DEFINITION SUBSETP-EQUAL))
+;;  (DISABLE (:INDUCTION MAKE-CHARACTER-LIST))
+;;  (DISABLE (:DEFINITION MAKE-CHARACTER-LIST))
+;;  (DISABLE (:DEFINITION LENGTH)))
+
+;; (acl2::find-theory-changes (:definition meta-extract-global-fact+) :x)
+;; ((DISABLE
+;;   (IN-THEORY (DISABLE META-EXTRACT-CONTEXTUAL-FACT
+;;                       META-EXTRACT-GLOBAL-FACT))
+;;   (INCLUDE-BOOK
+;;    "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/clause-processors/meta-extract-user.lisp"
+;;    :DIR :SYSTEM)
+;;   (INCLUDE-BOOK
+;;    "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/misc/interp-function-lookup.lisp")
+;;   (INCLUDE-BOOK
+;;     "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/misc/defapply.lisp")
+;;   (INCLUDE-BOOK
+;;    "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/gl/generic-geval.lisp")
+;;   (INCLUDE-BOOK
+;;        "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/gl/gtypes.lisp")
+;;   (INCLUDE-BOOK
+;;    "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/gl/general-objects.lisp")
+;;   (INCLUDE-BOOK
+;;      "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/gl/ite-merge.lisp")
+;;   (INCLUDE-BOOK
+;;        "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/gl/g-if.lisp")
+;;   (INCLUDE-BOOK
+;;       "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/gl/g-logapp.lisp")
+;;   (INCLUDE-BOOK
+;;        "/n_mounts/f0-fs18/fv2/sswords/e/acl2/books/centaur/gl/gl.lisp")))
diff -Nru acl2-6.2/books/misc/callers-and-ancestors.lisp acl2-6.3/books/misc/callers-and-ancestors.lisp
--- acl2-6.2/books/misc/callers-and-ancestors.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/callers-and-ancestors.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, December, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; This book provides utilities to answer the followign queries (as requested by
 ; Warren Hunt) for a given function, fn.  BUT NOTE the following catches:
 ; encapsulated functions and built-in :program mode functions are all treated
diff -Nru acl2-6.2/books/misc/character-encoding-test.lisp acl2-6.3/books/misc/character-encoding-test.lisp
--- acl2-6.2/books/misc/character-encoding-test.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/character-encoding-test.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,24 +1,6 @@
-; This program is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation; either version 2 of the License, or
-; (at your option) any later version.
-
-; This program is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this program; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-; Written by:  Matt Kaufmann
-; email:       Kaufmann@cs.utexas.edu
-; Department of Computer Science
-; University of Texas at Austin
-; Austin, TX 78701 U.S.A.
-
-; April, 2012
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, April, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 (in-package "ACL2")
 
diff -Nru acl2-6.2/books/misc/check-state.lisp acl2-6.3/books/misc/check-state.lisp
--- acl2-6.2/books/misc/check-state.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/check-state.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, Feb., 2013
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 ; See comment below for check-hons-enabled.
diff -Nru acl2-6.2/books/misc/computed-hint-rewrite.lisp acl2-6.3/books/misc/computed-hint-rewrite.lisp
--- acl2-6.2/books/misc/computed-hint-rewrite.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/computed-hint-rewrite.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,5 +1,6 @@
-; Matt Kaufmann
-; May 2008
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, May, 2008
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; This book defines a function, computed-hint-rewrite, that makes it easy to
 ; call the ACL2 rewriter in a computed hint.  For details see the comment in
diff -Nru acl2-6.2/books/misc/congruent-stobjs-test.lisp acl2-6.3/books/misc/congruent-stobjs-test.lisp
--- acl2-6.2/books/misc/congruent-stobjs-test.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/congruent-stobjs-test.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, April, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 ; We start with an example from :doc defstobj.
diff -Nru acl2-6.2/books/misc/dead-events.lisp acl2-6.3/books/misc/dead-events.lisp
--- acl2-6.2/books/misc/dead-events.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/dead-events.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,8 +1,8 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Shilpi Goel and Matt Kaufmann (original date January, 2012)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Dead events (dead code and theorems) analysis tool
-; Initial authors:
-;   Shilpi Goel
-;   Matt Kaufmann
-;   January, 2012
 
 ; For some relevant background, see :DOC dead-events in the ACL2
 ; documentation.
diff -Nru acl2-6.2/books/misc/defabsstobj-example-4.acl2 acl2-6.3/books/misc/defabsstobj-example-4.acl2
--- acl2-6.2/books/misc/defabsstobj-example-4.acl2	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defabsstobj-example-4.acl2	2013-09-30 17:52:18.000000000 +0000
@@ -1,2 +1,7 @@
+; Defabsstobj Example 4
+; Copyright (C) 2012, Regents of the University of Texas
+; Written by Matt Kaufmann, Dec., 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; cert-flags: ? t :ttags (:restore-state)
 (certify-book "defabsstobj-example-4" ? t :ttags (:restore-state))
diff -Nru acl2-6.2/books/misc/defattach-bang.lisp acl2-6.3/books/misc/defattach-bang.lisp
--- acl2-6.2/books/misc/defattach-bang.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defattach-bang.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,5 +1,6 @@
-; Matt Kaufmann
-; April, 2011
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, April, 2011
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; We define a macro based on defattach that does not require guard verification
 ; for a function to be attached to a constrained function.
diff -Nru acl2-6.2/books/misc/defattach-example.lisp acl2-6.3/books/misc/defattach-example.lisp
--- acl2-6.2/books/misc/defattach-example.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defattach-example.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,8 +1,8 @@
-; Matt Kaufmann, January 2011 (revised slightly October 2011)
-; Distributed with ACL2 as:
-; books/misc/defattach-example.lisp
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, January, 2011 (revised slightly October, 2011)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; See also books/misc/defattach-bang.lisp for a macro based
+; See also defattach-bang.lisp for a macro based
 ; on defattach that does not require guard verification.
 
 ; Defattach was introduced in ACL2 Version 4.0 (July, 2010).
diff -Nru acl2-6.2/books/misc/definline.lisp acl2-6.3/books/misc/definline.lisp
--- acl2-6.2/books/misc/definline.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/definline.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -7,10 +7,9 @@
 ;; particular purpose.
 
 (in-package "ACL2")
-(include-book "doc-section")
 
 (defmacro definline (name formals &rest args)
-  ":Doc-Section misc
+  ":Doc-Section defun
   Alias for ~ilc[defun-inline]~/
   Examples:
   ~bv[]
@@ -28,7 +27,7 @@
   `(defun-inline ,name ,formals . ,args))
 
 (defmacro definlined (name formals &rest args)
-  ":Doc-Section misc
+  ":Doc-Section defun
   Alias for ~ilc[defund-inline]~/
   This is a ~il[defund]-like version of ~il[definline].~/~/"
   `(defund-inline ,name ,formals . ,args))
diff -Nru acl2-6.2/books/misc/defmac.lisp acl2-6.3/books/misc/defmac.lisp
--- acl2-6.2/books/misc/defmac.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defmac.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,10 +1,11 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, 2/27/09
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; defmac.lisp
 ; Automated support for faster macroexpansion
-; Matt Kaufmann
-; 2/27/09
 
 (in-package "ACL2")
-(include-book "doc-section")
 
 ; See :doc defmac for information.
 
@@ -67,7 +68,7 @@
 
 ; The documentation below borrows heavily from :doc defmacro.
 
-  ":Doc-Section misc
+  ":Doc-Section defmacro
 
   define a macro that expands efficiently~/
   ~bv[]
diff -Nru acl2-6.2/books/misc/defopener.lisp acl2-6.3/books/misc/defopener.lisp
--- acl2-6.2/books/misc/defopener.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defopener.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,9 +1,10 @@
-; Matt Kaufmann
-; August, 2007
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, August, 2007
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Thanks to Robert Krug for requesting this tool.
 
 (in-package "ACL2")
-(include-book "doc-section")
 (include-book "bash")
 
 (program)
@@ -366,7 +367,7 @@
                             name call
                             &key hyp equiv hints debug (flatten 't))
 
-  ":Doc-Section misc
+  ":Doc-Section miscellaneous
 
   create a defthm equating a call with its simplification~/
 
diff -Nru acl2-6.2/books/misc/defp.lisp acl2-6.3/books/misc/defp.lisp
--- acl2-6.2/books/misc/defp.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defp.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,6 +1,8 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, August, 2007
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Enhancement of defpun to allow more than one tail-recursive call.
-; Matt Kaufmann
-; August 2007
 
 ; Notes:
 
diff -Nru acl2-6.2/books/misc/defproxy-test.acl2 acl2-6.3/books/misc/defproxy-test.acl2
--- acl2-6.2/books/misc/defproxy-test.acl2	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defproxy-test.acl2	2013-09-30 17:52:18.000000000 +0000
@@ -1,2 +1,6 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, December, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; cert-flags: ? t :ttags (:defproxy-test)
 (certify-book "defproxy-test" ? t :ttags (:defproxy-test))
diff -Nru acl2-6.2/books/misc/defproxy-test.lisp acl2-6.3/books/misc/defproxy-test.lisp
--- acl2-6.2/books/misc/defproxy-test.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defproxy-test.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, December, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; The following little book shows how to use defproxy.  See :DOC defproxy for
 ; more information.  Most users probably will have no need for defproxy, but
 ; for those who use attachments, it provides a convenient way to experiment
diff -Nru acl2-6.2/books/misc/defpun.lisp acl2-6.3/books/misc/defpun.lisp
--- acl2-6.2/books/misc/defpun.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/defpun.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,33 +1,11 @@
-;  Copyright (C) 2000 Panagiotis Manolios and J Strother Moore
- 
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Panagiotis Manolios and J Strother Moore, 2000
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Modified May 2004 by Matt Kaufmann, in order to allow stobjs.  Thanks to John
 ; Matthews for providing a motivating example.  NOTE:  Do not use a :stobjs
 ; declaration in your defpun!
 
-;  This program is free software; you can redistribute it and/or modify
-;  it under the terms of the GNU General Public License as published by
-;  the Free Software Foundation; either version 2 of the License, or
-;  (at your option) any later version.
- 
-;  This program is distributed in the hope that it will be useful,
-;  but WITHOUT ANY WARRANTY; without even the implied warranty of
-;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;  GNU General Public License for more details.
- 
-;  You should have received a copy of the GNU General Public License
-;  along with this program; if not, write to the Free Software
-;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- 
-;  Written by Panagiotis Manolios and J Strother Moore who can be
-;  reached as follows.
- 
-;  Email: pete@cs.utexas.edu, moore@cs.utexas.edu
- 
-;  Postal Mail:
-;  Department of Computer Science
-;  The University of Texas at Austin
-;  Austin, TX 78701 USA
-
 ; NOTE: For a generalization of this utility, see file defp.lisp in this
 ; directory.
 
diff -Nru acl2-6.2/books/misc/dft.lisp acl2-6.3/books/misc/dft.lisp
--- acl2-6.2/books/misc/dft.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/dft.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,6 +1,8 @@
-(in-package "ACL2")
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by J Moore, 6/13/01
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; J Moore, 6/13/01
+(in-package "ACL2")
 
 ; All the "terms" encountered in this work are untranslated.  We nevertheless
 ; explore them.  We will always check that they are "deft terms" which means
diff -Nru acl2-6.2/books/misc/dijkstra-shortest-path.lisp acl2-6.3/books/misc/dijkstra-shortest-path.lisp
--- acl2-6.2/books/misc/dijkstra-shortest-path.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/dijkstra-shortest-path.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,14 +1,15 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by: J Strother Moore and Qiang Zhang
+;             Department of Computer Sciences
+;             Univesity of Texas at Austin
+;             October, 2004
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; (certify-book "script")
 
 ; A Proof of the Correctness of Dijkstra's Shortest Path Algorithm in
 ; ACL2
 
-; J Strother Moore and Qiang Zhang
-; Department of Computer Sciences
-; Univesity of Texas at Austin
-
-; October, 2004
-
 ; See the paper ``Dijkstra's Shortest Path Algorithm Verified with ACL2''
 ; by the authors for a description of this script.
 
diff -Nru acl2-6.2/books/misc/disassemble.acl2 acl2-6.3/books/misc/disassemble.acl2
--- acl2-6.2/books/misc/disassemble.acl2	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/disassemble.acl2	2013-09-30 17:52:18.000000000 +0000
@@ -1,2 +1,6 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, April, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; cert-flags: ? t :ttags '(:disassemble$)
 (certify-book "disassemble" ? t :ttags '(:disassemble$))
diff -Nru acl2-6.2/books/misc/disassemble.lisp acl2-6.3/books/misc/disassemble.lisp
--- acl2-6.2/books/misc/disassemble.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/disassemble.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,24 +1,6 @@
-; This program is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation; either version 2 of the License, or
-; (at your option) any later version.
-
-; This program is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this program; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-; Written by:  Matt Kaufmann
-; email:       Kaufmann@cs.utexas.edu
-; Department of Computer Science
-; University of Texas at Austin
-; Austin, TX 78701 U.S.A.
-
-; April, 2012
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, April, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; WARNING: Keep the functionality of this book in sync with disassemble$ (and
 ; its documentation) in the ACL2 source code.
diff -Nru acl2-6.2/books/misc/doc-section.lisp acl2-6.3/books/misc/doc-section.lisp
--- acl2-6.2/books/misc/doc-section.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/doc-section.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-(in-package "ACL2")
-
-(defdoc misc
-  ":Doc-Section misc
-Miscellaneous ACL2 books.~/~/~/")
\ No newline at end of file
diff -Nru acl2-6.2/books/misc/dump-events.lisp acl2-6.3/books/misc/dump-events.lisp
--- acl2-6.2/books/misc/dump-events.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/dump-events.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,23 +1,12 @@
-; dump-events.lisp  --  file-dumping utility for ACL2
 ; Copyright (C) 1997  Computational Logic, Inc.
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; This book is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation; either version 2 of the License, or
-; (at your option) any later version.
-
-; This book is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this book; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+; dump-events.lisp  --  file-dumping utility for ACL2
 
 ; Originally written by Matt Kaufmann at Computational Logic, Inc.
 ; Although this file seems to work with ACL2 Release 2.0, it should be
-; viewed as a sproviding a capability that may prove useful in using
+; viewed as providing a capability that may prove useful in using
 ; ACL2 but _not_ as code that can be trusted to the extent that the
 ; ACL2 system prover may be trusted.
 
@@ -25,15 +14,12 @@
 ; (certify-book "dump-events").
 
 (in-package "ACL2")
-(include-book "doc-section")
-
-; We know what we are doing when using state:
 (set-state-ok t)
 
 (program)
 
 (defmacro dump-events (filename &optional (earlier-cd '0) (later-cd ':x))
- ":Doc-Section misc
+ ":Doc-Section miscellaneous
 
   dump events to a file~/
 
diff -Nru acl2-6.2/books/misc/eval.lisp acl2-6.3/books/misc/eval.lisp
--- acl2-6.2/books/misc/eval.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/eval.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,6 +1,12 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Here we define macros that employ make-event to check evaluations of forms.
-; See eval-tests.lisp (and many other .lisp files in this directory) for how
-; these macros may be employed.
+; See community book make-event/eval-tests.lisp (and many other .lisp files in
+; that directory) for how these macros may be employed.  See also
+; make-event/eval-check.lisp for a similar book that adds :check-expansion t to
+; its make-event forms.
 
 (in-package "ACL2")
 
@@ -8,8 +14,8 @@
                                form expr
                                &key (ld-skip-proofsp ':default))
 
-; Warning: Keep this in sync with the definition of must-eval-to in
-; eval-check.lisp.
+; Warning: Keep this in sync with the definition of must-eval-to in community
+; book make-event/eval-check.lisp.
 
 ; Form should evaluate to an error triple (mv erp form-val state).  If erp is
 ; nil and expr-val is the value of expr then (must-eval-to form expr) expands
diff -Nru acl2-6.2/books/misc/expander.lisp acl2-6.3/books/misc/expander.lisp
--- acl2-6.2/books/misc/expander.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/expander.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,8 @@
+; expander.lisp  --  symbolic expansion utilities for ACL2
+; Copyright (C) 2013, Regents of the University of Texas
+; Originally written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Changes by Pete Manolios Wed Jul 15 21:22:03 EDT 2009
 ; Changes by Daron Vroon shortly thereafter.
 ; Made minor modifications and added simplification
@@ -5,31 +10,15 @@
 ; "termination checkpoints" we generate. See the end of the file
 ; for documentation, examples, and ideas for extending this work.
 
-; expander.lisp  --  symbolic expansion utilities for ACL2
-; Copyright (C) 1997  Computational Logic, Inc.
+; Historical comments:
 
-; This book is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation; either version 2 of the License, or
-; (at your option) any later version.
-
-; This book is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this book; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-; Originally written by Matt Kaufmann at Computational Logic, Inc.
-; Although some attempt has been made to bring it up to date with ACL2
-; Release 2.0, this file should be viewed as a set of routines that
-; may prove useful in using ACL2 but _not_ as code that can be trusted
-; to the extent that the ACL2 system prover may be trusted.
+;   Although some attempt has been made to bring it up to date with ACL2
+;   Release 2.0, this file should be viewed as a set of routines that may prove
+;   useful in using ACL2 but _not_ as code that can be trusted to the extent
+;   that the ACL2 system prover may be trusted.
 
-; For ACL2 3.0, removed symsim-for-value (not clear that it's been used for a
-; long time).  And, we allow symsim to return multiple clauses.
+;   For ACL2 3.0, removed symsim-for-value (not clear that it's been used for a
+;   long time).  And, we allow symsim to return multiple clauses.
 
 ; Top-level routines (only the first two have reasonable documentation):
 
@@ -68,12 +57,11 @@
 ; (certify-book "expander").
 
 (in-package "ACL2")
-(include-book "doc-section")
 
 ; The following deflabel is placed here primarily to provide a section in which
 ; to hang documentation.
 (deflabel expander :doc
- ":Doc-Section misc
+ ":Doc-Section miscellaneous
 
   routines for simplifying terms~/
 
diff -Nru acl2-6.2/books/misc/file-io.lisp acl2-6.3/books/misc/file-io.lisp
--- acl2-6.2/books/misc/file-io.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/file-io.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Utilities read-list and write-list:
 
 ; (Read-list fname ctx state) returns (mv nil lst state) where lst is the list
@@ -54,8 +58,7 @@
       (pprogn (pprint-object-or-string (car list) channel state)
               (newline channel state)
               (newline channel state)
-              (write-objects (cdr list) channel state)
-              state)
+              (write-objects (cdr list) channel state))
     state))
 
 (defun write-list-body-fn (bangp)
diff -Nru acl2-6.2/books/misc/find-lemmas.lisp acl2-6.3/books/misc/find-lemmas.lisp
--- acl2-6.2/books/misc/find-lemmas.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/find-lemmas.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (program)
diff -Nru acl2-6.2/books/misc/gentle.lisp acl2-6.3/books/misc/gentle.lisp
--- acl2-6.2/books/misc/gentle.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/gentle.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Bob Boyer and Warren A. Hunt, Jr. (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; gentle.lisp                                 Boyer & Hunt
 
 ; Jared took these functions out of hons-help.lisp since they (generally) don't
diff -Nru acl2-6.2/books/misc/getprop.lisp acl2-6.3/books/misc/getprop.lisp
--- acl2-6.2/books/misc/getprop.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/getprop.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,4 +1,6 @@
-; J Moore
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by J Moore
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; In this sequence of events I define a linear-time no-duplicates
 ; function for lists of symbols, I prove its guards, I prove that it
diff -Nru acl2-6.2/books/misc/hanoi.acl2 acl2-6.3/books/misc/hanoi.acl2
--- acl2-6.2/books/misc/hanoi.acl2	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/hanoi.acl2	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann and J Strother Moore, April 2, 2003
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (defpkg "HANOI"
     (set-difference-equal
      (union-eq *acl2-exports*
diff -Nru acl2-6.2/books/misc/hanoi.lisp acl2-6.3/books/misc/hanoi.lisp
--- acl2-6.2/books/misc/hanoi.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/hanoi.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,6 +1,8 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann and J Strother Moore, April 2, 2003
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; A Proof of the Correctness of a Towers of Hanoi Program
-; Matt Kaufmann and J Strother Moore
-; April 2, 2003
 
 ; Abstract
 
diff -Nru acl2-6.2/books/misc/hons-help.lisp acl2-6.3/books/misc/hons-help.lisp
--- acl2-6.2/books/misc/hons-help.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/hons-help.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Bob Boyer and Warren A. Hunt, Jr. (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ;   hons-help.lisp                                Boyer & Hunt
 
 (in-package "ACL2")
diff -Nru acl2-6.2/books/misc/hons-help2.lisp acl2-6.3/books/misc/hons-help2.lisp
--- acl2-6.2/books/misc/hons-help2.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/hons-help2.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Bob Boyer and Warren A. Hunt, Jr. (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Abbreviations from Bob Boyer and Warren Hunt for hons.
 
 (in-package "ACL2")
diff -Nru acl2-6.2/books/misc/how-to-prove-thms.lisp acl2-6.3/books/misc/how-to-prove-thms.lisp
--- acl2-6.2/books/misc/how-to-prove-thms.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/how-to-prove-thms.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,9 +1,12 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by J Strother Moore
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Solutions to the Exercises
 ;            in
 
 ; How To Prove Theorems Formally
 ; Matt Kaufmann   J Strother Moore
-; AMD             UT Austin
 
 ; This file contains our solutions to the exercises in the paper
 ; above.  Remember, your solutions may be different but just as
diff -Nru acl2-6.2/books/misc/meta-lemmas.lisp acl2-6.3/books/misc/meta-lemmas.lisp
--- acl2-6.2/books/misc/meta-lemmas.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/meta-lemmas.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,6 @@
 ; meta-lemmas.lisp  --  meta-lemmas for NTH and MEMBER
 ; Copyright (C) 1997  Computational Logic, Inc.
-
-; This book is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation; either version 2 of the License, or
-; (at your option) any later version.
-
-; This book is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this book; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ;;;
@@ -35,7 +22,6 @@
 ;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 (in-package "ACL2")
-(include-book "doc-section")
 
 ;;;****************************************************************************
 ;;;
@@ -44,7 +30,7 @@
 ;;;****************************************************************************
 
 (deflabel meta-lemmas
-  :doc ":doc-section misc
+  :doc ":doc-section miscellaneous
   A book of general purpose meta-lemmas.
   ~/
   Note that it may be a good idea to load this book last, so that the lemmas
diff -Nru acl2-6.2/books/misc/misc2/ruler-extenders-tests.acl2 acl2-6.3/books/misc/misc2/ruler-extenders-tests.acl2
--- acl2-6.2/books/misc/misc2/ruler-extenders-tests.acl2	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/misc2/ruler-extenders-tests.acl2	2013-09-30 17:52:18.000000000 +0000
@@ -1,2 +1,6 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; cert-flags: ? t :skip-proofs-okp t
 (certify-book "ruler-extenders-tests" ? t :skip-proofs-okp t)
diff -Nru acl2-6.2/books/misc/misc2/ruler-extenders-tests.lisp acl2-6.3/books/misc/misc2/ruler-extenders-tests.lisp
--- acl2-6.2/books/misc/misc2/ruler-extenders-tests.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/misc2/ruler-extenders-tests.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,4 +1,6 @@
-; Matt Kaufmann
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; This file contains various rather ad-hoc tests of the ruler-extenders
 ; mechanism, mostly written during development of that capability.
diff -Nru acl2-6.2/books/misc/nested-stobj-tests.lisp acl2-6.3/books/misc/nested-stobj-tests.lisp
--- acl2-6.2/books/misc/nested-stobj-tests.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/nested-stobj-tests.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1042,3 +1042,10 @@
  (top1-fld.update-fld1 17 top1c)
  :check
  (f1 17 top1c))
+
+; Test the case where stobj fields are abstract stobjs.
+
+; Fails in Version 6.2: Bug from :doc note-6-3 says "Fixed a bug in the case of
+; a field of a (concrete) stobj that is an abstract stobj".
+(defstobj parent
+  (abs-child :type top1{abs}))
diff -Nru acl2-6.2/books/misc/priorities.lisp acl2-6.3/books/misc/priorities.lisp
--- acl2-6.2/books/misc/priorities.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/priorities.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,9 +1,8 @@
-; (certify-book "/u/moore/priorities")
-
-; J Strother Moore
-; Pete Manolios
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Panagiotis Manolios and J Strother Moore, July 7, 2001
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; July 7, 2001
+; (certify-book "/u/moore/priorities")
 
 ; Abstract
 
diff -Nru acl2-6.2/books/misc/process-book-readme.lisp acl2-6.3/books/misc/process-book-readme.lisp
--- acl2-6.2/books/misc/process-book-readme.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/process-book-readme.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (dates back to Feb., 2006 or earlier)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (program)
diff -Nru acl2-6.2/books/misc/profiling-raw.lsp acl2-6.3/books/misc/profiling-raw.lsp
--- acl2-6.2/books/misc/profiling-raw.lsp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/profiling-raw.lsp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, October, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; See profiling.lisp for information on how to use with-profiling.
 
 ; We have seen problems on Windows CCL, so we avoid Windows here for CCL.  It
diff -Nru acl2-6.2/books/misc/profiling.acl2 acl2-6.3/books/misc/profiling.acl2
--- acl2-6.2/books/misc/profiling.acl2	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/profiling.acl2	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, October, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 #+acl2-par
 ; You can't load profiling after threads are already started.
 (set-waterfall-parallelism nil)
diff -Nru acl2-6.2/books/misc/profiling.lisp acl2-6.3/books/misc/profiling.lisp
--- acl2-6.2/books/misc/profiling.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/profiling.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,5 +1,8 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, October, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Interface to some Lisp profilers
-; Matt Kaufmann
 
 ; Note: See also oprof.lisp (contributed by Jared Davis).
 
diff -Nru acl2-6.2/books/misc/qi-correct.lisp acl2-6.3/books/misc/qi-correct.lisp
--- acl2-6.2/books/misc/qi-correct.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/qi-correct.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,9 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
+; Contributors to this proof included Bob Boyer, Warren Hunt, Robert Krug, and
+; Qiang Zhang.
+
 (in-package "ACL2")
 
 (include-book "qi")
diff -Nru acl2-6.2/books/misc/qi.lisp acl2-6.3/books/misc/qi.lisp
--- acl2-6.2/books/misc/qi.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/qi.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Bob Boyer and Warren A. Hunt, Jr. (some years before that)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ;  qi.lisp                                  Boyer & Hunt
 
 (in-package "ACL2")
diff -Nru acl2-6.2/books/misc/save-time.lisp acl2-6.3/books/misc/save-time.lisp
--- acl2-6.2/books/misc/save-time.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/save-time.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,6 +1,6 @@
-; Save-time macro
-; Matt Kaufmann
-; January, 2012
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, January, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; Thanks to Sarah Weissman for the idea of this book and helpful discussions.
 
diff -Nru acl2-6.2/books/misc/simplify-defuns.lisp acl2-6.3/books/misc/simplify-defuns.lisp
--- acl2-6.2/books/misc/simplify-defuns.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/simplify-defuns.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,19 +1,8 @@
-; simplify-defuns.lisp  --  see simplify-defuns.txt for documentation
-; Copyright (C) 2002 Matt Kaufmann
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; This book is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation; either version 2 of the License, or
-; (at your option) any later version.
-
-; This book is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this book; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+; simplify-defuns.lisp  --  see simplify-defuns.txt for documentation
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; TABLE OF CONTENTS
diff -Nru acl2-6.2/books/misc/sin-cos.lisp acl2-6.3/books/misc/sin-cos.lisp
--- acl2-6.2/books/misc/sin-cos.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/sin-cos.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -37,10 +37,9 @@
 ;;;****************************************************************************
 
 (in-package "ACL2")
-(include-book "doc-section")
 
 (deflabel sin-cos
-  :doc ":doc-section misc
+  :doc ":doc-section miscellaneous
   SIN/COS approximations.
   ~/~/~/")
 
diff -Nru acl2-6.2/books/misc/sort-symbols.lisp acl2-6.3/books/misc/sort-symbols.lisp
--- acl2-6.2/books/misc/sort-symbols.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/sort-symbols.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann (original date July, 2006)
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; Proof of correctness of reasonably efficient symbol sorting function,
 ; sort-symbol-<.  This function is included in :program mode in the ACL2 source
 ; code, and is used by defpkg.
@@ -7,25 +11,6 @@
 ; strict-symbol-<-sortedp, and sort-symbol-listp are guard-verified when ACL2
 ; starts up.
 
-; Matt Kaufmann, July 2006
-
-; Copyright (C) 2006 by Matt Kaufmann <kaufmann@cs.utexas.edu>
-
-; This program is free software; you can redistribute it and/or 
-; modify it under the terms of the GNU General Public License as 
-; published by the Free Software Foundation; either version 2 of 
-; the License, or (at your option) any later version.
-
-; This program is distributed in the hope that it will be useful, 
-; but WITHOUT ANY WARRANTY; without even the implied warranty of 
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public 
-; License along with this program; if not, write to the Free 
-; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-; Boston, MA 02110-1301, USA.
-
 (in-package "ACL2")
 
 (defun strict-merge-symbol-< (l1 l2 acc)
diff -Nru acl2-6.2/books/misc/sticky-disable.lisp acl2-6.3/books/misc/sticky-disable.lisp
--- acl2-6.2/books/misc/sticky-disable.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/sticky-disable.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,11 +1,12 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann, 12/13/05
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 ; Sticky disabling and enabling, implementing an idea suggested by Ray
 ; Richards by using tables.
 
-; Matt Kaufmann
-; 12/13/05
-
 ; This book introduces the following macros:
 
 ; (sticky-disable name1 name2 ...):
diff -Nru acl2-6.2/books/misc/untranslate-patterns.lisp acl2-6.3/books/misc/untranslate-patterns.lisp
--- acl2-6.2/books/misc/untranslate-patterns.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/untranslate-patterns.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -34,7 +34,7 @@
 ;; See :doc untranslate-patterns-table or :doc add-untranslate-pattern after
 ;; loading this file for usage examples.
 
-(defdoc untranslate-patterns-table
+(defdoc untranslate-patterns
   ":Doc-Section Events
 
   a database used to extend untranslate with pattern-based rules~/
@@ -257,7 +257,7 @@
             (acons ',target ',replacement pat-database))))
 
 (defmacro add-untranslate-pattern (target replacement)
-  ":Doc-Section Events
+  ":Doc-Section untranslate-patterns
   add a new pattern to the untranslate patterns table~/
   General Form:
   ~bv[]
@@ -287,7 +287,7 @@
 
 
 (defmacro optimize-untranslate-patterns ()
-  ":Doc-Section Events
+  ":Doc-Section untranslate-patterns
   optimize the untranslate patterns table~/
   Usage:
   ~bv[]
diff -Nru acl2-6.2/books/misc/watch.acl2 acl2-6.3/books/misc/watch.acl2
--- acl2-6.2/books/misc/watch.acl2	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/watch.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-; cert-flags: ? t :ttags :all
-(certify-book "watch" ? t :ttags :all)
\ No newline at end of file
diff -Nru acl2-6.2/books/misc/wet.lisp acl2-6.3/books/misc/wet.lisp
--- acl2-6.2/books/misc/wet.lisp	2013-06-06 17:11:06.000000000 +0000
+++ acl2-6.3/books/misc/wet.lisp	2013-09-30 17:52:18.000000000 +0000
@@ -1,4 +1,6 @@
-; Matt Kaufmann
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; Replacement for WET, from before Version 3.4.
 
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/models/jvm/guard-verified-m1/Demo.class and /tmp/b2KjCbRUvz/acl2-6.3/books/models/jvm/guard-verified-m1/Demo.class differ
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/Demo.java acl2-6.3/books/models/jvm/guard-verified-m1/Demo.java
--- acl2-6.2/books/models/jvm/guard-verified-m1/Demo.java	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/Demo.java	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,13 @@
+class Demo {
+  public static int fact(int n){
+      int a = 1;
+      while (n!=0) {a = n*a; n = n-1;}
+      return a;
+  }
+
+  public static void main(String[] args){
+      int n = Integer.parseInt(args[0], 10);
+      System.out.println(fact(n));
+      return;
+    }
+}
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/Makefile acl2-6.3/books/models/jvm/guard-verified-m1/Makefile
--- acl2-6.2/books/models/jvm/guard-verified-m1/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/Makefile	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,2 @@
+include ../../../Makefile-generic
+-include Makefile-deps
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/README acl2-6.3/books/models/jvm/guard-verified-m1/README
--- acl2-6.2/books/models/jvm/guard-verified-m1/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/README	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,568 @@
+                        A Guard-Verified Version of M1
+
+                                      or
+
+             A Very Simplified Model of the Java Virtual Machine,
+                                   including
+                            a Bytecode Interpreter,
+                             a Bytecode Verifier,
+              a Proof that the Bytecode Verifier Insures Safety,
+             Sample Correctness Proofs for Many Bytecode Programs,
+            a Verifying Compiler from mini-Lisp to M1 Bytecode, and
+              a Proof that the Model is Turing Machine Equivalent
+
+                               J Strother Moore
+                          [last update: March, 2013]
+
+Heads-Up!
+
+This is the guard verified version of M1: we characterize a well-formed M1
+state and verify that well-formed code preserves such states.  But there is
+an earlier (and simpler to understand) version of M1 among the ACL2 Community
+Books on the directory books/models/jvm/m1.
+
+The guard verified version of M1 is semantically equivalent to the earlier
+version of M1.  All the code proofs there are reproduced here for
+completeness.  In addition, certain files have been added here to specify and
+verify the guards on the M1 model.
+
+As of Version 6.3 of ACL2 this directory and the earlier one were
+intellectually identical except for the issue of guards: both included the
+same bytecode programs, the same correctness theorems of those programs, and
+the proof that M1 is Turing machine equivalent.  Guards complicate the
+presentation of the model but don't effect subsequent proofs except insofar
+as the lemma database required to verify the guards slightly changes the
+environment in which subsequent proofs are performed.  Indeed, only four
+of the earlier files were changed:
+
+script.lsp -- includes a different M1 defpkg so that NTH and UPDATE-NTH
+              are the native ACL2 versions
+m1.lisp -- the definition of M1 now includes guards
+tmi-reductions.lisp -- now omits one lemma from the earlier version
+defsys-utilities.lisp -- now omits one lemma from the earlier version
+
+The vast majority of the material here is found verbatim on the earlier
+directory.
+
+However, as time goes on it would not surprise me if new results were added
+just to the guard verified version of M1.
+
+But even if that happens, if you're looking just to get a sense of the M1
+model and how we prove M1 bytecode programs correct with it, I advise you to
+look at the earlier version.
+
+Summary
+
+This is the README file for the guard-verified version of the M1 machine model.
+M1 is a simple stack machine that is suggestive of the JVM.  It supports only
+nine ``bytecode'' instructions and provides only two interesting resources: a
+finite number of local variable values (thought of as a local variable
+``array'' but actually a list) and an unbounded pushdown stack.
+
+M1 differs from the JVM in so many ways it is pointless to try to list them.
+But so that readers will not think I think M1 is a model of the JVM (!) let
+me say that (a) the instruction stream in M1 is a list of fully parsed
+symbolic instructions, not bytes, (b) the only data type supported is
+integers, (c) integers are unbounded, (d) the only instructions modeled are
+the analogues of ILOAD, ISTORE, ICONST, IADD, ISUB, IMUL, IFEQ, GOTO, and
+HALT (instead of IRETURN), (e) there is no heap, (f) there are no Objects,
+(g) there are no methods, classes, or class tables -- just a single parsed
+bytecode program, (h) there are no threads or monitors, and (i) there are no
+exceptions.  Otherwise, it's just like the JVM (!).
+
+Nevertheless, for many years my students have found M1 a good introduction to
+the JVM and have extended M1 in countless ways to ``grow it up'' into a
+realistic JVM model.  This process was brought to its stunning conclusion by
+Habing Liu who developed the M6 model, capable of accurately executing most
+J2ME compiled Java programs (except those with significant I/O or
+floating-point).  See
+
+  Hanbing Liu, "Formal Specification and Verification of a JVM and its Bytecode
+  Verifier," PhD Dissertation, Computer Science Department, University of Texas
+  at Austin, August, 2006.
+
+One can think of the books on this directory as being partitioned into
+three sections:
+
+Section 1: definition and guard-verification of the M1 machine, including a
+  ``verifier'' for checking that a program is well-formed, akin to the JVM's
+  bytecode verifier,
+
+Section 2: use of the M1 model to verify the functional correctness of some
+  simple M1 bytecode programs, and
+
+Section 3: proof that M1 can do anything a Turing machine can do, i.e., that it
+  is Turing Equivalent (given the thesis that it is no more powerful than
+  Turing machines!).
+
+Operational Information
+
+To re-certify all the books on this directory,
+
+(ld "script.lsp" :ld-pre-eval-print t)
+
+See script.lsp for the defpkg for the "M1" symbol package, in which all this
+work is done.
+
+Aside from several new files to support guards, and the provision of guards in
+the m1.lisp file, only three files were changed from the M1 model released with
+ACL2 Version 6.1:
+
+ tmi-reductions.lisp -- one lemma was deleted (and simply moved into
+  good-statep.lisp where it was needed earlier in the recertifications
+  sequence)
+
+ defsys-utilities.lisp -- omits a now unnecessary lemma
+
+ script.lsp -- includes new M1 defpkg and commands for guard verification
+  certification
+
+About Section 1:
+
+M1 is a very simple virtual machine providing local variables, a pushdown
+stack, and an execute-only program composed of the instructions ILOAD, ISTORE,
+ICONST, IADD, ISUB, IMUL, GOTO, IFEQ, and HALT.  M1 was developed as a
+pedagogical introduction to machine modeling in ACL2, techniques for proving
+properties of such models, and techniques for proving code correct.  The ``I''
+prefix for many of the instructions, which in the JVM would indicate that the
+instruction manipulates 32-bit int data, is misleading here.  Those names were
+chosen to facilitate the students looking up the names in the Sun JVM
+specification and comparing the informal descriptions to their formal
+counterparts.  All of the arithmetic instructions here operate correctly on
+unbounded rationals.
+
+Historically, the books here were developed by the author from 1997 through the
+present as part of an undergraduate course on formal modeling techniques.  The
+course culminates in the exploration of a very detailed model of the Java
+Virtual Machine.  Many students, TAs, and research colleagues share
+responsibility for developing these techniques over decades of machine modeling
+and code proof techniques by many members of the Boyer-Moore user community.
+
+If M1 is considered a very simplified model of the Java Virtual Machine (JVM),
+the functions guarding it are a very simplified model of Java's bytecode
+verifier: the guard guarantees that bytecode programs will ``stay in the
+sandbox,'' i.e., do not add non-numbers, jump outside the bounds of the
+program, or access non-existent variables or stack locations.  Verifying the M1
+guards is akin to verifying the correctness of the bytecode verifier.
+
+How does this m1 differ from earlier unguarded M1 models, specifically the file
+books/model/jvm/m1/m1.lisp released with ACL2 Version 6.1?  The functions in
+the unguarded model do not have have guards while the same functions here do
+have guards.  Logically, corresponding definitions are identical.
+
+For example, consider the stack manipulation functions, top and pop.  Logically
+they are defined in the unguarded and guarded books to be car and cdr,
+respectively.  They are unguarded in books/model/jvm/m1/m1.lisp but guarded
+here; each has a guard requiring that the stack be well-formed (a true list of
+rationals) and non-empty.  Because ACL2 requires that the guard for a function
+be exhibited at the time the function is defined it was impossible to produce a
+guard verified version of m1.lisp without editing the text in m1.lisp to insert
+guards.
+
+To preserve, as much as possible, the presentation of the earlier unguarded M1
+we define in one book all the functions we need to specify the guards, and we
+specify in another book all the lemmas we need to verify those guards.  We then
+sandwich the guarded version of m1.lisp between them.  Specifically, the
+``new'' books are:
+
+* good-statep.lisp -- define the invariant good-statep, which recognizes
+  well-formed M1 states; good-statep may be considered a simple example of a
+  bytecode verifier
+
+* m1.lisp -- define the M1 machine interpreter
+
+* verify-guards.lisp -- verify that M1 respects the good-statep invariant in
+  two senses:
+
+  - M1 never does anything ``unexpected'' to a state (e.g., encounter an
+    undefined instruction, access a non-existent local variable, perform
+    arithmetic on a non-number, jump to a non-existent location, or attempt to
+    pop something off an empty stack).  In ACL2 parlance, this is ``guard
+    verification'';
+
+  - M1 maintains the good-statep invariant (e.g., when given a well formed
+    state it returns one).
+
+Many ACL2 users add guards to their functions to make them run faster.  We are
+not interested in that motivation here.  We added guards simply to specify our
+expectations on the arguments of our functions -- largely for pedagogical
+purposes.  In addition, the exercise of adding guards is a good way to
+investigate how one formalizes and verifies a static checker like the bytecode
+verifier.  If our interest were in making M1 run faster on concrete data, the
+first change would have been to abandon the repeated use of make-state in our
+semantic functions and adopt the single-threaded object (stobj) paradigm.  We
+stick with the make-state paradigm because we feel it is pedagogically clearer.
+
+About Section 2:
+
+After defining M1 and verifying its guards, we use m1.lisp to verify many
+simple M1 programs.  In these exercises we do not exploit the fact that M1 is
+guard verified: we prove that the given bytecode, when interpreted by the M1
+logical machinery, returns its specified answer, whether or not the initial
+state (and bytecode) satisfy the bytecode verifier.  Indeed, sometimes the
+bytecode does NOT satisfy the bytecode verifier -- and yet still operates
+provably correctly on the unguarded M1.
+
+One such example is funny-fact.lisp, which computes factorial of n by pushing
+n, n-1, n-2, ..., 2, 1 onto the stack in one loop and then multiplying them
+together in a second loop.  The javac compiler would never generate such code.
+The Java programmer does not have direct access to the JVM operand stack.  This
+bytecode violates the bytecode verifier because the verifier requires that the
+depth of the operand stack be fixed for each pc.  Both the actual bytecode
+verifier and our simplification of it insist on this restriction.  For example,
+the guard on the function top, which returns the topmost element of the operand
+stack, requires that the stack be non-empty (have a non-zero depth) whenever
+top is used.  Thus, the IMUL instruction, for example, does not check the stack
+depth.  Instead, the good-statep predicate insures that whenever an IMUL is
+encountered there are at least two things on the stack.  It does this by
+constructing a ``stack map'' via an abstract interpreter-like process that
+walks the code calculating the stack depth at each location.
+
+The actual JVM solves the stack problem the same way.  The operand stack is
+used merely to evaluate expressions and hence its depth is always 0 on the
+boundaries of Java statements and, mid-statement, is limited to a fixed size
+determined by the amount of function/operator nesting in the expression being
+evaluated.  By insisting on this, the actual JVM can compute the maximal amount
+of stack space needed for a given method invocation and hence detect all stack
+overflows by checking only on method invocation.  Nevertheless, an actual JVM
+would operate correctly on funny-fact.lisp (until stack overflow wrecked the
+image) even though the Java compiler would never generate that bytecode.
+
+We generally prove total correctness by the ``clock function'' method: if you
+run a certain (constructively given) number of steps from a
+certain (constructively given) initial state, you arrive at a state that is
+halted and that has the expected answer on top of the stack.  In addition, we
+generally prove that the starting state satisfies the invariants of our
+``bytecode verifier,'' although this is not necessary to the functional
+correctness proof.  We prove functional correctness of one program that
+violates the invariants -- and we prove that it is never approved by the
+bytecode verifier.
+
+For a discussion of how we prove theorems about M1, see my Marktoberdorf 2008
+lectures on ``Mechanized Operational Semantics'' at
+
+http://www.cs.utexas.edu/users/moore/publications/talks/marktoberdorf-08/index.html
+
+There you will not only find a version of M1 very much like this one but an
+explanation of the ``clock function'' method of proving code totally correct,
+and an explanation of how we can also use the Floyd-Hoare inductive assertion
+method to prove both partial and total correctness.  [By adding or deleting
+M1 instructions we make certain programs easier or harder to write; for
+example, some M1 models include the instruction IFLT for testing whether the
+top of stack is less than 0, while others just have IFEQ for testing whether
+it is equal to 0.  These minor differences are what distinguish various
+versions of M1 floating around in the literature.]
+
+See also the paper
+
+ ``Proof Styles in Operational Semantics,'' with S. Ray, Formal Methods in
+ Computer-Aided Design (FMCAD 2004), A. J. Hu and A. K. Martin (eds.),
+ Springer Lecture Notes in Computer Science, 3312, pages 67-81, 2004.
+ http://www.cs.utexas.edu/users/sandip/publications/proof-styles/main.html
+
+and the supporting material in the Community Books on the directory
+books/proofstyles/ for discussion of the comparison of clock style proofs
+with inductive assertion style proofs.
+
+The programs dealt with in this directory include the following.  Unless
+otherwise noted, the inputs to the programs are natural numbers.  The
+programs are simple but illustrative of various code proof techniques.
+
+"template.lisp"                - product of two naturals by repeated addition
+"sum.lisp"                     - sum of the naturals below n
+"sumsq.lisp"                   - sum of squares of the naturals below n
+"fact.lisp"                    - factorial of n
+"power.lisp"                   - 2^n
+"expt.lisp"                    - n^m
+"alternating-sum.lisp"         - n/2 by summing alternate naturals below n
+"alternating-sum-variant.lisp" - same as above but slightly different proof
+"fib.lisp"                     - Fibonnaci n
+"lessp.lisp"                   -  1 or 0 depending on whether n < m
+"even-solution-1.lisp"         - 1 or 0 depending on whether n is even
+"even-solution-2.lisp"         - same as above but different program
+"sign.lisp"                    - -1, 0, or 1 depending on sign of integer i
+"div.lisp"                     - floor of n/d for non-0 d
+"bexpt.lisp"                   - n^m by binary method
+"magic.lisp"                   - illustration of the importance of total
+                                 correctness:  we exhibit and verify a
+                                 program that can ``compute'' any function
+                                 on the natural numbers -- sort of!
+"funny-fact.lisp"              - factorial again, but with a program that
+                                 violates the bytecode verifier
+"wormhole-abstraction.lisp"    - factorial, again, but by a different proof
+                                 method
+
+As of this writing (ACL2 Version 6.3) there are not illustrations of
+inductive assertion style proofs here.  I hope to add some in the future.
+
+I recommend studying these proofs in the order listed above.  The template file
+contains many comments trying to explain the basic method used.  The other
+files follow the template to verify similar programs and begin to introduce
+other proof techniques.
+
+To really learn how to do this I recommend reading the template and
+understanding it and then just trying to tackle each of the problems described
+above WITHOUT looking at my solutions.  For example, instead of
+reading "sum.lisp":
+
+ Define your own M1 program that takes a natural number, n, in local variable 0
+ and sums the naturals (weakly) below it, n+(n-1)+...+2+1, leaving the final
+ sum on the stack.  Prove that this program passes the bytecode verifier,
+ halts, and leaves (n * (n + 1))/2 on the stack.
+
+Then repeat that for the other simple programs described above.
+
+About Section 3:
+
+We then prove, in "theorems-a-and-b.lisp" (and supporting files) that M1 is
+Turing equivalent, meaning that it can emulate a Turing Machine.  The starting
+point of this work is the 1984 paper by Boyer and Moore in which a Turing
+machine interpreter is defined in the Pure Lisp of Nqthm.
+
+ A Mechanical Proof of the Turing Completeness of PURE LISP, with
+ R. S. Boyer. In W. W. Bledsoe and D. W. Loveland (eds.), Contemporary
+ Mathematics, Volume 29, Automated Theorem Proving: After 25 Years, American
+ Mathematical Society, Providence, Rhode Island, 1984, pp. 133-168.
+
+We define that function in ACL2 as tmi.  We then refine it down to a
+numerically based function tmi3 and then implement tmi3 on M1 and prove the
+equivalence of all these machines.
+
+We create the emulator by first writing a verifying compiler that takes an
+arbitrary system description written in a very simple Lisp-like language and:
+
+(i)   compiles it into M1 bytecode
+
+(ii)  generates clock functions that specify how long it runs on given input
+      (with suitable handling of non-terminating computations)
+
+(iii) generates theorems stating that the M1 bytecode satisfies its
+      specification,
+
+(iv)  generates the lemmas and hints necessary to lead ACL2 to the proofs, and
+
+(v)   proves all the theorems.
+
+By the way, the compiled code does not, in general, satisfy the good-statep
+predicate.  The reason it that it uses the M1 operand stack to
+
+(i)   save the return pc
+(ii)  pass arguments
+(iii) protect the local variables of the caller
+(iv)  store intermediate results during expression evaluation
+
+essentially following the standard x86 protocol for subroutine call and
+return.  (Of course, since M1 does not have a POPJ or RET instruction,
+returning to the saved pc is actually done by a big case split and the compiler
+keeps track of every location from which a subroutine is called.)
+
+Thus, multiple arrivals at the subroutine entry code for a given subroutine
+from different locations in the main program may have different stack depths.
+For example, the compiled code for (+ (foo x) (foo x)) jumps to the code for
+foo twice (and returns).  But on the second jump there is one more item on the
+stack than there was on the first jump, violating the bytecode verifier's stack
+conventions.
+
+Then we give this verifying compiler the description of tmi3 and get back an
+895 instruction verified M1 program implementing tmi3.  We then prove that tmi3
+is equivalent (modulo mappings between representations) to the 1984 Boyer-Moore
+tmi.
+
+We conclude by proving two theorems, analogous to theorems A and B in the
+Boyer-Moore paper:
+
+Let tm be any Turing machine, tape be any input tape, and st be any state of
+tm.  We will define an M1 program that, when given encodings st, tape, and tm,
+emulates the behavior of any given Turing machine.  We prove that
+
+(a) If there is an i such that running the M1 emulator halts after i steps,
+then there exists a j such that running the Turing machine tm on the given tape
+starting in st halts in j steps.  The contrapositive of this is that if there
+does not exist such a j, there does not exist such an i, i.e., if the Turing
+machine runs forever, so does the M1 emulator.
+
+(b) If tm on tape starting in st halts in n steps, then there exists a k such
+that the emulator halts in k steps and returns (an M1 representation of) the
+same final tape.
+
+These two theorems are formally stated as follows in terms of down and up,
+where down maps st, tape, and tm into an M1 state poised to run the emulator
+and up projects a tape out of an M1 state.  Technically, one should inspect the
+definitions of down and up to ascertain that we don't ``cheat'' and do the
+Turing machine computation with some kind of non-constructive mapping.
+
+Theorem a:
+(implies
+ (and (symbolp st)
+      (tapep tape)
+      (turing-machinep tm)
+      (natp i))
+ (let ((s_f (m1 (down st tape tm) i)))
+   (implies (haltedp s_f)
+            (tmi st tape tm (find-j st tape tm i)))))
+
+Theorem b:
+(implies (and (symbolp st)
+              (tapep tape)
+              (turing-machinep tm)
+              (tmi st tape tm n))
+         (let ((s_f (m1 (down st tape tm)
+                        (find-k st tape tm n))))
+           (and (haltedp s_f)
+                (equal (up s_f)
+                       (tmi st tape tm n)))))
+
+Finally, we demonstrate the extraordinary inefficiency of the M1 emulator.  We
+show a simple Turing Machine, taken from Rogers' book, that doubles the number
+of 1s on the initial tape, and show that to compute eight 1s from 4 1s requires
+
+291,202,253,588,734,484,219,274,297,505,568,945,357,129,888,612,375,663,883
+
+M1 steps.  That is between 10^56 and 10^57 steps.
+
+This illustrates that we can prove things about computational models that are
+way too expensive to run and that our method of counting steps works even for
+quite complex computations.
+
+The organization of the files in this section is:
+
+"tmi-reductions.lisp"   -- prove reduction theorems from the 1984 Boyer-Moore
+                           model of a Turing machine interpreter to an
+                           algorithm implementable with the all-numeric
+                           resources of M1
+
+"defsys-utilities.lisp" -- utilities for the verifying compiler
+
+""defsys.lisp""         -- a verifying compiler from a simple Lisp-like source
+                           language to M1 bytecode
+
+"low-seven.lisp"        -- simple example of the use of the verifying compiler;
+                           irrelevant to the main goal of proving Turing
+                           equivalence of M1
+
+"implementation.lisp"   -- the Lisp-like description of a Turing machine
+                           interpreter, compiled and verified by the verifying
+                           compiler
+
+"theorems-a-and-b.lisp" -- relating the tmi-reductions to the implementation
+                           and reshaping the final theorems into forms (a)
+                           and (b) of the 1984 Boyer-Moore paper
+
+"find-k!.lisp"          -- converting certain of the clock functions into
+                           equivalent closed-form algebraic expressions (and
+                           proving their equivalence) so that it is possible to
+                           compute the time it takes to simulate a given Turing
+                           machine computation by the M1 implementation.  It was
+                           only after this conversion that I could compute the
+                           time taken for the example program that doubles the
+                           number on the tape: ~ 10^56 steps.
+
+History, Related Work, and Background
+
+I developed M1 for the first offering, in 1997, of the course ``CS378 A Formal
+Model of the Java Virtual Machine,'' in the Computer Science Department of the
+University of Texas at Austin.  The course taught students how to model complex
+digital artifacts like microprocessors and virtual machines.  Over the course
+of the semester, the students modified and elaborated M1 until it became a
+reasonably accurate model of a substantial part of the JVM.  This process was
+taken to its stunning conclusion with M6 by Hanbing Liu in his 2006 UT Austin
+PhD dissertation, ``Formal Specification and Verification of a JVM and its
+Bytecode Verifier.''
+
+I found it helpful, over the years, to modify the original M1 in various ways
+to make program coding, proofs, and/or subsequent elaborations easier for the
+students.  Thus, papers that mention ``M1'' published from time to time by me
+and others do not necessarily talk about the version of M1 defined here!
+However, the most common discrepancy is just in the particular choice of subset
+of the instructions modeled.  I think any reasonable person would look at the
+various formal definitions and pronounce them all ``virtually the same.''
+
+M1 differs from the JVM in so many ways it is pointless to try to list them.
+But so that readers will not think I think M1 is a model of the JVM let me say that
+(a) the instruction stream in M1 is a list of fully parsed instructions, not
+bytes, (b) the only data type supported is integers, (c) integers are unbounded,
+(d) the only instructions modeled are the analogues of ILOAD, ISTORE, ICONST,
+IADD, ISUB, IMUL, IFEQ, and GOTO, (e) there is no heap, (f) there are no Objects,
+(g) there are no methods, classes, or class tables -- just a single parsed
+bytecode program, (h) there are no threads or monitors, (i) there are no
+exceptions, and (j) there is no bytecode verifier or class loader.  But by
+enumerating these omissions you can get a sense for what the students formalized
+(with my help) over the semester.
+
+Despite these limitations, since M1 has unbounded integers it is Turing
+equivalent and thus strictly more powerful than any finite computing machine.
+It wasn't until March, 2012, that I bothered to prove that M1 is Turing
+equivalent.  In class that month the students said that M1 was hard to program
+and I countered that it was Turing equivalent.  But since M1 is a pedagogical
+device designed to show students how to model and reason about computing
+artifacts, I felt it was incumbent upon me not to merely allege that it was
+Turing equivalent but to formalize and prove it.
+
+This amounts to implementing a Turing machine interpreter in M1 bytecode and
+proving it correct.  I completed the first proof of M1's Turing equivalence
+over Spring Break, March 10--18, 2012.  I coded the interpreter by hand -- all
+804 M1 instructions -- and manually wrote the specifications and lemmas
+necessary to prove it correct.  I was helped in this endeavor by the fact that
+by 2012 I had taught the JVM course so many times that programming and
+verifying M1 code was second nature.  But the biggest help was that in 1984,
+Bob Boyer and I had proved the Turing equivalence of Pure Lisp with Nqthm:
+
+ A Mechanical Proof of the Turing Completeness of PURE LISP, with
+ R. S. Boyer. In W. W. Bledsoe and D. W. Loveland (eds.), Contemporary
+ Mathematics, Volume 29, Automated Theorem Proving: After 25 Years, American
+ Mathematical Society, Providence, Rhode Island, 1984, pp. 133-168.
+
+This paper gave me the definition, in the Nqthm logic, of an acceptable Turing
+machine interpreter and the form of the two theorems I had to prove to capture
+the notion that a convenient computational paradigm (in this case, M1) is as
+powerful as Turing machines.  The basic idea is to set up a correspondence
+between Turing machines and M1 states and then to prove that (a) if a Turing
+machine runs forever it corresponding M1 computation runs forever and (b) if a
+Turing machine halts with a given tape, its M1 counterpart halts with the same
+tape (modulo data representation).  Great care must be taken to insure that the
+computing machines and not the correspondence perform the necessary work.
+
+The title of the 1984 paper used ``completeness'' where today I use
+``equivalence.'' I believe that in 1984, the term ``Turing completeness'' was
+an acceptable way to say what we mean by ``Turing equivalence'' today and,
+today, ``Turing completeness'' means something different than we meant by in it
+1984.
+
+I also believe that the 1984 Boyer-Moore paper was the first time a computing
+paradigm, in that case, Pure Lisp, was mechanically proved to be as powerful as
+Turing machines.  I believe this M1 proof is only the second time.
+Furthermore, I believe M1 is the first von Neumann paradigm mechanically proved
+Turing equivalent.
+
+Finally, I should note that in neither the 1984 work nor the present work do we
+prove that Turing machines can emulate the more convenient paradigms (Pure Lisp
+or M1).  Since it is commonly accepted that any computation can be done by
+Turing machines, the interesting direction whether a more convenient paradigm
+can emulate Turing machines.
+
+The week after Spring Break, I gave two talks on the M1 proof.  The first was
+at the ACL2 research group seminar and the second was in my JVM class.
+
+I learned a lot about the complexity of presenting the work in those two
+seminars.  Neither went as smoothly as I wished, in part because the work
+itself was so complicated but also because it was messy and I did not know what
+I wanted to emphasize.  But, having given the talks I put the whole thing down.
+
+I believe it was a few weeks later, in early April, 2012, that I decided to
+implement a verifying compiler from a simple Lisp subset to M1.  The compiler
+could then be used to produce both the bytecode implementation and the
+necessary lemmas.  That version of the proof was being polished by April 14,
+2012.
+
+But I did not change the talk nor did I give the talk again.
+
+Then in Edinburgh during the Summer of 2012, I volunteered to give the talk
+again to Alan Bundy's group and then realized I needed to clean it up.  I
+started during the evenings of the Dagstuhl workshop on ``AI and Formal
+Software Development'', July 2-6, 2012.  But instead of working on the proof
+script, I worked exclusively on the talk.  The version of the talk I created
+that week is quite similar to the pdf file provided below.
+
+Having finished preparing a better talk, I then repeated the proof a third time
+to make it reflect what I wanted to say.  I gave the third talk in Bundy's
+seminar in July, 2012.
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/alternating-sum-variant.lisp acl2-6.3/books/models/jvm/guard-verified-m1/alternating-sum-variant.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/alternating-sum-variant.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/alternating-sum-variant.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,209 @@
+; Correctness of Sum
+
+; Problem: Define an M1 program to compute the ceiling of n divided by 2 via
+; the ``alternating sum'' the natural number n.  The alternating sum of 7 is
+; 7-6+5-4+3-2+1-0 = 4 = (acl2::ceiling n 2).  Prove your program correct.
+
+; Design Plan: I will have two auxiliary variables, a sign and an accumulator
+; a.  The sign will be either -1 or +1, indicating the sign of the next term.
+; It will start at +1 and a will start at 0.  I will count n down to 0 by 1
+; adding either each successive result or its negation into a, according to
+; sign.  I'll flip sign on each iteration.
+
+; We presented one solution to this in alternating-sum.lisp.  This solution is
+; exactly the same as far as the algorithm and code are concerned.  But my
+; approach to the proof is a little different.  In the previous solution we had
+; to specify the final value of the variable SIGN in our specification and
+; program.  We found a closed-form expression for it, namely (if (equal (mod n
+; 2) 0) sign (- sign)).  But sometimes it is hard to find a closed-form
+; expression for a quantity you're not very interested in.  So we show another
+; way to handle it here: define an ACL2 function that computes it the same way
+; the algorithm does.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun theta (n)
+  (ceiling n 2))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n sign a)
+  (if (zp n)
+      a
+      (helper (- n 1)
+              (* -1 sign)
+              (+ a (* sign n)))))
+
+(defun fn (n) (helper n +1 0))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n a), not just about the special case (helper n 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (or (equal sign +1)
+                    (equal sign -1))
+                (integerp a))
+           (equal (helper n sign a)
+                  (+ a (* sign (theta n))))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((iconst +1)  ;  0
+    (istore 1)   ;  1
+    (iconst 0)   ;  2
+    (istore 2)   ;  3
+    (iload 0)    ;  4
+    (ifeq 16)    ;  5
+    (iload 2)    ;  6
+    (iload 1)    ;  7
+    (iload 0)    ;  8
+    (imul)       ;  9
+    (iadd)       ; 10
+    (istore 2)   ; 11
+    (iload 1)    ; 12
+    (iconst -1)  ; 13
+    (imul)       ; 14
+    (istore 1)   ; 15
+    (iload 0)    ; 16
+    (iconst 1)   ; 17
+    (isub)       ; 18
+    (istore 0)   ; 19
+    (goto -16)   ; 20
+    (iload 2)    ; 21
+    (halt))      ; 22
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (clk+ 17
+            (loop-clk (- n 1)))))
+
+(defun clk (n)
+  (clk+ 4
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n and a, you must characterize
+; its behavior for arbitrary, legal n and a, not just a special case (e.g.,
+; where a is 0).
+
+; Idea of this Variant: In the solution of this problem titled
+; alternating-sum.lisp, we showed that the final value of the sign (i.e., of
+; local 1) is (if (equal (mod n 2) 0) sign (- sign)).  Instead of having to
+; discover this closed form expression of it, we could just define the function
+; that computes it the same way the program does.  In this approach, we might
+; have named helper ``final-a''.
+
+(defun final-sign (n sign)
+  (if (zp n)
+      sign
+      (final-sign (- n 1) (- sign))))
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n)
+                (or (equal sign +1)
+                    (equal sign -1))
+                (integerp a))
+           (equal (m1 (make-state 4
+                                  (list n sign a)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state 22
+                              (list 0 (final-sign n sign) (helper n sign a))
+                              (push (helper n sign a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 22
+                              (list 0 (final-sign n 1) (fn n))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 22
+                              (list 0 (final-sign n 1) (ceiling n 2))
+                              (push (ceiling n 2)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (ceiling n 2))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains (ceiling n 2) on top of the stack.  Note that the algorithm used by
+; *pi* is not specified or derivable from this formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/alternating-sum.lisp acl2-6.3/books/models/jvm/guard-verified-m1/alternating-sum.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/alternating-sum.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/alternating-sum.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,194 @@
+; Correctness of Sum
+
+; Problem: Define an M1 program to compute the ceiling of n divided by 2 via
+; the ``alternating sum'' the natural number n.  The alternating sum of 7 is
+; 7-6+5-4+3-2+1-0 = 4 = (acl2::ceiling n 2).  Prove your program correct.
+
+; Design Plan: I will have two auxiliary variables, a sign and an accumulator
+; a.  The sign will be either -1 or +1, indicating the sign of the next term.
+; It will start at +1 and a will start at 0.  I will count n down to 0 by 1
+; adding either each successive result or its negation into a, according to
+; sign.  I'll flip sign on each iteration.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun theta (n)
+  (ceiling n 2))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n sign a)
+  (if (zp n)
+      a
+      (helper (- n 1)
+              (* -1 sign)
+              (+ a (* sign n)))))
+
+(defun fn (n) (helper n +1 0))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n a), not just about the special case (helper n 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (or (equal sign +1)
+                    (equal sign -1))
+                (integerp a))
+           (equal (helper n sign a)
+                  (+ a (* sign (theta n))))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((iconst +1)  ;  0
+    (istore 1)   ;  1
+    (iconst 0)   ;  2
+    (istore 2)   ;  3
+    (iload 0)    ;  4
+    (ifeq 16)    ;  5
+    (iload 2)    ;  6
+    (iload 1)    ;  7
+    (iload 0)    ;  8
+    (imul)       ;  9
+    (iadd)       ; 10
+    (istore 2)   ; 11
+    (iload 1)    ; 12
+    (iconst -1)  ; 13
+    (imul)       ; 14
+    (istore 1)   ; 15
+    (iload 0)    ; 16
+    (iconst 1)   ; 17
+    (isub)       ; 18
+    (istore 0)   ; 19
+    (goto -16)   ; 20
+    (iload 2)    ; 21
+    (halt))      ; 22
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (clk+ 17
+            (loop-clk (- n 1)))))
+
+(defun clk (n)
+  (clk+ 4
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n and a, you must characterize
+; its behavior for arbitrary, legal n and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n)
+                (or (equal sign +1)
+                    (equal sign -1))
+                (integerp a))
+           (equal (m1 (make-state 4
+                                  (list n sign a)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state 22
+                              (list 0
+                                    (if (equal (mod n 2) 0) sign (- sign))
+                                    (helper n sign a))
+                              (push (helper n sign a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 22
+                              (list 0
+                                    (if (equal (mod n 2) 0) 1 -1)
+                                    (fn n))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 22
+                              (list 0
+                                    (if (equal (mod n 2) 0) 1 -1)
+                                    (ceiling n 2))
+                              (push (ceiling n 2)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (ceiling n 2))))
+  :rule-classes nil)
+
+
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains (ceiling n 2) on top of the stack.  Note that the algorithm used by
+; *pi* is not specified or derivable from this formula.
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/bexpt.lisp acl2-6.3/books/models/jvm/guard-verified-m1/bexpt.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/bexpt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/bexpt.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,323 @@
+; Correctness of Binary Exponentiation
+
+; Problem: Define and verify an M1 program to compute (expt n m), by the binary
+; method.  You may assume that n and m are natural numbers.  The ``binary
+; method'' is shown by our definition of the algorithm fn below.
+
+; Design Plan: The binary method of exponentiation involves repeated squaring.
+; For example, n^11 = n*(n^10) = n*([n^2]^5).  So to compute n^m, we iterate
+; counting m down by varying amounts: if m is even, we square n and divide m by
+; 2.  If n is odd, we just decrement m and multiply n into our running
+; accumulator a, initially 1.  Of course, to determine if m is even we'll need
+; another loop.  (To compute m/2 we can just use 1/2 * m.)
+
+; This example does three nice things:
+; (a) it is the most sophisticated algorithm we'll verify here
+; (b) like div.lisp, it illustrates the verification of a two-loop program
+; (c) the innermost loop is coded more like a method invocation and its
+;     verification foreshadows some of what we'll do when we verify
+;     methods and then verify code that invokes them.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n m)
+  (and (natp n)
+       (natp m)))
+
+(defun theta (n m)
+  (expt n m))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n m a)
+  (if (zp m)
+      a
+    (if (equal (mod m 2) 0)
+        (helper (* n n) (/ m 2) a)
+      (helper n (- m 1) (* n a)))))
+
+; The problem with implementing this algorithm is that we don't have (mod m 2)
+; as an M1 instruction.  We have to implement it as a separate loop to count m
+; down by 2 to 0 or 1 to determine its parity.
+
+; Also, recall in alternating-sum-variant.lisp how we had to specify the final
+; value of a temporary (there it was final-sign) by writing the algorithm that
+; produces it.  In this problem we have to do that, only the variable in
+; question is n, which is occasionally squared in the algorithm above.  So
+; here is its final value:
+
+(defun final-n (n m)
+  (if (zp m)
+      n
+    (if (equal (mod m 2) 0)
+        (final-n (* n n) (/ m 2))
+      (final-n n (- m 1)))))
+
+(defun fn (n m) (helper n m 1))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n m a), not just about the special case (helper n m 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n m)
+                (natp a))
+           (equal (helper n m a)
+                  (* a (theta n m)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n m)
+           (equal (fn n m)
+                  (theta n m))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+; My program stores n and m in locals 0 and 1.  It stores a in local 2.  The
+; predicate even is implemented as a loop, starting at pc = 26.  The ``invoke''
+; even, I jump to that address.  Even saves the current value of local 1 by
+; pushing it on the stack.  It then counts n down by 2 stopping at 0 and 1 to
+; determine n's parity.  It then restores n's value from the stack, pushes a 1
+; (``true'') or 0 (``false'') and ``returns'' to the caller.
+
+(defconst *pi*
+  '(
+    (iconst 1)		;  0
+    (istore 2)		;  1       a = 1;
+                        ;    loop:
+    (iload 1)		;  2
+    (ifeq 21)		;  3       if m=0, goto end
+    (goto 22)		;  4       ``invoke'' even
+                        ;    ret-from-even:
+    (ifeq 10)		;  5       if even=0, goto even-nil
+    (iload 0)		;  6
+    (iload 0)		;  7
+    (imul)		;  8
+    (istore 0)		;  9       n = n*n;
+    (iload 1)		; 10
+    (iconst 1/2)	; 11
+    (imul)		; 12
+    (istore 1)		; 13       m = m/2;
+    (goto -12)		; 14       goto loop;
+                        ;     even-nil:
+    (iload 1)		; 15
+    (iconst 1)		; 16
+    (isub)		; 17
+    (istore 1)		; 18       m = m-1;
+    (iload 0)		; 19
+    (iload 2)		; 20
+    (imul)		; 21
+    (istore 2)		; 22       a = n*a;
+    (goto -21)		; 23       goto loop
+                        ;     end:
+    (iload 2)		; 24
+    (halt)		; 25       return a
+                        ;     even:
+    (iload 1)		; 26       save m
+                        ;     even-loop:
+    (iload 1)		; 27
+    (ifeq 10)		; 28       if m=0, goto even-t
+    (iload 1)		; 29
+    (iconst 1)		; 30
+    (isub)		; 31
+    (ifeq 9)		; 32       if m=1, goto even-nil
+    (iload 1)		; 33
+    (iconst 2)		; 34
+    (isub)		; 35
+    (istore 1)		; 36       m = m-1;
+    (goto -10)		; 37       goto even-loop
+                        ;    even-t:
+    (istore 1)		; 38       restore m
+    (iconst 1)		; 39       
+    (goto -35)		; 40       ``return'' 1 to ``caller''
+                        ;    even-nil:
+    (istore 1)		; 41       restore m
+    (iconst 0)		; 42
+    (goto -38)		; 43       ``return'' 0 to ``caller''
+    ))
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+; (even-clk m) takes us from an ``invocation'' of even through the
+; return to the caller.
+
+(defun even-loop-clk (m) ; Assume pc = 27 = even-loop
+  (if (zp m)
+      5
+      (if (equal m 1)
+          9
+          (clk+ 11
+                (even-loop-clk (- m 2))))))
+
+(defun even-clk (m) ; Assume we're at the ``invoke'' of even, pc = 4
+  (clk+ 2
+        (even-loop-clk m)))
+
+; (clk m) clocks the whole computation.  It's loop-clk calls even-clk to
+; when it gets to the invocation of even and assumes it leaves us at the instruction
+; after the invocation.
+
+(defun loop-clk (m)
+  (if (zp m)
+      3
+      (if (equal (mod m 2) 0)
+          (clk+ 2
+                (clk+ (even-clk m)
+                      (clk+ 10
+                            (loop-clk (* 1/2 m)))))
+          (clk+ 2
+                (clk+ (even-clk m)
+                      (clk+ 10
+                            (loop-clk (- m 1))))))))
+
+(defun clk (m)
+  (clk+ 2
+        (loop-clk m)))
+
+; Aside: I often define a little test function to let me play with my program
+; and clock.  This one prints the final pc, next-inst, locals and stack, but
+; not the program.
+
+(defun test (n m)
+  (let ((sf (m1 (make-state 0 (list n m) nil *pi*)
+                (clk m))))
+    (list (list :pc (pc sf) '--> (next-inst sf))
+          (list :locals (locals sf))
+          (list :stack (stack sf)))))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm even-loop-is-mod=0
+  (implies (natp m)
+           (equal
+            (m1 (make-state 27
+                            (list x m y)
+                            (push saved-m nil)
+                            *pi*)
+                (even-loop-clk m))
+            (make-state 5
+                        (list x saved-m y)
+                        (push (if (equal (mod m 2) 0) 1 0) nil)
+                        *pi*))))
+                
+
+(in-theory (disable even-loop-clk))
+
+; Important Note: The following is analogous to the specification of a method
+; invocation, equivalently, the addition of a new bytecode instruction.  Think
+; of the ``4'' in the initial state as an arbitrary pc pointing to the
+; invocation or bytecode in question.  The ``5'' in the final state is just
+; pc+1.  The theorem is like the semantics of execute-EVEN: ``The pc is
+; incremented by 1, the locals don't change, and a value, v, is pushed onto the
+; stack, where v is 1 or 0 depending on whether local 1 is even or odd.''
+
+(defthm even-is-mod=0
+  (implies (natp m)
+           (equal (m1 (make-state 4
+                                  (list n m a)
+                                  nil
+                                  *pi*)
+                      (even-clk m))
+                  (make-state 5
+                              (list n m a)
+                              (push (if (equal (mod m 2) 0) 1 0) nil)
+                              *pi*))))
+
+(in-theory (disable even-clk))
+
+; Once the above theorem has been proved it's as though we have a new
+; instruction (except here it must be used only at pc=4!).  When symbolic
+; execution gets to pc=4 with the appropriate clock, the machine just steps
+; to the next instruction and pushes the value of the even predicate on stack.
+
+(defthm helper-is-fn
+  (implies (and (ok-inputs n m)
+                (natp a))
+           (equal (m1 (make-state 2 (list n m a) nil *pi*)
+                      (loop-clk m))
+                  (make-state 25
+                              (list (final-n n m) 0 (helper n m a))
+                              (push (helper n m a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n m)
+           (equal (m1 (make-state 0
+                                  (list n m)
+                                  nil
+                                  *pi*)
+                      (clk m))
+                  (make-state 25
+                              (list (final-n n m) 0 (fn n m))
+                              (push (fn n m) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n m)
+           (equal (m1 (make-state 0
+                                  (list n m)
+                                  nil
+                                  *pi*)
+                      (clk m))
+                  (make-state 25
+                              (list (final-n n m) 0 (theta n m))
+                              (push (theta n m)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (natp m)
+                (equal sf (m1 (make-state 0
+                                          (list n m)
+                                          nil
+                                          *pi*)
+                              (clk m))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf)) (expt n m))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n and m, there
+; exists a clock (for example, the one constructed by (clk n)) such that
+; running *pi* with (list n m) as input produces a state, sf, that is halted
+; and which contains (expt n m) on top of the stack.  Note that the algorithm
+; used by *pi* is not specified or derivable from this formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/cert.acl2 acl2-6.3/books/models/jvm/guard-verified-m1/cert.acl2
--- acl2-6.2/books/models/jvm/guard-verified-m1/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/cert.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1 @@
+(include-book "m1")
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/defsys-utilities.lisp acl2-6.3/books/models/jvm/guard-verified-m1/defsys-utilities.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/defsys-utilities.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/defsys-utilities.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,142 @@
+; (include-book "m1")
+; (certify-book "defsys-utilities" 1)
+
+(in-package "M1")
+
+(defthm about-make-state
+  (and (true-listp (make-state pc locs stk prog))
+       (equal (len (make-state pc locs stk prog)) 4))
+  :hints (("Goal" :in-theory (enable make-state))))
+
+(defun name-locals (names locals i)
+  (cond ((endp names) t)
+        ((equal (car names) (nth i locals))
+         (name-locals (cdr names) locals (+ i 1)))
+        (t nil)))
+
+(defthm name-locals-opener
+  (and (equal (name-locals nil locals i) t)
+       (equal (name-locals (cons name names) locals i)
+              (and (equal name (nth i locals))
+                   (name-locals names locals (+ 1 i))))))
+
+(defun name-locals-locals-gen-hint (names junk)
+  (if (endp names)
+      junk
+      (name-locals-locals-gen-hint (cdr names)
+                                   (append junk (list (car names))))))
+
+(defthm append-assoc
+  (equal (append (append a b) c) (append a (append b c))))
+
+(defthm len-append
+  (equal (len (append a b)) (+ (len a) (len b))))
+
+(defthm nth-len-append
+  (equal (nth (len a) (append a b))
+         (car b)))
+
+(defthm name-locals-locals-gen
+  (equal (name-locals names (append junk names) (len junk))
+         t)
+  :hints (("Goal" :induct (name-locals-locals-gen-hint names junk)))
+  :rule-classes nil)
+
+(defthm name-locals-locals
+  (equal (name-locals names names 0) t)
+  :hints (("Goal" :use (:instance name-locals-locals-gen
+                                  (junk nil)))))
+
+(defun update-nth* (i lst locals)
+  (cond ((endp lst) locals)
+        (t (update-nth i (car lst)
+                       (update-nth* (+ i 1) (cdr lst) locals)))))
+
+(defthm update-nth*-opener
+  (and (equal (update-nth* i nil locals) locals)
+       (equal (update-nth* i (cons x lst) locals)
+              (update-nth i x (update-nth* (+ i 1) lst locals)))))
+
+(defthm len-update-nth-nil
+  (implies (natp i)
+           (equal (len (update-nth i v nil))
+                  (+ 1 i))))
+
+(defthm len-update-nth-inequality
+  (<= (len x) (len (update-nth i v x)))
+  :rule-classes :linear)
+
+; The :rewrite rule len-update-nth causes case splits that prevent us
+; from establishing some of the READY-AT hypotheses.  It seems to be sufficient
+; to know just the weaker :linear result, just proved.  So we disable the rewrite rule.
+
+(in-theory (disable len-update-nth))
+
+(defthm update-nth-noop
+  (implies (and (natp i)
+                (< i (len x)))
+           (equal (update-nth i (nth i x) x) x)))
+
+(defun number-of-explicit-elements (x)
+  (cond ((atom x) 0)
+        ((quotep x)
+         (cond ((true-listp (car (cdr x)))
+                (len (car (cdr x))))
+               ((consp (car (cdr x)))
+                (+ 1 (number-of-explicit-elements
+                      (kwote (cdr (car (cdr x)))))))
+               (t 0)))
+        ((eq (acl2::ffn-symb x) 'cons)
+         (+ 1 (number-of-explicit-elements (acl2::fargn x 2))))
+        (t 0)))
+
+(defthm nth-cons
+  (and (equal (nth 0 (cons e x)) e)
+       (implies (and (natp n)
+                     (syntaxp
+                      (and (quotep n)
+                           (natp (car (cdr n)))
+                           (<= (car (cdr n))
+                               (number-of-explicit-elements x)))))
+                (equal (nth (+ 1 n) (cons e x))
+                       (nth n x)))))
+
+(defthm true-listp-m1-update-nth-nil
+  (true-listp (update-nth i v nil)))
+
+(defthm true-listp-m1-update-nth
+  (implies (true-listp x)
+           (true-listp (update-nth i v x))))
+
+(in-theory (disable nth-alt-def nth-add1! update-nth))
+
+(defthm true-listp-locals-step
+  (implies (true-listp (locals s))
+           (true-listp (locals (step s))))
+  :hints (("Goal" :in-theory (enable step))))
+
+(defthm true-listp-locals-m1
+  (implies (true-listp (locals s))
+           (true-listp (locals (m1 s n))))
+  :hints (("Goal" :in-theory (enable m1))))
+
+(defthm len-locals-step
+  (<= (len (locals s))
+      (len (locals (step s))))
+  :hints (("Goal" :in-theory (enable step)))
+  :rule-classes :linear)
+
+(defthm len-locals-m1
+  (<= (len (locals s))
+      (len (locals (m1 s n))))
+  :hints (("Goal" :in-theory (enable m1)))
+  :rule-classes :linear)
+
+(defthm s-is-make-state-s
+  (implies (and (true-listp s)
+                (equal (len s) 4)
+                (equal (pc s) pc)
+                (equal (program s) program))
+           (equal (equal s (make-state pc (locals s) (stack s) program))
+                  t))
+  :hints (("Goal" :in-theory (enable make-state))))
\ No newline at end of file
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/defsys.acl2 acl2-6.3/books/models/jvm/guard-verified-m1/defsys.acl2
--- acl2-6.2/books/models/jvm/guard-verified-m1/defsys.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/defsys.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,2 @@
+(include-book "defsys-utilities")
+(certify-book "defsys" ? t)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/defsys.lisp acl2-6.3/books/models/jvm/guard-verified-m1/defsys.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/defsys.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/defsys.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,1771 @@
+; (ld '((include-book "defsys-utilities") . "defsys.lisp") :ld-pre-eval-print t)
+
+; (include-book "defsys-utilities")
+; (certify-book "defsys" 1)
+
+; Defsys -- a Verifying Mini-Compiler for M1
+; J Strother Moore
+; March, 2012
+
+; This file provides the defsys utility.  It takes a list of ``modules,''
+; compiles them into M1 code, defines the appropriate clocks and semantic
+; functions, and proves that the code is correct.  Here is an example that
+; illustrates what a ``module'' is and how the code is described in a
+; high-level source language akin to ACL2 except using IFEQ.
+
+; Every system is configured so that when starting from 0 it calls the MAIN
+; module using the arguments on the stack.  It then halts.  Note that a module
+; may return multiple values (see MOD2-FLOOR2) and note how that module is
+; called in the :code for MAIN: It is passed to RECOMBINE which treats
+; MOD2-FLOOR2 as having supplied 2 of its arguments.  (RECOMBINE needs 3 args
+; but is given 2 actual expressions in MAIN.)
+
+; Defsys also supports ``ghost variables.''  These are variables need to insure
+; termination of the corresponding ACL2 functions.  The provisions for ghost
+; variables are very hackish, designed with one example in mind: the situation
+; when the top level routine in a system doesn't always terminate and MAIN
+; calls it.  Ghost variables allow the additional keywords :ghost-formals,
+; :ghost-base-test, :ghost-base-value and :ghost-decr.  These are,
+; respectively, a list of variables, a test leading to forced termination, the
+; result in the case of forced termination, and a list of ``decrement''
+; expressions to be appended to every recursive call of fn.  We assume that
+; (nth 0 ghost-base-value) is 0 when forced termination occurs.
+
+; Basically a function like
+
+; (defun fn (vars)
+;   body)
+
+; with those additional keyword specifiers becomes:
+
+; (defun fn (vars ,@ghost-formals)
+;   (if ,ghost-base-test
+;       ,ghost-base-value
+;       body'))
+
+; where body' is body with all calls of fn given the additional final arguments
+; listed in ghost-decr.  For a relatively simple example of a use of ghost
+; variables, see low-seven.lisp.
+
+#|
+(defsys t
+  (mod2-floor2 :formals (x a)
+               :input (and (natp x) (natp a))
+               :output (mv (mod x 2) (+ a (floor x 2)))
+               :code (ifeq x (mv 0 a) (ifeq (- x 1) (mv 1 a) (mod2-floor2 (- x 2) (+ a 1))))
+               :post-events nil)
+  (recombine :formals (m q y)
+             :input (and (natp m)(natp q)(natp y))
+             :output (+ m (* y q))
+             :code (+ m (* y q)))
+  (lessp :formals (x y)
+         :input (and (natp x)
+                     (natp y))
+         :output (if (< x y) 1 0)
+         :code (ifeq y
+                     0
+                     (ifeq x
+                           1
+                           (lessp (- x 1) (- y 1)))))
+  (mod :formals (x y)
+       :input (and (natp x)
+                   (natp y)
+                   (not (equal y 0)))
+       :output (mod x y)
+       :code (ifeq (lessp x y)
+                   (mod (- x y) y)
+                   x))
+  (floor :formals (x y a)
+         :input (and (natp x)
+                     (natp y)
+                     (not (equal y 0))
+                     (natp a))
+         :output (+ a (floor x y))
+         :code (ifeq (lessp x y)
+                     (floor (- x y) y (+ a 1))
+                     a))
+  (main :formals (x y a)
+        :input (and (natp x)
+                    (natp y)
+                    (not (equal y 0))
+                    (natp a))
+        :output (+ (* 10000 (+ (mod x y) (* y (floor x y)))) a)
+        :code (+ (* 10000 (+ (mod x y) (* y (floor x y 0))))
+                 (recombine (mod2-floor2 a 0) 2))))
+
+(acl2::pe 'm1-psi)
+
+(defthm m1-psi-thm
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0))
+                (natp a))
+           (let ((sf (m1-psi x y a)))
+             (and (equal (next-inst sf) '(HALT))
+                  (equal (top (stack sf)) (+ (* 10000 x) a))))))
+
+(clk+ 2 (main-clock nil 231 7 456))
+
+(next-inst (m1-psi 231 7 456))
+; = (HALT)
+(top (stack (m1-psi 231 7 456)))
+; = 2310456
+
+QED!
+
+|#
+
+(in-package "M1")
+(acl2::program)
+
+; -----------------------------------------------------------------
+
+(defun pack (lst)
+  (declare (xargs :mode :program))
+  (intern-in-package-of-symbol
+   (coerce (acl2::packn1 lst)
+           'string)
+   'm1))
+
+
+; (defmacro trace$ (&rest args) `(acl2::trace$ ,@args))
+; (defmacro untrace$ (&rest args) `(acl2::untrace$ ,@args))
+
+; -----------------------------------------------------------------
+
+(acl2::set-irrelevant-formals-ok t)
+
+(defun rev1 (x a)
+  (if (endp x)
+      a
+      (rev1 (cdr x) (cons (car x) a))))
+
+(defun all-but-last (x)
+  (declare (xargs :mode :logic))
+  (if (endp x)
+      nil
+      (if (endp (cdr x))
+          nil
+          (cons (car x) (all-but-last (cdr x))))))
+
+
+
+(defun nv (fn var vars)
+  (let ((temp (member-equal var vars)))
+    (cond (temp
+; if a-reg were not 0, we'd have to add it to this number:
+           (- (len vars) (len temp)))
+          (t (er hard 'defsys
+                 "While compiling ~x0 we encountered an undeclared variable ~
+                  ~x1.  The locals of ~x0 are ~x2."
+                 fn var vars)))))
+
+; When we ILOAD a series of regs, we go from base up.  When we ISTORE a
+; series of regs, we go down to base.
+
+(defun ILOAD-series (base n)
+; (ILOAD-series 7 2) ==> ((ILOAD 7) (ILOAD 8))
+  (cond ((zp n) nil)
+        (t (cons `(ILOAD ,base)
+                 (ILOAD-series (+ 1 base) (- n 1))))))
+
+(defun ISTORE-series (base n)
+  (cond ((zp n) nil)
+        (t (cons `(ISTORE ,(+ base n -1))
+                 (ISTORE-series base (- n 1))))))
+
+(defun save-regs (n max-a-regs)
+  `((ISTORE ,(* 2 max-a-regs))
+    ,@(ISTORE-series max-a-regs n)
+    ,@(ILOAD-series 0 n)
+    (ILOAD ,(* 2 max-a-regs))
+    ,@(ILOAD-series max-a-regs n)
+    ,@(ISTORE-series 0 n)))
+
+; Let mvn below be the ;output-arity of the module.  We save the mvn results
+; temporarily into the B regs while we restore the pushed A regs.  We know that
+; at the end of this the ret pc is in the return pc register 2max-a-regs.
+
+(defun restore-regs (mvn n max-a-regs)
+  `(,@(ISTORE-series max-a-regs mvn)
+    (ISTORE ,(* 2 max-a-regs))
+    ,@(ISTORE-series 0 n)
+    ,@(ILOAD-series max-a-regs mvn)))
+
+(defun icount (acode)
+
+; Given a segment of acode generated by compiler-expr count how many
+; instructions will be in it after it is assembled and linked.  We know the
+; compiler does not lay down labels and it doesn't generate RETs.  So the only
+; pseudo-instructions in acode are CALLs.
+
+  (cond ((endp acode) 0)
+        ((and (consp (car acode))
+              (eq (op-code (car acode)) 'CALL))
+         (+ 2 (icount (cdr acode))))
+        ((and (consp (car acode))
+              (member (op-code (car acode))
+                      '(iload istore iconst iadd isub imul ifeq goto call)))
+         (+ (if (eq (op-code (car acode)) 'CALL)
+                2
+                1)
+            (icount (cdr acode))))
+        (t
+         (er hard 'icount
+             "Acode encountered an illegal instruction, label, or pseudo-instruction, ~x0."
+             (car acode)))))
+
+; We are about to implement a compiler from simple recursive functions to M1.
+; We will then implement a clock compiler to produce the corresponding
+; clock function.  To implement the clock compiler we must know the
+; return pc to which which each CALL returns.  That return pc affects the
+; clock for the CALL since the amount of time taken in the RET from that
+; call is a function of that return pc.
+
+; But the clock compiler is not looking at the compiled code where the CALL
+; really is.  It is looking at the high level language expression that was
+; compiled.  So how can the clock compiler determine the return pc for each
+; call?  We solve this problem by ``annotating'' the input definitions before
+; we begin compiling.  The annotation changes every function call (fn a1
+; ... an) into (fn id a1' ... an'), where id is a unique object associated with
+; this occurrence of this expression and the ai' are the recursively annotated
+; subexpressions.
+
+; The compiler generates annotated call statements, (CALL FOO id).
+; Add-return-labels, the function that adds return pc labels after each CALL,
+; builds a table associating the ids with the labels generated.  The linker
+; then builds a table associating labels with pcs.  So when the clock
+; compiler crawls over the annotated expressions to create the clocks it can
+; look at the id of the expression, get the corresponding label, and then the
+; corresponding return pc.
+
+(mutual-recursion
+ (defun annotate-expr (x id)
+   (cond ((atom x) x)
+         ((eq (car x) 'quote) x)
+         (t (cons (car x) (cons id (annotate-expr-lst (cdr x) 0 id))))))
+ (defun annotate-expr-lst (x i id)
+   (cond ((endp x) nil)
+         (t (cons (annotate-expr (car x) (cons i id))
+                  (annotate-expr-lst (cdr x) (+ i 1) id))))))
+
+(mutual-recursion
+ (defun strip-annotations-expr (x)
+   (cond ((atom x) x)
+         ((eq (car x) 'quote) x)
+         (t (cons (car x) (strip-annotations-expr-lst (cdr (cdr x)))))))
+
+ (defun strip-annotations-expr-lst (x)
+   (cond ((endp x) nil)
+         (t (cons (strip-annotations-expr (car x))
+                  (strip-annotations-expr-lst (cdr x)))))))
+
+; We handle tail recursive functions only.  We can properly compile full-blown
+; recursions and also properly compile ``sometimes tail-recursive'' functions
+; (which, like mc-flatten, contain both full-blown recursion and
+; tail-recursion).  But our clock compiler and the basic proof strategy do
+; not work for such functions.
+
+(mutual-recursion
+ (defun recursions-okp (mode fn expr)
+
+; We support two modes, :tail and :none.  The former checks that the only
+; recursions in expr are tail-recursive.  The latter checks that there are no
+; recursions in expr.
+
+   (cond ((atom expr) t)
+         ((eq (car expr) 'quote) t)
+         ((eq (car expr) 'IF)
+          (er hard 'compile-expr
+              "The compiler does not support IF.  Use IFEQ."))
+         ((eq (car expr) 'IFEQ)
+          (and (recursions-okp :none fn (nth 1 expr))
+               (recursions-okp mode fn (nth 2 expr))
+               (recursions-okp mode fn (nth 3 expr))))
+         ((eq (car expr) fn)
+          (if (eq mode :none)
+              nil
+              (recursions-okp-lst :none fn (cdr expr))))
+         (t (recursions-okp-lst :none fn (cdr expr)))))
+ (defun recursions-okp-lst (mode fn lst)
+   (cond ((endp lst) t)
+         (t (and (recursions-okp mode fn (car lst))
+                 (recursions-okp-lst mode fn (cdr lst)))))))
+
+(mutual-recursion
+ (defun chk-input-output-arity (expr amodules)
+
+; Amodules is the list of modules annotated so far.  Each module has a :formals
+; and an :output-arity field.  We confirm that every call of every function in
+; the annotated expression has the right number of arguments.  If so, we return
+; its output arity.  If not, we cause a hard error.
+
+   (cond
+    ((atom expr) 1)
+    ((eq (car expr) 'quote) 1)
+    ((eq (car expr) 'MV)
+     (chk-input-output-arity-lst (cddr expr) amodules))
+    ((eq (car expr) 'IFEQ)
+     (let ((test-output
+            (chk-input-output-arity (nth 2 expr) amodules))
+           (then-output
+            (chk-input-output-arity (nth 3 expr) amodules))
+           (else-output
+            (chk-input-output-arity (nth 4 expr) amodules)))
+       (cond
+        ((not (equal test-output 1))
+         (er hard 'defsys
+             "The test of an IFEQ must return 1 result but the test of ~x0 ~
+              returns ~x1."
+             expr test-output))
+        ((equal then-output else-output)
+         then-output)
+        (t (er hard 'defsys
+               "Both branches of an IFEQ must return the same number of ~
+                results, but in ~x0 the THEN branch returns ~x1 and the ELSE ~
+                branch returns ~x2."
+               expr then-output else-output)))))
+    (t
+     (let ((fn (car expr))
+           (expected-inputs
+            (if (member (car expr) '(+ - *))
+                2
+                (if (assoc-equal (car expr) amodules)
+                    (len (cadr (assoc-keyword :formals
+                                              (cdr (assoc-equal (car expr) amodules)))))
+                    nil)))
+           (expected-outputs
+            (if (member (car expr) '(+ - *))
+                1
+                (if (assoc-equal (car expr) amodules)
+                    (cadr (assoc-keyword :output-arity
+                                         (cdr (assoc-equal (car expr) amodules))))
+                    nil))))
+       (cond
+        ((equal expected-inputs nil)
+         (er hard 'defsys "Unknown function ~x0" fn))
+        (t (let ((actual-inputs
+                  (chk-input-output-arity-lst (cddr expr) amodules)))
+             (cond ((equal actual-inputs expected-inputs)
+                    expected-outputs)
+                   (t (er hard 'defsys
+                          "The function ~x0 expects ~x1 inputs but is ~
+                            supplied ~x2 inputs in the annotated expression ~
+                            ~x3."
+                          fn expected-inputs actual-inputs expr))))))))))
+ (defun chk-input-output-arity-lst (expr-lst amodules)
+   (cond ((endp expr-lst) 0)
+         (t (+ (chk-input-output-arity (car expr-lst) amodules)
+               (chk-input-output-arity-lst (cdr expr-lst) amodules))))))
+
+       
+
+; A module is a program name, fn, followed by a keyword alist containing, at
+; most, the keys
+
+; :formals -- list of formal parameters
+; :dcls -- nil or a DECLARE form to admit recursive fns
+; :input -- hypotheses about the formals (essentially a guard)
+; :output -- logical expression equal to the value left on the stack [see note]
+; :output-arity -- a natp constant, e.g., 1 or 3
+; :code -- source code from which we obtain M1 code by compilation
+
+; Note: If :output-arity is not specified and :output begins with MV,
+; :output-arity defaults to the number elements described by :output.  Things
+; should work when :output is an MV expression and :output-arity is omitted.
+; But if :output is some other expression, e.g., (my-algorithm x y), then you
+; have to tell defsys how many results are laid down by the code.  Of course,
+; there can be all sorts of discrepancies ... :output may describe 2 values,
+; :output-arity may specify 3, and the code may sometimes produce 2, 3, or 4!
+; But to verify, they'd all better agree.  This system cannot handle varying
+; output arities because the restore-regs code has to know how many values to
+; save.
+
+(defun annotate-module (module id)
+  (let ((legal-keys '(:formals :dcls :input :output
+                               :output-arity :code
+                               :ghost-formals
+                               :ghost-base-test :ghost-base-value
+                               :ghost-decr)))
+    (cond
+     ((and (consp module)
+           (symbolp (car module))
+           (acl2::keyword-value-listp (cdr module))
+           (acl2::subsetp (acl2::evens (cdr module)) legal-keys))
+      (let* ((fn (car module))
+             (expr (cadr (assoc-keyword :code (cdr module))))
+             (output-arity
+              (if (assoc-keyword :output-arity (cdr module))
+                  (cadr (assoc-keyword :output-arity (cdr module)))
+                  (if (and (consp (cadr (assoc-keyword :output (cdr module))))
+                           (or (eq (car (cadr (assoc-keyword :output (cdr module))))
+                                   'MV)
+                               (eq (car (cadr (assoc-keyword :output (cdr module))))
+                                   'acl2::MV)))
+                      (len (cdr (cadr (assoc-keyword :output (cdr module)))))
+                      1))))
+        (cond
+         ((member 's (cadr (assoc-keyword :formals (cdr module))))
+          (er hard 'defsys
+              "It is illegal for a module like ~x0 to use S as a formal ~
+               parameter because that variable name is used in certain of our ~
+               proof-support functions."
+              fn))
+         ((not (recursions-okp :tail fn expr))
+          (er hard 'defsys
+              "We only support tail-recursion and the module defining ~x0 is ~
+               not tail-recursive."
+              fn))
+         ((not (assoc-keyword :formals (cdr module)))
+          (er hard 'defsys
+              "You did not provide :FORMALS for ~x0."
+              fn))
+         ((not (assoc-keyword :code (cdr module)))
+          (er hard 'defsys
+              "You did not provide :CODE for ~x0."
+              fn))
+         ((not (natp output-arity))
+          (er hard 'defsys
+              "When an :output-arity is supplied it must be a natural number ~
+               and the :output-arity for ~x0 is not."
+              fn))
+         ((and (> output-arity 1)
+               (not (equal (cadr (assoc-keyword :input (cdr module))) t))
+               (not (and
+                     (consp (cadr (assoc-keyword :ghost-base-value (cdr module))))
+                     (or (equal (car (cadr (assoc-keyword :ghost-base-value (cdr module))))
+                                'mv)
+                         (equal (car (cadr (assoc-keyword :ghost-base-value (cdr module))))
+                                'acl2::mv))
+                     (equal (len (cdr (cadr (assoc-keyword :ghost-base-value (cdr module)))))
+                            output-arity))))
+          (er hard 'defsys
+              "When the :output-arity is greater than 1 you must supply a ~
+               :ghost-base-value, which must be an MV form of the appropriate ~
+               arity.  These rules are violated for ~x0 where the ~
+               :output-arity is ~x1 but :ghost-base-value is ~x2."
+              fn output-arity (cadr (assoc-keyword :ghost-base-value (cdr module)))))
+         ((and (or (assoc-keyword :ghost-base-test (cdr module))
+                   (assoc-keyword :ghost-decr (cdr module)))
+               (not (assoc-keyword :ghost-formals (cdr module))))
+          (er hard 'defsys
+              "When you supply either a :ghost-base-test or a :ghost-decr, ~
+               you must supply :ghost-formals but you did not in ~x0."
+              fn))
+         ((and (or (assoc-keyword :ghost-base-test (cdr module))
+                   (assoc-keyword :ghost-decr (cdr module)))
+               (not (and (assoc-keyword :ghost-base-test (cdr module))
+                         (assoc-keyword :ghost-base-value (cdr module))
+                         (assoc-keyword :ghost-decr (cdr module)))))
+          (er hard 'defsys
+              "When you supply either a :ghost-base-test or
+               or a :ghost-decr, you must supply both of them and a ~
+               :ghost-base-value as well.  You did not in ~x0."
+              fn))
+                   
+         ((and (and (assoc-keyword :ghost-formals (cdr module))
+                    (assoc-keyword :ghost-base-value (cdr module)))
+               (not (and (or (equal (car (cadr (assoc-keyword :ghost-base-value (cdr module)))) 'mv)
+                             (equal (car (cadr (assoc-keyword :ghost-base-value (cdr module)))) 'acl2::mv))
+                         (equal 0 (cadr (cadr (assoc-keyword :ghost-base-value (cdr module))))))))
+          (er hard 'defsys
+              "When :ghost-formals and a :ghost-base-value are supplied, the ~
+               :ghost-base-value must be an MV form with first result 0 but ~
+               in ~x0 the form is ~x1."
+              fn
+              (cadr (assoc-keyword :ghost-base-value (cdr module)))))
+         (t
+          (list (car module)
+                :formals (cadr (assoc-keyword :formals (cdr module)))
+                :dcls (cadr (assoc-keyword :dcls (cdr module)))
+                :input (or (cadr (assoc-keyword :input (cdr module))) t)
+                :output (or (cadr (assoc-keyword :output (cdr module)))
+                            :NONE)
+                :output-arity output-arity
+                :code (annotate-expr expr id)
+                :ghost-formals (cadr (assoc-keyword :ghost-formals (cdr module)))
+                :ghost-base-test (cadr (assoc-keyword :ghost-base-test (cdr module)))
+                :ghost-base-value (cadr (assoc-keyword :ghost-base-value (cdr module)))
+                :ghost-decr (cadr (assoc-keyword :ghost-decr (cdr module))))))))
+     (t (er hard 'defsys
+            "Bad DEFSYS syntax for module ~x0.  Each element must be of the form (symbol ~
+             :key1 val1 ... :keyn valn) where the only legal :keyi are ~&1."
+            (car module)
+            legal-keys)))))
+
+
+(defun annotate-modules (modules i id ans max-a-regs)
+  (cond ((endp modules)
+         (mv (rev1 ans nil) max-a-regs))
+        (t (let* ((amod (annotate-module (car modules) (cons i id)))
+                  (ans1 (cons amod ans)))
+             (acl2::prog2$
+              (chk-input-output-arity
+               (cadr (assoc-keyword :code (cdr amod)))
+               ans1)
+              (annotate-modules (cdr modules) (+ 1 i) id
+                                ans1
+                                (max max-a-regs
+                                     (max (len (cadr (assoc-keyword :formals (cdr amod))))
+                                          (cadr (assoc-keyword :output-arity (cdr amod)))))))))))
+
+(mutual-recursion
+ (defun compile-expr (fn loop vars expr max-a-regs)
+
+; expr is an annotated code expression: every fn call is of the form (fn id a1
+; ... an) instead of (fn a1 ... an).  By the way: this compiler handles
+; recursions just fine, including ``sometimes tail-recursive'' functions like
+; mc-flatten with some tail-recursive calls and some full-blown recursive
+; calls.  However, the clock compiler doesn't handle sometimes tail-recursive
+; functions properly.
+
+   (cond ((atom expr)
+          (cond ((symbolp expr)
+                 `((ILOAD ,(nv fn expr vars))))
+                (t `((ICONST ,expr)))))
+         ((eq (car expr) 'quote)
+          `((ICONST ,(cadr expr))))
+         ((member (car expr) '(+ - *))
+          `(,@(compile-expr nil nil vars (nth 2 expr) max-a-regs)
+            ,@(compile-expr nil nil vars (nth 3 expr) max-a-regs)
+            ,(case (car expr)
+               (+ '(IADD))
+               (- '(ISUB))
+               (otherwise '(IMUL)))))
+         ((eq (car expr) 'MV)
+          (compile-expr-lst nil loop vars (cdr (cdr expr)) max-a-regs))
+         ((eq (car expr) 'IF)
+          (er hard 'compile-expr
+              "The compiler does not support IF.  Use IFEQ."))
+         ((eq (car expr) 'IFEQ)
+          (let ((a (nth 2 expr))
+                (b (nth 3 expr))
+                (c (nth 4 expr)))
+            (let* ((test (compile-expr nil nil vars a max-a-regs))
+                   (then (compile-expr fn loop vars b max-a-regs))
+                   (else (compile-expr fn loop vars c max-a-regs))
+                   (last-else-inst (car (last else))))
+              (if (and (consp last-else-inst)
+                       (eq (car last-else-inst) 'GOTO))
+                  `(,@test
+                    (IFEQ ,(+ (icount else) 1))
+                    ,@else
+                    ,@then)
+                  `(,@test
+                    (IFEQ ,(+ (icount else) 2))
+                    ,@else
+                    (GOTO ,(+ (icount then) 1))
+                    ,@then)))))
+         (t (append
+             (compile-expr-lst nil loop vars (cdr (cdr expr)) max-a-regs)
+             (if (eq (car expr) fn)
+                 (append (ISTORE-series 0 (len vars))
+                         `((GOTO ,loop)))
+                 `((CALL ,(car expr) ,(cadr expr))))))))
+        
+ (defun compile-expr-lst (fn loop vars expr-lst max-a-regs)
+   (declare (xargs :mode :program))
+   (cond ((endp expr-lst) nil)
+         (t (append (compile-expr fn loop vars (car expr-lst) max-a-regs)
+                    (compile-expr-lst fn loop vars (cdr expr-lst) max-a-regs))))))
+  
+(defun compile-module (module max-a-regs)
+  (let* ((fn (car module))
+         (vars (cadr (assoc-keyword :formals (cdr module))))
+         (n (len vars))
+         (body (cadr (assoc-keyword :code (cdr module))))
+         (fn-loop (pack (list fn "-LOOP")))
+         (fn-exit (pack (list fn "-EXIT"))))
+    `(,fn
+      ,@(save-regs n max-a-regs)
+      ,fn-loop
+      ,@(compile-expr fn fn-loop vars body max-a-regs)
+      ,fn-exit
+      ,@(restore-regs (cadr (assoc-keyword :output-arity (cdr module)))
+                      n max-a-regs)
+      (RET ,fn))))
+
+(defun algorithm-name (fn)
+  (pack (list '! fn)))
+
+(defun nth-series (n base max)
+  (cond ((>= n max) nil)
+        (t (cons `(nth ,n ,base)
+                 (nth-series (+ 1 n) base max)))))
+
+(defun mv-nth-series (n base max)
+  (cond ((>= n max) nil)
+        (t (cons `(mv-nth ,n (mv-list ,max ,base))
+                 (mv-nth-series (+ 1 n) base max)))))
+
+(mutual-recursion
+ (defun algorithm-expr (fn expr amodule-lst)
+
+; Expr is an annotated expression and we strip the annotations out as we also
+; change the names of all the non-primitives from names such as FLOOR and MOD
+; to !FLOOR and !MOD, and convert the IFEQs to IFs.  Fn is either nil or a
+; function name.  When non-nil, fn is the name of a function we are defining
+; and expr was (originally) its body.  In the case that fn is non-nil and has
+; ghostly attributes, we put them into calls of fn.  Note that we don't know
+; how to make sense of calls of functions with ghostly attributes except at the
+; very top-level.  If, for example, foo has a ghost formal k and foo is called
+; in bar, which has no ghost formal, then what do we use for the x argument in
+; the call of foo from bar?  We simply return an ill-formed term in which foo
+; is called with an insufficient nubmer of arguments.
+
+   (cond ((atom expr) expr)
+         ((eq (car expr) 'IFEQ)
+          `(IF (EQUAL ,(algorithm-expr fn (nth 2 expr) amodule-lst)
+                      0)
+               ,(algorithm-expr fn (nth 3 expr) amodule-lst)
+               ,(algorithm-expr fn (nth 4 expr) amodule-lst)))
+         (t
+          (let ((ghost-formals
+                 (cadr
+                  (assoc-keyword :ghost-formals
+                                 (cdr (assoc-equal (car expr)
+                                                   amodule-lst)))))
+                (ghost-decr
+                 (if (equal (car expr) fn) ; if fn is nil this fails
+                     (cadr
+                      (assoc-keyword :ghost-decr
+                                     (cdr (assoc-equal fn
+                                                       amodule-lst))))
+                     nil))
+                (!fn (if (member (car expr) '(+ - * mv acl2::mv))
+                         (car expr)
+                         (algorithm-name (car expr))))
+                (args (algorithm-expr-lst fn (cdr (cdr  expr)) amodule-lst)))
+            (cons !fn
+                  (cond
+                   ((and (eq (car expr) fn) ghost-decr)
+                    (append args ghost-decr))
+                   (ghost-formals
+                    (append args ghost-formals))
+                   (t args)))))))
+
+ (defun algorithm-expr-lst (fn expr-lst amodule-lst)
+   (cond
+    ((endp expr-lst) nil)
+    (t (let* ((x (car expr-lst))
+              (arg (algorithm-expr fn x amodule-lst))
+              (output-arity
+               (cond ((and (consp x)
+                           (not (eq (car x) 'quote))
+                           (assoc-equal (car x) amodule-lst))
+                      (cadr (assoc-keyword :output-arity
+                                           (cdr (assoc-equal (car x)
+                                                             amodule-lst)))))
+                     (t 1)))
+              (rest (algorithm-expr-lst fn (cdr expr-lst) amodule-lst)))
+         (cond
+          ((equal output-arity 1)
+           (cons arg rest))
+          (t (append (mv-nth-series 0 arg output-arity) rest))))))))
+
+(defun add-return-labels (code i rcode id-to-label-table)
+
+; Every CALL must be followed by a label.  In addition, every call is currently
+; annotated with a unique id that associates it with the corresponding function
+; call in the original high-level expression.  We add a unique label after each
+; CALL and we build a table associating the unique ids of each call to the
+; label generated.  We do all this in a second pass, rather than as part of
+; compilation, because it is easier to guarantee that all the labels are
+; distinct.
+
+  (cond ((endp code)
+         (mv (rev1 rcode nil)
+                   id-to-label-table))
+        ((and (consp (car code))
+              (eq (op-code (car code)) 'CALL))
+         (let ((id (nth 2 (car code)))
+               (label (pack (list 'ret-pc- i '-from-call- (arg1 (car code))))))
+           (add-return-labels (cdr code)
+                              (+ 1 i)
+                              (rev1 `(,(car code)
+                                      ,label)
+                                    rcode)
+                              (cons (cons id label) id-to-label-table))))
+        (t (add-return-labels (cdr code)
+                              i
+                              (cons (car code) rcode)
+                              id-to-label-table))))
+
+(defun compile-module-lst (lst rcode max-a-regs)
+  (cond ((endp lst)
+         (add-return-labels (rev1 rcode '(NON-TERMINATING
+                                          (GOTO NON-TERMINATING)
+                                          ILLEGAL-FINAL-PC
+                                          (GOTO ILLEGAL-FINAL-PC)))
+                            0
+                            nil
+                            nil))
+        (t (compile-module-lst (cdr lst)
+                               (rev1 (compile-module (car lst) max-a-regs)
+                                     rcode)
+                               max-a-regs))))
+
+
+(defun compile-system (top-level-code module-lst max-a-regs)
+; module-lst is annotated.
+  (compile-module-lst module-lst
+                      (rev1 top-level-code nil)
+                      max-a-regs))
+
+(defun expand-CALL (inst ret-label rcode)
+  (rev1 `((ICONST ,ret-label)
+          (GOTO ,(arg1 inst)))
+        rcode))
+
+(defun expand-ret-lst (targets rcode max-a-regs)
+  (cond ((endp targets)
+         (rev1 '((GOTO NON-TERMINATING))
+               rcode))
+        ((endp (cdr targets))
+         (rev1 `((GOTO ,(car targets)))
+               rcode))
+        (t (expand-ret-lst 
+            (cdr targets) 
+            (rev1 `((ILOAD ,(* 2 max-a-regs))
+                    (ICONST ,(car targets))
+                    (ISUB)
+                    (IFEQ ,(car targets)))
+                  rcode)
+            max-a-regs))))
+
+(defun expand-RET (inst alist rcode max-a-regs)
+  (expand-ret-lst (cdr (assoc (arg1 inst) alist))
+                  rcode
+                  max-a-regs))
+
+; The alist below maps subrs to the return labels from all their callers.
+
+(defun assemble (code alist rcode max-a-regs)
+  (cond ((endp code)
+         (rev1 rcode nil))
+        ((atom (car code))
+         (assemble (cdr code)
+                   alist
+                   (cons (car code) rcode)
+                   max-a-regs))
+        ((eq (op-code (car code)) 'CALL)
+         (assemble (cdr code)
+                   alist
+                   (expand-CALL (car code) (cadr code) rcode)
+                   max-a-regs))
+        ((eq (op-code (car code)) 'RET)
+         (assemble (cdr code)
+                   alist
+                   (expand-RET (car code) alist rcode max-a-regs)
+                   max-a-regs))
+        (t (assemble (cdr code)
+                     alist
+                     (cons (car code) rcode)
+                     max-a-regs))))
+
+(defun label-table (code pc alist)
+  (cond ((endp code) alist)
+        ((atom (car code))
+         (label-table (cdr code)
+                      pc
+                      (cons (cons (car code) pc) alist)))
+        (t (label-table (cdr code)
+                        (+ 1 pc)
+                        alist))))
+
+(defun assoc-or-report (instr tablename key alist)
+  (let ((ans (assoc key alist)))
+    (if ans
+        ans
+        (er hard 'link
+            "While linking the instruction ~x0 no entry was found in ~x1 for ~x2.  The ~
+             value of ~x1 is ~X34."
+            instr tablename key alist nil))))
+
+(defun link (code pc label-table rcode)
+  (cond ((endp code)
+         (rev1 rcode nil))
+        ((atom (car code))
+         (link (cdr code) pc label-table rcode))
+        ((eq (op-code (car code)) 'ICONST)
+; We permit an ICONST instruction to use a label as data and replace the
+; label by the corresponding pc.
+
+         (link (cdr code)
+                (+ 1 pc)
+                label-table
+                (cons (if (integerp (arg1 (car code)))
+                          (car code)
+                          (list 'ICONST
+                                (cdr (assoc-or-report (car code)
+                                                      'label-table
+                                                      (arg1 (car code))
+                                                      label-table))))
+                      rcode)))
+        ((member (op-code (car code)) '(GOTO IFEQ))
+
+; We permit GOTO and IFEQ to use label names and replace them with the correct
+; relative jump distances.  However, if the arg given is a number, we leave it
+; in place.
+
+         (link (cdr code)
+                (+ 1 pc)
+                label-table
+                (cons (if (integerp (arg1 (car code)))
+                          (car code)
+                          (list (op-code (car code))
+                                (- (cdr (assoc-or-report (car code)
+                                                         'label-table
+                                                         (arg1 (car code))
+                                                         label-table))
+                                   pc)))
+                      rcode)))
+        ((member (op-code (car code)) '(ILOAD ISTORE IADD ISUB IMUL HALT))
+
+; All other M1 instructions are left as-is.
+
+         (link (cdr code)
+                (+ 1 pc)
+                label-table
+                (cons (car code) rcode)))
+        (t (er hard 'link
+               "Unrecognized instruction or pseudo-instruction, ~x0."
+               (car code)))))
+
+(defun defconst-lst (alist)
+  (cond ((endp alist) nil)
+        (t (cons `(defconst ,(pack (list '* (caar alist) '*))
+                    ,(cdr (car alist)))
+                 (defconst-lst (cdr alist))))))
+
+(defun switch-table (code alist)
+  (cond ((endp code) alist)
+        ((and (consp (car code))
+              (eq (op-code (car code)) 'CALL))
+         (let* ((subr (arg1 (car code)))
+                (ret-label (cadr code))
+                (temp (assoc subr alist))
+                (new-targets (add-to-set-equal ret-label (cdr temp))))
+           (switch-table (cdr code)
+                         (put-assoc-equal subr new-targets alist))))
+        (t (switch-table (cdr code) alist))))
+
+; Now we develop a compiler for clock functions.  The worst aspect of this
+; process is a hack I call the :STOP hack.  Recall that the then branch of an
+; IF is generally followed by a GOTO that skips over the else branch.  So the
+; clock for a then branch is generated by getting the clock for the code
+; and adding one TICK after it.  But this tick is not added if the last
+; instruction in the then branch is a GOTO.  However, now consider the code for
+; (if a (if b c d) e) and suppose c is a tail-recursive call compiled to a
+; GOTO.  Then the clock for c is correctly handled (no extra TICK) but the
+; clock for (if b c d) is not because we would add a TICK -- but that TICK
+; is not needed on every path through the code, just some paths.  We handle
+; this by putting the keyword :STOP into the clock when we see a
+; tail-recursive GOTO.  Then, we generate clocks like (clk+ (clk+ 
+; 11 (clk+ (foo-clock x) :STOP)) 1) like: (clk+ 11
+; (clk+ (foo-clock x) (clk+ :STOP 1))) which we just truncate at the
+; :STOP.  Thus, the extra TICK is added only on those branches not ending in a
+; tail-recursive GOTO.  But to make this work we have to normalize ifs and
+; associate the clk+s.
+
+(defun normalize-clk+-ifs (x)
+  (cond ((atom x) x)
+        ((eq (car x) 'quote) x)
+        ((eq (car x) 'IF)
+         `(IF ,(nth 1 x)
+              ,(normalize-clk+-ifs (nth 2 x))
+              ,(normalize-clk+-ifs (nth 3 x))))
+        ((eq (car x) 'clk+)
+         (let ((x1 (normalize-clk+-ifs (nth 1 x)))
+               (x2 (normalize-clk+-ifs (nth 2 x))))
+           (cond
+            ((and (consp x1)
+                  (eq (car x1) 'IF))
+             `(IF ,(nth 1 x1)
+                  ,(normalize-clk+-ifs `(clk+ ,(nth 2 x1) ,x2))
+                  ,(normalize-clk+-ifs `(clk+ ,(nth 3 x1) ,x2))))
+            ((and (consp x2)
+                  (eq (car x2) 'IF))
+             `(IF ,(nth 1 x2)
+                  ,(normalize-clk+-ifs `(clk+ ,x1 ,(nth 2 x2)))
+                  ,(normalize-clk+-ifs `(clk+ ,x1 ,(nth 3 x2)))))
+            (t `(clk+ ,x1 ,x2)))))
+        (t x)))
+
+(defun flatten-clk+-expr (x)
+  (cond ((and (consp x)
+              (eq (car x) 'clk+))
+         (append (flatten-clk+-expr (nth 1 x))
+                 (flatten-clk+-expr (nth 2 x))))
+        (t (list x))))
+
+(defun truncate-to-stop (x)
+  (cond ((endp x) nil)
+        ((eq (car x) :STOP) nil)
+        (t (cons (car x) (truncate-to-stop (cdr x))))))
+
+(defun combine-adjacent-natp-clocks (lst)
+  (cond ((endp lst) nil)
+        ((endp (cdr lst)) lst)
+        (t (let ((x1 (car lst))
+                 (lst1 (combine-adjacent-natp-clocks (cdr lst))))
+             (cond
+              ((and (natp x1)
+                    (natp (car lst1)))
+               (cons (+ x1 (car lst1))
+                     (cdr lst1)))
+              (t (cons x1 lst1)))))))
+
+(defun make-clk+-nest (lst)
+  (if (endp lst)
+      0
+      (if (endp (cdr lst))
+          (car lst)
+          `(clk+ ,(car lst)
+                 ,(make-clk+-nest (cdr lst))))))
+
+(defun associate-clk+s (x)
+  (cond ((atom x) x)
+        ((eq (car x) 'quote) x)
+        ((eq (car x) 'clk+)
+         (make-clk+-nest
+          (combine-adjacent-natp-clocks
+           (truncate-to-stop (flatten-clk+-expr x)))))
+        ((eq (car x) 'if)
+         `(if ,(nth 1 x)
+              ,(associate-clk+s (nth 2 x))
+              ,(associate-clk+s (nth 3 x))))
+        (t x)))
+
+(defun combine-clocks (lst1 lst2)
+
+; Each of the args is a list of clock expressions that will ultimately be
+; combined.  For example, lst1 might be '((foo-clock x) 5) and lst2 might be
+; '(3).  We ``concatentate'', combining explicit clocks (if any) on the last
+; element of lst1 and first of lst2.  So we combine the two examples above to
+; '((foo-clock x) 8).  Eventually we'll build a right-associated clk+ nest from
+; this list.
+
+  (let ((x1 (car (last lst1)))
+        (x2 (car lst2)))
+    (cond
+     ((and (natp x1)
+           (natp x2))
+      (append (all-but-last lst1)
+              (cons (+ x1 x2)
+                    (cdr lst2))))
+     (t (append lst1 lst2)))))
+
+(mutual-recursion
+ (defun compile-clock-expr (fn loop vars expr amodule-lst)
+; Expr is an annotated expression.
+   (cond ((atom expr)
+          '(1))   ; ILOAD or ICONST
+         ((eq (car expr) 'quote)
+          '(1))   ; ICONST
+         ((member (car expr) '(+ - *))
+          (combine-clocks
+           (compile-clock-expr nil nil vars (nth 2 expr) amodule-lst)
+           (combine-clocks
+            (compile-clock-expr nil nil vars (nth 3 expr) amodule-lst)
+            '(1)))) ; IADD, ISUB, IMUL
+         ((eq (car expr) 'MV)
+          (compile-clock-expr-lst nil loop vars (cdr (cdr expr)) amodule-lst))
+         ((eq (car expr) 'IF)
+          (er hard 'compile-clock-expr
+              "The clock compiler does not support IF.  Use IFEQ."))
+         ((eq (car expr) 'IFEQ)
+          (let ((a (nth 2 expr))
+                (b (nth 3 expr))
+                (c (nth 4 expr)))
+            (let* ((test-clock (compile-clock-expr nil nil vars a amodule-lst))
+                   (then-clock (compile-clock-expr fn loop vars b amodule-lst))
+                   (else-clock (compile-clock-expr fn loop vars c amodule-lst)))
+
+; I have debated whether the first arg to algorithm-expr below should be fn or
+; nil.  I will supply nil and that means that we won't supply ghost args if we
+; see a call of fn.  But I don't expect a call of fn in the test of a tail
+; recursive definition of fn!
+
+              `((IF (EQUAL ,(algorithm-expr nil a amodule-lst) 0)
+                    ,(make-clk+-nest
+                      (combine-clocks
+                       test-clock
+                       (combine-clocks
+                        '(1) ; IFEQ
+                        then-clock)))
+                    ,(make-clk+-nest
+                      (combine-clocks
+                       test-clock
+                       (combine-clocks
+                        '(1) ; IFEQ
+                        (if (and (consp c)
+                                 (eq (car c) fn))
+                            else-clock
+                            (combine-clocks
+                             else-clock
+                             '(1)))))))))))  ; (GOTO skip-around-then)
+         (t (combine-clocks
+             (compile-clock-expr-lst nil loop vars (cdr (cdr expr)) amodule-lst)
+             (cond
+              ((eq (car expr) fn)
+               `(,(+ 1 (len (ISTORE-series 0 (len vars))))
+                 (,(pack (list loop '-CLOCK))
+                  ,@(algorithm-expr-lst nil (cdr (cdr expr)) amodule-lst)
+                  ,@(cadr (assoc-keyword :ghost-decr
+                                         (cdr (assoc-equal fn amodule-lst)))))
+; Note the :STOP hack marker, indicating that the preceding is a tail-recursive jump.
+; This prevents any subsequent clock from being appended to this branch.
+                 :STOP))
+              (t
+               `(2
+                 (,(pack (list (car expr) '-CLOCK))
+                  ',(cadr expr) ; id
+                  ,@(algorithm-expr-lst fn (cdr (cdr expr)) amodule-lst)
+                  ,@(cadr (assoc-keyword :ghost-formals
+                                         (cdr (assoc-equal (car expr) amodule-lst))))))))))))
+        
+ (defun compile-clock-expr-lst (fn loop vars expr-lst amodule-lst)
+   (declare (xargs :mode :program))
+   (cond ((endp expr-lst) nil)
+         (t (combine-clocks
+             (compile-clock-expr fn loop vars (car expr-lst) amodule-lst)
+             (compile-clock-expr-lst fn loop vars (cdr expr-lst) amodule-lst))))))
+
+; Now we develop the code to extract from a recursive clock function the
+; part of the clock that drives the code once around the loop.
+
+(mutual-recursion
+ (defun calledp (fn x)
+   (cond ((atom x) nil)
+         ((eq (car x) 'quote) nil)
+         ((eq fn (car x)) t)
+         (t (calledp-lst fn (cdr x)))))
+ (defun calledp-lst (fn lst)
+   (cond ((endp lst) nil)
+         (t (or (calledp fn (car lst))
+                (calledp-lst fn (cdr lst)))))))
+
+
+(defun generate-induction-hint-expr (fn hfn vars expr a)
+
+; Fn is the name of a recursive clock function, like FACT-LOOP-CLOCK, and
+; expr is its body.  We dive through expr and gut it, replacing all base-case
+; exits by (list ,@vars s) and all clk+ nests containing calls of fn, e.g., (clk+ a
+; (clk+ b (clk+ c (fn ...)))) by (hfn ... (m1 s (clk+ a (clk+ b c)))).  We assume (and
+; check later) that every call of fn is the last argument of some clk+ nest
+; output.  We check that by only looking for and replacing such calls and then
+; finally confirm that the result has no calls of fn.
+
+  (cond ((atom expr) `(list ,@vars s))
+        ((eq (car expr) 'quote) `(list ,@vars s))
+        ((eq (car expr) 'IF)
+         `(IF ,(nth 1 expr)
+              ,(generate-induction-hint-expr fn hfn vars (nth 2 expr) a)
+              ,(generate-induction-hint-expr fn hfn vars (nth 3 expr) a)))
+        ((eq (car expr) fn)
+         `(,hfn ,@(cdr expr) ,(if a
+                                  `(m1 s ,(make-clk+-nest (rev1 a nil)))
+                                  's)))
+        ((eq (car expr) 'clk+)
+         (generate-induction-hint-expr fn hfn vars (nth 2 expr)
+                                       (cons (nth 1 expr) a)))
+        ((calledp fn expr)
+         (er hard 'defsys
+             "It was thought impossible for a clock function, specifically ~
+              ~x0, to be called recursively in its body except as the deepest ~
+              argument of CLK+ nests in output branches of top-level IFs, but ~
+              it is called in ~x1."
+             fn expr))
+        (t `(list ,@vars s))))
+
+(defun make-push-nest (lst stack)
+  (cond ((endp lst) stack)
+        (t (make-push-nest (cdr lst) `(push ,(car lst) ,stack)))))
+  
+
+(defun make-acl2-body (ghost-base-test ghost-base-value hyps body)
+  (let ((body1 (if (eq hyps t)
+                   body
+                   `(if ,hyps ,body ,ghost-base-value))))
+    (if ghost-base-test
+        `(if ,ghost-base-test
+             ,ghost-base-value
+             ,body1)
+        body1)))        
+
+; The following function generates two or three functions depending on whether
+; the module is iterative.  If it has a loop in it, we generate three
+; functions: the loop clock, the top-level clock (including entry and
+; exit costs), and the induction hint.  If it does not have a loop, we just
+; generate the ``loop'' clock (even though it is not a loop, it is the core
+; of the module) and the top-level clock.
+
+(defun repeat (e n)
+  (if (zp n)
+      nil
+      (cons e (repeat e (- n 1)))))
+
+(defun defun-clock-and-hint-fns (module max-a-regs amodule-lst)
+  (let* ((fn (car module))
+         (loop (pack (list fn '-loop)))
+         (vars (cadr (assoc-keyword :formals (cdr module))))
+         (ghost-formals (cadr (assoc-keyword :ghost-formals (cdr module))))
+         (vars-and-ghosts (append vars ghost-formals))
+         (ghost-base-test (cadr (assoc-keyword :ghost-base-test (cdr module))))
+         (dcls (cadr (assoc-keyword :dcls (cdr module))))
+         (hyps (cadr (assoc-keyword :input (cdr module))))
+         (output-arity (cadr (assoc-keyword :output-arity (cdr module))))
+         (expr (cadr (assoc-keyword :code (cdr module))))
+         (loop-clock-list (compile-clock-expr fn loop vars expr amodule-lst))
+         (loop-clock (pack (list loop '-clock)))
+         (loop-clock-body
+          (associate-clk+s
+           (normalize-clk+-ifs
+            (make-clk+-nest loop-clock-list))))
+         (clock (pack (list fn '-clock)))
+         (clock-body (if ghost-formals
+                         `(if (equal (mv-nth 0 (mv-list ,output-arity
+                                                        (,(algorithm-name fn) ,@vars-and-ghosts)))
+                                     0)
+                              (clk+ ,(len (save-regs (len vars) max-a-regs)) 
+                                    (,loop-clock ,@vars-and-ghosts))
+                              (clk+ ,(len (save-regs (len vars) max-a-regs)) 
+                                    (clk+ (,loop-clock ,@vars-and-ghosts)
+                                          (clk+ ,(len (restore-regs output-arity
+                                                                    (len vars)
+                                                                    max-a-regs))
+                                                (exit-clock ',fn ret-pc)))))
+                         `(clk+ ,(len (save-regs (len vars) max-a-regs)) 
+                                (clk+ (,loop-clock ,@vars-and-ghosts)
+                                      (clk+ ,(len (restore-regs output-arity
+                                                                (len vars)
+                                                                max-a-regs))
+                                            (exit-clock ',fn ret-pc))))))
+         (hint (pack (list loop '-induction-hint)))
+         (hint-body (if (calledp loop-clock loop-clock-body)
+                        (generate-induction-hint-expr loop-clock hint vars loop-clock-body nil)
+                        :NON-RECURSIVE)))
+    (cond ((and (not (eq hint-body :NON-RECURSIVE))
+                (calledp loop-clock hint-body))
+           (er hard 'defsys
+               "In the process of defining the hint function ~x0 we gutted ~
+                the body of the corresponding clock function, ~x1, and ~
+                replaced all the recursive calls at the end of output CLK+ ~
+                nests by recursive calls of the ~x0.  But the original ~
+                clock function name, ~x0, still occurs in the purported ~
+                induction hint function body, ~x1, contrary to what we ~
+                thought was possible!"
+               hint fn hint-body))
+          (t
+           `(
+             (defun ,loop-clock ,vars-and-ghosts
+               ,@dcls
+; Clock fns return nil on forced termination, so I ignore ghost-base-value below.
+               ,(make-acl2-body ghost-base-test 0 hyps loop-clock-body))
+             (defun ,clock (ret-pc ,@vars-and-ghosts)
+               ,clock-body)
+
+             ,@(if (eq fn 'MAIN)
+                   `((defun m1-psi (,@vars-and-ghosts)
+                       (m1 (make-state 0
+                                       ',(repeat 0 (+ (* 2 max-a-regs) 1))
+                                       ,(make-push-nest vars nil)
+                                       (psi))
+                           (clk+ 2
+                                 (main-clock nil ,@vars-and-ghosts)))))
+                   nil)
+
+             ,@(cond ((not (eq hint-body :NON-RECURSIVE))
+                      `((defun ,hint (,@vars-and-ghosts s)
+                          ,@dcls
+; Hint functions return nil on forced termination, so I ignore ghost-base-value below.
+                          ,(make-acl2-body ghost-base-test nil hyps hint-body))))
+                     (t nil)))))))
+
+(defun defun-algorithm (module amodule-lst)
+  (let* ((fn (car module))
+         (ghost-formals (cadr (assoc-keyword :ghost-formals (cdr module))))
+         (ghost-base-test (cadr (assoc-keyword :ghost-base-test (cdr module))))
+         (ghost-base-value (cadr (assoc-keyword :ghost-base-value (cdr module))))
+         (vars-and-ghosts
+          (append (cadr (assoc-keyword :formals (cdr module)))
+                  ghost-formals))
+         (dcls (cadr (assoc-keyword :dcls (cdr module))))
+         (hyps (cadr (assoc-keyword :input (cdr module))))
+         (body (cadr (assoc-keyword :code (cdr module))))
+         (!fn (algorithm-name fn))
+         (!body (algorithm-expr fn body amodule-lst)))
+    (mv `(defun ,!fn ,vars-and-ghosts ,@dcls
+           ,(make-acl2-body ghost-base-test ghost-base-value hyps !body))
+        (calledp !fn !body))))
+
+(defun make-equal-var-top-pop-stack (vars stack)
+  (cond ((endp vars) nil)
+        (t (cons `(equal ,(car vars) (top ,stack))
+                 (make-equal-var-top-pop-stack (cdr vars) `(pop ,stack))))))
+
+(defun nth-i-locals-lst (n max-a-regs)
+  (nth-series n '(locals s) max-a-regs))
+
+(defun push-lst (nthfn n expr stack)
+  (cond ((zp n) stack)
+        (t `(push (,nthfn ,(- n 1) ,expr)
+                  ,(push-lst nthfn (- n 1) expr stack)))))
+
+(mutual-recursion
+ (defun ghost-calls (expr amodule-lst)
+
+; We return the list of all modules with ghost formals that are called in expr.
+
+   (cond ((atom expr) nil)
+         ((eq (car expr) 'quote) nil)
+         ((cadr (assoc-keyword :ghost-formals
+                               (cdr (assoc-equal (car expr) amodule-lst))))
+          (cons (car expr)
+                (ghost-calls-lst (cddr expr) amodule-lst)))
+         (t (ghost-calls-lst (cddr expr) amodule-lst))))
+ (defun ghost-calls-lst (lst amodule-lst)
+   (cond ((endp lst) nil)
+         (t (append (ghost-calls (car lst) amodule-lst)
+                    (ghost-calls-lst (cdr lst) amodule-lst))))))
+
+
+(defun verification-events-for-module (module ans max-a-regs amodule-lst)
+  (let* ((fn (car module))
+         (vars (cadr (assoc-keyword :formals (cdr module))))
+         (ghost-formals (cadr (assoc-keyword :ghost-formals (cdr module))))
+         (vars-and-ghosts (append vars ghost-formals))
+         (hyps (cadr (assoc-keyword :input (cdr module))))
+         (rhs (cadr (assoc-keyword :output (cdr module))))
+         (output-arity (cadr (assoc-keyword :output-arity (cdr module))))
+         (expr (cadr (assoc-keyword :code (cdr module))))
+         (ghost-calls (ghost-calls expr amodule-lst))
+         (ghost-call (car ghost-calls)))
+
+; If module contains a ghost call (a call to a module with ghost formals) then
+; either the only ghost calls are to the module itself (i.e., this is the
+; module introducing nontermination), or else the module should be MAIN, there
+; is only one ghost call, and MAIN has the same ghost formals as the ghost
+; calling module.
+
+    (acl2::prog2$
+     (if
+      (or (not ghost-calls)
+          (acl2::subsetp ghost-calls (list fn))
+          (and (equal fn 'MAIN)
+               (equal ghost-calls (list ghost-call))
+               (equal
+                (cadr
+                 (assoc-keyword :ghost-formals (cdr module)))
+                (cadr
+                 (assoc-keyword :ghost-formals
+                                (cdr (assoc-equal ghost-call
+                                                  amodule-lst)))))))
+      nil
+      (acl2::cw
+       "The module named ~x0 calls ~x1 and the called module has ghost ~
+        formals.  (Presumably ~x1 does not necessarily terminate and thus ~
+        thus ~x0 won't either.)  How are the ghost formals for ~x1 passed ~
+        down to its clock function in the clock function for ~x0?  I ~
+        have a really draconian convention:  I allow this only if the calling ~
+        module is MAIN, the only ghostly call MAIN makes is to ~x1, and MAIN ~
+        has identical ghost formals.  Under these circumstances I pass MAIN's ~
+        ghosts down to ~x1.  However, these draconian restrictions are not ~
+        met in this system.  I wasn't motivated to figure out what is really ~
+        needed in such general cases as this.  I suspect this defsys will ~
+        fail!  However, if you :TRANS1 it and replay the workable part to get ~
+        to the first nonsensical event, perhaps you can see how to patch up ~
+        the remaining events."
+       fn ghost-call))
+     (mv-let
+      (alg-def recursivep)
+      (defun-algorithm module amodule-lst)
+      (rev1
+       `(,alg-def
+
+         ,@(defun-clock-and-hint-fns module max-a-regs amodule-lst)
+
+         (defun ,(pack (list fn '-loop-final-locals)) (,@vars-and-ghosts s)
+           (locals (m1 s (,(pack (list fn '-loop-clock)) ,@vars-and-ghosts))))
+
+;         (defthm ,(pack (list 'true-listp- fn '-loop-final-locals))
+;           (implies (acl2::true-listp (locals s))
+;                    (acl2::true-listp (,(pack (list fn '-loop-final-locals)) ,@vars-and-ghosts s))))
+
+         (defthm ,(pack (list 'len- fn '-loop-final-locals))
+           (<= (len (locals s))
+               (len (,(pack (list fn '-loop-final-locals)) ,@vars-and-ghosts s)))
+           :rule-classes :linear)
+
+         ,@(if (and (eq fn 'MAIN)
+                    ghost-calls)
+
+; Given our draconian restriction that MAIN is the only module that can call a
+; module with ghost formals, we know that ghost-call is the name of the called
+; module, that ghost-call's correctness theorem splits on whether ghost-call
+; terminates and that in the event that it does not, m1 hangs at
+; ghost-call's loop.  In this case, we handle MAIN differently than for normal
+; always-terminating MAINs.  In particular, we splice in a definition for MAIN's
+; final (still non-terminal) stack and then use it in the correcness results.
+
+               `((defun main-loop-final-stack (,@vars-and-ghosts s)
+                   (stack (m1 s (main-loop-clock ,@vars-and-ghosts)))))
+               nil)
+
+         (defthm ,(pack (list fn '-loop-is- (algorithm-name fn)))
+           (implies
+            (and (ready-at ,(pack (list '* fn '-loop*)) (list ,@vars) 0 s)
+                 ,@(if (equal hyps t) nil (list hyps))) 
+            (equal
+             (m1 s (,(pack (list fn '-loop-clock)) ,@vars-and-ghosts))
+             ,(let ((terminal-state
+                     `(make-state
+                       ,(pack (list '* fn '-exit*))
+                       ,(if (equal (len vars) max-a-regs)
+                            `(,(pack (list fn '-loop-final-locals)) ,@vars-and-ghosts s)
+                            `(update-nth* ,(len vars)
+                                          (list ,@(nth-i-locals-lst (len vars) max-a-regs))
+                                          (,(pack (list fn '-loop-final-locals))
+                                           ,@vars-and-ghosts s)))
+                       ,(if (equal output-arity 1)
+                            `(push (,(algorithm-name fn) ,@vars-and-ghosts) (stack s))
+                            (push-lst 'mv-nth
+                                      output-arity
+                                      `(,(algorithm-name fn) ,@vars-and-ghosts)
+                                      '(stack s)))
+                       (psi))))
+                (if ghost-formals
+                    (if (and (eq fn 'MAIN)
+                             ghost-calls)
+                        
+                        `(if (equal (mv-nth 0 (mv-list ,output-arity (!MAIN ,@vars-and-ghosts))) 0)
+
+; Note that if MAIN hangs, it hangs at ghost-call's loop, not *MAIN-LOOP*.
+; Note also that we disavow any knowledge of the stack at that point, although
+; with some care we could reconstruct it: it is (stack s) with MAIN's locals
+; and return pc popped off, then (len vars) of (LOCALS s) pushed, then the
+; return pc pushed, then k locals of that state pushed, where k is the number
+; of vars of ghost-calls, and then the return pc back to MAIN.  But I do not
+; think we care about the stack of an infinitely looping state, since we'll
+; never pop back into it.
+
+                             (make-state ,(pack (list '* ghost-call '-loop*))
+                                         (main-loop-final-locals ,@vars-and-ghosts s)
+                                         (main-loop-final-stack ,@vars-and-ghosts s)
+                                         (psi))
+                             ,terminal-state)
+                        `(if (equal (mv-nth 0 (mv-list ,output-arity
+                                                       (,(algorithm-name fn) ,@vars-and-ghosts)))
+                                    0)
+                             (make-state ,(pack (list '* fn '-loop*))
+                                         (,(pack (list fn '-loop-final-locals)) ,@vars-and-ghosts s)
+                                         (stack s)
+                                         (psi))
+                             ,terminal-state))
+                    terminal-state))))
+           :hints (("Goal"
+                    ,@(if recursivep
+                          `(:induct (,(pack (list fn '-loop-induction-hint)) ,@vars-and-ghosts s))
+                          `(:do-not-induct t)))))
+
+         (in-theory (disable ,(pack (list fn '-loop-clock))
+                             ,(pack (list fn '-loop-final-locals))
+                             ,@(if (and (eq fn 'MAIN)
+                                        ghost-calls)
+                                   '(MAIN-LOOP-FINAL-STACK)
+                                   nil)))
+
+         (defun ,(pack (list fn '-final-locals)) (call-id ,@vars-and-ghosts s)
+           (locals (m1 s (,(pack (list fn '-clock)) call-id ,@vars-and-ghosts))))
+
+;         (defthm ,(pack (list 'true-listp- fn '-final-locals))
+;           (implies (acl2::true-listp (locals s))
+;                    (acl2::true-listp (,(pack (list fn '-final-locals)) call-id ,@vars-and-ghosts s))))
+
+         (defthm ,(pack (list 'len- fn '-final-locals))
+           (<= (len (locals s))
+               (len (,(pack (list fn '-final-locals)) call-id ,@vars-and-ghosts s)))
+           :rule-classes :linear)
+
+; We do an analogous treatment for the top-level MAIN theorem if it has a ghost call in it.
+
+         ,@(if (and (eq fn 'MAIN)
+                    ghost-calls)
+               `((defun main-final-stack (call-id ,@vars-and-ghosts s)
+                   (stack (m1 s (main-clock call-id ,@vars-and-ghosts)))))
+               nil)
+
+; We force the READY-AT and the requirements on call-id.  The idea is that if
+; the theorem fails to apply at a place where the fn code is clocked, it is
+; because of elementary programming mistakes having to do with pushing the
+; right arguments.
+
+         (defthm ,(pack (list fn '-is- (algorithm-name fn)))
+           (implies
+            (and (acl2::force
+                  (ready-at ,(pack (list '* fn '*))
+                            (locals s)
+                            ,(+ 1 (len vars))
+                            s))
+                 (acl2::force
+                  (member (cdr (assoc call-id *id-to-label-table*))
+                          (cdr (assoc ',fn *switch-table*))))
+                 (acl2::force
+                  (equal (top (stack s)) (final-pc ',fn call-id)))
+                 ,@(make-equal-var-top-pop-stack (rev1 vars nil) '(pop (stack s)))
+                 ,@(if (equal hyps t) nil `(,hyps)))
+            (equal
+             (m1 s (,(pack (list fn '-clock)) call-id ,@vars-and-ghosts))
+             ,(let ((terminal-state
+                     `(make-state (top (stack s))
+                                  (update-nth* 0
+                                               (list ,@(nth-i-locals-lst 0 max-a-regs))
+                                               (,(pack (list fn '-final-locals))
+                                                call-id ,@vars-and-ghosts s))
+                                  ,(if (equal output-arity 1)
+                                       `(push (,(algorithm-name fn) ,@vars-and-ghosts)
+                                              (popn ,(+ 1 (len vars)) (stack s)))
+                                       (push-lst 'mv-nth
+                                                 output-arity
+                                                 `(,(algorithm-name fn) ,@vars-and-ghosts)
+                                                 `(popn ,(+ 1 (len vars)) (stack s))))
+                                  (psi))))
+                (if ghost-formals
+                    (if (and (eq fn 'main)
+                             ghost-calls)
+                        `(if (equal (mv-nth 0 (mv-list ,output-arity
+                                                       (!MAIN ,@vars-and-ghosts)))
+                                    0)
+                             (make-state ,(pack (list '* ghost-call '-loop*))
+                                         (,(pack (list fn '-final-locals)) call-id ,@vars-and-ghosts s)
+                                         (main-final-stack call-id ,@vars-and-ghosts s)
+                                         (psi))
+                             ,terminal-state)
+                        `(if (equal (mv-nth 0 (mv-list ,output-arity
+                                                       (,(algorithm-name fn) ,@vars-and-ghosts)))
+                                    0)
+                             (make-state ,(pack (list '* fn '-loop*))
+                                         (,(pack (list fn '-final-locals)) call-id ,@vars-and-ghosts s)
+                                         (push (final-pc ',fn call-id)
+                                               ,(push-lst 'nth
+                                                          (len vars)
+                                                          '(locals s)
+                                                          `(popn ,(+ 1 (len vars)) (stack s))))
+                                         (psi))
+                             ,terminal-state))
+                    terminal-state))))
+                         
+           :hints (("Goal" :do-not-induct t)))
+
+         (in-theory (disable ,(pack (list fn '-clock))
+                             ,(pack (list fn '-final-locals))
+                             ,@(if (and (eq fn 'MAIN)
+                                        ghost-calls)
+                                   `(main-final-stack)
+                                   nil)))
+
+         ,@(if (eq rhs :NONE)
+               nil
+               `((defthm ,(pack (list (algorithm-name fn) '-spec))
+                   ,(let ((concl `(equal (,(pack (list (algorithm-name fn))) ,@vars-and-ghosts)
+                                         ,rhs)))
+                      (if (equal hyps t)
+                          concl
+                          `(implies ,hyps ,concl)))))))
+       ans)))))
+
+
+(defun verification-events-for-modules (amod-lst ans max-a-regs amodule-lst)
+; amod-lst is a tail of amodule-lst, the full list of annotated modules.
+  (cond ((endp amod-lst) (rev1 ans nil))
+        (t (verification-events-for-modules
+            (cdr amod-lst)
+            (verification-events-for-module (car amod-lst) ans max-a-regs amodule-lst)
+            max-a-regs amodule-lst))))
+
+; Before we execute the events created by defsys we give the user a chance to
+; elaborate them.
+
+; We develop a utility that allows us to edit a list of events ``off line.''
+; The utility takes a list of events and a list of commands and carries out the
+; commands.  We do not expand macros in the event list, nor do we look inside
+; of encapsulates.  Each edit command is of the form (ev-type ev-name place x),
+; where
+          
+; ev-type = DEFTHM, place = :before, :after, :hints, or :rule-classes
+; ev-type = DEFUN, place =  :before, :after, or :xargs
+
+; When place is :before or :after, x is assumed to be a list of events and is
+; spliced in before or after the one identified.
+
+; When place is :hints, :xargs, or :rule-classes, x is a legal value for that
+; and replaces the value given (or is added as the value if none is present).
+
+; Errors are caused if a command is not used.
+
+#|
+(edit-event-lst
+ '((defun foo (x) (+ 1 x))
+   (defun bar (x y) (declare (ignore x)) (declare (type integerp y)) (+ 1 y))
+   (defun mum1 (x y) (declare (ignore x)) (declare (xargs :measure (m x))) (declare (type integerp y)) (+ 1 y))
+   (defun mum2 (x y) (declare (ignore x) (xargs :measure (m x)) (type integerp y)) (+ 1 y))
+   (defthm lem1 (equal rhs lhs))
+   (defthm lem2 (equal rhs lhs) :rule-classes :rewrite)
+   (defthm lem3 (equal rhs lhs) :rule-classes :rewrite :hints (("Goal" :do-not-induct t)))
+   (defthm lem4 (equal rhs lhs) :hints (("Goal" :do-not-induct t))  :rule-classes :rewrite :otf-flg t))
+ '((defthm lem1 :before (a b c))
+   (defthm lem1 :before (d e f))
+   (defthm lem3 :hints (("Goal" a b c)))
+   (defthm lem1 :after (u v w))
+   (defthm lem1 :after (x y z))
+   (defun mum2 :xargs (u v w))
+   ;(defun mum2 :guard-hints (a b c)) ; <--- illegal edit command
+   ))
+|#
+
+(defun relevant-edit-commands (ev-type ev-name commands relevant-cmds leftover-cmds)
+
+; We return (mv relevant-cmds leftover-cmds), where relevant-cmds are all the
+; commands in commands that identify the event with the given type and name and
+; leftover-commands are the other commands.
+
+  (cond
+   ((endp commands)
+    (mv (rev1 relevant-cmds nil) (rev1 leftover-cmds nil)))
+   ((and (eq ev-type (nth 0 (car commands)))
+         (eq ev-name (nth 1 (car commands))))
+    (relevant-edit-commands ev-type ev-name (cdr commands)
+                            (cons (car commands) relevant-cmds)
+                            leftover-cmds))
+   (t
+    (relevant-edit-commands ev-type ev-name (cdr commands)
+                            relevant-cmds
+                            (cons (car commands) leftover-cmds)))))
+         
+(defun replace-keyword-arg (key val lst)
+  (cond ((endp lst)
+         (list :key val))
+        ((eq key (car lst))
+         (list* key val (cdr (cdr lst))))
+        (t (list* (car lst) (car (cdr lst))
+                  (replace-keyword-arg key val (cdr (cdr lst)))))))
+
+(defun edit-hints (event x)
+  (let ((name (nth 1 event))
+        (term (nth 2 event))
+        (alist (cdr (cdr (cdr event)))))
+    `(DEFTHM ,name ,term
+       ,@(if (assoc-keyword :hints alist)
+             (replace-keyword-arg :hints x alist)
+             `(:hints ,x ,@alist)))))
+
+(defun edit-rule-classes (event x)
+  (let ((name (nth 1 event))
+        (term (nth 2 event))
+        (alist (cdr (cdr (cdr event)))))
+    `(DEFTHM ,name ,term
+       ,@(if (assoc-keyword :rule-classes alist)
+             (replace-keyword-arg :rule-classes x alist)
+             `(:rule-classes ,x ,@alist)))))
+
+(defun replace-xargs (dcls x)
+  (cond ((endp dcls) `((DECLARE (XARGS ,@x))))
+        ((and (eq (car (car dcls)) 'DECLARE)
+              (assoc 'XARGS (cdr (car dcls))))
+         (cons (cons 'DECLARE
+                     (put-assoc-equal 'XARGS x (cdr (car dcls))))
+               (cdr dcls)))
+        (t (cons (car dcls)
+                 (replace-xargs (cdr dcls) x)))))
+
+(defun edit-xargs (event x)
+  (let ((name (nth 1 event))
+        (vars (nth 2 event))
+        (dcls (all-but-last (cdr (cdr (cdr event)))))
+        (body (nth (- (len event) 1) event)))
+    `(DEFUN ,name ,vars
+       ,@(replace-xargs dcls x)
+       ,body)))
+               
+(defun do-edit-command (cmd event before-events after-events)
+  (let ((ev-type (nth 0 cmd))
+        (place (nth 2 cmd))
+        (x (nth 3 cmd)))
+    (case place
+      (:before
+       (mv (append before-events x) event after-events))
+      (:after
+       (mv before-events event (append after-events x)))
+      (:hints
+       (cond
+        ((eq ev-type 'defthm)
+         (mv before-events (edit-hints event x) after-events))
+        (t (mv nil
+               (er hard 'defsys
+                   "The event editor cannot handle a :hints edit command ~
+                    except on DEFTHM events.  So ~x0 is an illegal edit ~
+                    command."
+               cmd)
+               nil))))
+      (:rule-classes
+       (cond
+        ((eq ev-type 'defthm)
+         (mv before-events (edit-rule-classes event x) after-events))
+        (t (mv nil
+               (er hard 'defsys
+                   "The event editor cannot handle a :rule-classes edit ~
+                    command except on DEFTHM events.  So ~x0 is an illegal ~
+                    edit command."
+               cmd)
+               nil))))
+      (:xargs
+       (cond
+        ((eq ev-type 'defun)
+         (mv before-events (edit-xargs event x) after-events))
+        (t (mv nil
+               (er hard 'defsys
+                   "The event editor cannot handle an :xargs edit command ~
+                    except on DEFUN events.  So ~x0 is an illegal edit ~
+                    command."
+               cmd)
+               nil))))
+      (otherwise
+       (mv nil
+           (er hard 'defsys
+               "The event editor cannot handle the command ~x0.  Legal ~
+                commands are (DEFTHM name :HINTS x), (DEFTHM name ~
+                :RULE-CLASSES x), (DEFUN name :XARGS x), (ev-type name ~
+                :BEFORE x), or (ev-type name :AFTER x)."
+           cmd)
+           nil)))))
+
+(defun do-edit-commands (cmds event before-events after-events)
+  (cond
+   ((endp cmds)
+    (mv before-events event after-events))
+   (t (mv-let (new-before-events new-event new-after-events)
+              (do-edit-command (car cmds) event before-events after-events)
+              (do-edit-commands (cdr cmds)
+                                new-event new-before-events new-after-events)))))
+
+(defun edit-event-lst (events commands)
+  (cond
+   ((endp events)
+    (cond (commands
+           (er hard 'xdefsys
+               "The following commands were not used, ~x0."
+               commands))
+          (t nil)))
+   ((and (consp (car events))
+         (consp (cdr (car events)))
+         (symbolp (cadr (car events))))
+    (mv-let (relevant-cmds leftover-cmds)
+            (relevant-edit-commands (car (car events))
+                                    (cadr (car events))
+                                    commands nil nil)
+             
+            (mv-let (before-events new-event after-events)
+                    (do-edit-commands relevant-cmds (car events) nil nil)
+                    (append before-events
+                            (cons new-event
+                                  (append after-events
+                                          (edit-event-lst (cdr events) leftover-cmds)))))))
+   (t (cons (car events)
+            (edit-event-lst (cdr events) commands)))))
+
+(defmacro defsys (acl2::&key ld-flg modules edit-commands)
+  (mv-let
+   (amodule-lst max-a-regs)
+   (annotate-modules modules 0 nil nil 0)
+   (mv-let
+    (ccode id-to-label-table)
+    (compile-system '((CALL MAIN) (HALT))
+                    amodule-lst max-a-regs)
+
+; This system will require a total of 2*max-a-regs + 1 locals.  The first max-var
+; of them, locals 0, ..., max-var-1, are called the ``A registers''.  The next
+; max-var of them, namely max-var, max-var+1, ..., 2max-var-1, are the ``B
+; registers''.  The last, 2max-var, is the return-pc register.  The A registers
+; are used to hold the locals of the active module.  The B registers are used
+; merely to implement the basic operations of CALL and RET.  (To enter a module
+; with n locals, we pop n items off the stack and store them in the B
+; registers.  Then we push the relevant A registers to protect them.  Then we
+; move the B registers to the A registers for use by the module's code.
+; Exiting upon RET is the symmetric operation.)
+
+    (let* ((switch-table (switch-table ccode nil))
+           (acode (assemble ccode switch-table nil max-a-regs))
+           (label-table (label-table acode 0 nil))
+           (event-lst
+            `((defconst *amodule-lst* ',amodule-lst)
+              (defconst *max-a-regs* ,max-a-regs)
+              (defconst *ccode* ',ccode)
+              (defconst *acode* ',acode)
+              (defconst *psi* ',(link acode 0 label-table nil))
+              (defun psi () *psi*)
+              (defthm next-inst-psi
+                (implies (acl2::syntaxp (acl2::quotep i))
+                         (equal (nth i (psi)) (nth i *psi*))))
+              (in-theory (disable psi (:executable-counterpart psi)))
+              (defconst *id-to-label-table* ',id-to-label-table)
+              (defconst *switch-table* ',switch-table)
+              (defconst *label-table* ',label-table)
+              ,@(defconst-lst label-table)
+
+; The code above generates the M1 byte code and our tables.  Now we work on the
+; verification events for each successive module.  The following function is
+; used in all the top-level clock functions, to compute the time to exit a
+; call with a given id.  From id we get the corresponding return pc label and
+; then compute where that label occurs in list of return targets considered.
+; If you look at expand-ret you see that jumpting to the first pc in lst takes
+; 4 instructions, the next 8, etc., until you get to the last pc in lst, which
+; takes just 1 more instruction than the previous label took.
+
+              (defun exit-clock (fn id)
+                (let* ((exit (cdr (assoc id *id-to-label-table*)))
+                       (lst (cdr (assoc fn *switch-table*)))
+                       (tail (member-equal exit lst)))
+                  (cond ((or (endp tail)
+                             (endp (cdr tail)))
+                         (+ 1 (* 4 (nfix (- (len lst) 1)))))
+                        (t (* 4 (+ 1 (nfix (- (len lst) (len tail)))))))))
+
+; This is used in the code correctness theorems and returns the final pc given
+; the called routine and the id of the call.
+ 
+              (defun final-pc (fn id)
+                (cond ((assoc-equal id *id-to-label-table*)
+                       (let* ((label (cdr (assoc-equal id *id-to-label-table*))))
+                         (cond ((member label (cdr (assoc fn *switch-table*)))
+                                (cdr (assoc label *label-table*)))
+                               (t *illegal-final-pc*))))
+                      (t *illegal-final-pc*)))
+
+              (defun ready-at (pc local-names d s)
+                (and (acl2::true-listp s)
+                     (equal (len s) 4)
+                     (equal (pc s) pc)
+;(acl2::true-listp (locals s))
+                     (<= ,(+ (* 2 max-a-regs) 1) (len (locals s)))
+                     (name-locals local-names (locals s) 0)
+                     (<= d (len (stack s)))
+                     (equal (program s) (psi))))
+
+              ,@(verification-events-for-modules amodule-lst nil
+                                                 max-a-regs amodule-lst)
+
+              ))
+           (elaborated-event-lst
+            (edit-event-lst event-lst edit-commands))
+           (final-event-lst
+            `((defconst *defsys-events*
+                ',event-lst)
+              (defconst *elaborated-defsys-events*
+                ',elaborated-event-lst)
+              ,@elaborated-event-lst)))
+      (if ld-flg
+          `(ld ',final-event-lst :ld-pre-eval-print t)
+          `(encapsulate nil ,@final-event-lst))))))
+
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/div.lisp acl2-6.3/books/models/jvm/guard-verified-m1/div.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/div.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/div.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,314 @@
+; Correctness of Division
+
+; Problem: Define an M1 program to compute the natural number quotient (i.e.,
+; the floor) of n divided by d, where n and d are natural numbers and d is not
+; 0.  Prove that your program is correct.  Note: In ACL2, the floor of n
+; divided by d is (floor n d), e.g., (floor 27 6) = 4.
+
+; Design Plan: I will count how many times I can take d away from n before n <
+; d.  I will keep the counter in an auxilliary variable, a.  However, I can't
+; test n < d directly with M1, so I have to implement that test with a loop.
+; So my solution will be a program with nested loops.  To test n < d I'll move
+; both n and d into two additional auxiliary variables, x and y, so I can count
+; them down without destroying n and d.
+
+; Because of the nested loops, this file deviates a little from our one-loop
+; template, but I'll preserve the template's names for the main algorithm and
+; its outer loop.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n d)
+  (and (natp n)
+       (natp d)
+       (not (equal d 0))))
+
+(defun theta (n d)
+  (floor n d))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+; Recall the lessp problem (see lessp.lisp).  We need that concept here.  It
+; will be the ``helper's helper'' but we call it ``lessp'' instead.  Every part
+; of this problem concerned with lessp is analogous to what we did in
+; lessp.lisp, but because we don't have method invocation we have to
+; ``re-verify'' the code.
+
+(defun lessp (x y)
+  (cond ((zp y) 0)
+        ((zp x) 1)
+        (t (lessp (- x 1) (- y 1)))))
+
+; Here is the lemma that says the helper's helper does what we intended.
+
+(defthm lessp-lemma
+  (implies (and (natp x)
+                (natp y))
+           (equal (lessp x y)
+                  (if (< x y) 1 0))))
+
+; By the way, the theorem above ``ought'' to have been proved below when we
+; prove the relations between the algorithms and the spec.  But we actually
+; need to know (lessp x y) ``is'' (< x y) to know that the helper terminates.
+; That's why we proved it ``early.''  It is not unusual in real projects to see
+; the template ``mixed up'' like this.
+
+; When you read the next defun, ignore rest for a moment!
+
+(defun helper (n d a rest)
+  (declare (ignore rest))
+  (if (and (natp n)
+           (natp d)
+           (not (equal d 0)))
+      (if (equal (lessp n d) 1)
+          a
+          (helper (- n d) d (+ 1 a) (list (- n d) 0)))
+      'illegal))
+
+; The role of rest in the definition of helper is very subtle.  Note that rest
+; is an argument that we explicitly ignore and but go to the bother of
+; specifying what its value is on each recursive call of helper.  We'll explain
+; the role of rest in helper later.  For now, just keep reading, recognizing
+; that we're following the template.
+
+(defun fn (n d)
+  (helper n d 0 nil))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, a, and rest and fn calls helper initializing a to 0 and rest to nil,
+; your helper theorem must be about (helper n m a rest), not just about the
+; special case (helper n m 0 nil).
+
+(defthm helper-is-theta
+  (implies (and (natp n)
+                (natp d)
+                (not (equal d 0))
+                (natp a))
+           (equal (helper n d a rest)
+                  (+ a (theta n d)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n m)
+           (equal (fn n m)
+                  (theta n m))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+
+; We compute (div n d), where n and d are naturals and d is not
+; zero.  We use the following locals:
+; 0 n
+; 1 d
+; 2 a - answer
+; 3 x - param for lessp 
+; 4 y - param for lessp
+  '((iconst 0)  ;  0
+    (istore 2)  ;  1   a = 0
+    (iload 0)   ;  2   loop:
+    (istore 3)  ;  3   x = n
+    (iload 1)   ;  4
+    (istore 4)  ;  5   y = d
+; (invoke lessp on n d)....
+    (iload 4)   ;  6   lessp-loop:          -- the code for lessp
+    (ifeq 12)   ;  7   if y=0, goto false
+    (iload 3)   ;  8
+    (ifeq 12)   ;  9   if x=0, goto to true
+    (iload 3)   ; 10
+    (iconst 1)  ; 11
+    (isub)      ; 12
+    (istore 3)  ; 13   x = x-1
+    (iload 4)   ; 14
+    (iconst 1)  ; 15
+    (isub)      ; 16
+    (istore 4)  ; 17   y = y-1
+    (goto -12)  ; 18   goto lessp-loop
+    (iconst 0)  ; 19   lessp is false
+    (goto 2)    ; 20
+    (iconst 1)  ; 21   lessp is true
+    (ifeq 3)    ; 22   if (n >= d) goto continue
+    (iload 2)   ; 23
+    (halt)      ; 24   return a
+    (iload 0)   ; 25   continue:
+    (iload 1)   ; 26
+    (isub)      ; 27
+    (istore 0)  ; 28   n = n-d
+    (iload 2)   ; 29
+    (iconst 1)  ; 30
+    (iadd)      ; 31
+    (istore 2)  ; 32   a = a+1
+    (goto -31)  ; 33   goto loop
+    ))
+
+; Note: We can now foreshadow a little the role of rest in helper.  The outer
+; loop, which helper models, starts at pc=2.  Upon the first arrival at pc=2,
+; there are exactly 3 locals, n, d, and a.  But upon the next and all
+; subsequent arrivals there are 5 locals: x and y were added when we invoked
+; the inner loop.  The first three arguments of helper are the contents of the
+; first three locals at the top of the outer loop.  The rest argument of helper
+; is a list containing the rest of the locals.  Keep reading the template and
+; we'll explain the role of rest in helper soon.
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun inner-loop-clk (x y)
+  (if (zp y)
+      4
+      (if (zp x)
+          5
+          (clk+ 13
+                (inner-loop-clk (- x 1) (- y 1))))))
+
+(defun outer-loop-clk (n d)
+  (if (and (natp n)
+           (natp d)
+           (not (equal d 0)))
+      (if (< n d)
+          (clk+ 4
+                (clk+ (inner-loop-clk n d)
+                      2))
+          (clk+ 4
+                (clk+ (inner-loop-clk n d)
+                      (clk+ 10
+                            (outer-loop-clk (- n d) d)))))
+      nil))
+
+(defun clk (n d)
+  (clk+ 2
+        (outer-loop-clk n d)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemmas about your loops must consider the general case.
+; For example, if a loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm inner-loop-is-lessp
+  (implies (and (natp x)
+                (natp y))
+           (equal (m1 (make-state 6
+                                  (list n d a x y)
+                                  nil
+                                  *pi*)
+                      (inner-loop-clk x y))
+                  (make-state 22
+                              (if (< x y)
+                                  (list n d a 0 (- y x))
+                                  (list n d a (- x y) 0))
+                              (push (lessp x y) nil)
+                              *pi*))))
+
+(in-theory (disable inner-loop-clk))
+
+; Note: Now we explain the role of rest in helper.  Note the locals of the
+; initial state.  (List* n d a rest) is a list whose first three elements are
+; n, d, and a, and whose remaining elements are those of rest.  The hypothesis
+; stipulates that upon the arrivial at the top of the outer loop (pc = 2) rest
+; is either nil or list containing exactly two more locals.
+
+; Of course, this theorem is proved by induction.  The induction hypothesis is
+; formed by replacing the variables below, n d, a, and rest, by new values as
+; done by some recursive function in the formula.  Helper is actually telling
+; the theorem prover what values to use for those variables -- including the
+; value of rest when we've traversed the loop.
+
+(defthm outer-loop-is-helper
+  (implies (and (natp n)
+                (natp d)
+                (not (equal d 0))
+                (natp a)
+                (or (equal rest nil)
+                    (equal (cdr (cdr rest)) nil)))
+           (equal (m1 (make-state 2
+                                  (list* n d a rest)
+                                  nil
+                                  *pi*)
+                      (outer-loop-clk n d))
+                  (make-state 24
+                              (list (mod n d)
+                                    d
+                                    (helper n d a rest)
+                                    0
+                                    (- d (mod n d)))
+                              (push (helper n d a rest) nil)
+                              *pi*))))
+
+(in-theory (disable outer-loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n d)
+           (equal (m1 (make-state 0
+                                  (list n d)
+                                  nil
+                                  *pi*)
+                      (clk n d))
+                  (make-state 24
+                              (list (mod n d) d (fn n d) 0 (- d (mod n d)))
+                              (push (fn n d) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n d)
+           (equal (m1 (make-state 0
+                                  (list n d)
+                                  nil
+                                  *pi*)
+                      (clk n d))
+                  (make-state 24
+                              (list (mod n d) d (theta n d) 0 (- d (mod n d)))
+                              (push (theta n d)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (natp d)
+                (not (equal d 0))
+                (equal sf (m1 (make-state 0
+                                          (list n d)
+                                          nil
+                                          *pi*)
+                              (clk n d))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf)) (floor n d))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n and d, there
+; exists a clock (for example, the one constructed by (clk n d)) such that
+; running *pi* with (list n d) as input produces a state, sf, that is halted
+; and which contains (floor n d) on top of the stack.  Note that the algorithm
+; used by *pi* is not specified or derivable from this formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/even-solution-1.lisp acl2-6.3/books/models/jvm/guard-verified-m1/even-solution-1.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/even-solution-1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/even-solution-1.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,188 @@
+; Correctness of Even
+
+; Problem: Define an M1 program that determines if its argument, n, is even or
+; odd.  You may assume n is a natural number.  To indicate that n is even,
+; leave 1 on the stack.  Otherwise, leave 0 on the stack.  Prove that your
+; program is correct.
+
+; Advice: A convenient expression of the idea ``n is even'' in ACL2 is the
+; expression (equal (mod n 2) 0).  That is, provided n is a natural number,
+; (equal (mod n 2) 0) is t if n is even and is nil if n is odd.
+
+; Design Plan: I will count n down to 0 by 2 and stop when it gets to either 0
+; or 1.  If 0, n was even; if 1, n was odd.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun theta (n)
+  (if (equal (mod n 2) 0) 1 0))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n)
+  (if (zp n)
+      1
+      (if (equal n 1)
+          0
+          (helper (- n 2)))))
+
+(defun fn (n) (helper n))
+
+; Note: Since the wrapper fn is just the helper, we don't need both.  But we'll
+; stick to the template.
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n m a), not just about the special case (helper n m 0).  
+
+(defthm helper-is-theta
+  (implies (ok-inputs n)
+           (equal (helper n)
+                  (theta n))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((ILOAD 0)    ;  0
+    (IFEQ 10)    ;  1
+    (ILOAD 0)    ;  2
+    (ICONST 1)   ;  3
+    (ISUB)       ;  4
+    (IFEQ 8)     ;  5
+    (ILOAD 0)    ;  6
+    (ICONST 2)   ;  7
+    (ISUB)       ;  8
+    (ISTORE 0)   ;  9
+    (GOTO -10)   ; 10
+    (ICONST 1)   ; 11
+    (GOTO 2)     ; 12
+    (ICONST 0)   ; 13
+    (HALT))      ; 14
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      4
+      (if (equal n 1)
+          7
+          (clk+ 11
+                (loop-clk (- n 2))))))
+
+(defun clk (n)
+  (loop-clk n))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Note: The lemma below is a bit tricky because we have to specify the values
+; left in the locals at the end of the run.  What is left in local 0, i.e.,
+; what is the final value of n?  It is either 0 or 1, i.e., it is (mod n 2).
+; This is the first time we have had to introduce a ``new'' function to specify
+; a loop's behavior.  But it happens often.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state 14
+                              (list (mod n 2))
+                              (push (helper n) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list (mod n 2))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list (mod n 2))
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (if (equal (mod n 2) 0)
+                           1
+                           0))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains 1 or 0 on top of the stack depending on whether n is even.  Note
+; that the algorithm used by *pi* is not specified or derivable from this
+; formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/even-solution-2.lisp acl2-6.3/books/models/jvm/guard-verified-m1/even-solution-2.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/even-solution-2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/even-solution-2.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,205 @@
+; Correctness of Even
+
+; Problem: Define an M1 program that determines if its argument, n, is even or
+; odd.  You may assume n is a natural number.  To indicate that n is even,
+; leave 1 on the stack.  Otherwise, leave 0 on the stack.  Prove that your
+; program is correct.
+
+; Advice: A convenient expression of the idea ``n is even'' in ACL2 is the
+; expression (equal (mod n 2) 0).  That is, provided n is a natural number,
+; (equal (mod n 2) 0) is t if n is even and is nil if n is odd.
+
+; Design Plan: I will count n down to 0 by 1 and flip a bit each time.  The bit
+; will start at 1.  If n is even, the final bit will be 1 (``true'') because
+; I'll have flipped it an even number of times; else it will be 0 (``false'')
+; because I'll have flipped it an odd number of times.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun theta (n)
+  (if (equal (mod n 2) 0) 1 0))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n bit)
+  (if (zp n)
+      bit
+      (helper (- n 1) (if (equal bit 0) 1 0))))
+
+(defun fn (n) (helper n 1))
+
+; Note: Since the wrapper fn is just the helper, we don't need both.  But we'll
+; stick to the template.
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n m a), not just about the special case (helper n m 0).  
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (or (equal bit 0)
+                    (equal bit 1)))
+           (equal (helper n bit)
+                  (if (equal (theta n) 0) ; n is odd
+                      (if (equal bit 0) 1 0)
+                      bit))))
+                      
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((ICONST 1)
+    (ISTORE 1)
+    (ILOAD 0)   ; loop = pc 2
+    (IFEQ 12)
+    (ILOAD 0)  
+    (ICONST 1) 
+    (ISUB)     
+    (ISTORE 0) 
+    (ILOAD 1)   ; the next 6 instrs flip bit.  That could be done with
+    (IFEQ 3)    ; (ILOAD 0) (ICONST -1)(IMUL)(ICONST 1)(IADD)(ISTORE 0)
+    (ICONST 0)  ; but that sequence takes 6 TICKs and this one takes
+    (GOTO 2)    ; either 4 or 5 depending on bit.
+    (ICONST 1)
+    (ISTORE 1)
+    (GOTO -12)
+    (ILOAD 1)
+    (HALT))
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n bit)
+  (if (zp n)
+      3
+      (if (equal bit 0)
+          (clk+ 11
+                (loop-clk (- n 1) 1))
+          (clk+ 12
+                (loop-clk (- n 1) 0)))))
+
+(defun clk (n)
+  (clk+ 2
+        (loop-clk n 1)))
+
+(defun test (n)
+  (let ((sf (m1 (make-state 0 (list n) nil *pi*) (clk n))))
+    (list (list :pc (pc sf) '--> (next-inst sf))
+          (list :locals (locals sf))
+          (list :stack (stack sf)))))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Note: The lemma below is a bit tricky because we have to specify the values
+; left in the locals at the end of the run.  What is left in local 0, i.e.,
+; what is the final value of n?  It is either 0 or 1, i.e., it is (mod n 2).
+; This is the first time we have had to introduce a ``new'' function to specify
+; a loop's behavior.  But it happens often.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n)
+                (or (equal bit 0)
+                    (equal bit 1)))
+           (equal (m1 (make-state 2
+                                  (list n bit)
+                                  nil
+                                  *pi*)
+                      (loop-clk n bit))
+                  (make-state 16
+                              (list 0 (helper n bit))
+                              (push (helper n bit) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 16
+                              (list 0 (fn n))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 16
+                              (list 0 (theta n))
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (if (equal (mod n 2) 0)
+                           1
+                           0))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains 1 or 0 on top of the stack depending on whether n is even.  Note
+; that the algorithm used by *pi* is not specified or derivable from this
+; formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/expt.lisp acl2-6.3/books/models/jvm/guard-verified-m1/expt.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/expt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/expt.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,170 @@
+; The Correctness of an Exponentiation Program
+
+; Problem: Define an M1 program to compute n^m (n raised to the power m), where
+; both n and m are natural numbers.
+
+; Design Plan: I will count m down and repeatedly multiply n into an accumulator a,
+; which will be initialized to 1.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n m)
+  (and (natp n)
+       (natp m)))
+
+(defun theta (n m)
+  (expt n m))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n m a)
+  (if (zp m)
+      a
+      (helper n (- m 1) (* n a))))
+
+(defun fn (n m) (helper n m 1))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n m a), not just about the special case (helper n m 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n m)
+                (natp a))
+           (equal (helper n m a)
+                  (* a (theta n m)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n m)
+           (equal (fn n m)
+                  (theta n m))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+       '((ICONST 1)   ; 0
+         (ISTORE 2)   ; 1  a = 1;
+         (ILOAD 1)    ; 2  [loop:]
+         (IFEQ 10)    ; 3  if m=0 then go to end;
+         (ILOAD 1)    ; 4
+         (ICONST 1)   ; 5
+         (ISUB)       ; 6
+         (ISTORE 1)   ; 7  m = m-1;
+         (ILOAD 0)    ; 8
+         (ILOAD 2)    ; 9
+         (IMUL)       ;10
+         (ISTORE 2)   ;11  a = n*a;
+         (GOTO -10)   ;12  go to loop
+         (ILOAD 2)    ;13  [end:]
+         (HALT))      ;14 ``return'' a
+    )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (m)
+  (if (zp m)
+      3
+      (clk+ 11
+            (loop-clk (- m 1)))))
+
+(defun clk (m)
+  (clk+ 2
+        (loop-clk m)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n m)
+                (natp a))
+           (equal (m1 (make-state 2
+                                  (list n m a)
+                                  nil
+                                  *pi*)
+                      (loop-clk m))
+                  (make-state 14
+                              (list n 0 (helper n m a))
+                              (push (helper n m a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n m)
+           (equal (m1 (make-state 0
+                                  (list n m)
+                                  nil
+                                  *pi*)
+                      (clk m))
+                  (make-state 14
+                              (list n 0 (fn n m))
+                              (push (fn n m) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n m)
+           (equal (m1 (make-state 0
+                                  (list n m)
+                                  nil
+                                  *pi*)
+                      (clk m))
+                  (make-state 14
+                              (list n 0 (theta n m))
+                              (push (theta n m)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (natp m)
+                (equal sf (m1 (make-state 0
+                                          (list n m)
+                                          nil
+                                          *pi*)
+                              (clk m))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf)) (expt n m))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n and m, there
+; exists a clock (for example, the one constructed by (clk n)) such that
+; running *pi* with (list n m) as input produces a state, sf, that is halted
+; and which contains (* n m) on top of the stack.  Note that the algorithm
+; used by *pi* is not specified or derivable from this formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/fact.lisp acl2-6.3/books/models/jvm/guard-verified-m1/fact.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/fact.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/fact.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,173 @@
+; Correctness of Fact
+
+; Problem: Define an M1 program to compute the factorial of its natural number
+; input.  Prove your program correct.
+
+; Design Plan: I will count n down to 0 by 1 and multiply each successive
+; result into an accumulator, a, initially 1.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun ! (n)
+  (if (zp n)
+      1
+      (* n (! (- n 1)))))
+
+(defun theta (n)
+  (! n))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n a)
+  (if (zp n)
+      a
+      (helper (- n 1) (* n a))))
+
+(defun fn (n) (helper n 1))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n a), not just about the special case (helper n 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (helper n a)
+                  (* a (theta n)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((iconst 1)  ;  0
+    (istore 1)  ;  1
+    (iload 0)   ;  2
+    (ifeq 10)   ;  3
+    (iload 1)   ;  4
+    (iload 0)   ;  5
+    (imul)      ;  6
+    (istore 1)  ;  7
+    (iload 0)   ;  8
+    (iconst 1)  ;  9
+    (isub)      ; 10
+    (istore 0)  ; 11
+    (goto -10)  ; 12
+    (iload 1)   ; 13
+    (halt))     ; 14
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (clk+ 11
+            (loop-clk (- n 1)))))
+
+(defun clk (n)
+  (clk+ 2
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n and a, you must characterize
+; its behavior for arbitrary, legal n and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (m1 (make-state 2
+                                  (list n a)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state 14
+                              (list 0 (helper n a))
+                              (push (helper n a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list 0 (fn n))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list 0 (theta n))
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (! n))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains (! n) on top of the stack.  Note that the algorithm used by *pi* is
+; not specified or derivable from this formula.
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/factorial-demo.lsp acl2-6.3/books/models/jvm/guard-verified-m1/factorial-demo.lsp
--- acl2-6.2/books/models/jvm/guard-verified-m1/factorial-demo.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/factorial-demo.lsp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,315 @@
+#||
+
+Correctness of Fact
+J Strother Moore
+
+[It is silly to put a date on this file, but it was prepared in December, 2012.
+But files just like this have been prepared and verified by our provers dating
+back to the late 1970s.]
+
+This book is like fact.lisp but is formatted for a demo.  It illustrates the M1
+model, informally relates it to the JVM, shows that we can execute it on
+concrete data, and shows how we prove theorems about its programs.
+
+M1 is an idealized machine loosely based on the Java Virtual Machine.  It
+supports only a few of the JVM's instructions but provides true (unbounded)
+integer arithmetic and so is strictly more powerful.
+
+Suppose the Demo.java contains:
+
+class Demo {
+  public static int fact(int n){
+      int a = 1;
+      while (n!=0) {a = n*a; n = n-1;}
+      return a;
+  }
+
+  public static void main(String[] args){
+      int n = Integer.parseInt(args[0], 10);
+      System.out.println(fact(n));
+      return;
+    }
+}
+
+Suppose you compile it with:
+
+ % javac Demo.java
+
+and then use
+
+ % javap -c Demo
+
+to print the class file.  Inspecting the JVM bytecode for fact you will see:
+
+public static int fact(int);
+  Code:
+   0:	iconst_1
+   1:	istore_1
+   2:	iload_0
+   3:	ifeq	17   // see note 1 below
+   6:	iload_0
+   7:	iload_1
+   8:	imul
+   9:	istore_1
+   10:	iload_0
+   11:	iconst_1
+   12:	isub
+   13:	istore_0
+   14:	goto	2   // see note 1 below
+   17:	iload_1
+   18:	ireturn     // see note 2 below
+
+Note 1: The actual JVM bytecode for the ifeq and goto instructions contains the
+OFFSETS from the current program counter to the target program counter, but the
+javap utility prints the absolute target.
+
+Note 2: The actual JVM bytecode for fact terminates with an ireturn to return a
+32-bit int to its caller.  M1 does not support method invocation and our code,
+below, simply halts with the answer on the stack.
+
+In this file we show how M1 models this and how we can prove a theorem stating
+its total correctness: that the program always terminates and computes the
+mathematical factorial of its natural number input.
+
+This file assumes you have verified the book m1.lisp on this directory.  To use
+this file, start ACL2 and execute each of the commands below.  Some commands
+just show how certain functions in the model are defined, other commands define
+new functions or constants, other commands just run the functions to illustrate
+their behavior, and still other commands prove theorems.
+
+||#
+
+; Start your acl2:
+; % acl2 (or whatever command you use)
+
+; Include the book:
+(include-book "m1")
+
+; Declare all symbols to be in the M1 package by default.
+(in-package "M1")
+
+; Here are the definitions of the M1 model, from the top-level
+; interpreter, M1, down:
+
+(pe 'm1)
+(pe 'step)
+(pe 'next-inst)
+(pe 'do-inst)
+
+; Inspection of do-inst will reveal that if the current instruction is not one
+; of those named, the next state is identical to the current state.  This means
+; that M1 will never advance past this unknown instruction.  We thus adopt a
+; canonical unknown instruction to halt the machine and call it HALT.  In fact,
+; there are an infinite number of ``halt'' instructions -- every opcode other
+; than those explicitly listed by do-inst.
+
+; Here are the definitions of certain bytecode instructions:
+
+(pe 'execute-ILOAD)
+(pe 'make-state)
+(pe 'execute-ICONST)
+(pe 'execute-IADD)
+(pe 'execute-ISTORE)
+(pe 'execute-GOTO)
+(pe 'execute-IFEQ)
+
+; Here is an M1 ``bytecode'' program that models the JVM class file
+; for fact above:
+
+(defconst *pi*
+; N and A allocated in locals 0 and 1, respectively
+       '((ICONST 1) ;  0
+         (ISTORE 1) ;  1     A := 1;
+         (ILOAD 0)  ;  2 loop:
+         (IFEQ 10)  ;  3     if N=0, goto end;
+         (ILOAD 1)  ;  4
+         (ILOAD 0)  ;  5
+         (IMUL)     ;  6
+         (ISTORE 1) ;  7     A := A*N;
+         (ILOAD 0)  ;  8
+         (ICONST 1) ;  9
+         (ISUB)     ; 10
+         (ISTORE 0) ; 11     N := N-1;
+         (GOTO -10) ; 12     goto loop
+         (ILOAD 1)  ; 13 end:
+         (HALT))    ; 14     ``return'' A;
+  )
+
+; This demonstrates running the program on input n=5 (and a=0).
+; This demonstration takes 1000 steps but it actually takes fewer
+; steps to reach the HALT.
+
+(m1 (make-state 0 '(5 0) nil *pi*) 1000)
+
+; Note that the final stack contains 120 (which we know is 5!) and that the
+; final program counter is 14, which points to the HALT instruction.
+
+; The next two functions define exactly how many steps it takes M1 to execute
+; the program on input n.  If stepped as many times as given by (clk n), M1
+; arrives at the HALT instruction.
+
+(defun loop-clk (n)
+       (if (zp n)
+           3
+           (clk+ 11
+                 (loop-clk (- n 1)))))
+
+(defun clk (n)
+       (clk+ 2 (loop-clk n)))
+
+; This shows the same run shown previously, but now instead of taking 1000
+; steps, we take exactly enough steps, (clk 5).
+
+(m1 (make-state 0 '(5 0) nil *pi*) (clk 5))
+
+; Observe that we reached the HALT (pc 14) with 120 on top of the stack.
+
+; How many steps did we need?
+
+(clk 5)
+
+; Here is the mathematical definition of factorial:
+
+(defun ! (n)
+       (if (zp n)
+           1
+           (* n (! (- n 1)))))
+
+; Here we show 5! = 120.
+
+(! 5)
+
+; Now we exercise the machine on a harder computation.  We use M1 to
+; compute 100!
+
+(m1 (make-state 0 '(100 0) nil *pi*) (clk 100))
+
+(clk 100)
+
+(! 100)
+
+; Note that M1's answer agrees with the actual mathematical answer.
+
+; And here we use M1 to compute 1000!
+
+(m1 (make-state 0 '(1000 0) nil *pi*) (clk 1000))
+
+(! 1000)
+
+; Careful inspection will reveal that the answer is correct.
+
+; These example executions show that M1, while a ``toy,'' is capable of some
+; significant computations and that the models runs reasonably fast.
+
+; Now we prove that this M1 program always halts with the right answer.
+
+; First we define the algorithm that the program uses:
+
+(defun fact1 (n a)
+       (if (zp n)
+           a
+           (fact1 (- n 1) (* n a))))
+
+; The broad outline of our proof will be (a) prove that the code implements the
+; algorithm, and then (b) prove that the algorithm satisfies the spec.  In this
+; case the code is the bytecode in *pi*, the algorithm is fact1, and the spec
+; is factorial, !.
+
+; Step (a)  - prove that the code implements the algorithm.
+
+; We start by proving that the loop implements the algorithm and then we prove
+; that if we enter the loop with a = 1 we get (fact1 n 1).
+
+; Here we prove that the loop, when entered with arbitrary naturals n and a,
+; computes the same thing as the algorithm, in loop-clk time.  Note that the
+; starting pc is 2 and the starting locals are n and a.  The ending pc is 14
+; (the HALT) and the ending stack has (fact1 n a) on top.
+
+(defthm loop-is-fact1
+        (implies (and (natp n)
+                      (natp a))
+                 (equal (m1 (make-state 2
+                                        (list n a)
+                                        nil
+                                        *pi*)
+                            (loop-clk n))
+                        (make-state 14
+                                    (list 0 (fact1 n a))
+                                    (push (fact1 n a) nil)
+                                    *pi*))))
+
+; Now we disable loop-clk so the theorem prover does not expand it.  If the
+; system cannot expand loop-clk then it will not rewrite (m1 ... (loop-clk n))
+; except by applying the above theorem, loop-is-fact1.  So by disabling the
+; clock function, we tell the theorem prover that it knows everything we think
+; it needs to reason about that portion of the code.
+
+(in-theory (disable loop-clk))
+
+; Now we prove that if the program is entered from the top (pc = 0) we reach
+; the HALT with the final answer (fact1 n 1).
+
+(defthm program-is-fact1
+        (implies (natp n)
+                 (equal (m1 (make-state 0
+                                        (list n)
+                                        nil
+                                        *pi*)
+                            (clk n))
+                        (make-state 14
+                                    (list 0 (fact1 n 1))
+                                    (push (fact1 n 1) nil)
+                                    *pi*))))
+
+; Now we disable the clk function for the program, again signalling that the
+; only way to reason about (m1 ... (clk n)) is to use the above lemma.
+
+(in-theory (disable clk))
+
+; This completes Step (a). 
+
+; Step (b) Prove that the algorithm satisfies the spec.
+
+; In this case, we prove the general relation between the algorithm and
+; factorial:
+
+(defthm fact1-is-!
+        (implies (and (natp n)
+                      (natp a))
+                 (equal (fact1 n a)
+                        (* a (! n)))))
+
+; Now the theorem prover can put steps (a) and (b) together to get that the
+; code satisfies the spec: when entered at pc = 0 with n, it reaches the HALT
+; with (! n) on the stack, in (clk n) steps.
+
+(defthm program-correct
+        (implies (natp n)
+                 (equal (m1 (make-state 0
+                                        (list n)
+                                        nil
+                                        *pi*)
+                            (clk n))
+                        (make-state 14
+                                    (list 0 (! n))
+                                    (push (! n)
+                                          nil)
+                                    *pi*))))
+
+; It is sometimes desirable to omit some of the details when we ``advertize'' a
+; theorem.  The result below, a simple corollary of that above, says that if
+; you have an arbitrary natural number n and if you let sf be the state
+; obtained by running the program from pc = 0 on n for (clk n) steps, then you
+; reach the HALT and (! n) is on top of the stack.
+
+(defthm total-correctness
+        (implies (and (natp n)
+                      (equal sf (m1 (make-state 0
+                                                (list n)
+                                                nil
+                                                *pi*)
+                                    (clk n))))
+                 (and (haltedp sf)
+                      (equal (top (stack sf))
+                             (! n))))
+        :rule-classes nil)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/fib.lisp acl2-6.3/books/models/jvm/guard-verified-m1/fib.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/fib.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/fib.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,275 @@
+; Correctness of Fib
+
+; Problem: Define an M1 program to compute the Fibonacci function on its
+; natural number input.  Prove your program correct.
+
+; Fib(0) = 0
+; Fib(1) = 1
+; Fib(2) = Fib(1)+Fib(0)
+; Fib(3) = Fib(2)+Fib(1)
+; ...
+
+; However, M1 does not have recursion or method call, so you have to do this
+; iteratively.  When you verify your helper function you will have to think of
+; the generalization that characterizes its output for all legal inputs, not
+; just the initial case.  It also means that when you verify your loop code
+; you'll have to specify the final values of ALL of the locals you're using.  I
+; suggest you define the function fib-locals to return the list of the final
+; values of all of the locals, rather than worry about the closed form
+; expression of them.
+
+; Design Plan: Think of the fib sequence 0, 1, 1, 2, 3, 5, 8, ... and arrange
+; two auxiliary variables, j and k, to hold the first two values, 0 and 1,
+; respectively.  This is a ``window'' into the sequence and it is possible to
+; slide the window to the right by shifting k into j and adding k to the old
+; value of j to get the new value of k.  So fib can be computed by sliding the
+; window up n times.  I control the slide by counting n down to 0 by 1.  I will
+; express this algorithm more precisely (and formally) when I verify it!
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun fib (n)
+  (if (zp n)
+      0
+    (if (equal n 1)
+        1
+      (+ (fib (- n 1))
+         (fib (- n 2))))))
+
+(defun theta (n)
+  (fib n))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n j k)
+  (if (zp n)
+      j
+    (if (equal n 1)
+        k
+    (helper (- n 1) k (+ j k)))))
+
+(defun fn (n) (helper n 0 1))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, j, and k and fn calls helper initializing j and k to 0 and 1, your helper
+; theorem must be about (helper n j k), not just about the special case (helper
+; n 0 1).
+
+; It takes some creativity to figure out what the helper function does for
+; arbitrary j and k (instead of the initial 0 and 1).  I figured it out by
+; drawing a little table for unknown j and k but n=7:
+
+; n            j             k
+; 7            j             k  <--- unknown initial values
+; 6            k           j+k
+; 5          j+k          j+2k
+; 4         j+2k         2j+3k
+; 3        2j+3k         3j+5k
+; 2        3j+5k         5j+8k
+; 1        5j+8k        8j+13k  
+
+; Do you recognize the coefficients on j and k in the final line?
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (natp j)
+                (natp k)
+                (<= 1 n))
+           (equal (helper n j k)
+                  (+ (* (fib (- n 1)) j)
+                     (* (fib n) k)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((iconst 0)   ;  0
+    (istore 1)   ;  1  j = 0
+    (iconst 1)   ;  2
+    (istore 2)   ;  3  k = 1
+    (iload 0)    ;  4 loop:
+    (ifeq 16)    ;  5  if n=0, goto exitj
+    (iload 0)    ;  6
+    (iconst 1)   ;  7
+    (isub)       ;  8
+    (ifeq 14)    ;  9  if n=1, goto exitk
+    (iload 0)    ; 10
+    (iconst 1)   ; 11
+    (isub)       ; 12
+    (istore 0)   ; 13  n=n-1
+    (iload 2)    ; 14  save k on stack
+    (iload 1)    ; 15  
+    (iload 2)    ; 16
+    (iadd)       ; 17
+    (istore 2)   ; 18  k=j+k
+    (istore 1)   ; 19  j= saved k
+    (goto -16)   ; 20  goto loop
+    (iload 1)    ; 21 exitj: return j
+    (halt)       ; 22
+    (iload 2)    ; 23 exitk: return k
+    (halt))      ; 24
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (if (equal n 1)
+          7
+          (clk+ 17
+                (loop-clk (- n 1))))))
+
+(defun clk (n)
+  (clk+ 4
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Hint: Define the function fib-locals to return the list of the final values
+; of all of the locals.  We could struggle to come up with closed-form expressions
+; for the final values of j and k but there's no need.  We're not interested --
+; but to verify the loop we have to specify what they are, somehow.
+ 
+(defun fib-locals (n j k)
+  (if (zp n)
+      (list n j k)
+      (if (equal n 1)
+          (list n j k)
+          (fib-locals (- n 1) k (+ j k)))))
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n, j, and k, you must characterize
+; its behavior for arbitrary, legal n, j, and k, not just a special case (e.g.,
+; where j and k are 0 and 1 respectively).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n)
+                (natp j)
+                (natp k))
+           (equal (m1 (make-state 4
+                                  (list n j k)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state (if (equal n 0) 22 24)
+                              (fib-locals n j k)
+                              (push (helper n j k) nil)
+                              *pi*))))
+
+; Contrast the statement above with what we would have to write had we NOT defined
+; fib-locals:
+
+; (defthm
+;   loop-is-helper
+;   (implies
+;    (and (ok-inputs n) (natp j) (natp k))
+;    (equal (m1 (make-state 4 (list n j k) nil *pi*)
+;               (loop-clk n))
+;           (make-state (if (equal n 0) 22 24)
+;                       (list (if (equal n 0) 0 1)
+;                             (if (equal n 0)
+;                                 j
+;                                 (if (equal n 1)
+;                                     j
+;                                     (+ (* j (fib (- n 2)))
+;                                        (* k (fib (- n 1))))))
+;                             (if (equal n 0)
+;                                 k
+;                                 (+ (* j (fib (- n 1))) (* k (fib n)))))
+;                       (push (helper n j k) nil)
+;                       *pi*)))
+; 
+;   :hints (("Goal" :induct (helper n j k))))
+
+; Of course, we first would have to figure out WHAT to write for the final values
+; of j and k!  But we could, in principle, adopt this approach and modify the rest of the
+; file to reflect these final values.  I won't.  Instead, I'll rely on fib-locals
+; which is sort like saying ``the final locals are fib are whatever they are (as 
+; computed by the analogous ACL2 function.''
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state (if (equal n 0) 22 24)
+                              (fib-locals n 0 1)
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state (if (equal n 0) 22 24)
+                              (fib-locals n 0 1)
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (fib n))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains (fib n) on top of the stack.  Note that the algorithm used by *pi*
+; is not specified or derivable from this formula.
+
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/find-k!.acl2 acl2-6.3/books/models/jvm/guard-verified-m1/find-k!.acl2
--- acl2-6.2/books/models/jvm/guard-verified-m1/find-k!.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/find-k!.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,2 @@
+(include-book "theorems-a-and-b")
+(certify-book "find-k!" ? t)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/find-k!.lisp acl2-6.3/books/models/jvm/guard-verified-m1/find-k!.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/find-k!.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/find-k!.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,1511 @@
+; A Faster Calculation of Find-K
+; J Strother Moore
+; Sun Apr 15 17:09:07 2012
+
+; The *Rogers-Program* starting in state Q0 and *example-tape* takes:
+; 291,202,253,588,734,484,219,274,297,505,568,945,357,129,888,612,375,663,883 M1 steps
+; which is between 10^56 and 10^57.
+
+; Rest of these comments out of date...
+
+; In the Turing Equivalence of M1, we establish that a certain program *pi*
+; simulates a Turing machine computation of length n, i.e., (tmi st tape tm n),
+; in (find-k st! tape! pos! tm! w! n), where st!, tape!, pos!, tm!, and w! are the
+; M1 representations of st, tape, and tm.  (Pos! is the initial ``read/write
+; pointer'' into the M1 representation of the initial tape and w! is a
+; bit-width used in the encoding of tm.)
+
+; In the equivalence file we demonstrate a simple Turing machine which doubles
+; the number of 1s on the tape.  This machine, shown in Rogers and demonstrated
+; in the Equivalence Proof file, takes 78 steps to double 4 (1111).  How long
+; does it take M1 to do that same computation?
+
+; As defined for the equivalence proof, k computes a schedule -- a list of
+; TICKS of the appropriate length.  That definition of k in principal gives us
+; a way to answer the question above.  However, the number of M1 steps required
+; to do even simple Turing machine simulations is prohibitive because the
+; machine is coded as a bit-string and M1 does less-than, floor, and mod by
+; successive subtractions, e.g., an exponentially large number is being
+; decremented.
+
+; Because of the recursive method of defining the schedule functions --
+; necessary for the M1 code proofs -- it is also simply impractical to compute
+; schedules -- or their lengths -- directly from the definitions.  It is
+; necessary to produce closed form arithmetic expressions for the most basic
+; operations, e.g., less than, floor, mod, etc., before it becomes practical to
+; even compute how many steps are needed.
+
+; We do that here. Indeed, we define a function find-k!, prove that it is
+; equivalent to the k used in the equivalence proof, and then run it
+; on the Rogers machine for the 78-step computation.  The answer to the question
+; is that it takes M1:
+
+; 103,979,643,405,139,456,340,754,264,791,057,682,257,947,240,629,585,359,596
+
+; steps to simulate that computation.  That is slightly more than 10^56.
+
+; ---
+
+;(include-book "theorems-a-and-b")
+;(certify-book "find-k!" 1)
+(in-package "M1")
+
+(in-theory (enable binary-clk+))
+
+(defun fast-lessp-loop-clock (x y)
+  (+ (if (< x y) 6 3) (* 13 (acl2::min x y))))  
+
+(defthm lessp-loop-clock-lemma
+  (implies (and (natp x)
+                (natp y))
+           (equal (lessp-loop-clock x y)
+                  (fast-lessp-loop-clock x y)))
+  :hints (("Goal" :in-theory (enable lessp-loop-clock))))
+
+(in-theory (disable lessp-loop-clock))
+
+(defun fast-lessp-clock (ret-pc x y)
+  (+ 15 (+ (if (< x y) 6 3) (* 13 (acl2::min x y))) (exit-clock 'lessp ret-pc)))
+
+(defthm fast-lessp-clock-lemma
+  (implies (and (natp x)
+                (natp y))
+           (equal (lessp-clock ret-pc x y)
+                  (fast-lessp-clock ret-pc x y)))
+  :hints (("Goal" :in-theory (enable lessp-clock))))
+
+(in-theory (disable fast-lessp-clock))
+
+(defun fast-mod-loop-clock (x y)
+  (+ (* (+ 12 (fast-lessp-clock '(0 1) x y)) (floor x y))
+     (+ 7 (fast-lessp-clock '(0 1) (mod x y) y))))
+    
+
+(defthm fast-mod-loop-clock-lemma
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0)))
+           (equal (mod-loop-clock x y)
+                  (fast-mod-loop-clock x y)))
+  :hints (("Goal" :in-theory (enable mod-loop-clock fast-lessp-clock fast-lessp-loop-clock))))
+     
+(defthm natp-fast-mod-loop-clock-lemma
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0)))
+           (natp (fast-mod-loop-clock x y)))
+  :hints (("Goal" :in-theory (enable mod-loop-clock fast-lessp-clock fast-lessp-loop-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp x)
+                                           (natp y)
+                                           (not (equal y 0)))
+                                      (integerp (fast-mod-loop-clock x y))))
+                 (:linear
+                  :corollary (implies (and (natp x)
+                                           (natp y)
+                                           (not (equal y 0)))
+                                      (<= 0 (fast-mod-loop-clock x y))))))
+
+(in-theory (disable fast-mod-loop-clock))
+
+(defun fast-mod-clock (ret-pc x y)
+  (+ 15 (fast-mod-loop-clock x y) (exit-clock 'mod ret-pc)))
+
+(defthm fast-mod-clock-lemma
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0)))
+           (equal (mod-clock ret-pc x y)
+                  (fast-mod-clock ret-pc x y)))
+  :hints (("Goal" :in-theory (enable mod-clock))))
+
+(defthm natp-fast-mod-clock-lemma
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0)))
+           (natp (fast-mod-clock ret-pc x y)))
+  :hints (("Goal" :in-theory (enable mod-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp x)
+                                           (natp y)
+                                           (not (equal y 0)))
+                                      (integerp (fast-mod-clock ret-pc x y))))
+                 (:linear
+                  :corollary (implies (and (natp x)
+                                           (natp y)
+                                           (not (equal y 0)))
+                                      (<= 0 (fast-mod-clock ret-pc x y))))))
+
+(in-theory (disable fast-mod-clock))
+
+(defun fast-floor-loop-clock (x y)
+  (+ (* (+ 16 (fast-lessp-clock '(0 2) x y))
+        (floor x y))
+     (+ 7 (fast-lessp-clock '(0 2) (mod x y) y))))
+
+(defthm fast-floor-loop-clock-lemma
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0))
+                (natp a))
+           (equal (floor-loop-clock x y a)
+                  (fast-floor-loop-clock x y)))
+  :hints (("Goal" :in-theory (enable floor-loop-clock fast-lessp-clock fast-lessp-loop-clock))))
+
+(defthm natp-fast-floor-loop-clock-lemma
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0))
+                (natp a))
+           (natp (fast-floor-loop-clock x y)))
+  :hints (("Goal" :in-theory (enable floor-loop-clock fast-lessp-clock fast-lessp-loop-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp x)
+                                           (natp y)
+                                           (not (equal y 0))
+                                           (natp a))
+                                      (integerp (fast-floor-loop-clock x y))))
+                 (:linear
+                  :corollary (implies (and (natp x)
+                                           (natp y)
+                                           (not (equal y 0))
+                                           (natp a))
+                                      (<= 0 (fast-floor-loop-clock x y))))))
+
+(in-theory (disable fast-floor-loop-clock))
+
+(defun fast-floor-clock (ret-pc x y)
+  (+ 20 (fast-floor-loop-clock x y) (exit-clock 'floor ret-pc)))
+
+(defthm fast-floor-clock-lemma
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0))
+                (natp a))
+           (equal (floor-clock ret-pc x y a)
+                  (fast-floor-clock ret-pc x y)))
+  :hints (("Goal" :in-theory (enable floor-clock))))
+
+(defthm natp-fast-floor-clock-lemma
+  (implies (and (natp x)
+                (natp y)
+                (not (equal y 0))
+                (natp a))
+           (natp (fast-floor-clock ret-pc x y)))
+  :hints (("Goal" :in-theory (enable floor-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp x)
+                                           (natp y)
+                                           (not (equal y 0))
+                                           (natp a))
+                                      (integerp (fast-floor-clock ret-pc x y))))
+                 (:linear
+                  :corollary (implies (and (natp x)
+                                           (natp y)
+                                           (not (equal y 0))
+                                           (natp a))
+                                      (<= 0 (fast-floor-clock ret-pc x y))))))
+
+(in-theory (disable fast-floor-clock))
+
+(defun fast-log2-loop-clock (x)
+  (if (zp x)
+      3
+      (if (equal x 1)
+          8
+          (+ 17 (fast-floor-clock '(0 2 2 3) x 2)
+             (fast-log2-loop-clock (floor x 2))))))
+
+(defthm fast-log2-loop-clock-lemma
+  (implies (and (natp x)
+                (natp a))
+           (equal (log2-loop-clock x a)
+                  (fast-log2-loop-clock x)))
+  :hints (("Goal" :in-theory (enable log2-loop-clock))))
+
+(defthm natp-fast-log2-loop-clock-lemma
+  (implies (and (natp x)
+                (natp a))
+           (natp (fast-log2-loop-clock x)))
+  :hints (("Goal" :in-theory (enable log2-loop-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp x)
+                                           (natp a))
+                                      (integerp (fast-log2-loop-clock x))))
+                 (:linear
+                  :corollary (implies (and (natp x)
+                                           (natp a))
+                                      (<= 0 (fast-log2-loop-clock x))))))
+
+(in-theory (disable fast-log2-loop-clock))
+
+(defun fast-log2-clock (ret-pc x)
+  (+ 15
+     (fast-log2-loop-clock x)
+     (exit-clock 'log2 ret-pc)))
+
+(defthm fast-log2-clock-lemma
+  (implies (and (natp x)
+                (natp a))
+           (equal (log2-clock ret-pc x a)
+                  (fast-log2-clock ret-pc x)))
+  :hints (("Goal" :in-theory (enable log2-clock))))
+
+(defthm natp-fast-log2-clock-lemma
+  (implies (and (natp x)
+                (natp a))
+           (natp (fast-log2-clock ret-pc x)))
+  :hints (("Goal" :in-theory (enable log2-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp x)
+                                           (natp a))
+                                      (integerp (fast-log2-clock ret-pc x))))
+                 (:linear
+                  :corollary (implies (and (natp x)
+                                           (natp a))
+                                      (<= 0 (fast-log2-clock ret-pc x))))))
+
+(in-theory (disable fast-log2-clock))
+
+(defun fast-expt-loop-clock (n)
+  (+ 3 (* 13 n)))
+
+(defthm fast-expt-loop-clock-lemma
+  (implies (and (natp x)
+                (natp n)
+                (natp a))
+           (equal (expt-loop-clock x n a)
+                  (fast-expt-loop-clock n)))
+  :hints (("Goal" :in-theory (enable expt-loop-clock))))
+
+(defthm natp-fast-expt-loop-clock-lemma
+  (implies (and (natp x)
+                (natp n)
+                (natp a))
+           (natp (fast-expt-loop-clock n)))
+  :hints (("Goal" :in-theory (enable expt-loop-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp x)
+                                           (natp n)
+                                           (natp a))
+                                      (integerp (fast-expt-loop-clock n))))
+                 (:linear
+                  :corollary (implies (and (natp x)
+                                           (natp n)
+                                           (natp a))
+                                      (<= 0 (fast-expt-loop-clock n))))))
+
+(in-theory (disable fast-expt-loop-clock))
+
+(defun fast-expt-clock (ret-pc n)
+  (+ 20 (fast-expt-loop-clock n) (exit-clock 'expt ret-pc)))
+
+(defthm fast-expt-clock-lemma
+  (implies (and (natp x)
+                (natp n)
+                (natp a))
+           (equal (expt-clock ret-pc x n a)
+                  (fast-expt-clock ret-pc n)))
+  :hints (("Goal" :in-theory (enable expt-clock))))
+
+(defthm natp-fast-expt-clock-lemma
+  (implies (and (natp x)
+                (natp n)
+                (natp a))
+           (natp (fast-expt-clock ret-pc n)))
+  :hints (("Goal" :in-theory (enable expt-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp x)
+                                           (natp n)
+                                           (natp a))
+                                      (integerp (fast-expt-clock ret-pc n))))
+                 (:linear
+                  :corollary (implies (and (natp x)
+                                           (natp n)
+                                           (natp a))
+                                      (<= 0 (fast-expt-clock ret-pc n))))))
+
+(in-theory (disable fast-expt-clock))
+
+
+(DEFUN fast-NST-IN-LOOP-CLOCK (CELL W)
+  (+ 8
+     (fast-expt-clock '(1 5) W)
+     (fast-mod-clock '(5) cell (expt 2 W))))
+
+(defthm fast-nst-in-loop-clock-lemma
+  (implies (AND (NATP CELL)
+                (NATP W))
+           (equal (NST-IN-LOOP-CLOCK cell w)
+                  (fast-NST-IN-LOOP-CLOCK cell w)))
+  :hints (("Goal" :in-theory (enable NST-IN-LOOP-CLOCK))))
+
+(defthm natp-fast-nst-in-loop-clock-lemma
+  (implies (AND (NATP CELL)
+                (NATP W))
+           (natp (fast-NST-IN-LOOP-CLOCK cell w)))
+  :hints (("Goal" :in-theory (enable NST-IN-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP CELL)
+                                           (NATP W))
+                                      (integerp (fast-NST-IN-LOOP-CLOCK cell w))))
+                 (:linear
+                  :corollary (implies (AND (NATP CELL)
+                                           (NATP W))
+                                      (<= 0 (fast-NST-IN-LOOP-CLOCK cell w))))))
+
+(in-theory (disable fast-NST-IN-LOOP-CLOCK))
+
+
+(DEFUN fast-NST-IN-CLOCK (RET-PC CELL W)
+  (+ 15
+     (fast-NST-IN-LOOP-CLOCK CELL W)
+     (exit-clock 'NST-IN RET-PC)))
+
+(defthm fast-NST-IN-CLOCK-lemma
+  (implies (AND (NATP CELL)
+                (NATP W))
+           (equal (NST-IN-CLOCK RET-PC CELL W)
+                  (fast-NST-IN-CLOCK RET-PC CELL W)))
+  :hints (("Goal" :in-theory (enable NST-IN-CLOCK))))
+
+(defthm natp-fast-NST-IN-CLOCK-lemma
+  (implies (AND (NATP CELL)
+                (NATP W))
+           (natp (fast-NST-IN-CLOCK RET-PC CELL W)))
+  :hints (("Goal" :in-theory (enable NST-IN-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP CELL)
+                                           (NATP W))
+                                      (integerp (fast-NST-IN-CLOCK RET-PC CELL W))))
+                 (:linear
+                  :corollary (implies (AND (NATP CELL)
+                                           (NATP W))
+                                      (<= 0 (fast-NST-IN-CLOCK RET-PC CELL W))))))
+
+(in-theory (disable fast-NST-IN-CLOCK))
+
+(DEFUN fast-NSYM-LOOP-CLOCK (CELL W)
+  (+ 12
+     (fast-expt-clock '(1 0 6) W)
+     (fast-floor-CLOCK '(0 6) CELL (EXPT 2 W))
+     (fast-MOD-CLOCK '(6) (FLOOR CELL (EXPT 2 W)) 2)))
+
+(defthm NSYM-LOOP-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (equal (NSYM-LOOP-CLOCK CELL W)
+                  (fast-NSYm-LOOP-CLOCK CELL W)))
+  :hints (("Goal" :in-theory (enable nsym-LOOP-CLOCK))))
+
+(defthm natp-NSYM-LOOP-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (natp (fast-NSYm-LOOP-CLOCK CELL W)))
+  :hints (("Goal" :in-theory (enable nsym-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (integerp (fast-NSYm-LOOP-CLOCK CELL W))))
+                 (:linear
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (<= 0 (fast-NSYm-LOOP-CLOCK CELL W))))))
+
+(in-theory (disable fast-NSYM-LOOP-CLOCK))
+
+(DEFUN FAST-NSYM-CLOCK (RET-PC CELL W)
+  (+ 15
+     (fast-NSYM-LOOP-CLOCK CELL W)
+     (exit-clock 'NSYM RET-PC)))
+
+(defthm fast-nsym-clock-lemma
+  (implies (and (natp cell) (natp w))
+           (equal (nsym-clock ret-pc cell w)
+                  (fast-nsym-clock ret-pc cell w)))
+  :hints (("Goal" :in-theory (enable nsym-clock))))
+
+(defthm natp-fast-nsym-clock-lemma
+  (implies (and (natp cell) (natp w))
+           (natp (fast-nsym-clock ret-pc cell w)))
+  :hints (("Goal" :in-theory (enable nsym-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp cell) (natp w))
+                                      (integerp (fast-nsym-clock ret-pc cell w))))
+                 (:linear
+                  :corollary (implies (and (natp cell) (natp w))
+                                      (<= 0 (fast-nsym-clock ret-pc cell w))))))
+
+(in-theory (disable fast-nsym-clock))
+
+(DEFUN FAST-NOP-LOOP-CLOCK (CELL W)
+  (+ 14
+     (fast-EXPT-CLOCK '(1 0 7) (+ 1 W))
+     (fast-FLOOR-CLOCK '(0 7)
+                      CELL (EXPT 2 (+ 1 W)))
+     (fast-MOD-CLOCK '(7)
+                    (FLOOR CELL (EXPT 2 (+ 1 W)))
+                    8)))
+
+(defthm FAST-NOP-LOOP-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (equal (NOP-LOOP-CLOCK CELL W)
+                  (fast-NOP-LOOP-CLOCK CELL W)))
+  :hints (("Goal" :in-theory (enable NOP-LOOP-CLOCK))))
+
+(defthm natp-FAST-NOP-LOOP-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (natp (fast-NOP-LOOP-CLOCK CELL W)))
+  :hints (("Goal" :in-theory (enable NOP-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (integerp (fast-NOP-LOOP-CLOCK CELL W))))
+                 (:linear
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (<= 0 (fast-NOP-LOOP-CLOCK CELL W))))))
+
+(in-theory (disable fast-NOP-LOOP-CLOCK))
+
+
+(DEFUN FAST-NOP-CLOCK (RET-PC CELL W)
+  (+ 15
+     (fast-NOP-LOOP-CLOCK CELL W)
+     (exit-clock 'NOP RET-PC)))
+
+(defthm FAST-NOP-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (equal (NOP-CLOCK RET-PC CELL W)
+                  (fast-NOP-CLOCK RET-PC CELL W)))
+  :hints (("Goal" :in-theory (enable NOP-CLOCK))))
+
+(defthm natp-FAST-NOP-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (natp (fast-NOP-CLOCK RET-PC CELL W)))
+  :hints (("Goal" :in-theory (enable NOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (integerp (fast-NOP-CLOCK RET-PC CELL W))))
+                 (:linear
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (<= 0 (fast-NOP-CLOCK RET-PC CELL W))))))
+
+(in-theory (disable fast-NOP-CLOCK))
+
+(DEFUN FAST-NST-OUT-LOOP-CLOCK (CELL W)
+  (+ 18
+     (fast-EXPT-CLOCK '(1 0 8) (+ 4 W))
+     (fast-FLOOR-CLOCK '(0 8)
+                      CELL (EXPT 2 (+ 4 W)))
+     (fast-EXPT-CLOCK '(1 8) W)
+     (fast-MOD-CLOCK '(8)
+                    (FLOOR CELL (EXPT 2 (+ 4 W)))
+                    (EXPT 2 W))))
+
+(defthm FAST-NST-OUT-LOOP-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (equal (NST-OUT-LOOP-CLOCK CELL W)
+                  (fast-NST-OUT-LOOP-CLOCK CELL W)))
+  :hints (("Goal" :in-theory (enable NST-OUT-LOOP-CLOCK))))
+
+(defthm natp-FAST-NST-OUT-LOOP-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (natp (fast-NST-OUT-LOOP-CLOCK CELL W)))
+  :hints (("Goal" :in-theory (enable NST-OUT-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (integerp (fast-NST-OUT-LOOP-CLOCK CELL W))))
+                 (:linear
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (<= 0 (fast-NST-OUT-LOOP-CLOCK CELL W))))))
+
+(in-theory (disable fast-NST-OUT-LOOP-CLOCK))
+
+(DEFUN FAST-NST-OUT-CLOCK (RET-PC CELL W)
+  (+ 15
+     (fast-NST-OUT-LOOP-CLOCK CELL W)
+     (exit-clock 'NST-OUT RET-PC)))
+
+(defthm FAST-NST-OUT-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (equal (NST-OUT-CLOCK RET-PC CELL W)
+                  (fast-NST-OUT-CLOCK RET-PC CELL W)))
+  :hints (("Goal" :in-theory (enable NST-OUT-CLOCK))))
+
+(defthm natp-FAST-NST-OUT-CLOCK-lemma
+  (implies (AND (NATP CELL) (NATP W))
+           (natp (fast-NST-OUT-CLOCK RET-PC CELL W)))
+  :hints (("Goal" :in-theory (enable NST-OUT-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (integerp (fast-NST-OUT-CLOCK RET-PC CELL W))))
+                 (:linear
+                  :corollary (implies (AND (NATP CELL) (NATP W))
+                                      (<= 0 (fast-NST-OUT-CLOCK RET-PC CELL W))))))
+
+(in-theory (disable fast-NST-OUT-CLOCK))
+
+(DEFUN FAST-NCAR-LOOP-CLOCK (TM W)
+  (+ 12
+     (fast-EXPT-CLOCK '(1 9) (+ 4 (* 2 W)))
+     (fast-MOD-CLOCK '(9) TM (EXPT 2 (+ 4 (* 2 W))))))
+
+(defthm FAST-NCAR-LOOP-CLOCK-lemma
+  (implies (AND (NATP TM) (NATP W))
+           (equal (NCAR-LOOP-CLOCK TM W)
+                  (fast-NCAR-LOOP-CLOCK TM W)))
+  :hints (("Goal" :in-theory (enable NCAR-LOOP-CLOCK))))
+
+(defthm natp-FAST-NCAR-LOOP-CLOCK-lemma
+  (implies (AND (NATP TM) (NATP W))
+           (natp (fast-NCAR-LOOP-CLOCK TM W)))
+  :hints (("Goal" :in-theory (enable NCAR-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP TM) (NATP W))
+                                      (integerp (fast-NCAR-LOOP-CLOCK TM W))))
+                 (:linear
+                  :corollary (implies (AND (NATP TM) (NATP W))
+                                      (<= 0 (fast-NCAR-LOOP-CLOCK TM W))))))
+
+(in-theory (disable fast-NCAR-LOOP-CLOCK))
+
+(DEFUN FAST-NCAR-CLOCK (RET-PC TM W)
+  (+ 15
+     (fast-NCAR-LOOP-CLOCK TM W)
+     (exit-clock 'NCAR RET-PC)))
+
+(defthm FAST-NCAR-CLOCK-lemma
+  (implies (AND (NATP TM) (NATP W))
+           (equal (NCAR-CLOCK RET-PC TM W)
+                  (fast-NCAR-CLOCK RET-PC TM W)))
+  :hints (("Goal" :in-theory (enable NCAR-CLOCK))))
+
+(defthm natp-FAST-NCAR-CLOCK-lemma
+  (implies (AND (NATP TM) (NATP W))
+           (natp (fast-NCAR-CLOCK RET-PC TM W)))
+  :hints (("Goal" :in-theory (enable NCAR-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP TM) (NATP W))
+                                      (integerp (fast-NCAR-CLOCK RET-PC TM W))))
+                 (:linear
+                  :corollary (implies (AND (NATP TM) (NATP W))
+                                      (<= 0 (fast-NCAR-CLOCK RET-PC TM W))))))
+
+(in-theory (disable fast-NCAR-CLOCK))
+
+(DEFUN FAST-NCDR-LOOP-CLOCK (TM W)
+  (+ 13
+     (fast-EXPT-CLOCK '(1 10) (+ 4 (* 2 W)))
+     (fast-FLOOR-CLOCK '(10)
+                      TM (EXPT 2 (+ 4 (* 2 W))))))
+
+(defthm FAST-NCDR-LOOP-CLOCK-lemma
+  (implies (AND (NATP TM) (NATP W))
+           (equal (NCDR-LOOP-CLOCK TM W)
+                  (fast-NCDR-LOOP-CLOCK TM W)))
+  :hints (("Goal" :in-theory (enable NCDR-LOOP-CLOCK))))
+
+(defthm natp-FAST-NCDR-LOOP-CLOCK-lemma
+  (implies (AND (NATP TM) (NATP W))
+           (natp (fast-NCDR-LOOP-CLOCK TM W)))
+  :hints (("Goal" :in-theory (enable NCDR-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP TM) (NATP W))
+                                      (integerp (fast-NCDR-LOOP-CLOCK TM W))))
+                 (:linear
+                  :corollary (implies (AND (NATP TM) (NATP W))
+                                      (<= 0 (fast-NCDR-LOOP-CLOCK TM W))))))
+
+(in-theory (disable fast-NCDR-LOOP-CLOCK))
+
+(DEFUN FAST-NCDR-CLOCK (RET-PC TM W)
+  (+ 15
+     (fast-NCDR-LOOP-CLOCK TM W)
+     (exit-clock 'NCDR RET-PC)))
+
+(defthm FAST-NCDR-CLOCK-lemma
+  (implies (AND (NATP TM) (NATP W))
+           (equal (NCDR-CLOCK RET-PC TM W)
+                  (fast-NCDR-CLOCK RET-PC TM W)))
+  :hints (("Goal" :in-theory (enable NCDR-CLOCK))))
+
+(defthm natp-FAST-NCDR-CLOCK-lemma
+  (implies (AND (NATP TM) (NATP W))
+           (natp (fast-NCDR-CLOCK RET-PC TM W)))
+  :hints (("Goal" :in-theory (enable NCDR-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP TM) (NATP W))
+                                      (integerp (fast-NCDR-CLOCK RET-PC TM W))))
+                 (:linear
+                  :corollary (implies (AND (NATP TM) (NATP W))
+                                      (<= 0 (fast-NCDR-CLOCK RET-PC TM W))))))
+
+(in-theory (disable fast-NCDR-CLOCK))
+
+
+(DEFUN FAST-CURRENT-SYMN-LOOP-CLOCK (TAPE POS)
+  (IF
+    (EQUAL (- POS (LOG2 TAPE)) 0)
+    (+ 8 (fast-LOG2-CLOCK '(1 0 11) TAPE))
+    (+ 20
+       (fast-LOG2-CLOCK '(1 0 11) TAPE)
+       (fast-EXPT-CLOCK '(1 0 2 11) POS)
+       (fast-FLOOR-CLOCK '(0 2 11)
+                        TAPE (EXPT 2 POS))
+       (fast-MOD-CLOCK '(2 11)
+                      (FLOOR TAPE (EXPT 2 POS))
+                      2))))
+
+(defthm FAST-CURRENT-SYMN-LOOP-CLOCK-lemma
+  (implies (AND (NATP TAPE) (NATP POS))
+           (equal (CURRENT-SYMN-LOOP-CLOCK TAPE POS)
+                  (FAST-CURRENT-SYMN-LOOP-CLOCK TAPE POS)))
+  :hints (("Goal" :in-theory (enable CURRENT-SYMN-LOOP-CLOCK))))
+
+(defthm natp-FAST-CURRENT-SYMN-LOOP-CLOCK-lemma
+  (implies (AND (NATP TAPE) (NATP POS))
+           (natp (FAST-CURRENT-SYMN-LOOP-CLOCK TAPE POS)))
+  :hints (("Goal" :in-theory (enable CURRENT-SYMN-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP TAPE) (NATP POS))
+                                      (integerp (FAST-CURRENT-SYMN-LOOP-CLOCK TAPE POS))))
+                 (:linear
+                  :corollary (implies (AND (NATP TAPE) (NATP POS))
+                                      (<= 0 (FAST-CURRENT-SYMN-LOOP-CLOCK TAPE POS))))))
+
+(in-theory (disable FAST-CURRENT-SYMN-LOOP-CLOCK))
+
+
+(DEFUN FAST-CURRENT-SYMN-CLOCK (RET-PC TAPE POS)
+  (+ 15
+     (fast-CURRENT-SYMN-LOOP-CLOCK TAPE POS)
+     (exit-clock 'CURRENT-SYMN RET-PC)))
+
+(defthm FAST-CURRENT-SYMN-CLOCK-lemma
+  (implies (AND (NATP TAPE) (NATP POS))
+           (equal (CURRENT-SYMN-CLOCK RET-PC TAPE POS)
+                  (FAST-CURRENT-SYMN-CLOCK RET-PC TAPE POS)))
+  :hints (("Goal" :in-theory (enable CURRENT-SYMN-CLOCK))))
+
+(defthm natp-FAST-CURRENT-SYMN-CLOCK-lemma
+  (implies (AND (NATP TAPE) (NATP POS))
+           (natp (FAST-CURRENT-SYMN-CLOCK RET-PC TAPE POS)))
+  :hints (("Goal" :in-theory (enable CURRENT-SYMN-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP TAPE) (NATP POS))
+                                      (integerp (FAST-CURRENT-SYMN-CLOCK RET-PC TAPE POS))))
+                 (:linear
+                  :corollary (implies (AND (NATP TAPE) (NATP POS))
+                                      (<= 0 (FAST-CURRENT-SYMN-CLOCK RET-PC TAPE POS))))))
+
+(in-theory (disable FAST-CURRENT-SYMN-CLOCK))
+
+
+(DEFUN FAST-NINSTR1-LOOP-CLOCK (ST SYM TM W NNIL)
+  (if (and (natp w) (natp tm))
+      (IF
+       (EQUAL TM 0)
+       3
+       (IF
+        (EQUAL (- TM NNIL) 0)
+        8
+        (IF
+         (EQUAL (IF (EQUAL (- ST (NST-IN (NCAR TM W) W))
+                           0)
+                    (- SYM (NSYM (NCAR TM W) W))
+                    1)
+                0)
+         (IF
+          (EQUAL (- ST (NST-IN (NCAR TM W) W))
+                 0)
+          (+
+           11
+           (+
+            (fast-NCAR-CLOCK '(0 1 0 0 2 2 12) TM W)
+            (+
+             3
+             (+
+              (fast-NST-IN-CLOCK '(1 0 0 2 2 12)
+                                (NCAR TM W)
+                                W)
+              (+
+               7
+               (+ (fast-NCAR-CLOCK '(0 1 1 0 2 2 12) TM W)
+                  (+ 3
+                     (+ (fast-NSYM-CLOCK '(1 1 0 2 2 12)
+                                        (NCAR TM W)
+                                        W)
+                        (+ 6
+                           (+ (fast-NCAR-CLOCK '(1 2 2 12) TM W)
+                              2))))))))))
+          (+ 11
+             (+ (fast-NCAR-CLOCK '(0 1 0 0 2 2 12) TM W)
+                (+ 3
+                   (+ (fast-NST-IN-CLOCK '(1 0 0 2 2 12)
+                                        (NCAR TM W)
+                                        W)
+                      (+ 9
+                         (+ (fast-NCAR-CLOCK '(1 2 2 12) TM W)
+                            2)))))))
+         (IF
+          (EQUAL (- ST (NST-IN (NCAR TM W) W))
+                 0)
+          (+
+           11
+           (+
+            (fast-NCAR-CLOCK '(0 1 0 0 2 2 12) TM W)
+            (+
+             3
+             (+
+              (fast-NST-IN-CLOCK '(1 0 0 2 2 12)
+                                (NCAR TM W)
+                                W)
+              (+
+               7
+               (+
+                (fast-NCAR-CLOCK '(0 1 1 0 2 2 12) TM W)
+                (+
+                 3
+                 (+
+                  (fast-NSYM-CLOCK '(1 1 0 2 2 12)
+                                  (NCAR TM W)
+                                  W)
+                  (+
+                   8
+                   (+ (fast-NCDR-CLOCK '(2 2 2 2 12) TM W)
+                      (+ 8
+                         (fast-NINSTR1-LOOP-CLOCK ST SYM (NCDR TM W)
+                                                 W NNIL))))))))))))
+          (+
+           11
+           (+
+            (fast-NCAR-CLOCK '(0 1 0 0 2 2 12) TM W)
+            (+
+             3
+             (+
+              (fast-NST-IN-CLOCK '(1 0 0 2 2 12)
+                                (NCAR TM W)
+                                W)
+              (+ 11
+                 (+ (fast-NCDR-CLOCK '(2 2 2 2 12) TM W)
+                    (+ 8
+                       (fast-NINSTR1-LOOP-CLOCK ST SYM (NCDR TM W)
+                                               W NNIL))))))))))))
+      0))
+
+(defthm FAST-NINSTR1-LOOP-CLOCK-lemma
+  (implies (AND (NATP ST)
+                (NATP SYM)
+                (NATP TM)
+                (NATP W)
+                (EQUAL NNIL (NNIL W)))
+           (equal (NINSTR1-LOOP-CLOCK ST SYM TM W NNIL)
+                  (FAST-NINSTR1-LOOP-CLOCK ST SYM TM W NNIL)))
+  :hints (("Goal" :in-theory (enable NINSTR1-LOOP-CLOCK))))
+
+(defthm natp-FAST-NINSTR1-LOOP-CLOCK-lemma
+  (implies (AND (NATP ST)
+                (NATP SYM)
+                (NATP TM)
+                (NATP W)
+                (EQUAL NNIL (NNIL W)))
+           (natp (FAST-NINSTR1-LOOP-CLOCK ST SYM TM W NNIL)))
+  :hints (("Goal" :in-theory (enable NINSTR1-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP ST)
+                                           (NATP SYM)
+                                           (NATP TM)
+                                           (NATP W)
+                                           (EQUAL NNIL (NNIL W)))
+                                      (integerp (FAST-NINSTR1-LOOP-CLOCK ST SYM TM W NNIL))))
+                 (:linear
+                  :corollary (implies (AND (NATP ST)
+                                           (NATP SYM)
+                                           (NATP TM)
+                                           (NATP W)
+                                           (EQUAL NNIL (NNIL W)))
+                                      (<= 0 (FAST-NINSTR1-LOOP-CLOCK ST SYM TM W NNIL))))))
+
+(in-theory (disable FAST-NINSTR1-LOOP-CLOCK))
+
+
+(DEFUN FAST-NINSTR1-CLOCK (RET-PC ST SYM TM W NNIL)
+  (+ 22
+      (+ (fast-NINSTR1-LOOP-CLOCK ST SYM TM W NNIL)
+          (+ 8
+              (exit-clock 'NINSTR1 RET-PC)))))
+
+(defthm FAST-NINSTR1-CLOCK-lemma
+  (implies (AND (NATP ST)
+                (NATP SYM)
+                (NATP TM)
+                (NATP W)
+                (EQUAL NNIL (NNIL W)))
+           (equal (NINSTR1-CLOCK RET-PC ST SYM TM W NNIL)
+                  (FAST-NINSTR1-CLOCK RET-PC ST SYM TM W NNIL)))
+  :hints (("Goal" :in-theory (enable NINSTR1-CLOCK))))
+
+(defthm natp-FAST-NINSTR1-CLOCK-lemma
+  (implies (AND (NATP ST)
+                (NATP SYM)
+                (NATP TM)
+                (NATP W)
+                (EQUAL NNIL (NNIL W)))
+           (natp (FAST-NINSTR1-CLOCK RET-PC ST SYM TM W NNIL)))
+  :hints (("Goal" :in-theory (enable NINSTR1-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP ST)
+                                           (NATP SYM)
+                                           (NATP TM)
+                                           (NATP W)
+                                           (EQUAL NNIL (NNIL W)))
+                                      (integerp (FAST-NINSTR1-CLOCK RET-PC ST SYM TM W NNIL))))
+                 (:linear
+                  :corollary (implies (AND (NATP ST)
+                                           (NATP SYM)
+                                           (NATP TM)
+                                           (NATP W)
+                                           (EQUAL NNIL (NNIL W)))
+                                      (<= 0 (FAST-NINSTR1-CLOCK RET-PC ST SYM TM W NNIL))))))
+
+(in-theory (disable FAST-NINSTR1-CLOCK))
+
+
+(DEFUN FAST-NEW-TAPE2-LOOP-CLOCK (OP TAPE POS)
+  (IF
+   (EQUAL (IF (EQUAL OP 0)
+              0 (IF (EQUAL (- OP 1) 0) 0 1))
+          0)
+   (IF
+    (EQUAL OP 0)
+    (IF
+     (EQUAL (- POS (LOG2 TAPE)) 0)
+     (IF (EQUAL OP 0)
+         (+ 9
+            (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+               (+ 10
+                  (+ (fast-EXPT-CLOCK '(1 0 1 1 1 13) POS)
+                     2))))
+         (+ 9
+            (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+               (+ 12
+                  (+ (fast-EXPT-CLOCK '(1 0 2 1 1 13) (+ POS 1))
+                     3)))))
+     (IF
+      (EQUAL (- (CURRENT-SYMN TAPE POS) OP)
+             0)
+      (+ 9
+         (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+            (+ 6
+               (+ (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                          TAPE POS)
+                  6))))
+      (IF
+       (EQUAL (CURRENT-SYMN TAPE POS) 0)
+       (+
+        9
+        (+
+         (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+         (+
+          6
+          (+
+           (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                   TAPE POS)
+           (+
+            7
+            (+ (fast-CURRENT-SYMN-CLOCK '(0 2 2 1 13)
+                                       TAPE POS)
+               (+ 7
+                  (+ (fast-EXPT-CLOCK '(1 0 1 2 2 1 13) POS)
+                     4))))))))
+       (+
+        9
+        (+
+         (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+         (+
+          6
+          (+
+           (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                   TAPE POS)
+           (+
+            7
+            (+ (fast-CURRENT-SYMN-CLOCK '(0 2 2 1 13)
+                                       TAPE POS)
+               (+ 7
+                  (+ (fast-EXPT-CLOCK '(1 0 2 2 2 1 13) POS)
+                     5)))))))))))
+    (IF
+     (EQUAL (- OP 1) 0)
+     (IF
+      (EQUAL (- POS (LOG2 TAPE)) 0)
+      (IF (EQUAL OP 0)
+          (+ 14
+             (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+                (+ 10
+                   (+ (fast-EXPT-CLOCK '(1 0 1 1 1 13) POS)
+                      2))))
+          (+ 14
+             (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+                (+ 12
+                   (+ (fast-EXPT-CLOCK '(1 0 2 1 1 13) (+ POS 1))
+                      3)))))
+      (IF
+       (EQUAL (- (CURRENT-SYMN TAPE POS) OP)
+              0)
+       (+ 14
+          (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+             (+ 6
+                (+ (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                           TAPE POS)
+                   6))))
+       (IF
+        (EQUAL (CURRENT-SYMN TAPE POS) 0)
+        (+
+         14
+         (+
+          (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+          (+
+           6
+           (+
+            (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                    TAPE POS)
+            (+
+             7
+             (+
+              (fast-CURRENT-SYMN-CLOCK '(0 2 2 1 13)
+                                      TAPE POS)
+              (+ 7
+                 (+ (fast-EXPT-CLOCK '(1 0 1 2 2 1 13) POS)
+                    4))))))))
+        (+
+         14
+         (+
+          (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+          (+
+           6
+           (+
+            (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                    TAPE POS)
+            (+
+             7
+             (+
+              (fast-CURRENT-SYMN-CLOCK '(0 2 2 1 13)
+                                      TAPE POS)
+              (+ 7
+                 (+ (fast-EXPT-CLOCK '(1 0 2 2 2 1 13) POS)
+                    5)))))))))))
+     (IF
+      (EQUAL (- POS (LOG2 TAPE)) 0)
+      (IF (EQUAL OP 0)
+          (+ 15
+             (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+                (+ 10
+                   (+ (fast-EXPT-CLOCK '(1 0 1 1 1 13) POS)
+                      2))))
+          (+ 15
+             (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+                (+ 12
+                   (+ (fast-EXPT-CLOCK '(1 0 2 1 1 13) (+ POS 1))
+                      3)))))
+      (IF
+       (EQUAL (- (CURRENT-SYMN TAPE POS) OP)
+              0)
+       (+ 15
+          (+ (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+             (+ 6
+                (+ (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                           TAPE POS)
+                   6))))
+       (IF
+        (EQUAL (CURRENT-SYMN TAPE POS) 0)
+        (+
+         15
+         (+
+          (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+          (+
+           6
+           (+
+            (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                    TAPE POS)
+            (+
+             7
+             (+
+              (fast-CURRENT-SYMN-CLOCK '(0 2 2 1 13)
+                                      TAPE POS)
+              (+ 7
+                 (+ (fast-EXPT-CLOCK '(1 0 1 2 2 1 13) POS)
+                    4))))))))
+        (+
+         15
+         (+
+          (fast-LOG2-CLOCK '(1 0 1 13) TAPE)
+          (+
+           6
+           (+
+            (fast-CURRENT-SYMN-CLOCK '(0 0 2 1 13)
+                                    TAPE POS)
+            (+
+             7
+             (+
+              (fast-CURRENT-SYMN-CLOCK '(0 2 2 1 13)
+                                      TAPE POS)
+              (+ 7
+                 (+ (fast-EXPT-CLOCK '(1 0 2 2 2 1 13) POS)
+                    5)))))))))))))
+   (IF
+    (EQUAL OP 0)
+    (IF
+     (EQUAL (- OP 2) 0)
+     (IF (EQUAL POS 0)
+         15
+         16)
+     (IF
+      (EQUAL (- POS (LOG2 TAPE)) 0)
+      (+ 13
+         (+ (fast-LOG2-CLOCK '(1 0 2 2 13) TAPE)
+            (+ 8
+               (+ (fast-EXPT-CLOCK '(1 0 0 1 2 2 13) POS)
+                  (+ 8
+                     (+ (fast-EXPT-CLOCK '(1 0 1 2 2 13) (+ 1 POS))
+                        6))))))
+      (+ 13
+         (+ (fast-LOG2-CLOCK '(1 0 2 2 13) TAPE)
+            9))))
+    (IF
+     (EQUAL (- OP 1) 0)
+     (IF
+      (EQUAL (- OP 2) 0)
+      (IF (EQUAL POS 0)
+          20
+          21)
+      (IF
+       (EQUAL (- POS (LOG2 TAPE)) 0)
+       (+ 18
+          (+ (fast-LOG2-CLOCK '(1 0 2 2 13) TAPE)
+             (+ 8
+                (+ (fast-EXPT-CLOCK '(1 0 0 1 2 2 13) POS)
+                   (+ 8
+                      (+ (fast-EXPT-CLOCK '(1 0 1 2 2 13) (+ 1 POS))
+                         6))))))
+       (+ 18
+          (+ (fast-LOG2-CLOCK '(1 0 2 2 13) TAPE)
+             9))))
+     (IF
+      (EQUAL (- OP 2) 0)
+      (IF (EQUAL POS 0)
+          21
+          22)
+      (IF
+       (EQUAL (- POS (LOG2 TAPE)) 0)
+       (+ 19
+          (+ (fast-LOG2-CLOCK '(1 0 2 2 13) TAPE)
+             (+ 8
+                (+ (fast-EXPT-CLOCK '(1 0 0 1 2 2 13) POS)
+                   (+ 8
+                      (+ (fast-EXPT-CLOCK '(1 0 1 2 2 13) (+ 1 POS))
+                         6))))))
+       (+ 19
+          (+ (fast-LOG2-CLOCK '(1 0 2 2 13) TAPE)
+             9))))))))
+
+(defthm FAST-NEW-TAPE2-LOOP-CLOCK-lemma
+  (implies (AND (NATP OP) (NATP TAPE) (NATP POS))
+           (equal (NEW-TAPE2-LOOP-CLOCK OP TAPE POS)
+                  (FAST-NEW-TAPE2-LOOP-CLOCK OP TAPE POS)))
+  :hints (("Goal" :in-theory (enable NEW-TAPE2-LOOP-CLOCK))))
+
+(defthm natp-FAST-NEW-TAPE2-LOOP-CLOCK-lemma
+  (implies (AND (NATP OP) (NATP TAPE) (NATP POS))
+           (natp (FAST-NEW-TAPE2-LOOP-CLOCK OP TAPE POS)))
+  :hints (("Goal" :in-theory (enable NEW-TAPE2-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP OP) (NATP TAPE) (NATP POS))
+                                      (integerp (FAST-NEW-TAPE2-LOOP-CLOCK OP TAPE POS))))
+                 (:linear
+                  :corollary (implies (AND (NATP OP) (NATP TAPE) (NATP POS))
+                                      (<= 0 (FAST-NEW-TAPE2-LOOP-CLOCK OP TAPE POS))))))
+
+(in-theory (disable FAST-NEW-TAPE2-LOOP-CLOCK))
+
+
+(DEFUN FAST-NEW-TAPE2-CLOCK (RET-PC OP TAPE POS)
+  (+ 14
+      (+ (fast-NEW-TAPE2-LOOP-CLOCK OP TAPE POS)
+          (+ 8
+              (exit-clock 'NEW-TAPE2 RET-PC)))))
+
+(defthm FAST-NEW-TAPE2-CLOCK-lemma
+  (implies (AND (NATP OP) (NATP TAPE) (NATP POS))
+           (equal (NEW-TAPE2-CLOCK RET-PC OP TAPE POS)
+                  (FAST-NEW-TAPE2-CLOCK RET-PC OP TAPE POS)))
+  :hints (("Goal" :in-theory (enable NEW-TAPE2-CLOCK))))
+
+(defthm natp-FAST-NEW-TAPE2-CLOCK-lemma
+  (implies (AND (NATP OP) (NATP TAPE) (NATP POS))
+           (natp (FAST-NEW-TAPE2-CLOCK RET-PC OP TAPE POS)))
+  :hints (("Goal" :in-theory (enable NEW-TAPE2-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP OP) (NATP TAPE) (NATP POS))
+                                      (integerp (FAST-NEW-TAPE2-CLOCK RET-PC OP TAPE POS))))
+                 (:linear
+                  :corollary (implies (AND (NATP OP) (NATP TAPE) (NATP POS))
+                                      (<= 0 (FAST-NEW-TAPE2-CLOCK RET-PC OP TAPE POS))))))
+
+(in-theory (disable FAST-NEW-TAPE2-CLOCK))
+
+(DEFUN FAST-TMI3-LOOP-CLOCK (ST TAPE POS TM W NNIL N)
+  (DECLARE (XARGS :MEASURE (ACL2-COUNT N)))
+  (IF
+   (ZP N)
+   0
+   (IF
+    (AND (NATP ST)
+         (NATP TAPE)
+         (NATP POS)
+         (NATP TM)
+         (NATP W)
+         (EQUAL NNIL (NNIL W))
+         (< ST (EXPT 2 W)))
+    (IF
+     (EQUAL (- (NINSTR1 ST (CURRENT-SYMN TAPE POS)
+                        TM W NNIL)
+               -1)
+            0)
+     (+ 5
+        (+ (fast-CURRENT-SYMN-CLOCK '(1 0 0 14)
+                                   TAPE POS)
+           (+ 5
+              (+ (fast-NINSTR1-CLOCK '(0 0 14)
+                                    ST (CURRENT-SYMN TAPE POS)
+                                    TM W NNIL)
+                 7))))
+     (+
+      5
+      (+
+       (fast-CURRENT-SYMN-CLOCK '(1 0 0 14)
+                               TAPE POS)
+       (+
+        5
+        (+
+         (fast-NINSTR1-CLOCK '(0 0 14)
+                            ST (CURRENT-SYMN TAPE POS)
+                            TM W NNIL)
+         (+
+          8
+          (+
+           (fast-CURRENT-SYMN-CLOCK '(1 0 0 2 14)
+                                   TAPE POS)
+           (+
+            5
+            (+
+             (fast-NINSTR1-CLOCK '(0 0 2 14)
+                                ST (CURRENT-SYMN TAPE POS)
+                                TM W NNIL)
+             (+
+              3
+              (+
+               (fast-NST-OUT-CLOCK
+                '(0 2 14)
+                (NINSTR1 ST (CURRENT-SYMN TAPE POS)
+                         TM W NNIL)
+                W)
+               (+
+                5
+                (+
+                 (fast-CURRENT-SYMN-CLOCK '(1 0 0 1 2 14)
+                                         TAPE POS)
+                 (+
+                  5
+                  (+
+                   (fast-NINSTR1-CLOCK '(0 0 1 2 14)
+                                      ST (CURRENT-SYMN TAPE POS)
+                                      TM W NNIL)
+                   (+
+                    3
+                    (+
+                     (fast-NOP-CLOCK
+                      '(0 1 2 14)
+                      (NINSTR1 ST (CURRENT-SYMN TAPE POS)
+                               TM W NNIL)
+                      W)
+                     (+
+                      4
+                      (+
+                       (fast-NEW-TAPE2-CLOCK
+                        '(1 2 14)
+                        (NOP
+                         (NINSTR1 ST (CURRENT-SYMN TAPE POS)
+                                  TM W NNIL)
+                         W)
+                        TAPE POS)
+                       (+
+                        10
+                        (fast-TMI3-LOOP-CLOCK
+                         (NST-OUT
+                          (NINSTR1 ST (CURRENT-SYMN TAPE POS)
+                                   TM W NNIL)
+                          W)
+                         (MV-NTH
+                          0
+                          (MV-LIST
+                           2
+                           (NEW-TAPE2
+                            (NOP
+                             (NINSTR1
+                              ST (CURRENT-SYMN TAPE POS)
+                              TM W NNIL)
+                             W)
+                            TAPE POS)))
+                         (MV-NTH
+                          1
+                          (MV-LIST
+                           2
+                           (NEW-TAPE2
+                            (NOP
+                             (NINSTR1
+                              ST (CURRENT-SYMN TAPE POS)
+                              TM W NNIL)
+                             W)
+                            TAPE POS)))
+                         TM W NNIL (- N 1))))))))))))))))))))))
+    0)))
+
+(defthm FAST-TMI3-LOOP-CLOCK-lemma
+  (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+           (equal (TMI3-LOOP-CLOCK ST TAPE POS TM W NNIL N)
+                  (FAST-TMI3-LOOP-CLOCK ST TAPE POS TM W NNIL N)))
+  :hints (("Goal" :in-theory (e/d (TMI3-LOOP-CLOCK)
+                                  (TMI3-LOOP-CLOCK-IS-K*)))))
+
+(defthm natp-FAST-TMI3-LOOP-CLOCK-lemma
+  (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+           (natp (FAST-TMI3-LOOP-CLOCK ST TAPE POS TM W NNIL N)))
+  :hints (("Goal" :in-theory (e/d (TMI3-LOOP-CLOCK)
+                                  (TMI3-LOOP-CLOCK-IS-K*))))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+                                      (integerp (FAST-TMI3-LOOP-CLOCK ST TAPE POS TM W NNIL N))))
+                 (:linear
+                  :corollary (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+                                      (<= 0 (FAST-TMI3-LOOP-CLOCK ST TAPE POS TM W NNIL N))))))
+
+(in-theory (disable FAST-TMI3-LOOP-CLOCK))
+
+
+(DEFUN FAST-TMI3-CLOCK (RET-PC ST TAPE POS TM W NNIL N)
+  (IF
+   (EQUAL (MV-NTH 0
+                  (MV-LIST 4 (TMI3 ST TAPE POS TM W N)))
+          0)
+   (+ 26
+      (fast-TMI3-LOOP-CLOCK ST TAPE POS TM W NNIL N))
+   (+ 26
+      (+ (fast-TMI3-LOOP-CLOCK ST TAPE POS TM W NNIL N)
+         (+ 15
+            (exit-clock 'TMI3 RET-PC))))))
+
+(defthm FAST-TMI3-CLOCK-lemma
+  (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+           (equal (TMI3-CLOCK RET-PC ST TAPE POS TM W NNIL N)
+                  (FAST-TMI3-CLOCK RET-PC ST TAPE POS TM W NNIL N)))
+  :hints (("Goal" :in-theory (enable TMI3-CLOCK))))
+
+(defthm natp-FAST-TMI3-CLOCK-lemma
+  (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+           (natp (FAST-TMI3-CLOCK RET-PC ST TAPE POS TM W NNIL N)))
+  :hints (("Goal" :in-theory (enable TMI3-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+                                      (integerp (FAST-TMI3-CLOCK RET-PC ST TAPE POS TM W NNIL N))))
+                 (:linear
+                  :corollary (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+                                      (<= 0 (FAST-TMI3-CLOCK RET-PC ST TAPE POS TM W NNIL N))))))
+
+(in-theory (disable FAST-TMI3-CLOCK))
+
+
+(DEFUN FAST-MAIN-LOOP-CLOCK (ST TAPE POS TM W NNIL N)
+  (+ 8
+     (fast-TMI3-CLOCK '(15)
+                     ST TAPE POS TM W NNIL N)))
+
+(defthm FAST-MAIN-LOOP-CLOCK-lemma
+  (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+           (equal (MAIN-LOOP-CLOCK ST TAPE POS TM W NNIL N)
+                  (FAST-MAIN-LOOP-CLOCK ST TAPE POS TM W NNIL N)))
+  :hints (("Goal" :in-theory (enable MAIN-LOOP-CLOCK))))
+
+(defthm natp-FAST-MAIN-LOOP-CLOCK-lemma
+  (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+           (natp (FAST-MAIN-LOOP-CLOCK ST TAPE POS TM W NNIL N)))
+  :hints (("Goal" :in-theory (enable MAIN-LOOP-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+                                      (integerp (FAST-MAIN-LOOP-CLOCK ST TAPE POS TM W NNIL N))))
+                 (:linear
+                  :corollary (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+                                      (<= 0 (FAST-MAIN-LOOP-CLOCK ST TAPE POS TM W NNIL N))))))
+
+(in-theory (disable FAST-MAIN-LOOP-CLOCK))
+
+
+(DEFUN FAST-MAIN-CLOCK (RET-PC ST TAPE POS TM W NNIL N)
+  (IF
+   (EQUAL (MV-NTH 0
+                  (MV-LIST 4 (TMI3 ST TAPE POS TM W N)))
+          0)
+   (+ 26
+      (fast-MAIN-LOOP-CLOCK ST TAPE POS TM W NNIL N))
+   (+ 26
+      (+ (fast-MAIN-LOOP-CLOCK ST TAPE POS TM W NNIL N)
+         (+ 15
+            (exit-clock 'MAIN RET-PC))))))
+
+(defthm FAST-MAIN-CLOCK-lemma
+  (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+           (equal (MAIN-CLOCK RET-PC ST TAPE POS TM W NNIL N)
+                  (FAST-MAIN-CLOCK RET-PC ST TAPE POS TM W NNIL N)))
+  :hints (("Goal" :in-theory (enable MAIN-CLOCK))))
+
+(defthm natp-FAST-MAIN-CLOCK-lemma
+  (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+           (natp (FAST-MAIN-CLOCK RET-PC ST TAPE POS TM W NNIL N)))
+  :hints (("Goal" :in-theory (enable MAIN-CLOCK)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+                                      (integerp (FAST-MAIN-CLOCK RET-PC ST TAPE POS TM W NNIL N))))
+                 (:linear
+                  :corollary (implies (AND (NATP ST) (NATP TAPE) (NATP POS) (NATP TM) (NATP W) (EQUAL NNIL (NNIL W)) (< ST (EXPT 2 W)))
+                                      (<= 0 (FAST-MAIN-CLOCK RET-PC ST TAPE POS TM W NNIL N))))))
+
+(in-theory (disable FAST-MAIN-CLOCK))
+
+(defun fast-psi-clock (st tape pos tm w nnil n)
+  (+ 2 (fast-main-clock nil st tape pos tm w nnil n)))
+
+(defthm fast-psi-clock-thm
+  (implies (and (natp st)
+                (natp tape)
+                (natp pos)
+                (natp tm)
+                (natp w)
+                (equal nnil (nnil w))
+                (< st (expt 2 w)))
+           (equal (psi-clock st tape pos tm w nnil n)
+                  (fast-psi-clock st tape pos tm w nnil n)))
+  :hints (("Goal" :in-theory (enable psi-clock))))
+
+(defthm natp-fast-psi-clock-thm
+  (implies (and (natp st)
+                (natp tape)
+                (natp pos)
+                (natp tm)
+                (natp w)
+                (equal nnil (nnil w))
+                (< st (expt 2 w)))
+           (natp (fast-psi-clock st tape pos tm w nnil n)))
+  :hints (("Goal" :in-theory (enable psi-clock)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (natp st)
+                                           (natp tape)
+                                           (natp pos)
+                                           (natp tm)
+                                           (natp w)
+                                           (equal nnil (nnil w))
+                                           (< st (expt 2 w)))
+                                      (integerp (fast-psi-clock st tape pos tm w nnil n))))
+                 (:linear
+                  :corollary (implies (and (natp st)
+                                           (natp tape)
+                                           (natp pos)
+                                           (natp tm)
+                                           (natp w)
+                                           (equal nnil (nnil w))
+                                           (< st (expt 2 w)))
+                                      (<= 0 (fast-psi-clock st tape pos tm w nnil n))))))
+
+(defun find-k! (ST TAPE TM N)
+  (LET*
+    ((MAP (RENAMING-MAP ST TM))
+     (ST-PRIME (CDR (ASSOC ST MAP)))
+     (TAPE-PRIME
+      (MV-NTH 0
+              (MV-LIST 2 (CONVERT-TAPE-TO-TAPEN-POS TAPE))))
+     (POS-PRIME
+      (MV-NTH 1
+              (MV-LIST 2 (CONVERT-TAPE-TO-TAPEN-POS TAPE))))
+     (W (MAX-WIDTH TM MAP))
+     (TM-PRIME (NCODE (TM-TO-TM1 TM MAP) W)))
+    (FAST-PSI-CLOCK ST-PRIME
+                  TAPE-PRIME POS-PRIME TM-PRIME W (NNIL W)
+                  N)))
+
+(defthm find-k-is-find-k!
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm)
+                (natp n))
+           (equal (find-k st tape tm n)
+                  (find-k! st tape tm n)))
+  :hints (("Goal" :in-theory (enable find-k))))
+
+(in-theory (disable (:executable-counterpart find-k)))
+
+(defthm natp-find-k!
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm)
+                (natp n))
+           (natp (find-k! st tape tm n)))
+  :hints (("Goal" :in-theory (enable find-k)))
+  :rule-classes (:type-prescription
+                 (:rewrite
+                  :corollary (implies (and (symbolp st)
+                                           (tapep tape)
+                                           (turing-machinep tm)
+                                           (natp n))
+                                      (integerp (find-k! st tape tm n))))
+                 (:linear
+                  :corollary (implies (and (symbolp st)
+                                           (tapep tape)
+                                           (turing-machinep tm)
+                                           (natp n))
+                                      (<= 0 (find-k! st tape tm n))))))
+
+(defthm m1-simulation-of-rogers-tm-takes-a-long-time
+  (let ((k (find-k 'Q0 *example-tape* *rogers-program* 78))) 
+    (and
+     (equal k
+            291202253588734484219274297505568945357129888612375663883)
+     (< (expt 10 56) k)
+     (< k (expt 10 57))))
+  :rule-classes nil)
+
+
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/funny-fact.lisp acl2-6.3/books/models/jvm/guard-verified-m1/funny-fact.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/funny-fact.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/funny-fact.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,334 @@
+; Correctness of a Factorial Program that Violates Actual JVM Stack Rules
+
+; Problem: Define an M1 program to compute the factorial of a natural number n,
+; by pushing all the factors onto the stack and then multiplying them in a second
+; loop.
+
+; Design Plan: I will go around a loop pushing n, n-1, ..., 1 onto the stack.
+; Then I will go around another loop just doing IMULs.  Note that I must go
+; around the first loop n times and the second loop n-1 times.  This program
+; violates the bytecode verifier's run that the stack is a fixed size at every
+; instruction.
+
+; Verification of the program illustrates how to verify a two loop program
+; where the loops are not nested.  However, this program is very unusual
+; because it essentially uses the stack as a list of values of arbitary length
+; and its verification involves abandoning the push/top/pop abstraction and
+; just manipulating lists.  (Of course, we could redevelop list theory for
+; push/top/pop, but it is counter to the spirit of stacks.)  So this is not a
+; good exemplar of two-loop verification.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun ! (n)
+  (if (zp n)
+      1
+      (* n (! (- n 1)))))
+
+(defun theta (n)
+  (! n))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+; With this algorithm we see something new: We have to have two loops and so we
+; have to have two helpers, one which is mimicking pushing things onto the
+; stack and the other which mimicks IMULing them away.  Unlike our other
+; helpers, these return the stack rather than some individual local.
+
+(defun helper1 (n stack)
+  (if (zp n)
+      stack
+      (helper1 (- n 1) (push n stack))))
+
+(defun helper2 (m stack)
+  (if (zp m)
+      stack
+      (helper2 (- m 1) (push (* (top (pop stack)) (top stack)) (pop (pop stack))))))
+
+(defun fn (n)
+  (if (zp n)
+      1
+      (top (helper2 (- n 1)
+                    (helper1 n nil)))))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n m a), not just about the special case (helper n m 0).
+
+; -----------------------------------------------------------------
+
+; Here begins a horrible development of list theory and the conversion of our
+; stack stuff to lists!  We could import a bunch of functions from ACL2 list
+; books, but I'll just develop it all here.  The end of this development is
+; marked by another row of hyphens.
+
+(in-theory (enable top pop push))
+
+(defun ap (x y)
+  (if (endp x)
+      y
+      (cons (car x)
+            (ap (cdr x) y))))
+
+(defun nats (n)
+  (if (zp n)
+      nil
+      (ap (nats (- n 1)) (list n))))
+
+(defun prod (x)
+  (if (endp x)
+      1
+      (* (car x) (prod (cdr x)))))
+
+(defun firstn (n x)
+  (if (or (zp n)
+          (endp x))
+      1
+      (cons (car x)
+            (firstn (- n 1) (cdr x)))))
+
+(defun natp-list (x)
+  (if (endp x)
+      t
+      (and (natp (car x))
+           (natp-list (cdr x)))))
+
+(defthm assoc-of-ap
+  (equal (ap (ap a b) c)
+         (ap a (ap b c))))
+
+(defthm natp-list-ap
+  (equal (natp-list (ap a b))
+         (and (natp-list a)
+              (natp-list b))))
+
+(defthm len-ap
+  (equal (len (ap a b))
+         (+ (len a) (len b))))
+
+(defthm len-nats
+  (equal (len (nats n))
+         (nfix n)))
+
+(defthm natp-list-nats
+  (natp-list (nats n)))
+
+(defthm firstn-ap
+  (implies (natp n)
+           (equal (firstn n (ap a b))
+                  (if (< n (len a))
+                      (firstn n a)
+                      (ap a (firstn (- n (len a)) b))))))
+
+(defthm prod-ap
+  (equal (prod (ap a b))
+         (* (prod a) (prod b))))
+
+(defthm prod-nats
+  (equal (prod (nats n))
+         (! (nfix n))))
+
+(defthm nthcdr-ap
+  (implies (natp n)
+           (equal (nthcdr n (ap a b))
+                  (if (< n (len a))
+                      (ap (nthcdr n a) b)
+                      (nthcdr (- n (len a)) b)))))
+
+; -----------------------------------------------------------------
+
+(defthm helper1-alt-def
+  (equal (helper1 n stack)
+         (ap (nats n) stack)))
+
+(defthm helper2-alt-def
+  (implies (and (natp n)
+                (natp-list stack)
+                (< n (len stack)))
+           (equal (helper2 n stack)
+                  (cons (prod (firstn (+ n 1) stack))
+                        (nthcdr (+ n 1) stack)))))
+
+(defthm helper2-helper1-is-theta
+  (implies (and (not (zp n))
+                (natp-list stack))
+           (equal (helper2 (- n 1) (helper1 n stack))
+                  (push (! n) stack))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n) (theta n))))
+
+; Disable these lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper1-alt-def
+                    helper2-alt-def
+                    helper2-helper1-is-theta
+                    fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+       '((ILOAD 0)   ;  0
+         (IFEQ 21)   ;  1
+         (ILOAD 0)   ;  2
+         (ICONST 1)  ;  3
+         (ISUB)      ;  4
+         (ISTORE 1)  ;  5
+         (ILOAD 0)   ;  6 loop1
+         (IFEQ 7)    ;  7
+         (ILOAD 0)   ;  8
+         (ILOAD 0)   ;  9
+         (ICONST 1)  ; 10
+         (ISUB)      ; 11
+         (ISTORE 0)  ; 12
+         (GOTO -7)   ; 13
+         (ILOAD 1)   ; 14 loop2
+         (IFEQ 8)    ; 15
+         (IMUL)      ; 16
+         (ILOAD 1)   ; 17
+         (ICONST 1)  ; 18
+         (ISUB)      ; 19
+         (ISTORE 1)  ; 20
+         (GOTO -7)   ; 21
+         (ICONST 1)  ; 22
+         (HALT))     ; 23
+    )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop1-clk (n)
+  (if (zp n)
+      2
+      (clk+ 8
+            (loop1-clk (- n 1)))))
+
+(defun loop2-clk (m)
+  (if (zp m)
+      2
+      (clk+ 8
+            (loop2-clk (- m 1)))))
+
+(defun clk (n)
+  (if (zp n)
+      8
+      (clk+ 6
+            (clk+ (loop1-clk n)
+                  (loop2-clk (- n 1))))))
+
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop1-is-helper1
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 6
+                                  (list n m)
+                                  stack
+                                  *pi*)
+                      (loop1-clk n))
+                  (make-state 14
+                              (list 0 m)
+                              (helper1 n stack)
+                              *pi*))))
+
+(in-theory (disable loop1-clk))
+
+(defthm loop2-is-helper2
+  (implies (and (natp m)
+                (natp-list stack)
+                (< m (len stack)))
+           (equal (m1 (make-state 14
+                                  (list n m)
+                                  stack
+                                  *pi*)
+                      (loop2-clk m))
+                  (make-state 23
+                              (list n 0)
+                              (helper2 m stack)
+                              *pi*))))
+  
+(in-theory (disable loop2-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 23
+                              (if (zp n) (list 0) (list 0 0))
+                              (push (fn n) nil)
+                              *pi*)))
+; This hint is necessary because we have to relieve the hypotheses on the two
+; loop lemmas, e.g., that stack is a list of nats sufficiently long, and our
+; way of doing that is to appeal to the list lemmas.
+
+  :hints (("Goal" :in-theory (enable helper1-alt-def helper2-alt-def))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 23
+                              (if (zp n) (list 0) (list 0 0))
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf)) (! n))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n and m, there
+; exists a clock (for example, the one constructed by (clk n)) such that
+; running *pi* with (list n m) as input produces a state, sf, that is halted
+; and which contains (* n m) on top of the stack.  Note that the algorithm
+; used by *pi* is not specified or derivable from this formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/good-statep.acl2 acl2-6.3/books/models/jvm/guard-verified-m1/good-statep.acl2
--- acl2-6.2/books/models/jvm/guard-verified-m1/good-statep.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/good-statep.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,6 @@
+(defpkg "M1"
+  (set-difference-eq (union-eq *acl2-exports*
+                               *common-lisp-symbols-from-main-lisp-package*)
+                     '(push pop pc program step)))
+
+(certify-book "good-statep" 1)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/good-statep.lisp acl2-6.3/books/models/jvm/guard-verified-m1/good-statep.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/good-statep.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/good-statep.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,676 @@
+#||
+
+See the README file on this directory for an overview of this work.
+
+In this file, I define good-statep, the predicate that determines whether an M1
+state is well-formed.  This is analogous to the Java Bytecode Verifier.
+Good-statep will be in the guard of M1.  That is, M1 should only be applied to
+states satisfying good-statep and may apply any of the standard operations to
+it without any runtime checking.  In particular, by proving the guards of the
+model, ACL2 guarantees that every instruction in a well-formed M1 program can
+be executed without error.  The basic constraints are thus:
+
+* the state is a 4-tuple composed of a pc, locals, stack, and program
+* the pc is a natural number strictly less than the length of the program
+* the locals and stack are true lists rationals
+* the program is a true list of well-formed instructions
+* all the local variables (indices) used are legal wrt the locals
+* every jump or branch is to a legal pc
+* every instruction that removes elements from the stack will always
+   find sufficient elements on the stack
+
+Because good-statep is used in the guard of M1, it must be guard verified
+itself.  The bulk of this file is devoted to the proofs that the functions
+defined here are defined and are used in compliance with their own guards.
+
+If you are playing with this file, it is best to define the M1 symbol package
+and then ld the file.  That way you can undo back through the events here and
+modify them.  For a comment on the M1 package, see below.
+
+(defpkg "M1"
+  (set-difference-eq (union-eq *acl2-exports*
+                               *common-lisp-symbols-from-main-lisp-package*)
+                     '(push pop pc program step)))
+
+(ld ; linebreak here to help certification infrastructure
+ "good-statep.lisp" :ld-pre-eval-print t)
+
+If you are certifying this file, define the M1 symbol package and issue the
+certify-book command below.
+
+Comment on the M1 Symbol Package: I don't import certain Common Lisp symbols,
+like PUSH and POP, because of their existing ACL2 or Common Lisp definitions
+are incompatible with the intended definitions below.  Others of the symbols I
+don't import are defined acceptably in the ACL2 package, e.g., NTH, but I want
+to students to see their definitions as warm-up exercises.
+
+(defpkg "M1"
+  (set-difference-eq (union-eq *acl2-exports*
+                               *common-lisp-symbols-from-main-lisp-package*)
+                     '(push pop pc program step)))
+
+(certify-book "good-statep" 1)
+
+|#
+
+(in-package "M1")
+
+; -----------------------------------------------------------------
+; Stack Manipulation -- Step 1:  Define the (well-guarded) functions
+
+(defun stackp (lst)
+  (declare (xargs :guard t))
+  (cond ((atom lst) (equal lst nil))
+        (t (and (rationalp (car lst))
+                (stackp (cdr lst))))))
+
+; -----------------------------------------------------------------
+
+; Indexing into a List:
+
+; The only difference between new2 and new3 is that in new3 the symbols
+; nth and update-nth are imported into "M1".  But we need NTH to behave
+; as it does in new2.  Fortunately, the definitions of NTH in "ACL2"
+; and new2's "M1" are equivalent, just different.  So we prove the
+; alternative definition rule and disable the built-in rule.
+
+(defthm nth-alt-def
+  (equal (nth n list)
+         (IF (ZP N)
+             (CAR LIST)
+             (NTH (- N 1) (CDR LIST))))
+  :rule-classes ((:definition :controller-alist ((nth t nil)))))
+
+(in-theory (disable (:definition nth)))
+
+; -----------------------------------------------------------------
+; The pc of a State
+
+(defun pcp (x max-pc)
+  (declare (xargs :guard (natp max-pc)))
+  (and (natp x)
+       (< x max-pc)))
+
+; -----------------------------------------------------------------
+; The Locals of a State
+
+; The locals must be a list of integers.  This is equivalent to stackp but
+; we'll define it separately for sanity.
+
+(defun localsp (lst)
+  (declare (xargs :guard t))
+  (cond ((atom lst) (equal lst nil))
+        (t (and (rationalp (car lst))
+                (localsp (cdr lst))))))
+
+
+; -----------------------------------------------------------------
+; Instruction Accessors
+
+(defun op-code (inst)
+  (declare (xargs :guard (true-listp inst)))
+  (nth 0 inst))
+
+(defun arg1 (inst)
+  (declare (xargs :guard (true-listp inst)))
+  (nth 1 inst))
+
+; Since there are no functions for creating instructions, we don't need
+; ``accessor-constructor'' lemmas like top-push, etc.  We will just disable
+; these functions so that on symbolic expressions they do not expand.
+
+(in-theory (disable op-code arg1))
+
+;  Note that since we did not disable the executable-counterparts of these
+; functions they will compute out on constants, e.g. (arg1 '(ILOAD 3)) = 3.
+
+; -----------------------------------------------------------------
+; Instruction Well-Formedness
+
+
+
+; First we check ``syntactic'' (context-free) conditions on the shape of the
+; program.
+
+(defun instructionp (inst)
+  (declare (xargs :guard t))
+  (and (true-listp inst)
+       (consp inst)
+       (case (op-code inst)
+         ((IADD ISUB IMUL HALT)
+          (equal (len inst) 1))
+         ((ILOAD ISTORE)
+          (and (equal (len inst) 2)
+               (natp (arg1 inst))))
+         (ICONST
+          (and (equal (len inst) 2)
+               (rationalp (arg1 inst))))
+         ((GOTO IFEQ)
+          (and (equal (len inst) 2)
+               (integerp (arg1 inst))))
+         (otherwise nil))))
+
+(defun programp (lst)
+  (declare (xargs :guard t))
+  (cond
+   ((atom lst) (equal lst nil))
+   (t (and (instructionp (car lst))
+           (programp (cdr lst))))))
+
+(defthm instructionp-nth
+  (implies (and (programp lst)
+                (natp pc)
+                (< pc (len lst)))
+           (instructionp (nth pc lst)))
+  :rule-classes nil)
+
+; Note: The lemma above isn't a lot of use as a :rewrite or :forward-chaining
+; rule because too much information is buried inside the instructionp
+; conclusion, e.g., that the arg1 of the inst is a rational if the op-code is
+; ICONST.  So we arrange for this lemma to be :used automatically whenever
+; instances of (programp lst) and (nth pc lst) both occur the goal.
+
+(include-book "use-when")
+
+(acl2::use-when instructionp-nth         ; lemma name
+                nil                      ; initial substitution
+                :hyp (programp lst)      ; patterns to look for as
+                :subterm (nth pc lst))   ; either hyps or subterms
+
+; Now we check more context-sensitive constraints, e.g., that every local
+; variable index is legal, and that every ``next pc'' is legal.  We then
+; develop the machinery for checking that the stack always has enough things on
+; it.
+
+; Two methods come to mind to check the local variable indices.
+; (a) visit every ILOAD and ISTORE and check that its index is less than the
+;     length of the locals in the state in question
+; (b) visit every ILOAD and ISTORE and compute the maximum local, saving
+;     the state-related question until later.
+
+; We choose (b) because then we will be able to more easily show that if a
+; program is legal with some local variable array it is legal with any larger
+; one.  We need this property when we do code proofs because our code
+; correctness lemmas do not fully specify the length of the local variable
+; array.
+
+; Choosing (a) -- which we actually did the first time we implemented guards --
+; complicates the proof because we drag full states down into the simple
+; question of whether a program uses too big an index.
+
+(defun max-local (program)
+  (declare (xargs :guard (programp program)))
+  (cond ((endp program) -1)
+        ((or (eq (op-code (car program)) 'ILOAD)
+             (eq (op-code (car program)) 'ISTORE))
+         (max (arg1 (car program))
+              (max-local (cdr program))))
+        (t (max-local (cdr program)))))
+
+(defthm integerp-max-local
+  (implies (programp program)
+           (integerp (max-local program))))
+
+(defthm max-local-almost-natp
+  (implies (programp program)
+           (<= -1 (max-local program)))
+  :rule-classes :linear)
+
+(defthm max-local-nth
+  (implies (and (natp i)
+                (< i (len program))
+                (or (eq (op-code (nth i program)) 'ILOAD)
+                    (eq (op-code (nth i program)) 'ISTORE)))
+           (<= (arg1 (nth i program)) (max-local program)))
+  :rule-classes :linear)
+
+; Now we check that the next pc is always legal.
+
+(defun next-pc-okp (inst pc max-pc)
+  (declare (xargs :guard (and (instructionp inst)
+                              (natp pc)
+                              (natp max-pc)
+                              (< pc max-pc))))
+  (case (op-code inst)
+    ((ILOAD ISTORE ICONST IADD ISUB IMUL)
+     (pcp (+ 1 pc) max-pc))
+    (GOTO
+     (pcp (+ pc (arg1 inst)) max-pc))
+    (IFEQ
+     (and (pcp (+ pc (arg1 inst)) max-pc)
+          (pcp (+ pc 1) max-pc)))
+    (HALT t)
+    (otherwise nil)))
+
+(defthm programp-true-listp
+  (implies (programp lst)
+           (true-listp lst))
+  :rule-classes :forward-chaining)
+
+(defun all-pcs-okp (program pc)
+  (declare (xargs :measure (nfix (- (len program) (nfix pc)))
+                  :guard (and (programp program)
+                              (natp pc))))
+  (cond ((or (not (natp pc))
+             (>= pc (len program)))
+         t)
+        (t (and (next-pc-okp (nth pc program) pc (len program))
+                (all-pcs-okp program (+ 1 pc))))))
+
+(defthm next-pc-okp-nth
+  (implies (and (all-pcs-okp program pc)
+                (programp program)
+                (natp pc)
+                (natp i)
+                (<= pc i)
+                (< i (len program)))
+           (next-pc-okp (nth i program) i (len program)))
+  :rule-classes nil)
+
+; The lemma above is like instructionp-nth above: not very useful if stored as
+; :rewrite or :foreward-chaining rule.  So again, we force its automatic use:
+
+(acl2::use-when next-pc-okp-nth
+                ((pc . '0))
+                :hyp (all-pcs-okp program pc)
+                :subterm (nth i program))
+
+; Note that the first trigger is (all-pcs-okp program 0), given the initial
+; alist.
+
+; -----------------------------------------------------------------
+
+; State Manipulation:
+
+(defun pc (s)
+  (declare (xargs :guard (true-listp s)))
+  (nth 0 s))
+(defun locals (s)
+  (declare (xargs :guard (true-listp s)))
+  (nth 1 s))
+(defun stack (s)
+  (declare (xargs :guard (true-listp s)))
+  (nth 2 s))
+(defun program (s)
+  (declare (xargs :guard (true-listp s)))
+  (nth 3 s))
+
+(in-theory (disable pc locals stack program))
+
+; -----------------------------------------------------------------
+; Computing a Stack Map
+
+; A ``stack map'' is an association list that maps program counters to the
+; depth of the stack at arrival at that program counter.  It shall be a
+; requirement that every program counter have a fixed stack depth upon every
+; arrival.  I.e., a bytecode program is illegal if the stack is of different
+; sizes upon different arrivals at a given program counter.  (Of course, there
+; are perfectly ``nice'' programs that violate this requirement and, indeed, we
+; verify one such program in our suite of examples; see funny-fact.lisp.)
+
+; To check whether an M1 program satisfies the rule, we try to generate a stack
+; map.  This is done by the function gsm (``generate stack map'') and its
+; subfunction gsm1.  Gsm1 is essentially an abstract interpreter for M1 code.
+; Instead of manipulating actual data it just records the stack depth at each
+; instruction.  Upon encountering the branch instruction, IFEQ, it pursues both
+; branches.  It builds up the map as it goes, storing the current stack depth
+; upon arrival at a pc never before seen, and aborting with failure if it
+; arrives at a given pc with a different stack depth than previously stored.
+; It halts because the number of unvisited pcs shrinks as it recurs.  The
+; definitions between here and that for gsm1 are devoted to proving that.
+
+(defthm len-set-difference-equal
+  (implies (and (member e big)
+                (not (member e small)))
+           (< (len (set-difference-equal big (cons e small)))
+              (len (set-difference-equal big small))))
+  :rule-classes :linear)
+
+(defun nats-below (n)
+  (declare (xargs :guard (natp n)))
+  (cond ((zp n) nil)
+        (t (cons (- n 1) (nats-below (- n 1))))))
+
+(defun nat-to-nat-alistp (x)
+  (declare (xargs :guard t))
+  (cond
+   ((atom x) (equal x nil))
+   ((consp (car x))
+    (and (natp (car (car x)))
+         (natp (cdr (car x)))
+         (nat-to-nat-alistp (cdr x))))
+   (t nil)))
+
+(defthm nat-to-nat-alistp-to-alistp
+  (implies (nat-to-nat-alistp x)
+           (alistp x))
+  :rule-classes (:rewrite :forward-chaining))
+
+(defthm nats-below-property
+  (implies (and (natp max-pc)
+                (natp pc)
+                (< pc max-pc))
+           (member pc (nats-below max-pc))))
+ 
+(defthm subsetp-implies-member
+  (implies (and (subsetp a b)
+                (member e a))
+           (member e b)))
+
+; This is an unusual rule because the lhs is smaller than the rhs, but
+; the proofs below fail if I reverse the orientation.  I'm not sure why.
+
+(defthm assoc-is-member-strip-cars
+  (implies (alistp alist)
+           (iff (assoc key alist)
+                (member key (strip-cars alist)))))
+
+(defthm nat-to-nat-alistp-property
+  (implies (and (nat-to-nat-alistp alist)
+                (assoc x alist))
+           (natp (cdr (assoc x alist))))
+  :rule-classes (:rewrite
+                 (:rewrite
+                  :corollary
+                  (implies (and (nat-to-nat-alistp alist)
+                                (assoc x alist))
+                           (integerp (cdr (assoc x alist)))))
+                 (:linear
+                  :corollary
+                  (implies (and (nat-to-nat-alistp alist)
+                                (assoc x alist))
+                           (<= 0 (cdr (assoc x alist)))))))
+
+(defun gsm1 (pc stackn program map)
+  (declare (xargs :measure (len (set-difference-equal (nats-below (len program))
+                                                      (strip-cars map)))
+                  :guard (and (pcp pc (len program))
+                              (natp stackn)
+                              (programp program)
+                              (all-pcs-okp program 0)
+                              (nat-to-nat-alistp map))
+                  :verify-guards nil))
+  (let ((inst (nth pc program))
+        (temp (assoc pc map)))
+    (cond
+     ((mbe :logic (not (and (pcp pc (len program))
+                            (natp stackn)
+                            (programp program)
+                            (all-pcs-okp program 0)
+                            (nat-to-nat-alistp map)))
+           :exec nil)
+      nil)
+     (temp (if (equal stackn (cdr temp))
+               map
+               nil))
+     (t (let ((map1 (cons (cons pc stackn) map)))
+          (case (op-code inst)
+            ((ILOAD ICONST)
+             (gsm1 (+ pc 1) (+ 1 stackn) program map1))
+            (ISTORE
+             (if (<= 1 stackn)
+                 (gsm1 (+ pc 1) (- stackn 1) program map1)
+                 nil))
+            ((IADD ISUB IMUL)
+             (if (<= 2 stackn)
+                 (gsm1 (+ pc 1) (- stackn 1) program map1)
+                 nil))
+            (GOTO
+             (gsm1 (+ pc (arg1 inst)) stackn program map1))
+            (IFEQ
+             (if (< 0 stackn)
+                 (let ((map2 (gsm1 (+ pc (arg1 inst)) (- stackn 1) program map1)))
+                   (cond
+                    ((null map2) nil)
+                    ((mbe :logic
+                          (< (len (set-difference-equal (nats-below (len program)) (strip-cars map2)))
+                             (len (set-difference-equal (nats-below (len program)) (strip-cars map))))
+                          :exec
+                          t)
+                     (gsm1 (+ pc 1) (- stackn 1) program map2))
+                    (t nil)))
+                 nil))
+            (HALT map1)
+            (otherwise nil)))))))
+
+; Todo:
+; I don't know why I need the expand hint below, but I need it repeatedly.
+; I also believe I could get the proof a lot faster if I disabled everything
+; not involved in the construction of the new map.
+
+(defthm nat-to-nat-alistp-gsm1
+  (implies (nat-to-nat-alistp map)
+           (nat-to-nat-alistp (gsm1 pc stackn program map)))
+  :hints (("Subgoal *1/2''"
+           :expand
+           (GSM1 PC (CDR (ASSOC-EQUAL PC MAP))
+                 PROGRAM MAP))))
+
+(defthm subsetp-cons
+  (implies (subsetp a b)
+           (subsetp a (cons e b))))
+
+(defthm subsetp-refl
+  (subsetp a a))
+
+(defthm subsetp-trans
+  (implies (and (subsetp a b)
+                (subsetp b c))
+           (subsetp a c)))
+
+(defthm member-subsetp
+  (implies (and (member e a)
+                (subsetp a b))
+           (member e b)))
+
+
+; Todo: This is like pulling teeth...  Why do I need these hints?
+
+; Todo:  Hints!  Yuck...
+
+(defthm subsetp-strip-cars-gsm1
+  (implies (gsm1 pc stackn program map)
+           (subsetp (strip-cars map)
+                    (strip-cars (gsm1 pc stackn program map))))
+  :hints
+  (("Subgoal *1/2''"  ; Same hint as above...
+    :expand
+    (GSM1 PC (CDR (ASSOC-EQUAL PC MAP))
+          PROGRAM MAP))))
+
+(defthm strong-set-difference-equal-subsetp
+  (implies (and (not (member e little2))
+                (member e little1)
+                (member e big)
+                (subsetp little2 little1))
+           (< (len (set-difference-equal big little1))
+              (len (set-difference-equal big little2))))
+  :rule-classes nil)
+
+(in-theory (disable all-pcs-okp))
+
+(verify-guards gsm1
+               :hints
+               (("Goal" :do-not-induct t)
+                ("Subgoal 5'"
+                 :use ((:instance subsetp-strip-cars-gsm1
+                                  (pc (+ pc (arg1 (nth pc program))))
+                                  (stackn (+ -1 stackn))
+                                  (program program)
+                                  (map (cons (cons pc stackn) map)))
+                       (:instance member-subsetp
+                                  (e pc)
+                                  (a (strip-cars (cons (cons pc stackn) map)))
+                                  (b (strip-cars (gsm1 (+ pc (arg1 (nth pc program)))
+                                                       (+ -1 stackn)
+                                                       program (cons (cons pc stackn) map)))))
+                       (:instance subsetp-trans
+                                  (a (strip-cars map))
+                                  (b (strip-cars (cons (cons pc stackn) map)))
+                                  (c (strip-cars (gsm1 (+ pc (arg1 (nth pc program)))
+                                                       (+ -1 stackn)
+                                                       program (cons (cons pc stackn) map)))))
+                       (:instance strong-set-difference-equal-subsetp
+                                  (e pc)
+                                  (little2 (strip-cars map))
+                                  (little1 (strip-cars (gsm1 (+ pc (arg1 (nth pc program)))
+                                                             (+ -1 stackn)
+                                                             program (cons (cons pc stackn) map))))
+                                  (big (nats-below (len program)))))
+                 :in-theory (disable subsetp-strip-cars-gsm1
+                                     member-subsetp
+                                     subsetp-trans))))
+
+(defthm eqlable-listp-nats-below
+  (eqlable-listp (nats-below n)))
+
+(defun gsm (program)
+  (declare (xargs :guard (and (programp program)
+                              (all-pcs-okp program 0))))
+  (let ((alist (if (null program)
+                   nil
+                   (gsm1 0 0 program nil))))
+    (if (subsetp (nats-below (len program))
+                 (strip-cars alist))
+        alist
+        nil)))
+
+; -----------------------------------------------------------------
+; Checking a Stack Map
+
+; Because the stack map changes as it is built up, I found it easier to define
+; the function that checks that a stack map is legal, i.e., maps every pc to
+; some stack depth that is correctly related to the stack depth of the next
+; instruction.  This property is checked by csm (``check stack map'').  I then
+; use the construct (csm ...(gsm ...) ...), i.e., is the stack map generated by
+; gsm a legal one?  
+
+; I believe it is the case that if gsm returns non-nil then its result is a
+; legal stack map.  A nice piece of future work would be to prove that.  But
+; this approach suffices to give us an effective guard.
+        
+(defthm integerp-implies-rationalp ; give me a break!
+  (implies (integerp x)
+           (rationalp x)))
+
+(defun csm1 (pc program stack-map)
+  (declare (xargs :measure (nfix (- (len program) (nfix pc)))
+                  :guard (and (natp pc)
+                              (programp program)
+                              (all-pcs-okp program 0)
+                              (nat-to-nat-alistp stack-map))))
+  (cond
+   ((mbe :logic (not (and (natp pc)
+                          (programp program)
+                          (all-pcs-okp program 0)
+                          (nat-to-nat-alistp stack-map)))
+         :exec nil)
+    nil)
+   ((>= pc (len program)) t)
+   (t
+    (let ((inst (nth pc program))
+          (temp (assoc pc stack-map)))
+      (cond
+       ((null temp) nil)
+       (t (case (op-code inst)
+            ((ILOAD ICONST)
+             (and (assoc (+ 1 pc) stack-map)
+                  (equal (+ 1 (cdr temp))
+                         (cdr (assoc (+ 1 pc) stack-map)))
+                  (csm1 (+ pc 1) program stack-map)))
+            (ISTORE
+             (and (<= 1 (cdr temp))
+                  (assoc (+ 1 pc) stack-map)
+                  (equal (+ -1 (cdr temp))
+                         (cdr (assoc (+ 1 pc) stack-map)))
+                  (csm1 (+ pc 1) program stack-map)))
+            ((IADD ISUB IMUL)
+             (and (<= 2 (cdr temp))
+                  (assoc (+ 1 pc) stack-map)
+                  (equal (+ -1 (cdr temp))
+                         (cdr (assoc (+ 1 pc) stack-map)))
+                  (csm1 (+ pc 1) program stack-map)))
+            (GOTO
+             (and (assoc (+ pc (arg1 inst)) stack-map)
+                  (equal (cdr temp)
+                         (cdr (assoc (+ pc (arg1 inst)) stack-map)))
+                  (csm1 (+ pc 1) program stack-map)))
+            (IFEQ
+             (and (<= 1 (cdr temp))
+                  (assoc (+ 1 pc) stack-map)
+                  (equal (+ -1 (cdr temp))
+                         (cdr (assoc (+ 1 pc) stack-map)))
+                  (assoc (+ pc (arg1 inst)) stack-map)
+                  (equal (+ -1 (cdr temp))
+                         (cdr (assoc (+ pc (arg1 inst)) stack-map)))
+                  (csm1 (+ pc 1) program stack-map)))
+            (HALT (csm1 (+ pc 1) program stack-map))
+            (otherwise nil))))))))
+
+(defun csm (program stack-map)
+  (declare (xargs :guard (and (programp program)
+                              (all-pcs-okp program 0)
+                              (nat-to-nat-alistp stack-map))))
+  (cond
+   ((null program)
+    (equal stack-map nil))
+   ((not (nat-to-nat-alistp stack-map)) nil)
+   (t (csm1 0 program stack-map))))
+
+(in-theory (disable csm))
+
+; -----------------------------------------------------------------
+; Well-Formed States
+
+(defthm consp-assoc
+  (implies (and (alistp a)
+                (assoc k a))
+           (consp (assoc k a))))
+
+(defun good-statep (s)
+  (declare (xargs :guard t))
+  (and (true-listp s)                 ; state is right shape
+       (equal (len s) 4)
+
+       (natp (pc s))                  ; components are right shape
+       (localsp (locals s))
+       (stackp (stack s))
+       (programp (program s))
+                                      ; context-sensitive constraints
+       (< (pc s) (len (program s)))   ; * pc in bounds of program
+       (< (max-local (program s))     ; * all local vars exist
+          (len (locals s)))
+       (all-pcs-okp (program s) 0)    ; * all pcs in bounds
+       (csm (program s)               ; * stack map exists
+            (gsm (program s)))
+       (equal (len (stack s))         ; * stack right depth
+              (cdr (assoc (pc s)
+                          (gsm (program s)))))
+       
+       ))
+
+; Note that it might be the case that there are no good states!  For example,
+; it might be that gsm NEVER produces a stack map that csm approves.  In this
+; case, all the theorems hypothesizing good-statep would be vacuously true.
+; Just to establish that this is not the case, here is a theorem that shows
+; that there is at least one good state!  The one I choose is non-trivial: an
+; initial state for the M1 program verified in the file sum.lisp.
+
+(defthm good-statep-is-not-always-false
+  (good-statep (list 0 '(5 0) nil
+                     '((ICONST 0)       ;  0
+                       (ISTORE 1)       ;  1
+                       (ILOAD 0)        ;  2
+                       (IFEQ 10)        ;  3
+                       (ILOAD 1)        ;  4
+                       (ILOAD 0)        ;  5
+                       (IADD)           ;  6
+                       (ISTORE 1)       ;  7
+                       (ILOAD 0)        ;  8
+                       (ICONST 1)       ;  9
+                       (ISUB)           ; 10
+                       (ISTORE 0)       ; 11
+                       (GOTO -10)       ; 12
+                       (ILOAD 1)        ; 13
+                       (HALT))))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/implementation.acl2 acl2-6.3/books/models/jvm/guard-verified-m1/implementation.acl2
--- acl2-6.2/books/models/jvm/guard-verified-m1/implementation.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/implementation.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,2 @@
+(include-book "tmi-reductions")
+(certify-book "implementation" ? t)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/implementation.lisp acl2-6.3/books/models/jvm/guard-verified-m1/implementation.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/implementation.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/implementation.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,340 @@
+; (value :q)
+; (ccl::gc-verbose nil nil)
+; (lp)
+; (include-book "tmi-reductions")
+; (time$ (with-output :off :all (certify-book "implementation" 1)))
+; Timings on Whitehart:
+; Mon Jul 16 09:26:20 2012
+; 86.29 seconds realtime, 77.47 seconds runtime
+
+(in-package "M1")
+(include-book "defsys")
+
+(defthm nst-out-bound
+  (implies (natp w)
+           (< (nst-out cell w) (expt 2 w)))
+  :hints (("Goal" :in-theory (enable nst-out)))
+  :rule-classes :linear)
+
+(defthm current-symn-bound
+  (< (current-symn tape pos) 2)
+  :hints (("Goal" :in-theory (enable current-symn)))
+  :rule-classes :linear)
+
+(defun ninstr1 (st sym tm w nnil)
+  (if (natp w)
+      (if (zp tm)
+          -1
+          (if (equal tm nnil)
+              -1
+              (let ((cell (ncar tm w)))
+                (if (and (equal st (nst-in cell w))
+                         (equal sym (nsym cell w)))
+                    cell
+                    (ninstr1 st sym (ncdr tm w) w nnil)))))
+      -1))
+
+(defthm ninstr1-nnil-is-ninstr
+  (equal (ninstr1 st sym tm w (nnil w))
+         (ninstr st sym tm w))
+  :hints (("Goal" :in-theory (enable ninstr))))
+
+(in-theory (enable nst-in nsym nop nst-out ncar ncdr current-symn new-tape2))
+
+(defsys :ld-flg nil
+  :modules
+  ((lessp :formals (x y)
+          :input (and (natp x)
+                      (natp y))
+          :output (if (< x y) 1 0)
+          :code (ifeq y
+                      0
+                      (ifeq x
+                            1
+                            (lessp (- x 1) (- y 1)))))
+   (mod :formals (x y)
+        :input (and (natp x)
+                    (natp y)
+                    (not (equal y 0)))
+        :output (mod x y)
+        :code (ifeq (lessp x y)
+                    (mod (- x y) y)
+                    x))
+   (floor :formals (x y a)
+          :input (and (natp x)
+                      (natp y)
+                      (not (equal y 0))
+                      (natp a))
+          :output (+ a (floor x y))
+          :code (ifeq (lessp x y)
+                      (floor (- x y) y (+ a 1))
+                      a))
+   (log2 :formals (x a)
+         :input (and (natp x)
+                     (natp a))
+         :output (+ a (log2 x))
+         :code (ifeq x
+                     a
+                     (ifeq (- x 1)
+                           a
+                           (log2 (floor x 2 0) (+ 1 a)))))
+   (expt :formals (x n a)
+         :input (and (natp x)
+                     (natp n)
+                     (natp a))
+         :output (* a (expt x n))
+         :code (ifeq n
+                     a
+                     (expt x (- n 1) (* x a))))
+   (nst-in :formals (cell w)
+           :input (and (natp cell)
+                       (natp w))
+           :output (nst-in cell w)
+           :code (mod cell (expt 2 w 1)))
+
+   (nsym :formals (cell w)
+         :input (and (natp cell) (natp w))
+         :output (nsym cell w)
+         :code (mod (floor cell (expt 2 w 1) 0) 2))
+
+   (nop :formals (cell w)
+        :input (and (natp cell) (natp w))
+        :output (nop cell w)
+        :code (mod (floor cell (expt 2 (+ 1 w) 1) 0)
+                   8))
+
+   (nst-out :formals (cell w)
+            :input (and (natp cell) (natp w))
+            :output (nst-out cell w)
+            :code (mod (floor cell (expt 2 (+ 4 w) 1) 0)
+                       (expt 2 w 1)))
+
+   (ncar :formals (tm w)
+         :input (and (natp tm) (natp w))
+         :output (ncar tm w)
+         :code (mod tm (expt 2 (+ 4 (* 2 w)) 1)))
+
+   (ncdr :formals (tm w)
+         :input (and (natp tm) (natp w))
+         :output (ncdr tm w)
+         :code (floor tm (expt 2 (+ 4 (* 2 w)) 1) 0))
+
+   (current-symn :formals (tape pos)
+                 :input (and (natp tape)
+                             (natp pos))
+                 :output (current-symn tape pos)
+                 :code (ifeq (- pos (log2 tape 0))
+                             0
+                             (mod (floor tape (expt 2 pos 1) 0)
+                                  2)))
+
+   (ninstr1 :formals (st sym tm w nnil)
+            :input (and (natp st)
+                        (natp sym)
+                        (natp tm)
+                        (natp w)
+                        (equal nnil (nnil w)))
+            :output (ninstr1 st sym tm w nnil)
+            :code
+            (ifeq tm
+                  -1
+                  (ifeq (- tm nnil)
+                        -1
+                        (ifeq (ifeq (- st (nst-in (ncar tm w) w))
+                                    (- sym (nsym (ncar tm w) w))
+                                    1)
+                              (ncar tm w)
+                              (ninstr1 st sym (ncdr tm w) w nnil)))))
+  
+   (new-tape2 :formals (op tape pos)
+              :input (and (natp op)
+                          (natp tape)
+                          (natp pos))
+              :output (mv (acl2::mv-nth 0 (new-tape2 op tape pos))
+                          (acl2::mv-nth 1 (new-tape2 op tape pos)))
+              :code
+              (ifeq (ifeq op
+                          0
+                          (ifeq (- op 1)
+                                0
+                                1))
+                    (ifeq (- pos (log2 tape 0))
+                          (ifeq op
+                                (mv (+ tape (expt 2 pos 1)) pos)
+                                (mv (+ tape (expt 2 (+ pos 1) 1)) pos))
+                          (ifeq (- (current-symn tape pos) op)
+                                (mv tape pos)
+                                (ifeq (current-symn tape pos)
+                                      (mv (+ tape (expt 2 pos 1)) pos)
+                                      (mv (- tape (expt 2 pos 1)) pos))))
+                    (ifeq (- op 2)
+                          (ifeq pos
+                                (mv (* 2 tape) 0)
+                                (mv tape (- pos 1)))
+                         
+                          (ifeq (- pos (log2 tape 0))
+                                (mv (+ (- tape (expt 2 pos 1))
+                                       (expt 2 (+ 1 pos) 1))
+                                    (+ 1 pos))
+                                (mv tape (+ pos 1)))))
+              :ghost-base-value (mv tape pos))
+
+   (tmi3 :formals (st tape pos tm w nnil)
+         :dcls ((declare (xargs :measure (acl2-count n))))
+         :input (and (natp st)
+                     (natp tape)
+                     (natp pos)
+                     (natp tm)
+                     (natp w)
+                     (equal nnil (nnil w))
+                     (< st (expt 2 w)))
+         :output (tmi3 st tape pos tm w n) ; the logic's tmi3 doesn't take nnil as an arg.
+         :output-arity 4
+         :code
+         (ifeq (- (ninstr1 st (current-symn tape pos) tm w nnil) -1)
+               (mv 1 st tape pos)
+               (tmi3 (nst-out (ninstr1 st (current-symn tape pos) tm w nnil)
+                              w)
+                     (new-tape2 (nop (ninstr1 st (current-symn tape pos) tm w nnil)
+                                     w)
+                                tape pos)
+                     tm w nnil))
+         :ghost-formals (n)
+         :ghost-base-test (zp n)
+         :ghost-base-value (mv 0 st tape pos)
+         :ghost-decr ((- n 1)))
+
+   (main :formals (st tape pos tm w nnil)
+         :input (and (natp st)
+                     (natp tape)
+                     (natp pos)
+                     (natp tm)
+                     (natp w)
+                     (equal nnil (nnil w))
+                     (< st (expt 2 w)))
+         :output (tmi3 st tape pos tm w n)
+         :output-arity 4
+         :code (tmi3 st tape pos tm w nnil)
+         :ghost-formals (n)
+         :ghost-base-value (mv 0 st tape pos)))
+  :edit-commands
+  ((defun !ninstr1
+     :before
+     ((defthm natp-ncar
+        (implies (natp tm)
+                 (natp (ncar tm w)))
+        :rule-classes :type-prescription)
+
+      (defthm natp-ncdr-x
+        (implies (natp tm)
+                 (natp (ncdr tm w)))
+        :rule-classes :type-prescription)
+
+      (in-theory (disable ncar ncdr))
+
+      (defthm natp-nst-in
+        (implies (natp cell)
+                 (natp (nst-in cell w)))
+        :rule-classes :type-prescription)
+
+; The type-prescriptions for nsym, nop, and nst-out specify NATP.
+
+      (in-theory (disable nst-in nsym nop nst-out))
+
+; The type-prescription for current-symn specifies NATP.
+
+      (in-theory (disable current-symn))
+      ))
+   (defun !tmi3
+     :before
+     ((defthm integerp-ninstr1
+        (implies (and (natp st)
+                      (natp sym)
+                      (natp tm)
+                      (natp w)
+                      (equal nnil (nnil w)))
+                 (and (integerp (ninstr1 st sym tm w nnil))
+                      (<= -1 (ninstr1 st sym tm w nnil))))
+        :rule-classes
+        ((:type-prescription
+          :corollary
+          (implies (and (natp st)
+                        (natp sym)
+                        (natp tm)
+                        (natp w)
+                        (equal nnil (nnil w)))
+                   (integerp (ninstr1 st sym tm w nnil))))
+         (:linear
+          :corollary
+          (implies (and (natp st)
+                        (natp sym)
+                        (natp tm)
+                        (natp w)
+                        (equal nnil (nnil w)))
+                   (<= -1 (ninstr1 st sym tm w nnil))))
+         (:rewrite
+          :corollary
+          (implies (and (natp st)
+                        (natp sym)
+                        (natp tm)
+                        (natp w)
+                        (equal nnil (nnil w))
+                        (not (equal (ninstr1 st sym tm w nnil) -1)))
+                   (and (integerp (ninstr1 st sym tm w nnil))
+                        (<= 0 (ninstr1 st sym tm w nnil)))))))
+
+      (defthm integerp-ninstr
+        (implies (and (natp st)
+                      (natp sym)
+                      (natp tm)
+                      (natp w))
+                 (and (integerp (ninstr st sym tm w))
+                      (<= -1 (ninstr st sym tm w))))
+        :rule-classes
+        ((:type-prescription
+          :corollary
+          (implies (and (natp st)
+                        (natp sym)
+                        (natp tm)
+                        (natp w))
+                   (integerp (ninstr st sym tm w))))
+         (:linear
+          :corollary
+          (implies (and (natp st)
+                        (natp sym)
+                        (natp tm)
+                        (natp w))
+                   (<= -1 (ninstr st sym tm w))))
+         (:rewrite
+          :corollary
+          (implies (and (natp st)
+                        (natp sym)
+                        (natp tm)
+                        (natp w)
+                        (not (equal (ninstr st sym tm w) -1)))
+                   (and (integerp (ninstr st sym tm w))
+                        (<= 0 (ninstr st sym tm w)))))))
+                                                      
+      (defthm natp-mv-nth-0-new-tape2
+        (implies (and (natp tape)
+                      (natp pos))
+                 (natp (acl2::mv-nth 0 (new-tape2 op tape pos))))
+        :hints (("Goal" :nonlinearp t :in-theory (enable current-symn)))
+        :rule-classes :type-prescription)
+
+      (defthm natp-mv-nth-1-new-tape2
+        (implies (and (natp tape)
+                      (natp pos))
+                 (natp (acl2::mv-nth 1 (new-tape2 op tape pos))))
+        :hints (("Goal" :nonlinearp t :in-theory (enable current-symn)))
+        :rule-classes :type-prescription)
+
+      (in-theory (disable  ncar  ncdr  ninstr1  new-tape2  current-symn
+                           !ncar !ncdr !ninstr1 !new-tape2 !current-symn
+                           nst-in  nst-out  nop  nsym
+                           !nst-in !nst-out !nop !nsym))))
+   (defthm !tmi3-spec
+     :hints
+     (("Subgoal *1/10'" :expand (!TMI3 ST TAPE POS TM W (NNIL W) N))))))
+
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/lessp.lisp acl2-6.3/books/models/jvm/guard-verified-m1/lessp.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/lessp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/lessp.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,185 @@
+; Correctness of Less Than
+
+; Problem: Define an M1 program to compute whether natural number x is less than
+; natural number y.  Indicate true with 1 and false with 0.
+
+; Design Plan: I will count x and y both down by 1 and stop when either reaches
+; 0.  If y reaches 0 first (or at the same time), x < y was false.  If x
+; reaches 0 before y, x < y was true.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (x y)
+  (and (natp x)
+       (natp y)))
+
+(defun theta (x y)
+  (if (< x y) 1 0))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+; Note:  In this case, the helper and the top-level fn are the same.  We
+; don't need both, but we'll stick with the template.
+
+(defun helper (x y)
+  (cond ((zp y) 0)
+        ((zp x) 1)
+        (t (helper (- x 1) (- y 1)))))
+
+(defun fn (x y) (helper x y))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, a, and rest and fn calls helper initializing a to 0 and rest to nil,
+; your helper theorem must be about (helper n m a rest), not just about the
+; special case (helper n m 0 nil).
+
+(defthm helper-is-theta
+  (implies (and (natp x)
+                (natp y))
+           (equal (helper x y)
+                  (theta x y))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs x y)
+           (equal (fn x y)
+                  (theta x y))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((iload 1)   ;  0   lessp-loop:          -- the code for lessp
+    (ifeq 12)   ;  1   if y=0, goto false
+    (iload 0)   ;  2
+    (ifeq 12)   ;  3   if x=0, goto to true
+    (iload 0)   ;  4
+    (iconst 1)  ;  5
+    (isub)      ;  6
+    (istore 0)  ;  7   x = x-1
+    (iload 1)   ;  8
+    (iconst 1)  ;  9
+    (isub)      ; 10
+    (istore 1)  ; 11   y = y-1
+    (goto -12)  ; 12   goto lessp-loop
+    (iconst 0)  ; 13   lessp is false
+    (halt)      ; 14
+    (iconst 1)  ; 15   lessp is true
+    (halt)      ; 16   return a
+    ))
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (x y)
+  (if (zp y)
+      4
+      (if (zp x)
+          5
+          (clk+ 13
+                (loop-clk (- x 1) (- y 1))))))
+
+(defun clk (x y)
+  (loop-clk x y))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemmas about your loops must consider the general case.
+; For example, if a loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (natp x)
+                (natp y))
+           (equal (m1 (make-state 0
+                                  (list x y)
+                                  nil
+                                  *pi*)
+                      (loop-clk x y))
+                  (make-state (if (< x y) 16 14)
+                              (if (< x y)
+                                  (list 0 (- y x))
+                                  (list (- x y) 0))
+                              (push (helper x y) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs x y)
+           (equal (m1 (make-state 0
+                                  (list x y)
+                                  nil
+                                  *pi*)
+                      (clk x y))
+                  (make-state (if (< x y) 16 14)
+                              (if (< x y)
+                                  (list 0 (- y x))
+                                  (list (- x y) 0))
+                              (push (fn x y) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs x y)
+           (equal (m1 (make-state 0
+                                  (list x y)
+                                  nil
+                                  *pi*)
+                      (clk x y))
+                  (make-state (if (< x y) 16 14)
+                              (if (< x y)
+                                  (list 0 (- y x))
+                                  (list (- x y) 0))
+                              (push (theta x y)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp x)
+                (natp y)
+                (equal sf (m1 (make-state 0
+                                          (list x y)
+                                          nil
+                                          *pi*)
+                              (clk x y))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf)) (if (< x y) 1 0))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers x and y, there
+; exists a clock (for example, the one constructed by (clk x y)) such that
+; running *pi* with (list x y) as input produces a state, sf, that is halted
+; and which contains 1 or 0 on top of the stack depending on whether x < y.
+; Note that the algorithm used by *pi* is not specified or derivable from this
+; formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/low-seven.acl2 acl2-6.3/books/models/jvm/guard-verified-m1/low-seven.acl2
--- acl2-6.2/books/models/jvm/guard-verified-m1/low-seven.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/low-seven.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,2 @@
+(include-book "defsys")
+(certify-book "low-seven" ? t)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/low-seven.lisp acl2-6.3/books/models/jvm/guard-verified-m1/low-seven.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/low-seven.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/low-seven.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,84 @@
+; Low-Seven:  An Exploration of a Ghostly Defsys
+; J Strother Moore
+; March, 2012
+
+; (include-book "defsys")
+; (certify-book "low-seven" 1)
+
+(in-package "M1")
+
+; Low-seven looks for the digit 7 in the decimal representation of x, stopping
+; after it has inspected n digits.  If it finds it, it returns its position.
+; For example, (low-seven 9753 0 5) returns 2 because the lowest-order 7 occurs
+; at 10^2.  If there is no 7 among the low order n digits, low-seven returns
+; nil.
+
+; We will implement low-seven with an M1 program that does not halt unless it
+; finds a seven.  
+
+; Note: This is just a warm-up for more interesting proofs about
+; non-terminating programs.  Obviously, low-seven could look through all the
+; digits of x by stopping when x becomes 0, but we're not doing that, on
+; purpose!
+
+(defun low-seven! (x a n)
+  (declare (xargs :measure (acl2-count n)))
+  (if (zp n)
+      (mv 0 x a)
+      (if (equal (mod x 10) 7)
+          (mv 1 x a)
+          (low-seven! (floor x 10) (+ 1 a) (- n 1)))))
+
+(defsys
+  :ld-flg nil
+  :modules
+  ((lessp :formals (x y)
+          :input (and (natp x)
+                      (natp y))
+          :output (if (< x y) 1 0)
+          :code (ifeq y
+                      0
+                      (ifeq x
+                            1
+                            (lessp (- x 1) (- y 1)))))
+   (mod :formals (x y)
+        :input (and (natp x)
+                    (natp y)
+                    (not (equal y 0)))
+        :output (mod x y)
+        :code (ifeq (lessp x y)
+                    (mod (- x y) y)
+                    x))
+   (floor :formals (x y a)
+          :input (and (natp x)
+                      (natp y)
+                      (not (equal y 0))
+                      (natp a))
+          :output (+ a (floor x y))
+          :code (ifeq (lessp x y)
+                      (floor (- x y) y (+ a 1))
+                      a))
+
+   (low-seven :formals (x a)
+              :dcls   ((declare (xargs :measure (acl2-count n))))
+              :input (and (natp x)
+                          (natp a))
+              :output (low-seven! x a n)
+              :output-arity 3
+              :code (ifeq (- (mod x 10) 7)
+                          (mv 1 x a)
+                          (low-seven (floor x 10 0)
+                                     (+ 1 a)))
+              :ghost-formals (n)
+              :ghost-base-test (zp n)
+              :ghost-base-value (mv 0 x a)
+              :ghost-decr ((- n 1)))
+
+   (main :formals (x)
+         :input (natp x)
+         :output (low-seven! x 0 n)
+         :output-arity 3
+         :code (low-seven x 0)
+         :ghost-formals (n)
+         :ghost-base-value (mv 0 -1 -1))))
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/m1.acl2 acl2-6.3/books/models/jvm/guard-verified-m1/m1.acl2
--- acl2-6.2/books/models/jvm/guard-verified-m1/m1.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/m1.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,3 @@
+(include-book "good-statep")
+
+(certify-book "m1" ? t)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/m1.lisp acl2-6.3/books/models/jvm/guard-verified-m1/m1.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/m1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/m1.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,621 @@
+#||
+
+The M1 Model
+J Strother Moore
+
+See the README file on this directory for an overview of this work.  In this
+file I define the M1 model -- a very simple machine sort of kinda like the JVM.
+The machine has nine instructions that manipulate an array of local variable
+values and a push down stack.
+
+HOW TO PLAY WITH AND RECERTIFY THIS FILE
+
+If you are playing with this model, do this:
+
+; (include-book "good-statep")
+
+; (ld "m1.lisp" :ld-pre-eval-print t)
+
+But to recertify it, do:
+
+; (include-book "good-statep")
+
+; (certify-book "m1" 1)
+
+BRIEF INTRODUCTION TO GUARDS
+
+In the definitions below we include ``guards'' for the functions we define.
+The guards for a function tell us what to expect of the arguments whenever the
+function is called.  For example, consider this definition which appears below:
+
+ (defun top (stack)
+  (declare (xargs :guard (and (stackp stack)
+                              (not (endp stack)))))
+  (car stack))
+
+Logically speaking, this just gives us the axiom that (top stack) is
+ (car stack), i.e.,
+
+ Axiom:
+ (equal (top stack) (car stack))
+
+We call this the ``logical'' definition of top and it is all that matters about
+top when we are proving theorems.
+
+But operationally it also tells us that we ``expect'' stack to satisfy the
+predicate stackp and to be non-empty.
+
+Why express these expectations?  First, as with type declarations in many
+programming languages, it is sometimes helpful while reading a definition to
+know what kind of things the definition deals with.  More importantly, by
+expressing our expectations formally we can carry out a kind of ``sanity
+check'' on the model: are all our expectations met when we run the model on
+concrete data?  For example, if some other function, e.g., execute-IADD below,
+calls top, we can try to prove -- with the theorem prover -- that the guards
+for execute-IADD imply the guards for top, i.e., that execute-IADD is using top
+in compliance with our expectations for top.  This process -- of proving that
+every call of every function is on arguments that meet our expectations -- is
+called ``guard verification.''  Third, guards allow us to run this model faster
+on concrete data.  If we have proved that all guards are satisfied, then when
+we run the model we just have to check that the top-level input satisfies the
+expressed expectations for the top-level function call and then we can know --
+without any runtime checking -- that every other call of every function in the
+model is on the expected kind of data.  That in turn means we can compile the
+functions without checking the expectations.  For the stack function top it
+means that the compiled code for top need not check that its argument is a
+non-empty stack: it just calls car exactly as the axiom says.
+
+We will verify all the guards below in a later book, verify-guards.lisp.  For
+the moment, I recommend just noting the guards as a way of learning what we
+expect about the arguments, without
+
+Some functions (e.g., nth below) are defined redundantly with those in
+good-statep.lisp but are included here to make this file a self-contained
+explication of the unguarded (logical) definition of M1.
+
+||#
+
+(in-package "M1")
+
+; For current purposes, guards may be ignored.
+
+(set-verify-guards-eagerness 0)
+
+; Note: The command above tells ACL2 not to bother to verify the guards on
+; these functions.  This is in line with my advice about not paying too much
+; attention to the guards upon the first reading.  But there is more to it than
+; that.  Some of the guards CANNOT be verified without first introducing the
+; logical definitions and proving properties of them.  Thus, it is actually
+; necessary to take this two-step approach.
+
+; -----------------------------------------------------------------
+; Stack Manipulation
+
+(defun push (x y)
+  (declare (xargs :guard t))
+  (cons x y))
+
+(defun top (stack)
+  (declare (xargs :guard (and (stackp stack)
+                              (not (endp stack)))))
+  (car stack))
+
+(defun pop (stack)
+  (declare (xargs :guard (and (stackp stack)
+                              (not (endp stack)))))
+  (cdr stack))
+
+; -----------------------------------------------------------------
+
+; Indexing into a List:
+
+; We will fetch the nth element of a list with the funciton nth and
+; update it with the function update-nth.  These two functions are
+; defined in the ACL2 sources.  You can look at their
+; definitions by typing
+
+; ACL2 !>:pe nth
+; or
+; ACL2 !>:pe update-nth
+
+; You may think of NTH and UPDATE-NTH as being defined this way (their ACL2
+; definitions are syntactically different but semantically equivalent):
+
+; (DEFUN NTH (N L)
+;   (IF (ZP N)
+;       (CAR L)
+;       (NTH (- N 1) (CDR L))))
+; and
+; (DEFUN UPDATE-NTH (N V L)
+;   (IF (ZP N)
+;       (CONS V (CDR L))
+;       (CONS (CAR L)
+;             (UPDATE-NTH (1- N) V (CDR L)))))
+
+; Note that if n is ``too big'' then the definitions above will apply car and
+; cdr to nil.  However, in Lisp, (car nil) = (cdr nil) = nil.
+
+;   (nth 3 '(A B))
+; = (nth 2 '(B))
+; = (nth 1 NIL)
+; = (nth 0 (cdr nil))
+; = (car (cdr nil))
+; = nil
+
+; and
+
+;   (update-nth 3 44 '(A B))
+; = (cons 'A (update-nth 2 44 '(B)))
+; = (cons 'A (cons 'B (update-nth 1 44 nil)))
+; = (cons 'A (cons 'B (cons (car nil) (update-nth 0 44 (cdr nil)))))
+; = (cons 'A (cons 'B (cons nil (cons 44 nil))))
+; = '(A B nil 44)
+
+; -----------------------------------------------------------------
+
+; State Manipulation:
+
+(defun make-state (pc locals stack program)
+  (declare (xargs :guard t))
+  (cons pc
+        (cons locals
+              (cons stack
+                    (cons program
+                          nil)))))
+
+(defun pc (s)
+  (declare (xargs :guard (true-listp s)))
+  (nth 0 s))
+(defun locals (s)
+  (declare (xargs :guard (true-listp s)))
+  (nth 1 s))
+(defun stack (s)
+  (declare (xargs :guard (true-listp s)))
+  (nth 2 s))
+(defun program (s)
+  (declare (xargs :guard (true-listp s)))
+  (nth 3 s))
+
+; -----------------------------------------------------------------
+; Instruction Accessors
+
+(defun op-code (inst)
+  (declare (xargs :guard (true-listp inst)))
+  (nth 0 inst))
+
+(defun arg1 (inst)
+  (declare (xargs :guard (true-listp inst)))
+  (nth 1 inst))
+
+; These next two are irrelevant to M1 but are included in the model to
+; to allow us to extend it conveniently with new instructions.
+
+(defun arg2 (inst)
+  (declare (xargs :guard (true-listp inst)))
+  (nth 2 inst))
+
+(defun arg3 (inst)
+  (declare (xargs :guard (true-listp inst)))
+  (nth 3 inst))
+
+; -----------------------------------------------------------------
+; The Next Instruction
+
+(defun next-inst (s)
+  (declare (xargs :guard (and (true-listp s)
+                              (natp (pc s))
+                              (true-listp (program s)))))
+  (nth (pc s) (program s)))
+
+; -----------------------------------------------------------------
+
+; The M1 Machine
+
+; Now we define the semantics of each instruction.  These functions are called
+; ``semantic functions.''
+
+; Each opcode will be given semantics with an ACL2 function that takes an
+; instruction (with the given opcode) and a state and returns the state
+; produced by executing the instruction.  For example, the ILOAD instruction,
+; looks like this:
+
+; (ILOAD k)
+
+; where k is the index of some local variable.  Informally, the instruction
+; extracts the value of local variable k from the state and pushes that value
+; onto the stack in the state.  The instruction also advances the program
+; counter.  Formally, this transformation on the state is specified by the
+; function execute-ILOAD, below.  Execute-ILOAD is called the ``semantic
+; function'' for ILOAD.  We define the instruction set by defining a semantic
+; function for each opcode in it.
+
+; Our expectation when (execute-ILOAD inst s) is called is that s is a ``good''
+; M1 state, that inst is the next instruction in s, and that inst is an ILOAD
+; instruction. Because we have analogous expectations on the semantic function
+; for each opcode, we wrap up these expectations into a single predicate:
+
+(defun ok-to-step (op inst s)
+  (declare (xargs :guard t))
+  (and (good-statep s)
+       (equal inst (next-inst s))
+       (equal (op-code inst) op)))
+
+; The predicate ok-to-step is only used to express the guards on our semantic
+; functions.
+
+; Exactly what a ``good'' state is is defined in the file good-state.lisp, but
+; I do not recommend reading it yet, if at all!  The only reason to read it is
+; to learn about bytecode verification.  Why?  What does good-statep mean?
+; Aside from the obvious ``shape'' constraints on s, it expresses a fairly
+; sophisticated constraint on what constitutes a well-formed M1 program in
+; state s.  Most of that is straightforward, e.g., each instruction has the
+; right syntax, e.g., the ILOAD instruction has a local variable number as its
+; argument.  But there are some subtlties.  One is that the program counter
+; never gets outside of the program.  So every jump has to be to a legal pc.
+; Another is that any instruction that manipulates the local variables must
+; find the local variable array sufficiently long; it is illegal to reference
+; local variable 5 if there are only 4 local variable values in the state.  But
+; the most subtle is that any instruction that pops the stack will always find
+; enough items on the stack.  Since instructions can push and pop items, this
+; last constraint is not a local one but depends on the control flow from one
+; instruction to another.  All these conditions are checked by a predicate akin
+; to the Java bytecode verifier.  That predicate involves the construction of a
+; ``stack map'' that says how deep the stack gets as the execution proceeds
+; through the program.  That's all we'll say about ``good'' states here.
+
+; But recall the little introduction to guards above: if the guards for
+; execute-ILOAD are satisfied, we can run execute-ILOAD without error, i.e.,
+; without worrying whether the instruction is well-formed, whether the local
+; variable of that index exists, whether incrementing the pc pushes it outside
+; the bounds of the program, etc.  So, if you're willing to assume our
+; expressed expectations are met, all you really need to know is what each
+; instruction does.  So now we list the instructions and give an informal and
+; then a formal description of their semantics.
+
+
+; Semantics of (ILOAD k): increment the pc and push onto the stack the value of
+; the kth local.  Aside: We will know, by guard verification, that the new pc
+; is legal and that the value pushed is a rational number.  As a rule, I will
+; not comment here on everything we know by guard verification, I'm just trying
+; to give you a sense of the implications of our expectations.
+
+(defun execute-ILOAD (inst s)
+  (declare (xargs :guard (ok-to-step 'ILOAD inst s)))
+  (make-state (+ 1 (pc s))
+              (locals s)
+              (push (nth (arg1 inst)
+                         (locals s))
+                    (stack s))
+              (program s)))
+
+
+; Semantics of (ICONST k):  increment the pc and push k onto the stack.
+
+(defun execute-ICONST (inst s)
+  (declare (xargs :guard (ok-to-step 'ICONST inst s)))
+  (make-state (+ 1 (pc s))
+              (locals s)
+              (push (arg1 inst) (stack s))
+              (program s)))
+
+; Semantics of (IADD): increment the pc, pop two items off the stack and push
+; their sum.  Aside: We will know, by guard verification, that there are at
+; least two items on the stack and that they are both rational numbers.
+
+(defun execute-IADD (inst s)
+  (declare (xargs :guard (ok-to-step 'IADD inst s))
+           (ignore inst))
+  (make-state (+ 1 (pc s))
+              (locals s)
+              (push (+ (top (pop (stack s)))
+                       (top (stack s)))
+                    (pop (pop (stack s))))
+              (program s)))
+
+; Semantics of (ISUB): increment the pc, pop two items off the stack and push
+; their difference.
+
+(defun execute-ISUB (inst s)
+  (declare (xargs :guard (ok-to-step 'ISUB inst s))
+           (ignore inst))
+  (make-state (+ 1 (pc s))
+              (locals s)
+              (push (- (top (pop (stack s)))
+                       (top (stack s)))
+                    (pop (pop (stack s))))
+              (program s)))
+
+; Semantics of (IMUL): increment the pc, pop two items off the stack and push
+; their product.
+
+(defun execute-IMUL (inst s)
+  (declare (xargs :guard (ok-to-step 'IMUL inst s))
+           (ignore inst))
+  (make-state (+ 1 (pc s))
+              (locals s)
+              (push (* (top (pop (stack s)))
+                       (top (stack s)))
+                    (pop (pop (stack s))))
+              (program s)))
+
+; Semantics of (ISTORE k): increment the pc, pop one item off the stack, and
+; store it as the value of local variable k.
+
+(defun execute-ISTORE (inst s)
+  (declare (xargs :guard (ok-to-step 'ISTORE inst s)))
+  (make-state (+ 1 (pc s))
+              (update-nth (arg1 inst) (top (stack s)) (locals s))
+              (pop (stack s))
+              (program s)))
+
+; Semantics of (GOTO k): increment the pc by k.  Aside: We will know, by guard
+; verification, that the new pc is legal.
+
+(defun execute-GOTO (inst s)
+  (declare (xargs :guard (ok-to-step 'GOTO inst s)))
+  (make-state (+ (arg1 inst) (pc s))
+              (locals s)
+              (stack s)
+              (program s)))
+
+; Semantics of (IFEQ k): pop one item off the stack and increment the pc k if
+; that item is 0 and by 1 if if is non-0.  Aside: We will know, by guard
+; verification, that the new pc is legal.
+
+(defun execute-IFEQ (inst s)
+  (declare (xargs :guard (ok-to-step 'IFEQ inst s)))
+  (make-state (if (equal (top (stack s)) 0)
+                  (+ (arg1 inst) (pc s))
+                (+ 1 (pc s)))
+              (locals s)
+              (pop (stack s))
+              (program s)))
+
+(defun do-inst (inst s)
+  (declare (xargs :guard (and (good-statep s)
+                              (equal inst (next-inst s)))))
+  (if (equal (op-code inst) 'ILOAD)
+      (execute-ILOAD  inst s)
+      (if (equal (op-code inst) 'ICONST)
+          (execute-ICONST  inst s)
+          (if (equal (op-code inst) 'IADD)
+              (execute-IADD   inst s)
+              (if (equal (op-code inst) 'ISUB)
+                  (execute-ISUB   inst s)
+                  (if (equal (op-code inst) 'IMUL)
+                      (execute-IMUL   inst s)
+                      (if (equal (op-code inst) 'ISTORE)
+                          (execute-ISTORE  inst s)
+                          (if (equal (op-code inst) 'GOTO)
+                              (execute-GOTO   inst s)
+                              (if (equal (op-code inst) 'IFEQ)
+                                  (execute-IFEQ   inst s)
+                                  s)))))))))
+
+; This is the single-step function: it executes the next instruction in a
+; state.  Aside: We will know, by guard verification, that the resulting state
+; is a good state.
+
+(defun step (s)
+     (declare (xargs :guard (good-statep s)))
+     (do-inst (next-inst s) s))
+
+(defun m1 (s n)
+  (declare (xargs :guard (and (good-statep s)
+                              (natp n))))
+  (if (zp n)
+      s
+      (m1 (step s) (- n 1))))
+
+(defun haltedp (s)
+  (declare (xargs :guard (good-statep s)))
+  (equal (next-inst s) '(HALT)))
+
+; That's all there is to M1.  The rest of this file sets up some stuff
+; we'll need to prove theorems about M1 programs.  But I recommend that
+; you play with M1 instead.  For example, write and run some M1 programs.
+; Challenge yourself.  Can you write a program to multiply two number togther
+; without using the IMUL instructions?  Can you write a program to sum the
+; naturals from n down to 0?  Can you write a program to divide one number by
+; another?
+
+; One way to test your programs is just to run the M1 model on sample data.
+; For example, here is a program to multiply the first two locals together,
+; without using IMUL.  Below I let the initial state, s_i, be a state that is
+; poised to multiply 7 times 9.  Then I let the final state, s_f, be the result
+; of running s_i for 82 steps.  Then I check that s_i and s_f are both good
+; states, that s_f is halted, and that 7*9 is on top of the stack in s_f.
+
+
+#||
+ (let* ((s_i (make-state 0              ; pc = 0 ;
+                         '(7 9 0)       ; locals x, y, and a ;
+                         nil            ; stack = nil ;
+                                       ; program: ;
+                                       ;  pc   pseudo-code ;
+                         '((ICONST 0)   ;   0 ;
+                           (ISTORE 2)   ;   1  a = 0; ;
+                           (ILOAD 0)    ;   2  [loop:] ;
+                           (IFEQ 10)    ;   3  if x=0 then go to end; ;
+                           (ILOAD 0)    ;   4 ;
+                           (ICONST 1)   ;   5 ;
+                           (ISUB)       ;   6 ;
+                           (ISTORE 0)   ;   7  x = x-1; ;
+                           (ILOAD 1)    ;   8 ;
+                           (ILOAD 2)    ;   9 ;
+                           (IADD)       ;  10 ;
+                           (ISTORE 2)   ;  11  a = y+a; ;
+                           (GOTO -10)   ;  12  go to loop ;
+                           (ILOAD 2)    ;  13  [end:] ;
+                           (HALT))))    ;  14  ``return'' a ;
+
+        (s_f (m1 s_i 82)))              ; run s_i 82 steps ;
+   (and (good-statep s_i)               ; check that both states good ;
+        (good-statep s_f)
+        (haltedp s_f)                   ; and that s_f is halted and ;
+        (equal (top (stack s_f)) (* 7 9)))) ; the answer is correct ;
+||#
+
+; If you start ACL2 and do (include-book "m1") and (in-package "M1"), and then
+; evaluate the above expression, the result is T.
+
+; =================================================================
+; Lemmas for Proving M1 Code
+
+; In order to prove that M1 bytecode program satisfy their functional
+; specifications we need some lemmas about the model.  Those lemmas
+; are stated and proved below.  But I do not recommend that you read them
+; now!
+
+(defthm top-push
+  (equal (top (push x y)) x))
+
+(defthm pop-push
+  (equal (pop (push x y)) y))
+
+(defun popn (n stk)
+  (if (zp n)
+      stk
+    (popn (- n 1) (pop stk))))
+
+(defmacro push* (&rest lst)
+  (if (endp lst)
+      nil
+      (if (endp (cdr lst))
+          (car lst)
+          `(push ,(car lst) (push* ,@(cdr lst))))))
+
+(defthm len-push
+  (equal (len (push x y))
+         (+ 1 (len y))))
+
+; Arithmetic
+
+(include-book "arithmetic-5/top" :dir :system)
+
+; Abstract Data Type Stuff
+
+(defthm constant-stacks
+  (and
+
+; These next two are needed because some push expressions evaluate to
+; list constants, e.g., (push 1 (push 2 nil)) becomes '(1 2) and '(1
+; 2) pattern-matches with (cons x s) but not with (push x s).
+
+       (equal (top (cons x s)) x)
+       (equal (pop (cons x s)) s))
+  :hints (("Goal" :in-theory (enable top pop))))
+
+
+(in-theory (disable push (:executable-counterpart push) top pop))
+
+(defthm access-make-state
+  (and (equal (pc (make-state pc locals stack program)) pc)
+       (equal (locals (make-state pc locals stack program)) locals)
+       (equal (stack (make-state pc locals stack program)) stack)
+       (equal (program (make-state pc locals stack program)) program))
+
+  :hints (("Goal" :in-theory (enable pc locals stack program))))
+
+(defthm constant-states
+  (and
+
+; And we add the rules to handle constant states:
+
+       (equal (pc (cons pc x)) pc)
+       (equal (locals (cons pc (cons locals x))) locals)
+       (equal (stack (cons pc (cons locals (cons stack x)))) stack)
+       (equal (program (cons pc (cons locals (cons stack (cons program x)))))
+              program))
+
+  :hints (("Goal" :in-theory (enable pc locals stack program))))
+
+(defthm len-make-state
+  (equal (len (make-state pc locals stack program))
+         4))
+
+(in-theory (disable make-state (:executable-counterpart make-state)))
+
+; Step Stuff
+
+(defthm step-opener
+  (implies (consp (next-inst s))
+           (equal (step s)
+                  (do-inst (next-inst s) s)))
+
+  :hints (("Goal" :in-theory (enable step))))
+
+(in-theory (disable step))
+
+; Clocks and Run
+
+(defun binary-clk+ (i j)
+  (+ (nfix i) (nfix j)))
+
+(defthm clk+-associative
+  (equal (binary-clk+ (binary-clk+ i j) k)
+         (binary-clk+ i (binary-clk+ j k))))
+
+(defmacro clk+ (&rest args)
+  (if (endp args)
+      0
+      (if (endp (cdr args))
+          (car args)
+          `(binary-clk+ ,(car args)
+                         (clk+ ,@(cdr args))))))
+
+(defthm m1-clk+
+  (equal (m1 s (clk+ i j))
+         (m1 (m1 s i) j)))
+
+(in-theory (disable binary-clk+))
+
+(defthm m1-opener
+  (and (equal (m1 s 0) s)
+       (implies (natp i)
+                (equal (m1 s (+ 1 i))
+                       (m1 (step s) i)))))
+
+(in-theory (disable m1))
+
+; Nth and update-nth
+
+(defthm nth-add1!
+  (implies (natp n)
+           (equal (nth (+ 1 n) list)
+                  (nth n (cdr list)))))
+
+; Rather than rely on the more powerful built-in rule:
+; (DEFTHM NTH-UPDATE-NTH
+;   (EQUAL (NTH M (UPDATE-NTH N VAL L))
+;          (IF (EQUAL (NFIX M) (NFIX N))
+;              VAL (NTH M L)))
+;   :HINTS (("Goal" :IN-THEORY (ENABLE NTH))))
+
+; We will rely on:
+
+(defthm nth-update-nth-natp-case
+  (implies (and (natp i) (natp j))
+           (equal (nth i (update-nth j v list))
+                  (if (equal i j)
+                      v
+                    (nth i list)))))
+
+(defthm update-nth-update-nth-1
+  (implies (and (natp i) (natp j) (not (equal i j)))
+           (equal (update-nth i v (update-nth j w list))
+                  (update-nth j w (update-nth i v list))))
+  :rule-classes ((:rewrite :loop-stopper ((i j update-nth)))))
+
+(defthm update-nth-update-nth-2
+  (equal (update-nth i v (update-nth i w list))
+         (update-nth i v list)))
+
+; Len and the Locals
+
+; In our code proofs we need this theorem to prove that certain initial states
+; satisfy the good-statep predicate.
+
+(defthm equal-len-0
+  (equal (equal (len x) 0)
+         (not (consp x))))
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/magic.lisp acl2-6.3/books/models/jvm/guard-verified-m1/magic.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/magic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/magic.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,213 @@
+; The Bogus Correctness of the Universal Function
+
+; Problem: Define an M1 program to ``compute'' any natural number k, in the
+; sense that there exists a clock that makes the program leave k on top of
+; the stack (but not necessarily terminate).
+
+; We then prove that this program is a bogusly correct way to compute the
+; factorial and the Fibonacci functions.
+
+; Design Plan: My bogusly correct universal function will just put 0 on the
+; stack and then repeatedly add one to it.  So if you inspect the machine at
+; just the right moment, you can see whatever natural number you want on top of
+; the stack.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (k)
+  (natp k))
+
+(defun theta (k)
+  k)
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (k a)
+  (if (zp k)
+      a
+      (helper (- k 1) (+ 1 a))))
+
+(defun fn (k) (helper k 0))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n m a), not just about the special case (helper n m 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs k)
+                (natp a))
+           (equal (helper k a)
+                  (+ a (theta k)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs k)
+           (equal (fn k)
+                  (theta k))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+       '((ICONST 0)   ; 0   tos=0;
+         (ICONST 1)   ; 1 loop:
+         (IADD)       ; 2   tos = tos+1;
+         (GOTO -2))   ; 3   goto loop;
+    )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (k)
+  (if (zp k)
+      0
+      (clk+ 3
+            (loop-clk (- k 1)))))
+
+(defun clk (k)
+  (if (zp k)
+      1
+      (clk+ 1
+            (loop-clk k))))
+
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (natp k)
+                (natp tos))
+           (equal (m1 (make-state 1
+                                  locals
+                                  (push tos nil)
+                                  *pi*)
+                      (loop-clk k))
+                  (make-state 1
+                              locals
+                              (push (helper k tos) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (natp k)
+           (equal (m1 (make-state 0
+                                  locals
+                                  nil
+                                  *pi*)
+                      (clk k))
+                  (make-state 1
+                              locals
+                              (push (fn k) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs k)
+           (equal (m1 (make-state 0
+                                  locals
+                                  nil
+                                  *pi*)
+                      (clk k))
+                  (make-state 1
+                              locals
+                              (push (theta k)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do.
+; The difference between bogus-correctness and total-correctness
+; is that we don't require (equal (next-inst sf) '(HALT)) below
+; in the conclusion.
+
+(defthm bogus-correctness
+  (implies (and (natp k)
+                (equal sf (m1 (make-state 0 locals nil *pi*)
+                              (clk k))))
+           (equal (top (stack sf)) k)))
+
+; Think of the above theorem as saying: for all natural numbers k, there exists
+; a clock (for example, the one constructed by (clk k)) such that running
+; *pi* with any input produces a state, sf, which contains k on top of the
+; stack.  Note that the algorithm used by *pi* is not specified or derivable
+; from this formula.
+
+; Consider any function that returns a natural number, e.g., fact or fib.  We
+; can prove that *pi* is a ``correct'' -- in this bogus sense -- for computing
+; them!
+
+(defun fact (n)
+  (if (zp n)
+      1
+      (* n (fact (- n 1)))))
+
+(defun fib (n)
+  (if (zp n)
+      0
+      (if (equal n 1)
+          1
+          (+ (fib (- n 1)) (fib (- n 2))))))
+
+(defun fact-clk (n)
+  (clk (fact n)))
+
+(defun fib-clk (n)
+  (clk (fib n)))
+
+(defthm pi-bogusly-computes-fact
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0 (list n) nil *pi*)
+                              (fact-clk n))))
+           (equal (top (stack sf)) (fact n))))
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (fact-clk n)) such that
+; running *pi* with (list n) as input produces a state, sf, which contains
+; (fact n) on top of the stack -- but isn't necessarily halted!  Note that the
+; algorithm used by *pi* is not specified or derivable from this formula.
+
+
+(defthm pi-bogusly-computes-fib
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0 (list n) nil *pi*)
+                              (fib-clk n))))
+           (equal (top (stack sf)) (fib n))))
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (fib-clk n)) such that
+; running *pi* with (list n) as input produces a state, sf, which contains (fib
+; n) on top of the stack -- but isn't necessarily halted!  Note that the
+; algorithm used by *pi* is not specified or derivable from this formula.
+
+
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/power.lisp acl2-6.3/books/models/jvm/guard-verified-m1/power.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/power.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/power.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,168 @@
+; Correctness of a Power of Two Program
+
+; Problem: Define an M1 program to compute 2^n (2 raised to the power n), for
+; any natural number n.  Do not use IMUL.
+
+; Design Plan:  I will initialize an accumulator to 1 and then repeatedly double it by
+; adding it to itself, n times.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun theta (n)
+  (expt 2 n))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n a)
+  (if (zp n)
+      a
+      (helper (- n 1) (+ a a))))
+
+(defun fn (n) (helper n 1))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n a), not just about the special case (helper n 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (helper n a)
+                  (* a (theta n)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((iconst 1)  ;  0
+    (istore 1)  ;  1
+    (iload 0)   ;  2
+    (ifeq 10)   ;  3
+    (iload 1)   ;  4
+    (iload 1)   ;  5
+    (iadd)      ;  6
+    (istore 1)  ;  7
+    (iload 0)   ;  8
+    (iconst 1)  ;  9
+    (isub)      ; 10
+    (istore 0)  ; 11
+    (goto -10)  ; 12
+    (iload 1)   ; 13
+    (halt))     ; 14
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (clk+ 11
+            (loop-clk (- n 1)))))
+
+(defun clk (n)
+  (clk+ 2
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n and a, you must characterize
+; its behavior for arbitrary, legal n and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (m1 (make-state 2
+                                  (list n a)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state 14
+                              (list 0 (helper n a))
+                              (push (helper n a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list 0 (fn n))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list 0 (theta n))
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (expt 2 n))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains (/ (* n (+ n 1)) 2) on top of the stack.  Note that the algorithm
+; used by *pi* is not specified or derivable from this formula.
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/script.lsp acl2-6.3/books/models/jvm/guard-verified-m1/script.lsp
--- acl2-6.2/books/models/jvm/guard-verified-m1/script.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/script.lsp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,110 @@
+; % (time acl2 < script.lsp) > script.log
+; or
+; acl2
+; ACL2 !>(ld "script.lsp" :ld-pre-eval-print t)
+
+; -----------------------------------------------------------------
+; Section 1:  The M1 Machine
+
+(certify-book "use-when")
+(u)
+
+(defpkg "M1"
+  (set-difference-eq (union-eq *acl2-exports*
+                               *common-lisp-symbols-from-main-lisp-package*)
+                     '(push pop pc program step)))
+
+(certify-book "good-statep" 1)
+(u)
+(u)
+
+(include-book "good-statep")
+(certify-book "m1" 1)
+(u)
+(u)
+
+(include-book "m1")
+(certify-book "verify-guards" 1)
+(u)
+(u)
+
+; -----------------------------------------------------------------
+; Section 2: Verifying Simple M1 Programs
+
+(include-book "m1")
+
+(certify-book "template" 1)
+(u)
+(certify-book "sum" 1)
+(u)
+(certify-book "sumsq" 1)
+(u)
+(certify-book "fact" 1)
+(u)
+(certify-book "power" 1)
+(u)
+(certify-book "expt" 1)
+(u)
+(certify-book "alternating-sum" 1)
+(u)
+(certify-book "alternating-sum-variant" 1)
+(u)
+(certify-book "fib" 1)
+(u)
+(certify-book "lessp" 1)
+(u)
+(certify-book "even-solution-1" 1)
+(u)
+(certify-book "even-solution-2" 1)
+(u)
+(certify-book "sign" 1)
+(u)
+(certify-book "div" 1)
+(u)
+(certify-book "bexpt" 1)
+(u)
+(certify-book "magic" 1)
+(u)
+(certify-book "funny-fact" 1)
+(u)
+(certify-book "wormhole-abstraction" 1)
+(u)
+(u)
+
+; -----------------------------------------------------------------
+; Section 3:  Turing Equivalence of M1
+
+(include-book "m1")
+(certify-book "tmi-reductions" 1)
+(u)
+(u)
+
+(include-book "m1")
+(certify-book "defsys-utilities" 1)
+(u)
+(u)
+
+(include-book "defsys-utilities")
+(certify-book "defsys" 1)
+(u)
+(u)
+
+(include-book "defsys")
+(certify-book "low-seven" 1) ; irrelevant to Turing Equivalence goal
+(u)
+(u)
+
+(include-book "tmi-reductions")
+(certify-book "implementation" 1)
+(u)
+(u)
+
+(include-book "m1")
+(certify-book "theorems-a-and-b" 1)
+(u)
+(u)
+
+(include-book "theorems-a-and-b")
+(certify-book "find-k!" 1)
+(u)
+(u)
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/sign.lisp acl2-6.3/books/models/jvm/guard-verified-m1/sign.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/sign.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/sign.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,234 @@
+; Correctness of Sign
+
+; Problem: Define an M1 program to determine the sign of an integer n.  You may
+; assume that n is an integer.  To indicate that n is negative, leave -1 on the
+; stack; to indicate that n is zero, leave 0 on the stack; to indicate that n
+; is positive, leave +1 on the stack.  Prove that your program is correct.
+
+; Design Plan: Since M1 can only test against 0, I have to terminate my program
+; by reaching 0.  I could do that by counting a positive n down or by counting
+; a negative n up.  But I don't know whether n is positive or negative.  So
+; I'll start with n and -n, one of which will be positive, and count both down
+; by 1.  One will reach 0 and the other will start negative and just stay
+; negative.  I'll know the sign of the original n by seeing which reaches 0.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (integerp n))
+
+(defun theta (n)
+  (if (< n 0)
+      -1
+      (if (equal n 0)
+          0
+          +1)))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n m)
+  (declare (xargs :measure (+ (nfix m) (nfix n))))
+  (if (and (integerp n)
+           (integerp m)
+           (or (natp n)
+               (natp m)))
+      (if (equal n 0)
+          (if (equal m 0)
+              0
+              +1)
+          (if (equal m 0)
+              -1
+              (helper (- n 1) (- m 1))))
+      'illegal))
+
+(defun fn (n) (helper n (* -1 n)))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n and m and fn calls helper initializing m to -n, your helper theorem must
+; be about (helper n m), not just about the special case (helper n (- n)).
+
+(defthm helper-is-theta
+  (implies (and (integerp n)
+                (integerp m)
+                (or (natp n) (natp m)))
+           (equal (helper n m)
+                  (if (and (natp n) (natp m))
+                      (if (< n m)
+                          +1
+                          (if (equal n m)
+                              0
+                              -1))
+                      (if (natp n)
+                          +1
+                          -1)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((ILOAD 0)   ;  0
+    (ICONST -1) ;  1
+    (IMUL)      ;  2
+    (ISTORE 1)  ;  3 n = -m;
+    (ILOAD 0)   ;  4
+    (IFEQ 12)   ;  5 if m=0, goto 17
+    (ILOAD 1)   ;  6
+    (IFEQ 16)   ;  7 if n=0, goto 23
+    (ILOAD 0)   ;  8 
+    (ICONST 1)  ;  9
+    (ISUB)      ; 10
+    (ISTORE 0)  ; 11 m = m-1;
+    (ILOAD 1)   ; 12
+    (ICONST 1)  ; 13
+    (ISUB)      ; 14
+    (ISTORE 1)  ; 15 n = n-1;
+    (GOTO -12)  ; 16 goto 4
+    (ILOAD 1)   ; 17
+    (IFEQ 3)    ; 18 if n=0, goto 21
+    (ICONST 1)  ; 19 answer: positive
+    (GOTO 4)    ; 20 goto 24
+    (ICONST 0)  ; 21 answer: zero
+    (GOTO 2)    ; 22 goto 24
+    (ICONST -1) ; 23 answer: negative
+    (HALT))     ; 24 halt
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n m)
+  (declare (xargs :measure (+ (nfix n) (nfix m))))
+  (cond ((and (integerp n)
+              (integerp m)
+              (or (natp n)
+                  (natp m)))
+         (cond ((equal n 0)
+                6)
+               ((equal m 0)
+                5)
+               (t (clk+ 13
+                        (loop-clk (- n 1) (- m 1))))))
+        (t nil)))
+
+(defun clk (n)
+  (clk+ 4
+        (loop-clk n (- n))))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n and m, you must characterize its
+; behavior for arbitrary, legal n and m, not just a special case (e.g., where n
+; is (- n)).
+
+(defthm loop-is-helper
+  (implies (and (integerp n)
+                (integerp m)
+                (or (natp n) (natp m)))
+           (equal (m1 (make-state 4
+                                  (list n m)
+                                  nil
+                                  *pi*)
+                      (loop-clk n m))
+                  (make-state 24
+                              (cond
+                               ((and (natp n) (natp m))
+                                (if (< n m)
+                                    (list 0 (- m n))
+                                    (list (- n m) 0)))
+                               ((natp n)
+                                (list 0 (- m n)))
+                               (t (list (- n m) 0)))
+                              (push (helper n m) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 24
+                              (if (natp n)
+                                  (list 0 (* -2 n))
+                                  (list (* 2 n) 0))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 24
+                              (if (natp n)
+                                  (list 0 (* -2 n))
+                                  (list (* 2 n) 0))
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (integerp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (if (< n 0)
+                           -1
+                           (if (equal n 0)
+                               0
+                               +1)))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all integers n, there exists a
+; clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains -1, 0, or +1 on top of the stack depending on whether x is negative,
+; 0, or positive.  Note that the algorithm used by *pi* is not specified or
+; derivable from this formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/sum.lisp acl2-6.3/books/models/jvm/guard-verified-m1/sum.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/sum.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/sum.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,169 @@
+; Correctness of Sum
+
+; Problem: Define an M1 program to sum the natural numbers from n down to 0.
+; You may assume n is a natural number.  Prove that the result (left on the
+; stack) is (/ (* n (+ n 1)) 2).
+
+; Design Plan: I will count n down to 0 by 1 and add each successive value to
+; an accumulator, a, initially 0.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun theta (n)
+  (/ (* n (+ n 1)) 2))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n a)
+  (if (zp n)
+      a
+      (helper (- n 1) (+ n a))))
+
+(defun fn (n) (helper n 0))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n a), not just about the special case (helper n 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (helper n a)
+                  (+ a (theta n)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((iconst 0)  ;  0
+    (istore 1)  ;  1
+    (iload 0)   ;  2
+    (ifeq 10)   ;  3
+    (iload 1)   ;  4
+    (iload 0)   ;  5
+    (iadd)      ;  6
+    (istore 1)  ;  7
+    (iload 0)   ;  8
+    (iconst 1)  ;  9
+    (isub)      ; 10
+    (istore 0)  ; 11
+    (goto -10)  ; 12
+    (iload 1)   ; 13
+    (halt))     ; 14
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (clk+ 11
+            (loop-clk (- n 1)))))
+
+(defun clk (n)
+  (clk+ 2
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n and a, you must characterize
+; its behavior for arbitrary, legal n and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (m1 (make-state 2
+                                  (list n a)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state 14
+                              (list 0 (helper n a))
+                              (push (helper n a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list 0 (fn n))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list 0 (theta n))
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (/ (* n (+ n 1)) 2))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains (/ (* n (+ n 1)) 2) on top of the stack.  Note that the algorithm
+; used by *pi* is not specified or derivable from this formula.
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/sumsq.lisp acl2-6.3/books/models/jvm/guard-verified-m1/sumsq.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/sumsq.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/sumsq.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,176 @@
+; Correctness of Sum of Squares
+
+; Problem: Define an M1 program to sum the squares of the natural numbers from
+; n down to 0.  You may assume n is a natural number.  Prove that the result
+; (left on the stack) is (+ (/ (expt n 3) 3) (/ (expt n 2) 2) (/ n 6)).
+
+; Design Plan: I will count n down to 0 by 1 and add the square of each
+; successive result to an accumulator, a, initially 0.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun theta (n)
+  (+ (/ (expt n 3) 3) (/ (expt n 2) 2) (/ n 6)))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n a)
+  (if (zp n)
+      a
+      (helper (- n 1) (+ (* n n) a))))
+
+(defun fn (n) (helper n 0))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n a), not just about the special case (helper n 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (helper n a)
+                  (+ a (theta n)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+  '((iconst 0)
+    (istore 1)
+    (iload 0)
+    (ifeq 12)
+    (iload 1)
+    (iload 0)
+    (iload 0)
+    (imul)
+    (iadd)
+    (istore 1)
+    (iload 0)
+    (iconst 1)
+    (isub)
+    (istore 0)
+    (goto -12)
+    (iload 1)
+    (halt))
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (clk+ 13
+            (loop-clk (- n 1)))))
+
+(defun clk (n)
+  (clk+ 2
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n and a, you must characterize
+; its behavior for arbitrary, legal n and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (m1 (make-state 2
+                                  (list n a)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state 16
+                              (list 0 (helper n a))
+                              (push (helper n a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 16
+                              (list 0 (fn n))
+                              (push (fn n) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n)
+           (equal (m1 (make-state 0
+                                  (list n)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 16
+                              (list 0 (theta n))
+                              (push (theta n)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (+ (/ (expt n 3) 3)
+                          (/ (expt n 2) 2)
+                          (/ n 6)))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n, there exists
+; a clock (for example, the one constructed by (clk n)) such that running
+; *pi* with (list n) as input produces a state, sf, that is halted and which
+; contains (+ (/ (expt n 3) 3) (/ (expt n 2) 2) (/ n 6)) on top of the stack.
+; Note that the algorithm used by *pi* is not specified or derivable from this
+; formula.
+
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/template.lisp acl2-6.3/books/models/jvm/guard-verified-m1/template.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/template.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/template.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,187 @@
+; Template for Proving Correctness of One-Loop M1 Programs
+
+; This ``template'' is filled in with the details of a particular challenge
+; problem given below.  But it is meant to be very generic, suitable for
+; virtually any single-loop M1 program.  Because of its generic nature, this
+; template contains some rather odd idioms.  For example, we define the input
+; conditions on the program to be (ok-inputs n m) where it would be more
+; natural to just say (natp n) and (natp m).  But by giving a name to the
+; conditions, we can use them later in the template without explanation.
+; Similarly, we define the desired output to be (theta n m) when, in this case,
+; that is just (* n m).  The desire to make this template generic gives it a
+; verbosity no single instance of it would have to have!  But it makes it
+; easier for students to verify single-loop programs by just filling in the
+; template.
+
+; Problem: Define an M1 program to compute some result theta, when certain
+; preconditions are met.  In this instance, the idea is to compute the product
+; of two natural numbers, n and m.
+
+; Design Plan: I will often informally describe the algorithm I intend to
+; implement, before defining and coding it.  In the case of the example
+; illustrating this template, namely multiplying n times m, my plan is to
+; add m into an accumulator, a, n times, by counting n down to 0 by 1.
+; The accumulator will be initialized to 0.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n m)
+  (and (natp n)
+       (natp m)))
+
+(defun theta (n m)
+  (* n m))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n m a)
+  (if (zp n)
+      a
+      (helper (- n 1) m (+ m a))))
+
+(defun fn (n m) (helper n m 0))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n, m, and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n m a), not just about the special case (helper n m 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n m)
+                (natp a))
+           (equal (helper n m a)
+                  (+ a (theta n m)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n m)
+           (equal (fn n m)
+                  (theta n m))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+
+(defconst *pi*
+       '((ICONST 0)   ; 0
+         (ISTORE 2)   ; 1  a = 0;
+         (ILOAD 0)    ; 2  [loop:]
+         (IFEQ 10)    ; 3  if x=0 then go to end;
+         (ILOAD 0)    ; 4
+         (ICONST 1)   ; 5
+         (ISUB)       ; 6
+         (ISTORE 0)   ; 7  x = x-1;
+         (ILOAD 1)    ; 8
+         (ILOAD 2)    ; 9
+         (IADD)       ;10
+         (ISTORE 2)   ;11  a = y+a;
+         (GOTO -10)   ;12  go to loop
+         (ILOAD 2)    ;13  [end:]
+         (HALT))      ;14 ``return'' a
+    )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (clk+ 11
+            (loop-clk (- n 1)))))
+
+(defun clk (n)
+  (clk+ 2
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n, m, and a, you must characterize
+; its behavior for arbitrary, legal n, m, and a, not just a special case (e.g.,
+; where a is 0).
+
+(defthm loop-is-helper
+  (implies (and (ok-inputs n m)
+                (natp a))
+           (equal (m1 (make-state 2
+                                  (list n m a)
+                                  nil
+                                  *pi*)
+                      (loop-clk n))
+                  (make-state 14
+                              (list 0 m (helper n m a))
+                              (push (helper n m a) nil)
+                              *pi*))))
+
+(in-theory (disable loop-clk))
+
+(defthm program-is-fn
+  (implies (ok-inputs n m)
+           (equal (m1 (make-state 0
+                                  (list n m)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list 0 m (fn n m))
+                              (push (fn n m) nil)
+                              *pi*))))
+
+(in-theory (disable clk))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+(defthm program-correct
+  (implies (ok-inputs n m)
+           (equal (m1 (make-state 0
+                                  (list n m)
+                                  nil
+                                  *pi*)
+                      (clk n))
+                  (make-state 14
+                              (list 0 m (theta n m))
+                              (push (theta n m)
+                                    nil)
+                              *pi*))))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (natp m)
+                (equal sf (m1 (make-state 0
+                                          (list n m)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf)) (* n m))))
+  :rule-classes nil)
+
+; Think of the above theorem as saying: for all natural numbers n and m, there
+; exists a clock (for example, the one constructed by (clk n)) such that
+; running *pi* with (list n m) as input produces a state, sf, that is halted
+; and which contains (* n m) on top of the stack.  Note that the algorithm
+; used by *pi* is not specified or derivable from this formula.
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/theorems-a-and-b.lisp acl2-6.3/books/models/jvm/guard-verified-m1/theorems-a-and-b.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/theorems-a-and-b.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/theorems-a-and-b.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,765 @@
+;(include-book "m1")
+;(certify-book "theorems-a-and-b" 1)
+(in-package "M1")
+
+(include-book "tmi-reductions")
+(include-book "implementation")
+
+; The tmi-reductions book contains a theorem establishing that the function
+; TMI, as defined in the Boyer-Moore paper, "A Mechanical Proof of the Turing
+; Completeness of Pure Lisp," is equivalent (modulo the representation of
+; tapes) to an algorithm named tmi3 implementable on M1.  The implementation
+; book defines an M1 program (PI) and various schedules and proves that (PI)
+; implements tmi3.
+
+; For what it's worth: proof-1 required 160 defthms.  This proof requires 138,
+; mainly because defsys handles almost all of the implementation.lisp proofs.
+; I also cleaned up the theorem A and B proofs a bit.
+
+; In the Boyer-Moore paper, "A Mechanical Proof of the Turing Completeness of
+; Pure Lisp" we prove two things: about a computational paradigm emulating a
+; Turing machine.
+
+; (a) If the Turing machine runs forever, then the emulator runs forever.
+; This theorem is stated in its contrapositive form:  if the emulator halts
+; then the Turing machine halts.
+
+; (b) If the Turing machine halts with tape tape, then the emulator halts with
+; the same tape (modulo representation).
+
+; Outline:
+
+; Both of these theorems depend on a stronger Simulation Theorem that precisely
+; relates running (PI) and TMI.  So our first goal below is to prove the
+; Simulation Theorem.  Theorem B follows immediately from the Simulation
+; Theorem.  Theorem A, however, requires a little more work: we have to define
+; a clock function that converts a schedule (under which the M1 emulator halts)
+; to a clock (under which TMI halts).  The definition of this conversion
+; function depends crucially on the Monotonicity property of the M1 schedule
+; function used in the Simulation Theorem: TMI doesn't halt, then the schedule
+; for n+1 steps is greater than the schedule for n steps.  Given Monotonicity,
+; we can find an appropriate clock by searching upwards for ever greater
+; clocks, knowing that the corresponding schedule gets longer and longer and
+; that eventually it will exceed the length of the schedule that makes M1 halt.
+
+; So our subgoals are: The Simulation Theorem, Monotonicity, Theorem A, and,
+; finally, Theorem B.
+
+; Convention on Clocks and Schedules
+
+; Both tmi and run are ``non-terminating'' interpreters that have had
+; artificial means imposed upon them to insure (abnormal) termination.  For tmi
+; the artificial means is a number that is decreased every time tmi recurs.
+; When abnormal termination occurs, tmi returns nil; normal termination is
+; indicated by returning the final tape, a cons.  We call the number
+; controlling tmi a ``clock.''
+
+; For M1's run the artificial means is a list that is cdr'd every time run
+; recurs.  Abnormal termination is indicated by returning an M1 state that is
+; not HALTed, by which we mean the next-inst in the returned state is something
+; other than a HALT instruction.  Normal termination is indicated by returning
+; a state in which the next instruction is HALT.  We call the list controlling
+; run a ``thread schedule'' (in preparation for the eventual addition of
+; threads to the model).  But because M1's run isn't sensitive to the ``thread
+; identifier'' listed in its schedule -- it always steps the only thread -- we
+; can convert an M1 schedule to a ``clock,'' a number that determines how long
+; the schedule is.  The typical idiom for applications of run will be (run
+; (repeat 'tick <clock>) s), where <clock> is a numeric expression.
+
+; Our two theorems, A and B involve clocks.  
+
+; A: If run halts normally in so many clock ticks, then there exists a clock
+; that makes tmi halt normally.
+
+; B: If tmi halts normally in so many clock ticks, then there exists a clock
+; that makes run halt normally and return the ``same'' tape.
+
+; We thus talk about 4 clocks and we adopt the following naming conventions, by
+; restating A and B in terms that explicitly identify the symbol we will use
+; for each clock:
+
+; A: If run halts normally in i clock ticks, then there exists a j
+; that makes tmi halt normally.
+
+; B: If tmi halts normally in n clock ticks, then there exists a k
+; that makes run halt normally and return the ``same'' tape.
+
+; Summarizing our clock naming conventions:
+; i -- the number of steps run takes to halt in the hypothesis of theorem A
+; j -- the number of steps tmi takes to halt in the conclusion of theorem A
+; n -- the number of steps tmi takes to halt in the hypothesis of theorem B
+; k -- the number of steps run takes to halt in the conclusion of theorem B
+
+; Note that j is actually a function of i:  given i, there exists a j.
+; Note that k is actually a function of n:  given n, there exists a k.
+
+; So while i and n are variable symbols, j and k are function symbols in our
+; quantifier-free setting.
+
+; The Simulation Theorem
+
+(defun psi-clock (st tape pos tm w nnil n)
+  (clk+ 2
+      (main-clock nil st tape pos tm w nnil n)))
+
+; Our goal is to express precisely the relationship between TMI and an m1 run of
+; the M1 system (PSI).  We take it in steps.  First, we express the relationship
+; between an m1 run of (PSI) and tmi3.  Then we move to TMI terms by applying the
+; functions that re-represent Turing machines and tapes. 
+
+(defthm tmi3-simulation
+  (implies (and (natp st)
+                (natp tape)
+                (natp pos)
+                (natp tm)
+                (natp w)
+                (equal nnil (nnil w))
+                (< st (expt 2 w)))
+           (equal
+            (m1 (make-state 0
+                             '(0 0 0 0 0 0 0 0 0 0 0 0 0)
+                             (push nnil
+                                   (push w
+                                         (push tm
+                                               (push pos (push tape (push st nil))))))
+                             (psi))
+                 (psi-clock st tape pos tm w nnil n))
+            
+            (let ((s (make-state
+                      *main*
+                      '(0 0 0 0 0 0 0 0 0 0 0 0 0)
+                      (push 2
+                            (push nnil
+                                  (push w
+                                        (push tm
+                                              (push pos (push tape (push st nil)))))))
+                      (psi))))
+              (if
+               (equal (mv-nth 0 (tmi3 st tape pos tm w n))
+                      0)
+               (make-state
+                *tmi3-loop*
+                (main-final-locals nil st tape pos tm w nnil n s)
+                (main-final-stack nil st tape pos tm w nnil n s)
+                (psi))
+               (make-state
+                2
+                (update-nth*
+                 0
+                 '(0 0 0 0 0 0)
+                 (main-final-locals nil st tape pos tm w nnil n s))
+                (push
+                 (mv-nth 3 (tmi3 st tape pos tm w n))
+                 (push
+                  (mv-nth 2 (tmi3 st tape pos tm w n))
+                  (push (mv-nth 1 (tmi3 st tape pos tm w n))
+                        (push (mv-nth 0 (tmi3 st tape pos tm w n))
+                              nil))))
+                (psi)))))))
+
+(in-theory (disable psi-clock))
+
+; I am not convinced the following theorem is sufficient for Theorem A.  But let's go with it
+; and see what happens.
+
+(defthm integerp-mv-nth-convert-tape-to-tapen-pos
+  (implies (tapep tape)
+           (and (integerp (mv-nth 0 (convert-tape-to-tapen-pos tape)))
+                (integerp (mv-nth 1 (convert-tape-to-tapen-pos tape)))))
+  :hints (("Goal" :in-theory (enable acl2::mv-nth convert-tape-to-tapen-pos tapep)))
+  :rule-classes :rewrite)  ;I'd settle for :tau-system if it were used in backchaining!
+
+(defthm nonneg-mv-nth-convert-tape-to-tapen-pos
+  (implies (tapep tape)
+           (and (<= 0 (mv-nth 0 (convert-tape-to-tapen-pos tape)))
+                (<= 0 (mv-nth 1 (convert-tape-to-tapen-pos tape)))))
+  :hints (("Goal" :in-theory (enable acl2::mv-nth convert-tape-to-tapen-pos tapep)))
+  :rule-classes :linear)
+
+(defthm positive-natp-ncode-rewrite-version
+  (implies (and (natp w)
+                (turing1-machinep tm w))
+           (and (integerp (ncode tm w))
+                (< 0 (ncode tm w)))))
+
+(in-theory (disable tmi2-is-tmi1 tmi3-is-tmi2 renaming-map properties-of-instr))
+
+; We disable the intermediate tmi theorems because they rewrite TMI3.  We
+; disable RENAMING-MAP otherwise (cdr (assoc st (renaming-map st tm))) becomes
+; 0 and doesn't allow the assoc expression in m1-psi-is-tmi below to match the
+; corresponding one in the theorem tmi3-is-tmi.  We disable properties-of-instr
+; because it (stupidly) FORCEs turing1-machinep when we need to stay at the
+; turing-machinep level.
+
+; We really ought to know these tau-like theorems:
+
+(defthm tapep-new-tape
+  (implies (and (tapep tape)
+                (operationp op))
+           (tapep (new-tape op tape)))
+  :hints (("Goal" :in-theory (enable tapep new-tape))))
+
+(defthm operationp-nth-2-instr
+  (implies (and (turing-machinep tm)
+                (instr st current-sym tm))
+           (operationp (nth 2 (instr st current-sym tm))))
+  :hints (("Goal" :in-theory (disable properties-of-instr)))) ; <--- forces turing1-machinep!
+
+(defthm symbolp-nth-3-instr
+  (implies (and (turing-machinep tm)
+                (instr st current-sym tm))
+           (symbolp (nth 3 (instr st current-sym tm)))))
+
+(defthm tapep-tmi
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm)
+                (tmi st tape tm n))
+           (tapep (tmi st tape tm n))))
+
+#|
+(defthm run-repeat
+  (equal (run (repeat 'tick (len sched)) s)
+         (run sched s))
+  :hints (("Goal" :in-theory (enable run))))
+|#
+
+(defun find-k (st tape tm n)
+  (let* ((map (renaming-map st tm))
+         (st-prime (cdr (assoc st map)))
+         (tape-prime (mv-nth 0 (mv-list 2 (convert-tape-to-tapen-pos tape))))
+         (pos-prime (mv-nth 1 (mv-list 2 (convert-tape-to-tapen-pos tape))))
+         (w (max-width tm map))
+         (tm-prime (ncode (tm-to-tm1 tm map) w)))
+    (psi-clock st-prime tape-prime pos-prime tm-prime w (nnil w) n)))
+
+(defthm simulation
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm))
+           (let* ((map (renaming-map st tm))
+                  (st-prime (cdr (assoc st map)))
+                  (tape-prime (mv-nth 0 (convert-tape-to-tapen-pos tape)))
+                  (pos-prime (mv-nth 1 (convert-tape-to-tapen-pos tape)))
+                  (w (max-width1 (tm-to-tm1 tm map)))
+                  (nnil (nnil w))
+                  (tm-prime (ncode (tm-to-tm1 tm map) w))
+                  (s-final 
+                   (m1 (make-state 0
+                                    '(0 0 0 0 0 0 0 0 0 0 0 0 0)
+                                    (push nnil
+                                          (push w
+                                                (push tm-prime
+                                                      (push pos-prime
+                                                            (push tape-prime
+                                                                  (push st-prime nil))))))
+                                    (psi))
+                        (find-k st tape tm n))))
+             (and (iff (equal (next-inst s-final) '(HALT))
+                       (tmi st tape tm n))
+                  (implies (tmi st tape tm n)
+                           (equal (decode-tape-and-pos
+                                   (top (pop (stack s-final)))
+                                   (top (stack s-final)))
+                                  (tmi st tape tm n))))))
+  :hints (("Goal" :do-not-induct t)))
+
+(in-theory (disable find-k next-inst))
+
+(defun ncode-st (st map)
+  (cdr (assoc st map)))
+
+(defun ncode-tm (tm map w)
+  (ncode (tm-to-tm1 tm map) w))
+
+(defun ncode-tape (tape)
+  (mv-let (tapen pos)
+          (convert-tape-to-tapen-pos tape)
+          (declare (ignore pos))
+          tapen))
+
+(defun ncode-pos (tape)
+  (mv-let (tapen pos)
+          (convert-tape-to-tapen-pos tape)
+          (declare (ignore tapen))
+          pos))
+          
+(defmacro with-conventions (term)
+  `(let* ((map (renaming-map st tm))
+          (w (max-width tm map))
+          (nnil (nnil w))
+          (st^prime (ncode-st st map))
+          (tm^prime (ncode-tm tm map w))
+          (tape^prime (ncode-tape tape))
+          (pos^prime (ncode-pos tape))
+          (s_0 (make-state 0
+                           '(0 0 0 0 0 0 0 0 0 0 0 0 0)
+                           (push* nnil w tm^prime pos^prime tape^prime st^prime nil)
+                           (Psi))))
+     (implies (and (symbolp st) (tapep tape) (turing-machinep tm))
+              ,term)))
+
+
+(defthm theorem-b
+  (with-conventions
+   (implies (and (natp n)
+                 (tmi st tape tm n))
+            (let ((s_f (M1 s_0 (find-k st tape tm n))))
+              (and (haltedp s_f)
+                   (equal (decode-tape-and-pos
+                           (top (pop (stack s_f)))
+                           (top (stack s_f)))
+                          (tmi st tape tm n)))))))
+
+; Now we turn to Theorem A.  Recall that here we have a clock i at which m1
+; halts normally and wish to exhibit a j at which tmi halts normally.  We find
+; j by searching up from 0.  For each value of j, see if tmi halts normally.
+; If not, increment j by 1 and repeat.  Why does this search terminate?
+; Consider (find-k ... j), i.e., the clock for m1 corresponding to the current j.
+; We know by the Simulation theorem tmi halts (or not) at j iff m1 halts at (find-k
+; ... j).  So if tmi is not halted at j, then m1 is not halted at (find-k ...j).
+; But eventually, (find-k ...j) exceeds i, the time at which m1 does halt.  Why do
+; we know (find-k ...j) will eventually exceed i?  Because k is monotonic: as j
+; increases, k increases, provided tmi has not halted.  Note that we are also
+; relying on the fact that once m1 halts normally it stays halted, i.e., if
+; m1 is halted at i then it is halted at k if i <= k.  So we can bound the
+; search for j by looking until i <= (find-k ...j).
+; 
+
+; So we prove Monotonicity next, then prove that m1 stays halted, then define
+; the search mechanism for j, and then prove theorem a.
+
+#|
+(defthm len-repeat
+  (equal (len (repeat x n))
+         (nfix n)))
+|#
+
+(in-theory (enable binary-clk+))
+
+(defthm k-non-0
+  (implies (and (natp st)
+                (natp tape)
+                (natp pos)
+                (natp tm)
+                (natp w)
+                (not (zp n)))
+           (< 0 (find-k st tape tm n)))
+  :hints (("Goal" :in-theory (enable find-k psi-clock)))
+  :rule-classes :linear)
+
+; The first problem with monotonicity is that at the level of k it is about
+; main-clock, main-loop-clock, tmi3-clock, and tmi3-loop-clock.  But all the
+; action is happening at tmi3-loop-clock, where the computation actually hangs.
+; So I first prove that tmi3-loop-clock is monotonic and then raise that result
+; up through the others.
+
+
+(defun tmi3-trace (st tape pos tm w n)
+  (declare (xargs :measure (acl2-count n)))
+  (cond ((zp n)
+         nil)
+        ((equal (ninstr st (current-symn tape pos) tm w) -1)
+         (list (list t st tape pos)))
+        (t
+         (cons (list nil st tape pos)
+               (mv-let (new-tape new-pos)
+                       (new-tape2 (nop (ninstr st (current-symn tape pos) tm w) w) tape pos)
+                       (tmi3-trace (nst-out (ninstr st (current-symn tape pos) tm w) w)
+                                   new-tape
+                                   new-pos
+                                   tm
+                                   w
+                                   (- n 1)))))))
+
+(defun k-halt (st tape pos tm w)
+  (CLK+ 5
+        (CLK+ (CURRENT-SYMN-CLOCK '(1 0 0 14)
+                                  TAPE POS)
+              (CLK+ 5
+                    (CLK+ (NINSTR1-CLOCK '(0 0 14)
+                                         ST (!CURRENT-SYMN TAPE POS)
+                                         TM W (NNIL w))
+                          7)))))
+(defun k-step (st tape pos tm w)
+  (CLK+
+   5
+   (CLK+
+    (CURRENT-SYMN-CLOCK '(1 0 0 14)
+                        TAPE POS)
+    (CLK+
+     5
+     (CLK+
+      (NINSTR1-CLOCK '(0 0 14)
+                     ST (!CURRENT-SYMN TAPE POS)
+                     TM W (NNIL W))
+      (CLK+
+       8
+       (CLK+
+        (CURRENT-SYMN-CLOCK '(1 0 0 2 14)
+                            TAPE POS)
+        (CLK+
+         5
+         (CLK+
+          (NINSTR1-CLOCK '(0 0 2 14)
+                         ST (!CURRENT-SYMN TAPE POS)
+                         TM W (NNIL W))
+          (CLK+
+           3
+           (CLK+
+            (NST-OUT-CLOCK
+             '(0 2 14)
+             (!NINSTR1 ST (!CURRENT-SYMN TAPE POS)
+                       TM W (NNIL W))
+             W)
+            (CLK+
+             5
+             (CLK+
+              (CURRENT-SYMN-CLOCK '(1 0 0 1 2 14)
+                                  TAPE POS)
+              (CLK+
+               5
+               (CLK+
+                (NINSTR1-CLOCK '(0 0 1 2 14)
+                               ST (!CURRENT-SYMN TAPE POS)
+                               TM W (NNIL W))
+                (CLK+
+                 3
+                 (CLK+
+                  (NOP-CLOCK
+                   '(0 1 2 14)
+                   (!NINSTR1 ST (!CURRENT-SYMN TAPE POS)
+                             TM W (NNIL W))
+                   W)
+                  (CLK+
+                   4
+                   (CLK+
+                    (NEW-TAPE2-CLOCK
+                     '(1 2 14)
+                     (!NOP
+                      (!NINSTR1 ST (!CURRENT-SYMN TAPE POS)
+                                TM W (NNIL W))
+                      W)
+                     TAPE POS) 
+                    10)))))))))))))))))))
+
+(defun k* (trace tm w)
+  (if (endp trace)
+      0
+      (if (car (car trace))
+          (k-halt (nth 1 (car trace))
+                  (nth 2 (car trace))
+                  (nth 3 (car trace))
+                  tm w)
+          (+ (k-step (nth 1 (car trace))
+                     (nth 2 (car trace))
+                     (nth 3 (car trace))
+                     tm w)
+             (k* (cdr trace) tm w)))))
+
+(defthm tmi3-loop-clock-is-k*
+  (implies (and (natp st)
+                (natp tape)
+                (natp pos)
+                (natp tm)
+                (natp w)
+                (< st (expt 2 w)))
+           (equal (tmi3-loop-clock st tape pos tm w (nnil w) n)
+                  (k* (tmi3-trace st tape pos tm w n) tm w)))
+  :hints (("Goal" :in-theory (enable tmi3-loop-clock))
+          ("Subgoal *1/10'" :expand (TMI3-LOOP-CLOCK ST TAPE POS TM W (NNIL W) N))))
+
+(defthm positive-k-halt
+  (and (integerp (k-halt st tape pos tm w))
+       (< 0 (k-halt st tape pos tm w)))
+  :rule-classes :type-prescription)
+
+(defthm positive-k-step
+  (and (integerp (k-step st tape pos tm w))
+       (< 0 (k-step st tape pos tm w)))
+  :rule-classes :type-prescription)
+
+(in-theory (disable k-halt k-step))
+
+(defthm positive-k*
+  (implies (consp x)
+           (< 0 (k* x tm w)))
+  :rule-classes :linear)
+
+; -----------------------------------------------------------------
+
+(defthm trace-extension
+  (implies (and (natp n)
+                (equal (mv-nth 0 (tmi3 st tape pos tm w n)) 0))
+           (equal (tmi3-trace st tape pos tm w (+ 1 n))
+                  (append (tmi3-trace st tape pos tm w n)
+                      (mv-let (flg st1 tape1 pos1)
+                              (tmi3 st tape pos tm w n)
+                              (declare (ignore flg))
+                              (list (list (EQUAL (NINSTR ST1 (CURRENT-SYMN tape1 pos1) TM W)
+                                                 -1)
+                                          st1 tape1 pos1)))))))
+
+
+(defun tracep (x)
+  (cond ((endp x) t)
+        ((car (car x)) (endp (cdr x)))
+        (t (tracep (cdr x)))))
+
+(defthm tracep-tmi3-trace
+  (tracep (tmi3-trace st tape pos tm w n)))
+
+(defthm k*-append
+  (implies (tracep (append a b))
+           (equal (k* (append a b) tm w)
+                  (+ (k* a tm w) (k* b tm w)))))
+
+(defthm tracep-append
+  (equal (tracep (append a b))
+         (if (tracep a)
+             (if (car (car (last a)))
+                 (endp b)
+                 (tracep b))
+             nil)))
+
+(defthm tmi3-v-last-tmi3-trace
+  (implies (and (integerp n)
+                (<= 0 n)
+                (force (equal 0 (mv-nth 0 (tmi3 st tape pos tm w n)))))
+           (not (car (car (last (tmi3-trace st tape pos tm w n))))))
+  :hints (("Goal" :in-theory (enable tmi3))))
+
+(defthm k*-tmi3-trace-monotonic
+  (implies (and (natp n)
+                (equal (mv-nth 0 (tmi3 st tape pos tm w n))
+                       0))
+           (< (k* (tmi3-trace st tape pos tm w n) tm w)
+              (k* (tmi3-trace st tape pos tm w (+ n 1)) tm w)))
+  :rule-classes :linear)
+
+(defthm final-tmi3-state-is-proper
+  (implies (and (natp st)
+                (natp tape)
+                (natp pos)
+                (natp tm)
+                (natp w)
+                (< st (expt 2 w)))
+           (and (natp (mv-nth 1 (tmi3 st tape pos tm w n)))
+                (< (mv-nth 1 (tmi3 st tape pos tm w n)) (expt 2 w))))
+  :rule-classes
+  ((:linear :corollary
+            (implies (and (natp st)
+                          (natp tape)
+                          (natp pos)
+                          (natp tm)
+                          (natp w)
+                          (< st (expt 2 w)))
+                     (and (<= 0 (mv-nth 1 (tmi3 st tape pos tm w n)))
+                          (< (mv-nth 1 (tmi3 st tape pos tm w n)) (expt 2 w)))))
+   (:rewrite
+    :corollary
+    (implies (and (natp st)
+                  (natp tape)
+                  (natp pos)
+                  (natp tm)
+                  (natp w)
+                  (< st (expt 2 w)))
+             (integerp (mv-nth 1 (tmi3 st tape pos tm w n)))))))
+
+(defthm acl2-numberp-cdr-assoc-equal-st-renaming-map-st
+  (acl2-numberp (CDR (ASSOC-EQUAL ST (RENAMING-MAP ST TM))))
+  :hints (("Goal" :in-theory (enable renaming-map))))
+
+(defthm find-k-monotonic
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm)
+                (natp n)
+                (force (not (tmi st tape tm n))))
+           (< (find-k st tape tm n)
+              (find-k st tape tm (+ 1 n))))
+  :hints (("Goal" :do-not-induct t
+                  :in-theory (e/d (find-k psi-clock main-clock main-loop-clock tmi3-clock)
+                                  (turing1-4-tuple)
+                                  )))
+  :rule-classes :linear)
+
+(defthm 0<-find-k  
+  (< 0 (find-k st tape tm n))
+  :hints (("Goal" :in-theory (enable find-k psi-clock))))
+
+(defun find-j1 (st tape tm i j)
+
+  (declare (xargs :measure (nfix (- (+ 1 (nfix i))
+                                    (find-k st tape tm j)))
+                  :otf-flg t))
+  (if (and (symbolp st)
+           (tapep tape)
+           (turing-machinep tm)
+           (natp i)
+           (natp j))
+      (if (equal (tmi st tape tm j) nil)
+          (if (<= i (find-k st tape tm j))
+              j
+              (find-j1 st tape tm i (+ 1 j)))
+          j)
+      0))
+
+(defun find-j (st tape tm i)
+  (find-j1 st tape tm i 0))
+
+; The crucial property of find-j1 is that it either returns a j
+; that makes tmi halt or else an j whose k is greater than i.
+
+(defthm crucial-property-of-find-j1
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm)
+                (natp i)
+                (natp j))
+           (or (tmi st tape tm (find-j1 st tape tm i j))
+               (<= i (find-k st tape tm
+                             (find-j1 st tape tm i j)))))
+  :rule-classes nil)
+
+; Now we work on the M1 Stays Halted theorem.
+
+(defthm program-step
+  (equal (program (step s))
+         (program s))
+  :hints (("Goal" :in-theory (enable step))))
+
+(defthm program-m1
+  (equal (program (m1 s a))
+         (program s))
+  :hints (("Goal" :in-theory (enable m1))))
+
+(defthm m1-stays-halted
+  (implies (equal (next-inst s) '(HALT))
+           (equal (m1 s clock) s))
+  :hints (("Goal" :induct (m1 s clock)
+           :in-theory (enable m1 step))))
+
+;(defun run-repeat-hint (k s)
+;  (if (zp k)
+;      s
+;      (run-repeat-hint (- k 1) (step s))))
+
+(defthm m1-stays-halted-clk+-version
+  (implies (equal (next-inst (m1 s a)) '(HALT))
+           (equal (m1 s (clk+ a b))
+                  (m1 s a)))
+  :hints (("Goal" :in-theory (disable binary-clk+))))
+
+#|
+(defthm ap-repeat
+  (implies (and (natp i)
+                (natp j))
+           (equal (clk+ (repeat 'tick i)
+                      (repeat 'tick j))
+                  (repeat 'tick (+ i j)))))
+|#
+
+(defthm m1-stays-halted-repeat-version
+  (implies (and (<= i k)
+                (natp i)
+                (natp k)
+                (equal (next-inst (m1 s i)) '(HALT)))
+           (equal (m1 s k)
+                  (m1 s i)))
+  :hints (("Goal" :use (:instance m1-stays-halted-clk+-version
+                                  (a i)
+                                  (b (- k i)))
+           :do-not-induct t
+           :in-theory (disable m1-clk+ m1-stays-halted-clk+-version)))
+  :rule-classes nil)
+
+(in-theory (disable find-j1))
+
+(defthm theorem-a
+  (with-conventions
+   (implies (natp i)
+            (let ((s_f (m1 s_0 i)))
+              (implies
+               (haltedp s_f)
+               (tmi st tape tm (find-j st tape tm i))))))
+
+; Proof: Let s-init be the initial M1 state above.  (m1
+; s-init i) terminates.  find-j1 marches up from 0 looking for a j that makes tmi
+; halt.  If it finds it we're done.  Otherwise, it eventually finds a j such
+; tmi doesn't halt but (find-k .... j) exceeds i.  That's a contradiction because if
+; tmi doesn't halt at j then M1 doesn't halt at (find-k ... j), by the Simulation
+; theorem and the fact that M1 stays halted.  Q.E.D.
+
+  :hints (("Goal" :do-not-induct t
+           :use ((:instance crucial-property-of-find-j1 (j 0))
+                 (:instance m1-stays-halted-repeat-version
+                            (i i)
+                            (k (find-k st tape tm (find-j1 st tape tm i 0)))
+                            (s (MAKE-STATE
+                                0 '(0 0 0 0 0 0 0 0 0 0 0 0 0)
+                                (PUSH
+                                 (NNIL (MAX-WIDTH TM (RENAMING-MAP ST TM)))
+                                 (PUSH
+                                  (MAX-WIDTH TM (RENAMING-MAP ST TM))
+                                  (PUSH
+                                   (NCODE (TM-TO-TM1 TM (RENAMING-MAP ST TM))
+                                          (MAX-WIDTH TM (RENAMING-MAP ST TM)))
+                                   (PUSH (ACL2::MV-NTH 1 (CONVERT-TAPE-TO-TAPEN-POS TAPE))
+                                         (PUSH (ACL2::MV-NTH 0 (CONVERT-TAPE-TO-TAPEN-POS TAPE))
+                                               (PUSH (CDR (ACL2::ASSOC-EQUAL ST (RENAMING-MAP ST TM)))
+                                                     NIL))))))
+                                (PSI))))))))
+
+; Revision
+
+
+(defun down (st tape tm)
+; Down is a computable function.
+  (let* ((map (renaming-map st tm))
+         (st-prime (cdr (assoc st map)))
+         (tape-prime (mv-nth 0 (mv-list 2 (convert-tape-to-tapen-pos tape))))
+         (pos-prime (mv-nth 1 (mv-list 2 (convert-tape-to-tapen-pos tape))))
+         (w (max-width tm map))
+         (nnil (nnil w))
+         (tm-prime (ncode (tm-to-tm1 tm map) w)))
+    (make-state 0
+                '(0 0 0 0 0 0 0 0 0 0 0 0 0)
+                (push nnil
+                      (push w
+                            (push tm-prime
+                                  (push pos-prime
+                                        (push tape-prime
+                                              (push st-prime nil))))))
+                (psi))))
+
+(defun up (s)
+  (DECODE-TAPE-AND-POS (TOP (POP (STACK s)))
+                       (TOP (STACK s))))
+
+(defthm a
+  (implies
+   (and (symbolp st)
+        (tapep tape)
+        (turing-machinep tm)
+        (natp i))
+   (let ((s_f (m1 (down st tape tm) i)))
+     (implies (haltedp s_f)
+              (tmi st tape tm (find-j st tape tm i)))))
+  :hints (("Goal" :use theorem-a :in-theory (disable theorem-a) :do-not-induct t))
+  :rule-classes nil)
+
+(defthm b
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm)
+                (tmi st tape tm n))
+           (let ((s_f (m1 (down st tape tm)
+                          (find-k st tape tm n))))
+             (and (haltedp s_f)
+                  (equal (up s_f)
+                         (tmi st tape tm n)))))
+  :rule-classes nil)
+
+
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/tmi-reductions.lisp acl2-6.3/books/models/jvm/guard-verified-m1/tmi-reductions.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/tmi-reductions.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/tmi-reductions.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,1577 @@
+; Reduction of TMI to an Algorithm to be Implemented on M1 
+; J Strother Moore
+; April 10, 2012
+
+; (ld '((include-book "../m1/m1") . "tmi-reductions.lisp") :ld-pre-eval-print t)
+
+; Certification instructions:
+; cd /u/moore/courses/cs378/jvm/spring-12/equivalence/
+; acl2h536t
+; (include-book "../m1/m1-lemmas")
+; (time$ (with-output :off :all (certify-book "tmi-reductions" 1)))
+
+; Timing on Whitehart
+; 190.28 seconds realtime, 184.22 seconds runtime
+
+; Some comments below could be wrong... All of them need to be read carefully
+; in light of what is now in the file.
+
+; ---
+; The proof is really messy toward the end.  Start with theorem-b-raw and work
+; forward.  The hack lemmas and hints are depressing and probably fragile.
+; Try to get rewrite rules to do the work.
+
+; Notes: This file was tmi5.lisp before being completed.  Here are my
+; frequently used build commands.
+
+; (ld "tmi5.lisp" :ld-pre-eval-print t)
+; (acl2::with-output :off :all (ld "tmi5.lisp" :ld-pre-eval-print nil))
+
+; See improved-assembler.lisp for some random thoughts followed by a suggestion
+; for a better assembly langugage.  If you implement it, redo all of the M1
+; proofs!
+
+; Some problems were discovered in the arithmetic library.
+
+; Tell Robert that (set-default-arithmetic-theory) doesn't do the job advertised in
+; the README.  If you 
+; (include-book "arithmetic-5/top" :dir :system)
+; (defun log2 (n)
+;   (cond ((zp n) 0)
+;         ((equal n 1) 0)
+;         (t (+ 1 (log2 (floor n 2))))))
+; the defun of log2 works.  But if you (set-default-arithmetic-theory) before the
+; defun, it does not.  I want to be able to switch back and forth between
+; minimal-arithmetic-theory and the default and cannot.
+
+; Tell Robert about not-equal-ncons-nnil below!
+
+(in-package "M1")
+
+;(set-gag-mode :goals)
+(set-irrelevant-formals-ok t)
+(set-ignore-ok :warn)
+
+(defun rev (x)
+  (if (endp x)
+      nil
+      (append (rev (cdr x))
+              (list (car x)))))
+
+(defun rev1 (x a)
+  (if (endp x)
+      a
+      (rev1 (cdr x) (cons (car x) a))))
+
+(defun symp (x)
+  (member x '(0 1)))
+
+(defun sym (x)
+  (if (consp x) (car x) 0))
+
+(defun half-tape (x)
+  (if (endp x)
+      (equal x nil)
+      (and (symp (car x))
+           (half-tape (cdr x)))))
+
+(defun tapep (x)
+  (and (consp x)
+       (half-tape (car x))
+       (half-tape (cdr x))))
+
+(defun show-tape (tape)
+  (cond ((consp tape)
+         (rev1 (car tape)
+               (cons '[ (cons (sym (cdr tape)) (cons '] (cdr (cdr tape)))))))
+        (t nil)))
+
+(defun current-sym (tape) (sym (cdr tape)))
+
+(defun operationp (x)
+  (member x '(L R 0 1)))
+
+(defun state-namep (x)
+  (symbolp x))
+
+(defun turing-4-tuple (x)
+  (and (true-listp x)
+       (equal (len x) 4)
+       (state-namep (nth 0 x))
+       (symp (nth 1 x))
+       (operationp (nth 2 x))
+       (state-namep (nth 3 x))))
+
+(defun turing-machinep (x)
+  (if (endp x)
+      (equal x nil)
+      (and (turing-4-tuple (car x))
+           (turing-machinep (cdr x)))))
+
+(defun instr (st sym tm)
+
+; This function retrieves the first 4-tuple in Turing machine tm with
+; state-name st and symbol sym, if any.  If no such tuple exists, it returns
+; nil.
+
+  (if (endp tm)
+      nil
+      (if (and (equal st (nth 0 (car tm)))
+               (equal sym (nth 1 (car tm))))
+          (car tm)
+          (instr st sym (cdr tm)))))
+
+(defun new-tape (op tape)
+
+; Returns a new tape by carrying out operation op on tape.
+
+  (case op
+    (L (cons (cdr (car tape))
+             (cons (sym (car tape))
+                   (cdr tape))))
+    (R (cons (cons (sym (cdr tape))
+                   (car tape))
+             (cdr (cdr tape))))
+    (otherwise
+     (cons (car tape)
+           (cons op (cdr (cdr tape)))))))
+
+(defun test-tape (ops tape)
+  (cond ((endp ops) (list (show-tape tape)))
+        (t (cons (show-tape tape)
+                 (test-tape (cdr ops)
+                            (new-tape (car ops) tape))))))
+
+(defthm test-tape-demo
+  (equal (test-tape '(L L L 1 R R R R R R 1 L L L) '(nil . nil))
+         '(([ 0 ])
+           ([ 0 ])
+           ([ 0 ] 0)
+           ([ 0 ] 0 0)
+           ([ 1 ] 0 0)
+           (1 [ 0 ] 0)
+           (1 0 [ 0 ])
+           (1 0 0 [ 0 ])
+           (1 0 0 0 [ 0 ])
+           (1 0 0 0 0 [ 0 ])
+           (1 0 0 0 0 0 [ 0 ])
+           (1 0 0 0 0 0 [ 1 ])
+           (1 0 0 0 0 [ 0 ] 1)
+           (1 0 0 0 [ 0 ] 0 1)
+           (1 0 0 [ 0 ] 0 0 1)))
+  :rule-classes nil)
+
+(defun tmi (st tape tm n)
+  (declare (xargs :measure (nfix n)))
+  (cond ((zp n) nil)
+        ((instr st (current-sym tape) tm)
+         (tmi (nth 3 (instr st (current-sym tape) tm))
+              (new-tape (nth 2 (instr st (current-sym tape) tm)) tape)
+              tm
+              (- n 1)))
+        (t tape)))
+
+(defconst *rogers-program*
+  '((Q0 1 0 Q1)
+    (Q1 0 R Q2)
+    (Q2 1 0 Q3)
+    (Q3 0 R Q4)
+    (Q4 1 R Q4)
+    (Q4 0 R Q5)
+    (Q5 1 R Q5)
+    (Q5 0 1 Q6)
+    (Q6 1 R Q6)
+    (Q6 0 1 Q7)
+    (Q7 1 L Q7)
+    (Q7 0 L Q8)
+    (Q8 1 L Q1)
+    (Q1 1 L Q1)))
+
+(defconst *example-tape*
+  '(nil . (1 1 1 1 1)))
+
+(defthm rogers-program-demo
+  (let ((tape *example-tape*))
+    (and (equal (show-tape tape) '([ 1 ] 1 1 1 1))
+         (equal (show-tape (tmi 'Q0 tape *rogers-program* 77))
+                nil)
+         (equal (show-tape (tmi 'Q0 tape *rogers-program* 78))
+                '(0 0 0 0 [ 0 ] 0 1 1 1 1 1 1 1 1))))
+  :rule-classes nil)
+
+
+; My plan is to implement a Turing machine interpreter on M1 by representing a
+; tape as a natural number whose bits correspond to the 0s and 1s on the tape.
+; Similarly, I will transform the Turing machine program into a natural number
+; that can be unpacked by M1 into the ``same'' 4-tuples.  However, the presence
+; of the symbols in the definition of Turing machines prevents us from direct
+; numeric translation.  So step 1 is to convert our Turing machine program into
+; something involving only 4-tuples of numbers.  We'll rename the states to be
+; the consecutive natural numbers and we'll represent op=L with 2 and op=R with
+; 3, so legal ops in the new representation will be 0, 1, 2, 3.  We'll define
+; tmi1 to operate on these programs and prove that it is equivalent to tmi.
+
+; Step 2 will introduce tmi2, in which the Turing machine program is a single
+; big number.  We'll prove tmi1 equivalent to tmi2.
+
+; Step 3 will introduce tmi3, in which the tape is a big number.  We'll prove
+; tmi2 equivalent to tmi3.
+
+; Step 4 will define m1-tmi which is the algorithm we'll implement on M1.  We
+; will prove tmi equivalent to m1-tmi.  Thus, it will remain only to prove the
+; M1 code correct.
+
+(defun renaming-map2 (st i map)
+  (cond ((assoc st map)
+         (mv i map))
+        (t (mv (+ i 1)
+               (cons (cons st i) map)))))
+
+(defun renaming-map1 (tm i map)
+  (cond ((endp tm) map)
+        (t (let ((st-in   (nth 0 (car tm)))
+                 (st-out  (nth 3 (car tm))))
+             (mv-let (i map)
+                     (renaming-map2 st-in i map)
+                     (mv-let (i map)
+                             (renaming-map2 st-out i map)
+                             (renaming-map1 (cdr tm) i map)))))))
+
+(defun renaming-map (st tm)
+  (mv-let (i map)
+          (renaming-map2 st 0 nil)
+          (renaming-map1 tm i map)))
+
+(defun tm-to-tm1 (tm map)
+  (cond ((endp tm) nil)
+        (t (let ((st-in  (nth 0 (car tm)))
+                 (sym    (nth 1 (car tm)))
+                 (op     (nth 2 (car tm)))
+                 (st-out (nth 3 (car tm))))
+             (cons (list (cdr (assoc st-in map))
+                         sym
+                         (case op (L 2) (R 3) (otherwise op))
+                         (cdr (assoc st-out map)))
+                   (tm-to-tm1 (cdr tm) map))))))
+
+(defun assoc-inverse (key alist)
+  (cond ((endp alist) nil)
+        ((equal key (cdr (car alist))) (car alist))
+        (t (assoc-inverse key (cdr alist)))))
+
+(defun tm1-to-tm (tm1 map)
+  (cond ((endp tm1) nil)
+        (t (let ((st-in  (nth 0 (car tm1)))
+                 (sym    (nth 1 (car tm1)))
+                 (op     (nth 2 (car tm1)))
+                 (st-out (nth 3 (car tm1))))
+             (cons (list (car (assoc-inverse st-in map))
+                         sym
+                         (case op (2 'L) (3 'R) (otherwise op))
+                         (car (assoc-inverse st-out map)))
+                   (tm1-to-tm (cdr tm1) map))))))
+
+(defun descending-map (map)
+  (cond ((endp map) t)
+        ((endp (cdr map)) t)
+        ((> (cdr (car map)) (cdr (car (cdr map))))
+         (descending-map (cdr map)))
+        (t nil)))
+
+(defun total-map (tm map)
+  (cond ((endp tm) t)
+        (t (let ((st-in  (nth 0 (car tm)))
+                 (st-out (nth 3 (car tm))))
+             (and (assoc st-in map)
+                  (assoc st-out map)
+                  (total-map (cdr tm) map))))))
+
+(defun natp-map (map)
+  (cond ((endp map) t)
+        (t (and (natp (cdr (car map)))
+                (natp-map (cdr map))))))
+
+(defthm natp-map-renaming-map
+  (implies (and (natp-map map)
+                (natp i))
+           (natp-map (renaming-map1 tm i map))))
+
+(defthm renaming-map-preserves-map
+  (implies (assoc st map)
+           (equal (assoc st (renaming-map1 tm i map))
+                  (assoc st map))))
+
+(defthm total-map-renaming-map
+  (total-map tm (renaming-map1 tm i map)))
+
+(defthm descending-map-renaming-map
+  (implies (and (natp i)
+                (descending-map map)
+                (or (not (consp map))
+                    (< (cdr (car map)) i)))
+           (descending-map (renaming-map1 tm i map))))
+
+(defthm assoc-inverse-assoc-lemma
+  (implies (and (consp alist)
+                (not (equal key (car (car alist))))
+                (assoc key (cdr alist))
+                (integerp (cdr (car alist)))
+                (<= 0 (cdr (car alist)))
+                (natp-map (cdr alist))
+                (< (cdr (car (cdr alist)))
+                   (cdr (car alist)))
+                (descending-map (cdr alist)))
+           (not (equal (cdr (assoc key (cdr alist)))
+                       (cdr (car alist)))))
+  :otf-flg t)
+
+(defthm assoc-inverse-assoc
+  (implies (and (assoc key alist)
+                (natp-map alist)
+                (descending-map alist))
+           (equal (assoc-inverse (cdr (assoc key alist)) alist)
+                  (assoc key alist))))
+
+
+(defthm car-assoc
+  (implies (assoc key alist)
+           (equal (car (assoc key alist)) key)))
+
+(defthm equal-len-1
+  (equal (equal (len x) 1)
+         (and (consp x)
+              (atom (cdr x)))))
+
+(defthm tm-to-tm1-to-tm
+  (implies (and (turing-machinep tm)
+                (natp-map map)
+                (total-map tm map)
+                (descending-map map))
+           (equal (tm1-to-tm (tm-to-tm1 tm map) map)
+                  tm)))
+
+(defun new-tape1 (op1 tape)
+; Like new-tape, but uses numeric ops
+  (case op1
+    ((0 1)
+     (cons (car tape)
+           (cons op1 (cdr (cdr tape)))))
+    (2 (cons (cdr (car tape))
+             (cons (sym (car tape))
+                   (cdr tape))))
+    (otherwise (cons (cons (sym (cdr tape))
+                           (car tape))
+                     (cdr (cdr tape))))))
+
+(defun tmi1 (st tape tm1 n)
+; Like tmi but tm1 is a list of 4-tuples composed entirely of numbers.
+  (declare (xargs :measure (nfix n)))
+  (cond ((zp n) nil)
+        ((instr st (current-sym tape) tm1)
+         (tmi1 (nth 3 (instr st (current-sym tape) tm1))
+               (new-tape1 (nth 2 (instr st (current-sym tape) tm1)) tape)
+               tm1
+               (- n 1)))
+        (t tape)))
+
+(defthm car-instr
+  (implies (turing-machinep tm)
+           (and (equal (car (instr st sym tm))
+                       (if (instr st sym tm)
+                           st
+                           nil))
+                (equal (car (cdr (instr st sym tm)))
+                       (if (instr st sym tm)
+                           sym
+                           nil)))))
+
+(defthm instr-implies-mapped-instr
+  (implies (and (turing-machinep tm)
+                (natp-map map)
+                (total-map tm map)
+                (descending-map map)
+                (instr st sym tm))
+           (instr (cdr (assoc st map)) sym (tm-to-tm1 tm map))))
+
+(defthm cdr-assoc-descending-lemma
+  (implies (and (consp map)
+                (descending-map map)
+                (force (assoc key (cdr map))))
+           (< (cdr (assoc key (cdr map)))  (cdr (car map))))
+  :rule-classes :linear)
+
+(defthm map-property
+  (implies (and (natp-map map)
+                (descending-map map))
+           (equal (equal (cdr (assoc key1 map))
+                         (cdr (assoc key2 map)))
+                  (if (assoc key1 map)
+                      (if (assoc key2 map)
+                          (equal key1 key2)
+                          nil)
+                      (if (assoc key2 map)
+                          nil
+                          t)))))
+
+(defthm instr-implies-mapped-instr-vice-versa
+  (implies (and (turing-machinep tm)
+                (natp-map map)
+                (total-map tm map)
+                (descending-map map)
+                (not (instr st sym tm)))
+           (not (instr (cdr (assoc st map)) sym (tm-to-tm1 tm map)))))
+           
+(defthm instr-implies-assoc
+  (implies (and (turing-machinep tm)
+                (instr st sym tm))
+           (assoc st tm)))
+
+(defthm mapped-instr
+  (implies (and (turing-machinep tm)
+                (natp-map map)
+                (total-map tm map)
+                (descending-map map))
+           (equal (instr (cdr (assoc st map)) sym (tm-to-tm1 tm map))
+                  (if (instr st sym tm)
+                      (let ((st-in  (nth 0 (instr st sym tm)))
+                            (sym    (nth 1 (instr st sym tm)))
+                            (op     (nth 2 (instr st sym tm)))
+                            (st-out (nth 3 (instr st sym tm))))
+                        (list (cdr (assoc st-in map))
+                              sym
+                              (case op (L 2) (R 3) (otherwise op))
+                              (cdr (assoc st-out map))))
+                      nil))))
+
+(defthm symbolp-st-out-instr
+  (implies (and (turing-machinep tm)
+                (instr st sym tm))
+           (symbolp (car (cdr (cdr (cdr (instr st sym tm))))))))
+
+(defthm total-map-covers-tm
+  (implies (and (turing-machinep tm)
+                (instr st sym tm)
+                (total-map tm map))
+           (assoc (car (cdr (cdr (cdr (instr st sym tm))))) map)))
+
+(defthm mapped-new-tape1
+  (implies (natp op1)
+           (equal (new-tape1 op1 tape)
+                  (new-tape (case op1 ((0 1) op1) (2 'L) (otherwise 'R))
+                            tape))))
+
+(defthm op-instr
+  (implies (and (turing-machinep tm)
+                (instr st sym tm)
+                (not (equal (nth 2 (instr st sym tm)) 'L))
+                (not (equal (nth 2 (instr st sym tm)) 'R))
+                (not (equal (nth 2 (instr st sym tm))  0)))
+           (equal (car (cdr (cdr (instr st sym tm)))) 1)))
+
+(defthm op-instr-lessp-trick
+  (implies (and (turing-machinep tm)
+                (instr st sym tm))
+           (< (car (cdr (cdr (instr st sym tm)))) 2))
+  :rule-classes :linear)
+
+(defthm tmi1-is-tmi-lemma
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm)
+                (natp-map map)
+                (total-map tm map)
+                (assoc st map)
+                (descending-map map))
+           (equal (tmi1 (cdr (assoc st map))
+                        tape
+                        (tm-to-tm1 tm map)
+                        n)
+                  (tmi st tape tm n)))
+  :hints (("Goal" :induct (tmi st tape tm n))
+          ("Subgoal *1/2.13" :expand (TMI1 (CDR (ASSOC-EQUAL ST MAP))
+                                           TAPE (TM-TO-TM1 TM MAP)
+                                           N))
+          ("Subgoal *1/2.5''" :expand (TMI1 (CDR (ASSOC-EQUAL ST MAP))
+                                            TAPE (TM-TO-TM1 TM MAP)
+                                            N)))
+  :rule-classes nil)
+
+(defthm tmi1-is-tmi
+  (implies (and (symbolp st)
+                (tapep tape)
+                (turing-machinep tm))
+           (equal (tmi1 (cdr (assoc st (renaming-map st tm)))
+                        tape
+                        (tm-to-tm1 tm (renaming-map st tm))
+                        n)
+                  (tmi st tape tm n)))
+  :hints (("Goal"
+           :use ((:instance tmi1-is-tmi-lemma (map (renaming-map st tm)))))))
+
+; That completes step 1.  Now we move to step 2: introduce tmi2, in which the
+; Turing machine program is a single big number.  We'll prove tmi1 equivalent
+; to tmi2.
+
+; Consider a tm1-style machine.  It is a list of 4-tuples of natural numbers.
+; Each tuple is (st-in sym op st-out) where st-in and st-out are arbitrary nats
+; (``state numbers''), sym is 0 or 1 and op is a nat less than 4.  We will
+; first determine the width, w, into which we can pack all the state numbers.
+
+(defun log2 (n)
+  (cond ((zp n) 0)
+        ((equal n 1) 0)
+        (t (+ 1 (log2 (floor n 2))))))
+
+(defun log2-implies-expt-upperbound-hint (n w)
+  (cond ((zp n) (list n w))
+        ((equal n 1) (list n w))
+        (t (log2-implies-expt-upperbound-hint (floor n 2) (- w 1)))))
+
+(defthm log2-implies-expt-upperbound
+  (implies (and (natp w)
+                (natp n))
+           (equal (< w (log2 n))
+                  (not (< n (expt 2 (+ w 1))))))
+  :hints (("Goal" :induct (log2-implies-expt-upperbound-hint n w))))
+
+(defthm log2-implies-expt-upperbound-corollary
+  (implies (and (not (< w (+ 1 (log2 n))))
+                (natp w)
+                (natp n))
+           (< n (expt 2 w)))
+  :rule-classes ((:linear)
+                 (:linear :corollary
+                          (implies (and (not (< n (expt 2 w)))
+                                        (natp w)
+                                        (natp n))
+                                   (< w (+ 1 (log2 n))))))
+  :hints (("Goal" :use (:instance log2-implies-expt-upperbound
+                                  (w (- w 1))
+                                  (n n))
+           :in-theory (disable log2-implies-expt-upperbound))))
+
+
+(defun max-width1 (tm1)
+  (if (endp tm1)
+      0
+      (max (+ 1 (max (log2 (nth 0 (car tm1)))
+                     (log2 (nth 3 (car tm1)))))
+           (max-width1 (cdr tm1)))))
+
+(defun max-width (tm map)
+  (max-width1 (tm-to-tm1 tm map)))
+
+(defun turing1-4-tuple (x w)
+  (and (true-listp x)
+       (equal (len x) 4)
+       (natp (nth 0 x))
+       (< (nth 0 x) (expt 2 w))
+       (natp (nth 1 x))
+       (< (nth 1 x) 2)
+       (natp (nth 2 x))
+       (< (nth 2 x) 4)
+       (natp (nth 3 x))
+       (< (nth 3 x) (expt 2 w))))
+
+(defun turing1-machinep (x w)
+  (if (endp x)
+      (equal x nil)
+      (and (turing1-4-tuple (car x) w)
+           (turing1-machinep (cdr x) w))))
+
+
+; We will pack each tuple into a ``cell'' using simple arithmetic.  The two
+; state numbers fit in w bits each, the sym fits in 1 bit, and the op fits in
+; 2.  However, we will allocate 3 bits for op.  Consider how we'll ``assoc''
+; for a given st-in and sym through the big number that is the concatenation of
+; all these cells.  We will repeatedly extract the st-in and sym from the
+; low-order cell and if they're not the ones we are looking for we'll shift the
+; big number right by the cell length.  But how do we know when we've reached
+; the end?  (A cell of all 0s is perfectly legal.)  We must have a non-0 marker
+; cell.  That will be an otherwise all 0 cell with an op of 4.  Thus, ops will
+; have 3 bits allocated for them.
+
+(defun make-cell (tuple w)
+
+; W is the number of bits required to represent a state number.  For example,
+; if the highest state number is 8, then four bits are required: 8 = #b1000.
+; (So w is in fact (log2 <max-state-number>)+1.
+
+; I pack tuple with st-in and sym in the least significant bits, so (mod cell
+; (expt 2 (+ 1 w))) gets them both.
+
+  (let ((st-in  (nth 0 tuple))  ; w bits
+        (sym    (nth 1 tuple))  ; 1 bit
+        (op     (nth 2 tuple))  ; 3 bits (see above)
+        (st-out (nth 3 tuple))) ; w bits
+    (+ (* (expt 2 (+ 3 1 w)) st-out)
+       (* (expt 2 (+ 1 w)) op)
+       (* (expt 2 w) sym)
+       st-in)))
+
+; Now we use make-cell to create a big number representing the given tmi1-style
+; machine.  
+
+(defun ncons (cell tail w) 
+  (+ cell
+     (* (expt 2 (+ 4 (* 2 w))) tail)))
+
+(defun ncar (tm w)
+  (mod tm (expt 2 (+ 4 (* 2 w)))))
+
+(defun ncdr (tm w)
+  (ash tm (- (+ 4 (* 2 w)))))
+
+(defun cellp (cell w)
+  (and (natp cell)
+       (< cell (expt 2 (+ 4 (* 2 w))))))
+
+(defthm ncar-ncons
+  (implies (and (natp w)
+                (cellp cell w)
+                (natp tail))
+           (equal (ncar (ncons cell tail w) w)
+                  cell)))
+
+(defthm ncdr-ncons
+  (implies (and (natp w)
+                (cellp cell w)
+                (natp tail))
+           (equal (ncdr (ncons cell tail w) w)
+                  tail)))
+
+(defthm cellp-make-cell
+  (implies (and (natp w)
+                (turing1-4-tuple tuple w))
+           (cellp (make-cell tuple w) w))
+  :hints (("Goal" :nonlinearp t))
+  :rule-classes (:rewrite
+                 (:linear :corollary
+                          (implies (and (natp w)
+                                        (force (turing1-4-tuple tuple w)))
+                                   (<= 0 (make-cell tuple w))))
+                 (:type-prescription :corollary
+                                     (implies (and (natp w)
+                                                   (force (turing1-4-tuple tuple w)))
+                                              (integerp (make-cell tuple w))))))
+
+(defthm ncdr-decreases
+  (implies (and (natp w)
+                (not (zp tm)))
+           (< (ncdr tm w) tm))
+  :rule-classes :linear)
+
+(defthm natp-ncdr
+  (implies (and (natp w)
+                (natp tm))
+           (natp (ncdr tm w)))
+  :rule-classes :type-prescription)
+
+(defthm positive-natp-ncons
+  (implies (and (natp w)
+                (natp cell)
+                (integerp tail)
+                (< 0 tail))
+           (and (integerp (ncons cell tail w))
+                (< 0 (ncons cell tail w))))
+  :rule-classes
+  ((:type-prescription :corollary
+                       (implies (and (force (natp w))
+                                     (force (natp cell))
+                                     (force (integerp tail))
+                                     (force (< 0 tail)))
+                                (integerp (ncons cell tail w))))
+   (:linear :corollary
+            (implies (and (force (natp w))
+                          (force (natp cell))
+                          (force (integerp tail))
+                          (force (< 0 tail)))
+                     (< 0 (ncons cell tail w))))))
+
+(in-theory (disable ncons ncar ncdr cellp))
+
+(defun nst-in (cell w)
+  (mod cell (expt 2 w)))
+
+(defun nsym (cell w)
+  (mod (ash cell (- w)) 2))
+
+(defun nop (cell w)
+  (mod (ash cell (- (+ 1 w))) (expt 2 3)))
+
+(defun nst-out (cell w)
+  (mod (ash cell (- (+ 4 w)))
+       (expt 2 w)))
+
+(defun nnil (w)
+  (make-cell (list 0 0 4 0) w))
+
+(defun ncode (tm w)
+  (cond ((endp tm) (nnil w))
+        (t (ncons (make-cell (car tm) w)
+                  (ncode (cdr tm) w)
+                  w))))
+
+(defthm positive-natp-nnil
+  (implies (natp w)
+           (and (integerp (nnil w))
+                (< 0 (nnil w))))
+  :rule-classes :type-prescription)
+
+(defthm positive-natp-ncode
+  (implies (and (natp w)
+                (turing1-machinep tm w))
+           (and (integerp (ncode tm w))
+                (< 0 (ncode tm w))))
+  :rule-classes ((:type-prescription :corollary
+                                     (implies (and (force (natp w))
+                                                   (force (turing1-machinep tm w)))
+                                              (integerp (ncode tm w))))
+                 (:linear :corollary
+                          (implies (and (force (natp w))
+                                        (force (turing1-machinep tm w)))
+                                   (< 0 (ncode tm w))))))
+
+(defthm nst-in-make-cell
+  (implies (and (natp w)
+                (turing1-4-tuple tuple w))
+           (equal (nst-in (make-cell tuple w) w)
+                  (nth 0 tuple))))
+
+(defthm nsym-make-cell
+  (implies (and (natp w)
+                (turing1-4-tuple tuple w))
+           (equal (nsym (make-cell tuple w) w)
+                  (nth 1 tuple))))
+
+(defthm nop-make-cell
+  (implies (and (natp w)
+                (turing1-4-tuple tuple w))
+                (equal (nop (make-cell tuple w) w)
+                       (nth 2 tuple)))
+  :hints (("Goal" :in-theory (e/d (acl2::scatter-exponents-theory)
+                                  (acl2::gather-exponents-theory))
+           :nonlinearp t
+                  :do-not-induct t)))
+
+(defthm nst-out-make-cell
+  (implies (and (natp w)
+                (turing1-4-tuple tuple w))
+           (equal (nst-out (make-cell tuple w) w)
+                  (nth 3 tuple)))
+  :hints (("Goal" :in-theory (e/d (acl2::scatter-exponents-theory)
+                                  (acl2::gather-exponents-theory))
+           :nonlinearp t
+           :do-not-induct t)))
+                
+(defthm nop-nnil
+  (implies (natp w)
+           (equal (nop (nnil w) w) 4))
+  :hints (("Goal" :in-theory (e/d (acl2::scatter-exponents-theory)
+                                  (acl2::gather-exponents-theory))
+           :nonlinearp t
+           :do-not-induct t)))
+
+(defthm not-equal-ncons-nnil
+  (implies (and (natp w)
+                (cellp cell w)
+                (turing1-machinep tm w))
+           (< (nnil w) (ncons cell (ncode tm w) w)))
+  :rule-classes :linear
+  :hints (("Goal" :nonlinearp t
+           :in-theory (enable ncons cellp))
+          ("Subgoal *1/1'''"
+           :in-theory nil
+           :use (:instance (:theorem
+                            (implies (and (natp i)
+                                          (natp j)
+                                          (natp cell)
+                                          (< i j))
+                                     (< (expt 2 i) (+ cell (expt 2 j)))))
+                           (i (+ 3 W))
+                           (j (+ 7 (* 3 W)))))
+          ("Subgoal *1/1.3" :in-theory (enable natp))
+          ("Subgoal *1/1.2" :in-theory (enable natp))
+          ("Subgoal *1/1.1" :in-theory (enable natp))))
+
+(in-theory (disable nst-in nsym nop nst-out make-cell nnil))
+
+(defun ninstr (st sym tm w)
+  (if (natp w)
+      (if (zp tm)
+          -1
+          (if (equal tm (nnil w))
+              -1
+              (let ((cell (ncar tm w)))
+                (if (and (equal st (nst-in cell w))
+                         (equal sym (nsym cell w)))
+                    cell
+                    (ninstr st sym (ncdr tm w) w)))))
+      -1))
+
+(defthm ninstr-ncode
+  (implies (and (force (natp w))
+                (force (natp st))
+                (force (< st (expt 2 w)))
+                (force (natp sym))
+                (force (< sym 2))
+                (force (turing1-machinep tm w)))
+           (equal (ninstr st sym (ncode tm w) w)
+                  (if (instr st sym tm)
+                      (make-cell (instr st sym tm) w)
+                      -1))))
+
+(defun tmi2 (st tape tm2 w n)
+  (declare (xargs :measure (nfix n)))
+  (cond ((zp n) nil)
+        ((equal (ninstr st (current-sym tape) tm2 w) -1)
+         tape)
+        (t
+         (tmi2 (nst-out (ninstr st (current-sym tape) tm2 w) w)
+               (new-tape1 (nop (ninstr st (current-sym tape) tm2 w) w) tape)
+               tm2
+               w
+               (- n 1)))))  
+
+(defthm natp-make-cell
+  (implies (and (force (natp w))
+                (force (turing1-4-tuple tuple w)))
+           (natp (make-cell tuple w)))
+  :rule-classes :type-prescription
+  :hints (("Goal" :in-theory (enable make-cell))))
+
+(defthm properties-of-instr
+  (implies (and (force (turing1-machinep tm w))
+                (force (natp w))
+                (instr st sym tm))
+           (and (equal (nth 0 (instr st sym tm)) st)
+                (equal (nth 1 (instr st sym tm)) sym)
+                (integerp (nth 2 (instr st sym tm)))
+                (<= 0 (nth 2 (instr st sym tm)))
+                (< (nth 2 (instr st sym tm)) 4)
+                (integerp (nth 3 (instr st sym tm)))
+                (<= 0 (nth 3 (instr st sym tm)))
+                (< (nth 3 (instr st sym tm)) (expt 2 w))))
+  :rule-classes
+  ((:rewrite :corollary
+             (implies (and (force (turing1-machinep tm w))
+                           (force (natp w))
+                           (instr st sym tm))
+                      (and (equal (nth 0 (instr st sym tm)) st)
+                           (equal (nth 1 (instr st sym tm)) sym))))
+   (:type-prescription :corollary
+                 (implies (and (force (turing1-machinep tm w))
+                               (force (natp w))
+                               (instr st sym tm))
+                          (and (integerp (nth 2 (instr st sym tm)))
+                               (<= 0 (nth 2 (instr st sym tm))))))
+   (:type-prescription :corollary
+                 (implies (and (force (turing1-machinep tm w))
+                               (force (natp w))
+                               (instr st sym tm))
+                          (and (integerp (nth 3 (instr st sym tm)))
+                               (<= 0 (nth 3 (instr st sym tm))))))
+   (:linear :corollary
+            (implies (and (force (turing1-machinep tm w))
+                          (force (natp w))
+                          (instr st sym tm))
+                     (and (<= 0 (nth 2 (instr st sym tm)))
+                          (< (nth 2 (instr st sym tm)) 4)
+                          (<= 0 (nth 3 (instr st sym tm)))
+                          (< (nth 3 (instr st sym tm)) (expt 2 w)))))))
+            
+                
+(defthm turing1-4-tuple-instr
+  (implies (and (natp w)
+                (instr st sym tm)
+                (turing1-machinep tm w))
+           (turing1-4-tuple (instr st sym tm) w))
+  :hints (("Goal" :in-theory (disable turing1-4-tuple))))
+  
+
+(defthm tapep-new-tape1
+  (implies (and (tapep tape)
+                (natp op))
+           (tapep (new-tape1 op tape))))
+
+
+
+(defthm natp-current-sym
+  (implies (tapep tape)
+           (and (integerp (current-sym tape))
+                (<= 0 (current-sym tape))
+                (< (current-sym tape) 2)))
+  :rule-classes
+  ((:type-prescription :corollary
+                       (implies (tapep tape)
+                                (integerp (current-sym tape))))
+   (:linear :corollary
+            (implies (tapep tape)
+                     (and (<= 0 (current-sym tape))
+                          (< (current-sym tape) 2))))))
+
+(defthm tmi2-is-tmi1
+  (implies (and (natp w)
+                (natp st)
+                (< st (expt 2 w))
+                (tapep tape)
+                (turing1-machinep tm1 w))
+           (equal (tmi2 st tape (ncode tm1 w) w n)
+                  (tmi1 st tape tm1 n)))
+  :hints (("Goal" :in-theory (disable tmi1-is-tmi ninstr turing1-4-tuple instr ncode
+                                      current-sym nth nth-add1!
+                                      tapep new-tape1 MAPPED-NEW-TAPE1
+                                      ))))
+
+
+; That completes step 2.  Step 3 will introduce tmi3, in which the tape is a
+; big number.  We'll prove tmi2 equivalent to tmi3.
+
+
+; Our next goal is to re-represent the tape as a pair of natural numbers, (n . pos)
+; where the bits between the bottom and the topmost 1 in the binary expansion of n
+; represent the tape and pos is the bit position of the current bit.  For example,
+; ((0 1 0 0) . (1 1 0 0 0))
+; = (0 0 1 0 [ 1 ] 1 0 0 0) 
+; = (#B0010110001 . 4)
+
+; We need to be able to convert back and forth between tapes and these pairs.
+
+; (i-am-here)
+
+
+(defun convert-half-tape-to-nat (htape)
+ (cond ((endp htape) 0)
+       (t (+ (car htape)
+             (* 2 (convert-half-tape-to-nat (cdr htape)))))))
+
+(defun convert-tape-to-tapen-pos (tape)
+  (let ((lo (convert-half-tape-to-nat (rev (car tape))))
+        (lo-size (len (car tape)))
+        (hi (convert-half-tape-to-nat (cdr tape)))
+        (hi-size (len (cdr tape))))
+    (mv (+ lo (* (expt 2 lo-size) hi) (expt 2 (+ lo-size hi-size)))
+        lo-size)))
+
+(defun nat-to-half-tape (n size)
+  (cond ((zp size) nil)
+        (t (cons (mod n 2) (nat-to-half-tape (floor n 2) (- size 1))))))
+
+(defun decode-tape-and-pos (tapen pos)
+  (let* ((n tapen)
+         (lo-size pos)
+         (hi-size (log2 n)))
+    (cons (rev (nat-to-half-tape n lo-size))
+          (nat-to-half-tape (ash n (- lo-size))
+                            (- hi-size lo-size)))))
+
+(in-theory (enable member))
+
+(defthm natp-convert-half-tape-to-nat
+  (implies (half-tape htape)
+           (and (integerp (convert-half-tape-to-nat htape))
+                (<= 0 (convert-half-tape-to-nat htape))))
+  :rule-classes ((:rewrite) (:type-prescription)
+                 (:linear :corollary
+                          (implies (half-tape htape)
+                                   (<= 0 (convert-half-tape-to-nat htape))))))
+
+
+(defthm half-tape-conversion
+  (implies (half-tape htape)
+           (equal (nat-to-half-tape (convert-half-tape-to-nat htape)
+                                    (len htape))
+                  htape)))
+
+
+(defthm half-tape-append
+  (implies (half-tape x)
+           (equal (half-tape (append x (list bit)))
+                  (or (equal bit 0)
+                      (equal bit 1)))))
+
+(defthm half-tape-rev
+  (implies (half-tape x)
+           (half-tape (rev x))))
+
+(defthm convert-half-tape-to-nat-append
+  (implies (and (half-tape htape)
+                (or (equal bit 0)
+                    (equal bit 1)))
+           (equal (convert-half-tape-to-nat (append x (list bit)))
+                  (+ (convert-half-tape-to-nat x) (* bit (expt 2 (len x)))))))
+
+
+(defthm half-tape-below-expt
+  (implies (and (natp k)
+                (half-tape htape))
+           (equal (NAT-TO-HALF-TAPE (+ (CONVERT-HALF-TAPE-TO-NAT htape)
+                                       (* k (EXPT 2 (LEN htape))))
+                                    (LEN htape))
+                  htape))
+  :rule-classes nil)
+
+(defthm len-rev
+  (equal (len (rev x)) (len x)))
+
+(defthm rev-rev
+  (implies (true-listp x)
+           (equal (rev (rev x)) x)))
+
+(defthm half-tape-implies-true-listp
+  (implies (half-tape htape)
+           (true-listp htape)))
+
+(defthm convert-half-tape-to-nat-upper-bound
+  (implies (half-tape x)
+           (< (convert-half-tape-to-nat x) (expt 2 (len x))))
+  :hints (("Goal" :nonlinearp t))
+  :rule-classes :linear)
+
+(defthm convert-half-tape-to-nat-upper-bound-corollary
+  (implies (half-tape x)
+           (< (convert-half-tape-to-nat (rev x)) (expt 2 (len x))))
+  :hints (("Goal" :nonlinearp t))
+  :rule-classes :linear)
+
+(defun hint (k n) (if (zp n) (list k n) (hint (floor k 2) (- n 1))))
+
+(defthm log2-sum
+  (implies (and (natp n)
+                (natp k)
+                (< k (expt 2 n)))
+           (equal (log2 (+ k (expt 2 n)))  n))
+  :hints (("Goal" :induct (hint k n)))
+  :rule-classes nil)
+
+(defthm log2-sum-corollary
+  (implies (and (half-tape htape1)
+                (half-tape htape2))
+           (equal (LOG2 (+ (CONVERT-HALF-TAPE-TO-NAT (REV htape1))
+                           (* (CONVERT-HALF-TAPE-TO-NAT htape2)
+                              (EXPT 2 (LEN htape1)))
+                           (EXPT 2
+                                 (+ (LEN htape1)
+                                    (LEN htape2)))))
+                  (+ (LEN htape1)
+                     (LEN htape2))))
+  :hints (("Goal" :nonlinearp t
+                  :use (:instance log2-sum
+                                  (k (+ (CONVERT-HALF-TAPE-TO-NAT (REV htape1))
+                                        (* (CONVERT-HALF-TAPE-TO-NAT htape2)
+                                           (EXPT 2 (LEN htape1)))))
+                                  (n (+ (LEN htape1)
+                                        (LEN htape2)))))))
+
+(defthm floor-lemma-1
+  (implies (and (natp i)
+                (natp j)
+                (natp n)
+                (natp m)
+                (< i (expt 2 n)))
+           (equal (floor (+ i (* j (expt 2 n)) (expt 2 (+ n m)))
+                         (expt 2 n))
+                  (+ j (expt 2 m)))))
+
+(defthm get-the-upper-half-tape
+  (IMPLIES (HALF-TAPE TAPE2)
+           (EQUAL (NAT-TO-HALF-TAPE (+ (CONVERT-HALF-TAPE-TO-NAT TAPE2)
+                                       (EXPT 2 (LEN TAPE2)))
+                                    (LEN TAPE2))
+                  TAPE2)))
+
+(defthm tape-conversion-theorem
+  (implies (tapep tape)
+           (equal (decode-tape-and-pos
+                   (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                   (mv-nth 1 (convert-tape-to-tapen-pos tape)))
+                  tape))
+  :hints
+  (("Goal" :do-not-induct t)
+   ("Goal'4'" :use (:instance half-tape-below-expt
+                                (htape (rev tape1))
+                                (k (+ (CONVERT-HALF-TAPE-TO-NAT tape2)
+                                      (expt 2 (len tape2))))))))
+
+#| this npair theorem is no longer possible to state because it abuses types
+(defthm tape-conversion-theorem-stronger
+  (implies (or (tapep tape)
+               (equal tape nil))
+           (equal (convert-npair-to-tape
+                   (convert-tape-to-npair tape))
+                  tape))
+  :hints
+  (("Goal" :in-theory (disable convert-npair-to-tape
+                               convert-tape-to-npair))))
+|#
+
+; I think of the theorem above as an important sanity check.  But the real work
+; comes in implementing and verifying the numeric analogues of current-sym and
+; new-tape:
+
+(defun current-symn (tapen pos)
+
+; If we shift the tape down by pos and find that it is just 1, then we've
+; reached the end of the tape and everything thereafter is 0.  That 1 is just a
+; marker, not a legitimate bit.
+
+  (if (equal pos (log2 tapen))
+      0
+      (mod (ash tapen (- pos)) 2)))
+
+(defthm current-symn-convert-tape-to-tapen-pos
+  (implies (tapep tape)
+           (equal (current-symn (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                                (mv-nth 1 (convert-tape-to-tapen-pos tape)))
+                  (current-sym tape))))
+
+
+(defun new-tape2 (op tapen pos)
+  (CASE OP
+    ((0 1)
+     (if (equal pos (log2 tapen))
+         (if (equal op 0)
+             (mv (+ tapen (expt 2 pos)) pos)
+             (mv (+ tapen (expt 2 (+ pos 1))) pos))
+         (let ((sym (current-symn tapen pos)))
+           (cond ((equal sym op)
+                  (mv tapen pos))
+                 ((equal sym 0)
+                  (mv (+ tapen (expt 2 pos))
+                      pos))
+                 (t (mv (- tapen (expt 2 pos))
+                        pos))))))
+    (2 (if (zp pos)
+           (mv (* 2 tapen) 0)
+           (mv tapen (- pos 1))))
+    (otherwise (if (equal pos (log2 tapen))
+                   (mv (+ (- tapen (expt 2 pos)) (expt 2 (+ 1 pos)))
+                       (+ 1 pos))
+                   (mv tapen (+ pos 1))))))
+
+(defthm half-tape-below-expt-rule1
+  (implies (and (natp k)
+                (natp n)
+                (half-tape htape))
+           (equal (NAT-TO-HALF-TAPE (+ (CONVERT-HALF-TAPE-TO-NAT (REV htape))
+                                       (* k (EXPT 2 (LEN htape)))
+                                       (EXPT 2 (+ n (LEN htape))))
+                                    (LEN htape))
+                  (rev htape)))
+  :hints (("Goal" :do-not-induct t
+                  :use (:instance half-tape-below-expt
+                                  (htape (REV htape))
+                                  (k (+ k (EXPT 2 n)))))))
+
+(defthm half-tape-below-expt-rule2
+  (implies (and (natp k)
+                (natp i)
+                (natp n)
+                (half-tape htape))
+           (equal (NAT-TO-HALF-TAPE (+ (CONVERT-HALF-TAPE-TO-NAT (REV htape))
+                                       (* k (EXPT 2 (+ i (LEN htape))))
+                                       (EXPT 2 (+ i n (LEN htape))))
+                                    (LEN htape))
+                  (rev htape)))
+  :hints (("Goal" :do-not-induct t
+           :in-theory (disable half-tape-below-expt-rule1)
+           :use (:instance half-tape-below-expt-rule1
+                           (k (* k (expt 2 i)))
+                           (n (+ i n))))))
+
+(defthm floor-lemma-1-special-case
+  (implies (and (natp i)
+                (natp j)
+                (natp n)
+                (natp m)
+                (< i (expt 2 n)))
+           (equal (floor (+ i
+                            (* j (expt 2 (+ 1 n)))
+                            (expt 2 (+ 1 m n)))
+                         (expt 2 n))
+                  (+ (* 2 j) (* 2 (expt 2 m)))))
+  :hints (("Goal" :in-theory (disable floor-lemma-1)
+                  :use (:instance floor-lemma-1
+                                  (j (* 2 j))
+                                  (m (+ 1 m))))))
+
+(defthm log2-sum-corollary2
+  (implies (and (natp n)
+                (natp k1)
+                (natp k2)
+                (< (+ k1 k2) (expt 2 n)))
+           (equal (log2 (+ k1 k2 (expt 2 n)))  n))
+  :hints (("Goal" :use (:instance log2-sum
+                                  (k (+ k1 k2))))))
+
+
+(defthm half-tape-below-expt-rule3
+  (implies (and (natp k)
+                (natp i)
+                (natp n)
+                (half-tape htape))
+           (equal (NAT-TO-HALF-TAPE (+ (CONVERT-HALF-TAPE-TO-NAT (REV htape))
+                                       (expt 2 (len htape))
+                                       (* k (EXPT 2 (+ i (LEN htape))))
+                                       (EXPT 2 (+ i n (LEN htape))))
+                                    (LEN htape))
+                  (rev htape)))
+  :hints (("Goal"
+           :use (:instance half-tape-below-expt
+                           (htape (REV htape))
+                           (k (+ 1 (* k (expt 2 i)) (expt 2 (+ i n))))))))
+
+(defthm floor-lemma-1-special-case-2
+  (implies (and (natp i)
+                (natp j)
+                (natp n)
+                (natp m)
+                (< i (expt 2 n)))
+           (equal (floor (+ i
+                            (expt 2 n)
+                            (* j (expt 2 (+ 1 n)))
+                            (expt 2 (+ 1 m n)))
+                         (expt 2 n))
+                  (+ 1 (* 2 j) (* 2 (expt 2 m)))))
+  :hints (("Goal" :in-theory (disable floor-lemma-1)
+                  :use (:instance floor-lemma-1
+                                  (j (+ 1 (* 2 j)))
+                                  (m (+ 1 m))))))
+
+(defthm log2-sum-corollary3
+  (implies (and (natp n)
+                (natp k1)
+                (natp k2)
+                (natp k3)
+                (< (+ k1 k2 k3) (expt 2 n)))
+           (equal (log2 (+ k1 k2 k3 (expt 2 n)))  n))
+  :hints (("Goal" :use (:instance log2-sum
+                                  (k (+ k1 k2 k3))))))
+
+
+(defthm half-tape-below-expt-rule4
+  (implies (half-tape htape)
+           (equal (nat-to-half-tape (+ (convert-half-tape-to-nat htape)
+                                       (expt 2 (len htape)))
+                                    (len htape))
+                  htape))
+  :hints (("Goal" :use (:instance half-tape-below-expt
+                                  (k 1))))
+  :rule-classes nil)
+
+; !!! this is identical to log2-sum, which has rule-classes nil...
+
+(defthm log2-sum-corollary4
+  (implies (and (natp n) (natp k) (< k (expt 2 n)))
+           (equal (log2 (+ k (expt 2 n))) n))
+  :hints (("Goal" :use log2-sum)))
+
+(defthm floor-lemma-1-special-case-3
+  (implies (and (natp i)
+                (natp j)
+                (natp n)
+                (natp m)
+                (< i (expt 2 n)))
+           (equal (floor (+ i
+                            (* j (expt 2 (+ 1 n)))
+                            (expt 2 (+ 1 n m)))
+                         (expt 2 (+ 1 n)))
+                  (+ j (expt 2 m))))
+  :hints (("Goal" :nonlinearp t
+                  :in-theory (disable floor-lemma-1)
+                  :use (:instance floor-lemma-1
+                                  (n (+ n 1))))))
+
+(defthm rationalp-intp-+
+  (implies (and (common-lisp::rationalp x)
+                (common-lisp::rationalp y))
+           (common-lisp::rationalp (acl2::intp-+ x y)))
+  :rule-classes (:type-prescription :rewrite))
+
+#|
+(defun testn (op tape)
+  (equal (new-tape2 op (convert-tape-to-npair tape))
+         (convert-tape-to-npair (new-tape op tape))))|#
+
+(defthm new-tape2-convert-tape-to-tapen-transformed
+  (implies (and (natp op)
+;                (< op 4)
+                (tapep tape))
+           (equal (new-tape2 op
+                             (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                             (mv-nth 1 (convert-tape-to-tapen-pos tape)))
+                  (convert-tape-to-tapen-pos (new-tape1 op tape)))))
+
+(in-theory (disable current-sym current-symn
+                    convert-tape-to-tapen-pos
+                    decode-tape-and-pos
+                    new-tape new-tape1 new-tape2 MAPPED-NEW-TAPE1 mv-nth))
+
+(defthm new-tape2-convert-tape-to-tapen-pos
+  (implies (and  (natp op)
+;                (< op 4)
+                 (tapep tape))
+           (equal
+            (decode-tape-and-pos
+             (mv-nth 0 (new-tape2 op (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                                        (mv-nth 1 (convert-tape-to-tapen-pos tape))))
+             (mv-nth 1 (new-tape2 op (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                                        (mv-nth 1 (convert-tape-to-tapen-pos tape)))))
+            (new-tape1 op tape))))
+
+(defun tmi3 (st tapen pos tm w n)
+  (declare (xargs :measure (nfix n)))
+  (cond ((zp n)
+         (mv 0 st tapen pos))
+        ((equal (ninstr st (current-symn tapen pos) tm w) -1)
+         (mv 1 st tapen pos))
+        (t
+         (mv-let (new-tapen new-pos)
+                 (new-tape2 (nop (ninstr st (current-symn tapen pos) tm w) w)
+                            tapen pos)
+                 (tmi3 (nst-out (ninstr st (current-symn tapen pos) tm w) w)
+                       new-tapen
+                       new-pos
+                       tm
+                       w
+                       (- n 1))))))
+
+#| I prefer to avoid yet another level...
+(defun tmi3! (st npair tm w n)
+  (let* ((ans (tmi3 st npair tm w n))
+         (haltedp (nth 0 ans))
+         (final-st (nth 1 ans))
+         (final-tape-pair (nth 2 ans)))
+    (declare (ignore final-st))
+    (if haltedp
+        final-tape-pair
+        nil)))
+|#
+
+(defthm nop-ninstr
+  (implies (and (natp w)
+                (natp tm)
+                (natp st)
+                (< st (expt 2 w))
+                (natp sym)
+                (< sym 2)
+                (not (equal (ninstr st sym tm w) -1)))
+           (and (integerp (nop (ninstr st sym tm w) w))
+                (<= 0 (nop (ninstr st sym tm w) w))
+                (< (nop (ninstr st sym tm w) w) 8)))
+  :hints (("Subgoal *1/3''" :in-theory (enable nop ncar)))
+  :rule-classes
+  ((:type-prescription :corollary
+                       (implies (and (force (natp w))
+                                     (force (natp tm))
+                                     (force (natp st))
+                                     (force (< st (expt 2 w)))
+                                     (force (natp sym))
+                                     (force (< sym 2))
+                                     (not (equal (ninstr st sym tm w) -1)))
+                                (integerp (nop (ninstr st sym tm w) w))))
+   (:linear :corollary
+            (implies (and (force (natp w))
+                          (force (natp tm))
+                          (force (natp st))
+                          (force (< st (expt 2 w)))
+                          (force (natp sym))
+                          (force (< sym 2))
+                          (not (equal (ninstr st sym tm w) -1)))
+                     (and (<= 0 (nop (ninstr st sym tm w) w))
+                          (< (nop (ninstr st sym tm w) w) 8))))))
+
+(defthm nst-out-ninstr
+  (implies (and (natp w)
+                (natp tm)
+                (natp st)
+                (< st (expt 2 w))
+                (natp sym)
+                (< sym 2)
+                (not (equal (ninstr st sym tm w) -1)))
+           (and (integerp (nst-out (ninstr st sym tm w) w))
+                (<= 0 (nst-out (ninstr st sym tm w) w))
+                (< (nst-out (ninstr st sym tm w) w) (expt 2 w))))
+  :hints (("Subgoal *1/3''" :in-theory (enable nst-out ncar)))
+  :rule-classes
+  ((:type-prescription :corollary
+                       (implies (and (force (natp w))
+                                     (force (natp tm))
+                                     (force (natp st))
+                                     (force (< st (expt 2 w)))
+                                     (force (natp sym))
+                                     (force (< sym 2))
+                                     (not (equal (ninstr st sym tm w) -1)))
+                                (integerp (nst-out (ninstr st sym tm w) w))))
+   (:linear :corollary
+            (implies (and (force (natp w))
+                          (force (natp tm))
+                          (force (natp st))
+                          (force (< st (expt 2 w)))
+                          (force (natp sym))
+                          (force (< sym 2))
+                          (not (equal (ninstr st sym tm w) -1)))
+                     (and (<= 0 (nst-out (ninstr st sym tm w) w))
+                          (< (nst-out (ninstr st sym tm w) w) (expt 2 w)))))))
+
+(in-theory (disable tapep new-tape1))
+
+; This rather hideous theorem is phrased to rewrite tmi3 into tmi2 terms.
+; Specifically, the 0th result of tmi3 is 1 or 0 depending on tmi2, and
+; if tmi2 is non-nil then the 2nd and 3rd results of tmi3 are the result of tmi2,
+; properly converted.
+
+(defthm tmi3-is-tmi2
+  (implies (and (natp w)
+                (natp st)
+                (< st (expt 2 w))
+                (tapep tape)
+                (natp tm))
+           (and
+            (equal (mv-nth 0
+                                 (tmi3 st
+                                       (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                                       (mv-nth 1 (convert-tape-to-tapen-pos tape))
+                                       tm w n))
+                   (if (tmi2 st tape tm w n) 1 0))
+             
+            (implies
+             (tmi2 st tape tm w n)
+             (and (equal (mv-nth 2 (tmi3 st
+                                               (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                                               (mv-nth 1 (convert-tape-to-tapen-pos tape))
+                                               tm w n))
+                         (mv-nth 0 (convert-tape-to-tapen-pos (tmi2 st tape tm w n))))
+                  (equal (mv-nth 3 (tmi3 st
+                                               (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                                               (mv-nth 1 (convert-tape-to-tapen-pos tape))
+                                               tm w n))
+                         (mv-nth 1 (convert-tape-to-tapen-pos (tmi2 st tape tm w n)))))))))
+
+(defthm tapep-tmi2
+  (implies (and (natp w)
+                (natp st)
+                (< st (expt 2 w))
+                (tapep tape)
+                (natp tm))
+           (or (tapep (tmi2 st tape tm w n))
+               (equal (tmi2 st tape tm w n) nil)))
+  :rule-classes nil)
+
+#| As I said previously, I am resolutely avoiding needing tmi3!
+
+(defthm tmi3!-is-tmi2
+  (implies (and (natp w)
+                (natp st)
+                (< st (expt 2 w))
+                (tapep tape)
+                (natp tm))
+           (equal (convert-npair-to-tape (tmi3! st (convert-tape-to-npair tape) tm w n))
+                  (tmi2 st tape tm w n)))
+  :hints (("Goal"
+           :use tapep-tmi2
+           :in-theory (disable tmi3!)
+           :do-not-induct t)))
+
+(in-theory (disable tmi3!))
+
+|#
+
+; -----------------------------------------------------------------
+
+; Now I relate tmi3 all the back to tmi.  I need to establish the following hyps,
+; which I discovered by making the three relevant rules force their hyps.
+
+(defthm natp-cdr-assoc-map
+  (implies (and (natp-map map)
+                (assoc st map))
+           (natp (cdr (assoc st map))))
+  :rule-classes
+  ((:rewrite  :corollary
+              (implies (and (natp-map map)
+                            (assoc st map))
+                       (integerp (cdr (assoc st map)))))
+   (:type-prescription :corollary
+                       (implies (and (natp-map map)
+                                     (assoc st map))
+                                (integerp (cdr (assoc st map)))))
+   (:linear :corollary
+            (implies (and (natp-map map)
+                          (assoc st map))
+                     (<= 0 (cdr (assoc st map)))))))
+
+(defthm natp-map-renaming-map-top
+  (natp-map (renaming-map st tm)))
+
+(defthm assoc-st-renaming-map
+  (assoc st (renaming-map st tm)))
+
+(defthm turing1-machinep-tm-to-tm1
+  (implies (and (natp w)
+                (turing-machinep tm)
+                (total-map tm map)
+                (natp-map map)
+                (<= (max-width tm map) w))
+           (turing1-machinep (tm-to-tm1 tm map) w)))
+
+(defthm total-map-renaming-map-top
+  (total-map tm (renaming-map st tm)))
+
+(defthm cdr-assoc-renaming-map-upperbound
+  (< (cdr (assoc st (renaming-map st tm)))
+     (expt 2 (max-width1 (tm-to-tm1 tm (renaming-map st tm))))))
+
+
+; Wow!  Ok, this is the theorem that shows that there is a way to start tmi3!
+; so that it computes the same thing (modulo tape representation conversion) as
+; tmi.  In particular, this theorem rewrites tmi3 calls to tmi calls.  The 0th
+; result is 1 or 0 depending on whether tmi terminates and the 2nd and 3rd
+; results are the corresponding parts of converting tmi's output from tape form
+; to tapen and pos form.
+
+(defthm tmi3-is-tmi
+  (implies
+   (and (symbolp st)
+        (tapep tape)
+        (turing-machinep tm))
+   (and
+    (equal
+     (mv-nth 0
+             (tmi3 (cdr (assoc st (renaming-map st tm)))
+                   (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                   (mv-nth 1 (convert-tape-to-tapen-pos tape))
+                   (ncode (tm-to-tm1 tm (renaming-map st tm))
+                          (max-width1 (tm-to-tm1 tm (renaming-map st tm))))
+                   (max-width1 (tm-to-tm1 tm (renaming-map st tm)))
+                   n))
+     (if (tmi st tape tm n) 1 0))
+    (implies
+     (tmi st tape tm n)
+     (and (equal (mv-nth 2
+                         (tmi3 (cdr (assoc st (renaming-map st tm)))
+                               (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                               (mv-nth 1 (convert-tape-to-tapen-pos tape))
+                               (ncode (tm-to-tm1 tm (renaming-map st tm))
+                                      (max-width1 (tm-to-tm1 tm (renaming-map st tm))))
+                               (max-width1 (tm-to-tm1 tm (renaming-map st tm)))
+                               n))
+                 (mv-nth 0
+                         (convert-tape-to-tapen-pos (tmi st tape tm n))))
+          (equal (mv-nth 3
+                         (tmi3 (cdr (assoc st (renaming-map st tm)))
+                               (mv-nth 0 (convert-tape-to-tapen-pos tape))
+                               (mv-nth 1 (convert-tape-to-tapen-pos tape))
+                               (ncode (tm-to-tm1 tm (renaming-map st tm))
+                                      (max-width1 (tm-to-tm1 tm (renaming-map st tm))))
+                               (max-width1 (tm-to-tm1 tm (renaming-map st tm)))
+                               n))
+                 (mv-nth 1
+                         (convert-tape-to-tapen-pos (tmi st tape tm n))))))))
+           
+  :hints (("Goal" :do-not-induct t :in-theory (disable renaming-map))
+          ("Goal''" :use (:instance tapep-tmi2
+                                    (st (cdr (assoc st (renaming-map st tm))))
+                                    (w (max-width1 (tm-to-tm1 tm (renaming-map st tm))))
+                                    (tm (ncode (tm-to-tm1 tm (renaming-map st tm))
+                                               (max-width1 (tm-to-tm1 tm (renaming-map st tm)))))))))
+
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/models/jvm/guard-verified-m1/turing-equivalence-talk.pdf and /tmp/b2KjCbRUvz/acl2-6.3/books/models/jvm/guard-verified-m1/turing-equivalence-talk.pdf differ
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/use-when.acl2 acl2-6.3/books/models/jvm/guard-verified-m1/use-when.acl2
--- acl2-6.2/books/models/jvm/guard-verified-m1/use-when.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/use-when.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,5 @@
+; Since "m1" includes "good-statep", which includes "use-when", then
+; "use-when" should not include "m1".  So we create this file in order
+; to override the use of cert.acl2, which would include "m1".
+
+(certify-book "use-when")
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/use-when.lisp acl2-6.3/books/models/jvm/guard-verified-m1/use-when.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/use-when.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/use-when.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,175 @@
+; The Use-When Event
+; J Strother Moore
+; March, 2013
+
+; (certify-book "use-when")
+
+; This book is adds a default computed hint that automatically adds an instance
+; of a named theorem to any goal in which certain annotated patterns appear.
+; Each pattern must be fully translated.  Each pattern must be annotated with
+; one of the three labels :hyp, :lit, or :subterm, which specify whether the
+; pattern is to occur as a hypothesis, a literal, or any subterm.  (We negate
+; :hyp patterns and then look for a :lit occurrence.)  The patterns are matched
+; sequentially, each extending the substitution produced by the last match.  So
+; if asked to match
+
+; patterns:  (f x y) (g y z)
+
+; goal:      (FOO (f A B) (f C D) (g D E))
+
+; we would use the substitution ((x . C) (y . D) (z . E))
+
+; As an example of need for this event, suppose we've defined instructionp and programp
+; so that a programp is a list of elements satisfying instructionp.  That is,
+; (programp lst) is (forall e \in lst : (instructionp e)).  Then this is a nice
+; lemma:
+
+; (defthm instructionp-nth
+;   (implies (and (programp lst)
+;                 (natp pc)
+;                 (< pc (len lst)))
+;            (instructionp (nth pc lst))))
+
+; But if instructionp splits into many cases, e.g., one for each family or type
+; of instruction, then this lemma is of little use as a :rewrite or
+; :forward-chaining rule when executing, say, an ILOAD instruction.  Instead,
+; we need to add (instructionp ...) to the hypotheses as soon as we realize we
+; are looking at the (nth pc lst) where lst is a programp.  That way, the
+; rewriter can expand (instructionp ...) and pick out what we know for ILOAD
+; instructions.
+
+; To cause this behavior we could use this event:
+
+;  (use-when instructionp-nth
+;            ((:hyp (programp lst))
+;             (:subterm (nth pc lst)))
+;            nil)
+
+; The last argument to use-when is the initial substitution.  For example, if
+; we wanted to restrict this behavior to the case where lst was always bound to
+; (program s), we could use:
+
+;  (use-when instructionp-nth
+;            ((:hyp (programp lst))
+;             (:subterm (nth pc lst)))
+;            ((lst . (program s))))
+
+; We can also use the initial alist to specify free vars.
+
+(in-package "ACL2")
+
+(program)
+
+; The following is based on code taken from :DOC using-computed-hints-4.  Here
+; we find all instances of pat (extending alist) in term and accumulate the
+; resulting substitutions into ans.  The value is a list of alists.
+
+(mutual-recursion
+ 
+ (defun find-all-subterm-instances (pat term alist ans)
+   (mv-let
+    (instancep alist)
+    (one-way-unify1 pat term alist)
+
+; Note that we exploit the fact that one-way-unify1 is a ``no-change loser''
+; meaning that if instancep is nil, the returned alist is the initial alist
+; (not some intermediate result formed before we detected the impossibility of
+; a match here).
+
+    (let ((ans (if instancep (add-to-set-equal alist ans) ans)))
+      (cond
+       ((variablep term) ans)
+       ((fquotep term) ans)
+       (t ; We treat lambda applications just like other function applications.
+        (find-all-subterm-instances-list pat (fargs term) alist ans))))))
+
+ (defun find-all-subterm-instances-list (pat list-of-terms alist ans)
+   (cond
+    ((endp list-of-terms) ans)
+    (t (find-all-subterm-instances
+        pat
+        (car list-of-terms)
+        alist
+        (find-all-subterm-instances-list pat
+                                         (cdr list-of-terms)
+                                         alist
+                                         ans))))))
+
+(defun find-all-element-instances (pat list-of-terms alist ans)
+  (cond ((endp list-of-terms) ans)
+        (t (mv-let (instancep alist1)
+                   (one-way-unify1 pat (car list-of-terms) alist)
+                   (find-all-element-instances pat (cdr list-of-terms) alist
+                                               (if instancep
+                                                   (add-to-set-equal alist1 ans)
+                                                   ans))))))
+
+(mutual-recursion
+
+ (defun find-all-annotated-pattern-instances (apats clause alist ans)
+   (cond ((endp apats) (add-to-set-equal alist ans))
+         ((or (eq (car (car apats)) :hyp)
+              (eq (car (car apats)) :lit))
+          (let* ((lit (if (eq (car (car apats)) :hyp)
+                          (dumb-negate-lit (cadr (car apats)))
+                          (cadr (car apats))))
+                 (ans1 (find-all-element-instances lit clause alist nil)))
+            (loop-find-all-annotated-pattern-instances (cdr apats) clause ans1 ans)))
+         (t ; find subterms
+          (let* ((term (cadr (car apats)))
+                 (ans1 (find-all-subterm-instances term clause alist nil)))
+            (loop-find-all-annotated-pattern-instances (cdr apats) clause ans1 ans)))))
+
+ (defun loop-find-all-annotated-pattern-instances (apats clause alists ans)
+   (cond ((endp alists) ans)
+         (t (loop-find-all-annotated-pattern-instances
+             apats clause (cdr alists)
+             (find-all-annotated-pattern-instances apats clause (car alists) ans))))))
+
+; We now turn our attention to converting a list of substitutions into a list
+; of lemma instances, each of the form
+
+; (:INSTANCE name (var1 term1) ... (vark termk))
+
+; as written in :use hints. In the code shown above, substitutions are lists of
+; pairs of the form (var . term), but in lemma instances we must write
+; ``doublets.'' So here we show how to convert from one to the other:
+
+(defun pairs-to-doublets (alist)
+  (cond ((null alist) nil)
+        (t (cons (list (caar alist) (cdar alist))
+                 (pairs-to-doublets (cdr alist))))))
+
+(defun all-lemma-instances (name alists)
+  (cond ((endp alists) nil)
+        (t (cons `(:instance ,name ,@(pairs-to-doublets (car alists)))
+                 (all-lemma-instances name (cdr alists))))))
+
+(defun use-when-fn (name annotated-patterns alist clause)
+  (let ((alists
+         (loop-find-all-annotated-pattern-instances
+          annotated-patterns clause (list alist) nil)))
+    (if (null alists)
+        nil
+        `(:USE ,(all-lemma-instances name alists)))))
+
+(defun flat-annotationsp (lst)
+  (cond ((atom lst) (equal lst nil))
+        ((atom (cdr lst)) nil)
+        ((member (car lst) '(:hyp :lit :subterm))
+         (flat-annotationsp (cddr lst)))
+        (t nil)))
+
+(defun flat-annotations-to-doublets (lst)
+  (cond ((endp lst) nil)
+        (t (cons (list (car lst) (cadr lst))
+                 (flat-annotations-to-doublets (cddr lst))))))
+
+(defmacro use-when (name alist &rest flat-apats)
+  (declare (xargs :guard (and (symbolp name)
+                              (alistp alist)
+                              (flat-annotationsp flat-apats))))
+  `(add-default-hints
+    '((use-when-fn ',name ',(flat-annotations-to-doublets flat-apats) ',alist clause))))
+
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/verify-guards.lisp acl2-6.3/books/models/jvm/guard-verified-m1/verify-guards.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/verify-guards.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/verify-guards.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,410 @@
+#||
+
+See the README file on this directory for an overview of this work.
+
+In this file I verify the guards on the M1 model.  The guards are exhibited in
+the function definitions presented in m1.lisp and the functions used to express
+the guards are defined in good-statep.lisp.  All of the functions in
+good-statep.lisp are already guard verified.
+
+To play:
+
+; (include-book "m1")
+; (ld "verify-guards.lisp" :ld-pre-eval-print t)
+
+To recertify:
+
+; (include-book "m1")
+; (certify-book "verify-guards" 1)
+
+||#
+
+(in-package "M1")
+
+; These functions are left disabled by "m1.lisp" so that that book alone can be
+; used to verify code.  But to verify the guards of these functions we need to
+; have them enabled.  We re-disable them at the end of this book.
+
+(in-theory (enable make-state pc locals stack program step m1))
+
+; -----------------------------------------------------------------
+; Stack Manipulation
+
+; A stack is a true-list of rationals.  Here we show the consequences of this.
+
+(defthm stackp-implies-true-listp
+  (implies (stackp x)
+           (true-listp x)))
+
+(defthm stackp-push
+  (implies (and (rationalp x) (stackp y))
+           (stackp (push x y)))
+  :hints (("Goal" :in-theory (enable push))))
+
+(defthm integerp-top
+  (implies (and (stackp x) (not (equal x nil)))
+           (rationalp (top x)))
+  :hints (("Goal" :in-theory (enable top))))
+
+; ---  horrible lemmas for a user to have to state ---
+
+(defthm integerp-+
+  (implies (and (rationalp x)
+                (rationalp y))
+           (rationalp (+ x y))))
+
+(defthm rationalp--
+  (implies (rationalp x)
+           (rationalp (- x))))
+
+; --- end of horrible lemmas ---
+
+(defthm stackp-pop
+  (implies (stackp x) (stackp (pop x)))
+  :hints (("Goal" :in-theory (enable pop))))
+
+; -----------------------------------------------------------------
+; The Locals of a State
+
+; The locals must be a list of integers.  This is equivalent to stackp but
+; we'll define it separately for sanity.
+
+(defthm localsp-implies-true-listp
+  (implies (localsp x)
+           (true-listp x)))
+
+(defthm localsp-nth
+  (implies (and (localsp lst)
+                (natp i)
+                (< i (len lst)))
+           (rationalp (nth i lst))))
+
+(defthm localsp-update-nth
+  (implies (and (natp i)
+                (rationalp v)
+                (localsp x)
+                (< i (len x)))
+           (localsp (update-nth i v x))))
+
+(defthm len-update-nth-new
+  (implies (and (natp i)
+                (< i (len x)))
+           (equal (len (update-nth i v x)) (len x))))
+
+; -----------------------------------------------------------------
+; Instruction Well-Formedness
+
+(in-theory (disable make-state
+                    (:executable-counterpart make-state)
+                    pc locals stack program))
+
+; -----------------------------------------------------------------
+; Computing a Stack Map
+
+; We need a couple of key lemmas about csm: ``Property 1'' is that if pc is
+; legal and (csm program stack-map) is true and (nth pc program) is
+; an IADD [say], then 2 <= (cdr (assoc pc stack-map)).  Of course, we need the
+; analogous theorem for IADD, ISUB, IMUL, ISTORE, and IFEQ.
+
+; ``Property 2'' is that if (nth pc program) is an IADD [say] then the stack
+; map at (+ 1 pc) is one greater than at pc.
+
+; Our approach is first to prove inductive versions of properties 1 and 2 for
+; csm1, making the resulting general theorem :rule-classes nil.  Then, we
+; instantiate each of the general properties for specific opcodes.  We start with
+; property 1 and then do property 2.
+
+(defthm csm1-property-1
+  (implies (and (natp i)
+                (natp pc)
+                (<= i pc)
+                (< pc (len program))
+                (csm1 i program stack-map))
+           (<= (case (op-code (nth pc program))
+                 ((ISTORE IFEQ) 1)
+                 ((IADD ISUB IMUL) 2)
+                 (otherwise 0))
+               (cdr (assoc-equal pc stack-map))))
+  :rule-classes nil)
+
+(defthm csm-IADD-ISUB-IMUL-property-1
+  (implies (and (csm (program s) stack-map)
+                (pcp (pc s) (len (program s)))
+                (member (op-code (nth (pc s) (program s))) '(IADD ISUB IMUL)))
+           (<= 2 (cdr (assoc (pc s) stack-map))))
+  :hints (("Goal" :in-theory (enable csm)
+           :use (:instance csm1-property-1
+                           (i 0)
+                           (pc (pc s))
+                           (program (program s))
+                           (stack-map stack-map))))
+  :rule-classes :linear)
+
+(defthm csm-ISTORE-IFEQ-property-1
+  (implies (and (csm (program s) stack-map)
+                (pcp (pc s) (len (program s)))
+                (member (op-code (nth (pc s) (program s))) '(ISTORE IFEQ)))
+           (<= 1 (cdr (assoc (pc s) stack-map))))
+  :hints (("Goal" :in-theory (enable csm)
+                  :use (:instance csm1-property-1
+                                  (i 0)
+                                  (pc (pc s))
+                                  (program (program s))
+                                  (stack-map stack-map))))
+  :rule-classes :linear)
+
+(defthm csm1-property-2
+  (implies (and (natp i)
+                (natp pc)
+                (<= i pc)
+                (< pc (len program))
+                (csm1 i program stack-map))
+           (and (implies (equal (op-code (nth pc program)) 'GOTO)
+                         (and (assoc (+ pc (arg1 (nth pc program))) stack-map)
+                              (equal (cdr (assoc pc stack-map))
+                                     (cdr (assoc (+ pc (arg1 (nth pc program))) stack-map)))))
+                (implies (equal (op-code (nth pc program)) 'IFEQ)
+                         (and (assoc (+ pc (arg1 (nth pc program))) stack-map)
+                              (assoc (+ 1 pc) stack-map)
+                              (equal (+ -1 (cdr (assoc pc stack-map)))
+                                     (cdr (assoc (+ pc (arg1 (nth pc program))) stack-map)))
+                              (equal (+ -1 (cdr (assoc pc stack-map)))
+                                     (cdr (assoc (+ 1 pc) stack-map)))))
+                (implies (member (op-code (nth pc program))
+                                      '(ILOAD ICONST))
+                         (and (assoc (+ 1 pc) stack-map)
+                              (equal (+ 1 (cdr (assoc pc stack-map)))
+                                     (cdr (assoc (+ 1 pc) stack-map)))))
+                (implies (member (op-code (nth pc program))
+                                      '(IADD ISUB IMUL ISTORE))
+                         (and (assoc (+ 1 pc) stack-map)
+                              (equal (+ -1 (cdr (assoc pc stack-map)))
+                                     (cdr (assoc (+ 1 pc) stack-map)))))))
+  :rule-classes nil)
+
+(defthm csm-GOTO-property-2
+  (implies (and (csm (program s) stack-map)
+                (pcp (pc s) (len (program s)))
+                (equal (op-code (nth (pc s) (program s))) 'GOTO))
+           (and (assoc (+ (pc s) (arg1 (nth (pc s) (program s)))) stack-map)
+                (equal (cdr (assoc (+ (pc s) (arg1 (nth (pc s) (program s)))) stack-map))
+                       (cdr (assoc (pc s) stack-map)))))
+  :hints (("Goal" :in-theory (e/d (csm) (csm1))
+                  :use (:instance csm1-property-2
+                                  (i 0)
+                                  (pc (pc s))
+                                  (program (program s))
+                                  (stack-map stack-map)))))
+
+(defthm csm-IFEQ-property-2
+  (implies (and (csm (program s) stack-map)
+                (pcp (pc s) (len (program s)))
+                (equal (op-code (nth (pc s) (program s))) 'IFEQ))
+           (and (assoc (+ (pc s) (arg1 (nth (pc s) (program s)))) stack-map)
+                (assoc (+ 1 (pc s)) stack-map)
+                (equal (cdr (assoc (+ (pc s) (arg1 (nth (pc s) (program s)))) stack-map))
+                       (+ -1 (cdr (assoc (pc s) stack-map))))
+                (equal (cdr (assoc (+ 1 (pc s)) stack-map))
+                       (+ -1 (cdr (assoc (pc s) stack-map))))))
+  :hints (("Goal" :in-theory (e/d (csm) (csm1))
+           :use (:instance csm1-property-2
+                           (i 0)
+                           (pc (pc s))
+                           (program (program s))
+                           (stack-map stack-map)))))
+
+(defthm csm-ILOAD-ICONST-property-2
+  (implies (and (csm (program s) stack-map)
+                (pcp (pc s) (len (program s)))
+                (member (op-code (nth (pc s) (program s))) '(ILOAD ICONST)))
+           (and (assoc (+ 1 (pc s)) stack-map)
+                (equal (cdr (assoc (+ 1 (pc s)) stack-map))
+                       (+ 1 (cdr (assoc (pc s) stack-map))))))
+  :hints (("Goal" :in-theory (e/d (csm) (csm1))
+           :use (:instance csm1-property-2
+                           (i 0)
+                           (pc (pc s))
+                           (program (program s))
+                           (stack-map stack-map)))))
+
+(defthm csm-IADD-ISUB-IMUL-ISTORE-property-2
+  (implies (and (csm (program s) stack-map)
+                (pcp (pc s) (len (program s)))
+                (member (op-code (nth (pc s) (program s))) '(IADD ISUB IMUL ISTORE)))
+           (and (assoc (+ 1 (pc s)) stack-map)
+                (equal (cdr (assoc (+ 1 (pc s)) stack-map))
+                       (+ -1 (cdr (assoc (pc s) stack-map))))))
+  :hints (("Goal" :in-theory (e/d (csm) (csm1))
+           :use (:instance csm1-property-2
+                           (i 0)
+                           (pc (pc s))
+                           (program (program s))
+                           (stack-map stack-map)))))
+
+
+; -----------------------------------------------------------------
+; Well-Formed States
+
+; Note on strategy:
+
+; After admitting and proving the guards of an instruction's semantic function,
+; I will prove that the instruction preserves good-statep.  I do this for each
+; semantic function.  When that is done, I'll temporarily disable all the
+; semantic functions (so lemmas about them are available) and prove the theorem
+; that do-inst satisfies its guard and preserves good-statep.  Then I do repeat
+; that for step and the M1 interpreter.
+
+; In a model as small as M1 it is just as practical to NOT prove the
+; preservation property for each instruction, and just do it all at once when
+; we prove it for step.  One advantage of doing it the structured way, as done
+; here, is that it enables the discovery of the necessary lemmas (e.g.,
+; len-push above) in a manageable way.  We would get a lot of failures on the
+; proof of good-statep-step if we hadn't already proved the necessary lemmas
+; for each instruction.  So we are modularizing the proof discovery process
+; too.
+
+; The functions below marked redundant were actually guard verified in
+; good-statep.lisp.  They're listed here just to remind the user that we must
+; verify the guards of every function used in the model.
+
+(verify-guards push)
+(verify-guards top)
+(verify-guards pop)
+(verify-guards nth)         ; redundant
+(verify-guards update-nth)
+(verify-guards op-code)     ; redundant
+(verify-guards arg1)        ; redundant
+(verify-guards arg2)
+(verify-guards arg3)
+(verify-guards make-state)
+(verify-guards pc)          ; redundant
+(verify-guards locals)      ; redundant
+(verify-guards stack)       ; redundant
+(verify-guards program)     ; redundant
+(verify-guards next-inst)
+
+; To verify the guards on the individual instructions we need the same basic
+; ``use-when'' machinery set up in good-statep.
+
+(acl2::use-when instructionp-nth         ; lemma name
+                nil                      ; initial substitution
+                :hyp (programp lst)      ; patterns to look for as
+                :subterm (nth pc lst))
+
+(acl2::use-when next-pc-okp-nth
+                ((pc . '0))
+                :hyp (all-pcs-okp program pc)
+                :subterm (nth i program))
+
+(verify-guards ok-to-step)
+
+(verify-guards execute-ILOAD)
+(defthm good-statep-ILOAD
+  (implies (and (good-statep s)
+                (equal (op-code (nth (pc s) (program s))) 'ILOAD))
+           (good-statep (execute-ILOAD (nth (pc s) (program s)) s))))
+
+(verify-guards execute-ICONST)
+(defthm good-statep-ICONST
+  (implies (and (good-statep s)
+                (equal (op-code (nth (pc s) (program s))) 'ICONST))
+           (good-statep (execute-ICONST (nth (pc s) (program s)) s))))
+
+(defthm top-guards-1
+  (implies (and (stackp stk)
+                (< 0 (len stk)))
+           (and (rationalp (top stk))
+                (stackp (pop stk))))
+  :hints (("Goal" :in-theory (enable stackp top pop))))
+
+(defthm top-guards-2
+  (implies (and (stackp stk)
+                (< 1 (len stk)))
+           (and (rationalp (top stk))
+                (consp (pop stk))
+                (rationalp (top (pop stk)))
+                (stackp (pop (pop stk)))))
+  :hints (("Goal" :in-theory (enable stackp top pop))))
+
+(verify-guards execute-IADD)
+
+(defthm len-pop
+  (equal (len x)
+         (if (endp x)
+             0
+             (+ 1 (len (pop x)))))
+  :hints (("Goal" :in-theory (enable pop)))
+  :rule-classes (:definition))
+
+(defthm good-statep-IADD
+  (implies (and (good-statep s)
+                (equal (op-code (nth (pc s) (program s))) 'IADD))
+           (good-statep (execute-IADD (nth (pc s) (program s)) s))))
+
+(verify-guards execute-ISUB)
+(defthm good-statep-ISUB
+  (implies (and (good-statep s)
+                (equal (op-code (nth (pc s) (program s))) 'ISUB))
+           (good-statep (execute-ISUB (nth (pc s) (program s)) s))))
+
+(verify-guards execute-IMUL)
+(defthm good-statep-IMUL
+  (implies (and (good-statep s)
+                (equal (op-code (nth (pc s) (program s))) 'IMUL))
+           (good-statep (execute-IMUL (nth (pc s) (program s)) s))))
+
+(verify-guards execute-ISTORE)
+(defthm good-statep-ISTORE
+  (implies (and (good-statep s)
+                (equal (op-code (nth (pc s) (program s))) 'ISTORE))
+           (good-statep (execute-ISTORE (nth (pc s) (program s)) s))))
+
+(verify-guards execute-GOTO)
+(defthm good-statep-GOTO
+  (implies (and (good-statep s)
+                (equal (op-code (nth (pc s) (program s))) 'GOTO))
+           (good-statep (execute-GOTO (nth (pc s) (program s)) s))))
+
+(verify-guards execute-IFEQ)
+(defthm good-statep-IFEQ
+  (implies (and (good-statep s)
+                (equal (op-code (nth (pc s) (program s))) 'IFEQ))
+           (good-statep (execute-IFEQ (nth (pc s) (program s)) s))))
+
+(verify-guards do-inst)
+
+; We don't bother to prove that do-inst, when applied to the next-inst,
+; preserves good-statep.  Instead we will do it ``in place'' when we verify the
+; corresponding theorem for step.
+
+(verify-guards step)
+
+; The in-theory hint is not necessary below but is good hygine, since we have
+; already proved the preservation property for each opcode.
+
+(in-theory (disable good-statep))
+
+(defthm good-statep-step
+  (implies (good-statep s)
+           (good-statep (step s)))
+  :hints
+  (("Goal" :in-theory (disable execute-ILOAD
+                               execute-ICONST
+                               execute-IADD
+                               execute-ISUB
+                               execute-IMUL
+                               execute-ISTORE
+                               execute-GOTO
+                               execute-IFEQ))))
+
+(in-theory (disable step))
+
+(verify-guards m1)
+(defthm good-statep-m1
+  (implies (good-statep s)
+           (good-statep (m1 s n))))
+
+(in-theory (enable good-statep))
+
+(verify-guards haltedp)
+
diff -Nru acl2-6.2/books/models/jvm/guard-verified-m1/wormhole-abstraction.lisp acl2-6.3/books/models/jvm/guard-verified-m1/wormhole-abstraction.lisp
--- acl2-6.2/books/models/jvm/guard-verified-m1/wormhole-abstraction.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/guard-verified-m1/wormhole-abstraction.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,197 @@
+; Correctness of Fact via Wormhole Abstraction
+
+; Problem: Define an M1 program to compute the factorial of its natural number
+; input.  Prove your program correct without specifying what happens to some
+; variables.  Acknowledgement: This approach to code proofs was first developed
+; by Dave Greve at Rockwell Collins Inc, who named the technique ``wormhole
+; abstraction'' because the expressions defining the values of the variables we
+; don't care about are hidden from sight.  In essence, wormhole abstraction
+; characters the value of the uninteresting variables by saying ``they are what
+; they are'' or ``their values are whatever the machine computes'' instead of
+; characterizing them algebraically or extensionally.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; (1) Write your specification, i.e., define the expected inputs and the
+; desired output, theta.
+
+(defun ok-inputs (n)
+  (natp n))
+
+(defun ! (n)
+  (if (zp n)
+      1
+      (* n (! (- n 1)))))
+
+(defun theta (n)
+  (! n))
+
+; (2) Write your algorithm.  This will consist of a tail-recursive helper
+; function and a wrapper, fn.
+
+(defun helper (n a)
+  (if (zp n)
+      a
+      (helper (- n 1) (* n a))))
+
+(defun fn (n) (helper n 1))
+
+; (3) Prove that the algorithm satisfies the spec, by proving first that the
+; helper is appropriately related to theta and then that fn is theta on ok
+; inputs.
+
+; Important Note: When you verify your helper function, you must consider the
+; most general case.  For example, if helper is defined with formal parameters
+; n and a and fn calls helper initializing a to 0, your helper theorem must
+; be about (helper n a), not just about the special case (helper n 0).
+
+(defthm helper-is-theta
+  (implies (and (ok-inputs n)
+                (natp a))
+           (equal (helper n a)
+                  (* a (theta n)))))
+
+(defthm fn-is-theta
+  (implies (ok-inputs n)
+           (equal (fn n)
+                  (theta n))))
+
+; Disable these two lemmas because they confuse the theorem prover when it is
+; dealing with the code versus fn.
+
+(in-theory (disable helper-is-theta fn-is-theta))
+
+; (4) Write your M1 program with the intention of implementing your algorithm.
+; This program implements fact a little oddly: it uses a temporary variable,
+; local 2, that is otherwise unimportant.
+
+(defconst *pi*
+  '((iconst 1)  ;  0
+    (istore 1)  ;  1
+    (iload 0)   ;  2
+    (ifeq 12)   ;  3
+    (iload 0)   ;  4
+    (istore 2)  ;  5
+    (iload 0)   ;  6
+    (iconst 1)  ;  7
+    (isub)      ;  8
+    (istore 0)  ;  9
+    (iload 2)   ; 10
+    (iload 1)   ; 11
+    (imul)      ; 12
+    (istore 1)  ; 13
+    (goto -12)  ; 14
+    (iload 1)   ; 15
+    (halt))     ; 16
+  )
+
+; (5) Define the ACL2 function that clocks your program, starting with the
+; loop clock and then using it to clock the whole program.  The clock
+; should take the program from pc 0 to a HALT statement.  (Sometimes your
+; clocks will require multiple inputs or other locals, but our example only
+; requires the first local.)
+
+(defun loop-clk (n)
+  (if (zp n)
+      3
+      (clk+ 13
+            (loop-clk (- n 1)))))
+
+(defun clk (n)
+  (clk+ 2
+        (loop-clk n)))
+
+; (6) Prove that the code implements your algorithm, starting with the lemma
+; that the loop implements the helper.  Each time you prove a lemma relating
+; code to algorithm, disable the corresponding clock function so the theorem
+; prover doesn't look any deeper into subsequent code.
+
+; Important Note: Your lemma about the loop must consider the general case.
+; For example, if the loop uses the locals n and a, you must characterize
+; its behavior for arbitrary, legal n and a, not just a special case (e.g.,
+; where a is 0).
+
+(defun poised-to-loop (n s)
+  (and (acl2::true-listp s)
+       (equal (len s) 4)
+       (equal (pc s) 2)
+       (equal (program s) *pi*)
+       (equal n (nth 0 (locals s)))
+       (natp n)
+       (natp (nth 1 (locals s)))))
+
+(defun loop-hint (n s)
+  (if (zp n)
+      (list n s)
+      (loop-hint (- n 1)
+                 (m1 s 13))))
+
+(defthm about-make-state
+  (and (acl2::true-listp (make-state pc locs stk prog))
+       (equal (len (make-state pc locs stk prog)) 4))
+  :hints (("Goal" :in-theory (enable make-state))))
+
+
+(defun fact-loop-locals (n s)
+  (locals (m1 s (loop-clk n))))
+
+(defthm fact-loop-thm
+  (implies (poised-to-loop n s)
+           (equal (m1 s (loop-clk n))
+                  (make-state 16
+                              (if (zp n)
+                                  (locals s)
+                                  (update-nth 2
+                                              1
+                                              (fact-loop-locals n s)))
+                              (push (helper (nth 0 (locals s))
+                                            (nth 1 (locals s)))
+                                    (stack s))
+                              *pi*)))
+  :hints (("Goal" :induct (loop-hint n s))))
+
+(in-theory (disable loop-clk fact-loop-locals))
+
+(defun poised-for-fact (n s)
+  (and (acl2::true-listp s)
+       (equal (len s) 4)
+       (equal (pc s) 0)
+       (equal (program s) *pi*)
+       (equal n (nth 0 (locals s)))
+       (natp n)))
+
+(defun fact-locals (n s)
+  (locals (m1 s (clk n))))
+
+(defthm fact-thm
+  (implies (poised-for-fact n s)
+           (equal (m1 s (clk n))
+                  (make-state 16
+                              (fact-locals n s)
+                              (push (fn (nth 0 (locals s)))
+                                    (stack s))
+                              *pi*))))
+
+(in-theory (disable clk fact-locals))
+
+; (7) Put the two steps together to get correctness.
+
+(in-theory (enable fn-is-theta))
+
+; This corollary just shows we did what we set out to do:
+
+(defthm total-correctness
+  (implies (and (natp n)
+                (equal sf (m1 (make-state 0
+                                          (list n)
+                                          nil
+                                          *pi*)
+                              (clk n))))
+           (and (equal (next-inst sf) '(HALT))
+                (equal (top (stack sf))
+                       (! n))))
+  :rule-classes nil)
+
diff -Nru acl2-6.2/books/models/jvm/m1/README acl2-6.3/books/models/jvm/m1/README
--- acl2-6.2/books/models/jvm/m1/README	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/models/jvm/m1/README	2013-09-30 17:53:30.000000000 +0000
@@ -3,7 +3,7 @@
 December, 2012
 
 On this directory you will find a definition of a simple von Neumann machine
-called M1, the proofs of the correctness of 18 simple M1 programs, and a proof
+called M1, the proofs of the correctness of 19 simple M1 programs, and a proof
 that M1 is Turing equivalent.  M1 is an idealized version of a trivial subset
 of the Java Virtual Machine.  A highlight of the Turing equivalent proof is the
 definition and use of a verifying compiler from a simple subset of Lisp to M1.
@@ -178,6 +178,47 @@
 * sumsq.lisp
 * wormhole-abstraction.lisp
 
+All of the proofs above use the Boyer-Moore ``clock function'' approach to
+total program correctness.  In each example, a function is defined that takes
+the relevant inputs to the program and returns the minimum number of steps
+required to drive the M1 interpreter to halt on those inputs.  Then the theorem
+is proved that when the program is run that many steps on appropriate input the
+result is a halted state with the correct answer in the location specified.
+I use that style because it is easy for students to grasp and apply.  (And,
+as shown in
+
+  ``Proof Styles in Operational Semantics,'' with S. Ray, Formal Methods in
+  Computer-Aided Design (FMCAD 2004), A. J. Hu and A. K. Martin (eds.),
+  Springer Lecture Notes in Computer Science, 3312, pages 67-81, 2004.
+
+  http://www.cs.utexas.edu/users/sandip/publications/proof-styles/main.html
+
+the clock style proof method is equivalent to (indeed, interchangeable with)
+other proof styles.  The clock style approach is in fact used to verify the
+Turing equivalence of M1, described below.
+
+But I also demonstrate here how ACL2 can be used to verify M1 programs via
+the Floyd-Hoare inductive assertion style proofs.  As noted in the paper
+
+  ``Inductive Assertions and Operational Semantics,'' CHARME 2003,
+  D. Geist (ed.), Springer Verlag LNCS 2860, pp. 289-303, 2003
+
+  http://www.cs.utexas.edu/users/moore/publications/trecia/index.html
+
+it is possible to use the inductive assertion style proof method with a formal
+operational semantics without defining a weakest precondition or verification
+condition generator (VCG).  Instead, the theorem prover's rewriter can derive
+the required verification conditions from the code and semantics given
+user-supplied annotations attached to suitable cut points.  This is demonstrated
+for M1 in this file:
+
+* m1-half-via-inductive-assertions.lisp
+
+where I prove that an M1 program divides an even natural by 2 and halts,
+without characterizing how long it takes.  I prove that if the program halts
+the input was even, which also means: if the input is not even the program does
+not halt.
+
 The Turing Equivalence of M1: The following files prove that M1 can simulate a
 Turing machine interpreter.  To do this, I write an M1 program that interprets
 an encoding of arbitrary Turing machines and then I prove the program correct.
diff -Nru acl2-6.2/books/models/jvm/m1/m1-half-via-inductive-assertions.acl2 acl2-6.3/books/models/jvm/m1/m1-half-via-inductive-assertions.acl2
--- acl2-6.2/books/models/jvm/m1/m1-half-via-inductive-assertions.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/m1/m1-half-via-inductive-assertions.acl2	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,2 @@
+(include-book "models/jvm/m1/m1" :dir :system)
+(certify-book "m1-half-via-inductive-assertions" 1)
diff -Nru acl2-6.2/books/models/jvm/m1/m1-half-via-inductive-assertions.lisp acl2-6.3/books/models/jvm/m1/m1-half-via-inductive-assertions.lisp
--- acl2-6.2/books/models/jvm/m1/m1-half-via-inductive-assertions.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/jvm/m1/m1-half-via-inductive-assertions.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,294 @@
+; Correctness of Fact
+
+; Problem: Define an M1 program to halve its integer input, at least when that
+; input is even.  Prove that the if the program reaches its HALT then the input
+; was even and the correct answer is left on the stack.
+
+; Design Plan: I will count n down to 0 by 2 and increment an accumulator, a,
+; initially 0.
+
+; Proof Plan: I will use the inductive assertion method described in ``Inductive
+; Assertions and Operational Semantics,'' J Strother Moore, CHARME 2003, D. Geist
+; (ed.), Springer Verlag LNCS 2860, pp. 289-303, 2003, the long version of which
+; can be found here:
+
+; http://www.cs.utexas.edu/users/moore/publications/trecia/long.pdf
+
+; That paper illustrates the technique on the M5 model of the JVM.  This is a
+; recapitulation of that same script, except for M1.  In this book I actually
+; do the proof twice.  The first time I transcribe the events in Sections 4
+; through 9 of that paper.  Then I define the macro described in Section 10 of
+; that paper and invoke the macro, which automatically does all of the events
+; in Sections 4--9, with slightly different names to avoid redundancy.
+
+; In this presentation I only give the section headers of the various sections
+; and provide no commentary, since the paper is self-explanatory.  However,
+; because the M5 model is different from M1, some things have changed.  Three
+; differences manifest themselves: M5 supports only 32-bit integers and so the
+; assertions in the paper have to accommodate that limitation; M1 supports
+; unbounded integers.  M5 supports threads and the theorem proved in the paper
+; limits the execution trace to a single active thread; M1 is a uniprocessor.
+; And sthe program counter on M5 counts bytes whereas on M1 it counts
+; instructions, so some of the program counters mentioned are different than
+; those in the paper, e.g., the HALT is at pc 17 in the paper but at pc 14
+; here.  Finally, the program verified in the paper leaves the final answer in
+; local 1, whereas here I chose to push it onto the stack, for uniformity with
+; the other M1 programs verified in this collection.
+
+; (0) Start ACL2
+; (include-book "m1")
+
+(in-package "M1")
+
+; Section 4:  An Iterative Program
+
+(defconst *pi*
+  '((ICONST 0) ; 0
+    (ISTORE 1) ; 1 a := 0
+    (ILOAD 0)  ; 2 top of loop:
+    (IFEQ 10)  ; 3 if n=0, goto 13
+    (ILOAD 1)  ; 4
+    (ICONST 1) ; 5
+    (IADD)     ; 6
+    (ISTORE 1) ; 7 a := a+1
+    (ILOAD 0)  ; 8
+    (ICONST 2) ; 9
+    (ISUB)     ;10
+    (ISTORE 0) ;11 n := n-2
+    (GOTO -10) ;12 goto top of loop
+    (ILOAD 1)  ;13
+    (HALT)))   ;14 ``return'' a
+
+; Here is a paraphrase of our goal theorem.  Let s0 be an M1 state in which the
+; initial value, n0, of n (i.e., local 0) is some natural number, pc is 0, and
+; the program is *pi*.  Let sk be any state reachable from s0, i.e., (m1 s0 k)
+; for any k.  Suppose the pc in sk is 14.  Then n0 is even and the value on top
+; of the stack is n0/2.  Formally:
+
+;   (let* ((sk (m1 s0 k)))
+;     (implies (and (let ((s s0))
+;                     (and (equal (n s) n0)
+;                          (integerp n0)
+;                          (<= 0 n0)))
+;                   (equal (pc s0) 0)
+;                   (equal (locals s0) (list* n0 any))
+;                   (equal (program s0) *pi*)
+;                   (equal (pc sk) 14))
+;              (let ((s sk))
+;                (and (evenp n0)
+;                     (equal (top (stack s)) (/ n0 2))))))
+
+
+
+; Section 5:  The Assertions at the Three Cut Points
+
+(defun P (n0 n) ; Pre-Condition
+  (and (equal n n0)
+       (integerp n0)
+       (<= 0 n0)))
+
+(defun R (n0 n a) ; Loop Invariant
+  (and (integerp n0)
+       (<= 0 n0)
+       (integerp n)
+       (if (and (<= 0 n)
+                (integerp a)
+                (evenp n))
+           (equal (+ a (/ n 2))
+                  (/ n0 2))
+           (not (evenp n)))
+       (iff (evenp n0) (evenp n))))
+
+(defun Q (n0 tos) ; Post-Condition
+  (and (evenp n0)
+       (equal tos (/ n0 2))))
+
+; Section 6:  The Verification Conditions
+
+; Discussion only, no events.
+
+; Section 7:  Attaching the Assertions to the Code
+
+(defun n (s) (nth 0 (locals s)))
+(defun a (s) (nth 1 (locals s)))
+
+(defun assertion (n0 s)
+  (let ((n (n s))
+        (a (a s)))
+    (and (equal (program s) *pi*)
+         (case (pc s)
+           (0 (P n0 n))
+           (2 (R n0 n a))
+           (14 (Q n0 (top (stack s))))
+           (otherwise nil)))))
+
+; Section 8:  The Nugget: Defining the Invariant
+
+(include-book "misc/defpun" :dir :system)
+
+(acl2::defpun Inv (n0 s)
+  (if (member (pc s) '(0 2 14))
+      (assertion n0 s)
+      (Inv n0 (step s))))
+
+; Because the paper presents a proof at the level a human might do one, it does
+; not include the ACL2-specific events needed to drive the prover to that
+; proof.  There is only one such lemma required here and that is a rewrite rule
+; that forces the (Inv n0 s) to expand to (Inv n0 (step s)) if the pc is not
+; one of the annotated ones.  That strategy is made clear in the proof
+; described in the paper.  Here is how it is communicated to ACL2.
+
+(defthm inv-opener
+  (implies (and (equal pc (pc s))
+                (syntaxp (quotep pc))
+                (not (member pc '(0 2 14))))
+           (equal (inv n0 s)
+                   (inv n0 (step s)))))
+
+; Section 9:  Proofs
+
+(defthm inv-step                  ; called Property-1-of-Inv in the paper
+  (implies (inv n0 s)
+           (inv n0 (step s))))
+
+(defthm inv-run                   ; called Property-4-of-Inv in the paper
+  (implies (inv n0 s)
+           (inv n0 (m1 s k)))
+  :rule-classes nil
+  :hints (("goal" :in-theory (e/d (m1) (inv-def)))))
+
+(defthm Corollary-1              ; called Corollary-1 in the paper
+  (implies (and (equal n0 (n s0))
+                (integerp n0)
+                (<= 0 n0)
+                (equal (pc s0) 0)
+                (equal (locals s0) (list* n0 any))
+                (equal (program s0) *pi*)
+                (equal sk (M1 s0 k))
+                (equal (pc sk) 14))
+           (and (evenp n0)
+                (equal (top (stack sk)) (/ n0 2))))
+  :hints (("Goal" :use (:instance inv-run (s s0) (n0 n0))))
+  :rule-classes nil)
+
+
+; Section 10:  Packaging It Up
+
+(defmacro defspec (name prog inputs pre-pc post-pc annotation-alist)
+  (let ((Inv
+         (intern-in-package-of-symbol
+          (concatenate 'string (symbol-name name) "-INV")
+          'run))
+        (Inv-def
+         (intern-in-package-of-symbol
+          (concatenate 'string (symbol-name name) "-INV-DEF")
+          'run))
+        (Inv-opener
+         (intern-in-package-of-symbol
+          (concatenate 'string (symbol-name name) "-INV-OPENER")
+          'run))
+        (Inv-step
+         (intern-in-package-of-symbol
+          (concatenate 'string (symbol-name name) "-INV-STEP")
+          'run))
+        (Inv-run
+         (intern-in-package-of-symbol
+          (concatenate 'string (symbol-name name) "-INV-RUN")
+          'run))
+        (Correctness
+         (intern-in-package-of-symbol
+          (concatenate 'string "PARTIAL-CORRECTNESS-OF-PROGRAM-"
+                       (symbol-name name))
+          'run)))
+    `(acl2::progn
+      (acl2::defpun ,Inv (,@inputs s)
+                    (if (member (pc s)
+                                ',(strip-cars annotation-alist))
+                        (and (equal (program s) ,prog)
+                             (case (pc s)
+                               ,@annotation-alist))
+                        (,Inv ,@inputs (step s))))
+      (defthm ,Inv-opener
+        (implies (and (equal pc (pc s))
+                      (syntaxp (quotep pc))
+                      (not
+                       (member pc
+                               ',(strip-cars annotation-alist))))
+                 (equal (,Inv ,@inputs s)
+                        (,Inv ,@inputs (step s)))))
+      (defthm ,Inv-step
+        (implies (,Inv ,@inputs  s)
+                 (,Inv ,@inputs (step s))))
+      (defthm ,Inv-run
+        (implies (,Inv ,@inputs s)
+                 (,Inv ,@inputs (m1 s k)))
+        :rule-classes nil
+        :hints (("Goal" :in-theory (e/d (m1)(,Inv-def)))))
+      (defthm ,Correctness
+        (let* ((sk (m1 s0 k)))
+          (implies
+           (and (let ((s s0)) ,(cadr (assoc pre-pc annotation-alist)))
+                (equal (pc s0) ,pre-pc)
+                (equal (locals s0) (list* ,@inputs any))
+                (equal (program s0) ,prog)
+                (equal (pc sk) ,post-pc))
+           (let ((s sk)) ,(cadr (assoc post-pc annotation-alist)))))
+
+        :hints (("Goal" :use
+                 (:instance ,Inv-run
+                            ,@(pairlis$ inputs (acl2::pairlis-x2 inputs nil))
+                            (s s0)
+                            (k k))))
+        :rule-classes nil))))
+
+(defspec pi *pi*  (n0) 0 14
+  ( ; Pre-Condition:
+   (0 (and (equal (n s) n0)
+           (integerp n0)
+           (<= 0 n0)))
+
+; Loop Invariant:
+   (2 (and (integerp n0)
+           (<= 0 n0)
+           (integerp (n s))
+           (if (and (<= 0 (n s))
+                    (integerp (a s))
+                    (evenp (n s)))
+               (equal (+ (a s) (/ (n s) 2))
+                      (/ n0 2))
+               (not (evenp (n s))))
+           (iff (evenp n0) (evenp (n s)))))
+
+; Post-condition:
+   (14 (and (evenp n0)
+            (equal (top (stack s)) (/ n0 2))))))
+
+; If you print the last event proved by this command, you will see that it is
+; logically equivalent to Corollary-1 above, the desired result about our program.
+
+; M1 !>:pe PARTIAL-CORRECTNESS-OF-PROGRAM-PI
+;           16:x(DEFSPEC PI *PI* ...)
+;               \
+; >              (DEFTHM
+;                 PARTIAL-CORRECTNESS-OF-PROGRAM-PI
+;                 (LET* ((SK (M1 S0 K)))
+;                       (IMPLIES (AND (LET ((S S0))
+;                                          (AND (EQUAL (N S) N0)
+;                                               (INTEGERP N0)
+;                                               (<= 0 N0)))
+;                                     (EQUAL (PC S0) 0)
+;                                     (EQUAL (LOCALS S0) (LIST* N0 ANY))
+;                                     (EQUAL (PROGRAM S0) *PI*)
+;                                     (EQUAL (PC SK) 14))
+;                                (LET ((S SK))
+;                                     (AND (EVENP N0)
+;                                          (EQUAL (TOP (STACK S)) (/ N0 2))))))
+;                 :HINTS (("Goal" :USE (:INSTANCE PI-INV-RUN (N0 N0)
+;                                                 (S S0)
+;                                                 (K K))))
+;                 :RULE-CLASSES NIL)
+
+; The use of LET* and LET are just convenient ways for the macro to manipulate
+; the user's specification, which is in terms of the state variable s instead
+; of s0 and sk.
+
diff -Nru acl2-6.2/books/models/y86/y86-two-level/common/x86-memory-low.lisp acl2-6.3/books/models/y86/y86-two-level/common/x86-memory-low.lisp
--- acl2-6.2/books/models/y86/y86-two-level/common/x86-memory-low.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/models/y86/y86-two-level/common/x86-memory-low.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -10,6 +10,7 @@
 ||#
 
 (include-book "x86-state")
+(include-book "std/lists/list-defuns" :dir :system)
 
 (local
  (defmacro enable-stobj-fns-fn (x86-32-model)
@@ -762,6 +763,8 @@
            (good-mem-arrayp-1-logic index2 len mem-array)))
 
 
+;; (local (in-theory (disable nth-when-zp)))
+
 (encapsulate
  ()
 
@@ -887,31 +890,40 @@
 
 ; Start proof of x86-32p-!memi-new-page-resize
 
+(defthm mem-arrayp-repeat
+  (implies (unsigned-byte-p 8 x)
+           (mem-arrayp (repeat x n)))
+  :hints(("Goal" :in-theory (enable repeat))))
+
 (defthm mem-arrayp-resize-list
   (implies (and (mem-arrayp lst)
                 (unsigned-byte-p 8 default-value))
-           (mem-arrayp (resize-list lst new-len default-value))))
+           (mem-arrayp (resize-list lst new-len default-value)))
+  :hints(("Goal" :in-theory (enable resize-list))))
 
-(defun nth-resize-list-induction (i lst n default-value)
-  (declare (ignorable i lst n default-value))
-  (if (posp n)
-      (nth-resize-list-induction (1- i)
-                                 (if (atom lst) lst (cdr lst))
-                                 (1- n)
-                                 default-value)
-    nil))
-
-(defthm nth-resize-list
-  (implies (and (natp i)
-                (natp n)
-                (<= (len lst) n)
-                (< i n))
-           (equal (nth i (resize-list lst n default))
-                  (if (< i (len lst))
-                      (nth i lst)
-                    default)))
-  :hints (("Goal" :in-theory (enable resize-list nth)
-           :induct (nth-resize-list-induction i lst n default-value))))
+
+(local
+ (progn
+   (defun nth-resize-list-induction (i lst n default-value)
+     (declare (ignorable i lst n default-value))
+     (if (posp n)
+         (nth-resize-list-induction (1- i)
+                                    (if (atom lst) lst (cdr lst))
+                                    (1- n)
+                                    default-value)
+       nil))
+
+   (defthm nth-resize-list
+     (implies (and (natp i)
+                   (natp n)
+                   (<= (len lst) n)
+                   (< i n))
+              (equal (nth i (resize-list lst n default))
+                     (if (< i (len lst))
+                         (nth i lst)
+                       default)))
+     :hints (("Goal" :in-theory (enable resize-list nth)
+              :induct (nth-resize-list-induction i lst n default-value))))))
 
 (defthm good-mem-arrayp-1-logic-resize-list
   (implies (and (natp next-addr)
@@ -1662,19 +1674,30 @@
                                         (NTH *MEM-TABLEI* X86-32)))
                   0)))
 
-(defthm nth-resize-list++
-  (implies (and (natp i)
-                (natp n)
-                (<= (len lst) n))
-           (equal (nth i (resize-list lst n default))
-                  (cond ((< i (len lst))
-                         (nth i lst))
-                        ((< i n)
-                         default)
-                        (t
-                         nil))))
-  :hints (("Goal" :in-theory (enable resize-list nth)
-           :induct (nth-resize-list-induction i lst n default-value))))
+;; (defthm nth-resize-list++
+;;   (implies (and (natp i)
+;;                 (natp n)
+;;                 (<= (len lst) n))
+;;            (equal (nth i (resize-list lst n default))
+;;                   (cond ((< i (len lst))
+;;                          (nth i lst))
+;;                         ((< i n)
+;;                          default)
+;;                         (t
+;;                          nil))))
+;;   :hints (("Goal" :in-theory (enable resize-list nth)
+;;            :induct (nth-resize-list-induction i lst n default-value))))
+
+; At least some of the following enables and disables are required on 7/28/2013
+; for read-write, perhaps due to a change in or under centaur/books/gl/gl.lisp
+; -- actually the culprit is at least in part probably the additions of some
+; rules to centaur/misc/arith-equivs.lisp.
+;; (local (in-theory (e/d (nfix natp)
+;;                        (natp-when-gte-0
+;;                         natp-when-integerp
+;;                         nfix-when-natp
+;;                         nfix-when-not-natp
+;;                         nth-when-too-large))))
 
 (encapsulate
  ()
@@ -1967,4 +1990,4 @@
 
 (in-theory (disable wm32))
 
-; ======================================================================
\ No newline at end of file
+; ======================================================================
diff -Nru acl2-6.2/books/models/y86/y86-two-level/common/x86-state.lisp acl2-6.3/books/models/y86/y86-two-level/common/x86-state.lisp
--- acl2-6.2/books/models/y86/y86-two-level/common/x86-state.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/models/y86/y86-two-level/common/x86-state.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -8,6 +8,7 @@
 (in-package "ACL2")
 
 (include-book "constants")
+(include-book "std/lists/list-defuns" :dir :system)
 
 ; Increase memory for X86 memory.
 ;; (include-book "centaur/misc/memory-mgmt-logic" :dir :system)
@@ -310,6 +311,9 @@
                   (good-mem-table-entriesp-weak (1+ i) table-bound x86-32))))
         (t nil)))
 
+; Required on 7/28/2013, perhaps due to a change in or under
+; centaur/books/gl/gl.lisp:
+(local (in-theory (enable nfix)))
 
 (encapsulate
  ()
@@ -357,6 +361,17 @@
 ) ;; End of encapsulate
 
 
+(defthm rational-listp-append
+  (equal (rational-listp (append x y))
+         (and (rational-listp (list-fix x))
+              (rational-listp y)))
+  :hints(("Goal" :induct (len x))))
+
+(defthm rational-listp-rev
+  (equal (rational-listp (rev x))
+         (rational-listp (list-fix x)))
+  :hints(("Goal" :induct (len x))))
+
 (defthm rational-listp-revappend
   (implies (rational-listp x)
            (equal (rational-listp (revappend x y))
diff -Nru acl2-6.2/books/models/y86/y86-two-level-abs/common/x86-memory-high.lisp acl2-6.3/books/models/y86/y86-two-level-abs/common/x86-memory-high.lisp
--- acl2-6.2/books/models/y86/y86-two-level-abs/common/x86-memory-high.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/models/y86/y86-two-level-abs/common/x86-memory-high.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -3,6 +3,16 @@
 ;; This book is very, very sloppily done.  I'll come back to it later and re-do
 ;; it nicely.
 
+#||
+
+; [Jared and Sol]: fool make_cert_help.pl into allowing more memory for this
+; book. We would just include centaur/misc/memory-mgmt, but that has a ttag.
+
+(set-max-mem (* 6 (expt 2 30)))
+
+||#
+
+
 (in-package "ACL2")
 
 (include-book "x86-state")
diff -Nru acl2-6.2/books/models/y86/y86-two-level-abs/common/x86-memory-low.lisp acl2-6.3/books/models/y86/y86-two-level-abs/common/x86-memory-low.lisp
--- acl2-6.2/books/models/y86/y86-two-level-abs/common/x86-memory-low.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/models/y86/y86-two-level-abs/common/x86-memory-low.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -10,6 +10,7 @@
 ||#
 
 (include-book "x86-state-concrete")
+(include-book "std/lists/list-defuns" :dir :system)
 
 ;; Note that x86-memory-low would have memi$c and !memi$c related stuff, and
 ;; not rm* and wm* related stuff (rm*/wm* is defined in terms of the abstract
@@ -890,31 +891,41 @@
 
 ; Start proof of x86-32$cp-!mem$ci-new-page-resize
 
+(defthm mem-arrayp-repeat
+  (implies (unsigned-byte-p 8 x)
+           (mem-arrayp (repeat x n)))
+  :hints(("Goal" :in-theory (enable repeat))))
+
 (defthm mem-arrayp-resize-list
   (implies (and (mem-arrayp lst)
                 (unsigned-byte-p 8 default-value))
-           (mem-arrayp (resize-list lst new-len default-value))))
+           (mem-arrayp (resize-list lst new-len default-value)))
+  :hints(("Goal" :in-theory (enable resize-list))))
+
 
-(defun nth-resize-list-induction (i lst n default-value)
-  (declare (ignorable i lst n default-value))
-  (if (posp n)
-      (nth-resize-list-induction (1- i)
-                                 (if (atom lst) lst (cdr lst))
-                                 (1- n)
-                                 default-value)
-    nil))
-
-(defthm nth-resize-list
-  (implies (and (natp i)
-                (natp n)
-                (<= (len lst) n)
-                (< i n))
-           (equal (nth i (resize-list lst n default))
-                  (if (< i (len lst))
-                      (nth i lst)
-                    default)))
-  :hints (("Goal" :in-theory (enable resize-list nth)
-           :induct (nth-resize-list-induction i lst n default-value))))
+(local
+ (progn
+   (defun nth-resize-list-induction (i lst n default-value)
+     (declare (ignorable i lst n default-value))
+     (if (posp n)
+         (nth-resize-list-induction (1- i)
+                                    (if (atom lst) lst (cdr lst))
+                                    (1- n)
+                                    default-value)
+       nil))
+
+   ;; [Jared] subsumed by better lemma in std/lists/resize-list
+   (defthm nth-resize-list
+     (implies (and (natp i)
+                   (natp n)
+                   (<= (len lst) n)
+                   (< i n))
+              (equal (nth i (resize-list lst n default))
+                     (if (< i (len lst))
+                         (nth i lst)
+                       default)))
+     :hints (("Goal" :in-theory (enable resize-list nth)
+              :induct (nth-resize-list-induction i lst n default-value))))))
 
 (defthm good-mem-arrayp-1-logic-resize-list
   (implies (and (natp next-addr)
@@ -1596,19 +1607,31 @@
                                         (NTH *MEM-TABLEI* x86-32$c)))
                   0)))
 
-(defthm nth-resize-list++
-  (implies (and (natp i)
-                (natp n)
-                (<= (len lst) n))
-           (equal (nth i (resize-list lst n default))
-                  (cond ((< i (len lst))
-                         (nth i lst))
-                        ((< i n)
-                         default)
-                        (t
-                         nil))))
-  :hints (("Goal" :in-theory (enable resize-list nth)
-           :induct (nth-resize-list-induction i lst n default-value))))
+;; [Jared] subsumed by better lemma in std/lists/resize-list
+;; (defthm nth-resize-list++
+;;   (implies (and (natp i)
+;;                 (natp n)
+;;                 (<= (len lst) n))
+;;            (equal (nth i (resize-list lst n default))
+;;                   (cond ((< i (len lst))
+;;                          (nth i lst))
+;;                         ((< i n)
+;;                          default)
+;;                         (t
+;;                          nil))))
+;;   :hints (("Goal" :in-theory (enable resize-list nth)
+;;            :induct (nth-resize-list-induction i lst n default-value))))
+
+; At least some of the following enables and disables are required on 7/28/2013
+; for read-write, perhaps due to a change in or under centaur/books/gl/gl.lisp
+; -- actually the culprit is at least in part probably the additions of some
+; rules to centaur/misc/arith-equivs.lisp.
+;; (local (in-theory (e/d (nfix natp)
+;;                        (natp-when-gte-0
+;;                         natp-when-integerp
+;;                         nfix-when-natp
+;;                         nfix-when-not-natp
+;;                         nth-when-too-large))))
 
 (encapsulate
  ()
diff -Nru acl2-6.2/books/models/y86/y86-two-level-abs/common/x86-state-defabsstobj.lisp acl2-6.3/books/models/y86/y86-two-level-abs/common/x86-state-defabsstobj.lisp
--- acl2-6.2/books/models/y86/y86-two-level-abs/common/x86-state-defabsstobj.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/models/y86/y86-two-level-abs/common/x86-state-defabsstobj.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -8,6 +8,15 @@
 
 (in-package "ACL2")
 
+#||
+
+; [Jared]: fool make_cert_help.pl into allowing more memory for this
+; book. We would just include centaur/misc/memory-mgmt, but that has a ttag.
+
+(set-max-mem (* 6 (expt 2 30)))
+
+||#
+
 (include-book "x86-memory-low")
 (include-book "defexec/other-apps/records/records" :dir :system)
 
diff -Nru acl2-6.2/books/models/y86/y86-two-level-abs/examples/popcount-demo.lisp acl2-6.3/books/models/y86/y86-two-level-abs/examples/popcount-demo.lisp
--- acl2-6.2/books/models/y86/y86-two-level-abs/examples/popcount-demo.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/models/y86/y86-two-level-abs/examples/popcount-demo.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -11,10 +11,14 @@
 
 ; If popcount-demo.lisp (which, incidentally, is more or less subsumed by
 ; popcount.lisp) is certified in parallel with popcount.lisp, that could result
-; in memory usage that stresses a machine with 8GB of RAM.  So we add an
-; artificial dependency here:
+; in memory usage that stresses a machine with 8GB of RAM.  So we are tempted
+; to add artificial dependency here, and we did at one time.  But now, the
+; overall books/Makefile ensures that only one book is certified under
+; books/models/y86/ at a time, and that seems sufficient.  To restore the
+; previous state of affairs, eliminate the newline below as indicated.
 #||
-(include-book "popcount")
+(include-book
+ "popcount")
 ||#
 
 (defthm x86-32p-create-x86-32
diff -Nru acl2-6.2/books/models/y86-target.lisp acl2-6.3/books/models/y86-target.lisp
--- acl2-6.2/books/models/y86-target.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/models/y86-target.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -0,0 +1,18 @@
+; Silly file to support ../../Makefile
+
+(in-package "ACL2")
+; cert_param: (hons-only)
+
+#||
+(include-book "arithmetic-5/top" :dir :system)
+(include-book "arithmetic/top-with-meta" :dir :system)
+(include-book "arithmetic/top" :dir :system)
+(include-book "centaur/gl/gl" :dir :system)
+(include-book "centaur/misc/memory-mgmt-logic" :dir :system)
+(include-book "defexec/other-apps/records/records" :dir :system)
+(include-book "misc/check-state" :dir :system)
+(include-book "misc/defp" :dir :system)
+(include-book "rtl/rel8/lib/top" :dir :system)
+(include-book "std/lists/list-defuns" :dir :system)
+(include-book "tools/bstar" :dir :system)
+||#
diff -Nru acl2-6.2/books/oslib/argv-raw.lsp acl2-6.3/books/oslib/argv-raw.lsp
--- acl2-6.2/books/oslib/argv-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/argv-raw.lsp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,176 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+
+
+(defun argv-fn (state)
+
+   (unless (live-state-p state)
+     (error "ARGV can only be called on a live state.")
+     (mv nil state))
+
+   #+Clozure
+   (let ((args ccl::*unprocessed-command-line-arguments*))
+     ;; For this to work, the proper way to invoke CCL is through a wrapper
+     ;; script along the lines of:
+     ;;
+     ;;   #!/bin/sh
+     ;;   export CCL_DEFAULT_DIRECTORY=/blah/blah
+     ;;   exec ccl -I my-image.ccl -K ISO-8859-1 -e "(myprog::main)" -- "$@"
+     ;;
+     ;; CCL removes the arguments it processes and doesn't include any program
+     ;; name or anything like that, and just gives us the arguments past --, so
+     ;; that's perfectly good.
+     (cond ((string-listp args)
+            (mv args state))
+           (t
+            (error "ARGV found non string-listp arguments? ~a" args)
+            (mv nil state))))
+
+   #+SBCL
+   (let ((args sb-ext:*posix-argv*))
+     ;; For this to work, the proper way to invoke SBCL is through a wrapper
+     ;; script along the lines of:
+     ;;
+     ;;  #!/bin/sh
+     ;;  export SBCL_HOME=/blah/blah
+     ;;  exec /blah/blah/sbcl --core my-image.core --end-runtime-options \
+     ;;    --eval "(myprog::main)" --end-toplevel-options "$@"
+     ;;
+     ;; The SBCL manual (section, "Command Line Options") talks about the differences
+     ;; between runtime options and top-level options.  So see that if you want to also
+     ;; include things like --dynamic-space-size, etc.
+     ;;
+     ;; SBCL removes the arguments it processes but leaves the program name as
+     ;; the first member of args.  So to make ARGV consistent across Lisps,
+     ;; we'll remove that.
+     (cond ((atom args)
+            (error "Expected ARGV on SBCL to always have at least the program name.")
+            (mv nil state))
+           ((string-listp args)
+            ;; Strip out the program name
+            (mv (cdr args) state))
+           (t
+            (error "ARGV found non string-listp arguments? ~a" args)
+            (mv nil state))))
+
+   #+Allegro
+   (let ((args (sys:command-line-arguments :application t)))
+     ;; For this to work, the proper way to invoke Allegro is through a wrapper
+     ;; script along the lines of:
+     ;;
+     ;;  #!/bin/sh
+     ;;  exec /blah/blah/alisp -I /blah/blah/blah.dxl -- "$@"
+     ;;
+     ;; By using :application t, we tell Allegro to throw away the arguments it
+     ;; processes like -I.  But it still leaves in the program name, so as in
+     ;; SBCL we need to CDR the args to throw that away.
+     (cond ((atom arg)
+            (error "Expected ARGV on Allegro to always have at least the program name.")
+            (mv nil state))
+           ((string-listp args)
+            (mv (cdr args) state))
+           (t
+            (error "ARGV found non string-listp arguments? ~a" args)
+            (mv nil state))))
+
+   #+CLISP
+   (let ((args ext:*args*))
+     ;; For this to work, the proper way to invoke Clisp is through a wrapper
+     ;; script along the lines of:
+     ;;
+     ;;   #!/bin/sh
+     ;;   exec /blah/blah/clisp -i /blah/blah -M /blah/blah.mem -E ISO-8859-1 -- "$@"
+     ;;
+     ;; CLISP automatically throws away everything before the -- for us, and leaves
+     ;; us just with the arguments, which is perfect.
+     (cond ((string-listp args)
+            (mv args state))
+           (t
+            (error "ARGV found non string-listp arguments? ~a" args)
+            (mv nil state))))
+
+   #+CMU
+   (let ((args ext:*command-line-application-arguments*))
+     ;; For this to work, the proper way to invoke CMUCL is through a wrapper
+     ;; script along the lines of:
+     ;;
+     ;;   #!/bin/sh
+     ;;   exec /blah/blah/lisp -core /blah/blah.core -eval '(myprog::main)' -- "$@"
+     ;;
+     ;; CMUCL puts the arguments after -- into the above, without any program
+     ;; name or anything like that, which is perfect.
+     (cond ((string-listp args)
+            (mv args state))
+           (t
+            (error "ARGV found non string-listp arguments? ~a" args)
+            (mv nil state))))
+
+   #+gcl
+   (let ((args si::*command-args*))
+     ;; BOZO.  This isn't going to work perfectly because GCL doesn't seem to
+     ;; have an equivalent of --.  For now I'm going to at least expect that the
+     ;; wrapper script uses -- anyway, e.g., a proper wrapper script is:
+     ;;
+     ;;   #!/bin/sh
+     ;;   exec /blah/blah/blah.gcl -eval '(myprog::main)' -- "$@"
+     ;;
+     ;; This way we can at least cut out the stuff that comes before --.  But
+     ;; it's not perfect because GCL will still try to process options like
+     ;; -eval, -f, etc., that happen to come in $@.
+     (cond ((atom args)
+            (error "ARGV expected GCL to have at least the program name.")
+            (mv nil state))
+           ((string-listp args)
+            (mv (cdr (member-equal "--" args)) state))
+           (t
+            (error "ARGV found non string-listp arguments? ~a" args)
+            (mv nil state))))
+
+   #+lispworks
+   (let ((args sys:*line-arguments-list*))
+     ;; BOZO this is very similar to GCL.  There's apparently no proper support
+     ;; for --, so do the smae hack as for GCL, which sort of works.  A proper
+     ;; wrapper script is, e.g.,
+     ;;
+     ;;   #/bin/sh
+     ;;   exec /blah/blah/image.lw -init - -siteinit - -- "$@"
+     ;;
+     ;; Again this isn't perfect.
+     (cond ((atom args)
+            (error "ARGV expected Lispworks to have at least the program name."))
+           ((string-listp args)
+            (mv (cdr (member-equal "--" args)) state))
+           (t
+            (error "ARGV found non string-listp arguments? ~a" args)
+            (mv nil state))))
+
+   #+(and (not Clozure)
+          (not SBCL)
+          (not Allegro)
+          (not CLISP)
+          (not CMU)
+          (not gcl)
+          (not lispworks))
+   (progn
+     (error "ARGV is not yet implemented on this host Lisp.")
+     (mv nil state)))
+
diff -Nru acl2-6.2/books/oslib/argv.lisp acl2-6.3/books/oslib/argv.lisp
--- acl2-6.2/books/oslib/argv.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/argv.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,27 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+(include-book "logic-defs")
+; (depends-on "argv-raw.lsp")
+
+(defttag oslib)
+(include-raw "argv-raw.lsp")
+
diff -Nru acl2-6.2/books/oslib/date.lisp acl2-6.3/books/oslib/date.lisp
--- acl2-6.2/books/oslib/date.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/oslib/date.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -19,30 +19,10 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "OSLIB")
-(include-book "read-acl2-oracle")
-(include-book "cutil/define" :dir :system)
-(include-book "tools/include-raw" :dir :system)
+(include-book "logic-defs")
 (include-book "str/cat" :dir :system)
 (include-book "str/natstr" :dir :system)
 ; (depends-on "date-raw.lsp")
 
-(define date (&optional (state 'state))
-  :returns (mv (datestamp stringp :rule-classes :type-prescription)
-               (state state-p1 :hyp (force (state-p1 state))))
-  :parents (oslib)
-  :short "Get the current datestamp, like \"November 17, 2010 10:25:33\"."
-
-  :long "<p>In the logic this function reads from the ACL2 oracle.  In the
-execution we use Common Lisp's @('get-decoded-time') function to figure out
-what the current date and time is.  We think this <i>should</i> work on any
-Common Lisp system.</p>"
-
-  (b* ((- (er hard? __function__ "Raw Lisp definition not installed?"))
-       ((mv err val state) (read-acl2-oracle state)))
-    (if (and (not err)
-             (stringp val))
-        (mv val state)
-      (mv "Error reading date." state))))
-
 (defttag oslib)
 (include-raw "date-raw.lsp")
diff -Nru acl2-6.2/books/oslib/file-types-raw.lsp acl2-6.3/books/oslib/file-types-raw.lsp
--- acl2-6.2/books/oslib/file-types-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/file-types-raw.lsp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,48 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+(ql:quickload "osicat")
+
+(defun file-kind-fn (path follow-symlinks state)
+  (unless (live-state-p state)
+    (error "file-kind can only be called on a live state."))
+  (mv-let (errmsg result)
+    (handler-case
+     (multiple-value-bind
+         (main-kind broken)
+         (osicat::file-kind path :follow-symlinks follow-symlinks)
+       (cond ((and follow-symlinks broken)
+              (assert (eq main-kind :symbolic-link))
+              (mv (msg "Error in file-kind for ~x0: broken symlink." path)
+                  nil))
+             ((file-kind-p main-kind)
+              (mv nil main-kind))
+             (t
+              (mv (msg "Error in file-kind for ~x0: osicat::file-kind returned ~
+                        unexpected value ~s1."
+                       path
+                       (format nil "~a" main-kind))
+                  nil))))
+     (error (condition)
+            (mv (msg "Error in file-kind: ~s0." (format nil "~a" condition))
+                nil)))
+    (mv errmsg result state)))
+
diff -Nru acl2-6.2/books/oslib/file-types.lisp acl2-6.3/books/oslib/file-types.lisp
--- acl2-6.2/books/oslib/file-types.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/file-types.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,484 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+(include-book "read-acl2-oracle")
+(include-book "cutil/define" :dir :system)
+(include-book "cutil/defenum" :dir :system)
+(include-book "centaur/quicklisp/top" :dir :system)
+; (depends-on "file-types-raw.lsp")
+; cert_param: (uses-quicklisp)
+
+(defxdoc file-types
+  :parents (oslib)
+  :short "Functions for working with file types, e.g., regular files versus
+directories, devices, etc."
+
+  :long "<p>Many of these functions are just ACL2 wrappers for the Common Lisp
+<a href='http://common-lisp.net/project/osicat/'>Osicat</a> library.  Unlike
+the more basic file reading/writing operations (see @(see acl2::std/io)), there
+is no complex logical story for reasoning about these operations.  Instead, in
+the logic, practically everything here is just reading the oracle.</p>
+
+<p>As a general rule, these functions are <b>not entirely portable</b>,
+especially regarding special characters like @('~'), @('..'), @('\\'), @('*')
+in path names.  Paths containing these things will certainly not behave in the
+same way across different operating systems, and for that matter they may not
+even behave the same way on the same operating system, but in different Lisps.
+There's not much to be done for this, as the root causes are the lack of
+standards among file systems and Common Lisp implementations.</p>
+
+<p>Some possibly helpful reading about file systems in general and in Lisp:</p>
+
+<ul>
+
+<li>David A. Wheeler. <a
+href='http://www.dwheeler.com/essays/fixing-unix-linux-filenames.html'>Fixing
+Unix/Linux/POSIX Filenames: Control Characters (such as Newline), Leading
+Dashes, and Other Problems</a>.</li>
+
+<li>Peter Seibel's <a href='http://www.gigamonkeys.com/book/'>Practical Common
+Lisp</a>, especially the chapters on <a
+href='http://www.gigamonkeys.com/book/files-and-file-io.html'>Files and File
+I/O</a> and <a
+href='http://www.gigamonkeys.com/book/practical-a-portable-pathname-library.html'>Practical:
+A Portable Pathname Library</a>.</li>
+
+<li>The Common Lisp <a
+href='http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/FrontMatter/Chapter-Index.html'>Hyperspec</a>,
+especially the chapters on <a
+href='http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/chap-19.html'>file
+names</a> and <a
+href='http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/chap-20.html'>files</a>.</li>
+
+<li>The <a href='http://weitz.de/cl-fad/'>CL-FAD</a> (Common Lisp Files and
+Directories) library is perhaps similar to @('osicat'), but doesn't seem to
+have any support for querying what type of file you're looking at, etc., so we
+don't currently use it.</li>
+
+</ul>
+
+<h3>Future work</h3>
+
+<p>BOZO I would really like to have tests like -r, -w, and -x in Perl/Bash.  It
+looks like osicat gives me a way to access the permissions of a file, but
+these seem like just the rwx bits from the \"stat\" structure, and I don't
+think that's actually tells us anything useful, unless the file happens to
+be owned by us---at least, not without some way to figure out what groups
+our user is in, etc.</p>
+
+<p>The source code for Gnu's \"test\" utility (from coreutils) invokes the
+EUIDACCESS system call to figure out whether the argument is readable,
+writable, or executable.  So that'd probably be the nicest thing to use.  So
+maybe we could rig something up with CFFI to invoke that, but I am in way over
+my head here, and even if we did that, it'd probably just be a solution for
+Linux.  Who knows how Windows or FreeBSD or Darwin or anything else do
+it.</p>")
+
+(defenum file-kind-p
+  (nil
+   :regular-file
+   :directory
+   :symbolic-link
+   :pipe
+   :socket
+   :character-device
+   :block-device)
+  :parents (file-types)
+  :short "Possible return values from @(see file-kind)."
+  :long "<p>Here @('nil') indicates that the file does not exist.</p>")
+
+
+(define file-kind
+  :parents (file-types)
+  :short "See what kind of file a path refers to."
+
+  ((path stringp "The path to test.")
+   &key
+   ((follow-symlinks booleanp) 't)
+   (state 'state))
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans file-kind-p "On success: the kind of file.")
+               (state state-p1 :hyp (force (state-p1 state))))
+
+  :long "<p>We check whether @('path') exists.  If so, we determine what kind
+of file it is.</p>
+
+<p>This is complicated by symbolic links.  You can control how symlinks are
+handled using @(':follow-symlinks').</p>
+
+<p>By default, @(':follow-symlinks') is @('t').  In this case, the idea is to
+tell you what kind of file is ultimately pointed to after resolving all the
+symlinks.  Since we are following all links, we will never return
+@(':symbolic-link') in this case.  We treat any broken links as errors.</p>
+
+<p>For finer-grained handling of symlinks, you can set @(':follow-symlinks') to
+@('nil').  In this case, we return @(':symbolic-link') for symbolic links, no
+matter whether they are valid or broken.  Unless you're doing something very
+fancy with symlinks, this is almost surely not what you want.</p>"
+  :ignore-ok t
+  (b* ((- (raise "Raw Lisp definition not installed?"))
+       ((mv & err state) (read-acl2-oracle state))
+       ((mv & ans state) (read-acl2-oracle state)))
+    (mv err (if (file-kind-p ans) ans nil) state))
+  ///
+  (defthm type-of-file-kind.ans
+    (let ((ans (mv-nth 1 (file-kind path))))
+      (and (symbolp ans)
+           (not (equal ans t))))
+    :rule-classes :type-prescription))
+
+
+(define path-exists-p ((path stringp) &key (state 'state))
+  :parents (file-types)
+  :short "Does a path exist?  After following symlinks, does it refer to
+<i>any</i> \"file\" at all (a regular file, a directory, a device, ...)?"
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans booleanp :rule-classes :type-prescription
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  (b* (((mv err ans state) (file-kind path))
+       ((when err)
+        (mv err nil state)))
+    (mv err (not (null ans)) state)))
+
+
+(define paths-all-exist-p ((paths string-listp) &key (state 'state))
+  :parents (file-types)
+  :short "Do all of these paths <see topic='@(url path-exists-p)'>exist</see>?"
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans booleanp :rule-classes :type-prescription
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  (b* (((when (atom paths))
+        (mv nil t state))
+       ((mv err ans1 state) (path-exists-p (car paths)))
+       ((when err)
+        (mv err nil state))
+       ((unless ans1)
+        (mv nil nil state)))
+    (paths-all-exist-p (cdr paths))))
+
+
+(define paths-all-missing-p ((paths string-listp) &key (state 'state))
+  :parents (file-types)
+  :short "Do none of these paths <see topic='@(url path-exists-p)'>exist</see>?"
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans booleanp :rule-classes :type-prescription
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  (b* (((when (atom paths))
+        (mv nil t state))
+       ((mv err ans1 state) (path-exists-p (car paths)))
+       ((when err)
+        (mv err nil state))
+       ((when ans1)
+        (mv nil nil state)))
+    (paths-all-missing-p (cdr paths))))
+
+
+(define existing-paths ((paths string-listp) &key (state 'state))
+  :parents (file-types)
+  :short "Collect paths that <see topic='@(url path-exists-p)'>exist</see>."
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans string-listp :hyp (string-listp paths)
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  :verify-guards nil
+
+  (mbe :logic
+       (b* (((when (atom paths))
+             (mv nil nil state))
+            ((mv err exists-p state) (path-exists-p (car paths)))
+            ((when err)
+             (mv err nil state))
+            ((mv err rest state) (existing-paths (cdr paths)))
+            (ans (if exists-p
+                     (cons (car paths) rest)
+                   rest)))
+         (mv err ans state))
+       :exec
+       (b* (((mv err acc state)
+             (existing-paths-exec paths nil)))
+         (mv err (reverse acc) state)))
+
+  :prepwork
+  ((define existing-paths-exec ((paths string-listp) acc &key (state 'state))
+     "Tail recursive version for execution."
+     (b* (((when (atom paths))
+           (mv nil acc state))
+          ((mv err exists-p state) (path-exists-p (car paths)))
+          ((when err)
+           (mv err acc state))
+          (acc (if exists-p
+                   (cons (car paths) acc)
+                 acc)))
+       (existing-paths-exec (cdr paths) acc))))
+
+  ///
+  (local (in-theory (enable existing-paths-exec)))
+
+  (defthm existing-paths-exec-removal
+    (equal (existing-paths-exec paths acc)
+           (b* (((mv err ans state)
+                 (existing-paths paths)))
+             (mv err (revappend ans acc) state))))
+
+  (defthm true-listp-of-existing-paths
+    (true-listp (mv-nth 1 (existing-paths paths)))
+    :rule-classes :type-prescription)
+
+  (verify-guards existing-paths-fn))
+
+
+(define missing-paths ((paths string-listp) &key (state 'state))
+  :parents (file-types)
+  :short "Collect paths that do not <see topic='@(url path-exists-p)'>exist</see>."
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans string-listp :hyp (string-listp paths)
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  :verify-guards nil
+
+  (mbe :logic
+       (b* (((when (atom paths))
+             (mv nil nil state))
+            ((mv err exists-p state) (path-exists-p (car paths)))
+            ((when err)
+             (mv err nil state))
+            ((mv err rest state) (missing-paths (cdr paths)))
+            (ans (if exists-p
+                     rest
+                   (cons (car paths) rest))))
+         (mv err ans state))
+       :exec
+       (b* (((mv err acc state)
+             (missing-paths-exec paths nil)))
+         (mv err (reverse acc) state)))
+
+  :prepwork
+  ((define missing-paths-exec ((paths string-listp) acc &key (state 'state))
+     "Tail recursive version for execution."
+     (b* (((when (atom paths))
+           (mv nil acc state))
+          ((mv err exists-p state) (path-exists-p (car paths)))
+          ((when err)
+           (mv err acc state))
+          (acc (if exists-p
+                   acc
+                 (cons (car paths) acc))))
+       (missing-paths-exec (cdr paths) acc))))
+
+  ///
+  (local (in-theory (enable missing-paths-exec)))
+
+  (defthm missing-paths-exec-removal
+    (equal (missing-paths-exec paths acc)
+           (b* (((mv err ans state)
+                 (missing-paths paths)))
+             (mv err (revappend ans acc) state))))
+
+  (defthm true-listp-of-missing-paths
+    (true-listp (mv-nth 1 (missing-paths paths)))
+    :rule-classes :type-prescription)
+
+  (verify-guards missing-paths-fn))
+
+
+(define regular-file-p ((path stringp) &key (state 'state))
+  :parents (file-types)
+  :short "Does a path, after following symlinks, refer to an existing,
+regular file&mdash;not to a directory, device, etc."
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans booleanp :rule-classes :type-prescription
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  (b* (((mv err ans state) (file-kind path))
+       ((when err)
+        (mv err nil state)))
+    (mv err (eq ans :regular-file) state)))
+
+
+(define regular-files-p ((paths string-listp) &key (state 'state))
+  :parents (file-types)
+  :short "Are all of these paths <see topic='@(url regular-file-p)'>regular
+files</see>?"
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans booleanp :rule-classes :type-prescription
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  (b* (((when (atom paths))
+        (mv nil t state))
+       ((mv err ans1 state) (regular-file-p (car paths)))
+       ((when err)
+        (mv err nil state))
+       ((unless ans1)
+        (mv nil nil state)))
+    (regular-files-p (cdr paths))))
+
+
+(define regular-files ((paths string-listp) &key (state 'state))
+  :parents (file-types)
+  :short "Collect paths that are <see topic='@(url regular-file-p)'>regular
+files</see>."
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans string-listp :hyp (string-listp paths)
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  :verify-guards nil
+
+  (mbe :logic
+       (b* (((when (atom paths))
+             (mv nil nil state))
+            ((mv err regular-p state) (regular-file-p (car paths)))
+            ((when err)
+             (mv err nil state))
+            ((mv err rest state) (regular-files (cdr paths)))
+            (ans (if regular-p
+                     (cons (car paths) rest)
+                   rest)))
+         (mv err ans state))
+       :exec
+       (b* (((mv err acc state)
+             (regular-files-exec paths nil)))
+         (mv err (reverse acc) state)))
+
+  :prepwork
+  ((define regular-files-exec ((paths string-listp) acc &key (state 'state))
+     "Tail recursive version for execution."
+     (b* (((when (atom paths))
+           (mv nil acc state))
+          ((mv err regular-p state) (regular-file-p (car paths)))
+          ((when err)
+           (mv err acc state))
+          (acc (if regular-p
+                   (cons (car paths) acc)
+                 acc)))
+       (regular-files-exec (cdr paths) acc))))
+
+  ///
+  (local (in-theory (enable regular-files-exec)))
+
+  (defthm regular-files-exec-removal
+    (equal (regular-files-exec paths acc)
+           (b* (((mv err ans state)
+                 (regular-files paths)))
+             (mv err (revappend ans acc) state))))
+
+  (defthm true-listp-of-regular-files
+    (true-listp (mv-nth 1 (regular-files paths)))
+    :rule-classes :type-prescription)
+
+  (verify-guards regular-files-fn))
+
+
+
+(define directory-p ((path stringp) &key (state 'state))
+  :parents (file-types)
+  :short "Does a path, after following symlinks, refer to a directory?"
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans booleanp :rule-classes :type-prescription
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  (b* (((mv err ans state) (file-kind path))
+       ((when err)
+        (mv err nil state)))
+    (mv err (eq ans :directory) state)))
+
+(define directories-p ((paths string-listp) &key (state 'state))
+  :parents (file-types)
+  :short "Are all of these paths <see topic='@(url
+directory-p)'>directories</see>?"
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans booleanp :rule-classes :type-prescription
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  (b* (((when (atom paths))
+        (mv nil t state))
+       ((mv err ans1 state) (directory-p (car paths)))
+       ((when err)
+        (mv err nil state))
+       ((unless ans1)
+        (mv nil nil state)))
+    (directories-p (cdr paths))))
+
+(define directories ((paths string-listp) &key (state 'state))
+  :parents (file-types)
+  :short "Collect paths that are <see topic='@(url
+directory-p)'>directories</see>."
+  :returns (mv (err "NIL on success, or an error @(see msg) on failure.")
+               (ans string-listp :hyp (string-listp paths)
+                    "Meaningful only when there is no error.")
+               (state state-p1 :hyp (force (state-p1 state))))
+  :verify-guards nil
+
+  (mbe :logic
+       (b* (((when (atom paths))
+             (mv nil nil state))
+            ((mv err directory-p state) (directory-p (car paths)))
+            ((when err)
+             (mv err nil state))
+            ((mv err rest state) (directories (cdr paths)))
+            (ans (if directory-p
+                     (cons (car paths) rest)
+                   rest)))
+         (mv err ans state))
+       :exec
+       (b* (((mv err acc state)
+             (directories-exec paths nil)))
+         (mv err (reverse acc) state)))
+
+  :prepwork
+  ((define directories-exec ((paths string-listp) acc &key (state 'state))
+     "Tail recursive version for execution."
+     (b* (((when (atom paths))
+           (mv nil acc state))
+          ((mv err directory-p state) (directory-p (car paths)))
+          ((when err)
+           (mv err acc state))
+          (acc (if directory-p
+                   (cons (car paths) acc)
+                 acc)))
+       (directories-exec (cdr paths) acc))))
+
+  ///
+  (local (in-theory (enable directories-exec)))
+
+  (defthm directories-exec-removal
+    (equal (directories-exec paths acc)
+           (b* (((mv err ans state)
+                 (directories paths)))
+             (mv err (revappend ans acc) state))))
+
+  (defthm true-listp-of-directories
+    (true-listp (mv-nth 1 (directories paths)))
+    :rule-classes :type-prescription)
+
+  (verify-guards directories-fn))
+
+
+(defttag :oslib)
+(include-raw "file-types-raw.lsp"
+             ;; BOZO is there any way to allow ACL2 to compile this
+             ;; successfully?  It complains about the OSICAT package
+             ;; not being defined, but, but... god dammit Lisp.
+             :do-not-compile t
+             :host-readtable t)
+
diff -Nru acl2-6.2/books/oslib/getpid.lisp acl2-6.3/books/oslib/getpid.lisp
--- acl2-6.2/books/oslib/getpid.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/oslib/getpid.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -20,29 +20,9 @@
 ;                   Sol Swords <sswords@centtech.com>
 
 (in-package "OSLIB")
-(include-book "read-acl2-oracle")
-(include-book "cutil/define" :dir :system)
-(include-book "tools/include-raw" :dir :system)
+(include-book "logic-defs")
 ; (depends-on "getpid-raw.lsp")
 
-(define getpid (&optional (state 'state))
-  :returns (mv (pid "The Process ID for this ACL2 session on success, or
-                     @('nil') on failure."
-                    (or (natp pid)
-                        (not pid))
-                    :rule-classes :type-prescription)
-               (state state-p1 :hyp (force (state-p1 state))))
-  :parents (oslib)
-  :short "Get the current process identification (PID) number."
-
-  :long "<p>This will just fail if called on an unsupported Lisp.</p>"
-
-  (b* ((- (er hard? __function__ "Raw Lisp definition not installed?"))
-       ((mv err val state) (read-acl2-oracle state))
-       ((when err)
-        (mv nil state)))
-    (mv (nfix val) state)))
-
 (defttag oslib)
 (include-raw "getpid-raw.lsp")
 
diff -Nru acl2-6.2/books/oslib/logic-defs.lisp acl2-6.3/books/oslib/logic-defs.lisp
--- acl2-6.2/books/oslib/logic-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/logic-defs.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,311 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+(include-book "oslib/read-acl2-oracle" :dir :system)
+(include-book "cutil/define" :dir :system)
+(include-book "tools/include-raw" :dir :system)
+(local (include-book "std/typed-lists/string-listp" :dir :system))
+
+
+(define argv (&optional (state 'state))
+  :returns (mv (arguments string-listp)
+               (state state-p1 :hyp (force (state-p1 state))))
+  :parents (oslib)
+  :short "Get the \"application level\" command line arguments passed to ACL2."
+
+  :long "<p>Typically, @('(argv)') is useful for writing command-line programs
+atop ACL2, e.g., using @(see save-exec).</p>
+
+<p>In the logic, this function reads from the ACL2 oracle and coerces
+whatever it finds into a @(see string-listp).  In the execution, we use
+whatever mechanism the host Lisp provides for reading the command line
+arguments that were given to ACL2.</p>
+
+<p>Dead simple, right?  Well, not really.</p>
+
+<p>Usually ACL2 itself, or any custom program you build atop ACL2 using @(see
+save-exec), is really just an <i>image</i> that is executed by the
+<i>runtime</i> for the host Lisp.  For instance, when you build ACL2 on CCL,
+you get:</p>
+
+<ul>
+
+<li>An ACL2 image named @('saved_acl2.lx86cl64') or similar</li>
+
+<li>A script named @('saved_acl2') that is something like this:
+
+@({
+#!/bin/sh
+export CCL_DEFAULT_DIRECTORY=/path/to/ccl
+exec /path/to/ccl/lx86cl64 \
+  -I /path/to/saved_acl2.lx86cl64 \
+  -K ISO-8859-1 \
+  -e \"(acl2::acl2-default-restart)\"
+  -- \"$@\"
+})</li>
+
+</ul>
+
+<p>So this script is invoking the Lisp runtime, named @('lx86cl64'), and
+telling it to execute the ACL2 image, @('saved_acl2.lx86cl64').</p>
+
+<p>The important thing to note here is that command-line options like @('-I'),
+@('-K'), and @('-e'), are arguments <b>to the runtime</b>, not to ACL2.  These
+runtime options vary wildly from Lisp to Lisp.  So for @('argv') to be portable
+and make any sense at all, we really want to exclude these Lisp-runtime
+options, and only give you the \"real\", application-level options for this
+invocation of your program.</p>
+
+<p>Fortunately, most Lisps have a special mechanism to separate their runtime
+options from the application options.  In Allegro, CCL, CLISP, and CMUCL, this
+is done with a special @('--') option.  SBCL uses a slightly more elaborate
+syntax but it's the same basic idea.</p>
+
+<p>So on these Lisps, as long as you are running ACL2 or your save-image using
+a \"proper\" shell script, @('(argv)') will work perfectly and give you exactly
+the arguments to your program, no matter what options you are using, and no
+matter whether the host Lisp runtime takes options with the same names.  For
+details about what a \"proper\" script means, see the comments for your
+particular Lisp in @('oslib/argv-raw.lsp').</p>
+
+<p>Unfortunately, GCL and LispWorks do not have such an option, so on these
+Lisps we do something very half-assed:</p>
+
+<ul>
+<li>We still expect that a \"proper\" shell script will put in a @('--') option
+to separate the runtime options from the program options.</li>
+<li>@('(argv)') just excludes will everything before the @('--').</li>
+</ul>
+
+<p>So even though the Lisp doesn't know about @('--') in this case, we can at
+least keep the Lisp specific options out of your program.</p>
+
+<p>But this isn't perfect.  Since the Lisp doesn't know to stop processing
+options when it sees @('--'), there is a possibility of conflict if your
+program happens to use the same options as the Lisp.  I don't know how to do
+any better, so that's just how it is.</p>"
+
+  (b* ((- (raise "Raw Lisp definition not installed?"))
+       ((mv err val state) (read-acl2-oracle state)))
+    (if (and (not err)
+             (string-listp val))
+        (mv val state)
+      (mv nil state)))
+
+  ///
+  (defthm true-listp-of-argv
+    (true-listp (mv-nth 0 (argv)))
+    :rule-classes :type-prescription))
+
+
+(define date (&optional (state 'state))
+  :returns (mv (datestamp stringp :rule-classes :type-prescription)
+               (state state-p1 :hyp (force (state-p1 state))))
+  :parents (oslib)
+  :short "Get the current datestamp, like \"November 17, 2010 10:25:33\"."
+
+  :long "<p>In the logic this function reads from the ACL2 oracle.  In the
+execution we use Common Lisp's @('get-decoded-time') function to figure out
+what the current date and time is.  We think this <i>should</i> work on any
+Common Lisp system.</p>"
+
+  (b* ((- (raise "Raw Lisp definition not installed?"))
+       ((mv err val state) (read-acl2-oracle state)))
+    (if (and (not err)
+             (stringp val))
+        (mv val state)
+      (mv "Error reading date." state))))
+
+
+(define getpid (&optional (state 'state))
+  :returns (mv (pid "The Process ID for this ACL2 session on success, or
+                     @('nil') on failure."
+                    (or (natp pid)
+                        (not pid))
+                    :rule-classes :type-prescription)
+               (state state-p1 :hyp (force (state-p1 state))))
+  :parents (oslib)
+  :short "Get the current process identification (PID) number."
+
+  :long "<p>This will just fail if called on an unsupported Lisp.</p>"
+
+  (b* ((- (raise  "Raw Lisp definition not installed?"))
+       ((mv err val state) (read-acl2-oracle state))
+       ((when err)
+        (mv nil state)))
+    (mv (nfix val) state)))
+
+
+(define remove-nonstrings (x)
+  :returns (filtered- string-listp)
+  (cond ((atom x)
+         nil)
+        ((stringp (car x))
+         (cons (car x) (remove-nonstrings (cdr x))))
+        (t
+         (remove-nonstrings (cdr x)))))
+
+(define ls-subdirs ((path "Directory to list files in.  May or may not include
+                           a trailing slash.  May use standard idioms like
+                           @('~') or @('~jared').  The empty string means the
+                           current directory."
+                          stringp)
+                    &optional
+                    (state 'state))
+  :returns (mv (error "Success indicator.  We can fail if @('path') does not
+                       exist or isn't readable, etc."
+                      booleanp :rule-classes :type-prescription)
+               (val   "On success: a list of subdirectory names (excludes files).
+                       On failure: an error message explaining the problem."
+                      (and (equal (stringp val) error)
+                           (equal (string-listp val) (not error))))
+               (state state-p1
+                      :hyp (force (state-p1 state))))
+  :parents (oslib)
+  :short "Get a subdirectory listing."
+
+  :long "<p>In the logic this function reads from the ACL2 oracle.  In the
+execution we query the file system to obtain a listing of the
+<b>subdirectories</b> (not ordinary files) of the given @('path').</p>
+
+<p>The subdirectory names returned are <b>not</b> complete paths.  For
+instance, if @('/home/users/jared') contains directories named @('foo') and
+@('bar'), then the resulting @('val') will have @('\"foo\"') and @('\"bar\"'),
+not full paths like @('\"/home/users/jared/foo\"').</p>"
+
+  :ignore-ok t
+  (b* ((- (raise "Raw Lisp definition not installed?"))
+       ((mv err val state) (read-acl2-oracle state))
+       ((when err)
+        (mv t (if (stringp val) val "error") state)))
+    (mv nil (remove-nonstrings val) state)))
+
+(define ls-files ((path "Directory to list files in.  May or may not include
+                         a trailing slash.  May use standard idioms like
+                         @('~') or @('~jared').  The empty string means the
+                         current directory."
+                        stringp)
+                  &optional
+                  (state 'state))
+  :returns (mv (error "Success indicator.  We can fail if @('path') does not
+                       exist or isn't readable, etc."
+                      booleanp :rule-classes :type-prescription)
+               (val "On success: a list of file names (excluding directories).
+                     On failure: an error message explaining the problem."
+                    (and (equal (stringp val) error)
+                         (equal (string-listp val) (not error))))
+               (state state-p1
+                      :hyp (force (state-p1 state))))
+  :parents (oslib)
+  :short "Get a file listing."
+
+  :long "<p>In the logic this function reads from the ACL2 oracle.  In the
+execution we query the file system to obtain a listing of the <b>files</b> (not
+subdirectories) of the given @('path').</p>
+
+<p>The file names returned are <b>not</b> complete paths.  For instance, if
+@('/home/users/jared') contains @('foo.txt'), then @('val') will contain
+@('\"foo.txt\") instead of @('\"/home/users/jared/foo.txt\"').</p>"
+
+  :ignore-ok t
+  (b* ((- (raise "Raw Lisp definition not installed?"))
+       ((mv err val state) (read-acl2-oracle state))
+       ((when err)
+        (mv t (if (stringp val) val "error") state)))
+    (mv nil (remove-nonstrings val) state)))
+
+
+
+
+(define mkdir ((dir "The path that you want to create, e.g., @('./foo/bar')"
+                    stringp)
+               &optional
+               (state 'state))
+  :returns (mv (successp booleanp
+                         :rule-classes :type-prescription
+                         "Success indicator.  We might fail due to file system
+                          permissions, illegal file names, etc.")
+               (state state-p1
+                      :hyp (force (state-p1 state))))
+  :parents (oslib)
+  :short "Make new directories if they don't already exist, like @('mkdir -p'),
+and return a success indicator so you can recover from errors."
+
+  :long "<p>In the logic this function reads from the ACL2 oracle to determine
+if it succeeds.  In the execution, we attempt to create directories using the
+Common Lisp function @('ensure-directories-exist'), and capture any
+errors.</p>"
+
+  :ignore-ok t
+  (b* ((- (raise "Raw Lisp definition not installed?"))
+       ((mv err val state) (read-acl2-oracle state))
+       (okp (and (not err)
+                 (booleanp val)
+                 val)))
+    (mv okp state)))
+
+
+(define mkdir! ((dir "The path that you want to create, e.g., @('./foo/bar')"
+                     stringp)
+               &optional
+               (state 'state))
+  :returns (state state-p1 :hyp (force (state-p1 state)))
+  :parents (oslib)
+  :short "Make new directories if they don't already exist, like @('mkdir -p'),
+or cause a hard error if there is any problem."
+
+  :long "<p>This is just a wrapper for @(see mkdir) that causes an error on any
+failure.</p>"
+
+  (b* (((mv successp state) (mkdir dir state))
+       ((unless successp)
+        (raise "Failed to create ~s0." dir)
+        state))
+    state))
+
+
+
+(define rmtree ((dir "The path that you want to remove, e.g., @('./foo/bar')"
+                     stringp)
+               &optional
+               (state 'state))
+  :returns (mv (successp booleanp
+                         :rule-classes :type-prescription
+                         "Success indicator.  We might fail due to file system
+                          permissions, illegal file names, etc.")
+               (state state-p1
+                      :hyp (force (state-p1 state))))
+  :parents (oslib)
+  :short "Recursively delete files, like the shell command @('rm -rf'), and
+return a success indicator so you can recover from errors."
+
+  :long "<p>In the logic this function reads from the ACL2 oracle to determine
+if it succeeds.  In the execution, we attempt to delete the requested path, and
+detect errors.</p>"
+
+  :ignore-ok t
+  (b* ((- (raise "Raw Lisp definition not installed?"))
+       ((mv err val state) (read-acl2-oracle state))
+       (okp (and (not err)
+                 (booleanp val)
+                 val)))
+    (mv okp state)))
+
diff -Nru acl2-6.2/books/oslib/ls.lisp acl2-6.3/books/oslib/ls.lisp
--- acl2-6.2/books/oslib/ls.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/oslib/ls.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -20,89 +20,9 @@
 ;                   Sol Swords <sswords@centtech.com>
 
 (in-package "OSLIB")
-(include-book "read-acl2-oracle")
-(include-book "cutil/define" :dir :system)
-(include-book "tools/include-raw" :dir :system)
+(include-book "logic-defs")
 ; (depends-on "ls-raw.lsp")
 
-(define remove-nonstrings (x)
-  :returns (filtered- string-listp)
-  (cond ((atom x)
-         nil)
-        ((stringp (car x))
-         (cons (car x) (remove-nonstrings (cdr x))))
-        (t
-         (remove-nonstrings (cdr x)))))
-
-(define ls-subdirs ((path "Directory to list files in.  May or may not include
-                           a trailing slash.  May use standard idioms like
-                           @('~') or @('~jared').  The empty string means the
-                           current directory."
-                          stringp)
-                    &optional
-                    (state 'state))
-  :returns (mv (error "Success indicator.  We can fail if @('path') does not
-                       exist or isn't readable, etc."
-                      booleanp :rule-classes :type-prescription)
-               (val   "On success: a list of subdirectory names (excludes files).
-                       On failure: an error message explaining the problem."
-                      (and (equal (stringp val) error)
-                           (equal (string-listp val) (not error))))
-               (state state-p1
-                      :hyp (force (state-p1 state))))
-  :parents (oslib)
-  :short "Get a subdirectory listing."
-
-  :long "<p>In the logic this function reads from the ACL2 oracle.  In the
-execution we query the file system to obtain a listing of the
-<b>subdirectories</b> (not ordinary files) of the given @('path').</p>
-
-<p>The subdirectory names returned are <b>not</b> complete paths.  For
-instance, if @('/home/users/jared') contains directories named @('foo') and
-@('bar'), then the resulting @('val') will have @('\"foo\"') and @('\"bar\"'),
-not full paths like @('\"/home/users/jared/foo\"').</p>"
-
-  :ignore-ok t
-  (b* ((- (er hard? __function__ "Raw Lisp definition not installed?"))
-       ((mv err val state) (read-acl2-oracle state))
-       ((when err)
-        (mv t (if (stringp val) val "error") state)))
-    (mv nil (remove-nonstrings val) state)))
-
-(define ls-files ((path "Directory to list files in.  May or may not include
-                         a trailing slash.  May use standard idioms like
-                         @('~') or @('~jared').  The empty string means the
-                         current directory."
-                        stringp)
-                  &optional
-                  (state 'state))
-  :returns (mv (error "Success indicator.  We can fail if @('path') does not
-                       exist or isn't readable, etc."
-                      booleanp :rule-classes :type-prescription)
-               (val "On success: a list of file names (excluding directories).
-                     On failure: an error message explaining the problem."
-                    (and (equal (stringp val) error)
-                         (equal (string-listp val) (not error))))
-               (state state-p1
-                      :hyp (force (state-p1 state))))
-  :parents (oslib)
-  :short "Get a file listing."
-
-  :long "<p>In the logic this function reads from the ACL2 oracle.  In the
-execution we query the file system to obtain a listing of the <b>files</b> (not
-subdirectories) of the given @('path').</p>
-
-<p>The file names returned are <b>not</b> complete paths.  For instance, if
-@('/home/users/jared') contains @('foo.txt'), then @('val') will contain
-@('\"foo.txt\") instead of @('\"/home/users/jared/foo.txt\"').</p>"
-
-  :ignore-ok t
-  (b* ((- (er hard? __function__ "Raw Lisp definition not installed?"))
-       ((mv err val state) (read-acl2-oracle state))
-       ((when err)
-        (mv t (if (stringp val) val "error") state)))
-    (mv nil (remove-nonstrings val) state)))
-
 (defttag oslib)
 (include-raw "ls-raw.lsp")
 
diff -Nru acl2-6.2/books/oslib/mkdir-raw.lsp acl2-6.3/books/oslib/mkdir-raw.lsp
--- acl2-6.2/books/oslib/mkdir-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/mkdir-raw.lsp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,129 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+
+; Old definition using sys-call (which didn't return any error indicator).
+
+;; (defun mkdir (dir state)
+;;   (b* (((unless (stringp dir))
+;;         (er hard? 'mkdir "Dir must be a string, but is: ~x0.~%" dir)
+;;         state)
+;;        (- (sys-call "mkdir" (list "-p" dir)))
+;;        ((mv status state)
+;;         (sys-call-status state))
+;;        ((unless (= status 0))
+;;         (er hard? 'mkdir "error making directory ~s0.~%" dir)
+;;         state))
+;;     state))
+
+
+; I now want to use Common Lisp's ensure-directories-exist function instead,
+; because it avoids forking, which can occasionally cause problems; see for
+; instance the tshell book for discussion of problems related to fork.
+
+
+
+; -------------------------------------------------------------------------
+; The following functions are copied from CL-FAD.  In the long-term it would
+; make more sense not to copy/paste these, but instead to use quicklisp to
+; install CL-FAD and use it directly.  But for now I just do the dumb thing,
+; since Quicklisp may not be perfectly supported on all our Lisps.
+
+;;; Copyright (c) 2004, Peter Seibel.  All rights reserved.
+;;; Copyright (c) 2004-2010, Dr. Edmund Weitz.  All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(defun component-present-p (value)
+  ;; Copied from CL-FAD
+  "Helper function for DIRECTORY-PATHNAME-P which checks whether VALUE
+   is neither NIL nor the keyword :UNSPECIFIC."
+  (and value (not (eql value :unspecific))))
+
+(defun directory-pathname-p (pathspec)
+  ;; Copied from CL-FAD
+  "Returns NIL if PATHSPEC \(a pathname designator) does not designate
+a directory, PATHSPEC otherwise.  It is irrelevant whether file or
+directory designated by PATHSPEC does actually exist."
+  (and
+    (not (component-present-p (pathname-name pathspec)))
+    (not (component-present-p (pathname-type pathspec)))
+    pathspec))
+
+(defun pathname-as-directory (pathspec)
+  ;; Copied from CL-FAD
+  "Converts the non-wild pathname designator PATHSPEC to directory
+form."
+  (let ((pathname (pathname pathspec)))
+    (when (wild-pathname-p pathname)
+      (error "Can't reliably convert wild pathnames."))
+    (cond ((not (directory-pathname-p pathspec))
+           (make-pathname :directory (append (or (pathname-directory pathname)
+                                                 (list :relative))
+                                             (list (file-namestring pathname)))
+                          :name nil
+                          :type nil
+                          :defaults pathname))
+          (t pathname))))
+
+; End of copy pasted code from CL-FAD
+; -------------------------------------------------------------------------
+
+(defun mkdir-fn (dir state)
+
+  (b* (((unless (live-state-p state))
+        (error "MKDIR can only be called on a live state.")
+        (mv nil state))
+
+       ((unless (stringp dir))
+        (error "MKDIR called on a non-stringp dir?")
+        (mv nil state)))
+
+    (handler-case
+     (progn (ensure-directories-exist (pathname-as-directory (pathname dir)))
+            (mv t state))
+     (error (condition)
+            (progn
+              (format t "Error making directory ~s: ~a." dir condition)
+              (mv nil state))))))
+
diff -Nru acl2-6.2/books/oslib/mkdir.lisp acl2-6.3/books/oslib/mkdir.lisp
--- acl2-6.2/books/oslib/mkdir.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/mkdir.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,26 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+(include-book "logic-defs")
+; (depends-on "mkdir-raw.lsp")
+
+(defttag oslib)
+(include-raw "mkdir-raw.lsp")
diff -Nru acl2-6.2/books/oslib/package.lsp acl2-6.3/books/oslib/package.lsp
--- acl2-6.2/books/oslib/package.lsp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/oslib/package.lsp	2013-09-30 17:53:27.000000000 +0000
@@ -40,7 +40,9 @@
                defsection
                defsection-progn
                live-state-p
-               oslib))
+               oslib
+               value
+               msg))
    '(delete union)))
 
 (assign acl2::verbose-theory-warning nil)
diff -Nru acl2-6.2/books/oslib/rmtree-raw.lsp acl2-6.3/books/oslib/rmtree-raw.lsp
--- acl2-6.2/books/oslib/rmtree-raw.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/rmtree-raw.lsp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,43 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+
+(defun rmtree-fn (dir state)
+
+  (b* (((unless (live-state-p state))
+        (error "RMTREE can only be called on a live state.")
+        (mv nil state))
+
+       ((unless (stringp dir))
+        (error "RMTREE called on a non-stringp dir?")
+        (mv nil state))
+
+       (- (sys-call "rm" (list "-rf" dir)))
+
+       ((mv status state)
+        (sys-call-status state))
+
+       ((unless (eql status 0))
+        (error "error removing ~s0." dir)
+        (mv nil state)))
+
+    (mv t state)))
+
diff -Nru acl2-6.2/books/oslib/rmtree.lisp acl2-6.3/books/oslib/rmtree.lisp
--- acl2-6.2/books/oslib/rmtree.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/oslib/rmtree.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -0,0 +1,26 @@
+; OSLIB -- Operating System Utilities
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "OSLIB")
+(include-book "logic-defs")
+; (depends-on "rmtree-raw.lsp")
+
+(defttag oslib)
+(include-raw "rmtree-raw.lsp")
diff -Nru acl2-6.2/books/oslib/top.lisp acl2-6.3/books/oslib/top.lisp
--- acl2-6.2/books/oslib/top.lisp	2013-06-06 17:11:58.000000000 +0000
+++ acl2-6.3/books/oslib/top.lisp	2013-09-30 17:53:27.000000000 +0000
@@ -20,13 +20,18 @@
 
 (in-package "OSLIB")
 
+(include-book "argv")
 (include-book "catpath")
 (include-book "date")
 (include-book "getpid")
 (include-book "ls")
+(include-book "mkdir")
+(include-book "file-types")
 (include-book "tempfile")
+(include-book "rmtree")
 
 (defxdoc oslib
+  :parents (acl2::interfacing-tools)
   :short "Operating System Utilities Library"
 
   :long "<p>This is a collection of ACL2 functions that allow you to do various
diff -Nru acl2-6.2/books/parsers/earley/cert.acl2 acl2-6.3/books/parsers/earley/cert.acl2
--- acl2-6.2/books/parsers/earley/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/cert.acl2	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,21 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;   David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(include-book "centaur/gl/portcullis" :dir :system)
+; cert-flags: ? t :ttags :all :skip-proofs-okp t
+
diff -Nru acl2-6.2/books/parsers/earley/defprimitive.lisp acl2-6.3/books/parsers/earley/defprimitive.lisp
--- acl2-6.2/books/parsers/earley/defprimitive.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/defprimitive.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,44 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;  David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(in-package "ACL2")
+
+(include-book "xdoc/top" :dir :system)
+(include-book "tools/bstar" :dir :system)
+
+(defmacro defprimitive (name args body &key default parents short long)
+  (b* ((xdoc::mksym-package-symbol
+        (if (equal (symbol-package-name name) "COMMON-LISP")
+            'ACL2::an-obscure-symbol-that-should-never-be-used-787
+          name)))
+    `(progn
+       (defsection ,name
+         :parents ,parents
+         :short ,short
+         :long ,long
+
+         (defnd ,(xdoc::mksym name '-p) ,args
+           ,body)
+         (defnd ,(xdoc::mksym 'make- name) ()
+           ,default)))))
+
+(local
+ (defprimitive foo (x)
+   (and (integerp x)
+        (> x 4))
+   :default 7))
diff -Nru acl2-6.2/books/parsers/earley/earley-parser.lisp acl2-6.3/books/parsers/earley/earley-parser.lisp
--- acl2-6.2/books/parsers/earley/earley-parser.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/earley-parser.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,760 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;  David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(in-package "ACL2")
+
+(include-book "str/top" :dir :system)
+(include-book "cutil/defaggregate" :dir :system)
+(include-book "cutil/deflist" :dir :system)
+(include-book "std/lists/repeat" :dir :system) ; redundant
+(include-book "tools/bstar" :dir :system)
+(include-book "tools/defconsts" :dir :system)
+(include-book "xdoc/top" :dir :system)
+
+(include-book "object-representations")
+(include-book "grammar-reader" :skip-proofs-okp t)
+(include-book "strings")
+(include-book "tokenizer")
+
+(defxdoc earley-parser
+  :short "Earley parser written in ACL2"
+  :long "A general parser that takes three inputs: a grammar, a lexicon
+  (perhaps defined with regular expressions), and a string to parse.  This
+  parser then returns a parse tree.  The parsing algorithm that implements this
+  property happens to be an Earley Parser (EP) for reasons beyond the scope of
+  this documentation.
+
+  Earley Parsers are often also called \"Chart parsers\", because the EP
+  terminology dictates that every time the next token in a sentence is read,
+  that a new chart is created.  Each chart contains a set of \"states\" that
+  roughly correspond to rules in the specified grammar that are in different
+  states (depending upon what input has already been seen).
+
+  The EP algorithm starts with exactly one chart, with the starting state as
+  its only state.  Through prediction (and in later states, scanning and
+  completion) more states get added to this initial chart.  At some point a
+  part of speech is encountered, which triggers a scan, which causes the
+  chart-index to be incremented, and the next set of states that are created
+  are added to a new chart.  This continues, where new charts are created and
+  states are added to each of those charts.  In a concrete sense, a list of
+  charts is just a list of a list of states.
+
+  As of August 2013, the EP book comes with many extra constants and examples.
+  We plan to remove these constants in the long-run but have not yet done so.")
+
+;(set-guard-checking :all)
+
+;; (defthm a-lemma
+;;  (IMPLIES (and (< (nfix J) (LEN CHART-LIST))
+;;                (chart-list-p chart-list))
+;;           (CHART-P (NTH J CHART-LIST)))
+;;  :hints (("Goal" :in-theory (enable nth chart-list-p))))
+
+;; (local
+;;  (defthm lemma
+;;    (implies (and (< (nfix j) (len chart-list))
+;;                  (chart-list-p chart-list))
+;;             (pstate-list-p (chart->pstates (nth j chart-list))))
+;;    :hints (("Goal" :in-theory (enable pstate-list-p)))))
+
+;; (local
+;;  (defthm throwaway
+;;    (implies (chart-list-p x)
+;;             (equal (list-fix x)
+;;                    x))))
+
+;; (local
+;;  (defthm predictor1-admit-lemma-FORMER-B
+;;    (implies (and (pstate-p pstate)
+;;                  (pstate-list-p pstate-list))
+;;             (pstate-list-p (append pstate-list
+;;                                    (list pstate))))))
+
+#|
+; no longer needed with the new deflist
+(local
+ (defthm predictor1-admit-lemma-A
+   (implies (and (chart-p chart)
+                 (< (nfix j) (len chart-list))
+                 (chart-list-p chart-list))
+            (chart-list-p
+             (update-nth j chart chart-list)))))
+
+(local
+ (defthm predictor1-admit-lemma-B
+   (implies (pstate-list-p x)
+            (pstate-list-p (list-fix x)))))
+|#
+
+(local
+ (defthm predictor1-lemma
+   (implies
+    (and (string-list-list-p productions)
+         (consp productions)
+         (true-listp productions)
+         (car productions))
+    (< 0 (len (car productions))))
+   :rule-classes :linear))
+
+(define predictor1 ((productions string-list-list-p)
+                    (B stringp)
+                    (j natp)
+                    (new-pstates pstate-list-p)
+                    (chart-list chart-list-p))
+  :guard (and (< j (len chart-list))
+              ;(< j (len productions))
+              )
+  :guard-debug t
+  :parents (earley-parser)
+  ;:guard-hints (("[1]Goal'" :use ((:instance predictor1-lemma-d))
+  ;               :in-theory (disable predictor1-lemma-d)))
+  :returns (mv (pstates pstate-list-p :hyp :fguard)
+               (chart-list chart-list-p :hyp :fguard))
+  ;:assert (pstate-list-p chart-list-p)
+  (cond ((not (< j (len chart-list)))
+         (prog2$ (er hard? 'predictor1
+                     "Predictor1 was given an argument for j that is greater ~
+                      than the length of chart-list.  ~%J is: ~x0 ~
+                      ~%Productions is: ~x1 ~% Chart-list is ~x2"
+                     j productions chart-list)
+                 (mv (reverse new-pstates) chart-list)))
+        ;; ((not (< j (len productions)))
+        ;;  (prog2$ (er hard? 'predictor1
+        ;;              "Predictor1 was given an argument for j that is greater ~
+        ;;               than the length of productions.  ~%J is: ~x0 ~
+        ;;               ~%Productions is: ~x1 ~% Chart-list is ~x2"
+        ;;              j productions chart-list)
+        ;;          (mv (reverse new-pstates) chart-list)))
+        ((atom productions)
+         (mv (reverse new-pstates) chart-list))
+        (t
+         (b* ((new-pstate
+               (make-pstate :source B
+                            :targets (car productions)
+                            :dot 0
+                            :start-index j
+                            :dot-index j))
+              ((run-when (> *debug* 2))
+               (cw "  predictor attempting to enqueue")
+               (pstate->print new-pstate)
+               (cw " into chart ~x0~%"  j))
+              (chart-list
+               (update-nth j
+                           (enqueue new-pstate (nth j chart-list))
+                           chart-list)))
+           (predictor1 (cdr productions)
+                       B
+                       j
+                       (cons new-pstate new-pstates)
+                       chart-list)))))
+
+(defmacro assert-type (type-p default-value form)
+  `(let ((val ,form))
+     (if (,type-p val)
+         val
+       (prog2$ (er hard? 'assert-type
+                   "~x0 is not of type ~x1")
+               ,default-value))))
+
+
+(define predictor ((pstate pstate-p)
+                   (chart-list chart-list-p)
+                   (grammar grammar-p))
+; Predict possible successor states based on the grammar. As a side-effect, add
+; these states to the chart that this state belongs to.
+  :guard-debug t
+; The specification of this guard/precondition below is inconsistent with the
+; runtime-error approach I've used later in other definitions.  I leave it for
+; now, since if we want to improve the code, we'll want to push the
+; runtime-checks into guards.
+  :guard (< (pstate->dot-index pstate) (len chart-list))
+  :returns (mv (pstate-list pstate-list-p :hyp :fguard)
+               (chart-list chart-list-p :hyp :fguard))
+  :parents (earley-parser)
+  ;:assert (pstate-list-p chart-list-p)
+  (let* ((B (next-target pstate))
+         (j (pstate->dot-index pstate))
+         (productions (grammar-productions B grammar)))
+    (predictor1 productions B j nil chart-list)))
+
+(defn terminal-or-nil-p (x)
+  (or (null x)
+      (terminal-p x)))
+
+(define member-lexicon-equal ((B stringp)
+                              (terminals terminal-list-p))
+  :returns (terminal terminal-or-nil-p :hyp :fguard) ; useless return lemma
+  ;:assert terminal-or-nil-p
+  :parents (earley-parser)
+  (cond ((atom terminals)
+         nil)
+        ((equal b (terminal->class (car terminals)))
+         (car terminals))
+        (t (member-lexicon-equal b (cdr terminals)))))
+
+(defn pstate-or-nil-p (x)
+  (or (null x)
+      (pstate-p x)))
+
+;; (defthm scanner-lemma-0
+;;   (implies (and (pstate-p pstate)
+;;                 (word-list-p word-list)
+;;                 (chart-list-p chart-list)
+;;                 (lexicon-p lexicon))
+;;            (pstate-p (b* ((B (next-target pstate))
+;;                           (j (pstate->dot-index pstate))
+;;                           (word (nth j word-list))
+;;                           ((run-when (> *debug* 2))
+;;                            (cw "  scanner is considering if ~@0 is a member of " B)
+;;                            (cw "the word-class list for ~x0 (= ~x1)~%"
+;;                                word
+;;                                (lexicon-lookup word lexicon))))
+;;                        (make-pstate :source B
+;;                                     :targets (list word)
+;;                                     :dot 1
+;;                                     :start-index j
+;;                                     :dot-index (+ j 1))))))
+
+(defthm scanner-lemma-A
+  (implies (and (chart-list-p chart-list)
+                (pstate-p new-pstate)
+                (integerp j)
+                (force (< (+ 1 j) (len chart-list)))
+                (force (<= 0 (+ 1 j))))
+           (chart-p
+            (enqueue new-pstate
+                     (nth (+ j 1)
+                          chart-list)))))
+(defthm scanner-lemma-B
+  (implies (and (chart-list-p chart-list)
+                (pstate-p new-pstate)
+                (integerp j)
+                (force (< (+ 1 j) (len chart-list)))
+                (force (<= 0 (+ 1 j))))
+           (chart-list-p (update-nth (+ j 1)
+                                   (enqueue new-pstate
+                                            (nth (+ j 1)
+                                                 chart-list))
+                                   chart-list))))
+
+(define scanner ((pstate pstate-p)
+                 (word-list word-list-p)
+                 (chart-list chart-list-p)
+                 (lexicon lexicon-p))
+  :otf-flg t
+  :guard-debug t
+  :returns (mv (pstate pstate-list-p :hyp :fguard) ; was incorrectly pstate-or-nil-p
+               (chart-list chart-list-p :hyp :fguard))
+  ;:assert (pstate-or-nil-p chart-list-p)
+  :parents (earley-parser)
+  (b* ((next-target (next-target pstate))
+       (start-index (pstate->dot-index pstate))
+       (word (string-fix-with-error (nth start-index word-list)))
+       ((run-when (> *debug* 2))
+        (cw "  scanner is considering if ~@0 is a member of " next-target)
+        (cw "the word-class list for ~x0 (= ~x1)~%"
+            word
+            (lexicon-lookup word lexicon)))
+       (new-pstate
+        (make-pstate :source next-target
+                     :targets (list word)
+                     :dot 1
+                     :start-index start-index
+                     :dot-index (+ start-index 1))))
+    (if (member-lexicon-equal next-target (lexicon-lookup word lexicon))
+        (b* (((run-when (> *debug* 2))
+              (cw "  scanner attempting to enqueue")
+              (pstate->print new-pstate)
+              (cw " into chart ~x0~%" (+ start-index 1))))
+          (mv nil
+              (if (< (+ start-index 1) (len chart-list))
+                  (update-nth (+ start-index 1)
+                              (enqueue new-pstate
+                                       (nth (+ start-index 1) ; this is triggering guard
+                                            chart-list))
+                              chart-list)
+                (prog2$ (er hard? 'scanner "Chart-list wasn't long enough")
+                        chart-list))))
+      (mv nil chart-list))))
+
+(define completer1 ((potential-prev-states pstate-list-p)
+                    (new-states pstate-list-p)
+                    (pstate pstate-p)
+                    (chart-list chart-list-p)
+                    (dot-index natp) ; state-dot-index
+                    (source stringp)) ; state-source
+  :returns (mv (new-pstates pstate-list-p :hyp :fguard)
+               (chart-list chart-list-p :hyp :fguard))
+  :parents (earley-parser)
+  ;:assert (pstate-list-p chart-list-p)
+  (if (atom potential-prev-states)
+      (mv (reverse new-states) chart-list)
+    (b* ((prev-state (car potential-prev-states))
+         (a (next-target prev-state))
+; If the non-terminals are different, don't need to add this state
+         ((when (not (equal a source)))
+          (completer1 (cdr potential-prev-states)
+                      new-states
+                      pstate
+                      chart-list
+                      dot-index
+                      source))
+         ((run-when (and ;(equal a source) ; redundant test
+                     (> *debug* 3)))
+          (cw "    completer found the state: ")
+          (pstate->print prev-state)
+          (cw " to match")
+          (pstate->print pstate)
+          (cw "~%"))
+
+         ((when (not (<= (+ 1 (pstate->dot prev-state))
+                         (len (pstate->targets prev-state)))))
+          (prog2$ (er hard? 'completer1 "Error related to dot and targets")
+                  (mv new-states chart-list)))
+         ((when (not (<= (PSTATE->START-INDEX prev-state)
+                         DOT-INDEX)))
+          (prog2$ (er hard? 'completer1 "Error related to start-index and
+                                         dot-index")
+                  (mv new-states chart-list)))
+         ((when (not (< DOT-INDEX (LEN CHART-LIST))))
+          (prog2$ (er hard? 'completer1 "Problem with dot-index and
+                                         chart-list")
+                  (mv new-states chart-list)))
+         (new-pstate (make-pstate
+                      :source (pstate->source prev-state)
+                      :targets (pstate->targets prev-state)
+                      :dot (+ (pstate->dot prev-state) 1)
+                      :start-index (pstate->start-index prev-state)
+                      :dot-index dot-index
+                      :history (append (list pstate)
+                                             (pstate->history
+                                              prev-state))))
+         ((run-when (> *debug* 2))
+          (cw "  completer attempting to enqueue")
+          (pstate->print new-pstate)
+          (cw " into chart ~x0~%" dot-index))
+         (chart-list (update-nth dot-index
+                                 (enqueue new-pstate (nth dot-index chart-list))
+                                 chart-list)))
+      (completer1 (cdr potential-prev-states)
+                  (cons new-pstate new-states)
+                  pstate
+                  chart-list
+                  dot-index
+                  source))))
+
+(define completer ((pstate pstate-p)
+                   (chart-list chart-list-p))
+  :long "Find and return a list of the previous states that expect this states
+   category at this dot-index with the dot moved one step forward. Also returns
+   a chart-list that contains those states enqueued in the chart-list."
+  :returns (mv (pstate-list pstate-list-p :hyp :fguard)
+               (chart-list chart-list-p :hyp :fguard))
+  ;:assert (pstate-list-p chart-list-p)
+  :parents (earley-parser)
+  :guard-debug t
+  (b* ((source (pstate->source pstate))
+       (start-index (pstate->start-index pstate))
+       (dot-index (pstate->dot-index pstate))
+; potential-prev-states are those states that could potentially be waiting for
+; pstate to complete before they can complete.
+       ((when (>= start-index (len chart-list)))
+        (prog2$ (er hard? 'completer
+                    "Start-index not within range of chart-list")
+                (mv (list pstate) chart-list)))
+       (potential-prev-states (chart->pstates (nth start-index chart-list))))
+    (completer1 potential-prev-states nil pstate chart-list dot-index source)))
+
+
+(define earley-parse400 ((chart chart-p)
+                         (state-index natp)
+                         (chart-list chart-list-p)
+                         (words word-list-p)
+                         (lexicon lexicon-p)
+                         (grammar grammar-p))
+  :returns (mv (pstate-list pstate-list-p :hyp :fguard)
+               (chart-list chart-list-p :hyp :fguard))
+  ;:assert (pstate-list-p chart-list-p)
+  :guard-debug t
+  :parents (earley-parser)
+  (b* (
+       ((when (not (< state-index (len (chart->pstates chart)))))
+        (prog2$ (er hard? 'earley-parse400
+                    "State-index out of bounds")
+                (mv nil nil)))
+       (pstate (nth state-index (chart->pstates chart)))
+       ((run-when (> *debug* 1))
+        (cw "considering state: ")
+        (pstate->print pstate)
+        (cw "~%next cat of this~@0 state is ~@1~%"
+            (if (incomplete-p pstate) " (incomplete)" "")
+            (string-fix (next-target pstate))))) ; no error in this case
+    (cond ((or
+            (and (incomplete-p pstate)
+                 (not (member-equal (next-target pstate)
+                                    (lexicon->part-of-speech lexicon)))))
+           (b* (((run-when (> *debug* 1))
+                 (cw "predicting...~%"))
+                ((when (not (< (pstate->dot-index pstate) (len chart-list))))
+                 (prog2$ (er hard? 'earley-parse400
+                             "Dot-index out of bounds")
+                         (mv nil nil))))
+             (predictor pstate chart-list grammar))) ; (mv pstate chart-list)
+          ((and (incomplete-p pstate)
+                (member-equal (next-target pstate)
+                        (lexicon->part-of-speech lexicon)))
+           (if (equal chart (first (last chart-list)))
+               ;(prog2$ (break$) (mv nil chart-list))
+               (mv nil chart-list)
+             (b* (((run-when (> *debug* 1))
+                   (cw "scanning...~%")))
+               (scanner pstate words chart-list lexicon))))
+          (t (b* (((run-when (> *debug* 1))
+                   (cw "completing...~%")))
+               (completer pstate chart-list))))))
+
+(define earley-parse200 ((chart chart-p)
+                         (state-index natp)
+                         (chart-list chart-list-p)
+                         (words word-list-p)
+                         (lexicon lexicon-p)
+                         (grammar grammar-p))
+
+; It's rather difficult to prove termination of this function, because the
+; number of pstates in chart actually increases with each recursion,
+; basically until a fixed point is reached.  These types of fixed point
+; arguments are difficult to make, and we don't want to go through the
+; trouble at the moment.  To check that the above skip-proofs only skips the
+; termination proof, I submitted the expanded defund in program mode, verified
+; its termination with a skip-proofs, and then successfully submitted the
+; define in logic mode.
+
+  ;:measure (- (length (chart->pstates chart)) state-index)
+  :returns (chart-list chart-list-p :hyp :fguard)
+  :guard-debug t
+  :parents (earley-parser)
+  (if (>= state-index (length (chart->pstates chart)))
+      chart-list
+    (mv-let (pstates-to-add-to-chart chart-list)
+      (earley-parse400 chart state-index chart-list words lexicon grammar)
+      (earley-parse200
+; This call of chart->add-pstate-list is a critical difference between the ACL2
+; and CL versions.
+       (chart->add-pstate-list pstates-to-add-to-chart chart)
+       (1+ state-index) chart-list words lexicon grammar)))
+  :prepwork
+  ((skip-proofs
+   (defthm earley-parse200-termination-obligation
+     (IMPLIES
+     (< STATE-INDEX
+        (LENGTH (CHART->PSTATES CHART)))
+     (< (ACL2-COUNT
+             (CHART->ADD-PSTATE-LIST
+                  (MV-NTH 0
+                          (EARLEY-PARSE400 CHART STATE-INDEX
+                                           CHART-LIST WORDS LEXICON GRAMMAR))
+                  CHART))
+        (ACL2-COUNT CHART)))))))
+
+(define earley-parse100 ((chart chart-p)
+                         (chart-index natp)
+                         (chart-list chart-list-p)
+                         (words word-list-p)
+                         (lexicon lexicon-p)
+                         (grammar grammar-p))
+  :returns (chart-list chart-list-p :hyp :fguard)
+  ;:assert chart-list-p
+  :parents (earley-parser)
+  (b* (((run-when (> *debug* 0))
+        (cw "~%---- processing chart #~x0, which is as follows ----~%" chart-index))
+       ((run-when (> *debug* 0))
+        (cw "~x1~%---- end of chart#~x0 ----~%"
+            chart-index
+            chart))
+       ((run-when (> *debug* 4))
+        (cw "---- Here's the associated chart-list for chart #~x0 ----~%"
+            chart-index
+            chart))
+       ((run-when (> *debug* 4))
+        (cw "~%~x1~%---- End of associated chart-list for chart #~x0 ----~%"
+            chart-index
+            chart-list))
+       (chart-list
+        (earley-parse200 chart 0 chart-list words lexicon
+                         grammar))
+       ((run-when (> *debug* 0))
+        (cw "~%")))
+    chart-list))
+
+(define earley-parse50 ((chart-list chart-list-p)
+                       (chart-index natp)
+                       (words word-list-p)
+                       (lexicon lexicon-p)
+                       (grammar grammar-p)
+                       (updated-chart-list chart-list-p))
+
+; We could prove termination of this function, in particular, if we knew that
+; the length of chart-list wasn't changing during each recursion.  But, we'd
+; have to prove that earley-parse100 provides that property, which would
+; require that we prove that property about earley-parse200.  We leave that
+; proof for another day.  However we did make sure that the other events in the
+; define admit without a skip-proofs (by admitting expanded defund into program
+; mode, verifying its termination with a skip-proofs, and then admitting the
+; define.
+
+  ;; this measure is correct, we just don't have the supporting lemmas to use
+  ;;it.
+  ;;:measure (- (len chart-list) chart-index)
+
+  :returns (chart-list chart-list-p :hyp :fguard)
+  :parents (earley-parser)
+
+  (cond ( ;(atom chart-list) ; could also test against length
+         (>= chart-index (len chart-list))
+         updated-chart-list)
+        (t
+         (let ((updated-chart-list
+                (earley-parse100 (nth chart-index chart-list)
+                                 chart-index
+                                 updated-chart-list
+                                 words
+                                 lexicon
+                                 grammar))
+               (updated-chart-index (1+ chart-index)))
+           (earley-parse50 updated-chart-list
+                           updated-chart-index
+                           words
+                           lexicon
+                           grammar
+                           updated-chart-list))))
+  :prepwork
+  ((skip-proofs
+    (defthm earley-parse50-termination-obligation
+      (IMPLIES (< CHART-INDEX (LEN CHART-LIST))
+         (< (ACL2-COUNT (EARLEY-PARSE100 (NTH CHART-INDEX CHART-LIST)
+                                         CHART-INDEX UPDATED-CHART-LIST
+                                         WORDS LEXICON GRAMMAR))
+            (ACL2-COUNT CHART-LIST)))))))
+
+
+
+(define earley-parse25 ((sentence sentence-p)
+                        (grammar grammar-p)
+                        (lexicon lexicon-p))
+  :returns (chart-list chart-list-p :hyp :fguard)
+  :parents (earley-parser)
+  :guard-hints (("Goal" :in-theory (enable word-list-p)))
+  "Convert a string of words into a chart conforming to the grammar."
+  (b* ((words (remove-equal "" (str::strtok sentence '(#\Space))))
+       ;; Initialize charts, one chart per word in the sentence (plus an extra
+       ;; chart that we won't use, in slot 0)
+       (chart-list (repeat (make-chart) (1+ (length words))))
+       ;; Start off by enqueuing a dummy state in the first chart
+       (chart-list (update-nth 0 (enqueue (make-pstate :source "G"
+                                                       :targets '("S")
+                                                       :dot 0
+                                                       :start-index 0
+                                                       :dot-index 0)
+                                          (nth 0 chart-list))
+                               chart-list)))
+    ;; Then for each chart (= one per word)...
+    (earley-parse50 chart-list 0 words lexicon grammar chart-list))
+  :prepwork
+  ((defthm rewrite-word-list-p
+     (equal (word-list-p x)
+            (string-listp x)))
+
+   (defthm another-dopey-lemma
+     (implies (string-listp x)
+              (string-listp (remove-equal "" x))))))
+
+(define earley-parse ((sentence sentence-p)
+                        (grammar grammar-p)
+                        (lexicon lexicon-p))
+  :returns (chart-list chart-list-p :hyp :fguard)
+  :parents (earley-parser)
+  (earley-parse25 (tokenize-string sentence) grammar lexicon))
+
+; Dynamic programming example
+
+(defconsts (*dp-grammar* state)
+  (load-bnf-grammar "./examples/dp-grammar.txt" state))
+
+(defconsts (*dp-lexicon* state)
+  (load-lexicon "./examples/dp-lexicon.txt" state))
+
+(defconsts (*dp-parse-tree* state)
+  (mv-let (grammar state)
+    (load-bnf-grammar "./examples/dp-grammar.txt" state)
+    (mv-let (lexicon state)
+      (load-lexicon "./examples/dp-lexicon.txt" state)
+      (mv (earley-parse "mary runs" grammar lexicon)
+          state))))
+
+(defconsts *dp-tree-list*
+  (chart-list->trees
+   (earley-parse "mary runs" *dp-grammar* *dp-lexicon*)))
+
+(assert! (equal *dp-tree-list*
+                '(("S" ("noun" "mary") ("verb" "runs")))))
+
+
+; Dynamic programming example
+
+(defconsts (*dp2-grammar* state)
+  (load-bnf-grammar "./examples/dp2-grammar.txt" state))
+
+(defconsts (*dp2-lexicon* state)
+  (load-lexicon "./examples/dp2-lexicon.txt" state))
+
+(defconsts (*dp2-parse-tree* state)
+  (mv-let (grammar state)
+    (load-bnf-grammar "./examples/dp2-grammar.txt" state)
+    (mv-let (lexicon state)
+      (load-lexicon "./examples/dp2-lexicon.txt" state)
+      (mv (earley-parse "john called mary from denver" grammar lexicon)
+          state))))
+
+(defconsts *dp2-tree-list*
+ (chart-list->trees
+  (earley-parse "john called mary from denver" *dp2-grammar* *dp2-lexicon*)))
+
+;(assert! (equal *dp2-tree-list*
+;                '(("S" ("noun" "mary") ("verb" "runs")))))
+
+
+; Common Lisp example without regular expressions
+
+(defconsts (*grammar* state)
+  (load-bnf-grammar "./examples/grammar.txt" state))
+
+(defconsts (*lexicon* state)
+  (load-lexicon "./examples/lexicon.txt" state))
+
+(defconsts (*parse-tree-one* state)
+  (mv-let (grammar state)
+    (load-bnf-grammar "./examples/grammar.txt" state)
+    (mv-let (lexicon state)
+      (load-lexicon "./examples/lexicon.txt" state)
+      (mv (earley-parse "book that flight" grammar lexicon)
+          state))))
+
+(defconsts *parse-tree-two*
+  (earley-parse "book that flight" *grammar* *lexicon*))
+
+(assert! (equal *parse-tree-one* *parse-tree-two*))
+
+(defconsts *tree-list*
+  (chart-list->trees
+   (earley-parse "book that flight" *grammar* *lexicon*)))
+
+
+(assert! (equal *tree-list*
+                '(("S" ("VP" ("verb" "book")
+                        ("NP" ("det" "that")
+                         ("nominal" ("noun" "flight"))))))))
+
+; ; Common Lisp example with regular expressions
+
+(defconsts (*regex-grammar* state)
+  (load-bnf-grammar "./examples/regex-grammar.txt" state))
+
+(defconsts (*regex-lexicon* state)
+  (load-lexicon "./examples/regex-lexicon.txt" state))
+
+(defconsts *regex-tree-list*
+  (chart-list->trees
+   (earley-parse "book that 787" *regex-grammar* *regex-lexicon*)))
+
+(assert! (equal *regex-tree-list*
+                '(("S" ("VP" ("verb" "book")
+                        ("NP" ("det" "that")
+                         ("nominal" ("integer" "787"))))))))
+
+(defconsts (*oracle-grammar* state)
+  (load-bnf-grammar "./examples/oracle-grammar.txt" state))
+
+(defconsts (*oracle-lexicon* state)
+  (load-lexicon "./examples/oracle-lexicon.txt" state))
+
+(defconst *simple-java-example-chart-tree-target*
+  '(("S"
+     ("CompilationUnit"
+      ("TypeDeclarationRag"
+       ("TypeDeclaration"
+        ("ClassOrInterfaceDeclaration"
+         ("ModifierRag" ("Modifier" ("PUBLIC" "public")))
+         ("ClassDeclaration"
+          ("NormalClassDeclaration"
+           ("CLASS" "class")
+           ("Identifier" ("IDENTIFIER" "helloworld"))
+           ("ClassBody"
+            ("LBRACK" "{")
+            ("ClassBodyDeclarationRag"
+             ("ClassBodyDeclaration"
+              ("ModifierRag" ("Modifier" ("PUBLIC" "public"))
+               ("ModifierRag" ("Modifier" ("STATIC" "static"))))
+              ("MemberDecl"
+               ("VOID" "void")
+               ("Identifier" ("IDENTIFIER" "main"))
+               ("VoidMethodDeclaratorRest" ("FormalParameters" ("LPAREN" "(")
+                                            ("RPAREN" ")"))
+                ("Block" ("LBRACK" "{")
+                 ("RBRACK" "}"))))))
+            ("RBRACK" "}")))))))))))
+
+(assert!
+ (equal (chart-list->trees
+         (earley-parse "public class helloworld { public static void main (   ) { } } "
+                       *oracle-grammar* *oracle-lexicon*))
+        *simple-java-example-chart-tree-target*))
+
+(assert!
+ (equal (chart-list->trees
+         (earley-parse "public class helloworld { public static void main () {}}"
+                       *oracle-grammar* *oracle-lexicon*))
+        *simple-java-example-chart-tree-target*))
+
+(assert!
+ (equal (chart-list->trees
+         (earley-parse "
+  public class helloworld {
+    public static void main () {
+
+    }
+  }"
+                       *oracle-grammar* *oracle-lexicon*))
+        *simple-java-example-chart-tree-target*))
+
+#|
+
+(trace$ earley-parse earley-parse25 earley-parse50 earley-parse100
+        earley-parse200 earley-parse400)
+
+
+(trace$ read-next-bnf-production read-next-bnf-production1 read-next-bnf-lexeme
+        read-next-bnf-lexeme1 inject-expansions! load-bnf-grammar1
+        load-bnf-grammar)
+
+(trace$ predictor1 predictor scanner completer1 completer earley-parse400
+        earley-parse200 earley-parse100 earley-parse50 earley-parse25
+        earley-parse load-lexicon)
+
+(trace$ predictor1 predictor scanner completer1 completer)
+
+|#
diff -Nru acl2-6.2/books/parsers/earley/examples/LICENSE acl2-6.3/books/parsers/earley/examples/LICENSE
--- acl2-6.2/books/parsers/earley/examples/LICENSE	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/LICENSE	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,31 @@
+ACL2 Parser for Java
+Copyright (C) 2013 Battelle Memorial Institute
+
+Contact:
+  David Rager, ragerdl@cs.utexas.edu
+
+This program is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free Software
+Foundation; either version 2 of the License, or (at your option) any later
+version.
+
+This program is distributed in the hope that it will be useful but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License along with
+this program; see the file "gpl.txt" in this directory.  If not, write to the
+Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+02110-1335, USA.
+
+
+Additional Copyright Notices:
+
+Note that this library also depends upon other libraries which are
+copyrights of their respective owners and have their own licenses.
+See included files for those licenses.
+
+
+Due to the inability to add comment characters to the text files in
+this directory, the license in this file is (redundantly) declared to
+apply to all of the files in this directory.
\ No newline at end of file
diff -Nru acl2-6.2/books/parsers/earley/examples/dp-grammar.txt acl2-6.3/books/parsers/earley/examples/dp-grammar.txt
--- acl2-6.2/books/parsers/earley/examples/dp-grammar.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/dp-grammar.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1 @@
+<S> ::= <noun> <verb>
diff -Nru acl2-6.2/books/parsers/earley/examples/dp-lexicon.txt acl2-6.3/books/parsers/earley/examples/dp-lexicon.txt
--- acl2-6.2/books/parsers/earley/examples/dp-lexicon.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/dp-lexicon.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,2 @@
+mary :class <noun>
+runs :class <verb>
diff -Nru acl2-6.2/books/parsers/earley/examples/dp2-grammar.txt acl2-6.3/books/parsers/earley/examples/dp2-grammar.txt
--- acl2-6.2/books/parsers/earley/examples/dp2-grammar.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/dp2-grammar.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,4 @@
+<S> ::= <NP> <VP>
+<NP> ::= <NP> <PP> | <Noun>
+<VP> ::= <Verb> <NP> | <VP> <PP>
+<PP> ::= <Prep> <NP>
diff -Nru acl2-6.2/books/parsers/earley/examples/dp2-lexicon.txt acl2-6.3/books/parsers/earley/examples/dp2-lexicon.txt
--- acl2-6.2/books/parsers/earley/examples/dp2-lexicon.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/dp2-lexicon.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,5 @@
+john :class <Noun>
+mary :class <Noun>
+called :class <Verb>
+from :class <Prep>
+denver :class <Noun>
diff -Nru acl2-6.2/books/parsers/earley/examples/grammar.txt acl2-6.3/books/parsers/earley/examples/grammar.txt
--- acl2-6.2/books/parsers/earley/examples/grammar.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/grammar.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,5 @@
+<S>       ::= <aux> <NP> <VP> | <VP>  | <NP> <VP>
+<NP>      ::= <proper-noun> | <det> <nominal> | <integer>
+<VP>      ::= <verb> <NP> 
+		  | <verb>
+<nominal> ::= <noun> <nominal> | <noun>
diff -Nru acl2-6.2/books/parsers/earley/examples/java.g acl2-6.3/books/parsers/earley/examples/java.g
--- acl2-6.2/books/parsers/earley/examples/java.g	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/java.g	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,1033 @@
+/*
+ [The "BSD licence"]
+ Copyright (c) 2007-2008 Terence Parr
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in the
+    documentation and/or other materials provided with the distribution.
+ 3. The name of the author may not be used to endorse or promote products
+    derived from this software without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*/
+/** A Java 1.5 grammar for ANTLR v3 derived from the spec
+ *
+ *  This is a very close representation of the spec; the changes
+ *  are comestic (remove left recursion) and also fixes (the spec
+ *  isn't exactly perfect).  I have run this on the 1.4.2 source
+ *  and some nasty looking enums from 1.5, but have not really
+ *  tested for 1.5 compatibility.
+ *
+ *  I built this with: java -Xmx100M org.antlr.Tool java.g 
+ *  and got two errors that are ok (for now):
+ *  java.g:691:9: Decision can match input such as
+ *    "'0'..'9'{'E', 'e'}{'+', '-'}'0'..'9'{'D', 'F', 'd', 'f'}"
+ *    using multiple alternatives: 3, 4
+ *  As a result, alternative(s) 4 were disabled for that input
+ *  java.g:734:35: Decision can match input such as "{'$', 'A'..'Z',
+ *    '_', 'a'..'z', '\u00C0'..'\u00D6', '\u00D8'..'\u00F6',
+ *    '\u00F8'..'\u1FFF', '\u3040'..'\u318F', '\u3300'..'\u337F',
+ *    '\u3400'..'\u3D2D', '\u4E00'..'\u9FFF', '\uF900'..'\uFAFF'}"
+ *    using multiple alternatives: 1, 2
+ *  As a result, alternative(s) 2 were disabled for that input
+ *
+ *  You can turn enum on/off as a keyword :)
+ *
+ *  Version 1.0 -- initial release July 5, 2006 (requires 3.0b2 or higher)
+ *
+ *  Primary author: Terence Parr, July 2006
+ *
+ *  Version 1.0.1 -- corrections by Koen Vanderkimpen & Marko van Dooren,
+ *      October 25, 2006;
+ *      fixed normalInterfaceDeclaration: now uses typeParameters instead
+ *          of typeParameter (according to JLS, 3rd edition)
+ *      fixed castExpression: no longer allows expression next to type
+ *          (according to semantics in JLS, in contrast with syntax in JLS)
+ *
+ *  Version 1.0.2 -- Terence Parr, Nov 27, 2006
+ *      java spec I built this from had some bizarre for-loop control.
+ *          Looked weird and so I looked elsewhere...Yep, it's messed up.
+ *          simplified.
+ *
+ *  Version 1.0.3 -- Chris Hogue, Feb 26, 2007
+ *      Factored out an annotationName rule and used it in the annotation rule.
+ *          Not sure why, but typeName wasn't recognizing references to inner
+ *          annotations (e.g. @InterfaceName.InnerAnnotation())
+ *      Factored out the elementValue section of an annotation reference.  Created 
+ *          elementValuePair and elementValuePairs rules, then used them in the 
+ *          annotation rule.  Allows it to recognize annotation references with 
+ *          multiple, comma separated attributes.
+ *      Updated elementValueArrayInitializer so that it allows multiple elements.
+ *          (It was only allowing 0 or 1 element).
+ *      Updated localVariableDeclaration to allow annotations.  Interestingly the JLS
+ *          doesn't appear to indicate this is legal, but it does work as of at least
+ *          JDK 1.5.0_06.
+ *      Moved the Identifier portion of annotationTypeElementRest to annotationMethodRest.
+ *          Because annotationConstantRest already references variableDeclarator which 
+ *          has the Identifier portion in it, the parser would fail on constants in 
+ *          annotation definitions because it expected two identifiers.  
+ *      Added optional trailing ';' to the alternatives in annotationTypeElementRest.
+ *          Wouldn't handle an inner interface that has a trailing ';'.
+ *      Swapped the expression and type rule reference order in castExpression to 
+ *          make it check for genericized casts first.  It was failing to recognize a
+ *          statement like  "Class<Byte> TYPE = (Class<Byte>)...;" because it was seeing
+ *          'Class<Byte' in the cast expression as a less than expression, then failing 
+ *          on the '>'.
+ *      Changed createdName to use typeArguments instead of nonWildcardTypeArguments.
+ *          Again, JLS doesn't seem to allow this, but java.lang.Class has an example of
+ *          of this construct.
+ *      Changed the 'this' alternative in primary to allow 'identifierSuffix' rather than
+ *          just 'arguments'.  The case it couldn't handle was a call to an explicit
+ *          generic method invocation (e.g. this.<E>doSomething()).  Using identifierSuffix
+ *          may be overly aggressive--perhaps should create a more constrained thisSuffix rule?
+ *      
+ *  Version 1.0.4 -- Hiroaki Nakamura, May 3, 2007
+ *
+ *  Fixed formalParameterDecls, localVariableDeclaration, forInit,
+ *  and forVarControl to use variableModifier* not 'final'? (annotation)?
+ *
+ *  Version 1.0.5 -- Terence, June 21, 2007
+ *  --a[i].foo didn't work. Fixed unaryExpression
+ *
+ *  Version 1.0.6 -- John Ridgway, March 17, 2008
+ *      Made "assert" a switchable keyword like "enum".
+ *      Fixed compilationUnit to disallow "annotation importDeclaration ...".
+ *      Changed "Identifier ('.' Identifier)*" to "qualifiedName" in more 
+ *          places.
+ *      Changed modifier* and/or variableModifier* to classOrInterfaceModifiers,
+ *          modifiers or variableModifiers, as appropriate.
+ *      Renamed "bound" to "typeBound" to better match language in the JLS.
+ *      Added "memberDeclaration" which rewrites to methodDeclaration or 
+ *      fieldDeclaration and pulled type into memberDeclaration.  So we parse 
+ *          type and then move on to decide whether we're dealing with a field
+ *          or a method.
+ *      Modified "constructorDeclaration" to use "constructorBody" instead of
+ *          "methodBody".  constructorBody starts with explicitConstructorInvocation,
+ *          then goes on to blockStatement*.  Pulling explicitConstructorInvocation
+ *          out of expressions allowed me to simplify "primary".
+ *      Changed variableDeclarator to simplify it.
+ *      Changed type to use classOrInterfaceType, thus simplifying it; of course
+ *          I then had to add classOrInterfaceType, but it is used in several 
+ *          places.
+ *      Fixed annotations, old version allowed "@X(y,z)", which is illegal.
+ *      Added optional comma to end of "elementValueArrayInitializer"; as per JLS.
+ *      Changed annotationTypeElementRest to use normalClassDeclaration and 
+ *          normalInterfaceDeclaration rather than classDeclaration and 
+ *          interfaceDeclaration, thus getting rid of a couple of grammar ambiguities.
+ *      Split localVariableDeclaration into localVariableDeclarationStatement
+ *          (includes the terminating semi-colon) and localVariableDeclaration.  
+ *          This allowed me to use localVariableDeclaration in "forInit" clauses,
+ *           simplifying them.
+ *      Changed switchBlockStatementGroup to use multiple labels.  This adds an
+ *          ambiguity, but if one uses appropriately greedy parsing it yields the
+ *           parse that is closest to the meaning of the switch statement.
+ *      Renamed "forVarControl" to "enhancedForControl" -- JLS language.
+ *      Added semantic predicates to test for shift operations rather than other
+ *          things.  Thus, for instance, the string "< <" will never be treated
+ *          as a left-shift operator.
+ *      In "creator" we rule out "nonWildcardTypeArguments" on arrayCreation, 
+ *          which are illegal.
+ *      Moved "nonWildcardTypeArguments into innerCreator.
+ *      Removed 'super' superSuffix from explicitGenericInvocation, since that
+ *          is only used in explicitConstructorInvocation at the beginning of a
+ *           constructorBody.  (This is part of the simplification of expressions
+ *           mentioned earlier.)
+ *      Simplified primary (got rid of those things that are only used in
+ *          explicitConstructorInvocation).
+ *      Lexer -- removed "Exponent?" from FloatingPointLiteral choice 4, since it
+ *          led to an ambiguity.
+ *
+ *      This grammar successfully parses every .java file in the JDK 1.5 source 
+ *          tree (excluding those whose file names include '-', which are not
+ *          valid Java compilation units).
+ *
+ *  Known remaining problems:
+ *      "Letter" and "JavaIDDigit" are wrong.  The actual specification of
+ *      "Letter" should be "a character for which the method
+ *      Character.isJavaIdentifierStart(int) returns true."  A "Java 
+ *      letter-or-digit is a character for which the method 
+ *      Character.isJavaIdentifierPart(int) returns true."
+ */
+grammar Java;
+options {backtrack=true; memoize=true;}
+
+@lexer::members {
+  protected boolean enumIsKeyword = true;
+  protected boolean assertIsKeyword = true;
+}
+
+// starting point for parsing a java file
+/* The annotations are separated out to make parsing faster, but must be associated with
+   a packageDeclaration or a typeDeclaration (and not an empty one). */
+compilationUnit
+    :   annotations
+        (   packageDeclaration importDeclaration* typeDeclaration*
+        |   classOrInterfaceDeclaration typeDeclaration*
+        )
+    |   packageDeclaration? importDeclaration* typeDeclaration*
+    ;
+
+packageDeclaration
+    :   'package' qualifiedName ';'
+    ;
+    
+importDeclaration
+    :   'import' 'static'? qualifiedName ('.' '*')? ';'
+    ;
+    
+typeDeclaration
+    :   classOrInterfaceDeclaration
+    |   ';'
+    ;
+    
+classOrInterfaceDeclaration
+    :   classOrInterfaceModifiers (classDeclaration | interfaceDeclaration)
+    ;
+    
+classOrInterfaceModifiers
+    :   classOrInterfaceModifier*
+    ;
+
+classOrInterfaceModifier
+    :   annotation   // class or interface
+    |   'public'     // class or interface
+    |   'protected'  // class or interface
+    |   'private'    // class or interface
+    |   'abstract'   // class or interface
+    |   'static'     // class or interface
+    |   'final'      // class only -- does not apply to interfaces
+    |   'strictfp'   // class or interface
+    ;
+
+modifiers
+    :   modifier*
+    ;
+
+classDeclaration
+    :   normalClassDeclaration
+    |   enumDeclaration
+    ;
+    
+normalClassDeclaration
+    :   'class' Identifier typeParameters?
+        ('extends' type)?
+        ('implements' typeList)?
+        classBody
+    ;
+    
+typeParameters
+    :   '<' typeParameter (',' typeParameter)* '>'
+    ;
+
+typeParameter
+    :   Identifier ('extends' typeBound)?
+    ;
+        
+typeBound
+    :   type ('&' type)*
+    ;
+
+enumDeclaration
+    :   ENUM Identifier ('implements' typeList)? enumBody
+    ;
+
+enumBody
+    :   '{' enumConstants? ','? enumBodyDeclarations? '}'
+    ;
+
+enumConstants
+    :   enumConstant (',' enumConstant)*
+    ;
+    
+enumConstant
+    :   annotations? Identifier arguments? classBody?
+    ;
+    
+enumBodyDeclarations
+    :   ';' (classBodyDeclaration)*
+    ;
+    
+interfaceDeclaration
+    :   normalInterfaceDeclaration
+    |   annotationTypeDeclaration
+    ;
+    
+normalInterfaceDeclaration
+    :   'interface' Identifier typeParameters? ('extends' typeList)? interfaceBody
+    ;
+    
+typeList
+    :   type (',' type)*
+    ;
+    
+classBody
+    :   '{' classBodyDeclaration* '}'
+    ;
+    
+interfaceBody
+    :   '{' interfaceBodyDeclaration* '}'
+    ;
+
+classBodyDeclaration
+    :   ';'
+    |   'static'? block
+    |   modifiers memberDecl
+    ;
+    
+memberDecl
+    :   genericMethodOrConstructorDecl
+    |   memberDeclaration
+    |   'void' Identifier voidMethodDeclaratorRest
+    |   Identifier constructorDeclaratorRest
+    |   interfaceDeclaration
+    |   classDeclaration
+    ;
+    
+memberDeclaration
+    :   type (methodDeclaration | fieldDeclaration)
+    ;
+
+genericMethodOrConstructorDecl
+    :   typeParameters genericMethodOrConstructorRest
+    ;
+    
+genericMethodOrConstructorRest
+    :   (type | 'void') Identifier methodDeclaratorRest
+    |   Identifier constructorDeclaratorRest
+    ;
+
+methodDeclaration
+    :   Identifier methodDeclaratorRest
+    ;
+
+fieldDeclaration
+    :   variableDeclarators ';'
+    ;
+        
+interfaceBodyDeclaration
+    :   modifiers interfaceMemberDecl
+    |   ';'
+    ;
+
+interfaceMemberDecl
+    :   interfaceMethodOrFieldDecl
+    |   interfaceGenericMethodDecl
+    |   'void' Identifier voidInterfaceMethodDeclaratorRest
+    |   interfaceDeclaration
+    |   classDeclaration
+    ;
+    
+interfaceMethodOrFieldDecl
+    :   type Identifier interfaceMethodOrFieldRest
+    ;
+    
+interfaceMethodOrFieldRest
+    :   constantDeclaratorsRest ';'
+    |   interfaceMethodDeclaratorRest
+    ;
+    
+methodDeclaratorRest
+    :   formalParameters ('[' ']')*
+        ('throws' qualifiedNameList)?
+        (   methodBody
+        |   ';'
+        )
+    ;
+    
+voidMethodDeclaratorRest
+    :   formalParameters ('throws' qualifiedNameList)?
+        (   methodBody
+        |   ';'
+        )
+    ;
+    
+interfaceMethodDeclaratorRest
+    :   formalParameters ('[' ']')* ('throws' qualifiedNameList)? ';'
+    ;
+    
+interfaceGenericMethodDecl
+    :   typeParameters (type | 'void') Identifier
+        interfaceMethodDeclaratorRest
+    ;
+    
+voidInterfaceMethodDeclaratorRest
+    :   formalParameters ('throws' qualifiedNameList)? ';'
+    ;
+    
+constructorDeclaratorRest
+    :   formalParameters ('throws' qualifiedNameList)? constructorBody
+    ;
+
+constantDeclarator
+    :   Identifier constantDeclaratorRest
+    ;
+    
+variableDeclarators
+    :   variableDeclarator (',' variableDeclarator)*
+    ;
+
+variableDeclarator
+    :   variableDeclaratorId ('=' variableInitializer)?
+    ;
+    
+constantDeclaratorsRest
+    :   constantDeclaratorRest (',' constantDeclarator)*
+    ;
+
+constantDeclaratorRest
+    :   ('[' ']')* '=' variableInitializer
+    ;
+    
+variableDeclaratorId
+    :   Identifier ('[' ']')*
+    ;
+
+variableInitializer
+    :   arrayInitializer
+    |   expression
+    ;
+        
+arrayInitializer
+    :   '{' (variableInitializer (',' variableInitializer)* (',')? )? '}'
+    ;
+
+modifier
+    :   annotation
+    |   'public'
+    |   'protected'
+    |   'private'
+    |   'static'
+    |   'abstract'
+    |   'final'
+    |   'native'
+    |   'synchronized'
+    |   'transient'
+    |   'volatile'
+    |   'strictfp'
+    ;
+
+packageOrTypeName
+    :   qualifiedName
+    ;
+
+enumConstantName
+    :   Identifier
+    ;
+
+typeName
+    :   qualifiedName
+    ;
+
+type
+	:	classOrInterfaceType ('[' ']')*
+	|	primitiveType ('[' ']')*
+	;
+
+classOrInterfaceType
+	:	Identifier typeArguments? ('.' Identifier typeArguments? )*
+	;
+
+primitiveType
+    :   'boolean'
+    |   'char'
+    |   'byte'
+    |   'short'
+    |   'int'
+    |   'long'
+    |   'float'
+    |   'double'
+    ;
+
+variableModifier
+    :   'final'
+    |   annotation
+    ;
+
+typeArguments
+    :   '<' typeArgument (',' typeArgument)* '>'
+    ;
+    
+typeArgument
+    :   type
+    |   '?' (('extends' | 'super') type)?
+    ;
+    
+qualifiedNameList
+    :   qualifiedName (',' qualifiedName)*
+    ;
+
+formalParameters
+    :   '(' formalParameterDecls? ')'
+    ;
+    
+formalParameterDecls
+    :   variableModifiers type formalParameterDeclsRest
+    ;
+    
+formalParameterDeclsRest
+    :   variableDeclaratorId (',' formalParameterDecls)?
+    |   '...' variableDeclaratorId
+    ;
+    
+methodBody
+    :   block
+    ;
+
+constructorBody
+    :   '{' explicitConstructorInvocation? blockStatement* '}'
+    ;
+
+explicitConstructorInvocation
+    :   nonWildcardTypeArguments? ('this' | 'super') arguments ';'
+    |   primary '.' nonWildcardTypeArguments? 'super' arguments ';'
+    ;
+
+
+qualifiedName
+    :   Identifier ('.' Identifier)*
+    ;
+    
+literal 
+    :   integerLiteral
+    |   FloatingPointLiteral
+    |   CharacterLiteral
+    |   StringLiteral
+    |   booleanLiteral
+    |   'null'
+    ;
+
+integerLiteral
+    :   HexLiteral
+    |   OctalLiteral
+    |   DecimalLiteral
+    ;
+
+booleanLiteral
+    :   'true'
+    |   'false'
+    ;
+
+// ANNOTATIONS
+
+annotations
+    :   annotation+
+    ;
+
+annotation
+    :   '@' annotationName ( '(' ( elementValuePairs | elementValue )? ')' )?
+    ;
+    
+annotationName
+    : Identifier ('.' Identifier)*
+    ;
+
+elementValuePairs
+    :   elementValuePair (',' elementValuePair)*
+    ;
+
+elementValuePair
+    :   Identifier '=' elementValue
+    ;
+    
+elementValue
+    :   conditionalExpression
+    |   annotation
+    |   elementValueArrayInitializer
+    ;
+    
+elementValueArrayInitializer
+    :   '{' (elementValue (',' elementValue)*)? (',')? '}'
+    ;
+    
+annotationTypeDeclaration
+    :   '@' 'interface' Identifier annotationTypeBody
+    ;
+    
+annotationTypeBody
+    :   '{' (annotationTypeElementDeclaration)* '}'
+    ;
+    
+annotationTypeElementDeclaration
+    :   modifiers annotationTypeElementRest
+    ;
+    
+annotationTypeElementRest
+    :   type annotationMethodOrConstantRest ';'
+    |   normalClassDeclaration ';'?
+    |   normalInterfaceDeclaration ';'?
+    |   enumDeclaration ';'?
+    |   annotationTypeDeclaration ';'?
+    ;
+    
+annotationMethodOrConstantRest
+    :   annotationMethodRest
+    |   annotationConstantRest
+    ;
+    
+annotationMethodRest
+    :   Identifier '(' ')' defaultValue?
+    ;
+    
+annotationConstantRest
+    :   variableDeclarators
+    ;
+    
+defaultValue
+    :   'default' elementValue
+    ;
+
+// STATEMENTS / BLOCKS
+
+block
+    :   '{' blockStatement* '}'
+    ;
+    
+blockStatement
+    :   localVariableDeclarationStatement
+    |   classOrInterfaceDeclaration
+    |   statement
+    ;
+    
+localVariableDeclarationStatement
+    :    localVariableDeclaration ';'
+    ;
+
+localVariableDeclaration
+    :   variableModifiers type variableDeclarators
+    ;
+    
+variableModifiers
+    :   variableModifier*
+    ;
+
+statement
+    : block
+    |   ASSERT expression (':' expression)? ';'
+    |   'if' parExpression statement (options {k=1;}:'else' statement)?
+    |   'for' '(' forControl ')' statement
+    |   'while' parExpression statement
+    |   'do' statement 'while' parExpression ';'
+    |   'try' block
+        ( catches 'finally' block
+        | catches
+        |   'finally' block
+        )
+    |   'switch' parExpression '{' switchBlockStatementGroups '}'
+    |   'synchronized' parExpression block
+    |   'return' expression? ';'
+    |   'throw' expression ';'
+    |   'break' Identifier? ';'
+    |   'continue' Identifier? ';'
+    |   ';' 
+    |   statementExpression ';'
+    |   Identifier ':' statement
+    ;
+    
+catches
+    :   catchClause (catchClause)*
+    ;
+    
+catchClause
+    :   'catch' '(' formalParameter ')' block
+    ;
+
+formalParameter
+    :   variableModifiers type variableDeclaratorId
+    ;
+        
+switchBlockStatementGroups
+    :   (switchBlockStatementGroup)*
+    ;
+    
+/* The change here (switchLabel -> switchLabel+) technically makes this grammar
+   ambiguous; but with appropriately greedy parsing it yields the most
+   appropriate AST, one in which each group, except possibly the last one, has
+   labels and statements. */
+switchBlockStatementGroup
+    :   switchLabel+ blockStatement*
+    ;
+    
+switchLabel
+    :   'case' constantExpression ':'
+    |   'case' enumConstantName ':'
+    |   'default' ':'
+    ;
+    
+forControl
+options {k=3;} // be efficient for common case: for (ID ID : ID) ...
+    :   enhancedForControl
+    |   forInit? ';' expression? ';' forUpdate?
+    ;
+
+forInit
+    :   localVariableDeclaration
+    |   expressionList
+    ;
+    
+enhancedForControl
+    :   variableModifiers type Identifier ':' expression
+    ;
+
+forUpdate
+    :   expressionList
+    ;
+
+// EXPRESSIONS
+
+parExpression
+    :   '(' expression ')'
+    ;
+    
+expressionList
+    :   expression (',' expression)*
+    ;
+
+statementExpression
+    :   expression
+    ;
+    
+constantExpression
+    :   expression
+    ;
+    
+expression
+    :   conditionalExpression (assignmentOperator expression)?
+    ;
+    
+assignmentOperator
+    :   '='
+    |   '+='
+    |   '-='
+    |   '*='
+    |   '/='
+    |   '&='
+    |   '|='
+    |   '^='
+    |   '%='
+    |   ('<' '<' '=')=> t1='<' t2='<' t3='=' 
+        { $t1.getLine() == $t2.getLine() &&
+          $t1.getCharPositionInLine() + 1 == $t2.getCharPositionInLine() && 
+          $t2.getLine() == $t3.getLine() && 
+          $t2.getCharPositionInLine() + 1 == $t3.getCharPositionInLine() }?
+    |   ('>' '>' '>' '=')=> t1='>' t2='>' t3='>' t4='='
+        { $t1.getLine() == $t2.getLine() && 
+          $t1.getCharPositionInLine() + 1 == $t2.getCharPositionInLine() &&
+          $t2.getLine() == $t3.getLine() && 
+          $t2.getCharPositionInLine() + 1 == $t3.getCharPositionInLine() &&
+          $t3.getLine() == $t4.getLine() && 
+          $t3.getCharPositionInLine() + 1 == $t4.getCharPositionInLine() }?
+    |   ('>' '>' '=')=> t1='>' t2='>' t3='='
+        { $t1.getLine() == $t2.getLine() && 
+          $t1.getCharPositionInLine() + 1 == $t2.getCharPositionInLine() && 
+          $t2.getLine() == $t3.getLine() && 
+          $t2.getCharPositionInLine() + 1 == $t3.getCharPositionInLine() }?
+    ;
+
+conditionalExpression
+    :   conditionalOrExpression ( '?' expression ':' expression )?
+    ;
+
+conditionalOrExpression
+    :   conditionalAndExpression ( '||' conditionalAndExpression )*
+    ;
+
+conditionalAndExpression
+    :   inclusiveOrExpression ( '&&' inclusiveOrExpression )*
+    ;
+
+inclusiveOrExpression
+    :   exclusiveOrExpression ( '|' exclusiveOrExpression )*
+    ;
+
+exclusiveOrExpression
+    :   andExpression ( '^' andExpression )*
+    ;
+
+andExpression
+    :   equalityExpression ( '&' equalityExpression )*
+    ;
+
+equalityExpression
+    :   instanceOfExpression ( ('==' | '!=') instanceOfExpression )*
+    ;
+
+instanceOfExpression
+    :   relationalExpression ('instanceof' type)?
+    ;
+
+relationalExpression
+    :   shiftExpression ( relationalOp shiftExpression )*
+    ;
+    
+relationalOp
+    :   ('<' '=')=> t1='<' t2='=' 
+        { $t1.getLine() == $t2.getLine() && 
+          $t1.getCharPositionInLine() + 1 == $t2.getCharPositionInLine() }?
+    |   ('>' '=')=> t1='>' t2='=' 
+        { $t1.getLine() == $t2.getLine() && 
+          $t1.getCharPositionInLine() + 1 == $t2.getCharPositionInLine() }?
+    |   '<' 
+    |   '>' 
+    ;
+
+shiftExpression
+    :   additiveExpression ( shiftOp additiveExpression )*
+    ;
+
+shiftOp
+    :   ('<' '<')=> t1='<' t2='<' 
+        { $t1.getLine() == $t2.getLine() && 
+          $t1.getCharPositionInLine() + 1 == $t2.getCharPositionInLine() }?
+    |   ('>' '>' '>')=> t1='>' t2='>' t3='>' 
+        { $t1.getLine() == $t2.getLine() && 
+          $t1.getCharPositionInLine() + 1 == $t2.getCharPositionInLine() &&
+          $t2.getLine() == $t3.getLine() && 
+          $t2.getCharPositionInLine() + 1 == $t3.getCharPositionInLine() }?
+    |   ('>' '>')=> t1='>' t2='>'
+        { $t1.getLine() == $t2.getLine() && 
+          $t1.getCharPositionInLine() + 1 == $t2.getCharPositionInLine() }?
+    ;
+
+
+additiveExpression
+    :   multiplicativeExpression ( ('+' | '-') multiplicativeExpression )*
+    ;
+
+multiplicativeExpression
+    :   unaryExpression ( ( '*' | '/' | '%' ) unaryExpression )*
+    ;
+    
+unaryExpression
+    :   '+' unaryExpression
+    |   '-' unaryExpression
+    |   '++' unaryExpression
+    |   '--' unaryExpression
+    |   unaryExpressionNotPlusMinus
+    ;
+
+unaryExpressionNotPlusMinus
+    :   '~' unaryExpression
+    |   '!' unaryExpression
+    |   castExpression
+    |   primary selector* ('++'|'--')?
+    ;
+
+castExpression
+    :  '(' primitiveType ')' unaryExpression
+    |  '(' (type | expression) ')' unaryExpressionNotPlusMinus
+    ;
+
+primary
+    :   parExpression
+    |   'this' ('.' Identifier)* identifierSuffix?
+    |   'super' superSuffix
+    |   literal
+    |   'new' creator
+    |   Identifier ('.' Identifier)* identifierSuffix?
+    |   primitiveType ('[' ']')* '.' 'class'
+    |   'void' '.' 'class'
+    ;
+
+identifierSuffix
+    :   ('[' ']')+ '.' 'class'
+    |   ('[' expression ']')+ // can also be matched by selector, but do here
+    |   arguments
+    |   '.' 'class'
+    |   '.' explicitGenericInvocation
+    |   '.' 'this'
+    |   '.' 'super' arguments
+    |   '.' 'new' innerCreator
+    ;
+
+creator
+    :   nonWildcardTypeArguments createdName classCreatorRest
+    |   createdName (arrayCreatorRest | classCreatorRest)
+    ;
+
+createdName
+    :   classOrInterfaceType
+    |   primitiveType
+    ;
+    
+innerCreator
+    :   nonWildcardTypeArguments? Identifier classCreatorRest
+    ;
+
+arrayCreatorRest
+    :   '['
+        (   ']' ('[' ']')* arrayInitializer
+        |   expression ']' ('[' expression ']')* ('[' ']')*
+        )
+    ;
+
+classCreatorRest
+    :   arguments classBody?
+    ;
+    
+explicitGenericInvocation
+    :   nonWildcardTypeArguments Identifier arguments
+    ;
+    
+nonWildcardTypeArguments
+    :   '<' typeList '>'
+    ;
+
+    
+// Selector implementation that I got rid of so I'd only have one parse tree
+
+// <Selector> ::= 
+//     <PERIOD> <Identifier> 
+//   | <PERIOD> <Identifier> <Arguments> 
+//   | <PERIOD> <ExplicitGenericInvocation> 
+//   | <PERIOD> <THIS> 
+//   | <PERIOD> <SUPER> <SuperSuffic> 
+//   | <NEW> <InnerCreator> 
+//   | <NEW> <NonWildcardTypeArguments> <InnerCreator> 
+//   | <Expression>
+
+selector
+    :   '.' Identifier arguments?
+    |   '.' 'this'
+    |   '.' 'super' superSuffix
+    |   '.' 'new' innerCreator
+    |   '[' expression ']'
+    ;
+    
+superSuffix
+    :   arguments
+    |   '.' Identifier arguments?
+    ;
+
+arguments
+    :   '(' expressionList? ')'
+    ;
+
+// LEXER
+
+HexLiteral : '0' ('x'|'X') HexDigit+ IntegerTypeSuffix? ;
+
+DecimalLiteral : ('0' | '1'..'9' '0'..'9'*) IntegerTypeSuffix? ;
+
+OctalLiteral : '0' ('0'..'7')+ IntegerTypeSuffix? ;
+
+fragment
+HexDigit : ('0'..'9'|'a'..'f'|'A'..'F') ;
+
+fragment
+IntegerTypeSuffix : ('l'|'L') ;
+
+FloatingPointLiteral
+    :   ('0'..'9')+ '.' ('0'..'9')* Exponent? FloatTypeSuffix?
+    |   '.' ('0'..'9')+ Exponent? FloatTypeSuffix?
+    |   ('0'..'9')+ Exponent FloatTypeSuffix?
+    |   ('0'..'9')+ FloatTypeSuffix
+    ;
+
+fragment
+Exponent : ('e'|'E') ('+'|'-')? ('0'..'9')+ ;
+
+fragment
+FloatTypeSuffix : ('f'|'F'|'d'|'D') ;
+
+CharacterLiteral
+    :   '\'' ( EscapeSequence | ~('\''|'\\') ) '\''
+    ;
+
+StringLiteral
+    :  '"' ( EscapeSequence | ~('\\'|'"') )* '"'
+    ;
+
+fragment
+EscapeSequence
+    :   '\\' ('b'|'t'|'n'|'f'|'r'|'\"'|'\''|'\\')
+    |   UnicodeEscape
+    |   OctalEscape
+    ;
+
+fragment
+OctalEscape
+    :   '\\' ('0'..'3') ('0'..'7') ('0'..'7')
+    |   '\\' ('0'..'7') ('0'..'7')
+    |   '\\' ('0'..'7')
+    ;
+
+fragment
+UnicodeEscape
+    :   '\\' 'u' HexDigit HexDigit HexDigit HexDigit
+    ;
+
+ENUM:   'enum' {if (!enumIsKeyword) $type=Identifier;}
+    ;
+    
+ASSERT
+    :   'assert' {if (!assertIsKeyword) $type=Identifier;}
+    ;
+    
+Identifier 
+    :   Letter (Letter|JavaIDDigit)*
+    ;
+
+/**I found this char range in JavaCC's grammar, but Letter and Digit overlap.
+   Still works, but...
+ */
+fragment
+Letter
+    :  '\u0024' |
+       '\u0041'..'\u005a' |
+       '\u005f' |
+       '\u0061'..'\u007a' |
+       '\u00c0'..'\u00d6' |
+       '\u00d8'..'\u00f6' |
+       '\u00f8'..'\u00ff' |
+       '\u0100'..'\u1fff' |
+       '\u3040'..'\u318f' |
+       '\u3300'..'\u337f' |
+       '\u3400'..'\u3d2d' |
+       '\u4e00'..'\u9fff' |
+       '\uf900'..'\ufaff'
+    ;
+
+fragment
+JavaIDDigit
+    :  '\u0030'..'\u0039' |
+       '\u0660'..'\u0669' |
+       '\u06f0'..'\u06f9' |
+       '\u0966'..'\u096f' |
+       '\u09e6'..'\u09ef' |
+       '\u0a66'..'\u0a6f' |
+       '\u0ae6'..'\u0aef' |
+       '\u0b66'..'\u0b6f' |
+       '\u0be7'..'\u0bef' |
+       '\u0c66'..'\u0c6f' |
+       '\u0ce6'..'\u0cef' |
+       '\u0d66'..'\u0d6f' |
+       '\u0e50'..'\u0e59' |
+       '\u0ed0'..'\u0ed9' |
+       '\u1040'..'\u1049'
+   ;
+
+WS  :  (' '|'\r'|'\t'|'\u000C'|'\n') {$channel=HIDDEN;}
+    ;
+
+COMMENT
+    :   '/*' ( options {greedy=false;} : . )* '*/' {$channel=HIDDEN;}
+    ;
+
+LINE_COMMENT
+    : '//' ~('\n'|'\r')* '\r'? '\n' {$channel=HIDDEN;}
+    ;
diff -Nru acl2-6.2/books/parsers/earley/examples/lexicon.txt acl2-6.3/books/parsers/earley/examples/lexicon.txt
--- acl2-6.2/books/parsers/earley/examples/lexicon.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/lexicon.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,5 @@
+book :class <verb>
+flight :class <noun>
+that :class <det>
+be :class <aux>
+Bob :class <proper-noun>
diff -Nru acl2-6.2/books/parsers/earley/examples/oracle-grammar.txt acl2-6.3/books/parsers/earley/examples/oracle-grammar.txt
--- acl2-6.2/books/parsers/earley/examples/oracle-grammar.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/oracle-grammar.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,734 @@
+<S> ::= 
+    <CompilationUnit>
+
+<Identifier> ::= 
+    <IDENTIFIER>
+
+<QualifiedIdentifier> ::= 
+    <Identifier> 
+  | <Identifier> <PERIOD> <QualifiedIdentifier>
+
+<QualifiedIdentifierList> ::= 
+    <QualifiedIdentifier> 
+  | <QualifiedIdentifier> <COMMA> <QualifiedIdentifierList>
+
+<ImportDeclarationRag> ::= 
+    <ImportDeclaration> 
+  | <ImportDeclaration> <ImportDeclarationRag>
+
+<TypeDeclarationRag> ::= 
+    <TypeDeclaration>
+  | <TypeDeclaration> <TypeDeclarationRag>
+
+<CompilationUnit> ::= 
+    <PACKAGE> <QualifiedIdentifier> <SEMICOLON> <ImportDeclarationRag> <TypeDeclarationRag> 
+  | <ImportDeclarationRag> <TypeDeclarationRag> 
+  | <ImportDeclarationRag> 
+  | <TypeDeclarationRag>
+
+<IdentifierRag> ::= 
+    <Identifier>
+  | <Identifier> <PERIOD> <IdentifierRag>
+
+<ImportDeclaration> ::= 
+    <IMPORT> <IdentifierRag> <SEMICOLON> 
+  | <IMPORT> <STATIC> <IdentifierRag> <SEMICOLON> 
+  | <IMPORT> <IdentifierRag> <PERIOD> <STAR> <SEMICOLON> 
+  | <IMPORT> <STATIC> <IdentifierRag> <PERIOD> <STAR> <SEMICOLON>
+
+<TypeDeclaration> ::= 
+    <ClassOrInterfaceDeclaration> 
+  | <SEMICOLON>
+
+<ModifierRag> ::= 
+    <Modifier> 
+  | <Modifier> <ModifierRag>
+
+<ClassOrInterfaceDeclaration> ::= 
+    <ClassDeclaration> 
+  | <InterfaceDeclaration> 
+  | <ModifierRag> <ClassDeclaration> 
+  | <ModifierRag> <InterfaceDeclaration> 
+
+<ClassDeclaration> ::= 
+    <NormalClassDeclaration> 
+  | <EnumDeclaration>
+
+<InterfaceDeclaration> ::= 
+    <NormalInterfaceDeclaration> 
+  | <AnnotationTypeDeclaration>
+
+<NormalClassDeclaration> ::= 
+    <CLASS> <Identifier> <ClassBody>
+  | <CLASS> <Identifier> <TypeParameters> <ClassBody>
+  | <CLASS> <Identifier> <EXTENDS> <Type> <ClassBody>
+  | <CLASS> <Identifier> <TypeParameters> <EXTENDS> <Type> <ClassBody>
+  | <CLASS> <Identifier> <IMPLEMENTS> <TypeList> <ClassBody>
+  | <CLASS> <Identifier> <TypeParameters> <IMPLEMENTS> <TypeList> <ClassBody>
+  | <CLASS> <Identifier> <EXTENDS> <Type> <IMPLEMENTS> <TypeList> <ClassBody>
+  | <CLASS> <Identifier> <TypeParameters> <EXTENDS> <Type> <IMPLEMENTS> <TypeList> <ClassBody>
+
+<EnumDeclaration> ::= 
+    <ENUM> <Identifier> <EnumBody> 
+  | <ENUM> <Identifier> <IMPLEMENTS> <TypleList> <EnumBody>
+
+<NormalInterfaceDeclaration> ::= 
+    <INTERFACE> <Identifier> <InterfaceBody> 
+  | <INTERFACE> <Identifier> <TypeParameters> <InterfaceBody> 
+  | <INTERFACE> <Identifier> <TypeParameters> <EXTENDS> <TypeList> <InterfaceBody> 
+  | <INTERFACE> <Identifier> <EXTENDS> <TypeList> <InterfaceBody>
+
+<AnnotationTypeDeclaration> ::= 
+    <AT> <INTERFACE> <Identifier> <AnnotationTypeBody>
+
+<Type> ::= 
+    <BasicType> 
+  | <BasicType> <SqBrRag>
+
+<Type> ::= 
+    <ReferenceType> 
+  | <ReferenceType> <SqBrRag>
+
+<BasicType> ::= 
+    <BYTE> 
+  | <SHORT> 
+  | <CHAR> 
+  | <INT> 
+  | <LONG> 
+  | <FLOAT> 
+  | <DOUBLE> 
+  | <BOOLEAN>
+
+<ReferenceType> ::=
+    <Identifier>
+  | <Identifier> <PERIOD> <ReferenceType>
+  | <Identifier> <TypeArguments>
+  | <Identifier> <TypeArguments> <PERIOD> <ReferenceType>
+
+<TypeArgumentRag> ::= 
+    <COMMA> <TypeArgument> 
+  | <COMMA> <TypeArgument> <TypeArgumentRag>
+
+<TypeArguments> ::= 
+    <LT> <TypeArgument> <GT> 
+  | <LT> <TypeArgument> <TypeArgumentRag> <GT>
+
+<TypeArgument> ::= 
+    <ReferenceType> 
+  | <QUESTION> <EXTENDS> <ReferenceType> 
+  | <QUESTION> <SUPER> <ReferenceType> 
+  | <QUESTION>
+
+<NonWildcardTypeArguments> ::= 
+    <LT> <TypeList> <GT>
+
+<TypeList> ::= 
+    <ReferenceType> 
+  | <ReferenceType> <COMMAD> <TypeList>
+
+<TypeArgumentsOrDiamond> ::= 
+    <LT> <GT> 
+  | <TypeArguments>
+
+<NonWildcardTypeArgumentsOrDiamond> ::= 
+    <LT> <GT> 
+  | <NonWildcardTypeArguments>
+
+<TypeParametersRag> ::= 
+    <COMMA> <TypeParameter> <TypeParameterRag> 
+  | <COMMA> <TypeParameter>
+
+<TypeParemeters> ::= 
+    <LT> <TypeParameter> <GT> 
+  | <LT> <TypeParameter> <TypeParameterRag> <GT>
+
+<TypeParameter> ::= 
+    <Identifier> 
+  | <Identifier> <EXTENDS> <Bound>
+
+<ReferenceTypeRag> ::= 
+    <AMPERSTAND> <ReferenceType> 
+  | <AMPERSTAND> <ReferenceType> <ReferenceTypeRag>
+
+<Bound> ::= 
+    <ReferenceType> 
+  | <ReferenceType> <ReferenceTypeRag>
+
+<Modifier> ::= 
+    <Annotation> 
+  | <PUBLIC> 
+  | <PROTECTED> 
+  | <PRIVATE> 
+  | <STATIC> 
+  | <ABSTRACT> 
+  | <FINAL> 
+  | <NATIVE> 
+  | <SYNCHRONIZED> 
+  | <TRANSIENT> 
+  | <VOLATILE> 
+  | <STRICTFP>
+
+<Annotations> ::= 
+    <Annotation> 
+  | <Annotation> <Annotations>
+
+<Annotation> ::= 
+    <AT> <QualifiedIdentifier> 
+  | <AT> <QualifiedIdentifier> <LPAREN> <AnnotationElement>
+
+<AnnotationElement> ::= 
+    <ElementValuePairs> 
+  | <ElementValue>
+
+<ElementValuePairs> ::= 
+    <ElementValuePair> 
+  | <ElementValuePair> <COMMA> <ElementValuePairs>
+
+<ElementValuePair> ::= 
+    <Identifier> <EQUAL> <ElementValue>
+
+<ElementValue> ::= 
+    <Annotation> 
+  | <Expression1> 
+  | <ElementValueArrayInitializer>
+
+<ElementValueArrayInitializer> ::= 
+    <ElementValues> 
+
+<ElementValues> ::= 
+    <ElementValue> 
+  | <ElementValue> <COMMA> <ElementValues>
+
+<ClassBodyDeclarationRag> ::= 
+    <ClassBodyDeclaration> 
+  | <ClassBodyDeclaration> <ClassBodyDeclarationRag>
+
+<ClassBody> ::= 
+    <LBRACK> <RBRACK>
+  | <LBRACK> <ClassBodyDeclarationRag> <RBRACK>
+
+<ModifierRag> ::= 
+    <Modifier> 
+  | <Modifier> <ModifierRag> 
+
+<ClassBodyDeclaration> ::= 
+    <SEMICOLON> 
+  | <MemberDecl> 
+  | <ModifierRag> <MemberDecl> 
+  | <Block> 
+  | <STATIC> <Block>
+
+<MemberDecl> ::= 
+    <MethodOrFieldDecl> 
+  | <VOID> <Identifier> <VoidMethodDeclaratorRest> 
+  | <Identifier> <ConstructorDeclaratorRest> 
+  | <GenericMethodOrConstructorDecl> 
+  | <ClassDeclaration> 
+  | <InterfaceDeclaration>
+
+<MethodOrFieldDecl> ::= 
+    <Type> <Identifier> <MethodOrFieldRest>
+
+<MethodOrFieldRest> ::= 
+    <FieldDeclaratorsRest> <SEMICOLON> 
+  | <MethodDeclaratorRest>
+
+<VariableDeclaratorRag> ::= 
+    <COMMA> <VariableDeclarator> 
+  | <COMMA> <VariableDeclarator> <VariableDeclaratorRag>
+
+<FieldDeclaratorsRest> ::= 
+    <VariableDeclaratorRest> 
+  | <VariableDeclaratorRest> <VariableDeclaratorRag>
+
+<SqBrRag> ::= 
+    <LSQB> <RSQB> 
+  | <LSQB> <RSQB> <SqBrRag>
+
+<MethodDeclaratorRest> ::= 
+    <FormalParameters> <Block> 
+  | <FormalParameters> <SEMICOLON> 
+  | <FormalParameters> <SqBrRag> <Block> 
+  | <FormalParameters> <SqBrRag> <SEMICOLON> 
+  | <FormalParameters> <THROWS> <QualifiedIdentifierList> <Block> 
+  | <FormalParameters> <THROWS> <QualifiedIdentifierList> <SEMICOLON> 
+  | <FormalParameters> <SqBrRag> <THROWS> <QualifiedIdentifierList> <Block> 
+  | <FormalParameters> <SqBrRag> <THROWS> <QualifiedIdentifierList> <SEMICOLON>
+
+<VoidMethodDeclaratorRest> ::=
+    <FormalParameters> <Block> 
+  | <FormalParameters> <SEMICOLON> 
+  | <FormalParameters> <THROWS> <QualifiedIdentifierList> <Block> 
+  | <FormalParameters> <THROWS> <QualifiedIdentifierList> <SEMICOLON> 
+
+<ConstructorDeclaratorRest> ::= 
+    <FormalParameters> <Block> 
+  | <FormalParameters> <THROWS> <QualifiedIdentifierList> <Block>
+
+<GenericMethodOrConstrcutorDecl> ::= 
+    <TypeParameters> <GenericMethodOrConstructorRest>
+
+<GenericMethodOrConstructorRest> ::= 
+    <Type> <Identifier> <MethodDeclaratorRset> 
+  | <VOID> <Identifier> <MethodDeclaratorRset> 
+  | <Identifier> <ConstructorDeclaratorRest>
+
+<InterfaceBodyDeclarationRag> ::= 
+    <InterfaceBodyDeclaration> 
+  | <InterfaceBodyDeclaration> <InterfaceBodyDeclarationRag>
+
+<InterfaceBody> ::= <LBRACK> <InterfaceBodyDeclarationRag> <RBRACK>
+
+<InterfaceBodyDeclaration> ::= 
+    <SEMICOLON> 
+  | <ModifierRag> <InterfaceMemberDecl>
+
+<InterfaceMemberDecl> ::= 
+    <InterfaceMethodOrFieldDecl> 
+  | <VOID> <Identifier> <VoidInterfaceMEthodDeclaratorRest> 
+  | <InterfaceGenericMethodDecl> 
+  | <ClassDeclaration> 
+  | <InterfaceDeclaration>
+
+<InterfaceMethodOrFieldDecl> ::= 
+    <Type> <Identifier> <InterfaceMtehodOrFieldRest>
+
+<InterfaceMethodOrFieldRest> ::= 
+    <ConstantDeclaratorsRest> <SEMICOLON> 
+  | <InterfaceMEthodDeclaratorRest>
+
+<ConstantDeclaratorRag> ::= 
+    <COMMA> <ConstantDeclarator> 
+  | <COMMA> <ConstantDeclarator> <ConstantDeclaratorRag>
+
+<ConstantDeclaratorsRest> ::= 
+    <ConstantDeclaratorRest> 
+  | <ConstantDeclaratorRest> <ConstantDeclaratorRag>
+
+<ConstantDeclaratorRest> ::= 
+    <EQUAL> <VariableInitializer> 
+  | <SqBrRag> <EQUAL> <VariableInitializer>
+
+<ConstantDeclarator> ::= <Identifier> <ConstantDeclaratorRest>
+
+<InterfaceMethodDeclaratorRest> ::= 
+    <FormalParameters> <SEMICOLON> 
+  | <FormalParameters> <THROWS> <QualifiedIdentifierList> <SEMICOLON> 
+  | <FormalParameters> <SqBrRag> <SEMICOLON> 
+  | <FormalParameters> <SqBrRag> <THROWS> <QualifiedIdentifierList> <SEMICOLON>
+
+<VoidInterfaceMethodDeclaratorRest> ::= 
+    <FormalParameters> <SEMICOLON> 
+  | <FormalParameters> <THROWS> <QualifiedIdentifierList> <SEMICOLON>
+
+<InterfaceGenericMethodDecl> ::= 
+    <TypeParameters> <Type> <Identifier> <InterfaceMethodDeclaratorRest> 
+  | <TypeParameters> <VOID> <Identifier> <InterfaceMethodDeclaratorRest> 
+
+<FormalParameters> ::= 
+    <LPAREN> <RPAREN> 
+  | <LPAREN> <FormalParameterDecls> <RPAREN>
+
+<VariableModiferRag> ::= 
+    <VariableModifier> 
+  | <VariableModifier> <VariableModifierRag>
+
+<FormalParameterDecls> ::= 
+    <Type> <FormalParameterDeclsRest> 
+  | <VariableModifierRag> <Type> <FormalParameterDeclsRest>
+
+<VariableModifier> ::= 
+    <FINAL> 
+  | <Annotation>
+
+<FormalParameterDeclsRest> ::= 
+    <VariableDeclaratorId> 
+  | <VariableDeclaratorId> <COMMA> <FormalParameterDecls> 
+  | <DOTDOTDOT> <VariableDeclaratorId>
+
+<VariableDeclaratorId> ::= 
+    <Identifier> 
+  | <Identifier> <SqBrRag>
+
+<VariableDeclaratorRag> ::= 
+    <COMMA> <VariableDeclaratorRest> 
+  | <COMMA> <VariableDeclaratorRest> <VariableDeclaratorRag>
+
+<VariableDeclarators> ::= 
+    <VariableDeclarator> 
+  | <VariableDeclarator> <VariableDeclaratorRag>
+
+<VariableDeclarator> ::=
+    <Identifier>
+  | <Identifier> <VariableDeclaratorRest>
+
+<VariableDeclaratorRest> ::= 
+    <SqBrRag> 
+  | <EQUAL> <VariableInitializer> 
+  | <SqBrRag> <EQUAL> <VariableInitializer>
+
+<VariableInitializer> ::= 
+    <ArrayInitializer> 
+  | <Expression>
+
+<ArrayInitializer> ::= 
+    <NOTIMPLEMENTED>
+
+<Block> ::= 
+    <LBRACK> <RBRACK>
+  | <LBRACK> <BlockStatements> <RBRACK>
+
+<BlockStatements> ::= 
+    <BlockStatement> 
+  | <BlockStatement> <BlockStatements>
+
+<BlockStatement> ::= 
+    <LocalVariableDeclarationStatement> 
+  | <ClassOrInterfaceDeclaration> 
+  | <Statement> 
+  | <Identifier> <COLON> <Statement>
+
+<VariableModifierRag> ::= 
+    <VariableModifier> 
+  | <VariableModifier> <VariableModifierRag>
+
+<LocalVariableDeclarationStatement> ::= 
+    <Type> <VariableDeclarators> <SEMICOLON> 
+  | <VariableModifierRag> <Type> <VariableDeclarators> <SEMICOLON>
+
+<Statement> ::= 
+    <Block> 
+  | <SEMICOLON>
+  | <Identifier> <COLON> <Statement>
+  | <IF> <ParExpression> <Statement>
+  | <IF> <ParExpression> <Statement> <ELSE> <Statement>
+  | <ASSERT> <Expression> <SEMICOLON>
+  | <ASSERT> <Expression> <COLON> <Expression> <SEMICOLON>
+  | <SWITCH> <ParExpression> <LBRACK> <SwitchBlockStatementGroups> <RBRACK>
+  | <WHILE> <ParExpression> <Statement>
+  | <DO> <Statement> <WHILE> <ParExpression> <SEMICOLON>
+  | <FOR> <LPAREN> <ForControl> <RPAREN> <Statement>
+  | <BREAK> <SEMICOLON>
+  | <BREAK> <Identifier> <SEMICOLON>
+  | <CONTINUE> <SEMICOLON>
+  | <CONTINUE> <Identifier> <SEMICOLON>
+  | <RETURN> <SEMICOLON>
+  | <RETURN> <Expression> <SEMICOLON>
+  | <THROW> <Expression> <SEMICOLON>
+  | <SYNCHRONIZED> <ParExpression> <Block>
+  | <TRY> <Block> <Catches>
+  | <TRY> <Block> <Finally>
+  | <TRY> <Block> <Catches> <Finally>
+  | <TRY> <ResourceSpecification> <Block>
+  | <TRY> <ResourceSpecification> <Block> <Catches>
+  | <TRY> <ResourceSpecification> <Block> <Finally>
+  | <TRY> <ResourceSpecification> <Block> <Catches> <Finally>
+
+<StatementExpression> ::= 
+    <Expression>
+
+<Catches> ::= 
+    <CatchClause> 
+  | <CatchClause> <Catches>
+
+<CatchClause> ::= 
+    <CATCH> <LPAREN> <VariableModiferRag> <CatchType> <Identifier> <RPAREN> <Block>
+  | <CATCH> <LPAREN> <CatchType> <Identifier> <RPAREN> <Block>
+
+<CatchType> ::=
+    <QualifiedIdentifier> 
+  | <QualifiedIdentifier> <VERTICALBAR> <CatchType>
+
+<Finally> ::= 
+    <FINALLY> <Block>
+
+<ResourceSpecification> ::= 
+    <LPAREN> <Resources> <RPAREN>
+  | <LPAREN> <Resources> <SEMICOLON> <RPAREN>
+
+<Resources> ::=
+    <Resource>
+  | <Resource> <SEMICOLON> <Resources>
+
+<Resource> ::= 
+    <ReferenceType> <VariableDeclaratorId> <EQUAL> <Expression>
+  | <VariableModifierRag> <ReferenceType> <VariableDeclaratorId> <EQUAL> <Expression>
+
+<SwitchBlockStatementGroups> ::=
+    <SwitchBlockStatementGroup>
+  | <SwitchBlockStatementGroup> | <SwitchBlockStatementGroups>
+
+<SwitchBlockStatementGroup> ::= 
+    <SwitchLabels> <BlockStatements>
+
+<SwitchLabels> ::= 
+    <SwitchLabel> 
+  | <SwitchLabel> <SwitchLables>
+
+<SwitchLabel> ::=
+    <CASE> <Expression> <COLON>
+  | <CASE> <EnumConstantName> <COLON>
+  | <DEFAULT> <COLON>
+
+<EnumConstantName> ::= <Identifier>
+
+<ForControl> ::=
+    <ForVarControl>
+  | <ForInit> <SEMICOLON> <SEMICOLON>
+  | <ForInit> <SEMICOLON> <Expression> <SEMICOLON>
+  | <ForInit> <SEMICOLON> <SEMICOLON> <ForUpdate>
+  | <ForInit> <SEMICOLON> <Expression> <SEMICOLON> <ForUpdate>
+
+<ForVarControl> ::=
+    <Type> <VariableDeclaratorId> <ForVarControlRest>
+  | <VariableModifierRag> <Type> <VariableDeclaratorId> <ForVarControlRest>
+
+<ForVarControlRest> ::=
+    <ForVariableDeclaratorsRest> <SEMICOLON> <SEMICOLON>
+  | <ForVariableDeclaratorsRest> <SEMICOLON> <Expression> <SEMICOLON>
+  | <ForVariableDeclaratorsRest> <SEMICOLON> <SEMICOLON> <ForUpdate>
+  | <ForVariableDeclaratorsRest> <SEMICOLON> <Expression> <SEMICOLON> <ForUpdate>
+  | <COLON> <Expression>
+
+<ForVariableDeclaratorsRest> ::=
+    <EQUAL> <VariableInitializer>
+  | <EQUAL> <VariableInitializer> <VariableDeclaratorRag>
+  | <VariableDeclaratorRag>
+
+<StatementExpressionRag> ::= 
+    <COMMA> <StatementExpression> 
+  | <COMMA> <StatementExpression> <StatementExpressionRag>
+
+<ForInit> ::= 
+    <StatementExpression> 
+  | <StatementExpression> <StatementExpressionRag>
+
+<ForUpdate> ::= 
+    <StatementExpression> 
+  | <StatementExpression> <StatementExpressionRag>
+
+
+<Expression> ::= 
+    <Expression1> 
+  | <Expression1> <AssignmentOperator> <Expression1>
+
+<AssignmentOperator> ::= 
+    <EQUAL> 
+  | <PLUSEQUAL> 
+  | <MINUSEQUAL> 
+  | <STAREQUAL>
+  | <FORWARDSLASHEQUAL> 
+  | <AMPERSTANDEQUAL> 
+  | <VERTICALBAREQUAL> 
+  | <CARROTEQUAL> 
+  | <PERCENTEQUAL> 
+  | <LTLTEQUAL> 
+  | <GTGTEQUAL> 
+  | <GTGTGTEQUAL>
+
+<Expression1> ::= 
+    <Expression2> 
+  | <Expression2> <Expression1Rest>
+
+<Expression1Rest> ::= 
+    <QUESTION> <Expression> <COLON> <Expression1>
+
+<Expression2> ::= 
+    <Expression3> 
+  | <Expression3> <Expression2Rest>
+
+<InfixOpExpression3Rag> ::= 
+    <InfixOp> <Expression3> 
+  | <InfixOp> <Expression3> <InfixOpExpression3Rag>
+
+<Expression2Rest> ::= 
+    <InfixOpExpression3Rag> 
+  | <INSTANCEOF> <Type>
+
+<InfixOp> ::= 
+    <DOUBLEVERTICALBAR> 
+  | <DOUBLEAMPERSTAND> 
+  | <VERTICALBAR> 
+  | <AMPERSTAND> 
+  | <CARROT> 
+  | <DOUBLEEQUAL> 
+  | <NOTEQUAL> 
+  | <LT> 
+  | <GT> 
+  | <LTE> 
+  | <GTE> 
+  | <LTLT> 
+  | <GTGT> 
+  | <GTGTGT> 
+  | <PLUS> 
+  | <MINUS> 
+  | <STAR> 
+  | <FORWARDSLASH> <PERCENT>
+
+<SelectorRag> ::= 
+    <Selector> 
+  | <Selector> <SelectorRag>
+
+<PostfixOpRag> ::= 
+    <PostfixOp> 
+  | <PostfixOp> <PostfixOpRag>
+
+<Expression3> ::= 
+    <PrefixOp> <Expression3> 
+  | <LPAREN> <Expression> <RPAREN> <Expression3> 
+  | <LPAREN> <Type> <RPAREN> <Expression3> 
+  | <Primary> 
+  | <Primary> <SelectorRag> 
+  | <Primary> <PostFixOpRag> 
+  | <Primary> <SelectorRag> <PostFixOpRag>
+
+<PrefixOp> ::=  
+    <PLUSPLUS> 
+  | <MINUSMINUS> 
+  | <BANG> 
+  | <TILDE> 
+  | <PLUS>
+  | <MINUS>
+
+<PostFixOp> ::= 
+    <PLUSPLUS> 
+  | <MINUSMINUS>
+
+<Primary> ::= 
+    <Literal> 
+  | <ParExpression> 
+  | <THIS> 
+  | <THIS> <Arguments> 
+  | <SUPER> <SuperSuffix> 
+  | <NEW> <Creator> 
+  | <NonWildcardTypeArguments> <ExplicitGenericInvocationSuffix> 
+  | <NonWildcardTypeArguents> <THIS> <Arguments> 
+  | <IdentifierRag>
+  | <IdentifierRag> <IdentifierSuffix>
+  | <BasicType> <PERIOD> <CLASS>
+  | <BasicType> <SqBrRag> <PERIOD> <CLASS>
+  | <VOID> <PERIOD> <CLASS>
+
+<Literal> ::= 
+    <IntegerLiteral> 
+  | <FloatingPointLiteral> 
+  | <CharacterLiteral> 
+  | <StringLiteral> 
+  | <BooleanLiteral> 
+  | <NullLiteral>
+
+<ParExpression> ::= 
+    <LPAREN> <Expression> <RPAREN>
+
+<ArgumentExpressionRag> ::=
+    <Expression>
+  | <Expression> <COMMA> <ArgumentExpressionRag>
+
+<Arguments> ::=
+    <LPAREN> <RPAREN>
+  | <LPAREN> <ArgumentExpressionRag> <RPAREN>
+
+<SuperSuffix> ::= 
+    <Arguments> 
+  | <PERIOD> <Identifier> 
+  | <PERIOD> <Identifier> <Arguments>
+
+<ExplicitGenericInvocationSuffix> ::= 
+    <SUPER> <SuperSuffix> 
+  | <Identifier> <Arguments>
+
+<CreatedName> ::=
+    <Identifier>
+  | <Identifier> <TypeArgumentsOrDiamond>
+  | <Identifier> <TypeArgumentsOrDiamond> <PERIOD> <CreatedName>
+
+<Creator> ::= 
+    <NonWildcardTypeArguments> <CreatedName> <ClassCreatorRest> 
+  | <CreatedName> <ClassCreatorRest> 
+  | <CreatedName> <ArrayCreatorRest>
+
+<ClassCreatorRest> ::= 
+    <Arguments> <ClassBody> 
+  | <Arguments>
+
+<ExpressionRag> ::= 
+    <Expression> 
+  | <Expression> <ExpressionRag>
+
+<ArrayCreatorRest> ::= 
+    <LSQB> <SqBrRag> <ArrayInitializer> <RSQB> <SqBrRag>
+  | <LSQB> <SqBrRag> <Expression> <RSQB> <SqBrRag>
+  | <LSQB> <SqBrRag> <ArrayInitializer> <RSQB> <LSQB> <ExpressionRag> <RSQB> <SqBrRag>
+  | <LSQB> <SqBrRag> <Expression> <RSQB> <LSQB> <ExpressionRag> <RSQB> <SqBrRag>
+
+<IdentifierSuffix> ::= 
+    <Arguments>
+  | <NOTIMPLEMENTED>
+
+<ExplicitGenericInvocation> ::= 
+    <NonWildcardTypeArguments> <ExplicitGenericInvocationSuffix>
+
+<InnerCreator> ::= 
+    <Identifier> <NonWildcardTypeArgumentsOrDiamond> <ClassCreatorRest> 
+  | <Identifier> <ClassCreatorRest>
+
+<Selector> ::=
+    <NOTIMPLEMENTED>
+  | <PERIOD> <Identifier> <Arguments>
+
+<EnumBody> ::= 
+    <EnumConstants> 
+  | <LBRACK> <EnumConstants> <COMMA> <RBRACK>
+  | <LBRACK> <EnumConstants> <EnumBodyDeclarations> <RBRACK>
+  | <LBRACK> <EnumConstants> <COMMA> <EnumBodyDeclarations> <RBRACK>
+  | <LBRACK> <RBRACK>
+  | <LBRACK> <COMMA>  <RBRACK>
+  | <LBRACK> <EnumBodyDeclarations> <RBRACK>
+  | <LBRACK> <COMMA> <EnumBodyDeclarations> <RBRACK>
+
+<EnumConstants> ::= 
+    <EnumConstant> 
+  | <EnumConstant> <COMMA> <EnumConstants>
+
+<EnumConstant> ::= 
+    <Identifier> 
+  | <Identifier> <Arguments> 
+  | <Identifier> <Arguments> <ClassBody> 
+  | <Identifier> <ClassBody>
+  | <Annotations> <Identifier> 
+  | <Annotations> <Identifier> <Arguments> 
+  | <Annotations> <Identifier> <Arguments> <ClassBody> 
+  | <Annotations> <Identifier> <ClassBody>
+
+<EnumBodyDeclarations> := 
+    <SEMICOLON> 
+  | <SEMICOLON>  <ClassBodyDeclarationRag>
+
+<AnnotationTypeBody> ::= 
+    <LBRACK> <RBRACK>
+  | <LBRACK> <AnnotationTypeElementDeclarations> <RBRACK>
+
+<AnnotationTypeDeclarations> ::=
+    <AnnotationTypeDeclaration>
+  | <AnnotationTypeDeclaration> <AnnotationTypeDeclarations>
+
+<AnnotationTypeElementDeclaration> ::=
+    <AnnotationTypeElementRest>
+  | <ModiferRag> <AnnotationTypeElementRest>
+
+<AnnotationTypeElementRest> ::=
+    <Type> <Identifier> <AnnotationMethodOrConstantRest> <SEMICOLON>
+  | <ClassDeclaration>
+  | <InterfaceDeclaration>
+  | <EnumDeclaration>
+  | <AnnotationTypeDeclaration>
+
+<AnnotationMethodOrConstantRest> ::=
+    <AnnotationMethodRest>
+  | <ConstantDeclaratorsRest>
+
+<AnnotationMethodRest> ::= 
+    <LPAREN> <RPAREN>
+  | <LPAREN> <RPAREN> <LSQB> <RSQB>
+  | <LPAREN> <RPAREN> <DEFAULT> <ElementValue>
+  | <LPAREN> <RPAREN> <LSQB> <RSQB> <DEFAULT> <ElementValue>
diff -Nru acl2-6.2/books/parsers/earley/examples/oracle-java.g acl2-6.3/books/parsers/earley/examples/oracle-java.g
--- acl2-6.2/books/parsers/earley/examples/oracle-java.g	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/oracle-java.g	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,606 @@
+// Hi-lock: (("[FF]ieldDeclaratorsRest:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[II]dentifier:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[MM]ethodOrFieldRest:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[MM]ethodOrFieldDecl:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[MM]ethodOrFieldDecl:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[MM]emberDecl:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[CC]lassBodyDeclaration:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[CC]lassBody:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[EE]lementValues:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[EE]lementValue:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[EE]lementValuePair:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[EE]lementValuePairs:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[AA]nnotationElement:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[AA]nnotations:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[MM]odifier: " (0 (quote hi-yellow) t)))
+// Hi-lock: (("[BB]ound:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[TT]ypeParameter:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[TT]ypeParameters:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[TT]ypeArgumentsOrDiamond:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[TT]ypeList:" (0 (quote hi-yellow) t)))
+// Hi-lock: (("[NN]onWildcardTypeArguments:" (0 (quote hi-yellow) t)))
+
+
+
+
+M-s h l	highlight-lines-matching-regexp	Highlights all lines matching
+a regular expression
+
+If you create highlights interactively you can tell Emacs to insert
+those patterns into the active buffer by running M-s h w.
+
+Emacs will not highlight patterns found in a file automatically. You
+must explicitly tell it to do so by manually invoking
+M-x hi-lock-mode
+
+
+Identifier:
+    IDENTIFIER
+
+QualifiedIdentifier:
+    Identifier { . Identifier }
+
+QualifiedIdentifierList:
+    QualifiedIdentifier { , QualifiedIdentifier }
+
+# not supporting annotations
+CompilationUnit:
+    [[Annotations] package QualifiedIdentifier ;]
+                                {ImportDeclaration} {TypeDeclaration}
+
+ImportDeclaration:
+    import [static] Identifier { . Identifier } [. *] ;
+
+TypeDeclaration:
+    ClassOrInterfaceDeclaration
+    ;
+
+ClassOrInterfaceDeclaration:
+    {Modifier} (ClassDeclaration | InterfaceDeclaration)
+
+ClassDeclaration:
+    NormalClassDeclaration
+    EnumDeclaration
+
+InterfaceDeclaration:
+    NormalInterfaceDeclaration
+    AnnotationTypeDeclaration
+
+
+NormalClassDeclaration:
+    class Identifier [TypeParameters]
+                                [extends Type] [implements TypeList] ClassBody
+
+EnumDeclaration:
+    enum Identifier [implements TypeList] EnumBody
+
+NormalInterfaceDeclaration:
+    interface Identifier [TypeParameters] [extends TypeList] InterfaceBody
+
+AnnotationTypeDeclaration:
+    @ interface Identifier AnnotationTypeBody
+
+Type:
+    BasicType {[]}
+    ReferenceType  {[]}
+
+BasicType:
+    byte
+    short
+    char
+    int
+    long
+    float
+    double
+    boolean
+
+ReferenceType:
+    Identifier [TypeArguments] { . Identifier [TypeArguments] }
+
+TypeArguments:
+    < TypeArgument { , TypeArgument } >
+
+# The use of [ and ] is as optional in java.g
+TypeArgument:
+    ReferenceType
+    ? [ (extends | super) ReferenceType ]
+
+NonWildcardTypeArguments:
+    < TypeList >
+
+TypeList:
+    ReferenceType { , ReferenceType }
+
+
+
+TypeArgumentsOrDiamond:
+    < >
+    TypeArguments
+
+NonWildcardTypeArgumentsOrDiamond:
+    < >
+    NonWildcardTypeArguments
+
+
+
+TypeParameters:
+    < TypeParameter { , TypeParameter } >
+
+TypeParameter:
+    Identifier [extends Bound]
+
+Bound:
+    ReferenceType { & ReferenceType }
+
+Modifier:
+    Annotation
+    public
+    protected
+    private
+    static
+    abstract
+    final
+    native
+    synchronized
+    transient
+    volatile
+    strictfp
+
+# This one is so simple that we do not need an AnnotationRag.  It
+# already is a Rag!
+Annotations:
+    Annotation {Annotation}
+
+# Not really sure what is up with the [] below
+Annotation:
+    @ QualifiedIdentifier [ ( [AnnotationElement] ) ]
+
+AnnotationElement:
+    ElementValuePairs
+    ElementValue
+
+# Another case where we do not need a Rag
+ElementValuePairs:
+    ElementValuePair { , ElementValuePair }
+
+ElementValuePair:
+    Identifier = ElementValue
+
+ElementValue:
+    Annotation
+    Expression1
+    ElementValueArrayInitializer
+
+# This one is done wrong, because it really needs to be converted to a
+# Rag, and I do not know how to read it.  Flat out broken.  I could
+# code the comma below, but it seems like it could lead to ambiguous
+# parse trees.
+ElementValueArrayInitializer:
+    { [ElementValues] [,] }
+
+# Do not need to create a Rag for this one, because it is easy to just
+# write the equivalent grammar.
+ElementValues:
+    ElementValue { , ElementValue }
+
+ClassBody:
+    { { ClassBodyDeclaration } }
+
+ClassBodyDeclaration:
+    ;
+    {Modifier} MemberDecl
+    [static] Block
+
+MemberDecl:
+    MethodOrFieldDecl
+    void Identifier VoidMethodDeclaratorRest
+    Identifier ConstructorDeclaratorRest
+    GenericMethodOrConstructorDecl
+    ClassDeclaration
+    InterfaceDeclaration
+
+MethodOrFieldDecl:
+    Type Identifier MethodOrFieldRest
+
+MethodOrFieldRest:
+    FieldDeclaratorsRest ;
+    MethodDeclaratorRest
+
+FieldDeclaratorsRest:
+    VariableDeclaratorRest { , VariableDeclarator }
+
+
+# this one was ugly, but I think I got it right
+MethodDeclaratorRest:
+    FormalParameters {[]} [throws QualifiedIdentifierList] (Block | ;)
+
+VoidMethodDeclaratorRest:
+    FormalParameters [throws QualifiedIdentifierList] (Block | ;)
+
+ConstructorDeclaratorRest:
+    FormalParameters [throws QualifiedIdentifierList] Block
+
+GenericMethodOrConstructorDecl:
+    TypeParameters GenericMethodOrConstructorRest
+
+GenericMethodOrConstructorRest:
+    (Type | void) Identifier MethodDeclaratorRest
+    Identifier ConstructorDeclaratorRest
+
+InterfaceBody:
+    { { InterfaceBodyDeclaration } }
+
+InterfaceBodyDeclaration:
+    ;
+    {Modifier} InterfaceMemberDecl
+
+InterfaceMemberDecl:
+    InterfaceMethodOrFieldDecl
+    void Identifier VoidInterfaceMethodDeclaratorRest
+    InterfaceGenericMethodDecl
+    ClassDeclaration
+    InterfaceDeclaration
+
+InterfaceMethodOrFieldDecl:
+    Type Identifier InterfaceMethodOrFieldRest
+
+InterfaceMethodOrFieldRest:
+    ConstantDeclaratorsRest ;
+    InterfaceMethodDeclaratorRest
+
+ConstantDeclaratorsRest:
+    ConstantDeclaratorRest { , ConstantDeclarator }
+
+ConstantDeclaratorRest:
+    {[]} = VariableInitializer
+
+ConstantDeclarator:
+    Identifier ConstantDeclaratorRest
+
+InterfaceMethodDeclaratorRest:
+    FormalParameters {[]} [throws QualifiedIdentifierList] ;
+
+VoidInterfaceMethodDeclaratorRest:
+    FormalParameters [throws QualifiedIdentifierList] ;
+
+InterfaceGenericMethodDecl:
+    TypeParameters (Type | void) Identifier InterfaceMethodDeclaratorRest
+
+FormalParameters:
+    ( [FormalParameterDecls] )
+
+FormalParameterDecls:
+    {VariableModifier}  Type FormalParameterDeclsRest
+
+VariableModifier:
+    final
+    Annotation
+
+FormalParameterDeclsRest:
+    VariableDeclaratorId [, FormalParameterDecls]
+    ... VariableDeclaratorId
+
+
+
+VariableDeclaratorId:
+    Identifier {[]}
+
+
+
+VariableDeclarators:
+    VariableDeclarator { , VariableDeclarator }
+
+VariableDeclarator:
+    Identifier VariableDeclaratorRest
+
+VariableDeclaratorRest:
+    {[]} [ = VariableInitializer ]
+
+VariableInitializer:
+    ArrayInitializer
+    Expression
+
+# NOTIMPLEMENTED
+ArrayInitializer:
+    { [ VariableInitializer { , VariableInitializer } [,] ] }
+
+# I am making a very strange judgement call for Block and
+# BlockStatements.  I am assuming that the brackets in Block are because
+# programmers can use brackets.  And, I am assuming that the brackets in
+# BlockStatements are of the notation like [], (|), and {}.  If I am
+# right about that it, would mean that the Oracle Syntax is ambiguous.
+# It is hard to imagine that such a large product would have such
+# ambiguous syntax, so I concede that it is more likely that I am
+# wrong.  However, I do not currently have a way of determining the
+# right intepretation without experimenting.  Thus, we continue the experiment.
+
+Block:
+    { BlockStatements }
+
+BlockStatements:
+    { BlockStatement }
+
+BlockStatement:
+    LocalVariableDeclarationStatement
+    ClassOrInterfaceDeclaration
+    [Identifier :] Statement
+
+LocalVariableDeclarationStatement:
+    { VariableModifier }  Type VariableDeclarators ;
+
+# Interpreted the { } in switch as literals
+Statement:
+    Block
+    ;
+    Identifier : Statement
+    StatementExpression ;
+    if ParExpression Statement [else Statement]
+    assert Expression [: Expression] ;
+    switch ParExpression { SwitchBlockStatementGroups }
+    while ParExpression Statement
+    do Statement while ParExpression ;
+    for ( ForControl ) Statement
+    break [Identifier] ;
+    continue [Identifier] ;
+    return [Expression] ;
+    throw Expression ;
+    synchronized ParExpression Block
+    try Block (Catches | [Catches] Finally)
+    try ResourceSpecification Block [Catches] [Finally]
+
+StatementExpression:
+    Expression
+
+# Intepreted the { } below as non-literals based on knowledge of Java
+Catches:
+    CatchClause { CatchClause }
+
+CatchClause:
+    catch ( {VariableModifier} CatchType Identifier ) Block
+
+# Need to tease apart vertical bars, amperstands, and other dilineators in 
+# thing that preprocesses characters
+# The way I resolved this in oracle-grammar.txt should be fine
+CatchType:
+    QualifiedIdentifier { | QualifiedIdentifier }
+
+Finally:
+    finally Block
+
+ResourceSpecification:
+    ( Resources [;] )
+
+Resources:
+    Resource { ; Resource }
+
+Resource:
+    {VariableModifier} ReferenceType VariableDeclaratorId = Expression
+
+SwitchBlockStatementGroups:
+    { SwitchBlockStatementGroup }
+
+SwitchBlockStatementGroup:
+    SwitchLabels BlockStatements
+
+SwitchLabels:
+    SwitchLabel { SwitchLabel }
+
+SwitchLabel:
+    case Expression :
+    case EnumConstantName :
+    default :
+
+EnumConstantName:
+    Identifier
+
+
+
+ForControl:
+    ForVarControl
+    ForInit ; [Expression] ; [ForUpdate]
+
+ForVarControl:
+    {VariableModifier} Type VariableDeclaratorId  ForVarControlRest
+
+# We translate the below use of ForVariableDeclaratorsRest
+# differently
+ForVarControlRest:
+    ForVariableDeclaratorsRest ; [Expression] ; [ForUpdate]
+    : Expression
+
+ForVariableDeclaratorsRest:
+    [= VariableInitializer] { , VariableDeclarator }
+
+# not sure I did ForInit correctly
+ForInit:
+ForUpdate:
+    StatementExpression { , StatementExpression }
+
+Expression:
+    Expression1 [AssignmentOperator Expression1]
+
+AssignmentOperator:
+    =
+    +=
+    -=
+    *=
+    /=
+    &=
+    |=
+    ^=
+    %=
+    <<=
+    >>=
+    >>>=
+
+Expression1:
+    Expression2 [Expression1Rest]
+
+Expression1Rest:
+    ? Expression : Expression1
+
+Expression2:
+    Expression3 [Expression2Rest]
+
+# Another example of the "rag" approach.
+Expression2Rest:
+    { InfixOp Expression3 }
+    instanceof Type
+
+InfixOp:
+    ||
+    &&
+    |
+    ^
+    &
+    ==
+    !=
+    <
+    >
+    <=
+    >=
+    <<
+    >>
+    >>>
+    +
+    -
+    *
+    /
+    %
+
+# I did this one correctly. It is a good example to follow for dealing
+# with curly braces.  I picked the word "rag", because it is unlikely
+# to be used elsewhere.
+Expression3:
+    PrefixOp Expression3
+    ( (Expression | Type) ) Expression3
+    Primary { Selector } { PostfixOp }
+
+PrefixOp:
+    ++
+    --
+    !
+    ~
+    +
+    -
+
+PostfixOp:
+    ++
+    --
+
+# I skipped the Identifier and BasicType lines
+Primary:
+    Literal
+    ParExpression
+    this [Arguments]
+    super SuperSuffix
+    new Creator
+    NonWildcardTypeArguments (ExplicitGenericInvocationSuffix | this Arguments)
+    Identifier { . Identifier } [IdentifierSuffix]
+    BasicType {[]} . class
+    void . class
+
+
+
+Literal:
+    IntegerLiteral
+    FloatingPointLiteral
+    CharacterLiteral
+    StringLiteral
+    BooleanLiteral
+    NullLiteral
+
+ParExpression:
+    ( Expression )
+
+# skipping for now
+Arguments:
+    ( [ Expression { , Expression } ] )
+
+SuperSuffix:
+    Arguments
+    . Identifier [Arguments]
+
+ExplicitGenericInvocationSuffix:
+    super SuperSuffix
+    Identifier Arguments
+
+Creator:
+    NonWildcardTypeArguments CreatedName ClassCreatorRest
+    CreatedName (ClassCreatorRest | ArrayCreatorRest)
+
+CreatedName:
+    Identifier [TypeArgumentsOrDiamond] { . Identifier [TypeArgumentsOrDiamond] }
+
+ClassCreatorRest:
+    Arguments [ClassBody]
+
+ArrayCreatorRest:
+    [ (] {[]} ArrayInitializer  |  Expression ] {[ Expression ]} {[]})
+
+# skipping for now
+IdentifierSuffix:
+    [ ({[]} . class | Expression) ]
+    Arguments
+    . (class | ExplicitGenericInvocation | this | super Arguments |
+                                new [NonWildcardTypeArguments] InnerCreator)
+
+ExplicitGenericInvocation:
+    NonWildcardTypeArguments ExplicitGenericInvocationSuffix
+
+InnerCreator:
+    Identifier [NonWildcardTypeArgumentsOrDiamond] ClassCreatorRest
+
+
+# The use of [ Expression ] below is dangerous, because it really
+# means that Selector should be able to resolve to an empty string,
+# which we do not currently have a way of specifying
+Selector:
+    . Identifier [Arguments]
+    . ExplicitGenericInvocation
+    . this
+    . super SuperSuffix
+    . new [NonWildcardTypeArguments] InnerCreator
+    [ Expression ]
+
+# referenced java.g to get this one
+EnumBody:
+    { [EnumConstants] [,] [EnumBodyDeclarations] }
+
+# this rule is written backwards.  I fixed it
+EnumConstants:
+    EnumConstant
+    EnumConstants , EnumConstant
+
+EnumConstant:
+    [Annotations] Identifier [Arguments] [ClassBody]
+
+# It is weird that this rule can resolve to a single semi-colon
+EnumBodyDeclarations:
+    ; {ClassBodyDeclaration}
+
+
+
+AnnotationTypeBody:
+    { [AnnotationTypeElementDeclarations] }
+
+AnnotationTypeElementDeclarations:
+    AnnotationTypeElementDeclaration
+    AnnotationTypeElementDeclarations AnnotationTypeElementDeclaration
+
+AnnotationTypeElementDeclaration:
+    {Modifier} AnnotationTypeElementRest
+
+AnnotationTypeElementRest:
+    Type Identifier AnnotationMethodOrConstantRest ;
+    ClassDeclaration
+    InterfaceDeclaration
+    EnumDeclaration
+    AnnotationTypeDeclaration
+
+AnnotationMethodOrConstantRest:
+    AnnotationMethodRest
+    ConstantDeclaratorsRest
+
+AnnotationMethodRest:
+    ( ) [[]] [default ElementValue]
diff -Nru acl2-6.2/books/parsers/earley/examples/oracle-lexicon.txt acl2-6.3/books/parsers/earley/examples/oracle-lexicon.txt
--- acl2-6.2/books/parsers/earley/examples/oracle-lexicon.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/oracle-lexicon.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,94 @@
+[0123456789]+ :class <integer>
+[a-zA-Z][a-zA-Z0-9]* :class <IDENTIFIER>
+this :class <THIS>
+super :class <SUPER>
+new :class <NEW>
+void :class <VOID>
+class :class <CLASS>
+import :class <IMPORT>
+static :class <STATIC>
+enum :class <ENUM>
+NOTIMPLEMENTED :class NOTIMPLEMENTED
+byte :class <BYTE>
+short :class <SHORT>
+char :class <CHAR>
+int :class <INT>
+long :class <LONG>
+float :class <FLOAT>
+double :class <DOUBLE>
+boolean :class <BOOLEAN>
+public :class <PUBLIC>
+protected :class <PROTECTED>
+private :class <PRIVATE>
+static :class <STATIC>
+abstract :class <ABSTRACT>
+final :class <FINAL>
+native :class <NATIVE>
+synchronized :class <SYNCHRONIZED>
+transient :class <TRANSIENT>
+volatile :class <VOLATILE>
+strictfp :class <STRICTFP>
+if :class <IF>
+else :class <ELSE>
+for :class <FOR>
+while :class <WHILE>
+switch :class <SWITCH>
+assert :class <ASSERT>
+do :class <DO>
+break :class <BREAK>
+continue :class <CONTINUE>
+return :class <RETURN>
+throw :class <THROW>
+try :class <TRY>
+catch :class <CATCH>
+finally :class <FINALLY>
+case :class <CASE>
+default :class <DEFAULT>
+instanceof :class <INSTANCEOF>
+\( :class <LPAREN>
+\) :class <RPAREN>
+{ :class <LBRACK>
+} :class <RBRACK>
+\. :class <PERIOD>
+, :class <COMMA>
+; :class <SEMICOLON>
+\+\+ :class <PLUSPLUS>
+\-\- :class <MINUSMINUS>
+! :class <BANG>
+~ :class <TILDE>
+\+ :class <PLUS>
+\- :class <MINUS>
+|| :class <DOUBLEVERTICALBAR>
+&& :class <DOUBLEAMPERSTAND>
+| :class <VERTICALBAR>
+& :class <AMPERSTAND>
+^ :class <CARROT>
+== :class <DOUBLEEQUAL>
+!= :class <NOTEQUAL>
+< :class <LT>
+> :class <GT>
+<= :class <LTE>
+>= :class <GTE>
+<< :class <LTLT>
+>> :class <GTGT>
+>>> :class <GTGTGT>
+\* :class <STAR>
+/ :class <FORWARDSLASH>
+% :class <PERCENT>
+: :class <COLON>
+\? :class <QUESTION>
+= :class <EQUAL>
++= :class <PLUSEQUAL>
+-= :class <MINUSEQUAL>
+\*= :class <STAREQUAL>
+/= :class <FORWARDSLASHEQUAL>
+&= :class <AMPERSTANDEQUAL>
+\|= :class <VERTICALBAREQUAL>
+\^= :class <CARROTEQUAL>
+%= :class <PERCENTEQUAL>
+<<= :class <LTLTEQUAL>
+>>= :class <GTGTEQUAL>
+>>>= :class <GTGTGTEQUAL>
+@ :class <AT>
+\[ :class <LSQB>
+\] :class <RSQB>
diff -Nru acl2-6.2/books/parsers/earley/examples/regex-grammar.txt acl2-6.3/books/parsers/earley/examples/regex-grammar.txt
--- acl2-6.2/books/parsers/earley/examples/regex-grammar.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/regex-grammar.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,4 @@
+<S>       ::= <aux> <NP> <VP> | <VP>  | <NP> <VP>
+<NP>      ::= <proper-noun> | <det> <nominal>
+<VP>      ::= <verb> <NP> |  <verb>
+<nominal> ::= <noun> <nominal> | <noun> | <integer> | <IDENTIFIER> | <digits>
diff -Nru acl2-6.2/books/parsers/earley/examples/regex-lexicon.txt acl2-6.3/books/parsers/earley/examples/regex-lexicon.txt
--- acl2-6.2/books/parsers/earley/examples/regex-lexicon.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/examples/regex-lexicon.txt	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,8 @@
+[A-Za-z][0-9A-Za-z]+ :class <IDENTIFIER>
+[0-9]+ :class <integer>
+book :class <verb>
+flight :class <noun>
+that :class <det>
+be :class <aux>
+Bob :class <proper-noun>
+
diff -Nru acl2-6.2/books/parsers/earley/grammar-reader.lisp acl2-6.3/books/parsers/earley/grammar-reader.lisp
--- acl2-6.2/books/parsers/earley/grammar-reader.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/grammar-reader.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,765 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;  David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(in-package "ACL2")
+
+;(include-book "cutil/defaggregate" :dir :system)
+(include-book "cutil/deflist" :dir :system)
+;(include-book "tools/bstar" :dir :system)
+(include-book "str/top" :dir :system)
+(include-book "std/io/base" :dir :system)
+(include-book "cutil/define" :dir :system)
+(include-book "parallel/with-waterfall-parallelism" :dir :system)
+
+(include-book "object-representations")
+(include-book "strings")
+(include-book "read-line")
+;(include-book "read-file-to-char-list")
+(include-book "read-file-characters-no-error")
+
+;(include-book "unicode/read-file-characters" :dir :system)
+
+;; The context free grammar representation is a hashtable keyed on non-terminal
+;; symbols. For each symbol there is a list of productions/rules for that
+;; symbol. The productions take the form of a ordered list of symbols.
+;;
+;; The non-terminal symbols are represented as strings.
+
+
+;; The lexicon is the representation of all terminal symbols (words in the
+;; language). It is a hashtable keyed on word. For each word there is a list
+;; of "terminal" structures that are different semantic mappings of the word.
+
+
+;;;; Backus-Naur Form grammar reader functions
+;;;;------------------------------------------
+
+(with-waterfall-parallelism
+(define read-next-bnf-lexeme1 ((file-input character-listp)
+                               (keep-newline booleanp)
+                               (whitespace character-listp)
+                               (lexeme stringp))
+  :returns (mv (lexeme stringp :hyp :fguard)
+               (eof-p booleanp :hyp :fguard)
+               (new-file-input character-listp :hyp :fguard))
+  ;:assert (stringp booleanp character-listp)
+  :verify-guards t
+  :parents (earley-parser)
+
+  (if (atom file-input)
+      (mv lexeme t nil)
+    (mv-let (char new-file-input)
+      (mv (car file-input) (cdr file-input))
+      (cond ;; If the char is an '=' and the rest of the lexeme is already
+       ;; "::" -> Return lexeme
+       ((and (equal char #\=) (equal lexeme "::"))
+        (mv (string-append lexeme (string char)) nil new-file-input))
+       ;; If the char is an '>' and lexeme starts with an '<' ->
+       ;; Return lexeme
+       ((and (equal char #\>)
+             (< 0 (length lexeme)) ; for guard of following car THISMAKESNOSENSE
+             (equal (car (str::firstn-chars 1 lexeme)) #\<))
+        (mv (string-append lexeme (string char)) nil new-file-input))
+       ;; If the char is '|' it is in it self a complete lexeme
+       ((and (equal char #\|) (equal (length lexeme) 0))
+        (mv (string-append lexeme (string char)) nil new-file-input))
+       ;; Newlines are also (or may be) complete lexemes
+       ((and (equal char #\Newline)
+             (equal (length lexeme) 0)
+             keep-newline)
+        (mv (string-append lexeme (string char)) nil new-file-input))
+       ;; If the char is whitespace, and lexeme is empty ->
+       ;; Do nothing, just continue with the next char
+       ((and (member-equal char whitespace)
+             (equal (length lexeme) 0))
+        (read-next-bnf-lexeme1 new-file-input keep-newline whitespace lexeme))
+       (t (read-next-bnf-lexeme1 new-file-input keep-newline whitespace
+                                 (string-append lexeme (string char)))))))))
+
+(with-waterfall-parallelism
+(defthm read-next-bnf-lexeme1-termination-weak
+  (<= (acl2-count (mv-nth 2 (read-next-bnf-lexeme1 file-input keep-newline
+                                                   whitespace lexeme)))
+      (acl2-count file-input))
+  :hints (("Goal" :in-theory (enable read-next-bnf-lexeme1)))
+  :rule-classes (:rewrite :linear)))
+
+(with-waterfall-parallelism
+(defthm read-next-bnf-lexeme1-termination-strong
+  (implies (not (mv-nth 1 (read-next-bnf-lexeme1 file-input keep-newline
+                                                 whitespace lexeme)))
+           (< (acl2-count (mv-nth 2 (read-next-bnf-lexeme1 file-input keep-newline
+                                                           whitespace lexeme)))
+              (acl2-count file-input)))
+  :hints (("Goal" :in-theory (enable read-next-bnf-lexeme1)))
+  :rule-classes (:rewrite :linear)))
+
+;; (local
+;;  (defthm file-measure-of-read-next-bnf-lexeme1-weak
+;;    (implies
+;;     (and (character-listp file-input)
+;;          (booleanp keep-newline)
+;;          (character-listp whitespace)
+;;          (stringp lexeme))
+;;     (<= (file-measure channel
+;;                       (mv-nth 2 (read-next-bnf-lexeme1 channel keep-newline
+;;                                                        whitespace lexeme state)))
+;;         (file-measure channel state)))
+;;     :hints (("Goal" :induct t :in-theory (e/d
+;;                                           (read-next-bnf-lexeme1)
+;;                                           (file-measure mv-nth))))
+
+
+(define read-next-bnf-lexeme ((file-input character-listp)
+                              (keep-newline booleanp)) ; keep-newline should be nil if not specified
+;  "Reads and returns the next Backus-Naur lexeme from file."
+  :returns (mv (lexeme stringp ; (if lexeme (stringp lexeme) t)
+                       :hyp :fguard
+                       "Empty string if ")
+               (eof-p booleanp :hyp :fguard
+                      "Whether read-next-bnf-lexeme has reached the end of ~
+                       the file")
+               (new-file-input character-listp :hyp :fguard
+                               "Remaining portion of file input"))
+  :parents (earley-parser)
+  ;:assert (stringp booleanp character-listp)
+  (let ((whitespace (list #\Space #\Tab))
+        ;; (lexeme "") ; not used
+        )
+    (mv-let
+      (lexeme eof-p new-file-input)
+      (read-next-bnf-lexeme1 file-input
+                             keep-newline
+                             (if keep-newline
+                                 whitespace
+                               (cons #\Newline whitespace))
+                             "")
+          (mv (str-trim (list #\< #\>) lexeme)
+              eof-p
+              new-file-input))))
+
+(defthm read-next-bnf-lexeme-termination-weak
+  (<= (acl2-count (mv-nth 2 (read-next-bnf-lexeme file-input keep-newline)))
+      (acl2-count file-input))
+  :hints (("Goal" :in-theory (enable read-next-bnf-lexeme)))
+  :rule-classes (:rewrite :linear))
+
+(with-waterfall-parallelism
+ (defthm read-next-bnf-lexeme-termination-strong
+   (implies (not (mv-nth 1 (read-next-bnf-lexeme file-input keep-newline)))
+            (< (acl2-count (mv-nth 2 (read-next-bnf-lexeme file-input keep-newline)))
+               (acl2-count file-input)))
+   :hints (("Goal" :in-theory (enable read-next-bnf-lexeme)))
+   :rule-classes (:rewrite :linear)))
+
+
+(define read-next-bnf-production1 ((file-input character-listp)
+                                   (keep-newline booleanp)
+                                   (production string-list-p)
+                                   (lexeme-cache string-list-p))
+  :returns (mv (productions string-list-p :hyp :fguard)
+               (remaining-file-input character-listp :hyp :fguard)
+               (lexeme-cache string-list-p :hyp :fguard))
+  :parents (earley-parser)
+    (mv-let (lexeme eof-p new-file-input)
+    (read-next-bnf-lexeme file-input keep-newline) ; make sure I account for this in translation
+    (cond ((or (equal lexeme "") eof-p) ; check used to be for (null lexeme) - SOURCE OF RUNTIME BUG
+           (mv (reverse production) new-file-input lexeme-cache))
+          ;; If we just read a "::=" and there already is one in the
+          ;; production -> Push it and last lexeme onto cache instead of
+          ;; production
+          ((and (equal lexeme "::=")
+                (member-equal lexeme production))
+           (let* ((lexeme-cache (cons lexeme lexeme-cache))
+                  (lexeme-cache (cons (car production) lexeme-cache))
+                  (production (cdr production)))
+             (mv (rev production) new-file-input lexeme-cache)))
+          (t (let ((production (cons lexeme production)))
+               (read-next-bnf-production1 new-file-input keep-newline
+                                          production lexeme-cache))))))
+
+(defthm read-next-bnf-production1-weak
+  (<= (acl2-count (mv-nth 1 (read-next-bnf-production1 file-input keep-newline
+                                                       production lexeme-cache)))
+      (acl2-count file-input))
+  :hints (("Goal" :in-theory (enable read-next-bnf-production1)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthm read-next-bnf-production1-strong
+  (implies (and (character-listp file-input)
+                (booleanp keep-newline)
+                (string-list-p production)
+                ;(state-p state)
+                (string-list-p lexeme-cache)
+                (< (len production)
+                   (len (mv-nth 0 (read-next-bnf-production1 file-input keep-newline
+                                                             production lexeme-cache)))))
+           (< (acl2-count (mv-nth 1 (read-next-bnf-production1 file-input keep-newline
+                                                               production lexeme-cache)))
+              (acl2-count file-input)))
+  :hints (("Goal" :in-theory (enable read-next-bnf-production1)))
+  :rule-classes (:rewrite :linear))
+
+(define fix-production ((lexeme-cache string-list-p)
+                        (production string-list-p))
+  :returns (productions string-list-p "New list of production strings" :hyp
+                        :guard)
+  :parents (earley-parser)
+  ;:assert string-list-p
+  (append (rev lexeme-cache) production)
+
+  ///
+
+  (defthm fix-production-preserves-string-list-p
+    (implies (and (string-listp x)
+                  (string-listp y))
+             (string-listp (fix-production x y))))
+  (defthm fix-production-length
+    (implies (string-listp x)
+             (equal (len (fix-production x nil))
+                    (len x))))
+  (defthm fix-production-of-nil
+    (equal (fix-production x nil)
+           (rev x))))
+
+; To figure out how important the lexeme-cache is, I could call
+; my-f-put-global/my-f-get-global and trace those.  Would need to run on more
+; complicated examples.  Having a functional model that doesn't involve state
+; would be a nice improvement.
+
+; I did the above and found that it was used a small amount, even in our small
+; example.  Too bad.
+
+(defmacro string-list-p-alias (x)
+  `(string-list-p ,x))
+
+(define read-next-bnf-production ((file-input character-listp)
+                                  (keep-newline booleanp)
+                                  ;(state state-p)
+                                  (lexeme-cache string-list-p)
+                                  )
+  "Reads and returns the next Backus-Naur production from file."
+;  :guard (and (boundp-global 'lexeme-cache state)
+;              (string-list-p (get-global 'lexeme-cache state)))
+  :returns (mv (productions string-list-p :hyp :fguard)
+               (remaining-file-input character-listp :hyp :fguard)
+ ;              (state state-p :hyp :fguard)
+               (lexeme-cache string-list-p :hyp :fguard))
+  :parents (earley-parser)
+  ;:assert (string-list-p character-listp string-list-p-alias)
+; Seems to be working when compared with CL trace output.
+  (let (;(lexeme-cache (f-get-global 'lexeme-cache state)) ; silly
+        (production nil))                                 ; silly
+    ;; If there is anything in the cache, pop it off and add it to production
+    ;; (read-next-bnf-production-cache lexeme-cache lexeme-cache production)
+    (let* ((production (fix-production lexeme-cache production)) ; silly but it's part of the original code
+           ;(state (f-put-global 'lexeme-cache nil state))
+           (lexeme-cache nil) ; just integrated its value above
+           )
+      (read-next-bnf-production1 file-input keep-newline production lexeme-cache))))
+
+(defthm read-next-bnf-production-weak
+  (<= (acl2-count (mv-nth 1 (read-next-bnf-production file-input keep-newline
+                                                      lexeme-cache)))
+      (acl2-count file-input))
+  :hints (("Goal" :in-theory (enable read-next-bnf-production)))
+  :rule-classes (:rewrite :linear))
+
+(defthm read-next-bnf-production-strong-works
+  (implies (and (character-listp file-input)
+                (booleanp keep-newline)
+                (string-list-p production)
+                (string-list-p lexeme-cache)
+                (< (len (rev lexeme-cache)) ; production
+                   (len (mv-nth 0 (read-next-bnf-production1
+                                   file-input keep-newline
+                                   (rev lexeme-cache)
+                                   nil)))))
+           (< (acl2-count (mv-nth 1 (read-next-bnf-production file-input keep-newline
+                                                              lexeme-cache)))
+              (acl2-count file-input)))
+  :hints (("Goal" :do-not-induct t
+                  :in-theory (e/d (read-next-bnf-production)
+                                  (read-next-bnf-production1-strong)))
+          ("Goal'" :use ((:instance read-next-bnf-production1-strong
+                                    (production (rev lexeme-cache))
+                                    (lexeme-cache nil)))))
+  :rule-classes (:rewrite :linear))
+
+#|
+(i-am-here)
+
+(defthm read-next-bnf-production-strong
+  (implies (and (character-listp file-input)
+            (booleanp keep-newline)
+            (string-list-p production)
+            (string-list-p lexeme-cache)
+            (mv-nth 0 (read-next-bnf-production file-input keep-newline lexeme-cache)))
+           (< (acl2-count (mv-nth 1 (read-next-bnf-production file-input keep-newline
+                                                              lexeme-cache)))
+              (acl2-count file-input)))
+  :hints (("Goal" :do-not-induct t
+           :in-theory (e/d (read-next-bnf-production)
+                           (read-next-bnf-production1-strong
+                            read-next-bnf-production1)))
+          ("Goal'" :use ((:instance read-next-bnf-production1-strong
+                                    (production (rev lexeme-cache))
+                                    (lexeme-cache nil)))))
+  :otf-flg t
+  :rule-classes (:rewrite :linear))
+|#
+
+(define inject-expansions! ((target-list string-list-p)
+                            (expansion string-list-p)
+                            (rules rule-list-p)
+                            (production (and (string-list-p production)
+                                             (consp production))))
+  :returns (rules rule-list-p :hyp :fguard)
+  :parents (earley-parser)
+  ;:assert rule-list-p
+  (cond
+   ;; No more expansions -> Inject last one
+   ((atom target-list) ; was null in cl impl
+    (let ((curr-val (cdr (hons-get (car production) rules))))
+      (hons-shrink-alist
+       (hons-acons (car production)
+                   (cons expansion curr-val)
+                   rules)
+       nil)))
+   ;; More expansion -> Inject current and continue
+   ((equal (first target-list) "|")
+    (let* ((curr-val (cdr (hons-get (car production) rules)))
+           (rules (hons-shrink-alist
+                   (hons-acons (car production)
+                               (cons expansion curr-val)
+                               rules)
+                   nil)
+                   ))
+      (inject-expansions! (cdr target-list) nil #|expansion|# rules production)))
+   ;; Expansion not ended -> Collect rest of expansion
+   (t
+    (inject-expansions! (cdr target-list)
+                        (append expansion (list (first target-list)))
+                        rules
+                        production)))
+  :prepwork
+  ((skip-proofs ; unsound but doing for now. Commented hyps will be needed eventually
+    (defthm read-next-bnf-production-strong
+      (implies (and ;; (character-listp file-input)
+                ;; (booleanp keep-newline)
+                ;; (string-list-p production)
+                ;; (string-list-p lexeme-cache)
+                (mv-nth 0 (read-next-bnf-production file-input keep-newline lexeme-cache)))
+               (< (acl2-count (mv-nth 1 (read-next-bnf-production file-input keep-newline
+                                                                  lexeme-cache)))
+                  (acl2-count file-input)))
+      :hints (("Goal" :do-not-induct t
+               :in-theory (e/d (read-next-bnf-production)
+                               (read-next-bnf-production1-strong)))
+              ("Goal'" :use ((:instance read-next-bnf-production1-strong
+                                        (production (rev lexeme-cache))
+                                        (lexeme-cache nil)))))
+      :rule-classes (:rewrite :linear))))
+
+)
+
+(define load-bnf-grammar2 ((file-input character-listp)
+                           (rules rule-list-p)
+                           (lexeme-cache string-list-p))
+  :returns (mv (rules rule-list-p :hyp :fguard)
+               (lexeme-cache string-list-p :hyp :fguard))
+  ;:assert (rule-list-p string-list-p)
+  :parents (earley-parser)
+  (mv-let (production new-file-input lexeme-cache)
+
+; could use a flag other than production to indicate termination
+
+    (read-next-bnf-production file-input nil lexeme-cache)
+    (cond ((atom production) ; used to be null but should be fine
+           (mv rules lexeme-cache))
+          ((atom (cdr production))
+           (prog2$ (er hard? 'load-bnf-grammar2
+
+; Ee could try changing the above "hard?" to "hard", and after proving a lemma
+; about read-next-bnf-production, prove that this branch is unreachable.
+
+                       "Programming error: production should have been either ~
+                        nil or a list of at least length two, but was ~x0"
+                       production)
+                   (mv rules lexeme-cache)))
+          (t (let ((rules (inject-expansions! (cddr production) nil rules production)))
+               (load-bnf-grammar2 new-file-input rules lexeme-cache))))))
+
+(define load-bnf-grammar1 ((file-input character-listp))
+  :returns (grammar grammar-p :hyp :fguard)
+  ;:assert grammar-p
+  :parents (earley-parser)
+  (mv-let (rules lexeme-cache)
+
+; For each production in the BNF file, create a list of possible ordered symbol
+; sequences (list of strings) that is a legal expression for the symbol.
+
+    (load-bnf-grammar2 file-input nil nil)
+    (declare (ignore lexeme-cache))
+    (let ((rules (hons-shrink-alist rules nil)))
+      (make-grammar :rules rules))))
+
+(define load-bnf-grammar ((filename stringp)
+                          (state state-p))
+  "Reads a grammar on Backus-Naur form into the representation of the context
+   free grammar(CFG)."
+  :returns (mv (grammar grammar-p :hyp :fguard)
+               (state state-p :hyp :fguard))
+  :parents (earley-parser)
+  (mv-let (file-input state)
+    (read-file-characters-no-error filename state)
+    (let ((grammar (load-bnf-grammar1 file-input)))
+      (mv grammar state))))
+
+;;;; Lexicon functions
+;;;;------------------
+;;;; Reads a dictionary on the form:
+;;;;
+;;;; <word> :class <class> :gender <gender>
+;;;;
+;;;; into a hashtable of lists of word instances and
+;;;; a list of word classes (part of speech).
+
+;; (defn keyword-string-pair-p (x)
+;;   (and (consp x)
+;;        (keywordp (car x))
+;;        (stringp (cdr x))))
+
+;; (cutil::deflist keyword-string-pair-list-p (x)
+;;   (keyword-string-pair-p x)
+;;   :elementp-of-nil nil
+;;   :true-listp t)
+
+(cutil::defalist keyword-string-pair-list-p (x)
+  :key (keywordp x)
+  :val (stringp x)
+  :true-listp t
+  :parents (earley-parser))
+
+(local
+ (defthm lemma1
+   (implies (and (force (character-listp chars))
+                 (force (stringp str))
+                 (not (member-symbol-name str
+                                          (pkg-imports "KEYWORD"))))
+            (equal (symbol-package-name
+                    (intern-in-package-of-symbol str
+                                                 :a-random-symbol-for-intern))
+                   "KEYWORD"))))
+
+(local
+ (defthm lemma2
+   (implies (and (force (character-listp chars))
+                 (force (stringp str))
+                 (not (member-symbol-name str
+                                          nil)))
+            (equal (symbol-package-name
+                    (intern-in-package-of-symbol str
+                                                 :a-random-symbol-for-intern))
+                   "KEYWORD"))))
+
+(local
+ (include-book "std/misc/intern-in-package-of-symbol" :dir :system))
+
+(defthm run-pkg-imports-on-keyword
+  (equal (pkg-imports "KEYWORD")
+         nil))
+
+(local
+ (defun double-cdr (x)
+   (if (atom x)
+       nil
+     (double-cdr (cddr x)))))
+
+(defn even-string-list-p (x)
+  (cond ((atom x)
+         (null x))
+        (t (and (stringp (car x))
+                (consp (cdr x))
+                (stringp (cadr x))
+                (even-string-list-p (cddr x))))))
+
+(defthm even-string-list-p-implies-string-list-p
+  (implies (even-string-list-p x)
+           (string-list-p x))
+  :rule-classes :forward-chaining)
+
+
+
+(define read-lexicon-line-options ((strings even-string-list-p))
+  :measure (len strings)
+  :returns (ans keyword-string-pair-list-p :hyp :fguard)
+  :parents (earley-parser)
+  (cond ((atom strings)
+         nil)
+        ((member-symbol-name (str-trim '(#\:)
+                                       (str::upcase-string (car strings)))
+                             (pkg-imports "KEYWORD"))
+         (er hard? 'read-lexicon-line-options
+             "The lexicon string cannot be converted to a keyword symbol ~
+              because it already exists in the keyword package (this would ~
+              not be a problem if this symbol had not been imported from ~
+              another package).  Offending string is: ~x0"
+             (str-trim '(#\:)
+                       (str::upcase-string (car strings)))))
+        (t (cons (cons (intern (str-trim '(#\:)
+                                         (str::upcase-string (car strings)))
+                               "KEYWORD")
+                       (cadr strings))
+                 (read-lexicon-line-options (cddr strings))))))
+
+
+
+(local
+ (defthm read-lexicon-line-subgoal-4-a
+   (implies (and (alistp lst)
+                 (assoc-equal x lst))
+            (consp (assoc-equal x lst)))))
+
+(local
+ (defthm read-lexicon-line-subgoal-4-b
+   (implies (even-string-list-p (cdr (str::strtok (mv-nth 0 (read-line! file-input))
+                                                  '(#\space))))
+
+            (alistp (READ-LEXICON-LINE-OPTIONS
+                     (CDR (STR::STRTOK (MV-NTH 0 (READ-LINE! FILE-INPUT))
+                                       '(#\Space))))))))
+
+;; (local
+;;  (defthm read-lexicon-line-subgoal-4
+;;    (implies
+;;     (and
+;;      (character-listp file-input)
+;;      (mv-nth 0 (read-line! file-input))
+;;      (not (equal (mv-nth 0 (read-line! file-input))
+;;                  ""))
+;;      (consp (str::strtok (mv-nth 0 (read-line! file-input))
+;;                          '(#\space)))
+;;      (stringp (car (str::strtok (mv-nth 0 (read-line! file-input))
+;;                                 '(#\space))))
+;;      (even-string-list-p (cdr (str::strtok (mv-nth 0 (read-line! file-input))
+;;                                            '(#\space))))
+;;      (not
+;;       (consp
+;;        (assoc-equal
+;;         :class (read-lexicon-line-options
+;;                 (cdr (str::strtok (mv-nth 0 (read-line! file-input))
+;;                                   '(#\space))))))))
+;;     (not (assoc-equal
+;;           :class (read-lexicon-line-options
+;;                   (cdr (str::strtok (mv-nth 0 (read-line! file-input))
+;;                                     '(#\space)))))))))
+
+;; (local
+;;  (defthm member-assoc-equivalence-1-A
+;;    (implies (alistp lst)
+;;             (iff (member key (strip-cars lst))
+;;                  (assoc key lst)
+;;                  ))))
+
+;; (local
+;;  (defthm member-assoc-equivalence-1-B
+;;    (implies (alistp lst)
+;;             (iff (assoc key lst)
+;;                  (member key (strip-cars lst))))))
+
+
+;; (local
+;;  (defthm member-assoc-equivalence-2
+;;    (implies (and (alistp lst) (cdr (assoc key lst)))
+;;             (member key (strip-cars lst)))))
+
+(local
+ (defthm read-lexicon-line-subgoal-3-lemma
+   (implies (and (alistp lst)
+                 (keyword-string-pair-list-p lst)
+                 (assoc-equal key lst))
+            (stringp (cdr (assoc-equal key lst))))))
+
+;; (local
+;;  (defthm read-lexicon-line-subgoal3
+;;    (implies
+;;     (and
+;;      (character-listp file-input)
+;;      (mv-nth 0 (read-line! file-input))
+;;      (not (equal (mv-nth 0 (read-line! file-input))
+;;                  ""))
+;;      (consp (str::strtok (mv-nth 0 (read-line! file-input))
+;;                          '(#\space)))
+;;      (stringp (car (str::strtok (mv-nth 0 (read-line! file-input))
+;;                                 '(#\space))))
+;;      (even-string-list-p (cdr (str::strtok (mv-nth 0 (read-line! file-input))
+;;                                            '(#\space))))
+;;      (cdr (assoc-equal
+;;            :class (read-lexicon-line-options
+;;                    (cdr (str::strtok (mv-nth 0 (read-line! file-input))
+;;                                      '(#\space)))))))
+;;     (stringp
+;;      (cdr (assoc-equal
+;;            :class (read-lexicon-line-options
+;;                    (cdr (str::strtok (mv-nth 0 (read-line! file-input))
+;;                                      '(#\space))))))))))
+
+(define read-lexicon-line ((file-input character-listp))
+   "Read a line from the given file, and return the corresponding terminal."
+   ;; Parse a line from the file
+   :returns (mv (terminal (implies terminal (terminal-p terminal)))
+                (remaining-file-input character-listp :hyp :fguard))
+   :parents (earley-parser)
+   (mv-let (line new-file-input)
+     (read-line! file-input)
+     (cond ((or (null line) (equal line ""))
+            (mv nil new-file-input))
+           (t
+            (b* ((words ;(remove-equal ""  ; remove call is unnecessary
+                  (str::strtok line '(#\Space))) ;)
+                 ((unless (and (consp words) (stringp (car words))))
+                  (mv (er hard? 'read-lexicon-line
+                          "Read-lexicon-line does not accept empty lines")
+                      new-file-input))
+                 (string (first words))
+                 ( ;(when (and (consp (cdr words)) (atom (cddr words))))
+                  (unless (even-string-list-p (cdr words)))
+                  (mv (er hard? 'read-lexicon-line
+                          "Read-lexicon-line given lexicon input line that ~
+                          doesn't have _pairs_ (not in the lisp sense) of ~
+                          options and values.  Input line is:~% ~x0"
+                          (cdr words))
+                      new-file-input))
+                 (options (read-lexicon-line-options (cdr words))))
+              ;; Create the word object
+              (mv (make-terminal :word string ; the regex would be read in here
+                                 :class (str-trim '(#\< #\>)
+                                                  (or (cdr (assoc :class
+                                                                  options))
+                                                      ""))
+                                 :gender (cdr (assoc :gender options)))
+                  new-file-input)))))
+   ///
+
+
+   ;; (local
+   ;;  (defthm dumb-lemma
+   ;;    (implies (and (character-listp x) x)
+   ;;             (< 0 (length x)))))
+
+
+   (defthm read-lexicon-line-weak
+     (<= (acl2-count (mv-nth 1 (read-lexicon-line file-input)))
+         (acl2-count file-input))
+     :rule-classes (:rewrite :linear))
+
+
+   (encapsulate
+    ()
+    (local (include-book
+
+; Provides us with the following, necessary for read-lexicon-line-strong
+
+;;; (implies (and (stringp x)
+;;;        n       (not (equal x "")))
+;;;          (< 0 (length x)))))
+
+            "str/arithmetic" :dir :system))
+
+    (defthm read-lexicon-line-strong
+      (implies (and
+                (mv-nth 0 (read-lexicon-line file-input))
+                (force (character-listp
+; Could possibly be removed if we did more sophisticated reasoning for
+; read-line
+                        file-input)))
+               (< (acl2-count (mv-nth 1 (read-lexicon-line file-input)))
+                  (acl2-count file-input)))
+      :hints (("Goal" :in-theory (enable read-lexicon-line))
+              ("Goal'''" :in-theory (e/d (read-lexicon-line)
+                                         (read-line!-strong))
+               :use ((:instance read-line!-strong))))
+      :rule-classes (:rewrite :linear))))
+
+;; (local
+;;  (defthm load-lexicon1-lemma
+;;    (implies (and (stringp word)
+;;                  (lexicon-p lexicon)
+;;                  (terminal-p terminal))
+;;             (lexicon-p (hons-acons word
+;;                                    (hons terminal
+;;                                          (cdr (hons-get word lexicon-p)))
+;;                                    lexicon)))
+;;    :hints (("Goal" :in-theory (enable lexicon-p terminal-p)))))
+
+;; (local
+;;  (defthm load-lexicon1-lemmaaaa
+;;    (implies (and (dictionary-p dictionary)
+;;                  (stringp word))
+;;             (terminal-list-p (hons-assoc-equal word
+;;                                               dictionary)))))
+
+(defthm load-lexicon1-lemma
+  (implies
+   (and (character-listp file-input)
+        (string-list-p part-of-speech-list)
+        (dictionary-p dictionary)
+        (mv-nth 0 (read-lexicon-line file-input)))
+   (terminal-p (mv-nth 0 (read-lexicon-line file-input)))))
+
+(define load-lexicon1 ((dictionary dictionary-p)
+                       (part-of-speech-list string-list-p)
+                       (file-input character-listp))
+  :returns (mv (dictionary dictionary-p :hyp :fguard)
+               (part-of-speech-list string-list-p :hyp :fguard)
+               (remaining-file-input character-listp :hyp :fguard))
+  :parents (earley-parser)
+  (if (mbe :logic (not (character-listp file-input))
+           :exec nil)
+      (mv dictionary part-of-speech-list file-input)
+    (mv-let (terminal new-file-input)
+      (read-lexicon-line file-input)
+      (cond ((null terminal) ; source of a bug, what if the lex file contains a blank line?,
+             (mv dictionary part-of-speech-list new-file-input))
+            (t
+             (b* ((word (terminal->word terminal))
+                  (curr-terminal-list (cdr (hons-get word dictionary)))) ; source of bug?, "working" version doesn't call cdr, but it's "correctly" needed for the proof to go through
+               (load-lexicon1 (hons-acons word
+                                          (hons terminal curr-terminal-list)
+                                          dictionary)
+                              (cons (terminal->class terminal)
+                                    part-of-speech-list)
+                              new-file-input)))))))
+
+(define load-lexicon ((filename stringp)
+                      (state state-p))
+  :returns (mv (lexicon lexicon-p :hyp :fguard)
+               (state state-p :hyp :fguard))
+  :parents (earley-parser)
+  (let ((dictionary nil) ; use a hashtable
+        (part-of-speech-list nil))
+    (mv-let (file-input state)
+      (read-file-characters-no-error filename state)
+      (mv-let (dictionary part-of-speech-list new-file-input)
+        (load-lexicon1 dictionary part-of-speech-list file-input)
+        (declare (ignore new-file-input))
+        (mv (make-lexicon :dictionary dictionary
+                          :part-of-speech part-of-speech-list)
+            state)))))
diff -Nru acl2-6.2/books/parsers/earley/object-representations.lisp acl2-6.3/books/parsers/earley/object-representations.lisp
--- acl2-6.2/books/parsers/earley/object-representations.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/object-representations.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,711 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;  David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(in-package "ACL2")
+
+(include-book "cutil/defaggregate" :dir :system)
+(include-book "cutil/deflist" :dir :system)
+(include-book "cutil/defalist" :dir :system)
+(include-book "tools/bstar" :dir :system)
+(include-book "cutil/define" :dir :system)
+;(include-book "countereg-gen/top" :dir :system)
+(include-book "defprimitive")
+(include-book "regex/regex-ui" :dir :system)
+
+;(acl2s-defaults :set testing-enabled t)
+
+(defconst *debug* 4)
+
+(cutil::deflist string-list-p (x)
+  (stringp x)
+  :elementp-of-nil nil
+  :true-listp t
+  :parents (earley-parser))
+
+(defn word-p (x)
+  (stringp x))
+
+(defthm word-p-implies-string-p
+  (implies (word-p x)
+           (stringp x))
+  :rule-classes (:rewrite :forward-chaining))
+
+(cutil::deflist word-list-p (x)
+  (word-p x)
+  :elementp-of-nil nil
+  :true-listp t
+  :parents (earley-parser))
+
+(defprimitive sentence (x)
+  (stringp x)
+  :parents (earley-parser))
+
+;;;; Representation of terminals
+;;;;----------------------------
+(cutil::defaggregate terminal
+  ((class stringp)
+   (gender)
+   (word word-p))
+  :tag :terminal
+  :parents (earley-parser))
+
+(cutil::deflist terminal-list-p (x)
+  (terminal-p x)
+  :elementp-of-nil nil
+  :true-listp t
+  :parents (earley-parser))
+
+;;;; Representation of context-free grammar
+;;;;---------------------------------------
+(cutil::deflist string-list-list-p (x)
+  (string-list-p x)
+  :elementp-of-nil t
+  :true-listp t
+  :parents (earley-parser))
+
+(cutil::defalist rule-list-p (x)
+  :key (stringp x)
+  :val (string-list-list-p x)
+  :true-listp t
+  :parents (earley-parser))
+
+(cutil::defaggregate grammar
+  ((rules rule-list-p)) ; rules should be treated as a hons alist
+  :parents (earley-parser)
+  :tag :rules)
+
+(define grammar-productions ((non-terminal stringp "The non-terminal symbol")
+                             (grammar grammar-p "The grammar"))
+  :returns (productions string-list-list-p :hyp :fguard
+                        "Set of possible productions for a given non-terminal")
+  :parents (earley-parser)
+  ;:assert (string-list-list-p)
+  (cdr (hons-get non-terminal (grammar->rules grammar))))
+
+;;;; Representation of dictionary
+;;;;-----------------------------
+(cutil::defalist dictionary-p (x)
+  :key (stringp x)
+  :val (terminal-list-p x)
+  :true-listp t
+  :parents (earley-parser))
+
+(defthm dictionary-p-is-string-keyed-alist-p
+  (implies (dictionary-p x)
+           (string-keyed-alist-p x))
+  :hints (("Goal" :in-theory (enable string-keyed-alist-p))))
+
+(defthm regex-get-of-dictionary-p-returns-terminal-list-p
+  (implies (and (stringp x)
+                (dictionary-p dict))
+           (terminal-list-p (cdr (regex-get x dict))))
+  :hints (("Goal" :in-theory (enable regex-get))))
+
+;;;; Representation of lexicon
+;;;;--------------------------
+(cutil::defaggregate lexicon
+  ((dictionary dictionary-p) ; dictionary should be treated as a hons alist
+   (part-of-speech string-list-p))
+  :tag :lexicon
+  :parents (earley-parser))
+
+(define lexicon-lookup ((word word-p)
+                        (lexicon lexicon-p))
+  :returns (ans (terminal-list-p ans)
+                "The list of terminals associated with the given word"
+                :hyp :fguard)
+  :parents (earley-parser)
+  ;:assert (terminal-list-p)
+  (let ((val (regex-get word (lexicon->dictionary lexicon))))
+    (if (consp val)
+        (cdr val)
+      nil))
+  ;(cdr (hons-get word (lexicon->dictionary lexicon)))
+  )
+
+;;;; Representation of state
+;;;;------------------------
+;; (defun pstate-count (pstate-list)
+;;   (cond ((atom pstate-list)
+;;          0)
+;;         (t
+;;          (+ 1
+;;             (pstate-count (cdr (assoc-equal 'history (cdar pstate-list))))
+;;             (pstate-count (cdr pstate-list))))))
+
+(defn string-list-or-string-list-list-p (x)
+  (or (string-list-p x)
+      (string-list-list-p x)))
+
+(defthm string-list-or-string-list-list-p-helper-lemma-1
+  (implies (and (string-list-or-string-list-list-p x)
+                (not (string-list-p x)))
+           (string-list-list-p x)))
+
+(defthm string-list-or-string-list-list-p-helper-lemma-2
+  (implies (and (string-list-or-string-list-list-p x)
+                (not (string-list-list-p x)))
+           (string-list-p x)))
+           
+(encapsulate 
+ ()
+ (local
+  (defthm assoc-cdr-terminates-lemma
+    (implies (consp x)
+             (< (acl2-count (cdr (assoc some-label (cdr x))))
+                (acl2-count x)))
+    :rule-classes :linear))
+ 
+ 
+ (mutual-recursion
+  ;; (DEFUND
+  ;;     PSTATE-P (X)
+  ;;     (DECLARE (XARGS :GUARD T))
+  ;;     (AND (CONSP X)
+  ;;          (EQ (CAR X) :PSTATE)
+  ;;          (ALISTP (CDR X))
+  ;;          (CONSP (CDR X))
+  ;;          (LET ((SOURCE (CDR (ASSOC 'SOURCE (CDR X))))
+  ;;                (TARGETS (CDR (ASSOC 'TARGETS (CDR X))))
+  ;;                (DOT (CDR (ASSOC 'DOT (CDR X))))
+  ;;                (START-INDEX (CDR (ASSOC 'START-INDEX (CDR X))))
+  ;;                (DOT-INDEX (CDR (ASSOC 'DOT-INDEX (CDR X))))
+  ;;                (HISTORY (CDR (ASSOC 'HISTORY (CDR X)))))
+  ;;               (DECLARE (IGNORABLE SOURCE TARGETS DOT START-INDEX
+  ;;                                   DOT-INDEX HISTORY))
+  ;;               (AND (STRINGP SOURCE)
+  ;;                    (STRING-LIST-P TARGETS)
+  ;;                    (NATP DOT)
+  ;;                    (< DOT (LEN TARGETS))
+  ;;                    (NATP DOT-INDEX)
+  ;;                    (< DOT-INDEX (LEN TARGETS))
+  ;;                    (PSTATE-LIST-P HISTORY)))))
+
+ ;; (DEFUND
+ ;;   PSTATE-P (X)
+ ;;   (DECLARE (XARGS :GUARD T))
+ ;;   (AND
+ ;;    (OR
+ ;;     (AND (CONSP X) (EQ (CAR X) :PSTATE))
+ ;;     (WITH-OUTPUT-LOCK
+ ;;      (CW
+ ;;       "Stuctural check for consp and tag ~
+ ;;                                     equality failed.  Tag should be ~x0.  ~
+ ;;                                     Failing instance is:~% ~x1~%~%"
+ ;;       :PSTATE X)))
+ ;;    (OR
+ ;;     (AND (ALISTP (CDR X)) (CONSP (CDR X)))
+ ;;     (WITH-OUTPUT-LOCK
+ ;;      (CW
+ ;;       "Structural check for ~x0 failed.  Failing instance ~
+ ;;                         is:~% ~x1~%"
+ ;;       'PSTATE
+ ;;       X)))
+ ;;    (LET
+ ;;     ((SOURCE (CDR (ASSOC 'SOURCE (CDR X))))
+ ;;      (TARGETS (CDR (ASSOC 'TARGETS (CDR X))))
+ ;;      (DOT (CDR (ASSOC 'DOT (CDR X))))
+ ;;      (START-INDEX (CDR (ASSOC 'START-INDEX (CDR X))))
+ ;;      (DOT-INDEX (CDR (ASSOC 'DOT-INDEX (CDR X))))
+ ;;      (HISTORY (CDR (ASSOC 'HISTORY (CDR X)))))
+ ;;     (DECLARE (IGNORABLE SOURCE TARGETS DOT START-INDEX
+ ;;                         DOT-INDEX HISTORY))
+ ;;     (AND
+ ;;      (OR (STRINGP SOURCE)
+ ;;          (WITH-OUTPUT-LOCK (CW "Check ~x0 failed~%"
+ ;;                                '(STRINGP SOURCE))))
+ ;;      (OR (STRING-LIST-P TARGETS)
+ ;;          (WITH-OUTPUT-LOCK (CW "Check ~x0 failed~%"
+ ;;                                '(STRING-LIST-P TARGETS))))
+ ;;      (OR (NATP DOT)
+ ;;          (WITH-OUTPUT-LOCK (CW "Check ~x0 failed~%" '(NATP DOT))))
+ ;;      (OR (NATP DOT-INDEX)
+ ;;          (WITH-OUTPUT-LOCK (CW "Check ~x0 failed~%"
+ ;;                                '(NATP DOT-INDEX))))
+ ;;      (OR (PSTATE-LIST-P HISTORY)
+ ;;          (WITH-OUTPUT-LOCK (CW "Check ~x0 failed~%"
+ ;;                                '(PSTATE-LIST-P HISTORY))))
+ ;;      (OR
+ ;;       (IMPLIES TARGETS (<= DOT (LEN TARGETS)))
+ ;;       (WITH-OUTPUT-LOCK (CW "Check ~x0 failed~%"
+ ;;                             '(IMPLIES TARGETS (<= DOT (LEN TARGETS))))))))))
+
+
+  (DEFUND PSTATE-P (X)
+          (DECLARE (XARGS :GUARD T))
+          (AND (CONSP X)
+               (EQ (CAR X) :PSTATE)
+               (ALISTP (CDR X))
+               (CONSP (CDR X))
+               (LET ((SOURCE (CDR (ASSOC 'SOURCE (CDR X))))
+                     (TARGETS (CDR (ASSOC 'TARGETS (CDR X))))
+                     (DOT (CDR (ASSOC 'DOT (CDR X))))
+                     (START-INDEX (CDR (ASSOC 'START-INDEX (CDR X))))
+                     (DOT-INDEX (CDR (ASSOC 'DOT-INDEX (CDR X))))
+                     (HISTORY (CDR (ASSOC 'HISTORY (CDR X))))
+                     ;(INPUT-LENGTH (CDR (ASSOC 'INPUT-LENGTH (CDR X))))
+                     )
+                    (DECLARE (IGNORABLE SOURCE TARGETS DOT START-INDEX
+                                        DOT-INDEX HISTORY #|INPUT-LENGTH|#))
+                    (AND (STRINGP SOURCE)
+                         (STRING-LIST-P TARGETS)
+                         (NATP DOT)
+                         (NATP START-INDEX)
+                         (NATP DOT-INDEX)
+                         (PSTATE-LIST-P HISTORY)
+                         ;(NATP INPUT-LENGTH)
+                         (<= START-INDEX DOT-INDEX)
+                         (<= DOT (LEN TARGETS))
+                         ;; (AND (<= DOT INPUT-LENGTH)
+                         ;;      (<= DOT-INDEX INPUT-LENGTH)
+                         ;;      (<= START-INDEX INPUT-LENGTH))
+                         ))))
+
+  (DEFUND PSTATE-LIST-P (X)
+    (DECLARE (XARGS :GUARD T
+                    :NORMALIZE NIL
+                    :VERIFY-GUARDS T
+                    :GUARD-DEBUG NIL
+                    :GUARD-HINTS NIL))
+    (IF (CONSP X)
+        (AND (PSTATE-P (CAR X))
+             (PSTATE-LIST-P (CDR X)))
+        (NULL X)))
+  )
+ )
+
+(cutil::deflist pstate-list-p (x)
+  (pstate-p x)
+  :elementp-of-nil nil
+  :true-listp t 
+  :already-definedp t
+  :parents (earley-parser))
+
+
+(cutil::defaggregate pstate
+; consider renaming to cstate, short for "Chart state", or "staat", which is
+; phoenetically similar to "state"
+  :short "A Parser State (pstate)"
+  :long "Most parser states are created with a grammar rule in mind.  This is
+         because most of the parser states are a result of predictions.  A
+         relatively small number of them are created by scanning the input
+         text.  As such, the members of a parser state look a lot like parts of
+         a grammar rule, with markup for tracking where the current parse is in
+         the rule and where this particular instance of the grammar rule sits
+         inside the input text sentence."
+  ((source stringp
+            "The starting symbol for the state's grammar rule.")
+   (targets string-list-p 
+            "The targets for the state's grammar rule.  Consists of a left-hand
+             side (lhs) that has already been parsed (seen) and a right-hand side
+             (rhs) that remains to be parsed (unseen).")
+   (dot natp :rule-classes :type-prescription
+            "Indicates where the dot is. Everything to the left of the dot has
+             been seen and is called the <tt>lhs</tt> and everything to the
+             right of the dot has not yet been seen and is called the
+             <tt>rhs</tt>.")
+   (start-index natp :rule-classes :type-prescription
+                "Position in the input text where this instance of the
+                 grammar rule starts.")
+   (dot-index natp :rule-classes :type-prescription
+              "Dot's position, relative to the start of the sentence.")
+   (history pstate-list-p "Find out which previous states led to this
+                           state (used for printing a parse tree).")
+   ;; (input-length natp :rule-classes :type-prescription
+   ;;               "Length of the input text.  Not used in any meaningful way except
+   ;;                to help with logical obligations")
+   )
+  :require (
+
+; Since any pstate is constructed for a given input text, it would be nice to
+; include the property that the three natp's of the pstate must be less or
+; equal to the length of the input text.
+
+            (limit-of-pstate->dot-index
+             (<= start-index dot-index)
+             :rule-classes (:linear :rewrite))
+
+            (limit-of-pstate->dot
+             (<= dot (len targets))
+             :rule-classes (:linear :rewrite))
+
+            ;; (limits-based-on-pstate->input-length
+            ;;  (and (<= dot input-length)
+            ;;       (<= dot-index input-length)
+            ;;       (<= start-index input-length)))
+            )
+
+  :already-definedp t
+  :parents (earley-parser)
+  :tag :pstate)
+
+;; (defthm true-listp-of-pstate->history
+;;   (implies (pstate-p x)
+;;            (true-listp (pstate->history x)))
+;;   :rule-classes :type-prescription)
+
+(in-theory (disable pstate-p pstate-list-p))
+
+
+;(encapsulate 
+; ()
+
+ ;; (defthm subseq-hack
+ ;;   (implies (stringp str)
+ ;;            (equal (len (coerce str 'list)) 
+ ;;                   (length str))))
+ 
+; (ld "counter-example-gen.lisp")
+
+(defthm string-list-p-implies-true-listp
+
+; TODO: Consider making a type-prescription rule
+
+  (implies (string-list-p x)
+           (true-listp x)))
+
+(defthm pstate->targets-is-not-a-string
+  
+; Shouldn't really be necessary, but the question comes up a lot because of the
+; use of subseq and other functions that can accept either a list or a string.
+  
+  (implies (pstate-p x)
+           (not (stringp (pstate->targets x))))
+  
+  :hints (("Goal" :in-theory (enable pstate-p pstate->targets))))
+
+;(in-theory (enable pstate-targets$INLINE))
+
+#|
+(local 
+ (defthm lemmmamama
+   (IMPLIES (FORCE (PSTATE-P X))
+            (IMPLIES (PSTATE->TARGETS X)
+                     (<= (PSTATE->DOT X)
+                        (LEN (PSTATE->TARGETS X)))))))
+   :hints (("Goal" :in-theory (enable pstate-p)))))
+|#
+
+(define pstate->print ((pstate pstate-p))
+  :returns (ans null)
+  :guard-debug t
+  (let ((source (pstate->source pstate))
+        (targets (pstate->targets pstate))
+        (dot (nfix (pstate->dot pstate))))
+    (cw "#{~@0 -> ~*1 . ~*2 [~x3,~x4]}"
+        source
+        (if targets 
+            (list "" "~@*" "~@* " "~@* " (subseq-list targets 0 dot))
+          nil)
+        (if targets
+            (list "" "~@*" "~@* " "~@* " (subseq-list targets dot (len targets)))
+          nil)
+        (pstate->start-index pstate)
+        (pstate->dot-index pstate)))
+  :parents (earley-parser))
+
+
+(define incomplete-p ((pstate pstate-p))
+  :short "Determines whether there is anything left of the targets behind the dot."
+  :returns (ans booleanp)
+  ;:assert booleanp
+  :parents (earley-parser)
+  (not (equal (pstate->dot pstate) (len (pstate->targets pstate)))))
+
+#|
+ (define next-target ((pstate pstate-p))
+  :short "Returns the next category of 'state'" ; what is a "category"?
+  :returns (category (if category (stringp category) t))
+  (let ((targets (pstate->targets pstate))
+        (dot (pstate->dot pstate)))
+    (if (< dot (len targets))
+        (nth dot targets)
+      nil)))
+|#
+
+(defn string-or-string-list-p (x)
+  (or (stringp x)
+      (string-list-p x)))
+
+(defthm string-or-string-list-p-helper-lemma-1
+  (implies (and (string-or-string-list-p x)
+                (not (stringp x)))
+           (string-list-p x)))
+
+(defthm string-or-string-list-p-helper-lemma-2
+  (implies (and (string-or-string-list-p x)
+                (not (string-list-p x)))
+           (stringp x)))
+
+(local
+ (defthm next-target-lemma-1
+   (implies (and (natp n)
+                 (< n (len x))
+                 (string-list-or-string-list-list-p x))
+            (string-or-string-list-p (nth n x)))
+   :hints (("Goal" :in-theory (enable string-or-string-list-p)))))
+
+(local
+ (defthm next-target-lemma-2
+   (implies (and (pstate-p pstate)
+                 (not (stringp (nth (pstate->dot pstate)
+                                    (pstate->targets pstate))))
+                 (< (pstate->dot pstate)
+                    (len (pstate->targets pstate))))
+            (string-list-p (nth (pstate->dot pstate)
+                                (pstate->targets pstate))))))
+
+(define next-target ((pstate pstate-p))
+  "Returns the next category of 'state'"
+  :returns (cat stringp :hyp :fguard)
+  :parents (earley-parser)
+  ;:assert (stringp)
+  (let ((targets (pstate->targets pstate))
+        (dot (pstate->dot pstate)))
+    (if (< dot (len targets))
+        (nth dot targets) 
+      ""))) ; was nil once upon a time
+
+
+;; (skip-proofs ; this is hard to get rid of
+
+;; (mutual-recursion
+;;  (defun flatten-pstate-list (pstate-list)
+;;    (cond ((atom pstate-list)
+;;           nil)
+;;          (t 
+;;           (cons (flatten-pstate (car pstate-list))
+;;                 (flatten-pstate-list (cdr pstate-list)))))) 
+
+;;  (defun flatten-pstate (pstate)
+;;    (cond ((atom (pstate->history pstate))
+;;           (list pstate))
+;;          (t (cons pstate
+;;                   (flatten-pstate-list (pstate->history pstate))))))
+;;  )
+
+;; (defun pstate-count (pstate-list)
+;;   (cond ((atom pstate-list)
+;;          0)
+;;         (t
+;;          (+ 1
+;;             (pstate-count (pstate->history (car pstate-list)))
+;;             (pstate-count (cdr pstate-list))))))
+
+
+;;  (defun flatten-pstate-list (pstate-list)
+;;   (declare (xargs :measure (acl2-count pstate-list)))
+;;   (cond ((atom pstate-list)
+;;          nil)
+;;         (t
+;;          (append (car pstate-list)
+;;                  (flatten-pstate-list (pstate->history (car pstate-list)))
+;;                  (flatten-pstate-list (cdr pstate-list))))))
+
+(encapsulate 
+ ()
+; (local (in-theory (enable pstate->history$inline)))
+
+ (local 
+  (defthm pstate->tree-collect-lemma1
+    (implies (pstate->history pstate)
+             (< (acl2-count (pstate->history pstate))
+                (acl2-count pstate)))
+    :hints (("Goal" :in-theory (enable pstate->history$inline)))))
+
+;(local (in-theory (disable pstate->history$inline)))
+
+ (local 
+  (defthm pstate->tree-collect-lemma2
+    (implies (and (true-listp x)
+                  (atom x))
+             (equal (not x) t))))
+
+ (mutual-recursion
+  (defun pstate->tree-collect (pstates)
+    (declare (xargs :guard (pstate-list-p pstates)
+                    :guard-debug t
+                    :guard-hints (("Goal" :use ((:instance pstate->tree-collect-lemma2
+                                                           (x (pstate->targets pstate))))))))
+    (cond ((atom pstates)
+           nil)
+          (t (cons (pstate->tree (car pstates)) ; need to check collect for whether it removes duplicates)
+                   (pstate->tree-collect (cdr pstates))))))
+  
+  (defun pstate->tree (pstate)
+    "Creates a tree from a chart-listing object containing charts" ; ummmm what? there aren't any charts here
+    (declare (xargs :guard (pstate-p pstate)))
+    (if (null (pstate->history pstate))
+        (list (pstate->source pstate)
+              (if (atom (pstate->targets pstate))
+                  (er hard? 'pstate->tree
+                      "Expected (pstate->targets pstate) to be a consp but pstate ~
+                       was ~x0"
+                      pstate)
+                (car (pstate->targets pstate))))
+      (cons (pstate->source pstate)
+            (reverse (pstate->tree-collect (pstate->history pstate))))))))
+
+;; (defun pstate-list->tree (pstate-list)
+;;   (declare (xargs :guard (pstate-list-p pstate-list)
+;;                    ;:measure (acl2-count (flatten-pstate-list pstate-list))
+;;                    ))
+;;    (cond ((atom pstate-list)
+;;           nil)
+;;          (t
+;;           (append (car pstate-list)
+;;                   (pstate-list->tree (pstate->history (car pstate-list)))
+;;                   (pstate-list->tree (cdr pstate-list))))))
+
+;; (defun pstate->tree-new (pstate)
+;;   "Creates a tree from a chart-listing object containing charts"
+;;   (declare (xargs :guard (pstate-p pstate)
+;;                   :measure (pstate-count (list pstate))))
+;;   (cond ((atom 
+
+;;;; Representation of charts
+;;;;-------------------------
+(cutil::defaggregate chart
+  (pstates)
+  :require ((pstate-list-p-of-chart->pstates
+             (pstate-list-p pstates)))
+  ;:debugp t
+  :parents (earley-parser)
+  :tag :chart)
+
+;; (defthm true-listp-of-chart->pstates
+;;   (implies (chart-p x)
+;;            (true-listp (chart->pstates x)))
+;;   :rule-classes :type-prescription)
+
+(local
+ (defthmd enqueue-hack
+   (implies (pstate-list-p pstates) 
+            (pstate-list-p (list-fix pstates)))))
+
+(define enqueue ((pstate pstate-p)
+                 (chart chart-p)) 
+; enqueue should really be rewritten to accept a chart-list and an index to update
+  :guard-hints (("Goal" :in-theory (enable list-fix pstate-list-p
+                                           enqueue-hack)))
+  :parents (earley-parser)
+  :returns (chart chart-p :hyp :fguard)
+  ;:assert chart-p
+  (if (member-equal pstate (chart->pstates chart))
+      (if (> *debug* 3)
+          (progn$ (cw "  the state ")
+                  (pstate->print pstate)
+                  (cw "is already in the chart~%")
+                  chart)
+        chart)
+    (change-chart chart
+                  :pstates (append (chart->pstates chart)
+                                   (list pstate)))))
+
+(define chart->add-pstate-list ((pstate-list pstate-list-p)
+                                (chart chart-p))
+  :returns (chart chart-p :hyp :fguard)
+  :parents (earley-parser)
+  ;:assert (chart-p)
+  (cond ((atom pstate-list)
+         chart)
+        (t (chart->add-pstate-list (cdr pstate-list)
+                                   (enqueue (car pstate-list)
+                                            chart)))))
+
+(defun pstate-list->print (pstate-list)
+  (declare (xargs :guard (pstate-list-p pstate-list)))
+  (cond ((atom pstate-list)
+         nil)
+        (t
+         (progn$ (pstate->print (car pstate-list))
+                 (cw "~%")
+                 (pstate-list->print (cdr pstate-list))))))
+
+(defun chart->print (chart)
+  (declare (xargs :guard (chart-p chart)))
+  (progn$ (cw "#CHART:~%")
+          (pstate-list->print (chart->pstates chart))
+          (cw "~%")))
+
+;;;; Representation of chart listings
+;;;;---------------------------------
+(cutil::deflist chart-list-p (x)
+  (chart-p x)
+  :elementp-of-nil nil
+  :true-listp t
+  :parents (earley-parser))
+
+;; (cutil::defaggregate chart-listing
+;;   (charts)
+;;   :require ((chart-list-p-of-chart-listing->charts
+;;              (chart-list-p charts)))
+;;   :tag :chart-listing)
+
+;; (in-theory (enable chart-listing->charts)) ; because we have nice rewrite rules for chart-list-p
+
+(define add-chart ((chart chart-p)
+                   (chart-list chart-list-p))
+  :returns (chart-list chart-list-p :hyp :fguard)
+  :parents (earley-parser)
+  (cons chart chart-list))
+
+(defun chart-list->print1 (charts)
+  (declare (xargs :guard (chart-list-p charts)))
+  (cond ((atom charts)
+         nil)
+        (t
+         (prog2$ (chart->print (car charts))
+                 (chart-list->print1 (cdr charts))))))
+
+(defun chart-list->print (charts)
+  (declare (xargs :guard (chart-list-p charts)))
+  (prog2$ (cw "#CHART-LIST:~%")
+          (chart-list->print1 charts)))
+
+(define chart-list->collect ((pstates pstate-list-p)
+                             (chart-list chart-list-p))
+  :parents (earley-parser)
+; Don't yet know really what it returns, partly because it's not used in the example
+  (cond ((atom pstates)
+         nil)
+        (t (let ((pstate (car pstates)))
+             (if (and (equal (pstate->source pstate) "S")
+                      (equal (pstate->start-index pstate)
+                             0)
+                      (equal (pstate->dot-index pstate)
+                             (- (len chart-list) 1))
+                      (not (incomplete-p pstate)))
+                 (cons (pstate->tree pstate)
+                       (chart-list->collect (cdr pstates)
+                                            chart-list))
+               (chart-list->collect (cdr pstates)
+                                    chart-list))))))
+
+(define chart-list->trees ((chart-list chart-list-p))
+  :short "Return a list of trees created by following each successful parse in
+          the last chart of <tt>chart-list</tt>"
+  :parents (earley-parser)
+  (b* ((chart (first (last chart-list)))
+       ((when (null chart))
+        (er hard? 'chart-list->trees 
+            "Chart-list was null")))
+    (chart-list->collect
+     (chart->pstates (first (last chart-list)))
+     chart-list)))
+
diff -Nru acl2-6.2/books/parsers/earley/read-file-characters-no-error.lisp acl2-6.3/books/parsers/earley/read-file-characters-no-error.lisp
--- acl2-6.2/books/parsers/earley/read-file-characters-no-error.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/read-file-characters-no-error.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,35 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;  David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(in-package "ACL2")
+
+(include-book "std/io/read-file-characters" :dir :system)
+(include-book "cutil/define" :dir :system)
+
+(define read-file-characters-no-error ((filename stringp)
+                                      (state state-p))
+  :returns (mv (characters character-listp :hyp :fguard)
+               (state state-p :hyp :fguard))
+  (mv-let (data state)
+    (read-file-characters filename state)
+    (mv (if (stringp data)
+            (prog2$ (er hard? 'read-file-characters-no-error
+                        data)
+                    nil)
+          data)
+        state)))
diff -Nru acl2-6.2/books/parsers/earley/read-line.lisp acl2-6.3/books/parsers/earley/read-line.lisp
--- acl2-6.2/books/parsers/earley/read-line.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/read-line.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,216 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;  David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(in-package "ACL2")
+
+(include-book "std/io/base" :dir :system)
+(include-book "cutil/define" :dir :system)
+
+; These used to go through but aren't anymore.  We don't need them now, so I'm
+; commenting them out.
+
+;; (defun read-line$1 (line channel state)
+;;   (declare (xargs :guard (and (symbolp channel)
+;;                               (open-input-channel-p channel
+;;                                                     :character state)
+;;                               (character-listp line))
+;;                   :stobjs (state)
+;;                   :measure (file-measure channel state)))
+;;   (b* (((unless (mbt (state-p state)))
+;;         (mv nil state))
+;;        ((mv char state)
+;;         (read-char$ channel state))
+;;        ((unless char)
+;;         (let ((line (reverse (coerce line 'string))))
+;;           (mv line state)))
+
+;;        ((when (eql char #\Newline))
+;;         (let ((line (reverse (coerce line 'string))))
+;;           (mv line state)))
+
+;;        (line (cons char line)))
+;;     (read-line$1 line channel state)))
+
+;; (defthm stringp-of-read-line$1
+;;   (implies (and (symbolp channel)
+;;                 (open-input-channel-p channel :character state)
+;;                 (state-p state))
+;;            (stringp (mv-nth 0 (read-line$1 line channel state)))))
+
+;; (defun read-line$ (channel state)
+;;   (declare (xargs :guard (and (symbolp channel)
+;;                               (open-input-channel-p channel
+;;                                                     :character state))
+;;                   :stobjs (state)
+;;                   :measure (file-measure channel state)))
+;;   (read-line$1 nil channel state))
+
+;; (defthm stringp-of-read-line$
+;;   (implies (and (symbolp channel)
+;;                 (open-input-channel-p channel
+;;                                       :character state)
+;;                 (state-p state))
+;;            (stringp (mv-nth 0 (read-line$ channel state)))))
+
+;; I leave the following definition of an example of how formal methods helped
+;; us catch the bug that if the car of file-input is newline, that we should
+;; return (cdr file-input), not just file-input.
+
+;;; (define read-line!1 ((file-input character-listp))
+;;;   :returns (mv (line character-listp
+;;;                      "The characters from the next line of the file input"
+;;;                      :hyp :fguard)
+;;;                (new-file-input character-listp "The rest of the file input"
+;;;                :hyp :fguard))
+;;;   (cond ((or (atom file-input)
+;;;              (equal (car file-input) #\Newline))
+;;;          (mv nil file-input))
+;;;         (t (mv-let (recursive-chars remainder-of-file-input)
+;;;              (read-line!1 (cdr file-input))
+;;;              (mv (cons (car file-input)
+;;;                        recursive-chars)
+;;;                  remainder-of-file-input)))))
+
+(define read-line!1 ((file-input character-listp))
+  :returns (mv (line character-listp
+                     "The characters from the next line of the file input"
+                     :hyp :fguard)
+               (new-file-input character-listp "The rest of the file input"
+                               :hyp :fguard))
+  (cond ((atom file-input)
+         (mv nil file-input))
+        ((equal (car file-input) #\Newline)
+         ;; read-line!1 has no characters to return
+         (mv nil (cdr file-input)))
+        (t (mv-let (recursive-chars remainder-of-file-input)
+             (read-line!1 (cdr file-input))
+             (mv (cons (car file-input)
+                       recursive-chars)
+                 remainder-of-file-input))))
+  ///
+
+  (defthm read-line!1-weak
+    (<= (acl2-count (mv-nth 1 (read-line!1 file-input)))
+        (acl2-count file-input))
+    :rule-classes :linear)
+
+
+  (local
+   (defthm read-line!1-strong-lemma
+     (implies (and (consp file-input)
+                   (not (mv-nth 0 (read-line!1 (cdr file-input))))
+                   (characterp (car file-input))
+                   (character-listp (cdr file-input))
+                   (not (equal (car file-input) #\newline))
+                   (list (car file-input)))
+              (< (acl2-count (mv-nth 1 (read-line!1 (cdr file-input))))
+                 (acl2-count file-input)))
+     :rule-classes (:rewrite :linear)))
+  (local
+   (defun recur-on-cdr-only (x)
+     (if (atom x)
+         nil
+       (cons 1
+             (recur-on-cdr-only (cdr x))))))
+
+  (defthm read-line!1-strong
+    (implies (mv-nth 0 (read-line!1 file-input))
+             (< (acl2-count (mv-nth 1 (read-line!1 file-input)))
+                (acl2-count file-input)))
+    :hints (("Goal" :induct (recur-on-cdr-only file-input)))
+    :rule-classes :linear))
+
+;; (local
+;;  (defthm lemma
+;;    (implies (and (consp file-input)
+;;                  (not (character-listp (car file-input)))
+;;                  (not (mv-nth 0 (read-line!1 (cdr file-input))))
+;;                  (characterp (car file-input))
+;;                  (character-listp (cdr file-input))
+;;                  (not (equal (car file-input) #\newline))
+;;                  (list (car file-input)))
+;;             (< (acl2-count (mv-nth 1 (read-line!1 (cdr file-input))))
+;;                (+ 1 (acl2-count (car file-input))
+;;                   (acl2-count (cdr file-input)))))))
+
+;; (local
+;;  (defthm lemmmaa
+;;    (implies
+;;     (and (consp file-input)
+;;          (implies (and (character-listp (car file-input))
+;;                        (mv-nth 0 (read-line!1 (car file-input))))
+;;                   (< (acl2-count (mv-nth 1 (read-line!1 (car file-input))))
+;;                      (acl2-count (car file-input))))
+;;          (implies (and (character-listp (cdr file-input))
+;;                        (mv-nth 0 (read-line!1 (cdr file-input))))
+;;                   (< (acl2-count (mv-nth 1 (read-line!1 (cdr file-input))))
+;;                      (acl2-count (cdr file-input)))))
+;;     (implies (and (character-listp file-input)
+;;                   (mv-nth 0 (read-line!1 file-input)))
+;;              (< (acl2-count (mv-nth 1 (read-line!1 file-input)))
+;;                 (acl2-count file-input))))))
+
+;; (local
+;;  (defthm read-line!1-strong-lemma
+;;    (implies (and (consp file-input)
+;;                  (not (mv-nth 0 (read-line!1 (cdr file-input))))
+;;                  (characterp (car file-input))
+;;                  (character-listp (cdr file-input))
+;;                  (not (equal (car file-input) #\newline))
+;;                  (list (car file-input)))
+;;             (<= (acl2-count (mv-nth 1 (read-line!1 (cdr file-input))))
+;;                 (acl2-count file-input)))
+;;    :rule-classes (:rewrite :linear)))
+
+
+(define read-line! ((file-input character-listp))
+; consider renaming to read-line-as-char-list
+  :returns (mv (line stringp "The string read from the next line of the file input"
+                     :hyp :fguard)
+               (new-file-input character-listp "The rest of the file input"
+                               :hyp :fguard))
+  (mv-let (chars new-file-input)
+    (read-line!1 file-input)
+    (mv (coerce chars 'string)
+        new-file-input))
+  ///
+
+  (defthm read-line!-weak
+    (<= (acl2-count (mv-nth 1 (read-line! file-input)))
+        (acl2-count file-input)))
+
+  (defthm read-line!-strong-but-with-an-inner-hyp
+    (implies (mv-nth 0 (read-line!1 file-input))
+             (< (acl2-count (mv-nth 1 (read-line! file-input)))
+                (acl2-count file-input))))
+
+  (defthm read-line!-strong
+
+; This is a silly lemma, as read-line!-strong-alternative is probably more
+; meaningful.  But, I'm leaving it for now and can clean it up later.
+
+    (implies (< 0 (length (mv-nth 0 (read-line! file-input))))
+             (< (acl2-count (mv-nth 1 (read-line! file-input)))
+                (acl2-count file-input)))
+    :hints (("Goal" :use ((:instance read-line!-strong-but-with-an-inner-hyp)))))
+
+  (defthm read-line!-strong-alternative
+    (implies (not (equal (mv-nth 0 (read-line! file-input)) ""))
+             (< (acl2-count (mv-nth 1 (read-line! file-input)))
+                (acl2-count file-input)))
+    :hints (("Goal" :use ((:instance read-line!-strong-but-with-an-inner-hyp))))))
diff -Nru acl2-6.2/books/parsers/earley/strings.lisp acl2-6.3/books/parsers/earley/strings.lisp
--- acl2-6.2/books/parsers/earley/strings.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/strings.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,106 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;  David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(in-package "ACL2")
+
+(include-book "cutil/define" :dir :system)
+(include-book "tools/mv-nth" :dir :system)
+
+(define str-trim-left2 ((char-bag character-listp)
+                        (str-chars character-listp))
+
+  :returns (mv (done booleanp :hyp :fguard) 
+               (thechars character-listp :hyp :fguard))
+  :parents (earley-parser)
+
+  (cond ((atom char-bag)
+         (mv t str-chars)) ; t is for "done"
+        ((equal (car char-bag)
+                (car str-chars))
+         (mv nil (cdr str-chars)))
+        (t 
+         (str-trim-left2 (cdr char-bag) str-chars))))
+
+(local 
+ (defthm str-trim-left2-makes-progress
+   (implies (and (character-listp char-bag)
+                 (character-listp str-chars)
+                 (null (mv-nth 0 (str-trim-left2 char-bag str-chars))))
+            (< (acl2-count (mv-nth 1 (str-trim-left2 char-bag str-chars)))
+               (acl2-count str-chars)))
+   :hints (("Goal" :in-theory (enable str-trim-left2)))))
+
+(define str-trim-left1 ((char-bag character-listp)
+                        (str-chars character-listp))
+  :returns (ans character-listp :hyp :fguard)
+  :parents (earley-parser)
+  (b* (((when (or (not (character-listp char-bag))
+                  (not (character-listp str-chars))))
+        (prog2$ (er hard 'str-trim-left1 
+                    ;; By using hard and verified guards, we are guaranteed
+                    ;; that we never enter this branch.
+                    "Two arguments to str-trim-left1 were not character-listp")
+                str-chars))
+       ((mv done str-chars)
+        (str-trim-left2 char-bag str-chars)))
+    (cond (done str-chars)
+          (t (str-trim-left1 char-bag str-chars)))))
+
+(define str-trim-left ((char-bag character-listp)
+                       (str stringp))
+  :returns (ans stringp :hyp :fguard)
+  :parents (earley-parser)
+  (coerce (str-trim-left1 char-bag (coerce str 'list)) 'string))
+
+(local
+ (defthm rev-returns-character-listp
+   (implies (character-listp chars)
+            (character-listp (reverse chars)))))
+
+(define str-trim-right1 ((char-list character-listp)
+                         (str-chars character-listp))
+  :returns (ans character-listp :hyp :fguard)
+  :parents (earley-parser)
+  (reverse (str-trim-left1 char-list (reverse str-chars))))
+
+(define str-trim-right ((char-bag character-listp)
+                        (str stringp))
+  :returns (ans stringp :hyp :fguard)
+  :parents (earley-parser)
+  (coerce (str-trim-right1 char-bag (coerce str 'list)) 'string))
+
+(define str-trim ((char-bag character-listp "Bag of characters to trim from str")
+                  (str stringp "String to trim"))
+  :returns (ans stringp "Result of trimming the given characters from the ~
+                         front and back of the given string")
+  :parents (earley-parser)
+  (str-trim-right char-bag (str-trim-left char-bag str)))
+
+(define string-fix (x)
+  :returns (ans stringp "String version of the input")
+  (cond ((stringp x)
+         x)
+        (t "")))
+
+(define string-fix-with-error (x)
+  :returns (ans stringp "String version of the input")
+  (cond ((stringp x)
+         x)
+        (t (prog2$ (er hard? 'string-fix-with-error
+                       "Input wasn't a string but: ~x0" x)
+                       ""))))
diff -Nru acl2-6.2/books/parsers/earley/tokenizer.lisp acl2-6.3/books/parsers/earley/tokenizer.lisp
--- acl2-6.2/books/parsers/earley/tokenizer.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/parsers/earley/tokenizer.lisp	2013-09-30 17:53:19.000000000 +0000
@@ -0,0 +1,89 @@
+; ACL2 Parser for Java
+; Copyright (C) 2013 Battelle Memorial Institute
+;
+; Contact:
+;  David Rager, ragerdl@cs.utexas.edu
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: David Rager <ragerdl@cs.utexas.edu>
+
+(in-package "ACL2")
+
+(include-book "str/top" :dir :system)
+(include-book "cutil/define" :dir :system)
+
+(defconst *token-separators*
+  '(#\+ #\- #\* #\/ #\{ #\} #\( #\) #\[ #\] #\; #\,
+
+
+    ;; The inclusion of a period means that we are disabling our ability to
+    ;; parse floating point numbers for now.
+    
+    #\.
+
+
+    ))
+
+(defconst *whitespace* 
+  '(#\Space #\Newline))
+
+
+(define tokenize-string2 ((input character-listp)
+                          (curr-chars character-listp)
+                          (acc string-listp))
+
+; At some point I'll need to add the ability to recognize decimal numbers.
+; This won't be too bad, as I'll be able to look-ahead by looking at the input
+; and look-behind by looking at the curr-chars.
+
+  :returns (tokenized-string string-listp :hyp :fguard)
+  (cond ((atom input)
+         (if (atom curr-chars)
+             acc
+           (cons (coerce (rev curr-chars) 'string)
+                 acc)))
+        ((member (car input)
+                 *whitespace*)
+         (tokenize-string2 (cdr input)
+                           nil
+                           (if curr-chars
+                               (cons (coerce (rev curr-chars) 'string)
+                                     acc)
+                             acc)))
+        ((member (car input)
+                 *token-separators*)
+         (tokenize-string2 (cdr input)
+                           nil
+                           (if curr-chars
+                               (cons (coerce (list (car input)) 'string)
+                                     (cons (coerce (rev curr-chars) 'string)
+                                           acc))
+                             (cons (coerce (list (car input)) 'string)
+                                   acc))))
+        (t (tokenize-string2 (cdr input)
+                             (cons (car input) curr-chars)
+                             acc))))
+              
+(define tokenize-string1 ((input stringp))
+  :returns (result string-listp :hyp :fguard)
+
+  (rev (tokenize-string2 (coerce input 'list) 
+                         nil
+                         nil))
+  :prepwork
+  ((defthm lemma
+     (implies (string-listp x)
+              (string-listp (rev x))))))
+
+(define tokenize-string ((input stringp))
+  :returns (result stringp :hyp :fguard)
+  (str::join (tokenize-string1 input) " "))
diff -Nru acl2-6.2/books/regex/portcullis.acl2 acl2-6.3/books/regex/portcullis.acl2
--- acl2-6.2/books/regex/portcullis.acl2	2013-06-06 17:12:00.000000000 +0000
+++ acl2-6.3/books/regex/portcullis.acl2	2013-09-30 17:53:29.000000000 +0000
@@ -1,11 +1,11 @@
 (in-package "ACL2")
 
-(ld "cutil/package.lsp" :dir :system)
+(include-book "cutil/portcullis" :dir :system)
 (ld "tools/flag-package.lsp" :dir :system)
 
 ; We need the following for provisional certification, so that ACL2
 ; can read symbols xdoc::SYM in term-patterns.acl2x at the start of
 ; the Pcertify step for input-list.pcert.
-(include-book "xdoc/top" :dir :system)
+(include-book "xdoc/portcullis" :dir :system)
 
 (certify-book "portcullis" ? t)
diff -Nru acl2-6.2/books/regex/regex-defs.lisp acl2-6.3/books/regex/regex-defs.lisp
--- acl2-6.2/books/regex/regex-defs.lisp	2013-06-06 17:12:00.000000000 +0000
+++ acl2-6.3/books/regex/regex-defs.lisp	2013-09-30 17:53:29.000000000 +0000
@@ -1,6 +1,6 @@
 
 (in-package "ACL2")
-
+(include-book "xdoc/top" :dir :system)
 ;; (local (include-book "defsum-thms"))
 ;; (include-book "defsum")
 (include-book "tools/defsum" :dir :system)
diff -Nru acl2-6.2/books/regression-centaur-targets acl2-6.3/books/regression-centaur-targets
--- acl2-6.2/books/regression-centaur-targets	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/regression-centaur-targets	1970-01-01 00:00:00.000000000 +0000
@@ -1,83 +0,0 @@
-# This file used by the "centaur" target in Makefile, which is
-# intended for ACL2, not ACL2(h).
-
-# Keep this in sync with centaur/doc.lisp.
-
-./centaur/vl/top.cert
-./centaur/vl/lint/lint.cert
-./centaur/vl/mlib/clean-concats.cert
-./centaur/vl/mlib/atts.cert
-./centaur/vl/transforms/xf-clean-selects.cert
-./centaur/vl/transforms/xf-propagate.cert
-./centaur/vl/transforms/xf-expr-simp.cert
-./centaur/vl/transforms/xf-inline.cert
-./centaur/aig/aiger.cert
-./centaur/aig/aig-equivs.cert
-./centaur/aig/aig-vars.cert
-# Omit the following, which seems to require ACL2(h):
-# ./centaur/aig/aig-vars-fast.cert
-./centaur/aig/base.cert
-./centaur/aig/bddify.cert
-./centaur/aig/bddify-correct.cert
-./centaur/aig/eval-restrict.cert
-./centaur/aig/g-aig-eval.cert
-./centaur/aig/induction.cert
-./centaur/aig/misc.cert
-./centaur/aig/three-four.cert
-./centaur/aig/witness.cert
-./centaur/aig/vuaig.cert
-./centaur/ubdds/lite.cert
-./centaur/ubdds/param.cert
-./centaur/bitops/top.cert
-./centaur/clex/example.cert
-./centaur/gl/gl.cert
-./centaur/gl/bfr-aig-bddify.cert
-./centaur/4v-sexpr/top.cert
-./centaur/esim/stv/stv-top.cert
-./centaur/esim/stv/stv-debug.cert
-./centaur/esim/esim-sexpr-correct.cert
-./centaur/../xdoc-impl/save.cert
-./centaur/../xdoc/defxdoc-raw.cert
-./centaur/../xdoc-impl/mkdir-raw.cert
-./centaur/../xdoc-impl/topics.cert
-./centaur/../xdoc-impl/extra-packages.cert
-./centaur/misc/hons-remove-dups.cert
-./centaur/misc/seed-random.cert
-./centaur/misc/equal-by-nths.cert
-./centaur/misc/load-stobj.cert
-./centaur/misc/load-stobj-tests.cert
-
-# We omit some of centaur/tutorial/ for vanilla ACL2, but we may
-# include some books that support it.
-# ./centaur/tutorial/
-./centaur/tutorial/intro.cert
-
-./centaur/bridge/top.cert
-./centaur/defrstobj/defrstobj.cert
-./centaur/misc/smm.cert
-./centaur/bitops/install-bit.cert
-./centaur/bitops/rotate.cert
-./centaur/misc/tailrec.cert
-./centaur/vl/mlib/sub-counts.cert
-./centaur/vl/util/prefix-hash.cert
-./regex/regex-ui.cert
-./centaur/bitops/congruences.cert
-./centaur/defrstobj/basic-tests.cert
-./cutil/deflist-tests.cert
-./cutil/defalist-tests.cert
-./cutil/defmapappend-tests.cert
-./cutil/defprojection-tests.cert
-./centaur/bitops/sign-extend.cert
-./centaur/defrstobj/groundwork/demo1.cert
-./centaur/defrstobj/groundwork/demo2.cert
-./centaur/defrstobj/groundwork/demo3.cert
-./centaur/defrstobj/groundwork/demo4.cert
-./centaur/defrstobj/groundwork/demo5.cert
-./centaur/misc/top.cert
-./centaur/ubdds/sanity-check-macros.cert
-./centaur/vl/checkers/use-set-tool.cert
-./centaur/vl/lint/xf-drop-unresolved-submodules.cert
-./centaur/vl/mlib/lvalues-mentioning.cert
-./centaur/vl/mlib/rvalues.cert
-./centaur/vl/util/prefixp.cert
-./centaur/gl/bfr-satlink
diff -Nru acl2-6.2/books/regression-hons-targets acl2-6.3/books/regression-hons-targets
--- acl2-6.2/books/regression-hons-targets	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/regression-hons-targets	1970-01-01 00:00:00.000000000 +0000
@@ -1,76 +0,0 @@
-# This file is a list of certificate files generated by the ACL2
-# regression.  It is patterned after regression-targets, but was
-# created by running the following in the current (books/) directory
-# after making the taspi/ books, e.g. using
-#   (time nice make -j 8 ACL2=acl2c)
-# and then adding the centaur/doc book at the top below.
-
-# find ./taspi -name '*.cert'
-
-./centaur/doc.cert
-./taspi/code/brlens/brlens.cert
-./taspi/code/brlens/trees-with-brlens.cert
-./taspi/code/build/build-term.cert
-./taspi/code/build/build-term-guards.cert
-./taspi/code/fringes/fringes.cert
-./taspi/code/fringes/fringes-guards.cert
-./taspi/code/fringes/fringes-props.cert
-./taspi/code/gen-helper/extra.cert
-./taspi/code/gen-helper/sets.cert
-./taspi/code/gen-helper/fast-lists.cert
-./taspi/code/gen-helper/bdd-functions.cert
-./taspi/code/gen-helper/top.cert
-./taspi/code/gen-trees/btrees.cert
-./taspi/code/gen-trees/btrees-bdds.cert
-./taspi/code/gen-trees/tree-predicates.cert
-./taspi/code/gen-trees/sets-lists-trees.cert
-./taspi/code/gen-trees/btrees-bdds-sets.cert
-./taspi/code/gen-trees/app-rev-lists.cert
-./taspi/code/gen-trees/top.cert
-./taspi/code/replete/replete-helper.cert
-./taspi/code/replete/replete.cert
-./taspi/code/replete/replete-guards.cert
-./taspi/code/sequences/seqs.cert
-./taspi/code/sequences/p-inform.cert
-./taspi/code/sequences/align.cert
-./taspi/code/tree-manip/quicksort.cert
-./taspi/code/tree-manip/sort-help.cert
-./taspi/code/tree-manip/insertion-based-sort.cert
-./taspi/code/tree-manip/merge-based-sort.cert
-./taspi/code/tree-manip/mv-root.cert
-./taspi/code/tree-manip/top.cert
-./taspi/database/props.cert
-./taspi/database/entry.cert
-./taspi/database/db.cert
-./taspi/database/filters.cert
-./taspi/database/db-from-list.cert
-./taspi/proofs/sets.cert
-./taspi/proofs/omerge-good-order.cert
-./taspi/proofs/fringes-taspi.cert
-./taspi/sets-input/consensus.cert
-./taspi/sets-input/tree-compat.cert
-./taspi/sets-input/tree-support-in-set.cert
-./taspi/sets-input/mast.cert
-./taspi/sets-input/multipolar-loose.cert
-./taspi/sets-input/greedy.cert
-./taspi/sets-input/mct.cert
-./taspi/sets-input/top.cert
-./taspi/single-input/taxa-based.cert
-./taspi/single-input/tree-stats.cert
-./taspi/tree-distance/rf.cert
-./taspi/tree-distance/symm-diff.cert
-./taspi/tree-generation/branch-and-bound/bandb.cert
-./taspi/tree-generation/distance-based/naive-quartet-method.cert
-./taspi/tree-generation/heuristics/spr.cert
-./taspi/tree-generation/heuristics/tbr.cert
-./taspi/tree-generation/heuristics/do-search.cert
-./taspi/tree-generation/tree-gen-helper/basics.cert
-./taspi/tree-score/costs.cert
-./taspi/tree-score/pscores.cert
-./taspi/tree-score/fitch-scoring.cert
-./taspi/tree-score/efficient-pscores-help.cert
-./taspi/tree-score/efficient-pscores.cert
-./taspi/tree-score/min-length.cert
-./taspi/tree-score/ambig-score.cert
-./taspi/tree-score/circle-scoring.cert
-./taspi/tree-score/opt-pairwise.cert
diff -Nru acl2-6.2/books/regression-targets acl2-6.3/books/regression-targets
--- acl2-6.2/books/regression-targets	2013-06-06 17:12:02.000000000 +0000
+++ acl2-6.3/books/regression-targets	1970-01-01 00:00:00.000000000 +0000
@@ -1,2808 +0,0 @@
-# This file is a list of certificate files generated by the ACL2
-# regression; it was created by running:
-# make clean
-# make all-plus (or, in the parent directory, make regression)
-# find . -name '*.cert' | sort
-
-# This file is intended for ordinary ACL2 regressions.  For ACL2(h)
-# regressions, consider uncommenting the lines below with comments
-# that say "hons only".
-
-# To update this file, run the process above and then compare to
-# its existing contents.
-
-# This file provides the list of targets to be built by cert.pl, a
-# build system for ACL2 books.  Cert.pl requires a list of targets to
-# be built; it generates the dependencies for these targets and,
-# recursively, any other books they depend on.  So this list of files
-# could be pruned, potentially, to only the "top level" books in each
-# library.  To allow new libraries to be built with cert.pl using this
-# list, only the top-level books of these libraries need to be added.
-
-# In order to make this work with cert.pl, we have commented out
-# certain lines corresponding to files whose dependencies couldn't be
-# correctly determined (i.e., their certification failed when we
-# attempted one of the commands below.) Also, any directory containing
-# a file named cert_pl_exclude is excluded even if targets within that
-# directory are listed here.  Some notes on the excluded files and
-# directories are below.
-
-# To certify the books listed here cert.pl, you can run:
-
-# ./cert.pl -j <number of processes>       \
-#           --targets regression-targets   \
-#           --acl2 <acl2 executable>
-
-# To do this without stopping on errors, you can pass the --keep-going
-# argument to make by adding "--make-args --keep-going" to the above
-# command line.
-
-
-# To create a static stand-alone makefile (usable in systems without
-# Perl) for these targets, you can run the following, where the -acl2
-# argument is optional:
-
-# ./cert.pl -s <makefile-name>             \
-#           --targets regression-targets   \
-#           -b .
-#           --acl2 <acl2 executable>
-
-# or to create a static makefile that only contains dependency
-# information and omits everything else, e.g. the rule for making a
-# cert file, run:
-
-# ./cert.pl -s <makefile-name>             \
-#           --targets regression-targets   \
-#           --no-boilerplate
-
-# The file created by this command contains a list of the certificate
-# files to be created (stored in variable CERT_PL_CERTS) and their
-# dependencies.  This is suitable for inclusion in some other makefile
-# that includes the necessary rules and perhaps additional targets.
-# (Usually cert.pl creates a makefile that includes the file
-# make_cert, which provides a rule to make cert files, and defines the
-# "all" target as the entire list of certificates.)  If the additional
-# option --collect-sources is provided, the list of all source files
-# necessary for making the certificates is stored in variable
-# CERT_PL_SOURCES.
-
-
-
-# Excluded files:
-#    Benchmarks.lisp is a generated file, but the rest of the BDD
-#    library works without any problems:
-# ./bdd/benchmarks.cert
-
-# Excluded directories:
-# fix-cert:
-#    Uses a custom makefile that moves some certificates around, among
-#    other things.
-
-#    The following directories are all excluded because they require
-#    generated .lisp files:
-# workshops/1999/multiplier,
-# workshops/2003/greve-wilding-vanfleet/support
-# workshops/2003/kaufmann/support/input
-# workshops/2003/kaufmann/support/rtl
-
-#    There's nothing really terrible in this directory, but it seems
-#    that the equal sign in the name confuses make.
-# workshops/2009/cowles-gamboa-triangle-square/triangle=square-materials
-
-# NOTE: The following need to be omitted if they are generated below.
-# (In general, these will only be generated under the UT development
-# directory.)
-
-# arithmetic-4/ (and all its subdirectories)
-# clause-processors/SULFA/ (and all its subdirectories)
-# models/jvm/m5/apprentice.cert
-# nonstd/ (and all its subdirectories)
-# rtl/rel7/  (and all its subdirectories)
-
-##############################
-### Everything below is generated, except initial comment characters
-### (# ) have been inserted at beginnings of lines according to the list
-### of excluded files and directories, above.
-##############################
-
-./arithmetic-2/floor-mod/floor-mod.cert
-./arithmetic-2/floor-mod/floor-mod-helper.cert
-./arithmetic-2/meta/cancel-terms-helper.cert
-./arithmetic-2/meta/cancel-terms-meta.cert
-./arithmetic-2/meta/collect-terms-meta.cert
-./arithmetic-2/meta/common-meta.cert
-./arithmetic-2/meta/expt.cert
-./arithmetic-2/meta/expt-helper.cert
-./arithmetic-2/meta/integerp.cert
-./arithmetic-2/meta/integerp-meta.cert
-./arithmetic-2/meta/mini-theories.cert
-./arithmetic-2/meta/non-linear.cert
-./arithmetic-2/meta/numerator-and-denominator.cert
-./arithmetic-2/meta/post.cert
-./arithmetic-2/meta/pre.cert
-./arithmetic-2/meta/top.cert
-./arithmetic-2/pass1/basic-arithmetic.cert
-./arithmetic-2/pass1/basic-arithmetic-helper.cert
-./arithmetic-2/pass1/expt.cert
-./arithmetic-2/pass1/expt-helper.cert
-./arithmetic-2/pass1/inequalities.cert
-./arithmetic-2/pass1/mini-theories.cert
-./arithmetic-2/pass1/numerator-and-denominator.cert
-./arithmetic-2/pass1/numerator-and-denominator-helper.cert
-./arithmetic-2/pass1/prefer-times.cert
-./arithmetic-2/pass1/top.cert
-./arithmetic-3/bind-free/arithmetic-theory.cert
-./arithmetic-3/bind-free/banner.cert
-./arithmetic-3/bind-free/basic.cert
-./arithmetic-3/bind-free/basic-helper.cert
-./arithmetic-3/bind-free/building-blocks.cert
-./arithmetic-3/bind-free/collect.cert
-./arithmetic-3/bind-free/common.cert
-./arithmetic-3/bind-free/default-hint.cert
-./arithmetic-3/bind-free/integerp.cert
-./arithmetic-3/bind-free/integerp-meta.cert
-./arithmetic-3/bind-free/mini-theories.cert
-./arithmetic-3/bind-free/mini-theories-helper.cert
-./arithmetic-3/bind-free/normalize.cert
-./arithmetic-3/bind-free/numerator-and-denominator.cert
-./arithmetic-3/bind-free/remove-weak-inequalities.cert
-./arithmetic-3/bind-free/simplify.cert
-./arithmetic-3/bind-free/simplify-helper.cert
-./arithmetic-3/bind-free/top.cert
-./arithmetic-3/extra/ext.cert
-./arithmetic-3/extra/top-ext.cert
-./arithmetic-3/floor-mod/floor-mod.cert
-./arithmetic-3/floor-mod/mod-expt-fast.cert
-./arithmetic-3/pass1/basic-arithmetic.cert
-./arithmetic-3/pass1/basic-arithmetic-helper.cert
-./arithmetic-3/pass1/expt.cert
-./arithmetic-3/pass1/expt-helper.cert
-./arithmetic-3/pass1/inequalities.cert
-./arithmetic-3/pass1/mini-theories.cert
-./arithmetic-3/pass1/non-linear.cert
-./arithmetic-3/pass1/num-and-denom-helper.cert
-./arithmetic-3/pass1/numerator-and-denominator.cert
-./arithmetic-3/pass1/prefer-times.cert
-./arithmetic-3/pass1/top.cert
-./arithmetic-3/top.cert
-./arithmetic-5/lib/basic-ops/arithmetic-theory.cert
-./arithmetic-5/lib/basic-ops/banner.cert
-./arithmetic-5/lib/basic-ops/basic.cert
-./arithmetic-5/lib/basic-ops/building-blocks.cert
-./arithmetic-5/lib/basic-ops/building-blocks-helper.cert
-./arithmetic-5/lib/basic-ops/collect.cert
-./arithmetic-5/lib/basic-ops/common.cert
-./arithmetic-5/lib/basic-ops/default-hint.cert
-./arithmetic-5/lib/basic-ops/distributivity.cert
-./arithmetic-5/lib/basic-ops/dynamic-e-d.cert
-./arithmetic-5/lib/basic-ops/elim-hint.cert
-./arithmetic-5/lib/basic-ops/expt.cert
-./arithmetic-5/lib/basic-ops/expt-helper.cert
-./arithmetic-5/lib/basic-ops/forcing-types.cert
-./arithmetic-5/lib/basic-ops/if-normalization.cert
-./arithmetic-5/lib/basic-ops/integerp.cert
-./arithmetic-5/lib/basic-ops/integerp-helper.cert
-./arithmetic-5/lib/basic-ops/integerp-meta.cert
-./arithmetic-5/lib/basic-ops/mini-theories.cert
-./arithmetic-5/lib/basic-ops/natp-posp.cert
-./arithmetic-5/lib/basic-ops/normalize.cert
-./arithmetic-5/lib/basic-ops/numerator-and-denominator.cert
-./arithmetic-5/lib/basic-ops/remove-weak-inequalities.cert
-./arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities.cert
-./arithmetic-5/lib/basic-ops/simple-equalities-and-inequalities-helper.cert
-./arithmetic-5/lib/basic-ops/simplify.cert
-./arithmetic-5/lib/basic-ops/simplify-helper.cert
-./arithmetic-5/lib/basic-ops/top.cert
-./arithmetic-5/lib/basic-ops/types.cert
-./arithmetic-5/lib/basic-ops/types-helper.cert
-./arithmetic-5/lib/basic-ops/we-are-here.cert
-./arithmetic-5/lib/floor-mod/floor-mod-basic.cert
-./arithmetic-5/lib/floor-mod/floor-mod-basic-helper.cert
-./arithmetic-5/lib/floor-mod/floor-mod.cert
-./arithmetic-5/lib/floor-mod/floor-mod-helper.cert
-./arithmetic-5/lib/floor-mod/forcing-types.cert
-./arithmetic-5/lib/floor-mod/if-normalization.cert
-./arithmetic-5/lib/floor-mod/logand.cert
-./arithmetic-5/lib/floor-mod/logand-helper.cert
-./arithmetic-5/lib/floor-mod/mod-expt-fast.cert
-./arithmetic-5/lib/floor-mod/more-floor-mod.cert
-./arithmetic-5/lib/floor-mod/top.cert
-./arithmetic-5/lib/floor-mod/truncate-rem.cert
-./arithmetic-5/support/basic-arithmetic.cert
-./arithmetic-5/support/basic-arithmetic-helper.cert
-./arithmetic-5/support/expt.cert
-./arithmetic-5/support/expt-helper.cert
-./arithmetic-5/support/inequalities.cert
-./arithmetic-5/support/mini-theories.cert
-./arithmetic-5/support/non-linear.cert
-./arithmetic-5/support/num-and-denom-helper.cert
-./arithmetic-5/support/numerator-and-denominator.cert
-./arithmetic-5/support/prefer-times.cert
-./arithmetic-5/support/top.cert
-./arithmetic-5/top.cert
-./arithmetic/abs.cert
-./arithmetic/binomial.cert
-./arithmetic/equalities.cert
-./arithmetic/factorial.cert
-./arithmetic/idiv.cert
-./arithmetic/inequalities.cert
-./arithmetic/mod-gcd.cert
-./arithmetic/nat-listp.cert
-./arithmetic/natp-posp.cert
-./arithmetic/rational-listp.cert
-./arithmetic/rationals.cert
-./arithmetic/sumlist.cert
-./arithmetic/top.cert
-./arithmetic/top-with-meta.cert
-./bdd/alu.cert
-./bdd/alu-proofs.cert
-./bdd/bdd-primitives.cert
-# ./bdd/benchmarks.cert
-./bdd/bool-ops.cert
-./bdd/cbf.cert
-./bdd/hamming.cert
-./bdd/pg-theory.cert
-# For centaur/ use targets from regression-centaur-targets:
-./centaur/vl/top.cert
-./centaur/vl/lint/lint.cert
-./centaur/vl/mlib/clean-concats.cert
-./centaur/vl/mlib/atts.cert
-./centaur/vl/transforms/xf-clean-selects.cert
-./centaur/vl/transforms/xf-propagate.cert
-./centaur/vl/transforms/xf-expr-simp.cert
-./centaur/vl/transforms/xf-inline.cert
-./centaur/aig/aiger.cert
-./centaur/aig/aig-equivs.cert
-./centaur/aig/aig-vars.cert
-# ./centaur/aig/aig-vars-fast.cert (probably hons only)
-./centaur/aig/base.cert
-./centaur/aig/bddify.cert
-./centaur/aig/bddify-correct.cert
-./centaur/aig/eval-restrict.cert
-./centaur/aig/g-aig-eval.cert
-./centaur/aig/induction.cert
-./centaur/aig/misc.cert
-./centaur/aig/three-four.cert
-./centaur/aig/witness.cert
-./centaur/aig/vuaig.cert
-./centaur/ubdds/lite.cert
-./centaur/ubdds/param.cert
-./centaur/bitops/top.cert
-./centaur/gl/gl.cert
-./centaur/gl/bfr-aig-bddify.cert
-./centaur/4v-sexpr/top.cert
-./centaur/esim/stv/stv-top.cert
-./centaur/esim/stv/stv-debug.cert
-./centaur/esim/esim-sexpr-correct.cert
-./centaur/../xdoc-impl/save.cert
-./centaur/../xdoc/defxdoc-raw.cert
-./centaur/../xdoc-impl/mkdir-raw.cert
-./centaur/../xdoc-impl/topics.cert
-./centaur/../xdoc-impl/extra-packages.cert
-./centaur/misc/hons-remove-dups.cert
-./centaur/misc/seed-random.cert
-./centaur/misc/equal-by-nths.cert
-./centaur/misc/load-stobj.cert
-./centaur/misc/load-stobj-tests.cert
-# ./centaur/tutorial/ (hons only)
-./centaur/bridge/top.cert
-./centaur/defrstobj/defrstobj.cert
-./centaur/misc/smm.cert
-./centaur/bitops/install-bit.cert
-./centaur/bitops/rotate.cert
-./centaur/misc/tailrec.cert
-./centaur/vl/mlib/sub-counts.cert
-./centaur/vl/util/prefix-hash.cert
-./centaur/bitops/congruences.cert
-./centaur/defrstobj/basic-tests.cert
-./cutil/deflist-tests.cert
-./cutil/defalist-tests.cert
-./cutil/defmapappend-tests.cert
-./cutil/defprojection-tests.cert
-./centaur/bitops/sign-extend.cert
-./centaur/defrstobj/groundwork/demo1.cert
-./centaur/defrstobj/groundwork/demo2.cert
-./centaur/defrstobj/groundwork/demo3.cert
-./centaur/defrstobj/groundwork/demo4.cert
-./centaur/defrstobj/groundwork/demo5.cert
-./centaur/misc/top.cert
-./centaur/ubdds/sanity-check-macros.cert
-./centaur/vl/checkers/use-set-tool.cert
-./centaur/vl/lint/xf-drop-unresolved-submodules.cert
-./centaur/vl/mlib/lvalues-mentioning.cert
-./centaur/vl/mlib/rvalues.cert
-./centaur/vl/util/prefixp.cert
-./clause-processors/autohide.cert
-./clause-processors/basic-examples.cert
-./clause-processors/bv-add.cert
-./clause-processors/bv-add-common.cert
-./clause-processors/bv-add-tests.cert
-./clause-processors/decomp-hint.cert
-./clause-processors/equality.cert
-./clause-processors/ev-find-rules.cert
-./clause-processors/ev-theoremp.cert
-./clause-processors/find-subterms.cert
-./clause-processors/generalize.cert
-./clause-processors/instantiate.cert
-./clause-processors/join-thms.cert
-./clause-processors/just-expand.cert
-./clause-processors/meta-extract-simple-test.cert
-./clause-processors/meta-extract-user.cert
-./clause-processors/multi-env-trick.cert
-./clause-processors/null-fail-hints.cert
-./clause-processors/nvalues-thms.cert
-./clause-processors/replace-defined-consts.cert
-./clause-processors/replace-impl.cert
-./clause-processors/stobj-preservation.cert
-./clause-processors/sublis-var-meaning.cert
-# Omitting clause-processors/SULFA/ (and all its subdirectories)
-./clause-processors/term-patterns.cert
-./clause-processors/unify-subst.cert
-./clause-processors/use-by-hint.cert
-./clause-processors/witness-cp.cert
-./coi/adviser/adviser.cert
-./coi/adviser/adviser-pkg.cert
-./coi/adviser/test.cert
-./coi/alists/alist-pkg.cert
-./coi/alists/bindequiv.cert
-./coi/alists/clearkey.cert
-./coi/alists/deshadow.cert
-./coi/alists/equiv.cert
-./coi/alists/keyquiv.cert
-./coi/alists/preimage.cert
-./coi/alists/strip.cert
-./coi/alists/subkeyquiv.cert
-./coi/alists/top.cert
-./coi/bags/basic.cert
-./coi/bags/bind-free-rules.cert
-./coi/bags/cons.cert
-./coi/bags/eric-meta.cert
-./coi/bags/extras.cert
-./coi/bags/meta.cert
-./coi/bags/neq.cert
-./coi/bags/pick-a-point.cert
-./coi/bags/top.cert
-./coi/bags/two-level.cert
-./coi/bags/two-level-meta.cert
-./coi/defpun/ack.cert
-./coi/defpun/defminterm.cert
-./coi/defpun/defpun.cert
-./coi/defpun/defxch.cert
-./coi/defstructure/defstructure.cert
-./coi/defstructure/defstructure-pkg.cert
-./coi/dtrees/base.cert
-./coi/dtrees/child.cert
-./coi/dtrees/deps.cert
-./coi/dtrees/equiv.cert
-./coi/dtrees/erase.cert
-./coi/dtrees/leafp.cert
-./coi/dtrees/raw.cert
-./coi/dtrees/royalp.cert
-./coi/dtrees/set.cert
-./coi/dtrees/top.cert
-./coi/gacc/abstract-gacc.cert
-./coi/gacc/addr-range.cert
-./coi/gacc/bits.cert
-./coi/gacc/block.cert
-./coi/gacc/finite.cert
-./coi/gacc/fr-path-connection.cert
-./coi/gacc/gacc2.cert
-./coi/gacc/gacc3.cert
-./coi/gacc/gacc.cert
-./coi/gacc/gacc-exports.cert
-./coi/gacc/gacc-pkg.cert
-./coi/gacc/gax.cert
-./coi/gacc/list-ops.cert
-./coi/gacc/list-ops-common.cert
-./coi/gacc/list-ops-fast.cert
-./coi/gacc/mem.cert
-./coi/gacc/mem-fast.cert
-./coi/gacc/ram0.cert
-./coi/gacc/ram2b.cert
-./coi/gacc/ram2.cert
-./coi/gacc/ram3.cert
-./coi/gacc/ram.cert
-./coi/gacc/top.cert
-./coi/gacc/tr-path-connection.cert
-./coi/gacc/wrap.cert
-./coi/generalize/generalize.cert
-./coi/gensym/gensym.cert
-./coi/gensym/gensym-list.cert
-./coi/lists/acl2-count.cert
-./coi/lists/basic.cert
-./coi/lists/disjoint.cert
-./coi/lists/find-index.cert
-./coi/lists/listset-induction.cert
-./coi/lists/list-top.cert
-./coi/lists/map-cons.cert
-./coi/lists/memberp.cert
-./coi/lists/mixed.cert
-./coi/lists/mv-nth.cert
-./coi/lists/nth-and-update-nth.cert
-./coi/lists/nth-meta2.cert
-./coi/lists/nth-meta.cert
-./coi/lists/remove.cert
-./coi/lists/remove-induction.cert
-./coi/lists/repeat.cert
-./coi/lists/set.cert
-./coi/lists/subsetp.cert
-./coi/lists/update-nth-array.cert
-./coi/maps/aliases.cert
-./coi/maps/maps.cert
-./coi/maps/typed-maps.cert
-./coi/nary/example.cert
-./coi/nary/nary.cert
-./coi/nary/nth-rules.cert
-./coi/nary/ordinal-order.cert
-./coi/nary/rewrite-equal-hint.cert
-./coi/osets/computed-hints.cert
-./coi/osets/conversions.cert
-./coi/osets/extras.cert
-./coi/osets/fast.cert
-./coi/osets/instance.cert
-./coi/osets/listsets.cert
-./coi/osets/map.cert
-./coi/osets/membership.cert
-./coi/osets/multiappend.cert
-./coi/osets/multicons.cert
-./coi/osets/outer.cert
-./coi/osets/primitives.cert
-./coi/osets/quantify.cert
-./coi/osets/set-order.cert
-./coi/osets/set-processor.cert
-./coi/osets/sets.cert
-./coi/osets/sort.cert
-./coi/paths/compatibility.cert
-./coi/paths/cp-set.cert
-./coi/paths/defs.cert
-./coi/paths/diverge.cert
-./coi/paths/dominates.cert
-./coi/paths/equiv.cert
-./coi/paths/hints.cert
-./coi/paths/list-path-connection.cert
-./coi/paths/meta.cert
-./coi/paths/path.cert
-./coi/paths/pm.cert
-./coi/quantification/quantification.cert
-./coi/records/defarray.cert
-./coi/records/defrecord.cert
-./coi/records/defrecord-fast.cert
-./coi/records/domain.cert
-./coi/records/fixedpoint.cert
-./coi/records/mem-domain.cert
-./coi/records/memory.cert
-./coi/records/record-exports.cert
-./coi/records/records.cert
-./coi/records/set-domain.cert
-./coi/super-ihs/arithmetic.cert
-./coi/super-ihs/ash.cert
-./coi/super-ihs/basics.cert
-./coi/super-ihs/bit-functions.cert
-./coi/super-ihs/bit-twiddling-logops.cert
-./coi/super-ihs/byte-p.cert
-./coi/super-ihs/carry.cert
-./coi/super-ihs/c-functions.cert
-./coi/super-ihs/eric.cert
-./coi/super-ihs/evenp.cert
-./coi/super-ihs/fast.cert
-./coi/super-ihs/from-rtl.cert
-./coi/super-ihs/hacks.cert
-./coi/super-ihs/inductions.cert
-./coi/super-ihs/iter-sqrt.cert
-./coi/super-ihs/logapp.cert
-./coi/super-ihs/logbit.cert
-./coi/super-ihs/logbitp.cert
-./coi/super-ihs/logcar.cert
-./coi/super-ihs/logcdr.cert
-./coi/super-ihs/logcons.cert
-./coi/super-ihs/logext.cert
-./coi/super-ihs/loghead.cert
-./coi/super-ihs/logical-logops.cert
-./coi/super-ihs/logior-logapp-crock.cert
-./coi/super-ihs/loglist.cert
-./coi/super-ihs/logpair.cert
-./coi/super-ihs/logtail.cert
-./coi/super-ihs/lshu.cert
-./coi/super-ihs/meta.cert
-./coi/super-ihs/min-max.cert
-./coi/super-ihs/plus-logapp-suck.cert
-./coi/super-ihs/signed-byte-p-overflow.cert
-./coi/super-ihs/super-ihs.cert
-./coi/super-ihs/unsigned-byte-p.cert
-./coi/symbol-fns/symbol-fns.cert
-./coi/symbol-fns/symbol-fns-exports.cert
-./coi/syntax/auxilary.cert
-./coi/syntax/defbinding.cert
-./coi/syntax/defevaluator.cert
-./coi/syntax/quine.cert
-./coi/syntax/syn-pkg.cert
-./coi/syntax/syntax.cert
-./coi/syntax/syntax-extensions.cert
-./coi/termination/assuming/compiler.cert
-./coi/termination/assuming/compiler-proof.cert
-# ./coi/termination/assuming/complex.cert # see Makefile in that directory
-./coi/termination/assuming/zero.cert
-./coi/util/clause-processor.cert
-./coi/util/debug.cert
-./coi/util/defbinding.cert
-./coi/util/defdoc.cert
-./coi/util/deffix.cert
-./coi/util/defsubtype.cert
-./coi/util/defun.cert
-./coi/util/defun-support.cert
-./coi/util/extra-info.cert
-./coi/util/extra-info-test.cert
-./coi/util/fixequiv.cert
-./coi/util/good-rewrite-order.cert
-./coi/util/ifdef.cert
-./coi/util/iff.cert
-./coi/util/ifixequiv.cert
-./coi/util/implies.cert
-./coi/util/in-conclusion.cert
-./coi/util/ith.cert
-./coi/util/mv-nth.cert
-./coi/util/nfixequiv.cert
-./coi/util/ordinal-order.cert
-./coi/util/pseudo-translate.cert
-./coi/util/recursion-support.cert
-./coi/util/rewrite-equiv.cert
-./coi/util/rule-sets.cert
-./coi/util/rule-sets-documentation.cert
-./coi/util/rule-sets-support.cert
-./coi/util/skip-rewrite.cert
-./coi/util/syntaxp.cert
-./coi/util/table.cert
-./concurrent-programs/bakery/apply-total-order.cert
-./concurrent-programs/bakery/fairenv.cert
-./concurrent-programs/bakery/final-theorems.cert
-./concurrent-programs/bakery/initial-state.cert
-./concurrent-programs/bakery/inv-persists.cert
-./concurrent-programs/bakery/inv-sufficient.cert
-./concurrent-programs/bakery/labels.cert
-./concurrent-programs/bakery/lexicographic.cert
-./concurrent-programs/bakery/lexicographic-pos.cert
-./concurrent-programs/bakery/measures.cert
-./concurrent-programs/bakery/pos-temp.cert
-./concurrent-programs/bakery/programs.cert
-./concurrent-programs/bakery/properties.cert
-./concurrent-programs/bakery/properties-of-sets.cert
-./concurrent-programs/bakery/records.cert
-./concurrent-programs/bakery/stutter1-match.cert
-./concurrent-programs/bakery/stutter2.cert
-./concurrent-programs/bakery/variables.cert
-./concurrent-programs/german-protocol/german.cert
-./countereg-gen/acl2s-parameter.cert
-./countereg-gen/base.cert
-./countereg-gen/basis.cert
-./countereg-gen/data.cert
-./countereg-gen/graph.cert
-./countereg-gen/library-support.cert
-./countereg-gen/main.cert
-./countereg-gen/mv-proof.cert
-./countereg-gen/num-list-fns.cert
-./countereg-gen/num-list-thms.cert
-./countereg-gen/random.cert
-./countereg-gen/random-state-basis1.cert
-./countereg-gen/random-state.cert
-./countereg-gen/rem-and-floor.cert
-./countereg-gen/simple-graph-array.cert
-./countereg-gen/splitnat.cert
-./countereg-gen/switchnat.cert
-./countereg-gen/top.cert
-./countereg-gen/type.cert
-./countereg-gen/utilities.cert
-./countereg-gen/with-timeout.cert
-./cowles/acl2-agp.cert
-./cowles/acl2-asg.cert
-./cowles/acl2-crg.cert
-./cutil/da-base.cert
-./cutil/defaggregate.cert
-./cutil/defaggregate-tests.cert
-./cutil/defalist.cert
-./cutil/defalist-tests.cert
-./cutil/defenum.cert
-./cutil/define.cert
-./cutil/define-tests.cert
-./cutil/deflist-aux.cert
-./cutil/deflist.cert
-./cutil/deflist-tests.cert
-./cutil/defmapappend.cert
-./cutil/defmapappend-tests.cert
-./cutil/defmvtypes.cert
-./cutil/defprojection.cert
-./cutil/defprojection-tests.cert
-./cutil/defsection.cert
-./cutil/formals.cert
-./cutil/look-up.cert
-./cutil/maybe-defthm.cert
-./cutil/portcullis.cert
-./cutil/returnspecs.cert
-./cutil/support.cert
-./cutil/top.cert
-./cutil/wizard.cert
-./data-structures/alist-defthms.cert
-./data-structures/alist-defuns.cert
-./data-structures/alist-theory.cert
-./data-structures/array1.cert
-./data-structures/defalist.cert
-./data-structures/deflist.cert
-./data-structures/doc-section.cert
-./data-structures/list-defthms.cert
-./data-structures/list-defuns.cert
-./data-structures/list-theory.cert
-./data-structures/memories/log2.cert
-./data-structures/memories/memory.cert
-./data-structures/memories/memory-impl.cert
-./data-structures/memories/memtree.cert
-./data-structures/memories/private.cert
-./data-structures/no-duplicates.cert
-./data-structures/number-list-defthms.cert
-./data-structures/number-list-defuns.cert
-./data-structures/number-list-theory.cert
-./data-structures/set-defthms.cert
-./data-structures/set-defuns.cert
-./data-structures/set-theory.cert
-./data-structures/structures.cert
-./data-structures/utilities.cert
-./deduction/passmore/bewijs.cert
-./deduction/passmore/general.cert
-./deduction/passmore/paramod.cert
-./deduction/passmore/prover.cert
-./deduction/passmore/resolution.cert
-./deduction/passmore/unification.cert
-./deduction/passmore/weighting.cert
-./defexec/dag-unification/basic.cert
-./defexec/dag-unification/dags.cert
-./defexec/dag-unification/dag-unification-l.cert
-./defexec/dag-unification/dag-unification-rules.cert
-./defexec/dag-unification/dag-unification-st.cert
-./defexec/dag-unification/list-unification-rules.cert
-./defexec/dag-unification/matching.cert
-./defexec/dag-unification/subsumption.cert
-./defexec/dag-unification/subsumption-subst.cert
-./defexec/dag-unification/terms-as-dag.cert
-./defexec/dag-unification/terms.cert
-./defexec/dag-unification/terms-dag-stobj.cert
-./defexec/defpun-exec/defpun-exec.cert
-./defexec/find-path/fpst.cert
-./defexec/find-path/graph/find-path1.cert
-./defexec/find-path/graph/find-path2.cert
-./defexec/find-path/graph/find-path3.cert
-./defexec/find-path/graph/helpers.cert
-./defexec/find-path/graph/linear-find-path.cert
-./defexec/find-path/run-fpst.cert
-./defexec/ordinals/supporting-ordinals.cert
-./defexec/other-apps/misc/memos.cert
-./defexec/other-apps/misc/stobjsim.cert
-./defexec/other-apps/qsort/extraction.cert
-./defexec/other-apps/qsort/final-theorem.cert
-./defexec/other-apps/qsort/first-last.cert
-./defexec/other-apps/qsort/intermediate-program.cert
-./defexec/other-apps/qsort/intermediate-to-spec.cert
-./defexec/other-apps/qsort/load-extract.cert
-./defexec/other-apps/qsort/merge-intermediate.cert
-./defexec/other-apps/qsort/nth-update-nth.cert
-./defexec/other-apps/qsort/permutations.cert
-./defexec/other-apps/qsort/programs.cert
-./defexec/other-apps/qsort/sort-qs-properties.cert
-./defexec/other-apps/qsort/spec-properties.cert
-./defexec/other-apps/qsort/split-qs-properties.cert
-./defexec/other-apps/qsort/total-order.cert
-./defexec/other-apps/records/inline.cert
-./defexec/other-apps/records/records-bsd.cert
-./defexec/other-apps/records/records.cert
-./defexec/other-apps/records/recordsim.cert
-./defexec/reflexive/reflexive.cert
-./defsort/defsort.cert
-./defsort/duplicated-members.cert
-./defsort/duplicity.cert
-./defsort/examples.cert
-./defsort/generic.cert
-./defsort/generic-impl.cert
-./defsort/remove-dups.cert
-./defsort/uniquep.cert
-./demos/list-theory.cert
-./demos/modeling/memories.cert
-./demos/modeling/network-state-basic.cert
-./demos/modeling/network-state.cert
-./demos/modeling/nondeterminism.cert
-./finite-set-theory/osets/cardinality.cert
-./finite-set-theory/osets/computed-hints.cert
-./finite-set-theory/osets/delete.cert
-./finite-set-theory/osets/difference.cert
-./finite-set-theory/osets/instance.cert
-./finite-set-theory/osets/intersect.cert
-./finite-set-theory/osets/map.cert
-./finite-set-theory/osets/map-tests.cert
-./finite-set-theory/osets/membership.cert
-./finite-set-theory/osets/outer.cert
-./finite-set-theory/osets/portcullis.cert
-./finite-set-theory/osets/primitives.cert
-./finite-set-theory/osets/quantify.cert
-./finite-set-theory/osets/sets.cert
-./finite-set-theory/osets/sort.cert
-./finite-set-theory/osets/under-set-equiv.cert
-./finite-set-theory/osets/union.cert
-./finite-set-theory/set-theory.cert
-./finite-set-theory/total-ordering.cert
-# ./fix-cert/ (including all files and subdirectories)
-./hacking/all.cert
-./hacking/bridge.cert
-./hacking/defcode.cert
-./hacking/defstruct-parsing.cert
-./hacking/doc-section.cert
-./hacking/dynamic-make-event.cert
-./hacking/dynamic-make-event-test.cert
-./hacking/evalable-ld-printing.cert
-./hacking/hacker.cert
-./hacking/progn-bang-enh.cert
-./hacking/raw.cert
-./hacking/redefun.cert
-./hacking/rewrite-code.cert
-./hacking/subsumption.cert
-./hacking/table-guard.cert
-./hints/basic-tests.cert
-./hints/consider-hint.cert
-./hints/consider-hint-tests.cert
-./hints/huet-lang-algorithm.cert
-./hints/huet-lang-algorithm-tests.cert
-./hints/merge-hint.cert
-./ihs/basic-definitions.cert
-./ihs/ihs-definitions.cert
-./ihs/ihs-doc-topic.cert
-./ihs/ihs-init.cert
-./ihs/ihs-lemmas.cert
-./ihs/ihs-theories.cert
-./ihs/@logops.cert
-./ihs/logops-definitions.cert
-./ihs/logops-lemmas.cert
-./ihs/math-lemmas.cert
-./ihs/quotient-remainder-lemmas.cert
-./leftist-trees/leftist-tree-defthms.cert
-./leftist-trees/leftist-tree-defuns.cert
-./leftist-trees/leftist-tree-sort.cert
-./leftist-trees/leftist-tree-sort-equivalent2.cert
-./leftist-trees/leftist-tree-sort-equivalent3.cert
-./leftist-trees/leftist-tree-sort-equivalent.cert
-./leftist-trees/top.cert
-./make-event/acl2x-help.cert
-# ./make-event/acl2x-help-test.cert (maybe OK, but there's .acl2x file so not sure)
-./make-event/assert.cert
-./make-event/assert-check.cert
-./make-event/assert-check-include-1.cert
-./make-event/assert-check-include.cert
-./make-event/assert-include.cert
-./make-event/basic.cert
-./make-event/basic-check.cert
-./make-event/basic-pkg.cert
-./make-event/basic-pkg-check.cert
-./make-event/defconst-fast.cert
-./make-event/defconst-fast-examples.cert
-./make-event/defrefine.cert
-./make-event/defrule.cert
-./make-event/defspec.cert
-./make-event/dotimes.cert
-# ./make-event/double-cert-test-1.cert (maybe OK, but there's .acl2x file so not sure)
-# ./make-event/double-cert-test.cert (depends on double-cert-test-1.cert)
-./make-event/embeddable-event-forms.cert
-./make-event/eval.cert
-./make-event/eval-check.cert
-./make-event/eval-check-tests.cert
-./make-event/eval-tests.cert
-./make-event/gen-defthm.cert
-./make-event/gen-defthm-check.cert
-./make-event/gen-defun.cert
-./make-event/gen-defun-check.cert
-./make-event/inline-book.cert
-./make-event/local-elided.cert
-./make-event/local-elided-include.cert
-./make-event/local-requires-skip-check.cert
-./make-event/local-requires-skip-check-include.cert
-./make-event/logical-tangent.cert
-./make-event/macros.cert
-./make-event/macros-include.cert
-./make-event/macros-skip-proofs.cert
-./make-event/macros-skip-proofs-include.cert
-./make-event/make-redundant.cert
-./make-event/nested.cert
-./make-event/nested-check.cert
-./make-event/portcullis-expansion.cert
-./make-event/portcullis-expansion-include.cert
-./make-event/proof-by-arith.cert
-./make-event/read-from-file.cert
-./make-event/require-book.cert
-# ./make-event/stobj-test.cert (maybe OK, but there's .acl2x file so not sure)
-./make-event/test-case.cert
-./make-event/test-case-check.cert
-./meta/meta.cert
-./meta/meta-plus-equal.cert
-./meta/meta-plus-lessp.cert
-./meta/meta-times-equal.cert
-./meta/pseudo-termp-lemmas.cert
-./meta/term-defuns.cert
-./meta/term-lemmas.cert
-./misc/assert.cert
-./misc/bash.cert
-./misc/beta-reduce.cert
-./misc/callers-and-ancestors.cert
-./misc/character-encoding-test.cert
-./misc/check-acl2-exports.cert
-./misc/check-state.cert
-./misc/computed-hint.cert
-./misc/computed-hint-rewrite.cert
-./misc/congruent-stobjs-test.cert
-./misc/csort.cert
-./misc/dead-events.cert
-./misc/defabsstobj-example-1.cert
-./misc/defabsstobj-example-2.cert
-./misc/defabsstobj-example-3.cert
-./misc/defabsstobj-example-4.cert
-./misc/defattach-bang.cert
-./misc/defattach-example.cert
-./misc/definline.cert
-./misc/defmac.cert
-./misc/defopener.cert
-./misc/defp.cert
-./misc/defproxy-test.cert
-./misc/defpun.cert
-./misc/defun-plus.cert
-./misc/dft.cert
-./misc/dft-ex.cert
-./misc/dijkstra-shortest-path.cert
-./misc/disassemble.cert
-./misc/doc-section.cert
-./misc/dump-events.cert
-./misc/equal-by-g.cert
-./misc/equal-by-g-help.cert
-./misc/evalable-printing.cert
-./misc/eval.cert
-./misc/expander.cert
-./misc/fast-coerce.cert
-./misc/fibonacci.cert
-./misc/file-io.cert
-./misc/find-lemmas.cert
-./misc/gentle.cert
-./misc/getprop.cert
-./misc/goodstein.cert
-./misc/grcd.cert
-./misc/hanoi.cert
-./misc/hons-help2.cert
-./misc/hons-help.cert
-./misc/hons-tests.cert
-./misc/how-to-prove-thms.cert
-./misc/int-division.cert
-./misc/integer-type-set-test.cert
-./misc/invariants.cert
-./misc/meta-lemmas.cert
-./misc/misc2/defpun-exec-domain-example.cert
-./misc/misc2/misc.cert
-./misc/misc2/reverse-by-separation.cert
-./misc/misc2/ruler-extenders-tests.cert
-./misc/misc2/step-limits.cert
-./misc/mult.cert
-./misc/oprof.cert
-./misc/priorities.cert
-./misc/problem13.cert
-./misc/process-book-readme.cert
-./misc/profiling.cert
-./misc/qi.cert
-./misc/qi-correct.cert
-./misc/radix.cert
-./misc/random.cert
-./misc/records0.cert
-./misc/records-bsd.cert
-./misc/records.cert
-./misc/redef-pkg.cert
-./misc/rtl-untranslate.cert
-./misc/save-time.cert
-./misc/seq.cert
-./misc/seqw.cert
-./misc/simplify-defuns.cert
-./misc/simplify-thm.cert
-./misc/sin-cos.cert
-./misc/sort-symbols.cert
-./misc/sticky-disable.cert
-./misc/symbol-btree.cert
-./misc/total-order-bsd.cert
-./misc/total-order.cert
-./misc/trace-star.cert
-./misc/transfinite.cert
-./misc/untranslate-patterns.cert
-./misc/wet.cert
-./models/jvm/m1/alternating-sum.cert
-./models/jvm/m1/alternating-sum-variant.cert
-./models/jvm/m1/bexpt.cert
-./models/jvm/m1/defsys.cert
-./models/jvm/m1/defsys-utilities.cert
-./models/jvm/m1/div.cert
-./models/jvm/m1/even-solution-1.cert
-./models/jvm/m1/even-solution-2.cert
-./models/jvm/m1/expt.cert
-./models/jvm/m1/fact.cert
-./models/jvm/m1/fib.cert
-./models/jvm/m1/find-k!.cert
-./models/jvm/m1/funny-fact.cert
-./models/jvm/m1/implementation.cert
-./models/jvm/m1/lessp.cert
-./models/jvm/m1/low-seven.cert
-./models/jvm/m1/m1.cert
-./models/jvm/m1/magic.cert
-./models/jvm/m1-original/m1-story.cert
-./models/jvm/m1-original/problem-set-1-answers.cert
-./models/jvm/m1/power.cert
-./models/jvm/m1/sign.cert
-./models/jvm/m1/sum.cert
-./models/jvm/m1/sumsq.cert
-./models/jvm/m1/template.cert
-./models/jvm/m1/theorems-a-and-b.cert
-./models/jvm/m1/tmi-reductions.cert
-./models/jvm/m1/wormhole-abstraction.cert
-# ./models/jvm/m5/apprentice.cert (generated only at UT)
-./models/jvm/m5/apprentice-state.cert
-./models/jvm/m5/demo.cert
-./models/jvm/m5/idemo.cert
-./models/jvm/m5/infinite-fair-schedule.cert
-./models/jvm/m5/isort.cert
-./models/jvm/m5/jvm-fact-setup.cert
-./models/jvm/m5/m5.cert
-./models/jvm/m5/partial.cert
-./models/jvm/m5/perm.cert
-./models/jvm/m5/universal.cert
-./models/jvm/m5/universal-never-returns.cert
-./models/jvm/m5/utilities.cert
-# omitting nonstd/ (and all its subdirectories)
-# omitting models/y86/ (hons only)
-./ordinals/e0-ordinal.cert
-./ordinals/lexicographic-book.cert
-./ordinals/lexicographic-ordering.cert
-./ordinals/lexicographic-ordering-without-arithmetic.cert
-./ordinals/limits.cert
-./ordinals/ordinal-addition.cert
-./ordinals/ordinal-basic-thms.cert
-./ordinals/ordinal-counter-examples.cert
-./ordinals/ordinal-definitions.cert
-./ordinals/ordinal-exponentiation.cert
-./ordinals/ordinal-isomorphism.cert
-./ordinals/ordinal-multiplication.cert
-./ordinals/ordinals.cert
-./ordinals/ordinals-without-arithmetic.cert
-./ordinals/ordinal-total-order.cert
-./ordinals/proof-of-well-foundedness.cert
-./ordinals/top-with-meta.cert
-./oslib/catpath.cert
-./oslib/date.cert
-./oslib/getpid.cert
-./oslib/ls.cert
-./oslib/portcullis.cert
-./oslib/read-acl2-oracle.cert
-./oslib/tempfile.cert
-./oslib/top.cert
-./paco/database.cert
-./paco/elim-dest.cert
-./paco/foundations.cert
-./paco/induct.cert
-./paco/output-module.cert
-./paco/paco.cert
-./paco/prove.cert
-./paco/rewrite.cert
-./paco/simplify.cert
-./paco/type-set.cert
-./paco/utilities.cert
-./parallel/fibonacci.cert
-./parallel/hint-tests.cert
-./parallel/matrix-multiplication-parallel.cert
-./parallel/matrix-multiplication-serial.cert
-./parallel/matrix-multiplication-setup.cert
-# ./parallel/proofs/ideal-speedup.cert (could be slow in some Lisps)
-./parallel/spec-mv-let.cert
-./parallel/stress-tests.cert
-./parallel/syntax-tests.cert
-./parallel/without-waterfall-parallelism.cert
-./parallel/with-waterfall-parallelism.cert
-./powerlists/algebra.cert
-./powerlists/batcher-sort.cert
-./powerlists/bitonic-sort.cert
-./powerlists/cla-adder.cert
-./powerlists/gray-code.cert
-./powerlists/merge-sort.cert
-./powerlists/prefix-sum.cert
-./powerlists/simple.cert
-./powerlists/sort.cert
-./proofstyles/completeness/assertions-partial.cert
-./proofstyles/completeness/assertions-total.cert
-./proofstyles/completeness/clock-partial.cert
-./proofstyles/completeness/clock-total.cert
-./proofstyles/completeness/generic-partial.cert
-./proofstyles/completeness/generic-total.cert
-./proofstyles/completeness/stepwise-invariants-partial.cert
-./proofstyles/completeness/stepwise-invariants-total.cert
-./proofstyles/counterexamples/halt-flg.cert
-./proofstyles/counterexamples/memory-clearing.cert
-./proofstyles/counterexamples/realistic.cert
-./proofstyles/invclock/c2i/c2i-partial.cert
-./proofstyles/invclock/c2i/c2i-total.cert
-./proofstyles/invclock/c2i/clock-to-inv.cert
-./proofstyles/invclock/compose/compose-c-c-partial.cert
-./proofstyles/invclock/compose/compose-c-c-total.cert
-./proofstyles/invclock/i2c/i2c-partial.cert
-./proofstyles/invclock/i2c/i2c-total.cert
-./proofstyles/invclock/i2c/inv-to-clock.cert
-./proofstyles/soundness/assertions-partial.cert
-./proofstyles/soundness/assertions-total.cert
-./proofstyles/soundness/clock-partial.cert
-./proofstyles/soundness/clock-total.cert
-./proofstyles/soundness/stepwise-invariants-partial.cert
-./proofstyles/soundness/stepwise-invariants-total.cert
-./quadratic-reciprocity/eisenstein.cert
-./quadratic-reciprocity/euclid.cert
-./quadratic-reciprocity/euler.cert
-./quadratic-reciprocity/fermat.cert
-./quadratic-reciprocity/gauss.cert
-./quadratic-reciprocity/mersenne.cert
-./regex/defset-encapsulates.cert
-./regex/defset-macros.cert
-./regex/equal-based-set.cert
-./regex/grep-command-line.cert
-./regex/input-list.cert
-./regex/portcullis.cert
-./regex/regex-chartrans.cert
-./regex/regex-defs.cert
-./regex/regex-exec.cert
-./regex/regex-fileio.cert
-./regex/regex-parse-brace.cert
-./regex/regex-parse-bracket.cert
-./regex/regex-parse.cert
-./regex/regex-tests.cert
-./regex/regex-ui.cert
-./rtl/rel1/lib1/basic.cert
-./rtl/rel1/lib1/bits.cert
-./rtl/rel1/lib1/brat.cert
-./rtl/rel1/lib1/float.cert
-./rtl/rel1/lib1/reps.cert
-./rtl/rel1/lib1/round.cert
-./rtl/rel1/lib1/top.cert
-./rtl/rel1/lib3/basic.cert
-./rtl/rel1/lib3/bits.cert
-./rtl/rel1/lib3/brat.cert
-./rtl/rel1/lib3/fadd.cert
-./rtl/rel1/lib3/float.cert
-./rtl/rel1/lib3/reps.cert
-./rtl/rel1/lib3/round.cert
-./rtl/rel1/lib3/top.cert
-./rtl/rel1/support/add.cert
-./rtl/rel1/support/away.cert
-./rtl/rel1/support/basic.cert
-./rtl/rel1/support/divsqrt.cert
-./rtl/rel1/support/fadd/add3.cert
-./rtl/rel1/support/fadd/lop1.cert
-./rtl/rel1/support/fadd/lop2.cert
-./rtl/rel1/support/fadd/lop3.cert
-./rtl/rel1/support/fadd/stick.cert
-./rtl/rel1/support/fadd/top.cert
-./rtl/rel1/support/float.cert
-./rtl/rel1/support/floor.cert
-./rtl/rel1/support/fp.cert
-./rtl/rel1/support/logdefs.cert
-./rtl/rel1/support/loglemmas.cert
-./rtl/rel1/support/logxor-def.cert
-./rtl/rel1/support/logxor-lemmas.cert
-./rtl/rel1/support/merge.cert
-./rtl/rel1/support/near.cert
-./rtl/rel1/support/odd.cert
-./rtl/rel1/support/proofs.cert
-./rtl/rel1/support/reps.cert
-./rtl/rel1/support/rewrite-theory.cert
-./rtl/rel1/support/rnd.cert
-./rtl/rel1/support/sticky.cert
-./rtl/rel1/support/trunc.cert
-./rtl/rel1/support/x-2xx.cert
-./rtl/rel4/arithmetic/arith2.cert
-./rtl/rel4/arithmetic/arith.cert
-./rtl/rel4/arithmetic/basic.cert
-./rtl/rel4/arithmetic/cg.cert
-./rtl/rel4/arithmetic/common-factor.cert
-./rtl/rel4/arithmetic/common-factor-defuns.cert
-./rtl/rel4/arithmetic/complex-rationalp.cert
-./rtl/rel4/arithmetic/denominator.cert
-./rtl/rel4/arithmetic/even-odd2.cert
-./rtl/rel4/arithmetic/even-odd2-proofs.cert
-./rtl/rel4/arithmetic/even-odd.cert
-./rtl/rel4/arithmetic/expo.cert
-./rtl/rel4/arithmetic/expo-proofs.cert
-./rtl/rel4/arithmetic/expt.cert
-./rtl/rel4/arithmetic/expt-proofs.cert
-./rtl/rel4/arithmetic/extra-rules.cert
-./rtl/rel4/arithmetic/fl.cert
-./rtl/rel4/arithmetic/fl-expt.cert
-./rtl/rel4/arithmetic/fl-hacks.cert
-./rtl/rel4/arithmetic/floor.cert
-./rtl/rel4/arithmetic/floor-proofs.cert
-./rtl/rel4/arithmetic/fl-proofs.cert
-./rtl/rel4/arithmetic/fp2.cert
-./rtl/rel4/arithmetic/fp.cert
-./rtl/rel4/arithmetic/ground-zero.cert
-./rtl/rel4/arithmetic/hacks.cert
-./rtl/rel4/arithmetic/induct.cert
-./rtl/rel4/arithmetic/integerp.cert
-./rtl/rel4/arithmetic/inverted-factor.cert
-./rtl/rel4/arithmetic/mod.cert
-./rtl/rel4/arithmetic/mod-expt.cert
-./rtl/rel4/arithmetic/mod-proofs.cert
-./rtl/rel4/arithmetic/negative-syntaxp.cert
-./rtl/rel4/arithmetic/nniq.cert
-./rtl/rel4/arithmetic/numerator.cert
-./rtl/rel4/arithmetic/power2p.cert
-./rtl/rel4/arithmetic/predicate.cert
-./rtl/rel4/arithmetic/product.cert
-./rtl/rel4/arithmetic/product-proofs.cert
-./rtl/rel4/arithmetic/rationalp.cert
-./rtl/rel4/arithmetic/top.cert
-./rtl/rel4/arithmetic/unary-divide.cert
-./rtl/rel4/arithmetic/x-2xx.cert
-./rtl/rel4/lib/arith.cert
-./rtl/rel4/lib/basic.cert
-./rtl/rel4/lib/bits.cert
-./rtl/rel4/lib/bvecp-helpers.cert
-./rtl/rel4/lib/bvecp-raw-helpers.cert
-./rtl/rel4/lib/clocks.cert
-./rtl/rel4/lib/fadd.cert
-./rtl/rel4/lib/float.cert
-./rtl/rel4/lib/openers.cert
-./rtl/rel4/lib/package-defs.cert
-./rtl/rel4/lib/reps.cert
-./rtl/rel4/lib/rom-helpers.cert
-./rtl/rel4/lib/round.cert
-./rtl/rel4/lib/rtlarr.cert
-./rtl/rel4/lib/rtl.cert
-./rtl/rel4/lib/simple-loop-helpers.cert
-./rtl/rel4/lib/simplify-model-helpers.cert
-./rtl/rel4/lib/top.cert
-./rtl/rel4/lib/util.cert
-./rtl/rel4/support/add3.cert
-./rtl/rel4/support/add3-proofs.cert
-./rtl/rel4/support/all-ones.cert
-./rtl/rel4/support/ash.cert
-./rtl/rel4/support/away.cert
-./rtl/rel4/support/away-proofs.cert
-./rtl/rel4/support/badguys.cert
-./rtl/rel4/support/bias.cert
-./rtl/rel4/support/bias-proofs.cert
-./rtl/rel4/support/bitn.cert
-./rtl/rel4/support/bitn-proofs.cert
-./rtl/rel4/support/bits.cert
-./rtl/rel4/support/bits-extra.cert
-./rtl/rel4/support/bits-proofs.cert
-./rtl/rel4/support/bits-trunc.cert
-./rtl/rel4/support/bits-trunc-proofs.cert
-./rtl/rel4/support/bvecp.cert
-./rtl/rel4/support/bvecp-helpers.cert
-./rtl/rel4/support/bvecp-lemmas.cert
-./rtl/rel4/support/bvecp-proofs.cert
-./rtl/rel4/support/cat.cert
-./rtl/rel4/support/cat-def.cert
-./rtl/rel4/support/cat-proofs.cert
-./rtl/rel4/support/clocks.cert
-./rtl/rel4/support/decode.cert
-./rtl/rel4/support/decode-proofs.cert
-./rtl/rel4/support/drnd.cert
-./rtl/rel4/support/encode.cert
-./rtl/rel4/support/ereps.cert
-./rtl/rel4/support/ereps-proofs.cert
-./rtl/rel4/support/fadd.cert
-./rtl/rel4/support/fast-and.cert
-./rtl/rel4/support/float.cert
-./rtl/rel4/support/ground-zero.cert
-./rtl/rel4/support/guards.cert
-./rtl/rel4/support/ireps.cert
-./rtl/rel4/support/land.cert
-./rtl/rel4/support/land-proofs.cert
-./rtl/rel4/support/lextra.cert
-./rtl/rel4/support/lextra-proofs.cert
-./rtl/rel4/support/lior.cert
-./rtl/rel4/support/lior-proofs.cert
-./rtl/rel4/support/lnot.cert
-./rtl/rel4/support/lnot-proofs.cert
-./rtl/rel4/support/logand.cert
-./rtl/rel4/support/logand-proofs.cert
-./rtl/rel4/support/log.cert
-./rtl/rel4/support/log-equal.cert
-./rtl/rel4/support/logeqv.cert
-./rtl/rel4/support/logior1.cert
-./rtl/rel4/support/logior1-proofs.cert
-./rtl/rel4/support/logior.cert
-./rtl/rel4/support/logior-proofs.cert
-./rtl/rel4/support/lognot.cert
-./rtl/rel4/support/logorc1.cert
-./rtl/rel4/support/log-proofs.cert
-./rtl/rel4/support/logs.cert
-./rtl/rel4/support/logxor.cert
-./rtl/rel4/support/lop1.cert
-./rtl/rel4/support/lop1-proofs.cert
-./rtl/rel4/support/lop2.cert
-./rtl/rel4/support/lop2-proofs.cert
-./rtl/rel4/support/lop3.cert
-./rtl/rel4/support/lop3-proofs.cert
-./rtl/rel4/support/lxor.cert
-./rtl/rel4/support/lxor-proofs.cert
-./rtl/rel4/support/merge2.cert
-./rtl/rel4/support/merge.cert
-./rtl/rel4/support/mod4.cert
-./rtl/rel4/support/model-helpers.cert
-./rtl/rel4/support/mulcat.cert
-./rtl/rel4/support/mulcat-proofs.cert
-./rtl/rel4/support/near.cert
-./rtl/rel4/support/near+.cert
-./rtl/rel4/support/near-proofs.cert
-./rtl/rel4/support/near+-proofs.cert
-./rtl/rel4/support/ocat.cert
-./rtl/rel4/support/oddr.cert
-./rtl/rel4/support/oddr-proofs.cert
-./rtl/rel4/support/openers.cert
-./rtl/rel4/support/package-defs.cert
-./rtl/rel4/support/rewrite-theory.cert
-./rtl/rel4/support/rnd.cert
-./rtl/rel4/support/rom-helpers.cert
-./rtl/rel4/support/rtlarr.cert
-./rtl/rel4/support/rtl.cert
-./rtl/rel4/support/setbitn.cert
-./rtl/rel4/support/setbitn-proofs.cert
-./rtl/rel4/support/setbits.cert
-./rtl/rel4/support/setbits-proofs.cert
-./rtl/rel4/support/sgn.cert
-./rtl/rel4/support/shft.cert
-./rtl/rel4/support/simple-loop-helpers.cert
-./rtl/rel4/support/simplify-model-helpers.cert
-./rtl/rel4/support/stick.cert
-./rtl/rel4/support/stick-proofs.cert
-./rtl/rel4/support/sticky.cert
-./rtl/rel4/support/sticky-proofs.cert
-./rtl/rel4/support/sumbits.cert
-./rtl/rel4/support/top1.cert
-./rtl/rel4/support/top.cert
-./rtl/rel4/support/trunc.cert
-./rtl/rel4/support/trunc-proofs.cert
-./rtl/rel4/support/util.cert
-./rtl/rel4/user/away.cert
-./rtl/rel4/user/bias.cert
-./rtl/rel4/user/bitn.cert
-./rtl/rel4/user/bits.cert
-./rtl/rel4/user/bits-trunc.cert
-./rtl/rel4/user/brat.cert
-./rtl/rel4/user/bvecp.cert
-./rtl/rel4/user/cat.cert
-./rtl/rel4/user/decode.cert
-./rtl/rel4/user/ereps.cert
-./rtl/rel4/user/land.cert
-./rtl/rel4/user/lextra.cert
-./rtl/rel4/user/lior.cert
-./rtl/rel4/user/lnot.cert
-./rtl/rel4/user/logior1.cert
-./rtl/rel4/user/lxor.cert
-./rtl/rel4/user/mulcat.cert
-./rtl/rel4/user/near.cert
-./rtl/rel4/user/setbitn.cert
-./rtl/rel4/user/setbits.cert
-./rtl/rel4/user/stick.cert
-./rtl/rel4/user/sumbits.cert
-./rtl/rel4/user/top.cert
-./rtl/rel4/user/trunc.cert
-./rtl/rel5/arithmetic/arith2.cert
-./rtl/rel5/arithmetic/arith.cert
-./rtl/rel5/arithmetic/basic.cert
-./rtl/rel5/arithmetic/cg.cert
-./rtl/rel5/arithmetic/common-factor.cert
-./rtl/rel5/arithmetic/common-factor-defuns.cert
-./rtl/rel5/arithmetic/complex-rationalp.cert
-./rtl/rel5/arithmetic/denominator.cert
-./rtl/rel5/arithmetic/even-odd2.cert
-./rtl/rel5/arithmetic/even-odd2-proofs.cert
-./rtl/rel5/arithmetic/even-odd.cert
-./rtl/rel5/arithmetic/expo.cert
-./rtl/rel5/arithmetic/expo-proofs.cert
-./rtl/rel5/arithmetic/expt.cert
-./rtl/rel5/arithmetic/expt-proofs.cert
-./rtl/rel5/arithmetic/extra-rules.cert
-./rtl/rel5/arithmetic/fl.cert
-./rtl/rel5/arithmetic/fl-expt.cert
-./rtl/rel5/arithmetic/fl-hacks.cert
-./rtl/rel5/arithmetic/floor.cert
-./rtl/rel5/arithmetic/floor-proofs.cert
-./rtl/rel5/arithmetic/fl-proofs.cert
-./rtl/rel5/arithmetic/fp2.cert
-./rtl/rel5/arithmetic/fp.cert
-./rtl/rel5/arithmetic/ground-zero.cert
-./rtl/rel5/arithmetic/hacks.cert
-./rtl/rel5/arithmetic/induct.cert
-./rtl/rel5/arithmetic/integerp.cert
-./rtl/rel5/arithmetic/inverted-factor.cert
-./rtl/rel5/arithmetic/mod.cert
-./rtl/rel5/arithmetic/mod-expt.cert
-./rtl/rel5/arithmetic/mod-proofs.cert
-./rtl/rel5/arithmetic/negative-syntaxp.cert
-./rtl/rel5/arithmetic/nniq.cert
-./rtl/rel5/arithmetic/numerator.cert
-./rtl/rel5/arithmetic/power2p.cert
-./rtl/rel5/arithmetic/predicate.cert
-./rtl/rel5/arithmetic/product.cert
-./rtl/rel5/arithmetic/product-proofs.cert
-./rtl/rel5/arithmetic/rationalp.cert
-./rtl/rel5/arithmetic/top.cert
-./rtl/rel5/arithmetic/unary-divide.cert
-./rtl/rel5/arithmetic/x-2xx.cert
-./rtl/rel5/lib/add.cert
-./rtl/rel5/lib/arith.cert
-./rtl/rel5/lib/basic.cert
-./rtl/rel5/lib/bits.cert
-./rtl/rel5/lib/bvecp-helpers.cert
-./rtl/rel5/lib/bvecp-raw-helpers.cert
-./rtl/rel5/lib/clocks.cert
-./rtl/rel5/lib/float.cert
-./rtl/rel5/lib/log.cert
-./rtl/rel5/lib/openers.cert
-./rtl/rel5/lib/package-defs.cert
-./rtl/rel5/lib/reps.cert
-./rtl/rel5/lib/rom-helpers.cert
-./rtl/rel5/lib/round.cert
-./rtl/rel5/lib/rtlarr.cert
-./rtl/rel5/lib/rtl.cert
-./rtl/rel5/lib/simple-loop-helpers.cert
-./rtl/rel5/lib/simplify-model-helpers.cert
-./rtl/rel5/lib/top.cert
-./rtl/rel5/lib/util.cert
-./rtl/rel5/support/add3.cert
-./rtl/rel5/support/add3-proofs.cert
-./rtl/rel5/support/all-ones.cert
-./rtl/rel5/support/ash.cert
-./rtl/rel5/support/away.cert
-./rtl/rel5/support/away-proofs.cert
-./rtl/rel5/support/badguys.cert
-./rtl/rel5/support/bias.cert
-./rtl/rel5/support/bias-proofs.cert
-./rtl/rel5/support/bitn.cert
-./rtl/rel5/support/bitn-proofs.cert
-./rtl/rel5/support/bits.cert
-./rtl/rel5/support/bits-proofs.cert
-./rtl/rel5/support/bits-trunc.cert
-./rtl/rel5/support/bits-trunc-proofs.cert
-./rtl/rel5/support/bvecp.cert
-./rtl/rel5/support/bvecp-helpers.cert
-./rtl/rel5/support/bvecp-lemmas.cert
-./rtl/rel5/support/bvecp-proofs.cert
-./rtl/rel5/support/cat.cert
-./rtl/rel5/support/cat-def.cert
-./rtl/rel5/support/cat-proofs.cert
-./rtl/rel5/support/clocks.cert
-./rtl/rel5/support/decode.cert
-./rtl/rel5/support/decode-proofs.cert
-./rtl/rel5/support/drnd.cert
-./rtl/rel5/support/encode.cert
-./rtl/rel5/support/ereps.cert
-./rtl/rel5/support/ereps-proofs.cert
-./rtl/rel5/support/fadd.cert
-./rtl/rel5/support/fadd-extra0.cert
-./rtl/rel5/support/fadd-extra.cert
-./rtl/rel5/support/fast-and.cert
-./rtl/rel5/support/float.cert
-./rtl/rel5/support/float-extra.cert
-./rtl/rel5/support/ground-zero.cert
-./rtl/rel5/support/guards.cert
-./rtl/rel5/support/ireps.cert
-./rtl/rel5/support/land0.cert
-./rtl/rel5/support/land0-proofs.cert
-./rtl/rel5/support/land.cert
-./rtl/rel5/support/lextra0.cert
-./rtl/rel5/support/lextra.cert
-./rtl/rel5/support/lextra-proofs.cert
-./rtl/rel5/support/lior0.cert
-./rtl/rel5/support/lior0-proofs.cert
-./rtl/rel5/support/lior.cert
-./rtl/rel5/support/lnot.cert
-./rtl/rel5/support/lnot-proofs.cert
-./rtl/rel5/support/logand.cert
-./rtl/rel5/support/logand-proofs.cert
-./rtl/rel5/support/log.cert
-./rtl/rel5/support/log-equal.cert
-./rtl/rel5/support/logeqv.cert
-./rtl/rel5/support/logior1.cert
-./rtl/rel5/support/logior1-proofs.cert
-./rtl/rel5/support/logior.cert
-./rtl/rel5/support/logior-proofs.cert
-./rtl/rel5/support/lognot.cert
-./rtl/rel5/support/logorc1.cert
-./rtl/rel5/support/log-proofs.cert
-./rtl/rel5/support/logs.cert
-./rtl/rel5/support/logxor.cert
-./rtl/rel5/support/lop1.cert
-./rtl/rel5/support/lop1-proofs.cert
-./rtl/rel5/support/lop2.cert
-./rtl/rel5/support/lop2-proofs.cert
-./rtl/rel5/support/lop3.cert
-./rtl/rel5/support/lop3-proofs.cert
-./rtl/rel5/support/lxor0.cert
-./rtl/rel5/support/lxor0-proofs.cert
-./rtl/rel5/support/lxor.cert
-./rtl/rel5/support/merge2.cert
-./rtl/rel5/support/merge.cert
-./rtl/rel5/support/mod4.cert
-./rtl/rel5/support/model-helpers.cert
-./rtl/rel5/support/mulcat.cert
-./rtl/rel5/support/mulcat-proofs.cert
-./rtl/rel5/support/near.cert
-./rtl/rel5/support/near+.cert
-./rtl/rel5/support/near-proofs.cert
-./rtl/rel5/support/near+-proofs.cert
-./rtl/rel5/support/ocat.cert
-./rtl/rel5/support/oddr.cert
-./rtl/rel5/support/oddr-proofs.cert
-./rtl/rel5/support/openers.cert
-./rtl/rel5/support/package-defs.cert
-./rtl/rel5/support/rewrite-theory.cert
-./rtl/rel5/support/rnd.cert
-./rtl/rel5/support/rom-helpers.cert
-./rtl/rel5/support/round-extra.cert
-./rtl/rel5/support/rtlarr.cert
-./rtl/rel5/support/rtl.cert
-./rtl/rel5/support/setbitn.cert
-./rtl/rel5/support/setbitn-proofs.cert
-./rtl/rel5/support/setbits.cert
-./rtl/rel5/support/setbits-proofs.cert
-./rtl/rel5/support/sgn.cert
-./rtl/rel5/support/shft.cert
-./rtl/rel5/support/simple-loop-helpers.cert
-./rtl/rel5/support/simplify-model-helpers.cert
-./rtl/rel5/support/stick.cert
-./rtl/rel5/support/stick-proofs.cert
-./rtl/rel5/support/sticky.cert
-./rtl/rel5/support/sticky-proofs.cert
-./rtl/rel5/support/sumbits.cert
-./rtl/rel5/support/top1.cert
-./rtl/rel5/support/top.cert
-./rtl/rel5/support/trunc.cert
-./rtl/rel5/support/trunc-proofs.cert
-./rtl/rel5/support/util.cert
-./rtl/rel5/user/away.cert
-./rtl/rel5/user/bias.cert
-./rtl/rel5/user/bitn.cert
-./rtl/rel5/user/bits.cert
-./rtl/rel5/user/bits-trunc.cert
-./rtl/rel5/user/brat.cert
-./rtl/rel5/user/bvecp.cert
-./rtl/rel5/user/cat.cert
-./rtl/rel5/user/decode.cert
-./rtl/rel5/user/ereps.cert
-./rtl/rel5/user/land.cert
-./rtl/rel5/user/lextra.cert
-./rtl/rel5/user/lior.cert
-./rtl/rel5/user/lnot.cert
-./rtl/rel5/user/logior1.cert
-./rtl/rel5/user/lxor.cert
-./rtl/rel5/user/mulcat.cert
-./rtl/rel5/user/near.cert
-./rtl/rel5/user/setbitn.cert
-./rtl/rel5/user/setbits.cert
-./rtl/rel5/user/stick.cert
-./rtl/rel5/user/sumbits.cert
-./rtl/rel5/user/top.cert
-./rtl/rel5/user/trunc.cert
-# omitting rtl/rel7/  (and all its subdirectories)
-./rtl/rel8/arithmetic/arith2.cert
-./rtl/rel8/arithmetic/arith.cert
-./rtl/rel8/arithmetic/basic.cert
-./rtl/rel8/arithmetic/cg.cert
-./rtl/rel8/arithmetic/common-factor.cert
-./rtl/rel8/arithmetic/common-factor-defuns.cert
-./rtl/rel8/arithmetic/complex-rationalp.cert
-./rtl/rel8/arithmetic/denominator.cert
-./rtl/rel8/arithmetic/even-odd2.cert
-./rtl/rel8/arithmetic/even-odd2-proofs.cert
-./rtl/rel8/arithmetic/even-odd.cert
-./rtl/rel8/arithmetic/expo.cert
-./rtl/rel8/arithmetic/expo-proofs.cert
-./rtl/rel8/arithmetic/expt.cert
-./rtl/rel8/arithmetic/expt-proofs.cert
-./rtl/rel8/arithmetic/extra-rules.cert
-./rtl/rel8/arithmetic/fl.cert
-./rtl/rel8/arithmetic/fl-expt.cert
-./rtl/rel8/arithmetic/fl-hacks.cert
-./rtl/rel8/arithmetic/floor.cert
-./rtl/rel8/arithmetic/floor-proofs.cert
-./rtl/rel8/arithmetic/fl-proofs.cert
-./rtl/rel8/arithmetic/fp2.cert
-./rtl/rel8/arithmetic/fp.cert
-./rtl/rel8/arithmetic/ground-zero.cert
-./rtl/rel8/arithmetic/hacks.cert
-./rtl/rel8/arithmetic/induct.cert
-./rtl/rel8/arithmetic/integerp.cert
-./rtl/rel8/arithmetic/inverted-factor.cert
-./rtl/rel8/arithmetic/mod.cert
-./rtl/rel8/arithmetic/mod-expt.cert
-./rtl/rel8/arithmetic/mod-proofs.cert
-./rtl/rel8/arithmetic/negative-syntaxp.cert
-./rtl/rel8/arithmetic/nniq.cert
-./rtl/rel8/arithmetic/numerator.cert
-./rtl/rel8/arithmetic/power2p.cert
-./rtl/rel8/arithmetic/predicate.cert
-./rtl/rel8/arithmetic/product.cert
-./rtl/rel8/arithmetic/product-proofs.cert
-./rtl/rel8/arithmetic/rationalp.cert
-./rtl/rel8/arithmetic/top.cert
-./rtl/rel8/arithmetic/unary-divide.cert
-./rtl/rel8/arithmetic/x-2xx.cert
-./rtl/rel8/lib/add.cert
-./rtl/rel8/lib/arith.cert
-./rtl/rel8/lib/basic.cert
-./rtl/rel8/lib/bits.cert
-./rtl/rel8/lib/bvecp-helpers.cert
-./rtl/rel8/lib/bvecp-raw-helpers.cert
-./rtl/rel8/lib/clocks.cert
-./rtl/rel8/lib/float.cert
-./rtl/rel8/lib/log.cert
-./rtl/rel8/lib/logn2log.cert
-./rtl/rel8/lib/logn.cert
-./rtl/rel8/lib/mult.cert
-./rtl/rel8/lib/openers.cert
-./rtl/rel8/lib/package-defs.cert
-./rtl/rel8/lib/reps.cert
-./rtl/rel8/lib/rom-helpers.cert
-./rtl/rel8/lib/round.cert
-./rtl/rel8/lib/rtlarr.cert
-./rtl/rel8/lib/rtl.cert
-./rtl/rel8/lib/simple-loop-helpers.cert
-./rtl/rel8/lib/simplify-model-helpers.cert
-./rtl/rel8/lib/top.cert
-./rtl/rel8/lib/util.cert
-./rtl/rel8/support/lib1/add.cert
-./rtl/rel8/support/lib1/arith.cert
-./rtl/rel8/support/lib1/basic.cert
-./rtl/rel8/support/lib1/bits.cert
-./rtl/rel8/support/lib1/bvecp-helpers.cert
-./rtl/rel8/support/lib1/bvecp-raw-helpers.cert
-./rtl/rel8/support/lib1/clocks.cert
-./rtl/rel8/support/lib1.delta1/arith.cert
-./rtl/rel8/support/lib1.delta1/arith-extra.cert
-./rtl/rel8/support/lib1.delta1/basic.cert
-./rtl/rel8/support/lib1.delta1/basic-extra.cert
-./rtl/rel8/support/lib1.delta1/bits.cert
-./rtl/rel8/support/lib1.delta1/bits-extra.cert
-./rtl/rel8/support/lib1.delta1/bvecp-raw-helpers.cert
-./rtl/rel8/support/lib1.delta1/bvecp-raw-helpers-extra.cert
-./rtl/rel8/support/lib1.delta1/float.cert
-./rtl/rel8/support/lib1.delta1/float-extra2.cert
-./rtl/rel8/support/lib1.delta1/mult.cert
-./rtl/rel8/support/lib1.delta1/mult-proofs.cert
-./rtl/rel8/support/lib1.delta1/round.cert
-./rtl/rel8/support/lib1.delta1/round-extra2.cert
-./rtl/rel8/support/lib1.delta1/simple-loop-helpers.cert
-./rtl/rel8/support/lib1.delta1/simple-loop-helpers-extra.cert
-./rtl/rel8/support/lib1.delta2/float.cert
-./rtl/rel8/support/lib1.delta2/float-extra.cert
-./rtl/rel8/support/lib1/float.cert
-./rtl/rel8/support/lib1/log.cert
-./rtl/rel8/support/lib1/openers.cert
-./rtl/rel8/support/lib1/package-defs.cert
-./rtl/rel8/support/lib1/reps.cert
-./rtl/rel8/support/lib1/rom-helpers.cert
-./rtl/rel8/support/lib1/round.cert
-./rtl/rel8/support/lib1/rtlarr.cert
-./rtl/rel8/support/lib1/rtl.cert
-./rtl/rel8/support/lib1/simple-loop-helpers.cert
-./rtl/rel8/support/lib1/simplify-model-helpers.cert
-./rtl/rel8/support/lib1/top.cert
-./rtl/rel8/support/lib1/util.cert
-./rtl/rel8/support/lib2/add.cert
-./rtl/rel8/support/lib2/arith.cert
-./rtl/rel8/support/lib2/base.cert
-./rtl/rel8/support/lib2/basic.cert
-./rtl/rel8/support/lib2/bits.cert
-./rtl/rel8/support/lib2/bvecp-helpers.cert
-./rtl/rel8/support/lib2/bvecp-raw-helpers.cert
-./rtl/rel8/support/lib2/clocks.cert
-./rtl/rel8/support/lib2.delta1/add.cert
-./rtl/rel8/support/lib2.delta1/add-new.cert
-./rtl/rel8/support/lib2.delta1/add-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/add-proofs.cert
-./rtl/rel8/support/lib2.delta1/arith.cert
-./rtl/rel8/support/lib2.delta1/bits.cert
-./rtl/rel8/support/lib2.delta1/bits-new.cert
-./rtl/rel8/support/lib2.delta1/bits-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/bits-proofs.cert
-./rtl/rel8/support/lib2.delta1/bvecp-helpers.cert
-./rtl/rel8/support/lib2.delta1/bvecp-raw-helpers.cert
-./rtl/rel8/support/lib2.delta1/bvecp-raw-helpers-proofs.cert
-./rtl/rel8/support/lib2.delta1/float.cert
-./rtl/rel8/support/lib2.delta1/float-new.cert
-./rtl/rel8/support/lib2.delta1/float-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/float-proofs.cert
-./rtl/rel8/support/lib2.delta1/log.cert
-./rtl/rel8/support/lib2.delta1/logn2log.cert
-./rtl/rel8/support/lib2.delta1/logn2log-proofs.cert
-./rtl/rel8/support/lib2.delta1/logn.cert
-./rtl/rel8/support/lib2.delta1/log-new.cert
-./rtl/rel8/support/lib2.delta1/log-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/logn-new.cert
-./rtl/rel8/support/lib2.delta1/logn-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/logn-proofs.cert
-./rtl/rel8/support/lib2.delta1/log-proofs.cert
-./rtl/rel8/support/lib2.delta1/log-support.cert
-./rtl/rel8/support/lib2.delta1/log-support-proofs.cert
-./rtl/rel8/support/lib2.delta1/mult.cert
-./rtl/rel8/support/lib2.delta1/mult-new.cert
-./rtl/rel8/support/lib2.delta1/mult-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/mult-proofs.cert
-./rtl/rel8/support/lib2.delta1/reps.cert
-./rtl/rel8/support/lib2.delta1/reps-new.cert
-./rtl/rel8/support/lib2.delta1/reps-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/reps-proofs.cert
-./rtl/rel8/support/lib2.delta1/round.cert
-./rtl/rel8/support/lib2.delta1/round-new.cert
-./rtl/rel8/support/lib2.delta1/round-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/round-proofs.cert
-./rtl/rel8/support/lib2.delta1/rtlarr.cert
-./rtl/rel8/support/lib2.delta1/rtlarr-new.cert
-./rtl/rel8/support/lib2.delta1/rtl.cert
-./rtl/rel8/support/lib2.delta1/rtl-new.cert
-./rtl/rel8/support/lib2.delta1/rtl-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/rtl-proofs.cert
-./rtl/rel8/support/lib2.delta1/simple-loop-helpers.cert
-./rtl/rel8/support/lib2.delta1/simple-loop-helpers-proofs.cert
-./rtl/rel8/support/lib2.delta1/simplify-model-helpers.cert
-./rtl/rel8/support/lib2.delta1/simplify-model-helpers-new.cert
-./rtl/rel8/support/lib2.delta1/simplify-model-helpers-new-proofs.cert
-./rtl/rel8/support/lib2.delta1/simplify-model-helpers-proofs.cert
-./rtl/rel8/support/lib2.delta1/top.cert
-./rtl/rel8/support/lib2.delta1/util.cert
-./rtl/rel8/support/lib2.delta2/add.cert
-./rtl/rel8/support/lib2.delta2/add-lib.cert
-./rtl/rel8/support/lib2.delta2/base.cert
-./rtl/rel8/support/lib2.delta2/bits.cert
-./rtl/rel8/support/lib2.delta2/log.cert
-./rtl/rel8/support/lib2/float.cert
-./rtl/rel8/support/lib2/log.cert
-./rtl/rel8/support/lib2/mult.cert
-./rtl/rel8/support/lib2/openers.cert
-./rtl/rel8/support/lib2/package-defs.cert
-./rtl/rel8/support/lib2/reps.cert
-./rtl/rel8/support/lib2/rom-helpers.cert
-./rtl/rel8/support/lib2/round.cert
-./rtl/rel8/support/lib2/rtlarr.cert
-./rtl/rel8/support/lib2/rtl.cert
-./rtl/rel8/support/lib2/simple-loop-helpers.cert
-./rtl/rel8/support/lib2/simplify-model-helpers.cert
-./rtl/rel8/support/lib2/top.cert
-./rtl/rel8/support/lib2/util.cert
-./rtl/rel8/support/support/add3.cert
-./rtl/rel8/support/support/add3-proofs.cert
-./rtl/rel8/support/support/all-ones.cert
-./rtl/rel8/support/support/ash.cert
-./rtl/rel8/support/support/away.cert
-./rtl/rel8/support/support/away-proofs.cert
-./rtl/rel8/support/support/badguys.cert
-./rtl/rel8/support/support/bias.cert
-./rtl/rel8/support/support/bias-proofs.cert
-./rtl/rel8/support/support/bitn.cert
-./rtl/rel8/support/support/bitn-proofs.cert
-./rtl/rel8/support/support/bits.cert
-./rtl/rel8/support/support/bits-proofs.cert
-./rtl/rel8/support/support/bits-trunc.cert
-./rtl/rel8/support/support/bits-trunc-proofs.cert
-./rtl/rel8/support/support/bvecp.cert
-./rtl/rel8/support/support/bvecp-helpers.cert
-./rtl/rel8/support/support/bvecp-lemmas.cert
-./rtl/rel8/support/support/bvecp-proofs.cert
-./rtl/rel8/support/support/cat.cert
-./rtl/rel8/support/support/cat-def.cert
-./rtl/rel8/support/support/cat-proofs.cert
-./rtl/rel8/support/support/clocks.cert
-./rtl/rel8/support/support/decode.cert
-./rtl/rel8/support/support/decode-proofs.cert
-./rtl/rel8/support/support/drnd-original.cert
-./rtl/rel8/support/support/encode.cert
-./rtl/rel8/support/support/ereps.cert
-./rtl/rel8/support/support/ereps-proofs.cert
-./rtl/rel8/support/support/fadd.cert
-./rtl/rel8/support/support/fadd-extra0.cert
-./rtl/rel8/support/support/fadd-extra.cert
-./rtl/rel8/support/support/fast-and.cert
-./rtl/rel8/support/support/float.cert
-./rtl/rel8/support/support/float-extra.cert
-./rtl/rel8/support/support/ground-zero.cert
-./rtl/rel8/support/support/guards.cert
-./rtl/rel8/support/support/ireps.cert
-./rtl/rel8/support/support/land0.cert
-./rtl/rel8/support/support/land0-proofs.cert
-./rtl/rel8/support/support/land.cert
-./rtl/rel8/support/support/lextra0.cert
-./rtl/rel8/support/support/lextra.cert
-./rtl/rel8/support/support/lextra-proofs.cert
-./rtl/rel8/support/support/lior0.cert
-./rtl/rel8/support/support/lior0-proofs.cert
-./rtl/rel8/support/support/lior.cert
-./rtl/rel8/support/support/lnot.cert
-./rtl/rel8/support/support/lnot-proofs.cert
-./rtl/rel8/support/support/logand.cert
-./rtl/rel8/support/support/logand-proofs.cert
-./rtl/rel8/support/support/log.cert
-./rtl/rel8/support/support/log-equal.cert
-./rtl/rel8/support/support/logeqv.cert
-./rtl/rel8/support/support/logior1.cert
-./rtl/rel8/support/support/logior1-proofs.cert
-./rtl/rel8/support/support/logior.cert
-./rtl/rel8/support/support/logior-proofs.cert
-./rtl/rel8/support/support/lognot.cert
-./rtl/rel8/support/support/logorc1.cert
-./rtl/rel8/support/support/log-proofs.cert
-./rtl/rel8/support/support/logs.cert
-./rtl/rel8/support/support/logxor.cert
-./rtl/rel8/support/support/lop1.cert
-./rtl/rel8/support/support/lop1-proofs.cert
-./rtl/rel8/support/support/lop2.cert
-./rtl/rel8/support/support/lop2-proofs.cert
-./rtl/rel8/support/support/lop3.cert
-./rtl/rel8/support/support/lop3-proofs.cert
-./rtl/rel8/support/support/lxor0.cert
-./rtl/rel8/support/support/lxor0-proofs.cert
-./rtl/rel8/support/support/lxor.cert
-./rtl/rel8/support/support/merge2.cert
-./rtl/rel8/support/support/merge.cert
-./rtl/rel8/support/support/mod4.cert
-./rtl/rel8/support/support/model-helpers.cert
-./rtl/rel8/support/support/mulcat.cert
-./rtl/rel8/support/support/mulcat-proofs.cert
-./rtl/rel8/support/support/near.cert
-./rtl/rel8/support/support/near+.cert
-./rtl/rel8/support/support/near-proofs.cert
-./rtl/rel8/support/support/near+-proofs.cert
-./rtl/rel8/support/support/ocat.cert
-./rtl/rel8/support/support/oddr.cert
-./rtl/rel8/support/support/oddr-proofs.cert
-./rtl/rel8/support/support/openers.cert
-./rtl/rel8/support/support/package-defs.cert
-./rtl/rel8/support/support/rewrite-theory.cert
-./rtl/rel8/support/support/rnd.cert
-./rtl/rel8/support/support/rom-helpers.cert
-./rtl/rel8/support/support/round-extra.cert
-./rtl/rel8/support/support/rtlarr.cert
-./rtl/rel8/support/support/rtl.cert
-./rtl/rel8/support/support/setbitn.cert
-./rtl/rel8/support/support/setbitn-proofs.cert
-./rtl/rel8/support/support/setbits.cert
-./rtl/rel8/support/support/setbits-proofs.cert
-./rtl/rel8/support/support/sgn.cert
-./rtl/rel8/support/support/shft.cert
-./rtl/rel8/support/support/simple-loop-helpers.cert
-./rtl/rel8/support/support/simplify-model-helpers.cert
-./rtl/rel8/support/support/stick.cert
-./rtl/rel8/support/support/stick-proofs.cert
-./rtl/rel8/support/support/sticky.cert
-./rtl/rel8/support/support/sticky-proofs.cert
-./rtl/rel8/support/support/sumbits.cert
-./rtl/rel8/support/support/top1.cert
-./rtl/rel8/support/support/top.cert
-./rtl/rel8/support/support/trunc.cert
-./rtl/rel8/support/support/trunc-proofs.cert
-./rtl/rel8/support/support/util.cert
-./rtl/rel8/support/top/top.cert
-# ./security/des/des.cert (hons only)
-# ./security/des/des-test.cert (hons only)
-./security/jfkr/diffie-helman.cert
-./security/jfkr/encryption.cert
-./security/jfkr/jfkr.cert
-./security/jfkr/random.cert
-./security/suite-b/sha-2.cert
-./security/util/byte-operations.cert
-./serialize/serialize-tests2.cert
-./serialize/serialize-tests.cert
-./serialize/unsound-read.cert
-./sorting/bsort.cert
-./sorting/convert-perm-to-how-many.cert
-./sorting/equisort2.cert
-./sorting/equisort3.cert
-./sorting/equisort.cert
-./sorting/isort.cert
-./sorting/msort.cert
-./sorting/no-dups-qsort.cert
-./sorting/ordered-perms.cert
-./sorting/perm.cert
-./sorting/qsort.cert
-./sorting/sorts-equivalent2.cert
-./sorting/sorts-equivalent3.cert
-./sorting/sorts-equivalent.cert
-./std/io/base.cert
-./std/io/close-input-channel.cert
-./std/io/combine.cert
-./std/io/file-measure.cert
-./std/io/nthcdr-bytes.cert
-./std/io/open-input-channel.cert
-./std/io/open-input-channels.cert
-./std/io/peek-char.cert
-./std/io/read-byte.cert
-./std/io/read-char.cert
-./std/io/read-file-bytes.cert
-./std/io/read-file-characters.cert
-./std/io/read-file-characters-no-error.cert
-./std/io/read-file-lines.cert
-./std/io/read-file-objects.cert
-./std/io/read-ints.cert
-./std/io/read-object.cert
-./std/io/sign-byte.cert
-./std/io/signed-byte-listp.cert
-./std/io/take-bytes.cert
-./std/io/unsigned-byte-listp.cert
-./std/ks/base10-digit-charp.cert
-./std/ks/explode-atom.cert
-./std/ks/explode-nonnegative-integer.cert
-./std/ks/intern-in-package-of-symbol.cert
-./std/ks/string-append.cert
-./std/ks/two-nats-measure.cert
-./std/lists/app.cert
-./std/lists/append.cert
-./std/lists/coerce.cert
-./std/lists/consless-listp.cert
-./std/lists/equiv.cert
-./std/lists/final-cdr.cert
-./std/lists/flatten.cert
-./std/lists/list-defuns.cert
-./std/lists/list-fix.cert
-./std/lists/make-character-list.cert
-./std/lists/mfc-utils.cert
-./std/lists/nat-listp.cert
-./std/lists/nthcdr.cert
-./std/lists/prefixp.cert
-./std/lists/repeat.cert
-./std/lists/revappend.cert
-./std/lists/rev.cert
-./std/lists/reverse.cert
-./std/lists/sets.cert
-./std/lists/take.cert
-./str/abbrevs.cert
-./str/arithmetic.cert
-./str/case-conversion.cert
-./str/cat.cert
-./str/char-case.cert
-./str/digitp.cert
-./str/eqv.cert
-./str/fast-cat.cert
-./str/firstn-chars.cert
-./str/hexify.cert
-./str/html-encode.cert
-./str/ieqv.cert
-./str/iless.cert
-./str/iprefixp.cert
-./str/isort.cert
-./str/istrpos.cert
-./str/istrprefixp.cert
-./str/isubstrp.cert
-./str/natstr.cert
-./str/pad.cert
-./str/portcullis.cert
-./str/prefix-lines.cert
-./str/stringify.cert
-./str/strline.cert
-./str/strnatless.cert
-./str/strpos.cert
-./str/strprefixp.cert
-./str/strrpos.cert
-./str/strsplit.cert
-./str/strsubst.cert
-./str/strtok.cert
-./str/strval.cert
-./str/subseq.cert
-./str/substrp.cert
-./str/suffixp.cert
-./str/top.cert
-./symbolic/generic/assertions.cert
-./symbolic/generic/defsimulate.cert
-./symbolic/generic/factorial-jvm-correct.cert
-./symbolic/generic/measures.cert
-./symbolic/generic/partial-correctness.cert
-./symbolic/generic/tiny-fib-correct.cert
-./symbolic/generic/total-correctness.cert
-./symbolic/m5/demo.cert
-./symbolic/m5/utilities.cert
-./symbolic/tiny-fib/defstobj+.cert
-./symbolic/tiny-fib/fib-def.cert
-./symbolic/tiny-fib/tiny.cert
-./symbolic/tiny-fib/tiny-rewrites.cert
-./symbolic/tiny-triangle/tiny-triangle-correct.cert
-./symbolic/tiny-triangle/triangle-def.cert
-./system/compare-out-files.cert
-./system/convert-normalized-term-to-pairs.cert
-./system/extend-pathname.cert
-./system/f-put-global.cert
-./system/gather-dcls.cert
-./system/hl-addr-combine.cert
-./system/io.cert
-./system/legal-variablep.cert
-./system/meta-extract.cert
-# omitting system/pcert; provisional certification seems to cause problems here
-./system/pseudo-good-worldp.cert
-./system/pseudo-termp-lemmas.cert
-./system/subcor-var.cert
-./system/sublis-var.cert
-./system/subst-expr.cert
-./system/subst-var.cert
-./system/too-many-ifs.cert
-./system/top.cert
-./system/update-state.cert
-./system/verified-termination-and-guards.cert
-./system/worldp-check.cert
-./taspi/code/brlens/brlens.cert
-./taspi/code/brlens/trees-with-brlens.cert
-./taspi/code/build/build-term.cert
-./taspi/code/build/build-term-guards.cert
-./taspi/code/fringes/fringes.cert
-./taspi/code/fringes/fringes-guards.cert
-./taspi/code/fringes/fringes-props.cert
-./taspi/code/gen-helper/bdd-functions.cert
-./taspi/code/gen-helper/extra.cert
-./taspi/code/gen-helper/fast-lists.cert
-./taspi/code/gen-helper/sets.cert
-./taspi/code/gen-helper/top.cert
-./taspi/code/gen-trees/app-rev-lists.cert
-./taspi/code/gen-trees/btrees-bdds.cert
-./taspi/code/gen-trees/btrees-bdds-sets.cert
-./taspi/code/gen-trees/btrees.cert
-./taspi/code/gen-trees/sets-lists-trees.cert
-./taspi/code/gen-trees/top.cert
-./taspi/code/gen-trees/tree-predicates.cert
-./taspi/code/replete/replete.cert
-./taspi/code/replete/replete-guards.cert
-./taspi/code/replete/replete-helper.cert
-./taspi/code/sequences/align.cert
-./taspi/code/sequences/p-inform.cert
-./taspi/code/sequences/seqs.cert
-./taspi/code/tree-manip/insertion-based-sort.cert
-./taspi/code/tree-manip/merge-based-sort.cert
-./taspi/code/tree-manip/mv-root.cert
-./taspi/code/tree-manip/quicksort.cert
-./taspi/code/tree-manip/sort-help.cert
-./taspi/code/tree-manip/top.cert
-./taspi/database/db.cert
-./taspi/database/db-from-list.cert
-./taspi/database/entry.cert
-./taspi/database/filters.cert
-./taspi/database/props.cert
-./taspi/proofs/fringes-taspi.cert
-./taspi/proofs/omerge-good-order.cert
-./taspi/proofs/sets.cert
-./taspi/sets-input/consensus.cert
-./taspi/sets-input/greedy.cert
-./taspi/sets-input/mast.cert
-./taspi/sets-input/mct.cert
-./taspi/sets-input/multipolar-loose.cert
-./taspi/sets-input/top.cert
-./taspi/sets-input/tree-compat.cert
-./taspi/sets-input/tree-support-in-set.cert
-./taspi/single-input/taxa-based.cert
-./taspi/single-input/tree-stats.cert
-./taspi/tree-distance/rf.cert
-./taspi/tree-distance/symm-diff.cert
-./taspi/tree-generation/branch-and-bound/bandb.cert
-./taspi/tree-generation/distance-based/naive-quartet-method.cert
-./taspi/tree-generation/heuristics/do-search.cert
-./taspi/tree-generation/heuristics/spr.cert
-./taspi/tree-generation/heuristics/tbr.cert
-./taspi/tree-generation/tree-gen-helper/basics.cert
-./taspi/tree-score/ambig-score.cert
-./taspi/tree-score/circle-scoring.cert
-./taspi/tree-score/costs.cert
-./taspi/tree-score/efficient-pscores.cert
-./taspi/tree-score/efficient-pscores-help.cert
-./taspi/tree-score/fitch-scoring.cert
-./taspi/tree-score/min-length.cert
-./taspi/tree-score/opt-pairwise.cert
-./taspi/tree-score/pscores.cert
-./tau/bounders/elementary-bounders.cert
-./tau/bounders/find-maximal-1d.cert
-./tau/bounders/find-maximal-2d.cert
-./tau/bounders/find-minimal-1d.cert
-./tau/bounders/find-minimal-2d.cert
-./textbook/chap10/ac-example.cert
-./textbook/chap10/adder.cert
-./textbook/chap10/compiler.cert
-./textbook/chap10/fact.cert
-./textbook/chap10/insertion-sort.cert
-./textbook/chap10/tree.cert
-./textbook/chap11/compress.cert
-./textbook/chap11/encap.cert
-./textbook/chap11/finite-sets.cert
-./textbook/chap11/how-many-soln1.cert
-./textbook/chap11/how-many-soln2.cert
-./textbook/chap11/mergesort.cert
-./textbook/chap11/perm-append.cert
-./textbook/chap11/perm.cert
-./textbook/chap11/qsort.cert
-./textbook/chap11/starters.cert
-./textbook/chap11/summations-book.cert
-./textbook/chap11/summations.cert
-./textbook/chap11/tautology.cert
-./textbook/chap11/xtr2.cert
-./textbook/chap11/xtr.cert
-./textbook/chap3/programs.cert
-./textbook/chap4/solutions-logic-mode.cert
-./textbook/chap4/solutions-program-mode.cert
-./textbook/chap5/solutions.cert
-./textbook/chap6/selected-solutions.cert
-./tools/bstar.cert
-./tools/case-splitting-rules.cert
-./tools/clone-stobj.cert
-./tools/cws.cert
-./tools/defconsts.cert
-./tools/defevaluator-fast.cert
-./tools/def-functional-instance.cert
-./tools/defined-const.cert
-./tools/define-keyed-function.cert
-./tools/defmacfun.cert
-./tools/defredundant.cert
-./tools/defsum.cert
-./tools/deftuple.cert
-./tools/do-not.cert
-./tools/easy-simplify.cert
-./tools/fake-event.cert
-./tools/flag.cert
-./tools/include-raw.cert
-./tools/in-raw-mode.cert
-./tools/mv-nth.cert
-./tools/oracle-eval.cert
-./tools/oracle-eval-real.cert
-./tools/pack.cert
-./tools/pattern-match.cert
-./tools/plev-ccl.cert
-./tools/plev.cert
-./tools/rulesets.cert
-./tools/safe-case.cert
-./tools/saved-errors.cert
-./tools/stobj-frame.cert
-./tools/stobj-help.cert
-./tools/templates.cert
-./tools/theory-tools.cert
-./tools/time-dollar-with-gc.cert
-./tools/types-misc.cert
-./tools/with-arith5-help.cert
-./tools/with-quoted-forms.cert
-./tutorial-problems/introductory-challenge-problem-4-athena.cert
-./tutorial-problems/introductory-challenge-problem-4.cert
-./unicode/partition.cert
-./unicode/read-utf8.cert
-./unicode/sum-list.cert
-./unicode/uchar.cert
-./unicode/utf8-decode.cert
-./unicode/utf8-encode.cert
-./unicode/utf8-table35.cert
-./unicode/utf8-table36.cert
-./unicode/z-listp.cert
-./workshops/1999/calculus/solutions/mesh-append.cert
-./workshops/1999/calculus/solutions/mesh-make-partition.cert
-./workshops/1999/calculus/solutions/partition-defuns.cert
-./workshops/1999/calculus/solutions/partitionp-make-partition.cert
-./workshops/1999/calculus/solutions/partitionp-make-partition-rec.cert
-./workshops/1999/calculus/solutions/riemann-rcfn-helpers.cert
-./workshops/1999/compiler/compiler.cert
-./workshops/1999/compiler/evaluator.cert
-./workshops/1999/compiler/exercises.cert
-./workshops/1999/compiler/machine.cert
-./workshops/1999/compiler/proof1.cert
-./workshops/1999/compiler/proof.cert
-./workshops/1999/de-hdl/arity.cert
-./workshops/1999/de-hdl/de4.cert
-./workshops/1999/de-hdl/examples.cert
-./workshops/1999/de-hdl/help-defuns.cert
-./workshops/1999/de-hdl/measure.cert
-./workshops/1999/de-hdl/primitives.cert
-./workshops/1999/de-hdl/sts-okp.cert
-./workshops/1999/de-hdl/syntax.cert
-./workshops/1999/de-hdl/thm-example.cert
-./workshops/1999/embedded/Exercises/Exercise1-1/Exercise1.1.cert
-./workshops/1999/embedded/Exercises/Exercise1-2/Exercise1.2.cert
-./workshops/1999/embedded/Exercises/Exercise1-2/Minimal-Mod-Lemmas.cert
-./workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas.cert
-./workshops/1999/embedded/Exercises/Exercise1-3/Exercise1.3.cert
-./workshops/1999/embedded/Proof-Of-Contribution/CRT.cert
-./workshops/1999/embedded/Proof-Of-Contribution/CRTcorollaries.cert
-./workshops/1999/embedded/Proof-Of-Contribution/Disjoint-lists.cert
-./workshops/1999/embedded/Proof-Of-Contribution/Generic.cert
-./workshops/1999/embedded/Proof-Of-Contribution/Mapping.cert
-./workshops/1999/embedded/Proof-Of-Contribution/Memory-Assoc.cert
-./workshops/1999/embedded/Proof-Of-Contribution/Minimal-Mod-Lemmas.cert
-./workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas.cert
-./workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness.cert
-./workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Correctness-OneCycle.cert
-./workshops/1999/embedded/Proof-Of-Contribution/Proof-Of-Equiv-From-M-Corr.cert
-./workshops/1999/graph/find-path1.cert
-./workshops/1999/graph/find-path2.cert
-./workshops/1999/graph/find-path3.cert
-./workshops/1999/graph/helpers.cert
-./workshops/1999/graph/linear-find-path.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/alls.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/base.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/close.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/cnf.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/derive.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/flip.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/instance.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/keval.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/modeler.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/nnf.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/paramod.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/permutations.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/prover.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/pull.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/rename.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/resolve.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/sets.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/simplify.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/stage.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/substitution.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/sugar.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/top.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/variables.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.cert
-./workshops/1999/ivy/ivy-v2/ivy-sources/xeval.cert
-./workshops/1999/knuth-91/aof.cert
-./workshops/1999/knuth-91/exercise1.cert
-./workshops/1999/knuth-91/exercise2.cert
-./workshops/1999/knuth-91/exercise3.cert
-./workshops/1999/knuth-91/exercise4a.cert
-./workshops/1999/knuth-91/exercise4b.cert
-./workshops/1999/knuth-91/exercise5.cert
-./workshops/1999/knuth-91/exercise6a.cert
-./workshops/1999/knuth-91/exercise6b.cert
-./workshops/1999/knuth-91/exercise7a.cert
-./workshops/1999/knuth-91/exercise7b.cert
-./workshops/1999/knuth-91/knuth-arch.cert
-./workshops/1999/mu-calculus/book/fast-sets.cert
-./workshops/1999/mu-calculus/book/fixpoints.cert
-./workshops/1999/mu-calculus/book/models.cert
-./workshops/1999/mu-calculus/book/relations.cert
-./workshops/1999/mu-calculus/book/semantics.cert
-./workshops/1999/mu-calculus/book/sets.cert
-./workshops/1999/mu-calculus/book/syntax.cert
-./workshops/1999/mu-calculus/solutions/ctl.cert
-./workshops/1999/mu-calculus/solutions/defung.cert
-./workshops/1999/mu-calculus/solutions/fast-sets.cert
-./workshops/1999/mu-calculus/solutions/fixpoints.cert
-./workshops/1999/mu-calculus/solutions/meta.cert
-./workshops/1999/mu-calculus/solutions/models.cert
-./workshops/1999/mu-calculus/solutions/perm.cert
-./workshops/1999/mu-calculus/solutions/relations.cert
-./workshops/1999/mu-calculus/solutions/semantics.cert
-./workshops/1999/mu-calculus/solutions/sets.cert
-./workshops/1999/mu-calculus/solutions/syntax.cert
-# omitting ./workshops/1999/multiplier/
-./workshops/1999/pipeline/basic-def.cert
-./workshops/1999/pipeline/basic-lemmas.cert
-./workshops/1999/pipeline/b-ops-aux.cert
-./workshops/1999/pipeline/b-ops-aux-def.cert
-./workshops/1999/pipeline/exercise.cert
-./workshops/1999/pipeline/ihs.cert
-./workshops/1999/pipeline/model.cert
-./workshops/1999/pipeline/proof.cert
-./workshops/1999/pipeline/table-def.cert
-./workshops/1999/pipeline/trivia.cert
-./workshops/1999/pipeline/utils.cert
-./workshops/1999/simulator/exercises.cert
-./workshops/1999/simulator/tiny.cert
-./workshops/1999/ste/assertion.cert
-./workshops/1999/ste/boolean.cert
-./workshops/1999/ste/circuit.cert
-./workshops/1999/ste/example.cert
-./workshops/1999/ste/expression.cert
-./workshops/1999/ste/fundamental.cert
-./workshops/1999/ste/inference.cert
-./workshops/1999/ste/lemma-4.cert
-./workshops/1999/ste/run.cert
-./workshops/1999/ste/state.cert
-./workshops/1999/ste/trajectory.cert
-./workshops/1999/ste/util.cert
-./workshops/1999/vhdl/exercises.cert
-./workshops/1999/vhdl/fact.cert
-./workshops/1999/vhdl/fact-proof.cert
-./workshops/1999/vhdl/vhdl.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/base.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/compile.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/cstate.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/expr.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/gensym-e.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/lstate.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/mstate.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/pstate.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/setup.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/simulator.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/stepproc0.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/stepproc1.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/stepproc2.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/stepprocess.cert
-./workshops/2000/lusk-mccune/lusk-mccune-final/util.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/ma128net-ma128serial.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/netlist/netlist.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/ma128serial-ma128.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/serial/serial.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/isa128.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/128/top/ma128-isa128.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/isa.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/ma/ma-isa-flush.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-encap-wfbisim.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/det-macros.cert
-./workshops/2000/manolios/pipeline/pipeline/deterministic-systems/top/inst.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/netlist/ma128intnet-ma128intserial.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/serial/ma128intserial-ma128int.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/isa128int.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/128/top/ma128int-isa128int.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/isa-int.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/int/ma-int-isa-int.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/isa.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/ma/ma-isa.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/inst.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-encap-wfbisim.cert
-./workshops/2000/manolios/pipeline/pipeline/non-deterministic-systems/top/non-det-macros.cert
-./workshops/2000/manolios/pipeline/pipeline/top/alist-thms.cert
-./workshops/2000/manolios/pipeline/pipeline/top/defun-weak-sk.cert
-./workshops/2000/manolios/pipeline/pipeline/top/ihs.cert
-./workshops/2000/manolios/pipeline/pipeline/top/meta.cert
-./workshops/2000/manolios/pipeline/pipeline/top/nth-thms.cert
-./workshops/2000/manolios/pipeline/trivial/basic-def.cert
-./workshops/2000/manolios/pipeline/trivial/basic-lemmas.cert
-./workshops/2000/manolios/pipeline/trivial/b-ops-aux.cert
-./workshops/2000/manolios/pipeline/trivial/b-ops-aux-def.cert
-./workshops/2000/manolios/pipeline/trivial/ihs.cert
-./workshops/2000/manolios/pipeline/trivial/model.cert
-./workshops/2000/manolios/pipeline/trivial/proof.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/basic-def.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/basic-lemmas.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/b-ops-aux-def.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/ihs.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/model.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/proof.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/table-def.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/trivia.cert
-./workshops/2000/manolios/pipeline/trivial/sawada-model/utils.cert
-./workshops/2000/manolios/pipeline/trivial/table-def.cert
-./workshops/2000/manolios/pipeline/trivial/trivia.cert
-./workshops/2000/manolios/pipeline/trivial/utils.cert
-./workshops/2000/medina/polynomials/addition.cert
-./workshops/2000/medina/polynomials/congruences-1.cert
-./workshops/2000/medina/polynomials/congruences-2.cert
-./workshops/2000/medina/polynomials/examples.cert
-./workshops/2000/medina/polynomials/lexicographical-ordering.cert
-./workshops/2000/medina/polynomials/monomial.cert
-./workshops/2000/medina/polynomials/multiplication.cert
-./workshops/2000/medina/polynomials/negation.cert
-./workshops/2000/medina/polynomials/normal-form.cert
-./workshops/2000/medina/polynomials/polynomial.cert
-./workshops/2000/medina/polynomials/term.cert
-./workshops/2000/moore-manolios/partial-functions/defpun.cert
-./workshops/2000/moore-manolios/partial-functions/defpun-original.cert
-./workshops/2000/moore-manolios/partial-functions/examples.cert
-./workshops/2000/moore-manolios/partial-functions/mod-1-property.cert
-./workshops/2000/moore-manolios/partial-functions/report.cert
-./workshops/2000/moore-manolios/partial-functions/tjvm.cert
-./workshops/2000/moore-manolios/partial-functions/tjvm-examples.cert
-./workshops/2000/ruiz/multiset/defmul.cert
-./workshops/2000/ruiz/multiset/examples/ackermann/ackermann.cert
-./workshops/2000/ruiz/multiset/examples/mccarthy-91/mccarthy-91.cert
-./workshops/2000/ruiz/multiset/examples/newman/abstract-proofs.cert
-./workshops/2000/ruiz/multiset/examples/newman/confluence.cert
-./workshops/2000/ruiz/multiset/examples/newman/confluence-v0.cert
-./workshops/2000/ruiz/multiset/examples/newman/local-confluence.cert
-./workshops/2000/ruiz/multiset/examples/newman/newman.cert
-./workshops/2000/ruiz/multiset/multiset.cert
-./workshops/2000/russinoff-kaufmann/supporting-materials/constants.cert
-./workshops/2000/russinoff-kaufmann/supporting-materials/declarations.cert
-./workshops/2000/russinoff-kaufmann/supporting-materials/exec.cert
-./workshops/2000/russinoff-kaufmann/supporting-materials/inputs.cert
-./workshops/2000/russinoff-kaufmann/supporting-materials/main.cert
-./workshops/2000/russinoff-kaufmann/supporting-materials/model.cert
-./workshops/2000/russinoff-kaufmann/supporting-materials/pipe.cert
-./workshops/2000/russinoff-short/crt.cert
-./workshops/2000/russinoff-short/summary.cert
-./workshops/2000/sumners1/cdeq/cdeq-defs.cert
-./workshops/2000/sumners1/cdeq/cdeq-phase1.cert
-./workshops/2000/sumners1/cdeq/cdeq-phase2.cert
-./workshops/2000/sumners1/cdeq/cdeq-phase3.cert
-./workshops/2000/sumners1/cdeq/cdeq-phase4.cert
-./workshops/2000/sumners1/cdeq/records.cert
-./workshops/2000/sumners2/bdds/bdd-mgr.cert
-./workshops/2000/sumners2/bdds/bdd-prf.cert
-./workshops/2000/sumners2/bdds/bdd-spec.cert
-./workshops/2002/cowles-flat/support/flat-ackermann.cert
-./workshops/2002/cowles-flat/support/flat.cert
-./workshops/2002/cowles-flat/support/flat-nested.cert
-./workshops/2002/cowles-flat/support/flat-primitive.cert
-./workshops/2002/cowles-flat/support/flat-reverse.cert
-./workshops/2002/cowles-flat/support/flat-tail.cert
-./workshops/2002/cowles-flat/support/flat-z.cert
-./workshops/2002/cowles-primrec/support/bad-def1.cert
-./workshops/2002/cowles-primrec/support/bad-def.cert
-./workshops/2002/cowles-primrec/support/defpr.cert
-./workshops/2002/cowles-primrec/support/fix.cert
-./workshops/2002/cowles-primrec/support/primitive.cert
-./workshops/2002/cowles-primrec/support/tail.cert
-./workshops/2002/georgelin-borrione-ostier/support/acl2-transl.cert
-./workshops/2002/georgelin-borrione-ostier/support/generates-functions.cert
-./workshops/2002/georgelin-borrione-ostier/support/generates-theorems.cert
-./workshops/2002/georgelin-borrione-ostier/support/utils.cert
-./workshops/2002/kaufmann-sumners/support/records0.cert
-./workshops/2002/kaufmann-sumners/support/records.cert
-./workshops/2002/kaufmann-sumners/support/sets.cert
-./workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory.cert
-./workshops/2002/manolios-kaufmann/support/finite-set-theory/set-theory-original.cert
-./workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering.cert
-./workshops/2002/manolios-kaufmann/support/finite-set-theory/total-ordering-original.cert
-./workshops/2002/manolios-kaufmann/support/records/records.cert
-./workshops/2002/manolios-kaufmann/support/records/records-original.cert
-./workshops/2002/manolios-kaufmann/support/records/total-order.cert
-./workshops/2002/manolios-kaufmann/support/sorting/insertion-sort.cert
-./workshops/2002/manolios-kaufmann/support/sorting/perm.cert
-./workshops/2002/manolios-kaufmann/support/sorting/perm-order.cert
-./workshops/2002/manolios-kaufmann/support/sorting/quicksort.cert
-./workshops/2002/manolios-kaufmann/support/sorting/total-order.cert
-./workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-multiset.cert
-./workshops/2002/martin-alonso-hidalgo-ruiz/support/generic-theory.cert
-./workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-assoc.cert
-./workshops/2002/martin-alonso-hidalgo-ruiz/support/multiset-list.cert
-./workshops/2002/martin-alonso-perez-sancho/support/Adleman.cert
-./workshops/2002/medina-palomo-alonso/support/section-2/npol.cert
-./workshops/2002/medina-palomo-alonso/support/section-2/upol-1.cert
-./workshops/2002/medina-palomo-alonso/support/section-2/upol-2.cert
-./workshops/2002/medina-palomo-alonso/support/section-3/monomial.cert
-./workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-1.cert
-./workshops/2002/medina-palomo-alonso/support/section-3/npol-ordering-2.cert
-./workshops/2002/medina-palomo-alonso/support/section-3/ordinal-ordering.cert
-./workshops/2002/medina-palomo-alonso/support/section-3/term.cert
-./workshops/2002/medina-palomo-alonso/support/section-3/upol.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/basic.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dags.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/dag-unification.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/defpun.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-dags/support/terms.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/anti-unification.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/basic.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/lattice-of-terms.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/matching.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/mg-instance.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/renamings.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-definition-v0.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-subst.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/subsumption-well-founded.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/terms.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification.cert
-./workshops/2002/ruiz-alonso-hidalgo-martin-theory-terms/support/unification-pattern.cert
-./workshops/2003/austel/support/abs-type.cert
-./workshops/2003/cowles-gamboa-van-baalen_matrix/support/alist2.cert
-./workshops/2003/cowles-gamboa-van-baalen_matrix/support/array2.cert
-./workshops/2003/cowles-gamboa-van-baalen_matrix/support/matalg.cert
-./workshops/2003/cowles-gamboa-van-baalen_matrix/support/matrix.cert
-./workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs.cert
-./workshops/2003/gamboa-cowles-van-baalen/support/kalman-demo.cert
-./workshops/2003/gamboa-cowles-van-baalen/support/kalman-proof.cert
-./workshops/2003/gamboa-cowles-van-baalen/support/linalg.cert
-./workshops/2003/greve-wilding_defrecord/support/defrecord.cert
-./workshops/2003/greve-wilding_mbe/support/fpst.cert
-./workshops/2003/greve-wilding_mbe/support/run-fpst.cert
-# Omitting ./workshops/2003/greve-wilding-vanfleet/support/
-./workshops/2003/hbl/support/sol1.cert
-./workshops/2003/hbl/support/sol2.cert
-./workshops/2003/hendrix/support/madd.cert
-./workshops/2003/hendrix/support/matrices.cert
-./workshops/2003/hendrix/support/mdefthms.cert
-./workshops/2003/hendrix/support/mdefuns.cert
-./workshops/2003/hendrix/support/mentry.cert
-./workshops/2003/hendrix/support/mid.cert
-./workshops/2003/hendrix/support/mmult.cert
-./workshops/2003/hendrix/support/mscal.cert
-./workshops/2003/hendrix/support/msub.cert
-./workshops/2003/hendrix/support/mtrans.cert
-./workshops/2003/hendrix/support/mzero.cert
-./workshops/2003/hendrix/support/vector.cert
-# Omitting ./workshops/2003/kaufmann/support/
-./workshops/2003/matlin-mccune/support/simp.cert
-./workshops/2003/moore_rockwell/support/memory-taggings.cert
-./workshops/2003/moore_vcg/support/demo.cert
-./workshops/2003/moore_vcg/support/m5.cert
-./workshops/2003/moore_vcg/support/utilities.cert
-./workshops/2003/moore_vcg/support/vcg-examples.cert
-./workshops/2003/ray-matthews-tuttle/support/apply-total-order.cert
-./workshops/2003/ray-matthews-tuttle/support/bisimilarity.cert
-./workshops/2003/ray-matthews-tuttle/support/circuit-bisim.cert
-./workshops/2003/ray-matthews-tuttle/support/circuits.cert
-./workshops/2003/ray-matthews-tuttle/support/concrete-ltl.cert
-./workshops/2003/ray-matthews-tuttle/support/cone-of-influence.cert
-./workshops/2003/ray-matthews-tuttle/support/conjunction.cert
-./workshops/2003/ray-matthews-tuttle/support/impl-hack.cert
-./workshops/2003/ray-matthews-tuttle/support/ltl.cert
-./workshops/2003/ray-matthews-tuttle/support/records.cert
-./workshops/2003/ray-matthews-tuttle/support/reductions.cert
-./workshops/2003/ray-matthews-tuttle/support/sets.cert
-./workshops/2003/ray-matthews-tuttle/support/total-order.cert
-./workshops/2003/schmaltz-al-sammane-et-al/support/consistency.cert
-./workshops/2003/schmaltz-borrione/support/arbiter.cert
-./workshops/2003/schmaltz-borrione/support/decoder.cert
-./workshops/2003/schmaltz-borrione/support/inequalities.cert
-./workshops/2003/schmaltz-borrione/support/predicates.cert
-./workshops/2003/schmaltz-borrione/support/transfers.cert
-./workshops/2003/sumners/support/cfair.cert
-./workshops/2003/sumners/support/example1.cert
-./workshops/2003/sumners/support/example2.cert
-./workshops/2003/sumners/support/example3.cert
-./workshops/2003/sumners/support/fair1.cert
-./workshops/2003/sumners/support/fair2.cert
-./workshops/2003/sumners/support/n2n.cert
-./workshops/2003/sumners/support/simple.cert
-./workshops/2003/sustik/support/dickson.cert
-./workshops/2003/toma-borrione/support/bv-op-defthms.cert
-./workshops/2003/toma-borrione/support/bv-op-defuns.cert
-./workshops/2003/toma-borrione/support/misc.cert
-./workshops/2003/toma-borrione/support/padding-1-256.cert
-./workshops/2003/toma-borrione/support/padding-384-512.cert
-./workshops/2003/toma-borrione/support/parsing.cert
-./workshops/2003/toma-borrione/support/sha-1.cert
-./workshops/2003/toma-borrione/support/sha-256.cert
-./workshops/2003/toma-borrione/support/sha-384-512.cert
-./workshops/2003/toma-borrione/support/sha-functions.cert
-./workshops/2003/tsong/support/shim.cert
-./workshops/2004/cowles-gamboa/support/knuth.cert
-./workshops/2004/cowles-gamboa/support/tail-rec.cert
-./workshops/2004/cowles-gamboa/support/WyoM1.cert
-./workshops/2004/cowles-gamboa/support/WyoM1-correct.cert
-./workshops/2004/cowles-gamboa/support/WyoM1-utilities.cert
-./workshops/2004/davis/support/computed-hints.cert
-./workshops/2004/davis/support/fast.cert
-./workshops/2004/davis/support/instance.cert
-./workshops/2004/davis/support/map.cert
-./workshops/2004/davis/support/membership.cert
-./workshops/2004/davis/support/outer.cert
-./workshops/2004/davis/support/primitives.cert
-./workshops/2004/davis/support/quantify.cert
-./workshops/2004/davis/support/set-order.cert
-./workshops/2004/davis/support/sets.cert
-./workshops/2004/davis/support/sort.cert
-./workshops/2004/gameiro-manolios/support/interval.cert
-./workshops/2004/gameiro-manolios/support/nth-thms.cert
-./workshops/2004/gameiro-manolios/support/top-with-meta.cert
-./workshops/2004/gameiro-manolios/support/transversality.cert
-./workshops/2004/greve/support/defrecord.cert
-./workshops/2004/greve/support/mark.cert
-./workshops/2004/legato/support/generic-theories.cert
-./workshops/2004/legato/support/generic-theory-alternative-induction-mult.cert
-./workshops/2004/legato/support/generic-theory-alternative-induction-sum.cert
-./workshops/2004/legato/support/generic-theory-loop-invariant-mult.cert
-./workshops/2004/legato/support/generic-theory-loop-invariant-sum.cert
-./workshops/2004/legato/support/generic-theory-tail-recursion-mult.cert
-./workshops/2004/legato/support/generic-theory-tail-recursion-sum.cert
-./workshops/2004/legato/support/proof-by-generalization-mult.cert
-./workshops/2004/legato/support/proof-by-generalization-sum.cert
-./workshops/2004/manolios-srinivasan/support/Supporting-Books/det-macros.cert
-./workshops/2004/manolios-srinivasan/support/Supporting-Books/meta.cert
-./workshops/2004/manolios-srinivasan/support/Supporting-Books/records.cert
-./workshops/2004/manolios-srinivasan/support/Supporting-Books/seq.cert
-./workshops/2004/manolios-srinivasan/support/Supporting-Books/total-order.cert
-./workshops/2004/matthews-vroon/support/partial-clock-functions/efficient-simulator.cert
-./workshops/2004/matthews-vroon/support/partial-clock-functions/partial-clock-functions.cert
-./workshops/2004/matthews-vroon/support/tiny-fib-example/defstobj+.cert
-./workshops/2004/matthews-vroon/support/tiny-fib-example/fib-def.cert
-./workshops/2004/matthews-vroon/support/tiny-fib-example/partial-clock-functions.cert
-./workshops/2004/matthews-vroon/support/tiny-fib-example/tiny.cert
-./workshops/2004/matthews-vroon/support/tiny-fib-example/tiny-rewrites.cert
-./workshops/2004/ray/support/defcoerce.cert
-./workshops/2004/ray/support/defpun-exec.cert
-./workshops/2004/ray/support/generic.cert
-./workshops/2004/roach-fraij/support/roach-fraij-script.cert
-./workshops/2004/ruiz-et-al/support/basic.cert
-./workshops/2004/ruiz-et-al/support/dags.cert
-./workshops/2004/ruiz-et-al/support/dag-unification-rules.cert
-./workshops/2004/ruiz-et-al/support/lists.cert
-./workshops/2004/ruiz-et-al/support/matching.cert
-./workshops/2004/ruiz-et-al/support/prefix-unification-rules.cert
-./workshops/2004/ruiz-et-al/support/q-dag-unification.cert
-./workshops/2004/ruiz-et-al/support/q-dag-unification-rules.cert
-./workshops/2004/ruiz-et-al/support/q-dag-unification-st.cert
-./workshops/2004/ruiz-et-al/support/subsumption.cert
-./workshops/2004/ruiz-et-al/support/subsumption-subst.cert
-./workshops/2004/ruiz-et-al/support/terms-as-dag.cert
-./workshops/2004/ruiz-et-al/support/terms.cert
-./workshops/2004/sawada/support/bv.cert
-./workshops/2004/sawada/support/ihs.cert
-./workshops/2004/schmaltz-borrione/support/collect_msg_book.cert
-./workshops/2004/schmaltz-borrione/support/getting_rid_of_mod.cert
-./workshops/2004/schmaltz-borrione/support/intersect.cert
-./workshops/2004/schmaltz-borrione/support/local_trip_book.cert
-./workshops/2004/schmaltz-borrione/support/make_travel_list_book.cert
-./workshops/2004/schmaltz-borrione/support/mod_lemmas.cert
-./workshops/2004/schmaltz-borrione/support/node.cert
-./workshops/2004/schmaltz-borrione/support/octagon_book.cert
-./workshops/2004/schmaltz-borrione/support/predicatesNCie.cert
-./workshops/2004/schmaltz-borrione/support/routing_defuns.cert
-./workshops/2004/schmaltz-borrione/support/routing_local_lemmas.cert
-./workshops/2004/schmaltz-borrione/support/routing_main.cert
-./workshops/2004/schmaltz-borrione/support/scheduler_book.cert
-./workshops/2004/schmaltz-borrione/support/switch.cert
-./workshops/2004/schmaltz-borrione/support/trip_book.cert
-./workshops/2004/schmaltz-borrione/support/trip_thms.cert
-./workshops/2004/smith-et-al/support/bags/bag-exports.cert
-./workshops/2004/smith-et-al/support/bags/bag-pkg.cert
-./workshops/2004/smith-et-al/support/bags/basic.cert
-./workshops/2004/smith-et-al/support/bags/bind-free-rules.cert
-./workshops/2004/smith-et-al/support/bags/cons.cert
-./workshops/2004/smith-et-al/support/bags/eric-meta.cert
-./workshops/2004/smith-et-al/support/bags/meta.cert
-./workshops/2004/smith-et-al/support/bags/neq.cert
-./workshops/2004/smith-et-al/support/bags/top.cert
-./workshops/2004/smith-et-al/support/bags/two-level.cert
-./workshops/2004/smith-et-al/support/bags/two-level-meta.cert
-./workshops/2004/smith-et-al/support/lists/list-exports.cert
-./workshops/2004/smith-et-al/support/lists/lists.cert
-./workshops/2004/smith-et-al/support/lists/list-top.cert
-./workshops/2004/smith-et-al/support/lists/mv-nth.cert
-./workshops/2004/smith-et-al/support/symbol-fns/symbol-fns.cert
-./workshops/2004/smith-et-al/support/symbol-fns/symbol-fns-exports.cert
-./workshops/2004/smith-et-al/support/syntax/auxilary.cert
-./workshops/2004/smith-et-al/support/syntax/syn-pkg.cert
-./workshops/2004/smith-et-al/support/syntax/syntax.cert
-./workshops/2004/smith-et-al/support/syntax/syntax-extensions.cert
-./workshops/2004/sumners-ray/support/basis.cert
-./workshops/2004/sumners-ray/support/crit.cert
-./workshops/2004/sumners-ray/support/mesi.cert
-./workshops/2004/sumners-ray/support/records.cert
-./workshops/2004/sumners-ray/support/sets.cert
-./workshops/2004/sumners-ray/support/total-order.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed1.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed2a.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed2b.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed3.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed4aa.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed4ab.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed4ba.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed4bb.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed4ca.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed4cb.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed4da.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed4db.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed5aa.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/ed6a.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/coe-fld.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-producto.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fucongruencias-suma.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuforma-normal.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fumonomio.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuopuesto.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fupolinomio-normalizado.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuproducto.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fuquot-rem.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/fusuma.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/fld-u-poly/futermino.cert
-./workshops/2006/cowles-gamboa-euclid/Euclid/prime-fac.cert
-./workshops/2006/gordon-hunt-kaufmann-reynolds/support/basic.cert
-./workshops/2006/gordon-hunt-kaufmann-reynolds/support/data.cert
-./workshops/2006/gordon-hunt-kaufmann-reynolds/support/guarded.cert
-./workshops/2006/gordon-hunt-kaufmann-reynolds/support/stobjs.cert
-./workshops/2006/greve/nary/example.cert
-./workshops/2006/greve/nary/nary.cert
-./workshops/2006/greve/nary/nth-rules.cert
-./workshops/2006/hunt-reeber/support/acl2.cert
-./workshops/2006/hunt-reeber/support/bdd.cert
-./workshops/2006/hunt-reeber/support/sat.cert
-./workshops/2006/kaufmann-moore/support/austel.cert
-./workshops/2006/kaufmann-moore/support/greve1.cert
-./workshops/2006/kaufmann-moore/support/greve2.cert
-./workshops/2006/kaufmann-moore/support/greve3.cert
-./workshops/2006/kaufmann-moore/support/mini-proveall.cert
-./workshops/2006/kaufmann-moore/support/mini-proveall-plus.cert
-./workshops/2006/kaufmann-moore/support/rhs1.cert
-./workshops/2006/kaufmann-moore/support/rhs1-iff.cert
-./workshops/2006/kaufmann-moore/support/rhs2.cert
-./workshops/2006/kaufmann-moore/support/smith1.cert
-./workshops/2006/kaufmann-moore/support/sumners1.cert
-./workshops/2006/kaufmann-moore/support/warnings.cert
-./workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-canon.cert
-./workshops/2006/pike-shields-matthews/core_verifier/AES/AES-source-shallow-flatten.cert
-./workshops/2006/pike-shields-matthews/core_verifier/AES/proof-AES.cert
-./workshops/2006/pike-shields-matthews/core_verifier/books/append-defthms-help.cert
-./workshops/2006/pike-shields-matthews/core_verifier/books/computed-hints.cert
-./workshops/2006/pike-shields-matthews/core_verifier/books/ihs-defthms-help.cert
-./workshops/2006/pike-shields-matthews/core_verifier/books/list-defthms-help.cert
-./workshops/2006/pike-shields-matthews/core_verifier/books/make-theorems.cert
-./workshops/2006/pike-shields-matthews/core_verifier/books/source_shallow.cert
-./workshops/2006/pike-shields-matthews/core_verifier/books/symbol-manip.cert
-./workshops/2006/pike-shields-matthews/core_verifier/books/vector-comp-canon.cert
-./workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-canon.cert
-./workshops/2006/pike-shields-matthews/core_verifier/factorial/fac-source-shallow-flatten.cert
-./workshops/2006/pike-shields-matthews/core_verifier/factorial/proof-fac.cert
-./workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-canon.cert
-./workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/fibs-source-shallow-flatten.cert
-./workshops/2006/pike-shields-matthews/core_verifier/Fibonacci/proof-fibs.cert
-./workshops/2006/pike-shields-matthews/core_verifier/RC6/proof-RC6.cert
-./workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-canon.cert
-./workshops/2006/pike-shields-matthews/core_verifier/RC6/RC6-source-shallow-flatten.cert
-./workshops/2006/pike-shields-matthews/core_verifier/TEA/proof-TEA.cert
-./workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-canon.cert
-./workshops/2006/pike-shields-matthews/core_verifier/TEA/TEA-source-shallow-flatten.cert
-./workshops/2006/rager/support/ptest-fib.cert
-./workshops/2006/rager/support/ptest-if-normalization.cert
-./workshops/2006/rager/support/ptest-mergesort.cert
-./workshops/2006/ray/tail/exists.cert
-./workshops/2006/ray/tail/forall.cert
-./workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC.cert
-./workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-interfaces.cert
-./workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-misc.cert
-./workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-nodeset.cert
-./workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-routing.cert
-./workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-scheduling.cert
-./workshops/2006/schmaltz-borrione/GeNoC-support/GeNoC-types.cert
-./workshops/2006/swords-cook/lcsoundness/defsum.cert
-./workshops/2006/swords-cook/lcsoundness/defsum-thms.cert
-./workshops/2006/swords-cook/lcsoundness/LambdaCalcBasis.cert
-./workshops/2006/swords-cook/lcsoundness/LambdaCalcSoundness.cert
-./workshops/2006/swords-cook/lcsoundness/pattern-match.cert
-./workshops/2007/cowles-et-al/support/cowles/while-loop.cert
-./workshops/2007/cowles-et-al/support/greve/ack.cert
-./workshops/2007/cowles-et-al/support/greve/defminterm.cert
-./workshops/2007/cowles-et-al/support/greve/defpun.cert
-./workshops/2007/cowles-et-al/support/greve/defxch.cert
-./workshops/2007/cowles-et-al/support/greve/while.cert
-./workshops/2007/cowles-et-al/support/ray/reflexive.cert
-./workshops/2007/cowles-et-al/support/ray/reflexive-macros.cert
-./workshops/2007/dillinger-et-al/code/all.cert
-./workshops/2007/dillinger-et-al/code/bridge.cert
-./workshops/2007/dillinger-et-al/code/defcode.cert
-./workshops/2007/dillinger-et-al/code/defcode-macro.cert
-./workshops/2007/dillinger-et-al/code/defstruct-parsing.cert
-./workshops/2007/dillinger-et-al/code/hacker.cert
-./workshops/2007/dillinger-et-al/code/raw.cert
-./workshops/2007/dillinger-et-al/code/redefun.cert
-./workshops/2007/dillinger-et-al/code/rewrite-code.cert
-./workshops/2007/dillinger-et-al/code/subsumption.cert
-./workshops/2007/dillinger-et-al/code/table-guard.cert
-./workshops/2007/erickson/bprove/bash.cert
-./workshops/2007/erickson/bprove/exdefs.cert
-./workshops/2007/erickson/bprove/gen.cert
-./workshops/2007/erickson/bprove/lemgen.cert
-./workshops/2007/erickson/bprove/refute.cert
-./workshops/2007/rimlinger/support/Rimlinger.cert
-./workshops/2007/rubio/support/abstract-reductions/abstract-proofs.cert
-./workshops/2007/rubio/support/abstract-reductions/confluence.cert
-./workshops/2007/rubio/support/abstract-reductions/convergent.cert
-./workshops/2007/rubio/support/abstract-reductions/newman.cert
-./workshops/2007/rubio/support/multisets/defmul.cert
-./workshops/2007/rubio/support/multisets/multiset.cert
-./workshops/2007/rubio/support/simplicial-topology/generate-degenerate.cert
-./workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC.cert
-./workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-interfaces.cert
-./workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-misc.cert
-./workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-nodeset.cert
-./workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-routing.cert
-./workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-scheduling.cert
-./workshops/2007/schmaltz/genoc-v1.0/generic-modules/GeNoC-types.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/2D-mesh-nodeset.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/nodeset/octagon-nodeset.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/doubleY-routing/doubleY-routing.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/getting_rid_of_mod.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/mod_lemmas.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_defuns.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_local_lemmas.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/octagon-routing/routing_main.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/routing/xy-routing/xy-routing.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/circuit-scheduling.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/intersect.cert
-./workshops/2007/schmaltz/genoc-v1.0/instantiations/scheduling/packet-scheduling.cert
-# ./workshops/2009/cowles-gamboa-triangle-square/triangle=square-materials/tri-sq.cert
-# ./workshops/2009/cowles-gamboa-triangle-square/triangle=square-materials/log2.cert
-./workshops/2009/fraij-roach/support/functions.cert
-./workshops/2009/fraij-roach/support/theorems.cert
-./workshops/2009/hardin/deque-stobj/deque-stobj.cert
-./workshops/2009/hardin/deque-stobj/deque-thms.cert
-./workshops/2009/kaufmann-kornerup-reitblatt/support/gauss.cert
-./workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-fns.cert
-./workshops/2009/kaufmann-kornerup-reitblatt/support/gauss-work.cert
-./workshops/2009/kaufmann-kornerup-reitblatt/support/generic-loop-inv.cert
-./workshops/2009/kaufmann-kornerup-reitblatt/support/preliminaries.cert
-./workshops/2009/liu/support/error-analysis-tool3.cert
-./workshops/2009/liu/support/mylet.cert
-./workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-det.cert
-./workshops/2009/pierre-clavel-leveugle/Fault-tolerance/ATM-TMR.cert
-./workshops/2009/pierre-clavel-leveugle/Fault-tolerance/error-model.cert
-./workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register.cert
-./workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-det.cert
-./workshops/2009/pierre-clavel-leveugle/Fault-tolerance/register-TMR.cert
-./workshops/2009/sumners/support/kas.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/datalink.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/departure.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/flowcontrol.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/GeNoC.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/network.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/routecontrol.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/router.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/generic-modules/types.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/datalink/simple/datalink.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/departure/simple/departure.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/circuit/flowcontrol.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/packet/flowcontrol.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/flowcontrol/wormhole/flowcontrol.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/circuit-XY-2Dmesh/GeNoC.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/packet-XY-2Dmesh/GeNoC.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/spidergon/GeNoC.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/genoc/wormhole-XY-2Dmesh/GeNoC.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/2Dmesh/network.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/ring/network.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/network/spidergon/network.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/spidergon/routecontrol.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/routecontrol/xy/routecontrol.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/spidergon/router.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-circuit/router.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-packet/router.cert
-./workshops/2009/vandenbroek-schmaltz/GeNoC/instantiations/router/XY-wormhole/router.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-departure.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-interfaces.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-misc.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-nodeset.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-ntkstate.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-priority.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-routing.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-scheduling.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-simulation.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-synchronization.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/GeNoC-types.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/interfaces-computes.cert
-./workshops/2009/verbeek-schmaltz/verbeek/generic-modules/own-perm.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/departure/simple/simple-R4D.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/sets.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/simple.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/genoc/simple-ct-global/trlst-equal.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/interfaces/dummy-interfaces/interfaces-computes.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/nodeset/2DMesh-no-ports/2DMesh.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/ntkstate/simple/simple.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/routing/XY/XYRouting.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/circuit.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/scheduling/circuit-switching-global/intersect.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/simulation/simple/simple.cert
-./workshops/2009/verbeek-schmaltz/verbeek/instantiations/synchronization/circuit-global/circuit.cert
-./workshops/2011/cowles-gamboa-sierpinski/support/r-no-cover.cert
-./workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover1.cert
-./workshops/2011/cowles-gamboa-sierpinski/support/s-no-cover.cert
-./workshops/2011/cowles-gamboa-sierpinski/support/verifying-macros.cert
-# Omitting workshops/2011/verbeek-schmaltz/sources ; provisional certification seems to cause problems here
-./wp-gen/mutrec/mutrec.cert
-./wp-gen/shared.cert
-./wp-gen/wp-gen.cert
-# ./xdoc (possible problem making bookdoc.dat with "make regression-fast")
-# ./xdoc-impl (possible problem making bookdoc.dat with "make regression-fast")
diff -Nru acl2-6.2/books/rtl/Makefile acl2-6.3/books/rtl/Makefile
--- acl2-6.2/books/rtl/Makefile	2013-06-06 17:11:57.000000000 +0000
+++ acl2-6.3/books/rtl/Makefile	2013-09-30 17:53:25.000000000 +0000
@@ -1,4 +1,4 @@
-DIRS = rel1 rel4 rel5 rel8
+DIRS = rel1 rel4 rel5 rel8 rel9
 
 # Note: Directories rel2 and rel3 still exist, but are no longer
 # distributed.  Directory rel1 is needed not only for ACL2(r) but also
diff -Nru acl2-6.2/books/rtl/license.txt acl2-6.3/books/rtl/license.txt
--- acl2-6.2/books/rtl/license.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/license.txt	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,23 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
diff -Nru acl2-6.2/books/rtl/rel5/Makefile acl2-6.3/books/rtl/rel5/Makefile
--- acl2-6.2/books/rtl/rel5/Makefile	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-DIRS = arithmetic support user lib
-
-include ../../Makefile-subdirs
diff -Nru acl2-6.2/books/rtl/rel5/README acl2-6.3/books/rtl/rel5/README
--- acl2-6.2/books/rtl/rel5/README	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/README	1970-01-01 00:00:00.000000000 +0000
@@ -1,201 +0,0 @@
-This directory and this file are a work in progress.  The original author was
-David Russinoff.  He, Matt Kaufmann, and Eric Smith continue to improve this
-work.
-
-This directory contains an ACL2 library of register-transfer logic, developed
-at AMD from 1996 to 2005 in support of the mechanical verification of various
-components of the AMD microprocessors that were designed during that period,
-especially their floating-point arithmetic units.
-
-The library's core definitions and lemmas are contained in the subdirectory
-"lib/".  A parallel subdirectory, "support/", contains a superset of these
-events, including all sublemmas that were required for the proofs of the
-library lemmas.  Thus, the books of "support/" must be certified before those
-of "lib/", but the user is generally discouraged from accessing "support/".
-
-A more powerful (but perhaps more risky) arithmetic library is available in the
-directory "arithmetic/".  To use this library, we recommend including the book
-"arithmetic/top".
-
-The library contains another subdirectory, "user/".  "user/" contains many good
-rules which we haven't included in "lib/" because we wanted to keep "lib/"
-uncluttered.  The rules in "user/" are more risky than those in "lib/".  Use
-them at your own risk.
-
-The books of each directory may be certified by loading the file "cert.lsp" in
-that directory (some of which may be out of date! -- we generally expect people
-to use "make").
-
-See the comments in lib/top.lisp for information of what each book in lib/
-contains.
-
-See lib/README for more on lib/.
-
-The library files contain virtually no documentation, but many of the
-interesting events are formal versions of definitions and lemmas that
-are stated and proved in the earlier sections of the following
-papers, which document various applications of the library:
-
-  D.M. Russinoff, A mechanically checked proof of correctness of the AMD-K5
-  floating point square root microcode, Formal Methods in System Design 14, 
-  75-125 (1999).  See
-  http://www.onr.com/user/russ/david/fsqrt.html.
-
-  D.M. Russinoff, A mechanically checked proof of IEEE compliance of the AMD-K7
-  floating point multiplication, division, and square root instructions,
-  London Mathematical Society Journal of Computation and Mathematics (1), 
-  pp. 148-200, December, 1998.  See
-  http://www.russinoff.com/david/k7-div-sqrt.html.
-
-  D.M. Russinoff, A case study in formal verification of register-transfer 
-  logic with ACL2: the floating point adder of the AMD Athlon processor,
-  invited paper, FMCAD 2000.  See
-  http://www.russinoff.com/david/fadd.html.
-
-For a discussion of our pipeline verification methodology:
-
-  M. Kaufmann and D. M. Russinoff, Verification of Pipeline circuits.  See
-  http://www.russinoff.com/david/pipeline.html.
-
-=========================================================================
-
-How to add new theorems to lib/:
-
-Suppose you want to prove a new theorem to add to a book in lib/.  There are
-two approaches.  If it is convenient to do the proof in an existing book in
-support/, that's fine.  But you may well find it more convenient to create a
-new book in support/, say, bk.lisp, that starts (after the initial in-package)
-with:  (include-book "../lib/top").  In that case you can proceed as follows.
-
-1. Develop and certify support/bk.lisp, starting after the in-package form
-   with:
-
-   (include-book "../lib/top").
-
-2. Find the book support/top*.lisp with the largest index, e.g., top3.lisp if
-   that exists and there is no top4.lisp.  Let us call this index m and this
-   book topm.lisp.
-
-3. Let n = m+1 and rename support/top.lisp to the corresponding
-   support/topn.lisp.
-
-4. As suggested near the end of support/top1.lisp, start up ACL2 and execute
-   the following forms:
-
-   (include-book "../lib/top")
-   (let ((world (w state)))
-     (set-difference-theories (current-theory :here) (theory 'ground-zero)))
-
-   Paste the result as indicated below to the end of support/topn.lisp,
-   replacing lib-topn for the appropriate n.
-
-   (deftheory lib-topn (union-theories (theory 'ground-zero) (quote
-   <<Paste the above result here.>>
-   )))
-
-5. Create a new book support/top.lisp that contains the following.
-
-   (in-package "ACL2")
-   (include-book "topm")
-   (include-book "bk")
-
-6. Replace (include-book "../lib/top") in bk.lisp with the following two forms,
-   replacing topm as appropriate in both cases.
-
-   (include-book "topm")
-   (in-theory (theory 'lib-topm))
-
-7. In both support/ and lib/, run
-
-   make dependencies
-
-   and update the Makefile accordingly.
-
-8. In the parent of support/ and lib/, run:  make.  Look for the string
-
-   **CERTIFICATION FAILED**
-
-   -- if you don't find it, then all certifications presumably succeeded.
-
-=========================================================================
-
-Beginning of Eric's notes for users of the library [This is still a work in
-progress]:
-
-Personally, I wouldn't include lib/top since it includes lib/arith (which
-contains the old arithmetic rules) and also includes other books you probably
-don't need (e.g., fadd lemmas, maybe brat).  (But maybe including lib/top is
-okay, since I expect the arithmetic rules to at least be somewhat compatible
-with mine.  [At least, lib/arith and arithmetic/top can both be included in one
-session.] But maybe you don't want both, because I may have essentially the
-same rule under a better name, and the duplication may slow down the rewriter
-and be a pain if you have to disable a rule -- since you'd have to disable both
-mine and the one in lib/arith.)
-
-Of the lib/ books, including your certified model.lisp should include
-lib/rtl
-lib/rtl-arr
-lib/util
-lib/clocks2
-lib/package-defs
-
-To start doing proofs, I'd include:
-
-lib/bits - which itself includes lib/rtl
-lib/round - since you'll be reasoning about rounding
-lib/reps - you will be reasoning about floating-point representations, right?
-
-You'll probably also want lib/basic and lib/float, at least until I can come up
-with a replacement for these books.  But note that arithmetic/ contains many
-more lemmas about the functions mentioned in basic, especially mod, fl, and
-expt.
-
-You probably don't need lib/fadd.  
-
-You'll also need an arithmetic book (or books).  The safest course would be to
-include lib/arith.  However, I have lots of arithmetic books that you might
-want to use instead.  (I think my books and lib/arith are compatible [check
-this?], so it's probably safe to include both.)  Actually, many of the rules in
-lib/arith exist in arithmetic/ too.
-
-The books in arithmetic/ are far from finished, but there is a lot of good
-stuff in there.  There may be looping rules, but there are also powerful rules
-which can save you a lot of hassle.  I should probably spend more time
-separating the safe stuff from the potentially dangerous stuff.
-
-It might help to read through some of the books in arithmetic/.  For example,
-if you'll be proving a lot of stuff about mod, you should read through
-arithmetic/mod2.lisp?  [I should probably combine mod.lisp and mod2.lisp.
-Mod.lisp contains "Doc's" lemmas, and "mod2.lisp" contains Eric's lemmas.  Once
-I get all of support working with mod2.lisp included, I can combine it with
-mod.lisp.]  For some books, I've pulled out the proofs in to a separate book
-(e.g., expo2-proofs.lisp).
-
-For a quick overview of the books in arithmetic, see the comments in
-arithmetic/top.lisp.
-
-Misc notes: Generally, I assign a lemma to a book based on which function the
-lemma is "about".  So if you're missing a fact about bvecp, look in
-support/bvecp.lisp.  Or if you're missing a lemma about mod, look in
-arithmetic/mod.lisp.  Sometimes it's hard to tell which function a lemma is
-"about".  I tend to rely on a rough mental picture of the directed acyclic
-graph created by the definitions of the functions we use.  Thus if FOO calls
-BAR, a lemma about FOO and BAR goes in the FOO book.  Also, I tend to classify
-a lemma as being "about" to most complicated function it mentions. So a lemma
-about mod of a sum, goes in the mod book since mod is more complicated than
-+. (+ is used to define mod!).  Sometimes it's not clear where to put a lemma
-and I create a special book, such as "arithmetic/mod-expt.lisp", which contains
-lemmas mixing mod and expt.
-
-See also arithmetic/README.
-
-Examples of two useful greps (modify appropriately):
-
-Find all mentions of "mod-equal" in .lisp files:
-
-  grep -i "mod-equal" */*.lisp
-
-Find all mentions of the rule "mod-equal" in .out files (including all the
-times it was used in proofs):
-
-  grep -i "mod-equal" */*.out
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/Makefile acl2-6.3/books/rtl/rel5/arithmetic/Makefile
--- acl2-6.2/books/rtl/rel5/arithmetic/Makefile	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-include ../../../Makefile-generic
--include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/README acl2-6.3/books/rtl/rel5/arithmetic/README
--- acl2-6.2/books/rtl/rel5/arithmetic/README	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/README	1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-This directory contains the start of "arithmetic" library.  Some of the rules and files in this directory were
-previously in support/.  Others are new.
-
-This library includes lemmas about the following functions:
-
-+ 
-* 
-unary-- (note that - is a macro)
-unary-/ (note that - is a macro)
-<       (and so also > <= and >=)
-integerp
-rationalp
-complex-rationalp
-numerator                    (We hope the user doesn't have to reason about this directly.)
-denominator                  (We hope the user doesn't have to reason about this directly.)
-nonnegative-integer-quotient (We hope the user doesn't have to reason about this directly.)
-expt
-floor
-mod
-abs (sort of)
-fl (not built-in, but related to floor)
-cg (not built-in, but related to fl)
-expo (not built-in, but initmately tied up with expt)
-even (not built-in; recursive version of evenp)
-odd  (not built-in; recursive version of oddp)
-
-
-See the comments in top.lisp.  See also ../README
-
-The user of the library probably wants some arithmetic books, to help him/her reason about + and * and so on.
-The safest thing to do would be to include lib/arith.  This is essentially the old "fp.lisp" book.  Note that
-lib/basic include more arithmetic-style lemmas.  The more agressive use might want to try including this
-arithmetic library (i.e., the book arithmetic/top) instead of lib/arith.
-
-Normal Forms:
-
-We rewrite (- x) to (* -1 x).
-
-Scattering vs. gathering exponents: Currently, we are agnostic about which to do.  (Neither is enabled by
-default after one includes arithmetic/top).  To scatter exponents, enable expt-split and expt-miuns.  To
-gather exponents, enable a15 and expt-inverse (and disable expo-shift-general, which currently doesn't work
-with gathering -- that is, it can loop!).
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/arith.lisp acl2-6.3/books/rtl/rel5/arithmetic/arith.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/arith.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/arith.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,47 +0,0 @@
-(in-package "ACL2")
-
-;This book contains basic arith stuff which i'm pretty sure won't hurt anything.
-
-(local (include-book "arith2"))
-
-;This is a meta rule to cancel identical terms from both sides of an equality of sums.
-(include-book "meta/meta-plus-equal" :dir :system)
-
-;This is a meta rule to cancel identical terms from both sides of a < of sums.
-(include-book "meta/meta-plus-lessp" :dir :system)
-
-;This is a meta rule to cancel identical terms from both sides of an equality of products (I think).
-(include-book "meta/meta-times-equal" :dir :system)
-
-;Note!  There is not meta-times-lessp, which would be really nice to have.  I now have a bind-free rule to do that...
-
-(defthm collect-constants-in-equal-of-sums
-  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
-                (case-split (acl2-numberp c1))
-                )
-           (and (equal (equal (+ c2 x) c1)
-                       (equal (fix x) (- c1 c2)))
-                (equal (equal c1 (+ c2 x))
-                       (equal (fix x) (- c1 c2))))))
-
-(defthm collect-constants-in-equal-of-sums-2
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (and (equal (equal (+ c2 x) (+ c1 y))
-                       (equal (fix x) (+ (- c1 c2) y))))))
-
-(defthm collect-constants-in-<-of-sums
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (and (equal (< (+ c2 x) c1)
-                       (< x (- c1 c2)))
-                (equal (< c1 (+ c2 x))
-                       (< (- c1 c2) x)))))
-
-(defthm collect-constants-in-<-of-sums-2
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (equal (< (+ c2 x) (+ c1 y))
-                  (< x (+ (- c1 c2) y)))))
-
-;I put this in because it seems to help rewrite stupid hyps quickly.
-(defthm dumb
-  (equal (< x x)
-         nil))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/arith2.lisp acl2-6.3/books/rtl/rel5/arithmetic/arith2.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/arith2.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/arith2.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,568 +0,0 @@
-(in-package "ACL2")
-
-#|
-This book contains a hodgepodge of useful arithmetic rules.
-It's still kind of a mess.  But it's better now that we have the rules in common-factor.lisp.
-
-|#
-
-(include-book "fp2")
-(include-book "predicate")
-(include-book "product")
-(include-book "meta/meta-times-equal" :dir :system)
-(include-book "meta/meta-plus-equal" :dir :system)
-(include-book "meta/meta-plus-lessp" :dir :system)
-
-
-;get more rules from arithmetic-2 ?
-
-
-
-
-;;=================================================================================
-;; Collect leading constants in comparisons.
-;; This section is complete.  [what about products??]
-;;===================================================================================
-
-(defthm collect-constants-in-equal-of-sums
-  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
-                (case-split (acl2-numberp c1))
-                )
-           (and (equal (equal (+ c2 x) c1)
-                       (equal (fix x) (- c1 c2)))
-                (equal (equal c1 (+ c2 x))
-                       (equal (fix x) (- c1 c2))))))
-
-(defthm collect-constants-in-equal-of-sums-2
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (and (equal (equal (+ c2 x) (+ c1 y))
-                       (equal (fix x) (+ (- c1 c2) y))))))
-
-(defthm collect-constants-in-<-of-sums
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (and (equal (< (+ c2 x) c1)
-                       (< x (- c1 c2)))
-                (equal (< c1 (+ c2 x))
-                       (< (- c1 c2) x)))))
-
-(defthm collect-constants-in-<-of-sums-2
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (equal (< (+ c2 x) (+ c1 y))
-                  (< x (+ (- c1 c2) y)))))
-
-
-;this book includes (how many?) main types of lemmas
-
-;there's stuff in inverted-factor too
-
-
-;collecting constants
-; equal with sums
-; < with sums
-; < with products
-; equal with products
-
-;rearranging negative coeffs
-;getting rid of fractional coeffs
-
-;cancelling factors in comparisons of sums (these sums may each have only 1 addend)
-
-;misc lemmas (comparing products to 0)
-
-;see equal-constant-+ in equalities.lisp
-
-;see also see MULT-BOTH-SIDES-OF-EQUAL
-(defthmd mult-both-sides-of-<-by-positive
-  (implies (and (<= 0 c)
-                (rationalp c)
-                (case-split (< 0 c))
-                )
-           (equal (< (* c a) (* c b))
-                  (< a b))))
-
-(defthm mult-both-sides-of-equal
-  (implies (and (case-split (acl2-numberp a))
-                (case-split (acl2-numberp b))
-                (case-split (acl2-numberp c))
-                )
-           (equal (equal (* a c) (* b c)) 
-                  (if (equal c 0)
-                      t
-                    (equal a b))))
-  :rule-classes nil)
-
-
-
-#|
-
-;instead of these, we should just cancel common factors from the constants
-
-;open question: how to handle (equal (* 2 x) (* 3 y)) -- should we collect the constants or not? 
-;maybe so, since doing so would let us substitue for one of the vars (x or y).
-
-;don't yet handle negative constants
-;prefers that quotient of the constants be > 1  -perhaps we want the quotient to be < 1???
-;maybe the constant should be by itself?
-(defthm collect-constants-in-product-<-1-of-2-with-1-of-2
-  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
-                (rationalp c1)
-                (rationalp c2)
-                (< 0 c1) ;gen
-                (< 0 c2) ;gen
-                (rationalp a)
-                (rationalp b))
-           (equal (< (* c1 a) (* c2 b))
-                  (if (> c1 c2)
-                      (< (* (/ c1 c2) a) b)
-                    (< a (* (/ c2 c1) b)))))
-  :hints (("Goal" :use ((:instance mult-both-sides-of-<-by-positive 
-                                   (a (* c1 a))
-                                   (b (* c2 b))
-                                   (c (/ c1)))
-                        (:instance mult-both-sides-of-<-by-positive 
-                                   (a (* c1 a))
-                                   (b (* c2 b))
-                                   (c (/ c2)))))))
-
-(defthm collect-constants-in-product-<-1-of-1-with-1-of-2
-  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
-                (rationalp c1)
-                (rationalp c2)
-                (< 0 c1) ;gen
-                (< 0 c2) ;gen
-                (rationalp b))
-           (equal (< c1 (* c2 b))
-                  (< (/ c1 c2) b)))
-  :hints (("Goal" :use ((:instance mult-both-sides-of-<-by-positive 
-                                   (a c1)
-                                   (b (* c2 b))
-                                   (c (/ c2)))))))
-
-(defthm collect-constants-in-product-<-1-of-2-with-1-of-1
-  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
-                (rationalp c1)
-                (rationalp c2)
-                (< 0 c1) ;gen
-                (< 0 c2) ;gen
-                (rationalp b))
-           (equal (< (* c2 b) c1)
-                  (< b (/ c1 c2))))
-  :hints (("Goal" :use ((:instance mult-both-sides-of-<-by-positive 
-                                   (b c1)
-                                   (a (* c2 b))
-                                   (c (/ c2)))))))
-
-
-|#
-
-
-
-;generalize to acl2-numberp whenever possible
-;make more like these!
-
-;BOZO generalize this hack
-;drop?
-;is this like rearrange-negative coeffs?
-(defthm rearr-neg-eric
-  (implies (and (rationalp a)
-                (rationalp b)
-                (rationalp c)
-                (rationalp d))
-           (equal (EQUAL (+ a (* -1 b) c)
-                         d)
-                  (equal (+ a c) (+ b d)))))
-
-;add "equal" to the name?
-;more like this?
-;BOZO bad name...
-(defthm collect-constants-with-division
-  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
-                (rationalp c2)
-                (acl2-numberp c1)
-                (not (equal c2 0))
-                (rationalp x))
-           (equal (equal c1 (* c2 x))
-                  (equal (/ c1 c2) x))))
-
-
-;; ==================================================================================================
-;;
-;;;comparing a product to 0
-
-;; may cause case splits (which, for my purposes, is acceptable)
-
-;; ==================================================================================================
-
-
-
-#|
-;BOZO I have more rules about this in product.lisp !!!
-
-;case split on the sign of A
-(defthm prod->-0-cancel-pos
-  (implies (and (< 0 a)
-                (rationalp x)
-                (rationalp a)
-                )
-           (equal (< 0 (* a x))
-                  (< 0 x))))
-
-(defthm prod-<-0-cancel-pos
-  (implies (and (< 0 a)
-                (rationalp x)
-                (rationalp a)
-                )
-           (equal (< (* a x) 0)
-                  (< x 0))))
-
-
-(defthm prod-<-0-cancel-neg
-  (implies (and (< a 0)
-                (rationalp x)
-                (rationalp a)
-                )
-           (equal (< (* a x) 0)
-                  (< 0 x))))
-
-(defthm prod->-0-cancel-neg
-  (implies (and (< a 0)
-                (rationalp x)
-                (rationalp a)
-                )
-           (equal (< 0 (* a x))
-                  (< x 0))))
-
-
-;reorder to make the most likely case of the if first?
-(defthm prod->-0-cancel
-  (implies (and (rationalp x)
-                (rationalp a))
-           (equal (< 0 (* a x))
-                  (if (< 0 a)
-                      (< 0 x)
-                    (if (equal 0 a)
-                        nil
-                      (< x 0))))))
-
-
-(defthm prod-<-0-cancel
-  (implies (and (rationalp x)
-                (rationalp a))
-           (equal (< (* a x) 0)
-                  (if (equal a 0)
-                      nil
-                    (if (< a 0)
-                        (< 0 x)
-                      (< x 0))))))
-
-
-(in-theory (disable prod-<-0-cancel-neg 
-                    prod-<-0-cancel-pos
-                    prod->-0-cancel-neg  
-                    prod->-0-cancel-pos))
-
-
-|#
-
-
-(defthmd cancel-in-prods-<-case-x->-0
-  (implies (and (rationalp x)
-                (< 0 x)
-                (rationalp a)
-                (rationalp b))
-           (equal  (< (* x a) (* x b))
-                   (< a b)))
-  )
-
-(defthmd cancel-in-prods-<-case-x-<-0
-  (implies (and (rationalp x)
-                (> 0 x)
-                (rationalp a)
-                (rationalp b))
-           (equal  (< (* x a) (* x b))
-                   (> a b)))
-  )
-
-;changed the var names 'cause "x" was too heavy
-;disabled, since we have a bind-free rule to cancel
-(defthmd cancel-in-prods-<
-  (implies (and (rationalp a)
-                (rationalp b)
-                (rationalp c))
-           (equal (< (* a b) (* a c))
-                  (if (equal 0 a)
-                      nil
-                    (if (> a 0)
-                        (< b c)
-                      (> b c)))))
-  :hints (("Goal" :in-theory (enable  cancel-in-prods-<-case-x-<-0
-                                      cancel-in-prods-<-case-x->-0)))
-  )
-
-
-
-;it shouldn't be too hard to write a bind-free function for cancelling common factors; that rule could replace
-;many of the cancelling rules below
-
-
-;use negative-syntaxp? (or a version of it that operates on single addends only (i.e., has no '+ case)
-;do we need this?
-(defthmd move-a-negative-coeff
-  (equal (< (+ a (* -1 b)) c)
-         (< a (+ b c))))
-  
-;can simplify the *-1 term to have only one var 
-;do we need this?
-(defthm rearr-negative-coeffs-<-sums-blah
-  (equal (< (+ A e (* -1 C)) B)
-         (< (+ A e) (+ (* C) B)))
-  :hints (("Goal" :use (:instance
-                        move-a-negative-coeff (a (+ a e)) (b (* c)) (c b)))))
-
-(defthm collect-constant-mults-<-1-of-2-with-1-of-2-term-len-2
-  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
-                (rationalp c1)
-                (rationalp c2)
-                (rationalp a)
-                (rationalp b)
-                (rationalp c)
-                (rationalp d))
-           (equal (< (+ (* c1 c d) a) (+ (* c2 c d) b))
-                  (< (+ (* (- c1 c2) c d) a) b))))
-
-
-(include-book "inverted-factor")
-
-
-;events in :rule-classes nil which can be :used in hacks
-
-(defthm <-transitive
-  (implies (and (< a b)
-                (< b c)
-                )
-           (< a c)
-           )
-  :rule-classes nil
-  )
-
-(defthm <=-transitive
-  (implies (and (<= a b)
-                (<= b c)
-                )
-           (<= a c)
-           )
-  :rule-classes nil
-  )
-
-;a<b and b<=c together imply a<c
-(defthm <-and-<=-transitivity
-  (implies (and (< a b)	
-                (<= b c)	
-                )
-           (< a c)
-           )
-  :rule-classes nil
-  )
-
-;a<=b and b<c together imply a<c
-(defthm <=-and-<-transitivity
-  (implies (and (< a b)	
-                (<= b c)	
-                )
-           (< a c)
-           )
-  :rule-classes nil
-  )
-
-
-;used only as a hack:
-
-
-(defthm equal-transitive
-  (implies (and (equal a b)
-                (equal b c))
-           (equal a c))
-  :rule-classes nil)
-
-;there's a conflict in my arithmetic normal forms:
-; do we prefer (< (* 2 x) 1) or (< x 1/2) ?
-
-
-(defthm collect-again
-  (implies (and (syntaxp (quotep k))
-                (rationalp x)
-                (rationalp y))
-           (equal (< (+ x y) (* k x))
-                  (< y (* (- k 1) x)))))
-
-
-
-;natp is defined here to try to make sure its always enabled
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(in-theory (enable natp))
-
-;an odd rule
-(defthm two-natps-add-to-1
-  (implies (and (natp n)
-                (natp x))
-           (equal (equal 1 (+ x n))
-                  (or (and (equal x 1) (equal n 0))
-                      (and (equal x 0) (equal n 1))))))
-
-;backchain-limit?
-;why needed?
-(defthm nonneg-+
-  (implies (and (<= 0 x)
-                (<= 0 y))
-           (not (< (+ x y) 0))))
-
-;improve this? make the conclusion more type-like?
-(defthm nonneg-+-type
-  (implies (and (<= 0 x)
-                (<= 0 y))
-           (not (< (+ x y) 0)))
-  :rule-classes (:type-prescription))
-
-(defthm move-negative-constant-1
-  (implies (and (syntaxp (and (quotep k) (< (cadr k) 0)))
-                (acl2-numberp x)
-                (acl2-numberp y))
-           (equal (equal x (+ k y))
-                  (equal (+ x (- k)) y))))
-;move?
-(defthm rationalp-sum
-  (implies (rationalp k)
-           (and (equal (rationalp (+ k x))
-                       (not (complex-rationalp x)))
-                (equal (rationalp (+ x k))
-                       (not (complex-rationalp x))))))
-
-;move?
-;make rationalp-sum like this?
-(defthm rationalp-prod
-  (implies (and (rationalp k)
-                (case-split (not (equal k 0)))
-                )
-           (and (equal (rationalp (* k x))
-                       (not (complex-rationalp x)))
-                (equal (rationalp (* x k))
-                       (not (complex-rationalp x))))))
-;move?
-(defthm complex-rationalp-prod
-  (implies (and (rationalp k)
-                (case-split (not (equal k 0)))
-                )
-           (and (equal (complex-rationalp (* k x))
-                       (complex-rationalp x))
-                (equal (complex-rationalp (* x k))
-                       (complex-rationalp x)))))
-
-
-
-(defthm collect-1
-  (implies (and (syntaxp (and (quotep k) (quotep j)))
-                (rationalp k)
-                (rationalp j)
-                (rationalp x)
-                (rationalp y)
-                )
-           (equal (< (+ y (* k x)) (* j x))
-                  (< (+ (* (- k j) x) y) 0))))
-
-(defthm collect-2
-  (implies (and (syntaxp (and (quotep k) (quotep j)))
-                (rationalp k)
-                (rationalp j)
-                (rationalp x)
-                (rationalp y)
-                )
-           (equal (< (+ (* k x) y) (* j x))
-                  (< (+ (* (- k j) x) y) 0))))
-
-(defthm collect-another
-  (implies (and (syntaxp (and (quotep k) (quotep j)))
-                (rationalp k)
-                (rationalp j)
-                (rationalp x)
-                (rationalp y)
-                (rationalp z))
-           (equal (< (+ (* k x) y) (+ (* j x) z))
-                  (< (+ (* (- k j) x) y) z))))
-
-
-;simplify this
-(defthm collect-in-<-of-sums-2
-  (implies (syntaxp (and (quotep k) (quotep j)))
-           (equal (< (+ a (* k x) d) (+ b e (* j       x) f))
-                  (< (+ a         d) (+ b e (* (- j k) x) f)))))
-
-(defthm collect-in-<-of-sums-1
-  (implies (syntaxp (and (quotep k) (quotep j)))
-           (equal (< (+ a d (* k x) y) (+ b e f z (* j       x) g))
-                  (< (+ a d         y) (+ b e f z (* (- j k) x) g)))))
-
-
-(defthm cancel-in-sum-equal-zero-1
-  (implies (and (rationalp y)
-                (case-split (not (equal 0 y)))
-                (rationalp x1)
-                (rationalp x2)
-                (rationalp x3)
-                (rationalp x4)
-                (rationalp x5)
-                (rationalp x6))
-           (equal (EQUAL 0 (+ (* Y x1)
-                              (* x2 Y x3)
-                              (* Y x4)
-                              (* x5 Y x6)))
-                  (equal 0 (+ x1 (* x2 x3) x4 (* x5 x6)))))
-  :hints (("Goal" :in-theory (disable product-equal-zero)
-           :use (:instance product-equal-zero (x y) (y (+ x1 (* x2 x3) x4 (* x5 x6))))))
-  
-  )
-
-;expensive?
-(defthm integerp-implies-not-complex-rationalp
-  (implies (integerp x)
-           (not (complex-rationalp x))))
-
-;don't need this if we have frac-coeff rules?
-;move to unary-/ ?
-(defthm <-of-two-inverses
-  (implies (and (rationalp x)
-                (rationalp y)
-                (< 0 y)
-                (< 0 x)
-                )
-           (equal (< (/ x) (/ y))
-                  (< y x))))
-
-
-#|
-;move up?
-(defthm pos*
-  (implies (and (rationalp x)
-                (rationalp y)
-                (> x 0)
-                (> y 0))
-           (> (* x y) 0))
-  :rule-classes ())
-
-;bad name
-;find a way to make this a rewrite rule wihtout looping?
-(defthm tighten-integer-bound
-  (implies (and (< x (expt 2 i))
-                (integerp x)
-                (case-split (natp i))
-                )
-           (<= x (+ -1 (expt 2 i))))
-  :rule-classes :linear
-  )
-
-|#
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/basic.lisp acl2-6.3/books/rtl/rel5/arithmetic/basic.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/basic.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/basic.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,299 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-(in-package "ACL2")
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "fp2")
-(local (include-book "even-odd"))
-
-;;; natp ;;;
-;Currently, we plan to leave natp enabled...
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defthm natp-compound-recognizer
-  (equal (natp x)
-         (and (integerp x)
-              (<= 0 x)))
-  :rule-classes :compound-recognizer)
-
-; The fpaf3a proof of far-exp-low-lemma-1 in far.lisp requires the
-; following to be a :rewrite rule, not just a :type-prescription rule.
-; Let's make most or all of our :type-prescription rules into :rewrite
-; rules as well.
-(defthmd natp+
-    (implies (and (natp x) (natp y))
-	     (natp (+ x y))))
-
-;move
-(defthmd natp*
-    (implies (and (natp x) (natp y))
-	     (natp (* x y))))
-
-
-
-;abs
-;Currently, we plan to leave abs enabled, but here are some rules about it:
-
-(defthm abs-nonnegative-acl2-numberp-type
-  (implies (case-split (acl2-numberp x))
-           (and (<= 0 (abs x))
-                (acl2-numberp (abs x))))
-  :rule-classes (:TYPE-PRESCRIPTION))
-
-(defthm abs-nonnegative-rationalp-type
-  (implies (case-split (rationalp x))
-           (and (<= 0 (abs x))
-                (rationalp (abs x))))
-  :rule-classes (:TYPE-PRESCRIPTION))
-
-(defthm abs-nonnegative-integerp-type
-  (implies (integerp x)
-           (and (<= 0 (abs x))
-                (rationalp (abs x))))
-  :rule-classes (:TYPE-PRESCRIPTION))
-
-(defthm abs-nonnegative
-  (<= 0 (abs x)))
-
-
-
-
-(local (include-book "fl"))
-
-(defthm fl-def-linear
-  (implies (case-split (rationalp x))
-           (and (<= (fl x) x)
-                (< x (1+ (fl x)))))
-  :rule-classes :linear)
-
-;(in-theory (disable a13)) ;the same rule as fl-def-linear!
-
-;bad? free var.
-(defthm fl-monotone-linear
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y))
-           (<= (fl x) (fl y)))
-  :rule-classes :linear)
-
-(defthm n<=fl-linear
-    (implies (and (<= n x)
-		  (rationalp x)
-		  (integerp n))
-	     (<= n (fl x)))
-  :rule-classes :linear)
-
-
-;may need to disable? <-- why did I write that? expensive backchaining?
-(defthm fl+int-rewrite
-    (implies (and (integerp n)
-		  (rationalp x))
-	     (equal (fl (+ x n)) (+ (fl x) n))))
-
-
-;from fl.lisp
-(defthm fl/int-rewrite
-  (implies (and (integerp n)
-                (<= 0 n) ;can't gen?
-                (rationalp x))
-           (equal (fl (/ (fl x) n))
-                  (fl (/ x n))))
-  :hints (("Goal" :use ((:instance fl/int-1)
-			(:instance fl/int-2)))))
-
-
-;needed?
-(defthm fl-integer-type
-  (integerp (fl x))
-  :rule-classes (:type-prescription))
-
-(defthmd fl-def ; use defthmd to avoid wrecking old proofs (rel4->rel5 transition)
-  (and (integerp (fl x))    
-       (implies (case-split (rationalp x))
-	        (and (<= (fl x) x)
-		     (< x (1+ (fl x))))))
-  :rule-classes ((:linear :corollary
-                          (implies (case-split (rationalp x))
-                                   (and (<= (fl x) x)
-                                        (< x (1+ (fl x))))))
-                 (:type-prescription :corollary
-                                     (integerp (fl x)))))
-
-;this rule is no better than fl-integer-type and might be worse:
-(in-theory (disable (:type-prescription fl)))
-
-(defthm fl-int
-    (implies (integerp x)
-	     (equal (fl x) x)))
-
-(encapsulate
- ()
- (local (include-book "fl"))
- (defthm fl-integerp
-   (equal (equal (fl x) x)
-          (integerp x))))
-
-(defthm fl-unique
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (<= n x)
-		  (< x (1+ n)))
-	     (equal (fl x) n))
-  :rule-classes ())
-
-
-
-(encapsulate
- ()
- (local (include-book "expt")) 
-
- (defthm expt-2-positive-rational-type
-   (and (rationalp (expt 2 i))
-        (< 0 (expt 2 i)))
-   :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
-
- (defthm expt-2-positive-integer-type
-   (implies (<= 0 i)
-            (and (integerp (expt 2 i))
-                 (< 0 (expt 2 i))))
-   :rule-classes (:type-prescription))
- 
-;the rewrite rule counterpart to expt-2-positive-integer-type
- (defthm expt-2-integerp
-   (implies (<= 0 i)
-            (integerp (expt 2 i))))
- 
-
-
-; (in-theory (disable a14)) ;the rules above are better than this one for (expt 2 i)
-
-
- (defthm expt-2-type-linear
-   (implies (<= 0 i)
-            (<= 1 (expt 2 i)))
-   :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
-
- (defthmd expt-split
-   (implies (and (integerp i)
-                 (integerp j)
-                 (case-split (acl2-numberp r)) ;(integerp r)
-                 (case-split (not (equal r 0)))
-                 )
-            (equal (expt r (+ i j))
-                   (* (expt r i)
-                      (expt r j)))))
-
- (theory-invariant (incompatible (:rewrite expt-split)
-                                 (:definition a15))
-                   :key expt-split-invariant)
- 
- (defthmd expt-weak-monotone
-   (implies (and (integerp n)
-                 (integerp m))
-            (equal (<= (expt 2 n) (expt 2 m))
-                   (<= n m))))
-
- (defthmd expt-weak-monotone-linear
-   (implies (and (<= n m)
-                 (case-split (integerp n))
-                 (case-split (integerp m)))
-            (<= (expt 2 n) (expt 2 m)))
-  :rule-classes ((:linear :match-free :all)))
-
- (defthmd expt-strong-monotone
-   (implies (and (integerp n)
-                 (integerp m))
-            (equal (< (expt 2 n) (expt 2 m))
-                   (< n m))))
- (defthmd expt-strong-monotone-linear
-   (implies (and (< n m)
-                 (case-split (integerp n))
-                 (case-split (integerp m))
-                 )
-            (< (expt 2 n) (expt 2 m)))
-  :rule-classes ((:linear :match-free :all)))
-
- (defthmd a15
-   (implies (and (rationalp i)
-                 (not (equal i 0))
-                 (integerp j1)
-                 (integerp j2))
-            (and (equal (* (expt i j1) (expt i j2))
-                        (expt i (+ j1 j2)))
-                 (equal (* (expt i j1) (* (expt i j2) x))
-                        (* (expt i (+ j1 j2)) x))))
-
-   )
-
- )
-
-; The next two events were added by Matt K. June 2004: Some proofs require
-; calls of expt to be evaluated, but some calls are just too large (2^2^n for
-; large n).  So we use the following hack, which allows calls of 2^n for n<130
-; to be evaluated even when the executable-counterpart of expt is disabled.
-; The use of 130 is somewhat arbitrary, chosen in the hope that it suffices for
-; relieving of hyps related to widths of bit vectors
-
-(defun expt-exec (r i)
-  (declare (xargs :guard
-                  (and (acl2-numberp r)
-                       (integerp i)
-                       (not (and (eql r 0) (< i 0))))
-                  :guard-hints (("Goal" :expand (hide (expt r i))))))
-  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
-       :exec (expt r i)))
-
-(defthm expt-2-evaluator
-  (implies (syntaxp (and (quotep n)
-                         (natp (cadr n))
-                         (< (cadr n) 130)
-                         ))
-           (equal (expt 2 n)
-                  (expt-exec 2 n)))
-  :hints (("Goal" :expand ((hide (expt 2 n))))))
-
-;weakly?
-;cases for other signs?
-(defthm *-doubly-monotonic
-  (implies (and (rationalp x)
-                (rationalp y)
-                (rationalp a)
-                (rationalp b)
-                (<= 0 x)
-                (<= 0 y)
-                (<= 0 a)
-                (<= 0 b)
-                (<= x y)
-                (<= a b))
-           (<= (* x a) (* y b)))
-  :rule-classes ())
-
-(defund fl-half (x)
-;  (declare (xargs :guard (real/rationalp x)))
-  (1- (fl (/ (1+ x) 2))))
-
-
-(defthm fl-half-lemma
-    (implies (and (integerp x)
-		  (not (integerp (/ x 2)))) ;if x is odd, ...
-	     (= x (1+ (* 2 (fl-half x)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (e/d (fl-half) (fl-int))
-           :use ((:instance x-or-x/2)
-                 (:instance fl-int (x (/ (1+ x) 2)))))))
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/cg.lisp acl2-6.3/books/rtl/rel5/arithmetic/cg.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/cg.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/cg.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,144 +0,0 @@
-(in-package "ACL2")
-
-;This book introduces the function cg (for "ceiling"), which is in many ways analogous to fl and which is used
-;in the definition of the "away" rounding mode.
-
-;todo: prove more thms about cg analogous to those about fl (maybe not worth doing since only fl is used to
-;define, for example, bits).
-
-(local (include-book "fl"))
-(local (include-book "fp2"))
-(local (include-book "integerp"))
-(local (include-book "integerp"))
-(local (include-book "arith2"))
-(local (include-book "common-factor"))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defthm cg-def-linear
-  (implies (case-split (rationalp x))
-           (and (>= (cg x) x)
-                (> (1+ x) (cg x))))
-  :hints (("Goal" :in-theory (enable cg)))
-  :rule-classes :linear)
-
-(defthm cg-monotone-linear
-  (implies (and (rationalp x)
-                (rationalp y)
-                (<= x y))
-           (<= (cg x) (cg y)))
-  :rule-classes :linear)
-
-(defthm n>=cg-linear
-  (implies (and (>= n x)
-                (rationalp x)
-                (integerp n))
-           (>= n (cg x)))
-  :rule-classes :linear)
-
-(defthm cg+int-rewrite
-  (implies (and (integerp n)
-                (rationalp x))
-           (equal (cg (+ x n)) (+ (cg x) n))))
-
-(local
- (defthm cg/int-1
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (cg (/ (cg x) n))
-		 (cg (/ x n))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance cg-def-linear)
-			(:instance cg-monotone-linear (x (/ x n)) (y (/ (cg x) n))))))))
-
-(local
- (defthm cg/int-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (<= (cg (/ (cg x) n))
-		 (cg (/ x n))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance n>=cg-linear (n (* n (cg (/ x n)))))
-			(:instance n>=cg-linear (n (cg (/ x n))) (x (/ (cg x) n)))
-			(:instance cg-def-linear (x (/ x n))))))))
-
-(defthm cg/int-rewrite
-  (implies (and (integerp n)
-                (> n 0)
-                (rationalp x))
-           (equal (cg (* (cg x) (/ n)))
-                  (cg (/ x n))))
-  :hints (("Goal" :use ((:instance cg/int-1)
-			(:instance cg/int-2)))))
-
-(defthm cg/int-rewrite-alt
-  (implies (and (integerp n)
-                (> n 0)
-                (rationalp x))
-           (equal (cg (* (/ n) (cg x)))
-                  (cg (/ x n))))
-  :hints (("Goal" :use ((:instance cg/int-1)
-			(:instance cg/int-2)))))
-
-(defthm int-cg-rules
-  (implies (rationalp x)
-           (integerp (cg x)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm cg-int
-    (implies (integerp x)
-	     (equal (cg x) x)))
-
-(defthm cg-integerp
-    (implies (rationalp x)
-	     (equal (equal (cg x) x)
-                    (integerp x))))
-
-(defthm cg-unique
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (>= n x)
-		  (> (1+ x) n))
-	     (equal (cg x) n))
-  :rule-classes ())
-
-
-
-(defthm fl-cg
-  (implies (rationalp x)
-           (equal (cg x)
-                  (if (integerp x)
-                      (fl x)
-                    (1+ (fl x)))))
-  :rule-classes ())
-
-(defthm cg-integer-type
-  (integerp (cg x))
-  :rule-classes ( :type-prescription))
-
-(defthmd cg-def
-  (and (integerp (cg x))
-       (implies (case-split (rationalp x))
-                (and (>= (cg x) x)
-                     (> (1+ x) (cg x)))))
-  :rule-classes ((:linear :corollary
-                          (implies (case-split (rationalp x))
-                                   (and (>= (cg x) x)
-                                        (> (1+ x) (cg x)))))
-                 (:type-prescription :corollary
-                                     (integerp (cg x)))))
-
-(defthm cg-positive
-  (implies (case-split (not (complex-rationalp x)))
-           (equal (< 0 (cg x))
-                  (< 0 x)))
-  :hints (("Goal" :in-theory (enable cg)))
-  )
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/common-factor-defuns.lisp acl2-6.3/books/rtl/rel5/arithmetic/common-factor-defuns.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/common-factor-defuns.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/common-factor-defuns.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,166 +0,0 @@
-(in-package "ACL2")
-
-(include-book "inverted-factor")
-
-;combine with inverted-factor?
-
-#|
-
-Note.  I'd really like to use multi-sets to handle common factors that appear multiple times (e.g., x in 
-(+ (* x x) (* a x x)).  But for right now, we only handle one ocurrence of each factor.  (Multiple occurrences
-will be handled the next time our rules are tried.
-
-|#
-
-;todo: make these tail-recursive...
-
-(defund my-intersection-equal (x y)
-  (declare (xargs :guard (and (true-listp x) (true-listp y))))
-  (cond ((endp x) nil)
-	((member-equal (car x) y)
-	 (cons (car x) (my-intersection-equal (cdr x) y)))
-	(t (my-intersection-equal (cdr x) y))))
-
-(defun adjoin-equal (x l)
-  (declare (xargs :guard (true-listp l)))
-  (if (member-equal x l)
-      l
-    (cons x l)))
-
-
-;remove the first occurrence of x from l, if any...
-(defund remove-one (x l)
-  (declare (xargs :guard (true-listp l)))
-  (cond ((endp l) nil)
-        ((equal x (car l)) (cdr l))
-        (t (cons (car l) (remove-one x (cdr l))))))
-
-(defthm remove-one-preserves-true-listp
-  (implies (true-listp l)
-           (true-listp (remove-one x l)))
-  :hints (("Goal" :in-theory (enable remove-one))))
-
-
-;In this book, "ground-term" means any term except those which are calls to binary-+ or binary-*.
-
-;TERM is a product of one or more ground-terms.
-;Returns a list of the ground-terms which are multiplied in TERM.  The list will contain no duplicates.
-;Assumes TERM is normalized (either a single ground-term or a correctly associated product of ground-terms.)
-(defund get-factors-of-product (term)
-  (declare (xargs :guard (pseudo-termp term)))
-  (if (not (consp term)) ;term was a symbol
-      (list term)
-    (if (not (equal (car term) 'binary-*))
-        (list term) ;must be a ground-term...
-      (adjoin-equal (cadr term) (get-factors-of-product (caddr term))))))
-
-(defthm get-factors-of-product-true-listp
-  (true-listp (get-factors-of-product term))
-  :hints (("Goal" :in-theory (enable get-factors-of-product))))
-
-(in-theory (disable true-listp
-                    FACTOR-SYNTAXP
-                    PRODUCT-SYNTAXP
-                    SUM-OF-PRODUCTS-SYNTAXP))
-
-(defund find-inverted-factors-in-list (lst)
-  (declare (xargs :guard (true-listp lst)))  
-  (if (endp lst)
-      nil
-    (if (and (consp (car lst))
-             (equal (caar lst) 'unary-/))
-        (cons (car lst) (find-inverted-factors-in-list (cdr lst)))
-       (find-inverted-factors-in-list (cdr lst)))))
-
-(defund remove-cancelling-factor-pairs-helper (inverted-factor-lst lst)
-  (declare (xargs :guard (and (true-listp lst)
-                              (true-listp inverted-factor-lst))))
-  (if (endp inverted-factor-lst)
-      lst
-    (let* ((inverted-factor (car inverted-factor-lst))
-           (non-inverted-factor (and (consp inverted-factor)
-                                     (consp (cdr inverted-factor))
-                                     (cadr inverted-factor))))
-      (if (member-equal non-inverted-factor lst)
-          (remove-cancelling-factor-pairs-helper
-           (cdr inverted-factor-lst)
-           (remove-one inverted-factor 
-                       (remove-one non-inverted-factor 
-                                   lst)))
-        (remove-cancelling-factor-pairs-helper (cdr inverted-factor-lst) lst)))))
-
-(defthm remove-cancelling-factor-pairs-helper-preserves-true-listp
-  (implies (true-listp l)
-           (true-listp (remove-cancelling-factor-pairs-helper i l)))
-  :hints (("Goal" :in-theory (enable  remove-cancelling-factor-pairs-helper))))
-
-;removes any pair of elements <term> and (/ <term>) from the list, so that we don't cancel something that will
-;get blown away anyway.  Note that this is only an issue if we have unnormalized subterms, which *can* happen.
-(defund remove-cancelling-factor-pairs (lst)
-  (declare (xargs :guard (true-listp lst)))  
-  (let* ((inverted-factor-lst (find-inverted-factors-in-list lst)))
-    (if inverted-factor-lst
-        (remove-cancelling-factor-pairs-helper inverted-factor-lst lst)
-      lst)))
-
-(defthm remove-cancelling-factor-pairs-preserves-true-listp
-  (implies (true-listp l)
-           (true-listp (remove-cancelling-factor-pairs l)))
-  :hints (("Goal" :in-theory (enable  remove-cancelling-factor-pairs))))
-
-
-;TERM should be a "normalized sum of products" - "should" in what sense? BOZO
-;returns a list of the factors common to each product in TERM
-(defund find-common-factors-in-sum-of-products-aux (term)
-  (declare (xargs :guard (pseudo-termp term)))
-  (if (not (sum-of-products-syntaxp term))
-      nil
-    (if (not (consp term)) ;term was a symbol
-        (list term)
-      (case (car term)	
-        (binary-+ (my-intersection-equal (get-factors-of-product (cadr term))
-                                         (find-common-factors-in-sum-of-products-aux (caddr term))))
-        (otherwise (get-factors-of-product term)) ;must be a single product...
-        ))))
-
-(defthm find-common-factors-in-sum-of-products-aux-true-listp
-  (true-listp (find-common-factors-in-sum-of-products-aux term))
-  :hints (("Goal" :in-theory (enable find-common-factors-in-sum-of-products-aux))))
-
-;helps ensure that we don't cancel a factor whose inverse is also a factor (in this case the bad factor won't
-;be considered a "common factor" of whichever side also has its inverse among its factors.
-(defund find-common-factors-in-sum-of-products (term)
-  (declare (xargs :guard (pseudo-termp term)))  
-  (remove-cancelling-factor-pairs (find-common-factors-in-sum-of-products-aux term)))
-
-(defthm find-common-factors-in-sum-of-products-true-listp
-  (true-listp (find-common-factors-in-sum-of-products term))
-  :hints (("Goal" :in-theory (enable find-common-factors-in-sum-of-products))))
-
-;(REMOVE-CANCELLING-FACTOR-PAIRS '(a b (unary-/ a) d d d c (unary-/ d) (unary-/ d) (unary-/ d)))
-
-(defund make-product-from-list-of-factors (lst)
-  (declare (xargs :guard (true-listp lst)))  
-  (if (endp lst)
-      1
-    (if (endp (cdr lst))
-        (car lst)
-      (list 'binary-* (car lst) (make-product-from-list-of-factors (cdr lst))))))
-
-(defun find-common-factors-to-cancel (lhs rhs)
-  (declare (xargs :guard (and (pseudo-termp lhs) (pseudo-termp rhs))))  
-  (remove-cancelling-factor-pairs ; do we need this call?
-   (my-intersection-equal
-    (find-common-factors-in-sum-of-products lhs)
-    (find-common-factors-in-sum-of-products rhs))))
-
-(defund bind-k-to-common-factors (lhs rhs)
-  (declare (xargs :guard-hints (("Goal" :use (:instance remove-cancelling-factor-pairs-preserves-true-listp
-                                                        (l (MY-INTERSECTION-EQUAL (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS LHS)
-                                                                                  (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS RHS))))))
-                  :guard (and (pseudo-termp lhs) (pseudo-termp rhs))))
-  (let* ((common-factor-list (find-common-factors-to-cancel lhs rhs)))
-    (if (endp common-factor-list)
-        nil
-      (list (cons 'k (make-product-from-list-of-factors common-factor-list))))))
-                  
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/common-factor.lisp acl2-6.3/books/rtl/rel5/arithmetic/common-factor.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/common-factor.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/common-factor.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,129 +0,0 @@
-(in-package "ACL2")
-
-                  
-(include-book "meta/meta-times-equal" :dir :system)
-(include-book "meta/meta-plus-equal" :dir :system)
-(include-book "meta/meta-plus-lessp" :dir :system)
-
-(include-book "common-factor-defuns")
-
-(defthm mult-both-sides-of-equal
-  (implies (and (case-split (acl2-numberp a))
-                (case-split (acl2-numberp b))
-                (case-split (acl2-numberp c))
-                )
-           (equal (equal (* a c) (* b c)) 
-                  (if (equal c 0)
-                      t
-                    (equal a b))))
-  :rule-classes nil)
-
-;BOZO see a9
-(defthm COMMUTATIVITY-2-OF-*
-  (equal (* x (* y z)) (* y (* x z))))
-
-;BOZO see a8
-(defthm inverse-of-*-2
-  (implies (and (case-split (acl2-numberp x))
-                (case-split (not (equal x 0))))
-           (equal (* x (* (/ x) y)) (fix y)))
-  :hints (("Goal" :cases ((acl2-numberp x))))
-  )
-   
-(defthm cancel-common-factors-in-equal
-  (implies (and (bind-free (bind-k-to-common-factors lhs rhs) (k))
-                (case-split (not (equal 0 k)))
-                (case-split (acl2-numberp k))
-                (case-split (acl2-numberp lhs))
-                (case-split (acl2-numberp rhs))
-                )
-                (equal (equal lhs rhs)
-                       (equal (* (/ k) lhs) (* (/ k) rhs))))
-  :hints (("Goal" :use (:instance  mult-both-sides-of-equal (a lhs) (b rhs) (c (/ k))))))
-
-(local (include-book "predicate"))
-(local (include-book "fp2"))
-
-;changed the var names 'cause "x" was too heavy
-;BOZO gen?, rephrase
-(defthm cancel-in-prods-<
-  (implies (and (rationalp a)
-                (rationalp b)
-                (rationalp c))
-           (equal (< (* a b) (* a c))
-                  (if (equal 0 a)
-                      nil
-                    (if (> a 0)
-                        (< b c)
-                      (> b c))))))
-
-;BOZO gen?
-(defthm cancel-common-factors-in-<
-  (implies (and (bind-free (bind-k-to-common-factors lhs rhs) (k))
-                (syntaxp (not (equal lhs rhs))) ;don't apply to (< x x) since we can cause case-splits...
-                ;BOZO is a check like the above needed for the equal case?  I'm guessing not...
-                (case-split (not (equal 0 k)))
-                (case-split (rationalp k))
-                (case-split (rationalp lhs))
-                (case-split (rationalp rhs))
-                )
-                (equal (< lhs rhs)
-                       (if (< 0 k)
-                           (< (* (/ k) lhs) (* (/ k) rhs))
-                         (if (equal 0 k)
-                             nil
-                           (< (* (/ k) rhs) (* (/ k) lhs))
-                           ))))
-  :hints (("Goal" :use (:instance  cancel-in-prods-< (a lhs) (b rhs) (c (/ k))))))
-
-(defun find-common-factors-to-cancel-1 (expr)
-  (declare (xargs :guard (and (pseudo-termp expr))))  
-  (remove-cancelling-factor-pairs
-   (find-common-factors-in-sum-of-products expr)))
-
-(defund bind-k-to-common-factors-1 (expr)
-  (declare (xargs :guard-hints (("Goal" :use (:instance remove-cancelling-factor-pairs-preserves-true-listp
-                                                        (l (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS expr)))))
-                  :guard (and (pseudo-termp expr))))
-  (let* ((common-factor-list (find-common-factors-to-cancel-1 expr)))
-    (if (endp common-factor-list)
-        nil
-      (list (cons 'k (make-product-from-list-of-factors common-factor-list))))))
-
-(local (include-book "product"))
-
-(defthm cancel-common-factors-in-equal-with-0
-  (implies (and (bind-free (bind-k-to-common-factors-1 rhs) (k))
-                (syntaxp (not (equal k rhs))) ;helps prevent loops
-                (case-split (not (equal 0 k)))
-                (case-split (rationalp k))
-                (case-split (rationalp lhs))
-                (case-split (rationalp rhs))
-                )
-           (equal (equal 0 rhs)
-                  (or (equal 0 k) (equal 0 (* (/ k) rhs))))))
-
-#|
-;BOZO
-(defthm cancel-common-factors-<-0
-  (implies (and (bind-free (bind-k-to-common-factors-1 rhs) (k))
-                (case-split (not (equal 0 k)))
-                (case-split (rationalp k))
-                (case-split (rationalp lhs))
-                (case-split (rationalp rhs))
-                )
-           (equal (equal 0 rhs)
-                  (or (equal 0 k) (equal 0 (* (/ k) rhs))))))
-|#
-
-
-  
-
-
-;check that the inverse isn't a factor too...
-
-
-;returns an alist binding k to the product of all common factors in term 
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/complex-rationalp.lisp acl2-6.3/books/rtl/rel5/arithmetic/complex-rationalp.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/complex-rationalp.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/complex-rationalp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "predicate"))
-
-(defthm complex-rationalp-+-when-second-term-is-rational
-  (implies (rationalp y)
-           (equal (complex-rationalp (+ x y))
-                  (complex-rationalp x))))
-
-(defthm complex-rationalp-+-when-second-term-is-not-complex
-  (implies (not (complex-rationalp y))
-           (equal (complex-rationalp (+ x y))
-                  (complex-rationalp x))))
-
-(defthm complex-rationalp-+-when-first-term-is-rational
-  (implies (rationalp x)
-           (equal (complex-rationalp (+ x y))
-                  (complex-rationalp y))))
-
-(defthm complex-rationalp-+-when-first-term-is-not-complex
-  (implies (not (complex-rationalp x))
-           (equal (complex-rationalp (+ x y))
-                  (complex-rationalp y))))
-
-;add more cases
-(defthm complex-rationalp-*-drop-first-term-if-rational
-  (implies (and (case-split (not (equal y 0)))
-                (rationalp y))
-           (equal (complex-rationalp (* y x))
-                  (complex-rationalp x))))
-
-
-#|
-(defthm complex-rationalp-*-drop-first-term-if-not-complex
-  (implies (and (case-split (not (equal y 0)))
-                (not (complex-rationalp y))
-                )
-           (equal (complex-rationalp (* y x))
-                  (complex-rationalp x))))
-|#
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/denominator.lisp acl2-6.3/books/rtl/rel5/arithmetic/denominator.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/denominator.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/denominator.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "ground-zero"))
-(local (include-book "fp2"))
-
-;denom of non-rat?
-
-(defthm denominator-positive-integer-type-prescription
-  (and (< 0 (denominator x))
-       (integerp (denominator x)))
-  :rule-classes (:type-prescription))
-
-(defthm denominator-positive
-  (< 0 (denominator x))
-  :rule-classes (:rewrite :linear))
-
-(defthm denominator-integerp
-  (integerp (denominator x)))
-
-(defthm denominator-one-means-integer
-  (implies (case-split (rationalp x))
-           (equal (equal (denominator x) 1)
-                  (integerp x)))
-  :hints (("goal" :in-theory (disable rational-implies2)
-           :use (rational-implies2
-                 (:instance lowest-terms 
-                            (n (denominator x))
-                            (r x) 
-                            (q 1))))))
-
-(defthm denominator-of-integer-is-one
-  (implies (integerp x)
-           (equal (denominator x)
-                  1)))
-;linear?
-(encapsulate
- ()
- (local (include-book "arithmetic/mod-gcd" :dir :system))
- (defthm denominator-lower-bound
-   (implies (and (< 0 q)
-                 (integerp p)
-                 (integerp q)
-                 )
-            (<= (denominator (* p (/ q))) q))
-   :hints (("goal" :use (:instance least-numerator-denominator-<= (n p) (d q))))
-   ))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/even-odd.lisp acl2-6.3/books/rtl/rel5/arithmetic/even-odd.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/even-odd.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/even-odd.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,221 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "integerp"))
-(local (include-book "predicate"))
-(local (include-book "fp2"))
-
-;a funny little rule:
-;can be expensive!
-;perhaps should export disabled
-;make a forward-chaining rule?
-(defthmd even-int-implies-int
-  (implies (and (integerp (* 1/2 x))
-                (rationalp x) ;gen?
-                )
-           (integerp x))
-  :rule-classes ((:rewrite :backchain-limit-lst (1 nil)))
-  :hints (("Goal" :in-theory (disable integerp-prod)
-           :use (:instance integerp-prod (x (* 1/2 x)) (y 2)))))
-
-;this book is currently a mess.
-
-;normal forms: leave evenp and oddp enabled
-
-;from basic
-(defun INDUCT-NAT (x)
-  (if (and (integerp x)
-	   (> x 0))
-      (induct-nat (1- x))
-    ()))
-
-
-(local
- (defthm x-or-x/2-4
-   (implies (and (integerp x) (>= x 0))
-            (or (integerp (/ x 2)) (integerp (/ (1+ x) 2))))
-   :rule-classes ()
-   :hints (("Goal" :induct (induct-nat x)))))
-
-;is this sort of thing elsewhere? integerp.lisp?
-(defthm integerp-+
-  (implies (and (integerp x)
-                (integerp y))
-           (integerp (+ x y))))
-
-(defthm x-or-x/2
-  (implies (integerp x) 
-           (or (integerp (/ x 2)) (integerp (/ (1+ x) 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable integerp-+)
-           :use ((:instance integerp-+ (x (+ 1/2 (* -1/2 X))) (y x))
-                 (:instance x-or-x/2-4)
-                 (:instance x-or-x/2-4 (x (- x)))))))
-
-
-
-;end stuff from basic
-
-(encapsulate
- ()
- (local (defthm hack-int
-          (implies (and (integerp x)
-                        (integerp y))
-                   (integerp (+ x y)))))
-
- (defthm integerp-sum-of-odds-over-2
-   (implies (and (rationalp x)
-                 (rationalp y)
-                 (integerp (* 2 x)) ;these two hyps say x is of the form (odd)/2
-                 (not (integerp x)) ;
-                 )
-            (equal (integerp (+ x y))
-                   (and (integerp (* 2 y))
-                        (not (integerp y)) ; (oddp (* 2 y)) ;rephrase the oddp hyps?
-                        )))
-   :hints (("Goal" :in-theory (disable even-int-implies-int)
-            :use ( (:instance even-int-implies-int (x (+ (* 2 x) (* 2 y))))
-                   (:instance hack-int (x (+ 1/2 X)) (y (+ 1/2 y)))
-                   (:instance x-or-x/2 (x (* 2 x)))
-                   (:instance x-or-x/2 (x (* 2 y)))))))
- )
-
-;derive the results below from the above (or eliminate them)
-
-(in-theory (disable integerp-sum-of-odds-over-2))
-
-;make this a rewrite?
-;special case
-(defthm integerp-sum-of-odds-over-2-leading-constant
-  (implies (and (syntaxp (and (quotep x)
-                              (integerp (* 2 x)) ;;these two hyps say x is of the form (odd)/2
-                              (not (integerp x)) ;; 
-                              ))
-                (rationalp x)
-                (rationalp y)
-                (integerp (* 2 x)) ;;these two hyps say x is of the form (odd)/2
-                (not (integerp x)) ;;
-                (integerp (* 2 y))
-                (not (integerp y)) ; (oddp (* 2 y)) ;rephrase the oddp hyps?
-                )
-           (integerp (+ x y)))
-  :hints (("Goal" :use integerp-sum-of-odds-over-2)))
-
-;do we need all this stuff?
-
-;(defthm even-or-odd
- ; (implies (integerp x)
-  ;         (or (evenp x) (oddp x)))
-  ;:rule-classes nil)
-
-;should be a rewrite? - general rewrites for evenp/oddp of sum/diff?
-;(defthm odd-+-1
- ; (implies (and (integerp x)
-  ;              (oddp x))
-   ;        (evenp (+ 1 x)))
-  ;:hints (("Goal" :use (:instance x-or-x/2 ))))
-
-;(defthm odd/2-plus-1/2
- ; (implies (and (integerp x)
-  ;              (oddp x))
-   ;        (integerp (+ 1/2 (/ x 2))))
-  ;:hints (("Goal" :use (:instance odd-+-1))))
-
-;hack, don't leave enabled ;rewrite?
-;(defthm integerp-next
- ; (implies (and (rationalp x)
-  ;              (integerp (+ x 1)))
-   ;        (integerp x)))
-
-;(defthm odd/2-minus-1/2
- ; (implies (and (integerp x)
-  ;              (oddp x))
-   ;        (integerp (+ -1/2 (/ x 2))))
-  ;:hints (("Goal" :use (:instance odd/2-plus-1/2))))
-
-;(in-theory (disable integerp-next))
-
-;(defthm odd/2-minus-1/2-alt
- ; (implies (and (integerp x)
-  ;              (oddp x))
-   ;        (integerp (+ -1/2 (* 1/2 x))))
- ; :hints (("Goal" :in-theory (disable  odd/2-minus-1/2)
-  ;         :use (:instance  odd/2-minus-1/2))))
-
-;floor of odd/2 is odd/2 -1/2
-
-
- ;; :hints (("Goal" :use ( (:instance  fl-unique 
-   ;                                  (x (* 1/2 x))
-    ;                                 (n (- (* 1/2 x) 1/2)))))))
-
-
-;needed?
-
-(defthm even-and-odd-alternate-eric
-  (implies (and (rationalp x)
-                (integerp (* 2 x)))
-           (equal (integerp (+ 1/2 x))
-                  (not (integerp x)))))
-
-
-;should this go in type.lisp?
-;needed? ;lets change any leading constant of -1/2 to 1/2 and elim this rule
-(defthm even-and-odd-alternate-3
-  (implies (and (integerp x))
-           (equal (integerp (+ -1/2 (* -1/2 x)))
-                  (not (integerp (* 1/2 x)))))
-  :hints (("Goal" :in-theory (disable integerp-minus)
-           :use (:instance integerp-minus (x (+ -1/2 (* -1/2 x)))))))
-
-#| never finished this
-(defthm integerp-+-odd-over-2-reduce
-  (implies (and (rationalp x)
-                (integerp (* 2 x)) ;these two hyps say x is of the form (odd)/2
-                (not (integerp x))
-                (rationalp y))
-           (implies (integerp (+ x y))
-                    (and (integerp (* 2 y)) ;these two hyps say x is of the form (odd)/2
-                         (not (integerp y))))) ;
-  :otf-flg t
-  :hints (("Goal" :use  integerp-sum-of-odds-over-2)))
-|#
-
-
-
-
-(defthm even-and-odd-alternate-eric-2-bk
-  (implies (rationalp x)
-           (implies (and (integerp (* 2 x))
-                         (not (integerp x)))
-                    (integerp (+ 1/2 x)))))
-
-;if s is even, then s-1 is odd
-(defthm even-odd-5
-  (implies (and (rationalp x)
-                (integerp (* 1/2 x)))
-           (and (integerp (- x 1))
-                (not (integerp (* 1/2 (- x 1))))))
-  :hints (("Goal" :in-theory (enable even-int-implies-int)))
-)
-
-
-(defthm even-and-odd-alternate-eric-2-fw
-  (implies (rationalp x)
-           (implies (integerp (+ 1/2 x))
-                  (and (integerp (* 2 x))
-                       (not (integerp x)))))
-  :hints (("Goal"
-           :in-theory (disable even-odd-5)
-           :use (:instance even-odd-5 (x (+ 1 (* 2 x)))))))
-
-
-;replace the 1/2 rules above and similarly generalize the rules at the top to be equal rules
-(defthm even-and-odd-alternate-eric-2
-  (implies (rationalp x)
-           (equal (integerp (+ 1/2 x))
-                  (and (integerp (* 2 x))
-                       (not (integerp x))))))
-
-(in-theory (disable  even-and-odd-alternate-eric-2-fw even-and-odd-alternate-eric-2-bk))
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/even-odd2-proofs.lisp acl2-6.3/books/rtl/rel5/arithmetic/even-odd2-proofs.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/even-odd2-proofs.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/even-odd2-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,280 +0,0 @@
-(in-package "ACL2")
-
-;This is different from the book even-odd.  (We define new functions here.)
-
-;I could take pains to define functions that agree with evenp and oddp for all inputs (complex-rationalps are
-;a little weird).  But for now, I'll just focus on the integers.
-
-;more stuff like this is in x-2xx.lisp
-
-;a recursive version of even
-
-(local (include-book "integerp"))
-(local (include-book "arith"))
-(local (include-book "arith2"))
-(local (include-book "fp2")) ;ugh
-
-(in-theory (disable evenp))
-
-;x should be a non-negative integer
-(defund even-aux (x)
-  (if (zp x)
-      t
-    (if (eql 1 x)
-        nil
-      (even-aux (+ -2 x)))))
-
-(defthm even-aux-reduce-1
-  (implies (case-split (not (zp x)))
-           (equal (even-aux (+ -1 x))
-                  (not (even-aux x))))
-  :hints (("goal" :in-theory (enable even-aux)))
-  )
-
-;this loops with defn even-aux?
-(defthmd even-aux-reduce-2
-  (implies (and (integerp x)
-                (< 1 x))
-           (equal (even-aux (+ -2 x))
-                  (even-aux x)))
-  :hints (("goal" :in-theory (enable even-aux)))
-  )
-
-(defthm even-aux-reduce-3
-  (implies (case-split (not (zp x)))
-           (equal (even-aux (+ 1 x))
-                  (not (even-aux x))))
-  :hints (("goal" :expand (EVEN-AUX (+ 1 X))
-           :in-theory (enable even-aux-reduce-2)))
-  )
-
-(defthm even-plus-even-pos-aux
-  (implies (and (even-aux x)
-                (even-aux y)
-                (integerp x)
-                (<= 0 x)
-                (<= 0 y)
-                )
-           (even-aux (+ x y)))
-  :hints (("Goal" :in-theory (enable even-aux zp))))
-
-(defthm even-minus-even-pos-aux
-  (implies (and (even-aux x)
-                (even-aux y)
-                (integerp x)
-                (integerp y)
-                (<= 0 x)
-                (<= 0 y)
-                )
-           (even-aux (- x y)))
-  :hints (("Subgoal *1/6" :cases ((equal y x) (equal y (+ -1 x)))
-           :in-theory (set-difference-theories  
-                       (enable even-aux-reduce-2)
-                       '(even-aux)))
-          ("Goal" :cases (<= y x)
-           :in-theory (enable even-aux))))
-
-;note that even is not the same as the built in function evenp
-;handle complex numbers?
-(defund even (x)
-  (if (not (integerp x))
-      nil
-    (if (< x 0)
-        (even-aux (- x))
-      (even-aux x))))
-
-;keep disabled?
-(defthmd even-is-evenp-pos
-  (implies (and (integerp x)
-                (<= 0 x))
-           (equal (even-aux x) (evenp x)))
-  :hints (("Goal" :in-theory (enable even-aux evenp))))
-
-(defthmd even-is-evenp
-  (implies (integerp x)
-           (equal (even x) (evenp x)))
-  :hints (("Goal" :in-theory (enable even evenp ;or prove evenp-minus
-                                     even-is-evenp-pos
-                                      ))))
-
-(defthm even-aux-negative
-  (implies (<= x 0)
-           (even-aux x))
-  :hints (("Goal" :in-theory (enable even-aux)))
-  )
-
-(defthm even-minus
-  (implies (case-split (acl2-numberp x))
-           (equal (EVEN (* -1 X))
-                  (even x)))
-  :hints (("Goal" :in-theory (enable even)))
-  )
-
-(defthm even-means-integerp
-  (implies (even x)
-           (integerp x))
-  :hints (("Goal" :in-theory (enable even)))
-  :rule-classes (;:compound-recognizer
-                 :forward-chaining))
-
-;export
-(defthm even-plus-even
-  (implies (and (even x)
-                (even y)
-                )
-           (even (+ x y)))
-  :otf-flg t
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable EVEN)
-                              '( even-minus-even-pos-aux EVEN-PLUS-EVEN-POS-aux))
-           :use( (:instance even-plus-even-pos-aux (x x) (y y))
-                 (:instance even-plus-even-pos-aux (x (- x)) (y (- y)))
-                 (:instance even-minus-even-pos-aux (x x) (y (- y)))
-                 (:instance even-minus-even-pos-aux (x (- x)) (y y))
-                 (:instance even-minus-even-pos-aux (x (- y)) (y x))
-                 (:instance even-minus-even-pos-aux (x y) (y (- x)))))))
-
-;export
-;we don't disable even-plus-even, despite the use hint
-(defthm even-sum-rewrite-1
-  (implies (and (even x)
-                (case-split (acl2-numberp y))
-                )
-           (and (equal (even (+ x y))
-                       (even y))
-                (equal (even (+ y x))
-                       (even y))))
-  :hints (("Goal" :use (:instance even-plus-even (x (* -1 x)) (y (+ x y)))))) 
-
-(defund odd (x)
-  (and (integerp x)
-       (not (even x))))
-
-(defthm odd-means-integerp
-  (implies (odd x)
-           (integerp x))
-  :hints (("Goal" :in-theory (enable odd)))
-  :rule-classes (;:compound-recognizer
-                 :forward-chaining))
-
-(defthm odd-plus-even
-  (implies (and (odd x)
-                (even y))
-           (and (odd (+ x y))
-                (odd (+ y x))))
-  :hints (("Goal" :in-theory (enable odd))))
-
-
-(defthm odd-sum-rewrite-1
-  (implies (even x)
-           (and (equal (odd (+ x y))
-                       (odd y))
-                (equal (odd (+ y x))
-                       (odd y))))
-  :hints (("Goal" :in-theory (enable odd) )))
-
-#|
-
-there are plenty more nice even-odd theorems
-
-(defthm even-sum-rewrite
-  (implies (and (integerp x)
-                (integerp y))
-           (equal (even (+ x y))
-                  (or (and (even x) (even y))
-                      (and (odd x) (odd y)))))
-  :hints (("Goal" :in-theory (enable odd))))
-
-plus rules to rewrite oddp and evenp   
-
-(defthm oddp-sum
-  (implies (and (integerp x)
-                (integerp y))
-           (equal (oddp (+ x y))
-                  (or (and (oddp x) (evenp y))
-                      (and (evenp x) (oddp y))))))
-|#
-
-
-
-
-;yuck.  generalize?
-;does this loop with the defn of even?
-(defthm even-reduce
-  (implies (case-split (integerp n))
-           (equal (EVEN (+ -1 N))
-                  (not (even n))))
-  :hints (("Goal" :in-theory (enable even)))
-)
-
-
-(defthm odd-reduce
-  (implies (case-split (integerp n))
-           (equal (ODD (+ -1 N))
-                  (not (odd n))))
-  :hints (("Goal" :in-theory (enable odd))))
-
-
-(defthm odd-plus-odd
-  (implies (and (odd x)
-                (odd y))
-           (even (+ x y)))
-  :hints (("Goal" 
-           :use ((:instance odd-reduce (n (+ x y 1)))
-                 (:instance odd-reduce (n (+ x 1)))
-                 (:instance even-plus-even (x (+ 1 X Y)) (y (- (+ 1 x))))
-                 )
-           :in-theory (set-difference-theories
-                       (enable odd)
-                       '(odd-reduce)))))
-
-(defthm odd-sum-rewrite-2
-  (implies (and (odd x)
-                (case-split (acl2-numberp y))
-                )
-           (and (equal (odd (+ x y))
-                       (even y))
-                (equal (odd (+ y x))
-                       (even y))))
-  :hints (("Goal" :in-theory (enable odd) )))
-
-(defun induct-scheme (n)
-  (if (zp n)
-      t
-    (cons 'a (induct-scheme (+ -1 n)))))
-
-(defthm even-double-pos
-  (implies (and (integerp x)
-                (<= 0 x))
-           (even (* 2 x)))
-  :hints (("Goal" :induct (induct-scheme x)
-           :in-theory (enable even even-aux))))
-
-(defthm even-double
-  (implies (integerp x)
-           (even (* 2 x)))
-  :hints (("Goal" :use ((:instance even-double-pos)
-                        (:instance even-minus (x (* 2 x))); or improve even-minus with negative-syntaxp?
-                        (:instance even-double-pos (x (- x))))
-           :in-theory (disable even-minus even-double-pos))))
-
-(defthm odd-double
-  (implies (integerp x)
-           (not (odd (* 2 x))))
-  :hints (("Goal" :in-theory (enable odd))))
-
-
-(defthm even-sum-rewrite-2
-  (implies (odd x)
-           (and (equal (even (+ x y))
-                       (odd y))
-                (equal (even (+ y x))
-                       (odd y))))
-  :hints (("Goal" :cases ((acl2-numberp y))
-           :in-theory (enable odd))))
-
-(defthm even-means-half-is-integer
-  (implies (even x)
-           (integerp (* 1/2 x)))
-  :hints (("goal" :use even-is-evenp
-           :in-theory (enable evenp))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/even-odd2.lisp acl2-6.3/books/rtl/rel5/arithmetic/even-odd2.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/even-odd2.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/even-odd2.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,163 +0,0 @@
-(in-package "ACL2")
-
-;This is different from the book even-odd.  (We define new functions EVEN and ODD here.)
-;This book contains only the results I want to export.  The proofs are in even-odd2-proofs.lisp
-;I could take pains to define functions that agree with evenp and oddp for all inputs (complex-rationalps are
-;a little weird).  But for now, I'll just focus on the integers.
-;Perhaps see also the function REVEN in x-2xx.lisp
-
-(include-book "ground-zero")
-(local (include-book "even-odd2-proofs"))
-
-;just a helper function
-(defund even-aux (x)
-  (if (zp x)
-      t
-    (if (eql 1 x)
-        nil
-      (even-aux (+ -2 x)))))
-
-;A recursive recognizer for even integers.
-;Note that EVEN is not the same as the built in function EVENP
-;handle complex numbers?
-(defund even (x)
-  (if (not (integerp x))
-      nil
-    (if (< x 0)
-        (even-aux (- x))
-      (even-aux x))))
-
-;A recognizer for odd integers.
-;Most theorems about ODD follow from theorems about EVEN.
-(defund odd (x)
-  (and (integerp x)
-       (not (even x))))
-
-;keep disabled?
-(defthmd even-is-evenp
-  (implies (integerp x)
-           (equal (even x) (evenp x))))
-
-(defthm even-minus
-  (implies (case-split (acl2-numberp x))
-           (equal (even (* -1 x))
-                  (even x))))
-
-;not currently a rewrite rule
-(defthm even-means-integerp
-  (implies (even x)
-           (integerp x))
-  :rule-classes (;:compound-recognizer
-                 :forward-chaining)) 
-
-;not currently a rewrite rule
-(defthm odd-means-integerp
-  (implies (odd x)
-           (integerp x))
-  :rule-classes (;:compound-recognizer
-                 :forward-chaining))
-
-(defthm even-sum-rewrite-1
-  (implies (and (even x)
-                (case-split (acl2-numberp y))
-                )
-           (and (equal (even (+ x y))
-                       (even y))
-                (equal (even (+ y x))
-                       (even y)))))
-
-(defthm even-sum-rewrite-2
-  (implies (odd x)
-           (and (equal (even (+ x y))
-                       (odd y))
-                (equal (even (+ y x))
-                       (odd y)))))
-
-(defthm odd-sum-rewrite-1
-  (implies (even x)
-           (and (equal (odd (+ x y))
-                       (odd y))
-                (equal (odd (+ y x))
-                       (odd y)))))
-
-(defthm odd-sum-rewrite-2
-  (implies (and (odd x)
-                (case-split (acl2-numberp y))
-                )
-           (and (equal (odd (+ x y))
-                       (even y))
-                (equal (odd (+ y x))
-                       (even y)))))
-
-
-;avoid loops
-;wait, why would even ever be around?
-(theory-invariant (incompatible (:rewrite even-reduce) (:definition even-aux)))
-
-;yuck.  generalize?
-(defthm even-reduce
-  (implies (case-split (integerp n))
-           (equal (even (+ -1 n))
-                  (not (even n)))))
-
-
-(defthm odd-reduce
-  (implies (case-split (integerp n))
-           (equal (odd (+ -1 n))
-                  (not (odd n)))))
-
-(defthm even-double
-  (implies (integerp x)
-           (even (* 2 x))))
-
-(defthm odd-double
-  (implies (integerp x)
-           (not (odd (* 2 x)))))
-
-
-;do we want this enabled?
-;Eric needed this for an RTL proof, but perhaps we should think more about how to handle this.
-(defthm even-means-half-is-integer
-  (implies (even x)
-           (integerp (* 1/2 x))))
-
-#|
-
-there are plenty more nice even-odd theorems
-
-(defthm even-sum-rewrite
-  (implies (and (integerp x)
-                (integerp y))
-           (equal (even (+ x y))
-                  (or (and (even x) (even y))
-                      (and (odd x) (odd y)))))
-  :hints (("Goal" :in-theory (enable odd))))
-
-plus rules to rewrite oddp and evenp   
-
-(defthm oddp-sum
-  (implies (and (integerp x)
-                (integerp y))
-           (equal (oddp (+ x y))
-                  (or (and (oddp x) (evenp y))
-                      (and (evenp x) (oddp y))))))
-
-
-
-;move? ;or just prove rules like EVEN-SUM-REWRITE-1, etc. about even-aux
-(defthm even-aux-reduce-by-4
-  (implies (and (case-split (integerp n))
-                (case-split (<= 4 n)))
-           (equal (even-aux (+ -4 n))
-                  (even-aux n)))
-  :hints (("Goal" :in-theory (e/d (even odd) (ODD-REDUCE EVEN-REDUCE  EVEN-SUM-REWRITE-1
-                                                   ODD-SUM-REWRITE-1
-                                                    EVEN-SUM-REWRITE-2
-                                                     ODD-SUM-REWRITE-2))
-           :use ((:instance even-reduce (n n))
-                 (:instance even-reduce (n (+ -1 n)))
-                 (:instance even-reduce (n (+ -2 n)))
-                 (:instance even-reduce (n (+ -3 n)))))))
-|#
-
-   
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/expo-proofs.lisp acl2-6.3/books/rtl/rel5/arithmetic/expo-proofs.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/expo-proofs.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/expo-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,928 +0,0 @@
-(in-package "ACL2")
-
-;this book includes proofs mixing expo and expt and power2p.
-
-;(include-book
-; "include-book-macros")
-;(include-book
-; "float") ;remove!
-(include-book "negative-syntaxp")
-(include-book "power2p")
-(include-book "unary-divide")
-(include-book "arith2")
-(include-book "integerp")
-(local (include-book "fl"))
-(local (include-book "expt"))
-;(local (include-book "expo"))
-
-(local (in-theory (enable expt-minus)))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ordinals/e0-ordinal" :dir :system)
-(set-well-founded-relation e0-ord-<)
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-
-;probably get this anyway when we define expo
-(defthm expo-integer-type
-  (integerp (expo x))
-  :rule-classes :type-prescription)
-
-;(:type-prescription expo) is no better than expo-integer-type and might be worse:
-(in-theory (disable (:type-prescription expo)))
-
-(defthm expo-of-not-rationalp
-  (implies (not (rationalp x))
-           (equal (expo x) 0))
-  :hints (("Goal" :in-theory (enable expo))))
-
-
-;be careful: if you enable expo, the x<0 case of expo can loop with expo-minus
-;(see expo-minus-invariant)
-(defthmd expo-minus
-  (equal (expo (* -1 x))
-         (expo x))
-  :hints (("Goal" :in-theory (enable expo))))
-
-;rename?
-(defthm expo-minus-eric
-  (implies (syntaxp (negative-syntaxp x))
-           (equal (expo x) 
-                  (expo (* -1 x))))
-  :hints (("Goal" :in-theory (enable expo-minus))))
-
-
-(theory-invariant
- (not (and (or (active-runep '(:rewrite expo-minus))
-               (active-runep '(:rewrite expo-minus-eric)))
-           (active-runep '(:definition expo))))
- :key expo-minus-invariant)
-
-
-(local (in-theory (disable expo-minus expo-minus-eric)))
-
-(defthm expo-lower-bound
-  (implies (and (rationalp x)
-                (not (equal x 0)))
-           (<= (expt 2 (expo x)) (abs x)))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (enable expo expt-split))))
-
-(defthm expo-lower-pos
-  (implies (and (< 0 x)
-                (rationalp x)
-                )
-           (<= (expt 2 (expo x)) x))
-  :rule-classes :linear)
-
-(local
- (defthm expo-upper-bound-old
-  (implies (and (rationalp x)
-                (not (equal x 0)))
-           (< (abs x) (expt 2 (1+ (expo x)))))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expo expt-split)
-                              '())
-           :cases ((equal x 0))))))
-
-
-                
-(defthm expo-upper-bound
-  (implies (rationalp x)
-           (< (abs x) (expt 2 (1+ (expo x)))))
-  :rule-classes :linear
-  :hints (("Goal" :use (expo-upper-bound-old))))
-
-(defthm expo-upper-pos
-  (implies (rationalp x)
-           (< x (expt 2 (1+ (expo x)))))
-  :rule-classes :linear)
-
-
-
-(local
- (defthm expo-unique-2
-   (implies (and (rationalp x)
-                 (not (equal x 0))
-                 (integerp n)
-                 (> n (expo x)))
-            (> (expt 2 n) (abs x)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (disable abs)
-            :use ( ;(:instance expo-upper-bound)
-                  (:instance expt-weak-monotone (n (1+ (expo x))) (m n)))))))
-
-(local
- (defthm expo-unique-1
-   (implies (and (rationalp x)
-                 (not (equal x 0))
-                 (integerp n)
-                 (< n (expo x)))
-            (<= (expt 2 (1+ n)) (abs x)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (disable abs)
-            :use ((:instance expt-weak-monotone (n (1+ n)) (m (expo x))))))))
-
-
-
-(defthm expo-unique
-  (implies (and (<= (expt 2 n) (abs x))
-                (< (abs x) (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal n (expo x)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-           :use ((:instance expo-unique-1)
-                 (:instance expo-unique-2)))))
-
-;shouldn't have the abs??
-(defthmd expo-monotone
-  (implies (and (<= (abs x) (abs y))
-                (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                (case-split (rationalp y))
-                )
-           (<= (expo x) (expo y)))
-  :rule-classes :linear
-  :hints (("Goal"
-           :use (;(:instance expo-lower-bound)
-                 (:instance expo-unique-2 (n (expo x)) (x y))))))
-
-(defthm expo-2**n
-  (implies (integerp n)
-           (equal (expo (expt 2 n))
-                  n))
-  :hints (("Goal" :use ((:instance expo-unique (x (expt 2 n)))
-			(:instance expt-strong-monotone (m (1+ n)))))))
-
-;expo-half (and expo-double, sort of) makes the proof of expo-shift go through
-;move
-;worry about loops?
-(defthm expo-half
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                )
-           (equal (expo (* 1/2 x))
-              (+ -1 (expo x))))
-  :hints (("Goal" :in-theory (enable expo expt))))
-
-;move
-;worry about loops?
-(defthm expo-double
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                )
-           (equal (expo (* 2 x))
-              (+ 1 (expo x))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expo expt)
-                              '(expo-minus)))))
-
-(theory-invariant (incompatible (:rewrite expo-half)
-                                (:definition expo)
-                                )
-                  :key expo-half-loops-with-defn-expo)
-
-(theory-invariant (incompatible (:rewrite expo-double)
-                                (:definition expo)
-                                )
-                  :key expo-double-loops-with-defn-expo)
-
-(defthm expo-shift
-  (implies (and (rationalp x)
-                (not (equal x 0))
-                (integerp n))
-           (equal (expo (* (expt 2 n) x))
-                  (+ n (expo x))))
-  :hints (("Goal" :in-theory (e/d (expt)
-                                  ()))))
-
-(defthm expo-shift-alt
-  (implies (and (rationalp x)
-                (not (equal x 0))
-                (integerp n))
-           (equal (expo (* x (expt 2 n)))
-                  (+ n (expo x))))
-  :hints (("Goal" :use  expo-shift
-           :in-theory (e/d ()
-                                  ( expo-shift)))))
-
-(include-book "common-factor-defuns")
-
-;BOZO pull this stuff into a different book:
-
-;An "expt-factor" has the shape (expt 2 i) or the shape (/ (expt 2 i))
-(defun get-expt-factors (factor-list)
-  (declare (xargs :guard (true-listp factor-list)))
-  (if (endp factor-list)
-      nil
-    (let* ((factor (car factor-list)))
-      (if (and (consp factor)
-               (or (and (equal (car factor) 'expt)
-                        (consp (cdr factor))
-                        (equal (cadr factor) ''2))
-                   (and (equal (car factor) 'unary-/)
-                        (consp (cdr factor))
-                        (consp (cadr factor))
-                        (equal (caadr factor) 'expt)
-                        (consp (cdadr factor))
-                        (equal (cadadr factor) ''2))))
-          (cons factor (get-expt-factors (cdr factor-list)))
-        (get-expt-factors (cdr factor-list))))))
-
-(defun find-common-expt-factors-to-cancel (expr)
-  (declare (xargs :guard (and (pseudo-termp expr))))
-  (get-expt-factors
-   (remove-cancelling-factor-pairs
-    (find-common-factors-in-sum-of-products expr))))
-
-(defund bind-k-to-common-expt-factors (expr)
-  (declare (xargs :guard-hints (("Goal" :use (:instance remove-cancelling-factor-pairs-preserves-true-listp
-                                                        (l (MY-INTERSECTION-EQUAL (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS LHS)
-                                                                                  (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS RHS))))))
-                  :guard (and (pseudo-termp expr))))
-  (let* ((common-factor-list (find-common-expt-factors-to-cancel expr)))
-    (if (endp common-factor-list)
-        nil
-      (list (cons 'k (make-product-from-list-of-factors common-factor-list))))))
-
-
-
-(defthmd power2p-rewrite
-  (equal (power2p x)
-         (equal x (expt 2 (expo x))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable power2p
-                                      expt-split
-                                      expt-between-one-and-two
-                                      )
-                              
-                              '(POWER2P-SHIFT)))))
-
-(in-theory (disable EXPO-2**N)) ;why?
-
-;dont export?
-;like EXPO-2**N but better (now hypothesis-free)
-(defthm expo-expt2
-  (equal (expo (expt 2 i))
-         (if (integerp i)
-             i
-           0))
-  :hints (("goal" :in-theory (enable expt))))
-
-(defthm power2p-expt2-i
-  (power2p (expt 2 i))
-  :hints (("Goal" :in-theory (enable expt power2p))))
-
-(defthm power2p-shift-special
-  (equal (power2p (* (expt 2 i) x))
-         (power2p x))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '()))))
-
-(defthm expo-expt2-inverse
-  (equal (expo (/ (expt 2 i)))
-         (if (integerp i)
-             (- i)
-           0))
-  :hints (("goal" :in-theory (disable expo-expt2)
-           :use (:instance expo-expt2 (i (- i))))))
-
-(defthmd expo-/-power2p
-  (implies (power2p x)
-           (equal (expo (/ x))
-                  (- (expo x))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable power2p)
-                              '( power2p-shift EXPO-EXPT2  EXPO-EXPT2-INVERSE)))))
-
-;restrict to only x's which look like powers of 2
-(defthm expo-/-power2p-alt
-  (implies (and (syntaxp (power2-syntaxp x))
-                (force (power2p x)))
-           (equal (expo (/ x))
-                  (- (expo x))))
-  :hints (("Goal" :in-theory (e/d ( expo-/-power2p) ( EXPO-EXPT2  EXPO-EXPT2-INVERSE)))))
-
-;should we shift out by a constant using this rule?  or do we have another rule for that?
-(defthm expo-shift-general
-  (implies (and (bind-free (bind-k-to-common-expt-factors x) (k))
-                (syntaxp (not (equal k x))) ;helps prevent loops
-                (force (power2p k))
-                (case-split (rationalp x)) ;if not, we want to know about it
-                (case-split (not (equal x 0))) ;if x=0 we can simplify further
-                )
-           (equal (expo x)
-                  (+ (expo k) (expo (* (/ k) x)))))
-  :hints (("goal" :in-theory (enable power2p-rewrite)
-           :use (:instance expo-shift (n (- (expo k)))))))
-
-;BOZO think about this.  expo-shift-general depends on combining (expt 2 i) and (/ (expt 2 i)) but if
-;we rewrite  (/ (expt 2 i)) to (expt 2 (* -1 i)) then this may not happen...
-(theory-invariant (incompatible (:rewrite expo-shift-general)
-                                (:rewrite expt-inverse)
-                                )
-                  :key expt-shift-general-can-loop-with-expt-inverse)
-
-
-
-;BOZO defn expt loops 
-
-
-;(in-theory (disable expo-shift))
-
-(defthm expo>=
-  (implies (and (<= (expt 2 n) x)
-                (rationalp x)
-                (integerp n)
-                )
-           (<= n (expo x)))
-  :otf-flg t
-  :rule-classes :linear
-  :hints (("goal" :use ((:instance expo-monotone (x (expt 2 n)) (y x))))))
-
-(defthm expo<=
-  (implies (and (< x (* 2 (expt 2 n)))
-                (< 0 x)
-                (rationalp x)
-                (integerp n)
-                )
-           (<= (expo x) n))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (enable expt-split)
-           :use (expo-lower-bound
-                 (:instance expt-weak-monotone (n (1+ n)) (m (expo x)))))))
-
-(in-theory (disable expo<= expo>=))
-
-(local (in-theory (enable expo-minus)))
-
-;more gen than expo-of-non-negative-integerp in irepsproofs
-;sort of a weird way of proving this?
-(encapsulate
- ()
- (local (defthm expo-of-non-negative-integerp
-          (implies (and (integerp x)
-                        (>= x 0))
-                   (>= (expo x) 0))
-          :hints (("Goal" 
-                   :use ((:instance expo>= 
-                                    (x x)
-                                    (n 0)))))))
-
- (defthm expo-of-integer
-   (implies (integerp x)
-            (<= 0 (expo x)))
-   :hints (("Goal" :in-theory (disable expo-of-non-negative-integerp)
-            :use ((:instance  expo-of-non-negative-integerp (x x))
-                  (:instance  expo-of-non-negative-integerp (x (- x))))))
-   :rule-classes (:rewrite)))
-
-(defthm expo-of-integer-type
-  (implies (integerp x)
-           (and (integerp (expo x)) ;included to make the conclusion a "type" fact
-                (<= 0 (expo x))))
-  :rule-classes ((:type-prescription :typed-term (expo x))))
-
-
-(local (in-theory (disable expo-minus)))
-
-(local (include-book "common-factor"))
-
-
-
-
-
-
-
-;local in support/float:
-
-;(local (in-theory (disable expt-compare)))
-
-;kill
-(local
- (defthm expo-unique-1
-  (implies (and (rationalp x)
-                (not (equal x 0))
-                (integerp n)
-                (< n (expo x)))
-           (<= (expt 2 (1+ n)) (abs x)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expo abs)
-           :use ((:instance expt-weak-monotone (n (1+ n)) (m (expo x))))))))
-
-;kill
-(local
- (defthm expo-unique-2-alt
-  (implies (and (rationalp x)
-;                (not (equal x 0))
-                (integerp n)
-                (> n (expo x)))
-           (> (expt 2 n) (abs x)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expo abs)
-           :use (;(:instance expo-upper-bound)
-                 (:instance expt-weak-monotone (n (1+ (expo x))) (m n)))))))
-;kill
-;expensive?
-;n is a free var
-(defthmd expo-unique-eric
-  (implies (and (<= (expt 2 n) (abs x))
-                (< (abs x) (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (expo x) n))
-  :hints (("goal" :in-theory (disable expo abs)
-           :use ((:instance expo-unique-1)
-                 (:instance expo-unique-2)))))
-
-
-
-
-
-;could be even better if move hyps into the conclusion? (perhaps only when n is a constant?)
-; wow! this actually worked when the one above didn't!
-;reorder hyps
-(defthm expo-unique-eric-2
-  (implies (and (<= (expt 2 n) (abs x))
-                (< (abs x) (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (equal (expo x) n)
-                  t))
-  :hints (("goal" :in-theory (disable expo abs)
-           :use ((:instance expo-unique)))))
-
-;find a way to make this hit (EQUAL (+ I (EXPO (/ X))) -1) to (i.e., an expression containing one call to expo)
-(defthm expo-equality-reduce-to-bounds
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n)))
-           (equal (equal (expo x) n)
-                  (if (equal 0 x)
-                      (equal 0 n)
-                    (and (<= (expt 2 n) (abs x))
-                         (< (abs x) (expt 2 (1+ n)))))))
-  :hints (("goal" :in-theory (disable expo abs)
-           :cases ((equal x 0)))))
-
-(in-theory (disable expo-equality-reduce-to-bounds))
-
-#|
-(in-theory (enable expo-minus))
-
-(defthm expo-minus-const-mult
-  (implies (and (syntaxp (and (quotep k) (< (cadr k) 0))))
-           (equal (EXPO (* k X)) 
-                  (EXPO (* -1 k X)))))
-|#
-
-;combine this with others? ;BOZO delete comments?
-(DEFTHM EXPO-SHIFT-constant
-  (IMPLIES (AND (syntaxp (quotep k))
-                (equal k (expt 2 (expo k))) ; use power2p?
-                (RATIONALP X)
-                (NOT (equal X 0)))
-           (equal (EXPO (* k X))
-              (+ (expo k) (EXPO X))))
-  :HINTS (("Goal" :in-theory (disable  )
-           :USE (:instance expo-shift (n (expo k))))))
-
-;(local (in-theory (enable power2p)))
-
-
-#|
-(defthm expo-x+2**k-eric
-    (implies (and (syntaxp (quotep k))
-                  (power2p k)
-		  (rationalp x)
-		  (<= 0 x)
-		  (< (expo x) (expo k)))
-	     (equal (expo (+ k x))
-		    (expo k)))
-    :hints (("Goal" :in-theory (disable expo-x+2**k)
-             :use (:instance expo-x+2**k (k (expo k))))))
-
-|#
-
-
-
-;these next 2 can be very expensive since (expt 2 k) gets calculated!
-
-;restrict to constants k?
-(defthm expo-comparison-rewrite-to-bound
-  (implies (and (syntaxp (not (power2-syntaxp x))) ;helps prevent loops
-                (case-split (not (equal 0 x)))
-                (integerp k) ;gen?
-                (case-split (rationalp x))
-                )
-           (equal (< (expo x) k)
-                  (< (abs x) (expt 2 k))))
-  :otf-flg t
-  :hints (("Goal" :use ((:instance expo-monotone (x (expt 2 k)) (y x))
-                        (:instance expo-monotone (y (expt 2 k)) (x x))))
-          )
-  )
-
-;restrict to constants k?
-(defthm expo-comparison-rewrite-to-bound-2
-  (implies (and (syntaxp (not (power2-syntaxp x))) ;helps prevent loops
-                (case-split (not (equal 0 x)))
-                (integerp k) ;gen?
-                (case-split (rationalp x))
-                )
-           (equal (< k (expo x))
-                  (<= (expt 2 (+ k 1)) (abs x))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)
-           :use ((:instance expo-monotone (x (expt 2 (+ 1 k))) (y x))
-                 (:instance expo-monotone (y (expt 2 (+ 1 k))) (x x))))
-          )
-  )
-
-
-
-
-;have a better version but need this for the proofs
-
-
-
-#| true only for powers of 2
-(defthm expo-/
-  (equal (expo (/ x))
-         (- (expo x)))
-  :hints (("Goal" :in-theory (enable expo)))
-)
-|#
-
-
-#| these might be nice:
-(defthm expo-/-notpower2p
-  (implies (and (not (equal x 0))
-                (rationalp x)
-                (not (power2p x)))
-           (equal (expo (/ x))
-                  (+ -1 (- (expo x)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expo expt-split  expo-equality-reduce-to-bounds)
-                              '())))
-)
-
-|#
-
-
-
-
-  
-
-
-
-
-(defthm expo-bound-eric
-  (implies (case-split (rationalp x))
-           (and (equal (< (* 2 (expt 2 (expo x))) x)
-                       nil)
-                (equal (< x (* 2 (expt 2 (expo x))))
-                       t)
-                (equal (< (expt 2 (+ 1 (expo x))) x)
-                       nil)
-                (equal (< x (expt 2 (+ 1 (expo x))))
-                       t)
-                ))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '())
-           :use expo-upper-bound)))
-
-
-
-;if this loops, disable all the expo-shift rules!
-(defthm expo-/-notpower2p
-  (implies (and (not (power2p x))
-                (case-split (not (equal x 0)))
-                (<= 0 x)
-                (case-split (rationalp x))
-                )
-           (equal (expo (/ x))
-                  (+ -1 (- (expo x)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable power2p; expo
-                                      expt-split expo-equality-reduce-to-bounds)
-                              '( power2p-shift expo-shift-constant)))))
-
-(in-theory (disable expo-/-notpower2p))
-
-(in-theory (disable power2p-shift-special))
-
-
-#|
-(defthm power2p-quotient
-  (implies (and (syntaxp (power2-syntaxp y))
-                (case-split (power2p y)) ;this should be true if the syntaxp hyp is satisfied
-                )
-           (equal (power2p (/ y x))
-                  (power2p x)))
-  :hints (("Goal" :in-theory (disable power2p)
-           :use (:instance power2p-shift (x (/ x))))))
-
-(defthm power2p-quotient-2
-  (implies (and (syntaxp (power2-syntaxp y))
-                (case-split (power2p y)) ;this should be true if the syntaxp hyp is satisfied
-                )
-           (equal (power2p (/ x y))
-                  (power2p x)))
-  :hints (("Goal" :in-theory (disable power2p POWER2P-/)
-           :use (:instance power2p-shift (y (/ y))))))
-|#
-
-#|
-(include-book
- "abs")
-
-(defthm expo-of-x-minus-1-nopower2-case
-  (implies (and (integerp x)
-                (not (power2p x))
-                (<= 0 x) ;gen and add abs phrasing?
-                )
-           (equal (expo (+ -1 x))
-                  (expo x)))
-  :hints (("Goal" :use (:instance expo-unique
-                                 (x (+ -1 x))
-                                 (n (expo x)))
-           :in-theory (enable power2p))))
-
-
-
-
-(defthm expo-of-x-minus-1-power2-case
-  (implies (and (integerp x) ;drop?
-                (power2p x)
-                (case-split (< 1 x)) ;gen?
-                )
-           (equal (expo (+ -1 x))
-                  (+ -1 (expo x))))
-  :hints (("Goal" :use (:instance expo-unique
-                                  (x (+ -1 x))
-                                  (n (+ -1 (expo x))))
-           :in-theory (enable power2p expt-split))))
-
-
-;add more conclusions.  is (expt 2...) < or <= n?
-(defthm expt-expo-bound-1
-  (implies (and (integerp n)
-                (case-split (< 0 n))
-                )
-           (equal (< N (EXPT 2 (EXPO (+ -1 N))))
-                  nil))
-  :otf-flg t
-  :hints (("Goal" :cases ((power2p n))
-           :in-theory (enable expt-split)))
-  )
-
-|#
-
-(defthm expt-compare
-  (implies (and (syntaxp (and (power2-syntaxp lhs)
-                              (power2-syntaxp rhs)))
-                (case-split (power2p lhs))
-                (case-split (power2p rhs)))
-           (equal (< lhs rhs)
-                  (< (expo lhs) (expo rhs))))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable power2p-rewrite ; expt-strong-monotone
-                                      )
-                              '( ;EXPO-COMPARISON-REWRITE-TO-BOUND-1
-                                EXPO-COMPARISON-REWRITE-TO-BOUND-2 ;yuck
-                                power2p-shift))
-           :use (:instance expt-strong-monotone (m (expo lhs)) (n (expo rhs)))
-           ))
-  :otf-flg t
-  )
-
-
-(defthm expt-compare
-  (implies (and (syntaxp (and (power2-syntaxp lhs)
-                              (power2-syntaxp rhs)))
-                (case-split (power2p lhs))
-                (case-split (power2p rhs)))
-           (equal (< lhs rhs)
-                  (< (expo lhs) (expo rhs))))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable power2p-rewrite expt)
-                              '( power2p-shift))
-           :use (:instance expt-strong-monotone (m (expo lhs)) (n (expo rhs)))
-           ))
-  :otf-flg t
-  )
-
-(DEFTHM EXPT-COMPARE-equal
-  (IMPLIES (AND (syntaxp (and (power2-syntaxp lhs)
-                              (power2-syntaxp rhs)))
-                (case-split (power2p lhs)) ;if the syntacp hyp goes through we expect these to also
-                (case-split (power2p rhs))
-                )
-           (equal (equal lhs rhs)
-                  (equal (expo lhs) (expo rhs))))
-  :hints (("Goal"  :in-theory (set-difference-theories
-                               (enable power2p-rewrite expt)
-                               '( POWER2P-SHIFT))
-
-           ))
-)
-
-
-(defthm power2-integer
-  (implies (and (syntaxp (power2-syntaxp x))
-                (force (power2p x)))
-           (equal (integerp x)
-                  (<= 0 (expo x))))
-  :hints (("Goal" :use (:instance expt2-integer (i (expo x)))
-             :in-theory (set-difference-theories
-                         (enable power2p-rewrite expt)
-                         '( POWER2P-SHIFT expt2-integer)))))
-
-#| old stuff
-(defthm a14
-  (and
-   (implies (and (integerp i)
-                 (<= 0 i)
-                 (<= 0 j))
-            (and (integerp (expt i j))
-                 (<= 0 (expt i j))))
-   (implies (and (rationalp i)
-                 (not (equal i 0)))
-            (not (equal (expt i j) 0))))
-  :hints
-  (("Goal" :in-theory (enable expt)))
-  :rule-classes
-  ((:type-prescription
-    :corollary
-    (implies (and (integerp i)
-                  (<= 0 i)
-                  (<= 0 j))
-             (and (integerp (expt i j))
-                  (<= 0 (expt i j)))))
-   (:type-prescription
-    :corollary
-    (implies (and (rationalp i)
-                  (not (equal i 0)))
-             (not (equal (expt i j) 0))))))
-
-
-
-
-(defthm a16
-  (equal (expt (* a b) i)
-         (* (expt a i) (expt b i)))
-  :hints
-  (("Goal" :in-theory (enable distributivity-of-expt-over-*))))
-(defthm my-exponents-add
-  (implies (and (not (equal 0 r))
-                (acl2-numberp r)
-                (integerp i)
-                (integerp j))
-           (equal (expt r (+ i j))
-                  (* (expt r i)
-                     (expt r j))))
-  :rule-classes nil)
-
-|#
-
-
-#|
-(defthm expt-2-reduce-leading-constant-gen
-  (implies (case-split (integerp (+ k d)))
-           (equal (expt 2 (+ k d))
-                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d)))))
-  :otf-flg t
-   :hints (("Goal" :in-theory (set-difference-theories
-                                (enable; fl
-)
-                                '(expt-split mod))
-             :use (:instance expt-split (r 2) (i (fl k)) (j (+ (mod k 1) d))))))
-|#
-
-
-
-(defthm expo-shift-16
-  (implies (and (case-split (integerp n))
-                (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                )
-           (equal (expo (* (/ (expt 2 n)) x))
-                  (+ (- n) (expo x))))
-
-           
-  )
-
-(defthm expo-lower-bound-2
-  (implies (and (case-split (rationalp x))
-                (case-split (<= 0 x))
-                (case-split (not (equal x 0)))
-                )
-           (<= (expt 2 (expo x)) x))
-  :rule-classes :linear
-)
-
-(defthmd expo-upper-bound-tight
-  (implies (integerp x)
-           (<= (abs x) (+ -1 (expt 2 (1+ (expo x))))))
-  :hints (("Goal" :use (expo-upper-bound)))
-  :rule-classes :linear)
-
-;BOZO simplify the conclusion?
-(defthm expo-x+a*2**k
-  (implies (and (< (expo x) k)
-                (< 0 a)
-                (integerp a)
-                (case-split (<= 0 x))
-                (case-split (integerp k))
-                (case-split (rationalp x))
-                )
-           (equal (expo (+ x (* a (expt 2 k))))
-                  (expo (* a (expt 2 k)))))
-  :hints (("goal" :in-theory (e/d (expt-split) ( ;EXPO-BOUND-ERIC
-                                                 ;CANCEL-IN-PRODS-<-2-OF-2-WITH-2-OF-3
-                                                 ))
-           :use ((:instance expo-lower-bound (x (* a (expt 2 k))))
-                 (:instance expo-upper-bound-tight (x a))
-                 (:instance expo-unique 
-                            (x (+ x (* a (expt 2 k)))) (n (expo (* a (expt 2 k))))))))
-  :otf-flg t)
-
-(defthm expo-x+2**k
-    (implies (and (< (expo x) k)
-                  (<= 0 x)
-                  (case-split (integerp k))
-		  (case-split (rationalp x))
-		  )
-	     (equal (expo (+ x (expt 2 k)))
-		    k))
-  :hints (("Goal" :use (:instance  expo-x+a*2**k (a 1)))))
-
-
-
-
-
-(local (defthmd between-0-and-1-means-not-integerp
-  (implies (and (< 0 x) (< x 1))
-           (not (integerp x)))))
-
-(defthm expo-times-2-not-a-factor
-  (implies (rationalp x)
-           (equal (integerp (* 1/2 x (/ (expt 2 (expo x)))))
-                  (equal 0 x)))
-  :hints (("Goal" :in-theory (enable expt-minus expt-split)
-           :use ( expo-lower-bound
-                  expo-upper-bound
-                  (:instance  BETWEEN-0-AND-1-MEANS-NOT-INTEGERP
-                              (x  (* 1/2 (abs X) (EXPT 2 (* -1 (EXPO X))))))))))
-
-(local (defthmd between-1-and-2-means-not-integerp
-  (implies (and (< 1 x) (< x 2))
-           (not (integerp x)))))
-
-(local (defthm expo-a-factor-means-power2-helper
-  (implies (and (<= 0 x)
-                (rationalp x))
-           (equal (integerp (* x (/ (expt 2 (expo x)))))
-                  (or (equal 0 x)
-                      (power2p (abs x)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (e/d( expt-minus expt-split power2p-rewrite) ( EXPO-BOUND-ERIC))
-           :use (expo-lower-bound
-                 expo-upper-bound
-                 (:instance BETWEEN-1-AND-2-MEANS-NOT-INTEGERP (x (* x (/ (expt 2 (expo x)))))))))))
-
-(defthm expo-a-factor-means-power2
-  (implies (acl2-numberp x)
-           (equal (integerp (* x (/ (expt 2 (expo x)))))
-                  (or (equal 0 x)
-                      (power2p (abs x)))))
-  :hints (("Goal" :in-theory (enable expo-minus-eric)
-           :use ((:instance  expo-a-factor-means-power2-helper (x x))
-                        (:instance  expo-a-factor-means-power2-helper (x (- x)))))))
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/expo.lisp acl2-6.3/books/rtl/rel5/arithmetic/expo.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/expo.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/expo.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,521 +0,0 @@
-(in-package "ACL2")
-
-;This book contains theorems mixing expt and expo and power2p.
-;It is the top-level book for reasoning about powers of two.
-;Eric believes that the function EXPO is intimately connected to EXPT (they are inverses).  Some of his
-;theorems about EXPT require EXPO for their statements.
-
-;Todo: 
-;1. Write a more general version of EXPO that isn't tied to using 2 as the base?
-;2. Use more consistent names for lemmas, including using expt2 for lemmas which only apply when the r paramater
-;to expt is 2.
-
-(include-book "ground-zero")
-(include-book "negative-syntaxp")
-(include-book "power2p")
-(local (include-book "expo-proofs"))  ;there's now a separate expo-proofs book !!!
-;ad local in-thoery nil
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-
-;probably get this anyway when we define expo
-(defthm expo-integer-type
-  (integerp (expo x))
-  :rule-classes :type-prescription)
-
-;(:type-prescription expo) is no better than expo-integer-type and might be worse:
-(in-theory (disable (:type-prescription expo)))
-
-(defthm expo-of-not-rationalp
-  (implies (not (rationalp x))
-           (equal (expo x) 0)))
-
-
-;be careful: if you enable expo, the x<0 case of expo can loop with expo-minus
-;(see expo-minus-invariant)
-(defthmd expo-minus
-  (equal (expo (* -1 x))
-         (expo x)))
-
-;rename?
-(defthm expo-minus-eric
-  (implies (syntaxp (negative-syntaxp x))
-           (equal (expo x) 
-                  (expo (* -1 x)))))
-
-
-(theory-invariant
- (not (and (or (active-runep '(:rewrite expo-minus))
-               (active-runep '(:rewrite expo-minus-eric)))
-           (active-runep '(:definition expo))))
- :key expo-minus-invariant)
-
-;Eric doesn't like the presence of ABS here...
-(defthm expo-lower-bound
-  (implies (and (rationalp x)
-                (not (equal x 0)))
-           (<= (expt 2 (expo x)) (abs x)))
-  :rule-classes :linear)
-
-(defthm expo-lower-pos
-  (implies (and (< 0 x)
-                (rationalp x)
-                )
-           (<= (expt 2 (expo x)) x))
-  :rule-classes :linear)
-
-;make expo-lower-neg? expo-upper-neg? bad names? expo-lower-neg would really be an upper bound!
-
-(defthm expo-upper-bound
-  (implies (rationalp x)
-           (< (abs x) (expt 2 (1+ (expo x)))))
-  :rule-classes :linear)
-
-(defthm expo-upper-pos
-  (implies (rationalp x)
-           (< x (expt 2 (1+ (expo x)))))
-  :rule-classes :linear)
-
-(defthm expo-unique
-  (implies (and (<= (expt 2 n) (abs x))
-                (< (abs x) (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal n (expo x)))
-  :rule-classes ())
-
-;bad to have the abs there?
-(defthmd expo-monotone
-  (implies (and (<= (abs x) (abs y))
-                (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                (case-split (rationalp y))
-                )
-           (<= (expo x) (expo y)))
-  :rule-classes :linear)
-
-;BOZO. drop this in favor of expo-expt2?
-(defthmd expo-2**n
-  (implies (integerp n)
-           (equal (expo (expt 2 n))
-                  n)))
-
-;dont export?
-;like EXPO-2**N but better (now hypothesis-free)
-;This rule, together with expt-compare allows any comparison using <, >, <=, or >= of two terms which have the
-;form of powers of 2 to be rewritten to a claim about the exponents.  actually, we need a rule about (expo (/ <powerof2>))
-;can kill more specialized rules
-;use ifix?
-(defthm expo-expt2
-  (equal (expo (expt 2 i))
-         (if (integerp i)
-             i
-           0)))
-
-;Can loop with defn expo. See theory-invariant.
-;expo-half (and expo-double, sort of) makes the proof of expo-shift go through
-(defthm expo-half
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                )
-           (equal (expo (* 1/2 x))
-                  (+ -1 (expo x)))))
-
-(theory-invariant (incompatible (:rewrite expo-half)
-                                (:definition expo)
-                                )
-                  :key expo-half-loops-with-defn-expo)
-
-(theory-invariant (incompatible (:rewrite expo-double)
-                                (:definition expo)
-                                )
-                  :key expo-double-loops-with-defn-expo)
-
-
-
-;Can loop with defn expo.  See the theory-invariant.
-(defthm expo-double
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                )
-           (equal (expo (* 2 x))
-                  (+ 1 (expo x)))))
-
-(defthm expo-x+a*2**k
-  (implies (and (< (expo x) k)
-                (< 0 a)
-                (integerp a)
-                (case-split (<= 0 x))
-                (case-split (integerp k))
-                (case-split (rationalp x))
-                )
-           (equal (expo (+ x (* a (expt 2 k))))
-                  (expo (* a (expt 2 k))))))
-
-;special case of the above
-(defthm expo-x+2**k
-    (implies (and (< (expo x) k)
-                  (<= 0 x)
-                  (case-split (integerp k))
-		  (case-split (rationalp x))
-		  )
-	     (equal (expo (+ x (expt 2 k)))
-		    k)))
-
-
-
-(defthmd expo>=
-  (implies (and (<= (expt 2 n) x)
-                (rationalp x)
-                (integerp n)
-                )
-           (<= n (expo x)))
-  :rule-classes :linear)
-
-
-(defthmd expo<=
-  (implies (and (< x (* 2 (expt 2 n)))
-                (< 0 x)
-                (rationalp x)
-                (integerp n)
-                )
-           (<= (expo x) n))
-  :rule-classes :linear)
-
-(defthm expo-of-integer-type
-  (implies (integerp x)
-           (and (integerp (expo x)) ;included to make the conclusion a "type" fact
-                (<= 0 (expo x))))
-  :rule-classes ((:type-prescription :typed-term (expo x))))
-
-;!! rc?
-;actually, maybe we should rewrite the conclusion instead? <-- how?
-(defthm expo-of-integer
-  (implies (integerp x)
-           (<= 0 (expo x)))
-  :rule-classes (:rewrite))
-
-
-
-;expensive?
-;n is a free var
-;gotta get rid of the abs if we hope to bind n appropriately
-(defthmd expo-unique-eric
-  (implies (and (<= (expt 2 n) (abs x))
-                (< (abs x) (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (expo x) n)))
-
-
-
-
-
-;could be even better if move hyps into the conclusion? (perhaps only when n is a constant?)
-; wow! this actually worked when the one above didn't! (probably because this one doesn't have a free var)
-;expensive??
-(defthm expo-unique-eric-2
-  (implies (and (<= (expt 2 n) (abs x))
-                (< (abs x) (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (equal (expo x) n)
-                  t))
-)
-
-;find a way to make this hit (EQUAL (+ I (EXPO (/ X))) -1) to (i.e., an expression containing one call to expo)
-(defthmd expo-equality-reduce-to-bounds
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n)))
-           (equal (equal (expo x) n)
-                  (if (equal 0 x)
-                      (equal 0 n)
-                    (and (<= (expt 2 n) (abs x))
-                         (< (abs x) (expt 2 (1+ n))))))))
-
-
-
-
-
-
-;these next 2 can be very expensive since (expt 2 k) gets calculated!  Meh.
-
-;disable??
-;restrict to constants k?
-(defthm expo-comparison-rewrite-to-bound
-  (implies (and (syntaxp (not (power2-syntaxp x))) ;helps prevent loops
-                (case-split (not (equal 0 x)))
-                (integerp k) ;gen?
-                (case-split (rationalp x))
-                )
-           (equal (< (expo x) k)
-                  (< (abs x) (expt 2 k)))))
-;disable?
-;restrict to constants k?
-(defthm expo-comparison-rewrite-to-bound-2
-  (implies (and (syntaxp (not (power2-syntaxp x))) ;helps prevent loops
-                (case-split (not (equal 0 x)))
-                (integerp k) ;gen?
-                (case-split (rationalp x))
-                )
-           (equal (< k (expo x))
-                  (<= (expt 2 (+ k 1)) (abs x)))))
-
-
-
-(defthm power2p-expt2-i
-  (power2p (expt 2 i)))
-
-
-;have a better version but need this for the proofs - huh?
-;BOZO, so don't export this! ??
-(defthmd expo-expt2-inverse
-  (equal (expo (/ (expt 2 i)))
-         (if (integerp i)
-             (- i)
-           0)))
-
-;why disabled?
-(defthmd power2p-shift-special
-  (equal (power2p (* (expt 2 i) x))
-         (power2p x)))
-
-(defthmd expo-/-power2p-1
-  (equal (expo (/ (expt 2 i)))
-         (- (expo (expt 2 i)))))
-
-;drop, since we have the one below?
-(defthmd expo-/-power2p
-  (implies (power2p x)
-           (equal (expo (/ x))
-                  (- (expo x)))))
-
-;restrict to only x's which look like powers of 2
-(defthm expo-/-power2p-alt
-  (implies (and (syntaxp (power2-syntaxp x))
-                (force (power2p x)))
-           (equal (expo (/ x))
-                  (- (expo x)))))
-
-
-
-
-
-(defthm expo-bound-eric
-  (implies (case-split (rationalp x))
-           (and (equal (< (* 2 (EXPT 2 (EXPO X))) X)
-                       nil)
-                (equal (< X (* 2 (EXPT 2 (EXPO X))))
-                       t)
-                (equal (< (EXPT 2 (+ 1 (EXPO X))) X)
-                       nil)
-                (equal (< X (EXPT 2 (+ 1 (EXPO X))))
-                       t)
-                )))
-
-
-
-;if this loops, disable all the expo-shift rules!
-(defthmd expo-/-notpower2p
-  (implies (and (not (power2p x))
-                (case-split (not (equal x 0)))
-                (<= 0 x)
-                (case-split (rationalp x))
-                )
-           (equal (expo (/ x))
-                  (+ -1 (- (expo x))))))
-
-(defthmd power2p-rewrite
-  (equal (power2p x)
-         (equal x (expt 2 (expo x)))))
-
-;rename to powers-of-2-less-than?
-;An inequality between powers of two can be rewritten to an inequality about their exponents...
-;this allows LHS or RHS (or both) to be a gross term like, e.g., this: (* 2 (* (expt 2 j) (expt 2 (+ k (* -1 j)))))
-;we expect the EXPO introduced in the conclusion go away (it will crawl to the leaves of RHS and LHS, each of which is
-;either a constant or of the form (EXPT 2 I).
-(defthm expt-compare
-  (implies (and (syntaxp (and (power2-syntaxp lhs)
-                              (power2-syntaxp rhs)))
-                (case-split (power2p lhs)) ;use force?
-                (case-split (power2p rhs)))
-           (equal (< lhs rhs)
-                  (< (expo lhs) (expo rhs))))
-
-  :otf-flg t
-  )
-
-(defthm expt-compare-equal
-  (implies (and (syntaxp (and (power2-syntaxp lhs)
-                              (power2-syntaxp rhs)))
-                (case-split (power2p lhs)) ;if the syntaxp hyp goes through we expect these to also
-                (case-split (power2p rhs)) ;use force?
-                )
-           (equal (equal lhs rhs)
-                  (equal (expo lhs) (expo rhs)))))
-
-
-;this can be a powerful rule...
-;We expect the call to EXPO in the conclusion to go away (it should be pushed to the leaves...)
-(defthm power2-integer
-  (implies (and (syntaxp (power2-syntaxp x))
-                (force (power2p x)))
-           (equal (integerp x)
-                  (<= 0 (expo x)) 
-                  )))
-
-
-
-;BOZO dup with expo-lower-pos
-(defthm expo-lower-bound-2
-  (implies (and (case-split (rationalp x))
-                (case-split (<= 0 x))
-                (case-split (not (equal x 0)))
-                )
-           (<= (expt 2 (expo x)) x))
-  :rule-classes :linear)
-
-
-;we need these next 2, even though we have expt-shift-general
-;why did i say the above??
-;BOZO rename params.  put ifix around i
-(defthm expo-shift
-  (implies (and (rationalp x)
-                (not (equal x 0))
-                (integerp n))
-           (equal (expo (* (expt 2 n) x))
-                  (+ n (expo x)))))
-
-(defthm expo-shift-alt
-  (implies (and (rationalp x)
-                (not (equal x 0))
-                (integerp n))
-           (equal (expo (* x (expt 2 n)))
-                  (+ n (expo x)))))
-
-(defthm expo-shift-16
-  (implies (and (case-split (integerp n))
-                (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                )
-           (equal (expo (* (/ (expt 2 n)) x))
-                  (+ (- n) (expo x)))))
-
-;BOZO combine this with others?
-(defthm expo-shift-constant
-  (implies (and (syntaxp (quotep k))
-                (equal k (expt 2 (expo k))) ; use power2p?
-                (rationalp x)
-                (not (equal x 0)))
-           (equal (expo (* k x))
-                  (+ (expo k) (expo x)))))
-
-(include-book "common-factor-defuns")
-
-;An "expt-factor" has the shape (expt 2 i) or the shape (/ (expt 2 i))
-;does not consider constants to be "expt-factors", so we have expo-shift-constant
-(defun get-expt-factors (factor-list)
-  (declare (xargs :guard (true-listp factor-list)))
-  (if (endp factor-list)
-      nil
-    (let* ((factor (car factor-list)))
-      (if (and (consp factor)
-               (or (and (equal (car factor) 'expt)
-                        (consp (cdr factor))
-                        (equal (cadr factor) ''2))
-                   (and (equal (car factor) 'unary-/)
-                        (consp (cdr factor))
-                        (consp (cadr factor))
-                        (equal (caadr factor) 'expt)
-                        (consp (cdadr factor))
-                        (equal (cadadr factor) ''2))))
-          (cons factor (get-expt-factors (cdr factor-list)))
-        (get-expt-factors (cdr factor-list))))))
-
-
-(defun find-common-expt-factors-to-cancel (expr)
-  (declare (xargs :guard (and (pseudo-termp expr))))
-  (get-expt-factors
-   (remove-cancelling-factor-pairs
-    (find-common-factors-in-sum-of-products expr))))
-
-(defund bind-k-to-common-expt-factors (expr)
-  (declare (xargs :guard-hints (("Goal" :use (:instance remove-cancelling-factor-pairs-preserves-true-listp
-                                                        (l (MY-INTERSECTION-EQUAL (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS LHS)
-                                                                                  (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS RHS))))))
-                  :guard (and (pseudo-termp expr))))
-  (let* ((common-factor-list (find-common-expt-factors-to-cancel expr)))
-    (if (endp common-factor-list)
-        nil
-      (list (cons 'k (make-product-from-list-of-factors common-factor-list))))))
-
-
-
-(defthm expo-shift-general
-  (implies (and (bind-free (bind-k-to-common-expt-factors x) (k))
-                (syntaxp (not (equal k x))) ;helps prevent loops
-                (force (power2p k))
-                (case-split (rationalp x)) ;if not, we want to know about it
-                (case-split (not (equal x 0))) ;if x=0 we can simplify further
-                )
-           (equal (expo x)
-                  (+ (expo k) (expo (* (/ k) x)))))
-  :hints (("goal" :in-theory (enable power2p-rewrite)
-           :use (:instance expo-shift (n (- (expo k)))))))
-
-
-;BOZO think about this.  expo-shift-general depends on combining (expt 2 i) and (/ (expt 2 i)) but if we
-;rewrite (/ (expt 2 i)) to (expt 2 (* -1 i)) then this may not happen...  (We don't have a complete set of
-;rules for gathering expt terms, especially in cases like this: (* (expt 2 i) x y w z (expt 2 (* -1 i)))
-;So currently one cannot have both expt-inverse and expt-shift enabled...  
-;We could address this by writing a rule which will always gather expt
-;terms in a product, even if other terms intervene between them.  If we are guaranteed to always do all
-;gathering, then expo-shift-general should work okay (i.e., shouldn't loop).
-;Man, I can't figure out how to write an easy bind-free rule to do all gathering. Even if we walk through the
-;term and decide what to cancel out, e.g., the (expt 2 i) and the (expt 2 (* -1 i)) in  
-;  (* (expt 2 i) x y w z (expt 2 (* -1 i)))
-;we can't just multiply through by their inverses (which would be the standard way to cancel something in a
-;product) because the inverting would get sucked in by expt-inverse.  So an attempt to cancel by multiplying
-;through by (/ (expt 2 i)) and (/ (expt 2 (* -1 i))) would be the same as multipying through by (expt 2 (* -1 i)) 
-;and (expt 2 (* -1 (* -1 i))) = (expt 2 i), respectively.  Yuck.  Maybe we can use some sort of bubble-down
-;strategy like Rober Krug does.
-;It's unfortunate that we don't get any expo-shifting if we are gathering exponents...
-(theory-invariant (incompatible (:rewrite expo-shift-general)
-                                (:rewrite expt-inverse)
-                                )
-                  :key expo-shift-general-can-loop-with-expt-inverse)
-
-
-
-(defthm expo-times-2-not-a-factor
-  (implies (rationalp x)
-           (equal (integerp (* 1/2 x (/ (expt 2 (expo x)))))
-                  (equal 0 x))))
-
-(defthm expo-a-factor-means-power2
-  (implies (acl2-numberp x)
-           (equal (integerp (* x (/ (expt 2 (expo x)))))
-                  (or (equal 0 x)
-                      (power2p (abs x))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/expt-proofs.lisp acl2-6.3/books/rtl/rel5/arithmetic/expt-proofs.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/expt-proofs.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/expt-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,843 +0,0 @@
-(in-package "ACL2")
-
-;this book contains very basic expt stuff (i couldn't include expt.lisp in basic.lisp because of a circular dependency)
-
-;todo: 
-;make a separate expt-proofs book
-;there's a distinction between expt and expt-2 rules
-;make consistent names:  expt vs. expt2   
-;think about the rules to combine and split exponents
-;generalize some of these rules to be about expt with any base (not just 2)
-
-;remove this?
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ground-zero")
-(include-book "negative-syntaxp")
-(local (include-book "predicate"))
-(local (include-book "fp2"))
-(local (include-book "numerator"))
-(local (include-book "denominator"))
-(local (include-book "integerp"))
-(local (include-book "fl")) ;or use floor?
-(local (include-book "arith2"))
-
-(encapsulate 
- ()
- (local (include-book "arithmetic/top" :dir :system))
- (defthm a16
-   (equal (expt (* a b) i)
-          (* (expt a i) (expt b i)))
-   :hints
-   (("Goal" :in-theory (enable distributivity-of-expt-over-*))))
-
-;gen
-;split off the non-integer case
-;make an expt2-split?
-;instead of i1 and i2, use i and j?
- (defthmd expt-split
-   (implies (and (integerp i)
-                 (integerp j)
-                 (case-split (acl2-numberp r)) ;(integerp r)
-                 (case-split (not (equal r 0)))
-                 )
-            (equal (expt r (+ i j))
-                   (* (expt r i) (expt r j))))
-   :hints (("Goal" :in-theory (enable expt)))
-   )
- )
-
-(theory-invariant
-  (not (and (active-runep '(:rewrite expt-split))
-            (active-runep '(:rewrite a15))))
-  :key expt-split-invariant)
-
-(theory-invariant
-  (not (and (active-runep '(:rewrite expt-split))
-            (active-runep '(:definition expt))))
-  :key expt-split-invariant-2)
-
-
-;see also a14
-;generalize?  use arith books?
-(defthm expt-2-positive-rational-type
-  (and (rationalp (expt 2 i))
-       (< 0 (expt 2 i)))
-  :hints (("Goal" :in-theory (enable expt) ))
-  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
-
-;like a14?
-(defthm expt-2-positive-integer-type
-  (implies (<= 0 i)
-           (and (integerp (expt 2 i))
-                (< 0 (expt 2 i))))
-  :hints (("Goal" :in-theory (enable expt)))
-  :rule-classes (:type-prescription))
-
-;someday our rules may be better, but right now, ours only talk about when when the base is 2
-;(in-theory (disable (:TYPE-PRESCRIPTION EXPT)))
-
-
-;the rewrite rule counterpart to expt-2-positive-integer-type
-(defthm expt-2-integerp
-  (implies (<= 0 i)
-           (integerp (expt 2 i))))
-
-(defthm expt-2-type-linear
-  (implies (<= 0 i)
-           (<= 1 (expt 2 i)))
-  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
-
-
-
-;when you disable either of the two rules below, you might want to also disable expt-compare?
-;took these rules out of :rewrite since we have expt-compare?
-;are these bad :linear rules because they have free vars?
-
-(encapsulate
- ()
- (local (defthm expt-strong-monotone-1
-          (implies (and (integerp n)
-                        (integerp k)
-                        (> k 0))
-                   (< (expt 2 n) (expt 2 (+ n k))))
-          :hints (("Goal" :in-theory (enable expt
-                                             )))
-          :rule-classes ()))
-
- (defthmd expt-strong-monotone
-   (implies (and (integerp n)
-                 (integerp m))
-            (equal (< (expt 2 n) (expt 2 m))
-                   (< n m)))
-   :hints (("Goal" :use ((:instance expt-strong-monotone-1 (k (- m n)))
-                         (:instance expt-strong-monotone-1 (k (- n m)) (n m))
-                         )))))
-
-;improve to handle i non-integer?
-(defthm expt2-integer
-  (implies (case-split (integerp i))
-           (equal (integerp (expt 2 i))
-                  (<= 0 i)))
-  :hints (("Goal" :use (:instance expt-strong-monotone (n i) (m 0)))))
-
-;trying :match-free :all
-;why disabled?
-(defthmd expt-strong-monotone-linear
-  (implies (and (< n m)
-                (case-split (integerp n))
-                (case-split (integerp m))
-                )
-           (< (expt 2 n) (expt 2 m)))
-  :rule-classes ((:linear :match-free :all))
-  :hints (("Goal" :use expt-strong-monotone)))
-
-;why disabled?
-(defthmd expt-weak-monotone
-  (implies (and (integerp n)
-                (integerp m))
-           (equal (<= (expt 2 n) (expt 2 m))
-		  (<= n m)))
-  :hints (("Goal" :use (expt-strong-monotone
-			(:instance expt-strong-monotone (m n) (n m))))))
-
-;disabled because of the free var
-;but is occasionally helpful
-;make linear?
-;BOZO rename params?
-;trying :match-free :all
-(defthmd expt-weak-monotone-linear
-  (implies (and (<= n m)
-                (case-split (integerp n))
-                (case-split (integerp m)))
-           (<= (expt 2 n) (expt 2 m)))
-  :rule-classes ((:linear :match-free :all))
-  :hints (("Goal" :use (expt-strong-monotone
-			(:instance expt-strong-monotone (m n) (n m))))))
-
-;generalize? rewrite (< (expt 2 i) k) to a comparison of (expt 2 i) and the greatest power of 2 <= k
-;is this what expt-compare does?
-(defthmd expt-between-one-and-two
-  (implies (and (<= 1 (expt 2 i))
-                (< (expt 2 i) 2))
-           (equal (expt 2 i) 1))
-  :hints (("goal" 
-           :in-theory (enable expt zip))
-          ("subgoal *1/7" :use (:instance expt-weak-monotone (n (+ i 1)) (m 0)))))
-
-
-
-;We could disable this if it causes problems (but it seems okay).
-;should always use case-split n hyps that say exponents are integers
-(defthm expt-with-i-non-integer
-  (implies (not (integerp i))
-           (equal (expt r i)
-                  1))
-  :hints (("Goal" :in-theory (enable expt))))
-
-(defthmd expt-minus-helper
-  (equal (expt r (* -1 i))
-         (/ (expt r i)))
-  :otf-flg t
-  :hints (("Goal" :cases ((integerp i) (and (not (integerp i)) (acl2-numberp i)))
-           :in-theory (enable expt))))
-
-;BOZO disable or enable by default?
-;Loops with expt-inverse. How do we want to handle this??
-;I'd rather have the inverting done outside EXPT since most rules don't look inside EXPT.
-;This rule can be said to scatter exponents...
-(defthmd expt-minus
-  (implies (syntaxp (negative-syntaxp i))
-           (equal (expt r i)
-                  (/ (expt r (* -1 i)))))
-  :hints (("Goal" :in-theory (enable expt-minus-helper
-                                     expt-split))))
-
-(local (in-theory (enable expt-minus)))
-
-;This can loop with expt-minus (see theory-invariant).
-(defthmd expt-inverse
-  (equal (/ (expt 2 i))
-         (expt 2 (* -1 i))))
-
-(theory-invariant
-  (not (and (active-runep '(:rewrite expt-minus))
-            (active-runep '(:rewrite expt-inverse))))
-  :key expt-minus-invariant)
-
-
-;could prove a rule for (expt (* -1 r) i) ... or maybe we have a rule for expt when r is a product...
-
-;rename to expt-gather? !
-;Note that this rule isn't enough to gather exponents in every situation.  For example, two factors, (expt 2 i)
-;and (expt 2 j), won't be gathered if there are intervening factors between them.
-;BOZO change param names
-(defthmd a15
-  (implies (and (rationalp i)
-                (not (equal i 0))
-                (integerp j1)
-                (integerp j2))
-           (and (equal (* (expt i j1) (expt i j2))
-                       (expt i (+ j1 j2)))
-                (equal (* (expt i j1) (* (expt i j2) x))
-                       (* (expt i (+ j1 j2)) x))))
-  :hints (("Goal" :in-theory (enable expt-split))))
-
-(defthm expt-r-0
-  (equal (expt r 0)
-         1)
-  :hints (("Goal" :in-theory (enable expt))))
-
-
-
-
-
-(defthm expt-0-i
-  (implies (and (case-split (integerp i))      ;since expt with a non-integer index is 1
-                (case-split (not (equal 0 i))) ;since (expt 0 0) is 1
-                )
-           (equal (expt 0 i)
-                  0))
-  :hints (("Goal" :in-theory (enable expt))))
-
-
-
-
-
-;==== A scheme for preventing massively expensive calls to expt =======
-
-#| When ACL2 encounters a function call with constant arguments, the simplifier just evaluates the function on
-those arguments.  However, calls of (expt r i) with huge i can be very expensive to compute.  (I suppose calls
-with huge r might be very expensive too, but r is almost always 2 in my work.)  The scheme below prevents
-(expt r i) from being evaluated when i is too large (but allows evaluation in the case of small i).
-
-|#
-
-(in-theory (disable (:executable-counterpart expt)))
-
-(set-compile-fns t)
-(defun expt-execute (r i) (expt r i))
-
-;Allows expt calls with small exponents to be computed  
-;You can change 1000 to your own desired bound.
-(defthm expt-execute-rewrite
-  (implies (and (syntaxp (and (quotep r) (quotep i) (< (abs (cadr i)) 1000))))
-           (equal (expt r i)
-                  (expt-execute r i))))
-
-
-#|
-The rules below are not complete, I proved them as needed to simplify terms like:
-(* x
-   (EXPT 2 1000001)
-   (/ (EXPT 2 1000000))
-   y)
-
-Note that we could just compute (EXPT 2 1000001) and (EXPT 2 1000000) but that would be very expensive.
-
-Perhaps we can make this into a complete theory, based on the observation that if a product contains two
-factors of the form (expt 2 k) of (/ (expt 2 k)), where k is a constant, those factors will be brought
-together because they are very close in the term order used order arguments to * (recall that unary-/ is
-ignored when we decide how to order arguments to *).  
-|#
-
-;this could be made more general (replace the lhs with its second arg...)
-(defthm expt2-constants-collect-special-1
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (rationalp y))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal  (* (EXPT 2 i1)
-                      (/ (EXPT 2 i2))
-                      y)
-                   (* (expt 2 (- i1 i2)) y)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '())))
-  )
-
-(defthm expt2-constants-collect-special-2
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal  (* (EXPT 2 i1)
-                      (/ (EXPT 2 i2))
-                      )
-                   (expt 2 (- i1 i2))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '())))
-  )
-
-(defthm expt2-constants-collect-special-4
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (rationalp y))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal (* (/ (EXPT 2 i2)) (EXPT 2 i1) y)
-                  (* (expt 2 (- i1 i2)) y)))
-  
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '()))))
-
-(defthm expt2-constants-collect-special-5
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal  (* (/ (EXPT 2 i2)) (EXPT 2 i1))
-                   (expt 2 (- i1 i2))))
-  
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '()))))
-
-
-
-;will this happen?
-(defthm expt2-constants-collect-special-6
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (rationalp x))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal  (* (EXPT 2 i2) x (EXPT 2 i1))
-                   (* (expt 2 (+ i1 i2)) x)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '()))))
-
-
-;whoa this one is sort of different... (it rewrites an equality)
-(defthm expt2-constants-collect-special-3
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (rationalp x))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal (equal (* x (EXPT 2 i1)) (EXPT 2 i2))
-                  (equal x (expt 2 (- i2 i1)))))
-  
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '())))
-)
-
-
-
-
-
-
-;==================================================================
-
-;expt-compare
-;handle constants as args?
-(defthm expt2-1-to-1
-  (implies (and (integerp i1)
-                (integerp i2))
-           (equal (equal (expt 2 i1) (expt 2 i2))
-                  (equal i1 i2)))
-  :hints (("Goal"
-           :use ((:instance expt-strong-monotone (n i1) (m i2))
-                 (:instance expt-strong-monotone (n i2) (m i1))))))
-
-
-
-
-
-
-
-;could gen? move hyps to concl?
-(defthm expt-even
-  (implies (and (< 0 i)
-                (case-split (integerp i))
-                )
-           (integerp (* 1/2 (expt 2 i))))
-  :hints (("goal" :in-theory (enable expt))))
-
-
-;generalize rules like this with a power2-syntaxp (not power2p!) ?
-;make conclusion an equality?
-(defthm expt-quotient-integerp
-  (implies (and (<= j i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (integerp (* (expt 2 i) (/ (expt 2 j)))))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (e/d (expt-split) ( expt-2-integerp))
-           :use (:instance expt-2-positive-integer-type (i (- i j))))))
-
-(defthm expt-quotient-integerp-alt
-  (implies (and (<= j i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (integerp (* (/ (expt 2 j)) (expt 2 i))))
-  :rule-classes (:rewrite :type-prescription))
-
-
-;is there a 2 term version?
-(defthm expt-prod-integer-3-terms
-  (implies (and (integerp n)
-                (<= 0 (+ i j))
-                (integerp i)
-                (integerp j)
-                )
-           (integerp (* (expt 2 i) (expt 2 j) n)))
-  :hints (("Goal" :in-theory (enable a15))))
-
-
-;drop these?
-;generalize to comparisons to any constant (any power of 2)?
-
-;bad name?
-
-(defthm expt2-inverse-integer
-  (implies (case-split (integerp i))
-           (equal (integerp (/ (expt 2 i)))
-                  (<= i 0)))
-  :hints (("Goal" :in-theory (disable expt2-integer)
-           :use (:instance expt2-integer (i (- i))))))
-
-;figure out a better solution to this problem
-;perhaps say if a term is a power of 2, then it's an integer iff its expo is >=0
-(defthm expt-prod-integer-3-terms-2
-  (implies (and (<= 0 (+ i (- j) (- l)))
-                (integerp i)
-                (integerp j)
-                (integerp l)
-                )
-           (integerp (* (expt 2 i) (/ (expt 2 j)) (/ (expt 2 l)))))
-  :hints (("Goal" :in-theory (set-difference-theories (enable a15 expt-inverse)
-                                                      '(expt-minus))))
-  )
-
-#| would be nice (use expt2-1-to-1)?
-(defthm expt2-equal-1
-  (implies (integerp i)
-           (equal (EQUAL (EXPT 2 i) 1)
-                  (equal i 0)))
-;  :rule-classes nil
-  :hints (("Goal" :in-theory (enable expt-split-rewrite)))
-)
-|#
-
-(defthm expt2-inverse-even
-  (implies (case-split (integerp i))
-           (equal (integerp (* 1/2 (/ (expt 2 i))))
-                  (<= (+ 1 i) 0)))
-  :otf-flg t
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '(expt2-integer  EXPT2-INVERSE-INTEGER))
-           :use (:instance expt2-integer (i (+ -1 (- i)))))))
-
-
-;loops with a15?
-; (expt (* 2 i)) was matching with (expt 2 0) (booo!) so I added the syntaxp hyp
-(defthmd expt-2-split-product-index
-  (implies (and (syntaxp (not (quotep i)))
-                (case-split (rationalp r))
-                (case-split (integerp i)))
-           (equal (expt r (* 2 i))
-                  (* (expt r i) (expt r i))))
-  :hints (("Goal" :in-theory (disable expt-split)
-           :use (:instance expt-split (i i) (j i)))))
-
-
-;linear?
-(defthm expt-bigger-than-i
-  (implies (integerp i)
-           (< i (expt 2 i)))
-  :hints (("Goal" :in-theory (enable expt)))
-  )
-
-;BOZO this might loop with expt-split
-;i'm not sure that this is a good rewrite anyway
-(defthmd expt-compare-with-double
-  (implies (and (integerp x)
-                (integerp i))
-           (equal (< (* 2 x) (expt 2 i))
-                  (< x (expt 2 (+ -1 i)))))
-  :hints (("Goal" :in-theory (enable expt-split))))
-
-;leave this disabled?
-(defthmd expt-2-reduce-leading-constant-gen
-  (implies (case-split (integerp (+ k d)))
-           (equal (expt 2 (+ k d))
-                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d)))))
-    :hints (("Goal" :in-theory (set-difference-theories
-                                (enable mod)
-                                '(expt-split))
-             :use (:instance expt-split (r 2) (i (fl k)) (j (+ (mod k 1) d))))))
-
-
-;handles the case when k isn't even an integer!
-;loops with a15!  add theory invariant....
-(defthmd expt-2-reduce-leading-constant
-  (implies (and (syntaxp (and (quotep k)
-                         (or (>= (cadr k) 1) (< (cadr k) 0))))
-                (case-split (integerp (+ k d)))
-                )
-           (equal (expt 2 (+ k d))
-                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d)))))
-    :hints (("Goal" :in-theory (set-difference-theories
-                                (enable)
-                                '(expt-split))
-             :use (expt-2-reduce-leading-constant-gen
-                   (:instance expt-split (r 2) (i (fl k)) (j (+ (mod k 1) d)))))))
-
-; BOZO better than a15?
-(defthmd expt-combine
-  (implies (and (case-split (rationalp r))
-                (case-split (not (equal r 0)))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (and (equal (* (expt r i1) (expt r i2))
-                       (expt r (+ i1 i2)))
-                (equal (* (expt r i1) (* (expt r i2) x))
-                       (* (expt r (+ i1 i2)) x))))
-  :hints (("goal" :in-theory (enable a15))))
-
-
-;remove since we have expt-compare?
-(defthm expt-with-small-n
-  (implies (<= n 0)
-           (<= (expt 2 n) 1))
-  :hints (("Goal" :use (:instance expt-weak-monotone (m 0)))) 
-  :rule-classes (:linear))
-
-
-#|
-(include-book
- "factor-2")
-
-
-;which way do we want to do this?
-;disable later?
-;add a "can have a 2 multiplied in" hyp to this series?
-(defthm expt-2-combine-like-is
-  (implies (and (syntaxp (should-have-a-2-factor-multiplied-in i))
-                (integerp i))
-           (equal (* (expt 2 i) (expt 2 i))
-                  (expt 2 (* 2 i))))
-  :hints (("Goal" :in-theory (disable expt-split)
-           :use (:instance expt-split (r 2) (i i) (j i)))))
-
-(defthm expt-2-combine-like-is-3-and-4-of-6
-  (implies (and (syntaxp (should-have-a-2-factor-multiplied-in i))
-                (integerp i)
-                (rationalp a)
-                (rationalp b)
-                (rationalp c)
-                (rationalp d)
-                )
-           (equal (* a b (expt 2 i) (expt 2 i) c d )
-                  (* a b c d (expt 2 (* 2 i)))))
-  :hints (("Goal" :in-theory (disable expt-split)
-           :use (:instance expt-split (r 2) (i i) (j i)))))
-
-(defthm expt-2-combine-like-is-4-and-5-of-6
-  (implies (and (syntaxp (should-have-a-2-factor-multiplied-in i))
-                (integerp i)
-                (rationalp a)
-                (rationalp b)
-                (rationalp c)
-                (rationalp d)
-                )
-           (equal (* a b c (expt 2 i) (expt 2 i) d )
-                  (* a b c d (expt 2 (* 2 i)))))
-  :hints (("Goal" :in-theory (disable expt-split)
-           :use (:instance expt-split (r 2) (i i) (j i)))))
-
-
-
-(defthm expt-2-combine-like-is-inverted
-  (implies (and (syntaxp (should-have-a-2-factor-multiplied-in i))
-                (integerp i))
-           (equal (* (/ (EXPT 2 i))
-                     (/ (EXPT 2 i)))
-                  (/ (expt 2 (* 2 i)))))
-  :hints (("Goal" :in-theory (disable 
-                              expt-2-combine-like-is
-                              expt-split)
-           :use (:instance  expt-split (r 2) (i (* 1/2 i)) (j (* 1/2 i))))))
-
-|#
-
-
-
-
-
-
-
-#|
-(defthm expt-prod-integer-4-terms
-  (implies (and (integerp i)
-                (integerp j)
-                (integerp l)
-                (<= 0 (+ i (- j) l))
-                (integerp n))
-           (integerp (* (expt 2 i) (/ (expt 2 j)) (expt 2 l) n)))
-  :hints (("Goal" :in-theory (set-difference-theories (enable a15 expt-inverse)
-                                                      '(expt-minus))))
-  )
-
-
-
-
-would be nice (use expt2-1-to-1)?
-(defthm expt2-equal-1
-  (implies (integerp i)
-           (equal (EQUAL (EXPT 2 i) 1)
-                  (equal i 0)))
-;  :rule-classes nil
-  :hints (("Goal" :in-theory (enable expt-split)))
-)
-
-
-;remove?
-;actually, maybe this is good whether we are scattering or gathering...
-;bad name?
-;in general, are there rules which are good for scattering and for gathering?
-(defthm expt-simp
-  (implies (integerp x)
-           (equal (* 2 (EXPT 2 (+ -1 x)))
-                  (expt 2 x)))
-  :hints (("Goal" :use (:instance a15 (i 2) (j1 1) (j2 (+ -1 x))))))
-
-
-(defthmd expt-next
-  (implies (and (integerp i1)
-                (integerp i2)
-                (< (expt 2 i1) (expt 2 i2)))
-           (<= (expt 2 i1) (expt 2 (+ -1 i2)))))
-
-
-
-|#
-
-
-(local (include-book "even-odd"))
-
-;move? make fw-chaining rule?
-(defthmd even-not-equal-odd
-  (implies (and (evenp x)
-                (oddp y))
-           (not (equal x y)))
-  :hints (("Goal" :in-theory (enable oddp))))
-
-;this is sort of strange...
-(defthm expt-2-is-not-odd
-  (implies (and (evenp x)
-                (< 0 i) ;drop?
-                (integerp i)
-                )
-           (equal (equal (expt 2 i)
-                         (+ 1 x))
-                  nil))
-  :hints (("Goal" :in-theory (enable evenp oddp  even-not-equal-odd)))  ;shouldn't have to enable oddp
-  :otf-flg t)
-
-
-(defthm a14
-  (and
-   (implies (and (integerp i)
-                 (<= 0 i)
-                 (<= 0 j))
-            (and (integerp (expt i j))
-                 (<= 0 (expt i j))))
-   (implies (and (rationalp i)
-                 (not (equal i 0)))
-            (not (equal (expt i j) 0))))
-  :hints
-  (("Goal" :in-theory (enable expt)))
-  :rule-classes
-  ((:type-prescription
-    :corollary
-    (implies (and (integerp i)
-                  (<= 0 i)
-                  (<= 0 j))
-             (and (integerp (expt i j))
-                  (<= 0 (expt i j)))))
-   (:type-prescription
-    :corollary
-    (implies (and (rationalp i)
-                  (not (equal i 0)))
-             (not (equal (expt i j) 0))))))
-
-
-#|
-;this will get rewritten away?
-(defthm expt-in-product-linear	
-  (implies (and (<= 0 i)	
-		(<= 0 x)
-                (case-split (rationalp x))
-                )	
-	   (<= x (* x (expt 2 i))))
-  :rule-classes (:linear)
-  )
-
-;this will get rewritten away?
-(defthm expt-in-product-linear-2
-   (implies (and (case-split (<= i 0))	
-                 (case-split (<= 0 x))
-                 (case-split (rationalp x))
-                 )	
-            (<= (* x (expt 2 i)) x))
-   :rule-classes (:linear)
-   )
-
-|#
-
-;crap.  This unifies with (EXPT '2 '0), which we see because we disable the executable counterpart of expt to
-;prevent massively expensive calls.
-;loops with a15!!
-;add theory invar!
-;does this already exist?
-(defthmd expt-with-product-exponent
-  (implies (and (syntaxp (not (quotep i)))
-                (case-split (integerp i)))
-	   (equal (expt 2 (* 2 i))	
-		  (* (expt 2 i) (expt 2 i))))
-  :hints (("Goal" :in-theory (enable a15))))
-
-
-
-;yuck
-;perhaps use only expt-2-positive-integer-type;
-;don't need this if natp is enabled?
-(defthmd natp-expt
-  (implies (natp n)
-           (and (integerp (expt 2 n))
-                (< 0 (expt 2 n))))
-  :rule-classes (:type-prescription :rewrite))
-
-
-
-#|
-
-these deal with arbitrary bases (not just 2):
-
-(local (include-book
-        "../../../arithmetic-2/meta/expt"))
-(local
- (include-book
-  "../arithmetic/product"))
-
-(defun natp (x)
-  (declare (xargs :guard t))
-  (and (integerp x)
-       (>= x 0)))
-
-
-
-;allows both a and b to be non-integers:
-(defthm expt-non-negative
-  (implies (and (<= 0 a)	
-		(<= 0 b)	 		
-		(case-split (rationalp a))	
-		)					
-	   (<= 0 (expt a b))))
-
-(defthm expt-integerp
-  (implies (and (natp a)	
-		(<= 0 b) 		
-		)					
-	   (integerp (expt a b))))
-
-|#
-
-
-;there are funny little rules...
-
-(defthm expt-exceeds-another-by-more-than-1
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (integerp i)
-                (integerp j)
-                )
-           (implies (< (+ 1 i) j)
-                    (< (+ 1 (expt 2 i)) (expt 2 j))))
-  :hints (("Goal" :in-theory (enable expt-split)
-           :use (:instance expt-strong-monotone (n (+ 1 i)) (m j)))))
-
-
-(defthm expt-exceeds-2
-  (IMPLIES (AND (< i j)
-                (<= 0 i)
-                (<= 0 j)
-                (INTEGERP i)
-                (INTEGERP j)
-                )
-           (<= (+ 1 (EXPT 2 i)) (EXPT 2 j)))
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :use (:instance expt-strong-monotone (n i) (m j)))))
-
-#|
-
-Are there some rules (such as this one) which we want enabled for both scaterring and gathering exponents?
-
-(defthm expt-hack
-  (equal (* (expt 2 n) (expt 2 (* -1 n))) 1)
-  :hints (("Goal" :in-theory (e/d () (EXPT-minus)))))
-
-(defthm expt-hack-2
-  (equal (* (expt 2 (* -1 n)) (expt 2 n)) 1)
-  :hints (("Goal" :in-theory (e/d () (EXPT-minus)))))
-|#
-
-
-(defthm expt-with-i-non-integer-special
-  (implies (not (integerp i))
-           (equal (EXPT 2 (+ -1 i))
-                  (if (acl2-numberp i)
-                      1
-                    1/2))))
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/expt.lisp acl2-6.3/books/rtl/rel5/arithmetic/expt.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/expt.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/expt.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,537 +0,0 @@
-(in-package "ACL2")
-
-;this book contains very basic expt stuff (i couldn't include expt.lisp in basic.lisp because of a circular dependency)
-
-;todo: 
-;make a separate expt-proofs book
-;there's a distinction between expt and expt-2 rules
-;make consistent names:  expt vs. expt2   
-;think about the rules to combine and split exponents
-;generalize some of these rules to be about expt with any base (not just 2)
-
-;remove this?
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ground-zero")
-(include-book "negative-syntaxp")
-(local (include-book "expt-proofs"))
-
-(defthm a16
-  (equal (expt (* a b) i)
-         (* (expt a i) (expt b i))))
-
-
-;gen
-;split off the non-integer case
-;make an expt2-split?
-;instead of i1 and i2, use i and j?
-(defthmd expt-split
-  (implies (and (integerp i)
-                (integerp j)
-                (case-split (acl2-numberp r)) ;(integerp r)
-                (case-split (not (equal r 0)))
-                )
-           (equal (expt r (+ i j))
-                  (* (expt r i) (expt r j)))))
-
-
-
-(theory-invariant
-  (not (and (active-runep '(:rewrite expt-split))
-            (active-runep '(:rewrite a15))))
-  :key expt-split-invariant)
-
-(theory-invariant
-  (not (and (active-runep '(:rewrite expt-split))
-            (active-runep '(:definition expt))))
-  :key expt-split-invariant-2)
-
-
-;see also a14
-;generalize?  use arith books?
-(defthm expt-2-positive-rational-type
-  (and (rationalp (expt 2 i))
-       (< 0 (expt 2 i)))
-  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
-
-;like a14?
-(defthm expt-2-positive-integer-type
-  (implies (<= 0 i)
-           (and (integerp (expt 2 i))
-                (< 0 (expt 2 i))))
-  :rule-classes (:type-prescription))
-
-(defthm a14
-  (and
-   (implies (and (integerp i)
-                 (<= 0 i)
-                 (<= 0 j))
-            (and (integerp (expt i j))
-                 (<= 0 (expt i j))))
-   (implies (and (rationalp i)
-                 (not (equal i 0)))
-            (not (equal (expt i j) 0))))
-
-  :rule-classes
-  ((:type-prescription
-    :corollary
-    (implies (and (integerp i)
-                  (<= 0 i)
-                  (<= 0 j))
-             (and (integerp (expt i j))
-                  (<= 0 (expt i j)))))
-   (:type-prescription
-    :corollary
-    (implies (and (rationalp i)
-                  (not (equal i 0)))
-             (not (equal (expt i j) 0))))))
-
-
-;someday our rules may be better, but right now, ours only talk about when when the base is 2
-;(in-theory (disable (:TYPE-PRESCRIPTION EXPT)))
-
-
-;the rewrite rule counterpart to expt-2-positive-integer-type
-(defthm expt-2-integerp
-  (implies (<= 0 i)
-           (integerp (expt 2 i))))
-
-(defthm expt-2-type-linear
-  (implies (<= 0 i)
-           (<= 1 (expt 2 i)))
-  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
-
-
-
-;when you disable either of the two rules below, you might want to also disable expt-compare?
-;took these rules out of :rewrite since we have expt-compare?
-;are these bad :linear rules because they have free vars?
-
-(defthmd expt-strong-monotone
-  (implies (and (integerp n)
-                (integerp m))
-           (equal (< (expt 2 n) (expt 2 m))
-                  (< n m))))
-
-;improve to handle i non-integer?
-(defthm expt2-integer
-  (implies (case-split (integerp i))
-           (equal (integerp (expt 2 i))
-                  (<= 0 i))))
-
-;trying :match-free :all
-;why disabled?
-(defthmd expt-strong-monotone-linear
-  (implies (and (< n m)
-                (case-split (integerp n))
-                (case-split (integerp m))
-                )
-           (< (expt 2 n) (expt 2 m)))
-  :rule-classes ((:linear :match-free :all)))
-
-;why disabled?
-(defthmd expt-weak-monotone
-  (implies (and (integerp n)
-                (integerp m))
-           (equal (<= (expt 2 n) (expt 2 m))
-		  (<= n m))))
-
-;disabled because of the free var
-;but is occasionally helpful
-;make linear?
-;BOZO rename params?
-;trying :match-free :all
-(defthmd expt-weak-monotone-linear
-  (implies (and (<= n m)
-                (case-split (integerp n))
-                (case-split (integerp m)))
-           (<= (expt 2 n) (expt 2 m)))
-  :rule-classes ((:linear :match-free :all)))
-
-;generalize? rewrite (< (expt 2 i) k) to a comparison of (expt 2 i) and the greatest power of 2 <= k
-;is this what expt-compare does?
-(defthmd expt-between-one-and-two
-  (implies (and (<= 1 (expt 2 i))
-                (< (expt 2 i) 2))
-           (equal (expt 2 i) 1)))
-
-
-;We could disable this if it causes problems (but it seems okay).
-;should always use case-split n hyps that say exponents are integers
-(defthm expt-with-i-non-integer
-  (implies (not (integerp i))
-           (equal (expt r i)
-                  1)))
-
-(defthmd expt-minus-helper
-  (equal (expt r (* -1 i))
-         (/ (expt r i))))
-
-;BOZO disable or enable by default?
-;Loops with expt-inverse. How do we want to handle this??
-;I'd rather have the inverting done outside EXPT since most rules don't look inside EXPT.
-;This rule can be said to scatter exponents...
-(defthmd expt-minus
-  (implies (syntaxp (negative-syntaxp i))
-           (equal (expt r i)
-                  (/ (expt r (* -1 i))))))
-
-;This can loop with expt-minus (see theory-invariant).
-(defthmd expt-inverse
-  (equal (/ (expt 2 i))
-         (expt 2 (* -1 i))))
-
-(theory-invariant
-  (not (and (active-runep '(:rewrite expt-minus))
-            (active-runep '(:rewrite expt-inverse))))
-  :key expt-minus-invariant)
-
-
-;could prove a rule for (expt (* -1 r) i) ... or maybe we have a rule for expt when r is a product...
-
-;rename to expt-gather? !
-;Note that this rule isn't enough to gather exponents in every situation.  For example, two factors, (expt 2 i)
-;and (expt 2 j), won't be gathered if there are intervening factors between them.
-;BOZO change param names
-(defthmd a15
-  (implies (and (rationalp i)
-                (not (equal i 0))
-                (integerp j1)
-                (integerp j2))
-           (and (equal (* (expt i j1) (expt i j2))
-                       (expt i (+ j1 j2)))
-                (equal (* (expt i j1) (* (expt i j2) x))
-                       (* (expt i (+ j1 j2)) x)))))
-
-(defthm expt-r-0
-  (equal (expt r 0)
-         1))
-
-(defthm expt-0-i
-  (implies (and (case-split (integerp i))      ;since expt with a non-integer index is 1
-                (case-split (not (equal 0 i))) ;since (expt 0 0) is 1
-                )
-           (equal (expt 0 i)
-                  0)))
-
-
-
-
-
-;==== A scheme for preventing massively expensive calls to expt =======
-
-#| When ACL2 encounters a function call with constant arguments, the simplifier just evaluates the function on
-those arguments.  However, calls of (expt r i) with huge i can be very expensive to compute.  (I suppose calls
-with huge r might be very expensive too, but r is almost always 2 in my work.)  The scheme below prevents
-(expt r i) from being evaluated when i is too large (but allows evaluation in the case of small i).
-
-|#
-
-(in-theory (disable (:executable-counterpart expt)))
-
-(set-compile-fns t)
-(defun expt-execute (r i) (expt r i))
-
-;Allows expt calls with small exponents to be computed  
-;You can change 1000 to your own desired bound.
-(defthm expt-execute-rewrite
-  (implies (and (syntaxp (and (quotep r) (quotep i) (< (abs (cadr i)) 1000))))
-           (equal (expt r i)
-                  (expt-execute r i))))
-#|
-The rules below are not complete, I proved them as needed to simplify terms like:
-(* x
-   (EXPT 2 1000001)
-   (/ (EXPT 2 1000000))
-   y)
-
-Note that we could just compute (EXPT 2 1000001) and (EXPT 2 1000000) but that would be very expensive.
-
-Perhaps we can make this into a complete theory, based on the observation that if a product contains two
-factors of the form (expt 2 k) of (/ (expt 2 k)), where k is a constant, those factors will be brought
-together because they are very close in the term order used order arguments to * (recall that unary-/ is
-ignored when we decide how to order arguments to *).  
-|#
-
-;this could be made more general (replace the lhs with its second arg...)
-(defthm expt2-constants-collect-special-1
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (rationalp y))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal  (* (EXPT 2 i1)
-                      (/ (EXPT 2 i2))
-                      y)
-                   (* (expt 2 (- i1 i2)) y))))
-
-(defthm expt2-constants-collect-special-2
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal  (* (EXPT 2 i1)
-                      (/ (EXPT 2 i2))
-                      )
-                   (expt 2 (- i1 i2)))))
-
-(defthm expt2-constants-collect-special-4
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (rationalp y))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal (* (/ (EXPT 2 i2)) (EXPT 2 i1) y)
-                  (* (expt 2 (- i1 i2)) y))))
-
-(defthm expt2-constants-collect-special-5
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal  (* (/ (EXPT 2 i2)) (EXPT 2 i1))
-                   (expt 2 (- i1 i2)))))
-
-
-
-;will this happen?
-(defthm expt2-constants-collect-special-6
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (rationalp x))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal  (* (EXPT 2 i2) x (EXPT 2 i1))
-                   (* (expt 2 (+ i1 i2)) x))))
-
-
-;whoa this one is sort of different... (it rewrites an equality)
-(defthm expt2-constants-collect-special-3
-  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
-                (case-split (rationalp x))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (equal (equal (* x (EXPT 2 i1)) (EXPT 2 i2))
-                  (equal x (expt 2 (- i2 i1))))))
-
-
-
-
-
-
-;==================================================================
-
-;expt-compare
-;handle constants as args?
-(defthm expt2-1-to-1
-  (implies (and (integerp i1)
-                (integerp i2))
-           (equal (equal (expt 2 i1) (expt 2 i2))
-                  (equal i1 i2))))
-
-;could gen? move hyps to concl?
-(defthm expt-even
-  (implies (and (< 0 i)
-                (case-split (integerp i))
-                )
-           (integerp (* 1/2 (expt 2 i)))))
-
-
-;generalize rules like this with a power2-syntaxp (not power2p!) ?
-;make conclusion an equality?
-(defthm expt-quotient-integerp
-  (implies (and (<= j i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (integerp (* (expt 2 i) (/ (expt 2 j)))))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm expt-quotient-integerp-alt
-  (implies (and (<= j i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (integerp (* (/ (expt 2 j)) (expt 2 i))))
-  :rule-classes (:rewrite :type-prescription))
-
-
-;is there a 2 term version?
-(defthm expt-prod-integer-3-terms
-  (implies (and (integerp n)
-                (<= 0 (+ i j))
-                (integerp i)
-                (integerp j)
-                )
-           (integerp (* (expt 2 i) (expt 2 j) n))))
-
-
-;drop these?
-;generalize to comparisons to any constant (any power of 2)?
-
-;bad name?
-
-(defthm expt2-inverse-integer
-  (implies (case-split (integerp i))
-           (equal (integerp (/ (expt 2 i)))
-                  (<= i 0))))
-
-;figure out a better solution to this problem
-;perhaps say if a term is a power of 2, then it's an integer iff its expo is >=0
-(defthm expt-prod-integer-3-terms-2
-  (implies (and (<= 0 (+ i (- j) (- l)))
-                (integerp i)
-                (integerp j)
-                (integerp l)
-                )
-           (integerp (* (expt 2 i) (/ (expt 2 j)) (/ (expt 2 l))))))
-
-
-(defthm expt2-inverse-even
-  (implies (case-split (integerp i))
-           (equal (integerp (* 1/2 (/ (expt 2 i))))
-                  (<= (+ 1 i) 0))))
-
-
-;loops with a15?
-; (expt (* 2 i)) was matching with (expt 2 0) (booo!) so I added the syntaxp hyp
-(defthmd expt-2-split-product-index
-  (implies (and (syntaxp (not (quotep i)))
-                (case-split (rationalp r))
-                (case-split (integerp i)))
-           (equal (expt r (* 2 i))
-                  (* (expt r i) (expt r i)))))
-
-
-;linear?
-(defthm expt-bigger-than-i
-  (implies (integerp i)
-           (< i (expt 2 i))))
-
-;BOZO this might loop with expt-split
-;i'm not sure that this is a good rewrite anyway
-(defthmd expt-compare-with-double
-  (implies (and (integerp x)
-                (integerp i))
-           (equal (< (* 2 x) (expt 2 i))
-                  (< x (expt 2 (+ -1 i))))))
-
-;leave this disabled?
-(defthmd expt-2-reduce-leading-constant-gen
-  (implies (case-split (integerp (+ k d)))
-           (equal (expt 2 (+ k d))
-                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d))))))
-
-
-;handles the case when k isn't even an integer!
-;loops with a15!  add theory invariant....
-(defthmd expt-2-reduce-leading-constant
-  (implies (and (syntaxp (and (quotep k)
-                         (or (>= (cadr k) 1) (< (cadr k) 0))))
-                (case-split (integerp (+ k d)))
-                )
-           (equal (expt 2 (+ k d))
-                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d))))))
-
-; BOZO better than a15?
-(defthmd expt-combine
-  (implies (and (case-split (rationalp r))
-                (case-split (not (equal r 0)))
-                (case-split (integerp i1))
-                (case-split (integerp i2)))
-           (and (equal (* (expt r i1) (expt r i2))
-                       (expt r (+ i1 i2)))
-                (equal (* (expt r i1) (* (expt r i2) x))
-                       (* (expt r (+ i1 i2)) x)))))
-
-
-
-;remove since we have expt-compare?
-(defthm expt-with-small-n
-  (implies (<= n 0)
-           (<= (expt 2 n) 1))
-  :rule-classes (:linear))
-
-
-
-
-
-
-
-
-;move? make fw-chaining rule?
-(defthmd even-not-equal-odd
-  (implies (and (evenp x)
-                (oddp y))
-           (not (equal x y))))
-
-;this is sort of strange...
-(defthm expt-2-is-not-odd
-  (implies (and (evenp x)
-                (< 0 i) ;drop?
-                (integerp i)
-                )
-           (equal (equal (expt 2 i)
-                         (+ 1 x))
-                  nil)))
-
-
-
-
-
-;crap.  This unifies with (EXPT '2 '0), which we see because we disable the executable counterpart of expt to
-;prevent massively expensive calls.
-;loops with a15!!
-;add theory invar!
-;does this already exist?
-(defthmd expt-with-product-exponent
-  (implies (and (syntaxp (not (quotep i)))
-                (case-split (integerp i)))
-	   (equal (expt 2 (* 2 i))	
-		  (* (expt 2 i) (expt 2 i)))))
-
-
-
-;yuck
-;perhaps use only expt-2-positive-integer-type;
-;don't need this if natp is enabled?
-(defthmd natp-expt
-  (implies (natp n)
-           (and (integerp (expt 2 n))
-                (< 0 (expt 2 n))))
-  :rule-classes (:type-prescription :rewrite))
-
-
-
-
-;there are funny little rules...
-
-(defthm expt-exceeds-another-by-more-than-1
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (integerp i)
-                (integerp j)
-                )
-           (implies (< (+ 1 i) j)
-                    (< (+ 1 (expt 2 i)) (expt 2 j)))))
-
-
-(defthm expt-exceeds-2
-  (IMPLIES (AND (< i j)
-                (<= 0 i)
-                (<= 0 j)
-                (INTEGERP i)
-                (INTEGERP j)
-                )
-           (<= (+ 1 (EXPT 2 i)) (EXPT 2 j)))
-  :rule-classes (:rewrite :linear))
-
-(defthm expt-with-i-non-integer-special
-  (implies (not (integerp i))
-           (equal (EXPT 2 (+ -1 i))
-                  (if (acl2-numberp i)
-                      1
-                    1/2))))
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/extra-rules.lisp acl2-6.3/books/rtl/rel5/arithmetic/extra-rules.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/extra-rules.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/extra-rules.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,313 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-;this books contains rules which aren't used anywhere in lib/ or support/
-
-(in-package "ACL2")
-
-;(include-book "fp2")
-;(local (include-book "even-odd"))
-(local (include-book "basic")) ;yuck
-
-
-(defthm exp+1-1
-  (implies (and (integerp m)
-                (integerp n)
-                (<= n m))
-           (<= (+ (expt 2 m) (expt 2 n))
-               (expt 2 (1+ m))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expt-weak-monotone)
-			(:instance expt-split (r 2) (i 1) (j m))))))
-
-(defthm exp+1
-    (implies (and (integerp m)
-		  (integerp n)
-		  (<= n m))
-	     (> (* (- 1 (expt 2 m)) (- 1 (expt 2 n)))
-		(- 1 (expt 2 (1+ m)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable)
-		  :use ((:instance exp+1-1)
-                        ))))
-
-(defthm exp+2-1
-    (implies (and (integerp n)
-		  (integerp m)
-		  (<= n m)
-		  (<= m 0))
-	     (<= (* (expt 2 m) (expt 2 n))
-		 (expt 2 m)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expt-weak-monotone (n (+ m n)))
-			(:instance expt-split (r 2))))))
-
-(defthm exp+2-2
-    (implies (and (integerp n)
-		  (integerp m)
-		  (<= n m)
-		  (<= m 0))
-	     (<= (+ (expt 2 m) (expt 2 n) (* (expt 2 m) (expt 2 n)))
-		 (* 3 (expt 2 m))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable)
-		  :use ((:instance expt-weak-monotone)
-			(:instance exp+2-1)))))
-
-(defthm exp+2-3
-    (implies (and (integerp n)
-		  (integerp m)
-		  (<= n m)
-		  (<= m 0))
-	     (< (+ (expt 2 m) (expt 2 n) (* (expt 2 m) (expt 2 n)))
-		 (* 4 (expt 2 m))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable)
-		  :use (
-			(:instance exp+2-2)
-			(:instance *-strongly-monotonic (x (expt 2 m)) (y 3) (y+ 4))))))
-
-(defthm exp+2
-    (implies (and (integerp n)
-		  (integerp m)
-		  (<= n m)
-		  (<= m 0))
-	     (< (* (1+ (expt 2 m)) (1+ (expt 2 n)))
-		(1+ (expt 2 (+ m 2)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance exp+2-3)
-			(:instance expt-split (r 2) (i 2) (j m))))))
-
-
-(defthm exp-invert-1
-    (implies (and (integerp n)
-		  (<= n -1))
-	     (<= (* (expt 2 n) (expt 2 (1+ n)))
-		 (expt 2 n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expt-weak-monotone (n (1+ n)) (m 0))
-			(:instance *-weakly-monotonic (x (expt 2 n)) (y (expt 2 (1+ n))) (y+ 1))))))
-
-(defthm exp-invert-2
-    (implies (and (integerp n)
-		  (<= n -1))
-	     (>= (* (- 1 (expt 2 n))
-		    (1+ (expt 2 (1+ n))))
-		 1))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expt-split (r 2) (i n) (j 1))
-			(:instance exp-invert-1)))))
-
-(defthm cancel-x
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (<= 1 (* x y)))
-	     (<= (/ x) y))
-  :rule-classes ())
-
-(defthm exp-invert
-    (implies (and (integerp n)
-		  (<= n -1))
-	     (<= (/ (- 1 (expt 2 n)))
-		 (1+ (expt 2 (1+ n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance cancel-x (x (- 1 (expt 2 n))) (y (1+ (expt 2 (1+ n)))))
-			(:instance exp-invert-1)
-			(:instance expt-weak-monotone (m -1))))))
-
-
-(local
- (defthm sq-sq-1
-    (implies (and (rationalp a)
-		  (rationalp b)
-		  (rationalp p)
-		  (integerp n)
-		  (>= p 0)
-		  (<= (* (- 1 (expt 2 n)) p) (* a a))
-		  (<= (* a a) p)
-		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
-	     (<= (* (* a b) (* a b))
-		 (* (expt 2 (- (* 2 n) 2)) (* p p))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance *-doubly-monotonic 
-				   (x (* a a)) (a (* b b)) 
-				   (y p) (b (* (expt 2 (- (* 2 n) 2)) p))))))))
-;not exported anywhere!
-;rephrase?
-(defthm sqrt<=
-    (implies (and (rationalp x)
-		  (rationalp a)
-		  (>= a 0)
-		  (<= (* x x) (* a a)))
-	     (<= x a))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance *-strongly-monotonic (y a) (y+ x))
-			(:instance *-strongly-monotonic (x a) (y a) (y+ x))))))
-(local
- (defthm sq-sq-2
-    (implies (and (rationalp a)
-		  (rationalp b)
-		  (rationalp p)
-		  (integerp n)
-		  (>= p 0)
-		  (<= (* (- 1 (expt 2 n)) p) (* a a))
-		  (<= (* a a) p)
-		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
-	     (<= (* (* (expt 2 (1- n)) p) (* (expt 2 (1- n)) p))
-		 (* (expt 2 (- (* 2 n) 2)) (* p p))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expt-split (r 2) (i (1- n)) (j (1- n))))))))
-
-
-(local
- (defthm sq-sq-3
-    (implies (and (rationalp a)
-		  (rationalp b)
-		  (rationalp p)
-		  (integerp n)
-		  (>= p 0)
-		  (<= (* (- 1 (expt 2 n)) p) (* a a))
-		  (<= (* a a) p)
-		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
-	     (>= (* (expt 2 (1- n)) p) 0))
-  :rule-classes ()))
-
-(local
- (defthm sq-sq-4
-    (implies (and (rationalp a)
-		  (rationalp b)
-		  (rationalp p)
-		  (integerp n)
-		  (>= p 0)
-		  (<= (* (- 1 (expt 2 n)) p) (* a a))
-		  (<= (* a a) p)
-		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
-	     (<= (* a b)
-		 (* (expt 2 (1- n)) p)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable a15)
-           :use ((:instance sq-sq-1)
-			(:instance sq-sq-3)
-			(:instance sqrt<= (x (* a b)) (a (* (expt 2 (1- n)) p)))
-			(:instance sq-sq-2))))))
-
-(local
- (defthm sq-sq-5
-    (implies (and (rationalp x)
-		  (rationalp p)
-		  (integerp n)
-		  (<= x (* (expt 2 (1- n)) p)))
-	     (<= (* 2 x) (* (expt 2 n) p)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable *-weakly-monotonic)
-		  :use ((:instance expt-split (r 2) (i (1- n)) (j 1))
-			(:instance *-weakly-monotonic (x 2) (y x) (y+ (* (expt 2 (1- n)) p))))))))
-
-
-(local
- (defthm sq-sq-6
-    (implies (and (rationalp a)
-		  (rationalp b)
-		  (rationalp p)
-		  (integerp n)
-		  (>= p 0)
-		  (<= (* (- 1 (expt 2 n)) p) (* a a))
-		  (<= (* a a) p)
-		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
-	     (<= (* 2 a b)
-		 (* (expt 2 n) p)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance sq-sq-4)
-			(:instance sq-sq-5 (x (* a b))))))))
-
-(local
- (defthm sq-sq-7
-    (implies (and (rationalp a)
-		  (rationalp b))
-	     (>= (* (- a b) (- a b))
-		 (- (* a a) (* 2 a b))))
-  :rule-classes ()))
-
-(local
- (defthm sq-sq-8
-    (implies (and (rationalp a)
-		  (rationalp b)
-		  (rationalp p)
-		  (integerp n)
-		  (>= p 0)
-		  (<= (* (- 1 (expt 2 n)) p) (* a a))
-		  (<= (* a a) p)
-		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
-	     (>= (* (- a b) (- a b))
-		 (- (* (- 1 (expt 2 n)) p)
-		    (* (expt 2 n) p))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance sq-sq-6)
-			(:instance sq-sq-7))))))
-
-(local
- (defthm sq-sq-9
-    (implies (and (rationalp p)
-		  (integerp n))
-	     (= (- (* (- 1 (expt 2 n)) p)
-		   (* (expt 2 n) p))
-		(* (- 1 (expt 2 (1+ n))) p)))
-  :rule-classes ()))
-
-;where is this used?
-;doesn't seem to be used anywhere or exported in lib?
-(defthm sq-sq
-    (implies (and (rationalp a)
-		  (rationalp b)
-		  (rationalp p)
-		  (integerp n)
-		  (<= (* (- 1 (expt 2 n)) p) (* a a))
-		  (<= (* a a) p)
-		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
-	     (>= (* (- a b) (- a b))
-		 (* (- 1 (expt 2 (1+ n))) p)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance sq-sq-8)
-			(:instance sq-sq-9)))))
-
-;kill some of these 4 abs lemmas (they are from divsqrt and don't seem to be
-;needed in support/ or exported in lib/) ?
-
-(defthm abs-+
-  (implies (and (rationalp x)
-                (rationalp y)
-                (rationalp z))
-           (<= (abs (- x y))
-               (+ (abs (- x z))
-                  (abs (- y z)))))
-  :rule-classes ())
-
-(defthm abs->=
-  (implies (and (rationalp x)
-                (rationalp y))
-           (>= (abs (- y x)) (- (abs x) (abs y))))
-  :rule-classes ())
-
-;kill?
-(local 
- (defthm abs+
-   (implies (and (rationalp x)
-                 (rationalp y))
-            (<= (abs (+ x y))
-                (+ (abs x) (abs y))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable abs)))))
-
-(defthm abs-
-  (implies (and (rationalp x)
-                (rationalp y))
-           (<= (abs (- x y))
-               (+ (abs x) (abs y))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable abs))))
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/fl-expt.lisp acl2-6.3/books/rtl/rel5/arithmetic/fl-expt.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/fl-expt.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/fl-expt.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,144 +0,0 @@
-(in-package "ACL2")
-
-;don't need everything in this book!
-(local (include-book "numerator"))
-(local (include-book "denominator"))
-(local (include-book "nniq"))
-(local (include-book "arith2"))
-;(local (include-book "type"))
-(local (include-book "ground-zero"))
-(local (include-book "floor"))
-(local (include-book "integerp"))
-(local (include-book "rationalp"))
-(local (include-book "unary-divide"))
-(local (include-book "expt"))
-(local (include-book "expo"))
-(local (include-book "power2p"))
-(local (include-book "fl"))
-
-(local (in-theory (enable expt-minus)))
-
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-;more general vesions of this below.  kill this one?
-(defthm fl-simp
-  (implies (case-split (rationalp x))
-           (equal (FL (* 1/2 (FL (* X (/ (EXPT 2 N))))))
-                  (FL (* 1/2 X (/ (EXPT 2 N))))))
-  :hints (("Goal" :in-theory (disable fl-def-linear)
-           :use 
-           ((:instance fl-unique 
-                       (x (* 1/2 (FL (* X (/ (EXPT 2 N))))))
-                       (n (FL (* 1/2 X (/ (EXPT 2 N))))))
-            (:instance fl-def-linear (x (* 1/2 X (/ (EXPT 2 N)))))))))
-
-
-
-(encapsulate
- ()
- (local (defthm fl-shift-fl-case-1
-          (implies (<= 0 m)
-                   (equal (FL (* (FL X) (/ (expt 2 m))))
-                          (FL (* X (/ (EXPT 2 m))))))
-          :hints (("Goal" :cases ((rationalp x))))
-          ))
-
- (local (defthm fl-shift-fl-case-2
-          (implies (AND (< m 0)
-                        (case-split (INTEGERP M))
-                        )
-                   (equal (FL (* (FL X) (/ (expt 2 m))))
-                          (* (FL x) (/ (expt 2 m)))))
-          :hints  (("Goal" :in-theory (disable fl-int)
-                    :use (:instance fl-int (x (* (/ (expt 2 m)) (FL X))))))))
-
-
-
-;can this be extended to let the out fl be of a sum?
-;leave the case-1 event enabled too (not integerp hyp)?
- (defthm fl-shift-fl
-   (implies (case-split (INTEGERP M))
-            (equal (FL (* (/ (expt 2 m)) (FL X)))
-                   (if (<= 0 m)
-                       (FL (* (/ (EXPT 2 m)) X))
-                     (* (/ (expt 2 m)) (FL x)))))
-   :hints (("Goal" :cases ((< m 0))))
-   )
- )
-
-
-#|
-(defthm fl-shift-fl-case-1-gen
-  (implies (and (rationalp x)
-                (rationalp y)
-                (integerp m)
-                (<= 0 m)
-                )
-           (equal (fl (* (/ (expt 2 m)) (+ y (* 2 (fl (* 1/2 x))))))
-                  (fl (* (/ (expt 2 m)) (+ y x)))))
-  :otf-flg t
- :hints (("Goal" :in-theory (disable  FL-DEF-LINEAR-PART-1
-                                       FL-DEF-LINEAR-PART-2
-                                       FL-WEAK-MONOTONE
-;                                        LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE
-                                       )
-          :use (
-          (:instance FL-DEF-LINEAR-part-1  
-                     (x (+ (* X (/ (EXPT 2 M)))
-                           (* Y (/ (EXPT 2 M))))))
-          (:instance FL-DEF-LINEAR-part-1  
-                     (x x))
-          (:instance FL-DEF-LINEAR-part-2  
-                     (x (+ (* X (/ (EXPT 2 M)))
-                           (* Y (/ (EXPT 2 M))))))
-          (:instance FL-DEF-LINEAR-part-2  
-                     (x x))
-
-          (:instance fl-unique 
-                     (x (* (/ (expt 2 m)) (+ y (* 2 (FL (* 1/2 X))))))
-                     (n (FL (* (/ (EXPT 2 m)) (+ y X)))))))))
-|#
-
-(defthm fl-shift-fl-2-factors
-  (implies (AND ;(case-split (rationalp x))
-                (case-split (INTEGERP M))
-                (case-split (INTEGERP n))
-                )
-           (equal (FL (* (/ (expt 2 m)) (expt 2 n) (FL X)))
-                  (if (<= 0 (- m n))
-                      (FL (* (/ (EXPT 2 (- m n))) X))
-                    (* (/ (expt 2 (- m n))) (FL x)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '( fl-shift-fl  ;EXPO-COMPARISON-REWRITE-TO-BOUND
-                                              ))
-           :use (:instance fl-shift-fl (m (- m n))))))
-
-(defthm fl-shift-fl-2-factors-2
-  (implies (AND ;(case-split (rationalp x))
-                (case-split (INTEGERP M))
-                (case-split (INTEGERP n))
-                )
-           (equal (FL (* (expt 2 n) (/ (expt 2 m)) (FL X)))
-                  (if (<= 0 (- m n))
-                      (fl (* (/ (EXPT 2 (- m n))) X))
-                    (* (/ (expt 2 (- m n))) (FL x)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '( fl-shift-fl EXPO-COMPARISON-REWRITE-TO-BOUND))
-           :use (:instance fl-shift-fl (m (- m n))))))
-
-
-
-;(FL (* 2 (/ (EXPT 2 K)) (FL (* 1/2 X))))
-
-
-(defthm fl-shift-fl-by-1
-  (EQUAL (FL (* 1/2 (FL X)))
-         (FL (* 1/2 X)))
-  :hints (("Goal" :use (:instance fl-shift-fl (m 1)))))
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/fl-hacks.lisp acl2-6.3/books/rtl/rel5/arithmetic/fl-hacks.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/fl-hacks.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/fl-hacks.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,83 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-#|
-This book contains a few hacks about fl which aren't used elsewhere in support/.
-
-|#
-
-(in-package "ACL2")
-
-(include-book "ground-zero")
-;(include-book "basic") ;drop?
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(local (include-book "inverted-factor"))
-(local (include-book "nniq"))
-(local (include-book "numerator"))
-(local (include-book "denominator"))
-(local (include-book "fp2"))
-(local (include-book "predicate"))
-(local (include-book "product"))
-(local (include-book "unary-divide"))
-(local (include-book "rationalp"))
-(local (include-book "integerp"))
-(local (include-book "fl")) ;drop?
-(local (include-book "mod"))
-(local (include-book "even-odd"))
-(local (include-book "meta/meta-plus-equal" :dir :system))
-
-(local (include-book "arith"))
-
-;used anywhere?
-;exported in lib/basic
-(defthm fl-m-1
-  (implies (and (< 0 n) ;(not (equal n 0))
-                (integerp m)
-                (integerp n)
-                )
-           (= (fl (- (/ (1+ m) n)))
-              (1- (- (fl (/ m n))))))
-  :otf-flg t
-  :rule-classes ()
-  :hints (
-          ("goal" :in-theory (disable fl-def-linear-part-2
-                                      LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)
-           :use ((:instance  fl-of-fraction-min-change
-                             (p (+ 1 m)) (q n))
-                 (:instance fl-unique (x (* M (/ N)))
-                            (n (+ -1 (+ (/ N) (* M (/ N))))))
-                 (:instance fl-unique (x (+ (/ N) (* M (/ N))))
-                            (n (FL (* M (/ N)))))
-
-                 ))))
-
-(defthm fl-m-n
-  (implies (and (< 0 n)
-                (integerp m)
-                (integerp n))
-           (= (fl (- (/ m n)))
-              (1- (- (fl (/ (1- m) n))))))
-  :hints (("Goal" :use ((:instance fl-m-1 (m (1- m))))))
-  :rule-classes ())
-
-;remove?  doesn't seem to be used anywhere or exported in lib/
-;just a special case of the above...
-(defthm fl-lemma
-    (implies (integerp m)
-	     (= (fl (- (/ (1+ m) 2)))
-		(1- (- (fl (/ m 2))))))
-  :rule-classes ()
-  :hints (("goal" :use (:instance fl-m-1 (n 2)))))
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/fl-proofs.lisp acl2-6.3/books/rtl/rel5/arithmetic/fl-proofs.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/fl-proofs.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/fl-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,867 +0,0 @@
-(in-package "ACL2")
-
-;My approach (and I believe this is Russinoff's approach too) for reasoning about floor and related
-;functions is to write everything in terms of fl.  Unlike floor, fl takes only 1 argument.  Furthermore, all
-;calls to floor can be rewritten to calls to fl using floor-fl
-
-;don't need everything in this book!
-(local (include-book "numerator"))
-(local (include-book "denominator"))
-(local (include-book "nniq"))
-(local (include-book "arith2"))
-(local (include-book "ground-zero"))
-(local (include-book "floor"))
-(local (include-book "integerp"))
-(local (include-book "rationalp"))
-(local (include-book "unary-divide"))
-(local (include-book "common-factor"))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-;remove syntaxp hyp?
-;weird rule...
-(defthm integerp-<-non-integerp
-  (implies (and (and (syntaxp (quotep x)))
-                (not (integerp x)) 
-                (integerp n) ;backchain limit?
-                (case-split (rationalp x))
-                )
-           (equal (< n x)
-                  (<= n (fl x))))
-  :hints (("Goal" :in-theory (enable fl)))
-)
-
-;remove syntaxp hyp?
-;weird rule...
-(defthm non-integerp-<-integerp
-  (implies (and (and (syntaxp (quotep x)))
-                (not (integerp x)) 
-                (integerp n) ;backchain limit?
-                (case-split (rationalp x))
-                )
-           (equal (< x n)
-                  (< (fl x) n)))
-  :hints (("Goal" :in-theory (enable fl))))
-
-(defthm a10
-  (and (implies (integerp i) (equal (fl i) i))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))) ;drop?
-                (and (equal (fl (+ i x1)) (+ i (fl x1)))
-                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2)))
-                (and (equal (fl (+ x1 (+ i x2)))
-                            (+ i (fl (+ x1 x2))))
-                     (equal (fl (+ x1 (+ x2 i)))
-                            (+ i (fl (+ x1 x2))))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2))
-                     (case-split (rationalp x3)))
-                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
-                            (+ i (fl (+ x1 x2 x3))))
-                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
-                            (+ i (fl (+ x1 x2 x3))))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2))
-                     (case-split (rationalp x3))
-                     (case-split (rationalp x4)))
-                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
-                            (+ i (fl (+ x1 x2 x3 x4))))
-                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
-                            (+ i (fl (+ x1 x2 x3 x4)))))))
-  :hints (("Goal" :in-theory (enable fl)))
-)
-
-(defthm a12
-  (implies (and (integerp i)
-                (integerp j)
-                (< 1 j)
-                (< j i))
-           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
-                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
-  :hints (("Goal" :in-theory (enable fl)))
-  :rule-classes :linear
-)
-
-;why "fl-def" in the names?  this isn't a definition...
-
-;make a separate rewrite-version
-(defthm fl-def-linear-part-1
-  (implies (case-split (not (complex-rationalp x))) 
-           (<= (fl x) x))
-  :hints (("goal" :in-theory (enable fl floor)))
-  :rule-classes (:rewrite (:linear :trigger-terms ((fl x))))
-  )
-
-(defthm fl-def-linear-part-2
-  (implies (case-split (not (complex-rationalp x)))
-           (< x (1+ (fl x))))
-  :hints (("goal" :in-theory (enable fl floor)))
-  :rule-classes (:rewrite (:linear :trigger-terms ((fl x)))))
-
-;later, drop the hyp completely
-;disabled since we have the rules above
-;drop this whole rule
-(defthmd a13
-  (implies (case-split (rationalp x)) ;this hyp isn't needed for the first conslusion?
-           (and (< (1- x) (fl x))
-                (<= (fl x) x)))
-  :hints (("Goal" :in-theory (enable fl)))
-  :rule-classes :linear)
-
-;disabled since we have the next rules above
-(defthmd fl-def-linear
-  (implies (case-split (rationalp x)) ;gen?
-           (and (<= (fl x) x)
-                (< x (1+ (fl x)))))
-  :rule-classes :linear)
-
-
-
-
-;note that FL is not strongly monotonic.  That is, x<x+ does not always imply (fl x) < (fl x+)
-;change param names to x, x+
-;try match-free :all
-(defthm fl-weakly-monotonic
-  (implies (and (<= y y+)
-                (case-split (rationalp y)) ;drop?
-                (case-split (rationalp y+)) ;drop?
-                )
-           (<= (fl y) (fl y+)))
-  :hints (("Goal" :in-theory (enable fl)))
-  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
-                 (:linear)
-                 (:forward-chaining
-                  :trigger-terms ((fl y) (fl y+))
-                  :corollary (implies (and (< y y+)
-                                           (case-split (rationalp y))
-                                           (case-split (rationalp y+)))
-                                      (<= (fl y) (fl y+))))
-                 (:linear
-                  :corollary (implies (and (< y y+)
-                                           (case-split (rationalp y))
-                                           (case-split (rationalp y+)))
-                                      (<= (fl y) (fl y+))))))
-
-;add a separate "fl of complex is 0" ?
-;because of this, I can put make (rationalp x) into (case-split (rationalp x)) for all arguments x of fl
-; (since we always can simplify the other case, the split is nice)
-(defthm fl-of-non-rational
-  (implies (not (rationalp x))
-           (equal (fl x)
-                  0))
-  :hints (("Goal" :in-theory (enable fl))))
-
-
-(defthmd fl-minus
-  (implies (rationalp x)
-           (equal (fl (* -1 x))
-                  (if (integerp x)
-                      (* -1 x)
-                    (1- (* -1 (fl x)))))))
-
-;bad? free var.
-(defthm fl-monotone-linear
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y))
-           (<= (fl x) (fl y)))
-  :rule-classes :linear)
-
-(defthm n<=fl-linear
-    (implies (and (<= n x)
-		  (rationalp x)
-		  (integerp n))
-	     (<= n (fl x)))
-  :rule-classes :linear)
-
-
-;may need to disable?
-(defthm fl+int-rewrite
-    (implies (and (integerp n)
-		  (rationalp x))
-	     (equal (fl (+ x n)) (+ (fl x) n))))
-
-(local
- (defthm fl/int-1
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (<= 0 n)
-                  )
-	     (<= (fl (/ (fl x) n))
-		 (fl (/ x n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable fl-def-linear-part-1
-                                     fl-def-linear-part-2)
-           :use ((:instance fl-def-linear))))))
-
-
-
-
-(local
- (defthm fl/int-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (fl (/ (fl x) n))
-		 (fl (/ x n))))
-  :rule-classes ()
-  :hints (("Goal"  :in-theory (disable fl-def-linear-part-1
-                                       fl-def-linear-part-2)
-           :use ((:instance fl-def-linear)
-                 (:instance n<=fl-linear (n (* n (fl (/ x n)))))
-                 (:instance n<=fl-linear (n (fl (/ x n))) (x (/ (fl x) n)))
-                 (:instance fl-def-linear (x (/ x n)))
-                 (:instance fl-def-linear (x (/ (fl x) n))))))))
-
-;BOZO will this match?
-(defthm fl/int-rewrite
-  (implies (and (integerp n)
-                (<= 0 n)
-                (rationalp x))
-           (equal (fl (/ (fl x) n))
-                  (fl (/ x n))))
-  :hints (("Goal" :use ((:instance fl/int-1)
-			(:instance fl/int-2)))))
-
-(defthm fl/int-rewrite-alt
-  (implies (and (integerp n)
-                (<= 0 n)
-                (rationalp x))
-           (equal (fl (* (/ n) (fl x)))
-                  (fl (/ x n))))
-  :hints (("Goal" :in-theory (disable fl/int-rewrite)
-           :use ( fl/int-rewrite))))
-
-
-(defthm fl-integer-type
-  (integerp (fl x))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than fl-integer-type and might be worse
-(in-theory (disable (:type-prescription fl)))
-
-(defthm fl-int
-  (implies (integerp x)
-           (equal (fl x) x)))
-
-;bad name?
-(defthm fl-integerp
-  (equal (equal (fl x) x)
-         (integerp x)))
-
-(defthm fl-unique
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (<= n x)
-		  (< x (1+ n)))
-	     (equal (fl x) n))
-  :rule-classes ())
-
-
-
-
-;ACL2 already knows these facts about FL, but we include them anyway
-(defthm fl-rational
-  (rationalp (fl x)))
-
-(defthm fl-integer
-  (integerp (fl x)))
-
-
-
-;add "fl of negative is negative" type rule? (actually 2 posibilities?)
-(defthm fl-non-negative-integer-type-prescription
-  (implies (<= 0 x)
-           (and (<= 0 (fl x))
-                (integerp (fl x))))
-  :rule-classes (:type-prescription))
-
-(defthm fl-less-than-zero
-  (implies (case-split (rationalp x))
-           (equal (< (fl x) 0)
-                  (< x 0)))
-  :hints (("Goal" :in-theory (enable fl)))
-  )
-
-;use rifx?
-;prove a version for fl negative? (also t-p rules for that?)
-(defthm fl-non-negative-linear
-  (implies (<= 0 x)
-           (<= 0 (fl x)))
-  :rule-classes (:linear))
-
-
-
-;rename to start with fl-
-;needed? - any constant, not just integers
-;replace the rule to pull out an integer?
-;BOZO do we want to use rem here???
-(defthm pull-constant-out-of-fl
-  (implies (and (syntaxp (and (quotep c1) (>= (abs (cadr c1)) 1)))
-                (rationalp c1)
-                (rationalp x))
-           (equal (fl (+ c1 x))
-                  (+ (truncate c1 1) (fl (+ (rem c1 1) x)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rem)
-                              '(truncate)))))
-
-
-
-;fl-minus?
-
-(defthm fl-minus-factor
-  (implies (and (syntaxp (quotep k))
-                (< k 0)
-                (rationalp k)
-                (rationalp x))
-           (equal (fl (* k x))
-                  (if (integerp (* k x))
-                      (* -1 (fl (* (- k) x)))
-                      (+ -1 (- (fl (* (- k) x))))))))
-
-
-
-
-
-
-
-(defthm fl-<-integer
-  (implies (and (integerp y)
-                (case-split (rationalp x)))
-           (equal (< (fl x) y)
-                  (< x y))))
-
-(defthm fl->-integer
-  (implies (and (integerp y)
-                (case-split (rationalp x)))
-           (equal (< y (fl x))
-                  (<= (+ 1 y) x))))
-             
-
-;should this be disabled?
-(defthm fl-equal-0
-  (implies (case-split (rationalp x))
-           (equal (equal (fl x) 0)
-                  (and (<= 0 x)
-                       (< x 1)))))
-
-;kill this? or is this nice b/c it makes no change if its hyps fail to be satisfied?
-(defthmd fl-equal-0-alt
-  (implies (and (< x 1)
-                (<= 0 x)
-                (case-split (rationalp x))
-                )
-           (equal (fl x) 0)))
-
-;bad names?                  
-;fl-def-linear isn't rewrite!
-;remove this??
-(defthm fl-strong-monotone
-  (implies (and (< x y)
-                (rationalp x)
-                (rationalp y)
-                )
-           (< (fl x) y)))
-
-
-;remove this??
-;make linear?
-(defthm fl-weak-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                )
-           (<= (fl x) y)))
-
-
-
-
-;kill one of these?
-(defthm fl-def-linear-quotient
-  (implies (and (< 0 y)
-                (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (and (not (< X (* Y (FL (* X (/ Y))))))
-                (not (< X (* Y (FL (* (/ Y) X)))))))
-  :hints (("Goal" :in-theory (disable fl-strong-monotone
-                                      FL-WEAK-MONOTONE FL-DEF-LINEAR-part-1)
-           :use (:instance FL-DEF-LINEAR-part-1 (x (/ x y))))))
-
-;Our scheme for dealing with FLOOR is to always rewrite calls of it to FL
-(defthm floor-fl
-  (equal (floor m n) 
-         (fl (/ m n)))
-  :hints (("goal" :in-theory (e/d (fl) ( RATIONALP-PRODUCT))
-           :cases ((rationalp m) ;drop this hint?
-                   ))))
-
-(theory-invariant (incompatible (:rewrite floor-fl)
-                                (:definition fl))
-                  :key floor-fl--and--fl--conflict)
-
-
-;perhaps always split on even/odd for fl(x/2)
-;needed? was in proof.lisp for x87 recip proof
-(defthm fl-of-odd/2
-  (implies (and (integerp x)
-                (not (integerp (* 1/2 x)))
-                )
-           (equal (fl (* 1/2 x))
-                  (- (* 1/2 x) 1/2))))
-
-(defthm fl-of-even/2
-  (implies (and (INTEGERP (* X (/ 2))))
-           (equal (fl (* 1/2 x))
-                  (* 1/2 x)))
-)
-
-;new version
-(defthm fl-force-to-0
-  (implies (case-split (rationalp x))
-           (equal (equal 0 (fl x))
-                  (and (<= 0 x)
-                       (< x 1)))))
-
-
-(in-theory (disable fl-force-to-0)) ;may be expensive
-
-;generalize to any amount of shifting each time and to any base (2,3, etc.)?
-
-;is there a linear rule missing?  why did we need to :use fl-def-linear?
-;(both expressions shift x right n+1 spots and chop)
-
-
-
-
-
-#|
-;represents the fractional part of a number
-(defun md (x)
-  (- x (fl x)))
-
-(defthm fl-plus-md
-  (implies (acl2-numberp x)
-           (equal (+ (fl x) (md x))
-                  x)))
-
-(defthm md-nonnegative
-  (implies (rationalp x)
-           (<= 0 (md x))))
-
-(defthm md-less-than-1
-  (implies (rationalp x)
-           (<= 0 (md x))))
-
-(defthm md-type-rationalp
-  (implies (rationalp x)
-           (rationalp (md x))))
-
-
-(in-theory (disable fl-plus-md))
-
-(in-theory (disable md))
-
-|#
-
-
-
-;attempted addition 1/7/02:
-
-;make linear?
-(defthm fl-factor-out-integer-bound
-  (implies (and (integerp n)
-                (> n 0)
-                (rationalp x)
-                )
-           (<= (* n (fl x))
-               (fl (* n x)))))
-
-;make linear?
-(defthm fl-factor-out-integer-bound-2
-  (implies (and (integerp n)
-                (> n 0)
-                (rationalp m)
-                )
-           (<= (* n (fl (* m (/ n))))
-               (fl m))))
-
-
-
-
-
-;see sse-div.lisp for better versions of the above
-
-
-#| for reference:
-(DEFTHM FL-DEF-LINEAR
-  (IMPLIES (RATIONALP X)
-           (AND (<= (FL X) X) (< X (1+ (FL X)))))
-  :RULE-CLASSES :LINEAR)
-|#
-
-;these thms are about getting rid of one of two (roughly) "nested" calls to fl
-
-;why??
-(defthm fl-plus-integer-eric
-  (implies (and (integerp n)
-                (case-split (rationalp x)) ;not true if x is a complex-rationalp
-                )
-           (equal (fl (+ x n))
-                  (+ n (fl x)))))
-
-(local (in-theory (disable floor-fl)))
-
-;move
-;strictly better than the version in the arithmetic books
-(DEFTHM QUOTIENT-NUMER-DENOM-eric
-  (IMPLIES (AND (INTEGERP X)
-                (<= 0 X) ; was (< 0 x)
-                (INTEGERP Y)
-                (<= 0 Y)) ;was (< 0 y)
-           (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (NUMERATOR (/ X Y))
-                                                (DENOMINATOR (/ X Y)))
-                  (NONNEGATIVE-INTEGER-QUOTIENT X Y)))
-  :hints (("Goal" :cases ((and (= x 0) (=  y 0))
-                          (and (not (= x 0)) (= y 0))
-                          (and (= x 0) (not (= y 0)))))))
-
-;(in-theory (disable QUOTIENT-NUMER-DENOM))
-
-
-
-
-
-
-
-; rewrites things like (EQUAL (* 32768 (FL (* 1/32768 x))) x)
-(defthm fl-claim-rewrite-to-integerp-claim-gen
-  (implies (and (equal k-inverse (/ k))
-                (case-split (acl2-numberp k))
-                (case-split (not (equal k 0)))
-                (case-split (acl2-numberp x))
-                )
-           (and (equal (EQUAL (* k (FL (* k-inverse X))) X)
-                       (integerp (* k-inverse x)))
-                (equal (EQUAL (* k (FL (* X k-inverse))) X)
-                       (integerp (* k-inverse x)))))
-  :hints (("Goal" :in-theory (disable FL-INTEGERP
-                                      )
-           :use (:instance fl-integerp (x (* k-inverse X)))
-           )
-          ))
-(in-theory (disable fl-claim-rewrite-to-integerp-claim-gen))
-
-(defthm fl-claim-rewrite-to-integerp-claim-gen-2
-  (implies (and (equal k-inverse (/ k))
-                (case-split (acl2-numberp k))
-                (case-split (not (equal k 0)))
-                (case-split (acl2-numberp x))
-                (case-split (acl2-numberp y))
-                )
-           (and (equal (EQUAL (* k (FL (* k-inverse X y))) (* X y))
-                       (integerp (* k-inverse x y)))
-                (equal (EQUAL (* k (FL (* X k-inverse y))) (* X y))
-                       (integerp (* k-inverse x y)))
-                (equal (EQUAL (* k (FL (* X y k-inverse))) (* X y))
-                       (integerp (* k-inverse x y)))))
-  :hints (("Goal" :in-theory (disable FL-INTEGERP
-                                      )
-           :use (:instance  fl-claim-rewrite-to-integerp-claim-gen
-                            (x (* x y))))))
-
-
-
-
-(defthm fl-claim-rewrite-to-integerp-claim
-  (implies (and (syntaxp (and (quotep k-inverse)
-                              (quotep k)))
-                (equal k-inverse (/ k))
-                (case-split (acl2-numberp k))
-                (case-split (not (equal k 0)))
-                (case-split (acl2-numberp x))
-                )
-           (and (equal (EQUAL (* k (FL (* k-inverse X))) X)
-                       (integerp (* k-inverse x)))
-                (equal (EQUAL (* k (FL (* X k-inverse))) X)
-                       (integerp (* k-inverse x)))))
-  :hints (("Goal" :in-theory (disable FL-INTEGERP
-;                           (:type-prescription fl)
-                                      )
-           :use (:instance fl-integerp (x (* k-inverse X)))
-           )
-          ))
-
-#|
-(defthm fl-chops-off-1/2
-  (implies (and (not (integerp x))
-                (integerp (* 2 x))
-                (case-split (rationalp x))
-                )
-           (equal (fl x)
-                  (- x 1/2)))
-  :hints (("Goal" :use (:instance fl-unique (n                  (- x 1/2)))))
-)
-(in-theory (disable  fl-chops-off-1/2))
-
-(defthm fl-chops-off-1/2-2
-  (implies (and (syntaxp (not (and (quotep x)
-                                   (equal (cadr x) 1/2))))
-                (not (integerp x))
-                (integerp (* 2 x))
-                (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (and (equal (fl (+ y x))
-                       (+ (fl x) (fl (+ 1/2 y))))
-                (equal (fl (+ x y))
-                       (+ (fl x) (fl (+ 1/2 y))))))
-  :otf-flg t
-    :hints (("Goal" :in-theory (enable  fl-chops-off-1/2)
-             :use (:instance fl-unique
-                             (x (+ x y))
-                                    (n (+ (fl x) (fl (+ 1/2 y)))))))
-    )
-(in-theory (disable fl-chops-off-1/2-2))
-|#
-
-;rename?
-(defthm y-is-odd
-  (equal (EQUAL Y (+ 1 (* 2 (FL (* 1/2 Y)))))
-         (and (integerp y)
-              (not (integerp (* 1/2 y))))))
-
-(include-book "negative-syntaxp")
-
-(defthm fl-minus-gen
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x))
-                )
-          (EQUAL (FL x)
-                 (IF (INTEGERP X)
-                     (* -1 (FL (* -1 X)))
-                     (+ -1 (- (FL (* -1 X))))))))
-;this can loop with fl-minus-gen (when the result of applying fl-minus-gen doesn't get simplfied before we
-;build the linear pot list)
-(in-theory (disable fl-minus-factor))
-
-
-(defthmd fl-of-fraction-max-change-case-1
-  (implies (and (not (integerp (/ p q))) ;this case
-                (integerp p)
-                (integerp q)
-                (< 0 q)
-                )
-           (>= (+ 1 (fl (/ p q)))
-               (+ (/ p q) (/ q))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable fl floor)
-                              '(floor-fl 
-                                ;quotient-numer-denom
-                                ;nniq-lower-bound-non-integer-case
-                                ))
-           :use ((:instance  <=-transitive 
-                             (a (+ (/ Q) (* P (/ Q))))
-                             (b (+ (* P (/ Q))
-                                   (/ (DENOMINATOR (* P (/ Q))))))
-                             (c (+ 1
-                                   (NONNEGATIVE-INTEGER-QUOTIENT (NUMERATOR (* P (/ Q)))
-                                                                 (DENOMINATOR (* P (/ Q)))))))
-                 (:instance nniq-eric-8 (p (- p)))
-                 (:instance quotient-numer-denom (x (- p)) (y q))
-                 (:instance nniq-lower-bound-non-integer-case  (x (/ p q)))))))
-
-(defthmd fl-of-fraction-max-change-case-2
-  (implies (and (integerp (/ p q)) ;this case
-                (integerp p)
-                (integerp q)
-                (< 0 q)
-                )
-           (>= (+ 1 (fl (/ p q)))
-               (+ (/ p q) (/ q))))
-  :otf-flg t
-  :hints (("Goal" :use (:instance (:instance mult-both-sides-of-<-by-positive (a 1) (b (/ q)) (c q))))))
-
-;fl(p/q) + 1 >= p/q + 1/q
-;similar to  fl-of-fraction-upper-bound
-;rephrase the conclusion
-; if fl changes it argument, it does so by at most 1-1/q
-(defthm fl-of-fraction-max-change
-  (implies (and (< 0 q)
-                (integerp p)
-                (integerp q)
-                )
-           (>= (+ 1 (fl (/ p q)))
-               (+ (/ p q) (/ q))))
-  :otf-flg t
-  :hints (("Goal" :use ( fl-of-fraction-max-change-case-2  fl-of-fraction-max-change-case-1))))
-
-; Two integers, both in the interval (x,y], whose width is at most 1, must be equal.
-;make other versions?
-;move?
-(defthm int-unique
-  (implies (and (integerp i)
-                (integerp j)
-                (rationalp x)
-                (rationalp y)
-                (<= x y)
-                (< x i) (<= i y)
-                (< x j) (<= j y)
-                (<= (- y x) 1)
-                )
-           (equal i j))
-  :rule-classes nil
-  )
-
-;replace fl-unique?
-(defthm fl-unique-2
-  (implies (rationalp x)
-           (equal (and (integerp n)
-                       (<= n x)
-                       (< x (1+ n)))
-                  (equal (fl x) n)))
-  :rule-classes nil)  
-
-(encapsulate
- ()
- (local (defthm FL-M+1-1
-          (implies (and (integerp m)
-                        (integerp n)
-                        (>= m 0)
-                        (> n 0)
-                        (INTEGERP (+ (/ N) (* M (/ N)))))
-                   (= (fl (- (/ (1+ m) n)))
-                      (1- (- (fl (/ m n))))))
-          :hints (("Goal" :use (:instance fl-unique (x (* M (/ N)))
-                                          (n (/ (+ 1 (- n) m) n)))))
-          :rule-classes ()
-          ))         
-
-
- (local (defthm FL-M+1-2
-          (implies (and (integerp m)
-                        (integerp n)
-                        (>= m 0)
-                        (> n 0)
-                        (not (INTEGERP (+ (/ N) (* M (/ N))))))
-                   (= (fl (- (/ (1+ m) n)))
-                      (1- (- (fl (/ m n))))))
-          :otf-flg t
-          :rule-classes ()
-          :hints (("Goal" :in-theory (disable FL-INTEGER-TYPE ;yuck!  had to disable these!!
-                                              FL-NON-NEGATIVE-INTEGER-TYPE-PRESCRIPTION
-                                              ;; The following needed disabling
-                                              ;; for v2-8-alpha-12-30-03; I
-                                              ;; (mattk) don't know why.
-                                              FL-DEF-LINEAR-PART-2)
-                   :use( (:instance fl-def-linear (x (+ (/ N) (* M (/ N)))))
-                         (:instance fl-of-fraction-max-change (p m) (q n))
-                         (:instance fl-unique-2 (x (* M (/ N)))
-                                    (n (+ -1 (/ N) (* M (/ N)))))
-                         (:instance int-unique
-                                    (i (FL (+ (/ N) (* M (/ N)))))
-                                    (j (FL (* M (/ N))))
-                                    (x (+ (/ m n) (/ n) -1))
-                                    (y (+ (/ m n) (/ n))))))
-                  )))
-
-
- (defthm fl-m+1
-   (implies (and (integerp m)
-                 (integerp n)
-                 (>= m 0)
-                 (> n 0))
-            (= (fl (- (/ (1+ m) n)))
-               (1- (- (fl (/ m n))))))
-   :hints (("Goal" :use(fl-m+1-1 fl-m+1-2)))
-   :rule-classes ()))
-
-
-
-
-
-;this was the point of nniq-eric-5 to nniq-8 in basic.  how does this get proved without nniq-eric-8?
-;if fl changes its argument of p/q, it does so by at least a qth
-;rephrase concl?
-;make a linear rule?
-(defthmd fl-of-fraction-min-change
-  (implies (and (not (integerp (/ p q)))
-;                (<= 0 q)
-                (integerp p)
-                (integerp q)
-                )
-           (<= (/ q)
-               (- (/ p q) (fl (/ p q)))))  ;the amt of change made by fl
-  :otf-flg t
-  :hints (("Goal" 
-           :do-not-induct t
-           :in-theory (set-difference-theories
-                              (enable fl floor)
-                              '(nniq-eric-8
-                                fl-of-fraction-max-change
-                                )) 
-          :use (;(:instance nniq-eric-8 (p (- p)) )
-                (:instance fl-of-fraction-max-change (p (- p)))
-                (:instance fl-of-fraction-max-change (q (- q)))
-;                 nniq-eric-8
-                ))))
-
-;bad name? improve this?
-;BOZO call quot-bnd-2? or fl-bnd-2?
-(defthm fl-bound
-  (implies (and (< 0 y)
-                (rationalp x)
-                (rationalp y)
-                )
-           (<= (* y (FL (* x (/ y)))) x))
-  :hints (("Goal" :use  (:instance floor-upper-bound (i x) (j y) )
-           :in-theory (e/d (fl) (floor-upper-bound)))))
-
-;see fl-bound
-;BOZO rename params
-(defthm quot-bnd
-  (implies (and (<= 0 x)
-                (<= 0 y)
-                (rationalp x)
-                (rationalp y))
-           (<= (* y (fl (/ x y)))
-               x))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (disable  FL-WEAK-MONOTONE FL-DEF-LINEAR-PART-1) ;how similar are the 2 rules I
-    ;had to disable?
-           :use (:instance FL-DEF-LINEAR-PART-1 (x (/ x y))))))
-
-;move!
-;i just added this; is it expensive?
-;this was causing problems, so I disabled it.
-(defthmd x-times-something>=1
-  (implies (and (case-split (<= 1 y))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                (case-split (<= 0 x)))
-           (<= x (* x y)))
-  :rule-classes :linear
-  )
-
-(defthm fl-<=-y
-  (implies (and (<= x y)
-                (case-split (not (complex-rationalp x))))
-           (<= (fl x) y)))
-
-;make a version where n is a constant?
-(defthmd fl-equal-rewrite
-  (implies (and (rationalp x)
-                (integerp n)) ;move to conclusion?
-           (equal (equal (fl x) n)
-                  (and (<= n x)
-                       (< x (+ 1 n))))))
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/fl.lisp acl2-6.3/books/rtl/rel5/arithmetic/fl.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/fl.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/fl.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,587 +0,0 @@
-(in-package "ACL2")
-
-;My approach (and I believe this is Russinoff's approach too) for reasoning about floor and related
-;functions is to write everything in terms of fl.  Unlike floor, fl takes only 1 argument.  Furthermore, all
-;calls to floor can be rewritten to calls to fl using floor-fl
-
-(include-book "negative-syntaxp")
-(local (include-book "fl-proofs"))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-;remove syntaxp hyp?
-;weird rule...
-(defthm integerp-<-non-integerp
-  (implies (and (and (syntaxp (quotep x)))
-                (not (integerp x)) 
-                (integerp n) ;backchain limit?
-                (case-split (rationalp x))
-                )
-           (equal (< n x)
-                  (<= n (fl x)))))
-
-;remove syntaxp hyp?
-;weird rule...
-(defthm non-integerp-<-integerp
-  (implies (and (and (syntaxp (quotep x)))
-                (not (integerp x)) 
-                (integerp n) ;backchain limit?
-                (case-split (rationalp x))
-                )
-           (equal (< x n)
-                  (< (fl x) n))))
-
-(defthm a10
-  (and (implies (integerp i) (equal (fl i) i))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))) ;drop?
-                (and (equal (fl (+ i x1)) (+ i (fl x1)))
-                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2)))
-                (and (equal (fl (+ x1 (+ i x2)))
-                            (+ i (fl (+ x1 x2))))
-                     (equal (fl (+ x1 (+ x2 i)))
-                            (+ i (fl (+ x1 x2))))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2))
-                     (case-split (rationalp x3)))
-                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
-                            (+ i (fl (+ x1 x2 x3))))
-                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
-                            (+ i (fl (+ x1 x2 x3))))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2))
-                     (case-split (rationalp x3))
-                     (case-split (rationalp x4)))
-                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
-                            (+ i (fl (+ x1 x2 x3 x4))))
-                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
-                            (+ i (fl (+ x1 x2 x3 x4))))))))
-
-(defthm a12
-  (implies (and (integerp i)
-                (integerp j)
-                (< 1 j)
-                (< j i))
-           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
-                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
-  :rule-classes :linear)
-
-;why "fl-def" in the names?  this isn't a definition...
-
-;make a separate rewrite-version
-(defthm fl-def-linear-part-1
-  (implies (case-split (not (complex-rationalp x))) 
-           (<= (fl x) x))
-  :rule-classes (:rewrite (:linear :trigger-terms ((fl x)))))
-
-(defthm fl-def-linear-part-2
-  (implies (case-split (not (complex-rationalp x)))
-           (< x (1+ (fl x))))
-  :rule-classes (:rewrite (:linear :trigger-terms ((fl x)))))
-
-;later, drop the hyp completely
-;disabled since we have the rules above
-;drop this whole rule
-(defthmd a13
-  (implies (case-split (rationalp x)) ;this hyp isn't needed for the first conslusion?
-           (and (< (1- x) (fl x))
-                (<= (fl x) x)))
-  :rule-classes :linear)
-
-;disabled since we have the next rules above
-(defthmd fl-def-linear
-  (implies (case-split (rationalp x)) ;gen?
-           (and (<= (fl x) x)
-                (< x (1+ (fl x)))))
-  :rule-classes :linear)
-
-;note that FL is not strongly monotonic.  That is, x<x+ does not always imply (fl x) < (fl x+)
-;change param names to x, x+
-;try match-free :all
-(defthm fl-weakly-monotonic
-  (implies (and (<= y y+)
-                (case-split (rationalp y)) ;drop?
-                (case-split (rationalp y+)) ;drop?
-                )
-           (<= (fl y) (fl y+)))
-  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
-                 (:linear)
-                 (:forward-chaining
-                  :trigger-terms ((fl y) (fl y+))
-                  :corollary (implies (and (< y y+)
-                                           (case-split (rationalp y))
-                                           (case-split (rationalp y+)))
-                                      (<= (fl y) (fl y+))))
-                 (:linear
-                  :corollary (implies (and (< y y+)
-                                           (case-split (rationalp y))
-                                           (case-split (rationalp y+)))
-                                      (<= (fl y) (fl y+))))))
-
-;add a separate "fl of complex is 0" ?
-;because of this, I can put make (rationalp x) into (case-split (rationalp x)) for all arguments x of fl
-; (since we always can simplify the other case, the split is nice)
-(defthm fl-of-non-rational
-  (implies (not (rationalp x))
-           (equal (fl x)
-                  0)))
-
-(defthmd fl-minus
-  (implies (rationalp x)
-           (equal (fl (* -1 x))
-                  (if (integerp x)
-                      (* -1 x)
-                    (1- (* -1 (fl x)))))))
-
-;bad? free var.
-(defthm fl-monotone-linear
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y))
-           (<= (fl x) (fl y)))
-  :rule-classes :linear)
-
-(defthm n<=fl-linear
-    (implies (and (<= n x)
-		  (rationalp x)
-		  (integerp n))
-	     (<= n (fl x)))
-  :rule-classes :linear)
-
-
-;may need to disable?
-(defthm fl+int-rewrite
-    (implies (and (integerp n)
-		  (rationalp x))
-	     (equal (fl (+ x n)) (+ (fl x) n))))
-
-(defthm fl/int-rewrite
-  (implies (and (integerp n)
-                (<= 0 n)
-                (rationalp x))
-           (equal (fl (* (fl x) (/ n)))
-                  (fl (/ x n)))))
-
-(defthm fl/int-rewrite-alt
-  (implies (and (integerp n)
-                (<= 0 n)
-                (rationalp x))
-           (equal (fl (* (/ n) (fl x)))
-                  (fl (/ x n)))))
-
-(defthm fl-integer-type
-  (integerp (fl x))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than fl-integer-type and might be worse
-(in-theory (disable (:type-prescription fl)))
-
-(defthm fl-int
-  (implies (integerp x)
-           (equal (fl x) x)))
-
-;bad name?
-(defthm fl-integerp
-  (equal (equal (fl x) x)
-         (integerp x)))
-
-(defthm fl-unique
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (<= n x)
-		  (< x (1+ n)))
-	     (equal (fl x) n))
-  :rule-classes ())
-
-;ACL2 already knows these facts about FL, but we include them anyway
-(defthm fl-rational
-  (rationalp (fl x)))
-
-(defthm fl-integer
-  (integerp (fl x)))
-
-;add "fl of negative is negative" type rule? (actually 2 posibilities?)
-(defthm fl-non-negative-integer-type-prescription
-  (implies (<= 0 x)
-           (and (<= 0 (fl x))
-                (integerp (fl x))))
-  :rule-classes (:type-prescription))
-
-(defthm fl-less-than-zero
-  (implies (case-split (rationalp x))
-           (equal (< (fl x) 0)
-                  (< x 0))))
-
-;use rifx?
-;prove a version for fl negative? (also t-p rules for that?)
-(defthm fl-non-negative-linear
-  (implies (<= 0 x)
-           (<= 0 (fl x)))
-  :rule-classes (:linear))
-
-
-
-;rename to start with fl-
-;needed? - any constant, not just integers
-;replace the rule to pull out an integer?
-;BOZO do we want to use rem here???
-(defthm pull-constant-out-of-fl
-  (implies (and (syntaxp (and (quotep c1) (>= (abs (cadr c1)) 1)))
-                (rationalp c1)
-                (rationalp x))
-           (equal (fl (+ c1 x))
-                  (+ (truncate c1 1) (fl (+ (rem c1 1) x))))))
-
-;fl-minus?
-
-;this can loop with fl-minus-gen (when the result of applying fl-minus-gen doesn't get simplfied before we
-;build the linear pot list)??
-;maybe fl-minus-gen is enough?
-;why disabled?
-(defthmd fl-minus-factor
-  (implies (and (syntaxp (quotep k))
-                (< k 0)
-                (rationalp k)
-                (rationalp x))
-           (equal (fl (* k x))
-                  (if (integerp (* k x))
-                      (* -1 (fl (* (- k) x)))
-                      (+ -1 (- (fl (* (- k) x))))))))
-
-(defthm fl-<-integer
-  (implies (and (integerp y)
-                (case-split (rationalp x)))
-           (equal (< (fl x) y)
-                  (< x y))))
-
-(defthm fl->-integer
-  (implies (and (integerp y)
-                (case-split (rationalp x)))
-           (equal (< y (fl x))
-                  (<= (+ 1 y) x))))
-             
-
-;should this be disabled?
-(defthm fl-equal-0
-  (implies (case-split (rationalp x))
-           (equal (equal (fl x) 0)
-                  (and (<= 0 x)
-                       (< x 1)))))
-
-;kill this? or is this nice b/c it makes no change if its hyps fail to be satisfied?
-(defthmd fl-equal-0-alt
-  (implies (and (< x 1)
-                (<= 0 x)
-                (case-split (rationalp x))
-                )
-           (equal (fl x) 0)))
-
-;bad names?                  
-;fl-def-linear isn't rewrite!
-;remove this??
-(defthm fl-strong-monotone
-  (implies (and (< x y)
-                (rationalp x)
-                (rationalp y)
-                )
-           (< (fl x) y)))
-
-;remove this??
-;make linear?
-(defthm fl-weak-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                )
-           (<= (fl x) y)))
-
-;kill one of these?
-(defthm fl-def-linear-quotient
-  (implies (and (< 0 y)
-                (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (and (not (< X (* Y (FL (* X (/ Y))))))
-                (not (< X (* Y (FL (* (/ Y) X))))))))
-
-;Our scheme for dealing with FLOOR is to always rewrite calls of it to FL
-(defthm floor-fl
-  (equal (floor m n) 
-         (fl (/ m n))))
-
-(theory-invariant (incompatible (:rewrite floor-fl)
-                                (:definition fl))
-                  :key floor-fl--and--fl--conflict)
-
-;perhaps always split on even/odd for fl(x/2)
-;needed? was in proof.lisp for x87 recip proof
-(defthm fl-of-odd/2
-  (implies (and (integerp x)
-                (not (integerp (* 1/2 x)))
-                )
-           (equal (fl (* 1/2 x))
-                  (- (* 1/2 x) 1/2))))
-
-(defthm fl-of-even/2
-  (implies (and (INTEGERP (* X (/ 2))))
-           (equal (fl (* 1/2 x))
-                  (* 1/2 x))))
-
-;new version
-;may be expensive
-(defthmd fl-force-to-0
-  (implies (case-split (rationalp x))
-           (equal (equal 0 (fl x))
-                  (and (<= 0 x)
-                       (< x 1)))))
-
-;generalize to any amount of shifting each time and to any base (2,3, etc.)?
-
-;is there a linear rule missing?  why did we need to :use fl-def-linear?
-;(both expressions shift x right n+1 spots and chop)
-
-
-;attempted addition 1/7/02:
-
-;make linear?
-;bad name?
-(defthm fl-factor-out-integer-bound
-  (implies (and (integerp n)
-                (> n 0)
-                (rationalp x)
-                )
-           (<= (* n (fl x))
-               (fl (* n x)))))
-
-;make linear?
-;bad name?
-(defthm fl-factor-out-integer-bound-2
-  (implies (and (integerp n)
-                (> n 0)
-                (rationalp m)
-                )
-           (<= (* n (fl (* m (/ n))))
-               (fl m))))
-
-;see sse-div.lisp for better versions of the above
-
-#| for reference:
-(DEFTHM FL-DEF-LINEAR
-  (IMPLIES (RATIONALP X)
-           (AND (<= (FL X) X) (< X (1+ (FL X)))))
-  :RULE-CLASSES :LINEAR)
-|#
-
-;these thms are about getting rid of one of two (roughly) "nested" calls to fl
-
-;why??
-(defthm fl-plus-integer-eric
-  (implies (and (integerp n)
-                (case-split (rationalp x)) ;not true if x is a complex-rationalp
-                )
-           (equal (fl (+ x n))
-                  (+ n (fl x)))))
-
-(local (in-theory (disable floor-fl)))
-
-;BOZO move!
-;strictly better than the version in the arithmetic books
-(defthm quotient-numer-denom-eric
-  (implies (and (integerp x)
-                (<= 0 x) ; was (< 0 x)
-                (integerp y)
-                (<= 0 y)) ;was (< 0 y)
-           (equal (nonnegative-integer-quotient (numerator (/ x y))
-                                                (denominator (/ x y)))
-                  (nonnegative-integer-quotient x y))))
-
-;(in-theory (disable QUOTIENT-NUMER-DENOM))
-
-; rewrites things like (EQUAL (* 32768 (FL (* 1/32768 x))) x)
-(defthmd fl-claim-rewrite-to-integerp-claim-gen
-  (implies (and (equal k-inverse (/ k))
-                (case-split (acl2-numberp k))
-                (case-split (not (equal k 0)))
-                (case-split (acl2-numberp x))
-                )
-           (and (equal (EQUAL (* k (FL (* k-inverse X))) X)
-                       (integerp (* k-inverse x)))
-                (equal (EQUAL (* k (FL (* X k-inverse))) X)
-                       (integerp (* k-inverse x))))))
-
-(defthm fl-claim-rewrite-to-integerp-claim-gen-2
-  (implies (and (equal k-inverse (/ k))
-                (case-split (acl2-numberp k))
-                (case-split (not (equal k 0)))
-                (case-split (acl2-numberp x))
-                (case-split (acl2-numberp y))
-                )
-           (and (equal (EQUAL (* k (FL (* k-inverse X y))) (* X y))
-                       (integerp (* k-inverse x y)))
-                (equal (EQUAL (* k (FL (* X k-inverse y))) (* X y))
-                       (integerp (* k-inverse x y)))
-                (equal (EQUAL (* k (FL (* X y k-inverse))) (* X y))
-                       (integerp (* k-inverse x y))))))
-
-(defthm fl-claim-rewrite-to-integerp-claim
-  (implies (and (syntaxp (and (quotep k-inverse)
-                              (quotep k)))
-                (equal k-inverse (/ k))
-                (case-split (acl2-numberp k))
-                (case-split (not (equal k 0)))
-                (case-split (acl2-numberp x))
-                )
-           (and (equal (EQUAL (* k (FL (* k-inverse X))) X)
-                       (integerp (* k-inverse x)))
-                (equal (EQUAL (* k (FL (* X k-inverse))) X)
-                       (integerp (* k-inverse x))))))
-
-;move! rename?
-(defthm y-is-odd
-  (equal (EQUAL Y (+ 1 (* 2 (FL (* 1/2 Y)))))
-         (and (integerp y)
-              (not (integerp (* 1/2 y))))))
-
-(defthm fl-minus-gen
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x))
-                )
-          (EQUAL (FL x)
-                 (IF (INTEGERP X)
-                     (* -1 (FL (* -1 X)))
-                     (+ -1 (- (FL (* -1 X))))))))
-
-(defthmd fl-of-fraction-max-change-case-1
-  (implies (and (not (integerp (/ p q))) ;this case
-                (integerp p)
-                (integerp q)
-                (< 0 q)
-                )
-           (>= (+ 1 (fl (/ p q)))
-               (+ (/ p q) (/ q)))))
-
-(defthmd fl-of-fraction-max-change-case-2
-  (implies (and (integerp (/ p q)) ;this case
-                (integerp p)
-                (integerp q)
-                (< 0 q)
-                )
-           (>= (+ 1 (fl (/ p q)))
-               (+ (/ p q) (/ q)))))
-
-;fl(p/q) + 1 >= p/q + 1/q
-;similar to  fl-of-fraction-upper-bound
-;rephrase the conclusion
-; if fl changes it argument, it does so by at most 1-1/q
-(defthm fl-of-fraction-max-change
-  (implies (and (< 0 q)
-                (integerp p)
-                (integerp q)
-                )
-           (>= (+ 1 (fl (/ p q)))
-               (+ (/ p q) (/ q)))))
-
-; Two integers, both in the interval (x,y], whose width is at most 1, must be equal.
-;make other versions?
-;move?
-(defthm int-unique
-  (implies (and (integerp i)
-                (integerp j)
-                (rationalp x)
-                (rationalp y)
-                (<= x y)
-                (< x i) (<= i y)
-                (< x j) (<= j y)
-                (<= (- y x) 1)
-                )
-           (equal i j))
-  :rule-classes nil
-  )
-
-;replace fl-unique?
-(defthm fl-unique-2
-  (implies (rationalp x)
-           (equal (and (integerp n)
-                       (<= n x)
-                       (< x (1+ n)))
-                  (equal (fl x) n)))
-  :rule-classes nil)  
-
-(defthm fl-m+1
-  (implies (and (integerp m)
-                (integerp n)
-                (>= m 0)
-                (> n 0))
-           (= (fl (- (/ (1+ m) n)))
-              (1- (- (fl (/ m n))))))
-  :rule-classes ())
-
-
-
-
-
-;this was the point of nniq-eric-5 to nniq-8 in basic.  how does this get proved without nniq-eric-8?
-;if fl changes its argument of p/q, it does so by at least a qth
-;rephrase concl?
-;make a linear rule?
-(defthmd fl-of-fraction-min-change
-  (implies (and (not (integerp (/ p q)))
-                (integerp p)
-                (integerp q)
-                )
-           (<= (/ q)
-               (- (/ p q) (fl (/ p q)))))  ;the amt of change made by fl
-  )
-
-;bad name? improve this?
-;BOZO call quot-bnd-2? or fl-bnd-2?
-(defthm fl-bound
-  (implies (and (< 0 y)
-                (rationalp x)
-                (rationalp y)
-                )
-           (<= (* y (FL (* x (/ y)))) x)))
-
-;see fl-bound
-;BOZO rename?, params
-(defthm quot-bnd
-  (implies (and (<= 0 x)
-                (<= 0 y)
-                (rationalp x)
-                (rationalp y))
-           (<= (* y (fl (/ x y)))
-               x))
-  :rule-classes :linear)
-
-;move!
-;i just added this; is it expensive?
-;this was causing problems, so I disabled it.
-(defthmd x-times-something>=1
-  (implies (and (case-split (<= 1 y))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                (case-split (<= 0 x)))
-           (<= x (* x y)))
-  :rule-classes :linear
-  )
-
-(defthm fl-<=-y
-  (implies (and (<= x y)
-                (case-split (not (complex-rationalp x))))
-           (<= (fl x) y)))
-
-;make a version where n is a constant?
-(defthmd fl-equal-rewrite
-  (implies (and (rationalp x)
-                (integerp n)) ;move to conclusion?
-           (equal (equal (fl x) n)
-                  (and (<= n x)
-                       (< x (+ 1 n))))))
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/floor-proofs.lisp acl2-6.3/books/rtl/rel5/arithmetic/floor-proofs.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/floor-proofs.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/floor-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,282 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "ground-zero"))
-(local (include-book "fp2"))
-(local (include-book "denominator"))
-(local (include-book "numerator"))
-(local (include-book "predicate"))
-(local (include-book "nniq"))
-(local (include-book "product"))
-(local (include-book "unary-divide"))
-(local (include-book "rationalp"))
-(local (include-book "inverted-factor"))
-(local (include-book "meta/meta-plus-lessp" :dir :system))
-; (thm (rationalp (floor i j)))) goes through
-
-
-
-(defthm floor-non-negative-integerp-type-prescription
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (case-split (not (complex-rationalp j))) ;gen?
-                )
-           (and (<= 0 (floor i j))
-                (integerp (floor i j))))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable floor)
-                              '()))
-          ))
-
-;nope. (floor #C(0 -1)  #C(0 -1)) = 1
-;(defthm floor-with-j-non-rational
-;  (implies (not (rationalp j))
- ;          (equal (floor i j)
-  ;                0))
-;  :hints (("Goal" :in-theory (set-difference-theories
- ;                             (enable floor)
-  ;                            '(a13 FL-WEAKLY-MONOTONIC)))
-   ;       ))
-
-
-(defthm floor-non-negative
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (case-split (not (complex-rationalp i)));drop?
-                ;(case-split (rationalp j))
-                )
-           (<= 0 (floor i j)))
-
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable floor)
-                              '()))
-          ))
-
-
-(defthm floor-with-i-not-rational-but-j-rational
-  (implies (and (not (rationalp i))
-                (rationalp j)
-                )
-           (equal (floor i j)
-                  0))
-  :hints (("Goal" :in-theory (enable floor)))
-)
-
-
-(defthm floor-compare-to-zero
-  (implies (and (case-split (rationalp i))
-                (case-split (rationalp j)))
-           (equal (< (floor i j) 0)
-                  (or (and (< i 0) (< 0 j))
-                      (and (< 0 i) (< j 0))
-                      )))
-  :hints (("Goal" :in-theory (enable floor)))
-  )
-
-(defthm floor-of-non-acl2-number
-  (implies (not (acl2-numberp i))
-           (and (equal (floor i j)
-                       0)
-                (equal (floor j i)
-                       0)))
-  :hints (("Goal" :in-theory (enable floor)))
-  )
-
-;linear? how should it be phrased?
-;too many hints.  without the frac-coeff rule, things worked out here
-(defthm floor-upper-bound
-    (implies (and (case-split (rationalp i))
-                  (case-split (rationalp j))
-                  )
-	     (<= (floor i j) (/ i j)))
-    :hints (("Goal" :use ( (:instance nonnegative-integer-quotient-lower-bound-rewrite
-                                      (i (* -1 (NUMERATOR (* I (/ J)))))
-                                      (j (DENOMINATOR (* I (/ J)))))
-                           (:instance  nonnegative-integer-quotient-upper-bound-rewrite
-                                      (i (* -1 (NUMERATOR (* I (/ J)))))
-                                      (j (DENOMINATOR (* I (/ J)))))
-                           (:instance  nonnegative-integer-quotient-lower-bound-rewrite
-                                      (i (NUMERATOR (* I (/ J))))
-                                      (j (DENOMINATOR (* I (/ J)))))
-                           (:instance  nonnegative-integer-quotient-upper-bound-rewrite
-                                      (i (NUMERATOR (* I (/ J))))
-                                      (j (DENOMINATOR (* I (/ J))))))
-                           
-             :in-theory (set-difference-theories
-                         (enable floor)
-                         '(  nonnegative-integer-quotient-lower-bound-rewrite
-                             nonnegative-integer-quotient-upper-bound-rewrite
-                           ))))
-    :rule-classes (:rewrite (:linear :trigger-terms ((floor i j))))
-  )
-
-
-
-(defthm floor-equal-i-over-j-rewrite
-  (implies (and (case-split (not (equal j 0)))
-                (case-split (rationalp i))
-                (case-split (rationalp j))
-                )
-           (equal (EQUAL (* J (FLOOR I J)) I)
-                  (integerp (* i (/ j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable floor)
-                              '( nonnegative-integer-quotient-lower-bound-rewrite
-                                 nonnegative-integer-quotient-max-value-rewrite))
-           :use(
-                (:instance  nonnegative-integer-quotient-max-value-rewrite
-                            (i (* -1 (NUMERATOR (* I (/ J)))))
-                            (j (DENOMINATOR (* I (/ J)))))
-           
-                (:instance  nonnegative-integer-quotient-lower-bound-rewrite
-                            (i (* -1 (NUMERATOR (* I (/ J)))))
-                            (j (DENOMINATOR (* I (/ J))))))
-           )  )
-  )
-
-
-
-(defthm dumb
-  (equal (< x x)
-         nil))
-
-(defthm floor-with-j-zero
-  (equal (floor i 0)
-                  0)
-  :hints (("Goal" :in-theory (enable floor)))
-)
-
-
-;(defthm floor-greater-than-zero-rewrite
- ; (equal (< 0 (fl i j))
-  ;       (
-
-(defthm floor-upper-bound-2
-  (implies (and (<= 0 j)
-                (case-split (rationalp i))
-                (case-split (rationalp j))
-                (case-split (not (equal j 0)))
-                )
-           (<= (* j (floor i j)) i))
-  :hints (("Goal" :in-theory (disable  floor-upper-bound)
-           :use  floor-upper-bound))
-  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j))))
-
-  )
-
-
-(defthm floor-upper-bound-3
-  (implies (and (<= j 0)
-                (case-split (rationalp i))
-                (case-split (rationalp j))
-                (case-split (not (equal j 0)))
-                )
-           (<= i (* j (floor i j))))
-  :hints (("Goal" :in-theory (disable  floor-upper-bound)
-           :use  floor-upper-bound))
-  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j))))
-
-  )
-
-
-;BOZO remove the disables (and prove better nniq rules, and disable nniq!)
-(defthm floor-lower-bound
-  (implies (and (case-split (rationalp i))
-                (case-split (rationalp j))
-                )
-           (< (+ -1 (* i (/ j))) (floor i j)))
-  :otf-flg t
-  :hints (("Goal"
-             
-           :in-theory (set-difference-theories
-                       (enable floor)
-                       '( ;why do these disables help so much?
-                         less-than-multiply-through-by-inverted-factor-from-left-hand-side
-                         less-than-multiply-through-by-inverted-factor-from-right-hand-side
-                         EQUAL-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE
-                         )
-                       )))
-  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
-
-
-
-
-
-(defthm floor-when-arg-quotient-isnt-rational
-  (IMPLIES (NOT (RATIONALP (* i (/ j))))
-           (EQUAL (FLOOR i j) 0))
-  :hints (("Goal" :in-theory (enable floor))))
-
-(defthm floor-of-non-rational-by-one
-  (implies (not (rationalp i))
-           (equal (floor i 1)
-                  0))
-  :hints (("Goal" :in-theory (enable floor))))
-
-(defthm floor-of-rational-and-complex
-  (implies (and (rationalp i)
-                (not (rationalp j))
-                (case-split (acl2-numberp j)))
-           (and (equal (floor i j)
-                       0)
-                (equal (floor j i)
-                       0)))
-  :hints (("Goal" :in-theory (enable floor))))
-
-#|
-(defthm floor-of-two-complexes
-  (implies (and (complex-rationalp i)
-                (complex-rationalp j))
-           (equal (floor i j)
-                  (if (rationalp (/ i j))
-                      (floor (/ i j) 1)
-                    0)))
-  :hints (("Goal" :in-theory (enable floor))))
-|#
-
-(defthm floor-with-i-not-rational
-  (implies (not (rationalp i))
-           (equal (floor i j)
-                  (if (and (complex-rationalp i) (complex-rationalp j) (rationalp (/ i j)))
-                      (floor (/ i j) 1)
-                    0)))
-  :hints (("Goal" :in-theory (enable floor))))
-
-(defthm floor-with-j-not-rational
-  (implies (not (rationalp j))
-           (equal (floor i j)
-                  (if (and (complex-rationalp i) (complex-rationalp j) (rationalp (/ i j)))
-                      (floor (/ i j) 1)
-                    0)))
-  :hints (("Goal" :in-theory (enable floor))))
-
-
-
-
-(defthm floor-with-j-not-rational-but-i-rational
-  (implies (and (not (rationalp i))
-                (rationalp j)
-                )
-           (equal (floor i j)
-                  0)))
-
-#|
-(defthm floor-by-one-equal-zero
-  (implies (and (rationalp i)
-                (rationalp j))
-           (equal (EQUAL 0 (FLOOR (* i (/ j)) 1))
-                  (integerp (* i (/ j)))))
-  :hints (("Goal" :in-theory (enable floor)))
-)
-|#
-
-(defthm floor-of-zero
-  (equal (floor 0 j)
-         0))
-
-(defthm floor-of-integer-by-1
-  (implies (integerp i)
-           (equal (floor i 1)
-                  i))
-  :hints (("Goal" :in-theory (enable  floor))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/floor.lisp acl2-6.3/books/rtl/rel5/arithmetic/floor.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/floor.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/floor.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,199 +0,0 @@
-(in-package "ACL2")
-
-;see floor-proofs for all proofs (and todos?)
-
-(local (include-book "floor-proofs"))
-
-;;
-;; Behavior of floor when its guards are violated
-;;
-
-;this looks like it might loop! add syntaxp hyp that j isn't 1?
-(defthm floor-with-i-not-rational
-  (implies (not (rationalp i))
-           (equal (floor i j)
-                  (if (and (complex-rationalp i) (complex-rationalp j) (rationalp (/ i j)))
-                      (floor (/ i j) 1) ;yuck, defines floor in terms of itself
-                    0))))
-
-(defthm floor-with-j-not-rational
-  (implies (not (rationalp j))
-           (equal (floor i j)
-                  (if (and (complex-rationalp i) (complex-rationalp j) (rationalp (/ i j)))
-                      (floor (/ i j) 1) ;yuck, defines floor in terms of itself
-                    0))))
-
-;special case of floor-with-i-not-rational but contains no if
-(defthm floor-with-i-not-rational-but-j-rational
-  (implies (and (not (rationalp i))
-                (rationalp j)
-                )
-           (equal (floor i j)
-                  0)))
-
-;special case of floor-with-j-not-rational but contains no if
-(defthm floor-with-j-not-rational-but-i-rational
-  (implies (and (not (rationalp i))
-                (rationalp j)
-                )
-           (equal (floor i j)
-                  0)))
-
-;;
-;; type prescriptions
-;;
-
-; (thm (integerp (floor i j)))) goes through
-
-;to gen this, prove that the quotient of 2 positive complexes is either complex or positive. (that's a type!)
-;I have a marvelous proof of that fact, but this buffer is too small to contain it.
-;(Actually, it's in my green notebook.)
-
-(defthm floor-non-negative-integerp-type-prescription
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (case-split (not (complex-rationalp j))) ;I think I can drop this hyp, but it will take some work.
-                )
-           (and (<= 0 (floor i j))
-                (integerp (floor i j))))
-  :rule-classes (:type-prescription))
-
-
-
-;(floor #C(-4 -3) #C(4 3))= -1
-
-(defthm floor-non-negative
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (case-split (not (complex-rationalp i)));(case-split (rationalp i));drop?
-                )
-           (<= 0 (floor i j))))
-
-
-
-
-
-(defthm floor-compare-to-zero
-  (implies (and (case-split (rationalp i))
-                (case-split (rationalp j)))
-           (equal (< (floor i j) 0)
-                  (or (and (< i 0) (< 0 j))
-                      (and (< 0 i) (< j 0))
-                      ))))
-
-(defthm floor-of-non-acl2-number
-  (implies (not (acl2-numberp i))
-           (and (equal (floor i j)
-                       0)
-                (equal (floor j i)
-                       0))))
-
-;linear? how should it be phrased?
-(defthm floor-upper-bound
-  (implies (and (case-split (rationalp i))
-                (case-split (rationalp j))
-                )
-           (<= (floor i j) (/ i j)))
-  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
-
-
-
-(defthm floor-equal-i-over-j-rewrite
-  (implies (and (case-split (not (equal j 0)))
-                (case-split (rationalp i))
-                (case-split (rationalp j))
-                )
-           (equal (equal (* j (floor i j)) i)
-                  (integerp (* i (/ j))))))
-;move
-(defthm dumb
-  (equal (< x x)
-         nil))
-
-(defthm floor-with-j-zero
-  (equal (floor i 0)
-         0))
-
-(defthm floor-with-i-zero
-  (equal (floor 0 j)
-         0))
-
-
-;(defthm floor-greater-than-zero-rewrite
- ; (equal (< 0 (floor i j))
-  ;       (
-
-(defthm floor-upper-bound-2
-  (implies (and (<= 0 j)
-                (case-split (rationalp i))
-                (case-split (rationalp j))
-                (case-split (not (equal j 0)))
-                )
-           (<= (* j (floor i j)) i))
-  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
-
-
-(defthm floor-upper-bound-3
-  (implies (and (<= j 0) ;rarely true
-                (case-split (rationalp i))
-                (case-split (rationalp j))
-                (case-split (not (equal j 0)))
-                )
-           (<= i (* j (floor i j))))
-  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
-
-
-(defthm floor-lower-bound
-  (implies (and (case-split (rationalp i))
-                (case-split (rationalp j))
-                )
-           (< (+ -1 (* i (/ j))) (floor i j)))
-  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
-
-;a bit odd
-(defthm floor-when-arg-quotient-isnt-rational
-  (implies (not (rationalp (* i (/ j))))
-           (equal (floor i j) 0)))
-
-(defthm floor-of-non-rational-by-one
-  (implies (not (rationalp i))
-           (equal (floor i 1)
-                  0)))
-
-(defthm floor-of-rational-and-complex
-  (implies (and (rationalp i)
-                (not (rationalp j))
-                (case-split (acl2-numberp j)))
-           (and (equal (floor i j)
-                       0)
-                (equal (floor j i)
-                       0))))
-
-#|
-(defthm floor-of-two-complexes
-  (implies (and (complex-rationalp i)
-                (complex-rationalp j))
-           (equal (floor i j)
-                  (if (rationalp (/ i j))
-                      (floor (/ i j) 1)
-                    0)))
-  :hints (("Goal" :in-theory (enable floor))))
-|#
-
-
-
-
-#|
-(local
- (defthm floor*2
-   (implies (integerp x)
-            (equal (floor (* 2 x) 2) x))
-   :hints (("Goal" :in-theory (enable floor)))
-   ))
-|#
-
-(defthm floor-of-integer-by-1
-  (implies (integerp i)
-           (equal (floor i 1)
-                  i))
-  :hints (("Goal" :in-theory (enable  floor))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/fp.lisp acl2-6.3/books/rtl/rel5/arithmetic/fp.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/fp.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/fp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,310 +0,0 @@
-(in-package "ACL2")
-
-;Rename this book, since the guts have been ripped out?
-;BOZO clean up this book?
-;BOZO move these lemmas to extra?
-#|
-
-This book contains a few lemmas which are exported in lib/arith but which aren't needed in support/ or
-arithmetic/.  
-
-|#
-
-(local (include-book "fp2"))
-
-(defthm rearrange-fractional-coefs-<
-  (and
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (< 0 c))
-            (equal (< (* (/ c) x) z)
-                   (< x (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (< (+ (* (/ c) x) y) z)
-                   (< (+ x (* c y)) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (< (+ y (* (/ c) x)) z)
-                   (< (+ (* c y) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (< 0 c))
-            (equal (< (+ y1 y2 (* (/ c) x)) z)
-                   (< (+ (* c y1) (* c y2) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (case-split (rationalp y3))
-                 (< 0 c))
-            (equal (< (+ y1 y2 y3 (* (/ c) x)) z)
-                   (< (+ (* c y1) (* c y2) (* c y3) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (< 0 c))
-            (equal (< z (* (/ c) x))
-                   (< (* c z) x)))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (< z (+ (* (/ c) x) y))
-                   (< (* c z) (+ x (* c y)))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (< z (+ y (* (/ c) x)))
-                   (< (* c z) (+ (* c y) x))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (< 0 c))
-            (equal (< z (+ y1 y2 (* (/ c) x)))
-                   (< (* c z) (+ (* c y1) (* c y2) x))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (case-split (rationalp y3))
-                 (< 0 c))
-            (equal (< z (+ y1 y2 y3 (* (/ c) x)))
-                   (< (* c z) (+ (* c y1) (* c y2) (* c y3) x))))))
-
-
-(defthm rearrange-fractional-coefs-equal
-  (and
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (< 0 c))
-            (equal (equal (* (/ c) x) z)
-                 (equal x (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (equal (+ (* (/ c) x) y) z)
-                 (equal (+ x (* c y)) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (equal (+ y (* (/ c) x)) z)
-                 (equal (+ (* c y) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (< 0 c))
-            (equal (equal (+ y1 y2 (* (/ c) x)) z)
-                 (equal (+ (* c y1) (* c y2) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (case-split (rationalp y3))
-                 (< 0 c))
-            (equal (equal (+ y1 y2 y3 (* (/ c) x)) z)
-                 (equal (+ (* c y1) (* c y2) (* c y3) x) (* c z))))))
-
-
-
-; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
-; product of a and b given intervals for a and b.  We consider three kinds of intervals.
-; We discuss only the a case.
-
-; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
-
-; nonneg-open intervals mean 0<=a<amax.
-
-; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
-
-; We now prove theorems with names like abs*nonneg-open, etc. characterizing
-; the product of two elements from two such interals.  All of these theorems
-; are made with :rule-classes nil because I don't know how to control their
-; use.
-
-(encapsulate nil
-  (local 
-   (defthm renaming
-    (implies (and (rationalp a)
-                  (rationalp xmax)
-                  (rationalp b)
-                  (rationalp bmax)
-                  (< (- xmax) a)
-                  (<= a xmax)
-                  (< 0 xmax)
-                  (<= 0 b)
-                  (< b bmax))
-             (and (< (- (* xmax bmax)) (* a b))
-                  (< (* a b) (* xmax bmax))))
-    :hints (("Goal" :cases ((equal b 0))))))
-
-; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
-; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
-; lemma would be no different.
-
-  (defthm abs*nonneg-open
-    (implies (and (rationalp a)
-                  (rationalp amax)
-                  (rationalp b)
-                  (rationalp bmax)
-                  (< (- amax) a)
-                  (<= a amax)       ; (< a amax) is all we'll ever use, I bet.
-                  (< 0 amax)
-                  (<= 0 b)
-                  (< b bmax))
-             (and (< (- (* amax bmax)) (* a b))
-                  (< (* a b) (* amax bmax))))
-    :hints (("Goal" :by renaming))
-    :rule-classes nil))
-
-(defthm abs*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* a b))
-                (< (* a b) (* amax bmax))))
-  :hints (("Goal" :cases ((equal b 0))))
-  :rule-classes nil)
-
-(defthm nonneg-closed*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* b a))
-                (< (* b a) (* amax bmax))))
-  :hints (("Goal" :use abs*nonneg-closed))
-  :rule-classes nil)
-
-(defthm nonneg-open*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
-                (< 0 amax)
-                (<= 0 b)
-                (< b bmax))
-           (and (< (- (* bmax amax)) (* a b))
-                (< (* a b) (* bmax amax))))
-    :hints (("Goal" :use abs*nonneg-open))
-    :rule-classes nil)
-
-; The next three, which handle nonnegative open intervals in the first argument,
-; can actually be seen as uses of the abs intervals above.  Simply observe that
-; if 0<=a<amax then -amax<a<amax.
-
-(defthm nonneg-open*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* a b))
-                (< (* a b) (* amax bmax))))
-  :hints (("Goal" :use abs*nonneg-closed))
-  :rule-classes nil)
-
-(defthm nonneg-open*nonneg-open
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (< b bmax))
-           (and (<= 0 (* a b))
-                (< (* a b) (* amax bmax))))
-  :hints (("Goal" :use abs*nonneg-open))
-  :rule-classes nil)
-
-; and the commuted version
-(defthm nonneg-closed*nonneg-open
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* b a))
-                (< (* b a) (* amax bmax))))
-  :hints (("Goal" :use nonneg-open*nonneg-closed))
-  :rule-classes nil)
-
-(defthm nonneg-closed*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (<= a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* a b))
-                (<= (* a b) (* amax bmax))))
-  :rule-classes nil)
-
-(defthm abs*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (< (- bmax) b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* a b))
-                (< (* a b) (* amax bmax))))
-  :hints (("Goal" :cases ((< b 0) (> b 0))))
-  :rule-classes nil)  
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/fp2.lisp acl2-6.3/books/rtl/rel5/arithmetic/fp2.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/fp2.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/fp2.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,780 +0,0 @@
-; This file was created by J Moore and Matt Kaufmann in 1995 in support of
-; their proof of the AMD-K5 division code.
-
-;this is eric's version of fp.lisp
-;note that it doesn't mention fl
-
-(in-package "ACL2")
-
-
-(local (include-book "ihs/ihs-definitions" :dir :system))
-(local (include-book "ihs/ihs-lemmas" :dir :system))
-(local (include-book "ihs/ihs-lemmas" :dir :system))
-
-; The following is (minimal-ihs-theory)
-(local (PROGN (IN-THEORY NIL)
-              (IN-THEORY (ENABLE BASIC-BOOT-STRAP
-                                 IHS-MATH QUOTIENT-REMAINDER-RULES
-                                 LOGOPS-LEMMAS-THEORY))))
-
-(local (in-theory (enable logops-definitions-theory)))
-
-
-
-(defthm a1 (equal (+ x (+ y z)) (+ y (+ x z))))
-(defthm a2 (equal (- x) (* -1 x)))
-
-(local (in-theory (disable functional-commutativity-of-minus-*-right
-                           functional-commutativity-of-minus-*-left)))
-
-(defthm a3
-  (and (implies (syntaxp (and (quotep c1) (quotep c2)))
-                (and (equal (+ (* c1 x) (* c2 x)) (* (+ c1 c2) x))
-                     (equal (+ (* c1 x) (+ (* c2 x) y)) (+ (* (+ c1 c2) x) y))))
-       (implies (syntaxp (quotep c2))
-                (and (equal (+ x (* c2 x)) (* (+ 1 c2) x))
-                     (equal (+ x (+ (* c2 x) y1)) (+ (* (+ 1 c2) x) y1))
-                     (equal (+ x (+ y1 (* c2 x))) (+ (* (+ 1 c2) x) y1))
-                     (equal (+ x (+ y1 (+ (* c2 x) y2))) (+ (* (+ 1 c2) x) y1 y2))
-                     (equal (+ x (+ y1 (+ y2 (* c2 x)))) (+ (* (+ 1 c2) x) y1 y2))
-                     (equal (+ x (+ y1 (+ y2 (+ y3 (* c2 x)))))
-                            (+ (* (+ 1 c2) x) y1 y2 y3))
-                     (equal (+ x (+ y1 (+ y2 (+ (* c2 x) y3))))
-                            (+ (* (+ 1 c2) x) y1 y2 y3))))
-       (and (equal (+ x x) (* 2 x))
-            (equal (+ x (+ x y1)) (+ (* 2 x) y1)))))
-
-(defthm a4
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (equal (+ c1 (+ c2 y1)) (+ (+ c1 c2) y1))))
-(defthm a5
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (equal (* c1 (* c2 y1)) (* (* c1 c2) y1))))
-
-(defthm a6
-  (equal (/ (/ x)) (fix x)))
-
-(defthm a7
-  (equal (/ (* x y)) (* (/ x) (/ y))))
-
-;replaced force with case-split
-(defthm a8
-  (implies (and (case-split (acl2-numberp x))
-                (case-split (not (equal x 0))))
-           (and (equal (* x (* (/ x) y)) (fix y))
-                (equal (* x (/ x)) 1)))
-  :hints (("Goal" :cases ((acl2-numberp x))))
-)
-
-(in-theory (disable inverse-of-*))
-
-;separate these out?
-(defthm a9
-  (and (equal (* 0 x) 0)
-       (equal (* x (* y z)) (* y (* x z)))
-       (equal (* x (+ y z)) (+ (* x y) (* x z)))
-       (equal (* (+ y z) x) (+ (* y x) (* z x)))))
-
-
-
-#|
-
-(local (defthm evenp--k
-  (implies (integerp k) (equal (evenp (- k)) (evenp k)))
-  :hints
-  (("Goal" :in-theory (set-difference-theories
-                       (enable evenp
-                               functional-commutativity-of-minus-*-right
-                               functional-commutativity-of-minus-*-left)
-                       '(a2 a5))))))
-
-(local (defthm evenp-2k
-  (implies (integerp k) (evenp (* 2 k)))
-  :hints (("Goal" :in-theory (enable evenp)))))
-                                              
-(local (defthm evenp-expt-2
-  (implies (and (integerp k)
-                (> k 0))
-           (evenp (expt 2 k)))
-  :hints (("Goal" :in-theory (enable evenp expt)))))
-                                              
-(local (defthm evenp-+-even
-  (implies (evenp j) (equal (evenp (+ i j)) (evenp i)))
-  :hints (("Goal" :in-theory (enable evenp)))))
-
-
-|#
-
-;I want to use some theoremes in arithmetic-2, but the theorems I want to prove have the same names as those,
-;so I export them from the encapsulate with -alt appended to the names.
-
-
-(local 
- (encapsulate 
-  ()
-             
-  (local (include-book "arithmetic-2/meta/non-linear" :dir :system))
-
-;BOZO generalize the (rationalp x) hyp (is it enough that, say, y be rational?)
-  (defthm *-weakly-monotonic-alt
-    (implies (and (<= y y+)
-                  (<= 0 x) ;reordered to put this first!
-                  (rationalp x) ; This does not hold if x, y, and z are complex!
-                  )
-             (<= (* x y) (* x y+)))
-    :hints (("Goal" :cases ((equal x 0))))
-    :rule-classes
-    ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-     (:linear)
-     (:forward-chaining
-      :trigger-terms ((* y x) (* y+ x))
-      :corollary
-      (implies (and (<= y y+)
-                    (<= 0 x)
-                    (rationalp x)
-                    )
-               (<= (* y x) (* y+ x))))
-     (:linear
-      :corollary
-      (implies (and (<= y y+)
-                    (rationalp x)
-                    (<= 0 x))
-               (<= (* y x) (* y+ x))))))
-
-  (defthm *-strongly-monotonic-alt
-    (implies (and (< y y+)
-                  (rationalp x)
-                  (< 0 x))
-             (< (* x y) (* x y+)))
-    :rule-classes
-    ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-     (:linear)
-     (:forward-chaining
-      :trigger-terms ((* y x) (* y+ x))
-      :corollary
-      (implies (and (< y y+)
-                    (rationalp x)
-                    (< 0 x))
-               (< (* y x) (* y+ x))))
-     (:linear
-      :corollary
-      (implies (and (< y y+)
-                    (rationalp x)
-                    (< 0 x))
-               (< (* y x) (* y+ x))))))
-
-  (defthm *-weakly-monotonic-negative-multiplier-alt
-    (implies (and (<= y y+)
-                  (rationalp x)
-                  (< x 0))
-             (<= (* x y+) (* x y)))
-    :rule-classes
-    ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-     (:linear)
-     (:forward-chaining
-      :trigger-terms ((* y x) (* y+ x))
-      :corollary
-      (implies (and (<= y y+)
-                    (rationalp x)
-                    (< x 0))
-               (<= (* y+ x) (* y x))))
-     (:linear
-      :corollary
-      (implies (and (<= y y+)
-                    (rationalp x)
-                    (< x 0))
-               (<= (* y+ x) (* y x))))))
-
-  (defthm *-strongly-monotonic-negative-multiplier-alt
-    (implies (and (< y y+)
-                  (rationalp x)
-                  (< x 0))
-             (< (* x y+) (* x y)))
-    :rule-classes
-    ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-     (:linear)
-     (:forward-chaining
-      :trigger-terms ((* y x) (* y+ x))
-      :corollary
-      (implies (and (< y y+)
-                    (rationalp x)
-                    (< x 0))
-               (< (* y+ x) (* y x))))
-     (:linear
-      :corollary
-      (implies (and (< y y+)
-                    (rationalp x)
-                    (< x 0))
-               (< (* y+ x) (* y x))))))
-
-
-  (defthm /-weakly-monotonic-alt
-    (implies (and (<= y y+)
-                  (rationalp y)
-                  (rationalp y+)
-                  (< 0 y))
-             (<= (/ y+) (/ y)))
-    :rule-classes
-    ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
-
-  (defthm /-strongly-monotonic-alt
-    (implies (and (< y y+)
-                  (rationalp y)
-                  (rationalp y+)
-                  (< 0 y))
-             (< (/ y+) (/ y)))
-    :rule-classes
-    ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
-  )
- )
-
-
-
-
-
-(defthm /-weakly-monotonic
-  (implies (and (<= y y+)
-;                (not (equal 0 y))
-                (< 0 y) ;gen?
-                (case-split (rationalp y))
-                (case-split (rationalp y+))
-                )
-           (<= (/ y+) (/ y)))
-  :hints (("Goal" :use ( /-WEAKLY-MONOTONIC-ALT
-                  )))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
-
-(defthm /-strongly-monotonic
-  (implies (and (< y y+)
-                (< 0 y) ;gen?
-                (case-split (rationalp y))
-                (case-split (rationalp y+))
-                )
-           (< (/ y+) (/ y)))
-  :hints (("Goal" :use ( /-strongly-MONOTONIC-ALT
-                  )))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
-         
-(defthm *-weakly-monotonic
-  (implies (and
-                (<= y y+)
-                (<= 0 x)                 ;this hyp was last... re-order bad?
-                (case-split (rationalp x)) ; This does not hold if x, y, and z are complex!
-                )
-           (<= (* x y) (* x y+)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-   (:linear)
-   (:forward-chaining
-    :trigger-terms ((* y x) (* y+ x))
-    :corollary
-    (implies (and
-                  (<= y y+)
-                  (<= 0 x)
-                  (case-split (rationalp x))
-                  )
-             (<= (* y x) (* y+ x))))
-   (:linear
-    :corollary
-    (implies (and
-                  (<= y y+)
-                  (<= 0 x)
-                  (case-split (rationalp x))
-                  )
-             (<= (* y x) (* y+ x))))))
-
-#| Here is the complex counterexample to which we alluded above.
-
-(let ((y  #c(1 -1))
-      (y+ #c(1 1))
-      (x  #c(1 1)))
-    (implies (and (<= y y+)
-                  (<= 0 x))
-             (<= (* x y) (* x y+))))
-|#
-
-;could we generalize the (rationalp x) hyp to (not (complex-rationalp)) ?
-(defthm *-strongly-monotonic
-  (implies (and (< y y+)
-                (< 0 x)
-                (case-split (rationalp x))
-                )
-           (< (* x y) (* x y+)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-   (:linear)
-   (:forward-chaining
-    :trigger-terms ((* y x) (* y+ x))
-    :corollary
-    (implies (and
-                  (< y y+)
-                  (< 0 x)
-                  (case-split (rationalp x))
-                  )
-             (< (* y x) (* y+ x))))
-   (:linear
-    :corollary
-    (implies (and
-                  (< y y+)
-                  (< 0 x)
-                  (case-split (rationalp x))
-                  )
-             (< (* y x) (* y+ x))))))
-
-(defthm *-weakly-monotonic-negative-multiplier
-  (implies (and (<= y y+)
-                (< x 0)
-                (case-split (rationalp x))
-                )
-           (<= (* x y+) (* x y)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-   (:linear)
-   (:forward-chaining
-    :trigger-terms ((* y x) (* y+ x))
-    :corollary
-    (implies (and
-                  (<= y y+)
-                  (< x 0)
-                  (case-split (rationalp x))
-                  )
-             (<= (* y+ x) (* y x))))
-   (:linear
-    :corollary
-    (implies (and
-                  (<= y y+)
-                  (< x 0)
-                  (case-split (rationalp x))
-                  )
-             (<= (* y+ x) (* y x))))))
-
-(defthm *-strongly-monotonic-negative-multiplier
-  (implies (and
-                (< y y+)
-                (< x 0)
-                (case-split (rationalp x))
-                )
-           (< (* x y+) (* x y)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-   (:linear)
-   (:forward-chaining
-    :trigger-terms ((* y x) (* y+ x))
-    :corollary
-    (implies (and
-                  (< y y+)
-                  (< x 0)
-                  (case-split (rationalp x))
-                  )
-             (< (* y+ x) (* y x))))
-   (:linear
-    :corollary
-    (implies (and
-                  (< y y+)
-                   (< x 0)
-                  (case-split (rationalp x))
-                  )
-             (< (* y+ x) (* y x))))))
-
-
-
-; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
-; product of a and b given intervals for a and b.  We consider three kinds of intervals.
-; We discuss only the a case.
-
-; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
-
-; nonneg-open intervals mean 0<=a<amax.
-
-; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
-
-; We now prove theorems with names like abs*nonneg-open, etc. characterizing
-; the product of two elements from two such interals.  All of these theorems
-; are made with :rule-classes nil because I don't know how to control their
-; use.
-
-;BOZO move these to extra-rules? these are copied in fp.lisp!
-(encapsulate nil
-  (local 
-   (defthm renaming
-    (implies (and (rationalp a)
-                  (rationalp xmax)
-                  (rationalp b)
-                  (rationalp bmax)
-                  (< (- xmax) a)
-                  (<= a xmax)
-                  (< 0 xmax)
-                  (<= 0 b)
-                  (< b bmax))
-             (and (< (- (* xmax bmax)) (* a b))
-                  (< (* a b) (* xmax bmax))))
-    :hints (("Goal" :cases ((equal b 0))))))
-
-; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
-; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
-; lemma would be no different.
-
-  (defthm abs*nonneg-open
-    (implies (and (rationalp a)
-                  (rationalp amax)
-                  (rationalp b)
-                  (rationalp bmax)
-                  (< (- amax) a)
-                  (<= a amax)       ; (< a amax) is all we'll ever use, I bet.
-                  (< 0 amax)
-                  (<= 0 b)
-                  (< b bmax))
-             (and (< (- (* amax bmax)) (* a b))
-                  (< (* a b) (* amax bmax))))
-    :hints (("Goal" :by renaming))
-    :rule-classes nil))
-
-(defthm abs*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* a b))
-                (< (* a b) (* amax bmax))))
-  :hints (("Goal" :cases ((equal b 0))))
-  :rule-classes nil)
-
-(defthm nonneg-closed*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* b a))
-                (< (* b a) (* amax bmax))))
-  :hints (("Goal" :use abs*nonneg-closed))
-  :rule-classes nil)
-
-(defthm nonneg-open*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
-                (< 0 amax)
-                (<= 0 b)
-                (< b bmax))
-           (and (< (- (* bmax amax)) (* a b))
-                (< (* a b) (* bmax amax))))
-    :hints (("Goal" :use abs*nonneg-open))
-    :rule-classes nil)
-
-; The next three, which handle nonnegative open intervals in the first argument,
-; can actually be seen as uses of the abs intervals above.  Simply observe that
-; if 0<=a<amax then -amax<a<amax.
-
-(defthm nonneg-open*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* a b))
-                (< (* a b) (* amax bmax))))
-  :hints (("Goal" :use abs*nonneg-closed))
-  :rule-classes nil)
-
-(defthm nonneg-open*nonneg-open
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (< b bmax))
-           (and (<= 0 (* a b))
-                (< (* a b) (* amax bmax))))
-  :hints (("Goal" :use abs*nonneg-open))
-  :rule-classes nil)
-
-; and the commuted version
-(defthm nonneg-closed*nonneg-open
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* b a))
-                (< (* b a) (* amax bmax))))
-  :hints (("Goal" :use nonneg-open*nonneg-closed))
-  :rule-classes nil)
-
-(defthm nonneg-closed*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (<= a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* a b))
-                (<= (* a b) (* amax bmax))))
-  :rule-classes nil)
-
-(defthm abs*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (< (- bmax) b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* a b))
-                (< (* a b) (* amax bmax))))
-  :hints (("Goal" :cases ((< b 0) (> b 0))))
-  :rule-classes nil)  
-
-;Apparenlty, ACL2 will match (- c) to -1...
-;This rule is incomplete...
-;make a bind-free rule for this...
-(defthm rearrange-negative-coefs-<
-  (and (equal (< (* (- c) x) z)
-              (< 0 (+ (* c x) z)))
-       (equal (< (+ (* (- c) x) y) z)
-              (< y (+ (* c x) z)))
-       (equal (< (+ y (* (- c) x)) z)
-              (< y (+ (* c x) z)))
-       (equal (< (+ y1 y2 (* (- c) x)) z)
-              (< (+ y1 y2) (+ (* c x) z)))
-       (equal (< (+ y1 y2 y3 (* (- c) x)) z)
-              (< (+ y1 y2 y3) (+ (* c x) z)))
-       (equal (< z (+ (* (- c) x) y))
-              (< (+ (* c x) z) y))
-       (equal (< z (+ y (* (- c) x)))
-              (< (+ (* c x) z) y))
-       (equal (< z (+ y1 y2 (* (- c) x)))
-              (< (+ (* c x) z) (+ y1 y2)))
-       (equal (< z (+ y1 y2 y3 (* (- c) x)))
-              (< (+ (* c x) z) (+ y1 y2 y3)))))
-
-;make a bind-free rule for this...
-(defthm rearrange-negative-coefs-equal
-  (and (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp z)))
-                (equal (equal (* (- c) x) z)
-                       (equal 0 (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y))
-                     (case-split (rationalp z)))
-                (equal (equal (+ (* (- c) x) y) z)
-                       (equal y (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y))
-                     (case-split (rationalp z)))
-                (equal (equal (+ y (* (- c) x)) z)
-                       (equal y (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y1))
-                     (case-split (rationalp y2))
-                     (case-split (rationalp z)))
-                (equal (equal (+ y1 y2 (* (- c) x)) z)
-                       (equal (+ y1 y2) (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y1))
-                     (case-split (rationalp y2))
-                     (case-split (rationalp y3))
-                     (case-split (rationalp z)))
-                (equal (equal (+ y1 y2 y3 (* (- c) x)) z)
-                       (equal (+ y1 y2 y3) (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y))
-                     (case-split (rationalp z)))
-                (equal (equal z (+ (* (- c) x) y))
-                       (equal (+ (* c x) z) y)))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y))
-                     (case-split (rationalp z)))
-                (equal (equal z (+ y (* (- c) x)))
-                       (equal (+ (* c x) z) y)))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y1))
-                     (case-split (rationalp y2))
-                     (case-split (rationalp z)))
-                (equal (equal z (+ y1 y2 (* (- c) x)))
-                       (equal (+ (* c x) z) (+ y1 y2))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y1))
-                     (case-split (rationalp y2))
-                     (case-split (rationalp y3))
-                     (case-split (rationalp z)))
-                (equal (equal z (+ y1 y2 y3 (* (- c) x)))
-                       (equal (+ (* c x) z) (+ y1 y2 y3))))))
-
-(include-book "inverted-factor")
-
-;Sometimes we don't want these rules enabled (especially when we're doing linear reasoning about "quotients"
-;like calls to / or floor or fl or nonnegative-integer-quotient).
-(defthm equal-multiply-through-by-inverted-factor-from-left-hand-side
-  (implies (and (bind-free (find-inverted-factor lhs) (k))
-                (syntaxp (not (is-a-factor k lhs)))
-                (syntaxp (sum-of-products-syntaxp lhs))
-                (syntaxp (sum-of-products-syntaxp rhs))
-                (syntaxp (not (quotep lhs))) ;if lhs is a constant (e.g., (equal x '1/2)) then do nothing
-                (case-split (not (equal k 0)))
-                (case-split (acl2-numberp k))
-                (case-split (acl2-numberp lhs))
-                (case-split (acl2-numberp rhs))
-                )
-           (equal (equal lhs rhs)
-                  (equal (* lhs k) (* rhs k)))))
-
-(defthm equal-multiply-through-by-inverted-factor-from-right-hand-side
-  (implies (and (bind-free (find-inverted-factor rhs) (k))
-                (syntaxp (not (is-a-factor k rhs)))
-                (syntaxp (sum-of-products-syntaxp lhs))
-                (syntaxp (sum-of-products-syntaxp rhs))
-                (syntaxp (not (quotep rhs))) ;if rhs is a constant (e.g., (equal '1/2 x)) then do nothing
-                (case-split (not (equal k 0)))
-                (case-split (acl2-numberp k))
-                (case-split (acl2-numberp lhs))
-                (case-split (acl2-numberp rhs))
-                )
-           (equal (equal lhs rhs)
-                  (equal (* lhs k) (* rhs k)))))
-
-#|
-;are the case splits caused by these 2 rules bad?  
-;prove more rules with positive (and then negative) hyps?
-;maybe we can rewrite LHS first, to prevent loops.  can we rely on the rewriting to simplify LHS enough?  what
-;about funny cases?
- Note on loops: Consider when LHS is (* k (/ k)).  This has not been
-;simplified, but (very unfortunately), we cannot rely on ACL2 to have rewritten subterms before rewriting a
-;term.
-In this case, we must be sure that we don't multiply through by k (since we found the inverted factor (/ k).
-
-|#
-(defthm less-than-multiply-through-by-inverted-factor-from-left-hand-side
-  (implies (and (bind-free (find-inverted-factor lhs) (k))
-                (syntaxp (not (is-a-factor k lhs))) ;helps prevent loops.
-                (syntaxp (sum-of-products-syntaxp lhs))
-                (syntaxp (sum-of-products-syntaxp rhs))
-                (case-split (not (equal k 0)))
-                (case-split (rationalp k)) ;gen!
-                )
-           (equal (< lhs rhs)
-                  (if (<= 0 k)
-                      (< (* lhs k) (* rhs k))
-                    (< (* rhs k) (* lhs k))))))
-
-(defthm less-than-multiply-through-by-inverted-factor-from-right-hand-side
-  (implies (and (bind-free (find-inverted-factor rhs) (k))
-                (syntaxp (not (is-a-factor k rhs)))
-                (syntaxp (sum-of-products-syntaxp lhs))
-                (syntaxp (sum-of-products-syntaxp rhs))
-                (case-split (not (equal k 0)))
-                (case-split (rationalp k))
-                )
-           (equal (< lhs rhs)
-                  (if (<= 0 k)
-                      (< (* lhs k) (* rhs k))
-                    (< (* rhs k) (* lhs k))))))
-
-;move to extra?
-(defthm x*/y=1->x=y
-  (implies (and (rationalp x)
-                (rationalp y)
-                (not (equal x 0))
-                (not (equal y 0)))
-           (equal (equal (* x (/ y)) 1)
-                  (equal x y)))
-  :rule-classes nil)
-
-;move this stuff?                
-(defun point-right-measure (x)
-  (floor (if (and (rationalp x) (< 0 x)) (/ x) 0) 1))
-
-(defun point-left-measure (x)
-  (floor (if (and (rationalp x) (> x 0)) x 0) 1))
-
-(include-book "ordinals/e0-ordinal" :dir :system)
-
-(defthm recursion-by-point-right
-  (and (e0-ordinalp (point-right-measure x))
-       (implies (and (rationalp x)
-                     (< 0 x)
-                     (< x 1))
-                (e0-ord-< (point-right-measure (* 2 x))
-                          (point-right-measure x)))))
-
-(defthm recursion-by-point-left
-  (and (e0-ordinalp (point-left-measure x))
-       (implies (and (rationalp x)
-                     (>= x 2))
-                (e0-ord-< (point-left-measure (* 1/2 x))
-                          (point-left-measure x)))))
-
-(in-theory (disable point-right-measure point-left-measure))
-
-(defthm x<x*y<->1<y
-  (implies (and (rationalp x)
-                (< 0 x)
-                (rationalp y))
-           (equal (< x (* x y))
-                  (< 1 y)))
-  :rule-classes nil)
-
-(defthm cancel-equal-*
-  (implies (and (rationalp r)
-                (rationalp s)
-                (rationalp a)
-                (not (equal a 0)))
-           (equal (equal (* a r) (* a s))
-                  (equal r s)))
-  :rule-classes nil)
-
-
-;not used anywhere in support/
-;i have a better rule...
-(defthm cancel-<-*
-  (implies (and (rationalp r)
-                (rationalp s)
-                (rationalp a)
-                (< 0 a))
-           (equal (< (* a r) (* a s))
-                  (< r s)))
-  :rule-classes nil)
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/ground-zero.lisp acl2-6.3/books/rtl/rel5/arithmetic/ground-zero.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/ground-zero.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/ground-zero.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,24 +0,0 @@
-(in-package "ACL2")
-;includes changes to the default theory (mostly disabling built-in functions)
-
-(in-theory (disable aref1))
-(in-theory (disable aset1))
-(in-theory (disable aref2))
-(in-theory (disable aset2))
-(in-theory (disable floor))
-(in-theory (disable truncate))
-(in-theory (disable mod))
-(in-theory (disable rem))
-(in-theory (disable expt))
-(in-theory (disable ash))
-(in-theory (disable binary-logand))
-(in-theory (disable binary-logior))
-(in-theory (disable binary-logxor))
-(in-theory (disable binary-logeqv))
-(in-theory (disable logorc1))
-(in-theory (disable lognot))
-(in-theory (disable evenp)) ;new
-(in-theory (disable oddp)) ;new
-(in-theory (disable nonnegative-integer-quotient)) ;new
-;abs?
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/hacks.lisp acl2-6.3/books/rtl/rel5/arithmetic/hacks.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/hacks.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/hacks.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,68 +0,0 @@
-(in-package "ACL2")
-
-;This book contains arithmetic hacks removed from basic.lisp
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(local (include-book "fp2"))
-
-(defthm delta1-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp d)
-		  (>= y 0)
-		  (>= x (+ y y))
-		  (>= d 0))
-	     (<= (* y d) (* (- x y) d)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance *-weakly-monotonic (x d) (y+ (- x y)))))))
-
-
-(defthm delta1-a
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp d)
-		  (>= y 0)
-		  (>= x (+ y y))
-		  (>= d 0))
-	     (>= (- x (* y (+ 1 d)))
-		 (* (- x y) (- 1 d))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance delta1-1)))))
-
-(defthm delta1-b
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp d)
-		  (>= y 0)
-		  (>= x (+ y y))
-		  (>= d 0))
-	     (<= (- x (* y (- 1 d)))
-		 (* (- x y) (+ 1 d))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance delta1-1)))))
-
-(defthm delta2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp d)
-		  (>= (* x d) 0))
-	     (>= (+ x (* y (- 1 d)))
-		 (* (+ x y) (- 1 d))))
-  :rule-classes ())
-
-(defthm natp-
-    (implies (and (natp x)
-		  (natp y)
-		  (>= x y))
-	     (natp (+ x (* -1 y))))
-  :hints (("Goal" :in-theory (enable natp))))
-
-;disable, since we intend to keep natp enabled?
-(defthmd natp>=0
-  (implies (natp x)
-           (>= x 0)))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/induct.lisp acl2-6.3/books/rtl/rel5/arithmetic/induct.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/induct.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/induct.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,73 +0,0 @@
-(in-package "ACL2")
-
-;Necessary definitions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(local (include-book "fl")) ; yuck?
-
-(defun or-dist-induct (y n)
-  (if (and (integerp n) (>= n 0))
-      (if (= n 0)
-	  y
-	(or-dist-induct (fl (/ y 2)) (1- n)))
-    ()))
-
-(defun log-induct (i j)
-  (if (and (integerp i) (>= i 0)
-	   (integerp j) (>= j 0))
-      (if (or (= i 0) (= j 0))
-	  ()
-	(log-induct (fl (/ i 2)) (fl (/ j 2))))
-    ()))
-
-(DEFUN logand-three-args-induct (I J K)
-  (declare (xargs :measure (ACL2-COUNT (abs i))
-                  :hints (("Goal" :in-theory (enable abs)))))
-  (IF (AND (INTEGERP I)
-           (INTEGERP J)
-           (INTEGERP K)
-           )
-      (IF (OR (= I 0) (= J 0) (= K 0)
-              (= I -1) (= J -1) (= K -1))
-          NIL
-          (logand-three-args-induct
-           (FL (/ I 2))
-           (FL (/ J 2))
-           (FL (/ K 2))))
-      NIL))
-
-
-(DEFUN LOG-INDUCT-allows-negatives (i j)
-  (IF (AND (INTEGERP i)
-           (INTEGERP j)
-           )
-      (IF (OR (= i 0) (= j 0) (= i -1) (= j -1))
-          NIL
-          (LOG-INDUCT-allows-negatives (FL (/ i 2)) (FL (/ j 2))))
-      NIL))
-
-(defun op-dist-induct (i j n)
-  (if (and (integerp n) (>= n 0))
-      (if  (= n 0)
-	  (list i j)
-	(op-dist-induct (fl (/ i 2)) (fl (/ j 2)) (1- n)))
-    ()))
-
-#|
-(defun op-dist-induct-negative (i j n)
-  (if (and (integerp n) (<= n 0))
-      (if (= n 0)
-	  (list i j)
-	(op-dist-induct-negative (fl (/ i 2)) (fl (/ j 2)) (1+ n)))
-    ()))
-|#
-
-
-;move?
-(defun natp-induct (k)
-  (if (zp k)
-      t
-    (natp-induct (1- k))))
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/integerp.lisp acl2-6.3/books/rtl/rel5/arithmetic/integerp.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/integerp.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/integerp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,118 +0,0 @@
-(in-package "ACL2")
-
-;make an integerp-proofs book?
-
-(include-book "negative-syntaxp")
-(local (include-book "predicate"))
-(local (include-book "fp2")) ;gross?
-
-(local (in-theory (disable a2)))
-
-(encapsulate
- ()
- (local (defthm no-room-for-an-integerp-between-0-and-1
-          (implies (and (< x 1)
-                        (< 0 x))
-                   (not (integerp x)))))
- 
- (defthm quotient-not-integerp
-   (implies (and (< i j)
-                 (<= 0 i)
-                 (<= 0 j)
-                 (case-split (< 0 i)) ;if we can show (<= 0 i) but not (< 0 i), split cases
-                 (case-split (< 0 j))
-                 (case-split (rationalp j)) ;gen?
-                 )
-            (not (integerp (/ i j))))
-   ))
-
-
-;integerp-minus-aux
-(encapsulate
- ()
- (local (defthm minus-1-rewrite
-          (equal (* -1 x)
-                 (- x))))
-             
- (defthm integerp-minus-aux
-   (implies (acl2-numberp x) ;can't gen?
-            (equal (integerp (* -1 x))
-                   (integerp x)))))
-
-
-(defthm integerp-minus
-  (implies (and (syntaxp (negative-syntaxp x)) ;the negative-syntaxp test makes this rule quite general
-                (case-split (acl2-numberp x))
-                )
-           (equal (integerp x)
-                  (integerp (* -1 x)))))
-
-(in-theory (disable integerp-minus-aux))
-
-
-
-#|
- 
- simplify integerp of a sum. see robert krug's meta rules on this subject
-
-|#
-
-(defthm integerp-sum-take-out-known-integer
-   (implies (integerp n)
-            (and (equal (integerp (+ n x))
-                        (integerp (fix x)))
-                 (equal (integerp (+ x n))
-                        (integerp (fix x))))))
-
-(defthm integerp-sum-take-out-known-integer-3
-  (implies (integerp n)
-           (and ;(equal (integerp (+ n x y))      ;this case not needed?
-                 ;      (integerp (fix (+ x y))))
-                (equal (integerp (+ x n y))
-                       (integerp (fix (+ x y))))
-                (equal (integerp (+ x y n))
-                       (integerp (fix (+ x y))))))
-  :hints (("Goal" :in-theory (disable integerp-sum-take-out-known-integer)
-           :use (:instance  integerp-sum-take-out-known-integer (x (+ x y))))))
-
-
-#|
- 
- simplify integerp of a product. see robert krug's meta rules on this subject
-
-|#
-
-(defthm integerp-prod
-  (implies (and (integerp x)
-                (integerp y))
-           (integerp (* x y)))
-  :rule-classes (:rewrite :type-prescription))
-
-;are these expensive?
-(defthm integerp-prod-of-3-last-two
-  (implies (and (integerp (* b c))
-                (integerp a))
-           (integerp (* a b c))))
-
-(defthm integerp-prod-of-3-first-and-last
-  (implies (and (integerp (* a c))
-                (integerp b))
-           (integerp (* a b c)))
-  :hints (("Goal" :in-theory (disable integerp-prod-of-3-last-two)
-           :use (:instance integerp-prod-of-3-last-two (a b) (b a)))))
-
-(defthm integerp-prod-of-3-first-two
-  (implies (and (integerp (* a b))
-                (integerp c))
-           (integerp (* a b c)))
-  :hints (("Goal" :in-theory (disable integerp-prod-of-3-last-two 
-                                      integerp-prod-of-3-first-and-last)
-           :use (:instance integerp-prod-of-3-last-two (a c) (c a)))))
-
-
-;forces the constant to be in the range [0,1)  (and for 0, will be simplified further)
-(defthm integerp-+-reduce-leading-constant
-  (implies (syntaxp (and (quotep k)
-                         (or (>= (cadr k) 1) (< (cadr k) 0))))
-           (equal (integerp (+ k x))
-                  (integerp (+ (+ k (- (floor k 1))) x))))) ;use mod?
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/inverted-factor.lisp acl2-6.3/books/rtl/rel5/arithmetic/inverted-factor.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/inverted-factor.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/inverted-factor.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,118 +0,0 @@
-(in-package "ACL2")
-
-;(local (include-book "meta/meta-times-equal" :dir :system))
-;(local (INCLUDE-BOOK "predicate"))
-;(local (INCLUDE-BOOK "fp2"))
-
-#|
-treat constants separately.  careful.  do we prefer (equal x 1/2) or (equal (* 2 x) 1) ?
-Now I think we definitely prefer (equal x 1/2) because this allows us to substitue for x.
-
-when this
- (+ 1 x (* 2 x) (* x y (/ z)))
- appears in an equality, we want to multiply through by z
-either returns nil or a term to multiply through
-
-this assumes the term is already normalized.  this will be the case if we call this function on, say (equal
-lhs rhs) because by the time the equal term is processed, lhs and rhs are each individually normalized
-not necessarily!
-
-
-warning; multiplying through by these factors can cause problems with linear arithmetic (expand on this...)
-
-watch out.  how do we handle (< x 1/2) ?  do we multiply through by 2?
-
-binds the variable k
-
-(This used to be called find-frac-coeff.)
-
-|#
-
-(defun find-inverted-factor (term)
-  (declare (xargs :guard (pseudo-termp term)))
-  (if (not (consp term)) ;term was a symbol
-      nil
-    (case (car term)	
-      (quote (if (integerp (cadr term)) 
-                 nil ;no denominator
-               (if (rationalp (cadr term))
-                   `((k . ',(denominator (cadr term))))
-                 nil)))  ;we found one!
-      (binary-+ (or (find-inverted-factor (cadr term))
-                    (find-inverted-factor (caddr term))))
-      (binary-* (or (find-inverted-factor (cadr term))
-                    (find-inverted-factor (caddr term))))
-      (unary-/ (list (cons 'k (cadr term)))) ;we found one!
-      (otherwise nil)
-      )))
-
-;todo: generalize this
-;TERM is a product containing FACTOR as (at least) one factor
-(defun is-a-factor (factor term)
-  (declare (xargs :guard (pseudo-termp term)))
-  (if (not (consp term)) ;term was a symbol
-      (equal factor term)
-    (case (car term)	
-      (binary-* (if (equal factor (cadr term))
-                    t
-                  (is-a-factor factor (caddr term))))
-      (otherwise (equal factor term)) ;anything else is not a prduct [what about a sum, each of whose addends is a multiple of FACTOR?]
-      )))
-
-
-;;
-;; Detect that distributity and assoc rules have fired
-;; (doesn't check that comm and comm-2 have fired)
-;;
-
-
-;Checks whether TERM is a factor, which we define as either a variable, or a call to a function other than *
-;or +
-;Some example factors: x  '3  (mod x y)  (/ x)  (/ (bits (* 2 x) i j))
-;our normal form requires that the arg to (/ ... ) not be a product!
-;it is basic to our normal form that (/ (* x y)) be rewritten to (* (/ x) (/ y))
-;we can now have the routine check whether the term is a quoted constant..
-(defun factor-syntaxp (term can-be-a-constant)
-  (declare (xargs :guard (pseudo-termp term)))
-  (if (not (consp term)) ;term was a symbol
-      t
-    (case (car term)	
-      (binary-* nil) ;associativity of * must not have fired (or we are in the (* x y) of a (/ (* x y))
-      (binary-+ nil) ;distributivity must not have fired...
-      (unary-/ (and (consp (cdr term))
-                    (factor-syntaxp (cadr term) nil)))
-      (quote can-be-a-constant)
-      (otherwise t))))
-
-
-;Checks whether TERM is a product of (1 or more) "factors".
-;Also checks that only the first factor (if any) is a constant...  (If the constants aren't collected, the 
-;term isn't yet normalized, and rules can loop). BOZO document why the cancelling rule is okay even though
-;constants are a little weird..
-(defun product-syntaxp (term first-factor-can-be-a-constant)
-  (declare (xargs :guard (pseudo-termp term)))
-  (if (not (consp term)) ;term was a symbol
-      t
-    (case (car term)	
-      (binary-* (and (factor-syntaxp (cadr term) first-factor-can-be-a-constant)
-                     (product-syntaxp (caddr term) nil)))
-;check that term is a single factor..
-      (otherwise (factor-syntaxp term first-factor-can-be-a-constant)))))
-
-;Checks whether TERM is a sum of one or more products..
-;rejects TERM if distributivity or associativity haven't fired yet.
-;i suppose we could check that the terms have been commutted into the right order, but we don't do that
-;either.
-;But we do check that only the first factor (if any) of each product is a constant...
-(defun sum-of-products-syntaxp (term)
-  (declare (xargs :guard (pseudo-termp term)))
-  (if (not (consp term)) ;term was a symbol
-      t
-    (case (car term)	
-      (binary-+ (and (product-syntaxp (cadr term) t)
-                     (sum-of-products-syntaxp (caddr term))))
-      (otherwise (product-syntaxp term t)))))
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/mod-expt.lisp acl2-6.3/books/rtl/rel5/arithmetic/mod-expt.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/mod-expt.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/mod-expt.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,322 +0,0 @@
-(in-package "ACL2")
-
-;one of these is still broken
-
-
-(include-book "power2p")
-
-
-;don't need everything in this book!
-(local (include-book "numerator"))
-(local (include-book "denominator"))
-(local (include-book "nniq"))
-(local (include-book "arith2"))
-(local (include-book "ground-zero"))
-(local (include-book "floor"))
-(local (include-book "integerp"))
-(local (include-book "rationalp"))
-(local (include-book "unary-divide"))
-(local (include-book "expt"))
-(local (include-book "expo"))
-(local (include-book "fl-expt"))
-(local (include-book "mod"))
-(local (include-book "fl"))
-
-(local (in-theory (enable expt-minus)))
-
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defthmd fl-shift-pull-inside-mod
-  (implies (and ;(rationalp x)
-                (<= j i) ;what if not?
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (FL (* (/ (EXPT 2 J))
-                         (MOD x (EXPT 2 i))))
-                  (mod (FL (* x (/ (EXPT 2 J))))
-                       (expt 2 (- i j)))))
-  :hints (("Goal" :in-theory (enable mod expt-split))))
-
-(defthm mod-integerp-when-y-is-power-of-2
-  (implies (integerp x)
-           (integerp (mod x (expt 2 i))))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :cases ((< i 0)))))
-
-;Helpful, since if we split exponents, the rule above may not fire.
-(defthm mod-integerp-when-y-is-power-of-2-gen
-  (implies (and (integerp x)
-                (syntaxp (power2-syntaxp y))
-                (force (power2p y)))
-           (integerp (mod x y)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable power2p-rewrite))))
-
-(encapsulate
- ()
- (local (defthm mod-pull-inside-fl-shift-usual-case
-          (implies (and (<= 0 i) ;this case
-;                (rationalp x)
-                        (case-split (integerp i)) ;may be droppable
-                        (case-split (integerp j))
-                        )
-                   (equal (mod (FL (* x (/ (EXPT 2 J))))
-                               (expt 2 i))
-                          (FL (* (/ (EXPT 2 J))
-                                 (MOD x (EXPT 2 (+ i j)))))))
-          :otf-flg t
-          :hints (("Goal" :use ((:instance fl-def-linear-part-1 (x (* X (/ (EXPT 2 I))
-                                                                      (/ (EXPT 2 J)))))
-                                (:instance fl-def-linear-part-2 (x (* X (/ (EXPT 2 I))
-                                                                      (/ (EXPT 2 J))))))
-                   :in-theory (set-difference-theories
-                               (enable mod expt-split)
-                               '(  FL-WEAK-MONOTONE
-                                   fl-def-linear-part-1
-                                   fl-def-linear-part-2)
-                               )))))
-
-
- (local (defthm mod-pull-inside-fl-shift-other-case
-          (implies (and (< i 0) ;this case
-;                (rationalp x)
-                        (case-split (integerp i))
-                        (case-split (integerp J))
-
-                        )
-                   (equal (mod (FL (* x (/ (EXPT 2 J))))
-                               (expt 2 i))
-                          (FL (* (/ (EXPT 2 J))
-                                 (MOD x (EXPT 2 (+ i j)))))))
-          :otf-flg t
-          :hints (("Goal" :use ((:instance <-transitive 
-                                           (a x)
-                                           (b (+ (* (EXPT 2 I) (EXPT 2 J))
-                                                 (* (EXPT 2 I)
-                                                    (EXPT 2 J)
-                                                    (FL (* X (/ (EXPT 2 I)) (/ (EXPT 2 J)))))))
-                                           (c (+ (EXPT 2 J)
-                                                 (* (EXPT 2 I)
-                                                    (EXPT 2 J)
-                                                    (FL (* X (/ (EXPT 2 I))
-                                                           (/ (EXPT 2 J))))))))
-                                (:instance fl-def-linear-part-1 (x (* X (/ (EXPT 2 I))
-                                                                      (/ (EXPT 2 J)))))
-                                (:instance fl-def-linear-part-2 (x (* X (/ (EXPT 2 I))
-                                                                      (/ (EXPT 2 J))))))
-                   :in-theory (set-difference-theories
-                               (enable mod expt-split)
-                               '(FL-WEAK-MONOTONE
-;                         expt-compare
-                                 fl-def-linear-part-1
-                                 fl-def-linear-part-2)
-                               )))))
-
-
-;Basic idea: mod chops off some high bits from x and fl chops off some low bits.  We can do the chops in
-;either order.
- (defthm mod-pull-inside-fl-shift
-   (implies (and ;no hyp about x
-             (case-split (integerp i))
-             (case-split (integerp j))
-             )
-            (equal (mod (fl (* x (/ (expt 2 j))))
-                        (expt 2 i))
-                   (fl (* (/ (expt 2 j))
-                          (mod x (expt 2 (+ i j)))))))
-   :otf-flg t
-   :hints (("goal" :cases ( (<= 0 i)))))
- )
-
-
-(defthm mod-pull-inside-fl-shift-alt
-  (implies (and ;(rationalp x)
-                (integerp i)
-                (integerp j)
-                )
-           (equal (mod (FL (* (/ (EXPT 2 J)) x))
-                       (expt 2 i))
-                  (FL (* (/ (EXPT 2 J))
-                         (MOD x (EXPT 2 (+ i j))))))))
-
-(defthm mod-pull-inside-fl-shift-alt-alt
-  (implies (and ;(rationalp x)
-                (integerp i)
-                (integerp j)
-                )
-           (equal (mod (FL (* (/ (EXPT 2 J)) x))
-                       (* 2 (expt 2 i)))
-                  (FL (* (/ (EXPT 2 J))
-                         (MOD x (EXPT 2 (+ i 1 j)))))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '(MOD-PULL-INSIDE-FL-SHIFT
-                                mod-pull-inside-fl-shift-alt))
-           :use (:instance mod-pull-inside-fl-shift
-                           (i (+ i 1))))))
-
-(defthm mod-pull-inside-fl-shift-alt-alt-alt
-  (implies (and ;(rationalp x)
-                (integerp j)
-                )
-           (equal (mod (FL (* (/ (EXPT 2 J)) x))
-                       2)
-                  (FL (* (/ (EXPT 2 J))
-                         (MOD x (EXPT 2 (+ 1 j)))))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '( MOD-PULL-INSIDE-FL-SHIFT
-                                 mod-pull-inside-fl-shift-alt
-                                 mod-pull-inside-fl-shift-alt-alt))
-           :use (:instance mod-pull-inside-fl-shift-alt-alt
-                           (i 0)))))
-
-(defthm mod-pull-inside-fl-shift-alt-alt-alt-alt
-  (implies (and ;(rationalp x)
-                (integerp j)
-                )
-           (equal (mod (FL (* x (/ (EXPT 2 J)))) ;factors commuted
-                       2)
-                  (FL (* (/ (EXPT 2 J))
-                         (MOD x (EXPT 2 (+ 1 j)))))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '( MOD-PULL-INSIDE-FL-SHIFT
-                                 mod-pull-inside-fl-shift-alt
-                                 mod-pull-inside-fl-shift-alt-alt
-                                 mod-pull-inside-fl-shift-alt-alt-alt))
-           :use (:instance mod-pull-inside-fl-shift-alt-alt
-                           (i 0)))))
-
-
-;gen and move?
-(defthm fl-mod-zero
-  (implies (and (<= i2 i1)
-                (integerp i1)
-                (integerp i2)
-                )
-           (equal (FL (* (/ (EXPT 2 i1))
-                         (MOD X (EXPT 2 i2))))
-                  0))
-
-  )
-
-
-
-;generalize?
-(defthm mod-pull-inside-fl-shift-alt-5
-  (implies (and; (rationalp x)
-                (integerp i)
-                (integerp j)
-                )
-           (equal (mod (FL (* (/ (EXPT 2 J)) x))
-                       (* 2 (expt 2 i)))
-                  (FL (* (/ (EXPT 2 J))
-                         (MOD x (EXPT 2 (+ 1 i j)))))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '(
-                               MOD-PULL-INSIDE-FL-SHIFT
-                               mod-pull-inside-fl-shift-alt
-                               mod-pull-inside-fl-shift-alt-alt
-                               mod-pull-inside-fl-shift-alt-alt-alt))
-           :use (:instance  mod-pull-inside-fl-shift-alt (i (+ i 1))))))
-
-
-(defthm mod-pull-inside-fl-shift-alt-6
-  (implies (and; (case-split (rationalp x))
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                )
-           (equal (mod (FL (* x (/ (EXPT 2 J))))
-                       (* 2 (expt 2 i) (/ (expt 2 k))))
-                  (FL (* (/ (EXPT 2 J))
-                         (MOD x (EXPT 2 (+ 1 (- k) i j)))))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '(
-                               MOD-PULL-INSIDE-FL-SHIFT
-                               mod-pull-inside-fl-shift-alt
-                               mod-pull-inside-fl-shift-alt-alt
-                               mod-pull-inside-fl-shift-alt-alt-alt
-                               ))
-           :use (:instance  mod-pull-inside-fl-shift-alt (i (+ i (- k) 1))))))
-
-;why disable?
-;use i and j
-(defthmd mod-mod-eric
-  (implies (and (<= i1 i2)
-                (case-split (integerp i1))
-                (case-split (integerp i2))
-                )
-           (= (mod (mod x (expt 2 i2)) (expt 2 i1))
-              (mod x (expt 2 i1)))))
-
-
-;conclude from something more general?
-; NOTE: This is now a corollary of mod-of-mod.  But we might as well retain the
-; original proof.
-(defthmd mod-of-mod-cor
-  (implies (and (<= b a)
-                (case-split (integerp b))
-                (case-split (integerp a))
-                )
-           (equal (mod (mod x (expt 2 a)) (expt 2 b))
-                  (mod x (expt 2 b))))
-  :hints (("Goal" :in-theory (enable mod-mod-eric)))
-  )
-
-
-
-#|
-
-nice rules?
-
-(local
- (defthm mod-2m-2n-k-1
-   (implies (and (integerp m) (>= m n)
-                 (integerp n) (> n k)
-                 (integerp k) (> k 0))
-            (= (mod (- (expt 2 m) (expt 2 (- n k)))
-                    (expt 2 n))
-               (mod (- (expt 2 n) (expt 2 (- n k)))
-                    (expt 2 n))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable  a15)
-            :use ((:instance mod-mult-eric
-                             (x (- (expt 2 n) (expt 2 (- n k))))
-                             (y (expt 2 n))
-                             (a (1- (expt 2 (- m n)))))
-                  (:instance expt-weak-monotone (n (- n k)) (m n)))))))
-
-(local
-(defthm mod-2m-2n-k-2
-    (implies (and (integerp n) (> n k)
-		  (integerp k) (> k 0))
-	     (= (mod (- (expt 2 n) (expt 2 (- n k)))
-		     (expt 2 n))
-		(- (expt 2 n) (expt 2 (- n k)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance mod-does-nothing (m (- (expt 2 n) (expt 2 (- n k)))) (n (expt 2 n)))
-			(:instance expt-weak-monotone (n (- n k)) (m n))))
-)))
-
-;nice rule?
-(local
- (defthm mod-2m-2n-k
-   (implies (and (integerp m) (>= m n)
-                 (integerp n) (> n k)
-                 (integerp k) (> k 0))
-            (= (mod (- (expt 2 m) (expt 2 (- n k)))
-                    (expt 2 n))
-               (- (expt 2 n) (expt 2 (- n k)))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance mod-2m-2n-k-1)
-                         (:instance mod-2m-2n-k-2))))))
-
-|#
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/mod-proofs.lisp acl2-6.3/books/rtl/rel5/arithmetic/mod-proofs.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/mod-proofs.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/mod-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1618 +0,0 @@
-(in-package "ACL2")
-
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ground-zero")
-(include-book "negative-syntaxp")
-
-(local (include-book "floor"))
-(local (include-book "arith2"))
-(local (include-book "power2p"))
-(local (include-book "fp2"))
-(local (include-book "arith"))
-(local (include-book "integerp"))
-(local (include-book "product"))
-(local (include-book "complex-rationalp"))
-(local (include-book "meta/meta-plus-equal" :dir :system))
-(local (include-book "meta/meta-plus-lessp" :dir :system))
-(local (include-book "predicate"))
-(local (include-book "rationalp"))
-
-
-#| 
-
-Todo: We could probably prove REM analogs for most of the rules in this book (since REM and MOD agree on a
-certain range of inputs), but we don't use REM much at all in the library (for good reason, thinks Eric), so
-perhaps this isn't worth spending time on.
-
-|#
-
-
-
-
-(defthm mod-rational-when-y-is-rational-rewrite
-  (implies (and (rationalp y)
-                (case-split (acl2-numberp x)))
-           (equal (rationalp (mod x y))
-                  (rationalp x)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-;mod when x is complex?
-
-(defthm mod-with-x-a-non-acl2-number-is-zero
-  (implies (not (acl2-numberp x))
-           (equal (mod x y)
-                  0))
-  :hints (("Goal" :in-theory (enable mod))))
-
-
-
-
-(defthmd mod-when-y-is-complex-rationalp
-  (implies (complex-rationalp y)
-           (equal (mod x y)
-                  (if (not (complex-rationalp x))
-                      (fix x)
-                    (if (not (rationalp (/ x y)))
-                        x
-                      (if (integerp (/ x y))
-                          0 
-                        (+ X (* -1 Y (FLOOR (* X (/ Y)) 1))) ;this case is gross (basically the defn of mod)
-                        )))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable mod))))
-
-;enable?
-(defthmd mod-when-y-is-not-an-acl2-numberp
-  (implies (not (acl2-numberp y))
-           (equal (mod x y)
-                  (fix x)))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable mod))))
-
-
-;we probably get this when mod is defined.  perhaps we should disable mod's t-p rule since this duplicates it. 
-(defthm mod-acl2-numberp-type-prescription
-  (acl2-numberp (mod x y))
-  :rule-classes (:type-prescription))
-
-;Perhaps we don't need this as a rewrite rule, but here it is anyway:
-(defthm mod-acl2-numberp
-  (acl2-numberp (mod x y)))
-
-;add a weaker vesion of this in case we can establish (rationalp x) but not (not (complex-rationalp x)) ?
-(defthm mod-rationalp
-  (implies (case-split (not (complex-rationalp x)))
-           (rationalp (mod x y)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :cases ((rationalp x))
-           :in-theory (enable mod))))
-
-;I weakened the hyp on x as much as possible and then weakened the hyps on y as much as possible.  (We might
-;get a different rule by doing the reverse of that.)
-(defthm mod-non-negative
-  (implies (and (case-split (< 0 y)) ;can't gen: (mod -1 0) = -1 and  (mod 3 -2) = -1
-                (case-split (not (complex-rationalp x))) ;can't gen: (mod #C(-4 -3) 1) = #c(-4 -3)
-                (case-split (not (complex-rationalp y))) ;can't gen: (mod -3 #c(1 1)) = -3
-                )
-           (<= 0 (mod x y)))
-  :hints (("Goal" :cases ((acl2-numberp y))
-           :in-theory (enable mod))))
-
-(defthm mod-non-negative-rationalp-type-prescription
-  (implies (and (case-split (< 0 y))                     
-                (case-split (not (complex-rationalp x))) 
-                (case-split (not (complex-rationalp y))) 
-                )
-           (and (<= 0 (mod x y))
-                (rationalp (mod x y)) ;we might as well include this
-                ))
-  :rule-classes ((:type-prescription :typed-term (mod x y))))
-
-(defthm mod-non-negative-linear
-  (implies (and (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (<= 0 (mod x y)))
-  :rule-classes ((:linear :trigger-terms ((mod x y)))))
-
-(defthm mod-upper-bound
-  (implies (and (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (< (mod x y) y))
-  :hints (("Goal" :in-theory (enable mod) :cases ((rationalp x)))))
-
-(defthm mod-upper-bound-linear
-  (implies (and (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (< (mod x y) y))
-  :rule-classes ((:linear :trigger-terms ((mod x y)))))
-
-;included to help a hyp which matches this rule's conclusion get written away quickly
-(defthm mod-upper-bound-less-tight-rewrite
-  (implies (and (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (<= (mod x y) y)))
-
-;do we need this?  is it expensive?
-(defthm mod-upper-bound-3
-  (implies (and (<= y z)
-                (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (< (mod x y) z)))
-
-(defthm mod-upper-bound-2
-  (implies (and (<= 0 x)
-                (case-split (not (complex-rationalp x)))
-                )
-           (<= (mod x y) x))
-  :rule-classes (:rewrite (:linear :trigger-terms ((mod x y))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthm mod-integerp
-  (implies (and (integerp x) ;can't gen: (mod 2/3   5)=2/3
-                (integerp y) ;can't gen: (mod 5   2/3)=1/3
-                )
-           (integerp (mod x y)))
-  :hints (("Goal" :in-theory (enable mod)))
-  :rule-classes (:rewrite :type-prescription))
-
-;what about when x is a known int?
-(defthm mod-integerp-2
-  (implies (and (integerp y)
-                (case-split (acl2-numberp x))
-                )
-           (equal (integerp (mod x y))
-                  (integerp x)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthm mod-0
-    (and (equal (mod 0 y)
-                0)
-         (equal (mod x 0)
-                (fix x)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthm mod-complex-rationalp-rewrite
-  (implies (case-split (rationalp y))
-           (equal (complex-rationalp (mod x y))
-                  (complex-rationalp x)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-;Don't make this a rewrite rule (we don't want to backchain to (< y 0) to establish (rationalp (mod x y))
-(defthm mod-non-positive-type-prescription
-  (implies (and (< y 0) ;rarely will be the case
-                (rationalp x)
-                (rationalp y)
-                )
-           (and (rationalp (mod x y))
-                (<= (mod x y) 0)))
-  :hints (("Goal" :in-theory (enable mod)))
-  :rule-classes (:type-prescription))
-
-(defthm mod-non-positive
-  (implies (and (< y 0) ;rarely will be the case
-                (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (<= (mod x y) 0)))
-
-;rewrite a claim about mod being non-positive to a claim about y?
-
-(local (include-book "fl")) ;drop?
-
-(defthm mod-drop-irrelevant-first-term
-  (implies (and (integerp (* k (/ y)))
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                (case-split (not (complex-rationalp x)))
-                )
-           (equal (mod (+ k x) y)
-                  (mod x y)))
-  :hints (("Goal"  :in-theory (enable mod))))
-
-(defthm mod-drop-irrelevant-second-term
-  (implies (and (integerp (* k (/ y)))
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                (case-split (not (complex-rationalp x)))
-                )
-           (equal (mod (+ x k) y)
-                  (mod x y))))
-
-(defthm mod-drop-irrelevant-second-term-with-more-terms
-  (implies (and (integerp (* k (/ y)))
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp x2)))
-                )
-           (equal (mod (+ x k x2) y)
-                  (mod (+ x x2) y))))
-
-(defthm mod-drop-irrelevant-third-term
-  (implies (and (integerp (* k (/ y)))
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp x2)))
-                )
-           (equal (mod (+ x x2 k) y)
-                  (mod (+ x x2) y))))
-
-;We could make analogs to MOD-DROP-IRRELEVANT-SECOND-TERM in which we drop the third, fourth, etc. term.
-
-(defthm mod-mult-eric
-  (implies (and (integerp a)
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y))) ;gen?
-                )
-           (equal (mod (+ x (* a y)) y)
-                  (mod x y))))
-
-;similar lemmas in mod.lisp
-;change params on the rest?
-
-;could we generalize (mod x2 y) to (* k (mod x2 y)) ??
-;I don't think we can drop either hyp.
-(defthm mod-sum-elim-second
-  (implies (and (case-split (not (complex-rationalp x1)))
-                (case-split (not (complex-rationalp x2))) 
-                )
-           (equal (mod (+ x1 (mod x2 y)) y)
-                  (mod (+ x1 x2) y)))
-  :hints (("Goal" :in-theory (enable mod)
-           :cases ((and (rationalp x2) (equal y 0) (rationalp x1))
-                   (and (rationalp x2) (equal y 0) (not (rationalp x1)))
-                   (and (rationalp x2) (not (equal y 0)) (rationalp x1))
-                   (and (rationalp x2) (not (equal y 0)) (not (rationalp x1)))
-                   (and (not (acl2-numberp x2)) (equal y 0) (rationalp x1))
-                   (and (not (acl2-numberp x2)) (equal y 0) (not (rationalp x1)))
-                   (and (not (acl2-numberp x2)) (not (equal y 0)) (rationalp x1))
-                   (and (not (acl2-numberp x2)) (not (equal y 0)) (not (rationalp x1)))))))
-
-(defthm mod-sum-elim-second-gen
-  (implies (and (integerp (/ y2 y))
-                (case-split (not (complex-rationalp x1)))
-                (case-split (not (complex-rationalp x2))) 
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                )
-           (equal (mod (+ x1 (mod x2 y2)) y)
-                  (mod (+ x1 x2) y)))
-  :hints (("Goal" :in-theory (enable mod)
-           :cases ((and (rationalp x2) (equal y 0) (rationalp x1))
-                   (and (rationalp x2) (equal y 0) (not (rationalp x1)))
-                   (and (rationalp x2) (not (equal y 0)) (rationalp x1))
-                   (and (rationalp x2) (not (equal y 0)) (not (rationalp x1)))
-                   (and (not (acl2-numberp x2)) (equal y 0) (rationalp x1))
-                   (and (not (acl2-numberp x2)) (equal y 0) (not (rationalp x1)))
-                   (and (not (acl2-numberp x2)) (not (equal y 0)) (rationalp x1))
-                   (and (not (acl2-numberp x2)) (not (equal y 0)) (not (rationalp x1)))))))
-
-
-;Follows from MOD-SUM-ELIM-SECOND
-(defthm mod-sum-elim-first
-  (implies (and (case-split (not (complex-rationalp a)))
-                (case-split (not (complex-rationalp b)))
-                )
-           (equal (mod (+ (mod b y) a) y)
-                  (mod (+ a b) y))))
-
-;Follows from MOD-SUM-ELIM-SECOND-GEN
-(defthm mod-sum-elim-first-gen
-  (implies (and (integerp (/ y2 y))
-                (case-split (not (complex-rationalp x1)))
-                (case-split (not (complex-rationalp x2))) 
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                )
-           (equal (mod (+ (mod x2 y2) x1) y)
-                  (mod (+ x1 x2) y))))
-
-;Follows from MOD-SUM-ELIM-SECOND and MOD-SUM-ELIM-FIRST
-;Do we really need this if we have the other two?
-(defthm mod-sum-elim-both
-  (implies (and (case-split (not (complex-rationalp a)))
-                (case-split (not (complex-rationalp b)))
-                )
-           (equal (mod (+ (mod a y) (mod b y)) y)
-                  (mod (+ a b) y))))
-
-;see mod-diff
-(defthm mod-difference-elim-second
-  (implies (and (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (mod (+ x1 (* -1 (mod x2 y))) y)
-                  (mod (+ x1 (* -1 x2)) y)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-;Follows from MOD-DIFFERENCE-ELIM-SECOND
-;bad name?
-(defthm mod-sum-elim-negative-first-arg
-  (implies (and (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (mod (+ (* -1 (mod x2 y)) x1) y)
-                  (mod (+ (* -1 x2) x1) y))))
-
-(defthm mod-by-1
-  (implies (integerp m)
-           (equal (mod m 1)
-                  0)))
-
-;I'm going to try keeping this disabled, since relieving the first hyp may be expensive.
-;rename: no more n!
-;(integerp (* x (/ y))) basically says that x is a multiple of y, which is 
-;basicially what (equal (mod x y) 0) says too.
-(defthmd mod-mult-of-n
-  (implies (and (integerp (* x (/ y)))
-                (not (equal y 0))
-                (rationalp x)
-                (rationalp y)
-                )
-           (equal (mod x y)
-                  0))
-  :hints (("goal" :in-theory (enable mod))))
-
-;prove a rule for negative x too?
-;try disabling?
-(defthmd mod-negative-y
-  (implies (and (< 0 y)
-                (integerp x)
-                (integerp y)
-                )
-           (equal (mod x (- y))
-                  (if (integerp (/ x y))
-                      0
-                    (+ (- y) (mod x y)))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-
-;BOZO
-;try disabling???
-(defthm mod-does-nothing
-  (implies (and (< m n)
-                (<= 0 m)
-                (case-split (rationalp m)))
-           (equal (mod m n)
-                  m))
-  :hints (("Goal" :in-theory (enable mod))))
-
-
-;better name
-;can derive mod-of-mod, mod-idempotent from this?
-;perhaps keep this disabled??
-(defthm mod-mod-e
-  (implies (and (integerp (/ y1 y2))
-                (case-split (not (equal y2 0)))
-                (case-split (rationalp y1))
-                (case-split (rationalp y2))
-                )
-           (equal (mod (mod x y1) y2)
-                  (mod x y2)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthm mod-of-mod
-  (implies (and (case-split (natp k))
-                (case-split (natp n)))
-           (equal (mod (mod x (* k n)) n)
-                  (mod x n))))
-
-;Follows from mod-mod-e and mod-by-0
-(defthm mod-idempotent
-  (implies (and (case-split (rationalp x)) ;(integerp x)
-                (case-split (rationalp y)) ;(integerp y)
-                )
-           (equal (mod (mod x y) y)
-                  (mod x y))))
-
-
-;cute; why does this help so much?
-;like quot-mod
-(defthm mod-fl-2
-  (implies (case-split (acl2-numberp x))
-           (equal (+ (* y (fl (/ x y))) (mod x y))
-                  x))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable floor-fl mod))))
-
-(defthm mod-def
-  (implies (case-split (acl2-numberp x))
-           (equal (mod x y)
-                  (- x (* y (fl (/ x y))))))
-  :hints (("Goal"
-           :in-theory (union-theories (current-theory :here)
-                                      (theory 'ground-zero))))
-  :rule-classes ())
-
-;a is a free var
-(defthmd mod-force-eric
-  (implies (and (<= (* a y) x)
-                (< x (* (1+ a) y))
-                (integerp a)
-                (rationalp x)
-                (rationalp y)
-                )
-           (equal (mod x y)
-                  (- x (* a y))))
-  :hints
-  (("goal" :in-theory (enable mod)
-    :use ((:instance fl-unique (x (/ x y)) (n a))))))
-
-
-
-;chose a in mod-force-eric to be -1
-;expensive?
-(defthmd mod-force-chosen-a-neg
-    (implies (and (< x 0)
-		  (<= (* -1 y) x)
-                  (rationalp x)
-                  (rationalp y)
-                  )
-	     (equal (mod x y)
-                    (- x (* -1 y))))
-    :hints (("Goal" :in-theory (disable mod-force-eric)
-         :use (:instance mod-force-eric (a -1)))))
-
-;gen?
-;or could rewrite to (equal 0 (mod x 2))
-(defthm mod-even
-  (implies (rationalp x)
-           (equal (integerp (* 1/2 (mod x 2)))
-                  (integerp (* 1/2 x))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-;gen 2 to m?
-(defthm mod-even-gen
-  (implies (and (rationalp x)
-                (integerp n)
-                (integerp (* 1/2 n)) ;address the other case?
-                )
-           (equal (integerp (* 1/2 (mod x n)))
-                  (integerp (* 1/2 x))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-
-;Enforces a new normal form for mod in which we force the second arg to be 1.
-;Maybe this is just a weird idea.
-;BOZO bad name?
-(defthmd mod-cancel
-  (implies (syntaxp (not (and (quotep y) (equal (cadr y) 1)))) ;prevents looping
-           (equal (mod x y)
-                  (if (acl2-numberp x)
-                      (if (acl2-numberp y)
-                          (if (equal 0 y)
-                              x
-                            (* y (mod (/ x y) 1)))
-                        x)
-                    0)))
-  :hints (("Goal" :in-theory (enable mod inverse-of-*)))
-  )
-
-
-;can derive at least 1 thm above from this?
-(defthmd mod-equal-0
-  (implies (and ;(case-split (rationalp x))
-                (case-split (rationalp y)) ;gen?
-                (case-split (not (equal y 0)))
-                )
-           (equal (equal (mod x y) 0)
-                  (integerp (* (/ y) x))))
-  :hints (("Goal" 
-           :in-theory (enable mod))))
-
-(defthmd mod-minus-case-non-integerp
-  (implies (and (not (integerp (/ x y)))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (equal (mod (* -1 x) y)
-                  (- y (mod x y))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthmd mod-minus-case-integerp
-  (implies (and (integerp (/ x y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (equal (mod (* -1 x) y)
-                  (- (mod x y))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthmd mod-minus-case-integerp-better
-  (implies (and (integerp (/ x y))
-                (case-split (not (equal 0 y)))
-                (case-split (rationalp y))
-                )
-           (equal (mod (* -1 x) y)
-                  0))
-  :hints (("Goal" :use (mod-minus-case-integerp mod-equal-0))))
-
-;old version
-;disable?
-(defthm mod-minus
-  (implies (and (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (equal (mod (* -1 x) y)
-                  (if (equal 0 y)
-                      (- x)
-                    (if (integerp (/ x y))
-                        0
-                      (- y (mod x y))))))
-  :hints (("Goal" :in-theory (e/d ( mod-minus-case-integerp-better
-                                    mod-minus-case-non-integerp)
-                                  ())
-           :cases ((integerp (/ x y))))))  
-
-(defthm mod-minus-alt
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (equal (mod x y)
-                  (if (equal 0 y)
-                      x
-                    (if (integerp (/ (- x) y))
-                        0
-                      (- y (mod (- x) y))))))
-           :hints (("Goal" :in-theory (disable mod-minus) :use (:instance mod-minus (x (- x))))))
-
-(defthm mod-1-integerp
-  (implies (case-split (acl2-numberp x))
-           (equal (integerp (mod x 1))
-                  (integerp x)))
-  :hints (("Goal" :in-theory (enable mod)))
-  )
-
-
-
-
-; needs fl-of-odd/2
-;keep this disabled
-;gen?
-(defthmd mod-by-2-rewrite-to-even
-  (implies (integerp x)
-           (equal (equal (mod x 2) 0)
-                  (integerp (* 1/2 x))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthm fl-plus-md
-  (implies (rationalp x)
-           (equal (+ (fl x) (mod x 1))
-                  x))
-  :hints (("Goal" :in-theory (enable mod))))
-
-;sort of an odd rule...
-(defthm mod-1-sum-integer
-  (implies (and (rationalp x)
-                (rationalp y))
-           (equal (integerp (+ x (mod y 1)))
-                  (integerp (+ x y))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-;needed?
-;expensive?
-#|
-??
-ex:   (INTEGERP (* (/ (EXPT 2 J))
-               (MOD X (* 2 (EXPT 2 I)))))
-|#
-;bad name?
-(defthm mod-quotient-integerp
-  (implies (and (integerp (* y k))
-                (rationalp x)
-                (rationalp y)
-                (rationalp k)
-                )
-           (equal (integerp (* k (mod x y)))
-                  (integerp (* k x))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-
-
-
-
-
-
-;gen
-;may someday subsume mod-idempotent
-(defthm mod-mod-2-thm
-  (implies (and (<= y1 y2)
-;test                (case-split (<= 0 y2))
-                (case-split (< 0 y1))                 ;drop?
-                (case-split (acl2-numberp x)) ;gen?
-                (case-split (rationalp y1))
-                (case-split (rationalp y2))
-                (case-split (not (equal y1 0)))
-                )
-           (equal (mod (mod x y1) y2)
-                  (mod x y1)))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable mod))))
-
-
-
-
-;keep disabled?
-(defthmd mod-2-1-means-odd
-  (implies (integerp x)
-           (equal (equal (mod x 2) 1)
-                  (not (integerp (* 1/2 x)))))
-  :hints (("Goal" :in-theory (enable mod))))
-
-;unlikely to fire automatically
-;make a t-p rule too?
-(defthm mod-integerp-2-2
-  (implies (and (integerp y)
-                (integerp x))
-           (integerp (mod x (/ y))))
-  :hints (("Goal" :cases ((equal 0 y))
-           :in-theory (enable mod))))
-
-
-;like mod-prod?
-(defthm mod-cancel-special-1
-  (implies (and (acl2-numberp x)
-                (rationalp k)
-                (acl2-numberp y)
-                (not (equal y 0))
-                (not (equal k 0)))
-           (equal (mod (* k x)
-                       (* y k))
-                  (* k (mod x y))))
-  :hints (("goal" :in-theory (enable mod-cancel))))
-
-;move up
-;expensive?
-(defthm mod-integerp-when-y-is-an-inverse
-  (implies (and (integerp (/ y))
-                (integerp x))
-           (integerp (mod x y)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-;this is a bit odd..
-(defthm mod-when-y-is-an-inverse
-  (implies (and (integerp (/ y))
-                (integerp x)
-                (case-split (< 0 y))
-                )
-           (equal (mod x y)
-                  0))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthm fl-mod-x-1
-  (equal (fl (mod x 1)) 
-         0))
-
-(defthmd mod-by-2
-  (implies (integerp x)
-           (equal (mod x 2)
-                  (if (integerp (* 1/2 x))
-                      0
-                    1)))
-  :hints (("Goal" :in-theory (enable mod-by-2-rewrite-to-even mod-2-1-means-odd))))
-
-
-
-
-
-#|
-(defthm mod-with-y-not-rational
-  (implies (and (acl2-numberp x)
-                (not (rationalp y)))
-           (equal (mod x y)
-                  x))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthm mod-negative-rewrite
-  (implies (and ;(< 0 y)
-                (case-split (rationalp y))
-                (case-split (rationalp x)))
-           (implies (< (mod x y) 0)
-                    (and (not (integerp (* x (/ y))))
-                         (< y 0)
-                         )))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (enable mod)))
-)
-
-
-not done
-(defthm mod-of-complex
-  (implies (complex-rationalp x)
-           (equal (mod x y)
-                  xx))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable mod)
-           :cases ((rationalp y) (not (acl2-numberp y))))))
-|#
-
-
-
-
-(encapsulate
- ()
- (local (defthm mod-sum-move-forward-implication
-          (implies (and (case-split (<= 0 k1))
-                        (case-split (< k1 y))
-                        (rationalp y)
-                        (rationalp x)
-                        (rationalp k1)
-                        )
-                   (implies (equal k1 (mod (+ k2 x) y))
-                            (equal (mod (+ k1 (- k2)) y) (mod x y))))
-          :rule-classes nil
-          ))
-
- (local (defthm mod-sum-move-backward-implication
-          (implies (and (case-split (<= 0 k1))
-                        (case-split (< k1 y))
-                        (rationalp y)
-                        (rationalp x)
-                        (rationalp k1)
-                        )
-                   (implies (equal (mod (+ k1 (- k2)) y) (mod x y))
-                            (equal k1 (mod (+ k2 x) y))))
-          :rule-classes nil
-          :hints (("Goal" :use ((:instance mod-sum-move-forward-implication
-                                           (k1 (mod x y))
-                                           (x k1)
-                                           (k2 (- k2))
-                                           ))))))
-
-;I put this in :rule-classes nil, because it can loop if it is a rewrite rule..
- (defthm mod-sum-move
-   (implies (and (case-split (<= 0 k1))
-                 (case-split (< k1 y))
-                 (case-split (rationalp y))
-                 (case-split (rationalp x))
-                 (case-split (rationalp k1))
-;(rationalp k2)
-                 )
-            (equal (equal k1 (mod (+ k2 x) y))
-                   (equal (mod (+ k1 (- k2)) y) (mod x y))))
-   :rule-classes nil
-   :hints (("Goal" :use (mod-sum-move-forward-implication
-                         mod-sum-move-backward-implication)))))
-
-
-;Unlike the above, this rule shouldn't loop; since k1 and k2 are constants and we compute (+ k1 (- k2)) in the
-;conclusion...
-(defthm mod-sum-move-constants
-  (implies (and (syntaxp (and (quotep k1)
-                              (quotep k2)
-;                              (quotep y)  ;drop?
-                              )
-                         )
-                (case-split (<= 0 k1))
-                (case-split (< k1 y))
-                (rationalp y)
-                (rationalp x)
-                (rationalp k1)
-    ;(rationalp k2)
-                )
-           (equal (equal k1 (mod (+ k2 x) y))
-                  (equal (mod (+ k1 (- k2)) y) (mod x y))))
-  :hints (("Goal" :use mod-sum-move)))
-
-
-
-;BOZO don't need some of these?
-(defthm mod-sums-cancel-1
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (equal (mod (+ k x1) y) (mod (+ k x2) y))
-                  (equal (mod x1 y) (mod x2 y))))
-  :hints (("Goal" :use (:instance mod-sum-move (k2 k) (x x2) (k1 (mod (+ k x1) y))))))
-
-(defthm mod-sums-cancel-2
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (equal (mod (+ x1 k) y) (mod (+ k x2) y))
-                  (equal (mod x1 y) (mod x2 y)))))
-
-(defthm mod-sums-cancel-3
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (equal (mod (+ x1 k) y) (mod (+ x2 k) y))
-                  (equal (mod x1 y) (mod x2 y)))))
-
-;don't need this one..?
-(defthm mod-sums-cancel-4
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (equal (mod (+ k x1) y) (mod (+ x2 k) y))
-                  (equal (mod x1 y) (mod x2 y)))))
-
-(defthm mod-sums-cancel-5
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                )
-           (equal (equal (mod k y) (mod (+ x k) y))
-                  (equal 0 (mod x y))))
-  :hints (("Goal" :use (:instance mod-sums-cancel-4 (x1 0) (x2 x)))))
-
-(defthm mod-sums-cancel-6
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                )
-           (equal (equal (mod k y) (mod (+ k x) y))
-                  (equal 0 (mod x y))))
-  :hints (("Goal" :use (:instance mod-sums-cancel-4 (x1 0) (x2 x)))))
-
-;don't need this one..?
-(defthm mod-sums-cancel-7
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                )
-           (equal (equal (mod (+ k x) y) (mod k y))
-                  (equal 0 (mod x y))))
-  :hints (("Goal" :use (:instance mod-sums-cancel-4 (x1 0) (x2 x)))))
-
-;don't need this one..?
-(defthm mod-sums-cancel-8
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                )
-           (equal (equal (mod (+ x k) y) (mod k y))
-                  (equal 0 (mod x y))))
-  :hints (("Goal" :use (:instance mod-sums-cancel-4 (x1 0) (x2 x)))))
-  
-
-
-
-#|
-;weird case
-;not quite right
-(thm
- (implies (and ;(<= 0 x1)
-               ;(<= 0 x2)
-               (rationalp x1)
-               (rationalp x2)
-               (rationalp y)
-               (<= 0 y)
-               (< x1 0)
-               (< 0 x2)
-               (< (+ x1 x2) 0)
-               (< (- y) (+ x1 x2))
-               )
-          (equal (+ (mod x1 y) (mod x2 y))
-                 (+ y (mod (+ x1 x2) y))))
- :hints (("Goal" :in-theory (enable  mod-force-chosen-a-neg)))
- )
-|#
-
-
-(defthm fl-mod-equal
-  (implies (and (equal (fl (/ x 2)) (fl (/ y 2)))
-                (equal (mod x 2) (mod y 2))
-                (acl2-numberp x)
-                (acl2-numberp y)
-                )
-           (equal x y))
-  :hints (("goal" :in-theory (enable mod)))
-  :rule-classes nil)
-
-
-#|
-
-;there are many ways to say that x is even.  perhaps we should forward chain from any of them to each of the others.
-(defthmd blah
-  (equal (equal (mod x 2) 0)
-         (evenp x))
-  :hints (("Goal" :in-theory (enable evenp mod-equal-0)))
-  )
-
-(defthm mod-of-1-plus-even
-  (equal (mod (+ 1 (* 2 x)) y)
-	 (+ 1 (* 2 (mod x (/ y 2)))))
-  :hints (("Goal" :in-theory (e/d (mod)
-                                  (LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE)))))
-
-|#
-
-
-
-;====
-
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-
-
-
-;comes from mod-upper-bound
-(defthmd mod-bnd-1
-  (implies (and (case-split (< 0 n))
-                (case-split (not (complex-rationalp m)))
-                (case-split (not (complex-rationalp n)))
-                )
-           (< (mod m n) n))
-  :rule-classes :linear)
-
-;why not just enable mod whenever we'd use this rule?
-;make an alternate definition of MOD in terms of FL?
-(defthm quot-mod
-  (implies (case-split (acl2-numberp m))
-           (equal (+ (* n (fl (/ m n))) (mod m n))
-                  m))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (mod floor-fl)))))
-
-;proved in mod2
-;like old mod+-thm
-;make alt
-(defthm mod-mult-eric
-  (implies (and (integerp a)
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y))) ;gen?
-                )
-           (equal (mod (+ x (* a y)) y)
-                  (mod x y))))
-
-
-
-(defthm integerp-mod
-    (implies (and (integerp m)
-		  (integerp n))
-	     (integerp (mod m n)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable mod))))  
-
-(defthm rationalp-mod
-  (implies (case-split (rationalp x))
-           (rationalp (mod x y)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable mod))))
-
-
-;better conclusion?
-;this follows pretty trivially from quot-mod
-;never used in support/
-(defthm mod-0-fl
-    (implies (acl2-numberp m)
-	     (iff (= (mod m n) 0)
-		  (= m (* (fl (/ m n)) n))))
-  :rule-classes ()
-  :hints (("goal" :use (quot-mod))))
-
-
-;wow! this just goes through!
-(defthm mod-0-0
-  (implies (and (integerp p)
-                (rationalp m)
-                (rationalp n)
-                )
-           (iff (= (mod m (* n p)) 0)
-                (and (= (mod m n) 0)
-                     (= (mod (fl (/ m n)) p) 0))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable mod))))
-
-;BOZO more like this?
-(defthmd mod-prod
-  (implies (and (rationalp m)
-                (rationalp n)
-                (rationalp k)
-                )
-           (equal (mod (* k m) (* k n))
-                  (* k (mod m n))))
-  :hints (("goal" :in-theory (enable mod-cancel))))
-
-(defthm mod012
-  (implies (integerp m)
-           (or (equal (mod m 2) 0)
-               (equal (mod m 2) 1)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance mod-bnd-1 (m m) (n 2))))))
-
-;gen the 2?
-;bad name?
-(defthm mod-mod-2-not-equal
-   (implies (acl2-numberp m) ;(integerp m)
-            (not (= (mod m 2) (mod (1+ m) 2))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance quot-mod (m m) (n 2))
-                         (:instance quot-mod (m (1+ m)) (n 2))))))
-
-;change the formals on these?
-;these are from mod2
-(encapsulate
- ()
- (defthmd mod-sum
-   (implies (and (rationalp a)
-                 (rationalp b)
-                 )
-            (equal (mod (+ a (mod b n)) n)
-                   (mod (+ a b) n))))
-
- (defthm mod-mod-sum
-   (implies (and (rationalp a)
-                 (rationalp b)
-                 )
-            (equal (mod (+ (mod a n) (mod b n)) n)
-                   (mod (+ a b) n))))
-;BOZO
- (defthmd mod-bnd-2
-   (implies (and (<= 0 m)
-                 (case-split (rationalp m))
-                 )
-            (<= (mod m n) m))  
-   :rule-classes :linear)
-
- )
-
-;BOZO make this into a better rewrite rule (and generalize)
-;this is sort of a cancellation rule
-;prove from my mod cancellation rules?
-(defthm mod-plus-mod-2
-  (implies (and (integerp a)
-                (integerp b))
-           (iff (= (mod (+ a b) 2) (mod a 2))
-                (= (mod b 2) 0)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (e/d (mod-mult-of-n)
-                                  (MOD-SUM-ELIM-SECOND
-                                   MOD-DROP-IRRELEVANT-SECOND-TERM
-                                   MOD-2-1-MEANS-ODD
-                                   ))
-           :use ((:instance mod012 (m b))
-                 (:instance mod-sum (a a) (b b) (n 2))
-                 (:instance mod-mod-2-not-equal)))))
-
-;bad name
-;The only multiple of N between 0 and 2N is N itself.
-(defthm mod-must-be-n
-    (implies (and (= (mod m n) 0)
-                  (< m (* 2 n))
-		  (< 0 m)
-                  (rationalp m);(integerp m)
-		  (rationalp n);(integerp n)
-		  )
-	     (= m n))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable  MOD-does-nothing)
-           :use ((:instance mod-does-nothing (m m) (n n))
-                 (:instance mod-does-nothing (n n) (m (- m n)))
-;			(:instance mod+-thm (m (- m n)) (a 1))
-                 ))))
-
-;We need this here so that ACL2 knows how to make natp-mod into a type-prescription rule.
-(defthm natp-compound-recognizer
-  (equal (natp x)
-         (and (integerp x)
-              (<= 0 x)))
-  :rule-classes :compound-recognizer)
-
-
-;drop?
-(defthm natp-mod
-  (implies (and (natp m)
-                (natp n))
-           (natp (mod m n)))
-  :rule-classes ((:type-prescription :typed-term (mod m n)))
-  :hints (("Goal" :use (:instance mod-non-negative (x m) (y n)))))
-           
-(defthm natp-mod-rewrite
-  (implies (and (natp m)
-                (natp n))
-           (natp (mod m n))))
-
-;BOZO kill ;gen?  make alt?
-;see mod-mult-eric
-(defthmd mod-mult
-    (implies (and (integerp a)
-                  (rationalp m)
-		  (rationalp n))
-	     (equal (mod (+ m (* a n)) n)
-		    (mod m n)))
-  :hints (("Goal" ;:use mod+-thm
-           )))
-
-;gen?
-;essentially  mod-difference-elim-second
-(defthmd mod-diff
-    (implies (and (case-split (rationalp a))
-                  (case-split (rationalp b))
-                  )
-	     (equal (mod (- a (mod b n)) n)
-		    (mod (- a b) n))))
-
-
-;this doesn't seem to be used anywhere
-(defthmd mod-bnd-3
-    (implies (and (< m (+ (* a n) r))
-		  (<= (* a n) m)
-                  (integerp a)
-                  (case-split (rationalp m))
-		  (case-split (rationalp n))
-		  )
-	     (< (mod m n) r))
-  ;; Free variables make this rule very weak, but it seems harmless
-  ;; enough to make it a :linear rule.
-  :rule-classes :linear
-  :hints (("goal" :in-theory (disable FL-<-INTEGER) ;why needed?
-           :use ((:instance quot-mod)
-			(:instance n<=fl-linear (x (/ m n)) (n a))))))
-
-(defthm mod-force
-  (implies (and (<= (* a n) m)
-                (< m (* (1+ a) n))
-                (integerp a)
-                (rationalp m)
-                (rationalp n)
-                )
-           (= (mod m n) (- m (* a n))))
-  :rule-classes nil :hints
-  (("goal" :use
-    ((:instance quot-mod)
-     (:instance fl-unique (x (/ m n)) (n a))))))
-
-
-(local
- (defthm mod=mod-1
-   (implies (and (= (mod a n) (mod b n))
-                 (rationalp a) ; (>= a 0)
-                 (rationalp b); (>= b 0)
-;                 (integerp n) ;(> n 0)
-                 )
-            (= (- a (* n (fl (/ a n))))
-               (- b (* n (fl (/ b n))))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance quot-mod (m a))
-                         (:instance quot-mod (m b)))))))
-
-(local
- (defthm mod=mod-2
-   (implies (and (= (mod a n) (mod b n))
-                 (rationalp a) ; (>= a 0)
-                 (rationalp b) ; (>= b 0)
-;                 (integerp n) ;(> n 0)
-                 )
-            (= (- a b) (* n (- (fl (/ a n)) (fl (/ b n))))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance mod=mod-1))))))
-
-(local
- (defthm hack-m10
-   (implies (and (rationalp a) (rationalp b) (rationalp c) (> b 0) (= a (* b c)))
-            (= (/ a b) c))
-   :rule-classes ()))
-
-(local
- (defthm mod=mod-3
-   (implies (and (= (mod a n) (mod b n))
-                 (rationalp a) ; (>= a 0)
-                 (rationalp b); (>= b 0)
-;                 (integerp n) ;(> n 0)
-                 )
-            (= (/ (- a b) n) (- (fl (/ a n)) (fl (/ b n)))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance mod=mod-2)
-                         (:instance hack-m10 (a (- a b)) (b n) (c (- (fl (/ a n)) (fl (/ b n))))))))))
-
-; If A and B are congruent mod N, then their difference is a multiple of N; and conversely.
-; First, the forward direction.
-
-(defthm mod-equal-int
-  (implies (and (= (mod a n) (mod b n))
-                (rationalp a)
-                (rationalp b))
-           (integerp (/ (- a b) n)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance mod=mod-3)))))
-
-(local
- (defthm mod-equal-int-reverse-1
-   (implies (and (rationalp a)
-                 (rationalp b))
-            (equal (integerp (/ (- a b) n))
-                   (integerp (/ (- (mod a n) (mod b n))
-                                n))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance mod-def
-                                    (x a) (y n))
-                         (:instance mod-def
-                                    (x b) (y n)))))))
-
-(local
- (defthm mod-equal-int-reverse-2
-   (implies (and (rationalp a)
-                 (rationalp b))
-            (equal (integerp (/ (- a b) n))
-                   (integerp (/ (- (mod a n) (mod b n))
-                                n))))
-   :rule-classes ()
-   :hints (("goal" :use mod-equal-int-reverse-1))))
-
-(local
- (defthm mod-equal-int-reverse-3-1-1-1
-   (implies (and (rationalp i)
-                 (<= 0 i)
-                 (rationalp n)
-                 (< i n))
-            (implies (integerp (/ i n))
-                     (= i 0)))
-   :rule-classes nil))
-
-(local
- (defthm mod-equal-int-reverse-3-1-1
-   (implies (and (rationalp i)
-                 (rationalp n)
-                 (< (abs i) n))
-            (implies (integerp (/ i n))
-                     (= i 0)))
-   :hints (("Goal" :use (mod-equal-int-reverse-3-1-1-1
-                         (:instance mod-equal-int-reverse-3-1-1-1
-                                    (i (- i))))))
-   :rule-classes nil))
-
-(local
- (defthm mod-equal-int-reverse-3-1
-   (implies (and (rationalp i)
-                 (<= 0 i)
-                 (rationalp j)
-                 (<= 0 j)
-                 (rationalp n)
-                 (< i n)
-                 (< j n))
-            (implies (integerp (/ (- i j) n))
-                     (= i j)))
-   :hints (("Goal" :use ((:instance mod-equal-int-reverse-3-1-1
-                                    (i (- i j))))))
-   :rule-classes nil))
-
-(local
- (defthm mod-equal-int-reverse-3
-   (implies (and (rationalp a)
-                 (rationalp b)
-                 (rationalp n)
-                 (< 0 n))
-            (implies (integerp (/ (- a b) n))
-                     (= (mod a n) (mod b n))))
-   :rule-classes ()
-   :hints (("goal" :use (mod-equal-int-reverse-2
-                         (:instance mod-equal-int-reverse-3-1
-                                    (i (mod a n))
-                                    (j (mod b n))))))))
-
-(local
- (defthm mod-equal-int-reverse-4
-   (implies (and (rationalp a)
-                 (rationalp b)
-                 (rationalp n)
-                 (< 0 n))
-            (implies (= (mod a n) (mod b n))
-                     (integerp (/ (- a b) n))))
-   :rule-classes ()
-  :hints (("goal" :use (mod=mod-3)))))
-
-(defthm mod-equal-int-reverse
-  (implies (and (integerp (/ (- a b) n))
-                (rationalp a)
-                (rationalp b)
-                (rationalp n)
-                (< 0 n))
-           (= (mod a n) (mod b n)))
-  :rule-classes ()
-  :hints (("goal" :use (mod-equal-int-reverse-3 mod-equal-int-reverse-4))))
-
-(defthmd mod-mult-2
-  (implies (integerp a)
-           (equal (mod (* a n) n)
-                  0))
-  :hints (("goal" :in-theory (enable mod-when-y-is-complex-rationalp)
-           :use ((:instance mod-mult-eric (x 0) (y n))
-                 ))))
-
-(defthmd mod-mult-2-alt
-  (implies (integerp a)
-           (equal (mod (* n a) n)
-                  0))
-  :hints (("Goal" :in-theory (enable mod-mult-2))))
-
-(defthmd mod-mult-n
-  (equal (mod (* a n) n)
-         (* n (mod a 1)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthmd mod-mult-n-commuted
-  (equal (mod (* n a) n)
-         (* n (mod a 1)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthm mod-0-int
-  (implies (and (integerp m)
-                (integerp n)
-                (not (= n 0)))
-           (iff (= (mod m n) 0)
-                (integerp (/ m n))))
-  :hints (("Goal" :use ((:instance mod-equal-int
-                                   (a m) (b 0) (n n))
-                        quot-mod)))
-  :rule-classes ())
-
-;rename params on these:
-
-;just a special case of mod-mult-2-alt
-;generalize?
-;; Rule A3 in fp.lisp suggests using (* 2 i) instead of
-;; (+ i i).
-(defthm mod-2*i
-  (implies (integerp i)
-           (equal (mod (* 2 i) 2)
-                  0))
-  :hints (("Goal" :in-theory (enable mod-mult-2-alt))))
-
-;gen the 2?
-(defthm mod-2*m+1-rewrite
-  (implies (integerp m)
-           (equal (mod (1+ (* 2 m)) 2)
-                  1)))
-
-;eliminate this
-;in fact, it equals 1!
-(defthm mod-2*i+1
-  (implies (integerp i)
-           (not (equal (mod (1+ (* 2 i)) 2)
-                       0))))
-
-(defun INDUCT-NAT (x)
-  (if (and (integerp x)
-	   (> x 0))
-      (induct-nat (1- x))
-    ()))
-
-
-(local (defthm nk>=k-1
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp k)
-		  (> k 0)
-		  (not (= (* n k) 0))
-                  )
-	     (>= (* n k) k))
-  :rule-classes ()
-  :hints (("goal" :induct (induct-nat n)))
-   ))
-
-(local (defthm nk>=k-2
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp k)
-		  (> k 0)
-		  (not (= (* n k) 0)))
-	     (>= (abs (* n k)) k))
-  :rule-classes ()
-  :hints (("goal" :use (nk>=k-1)))))
-
-
-
-
-
-(local (defthm nk>=k-3
-    (implies (and (integerp n)
-		  (<= n 0)
-		  (integerp k)
-		  (> k 0)
-		  (not (= (* n k) 0)))
-	     (>= (abs (* n k)) k))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance nk>=k-2 (n (- n))))))))
-
-;BOZO move or drop?
-(defthm nk>=k
-    (implies (and (integerp n)
-		  (integerp k)
-		  (> k 0)
-		  (not (= (* n k) 0)))
-	     (>= (abs (* n k)) k))
-  :rule-classes ()
-  :hints (("goal" :use (nk>=k-2 nk>=k-3))))
-
-;BOZO gen?
-;not used anywhere but exported by lib/basic
-(defthm mod-force-equal
-  (implies (and (< (abs (- a b)) n)
-                (rationalp a) ;                  (natp a)
-                (rationalp b) ;(natp b)
-                (integerp n) ;(rationalp n) ;(natp n)
-                )
-           (iff (= (mod a n) (mod b n))
-                (= a b)))
-  :rule-classes ()
-  :hints (("goal" :use ( mod-equal-int
-                         (:instance nk>=k (k n) (n (/ (- a b) n)))
-;			(:instance *cancell (x a) (y b) (z n))
-                         ))))
-
-
-;yuck? BOZO used anywhere?
-(defthm nk>=k-linear
-    (implies (and (integerp n)
-		  (integerp k)
-		  (not (= n 0)))
-	     (>= (abs (* n k)) k))
-  :rule-classes :linear
-  :hints (("Goal" :use nk>=k)))
-
-
-;BOZO more like this.  get rid of mod-mult-alt-2?
-(defthm mod-mult-2-gen
-  (equal (mod (* a n) n)
-         (* n (mod a 1)))
-  :hints (("Goal" :in-theory (enable mod-cancel))))
-(defthm mod-mult-2-alt-gen
-  (equal (mod (* n a) n)
-         (* n (mod a 1)))
-  :hints (("Goal" :in-theory (enable mod-cancel))))
-
-#|
-(defthm mod-sum-subst
-  (implies (and (syntaxp (not (quotep z)))
-                (equal (mod z y) k)
-                (syntaxp (quotep k))
-                (rationalp z)
-                (rationalp x)
-                )
-           (equal (mod (+ x z) y)
-                  (mod (+ x k) y)))) 
-                        
-
-(defthm mod-split-around-zero
-  (implies (and (< x y)
-                (< (* -1 y) x)
-                (case-split (rationalp x))
-                (case-split (rationalp y)))
-           (equal (mod x y)
-                  (if (< x 0) 
-                      (+ x y)
-                      x)))
-  :hints (("Goal" :in-theory (enable mod-does-nothing  mod-force-chosen-a-neg)))
-)
-
-(defthm hack-ky
-  (implies (and; (syntaxp (and (quotep k) (quotep y)))
-                (< k y)
-                (<= 0 k)
-                ;(<= 0 y)
-                (rationalp x)
-                (rationalp y)
-                (rationalp k)
-                )
-           (equal (mod (+ k x) y)
-                  (if (< (+ k (mod x y)) y)
-                      (+ k (mod x y))
-                    (+ (- k y) (mod x y)))))
-  :hints (("Goal" :use((:instance mod-does-nothing (m (+ k (mod x y))) (n y))
-                       (:instance mod-does-nothing (m (+ (- k y) (mod x y))) (n y)))
-           :in-theory (disable mod-does-nothing)))
-  )
-
-(defthm mod-normalize-leading-constant
-  (implies (and (syntaxp (and (quotep k)
-                              (or (< (cadr k) 0)
-                                  (<= (cadr y) (cadr k)))))
-                (syntaxp (quotep y))
-                (rationalp k)
-                (rationalp x)
-                (rationalp y)
-                )
-           (equal (mod (+ k x) y)
-                  (mod (+ (mod k y) x) y))))
-
-
-
-
-(defthm hack
-  (equal (INTEGERP (* 1/8 x))
-         (equal 0 (mod x 8)))
-  :hints (("Goal" :in-theory (enable mod)))
-)
-
-
-
-|#
-
-
-(defthm fl-mod
-  (implies (and (rationalp x)
-                (natp y)
-                )
-           (equal (fl (mod x y))
-                  (mod (fl x) y)))
-  :hints (("Goal" :in-theory (enable mod)))
-  )
-
-; a powerful rule!
-(defthmd mod-sum-cases
-  (implies (and; (syntaxp (and (quotep k) (quotep y)))
-;                (< k y)
-;                (<= 0 k)
-                (<= 0 y)
-                (rationalp x)
-                (rationalp y)
-                (rationalp k)
-                )
-           (equal (mod (+ k x) y)
-                  (if (< (+ (mod k y) (mod x y)) y)
-                      (+ (mod k y) (mod x y))
-                    (+ (mod k y) (mod x y) (* -1 y)))))
-  :otf-flg t
-  :hints (("Goal" :use((:instance mod-does-nothing (m (+ (mod k y) (mod x y))) (n y))
-                       (:instance  mod-force-eric (a 1) (x (+ (MOD K Y) (MOD X Y))))
-                       )
-           :in-theory (disable mod-does-nothing)))
-  )
-
-
-
-;BOZO move
-(defthmd mod-fl-eric
-  (implies (and (<= 0 y)
-                (integerp y)
-                )
-           (equal (mod (fl x) y)
-                  (fl (mod x y))))
-  :hints (("Goal" :use (:instance fl/int-rewrite (n y))
-           :in-theory (enable mod ))))
-
-(defthm mod-squeeze
-  (implies (and (= (mod m n) 0)
-                (< m (* (1+ a) n))
-                (< (* (1- a) n) m)
-                (integerp a)
-                (integerp m)
-                (integerp n))
-           (= m (* a n)))
-  :hints (("Goal" :use (mod-0-int
-                        (:theorem
-                         (implies (and (< m (* (1+ a) n))
-                                       (< (* (1- a) n) m)
-                                       (rationalp n))
-                                  (and (< (1- a) (/ m n))
-                                       (< (/ m n) (1+ a))))))))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/mod.lisp acl2-6.3/books/rtl/rel5/arithmetic/mod.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/mod.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/mod.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1079 +0,0 @@
-(in-package "ACL2")
-
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ground-zero")
-(include-book "negative-syntaxp")
-
-(local (include-book "mod-proofs"))
-
-#| 
-
-Todo: We could probably prove REM analogs for most of the rules in this book (since REM and MOD agree on a
-certain range of inputs), but we don't use REM much at all in the library (for good reason, thinks Eric), so
-perhaps this isn't worth spending time on.
-
-|#
-
-
-;This fact is built in to ACL2 as (:TYPE-PRESCRIPTION MOD), so we disable it. 
-(defthmd mod-acl2-numberp-type-prescription
-  (acl2-numberp (mod x y))
-  :rule-classes (:type-prescription))
-
-;Perhaps we don't need this as a rewrite rule, but here it is anyway:
-(defthm mod-acl2-numberp
-  (acl2-numberp (mod x y)))
-
-;BOZO make sure we have a rule around which backchains from (not (complex-rationalp x)) to (rationalp x).
-;BOZO maybe we don't want the case-split in the t-p rule?
-(defthm mod-rationalp
-  (implies (case-split (not (complex-rationalp x)))
-           (rationalp (mod x y)))
-  :rule-classes (:rewrite :type-prescription))
-
-;BOZO do we even need this?
-(defthm mod-rational-when-y-is-rational-rewrite
-  (implies (and (rationalp y)
-                (case-split (acl2-numberp x))
-                )
-           (equal (rationalp (mod x y))
-                  (rationalp x))))
-
-;see also mod-integerp-when-y-is-power-of-2-gen
-(defthm mod-integerp
-  (implies (and (integerp x) ;can't gen: (mod 2/3   5)=2/3
-                (integerp y) ;can't gen: (mod 5   2/3)=1/3
-                )
-           (integerp (mod x y)))
-  :rule-classes (:rewrite :type-prescription))
-
-;what about when x is a known int?
-(defthm mod-integerp-2
-  (implies (and (integerp y)
-                (case-split (acl2-numberp x))
-                )
-           (equal (integerp (mod x y))
-                  (integerp x))))
-
-
-
-
-
-;mod when x is complex?
-
-(defthm mod-with-x-a-non-acl2-number-is-zero
-  (implies (not (acl2-numberp x))
-           (equal (mod x y)
-                  0)))
-
-;enable?
-(defthmd mod-when-y-is-not-an-acl2-numberp
-  (implies (not (acl2-numberp y))
-           (equal (mod x y)
-                  (fix x))))
-
-(defthmd mod-when-y-is-complex-rationalp
-  (implies (complex-rationalp y)
-           (equal (mod x y)
-                  (if (not (complex-rationalp x))
-                      (fix x)
-                    (if (not (rationalp (/ x y)))
-                        x
-                      (if (integerp (/ x y))
-                          0 
-                        (+ X (* -1 Y (FLOOR (* X (/ Y)) 1))) ;this case is gross (basically the defn of mod)
-                        ))))))
-
-
-
-
-
-;I weakened the hyp on x as much as I could and then weakened the hyps on y as much as possible.  (We might
-;get a different rule by doing the reverse of that.)
-(defthm mod-non-negative
-  (implies (and (case-split (< 0 y)) ;can't gen: (mod -1 0) = -1 and  (mod 3 -2) = -1
-                (case-split (not (complex-rationalp x))) ;can't gen: (mod #C(-4 -3) 1) = #c(-4 -3)
-                (case-split (not (complex-rationalp y))) ;can't gen: (mod -3 #c(1 1)) = -3
-                )
-           (<= 0 (mod x y))))
-
-(defthm mod-non-negative-rationalp-type-prescription
-  (implies (and (case-split (< 0 y))                     
-                (case-split (not (complex-rationalp x))) 
-                (case-split (not (complex-rationalp y))) 
-                )
-           (and (<= 0 (mod x y))
-                (rationalp (mod x y)) ;we might as well include this
-                ))
-  :rule-classes ((:type-prescription :typed-term (mod x y))))
-
-(defthm mod-non-negative-linear
-  (implies (and (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (<= 0 (mod x y)))
-  :rule-classes ((:linear :trigger-terms ((mod x y)))))
-
-(defthm mod-upper-bound
-  (implies (and (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (< (mod x y) y)))
-
-(defthm mod-upper-bound-linear
-  (implies (and (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (< (mod x y) y))
-  :rule-classes ((:linear :trigger-terms ((mod x y)))))
-
-;included to help a hyp which matches this rule's conclusion get written away quickly
-(defthm mod-upper-bound-less-tight-rewrite
-  (implies (and (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (<= (mod x y) y)))
-
-;do we need this?  is it expensive?
-(defthm mod-upper-bound-3
-  (implies (and (<= y z)
-                (case-split (< 0 y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y)))
-                )
-           (< (mod x y) z)))
-
-(defthm mod-upper-bound-2
-  (implies (and (<= 0 x)
-                (case-split (not (complex-rationalp x)))
-                )
-           (<= (mod x y) x))
-  :rule-classes (:rewrite (:linear :trigger-terms ((mod x y)))))
-
-(defthm mod-0
-    (and (equal (mod 0 y)
-                0)
-         (equal (mod x 0)
-                (fix x))))
-
-(defthm mod-complex-rationalp-rewrite
-  (implies (case-split (rationalp y))
-           (equal (complex-rationalp (mod x y))
-                  (complex-rationalp x))))
-
-;Don't make this a rewrite rule (we don't want to backchain to (< y 0) to establish (rationalp (mod x y))
-(defthm mod-non-positive-type-prescription
-  (implies (and (< y 0) ;rarely will be the case
-                (rationalp x)
-                (rationalp y)
-                )
-           (and (rationalp (mod x y))
-                (<= (mod x y) 0)))
-  :rule-classes (:type-prescription))
-
-(defthm mod-non-positive
-  (implies (and (< y 0) ;rarely will be the case
-                (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (<= (mod x y) 0)))
-
-;rewrite a claim about mod being non-positive to a claim about y?
-
-(local (include-book "fl")) ;drop?
-
-(defthm mod-drop-irrelevant-first-term
-  (implies (and (integerp (* k (/ y)))
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                (case-split (not (complex-rationalp x)))
-                )
-           (equal (mod (+ k x) y)
-                  (mod x y))))
-
-(defthm mod-drop-irrelevant-second-term
-  (implies (and (integerp (* k (/ y)))
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                (case-split (not (complex-rationalp x)))
-                )
-           (equal (mod (+ x k) y)
-                  (mod x y))))
-
-(defthm mod-drop-irrelevant-second-term-with-more-terms
-  (implies (and (integerp (* k (/ y)))
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp x2)))
-                )
-           (equal (mod (+ x k x2) y)
-                  (mod (+ x x2) y))))
-
-(defthm mod-drop-irrelevant-third-term
-  (implies (and (integerp (* k (/ y)))
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp x2)))
-                )
-           (equal (mod (+ x x2 k) y)
-                  (mod (+ x x2) y))))
-
-;We could make analogs to MOD-DROP-IRRELEVANT-SECOND-TERM in which we drop the third, fourth, etc. term.
-
-(defthm mod-mult-eric
-  (implies (and (integerp a)
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y))) ;gen?
-                )
-           (equal (mod (+ x (* a y)) y)
-                  (mod x y))))
-
-;similar lemmas below?
-;change params on the rest?
-
-;could we generalize (mod x2 y) to (* k (mod x2 y)) ??
-;I don't think we can drop either hyp.
-(defthm mod-sum-elim-second
-  (implies (and (case-split (not (complex-rationalp x1)))
-                (case-split (not (complex-rationalp x2))) 
-                )
-           (equal (mod (+ x1 (mod x2 y)) y)
-                  (mod (+ x1 x2) y))))
-
-(defthm mod-sum-elim-second-gen
-  (implies (and (integerp (/ y2 y))
-                (case-split (not (complex-rationalp x1)))
-                (case-split (not (complex-rationalp x2))) 
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                )
-           (equal (mod (+ x1 (mod x2 y2)) y)
-                  (mod (+ x1 x2) y))))
-
-
-;Follows from MOD-SUM-ELIM-SECOND
-(defthm mod-sum-elim-first
-  (implies (and (case-split (not (complex-rationalp a)))
-                (case-split (not (complex-rationalp b)))
-                )
-           (equal (mod (+ (mod b y) a) y)
-                  (mod (+ a b) y))))
-
-;Follows from MOD-SUM-ELIM-SECOND-GEN
-(defthm mod-sum-elim-first-gen
-  (implies (and (integerp (/ y2 y))
-                (case-split (not (complex-rationalp x1)))
-                (case-split (not (complex-rationalp x2))) 
-                (case-split (not (equal y 0)))
-                (case-split (rationalp y))
-                )
-           (equal (mod (+ (mod x2 y2) x1) y)
-                  (mod (+ x1 x2) y))))
-
-;Follows from MOD-SUM-ELIM-SECOND and MOD-SUM-ELIM-FIRST
-;Do we really need this if we have the other two?
-(defthm mod-sum-elim-both
-  (implies (and (case-split (not (complex-rationalp a)))
-                (case-split (not (complex-rationalp b)))
-                )
-           (equal (mod (+ (mod a y) (mod b y)) y)
-                  (mod (+ a b) y))))
-
-;see mod-diff
-(defthm mod-difference-elim-second
-  (implies (and (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (mod (+ x1 (* -1 (mod x2 y))) y)
-                  (mod (+ x1 (* -1 x2)) y))))
-
-;Follows from MOD-DIFFERENCE-ELIM-SECOND
-;bad name?
-(defthm mod-sum-elim-negative-first-arg
-  (implies (and (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (mod (+ (* -1 (mod x2 y)) x1) y)
-                  (mod (+ (* -1 x2) x1) y))))
-
-(defthm mod-by-1
-  (implies (integerp m)
-           (equal (mod m 1)
-                  0)))
-
-;I'm going to try keeping this disabled, since relieving the first hyp may be expensive.
-;rename: no more n!
-;(integerp (* x (/ y))) basically says that x is a multiple of y, which is 
-;basicially what (equal (mod x y) 0) says too.
-(defthmd mod-mult-of-n
-  (implies (and (integerp (* x (/ y)))
-                (not (equal y 0))
-                (rationalp x)
-                (rationalp y)
-                )
-           (equal (mod x y)
-                  0)))
-
-;prove a rule for negative x too?
-;try disabling?
-(defthmd mod-negative-y
-  (implies (and (< 0 y)
-                (integerp x)
-                (integerp y)
-                )
-           (equal (mod x (- y))
-                  (if (integerp (/ x y))
-                      0
-                    (+ (- y) (mod x y))))))
-
-;BOZO
-;try disabling???
-(defthm mod-does-nothing
-  (implies (and (< m n)
-                (<= 0 m)
-                (case-split (rationalp m)))
-           (equal (mod m n)
-                  m)))
-
-;better name
-;can derive mod-of-mod, mod-idempotent from this?
-;perhaps keep this disabled??
-(defthm mod-mod-e
-  (implies (and (integerp (/ y1 y2))
-                (case-split (not (equal y2 0)))
-                (case-split (rationalp y1))
-                (case-split (rationalp y2))
-                )
-           (equal (mod (mod x y1) y2)
-                  (mod x y2))))
-
-(defthm mod-of-mod
-  (implies (and (case-split (natp k))
-                (case-split (natp n)))
-           (equal (mod (mod x (* k n)) n)
-                  (mod x n))))
-
-;Follows from mod-mod-e and mod-by-0
-(defthm mod-idempotent
-  (implies (and (case-split (rationalp x)) ;(integerp x)
-                (case-split (rationalp y)) ;(integerp y)
-                )
-           (equal (mod (mod x y) y)
-                  (mod x y))))
-
-
-;cute; why does this help so much?
-;like quot-mod
-(defthm mod-fl-2
-  (implies (case-split (acl2-numberp x))
-           (equal (+ (* y (fl (/ x y))) (mod x y))
-                  x))
-  :rule-classes ())
-
-(defthm mod-def
-  (implies (case-split (acl2-numberp x))
-           (equal (mod x y)
-                  (- x (* y (fl (/ x y))))))
-  :rule-classes ())
-
-;why not just enable mod whenever we'd use this rule?
-;make an alternate definition of MOD in terms of FL?
-(defthm quot-mod
-  (implies (case-split (acl2-numberp m))
-           (equal (+ (* n (fl (/ m n))) (mod m n))
-                  m))
-  :rule-classes ())
-
-;a is a free var
-(defthmd mod-force-eric
-  (implies (and (<= (* a y) x)
-                (< x (* (1+ a) y))
-                (integerp a)
-                (rationalp x)
-                (rationalp y)
-                )
-           (equal (mod x y)
-                  (- x (* a y)))))
-
-
-
-;chose a in mod-force-eric to be -1
-;expensive?
-(defthmd mod-force-chosen-a-neg
-    (implies (and (< x 0)
-		  (<= (* -1 y) x)
-                  (rationalp x)
-                  (rationalp y)
-                  )
-	     (equal (mod x y)
-                    (- x (* -1 y)))))
-
-;gen?
-;or could rewrite to (equal 0 (mod x 2))
-(defthm mod-even
-  (implies (rationalp x)
-           (equal (integerp (* 1/2 (mod x 2)))
-                  (integerp (* 1/2 x)))))
-
-;gen 2 to m?
-(defthm mod-even-gen
-  (implies (and (rationalp x)
-                (integerp n)
-                (integerp (* 1/2 n)) ;address the other case?
-                )
-           (equal (integerp (* 1/2 (mod x n)))
-                  (integerp (* 1/2 x)))))
-
-
-;Enforces a new normal form for mod in which we force the second arg to be 1.
-;Maybe this is just a weird idea.
-;BOZO bad name?
-(defthmd mod-cancel
-  (implies (syntaxp (not (and (quotep y) (equal (cadr y) 1)))) ;prevents looping
-           (equal (mod x y)
-                  (if (acl2-numberp x)
-                      (if (acl2-numberp y)
-                          (if (equal 0 y)
-                              x
-                            (* y (mod (/ x y) 1)))
-                        x)
-                    0))))
-
-
-;old version
-(defthmd mod-minus
-  (implies (and (case-split (rationalp x))
-                (case-split (rationalp y)))
-           (equal (mod (* -1 x) y)
-                  (if (equal 0 y)
-                      (- x)
-                    (if (integerp (/ x y))
-                        0
-                      (- y (mod x y)))))))
-
-
-(defthm mod-minus-alt
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (equal (mod x y)
-                  (if (equal 0 y)
-                      x
-                    (if (integerp (/ (- x) y))
-                        0
-                      (- y (mod (- x) y)))))))
-
-(defthm mod-1-integerp
-  (implies (case-split (acl2-numberp x))
-           (equal (integerp (mod x 1))
-                  (integerp x))))
-
-; needs fl-of-odd/2
-;keep this disabled
-;gen?
-(defthmd mod-by-2-rewrite-to-even
-  (implies (integerp x)
-           (equal (equal (mod x 2) 0)
-                  (integerp (* 1/2 x)))))
-
-(defthm fl-plus-md
-  (implies (rationalp x)
-           (equal (+ (fl x) (mod x 1))
-                  x)))
-
-;sort of an odd rule...
-(defthm mod-1-sum-integer
-  (implies (and (rationalp x)
-                (rationalp y))
-           (equal (integerp (+ x (mod y 1)))
-                  (integerp (+ x y)))))
-
-;needed?
-;expensive?
-#|
-??
-ex:   (INTEGERP (* (/ (EXPT 2 J))
-               (MOD X (* 2 (EXPT 2 I)))))
-|#
-
-
-;bad name?
-(defthm mod-quotient-integerp
-  (implies (and (integerp (* y k))
-                (rationalp x)
-                (rationalp y)
-                (rationalp k)
-                )
-           (equal (integerp (* k (mod x y)))
-                  (integerp (* k x)))))
-
-;gen
-;may someday subsume mod-idempotent
-(defthm mod-mod-2-thm
-  (implies (and (<= y1 y2)
-;test                (case-split (<= 0 y2))
-                (case-split (< 0 y1))                 ;drop?
-                (case-split (acl2-numberp x)) ;gen?
-                (case-split (rationalp y1))
-                (case-split (rationalp y2))
-                (case-split (not (equal y1 0)))
-                )
-           (equal (mod (mod x y1) y2)
-                  (mod x y1))))
-
-
-;new
-;can derive at least 1 thm above from this?
-(defthmd mod-equal-0
-  (implies (and ;(case-split (rationalp x))
-                (case-split (rationalp y)) ;gen?
-                (case-split (not (equal y 0)))
-                )
-           (equal (equal (mod x y) 0)
-                  (integerp (* (/ y) x)))))
-
-;keep disabled?
-(defthmd mod-2-1-means-odd
-  (implies (integerp x)
-           (equal (equal (mod x 2) 1)
-                  (not (integerp (* 1/2 x))))))
-
-;unlikely to fire automatically
-;make a t-p rule too?
-(defthm mod-integerp-2-2
-  (implies (and (integerp y)
-                (integerp x))
-           (integerp (mod x (/ y)))))
-
-
-;like mod-prod?
-(defthm mod-cancel-special-1
-  (implies (and (acl2-numberp x)
-                (rationalp k)
-                (acl2-numberp y)
-                (not (equal y 0))
-                (not (equal k 0)))
-           (equal (mod (* k x)
-                       (* y k))
-                  (* k (mod x y)))))
-
-;move up
-;expensive?
-(defthm mod-integerp-when-y-is-an-inverse
-  (implies (and (integerp (/ y))
-                (integerp x))
-           (integerp (mod x y))))
-
-;this is a bit odd..
-(defthm mod-when-y-is-an-inverse
-  (implies (and (integerp (/ y))
-                (integerp x)
-                (case-split (< 0 y))
-                )
-           (equal (mod x y)
-                  0)))
-
-(defthm fl-mod-x-1
-  (equal (fl (mod x 1)) 
-         0))
-
-(defthmd mod-by-2
-  (implies (integerp x)
-           (equal (mod x 2)
-                  (if (integerp (* 1/2 x))
-                      0
-                    1))))
-
-
-
-
-
-
-
-
-;I put this in :rule-classes nil, because it can loop if it is a rewrite rule..
-(defthm mod-sum-move
-   (implies (and (case-split (<= 0 k1))
-                 (case-split (< k1 y))
-                 (case-split (rationalp y))
-                 (case-split (rationalp x))
-                 (case-split (rationalp k1))
-;(rationalp k2)
-                 )
-            (equal (equal k1 (mod (+ k2 x) y))
-                   (equal (mod (+ k1 (- k2)) y) (mod x y))))
-   :rule-classes nil)
-
-;Unlike the above, this rule shouldn't loop; since k1 and k2 are constants and we compute (+ k1 (- k2)) in the
-;conclusion...
-(defthm mod-sum-move-constants
-  (implies (and (syntaxp (and (quotep k1)
-                              (quotep k2)
-;                              (quotep y)  ;drop?
-                              )
-                         )
-                (case-split (<= 0 k1))
-                (case-split (< k1 y))
-                (rationalp y)
-                (rationalp x)
-                (rationalp k1)
-    ;(rationalp k2)
-                )
-           (equal (equal k1 (mod (+ k2 x) y))
-                  (equal (mod (+ k1 (- k2)) y) (mod x y)))))
-
-
-
-;BOZO don't need some of these?
-(defthm mod-sums-cancel-1
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (equal (mod (+ k x1) y) (mod (+ k x2) y))
-                  (equal (mod x1 y) (mod x2 y)))))
-
-(defthm mod-sums-cancel-2
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (equal (mod (+ x1 k) y) (mod (+ k x2) y))
-                  (equal (mod x1 y) (mod x2 y)))))
-
-(defthm mod-sums-cancel-3
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (equal (mod (+ x1 k) y) (mod (+ x2 k) y))
-                  (equal (mod x1 y) (mod x2 y)))))
-
-;don't need this one..?
-(defthm mod-sums-cancel-4
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x1))
-                (case-split (rationalp x2))
-                )
-           (equal (equal (mod (+ k x1) y) (mod (+ x2 k) y))
-                  (equal (mod x1 y) (mod x2 y)))))
-
-(defthm mod-sums-cancel-5
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                )
-           (equal (equal (mod k y) (mod (+ x k) y))
-                  (equal 0 (mod x y)))))
-
-(defthm mod-sums-cancel-6
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                )
-           (equal (equal (mod k y) (mod (+ k x) y))
-                  (equal 0 (mod x y)))))
-
-;don't need this one..?
-(defthm mod-sums-cancel-7
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                )
-           (equal (equal (mod (+ k x) y) (mod k y))
-                  (equal 0 (mod x y)))))
-
-;don't need this one..?
-(defthm mod-sums-cancel-8
-  (implies (and (case-split (<= 0 y))
-                (case-split (rationalp k))
-                (case-split (rationalp y))
-                (case-split (rationalp x))
-                )
-           (equal (equal (mod (+ x k) y) (mod k y))
-                  (equal 0 (mod x y)))))
-  
-
-
-
-(defthm fl-mod-equal
-  (implies (and (equal (fl (/ x 2)) (fl (/ y 2)))
-                (equal (mod x 2) (mod y 2))
-                (acl2-numberp x)
-                (acl2-numberp y)
-                )
-           (equal x y))
-  :rule-classes nil)
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-;comes from mod-upper-bound
-(defthmd mod-bnd-1
-  (implies (and (case-split (< 0 n))
-                (case-split (not (complex-rationalp m)))
-                (case-split (not (complex-rationalp n)))
-                )
-           (< (mod m n) n))
-  :rule-classes :linear)
-
-;proved in mod2
-;like old mod+-thm
-;make alt
-(defthm mod-mult-eric
-  (implies (and (integerp a)
-                (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y))) ;gen?
-                )
-           (equal (mod (+ x (* a y)) y)
-                  (mod x y))))
-
-
-
-(defthm integerp-mod
-    (implies (and (integerp m)
-		  (integerp n))
-	     (integerp (mod m n)))
-  :rule-classes (:rewrite :type-prescription))  
-
-(defthm rationalp-mod
-  (implies (case-split (rationalp x))
-           (rationalp (mod x y)))
-  :rule-classes (:rewrite :type-prescription))
-
-;better conclusion?
-;this follows pretty trivially from quot-mod
-;never used in support/
-(defthm mod-0-fl
-    (implies (acl2-numberp m)
-	     (iff (= (mod m n) 0)
-		  (= m (* (fl (/ m n)) n))))
-  :rule-classes ())
-
-
-
-
-;wow! this just goes through!
-(defthm mod-0-0
-  (implies (and (integerp p)
-                (rationalp m)
-                (rationalp n)
-                )
-           (iff (= (mod m (* n p)) 0)
-                (and (= (mod m n) 0)
-                     (= (mod (fl (/ m n)) p) 0))))
-  :rule-classes ())
-
-
-;BOZO see mod-cancel?
-(defthmd mod-prod
-  (implies (and (rationalp m)
-                (rationalp n)
-                (rationalp k)
-                )
-           (equal (mod (* k m) (* k n))
-                  (* k (mod m n)))))
-
-(defthm mod012
-  (implies (integerp m)
-           (or (equal (mod m 2) 0)
-               (equal (mod m 2) 1)))
-  :rule-classes ())
-
-
-;gen the 2?
-;bad name?
-(defthm mod-mod-2-not-equal
-   (implies (acl2-numberp m) ;(integerp m)
-            (not (= (mod m 2) (mod (1+ m) 2))))
-   :rule-classes ())
-
-;change the formals on these?
-;these are from mod2
-(encapsulate
- ()
- (defthmd mod-sum
-   (implies (and (rationalp a)
-                 (rationalp b)
-                 )
-            (equal (mod (+ a (mod b n)) n)
-                   (mod (+ a b) n))))
-
- (defthm mod-mod-sum
-   (implies (and (rationalp a)
-                 (rationalp b)
-                 )
-            (equal (mod (+ (mod a n) (mod b n)) n)
-                   (mod (+ a b) n))))
-;BOZO
- (defthmd mod-bnd-2
-   (implies (and (<= 0 m)
-                 (case-split (rationalp m))
-                 )
-            (<= (mod m n) m))  
-   :rule-classes :linear)
-
- )
-
-;BOZO make this into a better rewrite rule (and generalize)
-;this is sort of a cancellation rule
-;prove from my mod cancellation rules?
-(defthm mod-plus-mod-2
-  (implies (and (integerp a)
-                (integerp b))
-           (iff (= (mod (+ a b) 2) (mod a 2))
-                (= (mod b 2) 0)))
-  :rule-classes ())
-
-;bad name
-;The only multiple of N between 0 and 2N is N itself.
-(defthm mod-must-be-n
-    (implies (and (= (mod m n) 0)
-                  (< m (* 2 n))
-		  (< 0 m)
-                  (rationalp m);(integerp m)
-		  (rationalp n);(integerp n)
-		  )
-	     (= m n))
-  :rule-classes ())
-
-(defthm natp-compound-recognizer
-  (equal (natp x)
-         (and (integerp x) (<= 0 x)))
-  :rule-classes :compound-recognizer)
-
-;drop?
-(defthm natp-mod
-  (implies (and (natp m)
-                (natp n))
-           (natp (mod m n)))
-  :rule-classes ((:type-prescription :typed-term (mod m n))))
-           
-(defthm natp-mod-rewrite
-  (implies (and (natp m)
-                (natp n))
-           (natp (mod m n))))
-
-;BOZO kill ;gen?  make alt?
-;see mod-mult-eric
-(defthmd mod-mult
-    (implies (and (integerp a)
-                  (rationalp m)
-		  (rationalp n))
-	     (equal (mod (+ m (* a n)) n)
-		    (mod m n))))
-
-;gen?
-;essentially  mod-difference-elim-second
-(defthmd mod-diff
-    (implies (and (case-split (rationalp a))
-                  (case-split (rationalp b))
-                  )
-	     (equal (mod (- a (mod b n)) n)
-		    (mod (- a b) n))))
-
-
-;this doesn't seem to be used anywhere
-(defthmd mod-bnd-3
-    (implies (and (< m (+ (* a n) r))
-		  (<= (* a n) m)
-                  (integerp a)
-                  (case-split (rationalp m))
-		  (case-split (rationalp n))
-		  )
-	     (< (mod m n) r))
-  ;; Free variables make this rule very weak, but it seems harmless
-  ;; enough to make it a :linear rule.
-  :rule-classes :linear)
-
-(defthm mod-force
-  (implies (and (<= (* a n) m)
-                (< m (* (1+ a) n))
-                (integerp a)
-                (rationalp m)
-                (rationalp n)
-                )
-           (= (mod m n) (- m (* a n))))
-  :rule-classes nil)
-
-; If A and B are congruent mod N, then their difference is a multiple of N, and
-; conversely.
-
-(defthm mod-equal-int
-  (implies (and (= (mod a n) (mod b n))
-                (rationalp a)
-                (rationalp b))
-           (integerp (/ (- a b) n)))
-  :rule-classes ())
-
-(defthm mod-equal-int-reverse
-  (implies (and (integerp (/ (- a b) n))
-                (rationalp a)
-                (rationalp b)
-                (rationalp n)
-                (< 0 n))
-           (= (mod a n) (mod b n)))
-  :rule-classes ())
-
-(defthmd mod-mult-2
-  (implies (integerp a)
-           (equal (mod (* a n) n)
-                  0)))
-
-(defthmd mod-mult-2-alt
-  (implies (integerp a)
-           (equal (mod (* n a) n)
-                  0)))
-
-(defthmd mod-mult-n
-  (equal (mod (* a n) n)
-         (* n (mod a 1))))
-
-(defthmd mod-mult-n-commuted
-  (equal (mod (* n a) n)
-         (* n (mod a 1))))
-
-(defthm mod-0-int
-  (implies (and (integerp m)
-                (integerp n)
-                (not (= n 0)))
-           (iff (= (mod m n) 0)
-                (integerp (/ m n))))
-  :rule-classes ())
-
-(defthm mod-mult-2-gen
-  (equal (mod (* a n) n)
-         (* n (mod a 1))))
-
-(defthm mod-mult-2-alt-gen
-  (equal (mod (* n a) n)
-         (* n (mod a 1))))
-
-;rename params on these:
-
-;just a special case of mod-mult-2-alt
-;generalize?
-;; Rule A3 in fp.lisp suggests using (* 2 i) instead of
-;; (+ i i).
-(defthm mod-2*i
-  (implies (integerp i)
-           (equal (mod (* 2 i) 2)
-                  0)))
-
-;gen the 2?
-(defthm mod-2*m+1-rewrite
-  (implies (integerp m)
-           (equal (mod (1+ (* 2 m)) 2)
-                  1)))
-
-;eliminate this
-;in fact, it equals 1!
-(defthm mod-2*i+1
-  (implies (integerp i)
-           (not (equal (mod (1+ (* 2 i)) 2)
-                       0))))
-
-(defun INDUCT-NAT (x)
-  (if (and (integerp x)
-	   (> x 0))
-      (induct-nat (1- x))
-    ()))
-
-;BOZO move or drop?
-;try disabled
-(defthm nk>=k
-    (implies (and (integerp n)
-		  (integerp k)
-		  (> k 0)
-		  (not (= (* n k) 0)))
-	     (>= (abs (* n k)) k))
-  :rule-classes ())
-
-;BOZO gen?
-;not used anywhere but exported by lib/basic
-(defthm mod-force-equal
-  (implies (and (< (abs (- a b)) n)
-                (rationalp a) ;                  (natp a)
-                (rationalp b) ;(natp b)
-                (integerp n) ;(rationalp n) ;(natp n)
-                )
-           (iff (= (mod a n) (mod b n))
-                (= a b)))
-  :rule-classes ()
-  :hints (("goal" :use ( mod-equal-int
-                         (:instance nk>=k (k n) (n (/ (- a b) n)))
-;			(:instance *cancell (x a) (y b) (z n))
-                         ))))
-
-
-;yuck? BOZO used anywhere?
-(defthmd nk>=k-linear
-    (implies (and (integerp n)
-		  (integerp k)
-		  (not (= n 0)))
-	     (>= (abs (* n k)) k))
-  :rule-classes :linear)
-
-
-
-
-; BOZO add case-splits
-(defthm fl-mod
-  (implies (and (rationalp x)
-                (natp y)
-                )
-           (equal (fl (mod x y))
-                  (mod (fl x) y))))
-
-;BOZO a powerful rule!
-(defthmd mod-sum-cases
-  (implies (and (<= 0 y)
-                (rationalp x)
-                (rationalp y)
-                (rationalp k)
-                )
-           (equal (mod (+ k x) y)
-                  (if (< (+ (mod k y) (mod x y)) y)
-                      (+ (mod k y) (mod x y))
-                    (+ (mod k y) (mod x y) (* -1 y))))))
-
-(defthmd mod-fl-eric
-  (implies (and (<= 0 y)
-                (integerp y)
-                )
-           (equal (mod (fl x) y)
-                  (fl (mod x y)))))
-
-(defthm mod-squeeze
-  (implies (and (= (mod m n) 0)
-                (< m (* (1+ a) n))
-                (< (* (1- a) n) m)
-                (integerp a)
-                (integerp m)
-                (integerp n))
-           (= m (* a n)))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/negative-syntaxp.lisp acl2-6.3/books/rtl/rel5/arithmetic/negative-syntaxp.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/negative-syntaxp.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/negative-syntaxp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,87 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-Briefly, negative-syntaxp recognizes terms which are "syntactically negative."  These are terms which could
-be simplified by multiplying them by -1.  For example, the term
-  (+ -1/2 (* -1 x))
-could be simplified by multiplying it by -1, yielding (with distributivity enabled) the term
-  (+ 1/2 x)
-. Often, a statement about a negative term can be simplified by rewriting it into a statement about the term's
-positive analogue.  For example, (integerp (* -1 x)) can be simplified to (integerp x), if x is an
-acl2-numberp.  However, a rule rewriting (integerp (* -1 x)) to (integerp x) is not general enough to catch all
-"negative" terms.  For example, the rule would not fire on (integerp (- x)).  negative-syntaxp provides a
-general and extensible facility for making such rules.
-
-Note that the notion of "syntactically negative" pays no attention to *values*. E.g., (- x) is "syntactically
-negative" regardless of the sign of the value of x.
-
-|#
-
-
-
-;This function operates on translated terms!
-;This function should be extended to recognize more terms.
-;do I need to test that binary-+ and binary-* have the right number of arguments?
-;Worry: What happens on (+ -2 b)
-(defun negative-syntaxp (term)
-  (if (not (consp term))
-      nil
-    (case (car term)
-      (quote (and (rationalp (cadr term)) 
-                  (< (cadr term) 0)))
-      (unary-- (not (negative-syntaxp (cadr term))))  ;perhaps we should use "positive-syntaxp" here...
-      (binary-+ (and ;(equal (length term) 3) ;ok since binary-+ should always have 2 args
-                 (negative-syntaxp (cadr term))
-                 (negative-syntaxp (caddr term))))
-      (binary-* (and ;(equal (length term) 3)
-                 (or (and (negative-syntaxp (cadr term))
-                          (not (negative-syntaxp (caddr term))))
-                     (and (not (negative-syntaxp (cadr term)))
-                          (negative-syntaxp (caddr term))))))
-      (otherwise nil))))
-
-
-#|
-
-The following terms are "negative":
- negative constants
- (- x)
- (* -1 x)
- (* -5/7 x)
- (/ (- a)) - how do we simp this? - not currently handled...
- (+ -1/2 (* -1/2 x))
- the sum of two (or more) negative terms
-
-
-neg
- negative numeric constants
- (- <non-neg>)
- a product with an odd number of negative factors
- a sum of two or more negative terms
-
-pos
- positive numeric constants
- variables
- function calls other than +,*
- a product with an even number of negative factors
- a sum of two or more positive terms?
-
-It might be nice to someday decide how to handle a mixed sum.  For example, we might prefer 
-  (integerp (+ 2 (* -1 x) y))
-to
-  (integerp (+ -1 x (* -1 y)) 
-since the former has one fewer negated addend.  And, when exactly half the terms are negated, we might prefer 
-  (integerp (+ x (* -1 y)))
-to
-  (integerp (+ (* -1 x) y))
-since the latter has the negation around the "smaller" term.  Or something like that. 
-
-
-so that the rules don't loop, we must ensure that a negative term * -1 is not negative
-
-
-|#
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/nniq.lisp acl2-6.3/books/rtl/rel5/arithmetic/nniq.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/nniq.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/nniq.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,602 +0,0 @@
-(in-package "ACL2")
-
-(include-book "ground-zero")
-(local (include-book "fp2"))
-(local (include-book "denominator"))
-(local (include-book "numerator"))
-(local (include-book "predicate"))
-(local (include-book "unary-divide"))
-(local (include-book "product"))
-(local (include-book "integerp"))
-(local (include-book "arith"))
-
-;lemmas if non-rat args?
-
-(defthm nonnegative-integer-quotient-with-a-non-integer-arg
-  (implies (not (integerp i))
-           (equal (nonnegative-integer-quotient i j)
-                  0))
-  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
-
-(defthm nonnegative-integer-quotient-with-a-non-integer-arg-2
-  (implies (not (integerp j))
-           (equal (nonnegative-integer-quotient i j)
-                  0))
-  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
-
-(defthm nonnegative-integer-quotient-with-a-non-positive-arg
-  (implies (<= i 0)
-           (equal (nonnegative-integer-quotient i j)
-                  0))
-  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
-
-(defthm nonnegative-integer-quotient-with-a-non-positive-arg-2
-  (implies (<= j 0)
-           (equal (nonnegative-integer-quotient i j)
-                  0))
-    :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
-
-;like doc's floor-m+1-3?
-(defthm nonnegative-integer-quotient-upper-bound-rewrite
-  (implies (and (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                (case-split (rationalp j))
-                )
-           (<= (nonnegative-integer-quotient i j) (/ i j)))
-  :hints (("Goal" :cases ((rationalp i)
-                          )
-           :in-theory (enable nonnegative-integer-quotient))))
-
-;BOZO strict < when quotient isn't an integer
-(defthm nonnegative-integer-quotient-upper-bound-linear
-  (implies (and (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                (case-split (rationalp j))
-                )
-           (<= (nonnegative-integer-quotient i j) (/ i j)))
-  :rule-classes ((:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
-
-#|
-(defthm nonnegative-integer-quotient-upper-bound-linear-strict
-  (implies (and (not (integerp (NOT (INTEGERP (* I (/ J)))))) ;allows the strict bound
-                (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                (case-split (rationalp j))
-                )
-           (< (nonnegative-integer-quotient i j) (/ i j)))
-  :hints (("Goal" :use  nonnegative-integer-quotient-upper-bound-linear
-           ))
-  :rule-classes ((:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
-|#
-
-
-#|
-;what should the trigger terms be?
-(defthm nonnegative-integer-quotient-upper-bound-2
-  (implies (and (case-split (<= 0 i))
-                (case-split (<= 0 j))
-;                (case-split (rationalp i))
-                (case-split (rationalp j))
-                )
-           (<= (* j (nonnegative-integer-quotient i j)) i))
-  :hints (("Goal" :cases ((rationalp i))
-           :in-theory (enable nonnegative-integer-quotient)))
-  :rule-classes (:rewrite (:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
-|#
-
-#|
-(defthm nonnegative-integer-quotient-upper-bound-3
-  (implies (and (case-split (<= 0 i))
-                (case-split (<= 0 j))
-;                (case-split (rationalp i))
-                (case-split (rationalp j))
-                )
-           (<= (* j (nonnegative-integer-quotient i j)) i))
-  :hints (("Goal" :cases ((rationalp i))
-           :in-theory (enable nonnegative-integer-quotient)))
-  :rule-classes (:rewrite (:linear :trigger-terms ((* j (nonnegative-integer-quotient i j))))))
-|#
-
-;rewrite nniq to (/ i j) when quotient is known integer?
-(defthm nonnegative-integer-quotient-max-value-rewrite
-  (implies (and (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (equal (nonnegative-integer-quotient i j) (/ i j))
-                  (integerp (/ i j))))
-  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
-
-(defthm nonnegative-integer-quotient-lower-bound-rewrite
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                )
-           (< (+ -1 (/ i j)) (nonnegative-integer-quotient i j)))
-  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
-
-(defthm nonnegative-integer-quotient-lower-bound-linear
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                )
-           (< (+ -1 (/ i j)) (nonnegative-integer-quotient i j)))
-  :rule-classes ((:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
-
-#|
-;what should the trigger terms be?
-(defthm nonnegative-integer-quotient-lower-bound-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                (case-split (not (equal 0 j)))
-                )
-           (< (+ i (* -1 j)) (* j (nonnegative-integer-quotient i j))))
-  :hints (("Goal" :in-theory (disable  nonnegative-integer-quotient-lower-bound)
-           :use  nonnegative-integer-quotient-lower-bound))
-  :rule-classes (:rewrite (:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
-|#
-
-#|
-(defthm nonnegative-integer-quotient-lower-bound-3
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                (case-split (not (equal 0 j)))
-                )
-           (< (+ i (* -1 j)) (* j (nonnegative-integer-quotient i j))))
-  :hints (("Goal" :in-theory (disable  nonnegative-integer-quotient-lower-bound)
-           :use  nonnegative-integer-quotient-lower-bound))
-  :rule-classes (:rewrite (:linear :trigger-terms ((* j (nonnegative-integer-quotient i j))))))
-
-|#
-
-#|
-
-         (<= (* J
-                (NONNEGATIVE-INTEGER-QUOTIENT (NUMERATOR (* I (/ J)))
-                                              (DENOMINATOR (* I (/ J)))))
-             I)
-
-|#
-
-
-(defthm nonnegative-integer-quotient-upper-bound-linear-stronger
-  (implies (and (case-split (<= 0 i))
-                (case-split (<= 0 j))
-                (NOT (INTEGERP (* I (/ J))))
-                (case-split (acl2-numberp i))
-                (case-split (rationalp j))
-                (case-split (rationalp k))
-                (case-split (< 0 k))
-                )
-           (< (* k (nonnegative-integer-quotient i j)) (* k (/ i j))))
-  :hints (("Goal" :cases ((rationalp i))
-           :in-theory (enable nonnegative-integer-quotient)))
-  :rule-classes ((:linear :trigger-terms ((* k (nonnegative-integer-quotient i j))
-                                          ))))
-
-
-#|
-;was this ever proved?
-(defthm nonnegative-integer-quotient-upper-bound-linear-stronger
-   (implies (and (case-split (<= 0 i))
-                 (case-split (<= 0 j))
-                 (NOT (INTEGERP (* I (/ J))))
-                 (case-split (acl2-numberp i))
-                 (case-split (rationalp j))
-                 (case-split (rationalp k))
-                 (case-split (< 0 k))
-                 )
-            (< (* k (nonnegative-integer-quotient i j)) (* k (/ i j))))
-   :hints (("Goal" :cases ((rationalp i))
-            :in-theory (enable nonnegative-integer-quotient)))
-   :rule-classes ((:linear :trigger-terms ((* k (nonnegative-integer-quotient i j))))))
-
-
-
-|#
-
-(defthm nonnegative-integer-quotient-when-j-is-0
-  (equal (nonnegative-integer-quotient i 0)
-         0))
-
-
-;gen?
-(encapsulate ()
-              (local (defthm nniq-no-rounding-to-do-all-but-j=0
-                       (implies (and (integerp (* i (/ j)))
-                                     (integerp i)
-                                     (>= i 0)
-                                     (integerp j)
-                                     (> j 0)
-                                     )
-                                (equal (nonnegative-integer-quotient i j)
-                                       (/ i j)))))
-
-              (defthm nniq-no-rounding-to-do
-                       (implies (and (integerp (* i (/ j)))
-                                     (case-split (integerp i))
-                                     (case-split (<= 0 i))
-                                     (case-split (integerp j))
-                                     (case-split (<= 0 j))
-                                     )
-                                (equal (nonnegative-integer-quotient i j)
-                                       (/ i j)))))
-
-;begin stuff from elib27/rel2/nniq
-;i haven't organized the stuff below
-
-;move!
-;if the denom of a fraction is 1, the numerator is the whole fraction!
-(defthm denom-1-means-num-is-all
-  (implies (and (rationalp x)
-                (equal (denominator x) 1))
-           (equal (numerator x)
-                  x))
-  :hints (("Goal" :in-theory (disable rational-implies2)
-           :use rational-implies2)))
-
-(defthm nonnegative-integer-quotient-by-1
-  (implies (and
-            (integerp x)
-            (<= 0 x))
-           (equal (nonnegative-integer-quotient x 1)
-                  x)))
-#|
-;drop?
-;will backchain on (integerp x)!
-(defthm integer-has-denom-1-other-way
-  (implies (and
-            (rationalp x) ;acl2-numberp?
-            (equal (denominator x) 1))
-           (integerp x))
-   :hints (("Goal" :in-theory (disable rational-implies2)
-           :use (rational-implies2
-                 (:instance Lowest-terms 
-                           (n (denominator x))
-                           (r x) 
-                           (q 1))))))
-|#
-
-
-
-(defthm division-by-zero-yields-zero
-  (equal (/ m 0)
-         0))
-
-;expensive?
-(defthm fraction-less-than-1
-  (IMPLIES (AND (< (abs M) (abs N))
-                (rationalp m)
-                (rationalp n))
-           (<= (* m (/ n)) 1))
-  :hints (("Goal" :cases ((> n 0) (= n 0)))))
-
-(defthm nniq-int
-  (implies (and (integerp x)
-                (case-split (<= 0 x))
-                )
-           (equal (nonnegative-integer-quotient (numerator x)
-                                                (denominator x))
-                  x)))
-
-
-
-(encapsulate ()
-             (local (include-book "arithmetic/rationals" :dir :system))
-             (local (include-book "arithmetic/idiv" :dir :system))
-
-             (defthm quotient-numer-denom
-               (implies (and (integerp x) (< 0 x) (integerp y) (< 0 y))
-                        (equal (nonnegative-integer-quotient (numerator (/ x y))
-                                                             (denominator (/ x y)))
-                               (nonnegative-integer-quotient x y)))) 
-
-             (defthm 
-               Numerator-minus
-               (equal (numerator (- i))
-                      (- (numerator i))))
-
-             (defthm
-               Denominator-unary-minus
-               (implies (rationalp x)
-                        (equal (denominator (- x))
-                               (denominator x))))
-
-             (defthm 
-               Denominator-plus
-               (implies (and (rationalp r)
-                             (integerp i))
-                        (equal (denominator (+ i r))
-                               (denominator r))))
-             (defthm 
-               Denominator-plus-2
-               (implies (and (rationalp r)
-                             (integerp i))
-                        (equal (denominator (+ r i))
-                               (denominator r))))
-
-;add to arith books?
-             (defthm numerator-plus
-               (implies (and (rationalp x)
-                             (integerp i))
-                        (equal (numerator (+ x i))
-                               (+ (* i (denominator x)) (numerator x))))
-               :hints (("Goal" :in-theory (disable rational-implies2)
-                        :use (:instance rational-implies2 (x (+ x i)))))))
-
-(defthm numerator-plus-alt
-  (implies (and (rationalp x)
-                (integerp i))
-           (equal (numerator (+ i x))
-                  (+ (* i (denominator x)) (numerator x))))
-  :hints (("Goal" :in-theory (disable numerator-plus)
-           :use (:instance numerator-plus))))
-
-(defthm Numerator-minus-eric
-  (equal (numerator (* -1 i))
-         (* -1 (numerator i)))
-  :hints (("Goal" :in-theory (disable Numerator-minus) 
-           :use Numerator-minus)))
-
-(defthm Denominator-unary-minus-eric
-  (implies (rationalp x)
-           (equal (denominator (* -1 x))
-                  (denominator x)))
-  :hints (("Goal" :in-theory (disable Denominator-unary-minus) 
-           :use Denominator-unary-minus)))
-
-
-
-(encapsulate ()
-              (local (defthm NONNEGATIVE-INTEGER-QUOTIENT-sum-on-top
-                       (implies (and (integerp x)
-                                     (>= x 0)
-                                     (integerp y)
-                                     (> y 0)
-                                     )
-                                (equal (NONNEGATIVE-INTEGER-QUOTIENT (+ x y) y)
-                                       (+ 1 (NONNEGATIVE-INTEGER-QUOTIENT x y))))))
-
-              (local (defun nniq-induct (x y a)
-                       (if (zp a)
-                           1
-                         (* x y (nniq-induct x y (- a 1))))))
-
-              (local (DEFTHM NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-GEN
-                       (IMPLIES (AND (INTEGERP X)
-                                     (>= X 0)
-                                     (INTEGERP A)
-                                     (INTEGERP Y)
-                                     (> Y 0)
-                                     (>= A 0)
-                                     )
-                                (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (+ X (* A Y))
-                                                                     Y)
-                                       (+ A (NONNEGATIVE-INTEGER-QUOTIENT X Y))))
-                       :HINTS
-                       (("subgoal *1/2" :IN-THEORY (DISABLE NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP)
-                         :USE
-                         ((:INSTANCE NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP
-                                     (X (+ X (* (- A 1) Y))))))
-                        ("Goal" :DO-NOT '(GENERALIZE)
-                         :INDUCT (NNIQ-INDUCT X Y A)))))
-
-              (local (defthm NONNEGATIVE-INTEGER-QUOTIENT-sum-on-top-back
-                       (implies (and (integerp x)
-                                     (>= x 0)
-                                     (integerp y)
-                                     (> y 0)
-                                     (>= (+ x (- y)) 0)
-                                     )
-                                (equal (NONNEGATIVE-INTEGER-QUOTIENT (+ x (* -1 y)) y)
-                                       (+ -1 (NONNEGATIVE-INTEGER-QUOTIENT x y))))))
-
-              (local (defun nniq-induct-2 (x y a)
-                       (if (or (not (integerp a)) (>= a 0))
-                           1
-                         (* x y (nniq-induct-2 x y (+ a 1))))))
-
-
-
-              (local (DEFTHM NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-GEN-back
-                       (IMPLIES (AND (INTEGERP X)
-                                     (>= X 0)
-                                     (INTEGERP A)
-                                     (INTEGERP Y)
-                                     (> Y 0)
-                                     (< A 0)
-                                     (<= 0 (+ x (* a y)))
-                                     )
-                                (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (+ X (* A Y))
-                                                                     Y)
-                                       (+ A (NONNEGATIVE-INTEGER-QUOTIENT X Y))))
-                       :otf-flg t
-                       :HINTS
-                       (("subgoal *1/" :IN-THEORY (DISABLE NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-back)
-                         :USE
-                         ((:INSTANCE NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-back
-                                     (X (+ X (* (+ A 1) Y))))))
-                        ("Goal" :DO-NOT '(GENERALIZE)
-                         :INDUCT (NNIQ-INDUCT-2 X Y A)))))
-
-              (DEFTHM NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-GEN-both-cases
-                (IMPLIES (AND (INTEGERP X)
-                              (>= X 0)
-                              (INTEGERP A)
-                              (INTEGERP j)
-                              (> j 0)
-                              (<= 0 (+ x (* a j))) ;drop?
-                              )
-                         (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (+ X (* A j)) j)
-                                (+ A (NONNEGATIVE-INTEGER-QUOTIENT X j))))
-                :hints (("Goal" :cases ((>= a 0))))))
-
-;(in-theory (disable NONNEGATIVE-INTEGER-QUOTIENT-sum-on-top))
-
-
-
-(encapsulate ()
-             (local (include-book "arithmetic/idiv" :dir :system))
-             (local (include-book "arithmetic/top-with-meta" :dir :system))
-
-             (defthm nniq-eric-1
-               (implies (and (rationalp x)
-                             (not (integerp x)))
-                        (> (+ 1 (nonnegative-integer-quotient (numerator x) (denominator x))) ;the ceiling of x
-                           x))
-               :hints (("Goal" :in-theory (disable QUOTIENT-UPPER-BOUND
-                                                   NONNEGATIVE-INTEGER-QUOTIENT)
-                        :use (:instance QUOTIENT-UPPER-BOUND (x (numerator x)) (y (denominator x))))))
-             )
-
-
-;this sequence is used for nniq-lower-bound-non-integer-case
-(defthm nniq-eric-2
-  (implies (and (rationalp x)
-                (not (integerp x)))
-           (> (+ (denominator x) (* (denominator x) (nonnegative-integer-quotient (numerator x) (denominator x))))
-              (numerator x)))
-  :hints (("Goal" :in-theory  (disable nniq-eric-1 RATIONAL-IMPLIES2)
-           :use  (nniq-eric-1 RATIONAL-IMPLIES2))))
-
-
-(defthm nniq-eric-3
-  (implies (and (rationalp x)
-                (not (integerp x)))
-           (>= (+ (denominator x) (* (denominator x) (nonnegative-integer-quotient (numerator x) (denominator x))))
-              (+ 1 (numerator x))))
-  :hints (("Goal" :in-theory  (disable nniq-eric-2)
-           :use  (nniq-eric-2))))
-
-
-(defthm nniq-eric-4
-  (implies (and (rationalp x)
-                (not (integerp x)))
-           (>= (+ 1 (nonnegative-integer-quotient (numerator x) (denominator x)))
-               (+ (/ (numerator x) (denominator x)) (/ (denominator x)))))
-  :hints (("Goal" :in-theory  (disable nniq-eric-3 RATIONAL-IMPLIES2)
-           :use  (nniq-eric-3))))
-
-(defthm nniq-lower-bound-non-integer-case
-  (implies (and (rationalp x)
-                (not (integerp x)))
-           (>= (+ 1 (nonnegative-integer-quotient (numerator x) (denominator x)))
-               (+ x (/ (denominator x)))))
-  :hints (("Goal" :in-theory  (disable NNIQ-ERIC-3 nniq-eric-4)
-           :use  (nniq-eric-4))))
-
-
-(in-theory (disable  nniq-eric-1  nniq-eric-2  nniq-eric-3  nniq-eric-4))
-
-
-
-(defthm nniq-eric-5
-  (implies (and (integerp p)
-                (integerp q)
-                (not (integerp (/ p q)))
-                (< 0 p)
-                (< 0 q))
-           (< (nonnegative-integer-quotient p q)
-              (/ p q)))
-  :hints (("Goal" :in-theory  (disable nniq-eric-1 RATIONAL-IMPLIES2)
-           :use  (nniq-eric-1 RATIONAL-IMPLIES2))))
-
-
-(defthm nniq-eric-6
-  (implies (and (integerp p)
-                (integerp q)
-                (not (integerp (/ p q)))
-                (< 0 p)
-                (< 0 q))
-           (< (* q (nonnegative-integer-quotient p q))
-              p))
-  :hints (("Goal" :in-theory  (disable nonnegative-integer-quotient nniq-eric-5)
-           :use  (nniq-eric-5))))
-
-(defthm nniq-eric-7
-  (implies (and (integerp p)
-                (integerp q)
-                (not (integerp (/ p q)))
-                (< 0 p)
-                (< 0 q))
-           (<= (+ 1 (* q (nonnegative-integer-quotient p q)))
-              p))
-  :hints (("Goal" :in-theory  (disable nonnegative-integer-quotient nniq-eric-6)
-           :use  (nniq-eric-6))))
-
-
-(defthm nniq-eric-8
-  (implies (and (integerp p)
-                (integerp q)
-                (not (integerp (/ p q)))
-                (< 0 p)
-                (< 0 q))
-           (<= (+ (/ q) (nonnegative-integer-quotient p q))
-               (/ p q)))
-  :hints (("Goal" :in-theory  (disable nonnegative-integer-quotient nniq-eric-7)
-           :use  (nniq-eric-7))))
-
-(in-theory (disable  nniq-eric-5 nniq-eric-6 nniq-eric-7 nniq-eric-8))
-
-
-
-
-
-
-
-
-#|
-;too hard?
-(DEFTHM NONNEGATIVE-INTEGER-QUOTIENT-split-sum-case-1
-  (IMPLIES (AND (INTEGERP i1)
-                (> i1 0)
-                (INTEGERP i2)
-                (> i2 0)
-                (INTEGERP j)
-                (> j 0)
-                (< (+ (mod i1 j)
-                      (mod i2 j)) j)
-                )
-           (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (+ i1 i2)
-                                                j)
-                  (+  (NONNEGATIVE-INTEGER-QUOTIENT i1 j)
-                      (NONNEGATIVE-INTEGER-QUOTIENT i2 j))))
-
-
-)
-
-
-
-
-
-
-
-
-
-
-;integers
-;nniq of x+a*y and y is nniq of x and y, + a
-
-
-
-i/j = (nniq i j) + (mod/rem i j)  
-
-
-
-
-
-
-
-
-
-
-
-
-|#
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/numerator.lisp acl2-6.3/books/rtl/rel5/arithmetic/numerator.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/numerator.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/numerator.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,80 +0,0 @@
-(in-package "ACL2")
-
-;ass also some stuff in nniq.lisp
-
-(local (include-book "ground-zero"))
-(local (include-book "fp2"))
-(local (include-book "denominator")) ;drop?
-(local (include-book "predicate"))
-
-(defthm numerator-of-non-rational-is-zero
-  (implies (not (rationalp x))
-           (equal (numerator x)
-                  0)))
-
-
-;;
-;; type-prescriptions
-;;
-
-;(thm (integerp (numerator x))) goes through
-
-(defthm numerator-negative-integer-type-prescription
-  (implies (and (< x 0)
-                (case-split (rationalp x)))
-           (and (< (numerator x) 0)
-                (integerp (numerator x))))
-  :rule-classes (:type-prescription))
-
-(defthm numerator-positive-integer-type-prescription
-  (implies (and (< 0 x)
-                (case-split (rationalp x)))
-           (and (< 0 (numerator x))
-                (integerp (numerator x))))
-  :rule-classes (:type-prescription))
-           
-(defthm numerator-non-positive-integer-type-prescription
-  (implies (<= x 0)
-           (and (<= (numerator x) 0)
-                (integerp (numerator x))))
-  :rule-classes (:type-prescription))
-
-(defthm numerator-non-negative-integer-type-prescription
-  (implies (<= 0 x)
-           (and (<= 0 (numerator x))
-                (integerp (numerator x))))
-  :rule-classes (:type-prescription))
-
-;;
-;; comparisons with zero
-;;
-
-
-(defthm numerator-less-than-zero
-  (implies (case-split (rationalp x))
-           (equal (< (numerator x) 0)
-                  (< x 0)))
-   :hints (("goal" :in-theory (disable rational-implies2)
-           :use (rational-implies2))))
-
-(defthm numerator-greater-than-zero
-  (implies (case-split (rationalp x))
-           (equal (< 0 (numerator x))
-                  (< 0 x)))
-   :hints (("goal" :in-theory (disable rational-implies2)
-           :use (rational-implies2))))
-
-(defthm numerator-equal-zero
-  (implies (case-split (rationalp x))
-           (equal (equal (numerator x) 0)
-                  (equal x 0))))
-
-
-;;
-
-(defthm numerator-of-integer-is-the-integer-itself
-  (implies (integerp x)
-           (equal (numerator x)
-                  x))
-   :hints (("Goal" :in-theory (disable rational-implies2)
-           :use (rational-implies2))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/power2p.lisp acl2-6.3/books/rtl/rel5/arithmetic/power2p.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/power2p.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/power2p.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,166 +0,0 @@
-(in-package "ACL2")
-
-;The rule power2p-rewrite has proven quite helpful.
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(local (include-book "fl")) ;or could use floor?
-(local (include-book "fp2"))
-(local (include-book "predicate"))
-(local (include-book "unary-divide"))
-
-;old version
-;(defun power2p (x)
- ; (equal x (expt 2 (expo x))))
-
-(include-book "ordinals/e0-ordinal" :dir :system)
-(set-well-founded-relation e0-ord-<)
-
-(defund power2p-measure (x)
-  (declare (xargs :guard (and (rationalp x) (not (equal x 0)))))
-  (cond ((or (not (rationalp x))
-             (<= x 0)) 0)
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund power2p (x)
-  (declare (xargs :guard t
-                  :measure (power2p-measure x)
-                  :hints (("goal" :in-theory (enable power2p-measure)))))
-  (cond ((or (not (rationalp x))
-             (<= x 0))
-         nil)
-        ((< x 1) (power2p (* 2 x)))
-        ((<= 2 x) (power2p (* 1/2 x)))
-        ((equal x 1) t)
-        (t nil) ;got a number in the doubly-open interval (1,2)
-        ))
-
-#| A term fits the "power of 2" pattern iff it is a tree built using * and /  (actually, binary-* and unary-/)
-in which each leaf is either a rational constant which is a power of 2 or a term of the form (EXPT 2 I).
-|#
-
-(defund power2-syntaxp (term)
-  (if (not (consp term))
-      nil
-    (case (car term)
-      (quote (and (rationalp (cadr term)) 
-                  (power2p (cadr term))))
-      (expt (equal (cadr term) '(quote 2))) ;allow the base to be any power of 2?  (constants only? or (expt 2 n)??
-      (binary-* (and (power2-syntaxp (cadr term))
-                     (power2-syntaxp (caddr term))))
-      (unary-/ (power2-syntaxp (cadr term)))
-      (otherwise nil))))
-
-#|
-
-Notes:
-
-(power2-syntaxp ''2)
-(power2-syntaxp '(expt 2 i))
-(power2-syntaxp '(unary-/ (expt 2 i)))
-(power2-syntaxp '(binary-/ (expt 2 i) (expt 2 j)))
-(power2-syntaxp '(binary-* (expt 2 i) (expt 2 j)))
-(power2-syntaxp '(binary-* '2 (binary-* (expt '2 j) (expt '2 k))))
-(power2-syntaxp '(binary-* '2 (binary-* (expt '2 j) (expt '2 (binary-+ k (binary-* '-1 j))))))
-
-|#
-
-
-;induction?
-(defthmd power2p-with-arg-between-one-and-two
-  (implies (and (< 1/2 x)
-                (< x 1)
-                )
-           (not (power2p x)))
-  :hints (("goal" :in-theory  (enable power2p)))
-  )
-
-(defthm power2p-of-non-rational
-  (implies (not (rationalp x))
-           (equal (power2p x)
-                  nil))
-  :hints (("goal" :in-theory (enable power2p))))
-
-(defthm power2p-of-non-positive
-  (implies (not (< 0 x))
-           (equal (power2p x)
-                  nil))
-  :hints (("goal" :in-theory (enable power2p))))
-
-;induction
-(defthm power2p-inverse
-  (and (equal (power2p (/ x))
-              (power2p x))
-       (equal (power2p (/ 1 x)) ;do we need this?
-              (power2p x)))
-  :otf-flg t
-  :hints (("goal" :in-theory (enable power2p
-                                     power2p-with-arg-between-one-and-two))))
-
-;what about (/ -1 x) ? (/ 1 (- x)) ?
-;in general, what if x is negative, and we have something like (power2p (- x)) ?
-
-;power2p-double and power2p-half helped clean up the proof of power2p-prod
-(defthmd power2p-double
-  (equal (power2p (* 2 x))
-         (power2p x))
-  :hints (("goal" :in-theory (enable power2p
-                                     power2p-with-arg-between-one-and-two))))
-
-(defthmd power2p-half
-  (equal (power2p (* 1/2 x))
-         (power2p x))
-  :hints (("goal" :in-theory (enable power2p
-                                     power2p-with-arg-between-one-and-two))))
-;consider enabling?
-(defthmd power2p-prod
-  (implies (and (power2p x)
-                (power2p y))
-           (power2p (* x y)))
-  :hints (("goal" :in-theory (enable power2p power2p-double power2p-half
-                                     power2p-with-arg-between-one-and-two))))
-
-;robustify with power2p-quotient?
-
-;reorder hyps?  make conclusion into an equality?
-(defthmd power2p-prod-not
-  (implies (and (not (power2p x))
-                (power2p y)
-                )
-           (not (power2p (* x y))))
-   :hints (("goal" :in-theory (disable power2p-prod)
-            :use (:instance power2p-prod (x (* x y)) (y (/ y))))))
-
-(defthm power2p-shift
-  (implies (and (syntaxp (power2-syntaxp x))
-                (force (power2p x)) ;this should be true if the syntaxp hyp is satisfied
-                )
-           (equal (power2p (* x y))
-                  (power2p y)))
-  :hints (("goal"
-           :use ((:instance power2p-prod-not (y x) (x y))
-                 (:instance power2p-prod (y x) (x y))))))
-
-(defthm power2p-shift-2
-  (implies (and (syntaxp (power2-syntaxp y))
-                (force (power2p y)) ;this should be true if the syntaxp hyp is satisfied
-                )
-           (equal (power2p (* x y))
-                  (power2p x)))
-  :hints (("goal" :in-theory (disable power2p)
-           :use ( power2p-prod-not power2p-prod))))
-
-
-;make rules for quotient of powers of 2
-
-
-(defthm power2p-means-positive-rationalp
-  (implies (power2p x)
-           (and (< 0 x)
-                (rationalp x)))
-  :rule-classes ((:forward-chaining :trigger-terms ((POWER2P X)))))
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/predicate.lisp acl2-6.3/books/rtl/rel5/arithmetic/predicate.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/predicate.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/predicate.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,25 +0,0 @@
-(in-package "ACL2")
-
-;Rewrites an equality of two "predicates" to, essentially, an iff.  This can save you from having to do two
-;proofs, one for each of the forward and back directions.
-
-;Feel free to add more predicates to this list as time goes on.
-(defun predicatep (term)
-  (and (consp term) ;drop this test?
-       (member (car term) '(< integerp power2p complex-rationalp rationalp bvecp))))
-
-;This can cause case-splits, but that's sort of the point.
-;We could actually rewrite to iff instead of the and of the implies...
-(defthm equal-of-preds-rewrite
-  (implies (and (syntaxp (and (predicatep a)
-                              (predicatep b)))
-                (case-split (booleanp a)) ;or force?
-                (case-split (booleanp b)) ;or force?
-                )
-           (equal (equal a b)
-                  (and (implies a b)
-                       (implies b a)))))
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/product-proofs.lisp acl2-6.3/books/rtl/rel5/arithmetic/product-proofs.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/product-proofs.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/product-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,113 +0,0 @@
-(in-package "ACL2")
-
-;These rules may cause case splits, but that's sort of the point.
-
-(local (include-book "predicate"))
-(local (include-book "fp2"))
-
-(local (defthm hack2
-         (implies
-          (and (< y 0)
-               (rationalp x)
-               (case-split (< x 0))
-               )
-          (<= 0 (* x y)))
-       ))
-
-;BOZO instead of having 2 rules below, consider putting an OR inside the CASE-SPLIT
-;make these 2 nicer? ;do we need both?
-
-
-#| the conclusion of product-less-than-zero used to be this, which didn't mention acl2-numberp of x...
-                  (or (and (< x 0) (< 0 y))
-                      (and (< y 0) (< 0 x)))
-|#
-
-(defthm product-less-than-zero-1
-  (implies (case-split (not (complex-rationalp x))) ;can't gen: (* #C(-1 9) #C(-1 9))=#c(-80 -18)
-           (equal (< (* x y) 0)
-                  (if (< x 0)
-                      (< 0 y)
-                    (if (equal 0 x)
-                        nil
-                      (if (not (acl2-numberp x))
-                          nil
-                        (< y 0))))))
-  :otf-flg t
-  :hints (("Goal" :cases ((and (rationalp x) (rationalp y))
-                          (and (complex-rationalp x) (rationalp y))
-                          (and (not (acl2-numberp x)) (rationalp y))
-                          (and (rationalp x) (complex-rationalp y))
-                          (and (complex-rationalp x) (complex-rationalp y))
-                          (and (not (acl2-numberp x)) (complex-rationalp y))
-                          ))))
-
-(defthm product-less-than-zero-2
-  (implies (case-split (not (complex-rationalp y))) ;(case-split (rationalp y))
-           (equal (< (* x y) 0)
-                  (or (and (< x 0) (< 0 y))
-                      (and (< y 0) (< 0 x)))))
-  :hints (("Goal" :in-theory (disable product-less-than-zero-1)
-           :use (:instance  product-less-than-zero-1 (x y) (y x)))))
-
-(defthm product-less-than-zero
-  (implies (case-split (or (not (complex-rationalp x))
-                           (not (complex-rationalp y)))) ;can't gen: (* #C(-1 9) #C(-1 9))=#c(-80 -18)
-           (equal (< (* x y) 0)
-                  (if (< x 0)
-                      (< 0 y)
-                    (if (equal 0 x)
-                        nil
-                      (if (not (acl2-numberp x))
-                          nil
-                        (< y 0)))))))
-
-
-;combine the next twp by case-splittin on an OR?
-(defthm product-greater-than-zero
-  (implies (case-split (not (complex-rationalp y)))
-           (equal (< 0 (* x y))
-                  (or (and (< 0 x) (< 0 y))
-                      (and (< y 0) (< x 0)))))
-  :hints (("Goal" :cases (complex-rationalp x))))
-
-(defthm product-greater-than-zero-2
-  (implies (case-split (not (complex-rationalp x)))
-           (equal (< 0 (* x y))
-                  (or (and (< 0 x) (< 0 y))
-                      (and (< y 0) (< x 0)))))
-  :hints (("Goal" :in-theory (disable product-greater-than-zero)
-           :use (:instance  product-greater-than-zero (x y) (y x)))))
-
-;could write the conclusion using an OR...
-(defthm product-equal-zero
-  (equal (equal 0 (* x y))
-         (if (not (acl2-numberp x))
-             t
-           (if (not (acl2-numberp y))
-               t
-             (if (equal 0 x)
-                 t
-               (equal 0 y)))))
-  :hints (("Goal" :cases (complex-rationalp x))))
-
-
-#|
-;product-equal-zero is better?
-(defthm equal-zero-product
-  (implies (and (not (equal 0 x))
-                (case-split (acl2-numberp x))
-                (case-split (acl2-numberp y))
-                )
-           (equal (equal 0 (* x y))
-                  (equal 0 y))))
-
-;product-equal-zero is better?
-(defthm equal-zero-product-2
-  (implies (and (case-split (acl2-numberp x))
-                (case-split (acl2-numberp y))
-                (case-split (not (equal 0 x)))
-                )
-           (equal (equal 0 (* y x))
-                  (equal 0 y))))
-|#
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/product.lisp acl2-6.3/books/rtl/rel5/arithmetic/product.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/product.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/product.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,63 +0,0 @@
-(in-package "ACL2")
-
-;These rules may cause case splits, but that's sort of the point.
-
-(local (include-book "product-proofs"))
-
-(defthm product-less-than-zero
-  (implies (case-split (or (not (complex-rationalp x))
-                           (not (complex-rationalp y)))) ;can't gen: (* #C(-1 9) #C(-1 9))=#c(-80 -18)
-           (equal (< (* x y) 0)
-                  (if (< x 0)
-                      (< 0 y)
-                    (if (equal 0 x)
-                        nil
-                      (if (not (acl2-numberp x))
-                          nil
-                        (< y 0)))))))
-
-
-#|
-(defthm product-less-than-zero
-  (implies (case-split (not (complex-rationalp x))) ;can't gen: (* #C(-1 9) #C(-1 9))=#c(-80 -18)
-           (equal (< (* x y) 0)
-                  (if (< x 0)
-                      (< 0 y)
-                    (if (equal 0 x)
-                        nil
-                      (if (not (acl2-numberp x))
-                          nil
-                        (< y 0)))))))
-
-;this use hint shouldn't be needed
-(defthm product-less-than-zero-2
-  (implies (case-split (not (complex-rationalp y))) ;(case-split (rationalp y))
-           (equal (< (* x y) 0)
-                  (or (and (< x 0) (< 0 y))
-                      (and (< y 0) (< 0 x))))))
-|#
-
-;combine the next two by case-splittin on an OR?
-(defthm product-greater-than-zero
-  (implies (case-split (not (complex-rationalp y)))
-           (equal (< 0 (* x y))
-                  (or (and (< 0 x) (< 0 y))
-                      (and (< y 0) (< x 0))))))
-
-(defthm product-greater-than-zero-2
-  (implies (case-split (not (complex-rationalp x)))
-           (equal (< 0 (* x y))
-                  (or (and (< 0 x) (< 0 y))
-                      (and (< y 0) (< x 0))))))
-
-;could write the conclusion using an OR...
-(defthm product-equal-zero
-  (equal (equal 0 (* x y))
-         (if (not (acl2-numberp x))
-             t
-           (if (not (acl2-numberp y))
-               t
-             (if (equal 0 x)
-                 t
-               (equal 0 y))))))
-
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/rationalp.lisp acl2-6.3/books/rtl/rel5/arithmetic/rationalp.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/rationalp.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/rationalp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,56 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "predicate"))
-
-(defthm rationalp-product-when-one-arg-is-rational
-  (implies (and (rationalp x)
-                (case-split (not (equal x 0)))
-                (case-split (acl2-numberp y))
-                )
-           (and (equal (rationalp (* x y))
-                       (rationalp y))
-                (equal (rationalp (* y x))
-                       (rationalp y)))))
-
-(defthm rationalp-sum-when-one-arg-is-rational
-  (implies (and (rationalp x)
-                (case-split (acl2-numberp y)))
-           (and (equal (rationalp (+ x y))
-                       (rationalp y))
-                (equal (rationalp (+ y x))
-                       (rationalp y)))))
-
-(defthm rationalp-unary-divide
-  (implies (case-split (acl2-numberp x))
-           (equal (rationalp (/ x))
-                  (rationalp x))))
-
-
-                
-
-                
-#|
-
-(defthm rationalp-*-when-first-factor-is-rat
-  (implies (and (rationalp x)
-                (case-split (not (equal x 0))) ;if x is 0, then...
-                )
-           (equal (rationalp (* x y))
-                  (not (complex-rationalp y)))))
-
-(thm
-  (implies (and (rationalp x)
-                (case-split (not (equal x 0))) ;if x is 0, then...
-                )
-           (equal (rationalp (* x y))
-                  (not (complex-rationalp y)))))
-
-|#
-
-
-;try
-
-(defthm rationalp-product
-  (implies (and (case-split (not (complex-rationalp x)))
-                (case-split (not (complex-rationalp y))))
-           (rationalp (* x y))))
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/top.lisp acl2-6.3/books/rtl/rel5/arithmetic/top.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/top.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/top.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,58 +0,0 @@
-(in-package "ACL2")
-
-;An attempt to include all the books in arithmetic/ (to check for name conflicts and so forth).
-
-;Keep this list up-to-date:
-
-(include-book "ground-zero") ;disables some of the built-in functions which should be disabled when ACL2 starts
-
-(include-book "induct") ;Induction schemes			
-
-(include-book "denominator")		 
-(include-book "numerator")			
-(include-book "nniq") ;lemmas about nonnegative-integer-quotient			
-
-(include-book "complex-rationalp")		
-(include-book "rationalp")			
-(include-book "integerp")			
-
-;BOZO What's the difference between these 4?
-(include-book "arith")			
-(include-book "arith2")			
-(include-book "fp2")			
-(include-book "basic") ;this is Doc's book.  mixed lemmas about fl, mod, expt, and squaring
-
-(include-book "unary-divide")		
-(include-book "product") ;mostly stuff about comparing a product to zero.
-
-(include-book "inverted-factor")			
-
-(include-book "negative-syntaxp") ;handy recognizer for terms with look negative, needed by some of the other books.
-
-(include-book "predicate") ;splits an equality of two "predicates" into two implications			
-(include-book "x-2xx") ;A very special-purpose lemma having to do with 2x^2
-
-(include-book "power2p") ;recognizer for powers of 2			
-(include-book "expt")			
-(include-book "expo") ;sort of my top-level book dealing with powers of 2.
-
-;I commented out these two because we don't need them in support/.  
-;(include-book "hacks")			 ;BOZO Figure out exactly what this is.
-(include-book "fl-hacks") ; needed for fl-m-n, at the least
-
-(include-book "even-odd2") ;recursive analogues of evenp and oddp			
-(include-book "even-odd") ;lemmas 1/2 and even and odd numbers
-
-
-;;(include-book "floor-proofs")
-(include-book "floor")
-(include-book "fl")				
-(include-book "cg")				
-(include-book "mod")  
-
-(include-book "fl-expt") ;lemmas mixing fl and expt			
-(include-book "mod-expt") ;lemmas mixing mod and expt			
-
-(include-book "common-factor") ;
-
-               
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/unary-divide.lisp acl2-6.3/books/rtl/rel5/arithmetic/unary-divide.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/unary-divide.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/unary-divide.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,71 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "predicate"))
-(local (include-book "fp2"))
-(local (include-book "inverted-factor"))
-
-(defthm unary-divide-less-than-zero
-  (implies (case-split (not (complex-rationalp x))) ;drop?
-           (equal (< (/ x) 0)
-                  (< x 0))))
-
-#|
-;try
-(defthm unary-divide-less-than-zero
-  (implies t;(case-split (not (complex-rationalp x))) ;drop?
-           (equal (< (/ x) 0)
-                  (< x 0))))
-|#
-
-;perhaps we don't need these, if we have rules like
-;less-than-multiply-through-by-inverted-factor-from-left-hand-side ?
-(defthm unary-divide-greater-than-zero
-  (implies (case-split (not (complex-rationalp x))) ;drop?
-           (equal (< 0 (/ x))
-                  (< 0 x))))
-
-(defthm unary-divide-equal-0
-  (implies (case-split (acl2-numberp x))
-           (equal (equal 0 (/ x))
-                  (equal 0 x))))
-
-;BOZO Why do we require the constant to be non-zero?
-(defthm unary-divide-equal-non-zero-constant
-  (implies (and (syntaxp (and (quotep k)
-                              ;(not (equal 0 (cadr k)))
-                              ))  ;drop?
-                ;(case-split (not (equal 0 k)))
-                (case-split (acl2-numberp x))
-                (case-split (acl2-numberp k))
-                )
-           (equal (equal k (/ x))
-                  (equal (/ k) x))))
-
-;make a negative case?
-(defthm unary-divide-less-than-non-zero-constant
-  (implies (and (syntaxp (and (quotep k) (not (equal 0 (cadr k)))))  ;drop?
-                (<= 0 k)
-                (case-split (<= 0 x))
-                (case-split (not (equal 0 k)))
-                (case-split (not (equal 0 x)))
-                (case-split (rationalp x))
-                (case-split (rationalp k))
-                )
-           (equal (< (/ x) k)
-                  (< (/ k) x))))
-
-
-;once with this msg failed:
-;1x (:REWRITE UNARY-DIVIDE-GREATER-THAN-NON-ZERO-CONSTANT) failed because it permutes a big term forward.
-;so I changed the conclusion to not use unary-/
-(defthm unary-divide-greater-than-non-zero-constant
-  (implies (and (syntaxp (and (quotep k) (not (equal 0 (cadr k)))))  ;drop?
-                (<= 0 k)
-                (case-split (<= 0 x))
-                (case-split (not (equal 0 k)))
-                (case-split (not (equal 0 x)))
-                (case-split (rationalp x))
-                (case-split (rationalp k))
-                )
-           (equal (< k (/ x))
-                  (< x (/ 1 k)))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/arithmetic/x-2xx.lisp acl2-6.3/books/rtl/rel5/arithmetic/x-2xx.lisp
--- acl2-6.2/books/rtl/rel5/arithmetic/x-2xx.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/arithmetic/x-2xx.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,142 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-; The following proof is due to John Cowles.
-
-(in-package "ACL2")
-
-(local (include-book "arithmetic/top-with-meta" :dir :system))
-
-(local (include-book "arithmetic/mod-gcd" :dir :system))
-
-;; The definition of nonneg-int-gcd often interacts with the rewrite rule,
-;; commutativity-of-nonneg-int-gcd, to cause the rewriter to loop and stack
-;; overflow. 
-(local (in-theory (disable commutativity-of-nonneg-int-gcd)))
-
-(local
- (defthm lemma-1
-   (implies (and (rationalp x)
-                 (integerp (* 2 x x)))
-            (equal
-             (* 2 (abs (numerator x))(abs (numerator x)))
-             (* (denominator x)(denominator x)(numerator (* 2 x x)))))
-   :rule-classes nil))
-
-(local
- (defthm lemma-2
-   (implies (and (integerp x)
-                 (> x 0)
-                 (integerp y)
-                 (equal (* x y) z))
-            (equal (nonneg-int-mod z x) 0))
-   :rule-classes nil))
-
-(local
- (defthm lemma-3
-   (implies (and (rationalp x)
-                 (integerp (* 2 x x)))
-            (equal (nonneg-int-mod (* 2 (abs (numerator x)))
-                                   (denominator x))
-                   0))
-   :hints (("Goal"
-            :in-theory (disable abs)
-            :use ((:instance
-                   Divisor-of-product-divides-factor
-	           (x (* 2 (abs (numerator x))))
-                   (y (abs (numerator x)))
-                   (z (denominator x)))
-		  lemma-1
-		  (:instance
-                   lemma-2
-                   (x (denominator x))
-                   (y (* (denominator x)(numerator (* 2 x x))))
-		   (z (* 2 (abs (numerator x))(abs (numerator x)))))
-		  Nonneg-int-gcd-numerator-denominator)))))
-
-(local
- (defthm lemma-4
-   (implies (and (rationalp x)
-                 (integerp (* 2 x x)))
-            (equal (nonneg-int-mod 2 (denominator x))
-                   0))
-   :hints (("Goal"
-            :in-theory (disable abs)
-            :use ((:instance
-                   Divisor-of-product-divides-factor
-	           (x 2)
-                   (y (abs (numerator x)))
-                   (z (denominator x)))
-		  Nonneg-int-gcd-numerator-denominator)))))
-
-(local
- (defthm lemma-5
-   (implies (and (rationalp x)
-                 (integerp (* 2 x x)))
-            (or (equal (denominator x) 1)
-                (equal (denominator x) 2)))
-   :rule-classes nil
-   :hints (("Goal"
-            :use (:instance
-                  Divisor-<=
-                  (d (denominator x))
-                  (n 2))))))
-
-(local
- (defthm lemma-6
-   (implies (and (rationalp x)
-                 (integerp (* 2 x x))
-                 (equal (denominator x) 2))
-            (equal (* (abs (numerator x))(abs (numerator x)))
-                   (* 2 (numerator (* 2 x x)))))
-   :hints (("Goal"
-            :in-theory (disable abs)
-            :use lemma-1)))) 
-
-(local
- (defthm lemma-7
-   (implies (and (rationalp x)
-                 (integerp (* 2 x x))
-                 (equal (denominator x) 2))
-            (equal (nonneg-int-mod (* (abs (numerator x))(abs (numerator x)))
-                                   2)
-                   0))
-   :hints (("Goal"
-            :in-theory (disable abs)
-            :use (:instance
-                  lemma-2
-                  (x 2)
-                  (y (numerator (* 2 x x)))
-                  (z (* (abs (numerator x))(abs (numerator x)))))))))
-
-(local
- (defthm lemma-8
-   (implies (and (rationalp x)
-                 (integerp (* 2 x x))
-                 (equal (denominator x) 2))
-            (equal (nonneg-int-mod (abs (numerator x))
-                                   2)
-                   0))
-   :hints (("Goal"
-            :use ((:instance
-                   Divisor-of-product-divides-factor
-                   (x (abs (numerator x)))
-                   (y (abs (numerator x)))
-                   (z (denominator x)))
-                  Nonneg-int-gcd-numerator-denominator
-                  lemma-7)))))
-
-(defthm x-2xx
-  (implies (and (rationalp x)
-		(integerp (* 2 x x)))
-	   (integerp x))
-  :hints (("Goal"
-	   :in-theory (disable abs)
-	   :use (lemma-5
-		 Nonneg-int-gcd-numerator-denominator)))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/lib/Makefile acl2-6.3/books/rtl/rel5/lib/Makefile
--- acl2-6.2/books/rtl/rel5/lib/Makefile	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-include ../../../Makefile-generic
--include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel5/lib/README acl2-6.3/books/rtl/rel5/lib/README
--- acl2-6.2/books/rtl/rel5/lib/README	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/README	1970-01-01 00:00:00.000000000 +0000
@@ -1,16 +0,0 @@
-In order to include all books of the library, simply include the book
-"lib/top".  (All of the "support" books may similarly be loaded via
-the book "support/top".)  Alternatively, a subset of these books may
-be loaded, according to the user's intentions.  In particular,
-
-(1) "rtlarr" is needed only if arrays are involved in the application.
-
-(2) "basic", "float", "reps", "round", "fadd", "brat" and "package-defs"
-    are intended to be used specifically for floating-point applications.
-
-(3) "util" has no effect on the proof process and may be omitted.
-
-(4) "arith" contains a set of arithmetic rules that past users have found
-     useful; it may be omitted or replaced by another ACL2 arithmetic package.
-    (We recommend the package in the "arithmetic/" directory, since it enforces normal 
-    forms which the rules in "lib/" may depend on.
diff -Nru acl2-6.2/books/rtl/rel5/lib/add.lisp acl2-6.3/books/rtl/rel5/lib/add.lisp
--- acl2-6.2/books/rtl/rel5/lib/add.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/add.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,444 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/top"))
-
-(include-book "round")
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-
-;;;**********************************************************************
-;;;                      Bit Vector Addition
-;;;**********************************************************************
-
-(defthm half-adder
-  (implies (and (bvecp u 1)
-                (bvecp v 1))
-           (equal (+ u v)
-                  (cat (land u v 1) 1 (lxor u v 1) 1)))
-  :rule-classes ())
-
-(defthm add-2
-  (implies (and (not (zp n))
-                (bvecp x n)
-                (bvecp y n))
-           (equal (+ x y)
-                  (+ (lxor x y n)
-                     (* 2 (land x y n)))))
-  :rule-classes ())
-
-(defthm full-adder
-  (implies (and (bvecp u 1)
-                (bvecp v 1)
-                (bvecp w 1))
-           (equal (+ u v w)
-                  (cat (lior (land u v 1) (lior (land u w 1) (land v w 1) 1) 1) 1 
-                       (lxor u (lxor v w 1) 1) 1)))
-  :rule-classes ())
-
-(defthm add-3
-  (implies (and (not (zp n))
-                (bvecp x n)
-                (bvecp y n)
-                (bvecp z n))
-           (equal (+ x y z)
-                  (+ (lxor x (lxor y z n) n)
-                     (* 2 (lior (land x y n)
-                                (lior (land x z n)
-                                      (land y z n)
-                                      n)
-                                n)))))
-  :rule-classes ())
-
-(defun rc-carry (x y k)
-  (if (zp k)
-      0
-    (lior (land (bitn x (1- k)) (bitn y (1- k)) 1)
-	  (lior (land (bitn x (1- k)) (rc-carry x y (1- k)) 1)
-		(land (bitn y (1- k)) (rc-carry x y (1- k)) 1)
-		1)
-	  1)))
-
-(defun rc-sum (x y k)
-  (if (zp k)
-      0
-    (cat (lxor (bitn x (1- k))
-	       (lxor (bitn y (1- k)) (rc-carry x y (1- k)) 1)
-	       1)
-	 1
-	 (rc-sum x y (1- k))
-	 (1- k))))
-
-(defthm ripple-carry
-  (implies (and (natp x)
-                (natp y)
-                (natp n))
-           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
-                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
-  :rule-classes ())
-
-(defun gen (x y i j)
-  (declare (xargs :measure (nfix (1+ i))))
-  (if (and (natp i) (natp j) (>= i j))
-      (if (= (bitn x i) (bitn y i))
-	  (bitn x i)
-	(gen x y (1- i) j))
-    0))
-
-(defun prop (x y i j)
-  (declare (xargs :measure (nfix (1+ i))))
-  (if (and (natp i) (natp j) (>= i j))
-      (if (= (bitn x i) (bitn y i))
-	  0
-	(prop x y (1- i) j))
-    1))
-
-(defthm bvecp-1-gen
-  (bvecp (gen x y i j) 1)
-  :rule-classes (:rewrite
-                 (:forward-chaining :trigger-terms ((gen x y i j)))))
-
-(defthm bvecp-1-prop
-  (bvecp (prop x y i j) 1)
-  :rule-classes (:rewrite
-                 (:forward-chaining :trigger-terms ((prop x y i j)))))
-
-(defthmd gen-val
-  (implies (and (natp j) (>= i j))
-           (equal (gen x y i j)
-                  (if (>= (+ (bits x i j) (bits y i j))
-                          (expt 2 (1+ (- i j))))
-                      1
-                    0))))
-
-(defthmd gen-val-cor1
-  (implies (natp j)
-           (equal (gen x y i j)
-                  (bitn (+ (bits x i j) (bits y i j))
-			(1+ (- i j))))))
-
-(defthmd gen-val-cor2
-  (implies (and (natp x)
-                (natp y)
-		(natp i))
-           (equal (+ (bits x i 0) (bits y i 0))
-		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
-		     (bits (+ x y) i 0)))))
-
-(defthm gen-special-case
-  (implies (and (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0)
-                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
-           (equal (gen x y i j)
-                  (lior (bitn x i) (bitn y i) 1)))
-  :rule-classes ())
-
-(defthmd prop-val
-  (implies (and (integerp i) (natp j) (>= i j))
-           (equal (prop x y i j)
-                  (if (= (+ (bits x i j) (bits y i j))
-                         (1- (expt 2 (1+ (- i j)))))
-                      1
-                    0))))
-
-(defthmd prop-as-lxor
-  (implies (and (natp i)
-                (natp j)
-                (<= j i)
-                (natp x)
-                (natp y))
-           (equal (prop x y i j)
-                  (if (equal (lxor (bits x i j) (bits y i j) (1+ (- i j)))
-                             (1- (expt 2 (1+ (- i j)))))
-                      1
-                    0))))
-
-(defthm gen-extend
-  (implies (and (integerp i)
-                (integerp j)
-                (integerp k)
-                (> i k)
-                (>= k j)
-                (>= j 0))
-           (equal (gen x y i j)
-                  (lior (gen x y i (1+ k))
-                        (land (prop x y i (1+ k))
-                              (gen x y k j)
-                              1)
-                        1)))
-  :rule-classes ())
-
-(defthm gen-extend-cor
-  (implies (and (natp x)
-                (natp y)
-                (natp i)
-                (natp j)
-                (natp k)
-                (> i k)
-                (>= k j))
-           (equal (gen x y i j)
-                  (bitn (+ (bits x i (1+ k))
-                           (bits y i (1+ k))
-                           (gen x y k j))
-                        (- i k))))
-  :rule-classes ())
-
-(defthm prop-extend
-  (implies (and (integerp i)
-                (integerp j)
-                (integerp k)
-                (> i k)
-                (>= k j)
-                (>= j 0))
-           (equal (prop x y i j)
-                  (land (prop x y i (1+ k))
-                        (prop x y k j)
-                        1)))
-  :rule-classes ())
-
-(defthm bits-sum
-  (implies (and (integerp x) (integerp y))
-           (equal (bits (+ x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (gen x y (1- j) 0))
-                        (- i j) 0)))
-  :rule-classes ())
-
-(defthmd bits-sum-swallow
-  (implies (and (equal (bitn x k) 0)
-                (natp x)
-                (natp y)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (>= i j)
-                (> j k)
-                (>= k 0)
-                (<= y (expt 2 k)))
-           (equal (bits (+ x y) i j)
-                  (bits x i j))))
-
-(defthmd bits-sum-cor
-  (implies (and (integerp x)
-                (integerp y)
-                (>= i j)
-                (>= j 0)
-                (= (gen x y i j) 0)
-                (= (gen x y (1- j) 0) 0))
-           (equal (bits (+ x y) i j)
-                  (+ (bits x i j) (bits y i j)))))
-
-(defthm bits-sum-3
-  (implies (and (integerp x) (integerp y) (integerp z))
-           (equal (bits (+ x y z) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bits z i j)
-                           (gen x y (1- j) 0)
-                           (gen (+ x y) z (1- j) 0))
-                        (- i j) 0)))
-  :rule-classes ())
-
-(defthm bits-sum-plus-1
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0))
-           (equal (bits (+ 1 x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (lior (prop x y (1- j) 0) 
-                                 (gen x y (1- j) 0) 
-                                 1))
-                        (- i j) 0)))
-  :rule-classes ())
-
-(defthmd land-gen-0
-  (implies (and (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0)
-                (= (land (bits x i j) (bits y i j) (1+ (- i j))) 0))
-           (equal (gen x y i j) 0)))
-
-(defthm land-gen-0-cor
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n i)
-                (>= i j)
-                (>= j 0)
-                (= (land x y n) 0))
-           (equal (bits (+ x y) i j)
-                  (+ (bits x i j) (bits y i j))))
-  :rule-classes ())
-
-(defthmd gen-plus
-  (implies (and (natp x)
-                (natp y)
-		(natp k)
-		(bvecp z (1+ k))
-		(= (land z y (1+ k)) 0)
-		(= (gen x y k 0) 1))
-	   (equal (gen (+ x y) z k 0) 0)))
-
-(defthmd gen-extend-3
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (bvecp z (1+ j))
-                (= (land y z (1+ j)) 0))		  
-           (equal (gen (+ x y) z i 0)
-                  (land (prop x y i (1+ j))
-                        (gen (+ x y) z j 0)			  
-                        1))))
-
-
-;;;**********************************************************************
-;;;                  Leading One Prediction
-;;;**********************************************************************
-
-(defund lop (a b d k)
-  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
-    (if (and (integerp k) (>= k 0))
-	(if (= k 0)
-	    0
-	  (if (= d 0)
-	      (lop a b c (1- k))
-	    (if (= d (- c))
-		(lop a b (- c) (1- k))
-	      k)))
-      0)))
-
-(defthm lop-bnds
-  (implies (and (integerp a)
-                (integerp b)
-                (integerp n)
-                (>= a 0)
-                (>= b 0)
-                (>= n 0)
-                (not (= a b))
-                (< a (expt 2 n))
-                (< b (expt 2 n)))
-           (or (= (lop a b 0 n) (expo (- a b)))
-               (= (lop a b 0 n) (1+ (expo (- a b))))))
-  :rule-classes ())
-
-(defthm lop-thm-1
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (= e (expo a))
-                (< (expo b) e)
-                (= lambda
-                   (lior (* 2 (mod a (expt 2 e)))
-                         (lnot (* 2 b) (1+ e))
-                         (1+ e))))
-           (or (= (expo (- a b)) (expo lambda))
-               (= (expo (- a b)) (1- (expo lambda)))))
-  :rule-classes ())
-
-(defun lamt (a b e)
-  (lxor a (lnot b (1+ e)) (1+ e)))
-
-(defun lamg (a b e)
-  (land a (lnot b (1+ e)) (1+ e)))
-
-(defun lamz (a b e)
-  (lnot (lior a (lnot b (1+ e)) (1+ e)) (1+ e)))
-
-(defun lam1 (a b e)
-  (land (bits (lamt a b e) e 2) 
-	(land (bits (lamg a b e) (1- e) 1)
-	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam2 (a b e)
-  (land (lnot (bits (lamt a b e) e 2) (1- e))
-	(land (bits (lamz a b e) (1- e) 1)
-	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam3 (a b e)
-  (land (bits (lamt a b e) e 2) 
-	(land (bits (lamz a b e) (1- e) 1)
-	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam4 (a b e)
-  (land (lnot (bits (lamt a b e) e 2) (1- e))
-	(land (bits (lamg a b e) (1- e) 1)
-	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam0 (a b e)
-  (lior (lam1 a b e)
-	(lior (lam2 a b e)
-	      (lior (lam3 a b e)
-		    (lam4 a b e)
-		    (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lamb (a b e)
-  (+ (* 2 (lam0 a b e))
-     (lnot (bitn (lamt a b e) 0) 1)))
-
-(defthm lop-thm-2
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (not (= a b))
-                (= e (expo a))
-                (= e (expo b))
-                (> e 1))
-           (and (not (= (lamb a b e) 0))
-                (or (= (expo (- a b)) (expo (lamb a b e)))
-                    (= (expo (- a b)) (1- (expo (lamb a b e)))))))
-  :rule-classes ())
-
-
-;;;**********************************************************************
-;;;                    Trailing One Prediction
-;;;**********************************************************************
-
-(defthm top-thm-1
-  (implies (and (natp n)
-                (natp k)
-                (< k n)
-                (integerp a)
-                (integerp b))
-           (equal (equal (bits (+ a b 1) k 0) 0)
-		  (equal (bits (lnot (lxor a b n) n) k 0) 0)))
-  :rule-classes ())
-
-(defthm top-thm-2
-  (implies (and (natp n)
-                (integerp a)
-                (integerp b)
-                (natp k)
-                (< k n)
-                (or (equal c 0) (equal c 1)))
-           (equal (equal (bits (+ a b c) k 0) 0)
-                  (equal (bits (lxor (lxor a b n) 
-                                     (cat (lior a b n) n c 1)
-                                     (1+ n)) 
-                               k 0) 
-                         0)))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/lib/arith.lisp acl2-6.3/books/rtl/rel5/lib/arith.lisp
--- acl2-6.2/books/rtl/rel5/lib/arith.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/arith.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,819 +0,0 @@
-; This file is based on the old "fp book", which was initially created by J
-; Moore and Matt Kaufmann in 1995 in support of their proof of the AMD-K5
-; division code.    Here, we have moved
-; non-local in-theory events to the end.  All events should be redundant, so we
-; have deleted all local in-theory events and added (local (in-theory nil)) to
-; the beginning.
-
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../arithmetic/fp"))
-(local (include-book "../arithmetic/fp2"))
-(local (include-book "../arithmetic/fl"))
-(local (include-book "../arithmetic/expt"))
-(local (include-book "../arithmetic/expo"))
-(local (include-book "../arithmetic/extra-rules"))
-(local (include-book "../support/ash"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-(defthm a1 (equal (+ x (+ y z)) (+ y (+ x z))))
-(defthm a2 (equal (- x) (* -1 x)))
-
-(defthm a3
-  (and
-   (implies
-    (syntaxp (and (quotep c1) (quotep c2)))
-    (and (equal (+ (* c1 x) (* c2 x)) (* (+ c1 c2) x))
-         (equal (+ (* c1 x) (+ (* c2 x) y)) (+ (* (+ c1 c2) x) y))))
-   (implies
-    (syntaxp (quotep c2))
-    (and (equal (+ x (* c2 x)) (* (+ 1 c2) x))
-         (equal (+ x (+ (* c2 x) y1)) (+ (* (+ 1 c2) x) y1))
-         (equal (+ x (+ y1 (* c2 x))) (+ (* (+ 1 c2) x) y1))
-         (equal (+ x (+ y1 (+ (* c2 x) y2))) (+ (* (+ 1 c2) x) y1 y2))
-         (equal (+ x (+ y1 (+ y2 (* c2 x)))) (+ (* (+ 1 c2) x) y1 y2))
-         (equal (+ x (+ y1 (+ y2 (+ y3 (* c2 x)))))
-                (+ (* (+ 1 c2) x) y1 y2 y3))
-         (equal (+ x (+ y1 (+ y2 (+ (* c2 x) y3))))
-                (+ (* (+ 1 c2) x) y1 y2 y3))))
-   (and (equal (+ x x) (* 2 x))
-        (equal (+ x (+ x y1)) (+ (* 2 x) y1)))))
-(defthm a4
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (equal (+ c1 (+ c2 y1)) (+ (+ c1 c2) y1))))
-(defthm a5
-  (implies (syntaxp (and (quotep c1) (quotep c2)))
-           (equal (* c1 (* c2 y1)) (* (* c1 c2) y1))))
-
-
-
-
-
-(defthm a6
-  (equal (/ (/ x)) (fix x)))
-(defthm a7
-  (equal (/ (* x y)) (* (/ x) (/ y))))
-
-;replaced force with case-split
-(defthm a8
-  (implies (and (case-split (acl2-numberp x))
-                (case-split (not (equal x 0))))
-           (and (equal (* x (* (/ x) y)) (fix y))
-                (equal (* x (/ x)) 1))))
-
-(defthm a9
-  (and (equal (* 0 x) 0)
-       (equal (* x (* y z)) (* y (* x z)))
-       (equal (* x (+ y z)) (+ (* x y) (* x z)))
-       (equal (* (+ y z) x) (+ (* y x) (* z x)))))
-
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-
-
-(defthm a10
-  (and (implies (integerp i) (equal (fl i) i))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1)) ;can actually drop this
-                     )
-                (and (equal (fl (+ i x1)) (+ i (fl x1)))
-                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2)))
-                (and (equal (fl (+ x1 (+ i x2))) (+ i (fl (+ x1 x2))))
-                     (equal (fl (+ x1 (+ x2 i))) (+ i (fl (+ x1 x2))))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2))
-                     (case-split (rationalp x3)))
-                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
-                            (+ i (fl (+ x1 x2 x3))))
-                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
-                            (+ i (fl (+ x1 x2 x3))))))
-       (implies (and (integerp i)
-                     (case-split (rationalp x1))
-                     (case-split (rationalp x2))
-                     (case-split (rationalp x3))
-                     (case-split (rationalp x4)))
-                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
-                            (+ i (fl (+ x1 x2 x3 x4))))
-                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
-                            (+ i (fl (+ x1 x2 x3 x4))))))))
-
-(defthm a12
-  (implies (and (integerp i)
-                (integerp j)
-                (< 1 j)
-                (< j i))
-           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
-                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
-  :rule-classes :linear)
-
-
-;replaced force with case-split                
-;later, drop the hyp completely
-(defthm a13
-  (implies (case-split (rationalp x)) ;drop!
-           (and (< (1- x) (fl x))
-                (<= (fl x) x)))
-  :rule-classes :linear)
-
-(defthm a14
-  (and
-   (implies (and (integerp i)
-                 (<= 0 i)
-                 (<= 0 j))
-            (and (integerp (expt i j))
-                 (<= 0 (expt i j))))
-   (implies (and (rationalp i)
-                 (not (equal i 0)))
-            (not (equal (expt i j) 0))))
-  :rule-classes
-  ((:type-prescription
-    :corollary
-    (implies (and (integerp i)
-                  (<= 0 i)
-                  (<= 0 j))
-             (and (integerp (expt i j))
-                  (<= 0 (expt i j)))))
-   (:type-prescription
-    :corollary
-    (implies (and (rationalp i)
-                  (not (equal i 0)))
-             (not (equal (expt i j) 0))))))
-
-(defthm a15
-  (implies (and (rationalp i)
-                (not (equal i 0))
-                (integerp j1)
-                (integerp j2))
-           (and (equal (* (expt i j1) (expt i j2))
-                       (expt i (+ j1 j2)))
-                (equal (* (expt i j1) (* (expt i j2) x))
-                       (* (expt i (+ j1 j2)) x)))))
-(defthm a16
-  (equal (expt (* a b) i)
-         (* (expt a i) (expt b i))))
-
-(defthm /-weakly-monotonic
-  (implies (and (<= y y+)
-                (< 0 y)
-                (case-split (rationalp y))
-                (case-split (rationalp y+))
-                )
-           (<= (/ y+) (/ y)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
-
-(defthm /-strongly-monotonic
-  (implies (and (< y y+)
-                (< 0 y)
-                (case-split (rationalp y))
-                (case-split (rationalp y+))
-                )
-           (< (/ y+) (/ y)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
-         
-(defthm *-weakly-monotonic
-  (implies (and (<= y y+)
-                (<= 0 x)
-                (case-split (rationalp x)) ; This does not hold if x, y, and z are complex!
-                )
-           (<= (* x y) (* x y+)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-   (:linear)
-   (:forward-chaining
-    :trigger-terms ((* y x) (* y+ x))
-    :corollary
-    (implies (and (<= y y+)
-                  (<= 0 x)
-                  (case-split (rationalp x))
-                  )
-             (<= (* y x) (* y+ x))))
-   (:linear
-    :corollary
-    (implies (and (<= y y+)
-                  (<= 0 x)
-                  (case-split (rationalp x))
-                  )
-             (<= (* y x) (* y+ x))))))
-
-#| Here is the complex counterexample to which we alluded above.
-
-(let ((y  #c(1 -1))
-      (y+ #c(1 1))
-      (x  #c(1 1)))
-    (implies (and (<= y y+)
-                  (<= 0 x))
-             (<= (* x y) (* x y+))))
-|#
-
-(defthm *-strongly-monotonic
-  (implies (and (< y y+)
-                (< 0 x)
-                (case-split (rationalp x))
-                )
-           (< (* x y) (* x y+)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-   (:linear)
-   (:forward-chaining
-    :trigger-terms ((* y x) (* y+ x))
-    :corollary
-    (implies (and (< y y+)
-                  (< 0 x)
-                  (case-split (rationalp x))
-                  )
-             (< (* y x) (* y+ x))))
-   (:linear
-    :corollary
-    (implies (and (< y y+)
-                  (< 0 x)
-                  (case-split (rationalp x))
-                  )
-             (< (* y x) (* y+ x))))))
-
-(defthm *-weakly-monotonic-negative-multiplier
-  (implies (and (<= y y+)
-               (< x 0)
-               (case-split (rationalp x))
-               )
-           (<= (* x y+) (* x y)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-   (:linear)
-   (:forward-chaining
-    :trigger-terms ((* y x) (* y+ x))
-    :corollary
-    (implies (and (<= y y+)
-                  (< x 0)
-                  (case-split (rationalp x))
-                  )
-             (<= (* y+ x) (* y x))))
-   (:linear
-    :corollary
-    (implies (and (<= y y+)
-                  (< x 0)
-                  (case-split (rationalp x))
-                  )
-             (<= (* y+ x) (* y x))))))
-
-(defthm *-strongly-monotonic-negative-multiplier
-  (implies (and (< y y+)
-                (< x 0)
-                (case-split (rationalp x))
-                )
-           (< (* x y+) (* x y)))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
-   (:linear)
-   (:forward-chaining
-    :trigger-terms ((* y x) (* y+ x))
-    :corollary
-    (implies (and (< y y+)
-                  (< x 0)
-                  (case-split (rationalp x))
-                  )
-             (< (* y+ x) (* y x))))
-   (:linear
-    :corollary
-    (implies (and (< y y+)
-                  (< x 0)
-                  (case-split (rationalp x))
-                  )
-             (< (* y+ x) (* y x))))))
-
-(defthm fl-weakly-monotonic
-  (implies (and (<= y y+)
-                (case-split (rationalp y)) ;drop?
-                (case-split (rationalp y+)) ;drop?
-                )
-           (<= (fl y) (fl y+)))
-  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
-                 (:linear)
-                 (:forward-chaining
-                  :trigger-terms ((fl y) (fl y+))
-                  :corollary (implies (and (< y y+)
-                                           (case-split (rationalp y))
-                                           (case-split (rationalp y+)))
-                                      (<= (fl y) (fl y+))))
-                 (:linear
-                  :corollary (implies (and (< y y+)
-                                           (case-split (rationalp y))
-                                           (case-split (rationalp y+)))
-                                      (<= (fl y) (fl y+))))))
-
-(deftheory arith-fc-monotonicity
-  '((:forward-chaining /-weakly-monotonic)
-    (:forward-chaining /-strongly-monotonic)
-    (:forward-chaining *-weakly-monotonic . 1)
-    (:forward-chaining *-weakly-monotonic . 2)
-    (:forward-chaining *-strongly-monotonic . 1)
-    (:forward-chaining *-strongly-monotonic . 2)
-    (:forward-chaining *-weakly-monotonic-negative-multiplier . 1)
-    (:forward-chaining *-weakly-monotonic-negative-multiplier . 2)
-    (:forward-chaining *-strongly-monotonic-negative-multiplier . 1)
-    (:forward-chaining *-strongly-monotonic-negative-multiplier . 2)
-    (:forward-chaining fl-weakly-monotonic . 1)
-    (:forward-chaining fl-weakly-monotonic . 2)
-    ))
-
-; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
-; product of a and b given intervals for a and b.  We consider three kinds of intervals.
-; We discuss only the a case.
-
-; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
-
-; nonneg-open intervals mean 0<=a<amax.
-
-; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
-
-; We now prove theorems with names like abs*nonneg-open, etc. characterizing
-; the product of two elements from two such intervals.  All of these theorems
-; are made with :rule-classes nil because I don't know how to control their
-; use.
-
-; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
-; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
-; lemma would be no different.
-
-(defthm abs*nonneg-open
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
-                (< 0 amax)
-                (<= 0 b)
-                (< b bmax))
-           (and (< (- (* amax bmax)) (* a b))
-                (< (* a b) (* amax bmax))))
-  :rule-classes nil)
-
-
-
-(defthm abs*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* a b))
-                (< (* a b) (* amax bmax))))
-  :rule-classes nil)
-
-(defthm nonneg-closed*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* b a))
-                (< (* b a) (* amax bmax))))
-  :rule-classes nil)
-
-(defthm nonneg-open*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
-                (< 0 amax)
-                (<= 0 b)
-                (< b bmax))
-           (and (< (- (* bmax amax)) (* a b))
-                (< (* a b) (* bmax amax))))
-  :rule-classes nil)
-
-; The next three, which handle nonnegative open intervals in the first argument,
-; can actually be seen as uses of the abs intervals above.  Simply observe that
-; if 0<=a<amax then -amax<a<amax.
-
-(defthm nonneg-open*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* a b))
-                (< (* a b) (* amax bmax))))
-  :rule-classes nil)
-
-(defthm nonneg-open*nonneg-open
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (< b bmax))
-           (and (<= 0 (* a b))
-                (< (* a b) (* amax bmax))))
-  :rule-classes nil)
-
-; and the commuted version
-(defthm nonneg-closed*nonneg-open
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (< a amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* b a))
-                (< (* b a) (* amax bmax))))
-  :rule-classes nil)
-
-(defthm nonneg-closed*nonneg-closed
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (<= 0 a)
-                (<= a amax)
-                (< 0 amax)
-                (<= 0 b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (<= 0 (* a b))
-                (<= (* a b) (* amax bmax))))
-  :rule-classes nil)
-
-(defthm abs*abs
-  (implies (and (rationalp a)
-                (rationalp amax)
-                (rationalp b)
-                (rationalp bmax)
-                (< (- amax) a)
-                (< a amax)
-                (< 0 amax)
-                (< (- bmax) b)
-                (<= b bmax)
-                (< 0 bmax))
-           (and (< (- (* amax bmax)) (* a b))
-                (< (* a b) (* amax bmax))))
-  :rule-classes nil)  
-
-(defthm rearrange-negative-coefs-<
-  (and (equal (< (* (- c) x) z)
-              (< 0 (+ (* c x) z)))
-       (equal (< (+ (* (- c) x) y) z)
-              (< y (+ (* c x) z)))
-       (equal (< (+ y (* (- c) x)) z)
-              (< y (+ (* c x) z)))
-       (equal (< (+ y1 y2 (* (- c) x)) z)
-              (< (+ y1 y2) (+ (* c x) z)))
-       (equal (< (+ y1 y2 y3 (* (- c) x)) z)
-              (< (+ y1 y2 y3) (+ (* c x) z)))
-       (equal (< z (+ (* (- c) x) y))
-              (< (+ (* c x) z) y))
-       (equal (< z (+ y (* (- c) x)))
-              (< (+ (* c x) z) y))
-       (equal (< z (+ y1 y2 (* (- c) x)))
-              (< (+ (* c x) z) (+ y1 y2)))
-       (equal (< z (+ y1 y2 y3 (* (- c) x)))
-              (< (+ (* c x) z) (+ y1 y2 y3)))))
-
-(defthm rearrange-negative-coefs-equal
-  (and (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp z)))
-                (equal (equal (* (- c) x) z)
-                       (equal 0 (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y))
-                     (case-split (rationalp z)))
-                (equal (equal (+ (* (- c) x) y) z)
-                       (equal y (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y))
-                     (case-split (rationalp z)))
-                (equal (equal (+ y (* (- c) x)) z)
-                       (equal y (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y1))
-                     (case-split (rationalp y2))
-                     (case-split (rationalp z)))
-                (equal (equal (+ y1 y2 (* (- c) x)) z)
-                       (equal (+ y1 y2) (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y1))
-                     (case-split (rationalp y2))
-                     (case-split (rationalp y3))
-                     (case-split (rationalp z)))
-                (equal (equal (+ y1 y2 y3 (* (- c) x)) z)
-                       (equal (+ y1 y2 y3) (+ (* c x) z))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y))
-                     (case-split (rationalp z)))
-                (equal (equal z (+ (* (- c) x) y))
-                       (equal (+ (* c x) z) y)))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y))
-                     (case-split (rationalp z)))
-                (equal (equal z (+ y (* (- c) x)))
-                       (equal (+ (* c x) z) y)))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y1))
-                     (case-split (rationalp y2))
-                     (case-split (rationalp z)))
-                (equal (equal z (+ y1 y2 (* (- c) x)))
-                       (equal (+ (* c x) z) (+ y1 y2))))
-       (implies (and (case-split (rationalp c))
-                     (case-split (rationalp x))
-                     (case-split (rationalp y1))
-                     (case-split (rationalp y2))
-                     (case-split (rationalp y3))
-                     (case-split (rationalp z)))
-                (equal (equal z (+ y1 y2 y3 (* (- c) x)))
-                       (equal (+ (* c x) z) (+ y1 y2 y3))))))
-
-(defthm rearrange-fractional-coefs-<
-  (and
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (< 0 c))
-            (equal (< (* (/ c) x) z)
-                   (< x (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (< (+ (* (/ c) x) y) z)
-                   (< (+ x (* c y)) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (< (+ y (* (/ c) x)) z)
-                   (< (+ (* c y) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (< 0 c))
-            (equal (< (+ y1 y2 (* (/ c) x)) z)
-                   (< (+ (* c y1) (* c y2) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (case-split (rationalp y3))
-                 (< 0 c))
-            (equal (< (+ y1 y2 y3 (* (/ c) x)) z)
-                   (< (+ (* c y1) (* c y2) (* c y3) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (< 0 c))
-            (equal (< z (* (/ c) x))
-                   (< (* c z) x)))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (< z (+ (* (/ c) x) y))
-                   (< (* c z) (+ x (* c y)))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (< z (+ y (* (/ c) x)))
-                   (< (* c z) (+ (* c y) x))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (< 0 c))
-            (equal (< z (+ y1 y2 (* (/ c) x)))
-                   (< (* c z) (+ (* c y1) (* c y2) x))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (case-split (rationalp y3))
-                 (< 0 c))
-            (equal (< z (+ y1 y2 y3 (* (/ c) x)))
-                   (< (* c z) (+ (* c y1) (* c y2) (* c y3) x))))))
-
-(defthm rearrange-fractional-coefs-equal
-  (and
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (< 0 c))
-            (equal (equal (* (/ c) x) z)
-                   (equal x (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (equal (+ (* (/ c) x) y) z)
-                   (equal (+ x (* c y)) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y))
-                 (< 0 c))
-            (equal (equal (+ y (* (/ c) x)) z)
-                   (equal (+ (* c y) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (< 0 c))
-            (equal (equal (+ y1 y2 (* (/ c) x)) z)
-                   (equal (+ (* c y1) (* c y2) x) (* c z))))
-   (implies (and (case-split (rationalp c))
-                 (case-split (rationalp z))
-                 (case-split (rationalp x))
-                 (case-split (rationalp y1))
-                 (case-split (rationalp y2))
-                 (case-split (rationalp y3))
-                 (< 0 c))
-            (equal (equal (+ y1 y2 y3 (* (/ c) x)) z)
-                   (equal (+ (* c y1) (* c y2) (* c y3) x) (* c z))))))
-
-(defthm x*/y=1->x=y
-  (implies (and (rationalp x)
-                (rationalp y)
-                (not (equal x 0))
-                (not (equal y 0)))
-           (equal (equal (* x (/ y)) 1)
-                  (equal x y)))
-  :rule-classes nil)
-                
-(defun point-right-measure (x)
-  (floor (if (and (rationalp x) (< 0 x)) (/ x) 0) 1))
-
-(defun point-left-measure (x)
-  (floor (if (and (rationalp x) (> x 0)) x 0) 1))
-
-(include-book "ordinals/e0-ordinal" :dir :system)
-(set-well-founded-relation e0-ord-<)
-
-(defthm recursion-by-point-right
-  (and (e0-ordinalp (point-right-measure x))
-       (implies (and (rationalp x)
-                     (< 0 x)
-                     (< x 1))
-                (e0-ord-< (point-right-measure (* 2 x))
-                          (point-right-measure x)))))
-
-(defthm recursion-by-point-left
-  (and (e0-ordinalp (point-left-measure x))
-       (implies (and (rationalp x)
-                     (>= x 2))
-                (e0-ord-< (point-left-measure (* 1/2 x))
-                          (point-left-measure x)))))
-
-(defthm x<x*y<->1<y
-  (implies (and (rationalp x)
-                (< 0 x)
-                (rationalp y))
-           (equal (< x (* x y)) (< 1 y)))
-  :rule-classes nil)
-
-(defthm cancel-equal-*
-  (implies (and (rationalp r)
-                (rationalp s)
-                (rationalp a)
-                (not (equal a 0)))
-           (equal (equal (* a r) (* a s))
-                  (equal r s)))
-  :rule-classes nil)
-
-(defthmd expt-split
-  (implies (and (integerp i)
-                (integerp j)
-                (case-split (acl2-numberp r)) ;(integerp r)
-                (case-split (not (equal r 0)))
-                )
-           (equal (expt r (+ i j))
-                  (* (expt r i) (expt r j)))))
-
-(defthm cancel-<-*
-  (implies (and (rationalp r)
-                (rationalp s)
-                (rationalp a)
-                (< 0 a))
-           (equal (< (* a r) (* a s))
-                  (< r s)))
-  :rule-classes nil)
-
-(in-theory (disable fl
-                    inverse-of-*
-                    point-right-measure point-left-measure))
-
-
-;;;**********************************************************************
-;;;                       EXPONENTIATION
-;;;**********************************************************************
-
-(defthm expt-2-positive-rational-type
-  (and (rationalp (expt 2 i))
-       (< 0 (expt 2 i)))
-  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
-
-(defthm expt-2-positive-integer-type
-  (implies (<= 0 i)
-           (and (integerp (expt 2 i))
-                (< 0 (expt 2 i))))
-  :rule-classes (:type-prescription))
-
-(defthm expt-2-type-linear
-  (implies (<= 0 i)
-           (<= 1 (expt 2 i)))
-  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
-
-(defthmd expt-weak-monotone
-  (implies (and (integerp n)
-                (integerp m))
-           (equal (<= (expt 2 n) (expt 2 m))
-		  (<= n m))))
-
-(defthmd expt-strong-monotone
-  (implies (and (integerp n)
-                (integerp m))
-           (equal (< (expt 2 n) (expt 2 m))
-		  (< n m))))
-
-(defthmd expt-inverse
-  (equal (/ (expt 2 i))
-         (expt 2 (* -1 i))))
-
-(defthm ash-rewrite
-    (implies (integerp n)
-	     (equal (ash n i)
-		    (fl (* n (expt 2 i))))))
-
-(defthm exp+1
-    (implies (and (integerp m)
-		  (integerp n)
-		  (<= n m))
-	     (> (* (- 1 (expt 2 m)) (- 1 (expt 2 n)))
-		(- 1 (expt 2 (1+ m)))))
-  :rule-classes ())
-
-(defthm exp+2
-    (implies (and (integerp n)
-		  (integerp m)
-		  (<= n m)
-		  (<= m 0))
-	     (< (* (1+ (expt 2 m)) (1+ (expt 2 n)))
-		(1+ (expt 2 (+ m 2)))))
-  :rule-classes ())
-
-(defthm exp-invert
-    (implies (and (integerp n)
-		  (<= n -1))
-	     (<= (/ (- 1 (expt 2 n)))
-		 (1+ (expt 2 (1+ n)))))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/lib/basic.lisp acl2-6.3/books/rtl/rel5/lib/basic.lisp
--- acl2-6.2/books/rtl/rel5/lib/basic.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/basic.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,385 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/top"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-;;;**********************************************************************
-;;;                       FLOOR and CEILING
-;;;**********************************************************************
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defthm fl-def
-  (and (integerp (fl x))    
-       (implies (case-split (rationalp x))
-	        (and (<= (fl x) x)
-		     (< x (1+ (fl x))))))
-  :rule-classes ((:linear :corollary
-                          (implies (case-split (rationalp x))
-                                   (and (<= (fl x) x)
-                                        (< x (1+ (fl x))))))
-                 (:type-prescription :corollary
-                                     (integerp (fl x)))))
-
-(defthm fl-unique
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (<= n x)
-		  (< x (1+ n)))
-	     (equal (fl x) n))
-  :rule-classes ())
-
-(defthm fl-integerp
-  (equal (equal (fl x) x)
-         (integerp x)))
-
-(defthm quot-bnd
-  (implies (and (<= 0 x)
-                (<= 0 y)
-                (rationalp x)
-                (rationalp y))
-           (<= (* y (fl (/ x y)))
-               x))
-  :rule-classes :linear)
-
-(defthm fl-monotone-linear
-    (implies (and (<= x y)
-		  (rationalp x)
-		  (rationalp y))
-	     (<= (fl x) (fl y)))
-  :rule-classes :linear)
-
-(defthm n<=fl-linear
-    (implies (and (<= n x)
-		  (rationalp x)
-		  (integerp n))
-	     (<= n (fl x)))
-  :rule-classes :linear)
-
-(defthm fl+int-rewrite
-    (implies (and (integerp n)
-		  (rationalp x))
-	     (equal (fl (+ x n)) (+ (fl x) n))))
-
-(defthm fl/int-rewrite
-  (implies (and (integerp n)
-                (<= 0 n)
-                (rationalp x))
-           (equal (fl (* (fl x) (/ n)))
-                  (fl (/ x n)))))
-
-(defthm fl/int-rewrite-alt
-  (implies (and (integerp n)
-                (<= 0 n)
-                (rationalp x))
-           (equal (fl (* (/ n) (fl x)))
-                  (fl (/ x n)))))
-
-(defthmd fl-minus
-  (implies (rationalp x)
-           (equal (fl (* -1 x))
-                  (if (integerp x)
-                      (* -1 x)
-                    (1- (* -1 (fl x)))))))
-
-(defthm fl-m-n
-  (implies (and (< 0 n)
-                (integerp m)
-                (integerp n))
-           (= (fl (- (/ m n)))
-              (1- (- (fl (/ (1- m) n))))))
-  :rule-classes ())
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defthm cg-def
-  (and (integerp (cg x))
-       (implies (case-split (rationalp x))
-                (and (>= (cg x) x)
-                     (> (1+ x) (cg x)))))
-  :rule-classes ((:linear :corollary
-                          (implies (case-split (rationalp x))
-                                   (and (>= (cg x) x)
-                                        (> (1+ x) (cg x)))))
-                 (:type-prescription :corollary
-                                     (integerp (cg x)))))
-
-(defthm cg-unique
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (>= n x)
-		  (> (1+ x) n))
-	     (equal (cg x) n))
-  :rule-classes ())
-
-(defthm cg-integerp
-    (implies (rationalp x)
-	     (equal (equal (cg x) x)
-                    (integerp x))))
-
-(defthm cg-monotone-linear
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (<= x y))
-	     (<= (cg x) (cg y)))
-  :rule-classes :linear)
-
-(defthm n>=cg-linear
-    (implies (and (>= n x)
-		  (rationalp x)
-		  (integerp n))
-	     (>= n (cg x)))
-  :rule-classes :linear)
-
-(defthm cg+int-rewrite
-    (implies (and (integerp n)
-		  (rationalp x))
-	     (equal (cg (+ x n)) (+ (cg x) n))))
-
-(defthm cg/int-rewrite
-  (implies (and (integerp n)
-                (> n 0)
-                (rationalp x))
-           (equal (cg (* (cg x) (/ n)))
-                  (cg (/ x n)))))
-
-(defthm cg/int-rewrite-alt
-  (implies (and (integerp n)
-                (> n 0)
-                (rationalp x))
-           (equal (cg (* (/ n) (cg x)))
-                  (cg (/ x n)))))
-
-(defthm fl-cg
-  (implies (rationalp x)
-           (equal (cg x)
-                  (if (integerp x)
-                      (fl x)
-                    (1+ (fl x)))))
-  :rule-classes ())
-
-
-;;;**********************************************************************
-;;;                         MOD
-;;;**********************************************************************
-
-(defthm mod-def
-  (implies (case-split (acl2-numberp x))
-           (equal (mod x y)
-                  (- x (* y (fl (/ x y))))))
-  :rule-classes ())
-
-(defthm mod-0
-    (and (equal (mod 0 y)
-                0)
-         (equal (mod x 0)
-                (fix x))))
-
-(defthm rationalp-mod
-  (implies (case-split (rationalp x))
-           (rationalp (mod x y)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm integerp-mod
-  (implies (and (integerp m) (integerp n))
-           (integerp (mod m n)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm natp-mod
-  (implies (and (natp m)
-                (natp n))
-           (natp (mod m n)))
-  :rule-classes ((:type-prescription :typed-term (mod m n))))
-
-(defthm mod-bnd-1
-  (implies (and (case-split (< 0 n))
-                (case-split (not (complex-rationalp m)))
-                (case-split (not (complex-rationalp n))))
-           (< (mod m n) n))
-  :rule-classes :linear)
-
-(defthm mod-by-1
-  (implies (integerp m)
-           (equal (mod m 1)
-                  0)))
-
-(defthm mod-bnd-2
-  (implies (and (<= 0 m)
-                (case-split (rationalp m)))
-           (<= (mod m n) m))
-  :rule-classes :linear)
-
-(defthm mod-does-nothing
-  (implies (and (< m n)
-                (<= 0 m)
-                (case-split (rationalp m)))
-           (equal (mod m n)
-                  m)))
-
-(defthm mod-0-fl
-  (implies (acl2-numberp m)
-           (iff (= (mod m n) 0)
-	        (= m (* (fl (/ m n)) n))))
-  :rule-classes ())
-
-(defthm mod-0-int
-  (implies (and (integerp m)
-                (integerp n)
-                (not (= n 0)))
-           (iff (= (mod m n) 0)
-                (integerp (/ m n))))
-  :rule-classes ())
-
-(defthm mod-mult-n
-  (equal (mod (* a n) n)
-         (* n (mod a 1))))
-
-(defthm mod-mult-n-commuted
-  (equal (mod (* n a) n)
-         (* n (mod a 1))))
-
-(defthm mod-squeeze
-    (implies (and (= (mod m n) 0)
-		  (< m (* (1+ a) n))
-                  (< (* (1- a) n) m)
-                  (integerp a)
-		  (integerp m)
-		  (integerp n))
-	     (= m (* a n)))
-  :rule-classes ())
-
-(defthm mod-must-be-n
-    (implies (and (= (mod m n) 0)
-		  (< m (* 2 n))
-                  (< 0 m)
-		  (rationalp m)
-		  (rationalp n))
-	     (= m n))
-  :rule-classes ())
-
-(defthm mod-0-0
-  (implies (and (integerp p)
-                (rationalp m)
-                (rationalp n))
-           (iff (= (mod m (* n p)) 0)
-                (and (= (mod m n) 0)
-                     (= (mod (fl (/ m n)) p) 0))))
-  :rule-classes ())
-
-(defthm mod-equal-int
-  (implies (and (= (mod a n) (mod b n))
-                (rationalp a)
-                (rationalp b))
-           (integerp (/ (- a b) n)))
-  :rule-classes ())
-
-(defthm mod-equal-int-reverse
-  (implies (and (integerp (/ (- a b) n))
-                (rationalp a)
-                (rationalp b)
-                (rationalp n)
-                (< 0 n))
-           (= (mod a n) (mod b n)))
-  :rule-classes ())
-
-(defthm mod-force-equal
-  (implies (and (< (abs (- a b)) n)
-                (rationalp a)
-                (rationalp b)
-                (integerp n))
-          (iff (= (mod a n) (mod b n))
-               (= a b)))
-  :rule-classes ())
-
-(defthm mod-mult
-    (implies (and (integerp a)
-                  (rationalp m)
-		  (rationalp n))
-	     (equal (mod (+ m (* a n)) n)
-		    (mod m n))))
-
-(defthm mod-force
-  (implies (and (<= (* a n) m)
-                (< m (* (1+ a) n))
-                (integerp a)
-                (rationalp m)
-                (rationalp n))
-           (= (mod m n) (- m (* a n))))
-  :rule-classes ())
-
-(defthm mod-bnd-3
-  (implies (and (< m (+ (* a n) r))
-                (<= (* a n) m)
-                (integerp a)
-                (case-split (rationalp m))
-                (case-split (rationalp n)))
-           (< (mod m n) r))
-  :rule-classes :linear)
-
-(defthmd mod-sum
-    (implies (and (rationalp a)
-		  (rationalp b))
-	     (equal (mod (+ a (mod b n)) n)
-		    (mod (+ a b) n))))
-
-(defthmd mod-mod-sum
-    (implies (and (rationalp a)
-		  (rationalp b))
-	     (equal (mod (+ (mod a n) (mod b n)) n)
-		    (mod (+ a b) n))))
-
-(defthm mod-diff
-  (implies (and (case-split (rationalp a))
-                (case-split (rationalp b)))
-           (equal (mod (- a (mod b n)) n)
-                  (mod (- a b) n))))
-
-(defthm mod-of-mod
-  (implies (and (case-split (natp k))
-                (case-split (natp n)))
-           (equal (mod (mod x (* k n)) n)
-                  (mod x n))))
-
-(defthm mod-of-mod-cor
-  (implies (and (<= b a)
-                (case-split (integerp b))
-                (case-split (integerp a)))
-           (equal (mod (mod x (expt 2 a)) (expt 2 b))
-                  (mod x (expt 2 b)))))
-
-(defthm mod-prod
-  (implies (and (rationalp m)
-                (rationalp n)
-                (rationalp k))
-           (equal (mod (* k m) (* k n))
-                  (* k (mod m n)))))
-
-(defthm mod012
-  (implies (integerp m)
-           (or (equal (mod m 2) 0)
-               (equal (mod m 2) 1)))
-  :rule-classes ())
-
-(defthm mod-plus-mod-2
-  (implies (and (integerp a)
-                (integerp b))
-           (iff (= (mod (+ a b) 2) (mod a 2))
-                (= (mod b 2) 0)))
-  :rule-classes ())
-
-(defthm mod-mod-2-not-equal
-  (implies (acl2-numberp m)
-           (not (= (mod m 2) (mod (1+ m) 2))))
-  :rule-classes ())
-
-(defthm mod-2*m+1-rewrite
-  (implies (integerp m)
-           (equal (mod (1+ (* 2 m)) 2) 1)))
diff -Nru acl2-6.2/books/rtl/rel5/lib/bits.lisp acl2-6.3/books/rtl/rel5/lib/bits.lisp
--- acl2-6.2/books/rtl/rel5/lib/bits.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/bits.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,826 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(include-book "basic")
-
-(local (include-book "../support/top"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-
-;;;**********************************************************************
-;;;				BVECP
-;;;**********************************************************************
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defthm bvecp-forward
-  (implies (bvecp x k)
-	   (and (integerp x)
-		(<= 0 x)
-		(< x (expt 2 k))))
-  :rule-classes :forward-chaining)
-
-(defthmd bvecp-monotone
-    (implies (and (bvecp x n)
-		  (<= n m)
-		  (case-split (integerp m)))
-	     (bvecp x m)))
-
-(defthmd bvecp-shift-down
-    (implies (and (bvecp x n)
-		  (natp n)
-		  (natp k))
-	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
-
-(defthmd bvecp-shift-up
-    (implies (and (bvecp x (- n k))
-		  (natp k)
-		  (integerp n))
-	     (bvecp (* x (expt 2 k)) n)))
-
-(defthm bvecp-product
-    (implies (and (bvecp x m)
-		  (bvecp y n))
-	     (bvecp (* x y) (+ m n)))
-  :rule-classes ())
-
-(defthmd bvecp-1-rewrite
-  (equal (bvecp x 1)
-	 (or (equal x 0) (equal x 1))))
-
-(defthm bvecp-1-0
-  (implies (and (bvecp x 1)
-		(not (equal x 1)))
-	   (equal x 0))
-  :rule-classes :forward-chaining)
-
-(defthm bvecp-0-1
-  (implies (and (bvecp x 1)
-		(not (equal x 0)))
-	   (equal x 1))
-  :rule-classes :forward-chaining)
-
-
-;;;**********************************************************************
-;;;			    BITS
-;;;**********************************************************************
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defthm bits-nonnegative-integerp-type
-  (and (<= 0 (bits x i j))
-       (integerp (bits x i j)))
-  :rule-classes (:type-prescription))
-
-(in-theory (disable (:type-prescription bits)))
-
-(defthm bits-bvecp
-    (implies (and (<= (+ 1 i (- j)) k)
-		  (case-split (integerp k)))
-	     (bvecp (bits x i j) k)))
-
-;;Here is a variation of bits-bvecp that is less general but does not
-;;require an integerp hypothesis:
-(defthm bits-bvecp-simple
-  (implies (equal k (+ 1 i (* -1 j)))
-           (bvecp (bits x i j) k)))
-
-(defthm mod-bits-equal
-  (implies (= (mod x (expt 2 (1+ i))) 
-	      (mod y (expt 2 (1+ i))))
-	   (= (bits x i j) (bits y i j)))
-  :rule-classes ())
-
-(defthmd mod-bits-equal-cor
-    (implies (and (integerp x)
-		  (integerp n)
-		  (integerp i)
-		  (integerp j)
-		  (< i n))
-	     (equal (bits (mod x (expt 2 n)) i j)
-		    (bits x i j))))
-
-(defthmd bits-mod
-  (implies (and (case-split (integerp x))
-		(case-split (integerp i)))
-	   (equal (bits x i 0)
-		  (mod x (expt 2 (1+ i))))))
-
-(defthmd bits-bits-sum
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp i))
-	   (equal (bits (+ (bits x i 0) y) i 0)
-		  (bits (+ x y) i 0))))
-
-(defthmd bits-mod-2
-  (implies (and (integerp x)
-                (integerp i)
-                (integerp j)
-                (>= i j))
-           (equal (bits x (1- i) j)
-                  (- (fl (/ x (expt 2 j)))
-                     (* (expt 2 (- i j))
-                        (fl (/ x (expt 2 i))))))))
-
-(defthm bits-neg
-  (implies (and (< i 0)
-                (integerp x))
-           (equal (bits x i j) 0)))
-
-(defthm bits-with-indices-in-the-wrong-order
-  (implies (< i j)
-	   (equal (bits x i j)
-		  0)))
-
-(defthmd bvecp-bits-0
-  (implies (bvecp x j)
-	   (equal (bits x i j) 0)))
-
-(defthm bits-0
-  (equal (bits 0 i j) 0))
-
-(defthm bits-tail
-  (implies (and (bvecp x (1+ i))
-		(case-split (acl2-numberp i)))
-	   (equal (bits x i 0) x)))
-
-(defthm bits-drop-from-minus
-  (implies (and (bvecp x (1+ i))
-                (bvecp y (1+ i))
-                (<= y x)
-		(case-split (acl2-numberp i)))
-	   (equal (bits (+ x (* -1 y)) i 0)
-		  (+ x (* -1 y)))))
-
-(defthmd bits-shift-down-1
-  (implies (and (<= 0 j)
-		(integerp i)
-		(integerp j)
-		(integerp k))
-	   (equal (bits (fl (/ x (expt 2 k))) i j)
-		  (bits x (+ i k) (+ j k)))))
-
-(defthmd bits-shift-down-2
-  (implies (and (natp x)
-		(natp i)
-		(natp k))
-	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
-		  (bits (fl (/ x (expt 2 k))) i 0))))
-
-(defthm bits-shift-up-1
-  (implies (and (integerp k)
-		(integerp i)
-		(integerp j))
-	   (equal (bits (* (expt 2 k) x) i j)
-		  (bits x (- i k) (- j k))))
-  :rule-classes ())
-
-(defthm bits-shift-up-2
-  (implies (and (integerp x)
-		(integerp k)
-		(<= 0 k)
-		(integerp i))
-	   (equal (* (expt 2 k) (bits x i 0))
-		  (bits (* (expt 2 k) x) (+ i k) 0)))
-  :rule-classes ())
-
-(defthmd bits-plus-mult-1
-  (implies (and (bvecp x k)
-		(<= k m)
-		(integerp y)
-		(case-split (integerp m))
-		(case-split (integerp n))
-		(case-split (integerp k)))
-	   (equal (bits (+ x (* y (expt 2 k))) n m)
-		  (bits y (- n k) (- m k)))))
-
-(defthm bits-plus-mult-2
-  (implies (and (< n k)
-		(integerp y)
-		(integerp k))
-	   (equal (bits (+ x (* y (expt 2 k))) n m)
-		  (bits x n m))))
-
-(defthmd bits-plus-mult-2-rewrite
-   (implies (and (syntaxp (quotep c))
-                 (equal (mod c (expt 2 (1+ n))) 0))
-            (equal (bits (+ c x) n m)
-                   (bits x n m))))
-
-(defthm bits-plus-bits
-    (implies (and (integerp m)
-		  (integerp p)
-		  (integerp n)
-		  (<= m p)
-		  (<= p n))
-	     (= (bits x n m)
-		(+ (bits x (1- p) m)
-		   (* (expt 2 (- p m)) (bits x n p)))))
-  :rule-classes ())
-
-(defthm bits-bits
-  (implies (and (case-split (<= 0 l))
-		(case-split (integerp i))
-		(case-split (integerp j))
-		(case-split (integerp k))
-		(case-split (integerp l)))
-	   (equal (bits (bits x i j) k l)
-		  (if (<= k (- i j))
-		      (bits x (+ k j) (+ l j))
-		    (bits x i (+ l j))))))
-
-;;bits-match can prove things like this:
-;;(thm (implies (equal 12 (bits x 15 6))
-;;		(equal 4 (bits x 8 6))))
-;;See also bits-dont-match.
-
-(defthmd bits-match
-  (implies (and (syntaxp (and (quotep i)
-			      (quotep j)
-			      (quotep k)))
-		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
-		(syntaxp (and (quotep i2)
-			      (quotep j2)
-			      (quotep k2)))
-		(<= j2 j) (<= j i) (<= i i2)
-		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
-		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
-		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
-	   (equal (equal k (bits x i j))
-		  t)))
-
-;;bits-dont-match can prove things like this:
-;;(thm (implies (equal 7 (bits x 8 6))
-;;		(not (equal 4 (bits x 15 6)))))
-;;See also bits-match.
-
-(defthmd bits-dont-match 
-  (implies (and (syntaxp (and (quotep i)
-			      (quotep j)
-			      (quotep k)))
-		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
-		(syntaxp (and (quotep i2)
-			      (quotep j2)
-			      (quotep k2)))
-		(<= j2 j) (<= j i) (<= i i2)
-		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
-		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
-		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
-	   (equal (equal k (bits x i j))
-		  nil)))
-
-
-;;;**********************************************************************
-;;;				BITN
-;;;**********************************************************************
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defthm bitn-nonnegative-integer
-  (and (integerp (bitn x n))
-       (<= 0 (bitn x n)))
-  :rule-classes (:type-prescription))
-
-(in-theory (disable (:type-prescription bitn)))
-
-(defthm bits-n-n-rewrite
-  (equal (bits x n n)
-	 (bitn x n)))
-
-(defthmd bitn-def
-  (implies (case-split (integerp n))
-	   (equal (bitn x n)
-		  (mod (fl (/ x (expt 2 n))) 2))))
-
-;;A recursive formulation:
-
-(defthmd bitn-rec-0
-  (implies (integerp x)
-	   (equal (bitn x 0) (mod x 2))))
-
-(defthmd bitn-rec-pos
-    (implies (< 0 n)
-	     (equal (bitn x n)
-		    (bitn (fl (/ x 2)) (1- n))))
-  :rule-classes ((:definition :controller-alist ((bitn t t)))))
-
-;;Use this to induce case-splitting:
-
-(defthm bitn-0-1
-    (or (equal (bitn x n) 0)
-	(equal (bitn x n) 1))
-  :rule-classes ())
-
-(defthm bitn-bvecp
-  (implies (and (<= 1 k)
-		(case-split (integerp k)))
-	   (bvecp (bitn x n) k)))
-
-;;The following is a special case of bitn-bvecp.
-;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
-;;bvecp-1-0.
-(defthm bitn-bvecp-forward
-  (bvecp (bitn x n) 1)
-  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
-
-(defthm bitn-neg
-  (implies (and (< n 0)
-                (integerp x))
-           (equal (bitn x n) 0)))
-
-(defthm bitn-0
-  (equal (bitn 0 k) 0))
-
-(defthm bitn-bvecp-1
-    (implies (bvecp x 1)
-	     (equal (bitn x 0) x)))
-
-(defthm bitn-bitn-0
-    (equal (bitn (bitn x n) 0)
-	   (bitn x n)))
-
-(defthmd bitn-mod
-    (implies (and (< k n)
-		  (integerp n)
-		  (integerp k))
-	     (equal (bitn (mod x (expt 2 n)) k)
-		    (bitn x k))))
-
-(defthm bvecp-bitn-0
-    (implies (bvecp x n)
-	     (equal (bitn x n) 0)))
-
-(defthmd bitn-shift
-  (implies (and (integerp n)
-		(integerp k))
-	   (equal (bitn (* x (expt 2 k)) (+ n k))
-		  (bitn x n))))
-
-(defthmd bitn-shift-down
-  (implies (and (natp i)
-		(integerp k))
-	   (equal (bitn (fl (/ x (expt 2 k))) i)
-		  (bitn x (+ i k)))))
-
-(defthm bitn-bits
-  (implies (and (<= k (- i j))
-		(case-split (<= 0 k))
-		(case-split (integerp i))
-		(case-split (integerp j))
-		(case-split (integerp k)))
-	   (equal (bitn (bits x i j) k)
-		  (bitn x (+ j k)))))
-
-(defthmd bitn-plus-bits
-    (implies (and (<= m n)
-		  (integerp m)
-		  (integerp n))
-	     (= (bits x n m)
-		(+ (* (bitn x n) (expt 2 (- n m)))
-		   (bits x (1- n) m)))))
-
-(defthm bits-plus-bitn
-    (implies (and (<= m n)
-		  (integerp m)
-		  (integerp n))
-	     (= (bits x n m)
-		(+ (bitn x m)
-		   (* 2 (bits x n (1+ m))))))
-  :rule-classes ())
-
-(defun sumbits (x n)
-  (if (zp n)
-      0
-    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
-       (sumbits x (1- n)))))
-
-(defthmd sumbits-bits
-    (implies (and (natp x)
-		  (natp n)
-		  (> n 0))
-	     (equal (sumbits x n)
-		    (bits x (1- n) 0))))
-
-(defthmd sumbits-thm
-    (implies (and (bvecp x n)
-		  (natp n)
-		  (> n 0))
-	     (equal (sumbits x n)
-		    x)))
-
-; The lemmas sumbits-badguy-is-correct and sumbits-badguy-bounds, below, let
-; one prove equality of two bit vectors of width k by proving each of these has
-; the same value at bit i, for arbitrary i from 0 to k-1.
-
-(defun sumbits-badguy (x y k)
-  (if (zp k)
-      0
-    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
-        (1- k)
-      (sumbits-badguy x y (1- k)))))
-
-(defthmd sumbits-badguy-is-correct
-  (implies (and (bvecp x k)
-                (bvecp y k)
-                (equal (bitn x (sumbits-badguy x y k))
-                       (bitn y (sumbits-badguy x y k)))
-                (integerp k)
-                (< 0 k))
-           (equal (equal x y) t)))
-
-(defthmd sumbits-badguy-bounds
-  (implies (and (integerp k)
-                (< 0 k))
-           (let ((badguy (sumbits-badguy x y k)))
-             (and (integerp badguy)
-                  (<= 0 badguy)
-                  (< badguy k)))))
-
-(defun all-bits-p (b k)
-  (if (zp k)
-      t
-    (and (or (= (nth (1- k) b) 0)
-	     (= (nth (1- k) b) 1))
-	 (all-bits-p b (1- k)))))
-
-(defun sum-b (b k)
-  (if (zp k)
-      0
-    (+ (* (expt 2 (1- k)) (nth (1- k) b))
-       (sum-b b (1- k)))))
-
-(defthmd sum-bitn
-  (implies (and (natp n)
-		(all-bits-p b n)
-	        (natp k)
-		(< k n))
-           (equal (bitn (sum-b b n) k)
-	          (nth k b))))
-
-(defthmd bvecp-bitn-1
-    (implies (and (bvecp x (1+ n))
-		  (<= (expt 2 n) x)
-		  (natp n))
-	     (equal (bitn x n) 1)))
-
-(defthmd bvecp-bitn-2
-  (implies (and (bvecp x n)
-		(< k n)
-		(<= (- (expt 2 n) (expt 2 k)) x)
-		(integerp n)
-		(integerp k))
-	   (equal (bitn x k) 1))
-  :rule-classes ((:rewrite :match-free :all)))
-
-(defthmd bitn-expt
-    (implies (case-split (integerp n))
-	     (equal (bitn (expt 2 n) n)
-		    1)))
-
-(defthmd bitn-expt-0
-  (implies (and (not (equal i n))
-		(case-split (integerp i)))
-	   (equal (bitn (expt 2 i) n)
-		  0)))
-
-(defthm bitn-plus-expt-1
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (not (equal (bitn (+ x (expt 2 n)) n)
-			 (bitn x n))))
-  :rule-classes ())
-
-(defthmd bitn-plus-mult
-    (implies (and (< n m) 
-		  (integerp m) 
-		  (integerp k))
-	     (equal (bitn (+ x (* k (expt 2 m))) n)
-		    (bitn x n))))
-
-(defthmd bitn-plus-mult-rewrite
-    (implies (and (syntaxp (quotep c))
-		  (equal (mod c (expt 2 (1+ n))) 0))
-	     (equal (bitn (+ c x) n)
-		    (bitn x n))))
-
-
-;;;**********************************************************************
-;;;			     CAT
-;;;**********************************************************************
-
-(defund binary-cat (x m y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp m) (< 0 m)
-                              (integerp n) (< 0 n))))
-  (if (and (natp m) (natp n))
-      (+ (* (expt 2 n) (bits x (1- m) 0))
-         (bits y (1- n) 0))
-    0))
-
-;;Definition of the macro, cat:
-
-;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
-;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
-;;not need to specify this in the guard, and leaving it out of that guard
-;;simplifies the guard proof.
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defun cat-size (x)
-  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
-  (if (endp (cddr x))
-      (cadr x)
-    (formal-+ (cadr x)
-	      (cat-size (cddr x)))))
-
-(defmacro cat (&rest x)
-  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
-  (cond ((endp (cddr x))
-         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
-        ((endp (cddddr x))
-         `(binary-cat ,@x))
-        (t
-         `(binary-cat ,(car x) 
-                      ,(cadr x) 
-                      (cat ,@(cddr x)) 
-                      ,(cat-size (cddr x))))))
-
-(defthm cat-nonnegative-integer-type
-  (and (integerp (cat x m y n))
-       (<= 0 (cat x m y n)))
-  :rule-classes (:type-prescription))
-
-(in-theory (disable (:type-prescription binary-cat)))
-
-(defthm cat-bvecp
-  (implies (and (<= (+ m n) k)
-		(case-split (integerp k)))
-	   (bvecp (cat x m y n) k)))
-
-(defthm cat-with-n-0
-  (equal (binary-cat x m y 0)
-	 (bits x (1- m) 0)))
-
-(defthm cat-with-m-0
-  (equal (binary-cat x 0 y n)
-	 (bits y (1- n) 0)))
-
-(defthm cat-0
-  (implies (and (case-split (bvecp y n))
-		(case-split (integerp n))
-		(case-split (integerp m))
-		(case-split (<= 0 m)))
-	   (equal (cat 0 m y n) y)))
-
-(defthmd cat-bits-1
-    (equal (cat (bits x (1- m) 0) m y n)
-	   (cat x m y n)))
-
-(defthmd cat-bits-2
-    (equal (cat x m (bits y (1- n) 0) n)
-	   (cat x m y n)))
-
-(defthm cat-associative
-  (implies (and (case-split (<= (+ m n) p))
-		(case-split (<= 0 m))
-		(case-split (<= 0 n))
-		(case-split (<= 0 q))
-		(case-split (integerp m))
-		(case-split (integerp n))
-		(case-split (integerp p))
-		(case-split (integerp q)))
-	   (equal (cat (cat x m y n) p z q)
-		  (cat x m (cat y n z q) (+ n q)))))
-
-(defthmd cat-equal-constant
-  (implies (and (syntaxp (and (quotep k)
-			      (quotep m)
-			      (quotep n)))
-		(case-split (bvecp y n))
-		(case-split (bvecp x m))
-		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
-		(case-split (integerp k))
-		(case-split (<= 0 k))
-		(case-split (integerp m))
-		(case-split (<= 0 m))
-		(case-split (integerp n))
-		(case-split (<= 0 n)))
-	   (equal (equal k (cat x m y n))
-		  (and (equal y (bits k (1- n) 0))
-		       (equal x (bits k (+ -1 m n) n))))))
-
-(defthmd cat-equal-rewrite
-  (implies (and (case-split (bvecp x1 m))
-		(case-split (bvecp y1 n))
-		(case-split (bvecp x2 m))
-		(case-split (bvecp y2 n))
-		(case-split (integerp n))
-		(case-split (<= 0 n))
-		(case-split (integerp m))
-		(case-split (<= 0 m)))
-	   (equal (equal (cat x1 m y1 n)
-			 (cat x2 m y2 n))
-		  (and (equal x1 x2)
-		       (equal y1 y2)))))
-
-(defthm cat-bits-bits
-  (implies (and (equal j (1+ k))
-		(equal n (+ 1 (- l) k))
-		(case-split (<= (+ 1 (- j) i) m))
-		(case-split (<= j i))
-		(case-split (<= l k))
-		(case-split (integerp i))
-		(case-split (integerp k))
-		(case-split (integerp l))
-		(case-split (integerp m)))
-	   (equal (cat (bits x i j) m (bits x k l) n)
-		  (bits x i l))))
-
-(defthm cat-bitn-bits
-    (implies (and (equal j (1+ k))
-		  (equal n (+ 1 (- l) k))
-		  (case-split (<= 1 m))
-		  (case-split (<= l k))
-		  (case-split (integerp j))
-		  (case-split (integerp k))
-		  (case-split (integerp l))
-		  (case-split (integerp m)))
-	     (equal (cat (bitn x j) m (bits x k l) n)
-		    (bits x j l))))
-
-(defthm cat-bits-bitn
-  (implies (and (equal j (1+ k))
-		(case-split (<= (+ 1 (- j) i) m))
-		(case-split (<= j i))
-		(case-split (integerp i))
-		(case-split (integerp j))
-		(case-split (integerp k))
-		(case-split (integerp m)))
-	   (equal (cat (bits x i j) m (bitn x k) 1)
-		  (bits x i k))))
-
-(defthm cat-bitn-bitn
-  (implies (and (equal i (1+ j))
-		(case-split (integerp i))
-		(case-split (integerp j)))
-	   (equal (cat (bitn x i) 1 (bitn x j) 1)
-		  (bits x i j))))
-
-(defthmd bits-cat
-  (implies (and (case-split (natp n))
-		(case-split (natp m))
-		(case-split (natp i))
-		(case-split (natp j)))
-	   (equal (bits (cat x m y n) i j)
-		  (if (< i n)
-		      (bits y i j)
-		    (if (>= j n)
-			(bits x (if (< i (+ m n))
-				    (- i n)
-				  (1- m)) 
-			      (- j n))
-		      (cat (bits x (if (< i (+ m n))
-					(- i n)
-				      (1- m)) 0)
-			    (1+ (- i n))
-			    (bits y (1- n) j)
-			    (- n j)))))))
-
-(defthm bits-cat-constants
-  (implies (and (syntaxp (quotep n))
-		(syntaxp (quotep m))
-		(syntaxp (quotep i))
-		(syntaxp (quotep j))
-		(natp n)
-		(natp m)
-		(natp i)
-		(natp j))
-	   (equal (bits (cat x m y n) i j)
-		  (if (< i n)
-		      (bits y i j)
-		    (if (>= j n)
-			(bits x (if (< i (+ m n))
-				    (- i n)
-				  (1- m)) 
-			      (- j n))
-		      (cat (bits x (if (< i (+ m n))
-				       (- i n)
-				     (1- m)) 0)
-			   (1+ (- i n))
-			   (bits y (1- n) j)
-			   (- n j)))))))
-
-(defthmd bitn-cat
-  (implies (and (case-split (natp n))
-		(case-split (natp m))
-		(case-split (natp i)))
-	   (equal (bitn (cat x m y n) i)
-		  (if (< i n)
-		      (bitn y i)
-		    (if (< i (+ m n))
-		      (bitn x (- i n))
-		    0)))))
-
-(defthm bitn-cat-constants
-  (implies (and (syntaxp (quotep n))
-		(syntaxp (quotep m))
-		(syntaxp (quotep i))
-		(natp n)
-		(natp m)
-		(natp i))
-	   (equal (bitn (cat x m y n) i)
-		  (if (< i n)
-		      (bitn y i)
-		    (if (< i (+ m n))
-		      (bitn x (- i n))
-		    0)))))
-
-; We introduce mbe not because we want particularly fast execution, but because
-; the existing logic definition does not satisfy the guard of cat, which can't
-; be changed because of the guard of bits.
-(defund mulcat (l n x)
-  (declare (xargs :guard (and (integerp l)
-                              (< 0 l)
-                              (acl2-numberp n)
-                              (natp x))))
-  (mbe :logic (if (and (integerp n) (> n 0))
-                  (cat (mulcat l (1- n) x)
-                       (* l (1- n))
-                       x
-                       l)
-                0)
-       :exec  (cond ((eql n 1)
-                     (bits x (1- l) 0))
-                    ((and (integerp n) (> n 0))
-                     (cat (mulcat l (1- n) x)
-                          (* l (1- n))
-                          x
-                          l))
-                    (t 0))))
-
-(defthm mulcat-nonnegative-integer-type
-  (and (integerp (mulcat l n x))
-       (<= 0 (mulcat l n x)))
-  :rule-classes (:type-prescription))
-
-(in-theory (disable (:type-prescription mulcat)))
-
-(defthmd mulcat-bits
-    (implies (and (integerp l)
-		  (integerp x))
-	     (equal (mulcat l n (bits x (1- l) 0))
-		    (mulcat l n x))))
-
-(defthm mulcat-bvecp
-  (implies (and (>= p (* l n))
-		(case-split (integerp p))
-		(case-split (natp l)))
-	   (bvecp (mulcat l n x) p)))
-
-(defthm mulcat-1
-    (implies (natp l)
-	     (equal (mulcat l 1 x) 
-		    (bits x (1- l) 0))))
-
-(defthm mulcat-0
-  (equal (mulcat l n 0) 0))
-
-(defthm mulcat-n-1
-  (implies (case-split (<= 0 n))
-	   (equal (mulcat 1 n 1)
-		  (1- (expt 2 n)))))
-
-(defthm bitn-mulcat-1
-  (implies (and (< m n)
-		(case-split (bvecp x 1))
-		(case-split (natp m))
-		(case-split (integerp n)))
-	   (equal (bitn (mulcat 1 n x) m)
-		  x)))
diff -Nru acl2-6.2/books/rtl/rel5/lib/bvecp-helpers.lisp acl2-6.3/books/rtl/rel5/lib/bvecp-helpers.lisp
--- acl2-6.2/books/rtl/rel5/lib/bvecp-helpers.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/bvecp-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(include-book "rtl")
-(include-book "rtlarr")
-(local (include-book "../support/bvecp-helpers"))
-
-(defthm bv-arrp-implies-nonnegative-integerp
-  (implies (bv-arrp obj size)
-           (and (integerp (ag index obj))
-                (<= 0 (ag index obj))))
-  :rule-classes (:rewrite :type-prescription)
-  )
-
-; The two events following the next local include-book were added by Matt
-; K. June 2004: Some proofs require calls of expt to be evaluated, but some
-; calls are just too large (2^2^n for large n).  So we use the following hack,
-; which allows calls of 2^n for n<130 to be evaluated even when the
-; executable-counterpart of expt is disabled.  The use of 130 is somewhat
-; arbitrary, chosen in the hope that it suffices for relieving of hyps related
-; to widths of bit vectors
-
-(local (include-book "../arithmetic/basic"))
-
-(defun expt-exec (r i)
-  (declare (xargs :guard
-                  (and (acl2-numberp r)
-                       (integerp i)
-                       (not (and (eql r 0) (< i 0))))))
-  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
-       :exec (expt r i)))
-
-(defthm expt-2-evaluator
-  (implies (syntaxp (and (quotep n)
-                         (natp (cadr n))
-                         (< (cadr n) 130)
-                         ))
-           (equal (expt 2 n)
-                  (expt-exec 2 n))))
-
diff -Nru acl2-6.2/books/rtl/rel5/lib/bvecp-raw-helpers.lisp acl2-6.3/books/rtl/rel5/lib/bvecp-raw-helpers.lisp
--- acl2-6.2/books/rtl/rel5/lib/bvecp-raw-helpers.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/bvecp-raw-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,792 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-;Contains bvecp lemmas about the RTL primitives.
-;Also contains type lemmas (non-negative integer, natp, etc.)
-
-(include-book "rtl")
-(include-book "rtlarr")
-;(include-book "util") ?
-(local (include-book "../support/bvecp-helpers"))
-(local (include-book "../support/bits"))
-(local (include-book "../support/bitn"))
-(local (include-book "../support/setbits"))
-(local (include-book "../support/setbitn"))
-(local (include-book "../support/logs"))
-(local (include-book "../support/lnot"))
-(local (include-book "../support/shft"))
-(local (include-book "../support/cat"))
-(local (include-book "../support/mulcat"))
-(local (include-book "../support/encode"))
-(local (include-book "../support/decode"))
-(local (include-book "../support/land"))
-(local (include-book "../support/lior"))
-(local (include-book "../support/lxor"))
-(local (include-book "../support/guards"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-(set-match-free-default :all)
-
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(local (include-book "../arithmetic/expo"))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defun expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;; bits
-
-(defthm bits-nonnegative-integerp-type
-  (and (<= 0 (bits x i j))
-       (integerp (bits x i j)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than bits-nonnegative-integer and might be worse
-(in-theory (disable (:type-prescription bits)))
-
-(defthm bits-bvecp
-   (implies (and (<= (+ 1 i (- j)) k)
-                 (case-split (integerp k))
-                 )
-            (bvecp (bits x i j) k)))
-
-
-;; setbits
-
-(defthm setbits-nonnegative-integer-type
-  (and (integerp (setbits x w i j y))
-       (<= 0 (setbits x w i j y)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than setbits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription setbits)))
-
-(defthm setbits-bvecp
-  (implies (and (<= w k)
-                (case-split (integerp k))
-                )
-           (bvecp (setbits x w i j y) k)))
-
-
-;; setbitn
-
-(defthm setbitn-nonnegative-integer-type
-  (and (integerp (setbitn x w n y))
-       (<= 0 (setbitn x w n y)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than setbits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription setbitn)))
-
-(defthm setbitn-bvecp
-  (implies (and (<= w k)
-                (case-split (integerp k)))
-           (bvecp (setbitn x w n y) k)))
-
-
-
-;; log<
-
-(defthm log<-nonnegative-integer-type
-  (and (integerp (log< x y))
-       (<= 0 (log< x y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than log<-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log<)))
-
-(defthm log<-bvecp
-  (bvecp (log< x y) 1))
-
-
-;; log<=
-
-(defthm log<=-nonnegative-integer-type
-  (and (integerp (log<= x y))
-       (<= 0 (log<= x y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than log<=-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log<=)))
-
-(defthm log<=-bvecp
-  (bvecp (log<= x y) 1))
-
-
-
-;; log>
-
-(defthm log>-nonnegative-integer-type
-  (and (integerp (log> x y))
-       (<= 0 (log> x y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than log>-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log>)))
-
-(defthm log>-bvecp
-  (bvecp (log> x y) 1))
-
-
-
-;; log>=
-
-(defthm log>=-nonnegative-integer-type
-  (and (integerp (log>= x y))
-       (<= 0 (log>= x y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than log>=-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log>=)))
-
-(defthm log>=-bvecp
-  (bvecp (log>= x y) 1))
-
-
-
-;; log=
-
-(defthm log=-nonnegative-integer-type
-  (and (integerp (log= x y))
-       (<= 0 (log= x y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than log=-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log=)))
-
-(defthm log=-bvecp
-  (bvecp (log= x y) 1))
-
-
-
-;; log<>
-
-(defthm log<>-nonnegative-integer-type
-  (and (integerp (log<> x y))
-       (<= 0 (log<> x y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than log<>-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log<>)))
-
-(defthm log<>-bvecp
-  (bvecp (log<> x y) 1))
-
-
-
-;; logand1
-
-(defthm logand1-nonnegative-integer-type
-  (and (integerp (logand1 x y))
-       (<= 0 (logand1 x y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than logand1-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription logand1)))
-
-(defthm logand1-bvecp
-  (bvecp (logand1 x y) 1))
-
-
-
-;; logior1
-
-(defthm logior1-nonnegative-integer-type
-  (and (integerp (logior1 x))
-       (<= 0 (logior1 x)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than logior1-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription logior1)))
-
-(defthm logior1-bvecp
-  (bvecp (logior1 x) 1))
-
-
-
-;; logxor1
-
-(defthm logxor1-nonnegative-integer-type
-  (and (integerp (logxor1 x))
-       (<= 0 (logxor1 x)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than logxor1-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription logxor1)))
-
-(defthm logxor1-bvecp
-  (bvecp (logxor1 x) 1))
-
-
-
-;; lnot
-
-(defthm lnot-nonnegative-integer-type
-  (and (integerp (lnot x n))
-       (<= 0 (lnot x n)))
-  :rule-classes ((:type-prescription :typed-term (lnot x n))))
-
-;lnot-nonnegative-integer-type is strictly better, and we don't need both
-(in-theory (disable (:type-prescription lnot))) 
-
-(defthm lnot-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lnot x n) k)))
-
-
-;; bitn
-
-(defthm bitn-nonnegative-integer
-  (and (integerp (bitn x n))
-       (<= 0 (bitn x n)))
-  :rule-classes ( :type-prescription))
-
-;this rule is no better than bitn-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription bitn)))
-
-(defthm bitn-bvecp
-  (implies (and (<= 1 k)
-                (case-split (integerp k)))
-           (bvecp (bitn x n) k)))
-
-;; shft
-
-(defthm shft-nonnegative-integer-type
-  (and (integerp (shft x s l))
-       (<= 0 (shft x s l)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription shft)))
-
-(defthm shft-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (shft x s n) k)))
-
-;; cat
-
-(defthm cat-nonnegative-integer-type
-  (and (integerp (CAT X m Y N))
-       (<= 0 (CAT X m Y N)))
-  :rule-classes (:type-prescription))
-
-(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
-
-(defthm cat-bvecp
-  (implies (and (<= (+ m n) k)
-                (case-split (integerp k)))
-           (bvecp (cat x m y n) k)))
-
-
-;; logand
-
-(defthm logand-integer-type-prescription
-  (integerp (logand i j))
-  :rule-classes (:type-prescription))
-
-(defthm logand-non-negative-integer-type-prescription
-  (implies (or (<= 0 i)
-               (<= 0 j))
-           (and (<= 0 (logand i j))
-                (integerp (logand i j))))
-  :rule-classes (:type-prescription))
-
-(defthm logand-non-negative
-  (implies (or (<= 0 x)
-               (<= 0 y)
-               )
-           (<= 0 (logand x y))))
-
-(defthm bvecp-logand-alternate
-  (implies (and (integerp n)
-                (<= 0 n)
-                (bvecp x n)
-                (bvecp y n))
-           (bvecp (logand x y) n)))
-
-
-;; logior
-
-(defthm logior-integer-type-prescription
-  (integerp (logior i j))
-  :rule-classes (:type-prescription))
-
-(defthm logior-non-negative-integer-type-prescription
-  (implies (and (<= 0 i)
-                (<= 0 j))
-           (and (<= 0 (logior i j))
-                (integerp (logior i j))))
-  :rule-classes (:type-prescription))
-
-(defthm logior-non-negative
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                )
-           (<= 0 (logior i j))))
-
-(defthm bvecp-logior-alternate
-  (implies (and (integerp n)
-                (<= 0 n)
-                (bvecp x n)
-                (bvecp y n))
-           (bvecp (logior x y) n)))
-
-;; logxor
-;!!fix this to have lemmas like logand,logior above
-(defthm natp-logxor-alternate-2
-    (implies (and (integerp x) (<= 0 x)
-		  (integerp y) (<= 0 y))
-	     (and (integerp (logxor x y))
-		  (<= 0 (logxor x y))))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm bvecp-logxor-alternate
-  (implies (and (integerp n)
-                (<= 0 n)
-                (bvecp x n)
-                (bvecp y n))
-           (bvecp (logxor x y) n)))
-
-
-;; mulcat
-
-(defund mulcat (l n x)
-
-; We introduce mbe not because we want particularly fast execution, but because
-; the existing logic definition does not satisfy the guard of cat, which can't
-; be changed because of the guard of bits.
-
-  (declare (xargs :guard (and (integerp l)
-                              (< 0 l)
-                              (acl2-numberp n)
-                              (natp x))))
-  (mbe :logic (if (and (integerp n) (> n 0))
-                  (cat (mulcat l (1- n) x)
-                       (* l (1- n))
-                       x
-                       l)
-                0)
-       :exec  (cond ((eql n 1)
-                     (bits x (1- l) 0))
-                    ((and (integerp n) (> n 0))
-                     (cat (mulcat l (1- n) x)
-                          (* l (1- n))
-                          x
-                          l))
-                    (t 0))))
-
-(defthm mulcat-nonnegative-integer-type
-  (and (integerp (mulcat l n x))
-       (<= 0 (mulcat l n x)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than mulcat-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
-
-(defthm mulcat-bvecp
-  (implies (and (>= p (* l n))
-                (case-split (integerp p))
-                (case-split (natp l)))
-           (bvecp (mulcat l n x) p)))
-
-
-;; mod-
-
-;finish this section (will have to change comp2-inv?)
-
-#|
-(defthm mod--nonnegative-integer-type
-  (and (integerp (mod- l n x))
-       (<= 0 (mod- l n x)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than mod--nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription mod-)))
-|#
-
-#| mod- is now a macro!
-(defthm mod--bvecp
-  (implies (and (bvecp x n)
-                (bvecp y n)
-                (integerp n)
-                (>= n 0))
-           (bvecp (mod- x y n) n)))
-|#
-
-;; encode
-
-(defthm encode-nonnegative-integer-type
-  (and (integerp (encode x n))
-       (<= 0 (encode x n)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than encode-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription encode)))
-
-(defthm encode-bvecp-old
-  (implies (and (<= (+ 1 (expo n)) k)
-                (case-split (integerp k)))
-           (bvecp (encode x n) k)))
-
-
-;; decode
-
-(defthm decode-nonnegative-integer-type
-  (and (integerp (decode x n))
-       (<= 0 (decode x n)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than decode-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription decode)))
-
-(defthm decode-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k))
-                )
-           (bvecp (decode x n) k)))
-
-
-
-
-
-(DEFTHM UNKNOWN-upper-bound
-  (< (UNKNOWN KEY SIZE N) (expt 2 size))
-  :RULE-CLASSES
-  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
-
-;BOZO dup?
-(defthm bv-arrp-implies-nonnegative-integerp
-  (implies (bv-arrp obj size)
-           (and (INTEGERP (ag index obj))
-                (<= 0 (ag index obj))))
-  :rule-classes (:rewrite :type-prescription)
-  )
-
-
-; land
-
-(defthm land-nonnegative-integer-type
-  (and (integerp (land x y n))
-       (<= 0 (land x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-land)))
-
-;drop this if we plan to keep natp enabled?
-(defthm land-natp
-  (natp (land x y n)))
-
-(defthm land-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (land x y n) k)))
-
-;; lior
-
-
-(defthm lior-nonnegative-integer-type
-  (and (integerp (lior x y n))
-       (<= 0 (lior x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lior)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lior-natp
-  (natp (lior x y n)))
-
-(defthm lior-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lior x y n) k)))
-
-;; lxor
-
-
-(defthm lxor-nonnegative-integer-type
-  (and (integerp (lxor x y n))
-       (<= 0 (lxor x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lxor)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lxor-natp
-  (natp (lxor x y n)))
-
-(defthm lxor-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lxor x y n) k)))
-
-;; cat
-
-
-(defthm cat-nonnegative-integer-type
-  (and (integerp (CAT X m Y N))
-       (<= 0 (CAT X m Y N)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than cat-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription binary-cat)))
-
-;just a rewrite rule
-(defthm cat-natp
-  (natp (cat x m y n)))
-
-(defthm cat-bvecp
-  (implies (and (<= (+ m n) k)
-                (case-split (integerp k)))
-           (bvecp (cat x m y n) k)))
-
-;would like to remove some of this stuff
-
-;;;;;;;;;;;;;;;;;;; other helpful lemmas
-
-(defthm nonneg-+
-  (implies (and (<= 0 x)
-                (<= 0 y))
-           (<= 0 (+ x y))))
-
-(defthm integerp-+
-  (implies (and (integerp x)
-                (integerp y))
-           (integerp (+ x y))))
-
-#|
-;should be a forward-chaining rule?
-(defthm bvecp-implies-natp
-  (implies (bvecp x k)
-           (and (integerp x)
-                (>= x 0))))
-
-;free var
-;should be a forward-chaining rule?
-(defthm bvecp-implies-rationalp
-  (implies (bvecp x k)
-           (rationalp x)))
-|#
-
-;why do we have this?
-(defthm unknown-upper-bound
-  (< (unknown key size n) (expt 2 size))
-  :rule-classes
-  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
-
-(defthm bv-arrp-implies-nonnegative-integerp
-  (implies (bv-arrp obj size)
-           (and (INTEGERP (ag index obj))
-                (<= 0 (ag index obj))))
-  :rule-classes (:rewrite :type-prescription))
-
-;(local (in-theory (enable floor-fl)))
-
-;These next two are for the bus unit bvecp lemmas:
-
-;could use (local (in-theory (enable expt-compare-with-double)))
-;remove?
-(defthm bits-does-nothing-hack
-  (implies (and (< x (expt 2 i)) 
-                (integerp x)
-                (<= 0 x)
-                (integerp i)
-                (<= 0 i))
-           (equal (BITS (* 2 x) i 0)
-                  (* 2 x))))
-
-;remove?
-(defthm bits-does-nothing-hack-2
-  (implies (and (< x (expt 2 i)) 
-                (integerp x)
-                (<= 0 x)
-                (integerp i)
-                (<= 0 i))
-           (equal (bits (+ 1 (* 2 x)) i 0)
-                  (+ 1 (* 2 x)))))
-
-
-;is this one too expensive?
-(defthm bvecp-def
-  (implies (and (< x (expt 2 k))
-                (integerp x)
-                (<= 0 x)
-                )
-           (bvecp x k))
-  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
-
-
-; The two events following the next local include-book were added by Matt
-; K. June 2004: Some proofs require calls of expt to be evaluated, but some
-; calls are just too large (2^2^n for large n).  So we use the following hack,
-; which allows calls of 2^n for n<130 to be evaluated even when the
-; executable-counterpart of expt is disabled.  The use of 130 is somewhat
-; arbitrary, chosen in the hope that it suffices for relieving of hyps related
-; to widths of bit vectors
-
-(local (include-book "../arithmetic/basic"))
-
-(defun expt-exec (r i)
-  (declare (xargs :guard
-                  (and (acl2-numberp r)
-                       (integerp i)
-                       (not (and (eql r 0) (< i 0))))))
-  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
-       :exec (expt r i)))
-
-(defthm expt-2-evaluator
-  (implies (syntaxp (and (quotep n)
-                         (natp (cadr n))
-                         (< (cadr n) 130)
-                         ))
-           (equal (expt 2 n)
-                  (expt-exec 2 n))))
-
-
-;remove these?
-
-
-;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
-;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
-;;;;;;;;;;;;;;;;;;; statements have no default.
-
-;maybe leave this one?
-
-#|
-(defthm bvecp-1-values
-  (implies (and (bvecp x 1)
-                (not (equal x 0)))
-           (equal (equal x 1) t)))
-
-(defthm bvecp-2-values
-  (implies (and (bvecp x 2)
-                (not (equal x 2))
-                (not (equal x 1))
-                (not (equal x 0)))
-           (equal (equal x 3) t)))
-
-(defthm bvecp-3-values
-  (implies (and (bvecp x 3)
-                (not (equal x 6))
-                (not (equal x 5))
-                (not (equal x 4))
-                (not (equal x 3))
-                (not (equal x 2))
-                (not (equal x 1))
-                (not (equal x 0)))
-           (equal (equal x 7) t)))
-
-(defthm bvecp-4-values
-  (implies (and (bvecp x 4)
-                (not (equal x 14))
-                (not (equal x 13))
-                (not (equal x 12))
-                (not (equal x 11))
-                (not (equal x 10))
-                (not (equal x 9))
-                (not (equal x 8))
-                (not (equal x 7))
-                (not (equal x 6))
-                (not (equal x 5))
-                (not (equal x 4))
-                (not (equal x 3))
-                (not (equal x 2))
-                (not (equal x 1))
-                (not (equal x 0)))
-           (equal (equal x 15) t)))
-
-(defthm bvecp-5-values
-  (implies (and (bvecp x 5)
-                (not (equal x 30))
-                (not (equal x 29))
-                (not (equal x 28))
-                (not (equal x 27))
-                (not (equal x 26))
-                (not (equal x 25))
-                (not (equal x 24))
-                (not (equal x 23))
-                (not (equal x 22))
-                (not (equal x 21))
-                (not (equal x 20))
-                (not (equal x 19))
-                (not (equal x 18))
-                (not (equal x 17))
-                (not (equal x 16))
-                (not (equal x 15))
-                (not (equal x 14))
-                (not (equal x 13))
-                (not (equal x 12))
-                (not (equal x 11))
-                (not (equal x 14))
-                (not (equal x 13))
-                (not (equal x 12))
-                (not (equal x 11))
-                (not (equal x 10))
-                (not (equal x 9))
-                (not (equal x 8))
-                (not (equal x 7))
-                (not (equal x 6))
-                (not (equal x 5))
-                (not (equal x 4))
-                (not (equal x 3))
-                (not (equal x 2))
-                (not (equal x 1))
-                (not (equal x 0)))
-           (equal (equal x 31) t)))
-|#
-
-#|
-;can remove these two?
-(defthm natp-* 
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp y)
-                (>= y 0))
-           (and (integerp (* x y))
-                (>= (* x y) 0))))
-
-(defthm natp-+ 
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp y)
-                (>= y 0))
-           (and (integerp (+ x y))
-                (>= (+ x y) 0))))
-|#
-
-#|
-;drop?
-(defthm bits-bvecp-fw
-  (implies (equal n (- (1+ i) j))
-           (bvecp (bits x i j) n))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((bits x i j)))))
-|#
-
-
diff -Nru acl2-6.2/books/rtl/rel5/lib/clocks.lisp acl2-6.3/books/rtl/rel5/lib/clocks.lisp
--- acl2-6.2/books/rtl/rel5/lib/clocks.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/clocks.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,175 +0,0 @@
-; Most or all of this was originally written by Eric Smith while an intern at AMD.
-
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(include-book "../support/clocks")
-
-; The analysis of clocks uses some new functions.
-; 
-; First, even and odd are not the same as evenp and oddp.  For one thing, even
-; and odd are defined recursively, and I've proved a bunch of nice rules about
-; them which we probably want to use and which may not be proved about evenp and
-; oddp (and which may be nicer than what is proveable about evenp and oddp).  One
-; nice property of even and odd is that each implies integerp.  (By contrast,
-; evenp returns t for non-numbers like nil or '(a b).)  So rules which would
-; naturally have both the hyp (integerp n) and the hyp (evenp n) now can just
-; have (even n).
-; 
-; Second, I also define a function, MOD4. I didn't want to use MOD itself in the
-; clocking logic because reasoning about clocks needs to be fast and predictable.
-; (I can imagine that we'll have rules about MOD, especially when doing FP
-; proofs, which will just get in the way of our reasoning about clocks. We might
-; even open up MOD on occasion.)  So, in order to get complete control over the
-; rules which fire when we reason about clocks, I introduced MOD4, which we
-; expect never to have to open after proving a nice set of rules about it.
-; 
-; Also, theorems about MOD4 may be nicer than their analogs for MOD.  For
-; example, MOD4 is always equal to 0, 1, 2, or 3, but (mod #c(0 1) 4) = #c(0 1),
-; which isn't even rational.
-
-(defund pedge (x y)
-  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
-  (and (equal x 0)
-       (equal y 1)))
-
-(defund nedge (x y)
-  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
-  (and (equal x 1)
-       (equal y 0)))
-
-(defmacro posedge (clk)
-  `(and (not (zp n))
-        (pedge (,clk (1- n)) (,clk n))))
-
-(defmacro negedge (clk)
-  `(and (not (zp n))
-        (nedge (,clk (1- n)) (,clk n))))
-
-(defthm pedge-known-false-1
-  (not (pedge x 0)))
-
-(defthm pedge-known-false-2
-  (not (pedge 1 y)))
-
-(defthm nedge-known-false-1
-  (not (nedge x 1)))
-
-(defthm nedge-known-false-2
-  (not (nedge 0 y)))
-
-
-; The call (defperiodic NAME TYPE) creates 1) a defun which defines NAME to be
-; a periodic signal of the specified TYPE and 2) a bvecp lemma for that defun
-; (all periodics have width 1).
-
-; We intend the user to smash certain periodic inputs to his top level module
-; and replace their translations with calls to defperiodic.
-
-; Currently we support the following types of periodic signals:
-
-#|
-
-'fast-clock : 
-
- _   _   _   _   _   _   _
-| |_| |_| |_| |_| |_| |_| |_|
-
-
-'slow-clock-one-quantum-wide
-
- _       _       _       _
-| |_____| |_____| |_____| |__
-
-
-'slow-clock-one-quantum-wide-shifted :
-
-     _       _       _       _
-____| |_____| |_____| |_____| |__
-
-
-'slow-clock-two-quanta-wide :
-
- ___     ___     ___     ___     
-|   |___|   |___|   |___|   |___|
-
-
-'slow-clock-two-quanta-wide-shifted :
-
-     ___     ___     ___     
-|___|   |___|   |___|   |___|
-
-'always-1 :
-
-  ___________________________
-..
-
-
-|#
-
-; As the need arises, we can easily change defperiodic to add support for more
-; types of signal.
-
-; BTW, currently, the definitions generated by defperiodic return unknown
-; values (calls to reset) at time 0 (and whenever N is not a natp).  Perhaps
-; this is too conservative, and perhaps defining the value at time 0 would
-; allow nicer rewrite rules to be proved.
-
-(defconst *defperiodic-types*
-
-; Keep this in sync with the corresponding definition in the compiler.
-
-  '(fast-clock
-    slow-clock-one-quantum-wide
-    slow-clock-one-quantum-wide-shifted
-    slow-clock-two-quanta-wide
-    slow-clock-two-quanta-wide-shifted
-    always-1))
-
-(defmacro defperiodic (name type)
-  (declare (xargs :guard (member-eq type *defperiodic-types*)))
-  (list*
-   'encapsulate
-   nil
-   (case type
-     (fast-clock
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (even n) 1 0))))
-     (slow-clock-one-quantum-wide
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (equal 0 (mod4 n)) 1 0))))
-     (slow-clock-one-quantum-wide-shifted
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (equal 2 (mod4 n)) 1 0))))
-     (slow-clock-two-quanta-wide
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (or (equal 0 (mod4 n))
-                   (equal 1 (mod4 n)))
-               1
-             0))))
-     (slow-clock-two-quanta-wide-shifted
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (or (equal 2 (mod4 n))
-                   (equal 3 (mod4 n)))
-               1
-             0))))
-     (always-1
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           1)))
-     (otherwise (er hard 'defperiodic
-                    "Bad type, ~x0, for defperiodic."
-                    type)))
-   `((defbvecp ,name (n) 1 :hints (("Goal" :in-theory (enable ,name)))))))
diff -Nru acl2-6.2/books/rtl/rel5/lib/float.lisp acl2-6.3/books/rtl/rel5/lib/float.lisp
--- acl2-6.2/books/rtl/rel5/lib/float.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/float.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,437 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/top"))
-
-(include-book "log")
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-;;;**********************************************************************
-;;;                 Sign, Significand, and Exponent
-;;;**********************************************************************
-
-(defund sgn (x) 
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0) -1 +1)))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (:? x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-(defthmd expo-lower-bound
-    (implies (and (rationalp x)
-		  (not (equal x 0)))
-	     (<= (expt 2 (expo x)) (abs x)))
-  :rule-classes :linear)
-
-(defthmd expo-upper-bound
-    (implies (and (rationalp x))
-	     (< (abs x) (expt 2 (1+ (expo x)))))
-  :rule-classes :linear)
-
-(defthm expo-unique
-  (implies (and (<= (expt 2 n) (abs x))
-                (< (abs x) (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n))
-           (equal n (expo x)))
-  :rule-classes ())
-
-(defthm fp-rep
-    (implies (rationalp x)
-	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
-  :rule-classes ())
-
-(defthm fp-abs
-    (implies (rationalp x)
-	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
-  :rule-classes ())
-
-(defthmd expo>=
-    (implies (and (<= (expt 2 n) x)
-                  (rationalp x)
-		  (integerp n))
-	     (<= n (expo x)))
-  :rule-classes :linear)
-
-(defthmd expo<=
-    (implies (and (< x (* 2 (expt 2 n)))
-                  (< 0 x)
-                  (rationalp x)
-		  (integerp n))
-	     (<= (expo x) n))
-  :rule-classes :linear)
-
-(defthm expo-2**n
-    (implies (integerp n)
-	     (equal (expo (expt 2 n))
-		    n)))
-
-(defthmd expo-monotone
-  (implies (and (<= (abs x) (abs y))
-                (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                (case-split (rationalp y)))
-           (<= (expo x) (expo y)))
-  :rule-classes :linear)
-
-(defthmd bvecp-expo
-    (implies (case-split (natp x))
-	     (bvecp x (1+ (expo x)))))
-
-(defthmd mod-expo
-  (implies (and (< 0 x)
-                (rationalp x))
-           (equal (mod x (expt 2 (expo x)))
-                  (- x (expt 2 (expo x))))))
-
-(defthmd sig-lower-bound
-  (implies (and (rationalp x)
-                (not (equal x 0)))
-           (<= 1 (sig x)))
-  :rule-classes (:rewrite :linear))
-
-(defthmd sig-upper-bound
-  (< (sig x) 2)
-  :rule-classes (:rewrite :linear))
-
-(defthm already-sig
-  (implies (and (rationalp x)
-                (<= 1 x)
-                (< x 2))
-           (= (sig x) x)))
-
-(defthm sig-sig
-    (equal (sig (sig x)) 
-	   (sig x)))
-
-(defthm fp-rep-unique
-    (implies (and (rationalp x)
-		  (rationalp m)
-		  (<= 1 m)
-		  (< m 2)
-		  (integerp e)
-		  (= (abs x) (* m (expt 2 e))))
-	     (and (= m (sig x))
-		  (= e (expo x))))
-  :rule-classes ())
-
-(defthmd sgn-minus
-  (equal (sgn (* -1 x))
-         (* -1 (sgn x))))
-
-(defthmd expo-minus
-  (equal (expo (* -1 x))
-         (expo x)))
-
-(defthmd sig-minus
-  (equal (sig (* -1 x))
-         (sig x)))
-
-(defthmd sgn-shift
-  (equal (sgn (* x (expt 2 k)))
-         (sgn x)))
-
-(defthmd expo-shift
-  (implies (and (rationalp x)
-                (not (equal x 0))
-                (integerp n))
-           (equal (expo (* (expt 2 n) x)) 
-                  (+ n (expo x)))))
-
-(defthmd sig-shift
-  (equal (sig (* (expt 2 n) x)) 
-         (sig x)))
-
-(defthmd sgn-prod
-  (implies (and (case-split (rationalp x))
-                (case-split (rationalp y)))
-           (equal (sgn (* x y))
-                  (* (sgn x) (sgn y)))))
-
-(defthmd expo-prod
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (rationalp y)
-		  (not (= y 0)))
-	     (equal (expo (* x y))
-		    (if (< (* (sig x) (sig y)) 2)
-			(+ (expo x) (expo y))
-		      (+ 1 (expo x) (expo y))))))
-
-(defthmd expo-prod-lower
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (rationalp y)
-		  (not (= y 0)))
-	     (<= (+ (expo x) (expo y)) (expo (* x y))))
-  :rule-classes :linear)
-
-(defthmd expo-prod-upper
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (rationalp y)
-		  (not (= y 0)))
-	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
-  :rule-classes :linear)
-
-(defthmd sig-prod
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (rationalp y)
-		  (not (= y 0)))
-	     (equal (sig (* x y))
-		    (if (< (* (sig x) (sig y)) 2)
-			(* (sig x) (sig y))
-		      (* 1/2 (sig x) (sig y))))))
-
-
-;;;**********************************************************************
-;;;                          Exactness
-;;;**********************************************************************
-
-(defund exactp (x n)
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defthmd exactp2
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (equal (exactp x n)
-		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
-
-(defthm exactp-sig
-  (equal (exactp (sig x) n)
-         (exactp x n)))
-
-(defthm exactp-minus
-  (equal (exactp (* -1 x) n)
-         (exactp x n)))
-
-(defthm exact-neg
-    (equal (exactp x n) (exactp (abs x) n))
-  :rule-classes ())
-
-(defthmd exactp-shift
-  (implies (and (rationalp x)
-                (integerp k)
-                (integerp n))
-           (equal (exactp (* (expt 2 k) x) n)
-                  (exactp x n))))
-
-(defthmd exactp-<=
-    (implies (and (exactp x m)
-                  (<= m n)
-                  (rationalp x)
-		  (integerp n)
-		  (integerp m))
-	     (exactp x n)))
-
-(defthmd exactp-2**n
-  (implies  (and (case-split (integerp m))
-                 (case-split (> m 0)))
-            (exactp (expt 2 n) m)))
-
-(defthm bvecp-exactp
-  (implies (bvecp x n)
-           (exactp x n)))
-
-(defthm exactp-prod
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp n)
-		  (exactp x m)
-		  (exactp y n))
-	     (exactp (* x y) (+ m n)))
-  :rule-classes ())
-
-(defthm exactp-x2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (exactp (* x x) (* 2 n)))
-	     (exactp x n))
-  :rule-classes ())
-
-(defthm exact-bits-1
-  (implies (and (equal (expo x) (1- n))
-                (rationalp x)
-                (integerp k))
-           (equal (integerp (/ x (expt 2 k)))
-		  (exactp x (- n k))))
-  :rule-classes ())
-
-(defthm exact-bits-2
-  (implies (and (equal (expo x) (1- n))
-                (rationalp x)
-                (<= 0 x)
-                (integerp k)
-                )
-           (equal (integerp (/ x (expt 2 k)))
-		  (equal (bits x (1- n) k)
-                         (/ x (expt 2 k)))))
-  :rule-classes ())
-
-(defthm exact-bits-3
-  (implies (integerp x)
-           (equal (integerp (/ x (expt 2 k)))
-		  (equal (bits x (1- k) 0)
-                         0)))
-  :rule-classes ())
-
-(defthm exact-k+1
-    (implies (and (natp n)
-		  (natp x)
-		  (= (expo x) (1- n))
-		  (natp k)
-		  (< k (1- n))
-		  (exactp x (- n k)))
-	     (iff (exactp x (1- (- n k)))
-		  (= (bitn x k) 0)))
-  :rule-classes ())
-
-(defthm exactp-diff
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-		  (integerp n)
-		  (> n 0)
-		  (> n k)
-		  (exactp x n)
-		  (exactp y n)
-		  (<= (+ k (expo (- x y))) (expo x))
-		  (<= (+ k (expo (- x y))) (expo y)))
-	     (exactp (- x y) (- n k)))
-  :rule-classes ())
-
-(defthm exactp-diff-cor
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n)
-		  (<= (abs (- x y)) (abs x))
-		  (<= (abs (- x y)) (abs y)))
-	     (exactp (- x y) n))
-  :rule-classes ())
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defthm fp+-positive
-  (implies (<= 0 x)
-           (< 0 (fp+ x n)))
-  :rule-classes :type-prescription)
-
-(defthm fp+1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n))
-	     (exactp (fp+ x n) n))
-  :rule-classes ())
-
-(defthm fp+2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y x)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (>= y (fp+ x n)))
-  :rule-classes ())
-
-(defthm fp+expo
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-  		  (not (= (expo (fp+ x n)) (expo x))))
-	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthm expo-diff-min
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n)
-		  (not (= y x)))
-	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
-  :rule-classes ())
-
-(defun fp- (x n)
-  (if (= x (expt 2 (expo x)))
-      (- x (expt 2 (- (expo x) n)))
-    (- x (expt 2 (- (1+ (expo x)) n)))))
-
-(defthm fp--non-negative
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (> n 0)
-                 (> x 0))
-            (and (rationalp (fp- x n))
-                 (< 0 (fp- x n))))
-   :rule-classes :type-prescription)
-
-(defthm fp-1
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n))
-           (exactp (fp- x n) n))
-  :rule-classes ())
-
-(defthm fp+-
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n))
-           (equal (fp+ (fp- x n) n)
-                  x)))
-
-(defthm fp-+
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n))
-           (equal (fp- (fp+ x n) n)
-                  x)))
-
-(defthm fp-2
-  (implies (and (rationalp x)
-                (rationalp y)
-                (> y 0)
-                (> x y)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (exactp y n))
-           (<= y (fp- x n)))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/lib/log.lisp acl2-6.3/books/rtl/rel5/lib/log.lisp
--- acl2-6.2/books/rtl/rel5/lib/log.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/log.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,830 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(include-book "bits")
-
-(local (include-book "../support/top"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-
-;;;**********************************************************************
-;;;                     LNOT
-;;;**********************************************************************
-
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-(defthm lnot-nonnegative-integer-type
-  (and (integerp (lnot x n))
-       (<= 0 (lnot x n)))
-  :rule-classes ((:type-prescription :typed-term (lnot x n))))
-
-(in-theory (disable (:type-prescription lnot))) 
-
-(defthmd lnot-bits-1
-  (equal (lnot (bits x (1- n) 0) n)
-         (lnot x n)))
-
-(defthm lnot-bvecp
-  (implies (and (<= n k)
-		(case-split (integerp k)))
-	   (bvecp (lnot x n) k)))
-
-(defthm lnot-x-0
-  (equal (lnot x 0) 0))
-
-(defthmd lnot-shift
-  (implies (and (case-split (integerp x))
-                (case-split (natp n))
-                (natp k))
-           (equal (lnot (* (expt 2 k) x) n)
-                  (if (<= k n)
-                      (+ (* (expt 2 k) (lnot x (- n k)))
-                         (1- (expt 2 k)))
-                    (1- (expt 2 n))))))
-
-(defthmd lnot-shift-2
-  (implies (and (syntaxp (not (quotep x))) ;prevents loops
-                (case-split (integerp x))
-                (case-split (< 0 n))
-                (case-split (integerp n)))
-           (equal (lnot (* 2 x) n)
-                  (+ 1 (* 2 (lnot x (1- n)))))))
-
-(defthmd lnot-fl
-  (implies (and (natp n)
-                (natp k))
-           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
-                  (lnot (fl (/ x (expt 2 k))) n))))
-
-(defthm mod-lnot
-  (implies (and (<= k n)
-                (natp k)
-                (integerp n))
-           (equal (mod (lnot x n) (expt 2 k))
-                  (lnot (mod x (expt 2 k)) k))))
-
-(defthmd bits-lnot
-  (implies (and (case-split (natp j))
-		(case-split (integerp n))
-		(case-split (integerp i)))
-	   (equal (bits (lnot x n) i j)
-                  (if (< i n)
-                      (lnot (bits x i j)
-                            (1+ (- i j)))
-                    (lnot (bits x (1- n) j)
-                          (- n j))))))
-
-(defthmd bitn-lnot
-  (implies (and (case-split (natp k))
-		(case-split (natp n)))
-	   (equal (bitn (lnot x n) k)
-		  (if (< k n)
-		      (lnot (bitn x k) 1)
-		    0))))
-
-(defthmd lnot-cat
-  (implies (and (case-split (natp n))
-		(case-split (natp m))
-		(equal l (+ m n)))
-	   (equal (lnot (cat x m y n) l)
-		  (cat (lnot x m) m (lnot y n) n))))
-
-
-;;;**********************************************************************
-;;;                LAND, LIOR, and LXOR
-;;;**********************************************************************
-
-(defund binary-land (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (and (equal (bitn x 0) 1)
-                       (equal (bitn y 0) 1))
-                  1
-                0))
-             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-land (mod x 2) (mod y 2) 1))))
-       :exec
-       (logand (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro land (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x))
-         `(binary-land ,@x))
-        (t         
-         `(binary-land ,(car x)
-                       (land ,@(cdr x))
-                       ,(car (last x))))))
-
-(defthm land-nonnegative-integer-type
-  (and (integerp (land x y n))
-       (<= 0 (land x y n)))
-  :rule-classes (:type-prescription))
-
-(in-theory (disable (:type-prescription binary-land)))
-
-(defund binary-lior (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (or (equal (bitn x 0) 1)
-                      (equal (bitn y 0) 1))
-                  1
-                0))
-             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-lior (mod x 2) (mod y 2) 1))))
-       :exec
-       (logior (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro lior (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
-         `(binary-lior ,@x))
-        (t         
-         `(binary-lior ,(car x)
-                       (lior ,@(cdr x))
-                       ,(car (last x))))))
-
-(defthm lior-nonnegative-integer-type
-  (and (integerp (lior x y n))
-       (<= 0 (lior x y n)))
-  :rule-classes (:type-prescription))
-
-(in-theory (disable (:type-prescription binary-lior)))
-
-(defund binary-lxor (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (iff (equal (bitn x 0) 1)
-                       (equal (bitn y 0) 1))
-                  0
-                1))
-             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-lxor (mod x 2) (mod y 2) 1))))
-       :exec
-       (logxor (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro lxor (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x))
-         `(binary-lxor ,@x))
-        (t         
-         `(binary-lxor ,(car x)
-                       (lxor ,@(cdr x))
-                       ,(car (last x))))))
-
-(defthm lxor-nonnegative-integer-type
-  (and (integerp (lxor x y n))
-       (<= 0 (lxor x y n)))
-  :rule-classes (:type-prescription))
-
-(in-theory (disable (:type-prescription binary-lxor)))
-
-(defun logop-2-induct (x y)
-  (if (or (zp x) (zp y))
-      ()
-    (logop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
-
-(defun logop-2-n-induct (x y n)
-  (if (zp n)
-      (cons x y)
-    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-
-(defun logop-3-induct (x y z)
-  (declare (xargs :measure (:? z y x)))
-  (if (and (natp x) (natp y) (natp z))
-      (if (and (zp x) (zp y) (zp z))
-	  t
-	(logop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
-    t))
-
-(defthm land-x-y-0
-    (equal (land x y 0) 0))
-
-(defthm lior-x-y-0
-    (equal (lior x y 0) 0))
-
-(defthm lxor-x-y-0
-    (equal (lxor x y 0) 0))
-
-(defthmd land-bits-1
-  (equal (land (bits x (1- n) 0) y n)
-         (land x y n)))
-
-(defthmd land-bits-2
-  (equal (land x (bits y (1- n) 0) n)
-         (land x y n)))
-
-(defthmd lior-bits-1
-  (equal (lior (bits x (1- n) 0) y n)
-         (lior x y n)))
-
-(defthmd lior-bits-2
-  (equal (lior x (bits y (1- n) 0) n)
-         (lior x y n)))
-
-(defthmd lxor-bits-1
-  (equal (lxor (bits x (1- n) 0) y n)
-         (lxor x y n)))
-
-(defthmd lxor-bits-2
-  (equal (lxor x (bits y (1- n) 0) n)
-         (lxor x y n)))
-
-(defthm land-bvecp
-  (implies (and (<= n k) (case-split (integerp k)))
-	   (bvecp (land x y n) k)))
-
-(defthm lior-bvecp
-  (implies (and (<= n k) (case-split (integerp k)))
-	   (bvecp (lior x y n) k)))
-
-(defthm lxor-bvecp
-  (implies (and (<= n k) (case-split (integerp k)))
-	   (bvecp (lxor x y n) k)))
-
-(defthm land-bvecp-2
-    (implies (and (bvecp x m)
-		  (bvecp y m))
-	     (bvecp (land x y n) m)))
-
-(defthm lior-bvecp-2
-    (implies (and (bvecp x m)
-		  (bvecp y m))
-	     (bvecp (lior x y n) m)))
-
-(defthm lxor-bvecp-2
-    (implies (and (bvecp x m)
-		  (bvecp y m))
-	     (bvecp (lxor x y n) m)))
-
-(defthmd land-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (natp n)
-		  (natp m)
-		  (< n m))
-	     (equal (land x y m) (land x y n))))
-
-(defthmd lior-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (< n m)
-		  (natp n)
-		  (natp m))
-	     (equal (lior x y m) (lior x y n))))
-
-(defthmd lxor-reduce
-  (implies (and (bvecp x n)
-		(bvecp y n)
-		(< n m)
-		(case-split (integerp m)))
-	   (equal (lxor x y m) (lxor x y n))))
-
-(defthmd land-def
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n 0))
-           (equal (land x y n)
-                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (land (bitn x 0) (bitn y 0) 1)))))
-
-(defthmd lior-def
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n 0))
-           (equal (lior x y n)
-                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (lior (bitn x 0) (bitn y 0) 1)))))
-
-(defthmd lxor-def
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n 0))
-           (equal (lxor x y n)
-                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (lxor (bitn x 0) (bitn y 0) 1)))))
-
-(defthm land-0
-  (equal (land 0 y n)
-	 0))
-
-(defthmd land-equal-0
-  (implies (and (bvecp i 1)
-		(bvecp j 1))
-	   (equal (equal 0 (land i j 1))
-		  (or (equal i 0)
-		      (equal j 0)))))
-
-(defthm lior-0
-  (implies (case-split (bvecp y n))
-	   (equal (lior 0 y n) y)))
-
-(defthmd lior-equal-0
-  (implies (and (case-split (bvecp x n))
-		(case-split (bvecp y n))
-		(case-split (integerp n)))
-	   (equal (equal 0 (lior x y n))
-		  (and (equal x 0)
-		       (equal y 0)))))
-
-(defthm lxor-0
-  (implies (case-split (bvecp y n))
-	   (equal (lxor 0 y n) y)))
-
-(defthm land-shift
-  (implies (and (integerp x)
-                (integerp y)
-                (natp k))
-           (= (land (* (expt 2 k) x)
-                    (* (expt 2 k) y)
-                    n)
-              (* (expt 2 k) (land x y (- n k)))))
-  :rule-classes ())
-
-(defthm lxor-shift
-  (implies (and (integerp x)
-                (integerp y)
-                (natp k))
-           (= (lxor (* (expt 2 k) x)
-                    (* (expt 2 k) y)
-                    n)
-              (* (expt 2 k) (lxor x y (- n k)))))
-  :rule-classes ())
-
-(defthm lior-shift
-  (implies (and (integerp x)
-                (integerp y)
-                (natp k))
-           (= (lior (* (expt 2 k) x)
-                    (* (expt 2 k) y)
-                    n)
-              (* (expt 2 k) (lior x y (- n k)))))
-  :rule-classes ())
-
-(defthmd fl-land
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (natp k))
-           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
-                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
-
-(defthmd fl-lior
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (natp k))
-           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
-                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
-
-(defthmd fl-lxor
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (natp k))
-           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
-                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
-
-(defthmd mod-land
-  (implies (and (integerp n)
-                (integerp k)
-                (<= k n))
-           (equal (mod (land x y n) (expt 2 k))
-                  (land x y k))))
-
-(defthmd mod-lior
-  (implies (and (integerp n)
-                (<= k n))
-           (equal (mod (lior x y n) (expt 2 k))
-                  (lior x y k))))
-
-(defthmd mod-lxor
-  (implies (and (integerp n)
-                (integerp k)
-                (<= k n))
-           (equal (mod (lxor x y n) (expt 2 k))
-                  (lxor x y k))))
-
-(defthm bits-land
-  (implies (and (case-split (<= 0 j))
-		(case-split (integerp n))
-		(case-split (integerp i)))
-	   (equal (bits (land x y n) i j)
-		  (land (bits x i j) 
-			(bits y i j) 
-			(+ (min n (1+ i)) (- j))))))
-
-(defthm bits-lior
-  (implies (and (case-split (<= 0 j))
-		(case-split (integerp n))
-		(case-split (integerp i)))
-	   (equal (bits (lior x y n) i j)
-		  (lior (bits x i j) 
-			(bits y i j) 
-			(+ (min n (1+ i)) (- j))))))
-
-(defthm bits-lxor
-  (implies (and (case-split (<= 0 j))
-		(case-split (integerp n))
-		(case-split (integerp i)))
-	   (equal (bits (lxor x y n) i j)
-		  (lxor (bits x i j) 
-			(bits y i j) 
-			(+ (min n (1+ i)) (- j))))))
-
-(defthm bitn-land
-  (implies (and (case-split (<= 0 k))
-		(case-split (integerp n)))
-	   (equal (bitn (land x y n) k)
-		  (if (< k n)
-		      (land (bitn x k) 
-			    (bitn y k) 
-			    1)
-		    0))))
-
-(defthm bitn-lior
-  (implies (and (case-split (<= 0 k))
-		(case-split (integerp n)))
-	   (equal (bitn (lior x y n) k)
-		  (if (< k n)
-		      (lior (bitn x k) 
-			    (bitn y k) 
-			    1)
-		    0))))
-
-(defthm bitn-lxor
-  (implies (and (case-split (<= 0 k))
-		(case-split (integerp n)))
-	   (equal (bitn (lxor x y n) k)
-		  (if (< k n)
-		      (lxor (bitn x k) 
-			    (bitn y k) 
-			    1)
-		    0))))
-
-(defthmd land-cat
-  (implies (and (case-split (natp n))
-		(case-split (integerp m))
-		(> m 0)
-		(equal l (+ m n)))
-	   (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
-		  (cat (land x1 x2 m) m (land y1 y2 n) n))))
-
-(defthm land-cat-constant
-  (implies (and (case-split (integerp n))
-		(case-split (integerp m))
-		(syntaxp (quotep c))
-		(> n 0)
-		(> m 0)
-		(equal l (+ m n)))
-	   (equal (land c (cat x2 m y2 n) l)
-		  (cat (land (bits c (+ -1 m n) n) x2 m)
-		       m
-		       (land (bits c (1- n) 0) y2 n)
-		       n))))
-
-(defthmd lior-cat
-  (implies (and (case-split (natp n))
-		(case-split (integerp m))
-		(> m 0)
-		(equal l (+ m n)))
-	   (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
-		  (cat (lior x1 x2 m) m (lior y1 y2 n) n))))
-
-(defthm lior-cat-constant
-  (implies (and (case-split (integerp n))
-		(case-split (integerp m))
-		(syntaxp (quotep c))
-		(> n 0)
-		(> m 0)
-		(equal l (+ m n)))
-	   (equal (lior c (cat x2 m y2 n) l)
-		  (cat (lior (bits c (+ -1 m n) n) x2 m)
-		       m
-		       (lior (bits c (1- n) 0) y2 n)
-		       n))))
-
-(defthmd lxor-cat
-  (implies (and (case-split (natp n))
-		(case-split (integerp m))
-		(> m 0)
-		(equal l (+ m n)))
-	   (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
-		  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n))))
-
-(defthm lxor-cat-constant
-  (implies (and (case-split (integerp n))
-		(case-split (integerp m))
-		(syntaxp (quotep c))
-		(> n 0)
-		(> m 0)
-		(equal l (+ m n)))
-	   (equal (lxor c (cat x2 m y2 n) l)
-		  (cat (lxor (bits c (+ -1 m n) n) x2 m)
-		       m
-		       (lxor (bits c (1- n) 0) y2 n)
-		       n))))
-
-(defthm land-bnd
-    (implies (case-split (<= 0 x))
-	     (<= (land x y n) x))
-  :rule-classes (:rewrite :linear))
-
-(defthm lior-bnd
-  (implies (case-split (bvecp x n))
-	   (<= x (lior x y n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm lxor-bnd
-  (<= (lxor x y n) (lior x y n))
-  :rule-classes (:rewrite :linear))
-
-(defthmd lior-plus
-  (implies (= (land x y n) 0)
-           (equal (lior x y n)
-                  (+ (bits x (1- n) 0)
-                     (bits y (1- n) 0)))))
-
-(defthmd land-with-shifted-arg
-  (implies (and (integerp x)
-		(rationalp y)
-		(integerp m)
-		(integerp n)
-		(<= 0 m))
-	   (equal (land (* (expt 2 m) x) y n)
-		  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m)))))))
-
-(defthm lior-with-shifted-arg
-  (implies (and (bvecp y m)
-                (bvecp x (- n m))
-                (<= m n)
-                (natp m)
-                (integerp n))
-           (= (lior (* (expt 2 m) x) y n)
-              (+ (* (expt 2 m) x) y)))
-  :rule-classes ())
-
-(defthmd land-expt
-  (implies (and (natp n)
-		(natp k)
-		(< k n))
-	   (equal (land x (expt 2 k) n)
-		  (* (expt 2 k) (bitn x k)))))
-
-(defthm lior-expt
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n))
-	     (= (lior x (expt 2 k) n)
-		(+ (bits x (1- n) 0)
-		   (* (expt 2 k) (- 1 (bitn x k))))))
-  :rule-classes ())
-
-(defthmd lxor-expt
-  (implies (and (natp n)
-		(natp k)
-		(< k n))
-	   (equal (lxor x (expt 2 k) n)
-		  (+ (bits x (1- n) 0)
-                     (* (expt 2 k) (- 1 (* 2 (bitn x k))))))))
-
-(defthm land-ones
-  (equal (land (1- (expt 2 n)) x n)
-	 (bits x (1- n) 0))
-  :rule-classes nil)
-
-(defthm land-ones-rewrite
-  (implies (and (syntaxp (and (quotep k) (quotep n)))
-		(equal k (1- (expt 2 n))))
-	   (equal (land k x n)
-		  (bits x (1- n) 0))))
-
-(defthm lior-ones
-  (implies (and (case-split (bvecp x n))
-		(case-split (natp n)))
-	   (equal (lior (1- (expt 2 n)) x n)
-		  (1- (expt 2 n))))
-  :rule-classes ())
-
-(defthm lior-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-			      (quotep n)
-			      (equal (cadr k) (1- (expt 2 (cadr n))))))
-		(force (equal k (1- (expt 2 n))))
-		(case-split (natp n))
-		(case-split (bvecp x n)))
-	   (equal (lior k x n)
-		  (1- (expt 2 n)))))
-
-(defthm lxor-ones
-  (implies (case-split (bvecp x n))
-	   (equal (lxor (1- (expt 2 n)) x n)
-		  (lnot x n)))
-  :rule-classes ())
-
-(defthm lxor-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-			      (quotep n)
-			      (equal (cadr k) (1- (expt 2 (cadr n))))))
-		(force (equal k (1- (expt 2 n))))
-		(case-split (bvecp x n)))
-	   (equal (lxor k x n)
-		  (lnot x n))))
-
-(defthm land-slice
-  (implies (and (<= j i)
-		(<= i n)
-		(integerp n)
-		(integerp i)
-		(integerp j)
-		(<= 0 j))
-	   (equal (land x (- (expt 2 i) (expt 2 j)) n)
-		  (* (expt 2 j) (bits x (1- i) j))))
-  :rule-classes ())
-
-(defthmd lior-slice
-  (implies (and (<= j i)
-		(<= i n)
-		(integerp n)
-		(integerp i)
-		(integerp j)
-		(<= 0 j))
-	   (equal (lior x
-                        (- (expt 2 i) (expt 2 j))
-                        n)
-		  (cat (bits x (1- n) i)     (- n i)
-                       (1- (expt 2 (- i j))) (- i j)
-                       (bits x (1- j) 0)     j))))
-
-(defthmd lxor-slice
-  (implies (and (<= j i)
-		(<= i n)
-		(integerp n)
-		(integerp i)
-		(integerp j)
-		(<= 0 j))
-	   (equal (lxor x
-                        (- (expt 2 i) (expt 2 j))
-                        n)
-		  (cat (bits x (1- n) i) (- n i)
-                       (lnot (bits x (1- i) j) (- i j)) (- i j)
-                       (bits x (1- j) 0) j))))
-
-(defthmd land-slices
-  (implies (and (natp n)
-                (natp l)
-                (natp k)
-                (<= l k)
-                (< k n))
-           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
-                        (- (expt 2 n) (expt 2 k))
-                        n)
-                  (if (= l k)
-                      (- (expt 2 n) (expt 2 (1+ k)))
-                    (- (expt 2 n) (expt 2 k))))))
-
-
-;;;**********************************************************************
-;;;                Algebraic Properties
-;;;**********************************************************************
-
-(defthm lnot-lnot
-  (implies (and (case-split (natp n))
-		(case-split (bvecp x n)))
-	   (equal (lnot (lnot x n) n)
-		  x)))
-
-(defthm land-commutative
-  (equal (land y x n)
-	 (land x y n)))
-
-(defthm lior-commutative
-  (equal (lior y x n)
-	 (lior x y n)))
-
-(defthm lxor-commutative
-  (equal (lxor y x n)
-	 (lxor x y n)))
-
-(defthm land-associative
-  (equal (land (land x y n) z n)
-	 (land x (land y z n) n)))
-
-(defthm lior-associative
-  (equal (lior (lior x y n) z n)
-	 (lior x (lior y z n) n)))
-
-(defthm lxor-associative
-  (equal (lxor (lxor x y n) z n)
-	 (lxor x (lxor y z n) n)))
-
-(defthm land-commutative-2
-  (equal (land y (land x z n) n)
-	 (land x (land y z n) n)))
-
-(defthm lior-commutative-2
-  (equal (lior y (lior x z n) n)
-	 (lior x (lior y z n) n)))
-
-(defthm lxor-commutative-2
-  (equal (lxor y (lxor x z n) n)
-	 (lxor x (lxor y z n) n)))
-
-(defthm land-combine-constants
-  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
-	   (equal (land x (land y z n) n)
-		  (land (land x y n) z n))))
-
-(defthm lior-combine-constants
-  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
-	   (equal (lior x (lior y z n) n)
-		  (lior (lior x y n) z n))))
-
-(defthm lxor-combine-constants
-  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
-	   (equal (lxor x (lxor y z n) n)
-		  (lxor (lxor x y n) z n))))
-
-(defthm land-self
-  (equal (land x x n)
-	 (bits x (1- n) 0)))
-
-(defthm lior-self
-  (implies (and (case-split (bvecp x n))
-		(case-split (integerp n)))
-	   (equal (lior x x n) x)))
-
-(defthm lxor-self
-  (implies (case-split (bvecp x n))
-	   (equal (lxor x x n) 0)))
-
-(defthmd lior-land-1
-  (equal (lior x (land y z n) n)
-	 (land (lior x y n) (lior x z n) n)))
-
-(defthmd lior-land-2
-  (equal (lior (land y z n) x n)
-	 (land (lior x y n) (lior x z n) n)))
-
-(defthmd land-lior-1
-  (equal (land x (lior y z n) n)
-	 (lior (land x y n) (land x z n) n)))
-
-(defthmd land-lior-2
-  (equal (land (lior y z n) x n)
-	 (lior (land x y n) (land x z n) n)))
-
-(defthmd lior-land-lxor
-  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
-	 (lior (land x y n) (land (lxor x y n) z n) n)))
-
-(defthmd lxor-rewrite
-  (equal (lxor x y n)
-	 (lior (land x (lnot y n) n)
-	       (land y (lnot x n) n)
-	       n)))
-
-(defthmd lnot-lxor
-  (equal (lnot (lxor x y n) n)
-	 (lxor (lnot x n) y n)))
diff -Nru acl2-6.2/books/rtl/rel5/lib/openers.lisp acl2-6.3/books/rtl/rel5/lib/openers.lisp
--- acl2-6.2/books/rtl/rel5/lib/openers.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/openers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,50 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/openers"))
-
-(program)
-
-; In this file, an event-control (evctl) data structure is either (posedge
-; clk), (negedge clk), or (even n).
-
-(defun negate-event-control (evctl)
-  (if (equal evctl '(even n))
-      (list 'not evctl)
-    (let* ((edge0 (car evctl))
-           (clk (cadr evctl))
-           (edge (case edge0
-                   (posedge 'pedge)
-                   (negedge 'nedge)
-                   (otherwise
-                    (er hard 'gen-model-preamble-common
-                        "Unable to handle edge specifier ~x0."
-                        edge0)))))
-      `(not (,edge (,clk (1- n)) (,clk n))))))
-
-(defun negate-event-control-list (x)
-  (declare (xargs :guard (true-listp x)))
-  (if (endp x)
-      nil
-    (cons (negate-event-control (car x))
-          (negate-event-control-list (cdr x)))))
-
-(defmacro def$open (name type &rest evctl-lst)
-  (if (eq type :skipped)
-      `(value-triple '(def$open ,name :skipped))
-    (let ((evctl-lst (if (eq type :input)
-                         (assert$ (null evctl-lst)
-                                  '((even n)))
-                       evctl-lst)))
-      `(defthm ,(intern-in-package-of-symbol
-                 (concatenate 'string (symbol-name name) "$OPEN")
-                 name)
-         (implies (and (integerp n)
-                       (< 0 n)
-                       ,@(negate-event-control-list evctl-lst))
-                  (equal (,name n)
-                         (,name (1- n))))
-         :hints (("Goal"
-                  :expand ((,name n)
-                           ,@(and (eq type :wire) `((,name (1- n)))))))))))
diff -Nru acl2-6.2/books/rtl/rel5/lib/package-defs.lisp acl2-6.3/books/rtl/rel5/lib/package-defs.lisp
--- acl2-6.2/books/rtl/rel5/lib/package-defs.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/package-defs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,57 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/package-defs"))
-
-;;Miscellaneous symbols that are not in *acl2-exports*:
-
-(defmacro other-acl2-symbols ()
-  ''(local-defun local-defthm local-in-theory
-                 n ; clock argument
-                 defbvecp ; macro written out by compiler
-                 defclock ; macro written out by compiler
-                 defperiodic
-                 fast-clock  ;BOZO, is importing these into the packages, the right way to handle this?
-                 slow-clock-one-quantum-wide
-                 slow-clock-one-quantum-wide-shifted
-                 slow-clock-two-quanta-wide
-                 slow-clock-two-quanta-wide-shifted
-                 always-1
-                 posedge negedge edge ; for defclock macro, which we used to use
-                 pedge nedge ;for defperiodic macro
-                 $path ; path argument of signal functions
-                 sub1-induction ; for bvecp lemma hints
-                 ))
-
-;;Symbols that occur in the RTL translation.  Formerly the symbol UNKNOWN was excluded from this
-;;list so that the corresponding symbol in the "*" package could be assigned a different function
-;;definition; but the first argument of unknown can be in any package desired.
-
-(defmacro rtl-symbols ()
-  ''(log= log<> log< log<= log> log>= lnot logand1 logior1 logxor1 shft lshft
-          rshft cat mulcat bitn bits setbits setbitn mod+ mod* mod- bind
-          case-select if1 cond1 reset reset2 land lior lxor lcat n! arr0 natp1
-          as ag mk-bvarr mk-bvec ag2 as2
-          abs trunc near minf inf sticky sig expo bitvec ; appeared May 2004 (from rpl_main.cc)
-          expt ; appeared May 2004 (seems to come from r2s)
-          prop gen
-          unknown unknown2))
-
-;;Functions that are defined in the FP library:
-
-(defmacro fp-symbols ()
-  ''(natp fl cg fl-half bvecp bv-arrp sumbits sigm kap tau lamt lamg lamz lam1 lam2 lam3 lam4 lam0 lamb
-          expo sgn sig 
-          exactp fp+ bias esgnf eexpof esigf erepp eencodingp eencode edecode ndecode rebias-expo isgnf iexpof isigf 
-          nrepp drepp irepp nencodingp dencodingp iencodingp nencode dencode iencode ddecode idecode trunc away re 
-          near near-witness near+ sticky oddr kp inf minf ieee-mode-p rnd flip rnd-const drnd))
-
-;;ACL2 symbols that are imported by all packages:
-
-(defmacro shared-symbols ()
-  '(union-eq *acl2-exports*
-    (union-eq *common-lisp-symbols-from-main-lisp-package*
-     (union-eq (other-acl2-symbols)
-      (union-eq (fp-symbols)
-       (rtl-symbols))))))
diff -Nru acl2-6.2/books/rtl/rel5/lib/reps.lisp acl2-6.3/books/rtl/rel5/lib/reps.lisp
--- acl2-6.2/books/rtl/rel5/lib/reps.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/reps.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,516 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/ereps"))
-(local (include-book "../support/ireps"))
-(local (include-book "../support/guards"))
-
-(include-book "log")
-(include-book "float")
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-;;;***************************************************************
-;;;          REPRESENTATIONS WITH EXPLICIT MSB
-;;;***************************************************************
-
-(defund bias (q) (- (expt 2 (- q 1)) 1) )
-
-;BOZO add rewrite rule?
-(defthm bias-non-negative-integerp-type-prescription
-  (implies (and (case-split (integerp q))
-                (case-split (< 0 q)))
-           (and (integerp (bias q))
-                (>= (bias q) 0)))
-  :rule-classes :type-prescription)
-
-;BOZO disable?
-(defun esgnf  (x p q) (bitn x (+ p q)))
-(defun eexpof (x p q) (bits x (1- (+ p q)) p)) 
-(defun esigf  (x p)   (bits x (1- p) 0))
-
-(defund erepp (x p q)
-  (and (rationalp x)
-       (not (= x 0))
-       (bvecp (+ (expo x) (bias q)) q)
-       (exactp x p)))
-
-(defund eencodingp (x p q)
-  (and (bvecp x (+ p q 1))
-       (= (bitn x (- p 1)) 1)))
-
-
-(defund eencode (x p q)
-  (cat (cat (if (= (sgn x) 1) 0 1)
-	    1
-	    (+ (expo x) (bias q))
-	    q)
-       (1+ q)
-       (* (sig x) (expt 2 (- p 1)))
-       p) )
-
-(defund edecode (x p q)
-  (* (if (= (esgnf x p q) 0) 1 -1)
-     (esigf x p)
-     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
-
-(defthm eencodingp-not-zero
-    (implies (and (eencodingp x p q)
-		  (integerp p)
-		  (> p 0)
-		  (integerp q)
-		  (> q 0))
-	     (not (equal (edecode x p q) 0))))
-
-(defthm erepp-edecode
-    (implies (and (eencodingp x p q)
-		  (integerp p)
-		  (> p 0)
-		  (integerp q)
-		  (> q 0))
-	     (erepp (edecode x p q) p q)))
-
-
-(defthm eencodingp-eencode
-    (implies (and (erepp x p q)
-		  (integerp p)
-		  (> p 0)
-		  (integerp q)
-		  (> q 0))
-	     (eencodingp (eencode x p q) p q) ))
-
-(defthm edecode-eencode
-    (implies (and (erepp x p q)
-		  (integerp p)
-;		  (> p 0)
-		  (integerp q)
-	;	  (> q 0)
-                  )
-	     (equal (edecode (eencode x p q) p q)
-		    x)))
-
-(defthm eencode-edecode
-    (implies (and (eencodingp x p q)
-		  (integerp p)
-		  (>= p 0)
-		  (integerp q)
-		  (> q 0))
-	     (equal (eencode (edecode x p q) p q)
-		    x)))
-
-(defthm expo-edecode
-    (implies (and (eencodingp x p q)
-		  (integerp p)
-		  (> p 0)
-		  (integerp q)
-		  (> q 0))  
-	     (equal (expo (edecode x p q))
-		    (- (eexpof x p q) (bias q)))))
-
-(defthm sgn-edecode
-    (implies (and (eencodingp x p q)
-		  (integerp p)
-		  (> p 0)
-		  (integerp q)
-		  (> q 0))
-	     (equal (sgn (edecode  x p q))
-		    (if (= (esgnf x p q) 0) 1 -1))))
-
-(defthm sig-edecode
-    (implies (and (eencodingp  x p q)
-		  (integerp p)
-		  (> p 0)
-		  (integerp q)
-		  (> q 0))
-	     (equal (sig (edecode  x p q))
-		    (/ (esigf x p) (expt 2 (- p 1))))))
-
-;BOZO disable?
-(defun rebias-expo (expo old new)
-  (+ expo (- (bias new) (bias old))))
-
-(defthm natp-rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x m))
-	     (natp (rebias-expo x m n))))
-
-(defthm natp-rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (natp (rebias-expo x n m))))
-
-(defthm bvecp-rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x m))
-	     (bvecp (rebias-expo x m n) n)))
-
-(defthm bvecp-rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (bvecp (rebias-expo x n m) m)))
-
-(defthm rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (equal (rebias-expo x n m)
-		    (cat (bitn x (1- n))
-			 1
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ())
-
-(defthm rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x m))
-	     (equal (rebias-expo x m n)
-		    (cat (cat (bitn x (1- m))
-			      1
-			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
-			      (- n m))
-			 (1+ (- n m))
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ())
-
-
-;;;***************************************************************
-;;;          REPRESENTATIONS WITH IMPLICIT MSB
-;;;***************************************************************
-
-;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
-;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
-;;where p > 1.
-
-;;Field extractors:
-
-(defun isgnf (x p q) (bitn x (1- (+ p q))))
-(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
-(defun isigf (x p) (bits x (- p 2) 0))
-
-
-;Representable numbers (normals and denormal):
-
-(defund nrepp (x p q)
-  (and (rationalp x)
-       (not (= x 0))
-       (< 0 (+ (expo x) (bias q)))
-       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
-       (exactp x p)))
-
-(defund drepp (x p q)
-  (and (rationalp x)
-       (not (= x 0))
-       (<= (- 2 p) (+ (expo x) (bias q)))
-       (<= (+ (expo x) (bias q)) 0)
-       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
-       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
-
-(defund irepp (x p q)
-  (or (nrepp x p q)
-      (drepp x p q)))
-
-
-;;Valid encodings:
-
-(defund nencodingp (x p q)
-  (and (bvecp x (+ p q))
-       (< 0 (iexpof x p q))
-       (< (iexpof x p q) (- (expt 2 q) 1))))
-
-(defund dencodingp (x p q)
-  (and (bvecp x (+ p q))
-       (= (iexpof x p q) 0)
-       (not (= (isigf x p) 0))))
-
-(defund iencodingp (x p q)
-  (or (nencodingp x p q)
-      (dencodingp x p q)))
-
-(defthm not-both-nrepp-and-drepp
-    (implies (irepp x p q)
-	     (iff (nrepp x p q) (not (drepp x p q))))
-  :rule-classes ())
-
-(defthm not-both-nencodingp-and-dencodingp
-    (implies (iencodingp x p q)
-	     (iff (nencodingp x p q) (not (dencodingp x p q))))
-  :rule-classes ())
-
-
-;;Encoding functions:
-
-(defund nencode (x p q)
-  (cat (cat (if (= (sgn x) 1) 0 1)
-	    1
-            (+ (expo x) (bias q))
-            q)
-       (1+ q)
-       (* (- (sig x) 1) (expt 2 (- p 1)))
-       (- p 1)))
-
-(defund dencode (x p q)
-  (cat (cat (if (= (sgn x) 1) 0 1)
-	    1
-            0
-            q)
-       (1+ q)
-       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
-       (- p 1)))
-
-(defund iencode (x p q)
-  (cond ((nrepp x p q)
-	 (nencode x p q))
-	((drepp x p q)
-	 (dencode x p q))))
-
-
-;;Decoding functions:
-
-(defund ndecode (x p q)
-  (* (if (= (isgnf x p q) 0) 1 -1)
-     (+ (expt 2 (- (iexpof x p q) (bias q)))
-        (* (isigf x p)
-           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
-
-(defund ddecode (x p q)
-  (* (if (= (isgnf x p q) 0) 1 -1)
-     (isigf x p)
-     (expt 2 (+ 2 (- (bias q)) (- p)))))
-
-(defund idecode (x p q)
-  (cond ((nencodingp x p q)
-	 (ndecode x p q))
-	((dencodingp x p q)
-	 (ddecode x p q))))
-
-
-;;Field extraction:
-
-(defthm sgn-ndecode
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (sgn (ndecode x p q))
-		    (if (= (isgnf x p q) 0) 1 -1))))
-
-(defthm expo-ndecode
-    (implies (and (nencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))  
-	     (equal (expo (ndecode x p q))
-		    (- (iexpof x p q) (bias q)))))
-
-(defthm sig-ndecode
-    (implies (and (nencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (sig (ndecode x p q))
-		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
-
-(defthm sgn-ddecode
-    (implies (and (dencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (sgn (ddecode x p q))
-		    (if (= (isgnf x p q) 0) 1 -1))))
-
-(defthm expo-ddecode
-    (implies (and (dencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (expo (ddecode x p q))
-		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
-
-(defthm sig-ddecode
-    (implies (and (dencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (sig (ddecode x p q))
-		    (sig (isigf x p)))))
-
-(defthm sgn-idecode
-    (implies (and (iencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal
-	      (sgn (idecode x p q))
-	      (if (= (isgnf x p q) 0) 1 -1))))
-
-(defthm expo-idecode
-    (implies (and (iencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal
-	      (expo (idecode x p q))
-	      (cond ((nencodingp x p q)
-		     (- (iexpof x p q) (bias q)))         
-		    ((dencodingp x p q)
-		     (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))))
-
-(defthm sig-idecode
-    (implies (and (iencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (sig (idecode x p q))
-		    (cond ((nencodingp x p q)
-			   (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
-			  ((dencodingp x p q)
-			   (sig (isigf x p)))))))
-
-
-;;Inversions:
-
-(defthm dencodingp-dencode
-    (implies (and (drepp x p q)
-		  (integerp p)
-		  (integerp q)
-		  (> q 0))
-	     (dencodingp (dencode x p q) p q)))
-
-(defthm iencodingp-iencode
-    (implies (and (irepp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (iencodingp (iencode x p q) p q)))
-
-(defthm nrepp-ndecode
-    (implies (and (nencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (nrepp (ndecode x p q) p q)))
-
-(defthm drepp-ddecode
-    (implies (and (dencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (drepp (ddecode x p q) p q)))
-
-(defthm irepp-idecode
-    (implies (and (iencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (irepp (idecode x p q) p q)))
-
-(defthm nencodingp-nencode
-    (implies (and (nrepp x p q)
-                  (integerp p)
-                  (> p 1)
-                  (integerp q)
-                  (> q 0))
-             (nencodingp (nencode x p q) p q)))
-
-(defthm ndecode-nencode
-    (implies (and (nrepp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (ndecode (nencode x p q) p q)
-		    x)))
-
-(defthm ddecode-dencode
-    (implies (and (drepp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (ddecode (dencode x p q) p q)
-		    x)))
-
-(defthm idecode-iencode
-    (implies (and (irepp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (idecode (iencode x p q) p q)
-		    x)))
-
-(defthm nencode-ndecode
-    (implies (and (nencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (nencode (ndecode x p q) p q)
-		    x)))
-
-(defthm dencode-ddecode
-    (implies (and (dencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (dencode (ddecode x p q) p q)
-		    x)))
-
-(defthm iencode-idecode
-    (implies (and (iencodingp x p q)
-		  (integerp p)
-		  (> p 1)
-		  (integerp q)
-		  (> q 0))
-	     (equal (iencode (idecode x p q) p q)
-		    x)))
-
-
-
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/lib/rom-helpers.lisp acl2-6.3/books/rtl/rel5/lib/rom-helpers.lisp
--- acl2-6.2/books/rtl/rel5/lib/rom-helpers.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/rom-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/rom-helpers"))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-(local (in-theory (enable bvecp)))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defun check-array (name a dim1 dim2)
-  (if (zp dim1)
-      t
-    (and (bvecp (aref1 name a (1- dim1)) dim2)
-	 (check-array name a (1- dim1) dim2))))
-
-(defthm check-array-lemma-1
-    (implies (and (not (zp dim1))
-		  (check-array name a dim1 dim2)
-		  (natp i)
-		  (< i dim1))
-	     (bvecp (aref1 name a i) dim2))
-  :rule-classes ())
-
-(defthm check-array-lemma
-    (implies (and (bvecp i n)
-		  (not (zp (expt 2 n)))
-		  (check-array name a (expt 2 n) dim2))		  
-	     (bvecp (aref1 name a i) dim2))
-  :rule-classes ())
-
-
diff -Nru acl2-6.2/books/rtl/rel5/lib/round.lisp acl2-6.3/books/rtl/rel5/lib/round.lisp
--- acl2-6.2/books/rtl/rel5/lib/round.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/round.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1861 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/top"))
-
-(include-book "reps")
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-;;;**********************************************************************
-;;;                            TRUNC
-;;;**********************************************************************
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defthmd trunc-rewrite
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (equal (trunc x n)
-		    (* (sgn x) 
-		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
-		       (expt 2 (- (1+ (expo x)) n))))))
-
-;replaces trunc-pos
-;BOZO now a rewrite rule too; okay?
-(defthm trunc-positive
-   (implies (and (< 0 x)
-                 (case-split (rationalp x))
-                 (case-split (integerp n))
-                 (case-split (< 0 n))
-                 )
-            (< 0 (trunc x n)))
-   :rule-classes (:rewrite :linear))
-
-;replaces trunc-neg
-;BOZO now a rewrite rule too; okay?
-(defthm trunc-negative
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n)))
-           (< (trunc x n) 0))
-  :rule-classes (:rewrite :linear))
-
-(defthm trunc-0
-  (equal (trunc 0 n) 0))
-
-(defthmd sgn-trunc
-    (implies (and (< 0 n)
-                  (rationalp x)
-		  (integerp n)
-		  )
-	     (equal (sgn (trunc x n))
-		    (sgn x))))
-
-(defthmd trunc-minus
-  (equal (trunc (* -1 x) n)
-         (* -1 (trunc x n))))
-
-(defthmd abs-trunc
-  (equal (abs (trunc x n))
-         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
-
-(defthm trunc-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (trunc x n))
-		  (exactp x n)))
-  :rule-classes ())
-
-(defthm trunc-exactp-b
-  (exactp (trunc x n) n))
-
-(defthmd trunc-exactp-c
-    (implies (and (exactp a n)
-		  (<= a x)
-                  (rationalp x)
-		  (integerp n)
-		  (rationalp a)
-		  )
-	     (<= a (trunc x n))))
-
-;we called int-trunc
-(defthmd trunc-integer-type-prescription
-  (implies (and (>= (expo x) n)
-                (case-split (integerp n))
-                )
-           (integerp (trunc x n)))
-  :rule-classes :type-prescription)
-
-(defthmd trunc-upper-bound
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (<= (abs (trunc x n)) (abs x)))
-  :rule-classes :linear)
-
-(defthmd trunc-upper-pos
-    (implies (and (<= 0 x)
-                  (rationalp x)
-		  (integerp n))
-	     (<= (trunc x n) x))
-  :rule-classes :linear)
-
-(defthmd trunc-lower-1
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes :linear)
-
-(defthmd trunc-lower-pos
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthmd trunc-lower-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthmd trunc-lower-4
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (trunc x n) (- x (* (abs x) (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-diff
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes ())
-
-(defthm trunc-diff-pos
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes ())
-
-(defthm trunc-diff-expo
-    (implies (and (rationalp x)
-		  (not (exactp x n))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
-  :rule-classes ())
-
-(defthmd trunc-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                )
-           (<= (trunc x n) (trunc y n)))
-  :rule-classes :linear)
-
-(defthmd trunc-shift
-  (implies (integerp n)
-           (equal (trunc (* x (expt 2 k)) n)
-                  (* (trunc x n) (expt 2 k)))))
-
-(defthm expo-trunc
-    (implies (and (< 0 n)
-                  (rationalp x)
-		  (integerp n)
-		  )
-	     (equal (expo (trunc x n))
-                    (expo x))))
-
-(defthmd trunc-trunc
-    (implies (and (>= n m)
-                  (integerp n)
-		  (integerp m)
-		  )
-	     (equal (trunc (trunc x n) m)
-		    (trunc x m))))
-
-(defthm plus-trunc
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (rationalp y)
-		  (>= y 0)
-		  (integerp k)
-		  (exactp x (+ k (- (expo x) (expo y)))))
-	     (= (+ x (trunc y k))
-		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ())
-
-(defthm plus-trunc-alt
-  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp j))
-           (= (trunc (+ x y) j)
-              (+ x
-                 (trunc y (+ j (- (expo (+ x y))) (expo y))))))
-  :rule-classes ())
-
-(defthmd plus-trunc-corollary
-  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
-                (exactp x n)
-                (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp n))
-           (= (trunc (+ x y) n) x)))
-
-(defthm trunc-plus
-    (implies (and (rationalp y)
-		  (> y 0)
-		  (integerp e)
-		  (< y (expt 2 e))
-		  (integerp m)
-		  (> m 0)
-		  (integerp k)
-		  (> k 0)
-		  (<= m (1+ k)))
-	     (= (trunc (+ (expt 2 e) (trunc y k)) m)
-		(trunc (+ (expt 2 e) y) m)))
-  :rule-classes ())
-
-(defthm trunc-n+k
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  ;;this isn't really needed, but it won't hurt me.
-		  (not (exactp x n))          
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n)))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
-		   (expt 2 e))))
-  :rule-classes ())
-
-(defthm bits-trunc
-    (implies (and (>= x (expt 2 (1- n)))
-		  (< x (expt 2 n))
-                  (integerp x) (> x 0)
-		  (integerp m) (>= m n)
-		  (integerp n) (> n k)
-		  (integerp k) (> k 0)
-		  )
-	     (= (trunc x k)
-		(land x (- (expt 2 m) (expt 2 (- n k))) n)))
-  :rule-classes ())
-
-(defthm bits-trunc-2
-  (implies (and (= n (1+ (expo x)))
-                (>= x 0)
-                (integerp k)
-                (> k 0)
-                )
-           (= (trunc x k)
-              (* (expt 2 (- n k))
-                 (bits x (1- n) (- n k)))))
-  :rule-classes ())
-
-(defthm trunc-away-a
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (- x (expt 2 (- (expo x) n)))
-		(trunc x n)))
-  :rule-classes ())
-
-(defthmd trunc-split
-  (implies (and (= n (1+ (expo x)))
-                (>= x 0)
-                (integerp m)
-                (> m k)
-                (integerp k)
-                (> k 0))
-           (equal (trunc x m)
-                  (+ (trunc x k)
-                     (* (expt 2 (- n m))
-                        (bits x (1- (- n k)) (- n m)))))))
-
-;;;**********************************************************************
-;;;                            AWAY
-;;;**********************************************************************
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defthmd away-rewrite
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (equal (away x n)
-		    (* (sgn x) 
-		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
-		       (expt 2 (- (1+ (expo x)) n))))))
-
-;replaces away-pos
-;BOZO wasn't a rewrite rule..
-(defthm away-positive
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                )
-           (< 0 (away x n)))
-  :rule-classes (:rewrite :linear))
-
-;replaces away-neg
-;BOZO wasn't a rewrite rule..
-(defthm away-negative
-    (implies (and (< x 0)
-                  (case-split (rationalp x))
-                  )
-	     (< (away x n) 0))
-    :rule-classes (:rewrite :linear))
-
-(defthm away-0
-  (equal (away 0 n) 0))
-
-(defthmd sgn-away
-  (equal (sgn (away x n))
-         (sgn x)))
-
-(defthmd away-minus
-  (= (away (* -1 x) n) (* -1 (away x n))))
-
-(defthmd abs-away
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (equal (abs (away x n)) 
-		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm away-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (away x n))
-		  (exactp x n)))
-  :rule-classes ())
-
-(defthm away-exactp-b
-    (implies (case-split (< 0 n))
-	     (exactp (away x n) n)))
-
-(defthmd away-exactp-c
-    (implies (and (exactp a n)
-		  (>= a x)
-                  (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  )
-	     (>= a (away x n))))
-
-(defthmd away-lower-bound
-    (implies (and (case-split (rationalp x))
-		  (case-split (integerp n)))
-	     (>= (abs (away x n)) (abs x)))
-  :rule-classes :linear)
-
-(defthmd away-lower-pos
-    (implies (and (>= x 0)
-                  (case-split (rationalp x))
-		  (case-split (integerp n)))
-	     (>= (away x n) x))
-  :rule-classes :linear)
-
-(defthmd expo-away-lower-bound
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (expo (away x n)) (expo x)))
-  :rule-classes :linear)
-
-(defthmd away-upper-1
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes :linear)
-
-(defthmd away-upper-2
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthmd away-upper-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthmd away-diff
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes :linear)
-
-(defthmd away-diff-pos
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes :linear)
-
-(defthmd away-diff-expo
-    (implies (and (rationalp x)
-		  (not (exactp x n))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- (away x n) x)) (- (expo x) n)))
-  :rule-classes :linear)
-
-(defthm away-exactp-d
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthm expo-away
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0)
-		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
-	     (equal (expo (away x n))
-                   (expo x)))
-  :rule-classes ())
-
-(defthmd away-monotone
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (<= x y))
-	     (<= (away x n) (away y n)))
-  :rule-classes :linear)
-
-(defthmd away-shift
-    (implies (integerp n)
-	     (= (away (* x (expt 2 k)) n)
-		(* (away x n) (expt 2 k)))))
-
-(defthmd away-away
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (equal (away (away x n) m)
-		    (away x m))))
-
-(defthm away-imp
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m))
-	     (= (away x n)
-		(trunc (+ x
-			  (expt 2 (- (1+ (expo x)) n))
-			  (- (expt 2 (- (1+ (expo x)) m))))
-		       n)))
-  :rule-classes ())
-
-(defthm plus-away
-  (implies (and (exactp x (+ k (- (expo x) (expo y))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k))
-           (= (+ x (away y k))
-              (away (+ x y)
-                    (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ())
-
-(defthm plus-away-alt
-  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp j))
-           (= (away (+ x y) j)
-              (+ x
-                 (away y (+ j (- (expo (+ x y))) (expo y))))))
-  :rule-classes ())
-
-(defthmd plus-away-corollary
-  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
-                (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (> y 0)
-                (integerp n)
-                (exactp x n))
-           (= (away (+ x y) n)
-              (fp+ x n))))
-
-(defthm trunc-away-b
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (away x n)
-		(+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ())
-
-(defthm trunc-away
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n)))
-	     (= (away x n)
-		(+ (trunc x n)
-		   (expt 2 (+ (expo x) 1 (- n))))))		
-  :rule-classes ())
-
-;bad name?
-(defthm minus-trunc-4
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< y x)
-		  (integerp k)
-		  (> k 0)
-		  (> (+ k (- (expo (- x y)) (expo y))) 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
-  :rule-classes ())
-
-;BOZO move to away section?
-(defthm minus-trunc-5
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< x y)
-		  (integerp k)
-		  (> k 0)
-		  (> (+ k (- (expo (- x y)) (expo y))) 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
-  :rule-classes ())
-
-
-;;;**********************************************************************
-;;;                            NEAR
-;;;**********************************************************************
-
-(defun re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-(defthm near1-a
-    (implies (and (< (- x (trunc x n)) (- (away x n) x))
-                  (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  )
-	     (equal (near x n)
-                    (trunc x n)))
-  :rule-classes ())
-
-(defthm near1-b
-  (implies (and (> (- x (trunc x n)) (- (away x n) x))
-                (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0)
-                )
-           (equal (near x n)
-                  (away x n)))
-  :rule-classes ())
-
-(defthm near-choice
-    (or (= (near x n) (trunc x n))
-	(= (near x n) (away x n)))
-  :rule-classes ())
-
-(defthm near-pos
-    (implies (and (< 0 x)
-                  (< 0 n)
-                  (rationalp x)
-		  (integerp n))
-	     (< 0 (near x n)))
-  :rule-classes (:TYPE-PRESCRIPTION :LINEAR))
-
-(defthmd near-neg
-  (implies (and (< x 0)
-                (< 0 n)
-                (rationalp x)
-                (integerp n)
-		)
-           (< (near x n) 0))
-  :rule-classes (:TYPE-PRESCRIPTION :LINEAR))
-
-(defthm near-0
-  (equal (near 0 n) 
-         0))
-
-(defthmd sgn-near-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (equal (sgn (near x n))
-		    (sgn x))))
-
-(defthmd near-minus
-  (equal (near (* -1 x) n)
-         (* -1 (near x n))))
-
-(defthm near-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (near x n))
-		  (exactp x n)))
-  :rule-classes ())
-
-(defthm near-exactp-b
-    (implies (< 0 n)
-	     (exactp (near x n) n)))
-
-(defthmd near-exactp-c
-    (implies (and (exactp a n)
-		  (>= a x)
-                  (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  )
-	     (>= a (near x n))))
-
-(defthmd near-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (near x n))))
-
-(defthm near<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (near x n) (away x n)))
-  :rule-classes ())
-
-(defthm near>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (near x n) (trunc x n)))
-  :rule-classes ())
-
-;was called monotone-near
-(defthm near-monotone
-    (implies (and (<= x y)
-                  (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (integerp n)
-		  (> n 0))
-	     (<= (near x n) (near y n))))
-
-(defthmd near-shift
-    (implies (and (rationalp x)
-                  (integerp n)
-		  (integerp k))
-	     (= (near (* x (expt 2 k)) n)
-		(* (near x n) (expt 2 k)))))
-
-(defthm near2
-    (implies (and (exactp y n)
-                  (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  )
-	     (>= (abs (- x y)) (abs (- x (near x n)))))
-  :rule-classes ())
-
-(defund near-witness (x y n)
-  (if (= (expo x) (expo y))
-      (/ (+ (near x n) (near y n)) 2)
-    (expt 2 (expo y))))
-
-(defthm near-near-lemma
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (near x n) (near y n))))
-	     (and (<= x (near-witness x y n))
-		  (<= (near-witness x y n) y)
-		  (exactp (near-witness x y n) (1+ n))))
-  :rule-classes ())
-
-(defthm near-near
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp a)
-		  (integerp n)
-		  (integerp k)
-		  (> k 0)
-		  (>= n k)		  
-		  (< 0 a)
-		  (< a x)
-		  (< 0 y)
-		  (< y (fp+ a (1+ n)))
-		  (exactp a (1+ n)))
-	     (<= (near y k) (near x k)))
-  :rule-classes ())
-
-(defthm near-est
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0))
-	     (<= (abs (- x (near x n)))
-		 (expt 2 (- (expo x) n))))
-  :rule-classes ())
-
-(defthm near-a-a
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (> x (+ a (expt 2 (- (expo a) n)))))
-	     (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
-  :rule-classes ())
-
-(defthm near-a-b
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x (+ a (expt 2 (- (expo a) n)))))
-	     (<= (near x n) a))
-  :rule-classes ())
-
-(defthm near-a-c
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (>= (near x n) a))
-  :rule-classes ())
-
-(defthm near-exact
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (exactp (near x n) (1- n)))
-  :rule-classes ())
-
-(defthm near-power-a
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (near x n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthm near-power-b
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthm near-trunc
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (= (near x n)
-		(if (and (exactp x (1+ n)) (not (exactp x n)))
-		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
-		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
-  :rule-classes ())
-
-
-;;;**********************************************************************
-;;;                            NEAR+
-;;;**********************************************************************
-
-(defund near+ (x n)
-  (if (< (re (* (expt 2 (1- n)) (sig x)))
-	 1/2)
-      (trunc x n)
-    (away x n)))
-
-(defthm near+trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (= (near+ x n)
-		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
-  :rule-classes ())
-
-(defthm sgn-near+
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (= (near+ x n)
-		(* (sgn x) (near+ (abs x) n))))
-  :rule-classes ())
-
-(defthm sgn-near+-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (equal (sgn (near+ x n))
-		    (sgn x))))
-
-(defthm near+-pos
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0))
-           (> (near+ x n) 0))
-  :rule-classes :linear)
-
-;BOZO make :t-p?
-(defthm near+-neg
-    (implies (and (< x 0)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (near+ x n) 0))
-  :rule-classes :linear)
-
-(defthm near+-0-0
-  (implies (and (case-split (< 0 n))
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (equal (equal (near+ x n) 0)
-		  (equal x 0)))
-  :rule-classes ())
-
-(defthm near+-0
-  (equal (near+ 0 n) 0))
-
-(defthmd near+-minus
-  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
-
-(defthmd near+-shift
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (integerp k))
-	     (= (near+ (* x (expt 2 k)) n)
-		(* (near+ x n) (expt 2 k)))))
-
-(defthm near+-choice
-    (or (= (near+ x n) (trunc x n))
-	(= (near+ x n) (away x n)))
-  :rule-classes ())
-
-(defthm near+1-a
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (< (- x (trunc x n)) (- (away x n) x)))
-	     (= (near+ x n) (trunc x n)))
-  :rule-classes ())
-
-(defthm near+1-b
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (> (- x (trunc x n)) (- (away x n) x)))
-	     (= (near+ x n) (away x n)))
-  :rule-classes ())
-
-(defthm near+<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (near+ x n) (away x n)))
-  :rule-classes ())
-
-(defthm near+>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (near+ x n) (trunc x n)))
-  :rule-classes ())
-
-(defthm near+2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n))
-	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
-  :rule-classes ())
-
-(defthm near+-est
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0))
-	     (<= (abs (- x (near+ x n)))
-		 (expt 2 (- (expo x) n))))
-  :rule-classes ())
-
-;was called monotone-near+
-(defthm near+-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (< 0 x)
-                (integerp n)
-                (> n 0))
-           (<= (near+ x n) (near+ y n))))
-
-(defthm near+-power
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (near+ x n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthm near+-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (near+ x n))
-		  (exactp x n)))
-  :rule-classes ())
-
-(defthm near+-exactp-b
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (exactp (near+ x n) n)))
-
-(defthm near+-exactp-c
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (>= a x))
-	     (>= a (near+ x n))))
-
-(defthm near+-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (near+ x n))))
-
-
-;;;**********************************************************************
-;;;                           STICKY
-;;;**********************************************************************
-
-(defund sticky (x n)
-  (cond ((exactp x (1- n)) x)
-	(t (+ (trunc x (1- n))
-              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
-
-(defthm sticky-1
-  (implies (rationalp x)
-           (equal (sticky x 1)
-                  (* (sgn x) (expt 2 (expo x))))))
-
-(defthmd sticky-pos
-    (implies (and (< 0 x)
-                  (rationalp x) 
-		  (integerp n)
-                  (> n 0))
-	     (> (sticky x n) 0))
-  :rule-classes :linear)
-
-(defthm sticky-0
-  (equal (sticky 0 n) 0))
-
-(defthmd sticky-minus
-  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
-
-(defthm sticky-shift
-    (implies (and (rationalp x)
-		  (integerp n) (> n 0)
-		  (integerp k))
-	     (= (sticky (* (expt 2 k) x) n)
-		(* (expt 2 k) (sticky x n))))		
-  :rule-classes ())
-
-(defthm sticky-exactp
-    (implies (and (rationalp x) (>= x 0)
-		  (integerp n) (> n 0))
-	     (exactp (sticky x n) n))
-  :rule-classes ())
-
-(defthm sticky-exactp-m
-    (implies (and (rationalp x)
-		  (integerp m)
-		  (integerp n) 
-		  (> n m)
-		  (> m 0))
-	     (iff (exactp (sticky x n) m)
-		  (exactp x m)))
-  :rule-classes ())
-
-(defthm expo-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0))
-	     (= (expo (sticky x n))
-		(expo x)))
-  :rule-classes ())
-
-(defthm trunc-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n m))
-	     (= (trunc (sticky x n) m)
-		(trunc x m)))
-  :rule-classes ())
-
-(defthm away-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n m))
-	     (= (away (sticky x n) m)
-		(away x m)))
-  :rule-classes ())
-
-(defthm near-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n (1+ m)))
-	     (= (near (sticky x n) m)
-		(near x m)))
-  :rule-classes ())
-
-(defthm sticky-sticky
-    (implies (and (rationalp x)
-		  (integerp m)
-		  (> m 1)
-		  (integerp n)
-		  (>= n m))
-	     (= (sticky (sticky x n) m)
-		(sticky x m)))
-  :rule-classes ())
-
-(defthm sticky-plus
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ())
-
-(defthm minus-sticky
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (- x (sticky y k))
-		(sticky (- x y) k2)))
-  :rule-classes ())
-
-(defthm sticky-lemma
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ())
-
-(defthmd sticky-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0))
-           (<= (sticky x n) (sticky y n)))
-  :rule-classes :linear)
-
-;;;**********************************************************************
-;;;                              ODDR 
-;;;**********************************************************************
-
-;was called "odd" but that name conflicted with another function we wanted (a recursive version of oddp)
-(defund oddr (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x)))))
-    (if (evenp z)
-	(* (sgn x) (1+ z) (expt 2 (- (1+ (expo x)) n)))
-      (* (sgn x) z (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm oddr-pos
-    (implies (and (< 0 x)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< 0 (oddr x n)))
-  :rule-classes ())
-
-(defthm oddr>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (oddr x n) (trunc x n)))
-  :rule-classes ())
-
-;keep disabled..
-(defthmd oddr-rewrite
-    (implies (and (< 0 x)
-                  (rationalp x)
-		  (integerp n)
-		  (< 0 n))
-	     (equal (oddr x n)
-		    (let ((z (fl (* (expt 2 (- (1- n) (expo x))) x))))
-		      (if (evenp z)
-			  (* (1+ z) (expt 2 (- (1+ (expo x)) n)))
-			(* z (expt 2 (- (1+ (expo x)) n))))))))
-
-(defthm oddr-other
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n) 
-		  (> n 1))
-	     (= (oddr x n)
-		(+ (trunc x (1- n))
-		   (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ())
-
-(defthm expo-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (equal (expo (oddr x n)) (expo x))))
-
-(defthm exactp-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (exactp (oddr x n) n))
-  :rule-classes ())
-
-(defthm not-exactp-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (not (exactp (oddr x n) (1- n))))
-  :rule-classes ())
-
-(defthm trunc-oddr
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (> n m))
-	     (= (trunc (oddr x n) m)
-		(trunc x m)))
-  :rule-classes ())
-
-(defun kp (k x y)
-  (+ k (- (expo (+ x y)) (expo y))))
-
-(defthm oddr-plus
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-		  (> x 0)
-		  (> y 0)
-		  (> k 1)
-		  (> (+ (1- k) (- (expo x) (expo y))) 0)
-		  (exactp x (+ (1- k) (- (expo x) (expo y)))))
-	     (= (+ x (oddr y k))
-		(oddr (+ x y) (kp k x y))))
-  :rule-classes ())
-
-(defthm trunc-trunc-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (trunc x k) (trunc (oddr y m) k)))
-  :rule-classes ())
-
-(defthm away-away-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (away x k) (away (oddr y m) k)))
-  :rule-classes ())
-
-(defthm near-near-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (near x k) (near (oddr y m) k)))
-  :rule-classes ())
-
-
-;;;**********************************************************************
-;;;        IEEE Rounding (most theorems also apply to AWAY and NEAR+) 
-;;;**********************************************************************
-
-(defun inf (x n)
-  (if (>= x 0)
-      (away x n)
-    (trunc x n)))
-
-(defun minf (x n)
-  (if (>= x 0)
-      (trunc x n)
-    (away x n)))
-
-(defund ieee-mode-p (mode)
-  (member mode '(trunc inf minf near)))
-
-(defun rounding-mode-p (mode)
-  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
-
-(defthmd ieee-mode-p-implies-rounding-mode-p
-  (implies (IEEE-mode-p mode)
-           (rounding-mode-p mode)))
-
-(defund rnd (x mode n)
-  (case mode
-    (away (away x n))
-    (near+ (near+ x n))
-    (trunc (trunc x n))
-    (inf (inf x n))
-    (minf (minf x n))
-    (near (near x n))
-    (otherwise 0)))
-
-(defthm rationalp-rnd
-  (rationalp (rnd x mode n))
-  :rule-classes (:type-prescription))
-
-; Unlike the above, we leave the following two as rewrite rules because we may
-; want to use the rewriter to relieve their hypotheses.
-
-(defthm rnd-non-pos
-    (implies (<= x 0)
-	     (<= (rnd x mode n) 0))
-  :rule-classes (:rewrite :type-prescription :linear))
-
-(defthm rnd-non-neg
-    (implies (<= 0 x)
-	     (<= 0 (rnd x mode n)))
-  :rule-classes (:rewrite :type-prescription :linear))
-
-(defthm rnd-pos
-  (implies (and (< 0 x)
-                (rationalp x)
-                (integerp n)
-                (> n 0)
-                (rounding-mode-p mode))
-           (> (rnd x mode n) 0))
-  :RULE-CLASSES (:TYPE-PRESCRIPTION))
-
-(defthm rnd-neg
-    (implies (and (< x 0)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0)
-		  (rounding-mode-p mode))
-	     (< (rnd x mode n) 0))
-  :RULE-CLASSES (:TYPE-PRESCRIPTION))
-
-(defthm rnd-0
-  (equal (rnd 0 mode n)
-         0))
-
-(defthmd sgn-rnd
-    (implies (and; (rationalp x)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0))
-	     (equal (sgn (rnd x mode n))
-		    (sgn x))))
-
-(defund flip (m)
-  (case m
-    (inf 'minf)
-    (minf 'inf)
-    (t m)))
-
-(defthm ieee-mode-p-flip
-    (implies (ieee-mode-p m)
-	     (ieee-mode-p (flip m))))
-
-(defthm rounding-mode-p-flip
-    (implies (rounding-mode-p m)
-	     (rounding-mode-p (flip m))))
-
-;a very similar rule was called rnd-flip
-;enable?
-(defthmd rnd-minus
-  (equal (rnd (* -1 x) mode n)
-         (* -1 (rnd x (flip mode) n))))
-
-(defthm rnd-exactp-a
-  (implies (and (rationalp x)
-                (rounding-mode-p mode)
-                (integerp n) 
-                (> n 0))
-           (equal (equal x (rnd x mode n))
-		  (exactp x n))))
-
-(defthm rnd-exactp-b
-    (implies (< 0 n)
-	     (exactp (rnd x mode n) n)))
-
-(defthmd rnd-exactp-c
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (>= a x))
-	     (>= a (rnd x mode n))))
-
-(defthmd rnd-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (rnd x mode n))))
-
-(defthm rnd<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0))
-	     (<= (rnd x mode n) (away x n)))
-  :rule-classes ())
-
-(defthm rnd>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0))
-	     (>= (rnd x mode n) (trunc x n)))
-  :rule-classes ())
-
-(defthmd rnd-monotone
-    (implies (and (<= x y)
-                  (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0))
-	     (<= (rnd x mode n) (rnd y mode n))))
-
-(defthm exactp-rnd
-    (implies (and (rationalp x)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0))
-	     (exactp (rnd x mode n) n)))
-
-(defthm rnd-shift
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (rounding-mode-p mode)
-		  (integerp k))
-	     (= (rnd (* x (expt 2 k)) mode n)
-		(* (rnd x mode n) (expt 2 k))))
-  :rule-classes ())
-
-(defthm expo-rnd
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0)
-		  (rounding-mode-p mode)
-		  (not (= (abs (rnd x mode n))
-			  (expt 2 (1+ (expo x))))))
-	     (= (expo (rnd x mode n))
-		(expo x)))
-  :rule-classes ())
-
-(defthm expo-rnd-bnd
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0)
-		  (rounding-mode-p mode))
-	     (>= (expo (rnd x mode n))
-		 (expo x)))
-  :rule-classes ())
-
-(defun rnd-const (e mode n)
-  (case mode
-    ((near near+) (expt 2 (- e n)))
-    ((inf away) (1- (expt 2 (1+ (- e n)))))
-    (otherwise 0)))
-
-(defthm rnd-const-thm
-    (implies (and (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 1)
-		  (integerp x)
-		  (> x 0)
-		  (>= (expo x) n))
-	     (= (rnd x mode n)
-		(if (and (eql mode 'near)
-			 (exactp x (1+ n))
-			 (not (exactp x n)))
-		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
-		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
-  :rule-classes ())
-
-(defun roundup (x mode n)
-; Returns T when we should add an ulp after truncating x to n digits.
-  (case mode
-    (near+ (= (bitn x (- (expo x) n)) 1))
-    (near (and (= (bitn x (- (expo x) n)) 1)
-               (or (not (exactp x (1+ n)))
-                   (= (bitn x (- (1+ (expo x)) n)) 1))))
-    ((inf away) (not (exactp x n)))
-    (otherwise ())))
-
-(defthm roundup-thm
-    (implies (and (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 1)
-		  (integerp x)
-		  (> x 0)
-		  (>= (expo x) n))
-	     (= (rnd x mode n)
-                (if (roundup x mode n)
-                    (fp+ (trunc x n) n)
-                  (trunc x n))))
-  :rule-classes ())
-
-(defthmd rnd-sticky
-  (implies (and (> n (1+ k))
-                (rounding-mode-p mode)
-                (rationalp x) (> x 0)
-                (integerp k) (> k 0)
-                (integerp n) )
-           (equal (rnd (sticky x n) mode k)
-                  (rnd x mode k))))
-
-(defthmd rnd-diff
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0)
-                (rounding-mode-p mode))
-           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
-
-(defthm plus-rnd
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y))))
-                (rounding-mode-p mode))
-           (= (+ x (rnd y mode k))
-              (rnd (+ x y)
-                   mode
-                   (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ())
-
-
-
-;;;**********************************************************************
-;;;                         Denormal Rounding 
-;;;**********************************************************************
-
-(defund drnd (x mode n k)
-  (- (rnd (+ x (* (sgn x) (expt 2 (- 2 (expt 2 (1- k)))))) mode n)
-     (* (sgn x) (expt 2 (- 2 (expt 2 (1- k)))))))
-
-(defthm drnd-0
-  (equal (drnd 0 mode n k)
-         0))
-
-; a very similar rule was called drnd-flip
-(defthmd drnd-minus
-  (equal (drnd (* -1 x) mode n k)
-         (* -1 (drnd x (flip mode) n k))))
-
-(defthm drnd-sticky
-    (implies (and (rounding-mode-p mode)
-		  (natp n)
-		  (> n 0)
-		  (natp m)
-		  (> m 1)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (<= (expo x) (- 1 (expt 2 (1- k))))
-		  (<= (expo x) (- m (+ n (expt 2 (1- k))))))
-	     (equal (drnd (sticky x m) mode n k)
-		    (drnd x mode n k)))
-  :rule-classes ())
-
-(defthm drnd-tiny-equal
-    (implies (and (ieee-mode-p m)
-		  (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (< (abs x) (expt 2 (- 2 (+ n (expt 2 (1- k))))))
-		  (rationalp y)
-		  (< (abs y) (expt 2 (- 2 (+ n (expt 2 (1- k))))))
-		  (equal (sgn x) (sgn y)))
-	     (equal (drnd x m n k)
-		    (drnd y m n k)))
-  :rule-classes ())
-
-
-(defund smallest-positive-normal (k)
-  (expt 2 (- 1 (bias k))))
-
-;;These next three show that smallest-positive-normal really is what it claims to be
-
-(defthm positive-spn
-  (> (smallest-positive-normal k) 0)
-  :rule-classes ( :linear))
-
-(defthm nrepp-spn
-  (implies (and (integerp n)
-                (> n 0)
-                (integerp k)
-                (> k 1))
-           (nrepp (smallest-positive-normal k) n k)))
-
-(defthm smallest-spn
-  (implies (and (nrepp x n k)
-                (integerp n)
-                (> n 0)
-                (integerp k)
-                (> k 1)
-                )
-           (>= (abs x) (smallest-positive-normal k)))
-  :rule-classes
-  ((:rewrite :match-free :once)))
-
-(defund smallest-positive-denormal (n k)
-     (expt 2 (+ 2 (- (bias k)) (- n))))
-
-;;These next three show that smallest-positive-denormal really is what it claims to be
-
-(defthm positive-spd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (> (smallest-positive-denormal n k) 0)))
-
-(defthm drepp-spd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (drepp (smallest-positive-denormal n k) n k)))
-
-(defthm smallest-spd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (drepp x n k))
-           (>= (abs x) (smallest-positive-denormal n k))))
-
-;DRND returns a denormal, or zero, or the smallest normal:
-
-(defthm drnd-type
-  (implies (and (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (or (drepp (drnd x mode n k) n k)
-               (= (drnd x mode n k) 0)
-               (= (drnd x mode n k) (* (sgn x) (smallest-positive-normal k)))))
-  :rule-classes ())
-
-(defthmd drnd-rewrite
-  (implies (and (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (rounding-mode-p mode)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (equal (drnd x mode n k)
-                  (rnd x 
-                       mode
-                       (+ n 
-                          (- (expo (smallest-positive-normal k))) 
-                          (expo x))))))
-
-(defthm drnd-of-drepp-is-NOP
-  (implies (and (drepp x n k)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (equal (drnd x mode n k)
-                  x)))
-
-(defthm drnd-spn-is-spn-general
-  (implies (and (= (abs x) (smallest-positive-normal k))
-                (rounding-mode-p mode)
-                (integerp n)
-                (>= n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x))
-           (= (drnd x mode n k) x)))
-
-(defthm drnd-trunc-never-goes-away-from-zero
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)))
-           (<= (abs (drnd x 'trunc n k))
-               (abs x))))
-
-(defthm drnd-away-never-goes-toward-zero
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)))
-           (>= (abs (drnd x 'away n k))
-               (abs x))))
-
-(defthm drnd-inf-never-goes-down
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)))
-           (>= (drnd x 'inf n k)
-               x)))
-
-(defthm drnd-minf-never-goes-up
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)))
-           (<= (drnd x 'minf n k)
-               x)))
-
-(defthm drnd-trunc-skips-no-denormals
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (drepp a n k)
-                (<= (abs a) (abs x))
-                )
-           (<= (abs a)
-               (abs (drnd x 'trunc n k)))))
-
-(defthm drnd-away-skips-no-denormals
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (drepp a n k)
-                (>= (abs a) (abs x))
-                )
-           (>= (abs a) (abs (drnd x 'away n k)))))
-
-
-(defthm drnd-inf-skips-no-denormals
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (drepp a n k)
-                (>= a x))
-           (>= a (drnd x 'inf n k))))
-
-(defthm drnd-minf-skips-no-denormals
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (drepp a n k)
-                (<= a x))
-           (<= a (drnd x 'minf n k))))
-
-(defthm drnd-diff
-  (implies (and (rationalp x)
-                (<= (ABS X) (SMALLEST-POSITIVE-NORMAL K))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (< (abs (- x (drnd x mode n k))) (smallest-positive-denormal n k))))
-
-(defund next-denormal (x n k)
-  (+ x (smallest-positive-denormal n k)))
-
-;;NEXT-DENORMAL behaves as expected:
-
-(defthm denormal-spacing
-  (implies (and (integerp n)
-                (integerp k)
-                (> k 0)
-                (> n 1)
-                (drepp x n k)
-                (drepp x+ n k)
-                (>= x 0)
-                (> x+ x))
-           (>= x+ (next-denormal x n k))))
-
-(defthm no-denormal-is-closer-than-what-drnd-near-returns
-  (implies (and (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (drepp a n k))
-           (>= (abs (- x a)) (abs (- x (drnd x 'near n k))))))
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/lib/rtl.lisp acl2-6.3/books/rtl/rel5/lib/rtl.lisp
--- acl2-6.2/books/rtl/rel5/lib/rtl.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/rtl.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,675 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/top"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-;;This book contains definitions of the ACL2 functions that are used in the
-;;formalization of RTL semantics.
-
-
-;;Bit-vector access:
-
-(defund fl (x)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-
-;;CAT (concatenation):
-
-(defund binary-cat (x m y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp m) (< 0 m)
-                              (integerp n) (< 0 n))))
-  (if (and (natp m) (natp n))
-      (+ (* (expt 2 n) (bits x (1- m) 0))
-         (bits y (1- n) 0))
-    0))
-
-(defun formal-+ (x y)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
-;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
-;;not need to specify this in the guard, and leaving it out of that guard
-;;simplifies the guard proof.
-
-(defun cat-size (x)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
-  (if (endp (cddr x))
-      (cadr x)
-    (formal-+ (cadr x)
-	      (cat-size (cddr x)))))
-
-(defmacro cat (&rest x)
-  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
-  (cond ((endp (cddr x))
-         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
-        ((endp (cddddr x))
-         `(binary-cat ,@x))
-        (t
-         `(binary-cat ,(car x) 
-                      ,(cadr x) 
-                      (cat ,@(cddr x)) 
-                      ,(cat-size (cddr x))))))
-
-;Allows things like (in-theory (disable cat)) to refer to binary-cat.
-(add-macro-alias cat binary-cat)
-
-(defund mulcat (l n x)
-
-; We introduce mbe not because we want particularly fast execution, but because
-; the existing logic definition does not satisfy the guard of cat, which can't
-; be changed because of the guard of bits.
-
-  (declare (xargs :guard (and (integerp l)
-                              (< 0 l)
-                              (acl2-numberp n)
-                              (natp x))))
-  (mbe :logic (if (and (integerp n) (> n 0))
-                  (cat (mulcat l (1- n) x)
-                       (* l (1- n))
-                       x
-                       l)
-                0)
-       :exec  (cond ((eql n 1)
-                     (bits x (1- l) 0))
-                    ((and (integerp n) (> n 0))
-                     (cat (mulcat l (1- n) x)
-                          (* l (1- n))
-                          x
-                          l))
-                    (t 0))))
-
-;;LNOT (bitwise complement):
-
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-;LAND (bitwise and):
-
-(defund binary-land (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (and (equal (bitn x 0) 1)
-                       (equal (bitn y 0) 1))
-                  1
-                0))
-             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-land (mod x 2) (mod y 2) 1))))
-       :exec ; (land0 x y n)
-       (logand (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro land (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
-         `(binary-land ,@x))
-        (t         
-         `(binary-land ,(car x)
-                       (land ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable land)) to refer to binary-land.
-(add-macro-alias land binary-land)
-
-;;LIOR (bitwise inclusive or):
-
-(defund binary-lior (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (or (equal (bitn x 0) 1)
-                      (equal (bitn y 0) 1))
-                  1
-                0))
-             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-lior (mod x 2) (mod y 2) 1))))
-       :exec ; (lior0 x y n)
-       (logior (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro lior (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
-         `(binary-lior ,@x))
-        (t         
-         `(binary-lior ,(car x)
-                       (lior ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable lior)) to refer to binary-lior:
-(add-macro-alias lior binary-lior)
-
-;;LXOR (bitwise exclusive or):
-
-(defund binary-lxor (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (iff (equal (bitn x 0) 1)
-                       (equal (bitn y 0) 1))
-                  0
-                1))
-             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-lxor (mod x 2) (mod y 2) 1))))
-       :exec ; (lxor0 x y n)
-       (logxor (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro lxor (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
-         `(binary-lxor ,@x))
-        (t         
-         `(binary-lxor ,(car x)
-                       (lxor ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
-(add-macro-alias lxor binary-lxor)
-
-
-;;Bit-vector update:
-
-; We have decided to allow setbits to open up in terms of cat.  So, we leave it
-; enabled.
-
-(defun setbits (x w i j y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp i)
-                              (integerp j)
-                              (<= 0 j)
-                              (<= j i)
-                              (integerp w)
-                              (< i w))))
-  (mbe :logic (cat (bits x (1- w) (1+ i))
-                   (+ -1 w (- i))
-                   (cat (bits y (+ i (- j)) 0)
-                        (+ 1 i (- j))
-                        (bits x (1- j) 0)
-                        j)
-                   (1+ i))
-       :exec  (cond ((int= j 0)
-                     (cond ((int= (1+ i) w)
-                            (bits y (+ i (- j)) 0))
-                           (t
-                            (cat (bits x (1- w) (1+ i))
-                                 (+ -1 w (- i))
-                                 (bits y (+ i (- j)) 0)
-                                 (1+ i)))))
-                    ((int= (1+ i) w)
-                     (cat (bits y (+ i (- j)) 0)
-                          (+ 1 i (- j))
-                          (bits x (1- j) 0)
-                          j))
-                    (t
-                     (cat (bits x (1- w) (1+ i))
-                          (+ -1 w (- i))
-                          (cat (bits y (+ i (- j)) 0)
-                               (+ 1 i (- j))
-                               (bits x (1- j) 0)
-                               j)
-                          (1+ i))))))
-
-(defun setbitn (x w n y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (<= 0 n)
-                              (integerp w)
-                              (< n w))))
-  (setbits x w n n y))
-
-
-;;Equality comparison:
-
-;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
-;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
-(defund log= (x y)
-  (declare (xargs :guard t))
-  (if (equal x y) 1 0))
-
-(defund log<> (x y)
-  (declare (xargs :guard t))
-  (if (equal x y) 0 1))
-
-
-;;Unsigned inequalities:
-
-(defund log< (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (< x y) 1 0))
-
-(defund log<= (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (<= x y) 1 0))
-
-(defund log> (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (> x y) 1 0))
-
-(defund log>= (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (>= x y) 1 0))
-
-
-;;Signed inequalities:
-
-(defund comp2 (x n)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (and (rationalp x) (integerp n))))
-  (if (< x (expt 2 (1- n)))
-      x
-    (- (- (expt 2 n) x))))
-
-(defund comp2< (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
-  (log< (comp2 x n) (comp2 y n)))
-
-(defund comp2<= (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
-  (log<= (comp2 x n) (comp2 y n)))
-
-(defund comp2> (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
-  (log> (comp2 x n) (comp2 y n)))
-
-(defund comp2>= (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
-  (log>= (comp2 x n) (comp2 y n)))
-
- 
-;;Unary logical operations:
-
-(defund logand1 (x n)
-  (declare (xargs :guard (integerp n)))
-  (log= x (1- (expt 2 n))))
-
-(defund logior1 (x)
-  (declare (xargs :guard t))
-  (if (equal x 0) 0 1))
-
-(defund logxor1 (src)
-  (declare (xargs :guard (integerp src)))
-  (if (oddp (logcount src)) 1 0))
-
-
-;;Shifting operations:
-
-(defund shft (x s l)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (and (integerp s) (rationalp x))))
-  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
-
-(defmacro lshft (x s l)
-  `(shft ,x ,s ,l))
-
-(defmacro rshft (x s l)
-  `(shft ,x (- ,s) ,l))
-
-
-;;Arithmetic operations
-
-(defmacro mod+ (x y n)
-  `(bits (+ ,x ,y) (1- ,n) 0))
-
-(defmacro mod* (x y n)
-  `(bits (* ,x ,y) (1- ,n) 0))
-
-#|
-Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
-i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
-about the old defintion of mod-:
-
-(thm
- (implies (and (bvecp x n)
-	       (bvecp y n)
-	       (natp n)
-	       )
-	  (equal (mod- x y n)
-		 (bits (- x y) (1- n) 0)))
-	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
-)
-
-We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
-any behavior we care about.
-
-Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
-get rid of the bits call.
-|#
-
-(defmacro mod- (x y n)
-  `(bits (- ,x ,y) (1- ,n) 0))
-
-
-#| Old definition of mod- :
-
-;; the following function is not generated in the translate-rtl output. It is
-;; only needed to define 'mod-
-(defund comp2-inv (x n)
-  (declare (xargs :guard (and (rationalp x)
-                              (integerp n))))
-  (if (< x 0)
-      (+ x (expt 2 n))
-    x))
-
-(defund mod- (x y n)
-  (declare (xargs :guard (and (rationalp x)
-                              (rationalp y)
-                              (integerp n))))
-  (comp2-inv (- x y) n))
-|#
-
-
-;; NOTE -- the following definition of decode is "flawed". We still
-;; need to add assumptions to "allow" this definition to be used.
-
-(defund decode (x n)
-  (declare (xargs :guard (rationalp n)))
-  (if (and (natp x) (< x n)) 
-      (ash 1 x) 
-    0))
-
-(defund encode (x n)
-    (declare (xargs :guard (and (acl2-numberp x)
-                                (integerp n)
-                                (<= 0 n))))
-  (if (zp n) 
-      0
-    (if (= x (ash 1 n))
-        n
-      (encode x (1- n)))))
-
-
-;;Evaluation control operators
-
-(defmacro bind (v x y)
-  `(let ((,v ,x)) ,y))
-
-(defun if1 (x y z)
-  (declare (xargs :guard (integerp x)))
-  (if (eql x 0) z y))
-
-;BOZO Where in lib/ should these go?
-
-(defthm if1-0
-  (equal (if1 0 y z)
-         z))
-
-(defthm if1-non-0
-  (implies (not (equal x 0))
-           (equal (if1 x y z)
-                  y)))
-
-(defthm if1-x-x
-  (equal (if1 tst x x)
-         x))
-
-(defun cond1-macro (clauses)
-  ;; Based on cond-macro.
-  (declare (xargs :guard (cond-clausesp clauses)))
-  (if (consp clauses)
-      (if (and (eq (car (car clauses)) t)
-               (eq (cdr clauses) nil))
-          (if (cdr (car clauses))
-              (car (cdr (car clauses)))
-            (car (car clauses)))
-        (list 'if1 (car (car clauses))
-              (if (cdr (car clauses))
-                  (car (cdr (car clauses)))
-                (car (car clauses)))
-              (cond1-macro (cdr clauses))))
-    0))
-
-(defmacro cond1 (&rest clauses)
-  (declare (xargs :guard (cond-clausesp clauses)))
-  (cond1-macro clauses))
-
-
-;;Natural number recognizer
-
-(defund natp1 (x)
-  (declare (xargs :guard t))
-  (if (and (integerp x)
-           (<= 0 x))
-      1
-    0))
-
-;;Functions representing bit vectors of determined length but undetermined value:
-
-(defund bvecp (x k)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defthm bvecp-if1
-  (equal (bvecp (if1 x y z) n)
-         (if1 x (bvecp y n) (bvecp z n))))
-
-; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
-
-(defun mk-bvec (r k)
-  (declare (xargs :guard (integerp k)))
-  (if (bvecp r k) r 0))
-
-(defthm mk-bvec-is-bvecp
-  (bvecp (mk-bvec r k) k))
-
-(defthm mk-bvec-identity
-  (implies (bvecp r k)
-           (equal (mk-bvec r k) r)))
-
-(defmacro n! (i n)
-  (declare (ignore n)
-           (xargs :guard (and (natp i)
-                              (natp n)
-                              (bvecp i n))))
-  i)
-
-(encapsulate 
- ((reset (key size) t))
- (local (defun reset (key size) (declare (ignore key size)) 0))
- (defthm bvecp-reset (bvecp (reset key size) size)
-   :hints (("Goal" :in-theory (enable bvecp expt)))
-   :rule-classes 
-   (:rewrite 
-    (:forward-chaining :trigger-terms ((reset key size)))	
-    (:type-prescription :corollary
-                        (and (integerp (reset key size)) 
-                             (>= (reset key size) 0))
-                        :hints
-                        (("Goal" :in-theory '(implies bvecp)))))))
-
-(encapsulate 
- ((unknown (key size n) t))
- (local (defun unknown (key size n) (declare (ignore key size n)) 0))
- (defthm bvecp-unknown (bvecp (unknown key size n) size)
-   :hints (("Goal" :in-theory (enable bvecp expt)))
-   :rule-classes 
-   (:rewrite
-    (:forward-chaining :trigger-terms ((unknown key size n)))
-    (:type-prescription :corollary
-                        (and (integerp (unknown key size n))
-                             (>= (unknown key size n) 0))
-                        :hints
-                        (("Goal" :in-theory '(implies bvecp)))))))
-
-
-; Finally, we include bvecp (and, occasionally, related) lemmas for several
-; functions that are disabled.  These are not included elsewhere, presumably
-; because the functions will generally be enabled (hence blown away) by the
-; user.
-
-(defthm shft-bvecp
-  (implies (and (<= n k)
-		(case-split (integerp k)))
-	   (bvecp (shft x s n) k)))
-
-(defthm logand1-bvecp
-  (bvecp (logand1 x y) 1))
-
-(defthm logior1-bvecp
-  (bvecp (logior1 x) 1))
-
-(defthm logxor1-bvecp
-  (bvecp (logxor1 x) 1))
-
-(defthm log<-bvecp
-  (bvecp (log< x y) 1))
-
-(defthm log<-nonnegative-integer-type
-  (and (integerp (log< x y))
-       (<= 0 (log< x y)))
-  :rule-classes (:type-prescription))
-
-;;This rule is no better than log<-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription log<)))
-
-(defthm log<=-bvecp
-  (bvecp (log<= x y) 1))
-
-(defthm log<=-nonnegative-integer-type
-  (and (integerp (log<= x y))
-       (<= 0 (log<= x y)))
-  :rule-classes (:type-prescription))
-
-;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription log<=)))
-
-(defthm log>-bvecp
-  (bvecp (log> x y) 1))
-
-(defthm log>-nonnegative-integer-type
-  (and (integerp (log> x y))
-       (<= 0 (log> x y)))
-  :rule-classes (:type-prescription))
-
-;;This rule is no better than log>-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription log>)))
-
-(defthm log>=-bvecp
-  (bvecp (log>= x y) 1))
-
-(defthm log>=-nonnegative-integer-type
-  (and (integerp (log>= x y))
-       (<= 0 (log>= x y)))
-  :rule-classes (:type-prescription))
-
-;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription log>=)))
-
-(defthm log=-bvecp
-  (bvecp (log= x y) 1))
-
-(defthm log=-nonnegative-integer-type
-  (and (integerp (log= x y))
-       (<= 0 (log= x y)))
-  :rule-classes (:type-prescription))
-
-(defthm log=-commutative
-       (equal (log= x y)
-              (log= y x))
-       :hints (("Goal" :in-theory (enable log=))))
-
-;;This rule is no better than log=-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription log=)))
-
-(defthm log<>-bvecp
-  (bvecp (log<> x y) 1))
-
-(defthm log<>-nonnegative-integer-type
-  (and (integerp (log<> x y))
-       (<= 0 (log<> x y)))
-  :rule-classes (:type-prescription))
-
-(defthm log<>-commutative
-  (equal (log<> x y)
-	 (log<> y x)))
-
-;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription log<>)))
-
-;;The definitions of these functions are best disabled:
-
-(in-theory (disable aref1))
-(in-theory (disable aset1))
-(in-theory (disable aref2))
-(in-theory (disable aset2))
-(in-theory (disable floor))
-(in-theory (disable truncate))
-(in-theory (disable mod))
-(in-theory (disable rem))
-(in-theory (disable expt))
-(in-theory (disable ash))
-(in-theory (disable binary-logand))
-(in-theory (disable binary-logior))
-(in-theory (disable binary-logxor))
-(in-theory (disable binary-logeqv))
-(in-theory (disable logorc1))
-(in-theory (disable lognot))
-(in-theory (disable mk-bvec))
-(in-theory (disable if1))
diff -Nru acl2-6.2/books/rtl/rel5/lib/rtlarr.lisp acl2-6.3/books/rtl/rel5/lib/rtlarr.lisp
--- acl2-6.2/books/rtl/rel5/lib/rtlarr.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/rtlarr.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,234 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/rtlarr"))
-(local (include-book "../support/bvecp-helpers"))
-(local (include-book "../support/guards"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-;;We define generic record accessing and updating functions to be used 
-;;with RTL arrays.  The basic functions are (ag a r) and (as a v r)
-;;where a is an array index, v is a value, r is an "array" or record.
-;;(ag a r) returns the value at index a in array r, and (as a v r) returns 
-;;a new array with index a set to value v in array r.
-
-(include-book "misc/total-order" :dir :system)
-
-(include-book "rtl")
-
-(defmacro default-get-valu () 0)
-
-(defun rcdp (x)
-  (declare (xargs :guard t))
-  (or (null x)
-      (and (consp x)
-           (consp (car x))
-           (rcdp (cdr x))
-           (not (equal (cdar x) 
-                       (default-get-valu)))
-           (or (null (cdr x))
-               (<< (caar x) (caadr x))))))
-
-(defthm rcdp-implies-alistp
-  (implies (rcdp x) (alistp x)))
-
-(defmacro ifrp-tag ()
-  ''unlikely-to-ever-occur-in-an-executable-counterpart)
-
-(defun ifrp (x) ;; ill-formed rcdp 
-  (declare (xargs :guard t))
-  (or (not (rcdp x))
-      (and (consp x)
-           (null (cdr x))
-           (consp (car x))
-           (equal (cdar x) (ifrp-tag))
-           (ifrp (caar x)))))
-
-(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
-  (declare (xargs :guard t))
-  (if (ifrp x) (list (cons x (ifrp-tag))) x))
-
-(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
-  (declare (xargs :guard (rcdp r)))
-  (if (ifrp r) (caar r) r))
-
-(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
-  (declare (xargs :guard (rcdp r)))
-  (cond ((or (endp r)
-             (<< a (caar r)))
-         (default-get-valu))
-        ((equal a (caar r))
-         (cdar r))
-        (t
-         (ag-aux a (cdr r)))))
-
-(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
-  (declare (xargs :guard t))
-  (ag-aux a (acl2->rcd x)))
-
-(defun acons-if (a v r)
-  (declare (xargs :guard (rcdp r)))
-  (if (equal v (default-get-valu)) r (acons a v r)))
-
-(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
-  (declare (xargs :guard (rcdp r)))
-  (cond ((or (endp r)
-             (<< a (caar r)))
-         (acons-if a v r))
-        ((equal a (caar r))
-         (acons-if a v (cdr r)))
-        (t 
-         (cons (car r) (as-aux a v (cdr r))))))
-
-(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
-  (declare (xargs :guard t))
-  (rcd->acl2 (as-aux a v (acl2->rcd x))))
-
-
-;;Basic properties of arrays:
-
-(defthm ag-same-as
-  (equal (ag a (as a v r)) 
-         v))
-
-(defthm ag-diff-as
-  (implies (not (equal a b))
-           (equal (ag a (as b v r))
-                  (ag a r))))
-
-;;;; NOTE: The following can be used instead of the above rules to force ACL2
-;;;; to do a case-split. We disable this rule by default since it can lead to
-;;;; an expensive case explosion, but in many cases, this rule may be more
-;;;; effective than two rules above and should be enabled.
-
-(defthm ag-of-as-redux
-  (equal (ag a (as b v r))
-         (if (equal a b) v (ag a r))))
-
-(in-theory (disable ag-of-as-redux))
-
-(defthm as-same-ag
-  (equal (as a (ag a r) r) 
-         r))
-
-(defthm as-same-as
-  (equal (as a y (as a x r))
-         (as a y r)))
-
-(defthm as-diff-as
-  (implies (not (equal a b))
-           (equal (as b y (as a x r))
-                  (as a x (as b y r))))
-  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
-
-;; the following theorems are less relevant but have been useful in dealing
-;; with a default record of NIL.
-
-(defthm ag-of-nil-is-default
-  (equal (ag a nil) (default-get-valu)))
-
-(defthm as-non-default-cannot-be-nil
-  (implies (not (equal v (default-get-valu)))
-           (as a v r)))
-
-(defthm non-nil-if-ag-not-default
-  (implies (not (equal (ag a r) 
-                       (default-get-valu)))
-           r)
-  :rule-classes :forward-chaining)
-
-;; OK, we add here some properties for typing the records and the values which
-;; are stored in the records. This "typing" is pretty generic, but we choose the
-;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
-
-(defun bv-arrp (x k)
-  (declare (xargs :guard (integerp k)))
-  (or (null x)
-      (and (consp x)
-           (consp (car x))
-           (bv-arrp (cdr x) k)
-           (not (equal (cdar x) 
-                       (default-get-valu)))
-           (bvecp (cdar x) k)
-           (or (null (cdr x))
-               (<< (caar x) (caadr x))))))
-
-(defthm as-maps-bv-arr-to-bv-arr
-  (implies (and (bv-arrp r k)
-                (bvecp v k))
-           (bv-arrp (as a v r) k)))
-
-(defthm ag-maps-bv-arr-to-bvecp
-  (implies (bv-arrp r k)
-           (bvecp (ag a r) k)))
-
-(defun mk-bvarr (r k)
-  (declare (xargs :guard (integerp k)))
-  (if (bv-arrp r k) r ()))
-
-(defthm mk-bvarr-is-bv-arrp
-  (bv-arrp (mk-bvarr r k) k))
-
-(defthm mk-bvarr-identity
-  (implies (bv-arrp r k)
-           (equal (mk-bvarr r k) r)))
-
-(in-theory (disable bv-arrp mk-bvarr))
-
-;;We also define as2 and ag2 for 2-dimensional arrays but these simply
-;;macro-expand into appropriate as and ag calls.
-
-(defmacro ag2 (a b r)
-  `(ag (cons ,a ,b) ,r))
-
-(defmacro as2 (a b v r)
-  `(as (cons ,a ,b) ,v ,r))
-
-
-;;We disable as and ag, assuming the rules proved in this book are 
-;;sufficient to manipulate any record terms that are encountered.
-
-(in-theory (disable as ag))
-
-(defun positive-integer-listp (l)
-  (declare (xargs :guard t))
-  (cond ((atom l)
-         (equal l nil))
-        (t (and (integerp (car l))
-                (< 0 (car l))
-                (positive-integer-listp (cdr l))))))
-
-(defmacro arr0 (&rest dims)
-  (declare (ignore dims)
-           (xargs :guard (positive-integer-listp dims)))
-  nil)
-
-;;Functions representing bit vectors of determined length but undetermined value:
-
-(encapsulate 
- ((reset2 (key size) t))
- (local (defun reset2 (key size) (declare (ignore key size)) nil))
- (defthm bv-arrp-reset2
-   (bv-arrp (reset2 key size) size)
-   :hints
-   (("goal" :in-theory (enable bv-arrp)))))
-
-(encapsulate 
- ((unknown2 (key size n) t))
- (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
- (defthm bv-arrp-unknown2
-   (bv-arrp (unknown2 key size n) size)
-   :hints
-   (("goal" :in-theory (enable bv-arrp)))))
-
-;BOZO where in lib/ should this go?
-(defthm bv-arrp-if1
-  (equal (bv-arrp (if1 x y z) n)
-         (if1 x (bv-arrp y n) (bv-arrp z n))))
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/lib/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel5/lib/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel5/lib/simple-loop-helpers.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,323 +0,0 @@
-(IN-PACKAGE "ACL2")
-
-(set-enforce-redundancy t)
-
-(include-book "rtl")
-(include-book "rtlarr")
-(include-book "arith")
-(include-book "log")
-(local (include-book "../support/simple-loop-helpers"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Other helpful stuff;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(DEFCONST *EXPT-2-32*
-  (EXPT 2 32))
-
-(DEFTHM BITS-31-0
-  (IMPLIES (AND (NATP I)
-                (< I *EXPT-2-32*))
-           (EQUAL (BITS I 31 0)
-                  I)))
-
-(DEFTHM BVECP-BITN
-  (BVECP (BITN Y I) 1))
-
-(DEFTHM BITN-SETBITN-NOT-EQUAL
-
-; This holds without needing (CASE-SPLIT (BVECP Y 1)).
-
-  (IMPLIES (AND (NOT (EQUAL N K))
-                (CASE-SPLIT (< 0 W))
-                (CASE-SPLIT (< N W))
-                (CASE-SPLIT (< K W))
-                (CASE-SPLIT (<= 0 K))
-                (CASE-SPLIT (INTEGERP W))
-                (CASE-SPLIT (INTEGERP N))
-                (<= 0 N)
-                (CASE-SPLIT (INTEGERP K)))
-           (EQUAL (BITN (SETBITN X W N Y) K)
-                  (BITN X K))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generic theory for counting up, non-arrays
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ENCAPSULATE
- (($$LOOP_0$ADJ (Y+ I) T)
-  ($$LOOP_0$HIGH () T))
-
- (LOCAL
-  (DEFUN $$LOOP_0$HIGH () 3))
-
- (DEFTHM NATP-$$LOOP_0$HIGH
-   (AND (INTEGERP ($$LOOP_0$HIGH))
-        (<= 0 ($$LOOP_0$HIGH)))
-   :RULE-CLASSES :TYPE-PRESCRIPTION)
-
- (LOCAL
-  (DEFUN $$LOOP_0$ADJ (Y+ I)
-    (DECLARE (IGNORE I))
-    Y+))
-
- (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
-   (IMPLIES (AND (NATP I)
-                 (NATP J)
-                 (NOT (EQUAL I J))
-                 (<= I ($$LOOP_0$HIGH))
-                 (<= J ($$LOOP_0$HIGH)))
-            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
-                   (BITN Y+ J)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
-
- (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
-   (IMPLIES (AND (NATP I)
-                 (<= I ($$LOOP_0$HIGH))
-                 (NATP J)
-                 (<= J ($$LOOP_0$HIGH))
-                 (<= I J))
-            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
-                                       J)
-                         J)
-                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
-
-(DEFUN $$LOOP_0 (Y+ I)
-  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
-  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
-      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
-                (+ I 1))
-      Y+))
-
-(DEFTHM BITN-$$LOOP_0
-  (IMPLIES (AND (NATP I)
-                (NATP J)
-                (<= I ($$LOOP_0$HIGH))
-                (<= J ($$LOOP_0$HIGH)))
-           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
-                  (IF (<= I J)
-                      (BITN ($$LOOP_0$ADJ Y+ J) J)
-                      (BITN Y+ J)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generic theory for counting down, non-arrays
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ENCAPSULATE
- (($$LOOP_1$ADJ (Y+ I) T)
-  ($$LOOP_1$LOW () T)
-  ($$LOOP_1$HIGH () t))
-
- (LOCAL
-  (DEFUN $$LOOP_1$LOW () 2))
-
- (LOCAL
-  (DEFUN $$LOOP_1$HIGH () 4))
-
- (DEFTHM NATP-$$LOOP_1$LOW
-   (AND (INTEGERP ($$LOOP_1$LOW))
-        (<= 0 ($$LOOP_1$LOW)))
-   :RULE-CLASSES :TYPE-PRESCRIPTION)
-
- (LOCAL
-  (DEFUN $$LOOP_1$ADJ (Y+ I)
-    (DECLARE (IGNORE I))
-    Y+))
-
- (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
-   (IMPLIES (AND (NATP I)
-                 (NATP J)
-                 (NOT (EQUAL I J))
-                 (>= I ($$LOOP_1$LOW))
-                 (>= J ($$LOOP_1$LOW))
-                 (< I ($$LOOP_1$HIGH))
-                 (< J ($$LOOP_1$HIGH)))
-            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
-                   (BITN Y+ J)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
-
- (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
-   (IMPLIES (AND (NATP I)
-                 (>= I ($$LOOP_1$low))
-                 (NATP J)
-                 (>= J ($$LOOP_1$LOW))
-                 (< I ($$LOOP_1$HIGH))
-                 (< J ($$LOOP_1$HIGH))
-                 (<= J I))
-            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
-                                       J)
-                         J)
-                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
-
-(DEFUN $$LOOP_1 (Y+ I)
-  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
-  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
-      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
-                (- I 1))
-      Y+))
-
-(DEFTHM BITN-$$LOOP_1
-  (IMPLIES (AND (NATP I)
-                (NATP J)
-                (>= I ($$LOOP_1$LOW))
-                (>= J ($$LOOP_1$LOW))
-                (< I ($$LOOP_1$HIGH))
-                (< J ($$LOOP_1$HIGH)))
-           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
-                  (IF (>= I J)
-                      (BITN ($$LOOP_1$ADJ Y+ J) J)
-                      (BITN Y+ J)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generic theory for counting up, arrays
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ENCAPSULATE
- (($$LOOP_2$ADJ (Y+ I) T)
-  ($$LOOP_2$HIGH () T))
-
- (LOCAL
-  (DEFUN $$LOOP_2$HIGH () 3))
-
- (DEFTHM NATP-$$LOOP_2$HIGH
-   (AND (INTEGERP ($$LOOP_2$HIGH))
-        (<= 0 ($$LOOP_2$HIGH)))
-   :RULE-CLASSES :TYPE-PRESCRIPTION)
-
- (LOCAL
-  (DEFUN $$LOOP_2$ADJ (Y+ I)
-    (DECLARE (IGNORE I))
-    Y+))
-
- (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
-   (IMPLIES (AND (NATP I)
-                 (NATP J)
-                 (NOT (EQUAL I J))
-                 (<= I ($$LOOP_2$HIGH))
-                 (<= J ($$LOOP_2$HIGH)))
-            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
-                   (AG J Y+)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
-
- (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
-   (IMPLIES (AND (NATP I)
-                 (<= I ($$LOOP_2$HIGH))
-                 (NATP J)
-                 (<= J ($$LOOP_2$HIGH))
-                 (<= I J))
-            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
-                                       J))
-                   (AG J ($$LOOP_2$ADJ Y+ J))))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
-
-(DEFUN $$LOOP_2 (Y+ I)
-  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
-  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
-      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
-                (+ I 1))
-      Y+))
-
-(DEFTHM AG-$$LOOP_2
-  (IMPLIES (AND (NATP I)
-                (NATP J)
-                (<= I ($$LOOP_2$HIGH))
-                (<= J ($$LOOP_2$HIGH)))
-           (EQUAL (AG J ($$LOOP_2 Y+ I))
-                  (IF (<= I J)
-                      (AG J ($$LOOP_2$ADJ Y+ J))
-                      (AG J Y+)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generic theory for counting down, arrays
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ENCAPSULATE
- (($$LOOP_3$ADJ (Y+ I) T)
-  ($$LOOP_3$LOW () T)
-  ($$LOOP_3$HIGH () t))
-
- (LOCAL
-  (DEFUN $$LOOP_3$LOW () 2))
-
- (LOCAL
-  (DEFUN $$LOOP_3$HIGH () 4))
-
- (DEFTHM NATP-$$LOOP_3$LOW
-   (AND (INTEGERP ($$LOOP_3$LOW))
-        (<= 0 ($$LOOP_3$LOW)))
-   :RULE-CLASSES :TYPE-PRESCRIPTION)
-
- (LOCAL
-  (DEFUN $$LOOP_3$ADJ (Y+ I)
-    (DECLARE (IGNORE I))
-    Y+))
-
- (DEFTHM AG-$$LOOP_3$ADJ
-   (IMPLIES (AND (NATP I)
-                 (NATP J)
-                 (NOT (EQUAL I J))
-                 (>= I ($$LOOP_3$LOW))
-                 (>= J ($$LOOP_3$LOW))
-                 (< I ($$LOOP_3$HIGH))
-                 (< J ($$LOOP_3$HIGH)))
-            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
-                   (AG J Y+)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
-
- (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
-   (IMPLIES (AND (NATP I)
-                 (>= I ($$LOOP_3$low))
-                 (NATP J)
-                 (>= J ($$LOOP_3$low))
-                 (< I ($$LOOP_3$HIGH))
-                 (< J ($$LOOP_3$HIGH))
-                 (<= J I))
-            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
-                                       J))
-                   (AG J ($$LOOP_3$ADJ Y+ J))))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
-
-(DEFUN $$LOOP_3 (Y+ I)
-  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
-  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
-      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
-                (- I 1))
-      Y+))
-
-(DEFTHM AG-$$LOOP_3
-  (IMPLIES (AND (NATP I)
-                (NATP J)
-                (>= I ($$LOOP_3$LOW))
-                (>= J ($$LOOP_3$LOW))
-                (< I ($$LOOP_3$HIGH))
-                (< J ($$LOOP_3$HIGH)))
-           (EQUAL (AG J ($$LOOP_3 Y+ I))
-                  (IF (>= I J)
-                      (AG J ($$LOOP_3$ADJ Y+ J))
-                      (AG J Y+)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Miscellany
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;not in support/simple-loop-helpers since would be redefined here (which is illegal)
-
-(deftheory simple-loop-thy-0
-  (union-theories '(if1) (theory 'minimal-theory)))
-
-(deftheory simple-loop-thy-1
-  (union-theories
-   '(bitn-setbitn-not-equal
-     ag-diff-as
-     bits-31-0
-     natp)
-   (theory 'simple-loop-thy-0)))
-
-(in-theory (enable setbits))
diff -Nru acl2-6.2/books/rtl/rel5/lib/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel5/lib/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel5/lib/simplify-model-helpers.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,83 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(include-book "rtl")
-(include-book "arith")
-(include-book "bits")
-(local (include-book "../support/simplify-model-helpers"))
-
-(defthm equal-log=-0
-  (equal (equal (log= k x)
-                0)
-         (not (equal k x))))
-
-(defthm equal-log=-1 ; possibly not needed
-  (equal (equal (log= k x)
-                1)
-         (equal k x)))
-
-(defthm equal-lnot-0
-  (implies (bvecp x 1)
-           (equal (equal (lnot x 1) 0)
-                  (equal x 1))))
-
-(defthm equal-lnot-1 ; possibly not needed
-  (implies (bvecp x 1)
-           (equal (equal (lnot x 1) 1)
-                  (equal x 0))))
-
-(defthm bits-if
-  (equal (bits (if x y z) i j)
-         (if x (bits y i j) (bits z i j))))
-
-(defthm bitn-if
-  (equal (bitn (if x y z) i)
-         (if x (bitn y i) (bitn z i))))
-
-(defthm bits-if1
-  (equal (bits (if1 x y z) i j)
-         (if1 x (bits y i j) (bits z i j))))
-
-(defthm bitn-if1
-  (equal (bitn (if1 x y z) i)
-         (if1 x (bitn y i) (bitn z i))))
-
-(defthm log=-0-rewrite
-  (implies (bvecp k 1)
-           (equal (log= 0 k)
-                  (lnot k 1))))
-
-(defthm log=-1-rewrite
-  (implies (bvecp k 1)
-           (equal (log= 1 k)
-                  k)))
-
-(defthm log<>-is-lnot-log=
-  (equal (log<> x y) (lnot (log= x y) 1)))
-
-(defthm cat-combine-constants
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep m)
-                              (quotep y)
-                              (quotep n)))
-                (equal (+ n p) r)
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 p))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p)))
-           (equal (cat x m (cat y n z p) r)
-                  (cat (cat x m y n) (+ m n) z p))))
-
-(defthm bvecp-if
-  (equal (bvecp (if test x y) k)
-         (if test (bvecp x k) (bvecp y k))))
-
-; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
-
-; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
-; say, even though sig is a single bit.  So we add the following.
-
-(in-theory (enable bvecp-monotone))
diff -Nru acl2-6.2/books/rtl/rel5/lib/top.lisp acl2-6.3/books/rtl/rel5/lib/top.lisp
--- acl2-6.2/books/rtl/rel5/lib/top.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/top.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-; Optionally, one may wish to consider:
-; (include-book "misc/rtl-untranslate" :dir :system)
-; to inhibit expansion of macros in proof output.
-
-; We deliberately exclude any *-helpers.lisp books that may appear here.
-
-(include-book "rtl") ;semantics of the basic RTL primitives
-
-(include-book "rtlarr") ;semantics RTL array primitives
-
-(include-book "basic") ;properties of basic arithmetic functions: floor, ceiling, 
-;                       exponential, and remainder
-
-(include-book "bits") ;bit vectors
-
-(include-book "log") ;logical operations
-
-(include-book "float") ;floating-point numbers
-
-(include-book "reps") ;floating-point formats and representations
-
-(include-book "round") ;floating-point rounding
-
-(include-book "add") ;support for reasoning about floating-point addition
-;                      (leading one prediction and sticky bit computation)
-
-; Users may prefer to replace the (include-book "arith") below with:
-; (include-book "../arithmetic/top")
-(include-book "arith") ;general arithmetic package
-
-(include-book "util") ;misc helpful stuff including a few macros
diff -Nru acl2-6.2/books/rtl/rel5/lib/util.lisp acl2-6.3/books/rtl/rel5/lib/util.lisp
--- acl2-6.2/books/rtl/rel5/lib/util.lisp	2013-06-06 17:11:52.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/lib/util.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,127 +0,0 @@
-(in-package "ACL2")
-
-(set-enforce-redundancy t)
-
-(local (include-book "../support/util"))
-
-;;These macros facilitate localization of events:
-
-(defmacro local-defun (&rest body)
-  (list 'local (cons 'defun body)))
-
-(defmacro local-defund (&rest body)
-  (list 'local (cons 'defund body)))
-
-(defmacro local-defthm (&rest body)
-  (list 'local (cons 'defthm body)))
-
-(defmacro local-defthmd (&rest body)
-  (list 'local (cons 'defthmd body)))
-
-(defmacro local-in-theory (&rest body)
-  (cons 'local
-	(cons (cons 'in-theory (append body 'nil))
-	      'nil)))
-
-(defmacro defbvecp (name formals width &key thm-name hyp hints)
-  (let* ((thm-name
-          (or thm-name
-              (intern-in-package-of-symbol
-               (concatenate 'string
-                            (if (consp width)
-                                "BV-ARRP$"
-                              "BVECP$")
-                            (symbol-name name))
-               name)))
-         (x (cons name formals))
-         (typed-term (if (consp width)
-                         (list 'ag 'index x)
-                       x))
-         (bvecp-concl (if (consp width)
-                          (list 'bv-arrp x (car (last width)))
-                        (list 'bvecp x width)))
-         (concl (list 'and
-                      (list 'integerp typed-term)
-                      (list '<= 0 typed-term))))
-    (list* 'defthm thm-name
-           (if hyp
-               (list 'implies hyp bvecp-concl)
-             bvecp-concl)
-           :rule-classes
-           (list
-            :rewrite
-            (list :forward-chaining :trigger-terms (list x))
-            (list :type-prescription
-                  :corollary
-                  (if hyp
-                      (list 'implies hyp concl)
-                    concl)
-                  :typed-term typed-term
-                  ;; hints for the corollary 
-                  :hints
-                  (if (consp width)
-                      '(("Goal"
-                         :in-theory
-                         '(implies bvecp
-                                   bv-arrp-implies-nonnegative-integerp)))
-                    '(("Goal"
-                       :in-theory
-                       '(implies bvecp))))))
-           (if hints (list :hints hints) nil))))
-
-(defun sub1-induction (n)
-      (if (zp n)
-          n
-        (sub1-induction (1- n))))
-
-; These will be the functions to disable in acl2 proofs about signal bodies.
-; We use this in the compiler.
-;BOZO This doesn't include cons, which can now appear in signals defs.  I think that's okay, right?  think
-;about this and remove the BOZO
-(defconst *rtl-operators-after-macro-expansion*
-  '(log= log<> 
-    log< log<= log> log>= 
-    comp2< comp2<= comp2> comp2>=
-    land lior lxor lnot
-    logand1 logior1 logxor1
-    shft
-    cat mulcat
-    bits bitn setbits setbitn 
-    ag as
-    * + ; from macroexpansion of mod* or mod+
-    ;mod- ;now a macro!
-    floor rem decode encode
-    ;; bind ; handled specially in fixup-term
-    ;; if1 ;  a macro, so we don't disable it
-    ;; quote, n!, arr0 ; handled specially in fixup-term
-    natp1 ; doesn't matter, only occurs in for-loop defuns (must be enabled in those proofs anyway)
-    mk-bvarr mk-bvec
-    ))
-
-; Macro fast-and puts conjunctions in a tree form, which can avoid stack
-; overflows by ACL2's translate functions.
-
-(defun split-list (lst lo hi)
-  (cond ((endp lst) 
-         (mv lo hi))
-        ((endp (cdr lst)) 
-         (mv (cons (car lst) lo) hi))
-        (t
-         (split-list (cddr lst)
-                     (cons (car lst) lo)
-                     (cons (cadr lst) hi)))))
-
-(defun fast-and-fn (conjuncts)
-  (declare (xargs :mode :program))
-  (cond ((endp conjuncts) ''t)
-        ((endp (cdr conjuncts)) (car conjuncts))
-        (t
-         (mv-let (hi lo)
-             (split-list conjuncts () ())
-           (list 'if
-                 (fast-and-fn hi)
-                 (fast-and-fn lo)
-                 'nil)))))
-
-(defmacro fast-and (&rest conjuncts)
-  (fast-and-fn conjuncts))
diff -Nru acl2-6.2/books/rtl/rel5/support/Makefile acl2-6.3/books/rtl/rel5/support/Makefile
--- acl2-6.2/books/rtl/rel5/support/Makefile	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-include ../../../Makefile-generic
--include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel5/support/README acl2-6.3/books/rtl/rel5/support/README
--- acl2-6.2/books/rtl/rel5/support/README	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/README	1970-01-01 00:00:00.000000000 +0000
@@ -1,7 +0,0 @@
-See the comments in top.lisp.
-See also ../README
-
-Some of the books and lemmas which used to be in support/ have been moved to arithmetic/.
-
-This directory is still a mess (all our gross hacks are in support/), but we are gradually burying them in
--proofs books.
diff -Nru acl2-6.2/books/rtl/rel5/support/add3-proofs.lisp acl2-6.3/books/rtl/rel5/support/add3-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/add3-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/add3-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,419 +0,0 @@
-(in-package "ACL2")
-
-(include-book "merge")
-(local (include-book "bitn"))
-(local (include-book "bits"))
-(local (include-book "../arithmetic/top"))
-;(local (include-book "../arithmetic/mod"))
-
-(defun add3-measure (x y z)
-  (acl2-count (+ x y z)))
-
-(defthm add3-1
-    (implies (and (integerp x)
-		  (> x 0))
-	     (and (>= (fl (/ x 2)) 0)
-		  (< (fl (/ x 2)) x)))
-  :rule-classes ())
-
-(defthm recursion-by-add3-measure
-    (IMPLIES (AND (INTEGERP X)
-		  (<= 0 X)
-		  (INTEGERP Y)
-		  (<= 0 Y)
-		  (INTEGERP Z)
-		  (<= 0 Z)
-		  (NOT (AND (EQUAL X 0)
-			    (EQUAL Y 0)
-			    (EQUAL Z 0))))
-	     (e0-ord-< (ADD3-MEASURE (FL (* 1/2 x))
-				     (FL (* 1/2 y))
-				     (FL (* 1/2 z)))
-		       (ADD3-MEASURE X Y Z)))
-  :hints (("Goal" :use ((:instance add3-1)
-			(:instance add3-1 (x y))
-			(:instance add3-1 (x z))))))
-
-(in-theory (disable add3-measure))
-
-(include-book "ordinals/e0-ordinal" :dir :system)
-(set-well-founded-relation e0-ord-<)
-
-(defun add3-induct (x y z)
-  (declare (xargs :measure (add3-measure x y z)))
-  (if (and (integerp x) (>= x 0)
-	   (integerp y) (>= y 0)
-	   (integerp z) (>= z 0))
-      (if (and (= x 0) (= y 0) (= z 0))
-	  ()
-	(add3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
-    ()))
-
-(in-theory (disable logand logior logxor))
-
-(defthm add3-2
-    (implies (and (INTEGERP X)
-;		  (<= 0 X)
-		  (INTEGERP Y)
-;		  (<= 0 Y)
-		  (INTEGERP Z)
-	;	  (<= 0 Z)
-                  )
-	     (= (LOGXOR (FL (* X 1/2))
-			(LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
-		(fl (/ (logxor x (logxor y z)) 2))))
-  :rule-classes())
-
-(defthm add3-3
-    (implies (and (INTEGERP X)
-;		  (<= 0 X)
-		  (INTEGERP Y)
-	;	  (<= 0 Y)
-		  (INTEGERP Z)
-		;  (<= 0 Z)
-                  )
-	     (= (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
-			(LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
-				(LOGAND (FL (* Y 1/2)) (FL (* Z 1/2)))))
-		(fl (/ (logior (logand x y)
-			       (logior (logand x z) (logand y z)))
-		       2))))
-  :rule-classes())
-
-(defthm add3-4
-    (IMPLIES (AND (INTEGERP X)
-;		  (<= 0 X)
-		  (INTEGERP Y)
-;		  (<= 0 Y)
-		  (INTEGERP Z)
-;		  (<= 0 Z)
-;		  (NOT (AND (= X 0) (= Y 0) (= Z 0)))
-		  (IMPLIES (AND (INTEGERP (FL (* X 1/2)))
-;				(<= 0 (FL (* X 1/2)))
-				(INTEGERP (FL (* Y 1/2)))
-;				(<= 0 (FL (* Y 1/2)))
-				(INTEGERP (FL (* Z 1/2)))
-	;			(<= 0 (FL (* Z 1/2)))
-                                )
-			   (= (+ (FL (* X 1/2))
-				 (FL (* Y 1/2))
-				 (FL (* Z 1/2)))
-			      (+ (LOGXOR (FL (* X 1/2))
-					 (LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
-				 (* 2
-				    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
-					    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
-						    (LOGAND (FL (* Y 1/2))
-							    (FL (* Z 1/2))))))))))
-	     (= (+ (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)))
-		(+ (fl (/ (logxor x (logxor y z)) 2))
-		   (* 2 (fl (/ (logior (logand x y) (logior (logand x z) (logand y z))) 2))))))
-  :rule-classes ()
-  :hints (("Goal" :use (add3-2 add3-3))))
-
-(defthm add3-5
-    (IMPLIES (AND (INTEGERP X)
-;		  (<= 0 X)
-		  (INTEGERP Y)
-	;	  (<= 0 Y)
-		  (INTEGERP Z)
-;		  (<= 0 Z)
-                  )
-	     (= (fl (/ (+ (bitn x 0) (bitn y 0) (bitn z 0)) 2))
-		(bitn (logior (logand x y) (logior (logand x z) (logand y z))) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-logior)
-           :use ((:instance bitn-0-1 (n 0))
-			(:instance bitn-0-1 (n 0) (x y))
-			(:instance bitn-0-1 (n 0) (x z))
-			(:instance bitn-0-1 (n 0))
-                        ))))
-
-(defthm add3-6
-    (IMPLIES (AND (INTEGERP X)
-		;  (<= 0 X)
-		  (INTEGERP Y)
-;		  (<= 0 Y)
-		  (INTEGERP Z)
-;		  (<= 0 Z)
-                  )
-	     (= (bitn (+ x y z) 0)
-		(bitn (logxor x (logxor y z)) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance bitn-logxor-0 (a x) (b (+ y z)))
-			(:instance bitn-logxor-0 (a y) (b z))
-			(:instance bitn-logxor (n 0) (y (+ y z)))
-			(:instance bitn-logxor (n 0) (y (logxor y z)))
-	;		(:instance logxor-nat (i y) (j z))
-                        ))))
-
-(defthm add3-7
-    (IMPLIES (AND (INTEGERP X)
-;		  (<= 0 X)
-		  (INTEGERP Y)
-;		  (<= 0 Y)
-		  (INTEGERP Z)
-	;	  (<= 0 Z)
-                  )
-	     (= (fl (/ (+ x y z) 2))
-		(fl (+ (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)) (/ (+ (bitn x 0) (bitn y 0) (bitn z 0)) 2)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-def)
-		  :use ((:instance quot-mod (n 2) (m x))
-			(:instance quot-mod (n 2) (m y))
-			(:instance quot-mod (n 2) (m z))))))
-
-(defthm add3-8
-    (IMPLIES (AND (INTEGERP X)
-;		  (<= 0 X)
-		  (INTEGERP Y)
-	;	  (<= 0 Y)
-		  (INTEGERP Z)
-		;  (<= 0 Z)
-                  )
-	     (= (fl (/ (+ x y z) 2))
-		(+ (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))
-		   (fl (/ (+ (bitn x 0) (bitn y 0) (bitn z 0)) 2)))))
-  :rule-classes ()
-  :hints (("Goal" :use (add3-7
-			(:instance fl+int-rewrite
-				   (x (/ (+ (bitn x 0) (bitn y 0) (bitn z 0)) 2))
-				   (n (+ (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)))))))))
-
-(defthm add3-9
-    (IMPLIES (AND (INTEGERP X)
-;		  (<= 0 X)
-		  (INTEGERP Y)
-	;	  (<= 0 Y)
-		  (INTEGERP Z)
-		;  (<= 0 Z)
-;		  (NOT (AND (= X 0) (= Y 0) (= Z 0)))
-		  (IMPLIES (AND (INTEGERP (FL (* X 1/2)))
-			;	(<= 0 (FL (* X 1/2)))
-				(INTEGERP (FL (* Y 1/2)))
-				;(<= 0 (FL (* Y 1/2)))
-				(INTEGERP (FL (* Z 1/2)))
-;(<= 0 (FL (* Z 1/2)))
-                                )
-			   (= (+ (FL (* X 1/2))
-				 (FL (* Y 1/2))
-				 (FL (* Z 1/2)))
-			      (+ (LOGXOR (FL (* X 1/2))
-					 (LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
-				 (* 2
-				    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
-					    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
-						    (LOGAND (FL (* Y 1/2))
-							    (FL (* Z 1/2))))))))))
-	     (= (fl (/ (+ x y z) 2))
-		(+ (fl (/ (logxor x (logxor y z)) 2))
-		   (* 2 (fl (/ (logior (logand x y) (logior (logand x z) (logand y z))) 2)))
-		   (bitn (logior (logand x y) (logior (logand x z) (logand y z))) 0))))
-  :rule-classes ()
-  :hints (("Goal" :use (add3-4 add3-5 add3-8))))
-
-(defthm add3-10
-    (IMPLIES (AND (INTEGERP X)
-	;	  (<= 0 X)
-		  (INTEGERP Y)
-;		  (<= 0 Y)
-		  (INTEGERP Z)
-	;	  (<= 0 Z)
-;		  (NOT (AND (= X 0) (= Y 0) (= Z 0)))
-		  (IMPLIES (AND (INTEGERP (FL (* X 1/2)))
-;				(<= 0 (FL (* X 1/2)))
-				(INTEGERP (FL (* Y 1/2)))
-;				(<= 0 (FL (* Y 1/2)))
-				(INTEGERP (FL (* Z 1/2)))
-	;			(<= 0 (FL (* Z 1/2)))
-                                )
-			   (= (+ (FL (* X 1/2))
-				 (FL (* Y 1/2))
-				 (FL (* Z 1/2)))
-			      (+ (LOGXOR (FL (* X 1/2))
-					 (LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
-				 (* 2
-				    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
-					    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
-						    (LOGAND (FL (* Y 1/2))
-							    (FL (* Z 1/2))))))))))
-	     (= (fl (/ (+ x y z) 2))
-		(+ (fl (/ (logxor x (logxor y z)) 2))
-		   (logior (logand x y) (logior (logand x z) (logand y z))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-def)
-		  :use (add3-9
-			(:instance quot-mod
-				   (m (logior (logand x y) (logior (logand x z) (logand y z))))
-				   (n 2))
-                                   ))))
-
-(defthm add3-11
-  (IMPLIES (AND (INTEGERP X)
-                (INTEGERP Y)
-                (INTEGERP Z)
-;                (NOT (AND (= X 0) (= Y 0) (= Z 0)))
-                (IMPLIES (AND (INTEGERP (FL (* X 1/2)))
-                              (INTEGERP (FL (* Y 1/2)))
-                              (INTEGERP (FL (* Z 1/2)))
-                              )
-                         (= (+ (FL (* X 1/2))
-                               (FL (* Y 1/2))
-                               (FL (* Z 1/2)))
-                            (+ (LOGXOR (FL (* X 1/2))
-                                       (LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
-                               (* 2
-                                  (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
-                                          (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
-                                                  (LOGAND (FL (* Y 1/2))
-                                                          (FL (* Z 1/2))))))))))
-           (= (+ X Y Z)
-              (+ (LOGXOR X (LOGXOR Y Z))
-                 (* 2
-                    (LOGIOR (LOGAND X Y)
-                            (LOGIOR (LOGAND X Z)
-                                    (LOGAND Y Z)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-def)
-           :use (add3-10
-                 add3-6
-                 (:instance quot-mod (n 2) (m (+ x y z)))
-;			(:instance logxor-nat (i x) (j (logxor y z)))
-;		(:instance logxor-nat (i y) (j z))
-                 (:instance quot-mod (n 2) (m (logxor x (logxor y z))))))))
-
-
-;begin Eric's additions
-(defun add3-measure-neg (x y z)
-  (acl2-count (+ (abs x) (abs y) (abs z))))
-
-(local (include-book "../arithmetic/arith2"))
-
-(defthm fl-sum-non-neg
-  (implies (and (<= 0 x)
-                (<= 0 y)
-                (<= 0 z)
-                (rationalp x)
-                (rationalp y)
-                (rationalp z)
-                )
-           (<= 0 
-           (+ (FL (* 1/2 X))
-              (FL (* 1/2 Y))
-              (FL (* 1/2 Z))))))
-
-#|
-(defthm add3-1-neg
-    (implies (and (integerp x)
-		  (< x 0))
-	     (and (<= (fl (/ x 2)) 0)
-		  (>= (fl (/ x 2)) x)))
-  :rule-classes ())
-|#
-
-;BOZO contains the seed of a nice rule?
-(defthm add3-1-neg-2
-    (implies (and (< x 0)
-                  (integerp x)
-		  )
-	     (and (<= (fl (* 1/2 x)) 0)
-		  (>= (fl (* 1/2 x)) x)))
-  :rule-classes :linear)
-
-
-
-;why so many cases?
-(defthm recursion-by-add3-measure-neg
-    (IMPLIES (AND (INTEGERP X)
-		  (INTEGERP Y)
-		  (INTEGERP Z)
-		  (not (and (or (EQUAL X 0) (EQUAL X -1))
-                            (or (EQUAL y 0) (EQUAL y -1))
-                            (or (EQUAL z 0) (EQUAL z -1))
-                       )))
-	     (e0-ord-< (ADD3-MEASURE-neg (FL (* 1/2 x))
-                                         (FL (* 1/2 y))
-                                         (FL (* 1/2 z)))
-		       (ADD3-MEASURE-neg X Y Z)))
-    :otf-flg t
-  :hints (("Goal" :in-theory (disable ;FL-STRONG-MONOTONE ;BOZO these disables are unfortunate..
-                                      ;FL-WEAK-MONOTONE
-;                                      FL-<=-Y
-                        ;              FL->-INTEGER ;for efficiency
-                         ;             fl-<-integer
-                                      ;fl-def-linear-part-1
-                                      )
-           
-           :use (;(:instance add3-1-neg) ;BOZO if these are put back, things get really slow..
-                 ;(:instance add3-1-neg (x y))
-                 ;(:instance add3-1-neg (x z))
-                 ))))
-
-(DEFUN ADD3-INDUCT-allow-negatives (X Y Z)
-  (DECLARE (XARGS   :hints (("Goal" :use recursion-by-add3-measure-neg
-                             ))
-                    :MEASURE (ADD3-MEASURE-neg X Y Z)))
-  (IF (AND (INTEGERP X)
-           (INTEGERP Y)
-           (INTEGERP Z)
-           )
-      (IF (and (or (EQUAL X 0) (EQUAL X -1))
-               (or (EQUAL y 0) (EQUAL y -1))
-               (or (EQUAL z 0) (EQUAL z -1))
-               )
-          NIL
-          (ADD3-INDUCT-allow-negatives
-           (FL (/ X 2))
-           (FL (/ Y 2))
-           (FL (/ Z 2))))
-      NIL)
-
-  )
-
-
-(defthm add-3-old
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp z)
-                )
-           (equal (+ x y z)
-                  (+ (logxor x (logxor y z))
-                     (* 2 (logior (logand x y)
-                                  (logior (logand x z)
-                                          (logand y z)))))))
-  :rule-classes ()
-  :hints (("Goal" :induct (ADD3-INDUCT-allow-negatives x y z))
-	  ("Subgoal *1/2" :use (add3-11))))
-
-(include-book "land0")
-(include-book "lior0")
-(include-book "lxor0")
-
-(in-theory (enable bits-tail))
-
-(defthm add-3-original
-  (implies (and (not (zp n))
-                (bvecp x n)
-                (bvecp y n)
-                (bvecp z n))
-           (equal (+ x y z)
-                  (+ (lxor0 x (lxor0 y z n) n)
-                     (* 2 (lior0 (land0 x y n)
-                                (lior0 (land0 x z n)
-                                      (land0 y z n)
-                                      n)
-                                n)))))
-  :rule-classes ()
-  :hints (("Goal" :use (add-3-old)
-           :in-theory (enable lxor0 lior0 land0 bvecp))))
-
-(defthm add-2-original
-  (implies (and (not (zp n))
-                (bvecp x n)
-                (bvecp y n))
-           (equal (+ x y)
-                  (+ (lxor0 x y n)
-                     (* 2 (land0 x y n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use ((:instance add-3-original (z 0))))))
diff -Nru acl2-6.2/books/rtl/rel5/support/add3.lisp acl2-6.3/books/rtl/rel5/support/add3.lisp
--- acl2-6.2/books/rtl/rel5/support/add3.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/add3.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-(in-package "ACL2")
-
-(include-book "merge") ;BOZO yuck
-(local (include-book "add3-proofs"))
-
-(defund add3-measure (x y z)
-  (acl2-count (+ x y z)))
-
-(defthm add3-1
-  (implies (and (integerp x)
-                (> x 0))
-           (and (>= (fl (/ x 2)) 0)
-                (< (fl (/ x 2)) x)))
-  :rule-classes ())
-
-(include-book "land0")
-(include-book "lior0")
-(include-book "lxor0")
-
-(in-theory (enable bits-tail)) ;BOZO
-
-(defthm add-3-original
-  (implies (and (not (zp n))
-                (bvecp x n)
-                (bvecp y n)
-                (bvecp z n))
-           (equal (+ x y z)
-                  (+ (lxor0 x (lxor0 y z n) n)
-                     (* 2 (lior0 (land0 x y n)
-                                (lior0 (land0 x z n)
-                                      (land0 y z n)
-                                      n)
-                                n)))))
-  :rule-classes ())
-
-(defthm add-2-original
-  (implies (and (not (zp n))
-                (bvecp x n)
-                (bvecp y n))
-           (equal (+ x y)
-                  (+ (lxor0 x y n)
-                     (* 2 (land0 x y n)))))
-  :rule-classes ())
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/all-ones.lisp acl2-6.3/books/rtl/rel5/support/all-ones.lisp
--- acl2-6.2/books/rtl/rel5/support/all-ones.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/all-ones.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,19 +0,0 @@
-(in-package "ACL2")
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(defthm all-ones-of-non-integer
-  (implies (not (integerp n))
-           (equal (all-ones n)
-                  0))
-  :hints (("Goal" :in-theory (enable all-ones))))
-
-(defthm all-ones-of-negative
-  (implies (< n 0)
-           (equal (all-ones n)
-                  0))
-  :hints (("Goal" :in-theory (enable all-ones))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/ash.lisp acl2-6.3/books/rtl/rel5/support/ash.lisp
--- acl2-6.2/books/rtl/rel5/support/ash.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/ash.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,60 +0,0 @@
-(in-package "ACL2")
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(include-book "ground-zero")
-(local (include-book "../arithmetic/fl"))
-(local (include-book "../arithmetic/expt"))
-(local (include-book "../arithmetic/expo"))
-
-;change params on lemmas in this book to match those on ash?
-
-#|(defun ash (i c)
-(FLOOR (BINARY-* (IFIX I) (EXPT '2 C))
-       '1))
-|#
-
-;(thm (rationalp (ash x n))) goes through?
-
-;the (ash 1 x) form shows up in the function decode
-(defthm bvecp-ash-1
-  (implies (and (case-split (< x n))
-                (case-split (integerp n))
-                (case-split (integerp x))
-                )
-           (bvecp (ASH 1 x) n))
-  :hints (("Goal" :in-theory (enable ash bvecp floor))))
-
-;is this dumb?
-(defthmd ash-rewrite
-    (implies (integerp n)
-	     (equal (ash n i)
-		    (fl (* n (expt 2 i)))))
-    :hints (("Goal" :in-theory (enable ash))))
-
-(defthm ash-nonnegative
-  (implies (<= 0 i)
-           (<= 0 (ash i c)))
-  :hints (("Goal" :in-theory (enable ash))))
-
-(defthm ash-nonnegative-type
-  (implies (<= 0 i)
-           (and (rationalp (ash i c))
-                (<= 0 (ash i c))))
-  :rule-classes ( :type-prescription)
-  :hints (("Goal" :in-theory (enable ash))))
-
-(defthm ash-with-c-non-integer
-  (implies (not (integerp c))
-           (equal (ash i c)
-                  (ifix i)))
-  :hints (("Goal" :in-theory (enable ash))))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/away-proofs.lisp acl2-6.3/books/rtl/rel5/support/away-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/away-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/away-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1543 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-(in-package "ACL2")
-
-(local (include-book "trunc"))
-(local (include-book "../arithmetic/top"))
-(local (include-book "float"))
-
-;; Necessary defuns
-
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund power2p-measure (x)
-  (declare (xargs :guard (and (rationalp x) (not (equal x 0)))))
-  (cond ((or (not (rationalp x))
-             (<= x 0)) 0)
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund power2p (x)
-  (declare (xargs :guard t
-                  :measure (power2p-measure x)
-                  :hints (("goal" :in-theory (enable power2p-measure)))))
-  (cond ((or (not (rationalp x))
-             (<= x 0))
-         nil)
-        ((< x 1) (power2p (* 2 x)))
-        ((<= 2 x) (power2p (* 1/2 x)))
-        ((equal x 1) t)
-        (t nil) ;got a number in the doubly-open interval (1,2)
-        ))
-
-
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;; Start of new stuff
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;generated automatically by ACL2 when we define away, but included here just to be safe
-;could disabled (:type-prescription away) for slight efficiency gain at the cost of making the output of :pe a
-;little deceptive
-(defthm away-rational-type-prescription
-  (rationalp (away x n))
-  :rule-classes :type-prescription)
- 
-(defthm away-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (away x n)
-                  0))
-  :hints (("goal" :in-theory (enable away sig))))
-
-;make alt version? use negative-syntaxp?
-(defthm away-minus
-  (= (away (* -1 x) n)
-     (* -1 (away x n)))
-  :hints (("Goal" :in-theory (enable away))))
-
-(defthm away-positive
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                )
-           (< 0 (away x n)))
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :in-theory (enable away cg)
-           :use (;(:instance sig-lower-bound)
-                 ))))
-
-(defthm away-positive-rational-type-prescription
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                )
-           (and (< 0 (away x n))
-                (rationalp (away x n))))
-  :rule-classes :type-prescription)
-
-(defthm away-negative
-    (implies (and (< x 0)
-                  (case-split (rationalp x))
-                  )
-	     (< (away x n) 0))
-    :rule-classes (:rewrite :linear)
-    :hints (("Goal" :in-theory (e/d (away) (sig-lower-bound SIG-LESS-THAN-1-MEANS-X-0))
-             :use ((:instance sig-lower-bound)))))
-
-(defthm away-negative-rational-type-prescription
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                )
-           (< (away x n) 0))
-  :rule-classes :type-prescription)
-
-(defthm away-0
-  (equal (away 0 n)
-         0)
-  :hints (("Goal" :in-theory (enable away))))
-
-(defthm away-non-negative-rational-type-prescription
-  (implies (<= 0 x)
-           (and (<= 0 (away x n))
-                (rationalp (away x n))))
-  :hints (("Goal" :cases ((or (not (rationalp x)) (equal x 0)))))
-  :rule-classes :type-prescription)
-
-(defthm away-non-positive-rational-type-prescription
-  (implies (<= x 0)
-           (and (<= (away x n) 0)
-                (rationalp (away x n))))
-  :hints (("Goal" :cases ((or (not (rationalp x)) (equal x 0)))))
-  :rule-classes :type-prescription)
-
-(defthm away-equal-0-rewrite
-  (implies (rationalp x)
-           (equal (equal (away x n) 0)
-                  (equal x 0)))
-  :hints (("Goal" :cases ((< x 0) (equal x 0) (< 0 x)))))
-
-(defthm sgn-away
-  (equal (sgn (away x n))
-         (sgn x)))
-
-;keep this disabled, since it basically opens up AWAY
-(defthmd abs-away
-  (implies (and (rationalp x)
-                (integerp n))
-           (equal (abs (away x n))
-                  (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
-  :hints (("Goal" :in-theory (enable away sig)))) ;why enable sig?
-
-;kind of gross...
-(defthm away-to-0-or-fewer-bits
-  (implies (and (<= n 0)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (away x n)
-                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n))))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable away expt-split
-;                                     expt ;yuck
-                                     )
-                              '())
-           :use ((:instance cg-unique
-                            (x (* 1/2 (SIG X) (EXPT 2 N)))
-                            (n 1))
-;                 sig-upper-bound
-                 sig-lower-bound
-                 (:instance expt-weak-monotone
-                            (n n)
-                            (m 0))
-                 (:instance expt-strong-monotone
-                            (n 0)
-                            (m n))))))
-
-(defthm away-lower-bound
-    (implies (and (case-split (rationalp x))
-		  (case-split (integerp n))
-                  )
-	     (>= (abs (away x n)) (abs x)))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (enable away sig
-                                     expt-split
-                                     expt-minus
-                                     )
-		  :use (away-to-0-or-fewer-bits
-                        (:instance cg-def-linear (x (* (expt 2 (1- n)) (sig x))))
-;			(:instance fp-abs)
-                        ))))
-(defthm away-lower-pos
-    (implies (and (>= x 0)
-                  (case-split (rationalp x))
-		  (case-split (integerp n))
-                  )
-	     (>= (away x n) x))
-  :rule-classes :linear
-  :hints (("Goal" :use ((:instance away-lower-bound)))))
-
-;elim?
-(defthm expo-away-lower-bound
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (>= (expo (away x n)) (expo x)))
-  :rule-classes :linear
-  :hints (("Goal"
-           :use ((:instance away-lower-bound)
-;                 (:instance away-0-0)
-                 (:instance expo-monotone (y (away x n)))))))
-
-(local
-   (defthm trunc-lower-1-2
-     (implies (and (rationalp u)
-                   (rationalp v)
-                   (rationalp r)
-                   (> r 0)
-                   (< u (1+ v)))
-              (< (* r u) (* r (1+ v))))
-     :rule-classes ()))
-
-;gross..
-(defthm trunc-lower-1-3
-    (implies (and (rationalp u)
-                  (rationalp v)
-                  (rationalp r)
-                  (> r 0)
-                  (< u (1+ v)))
-             (< (* r u) (+ r (* r v))))
-    :rule-classes ()
-    :hints (("goal" :in-theory (disable *-strongly-monotonic)
-             :use ((:instance trunc-lower-1-2)))))
-
-(defthm away-upper-1
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (enable abs-away
-                                      expt-split
-                                      expt-minus
-                                      sig)
-           :use (;(:instance trunc-lower-1-1)
-                 (:instance fp-abs)
-                 (:instance trunc-lower-1-3
-                            (u (* (sig x) (expt 2 (1- n))))
-                            (v (fl (* (sig x) (expt 2 (1- n)))))
-                            (r (expt 2 (- (1+ (expo x)) n))))
-                 (:instance cg-def-linear (x (* (expt 2 (1- n)) (sig x))))))))
-
-(defthm away-upper-2
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (integerp n)
-                (> n 0))
-           (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (disable abs)
-           :use ((:instance away-upper-1)
-                 (:instance trunc-lower-2-1)))))
-
-(defthm away-upper-pos
-    (implies (and (> x 0)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (away x n) (* x (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (disable abs-pos)
-		  :use ((:instance away-upper-2)
-;			(:instance away-positive)
-                        ))))
-
-(defthm away-upper-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance away-upper-1)
-;			(:instance away-0-0)
-			(:instance trunc-lower-2-1)))))
-
-(defthm away-diff
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes :linear
-  :hints (("Goal" :use (;(:instance trunc-diff-1 (y (away x n)))
-;			(:instance away-negative)
-	;		(:instance away-positive)
-			;(:instance away-0-0)
-			(:instance away-lower-bound)
-			(:instance away-upper-1)
-                        ))))
-
-(defthm away-diff-pos
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes :linear
-  :hints (("Goal" :use ((:instance away-diff)
-;			(:instance away-pos)
-			(:instance away-lower-bound)))))
-
-
-(defthm away-diff-expo-1
-    (implies (and (rationalp x)
-		  (not (= x (away x n)))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- (away x n) x)) (- (expo x) n)))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance away-diff)
-			(:instance expo-lower-bound (x (- (away x n) x)))
-			(:instance expt-strong-monotone 
-				   (n (expo (- (away x n) x)))
-				   (m (- (1+ (expo x)) n)))))))
-;slow
-(defthmd away-rewrite
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (equal (away x n)
-                  (* (sgn x) 
-                     (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
-                     (expt 2 (- (1+ (expo x)) n)))))
-  :hints (("Goal" :in-theory (enable away sig expt-split))))
-
-
-(local
- (defthm away-exactp-1
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (= x (* (sgn x) (* (expt 2 (- (1- n) (expo x))) (abs x)) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expt-split (r 2) (j (- (1- n) (expo x))) (i (- (1+ (expo x)) n))))))))
-
-(local
- (defthm away-exactp-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp z)
-		  (not (= x 0))
-		  (not (= z 0)))
-	     (iff (= (* x y z) (* x (cg y) z))
-		  (integerp y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable cg-int cg-integerp)
-		  :use ((:instance cg-integerp (x y))
-			(:instance *cancell (x (cg y)) (z (* x z))))))))
-
-(defthm away-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (away x n))
-		  (exactp x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2 away-rewrite expt-split expt-minus)
-		  :use ((:instance away-exactp-1)
-;			(:instance away-exactp-6)
-			(:instance away-exactp-2
-				   (x (sgn x))
-				   (y (* (expt 2 (- (1- n) (expo x))) (abs x)))
-				   (z (expt 2 (- (1+ (expo x)) n))))))))
-
-(defthm away-diff-expo
-    (implies (and (rationalp x)
-		  (not (exactp x n))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- (away x n) x)) (- (expo x) n)))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance away-diff-expo-1)
-			(:instance away-exactp-a)))))
-(local
- (defthm away-exactp-b-1    
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (> n 0))
-	     (integerp (* (* (sgn x) (cg y) (expt 2 (- (1- n) (expo x)))) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance integerp-x-y 
-				   (x (sgn x))
-				   (y (cg (* (expt 2 (- (1- n) (expo x))) (abs x)))))
-			(:instance expt-split (r 2) (j (- (1- n) (expo x))) (i (- (1+ (expo x)) n))))))))
-
-(local
- (defthm away-exactp-b-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (integerp (* (away x n) (expt 2 (- (1- n) (expo x))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable away-rewrite)
-                              '( sgn))
-		  :use ((:instance away-exactp-b-1 (y (* (expt 2 (- (1- n) (expo x))) (abs x)))))))))
-
-(local
- (defthm away-exactp-b-3
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (* (expt 2 (1- n)) (sig x)) (expt 2 n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (expt-split) (SIG-UPPER-BOUND
-                                               ))
-		  :use ((:instance sig-upper-bound)
-			(:instance expt-split (r 2) (j (1- n)) (i 1)))))))
-(local
- (defthm away-exactp-b-4
-    (implies (and (rationalp c)
-		  (integerp n)
-		  (integerp m)
-		  (<= c (expt 2 n)))
-	     (<= (* c (expt 2 (- m n))) (expt 2 m)))
-    :hints (("Goal" :in-theory (enable expt-split expt-minus)))
-  :rule-classes ()))
-
-(local
- (defthm away-exactp-b-5
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable abs-away)
-                              '( abs))
-		  :use ((:instance away-exactp-b-3)
-			(:instance away-exactp-b-4 (c (cg (* (sig x) (expt 2 (1- n))))) (m (1+ (expo x))))
-			(:instance n>=cg-linear (n (expt 2 n)) (x (* (expt 2 (1- n)) (sig x)))))))))
-
-(local
- (defthm away-exactp-b-6
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0)
-		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
-	     (<= (expo (away x n)) (expo x)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance away-exactp-b-5)
-			(:instance expo-lower-bound (x (away x n)))
-;			(:instance away-0-0)
-			(:instance expt-strong-monotone (n (expo (away x n))) (m (1+ (expo x)))))))))
-
-(local
- (defthm away-exactp-b-7
-   (implies (and (rationalp x)
-                 (not (= x 0))
-                 (integerp n)
-                 (> n 0)
-                 (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
-            (exactp (away x n) n))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (disable abs)
-            :use ((:instance away-exactp-b-2)
-                  (:instance away-exactp-b-6)
-;                  (:instance away-0-0)
-                  (:instance exactp->=-expo (x (away x n)) (e (expo x))))))))
-
-(local
- (defthm away-exactp-b-9
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (integerp m)
-                 (> m 0)
-                 (= (abs x) (expt 2 n)))
-            (exactp x m))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable exactp2)
-            :use (;(:instance away-exactp-b-8)
-                  (:instance exactp-2**n))))))
-
-(local
- (defthm away-exactp-b-10    
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (exactp (away x n) n))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance away-exactp-b-7)
-			(:instance away-exactp-b-9 (x (away x n)) (m n) (n (1+ (expo x))))
-                        )))))
-
-
-;gross.  keep disabled
-(defthmd away-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (away x n)
-                  (if (not (rationalp x))
-                      0
-                    (if (acl2-numberp n)
-                        (if (power2p (abs x))
-                            (sgn x)
-                        (* 2 (sgn x)))
-                      (* (sgn x) (expt 2 (+ 1 (expo x))))))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable away)))
-  )
-
-(defthm away-exactp-b
-    (implies (case-split (< 0 n)) ;can't drop this hyp
-	     (exactp (away x n) n))
-  :hints (("Goal" :in-theory (enable  away-with-n-not-an-integer)
-           :use ((:instance away-exactp-b-10)
-;			(:instance away-0-0)
-                        ))))
-
-(local
- (defthm away-exactp-c-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (>= a x)
-		  (< a (away x n)))
-	     (>= (away x n) (+ x (expt 2 (- (1+ (expo x)) n)))))
-    :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :in-theory (disable EXPT-COMPARE)
-		  :use ((:instance away-exactp-b)
-			(:instance fp+2 (x a) (y (away x n)))
-			(:instance expo-monotone (y a))
-			(:instance expt-weak-monotone (n (- (1+ (expo x)) n)) (m (- (1+ (expo a)) n))))))))
-
-(defthm away-exactp-c
-    (implies (and (exactp a n)
-		  (>= a x)
-                  (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  )
-	     (>= a (away x n)))
-  :hints (("Goal" :in-theory (disable)
-		  :use ((:instance away-exactp-c-1)
-			(:instance away-upper-1)
-			;(:instance away-positive)
-                        ))))
-
-(encapsulate
- ()
- (local (defthm away-monotone-old
-   (implies (and (rationalp x)
-                 (rationalp y)
-                 (integerp n)
-                 (> x 0)
-                 (> n 0)
-                 (<= x y))
-            (<= (away x n) (away y n)))
-   :hints (("Goal" :in-theory (disable)
-            :use ((:instance away-exactp-b (x y))
-                  (:instance away-lower-pos (x y))
-                  (:instance away-exactp-c (a (away y n))))))))
-
-;trying disabled?
- (defthmd away-monotone
-   (implies (and (rationalp x)
-                 (rationalp y)
-                 (integerp n)
-                 (<= x y))
-            (<= (away x n) (away y n)))
-   :hints (("Goal" :in-theory (disable away-upper-pos
-;                                      away-positive away-negative
-;away-to-0-or-fewer-bits
-                                       expo-monotone
-                                       away-monotone-old)
-            :cases ((> n 0)))
-           ("subgoal 2" 
-            :use ((:instance expt-weak-monotone
-                             (n (+ 1 (EXPO X) (* -1 N)))
-                             (m (+ 1 (EXPO y) (* -1 N))))
-;                 away-to-0-or-fewer-bits
-                  expo-monotone
-                  (:instance expo-monotone (x y) (y x))
-;                (:instance away-to-0-or-fewer-bits (x y))
-                  ))
-           ("subgoal 1" 
-            :use (away-monotone-old
-                  (:instance away-monotone-old (x (- y))
-                             (y (- x))))))
-   :rule-classes :linear)
- )
-
-
-
-(defthm away-exactp-d
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance away-exactp-b-5)))))
-
-(defthmd away-pos-rewrite
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n))
-           (equal (away x n)
-                  (* (cg (* (expt 2 (- (1- n) (expo x))) x))
-                     (expt 2 (- (1+ (expo x)) n)))))
-  :hints (("goal" :in-theory (enable away sgn expt-split expt-minus)
-           :use fp-abs)))
-
-(defthm expo-away
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (integerp n)
-                (> n 0)
-                (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
-           (equal (expo (away x n))
-                  (expo x)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-           :use ((:instance away-exactp-b-6)
-                 (:instance expo-monotone (y (away x n)))
-                 (:instance away-lower-bound)))))
-
-(local
- (defthm away-away-1
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (not (= (away x n) (expt 2 (1+ (expo x)))))
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (away (away x n) m)
-		(* (cg (* (expt 2 (- (1- m) (expo x)))
-			  (* (cg (* (expt 2 (- (1- n) (expo x))) x))
-			     (expt 2 (- (1+ (expo x)) n)))))
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (away-pos-rewrite expt-split expt-minus)
-                              ())
-		  :use (;(:instance away-positive)
-			(:instance expo-away))))))
-
-(local
- (defthm away-away-2
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (not (= (away x n) (expt 2 (1+ (expo x)))))
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (away (away x n) m)
-		(* (cg (* (cg (* (expt 2 (- (1- n) (expo x))) x)) (expt 2 (- m n)))) 
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt-compare-equal)
-		  :use ((:instance away-away-1)
-			(:instance expt-split (r 2) (j (- (1- m) (expo x))) (i (- (1+
-                                                                        (expo
-                                                                         x))
-                                                                       n))))))))
-
-
-(local
- (defthm away-away-3
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (not (= (away x n) (expt 2 (1+ (expo x)))))
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (away (away x n) m)
-		(* (cg (/ (cg (* (expt 2 (- (1- n) (expo x))) x)) (expt 2 (- n m)))) 
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split expt-minus)
-		  :use ((:instance away-away-2))))))
-
-(local
- (defthm away-away-4
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (not (= (away x n) (expt 2 (1+ (expo x)))))
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (away (away x n) m)
-		(* (cg (/ (* (expt 2 (- (1- n) (expo x))) x) (expt 2 (- n m)))) 
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable cg/int-rewrite)
-		  :use ((:instance away-away-3)
-			(:instance cg/int-rewrite 
-				   (x (* (expt 2 (- (1- n) (expo x))) x))
-				   (n (expt 2 (- n m)))))))))
-
-(local
- (defthm away-away-5
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (not (= (away x n) (expt 2 (1+ (expo x)))))
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (away (away x n) m)
-		(* (cg (* (expt 2 (- (1- m) (expo x))) x))
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (expt-split expt-minus) ())
-		  :use ((:instance away-away-4))))))
-
-(local
- (defthm away-away-6
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (not (= (away x n) (expt 2 (1+ (expo x)))))
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (equal (away (away x n) m)
-		    (away x m)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable away-pos-rewrite)
-		  :use ((:instance away-away-5))))))
-
-(local
- (defthm away-away-7
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (>= (away x m) (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance away-exactp-c (a (away x m)))
-			(:instance away-exactp-b (n m))
-			(:instance away-lower-pos (n m))
-			(:instance exactp-<= (x (away x m))))))))
-(local
- (defthm away-away-8
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (>= (away x m) (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance away-away-7)
-;			(:instance away-0-0)
-	;		(:instance away-0-0 (n m))
-                        )))))
-
-(local
- (defthm away-away-9
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (= (away x n) (expt 2 (1+ (expo x))))
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (equal (away (away x n) m)
-		    (away x m)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable away-pos-rewrite)
-		  :use ((:instance away-away-8)
-			(:instance exactp-2**n (n (1+ (expo x))))
-			(:instance away-exactp-a (x (expt 2 (1+ (expo x)))) (n m))
-			(:instance away-exactp-d (n m)))))))
-
-;handle the case where n<m?
-(defthm away-away
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (equal (away (away x n) m)
-		    (away x m)))
-  :hints (("Goal" :use ((:instance away-away-9)
-			(:instance away-away-6)))))
-
-(defthm away-shift
-  (implies (integerp n)
-           (= (away (* x (expt 2 k)) n)
-              (* (away x n) (expt 2 k))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable away
-                                      sig
-                                      expt-split
-                                      )
-                              '()))))
-
-(local
- (defthm trunc-away-1
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (not (exactp x n)))
-            (> x (expt 2 (expo x))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance expo-lower-bound)
-                  (:instance exactp-2**n (n (expo x)) (m n)))))))
-
-
-(local
-(defthm trunc-away-2
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (>= (- x (expt 2 (- (expo x) n)))
-		 (expt 2 (expo x))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance trunc-away-1)
-			(:instance exactp-2**n (n (expo x)) (m (1+ n)))
-			(:instance fp+2 (x (expt 2 (expo x))) (n (1+ n)) (y x)))))))
-
-(local
-(defthm trunc-away-3
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (expo (- x (expt 2 (- (expo x) n))))
-		(expo x)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance trunc-away-2)
-			(:instance expo-unique (x (- x (expt 2 (- (expo x) n)))) (n (expo x)))
-			(:instance exactp-2**n (n (- (expo x) n)) (m n))
-;			(:instance expt-pos (x (- (expo x) n)))
-			(:instance expo-lower-bound)
-			(:instance expt-weak-monotone (n (- (expo x) n)) (m (expo x)))
-			(:instance expo-upper-bound))))))
-
-#|
-zz
-;yuck
-(local
- (defthm hack-83
-   (implies (and (integerp n)
-                 (< 0 n))
-            (= (* 1/2 (expt 2 (+ n (* -1 (expo x)))))
-               (expt 2 (1- n (* -1 (expo x))))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance expt-split (r 2) (i (- n (expo x))) (j -1)))))))
-
-;yuck
-(local
- (defthm hack-84
-   (implies (and (rationalp x)
-                 (rationalp a)
-                 (rationalp b)
-                 (= a b))
-            (= (* x a) (* x b)))
-   :rule-classes ()))
-
-;yuck
-(local
- (defthm hack-85
-   (implies (and (integerp n)
-                 (< 0 n)
-                 (rationalp x))
-            (equal (* 1/2 x (expt 2 (+ n (* -1 (expo x)))))
-                   (* x (expt 2 (1- n (* -1 (expo x)))))))
-   :hints (("goal" :use ((:instance hack-83)
-                         (:instance hack-84 
-                                    (a (* 1/2 (expt 2 (+ n (* -1 (expo x))))))
-                                    (b (expt 2 (1- n (* -1 (expo x)))))))))))
-|#
-
-(local
- (defthm trunc-away-4
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (not (exactp x n)))
-            (= (* x (expt 2 (- n (expo x))))
-               (1+ (* 2 (fl-half (* x (expt 2 (- n (expo x)))))))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable exactp2 expt-split)
-            :use ((:instance fl-half-lemma (x (* x (expt 2 (- n (expo x)))))))))))
-
-#|
-;yuck
-(local
- (defthm hack-86
-   (implies (integerp k)
-            (= (- (/ (1+ (* 2 k)) 2) 1/2) k))
-   :rule-classes ()))
-|#
-
-(local
- (defthm trunc-away-5
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (not (exactp x n)))
-            (= (* (- x (expt 2 (- (expo x) n)))
-                  (expt 2 (- (1- n) (expo x))))
-               (fl-half (* x (expt 2 (- n (expo x)))))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-compare-equal)
-            :use ((:instance trunc-away-4)
-;                         (:instance hack-86 (k (fl-half (* x (expt 2 (- n (expo x))))))) 
-                         (:instance expt-split (r 2) (i (- (expo x) n)) (j (- (1- n) (expo x))))
-                         (:instance expt-split (r 2) (i 1) (j (- (1- n) (expo x)))))))))
-
-(local
- (defthm trunc-away-6
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (not (exactp x n)))
-            (integerp (* (- x (expt 2 (- (expo x) n)))
-                         (expt 2 (- (1- n) (expo x))))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance trunc-away-5))))))
-
-(local
- (defthm trunc-away-7
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (not (exactp x n)))
-            (integerp (* (- x (expt 2 (- (expo x) n)))
-                         (expt 2 (- (1- n) (expo (- x (expt 2 (- (expo x) n)))))))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance trunc-away-6)
-                         (:instance trunc-away-3))))))
-
-(local
- (defthm trunc-away-8
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (>= (- x (expt 2 (- (expo x) n))) 0)
-                 (not (exactp x n)))
-            (exactp (- x (expt 2 (- (expo x) n)))
-                    n))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable exactp2)
-            :use ((:instance trunc-away-7))))))
-
-(local
- (defthm trunc-away-9
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (not (exactp x n)))
-            (exactp (- x (expt 2 (- (expo x) n)))
-                    n))
-   :rule-classes ()
-   :hints (("goal" :in-theory (e/d (expt-split) (expt-compare
-                                                 EXPO-COMPARISON-REWRITE-TO-BOUND
-                                                 EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                                                 ))
-            :use ((:instance trunc-away-8)
-                  (:instance expo-lower-bound)
-                  (:instance expt-weak-monotone (n (- (expo x) n)) (m (expo x))))))))
-
-(local
- (defthm trunc-away-10
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (not (exactp x n)))
-            (<= (- x (expt 2 (- (expo x) n)))
-                (trunc x n)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable; expt-pos
-                               trunc-exactp-c)
-            :use ((:instance trunc-away-9)
-                  (:instance expo-lower-bound)
-                  (:instance expt-weak-monotone (n (- (expo x) n)) (m (expo x)))
-;                  (:instance expt-pos (x (- (expo x) n)))
-                  (:instance trunc-exactp-c (a (- x (expt 2 (- (expo x) n))))))))))
-
-(local
-(defthm trunc-away-11
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n))
-		  (< (- x (expt 2 (- (expo x) n)))
-		     (trunc x n)))
-	     (<= x (trunc x n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable
-                              expt-compare
-                               EXPT-COMPARE-EQUAL
-                               EXPO-COMPARISON-REWRITE-TO-BOUND
-                              ;expt-pos
-;exactp2 
-                               )
-		  :use ((:instance trunc-away-8)
-			(:instance trunc-away-3)
-			(:instance expt-split (r 2) (i 1) (j (- n (expo x))))
-;			(:instance expt-pos (x (- (expo x) n)))
-			(:instance fp+2 (x (- x (expt 2 (- (expo x) n)))) (y (trunc x n)))
-			(:instance expo-lower-bound)
-			(:instance expt-strong-monotone (n (- (expo x) n)) (m (expo x)))
-			(:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))
-
-(defthm trunc-away-a
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (- x (expt 2 (- (expo x) n)))
-		(trunc x n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable trunc-exactp-b)
-		  :use ((:instance trunc-away-10)
-			(:instance trunc-away-11)
-			(:instance trunc-upper-pos)
-			(:instance trunc-exactp-b)))))
-(local
-(defthm hack-87
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (= (expo (- x (expt 2 (- (expo x) n))))
-		     (expo x)))
-	     (equal (+ x (* -1 (expt 2 (+ (expo x) (* -1 n))))
-		       (expt 2
-			 (+ 1 (* -1 n)
-			    (expo (+ x
-				     (* -1 (expt 2 (+ (expo x) (* -1 n)))))))))
-		    (+ x (expt 2 (+ (expo x) (* -1 n))))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance expt-split (r 2) (i (- (expo x) n)) (j 1)))))))
-
-(local
- (defthm hack-88
-   (implies (equal x y) (equal (exactp x n) (exactp y n)))
-   :rule-classes ()))
-
-(local
- (defthm hack-89
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (= (expo (- x (expt 2 (- (expo x) n))))
-                    (expo x)))
-            (equal (exactp (+ x (* -1 (expt 2 (+ (expo x) (* -1 n))))
-                              (expt 2
-                                    (+ 1 (* -1 n)
-                                       (expo (+ x
-                                                (* -1 (expt 2 (+ (expo x) (* -1 n)))))))))
-                           n)
-                   (exactp (+ x (expt 2 (+ (expo x) (* -1 n)))) n)))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance hack-87)
-                         (:instance hack-88 
-                                    (x (+ x (* -1 (expt 2 (+ (expo x) (* -1 n))))
-                                          (expt 2
-                                                (+ 1 (* -1 n)
-                                                   (expo (+ x
-                                                            (* -1 (expt 2 (+ (expo x) (* -1 n))))))))))
-                                    (y (+ x (expt 2 (+ (expo x) (* -1 n)))))))))))
-
-;(local (in-theory (disable expo-monotone))) ;drop?
-
-;not about away...
-(local
- (defthm trunc-away-12
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (not (exactp x n)))
-            (exactp (+ x (expt 2 (- (expo x) n)))
-                    n))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
-                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                                       EXPT-COMPARE-EQUAL
-                                       EXPT-COMPARE)
-            :use ((:instance trunc-away-9)
-                  (:instance fp+1 (x (- x (expt 2 (- (expo x) n)))))
-                  (:instance expo-lower-bound)
-                  (:instance expt-strong-monotone (n (- (expo x) n)) (m (expo x)))
-                  (:instance expt-split (r 2) (i (- (expo x) n)) (j 1))
-                  (:instance hack-89)
-                  (:instance trunc-away-3))))))
-
-(local
-(defthm trunc-away-13
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (>= (+ x (expt 2 (- (expo x) n)))
-		 (away x n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                                      away-exactp-c)
-		  :use ((:instance trunc-away-12)
-			(:instance expo-lower-bound)
-			(:instance expt-weak-monotone (n (- (expo x) n)) (m (expo x)))
-;			(:instance expt-pos (x (- (expo x) n)))
-			(:instance away-exactp-c (a (+ x (expt 2 (- (expo x) n))))))))))
-
-(local
-(defthm trunc-away-14
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (> (away x n)
-		(- x (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance away-lower-pos)
-;			(:instance expt-pos (x (- (expo x) n)))
-                        )))))
-
-(local
-(defthm trunc-away-15
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (>= (away x n)
-		 (+ (- x (expt 2 (- (expo x) n)))
-		    (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable away-exactp-b EXPT-COMPARE EXPO-COMPARISON-REWRITE-TO-BOUND)
-		  :use ((:instance trunc-away-8)
-			(:instance trunc-away-3)
-			(:instance expo-lower-bound)
-			(:instance expt-strong-monotone (n (- (expo x) n)) (m (expo x)))
-			(:instance trunc-away-14)
-			(:instance away-exactp-b)
-			(:instance fp+2 (x (- x (expt 2 (- (expo x) n)))) (y (away x n))))))))
-
-(local
- (defthm trunc-away-16
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (exactp x (1+ n))
-                 (not (exactp x n)))
-            (>= (away x n)
-                (+ x (expt 2 (- (expo x) n)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable expt-split) 
-            :use ((:instance trunc-away-15)
-                  )))))
-
-(defthm trunc-away-b
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (away x n)
-		(+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance trunc-away-16)
-			(:instance trunc-away-13)))))
-
-
-
-
-
-(local (defthm away-imp-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m))
-	     (< (trunc (+ x
-			  (expt 2 (- (1+ (expo x)) n))
-			  (- (expt 2 (- (1+ (expo x)) m))))
-		       n)
-		(+ x (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance trunc-upper-pos
-				   (x (+ x
-					 (expt 2 (- (1+ (expo x)) n))
-					 (- (expt 2 (- (1+ (expo x)) m))))))
-;			(:instance expt-pos (x (- (1+ (expo x)) m)))
-			(:instance expt-weak-monotone (n (- (1+ (expo x)) m)) (m (- (1+ (expo x)) n))))))))
-
-(local (in-theory (disable abs-pos)))
-
-(local (defthm away-imp-2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (+ x (expt 2 (- (1+ (expo x)) n)))
-		 (+ (away x n)
-		    (expt 2 (- (1+ (expo (away x n))) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable  expt-compare
-                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-                              :use ((:instance away-lower-pos)
-			(:instance expo-monotone (y (away x n)))
-			(:instance expt-weak-monotone
-				   (n (- (1+ (expo x)) n)) (m (- (1+ (expo (away x n))) n))))))))
-
-(local (defthm away-imp-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m))
-	     (< (trunc (+ x
-			  (expt 2 (- (1+ (expo x)) n))
-			  (- (expt 2 (- (1+ (expo x)) m))))
-		       n)
-		(+ (away x n)
-		   (expt 2 (- (1+ (expo (away x n))) n)))))
-  :rule-classes ()
-  :hints (("goal" :use (away-imp-1 away-imp-2)))))
-
-(local 
- (defthm away-imp-4
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (integerp m)
-                 (>= m n)
-                 (exactp x m))
-            (<= (trunc (+ x
-                          (expt 2 (- (1+ (expo x)) n))
-                          (- (expt 2 (- (1+ (expo x)) m))))
-                       n)
-                (away x n)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable away-exactp-b trunc-exactp-b away-positive) 
-            :use (away-imp-3
-                  (:instance fp+2
-                             (x (away x n))
-                             (y (trunc (+ x
-                                          (expt 2 (- (1+ (expo x)) n))
-                                          (- (expt 2 (- (1+ (expo x)) m))))
-                                       n)))
-                  (:instance away-positive)
-                  (:instance away-exactp-b)
-                  (:instance trunc-exactp-b
-                             (x (+ x
-                                   (expt 2 (- (1+ (expo x)) n))
-                                   (- (expt 2 (- (1+ (expo x)) m)))))))))))
-
-(local (defthm away-imp-5
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m)
-		  (exactp x n))
-	     (>= (trunc (+ x
-			   (expt 2 (- (1+ (expo x)) n))
-			   (- (expt 2 (- (1+ (expo x)) m))))
-			n)
-		 (away x n)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance trunc-monotone
-				   (y (+ x
-					 (expt 2 (- (1+ (expo x)) n))
-					 (- (expt 2 (- (1+ (expo x)) m))))))
-			(:instance expt-weak-monotone (n (- (1+ (expo x)) m)) (m (- (1+ (expo x)) n)))
-			(:instance trunc-exactp-a)
-			(:instance away-exactp-a))))))
-
-(local (defthm away-imp-6
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m)
-		  (not (exactp x n)))
-	     (>= x
-		 (+ (trunc x n)
-		    (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable trunc-exactp-b)
-           :use (trunc-exactp-a
-;			trunc-pos
-			trunc-upper-pos
-			trunc-exactp-b
-			(:instance exactp-<= (x (trunc x n)) (n m) (m n))
-			(:instance fp+2 (x (trunc x n)) (y x) (n m)))))))
-
-(local (defthm away-imp-7
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m)
-		  (not (exactp x n)))
-	     (>= (+ x
-		    (expt 2 (- (1+ (expo x)) n))
-		    (- (expt 2 (- (1+ (expo x)) m))))
-		 (+ (trunc x n)
-		    (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use (away-imp-6)))))
-
-(local (defthm away-imp-8
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (not (exactp x n)))
-	     (> (+ (trunc x n)
-		   (expt 2 (- (1+ (expo x)) n)))
-		x))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable trunc-exactp-c trunc-exactp-b)
-
-           :use ((:instance fp+1 (x (trunc x n)))
-			(:instance trunc-exactp-b)
-;			(:instance trunc-pos)
-;			(:instance expt-pos (x (- (1+ (expo x)) n)))
-			(:instance trunc-exactp-c 
-				   (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
-
-(local (defthm away-imp-9
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (not (exactp x n)))
-	     (>= (+ (trunc x n)
-		   (expt 2 (- (1+ (expo x)) n)))
-		(away x n)))
-  :rule-classes ()
-  :hints (("goal"  :in-theory (disable trunc-exactp-b away-exactp-c)
-           :use (away-imp-8
-			(:instance fp+1 (x (trunc x n)))
-			(:instance trunc-exactp-b)
-;			(:instance trunc-pos)
-			(:instance away-exactp-c 
-				   (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
-
-(local (defthm away-imp-10
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m)
-		  (not (exactp x n)))
-	     (>= (+ x
-		    (expt 2 (- (1+ (expo x)) n))
-		    (- (expt 2 (- (1+ (expo x)) m))))
-		 (away x n)))
-  :rule-classes ()
-  :hints (("goal" :use (away-imp-7 away-imp-9)))))
-
-(local (defthm away-imp-11
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m)
-		  (not (exactp x n)))
-	     (>= (trunc (+ x
-			   (expt 2 (- (1+ (expo x)) n))
-			   (- (expt 2 (- (1+ (expo x)) m))))
-			n)
-		 (away x n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable away-exactp-b trunc-exactp-c)
-           :use (away-imp-10
-			away-exactp-b
-			(:instance expt-weak-monotone (n (- (1+ (expo x)) m)) (m (- (1+ (expo x)) n)))
-			(:instance trunc-exactp-c
-				   (a (away x n))
-				   (x (+ x
-					 (expt 2 (- (1+ (expo x)) n))
-					 (- (expt 2 (- (1+ (expo x)) m)))))))))))
-
-(defthm away-imp
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m))
-	     (= (away x n)
-		(trunc (+ x
-			  (expt 2 (- (1+ (expo x)) n))
-			  (- (expt 2 (- (1+ (expo x)) m))))
-		       n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable AWAY-EXACTP-C) ;consider disabling this globally...
-           :use (away-imp-11 away-imp-5 away-imp-4))))
-
-(defthm plus-away-2
-  (implies (and (exactp x (+ k (- (expo x) (expo y))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                )
-           (equal (+ x (away y k))
-                  (* (cg (* (+ x y) (expt 2 (- (1- k) (expo y)))))
-                     (expt 2 (- (1+ (expo y)) k)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (e/d (away-pos-rewrite exactp2)
-                                  (cg+int-rewrite ;int-fl-rules
-                                     ))
-           :use ((:instance cg+int-rewrite 
-                            (x (* y (expt 2 (- (1- k) (expo y)))))
-                            (n (* x (expt 2 (- (1- k) (expo y))))))))))
-
-(defthm plus-away
-  (implies (and (exactp x (+ k (- (expo x) (expo y))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                )
-           (= (+ x (away y k))
-              (away (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable away-pos-rewrite)
-           :use ((:instance plus-away-2)
-                 (:instance expo-monotone (y (+ x y)))))))
-
-;add to lib? alternate form of the above
-(defthm plus-away-alt
-  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp j)
-                )
-           (= (away (+ x y) j)
-              (+ x (away y (+ j (- (expo (+ x y))) (expo y))))))
-  :rule-classes ()
-  :hints (("goal" 
-           :use (:instance plus-away
-                           (k (+ j (- (expo (+ x y))) (expo y)))))))
-
-; isn't nice for y=0
-;corollaries like this for inf, minf, rnd?
-(defthm plus-away-corollary
-  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
-                (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (> y 0)
-                (integerp n)
-                (exactp x n)
-                )
-           (= (away (+ x y) n)
-              (fp+ x n)))
-  :hints (("goal"  :in-theory (set-difference-theories
-                               (enable sgn
-                                       expt-split expt-minus)
-                               '(EXPT-COMPARE-EQUAL))
-           :use (  
-                 (:instance only-0-is-0-or-negative-exact) 
-                 (:instance away-exactp-a)
-                  expo-of-sum-of-disjoint 
-                 (:instance expo<=
-                            (x y)
-                            (n (+ (expo x) (* -1 n))))
-                 (:instance plus-away-alt
-                            (j n)))))
-  :otf-flg t)
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/away.lisp acl2-6.3/books/rtl/rel5/support/away.lisp
--- acl2-6.2/books/rtl/rel5/support/away.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/away.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,450 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-;there may be some cruft to be deleted from this file...
-
-;(include-book "trunc") ;BOZO drop
-(local (include-book "away-proofs"))
-
-;; Necessary defuns
-
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund power2p-measure (x)
-  (declare (xargs :guard (and (rationalp x) (not (equal x 0)))))
-  (cond ((or (not (rationalp x))
-             (<= x 0)) 0)
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund power2p (x)
-  (declare (xargs :guard t
-                  :measure (power2p-measure x)
-                  :hints (("goal" :in-theory (enable power2p-measure)))))
-  (cond ((or (not (rationalp x))
-             (<= x 0))
-         nil)
-        ((< x 1) (power2p (* 2 x)))
-        ((<= 2 x) (power2p (* 1/2 x)))
-        ((equal x 1) t)
-        (t nil) ;got a number in the doubly-open interval (1,2)
-        ))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;; Start of new stuff
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;generated automatically by ACL2 when we define away, but included here just to be safe
-;could disable (:type-prescription away) for slight efficiency gain at the cost of making the output of :pe a
-;little deceptive
-(defthm away-rational-type-prescription
-  (rationalp (away x n))
-  :rule-classes :type-prescription)
- 
-(defthm away-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (away x n)
-                  0)))
-
-;make alt version? use negative-syntaxp?
-(defthm away-minus
-  (= (away (* -1 x) n)
-     (* -1 (away x n))))
-
-(defthm away-positive
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                )
-           (< 0 (away x n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm away-positive-rational-type-prescription
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                )
-           (and (< 0 (away x n))
-                (rationalp (away x n))))
-  :rule-classes :type-prescription)
-
-(defthm away-negative
-    (implies (and (< x 0)
-                  (case-split (rationalp x))
-                  )
-	     (< (away x n) 0))
-    :rule-classes (:rewrite :linear))
-
-(defthm away-negative-rational-type-prescription
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                )
-           (< (away x n) 0))
-  :rule-classes :type-prescription)
-
-(defthm away-0
-  (equal (away 0 n)
-         0))
-
-(defthm away-non-negative-rational-type-prescription
-  (implies (<= 0 x)
-           (and (<= 0 (away x n))
-                (rationalp (away x n))))
-  :rule-classes :type-prescription)
-
-(defthm away-non-positive-rational-type-prescription
-  (implies (<= x 0)
-           (and (<= (away x n) 0)
-                (rationalp (away x n))))
-  :rule-classes :type-prescription)
-
-(defthm away-equal-0-rewrite
-  (implies (rationalp x)
-           (equal (equal (away x n) 0)
-                  (equal x 0))))
-
-(defthm sgn-away
-  (equal (sgn (away x n))
-         (sgn x)))
-
-;keep this disabled, since it basically opens up AWAY
-(defthmd abs-away
-  (implies (and (rationalp x)
-                (integerp n))
-           (equal (abs (away x n))
-                  (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
-
-;kind of gross...
-(defthm away-to-0-or-fewer-bits
-  (implies (and (<= n 0)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (away x n)
-                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
-
-(defthm away-lower-bound
-    (implies (and (case-split (rationalp x))
-		  (case-split (integerp n))
-                  )
-	     (>= (abs (away x n)) (abs x)))
-  :rule-classes :linear)
-
-(defthm away-lower-pos
-    (implies (and (>= x 0)
-                  (case-split (rationalp x))
-		  (case-split (integerp n))
-                  )
-	     (>= (away x n) x))
-  :rule-classes :linear)
-
-;elim?
-(defthm expo-away-lower-bound
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (>= (expo (away x n)) (expo x)))
-  :rule-classes :linear)
-
-(defthm away-upper-1
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes :linear)
-
-(defthm away-upper-2
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (integerp n)
-                (> n 0))
-           (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm away-upper-pos
-    (implies (and (> x 0)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (away x n) (* x (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm away-upper-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm away-diff
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes :linear)
-
-(defthm away-diff-pos
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes :linear)
-
-
-(defthm away-diff-expo-1
-    (implies (and (rationalp x)
-		  (not (= x (away x n)))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- (away x n) x)) (- (expo x) n)))
-  :rule-classes :linear)
-;slow
-(defthmd away-rewrite
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (equal (away x n)
-                  (* (sgn x) 
-                     (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
-                     (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm away-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (away x n))
-		  (exactp x n)))
-  :rule-classes ())
-
-(defthm away-diff-expo
-    (implies (and (rationalp x)
-		  (not (exactp x n))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- (away x n) x)) (- (expo x) n)))
-  :rule-classes :linear)
-
-(defthm away-exactp-b
-    (implies (case-split (< 0 n))
-	     (exactp (away x n) n)))
-
-(defthmd away-exactp-c
-    (implies (and (exactp a n)
-		  (>= a x)
-                  (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  )
-	     (>= a (away x n))))
-
-;trying disabled?
-(defthmd away-monotone
-  (implies (and (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (<= x y))
-           (<= (away x n) (away y n)))
-  :rule-classes :linear)
-
-(defthm away-exactp-d
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthmd away-pos-rewrite
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n))
-           (equal (away x n)
-                  (* (cg (* (expt 2 (- (1- n) (expo x))) x))
-                     (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm expo-away
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (integerp n)
-                (> n 0)
-                (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
-           (equal (expo (away x n))
-                  (expo x)))
-  :rule-classes ())
-
-;handle the case where n<m?
-(defthm away-away
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (equal (away (away x n) m)
-		    (away x m))))
-
-(defthm away-shift
-  (implies (integerp n)
-           (= (away (* x (expt 2 k)) n)
-              (* (away x n) (expt 2 k)))))
-
-;BOZO move to trunc! ?
-(defthm trunc-away-a
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (- x (expt 2 (- (expo x) n)))
-		(trunc x n)))
-  :rule-classes ())
-
-;rename! doesn't mention trunc
-(defthm trunc-away-b
-  (implies (and (integerp n) (> n 0)
-                (rationalp x) (> x 0)
-                (exactp x (1+ n))
-                (not (exactp x n)))
-           (= (away x n)
-              (+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ())
-
-(defthm away-imp
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (integerp m)
-                (>= m n)
-                (exactp x m))
-           (= (away x n)
-              (trunc (+ x
-                        (expt 2 (- (1+ (expo x)) n))
-                        (- (expt 2 (- (1+ (expo x)) m))))
-                     n)))
-  :rule-classes ())
-
-(defthm plus-away-2
-  (implies (and (exactp x (+ k (- (expo x) (expo y))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                )
-           (equal (+ x (away y k))
-                  (* (cg (* (+ x y) (expt 2 (- (1- k) (expo y)))))
-                     (expt 2 (- (1+ (expo y)) k)))))
-  :rule-classes ())
-
-(defthm plus-away
-  (implies (and (exactp x (+ k (- (expo x) (expo y))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                )
-           (= (+ x (away y k))
-              (away (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ())
-
-;add to lib? alternate form of the above
-(defthm plus-away-alt
-  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp j)
-                )
-           (= (away (+ x y) j)
-              (+ x (away y (+ j (- (expo (+ x y))) (expo y))))))
-  :rule-classes ())
-
-; isn't nice for y=0
-;prove corollaries like this for inf, minf, rnd?
-(defthm plus-away-corollary
-  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
-                (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (> y 0)
-                (integerp n)
-                (exactp x n)
-                )
-           (= (away (+ x y) n)
-              (fp+ x n))))
-
-
-;gross.  keep disabled? don't put in user/ ?
-(defthmd away-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (away x n)
-                  (if (not (rationalp x))
-                      0
-                    (if (acl2-numberp n)
-                        (if (power2p (abs x))
-                            (sgn x)
-                        (* 2 (sgn x)))
-                      (* (sgn x) (expt 2 (+ 1 (expo x)))))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/badguys.lisp acl2-6.3/books/rtl/rel5/support/badguys.lisp
--- acl2-6.2/books/rtl/rel5/support/badguys.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/badguys.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,47 +0,0 @@
-; This file introduces definable Skolem functions that can be used in order to
-; reduce theorems about all elements of a list to theorems about an arbitrary
-; elements of a list.  Matt Kaufmann first learned of this trick from Ken
-; Kunen.
-
-(in-package "ACL2")
-
-;;;**********************************************************************
-;;;                       SUMBITS
-;;;**********************************************************************
-
-(include-book "merge") ; for badguy and lemmas about it
-
-(defun sumbits-badguy (x y k)
-  (if (zp k)
-      0 ; arbitrary
-    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
-        (1- k)
-      (sumbits-badguy x y (1- k)))))
-
-(local
- (defthm sumbits-badguy-is-correct-lemma
-   (implies (equal (bitn x (sumbits-badguy x y k))
-                   (bitn y (sumbits-badguy x y k)))
-            (equal (sumbits x k)
-                   (sumbits y k)))
-   :rule-classes nil))
-
-(defthmd sumbits-badguy-is-correct
-  (implies (and (bvecp x k)
-                (bvecp y k)
-                (equal (bitn x (sumbits-badguy x y k))
-                       (bitn y (sumbits-badguy x y k)))
-                (integerp k)
-                (< 0 k))
-           (equal (equal x y) t))
-  :hints (("Goal"
-           :use sumbits-badguy-is-correct-lemma
-           :in-theory (enable sumbits-thm))))
-
-(defthmd sumbits-badguy-bounds
-  (implies (and (integerp k)
-                (< 0 k))
-           (let ((badguy (sumbits-badguy x y k)))
-             (and (integerp badguy)
-                  (<= 0 badguy)
-                  (< badguy k)))))
diff -Nru acl2-6.2/books/rtl/rel5/support/bias-proofs.lisp acl2-6.3/books/rtl/rel5/support/bias-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/bias-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bias-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,72 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "../arithmetic/expt"))
-(local (include-book "bvecp"))
-(local (include-book "../arithmetic/integerp"))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-; bias of a q bit exponent field is 2^(q-1)-1 
-(defund bias (q) (- (expt 2 (- q 1)) 1) )
-
-(defthm bias-non-negative-integerp-type-prescription
-  (implies (and (case-split (integerp q))
-                (case-split (< 0 q))
-                )
-           (and (integerp (bias q))
-                (<= 0 (bias q))))
-  :hints (("Goal" :in-theory (enable bias)))
-  :rule-classes :TYPE-PRESCRIPTION
-  )
-
-(encapsulate
- ()
- (local (defthm bias-bvecp-aux
-          (implies (and (< 0 q)
-                        (integerp q))
-                   (BVECP (BIAS Q) (1- Q)))
-          :rule-classes nil
-          :hints (("Goal" :in-theory (set-difference-theories
-                                      (enable bias bvecp expt ;-split
-                                              )
-                                      '())))))
-
- (defthm bias-bvecp
-   (implies (and (<= (1- q) q2)
-                 (case-split (< 0 q))
-                 (case-split (integerp q))
-                 (case-split (integerp q2))
-                 )
-            (BVECP (BIAS Q) q2))
-   :hints (("Goal" :in-theory (enable bvecp-longer)
-            :use bias-bvecp-aux)))
- )
-
-(defthm bias-integerp-rewrite
-  (equal (integerp (bias q))
-         (or (and (acl2-numberp q) (not (integerp q)))
-             (<= 1 q)))
-  :hints (("Goal" :in-theory (enable bias))))
-
-;where's bias-integerp?
-(defthm bias-integerp
-  (implies (case-split (< 0 k))
-           (integerp (bias k)))
-  :hints (("Goal" :in-theory (enable bias))))
-
-(defthm bias-with-q-an-acl2-number-but-not-an-integer
-  (implies (and (not (integerp q))
-                (case-split (acl2-numberp q)))
-           (equal (bias q)
-                  0))
-  :hints (("Goal" :in-theory (enable bias))))
-
-(defthm bias-with-q-not-an-acl2-number
-  (implies (not (acl2-numberp q))
-           (equal (bias q)
-                  -1/2))
-  :hints (("Goal" :in-theory (enable bias))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/bias.lisp acl2-6.3/books/rtl/rel5/support/bias.lisp
--- acl2-6.2/books/rtl/rel5/support/bias.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bias.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,50 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "bias-proofs"))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-; bias of a q bit exponent field is 2^(q-1)-1 
-(defund bias (q) (- (expt 2 (- q 1)) 1) )
-
-(defthm bias-non-negative-integerp-type-prescription
-  (implies (and (case-split (integerp q))
-                (case-split (< 0 q))
-                )
-           (and (integerp (bias q))
-                (<= 0 (bias q))))
-  :rule-classes :TYPE-PRESCRIPTION)
-
-;BOZO rename q2 to k?
-(defthm bias-bvecp
-   (implies (and (<= (1- q) q2)
-                 (case-split (< 0 q))
-                 (case-split (integerp q))
-                 (case-split (integerp q2))
-                 )
-            (bvecp (bias q) q2)))
-
-(defthm bias-integerp-rewrite
-  (equal (integerp (bias q))
-         (or (and (acl2-numberp q) (not (integerp q)))
-             (<= 1 q))))
-
-;where's bias-integerp?
-(defthm bias-integerp
-  (implies (case-split (< 0 k))
-           (integerp (bias k))))
-
-(defthm bias-with-q-an-acl2-number-but-not-an-integer
-  (implies (and (not (integerp q))
-                (case-split (acl2-numberp q)))
-           (equal (bias q)
-                  0)))
-
-(defthm bias-with-q-not-an-acl2-number
-  (implies (not (acl2-numberp q))
-           (equal (bias q)
-                  -1/2)))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/bitn-proofs.lisp acl2-6.3/books/rtl/rel5/support/bitn-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/bitn-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bitn-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1217 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(local (include-book "../arithmetic/top"))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-
-
-(include-book "../arithmetic/negative-syntaxp")
-(include-book "../arithmetic/power2p")
-
-(local (include-book "ground-zero"))
-
-(local (include-book "bits"))
-(local (include-book "bvecp")) ;to get bvecp-longer
-
-;(in-theory (disable expt-inverse))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defthm bitn-nonnegative-integer
-  (and (integerp (bitn x n))
-       (<= 0 (bitn x n)))
-  :hints (("Goal" :in-theory (enable bitn)))
-  :rule-classes (:type-prescription))
-
-(defthm bitn-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (bitn x n)
-                  0))
-  :hints (("Goal" :in-theory (enable bitn))))
-
-
-(encapsulate
- ()
-;gen
- (local (defthm bitn-upper-bound-case-1
-          (implies (integerp n)
-                   (<= (bitn x n) 1))
-          :otf-flg t
-          :hints (("Goal" :use (:instance fl-def-linear-part-2 (x (* 1/2 X (/ (EXPT 2 N)))))
-                   :in-theory (set-difference-theories
-                               (enable mod bitn bits expt-split)
-                               '( fl-def-linear-part-2
-                                  a10
-;                          REARRANGE-ERIC-4
-;                                  REARRANGE-FRACTIONAL-COEFS-<
-                                  ))))
-          :rule-classes (:rewrite :linear)))
-;separate out the linear rule?
-
- (local (defthm bitn-upper-bound-case-2
-          (implies (not (integerp n))
-                   (<= (bitn x n) 1))
-          :otf-flg t
-          :hints (("Goal" :cases ((integerp (+ n 1)))
-                   :in-theory (set-difference-theories
-                               (enable mod bitn bits expt-split)
-                               '(A10
-                                 fl-def-linear-part-2
- ;                                REARRANGE-FRACTIONAL-COEFS-<
-                                 ))))
-          :rule-classes (:rewrite :linear)))
-
-
-
- (defthm bitn-upper-bound
-   (<= (bitn x n) 1)
-   :hints (("Goal" :cases ((integerp n)))))
- )
-
-(defthm bitn-upper-bound-linear
-  (<= (bitn x n) 1)
-  :rule-classes ((:LINEAR :TRIGGER-TERMS ((bitn x n)))))
-
-;!! was looping with expt-compare
-; look into this more
-(local (in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)))
-
-(encapsulate
- ()
-;derive from bits-minus?
- (local (defthm bitn-minus-case-1
-          (implies (and (rationalp x)
-                        (integerp n)
-                        (integerp (/ x (expt 2 (+ 1 n))))
-                        )
-                   (equal (bitn (* -1 x) n)
-                          (- (bitn x n))
-                          ))
-          :hints (("Goal" :in-theory (set-difference-theories
-                                      (enable bitn 
-                                              bits
-                                              mod-cancel
-                                              expt-minus  
-                                              expt-split)
-                                      '( ;expt-inverse 
-                                        ))))))
-
-
- (local (defthm bitn-minus-case-2
-          (implies (and (rationalp x)
-                        (integerp n)
-                        (not (integerp (/ x (expt 2 n))))
-                        )
-                   (equal (bitn (* -1 x) n)
-                          (- 1 (bitn x n))
-                          ))
-          :hints (("Goal" :in-theory (set-difference-theories
-                                      (enable bitn
-                                              mod
-                                              mod-cancel
-                                              bits 
-                                              even-int-implies-int
-                                              expt-minus  
-                                              expt-split)
-                                      '( ;expt-inverse
-                                        ))))))
-
-
- (local (defthm bitn-minus-case-3
-          (implies (and (rationalp x)
-                        (integerp n)
-                        (not (integerp (/ x (expt 2 (+ 1 n)))))
-                        (integerp (/ x (expt 2 n)))
-                        )
-                   (equal (bitn (* -1 x) n)
-                          (- 2 (bitn x n))
-                          ))
-          :hints (("Goal" :in-theory (set-difference-theories
-                                      (enable bitn
-                                              mod
-                                              mod-cancel
-                                              bits 
-                                              expt-minus  
-                                              expt-split)
-                                      '( ;expt-inverse
-                                        ))))))
-
-
-
-
-
- (defthm bitn-minus
-   (implies (and (syntaxp (negative-syntaxp x))
-                 (case-split (rationalp x)) ;gen?
-                 (case-split (integerp n))
-                 )
-            (equal (bitn x n)
-                   (if (integerp (/ x (expt 2 (+ 1 n))))
-                       (- (bitn (- x) n))
-                     (if (integerp (/ x (expt 2 n)))
-                         (- 2 (bitn (- x) n))
-                       (- 1 (bitn (- x) n))))))))
-
-
-
-;(in-theory (disable  FL-EQUAL-0))
-
-;1 rewrite to odd?
-(defthm bitn-0-rewrite-to-even
-  (implies (integerp x)
-           (equal (equal (bitn x 0) 0)
-                  (integerp (* 1/2 x))))
-  :hints (("Goal" :in-theory (enable bitn bits  mod-by-2-rewrite-to-even)))
-  )
-
-
-;...
-
-
-;(in-theory (disable  bitn-sum-lowbits)) ;was causing loops
-
-
-;this one should remain last? <-- huh?
-(theory-invariant (incompatible (:rewrite bits-n-n-rewrite)
-                                (:definition bitn)
-                                )
-                  :key bitn-and-bits-n-n-shouldnt-alternate)
-
-(defthmd bits-n-n-rewrite
-  (equal (BITS X n n)
-         (bitn x n))
-  :hints (("Goal" :in-theory (enable bitn)))
-  )
-
-
-
-
-#|
-;should only fire if it really does simplify x, that is, if x really has bits to be dropped
-(defthm bitn-sum-simplify-first-term
-  (implies (and (>= (abs x) (expt 2 (+ n 1))) ;prevents loop
-                (rationalp x)
-                (rationalp y)
-                (integerp n))
-           (equal (bitn (+ x y) n)
-                  (bitn (+ (lowbits x n) y) n)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable 
-                               lowbits
-                               bitn bits)
-                              '()))))
-
-;should only fire if it really does simplify y, that is, if y really has bits to be dropped
-(defthm bitn-sum-simplify-second-term
-  (implies (and (>= (abs y) (expt 2 (+ n 1))) ;prevents loop
-                (rationalp x)
-                (rationalp y)
-                (integerp n))
-           (equal (bitn (+ x y) n)
-                  (bitn (+ x (lowbits y n)) n)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable lowbits
-                                      bitn bits)
-                              '()))))
-
-(defthm bitn-sum-simplify-third-term
-  (implies (and (>= (abs z) (expt 2 (+ n 1))) ;prevents loop
-                (rationalp x)
-                (rationalp y)
-                (rationalp z)
-                (integerp n))
-           (equal (bitn (+ x y z) n)
-                  (bitn (+ x y (lowbits z n)) n)))
-  :hints (("Goal" :in-theory (disable bitn-sum-simplify-first-term
-                                      bitn-sum-simplify-second-term)
-           :use (:instance bitn-sum-simplify-first-term (x z) (y (+ x y))))))
-
-
-
-|#
-
-
-(defthm bitn-upper-bound-2
-  (< (bitn x n) 2)
-  :hints (("Goal" :in-theory (disable  bitn-upper-bound)
-           :use  bitn-upper-bound)))
-
-(defthm bitn-0-1
-  (or (equal (bitn x n) 0)
-      (equal (bitn x n) 1))
-  :hints (("Goal" :in-theory (disable bitn)))
-  :rule-classes nil)
-
-
-;my strategey with the rules below is to rewrite prefer (not (equal (bitn x n) 0)) over (equal (bitn x n) 1)
-;this allows subsumption to ...
-
-;bad to have both?
-(defthm bitn-not-0-means-1
-  (equal (not (equal (bitn x n) 0))
-         (equal (bitn x n) 1))
-  :hints (("Goal" :use bitn-0-1)))
-
-(defthm bitn-not-1-means-0
-  (equal (not (equal (bitn x n) 1))
-         (equal (bitn x n) 0))
-  :hints (("Goal" :use bitn-0-1)))
-
-;these are bad rules?
-(in-theory (disable bitn-not-1-means-0 bitn-not-0-means-1))
-
-;add matt's forward chaining rules for dealing with single bits (maybe they should go in bvecp.lisp)
-
-
-(encapsulate 
- ()
- (local (defthm bitn-bitn-case-1
-          (implies (case-split (integerp n))
-                   (equal (bitn (bitn x n) 0)
-                          (bitn x n)))
-          :hints (("Goal"
-                   :in-theory (set-difference-theories
-                               (enable bitn bits)
-                               '())))))
-
-
- (local (defthm bitn-bitn-case-2
-          (implies (not (integerp n))
-                   (equal (bitn (bitn x n) 0)
-                          (bitn x n)))
-          :hints (("Goal" :cases ((acl2-numberp n))
-                   :in-theory (set-difference-theories
-                               (enable bitn bits mod)
-                               '())))))
-
- (defthm bitn-bitn
-   (equal (bitn (bitn x n) 0)
-          (bitn x n))))
-
-
-
-;bb
-(defthm bitn-known-not-0-replace-with-1
-  (implies (not (equal (bitn x n) 0)) ; backchain-limit?
-           (equal (bitn x n)
-                  1))
-  :rule-classes ((:rewrite :backchain-limit-lst (1)))
-  :hints (("Goal" :use (:instance bitn-0-1)))
-  )
-
-
-
-;needed?
-(defthm bitn->-0
-  (equal (< 0 (bitn x n))
-         (not (equal 0 (bitn x n)))))
-
-(defthm bitn-<-1
-  (equal (< (BITN X n) 1)
-         (equal (BITN X n) 0))
-  :hints (("Goal"
-           :use bitn-0-1)))
-
-;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
-(defthm bitn-not->-1
-  (implies (and (syntaxp (quotep k))
-                (<= 1 k))
-           (equal (< k (bitN x n))
-                  nil))
-  :hints (("Goal" :in-theory (disable bitn-upper-bound bitn-upper-bound-2)
-           :use bitn-upper-bound)))
-
-
-;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
-(defthm bitn-<=-1
-  (implies (and (syntaxp (quotep k))
-                (< 1 k))
-           (equal (< (bitN x n) k)
-                  t))
-    :hints (("Goal" :in-theory (disable  BITN-NOT->-1 bitn-upper-bound bitn-upper-bound-2)
-           :use bitn-upper-bound)))
-
-#|
-;cc
-(defthm bitn-shift-alt
-  (implies (and (syntaxp (should-have-a-2-factor-divided-out x))
-                (> n 0) ;restricts application 
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (bitn x n)
-                  (bitn (/ x 2) (- n 1))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bits bitn)
-                              '(bits-shift-alt
-                                ))
-           :use (:instance bits-shift-alt (i n) (j n)))))
-|#
-
-(defthmd bitn-def
-  (implies (case-split (integerp n))
-           (equal (bitn x n)
-                  (mod (fl (/ x (expt 2 n)))
-                       2)))
-  :hints (("Goal" :in-theory (enable bits bitn expt-split))))
-
-
-
-(defun not-eric (x)
-  (if (equal x 0)
-      1
-    0))
-
-
-
-#|
-;this does most of the work (i.e., it gets the constant below 2^i+1
-(defthm bitn-sum-lowbits
-  (implies (and (syntaxp (and (quotep x) (>= (cadr x) (expt 2 (+ 1 (cadr n)))))) ;dropped negative case
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                )
-           (equal (bitn (+ x              y) n)
-                  (bitn (+ (lowbits x n) y) n)))
-  :hints (("Goal" :in-theory (enable bitn)
-           :use  (:instance bits-sum-lowbits (i n) (j n) ))))
-|#
-
-(defthm bitn-drop-crucial-bit-and-flip-result
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n)) ;drop?
-                )
-           (and (equal (bitn (+ (expt 2 n) x) n)
-                       (not-eric (bitn x n)))
-                (equal (bitn (+ x (expt 2 n)) n)
-                       (not-eric (bitn x n)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bits bitn-def
-                                      expt-split
-                                      )
-                              '(
-                                MOD-PULL-INSIDE-FL-SHIFT-ALT-ALT-ALT-ALT
-                                floor-fl)))))
-
-(defthm bitn-drop-crucial-bit-and-flip-result-alt-gen
-  (implies (and (syntaxp (and (quotep j) 
-                              (< (cadr j) (expt 2 (+ 1 (cadr n)))) ;bitn-sum-lowbits does most of the work
-                              (>= (cadr j) (expt 2 (cadr n)))))
-                (rationalp j)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (bitn (+ j x) n)
-                  (not-eric (bitn (+ (- j (expt 2 n)) x) n))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (disable bitn-drop-crucial-bit-and-flip-result)
-           :use (:instance bitn-drop-crucial-bit-and-flip-result (x (+ j (- (expt 2 n)) x))))))
-
-;for negative constants j
-;might be slow if the negative constant has a large absolute value
-;make a negative version of bitn-sum-lowbits
-(defthm bitn-add-crucial-bit-and-flip-result
-  (implies (and (syntaxp (and (quotep j) 
-                              (quotep n)
-                              (< (cadr j) 0)))
-                (rationalp j)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (bitn (+ j x) n)
-                  (not-eric (bitn (+ (+ j (expt 2 n)) x) n))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (disable  bitn-drop-crucial-bit-and-flip-result)
-           :use (:instance bitn-drop-crucial-bit-and-flip-result (x (+ j  x))))))
-
-
-
-(defthm bitn-equal-to-silly-value
-  (implies (and (syntaxp (quotep k))
-                (not (or (equal 0 k) (equal 1 k)))
-                )
-           (equal (equal k (bitn x n))
-                  nil)))
-                         
-
-
-
-(defthm bitn-split-around-zero
-  (implies (and (<= (- (expt 2 n)) x)
-                (< x (expt 2 n))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (equal (bitn x n) 0)
-                  (<= 0 x)))
-  :otf-flg t
-  :hints (("Goal" :cases ((<= 0 x))
-           :in-theory (enable bitn bits expt-split  mod-force-chosen-a-neg)))
-  )
-
-
-;drop silly hyps like: (<= -128 (BITN FOO 24))
-(defthm bitn-drop-silly-bound
-  (implies (and (syntaxp (quotep k))
-                (<= k 0)
-                )
-  (equal (< (bitn x n) k)
-         nil)))
-
-(defthm bitn-drop-silly-bound-2
-  (implies (and (syntaxp (quotep k))
-                (< k 0)
-                )
-  (equal (< k (bitn x n))
-         t)))
-
-
-(defthm bitn-even-means-0
-  (equal (INTEGERP (* 1/2 (BITN x n)))
-         (equal (bitn x n) 0)))
-
-;new - export disabled?
-(defthm bitn-too-small
-  (implies (and (< x (expt 2 n))
-                (<= 0 x) ;case-split?
-                )
-           (equal (bitn x n)
-                  0))
-  :hints (("Goal" :cases ((rationalp x)) ;why needed?
-           :in-theory (enable bitn bits expt-split)))
-  :rule-classes ((:rewrite :backchain-limit-lst (1 nil)))
-  )
-
-(defthm bitn-normal-form
-  (equal (equal (bitn x n) 1)
-         (not (equal (bitn x n) 0))))
-
-
-(defthm bitn-of-non-rational
-  (implies (not (rationalp x))
-           (equal (bitn x n)
-                  0))
-  :hints (("Goal" :in-theory (enable bitn)))
-)
-
-
-
- 
-
-
-(encapsulate
- ()
- (local (defthm bitn-bvecp-simple
-   (bvecp (bitn x n) 1)
-   :hints (("Goal" :use bitn-0-1
-            :in-theory (set-difference-theories
-                        (enable bvecp)
-                        '()
-                        )))))
-
- (defthm bitn-bvecp
-   (implies (and (<= 1 k)
-                 (case-split (integerp k)))
-            (bvecp (bitn x n) k))
-   :hints (("Goal" :use  bitn-bvecp-simple
-            :in-theory (disable bitn-bvecp-simple
-                              ))))
- )
-
-(defthm bitn-times-fraction-integerp 
-  (implies (and (not (integerp k))
-                (case-split (acl2-numberp k))
-                )
-           (equal (INTEGERP (* k (BITN x n)))
-                  (equal (BITN x n) 0))))
-
-
-
-(defthm bitn-in-product-split-cases
-  (and (implies (case-split (acl2-numberp k))
-                (equal (* (bitn x n) k)
-                       (if (equal (bitn x n) 0)
-                           0
-                         k)))
-       (implies (case-split (acl2-numberp k))
-                (equal (* k (bitn x n))
-                       (if (equal (bitn x n) 0)
-                           0
-                         k)))))
-;(in-theory (disable bitn-in-product-split-cases))
-
-(defthm bitn-in-sum-split-cases
-  (and (implies (case-split (acl2-numberp k))
-                (equal (+ k (bitn x n))
-                       (if (equal (bitn x n) 0)
-                           k
-                         (+ k 1))))
-  
-       (implies (case-split (acl2-numberp k))
-                (equal (+ (bitn x n) k)
-                       (if (equal (bitn x n) 0)
-                           k
-                         (+ k 1))))))
-;(in-theory (disable bitn-in-sum-split-cases))
-
-#|
-(defthm bitn-shift-better
-  (implies (and (bind-free (can-take-out-numeric-power-of-2 x) (c))
-                (force (power2p c))
-                (case-split (integerp n))
-                )
-           (equal (bitn x n)
-                  (bitn (/ x c) (- n (expo c)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn)
-                              '(bits-shift-better)
-                              )
-           :use (:instance bits-shift-better (i n) (j n)))))
-
-|#
-
-(defthm bitn-0
-  (equal (bitn 0 k) 
-         0)
-  :hints (("goal" :in-theory (enable bitn))))
-
-;may cause case splits (maybe that's good?) 
-(defthm bitn-expt-gen
-  (implies (case-split (integerp i))
-           (equal (bitn (expt 2 i) n)
-                  (if (equal i n)
-                      1
-                    0)))
-  :hints (("Goal" :in-theory (enable bitn))))
-
-(defthmd bitn-expt
-  (implies (case-split (integerp n))
-           (equal (bitn (expt 2 n) n) 1)))
-
-;These are intended for the (perhaps weird) case when x in (bitn x n) is a constant but n is not a constant.
-;I actually had this term in a proof: (EQUAL (BITN 128 (BITS <signal-name> 8 6)) 0)
-
-(defthm bitn-of-expt-equal-0
-  (implies (and (syntaxp (quotep x))
-                (equal x (expt 2 (expo x))) ;means x is a power of 2
-                )
-           (equal (equal (bitn x n) 0)
-                  (not (equal n (expo x))))));note that (expo x) will be a constant since x is
-
-(defthm bitn-of-expt-equal-1
-  (implies (and (syntaxp (quotep x))
-                (equal x (expt 2 (expo x))) ;means x is a power of 2
-                )
-           (equal (equal (bitn x n) 1)
-                  (equal n (expo x))))) ;note that (expo x) will be a constant since x is
-
-#|
-(defthm bitn-of-expt-constant
-  (implies (and (syntaxp (quotep x))
-                (equal e (expo x)) ;having E means we don't have to evaluate (expo x) in the conclusion
-                (equal x (expt 2 e)) ;means x is a power of 2
-                )
-           (equal (bitn x n)
-                  (log= n e)))) ;note that e will be a constant
-
-|#
-
-;This is the rule Doc is allowing in lib/, since it doesn't cause as many case-splits are bitn-expt-gen?
-(defthmd bitn-expt-0
-  (implies (and (not (equal i n))
-		(case-split (integerp i)))
-	   (equal (bitn (expt 2 i) n) 0)))
-
-(defthm bitn-0-1
-    (or (equal (bitn x n) 0)
-        (equal (bitn x n) 1))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable bitn))))
-
-(defthmd bitn-shift-eric
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* x (expt 2 k)) n)
-                  (bitn x (+ n (- k)))))
-  :hints (("Goal" :in-theory (enable bitn))))
-
-;BOZO replace with bitn-shift-eric ??
-(defthmd bitn-shift
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* x (expt 2 k)) (+ n k))
-                  (bitn x n)))
-  :hints (("Goal" :in-theory (enable bitn))))
-
-;gen!
-;dammit, ACL2 unifies 0 with (* 2 x), so this rule can loop!
-(defthm bitn-shift-by-2
-  (implies (and (syntaxp (not (quotep x)))
-                (acl2-numberp n))
-           (equal (BITN (* 2 x) n)
-                  (bitn x (1- n))))
-  :hints (("Goal" :use (:instance bitn-shift-eric (k 1))))
-  )
-
-(defthmd bitn-plus-mult
-  (implies (and (< n m)
-                (integerp m)
-                (integerp k)
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn x n)))
-  :hints (("Goal" :in-theory (enable bitn bits-plus-mult-2))))
-
-(defthmd bitn-plus-mult-rewrite
-    (implies (and (syntaxp (quotep c))
-		  (equal (mod c (expt 2 (1+ n))) 0))
-	     (equal (bitn (+ c x) n)
-		    (bitn x n)))
-    :hints (("Goal" :use ((:instance bitn-plus-mult
-                                     (x x)
-                                     (k (/ c (expt 2 (1+ n))))
-                                     (m (1+ n))
-                                     (n n)))
-             :in-theory (enable mod))))
-
-;we almost always want to leave this disabled!
-(defthmd bitn-plus-bits
-  (implies (and (<= m n)
-                (integerp m)
-                (integerp n)
-                )
-           (= (bits x n m)
-              (+ (* (bitn x n) (expt 2 (- n m)))
-                 (bits x (1- n) m))))
-  :hints (("goal" :in-theory (enable bitn)
-           :use ((:instance bits-plus-bits (n n) (p n) (m m)))
-           )))
-
-;we almost always want to leave this disabled!
-(defthm bits-plus-bitn
-    (implies (and (<= m n)
-                  (integerp m)
-		  (integerp n)
-		  )
-	     (= (bits x n m)
-		(+ (bitn x m)
-		   (* 2 (bits x n (1+ m))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable bitn)
-           :use ((:instance bits-plus-bits (n n) (m m) (p (+ m 1)))))))
-
-;drop?
-(defthm bits-0-bitn-0
-  (implies (and (<= 0 n)
-                (integerp n)
-                )
-           (iff (= (bits x n 0) 0)
-                (and (= (bitn x n) 0)
-                     (= (bits x (1- n) 0) 0))))
-  :rule-classes ()
-  :hints (("Goal" :use (:instance bitn-plus-bits (m 0)))))
-
-(defthmd bitn-shift-down
-  (implies (and (natp i)
-                (integerp k))
-           (equal (bitn (fl (/ x (expt 2 k))) i)
-                  (bitn x (+ i k))))
-  :hints (("goal" :in-theory (e/d (bits-shift-down-1 bitn) (BITS-FL)))))
-
-(defthm bitn-shift-by-constant-power-of-2
-  (implies (and (syntaxp (quotep k))
-                (power2p k)
-                (case-split (integerp n))
-                )
-           (equal (bitn (* k x) n)
-                  (bitn x (- n (expo k)))))
-  :hints (("Goal" :use (:instance  bits-shift-by-constant-power-of-2 (i n) (j n))
-           :in-theory (enable bitn))))
-
-(defthmd bitn-shift-eric-2
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* (expt 2 k) x) n) ;BOZO rewrite the (+ n k) to match better
-                  (bitn x (+ n (- k)))))
-  :hints (("Goal" :in-theory (enable bitn))))
-
-
-
-(defthmd bitn-rec-0
-  (implies (integerp x)
-           (equal (bitn x 0)
-                  (mod x 2)))
-  :hints (("goal" :use ((:instance bitn-def (n 0))))))
-
-;rename?
-;is there a bits analog of this theorem?
-;move or copy to bitn?
-;change k to n
-;BOZO change formal k to n
-(defthmd bitn-rec-pos
-  (implies (< 0 n) ;n cannot be 0 or negative
-           (equal (bitn x n)
-                  (bitn (fl (/ x 2)) (1- n))))
-  :rule-classes ((:definition :controller-alist ((bitn t t))))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable bitn-def expt-split)
-                              '( ; bitn-def
-                                fl/int-rewrite
-                                fl-shift-fl  
-                                mod-pull-inside-fl-shift-alt-alt-alt
-                                mod-pull-inside-fl-shift-alt-alt-alt-alt))
-           :use ((:instance fl/int-rewrite (x (/ x 2)) (n (expt 2 (1- n))))))))
-
-
-
-;generalize to bits-mod?
-(defthmd bitn-mod
-  (implies (and (< k n)
-                (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (mod x (expt 2 n)) k)
-                  (bitn x k)))
-  :hints (("Goal"; :cases ((integerp n))
-           :in-theory (enable bitn bits))))
-
-;dup?
-(defthm BIT-EXPO-A
-  (implies (and (< x (expt 2 n))
-                (>= x 0)
-                (integerp n)
-                )
-           (equal (bitn x n) 0))
-  :rule-classes ())
-
-;special case of  bit-expo-c?
-(defthm BIT-EXPO-B
-  (implies (and (<= (expt 2 n) x)
-                (< x (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                ;(>= x 0)
-                ;(>= n 0)
-                )
-           (equal (bitn x n) 1))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split bitn-def)
-           :use ((:instance fl-unique (x (/ x (expt 2 n))) (n 1))))))
-
-(defthm bitn-plus-expt-1
-  (implies (and (rationalp x)
-                (integerp n)
-                )
-           (not (equal (bitn (+ x (expt 2 n)) n)
-                       (bitn x n))))
-  :rule-classes ()
-)
-
-
-;bozo. dup?
-;prove from bitn-plus-mult?
-(defthm bitn-plus-expt-2
-  (implies (and (< n m)
-                (integerp n)
-                (integerp m)
-                )
-           (equal (bitn (+ x (expt 2 m)) n)
-                  (bitn x n)))
-  :hints (("Goal" :in-theory (enable bitn))))
-
-;this is the most interesting case. perhaps add the other cases for k<0 and k>i-j
-(defthm bitn-bits
-  (implies (and (<= k (- i j))
-                (case-split (<= 0 k))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (bitn (bits x i j) k)
-                  (bitn x (+ j k))))
-  :hints (("Goal" :in-theory (e/d ( bitn) (BITS-FL)))))
-
-;The following trivial corollary of bitn-bits is worth keeping enabled.
-
-(defthm bitn-bits-constants
-  (implies (and (syntaxp (quotep i))
-                (syntaxp (quotep j))
-                (syntaxp (quotep k))
-                (<= k (- i j))
-                (<= 0 k)
-                (integerp i)
-                (integerp j)
-                (integerp k))
-           (equal (bitn (bits x i j) k)
-                  (bitn x (+ j k)))))
-
-
-(defthmd bit+*k-2
-  (implies (and (< x (expt 2 m))
-                (<= 0 x)
-                (rationalp x)
-                (<= m n)
-                (integerp k)
-                (case-split (integerp n))
-                (case-split (integerp m))
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn k (- n m))))
-  :hints (("Goal" :in-theory (enable bitn bits+2**k-2))))
-
-(defthmd bitn-shift-3
-  (implies (and (bvecp x m)
-                (<= m n)
-                (integerp k)
-                (case-split (integerp n))
-                (case-split (integerp m))
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn k (- n m))))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (bit+*k-2))))
-
-
-;try
-
-(local
- (defthm bit-expo-c-4
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (integerp k)
-                 (<= k n)
-                 (< x (expt 2 n))
-                 (<= (- (expt 2 n) (expt 2 k)) x))
-            (= (fl (/ x (expt 2 k)))
-               (1+ (* 2 (1- (expt 2 (1- (- n k))))))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (set-difference-theories
-                               (enable expt-split expt-minus )
-                               '())
-            :use ((:instance fl-unique (x (/ x (expt 2 k))) (n (1- (expt 2 (- n k))))))))))
-
-
-
-(local
- (defthm bit-expo-c-6
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (integerp k)
-                 (< k n)
-                 (< x (expt 2 n))
-                 (<= (- (expt 2 n) (expt 2 k)) x))
-            (= (mod (fl (/ x (expt 2 k))) 2)
-               1))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable  expt-split
-                               )
-            :use ( ;(:instance bit-expo-c-5)
-                         (:instance bit-expo-c-4)
-                         (:instance mod-mult-eric (x 1) (y 2) (a (1- (expt 2 (1- (- n k))))))
-)))))
-
-;prove this from a more general result about bits??
-;BOZO bad name. doesn't mention expo !
-(defthm bit-expo-c
-    (implies (and (<= (- (expt 2 n) (expt 2 k)) x)
-                  (< x (expt 2 n))
-                  (< k n)
-                  (rationalp x);(integerp x) ;gen more!
-		  (integerp n)
-		  (integerp k)
-		  )
-	     (equal (bitn x k) 1))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance bitn-def (n k))
-			(:instance bit-expo-c-6)))))
-
-(defthmd bvecp-bitn-2
-    (implies (and (bvecp x n) ; bind free var n here
-                  (< k n)
-                  (<= (- (expt 2 n) (expt 2 k)) x)
-                  (integerp n)
-		  (integerp k)
-		  )
-	     (equal (bitn x k) 1))
-    :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (bit-expo-c))))
-
-(defthm bitn-bvecp-forward
-  (bvecp (bitn x n) 1)
-  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
-
-
-#| old:
-(defun BITN (x n)
-  (if (logbitp n x) 1 0))
-|#
-
-(defthm bitn-natp
-  (natp (bitn x n)))
-
-;BOZO do we want these?
-(defthmd bitn-fw-1
-  (implies (not (equal (bitn x n) 0))
-           (equal (bitn x n) 1)
-           )
-  :rule-classes (:forward-chaining))
-
-(defthmd bitn-fw-2
-  (implies (not (equal (bitn x n) 1))
-           (equal (bitn x n) 0)
-           )
-  :rule-classes (:forward-chaining))
-
-(defthmd bvecp-bitn-0
-  (implies (bvecp x n)
-           (equal (bitn x n) 0))
-  :hints (("Goal" :in-theory (enable bitn bvecp-bits-0))))
-
-
-;make an alt version?
-(defthm bitn-bvecp-0
-  (implies (and (bvecp x n)
-                (<= 0 m)
-                )
-           (equal (bitn x (+ m n)) 0))
-  :hints (("Goal" :in-theory (disable bvecp-bitn-0)
-           :use ((:instance bvecp-bitn-0 (n (+ m n)))))))
-
-;k is a free var
-;do we need this, if we have bvecp-longer?
-(defthm bitn-bvecp-0-eric
-  (implies (and (bvecp x k)
-                (<= k n))
-           (equal (bitn x n) 0))
-  :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :in-theory (enable bvecp-bitn-0))))
-
-
-;sort of a "bitn-tail" like bits-tail?
-(defthm bitn-bvecp-1
-    (implies (bvecp x 1)
-	     (equal (bitn x 0) x))
-    :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-(defthmd bvecp-bitn-1
-    (implies (and (bvecp x (1+ n))
-		  (<= (expt 2 n) x)
-                  (natp n))
-	     (equal (bitn x n) 1))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (bit-expo-b))))
-
-;handle the case where we don't go down to 0?
-(defthm bits-bitn
-  (implies (and (case-split (integerp i))
-                (case-split (<= 0 i))
-                )
-  (equal (bits (bitn x n) i 0)
-         (bitn x n)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn)
-                              '()))))
-
-(defthmd bitn-neg
-  (implies (and (< n 0)
-                (integerp x))
-           (equal (bitn x n) 0))
-  :hints (("Goal" :in-theory (enable bitn bits-neg))))
-
-; Start proof of sum-bitn.
-
-(defun all-bits-p (b k)
-  (if (zp k)
-      t
-    (and (or (= (nth (1- k) b) 0)
-	     (= (nth (1- k) b) 1))
-	 (all-bits-p b (1- k)))))
-
-(defun sum-b (b k)
-  (if (zp k)
-      0
-    (+ (* (expt 2 (1- k)) (nth (1- k) b))
-       (sum-b b (1- k)))))
-
-(defthm sum-b-bounds
-  (implies (all-bits-p b k)
-           (and (<= 0 (sum-b b k))
-                (< (sum-b b k) (expt 2 k))))
-  :hints (("Goal" :expand ((expt 2 k))))
-  :rule-classes :linear)
-
-(defun sum-b-alt (b lower upper)
-  (if (or (zp upper) ; for termination
-          (equal upper lower))
-      0
-    (+ (* (expt 2 (1- upper)) (nth (1- upper) b))
-       (sum-b-alt b lower (1- upper)))))
-
-(defthmd sum-b-alt-split
-  (implies (and (<= lower k)
-                (< k upper)
-                (integerp upper)
-                (natp k))
-           (equal (sum-b-alt b lower upper)
-                  (+ (sum-b-alt b lower k)
-                     (* (expt 2 k) (nth k b))
-                     (sum-b-alt b (1+ k) upper)))))
-
-(defthm nth-nthcdr
-  (implies (and (natp i)
-                (natp j))
-           (equal (nth i (nthcdr j x))
-                  (nth (+ i j) x))))
-
-(defthm sum-b-alt-is-sum-b
-  (implies (and (natp lower)
-                (natp upper)
-                (all-bits-p b upper)
-                (<= lower upper))
-           (equal (sum-b-alt b lower upper)
-                  (* (expt 2 lower)
-                     (sum-b (nthcdr lower b) (- upper lower))))))
-
-(defthm all-bits-p-goes-down
-  (implies (and (all-bits-p b n)
-                (<= k n)
-                (natp n)
-                (natp k))
-           (all-bits-p b k)))
-
-(defthmd sum-b-split
-  (implies (and (< k upper)
-                (natp k)
-                (integerp upper)
-                (natp upper)
-                (all-bits-p b upper))
-           (equal (sum-b b upper)
-                  (+ (sum-b b k)
-                     (* (expt 2 k) (nth k b))
-                     (* (expt 2 (1+ k))
-                        (sum-b (nthcdr (1+ k) b) (1- (- upper k)))))))
-  :hints (("Goal" :use ((:instance sum-b-alt-split (lower 0))))))
-
-(defthm natp-sum-b
-  (implies (and (force (all-bits-p b k))
-                (force (natp k)))
-           (natp (sum-b b k)))
-  :rule-classes :type-prescription)
-
-(defthm all-bits-p-nthcdr-cdr
-  (implies (and (natp k)
-                (natp n)
-                (all-bits-p x n)
-                (< k n))
-           (all-bits-p (nthcdr k (cdr x)) (+ -1 n (* -1 k)))))
-
-(defthm sum-bitn-1-1
-  (implies (and (natp n)
-                (all-bits-p b n)
-                (natp k)
-                (< k n))
-           (equal (bitn (+ (sum-b b k)
-                           (* (expt 2 k) (nth k b))
-                           (* (expt 2 (1+ k))
-                              (sum-b (nthcdr (1+ k) b) (1- (- n k)))))
-                        k)
-                  (bitn (+ (sum-b b k)
-                           (* (expt 2 k) (nth k b)))
-                        k)))
-  :hints (("Goal"
-           :use ((:instance bitn-plus-mult
-                            (x (+ (sum-b b k)
-                                  (* (expt 2 k) (nth k b))))
-                            (k (sum-b (nthcdr (1+ k) b) (1- (- n k))))
-                            (m (1+ k))
-                            (n k)))))
-  :rule-classes nil)
-
-(defthm sum-bitn-1-2
-  (implies (and (natp n)
-                (all-bits-p b n)
-                (natp k)
-                (< k n))
-           (equal (bitn (+ (sum-b b k)
-                           (* (expt 2 k) (nth k b)))
-                        k)
-                  (nth k b)))
-  :rule-classes nil)
-
-(defthmd sum-bitn-1
-  (implies (and (natp n)
-                (all-bits-p b n)
-                (natp k)
-                (< k n))
-           (equal (bitn (+ (sum-b b k)
-                           (* (expt 2 k) (nth k b))
-                           (* (expt 2 (1+ k))
-                              (sum-b (nthcdr (1+ k) b) (1- (- n k)))))
-                        k)
-                  (nth k b)))
-  :hints (("Goal" :use (sum-bitn-1-1 sum-bitn-1-2))))
-
-(defthmd sum-bitn
-  (implies (and (natp n)
-		(all-bits-p b n)
-	        (natp k)
-		(< k n))
-           (equal (bitn (sum-b b n) k)
-	          (nth k b)))
-  :hints (("Goal" :use sum-bitn-1
-           :in-theory (enable sum-b-split))))
diff -Nru acl2-6.2/books/rtl/rel5/support/bitn.lisp acl2-6.3/books/rtl/rel5/support/bitn.lisp
--- acl2-6.2/books/rtl/rel5/support/bitn.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bitn.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,683 +0,0 @@
-(in-package "ACL2")
-
-(include-book "ground-zero")
-(include-book "../arithmetic/power2p")
-(include-book "../arithmetic/negative-syntaxp")
-(local (include-book "bitn-proofs"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-;; Necessary defuns:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;;
-;; Begin bitn stuff...
-;;
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defthm bitn-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (bitn x n)
-                  0)))
-
-(defthm bitn-of-non-rational
-  (implies (not (rationalp x))
-           (equal (bitn x n)
-                  0)))
-
-(defthm bitn-nonnegative-integer
-  (and (integerp (bitn x n))
-       (<= 0 (bitn x n)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than bitn-nonnegative-integer and might be worse:
-(in-theory (disable (:type-prescription bitn)))
-
-(defthm bitn-natp
-  (natp (bitn x n)))
-
-(defthm bitn-upper-bound
-  (<= (bitn x n) 1))
-
-(defthm bitn-upper-bound-linear
-  (<= (bitn x n) 1)
-  :rule-classes ((:LINEAR :TRIGGER-TERMS ((bitn x n)))))
-
-;include separate cases?
-;BOZO one of the branches simplifies to 0 - see bits-minus
-(defthm bitn-minus
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x)) ;gen?
-                (case-split (integerp n))
-                )
-           (equal (bitn x n)
-                  (if (integerp (/ x (expt 2 (+ 1 n))))
-                      (- (bitn (- x) n))
-                    (if (integerp (/ x (expt 2 n)))
-                        (- 2 (bitn (- x) n))
-                      (- 1 (bitn (- x) n)))))))
-;1 rewrite to odd?
-;trying disabled
-(defthmd bitn-0-rewrite-to-even
-  (implies (integerp x)
-           (equal (equal (bitn x 0) 0)
-                  (integerp (* 1/2 x)))))
-
-;we probably want this enanled in lib/ but not in support/
-(defthmd bits-n-n-rewrite
-  (equal (bits x n n)
-         (bitn x n)))
-
-(theory-invariant (incompatible (:rewrite bits-n-n-rewrite)
-                                (:definition bitn)
-                                )
-                  :key bitn-and-bits-n-n-can-loop)
-
-(defthm bitn-0-1
-  (or (equal (bitn x n) 0)
-      (equal (bitn x n) 1))
-  :rule-classes nil)
-
-
-;my strategy with the rules below is to prefer (not (equal (bitn x n) 0)) over (equal (bitn x n) 1)
-;this allows subsumption to ...
-;but maybe this is a bad idea!
-;BOZO if we have f-w chaining rule to handle this issue, perhaps drop these rules?
-
-;bad to have both?
-(defthm bitn-not-0-means-1
-  (equal (not (equal (bitn x n) 0))
-         (equal (bitn x n) 1)))
-
-(defthm bitn-not-1-means-0
-  (equal (not (equal (bitn x n) 1))
-         (equal (bitn x n) 0)))
-
-;these are bad rules?
-(in-theory (disable bitn-not-1-means-0 bitn-not-0-means-1))
-
-(defthm bitn-bitn
-  (equal (bitn (bitn x n) 0)
-         (bitn x n)))
-
-(defthm bitn-known-not-0-replace-with-1
-  (implies (not (equal (bitn x n) 0)) ; backchain-limit?
-           (equal (bitn x n)
-                  1))
-  :rule-classes ((:rewrite :backchain-limit-lst (1)))
-  )
-
-;needed?
-(defthm bitn->-0
-  (equal (< 0 (bitn x n))
-         (not (equal 0 (bitn x n)))))
-
-(defthm bitn-<-1
-  (equal (< (BITN X n) 1)
-         (equal (BITN X n) 0)))
-
-;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
-(defthm bitn-not->-1
-  (implies (and (syntaxp (quotep k))
-                (<= 1 k))
-           (equal (< k (bitn x n))
-                  nil)))
-
-;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
-(defthm bitn-<=-1
-  (implies (and (syntaxp (quotep k))
-                (< 1 k))
-           (equal (< (bitn x n) k)
-                  t)))
-
-(defthmd bitn-rec-0
-  (implies (integerp x)
-           (equal (bitn x 0)
-                  (mod x 2))))
-
-;rename?
-;is there a bits analog of this theorem?
-;BOZO change formal k to n
-(defthmd bitn-rec-pos
-  (implies (< 0 n) ;n cannot be 0 or negative
-           (equal (bitn x n)
-                  (bitn (fl (/ x 2)) (1- n))))
-  :rule-classes ((:definition :controller-alist ((bitn t t)))))
-
-;BOZO change k param to n
-(defthmd bitn-def
-  (implies (case-split (integerp n))
-           (equal (bitn x n)
-                  (mod (fl (/ x (expt 2 n)))
-                       2))))
-
-;make bit-not, bit-and, etc. ?
-;BOZO or remove this function?
-(defun not-eric (x)
-  (if (equal x 0)
-      1
-    0))
-
-(defthm bitn-drop-crucial-bit-and-flip-result
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n)) ;drop?
-                )
-           (and (equal (bitn (+ (expt 2 n) x) n)
-                       (not-eric (bitn x n)))
-                (equal (bitn (+ x (expt 2 n)) n)
-                       (not-eric (bitn x n))))))
-
-;BOZO this looped!
-(defthmd bitn-drop-crucial-bit-and-flip-result-alt-gen
-  (implies (and (syntaxp (and (quotep j) 
-                              (< (cadr j) (expt 2 (+ 1 (cadr n)))) ;bitn-sum-lowbits does most of the work
-                              (>= (cadr j) (expt 2 (cadr n)))))
-                (rationalp j)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (bitn (+ j x) n)
-                  (not-eric (bitn (+ (- j (expt 2 n)) x) n)))))
-
-;for negative constants j
-;might be slow if the negative constant has a large absolute value
-;make a negative version of bitn-sum-lowbits
-(defthm bitn-add-crucial-bit-and-flip-result
-  (implies (and (syntaxp (and (quotep j) 
-                              (quotep n)
-                              (< (cadr j) 0)))
-                (rationalp j)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (bitn (+ j x) n)
-                  (not-eric (bitn (+ (+ j (expt 2 n)) x) n)))))
-
-(defthm bitn-equal-to-silly-value
-  (implies (and (syntaxp (quotep k))
-                (not (or (equal 0 k) (equal 1 k)))
-                )
-           (equal (equal k (bitn x n))
-                  nil)))
-                         
-(defthm bitn-split-around-zero
-  (implies (and (<= (- (expt 2 n)) x)
-                (< x (expt 2 n))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (equal (bitn x n) 0)
-                  (<= 0 x))))
-
-;drop silly hyps like: (<= -128 (bitn x 24))
-(defthm bitn-drop-silly-bound
-  (implies (and (syntaxp (quotep k))
-                (<= k 0)
-                )
-           (equal (< (bitn x n) k)
-                  nil)))
-
-(defthm bitn-drop-silly-bound-2
-  (implies (and (syntaxp (quotep k))
-                (< k 0)
-                )
-           (equal (< k (bitn x n))
-                  t)))
-
-;there are many other ways to say that something is even (include those?)
-(defthm bitn-even-means-0
-  (equal (integerp (* 1/2 (bitn x n)))
-         (equal (bitn x n) 0)))
-
-;new - export disabled?
-(defthm bitn-too-small
-  (implies (and (< x (expt 2 n))
-                (<= 0 x) ;case-split?
-                )
-           (equal (bitn x n)
-                  0))
-  :rule-classes ((:rewrite :backchain-limit-lst (1 nil))))
-
-;not sure how to handle this.
-(defthmd bitn-normal-form
-  (equal (equal (bitn x n) 1)
-         (not (equal (bitn x n) 0))))
-
-(defthm bitn-bvecp
-  (implies (and (<= 1 k)
-                (case-split (integerp k)))
-           (bvecp (bitn x n) k)))
-
-(defthm bitn-times-fraction-integerp 
-  (implies (and (not (integerp k))
-                (case-split (acl2-numberp k))
-                )
-           (equal (INTEGERP (* k (BITN x n)))
-                  (equal (BITN x n) 0))))
-
-(defthm bitn-in-product-split-cases
-  (and (implies (case-split (acl2-numberp k))
-                (equal (* (bitn x n) k)
-                       (if (equal (bitn x n) 0)
-                           0
-                         k)))
-       (implies (case-split (acl2-numberp k))
-                (equal (* k (bitn x n))
-                       (if (equal (bitn x n) 0)
-                           0
-                         k)))))
-
-(defthm bitn-in-sum-split-cases
-  (and (implies (case-split (acl2-numberp k))
-                (equal (+ k (bitn x n))
-                       (if (equal (bitn x n) 0)
-                           k
-                         (+ k 1))))
-       (implies (case-split (acl2-numberp k))
-                (equal (+ (bitn x n) k)
-                       (if (equal (bitn x n) 0)
-                           k
-                         (+ k 1))))))
-
-;BOZO change params
-(defthm bitn-0
-  (equal (bitn 0 k)
-         0))
-
-(defthmd bitn-fw-1
-  (implies (not (equal (bitn x n) 0))
-           (equal (bitn x n) 1)
-           )
-  :rule-classes (:forward-chaining))
-
-(defthmd bitn-fw-2
-  (implies (not (equal (bitn x n) 1))
-           (equal (bitn x n) 0)
-           )
-  :rule-classes (:forward-chaining))
-
-;may cause case splits (maybe that's good?) 
-(defthm bitn-expt-gen
-  (implies (case-split (integerp i))
-           (equal (bitn (expt 2 i) n)
-                  (if (equal i n)
-                      1
-                    0))))
-
-;BOZO consider having only the rule above?
-(defthmd bitn-expt
-  (implies (case-split (integerp n))
-           (equal (bitn (expt 2 n) n) 1)))
-
-
-;These are intended for the (perhaps weird) case when x in (bitn x n) is a constant but n is not a constant.
-;I actually had this term in a proof: (EQUAL (BITN 128 (BITS <signal-name> 8 6)) 0)
-(defthm bitn-of-expt-equal-0
-  (implies (and (syntaxp (quotep x))
-                (equal x (expt 2 (expo x))) ;means x is a power of 2
-                )
-           (equal (equal (bitn x n) 0)
-                  (not (equal n (expo x))))));note that (expo x) will be a constant since x is
-
-(defthm bitn-of-expt-equal-1
-  (implies (and (syntaxp (quotep x))
-                (equal x (expt 2 (expo x))) ;means x is a power of 2
-                )
-           (equal (equal (bitn x n) 1)
-                  (equal n (expo x))))) ;note that (expo x) will be a constant since x is
-
-(defthmd bitn-expt-0
-  (implies (and (not (equal i n))
-		(case-split (integerp i)))
-	   (equal (bitn (expt 2 i) n) 0)))
-
-(defthm bitn-0-1
-    (or (equal (bitn x n) 0)
-        (equal (bitn x n) 1))
-  :rule-classes ())
-
-;BOZO enable?
-(defthmd bitn-shift-eric
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* x (expt 2 k)) n)
-                  (bitn x (+ n (- k))))))
-
-(defthmd bitn-shift-eric-2
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* (expt 2 k) x) n)
-                  (bitn x (+ n (- k))))))
-
-;BOZO replace with bitn-shift-eric ??
-(defthmd bitn-shift
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* x (expt 2 k)) (+ n k))  ;BOZO rewrite the (+ n k) to match better
-                  (bitn x n)))) 
-
-;dammit, ACL2 unifies 0 with (* 2 x), so this rule can loop!
-(defthm bitn-shift-by-2
-  (implies (and (syntaxp (not (quotep x)))
-                (acl2-numberp n))
-           (equal (BITN (* 2 x) n)
-                  (bitn x (1- n)))))
-
-(defthmd bitn-plus-mult
-  (implies (and (< n m)
-                (integerp m)
-                (integerp k)
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn x n))))
-
-(defthmd bitn-plus-mult-rewrite
-    (implies (and (syntaxp (quotep c))
-		  (equal (mod c (expt 2 (1+ n))) 0))
-	     (equal (bitn (+ c x) n)
-		    (bitn x n))))
-
-;we almost always want to leave this disabled!
-(defthmd bitn-plus-bits
-  (implies (and (<= m n)
-                (integerp m)
-                (integerp n)
-                )
-           (= (bits x n m)
-              (+ (* (bitn x n) (expt 2 (- n m)))
-                 (bits x (1- n) m)))))
-
-;BOZO it's in r-c nil.  we almost always want to leave this disabled!
-(defthm bits-plus-bitn
-    (implies (and (<= m n)
-                  (integerp m)
-		  (integerp n)
-		  )
-	     (= (bits x n m)
-		(+ (bitn x m)
-		   (* 2 (bits x n (1+ m))))))
-  :rule-classes ())
-
-;drop?
-(defthm bits-0-bitn-0
-  (implies (and (<= 0 n)
-                (integerp n)
-                )
-           (iff (= (bits x n 0) 0)
-                (and (= (bitn x n) 0)
-                     (= (bits x (1- n) 0) 0))))
-  :rule-classes ())
-
-;Follows from bits-shift-down-1
-(defthmd bitn-shift-down
-  (implies (and (natp i)
-                (integerp k))
-           (equal (bitn (fl (/ x (expt 2 k))) i)
-                  (bitn x (+ i k)))))
-
-(defthm bitn-shift-by-constant-power-of-2
-  (implies (and (syntaxp (quotep k))
-                (power2p k)
-                (case-split (integerp n))
-                )
-           (equal (bitn (* k x) n)
-                  (bitn x (- n (expo k))))))
-
-
-
-;generalize to bits-mod?
-(defthmd bitn-mod
-  (implies (and (< k n)
-                (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (mod x (expt 2 n)) k)
-                  (bitn x k))))
-
-;dup?
-(defthm BIT-EXPO-A
-  (implies (and (< x (expt 2 n))
-                (>= x 0)
-                (integerp n)
-                )
-           (equal (bitn x n) 0))
-  :rule-classes ())
-
-;special case of  bit-expo-c?
-(defthm BIT-EXPO-B
-  (implies (and (<= (expt 2 n) x)
-                (< x (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                ;(>= x 0)
-                ;(>= n 0)
-                )
-           (equal (bitn x n) 1))
-  :rule-classes ())
-
-;bozo. combine these next 2?
-
-;bozo. dup?
-(defthm bitn-plus-expt-1
-  (implies (and (rationalp x)
-                (integerp n)
-                )
-           (not (equal (bitn (+ x (expt 2 n)) n)
-                       (bitn x n))))
-  :rule-classes ()
-)
-
-
-;bozo. dup?
-;prove from bitn-plus-mult?
-(defthm bitn-plus-expt-2
-  (implies (and (< n m)
-                (integerp n)
-                (integerp m)
-                )
-           (equal (bitn (+ x (expt 2 m)) n)
-                  (bitn x n))))
-
-
-;this is the most interesting case. perhaps add the other cases for k<0 and k>i-j
-(defthm bitn-bits
-  (implies (and (<= k (- i j))
-                (case-split (<= 0 k))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (bitn (bits x i j) k)
-                  (bitn x (+ j k)))))
-
-;The following trivial corollary of bitn-bits is worth keeping enabled.
-
-(defthm bitn-bits-constants
-  (implies (and (syntaxp (quotep i))
-                (syntaxp (quotep j))
-                (syntaxp (quotep k))
-                (<= k (- i j))
-                (<= 0 k)
-                (integerp i)
-                (integerp j)
-                (integerp k))
-           (equal (bitn (bits x i j) k)
-                  (bitn x (+ j k)))))
-
-(defthmd bitn-shift-3
-  (implies (and (bvecp x m)
-                (<= m n)
-                (integerp k)
-                (case-split (integerp n))
-                (case-split (integerp m))
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn k (- n m)))))
-
-;reconcile param names with bits version?
-;like  bitn-shift-3
-;rename!
-
-(defthmd bit+*k-2
-  (implies (and (< x (expt 2 m))
-                (<= 0 x)
-                (rationalp x)
-                (<= m n)
-                (integerp k)
-                (case-split (integerp n))
-                (case-split (integerp m))
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn k (- n m)))))
-
-(defthm bit-expo-c
-    (implies (and (<= (- (expt 2 n) (expt 2 k)) x)
-                  (< x (expt 2 n))
-                  (< k n)
-                  (rationalp x);(integerp x) ;gen more!
-		  (integerp n)
-		  (integerp k)
-		  )
-	     (equal (bitn x k) 1))
-  :rule-classes ())
-
-;Follows from bit-expo-c
-;requires x to be an integer, unlike bit-expo-c.
-(defthmd bvecp-bitn-2
-    (implies (and (bvecp x n) ; bind free var n here
-                  (< k n)
-                  (<= (- (expt 2 n) (expt 2 k)) x)
-                  (integerp n)
-		  (integerp k)
-		  )
-	     (equal (bitn x k) 1))
-    :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (bit-expo-c))))
-
-(defthm bitn-bvecp-forward
-  (bvecp (bitn x n) 1)
-  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
-
-;could combine these next two?
-
-;BOZO enable?
-(defthmd bvecp-bitn-0
-  (implies (bvecp x n)
-           (equal (bitn x n) 0)))
-
-;make an alt version?
-;trying disabled..
-(defthmd bitn-bvecp-0
-  (implies (and (bvecp x n)
-                (<= 0 m)
-                )
-           (equal (bitn x (+ m n)) 0)))
-
-;k is a free var
-;do we need this, if we have bvecp-longer?
-(defthm bitn-bvecp-0-eric
-  (implies (and (bvecp x k)
-                (<= k n))
-           (equal (bitn x n) 0))
-  :rule-classes ((:rewrite :match-free :all)))
-
-;sort of a "bitn-tail" like bits-tail?
-(defthm bitn-bvecp-1
-  (implies (bvecp x 1)
-           (equal (bitn x 0) x)))
-
-;rename
-(defthmd bvecp-bitn-1
-    (implies (and (bvecp x (1+ n))
-		  (<= (expt 2 n) x)
-                  (natp n))
-	     (equal (bitn x n) 1)))
-
-;handle the case where we don't go down to 0?
-(defthm bits-bitn
-  (implies (and (case-split (integerp i))
-                (case-split (<= 0 i))
-                )
-  (equal (bits (bitn x n) i 0)
-         (bitn x n))))
-
-(defthmd bitn-neg
-  (implies (and (< n 0)
-                (integerp x))
-           (equal (bitn x n) 0)))
-
-(defun all-bits-p (b k)
-  (if (zp k)
-      t
-    (and (or (= (nth (1- k) b) 0)
-	     (= (nth (1- k) b) 1))
-	 (all-bits-p b (1- k)))))
-
-(defun sum-b (b k)
-  (if (zp k)
-      0
-    (+ (* (expt 2 (1- k)) (nth (1- k) b))
-       (sum-b b (1- k)))))
-
-(defthmd sum-bitn
-  (implies (and (natp n)
-		(all-bits-p b n)
-	        (natp k)
-		(< k n))
-           (equal (bitn (sum-b b n) k)
-	          (nth k b))))
diff -Nru acl2-6.2/books/rtl/rel5/support/bits-proofs.lisp acl2-6.3/books/rtl/rel5/support/bits-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/bits-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bits-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1811 +0,0 @@
-(in-package "ACL2")
-
-(include-book "ground-zero")
-(include-book "../arithmetic/negative-syntaxp")
-(include-book "../arithmetic/power2p")
-
-(local (include-book "../arithmetic/top"))
-(local (include-book "bvecp"))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-
-;this book is still a mess
-
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-#|
-
-The new version of bits is like Russinoff's "bits" but uses mod instead of rem.
-The use of "mod" seems to allow nicer results to be proved.
-
-For example, bits now *always* returns a non-negative integer.  Many hyps of other lemmas require
-expressions to be non-negative integers, and with the old bits, this requires further checking of the
-arguments (at worst, checking all the way to the leaves of the expression tree each time).
-
-Add case-split to all hyps about i and j (indices to bits must be integers and j must be <= i or else weird
-stuff may happen (but we can easily handle these cases).
-
-|#
-
-;In proofs about RTL terms, i and j should always be natural number constants
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defthm bits-nonnegative-integerp-type
-  (and (<= 0 (bits x i j))
-       (integerp (bits x i j)))
-  :hints (("Goal" :in-theory (enable bits)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than bits-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription bits)))
-
-;dup with bits-0!
-(defthm bits-with-x-0
-  (equal (bits 0 i j)
-         0)
-  :hints (("Goal" :in-theory (enable bits))))
-
-(defthm bits-with-i-not-an-integer
-  (implies (not (integerp i))
-           (equal (bits x i j)
-                  0))
-  :hints (("Goal" :in-theory (enable bits))))
-
-(defthm bits-with-j-not-an-integer
-  (implies (not (integerp j))
-           (equal (bits x i j)
-                  0))
-  :hints (("Goal" :in-theory (enable bits))))
-
-(defthm bits-with-indices-in-the-wrong-order
-  (implies (< i j)
-           (equal (bits x i j)
-                  0))
-  :hints (("Goal" :in-theory (enable bits))))
-
-(defthm bits-upper-bound
-  (< (bits x i j) (expt 2 (+ 1 i (- j))))
-  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j))))
-  :hints (("Goal" :in-theory (enable bits 
-                                     expt-minus
-                                     expt-split))))
-
-;has the right pattern to rewrite stuff like this: (<= (EXPT 2 J) (BITS Y (+ -1 J) 0)) to nil
-(defthm bits-upper-bound-special
-  (< (BITS x (1- i) 0) (EXPT 2 i))
-  :hints (("Goal" :use (:instance bits-upper-bound (i (1- i)) (j 0))))
-  )
-
-;tigher bound
-(defthm bits-upper-bound-tighter
-  (implies (case-split (<= j i))
-           (<= (bits x i j) (1- (expt 2 (+ i 1 (- j))))))
-  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j))))
-  :hints (("Goal" :cases ((rationalp x) (not (acl2-numberp x)))
-           :in-theory (enable bits 
-                              expt-minus
-                              expt-split))))
-
-  
-;like  mod-upper-bound-3
-(defthm bits-upper-bound-2
-  (implies (and (<= (expt 2 (+ 1 i (- j))) z) ;backchain-limit?
-                ;(case-split (integerp i))
-                ;(case-split (integerp j))
-                )
-           (< (bits x i j) z)))
-
-
-
-#|
-;I have many theorems dealing with the simplification of bits of a sum
-
-(include-book
- "lowbits")
-
-
-;taking sort of a long time (3-4 secs)
-(defthm bits-sum-lowbits
-  (implies (and (rationalp x)
-                (rationalp y)
-                (integerp i)
-                (integerp j))
-           (equal (bits (+ x             y) i j)
-                  (bits (+ (lowbits x i) y) i j)))
-  :hints (("Goal" :in-theory (enable ;mod-cancel
-                              bits
-                              lowbits))))
-(in-theory (disable bits-sum-lowbits))
-
-;special case of the above -- helps rewrite the constant to a unique (positive) value
-;make another rule to handle negative constants
-(defthm bits-sum-reduce-leading-constant
-  (implies (and (syntaxp (and (quotep x) (>= (cadr x) (expt 2 (+ (cadr i) 1)))))
-                (rationalp x)
-                (rationalp y)
-                (integerp i)
-                (integerp j))
-           (equal (bits (+ x             y) i j)
-                  (bits (+ (lowbits x i) y) i j)))
-  :hints (("Goal" :use bits-sum-lowbits )))
-
-(defun oldbits (x i j)
-  (fl (/ (rem x (expt 2 (1+ i))) (expt 2 j))))
-
-(in-theory (disable bits)) ;move up
-
-;(in-theory (disable INTEGER-HAS-DENOM-1-OTHER-WAY))
-
-(in-theory (disable rem))
-
-
-|#
-
-;a is a free var
-(defthm bits-force
-  (implies (and (<= (* a (expt 2 (+ i 1))) x)
-                (< x (* (1+ a) (expt 2 (+ i 1))))
-                (integerp x)
-                (integerp i)
-;                (<= 0 i)
-                (integerp a)
-                )
-           (equal (bits x i 0) (- x (* a (expt 2 (+ i 1))))))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (enable bits)
-           :use (:instance  mod-force-eric (y (expt 2 (+ i 1)))))))
-
-(defthm bits-force-with-a-chosen-neg
-  (implies (and (< x 0)
-                (<= (* -1 (expt 2 (+ i 1))) x)
-;                (<= 0 i)
-                (integerp x)
-                (integerp i)
-                )
-           (equal (bits x i 0) (- x (* -1 (expt 2 (+ i 1))))))
-  :hints (("Goal" 
-           :use (:instance bits-force (a -1)))))
-                                      
-;remove:?
-;(in-theory (disable bits-force))
-
-;expensive?
-;make a corollary?
-(defthm bits-shift
-  (implies (and ;(rationalp x)
-            (case-split (integerp n))
-            (case-split (integerp i))
-            (case-split (integerp j))
-            )
-           (and (equal (bits (* (expt 2 n) x) i j)
-                       (bits x (- i n) (- j n)))
-                (equal (bits (* x (expt 2 n)) i j)
-                       (bits x (- i n) (- j n)))))
-  :hints (("Goal" :cases ((and (acl2-numberp n) (not (rationalp n)))
-                          (and (rationalp n) (not (integerp n)))
-                          (integerp n))
-           :in-theory (e/d (expt-minus
-                              mod-cancel
-                              bits 
-                              expt-split
-                            
-                              )
-                           (  ;these are disabled to speed up he proof:
-                            INTEGERP-PROD-OF-3-FIRST-AND-LAST
-                              INTEGERP-PROD-OF-3-LAST-TWO
-                              a10
-                              a13)))))
-
-; Basically a restatement of bits-shift:
-(defthm bits-shift-up-1
-  (implies (and (integerp k)
-		(integerp i)
-		(integerp j))
-	   (equal (bits (* (expt 2 k) x) i j)
-		  (bits x (- i k) (- j k))))
-  :hints (("Goal" :use ((:instance bits-shift (n k)))))
-  :rule-classes ())
-
-#| original:
-(defthm bits-shift
-  (implies (and ;(rationalp x)
-            (case-split (integerp n))
-            (case-split (integerp i))
-            (case-split (integerp j))
-            )
-           (and (equal (bits (* (expt 2 n) x) i j)
-                       (bits x (- i n) (- j n)))
-                (equal (bits (* x (expt 2 n)) i j)
-                       (bits x (- i n) (- j n)))))
-  :hints (("Goal" :cases ((and (acl2-numberp n) (not (rationalp n)))
-                          (and (rationalp n) (not (integerp n)))
-                          (integerp n))
-           :in-theory (enable expt-minus
-                              mod-cancel
-                              bits 
-                              expt-split))))
-|#
-
-(local (in-theory (enable mod-cancel)))
-  
-;allows you to split bit vectors into two parts
-;free var n (where to split)
-;resembles doc's bits-plus-bits-1 and another rule in merge
-(defthm bits-plus-bits2
-  (implies (and ;(rationalp x)
-                (integerp i) 
-                (integerp j)
-                (integerp n)
-                (<= j n)
-                (<= n i)
-                )
-           (equal (bits x i j)
-                  (+ (* (bits x i n) (expt 2 (- n j)))
-                     (bits x (1- n) j))))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (enable bits mod expt-split expt-minus))))
-
-;a hint that worked for this before I made such nice rules is in junk.lisp under bits-plus-bits-hint
-
-;(in-theory (disable bits-plus-bits-1)) ;keep disabled
-
-
-#|
-;use mbitn?
-;could use even-odd phrasing?
-(defthm bits-down-to-1-case-split
-  (implies (and (integerp x)
-                (<= 0 x)
-                (integerp i)
-                (<= 1 i))
-           (equal (bits x i 1)
-                  (if (equal (bitn x 0) 0)
-                      (/ (bits x i 0) 2) ;use the fact that we know bit 0 is 0?
-                    (/ (1- (bits x i 0)) 2) ;use the fact that we know bit 0 is 1?
-                    )))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable bits mod bitn))))
-|#
-
-;this really has two separate cases
-;generalize with j not 0?
-(defthm bits-split-around-zero
-  (implies (and (>= x (- (expt 2 (+ i 1))))
-                (< x (expt 2 (+ i 1)))
-                (integerp x)
-                (case-split (integerp i))
-                (case-split (<= 0 i))
-                )
-           (equal (bits x i 0)
-                  (if (<= 0 x)
-                      x
-                    (+ x (expt 2 (+ i 1))))))
- :hints (("Goal" :in-theory (enable bits)
-          :use ((:instance bits-force (a 0))
-                (:instance bits-force (a -1))))))
-
-
-;(local (in-theory (disable expt-inverse)))
-
-(defthm bits-bvecp-simple
-  (implies (equal k (+ 1 i (* -1 j)))
-           (bvecp (bits x i j) k))
-  :hints (("Goal" :in-theory (enable 
-                              bvecp))))
-
-
-
-(defthm bits-bvecp
-  (implies (and (<= (+ 1 i (- j)) k)
-                (case-split (integerp k))
-                )
-           (bvecp (bits x i j) k))
-  :hints (("Goal" :use ((:instance bits-bvecp-simple
-                                   (k (+ 1 i (* -1 j)))))
-           :in-theory (disable bits-bvecp-simple))))
-
-(in-theory (disable bits-bvecp-simple))
-
-;do we want this rule enabled?
-(defthm bits-bvecp-fw
-  (implies (equal n (- (1+ i) j)) ; note equal here to help with the fw chaining
-           (bvecp (bits x i j) n))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((bits x i j)))))
-
-;these may be made moot by my method of using lowbits with bits of a sum
-
-#|
-(defthm bits-sum-simplify-first-term
-  (implies (and (>= (abs x) (expt 2 (+ j 1))) ;prevents loop
-                (rationalp x)
-                (rationalp y)
-                (integerp j)
-                (<= 0 j)
-                )
-           (equal (bits (+ x y) j 0)
-                  (bits (+ (lowbits x j) y) j 0)))
-  :hints (("Goal" :in-theory (enable lowbits
-                                     bits))))
-
-(defthm bits-sum-simplify-second-term
-  (implies (and (>= (abs x) (expt 2 (+ j 1))) ;prevents loop
-                (rationalp x)
-                (rationalp y)
-                (integerp j)
-                (<= 0 j)
-                )
-           (equal (bits (+ y x) j 0)
-                  (bits (+ (lowbits x j) y) j 0)))
-  :hints (("Goal" :in-theory (enable lowbits
-                                     bits))))
-
-|#
-
-
-(local (in-theory (disable mod-cancel)))
-
-;better names: make the dropped term x, the others a,b,c,...
-;;; more bits thms like this!
-
-(defthm bits-sum-drop-irrelevant-term-2-of-2
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ x y) i j)
-                  (bits x i j)))
-  :hints (("Goal" :cases ((rationalp y) (not (acl2-numberp y)))
-           :in-theory (enable bits))))
-
-(defthm bits-sum-drop-irrelevant-term-1-of-2
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ y x) i j)
-                  (bits x i j)))
-  :hints (("Goal"  :cases ((rationalp y) (not (acl2-numberp y)))
-           :in-theory (enable bits))))
-
-(defthm bits-sum-drop-irrelevant-term-3-of-3
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ w x y) i j)
-                  (bits (+ w x) i j)))
-  :hints (("Goal" :in-theory (disable bits-sum-drop-irrelevant-term-1-of-2
-                                      bits-sum-drop-irrelevant-term-2-of-2)
-           :use (:instance bits-sum-drop-irrelevant-term-1-of-2 (x (+ w x))))))
-
-(defthm bits-sum-drop-irrelevant-term-2-of-3
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ w y x) i j)
-                  (bits (+ w x) i j)))
-  :hints (("Goal" :in-theory (disable bits-sum-drop-irrelevant-term-3-of-3
-                                      bits-sum-drop-irrelevant-term-1-of-2
-                                      bits-sum-drop-irrelevant-term-2-of-2)
-           :use (:instance bits-sum-drop-irrelevant-term-1-of-2 (x (+ w x))))))
-#|
-(defthm bits-sum-drop-irrelevant-term-1-of-3
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp w)
-
-                (integerp i)
-                (<= 0 i)
-                (integerp j)
-                (<= 0 j)
-
-                (integerp (/ y (expt 2 (+ 1 i))))
-                )
-           (equal (bits (+ y w x) i j)
-                  (bits (+ w x) i j)))
-  :hints (("Goal" :in-theory (disable bits-sum-drop-irrelevant-term-2-of-3
-                                      bits-sum-drop-irrelevant-term-3-of-3
-                                      bits-sum-drop-irrelevant-term-1-of-2
-                                      bits-sum-drop-irrelevant-term-2-of-2)
-           :use (:instance bits-sum-drop-irrelevant-term-1-of-2 (x (+ w x))))))
-|#
-
-
-#|
-
-This series of events deals with simplifying expressions like
-(equal (bits x 8 0) 
-       (+ (bits x 6 0) k))
-Intuitively, bits 6 down-to 0 appear on both sides of the sum and should be "cancelled".  
-The remaining bits will need to be "shifted" back into place.
-
-More rules are probably needed to make the theory complete.
-|#
-
-#|
-(defthm bits-cancel-lowbits-in-comparison
-  (implies (and (> i+ i)
-                (rationalp k)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                )
-           (equal (equal (+ k (bits x i j))
-                         (bits x i+ j))
-                  (equal (* (expt 2 (+ 1 i (- j))) 
-                            (BITS X I+ (+ 1 I))) 
-                         k)))
-  :hints (("Goal"          
-           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
-           :in-theory (enable expt-split)
-           )))
-
-(defthm bits-cancel-lowbits-in-comparison-alt-2
-  (implies (and (> i+ i)
-                (rationalp k)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                )
-           (equal (equal (+ (bits x i j) k)
-                         (bits x i+ j))
-                  (equal (* (expt 2 (+ 1 i (- j))) 
-                            (BITS X I+ (+ 1 I))) 
-                         k)))
-  :hints (("Goal"          
-           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
-           :in-theory (enable expt-split)
-           )))
-|#
-
-#|
-;todo: rephrase the conclusion of the above by moving the "constant" (* 2 (EXPT 2 I) (/ (EXPT 2 J))) to the other
-;side
-;a good idea since k is usually divisible by that quantity (with the rule above, we often end up with an
-equality in which each side should have a power of 2 divided out of it
-; not needed if we have good meta rules for cancelling factors from an inequality
-
-
-(defthm bits-cancel-lowbits-in-comparison-2
-  (implies (and (> i+ i)
-                (rationalp k)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-
-                )
-           (equal (equal (+ k (bits x i j))
-                         (bits x i+ j))
-                  (equal (*  
-                            (BITS X I+ (+ 1 I))) 
-                         (/ k (expt 2 (+ 1 i (- j)))))))
-  :hints (("Goal"          
-           :use (:instance bits-cancel-lowbits-in-comparison)
-           :in-theory (set-difference-theories
-                       (enable expt-split)
-                       '(bits-cancel-lowbits-in-comparison))
-           )))
-|#
-
-#|
-
-(defthm bits-cancel-lowbits-in-comparison-3
-  (implies (and (> i+ i)
-                (rationalp k)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                (rationalp y)
-                )
-           (equal (equal (+ (bits x i+ j) k)
-                         (+ y (bits x i j)))
-                  (equal (* (expt 2 (+ 1 i (- j )))
-                            (BITS X I+ (+ 1 I))) 
-                         (- y k))))
-  :hints (("Goal"          
-           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
-           :in-theory (set-difference-theories
-                       (enable expt-split)
-                       '(
-                         BITS-CANCEL-LOWBITS-IN-COMPARISON-ALT-2))
-           )))
-
-;better conclusion?
-(defthm bits-cancel-lowbits-in-comparison-no-constant
-  (implies (and (> i+ i)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                )
-           (equal (equal (bits x i j)
-                         (bits x i+ j))
-                  (equal (* 2 (EXPT 2 I)
-                           (/ (EXPT 2 J))
-                           (BITS X I+ (+ 1 I))) 
-                         0)))
-  :hints (("Goal"          
-           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
-           :in-theory (set-difference-theories
-                       (enable expt-split)
-                       '( BITS-CANCEL-LOWBITS-IN-COMPARISON-ALT-2
-                          ))
-           )))
-
-(defthm bits-cancel-lowbits-in-comparison-no-constant-2
-  (implies (and (> i+ i)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                )
-           (equal (equal (bits x i+ j)
-                         (bits x i j))
-                  (equal (* 2 (EXPT 2 I)
-                           (/ (EXPT 2 J))
-                           (BITS X I+ (+ 1 I))) 
-                         0)))
-  :hints (("Goal"          
-           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
-           :in-theory (set-difference-theories
-                       (enable expt-split)
-                       '( BITS-CANCEL-LOWBITS-IN-COMPARISON-ALT-2
-))
-           )))
-
-;the theory above (cancelling bits in comparisons) is not complete
-;it should also deal with bitn
-;perhaps a bind-free rule would be a good idea here?
-
-|#
-
-
-;kind of yucky...
-(defthm bits-minus
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (<= j i))
-                (case-split (integerp j))
-                )
-           (equal (bits (* -1 x) i j)
-                  (if (integerp (* 1/2 x (/ (expt 2 i))))
-                      0
-                    (if (integerp (* x (/ (expt 2 j))))
-                        (+ (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))
-                      (+ -1 (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))))))
-  :hints (("goal" :in-theory (enable mod-mult-of-n
-                                     bits
-                                     expt-split)))
-  )
-
-
-
-
-
-;expensive?
-(defthm bits-minus-alt
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (<= j i))
-                (case-split (integerp j))
-                )
-           (equal (bits x i j)
-                  (if (integerp (* 1/2 (- X) (/ (EXPT 2 I))))
-                    0
-                    (if (INTEGERP (* (- X) (/ (EXPT 2 J))))
-                        (+ (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j)))
-                      (+ -1 (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j)))))))
-  :hints (("Goal" :in-theory (disable bits-minus)
-           :use (:instance bits-minus (x (- x)))))
-  )
-
-
-
-
-#|
-(defthm bits-shift-alt
-  (implies (and (syntaxp (should-have-a-2-factor-divided-out x))
-                (> j 0) ;restricts application 
-                (rationalp x)
-;                (integerp n)
-                (integerp i)
-                (integerp j)
-                )
-           (equal (bits x i j)
-                  (bits (/ x 2) (- i 1) (- j 1))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bits)
-                              '(bits-shift))
-           :use (:instance bits-shift (x (/ x 2)) (n 1)))))
-
-|#
-
-
-;drops hyps like this: (<= (BITS x 30 24) 253)
-;Recall that <= gets rewritten to < during proofs
-(defthm bits-drop-silly-upper-bound
-  (implies (and (syntaxp (quotep k))
-                (>= k (1- (expt 2 (+ 1 i (- j)))))
-                (case-split (<= j i))
-;                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-;                (case-split (rationalp k))
-                )
-           (equal (< k (bits x i j))
-                  nil)))
-
-;rewrite things like (<= 4096 (BITS x 23 12)) to false
-;Recall that <= gets rewritten to < during proofs
-(defthm bits-drop-silly-lower-bound
-  (implies (and (syntaxp (quotep k))
-                (> k (1- (expt 2 (+ 1 i (- j)))))
-                (case-split (<= j i))
-;                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-;                (case-split (rationalp k))
-                )
-  (equal (< (bits x i j) k)
-         t)))
-
-;rewrite (< -64 (BITS <signal> 64 59)) to t
-(defthm bits-drop-silly-bound-3
-  (implies (and (syntaxp (quotep k))
-                (< k 0)
-                )
-  (equal (< k (bits x i j))
-         t)))
-
-(defthm bits-drop-silly-bound-4
-  (implies (and (syntaxp (quotep k))
-                (<= k 0)
-                )
-  (equal (< (bits x i j) k)
-         nil)))
-
-(defthm bits-<-1
-  (equal (< (bits x i j) 1)
-         (equal (bits x i j) 0)))
-
-;put bits-cancel- in the name?
-(defthm bits-at-least-zeros
-  (implies (and (syntaxp (quotep k))
-                (equal k (expt 2 (- j2 j)))
-                (<= j j2)
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-  (equal (< (BITS x i j)
-             (* k (BITS x i j2)))
-         nil))
-  :hints (("Goal" :use (:instance bits-plus-bits2 (n j2)))))
-
-(defthm bits-upper-with-subrange
-  (implies (and (syntaxp (quotep k))
-                (<= j j2)
-                (equal k (expt 2 (- j2 j)))
-                (case-split (<= j2 i)) ;drop?
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-           (< (BITS x i j) 
-              (BINARY-+ k (BINARY-* k (BITS x i j2)))))
-  :hints (("Goal" :use (:instance bits-plus-bits2 (j j) (n j2)))))
-
-(defthm bits-upper-with-subrange-alt
-  (implies (and (syntaxp (quotep k))
-                (<= j j2)
-                (equal k (expt 2 (- j2 j)))
-                (case-split (<= j2 i)) ;drop?
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-           (equal (< (BINARY-+ k (BINARY-* k (BITS x i j2))) 
-                     (BITS x i j))
-                  nil))
-  :hints (("Goal" :use (:instance bits-plus-bits2 (j j) (n j2)))))
-
-
-;make another version for k negative?
-(defthm bits-equal-impossible-constant
-  (implies (and (syntaxp (quotep k))
-                (<= (expt 2 (+ 1 i (- j))) k)
-                )
-           (not (equal (bits x i j) k))))
-
-
-
-
-#|
-;degenerate case
-;rename?
-;expensive
-(defthm bits-sum-drop-irrelevant-term-1-of-1
-  (implies (and (rationalp x) ;(integerp x)
-
-                (integerp i)
-                (<= 0 i)
-                (integerp j)
-                (<= 0 j)
-
-                (integerp (/ x (expt 2 (+ 1 i))))
-                )
-           (equal (bits x i j)
-                  0))
-  :hints (("Goal" :in-theory (enable bits bits)))
-  :rule-classes ((:rewrite :backchain-limit-lst (nil nil nil nil nil 1)))
-)
-|#
-
-(defthm bits-with-x-not-rational
-  (implies (not (rationalp x))
-           (equal (bits x i j)
-                  0))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bits)
-                              '( ;REARRANGE-FRACTIONAL-COEFS-<
-                                )))))
-
-
-
-(defthm bits-compare-to-zero
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (not (< 0 (bits x i j)))
-                  (equal 0 (bits x i j)))))
-
-;expensive?
-
-(encapsulate
- ()
-
- (defthmd bits-ignore-negative-bits-of-integer-main-case
-   (implies (and (<= j 0)
-                 (integerp x) 
-                 (case-split (integerp j))
-                 (case-split (<= j i))
-                 )
-            (equal (bits x i j)
-                   (* (expt 2 (- j)) (bits x i 0))))
-   :hints (("Goal" :cases ((<= j i))
-            :in-theory (enable bits)))
-   )
-
- (defthm bits-ignore-negative-bits-of-integer
-   (implies (and (and (syntaxp (not (and (quotep j) (equal 0 (cadr j)))))) ;prevents loops
-                 (<= j 0)
-                 (integerp x)
-                 (case-split (integerp j))
-                 )
-            (equal (bits x i j)
-                   (* (expt 2 (- j)) (bits x i 0))))
-   :hints (("Goal"; :cases ((<= j i))
-            :use bits-ignore-negative-bits-of-integer-main-case
-            :in-theory (enable)))
-   )
- )
-
-
-;disable since it can be bad to leave "naked" signals?
-(defthmd bits-does-nothing-2
-  (implies (and (<= j 0) ;a bit strange (j will usually be zero?)
-                (bvecp x (+ i 1)) ;expand?
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits x i j)
-                  (* (expt 2 (- j)) x)))
-  :hints (("Goal" :cases ((<= j 0))
-           :in-theory (enable bits bvecp))))
-
-
-
-
-
-
-#|
-;(include-book "factor-out")
-
-(defthm bits-shift-better
-  (implies (and (bind-free (can-take-out-numeric-power-of-2 x) (c))
-                (force (power2p c))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits x i j)
-                  (bits (/ x c) (- i (expo c)) (- j (expo c)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable power2p)
-                              '(bits-shift))
-           :use  (:instance bits-shift 
-                           (x (/ x c))
-                           (n (expo c))
-                           ))))
-
-|#
-
-
-
-
-(defthm bits-does-nothing
-  (implies (and (bvecp x (1+ i))
-                (case-split (integerp i))
-;                (case-split (integerp j))
-                )
-           (equal (bits x i 0)
-                  x))
-  :hints (("Goal" :in-theory (enable bits-does-nothing-2)
-           :cases ((<= i -1))))
-  )
-
-(in-theory (disable bits-does-nothing))
-
-
-
-(defthm bits-with-bad-index-2
-  (IMPLIES (NOT (INTEGERP i))
-           (EQUAL (BITS x (1- i) 0)
-                  0))
-  :hints (("Goal" :in-theory (enable bits))))
-
-(local (defthm bvecp-bits-0-aux
-   (implies (and (case-split (natp i)) ;(natp i)
-                 (case-split (<= j i))
-                 (bvecp x j))
-            (equal (bits x i j) 0))
-   :hints (("Goal" :in-theory (enable bits bvecp)
-            :use (;(:instance mod-equal (m x) (n (expt 2 (1+ i))))
-                  (:instance expt-weak-monotone (n j) (m (1+ i))))))))
-
-(defthmd bvecp-bits-0
-   (implies (bvecp x j)
-            (equal (bits x i j) 0))
-   :hints (("Goal" :cases ((< i j))
-            :in-theory (set-difference-theories
-                        (enable natp)
-                        '( bvecp )))))
-
-;add case-split to hyps?
-(local
- (defthm bits-drop-from-minus-original
-   (implies (and (<= y x)
-                 (bvecp x n)
-                 (bvecp y n)
-                 )
-            (equal (bits (+ x (* -1 y)) (1- n) 0)
-                   (+ x (* -1 y))
-                   ))
-   :hints (("Goal" :cases ((integerp n))
-            :in-theory (enable bvecp)))
-   ))
-
-;add case-split to hyps?
-(defthm bits-drop-from-minus
-  (implies (and (bvecp x (1+ i))
-                (bvecp y (1+ i))
-                (<= y x)
-		(case-split (acl2-numberp i)))
-	   (equal (bits (+ x (* -1 y)) i 0)
-		  (+ x (* -1 y))))
-  :hints (("Goal" :use ((:instance bits-drop-from-minus-original
-                                   (n (1+ i))))
-           :in-theory (disable bits-drop-from-minus-original))))
-
-(defthm bits-tail
-   (implies (and (bvecp x (1+ i))
-                 (case-split (acl2-numberp i)))
-            (equal (bits x i 0)
-                   x))
-   :hints (("Goal" :in-theory (enable bvecp bits-does-nothing))))
-
-(defthm bits-tail-special
-   (implies (bvecp x i)
-            (equal (bits x (1- i) 0)
-                   x))
-   :hints (("Goal" :cases ((acl2-numberp i)))))
-
-
-#|
-
-comments from bits.lisp (these may duplicate comments in this book)
-
-;why have this?
-(defthm bits-shift-out-even
-  (implies (and (integerp x)
-                (evenp x)
-                (integerp i)
-                (integerp j)
-                (>= i j))
-           (equal (bits x i j)
-                  (bits (/ x 2) (- i 1) (- j 1) )))
-  :hints (("Goal" :in-theory (enable expt-minus
-                                     bits 
-                                     mod-cancel 
-                                     expt-split-rewrite)))
-  )
-
-
-
-
-;could use even-odd phrasing?
-(defthm bits-down-to-1-case-split
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp i)
-                (>= i 1))
-           (equal (bits x i 1)
-                  (if (equal (bitn x 0) 0)
-                      (/ (bits x i 0) 2) ;use the fact that we know bit 0 is 0?
-                    (/ (1- (bits x i 0)) 2) ;use the fact that we know bit 0 is 1?
-                    ))))
-
-
-;would like these
-;x<2^n
-(defthm test2
-  (IMPLIES (AND (INTEGERP N) (<= 0 N) (rationalP X) (<= 0 x))
-         (EQUAL (FLOOR (* 1/2 x) 1)
-                (FLOOR (* 1/2 (FLOOR x 1))
-                       1)))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable floor))))
-
-  :otf-flg t
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable fl)
-                              '())))
-)
-
-
-(defthm test
-  (IMPLIES (AND (INTEGERP N) (<= 0 N) (INTEGERP X))
-         (EQUAL (FL (* 1/2 X (/ (EXPT 2 N))))
-                (FL (* 1/2 (FL (* X (/ (EXPT 2 N))))))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable fl)
-                              '()))))
-)
-
-
-;these may be made moot by my method of using lowbits with bits of a sum
-
-(defthm bits-sum-simplify-first-term
-  (implies (and (>= (abs x) (expt 2 (+ j 1))) ;prevents loop
-                (rationalp x)
-                (rationalp y)
-                (integerp j)
-                (<= 0 j)
-                )
-           (equal (bits (+ x y) j 0)
-                  (bits (+ (lowbits x j) y) j 0))))
-
-(defthm bits-sum-simplify-second-term
-  (implies (and (>= (abs x) (expt 2 (+ j 1))) ;prevents loop
-                (rationalp x)
-                (rationalp y)
-                (integerp j)
-                (<= 0 j)
-                )
-           (equal (bits (+ y x) j 0)
-                  (bits (+ (lowbits x j) y) j 0))))
-
-
-
-
-This series of events deals with simplifying expressions like
-(equal (bits x 8 0) 
-       (+ (bits x 6 0) k))
-Intuitively, bits 6 down-to 0 appear on both sides of the sum and should be "cancelled".  
-The remaining bits will need to be "shifted" back into place.
-
-More rules are probably needed to make the theory complete.
-
-
-(defthm bits-cancel-lowbits-in-comparison
-  (implies (and (> i+ i)
-                (rationalp k)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                )
-           (equal (equal (+ k (bits x i j))
-                         (bits x i+ j))
-                  (equal (* (expt 2 (+ 1 i (- j))) 
-                            (BITS X I+ (+ 1 I))) 
-                         k))))
-
-(defthm bits-cancel-lowbits-in-comparison-alt-2
-  (implies (and (> i+ i)
-                (rationalp k)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                )
-           (equal (equal (+ (bits x i j) k)
-                         (bits x i+ j))
-                  (equal (* (expt 2 (+ 1 i (- j))) 
-                            (BITS X I+ (+ 1 I))) 
-                         k))))
-
-
-
-;todo: rephrase the conclusion of the above by moving the "constant" (* 2 (EXPT 2 I) (/ (EXPT 2 J))) to the other
-;side
-;a good idea since k is usually divisible by that quantity (with the rule above, we often end up with an
-equality in which each side should have a power of 2 divided out of it
-; not needed if we have good meta rules for cancelling factors from an inequality
-
-
-(defthm bits-cancel-lowbits-in-comparison-2
-  (implies (and (> i+ i)
-                (rationalp k)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-
-                )
-           (equal (equal (+ k (bits x i j))
-                         (bits x i+ j))
-                  (equal (*  
-                            (BITS X I+ (+ 1 I))) 
-                         (/ k (expt 2 (+ 1 i (- j))))))))
-
-
-
-
-(defthm bits-cancel-lowbits-in-comparison-3
-  (implies (and (> i+ i)
-                (rationalp k)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                (rationalp y)
-                )
-           (equal (equal (+ (bits x i+ j) k)
-                         (+ y (bits x i j)))
-                  (equal (* (expt 2 (+ 1 i (- j )))
-                            (BITS X I+ (+ 1 I))) 
-                         (- y k)))))
-
-;better conclusion?
-(defthm bits-cancel-lowbits-in-comparison-no-constant
-  (implies (and (> i+ i)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                )
-           (equal (equal (bits x i j)
-                         (bits x i+ j))
-                  (equal (* 2 (EXPT 2 I)
-                           (/ (EXPT 2 J))
-                           (BITS X I+ (+ 1 I))) 
-                         0))))
-
-(defthm bits-cancel-lowbits-in-comparison-no-constant-2
-  (implies (and (> i+ i)
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                (<= j i)
-                (integerp i+)
-                )
-           (equal (equal (bits x i+ j)
-                         (bits x i j))
-                  (equal (* 2 (EXPT 2 I)
-                           (/ (EXPT 2 J))
-                           (BITS X I+ (+ 1 I))) 
-                         0))))
-;the theory above (cancelling bits in comparisons) is not complete
-;it should also deal with bitn
-;perhaps a meta rule would be a good idea here?
-
-
-(defthm bits-shift-alt
-  (implies (and (syntaxp (should-have-a-2-factor-divided-out x))
-                (> j 0) ;restricts application 
-                (rationalp x)
-                (integerp i)
-                (integerp j)
-                )
-           (equal (bits x i j)
-                  (bits (/ x 2) (- i 1) (- j 1)))))
-
-(defthm bits-turn-bound-into-equal
-  (implies (and (syntaxp (quotep k))
-                (equal k (+ -2 (expt 2 (+ 1 i (- j)))))
-                (case-split (<= j i))
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (rationalp k))
-                )
-           (equal (< k (bits x i j))
-                  (equal (bits x i j) (+ k 1))))
-  :hints (("Goal" :in-theory (disable  bits-upper-bound-tighter
-                                        bits-upper-bound
-                                         bits-upper-bound-2)
-           :use  bits-upper-bound-tighter))
-)
-
-
-
-
-
-
-
-;(in-theory (disable nbits-shift-out-even))
-
-
-;...
-
-
-;degenerate case
-;rename?
-;expensive
-(defthm bits-sum-drop-irrelevant-term-1-of-1
-  (implies (and (rationalp x) ;(integerp x)
-
-                (integerp i)
-                (<= 0 i)
-                (integerp j)
-                (<= 0 j)
-
-                (integerp (/ x (expt 2 (+ 1 i))))
-                )
-           (equal (bits x i j)
-                  0))
-  :hints (("Goal" :in-theory (enable bits bits)))
-  :rule-classes ((:rewrite :backchain-limit-lst (nil nil nil nil nil 1)))
-)
-
-
-(defthm bits-shift-better
-  (implies (and (bind-free (can-take-out-numeric-power-of-2 x) (c))
-                (force (power2p c))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits x i j)
-                  (bits (/ x c) (- i (expo c)) (- j (expo c))))))
-
-;high bits don't matter - add syntaxp hyp that one addend is a constant with high bits still present
-;huh?
-
-
-|#
-
-
-;It may be easier to reason about bits if we use this rule instead of expanding/enabling bits.
-(defthmd bits-alt-def
-  (equal (bits x i j)
-         (if (or (not (integerp i))
-                 (not (integerp j)))
-             0
-           (mod (fl (/ x (expt 2 j))) (expt 2 (+ 1 i (- j))))))
-  :hints (("Goal" :in-theory (enable bits))))
-
-
-
-
-
-
-(defthm bits-bvecp-simple-2
-  (bvecp (bits x (1- i) 0) i)
-  :hints (("Goal" :cases ((acl2-numberp i)))))
-
-
-;Follows from BITS-SUM-DROP-IRRELEVANT-TERM-2-OF-2.
-;change param names
-(defthmd bits-plus-mult-2
-   (implies (and (< n k)
-                 (integerp y)
-                 (integerp k)
-                 )
-            (equal (bits (+ x (* y (expt 2 k))) n m)
-                   (bits x n m)))
-   :hints (("Goal" :cases ((integerp n))))) ;why cases hint needed?
-
-(defthmd bits-plus-mult-2-rewrite
-   (implies (and (syntaxp (quotep c))
-                 (equal (mod c (expt 2 (1+ n))) 0))
-            (equal (bits (+ c x) n m)
-                   (bits x n m)))
-    :hints (("Goal" :use ((:instance bits-plus-mult-2
-                                     (x x)
-                                     (y (/ c (expt 2 (1+ n))))
-                                     (k (1+ n))
-                                     (n n)))
-             :in-theory (enable mod))))
-
-(defthm bits-plus-bits
-   (implies (and (integerp m)
-                 (integerp p)
-                 (integerp n)
-                 (<= m p)
-                 (<= p n))
-            (= (bits x n m)
-               (+ (bits x (1- p) m)
-                  (* (expt 2 (- p m)) (bits x n p)))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance bits-plus-bits2 (i n) (j m) (n p))))))
-
-(defthm bits-less-than-x
-  (implies (<= 0 x)
-	   (<= (bits x i 0) x))
-  :rule-classes (:rewrite :linear)
-  :hints (("goal" :in-theory (enable bits))))
-
-(defthm bits-less-than-x-gen
-  (implies (and (<= 0 x)
-                (case-split (<= 0 j))
-                (case-split (not (complex-rationalp x)))
-                )
-	   (<= (bits x i j) x))
-  :rule-classes (:rewrite :linear)
-  :hints (("goal" :in-theory (enable bits x-times-something>=1))))
-
-(defthm bits-bvecp-when-x-is	
-  (implies (and (bvecp x k)	
-                (case-split (<= 0 j))
-                )
-           (bvecp (bits x i j) k))
-  :hints (("Goal" :in-theory (enable  bvecp))))
-
-(defthmd bits-bits-1
-  (implies (and (<= k (- i j))
-                (case-split (<= 0 l))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (bits x (+ k j) (+ l j))))
-  :hints (("Goal" :in-theory (enable bits expt-split))))
-
-(defthmd bits-bits-2
-  (implies (and (> k (- i j))
-                (case-split (<= 0 l))
-;                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (bits x i (+ l j))))
-  :hints (("Goal" :in-theory (enable bits expt-split))))
-
-(defthm bits-bits
-  (implies (and (case-split (<= 0 l))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (if (<= k (- i j))
-                      (bits x (+ k j) (+ l j))
-                    (bits x i (+ l j)))))
-:hints (("Goal" :in-theory (enable bits-bits-1 bits-bits-2))))
-
-
-;The following trivial corollary of bits-bits is worth keeping enabled.
-
-(defthm bits-bits-constants
-  (implies (and (syntaxp (quotep i))
-                (syntaxp (quotep j))
-                (syntaxp (quotep k))
-                (<= 0 l)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp l))
-           (equal (bits (bits x i j) k l)
-                  (if (<= k (- i j))
-                      (bits x (+ k j) (+ l j))
-                    (bits x i (+ l j))))))
-
-
-(defthm bits-reduce
-  (implies (and (< x (expt 2 (+ 1 i)))
-                (case-split (integerp x))
-                (case-split (<= 0 x))
-                (case-split (integerp i))
-                )
-           (equal (bits x i 0) x)))
-
-(defthm bits-0
-  (equal (bits 0 i j) 0))
-
-
-
-
-
-;could prove a version where we drop bits from both args?
-(defthm bits-sum-drop-bits-around-arg-2
-  (implies (and (<= i i+)
-                (integerp y)
-                (case-split (integerp i+))
-                )
-           (equal (bits (+ x (bits y i+ 0)) i j)
-                  (bits (+ x y) i j)))
-  :hints (("Goal" :in-theory (enable bits))))
-
-;Follows from BITS-SUM-DROP-BITS-AROUND-ARG-2.
-(defthm bits-sum-drop-bits-around-arg-1
-  (implies (and (<= i i+)
-                (integerp x)
-                (case-split (integerp i+))
-                )
-           (equal (bits (+ (bits x i+ 0) y) i j)
-                  (bits (+ x y) i j))))
-
-(defthm bits-sum-drop-bits-around-arg-2-special-case
-  (implies (integerp y) ;case-split?
-           (equal (bits (+ x (bits y i 0)) i j)
-                  (bits (+ x y) i j))))
-
-(defthm bits-sum-drop-bits-around-arg-1-special-case
-  (implies (integerp x) ;case-split?
-           (equal (bits (+ (bits x i 0) y) i j)
-                  (bits (+ x y) i j))))
-
-;rename
-;Follows from BVECP-SUM-OF-BVECPS.
-(defthm bits-sum-1
-  (equal (bits (+ (bits x (1- i) 0)
-                  (bits y (1- i) 0))
-               i ;actually, this could be anything >= i ??
-               0)
-         (+ (bits x (1- i) 0)
-            (bits y (1- i) 0)))
-  :hints (("Goal" :in-theory (enable bits-tail))))
-
-
-;export!! enable?
-;gen?
-(defthmd bits-of-non-integer-special
-  (implies (case-split (not (integerp i)))
-           (equal (BITS X (1- i) 0)
-                  0)))
-
-(local
- (defthmd bits-fl-helper
-   (implies (and (<= 0 j)
-                 (<= -1 i)
-                 )
-            (equal (bits (fl x) i j)
-                   (bits x i j)))
-   :hints (("Goal" :in-theory (enable bits mod-fl-eric)))))
-
-(defthm bits-fl
-  (implies (<= 0 j)
-           (equal (bits (fl x) i j)
-                  (bits x i j)))
-  :hints (("Goal" :use  bits-fl-helper)))
-
-(defthmd bits-shift-down-eric
-  (implies (and (<= 0 j)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                )
-           (equal (bits (* x (/ (expt 2 k)))
-                        i
-                        j)
-                  (bits x (+ i k) (+ j k))))
-  :hints (("Goal" :in-theory (e/d (expt-minus) (bits-shift))
-           :use (:instance bits-shift (n (- k))))))
-
-(defthmd bits-shift-down-1
-    (implies (and (<= 0 j)
-                  (integerp i)
-		  (integerp j)
-                  (integerp k)
-                  )
-	     (equal (bits (fl (/ x (expt 2 k)))
-			  i
-			  j)
-		    (bits x (+ i k) (+ j k))))
-  :hints (("Goal" :in-theory (enable bits-fl bits-shift-down-eric))))
-
-(local
- (defthm bits-fl-by-2-helper
-   (implies (and (integerp i)
-                 (<= 0 i) 
-                 )
-            (equal (fl (* 1/2 (bits x i 0))) ;gen 0 to j?
-                   (bits x i 1)))
-   :rule-classes ()
-   :hints (("Goal"  :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)
-            :use ((:instance bits-shift-down-1 (k 1) (i (1- i)) (j 0))
-                  (:instance bits-plus-bits (n i) (m 0) (p 1))
-                  (:instance fl-unique (x (/ (bits x i 0) 2)) (n (bits x i 1))))))))
-;rename?
-(defthmd bits-fl-by-2
-  (equal (fl (* 1/2 (bits x i 0)))
-         (bits x i 1))
-  :hints (("Goal" :use (:instance  bits-fl-by-2-helper))))
-
-(defthm mod-bits-by-2
-  (implies (and (integerp x)
-                (<= 0 i)
-                (integerp i)
-                )
-           (equal (mod (bits x i 0) 2)
-                  (mod x 2)))
-  :hints (("Goal" :in-theory (enable bits))))
-
-
-#|
-
-;BOZO challenge:
-
-(defthm bits-sum-drop-bits-around-arg-2-really-special-case
-  (implies (rationalp y)
-           (equal (bits (+ x (bits y i 0)) i 0)
-                  (bits (+ x y) i 0)))
-  :hints (("Goal" :in-theory (enable bits)))))
-
-(defthm bits-sum-drop-bits-around-arg-1-really-special-case
-  (implies (integerp x)
-           (equal (bits (+ (bits x i 0) y) i 0)
-                  (bits (+ x y) i 0))))
-
-|#
-
-
-(defthm bits-shift-by-constant-power-of-2
-  (implies (and (syntaxp (quotep k))
-                (power2p k)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (* k x) i j)
-                  (bits x (- i (expo k)) (- j (expo k)))))
-  :hints (("Goal" :in-theory (enable power2p-rewrite))))
-
-
-(defthm bits-shift-second-with-more
-  (implies (and ;(rationalp x)
-            (case-split (integerp n))
-            (case-split (integerp i))
-            (case-split (integerp j))
-            )
-           (equal (bits (* x (expt 2 n) y) i j)
-                  (bits (* x y) (- i n) (- j n))))
-  :hints (("Goal" :in-theory (disable bits-shift)
-           :use (:instance bits-shift (x (* x y))))))
-
-(defthmd bits-times-2
-  (implies (and (acl2-numberp i)
-                (acl2-numberp j)
-                )
-           (equal (bits (* 2 x) i j)
-                  (bits x (1- i) (1- j))))
-  :hints (("Goal" :use ((:instance bits-shift (n 1))))))
-
-(defthmd bits+2**k-2
-  (implies (and (< x (expt 2 k))
-                (<= 0 x)
-                (rationalp x) ;(integerp x)
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* y (expt 2 k))) n m)
-                  (bits y (- n k) (- m k))))
-  :hints (("goal" :in-theory (disable FL-EQUAL-0)
-           :use ((:instance bits-shift-down-1
-                            (x (+ x (* y (expt 2 k))))
-                            (i (- n k))
-                            (j (- m k)))
-                 (:instance fl-unique (x (/ (+ x (* y (expt 2 k))) (expt 2 k))) (n y))))))
-
-(defthm bits+2**k-2-alt
-  (implies (and (< x (expt 2 k))
-                (<= 0 x)
-                (rationalp x) ;(integerp x)
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* (expt 2 k) y)) n m)
-                  (bits y (- n k) (- m k))))
-
-  :hints (("Goal" :in-theory (disable bits+2**k-2)
-           :use (:instance bits+2**k-2))))
-
-;basically the same as bits+2**k-2; drop one?
-;move
-(defthmd bits-plus-mult-1
-  (implies (and (bvecp x k) ;actually, x need not be an integer...
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* y (expt 2 k))) n m)
-                  (bits y (- n k) (- m k))))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (bits+2**k-2))))
-
-(defthm bits-mod-0
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp m)
-                (>= m 0)
-                (integerp n)
-                (>= n 0))
-           (iff (= (mod x (expt 2 (+ m n 1))) 0)
-                (and (= (bits x (+ m n) n) 0)
-                     (= (mod x (expt 2 n)) 0))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (e/d (bits expt-split) (BITS-FL)) 
-           :use ((:instance mod-0-0 (m x) (n (expt 2 n)) (p (expt 2 (1+ m))))
-                 (:instance bits-shift-down-1 (k n) (i m) (j 0))))))
-
-;this is silly? just open up bits!
-(defthm mod-bits-equal
-  (implies (= (mod x (expt 2 (1+ i))) (mod y (expt 2 (1+ i))))
-           (= (bits x i j) (bits y i j)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits))))
-
-(defthmd mod-bits-equal-cor
-    (implies (and (integerp x)
-		  (integerp n)
-		  (integerp i)
-		  (integerp j)
-		  (< i n))
-	     (equal (bits (mod x (expt 2 n)) i j)
-		    (bits x i j)))
-    :hints (("Goal" :use ((:instance mod-bits-equal
-                                     (x (mod x (expt 2 n)))
-                                     (y x))))))
-
-;not needed?  just expand bits?
-(defthmd bits-mod
-  (implies (and (case-split (integerp x))
-                (case-split (integerp i)) ;gen?
-                ;(case-split (<= 0 i))
-                )
-           (equal (bits x i 0)
-                  (mod x (expt 2 (1+ i)))))
-  :hints (("Goal" 
-           :cases ((rationalp i) (complex-rationalp i))
-           :in-theory (e/d (bits) ( EXPT-SPLIT)))))
-
-(defthmd bits-bits-sum
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp i))
-	   (equal (bits (+ (bits x i 0) y) i 0)
-		  (bits (+ x y) i 0)))
-  :hints (("Goal" :in-theory (enable bits mod-sum))))
-
-;reorder? make rewrite?
-(defthm bits-shift-up-2
-  (implies (and (integerp x)
-                (integerp k)
-                (<= 0 k)
-                (integerp i)
-                )
-           (equal (* (expt 2 k) (bits x i 0))
-                  (bits (* (expt 2 k) x) (+ i k) 0)))
-  :rule-classes ()
-;:hints (("Goal" :cases ((equal 0 k))))
-  )
-
-
-;export!
-(defthm bits-expt
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (bits (expt 2 k) i j)
-                  (if (or (< i j)
-                          (< k j)
-                          (< i k))
-                      0
-                    (expt 2 (- k j))))
-           )
-  :hints (("Goal" :use (:instance bits-shift (x 1) (n k))))
-  )
-
-(defthm bits-natp
-  (natp (bits x i j)))
-
-
-(defthmd bits-shift-down-eric
-  (implies (and (<= 0 j)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                )
-           (equal (bits (* x (/ (expt 2 k)))
-                        i
-                        j)
-                  (bits x (+ i k) (+ j k))))
-  :hints (("Goal" :use (:instance bits-shift-down-1)))
-  )
-
-;gen the 0?
-(defthm mod-bits
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (integerp j)
-                (integerp i))
-           (equal (mod (bits x i 0) (expt 2 j))
-                  (bits x (min i (1- j)) 0)))
-  :hints (("Goal" :in-theory (enable bits)))
-  )
-
-(defthm bits-expt-constant
-  (implies (and (syntaxp (and (quotep k) (power2p (cadr k))))
-                (force (power2p k))
-                (case-split (integerp k)) ;gen?
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits k i j)
-                  (if (or (< i j)
-                          (< (expo k) j)
-                          (< i (expo k)))
-                      0
-                    (expt 2 (- (expo k) j)))))
-  :hints (("Goal" :in-theory (enable power2p-rewrite))))
-
-#|
-
-(defthm bits-minus-better-helper-1
-  (implies (and (integerp x)
-                (integerp i))
-           (equal (equal 0 (bits x i 0))
-                  (integerp (* 1/2 x (/ (expt 2 i))))
-                  ))
-  :hints (("Goal" :in-theory (enable expt-split mod-equal-0)
-           :expand  (BITS X I 0)))
-  )
-
-(defthm bits-minus-better-helper-2
-  (implies (and (integerp x)
-                (integerp i))
-           (equal (equal 0 (bits x (1- j) 0))
-                  (integerp (* x (/ (expt 2 j))))
-                  ))
-  :hints (("Goal" :in-theory (enable expt-split mod-equal-0)
-           :expand   (bits x (1- j) 0)))
-  )
-
-;note that although the RHS looks slightly gross, 
-;gen the (integerp x) hyp!!
-(defthm bits-minus-better
-  (implies (and (case-split (integerp x)) ;gen!
-                (case-split (integerp i))
-                (case-split (<= j i)) ;drop?
-                (case-split (integerp j))
-                )
-           (equal (bits (* -1 x) i j)
-                  (if (equal 0 (bits x i 0))
-                      0
-                    (if (equal 0 (bits x (1- j) 0))
-                        (+ (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))
-                      (+ -1 (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))))))
-	:hints (("Goal" :use bits-minus
-	:in-theory (enable mod-does-nothing expt-split mod-cancel)))
-)
-
-|#
-
-
-;Unlike bits-tail, this allows j to be non-zero.
-;Note that the conclusion is (bits x ...), not just x.
-;i is a free variable
-;watch out for loops with this rule
-;BOZO export in lib/ or user/!
-(defthm bits-tighten
-  (implies (and (bvecp x i)
-                (<= i n) 
-                (case-split (integerp n))
-                )
-           (equal (bits x n j)
-                  (bits x (1- i) j)))
-  :rule-classes ((:rewrite :match-free :all))
-  :hints (("goal" :use (:instance expt-weak-monotone (n i) (m (+ 1 n)))
-           :in-theory (e/d (bits bvecp) (expt-compare)))))
-
-(defthmd bits-mod-2
-  (implies (and (integerp x)
-                (integerp i)
-                (integerp j)
-                (>= i j))
-           (equal (bits x (1- i) j)
-                  (- (fl (/ x (expt 2 j)))
-                     (* (expt 2 (- i j))
-                        (fl (/ x (expt 2 i)))))))
-  :hints (("Goal" :in-theory (enable bits mod))))
-
-(defthmd bits-neg
-  (implies (and (< i 0)
-                (integerp x))
-           (equal (bits x i j) 0))
-  :hints (("Goal" :in-theory (enable bits))))
-
-(defthmd bits-shift-down-2
-  (implies (and (natp x)
-		(natp i)
-		(natp k))
-	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
-		  (bits (fl (/ x (expt 2 k))) i 0)))
-  :hints (("Goal" :use ((:instance bits-plus-bits (n (+ i k)) (m 0) (p k)))
-           :in-theory (enable bits-shift-down-1))))
diff -Nru acl2-6.2/books/rtl/rel5/support/bits-trunc-proofs.lisp acl2-6.3/books/rtl/rel5/support/bits-trunc-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/bits-trunc-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bits-trunc-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,114 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-(in-package "ACL2")
-
-(local (include-book "trunc"))
-(include-book "log")
-(include-book "float")
-(include-book "trunc")
-(local (include-book "bits"))
-(local (include-book "../arithmetic/top"))
-(local (in-theory (enable expt-minus)))
-
-(defthm bits-trunc-2
-  (implies (and (= n (1+ (expo x)))
-;(rationalp x) ;(integerp x) 
-                (>= x 0)
-                ;(integerp n) 
-;                (>= n k)
-                (integerp k) 
-                (> k 0)
-                )
-           (= (trunc x k)
-              (* (expt 2 (- n k))
-                 (bits x (1- n) (- n k)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable bits trunc-rewrite expt-split))))
-
-
-(local
- (defthm bits-trunc-3
-   (implies (and (integerp x) 
-                 (> x 0)
-                 (integerp n) (> n k)
-                 (integerp k) (> k 0)
-                 (= (expo x) (1- n)))
-            (= (trunc x k)
-               (logand x (- (expt 2 n) (expt 2 (- n k))))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance bits-trunc-2)
-                         (:instance logand-slice (k (- n k)))))
-           )))
-
-(local
- (defthm bits-trunc-4
-   (implies (and (integerp x) (> x 0)
-                 (integerp n) (> n k)
-                 (integerp k) (> k 0)
-                 (>= x (expt 2 (1- n)))
-                 (< x (expt 2 n)))
-            (= (trunc x k)
-               (logand x (- (expt 2 n) (expt 2 (- n k))))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance bits-trunc-3)
-                         (:instance expo-unique (n (1- n))))))))
-
-(local
- (defthm bits-trunc-5
-   (implies (and (integerp x) (> x 0)
-                 (integerp m) (>= m n)
-                 (integerp n) (> n k)
-                 (integerp k) (> k 0)
-                 (>= x (expt 2 (1- n)))
-                 (< x (expt 2 n)))
-            (= (trunc x k)
-               (logand x (mod (- (expt 2 m) (expt 2 (- n k))) (expt 2 n)))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance bits-trunc-4)
-                         ;(:instance mod-2m-2n-k)
-                         )))))
-
-(include-book "land0")
-(include-book "merge")
-
-(defthm bits-trunc-original
-  (implies (and (>= x (expt 2 (1- n)))
-                (< x (expt 2 n))
-                (integerp x) (> x 0)
-                (integerp m) (>= m n)
-                (integerp n) (> n k)
-                (integerp k) (> k 0)
-                )
-           (= (trunc x k)
-              (land0 x (- (expt 2 m) (expt 2 (- n k))) n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (e/d (bits-tail land0 expt-split) (expt-minus))
-		  :use ((:instance bits-trunc-5)))))
-
-#|
-(defthm bits-trunc-6
-  (implies (and (integerp x) (> x 0)
-                (integerp m) (>= m n)
-                (integerp n) (> n k)
-                (integerp k) (> k 0)
-                (>= x (expt 2 (1- n)))
-                (< x (expt 2 n)))
-           (= (trunc x k)
-              (logand x (- (expt 2 m) (expt 2 (- n k))))))
-  :rule-classes ()
-  :hints (("goal" :use (;(:instance hack-82)
-                        (:instance bits-trunc-5)
-			(:instance expt-weak-monotone (n (- n k)))
-			(:instance and-dist-d (y (- (expt 2 m) (expt 2 (- n k)))))))))
-|#
-
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/bits-trunc.lisp acl2-6.3/books/rtl/rel5/support/bits-trunc.lisp
--- acl2-6.2/books/rtl/rel5/support/bits-trunc.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bits-trunc.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-(in-package "ACL2")
-
-;BOZO include less...
-(include-book "log")
-(include-book "float")
-(include-book "trunc")
-(include-book "land0")
-(local (include-book "bits-trunc-proofs"))
-
-(defthm bits-trunc-2
-  (implies (and (= n (1+ (expo x)))
-                (>= x 0)
-                (integerp k) 
-                (> k 0)
-                )
-           (= (trunc x k)
-              (* (expt 2 (- n k))
-                 (bits x (1- n) (- n k)))))
-  :rule-classes ())
-
-(defthm bits-trunc-original
-  (implies (and (>= x (expt 2 (1- n)))
-                (< x (expt 2 n))
-                (integerp x) (> x 0)
-                (integerp m) (>= m n)
-                (integerp n) (> n k)
-                (integerp k) (> k 0)
-                )
-           (= (trunc x k)
-              (land0 x (- (expt 2 m) (expt 2 (- n k))) n)))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/support/bits.lisp acl2-6.3/books/rtl/rel5/support/bits.lisp
--- acl2-6.2/books/rtl/rel5/support/bits.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bits.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,868 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-;; NOTE:: all proofs are now in bits-proofs.lisp  !!
-
-This book is still a mess.
-
-See the comments in bits-proofs (especially at the end) for more possible lemmas to add.
-
-bits now uses mod instead of rem; the use of "mod" seems to allow nicer results to be proved.
-
-bits now *always* returns a non-negative integer.  Many hyps of other lemmas require expressions to be
-non-negative integers, and with bits, this used to require further checking of the arguments (at worst,
-checking all the way to the leaves of each bits nest each time).
-
-todo:
- add case-split to all hyps about i and j (indices to bits must be integers and j must be <= i or else weird
-stuff happens (but we can easily handle these cases).
-
-|#
-
-(local (include-book "bits-proofs")) 
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-(include-book "../arithmetic/negative-syntaxp")
-(include-book "../arithmetic/power2p")
-
-;; Necessary defuns:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defun bitvec (x n)
-  (if (bvecp x n) x 0))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-
-;In proofs about RTL terms, i and j are almost always constants
-
-(defthm bits-nonnegative-integerp-type
-  (and (<= 0 (bits x i j))
-       (integerp (bits x i j)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than bits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription bits)))
-
-(defthm bits-natp
-  (natp (bits x i j)))
-
-(defthm bits-with-x-0
-  (equal (bits 0 i j)
-         0))
-
-(defthm bits-with-x-not-rational
-  (implies (not (rationalp x))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-i-not-an-integer
-  (implies (not (integerp i))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-j-not-an-integer
-  (implies (not (integerp j))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-indices-in-the-wrong-order
-  (implies (< i j)
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-upper-bound
-  (< (bits x i j) (expt 2 (+ 1 i (- j))))
-  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j)))))
-
-;tigher bound for the usual case
-(defthm bits-upper-bound-tighter
-  (implies (case-split (<= j i))
-           (<= (bits x i j) (1- (expt 2 (+ i 1 (- j))))))
-  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j)))))
-
-;this might help stupid hyps get rewritten away...
-;perhaps require that z be a constant?
-(defthm bits-upper-bound-2
-  (implies (<= (expt 2 (+ 1 i (- j))) z)
-           (< (bits x i j) z)))
-
-;a is a free var
-(defthm bits-force
-  (implies (and (<= (* a (expt 2 (+ i 1))) x)
-                (< x (* (1+ a) (expt 2 (+ i 1))))
-                (integerp x)
-                (integerp i)
-                (integerp a)
-                )
-           (equal (bits x i 0)
-                  (- x (* a (expt 2 (+ i 1))))))
-  :rule-classes nil
-  )
-
-;BOZO expensive? disable?
-(defthm bits-force-with-a-chosen-neg
-  (implies (and (< x 0) ;rarely the case?
-                (<= (* -1 (expt 2 (+ i 1))) x)
-                (integerp x)
-                (integerp i)
-                )
-           (equal (bits x i 0)
-                  (- x (* -1 (expt 2 (+ i 1)))))))
-
-;eventually, I'd like to add a bind-free rule to handle the bits-shift case?
-(defthm bits-shift
-  (implies (and (case-split (integerp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (equal (bits (* (expt 2 n) x) i j)
-                       (bits x (- i n) (- j n)))
-                (equal (bits (* x (expt 2 n)) i j)
-                       (bits x (- i n) (- j n))))))
-
-; Basically a restatement of bits-shift:
-(defthm bits-shift-up-1
-  (implies (and (integerp k)
-		(integerp i)
-		(integerp j))
-	   (equal (bits (* (expt 2 k) x) i j)
-		  (bits x (- i k) (- j k))))
-  :rule-classes ())
-
-(defthm bits-shift-second-with-more
-  (implies (and (case-split (integerp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (* x (expt 2 n) y) i j)
-                  (bits (* x y) (- i n) (- j n)))))
-
-(defthm bits-shift-by-constant-power-of-2
-  (implies (and (syntaxp (quotep k))
-                (power2p k)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (* k x) i j)
-                  (bits x (- i (expo k)) (- j (expo k))))))
-
-;don't need this if we have bits-shift-by-constant-power-of-2?
-(defthmd bits-times-2
-  (implies (and (acl2-numberp i)
-                (acl2-numberp j)
-                )
-           (equal (bits (* 2 x) i j)
-                  (bits x (1- i) (1- j)))))
-
-;allows you to split a bit vector into two parts
-;split x[i:j] into x[i:n] and x[n-1:j]
-;free var n (where to split)
-;BOZO get rid of the other in favor of this one?
-(defthm bits-plus-bits2
-  (implies (and ;(rationalp x)
-                (integerp i) 
-                (integerp j)
-                (integerp n)
-                (<= j n)
-                (<= n i))
-           (equal (bits x i j)
-                  (+ (* (bits x i n) (expt 2 (- n j)))
-                     (bits x (1- n) j))))
-  :rule-classes nil)
-
-(defthm bits-plus-bits
-  (implies (and (integerp m)
-                (integerp p)
-                (integerp n)
-                (<= m p)
-                (<= p n))
-           (= (bits x n m)
-              (+ (bits x (1- p) m)
-                 (* (expt 2 (- p m)) (bits x n p)))))
-  :rule-classes ())
-
-;this really has two separate cases
-;generalize with j not 0?
-;this rule often seems helpful, but I'm not sure exactly why
-(defthm bits-split-around-zero
-  (implies (and (>= x (- (expt 2 (+ i 1))))
-                (< x (expt 2 (+ i 1)))
-                (integerp x)
-                (case-split (integerp i))
-                (case-split (<= 0 i))
-                )
-           (equal (bits x i 0)
-                  (if (<= 0 x)
-                      x
-                    (+ x (expt 2 (+ i 1)))))))
-
-
-
-;this should fire after bits-bvecp, so we list it first
-;or should we rewrite (bvecp (bits x i j))? <-- huh? make the conslusion an equal??
-(defthm bits-bvecp-when-x-is	
-  (implies (and (bvecp x k)	;gen k to be something less that the k in the rhs?
-                (case-split (<= 0 j))
-                )
-           (bvecp (bits x i j) k)))
-
-#|
-I found a case where this failed to apply because I didn't know that j was an acl2-number:
-1x (:REWRITE BITS-BVECP) failed because :HYP 1 rewrote to (NOT (< J (IF (ACL2-NUMBERP J) J '0))).
-|#
-(defthm bits-bvecp
-  (implies (and (<= (+ 1 i (- j)) k)
-                (case-split (integerp k))
-                )
-           (bvecp (bits x i j) k)))
-
-;do we want this rule enabled?
-;this is sort of odd
-(defthm bits-bvecp-fw
-  (implies (equal n (- (1+ i) j)) ; note equal here to help with the fw chaining
-           (bvecp (bits x i j) n))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((bits x i j)))))
-
-;BOZO make this one a fw-chaining rule instead of the one above?
-(defthm bits-bvecp-simple
-  (implies (equal k (+ 1 i (* -1 j)))
-           (bvecp (bits x i j) k)))
-
-;included in case bits-bvecp has the problem described above...
-(defthm bits-bvecp-simple-2
-  (bvecp (bits x (1- i) 0) i))
-
-
-
-;I have many theorems dealing with the simplification of bits of a sum
-
-;better names: make the dropped term x, the others a,b,c,...
-;;; more bits thms like this!
-
-(defthm bits-sum-drop-irrelevant-term-2-of-2
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ x y) i j)
-                  (bits x i j))))
-
-(defthm bits-sum-drop-irrelevant-term-1-of-2
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ y x) i j)
-                  (bits x i j))))
-
-(defthm bits-sum-drop-irrelevant-term-3-of-3
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ w x y) i j)
-                  (bits (+ w x) i j))))
-
-(defthm bits-sum-drop-irrelevant-term-2-of-3
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ w y x) i j)
-                  (bits (+ w x) i j))))
-
-;kind of yucky
-(defthm bits-minus
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (<= j i)) ;drop?
-                (case-split (integerp j))
-                )
-           (equal (bits (* -1 x) i j)
-                  (if (integerp (* 1/2 x (/ (expt 2 i))))
-                      0
-                    (if (integerp (* x (/ (expt 2 j))))
-                        (+ (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))
-                      (+ -1 (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j))))))))
-
-;this one should be the one enabled?
-(defthmd bits-minus-alt
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (<= j i))
-                (case-split (integerp j))
-                )
-           (equal (bits x i j)
-                  (if (integerp (* 1/2 (- X) (/ (EXPT 2 I))))
-                    0
-                    (if (INTEGERP (* (- X) (/ (EXPT 2 J))))
-                        (+ (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j)))
-                      (+ -1 (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j))))))))
-
-;drops hyps like this: (<= (BITS x 30 24) 253)
-;Recall that <= gets rewritten to < during proofs
-(defthm bits-drop-silly-upper-bound
-  (implies (and (syntaxp (quotep k))
-                (>= k (1- (expt 2 (+ 1 i (- j)))))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< k (bits x i j))
-                  nil)))
-
-;rewrite things like (<= 4096 (BITS x 23 12)) to false
-;Recall that <= gets rewritten to < during proofs
-(defthm bits-drop-silly-lower-bound
-  (implies (and (syntaxp (quotep k))
-                (> k (1- (expt 2 (+ 1 i (- j)))))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-  (equal (< (bits x i j) k)
-         t)))
-
-;rewrite (< -64 (BITS <signal> 64 59)) to t
-(defthm bits-drop-silly-bound-3
-  (implies (and (syntaxp (quotep k))
-                (< k 0)
-                )
-           (equal (< k (bits x i j))
-                  t)))
-
-(defthm bits-drop-silly-bound-4
-  (implies (and (syntaxp (quotep k))
-                (<= k 0)
-                )
-           (equal (< (bits x i j) k)
-                  nil)))
-
-;This is the rule for which I wish I knew the "parity" of the term being rewritten...
-(defthm bits-<-1
-  (equal (< (bits x i j) 1)
-         (equal (bits x i j) 0)))
-
-;put bits-cancel- in the name?
-(defthm bits-at-least-zeros
-  (implies (and (syntaxp (quotep k))
-                (equal k (expt 2 (- j2 j)))
-                (<= j j2)
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-           (equal (< (bits x i j)
-                     (* k (bits x i j2)))
-                  nil)))
-
-(defthm bits-upper-with-subrange
-  (implies (and (syntaxp (quotep k))
-                (<= j j2)
-                (equal k (expt 2 (- j2 j)))
-                (case-split (<= j2 i)) ;drop?
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-           (< (BITS x i j) 
-              (BINARY-+ k (BINARY-* k (BITS x i j2))))))
-
-(defthm bits-upper-with-subrange-alt
-  (implies (and (syntaxp (quotep k))
-                (<= j j2)
-                (equal k (expt 2 (- j2 j)))
-                (case-split (<= j2 i)) ;drop?
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-           (equal (< (BINARY-+ k (BINARY-* k (BITS x i j2))) 
-                     (BITS x i j))
-                  nil)))
-
-;make another version for k negative? (t-p should handle?)
-(defthm bits-equal-impossible-constant
-  (implies (and (syntaxp (quotep k)) ;require that i and j be constants too?
-                (<= (expt 2 (+ 1 i (- j))) k)
-                )
-           (not (equal (bits x i j) k))))
-
-;will this fire?
-(defthm bits-compare-to-zero
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (not (< 0 (bits x i j)))
-                  (equal 0 (bits x i j)))))
-
-;expensive?
-;have we done enough to prevent loops?
-;should we make a version where we require j to be a constant and then disable this version?
-(defthm bits-ignore-negative-bits-of-integer
-   (implies (and (syntaxp (not (and (quotep j) (equal 0 (cadr j))))) ;prevents loops
-                 (<= j 0)
-                 (integerp x)
-                 (case-split (integerp j))
-                 )
-            (equal (bits x i j)
-                   (* (expt 2 (- j)) (bits x i 0)))))
-
-;disable since it can be bad to leave "naked" signals and we never want to see expt
-(defthmd bits-does-nothing-2
-  (implies (and (<= j 0) ;a bit strange (j will usually be zero?)
-                (bvecp x (+ i 1)) ;expand?
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits x i j)
-                  (* (expt 2 (- j)) x))))
-
-;has the right pattern to rewrite stuff like this: (<= (EXPT 2 J) (BITS Y (+ -1 J) 0)) to nil
-(defthm bits-upper-bound-special
-  (< (bits x (1- i) 0) (expt 2 i)))
-
-;like bits-reduce
-;was called bits-tail
-;BOZO choose a name for this...
-(defthmd bits-does-nothing
-  (implies (and (bvecp x (1+ i))
-                (case-split (integerp i))
-                )
-           (equal (bits x i 0)
-                  x)))
-
-(defthm bits-with-bad-index-2
-  (implies (not (integerp i))
-           (equal (bits x (1- i) 0)
-                  0)))
-
-;BOZO rename to begin with "bits-"
-(defthmd bvecp-bits-0
-   (implies (bvecp x j)
-            (equal (bits x i j) 0)))
-
-;to handle mod- correctly
-;make an alt version?
-(defthm bits-drop-from-minus
-  (implies (and (bvecp x (1+ i))
-                (bvecp y (1+ i))
-                (<= y x)
-		(case-split (acl2-numberp i)))
-	   (equal (bits (+ x (* -1 y)) i 0)
-		  (+ x (* -1 y)))))
-
-;backchain-limit?
-(defthm bits-tail
-   (implies (and (bvecp x (1+ i))
-                 (case-split (acl2-numberp i)))
-            (equal (bits x i 0)
-                   x)))
-
-(defthm bits-tail-special
-   (implies (bvecp x i)
-            (equal (bits x (1- i) 0)
-                   x)))
-
-(defthmd bits-alt-def
-  (equal (bits x i j)
-         (if (or (not (integerp i))
-                 (not (integerp j)))
-             0
-           (mod (fl (/ x (expt 2 j))) (expt 2 (+ 1 i (- j)))))))
-
-(defthmd bits-plus-mult-2
-   (implies (and (< n k)
-                 (integerp y)
-                 (integerp k)
-                 )
-            (equal (bits (+ x (* y (expt 2 k))) n m)
-                   (bits x n m))))
-
-(defthmd bits-plus-mult-2-rewrite
-   (implies (and (syntaxp (quotep c))
-                 (equal (mod c (expt 2 (1+ n))) 0))
-            (equal (bits (+ c x) n m)
-                   (bits x n m))))
-
-;can we replace 0 with any non-negative j?
-(defthm bits-less-than-x
-  (implies (<= 0 x)
-	   (<= (bits x i 0) x))
-  :rule-classes (:rewrite :linear))
-
-;should say <= instead of less-than
-(defthm bits-less-than-x-gen
-  (implies (and (<= 0 x) ;case-split?
-                (case-split (<= 0 j))
-                (case-split (not (complex-rationalp x)))
-                )
-	   (<= (bits x i j) x))
-  :rule-classes (:rewrite :linear))
-
-
-(defthmd bits-bits-1
-  (implies (and (<= k (- i j))
-                (case-split (<= 0 l))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (bits x (+ k j) (+ l j)))))
-
-(defthmd bits-bits-2
-  (implies (and (> k (- i j))
-                (case-split (<= 0 l))
-;                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (bits x i (+ l j)))))
-
-(defthm bits-bits
-  (implies (and (case-split (<= 0 l))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (if (<= k (- i j))
-                      (bits x (+ k j) (+ l j))
-                    (bits x i (+ l j))))))
-
-
-;The following trivial corollary of bits-bits is worth keeping enabled.
-
-(defthm bits-bits-constants
-  (implies (and (syntaxp (quotep i))
-                (syntaxp (quotep j))
-                (syntaxp (quotep k))
-                (<= 0 l)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp l))
-           (equal (bits (bits x i j) k l)
-                  (if (<= k (- i j))
-                      (bits x (+ k j) (+ l j))
-                    (bits x i (+ l j))))))
-
-(defthm bits-reduce
-  (implies (and (< x (expt 2 (+ 1 i)))
-                (case-split (integerp x))
-                (case-split (<= 0 x))
-                (case-split (integerp i))
-                )
-           (equal (bits x i 0)
-                  x)))
-
-(defthm bits-0
-  (equal (bits 0 i j) 
-         0))
-
-
-
-;could prove a version where we drop bits from both args?
-(defthm bits-sum-drop-bits-around-arg-2
-  (implies (and (<= i i+)
-                (integerp y)
-                (case-split (integerp i+))
-                )
-           (equal (bits (+ x (bits y i+ 0)) i j)
-                  (bits (+ x y) i j))))
-
-;Follows from BITS-SUM-DROP-BITS-AROUND-ARG-2.
-(defthm bits-sum-drop-bits-around-arg-1
-  (implies (and (<= i i+)
-                (integerp x)
-                (case-split (integerp i+))
-                )
-           (equal (bits (+ (bits x i+ 0) y) i j)
-                  (bits (+ x y) i j))))
-
-(defthm bits-sum-drop-bits-around-arg-2-special-case
-  (implies (integerp y)
-           (equal (bits (+ x (bits y i 0)) i j)
-                  (bits (+ x y) i j))))
-
-(defthm bits-sum-drop-bits-around-arg-1-special-case
-  (implies (integerp x)
-           (equal (bits (+ (bits x i 0) y) i j)
-                  (bits (+ x y) i j))))
-
-;rename
-;Follows from BVECP-SUM-OF-BVECPS.
-(defthm bits-sum-1
-  (equal (bits (+ (bits x (1- i) 0)
-                  (bits y (1- i) 0))
-               i ;actually, this could be anything >= i ??
-               0)
-         (+ (bits x (1- i) 0)
-            (bits y (1- i) 0))))
-
-
-;export!! enable?
-;gen?
-;BOZO rename!
-(defthmd bits-of-non-integer-special
-  (implies (case-split (not (integerp i)))
-           (equal (bits x (1- i) 0)
-                  0)))
-
-(defthm bits-fl
-  (implies (<= 0 j)
-           (equal (bits (fl x) i j)
-                  (bits x i j))))
-
-;just use bits-fl-eric and bits-shift!
-;BOZO drop the fl from the lhs, since it'll be rewritten away...
-(defthmd bits-shift-down-1
-  (implies (and (<= 0 j)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                )
-           (equal (bits (fl (/ x (expt 2 k)))
-                        i
-                        j)
-                  (bits x (+ i k) (+ j k)))))
-
-(defthmd bits-shift-down-eric
-  (implies (and (<= 0 j)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                )
-           (equal (bits (* x (/ (expt 2 k)))
-                        i
-                        j)
-                  (bits x (+ i k) (+ j k)))))
-
-; like  bits-plus-mult-1 - remove one of them?
-(defthmd bits+2**k-2
-  (implies (and (< x (expt 2 k))
-                (<= 0 x)
-                (rationalp x) ;(integerp x)
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* y (expt 2 k))) n m)
-                  (bits y (- n k) (- m k)))))
-
-(defthm bits+2**k-2-alt
-  (implies (and (< x (expt 2 k))
-                (<= 0 x)
-                (rationalp x) ;(integerp x)
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* (expt 2 k) y)) n m)
-                  (bits y (- n k) (- m k)))))
-
-(defthmd bits-fl-by-2
-  (equal (fl (* 1/2 (bits x i 0)))
-         (bits x i 1)))
-
-(defthm mod-bits-by-2
-  (implies (and (integerp x)
-                (<= 0 i)
-                (integerp i)
-                )
-           (equal (mod (bits x i 0) 2)
-                  (mod x 2))))
-
-;basically the same as bits+2**k-2; drop one?
-;move
-(defthmd bits-plus-mult-1
-  (implies (and (bvecp x k) ;actually, x need not be an integer...
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* y (expt 2 k))) n m)
-                  (bits y (- n k) (- m k)))))
-
-(defthm bits-mod-0
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp m)
-                (>= m 0)
-                (integerp n)
-                (>= n 0))
-           (iff (= (mod x (expt 2 (+ m n 1))) 0)
-                (and (= (bits x (+ m n) n) 0)
-                     (= (mod x (expt 2 n)) 0))))
-  :rule-classes ())
-
-;this is silly? just open up bits!
-(defthm mod-bits-equal
-  (implies (= (mod x (expt 2 (1+ i))) (mod y (expt 2 (1+ i))))
-           (= (bits x i j) (bits y i j)))
-  :rule-classes ())
-
-(defthmd mod-bits-equal-cor
-    (implies (and (integerp x)
-		  (integerp n)
-		  (integerp i)
-		  (integerp j)
-		  (< i n))
-	     (equal (bits (mod x (expt 2 n)) i j)
-		    (bits x i j))))
-
-;not needed?  just expand bits?
-(defthmd bits-mod
-  (implies (and (case-split (integerp x))
-                (case-split (integerp i)) ;gen?
-;(case-split (<= 0 i))
-                )
-           (equal (bits x i 0)
-                  (mod x (expt 2 (1+ i))))))
-
-(defthmd bits-bits-sum
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp i))
-	   (equal (bits (+ (bits x i 0) y) i 0)
-		  (bits (+ x y) i 0))))
-
-;reorder? make rewrite?
-(defthm bits-shift-up-2
-  (implies (and (integerp x)
-                (integerp k)
-                (<= 0 k)
-                (integerp i)
-                )
-           (equal (* (expt 2 k) (bits x i 0))
-                  (bits (* (expt 2 k) x) (+ i k) 0)))
-  :rule-classes ())
-
-;export!
-;more forms of this? (bits (/ (expt 2 k)) i j)
-;bits of a constant power of 2??
-;bits of a range of ones (i.e., a difference of powers of 2).
-;use power2p??
-(defthm bits-expt
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k)) ;BOZO gen?
-                )
-           (equal (bits (expt 2 k) i j)
-                  (if (or (< i j)
-                          (< k j)
-                          (< i k))
-                      0
-                    (expt 2 (- k j))))))
-
-(defthm bits-expt-constant
-  (implies (and (syntaxp (and (quotep k) (power2p (cadr k))))
-                (force (power2p k)) ;bozo do the computation only once
-                (case-split (integerp k)) ;gen?
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits k i j)
-                  (if (or (< i j)
-                          (< (expo k) j)
-                          (< i (expo k)))
-                      0
-                    (expt 2 (- (expo k) j))))))
-
-
-;BOZO add case-splits?
-(defthm mod-bits
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (integerp j)
-                (integerp i))
-           (equal (mod (bits x i 0) (expt 2 j))
-                  (bits x (min i (1- j)) 0))))
-
-
-
-;Unlike bits-tail, this allows j to be non-zero.
-;Note that the conclusion is (bits x ...), not just x.
-;i is a free variable
-;watch out for loops with this rule
-(defthmd bits-tighten
-  (implies (and (bvecp x i)
-                (<= i n) 
-                (case-split (integerp n))
-                )
-           (equal (bits x n j)
-                  (bits x (1- i) j)))
-  :rule-classes ((:rewrite :match-free :all)))
-
-(defthmd bits-mod-2
-  (implies (and (integerp x)
-                (integerp i)
-                (integerp j)
-                (>= i j))
-           (equal (bits x (1- i) j)
-                  (- (fl (/ x (expt 2 j)))
-                     (* (expt 2 (- i j))
-                        (fl (/ x (expt 2 i))))))))
-
-(defthmd bits-neg
-  (implies (and (< i 0)
-                (integerp x))
-           (equal (bits x i j) 0)))
-
-(defthmd bits-shift-down-2
-  (implies (and (natp x)
-		(natp i)
-		(natp k))
-	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
-		  (bits (fl (/ x (expt 2 k))) i 0))))
diff -Nru acl2-6.2/books/rtl/rel5/support/bvecp-helpers.lisp acl2-6.3/books/rtl/rel5/support/bvecp-helpers.lisp
--- acl2-6.2/books/rtl/rel5/support/bvecp-helpers.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bvecp-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,249 +0,0 @@
-(in-package "ACL2")
-
-(include-book "rtl")
-(include-book "bvecp-lemmas") ;bvecp and type lemmas for the RTL primitives
-(local (include-book "../arithmetic/top"))
-(local (include-book "bits"))
-
-;would like to remove some of this stuff
-
-;;;;;;;;;;;;;;;;;;; other helpful lemmas
-
-(defthm nonneg-+
-  (implies (and (<= 0 x)
-                (<= 0 y))
-           (<= 0 (+ x y))))
-
-(defthm integerp-+
-  (implies (and (integerp x)
-                (integerp y))
-           (integerp (+ x y))))
-
-#|
-;should be a forward-chaining rule?
-(defthm bvecp-implies-natp
-  (implies (bvecp x k)
-           (and (integerp x)
-                (>= x 0)))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-;free var
-;should be a forward-chaining rule?
-(defthm bvecp-implies-rationalp
-  (implies (bvecp x k)
-           (rationalp x))
-  :hints (("Goal" :in-theory (enable bvecp))))
-|#
-
-;why do we have this?
-(defthm unknown-upper-bound
-  (< (unknown key size n) (expt 2 size))
-  :hints
-  (("goal" :use bvecp-unknown
-    :in-theory (set-difference-theories
-                (enable bvecp)
-                '(bvecp-unknown))))
-  :rule-classes
-  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
-
-(defthm bv-arrp-implies-nonnegative-integerp
-  (implies (bv-arrp obj size)
-           (and (INTEGERP (ag index obj))
-                (<= 0 (ag index obj))))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :use (:instance
-                        ag-maps-bv-arr-to-bvecp (a index) (r obj) (k size))
-           :in-theory (set-difference-theories
-                       (enable bvecp)
-                       '(ag-maps-bv-arr-to-bvecp)))))
-
-;(local (in-theory (enable floor-fl)))
-
-;These next two are for the bus unit bvecp lemmas:
-
-;could use (local (in-theory (enable expt-compare-with-double)))
-;remove?
-(defthm bits-does-nothing-hack
-  (implies (and (< x (expt 2 i)) 
-                (integerp x)
-                (<= 0 x)
-                (integerp i)
-                (<= 0 i))
-           (equal (BITS (* 2 x) i 0)
-                  (* 2 x)))
-  :hints (("Goal" :use (:instance bits-tail (x (* 2 x)) (i i))
-           :in-theory (set-difference-theories
-                       (enable bvecp)
-                       '(bits-tail)))))
-
-;remove?
-(defthm bits-does-nothing-hack-2
-  (implies (and (< x (expt 2 i)) 
-                (integerp x)
-                (<= 0 x)
-                (integerp i)
-                (<= 0 i))
-           (equal (bits (+ 1 (* 2 x)) i 0)
-                  (+ 1 (* 2 x))))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '(bits-tail
-                                ))
-           :use (:instance bits-tail (x (+ 1 (* 2 x))) (i i)))))
-
-
-;is this one too expensive?
-(defthm bvecp-def
-  (implies (and (< x (expt 2 k))
-                (integerp x)
-                (<= 0 x)
-                )
-           (bvecp x k))
-  :hints (("Goal" :in-theory (enable bvecp)))
-  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
-
-(defthm if1-0
-  (equal (if1 0 y z)
-         z))
-
-(defthm if1-non-0
-  (implies (not (equal x 0))
-           (equal (if1 x y z)
-                  y)))
-
-(defthm if1-x-x
-  (equal (if1 tst x x)
-         x))
-
-(defthm bvecp-if1
-  (equal (bvecp (if1 x y z) n)
-         (if1 x (bvecp y n) (bvecp z n))))
-
-(defthm bv-arrp-if1
-  (equal (bv-arrp (if1 x y z) n)
-         (if1 x (bv-arrp y n) (bv-arrp z n))))
-
-;remove these?
-
-
-#|
-(defthm bvecp-1-values
-  (implies (and (bvecp x 1)
-                (not (equal x 0)))
-           (equal (equal x 1) t))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-(defthm bvecp-2-values
-  (implies (and (bvecp x 2)
-                (not (equal x 2))
-                (not (equal x 1))
-                (not (equal x 0)))
-           (equal (equal x 3) t))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-(defthm bvecp-3-values
-  (implies (and (bvecp x 3)
-                (not (equal x 6))
-                (not (equal x 5))
-                (not (equal x 4))
-                (not (equal x 3))
-                (not (equal x 2))
-                (not (equal x 1))
-                (not (equal x 0)))
-           (equal (equal x 7) t))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-(defthm bvecp-4-values
-  (implies (and (bvecp x 4)
-                (not (equal x 14))
-                (not (equal x 13))
-                (not (equal x 12))
-                (not (equal x 11))
-                (not (equal x 10))
-                (not (equal x 9))
-                (not (equal x 8))
-                (not (equal x 7))
-                (not (equal x 6))
-                (not (equal x 5))
-                (not (equal x 4))
-                (not (equal x 3))
-                (not (equal x 2))
-                (not (equal x 1))
-                (not (equal x 0)))
-           (equal (equal x 15) t))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-(defthm bvecp-5-values
-  (implies (and (bvecp x 5)
-                (not (equal x 30))
-                (not (equal x 29))
-                (not (equal x 28))
-                (not (equal x 27))
-                (not (equal x 26))
-                (not (equal x 25))
-                (not (equal x 24))
-                (not (equal x 23))
-                (not (equal x 22))
-                (not (equal x 21))
-                (not (equal x 20))
-                (not (equal x 19))
-                (not (equal x 18))
-                (not (equal x 17))
-                (not (equal x 16))
-                (not (equal x 15))
-                (not (equal x 14))
-                (not (equal x 13))
-                (not (equal x 12))
-                (not (equal x 11))
-                (not (equal x 14))
-                (not (equal x 13))
-                (not (equal x 12))
-                (not (equal x 11))
-                (not (equal x 10))
-                (not (equal x 9))
-                (not (equal x 8))
-                (not (equal x 7))
-                (not (equal x 6))
-                (not (equal x 5))
-                (not (equal x 4))
-                (not (equal x 3))
-                (not (equal x 2))
-                (not (equal x 1))
-                (not (equal x 0)))
-           (equal (equal x 31) t))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-
-;can remove these two?
-(defthm natp-* 
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp y)
-                (>= y 0))
-           (and (integerp (* x y))
-                (>= (* x y) 0))))
-
-(defthm natp-+ 
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp y)
-                (>= y 0))
-           (and (integerp (+ x y))
-                (>= (+ x y) 0))))
-
-
-;drop?
-(DEFTHM BITS-bvecp-FW
-  (IMPLIES (EQUAL N (- (1+ I) J))
-           (BVECP (BITS X I J) N))
-  :RULE-CLASSES
-  ((:FORWARD-CHAINING :TRIGGER-TERMS ((BITS X I J)))))
-|#
-
-
-;BOZO where all should this go?  make an if1 book!
-(defthmd if1-lnot
-  (implies (bvecp tst 1)
-	   (equal (if1 (lnot tst 1) x y)
-		  (if1 tst y x)))
-  :hints (("Goal" :in-theory (enable if1 bvecp))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/bvecp-lemmas.lisp acl2-6.3/books/rtl/rel5/support/bvecp-lemmas.lisp
--- acl2-6.2/books/rtl/rel5/support/bvecp-lemmas.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bvecp-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,207 +0,0 @@
-(in-package "ACL2")
-
-;BOZO Everything in this book should be redundant...
-
-(set-match-free-default :all)
-
-;Contains bvecp lemmas about the RTL primitives.
-;Also contains type lemmas (non-negative integer, natp, etc.)
-
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(local (include-book "../arithmetic/expo"))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defun expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;should this be here?  should it be enabled?
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local (include-book "bits"))
-(local (include-book "setbits"))
-(local (include-book "setbitn"))
-(local (include-book "encode"))
-(local (include-book "decode"))
-(local (include-book "logs"))
-(local (include-book "lnot"))
-(local (include-book "bitn"))
-(local (include-book "shft"))
-(local (include-book "cat"))
-(local (include-book "logand"))
-(local (include-book "merge")) ;would like to remove this
-(local (include-book "mulcat"))
-(local (include-book "land0"))
-(local (include-book "lior0"))
-(local (include-book "lxor0"))
-(local (include-book "cat"))
-
-(include-book "rtl")
-
-;; logand
-
-(defthm logand-integer-type-prescription
-  (integerp (logand i j))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logand))))
-
-(defthm logand-non-negative-integer-type-prescription
-  (implies (or (<= 0 i)
-               (<= 0 j))
-           (and (<= 0 (logand i j))
-                (integerp (logand i j))))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logand))))
-
-(defthm logand-non-negative
-  (implies (or (<= 0 x)
-               (<= 0 y)
-               )
-           (<= 0 (logand x y))))
-
-(defthm bvecp-logand-alternate
-  (implies (and (integerp n)
-                (<= 0 n)
-                (bvecp x n)
-                (bvecp y n))
-           (bvecp (logand x y) n))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-
-;; logior
-
-(defthm logior-integer-type-prescription
-  (integerp (logior i j))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-non-negative-integer-type-prescription
-  (implies (and (<= 0 i)
-                (<= 0 j))
-           (and (<= 0 (logior i j))
-                (integerp (logior i j))))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-non-negative
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                )
-           (<= 0 (logior i j))))
-
-(defthm bvecp-logior-alternate
-  (implies (and (integerp n)
-                (<= 0 n)
-                (bvecp x n)
-                (bvecp y n))
-           (bvecp (logior x y) n)))
-
-;; logxor
-;!!fix this to have lemmas like logand,logior above
-(defthm natp-logxor-alternate-2
-    (implies (and (integerp x) (<= 0 x)
-		  (integerp y) (<= 0 y))
-	     (and (integerp (logxor x y))
-		  (<= 0 (logxor x y))))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm bvecp-logxor-alternate
-  (implies (and (integerp n)
-                (<= 0 n)
-                (bvecp x n)
-                (bvecp y n))
-           (bvecp (logxor x y) n)))
-
-;if1
-
-(defthm bvecp-if1
-  (equal (bvecp (if1 x y z) n)
-         (if1 x (bvecp y n) (bvecp z n))))
-
-
-;; mod-
-
-;finish this section (will have to change comp2-inv?)
-
-#|
-(defthm mod--nonnegative-integer-type
-  (and (integerp (mod- l n x))
-       (<= 0 (mod- l n x)))
-  :hints (("Goal" :in-theory (enable mod-)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than mod--nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription mod-)))
-|#
-
-#| mod- is now a macro!
-(defthm mod--bvecp
-  (implies (and (bvecp x n)
-                (bvecp y n)
-                (integerp n)
-                (>= n 0))
-           (bvecp (mod- x y n) n))
-  :hints (("Goal" :in-theory (enable bvecp mod- comp2-inv))))
-|#
-
-
-
-
-
-
-(DEFTHM UNKNOWN-upper-bound
-  (< (UNKNOWN KEY SIZE N) (expt 2 size))
-  :HINTS
-  (("Goal" :use bvecp-unknown
-    :IN-THEORY (set-difference-theories
-                (ENABLE BVECP)
-                '(bvecp-unknown))))
-  :RULE-CLASSES
-  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
-
-(defthm bv-arrp-implies-nonnegative-integerp
-  (implies (bv-arrp obj size)
-           (and (INTEGERP (ag index obj))
-                (<= 0 (ag index obj))))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :use (:instance
-                        ag-maps-bv-arr-to-bvecp (a index) (r obj) (k size))
-           :in-theory (set-difference-theories
-                       (enable bvecp)
-                       '(ag-maps-bv-arr-to-bvecp))))
-  )
-
-
-
-
-
-
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/bvecp-proofs.lisp acl2-6.3/books/rtl/rel5/support/bvecp-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/bvecp-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bvecp-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,249 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(local (include-book "../arithmetic/top"))
-
-(local (in-theory (enable expt-minus)))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defthm bvecp-with-n-not-a-positive-integer
-  (implies (or (not (integerp k))
-               (<= k 0))
-           (equal (bvecp x k)
-                  (equal 0 x)))
-  :hints (("Goal" :cases ((< x 1))
-           :in-theory (enable bvecp))))
-
-(defthm bvecp-0
-  (bvecp 0 k)
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-;drop?
-;just a special case of bvecp-with-n-not-a-positive-integer
-(defthm bvecp-0-thm
-  (equal (bvecp x 0)
-         (equal x 0))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-(defthm bvecp-ones
-  (implies (case-split (<= 0 k))
-           (bvecp (1- (expt 2 k)) k))
-    :hints (("goal" :in-theory (enable bvecp))))
-
-(encapsulate
- ()
-;k1 is a free var
- (local (defthm bvecp-longer-aux
-          (implies (and (bvecp x k1)
-                        (<= k1 k2)
-                        (case-split (integerp k1))
-                        (case-split (integerp k2))
-                        )
-                   (bvecp x k2))
-          :rule-classes ((:rewrite :match-free :all))
-          :hints (("Goal" :use (:instance expt-compare (lhs (expt 2 k1)) (rhs (expt 2 k2)))
-                   :in-theory (set-difference-theories
-                               (enable bvecp)
-                               '(EXPT-COMPARE))
-                   ))))
-;k1 is a free var
- (defthm bvecp-longer
-   (implies (and (bvecp x k1)
-                 (<= k1 k2)
-                 (case-split (integerp k2))
-                 )
-            (bvecp x k2))
-   :rule-classes ((:rewrite :match-free :all))
-   :hints (("Goal" :cases ((integerp k1)))))
- )
-
-;expensive and so disabled
-;no free var
-(defthmd bvecp-one-longer
-  (implies (and (integerp k)
-                (bvecp x (- k 1)))
-           (bvecp x k))
-  :hints (("Goal" :in-theory (disable bvecp-longer)
-           :use ((:instance bvecp-longer (k2 k) (k1 (- k 1))))))
-  :rule-classes ((:rewrite :backchain-limit-lst (nil 2))))
-
-
-(defthm bvecp-of-non-integer
-  (implies (not (integerp x))
-           (not (bvecp x k)))
-    :hints (("Goal" :in-theory (enable bvecp))))
-
-;gen (replace n+1 with an arbitrary integer > n)?
-(defthm bvecp-expt-2-n
-  (implies (and (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (bvecp (expt 2 n) (+ 1 n)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bvecp expt-split)
-                              '(a15)))))
-
-(defthm bvecp-if ; see comment in bvecp.lisp
-  (equal (bvecp (if test x y) k)
-         (if test (bvecp x k) (bvecp y k))))
-
-
-; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
-
-;better name?
-(defund mk-bvec (r k)
-  (declare (xargs :guard (integerp k)))
-  (if (bvecp r k) r 0))
-
-(defthm mk-bvec-is-bvecp
-  (bvecp (mk-bvec r k) k)
-  :hints (("Goal" :in-theory (enable mk-bvec))))
-
-(defthm mk-bvec-identity
-  (implies (bvecp r k)
-           (equal (mk-bvec r k) r))
-  :hints (("Goal" :in-theory (enable mk-bvec))))
-
-;BOZO make a version to shift by a constant!
-(defthm bvecp-shift
-  (implies (and (integerp x) ;note!
-		(<= 0 m)
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* x (expt 2 m)) n)
-		  (bvecp x (- n m))))
-  :hints (("Goal" :in-theory (enable bvecp expt-split))))
-
-(defthm bvecp-shift-alt
-  (implies (and (integerp x) ;note!
-		(<= 0 m)
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* (expt 2 m) x) n)
-		  (bvecp x (- n m))))
-  :hints (("Goal" :in-theory (enable bvecp expt-split))))
-
-;gen this!
-;BOZO will this unify (* 2 x) with 0??
-(defthm bvecp-shift-by-2
-  (implies (and (syntaxp (not (quotep x))) ;prevents loops...
-                (integerp x)
-		(<= 0 m) ;gen?
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* 2 x) n)
-		  (bvecp x (- n 1))))
-  :hints (("Goal" :in-theory (enable bvecp expt-split))))
-
-
-;gen?
-;in general, rewrite (bvecp k n) where k is a constant to a fact about n
-(defthm bvecp-1
-  (implies (and (<= 1 n)
-                (integerp n))
-           (bvecp 1 n))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-;n is a free variable
-;Disabled since may cause expensive backchaining.
-(defthmd natp-bvecp
-  (implies (bvecp x n)
-           (natp x))
-  :hints (("Goal" :in-theory (enable bvecp)))
-  :rule-classes ((:rewrite :match-free :once)))
-
-#|
-;kill this rule?
-;could just open bvecp instead of using this rule?
-(defthmd bvecp<=
-    (implies (and (natp n) ;gen?
-		  (bvecp x n))
-	     (<= x (1- (expt 2 n))))
-  :hints (("Goal" :in-theory (enable bvecp))))
-|#
-
-(defthmd bvecp-forward
-  (implies (bvecp x k)
-           (and (integerp x)
-                (<= 0 x)
-                (< x (expt 2 k)))) ;tigher-bound?
-  :hints (("Goal" :in-theory (enable bvecp)))
-  :rule-classes :forward-chaining)
-
-(defthm bvecp-product
-  (implies (and (bvecp x m)
-                (bvecp y n)
-                )
-           (bvecp (* x y) (+ m n)))
-  :rule-classes ()
-  :hints (("Goal" :cases ((and (integerp m) (equal 0 y) (integerp n))
-                          (and (integerp m) (equal 0 y) (not (integerp n)))
-                          (and (integerp m) (not (equal 0 y)) (integerp n))
-                          (and (integerp m) (not (equal 0 y)) (not (integerp n)))
-                          (and (not (integerp m))(equal 0 y) (integerp n))
-                          (and (not (integerp m)) (equal 0 y) (not (integerp n)))
-                          (and (not (integerp m)) (not (equal 0 y)) (integerp n))
-                          (and (not (integerp m)) (not (equal 0 y)) (not (integerp n)))
-                          )
-           :in-theory (enable bvecp natp expt-split))))
-
-(defthmd bvecp-1-rewrite
-  (equal (bvecp x 1)
-	 (or (equal x 0) (equal x 1)))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-;make another for not-equal-0 implies equal-1?
-(defthm bvecp-1-0
-    (implies (and (bvecp x 1)
-		  (not (equal x 1)))
-	     (equal x 0))
-  :rule-classes :forward-chaining
-  :hints (("Goal" :use bvecp-1-rewrite)))
-
-
-(defthm bvecp+1
-    (implies (and (natp n)
-		  (bvecp x n))
-	     (bvecp x (+ 1 n)))
-  :hints (("Goal" :in-theory (enable bvecp expt-split))))
-
-;same as bvecp-longer.decide which param names to use.  j and k??
-(defthmd bvecp-monotone
-    (implies (and (bvecp x n)
-		  (<= n m)
-                  (case-split (integerp m))
-                  )		  
-	     (bvecp x m)))
-
-
-;This bounds the amount of carry out that we can have from the sum.
-(defthm bvecp-sum-of-bvecps
-  (implies (and (bvecp x (1- k))
-                (bvecp y (1- k))
-                (case-split (integerp k)))
-           (bvecp (+ x y) k))
-  :hints (("Goal" :in-theory (enable bvecp expt-split)))
-  )
-
-
-;add rule that (not (natp x)) implies (not (bvecp x k)) ??
-
-;exported in lib/
-(defthmd bvecp-0-1
-  (implies (and (bvecp x 1)
-                (not (equal x 0)))
-           (equal x 1))
-  :rule-classes :forward-chaining)
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/bvecp.lisp acl2-6.3/books/rtl/rel5/support/bvecp.lisp
--- acl2-6.2/books/rtl/rel5/support/bvecp.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/bvecp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,191 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(local (include-book "bvecp-proofs"))
-
-;; New stuff:
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defthm bvecp-with-n-not-a-positive-integer
-  (implies (or (not (integerp k))
-               (<= k 0))
-           (equal (bvecp x k)
-                  (equal 0 x))))
-
-(defthm bvecp-0
-  (bvecp 0 k))
-
-;drop?
-;just a special case of bvecp-with-n-not-a-positive-integer
-(defthm bvecp-0-thm
-  (equal (bvecp x 0)
-         (equal x 0)))
-
-(defthm bvecp-ones
-  (implies (case-split (<= 0 k))
-           (bvecp (1- (expt 2 k)) k)))
-
-;k1 is a free var
-(defthm bvecp-longer
-   (implies (and (bvecp x k1)
-                 (<= k1 k2)
-                 (case-split (integerp k2))
-                 )
-            (bvecp x k2))
-   :rule-classes ((:rewrite :match-free :all)))
-
-;expensive and so disabled
-;no free var
-(defthmd bvecp-one-longer
-  (implies (and (integerp k)
-                (bvecp x (- k 1)))
-           (bvecp x k))
-  :rule-classes ((:rewrite :backchain-limit-lst (nil 2))))
-
-
-(defthm bvecp-of-non-integer
-  (implies (not (integerp x))
-           (not (bvecp x k))))
-
-;gen (replace n+1 with an arbitrary integer > n)?
-(defthm bvecp-expt-2-n
-  (implies (and (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (bvecp (expt 2 n) (+ 1 n))))
-
-;Can help in back-chaining (sometimes ACL2 will refuse to split an IF during backchaining). Imagine that ACL2
-;backchains to (bvecp (if test x y) k) and we know (bvecp x k) and (bvecp y k). ACL2 may fail to relieve the
-;hyp because it refuses to split into cases (due to some heuristics that limit the cost of backchaining). But
-;if this rule fires, both (bvecp x k) and (bvecp y k) can rewrite to T, and the hyp can be relieved.  (At
-;least, I think that's how this works.)
-(defthm bvecp-if
-  (equal (bvecp (if test x y) k)
-         (if test (bvecp x k) (bvecp y k))))
-
-
-; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
-
-;better name?
-(defund mk-bvec (r k)
-  (declare (xargs :guard (integerp k)))
-  (if (bvecp r k) r 0))
-
-(defthm mk-bvec-is-bvecp
-  (bvecp (mk-bvec r k) k))
-
-(defthm mk-bvec-identity
-  (implies (bvecp r k)
-           (equal (mk-bvec r k) r)))
-
-;BOZO make a version to shift by a constant!
-(defthm bvecp-shift
-  (implies (and (integerp x) ;note!
-		(<= 0 m)
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* x (expt 2 m)) n)
-		  (bvecp x (- n m)))))
-
-(defthm bvecp-shift-alt
-  (implies (and (integerp x) ;note!
-		(<= 0 m)
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* (expt 2 m) x) n)
-		  (bvecp x (- n m)))))
-
-;gen this!
-;BOZO will this unify (* 2 x) with 0??
-(defthm bvecp-shift-by-2
-  (implies (and (syntaxp (not (quotep x))) ;prevents loops...
-                (integerp x)
-		(<= 0 m) ;gen?
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* 2 x) n)
-		  (bvecp x (- n 1)))))
-
-
-;gen?
-;in general, rewrite (bvecp k n) where k is a constant to a fact about n
-(defthm bvecp-1
-  (implies (and (<= 1 n)
-                (integerp n))
-           (bvecp 1 n)))
-
-;n is a free variable
-;Disabled since may cause expensive backchaining.
-(defthmd natp-bvecp
-  (implies (bvecp x n)
-           (natp x))
-  :rule-classes ((:rewrite :match-free :once)))
-
-(defthmd bvecp-forward
-  (implies (bvecp x k)
-           (and (integerp x)
-                (<= 0 x)
-                (< x (expt 2 k)))) ;tigher-bound?
-  :rule-classes :forward-chaining)
-
-(defthm bvecp-product
-  (implies (and (bvecp x m)
-                (bvecp y n)
-                )
-           (bvecp (* x y) (+ m n)))
-  :rule-classes ())
-
-(defthmd bvecp-1-rewrite
-  (equal (bvecp x 1)
-	 (or (equal x 0) (equal x 1))))
-
-;make another for not-equal-0 implies equal-1?
-(defthm bvecp-1-0
-    (implies (and (bvecp x 1)
-		  (not (equal x 1)))
-	     (equal x 0))
-  :rule-classes :forward-chaining)
-
-(defthm bvecp+1
-  (implies (and (natp n)
-                (bvecp x n))
-           (bvecp x (+ 1 n))))
-
-;same as bvecp-longer.decide which param names to use.  j and k??
-(defthmd bvecp-monotone
-    (implies (and (bvecp x n)
-		  (<= n m)
-                  (case-split (integerp m))
-                  )		  
-	     (bvecp x m)))
-
-
-;This bounds the amount of carry out that we can have from the sum.
-(defthm bvecp-sum-of-bvecps
-  (implies (and (bvecp x (1- k))
-                (bvecp y (1- k))
-                (case-split (integerp k)))
-           (bvecp (+ x y) k)))
-
-
-;add rule that (not (natp x)) implies (not (bvecp x k)) ??
-
-;exported in lib/
-(defthmd bvecp-0-1
-  (implies (and (bvecp x 1)
-                (not (equal x 0)))
-           (equal x 1))
-  :rule-classes :forward-chaining)
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/cat-def.lisp acl2-6.3/books/rtl/rel5/support/cat-def.lisp
--- acl2-6.2/books/rtl/rel5/support/cat-def.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/cat-def.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,88 +0,0 @@
-(in-package "ACL2")
-
-;don't include just this book unless you really mean it; this book contains no theorems about cat.  even the
-;type-prescription lemma generated about binary-cat in this book is poor.
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-#|
-;drop?
-(defund ocat (x y n)
-  (declare (xargs :guard t))
-  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
-|#
-
-; return 0 if m or n isn't a nat (change this bevahior?)
-(defund binary-cat (x m y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp m) (< 0 m)
-                              (integerp n) (< 0 n))
-                  :verify-guards nil))
-  (if (and (natp m) (natp n))
-      (+ (* (expt 2 n) (bits x (1- m) 0))
-         (bits y (1- n) 0))
-    0))
-
-;; The macro cat
-
-(defun formal-+ (x y)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(encapsulate
- ()
- (local ; for guard proof below
-  (defthm fold-constants-in-+
-    (implies (and (syntaxp (quotep x))
-                  (syntaxp (quotep y)))
-             (equal (+ x y z)
-                    (+ (+ x y) z)))))
-
-;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
-;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
-;;not need to specify this in the guard, and leaving it out of that guard
-;;simplifies the guard proof.
-
- (defun cat-size (x)
-   ;;an auxiliary function that does not appear in translate-rtl output.
-   (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
-   (if (endp (cddr x))
-       (cadr x)
-     (formal-+ (cadr x)
-               (cat-size (cddr x))))))
-
-;data and sizes alternate thus: (cat x xsize y ysize z zsize ...)  
-(defmacro cat (&rest x)
-  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
-  (cond ((endp (cddr x))
-         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
-        ((endp (cddddr x))
-         `(binary-cat ,@x))
-        (t
-         `(binary-cat ,(car x) 
-                      ,(cadr x) 
-                      (cat ,@(cddr x)) 
-                      ,(cat-size (cddr x))))))
-
-;Allows things like (in-theory (disable cat)) to refer to binary-cat.
-(add-macro-alias cat binary-cat)
-
diff -Nru acl2-6.2/books/rtl/rel5/support/cat-proofs.lisp acl2-6.3/books/rtl/rel5/support/cat-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/cat-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/cat-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1201 +0,0 @@
-(in-package "ACL2")
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-;(defund ocat (x y n)
-;  (declare (xargs :guard t))
-;  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(include-book "cat-def")
-(local (include-book "../arithmetic/top")) ;try
-(local (include-book "bits"))
-(local (include-book "bvecp"))
-
-(local (in-theory (enable expt-minus)))
-
-#|
-Concatenate the M-bit value X onto the N-bit value Y.  X will occupy the high bits of the result.
-
-(cat x m y n) is well-defined only when the following predicate is true:
-
-(and (natp m)
-     (bvecp x m)
-     (natp n)
-     (bvecp y n))
-
-|#
-
-(defthm cat-nonnegative-integer-type
-  (and (integerp (cat x m y n))
-       (<= 0 (cat x m y n)))
-  :hints (("Goal" :in-theory (enable cat)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than cat-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-cat)))
-
-;just a rewrite rule
-(defthm cat-natp
-  (natp (cat x m y n)))
-
-;disable?
-(defthm cat-0
-  (implies (and (case-split (bvecp y n))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )		  
-           (equal (cat 0 m y n) y))
-  :hints (("Goal" :in-theory (enable cat bits-tail))))
-
-;BOZO just use this one??
-(defthm cat-0-alt
-  (implies (and ;(case-split (bvecp y n))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )		  
-           (equal (cat 0 m y n) (bits y (1- n) 0)))
-  :hints (("Goal" :in-theory (enable cat bits-tail))))
-
-;We can rely on bits-tail to complete the simplification down to x if desired.
-(defthm cat-with-n-0
-  (equal (binary-cat x m y 0)
-         (bits x (1- m) 0))
-  :hints (("goal" :in-theory (enable cat))))
-
-(local (in-theory (enable bits-tail)))
-
-(defthm cat-with-n-0-alt
- (implies (case-split (bvecp x m))
-           (equal (cat x m y 0)
-                  x)))
-
-;We can rely on bits-tail to complete the simplification down to y if desired.
-(defthm cat-with-m-0
-  (equal (binary-cat x 0 y n)
-         (bits y (1- n) 0))
-  :hints (("goal" :in-theory (enable cat))))
-
-(defthm cat-with-m-0-alt
-  (implies (case-split (bvecp y n))
-           (equal (cat x 0 y n)
-                  y)))
-
-;change this behavior??
-(defthm cat-with-n-not-a-natural
-  (implies (or (not (integerp n))
-               (< n 0))
-           (equal (cat x m y n)
-                  0))
-  :hints (("Goal" :in-theory (enable cat))))
-
-(defthm cat-with-m-not-a-natural
-  (implies (or (not (integerp m))
-               (< m 0))
-           (equal (cat x m y n)
-                  0))
-  :hints (("Goal" :in-theory (enable cat))))
-
-#|
-;used to transfer theorems about ocat to theorems about cat
-(defthmd cat-ocat
-    (equal (binary-cat x m y n)
-	   (if (or (not (integerp m))
-		   (< m 0)
-		   (not (integerp n))
-		   (< n 0)
-		   )
-	       0
-	     (ocat (bits x (1- m) 0)
-		   (bits y (1- n) 0)
-		   n)))
-  :hints (("Goal" :in-theory (enable ocat cat))))
-|#
-
-(local (defthm hack-10
-    (implies (and (integerp x)
-		  (integerp y)
-		  (< x y)
-                  )
-	     (<= x (1- y)))
-  :rule-classes ()))
-
-(defthm cat-bvecp-simple
-  (bvecp (cat x m y n) (+ m n))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bvecp cat expt-split)
-                              '(expt-compare EXPT-COMPARE-EQUAL ))
-		  :use ((:instance expt-split (i m) (j n) (r 2))
-			(:instance hack-10 (x (BITS X (1- M) 0)) (y (expt 2 m)))
-			(:instance expt-weak-monotone (m p))
-			(:instance expt-weak-monotone (m k) (n (+ m n)))))))
-
-
-(defthm cat-bvecp
-  (implies (and (<= (+ m n) k)
-                (case-split (integerp k)))
-           (bvecp (cat x m y n) k))
-  :hints (("Goal" :in-theory (disable cat-bvecp-simple)
-           :use cat-bvecp-simple)))
-
-#|
-
-these aren't right any more?
-
-(defthm cat-with-x-not-a-natural
-  (implies (or (not (integerp x))
-               (< x 0))
-           (equal (cat x m y n)
-                  0))
-  :hints (("Goal" :in-theory (enable cat))))
-
-(defthm cat-with-y-not-a-natural
-  (implies (or (not (integerp y))
-               (< y 0))
-           (equal (cat x y n)
-                  (* (nfix x) (expt 2 (nfix n)))))
-  :hints (("Goal" :in-theory (enable cat-ocat))))
-
-|#
-
-;move
-(defthm hack11
- (implies (and (< x z)
-               (integerp x)
-               (integerp z)
-               (<= 0 y)
-               (< y 1))
-          (< (+ x y) z)))
-
-;move!
-(defthm expt-bound-hack
- (implies (and (< y (expt 2 i))
-               (< x (expt 2 (- k i)))
-               (<= 0 x)
-               (<= 0 y)
-               (<= i k)
-               (integerp k)
-               (integerp i)
-               (integerp x)
-               (integerp y)
-               )
-          (< (+ y (* (expt 2 i) x)) (expt 2 k)))
- :hints (("Goal" :in-theory (e/d ( expt-split expt-minus)
-                                 (LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE
-                                  LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE))
-          :use (:instance  mult-both-sides-of-<-by-positive (a (+ y (* x (expt 2 i)))) (b (expt 2 k))
-                           (c (/ (expt 2 i)))))) 
- )
-
-
-
-(defthm cat-associative
-  (implies (and (case-split (<= (+ m n) p)) ;gen?
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 q))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                (case-split (integerp q))
-                )
-           (equal (cat (cat x m y n) p z q)
-                  (cat x m (cat y n z q) (+ n q))))
-  :hints (("Goal" :in-theory (enable cat))))
-
-;prove from something more general (cat-equal-split??)
-;BOZO move hyps to conclusion?
-(defthm cat-equal-0
-  (implies (and (case-split (bvecp x m))
-                (case-split (bvecp y n))
-                (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat x m y n) 0)
-                  (and (equal x 0)
-                       (equal y 0))))
-  :hints (("Goal" :in-theory (enable cat bits-tail bvecp)))
-  )
-
-(defthm cat-combine-constants
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep m)
-                              (quotep y)
-                              (quotep n)))
-                (equal (+ n p) r)
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 p))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                )
-           (equal (cat x m (cat y n z p) r)
-                  (cat (cat x m y n) (+ m n) z p))))
-
-;allows r to be > n+p
-(defthm cat-combine-constants-gen
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep m)
-                              (quotep y)
-                              (quotep r)
-                              (quotep p)))
-                (case-split (<= (+ n p) r))
-                (case-split (bvecp y n))
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 p))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                (case-split (integerp r))
-                )
-           (equal (cat x m (cat y n z p) r)
-                  (cat (cat x m y (+ r (- p))) (+ m r (- p)) z p)))
-  :hints (("goal" :in-theory (enable bits-tail)
-           :expand ((binary-cat y n z p)
-                           (binary-cat y (+ r (* -1 p)) z p)))))
-
-(defthm cat-constant-equal-constant-hack
-  (implies (and (syntaxp (and (quotep k1) (quotep k2)))
-                (case-split (bvecp x n))
-                (case-split (bvecp k1 m))
-                (case-split (rationalp k2))
-                (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat k1 m x n) k2)
-                  (equal x (- k2 (* (expt 2 n) k1)))))
-  :hints (("Goal" :in-theory (enable cat bvecp))))
-
-(defthm cat-upper-bound
-  (< (cat x m y n)
-     (expt 2 (+ m n)))
-  :rule-classes (:rewrite :linear)
-  :hints (("goal"
-           :in-theory (set-difference-theories
-                       (enable cat)
-                       '()))))
-
-;perhaps the :linear rule cat-upper-bound is enough, but this may help stupid hyps be rewritten away
-(defthm cat-compare-to-constant-1
-  (implies (and (syntaxp (quotep k))
-                (<= (expt 2 (+ m n)) k))
-           (< (cat x m y n) k))
-  :hints (("goal" :in-theory (disable cat-upper-bound)
-           :use cat-upper-bound)))
-
-;provides a tighter bound
-(defthm cat-upper-bound-tight
-  (implies (and (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (<= (cat x m y n)
-               (1- (expt 2 (+ n m)))))
-  :hints (("goal" :use cat-upper-bound
-           :in-theory (set-difference-theories
-                       (enable)
-                       '(cat-upper-bound)))))
-
-
-(defthm cat-compare-to-constant-2
-  (implies (and (syntaxp (quotep k))
-                (<= (1- (expt 2 (+ m n))) k)
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (not (< k (cat x m y n))))
-  :hints (("goal" :in-theory (disable cat-upper-bound)
-           :use cat-upper-bound)))
-
-;BOZO consider adding?
-;problem if we case-split something that turns out to be false?
-(defthm bits-with-i-not-an-integer-2
-  (implies (case-split (not (integerp i)))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-j-not-an-integer-2
-  (implies (case-split (not (integerp j)))
-           (equal (bits x i j)
-                  0)))
-
-;also case-split that i>=j in any call to bits?
-
-
-;loops with bits-<-1
-;BOZO add theory invariant!
-;BOZO ask matt about parity..
-(defthmd bits-equal-0-to-bound
-  (equal (equal 0 (bits x i j))
-         (< (bits x i j) 1)))
-
-;we had a special case where j was 0, but I think this is better (it's certainly more general):
-;better name?
-;think about whether this can be proved without opening bits (including bits-plus-bits??)
-;prove bvecp-bits from this??
-;the regular bits-bvecp should fire first...
-(defthm bits-slice-zero-gen
-  (implies (and (case-split (<= 0 k))
-                (case-split (integerp k))
-                (case-split (integerp j))
-                )
-           (equal (bvecp (bits x i j) k)
-                  (equal 0 (bits x i (+ k j)))))
-  :otf-flg t
-  :hints (("Goal" :use (:instance bits-plus-bits (n i) (m j) (p (+ k j)))
-           :in-theory (e/d (bits-equal-0-to-bound bvecp expt-strong-monotone-linear) (bits-<-1)))))
-
-(encapsulate
- ()
-
- (local (defthm cat-bvecp-rewrite-case-1-a
-          (implies (and (<= n k) ;this case
-                        (< k (+ m n))
-                        (<= 0 n)
-                        (integerp k)
-                        (integerp n)
-                        )
-                   (implies (bvecp (cat x m y n) k)
-                            (bvecp (bits x (1- m) 0) (+ k (* -1 n))) ;the BITS call around x is weird but necessary
-                            ))
-          :rule-classes nil
-          :otf-flg t
-          :hints (("Goal" :in-theory (e/d (cat bvecp expt-split) ( expt-inverse  bits-slice-zero-gen))))))
-
- (local (defthm cat-bvecp-rewrite-case-1-a-better
-          (implies (and (<= n k) ;this case
-                        (< k (+ m n))
-                        (<= 0 n)
-                        (integerp k)
-                        (integerp n)
-                        )
-                   (implies (bvecp (cat x m y n) k)
-                            (equal 0 (bits x (1- m) (+ k (* -1 n))))
-                            ))
-          :rule-classes nil
-          :otf-flg t
-          :hints (("Goal" :use  cat-bvecp-rewrite-case-1-a ))))
-
-;move!
-;this can help, especially when we aren't multiplying through by inverted factors
- (defthm bits-upper-bound-new
-   (< (* (/ (expt 2 i)) (bits x (1- i) 0)) 1)
-   :hints (("Goal" :in-theory (disable expt-inverse)))
-   :rule-classes (:rewrite :linear)
-   )
-
-;make a lemma about bvecp of (+ (BITS Y (+ -1 N) 0) (* (EXPT 2 N) (BITS X (+ -1 M) 0))) ?
- (local (defthm cat-bvecp-rewrite-case-1-b
-          (implies (and (<= n k) ;this case
-                        (< k (+ m n))
-                        (integerp k)
-                        )
-                   (implies (bvecp (bits x (1- m) 0) (- k n))
-                            (bvecp (cat x m y n) k))) ;the BITS call around x is weird but necessary?
-          :rule-classes nil
-          :hints (("Goal" :in-theory (e/d (cat bvecp expt-split
-                                               EXPT-minus
-                                               ) 
-                                          ( expt-inverse
-;these must be disabled, or  bits-upper-bound-new fails to do its job
-                                               LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE
-                                               LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE
-                                               ))))))
-
-
-
- (local (defthm cat-bvecp-rewrite-case-1-b-better
-          (implies (and (<= n k) ;this case
-                        (< k (+ m n))
-                        (integerp k)
-                        )
-                   (implies (equal 0 (bits x (1- m) (+ k (* -1 n))))
-                            (bvecp (cat x m y n) k))) ;the BITS call around x is weird but necessary?
-          :rule-classes nil
-          :hints (("Goal":use  cat-bvecp-rewrite-case-1-b))))
-
-
- (local (defthm cat-bvecp-rewrite-case-1
-          (implies (and (<= n k) ;this case
-                        (< k (+ m n))
-                        (case-split (<= 0 n))
-                        (case-split (integerp k))
-                        (case-split (integerp n))
-                        )
-                   (equal (bvecp (cat x m y n) k)
-                          (equal 0 (bits x (1- m) (+ k (* -1 n)))))) ;the BITS call around x is weird but necessary?
-          :hints (("Goal" :use ( cat-bvecp-rewrite-case-1-b-better  cat-bvecp-rewrite-case-1-a-better)))
-          ))
-
-
-
-
-
- 
- (local (defthm cat-bvecp-rewrite-case-2-a
-          (implies (and (< k n) ;this case
-                        (<= 0 k)
-                        (natp m) (natp n) (natp k)
-                        (integerp n)
-                        (integerp k)
-                        )
-                   (implies (bvecp (cat x m y n) k)
-                            (and (equal (bits x (1- m) 0) 0)
-                                 (bvecp (bits y (1- n) 0) k))))
-          :rule-classes nil
-          :otf-flg t
-          :hints (("Goal"
-                   :use (
-                         )
-                   :in-theory (e/d (cat bvecp bits-equal-0-to-bound expt-strong-monotone-linear) (bits-<-1
-                                                                                                  BITS-SLICE-ZERO-GEN
-                                                                                                  ))))))
-
-
- (local (defthm cat-bvecp-rewrite-case-2-a-better
-          (implies (and (< k n) ;this case
-                        (<= 0 k)
-                        (<= 0 m)
-                        (integerp m)
-                        (integerp n)
-                        (integerp k)
-                        )
-                   (implies (bvecp (cat x m y n) k)
-                            (and (equal 0 (bits x (1- m) 0))
-                                 (equal 0 (bits y (1- n) k)))))
-          :rule-classes nil
-          :otf-flg t
-          :hints (("Goal"
-                   :use (cat-bvecp-rewrite-case-2-a)))))
-
- (local (defthm cat-bvecp-rewrite-case-2-b
-          (implies (and (< k n) ;this case
-                        (<= 0 k)
-                        (integerp n)
-                        (integerp k)
-                        )
-                   (implies (and (equal (bits x (1- m) 0) 0)
-                                 (bvecp (bits y (1- n) 0) k))
-                            (bvecp (cat x m y n) k)))
-          :rule-classes nil
-          :otf-flg t
-          :hints (("Goal"
-                   :use (
-                         )
-                   :in-theory (e/d (cat
-                                    bits-equal-0-to-bound
-                                    expt-strong-monotone-linear
-                                    bvecp expt-split)
-                                   (;CANCEL-IN-PRODS-<-1-OF-2-WITH-1-OF-1
-                                    ;CANCEL-TIMES-<-ERIC-1-BETTER-ALT
-                                    bits-<-1
-                                    
-                                    expt-inverse
-                                    BITS-SLICE-ZERO-GEN))))))
-
- (local (defthm cat-bvecp-rewrite-case-2-b-better
-          (implies (and (< k n) ;this case
-                        (<= 0 k)
-                        (integerp n)
-                        (integerp k)
-                        )
-                   (implies (and (equal (bits x (1- m) 0) 0)
-                                 (equal 0 (bits y (1- n) k)))
-                            (bvecp (cat x m y n) k)))
-          :rule-classes nil
-          :otf-flg t
-          :hints (("Goal"
-                   :use (cat-bvecp-rewrite-case-2-b)))))
-
- (local (defthm cat-bvecp-rewrite-case-2
-          (implies (and (< k n) ;this case
-                        (<= 0 k)
-                        (<= 0 m)
-                        (integerp m)
-                        (integerp n)
-                        (integerp k)
-                        )
-                   (equal (bvecp (cat x m y n) k)
-                          (and (equal 0 (bits x (1- m) 0))
-                               (equal 0 (bits y (1- n) k)))))
-          :otf-flg t
-          :hints (("Goal"
-                   :use (cat-bvecp-rewrite-case-2-a-better
-                         cat-bvecp-rewrite-case-2-b-better
-                         )
-                   :in-theory (e/d () ())))))
-
- (defthmd cat-bvecp-rewrite
-   (implies (and (case-split (<= 0 k))
-                 (case-split (<= 0 n))
-                 (case-split (<= 0 m))
-                 (case-split (integerp n)) 
-                 (case-split (integerp m)) 
-                 (case-split (integerp k)) 
-                 )
-            (equal (bvecp (cat x m y n) k)
-                   (if (<= (+ m n) k)
-                       t
-                     (if (<= n k)
-                         (equal 0 (bits x (1- m) (+ k (* -1 n))))                      
-                       (and (equal 0 (bits x (1- m) 0))
-                            (equal 0 (bits y (1- n) k))))))))
-
- ) ;end the encapsulate
-
-(defthm cat-bvecp-rewrite-constants
-  (implies (and (syntaxp (and (quotep k) (quotep m) (quotep n)))
-                (case-split (<= 0 k))
-                (case-split (<= 0 n))
-                (case-split (<= 0 m))
-                (case-split (integerp n)) 
-                (case-split (integerp m)) 
-                (case-split (integerp k)) 
-                )
-           (equal (bvecp (cat x m y n) k)
-                  (if (<= (+ m n) k)
-                      t
-                    (if (<= n k)
-                        (equal 0 (bits x (1- m) (+ k (* -1 n))))                      
-                      (and (equal 0 (bits x (1- m) 0))
-                           (equal 0 (bits y (1- n) k)))))))
-  :hints (("Goal" :by cat-bvecp-rewrite)))
-
-
-#|
-Art's example:
-
-(thm (implies (and (natp i) (natp m) (natp n) (bvecp x i))
-              (bvecp (cat x m y n) (+ i n)))
-     )
-|#
-
-;k is a free variable.
-;There is no real analogue of this for y (that is, we can't change n to something smaller).
-(defthm cat-tighten-x
-  (implies (and (bvecp x k) ;k becomes bound here
-                (< k m) ;if k=m, this rule can loop
-                (case-split (<= 0 k))
-                (case-split (integerp k))
-                (case-split (integerp m))
-                )
-           (equal (cat x m y n)
-                  (cat x k y n)))
-  :hints (("Goal" :in-theory (enable cat))))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-(defthm cat-equal-y
-  (implies (and (bvecp y (+ m n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (equal (bits y (+ -1 m n) n)
-                         (bits x (1- m) 0))))
-  :hints (("Goal" :in-theory (enable cat a15)
-           :use (:instance bits-plus-bits (x y) (n  (+ -1 m n)) (m 0) (p n))))
-  )
-
-(defthm cat-equal-y-alt
-  (implies (and (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (if (bvecp y (+ m n))
-                      (equal (bits y (+ -1 m n) n)
-                             (bits x (1- m) 0))
-                    nil)))
-  :hints (("Goal" :in-theory (disable  cat-equal-y)
-           :use  cat-equal-y))
-)
-
-(defthm cat-equal-bits-of-y
-  (implies (and; (case-split (bvecp y n))
-;                (case-split (bvecp x m))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal (bits y (1- n) 0) (binary-cat x m y n))
-                  (equal (bits x (1- m) 0) 0)))
-  :hints (("goal" :in-theory (enable binary-cat)))
-   )
-
-;requires y to be a bvecp of length n
-;drop this one?
-(defthm cat-equal-y-special
-  (implies (and (case-split (bvecp y n))
-                (case-split (integerp m))
-                (case-split (<= 0 m)) ;gen!
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (equal 0 (bits x (1- m) 0))))
-  :hints (("Goal" :use cat-equal-bits-of-y)) ;drop this hint
-  )
-
-;enable?
-;make into 2 separate lemmas (can drop the bits from x or from y)
-(defthmd cat-ignores-bits
-  (equal (cat (bits x (1- m) 0)
-              m (bits y (1- n) 0)
-              n)
-         (cat x m y n))
-  :hints (("goal" :in-theory (enable cat))))
-
-(defthmd bits-cat-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits y i j)))
-  :hints (("Goal" :in-theory (enable cat))))
-
-;move!
-
-
-(defthmd bits-cat-2-1
-  (implies (and (<= n j) ;case 2
-                (< i (+ m n))  ;case 2-1
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (- i n) (- j n))))
-  :hints (("Goal" :in-theory (enable cat))))
-
-(defthmd bits-cat-2-2
-  (implies (and (<= n j)  ;case 2
-                (<= (+ m n) i)  ;case 2-1
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (+ m -1) (- j n))))
-  :hints (("Goal" :in-theory (enable cat)))
-  )
-
-;note the IF in the conclusion
-(defthmd bits-cat-2
-  (implies (and (<= n j)  ;case 2
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (if (< i (+ m n))
-                              (- i n)
-                            (1- m))
-                        (- j n))))
-  :hints (("Goal" :in-theory (enable cat)))
-  )
-
-
-;Note the IF in the conclusion
-(defthmd bits-cat-3
-  (implies (and (>= i n)
-                (< j n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                (case-split (natp j))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (cat (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (1- m))
-                              0)
-                        (+ 1 (- i n))
-                        (bits y (1- n) j)
-                        (- n j))))
-  :hints (("Goal" :use (:instance bits-plus-bits (x (cat x m y n)) (p n) (n i) (m j))
-           :in-theory (enable cat   bits-plus-mult-1))))
-
-;includes both bits-cat-1, bits-cat-2, and bits-cat-3
-;we expect the indices to be constants, so this won't cause case-splits
-;gen
-(defthm bits-cat
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                (case-split (natp j)))
-           (equal (bits (cat x m y n) i j)
-                  (if (< i n)
-                      (bits y i j)
-                    (if (>= j n)
-                        (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (1- m)) 
-                              (- j n))
-                      (cat (bits x (if (< i (+ m n))
-                                        (- i n)
-                                      (1- m)) 0)
-                            (+ 1 (- i n))
-                            (bits y (1- n) j)
-                            (- n j))))))
-  :hints (("Goal" :in-theory (enable bits-cat-1
-                                     bits-cat-2
-                                     bits-cat-3))))
-
-;The following trivial corollary of bits-cat is worth keeping enabled.
-
-(defthm bits-cat-constants
-  (implies (and (syntaxp (quotep n))
-                (syntaxp (quotep m))
-                (syntaxp (quotep i))
-                (syntaxp (quotep j))
-                (natp n)
-                (natp m)
-                (natp i)
-                (natp j))
-           (equal (bits (cat x m y n) i j)
-                  (if (< i n)
-                      (bits y i j)
-                    (if (>= j n)
-                        (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (1- m)) 
-                              (- j n))
-                      (cat (bits x (if (< i (+ m n))
-                                       (- i n)
-                                     (1- m)) 0)
-                           (+ 1 (- i n))
-                           (bits y (1- n) j)
-                           (- n j)))))))
-
-;bitn-cat should be all we need for simplifying (bitn (cat...))
-(defthmd bitn-cat-1
-  (implies (and (< i n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                )
-           (equal (bitn (cat x m y n) i)
-                  (bitn y i)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn bits-cat-1)
-                              '()))))
-
-;bitn-cat should be all we need for simplifying (bitn (cat...))
-(defthmd bitn-cat-2
-  (implies (and (>= i n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (integerp i))
-                )
-           (equal (bitn (cat x m y n) i)
-                  (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn)
-                              '()))))
-
-;includes both bitn-cat-1 and bitn-cat-2
-(defthm bitn-cat
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i)))
-           (equal (bitn (cat x m y n) i)
-                  (if (< i n)
-                      (bitn y i)
-                    (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0))))
-  :hints (("Goal" :in-theory (enable bitn-cat-1
-                                     bitn-cat-2))))
-
-;The following trivial corollary of bitn-cat is worth keeping enabled.
-
-(defthm bitn-cat-constants
-  (implies (and (syntaxp (quotep n))
-                (syntaxp (quotep m))
-                (syntaxp (quotep i))
-                (natp n)
-                (natp m)
-                (natp i))
-           (equal (bitn (cat x m y n) i)
-                  (if (< i n)
-                      (bitn y i)
-                    (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0)))))
-
-(defthm cat-bits-bits
-  (implies (and (equal j (1+ k))
-                (equal n (+ 1 (- l) k))
-                (case-split (<= (+ 1 (- j) i) m))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (integerp i))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                (case-split (integerp m))
-                )
-           (equal (cat (bits x i j) m (bits x k l) n)
-                  (bits x i l)))
-  :hints (("Goal" :in-theory (enable cat)
-           :use ((:instance bits-plus-bits (n i) (p j) (m l))))))
-
-(defthm cat-bitn-bits
-    (implies (and (equal j (+ 1 k))
-		  (equal n (+ 1 (- l) k))
-                  (case-split (<= 1 m))
-		  (case-split (<= l k))
-		  (case-split (integerp j))
-                  (case-split (integerp k))
-                  (case-split (integerp l))
-                  (case-split (integerp m))
-		  )
-	     (equal (cat (bitn x j) m (bits x k l) n)
-		    (bits x j l)))
-    :hints (("Goal" :in-theory (enable bitn))))
-
-(defthm cat-bits-bitn
-  (implies (and (equal j (+ 1 k))
-                (case-split (<= (+ 1 (- j) i) m))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp m))
-                )
-           (equal (cat (bits x i j) m (bitn x k) 1)
-                  (bits x i k)))
-  :hints (("Goal" :in-theory (enable bitn))))
-
-(defthm cat-bitn-bitn
-  (implies (and (equal i (+ 1 j))
-                (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (cat (bitn x i) 1 (bitn x j) 1)
-                  (bits x i j)))
-  :hints (("Goal" :in-theory (enable bitn))))
-
-
-
-
-;may not want this enabled (but probably do want CAT-EQUAL-CONSTANT enabled)
-;the BITS calls around X and Y in the conclusion allow us to drop the hyps that X and Y are bvecps.
-(defthmd cat-split-equality
-  (implies (and (case-split (bvecp k (+ m n))) ;if not, K can't be equal to the CAT expression
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (equal (equal k (cat x m y n))
-                  (and (equal (bits y (1- n) 0) (bits k (1- n) 0))
-                       (equal (bits x (1- m) 0) (bits k (+ -1 m n) n)))))
-  :hints (("Goal" :in-theory (enable cat-ignores-bits)
-           :use ((:instance cat-bits-bits (x  (cat x m y n)) (i (+ -1 m n)) (j n) (k (+ -1 n)) (l 0))))))
-
-
-
-;generalize this by dropping the bvecp-hyps and wrapping bits around x and y in the conclusion?
-;follows trivially from   cat-split-equality
-;prove a version of this without the bvecp hyps?
-(defthm cat-equal-constant
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep m)
-                              (quotep n)))
-                (case-split (bvecp y n))
-                (case-split (bvecp x m))
-                (case-split (< k (expt 2 (+ m n)))) ;drop!
-                (case-split (integerp k))
-                (case-split (<= 0 k))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (equal (equal k (cat x m y n))
-                  (and (equal y (bits k (1- n) 0))
-                       (equal x (bits k (+ -1 m n) n)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable cat-split-equality))))
-
-;lacks the bvecp hyps.  do we want this or cat-equal-rewrite?
-(defthm cat-equal-rewrite-alt
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat x1 m y1 n)
-                         (cat x2 m y2 n))
-                  (and (equal (bits x1 (1- m) 0) (bits x2 (1- m) 0))
-                       (equal (bits y1 (1- n) 0) (bits y2 (1- n) 0)))))
-  :hints (("Goal" :in-theory (enable cat-split-equality))))
-
-;move hyps to conclusion?
-(defthm cat-equal-rewrite
-  (implies (and (case-split (bvecp x1 m))
-                (case-split (bvecp y1 n))
-                (case-split (bvecp x2 m))
-                (case-split (bvecp y2 n))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )
-           (equal (equal (cat x1 m y1 n)
-                         (cat x2 m y2 n))
-                  (and (equal x1 x2)
-                       (equal y1 y2))))
-  :hints (("Goal" :in-theory (enable cat-split-equality))))
-
-(defthm cat-bits-bits-bits
-  (implies (and (<= k i)
-                (<= l k)
-                (<= j l)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp l)
-                )
-           (equal (cat (bits x i (+ 1 k))
-                       (+ 2 i (- k))
-                       (cat (bits x k l)
-                            (+ 1 k (- l))
-                            (bits x (1- l) j)
-                            (+ l (- j)))
-                       (+ 1 (- j) k))
-                  (bits x i j)))
-  :rule-classes nil)
-
-#|
-bits-dont-match can prove things like this:
-(thm (IMPLIES (EQUAL 7 (BITS x 8 6))
-              (NOT (EQUAL 3 (BITS x 15 6)))))
-|#
-
-(defthm bits-dont-match 
-  (implies (and (syntaxp (and (quotep i)
-                              (quotep j)
-                              (quotep k)))
-                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
-                (syntaxp (and (quotep i2)
-                              (quotep j2)
-                              (quotep k2)))
-                (<= j2 j) (<= j i) (<= i i2)
-                (not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
-                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
-                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
-                )
-           (equal (equal k (bits x i j))
-                  nil))
-  :otf-flg t
-  :hints (("Goal" :in-theory ( set-difference-theories
-                               (enable)
-                              '( cat-bits-bits))
-           :use (:instance cat-bits-bits-bits 
-                           (i i2)
-                           (j j2)
-                           (k (+ i (- j2)))
-                           (l (+ j (- j2)))))))
-
-(defthm bits-match
-  (implies (and (syntaxp (and (quotep i)
-                              (quotep j)
-                              (quotep k)))
-                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
-                (syntaxp (and (quotep i2)
-                              (quotep j2)
-                              (quotep k2)))
-                (<= j2 j) (<= j i) (<= i i2)
-                (equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
-                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
-                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
-                )
-           (equal (equal k (bits x i j))
-                  t))
-  :otf-flg t
-  :hints (("Goal" :in-theory ( set-difference-theories
-                               (enable)
-                              '( cat-bits-bits))
-           :use (:instance cat-bits-bits-bits 
-                           (i i2)
-                           (j j2)
-                           (k (+ i (- j2)))
-                           (l (+ j (- j2)))))))
-
-
-;make into a rewrite rule
-(defthm cat-with-slice-of-x-equal-x
-  (implies (and (bvecp x (+ m n))
-                (case-split (bvecp y n))
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (equal x (cat (bits x (+ -1 m n) n) m y n))
-                  (equal (bits x (1- n) 0) y))
-           )
-  :hints (("Goal" :in-theory (disable CAT-BITS-BITS
-                                      BITS-SPLIT-AROUND-ZERO)
-           :use (:instance cat-bits-bits (i (+ -1 m n)) (l 0) (j n) (k (+ -1 n))))))
-
-;cat-with-slice-of-x-equal-x won't match, so we use kk here
-;add a syntaxp hyp?
-(defthm cat-with-slice-of-x-equal-x-rewrite
-  (implies (and (equal kk (+ -1 m n))
-                (bvecp x (+ m n))
-                (case-split (bvecp y n))
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (equal x (cat (bits x kk n) m y n))
-                  (equal (bits x (1- n) 0) y))
-           )
-  :hints (("Goal" :in-theory (disable CAT-BITS-BITS
-                                      BITS-SPLIT-AROUND-ZERO)
-           :use (:instance cat-bits-bits (i (+ -1 m n)) (l 0) (j n) (k (+ -1 n))))))
-
-;If X and Y have identical bits in the range [i..j], then they also match on any subrange [k..l] of [i..j]
-(defthmd bits-equal-implies-subranges-equal-helper
-  (implies (and (equal (bits x i j) (bits y i j))
-                (<= j l)
-                (<= k i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (equal (bits x k l) (bits y k l))
-                  t))
-  :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :in-theory (disable cat-bits-bits cat-equal-rewrite cat-equal-rewrite-alt)
-           :use ((:instance cat-equal-rewrite
-                            (x1 (BITS X K L))
-                            (y1 (BITS X (+ -1 L) J))
-                            (x2 (BITS Y K L))
-                            (y2 (BITS Y (+ -1 L) J))
-                            (m (+ 1 k (* -1 l)))
-                            (n (+ L (* -1 J))))
-                 (:instance cat-equal-rewrite
-                            (x1 (BITS X I (+ 1 K)))
-                            (y1 (CAT (BITS X K L)
-                                     (+ 1 k (* -1 l))
-                                     (BITS X (+ -1 L) J)
-                                     (+ L (* -1 J))))
-                            (x2 (BITS Y I (+ 1 K)))
-                            (y2 (CAT (BITS Y K L)
-                                      (+ 1 k (* -1 l))
-                                     (BITS Y (+ -1 L) J)
-                                     (+ L (* -1 J))))
-                            (m (+ 2 i (* -1 k)))
-                            (n (+ 1 K (* -1 J))))
-                 (:instance cat-bits-bits-bits (x x))
-                 (:instance cat-bits-bits-bits (x y)))
-           )))
-
-(defthm bits-equal-implies-subranges-equal
-  (implies (and (equal (bits x i j) (bits y i j))
-                (<= j l)
-                (<= k i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (equal (bits x k l) (bits y k l))
-                  t))
-  :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :use ( bits-equal-implies-subranges-equal-helper)
-           )))
-
-
-#|
-
-(thm
- (implies (and (integerp m) (integerp n) (<= 0 m) (<= 0 n) (bvecp x m)
-                (bvecp y n))
-          (equal (EQUAL (BINARY-CAT X M Y N) X)
-                 (or (equal y 0) (equal n 0))))
- :hints (("Goal" :in-theory (enable binary-cat bvecp))))
-
-;keep disabled?
-(defthm cat-when-bits-of-x-are-0
-  (implies (and (EQUAL (BITS X (1- M) 0) 0)
-                (integerp m)
-                (<= 0 m))
-           (equal (cat x m y n)
-                  (bits y (+ -1 n) 0))))
-|# ; |
-
-(defthmd cat-bits-1
-    (equal (cat (bits x (1- m) 0) m y n)
-	   (cat x m y n)))
-
-(defthmd cat-bits-2
-    (equal (cat x m (bits y (1- n) 0) n)
-	   (cat x m y n)))
diff -Nru acl2-6.2/books/rtl/rel5/support/cat.lisp acl2-6.3/books/rtl/rel5/support/cat.lisp
--- acl2-6.2/books/rtl/rel5/support/cat.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/cat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,781 +0,0 @@
-(in-package "ACL2")
-
-;; Necessary defuns
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(include-book "cat-def")
-
-; "Definition" used in the library for the purpose of documentation.
-(defthm cat-def
-  (implies (and (natp m) (natp n))
-           (equal (cat x m y n)
-                  (+ (* (expt 2 n) (bits x (1- m) 0))
-                     (bits y (1- n) 0))))
-  :hints (("Goal" :in-theory (enable cat)))
-  :rule-classes nil)
-
-(local (include-book "cat-proofs"))
-
-#|
-Concatenate the M-bit value X onto the N-bit value Y.  X will occupy the high bits of the result.
-
-(cat x m y n) is well-defined only when the following predicate is true:
-
-(and (natp m)
-     (bvecp x m)
-     (natp n)
-     (bvecp y n))
-
-|#
-
-;; New stuff
-
-(defthm cat-nonnegative-integer-type
-  (and (integerp (cat x m y n))
-       (<= 0 (cat x m y n)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than cat-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-cat)))
-
-;just a rewrite rule
-(defthm cat-natp
-  (natp (cat x m y n)))
-
-;bozo disable? drop bvecp hyp and wrap bits around conclusion??
-(defthm cat-0
-  (implies (and (case-split (bvecp y n))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )		  
-           (equal (cat 0 m y n) y)))
-
-;BOZO just use this one??
-(defthm cat-0-alt
-  (implies (and ;(case-split (bvecp y n))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )		  
-           (equal (cat 0 m y n) (bits y (1- n) 0))))
-
-;We can rely on bits-tail to complete the simplification down to x if desired.
-(defthm cat-with-n-0
-  (equal (binary-cat x m y 0)
-         (bits x (1- m) 0)))
-
-;bozo disable?
-(defthm cat-with-n-0-alt
-  (implies (case-split (bvecp x m))
-           (equal (cat x m y 0)
-                  x)))
-
-;We can rely on bits-tail to complete the simplification down to y if desired.
-(defthm cat-with-m-0
-  (equal (binary-cat x 0 y n)
-         (bits y (1- n) 0)))
-
-;bozo disable?
-(defthm cat-with-m-0-alt
-  (implies (case-split (bvecp y n))
-           (equal (cat x 0 y n)
-                  y)))
-
-;change this behavior?? no, it makes for a nice setbits bvecp lemma
-(defthm cat-with-n-not-a-natural
-  (implies (or (not (integerp n))
-               (< n 0))
-           (equal (cat x m y n)
-                  0)))
-
-(defthm cat-with-m-not-a-natural
-  (implies (or (not (integerp m))
-               (< m 0))
-           (equal (cat x m y n)
-                  0)))
-
-(defthm cat-bvecp-simple
-  (bvecp (cat x m y n) (+ m n)))
-
-(defthm cat-bvecp
-  (implies (and (<= (+ m n) k)
-                (case-split (integerp k)))
-           (bvecp (cat x m y n) k)))
-
-(defthm cat-associative
-  (implies (and (case-split (<= (+ m n) p)) ;gen?
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 q))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                (case-split (integerp q))
-                )
-           (equal (cat (cat x m y n) p z q)
-                  (cat x m (cat y n z q) (+ n q)))))
-
-;prove from something more general (cat-equal-split??)
-;BOZO move hyps to conclusion?
-(defthm cat-equal-0
-  (implies (and (case-split (bvecp x m))
-                (case-split (bvecp y n))
-                (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat x m y n) 0)
-                  (and (equal x 0)
-                       (equal y 0)))))
-
-(defthm cat-combine-constants
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep m)
-                              (quotep y)
-                              (quotep n)))
-                (equal (+ n p) r)
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 p))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                )
-           (equal (cat x m (cat y n z p) r)
-                  (cat (cat x m y n) (+ m n) z p))))
-
-;allows r to be > n+p
-;perhaps we only want this one, not cat-combine-constants ??
-(defthm cat-combine-constants-gen
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep m)
-                              (quotep y)
-                              (quotep r)
-                              (quotep p)))
-                (case-split (<= (+ n p) r)) ;other case?
-                (case-split (bvecp y n)) ;BOZO instead put bits in the conclusion?
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 p))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                (case-split (integerp r))
-                )
-           (equal (cat x m (cat y n z p) r)
-                  (cat (cat x m y (+ r (- p))) (+ m r (- p)) z p))))
-
-(defthm cat-constant-equal-constant-hack
-  (implies (and (syntaxp (and (quotep k1) (quotep k2)))
-                (case-split (bvecp x n))
-                (case-split (bvecp k1 m))
-                (case-split (rationalp k2))
-                (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat k1 m x n) k2)
-                  (equal x (- k2 (* (expt 2 n) k1))))))
-
-(defthm cat-upper-bound
-  (< (cat x m y n)
-     (expt 2 (+ m n)))
-  :rule-classes (:rewrite :linear))
-
-;perhaps the :linear rule cat-upper-bound is enough, but this may help stupid hyps be rewritten away
-(defthm cat-compare-to-constant-1
-  (implies (and (syntaxp (quotep k))
-                (<= (expt 2 (+ m n)) k))
-           (< (cat x m y n) k)))
-
-;provides a tighter bound
-(defthm cat-upper-bound-tight
-  (implies (and (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (<= (cat x m y n)
-               (1- (expt 2 (+ n m))))))
-
-
-(defthm cat-compare-to-constant-2
-  (implies (and (syntaxp (quotep k))
-                (<= (1- (expt 2 (+ m n))) k)
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (not (< k (cat x m y n)))))
-
-;BOZO consider adding?
-;problem if we case-split something that turns out to be false?
-(defthm bits-with-i-not-an-integer-2
-  (implies (case-split (not (integerp i)))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-j-not-an-integer-2
-  (implies (case-split (not (integerp j)))
-           (equal (bits x i j)
-                  0)))
-
-;also case-split that i>=j in any call to bits?
-
-
-;loops with bits-<-1
-;BOZO add theory invariant!
-;BOZO ask matt about parity..
-(defthmd bits-equal-0-to-bound
-  (equal (equal 0 (bits x i j))
-         (< (bits x i j) 1)))
-
-;we had a special case where j was 0, but I think this is better (it's certainly more general):
-;better name?
-;think about whether this can be proved without opening bits (including bits-plus-bits??)
-;prove bvecp-bits from this??
-;the regular bits-bvecp should fire first...
-(defthm bits-slice-zero-gen
-  (implies (and (case-split (<= 0 k))
-                (case-split (integerp k))
-                (case-split (integerp j))
-                )
-           (equal (bvecp (bits x i j) k)
-                  (equal 0 (bits x i (+ k j))))))
-
-;move!
-;this can help, especially when we aren't multiplying through by inverted factors
-(defthm bits-upper-bound-new
-  (< (* (/ (expt 2 i)) (bits x (1- i) 0)) 1)
-  :rule-classes (:rewrite :linear)
-   )
-
- (defthmd cat-bvecp-rewrite
-   (implies (and (case-split (<= 0 k))
-                 (case-split (<= 0 n))
-                 (case-split (<= 0 m))
-                 (case-split (integerp n)) 
-                 (case-split (integerp m)) 
-                 (case-split (integerp k)) 
-                 )
-            (equal (bvecp (cat x m y n) k)
-                   (if (<= (+ m n) k)
-                       t
-                     (if (<= n k)
-                         (equal 0 (bits x (1- m) (+ k (* -1 n))))                      
-                       (and (equal 0 (bits x (1- m) 0))
-                            (equal 0 (bits y (1- n) k))))))))
-
-(defthm cat-bvecp-rewrite-constants
-  (implies (and (syntaxp (and (quotep k) (quotep m) (quotep n)))
-                (case-split (<= 0 k))
-                (case-split (<= 0 n))
-                (case-split (<= 0 m))
-                (case-split (integerp n)) 
-                (case-split (integerp m)) 
-                (case-split (integerp k)) 
-                )
-           (equal (bvecp (cat x m y n) k)
-                  (if (<= (+ m n) k)
-                      t
-                    (if (<= n k)
-                        (equal 0 (bits x (1- m) (+ k (* -1 n))))                      
-                      (and (equal 0 (bits x (1- m) 0))
-                           (equal 0 (bits y (1- n) k))))))))
-
-;k is a free variable.
-;There is no real analogue of this for y (that is, we can't change n to something smaller).
-(defthm cat-tighten-x
-  (implies (and (bvecp x k) ;k becomes bound here
-                (< k m) ;if k=m, this rule can loop
-                (case-split (<= 0 k))
-                (case-split (integerp k))
-                (case-split (integerp m))
-                )
-           (equal (cat x m y n)
-                  (cat x k y n))))
-
-(defthm cat-equal-y
-  (implies (and (bvecp y (+ m n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (equal (bits y (+ -1 m n) n)
-                         (bits x (1- m) 0)))))
-
-(defthm cat-equal-y-alt
-  (implies (and (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (if (bvecp y (+ m n))
-                      (equal (bits y (+ -1 m n) n)
-                             (bits x (1- m) 0))
-                    nil))))
-
-(defthm cat-equal-bits-of-y
-  (implies (and; (case-split (bvecp y n))
-;                (case-split (bvecp x m))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal (bits y (1- n) 0) (binary-cat x m y n))
-                  (equal (bits x (1- m) 0) 0))))
-
-;requires y to be a bvecp of length n
-;drop this one?
-(defthm cat-equal-y-special
-  (implies (and (case-split (bvecp y n))
-                (case-split (integerp m))
-                (case-split (<= 0 m)) ;gen!
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (equal 0 (bits x (1- m) 0)))))
-
-;enable?
-;make into 2 separate lemmas (can drop the bits from x or from y)
-(defthmd cat-ignores-bits
-  (equal (cat (bits x (1- m) 0)
-              m (bits y (1- n) 0)
-              n)
-         (cat x m y n)))
-
-(defthmd bits-cat-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits y i j))))
-
-(defthmd bits-cat-2-1
-  (implies (and (<= n j) ;case 2
-                (< i (+ m n))  ;case 2-1
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (- i n) (- j n)))))
-
-(defthmd bits-cat-2-2
-  (implies (and (<= n j)  ;case 2
-                (<= (+ m n) i)  ;case 2-1
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (+ m -1) (- j n)))))
-
-;note the IF in the conclusion
-(defthmd bits-cat-2
-  (implies (and (<= n j)  ;case 2
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (if (< i (+ m n))
-                              (- i n)
-                            (1- m))
-                        (- j n)))))
-
-
-;Note the IF in the conclusion
-(defthmd bits-cat-3
-  (implies (and (>= i n)
-                (< j n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                (case-split (natp j))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (cat (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (1- m))
-                              0)
-                        (+ 1 (- i n))
-                        (bits y (1- n) j)
-                        (- n j)))))
-
-;includes both bits-cat-1, bits-cat-2, and bits-cat-3
-;we expect the indices to be constants, so this won't cause case-splits
-;gen
-(defthm bits-cat
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                (case-split (natp j)))
-           (equal (bits (cat x m y n) i j)
-                  (if (< i n)
-                      (bits y i j)
-                    (if (>= j n)
-                        (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (1- m)) 
-                              (- j n))
-                      (cat (bits x (if (< i (+ m n))
-                                        (- i n)
-                                      (1- m)) 0)
-                            (+ 1 (- i n))
-                            (bits y (1- n) j)
-                            (- n j)))))))
-
-;The following trivial corollary of bits-cat is worth keeping enabled.
-
-(defthm bits-cat-constants
-  (implies (and (syntaxp (quotep n))
-                (syntaxp (quotep m))
-                (syntaxp (quotep i))
-                (syntaxp (quotep j))
-                (natp n)
-                (natp m)
-                (natp i)
-                (natp j))
-           (equal (bits (cat x m y n) i j)
-                  (if (< i n)
-                      (bits y i j)
-                    (if (>= j n)
-                        (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (1- m)) 
-                              (- j n))
-                      (cat (bits x (if (< i (+ m n))
-                                       (- i n)
-                                     (1- m)) 0)
-                           (+ 1 (- i n))
-                           (bits y (1- n) j)
-                           (- n j)))))))
-
-;bitn-cat should be all we need for simplifying (bitn (cat...))
-(defthmd bitn-cat-1
-  (implies (and (< i n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                )
-           (equal (bitn (cat x m y n) i)
-                  (bitn y i))))
-
-;bitn-cat should be all we need for simplifying (bitn (cat...))
-(defthmd bitn-cat-2
-  (implies (and (>= i n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (integerp i))
-                )
-           (equal (bitn (cat x m y n) i)
-                  (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0))))
-
-;includes both bitn-cat-1 and bitn-cat-2
-(defthm bitn-cat
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i)))
-           (equal (bitn (cat x m y n) i)
-                  (if (< i n)
-                      (bitn y i)
-                    (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0)))))
-
-;The following trivial corollary of bitn-cat is worth keeping enabled.
-
-(defthm bitn-cat-constants
-  (implies (and (syntaxp (quotep n))
-                (syntaxp (quotep m))
-                (syntaxp (quotep i))
-                (natp n)
-                (natp m)
-                (natp i))
-           (equal (bitn (cat x m y n) i)
-                  (if (< i n)
-                      (bitn y i)
-                    (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0)))))
-
-(defthm cat-bits-bits
-  (implies (and (equal j (1+ k))
-                (equal n (+ 1 (- l) k))
-                (case-split (<= (+ 1 (- j) i) m))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (integerp i))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                (case-split (integerp m))
-                )
-           (equal (cat (bits x i j) m (bits x k l) n)
-                  (bits x i l))))
-
-(defthm cat-bitn-bits
-    (implies (and (equal j (+ 1 k))
-		  (equal n (+ 1 (- l) k))
-                  (case-split (<= 1 m))
-		  (case-split (<= l k))
-		  (case-split (integerp j))
-                  (case-split (integerp k))
-                  (case-split (integerp l))
-                  (case-split (integerp m))
-		  )
-	     (equal (cat (bitn x j) m (bits x k l) n)
-		    (bits x j l))))
-
-(defthm cat-bits-bitn
-  (implies (and (equal j (+ 1 k))
-                (case-split (<= (+ 1 (- j) i) m))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp m))
-                )
-           (equal (cat (bits x i j) m (bitn x k) 1)
-                  (bits x i k))))
-
-(defthm cat-bitn-bitn
-  (implies (and (equal i (+ 1 j))
-                (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (cat (bitn x i) 1 (bitn x j) 1)
-                  (bits x i j))))
-
-
-;may not want this enabled (but probably do want CAT-EQUAL-CONSTANT enabled)
-;the BITS calls around X and Y in the conclusion allow us to drop the hyps that X and Y are bvecps.
-(defthmd cat-split-equality
-  (implies (and (case-split (bvecp k (+ m n))) ;if not, K can't be equal to the CAT expression
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (equal (equal k (cat x m y n))
-                  (and (equal (bits y (1- n) 0) (bits k (1- n) 0))
-                       (equal (bits x (1- m) 0) (bits k (+ -1 m n) n))))))
-
-
-
-;generalize this by dropping the bvecp-hyps and wrapping bits around x and y in the conclusion?
-;follows trivially from   cat-split-equality
-;prove a version of this without the bvecp hyps?
-(defthm cat-equal-constant
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep m)
-                              (quotep n)))
-                (case-split (bvecp y n))
-                (case-split (bvecp x m))
-                (case-split (< k (expt 2 (+ m n)))) ;drop!
-                (case-split (integerp k))
-                (case-split (<= 0 k))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (equal (equal k (cat x m y n))
-                  (and (equal y (bits k (1- n) 0))
-                       (equal x (bits k (+ -1 m n) n))))))
-
-;lacks the bvecp hyps.  do we want this or cat-equal-rewrite?
-(defthm cat-equal-rewrite-alt
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat x1 m y1 n)
-                         (cat x2 m y2 n))
-                  (and (equal (bits x1 (1- m) 0) (bits x2 (1- m) 0))
-                       (equal (bits y1 (1- n) 0) (bits y2 (1- n) 0))))))
-
-;move hyps to conclusion?
-(defthm cat-equal-rewrite
-  (implies (and (case-split (bvecp x1 m))
-                (case-split (bvecp y1 n))
-                (case-split (bvecp x2 m))
-                (case-split (bvecp y2 n))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )
-           (equal (equal (cat x1 m y1 n)
-                         (cat x2 m y2 n))
-                  (and (equal x1 x2)
-                       (equal y1 y2)))))
-
-(defthm cat-bits-bits-bits
-  (implies (and (<= k i)
-                (<= l k)
-                (<= j l)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp l)
-                )
-           (equal (cat (bits x i (+ 1 k))
-                       (+ 2 i (- k))
-                       (cat (bits x k l)
-                            (+ 1 k (- l))
-                            (bits x (1- l) j)
-                            (+ l (- j)))
-                       (+ 1 (- j) k))
-                  (bits x i j)))
-  :rule-classes nil)
-
-#|
-bits-dont-match can prove things like this:
-(thm (IMPLIES (EQUAL 7 (BITS x 8 6))
-              (NOT (EQUAL 3 (BITS x 15 6)))))
-|#
-
-(defthm bits-dont-match 
-  (implies (and (syntaxp (and (quotep i)
-                              (quotep j)
-                              (quotep k)))
-                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
-                (syntaxp (and (quotep i2)
-                              (quotep j2)
-                              (quotep k2)))
-                (<= j2 j) (<= j i) (<= i i2)
-                (not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
-                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
-                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
-                )
-           (equal (equal k (bits x i j))
-                  nil)))
-
-; improve somehow?
-(defthm bits-match
-  (implies (and (syntaxp (and (quotep i)
-                              (quotep j)
-                              (quotep k)))
-                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
-                (syntaxp (and (quotep i2)
-                              (quotep j2)
-                              (quotep k2)))
-                (<= j2 j) (<= j i) (<= i i2)
-                (equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
-                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
-                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
-                )
-           (equal (equal k (bits x i j))
-                  t)))
-
-
-;make into a rewrite rule
-(defthm cat-with-slice-of-x-equal-x
-  (implies (and (bvecp x (+ m n))
-                (case-split (bvecp y n))
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (equal x (cat (bits x (+ -1 m n) n) m y n))
-                  (equal (bits x (1- n) 0) y))
-           ))
-
-;cat-with-slice-of-x-equal-x won't match, so we use kk here
-;add a syntaxp hyp?
-(defthm cat-with-slice-of-x-equal-x-rewrite
-  (implies (and (equal kk (+ -1 m n))
-                (bvecp x (+ m n))
-                (case-split (bvecp y n))
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (equal x (cat (bits x kk n) m y n))
-                  (equal (bits x (1- n) 0) y))
-           ))
-
-;If X and Y have identical bits in the range [i..j], then they also match on any subrange [k..l] of [i..j]
-(defthmd bits-equal-implies-subranges-equal-helper
-  (implies (and (equal (bits x i j) (bits y i j))
-                (<= j l)
-                (<= k i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (equal (bits x k l) (bits y k l))
-                  t))
-  :rule-classes ((:rewrite :match-free :all)))
-
-(defthm bits-equal-implies-subranges-equal
-  (implies (and (equal (bits x i j) (bits y i j))
-                (<= j l)
-                (<= k i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (equal (bits x k l) (bits y k l))
-                  t))
-  :rule-classes ((:rewrite :match-free :all)))
-
-(defthmd cat-bits-1
-    (equal (cat (bits x (1- m) 0) m y n)
-	   (cat x m y n)))
-
-(defthmd cat-bits-2
-    (equal (cat x m (bits y (1- n) 0) n)
-	   (cat x m y n)))
diff -Nru acl2-6.2/books/rtl/rel5/support/clocks.lisp acl2-6.3/books/rtl/rel5/support/clocks.lisp
--- acl2-6.2/books/rtl/rel5/support/clocks.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/clocks.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,178 +0,0 @@
-; Most or all of this was originally written by Eric Smith while an intern at AMD.
-
-(in-package "ACL2")
-
-(include-book "mod4")
-(local (include-book "../arithmetic/even-odd2"))
-
-; The analysis of clocks uses some new functions.
-; 
-; First, even and odd are not the same as evenp and oddp.  For one thing, even
-; and odd are defined recursively, and I've proved a bunch of nice rules about
-; them which we probably want to use and which may not be proved about evenp and
-; oddp (and which may be nicer than what is proveable about evenp and oddp).  One
-; nice property of even and odd is that each implies integerp.  (By contrast,
-; evenp returns t for non-numbers like nil or '(a b).)  So rules which would
-; naturally have both the hyp (integerp n) and the hyp (evenp n) now can just
-; have (even n).
-; 
-; Second, I also define a function, MOD4. I didn't want to use MOD itself in the
-; clocking logic because reasoning about clocks needs to be fast and predictable.
-; (I can imagine that we'll have rules about MOD, especially when doing FP
-; proofs, which will just get in the way of our reasoning about clocks. We might
-; even open up MOD on occasion.)  So, in order to get complete control over the
-; rules which fire when we reason about clocks, I introduced MOD4, which we
-; expect never to have to open after proving a nice set of rules about it.
-; 
-; Also, theorems about MOD4 may be nicer than their analogs for MOD.  For
-; example, MOD4 is always equal to 0, 1, 2, or 3, but (mod #c(0 1) 4) = #c(0 1),
-; which isn't even rational.
-
-(defund pedge (x y)
-  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
-  (and (equal x 0)
-       (equal y 1)))
-
-(defund nedge (x y)
-  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
-  (and (equal x 1)
-       (equal y 0)))
-
-(defmacro posedge (clk)
-  `(and (not (zp n))
-        (pedge (,clk (1- n)) (,clk n))))
-
-(defmacro negedge (clk)
-  `(and (not (zp n))
-        (nedge (,clk (1- n)) (,clk n))))
-
-(defthm pedge-known-false-1
-  (not (pedge x 0))
-  :hints (("Goal" :in-theory (enable pedge))))
-
-(defthm pedge-known-false-2
-  (not (pedge 1 y))
-  :hints (("Goal" :in-theory (enable pedge))))
-
-(defthm nedge-known-false-1
-  (not (nedge x 1))
-  :hints (("Goal" :in-theory (enable nedge))))
-
-(defthm nedge-known-false-2
-  (not (nedge 0 y))
-  :hints (("Goal" :in-theory (enable nedge))))
-
-
-; The call (defperiodic NAME TYPE) creates 1) a defun which defines NAME to be
-; a periodic signal of the specified TYPE and 2) a bvecp lemma for that defun
-; (all periodics have width 1).
-
-; We intend the user to smash certain periodic inputs to his top level module
-; and replace their translations with calls to defperiodic.
-
-; Currently we support the following types of periodic signals:
-
-#|
-
-'fast-clock : 
-
- _   _   _   _   _   _   _
-| |_| |_| |_| |_| |_| |_| |_|
-
-
-'slow-clock-one-quantum-wide
-
- _       _       _       _
-| |_____| |_____| |_____| |__
-
-
-'slow-clock-one-quantum-wide-shifted :
-
-     _       _       _       _
-____| |_____| |_____| |_____| |__
-
-
-'slow-clock-two-quanta-wide :
-
- ___     ___     ___     ___     
-|   |___|   |___|   |___|   |___|
-
-
-'slow-clock-two-quanta-wide-shifted :
-
-     ___     ___     ___     
-|___|   |___|   |___|   |___|
-
-'always-1 :
-
-  ___________________________
-..
-
-
-|#
-
-; As the need arises, we can easily change defperiodic to add support for more
-; types of signal.
-
-; BTW, currently, the definitions generated by defperiodic return unknown
-; values (calls to reset) at time 0 (and whenever N is not a natp).  Perhaps
-; this is too conservative, and perhaps defining the value at time 0 would
-; allow nicer rewrite rules to be proved.
-
-(defconst *defperiodic-types*
-
-; Keep this in sync with the corresponding definition in the compiler.
-
-  '(fast-clock
-    slow-clock-one-quantum-wide
-    slow-clock-one-quantum-wide-shifted
-    slow-clock-two-quanta-wide
-    slow-clock-two-quanta-wide-shifted
-    always-1))
-
-(defmacro defperiodic (name type)
-  (declare (xargs :guard (member-eq type *defperiodic-types*)))
-  (list*
-   'encapsulate
-   nil
-   (case type
-     (fast-clock
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (even n) 1 0))))
-     (slow-clock-one-quantum-wide
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (equal 0 (mod4 n)) 1 0))))
-     (slow-clock-one-quantum-wide-shifted
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (equal 2 (mod4 n)) 1 0))))
-     (slow-clock-two-quanta-wide
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (or (equal 0 (mod4 n))
-                   (equal 1 (mod4 n)))
-               1
-             0))))
-     (slow-clock-two-quanta-wide-shifted
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           (if (or (equal 2 (mod4 n))
-                   (equal 3 (mod4 n)))
-               1
-             0))))
-     (always-1
-      `(defund ,name (n)
-         (if (zp n)
-             (reset (quote ,name) 1)
-           1)))
-     (otherwise (er hard 'defperiodic
-                    "Bad type, ~x0, for defperiodic."
-                    type)))
-   `((defbvecp ,name (n) 1 :hints (("Goal" :in-theory (enable ,name)))))))
diff -Nru acl2-6.2/books/rtl/rel5/support/decode-proofs.lisp acl2-6.3/books/rtl/rel5/support/decode-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/decode-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/decode-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,49 +0,0 @@
-(in-package "ACL2")
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(include-book "ground-zero")
-
-#|(defun decode (x n)
-  (if (< x n) (ash 1 x) 0))
-(in-theory (disable decode))
-|#
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(local (include-book "../arithmetic/fl"))
-(local (include-book "ash"))
-(local (include-book "bvecp"))
-
-(defund decode (x n)
-  (declare (xargs :guard (rationalp n)))
-  (if (and (natp x) (< x n)) 
-      (ash 1 x) 
-    0))
-
-(defthm decode-nonnegative-integer-type
-  (and (integerp (decode x n))
-       (<= 0 (decode x n)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable decode))))
-
-;this rule is no better than decode-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription decode)))
-
-(defthm decode-natp
-  (natp (decode x n)))
-
-(defthm decode-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k))
-                )
-           (bvecp (decode x n) k))
-  :hints (("Goal" :in-theory (enable decode))))
diff -Nru acl2-6.2/books/rtl/rel5/support/decode.lisp acl2-6.3/books/rtl/rel5/support/decode.lisp
--- acl2-6.2/books/rtl/rel5/support/decode.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/decode.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-(in-package "ACL2")
-
-(include-book "ground-zero")
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(local (include-book "decode-proofs"))
-
-
-(defund decode (x n)
-  (declare (xargs :guard (rationalp n)))
-  (if (and (natp x) (< x n)) 
-      (ash 1 x) 
-    0))
-
-(defthm decode-nonnegative-integer-type
-  (and (integerp (decode x n))
-       (<= 0 (decode x n)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than decode-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription decode)))
-
-(defthm decode-natp
-  (natp (decode x n)))
-
-(defthm decode-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k))
-                )
-           (bvecp (decode x n) k)))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/drnd.lisp acl2-6.3/books/rtl/rel5/support/drnd.lisp
--- acl2-6.2/books/rtl/rel5/support/drnd.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/drnd.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,2260 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "merge"))
-(include-book "ireps") ;make local?
-(local (include-book "rnd"))
-(local (include-book "bias"))
-(local (include-book "sgn"))
-(local (include-book "bits"))
-(local (include-book "trunc"))
-(local (include-book "away"))
-(local (include-book "near"))
-(local (include-book "near+"))
-(local (include-book "sticky"))
-(local (include-book "../arithmetic/top"))
-
-(local (in-theory (enable evenp))) ;yuck
-(local (in-theory (disable EXPT-2-TYPE-LINEAR))) ;yuck!
-
-;; Necessary functions:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-(defund near+ (x n)
-  (if (< (re (* (expt 2 (1- n)) (sig x)))
-	 1/2)
-      (trunc x n)
-    (away x n)))
-
-(defund sticky (x n)
-  (cond ((exactp x (1- n)) x)
-	(t (+ (trunc x (1- n))
-              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
-
-(defund inf (x n)
-  (if (>= x 0)
-      (away x n)
-    (trunc x n)))
-
-(defund minf (x n)
-  (if (>= x 0)
-      (trunc x n)
-    (away x n)))
-
-(defund rnd (x mode n)
-  (case mode
-    (away (away x n)) ;added by eric in august, 2001
-    (near+ (near+ x n))
-    (trunc (trunc x n))
-    (inf (inf x n))
-    (minf (minf x n))
-    (near (near x n))
-    (otherwise 0)))
-
-(defund IEEE-MODE-P (mode)
-  (member mode '(trunc inf minf near)))
-
-(defund rounding-mode-p (mode)
-  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
-
-(defund flip (m)
-  (case m
-    (inf 'minf)
-    (minf 'inf)
-    (t m)))
-
-; bias of a q bit exponent field is 2^(q-1)-1 
-(defund bias (q) (- (expt 2 (- q 1)) 1) )
-
-
-
-;;
-;; New stuff:
-;;
-
-(defund drnd (x mode n k)
-  (- (rnd (+ x (* (sgn x) (expt 2 (- 2 (expt 2 (1- k)))))) mode n)
-     (* (sgn x) (expt 2 (- 2 (expt 2 (1- k)))))))
-
-(defthmd drnd-minus
-  (equal (drnd (* -1 x) mode n k)
-         (* -1 (drnd x (flip mode) n k)))
-  :hints (("Goal" :in-theory
-           (enable drnd)
-           :use ((:instance rnd-minus
-                            (x (+ x (* (sgn x) (expt 2 (- 2 (expt 2 (1- k))))))))))))
-
-(defthm drnd-0
-  (equal (drnd 0 mode n k) 
-         0)
-  :hints (("Goal" :in-theory (enable drnd))))
-
-
-(local (defthm drnd-sticky-pos
-    (implies (and (rounding-mode-p mode)
-		  (natp n)
-		  (> n 0)
-		  (natp m)
-		  (> m 1)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (> x 0)
-		  (<= (expo x) (- 1 (expt 2 (1- k))))
-		  (<= (expo x) (- m (+ n (expt 2 (1- k))))))
-	     (equal (drnd (sticky x m) mode n k)
-		    (drnd x mode n k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sgn drnd rnd-sticky)
-		  :use (expo-upper-bound
-			expo-lower-bound
-			(:instance sticky-pos (n m))
-			(:instance sticky-plus
-				   (x (expt 2 (- 2 (expt 2 (1- k)))))
-				   (y x)
-				   (k m)
-				   (k1 (- (+ m 2) (+ (expt 2 (1- k)) (expo x))))
-				   (k2 (- (+ m 2) (+ (expt 2 (1- k)) (expo x)))))
-			(:instance exactp-2**n 
-				   (n (- 2 (expt 2 (1- k))))
-				   (m (- (+ m 1) (+ (expt 2 (1- k)) (expo x))))))))))
-
-(defthm drnd-sticky
-  (implies (and (rounding-mode-p mode)
-                (natp n)
-                (> n 0)
-                (natp m)
-                (> m 1)
-                (natp k)
-                (> k 0)
-                (rationalp x)
-                (<= (expo x) (- 1 (expt 2 (1- k))))
-                (<= (expo x) (- m (+ n (expt 2 (1- k))))))
-           (equal (drnd (sticky x m) mode n k)
-                  (drnd x mode n k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable drnd-minus)
-           :use (drnd-sticky-pos
-                 (:instance drnd-sticky-pos (mode (flip mode)) (x (- x)))
-                 ))))
-
-(local (defthm drnd-bnd-1
-    (implies (and (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (>= x (expt 2 (- 2 (expt 2 (1- k)))))
-		  (< x (+ (expt 2 (- 2 (expt 2 (1- k)))) 
-			  (expt 2 (- 3 (+ n (expt 2 (1- k))))))))
-	     (equal (trunc x n)
-		    (expt 2 (- 2 (expt 2 (1- k))))))
-  :hints (("Goal" :in-theory (disable trunc-exactp-b trunc-exactp-c)
-		  :use (trunc-exactp-b
-			trunc-upper-pos
-			(:instance expt-split (r 2) (j (- 1 n)) (i (- 2 (expt 2 (1- k)))))
-			(:instance trunc-exactp-c (a (expt 2 (- 2 (expt 2 (1- k))))))
-			(:instance exactp-2**n (n (- 2 (expt 2 (1- k)))) (m n))
-			(:instance fp+2
-				   (y (trunc x n))
-				   (x (expt 2 (- 2 (expt 2 (1- k)))))))))))
-
-
-
-(local (defthm drnd-bnd-2
-    (implies (and (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (>= x 0)
-		  (< x (expt 2 (- 3 (+ n (expt 2 (1- k)))))))
-	     (equal (drnd x 'trunc n k)
-		    0))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sgn rnd drnd)
-           :use trunc-0))))
-
-
-
-(local (defthm drnd-bnd-3
-    (implies (and (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (> x (expt 2 (- 2 (expt 2 (1- k)))))
-		  (<= x (+ (expt 2 (- 2 (expt 2 (1- k)))) 
-			   (expt 2 (- 3 (+ n (expt 2 (1- k))))))))
-	     (equal (away x n)
-		    (+ (expt 2 (- 2 (expt 2 (1- k)))) 
-		       (expt 2 (- 3 (+ n (expt 2 (1- k))))))))
-  :hints (("Goal" :in-theory (disable away-exactp-b away-exactp-c)
-		  :use (away-exactp-b
-			away-lower-pos
-			(:instance expt-split (r 2) (j (- 1 n)) (i (- 2 (expt 2 (1- k)))))
-			(:instance away-exactp-c
-				   (a (+ (expt 2 (- 2 (expt 2 (1- k))))
-					 (expt 2 (- 3 (+ n (expt 2 (1- k))))))))
-			(:instance exactp-2**n (n (- 2 (expt 2 (1- k)))) (m n))
-			(:instance fp+1
-				   (x (expt 2 (- 2 (expt 2 (1- k))))))
-			(:instance fp+2
-				   (y (away x n))
-				   (x (expt 2 (- 2 (expt 2 (1- k)))))))))))
-
-(local (defthm drnd-bnd-4
-    (implies (and (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (> x 0)
-		  (<= x (expt 2 (- 3 (+ n (expt 2 (1- k)))))))
-	     (equal (drnd x 'inf n k)
-		    (expt 2 (- 3 (+ n (expt 2 (1- k)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sgn rnd drnd inf)))))
-
-(local (defthm drnd-bnd-5
-    (implies (and (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (> x (expt 2 (- 2 (expt 2 (1- k)))))
-		  (< x (+ (expt 2 (- 2 (expt 2 (1- k))))
-			  (expt 2 (- 3 (+ n (expt 2 (1- k)))))))
-		  (< x (+ (expt 2 (- 2 (expt 2 (1- k))))
-			  (expt 2 (- 2 (+ n (expt 2 (1- k))))))))
-	     (equal (near x n)
-		    (expt 2 (- 2 (expt 2 (1- k))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split)
-           :use (near1-a)))))
-
-(local (defthm drnd-bnd-6
-    (implies (and (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (> x (expt 2 (- 2 (expt 2 (1- k)))))
-		  (< x (+ (expt 2 (- 2 (expt 2 (1- k))))
-			  (expt 2 (- 2 (+ n (expt 2 (1- k))))))))
-	     (equal (near x n)
-		    (expt 2 (- 2 (expt 2 (1- k))))))
-  :hints (("Goal" :in-theory (disable expt-compare)
-           :use (drnd-bnd-5
-			(:instance expt-weak-monotone
-				   (n (- 2 (+ n (expt 2 (1- k)))))
-				   (m (- 3 (+ n (expt 2 (1- k)))))))))))
-
-(local (defthm drnd-bnd-7
-    (implies (and (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (> x 0)
-		  (< x (expt 2 (- 2 (+ n (expt 2 (1- k)))))))
-	     (equal (drnd x 'near n k)
-		    0))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sgn rnd drnd)))))
-
-(local (defthm drnd-bnd-8
-    (implies (and (ieee-mode-p m)
-		  (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (> x 0)
-		  (< x (expt 2 (- 2 (+ n (expt 2 (1- k)))))))
-	     (equal (drnd x m n k)
-		    (if (eql m 'inf)
-			(expt 2 (- 3 (+ n (expt 2 (1- k)))))
-		      0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (ieee-mode-p sgn rnd drnd minf inf) (expt-compare))
-		  :use (drnd-bnd-2
-			drnd-bnd-4
-			drnd-bnd-7
-			(:instance expt-weak-monotone
-				   (n (- 2 (+ n (expt 2 (1- k)))))
-				   (m (- 3 (+ n (expt 2 (1- k)))))))))))
-
-(local (defthm drnd-bnd-9
-    (implies (and (ieee-mode-p m)
-		  (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (> x 0)
-		  (< x (expt 2 (- 2 (+ n (expt 2 (1- k))))))
-		  (rationalp y)
-		  (> y 0)
-		  (< y (expt 2 (- 2 (+ n (expt 2 (1- k)))))))
-	     (equal (drnd x m n k)
-		    (drnd y m n k)))
-  :rule-classes ()
-  :hints (("Goal" :use (drnd-bnd-8
-			(:instance drnd-bnd-8 (x y)))))))
-
-(defthm drnd-tiny-equal
-    (implies (and (ieee-mode-p m)
-		  (natp n)
-		  (> n 0)
-		  (natp k)
-		  (> k 0)
-		  (rationalp x)
-		  (< (abs x) (expt 2 (- 2 (+ n (expt 2 (1- k))))))
-		  (rationalp y)
-		  (< (abs y) (expt 2 (- 2 (+ n (expt 2 (1- k))))))
-		  (equal (sgn x) (sgn y)))
-	     (equal (drnd x m n k)
-		    (drnd y m n k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sgn  DRND-minus)
-		  :use ((:instance drnd-bnd-9 (m (if (< x 0) (flip m) m)) (x (abs x)) (y (abs y)))))))
-
-
-
-;beginning of Eric's drnd lemmas.  Throughout, n is the number of significand bits
-;(counting the implicit leading zero), and k is the number of exponent bits.
-
-;it doesn't make sense for n to be 0 (no bits of significand).  Since n counts the
-;implicit 0, n=1 is also questionable.
-
-;It doesn't make sense for k to be 0 (no bits of exponent).  Having k=1 is also
-;questionable, since that would allow only 2 possible exponent values, both
-;reserved (one reserved for denormals).
-
-(defund smallest-positive-normal (k)
-  (expt 2 (- 1 (bias k))))
-
-(defund smallest-positive-denormal (n k)
-     (expt 2 (+ 2 (- (bias k)) (- n))))
-
-
-(defthm expo-spn
-  (implies (and (case-split (acl2-numberp k))
-                (case-split (< 0 k)))
-           (equal (expo (smallest-positive-normal k))
-                  (+ 1 (* -1 (bias k)))))
-  :hints (("Goal" :in-theory (enable  smallest-positive-normal))))
-
-(defthm expo-spd
-  (implies (and (case-split (acl2-numberp k))
-                (case-split (integerp n))
-                (case-split (< 0 k)))
-           (equal (expo (smallest-positive-denormal n k))
-                  (+ 2 (- (bias k)) (- n))))
-  :hints (("Goal" :in-theory (enable smallest-positive-denormal))))
-
-(defthm spn-positive-rational-type
-  (and (rationalp (smallest-positive-normal k))
-       (> (smallest-positive-normal k) 0))
-  :rule-classes (:type-prescription ))
-
-(defthm positive-spn
-  (> (smallest-positive-normal k) 0)
-  :rule-classes (:linear))
-
-(defthm nrepp-spn
-  (implies (and (integerp n)
-                (> n 0)
-                (integerp k)
-                (> k 1))
-           (nrepp (smallest-positive-normal k) n k))
-  :hints (("goal" :in-theory (enable nrepp SMALLEST-POSITIVE-NORMAL)
-           :use ((:instance exactp-2**n
-                            (n (+ 1 (* -1 (bias k))))
-                            (m n))
-                 (:instance expt-strong-monotone
-                            (n 1)
-                            (m k))))))
-
-(defthm smallest-spn
-  (implies (and (nrepp x n k) ;n is a free var
-                (integerp n)
-                (> n 0)
-                (integerp k)
-                (> k 1)
-                )
-           (>= (abs x) (smallest-positive-normal k)))
-  :rule-classes ((:rewrite :match-free :once))
-  :hints (("goal" :in-theory (enable nrepp; bias
-                                     SMALLEST-POSITIVE-NORMAL
-                                     )
-           :use (fp-abs
-                 sig-lower-bound
-                 (:instance expt-weak-monotone
-                            (n (- 1 (bias k)))
-                            (m (expo x)))))))
-
-;uses bias to avoid having to open bias in proofs below
-(defthmd drnd-def
-  (equal (drnd x mode n k)
-         (- (rnd (+ x
-                    (* (sgn x)
-                       (expt 2 (- 1 (bias k)))))
-                 mode n)
-            (* (sgn x)
-               (expt 2 (- 1 (bias k))))))
-  :hints (("goal" :in-theory (enable drnd bias))))
-
-(defthmd drnd-spn
-  (implies (and (rounding-mode-p mode)
-                (integerp n)
-                (> n 0)
-                (integerp k)
-                (> k 0))
-           (equal (drnd (smallest-positive-normal k) mode n k)
-                  (rnd (smallest-positive-normal k) 
-                       mode
-                       (+ n
-                          (- (expo (smallest-positive-normal k)))
-                          (+ 1 (* -1 (BIAS K)))))))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable drnd-def ;sgn
-                                      SMALLEST-POSITIVE-NORMAL
-;      expt-split
-;     expt-minus
-                                      )
-                              '(a15 
-                                EXPT-COMPARE-EQUAL))
-           :use ((:instance rnd-exactp-a (x (expt 2 (+ 2 (* -1 (bias k))))))
-                 (:instance rnd-exactp-a (x (expt 2 (+ 1 (* -1 (bias k))))))
-                 (:instance a15
-                            (i 2)
-                            (j1 (+ 1 (- (bias k))))
-                            (j2 1))
-                 ))))
-
-(local (defthmd drnd-rewrite-1
-         (implies (and (rationalp x)
-                       (<= 0 x)
-                       (< x (smallest-positive-normal k))
-                       (rounding-mode-p mode)
-                       (integerp n)
-                       (> n 1)
-                       (integerp k)
-                       (> k 0))
-                  (equal (drnd x mode n k)
-                         (rnd x 
-                              mode
-                              (+ n (- (expo (smallest-positive-normal k))) (expo x)))))
-         :hints (("goal" :in-theory (set-difference-theories
-                                     (enable drnd-def sgn ;rounding-mode-p ;ieee-mode-p 
-                                             expt ;expt-split ;why?
-                                             ;bias
-                                             SMALLEST-POSITIVE-NORMAL
-                                             )
-                                     '(                                       ;SMALLEST-POSITIVE-NORMAL
-                                       rounding-mode-p
-                                       expo-x+2**k))
-                  :use ((:instance plus-rnd
-                                   (y x)
-                                   (x (smallest-positive-normal k))
-                                   (k (+ n (expo x) (- (expo
-                                                        (smallest-positive-normal k))))))
-                        (:instance expo-x+2**k
-                                   (k (+ 1 (* -1 (bias k)))))
-                        (:instance expo<=
-                                   (n (* -1 (bias k)))))))
-         :otf-flg t))
-
-(local 
- (defthmd drnd-rewrite-pos
-  (implies (and (rationalp x)
-                (<= 0 x)
-                (<= x (smallest-positive-normal k))
-                (rounding-mode-p mode)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (equal (drnd x mode n k)
-                  (rnd x 
-                       mode
-                       (+ n (- (expo (smallest-positive-normal k))) (expo x)))))
-  :hints (("goal" :in-theory (disable smallest-positive-normal ROUNDING-MODE-P)
-           :use (drnd-rewrite-1 drnd-spn )))))
-
-(local
- (defthmd drnd-rewrite-neg
-   (implies (and (rationalp x)
-                 (<= (- (smallest-positive-normal k)) x)
-                 (<= x 0)
-                 (rounding-mode-p mode)
-                 (integerp n)
-                 (> n 1)
-                 (integerp k)
-                 (> k 0))
-            (equal (drnd x mode n k)
-                   (rnd x 
-                        mode
-                        (+ n (- (expo (smallest-positive-normal k))) (expo x)))))
-   :hints (("goal" :in-theory (enable drnd-rewrite-pos )
-            :use ((:instance drnd-minus (mode (flip mode)))
-                  (:instance 
-                   rnd-minus (x (- x)) (mode mode)
-                   (n (+ -1 n (expo x) (bias k)))))))))
-
-;why enable so much?
-(defthmd drnd-rewrite
-  (implies (and (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (rounding-mode-p mode)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (equal (drnd x mode n k)
-                  (rnd x 
-                       mode
-                       (+ n 
-                          (- (expo (smallest-positive-normal k))) 
-                          (expo x)))))
-  :hints (("Goal" :in-theory (enable drnd-rewrite-pos drnd-rewrite-neg))))
-
-(defthm drepp-range
-  (implies (and (drepp x n k)
-                (integerp n)
-                (>= n 0)
-                (integerp k)
-                (> k 0)
-                )
-           (<= (abs x)
-               (smallest-positive-normal k)))
-  :hints (("Goal" :in-theory (enable bias drepp SMALLEST-POSITIVE-NORMAL)
-           :use ((:instance expo>= (x (- x))
-                        (n (+ 1 (- (bias k)))))
-                 (:instance expo>= (n (+ 1 (- (bias k)))))))))
-
-(defthmd drepp-def
-  (equal (drepp x p q)
-         (and (rationalp x)
-              (not (= x 0))
-              (<= (- 2 p) (+ (expo x) (bias q)))
-              (<= (+ (expo x) (bias q)) 0)
-              (exactp x (+ -1 p (bias q) (expo x)))))
-  :hints (("Goal" :in-theory (enable drepp bias))))
-
-(defthm drnd-of-drepp-is-NOP
-  (implies (and (drepp x n k)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (equal (drnd x mode n k)
-                  x))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable drepp-def
-                                      )
-                              '( SMALLEST-POSITIVE-NORMAL))
-           :use (drnd-rewrite
-                 drepp-range
-                 (:instance rnd-exactp-a
-                            (n (+ n 
-                                  (- (expo (smallest-positive-normal k))) 
-                                  (expo x))))))))
-;move up?
-(defthm spn-1-exact
-  (implies (and (case-split (integerp k))
-                (case-split (> k 0)))
-           (exactp (smallest-positive-normal k) 1))
-  :hints (("Goal" :in-theory (enable smallest-positive-normal))))
-
-(defthm spd-1-exact
-  (implies (and (case-split (integerp k))
-                (case-split (integerp n))
-                (case-split (> k 0)))
-           (exactp (smallest-positive-denormal n k) 1))
-  :hints (("Goal" :in-theory (enable smallest-positive-denormal)))
-  )
-
-;(in-theory (enable drnd-spn))
-
-(defthm drnd-spn-is-spn
-  (implies (and (rounding-mode-p mode)
-                (integerp n)
-                (>= n 1)
-                (integerp k)
-                (> k 0))
-           (= (drnd (smallest-positive-normal k) mode n k)
-              (smallest-positive-normal k))
-           )
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable IEEE-MODE-P)
-                              '( spn-1-exact
-                                 SMALLEST-POSITIVE-NORMAL
-                                      drnd-spn
-                                      ))
-           :use ( drnd-spn
-                  (:instance exactp-<= (m 1)
-                             (x (smallest-positive-normal k)))
-                  (:instance spn-1-exact)
-                  (:instance rnd-exactp-a 
-                             (x (smallest-positive-normal k))
-;                             (m mode)
-                             (n n))))))
-
-;can be expensive..
-(defthmd drnd-spn-is-spn-general
-  (implies (and (= (abs x) (smallest-positive-normal k))
-                (rounding-mode-p mode)
-                (integerp n)
-                (>= n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                )
-           (= (drnd x mode n k)
-              x)
-           )
-  :hints (("Goal" :in-theory (disable smallest-positive-normal drnd-rewrite drnd-spn)
-           :use (:instance drnd-minus (mode (flip mode))))))
-
-;(in-theory (disable drnd-spn))
-
-;(in-theory (enable drnd-rewrite)) ;BOZO yuck!
-
-(defthm drnd-trunc-never-goes-away-from-zero
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)))
-           (<= (abs (drnd x 'trunc n k))
-               (abs x)))
-  :hints (("Goal" :in-theory (enable rnd drnd-rewrite)
-           :use (:instance trunc-upper-bound
-                           (n (+ -1 N (EXPO X) (bias k)))))))
-
-(defthm drnd-away-never-goes-toward-zero
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)))
-           (>= (abs (drnd x 'away n k))
-               (abs x)))
-  :hints (("Goal" :in-theory (enable rnd drnd-rewrite)
-           :use (:instance away-lower-bound
-                (n (+ -1 N (EXPO X) (bias k)))))))
-
-(defthm drnd-inf-never-goes-down
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)))
-           (>= (drnd x 'inf n k)
-               x))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd drnd-rewrite)
-                              '(expo-2**n abs-pos)))))
-
-(defthm drnd-minf-never-goes-up
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)))
-           (<= (drnd x 'minf n k)
-               x))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd drnd-rewrite)
-                              '(expo-2**n abs-pos)))))
-
-;t-p?
-(defthm fl-not-0
-  (implies (and (rationalp x)
-                (>= x 1))
-           (not (= (fl x)
-                   0))))
-;t-p?
-(defthm cg-not-0
-  (implies (and (rationalp x)
-                (> x 0))
-           (not (= (cg x)
-                   0))))
-
-(defthm drnd-trunc-skips-no-denormals
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (drepp a n k)
-                (<= (abs a) (abs x))
-                )
-           (<= (abs a)
-               (abs (drnd x 'trunc n k))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd drepp-def drnd-rewrite
-                                      )
-                              '(trunc-exactp-c-eric
-                                 EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                                  EXPO-COMPARISON-REWRITE-TO-BOUND
-                                smallest-positive-normal))
-           :use (
-                 (:instance exactp-<=
-                            (x a)
-                            (m (+ -1 N (EXPO A) (bias k)))
-                            (n (+ -1 N (EXPO x) (bias k))))
-                 (:instance trunc-exactp-c-eric (n (+ -1 N (EXPO X) (bias k))))
-                 (:instance expo-monotone (x a) (y x))))))
-
-
-(defthm drnd-trunc-skips-no-rep-numbers
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 1)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (irepp a n k)
-                (<= (abs a) (abs x))
-                )
-           (<= (abs a)
-               (abs (drnd x 'trunc n k))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable irepp DRND-SPN-IS-SPN-GENERAL )
-                              '(drnd-trunc-skips-no-denormals
-
-                                  DRND-SPN-IS-SPN
-                                smallest-spn
-                                smallest-positive-normal drnd-rewrite))
-           :use (drnd-trunc-skips-no-denormals
-                 (:instance smallest-spn (x a))))
-          ("goal'" 
-           :cases ((and (nrepp a n k) (< (abs x) (smallest-positive-normal k)))
-                   (and (drepp a n k) (< (abs x) (smallest-positive-normal k)))))))
-
-(defthm positive-spd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (> (smallest-positive-denormal n k) 0)))
-
-(defthm drepp-spd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (drepp (smallest-positive-denormal n k) n k))
-  :hints (("goal" :in-theory (enable drepp-DEF ;bias
-                                     ))))
-
-
-(defthm smallest-spd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (drepp x n k))
-           (>= (abs x) (smallest-positive-denormal n k)))
-  :hints (("goal" :in-theory (enable drepp SMALLEST-POSITIVE-DENORMAL)
-           :use (sig-lower-bound 
-                 fp-abs
-                 (:instance expt-weak-monotone
-                            (n (+ 2 (* -1 n) (* -1 (bias k))))
-                            (m (expo x)))))))
-
-
-;BOZO.  if we try to scatter exponents here, we don't gather the constants...
-(defthm drnd-trunc-of-low-range
-  (implies (and (rationalp x)
-                (< (abs x) (abs (smallest-positive-denormal n k)))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (drnd x 'trunc n k)
-              0))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable drnd-rewrite rnd sgn 
-                                      SMALLEST-POSITIVE-DENORMAL
-                                      SMALLEST-POSITIVE-NORMAL
-                                      bias ;drop?
-;                                      EXPT-COMPARE-EQUAL
-;expt-split expt-minus
-                                      )
-                              '(a15 ;smallest-positive-normal
-;smallest-positive-denormal
-                                EXPT-COMPARE-EQUAL
-                                EXPT-COMPARE
-                                ))
-           :use ((:instance expt-strong-monotone 
-                            (n (expo (smallest-positive-denormal n k)))
-                            (m (expo (smallest-positive-normal k))))
-                 (:instance trunc-to-0-or-fewer-bits
-                            (n (+ -1 N (EXPO X) (bias k))))
-                 (:instance a15 (i 2) (j1 1) (j2 (+ 1 (* -1 N)
-                                                    (* -1 (bias k)))))
-                 (:instance expo<= (n (+ 1 (* -1 N)
-                                         (* -1 (bias k)))))
-                 (:instance expo<= (x (- x))
-                            (n (+ 1 (* -1 N)
-                                  (* -1 (bias k)))))))))
-
-(defthm drnd-away-of-low-range
-  (implies (and (rationalp x)
-                (< (abs x) (abs (smallest-positive-denormal n k)))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (drnd x 'away n k)
-              (* (sgn x) (smallest-positive-denormal n k))))
-  :hints (("Goal"  :in-theory (set-difference-theories
-                               (enable drnd-rewrite rnd sgn bias 
-                                       smallest-positive-normal
-                                       smallest-positive-denormal)
-                               '(a15 ;
-                                                                 EXPT-COMPARE-EQUAL
-                                EXPT-COMPARE
-                                     ))
-           :use ((:instance expt-strong-monotone 
-                            (n (expo (smallest-positive-denormal n k)))
-                            (m (expo (smallest-positive-normal k))))
-;                 (:instance away-to-0-or-fewer-bits
- ;                           (n (+ -2 N (EXPO X) (EXPT 2 (+ -1 K)))))
-                 (:instance a15 (i 2) (j1 1) (j2 (+ 2 (* -1 N)
-                                                    (* -1 (EXPT 2 (+ -1 K))))))
-                 (:instance expo<= (n (+ 2 (* -1 N)
-                                         (* -1 (EXPT 2 (+ -1 K))))))
-                 (:instance expo<= (x (- x))
-                            (n (+ 2 (* -1 N)
-                                  (* -1 (EXPT 2 (+ -1 K))))))))))
-
-
-(defthm spd-<-spn
-  (implies (and (integerp n)
-                (> n 1)
-                (> k 0)
-                (integerp k))
-  (< (smallest-positive-denormal n k)
-     (smallest-positive-normal k)))
-;  :rule-classes :linear
-  :hints (("Goal" :in-theory (enable smallest-positive-denormal
-                                     smallest-positive-normal)
-           :use (:instance expt-strong-monotone 
-                                  (n (+ 2 (* -1 N) (* -1 (bias k))))
-                                  (m (+ 1          (* -1 (bias k))))))))
-
-#|
-(defthm abs-spd-<-abs-spn
-  (implies (and (integerp n)
-                (> n 1)
-                (> k 0)
-                (integerp k))
-  (< (abs (smallest-positive-denormal n k))
-     (abs (smallest-positive-normal k))))
- ; :rule-classes :linear
-  :hints (("Goal" :in-theory (disable smallest-positive-denormal smallest-positive-normal))))
-|#
-
-;move or drop?
-(defthm abs-prod
-  (implies (and (rationalp x)
-                (rationalp y))
-           (= (abs (* x y))
-              (* (abs x) (abs y))))
-  :hints (("Goal" :in-theory (enable sgn))))
-
-(defthm drnd-of-low-range
-  (implies (and (rationalp x)
-                (< (abs x) (abs (smallest-positive-denormal n k)))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (or (= (drnd x mode n k) 0)
-               (= (abs (drnd x mode n k)) (smallest-positive-denormal n k))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd inf minf near near+ ieee-mode-p rounding-mode-p sgn drnd-rewrite
-                                      )
-                              '(smallest-positive-denormal
-                                smallest-positive-normal 
-                                abs
-                                abs-away
-                                drnd-away-of-low-range
-                                drnd-trunc-of-low-range
-                                spd-<-spn
-;                                drnd-rewrite
-                                rearrange-negative-coefs-equal))
-           :use (;drnd-rewrite
-                 spd-<-spn
-                 drnd-away-of-low-range drnd-trunc-of-low-range)))
-  :rule-classes nil)
-
-(defthm drnd-spd-is-spd
-  (implies (and (rounding-mode-p mode)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (drnd (smallest-positive-denormal n k) mode n k)
-              (smallest-positive-denormal n k))
-           )
-  :hints (("Goal" :in-theory (disable smallest-positive-denormal))))
-
-(defthm drepp-minus
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (drepp (* -1 x) n k) (drepp x n k)))
-  :hints (("Goal" :in-theory (enable drepp))))
-
-;can be expensive
-(defthmd drnd-spd-is-spd-general
-  (implies (and (= (abs x) (smallest-positive-denormal n k))
-                (rounding-mode-p mode)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                )
-           (= (drnd x mode n k)
-              x)
-           )
-  :hints (("Goal" :in-theory (disable smallest-positive-denormal drnd-rewrite
-                                      DRND-OF-DREPP-IS-NOP
-                                      drepp-spd)
-           :use ((:instance drepp-spd)
-                 (:instance DRND-OF-DREPP-IS-NOP (x (- x)))
-                 (:instance DRND-OF-DREPP-IS-NOP )))))
-
-
-
-
-(defund largest-positive-denormal (n k)
-  (- (smallest-positive-normal k)
-     (smallest-positive-denormal n k)))
-
-
-(defthm positive-lpd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (> (largest-positive-denormal n k) 0))
-  :hints (("goal" :in-theory (enable drepp bias; SMALLEST-POSITIVE-NORMAL
-;                                     SMALLEST-POSITIVE-deNORMAL
-                                     largest-positive-denormal)
-           :use 
-           (:instance expt-strong-monotone 
-                      (n (+ 2 (* -1 n) (* -1 (bias k))))
-                      (m (+ 1 (* -1 (bias k)))))))
-  :rule-classes (:rewrite :linear))
-
-(defthm expo-2**k-x
-  (implies (and (integerp k)
-                (rationalp x)
-                (> x 0)
-                (<= x (expt 2 (- k 1))))
-           (equal (expo (+ (expt 2 k) (* -1 x)))
-                  (- k 1)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '())
-           :use (
-                 (:instance expo-unique (x (- (expt 2 k) x)) (n (- k 1)))
-                 )))
-  :otf-flg t)
-
-(defthm expo-lpd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (expo (largest-positive-denormal n k))
-              (1- (expo (smallest-positive-normal k)))))  
-  :hints (("Goal" :in-theory (enable largest-positive-denormal
-                                     SMALLEST-POSITIVE-NORMAL
-                                     SMALLEST-POSITIVE-deNORMAL))))
-
-;move
-(defthm exactp-diff-of-powers-of-2
-  (implies (and (integerp m)
-                (integerp n)
-                (> m n) ; remove?
-                )
-           (exactp (+ (expt 2 m) (* -1 (expt 2 n)))
-                   (- m n)))
-  :hints (("Goal" :in-theory (disable  expo-2**k-x)
-           :use ((:instance expt-strong-monotone (n m) (m n))
-                 (:instance exactp2 (x (- (expt 2 m) (expt 2 n)))
-                               (n (- m n)))
-                 (:instance  expo-2**k-x (k m)
-                             (x (EXPT 2 N)))))))
-
-
-(defthm exactness-of-lpd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (exactp (largest-positive-denormal n k)
-                   (1- n)))
-  :hints (("Goal" :in-theory (e/d (largest-positive-denormal
-                                   SMALLEST-POSITIVE-NORMAL
-                                   SMALLEST-POSITIVE-deNORMAL) ( exactp-diff-of-powers-of-2))
-           :use (:instance
-                        exactp-diff-of-powers-of-2
-                        (m (expo (smallest-positive-normal k)))
-                        (n (expo (smallest-positive-denormal n k)))))))
-
-(defthm drepp-lpd
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (drepp (largest-positive-denormal n k) n k))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable drepp-def)
-                              '(expo-lpd exactness-of-lpd))
-           :use ( (:instance expo-lpd)
-                  (:instance exactness-of-lpd)
-                  (:instance expt-strong-monotone 
-                             (n (+ 3 (* -1 n) (* -1 (EXPT 2 (1- k)))))
-                             (m (+ 2 (* -1 (EXPT 2 (1- k))))))))))
-
-;BOZO move these
-;nice rules to have in lib?
-(defthmd expo<=-2
-  (implies (and (<= (expo x) (- n 1))
-                (rationalp x)
-                (> x 0) ;gen?
-                (integerp n)
-                )
-           (<= x (expt 2 n)))
-  :hints (("Goal" :in-theory (disable EXPT-COMPARE)
-           :use (expo-upper-bound
-                 (:instance expt-weak-monotone-linear (m n) (n (+ 1 (expo x)))))))
-  :rule-classes (:rewrite :linear))
-
-;shouldn't be a linear rule?
-(defthmd expo>=-2
-  (implies (and (>= (expo x) n)
-                (rationalp x)
-                (> x 0) ;gen?
-                (integerp n)
-                )
-           (>= x (expt 2 n)))
-  :hints (("Goal" :in-theory (disable EXPT-COMPARE)
-           :use (expo-lower-bound
-                 (:instance expt-weak-monotone-linear (m (expo x))))))
-  :rule-classes (:rewrite :linear))
-
-
-;are these 2 duplicated elsewhere?
-;shouldn't be a linear rule?
-(defthmd expo>
-  (implies (and (> x (expt 2 (+ 1 n)))
-                (rationalp x)
-                (integerp n)
-                )
-           (> (expo x) n))
-  :rule-classes :linear
-  :otf-flg t
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '( EXPT-COMPARE))
-           :use (expo-upper-bound
-                 expo>=))))
-
-(defthmd expo<
-  (implies (and (< x (expt 2 n))
-                (> x 0)
-                (rationalp x)
-                (integerp n)
-                )
-           (< (expo x) n))
-  :rule-classes :linear
-  :hints (("goal" :use (expo-lower-bound
-			(:instance expt-split (r 2) (i 1) (j n))
-			(:instance expt-weak-monotone (n (1+ n)) (m (expo x)))))))
-
-(defthm largest-lpd
-  (implies (and (drepp x n k)
-                (> x 0) ;drop?
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                )
-           (<= x (largest-positive-denormal n k)))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable drepp-def largest-positive-denormal
-                                      SMALLEST-POSITIVE-NORMAL
-                                      SMALLEST-POSITIVE-deNORMAL)
-                              '(expo<=-2))
-           :use ((:instance expo<=-2 (n (+ 1 (* -1 (bias k)))))
-                 (:instance fp+2
-                            (y (EXPT 2 (+ 1 (* -1 (bias k)))))
-                            (n (+ -1 n (EXPO X) (bias k)))
-                            )))))
-
-;why? :
-(local (in-theory (disable expo-monotone)))
-(local (in-theory (disable expt-weak-monotone-linear)))
-
-;rephrase using bias?
-(defthm drepp-drnd-exactness
-  (implies (and (rationalp x)
-                (< (smallest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p m))
-           (exactp (drnd x m n k) (+ -2 n (expt 2 (- k 1)) (expo (drnd x m n k)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bias
-                                      drnd-rewrite
-                                      smallest-positive-normal
-                                      smallest-positive-denormal
-                                      ) ;drop?
-                              '(expo>))
-           :use ((:instance expo-rnd (mode m) (n (+ -1 N (EXPO X)
-                                                    (bias k))))
-                 (:instance expo> (n (+ 1 (- n ) (- (bias k)))))))))
-
-
-(defthm drepp-drnd-expo-1
-  (implies (and (rationalp x)
-                (< (smallest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p m))
-           (<= (- 2 n) (+ (expo (drnd x m n k)) (bias k))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable smallest-positive-normal
-                                      drnd-rewrite
-                                      smallest-positive-denormal)
-                              '(expo>=))
-           :use ((:instance expo-rnd (mode m) (n (+ -1 N (EXPO X)
-                                                    (bias k))))
-                 (:instance expo>= (n (+ 2 (- n) (- (bias k)))))))))
-
-(local 
- (defthm hack3
-   (implies (and (equal (expo x) (- 1 (expt 2 (1- k))))
-                 (rationalp x)
-                 (integerp n)
-                 (< 1 n)
-                 (integerp k)
-                 (< 0 k))
-            (> (+ (expt 2 (+ 1 (expo x)))
-                  (expt 2
-                        (+ 3 (* -1 n)
-                           (* -1 (expt 2 (1- k))))))
-               (expt 2 (+ 2 (* -1 (expt 2 (1- k)))))))
-   :rule-classes nil 
-   :hints (("Goal" :in-theory (disable   REARRANGE-NEGATIVE-COEFS-EQUAL)))))
-
-
-(defthm drepp-drnd-expo-2
-  (implies (and (rationalp x)
-                (< (smallest-positive-denormal n k) x)
-                (< x (largest-positive-denormal n k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p m))
-           (<= (+ (expo (drnd x m n k)) (bias k)) 0))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable ;expt-split
-                               bias ;drop
-                               largest-positive-denormal
-                               smallest-positive-normal
-                               smallest-positive-denormal
-                               drnd-rewrite
-                               )
-                              '(expo>= expo>=-2 ; expo-2**k-x
-                                       rnd-exactp-c ; expt-compare
-                                       exactp-diff-of-powers-of-2
-                                       ))
-           :use ((:instance expo-rnd (mode m)
-                            (n (+ -1 n (expo x) (bias k))))
-                 (:instance expo< (n (+ 2 (- n ) (- (bias k)))))
-                 (:instance expo< (n (+ 1 (* -1 (bias k)))))
-                 (:instance expo>= (n (+ 2 (- n ) (- (bias k)))))
-                 (:instance exactp-diff-of-powers-of-2
-                            (m (+ 1 (* -1 (bias k))))
-                            (n (+ 2 (* -1 n)
-                                  (* -1 (bias k)))))
-                 (:instance rnd-exactp-c (a (largest-positive-denormal n k))
-                            (mode m)
-                            (n (1- n)))
-                 hack3 ;hack3-bias
-
-                 ))
-          )
-  :otf-flg t
-  )
-
-
-#|
-(defthm drepp-drnd-expo-2
-  (implies (and (rationalp x)
-                (< (smallest-positive-denormal n k) x)
-                (< x (largest-positive-denormal n k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p m))
-           (<= (+ (expo (drnd x m n k)) (bias k)) 0))
-  :hints (("goal" :cases (< x 0)
-           :in-theory (set-difference-theories
-                              (enable ;expt-split
-;                               bias ;drop
-                               expt-split
-                               drnd-rewrite
-                               )
-                              '(expo>= expo>=-2 ; expo-2**k-x
-                                       rnd-exactp-c ; expt-compare
-                                       exactp-diff-of-powers-of-2
-                                       ))
-           )
-          )
-  :otf-flg t
-  )
-
-
-|#
-
-
-(defthm drepp-drnd-not-0
-  (implies (and (rationalp x)
-                (< (smallest-positive-denormal n k) x)
-                (< x (largest-positive-denormal n k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p m))
-           (not (equal (drnd x m n k) 0)))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable rnd inf minf near near+
-                                      drnd-rewrite
-                                      rounding-mode-p ieee-mode-p
-                                      smallest-positive-denormal
-                                      smallest-positive-normal
-                                      LARGEST-POSITIVE-DENORMAL
-;                                      bias
-                                      )
-                              '(drepp-spd drnd-trunc-skips-no-denormals))
-           :use ((:instance drepp-spd)
-                 (:instance drnd-trunc-skips-no-denormals
-                             (a (expt 2
-                                      (+ 2 (* -1 n) (* -1 (bias k))))))))))
-
-
-(defthm drepp-drnd-mid-range-1
-  (implies (and (rationalp x)
-                (< (smallest-positive-denormal n k) x)
-                (< x (largest-positive-denormal n k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p m))
-           (drepp (drnd x m n k) n k))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable drepp bias
-                                      smallest-positive-denormal
-                                      smallest-positive-normal
-                                      LARGEST-POSITIVE-DENORMAL)
-                              '(drnd-rewrite
-                                drepp-drnd-expo-2  drepp-drnd-expo-1))
-           :use ( drepp-drnd-expo-2  drepp-drnd-expo-1))))
-
-(defthm drepp-drnd-mid-range
-  (implies (and (rationalp x)
-                (< (smallest-positive-denormal n k) (abs x))
-                (< (abs x) (largest-positive-denormal n k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p m))
-           (drepp (drnd x m n k) n k))
-  :hints (("goal" :in-theory (e/d (drnd-minus)
-                                  ( drnd-rewrite DREPP-DRND-MID-RANGE-1 flip  DREPP-DEF
-                                      SMALLEST-POSITIVE-NORMAL SMALLEST-POSITIVE-DENORMAL))
-           :use (drepp-drnd-mid-range-1
-                 (:instance drepp-drnd-mid-range-1 (m (flip m)) (x (- x)))))))
-
-(defthm expo-of-high-range-1
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (> x 0))
-  :hints (("goal" :in-theory (disable largest-positive-denormal positive-lpd)
-           :use (:instance positive-lpd))))
-
-(defthm expo-of-high-range-2-2
-  (implies (and
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (<= (* 2
-                   (expt 2
-                         (+ 3 (* -1 n)
-                            (* -1 (expt 2 (1- k))))))
-               (expt 2 (+ 2 (* -1 (expt 2 (1- k)))))))
-  :hints (("goal" :in-theory (disable expo>=-2)
-           :use ((:instance a15 (i 2) (j1 1) (j2 (+ 3 (* -1 n) (* -1 (expt 2 (1- k))))))
-                 (:instance expt-weak-monotone (n (+ 4 (* -1 n)
-                         (* -1 (expt 2 (1- k)))))
-           
-                       (m (+ 2 (* -1 (expt 2 (1- k))))))))))
-#|
-;BOZO kill move
-(defthm expo-shift-3-alt
-    (implies (and (rationalp (* x y))
-		  (not (= (* x y) 0))
-		  (integerp n))
-	     (= (expo (* y (expt 2 n) x)) 
-		(+ n (expo (* x y)))))
-  :hints (("Goal" :use (:instance sig-expo-shift (x (* x y ))))))
-|#
-
-;finish trying to keep bias disabled in proofs below here
-(defthm expo-of-high-range-2-1
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (<= (expt 2 (- (expo (smallest-positive-normal k)) 1)) 
-               (largest-positive-denormal n k)))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable expt-split
-                                      expo-shift-2
-                                      bias
-                                      LARGEST-POSITIVE-DENORMAL
-                                      smallest-positive-normal
-                                      smallest-positive-denormal
-                                      )
-                              '()))))
-
-(defthm expo-of-high-range-2
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (< (expt 2 (- (expo (smallest-positive-normal k)) 1)) x))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable largest-positive-denormal
-                                      )
-                              '( expo>=-2
-                                      expo-of-high-range-2-1
-                                      smallest-positive-normal
-                                      ))
-           :use  expo-of-high-range-2-1)))   
-
-
-(defthm expo-of-high-range
-    (implies (and (rationalp x)
-                  (< (largest-positive-denormal n k) x)
-                  (< x (smallest-positive-normal k))
-                  (integerp n)
-                  (> n 1)
-                  (integerp k)
-                  (> k 0))
-             (= (expo x)
-                (- (expo (smallest-positive-normal k)) 1)))
-    :hints (("goal" :in-theory (e/d (smallest-positive-normal
-                                     smallest-positive-denormal)
-                                    (
-                                 expo-of-high-range-2
-                                positive-lpd))
-             :use ( expo-of-high-range-2
-                    (:instance positive-lpd)
-                   (:instance expo-unique (n (- (expo (smallest-positive-normal k)) 1)))))))
-
-(defthm drnd-trunc-of-high-range-3
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (equal (fp+ (largest-positive-denormal n k) (- n 1))
-                  (smallest-positive-normal k)))
-  :hints (("Goal" :in-theory (enable expo>=-2 largest-positive-denormal smallest-positive-normal
-                                     SMALLEST-POSITIVE-DENORMAL))))
-                       
-(defthm drnd-trunc-of-high-range-1
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (>= (drnd x 'trunc n k)
-               (largest-positive-denormal n k)))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable rnd drnd-rewrite)
-                              '(drnd-trunc-skips-no-denormals 
-                                smallest-positive-normal
-                                largest-positive-denormal
-                                rnd-exactp-d
-                                ))
-           :use ((:instance drnd-trunc-skips-no-denormals 
-                            (a (largest-positive-denormal n k))
-                            )))))
-
-(defthm drnd-trunc-of-high-range-2
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (<= (drnd x 'trunc n k)
-               (largest-positive-denormal n k)))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable rnd drnd-rewrite)
-                              '(
-                                smallest-positive-normal
-                                largest-positive-denormal
-                                rnd-exactp-d
-                                ;; expo-of-high-range
-                                ))
-           :use ((:instance fp+2 
-                            (y (trunc x (+ n 
-                                                (- (expo (smallest-positive-normal k))) 
-                                                (expo x))))
-                            (x (largest-positive-denormal n k))
-                            (n (- n 1)))))))
-
-(defthm drnd-trunc-of-high-range-pos
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (drnd x 'trunc n k)
-               (largest-positive-denormal n k)))
-  :hints (("goal" :in-theory (disable smallest-positive-normal
-                                      drnd-rewrite
-                                      largest-positive-denormal
-                                      drnd-trunc-of-high-range-2
-                                      drnd-trunc-of-high-range-1
-                                      )
-           :use (drnd-trunc-of-high-range-2 drnd-trunc-of-high-range-1))))
-
-
-(defthm drnd-trunc-of-high-range
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) (abs x))
-                (< (abs x) (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (drnd x 'trunc n k)
-               (* (sgn x) (largest-positive-denormal n k))))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable sgn drnd-minus)
-                              '(smallest-positive-normal
-                                drnd-rewrite
-                                largest-positive-denormal
-                                drnd-trunc-of-high-range-pos))
-           :use (drnd-trunc-of-high-range-pos
-                 (:instance drnd-trunc-of-high-range-pos (x (- x)))))))
-
-(defthm drnd-away-of-high-range-1
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (<= (drnd x 'away n k)
-               (smallest-positive-normal k)))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable rnd drnd-rewrite)
-                              '(spn-1-exact
-                                smallest-positive-normal
-                                largest-positive-denormal
-                                rnd-exactp-d))
-           :use ( spn-1-exact
-                  (:instance exactp-<= (x (smallest-positive-normal k)) (m 1) (n (- n 1)))
-                  (:instance away-exactp-c (a (smallest-positive-normal k))
-                             (n (+ n 
-                                   (- (expo (smallest-positive-normal k))) 
-                                   (expo x))))))))
-
-(defthm drnd-away-of-high-range-2
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (>= (drnd x 'away n k)
-               (smallest-positive-normal k)))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable rnd drnd-rewrite)
-                              '(smallest-positive-normal
-                                largest-positive-denormal
-                                rnd-exactp-d))
-           :use ((:instance exactp-<= (x (smallest-positive-normal k)) (m 1) (n
-                                                                              (- n 1)))
-                 (:instance fp+2 
-                            (y (away x (+ n 
-                                          (- (expo (smallest-positive-normal k))) 
-                                          (expo x))))
-                            (x (largest-positive-denormal n k))
-                            (n (- n 1)))))))
-
-(defthm drnd-away-of-high-range-pos
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) x)
-                (< x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (drnd x 'away n k)
-               (smallest-positive-normal k)))
-  :hints (("goal" :in-theory (disable 
-                              drnd-rewrite
-                              smallest-positive-normal
-                              largest-positive-denormal
-                               DRND-AWAY-OF-HIGH-RANGE-1
-                                DRND-AWAY-OF-HIGH-RANGE-2)
-           :use (drnd-away-of-high-range-2 drnd-away-of-high-range-1))))
-
-
-(defthm drnd-away-of-high-range
-  (implies (and (rationalp x)
-                (< (largest-positive-denormal n k) (abs x))
-                (< (abs x) (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0))
-           (= (drnd x 'away n k)
-               (* (sgn x) (smallest-positive-normal k))))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable sgn drnd-minus)
-                              '(smallest-positive-normal
-                                drnd-rewrite
-                                largest-positive-denormal
-                                drnd-away-of-high-range-pos))
-           :use (drnd-away-of-high-range-pos
-                 (:instance drnd-away-of-high-range-pos (x (- x)))
-                 ))))
-
-(defthm drnd-choice
-  (implies (rounding-mode-p mode)
-           (or (equal (drnd x mode n k) (drnd x 'away n k))
-               (equal (drnd x mode n k) (drnd x 'trunc n k))))
-  :hints (("Goal" :use (:instance rnd-choice (x (+ X
-                        (* (SGN X)
-                           (EXPT 2 (+ 2 (* -1 (EXPT 2 (1- K)))))))))
-           :in-theory (set-difference-theories
-                       (enable drnd)
-                       '(re evenp))))
-  :rule-classes nil)
-
-
-(defthm drnd-of-high-range
-  (implies (and (< (largest-positive-denormal n k) (abs x))
-                (< (abs x) (smallest-positive-normal k))
-                (rationalp x)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (or (= (drnd x mode n k) (* (sgn x) (largest-positive-denormal n k)))
-               (= (drnd x mode n k) (* (sgn x) (smallest-positive-normal k)))))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable rnd inf minf near ieee-mode-p rounding-mode-p sgn)
-                              '(smallest-positive-denormal
-                                drnd-rewrite
-                                smallest-positive-normal 
-                                abs-away
-                                rounding-mode-p
-                                rearrange-negative-coefs-equal))
-           :use (drnd-choice)))
-  :rule-classes nil) 
-
-;add?
-;gen?
-(defthm drnd-non-neg
-  (implies (and (<= 0 x)
-                (rationalp x)
-                (<= x (smallest-positive-normal k)) ;drop?
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (<= 0 (drnd x mode n k)))
-  :hints (("Goal" :in-theory (enable drnd-rewrite)))
-  :rule-classes (:rewrite :type-prescription))
-
-;add?
-;gen?
-(defthm drnd-non-pos
-  (implies (and (<= x 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)) ;drop?
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (<= (drnd x mode n k) 0))
-  :hints (("Goal" :in-theory (enable drnd-rewrite)))
-  :rule-classes (:rewrite :type-prescription))
-
-;bad name?
-(defthm drnd-type-pos
-  (implies (and (rationalp x)
-                (<= 0 x)
-                (<= x (smallest-positive-normal k)) ;drop?
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (or (drepp (drnd x mode n k) n k)
-               (= (drnd x mode n k) 0)
-               (= (drnd x mode n k) (smallest-positive-normal k))))
-           :otf-flg t
-           :hints (("goal" :in-theory (set-difference-theories
-                              (enable sgn DRND-SPN-IS-SPN-GENERAL)
-                              '(drnd-rewrite 
-                                drepp-drnd-mid-range
-                                drnd-spd-is-spd-general
-                                smallest-positive-denormal
-                                largest-positive-denormal
-                                smallest-positive-normal
-                                drepp-drnd-mid-range-1
-                                drepp-spd
-                                ))
-           :use (drnd-of-high-range
-                 drnd-of-low-range
-                 (:instance  DREPP-MINUS (x  (DRND X MODE N K)))
-                 (:instance  drepp-spd)
-                 (:instance drepp-drnd-mid-range (m mode)))))
-  :rule-classes nil)
-
-;bad name?
-(defthm drnd-type
-  (implies (and (rationalp x)
-                (<= (abs x) (smallest-positive-normal k)) ;drop?
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (or (drepp (drnd x mode n k) n k)
-               (= (drnd x mode n k) 0)
-               (= (drnd x mode n k) (* (sgn x) (smallest-positive-normal k)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable sgn drnd-minus)
-                              '(drnd-rewrite
-;                                DRND-SPD-IS-SPD-GENERAL ; for efficiency
-                                smallest-positive-normal))
-           :use (drnd-type-pos
-                 (:instance drnd-type-pos (mode (flip mode)) (x (- x))))))
-  :rule-classes nil)
-
-
-;drop?
-;(in-theory (disable SMALLEST-POSITIVE-NORMAL))
-
-
-
-;better proof?
-(defthm drnd-diff
-  (implies (and (rationalp x)
-                (<= (ABS X) (SMALLEST-POSITIVE-NORMAL K))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rounding-mode-p mode))
-           (< (abs (- x (drnd x mode n k))) (smallest-positive-denormal n k)))
-  :hints (("Goal'" 
-           :cases ((> (+ n 
-                         (- (expo (smallest-positive-normal k))) 
-                         (expo x)) 0)))
-          ("goal" :in-theory (set-difference-theories
-                              (enable rnd 
-                                      drnd-rewrite
-                                      SMALLEST-POSITIVE-DENORMAL
-                                      ;bias
-                                     ; SMALLEST-POSITIVE-NORMAL
-                                      rounding-mode-p
-                                      inf minf near near+ sgn)
-                              '( ;BIAS
-                                ;sgn
-                                SMALLEST-POSITIVE-NORMAL
-                                ;SMALLEST-POSITIVE-deNORMAL
-                                re evenp EXPO<=-2 EXPO>=-2 expt-compare
-                                rnd-diff))
-           :use ((:instance rnd-diff (n (+ N (EXPO X)
-                                           (* -1 (EXPO (SMALLEST-POSITIVE-NORMAL
-                                                        K))))))
-                 (:instance expo-upper-bound (x (- x)))
-                 (:instance expo-upper-bound)
-                 (:instance expt-weak-monotone (n (+ 1 (expo x)))
-                            (M (+ 2 (* -1 N)
-                                  (* -1 (bias k)))))))))
-
-
-(defthm drepp-rationalp
-  (implies (drepp x n k)
-           (rationalp x))
-  :rule-classes :forward-chaining
-  :hints (("Goal" :in-theory (enable drepp))))
-
-;just an intermediate step in the proofs
-(defund next-denormal-2 (x n k)
-  (fp+ x (+ -1 n (expo x) (bias k))))
-
-(defund next-denormal (x n k)
-  (+ x (smallest-positive-denormal n k))) 
-
-(defthmd denormals-same
-  (equal (next-denormal-2 x n k) 
-         (next-denormal x n k))
-  :hints (("Goal" :in-theory (enable next-denormal next-denormal-2 
-                                     SMALLEST-POSITIVE-DENORMAL)))
-  )
-
-;move
-(defthmd fp+-expo
-  (implies (and (rationalp x)
-                (< 0 x)
-                (< x y)
-                (rationalp y)
-                (exactp x n)
-                (integerp n)
-                (> n 0)
-                (< y (fp+ x n)))
-           (= (expo y)
-              (expo x)))
-  :hints (("Goal" :use ((:instance expo-unique (x y) (n (expo x)))
-           (:instance fp+1-1)))))
-
-;remove x>=0 hyp?
-(defthm denormal-spacing-1
-  (implies (and (integerp n)
-                (integerp k)
-                (> k 0)
-                (> n 1)
-                (drepp x n k)
-                (drepp x+ n k)
-                (>= x 0)
-                (> x+ x))
-           (>= x+ (next-denormal-2 x n k)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable drepp bias NEXT-DENORMAL-2)
-                              '(fp+ fp+-expo))
-           :use ((:instance fp+-expo (y x+)
-                            (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
-                 (:instance fp+2 
-                            (y x+)
-                            (n (+ -1 n (expo x) (bias k))))))))
-
-(defthm denormal-spacing
-  (implies (and (integerp n)
-                (integerp k)
-                (> k 0)
-                (> n 1)
-                (drepp x n k)
-                (drepp x+ n k)
-                (>= x 0)
-                (> x+ x))
-           (>= x+ (next-denormal x n k)))
-  :hints (("Goal" :in-theory (disable denormal-spacing-1)
-           :use (denormal-spacing-1
-                 (:instance denormals-same)))))
-
-(defthm drnd-away-skips-no-denormals-pos
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= 0 x)
-                (<= x (smallest-positive-normal k))
-                (drepp a n k)
-                (>= a x)
-                )
-           (>= a (drnd x 'away n k)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable sgn smallest-positive-normal
-                                      SMALLEST-POSITIVE-DENORMAL
-                                      LARGEST-POSITIVE-DENORMAL
-                                      NEXT-DENORMAL)
-                              '(drnd-diff
-                                drnd-rewrite
-                                largest-lpd
-                                denormal-spacing
-                                
-;                                DRND-SPD-IS-SPD-GENERAL ;these two for efficiency
- ;                               DRND-SPN-IS-SPN-GENERAL ;
-                                 ))
-           :use ((:instance largest-lpd (x a))
-                 (:instance drnd-diff (mode 'away))
-                 (:instance drnd-type (mode 'away))
-                 (:instance denormal-spacing
-                            (x a)
-                            (x+ (drnd x 'away n k)))))))
-
-; all 4 :use hints seem necessary
-(defthm drnd-away-skips-no-denormals
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (drepp a n k)
-                (>= (abs a) (abs x))
-                )
-           (>= (abs a) (abs (drnd x 'away n k))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable sgn drnd-minus)
-                              '(drnd-diff
-                                DRND-AWAY-OF-HIGH-RANGE
-                                DRND-AWAY-OF-HIGH-RANGE-POS
-                                DRND-AWAY-OF-LOW-RANGE
-                                DREPP-DRND-MID-RANGE
-                                drnd-non-pos
-                                drnd-rewrite
-                                smallest-positive-normal
-                                DRND-AWAY-SKIPS-NO-DENORMALS-pos
-;                                DRND-SPD-IS-SPD-GENERAL ;these two for efficiency
- ;                               DRND-SPN-IS-SPN-GENERAL
-                                ))
-                                
-           :use ((:instance drnd-non-pos (mode 'away))
-                 (:instance drnd-away-skips-no-denormals-pos)
-                 (:instance drnd-away-skips-no-denormals-pos (a (- a)) (x (- x)))
-                 (:instance drnd-away-skips-no-denormals-pos (x (- x)))
-                 (:instance drnd-away-skips-no-denormals-pos (a (- a)))))))
-  
-;BOZO
-;(in-theory (disable SMALLEST-POSITIVE-NORMAL BIAS DREPP))
-
-(defthm drnd-inf-skips-no-denormals
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (drepp a n k)
-                (>= a x))
-           (>= a (drnd x 'inf n k)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd ;drepp 
-                                      inf
-                                      drnd-rewrite)
-                              '(;drnd-rewrite
-                                drnd-away-skips-no-denormals
-                                 drnd-trunc-skips-no-denormals))
-          :use ((:instance drnd-away-skips-no-denormals)
-                (:instance drnd-trunc-skips-no-denormals (x (- x)))))))
-
-(defthm drnd-minf-skips-no-denormals
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (drepp a n k)
-                (<= a x))
-           (<= a (drnd x 'minf n k)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd ;drepp 
-                                      drnd-rewrite
-                                      minf)
-                              '(
-                                drnd-away-skips-no-denormals
-                                 drnd-trunc-skips-no-denormals))
-          :use ((:instance drnd-away-skips-no-denormals (x (- x)))
-                (:instance drnd-trunc-skips-no-denormals)))))
-
-
-
-(local 
- (defthm hack1
-   (implies (and (< n 0)
-                 (>= x 0)
-                 (rationalp x)
-                 (integerp n)
-                 )
-            (>= (EXPT 2 (+ (EXPO X) (* -1 N)))
-                X))
-   :hints (("Goal" :use (:instance expo<=-2 (n (+ (EXPO X) (* -1 N))))))))
-
-;BOZO this hack shouldn't be needed
-(local 
- (defthm hack2
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (< n 0)
-                 (>= x 0))
-            (>= (EXPT 2 (+ 1 (EXPO X) (* -1 N)))
-                (* 2 X)))
-   :hints (("Goal" :in-theory (set-difference-theories
-                               (enable expt-split)
-                               '( hack1 expo<=-2))
-            :use (hack1
-                  (:instance a15 (i 2) (j1 1) (j2 (+ (EXPO X) (* -1 N)))))))))
-
-;BOZO in trying to improve this I enabled sig, which caused a loop
-;try
-(local
- (defthm near1-b-negative-n
-   (implies (and (rationalp x)
-                 (>= x 0)
-                 (integerp n)
-                 (<= n 0)
-                 (> (- x (trunc x n)) (- (away x n) x)))
-            (= (near x n) (away x n)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (set-difference-theories
-                               (enable sgn near expt-split re)
-                               '(                                     ;FL-EQUAL-0
-                                 EXPT-COMPARE
-                                 FL-EQUAL-0
-                                 hack2 EXPO-BOUND-ERIC
-                                 expo>=-2 expo<=-2
-                                 ;; MattK: The following disable is needed by
-                                 ;; v2-8-alpha-12-30-03 (and somewhat before,
-                                 ;; but not in June 03).  I haven't
-                                 ;; investigated why exactly, but from the
-                                 ;; transcript it seems that the new use of
-                                 ;; linear arithmetic for type-set is the
-                                 ;; culprit.  I don't have any reason to
-                                 ;; believe that this exposes a problem with
-                                 ;; that new use; I'm happy to assume that it's
-                                 ;; just an artifact of this particular proof
-                                 ;; approach, at least for now.
-                                 expt-2-positive-rational-type
-                                 ))
-            :use (expo-upper-bound
-                  hack2
-                  (:instance expt-strong-monotone (m (+ (EXPO X) (* -1 N))) (n (EXPO X)))
-                  (:instance expt-weak-monotone (n n) (m 0))
-                  (:instance expt-weak-monotone (n n) (m -1))
-                  (:instance fl-unique (x (* 1/2 (SIG X) (EXPT 2 N)))
-                             (n 0))
-                  )))))
-
-
-;BOZO could replace the version in near.lisp 
-(defthm near1-b-eric
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> (- x (trunc x n)) (- (away x n) x)))
-	     (= (near x n) (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near away trunc)
-		  :use (near1-b
-                        near1-b-negative-n))))
-
-
-
-(defthm drnd-near-2-1
-  (implies (and (rationalp x)
-                (<= x (smallest-positive-normal k))
-                (rationalp a)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (> x 0)
-                (drepp a n k)
-                (= (drnd x 'near n k) (drnd x 'trunc n k)))
-           (>= (abs (- x a)) (abs (- x (drnd x 'trunc n k)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd bias drnd-rewrite)
-                              '(  away-exactp-c 
-				      near trunc-exactp-c
-                                      drnd-away-skips-no-denormals
-                                      drnd-trunc-skips-no-denormals
-                                      ))
-           :use ((:instance near1-b-eric (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
-                 (:instance away-lower-pos (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
-                 (:instance trunc-upper-pos (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
-                 (:instance drnd-away-skips-no-denormals )
-                 (:instance drnd-trunc-skips-no-denormals)))))
-
-(defthm drnd-near-2-2
-  (implies (and (rationalp x)
-                (<= x (smallest-positive-normal k))
-                (rationalp a)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (> x 0)
-                (drepp a n k)
-                (= (drnd x 'near n k) (drnd x 'away n k)))
-           (>= (abs (- x a)) (abs (- x (drnd x 'away n k)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd bias drnd-rewrite)
-                              '( drnd-away-skips-no-denormals
-                                 drnd-trunc-skips-no-denormals
-                                 away-exactp-c 
-                                 trunc-exactp-c
-                                 ))
-           :use ((:instance near1-a (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
-                 (:instance away-lower-pos (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
-                 (:instance trunc-upper-pos (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
-                 (:instance drnd-away-skips-no-denormals )
-                 (:instance drnd-trunc-skips-no-denormals)))))
-
-(defthm drnd-near-choice
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (<= (abs x) (smallest-positive-normal k)))
-           (or (= (drnd x 'near n k) (drnd x 'trunc n k))
-               (= (drnd x 'near n k) (drnd x 'away n k))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd near drnd-rewrite)
-                              '(re evenp))))
-  :rule-classes ())
-
-;BOZO
-;(in-theory (disable SMALLEST-POSITIVE-DENORMAL))
-
-(defthm no-denormal-is-closer-than-what-drnd-near-returns-pos
-  (implies (and (rationalp x)
-                (>= x 0)
-                (<= x (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (drepp a n k))
-           (>= (abs (- x a)) (abs (- x (drnd x 'near n k)))))
-  :hints (("Goal" :in-theory (disable
-
-                              drnd-rewrite
-                              drnd-non-neg
-                              DRND-AWAY-SKIPS-NO-DENORMALS-POS)
-           :use ((:instance drnd-near-2-1)
-                 (:instance drnd-near-2-2)
-                 (:instance drnd-near-choice)))))
-
-(defthm no-denormal-is-closer-than-what-drnd-near-returns-neg
-  (implies (and (rationalp x)
-                (<= x 0)
-                (<= (abs x) (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (drepp a n k))
-           (>= (abs (- x a)) (abs (- x (drnd x 'near n k)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable drnd-minus)
-                              '(drnd-rewrite
-                                drnd-non-pos
-                                drnd-non-neg
-                                smallest-positive-normal
-                                no-denormal-is-closer-than-what-drnd-near-returns-pos
-                                DRND-AWAY-SKIPS-NO-DENORMALS-POS))
-           :use ((:instance no-denormal-is-closer-than-what-drnd-near-returns-pos
-                            (x (- x)) (a (- a)))))))
-
-
-(defthm no-denormal-is-closer-than-what-drnd-near-returns
-  (implies (and (rationalp x)
-                (<= (abs x) (smallest-positive-normal k))
-                (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (drepp a n k))
-           (>= (abs (- x a)) (abs (- x (drnd x 'near n k)))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable)
-                              '(drnd-rewrite
-                                drnd-non-pos
-                                drnd-non-neg
-                                smallest-positive-normal
-                                DRND-AWAY-SKIPS-NO-DENORMALS-POS
-                                no-denormal-is-closer-than-what-drnd-near-returns-pos
-                                no-denormal-is-closer-than-what-drnd-near-returns-neg))
-           :use (no-denormal-is-closer-than-what-drnd-near-returns-pos
-                 no-denormal-is-closer-than-what-drnd-near-returns-neg))))
-
-;could speed up the above with a :cases hint instead of :use hints?
-
-
-
-
-#|
-;remove these?
-(defthm drnd-trunc-never-goes-up-for-pos-args
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= 0 x)
-                (<= x (smallest-positive-normal k)))
-           (<= (drnd x 'trunc n k)
-               x))
-  :hints (("Goal" :in-theory (enable rnd)
-           :use (:instance trunc-upper-bound
-                                  (n (+ -2 N (EXPO X) (EXPT 2 (1- K))))))))
-
-
-(defthm drnd-away-never-goes-down-for-pos-args
-  (implies (and (integerp n)
-                (> n 1)
-                (integerp k)
-                (> k 0)
-                (rationalp x)
-                (<= 0 x)
-                (<= x (smallest-positive-normal k)))
-           (>= (drnd x 'away n k)
-               x))
-  :hints (("Goal" :in-theory (enable rnd)
-           :use (:instance away-lower-bound
-                                  (n (+ -2 N (EXPO X) (EXPT 2 (1- K))))))))
-|#
-
-;why?
-(in-theory (disable expo< expo>))
-
-
-
-
- 
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/encode.lisp acl2-6.3/books/rtl/rel5/support/encode.lisp
--- acl2-6.2/books/rtl/rel5/support/encode.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/encode.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,133 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(local (include-book "../arithmetic/top"))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-(local (include-book "ground-zero"))
-(local (include-book "bvecp"))
-(local (include-book "ash"))
-(local (include-book "float"))
-
-(defund encode (x n)
-  (declare (xargs :guard (and (acl2-numberp x)
-                              (integerp n)
-                              (<= 0 n))))
-  (if (zp n) 
-      0
-    (if (= x (ash 1 n))
-        n
-      (encode x (1- n)))))
-
-(defthm encode-nonnegative-integer-type
-  (and (integerp (encode x n))
-       (<= 0 (encode x n)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable encode))))
-
-;this rule is no better than encode-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription encode)))
-
-(defthm encode-natp
-  (natp (encode x n)))
-
-(defthm encode-bvecp-helper
-  (implies (and (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (bvecp (encode x n) (+ 1 (expo n)))) ;The +1 is necessary
-  :hints (("Subgoal *1/5" :use (:instance EXPT-WEAK-MONOTONE
-                                          (n (+ 1 (EXPO (1- N)))) 
-                                          (m (+ 1 (EXPO N))))
-           :in-theory (set-difference-theories
-                       (enable encode bvecp power2p ash-rewrite)
-                       '(
-                         expt-compare
-                         )))
-          ("Goal"
-           :in-theory (set-difference-theories
-                       (enable encode bvecp power2p ash-rewrite)
-                       '(
-                         expt-compare
-                         )))
-          ))
-
-(defthm encode-bvecp-old
-  (implies (and (<= (+ 1 (expo n)) k)
-                (case-split (integerp k))
-                )
-           (BVECP (ENCODE x n) k))
-  :hints (("Goal" :in-theory (disable encode-bvecp-helper)
-           :expand (ENCODE X N)
-           :use  (encode-bvecp-helper))))
-
-(defthmd expo-expt-reduction
-  (implies (and (integerp k)
-                (rationalp n)
-                (< 0 n)
-                (< n (expt 2 k)))
-           (<= (+ 1 (expo n)) k))
-  :hints (("Goal" :use ((:instance expo-comparison-rewrite-to-bound-2
-                                   (k (1- k))
-                                   (x n)))
-           :in-theory (disable expo-comparison-rewrite-to-bound-2))))
-
-(local
- (defthmd encode-non-positive-integer
-   (implies (not (and (integerp n)
-                      (< 0 n)))
-            (equal (encode x n) 0))
-   :hints (("Goal" :expand ((encode x n))))))
-
-(defthm encode-bvecp
-  (implies (and (< n (expt 2 k))
-                (case-split (integerp k)))
-           (bvecp (encode x n) k))
-  :hints (("Goal" :in-theory (enable expo-expt-reduction encode-non-positive-integer)
-           :cases ((and (integerp n) (< 0 n))))))
-
-; may not need this now
-(defthm encode-reduce-n
-  (implies (and (integerp n)
-                (<= 0 n)
-                (bvecp x n))
-           (equal (encode x n)
-                  (encode x (1- n))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable encode bvecp power2p ash-rewrite )
-                              '(
-                                expt-compare
-                                )))))
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/ereps-proofs.lisp acl2-6.3/books/rtl/rel5/support/ereps-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/ereps-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/ereps-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,699 +0,0 @@
-(in-package "ACL2")
-
-; Eric Smith, David Russinoff, with contributions and suggestions by Matt Kaufmann
-; AMD, June 2001 
-;this file was previously called repsproofs.lisp
-;perhaps the more hierarchical defns (e.g., erepp2) should be exported
-
-(include-book "rtl")
-(include-book "float") ;to get the defns...
-
-; bias of a q bit exponent field is 2^(q-1)-1 
-(defund bias (q) (- (expt 2 (- q 1)) 1) )
-
-(local (include-book "bias"))
-(local (include-book "merge"))
-(local (include-book "cat"))
-(local (include-book "bvecp"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "../arithmetic/top")) ;try
-(include-book "mulcat")
-
-(local (in-theory (enable bits-tail)))
-(local (in-theory (disable sgn))) ;move up?
-(local (in-theory (enable expt-split expt-minus)))
-
-;;Encoding of floating-point numbers with explicit leading one:
-;;bit vectors of length p+q+1, consisting of 1-bit sign field, 
-;;q-bit exponent field (bias = 2**(q-1)-1), and p-bit significand field.
-
-(defund esgnf  (x p q) (bitn x (+ p q)))
-(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
-(defund esigf  (x p)   (bits x (1- p) 0))
-
-;;;**********************************************************************
-;;;                       REPRESENTABLE NUMBERS
-;;;**********************************************************************
-
-(defund erepp (x p q)
-  (and (rationalp x)
-       (not (= x 0))
-       (bvecp (+ (expo x) (bias q)) q)
-       (exactp x p)))
-
-
-;;;**********************************************************************
-;;;                      VALID ENCODINGS
-;;;**********************************************************************
-
-(defund eencodingp (x p q)
-  (and (bvecp x (+ p q 1))
-       (= (bitn x (- p 1)) 1)))
-
-; sig, expo, and sgn are defined in float.lisp
-(defund eencode (x p q)
-  (cat (cat (if (= (sgn x) 1) 0 1)
-	    1
-	    (+ (expo x) (bias q))
-	    q)
-       (1+ q)
-       (* (sig x) (expt 2 (- p 1)))
-       p) )
-
-(defund edecode (x p q)
-  (* (if (= (esgnf x p q) 0) 1 -1)
-     (esigf x p)
-     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
-
-;BOZO move.  handle this better
-(defthm cancel-hack
-  (implies (and (not (equal 0 y))
-                (rationalp x)
-                (rationalp y)
-                (rationalp w)
-                (rationalp z))
-                (equal (EQUAL 0 (+ (* X y) (* w y z)))
-                       (EQUAL 0 (+ x (* w z)))))
-  :hints (("Goal" :in-theory (disable CANCEL_TIMES-EQUAL-CORRECT)
-           :use (:instance  mult-both-sides-of-equal (c y) (a 0) (b (+ x (* w z)))))))
-                       
-(defthm edecode-eencode
-  (implies (and (erepp x p q)
-                (integerp p)
-;                (>= p 0)
-                (integerp q)
-;                (>= q 0) ;gen!
-                )
-           (equal (edecode (eencode x p q) p q)
-                  x))
-  :hints (("Goal" :in-theory (enable only-0-is-0-or-negative-exact
-                                     edecode eencode erepp esgnf eexpof esigf sgn bits-minus-alt))))
-
-(defthm eencode-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (>= p 0)
-                (integerp q)
-                (> q 0)
-                )
-           (equal (eencode (edecode x p q) p q)
-                  x))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable bvecp-forward
-                                     bitn-negative-bit-of-integer
-                                     edecode eencode esigf eexpof eencodingp esgnf sgn cat-split-equality))))
-
-(defthm erepp-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (erepp (edecode x p q) p q))
-  :hints (("Goal" :in-theory (enable erepp edecode eencodingp esigf eexpof esgnf))))
-
-(defthm eencodingp-eencode
-  (implies (and (erepp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (eencodingp (eencode x p q) p q) )
-  :hints (("Goal" :in-theory (e/d (eencodingp eencode erepp sgn bitn-shift-eric) ()))))
-
-(defthm expo-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))  
-           (equal (expo (edecode x p q))
-                  (- (eexpof x p q) (bias q))
-                  ))
-  :hints (("Goal" :in-theory (enable edecode eexpof esigf esgnf eencodingp))))
-
-(defthm sig-edecode
-  (implies (and (eencodingp  x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (equal (sig (edecode x p q))
-                  (/ (esigf x p) (expt 2 (- p 1)))))
-  :hints (("Goal" :in-theory (enable sig esigf eexpof edecode esgnf eencodingp))))
-
-(defthm sgn-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (equal (sgn (edecode  x p q))
-                  (if (= (esgnf x p q) 0) 1 -1)))
-  :hints (("Goal" :in-theory (enable sgn edecode esgnf esigf eencodingp))))
-
-(defthm eencodingp-not-zero
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (not (equal (edecode x p q) 0)))
-  :hints (("Goal" :in-theory (enable eencodingp edecode esigf esgnf))))
-
-
-;Rebiasing proofs:
-
-(defund rebias-expo (expo old new)
-  (+ expo (- (bias new) (bias old))))
-
-(defthm natp-rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x m))
-	     (natp (rebias-expo x m n)))
-    :hints (("goal" :in-theory (e/d ( expt-split rebias-expo bvecp natp bias
-                                                  ) (expt-compare))
-		  :use (:instance expt-weak-monotone (n m) (m n)))))
-
-(defthm natp-rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (natp (rebias-expo x n m)))
-    :hints (("goal" :in-theory (enable rebias-expo bvecp natp bias))))
-
-
-(defthm bvecp-rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x m))
-	     (bvecp (rebias-expo x m n) n))
-  :hints (("goal" :in-theory (e/d ( ;expt
-                                   expt-split
-                                     rebias-expo bvecp bias)
-                                  (expt-compare))
-		  :use (:instance expt-weak-monotone (n m) (m n)))))
-
-
-(defthm bvecp-rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (bvecp (rebias-expo x n m) m))
-  :hints (("goal" :in-theory (enable ;expt 
-                              expt-split
-                                     rebias-expo bvecp bias))))
-(local (defthm rebias-lemma-1
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 1))
-	     (< (bits x (- n 2) 0) (expt 2 (1- m))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance bitn-plus-bits (n (1- n)) (m 0)))))))
-
-(local (defthm rebias-lemma-3
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 1))
-	     (bvecp (bits x (- n 2) 0) (1- m)))
-  :rule-classes ()
-  :hints (("Goal" :use (rebias-lemma-1
-;			rebias-lemma-2
-                        )
-		  :in-theory (e/d (bvecp) (BITS-SLICE-ZERO-GEN))))))
-
-(local (defthm rebias-lemma-4
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 1))
-	     (equal (bits x (- n 2) 0)
-		    (bits x (- m 2) 0)))
-    :rule-classes nil
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable natp)
-                              '(bits-bits
-                                ))
-		  :use (rebias-lemma-3
-			(:instance bits-bits (i (- n 2)) (j 0) (k (- m 2)) (l 0)))))))
-
-(local (defthm rebias-lemma-5
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 1))
-	     (equal x (+ (expt 2 (1- n)) (bits x (- m 2) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories (enable natp) '())
-		  :use (rebias-lemma-4
-			(:instance bitn-plus-bits (n (1- n)) (m 0)))))))
-
-(local (defthm rebias-lemma-6
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 1))
-	     (equal (rebias-expo x n m)
-		    (cat (bitn x (1- n)) 1
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable rebias-expo bias cat)
-		  :use (rebias-lemma-5)))))
-
-(local (defthm rebias-lemma-7
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (equal (bits x (+ -2 n) 0)
-		    x))
-    :rule-classes nil
-    :hints (("Goal" :use ((:instance bitn-plus-bits (n (1- n)) (m 0)))))))
-
-(local (defthm rebias-lemma-8
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (equal (bits x (+ -2 n) 0)
-		    (+ (* (expt 2 (1- m))
-			  (bits x (- n 2) (1- m)))
-		       (bits x (- m 2) 0))))
-    :rule-classes nil
-    :hints (("Goal" :use ((:instance bits-plus-bits (n (+ -2 n)) (p (1- m)) (m 0)))))))
-
-(local (defthm rebias-lemma-9
-    (implies (and ;(natp n)
-		  (natp m)
-		  ;(> n m)
-		  (> m 1)
-		  ;(bvecp x n)
-                  )
-	     (and (integerp (bits x (- m 2) 0))
-		  (< (bits x (- m 2) 0)
-		     (expt 2 (1- m)))))
-  :hints (("Goal" :use ((:instance bits-bvecp (i (- m 2)) (j 0) (k (1- m))))
-		  :in-theory (union-theories (disable bits-bvecp) '(bvecp natp))))))
-
-(local (defthm rebias-lemma-10
-    (implies (and (integerp x)
-		  (integerp y)
-		  (< x y))
-	     (<= x (1- y)))
-  :rule-classes ()))
-
-(local (defthm rebias-lemma-11
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n))
-	     (INTEGERP (EXPT 2 (+ -2 M))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable natp)))))
-
-
-(local (defthm rebias-lemma-12
-    (implies (and; (natp n)
-		  (natp m)
-		 ; (> n m)
-		  (> m 1)
-		  ;(bvecp x n)
-                  )
-	     (<= (bits x (- m 2) 0)
-		 (1- (expt 2 (1- m)))))
-  :hints (("Goal" :in-theory (union-theories (disable rebias-lemma-9 expt) '(natp))
-		  :use (rebias-lemma-9
-			rebias-lemma-11
-			(:instance rebias-lemma-10 (x (bits x (- m 2) 0)) (y (expt 2 (1- m)))))))))
-
-(local (defthm rebias-lemma-13
-              (implies (and (natp n)
-                            (natp m)
-                            (> n m)
-                            (> m 1)
-                            (bvecp x n)
-                            (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-                            (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-                            (= (bitn x (1- n)) 0))
-                       (<= (bits x (+ -2 n) 0)
-                           (+ (* (expt 2 (1- m))
-                                 (bits x (- n 2) (1- m)))
-                              (1- (expt 2 (- m 1))))))
-              :rule-classes ()
-              :hints (("Goal" :in-theory (disable rebias-lemma-12)
-                       :use (rebias-lemma-8
-                             rebias-lemma-12)))))
-
-(local (defthm rebias-lemma-14
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (or (> (bits x (- n 2) (1- m))
-		    (- (expt 2 (- n m)) 2))
-		 (<= (bits x (- n 2) 0)
-		     (+ (* (- (expt 2 (- n m)) 2)
-			   (expt 2 (1- m)))
-			(1- (expt 2 (1- m)))))))
-  :rule-classes ()
-  :hints (("Goal" :use (rebias-lemma-13)))))
-
-(local (defthm rebias-lemma-15
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (or (> (bits x (- n 2) (1- m))
-		    (- (expt 2 (- n m)) 2))
-		 (<= (bits x (- n 2) 0)
-		     (+ (- (expt 2 (- n 1))
-			   (* 2 (expt 2 (1- m))))
-			(1- (expt 2 (1- m)))))))
-  :rule-classes ()
-  :hints (("Goal" :use (rebias-lemma-14
-			(:instance expt-split (r 2) (i (- n m)) (j (1- m))))))))
-
-(local (defthm rebias-lemma-16
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (or (> (bits x (- n 2) (1- m))
-		    (- (expt 2 (- n m)) 2))
-		 (< (bits x (- n 2) 0)
-		    (- (expt 2 (1- n)) (expt 2 (1- m))))))
-  :rule-classes ()
-  :hints (("goal" :use (rebias-lemma-15)))))
-
-(local (defthm rebias-lemma-17
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (equal (< x 
-		     (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (< (bits x (+ -2 n) 0)
-		     (- (expt 2 (1- n))
-			(expt 2 (1- m))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable ;rebias-lemma-7
-                              )
-           :use (rebias-lemma-7)))))
-
-(local (defthm rebias-lemma-18
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (> (bits x (- n 2) (1- m))
-		(- (expt 2 (- n m)) 2)))
-  :rule-classes ()
-  :hints (("Goal" :use (rebias-lemma-16
-			rebias-lemma-17)))))
-
-(local (defthm rebias-lemma-19
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (and ;(integerp (bits x (- n 2) (1- m)))
-		  (< (bits x (- n 2) (1- m)) (expt 2 (- n m)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (bvecp
-                                   ) ( bits-bvecp
-                                       BITS-SLICE-ZERO-GEN
-                                       ))
-		  :use ((:instance bits-bvecp (i (- n 2)) (j (1- m)) (k (- n m))))))))
-
-(local (defthm rebias-lemma-20
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1))
-	     (integerp (expt 2 (- n m))))
-  :rule-classes ()))
-
-(local (defthm rebias-lemma-21
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (= (bits x (- n 2) (1- m))
-		(1- (expt 2 (- n m)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bvecp)
-                              '(;natp
-                                expt-2-integerp
-                                ;; Matt K.: ACL2 v2-8-alpha-12-30-03 needs two
-                                ;; more rules to be disabled, as follows.  I
-                                ;; haven't investigated why, but given the rule
-                                ;; expt-2-integerp disabled just above, a
-                                ;; reasonable explanation is that ACL2 simply
-                                ;; does a better job now of using the rules
-                                ;; below (to rewrite a hypothesis to T that is,
-                                ;; in fact, needed).
-                                EXPT-2-POSITIVE-INTEGER-TYPE ; new
-                                A14 ; new
-                                EXPT-QUOTIENT-INTEGERP-ALT
-                                EXPT2-INTEGER
-                                EXPT-SPLIT
-                                POWER2-INTEGER
-                                BVECP-TIGHTEN
-                                LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE
-                                ))
-		  :use (rebias-lemma-18
-			rebias-lemma-20
-			rebias-lemma-19)))))
-
-(local (defthm rebias-lemma-22
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (= x
-		(+ (* (1- (expt 2 (- n m)))
-		      (expt 2 (1- m)))
-		   (bits x (- m 2) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable ;rebias-lemma-7
-                              )
-           :use (rebias-lemma-21
-			rebias-lemma-7
-			(:instance bits-plus-bits (n (+ -2 n)) (p (1- m)) (m 0)))))))
-
-(local (defthm rebias-lemma-23
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (= x
-		(+ (- (expt 2 (1- m)))
-		   (expt 2 (1- n))
-		   (bits x (- m 2) 0))))
-  :rule-classes ()
-  :hints (("Goal" :use (rebias-lemma-22
-			(:instance expt-split (r 2) (i (- n m)) (j (1- m))))))))
-
-(local (defthm rebias-lemma-24
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
-		  (= (bitn x (1- n)) 0))
-	     (equal (rebias-expo x n m)
-		    (cat (bitn x (1- n)) 1
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable rebias-expo bias cat)
-		  :use (rebias-lemma-23)))))
-
-(defthm rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (equal (rebias-expo x n m)
-		    (cat (bitn x (1- n))
-			 1
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ()
-  :hints (("Goal" :use (rebias-lemma-6
-			rebias-lemma-24
-			(:instance bitn-0-1 (n (1- n)))))))
-
-
-(local (defthm rebias-up-1
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x m)
-		  (= (bitn x (1- m)) 1))
-	     (equal (cat (cat 1 1 0 (- n m)) (+ 1 (- n m))
-                          (bits x (- m 2) 0)
-                          (1- m))
-		    (+ (expt 2 (1- n))
-		       (bits x (- m 2) 0))))
-    :rule-classes ()
-    :hints (("Goal" :in-theory (enable cat)
-             :use ((:instance expt-split (r 2) (i (- n m)) (j (1- m))))))))
-
-(local (defthm rebias-up-2
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x m)
-		  (= (bitn x (1- m)) 1))
-	     (equal (cat (cat 1 1 0 (- n m)) (+ 1 (- n m))
-			 (bits x (- m 2) 0)
-			 (1- m))
-		    (rebias-expo x m n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable rebias-expo bias)
-		  :use (rebias-up-1
-			(:instance bitn-plus-bits (n (1- m)) (m 0)))))))
-
-;BOZO move
-(defthmd bits-of-minus-1
-  (implies (and (integerp i)
-                (integerp j)
-                (<= j i)
-                (<= 0 j)
-                )
-           (equal (bits -1 i j)
-                  (1- (expt 2 (+ 1 i (- j))))))
-  :hints (("Goal" :in-theory (enable bits))))
-
-(local (defthm rebias-up-3
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x m)
-		  (= (bitn x (1- m)) 0))
-	     (equal (cat (cat 0 1 (1- (expt 2 (- n m))) (- n m)) (+ 1 (- n m))
-			 (bits x (- m 2) 0)
-			 (1- m))
-		    (rebias-expo x m n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (rebias-expo cat bias) (expt-compare)) ;BOZO investigate loopA
-		  :use ((:instance bits-of-minus-1 (j 0) (i (+ -1 N (* -1 M))))
-                        (:instance bitn-plus-bits (n (1- m)) (m 0))
-			(:instance expt-split (r 2) (i (- n m)) (j (1- m))))))))
-
-
-(defthm rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x m))
-	     (equal (rebias-expo x m n)
-		    (cat (cat (bitn x (1- m))
-			      1
-			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
-			      (- n m))
-			 (1+ (- n m))
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable bvecp-tighten ;expo-shift-eric
-                                      EXPT-SPLIT
-                                      BITS-BVECP-WHEN-X-IS
-                                      BITS-SLICE-ZERO-GEN
-                                      BITN-KNOWN-NOT-0-REPLACE-WITH-1)
-		  :use (rebias-up-2
-			rebias-up-3
-			(:instance bitn-0-1 (n (1- m)))))))
diff -Nru acl2-6.2/books/rtl/rel5/support/ereps.lisp acl2-6.3/books/rtl/rel5/support/ereps.lisp
--- acl2-6.2/books/rtl/rel5/support/ereps.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/ereps.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,234 +0,0 @@
-(in-package "ACL2")
-
-; Eric Smith, David Russinoff, with contributions and suggestions by Matt Kaufmann
-; AMD, June 2001 
-;this file was previously called repsproofs.lisp
-
-(include-book "rtl")
-(include-book "float") ;to get the defns...
-
-(local (include-book "ereps-proofs"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-; bias of a q bit exponent field is 2^(q-1)-1 
-(defund bias (q) (- (expt 2 (- q 1)) 1) )
-
-;;Encoding of floating-point numbers with explicit leading one:
-;;bit vectors of length p+q+1, consisting of 1-bit sign field, 
-;;q-bit exponent field (bias = 2**(q-1)-1), and p-bit significand field.
-
-(defund esgnf  (x p q) (bitn x (+ p q)))
-(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
-(defund esigf  (x p)   (bits x (1- p) 0))
-
-;;;**********************************************************************
-;;;                       REPRESENTABLE NUMBERS
-;;;**********************************************************************
-
-(defund erepp (x p q)
-  (and (rationalp x)
-       (not (= x 0))
-       (bvecp (+ (expo x) (bias q)) q)
-       (exactp x p)))
-
-
-;;;**********************************************************************
-;;;                      VALID ENCODINGS
-;;;**********************************************************************
-
-(defund eencodingp (x p q)
-  (and (bvecp x (+ p q 1))
-       (= (bitn x (- p 1)) 1)))
-
-
-;;;**********************************************************************
-;;;                       EENCODE
-;;;**********************************************************************
-
-
-
-; sig, expo, and sgn are defined in float.lisp
-
-
-;bozo disable!
-(defund eencode (x p q)
-  (cat (cat (if (= (sgn x) 1) 0 1)
-	    1
-	    (+ (expo x) (bias q))
-	    q)
-       (1+ q)
-       (* (sig x) (expt 2 (- p 1)))
-       p) )
-
-
-
-
-;;;**********************************************************************
-;;;                       EDECODE
-;;;**********************************************************************
-
-
-(defund edecode (x p q)
-  (* (if (= (esgnf x p q) 0) 1 -1)
-     (esigf x p)
-     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
-
-
-
-;;;**********************************************************************
-;;;                      Encoding and Decoding are Inverses
-;;;**********************************************************************
-
-(defthm erepp-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (erepp (edecode x p q) p q)))
-
-
-(defthm eencodingp-eencode
-  (implies (and (erepp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (eencodingp (eencode x p q) p q) ))
-
-(defthm edecode-eencode
-  (implies (and (erepp x p q)
-                (integerp p)
-;                (> p 0)
-                (integerp q)
- ;               (> q 0)
-                )
-           (equal (edecode (eencode x p q) p q)
-                  x )))
-
-(defthm eencode-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (>= p 0)
-                (integerp q)
-                (> q 0))
-           (equal (eencode (edecode x p q) p q)
-                  x )))
-
-(defthm expo-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))  
-           (equal (expo (edecode x p q))
-                  (- (eexpof x p q) (bias q))
-                  )))
-
-(defthm sgn-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (equal (sgn (edecode  x p q))
-                  (if (= (esgnf x p q) 0) 1 -1))))
-
-(defthm sig-edecode
-  (implies (and (eencodingp  x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (equal (sig (edecode  x p q))
-                  (/ (esigf x p) (expt 2 (- p 1))))))
-
-(defthm eencodingp-not-zero
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (not (equal (edecode x p q) 0))))
-
-(defund rebias-expo (expo old new)
-  (+ expo (- (bias new) (bias old))))
-
-;;I actually needed all four of the following lemmas, although I would have thought
-;;that the two bvecp lemmas would be enough.
-
-(defthm natp-rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x m))
-	     (natp (rebias-expo x m n)))
-    :hints (("goal" :in-theory (e/d ( expt-split rebias-expo bvecp natp bias
-                                                  ) (expt-compare))
-		  :use (:instance expt-weak-monotone (n m) (m n)))))
-
-(defthm natp-rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (natp (rebias-expo x n m)))
-    :hints (("goal" :in-theory (enable rebias-expo bvecp natp bias))))
-
-(defthm bvecp-rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x m))
-	     (bvecp (rebias-expo x m n) n)))
-
-(defthm bvecp-rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (bvecp (rebias-expo x n m) m)))
-
-(defthm rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x m))
-	     (equal (rebias-expo x m n)
-		    (cat (cat (bitn x (1- m))
-			      1
-			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
-			      (- n m))
-			 (1+ (- n m))
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ())
-
-(defthm rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (equal (rebias-expo x n m)
-		    (cat (bitn x (1- n))
-			 1
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ())
-
diff -Nru acl2-6.2/books/rtl/rel5/support/fadd-extra.lisp acl2-6.3/books/rtl/rel5/support/fadd-extra.lisp
--- acl2-6.2/books/rtl/rel5/support/fadd-extra.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/fadd-extra.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,480 +0,0 @@
-; The original version of this book, before changing land/lior/lxor, is
-; fadd-extra0.lisp.
-
-(in-package "ACL2")
-
-(include-book "fadd-extra0")
-(include-book "land")
-(include-book "lior")
-(include-book "lxor")
-
-(local (in-theory (enable land-is-land0)))
-(local (in-theory (enable lior-is-lior0)))
-(local (in-theory (enable lxor-is-lxor0)))
-
-(defthmd lior-bits-1
-  (equal (lior (bits x (1- n) 0)
-               y
-               n)
-         (lior x y n))
-  :hints (("Goal" :use lior0-bits-1)))
-
-(defthmd lior-bits-2
-  (equal (lior x
-               (bits y (1- n) 0)
-               n)
-         (lior x y n))
-  :hints (("Goal" :use lior0-bits-2)))
-
-(defthmd land-bits-1
-  (equal (land (bits x (1- n) 0)
-               y
-               n)
-         (land x y n))
-  :hints (("Goal" :use land0-bits-1)))
-
-(defthmd land-bits-2
-  (equal (land x
-               (bits y (1- n) 0)
-               n)
-         (land x y n))
-  :hints (("Goal" :use land0-bits-2)))
-
-(defthmd lxor-bits-1
-  (equal (lxor (bits x (1- n) 0)
-               y
-               n)
-         (lxor x y n))
-  :hints (("Goal" :use lxor0-bits-1)))
-
-(defthmd lxor-bits-2
-  (equal (lxor x
-               (bits y (1- n) 0)
-               n)
-         (lxor x y n))
-  :hints (("Goal" :use lxor0-bits-2)))
-
-(defthmd lior-slice
-  (implies (and (<= j i)
-		(<= i n)
-		(integerp n)
-		(integerp i)
-		(integerp j)
-		(<= 0 j))
-	   (equal (lior x
-                        (- (expt 2 i) (expt 2 j))
-                        n)
-		  (cat (bits x (1- n) i)     (- n i)
-                       (1- (expt 2 (- i j))) (- i j)
-                       (bits x (1- j) 0)     j)))
-  :hints (("Goal" :use lior0-slice)))
-
-(defthm land-base
-  (equal (land x y 1)
-         (if (and (equal (bitn x 0) 1)
-                  (equal (bitn y 0) 1))
-             1
-           0))
-  :hints (("Goal" :use land0-base))
-  :rule-classes nil)
-
-(defthm lior-base
-  (equal (lior x y 1)
-         (if (or (equal (bitn x 0) 1)
-                 (equal (bitn y 0) 1))
-             1
-           0))
-  :hints (("Goal" :use lior0-base))
-  :rule-classes nil)
-
-(defthm lxor-base
-  (equal (lxor x y 1)
-         (if (iff (equal (bitn x 0) 1)
-                  (equal (bitn y 0) 1))
-             0
-           1))
-  :hints (("Goal" :use lxor0-base))
-  :rule-classes nil)
-
-(defthmd prop-as-lxor
-  (implies (and (natp i)
-                (natp j)
-                (<= j i)
-                (natp x)
-                (natp y))
-           (equal (prop x y i j)
-                  (if (equal (lxor (bits x i j) (bits y i j) (1+ (- i j)))
-                             (1- (expt 2 (1+ (- i j)))))
-                      1
-                    0)))
-  :hints (("Goal" :use prop-as-lxor0
-           :in-theory (enable log=))))
-
-; new for rel5/:
-
-(defthm half-adder
-  (implies (and (bvecp u 1)
-                (bvecp v 1))
-           (equal (+ u v)
-                  (cat (land u v 1) 1 (lxor u v 1) 1)))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :cases ((and (equal u 0) (equal v 0))
-                   (and (equal u 0) (equal v 1))
-                   (and (equal u 1) (equal v 0)))))
-  :rule-classes ())
-
-(defthm full-adder
-  (implies (and (bvecp u 1)
-                (bvecp v 1)
-                (bvecp w 1))
-           (equal (+ u v w)
-                  (cat (lior (land u v 1) (lior (land u w 1) (land v w 1) 1) 1) 1 
-                       (lxor u (lxor v w 1) 1) 1)))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :cases ((and (equal u 0) (equal v 0) (equal w 0))
-                   (and (equal u 0) (equal v 0) (equal w 1))
-                   (and (equal u 0) (equal v 1) (equal w 0))
-                   (and (equal u 0) (equal v 1) (equal w 1))
-                   (and (equal u 1) (equal v 0) (equal w 0))
-                   (and (equal u 1) (equal v 0) (equal w 1))
-                   (and (equal u 1) (equal v 1) (equal w 0)))))
-  :rule-classes ())
-
-(defun rc-carry (x y k)
-  (if (zp k)
-      0
-    (lior (land (bitn x (1- k)) (bitn y (1- k)) 1)
-	  (lior (land (bitn x (1- k)) (rc-carry x y (1- k)) 1)
-		(land (bitn y (1- k)) (rc-carry x y (1- k)) 1)
-		1)
-	  1)))
-
-(defun rc-sum (x y k)
-  (if (zp k)
-      0
-    (cat (lxor (bitn x (1- k))
-	       (lxor (bitn y (1- k)) (rc-carry x y (1- k)) 1)
-	       1)
-	 1
-	 (rc-sum x y (1- k))
-	 (1- k))))
-
-; Start proof of ripple-carry.
-
-(local-defun ripple-carry-prop (x y n)
-  (implies (and (natp x)
-                (natp y)
-                (natp n))
-           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
-                  (cat (rc-carry x y n) 1 (rc-sum x y n) n))))
-
-(local (include-book "top1"))
-
-(local (in-theory (disable land-is-land0)))
-(local (in-theory (disable lior-is-lior0)))
-(local (in-theory (disable lxor-is-lxor0)))
-
-(defthm bvecp-rc-carry
-  (bvecp (rc-carry x y k) 1))
-
-(defthm bvecp-rc-sum
-  (bvecp (rc-sum x y k) k))
-
-(local-defthm ripple-carry-prop-base
-  (implies (zp n)
-           (ripple-carry-prop x y n)))
-
-; Speed things up a lot in main-1 (at least), as found by
-; accumulated-persistence.
-(local (in-theory (disable bits-tail
-                           bvecp-tighten
-                           bitn-too-small
-                           bits-upper-bound
-                           bits-less-than-x-gen
-                           bits-less-than-x)))
-
-(local-defthm main-1
-  (implies (and (natp k)
-                (natp x)
-                (natp y)
-                (equal (+ (bits x (+ -1 k) 0)
-                          (bits y (+ -1 k) 0))
-                       (cat (rc-carry x y k)
-                            1
-                            (rc-sum x y k)
-                            k)))
-           (equal (+ (bits x k 0)
-                     (bits y k 0))
-                  (+ (* (expt 2 k)
-                        (+ (bitn x k) (bitn y k)))
-                     (+ (bits x (1- k) 0)
-                        (bits y (1- k) 0)))))
-  :hints (("Goal" :use ((:instance bitn-plus-bits
-                                   (x x)
-                                   (n k)
-                                   (m 0))
-                        (:instance bitn-plus-bits
-                                   (x y)
-                                   (n k)
-                                   (m 0)))))
-  :rule-classes nil)
-
-(local-defthm main-2
-  (implies (and (natp k)
-                (natp x)
-                (natp y)
-                (equal (+ (bits x (+ -1 k) 0)
-                          (bits y (+ -1 k) 0))
-                       (cat (rc-carry x y k)
-                            1
-                            (rc-sum x y k)
-                            k)))
-           (equal (+ (bits x k 0)
-                     (bits y k 0))
-                  (+ (* (expt 2 k)
-                        (+ (bitn x k) (bitn y k)))
-                     (cat (rc-carry x y k)
-                          1
-                          (rc-sum x y k)
-                          k))))
-  :hints (("Goal" :use main-1
-           :in-theory (theory 'minimal-theory)))
-  :rule-classes nil)
-
-(local-defthm main-3-1
-  (implies (and (natp k)
-                (natp x)
-                (natp y))
-           (equal (cat (rc-carry x y k)
-                       1
-                       (rc-sum x y k)
-                       k)
-                  (+ (* (expt 2 k)
-                        (rc-carry x y k))
-                     (rc-sum x y k))))
-  :hints (("Goal" :expand ((cat (rc-carry x y k)
-                                1
-                                (rc-sum x y k)
-                                k))))
-  :rule-classes nil)
-
-(local-defthm main-3
-  (implies (and (natp k)
-                (natp x)
-                (natp y)
-                (equal (+ (bits x (+ -1 k) 0)
-                          (bits y (+ -1 k) 0))
-                       (cat (rc-carry x y k)
-                            1
-                            (rc-sum x y k)
-                            k)))
-           (equal (+ (bits x k 0)
-                     (bits y k 0))
-                  (+ (* (expt 2 k)
-                        (+ (bitn x k)
-                           (bitn y k)
-                           (rc-carry x y k)))
-                     (rc-sum x y k))))
-  :hints (("Goal" :use (main-2 main-3-1)
-           :in-theory (disable rc-sum rc-carry cat)))
-  :rule-classes nil)
-
-(local
- (encapsulate
-  ()
-
-  (local-defthm main-4-1
-    (implies (and (natp k)
-                  (natp x)
-                  (natp y)
-                  (equal (+ (bits x (+ -1 k) 0)
-                            (bits y (+ -1 k) 0))
-                         (cat (rc-carry x y k)
-                              1
-                              (rc-sum x y k)
-                              k)))
-             (equal (+ (bits x k 0)
-                       (bits y k 0))
-                    (+ (* (expt 2 k)
-                          (let ((u (bitn x k))
-                                (v (bitn y k))
-                                (w (rc-carry x y k)))
-                            (cat (lior (land u v 1)
-                                       (lior (land u w 1) (land v w 1) 1)
-                                       1)
-                                 1 
-                                 (lxor u (lxor v w 1) 1)
-                                 1)))
-                       (rc-sum x y k))))
-    :hints (("Goal" :use (main-3
-                          (:instance full-adder
-                                     (u (bitn x k))
-                                     (v (bitn y k))
-                                     (w (rc-carry x y k))))
-             :in-theory (disable rc-sum rc-carry cat)))
-    :rule-classes nil)
-
-  (local-defthm main-4-2
-    (implies (and (natp k)
-                  (natp x)
-                  (natp y))
-             (equal (cat (rc-carry x y (1+ k))
-                         1 
-                         (bitn (rc-sum x y (1+ k)) k)
-                         1)
-                    (let ((u (bitn x k))
-                          (v (bitn y k))
-                          (w (rc-carry x y k)))
-                      (cat (lior (land u v 1)
-                                 (lior (land u w 1) (land v w 1) 1)
-                                 1)
-                           1 
-                           (lxor u (lxor v w 1) 1)
-                           1)))))
-
-  (defthm main-4
-    (implies (and (natp k)
-                  (natp x)
-                  (natp y)
-                  (equal (+ (bits x (+ -1 k) 0)
-                            (bits y (+ -1 k) 0))
-                         (cat (rc-carry x y k)
-                              1
-                              (rc-sum x y k)
-                              k)))
-             (equal (+ (bits x k 0)
-                       (bits y k 0))
-                    (+ (* (expt 2 k)
-                          (cat (rc-carry x y (1+ k))
-                               1 
-                               (bitn (rc-sum x y (1+ k)) k)
-                               1))
-                       (rc-sum x y k))))
-    :instructions (:promote
-                   (:dv 2 1 2 0)
-                   (:rewrite main-4-2)
-                   :top
-                   (:use main-4-1)
-                   :split)
-    :rule-classes nil)))
-
-(local-defthm main-5
-  (implies (and (natp k)
-                (natp x)
-                (natp y)
-                (equal (+ (bits x (+ -1 k) 0)
-                          (bits y (+ -1 k) 0))
-                       (cat (rc-carry x y k)
-                            1
-                            (rc-sum x y k)
-                            k)))
-           (equal (+ (bits x k 0)
-                     (bits y k 0))
-                  (+ (* (expt 2 (1+ k))
-                        (rc-carry x y (1+ k)))
-                     (* (expt 2 k)
-                        (bitn (rc-sum x y (1+ k)) k))
-                     (rc-sum x y k))))
-  :hints (("Goal" :use main-4
-           :expand ((cat (rc-carry x y (1+ k))
-                         1 
-                         (bitn (rc-sum x y (1+ k)) k)
-                         1))
-           :in-theory (e/d (bits-tail) (rc-sum rc-carry))))
-  :rule-classes nil)
-
-(local
- (encapsulate
-  ()
-
-  (local-defthm main-6-1-1
-    (implies (and (natp k)
-                  (natp x)
-                  (natp y))
-             (equal (bits (rc-sum x y (1+ k)) (1- k) 0)
-                    (rc-sum x y k)))
-    :hints (("Goal" 
-             :expand ((rc-sum x y (1+ k)))
-             :in-theory (e/d (cat) (rc-sum)))))
-
-  (local-defthm main-6-1
-    (implies (and (natp k)
-                  (natp x)
-                  (natp y))
-             (equal (rc-sum x y (1+ k))
-                    (+ (* (expt 2 k)
-                          (bitn (rc-sum x y (1+ k)) k))
-                       (rc-sum x y k))))
-    :hints (("Goal" :use ((:instance bitn-plus-bits
-                                     (x (rc-sum x y (1+ k)))
-                                     (n k)
-                                     (m 0)))
-             :expand ((rc-sum x y 0))
-             :in-theory (e/d (bits-tail) (rc-sum rc-carry))))
-    :rule-classes nil)
-
-  (defthm main-6
-    (implies (and (natp k)
-                  (natp x)
-                  (natp y)
-                  (equal (+ (bits x (+ -1 k) 0)
-                            (bits y (+ -1 k) 0))
-                         (cat (rc-carry x y k)
-                              1
-                              (rc-sum x y k)
-                              k)))
-             (equal (+ (bits x k 0)
-                       (bits y k 0))
-                    (+ (* (expt 2 (1+ k))
-                          (rc-carry x y (1+ k)))
-                       (rc-sum x y (1+ k)))))
-    :hints (("Goal" :use (main-5 main-6-1)
-             :in-theory (disable rc-sum rc-carry)))
-    :rule-classes nil)))
-
-(local-defthm main
-  (implies (and (natp k)
-                (natp x)
-                (natp y)
-                (equal (+ (bits x (+ -1 k) 0)
-                          (bits y (+ -1 k) 0))
-                       (cat (rc-carry x y k)
-                            1
-                            (rc-sum x y k)
-                            k)))
-           (equal (+ (bits x k 0)
-                     (bits y k 0))
-                  (cat (rc-carry x y (1+ k))
-                       1
-                       (rc-sum x y (1+ k))
-                       (1+ k))))
-  :hints (("Goal" :use main-6
-           :expand ((cat (rc-carry x y (1+ k))
-                         1
-                         (rc-sum x y (1+ k))
-                         (1+ k)))
-           :in-theory (e/d (bits-tail) (rc-sum rc-carry))))
-  :rule-classes nil)
-
-(local-defthm ripple-carry-prop-induction-step
-  (implies (and (not (zp n))
-                (ripple-carry-prop x y (1- n)))
-           (ripple-carry-prop x y n))
-  :hints (("Goal" :use ((:instance main (k (1- n))))
-           :in-theory (disable rc-sum rc-carry cat))))
-
-(local-defthm ripple-carry-prop-proved
-  (ripple-carry-prop x y n)
-  :hints (("Goal" :induct (rc-sum x y n)
-           :in-theory (disable ripple-carry-prop))))
-
-(defthm ripple-carry
-  (implies (and (natp x)
-                (natp y)
-                (natp n))
-           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
-                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
-  :hints (("Goal" :use ripple-carry-prop-proved
-           :in-theory (union-theories '(ripple-carry-prop)
-                                      (theory 'ground-zero))))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/support/fadd-extra0.lisp acl2-6.3/books/rtl/rel5/support/fadd-extra0.lisp
--- acl2-6.2/books/rtl/rel5/support/fadd-extra0.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/fadd-extra0.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,594 +0,0 @@
-; This book, but with land0/lior0/lxor0 replaced by land/lior/lxor, was the
-; original state of fadd-extra.lisp.
-
-(in-package "ACL2")
-
-; This book illustrates how to extend the library.
-
-; Typically, one first does the proof after including ../lib/top/.  (For this
-; particular file we happened to include ../lib/ books bits, arith, and util.)
-; But in order to prove them in this support/ directory, we instead locally
-; include a book top1 and put ourselves in a theory, lib-top1.  The resulting
-; environment is the same (or at least very close to the same) as the
-; environment after including ../lib/top -- or more precisely, a snapshot of
-; lib/top at the time top1 was created.  The present book is locally included
-; in ../lib/fadd.lisp.
-
-; Some day there might be a need for top2 and theory lib-top2, which will
-; include the state of lib/top after the inclusion of the present book
-; (fadd-extra.lisp) and any other *-extra.lisp books in this support/
-; directory.  But that should be a long time off.
-
-; A reasonable book name in this directory could be
-; <lib-book-name>-extra.lisp.
-
-; Be sure to modify the Makefile and top.lisp accordingly.  You can do this by
-; searching in those files for fadd-extra and making the analogous mods.
-
-(include-book "rtl")  ; needed for some definitions
-(include-book "fadd") ; needed for some definitions
-
-; Now put ourselves in what amounts to the environment of ../lib/top, as
-; explained above.
-(local (include-book "top1"))
-(local (in-theory (theory 'lib-top1)))
-
-; Proof of bits-sum-swallow:
-
-; Proof:  Since y < 2^(k+1), y[i:k+1] = 0.  
-; 
-; Since x[k] = 0, x[k:0] = x[k-1:0] < 2^k.
-; 
-; Hence, 
-; 
-;   x[k:0] + y[k:0] < 2^k + 2^k = 2^(k+1) 
-; 
-; and 
-; 
-;   (x[k:0] + y[k:0])[k+1] = 0.
-; 
-; By BITS-SUM-ORIGINAL,
-; 
-;   (x+y)[i:k+1] = (x[i:k+1] + y[i:k+1] + (x[k:0] + y[k:0])[k+1])[i-k-1:0]
-;                = (x[i:k+1])[i-k-1:0]
-;                = x[i:k+1] {by BITS-BITS}.
-; 
-; By BITS-BITS,
-; 
-;   (x+y)[i:j] = (x+y)[i:k+1][i-k-1:j-k-1] 
-;              = x[i:k+1][i-k-1:j-k-1] 
-;              = x[i:j].
-
-(local-defthm bits<expt
-  (implies (and (natp x)
-                (integerp i)
-                (natp j)
-                (<= j i)
-                (equal n (1+ (- i j))))
-           (< (bits x i j)
-              (expt 2 n)))
-  :hints (("Goal" :use ((:instance bits-bvecp
-                                   (k n)))
-           :in-theory (e/d (bvecp) (bits-bvecp bits-bvecp-simple))))
-  :rule-classes :linear)
-
-(local-defthm bits-sum-swallow-1-1-1-1
-  (implies (and (natp x)
-                (natp k)
-                (= (bitn x k) 0))
-           (< (bits x k 0)
-              (expt 2 k)))
-  :hints (("Goal" :use ((:instance bitn-plus-bits (n k) (m 0))
-                        (:theorem (or (zp k) (< 0 k))))))
-  :rule-classes :linear)
-
-(local-defthm bits-sum-swallow-1-1-1-2
-  (implies (and (natp y)
-                (natp k)
-                (<= y (expt 2 k)))
-           (equal (bits y k 0) y))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :expand ((expt 2 (1+ k))))))
-
-(local-defthm bits-sum-swallow-1-1-1
-  (implies (and (natp x)
-                (natp y)
-                (natp k)
-                (= (bitn x k) 0)
-                (<= y (expt 2 k)))
-           (< (+ (bits x k 0) (bits y k 0))
-              (expt 2 (1+ k))))
-  :hints (("Goal" :expand ((expt 2 (1+ k)))))
-  :rule-classes nil)
-
-(local-defthm bits-sum-swallow-1-1
-  (implies (and (natp x)
-                (natp y)
-                (natp k)
-                (= (bitn x k) 0)
-                (<= y (expt 2 k)))
-           (equal (bitn (+ (bits x k 0) (bits y k 0))
-                        (1+ k))
-                  0))
-  :hints (("Goal" :in-theory (enable bvecp) ; for bvecp-bitn-0
-           :use bits-sum-swallow-1-1-1))
-  :rule-classes nil)
-
-(local-defthm bits-sum-swallow-1-2
-  (implies (and (natp y)
-                (natp k)
-                (>= i k)
-                (<= y (expt 2 k)))
-           (equal (bits y i (1+ k))
-                  0))
-  :hints (("Goal" :in-theory (enable bvecp-bits-0 bvecp)
-           :expand ((expt 2 (1+ k))))))
-
-(local-defthm bits-sum-swallow-1
-  (implies (and (natp x)
-                (natp y)
-                (natp k)
-                (>= i k)
-                (= (bitn x k) 0)
-                (<= y (expt 2 k)))
-            (equal (bits (+ x y) i (1+ k))
-                   (bits x i (1+ k))))
-  :hints (("Goal" :use ((:instance bits-sum-original (j (1+ k)))
-                        bits-sum-swallow-1-1))))
-
-(defthmd bits-sum-swallow
-  (implies (and (equal (bitn x k) 0)
-                (natp x)
-                (natp y)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (>= i j)
-                (> j k)
-                (>= k 0)
-                (<= y (expt 2 k)))
-           (equal (bits (+ x y) i j)
-                  (bits x i j)))
-  :hints (("Goal"
-           ;; We deliberately leave bits-bits enabled because we need another
-           ;; instance of it too.
-           :use ((:instance bits-bits
-                            (x (+ x y))
-                            (i i)
-                            (j (1+ k))
-                            (k (1- (- i k)))
-                            (l (1- (- j k))))))))
-
-(defthmd bits-sum-of-bits
-  (implies (and (integerp x)
-                (integerp y)
-                (natp i))
-           (equal (bits (+ x (bits y i 0)) i 0)
-                  (bits (+ x y) i 0)))
-  :hints (("Goal" :use ((:instance bits-sum-original
-                                   (x x)
-                                   (y (bits y i 0))
-                                   (i i)
-                                   (j 0))
-                        (:instance bits-sum-original
-                                   (x x)
-                                   (y y)
-                                   (i i)
-                                   (j 0))))))
-
-(defthm bits-sum-3-original
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp z)
-                (integerp i)
-                (integerp j))
-           (equal (bits (+ x y z) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bits z i j)
-                           (bitn (+ (bits x (1- j) 0) (bits y (1- j) 0))
-                                 j)
-                           (bitn (+ (bits (+ x y) (1- j) 0) (bits z (1- j) 0))
-                                 j))
-                        (- i j) 0)))
-  :hints (("Goal" :use ((:instance bits-sum-original
-                                   (x x)
-                                   (y y)
-                                   (i (1- j))
-                                   (j 0))
-                        (:instance bits-sum-original
-                                   (x x)
-                                   (y y)
-                                   (i i)
-                                   (j j))
-                        (:instance bits-sum-original
-                                   (x (+ x y))
-                                   (y z)
-                                   (i i)
-                                   (j j))
-                        (:instance bits-sum-of-bits
-                                   (x (+ (bits z i j)
-                                         (bitn (+ (bits z (1- j) 0)
-                                                  (bits (+ x y) (1- j) 0))
-                                               j)))
-                                   (y (+ (bits x i j)
-                                         (bits y i j)
-                                         (bitn (+ (bits x (1- j) 0)
-                                                  (bits y (1- j) 0))
-                                               j)))
-                                   (i (+ i (* -1 j)))))))
-  :rule-classes ())
-
-(local-defthm bits-sum-3-with-gen-normal-case
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp z)
-                (integerp i)
-                (integerp j)
-                (< 0 j))
-           (equal (bits (+ x y z) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bits z i j)
-                           (gen x y (1- j) 0)
-                           (gen (+ x y) z (1- j) 0))
-                        (- i j) 0)))
-  :hints (("Goal" :use bits-sum-3-original
-           :in-theory (enable gen-val-cor1)))
-  :rule-classes ())
-
-(local-defthm bits-sum-3-with-gen-numberp-not-integerp-i
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp z)
-                (integerp j)
-                (acl2-numberp i)
-                (not (integerp i)))
-           (equal (bits (+ x y z) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bits z i j)
-                           (gen x y (1- j) 0)
-                           (gen (+ x y) z (1- j) 0))
-                        (- i j) 0)))
-  :hints (("Goal" :use (bits-sum-3-original bits-sum-3-with-gen-normal-case)
-           :in-theory (enable bits-with-i-not-an-integer
-                              bits-with-j-not-an-integer)))
-  :rule-classes ())
-
-(local-defthm bits-sum-3-with-gen-not-numberp-i-positive-j
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp z)
-                (integerp j)
-                (> j 0)
-                (not (acl2-numberp i)))
-           (equal (bits (+ x y z) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bits z i j)
-                           (gen x y (1- j) 0)
-                           (gen (+ x y) z (1- j) 0))
-                        (- i j) 0)))
-  :hints (("Goal" :use (bits-sum-3-original bits-sum-3-with-gen-normal-case)
-           :in-theory (enable bits-with-i-not-an-integer
-                              bits-with-j-not-an-integer)))
-  :rule-classes ())
-
-(local-defthm bits-sum-3-with-gen-not-numberp-i-not-positive-j
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp z)
-                (integerp j)
-                (<= j 0)
-                (not (acl2-numberp i)))
-           (equal (bits (+ x y z) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bits z i j)
-                           (gen x y (1- j) 0)
-                           (gen (+ x y) z (1- j) 0))
-                        (- i j) 0)))
-  :hints (("Goal" :use (bits-sum-3-original bits-sum-3-with-gen-normal-case)
-           :in-theory (enable bits-with-i-not-an-integer
-                              bits-with-j-not-an-integer)))
-  :rule-classes ())
-
-(defthm bits-sum-3
-  (implies (and (integerp x) (integerp y) (integerp z))
-           (equal (bits (+ x y z) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bits z i j)
-                           (gen x y (1- j) 0)
-                           (gen (+ x y) z (1- j) 0))
-                        (- i j) 0)))
-  :hints (("Goal" :use (bits-sum-3-original bits-sum-3-with-gen-normal-case
-                                   bits-sum-3-with-gen-numberp-not-integerp-i
-                                   bits-sum-3-with-gen-not-numberp-i-positive-j
-                                   bits-sum-3-with-gen-not-numberp-i-not-positive-j)
-           :in-theory (enable bits-with-j-not-an-integer)))
-  :rule-classes ())
-
-; Proof of lior0-slice:
-
-; Note that (2^i - 2^j) = 2^j(2^(i-j)-1) = {2^(i-j)-1,j'b0}
-
-; x[n-1:0] | (2^i - 2^j) =
-; {x[n-1:i], x[i-1:j], x[j-1:0]} | {(n-i)'b0, 2^(i-j), j'b0} =
-; [by LIOR0-CAT, LIOR0-0, and LIOR0-ONES]
-; {{x[n-1:i], 2^(i-j)-1, x[j-1:0]}.
-
-(local-defthm lior0-slice-1
-  (implies (and (<= j i)
-                (<= i n)
-                (integerp n)
-                (integerp i)
-                (integerp j)
-                (<= 0 j))
-           (equal (cat (bits x (1- n) i) (- n i)
-                       (bits x (1- i) j) (- i j)
-                       (bits x (1- j) 0) j)
-                  (bits x (1- n) 0)))
-  :hints (("Goal" :use ((:instance cat-bits-bits
-                                   (x (bits x (1- i) 0))
-                                   (i (1- i))
-                                   (j j)
-                                   (k (1- j))
-                                   (l 0)
-                                   (m (- i j))
-                                   (n j))
-                        (:instance cat-bits-bits
-                                   (x x)
-                                   (i (1- n))
-                                   (j i)
-                                   (k (1- i))
-                                   (l 0)
-                                   (m (- n i))
-                                   (n i)))))
-  :rule-classes nil)
-
-(local-defthm bvecp-power-of-2-minus-1
-  (implies (and (integerp k)
-                (equal k k2)
-                (< 0 k))
-           (bvecp (1- (expt 2 k))
-                  k2))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-(local-defthm bvecp-power-of-2-minus-1-alt
-  (implies (and (natp k)
-                (equal k2 (1+ k)))
-           (bvecp (1- (* 2 (expt 2 k)))
-                  k2))
-  :hints (("Goal" :in-theory (enable bvecp expt))))
-
-(local-defthm lior0-slice-2
-  (implies (and (<= j i)
-                (<= i n)
-                (integerp n)
-                (integerp i)
-                (integerp j)
-                (<= 0 j))
-           (equal (cat 0                     (- n i)
-                       (1- (expt 2 (- i j))) (- i j)
-                       0                     j)
-                  (- (expt 2 i) (expt 2 j))))
-  ;; The following hint is very weird!!  It can't be on Goal or Goal'.  The
-  ;; idea came from a proof-checker proof.  I should investigate....
-  :hints (("Goal''" :in-theory (enable cat expt)))
-  :rule-classes nil)
-
-(local
- (defthmd lior0-slice-3-1
-   (implies (and (<= j i)
-                 (integerp i)
-                 (integerp j)
-                 (<= 0 j)
-                 (equal k (1- (expt 2 (- i j))))
-                 (equal diff (- i j)))
-            (equal (lior0 k
-                         (bits x (1- i) j)
-                         diff)
-                   (1- (expt 2 (- i j)))))
-   :hints (("Goal" :use ((:instance lior0-ones
-                                    (x (bits x (1- i) j))
-                                    (n (- i j))))))))
-
-(local-defthm lior0-slice-3
-  (implies (and (<= j i)
-		(<= i n)
-		(integerp n)
-		(integerp i)
-		(integerp j)
-		(<= 0 j))
-	   (equal (lior0 (cat (bits x (1- n) i) (- n i)
-                             (bits x (1- i) j) (- i j)
-                             (bits x (1- j) 0) j)
-                        (cat 0                     (- n i)
-                             (1- (expt 2 (- i j))) (- i j)
-                             0                     j)
-                        n)
-                  (cat (bits x (1- n) i)     (- n i)
-                       (1- (expt 2 (- i j))) (- i j)
-                       (bits x (1- j) 0)     j)))
-  :hints (("Goal" :in-theory (e/d (lior0-cat lior0-slice-3-1)
-                                  (cat-bits-bits cat-0))
-           :cases ((and (equal j i) (equal j 0) (equal i n))
-                   (and (equal j i) (not (equal j 0)) (equal i n))
-                   (and (not (equal j i)) (equal j 0) (equal i n))
-                   (and (equal j i) (equal j 0) (not (equal i n)))
-                   (and (equal j i) (not (equal j 0)) (not (equal i n)))
-                   (and (not (equal j i)) (equal j 0) (not (equal i n)))
-                   (and (not (equal j i)) (not (equal j 0)) (not (equal i n))))))
-  :rule-classes nil)
-
-(local-defthm lior0-slice-almost
-  (implies (and (<= j i)
-		(<= i n)
-		(integerp n)
-		(integerp i)
-		(integerp j)
-		(<= 0 j))
-	   (equal (lior0 (bits x (1- n) 0)
-                        (- (expt 2 i) (expt 2 j))
-                        n)
-		  (cat (bits x (1- n) i)     (- n i)
-                       (1- (expt 2 (- i j))) (- i j)
-                       (bits x (1- j) 0)     j)))
-  :hints (("Goal" :use (lior0-slice-1 lior0-slice-2 lior0-slice-3)
-           :in-theory (theory 'ground-zero)))
-  :rule-classes nil)
-
-(defthmd lior0-slice
-  (implies (and (<= j i)
-		(<= i n)
-		(integerp n)
-		(integerp i)
-		(integerp j)
-		(<= 0 j))
-	   (equal (lior0 x
-                        (- (expt 2 i) (expt 2 j))
-                        n)
-		  (cat (bits x (1- n) i)     (- n i)
-                       (1- (expt 2 (- i j))) (- i j)
-                       (bits x (1- j) 0)     j)))
-  :hints (("Goal" :use (lior0-slice-almost)
-           :in-theory (enable lior0-bits-1))))
-
-(local (in-theory (theory 'lib-top1)))
-
-(local-defthm lxor0-1-not-2
-  (equal (equal 2 (lxor0 i j 1))
-         nil)
-  :hints (("Goal" :expand ((lxor0 i j 1))
-           :use ((:instance acl2::bvecp-1-rewrite
-                            (acl2::x (bitn i 0)))
-                 (:instance acl2::bvecp-1-rewrite
-                            (acl2::x (bitn j 0)))))))
-
-(local
- (encapsulate
-  ()
-
-  (local-defthm bitn-of-1-less-than-power-of-2-lemma-1
-    (implies (natp j)
-             (equal (bitn (1- (expt 2 (1+ j))) j)
-                    1))
-    :hints (("Goal" :in-theory (enable acl2::bvecp-bitn-1 bvecp)
-             :expand ((expt 2 (+ 1 j))))))
-
-  (defthm bitn-of-1-less-than-power-of-2
-    (implies (and (integerp i)
-                  (natp j)
-                  (< j i))
-             (equal (bitn (1- (expt 2 i)) j)
-                    1))
-    :hints (("Goal" :use ((:instance acl2::bitn-plus-mult
-                                     (acl2::x (1- (expt 2 (1+ j))))
-                                     (acl2::k (1- (expt 2 (- i (1+ j)))))
-                                     (acl2::m (1+ j))
-                                     (acl2::n j))))))))
-                                   
-(local-defun prop-as-lxor0-thm (i j x y)
-  (implies (and (natp i)
-                (natp j)
-                (<= j i)
-                (natp x)
-                (natp y))
-           (equal (prop x y i j)
-                  (log= (lxor0 (bits x i j) (bits y i j) (1+ (- i j)))
-                        (1- (expt 2 (1+ (- i j))))))))
-
-(local-defthm prop-as-lxor0-thm-proved-1
-  (implies (not (and (natp i) (natp j) (<= j i)))
-           (prop-as-lxor0-thm i j x y)))
-
-(local-defthm prop-as-lxor0-thm-proved-3-1
-  (implies (and (integerp i)
-                (<= 0 i)
-                (integerp j)
-                (<= 0 j)
-                (<= j i)
-                (equal (bitn x i) (bitn y i))
-                (integerp x)
-                (<= 0 x)
-                (integerp y)
-                (<= 0 y))
-           (not (equal (bitn (+ -1 (expt 2 (+ 1 i (* -1 j)))) (- i j))
-                       (bitn (lxor0 (bits x i j)
-                                   (bits y i j)
-                                   (+ 1 i (* -1 j)))
-                             (- i j)))))
-  :rule-classes nil)
-
-(local-defthm prop-as-lxor0-thm-proved-3
-  (implies (and (and (natp i) (natp j) (<= j i))
-                (= (bitn x i) (bitn y i)))
-           (prop-as-lxor0-thm i j x y))
-  :hints (("Goal" :use prop-as-lxor0-thm-proved-3-1
-           :in-theory (e/d (log=)
-                           (bitn-of-1-less-than-power-of-2)))))
-
-(local (in-theory (enable bvecp-0)))
-
-(local-defthm prop-as-lxor0-thm-proved-2
-  (implies (and (and (natp i) (natp j) (<= j i))
-                (not (= (bitn x i) (bitn y i)))
-                (prop-as-lxor0-thm (+ -1 i) j x y))
-           (prop-as-lxor0-thm i j x y))
-  :hints (("Goal" :in-theory (enable log=)
-           :expand ((expt 2 (+ 1 i (* -1 j))))
-           :use ((:instance acl2::bitn-plus-bits (acl2::m 0)
-                            (n (- i j))
-                            (acl2::x (lxor0 (bits x i j)
-                                           (bits y i j)
-                                           (+ 1 i (* -1 j)))))
-                 (:instance acl2::bvecp-1-rewrite
-                            (acl2::x (bitn x i)))
-                 (:instance acl2::bvecp-1-rewrite
-                            (acl2::x (bitn y i)))
-                 (:instance acl2::bvecp-1-rewrite
-                            (acl2::x (bitn x 0)))
-                 (:instance acl2::bvecp-1-rewrite
-                            (acl2::x (bitn y 0)))))))
-
-(local-defthm prop-as-lxor0-thm-proved
-  (prop-as-lxor0-thm i j x y)
-  :hints (("Goal" :induct (prop x y i j)
-           :in-theory (disable prop-as-lxor0-thm)))
-  :rule-classes nil)
-
-(defthmd prop-as-lxor0
-  (implies (and (natp i)
-                (natp j)
-                (<= j i)
-                (natp x)
-                (natp y))
-           (equal (prop x y i j)
-                  (log= (lxor0 (bits x i j) (bits y i j) (1+ (- i j)))
-                        (1- (expt 2 (1+ (- i j)))))))
-  :hints (("Goal" :use prop-as-lxor0-thm-proved)))
-
-; Added for rel5: bitn-neg
-
-(local-defthm bitn-neg-1
-  (implies (natp x)
-           (equal (bitn x -1) 0))
-  :hints (("Goal" :use ((:instance bits-times-2 (x x) (i 0) (j 0))
-                        (:instance bitn-rec-0 (x (* 2 x))))
-           :in-theory (e/d (bitn) (bits-n-n-rewrite)))))
-
-(local-defun bitn-neg-induction (x n)
-  (if (zp n)
-      (+ x n)
-    (bitn-neg-induction (* 2 x) (1- n))))
-
-(defthm bitn-neg-alt
-  (implies (and (natp x)
-                (integerp k)
-                (< 0 k))
-           (equal (bitn x (* -1 k)) 0))
-  :hints (("Goal" :induct (bitn-neg-induction x k))
-          ("Subgoal *1/2.1"
-           :use ((:instance bits-times-2 (x x) (i (- 1 k)) (j (- 1 k)))))))
diff -Nru acl2-6.2/books/rtl/rel5/support/fadd.lisp acl2-6.3/books/rtl/rel5/support/fadd.lisp
--- acl2-6.2/books/rtl/rel5/support/fadd.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/fadd.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1204 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "stick"))
-(local (include-book "lop3"))
-(local (include-book "add3"))
-(local (include-book "bitn"))
-(local (include-book "bits"))
-(local (include-book "../arithmetic/top"))
-
-(include-book "rtl") ; need definition of, at least, bitn
-(include-book "float")
-
-;;;**********************************************************************
-;;;                     GENERATE AND PROPAGATE
-;;;**********************************************************************
-
-;;Once the lemmas below are in place, the lemmas BITS-SUM-ORIGINAL, 
-;;BITS-SUM-SPECIAL-CASE, and BITS-SUM-PLUS-1-ORIGINAL of book "bits" should be
-;;deleted.
-
-(defun gen (x y i j)
-; generates a carry
-  (declare (xargs :measure (nfix (1+ i))))
-  (if (and (natp i) (natp j) (>= i j))
-      (if (= (bitn x i) (bitn y i))
-	  (bitn x i)
-	(gen x y (1- i) j))
-    0))
-
-(defun prop (x y i j)
-; propagates a carry-in from below
-  (declare (xargs :measure (nfix (1+ i))))
-  (if (and (natp i) (natp j) (>= i j))
-      (if (= (bitn x i) (bitn y i))
-	  0
-	(prop x y (1- i) j))
-    1))
-
-(local (in-theory (enable bits-n-n-rewrite)))
-
-(encapsulate
- ()
-
- (local
-  (defthm gen-val-lemma-1
-    (implies (not (equal (bitn x i) (bitn y i)))
-             (equal (< (+ (bits x i j) (bits y i j))
-                       (expt 2 (+ 1 i (* -1 j))))
-                    (< (+ (bits x (1- i) j)
-                          (bits y (1- i) j))
-                       (expt 2 (+ i (* -1 j))))))
-    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
-             :use ((:instance bitn-plus-bits
-                              (x x)
-                              (n i)
-                              (m j))
-                   (:instance bitn-plus-bits
-                              (x y)
-                              (n i)
-                              (m j)))))))
-
- (local
-  (defthm gen-val-lemma-2
-    (implies (and (equal (bitn x i) 0)
-                  (equal (bitn y i) 0))
-             (< (+ (bits x i j) (bits y i j))
-                (expt 2 (+ 1 i (* -1 j)))))
-    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
-             :use ((:instance bitn-plus-bits
-                              (x x)
-                              (n i)
-                              (m j))
-                   (:instance bitn-plus-bits
-                              (x y)
-                              (n i)
-                              (m j)))))))
-
- (local
-  (defthm gen-val-lemma-3
-    (implies (and (integerp j)
-                  (<= j i)
-                  (equal (bitn x i) 1)
-                  (equal (bitn y i) 1))
-             (>= (+ (bits x i j) (bits y i j))
-                 (expt 2 (+ 1 i (* -1 j)))))
-    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
-             :use ((:instance bitn-plus-bits
-                              (x x)
-                              (n i)
-                              (m j))
-                   (:instance bitn-plus-bits
-                              (x y)
-                              (n i)
-                              (m j)))))))
-
- (defthmd gen-val
-   (implies (and (natp j) (>= i j))
-            (equal (gen x y i j)
-                   (if (>= (+ (bits x i j) (bits y i j))
-                           (expt 2 (1+ (- i j))))
-                       1
-                     0)))))
-
-(encapsulate
- ()
-
- (local
-  (defthm prop-val-lemma-1
-    (implies (and (integerp j)
-                  (<= j i)
-                  (not (equal (bitn x i) (bitn y i))))
-             (equal (equal (+ 1 (bits x i j) (bits y i j))
-                           (expt 2 (+ 1 i (* -1 j))))
-                    (equal (+ 1 (bits x (1- i) j)
-                              (bits y (1- i) j))
-                           (expt 2 (+ i (* -1 j))))))
-    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
-             :use ((:instance bitn-plus-bits
-                              (x x)
-                              (n i)
-                              (m j))
-                   (:instance bitn-plus-bits
-                              (x y)
-                              (n i)
-                              (m j)))))))
-
- (local
-  (defthm prop-val-lemma-2
-    (implies (and (integerp i)
-                  (integerp j)
-                  (<= j i)
-                  (equal (bitn x i) (bitn y i)))
-             (not (equal (+ 1 (bits x i j) (bits y i j))
-                         (expt 2 (+ 1 i (* -1 j))))))
-    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
-             :use ((:instance bitn-plus-bits
-                              (x x)
-                              (n i)
-                              (m j))
-                   (:instance bitn-plus-bits
-                              (x y)
-                              (n i)
-                              (m j)))))))
-
- (defthmd prop-val
-   (implies (and (integerp i) (natp j) (>= i j))
-            (equal (prop x y i j)
-                   (if (= (+ (bits x i j) (bits y i j))
-                          (1- (expt 2 (1+ (- i j)))))
-                       1
-                     0)))))
-
-(local
- (defthmd bits-split-rewrite
-   (implies (and (natp i)
-                 (natp j)
-                 (natp k)
-                 (< j k)
-                 (<= k i))
-            (equal (bits x i j)
-                   (+ (* (expt 2 (- k j))
-                         (bits x i k))
-                      (bits x (1- k) j))))
-   :hints (("Goal"
-            :in-theory (e/d (cat) (cat-bits-bits))
-            :use ((:instance cat-bits-bits
-                             (x x)
-                             (i i)
-                             (j k)
-                             (k (1- k))
-                             (l j)
-                             (m (1+ (- i j)))
-                             (n (+ (- j) k))))))))
-
-(local
- (defthm gen-extend-1
-   (implies (and (natp j)
-                 (integerp k)
-                 (> i k)
-                 (>= k j)
-                 (equal (gen x y i (1+ k)) 1))
-            (equal (gen x y i j)
-                   (lior0 (gen x y i (1+ k))
-                         (land0 (prop x y i (1+ k))
-                               (gen x y k j)
-                               1)
-                         1)))
-   :rule-classes ()))
-
-(local
- (defthm gen-extend-2
-   (implies (and (> i k)
-                 (>= k j)
-                 (equal (gen x y i (1+ k)) 0)
-                 (equal (prop x y i (1+ k)) 0))
-            (equal (gen x y i j)
-                   (lior0 (gen x y i (1+ k))
-                         (land0 (prop x y i (1+ k))
-                               (gen x y k j)
-                               1)
-                         1)))
-   :rule-classes ()))
-
-(local
- (defthmd hack-2
-   (implies (and (integerp i)
-                 (integerp j)
-                 (integerp k)
-                 (> i k)
-                 (> k j))
-            (equal (expt 2 (+ i (* -1 j)))
-                   (* (expt 2 (+ i (* -1 k)))
-                      (expt 2 (+ k (* -1 j))))))))
-
-(local
- (defthm expt-open-+1
-   (implies (force (natp n))
-            (equal (expt 2 (1+ n))
-                   (* 2 (expt 2 n))))))
-
-(local
- (defthm gen-extend-3-k=j
-   (implies (and (integerp i)
-                 (> i j)
-                 (equal (gen x y i (1+ j)) 0)
-                 (equal (prop x y i (1+ j)) 1))
-            (equal (gen x y i j)
-                   (lior0 (gen x y i (1+ j))
-                         (land0 (prop x y i (1+ j))
-                               (gen x y j j)
-                               1)
-                         1)))
-   :hints (("Goal" :in-theory (enable bits-split-rewrite hack-2 gen-val prop-val)
-            :restrict ((bits-split-rewrite ((x x) (i i) (j j) (k (1+ j)))
-                                           ((x y) (i i) (j j) (k (1+ j)))))))
-   :rule-classes ()))
-
-(local
- (defthm gen-extend-3-k>j
-   (implies (and (integerp i)
-                 (integerp k)
-                 (> i k)
-                 (> k j)
-                 (equal (gen x y i (1+ k)) 0)
-                 (equal (prop x y i (1+ k)) 1))
-            (equal (gen x y i j)
-                   (lior0 (gen x y i (1+ k))
-                         (land0 (prop x y i (1+ k))
-                               (gen x y k j)
-                               1)
-                         1)))
-   :hints (("Goal" :in-theory (enable bits-split-rewrite hack-2 gen-val prop-val)
-            :restrict ((bits-split-rewrite ((x x) (i i) (j j) (k (1+ k)))
-                                           ((x y) (i i) (j j) (k (1+ k)))))))
-   :rule-classes ()))
-
-(local
- (defthm gen-extend-3
-   (implies (and (integerp i)
-                 (integerp k)
-                 (> i k)
-                 (>= k j)
-                 (equal (gen x y i (1+ k)) 0)
-                 (equal (prop x y i (1+ k)) 1))
-            (equal (gen x y i j)
-                   (lior0 (gen x y i (1+ k))
-                         (land0 (prop x y i (1+ k))
-                               (gen x y k j)
-                               1)
-                         1)))
-   :hints (("Goal" :use (gen-extend-3-k>j gen-extend-3-k=j)))
-   :rule-classes ()))
-
-(local
- (defthm gen-is-0-or-1
-   (implies (not (equal (gen x y i k) 0))
-            (equal (gen x y i k) 1))
-   :hints (("Goal" :in-theory (enable gen-val)))
-   :rule-classes ((:forward-chaining :trigger-terms ((gen x y i k))))))
-
-(local
- (defthm prop-is-0-or-1
-   (implies (not (equal (prop x y i k) 0))
-            (equal (prop x y i k) 1))
-   :hints (("Goal" :in-theory (enable prop-val)))
-   :rule-classes ((:forward-chaining :trigger-terms ((prop x y i k))))))
-
-(defthmd gen-extend-original
-  (implies (and (integerp i)
-                (integerp j)
-                (integerp k)
-                (> i k)
-                (>= k j)
-                (>= j 0))
-           (equal (lior0 (gen x y i (1+ k))
-                        (land0 (gen x y k j)
-                              (prop x y i (1+ k))
-                              1)
-                        1)
-                  (gen x y i j)))
-  :hints (("Goal" :use (gen-extend-1 gen-extend-2 gen-extend-3))))
-
-(local
- (defthmd bitn-1-iff-at-least-2^n
-   (implies (and (integerp n)
-                 (bvecp x (1+ n)))
-            (equal (bitn x n)
-                   (if (< x (expt 2 n))
-                       0
-                     1)))
-   :hints (("Goal" :in-theory (enable bvecp)
-            :use ((:instance bitn-plus-bits
-                             (x x)
-                             (n n)
-                             (m 0)))))))
-
-(local
- (defthm bvecp-+
-   (implies (and (not (zp k))
-                 (equal n (1- k))
-                 (bvecp x n)
-                 (bvecp y n))
-            (bvecp (+ x y) k))
-   :hints (("Goal" :in-theory (enable bvecp)
-            :expand ((expt 2 k))))))
-
-(local
- (defthm bvecp-+-1
-   (implies (and (not (zp k))
-                 (equal n (1- k))
-                 (bvecp x n)
-                 (bvecp y n))
-            (bvecp (+ 1 x y) k))
-   :hints (("Goal" :in-theory (enable bvecp)
-            :expand ((expt 2 k))))))
-
-(local
- (defthmd integerp-expt-2-forced
-   (implies (and (force (integerp n))
-                 (force (<= 0 n)))
-            (and (integerp (expt 2 n))
-                 (< 0 (expt 2 n))))
-   :rule-classes :type-prescription))
-
-(defthm gen-extend-cor
-  (implies (and (natp x)
-                (natp y)
-                (natp i)
-                (natp j)
-                (natp k)
-                (> i k)
-                (>= k j))
-           (equal (gen x y i j)
-                  (bitn (+ (bits x i (1+ k))
-                           (bits y i (1+ k))
-                           (gen x y k j))
-                        (- i k))))
-  :hints (("Goal" :use gen-extend-original
-           :in-theory (enable integerp-expt-2-forced bitn-1-iff-at-least-2^n
-                              gen-val prop-val)))
-  :rule-classes ())
-
-(local
- (defthm prop-extend-1
-   (implies (and (integerp j)
-                 (integerp k)
-                 (> i k)
-                 (>= k j)
-                 (equal (prop x y i j) 0))
-            (equal (prop x y i j)
-                   (land0 (prop x y i (1+ k))
-                         (prop x y k j)
-                         1)))
-   :rule-classes nil))
-
-(local
- (defthm prop-extend-2
-   (implies (and (integerp i)
-                 (integerp j)
-                 (> i k)
-                 (>= k j)
-                 (>= j 0)
-                 (equal (prop x y i j) 1))
-            (equal (prop x y i j)
-                   (land0 (prop x y i (1+ k))
-                         (prop x y k j)
-                         1)))
-   :rule-classes nil))
-
-(defthm prop-extend-original
-  (implies (and (integerp i)
-                (integerp j)
-                (integerp k)
-                (> i k)
-                (>= k j)
-                (>= j 0))
-           (equal (prop x y i j)
-                  (land0 (prop x y i (1+ k))
-                        (prop x y k j)
-                        1)))
-  :hints (("Goal" :use (prop-extend-1 prop-extend-2)))
-  :rule-classes ())
-
-(defthm gen-special-case-original
-  (implies (and (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0)
-                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
-           (equal (gen x y i j)
-                  (lior0 (bitn x i) (bitn y i) 1)))
-  :hints (("Goal" :in-theory (enable gen-val)
-           :use ((:instance bitn-plus-bits (x x) (n i) (m j))
-                 (:instance bitn-plus-bits (x y) (n i) (m j)))))
-  :rule-classes ())
-
-(defthm land0-gen-0
-  (implies (and (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0)
-                (= (land0 (bits x i j) (bits y i j) (1+ (- i j))) 0))
-           (equal (gen x y i j) 0))
-  :hints (("Goal" :in-theory (enable gen-val)
-           :use ((:instance add-2-original
-                            (x (bits x i j))
-                            (y (bits y i j))
-                            (n (1+ (- i j))))))))
-
-(defthmd gen-val-cor1
-  (implies (natp j)
-           (equal (gen x y i j)
-                  (bitn (+ (bits x i j)
-                           (bits y i j))
-                        (1+ (- i j)))))
-  :hints (("Goal" :in-theory (enable bitn-1-iff-at-least-2^n gen-val))))
-
-(defthm bits-sum-original ; from merge.lisp
-  (implies (and (integerp x)
-                (integerp y)
-                )
-           (equal (bits (+ x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bitn (+ (bits x (1- j) 0)
-                                    (bits y (1- j) 0))
-                                 j))
-                        (- i j)
-                        0)))
-  :rule-classes ())
-
-(local
- (defthm bits-sum-with-gen-normal-case
-   (implies (and (integerp x)
-                 (integerp y)
-                 (integerp j)
-                 (< 0 j))
-            (equal (bits (+ x y) i j)
-                   (bits (+ (bits x i j)
-                            (bits y i j)
-                            (gen x y (1- j) 0))
-                         (- i j) 0)))
-   :hints (("Goal" :use bits-sum-original
-            :in-theory (e/d (gen-val-cor1)
-                            ;; the disables below are optional but they speed up
-                            ;; the proof by orders of magnitude
-                            (bits-upper-bound
-                             bits-less-than-x-gen
-                             bits-less-than-x
-                             bits-reduce-exactp
-                             bits-sum-drop-irrelevant-term-2-of-2
-                             bits-tail
-                             bits-upper-bound-tighter
-                             bits-sum-drop-irrelevant-term-1-of-2
-                             bits-split-around-zero))))
-   :rule-classes ()))
-
-(defthm bits-sum
-  (implies (and (integerp x) (integerp y))
-           (equal (bits (+ x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (gen x y (1- j) 0))
-                        (- i j) 0)))
-  :hints (("Goal" :use (bits-sum-original bits-sum-with-gen-normal-case)))
-  :rule-classes ())
-
-(local
- (defthm bits-sum-special-case ; from merge.lisp
-   (implies (and (= (bits (+ x y) (1- j) 0) 0)
-                 (integerp x)
-                 (integerp y)
-                 (>= j 0)
-                 )
-            (equal (bits (+ x y) i j)
-                   (bits (+ (bits x i j)
-                            (bits y i j) 
-                            (logior (bitn x (1- j)) (bitn y (1- j))))
-                         (- i j) 0)))
-   :rule-classes ()))
-
-; Start proof of land-gen-0-cor.
-
-(local
- (defthm binary-land0-is-preserved-by-slice
-   (implies (and (equal (binary-land0 x y n) 0)
-                 (< i n)
-                 (integerp n)
-                 (<= 0 j)
-                 (equal k (1+ (- i j))))
-            (equal (binary-land0 (bits x i j)
-                                (bits y i j)
-                                k)
-                   0))
-   :hints (("Goal" :use bits-land0
-            :in-theory (disable bits-land0)))))
-
-(local
- (defthm land0-0-implies-gen-0
-   (implies (and (equal (land0 x y n) 0)
-                 (> n j)
-                 (integerp n))
-            (equal (gen x y j 0)
-                   0))))
-
-(local
- (defthm bvecp-+-bits
-   (implies (and (equal (land0 x y n) 0)
-                 (> n i)
-                 (integerp n)
-                 (integerp i)
-                 (>= i j)
-                 (integerp j)
-                 (>= j 0)
-                 (equal k (1+ (- i j))))
-            (bvecp (+ (bits x i j) (bits y i j))
-                   k))
-   :hints (("Goal" :use ((:instance add-2-original
-                                    (x (bits x i j))
-                                    (y (bits y i j))
-                                    (n (1+ (- i j)))))))))
-
-(defthm land-gen-0-cor-original
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n i)
-                (>= i j)
-                (>= j 0)
-                (= (land0 x y n) 0))
-           (equal (bits (+ x y) i j)
-                  (+ (bits x i j) (bits y i j))))
-  :hints (("Goal" :use (bits-sum)))
-  :rule-classes ())
-
-(defthm bvecp-1-gen
-  (bvecp (gen x y i j) 1)
-  :hints (("Goal" :in-theory (enable bvecp)))
-  :rule-classes (:rewrite
-                 (:forward-chaining :trigger-terms ((gen x y i j)))))
-
-(defthm bvecp-1-prop
-  (bvecp (prop x y i j) 1)
-  :hints (("Goal" :in-theory (enable bvecp)))
-  :rule-classes (:rewrite
-                 (:forward-chaining :trigger-terms ((prop x y i j)))))
-
-(local
- (defthmd lior0-prop-gen-val-cor1
-   (implies (and (integerp x)
-                 (integerp y)
-                 (integerp j)
-                 (< 0 j))
-            (equal (lior0 (prop x y (1- j) 0)
-                         (gen x y (1- j) 0)
-                         1)
-                   (bitn (+ 1
-                            (bits x (1- j) 0)
-                            (bits y (1- j) 0))
-                         j)))
-   :hints (("Goal" :in-theory (enable prop-val gen-val bitn-1-iff-at-least-2^n
-                                      bvecp-1-gen)))))
-
-(defthm bits-sum-plus-1-original
-  (implies (and (integerp x)
-                (integerp y)
-                (natp i)
-                (natp j)
-                (>= i j)
-                (>= j 0))
-           (equal (bits (+ 1 x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bitn (+ 1
-                                    (bits x (1- j) 0)
-                                    (bits y (1- j) 0))
-                                 j))
-                        (- i j) 0)))
-  :rule-classes ())
-
-(local
- (defthm bits-sum-plus-1-with-prop-gen-normal
-   (implies (and (integerp x)
-                 (integerp y)
-                 (integerp i)
-                 (integerp j)
-                 (>= i j)
-                 (> j 0))
-            (equal (bits (+ 1 x y) i j)
-                   (bits (+ (bits x i j)
-                            (bits y i j)
-                            (lior0 (prop x y (1- j) 0) 
-                                  (gen x y (1- j) 0) 
-                                  1))
-                         (- i j) 0)))
-   :hints (("Goal" :use bits-sum-plus-1-original
-            :in-theory (e/d (lior0-prop-gen-val-cor1)
-                            ;; the disables below are optional but they speed up
-                            ;; the proof by orders of magnitude
-                            (bits-upper-bound
-                             bits-less-than-x-gen
-                             bits-less-than-x
-                             bits-reduce-exactp
-                             bits-sum-drop-irrelevant-term-2-of-2
-                             bits-tail
-                             bits-upper-bound-tighter
-                             bits-sum-drop-irrelevant-term-1-of-2
-                             bits-split-around-zero))))
-   :rule-classes ()))
-
-(defthm bits-sum-plus-1-with-prop-gen-original
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0))
-           (equal (bits (+ 1 x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (lior0 (prop x y (1- j) 0) 
-                                 (gen x y (1- j) 0) 
-                                 1))
-                        (- i j) 0)))
-  :hints (("Goal" :use (bits-sum-plus-1-original bits-sum-plus-1-with-prop-gen-normal)
-           :in-theory (e/d (lior0-prop-gen-val-cor1)
-                           ;; the disables below are optional but they speed up
-                           ;; the proof by orders of magnitude
-                           (bits-upper-bound
-                            bits-less-than-x-gen
-                            bits-less-than-x
-                            bits-reduce-exactp
-                            bits-sum-drop-irrelevant-term-2-of-2
-                            bits-tail
-                            bits-upper-bound-tighter
-                            bits-sum-drop-irrelevant-term-1-of-2
-                            bits-split-around-zero))))
-  :rule-classes ())
-
-;;;**********************************************************************
-;;;                     THREE-INPUT ADDITION
-;;;**********************************************************************
-
-(defthm add-3-original
-    (implies (and (not (zp n))
-		  (bvecp x n)
-		  (bvecp y n)
-		  (bvecp z n))
-	     (equal (+ x y z)
-		    (+ (lxor0 x (lxor0 y z n) n)
-		       (* 2 (lior0 (land0 x y n)
-				  (lior0 (land0 x z n)
-					(land0 y z n)
-					n)
-				  n)))))
-  :rule-classes ())
-
-(defthm add-2-original
-    (implies (and (not (zp n))
-		  (bvecp x n)
-		  (bvecp y n))
-	     (equal (+ x y)
-		    (+ (lxor0 x y n)
-		       (* 2 (land0 x y n)))))
-  :rule-classes ())
-
-
-;;;**********************************************************************
-;;;                    TRAILING ONE PREDICTION
-;;;**********************************************************************
-
-(defthm top-thm-1-original
-  (implies (and (natp n)
-                (natp k)
-                (< k n)
-                (integerp a)
-                (integerp b))
-           (equal (equal (bits (+ a b 1) k 0) 0)
-		  (equal (bits (lnot (lxor0 a b n) n) k 0) 0)))
-  :rule-classes ())
-
-(defund sigm-0 (a b c n)
-  (if (= c 0)
-      (lnot (lxor0 a b n) n)
-    (lxor0 a b n)))
-
-(defund kap-0 (a b c n)
-  (if (= c 0)
-      (* 2 (lior0 a b n))
-    (* 2 (land0 a b n))))
-
-(defund tau-0 (a b c n)
-  (lnot (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (1+ n)) (1+ n)))
-
-(defthm bvecp-sigm-0
-  (bvecp (sigm-0 a b c n) n)
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm-0 a b c n)))))
-
-(defthm bvecp-kap-0
-  (implies (and (integerp n) (<= 0 n))
-           (bvecp (kap-0 a b c n) (1+ n)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap-0 a b c n)))))
-
-(defthm bvecp-tau-0
-  (bvecp (tau-0 a b c n) (1+ n))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau-0 a b c n)))))
-
-(local (include-book "lextra0")) ; for lnot-lxor0
-
-(defthm top-thm-2-old
-  (implies (and (natp n)
-                (integerp a)
-                (integerp b)
-                (natp k)
-                (< k n)
-                (or (equal c 0) (equal c 1)))
-           (equal (equal (bits (+ a b c) k 0) 0)
-		  (equal (bits (tau-0 a b c n) k 0) 0)))
-  :rule-classes ())
-
-(encapsulate ()
-
-(local
- (defthm top-thm-2-0
-   (implies (and (natp n)
-                 (integerp a)
-                 (integerp b)
-                 (natp k)
-                 (< k n))
-            (equal (equal (bits (+ a b) k 0) 0)
-                   (equal (bits (lxor0 (lxor0 a b n) 
-                                      (cat (lior0 a b n) n 0 1)
-                                      (1+ n)) 
-                                k 0) 
-                          0)))
-   :hints (("Goal"
-            :expand ((:free (x y) (cat x n y 1)))
-            :use
-            ((:instance top-thm-2-old (c 0))
-             (:instance lnot-lxor0
-                        (x (lnot (binary-lxor0 (bits a k 0)
-                                              (bits b k 0)
-                                              (+ 1 k))
-                                 (+ 1 k)))
-                        (y (* 2
-                              (binary-lior0 (bits a (1- k) 0)
-                                           (bits b (1- k) 0)
-                                           k)))
-                        (n (+ 1 k))))
-            :in-theory (e/d (tau-0 kap-0 sigm-0 bitn-negative-bit-of-integer)
-                            (bitn-known-not-0-replace-with-1))))
-   :rule-classes ()))
-
-#|
-Proof of top-thm-2-1 from top-thm-2-0:
-
-Case 1: (bitn a 0) = (bitn b 0).  Then (bitn (+ a b 1) 0) = 1 by
-top-thm-1, so (bits (+ a b 1) k 0) != 0, by bits-plus-bitn.  We can also use
-bits-plus-bitn so that it suffices to show that bit 0 of the outermost lxor0
-call is 1, which is clear.
-
-Case 2: Without loss of generality, (bitn a 0) = 0 and (bitn b 0) = 1.  We want
-to apply top-thm-2-0 with a replaced by a+1.  Thus it suffices to prove:
-
-(lxor0 (lxor0 a b n)
-      (cat (lior0 a b n) n 1 1)
-      (1+ n))
-=
-(lxor0 (lxor0 (1+ a) b n) 
-      (cat (lior0 (1+ a) b n) n 0 1)
-      (1+ n))
-
-The key observation is that for all integers i, (bitn (1+ a) i) = (bitn a i)
-if i is positive, and (bitn (1+ a) 0) = 1.  {This follows from the fact that
-(bits (1+ a) m 0) = (cat (bits a m 1) m 1 1).}  By lemma
-sumbits-badguy-is-correct, it suffices to prove that the nth bit of each of the
-two sides above is the same for an arbitrary natp n.  We have rules for bitn of
-lxor0, cat, and lior0 that should make this proof pretty automatic.
-
-|# ; |
-
-(local
- (defthm top-thm-2-1-1-1
-   (implies (and (natp n)
-                 (integerp a)
-                 (integerp b)
-                 (natp k)
-                 (< k n)
-                 (equal (bitn a 0) (bitn b 0)))
-            (not (equal (bits (+ a b 1) k 0) 0)))
-   :hints (("Goal" :use ((:instance bits-plus-bitn
-                                    (x (+ a b 1))
-                                    (n k)
-                                    (m 0))
-                         (:instance top-thm-1-original
-                                    (k 0)))))
-   :rule-classes ()))
-
-(local (in-theory (disable bitn-known-not-0-replace-with-1)))
-
-(local
- (defthm top-thm-2-1-1-2-1
-   (implies (and (natp n)
-                 (integerp a)
-                 (integerp b)
-                 (natp k)
-                 (< k n)
-                 (equal (bitn a 0) (bitn b 0)))
-            (not (equal (bitn (bits (lxor0 (lxor0 a b n)
-                                          (cat (lior0 a b n) n 1 1)
-                                          (1+ n)) 
-                                    k 0)
-                              0)
-                        0)))
-   :hints (("Goal" :use ((:instance bits-plus-bitn
-                                    (x a)
-                                    (n k)
-                                    (m 0))
-                         (:instance bits-plus-bitn
-                                    (x b)
-                                    (n k)
-                                    (m 0))
-                         (:instance bvecp-1-rewrite
-                                    (x (bitn a 0)))
-                         (:instance bvecp-1-rewrite
-                                    (x (bitn b 0))))))
-   :rule-classes ()))
-
-(local
- (defthm top-thm-2-1-1-2
-   (implies (and (natp n)
-                 (integerp a)
-                 (integerp b)
-                 (natp k)
-                 (< k n)
-                 (equal (bitn a 0) (bitn b 0)))
-            (not (equal (bits (lxor0 (lxor0 a b n)
-                                    (cat (lior0 a b n) n 1 1)
-                                    (1+ n)) 
-                              k 0)
-                        0)))
-   :hints (("Goal" :use top-thm-2-1-1-2-1))
-   :rule-classes nil))
-
-(local
- (defthm top-thm-2-1-1
-   (implies (and (natp n)
-                 (integerp a)
-                 (integerp b)
-                 (natp k)
-                 (< k n)
-                 (equal (bitn a 0) (bitn b 0)))
-            (equal (equal (bits (+ a b 1) k 0) 0)
-                   (equal (bits (lxor0 (lxor0 a b n)
-                                      (cat (lior0 a b n) n 1 1)
-                                      (1+ n)) 
-                                k 0) 
-                          0)))
-   :hints (("Goal" :use (top-thm-2-1-1-1 top-thm-2-1-1-2)))
-   :rule-classes ()))
-
-; Start proof of top-thm-2-1-2-1.
-
-(local
- (encapsulate
-  ()
-
-  (local
-   (defthm top-thm-2-1-2-2-1-1-1-1
-     (implies (and (natp m)
-                   (< 0 m)
-                   (integerp a)
-                   (equal (bitn a 0) 0))
-              (equal (land0 1 a m)
-                     0))
-     :hints (("Goal" :use ((:instance land0-slice (x a) (i 1) (j 0) (n m)))))))
-
-  (local
-   (defthm top-thm-2-1-2-2-1-1-1
-     (implies (and (natp m)
-                   (<= 0 m)
-                   (integerp a)
-                   (equal (bitn a 0) 0))
-              (equal (bits (1+ a) m 0)
-                     (cat (bits a m 1) m 1 1)))
-     :hints (("Goal" :use ((:instance land-gen-0-cor-original
-                                      (x a)
-                                      (y 1)
-                                      (n (1+ m))
-                                      (i m)
-                                      (j 0))
-                           (:instance bits-plus-bitn
-                                      (x a)
-                                      (n m)
-                                      (m 0)))
-              :expand ((cat (bits a m 1) m 1 1))))))
-
-  (defthm top-thm-2-1-2-2-1-1
-    (implies (and (natp m)
-                  (<= 0 m)
-                  (integerp a)
-                  (equal (bitn a 0) 0))
-             (equal (bitn (bits (1+ a) m 0) m)
-                    (bitn (cat (bits a m 1) m 1 1) m)))
-    :rule-classes nil)))
-
-(local
- (defthm top-thm-2-1-2-2-1
-   (implies (and (natp m)
-                 (integerp a)
-                 (equal (bitn a 0) 0))
-            (equal (bitn (1+ a) m)
-                   (if (equal m 0)
-                       1
-                     (bitn a m))))
-   :hints (("Goal" :use top-thm-2-1-2-2-1-1))))
-
-(local
- (defthmd lxor0-lnot-1
-   (equal (lxor0 (lnot x n) y n)
-          (lnot (lxor0 x y n) n))
-   :hints (("Goal" :in-theory (enable lnot-lxor0)))))
-
-(local
- (defthmd lxor0-lnot-2
-   (equal (lxor0 y (lnot x n) n)
-          (lnot (lxor0 x y n) n))
-   :hints (("Goal" :in-theory (enable lnot-lxor0)))))
-
-(local
- (defthm top-thm-2-1-2-2
-   (implies (and (natp n)
-                 (integerp a)
-                 (integerp b)
-                 (natp k)
-                 (< k n)
-                 (equal (bitn a 0) 0)
-                 (equal (bitn b 0) 1))
-            (equal (lxor0 (lxor0 a b n)
-                         (cat (lior0 a b n) n 1 1)
-                         (1+ n))
-                   (lxor0 (lxor0 (1+ a) b n)
-                         (cat (lior0 (1+ a) b n) n 0 1)
-                         (1+ n))))
-   :hints (("Goal" :use ((:instance sumbits-badguy-is-correct
-                                    (x (lxor0 (lxor0 a b n)
-                                             (cat (lior0 a b n) n 1 1)
-                                             (1+ n)))
-                                    (y (lxor0 (lxor0 (1+ a) b n) 
-                                             (cat (lior0 (1+ a) b n) n 0 1)
-                                             (1+ n)))
-                                    (k (1+ n))))
-            :in-theory (enable lxor0-lnot-1 lxor0-lnot-2)))
-   :rule-classes ()))
-
-(local
- (defthm top-thm-2-1-2
-   (implies (and (natp n)
-                 (integerp a)
-                 (integerp b)
-                 (natp k)
-                 (< k n)
-                 (equal (bitn a 0) 0)
-                 (equal (bitn b 0) 1))
-            (equal (equal (bits (+ a b 1) k 0) 0)
-                   (equal (bits (lxor0 (lxor0 a b n)
-                                      (cat (lior0 a b n) n 1 1)
-                                      (1+ n)) 
-                                k 0) 
-                          0)))
-   :hints (("Goal" :use (top-thm-2-1-2-2
-                         (:instance top-thm-2-0
-                                    (a (1+ a))))))
-   :rule-classes ()))
-
-(local
- (defthm top-thm-2-1
-   (implies (and (natp n)
-                 (integerp a)
-                 (integerp b)
-                 (natp k)
-                 (< k n))
-            (equal (equal (bits (+ a b 1) k 0) 0)
-                   (equal (bits (lxor0 (lxor0 a b n)
-                                      (cat (lior0 a b n) n 1 1)
-                                      (1+ n)) 
-                                k 0) 
-                          0)))
-   :hints (("Goal" :use (top-thm-2-1-1
-                         top-thm-2-1-2
-                         (:Instance top-thm-2-1-2 (a b) (b a)))
-            ;; for efficiency only:
-            :in-theory (disable;;bits-cat
-                        bits-lxor0 ; important
-                        ;;bvecp-tighten
-                        bits-tail ; pretty impt
-                        power2-integer ; a little impt
-                        bits-sum-drop-irrelevant-term-2-of-2 ; barely impt
-                        ;;bits-reduce-exactp
-                        ;;expo-unique-eric-2
-                        ;;bits-split-around-zero
-                        )))
-   :rule-classes ()))
-
-(defthm top-thm-2-original
-  (implies (and (natp n)
-                (integerp a)
-                (integerp b)
-                (natp k)
-                (< k n)
-                (or (equal c 0) (equal c 1)))
-           (equal (equal (bits (+ a b c) k 0) 0)
-                  (equal (bits (lxor0 (lxor0 a b n) 
-                                     (cat (lior0 a b n) n c 1)
-                                     (1+ n)) 
-                               k 0) 
-                         0)))
-  :hints (("Goal" :use (top-thm-2-0 top-thm-2-1)
-           :in-theory (theory 'ground-zero)))
-  :rule-classes nil)
-
-)
-
-(local
- (defthm top-thm-3-lemma
-   (implies (and (integerp a) (integerp b) (integerp n))
-            (equal (land0 (bits a (1- n) 0)
-                         (bits b (1- n) 0)
-                         n)
-                   (land0 a b n)))
-   :hints (("Goal" :use ((:instance land0-ignores-bits
-                                    (x a) (y (bits b (1- n) 0)) (n n))
-                         (:instance land0-ignores-bits
-                                    (x b) (y a) (n n)))))
-   :rule-classes nil))
-
-(defthm top-thm-3-original
-  (implies (and (natp n)
-                (integerp a)
-                (integerp b)
-                (natp k)
-                (< k n))
-           (equal (equal (bits (+ a b 1) k 0) 0)
-		  (equal (bits (lnot (lxor0 (lxor0 a b n) 
-				           (cat (land0 a b n) n 0 1)
-					   (1+ n))
-				     (1+ n))
-			       k 0) 
-			 0)))
-  :hints (("Goal" :use (top-thm-3-lemma (:instance top-thm-2-old (c 1)))
-           :expand ((cat (land0 a b n) n 0 1))
-           :in-theory (enable tau-0 kap-0 sigm-0)))
-  :rule-classes ())
-
-
-;;;**********************************************************************
-;;;                  LEADING ONE PREDICTION
-;;;**********************************************************************
-
-;add in some more theorems about the functions defined below?
-
-(defthm lop-thm-1-original
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e)
-		  (= lambda
-		     (lior0 (* 2 (mod a (expt 2 e)))
-			   (lnot (* 2 b) (1+ e))
-			   (1+ e))))
-	     (or (= (expo (- a b)) (expo lambda))
-		 (= (expo (- a b)) (1- (expo lambda)))))
-  :rule-classes ())
-
-(defun lamt-0 (a b e)
-  (lxor0 a (lnot b (1+ e)) (1+ e)))
-
-(defun lamg-0 (a b e)
-  (land0 a (lnot b (1+ e)) (1+ e)))
-
-(defun lamz-0 (a b e)
-  (lnot (lior0 a (lnot b (1+ e)) (1+ e)) (1+ e)))
-
-(defun lam1-0 (a b e)
-  (land0 (bits (lamt-0 a b e) e 2) 
-	(land0 (bits (lamg-0 a b e) (1- e) 1)
-	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam2-0 (a b e)
-  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
-	(land0 (bits (lamz-0 a b e) (1- e) 1)
-	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam3-0 (a b e)
-  (land0 (bits (lamt-0 a b e) e 2) 
-	(land0 (bits (lamz-0 a b e) (1- e) 1)
-	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam4-0 (a b e)
-  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
-	(land0 (bits (lamg-0 a b e) (1- e) 1)
-	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam0-0 (a b e)
-  (lior0 (lam1-0 a b e)
-	(lior0 (lam2-0 a b e)
-	      (lior0 (lam3-0 a b e)
-		    (lam4-0 a b e)
-		    (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lamb-0 (a b e)
-  (+ (* 2 (lam0-0 a b e))
-     (lnot (bitn (lamt-0 a b e) 0) 1)))
-
-(defthm lop-thm-2-original
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (and (not (= (lamb-0 a b e) 0))
-		  (or (= (expo (- a b)) (expo (lamb-0 a b e)))
-		      (= (expo (- a b)) (1- (expo (lamb-0 a b e)))))))
-  :rule-classes ())
-
-; new for rel5:
-
-(defthmd gen-val-cor2
-  (implies (and (natp x)
-                (natp y)
-		(natp i))
-           (equal (+ (bits x i 0) (bits y i 0))
-		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
-		     (bits (+ x y) i 0))))
-  :hints (("Goal" :use ((:instance bitn-plus-bits
-                                   (x (+ (bits x i 0) (bits y i 0)))
-                                   (n (1+ i))
-                                   (m 0))
-                        (:instance gen-val-cor1
-                                   (j 0))))))
-
-(defthm bits-sum-cor-lemma
-  (implies (and (integerp x)
-                (integerp y)
-                (>= i j)
-                (>= j 0)
-                (= (gen x y i j) 0))
-           (equal (bits (+ (bits x i j)
-                           (bits y i j))
-                        (- i j) 0)
-                  (+ (bits x i j)
-                     (bits y i j))))
-  :hints (("Goal" :use ((:instance bitn-plus-bits
-                                   (x (+ (bits x i j) (bits y i j)))
-                                   (n (1+ (- i j)))
-                                   (m 0))
-                        gen-val-cor1)))
-  :rule-classes nil)
-
-(defthmd bits-sum-cor
-  (implies (and (integerp x)
-                (integerp y)
-                (>= i j)
-                (>= j 0)
-                (= (gen x y i j) 0)
-                (= (gen x y (1- j) 0) 0))
-           (equal (bits (+ x y) i j)
-                  (+ (bits x i j) (bits y i j))))
-  :hints (("Goal" :use (bits-sum bits-sum-cor-lemma))))
diff -Nru acl2-6.2/books/rtl/rel5/support/fast-and.lisp acl2-6.3/books/rtl/rel5/support/fast-and.lisp
--- acl2-6.2/books/rtl/rel5/support/fast-and.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/fast-and.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,26 +0,0 @@
-(in-package "ACL2")
-
-(defun split-list (lst lo hi)
-  (cond ((endp lst) 
-         (mv lo hi))
-        ((endp (cdr lst)) 
-         (mv (cons (car lst) lo) hi))
-        (t
-         (split-list (cddr lst)
-                     (cons (car lst) lo)
-                     (cons (cadr lst) hi)))))
-
-(defun fast-and-fn (conjuncts)
-  (declare (xargs :mode :program))
-  (cond ((endp conjuncts) ''t)
-        ((endp (cdr conjuncts)) (car conjuncts))
-        (t
-         (mv-let (hi lo)
-             (split-list conjuncts () ())
-           (list 'if
-                 (fast-and-fn hi)
-                 (fast-and-fn lo)
-                 'nil)))))
-
-(defmacro fast-and (&rest conjuncts)
-  (fast-and-fn conjuncts))
diff -Nru acl2-6.2/books/rtl/rel5/support/float-extra.lisp acl2-6.3/books/rtl/rel5/support/float-extra.lisp
--- acl2-6.2/books/rtl/rel5/support/float-extra.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/float-extra.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,593 +0,0 @@
-(in-package "ACL2")
-
-; This book was originally certified (in a different directory, not support/)
-; starting with:
-
-; (include-book "rtl/rel4/lib/top" :dir :system)
-
-; Then that form was replaced by the forms below starting with (include-book
-; "sticky"), up through the form (local (in-theory (theory 'lib-top1))).  See
-; the comments at the top of fadd-extra.lisp for further explanation of how to
-; extend the library.
-
-; But first, we need the following before including rtl books -- otherwise we
-; get a conflict of the rtl books with the arithmetic library.
-
-(local
- (encapsulate
-  ()
-
-  (local (include-book "arithmetic/inequalities" :dir :system))
-  (set-enforce-redundancy t)
-
-  (defmacro fc (x) x)
-
-  (defthm expt-is-increasing-for-base>1
-    (implies (and (< 1 r)
-                  (< i j)
-                  (fc (real/rationalp r))
-                  (fc (integerp i))
-                  (fc (integerp j)))
-             (< (expt r i) (expt r j)))
-    :rule-classes (:rewrite :linear))
-
-  (in-theory (disable (:rewrite expt-is-increasing-for-base>1)))))
-
-(include-book "sticky") ; needed for some definitions
-(include-book "util")   ; needed for definition of local-defthm
-
-; Now put ourselves in what amounts to the environment of ../lib/top, as
-; explained above.
-(local (include-book "top1"))
-(local (in-theory (theory 'lib-top1)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; fp- definition and lemmas
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; "Transcription" by Matt Kaufmann into ACL2 of hand proofs supplied by David
-; Russinoff (shown below). August 2005.
-
-(defun fp- (x n)
-  (if (= x (expt 2 (expo x)))
-      (- x (expt 2 (- (expo x) n)))
-    (- x (expt 2 (- (1+ (expo x)) n)))))
-
-; Lemma 1.  If x>0, x n-exact, and y = fp-(x,n), then y is n-exact and fp+(y,n)
-; = x.
-
-; Proof.  Let e = expo(x).
-
-; Case 1 [fp--lemma-1-1]: x = 2^e.
-
-; y = x - 2^(e-n) by definition of fp-.
-
-; 2^e > y = x - 2^(e-n) >= 2^e - 2^(e-1) = 2^(e-1);
-; so [fp--lemma-1-1-1] expo(y) = e-1 by expo-unique.
-
-; By exactp2, y is n-exact if y*2^(n-1-expo(y)) is an integer.  But we have:
-; y*2^(n-1-expo(y)) = y*2^(n-e) = (x-2^(e-n))*2^(n-e) = (2^e-2^(e-n))*2^(n-e) =
-; 2^n-1, which is an integer.
-
-; fp+(y,n) = y + 2^(expo(y)+1-n) = y + 2^(e-n) = x.
-
-; Case 2 [fp--lemma-1-2]: x != 2^e.
-
-; [fp--lemma-1-2-1-1-1] By fp+2, x >= fp+(2^e,n) = 2^e + 2^(e+1-n) by expo-2**n.
-
-; By definition of fp-, y = x - 2^(e+1-n) >= 2^e by the step just above.
-
-; So [fp--lemma-1-2-1-1] 2^e <= y; and, y < x <= 2^(e+1) by expo-upper-bound.
-; Therefore by expo-unique, expo(y) = e.
-
-; By exactp2, y is n-exact if y*2^(n-1-expo(y)) is an integer.  But we have:
-; y*2^(n-1-expo(y)) = y*2^(n-1-e) = (x-2^(e+1-n))*2^(n-1-e) =
-; x*2^(n-1-e) - 1, whicn is an integer by exactp2 because x is n-exact.
-
-; Finally, fp+(y,n) = y + 2^(expo(y)+1-n) = y + 2^(e+1-n) = x.
-
-(local-defthm expt-hack
-    (implies (and (integerp n)
-                  (> n 0))
-             (<= (expt 2 (* -1 n)) 1/2))
-    :hints (("Goal" :use ((:instance expt-is-increasing-for-base>1
-                                     (r 2)
-                                     (i (* -1 n))
-                                     (j -1)))))
-    :rule-classes :linear)
-
-; We deliberately export useful type-prescription rule fp--non-negative.
-(encapsulate
- ()
-
- (set-non-linearp t)
-
-; Expt-hack is used in the proof of the following.
-
- (defthm fp--non-negative
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (> n 0)
-                 (> x 0))
-            (and (rationalp (fp- x n))
-                 (< 0 (fp- x n))))
-   :hints (("Goal" :in-theory (e/d (expt-split fp-) (a15))
-            :use expo-lower-bound))
-   :rule-classes :type-prescription))
-
-(local
- (encapsulate
-  ()
-
-  (set-non-linearp t)
-
-  (local-defthm fp--lemma-1-1-1-1-1
-    (implies (and (integerp n)
-                  (< 0 n)
-                  (equal x (expt 2 (expo x))))
-             (<= (+ (expt 2 (+ -1 (expo x)))
-                    (expt 2 (+ (expo x) (* -1 n))))
-                 x))
-    :hints (("Goal" :in-theory (e/d (expt-split fp-) (a15)))))
-
-  (defthm fp--lemma-1-1-1-1
-    (implies (and (rationalp x)
-                  (> x 0)
-                  (integerp n)
-                  (> n 0)
-                  (exactp x n)
-                  (equal y (fp- x n))
-                  (equal e (expo x))
-                  (equal x (expt 2 e)))
-             (>= y (expt 2 (- e 1))))
-    :rule-classes nil)))
-
-(local-defthm fp--lemma-1-1-1
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (equal y (fp- x n))
-                (equal e (expo x))
-                (equal x (expt 2 e)))
-           (equal (expo y) (- e 1)))
-  :hints (("Goal" :use (fp--lemma-1-1-1-1
-                        (:instance expo-unique
-                                   (x y)
-                                   (n (- e 1))))))
-  :rule-classes nil)
-
-(local-defthm fp--lemma-1-1-2-1
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (equal y (fp- x n))
-                (equal e (expo x))
-                (equal x (expt 2 e)))
-           (equal (* y (expt 2 (- (- n 1) (expo y))))
-                  (1- (expt 2 n))))
-   :hints (("Goal" :use fp--lemma-1-1-1))
-  :rule-classes nil)
-
-(local-defthm fp--lemma-1-1-2
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (equal y (fp- x n))
-                (equal e (expo x))
-                (equal x (expt 2 e)))
-           (exactp y n))
-  :hints (("Goal" :use (fp--lemma-1-1-2-1
-                        (:instance exactp2 (x y) (n n)))))
-  :rule-classes nil)
-
-(local-defthm fp--lemma-1-1-3
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (equal y (fp- x n))
-                (equal e (expo x))
-                (equal x (expt 2 e)))
-           (equal (fp+ y n) x))
-  :hints (("Goal" :use fp--lemma-1-1-1))
-  :rule-classes nil)
-
-(local-defthm fp--lemma-1-1
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (equal y (fp- x n))
-                (equal e (expo x))
-                (equal x (expt 2 e)))
-           (and (exactp y n)
-                (equal (fp+ y n) x)))
-  :hints (("Goal" :use (fp--lemma-1-1-2
-                        fp--lemma-1-1-3)))
-  :rule-classes nil)
-
-(local
- (encapsulate
-  ()
-
-  (local-defthm fp--lemma-1-2-1-1-1
-    (implies (and (rationalp x)
-                  (> x 0)
-                  (integerp n)
-                  (> n 0)
-                  (exactp x n)
-                  (equal e (expo x))
-                  (not (equal x (expt 2 e))))
-             (>= x (+ (expt 2 e)
-                      (expt 2 (+ 1 e (- n))))))
-    :hints (("Goal" :use ((:instance fp+2
-                                     (n n)
-                                     (y x)
-                                     (x (expt 2 e)))
-                          (:instance expo-lower-bound
-                                     (x x)))
-             :in-theory (enable exactp-2**n)))
-    :rule-classes nil)
-
-  (defthm fp--lemma-1-2-1-1
-    (implies (and (rationalp x)
-                  (> x 0)
-                  (integerp n)
-                  (> n 0)
-                  (exactp x n)
-                  (equal y (fp- x n))
-                  (equal e (expo x))
-                  (not (equal x (expt 2 e))))
-             (equal (expo y) e))
-    :hints (("Goal" :use (fp--lemma-1-2-1-1-1
-                          (:instance expo-upper-bound (x x))
-                          (:instance expo-unique (x y) (n e)))))
-    :rule-classes nil)))
-
-(local-defthm fp--lemma-1-2-1-2
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (exactp x n)
-                 (equal y (fp- x n))
-                 (equal e (expo x))
-                 (not (equal x (expt 2 e))))
-            (equal (* y (expt 2 (- (1- n) e)))
-                   (1- (* x (expt 2 (- (- n 1) e))))))
-   :rule-classes nil)
-
-(local-defthm fp--lemma-1-2-1
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (exactp x n)
-                 (equal y (fp- x n))
-                 (equal e (expo x))
-                 (not (equal x (expt 2 e))))
-            (exactp y n))
-   :hints (("Goal" :use (fp--lemma-1-2-1-1
-                         fp--lemma-1-2-1-2
-                         (:instance exactp2 (x x) (n n))
-                         (:instance exactp2 (x y) (n n)))))
-   :rule-classes nil)
-
-(local-defthm fp--lemma-1-2-2
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (exactp x n)
-                 (equal y (fp- x n))
-                 (equal e (expo x))
-                 (not (equal x (expt 2 e))))
-            (equal (fp+ y n) x))
-   :hints (("Goal" :use (fp--lemma-1-2-1-1)))
-   :rule-classes nil)
-
-(local-defthm fp--lemma-1-2
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (exactp x n)
-                 (equal y (fp- x n))
-                 (equal e (expo x))
-                 (not (equal x (expt 2 e))))
-            (and (exactp y n)
-                 (equal (fp+ y n) x)))
-   :hints (("Goal" :use (fp--lemma-1-2-1 fp--lemma-1-2-2)))
-   :rule-classes nil)
-
-(local-defthm fp--lemma-1
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (equal y (fp- x n)))
-           (and (exactp y n)
-                (equal (fp+ y n) x)))
-  :rule-classes nil
-  :hints (("Goal" :use ((:instance fp--lemma-1-1 (e (expo x)))
-                        (:instance fp--lemma-1-2 (e (expo x)))))))
-
-(local-defthm fp-2-lemma
-  (implies (and (integerp n)
-                (> n 0))
-           (not (equal (fp- (fp+ 0 n) n) 0)))
-  :hints (("Goal" :use ((:instance expt-weak-monotone
-                                   (n (+ 1 (* -2 n)))
-                                   (m (+ 1 (* -1 n))))
-                        (:instance expt-weak-monotone
-                                   (m (+ 1 (* -2 n)))
-                                   (n (+ 1 (* -1 n)))))))
-                                   
-  :rule-classes ())
-
-(defthm fp-2
-  (implies (and (rationalp x)
-                (rationalp y)
-                (> y 0)
-                (> x y)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (exactp y n))
-           (<= y (fp- x n)))
-  :hints (("Goal" :use ((:instance fp+2
-                                   (x (fp- x n))
-                                   (y y))
-                        (:instance fp--lemma-1
-                                   (x x)
-                                   (y (fp- x n)))
-                        fp-2-lemma)
-           :in-theory (disable fp- fp+)))
-  :rule-classes ())
-
-(defthm fp-1
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n))
-           (exactp (fp- x n) n))
-  :hints (("Goal" :use ((:instance fp--lemma-1
-                                   (x x)
-                                   (y (fp- x n))))))
-  :rule-classes ())
-
-(defthm fp+-
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n))
-           (equal (fp+ (fp- x n) n)
-                  x))
-  :hints (("Goal" :use ((:instance fp--lemma-1
-                                   (y (fp- x n)))))))
-
-; Lemma 2.  If x>0, x is n-exact, and y = fp+(x,n), then fp-(y,n) = x.
-
-; Proof.  Let e = expo(x).  Then y = x + 2^(e+1-n).
-
-; Case 1 [fp--lemma-2-1]: y < 2^(e+1).
-
-; Then [fp--lemma-2-1-1] expo(y) = e by expo-unique.
-
-; Since y != 2^e, fp-(y,n) = y - 2^(e+1-n) = x.
-
-; Case 2 [fp--lemma-2-2]: y >= 2^(e+1).
-
-; By fp+2, since 2^(e+1) is n-exact by exactp-2**n, then 2^(e+1) >= y
-; [fp--lemma-2-2-1].  So y = 2^(e+1), and the result follows by definition of fp-.
-
-(local-defthm fp--lemma-2-1-1
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (equal y (fp+ x n))
-                (equal e (expo x))
-                (< y (expt 2 (1+ e))))
-           (equal (expo y) e))
-  :hints (("Goal" :use ((:instance expo-lower-bound (x x))
-                        (:instance expo-unique (x y) (n e)))))
-  :rule-classes nil)
-
-(local-defthm fp--lemma-2-1
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (exactp x n)
-                 (equal y (fp+ x n))
-                 (equal e (expo x))
-                 (< y (expt 2 (1+ e))))
-            (equal (fp- y n) x))
-   :hints (("Goal" :use (fp--lemma-2-1-1 expo-lower-bound)))
-   :rule-classes nil)
-
-(local-defthm fp--lemma-2-2-1
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (exactp x n)
-                 (equal y (fp+ x n))
-                 (equal e (expo x))
-                 (>= y (expt 2 (1+ e))))
-            (>= (expt 2 (1+ e)) y))
-   :hints (("Goal" :use ((:instance fp+2 (x x) (y (expt 2 (1+ e))))
-                         expo-upper-bound)
-            :in-theory (enable exactp-2**n)))
-   :rule-classes nil)
-
-(local-defthm fp--lemma-2-2
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (exactp x n)
-                 (equal y (fp+ x n))
-                 (equal e (expo x))
-                 (>= y (expt 2 (1+ e))))
-            (equal (fp- y n) x))
-   :hints (("Goal" :use (fp--lemma-2-2-1)))
-   :rule-classes nil)
-
-(local-defthm fp--lemma-2
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (equal y (fp+ x n)))
-           (equal (fp- y n) x))
-  :hints (("Goal" :use ((:instance fp--lemma-2-1 (e (expo x)))
-                        (:instance fp--lemma-2-2 (e (expo x))))))
-  :rule-classes nil)
-
-(defthm fp-+
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n))
-           (equal (fp- (fp+ x n) n)
-                  x))
-  :hints (("Goal" :use ((:instance fp--lemma-2
-                                   (y (fp+ x n)))))))
-
-; Start proof of expo-prod.
-
-(local-defthm expo-prod-1
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (rationalp y)
-                (not (= y 0)))
-           (equal (* x y)
-                  (* (sgn x)
-                     (sgn y)
-                     (sig x)
-                     (sig y)
-                     (expt 2 (+ (expo x) (expo y))))))
-  :hints (("Goal" :use ((:instance fp-rep (x x))
-                        (:instance fp-rep (x y)))
-           :in-theory (e/d (expt-split) (a15))))
-  :rule-classes nil)
-
-(local-defthm expo-prod-2
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (rationalp y)
-                (not (= y 0))
-                (< (* (sig x) (sig y)) 2))
-           (equal (expo (* x y))
-                  (+ (expo x) (expo y))))
-  :hints (("Goal" :use (expo-prod-1
-                        (:instance fp-rep-unique
-                                   (x (* x y))
-                                   (m (* (sig x) (sig y)))
-                                   (e (+ (expo x) (expo y))))
-                        (:instance sig-lower-bound
-                                   (x x))
-                        (:instance sig-lower-bound
-                                   (x y)))
-           :in-theory (enable sgn)))
-  :rule-classes nil)
-
-(local-defthm expo-prod-3-1
-  (implies (and (rationalp x)
-                (rationalp y)
-                (not (equal x 0))
-                (not (equal y 0))
-                (not (< (* (sig x) (sig y)) 2)))
-           (and (< (* 1/2 (sig x) (sig y))
-                   2)
-                (>= (* 1/2 (sig x) (sig y))
-                    1)))
-  :hints (("Goal" :use ((:instance sig-upper-bound
-                                   (x x))
-                        (:instance sig-upper-bound
-                                   (x y))
-                        (:instance sig-lower-bound
-                                   (x x))
-                        (:instance sig-lower-bound
-                                   (x y)))))
-  :rule-classes nil)
-
-(local
- (encapsulate
-  ()
-
-  (local-defthm hack
-    (implies (and (syntaxp (quotep k))
-                  (integerp k))
-             (equal (expt 2 (+ k (expo x) (expo y)))
-                    (* (expt 2 k)
-                       (expt 2 (+ (expo x) (expo y))))))
-    :hints (("Goal" :in-theory (e/d (expt-split) (a15)))))
-
-  (defthm expo-prod-3
-    (implies (and (rationalp x)
-                  (not (= x 0))
-                  (rationalp y)
-                  (not (= y 0))
-                  (not (< (* (sig x) (sig y)) 2)))
-             (equal (expo (* x y))
-                    (+ 1 (expo x) (expo y))))
-    :hints (("Goal" :use (expo-prod-1
-                          expo-prod-3-1
-                          (:instance fp-rep-unique
-                                     (x (* x y))
-                                     (m (* 1/2 (sig x) (sig y)))
-                                     (e (+ 1 (expo x) (expo y)))))
-             :in-theory (e/d (sgn) (expt a15))))
-    :rule-classes nil)))
-
-(defthmd expo-prod
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (rationalp y)
-                (not (= y 0)))
-           (equal (expo (* x y))
-                  (if (< (* (sig x) (sig y)) 2)
-                      (+ (expo x) (expo y))
-                    (+ 1 (expo x) (expo y)))))
-  :hints (("Goal" :use (expo-prod-2 expo-prod-3))))
-
-(defthmd sig-prod
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (rationalp y)
-                (not (= y 0)))
-           (equal (sig (* x y))
-                  (if (< (* (sig x) (sig y)) 2)
-                      (* (sig x) (sig y))
-                    (* 1/2 (sig x) (sig y)))))
-  :hints (("Goal" :in-theory (e/d (expt-split sig expo-prod) (a15)))))
-
-; This is essentially just fp+1-2, but it happens to be convenient just to tack
-; it on here.
-(defthm fp+expo
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (not (= (expo (fp+ x n)) (expo x))))
-           (equal (fp+ x n) (expt 2 (1+ (expo x)))))
-  :hints (("Goal" :use fp+1-2))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/support/float.lisp acl2-6.3/books/rtl/rel5/support/float.lisp
--- acl2-6.2/books/rtl/rel5/support/float.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/float.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,2011 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-;todo: disable expt in this file (and everywhere)
-;disable abs, sgn
-
-;move some of this stuff to books in arithmetic/
-
-(in-package "ACL2")
-
-(local (include-book "../arithmetic/top"))
-(include-book "../arithmetic/negative-syntaxp")
-(include-book "../arithmetic/basic") ;BOZO! make this local
-(include-book "../arithmetic/power2p")
-(local (include-book "../arithmetic/fl"))
-(local (include-book "../arithmetic/cg"))
-
-(local (in-theory (enable expt-minus)))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-;fp rep
-
-(defthm fp-rep
-  (implies (rationalp x)
-           (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
-  :hints (("Goal" :in-theory (enable sig)))
-  :rule-classes ())
-
-(defthm fp-abs
-  (implies (rationalp x)
-           (equal (abs x) (* (sig x) (expt 2 (expo x)))))
-  :hints (("Goal" :use fp-rep))
-  :rule-classes ())
-
-
-
-
-;expo
-
-
-(defthm expo-lower-bound
-  (implies (and (rationalp x)
-                (not (equal x 0)))
-           (<= (expt 2 (expo x)) (abs x)))
-  :rule-classes :linear)
-
-(defthm expo-lower-pos
-  (implies (and (< 0 x)
-                (rationalp x)
-                )
-           (<= (expt 2 (expo x)) x))
-  :rule-classes :linear)
-
-(defthm expo-of-not-rationalp
-  (implies (not (rationalp x))
-           (equal (expo x) 0)))
-
-;make a vesion whose max term is consistent with split exponents?                
-(defthm expo-upper-bound
-  (implies (rationalp x)
-           (< (abs x) (expt 2 (1+ (expo x)))))
-  :rule-classes :linear
-)
-
-(defthm expo-upper-pos
-  (implies (rationalp x)
-           (< x (expt 2 (1+ (expo x)))))
-  :rule-classes :linear)
-
-;be careful: if you enable expo, the x<0 case of expo can loop with expo-minus
-;BOZO add theory-invariant
-(defthm expo-minus
-  (equal (expo (* -1 x))
-         (expo x)))
-
-(local
- (defthm expo-unique-2
-   (implies (and (rationalp x)
-                 (not (equal x 0))
-                 (integerp n)
-                 (> n (expo x)))
-            (> (expt 2 n) (abs x)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (disable abs)
-            :use ( ;(:instance expo-upper-bound)
-                  (:instance expt-weak-monotone (n (1+ (expo x))) (m n)))))))
-
-(local
- (defthm expo-unique-1
-   (implies (and (rationalp x)
-                 (not (equal x 0))
-                 (integerp n)
-                 (< n (expo x)))
-            (<= (expt 2 (1+ n)) (abs x)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (disable abs)
-            :use ((:instance expt-weak-monotone (n (1+ n)) (m (expo x))))))))
-
-
-
-(defthm expo-unique
-  (implies (and (<= (expt 2 n) (abs x))
-                (< (abs x) (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal n (expo x)))
-  :hints (("Goal" :in-theory (disable abs)
-           :use ((:instance expo-unique-1)
-                 (:instance expo-unique-2))))
-  :rule-classes ())
-
-
-(defthmd expo-monotone
-  (implies (and (<= (abs x) (abs y))
-                (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                (case-split (rationalp y))
-                )
-           (<= (expo x) (expo y)))
-  :rule-classes :linear
-  :hints (("Goal"
-           :use (;(:instance expo-lower-bound)
-                 (:instance expo-unique-2 (n (expo x)) (x y))))))
-
-
-(defthm expo-2**n
-  (implies (integerp n)
-           (equal (expo (expt 2 n))
-                  n))
-  :hints (("Goal" :use ((:instance expo-unique (x (expt 2 n)))
-			(:instance expt-strong-monotone (m (1+ n)))))))
-
-
-;sig
-
-;BOZO looped with sig-minus??
-(defthmd sig-minus
-  (equal (sig (* -1 x))
-         (sig x))
-  :hints (("Goal" :in-theory (enable sig) 
-           :cases ((rationalp x)))))
-
-(defthm sig-minus-gen
-  (implies (syntaxp (negative-syntaxp x))
-           (equal (sig x)
-                  (sig (* -1 x))))
-  :hints (("Goal" :in-theory (enable sig-minus))))
-
-(defthm sig-lower-bound
-  (implies (and (rationalp x)
-                (not (equal x 0)))
-           (<= 1 (sig x)))
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :in-theory  (disable abs)
-           :use ((:instance fp-abs)))))
-
-(defthm sig-of-not-rationalp
-  (implies (not (rationalp x))
-           (equal (sig x)
-                  0))
-  :hints (("Goal" :in-theory (enable sig))))
-
-(defthm sig-rationalp-type-prescription
-  (rationalp (sig x))
-  :rule-classes (:type-prescription))
-
-(defthm sig-positive-type-prescription
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0))))
-           (< 0 (sig x)))
-  :hints (("Goal" :in-theory (enable sig)))
-  :rule-classes (:type-prescription))
-
-(defthm sig-non-negative-type-prescription
-  (<= 0 (sig x))
-  :rule-classes (:type-prescription))
-
-;rephrase
-(defthm x-0-iff-sig-x-0
-  (implies (rationalp x)
-           (equal (equal (sig x) 0)
-                  (equal x 0))))
-
-;would like to reduce the number of hints here...
-(defthm sig-upper-bound
-  (< (sig x) 2)
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :use (:instance expo-upper-bound)
-           :in-theory (e/d (sig expt-split) (expo-bound-eric)))))
-
-
-
-
-
-
-;sgn
-
-;Do we plan to enable sgn in our proofs?
-
-(defthm sgn-minus
-  (equal (sgn (* -1 x))
-         (* -1 (sgn x)))
-  :hints (("Goal" :cases ((rationalp x)))))
-
-(defthm sgn+1
-  (implies (and (< 0 x)
-                (rationalp x)
-                )
-           (equal (sgn x) 
-                  1))
-  :rule-classes ())
-
-(defthm sgn-1
-  (implies (and (< x 0)
-                (rationalp x))
-           (equal (sgn x) 
-                  -1))
-  :rule-classes ())
-
-;gen to multiplying by anything positive?
-(defthm sgn-shift
-  (equal (sgn (* x (expt 2 k)))
-         (sgn x)))
-
-(defthm sgn-sig
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0))))
-           (equal (sgn (sig x))
-                  1))
-  :hints (("Goal" :in-theory (enable sgn sig))))
-
-(defthm sgn-prod
-  (implies (and (case-split (rationalp x))
-                (case-split (rationalp y))
-                )
-           (equal (sgn (* x y))
-                  (* (sgn x) (sgn y))))
-  :hints (("Goal" :in-theory (enable sgn))))
-
-(defthm sgn-sgn
-  (equal (sgn (sgn x))
-         (sgn x))
-  :hints (("Goal" :in-theory (enable sgn))))
-
-(defthm sgn-expt
-  (equal (sgn (expt 2 x))
-         1)
-  :hints (("Goal" :in-theory (enable sgn))))
-
-(defthm sgn-equal-0
-  (equal (equal (sgn x) 0)
-         (or (equal x 0)
-             (not (rationalp x))))
-  :hints (("goal" :in-theory (enable sgn))))
-
-(defthm sig-equal-0
-  (equal (equal (sig x) 0)
-         (or (equal x 0)
-             (not (rationalp x))))
-  :hints (("goal" :in-theory (enable sig))))
-
-(defthm sig-*-sgn
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                )
-           (equal (sig (* (sgn x) y))
-                  (sig y)))
-  :hints (("Goal" :in-theory (enable sig sgn))))
-
-(defthm sig-of-non-rational
-  (implies (not (rationalp x))
-           (equal (sig x)
-                  0))
-  :hints (("Goal" :in-theory (enable sig))))
-
-(defthm sgn-of-non-rational
-  (implies (not (rationalp x))
-           (equal (sgn x)
-                  0))
-  :hints (("Goal" :in-theory (enable sgn))))
-
-(defthm expo-*-sgn
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                )
-           (equal (expo (* (sgn x) y))
-                  (expo y)))
-      :hints (("goal" :in-theory (enable sgn))))
-
-(defthm fp-unique-1
-    (implies (and (rationalp m)
-		  (integerp e)
-		  (<= 1 m)
-		  (< 0 e))
-	     (<= 2 (* m (expt 2 e))))
-    :hints (("Goal" :in-theory (enable expt))) ;yuck
-             :rule-classes ())
-
-(defthm fp-unique-2
-  (implies (and (rationalp m)
-                (integerp e)
-                (< m 2)
-                (< e 0))
-           (< (* m (expt 2 e)) 1))
-  :hints (("Goal" :in-theory (enable expt))) ;yuck
-  :rule-classes ())
-
-(defthm fp-unique-3
-    (implies (and (rationalp m)
-		  (integerp e)
-		  (<= 1 m)
-		  (< m 2)
-		  (<= 1 (* m (expt 2 e)))
-		  (< (* m (expt 2 e)) 2))
-	     (equal e 0))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance fp-unique-1)
-			(:instance fp-unique-2)))))
-
-
-
-(defthm =*
-  (implies (and (rationalp x1)
-                (rationalp x2)
-                (rationalp y)
-                (not (equal y 0))
-                (equal x1 x2))
-           (equal (* x1 y) (* x2 y)))
-  :rule-classes ())
-
-(defthm fp-unique-4
-    (implies (and (rationalp m1)
-		  (integerp e1)
-		  (rationalp m2)
-		  (integerp e2)
-		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
-	     (= (* m1 (expt 2 (- e1 e2))) m2))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (expt-split
-                                   ) ())
-           :use (;(:instance expt- (a e1) (b e2))
-                 (:instance =* (x1 (* m1 (expt 2 e1))) (x2 (* m2 (expt 2 e2))) (y (expt 2 (- e2))))))))
-
-(defthm fp-unique-5
-    (implies (and (rationalp m1)
-		  (integerp e1)
-		  (rationalp m2)
-		  (integerp e2)
-		  (<= 1 m1)
-		  (< m1 2)
-		  (<= 1 m2)
-		  (< m2 2)
-		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
-	     (= e1 e2))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance fp-unique-3 (m m1) (e (- e1 e2)))
-			(:instance fp-unique-4)))))
-
-(defthm *cancell
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp z)
-		  (not (= z 0))
-		  (= (* x z) (* y z)))
-	     (= x y))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance =* (x1 (* x z)) (x2 (* y z)) (y (/ z)))))))
-
-(defthm fp-unique-6
-    (implies (and (rationalp m1)
-		  (integerp e1)
-		  (rationalp m2)
-		  (integerp e2)
-		  (<= 1 m1)
-		  (< m1 2)
-		  (<= 1 m2)
-		  (< m2 2)
-		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
-	     (= m1 m2))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance fp-unique-5)
-			(:instance cancel-equal-* (r m1) (s m2) (a (expt 2 e1)))))))
-
-(defthm fp-rep-unique
-    (implies (and (rationalp x)
-		  (rationalp m)
-		  (<= 1 m)
-		  (< m 2)
-		  (integerp e)
-		  (= (abs x) (* m (expt 2 e))))
-	     (and (= m (sig x))
-		  (= e (expo x))))
-  :rule-classes ()
-  :hints (("Goal"
-           :use ((:instance fp-rep)
-                 (:instance sig-lower-bound)
-                 (:instance sig-upper-bound)
-                 (:instance fp-unique-5 (m1 m) (m2 (sig x)) (e1 e) (e2 (expo x)))
-                 (:instance fp-unique-6 (m1 m) (m2 (sig x)) (e1 e) (e2 (expo x)))))))
-
-;drop this?
-(defthm sig-expo-shift
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (integerp n))
-           (and (= (sig (* (expt 2 n) x)) (sig x))
-                (= (expo (* (expt 2 n) x)) (+ n (expo x)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sig)
-           :use ((:instance sgn+1)
-                 (:instance fp-rep)
-
-                 (:instance sig-lower-bound)
-                 (:instance sig-upper-bound)
-                 (:instance fp-rep-unique (x (* (expt 2 n) x)) (m (sig x)) (e (+ n (expo x))))))))
-
-
-(defthm expo-shift
-  (implies (and (rationalp x)
-                (not (equal x 0))
-                (integerp n))
-           (equal (expo (* (expt 2 n) x)) 
-                  (+ n (expo x))))
-  :hints (("Goal" :use (sig-expo-shift))))
-
-(defthm expo-shift-2
-  (implies (and (case-split (rationalp x))
-                (case-split (not (equal x 0)))
-                (case-split (integerp n)))
-           (equal (expo (* x (expt 2 n))) 
-                  (+ n (expo x))))
-  :hints (("Goal" :in-theory (disable expo-shift) 
-           :use expo-shift)))
-
-;(in-theory (disable expo-shift-2)) ; can cause loops if enabled?
-
-(defthm sig-shift
-  (equal (sig (* (expt 2 n) x)) 
-         (sig x))
-  :hints (("Goal" :in-theory (set-difference-theories (enable sig expt)
-                                                      '( expo-shift-2))
-           :use (sig-expo-shift))))
-
-(defthm sig-shift-2
-  (equal (sig (* x (expt 2 n))) 
-         (sig x))
-  :hints (("Goal" :in-theory (disable sig-shift)
-           :use (sig-shift))))
-
-(defthm sig-shift-by-constant-power-of-2
-  (implies (and (syntaxp (and (quotep k)))
-                (power2p k)
-                )
-           (equal (sig (* k x))
-                  (sig x)))
-  :hints (("Goal" :in-theory (enable power2p-rewrite))))
-
-(defthm sig-shift-by-power-of-2
-  (implies (and (syntaxp (power2-syntaxp k))
-                (force (power2p k))
-                )
-           (equal (sig (* k x))
-                  (sig x)))
-  :hints (("Goal" :in-theory (enable power2p-rewrite))))
-
-(defthm sig-shift-by-power-of-2-2
-  (implies (and (syntaxp (power2-syntaxp k))
-                (force (power2p k))
-                )
-           (equal (sig (* x k))
-                  (sig x)))
-  :hints (("Goal" :in-theory (enable power2p-rewrite))))
-
-
-
-;(in-theory (disable sig-shift-2)) ;can cause loops if enabled?
-
-
-(defthm sig-sig
-  (equal (sig (sig x)) 
-         (sig x))
-  :hints (("Goal" :in-theory (enable sig))))
-
-
-#|
-(defthm expt-non-neg
-    (implies (integerp n)
-	     (not (< (expt 2 n) 0))))
-|#
-
-;move?
-(defthm expo-prod-lower
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (rationalp y)
-                (not (= y 0)))
-           (<= (+ (expo x) (expo y)) (expo (* x y))))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (enable a15)
-           :use ((:instance *-doubly-monotonic 
-                            (x (expt 2 (expo x)))
-                            (y (abs x))
-                            (a (expt 2 (expo y)))
-                            (b (abs y)))
-                 (:instance expo-lower-bound)
-                 (:instance expo-lower-bound (x y))
-                 (:instance expo-unique-2 (x (* x y)) (n (+ (expo x) (expo y))))))))
-
-(defthm *-doubly-strongly-monotonic
-  (implies (and (rationalp x)
-                (rationalp y)
-                (rationalp a)
-                (rationalp b)
-                (< 0 x)
-                (< 0 y)
-                (< 0 a)
-                (< 0 b)
-                (< x y)
-                (< a b))
-           (< (* x a) (* y b)))
-  :rule-classes ())
-
-(defthm expo-prod-upper
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (rationalp y)
-		  (not (= y 0)))
-	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (enable a15)
-		  :use ((:instance *-doubly-strongly-monotonic
-				   (x (abs x))
-				   (y (expt 2 (1+ (expo x))))
-				   (a (abs y))
-				   (b (expt 2 (1+ (expo y)))))
-			(:instance expo-upper-bound)
-			(:instance expo-upper-bound (x y))
-			(:instance expo-unique-1 (x (* x y)) (n (+ (expo x) (expo y) 1)))))))
-
-
-
-;exactp
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defthm exactp-0
-  (exactp 0 n)
-  :hints (("Goal" :in-theory (enable exactp))))
-
-(defthm exactp-sig
-  (equal (exactp (sig x) n)
-         (exactp x n))
-  :hints (("Goal" :in-theory (enable exactp))))
-
-(defthmd exactp-minus
-  (equal (exactp (* -1 x) n)
-         (exactp x n))
-  :hints (("Goal" :in-theory (enable exactp))))
-
-(defthm exactp-minus-gen
-  (implies (syntaxp (negative-syntaxp x))
-           (equal (exactp x n)
-                  (exactp (* -1 x) n)))
-  :hints (("Goal" :in-theory (enable exactp-minus))))
-
-#| kill
-;make negative-syntaxp version
-;add? ;three summand version?
-(defthm exactp-minus-dist
-  (equal (exactp (+ (* -1 x) (* -1 y)) n)
-         (exactp (+ x y) n))
-  :hints (("Goal" :in-theory (disable exactp-minus)
-          :use (:instance exactp-minus (x (* -1 (+ x y)))))))
-|#
-
-
-;similar to other hacks?
-(defthmd between-0-and-1-means-not-integerp
-  (implies (and (< 0 x)
-                (< x 1))
-           (not (integerp x))))
-
-(defthm sig-prod-linear
-  (implies (and (<= 0 y)
-                (rationalp x)
-                (rationalp y))
-           (<= (* (sig x) y) (* 2 y)))
-  :rule-classes (:linear)
-  )
-
-;rephrase?
-(defthmd only-0-is-0-or-negative-exact
-  (implies (and (<= n 0)
-                (integerp n)
-                (case-split (rationalp x))
-                (case-split (not (= x 0))))
-           (not (exactp x n)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable exactp expt-split ;expt
-                                      )
-                              '( fl-equal-0 ;why was this needed?
-                                    ))
-           :use (:instance between-0-and-1-means-not-integerp (x (* (SIG X) (EXPT 2 (+ -1 N))))))))
-
-#|
-;gross?
-;just enable sig?
-(defthm exactp-lemma
-  (implies (and (rationalp x)
-                (integerp n))
-           (equal (* (sig x) (expt 2 (1- n)))
-                  (* (abs x) (expt 2 (- (1- n) (expo x))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sig))))
-
-|#
-
-
-
-
-;not needed?
-;bad name?
-;reorder and call exactp-abs and make rewrite
-;more rules to drop abs?
-(defthm exact-neg
-  (equal (exactp x n)
-         (exactp (abs x) n))
-  :hints (("Goal" :in-theory (enable exactp)))
-  :rule-classes ())
-
-;make this a definition rule?
-(defthmd exactp2
-  (implies (and (rationalp x)
-                (integerp n))
-           (equal (exactp x n)
-                  (integerp (* x (expt 2 (- (1- n) (expo x)))))))
-  :hints (("Goal" :in-theory (e/d (exactp sig expt-split) ()))))
-
-
-#| kill
-;could this be a rewrite rule?
-(defthm exactp-shift
-  (implies (and (rationalp x)
-                (integerp m)
-                (integerp n)
-                (exactp x m))
-           (exactp (* (expt 2 n) x) m))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable exactp2)
-                              '( sgn))
-           :cases ((= x 0)))))
-|#
-
-;consider enabling?
-;reorder product in lhs?
-(defthmd exactp-shift
-    (implies (and (rationalp x)
-                (integerp k)
-                (integerp n))
-           (equal (exactp (* (expt 2 k) x) n)
-                  (exactp x n)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable exactp2 a15)
-                              '( sgn))
-           :cases ((= x 0)))))
-
-(defthmd exactp-shift-2
-  (implies (and (rationalp x)
-                (integerp m)
-                (integerp n)
-                )
-           (equal (exactp (* x (expt 2 n)) m)
-                  (exactp x m)))
-  :hints (("Goal" :use  ((:instance exactp-shift (k n) (n m))))))
-
-(defthm exactp-shift-by-constant-power-of-2
-  (implies (and (syntaxp (and (quotep k)))
-                (power2p k)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (exactp (* k x) n)
-                  (exactp x n)))
-  :hints (("Goal" :in-theory (enable exactp-shift-2 power2p-rewrite))))
-
-(defthm exactp-shift-by-power-of-2
-  (implies (and (syntaxp (power2-syntaxp k))
-                (force (power2p k))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (exactp (* k x) n)
-                  (exactp x n)))
-  :hints (("Goal" :in-theory (enable  exactp-shift-2 power2p-rewrite))))
-
-(defthm exactp-shift-by-power-of-2-2
-  (implies (and (syntaxp (power2-syntaxp k))
-                (force (power2p k))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (exactp (* x k) n)
-                  (exactp x n)))
-  :hints (("Goal" :in-theory (enable  exactp-shift-2 power2p-rewrite))))
-
-
-
-(defthm exactp-prod-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (integerp m))
-	     (= (expt 2 (+ m n -1 (- (expo (* x y)))))
-		(* (expt 2 (- (1- m) (expo x)))
-		   (expt 2 (- (1- n) (expo y)))
-		   (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y))))))))
-  :rule-classes ())
-
-(defthm exactp-prod-2
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (rationalp y)
-		  (not (= y 0)))
-	     (integerp (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y)))))))
-  :rule-classes ()
-  :hints (("Goal" 
-		  :use ((:instance expo-prod-upper)))))
-
-(defthm integerp-x-y-z
-    (implies (and (integerp x) (integerp y) (integerp z))
-	     (integerp (* x y z)))
-  :rule-classes ())
-
-(defthm exactp-prod
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp n)
-		  (exactp x m)
-		  (exactp y n))
-	     (exactp (* x y) (+ m n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2 expt-split)
-		  :use ((:instance exactp-prod-1)
-			(:instance exactp-prod-2)
-			(:instance integerp-x-y-z 
-				   (x (* x (expt 2 (- (1- m) (expo x)))))
-				   (y (* y (expt 2 (- (1- n) (expo y)))))
-				   (z (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y)))))))))))
-
-(defthm exactp-x2-1
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (= (* 2 (expt 2 n) (expt 2 n))
-		(expt 2 (+ n n 1))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expt-split (r 2) (i m) (j n))
-			(:instance expt-split (r 2) (i (* 2 n)) (j 1))))))
-
-(defthm exactp-x2-2
-    (implies (and (rationalp x)
-		  (rationalp y))
-	     (= (* 2 (* x y) (* x y))
-		(* (* x x) (* 2 y y))))
-  :rule-classes ())
-
-(defthm exactp-x2-3
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (= (* 2 (* x (expt 2 n)) (* x (expt 2 n)))
-		(* (* x x) (expt 2 (+ n n 1)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance exactp-x2-1)
-			(:instance exactp-x2-2 (y (expt 2 n)))))))
-
-(defthm exactp-x2-4
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (integerp e))
-	     (= (* 2 (* x (expt 2 (- (1- n) e))) (* x (expt 2 (- (1- n) e))))
-		(* (* x x) (expt 2 (- (1- (* 2 n)) (* 2 e))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance exactp-x2-3 (n (- (1- n) e)))))))
-
-(defthm exactp-x2-5
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (integerp e)
-		  (integerp e2))
-	     (= (* 2 (* x (expt 2 (- (1- n) e))) (* x (expt 2 (- (1- n) e))))
-		(* (* (* x x) (expt 2 (- (1- (* 2 n)) e2)))
-		   (expt 2 (- e2 (* 2 e))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance exactp-x2-4)
-			(:instance expt-split (r 2) (i (- (1- (* 2 n)) e2)) (j (- e2 (* 2 e))))))))
-
-(defthm integerp-x-y
-    (implies (and (integerp x)
-		  (integerp y))
-	     (integerp (* x y)))
-  :rule-classes ())
-
-(defthm exactp-x2-6
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (exactp (* x x) (* 2 n)))
-	     (integerp (* 2 (* x (expt 2 (- (1- n) (expo x)))) (* x (expt 2 (- (1- n) (expo x)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (expt-split exactp2 expt-with-product-exponent) ())
-		  :use ((:instance expo-prod-lower (y x))
-			(:instance integerp-x-y 
-				   (x (* (* x x) (expt 2 (- (1- (* 2 n)) (expo (* x x))))))
-				   (y (expt 2 (- (expo (* x x)) (* 2 (expo x))))))
-			(:instance exactp-x2-5 (e (expo x)) (e2 (expo (* x x))))))))
-
-(defthm exactp-x2-not-zero
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (exactp (* x x) (* 2 n)))
-	     (exactp x n))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2 expt-split)
-		  :use ((:instance exactp-x2-6)
-			(:instance x-2xx (x (* x (expt 2 (- (1- n) (expo x))))))))))
-
-;what's the role of k here?
-(defthm exactp-x2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (exactp (* x x) (* 2 n)))
-	     (exactp x n))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance exactp-x2-not-zero)))))
-
-(defthmd exactp-<=
-  (implies (and (exactp x m)
-                (<= m n)
-                (rationalp x)
-                (integerp n)
-                (integerp m)
-                )
-           (exactp x n))
-  :hints (("Goal" :in-theory (enable exactp2 expt-split)
-           :use (;(:instance expt-split (r 2) (i (- (1- m) (expo x))) (j (- n m)))
-                 (:instance integerp-x-y 
-                            (x (* x (expt 2 (- (1- m) (expo x))))) 
-                            (y (expt 2 (- n m))))))))
-
-
-(defthm exactp-<=-expo
-  (implies (and (rationalp x)
-                (integerp n)
-                (integerp e)
-                (<= e (expo x))
-                (exactp x n))
-           (integerp (* x (expt 2 (- (1- n) e)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2 expt-split)
-           :use ( ;(:instance expt-split (r 2) (i (- (1- n) (expo x))) (j (- (expo x) e)))
-                 (:instance integerp-x-y 
-                            (x (* x (expt 2 (- (1- n) (expo x))))) 
-                            (y (expt 2 (- (expo x) e))))))))
-
-(defthm exactp->=-expo
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (integerp e)
-		  (>= e (expo x))
-		  (integerp (* x (expt 2 (- (1- n) e)))))
-	     (exactp x n))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2 expt-split)
-           :use ((:instance expt-split (r 2) (i (- (1- n) e)) (j (- e (expo x))))
-			(:instance integerp-x-y 
-				   (x (* x (expt 2 (- (1- n) e))))
-				   (y (expt 2 (- e (expo x)))))))))
-
-(defthm exactp-diff
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-		  (integerp n)
-		  (> n 0)
-		  (> n k)
-		  (exactp x n)
-		  (exactp y n)
-		  (<= (+ k (expo (- x y))) (expo x))
-		  (<= (+ k (expo (- x y))) (expo y)))
-	     (exactp (- x y) (- n k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2)
-		  :use ((:instance exactp-<=-expo (e (+ k (expo (- x y)))))
-			(:instance exactp-<=-expo (e (+ k (expo (- x y)))) (x y))))))
-
-(defthm exactp-diff-0
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n)
-		  (<= (expo (- x y)) (expo x))
-		  (<= (expo (- x y)) (expo y)))
-	     (exactp (- x y) n))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance exactp-diff (k 0))))))
-
-;bad name?
-(defthm exactp-diff-cor
-  (implies (and (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (exactp y n)
-                (<= (abs (- x y)) (abs x))
-                (<= (abs (- x y)) (abs y)))
-           (exactp (- x y) n))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance exactp-diff-0)
-                        (:instance expo-monotone (x (- x y)) (y x))
-                        (:instance expo-monotone (x (- x y)))))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defthm fp+-positive
-  (implies (<= 0 x)
-           (< 0 (fp+ x n)))
-  :rule-classes :type-prescription)
-
-(defthm fp+2-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y x)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (integerp (* (- y x) (expt 2 (- (1- n) (expo x))))))
-    :otf-flg t
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (exactp2 expt-split)())
-           :use ((:instance expo-monotone)
-                 (:instance exactp-<=-expo (x y) (e (expo x)))))))
-
-
-(defthm fp+2-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y x)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (integerp (* (- y x) (expt 2 (- (1- n) (expo x))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2)
-           :use ((:instance expo-monotone)
-                 (:instance exactp-<=-expo (x y) (e (expo x)))))))
-
-(defthm int>0
-  (implies (and (integerp n)
-                (> n 0))
-           (>= n 1))
-  :rule-classes ())
-
-(defthm fp+2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y x)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (>= y (fp+ x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split)
-		  :use (;(:instance expt-split (r 2) (i (- (1- n) (expo x))) (j (- (1+ (expo x)) n)))
-			(:instance fp+2-1)
-			(:instance int>0 (n (* (- y x) (expt 2 (- (1- n) (expo x))))))))))
-
-
-
-(defthm fp+1-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n))
-	     (<= (fp+ x n) (expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("Goal"  :in-theory (enable exactp2)
-		  :use ((:instance fp+2 (y (expt 2 (1+ (expo x)))))
-			(:instance expo-upper-bound)))))
-
-(defthm x<fp+
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (> (fp+ x n) x))
-  :rule-classes ())
-
-;export in lib/?
-(defthm ratl-fp+
-  (implies (rationalp x)
-           (rationalp (fp+ x n)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm expo-sig
-  (equal (expo (sig x))
-         0)
-  :hints (("Goal" :in-theory (enable sig))))
-
-(defthm fp+1-2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n))
-	     (or (= (fp+ x n) (expt 2 (1+ (expo x))))
-		 (= (expo (fp+ x n)) (expo x))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable fp+)
-		  :use ((:instance fp+1-1)
-			(:instance x<fp+)
-			(:instance expo-lower-bound)
-			(:instance expo-unique (x (fp+ x n)) (n (expo x)))))))
-
-(defthm fp+1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n))
-	     (exactp (fp+ x n) n))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2)
-		  :use ((:instance fp+1-2)))))
-
-(defthm expo-diff-min-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n)
-		  (> y x))
-	     (>= (expo (- y x)) (- (1+ (expo x)) n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)
-		  :use ((:instance fp+2)
-			(:instance expo-monotone (y (- y x)) (x (expt 2 (- (1+ (expo x)) n))))))))
-
-(defthm expo-diff-min-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n)
-		  (> y x))
-	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                                       EXPO-COMPARISON-REWRITE-TO-BOUND)
-		  :use ((:instance expo-diff-min-1)			
-			(:instance expo-monotone)))))
-
-
-(defthm expo-diff-min-pos
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n)
-		  (not (= y x)))
-	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expo-minus  EXPO-COMPARISON-REWRITE-TO-BOUND
-                                      EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-		  :use ((:instance expo-diff-min-2)
-			(:instance expo-diff-min-2 (x y) (y x))
-			(:instance expo-minus (x (- y x)))))))
-
-(defthm expo-diff-min-neg
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< x 0)
-		  (< y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n)
-		  (not (= y x)))
-	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expo-diff-min-pos
-                                   (x (- y))
-                                   (y (- x)))
-                        (:instance expo-minus (x x))
-                        (:instance expo-minus (x y))
-                        (:instance expo-minus (x (- (- (- x) (- y))))))
-           :in-theory (disable expo-comparison-rewrite-to-bound
-                               expo-comparison-rewrite-to-bound-2))))
-
-(defthm expo-diff-min-mixed
-  (implies (and (rationalp x)
-                (rationalp y)
-                (<= x 0)
-                (<= 0 y)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (exactp y n))
-           (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
-  :rule-classes ()
-  :hints (("Goal"
-           :use ((:instance expo-monotone
-                            (x y)
-                            (y (- y x))))
-           :in-theory (disable expo-comparison-rewrite-to-bound
-                               expo-comparison-rewrite-to-bound-2))))
-
-(local (defthm expo-diff
-         (equal (expo (+ x (* -1 y)))
-                (expo (+ y (* -1 x))))
-         :hints (("Goal" :use ((:instance expo-minus (x (+ x (* -1 y)))))))))
-
-(defthm expo-diff-min
-  (implies (and (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0)
-                (exactp x n)
-                (exactp y n)
-                (not (= y x)))
-           (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
-                                      EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-           :use ((:instance expo-diff-min-pos)
-                 (:instance expo-diff-min-neg)
-                 (:instance expo-diff-min-mixed)
-                 (:instance expo-diff-min-mixed (x y) (y x))))))
-
-(local (in-theory (disable expo-diff)))
-
-;make into a rewrite (rewrite to a claim about m?)
-;change param names to i and n?
-(defthmd exactp-2**n
-  (implies (and ;(case-split (integerp n)) ;drop?
-                (case-split (integerp m))
-                (case-split (> m 0))
-                )
-           (exactp (expt 2 n) m))
-  :hints (("Goal" :in-theory (enable exactp2)))
-  )
-
-;change param names to i and n?
-;gen to any power of 2 (e.g., (* 2 (expt n) (/ (expt m)))
-(defthm exactp-2**n-rewrite
-  (implies (case-split (integerp m)) ;move to conclusion?
-           (equal (exactp (expt 2 n) m)
-                  (< 0 m)))
-  :hints (("Goal" :in-theory (enable exactp2)))
-  )
-
-
-(defthmd expo-upper-2
-    (implies (and (< (abs x) (expt 2 n)) ;i don't like abs here
-                  (< 0 x)
-                  (rationalp x)
-		  (integerp n)
-		  )
-	     (< (expo x) n))
-  :rule-classes :linear
-  :hints (("Goal"
-		  :use ((:instance expo-lower-bound)
-			(:instance expt-strong-monotone (n (expo x)) (m n))))))
-
-
-#|
-(defthm xy2-1
-    (implies (and (rationalp z)
-		  (<= (abs (- 1 z)) 1/2))
-	     (and (<= -1 (expo z))
-		  (<= (expo z) 0)))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance expo-monotone (x 1/2) (y z))
-			(:instance expo-monotone (x z) (y 3/2))))))
-
-(defthm xy2-2
-    (implies (and (rationalp z)
-		  (<= (abs (- 1 z)) 1/2))
-	     (<= (abs (expo z)) 1))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance xy2-1)))))
-|#
-
-;move?
-(defthm abs+2
-    (implies (and (rationalp x1)
-		  (rationalp x2))
-	     (<= (abs (+ x1 x2)) (+ (abs x1) (abs x2))))
-  :rule-classes ())
-
-;move
-(defthm abs+3
-  (implies (and (rationalp x1)
-                (rationalp x2)
-                (rationalp x3))
-           (<= (abs (+ x1 x2 x3)) (+ (abs x1) (abs x2) (abs x3))))
-  :rule-classes ())
-
-#|
-(defthm xy2-3
-  (implies (and (rationalp x)
-                (rationalp y)
-                (<= (abs (- 1 (* x y y))) 1/2))
-           (and (not (= x 0)) (not (= y 0))))
-  :rule-classes ()
-  :hints (("Goal"
-           :use ((:instance xy2-1)))))
-
-
-(defthm xy2-4
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (<= (abs (- (* 2 (expo y)) (expo (* y y)))) 1))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance xy2-3)
-			(:instance expo-prod-lower (x y))
-			(:instance expo-prod-upper (x y))))))
-
-(defthm xy2-5
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (<= (abs (- (+ (expo (* y y)) (expo x)) (expo (* x y y)))) 1))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance xy2-3)
-			(:instance expo-prod-lower (y (* y y)))
-			(:instance expo-prod-upper (y (* y y)))))))
-
-(defthm xy2-6
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (<= (abs (+ (* 2 (expo y)) (expo x))) 3))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance xy2-2 (z (* x y y)))
-			(:instance xy2-4)
-			(:instance xy2-5)
-			(:instance abs+3 
-				   (x1 (- (* 2 (expo y)) (expo (* y y))))
-				   (x2 (expo (* x y y)))
-				   (x3 (- (+ (expo (* y y)) (expo x)) (expo (* x y y)))))))))
-|#
-
-;move
-(defthm abs-2
-    (implies (and (rationalp x1)
-		  (rationalp x2))
-	     (<= (abs (- x1 x2)) (+ (abs x1) (abs x2))))
-  :rule-classes ())
-
-#|
-(defthm xy2-7
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (<= (abs (* 2 (expo y))) (+ 3 (abs (expo x)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance xy2-6)
-			(:instance abs-2
-				   (x1 (+ (* 2 (expo y)) (expo x)))
-				   (x2 (expo x)))))))
-
-(defthm xy2-a
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (< (abs (expo y)) (+ (/ (abs (expo x)) 2) 2)))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance xy2-7)))))
-
-(defthm xy2-8
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp xp)
-		  (not (= xp 0))
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (<= (abs (* 2 (- (expo (* xp y)) (+ (expo xp) (expo y)))))
-		 2))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance xy2-3)
-			(:instance expo-prod-lower (x xp))
-			(:instance expo-prod-upper (x xp))))))
-
-(defthm hack4
-    (implies (and (rationalp a)
-		  (rationalp b)
-		  (rationalp c))
-	     (= (+ (* 2 a)
-		   (* 2 b)
-		   (* -2 a)
-		   (* -2 b)
-		   (* 2 c))
-		(* 2 c)))
-  :rule-classes ())
-
-(defthm xy2-9
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp xp)
-		  (= (expo xp) (expo x))
-		  (not (= xp 0))
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (<= (abs (* 2 (expo (* xp y))))
-		 (+ 5 (abs (expo x)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance abs+3
-				   (x1 (* 2 (- (expo (* xp y)) (+ (expo xp) (expo y)))))
-				   (x2 (+ (* 2 (expo y)) (expo xp)))
-				   (x3 (expo xp)))
-			(:instance hack4 (a (expo x)) (b (expo y)) (c (expo (* xp y))))
-			(:instance xy2-8)
-			(:instance xy2-6)))))
-
-(defthm xy2-10
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp xp)
-		  (= (expo xp) (expo x))
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (<= (abs (* 2 (expo (* xp y))))
-		 (+ 5 (abs (expo x)))))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance xy2-9)))))
-
-;who uses this or any of the xy2-... lemmas??
-(defthm xy2-b
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp xp)
-		  (= (expo xp) (expo x))
-		  (<= (abs (- 1 (* x y y))) 1/2))
-	     (< (abs (expo (* xp y))) (+ (/ (abs (expo x)) 2) 3)))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance xy2-10)))))
-
-|#
-
-(defthm expo-diff-abs-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x y)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (>= (expo (- y x))
-		 (- (expo y) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                                      EXPO-COMPARISON-REWRITE-TO-BOUND)
-		  :use ((:instance expo-diff-min)
-			(:instance expo-monotone (x y) (y x))))))
-
-(defthm expo-diff-abs-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x y)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (expo (- y x))
-		 (expo x)))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance expo-monotone (x (- y x)) (y x))))))
-
-(defthm expo-diff-abs-3
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (- (expo y) (1- n)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-    :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
-                                        EXPO-COMPARISON-REWRITE-TO-BOUND-2)))
-  :rule-classes ())
-
-(defthm expo-diff-abs-4
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (expo x))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-    :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
-                                        EXPO-COMPARISON-REWRITE-TO-BOUND-2)))
-    :rule-classes ())
-
-;move?
-(defthmd abs-squeeze
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp z)
-		  (rationalp m)
-		  (<= x y)
-		  (<= y z)
-		  (<= (abs x) m)
-		  (<= (abs z) m))
-	     (<= (abs y) m))
-  :rule-classes :linear)
-
-;move?
-(defthm rationalp-abs
-  (implies (case-split (rationalp x))
-           (rationalp (abs x)))
-  :rule-classes (:rewrite :type-prescription))
-
-;yuck
-(local (in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                           EXPO-COMPARISON-REWRITE-TO-BOUND)))
-
-(defthm expo-diff-abs-5
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x y)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- y x)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance abs-squeeze
-				   (m (+ (max (abs (expo x)) (abs (expo y))) (1- n)))
-				   (x (- (expo y) (1- n)))
-				   (y (expo (- y x)))
-				   (z (expo x)))
-			(:instance expo-diff-abs-1)
-			(:instance expo-diff-abs-2)
-			(:instance expo-diff-abs-3)
-			(:instance expo-diff-abs-4)))))
-
-
-(defthm expo-diff-abs-6
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (not (= x y))
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs expo-minus)
-		  :use ((:instance expo-diff-abs-5)
-			(:instance expo-diff-abs-5 (x y) (y x))
-			(:instance expo-minus (x (- x y)))))))
-
-
-
-(defthm expo-diff-abs
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" ;:in-theory (disable abs)
-		  :use ((:instance expo-diff-abs-6)
-			))))
-
-(defthm expo-diff-abs-neg-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (>= x y)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (expo (+ x y))
-		 (+ (expo x) (1- n))))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use (;(:instance expo-2x-upper)		 
-			(:instance expo-monotone (x (+ x y)) (y (* 2 x)))))))
-
-(defthm expo-diff-abs-neg-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (>= x y)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (expo x) (expo (+ x y))))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance expo-monotone (y (+ x y)))))))
-
-;move or remove?
-(defthm abs-pos
-    (implies (<= 0 x)
-	     (equal (abs x) x)))
-
-(defthm expo-diff-abs-neg-3
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (>= x y)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (+ x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance expo-diff-abs-neg-1)
-			(:instance expo-diff-abs-neg-2)
-			(:instance abs-squeeze
-				   (m (+ (max (abs (expo x)) (abs (expo y))) (1- n)))
-				   (x (expo x))
-				   (y (expo (+ y x)))
-				   (z (+ (expo x) (1- n))))
-			(:instance abs+2 (x1 (expo x)) (x2 (1- n)))))))
-
-(defthm expo-diff-abs-neg-4
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (+ x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable abs)
-		  :use ((:instance expo-diff-abs-neg-3)
-			(:instance expo-diff-abs-neg-3 (x y) (y x))))))
-
-(defthm expo-diff-abs-neg-5
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (< y 0)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable exactp2)
-                              '( abs expo-minus))
-		  :use ((:instance expo-diff-abs-neg-4 (y (- y)))
-			(:instance expo-minus (x y))))))
-
-(defthm expo-diff-abs-neg-6
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory  (set-difference-theories
-                              (enable exactp2)
-                              '( abs expo-minus))
-		  :use ((:instance expo-diff-abs-neg-4 (x (- x)))
-			(:instance expo-minus (x (- x y)))
-			(:instance expo-minus)))))
-
-(defthm expo-diff-abs-neg-neg
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< x 0)
-		  (< y 0)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable exactp2)
-                              '( abs max expo-minus))
-		  :use ((:instance expo-diff-abs (x (- x)) (y (- y)))
-			(:instance expo-minus)
-			(:instance expo-minus (x (- x y)))
-			(:instance expo-minus (x y))))))
-
-(defthm expo-diff-abs-zero-y
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (= y 0)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ())
-
-(defthm expo-diff-abs-zero-x
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expo-minus)
-		  :use ((:instance expo-minus (x y))))))
-
-(defthm expo-diff-abs-neg-x
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< x 0)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable max abs)
-		  :use ((:instance expo-diff-abs-zero-y)
-			(:instance expo-diff-abs-neg-6)
-			(:instance expo-diff-abs-neg-neg)))))
-
-(defthm expo-diff-abs-pos-x
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (integerp n)
-		  (> n 1)
-		  (exactp x n)
-		  (exactp y n))
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable max abs)
-		  :use ((:instance expo-diff-abs-zero-y)
-			(:instance expo-diff-abs)
-			(:instance expo-diff-abs-neg-5)))))
-
-(defthm expo-diff-abs-any
-    (implies (and (exactp x n)
-		  (exactp y n)
-                  (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (> n 1)
-		  )
-	     (<= (abs (expo (- x y)))
-		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable max abs)
-		  :use ((:instance expo-diff-abs-zero-x)
-			(:instance expo-diff-abs-neg-x)
-			(:instance expo-diff-abs-pos-x)))))
-;move?
-;try as a rewrite rule (perhaps with a backchain limit?)
-;why disabled?
-(defthm expo>=
-  (implies (and (<= (expt 2 n) x)
-                (rationalp x)
-                (integerp n)
-                )
-           (<= n (expo x)))
-  :otf-flg t
-  :rule-classes :linear
-  :hints (("goal" :use ((:instance expo-monotone (x (expt 2 n)) (y x))))))
-
-;move?
-;try as a rewrite rule (perhaps with a backchain limit?)
-;why disabled?
-(defthmd expo<=
-  (implies (and (< x (* 2 (expt 2 n)))
-                (< 0 x)
-                (rationalp x)
-                (integerp n)
-                )
-           (<= (expo x) n))
-  :rule-classes :linear
-  :hints (("goal" :use (expo-lower-bound
-			(:instance expt-split (r 2) (i 1) (j n))
-			(:instance expt-weak-monotone (n (1+ n)) (m (expo x)))))))
-
-(defthm sig-does-nothing
-  (implies (and (< x 2)
-                (<= 1 x)
-                (rationalp x)
-                )
-           (equal (sig x)
-                  x))
-  :hints (("Goal" :use ((:instance fp-rep-unique
-                                   (x x)
-                                   (m x)
-                                   (e (expo x))))
-           :in-theory (enable sig))))
-
-
-;proved in expo
-(defthm expo-x+2**k
-    (implies (and (< (expo x) k)
-                  (<= 0 x)
-                  (case-split (integerp k))
-		  (case-split (rationalp x))
-		  )
-	     (equal (expo (+ x (expt 2 k)))
-		    k)))
-
-
-;remove? or move elsewhere?
-#|
-bad name
-(defthm only-1-has-integerp-sig
-  (implies (and 
-            (rationalp x)
-            (not (equal x 0))
-            (integerp (sig x)))
-           (= (sig x) 1))
-  :hints (("Goal" :in-theory (disable sig-upper-bound)
-           :use (sig-upper-bound sig-lower-bound)))
-)
-|#
-
-
-;dup?
-(defthm exactp-shift-rewrite
-  (implies (and (rationalp x)
-                (integerp n)
-                (integerp k))
-           (and (equal (exactp (* (expt 2 k) x) n)
-                       (exactp x n))
-                (equal (exactp (* x (expt 2 k)) n)
-                       (exactp x n))))
-  :hints (("Goal" :use exactp-shift)))
-
-(defthm exactp-one-plus-expo
-  (implies (case-split (rationalp x)) ;gen?
-           (equal (exactp x (+ 1 (expo x)))
-                  (integerp x)))
-  :hints (("Goal" :in-theory (enable exactp)
-           :use ((:instance fp-rep)))))
-
-(defthmd sgn*
-    (implies (and (rationalp x) (rationalp y))
-	     (= (sgn (* x y)) (* (sgn x) (sgn y)))))
-
-(defthm already-sig
-  (implies (and (rationalp x)
-                (<= 1 x)
-                (< x 2))
-           (= (sig x) x)))
-
-(defthm sig-shift-4-alt
-  (implies (and (rationalp a)
-                (integerp n)
-                (case-split (not (equal a 0)))
-                )
-           (equal (sig (* a (EXPT 2 n)))
-                  (sig a)))
-  :HINTS (("Goal" :USE (:instance SIG-EXPO-SHIFT (x a)))))
-
-;add to lib?
-;can save you from having to :use fp-rep
-(defthmd fp-rep-cancel-expo
-  (implies (rationalp x)
-           (equal (* x (expt 2 (- (expo x))))
-                  (* (sgn x) (sig x))))
-  :hints (("Goal" :in-theory (enable sig
-                                     )
-           :use (fp-rep))))
-
-;do we need this?
-(defthmd fp-rep-cancel-sig
-  (equal (/ x (sig x))
-         (* (sgn x) (expt 2 (expo x))))
-  :hints (("Goal" :use (fp-rep))))
-
-;useful?
-; could be made more general?
-(defthm sig-x+2**k-non-neg
-  (implies (and (< x (expt 2 k))
-                (integerp k)
-                (rationalp x)
-                (<= 0 x)
-                )
-           (equal (sig (+ (expt 2 k) x))
-                  (+ 1 (/ x (expt 2 k)))))
-  :hints (("Goal" :in-theory (e/d () ( sig-does-nothing sig-shift))
-           :use ((:instance sig-shift
-                            (x (+ 1 (/ x (expt 2 k))))
-                            (n k))
-                 (:instance sig-does-nothing
-                            (x (+ 1 (/ x (expt 2 k)))))))))
-
-;rename?
-;what's the role of n here?
-;this does not mention trunc!
-;conceptually, x and y don't overlap
-(defthm expo-of-sum-of-disjoint
-  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
-                (exactp x n)
-                (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp n)
-                )
-           (equal (expo (+ x y))
-                  (expo x)
-                  ))
-  :hints (("Goal"  :in-theory (set-difference-theories
-                               (enable exactp sgn
-                                       expt-split expt-minus
-                                       sig
-                                       )
-                               '(expo-x+a*2**k
-                                 EXPT-COMPARE-EQUAL
-                                 EXPO-COMPARISON-REWRITE-TO-BOUND
-  ;                               EXPO-SHIFT-4-ALT-2
-                                 ))
-           :use (;(:instance expt-split (r 2) (i 1) (j (+ (EXPO X) (* -1 N))))
-                 (:instance expo<= (x y) (n (+ (EXPO X) (* -1 N))))
-                 ;(:instance fp-rep-cancel-expo)
-                 (:instance
-                  expo-x+a*2**k
-                  (x y)
-                  (k (+ (expo x) (- n) 1))
-                  (a (/ x (expt 2 (+ (expo x) (- n) 1)))))
-                 ))
-          )
-  :rule-classes nil
-  )
-
-
-
-
-(defthm exactp-with-n-not-integer
-  (implies (not (integerp n))
-           (equal (exactp x n)
-                  (or (equal 0 x)
-                      (not (rationalp x))
-                      (and (acl2-numberp n)
-                           (power2p (abs x))))))
-  :hints (("Goal" :in-theory (enable exactp sig expt-minus expt-split))))
-
-;BOZO could say power2p in conclusion?
-(defthm sig-x-1-means-power-of-2
-  (implies (and (rationalp x)
-;                (> x 0) ;gen?
-                )
-           (equal (equal (sig x) 1)
-                  (equal (expt 2 (expo x)) (abs x))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable sig expt-minus)
-                              '(expt-inverse))
-                              
-           :use ())))
-
-(defthm sig-less-than-1-means-x-0
-  (equal (< (sig x) 1)
-	 (or (equal 0 x)
-             (not (rationalp x)))))
-
-(defthm sig-integer-rewrite
-  (equal (integerp (sig x))
-         (or (not (rationalp x))
-             (equal 0 x)
-             (equal 1 (sig x))))
-  :hints (("goal" :in-theory (disable sig-x-1-means-power-of-2)))
-  )
-
-(defthm cg-sig
-  (equal (cg (sig x))
-         (if (or (not (rationalp x)) (equal 0 x))
-             0
-           (if (power2p (abs x))
-               1
-             2)))
-  :hints (("goal" :in-theory (enable cg power2p-rewrite)))
-  )
-
-(defthm sig-times-half-not-integer
-  (equal (integerp (* 1/2 (sig x)))
-         (or (equal 0 x)
-             (not (rationalp x))))
-  :hints (("goal" :in-theory (enable sig))))
-
-(defthm cg-half-sig
-  (equal (cg (* 1/2 (sig x)))
-         (if (or (not (rationalp x)) (equal 0 x))
-             0
-           1))
-  :hints (("goal" :in-theory (enable cg))))
-
-; Added for rel5:
-
diff -Nru acl2-6.2/books/rtl/rel5/support/ground-zero.lisp acl2-6.3/books/rtl/rel5/support/ground-zero.lisp
--- acl2-6.2/books/rtl/rel5/support/ground-zero.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/ground-zero.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-(in-package "ACL2")
-;includes changes to the default theory (mostly disabling built-in functions)
-
-(include-book "../arithmetic/ground-zero")
-(include-book "util")
diff -Nru acl2-6.2/books/rtl/rel5/support/guards.lisp acl2-6.3/books/rtl/rel5/support/guards.lisp
--- acl2-6.2/books/rtl/rel5/support/guards.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/guards.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,104 +0,0 @@
-(in-package "ACL2")
-
-; Proof of bits-guard:
-
-; (logand (ash x (- j)) (1- (ash 1 (1+ (- i j)))))
-; =
-; (logand (fl (/ x (expt 2 j))) (1- (expt 2 (1+ (- i j)))))
-; = {logand-slice}
-; (bits (fl (/ x (expt 2 j))) (- i j) 0)
-; = {bits-shift-down-1}
-; (bits x i j)
-
-(include-book "rtl")
-(local (include-book "top1"))
-(local (in-theory (theory 'lib-top1)))
-
-(local-defthmd bits-guard
-  (implies (and (natp x)
-                (natp i)
-                (natp j)
-                (<= j i))
-           (equal (bits x i j)
-                  (logand (ash x (- j)) (1- (ash 1 (1+ (- i j)))))))
-  :hints (("Goal" :in-theory (enable bits-shift-down-1 floor-fl expt-minus)
-           :use ((:instance logand-slice
-                            (x (ash x (- j)))
-                            (n (1+ (- i j)))
-                            (k 0))))))
-
-(verify-guards bits
-               :hints (("Goal" :use bits-guard
-                        :in-theory (enable bits fl-mod-zero))))
-
-; Proof of bitn-guard:
-
-; (bitn x i)
-; = {def. of bitn}
-; (bits x i i)
-; = {previous thm.}
-; (logand (ash x (- i)) (1- (ash 1 (1+ (- i i)))))
-; =
-; (logand (ash x (- i)) 1)
-; = {logand-with-1}
-; (if (evenp (ash x (- i))) 0 1)
-
-(local-defthmd bitn-guard
-  (implies (and (natp x)
-                (natp n))
-           (equal (bitn x n)
-                  (if (evenp (ash x (- n))) 0 1)))
-  :hints (("Goal" :in-theory (e/d (bitn logand-with-1 logand-commutative
-                                        bits-guard)
-                                  (bits-n-n-rewrite)))))
-
-(verify-guards bitn
-               :hints (("Goal" :use bitn-guard
-                        :in-theory (e/d (bitn) (bits-n-n-rewrite)))))
-
-(verify-guards lnot)
-
-(verify-guards binary-cat)
-
-(local-defthm mulcat-guard-proof-hack
-  (implies (and (< 0 l)
-                (integerp l)
-                (not (equal n 1)))
-           (not (equal l (* l n))))
-  :hints (("Goal" :use ((:instance collect-constants-with-division
-                                   (x n)
-                                   (c1 l)
-                                   (c2 l))))))
-
-(verify-guards mulcat)
-
-(verify-guards setbits)
-
-(verify-guards setbitn)
-
-(verify-guards binary-land0)
-
-(verify-guards binary-lior0)
-
-(verify-guards binary-lxor0)
-
-(include-book "land")
-
-(verify-guards binary-land
-               :hints (("Goal" :use land-is-land0
-                        :in-theory (enable binary-land0)
-                        :expand ((binary-land x y n)))))
-
-(include-book "lior")
-
-(verify-guards binary-lior
-               :hints (("Goal" :use lior-is-lior0
-                        :in-theory (enable binary-lior0)
-                        :expand ((binary-lior x y n)))))
-
-(include-book "lxor")
-
-(verify-guards binary-lxor
-               :hints (("Goal" :use lxor-is-lxor0
-                        :in-theory (enable binary-lxor0)
-                        :expand ((binary-lxor x y n)))))
diff -Nru acl2-6.2/books/rtl/rel5/support/ireps.lisp acl2-6.3/books/rtl/rel5/support/ireps.lisp
--- acl2-6.2/books/rtl/rel5/support/ireps.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/ireps.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,960 +0,0 @@
-(in-package "ACL2")
-
-; eric smith, david russinoff, with suggestions by matt kaufmann
-; amd, june 2001 
-
-;this file was previously called irepsproofs.lisp
-
-;note: the proofs in this file are messy.  i haven't taken much time to clean
-;them up by eliminating hacks or increasing elegance. -eric
-
-;todo: add t-p for isigf, etc.
-
-(include-book "rtl") ;BOZO remove!
-(include-book "bias")
-(include-book "float") ;for the defns
-(local (include-book "merge"))
-(local (include-book "cat"))
-(local (include-book "bvecp"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "../arithmetic/top"))
-
-(local (in-theory (enable bvecp-forward)))
-
-;;encoding of floating-point numbers with implicit msb
-;;bit vectors of length p+q, consisting of 1-bit sign field, 
-;;q-bit exponent field (bias = 2**(q-1)-1), and (p-1)-bit 
-;;significand field:
-;; p must be > 1
-
-
-
-;;;**********************************************************************
-;;;                       field extractors
-;;;**********************************************************************
-
-(defund isgnf  (x p q) (bitn x (1- (+ p q))))
-(defund iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
-(defund isigf  (x p)   (bits x (- p 2) 0))
-
-
-;;;**********************************************************************
-;;;                       representable numbers
-;;;**********************************************************************
-
-(defund nrepp (x p q)
-  (and (rationalp x)
-       (not (= x 0))
-       (< 0 (+ (expo x) (bias q)))
-       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
-       (exactp x p)))
-
-(defund drepp (x p q)
-  (and (rationalp x)
-       (not (= x 0))
-       (<= (- 2 p) (+ (expo x) (bias q)))
-       (<= (+ (expo x) (bias q)) 0)
-       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x))))) ;use bias here?
-;bits available in the sig field = p-1-(-bias-expo(x))
-
-(defund irepp (x p q)
-  (or (nrepp x p q)
-      (drepp x p q)))
-
-
-;;;**********************************************************************
-;;;                      valid encodings
-;;;**********************************************************************
-
-(defund nencodingp (x p q)
-  (and (bvecp x (+ p q))
-       (< 0 (iexpof x p q))
-       (< (iexpof x p q) (- (expt 2 q) 1))))
-
-(defund dencodingp (x p q)
-  (and (bvecp x (+ p q))
-       (= (iexpof x p q) 0)
-       (not (= (isigf x p) 0))))
-
-(defund iencodingp (x p q)
-  (or (nencodingp x p q)
-      (dencodingp x p q)))
-
-
-;;;**********************************************************************
-;;;                       encode
-;;;**********************************************************************
-
-; sig, expo, and sgn are defined in float.lisp
-
-(defund dencode (x p q)
-  (cat (cat (if (= (sgn x) 1) 0 1)
-	    1
-            0
-            q)
-       (1+ q)
-       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
-       (- p 1)))
-
-(defund nencode (x p q)
-  (cat (cat (if (= (sgn x) 1) 0 1)
-	    1
-            (+ (expo x) (bias q))
-            q)
-       (1+ q)
-       (* (- (sig x) 1) (expt 2 (- p 1)))
-       (- p 1)))
-
-(defund iencode (x p q)
-  (cond ((nrepp x p q)
-	 (nencode x p q))
-	((drepp x p q)
-	 (dencode x p q))))
-
-;;;**********************************************************************
-;;;                       decode
-;;;**********************************************************************
-
-(defund ndecode (x p q)
-  (* (if (= (isgnf x p q) 0) 1 -1)
-     (+ (expt 2 (- (iexpof x p q) (bias q)))
-        (* (isigf x p)
-           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
-
-
-(defund ddecode (x p q)
-  (* (if (= (isgnf x p q) 0) 1 -1)
-     (isigf x p)
-     (expt 2 (+ 2 (- (bias q)) (- p)))))
-
-
-(defund idecode (x p q)
-  (cond ((nencodingp x p q)
-	 (ndecode x p q))
-	((dencodingp x p q)
-	 (ddecode x p q))))
-
-;;;**********************************************************************
-;;;                       theorems
-;;;**********************************************************************
-
-(defthm nencodingp-means-not-dencodingp
-  (implies (nencodingp x p q)
-	   (not (dencodingp x p q)))
-  :rule-classes ((:rewrite :backchain-limit-lst (0)))
-  :hints (("goal" :in-theory (enable iencodingp nencodingp dencodingp))))
-
-(defthm dencodingp-means-not-nencodingp
-  (implies (dencodingp x p q)
-	   (not (nencodingp x p q)))
-  :rule-classes ((:rewrite :backchain-limit-lst (0)))
-  :hints (("goal" :in-theory (enable iencodingp nencodingp dencodingp))))
-
-(defthm not-both-nencodingp-and-dencodingp
-  (implies (iencodingp x p q)
-	   (iff (nencodingp x p q) (not (dencodingp x p q))))
-  :hints (("Goal" :in-theory (enable iencodingp)))
-  :rule-classes ())
-
-
-
-; the field extractors return bit-vectors.
-
-
-;some of the rules below may be bad because they are put into both the
-; forward-chaining and type-prescription rule classes, causing them
-; not to always work. 
-
-;!! rc
-(defthm bvecp-isigf-forward-3
-  (implies (case-split (integerp p))
-           (bvecp (isigf x p) (- p 1)))
-  :hints (("goal" :in-theory (enable isigf)))
-  :rule-classes (:rewrite
-                 (:forward-chaining :trigger-terms ((isigf x p)))
-                 ))
-
-(defthm iexpof-bvecp
-  (implies (case-split (integerp q))
-           (bvecp (iexpof x p q) q))
-  :hints (("goal" :in-theory (enable iexpof))))
-
-(defthm isgnf-bvecp
-  (bvecp (isgnf x p q) 1)
-  :hints (("goal" :in-theory (enable isgnf))))
-
-;forward-chaining-rules for encoding types
-
-(defthm nencodingp-forward-to-iencodingp
-  (implies (nencodingp x p q)
-           (iencodingp x p q) )
-  :hints (("goal" :in-theory (enable iencodingp nencodingp)))
-  :rule-classes (:rewrite :forward-chaining)
-  )
-
-(defthm dencodingp-forward-to-iencodingp
-  (implies (dencodingp x p q)
-           (iencodingp x p q) )
-  :hints (("goal" :in-theory (enable iencodingp dencodingp)))
-  :rule-classes (:rewrite :forward-chaining)
-  )
-
-;needed? t-p?
-(defthm not-zero-ddecode
-  (implies (and (dencodingp x p q)
-                (integerp p)
-                (< 1 p)
-                (integerp q)
-                (< 0 q))
-           (not (equal (ddecode x p q) 0)))
-  :hints (("goal" :in-theory (enable ddecode dencodingp))))
-
-(defthm not-zero-ndecode
-  (implies (and ;(nencodingp x p q)
-                (rationalp x)
-                (>= x 0)
-                (integerp p)
-                (< 1 p)
-                (integerp q)
-                (< 0 q))
-           (not (equal (ndecode x p q) 0)))
-  :hints (("goal" :in-theory (enable ndecode nencodingp))))
-
-;move
-;BOZO make a negative-syntaxp version
-;or just enable sgn?
-(defthm sgn-minus-dist
-  (implies (and (acl2-numberp x)
-                (acl2-numberp y))
-           (equal (sgn (+ (* -1 x) (* -1 y)))
-                  (* -1 (sgn (+ x y)))))
-  :hints (("Goal" :in-theory (disable sgn-minus)
-          :use (:instance sgn-minus (x (* -1 (+ x y)))))))
-
-(defthm expo-ndecode
-  (implies (and (nencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))  
-           (equal (expo (ndecode x p q))
-                  (- (iexpof x p q) (bias q))))
-  :hints (("goal" :in-theory (e/d (ndecode nencodingp 
-                                           expt-split
-                                           expt-minus
-                                           isigf
-                                           )
-                                  ()))))
-
-(defthm sgn-ndecode
-  (implies (and ; (nencodingp x p q)
-            (rationalp x)
-            (>= x 0)
-            (integerp p)
-            (> p 1)
-            (integerp q)
-            (> q 0))
-           (equal (sgn (ndecode x p q))
-                  (if (= (isgnf x p q) 0) 1 -1)))
-  :hints (("goal" :in-theory (enable ndecode sgn))))
-
-;remove from :rewrite?
-(defthm nencodingp-forward-to-positive-integerp
-  (implies (nencodingp x p q)
-           (and (integerp x)
-                (<= 0 x)))
-  :hints (("Goal" :in-theory (enable nencodingp)))
-  :rule-classes (:forward-chaining))
-
-(defthm dencodingp-forward-to-positive-integerp
-  (implies (dencodingp x p q)
-           (and (integerp x)
-                (<= 0 x)))
-  :hints (("Goal" :in-theory (enable dencodingp)))
-  :rule-classes (:forward-chaining))
-
-;BOZO do we even need this?
-(defthmd ndecode-rewrite
-  (implies (and (rationalp x)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (= (ndecode x p q)
-              (* (if (= (isgnf x p q) 0) 1 -1)
-                 (* (expt 2 (- (iexpof x p q) (bias q)))
-                    (+ 1 (* (isigf x p)
-                            (expt 2 (+ 1 (- p)))))))))
-  :hints (("Goal" :in-theory (enable ndecode))))
-
-(defthm isigf-upper-bound-linear
-  (implies (case-split (integerp p))
-           (< (isigf x p) (expt 2 (- p 1) )))
-  :rule-classes (:rewrite :linear))
-
-(defthm sig-ndecode
-  (implies (and (nencodingp x p q) ;gen?
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (sig (ndecode x p q))
-                  (+ 1 (/ (isigf x p) (expt 2 (- p 1))))
-                  ))
-  :otf-flg t
-  :hints (("goal" :use (:instance expo-unique (x (+ 1
-                                                    (* 2 (/ (EXPT 2 P))
-                                                       (BITS X (+ -2 P) 0))))
-                                  (n 0))
-           :in-theory (set-difference-theories
-                       (enable ndecode
-                               expt-split
-                               expt-minus
-                               isigf iexpof ; isgnf
-                               sig
-;                                       nencodingp
-                               )
-                       '( EXPO-UNIQUE-ERIC-2)))))
-
-;instead, just open up sgn?
-(defthm sgn-ddecode
-  (implies (and (dencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (sgn (ddecode x p q))
-                  (if (= (isgnf x p q) 0) 1 -1)))
-  :hints (("Goal" :in-theory (e/d (ddecode dencodingp sgn) ()))))
-
-(defthm sig-ddecode
-  (implies (and (dencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (sig (ddecode x p q))
-                  (sig (isigf x p))))
-  :hints (("Goal" :in-theory (e/d ( ddecode sgn ) ()))))
-
-(defthm expo-ddecode
-  (implies (and (dencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (expo (ddecode x p q))
-                  (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))
-  :hints (("Goal" :in-theory (enable ddecode dencodingp ))))
-
-(defthm sgn-idecode
-  (implies (and (iencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (sgn (idecode x p q))
-                  (if (= (isgnf x p q) 0) 1 -1)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable idecode iencodingp ISGNF NDECODE)
-                              '()))))
-
-(defthm sig-idecode
-  (implies (and (iencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (sig (idecode x p q))
-                  (cond ((nencodingp x p q)
-                         (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
-                        ((dencodingp x p q)
-                         (sig (isigf x p))))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable idecode iencodingp)
-                              '()))))
-
-(defthm expo-idecode
-  (implies (and (iencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (expo (idecode x p q))
-                  (cond ((nencodingp x p q)
-                         (- (iexpof x p q) (bias q)))         
-                        ((dencodingp x p q)
-                         (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))))         
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable idecode iencodingp)
-                              '()))))
-
-
-;move?
-(defthm expo-bvecp-upper-bound
-  (implies (and (bvecp x n)
-                (integerp n)
-                (< 0 n))
-           (< (expo x) n))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use ((:instance expo<= ( n (- n 1))))))
-  :rule-classes (:rewrite (:linear :match-free :all)))
-
-(local (in-theory (disable bvecp-exactp))) ;why? efficiency?
-
-;nice lemma?
-(local
- (defthm drepp-decode-1
-  (IMPLIES (AND (DENCODINGP X P Q)
-                (INTEGERP P)
-                (< 1 P)
-                (INTEGERP Q)
-                (< 0 Q))
-           (EXACTP (DDECODE X P Q)
-                   (+ (* -1 (BIAS Q))
-                      (EXPT 2 (1- Q))
-                      (EXPO (ISIGF X P)))))
-  :hints (("Goal" :in-theory (enable ddecode dencodingp bias)))))     
-
-(defthm drepp-ddecode
-  (implies (and (dencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (drepp (ddecode x p q) p q))
-  :hints (("Goal" :use drepp-decode-1
-           :in-theory (set-difference-theories
-                       (enable drepp)
-                       '(drepp-decode-1)))))
-
-;BOZO yuck. better expo-shift rules would help here..
-(defthm nrepp-ndecode-hack
-  (implies (and (nencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (exactp (ndecode x p q) p))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable nrepp nencodingp ndecode exactp
-                                      a15
-                                      ndecode-rewrite
-;expt-split
-                                      )
-                              '(a9 distributivity
-                                   )))
-          (and stable-under-simplificationp ;yuck?
-               '(:in-theory (enable a9 distributivity a15)))))
-
-
-#|
-
-(defthm nrepp-ndecode-hack
-  (implies (and (nencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (exactp (ndecode x p q) p))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable nrepp nencodingp ndecode exactp
-                                      a15
-                                      ndecode-rewrite
-                                      expt-split
-                                      expt-minus
-                                      sig
-                                      isigf
-                                      isgnf
-                                      iexpof
-                                      )
-                              '(;a9 distributivity
-                                a15
-                                   )))
-          (and stable-under-simplificationp ;yuck?
-               '(:in-theory (enable a9 distributivity a15)))))
-|#
-
-
-
-
-(defthm nrepp-ndecode
-  (implies (and (nencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (nrepp (ndecode x p q) p q))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable nrepp nencodingp)
-                              '()))))
-
-(defthm irepp-idecode
-  (implies (and (iencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (irepp (idecode x p q) p q))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable idecode irepp iencodingp)
-                              '()))))
-
-
-(local
- (defthm nencodingp-nencode-2-1
-   (IMPLIES (AND (RATIONALP X)
-                 (NOT (EQUAL X 0))
-                 (EXACTP X P)
-                 (INTEGERP P)
-                 (<= 1 P)
-                 )
-            (integerp (+ (* -1 (EXPT 2 (1- P)))
-                         (* (SIG X) (EXPT 2 (1- P))))
-                      ))
-   :hints (("Goal" :in-theory (enable exactp)
-            :use ( sig-lower-bound)))))
-
-(local 
- (defthm nencodingp-nencode-2
-   (IMPLIES (AND (NREPP X P Q)
-                 (INTEGERP P)
-                 (< 1 P)
-                 (INTEGERP Q)
-                 (< 0 Q))
-            (<= 0 (NENCODE X P Q)))
- :hints (("Goal"  :in-theory (enable nencode nrepp)))))
-
-(local
- (defthm nencodingp-nencode-3
-   (IMPLIES (AND (NREPP X P Q)
-                 (INTEGERP P)
-                 (< 1 P)
-                 (INTEGERP Q)
-                 (< 0 Q))
-            (< (NENCODE X P Q) (EXPT 2 (+ P Q))))
-   :hints (("Goal" :in-theory (enable nencode)))))
-
-
-(local
- (defthm nencodingp-nencode-4
-   (IMPLIES (AND (NREPP X P Q)
-                 (INTEGERP P)
-                 (< 1 P)
-                 (INTEGERP Q)
-                 (< 0 Q))
-            (< 0 (IEXPOF (NENCODE X P Q) P Q)))
-   :hints (("Goal"  :in-theory (e/d ( nencode 
-                                      iexpof 
-                                      bvecp
-                                      nrepp
-                                      bits-tail) (sig-lower-bound sig-upper-bound))
-            :use (sig-upper-bound sig-lower-bound)))))
-
-
-(local
- (defthm nencodingp-nencode-5
-   (IMPLIES (AND (NREPP X P Q)
-                 (INTEGERP P)
-                 (< 1 P)
-                 (INTEGERP Q)
-                 (< 0 Q))
-            (< (IEXPOF (NENCODE X P Q) P Q)
-               (1- (EXPT 2 Q))))
-   :hints (("Goal"  :in-theory (e/d (nrepp nencode iexpof bvecp
-                                       bits-tail) (sig-lower-bound sig-upper-bound))
-            :use (sig-upper-bound sig-lower-bound)))))
-
-(defthm nencodingp-nencode
-  (implies (and (nrepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (nencodingp (nencode x p q) p q) )
-  :hints (("Goal" :in-theory (enable nencodingp bvecp)))
-  :OTF-FLG T)
-
-(local
- (defthm dencodingp-dencode-hack-3
-   (implies (and (drepp x p q)
-                 (integerp p)
-                 (> p 1)
-                 (integerp q)
-                 (> q 0))
-            (equal (* (SIG X)
-                      (EXPT 2 (+ -3 P (EXPO X) (EXPT 2 (1- Q)))))
-                   (* (abs x) (EXPT 2 (+ -3 P (EXPT 2 (1- Q)))))))
-   :hints (("Goal" :in-theory (set-difference-theories
-                               (enable drepp sgn)
-                               '(fp-rep-collapse abs))
-            :use fp-abs))
-   :rule-classes nil))
-
-
-(local (in-theory (disable expt-compare))) ;yuck
-
-(local 
- (defthmd dencodingp-dencode-hack-4
-   (implies (and (drepp x p q)
-                 (integerp p)
-                 (> p 1)
-                 (integerp q)
-                 (> q 0))
-            (bvecp (* (SIG X)
-                      (EXPT 2 (+ -3 P (EXPO X) (EXPT 2 (1- Q)))))
-                   (- p 1)))
-           
-   :hints (("Goal" :in-theory (set-difference-theories (enable dencodingp drepp dencode
-                                                               iexpof isigf bias exactp
-                                                               expt-split
-                                                               bvecp)
-                                                       '(abs EXPT-COMPARE sig-upper-bound))
-            :use (dencodingp-dencode-hack-3
-                  sig-upper-bound 
-                  (:instance expt-weak-monotone
-                             (n (+ -3 P (EXPO X) (EXPT 2 (1- Q))))
-                             (m (- p 2))))))))
-
-(defthm dencodingp-dencode
-  (implies (and (drepp x p q)
-                (integerp p)
-;                (> p 1)
-                (integerp q)
-                (> q 0)
-                )
-           (dencodingp (dencode x p q) p q) )
-  :hints (("Goal" :in-theory (e/d (exactp 
-                                     dencodingp 
-                                     drepp 
-                                     dencode
-                                     iexpof 
-                                     isigf 
-                                     bias
-                                     bits-tail
-                                     
-                                     bvecp
-                                     bvecp-bits-0
-                                     )
-                                  (sig-upper-bound
-                                   BITS-SHIFT
-                                   BITS-SPLIT-AROUND-ZERO))
-           :use (sig-upper-bound 
-                 sig-lower-bound 
-                 dencodingp-dencode-hack-4
-                 (:instance expt-strong-monotone
-                            (n (- p 1))
-                            (m (+ p q)))
-                 (:instance expt-strong-monotone
-                            (n (- p 1))
-                            (m (+ p q -1)))))))
-
-(defthm drepp-forward-to-rationalp
-  (implies (drepp x p q)
-           (rationalp x))
-  :hints (("Goal" :in-theory (enable drepp)))
-  :rule-classes ((:forward-chaining :trigger-terms ((drepp x p q)))))
-
-(defthm drepp-zero-false
-  (not (drepp 0 p q))
-  :hints (("Goal" :in-theory (enable drepp))))
-
-(defthm iencodingp-iencode
-  (implies (and (irepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (iencodingp (iencode x p q) p q) )
-  :hints (("Goal" :in-theory (enable iencodingp irepp iencode))))
-
-;prove a thm about bvecp of sig-1?
-(defthm isigf-nencode-0
-  (implies (and (rationalp x)
-                (not (equal x 0))
-                (exactp x p)
-                (integerp p)
-                (< 1 p)
-                )
-           (bvecp (+ (* -1 (expt 2 (1- p)))
-                     (* (sig x) (expt 2 (1- p))))
-                  (- p 1)))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable bvecp)
-                              '(nencodingp-nencode-2-1 
-                                sig-upper-bound))
-           :use (sig-lower-bound sig-upper-bound nencodingp-nencode-2-1)))
-  :rule-classes nil)
-
-(defthm isgnf-nencode
-  (implies (and (nrepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (isgnf (nencode x p q) p q)
-                  (if (equal (sgn x) 1) 0 1)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable isgnf nencode nrepp bvecp)
-                              '(nencodingp-nencode-2-1 
-                                bitn-bvecp-0 
-                                sig-upper-bound
-                                                        ))
-           :use (nencodingp-nencode-2-1
-                 sig-lower-bound
-                 sig-upper-bound
-                 (:instance bitn-bvecp-0 (m 0)
-                            (x (+ (BIAS Q) (EXPO X)))
-                            (n q))))))
-
-(defthm isgnf-dencode
-  (implies (and (drepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (isgnf (dencode x p q) p q)
-                  (if (= (sgn x) 1) 0 1)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable isgnf dencode drepp bvecp bias)
-                              '(nencodingp-nencode-2-1 bitn-bvecp-0))
-           :use (dencodingp-dencode-hack-4 
-                 (:instance expt-strong-monotone
-                            (n (- p 1))
-                            (m (+ p q -1)))
-                 (:instance bitn-bvecp-0 
-                            (m q)
-                            (x (* (SIG X)
-                                  (EXPT 2 (+ -3 P (EXPO X) (EXPT 2 (1- Q))))))
-                            (n (- p 1)))))))
-
-(defthm isgnf-iencode
-  (implies (and (irepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (isgnf (iencode x p q) p q)
-                  (if (equal (sgn x) 1) 0 1)))
-  
-  :hints (("Goal" :in-theory (enable irepp iencode))))
-  
-(defthm isigf-nencode-1
-  (implies (and (nrepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (bvecp (+ (* -2 (EXPT 2 (+ -2 P)))
-                     (* 2 (SIG X) (EXPT 2 (+ -2 P)))) (- p 1)   ))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable isigf nencode nrepp bvecp expt-split)
-                              '())
-           :use isigf-nencode-0))
-  :rule-classes nil)
-
-(defthm isigf-nencode
-  (implies (and (nrepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (isigf (nencode x p q) p)
-                  (* (- (sig x) 1) (expt 2 (- p 1)))))
-  :hints (("Goal" :in-theory (e/d (isigf nencode nrepp expt-split bvecp bias bits-tail)
-                                  (bits-shift
-                                   BITS-SUM-DROP-IRRELEVANT-TERM-1-OF-2
-                                   BITS-SHIFT-BY-CONSTANT-POWER-OF-2))
-           :use (isigf-nencode-1
-                 ))))
-
-(defthm isigf-dencode
-  (implies (and (drepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (isigf (dencode x p q) p)
-                  (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))))
-  
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable isigf dencode drepp bias bits-tail lead-bit-0)
-                              '(BITS-SHIFT))
-           :use dencodingp-dencode-hack-4)))
-
-(defthm iexpof-nencode
-  (implies (and (nrepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (iexpof (nencode x p q) p q)
-                  (+ (expo x) (bias q))))
-  :hints (("Goal" :in-theory (enable iexpof nencode nrepp bvecp
-                                     bits-tail)  
-           :use (isigf-nencode-1))))
-
-(defthm iexpof-dencode
-  (implies (and (drepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (iexpof (dencode x p q) p q)
-                  0))
-  :otf-flg t
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable iexpof dencode drepp bias
-                                      bvecp-bits-0
-                                      )
-                              '())
-           :use (dencodingp-dencode-hack-4))))
-
-(defthm ndecode-nencode
-  (implies (and (nrepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (ndecode (nencode x p q) p q)
-                  x))
-  :hints (("Goal" :in-theory (enable nrepp ndecode sgn expt-split expt-minus))))
-
-(defthm ddecode-dencode
-  (implies (and (drepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (ddecode (dencode x p q) p q)
-                  x))
-  :hints (("Goal" :in-theory (enable drepp ddecode sgn expt-split expt-minus))))
-
-(defthm not-both-nrepp-and-drepp
-  (implies (irepp x p q)
-	   (iff (nrepp x p q)
-		(not (drepp x p q))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable irepp nrepp drepp))))
-
-(defthm idecode-iencode
-  (implies (and (irepp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal
-            (idecode (iencode x p q) p q)
-            x))
-  :hints (("Goal" :in-theory (enable irepp idecode iencode idecode)
-		  :use (dencodingp-dencode
-			not-both-nrepp-and-drepp))))
-
-(defthm nencode-ndecode
-  (implies (and (nencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (nencode (ndecode x p q) p q)
-                  x))
-  :hints (("Goal" :in-theory (set-difference-theories
-			      (enable nencodingp nencode iexpof isigf isgnf sgn
-				      cat lead-bit-0
-				      expt-split
-				      bits-reduce ;why?
-				      )
-; Modification by Matt K. for v2-9, due to the change to rewrite-clause that
-; avoids using forward-chaining facts derived from a literal that has been
-; rewritten: use sgn-ndecode explicitly (see :use hint below) and hence disable
-; it here.
-
-			      '(sgn-ndecode))
-           :use (sgn-ndecode
-                 (:instance bits-plus-bits
-                            (m 0)
-                            (p (- p 1))
-                            (n (+ -2 p q)))
-                 (:instance bitn-plus-bits
-                            (n (+ p q -1))
-                            (m 0))
-                 (:instance bitn-0-1 (x x) (n (+ -1 p q)))))))
-
-(defthm dencode-ddecode
-  (implies (and (dencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (dencode (ddecode x p q) p q)
-                  x))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable dencodingp dencode iexpof isigf isgnf sgn
-                                      cat lead-bit-0 expt-split expt-minus)
-                              '())
-           :use ((:instance bits-plus-bits
-                            (m 0)
-                            (p (- p 1))
-                            (n (+ -2 p q)))
-                 (:instance fp-rep (x (BITS X (+ -2 P) 0)))
-                 (:instance bitn-plus-bits
-                            (n (+ p q -1))
-                            (m 0))
-                 (:instance bitn-0-1 (x x) (n (+ -1 p q)))
-                 ))))
-
-(defthm iencode-idecode
-  (implies (and (iencodingp x p q)
-                (integerp p)
-                (> p 1)
-                (integerp q)
-                (> q 0))
-           (equal (iencode (idecode x p q) p q)
-                  x))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable irepp idecode iencode idecode IENCODINGP)
-                              '())
-		  :use (
-			(:instance not-both-nrepp-and-drepp (x (ddecode x p q)))))))
-
-(defthm nrepp-bvecp-sig
-  (implies (and (natp p)
-                (> p 0)
-                (nrepp x p q))
-           (bvecp (* (1- (sig x)) (expt 2 (1- p)))
-                  (1- p)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (nrepp exactp bvecp) ()))))
-
-; Matt K., after v4-2:
-; Commenting out the following rule, which rewrites a term to itself!
-#||
-(defthm nencode-nencode
-  (implies (and (nrepp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (equal (nencode x p q) (nencode x p q)))
-  :hints (("Goal" :use (nrepp-bvecp-sig)
-		  :in-theory (enable nencode nencode bits-tail nrepp bvecp))))
-||#
-
-(defthm drepp-bvecp-sig
-    (implies (and (integerp p)
-		  (natp q)
-		  (> q 0)
-		  (drepp x p q))
-	     (bvecp (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
-		    (1- p)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (bias drepp exactp bvecp expt-split) (sig-upper-bound
-                                                                        ))
-		  :use (;sig-lower-bound
-			sig-upper-bound
-			(:instance expt-weak-monotone (n (+ -3 P (EXPO X) (EXPT 2 (+ -1 Q)))) (m (- p 2)))))))
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/land.lisp acl2-6.3/books/rtl/rel5/support/land.lisp
--- acl2-6.2/books/rtl/rel5/support/land.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/land.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,604 +0,0 @@
-; Port land0 theorems to land.  The original definition of land (in rel4) was
-; that of land0 in the current release.  So the port is to keep all the lemmas
-; about land0 and then use equality of land0 with land to port them to land.
-
-(in-package "ACL2")
-
-(include-book "land0")
-(local (include-book "top1")) ; for land0-bits-1 and land0-bits-2
-
-(defun binary-land (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)
-                  :verify-guards nil))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (and (equal (bitn x 0) 1)
-                       (equal (bitn y 0) 1))
-                  1
-                0))
-             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-land (mod x 2) (mod y 2) 1))))
-       :exec ; (land0 x y n)
-       (logand (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro land (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
-         `(binary-land ,@x))
-        (t         
-         `(binary-land ,(car x)
-                       (land ,@(cdr x))
-                       ,(car (last x))))))
-
-; We attempt to derive all land results from corresponding land0 results.
-
-(encapsulate
- ()
-
- (local
-  (defun p0 (x y n)
-    (equal (land x y n)
-           (land0 x y n))))
-
- (local
-  (defthm p0-holds-inductive-step
-    (implies (and (not (zp n))
-                  (not (equal n 1))
-                  (p0 (fl (* x 1/2))
-                      (fl (* y 1/2))
-                      (+ -1 n))
-                  (p0 (mod x 2) (mod y 2) 1))
-             (p0 x y n))
-    :hints (("Goal" :use (land0-def binary-land)))))
-
- (local
-  (defthm p0-holds-base-1
-    (p0 x y 1)
-    :hints (("Goal" :in-theory (enable bitn)
-             :expand ((binary-land0 x y 1))))))
-
- (local
-  (defthm p0-holds-base-0
-    (implies (zp n)
-             (p0 x y n))
-    :hints (("Goal" :expand ((binary-land0 x y n))))))
-
- (local
-  (defthm p0-holds
-    (p0 x y n)
-    :hints (("Goal" :induct (land x y n)
-             :in-theory (disable p0)))
-    :rule-classes nil))
-
- (defthmd land-is-land0
-   (equal (land x y n)
-          (land0 x y n))
-   :hints (("Goal" :use p0-holds))))
-
-(local (in-theory (e/d (land-is-land0) (binary-land))))
-
-;Allows things like (in-theory (disable land)) to refer to binary-land.
-(add-macro-alias land binary-land)
-
-(defthm land-nonnegative-integer-type
-  (and (integerp (land x y n))
-       (<= 0 (land x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-land)))
-
-;drop this if we plan to keep natp enabled?
-(defthm land-natp
-  (natp (land x y n)))
-
-;BOZO split into 2 rules?
-(defthm land-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (land x y n)
-                  0)))
-
-(defthmd land-bvecp-simple
-  (bvecp (land x y n) n)
-  :hints (("Goal" :use land0-bvecp-simple)))
-
-(defthm land-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (land x y n) k)))
-
-
-;;
-;; Rules to normalize land terms (recall that LAND is a macro for BINARY-LAND):
-;;
-
-;This guarantees that the n parameters to nested LAND calls match.
-;Note the MIN in the conclusion.
-;BOZO do we expect MIN to be enabled?  Maybe we should use IF instead for this and other rules?
-(defthm land-nest-tighten
-  (implies (and (syntaxp (not (equal m n)))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (land x (land y z m) n)
-                  (land x (land y z (min m n)) (min m n)))))
-
-; allow the n's to differ on this?
-(defthm land-associative
-  (equal (land (land x y n) z n)
-         (land x (land y z n) n)))
-
-(defthm land-commutative
-  (equal (land y x n)
-         (land x y n)))
-
-; allow the n's to differ on this?
-(defthm land-commutative-2
-  (equal (land y (land x z n) n)
-         (land x (land y z n) n)))
-
-; allow the n's to differ on this?
-(defthm land-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (land x (land y z n) n)
-                  (land (land x y n) z n))))
-
-(defthm land-0
-  (equal (land 0 y n)
-         0))
-
-;nicer than the analogous rule for logand? is it really?
-;BOZO gen the second 1 in the lhs?
-(defthm land-1
-  (equal (land 1 y 1)
-         (bitn y 0)))
-
-(defthm land-self
-  (equal (land x x n)
-         (bits x (1- n) 0)))
-
-;perhaps use only the main rule, bits-land?
-(defthmd bits-land-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (land x y n) i j)
-                  (land (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j)))))
-  :hints (("Goal" :use bits-land0-1)))
-
-;perhaps use only the main rule, bits-land?
-(defthmd bits-land-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (land x y n) i j)
-                  (land (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j)))))
-  :hints (("Goal" :use bits-land0-2)))
-
-;Notice the call to MIN in the conclusion.
-(defthm bits-land
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (land x y n) i j)
-                  (land (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-land-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land x y n) m)
-                  (land (bitn x m) 
-                        (bitn y m) 
-                        1))))
-(defthmd bitn-land-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-land
-  (implies (and (case-split (<= 0 k))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land x y n) k)
-                  (if (< k n)
-                      (land (bitn x k)
-                            (bitn y k) 
-                            1)
-                    0))))
-
-;BOZO see land-equal-0
-;drop bvecp hyps and put bitn in conclusion?
-(defthm land-of-single-bits-equal-0
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 0 (land x y 1))
-                  (or (equal x 0)
-                      (equal y 0)))))
-
-(defthm land-of-single-bits-equal-1
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 1 (land x y 1))
-                  (and (equal x 1)
-                       (equal y 1)))))
-
-(defthm land-ones
-  (equal (land (1- (expt 2 n)) x n)
-         (bits x (1- n) 0))
-  :hints (("Goal" :use land0-ones))
-  :rule-classes ())
-
-;land-with-all-ones will rewrite (land x n) [note there's only one value being ANDed], because (land x n)
-;expands to (BINARY-LAND X (ALL-ONES N) N) - now moot???
-;BOZO drop bvecp hyp and move to conclusion?
-(defthm land-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (land (all-ones n) x n)
-                  x)))
-
-(defthmd land-ones-rewrite
-  (implies (and (syntaxp (and (quotep k) (quotep n)))
-                (equal k (1- (expt 2 n))) ;this computes on constants...
-                )
-           (equal (land k x n)
-                  (bits x (1- n) 0)))
-  :hints (("Goal" :use land0-ones-rewrite)))
-
-(defthm land-def-original
-  (implies (and (integerp x)
-                (integerp y)
-                (> n 0)
-                (integerp n)
-                )
-           (equal (land x y n)
-                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (land (mod x 2) (mod y 2) 1))))
-  :hints (("Goal" :use land0-def))
-  :rule-classes ())
-
-(defthmd land-mod-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (mod (land x y n) 2)
-                  (land (mod x 2) (mod y 2) 1)))
-  :hints (("Goal" :use land0-mod-2)))
-
-;BOZO RHS isn't simplified...
-(defthmd land-fl-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (fl (/ (land x y n) 2))
-                  (land (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-  :hints (("Goal" :use land0-fl-2)))
-
-;BOZO rename to land-with-n-0
-;what if n is negative? or not an integer?
-(defthm land-x-y-0
-  (equal (land x y 0) 0))
-
-;actually, maybe only either x or y must be a bvecp of length n
-;n is a free var
-(defthm land-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (natp n)
-		  (natp m)
-		  (< n m))
-	     (equal (land x y m)
-                    (land x y n))))
-
-;deceptive name; this only works for single bits!
-(defthm land-equal-0
-  (implies (and (bvecp i 1)
-                (bvecp j 1))
-           (equal (equal 0 (land i j 1))
-                  (or (equal i 0)
-                      (equal j 0)))))
-
-;make alt version?
-(defthm land-bnd
-  (implies (case-split (<= 0 x))
-           (<= (land x y n) x))
-  :rule-classes (:rewrite :linear))
-
-;enable? make an alt version??
-(defthmd land-ignores-bits
-  (equal (land (bits x (1- n) 0) y n)
-         (land x y n))
-  :hints (("Goal" :use land0-ignores-bits)))
-
-(defthmd land-with-shifted-arg
-  (implies (and (integerp x) ;gen?
-                (rationalp y)
-                (integerp m)
-                (integerp n)
-                (<= 0 m)
-                )
-           (equal (land (* (expt 2 m) x) y n)
-                  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m))))))
-  :hints (("Goal" :use land0-with-shifted-arg)))
-
-(defthm land-shift
-  (implies (and (integerp x)
-                (integerp y)
-                (natp k))
-           (= (land (* (expt 2 k) x)
-                    (* (expt 2 k) y)
-                    n)
-              (* (expt 2 k) (land x y (- n k)))))
-  :hints (("Goal" :use land0-shift))
-  :rule-classes nil)
-
-(defthmd land-expt
-  (implies (and (natp n)
-                (natp k)
-                (< k n))
-           (equal (land x (expt 2 k) n)
-                  (* (expt 2 k) (bitn x k))))
-  :hints (("Goal" :use land0-expt)))
-
-(defthm land-slice
-  (implies (and (<= j i) ;drop? or not?
-                (<= i n)
-                (integerp n)
-                (integerp i)
-                (integerp j)
-                (<= 0 j)
-                )
-           (equal (land x (- (expt 2 i) (expt 2 j)) n)
-                  (* (expt 2 j) (bits x (1- i) j))))
-  :hints (("Goal" :use land0-slice))
-  :rule-classes ())
-
-(defthmd land-slices
-  (implies (and (natp n)
-                (natp l)
-                (natp k)
-                (<= l k)
-                (< k n))
-           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
-                        (- (expt 2 n) (expt 2 k))
-                        n)
-                  (if (= l k)
-                      (- (expt 2 n) (expt 2 (1+ k)))
-                    (- (expt 2 n) (expt 2 k)))))
-  :hints (("Goal" :use land0-slices)))
-
-(defthm land-upper-bound
-  (implies (and (integerp n)
-                (<= 0 n))
-           (< (land x y n) (expt 2 n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm land-upper-bound-tight
-  (implies (and (integerp n)
-                (<= 0 n))
-           (<= (land x y n) (1- (expt 2 n)))))
-
-(defthm land-fl-1
-  (equal (land (fl x) y n)
-         (land x y n)))
-
-(defthm land-fl-2-eric ;BOZO name conflicted...
-  (equal (land x (fl y) n)
-         (land x y n)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; Added in move to rel5 (should perhaps be in a -proofs file):
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defthm land-bvecp-2
-  (implies (and (bvecp x m)
-                (bvecp y m))
-           (bvecp (land x y n) m))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-; Start proof of fl-land.
-
-(local
- (defun fl-land-induction (k n)
-   (if (zp k)
-       n
-     (fl-land-induction (1- k) (1+ n)))))
-
-
-(local
- (defthmd fl-land-induction-step-1
-   (implies (not (zp k))
-            (equal (land (fl (* x (/ (expt 2 k))))
-                         (fl (* y (/ (expt 2 k))))
-                         n)
-                   (land (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
-                         (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
-                         n)))
-   :hints (("Goal" :in-theory (disable land-fl-1
-                                       land-fl-2-eric
-                                       land-is-land0
-                                       fl/int-rewrite)
-            :expand ((expt 2 k))
-            :use ((:instance fl/int-rewrite
-                             (x (* x (/ (expt 2 (1- k)))))
-                             (n 2))
-                  (:instance fl/int-rewrite
-                             (x (* y (/ (expt 2 (1- k)))))
-                             (n 2)))))))
-
-(local
- (defthmd fl-land-induction-step-2
-   (equal (land (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
-                (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
-                n)
-          (fl (/ (land (fl (* x (/ (expt 2 (1- k)))))
-                       (fl (* y (/ (expt 2 (1- k)))))
-                       (1+ n))
-                 2)))
-   :hints (("Goal" :in-theory (disable land-fl-1
-                                       land-fl-2-eric
-                                       land-is-land0
-                                       fl/int-rewrite)
-            :expand ((land (fl (* x (/ (expt 2 (1- k)))))
-                           (fl (* y (/ (expt 2 (1- k)))))
-                           (1+ n)))))))
-
-(local
- (defthmd fl-land-induction-step-3
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (land x y (+ k n))))
-                        (land (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (/ (land (fl (* x (/ (expt 2 (1- k)))))
-                                (fl (* y (/ (expt 2 (1- k)))))
-                                (1+ n))
-                          2))
-                   (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
-                                 (land x y (+ k n))))
-                          2))))))
-
-(local
- (defthmd fl-land-induction-step-4
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (land x y (+ k n))))
-                        (land (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
-                                 (land x y (+ k n))))
-                          2))
-                   (fl (* (/ (expt 2 k))
-                          (land x y (+ k n))))))
-   :hints (("Goal" :expand ((expt 2 k))))))
-
-(local
- (defthm fl-land-induction-step
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (land x y (+ k n))))
-                        (land (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (* (/ (expt 2 k))
-                          (land x y (+ k n))))
-                   (land (fl (* x (/ (expt 2 k))))
-                         (fl (* y (/ (expt 2 k))))
-                         n)))
-   :hints (("Goal" :use (fl-land-induction-step-1
-                         fl-land-induction-step-2
-                         fl-land-induction-step-3
-                         fl-land-induction-step-4)))))
-
-(defthmd fl-land
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (natp k))
-           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
-                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
-  :hints (("Goal" :induct (fl-land-induction k n)
-           :in-theory (disable land-is-land0 land-fl-1 land-fl-2-eric))))
-
-
-(defthmd land-def
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n 0))
-           (equal (land x y n)
-                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (land (bitn x 0) (bitn y 0) 1))))
-  :hints (("Goal" :in-theory (enable bitn-rec-0)
-           :use land-def-original)))
-
-; Proof of mod-land as derived from bits-land:
-
-; (land x y k)))
-; = {by land-bvecp and bits-tail}
-; (bits (land x y k) (1- k) 0)
-; = {by (:instance bits-land (x x) (y y) (n k) (i (1- k)) (j 0))}
-; (land (bits x (1- k) 0) (bits y (1- k) 0) k)
-; = {by (:instance bits-land (x x) (y y) (n n) (i (1- k)) (j 0))}
-; (bits (land x y n) (1- k) 0)
-; = {by hypothesis}
-; (bits (land x y n) (min (1- n) (1- k)) 0)
-; = {by (:instance mod-bits (x (land x y n)) (i (1- n)) (j k))}
-; (mod (bits (land x y n) (1- n) 0) (expt 2 k))
-; = {by land-bvecp}
-; (mod (land x y n) (expt 2 k))
-
-(defthmd mod-land
-  (implies (and (integerp n)
-                (integerp k)
-                (<= k n))
-           (equal (mod (land x y n) (expt 2 k))
-                  (land x y k)))
-  :hints (("Goal"
-           :use
-           ((:instance bits-land (x x) (y y) (n k) (i (1- k)) (j 0))
-            (:instance mod-bits (x (land x y n)) (i (1- n)) (j k))))))
-
-(defthmd land-bits-1
-  (equal (land (bits x (1- n) 0)
-               y
-               n)
-         (land x y n))
-  :hints (("Goal" :use land0-bits-1)))
-
-(defthmd land-bits-2
-  (equal (land x
-               (bits y (1- n) 0)
-               n)
-         (land x y n))
-  :hints (("Goal" :use land0-bits-2)))
-
-(defthm land-base
-  (equal (land x y 1)
-         (if (and (equal (bitn x 0) 1)
-                  (equal (bitn y 0) 1))
-             1
-           0))
-  :hints (("Goal" :use land0-base))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/land0-proofs.lisp acl2-6.3/books/rtl/rel5/support/land0-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/land0-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/land0-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,853 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LAND0, a nice version of LOGAND.  LAND0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-Todo:
-add versions of logand-expt-2 and logand-expt-4
-prove (elsewhere) lemmas mixing land0 with other functions
-what should land0 of non-ints be?
-
-think about removing bits from defn of land0? why???
-|#
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(local (include-book "bvecp"))
-(local (include-book "all-ones"))
-(local (include-book "log"))
-(local (include-book "merge")) ;drop?
-(local (include-book "bvecp"))
-(local (include-book "logand"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "../arithmetic/top"))
-
-;We expect n to be a positive integer, and x and y to be bit vectors of length n.
-(defund binary-land0 (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logand (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro land0 (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(land0 x y n) -- the base case
-         `(binary-land0 ,@x))
-        (t         
-         `(binary-land0 ,(car x)
-                       (land0 ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable land0)) to refer to binary-land0.
-(add-macro-alias land0 binary-land0)
-
-(defthm land0-nonnegative-integer-type
-  (and (integerp (land0 x y n))
-       (<= 0 (land0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription land0) is no better than land0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-land0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm land0-natp
-  (natp (land0 x y n)))
-
-(defthm land0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (land0 x y n)
-                  0))
-  :hints (("Goal" :cases ((acl2-numberp n))
-           :in-theory (enable land0)))
-  )
-
-(defthmd land0-bvecp-simple
-  (bvecp (land0 x y n) n)
-  :hints (("Goal" :cases ((natp n))
-           :in-theory (enable land0))))
-
-(defthm land0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (land0 x y n) k))
-  :hints (("Goal" :in-theory (disable land0-bvecp-simple)
-           :use land0-bvecp-simple)))
-
-
-;;
-;; Rules to normalize land0 terms (recall that LAND0 is a macro for BINARY-LAND0):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm land0-associative
-  (equal (land0 (land0 x y n) z n)
-         (land0 x (land0 y z n) n))
-  :hints (("Goal" :cases ((natp n))
-           :in-theory (enable land0 bits-tail))))
-
-#|
-;move
-(defthm logand-tighten-helper
-  (implies (bvecp x m)
-           (equal (logand x y)
-                  (logand (bits x (1- m) 0) y))))
-
-(defthm land0-tighten-1
-  (implies (and (< m n)
-                (integerp m)
-                (integerp n))
-           (equal (land0 (land0 x y m) z n)
-                  (land0 (land0 x y m) z m)))
-  :hints (("Goal" :in-theory (enable bits-tail)
-           :expand ((BINARY-LAND0 Z (BINARY-LAND0 X Y M) N)))))
-
-
-(defthm land0-associative-gen
-  (implies (and (integerp m)
-                (integerp n)
-                (<= 0 m)
-                (<= 0 n)
-                (<= m n)
-;                (bvecp x m)
-;                (bvecp z n)
-                )
-  (equal (land0 (land0 x y m) z n)
-         (land0 x (land0 y z m) m)))
-  :hints (("Goal" :cases ((natp n))
-           :in-theory (enable land0 bits-tail))))
-  |#       
-
-(defthm land0-commutative
-  (equal (land0 y x n)
-         (land0 x y n))
-  :hints (("Goal" :in-theory (enable land0))))
-
-;gen (must the n's match)?
-(defthm land0-commutative-2
-  (equal (land0 y (land0 x z n) n)
-         (land0 x (land0 y z n) n))
-  :hints (("Goal"  :cases ((natp n))
-           :in-theory (enable land0 bits-tail))))
-
-(defthm land0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (land0 x (land0 y z n) n)
-                  (land0 (land0 x y n) z n))))
-
-
-(defthm land0-0
-  (equal (land0 0 y n)
-         0)
-  :hints (("Goal" :in-theory (enable land0))))
-
-;nicer than the analogous rule for logand?
-;would like to let the 1 be any n?
-(defthm land0-1
-  (equal (land0 1 y 1)
-         (bitn y 0))
-  :hints (("Goal" :in-theory (enable land0 bitn))))
-
-(defthm land0-self
-  (equal (land0 x x n)
-         (bits x (1- n) 0))
-  :hints (("Goal" :in-theory (enable land0 bits-tail))))
-
-(defthmd bits-land0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable land0 bits-logand))))
-
-
-(defthmd bits-land0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable land0 bits-logand))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-land0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j)))))
-  :hints (("Goal" :in-theory (enable bits-land0-1 bits-land0-2))))
-
-(defthmd bitn-land0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  (land0 (bitn x m) 
-                        (bitn y m) 
-                        1)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn)
-                              '(BITS-N-N-REWRITE)))))
-(defthmd bitn-land0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  0))
-  :hints (("Goal" :in-theory (enable bvecp-bitn-0))))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-land0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  (if (< m n)
-                      (land0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0)))
-  :hints (("Goal" :in-theory (enable bitn-land0-1 bitn-land0-2))))
-
-;BOZO see land0-equal-0
-;drop bvecp hyps and out bitn in conclusion?
-(defthm land0-of-single-bits-equal-0
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 0 (land0 x y 1))
-                  (or (equal x 0)
-                      (equal y 0))))
-  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-(defthm land0-of-single-bits-equal-1
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 1 (land0 x y 1))
-                  (and (equal x 1)
-                       (equal y 1))))
-  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-
-
-;in general, rewrite (bvecp k n) where k is a constant to a fact about n
-
-;BOZO allow the n's to differ?
-(defthm land0-ones
-  (equal (land0 (1- (expt 2 n)) x n)
-         (bits x (1- n) 0))
-  :rule-classes ()
-  :hints (("goal" :cases ((natp n))
-           :in-theory (enable land0 bits-tail logand-ones bvecp)
-           )))
-
-#| old:
-(defthm land0-ones
-  (implies (case-split (bvecp x n))
-           (equal (land0 (1- (expt 2 n)) x n)
-                  x))
-  :rule-classes ()
-  :hints (("goal" :cases ((natp n))
-           :in-theory (enable land0 bits-tail logand-ones bvecp)
-           )))
-|#
-
-;land0-with-all-ones will rewrite (land0 x n) [note there's only one value being ANDed], because (land0 x n)
-;expands to (BINARY-LAND0 X (ALL-ONES N) N) - now moot???
-(defthm land0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (land0 (all-ones n) x n)
-                  x))
-  :hints (("goal" :use land0-ones
-           :in-theory (enable all-ones))))
-
-#| old
-(defthm land0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-                (case-split (bvecp x n)))
-           (equal (land0 k x n)
-                  x))
-  :hints (("Goal" :use land0-ones)))
-|#
-
-(defthmd land0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k) (quotep n)))
-                (equal k (1- (expt 2 n))) ;this computes on constants...
-                )
-           (equal (land0 k x n)
-                  (bits x (1- n) 0)))
-  :hints (("Goal" :use (:instance land0-ones))))
-
-
-(local (in-theory (disable mod-by-2-rewrite-to-even mod-mult-of-n mod-equal-0 )))
-
-(encapsulate
- ()
-
- (local
-  (defthm land0-def-integerp
-    (implies (and (integerp x)
-                  (integerp y)
-                  (> n 0)
-                  (integerp n))
-             (equal (land0 x y n)
-                    (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (land0 (mod x 2) (mod y 2) 1))))
-    :rule-classes ()
-    :hints (("Goal" :in-theory (e/d (land0 bits-fl-by-2) ())
-             :use ((:instance logand-rewrite (x (bits x (1- n) 0)) (y (bits y (1- n) 0)))
-                   (:instance mod012 (m x))
-                   (:instance mod012 (m y)))))))
-
-; Now we want to eliminate the (integerp x) and (integerp y) hypotheses from
-; land0-def-integerp.  First suppose x is not rational.
-
- (local
-  (defthm land0-is-0-if-not-rational
-    (implies (not (rationalp x))
-             (and (equal (land0 x y n) 0)
-                  (equal (land0 y x n) 0)))
-    :hints (("Goal" :expand ((land0 x y n)
-                             (land0 y x n))))))
-
- (local
-  (defthm fl-1/2-is-0-if-not-rational
-    (implies (not (rationalp x))
-             (equal (fl (* 1/2 x)) 0))
-    :hints (("Goal" :cases ((acl2-numberp x))))))
-
- (local
-  (defthm mod-2-if-not-rational
-    (implies (not (rationalp x))
-             (equal (mod x 2)
-                    (fix x)))
-    :hints (("Goal" :expand ((mod x 2))))))
-
- (local
-  (defthm land0-def-not-rational
-    (implies (and (or (not (rationalp x))
-                      (not (rationalp y)))
-                  (> n 0)
-                  (integerp n))
-             (equal (land0 x y n)
-                    (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (land0 (mod x 2) (mod y 2) 1))))
-    :rule-classes nil))
-
- (local
-  (defthm land0-fl-1
-    (equal (land0 (fl x) y n)
-           (land0 x y n))
-    :hints (("Goal" :expand ((land0 y (fl x) n)
-                             (land0 x y n))))))
-
- (local
-  (defthm land0-fl-2
-    (equal (land0 y (fl x) n)
-           (land0 y x n))
-    :hints (("Goal" :expand ((land0 y (fl x) n)
-                             (land0 x y n))))))
-
- (local
-  (defthm land0-def-rational-hack
-    (implies (and (rationalp x)
-                  (rationalp y)
-                  (>= n 0)
-                  (integerp n))
-             (equal (land0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
-                    (land0 (* 1/2 x) (* 1/2 y) n)))
-    :hints (("Goal" :expand ((land0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
-                             (land0 (* 1/2 x) (* 1/2 y) n))))))
-
- (local
-  (defthm land0-def-rational
-    (implies (and (rationalp x)
-                  (rationalp y)
-                  (> n 0)
-                  (integerp n))
-             (equal (land0 x y n)
-                    (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (land0 (mod x 2) (mod y 2) 1))))
-    :rule-classes ()
-    :hints (("Goal"
-             :use ((:instance land0-def-integerp (x (fl x)) (y (fl y))))
-             :in-theory (e/d (mod-fl-eric) (fl-mod))))))
-
- (defthm land0-def
-   (implies (and (> n 0)
-                 (integerp n))
-            (equal (land0 x y n)
-                   (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                      (land0 (mod x 2) (mod y 2) 1))))
-   :rule-classes ()
-   :hints (("Goal" :use (land0-def-not-rational land0-def-rational)))))
-
-(defthm land0-mod-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (mod (land0 x y n) 2)
-		    (land0 (mod x 2) (mod y 2) 1)))
-  :hints (("Goal" :use (land0-def
-			(:instance mod012 (m x))
-			(:instance mod012 (m y))
-			(:instance quot-mod (m (land0 x y n)) (n 2))))))
-
-(defthm land0-fl-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (fl (/ (land0 x y n) 2))
-		    (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-  :hints (("Goal" :use (land0-def
-			(:instance mod012 (m x))
-			(:instance mod012 (m y))
-			(:instance quot-mod (m (land0 x y n)) (n 2))))))
-
-(in-theory (disable land0-mod-2 land0-fl-2))
-
-;BOZO rename to land0-with-n-0
-;what if n is negative? or not an integer?
-(defthm land0-x-y-0
-    (equal (land0 x y 0) 0)
-  :hints (("Goal" :in-theory (enable land0))))
-
-;actually, maybe only either x or y must be a bvecp of length n
-;n is a free var
-(defthm land0-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (natp n)
-		  (natp m)
-		  (< n m))
-	     (equal (land0 x y m)
-                    (land0 x y n)))
-  :hints (("Goal" :in-theory (enable land0))))
-
-;BOZO move to logand?
-(local
- (defthm logand-of-single-bits-equal-0
-   (implies (and (bvecp i 1)
-                 (bvecp j 1))
-            (equal (equal 0 (logand i j))
-                   (or (equal i 0)
-                       (equal j 0))))
-   :hints (("Goal" :in-theory (enable bvecp-1-rewrite)))))
-
-;deceptive name; this only works for single bits!
-(defthm land0-equal-0
-  (implies (and (bvecp i 1)
-                (bvecp j 1))
-           (equal (equal 0 (land0 i j 1))
-                  (or (equal i 0)
-                      (equal j 0)))))
-
-;make alt version?
-(defthm land0-bnd
-  (implies (case-split (<= 0 x))
-           (<= (land0 x y n) x))
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :in-theory (enable land0))))
-
-#|
-;move?
-;BOZO yuck! logand is in the conclusion!
-;BOZO different from lior0-shift (only 1 arg is shifted).  consider renaming?
-;BOZO drop fl from conclusion?
-;could tighten n to m first, then drop the irrelevant term?
-(defthm land0-shift
-  (implies (and (not (zp n))
-                (natp m)
-                (<= m n)
-                (bvecp y m)
-                (bvecp x (- n m)))
-           (= (land0 (* (expt 2 m) x) y n)
-              (* (expt 2 m) (logand x (fl (/ y (expt 2 m)))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance logand-expt (n m)))
-           :in-theory (enable bvecp-forward bvecp-shift-up bits-tail land0))))
-
-;try
-(defthm land0-shift-2
-  (implies (and (not (zp n))
-                (natp m)
-                (<= m n)
-                (bvecp y m)
-                (bvecp x (- n m)))
-           (= (land0 (* (expt 2 m) x) y n)
-              0))
-  :rule-classes ()
-  :hints (("Goal" :use (land0-shift (:instance fl-unique (x (* Y (/ (EXPT 2 M)))) (n 0)))
-           :in-theory (e/d  (bvecp) ( FL-EQUAL-0)))))
-|#
-
-(local
- (defthmd land0-with-shifted-arg-helper
-  (implies (and (bvecp x (- n m)) ;dropped below
-                (rationalp y)
-                (integerp m)
-                (integerp n)
-                (<= 0 m)
-                )
-           (equal (land0 (* (expt 2 m) x) y n)
-                  (* (expt 2 m) (land0 x (bits y (1- n) m) (+ n (- m))))))
-  :hints (("Goal" :use ((:instance logand-expt (n m) (y (fl (MOD Y (EXPT 2 N))))))
-           :in-theory (enable land0 bits bvecp)))))
-
-;enable? make an alt version??
-(defthmd land0-ignores-bits
-  (equal (land0 (bits x (1- n) 0) y n)
-         (land0 x y n))
-  :hints (("Goal" :in-theory (enable land0))))
-
-(defthmd land0-with-shifted-arg
-  (implies (and (integerp x) ;gen?
-                (rationalp y)
-                (integerp m)
-                (integerp n)
-                (<= 0 m)
-                )
-           (equal (land0 (* (expt 2 m) x) y n)
-                  (* (expt 2 m) (land0 x (bits y (1- n) m) (+ n (- m))))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable expt-split expt-minus bvecp)
-           :use ((:instance land0-ignores-bits (y (BITS Y (+ -1 N) M)) (n (+ N (* -1 M))))
-                 (:instance land0-ignores-bits (x (* X (EXPT 2 M))))
-                 (:instance land0-with-shifted-arg-helper (x (bits x (+ -1 n (- m)) 0)))))))
-
-(defthmd land0-shift
-  (implies (and (integerp x)
-                (integerp y) ; actually (rationalp y) works
-                (natp k))
-           (= (land0 (* (expt 2 k) x)
-                     (* (expt 2 k) y)
-                     n)
-              (* (expt 2 k) (land0 x y (- n k)))))
-  :hints (("Goal" :use ((:instance land0-with-shifted-arg
-                                   (m k)
-                                   (x x)
-                                   (y (* (expt 2 k) y))
-                                   (n n))
-                        (:instance land0-ignores-bits (x y)
-                                   (y x)
-                                   (n (- n k)))))))
-
-
-#|
-;try
-(defthm land0-shift-4
-  (implies (and (not (zp n))
-                (natp m)
-                (<= m n)
-                (integerp y)
-                (<= 0 y)
-                ;(bvecp y m)
-;                (bvecp x (- n m))
-                )
-           (= (land0 (* (expt 2 m) x) y n)
-              (* (expt 2 m)
-                 (land0 (bits x (+ -1 n (- m)) 0)
-                       (bits y (1- n) m)
-                       (+ n (- m))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance logand-expt (n m) (x (bits x (+ -1 n (- m)) 0))
-                                   (y (MOD Y (EXPT 2 N)))))
-           :in-theory (e/d ( land0 bits bvecp expt-split expt-minus mod-prod)
-                           (mod-does-nothing)))))
-|#
-
-(defthmd land0-expt
-  (implies (and (natp n)
-                (natp k)
-                (< k n))
-           (equal (land0 x (expt 2 k) n)
-                  (* (expt 2 k) (bitn x k))))
-  :hints (("Goal" :use ((:instance logand-expt-2 (x (bits x (1- n) 0)))
-			(:instance expt-strong-monotone (n k) (m n)))
-           :in-theory (enable bvecp land0))))
-
-(defthm land0-slice
-  (implies (and (<= j i) ;drop?
-                (<= i n)
-                (integerp n)
-                (integerp i)
-                (integerp j)
-                (<= 0 j)
-                )
-           (equal (land0 x (- (expt 2 i) (expt 2 j)) n)
-                  (* (expt 2 j) (bits x (1- i) j))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance logand-slice (x (bits x (1- n) 0)) (n i) (k j))
-                        )
-           :in-theory (enable expt-strong-monotone-linear 
-                              expt-weak-monotone-linear 
-                              land0))))
-; Start proof of land-slices.
-
-(local
- (defthm land0-slices-1
-   (implies (and (natp n)
-                 (natp l)
-                 (natp k)
-                 (<= l k)
-                 (< k n))
-            (equal (land0 (- (expt 2 n) (1+ (expt 2 l)))
-                          (- (expt 2 n) (expt 2 k))
-                          n)
-                   (* (expt 2 k)
-                      (bits (- (expt 2 n) (1+ (expt 2 l))) (1- n) k))))
-   :hints (("Goal" :use ((:instance land0-slice
-                                    (x (- (expt 2 n) (1+ (expt 2 l))))
-                                    (i n)
-                                    (j k)
-                                    (n n)))))
-   :rule-classes nil))
-
-(local
- (defthmd land0-slices-2
-   (implies (and (natp n)
-                 (natp l)
-                 (natp k)
-                 (<= l k)
-                 (< k n))
-            (equal (* (expt 2 k)
-                      (bits (- (expt 2 n) (1+ (expt 2 l))) (1- n) k))
-                   (* (expt 2 k)
-                      (fl (/ (- (expt 2 n) (1+ (expt 2 l))) (expt 2 k))))))
-   :instructions (:promote (:dv 1)
-                           (:dv 2)
-                           :x :top (:dv 1 2 1 2 0)
-                           (:rewrite mod-does-nothing)
-                           :top :prove :prove
-                           (:use (:instance expt-strong-monotone (n l)
-                                            (m n)))
-                           (:in-theory (disable expt-compare power2p-expt2-i))
-                           :bash)))
-
-(local
- (defthmd land0-slices-3
-   (implies (and (natp n)
-                 (natp l)
-                 (natp k)
-                 (<= l k)
-                 (< k n))
-            (equal (* (expt 2 k)
-                      (fl (/ (- (expt 2 n) (1+ (expt 2 l))) (expt 2 k))))
-                   (* (expt 2 k)
-                      (+ (expt 2 (- n k))
-                         (fl (/ (- (1+ (expt 2 l))) (expt 2 k)))))))
-   :hints (("Goal" :use ((:instance fl+int-rewrite
-                                    (x (/ (1+ (expt 2 l)) (expt 2 k)))
-                                    (n (/ (expt 2 n) (expt 2 k)))))))))
-
-(local (include-book "../arithmetic/fl-hacks"))
-
-(local
- (defthmd land0-slices-4
-   (implies (and (natp n)
-                 (natp l)
-                 (natp k)
-                 (<= l k)
-                 (< k n))
-            (equal (* (expt 2 k)
-                      (+ (expt 2 (- n k))
-                         (fl (/ (- (1+ (expt 2 l))) (expt 2 k)))))
-                   (* (expt 2 k)
-                      (+ (expt 2 (- n k))
-                         (- (fl (/ (expt 2 l) (expt 2 k))))
-                         -1))))
-   :hints (("Goal" :use ((:instance fl-m-n
-                                    (m (1+ (expt 2 l)))
-                                    (n (expt 2 k))))))))
-
-(local
- (defthmd land0-slices-5
-   (implies (and (natp n)
-                 (natp l)
-                 (natp k)
-                 (<= l k)
-                 (< k n))
-            (equal (* (expt 2 k)
-                      (+ (expt 2 (- n k))
-                         (- (fl (/ (expt 2 l) (expt 2 k))))
-                         -1))
-                   (- (expt 2 n)
-                      (* (expt 2 k)
-                         (1+ (fl (/ (expt 2 l) (expt 2 k))))))))))
-
-(defthmd land0-slices
-  (implies (and (natp n)
-                (natp l)
-                (natp k)
-                (<= l k)
-                (< k n))
-           (equal (land0 (- (expt 2 n) (1+ (expt 2 l)))
-                         (- (expt 2 n) (expt 2 k))
-                         n)
-                  (if (= l k)
-                      (- (expt 2 n) (expt 2 (1+ k)))
-                    (- (expt 2 n) (expt 2 k)))))
-  :instructions ((:use land0-slices-1
-                       land0-slices-2 land0-slices-3
-                       land0-slices-4 land0-slices-5)
-                 :promote (:dv 1)
-                 := (:drop 1)
-                 := (:drop 1)
-                 := (:drop 1)
-                 := (:drop 1)
-                 := (:drop 1)
-                 :top :prove))
-
-(defthm land0-upper-bound
-  (implies (and (integerp n)
-                (<= 0 n))
-           (< (land0 x y n) (expt 2 n)))
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :in-theory (enable land0))))
-
-(defthm land0-upper-bound-tight
-  (implies (and (integerp n)
-                (<= 0 n))
-           (<= (land0 x y n) (1- (expt 2 n)))))
-
-(defthm land0-nest-tighten
-  (implies (and (syntaxp (not (equal m n)))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (land0 x (land0 y z m) n)
-                  (land0 x (land0 y z (min m n)) (min m n))))
-  :hints (("Goal" :use (:instance and-dist-d
-                                  (x (logand (BITS Y (1- M) 0)
-                                             (BITS Z (1- M) 0)))
-                                  (n m)
-                                  (y  (BITS X (1- N) 0)))
-           :in-theory (enable land0))))
-
-(defthm land0-fl-1
-  (equal (land0 (fl x) y n)
-         (land0 x y n))
-  :hints (("Goal" :in-theory (enable land0))))
-
-(defthm land0-fl-2-eric
-  (equal (land0 x (fl y) n)
-         (land0 x y n))
-  :hints (("Goal" :in-theory (enable land0))))
-
-(defthmd land0-bits-1
-  (equal (land0 (bits x (1- n) 0)
-               y
-               n)
-         (land0 x y n))
-  :hints (("Goal" :in-theory (e/d (land0) (logior land0-commutative)))))
-
-(defthmd land0-bits-2
-  (equal (land0 x
-               (bits y (1- n) 0)
-               n)
-         (land0 x y n))
-  :hints (("Goal" :in-theory (e/d (land0) (logior land0-commutative)))))
-
-(local
- (defthm land0-base-lemma
-   (implies (and (bvecp x 1) (bvecp y 1))
-            (equal (land0 x y 1)
-                   (if (and (equal (bitn x 0) 1)
-                            (equal (bitn y 0) 1))
-                       1
-                     0)))
-   :rule-classes nil))
-
-(defthm land0-base
-  (equal (land0 x y 1)
-         (if (and (equal (bitn x 0) 1)
-                  (equal (bitn y 0) 1))
-             1
-           0))
-  :hints (("Goal" :use ((:instance land0-base-lemma
-                                   (x (bits x 0 0))
-                                   (y (bits y 0 0)))
-                        (:instance land0-bits-1
-                                   (x x)
-                                   (y (bits y 0 0))
-                                   (n 1))
-                        (:instance land0-bits-2 (n 1)))))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/land0.lisp acl2-6.3/books/rtl/rel5/support/land0.lisp
--- acl2-6.2/books/rtl/rel5/support/land0.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/land0.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,419 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LAND0, a nice version of LOGAND.  LAND0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-Todo:
-add versions of logand-expt-2 and logand-expt-4
-prove (elsewhere) lemmas mixing land0 with other functions
-
-|#
-
-;;Necessary defuns:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(local (include-book "land0-proofs"))
-
-;; New stuff
-
-;We expect n to be a positive integer, and x and y to be bit vectors of length n.
-(defund binary-land0 (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logand (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro land0 (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(land0 x y n) -- the base case
-         `(binary-land0 ,@x))
-        (t         
-         `(binary-land0 ,(car x)
-                       (land0 ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable land0)) to refer to binary-land0.
-(add-macro-alias land0 binary-land0)
-
-(defthm land0-nonnegative-integer-type
-  (and (integerp (land0 x y n))
-       (<= 0 (land0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription land0) is no better than land0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-land0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm land0-natp
-  (natp (land0 x y n)))
-
-;BOZO split into 2 rules?
-(defthm land0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (land0 x y n)
-                  0)))
-
-(defthmd land0-bvecp-simple
-  (bvecp (land0 x y n) n))
-
-(defthm land0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (land0 x y n) k)))
-
-
-;;
-;; Rules to normalize land0 terms (recall that LAND0 is a macro for BINARY-LAND0):
-;;
-
-;This guarantees that the n parameters to nested LAND0 calls match.
-;Note the MIN in the conclusion.
-;BOZO do we expect MIN to be enabled?  Maybe we should use IF instead for this and other rules?
-(defthm land0-nest-tighten
-  (implies (and (syntaxp (not (equal m n)))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (land0 x (land0 y z m) n)
-                  (land0 x (land0 y z (min m n)) (min m n)))))
-
-; allow the n's to differ on this?
-(defthm land0-associative
-  (equal (land0 (land0 x y n) z n)
-         (land0 x (land0 y z n) n)))
-
-(defthm land0-commutative
-  (equal (land0 y x n)
-         (land0 x y n)))
-
-; allow the n's to differ on this?
-(defthm land0-commutative-2
-  (equal (land0 y (land0 x z n) n)
-         (land0 x (land0 y z n) n)))
-
-; allow the n's to differ on this?
-(defthm land0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (land0 x (land0 y z n) n)
-                  (land0 (land0 x y n) z n))))
-
-(defthm land0-0
-  (equal (land0 0 y n)
-         0))
-
-;nicer than the analogous rule for logand? is it really?
-;BOZO gen the second 1 in the lhs?
-(defthm land0-1
-  (equal (land0 1 y 1)
-         (bitn y 0)))
-
-(defthm land0-self
-  (equal (land0 x x n)
-         (bits x (1- n) 0)))
-
-;perhaps use only the main rule, bits-land0?
-(defthmd bits-land0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j))))))
-
-;perhaps use only the main rule, bits-land0?
-(defthmd bits-land0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j))))))
-
-;Notice the call to MIN in the conclusion.
-(defthm bits-land0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-land0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  (land0 (bitn x m) 
-                        (bitn y m) 
-                        1))))
-(defthmd bitn-land0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-land0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  (if (< m n)
-                      (land0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0))))
-
-;BOZO see land0-equal-0
-;drop bvecp hyps and put bitn in conclusion?
-(defthm land0-of-single-bits-equal-0
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 0 (land0 x y 1))
-                  (or (equal x 0)
-                      (equal y 0)))))
-
-(defthm land0-of-single-bits-equal-1
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 1 (land0 x y 1))
-                  (and (equal x 1)
-                       (equal y 1)))))
-
-(defthm land0-ones
-  (equal (land0 (1- (expt 2 n)) x n)
-         (bits x (1- n) 0))
-  :rule-classes ())
-
-;land0-with-all-ones will rewrite (land0 x n) [note there's only one value being ANDed], because (land0 x n)
-;expands to (BINARY-LAND0 X (ALL-ONES N) N) - now moot???
-;BOZO drop bvecp hyp and move to conclusion?
-(defthm land0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (land0 (all-ones n) x n)
-                  x)))
-
-(defthmd land0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k) (quotep n)))
-                (equal k (1- (expt 2 n))) ;this computes on constants...
-                )
-           (equal (land0 k x n)
-                  (bits x (1- n) 0))))
-
-(defthm land0-def
-  (implies (and (> n 0)
-                (integerp n))
-           (equal (land0 x y n)
-                  (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (land0 (mod x 2) (mod y 2) 1))))
-  :rule-classes ())
-
-(defthmd land0-mod-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (mod (land0 x y n) 2)
-                  (land0 (mod x 2) (mod y 2) 1))))
-
-;BOZO RHS isn't simplified...
-(defthmd land0-fl-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (fl (/ (land0 x y n) 2))
-                  (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
-
-;BOZO rename to land0-with-n-0
-;what if n is negative? or not an integer?
-(defthm land0-x-y-0
-  (equal (land0 x y 0) 0))
-
-;actually, maybe only either x or y must be a bvecp of length n
-;n is a free var
-(defthm land0-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (natp n)
-		  (natp m)
-		  (< n m))
-	     (equal (land0 x y m)
-                    (land0 x y n))))
-
-;deceptive name; this only works for single bits!
-(defthm land0-equal-0
-  (implies (and (bvecp i 1)
-                (bvecp j 1))
-           (equal (equal 0 (land0 i j 1))
-                  (or (equal i 0)
-                      (equal j 0)))))
-
-;make alt version?
-(defthm land0-bnd
-  (implies (case-split (<= 0 x))
-           (<= (land0 x y n) x))
-  :rule-classes (:rewrite :linear))
-
-;enable? make an alt version??
-(defthmd land0-ignores-bits
-  (equal (land0 (bits x (1- n) 0) y n)
-         (land0 x y n)))
-
-(defthmd land0-with-shifted-arg
-  (implies (and (integerp x) ;gen?
-                (rationalp y)
-                (integerp m)
-                (integerp n)
-                (<= 0 m)
-                )
-           (equal (land0 (* (expt 2 m) x) y n)
-                  (* (expt 2 m) (land0 x (bits y (1- n) m) (+ n (- m)))))))
-
-(defthmd land0-shift
-  (implies (and (integerp x)
-                (integerp y) ; actually (rationalp y) works
-                (natp k))
-           (= (land0 (* (expt 2 k) x)
-                     (* (expt 2 k) y)
-                     n)
-              (* (expt 2 k) (land0 x y (- n k))))))
-
-(defthmd land0-expt
-  (implies (and (natp n)
-                (natp k)
-                (< k n))
-           (equal (land0 x (expt 2 k) n)
-                  (* (expt 2 k) (bitn x k)))))
-
-(defthm land0-slice
-  (implies (and (<= j i) ;drop? or not?
-                (<= i n)
-                (integerp n)
-                (integerp i)
-                (integerp j)
-                (<= 0 j)
-                )
-           (equal (land0 x (- (expt 2 i) (expt 2 j)) n)
-                  (* (expt 2 j) (bits x (1- i) j))))
-  :rule-classes ())
-
-(defthmd land0-slices
-  (implies (and (natp n)
-                (natp l)
-                (natp k)
-                (<= l k)
-                (< k n))
-           (equal (land0 (- (expt 2 n) (1+ (expt 2 l)))
-                         (- (expt 2 n) (expt 2 k))
-                         n)
-                  (if (= l k)
-                      (- (expt 2 n) (expt 2 (1+ k)))
-                    (- (expt 2 n) (expt 2 k))))))
-
-(defthm land0-upper-bound
-  (implies (and (integerp n)
-                (<= 0 n))
-           (< (land0 x y n) (expt 2 n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm land0-upper-bound-tight
-  (implies (and (integerp n)
-                (<= 0 n))
-           (<= (land0 x y n) (1- (expt 2 n)))))
-
-(defthm land0-fl-1
-  (equal (land0 (fl x) y n)
-         (land0 x y n)))
-
-(defthm land0-fl-2-eric ;BOZO name conflicted...
-  (equal (land0 x (fl y) n)
-         (land0 x y n)))
-
-(defthmd land0-bits-1
-  (equal (land0 (bits x (1- n) 0)
-               y
-               n)
-         (land0 x y n)))
-
-(defthmd land0-bits-2
-  (equal (land0 x
-               (bits y (1- n) 0)
-               n)
-         (land0 x y n)))
-
-(defthm land0-base
-  (equal (land0 x y 1)
-         (if (and (equal (bitn x 0) 1)
-                  (equal (bitn y 0) 1))
-             1
-           0))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/lextra-proofs.lisp acl2-6.3/books/rtl/rel5/support/lextra-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/lextra-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lextra-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,200 +0,0 @@
-(in-package "ACL2")
-
-(include-book "land0")
-(include-book "lior0")
-(include-book "lxor0")
-(local (include-book "../arithmetic/top"))
-(local (include-book "logand"))
-(local (include-book "logior"))
-(local (include-book "logxor"))
-(local (include-book "merge"))
-(local (include-book "bvecp"))
-(local (include-book "bits"))
-
-(defthmd lior0-land0-1
-  (equal (lior0 x (land0 y z n) n)
-         (land0 (lior0 x y n) (lior0 x z n) n))
-  :hints (("Goal" :use ((:instance logior-logand 
-				   (x (bits x (1- n) 0)) 
-				   (y (bits y (1- n) 0))
-				   (z (bits z (1- n) 0))))
-           :in-theory (enable lior0 land0))))
-
-(defthmd lior0-land0-2
-  (equal (lior0 (land0 y z n) x n)
-         (land0 (lior0 x y n) (lior0 x z n) n))
-  :hints (("Goal" :use ((:instance logior-logand 
-				   (x (bits x (1- n) 0)) 
-				   (y (bits y (1- n) 0))
-				   (z (bits z (1- n) 0))))
-           :in-theory (enable lior0 land0))))
-
-(defthmd land0-lior0-1
-  (equal (land0 x (lior0 y z n) n)
-         (lior0 (land0 x y n) (land0 x z n) n))
-  :hints (("Goal" :use ((:instance logand-logior 
-				   (x (bits x (1- n) 0)) 
-				   (y (bits y (1- n) 0))
-				   (z (bits z (1- n) 0))))
-           :in-theory (enable lior0 land0))))
-
-(defthmd land0-lior0-2
-  (equal (land0 (lior0 y z n) x n)
-         (lior0 (land0 x y n) (land0 x z n) n))
-  :hints (("Goal" :use ((:instance logand-logior 
-				   (x (bits x (1- n) 0)) 
-				   (y (bits y (1- n) 0))
-				   (z (bits z (1- n) 0))))
-           :in-theory (enable lior0 land0))))
-
-(defthmd lior0-land0-lxor0
-  (equal (lior0 (land0 x y n) (lior0 (land0 x z n) (land0 y z n) n) n)
-         (lior0 (land0 x y n) (land0 (lxor0 x y n) z n) n))
-  :hints (("Goal" :use ((:instance log3
-				   (x (bits x (1- n) 0)) 
-				   (y (bits y (1- n) 0))
-				   (z (bits z (1- n) 0))))
-           :in-theory (enable lior0 land0 lxor0))))
-
-(defthmd lxor0-rewrite
-  (equal (lxor0 x y n)
-         (lior0 (land0 x (lnot y n) n)
-               (land0 y (lnot x n) n)
-               n))
-  :hints (("Goal" :use ((:instance logxor-rewrite-2
-				   (x (bits x (1- n) 0)) 
-				   (y (bits y (1- n) 0))))
-           :in-theory (enable lior0 land0 lxor0))))
-
-(defthmd lnot-lxor0
-  (equal (lnot (lxor0 x y n) n)
-         (lxor0 (lnot x n) y n))
-  :hints (("Goal" :use ((:instance lnot-logxor
-				   (x (bits x (1- n) 0)) 
-				   (y (bits y (1- n) 0))))
-           :in-theory (enable lxor0))))
-
-;move
-(defthm bits-of-1-plus-double
-  (implies (and (integerp x)
-                (<= 0 i)
-                )
-           (equal (bits (+ 1 (* 2 x)) i 1)
-                  (bits x (1- i) 0)))
-  :hints (("goal" :in-theory (enable bits expt-split mod-prod mod-sum-cases)
-           ))
-  )
-
-;move
-;useful for inductions involvling lnot?
-(defthm lnot-shift-plus-1
-  (implies (and (case-split (integerp x))
-                (case-split (< 0 n))
-                (case-split (integerp n))
-                )
-           (equal (lnot (+ 1 (* 2 x)) n)
-                  (* 2 (lnot x (1- n)))))
-  :hints (("Goal" :use (:instance bits-plus-bits (x (+ 1 (* 2 X))) (n  (1- N)) (m 0) (p 1))
-           :in-theory (enable lnot expt-split))))
-
-;move?
-;do we want this sort of theorem about lognot and logand too?
-; Matt K.:  The original proof fails using v2-8-alpha-12-30-03.  I don't know
-; why, but I do notice that the induction heuristics are getting in the way,
-; because the problem goal (the one with the hint below) goes through in the
-; proof-checker.  So we use the proof-checker proof.
-
-#|
-(local
- (defthm lnot-lior0-aux
-  (implies (and (integerp x) ;gen?
-                (integerp y) ;gen?
-                )
-           (equal (lnot (lior0 x y n) n)
-                  (land0 (lnot x n) (lnot y n) n)))
-  :hints (("subgoal *1/2" :use (lior0-def
-                                (:instance land0-def (x  (LNOT X N)) (y (LNOT Y N)))
-                                (:instance mod012 (m x))
-                                (:instance mod012 (m y))
-                                (:instance lnot-fl-original (k 1))
-                                (:instance lnot-fl-original (x y) (k 1))
-                                )
-           )
-          ("Goal" :in-theory (enable lnot-shift-2)
-           :do-not '(generalize)
-           :induct ( op-dist-induct x y n)))))
-|#
-
-(local
- (DEFTHM LNOT-LIOR0-AUX
-   (IMPLIES (AND (INTEGERP X) (INTEGERP Y))
-            (EQUAL (LNOT (LIOR0 X Y N) N)
-                   (LAND0 (LNOT X N) (LNOT Y N) N)))
-   :INSTRUCTIONS
-   ((:IN-THEORY (ENABLE LNOT-SHIFT-2))
-    (:INDUCT (OP-DIST-INDUCT X Y N))
-    :PROVE
-    (:PROVE :HINTS
-            (("Goal" :USE
-              (LIOR0-DEF (:INSTANCE LAND0-DEF (X (LNOT X N))
-                                   (Y (LNOT Y N)))
-                        (:INSTANCE MOD012 (M X))
-                        (:INSTANCE MOD012 (M Y))
-                        (:INSTANCE LNOT-FL-ORIGINAL (K 1))
-                        (:INSTANCE LNOT-FL-ORIGINAL (X Y) (K 1))))))
-    :PROVE)))
-
-(defthm lnot-lior0
-  (equal (lnot (lior0 x y n) n)
-         (land0 (lnot x n) (lnot y n) n))
-  :hints (("goal" :in-theory (disable lnot-lior0-aux)
-           :use (:instance lnot-lior0-aux (x (fl x)) (y (fl y)))))
-  )
-
-; See comment above about v2-8-alpha-12-30-03.  A similar situation applies
-; just below.
-#|
-(local
- (defthm lnot-land0-aux
-   (implies (and (integerp x) ;gen?
-                 (integerp y) ;gen?
-                 )
-            (equal (lnot (land0 x y n) n)
-                   (lior0 (lnot x n) (lnot y n) n)))
-   :hints (("subgoal *1/2" :use (land0-def
-                                 (:instance lior0-def (x  (LNOT X N)) (y (LNOT Y N)))
-                                 (:instance mod012 (m x))
-                                 (:instance mod012 (m y))
-                                 (:instance lnot-fl-original (k 1))
-                                 (:instance lnot-fl-original (x y) (k 1))
-                                 )
-            )
-           ("Goal" :in-theory (enable lnot-shift)
-            :do-not '(generalize)
-            :induct ( op-dist-induct x y n)))))
-|#
-
-(DEFTHM LNOT-LAND0-AUX
-        (IMPLIES (AND (INTEGERP X) (INTEGERP Y))
-                 (EQUAL (LNOT (LAND0 X Y N) N)
-                        (LIOR0 (LNOT X N) (LNOT Y N) N)))
-        :INSTRUCTIONS
-        ((:IN-THEORY (ENABLE LNOT-SHIFT-2))
-         (:INDUCT (OP-DIST-INDUCT X Y N))
-         :PROVE
-         (:PROVE :HINTS
-                 (("Goal" :USE
-                          (LAND0-DEF (:INSTANCE LIOR0-DEF (X (LNOT X N))
-                                               (Y (LNOT Y N)))
-                                    (:INSTANCE MOD012 (M X))
-                                    (:INSTANCE MOD012 (M Y))
-                                    (:INSTANCE LNOT-FL-ORIGINAL (K 1))
-                                    (:INSTANCE LNOT-FL-ORIGINAL (X Y) (K 1))))))
-         :PROVE))
-
-(defthm lnot-land0
-  (equal (lnot (land0 x y n) n)
-         (lior0 (lnot x n) (lnot y n) n))
-  :hints (("Goal" :in-theory (disable LNOT-LAND0-aux)
-           :use (:instance lnot-land0-aux (x (fl x)) (y (fl y)))))
-  )
diff -Nru acl2-6.2/books/rtl/rel5/support/lextra.lisp acl2-6.3/books/rtl/rel5/support/lextra.lisp
--- acl2-6.2/books/rtl/rel5/support/lextra.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lextra.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1155 +0,0 @@
-(in-package "ACL2")
-
-(include-book "land")
-(include-book "lior")
-(include-book "lxor")
-(include-book "cat")
-(local (include-book "lextra0"))
-(local (include-book "land0"))
-(local (include-book "lior0"))
-(local (include-book "lxor0"))
-(local (include-book "merge2"))
-
-(local (in-theory (current-theory 'lextra0-start)))
-(local (in-theory (e/d (land-is-land0 lior-is-lior0 lxor-is-lxor0)
-                       (binary-land binary-lior binary-lxor))))
-
-;theorems mixing two or more of the new logical operators.
-
-;BOZO really the -1 and -2 names below should be switched?
-
-(defthmd lior-land-1
-  (equal (lior x (land y z n) n)
-         (land (lior x y n) (lior x z n) n))
-  :hints (("Goal" :in-theory (enable lior0-land0-1))))
-
-(defthmd lior-land-2
-  (equal (lior (land y z n) x n)
-         (land (lior x y n) (lior x z n) n))
-  :hints (("Goal" :in-theory (enable lior0-land0-2))))
-
-(defthmd land-lior-1
-  (equal (land x (lior y z n) n)
-         (lior (land x y n) (land x z n) n))
-  :hints (("Goal" :in-theory (enable land0-lior0-1))))
-
-(defthmd land-lior-2
-  (equal (land (lior y z n) x n)
-         (lior (land x y n) (land x z n) n))
-  :hints (("Goal" :in-theory (enable land0-lior0-2))))
-
-(defthmd lior-land-lxor
-  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
-         (lior (land x y n) (land (lxor x y n) z n) n))
-  :hints (("Goal" :in-theory (enable lior0-land0-lxor0))))
-
-(defthmd lxor-rewrite
-  (equal (lxor x y n)
-         (lior (land x (lnot y n) n)
-               (land y (lnot x n) n)
-               n))
-  :hints (("Goal" :in-theory (enable lxor0-rewrite))))
-
-(defthmd lnot-lxor
-  (equal (lnot (lxor x y n) n)
-         (lxor (lnot x n) y n))
-  :hints (("Goal" :in-theory (enable lnot-lxor0))))
-
-;consider enabling?
-(defthmd lnot-lior
-  (equal (lnot (lior x y n) n)
-         (land (lnot x n) (lnot y n) n))
-  :hints (("Goal" :in-theory (enable lnot-lior0))))
-
-;consider enabling?
-(defthmd lnot-land
-  (equal (lnot (land x y n) n)
-         (lior (lnot x n) (lnot y n) n))
-  :hints (("Goal" :in-theory (enable lnot-land0))))
-
-; Added for rel5.  (Much of this really "should" go in lextra-proofs.lisp, but
-; it was developed here before that realization, and moving it doesn't seem
-; worth the trouble.)
-
-(defthmd land-cat
-  (implies (and (case-split (natp n))
-                (case-split (integerp m))
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
-                  (cat (land x1 x2 m) m (land y1 y2 n) n)))
-  :hints (("Goal" :in-theory (enable land0-cat))))
-
-(defthm land-cat-constant
-  (implies (and (case-split (integerp n))
-                (case-split (integerp m))
-                (syntaxp (quotep c))
-                (> n 0)
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (land c (cat x2 m y2 n) l)
-                  (cat (land (bits c (+ -1 m n) n) x2 m)
-                       m
-                       (land (bits c (1- n) 0) y2 n)
-                       n)))
-  :hints (("Goal" :use land0-cat-constant)))
-
-(defthmd lior-cat
-  (implies (and (case-split (natp n))
-                (case-split (integerp m))
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
-                  (cat (lior x1 x2 m) m (lior y1 y2 n) n)))
-  :hints (("Goal" :in-theory (enable lior0-cat))))
-
-(defthm lior-cat-constant
-  (implies (and (case-split (integerp n))
-                (case-split (integerp m))
-                (syntaxp (quotep c))
-                (> n 0)
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (lior c (cat x2 m y2 n) l)
-                  (cat (lior (bits c (+ -1 m n) n) x2 m)
-                       m
-                       (lior (bits c (1- n) 0) y2 n)
-                       n)))
-  :hints (("Goal" :use lior0-cat-constant)))
-
-(defthmd lxor-cat
-  (implies (and (case-split (natp n))
-                (case-split (integerp m))
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
-                  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n)))
-  :hints (("Goal" :in-theory (enable lxor0-cat))))
-
-(defthm lxor-cat-constant
-  (implies (and (case-split (integerp n))
-                (case-split (integerp m))
-                (syntaxp (quotep c))
-                (> n 0)
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (lxor c (cat x2 m y2 n) l)
-                  (cat (lxor (bits c (+ -1 m n) n) x2 m)
-                       m
-                       (lxor (bits c (1- n) 0) y2 n)
-                       n)))
-  :hints (("Goal" :use lxor0-cat-constant)))
-
-(defthm lxor-bnd
-  (<= (lxor x y n) (lior x y n))
-  :hints (("Goal"
-           :in-theory
-           (e/d (lxor lior)
-                (lxor-is-lxor0 lior-is-lior0))))
-  :rule-classes (:rewrite :linear))
-
-; Start proof of lxor-slice.
-
-(local (include-book "../arithmetic/top"))
-
-(local (in-theory (enable a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a12 a13 a14 a15
-                          bits-lnot bits-bits
-                          bits-with-indices-in-the-wrong-order
-                          lnot-bvecp-simple lnot-bvecp
-                          bits-0)))
-
-(local
- (defthmd lxor-slice-1-1
-   (implies (and (<= j i)
-                 (<= i n)
-                 (integerp n)
-                 (integerp i)
-                 (integerp j)
-                 (<= 0 j))
-            (equal (bits x (1- n) 0)
-                   (cat (bits x (1- n) i) (- n i)
-                        (bits x (1- i) j) (- i j)
-                        (bits x (1- j) 0) j)))
-   :hints (("Goal" :use ((:instance bits-plus-bits
-                                    (n (1- n))
-                                    (m 0)
-                                    (p i))
-                         (:instance bits-plus-bits
-                                    (n (1- i))
-                                    (m 0)
-                                    (p j)))))))
-
-(local
- (encapsulate
-  ()
-
-  (local
-   (defthm lxor-slice-1-2-1
-     (implies (and (<= 0 j)
-                   (<= j i)
-                   (<= i n)
-                   (integerp n)
-                   (integerp i)
-                   (integerp j))
-              (equal (bits (- (expt 2 i) (expt 2 j))
-                           (+ -1 n)
-                           0)
-                     (- (expt 2 i) (expt 2 j))))
-     :hints (("Goal" :use ((:instance expt-weak-monotone (n i) (m n))
-                           (:instance expt-weak-monotone (n j) (m i)))
-              :in-theory (e/d (bits-reduce) (expt-compare))))
-     :rule-classes nil))
-
-  (local
-   (defthm lxor-slice-1-2-2
-     (implies (and (<= 0 i)
-                   (<= i n)
-                   (integerp n)
-                   (integerp i))
-              (equal (bits (+ -1 (expt 2 i))
-                           (+ -1 n)
-                           0)
-                     (+ -1 (expt 2 i))))
-     :hints (("Goal" :use ((:instance lxor-slice-1-2-1 (j 0)))))))
-
-  (defthm lxor-slice-1-2-3 ; used in final lxor-slice proof
-    (implies (and (<= 0 j)
-                  (<= j i)
-                  (<= i n)
-                  (integerp n)
-                  (integerp i)
-                  (integerp j))
-             (equal (bits (+ (expt 2 i) (* -1 (expt 2 j)))
-                          (+ -1 n)
-                          0)
-                    (+ (expt 2 i) (* -1 (expt 2 j)))))
-    :hints (("Goal" :use ((:instance lxor-slice-1-2-1 (j j))))))
-
-  (defthm lxor-slice-1-2
-    (implies (and (<= j i)
-                  (<= i n)
-                  (integerp n)
-                  (integerp i)
-                  (integerp j)
-                  (<= 0 j))
-             (equal (bits (- (expt 2 i) (expt 2 j)) (1- n) 0)
-                    (cat 0 (- n i)
-                         (1- (expt 2 (- i j))) (- i j)
-                         0 j)))
-    :hints (("Goal" :in-theory (enable cat))))))
-
-(local
- (defthm lxor-slice-1
-   (implies (and (<= j i)
-                 (<= i n)
-                 (integerp n)
-                 (integerp i)
-                 (integerp j)
-                 (<= 0 j))
-            (equal (lxor (cat (bits x (1- n) i) (- n i)
-                              (bits x (1- i) j) (- i j)
-                              (bits x (1- j) 0) j)
-                         (cat 0 (- n i)
-                              (1- (expt 2 (- i j))) (- i j)
-                              0 j)
-                         n)
-                   (lxor (bits x (1- n) 0)
-                         (bits (- (expt 2 i) (expt 2 j)) (1- n) 0)
-                         n)))
-   :hints (("Goal" :use (lxor-slice-1-1 lxor-slice-1-2)))
-   :rule-classes nil))
-
-(local
- (defthm lxor-slice-2
-   (implies (and (< j i)
-                 (< i n)
-                 (integerp n)
-                 (integerp i)
-                 (integerp j)
-                 (<= 0 j))
-            (equal (lxor (cat (bits x (1- n) i) (- n i)
-                              (bits x (1- i) j) (- i j)
-                              (bits x (1- j) 0) j)
-                         (cat 0 (- n i)
-                              (1- (expt 2 (- i j))) (- i j)
-                              0 j)
-                         n)
-                   (cat (bits x (1- n) i) (- n i)
-                        (lnot (bits x (1- i) j) (- i j)) (- i j)
-                        (bits x (1- j) 0) j)))
-   :hints (("Goal" :in-theory (e/d (lxor0-cat)
-                                   (cat-0 cat-0-alt cat-bits-bits))
-            :use ((:instance lxor0-ones
-                             (x (bits x (+ -1 i) j))
-                             (n (+ i (* -1 j)))))))
-   :rule-classes nil))
-
-(local
- (defthm lxor-slice-3 ; i=j case
-   (implies (and (<= i n)
-                 (<= 0 i)
-                 (integerp n)
-                 (integerp i))
-            (equal (lxor (bits x (1- n) 0)
-                         0
-                         n)
-                   (cat (bits x (1- n) i) (- n i)
-                        (lnot (bits x (1- i) i) 0) 0
-                        (bits x (1- i) 0) i)))
-   :hints (("Goal" :in-theory (enable cat)))
-   :rule-classes nil))
-
-(local
- (encapsulate
-  ()
-
-  (local
-   (defthm hack-1
-     (implies (natp n)
-              (equal (bits (+ -1 (* 2 (expt 2 n)))
-                           n
-                           0)
-                     (+ -1 (* 2 (expt 2 n)))))
-     :hints (("Goal" :in-theory (enable bits-reduce)))))
-
-  (local
-   (defthm hack-2
-     (implies (and (< j n)
-                   (integerp n)
-                   (integerp j)
-                   (< 0 j))
-              (equal (bits (+ -1 (expt 2 (+ n (* -1 j))))
-                           (+ -1 n (* -1 j))
-                           0)
-                     (+ -1 (expt 2 (+ n (* -1 j))))))
-     :hints (("Goal"
-              :use ((:instance bits-reduce
-                               (x (+ -1 (expt 2 (+ n (* -1 j)))))
-                               (i (+ -1 n (* -1 j)))))))))
-
-  (defthm lxor-slice-2-i=n
-    (implies (and (< j n)
-                  (integerp n)
-                  (integerp j)
-                  (<= 0 j))
-             (equal (lxor (cat (bits x (1- n) n) 0
-                               (bits x (1- n) j) (- n j)
-                               (bits x (1- j) 0) j)
-                          (cat 0 0
-                               (1- (expt 2 (- n j))) (- n j)
-                               0 j)
-                          n)
-                    (cat (bits x (1- n) n) 0
-                         (lnot (bits x (1- n) j) (- n j)) (- n j)
-                         (bits x (1- j) 0) j)))
-    :hints (("Goal" :in-theory (e/d (lxor0-cat)
-                                    (cat-0 cat-0-alt cat-bits-bits))
-             :use ((:instance lxor0-ones
-                              (x (bits x (+ -1 n) j))
-                              (n (+ n (* -1 j)))))))
-    :rule-classes nil)))
-
-(defthmd lxor-slice
-  (implies (and (<= j i)
-                (<= i n)
-                (integerp n)
-                (integerp i)
-                (integerp j)
-                (<= 0 j))
-           (equal (lxor x
-                        (- (expt 2 i) (expt 2 j))
-                        n)
-                  (cat (bits x (1- n) i) (- n i)
-                       (lnot (bits x (1- i) j) (- i j)) (- i j)
-                       (bits x (1- j) 0) j)))
-  :hints (("Goal" :use (lxor-slice-1 lxor-slice-2 lxor-slice-2-i=n)
-           :in-theory (e/d (lxor-bits-1) (expt)))))
-
-; Start proof of lxor-expt, using lxor-slice, which is in this file because it
-; is a corollary of lxor-slice.
-
-(local
- (defthm lxor-expt-1-1
-   (implies (and (natp n)
-                 (natp k)
-                 (< k n))
-            (equal (lxor x (expt 2 k) n)
-                   (cat (bits x (1- n) (1+ k)) (1- (- n k))
-                        (lnot (bits x k k) 1) 1
-                        (bits x (1- k) 0) k)))
-   :hints (("Goal" :use ((:instance lxor-slice
-                                    (i (1+ k))
-                                    (j k)))))
-   :rule-classes nil))
-
-(local
- (defthm lxor-expt-1-2
-   (implies (and (natp n)
-                 (natp k)
-                 (< k n))
-            (equal (cat (bits x (1- n) (1+ k)) (1- (- n k))
-                        (lnot (bits x k k) 1) 1
-                        (bits x (1- k) 0) k)
-                   (+ (* (expt 2 (1+ k)) (bits x (1- n) (1+ k)))
-                      (cat (lnot (bits x k k) 1) 1
-                           (bits x (1- k) 0) k))))
-   :hints (("Goal" :use ((:instance binary-cat
-                                    (x (bits x (1- n) (1+ k)))
-                                    (m (1- (- n k)))
-                                    (y (cat (lnot (bits x k k) 1) 1
-                                            (bits x (1- k) 0) k))
-                                    (n (+ 1 k))))))
-   :rule-classes nil))
-
-(local
- (defthm lxor-expt-1-3
-   (implies (and (natp n)
-                 (natp k)
-                 (< k n))
-            (equal (cat (lnot (bits x k k) 1) 1
-                        (bits x (1- k) 0) k)
-                   (+ (* (expt 2 k) (lnot (bits x k k) 1))
-                      (bits x (1- k) 0))))
-   :hints (("Goal" :use ((:instance binary-cat
-                                    (x (lnot (bits x k k) 1))
-                                    (m 1)
-                                    (y (bits x (1- k) 0))
-                                    (n k)))))
-   :rule-classes nil))
-
-(local
- (defthmd lxor-expt-1
-   (implies (and (natp n)
-                 (natp k)
-                 (< k n))
-            (equal (lxor x (expt 2 k) n)
-                   (+ (* (expt 2 (1+ k)) (bits x (1- n) (1+ k)))
-                      (* (expt 2 k) (lnot (bits x k k) 1))
-                      (bits x (1- k) 0))))
-   :hints (("Goal" :use (lxor-expt-1-1 lxor-expt-1-2 lxor-expt-1-3)))))
-
-(local
- (defthmd lxor-expt-2
-   (implies (and (natp n)
-                 (natp k)
-                 (< k n))
-            (equal (bits x (1- n) 0)
-                   (+ (* (expt 2 (1+ k))
-                         (bits x (1- n) (1+ k)))
-                      (* (expt 2 k) (bitn x k))
-                      (bits x (1- k) 0))))
-   :hints (("Goal" :use ((:instance bits-plus-bits
-                                    (n (1- n))
-                                    (m 0)
-                                    (p (1+ k)))
-                         (:instance bitn-plus-bits ; could just enable
-                                    (n k)
-                                    (m 0)))))))
-
-(defthmd lxor-expt
-  (implies (and (natp n)
-		(natp k)
-		(< k n))
-	   (equal (lxor x (expt 2 k) n)
-		  (+ (bits x (1- n) 0)
-                     (* (expt 2 k) (- 1 (* 2 (bitn x k)))))))
-  :hints (("Goal" :in-theory (union-theories '(lxor-expt-1 lxor-expt-2)
-                                             (current-theory 'ground-zero)))
-          ("Goal''" :in-theory (enable lnot bitn))))
-
-(include-book "bits-trunc")
-
-; adapted from bits-trunc.lisp:
-
-(defthm bits-trunc
-  (implies (and (>= x (expt 2 (1- n)))
-                (< x (expt 2 n))
-                (integerp x) (> x 0)
-                (integerp m) (>= m n)
-                (integerp n) (> n k)
-                (integerp k) (> k 0)
-                )
-           (= (trunc x k)
-              (land x (- (expt 2 m) (expt 2 (- n k))) n)))
-  :hints (("Goal" :use bits-trunc-original))
-  :rule-classes ())
-
-; adapted from fadd.lisp:
-
-(include-book "fadd")
-
-(defthm gen-extend
-  (implies (and (integerp i)
-                (integerp j)
-                (integerp k)
-                (> i k)
-                (>= k j)
-                (>= j 0))
-           (equal (gen x y i j)
-                  (lior (gen x y i (1+ k))
-                        (land (prop x y i (1+ k))
-                              (gen x y k j)
-                              1)
-                        1)))
-  :hints (("Goal" :use gen-extend-original))
-  :rule-classes nil)
-
-(defthm prop-extend
-  (implies (and (integerp i)
-                (integerp j)
-                (integerp k)
-                (> i k)
-                (>= k j)
-                (>= j 0))
-           (equal (prop x y i j)
-                  (land (prop x y i (1+ k))
-                        (prop x y k j)
-                        1)))
-  :hints (("Goal" :use prop-extend-original))
-  :rule-classes ())
-
-(defthm gen-special-case
-  (implies (and (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0)
-                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
-           (equal (gen x y i j)
-                  (lior (bitn x i) (bitn y i) 1)))
-  :hints (("Goal" :use gen-special-case-original))
-  :rule-classes ())
-
-(defthm land-gen-0
-  (implies (and (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0)
-                (= (land (bits x i j) (bits y i j) (1+ (- i j))) 0))
-           (equal (gen x y i j) 0))
-  :hints (("Goal" :use land0-gen-0)))
-
-(defthm bits-sum-plus-1
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp i)
-                (integerp j)
-                (>= i j)
-                (>= j 0))
-           (equal (bits (+ 1 x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (lior (prop x y (1- j) 0) 
-                                 (gen x y (1- j) 0) 
-                                 1))
-                        (- i j) 0)))
-  :hints (("Goal" :use bits-sum-plus-1-with-prop-gen-original))
-  :rule-classes ())
-
-(defthm add-3
-  (implies (and (not (zp n))
-                (bvecp x n)
-                (bvecp y n)
-                (bvecp z n))
-           (equal (+ x y z)
-                  (+ (lxor x (lxor y z n) n)
-                     (* 2 (lior (land x y n)
-                                (lior (land x z n)
-                                      (land y z n)
-                                      n)
-                                n)))))
-  :hints (("Goal" :use add-3-original))
-  :rule-classes ())
-
-(defthm add-2
-  (implies (and (not (zp n))
-                (bvecp x n)
-                (bvecp y n))
-           (equal (+ x y)
-                  (+ (lxor x y n)
-                     (* 2 (land x y n)))))
-  :hints (("Goal" :use add-2-original))
-  :rule-classes ())
-
-(defthm top-thm-1
-  (implies (and (natp n)
-                (natp k)
-                (< k n)
-                (integerp a)
-                (integerp b))
-           (equal (equal (bits (+ a b 1) k 0) 0)
-		  (equal (bits (lnot (lxor a b n) n) k 0) 0)))
-  :hints (("Goal" :use top-thm-1-original))
-  :rule-classes ())
-
-(defund sigm (a b c n)
-  (if (= c 0)
-      (lnot (lxor a b n) n)
-    (lxor a b n)))
-
-(local-defthm sigm-is-sigm-0
-  (equal (sigm a b c n)
-         (sigm-0 a b c n))
-  :hints (("Goal" :in-theory (enable sigm-0 sigm))))
-
-(defund kap (a b c n)
-  (if (= c 0)
-      (* 2 (lior a b n))
-    (* 2 (land a b n))))
-
-(local-defthm kap-is-kap-0
-  (equal (kap a b c n)
-         (kap-0 a b c n))
-  :hints (("Goal" :in-theory (enable kap-0 kap))))
-
-(defund tau (a b c n)
-  (lnot (lxor0 (sigm a b c n) (kap a b c n) (1+ n)) (1+ n)))
-
-(local-defthm tau-is-tau-0
-  (equal (tau a b c n)
-         (tau-0 a b c n))
-  :hints (("Goal" :in-theory (enable tau-0 tau))))
-
-(defthm bvecp-sigm
-  (bvecp (sigm a b c n) n)
-  :hints (("Goal" :use bvecp-sigm-0 :in-theory (disable bvecp-sigm-0)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm a b c n)))))
-
-(defthm bvecp-kap
-  (implies (and (integerp n) (<= 0 n))
-           (bvecp (kap a b c n) (1+ n)))
-  :hints (("Goal" :use bvecp-kap-0 :in-theory (disable bvecp-kap-0)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap a b c n)))))
-
-(defthm bvecp-tau
-  (bvecp (tau a b c n) (1+ n))
-  :hints (("Goal" :use bvecp-tau-0 :in-theory (disable bvecp-tau-0)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau a b c n)))))
-
-(defthm top-thm-2
-  (implies (and (natp n)
-                (integerp a)
-                (integerp b)
-                (natp k)
-                (< k n)
-                (or (equal c 0) (equal c 1)))
-           (equal (equal (bits (+ a b c) k 0) 0)
-                  (equal (bits (lxor (lxor a b n) 
-                                     (cat (lior a b n) n c 1)
-                                     (1+ n)) 
-                               k 0) 
-                         0)))
-  :hints (("Goal" :use top-thm-2-original))
-  :rule-classes nil)
-
-(defthm top-thm-3
-  (implies (and (natp n)
-                (integerp a)
-                (integerp b)
-                (natp k)
-                (< k n))
-           (equal (equal (bits (+ a b 1) k 0) 0)
-		  (equal (bits (lnot (lxor (lxor a b n) 
-				           (cat (land a b n) n 0 1)
-					   (1+ n))
-				     (1+ n))
-			       k 0) 
-			 0)))
-  :hints (("Goal" :use top-thm-3-original))
-  :rule-classes ())
-
-(defthm lop-thm-1
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (= e (expo a))
-                (< (expo b) e)
-                (= lambda
-                   (lior (* 2 (mod a (expt 2 e)))
-                         (lnot (* 2 b) (1+ e))
-                         (1+ e))))
-           (or (= (expo (- a b)) (expo lambda))
-               (= (expo (- a b)) (1- (expo lambda)))))
-  :hints (("Goal" :use lop-thm-1-original))
-  :rule-classes ())
-
-(defun lamt (a b e)
-  (lxor a (lnot b (1+ e)) (1+ e)))
-
-(defun lamg (a b e)
-  (land a (lnot b (1+ e)) (1+ e)))
-
-(defun lamz (a b e)
-  (lnot (lior a (lnot b (1+ e)) (1+ e)) (1+ e)))
-
-(defun lam1 (a b e)
-  (land (bits (lamt a b e) e 2) 
-	(land (bits (lamg a b e) (1- e) 1)
-	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam2 (a b e)
-  (land (lnot (bits (lamt a b e) e 2) (1- e))
-	(land (bits (lamz a b e) (1- e) 1)
-	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam3 (a b e)
-  (land (bits (lamt a b e) e 2) 
-	(land (bits (lamz a b e) (1- e) 1)
-	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam4 (a b e)
-  (land (lnot (bits (lamt a b e) e 2) (1- e))
-	(land (bits (lamg a b e) (1- e) 1)
-	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam0 (a b e)
-  (lior (lam1 a b e)
-	(lior (lam2 a b e)
-	      (lior (lam3 a b e)
-		    (lam4 a b e)
-		    (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lamb (a b e)
-  (+ (* 2 (lam0 a b e))
-     (lnot (bitn (lamt a b e) 0) 1)))
-
-(defthm lop-thm-2
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (not (= a b))
-                (= e (expo a))
-                (= e (expo b))
-                (> e 1))
-           (and (not (= (lamb a b e) 0))
-                (or (= (expo (- a b)) (expo (lamb a b e)))
-                    (= (expo (- a b)) (1- (expo (lamb a b e)))))))
-  :hints (("Goal" :use lop-thm-2-original))
-  :rule-classes ())
-
-(defthm land-gen-0-cor
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n i)
-                (>= i j)
-                (>= j 0)
-                (= (land x y n) 0))
-           (equal (bits (+ x y) i j)
-                  (+ (bits x i j) (bits y i j))))
-  :hints (("Goal" :use land-gen-0-cor-original))
-  :rule-classes ())
-
-; Start proof of lior-plus from add-2.
-
-(local (in-theory (e/d (binary-land binary-lior binary-lxor)
-                       (land-is-land0 lior-is-lior0 lxor-is-lxor0))))
-
-(local-defthm lxor-is-lior
-  (implies (equal (land x y n) 0)
-           (equal (lxor x y n)
-                  (lior x y n))))
-
-(defthmd lior-plus
-  (implies (= (land x y n) 0)
-           (equal (lior x y n)
-                  (+ (bits x (1- n) 0)
-                     (bits y (1- n) 0))))
-  :hints (("Goal" :use ((:instance add-2
-                                   (x (bits x (1- n) 0))
-                                   (y (bits y (1- n) 0))))
-           :in-theory (enable lior-bits-1 lior-bits-2
-                              land-bits-1 land-bits-2))))
-
-; Start proof of gen-plus:
-
-(encapsulate
- ()
-
- (local-defthm gen-plus-1-1
-   (implies (and (natp x)
-                 (natp y)
-                 (natp k)
-                 (bvecp z (1+ k))
-                 (= (land z y (1+ k)) 0)
-                 (= (gen x y k 0) 1))
-            (equal (+ (bits x k 0) (bits y k 0))
-                   (+ (expt 2 (1+ k))
-                      (bits (+ x y) k 0))))
-   :hints (("Goal" :use ((:instance gen-val-cor2 (i k)))))
-   :rule-classes nil)
-
- (local-defthm gen-plus-1-2
-   (implies (and (natp x)
-                 (natp y)
-                 (natp k)
-                 (bvecp z (1+ k))
-                 (= (land z y (1+ k)) 0))
-            (equal (+ (bits y k 0) (bits z k 0))
-                   (bits (+ y z) k 0)))
-   :hints (("Goal" :use ((:instance land-gen-0-cor
-                                    (x y) (y z) (i k) (j 0) (n (1+ k))))
-            :in-theory (enable bvecp)))
-   :rule-classes nil)
-
- (local-defthm gen-plus-1-3
-   (< (bits x i j)
-      (expt 2 (1+ (- i j))))
-   :hints (("Goal"
-            :use ((:instance bits-upper-bound-2 (z (expt 2 (1+ (- i j))))))))
-   :rule-classes nil)
-                                   
- (local-defthm gen-plus-1
-   (implies (and (natp x)
-                 (natp y)
-                 (natp k)
-                 (bvecp z (1+ k))
-                 (= (land z y (1+ k)) 0)
-                 (= (gen x y k 0) 1))
-            (< (+ (bits (+ x y) k 0)
-                  (bits z k 0))
-               (expt 2 (1+ k))))
-   :hints (("Goal" :use (gen-plus-1-1
-                         gen-plus-1-2
-                         (:instance gen-plus-1-3 (x x) (i k) (j 0))
-                         (:instance gen-plus-1-3 (x (+ y z)) (i k) (j 0)))
-            :in-theory (disable land)))
-   :rule-classes nil)
-
- (defthmd gen-plus
-   (implies (and (natp x)
-                 (natp y)
-                 (natp k)
-                 (bvecp z (1+ k))
-                 (= (land z y (1+ k)) 0)
-                 (= (gen x y k 0) 1))
-            (equal (gen (+ x y) z k 0) 0))
-   :hints (("Goal" :use gen-plus-1
-            :in-theory (enable gen-val)))))
-
-; Start proof of gen-extend-3.
-
-(local (in-theory (enable bvecp-bits-0))) ; needed for gen-extend-3-a and more
-
-(local-defthm gen-extend-3-a-1
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (bvecp z (1+ j))
-                (= (land y z (1+ j)) 0))
-           (equal (gen (+ x y) z i (+ 1 j))
-                  0))
-  :rule-classes nil)
-
-(defthmd gen-extend-3-a
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (bvecp z (1+ j))
-                (= (land y z (1+ j)) 0))		  
-           (equal (gen (+ x y) z i 0)
-                  (land (prop (+ x y) z i (1+ j))
-                        (gen (+ x y) z j 0)			  
-                        1)))
-  :hints (("Goal" :use ((:instance gen-extend
-                                   (x (+ x y))
-                                   (y z)
-                                   (i i)
-                                   (j 0)
-                                   (k j))
-                        gen-extend-3-a-1))))
-
-(local-defthm bitn-0-1-rewrite
-  (implies (not (equal (bitn x n) 0))
-           (equal (bitn x n) 1))
-  :hints (("Goal" :use bitn-0-1)))
-
-(local-defthm gen-is-0-or-1
-  (implies (and (natp x)
-                (natp y)
-                (not (equal (gen x y i j) 1)))
-           (equal (gen x y i j) 0))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-1-1-1
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (bvecp z (1+ j))
-                 (= (land y z (1+ j)) 0)
-                (equal (gen (+ x y) z j 0) 1))
-           (equal (gen x y j 0) 0))
-  :hints (("Goal" :use ((:instance gen-plus (k j))
-                        (:instance gen-is-0-or-1
-                                   (i j) (j 0)))))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-1-1
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (bvecp z (1+ j))
-                (= (land y z (1+ j)) 0)
-                (equal (gen (+ x y) z j 0) 1))		  
-           (equal (bits (+ x y) i (1+ j))
-                  (bits (+ (bits x i (1+ j))
-                           (bits y i (1+ j)))
-                        (- i (1+ j))
-                        0)))
-  :hints (("Goal" :use ((:instance bits-sum (j (1+ j)))
-                        gen-extend-3-b-1-1-1)))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-1
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (bvecp z (1+ j))
-                (equal (gen (+ x y) z j 0) 1)
-                (= (land y z (1+ j)) 0))		  
-           (iff (equal (prop (+ x y) z i (1+ j))
-                       1)
-                (equal (bits (+ (bits x i (1+ j))
-                                (bits y i (1+ j)))
-                             (- i (1+ j))
-                             0)
-                       (1- (expt 2 (- i j))))))
-  :hints (("Goal" :use (gen-extend-3-b-1-1
-                        (:instance prop-val
-                                   (x (+ x y))
-                                   (y z)
-                                   (i i)
-                                   (j (1+ j))))))
-  :rule-classes nil)
-
-(local-defthm prop-is-0-or-1
-  (implies (not (equal (prop x y i j) 1))
-           (equal (prop x y i j) 0))
-  :rule-classes nil)
-
-; Most or all of the following are needed for gen-extend-3-b-2-1-2, and this is
-; a good idea anyhow.
-(local (in-theory (e/d (bits-nonnegative-integerp-type)
-                       (bits-slice-zero-gen))))
-
-(local-defthm gen-extend-3-b-2-1-1-1
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y))
-           (equal (+ (bits x i (1+ j))
-                     (bits y i (1+ j)))
-                  (bits (+ (bits x i (1+ j))
-                           (bits y i (1+ j)))
-                        (- i j)
-                        0)))
-  :hints (("Goal" :use ((:instance bits-bvecp
-                                   (x x) (i i) (j (1+ j)) (k (- i j)))
-                        (:instance bits-bvecp
-                                   (x y) (i i) (j (1+ j)) (k (- i j)))
-                        (:instance bits-tail
-                                   (x (+ (bits x i (+ 1 j))
-                                         (bits y i (+ 1 j))))
-                                   (i (+ i (* -1 j)))))
-           :expand ((expt 2 (+ 1 i (* -1 j))))
-           :in-theory (enable bvecp)))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-2-1-1-2
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y))
-           (equal (bits (+ (bits x i (1+ j))
-                           (bits y i (1+ j)))
-                        (- i j)
-                        0)
-                  (+ (* (expt 2 (- i j))
-                        (bitn (+ (bits x i (1+ j))
-                                 (bits y i (1+ j)))
-                              (- i j)))
-                     (bits (+ (bits x i (1+ j))
-                              (bits y i (1+ j)))
-                           (1- (- i j))
-                           0))))
-  :hints (("Goal" :use ((:instance bitn-plus-bits
-                                   (x (+ (bits x i (1+ j))
-                                         (bits y i (1+ j))))
-                                   (n (- i j))
-                                   (m 0)))))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-2-1-1
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (equal (bits (+ (bits x i (1+ j))
-                                (bits y i (1+ j)))
-                             (- i (1+ j))
-                             0)
-                       (1- (expt 2 (- i j)))))
-           (equal (+ (bits x i (1+ j))
-                     (bits y i (1+ j)))
-                  (+ (* (expt 2 (- i j))
-                        (bitn (+ (bits x i (1+ j))
-                                 (bits y i (1+ j)))
-                              (- i j)))
-                     (1- (expt 2 (- i j))))))
-  :hints (("Goal" :use (gen-extend-3-b-2-1-1-1 gen-extend-3-b-2-1-1-2)))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-2-1-2
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y))
-           (< (+ (bits x i (1+ j))
-                 (bits y i (1+ j)))
-              (1- (+ (expt 2 (- i j))
-                     (expt 2 (- i j))))))
-  :hints (("Goal" :use ((:instance bits-bvecp
-                                   (x x) (i i) (j (1+ j)) (k (- i j)))
-                        (:instance bits-bvecp
-                                   (x y) (i i) (j (1+ j)) (k (- i j)))
-                        (:instance expt-2-positive-integer-type
-                                   (i (+ i (* -1 j)))))
-           :in-theory (e/d (bvecp) (a14 power2-integer expt2-integer))))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-2-1
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (equal (bits (+ (bits x i (1+ j))
-                                (bits y i (1+ j)))
-                             (- i (1+ j))
-                             0)
-                       (1- (expt 2 (- i j)))))
-           (equal (+ (bits x i (1+ j))
-                     (bits y i (1+ j)))
-                  (1- (expt 2 (- i j)))))
-  :hints (("Goal" :use (gen-extend-3-b-2-1-1 gen-extend-3-b-2-1-2)))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-2-2-1
-  (implies (and (natp i)
-                (natp j)
-                (> i j))
-           (equal (bits (1- (expt 2 (- i j)))
-                        (- i (1+ j))
-                        0)
-                  (1- (expt 2 (- i j)))))
-  :hints (("Goal" :in-theory (enable bvecp bits-does-nothing (expo))))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-2-2
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (equal (+ (bits x i (1+ j))
-                          (bits y i (1+ j)))
-                       (1- (expt 2 (- i j)))))
-           (equal (bits (+ (bits x i (1+ j))
-                           (bits y i (1+ j)))
-                        (- i (1+ j))
-                        0)
-                  (1- (expt 2 (- i j)))))
-  :hints (("Goal" :use gen-extend-3-b-2-2-1))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b-2
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y))
-           (iff (equal (bits (+ (bits x i (1+ j))
-                                (bits y i (1+ j)))
-                             (- i (1+ j))
-                             0)
-                       (1- (expt 2 (- i j))))
-                (equal (+ (bits x i (1+ j))
-                          (bits y i (1+ j)))
-                       (1- (expt 2 (- i j))))))
-  :hints (("Goal" :use (gen-extend-3-b-2-1 gen-extend-3-b-2-2)))
-  :rule-classes nil)
-
-(local-defthm gen-extend-3-b
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (bvecp z (1+ j))
-                (= (land y z (1+ j)) 0)
-                (equal (gen (+ x y) z j 0) 1))
-           (equal (prop (+ x y) z i (1+ j))
-                  (prop x y i (1+ j))))
-  :hints (("Goal" :use (gen-extend-3-b-1
-                        (:instance prop-val (j (1+ j)))
-                        gen-extend-3-b-2
-                        (:instance prop-is-0-or-1
-                                   (x (+ x y))
-                                   (y z)
-                                   (i i)
-                                   (j (1+ j)))
-                        (:instance prop-is-0-or-1
-                                   (x x)
-                                   (y y)
-                                   (i i)
-                                   (j (1+ j))))
-           :in-theory (enable bits-reduce)
-           ))
-  :rule-classes nil)
-
-(defthmd gen-extend-3
-  (implies (and (natp i)
-                (natp j)
-                (> i j)
-                (natp x)
-                (natp y)
-                (bvecp z (1+ j))
-                (= (land y z (1+ j)) 0))		  
-           (equal (gen (+ x y) z i 0)
-                  (land (prop x y i (1+ j))
-                        (gen (+ x y) z j 0)			  
-                        1)))
-  :hints (("Goal" :use (gen-extend-3-a
-                        gen-extend-3-b
-                        (:instance gen-is-0-or-1
-                                   (x (+ x y))
-                                   (y z)
-                                   (i j)
-                                   (j 0)))
-           :in-theory (enable bvecp) ; need (natp z)
-           )))
diff -Nru acl2-6.2/books/rtl/rel5/support/lextra0.lisp acl2-6.3/books/rtl/rel5/support/lextra0.lisp
--- acl2-6.2/books/rtl/rel5/support/lextra0.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lextra0.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,54 +0,0 @@
-(in-package "ACL2")
-
-(include-book "land0")
-(include-book "lior0")
-(include-book "lxor0")
-(local (include-book "lextra-proofs"))
-
-;theorems mixing two or more of the new logical operators.
-
-;BOZO really the -1 and -2 names below should be switched?
-
-(deflabel lextra0-start)
-
-(defthm lior0-land0-1
-  (equal (lior0 x (land0 y z n) n)
-         (land0 (lior0 x y n) (lior0 x z n) n)))
-
-(defthm lior0-land0-2
-  (equal (lior0 (land0 y z n) x n)
-         (land0 (lior0 x y n) (lior0 x z n) n)))
-
-(defthm land0-lior0-1
-  (equal (land0 x (lior0 y z n) n)
-         (lior0 (land0 x y n) (land0 x z n) n)))
-
-(defthm land0-lior0-2
-  (equal (land0 (lior0 y z n) x n)
-         (lior0 (land0 x y n) (land0 x z n) n)))
-
-(defthm lior0-land0-lxor0
-  (equal (lior0 (land0 x y n) (lior0 (land0 x z n) (land0 y z n) n) n)
-         (lior0 (land0 x y n) (land0 (lxor0 x y n) z n) n)))
-
-(defthm lxor0-rewrite
-  (equal (lxor0 x y n)
-         (lior0 (land0 x (lnot y n) n)
-               (land0 y (lnot x n) n)
-               n)))
-
-(defthm lnot-lxor0
-  (equal (lnot (lxor0 x y n) n)
-         (lxor0 (lnot x n) y n)))
-
-(defthm lnot-lior0
-  (equal (lnot (lior0 x y n) n)
-         (land0 (lnot x n) (lnot y n) n)))
-
-(defthm lnot-land0
-  (equal (lnot (land0 x y n) n)
-         (lior0 (lnot x n) (lnot y n) n)))
-
-(deflabel lextra0-end)
-
-(in-theory (current-theory 'lextra0-start))
diff -Nru acl2-6.2/books/rtl/rel5/support/lior.lisp acl2-6.3/books/rtl/rel5/support/lior.lisp
--- acl2-6.2/books/rtl/rel5/support/lior.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lior.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,566 +0,0 @@
-; Port lior0 theorems to lior.  The original definition of lior (in rel4) was
-; that of lior0 in the current release.  So the port is to keep all the lemmas
-; about lior0 and then use equality of lior0 with lior to port them to lior.
-
-(in-package "ACL2")
-
-(include-book "lior0")
-(local (include-book "top1"))
-
-(defun binary-lior (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)
-                  :verify-guards nil))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (or (equal (bitn x 0) 1)
-                      (equal (bitn y 0) 1))
-                  1
-                0))
-             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-lior (mod x 2) (mod y 2) 1))))
-       :exec ; (lior0 x y n)
-       (logior (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro lior (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
-         `(binary-lior ,@x))
-        (t         
-         `(binary-lior ,(car x)
-                       (lior ,@(cdr x))
-                       ,(car (last x))))))
-
-
-(encapsulate
- ()
-
- (local
-  (defun p0 (x y n)
-    (equal (lior x y n)
-           (lior0 x y n))))
-
- (local
-  (defthm p0-holds-inductive-step
-    (implies (and (not (zp n))
-                  (not (equal n 1))
-                  (p0 (fl (* x 1/2))
-                      (fl (* y 1/2))
-                      (+ -1 n))
-                  (p0 (mod x 2) (mod y 2) 1))
-             (p0 x y n))
-    :hints (("Goal" :use (lior0-def binary-lior)))))
-
- (local
-  (defthm p0-holds-base-1
-    (p0 x y 1)
-    :hints (("Goal" :in-theory (enable bitn)
-             :expand ((binary-lior0 x y 1))))))
-
- (local
-  (defthm p0-holds-base-0
-    (implies (zp n)
-             (p0 x y n))
-    :hints (("Goal" :expand ((binary-lior0 x y n))))))
-
- (local
-  (defthm p0-holds
-    (p0 x y n)
-    :hints (("Goal" :induct (lior x y n)
-             :in-theory (disable p0)))
-    :rule-classes nil))
-
- (defthmd lior-is-lior0
-   (equal (lior x y n)
-          (lior0 x y n))
-   :hints (("Goal" :use p0-holds))))
-
-(local (in-theory (e/d (lior-is-lior0))))
-
-(add-macro-alias lior binary-lior)
-
-(defthm lior-nonnegative-integer-type
-  (and (integerp (lior x y n))
-       (<= 0 (lior x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lior)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lior-natp
-  (natp (lior x y n)))
-
-(defthm lior-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (lior x y n)
-                  0)))
-
-(defthmd lior-bvecp-simple
-  (bvecp (lior x y n) n))
-
-(defthm lior-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lior x y n) k)))
-
-
-;;
-;; Rules to normalize lior terms (recall that LIOR is a macro for BINARY-LIOR):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm lior-associative
-  (equal (lior (lior x y n) z n)
-         (lior x (lior y z n) n)))
-
-(defthm lior-commutative
-  (equal (lior y x n)
-         (lior x y n)))
-
-(defthm lior-commutative-2
-  (equal (lior y (lior x z n) n)
-         (lior x (lior y z n) n)))
-
-(defthm lior-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (lior x (lior y z n) n)
-                  (lior (lior x y n) z n))))
-
-(defthm lior-0
-  (implies (case-split (bvecp y n))
-           (equal (lior 0 y n)
-                  y)))
-
-;nicer than the analogous rule for logior?
-(defthm lior-1
-  (implies (case-split (bvecp y 1))
-           (equal (lior 1 y 1)
-                  1)))
-
-(defthm lior-self
-  (implies (and (case-split (bvecp x n))
-                (case-split (integerp n)))
-           (equal (lior x x n)
-                  x)))
-
-(defthmd bits-lior-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lior x y n) i j)
-                  (lior (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j))))))
-
-(defthmd bits-lior-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lior x y n) i j)
-                  (lior (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j))))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-lior
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (lior x y n) i j)
-                  (lior (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-lior-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior x y n) m)
-                  (lior (bitn x m) 
-                        (bitn y m) 
-                        1))))
-
-(defthmd bitn-lior-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-lior
-  (implies (and (case-split (<= 0 k))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior x y n) k)
-                  (if (< k n)
-                      (lior (bitn x k) 
-                            (bitn y k) 
-                            1)
-                    0))))
-
-;or could wrap bits around conclusion?
-(defthm lior-equal-0
-  (implies (and (case-split (bvecp x n))
-                (case-split (bvecp y n))
-                (case-split (integerp n))
-                )
-           (equal (equal 0 (lior x y n))
-                  (and (equal x 0)
-                       (equal y 0)))))
-
-(defthm lior-of-single-bits-equal-0
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 0 (lior x y 1))
-                  (and (equal x 0)
-                       (equal y 0)))))
-
-(defthm lior-of-single-bits-equal-1
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 1 (lior x y 1))
-                  (or (equal x 1)
-                      (equal y 1)))))
-
-(defthm lior-ones
-  (implies (and (case-split (bvecp x n))
-                (case-split (natp n)) ;gen
-                )
-           (equal (lior (1- (expt 2 n)) x n)
-                  (1- (expt 2 n))))
-  :hints (("Goal" :use lior0-ones))
-  :rule-classes ())
-
-;lior-with-all-ones will rewrite (lior x n) [note there's only one value being ANDed], because (lior x n)
-;expands to (BINARY-LIOR X (ALL-ONES N) N) - now moot???
-(defthm lior-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (lior (all-ones n) x n)
-                  (all-ones n))))
-
-(defthm lior-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-		(case-split (natp n))
-                (case-split (bvecp x n)))
-           (equal (lior k x n)
-                  (1- (expt 2 n))))
-  :hints (("Goal" :use lior-ones)))
-
-(defthm lior-def-original
-  (implies (and (< 0 n)
-                (integerp n))
-           (equal (lior x y n)
-                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (lior (mod x 2) (mod y 2) 1))))
-  :hints (("Goal" :use lior0-def))
-  :rule-classes ())
-
-(defthm lior-mod-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (mod (lior x y n) 2)
-                  (lior (mod x 2) (mod y 2) 1)))
-  :hints (("Goal" :use lior0-mod-2)))
-
-(defthm lior-fl-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (fl (/ (lior x y n) 2))
-                  (lior (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-  :hints (("Goal" :use lior0-fl-2)))
-
-(in-theory (disable lior-mod-2 lior-fl-2))
-
-;BOZO rename
-(defthm lior-x-y-0
-  (equal (lior x y 0) 0))
-
-(defthm lior-reduce
-  (implies (and (bvecp x n)
-                (bvecp y n)
-                (< n m)
-                (natp n) ;gen?
-                (natp m)
-                )
-           (equal (lior x y m) (lior x y n))))
-
-;whoa! this is a *lower* bound !
-;make alt version?
-(defthm lior-bnd
-  (implies (case-split (bvecp x n))
-           (<= x (lior x y n)))
-  :rule-classes (:rewrite :linear))
-
-;get rid of the bvecp hyps (do that for many lemmas like this one)
-(defthm lior-with-shifted-arg
-  (implies (and (bvecp y m)
-                (bvecp x (- n m))
-                (<= m n)
-                (natp m)
-                (integerp n)
-                )
-           (= (lior (* (expt 2 m) x) y n)
-              (+ (* (expt 2 m) x) y)))
-  :rule-classes ()
-  :hints (("Goal" :use lior0-with-shifted-arg)))
-
-(defthm lior-shift-original
-  (implies (and (bvecp x (- n m))
-                (bvecp y (- n m))
-                (integerp n) ;(not (zp n))
-                (natp m)
-                (<= m n)
-                )
-           (= (lior (* (expt 2 m) x)
-                    (* (expt 2 m) y)
-                    n)
-              (* (expt 2 m) (lior x y (- n m)))))
-  :rule-classes ()
-  :hints (("Goal" :use lior0-shift)))
-
-(defthm lior-expt
-  (implies (and (natp n)
-                (natp k)
-                (< k n))
-           (= (lior x (expt 2 k) n)
-              (+ (bits x (1- n) 0)
-                 (* (expt 2 k) (- 1 (bitn x k))))))
-  :rule-classes ()
-  :hints (("Goal" :use lior0-expt)))
-
-;interesting.  not the same as lior-bvecp (here, m can be smaller than n)
-;rename !!
-(defthm lior-bvecp-2
-  (implies (and (bvecp x m)
-                (bvecp y m)
-                )
-           (bvecp (lior x y n) m)))
-
-(defthm lior-upper-bound
-  (< (lior x y n) (expt 2 n))
-  :rule-classes (:rewrite :linear))
-
-(defthm lior-upper-bound-tight
-  (implies (<= 0 n)
-           (<= (lior x y n) (1- (expt 2 n))))
-  :rule-classes (:rewrite :linear))
-
-(defthm lior-fl-1
-  (equal (lior (fl x) y n)
-         (lior x y n)))
-
-(defthm lior-fl-2-eric
-  (equal (lior x (fl y) n)
-         (lior x y n)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; Added in move to rel5 (should perhaps be in a -proofs file):
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; Start proof of fl-lior (copied from proof of fl-land).
-
-(local
- (defun fl-lior-induction (k n)
-   (if (zp k)
-       n
-     (fl-lior-induction (1- k) (1+ n)))))
-
-
-(local
- (defthmd fl-lior-induction-step-1
-   (implies (not (zp k))
-            (equal (lior (fl (* x (/ (expt 2 k))))
-                         (fl (* y (/ (expt 2 k))))
-                         n)
-                   (lior (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
-                         (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
-                         n)))
-   :hints (("Goal" :in-theory (disable lior-fl-1
-                                       lior-fl-2-eric
-                                       lior-is-lior0
-                                       fl/int-rewrite)
-            :expand ((expt 2 k))
-            :use ((:instance fl/int-rewrite
-                             (x (* x (/ (expt 2 (1- k)))))
-                             (n 2))
-                  (:instance fl/int-rewrite
-                             (x (* y (/ (expt 2 (1- k)))))
-                             (n 2)))))))
-
-(local
- (defthmd fl-lior-induction-step-2
-   (equal (lior (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
-                (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
-                n)
-          (fl (/ (lior (fl (* x (/ (expt 2 (1- k)))))
-                       (fl (* y (/ (expt 2 (1- k)))))
-                       (1+ n))
-                 2)))
-   :hints (("Goal" :in-theory (disable lior-fl-1
-                                       lior-fl-2-eric
-                                       lior-is-lior0
-                                       fl/int-rewrite)
-            :expand ((lior (fl (* x (/ (expt 2 (1- k)))))
-                           (fl (* y (/ (expt 2 (1- k)))))
-                           (1+ n)))))))
-
-(local
- (defthmd fl-lior-induction-step-3
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (lior x y (+ k n))))
-                        (lior (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (/ (lior (fl (* x (/ (expt 2 (1- k)))))
-                                (fl (* y (/ (expt 2 (1- k)))))
-                                (1+ n))
-                          2))
-                   (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
-                                 (lior x y (+ k n))))
-                          2))))))
-
-(local
- (defthmd fl-lior-induction-step-4
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (lior x y (+ k n))))
-                        (lior (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
-                                 (lior x y (+ k n))))
-                          2))
-                   (fl (* (/ (expt 2 k))
-                          (lior x y (+ k n))))))
-   :hints (("Goal" :expand ((expt 2 k))))))
-
-(local
- (defthm fl-lior-induction-step
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (lior x y (+ k n))))
-                        (lior (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (* (/ (expt 2 k))
-                          (lior x y (+ k n))))
-                   (lior (fl (* x (/ (expt 2 k))))
-                         (fl (* y (/ (expt 2 k))))
-                         n)))
-   :hints (("Goal" :use (fl-lior-induction-step-1
-                         fl-lior-induction-step-2
-                         fl-lior-induction-step-3
-                         fl-lior-induction-step-4)))))
-
-(defthmd fl-lior
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (natp k))
-           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
-                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
-  :hints (("Goal" :induct (fl-lior-induction k n)
-           :in-theory (disable lior-is-lior0 lior-fl-1 lior-fl-2-eric))))
-
-(defthmd lior-def
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n 0))
-           (equal (lior x y n)
-                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (lior (bitn x 0) (bitn y 0) 1))))
-  :hints (("Goal" :in-theory (enable bitn-rec-0)
-           :use lior-def-original)))
-
-(local
- (defun lior-shift-induction (n k)
-   (if (zp k)
-       (+ k n)
-     (lior-shift-induction (1- n) (1- k)))))
-
-(defthm lior-shift
-  (implies (and (integerp x)
-                (integerp y)
-                (natp k))
-           (= (lior (* (expt 2 k) x)
-                    (* (expt 2 k) y)
-                    n)
-              (* (expt 2 k) (lior x y (- n k)))))
-  :hints (("Goal" :induct (lior-shift-induction n k)
-           :expand ((expt 2 k))
-           :in-theory (e/d (bitn-negative-bit-of-integer)
-                           (lior-is-lior0))))
-  :rule-classes ())
-
-; See land.lisp for analogous lemma and a hand proof of it.
-(defthmd mod-lior
-  (implies (and (integerp n)
-                (<= k n))
-           (equal (mod (lior x y n) (expt 2 k))
-                  (lior x y k)))
-  :hints (("Goal"
-           :use
-           ((:instance bits-lior (x x) (y y) (n k) (i (1- k)) (j 0))
-            (:instance mod-bits (x (lior x y n)) (i (1- n)) (j k))))))
-
-(defthmd lior-bits-1
-  (equal (lior (bits x (1- n) 0)
-               y
-               n)
-         (lior x y n))
-  :hints (("Goal" :use lior0-bits-1)))
-
-(defthmd lior-bits-2
-  (equal (lior x
-               (bits y (1- n) 0)
-               n)
-         (lior x y n))
-  :hints (("Goal" :use lior0-bits-2)))
-
-(defthm lior-base
-  (equal (lior x y 1)
-         (if (or (equal (bitn x 0) 1)
-                 (equal (bitn y 0) 1))
-             1
-           0))
-  :hints (("Goal" :use lior0-base))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/lior0-proofs.lisp acl2-6.3/books/rtl/rel5/support/lior0-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/lior0-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lior0-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,616 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LIOR0, a nice version of LOGIOR.  LIOR0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-Todo:
-add versions like logand-expt-2 and logand-expt-4
-prove (elsewhere) lemmas mixing lior0 with other functions
-what should lior0 of non-ints be?
-|#
-
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(local (include-book "all-ones"))
-(local (include-book "merge"))
-(local (include-book "bvecp"))
-(local (include-book "logior"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "../arithmetic/top"))
-
-(defund binary-lior0 (x y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logior (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro lior0 (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lior0 x y n) -- the base case
-         `(binary-lior0 ,@x))
-        (t         
-         `(binary-lior0 ,(car x)
-                       (lior0 ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable lior0)) to refer to binary-lior0.
-(add-macro-alias lior0 binary-lior0)
-
-(defthm lior0-nonnegative-integer-type
-  (and (integerp (lior0 x y n))
-       (<= 0 (lior0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lior0) is no better than lior0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lior0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lior0-natp
-  (natp (lior0 x y n)))
-
-(defthm lior0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (lior0 x y n)
-                  0))
-  :hints (("Goal" :cases ((acl2-numberp n))
-           :in-theory (enable lior0)))
-  )
-
-(defthmd lior0-bvecp-simple
-  (bvecp (lior0 x y n) n)
-  :hints (("Goal" :cases ((natp n))
-           :in-theory (enable lior0))))
-
-(defthm lior0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lior0 x y n) k))
-  :hints (("Goal" :in-theory (disable lior0-bvecp-simple)
-           :use lior0-bvecp-simple)))
-
-
-;;
-;; Rules to normalize lior0 terms (recall that LIOR0 is a macro for BINARY-LIOR0):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm lior0-associative
-  (equal (lior0 (lior0 x y n) z n)
-         (lior0 x (lior0 y z n) n))
-  :hints (("Goal" :cases ((natp n))
-           :in-theory (enable lior0 bits-tail))))
-
-(defthm lior0-commutative
-  (equal (lior0 y x n)
-         (lior0 x y n))
-  :hints (("Goal" :in-theory (enable lior0))))
-
-(defthm lior0-commutative-2
-  (equal (lior0 y (lior0 x z n) n)
-         (lior0 x (lior0 y z n) n))
-  :hints (("Goal"  :cases ((natp n))
-           :in-theory (enable lior0 bits-tail))))
-
-(defthm lior0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (lior0 x (lior0 y z n) n)
-                  (lior0 (lior0 x y n) z n))))
-
-(defthm lior0-0
-  (implies (case-split (bvecp y n))
-           (equal (lior0 0 y n)
-                  y))
-  :hints (("Goal" :in-theory (enable lior0 bits-tail))))
-
-;nicer than the analogous rule for logior?
-(defthm lior0-1
-  (implies (case-split (bvecp y 1))
-           (equal (lior0 1 y 1)
-                  1))
-  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-(defthm lior0-self
-  (implies (and (case-split (bvecp x n))
-                (case-split (integerp n)))
-           (equal (lior0 x x n)
-                  x))
-  :hints (("Goal" :in-theory (enable lior0 bits-tail))))
-
-
-(defthmd bits-lior0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable lior0 bits-logand))))
-
-
-(defthmd bits-lior0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable lior0 bits-logand))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-lior0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j)))))
-  :hints (("Goal" :in-theory (enable bits-lior0-1 bits-lior0-2))))
-
-(defthmd bitn-lior0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  (lior0 (bitn x m) 
-                        (bitn y m) 
-                        1)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn)
-                              '(BITS-N-N-REWRITE)))))
-(defthmd bitn-lior0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  0))
-  :hints (("Goal" :in-theory (enable BVECP-BITN-0))))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-lior0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  (if (< m n)
-                      (lior0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0)))
-  :hints (("Goal" :in-theory (enable bitn-lior0-1 bitn-lior0-2))))
-
-
-
-;or could wrap bits around conclusion?
-(defthm lior0-equal-0
-  (implies (and (case-split (bvecp x n))
-                (case-split (bvecp y n))
-                (case-split (integerp n))
-                )
-           (equal (equal 0 (lior0 x y n))
-                  (and (equal x 0)
-                       (equal y 0))))
-  :hints (("Goal" :in-theory (enable lior0 bits-tail))))
-
-(defthm lior0-of-single-bits-equal-0
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 0 (lior0 x y 1))
-                  (and (equal x 0)
-                       (equal y 0))))
-  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-(defthm lior0-of-single-bits-equal-1
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 1 (lior0 x y 1))
-                  (or (equal x 1)
-                      (equal y 1))))
-  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-(defthm lior0-ones
-  (implies (and (case-split (bvecp x n))
-                (case-split (natp n)) ;gen
-                )
-           (equal (lior0 (1- (expt 2 n)) x n)
-                  (1- (expt 2 n))))
-  :rule-classes ()
-  :hints
-  (("goal"  :use logior-ones
-    :in-theory (enable lior0 bits-tail)
-    )))
-
-;lior0-with-all-ones will rewrite (lior0 x n) [note there's only one value being ANDed], because (lior0 x n)
-;expands to (BINARY-LIOR0 X (ALL-ONES N) N) - now moot???
-(defthm lior0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (lior0 (all-ones n) x n)
-                  (all-ones n)))
-  :hints
-  (("goal" :use lior0-ones
-    :in-theory (enable all-ones))))
-
-(defthm lior0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-		(case-split (natp n))
-                (case-split (bvecp x n)))
-           (equal (lior0 k x n)
-                  (1- (expt 2 n))))
-  :hints (("Goal"
-           :use lior0-ones)))
-
-(local (in-theory (disable MOD-BY-2-REWRITE-TO-EVEN MOD-MULT-OF-N MOD-EQUAL-0 )))
-
-(encapsulate
- ()
-
- (local
-  (defthm lior0-def-integerp
-    (implies (and (integerp x)
-                  (integerp y)
-                  (> n 0)
-                  (integerp n))
-             (equal (lior0 x y n)
-                    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (lior0 (mod x 2) (mod y 2) 1))))
-    :rule-classes ()
-    :hints (("Goal" :in-theory (e/d (lior0 bits-fl-by-2)
-                                    ())
-             :use ((:instance logior-def (i (bits x (1- n) 0)) (j (bits y (1- n) 0)))
-                   (:instance mod012 (m x))
-                   (:instance mod012 (m y)))))))
-
-; Now we want to eliminate the (integerp x) and (integerp y) hypotheses from
-; lior0-def-integerp.  First suppose x is not rational.
-
- (local
-  (defthm lior0-is-0-if-not-rational-1
-    (implies (not (rationalp x))
-             (equal (lior0 x y n)
-                    (lior0 0 y n)))
-    :hints (("Goal" :expand ((lior0 x y n)
-                             (lior0 0 y n))))))
-
- (local
-  (defthm lior0-is-0-if-not-rational-2
-    (implies (not (rationalp y))
-             (equal (lior0 x y n)
-                    (lior0 x 0 n)))
-    :hints (("Goal" :expand ((lior0 x y n)
-                             (lior0 0 x n))))))
-
- (local
-  (defthm fl-1/2-is-0-if-not-rational
-    (implies (not (rationalp x))
-             (equal (fl (* 1/2 x)) 0))
-    :hints (("Goal" :cases ((acl2-numberp x))))))
-
- (local
-  (defthm mod-2-if-not-rational
-    (implies (not (rationalp x))
-             (equal (mod x 2)
-                    (fix x)))
-    :hints (("Goal" :expand ((mod x 2))))))
-
- (local
-  (defthm lior0-fl-1
-    (equal (lior0 (fl x) y n)
-           (lior0 x y n))
-    :hints (("Goal" :expand ((lior0 y (fl x) n)
-                             (lior0 x y n))))))
-
- (local
-  (defthm lior0-fl-2
-    (equal (lior0 y (fl x) n)
-           (lior0 y x n))
-    :hints (("Goal" :expand ((lior0 y (fl x) n)
-                             (lior0 x y n))))))
-
- (local
-  (defthm lior0-def-rational-hack
-    (implies (and (rationalp x)
-                  (rationalp y)
-                  (>= n 0)
-                  (integerp n))
-             (equal (lior0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
-                    (lior0 (* 1/2 x) (* 1/2 y) n)))
-    :hints (("Goal" :expand ((lior0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
-                             (lior0 (* 1/2 x) (* 1/2 y) n))))))
-
- (local
-  (defthm lior0-def-rational
-    (implies (and (rationalp x)
-                  (rationalp y)
-                  (> n 0)
-                  (integerp n))
-             (equal (lior0 x y n)
-                    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (lior0 (mod x 2) (mod y 2) 1))))
-    :rule-classes ()
-    :hints (("Goal"
-             :use ((:instance lior0-def-integerp (x (fl x)) (y (fl y))))
-             :in-theory (e/d (mod-fl-eric) (fl-mod))))))
-
- (local
-  (defthm lior0-def-not-rational-1
-    (implies (and (not (rationalp x))
-                  (rationalp y)
-                  (> n 0)
-                  (integerp n))
-             (equal (lior0 x y n)
-                    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (lior0 (mod x 2) (mod y 2) 1))))
-    :hints (("Goal" :use ((:instance lior0-def-rational
-                                     (x 0)))))
-    :rule-classes nil))
-
- (local
-  (defthm lior0-def-not-rational-2
-    (implies (and (rationalp x)
-                  (not (rationalp y))
-                  (> n 0)
-                  (integerp n))
-             (equal (lior0 x y n)
-                    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (lior0 (mod x 2) (mod y 2) 1))))
-    :hints (("Goal" :use ((:instance lior0-def-rational
-                                     (y 0)))))
-    :rule-classes nil))
-
- (defthm lior0-def
-   (implies (and (> n 0)
-                 (integerp n))
-            (equal (lior0 x y n)
-                   (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                      (lior0 (mod x 2) (mod y 2) 1))))
-   :rule-classes ()
-   :hints (("Goal" :use (lior0-def-not-rational-1
-                         lior0-def-not-rational-2
-                         lior0-def-rational)))))
-
-
-(defthm lior0-mod-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (mod (lior0 x y n) 2)
-		    (lior0 (mod x 2) (mod y 2) 1)))
-  :hints (("Goal" :use (lior0-def
-			(:instance mod012 (m x))
-			(:instance mod012 (m y))
-			(:instance quot-mod (m (lior0 x y n)) (n 2))))))
-
-(defthm lior0-fl-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (fl (/ (lior0 x y n) 2))
-		    (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-  :hints (("Goal" :use (lior0-def
-			(:instance mod012 (m x))
-			(:instance mod012 (m y))
-			(:instance quot-mod (m (lior0 x y n)) (n 2))))))
-
-(in-theory (disable lior0-mod-2 lior0-fl-2))
-
-(defthm lior0-x-y-0
-    (equal (lior0 x y 0) 0)
-  :hints (("Goal" :in-theory (enable lior0))))
-
-(defthm lior0-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (< n m)
-                  (natp n)
-		  (natp m)
-		  )
-	     (equal (lior0 x y m) (lior0 x y n)))
-  :hints (("Goal" :in-theory (enable lior0))))
-
-;whoa! this is a *lower* bound !
-;make alt version?
-(defthm lior0-bnd
-  (implies (case-split (bvecp x n))
-           (<= x (lior0 x y n)))
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :use ((:instance logior-bnd
-                                   (x (bits x (1- n) 0)) 
-				   (y (bits y (1- n) 0))))
-           :in-theory (enable bits-tail lior0))))
-
-;get rid of the bvecp hyps (do that for many lemmas like this one)
-(defthm lior0-with-shifted-arg
-    (implies (and (bvecp y m)
-		  (bvecp x (- n m))
-                  (<= m n)
-		  (natp m)
-                  (integerp n)
-                  )
-	     (= (lior0 (* (expt 2 m) x) y n)
-		(+ (* (expt 2 m) x) y)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance logior-expt (n m)))
-		  :in-theory (enable bvecp-forward bvecp-longer bvecp-shift-up bits-tail lior0))))
-
-(defthm lior0-shift
-    (implies (and (bvecp x (- n m))
-		  (bvecp y (- n m))
-                  (integerp n) ;(not (zp n))
-		  (natp m)
-		  (<= m n)
-                  )
-	     (= (lior0 (* (expt 2 m) x)
-		      (* (expt 2 m) y)
-		      n)
-		(* (expt 2 m) (lior0 x y (- n m)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance logior-expt-2 (n m)))
-		  :in-theory (enable bvecp-forward bvecp-longer bvecp-shift-up bits-tail lior0))))
-
-(defthm lior0-expt-original
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (bvecp x n))
-	     (= (lior0 x (expt 2 k) n)
-		(+ x (* (expt 2 k) (- 1 (bitn x k))))))
-  :rule-classes ()
-  :hints (("Goal" :use (logior-expt-3
-			(:instance expt-strong-monotone (n k) (m n)))
-		  :in-theory (enable bvecp lior0))))
-
-;interesting.  not the same as lior0-bvecp (here, m can be smaller than n)
-;rename !!
-(defthm lior0-bvecp-2
-  (implies (and (bvecp x m)
-                (bvecp y m)
-                )
-           (bvecp (lior0 x y n) m))
-  :hints (("Goal" :in-theory (enable lior0))))
-
-(defthm lior0-upper-bound
-  (< (lior0 x y n) (expt 2 n))
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :in-theory (enable lior0))))
-
-(defthm lior0-upper-bound-tight
-  (implies (<= 0 n)
-           (<= (lior0 x y n) (1- (expt 2 n))))
-  :rule-classes (:rewrite :linear))
-
-(defthm lior0-fl-1
-  (equal (lior0 (fl x) y n)
-         (lior0 x y n))
-  :hints (("Goal" :in-theory (enable lior0))))
-
-(defthm lior0-fl-2-eric ;BOZO name conflicted...
-  (equal (lior0 x (fl y) n)
-         (lior0 x y n))
-  :hints (("Goal" :in-theory (enable lior0))))
-
-(defthmd lior0-bits-1
-  (equal (lior0 (bits x (1- n) 0)
-               y
-               n)
-         (lior0 x y n))
-  :hints (("Goal" :in-theory (e/d (lior0) (logior lior0-commutative)))))
-
-(defthmd lior0-bits-2
-  (equal (lior0 x
-               (bits y (1- n) 0)
-               n)
-         (lior0 x y n))
-  :hints (("Goal" :in-theory (e/d (lior0) (logior lior0-commutative)))))
-
-(local
- (defthm lior0-base-lemma
-   (implies (and (bvecp x 1) (bvecp y 1))
-            (equal (lior0 x y 1)
-                   (if (or (equal (bitn x 0) 1)
-                           (equal (bitn y 0) 1))
-                       1
-                     0)))
-   :rule-classes nil))
-
-(defthm lior0-base
-  (equal (lior0 x y 1)
-         (if (or (equal (bitn x 0) 1)
-                 (equal (bitn y 0) 1))
-             1
-           0))
-  :hints (("Goal" :use ((:instance lior0-base-lemma
-                                   (x (bits x 0 0))
-                                   (y (bits y 0 0)))
-                        (:instance lior0-bits-1
-                                   (x x)
-                                   (y (bits y 0 0))
-                                   (n 1))
-                        (:instance lior0-bits-2 (n 1)))))
-  :rule-classes nil)
-
-(defthm lior0-expt
-  (implies (and (natp n)
-                (natp k)
-                (< k n))
-           (= (lior0 x (expt 2 k) n)
-              (+ (bits x (1- n) 0)
-                 (* (expt 2 k) (- 1 (bitn x k))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance lior0-expt-original
-                                   (x (bits x (1- n) 0))))
-           :in-theory (enable lior0-bits-1 lior0-bits-2))))
diff -Nru acl2-6.2/books/rtl/rel5/support/lior0.lisp acl2-6.3/books/rtl/rel5/support/lior0.lisp
--- acl2-6.2/books/rtl/rel5/support/lior0.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lior0.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,403 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LIOR0, a nice version of LOGIOR.  LIOR0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-Todo:
-add versions like logand-expt-2 and logand-expt-4 <-- huh?
-prove (elsewhere) lemmas mixing lior0 with other functions
-|#
-
-;; Necessary defuns:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(local (include-book "lior0-proofs"))
-
-;; Start of new stuff:
-
-(defund binary-lior0 (x y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logior (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro lior0 (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lior0 x y n) -- the base case
-         `(binary-lior0 ,@x))
-        (t         
-         `(binary-lior0 ,(car x)
-                       (lior0 ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable lior0)) to refer to binary-lior0.
-(add-macro-alias lior0 binary-lior0)
-
-(defthm lior0-nonnegative-integer-type
-  (and (integerp (lior0 x y n))
-       (<= 0 (lior0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lior0) is no better than lior0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lior0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lior0-natp
-  (natp (lior0 x y n)))
-
-(defthm lior0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (lior0 x y n)
-                  0)))
-
-(defthmd lior0-bvecp-simple
-  (bvecp (lior0 x y n) n))
-
-(defthm lior0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lior0 x y n) k)))
-
-
-;;
-;; Rules to normalize lior0 terms (recall that LIOR0 is a macro for BINARY-LIOR0):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm lior0-associative
-  (equal (lior0 (lior0 x y n) z n)
-         (lior0 x (lior0 y z n) n)))
-
-(defthm lior0-commutative
-  (equal (lior0 y x n)
-         (lior0 x y n)))
-
-(defthm lior0-commutative-2
-  (equal (lior0 y (lior0 x z n) n)
-         (lior0 x (lior0 y z n) n)))
-
-(defthm lior0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (lior0 x (lior0 y z n) n)
-                  (lior0 (lior0 x y n) z n))))
-
-(defthm lior0-0
-  (implies (case-split (bvecp y n))
-           (equal (lior0 0 y n)
-                  y)))
-
-;nicer than the analogous rule for logior?
-(defthm lior0-1
-  (implies (case-split (bvecp y 1))
-           (equal (lior0 1 y 1)
-                  1)))
-
-(defthm lior0-self
-  (implies (and (case-split (bvecp x n))
-                (case-split (integerp n)))
-           (equal (lior0 x x n)
-                  x)))
-
-(defthmd bits-lior0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j))))))
-
-(defthmd bits-lior0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j))))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-lior0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-lior0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  (lior0 (bitn x m) 
-                        (bitn y m) 
-                        1))))
-
-(defthmd bitn-lior0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-lior0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  (if (< m n)
-                      (lior0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0))))
-
-;or could wrap bits around conclusion?
-(defthm lior0-equal-0
-  (implies (and (case-split (bvecp x n))
-                (case-split (bvecp y n))
-                (case-split (integerp n))
-                )
-           (equal (equal 0 (lior0 x y n))
-                  (and (equal x 0)
-                       (equal y 0)))))
-
-(defthm lior0-of-single-bits-equal-0
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 0 (lior0 x y 1))
-                  (and (equal x 0)
-                       (equal y 0)))))
-
-(defthm lior0-of-single-bits-equal-1
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 1 (lior0 x y 1))
-                  (or (equal x 1)
-                      (equal y 1)))))
-
-(defthm lior0-ones
-  (implies (and (case-split (bvecp x n))
-                (case-split (natp n)) ;gen
-                )
-           (equal (lior0 (1- (expt 2 n)) x n)
-                  (1- (expt 2 n))))
-  :rule-classes ())
-
-;lior0-with-all-ones will rewrite (lior0 x n) [note there's only one value being ANDed], because (lior0 x n)
-;expands to (BINARY-LIOR0 X (ALL-ONES N) N) - now moot???
-(defthm lior0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (lior0 (all-ones n) x n)
-                  (all-ones n))))
-
-(defthm lior0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-		(case-split (natp n))
-                (case-split (bvecp x n)))
-           (equal (lior0 k x n)
-                  (1- (expt 2 n)))))
-
-(defthm lior0-def
-    (implies (and (< 0 n)
-		  (integerp n))
-	     (equal (lior0 x y n)
-		    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-		       (lior0 (mod x 2) (mod y 2) 1))))
-  :rule-classes ())
-
-(defthm lior0-mod-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (mod (lior0 x y n) 2)
-		    (lior0 (mod x 2) (mod y 2) 1))))
-
-(defthm lior0-fl-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (fl (/ (lior0 x y n) 2))
-		    (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
-
-(in-theory (disable lior0-mod-2 lior0-fl-2))
-
-;BOZO rename
-(defthm lior0-x-y-0
-  (equal (lior0 x y 0) 0))
-
-(defthm lior0-reduce
-  (implies (and (bvecp x n)
-                (bvecp y n)
-                (< n m)
-                (natp n) ;gen?
-                (natp m)
-                )
-           (equal (lior0 x y m) (lior0 x y n))))
-
-;whoa! this is a *lower* bound !
-;make alt version?
-(defthm lior0-bnd
-  (implies (case-split (bvecp x n))
-           (<= x (lior0 x y n)))
-  :rule-classes (:rewrite :linear))
-
-;get rid of the bvecp hyps (do that for many lemmas like this one)
-(defthm lior0-with-shifted-arg
-    (implies (and (bvecp y m)
-		  (bvecp x (- n m))
-                  (<= m n)
-		  (natp m)
-                  (integerp n)
-                  )
-	     (= (lior0 (* (expt 2 m) x) y n)
-		(+ (* (expt 2 m) x) y)))
-  :rule-classes ())
-
-(defthm lior0-shift
-    (implies (and (bvecp x (- n m))
-		  (bvecp y (- n m))
-                  (integerp n) ;(not (zp n))
-		  (natp m)
-		  (<= m n)
-                  )
-	     (= (lior0 (* (expt 2 m) x)
-		      (* (expt 2 m) y)
-		      n)
-		(* (expt 2 m) (lior0 x y (- n m)))))
-  :rule-classes ())
-
-(defthm lior0-expt-original
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (bvecp x n))
-	     (= (lior0 x (expt 2 k) n)
-		(+ x (* (expt 2 k) (- 1 (bitn x k))))))
-  :rule-classes ())
-
-(defthm lior0-expt
-  (implies (and (natp n)
-                (natp k)
-                (< k n))
-           (= (lior0 x (expt 2 k) n)
-              (+ (bits x (1- n) 0)
-                 (* (expt 2 k) (- 1 (bitn x k))))))
-  :rule-classes ())
-
-;interesting.  not the same as lior0-bvecp (here, m can be smaller than n)
-;rename !!
-(defthm lior0-bvecp-2
-  (implies (and (bvecp x m)
-                (bvecp y m)
-                )
-           (bvecp (lior0 x y n) m)))
-
-(defthm lior0-upper-bound
-  (< (lior0 x y n) (expt 2 n))
-  :rule-classes (:rewrite :linear))
-
-(defthm lior0-upper-bound-tight
-  (implies (<= 0 n)
-           (<= (lior0 x y n) (1- (expt 2 n))))
-  :rule-classes (:rewrite :linear))
-
-(defthm lior0-fl-1
-  (equal (lior0 (fl x) y n)
-         (lior0 x y n)))
-
-(defthm lior0-fl-2-eric
-  (equal (lior0 x (fl y) n)
-         (lior0 x y n)))
-
-(defthmd lior0-bits-1
-  (equal (lior0 (bits x (1- n) 0)
-               y
-               n)
-         (lior0 x y n)))
-
-(defthmd lior0-bits-2
-  (equal (lior0 x
-               (bits y (1- n) 0)
-               n)
-         (lior0 x y n)))
-
-(defthm lior0-base
-  (equal (lior0 x y 1)
-         (if (or (equal (bitn x 0) 1)
-                 (equal (bitn y 0) 1))
-             1
-           0))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/lnot-proofs.lisp acl2-6.3/books/rtl/rel5/support/lnot-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/lnot-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lnot-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,776 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defun bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(local (include-book "bits"))
-(local (include-book "bitn"))
-;(local (include-book "../arithmetic/top"))
-(local (include-book "../arithmetic/expt"))
-(local (include-book "../arithmetic/mod"))
-(local (include-book "../arithmetic/mod"))
-(local (include-book "../arithmetic/arith"))
-(local (include-book "../arithmetic/arith2"))
-(local (include-book "../arithmetic/integerp"))
-(local (include-book "bvecp"))
-
-(local (in-theory (enable expt-minus)))
-
-#|
-(defun LNOT (x n)
-  (1- (- (expt 2 n) x)))
-|#
-
-;used to be called COMP1
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-;note that this isn't a rewrite rule b/c we believe it will never need to be
-(defthm lnot-nonnegative-integer-type
-  (and (integerp (lnot x n))
-       (<= 0 (lnot x n)))
-  :hints (("Goal" :in-theory (enable lnot)))
-  :rule-classes ((:type-prescription :typed-term (lnot x n))))
-
-;lnot-nonnegative-integer-type is strictly better, and we don't need both
-(in-theory (disable (:type-prescription lnot))) 
-
-(defthm lnot-natp
-  (natp (lnot x n)))
-
-(defthm lnot-upper-bound
-  (< (lnot x n) (expt 2 n))
-  :hints (("Goal" :in-theory (enable lnot)))
-  :rule-classes (:rewrite :linear)
-  )
-
-;why is bvecp enabled here?
-
-(defthm lnot-bvecp-simple
-  (bvecp (lnot x n) n)
-  :hints (("Goal" :in-theory (enable bvecp lnot))))
-
-(defthm lnot-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lnot x n) k))
-  :hints (("Goal" :in-theory (disable lnot-bvecp-simple)
-           :use lnot-bvecp-simple)))
-
-(defthm lnot-lnot
-  (implies (and (case-split (natp n))
-                (case-split (bvecp x n))
-                )
-           (equal (lnot (lnot x n) n)
-                  x))
-  :hints (("Goal" :in-theory (enable lnot bvecp bits-does-nothing))))
-
-;reorient this rule?
-(defthmd lnot-times-2
-   (implies (and (case-split (natp x))
-                 (case-split (natp n))
-                 )
-            (equal (+ 1 (* 2 (lnot x n)))
-                   (lnot (* 2 x) (1+ n))))
-   :hints (("Goal" :in-theory (enable lnot expt-split)
-            :use (:instance bits-shift (n 1) (i n) (j 0)))))
-
-(defthm lnot-x-0
-  (equal (lnot x 0) 0)
-  :hints (("Goal" :in-theory (enable lnot)))
-  )
-
-
-(encapsulate
- ()
-
- (local
-  (defthm fl-lnot-1
-    (implies (and (integerp n) (>= n k)
-                  (integerp k)
-                  (>= k 0) ;drop? and propagate..
-                  (integerp x) (>= x 0)
-                  (< x (expt 2 n))
-                  )
-             (equal (/ (lnot x n) (expt 2 k))
-                    (+ (expt 2 (- n k))
-                       (/ (- -1 x) (expt 2 k)))))
-    :rule-classes ()
-    :hints (("Goal" :in-theory (set-difference-theories
-                                (enable lnot expt-split)
-                                '( ;a10
-                                   ))
-             ))))
-
-;this looks fragile
- (local (defthm fl=
-          (implies (equal x y)
-                   (equal (fl x) (fl y)))
-          :rule-classes ()))
-
- (local (defthm fl-lnot-2
-          (implies (and (integerp n) (>= n k)
-                        (integerp k) (>= k 0)
-                        (integerp x) (>= x 0) (< x (expt 2 n)))
-                   (equal (fl (/ (lnot x n) (expt 2 k)))
-                          (fl (+ (expt 2 (- n k))
-                                 (/ (- -1 x) (expt 2 k))))))
-          :rule-classes ()
-          :hints (("Goal" :in-theory (disable ;a10
-                                      )
-                   :use ((:instance fl-lnot-1)
-                         (:instance fl= 
-                                    (x (/ (lnot x n) (expt 2 k))) 
-                                    (y (+ (expt 2 (- n k))
-                                          (/ (- -1 x) (expt 2 k))))))))))
-
- (local (include-book "../arithmetic/fl"))
-
- (local (defthm fl-lnot-3
-          (implies (and (integerp n) (>= n k)
-                        (integerp k) (>= k 0)
-                        (integerp x) (>= x 0) (< x (expt 2 n)))
-                   (equal (fl (/ (lnot x n) (expt 2 k)))
-                          (+ (expt 2 (- n k))
-                             (fl (/ (- -1 x) (expt 2 k))))))
-          :rule-classes ()
-          :hints (("Goal" :in-theory (enable lnot)
-                   :use ((:instance fl-lnot-2)
-                         )))))
-
-;gen?
-;make a by-2 version?
-;change param name?
-;make a better rewrite rule
- (defthmd lnot-fl-aux
-   (implies (and (<= k n)
-                 (bvecp x n)
-                 (<= 0 k)
-                 (integerp n) 
-                 (integerp k)
-                 )
-            (equal (fl (* (/ (expt 2 k)) (lnot x n)))
-                   (lnot (fl (/ x (expt 2 k))) (- n k))))
-   :hints (("Goal" :in-theory (set-difference-theories
-                               (enable lnot bvecp)
-                               '(bits-fl ;a10
-                                 ;fl-minus-gen
-                                 ))
-            :use ((:instance fl-lnot-3)
-                  (:instance fl-m+1 (m x) (n (expt 2 k)))
-                  ))))
-
- )
-
-;disable?
-(defthm lnot-bits-1
-  (equal (lnot (bits x (1- n) 0) n)
-         (lnot x n))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-(defthmd lnot-ignores-bits-2
-  (implies (and (integerp i)
-                (<= (1- n) i))
-           (equal (lnot (bits x i 0) n)
-                  (lnot x n)))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-;disable?
-(defthm lnot-fl-eric
-  (equal (lnot (fl x) n)
-         (lnot x n))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-;is this okay? dropped the fl...
-(local (defthmd lnot-fl-eric-helper
-   (implies (and (<= k n)
-                 ;(bvecp x n)
-                 (<= 0 k)
-                 (integerp n) 
-                 (integerp k)
-                 )
-            (equal (fl (* (/ (expt 2 k)) (lnot x n)))
-                   (lnot (/ (bits x (1- n) 0) (expt 2 k)) (- n k))))
-   :hints (("Goal" :in-theory (disable lnot-fl-aux)
-            :use ((:instance lnot-fl-aux (x (bits x (1- n) 0 ))))))
-   ))
-
-
-;BOZO move!
-(DEFTHM BITS-SHIFT-inv
-  (IMPLIES (AND (CASE-SPLIT (INTEGERP N))
-                (CASE-SPLIT (INTEGERP I))
-                (CASE-SPLIT (INTEGERP J)))
-           (EQUAL (BITS (* (/ (EXPT 2 N)) X) I J)
-                  (BITS X (+ I N) (+ J N))))
-  :hints (("Goal" :in-theory (disable bits-shift)
-           :use (:instance bits-shift (n (- n))))))
-
-
-;why did I have to open up bits??
-;perhaps export this?
-(local (defthmd lnot-fl-eric-helper-2
-   (implies (and (<= k n)
-                 (<= 0 k)
-                 (integerp n) 
-                 (integerp k)
-                 )
-            (equal (lnot (/ (bits x (1- n) 0) (expt 2 k)) (- n k))
-                   (lnot (/ x (expt 2 k)) (- n k))))
-   :hints (("Goal" :in-theory (e/d ( lnot) (
-                                            LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)) ;BOZO
-            :use ((:instance bits-shift (n (- k)) (i (+ -1 N (* -1 K))) (j 0))
-
-                  )))))
-
-;lacks the bvecp hyp
-(defthmd lnot-fl-original
-   (implies (and (<= k n)
-                 (<= 0 k)
-                 (integerp n) 
-                 (integerp k)
-                 )
-            (equal (fl (* (/ (expt 2 k)) (lnot x n)))
-                   (lnot (fl (/ x (expt 2 k))) (- n k))))
-   :hints (("Goal" :use  lnot-fl-eric-helper-2
-            :in-theory (enable  lnot-fl-eric-helper  lnot-fl-eric-helper-2))))
-
-(defthmd lnot-fl
-  (implies (and (natp n)
-                (natp k))
-           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
-                  (lnot (fl (/ x (expt 2 k))) n)))
-  :Hints (("Goal" :use ((:instance lnot-fl-original
-                                   (x x)
-                                   (k k)
-                                   (n (+ n k)))))))
-
-
-
-
-(encapsulate
- ()
-
- (local
-  (defthm mod-lnot-1
-    (implies (and (integerp x)
-                  (>= x 0)
-                  (integerp n)
-                  (>= n 0) ;BOZO try dropping
-                  (integerp m)
-                  (>= m n)
-                  (< x (expt 2 m))
-                  (< x (expt 2 n)) ;new
-                  )
-             (equal (lnot x m)
-                    (+ (lnot x n) (* (expt 2 n) (1- (expt 2 (- m n)))))))
-    :rule-classes ()
-    :hints (("goal"  :in-theory (enable lnot expt-split) 
-             ))))
-
-
- (local
-  (defthm mod-lnot-2-thm
-    (implies (and (integerp x)
-                  (>= x 0)
-                  (integerp n)
-                  (>= n 0)
-                  (integerp m)
-                  (>= m n)
-                  (< x (expt 2 m))
-                  (< x (expt 2 n)) ;new
-                  )
-             (equal (mod (lnot x m) (expt 2 n))
-                    (mod (+ (lnot x n) (* (expt 2 n) (1- (expt 2 (- m n))))) (expt 2 n))))
-    :rule-classes ()
-    :hints (("goal" :use (mod-lnot-1)))))
-
- (local
-  (defthm mod-lnot-3
-    (implies (and (integerp x)
-                  (>= x 0)
-                  (integerp n)
-                  (>= n 0)
-                  (integerp m)
-                  (>= m n)
-                  (< x (expt 2 m))
-                  )
-             (equal (mod (lnot x m) (expt 2 n))
-                    (mod (lnot (mod x (expt 2 n)) m) (expt 2 n))))
-    :otf-flg t
-    :rule-classes ()
-    :hints (("goal" :in-theory (enable lnot ; bits
-                                       )
-             :use ((:instance mod-difference-elim-second (x1 (1- (expt 2 m))) (x2 x) (y (expt 2 n)))
-                   (:instance expt-weak-monotone)
-;                 (:instance lnot-bnds (n m))
-;                              (:instance mod+-thm (m (lnot x n)) (n (expt 2 n)) (a (1- (expt 2 (- m n)))))
-                              
-                   )))))
-
- (local
-  (defthm mod-lnot-4
-    (implies (and (integerp x)
-                  (>= x 0)
-                  (integerp n)
-                  (>= n 0)
-                  (integerp m)
-                  (>= m n)
-                  (< x (expt 2 n))
-                  )
-             (equal (mod (lnot x m) (expt 2 n))
-                    (mod (lnot x n) (expt 2 n))))
-    :rule-classes ()
-    :hints (("goal"
-             :use (mod-lnot-2-thm
-                   (:instance expt-weak-monotone)
-;			(:instance lnot-bnds (n m))
-                   (:instance mod-mult-eric (x (lnot x n)) (y (expt 2 n)) (a (1- (expt 2 (- m n)))))
-                   )))))
-
- (local
-  (defthm mod-lnot-5
-    (implies (and (integerp x)
-                  (>= x 0)
-                  (integerp n)
-                  (>= n 0)
-                  (integerp m)
-                  (>= m n)
-                  (< x (expt 2 m)))
-             (equal (mod (lnot x m) (expt 2 n))
-                    (mod (lnot (mod x (expt 2 n)) n) (expt 2 n))))
-    :rule-classes ()
-    :hints (("goal" :use (mod-lnot-3
-                          (:instance mod-lnot-4 (x (mod x (expt 2 n))))
-;                                     (:instance mod-bnd-1 (m x) (n (expt 2 n)))
-;                                     (:instance mod>=0 (m x) (n (expt 2 n)))
-                          )))))
-
-;gen
-;add case-splits
-;write in terms of bvecp?
- (defthm mod-lnot-aux
-   (implies (and (< x (expt 2 m)) ;drop!
-                 (<= n m)
-                 (integerp x)
-                 (<= 0 x)
-                 (integerp n)
-                 (<= 0 n) ;gen
-                 (integerp m)
-                 )
-            (equal (mod (lnot x m) (expt 2 n))
-                   (lnot (mod x (expt 2 n)) n)))
-   :hints (("goal" :in-theory (enable lnot)
-            :use (mod-lnot-5
-;(:instance mod-equal (m (lnot (mod x (expt 2 n)) n)) (n (expt 2 n)))
-;(:instance mod-bnd-1 (m x) (n (expt 2 n)))
-;                  (:instance mod>=0 (m x) (n (expt 2 n)))
-                  ))))
- )
-
-
-
-
-(local (include-book "../arithmetic/top"))
-
-
-;BOZO move this!
-(defthm bits-ignores-mod-special
-  (equal (bits (mod x (expt 2 m)) (1- m) 0)
-         (bits x (1- m) 0)
-         )
-  :hints (("goal" :in-theory (enable bits)))
-  )
-
-;BOZO move this!
-(defthm bits-ignores-mod
-  (implies (and (<= m n)
-                (case-split (integerp n))
-                ;(integerp m)
-                )
-           (equal (bits (mod x (expt 2 n)) (1- m) 0)
-                  (bits x (1- m) 0)
-                  ))
-  :hints (("goal" :in-theory (enable bits)))
-  )
-
-(defthm lnot-ignores-mod-special
-  (equal (lnot (mod x (expt 2 m)) m)
-         (lnot x m))
-  :hints (("Goal" :in-theory (enable lnot)))
-  )
-
-(defthm lnot-ignores-mod
-  (implies (and (<= m n)
-                (case-split (integerp n)))
-           (equal (lnot (mod x (expt 2 n)) m)
-                  (lnot x m)))
-  :hints (("Goal" :in-theory (enable lnot)))
-  )
-
-;consider enabling?
-(defthmd mod-lnot-aux2
-   (implies (and (<= n m)
-                 (integerp x) ;will be dropped below
-                 (integerp n)
-                 (<= 0 n) ;gen
-                 (integerp m)
-                 )
-            (equal (mod (lnot x m) (expt 2 n))
-                   (lnot (mod x (expt 2 n)) n))) ;note the lack of m in the conclusion
-   :hints (("Goal" :in-theory (disable MOD-LNOT-aux)
-            :use (:instance mod-lnot-aux (x (mod x (expt 2 m)))))))
-
-;no (integerp x) hyp
-(defthmd mod-lnot
-   (implies (and (<= k n) ;handle the other case?
-                 (natp k)
-                 (integerp n)
-                 )
-            (equal (mod (lnot x n) (expt 2 k))
-                   (lnot (mod x (expt 2 k)) k))) ;note the lack of n in the conclusion
-   :hints (("Goal" :use (:instance mod-lnot-aux2 (x (fl x)) (n k) (m n))
-            :in-theory (disable mod-lnot-aux2 ))))
-
-(defthm mod-lnot-by-2
-  (implies (and (< 0 n)
-                (integerp x) ;gen?
-                (integerp n)
-                )
-           (equal (mod (lnot x n) 2)
-                  (lnot (mod x 2) 1)))
-  :hints (("Goal" :in-theory (disable lnot-ignores-mod
-                                      LNOT-IGNORES-MOD-SPECIAL
-                                      mod-lnot)
-           :use ((:instance lnot-ignores-mod (n 1) (m n))
-                 (:instance mod-lnot (n n) (k 1))))))
-
-(local (defthmd bits-lnot-aux
-  (implies (and (< i m)
-                (case-split (bvecp x m)) ;dropped below..
-                (case-split (integerp m))
-                (case-split (integerp i))
-                (case-split (natp j)) ;gen?
-                )
-           (equal (bits (lnot x m) i j)
-                  (lnot (bits x i j) (1+ (- i j)))))
-  :hints (("Goal" :cases ((>= i j))
-           :in-theory (e/d (bits bvecp lnot-fl-original) ( LNOT-IGNORES-MOD  MOD-LNOT  LNOT-IGNORES-MOD-SPECIAL))))))
-
-
-
-;gen?
-;BOZO formal m should be n
-(local
- (defthm bits-lnot-original
-   (implies (and (< i m)
-                 (case-split (natp j))
-                 (case-split (integerp m))
-                 (case-split (integerp i))
-                 )
-            (equal (bits (lnot x m) i j)
-                   (lnot (bits x i j) (1+ (- i j)))))
-   :hints (("Goal" :use (:instance bits-lnot-aux (x (bits x (1- m) 0)))
-            :in-theory (e/d (bvecp) ())))))
-
-#|
-(defthm bits-lnot-2
-  (implies (and (< i m)
-                (case-split (integerp m))
-                (case-split (integerp i))
-                (case-split (natp j)) ;gen?
-                (not (bvecp x m)) ;note!
-                (integerp x)
-                )
-           (equal (bits (lnot x m) i j)
-                  (lnot (bits x i j) (1+ (- i j)))))
-  :hints (("Goal" :cases ((>= i j))
-           :in-theory (enable bvecp lnot))))
-
-
-
-|#
-
-;gen?
-(defthm bitn-lnot
-  (implies (and (case-split (natp k))
-                (case-split (natp n))
-                ;(case-split (bvecp x k))
-                )
-           (equal (bitn (lnot x n) k)
-                  (if (< k n)
-                      (lnot (bitn x k) 1)
-                    0)))
-  :hints (("Goal" :in-theory (enable bitn BVECP-BITS-0
-                                     ))))
-
-;drop?
-(defthm bitn-lnot-not-equal
-  (implies (and (< k n)
-                (integerp n)
-                (<= 0 n)
-                (integerp k)
-                (<= 0 k)
-                )
-           (not (= (bitn (lnot x n) k)
-                   (bitn x k))))
-  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1) ;why needed?
-; :in-theory (enable bvecp)
-           :use (:instance bitn-0-1 (n k))
-           ))
-  :rule-classes ())
-
-;could generalize these a lot (when lnot equals a constant, take the lnot of both sides)
-;drop bvecp hyp by wrapping bits around conclusion?
-(defthm lnot-bvecp-equal-0
-  (implies (case-split (bvecp x 1))
-           (equal (equal (lnot x 1) 0)
-                  (not (equal x 0))))
-  :hints (("goal" :in-theory (enable lnot bvecp))))
-
-(defthm lnot-bvecp-equal-1
-  (implies (case-split (bvecp x 1))
-           (equal (equal (lnot x 1) 1)
-                  (equal x 0)))
-  :hints (("goal" :in-theory (enable lnot bvecp))))
-
-(defthmd lnot-shift
-  (implies (and (case-split (integerp x))
-                (case-split (natp n))
-                (natp k))
-           (equal (lnot (* (expt 2 k) x) n)
-                  (if (<= k n)
-                      (+ (* (expt 2 k) (lnot x (- n k)))
-                         (1- (expt 2 k)))
-                    (1- (expt 2 n)))))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-(defthmd lnot-shift-2
-  (implies (and (syntaxp (not (quotep x))) ;prevents loops
-                (case-split (integerp x))
-                (case-split (< 0 n))
-                (case-split (integerp n))
-                )
-           (equal (lnot (* 2 x) n)
-                  (+ 1 (* 2 (lnot x (1- n))))))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-
-
-
-
-#| BOZO get this to work and use in stick-proofs instead of bitn-lnot-not-equal?
-
-;gen!
-(defthm lnot-x-not-equal-x
-  (implies (and (natp n) (natp x))
-           (not (equal (lnot x n) x)))
-  :hints (("Goal" :in-theory (enable lnot)))
-)
-
-|#
-
-
-(defthm lnot-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (lnot x n)
-                  0))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-(defthm lnot-with-n-not-positive
-  (implies (<= n 0)
-           (equal (lnot x n)
-                  0))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-; Start proof of bits-lnot-aux-2 (for bits-lnot).
-
-(local
- (defthm hack 
-   (implies (and (integerp n) (integerp i) (<= n i))
-            (< (expt 2 n) (expt 2 (1+ i))))
-   :rule-classes nil))
-
-(local
-  (defthm bits-lnot-aux-2-1-1-1
-    (implies (and (not (< i n))
-                  (rationalp x)
-                  (case-split (integerp n))
-                  (case-split (integerp i)))
-             (equal (mod (lnot x n) (expt 2 (+ 1 i)))
-                    (lnot x n)))
-    :hints (("Goal"
-             :use (lnot-upper-bound hack)
-             :in-theory (e/d () (lnot-upper-bound
-                                 expt-compare
-                                 expo-expt2
-                                 power2p-expt2-i))))))
-
-(local
-  (defthm bits-lnot-aux-2-1-1
-    (implies (and (not (< i n))
-                  (rationalp x)
-                  (case-split (natp j))
-                  (case-split (integerp n))
-                  (case-split (integerp i)))
-             (equal (bits (lnot x n) i j)
-                    (fl (/ (lnot x n)
-                           (expt 2 j)))))
-    :hints (("Goal"
-             :in-theory (e/d (bits) ())))))
-
-(local
- (defthm hack-2
-   (implies (and (< n j)
-                 (integerp j))
-            (< (lnot x n) (expt 2 j)))
-   :hints (("Goal" :in-theory (enable lnot)))))
-
-(local
-  (defthm bits-lnot-aux-2-1-2
-    (implies (and (not (< i n))
-                  (rationalp x)
-                  (case-split (natp j))
-                  (case-split (integerp n))
-                  (case-split (integerp i)))
-             (equal (fl (/ (lnot x n)
-                           (expt 2 j)))
-                    (lnot (fl (/ x (expt 2 j))) (- n j))))
-    :hints (("Goal" :use ((:instance lnot-fl
-                                     (k j)
-                                     (n (- n j))))))))
-
-(local
-  (defthm bits-lnot-aux-2-1-3
-    (implies (and (not (< i n))
-                  (rationalp x)
-                  (case-split (natp j))
-                  (case-split (integerp n))
-                  (case-split (integerp i)))
-             (equal (bits (fl (/ x (expt 2 j))) (1- (- n j)) 0)
-                    (bits x (1- n) j)))
-    :hints (("Goal" :use ((:instance bits-shift-down-1
-                                     (x x)
-                                     (k j)
-                                     (i (- (1- n) j))
-                                     (j 0)))))))
-
-(local
- (defthm bits-lnot-aux-2-1
-   (implies (and (not (< i n))
-                 (rationalp x)
-                 (case-split (natp j))
-                 (case-split (integerp n))
-                 (case-split (integerp i)))
-            (equal (bits (lnot x n) i j)
-                   (lnot (bits x (1- n) j)
-                         (- n j))))
-   :hints (("Goal"
-            :use (bits-lnot-aux-2-1-1
-                  bits-lnot-aux-2-1-2
-                  bits-lnot-aux-2-1-3)))
-   :rule-classes nil))
-
-(local
- (defthm bits-lnot-aux-2-2
-   (implies (and (not (< i n))
-                 (not (<= j i))
-                 (rationalp x)
-                 (case-split (natp j))
-                 (case-split (integerp n))
-                 (case-split (integerp i)))
-            (equal (bits (lnot x n) i j)
-                   (lnot (bits x (1- n) j)
-                         (- n j))))
-   :hints (("Goal"
-            :in-theory (e/d (bits) ())))
-   :rule-classes nil))
-
-(local
- (defthm lnot-of-irrational
-   (implies (not (rationalp x))
-            (equal (lnot x n) (lnot 0 n)))
-   :hints (("Goal" :in-theory (enable lnot)))))
-
-(local
- (defthm bits-lnot-aux-2-3
-   (implies (and (not (rationalp x))
-                 (not (< i n))
-                 (case-split (natp j))
-                 (case-split (integerp n))
-                 (case-split (integerp i)))
-            (equal (bits (lnot x n) i j)
-                   (lnot (bits x (1- n) j)
-                         (- n j))))
-   :hints (("Goal" :use ((:instance bits-lnot-aux-2-1
-                                    (x 0))
-                         (:instance bits-lnot-aux-2-2
-                                    (x 0)))))
-   :rule-classes nil))
-
-(local
- (defthm bits-lnot-aux-2
-   (implies (and (not (< i n))
-                 (case-split (natp j))
-                 (case-split (integerp n))
-                 (case-split (integerp i)))
-            (equal (bits (lnot x n) i j)
-                   (lnot (bits x (1- n) j)
-                         (- n j))))
-   :hints (("Goal" :use (bits-lnot-aux-2-1
-                         bits-lnot-aux-2-2
-                         bits-lnot-aux-2-3)))
-   :rule-classes nil))
-
-(defthmd bits-lnot
-  (implies (and (case-split (natp j))
-		(case-split (integerp n))
-		(case-split (integerp i)))
-	   (equal (bits (lnot x n) i j)
-                  (if (< i n)
-                      (lnot (bits x i j)
-                            (1+ (- i j)))
-                    (lnot (bits x (1- n) j)
-                          (- n j)))))
-  :hints (("Goal" :use ((:instance bits-lnot-aux (m n) (x (bits x (1- n) 0)))
-                        bits-lnot-aux-2)
-           :in-theory (e/d (bvecp) ()))))
diff -Nru acl2-6.2/books/rtl/rel5/support/lnot.lisp acl2-6.3/books/rtl/rel5/support/lnot.lisp
--- acl2-6.2/books/rtl/rel5/support/lnot.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lnot.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,246 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defun bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(local (include-book "lnot-proofs"))
-
-#| old definition:
-(defun LNOT (x n)
-  (1- (- (expt 2 n) x)))
-|#
-
-;used to be called COMP1
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-;note that this isn't a rewrite rule b/c we believe it will never need to be
-;BOZO make it one anyway?
-(defthm lnot-nonnegative-integer-type
-  (and (integerp (lnot x n))
-       (<= 0 (lnot x n)))
-  :rule-classes ((:type-prescription :typed-term (lnot x n))))
-
-;lnot-nonnegative-integer-type is strictly better, and we don't need both
-(in-theory (disable (:type-prescription lnot))) 
-
-(defthm lnot-natp
-  (natp (lnot x n)))
-
-(defthm lnot-upper-bound
-  (< (lnot x n) (expt 2 n))
-  :rule-classes (:rewrite :linear)
-  )
-
-;why is bvecp enabled here?
-
-(defthm lnot-bvecp-simple
-  (bvecp (lnot x n) n))
-
-(defthm lnot-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lnot x n) k)))
-
-;perhaps conclude with bits of x and drop the bvecp hyp?
-(defthm lnot-lnot
-  (implies (and (case-split (natp n))
-                (case-split (bvecp x n))
-                )
-           (equal (lnot (lnot x n) n)
-                  x)))
-
-;reorient this rule?
-(defthmd lnot-times-2
-   (implies (and (case-split (natp x))
-                 (case-split (natp n))
-                 )
-            (equal (+ 1 (* 2 (lnot x n)))
-                   (lnot (* 2 x) (1+ n)))))
-
-(defthm lnot-x-0
-  (equal (lnot x 0) 0))
-
-;gen?
-;make a by-2 version?
-;change param name?
-;make a better rewrite rule
-;RHS isn't simplified!
-(defthmd lnot-fl-original
-  (implies (and (<= k n)
-                ;(bvecp x n)
-                (<= 0 k)
-                (integerp n) 
-                (integerp k)
-                )
-           (equal (fl (* (/ (expt 2 k)) (lnot x n)))
-                  (lnot (fl (/ x (expt 2 k))) (- n k)))))
-
-(defthmd lnot-fl
-  (implies (and (natp n)
-                (natp k))
-           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
-                  (lnot (fl (/ x (expt 2 k))) n))))
-
-;gen
-;add case-splits
-(defthmd mod-lnot
-  (implies (and (<= k n)
-                (natp k)
-                (integerp n)
-                )
-           (equal (mod (lnot x n) (expt 2 k))
-                  (lnot (mod x (expt 2 k)) k))))
-
-(defthm mod-lnot-by-2
-  (implies (and (< 0 n)
-                (integerp x) ;gen?
-                (integerp n)
-                )
-           (equal (mod (lnot x n) 2)
-                  (lnot (mod x 2) 1))))
-
-;disable?
-(defthm lnot-bits-1
-  (equal (lnot (bits x (1- n) 0) n)
-         (lnot x n)))
-
-(defthmd lnot-ignores-bits-2
-  (implies (and (integerp i)
-                (<= (1- n) i))
-           (equal (lnot (bits x i 0) n)
-                  (lnot x n))))
-
-(defthm bits-lnot
-  (implies (and (case-split (natp j))
-		(case-split (integerp n))
-		(case-split (integerp i)))
-	   (equal (bits (lnot x n) i j)
-                  (if (< i n)
-                      (lnot (bits x i j)
-                            (1+ (- i j)))
-                    (lnot (bits x (1- n) j)
-                          (- n j))))))
-
-;gen?
-(defthm bitn-lnot
-  (implies (and (case-split (natp k))
-                (case-split (natp n))
-                )
-           (equal (bitn (lnot x n) k)
-                  (if (< k n)
-                      (lnot (bitn x k) 1)
-                    0))))
-
-;do we still need this, given bitn-lnot?
-(defthm bitn-lnot-not-equal
-  (implies (and (< k n)
-                (integerp n)
-                (<= 0 n)
-                (integerp k)
-                (<= 0 k)
-                )
-           (not (= (bitn (lnot x n) k)
-                   (bitn x k))))
-  :rule-classes ())
-
-;could generalize these a lot (when lnot equals a constant, take the lnot of both sides)
-;drop bvecp hyp by wrapping bits around conclusion?
-(defthm lnot-bvecp-equal-0
-  (implies (case-split (bvecp x 1))
-           (equal (equal (lnot x 1) 0)
-                  (not (equal x 0)))))
-
-(defthm lnot-bvecp-equal-1
-  (implies (case-split (bvecp x 1))
-           (equal (equal (lnot x 1) 1)
-                  (equal x 0))))
-
-;consider enabling?
-(defthmd lnot-ignores-mod-special
-  (equal (lnot (mod x (expt 2 m)) m)
-         (lnot x m)))
-
-;consider enabling?
-(defthmd lnot-ignores-mod
-  (implies (and (<= m n)
-                (case-split (integerp n)))
-           (equal (lnot (mod x (expt 2 n)) m)
-                  (lnot x m))))
-
-(defthmd lnot-shift
-  (implies (and (case-split (integerp x))
-                (case-split (natp n))
-                (natp k))
-           (equal (lnot (* (expt 2 k) x) n)
-                  (if (<= k n)
-                      (+ (* (expt 2 k) (lnot x (- n k)))
-                         (1- (expt 2 k)))
-                    (1- (expt 2 n)))))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-;consider enabling?
-(defthmd lnot-shift-2
-  (implies (and (syntaxp (not (quotep x))) ;prevents loops
-                (case-split (integerp x))
-                (case-split (< 0 n))
-                (case-split (integerp n))
-                )
-           (equal (lnot (* 2 x) n)
-                  (+ 1 (* 2 (lnot x (1- n))))))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-;disable?
-;BOZO rename the other lnot-fl.  this one should be called lnot-fl.
-(defthm lnot-fl-eric
-  (equal (lnot (fl x) n)
-         (lnot x n)))
-
-(defthm lnot-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (lnot x n)
-                  0)))
-
-(defthm lnot-with-n-not-positive
-  (implies (<= n 0)
-           (equal (lnot x n)
-                  0)))
diff -Nru acl2-6.2/books/rtl/rel5/support/log-equal.lisp acl2-6.3/books/rtl/rel5/support/log-equal.lisp
--- acl2-6.2/books/rtl/rel5/support/log-equal.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/log-equal.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,12 +0,0 @@
-(in-package "ACL2")
-
-;Did we say we'd keep log= enabled?  Will this cause lots of splitting on ifs?
-
-(defund log= (x y)
-  (declare (xargs :guard t))
-  (if (equal x y) 1 0))
-
-;or did we say we'd keep log= disabled?
-(defthm log=-same
-  (equal (log= x x) 1)
-  :hints (("Goal" :in-theory (enable log=))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/log-proofs.lisp acl2-6.3/books/rtl/rel5/support/log-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/log-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/log-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1282 +0,0 @@
-;;;**************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-(in-package "ACL2")
-
-;BOZO make log-proofs.lisp
-
-(include-book "ground-zero")
-
-(local (include-book "../arithmetic/top"))
-(local (include-book "lognot"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "lnot"))
-(local (include-book "logior"))
-(local (include-book "logand"))
-(local (include-book "logxor"))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-
-
-;rename! mod-lognot-by-2
-(defthm mod-logior-9
-  (implies (integerp i)
-           (iff (= (mod (lognot i) 2) 0)
-                (not (= (mod i 2) 0))))
-  :hints (("Goal" :in-theory (enable mod-by-2)
-           )))
-
-
-
-(defthm mod-logior-10
-  (implies (and (integerp i)
-                (integerp j))
-           (iff (and (= (mod i 2) 0) (= (mod j 2) 0))
-                (= (mod (logior i j) 2) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use mod-logior-by-2
-           :in-theory (set-difference-theories
-                       (enable mod-by-2)
-                       '(logior)))))
-;move
-(local
- (defun log-induct-3 (x y z)
-   (if (and (integerp x) (>= x 0)
-            (integerp y) (>= y 0)
-            (integerp z) (>= z 0))
-       (if (or (= x 0) (= y 0) (= z 0))
-           ()
-         (log-induct-3 (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
-     ())))
-
-
-
-(local
- (defthm logior-logand-1
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp z) (>= z 0))
-            (equal (logior (mod x 2)
-                           (logand  (mod y 2) (mod z 2)))
-                   (logand (logior (mod x 2) (mod y 2))
-                           (logior (mod x 2) (mod z 2)))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance mod012 (m x))
-                         (:instance mod012 (m y))
-                         (:instance mod012 (m z)))))))
-
-(local (defthm logior-logand-2
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0))
-            (equal (logand (logior (mod x 2) (mod y 2)) (mod x 2))
-                   (mod x 2)))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance mod012 (m x))
-                         (:instance mod012 (m y)))))))
-
-;nice lemma?
-(local
- (defthm logior-logand-3
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0))
-            (= (logand (logior x y) x)
-               x))
-   :rule-classes ()
-   :hints (("Goal" :induct (log-induct x y))
-           ("Subgoal *1/2" :use ((:instance logior-logand-2)
-                                 (:instance fl-mod-equal
-                                            
-                                            (y (logand (logior x y) x))))))))
-;BOZO export!
-;gen?
-(defthm logior-logand
-  (implies (and (integerp x)
-                (<= 0 x)
-                (integerp y)
-                (<= 0 y)
-                (integerp z)
-                (<= 0 z))
-           (equal (logior x (logand y z))
-                  (logand (logior x y) (logior x z))))
-  :rule-classes ()
-  :hints (("Goal" :induct (log-induct-3 x y z))
-	  ("Subgoal *1/2" :use ((:instance logior-logand-1)
-                                (:instance fl-mod-equal
-                                           (x (logior x (logand y z)))
-                                           (y (logand (logior x y) (logior x z))))))
-	  ("Subgoal *1/1" :use ((:instance logior-logand-3)
-				(:instance logior-logand-3 (y z))))))
-
-;BOZO export!
-(defthm logior-logand-alt
-  (implies (and (integerp x)
-                (<= 0 x)
-                (integerp y)
-                (<= 0 y)
-                (integerp z)
-                (<= 0 z))
-           (equal (logior (logand y z) x)
-                  (logand (logior x y) (logior x z))))
-  :hints (("Goal" :use ( logior-logand)))
-  :rule-classes ())
-
-
-
-(local
- (defthm logand-logior-1
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp z) (>= z 0))
-            (equal (logand (mod x 2)
-                           (logior  (mod y 2) (mod z 2)))
-                   (logior (logand (mod x 2) (mod y 2))
-                           (logand (mod x 2) (mod z 2)))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance mod012 (m x))
-                         (:instance mod012 (m y))
-                         (:instance mod012 (m z)))))))
-
-(defthm LOGAND-LOGIOR
-  (implies (and (integerp x) (<= 0 x)
-                (integerp y) (<= 0 y)
-                (integerp z) (<= 0 z))
-           (equal (logand x (logior y z))
-                  (logior (logand x y) (logand x z))))
-  :rule-classes ()
-  :hints (("Goal" :induct (log-induct-3 x y z))
-	  ("Subgoal *1/2" :use ((:instance logand-logior-1)
-                                (:instance fl-mod-equal
-                                           (x (logand x (logior y z)))
-                                           (y (logior (logand x y) (logand x z))))))))
-(defthm logand-logior-alt
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp z) (>= z 0))
-           (equal (logand (logior y z) x)
-                  (logior (logand y x) (logand z x))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance logand-logior)))))
-
-
-
-;I should be able to prove mod-logand without appealing to logior!
-;Rather, I should try to prove mod-logior from mod-logand.
-
-;not about logand!
-(local
- (defthm mod-logand-1
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0))
-            (= x (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
-                         (mod x (expt 2 n)))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance quot-mod (m x) (n (expt 2 n)))
-                         (:instance or-dist-b (x (fl (/ x (expt 2 n)))) (y (mod x (expt 2 n)))) ;yuck!
-                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-                         )))))
-
-(local
- (defthm mod-logand-2
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (>= n 0))
-            (= (logand x y)
-               (logior (logand (* (expt 2 n) (fl (/ x (expt 2 n))))
-                               y)
-                       (logand (mod x (expt 2 n))
-                               y))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance mod-logand-1)
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-                         (:instance logand-logior 
-                                    (x y)
-                                    (y (* (expt 2 n) (fl (/ x (expt 2 n)))))
-                                    (z (mod x (expt 2 n))))
-                         )))))
-
-(local
- (defthm mod-logand-3
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0))
-	     (= (logand x y)
-		(logior (* (expt 2 n) 
-			   (logand (fl (/ x (expt 2 n)))
-				   (fl (/ y (expt 2 n)))))
-			(logand (mod x (expt 2 n))
-				y))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance mod-logand-2)
-			(:instance and-dist-b (x (fl (/ x (expt 2 n))))))))))
-
-(local
- (defthm mod-logand-4
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (>= n 0))
-            (= (logand x y)
-               (+ (* (expt 2 n) 
-                     (logand (fl (/ x (expt 2 n)))
-                             (fl (/ y (expt 2 n)))))
-                  (logand (mod x (expt 2 n))
-                          y))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance mod-logand-3)
-                         (:instance or-dist-b
-                                    (x (logand (fl (/ x (expt 2 n)))
-                                               (fl (/ y (expt 2 n)))))
-                                    (y (logand (mod x (expt 2 n))
-                                               y)))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))			
-                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
-                         (:instance logand-bnd (x (mod x (expt 2 n))))
-                         )))))
-
-(defthm mod-logand-aux
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp n) (>= n 0))
-           (= (mod (logand x y) (expt 2 n))
-              (logand (mod x (expt 2 n)) y)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance mod-logand-4)
-			(:instance mod-mult-eric
-				   (x (logand (mod x (expt 2 n)) y)) 
-				   (y (expt 2 n))
-				   (a (logand (fl (/ x (expt 2 n))) (fl (/ y (expt 2 n))))))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))			
-			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
-			(:instance logand-bnd (x (mod x (expt 2 n))))
-			(:instance mod-does-nothing (m (logand (mod x (expt 2 n)) y)) (n (expt 2 n)))))))
-
-;generalize (mod y (expt 2 n)) to anything < 2^n?
-(defthm and-dist-d
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0)
-		  (< x (expt 2 n)))
-	     (= (logand x y)
-		(logand x (mod y (expt 2 n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance mod-logand-aux (x y) (y x))
-;			(:instance and-dist-a)
-			(:instance mod-does-nothing (m (logand x y)) (n (expt 2 n)))))))
-
-;compare to mod-logand-aux
-;looks like we can wrap the mod around x or y or both (same for bits of logand?)
-(defthm mod-logand
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp n) (>= n 0))
-           (equal (mod (logand x y) (expt 2 n))
-                  (logand (mod x (expt 2 n)) (mod y (expt 2 n)))))
-  :hints (("goal" :use (mod-logand-aux
-			(:instance and-dist-d (x (mod x (expt 2 n))))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-			(:instance mod-bnd-1 (m x) (n (expt 2 n)))))))
-
-(encapsulate
- ()
-
- (local (defthm bits-logand-1
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (bits (logand x y) i 0)
-                           (logand (+ (* (expt 2 j) (bits x i j))
-                                      (bits x (1- j) 0))
-                                   (+ (* (expt 2 j) (bits y i j))
-                                      (bits y (1- j) 0)))))
-               :rule-classes ()
-               :hints (("Goal" :in-theory (enable bits
-                                                  )
-                        :use ((:instance mod-logand (n (1+ i)))
-                              (:instance expt-split (r 2) (i 1) (j i))
-                              (:instance bits-plus-bits (n i) (p j) (m 0))
-                              (:instance bits-plus-bits (x y) (n i) (p j) (m 0)))))))
-
- (local (defthm bits-logand-2
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (bits (logand x y) i 0)
-                           (logand (logior (* (expt 2 j) (bits x i j))
-                                           (bits x (1- j) 0))
-                                   (logior (* (expt 2 j) (bits y i j))
-                                           (bits y (1- j) 0)))))
-               :rule-classes ()
-               :hints (("Goal" :use (bits-logand-1
-                     ;                       (:instance bits< (i (1- j)) (j 0))
-                     ;                      (:instance bits< (x y) (i (1- j)) (j 0))
-                                     (:instance or-dist-b (x (bits x i j)) (n j) (y (bits x (1- j) 0)))
-                                     (:instance or-dist-b (x (bits y i j)) (n j) (y (bits y (1- j) 0))))))))
-
- (local (defthm bits-logand-3
-               (implies (and (integerp a) (>= a 0)
-                             (integerp b) (>= b 0)
-                             (integerp c) (>= c 0)
-                             (integerp d) (>= d 0))
-                        (= (logand (logior a b) (logior c d))
-                           (logior (logior (logand a c) (logand c b))
-                                   (logior (logand b d) (logand a d)))))
-               :rule-classes ()
-               :hints (("Goal" :use ((:instance logand-logior (x (logior a b)) (y c) (z d))
-                                     (:instance logand-logior-alt (y a) (z b) (x c))
-                                     (:instance logand-logior-alt (y a) (z b) (x d))
-
-                     ;			(:instance bit-basic-d (x (logand a d)) (y (logand b d)))
-                                     )))))
-
- (local (defthm bits-logand-4
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (bits (logand x y) i 0)
-                           (logior (logior (logand (* (expt 2 j) (bits x i j))
-                                                   (* (expt 2 j) (bits y i j)))
-                                           (logand (* (expt 2 j) (bits y i j))
-                                                   (bits x (1- j) 0)))					
-                                   (logior (logand (bits x (1- j) 0)
-                                                   (bits y (1- j) 0))
-                                           (logand (* (expt 2 j) (bits x i j))
-                                                   (bits y (1- j) 0))))))
-				
-               :rule-classes ()
-               :hints (("Goal" :use (bits-logand-2
-                     ;                 (:instance expt-pos (x j))
-                                     (:instance bits-logand-3
-                                                (a (* (expt 2 j) (bits x i j)))
-                                                (b (bits x (1- j) 0))
-                                                (c (* (expt 2 j) (bits y i j)))
-                                                (d (bits y (1- j) 0))))))))
-
- (local (defthm bits-logand-5
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (logand (* (expt 2 j) (bits x i j))
-                                   (* (expt 2 j) (bits y i j)))
-                           (* (expt 2 j) (logand (bits x i j) (bits y i j)))))				
-               :rule-classes ()
-               :hints (("Goal" :use (
-                     ;                 (:instance expt-pos (x j))
-                                     (:instance and-dist-b (n j) (x (bits x i j)) (y (* (expt 2 j) (bits y i j)))))))))
-
-
-
- (local (defthm bits-logand-7
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (logand (* (expt 2 j) (bits x i j))
-                                   (bits y (1- j) 0))
-                           0))
-               :rule-classes ()
-               :hints (("Goal" :in-theory (enable logand)
-                        :use (
-;                              bits-logand-6
-                              (:instance fl-unique (x (/ (bits y (1- j) 0) (expt 2 j))) (n 0))
-                     ;                 (:instance expt-pos (x j))
-                     ;                (:instance expt-pos (x (- 1 j)))
-                     ;                 (:instance bits< (x y) (i (1- j)) (j 0))
-                     ;                 (:instance bit-basic-a (x (bits x i j)))
-                              (:instance and-dist-b (n j) (x (bits x i j)) (y (bits y (1- j) 0))))))))
-
- (local (defthm bits-logand-8
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (bits (logand x y) i 0)
-                           (logior (logior (* (expt 2 j) (logand (bits x i j) (bits y i j)))
-                                           0)
-                                   (logior (logand (bits x (1- j) 0)
-                                                   (bits y (1- j) 0))
-                                           0))))				
-               :rule-classes ()
-               :hints (("Goal" :use (bits-logand-4
-                                     bits-logand-5
-                                     bits-logand-7
-                                     (:instance bits-logand-7 (x y) (y x)))))))
-
- (local (defthm bits-logand-9
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (bits (logand x y) i 0)
-                           (logior (* (expt 2 j) (logand (bits x i j) (bits y i j)))
-                                   (logand (bits x (1- j) 0)
-                                           (bits y (1- j) 0)))))
-               :rule-classes ()
-               :hints (("Goal" :use (bits-logand-8
-                     ;			(:instance bit-basic-b (x (* (expt 2 j) (logand (bits x i j) (bits y i j)))))
-                     ;			(:instance bit-basic-b (x (logand (bits x (1- j) 0) (bits y (1- j) 0))))
-                                     )))))
-
- (local (defthm bits-logand-10
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (bits (logand x y) i 0)
-                           (logior (* (expt 2 j) (logand (bits x i j) (bits y i j)))
-                                   (bits (logand x y) (1- j) 0))))
-               :rule-classes ()
-               :hints (("Goal" :in-theory (enable 
-                                           bits
-                                           )
-                        :use (bits-logand-9
-                              (:instance mod-logand (n j)))))))
-
- (local (defthm bits-logand-11
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (bits (logand x y) i 0)
-                           (+ (* (expt 2 j) (logand (bits x i j) (bits y i j)))
-                              (bits (logand x y) (1- j) 0))))
-               :rule-classes ()
-               :hints (("Goal" :use (bits-logand-10
-
-                     ;                 (:instance bits< (x (logand x y)) (i (1- j)) (j 0))
-                                     ;yuck!
-                                     (:instance or-dist-b
-                                                (x (logand (bits x i j) (bits y i j)))
-                                                (y (bits (logand x y) (1- j) 0))
-                                                (n j)))))))
-
- (local (defthm bits-logand-12
-               (implies (and (integerp x) (>= x 0)
-                             (integerp y) (>= y 0)
-                             (integerp i) (>= i j)
-                             (integerp j) (> j 0))
-                        (= (bits (logand x y) i 0)
-                           (+ (* (expt 2 j) (bits (logand x y) i j))
-                              (bits (logand x y) (1- j) 0))))
-               :rule-classes ()
-               :hints (("Goal" :use (
-                                     (:instance bits-plus-bits (x (logand x y)) (n i) (p j) (m 0)))))))
-
- (defthm bits-logand
-   (implies (and     ;(<= i j)
-             (case-split (natp x)) ;drop?
-             (case-split (natp y)) ;drop?
-             (case-split (natp i))
-             (case-split (natp j))
-             )
-            (equal (bits (logand x y) i j)
-                   (logand (bits x i j) (bits y i j))))
-   :hints (("Goal" :in-theory (set-difference-theories
-                               (enable bits)
-                               '(CANCEL_TIMES-EQUAL-CORRECT))
-            :use (bits-logand-11
-                  bits-logand-12
-                  (:instance cancel-equal-*
-                             (a (expt 2 j))
-                             (r (logand (bits x i j) (bits y i j)))
-                             (s (bits (logand x y) i j)))
-
-                  (:instance mod-logand (n (1+ i)))
-                  ))))
- )
-
-
-
-;prove from bits-logand?
-(defthm bitn-logand
-  (implies (and (integerp x) ; (>= x 0)
-                (integerp y) ; (>= y 0)
-                (integerp n) (>= n 0)
-                )
-           (equal (bitn (logand x y) n)
-                  (logand (bitn x n) (bitn y n))))
-  :hints (("goal" :induct (op-dist-induct x y n))
-	  ("subgoal *1/1" :use ( ;(:instance mod)
-				(:instance bitn-rec-0)
-				(:instance bitn-rec-0 (x y))
-				(:instance bitn-rec-0 (x (logand x y)))))
-	  ("subgoal *1/2" :use ((:instance bitn-rec-pos (n n))
-				(:instance bitn-rec-pos (n n) (x y))
-				(:instance bitn-rec-pos (n n) (x (logand x y)))
-;				(:instance logand-fl)
-                                ))))
-
-(local (defthm bits-logior-1
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp i) (>= i j)
-		  (integerp j) (> j 0))
-	     (= (bits (logior x y) i 0)
-		(logior (+ (* (expt 2 j) (bits x i j))
-			   (bits x (1- j) 0))
-			(+ (* (expt 2 j) (bits y i j))
-			   (bits y (1- j) 0)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits
-                                     )
-		  :use ((:instance mod-logior (n (1+ i)))
-			(:instance expt-split (r 2) (i 1) (j i))
-			(:instance bits-plus-bits (n i) (p j) (m 0))
-			(:instance bits-plus-bits (x y) (n i) (p j) (m 0)))))))
-
-(local (defthm bits-logior-2
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp i) (>= i j)
-		  (integerp j) (> j 0))
-	     (= (bits (logior x y) i 0)
-		(logior (logior (* (expt 2 j) (bits x i j))
-				(bits x (1- j) 0))
-			(logior (* (expt 2 j) (bits y i j))
-				(bits y (1- j) 0)))))
-  :rule-classes ()
-  :hints (("Goal"
-           :use (bits-logior-1
-;                 (:instance bits< (i (1- j)) (j 0))
-;                 (:instance bits< (x y) (i (1- j)) (j 0))
-                 (:instance or-dist-b (x (bits x i j)) (n j) (y (bits x (1- j) 0)))
-                 (:instance or-dist-b (x (bits y i j)) (n j) (y (bits y (1- j) 0))))))))
-
-(local (defthm bits-logior-4
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp i) (>= i j)
-		  (integerp j) (> j 0))
-	     (= (bits (logior x y) i 0)
-		(logior (logior (* (expt 2 j) (bits x i j))
-				(* (expt 2 j) (bits y i j)))
-			(logior (bits x (1- j) 0)
-				(bits y (1- j) 0)))))
-  :rule-classes ()
-  :hints (("Goal"
-           :use (bits-logior-2
-;                 (:instance expt-pos (x j))
-)))))
-
-(local (defthm bits-logior-5
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp i) (>= i j)
-		  (integerp j) (> j 0))
-	     (= (bits (logior x y) i 0)
-		(logior (* (expt 2 j) (logior (bits x i j) (bits y i j)))
-			(bits (logior x y) (1- j) 0))))
-    :otf-flg t
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits mod-logior 
-                                     )
-           :use (bits-logior-4
-                 (:instance or-dist-c (n j) (x (bits x i j)) (y (bits y i j))))))))
-
-(local (defthm bits-logior-6
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp i) (>= i j)
-		  (integerp j) (> j 0))
-	     (= (bits (logior x y) i 0)
-		(+ (* (expt 2 j) (logior (bits x i j) (bits y i j)))
-		   (bits (logior x y) (1- j) 0))))
-  :rule-classes ()
-  :hints (("Goal"
-           :use (bits-logior-5
-;                 (:instance bits< (x (logior x y)) (i (1- j)) (j 0))
-                 (:instance or-dist-b
-                            (x (logior (bits x i j) (bits y i j)))
-                            (y (bits (logior x y) (1- j) 0))
-                            (n j)))))))
-
-(local (defthm bits-logior-7
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp i) (>= i j)
-		  (integerp j) (> j 0))
-	     (= (bits (logior x y) i 0)
-		(+ (* (expt 2 j) (bits (logior x y) i j))
-		   (bits (logior x y) (1- j) 0))))
-  :rule-classes ()
-  :hints (("Goal" :use (
-			(:instance bits-plus-bits (x (logior x y)) (n i) (p j) (m 0)))))))
-
-(defthm bits-logior
-    (implies (and ;(>= i j)
-                  (case-split (natp x))
-                  (case-split (natp y))
-                  (case-split (natp i))
-                  (case-split (natp j))
-                  )
-	     (equal (bits (logior x y) i j)
-		    (logior (bits x i j) (bits y i j))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bits ;natp
-                                     )
-                              '(;COLLECT-CONSTANTS-IN-<-OF-SUMS
-;                                a4 a9
-                                CANCEL_TIMES-EQUAL-CORRECT ;unfortunate
-                                CANCEL-COMMON-FACTORS-IN-EQUAL ;unfortunate
-                                ;INTEGER-TIGHTEN-BOUND
-                                ))
-		  :use (bits-logior-6
-			bits-logior-7
-			(:instance cancel-equal-*
-				   (a (expt 2 j))
-				   (r (logior (bits x i j) (bits y i j)))
-				   (s (bits (logior x y) i j)))
-			(:instance mod-logior (n (1+ i)))
-;			(:instance expt-pos (x j))
-                        ))))
-
-;someday prove from bits-logior (will have to generalize bits-logior?)?
-(defthm bitn-logior
-    (implies (and (integerp x)
-		  (integerp y)
-		  (integerp n)
-                  (>= n 0))
-	     (equal (bitn (logior x y) n)
-                    (logior (bitn x n) (bitn y n))))
-  :hints (("goal" :induct (op-dist-induct x y n))
-	  ("subgoal *1/1" :use (;(:instance logior-mod)
-				(:instance bitn-rec-0)
-				(:instance bitn-rec-0 (x y))
-				(:instance bitn-rec-0 (x (logior x y)))))
-	  ("subgoal *1/2" :use ((:instance bitn-rec-pos (n n))
-				(:instance bitn-rec-pos (n n) (x y))
-				(:instance bitn-rec-pos (n n) (x (logior x y)))
-				;(:instance logior-fl)
-                                ))))
-
-(defthm and-bits-a
-    (implies (and (integerp x) (>= x 0)
-		  (integerp k) (>= k 0))
-	     (= (logand x (expt 2 k))
-		(* (expt 2 k) (bitn x k))))
-  :rule-classes ()
-  :hints (("goal"  :in-theory (enable expt)
-           :induct (or-dist-induct x k))
-	  ("subgoal *1/1" :use ((:instance logand-def (i x) (j 1))
-				(:instance mod012 (m x))
-				(:instance bitn-rec-0)))
-	  ("subgoal *1/2" :use ((:instance logand-def (i x) (j (expt 2 k)))
-				(:instance mod-2*i (i (expt 2 (1- k))))
-				(:instance fl-int (x (expt 2 (1- k))))
-				(:instance bitn-rec-pos (n k))))))
-
-(defthm and-bits-b
-  (implies (and (integerp x) (>= x 0)
-                (integerp k) (>= k 0))
-           (= (logior x (expt 2 k))
-              (+ x
-                 (* (expt 2 k) 
-                    (- 1 (bitn x k))))))
-  :rule-classes ()
-  :hints (("goal"  :in-theory (enable expt) :induct (or-dist-induct x k))
-	  ("subgoal *1/1" :use ((:instance logior-def (i x) (j 1))
-				(:instance mod012 (m x))
-				(:instance quot-mod (m x) (n 2))
-				(:instance bitn-rec-0)))
-	  ("subgoal *1/2" :use ((:instance logior-def (i x) (j (expt 2 k)))
-				(:instance mod-2*i (i (expt 2 (1- k))))
-				(:instance quot-mod (m x) (n 2))
-				(:instance fl-int (x (expt 2 (1- k))))
-				(:instance bitn-rec-pos (n k))))))
-
-;move?
-(local
- (defthm fl-2**n-1/2
-    (implies (and (integerp n) (> n 0))
-	     (= (fl (/ (1- (expt 2 n)) 2))
-		(1- (expt 2 (1- n)))))
-    :hints (("Goal" :in-theory (enable expt)))
-  :rule-classes ()))
-
-;move?
-(local
- (defthm mod-2**n-1/2
-   (implies (and (integerp n) (> n 0))
-            (= (mod (1- (expt 2 n)) 2)
-               1))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable expt) 
-            :use ((:instance mod-2*i+1 (i (1- (expt 2 (1- n)))))
-                  (:instance mod012 (m (1- (expt 2 n)))))))))
-
-(local
- (defthm logand-slice-<-0
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (> n 0)
-                 (< x (expt 2 n)))
-            (= (logand x (- (expt 2 n) 1))
-               (bits x (1- n) 0)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable logand-ones)
-            :use (;(:instance logand-slice-<-0-1)
-                  (:instance mod-does-nothing (m x) (n (expt 2 n))))))))
-
-(local
- (defthm logand-slice-<-pos-1
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0)
-                 (< x (expt 2 n))
-                 (integerp k) (> k 0)
-                 (< k n))
-            (= (logand x (- (expt 2 n) (expt 2 k)))
-               (* 2 (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k)))))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable expt) 
-            :use ((:instance logand-def (i x) (j (- (expt 2 n) (expt 2 k))))
-                  (:instance expt-weak-monotone (n k) (m n))
-                  (:instance mod-2*i (i (- (expt 2 (1- n)) (expt 2 (1- k))))))))))
-
-(local
-(defthm logand-slice-<-pos-2
-    (implies (and (integerp x) (>= x 0)
-		  (integerp n) (>= n 0)
-		  (< x (expt 2 n))
-		  (integerp k) (> k 0)
-		  (< k n)
-		  (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
-		     (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
-	     (= (logand x (- (expt 2 n) (expt 2 k)))
-		(* (expt 2 k) (bits (fl (/ x 2)) (- n 2) (1- k)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt)
-           :use ((:instance logand-slice-<-pos-1))))))
-
-(local
- (defthm logand-slice-<-pos-3
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0)
-                 (< x (expt 2 n))
-                 (integerp k) (> k 0)
-                 (< k n)
-                 (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
-                    (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
-            (= (logand x (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (fl (/ (mod (fl (/ x 2)) (expt 2 (1- n))) (expt 2 (1- k)))))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (e/d ( bits) (bits-fl)) ;BOZO why?
-            :use ((:instance logand-slice-<-pos-2))))))
-
-;Looping rules in this lemma led to a discussion on the acl2-help list about looping rules (due to subterms
-;not be simplified).
-(local
- (defthm logand-slice-<-pos-4
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0)
-                 (< x (expt 2 n)))
-            (= (mod (fl (* 1/2 x)) (expt 2 (1- n)))
-               (fl (* 1/2 x))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance mod-does-nothing (m (fl (/ x 2))) (n (expt 2 (1- n))))
-                         (:instance fl-def-linear (x (/ x 2))))
-            :in-theory (set-difference-theories
-                        (enable expt)
-                        '( ;mod-equal
-                          mod-does-nothing
-                           mod-upper-bound-2
-                           mod-upper-bound-linear
-                           mod-non-negative-linear
-                           mod-bnd-1
-;                           mod-bnd-2
-                           mod-bnd-3
-                           ))))))
-
-(local
- (defthm logand-slice-<-pos-5
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0)
-                 (< x (expt 2 n))
-                 (integerp k) (> k 0)
-                 (< k n)
-                 (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
-                    (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
-            (= (logand x (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (fl (/ (fl (/ x 2)) (expt 2 (1- k)))))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance logand-slice-<-pos-3)
-                         (:instance logand-slice-<-pos-4))))))
-
-(local
- (defthm logand-slice-<-pos-6
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0)
-                 (< x (expt 2 n))
-                 (integerp k) (> k 0)
-                 (< k n)
-                 (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
-                    (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
-            (= (logand x (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (fl (/ x (expt 2 k))))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable expt)
-            :use ((:instance logand-slice-<-pos-5)
-                  (:instance fl/int-rewrite (x (/ x 2)) (n (expt 2 (1- k)))))))))
-
-(local
-(defthm logand-slice-<-pos-7
-    (implies (and (integerp x) (>= x 0)
-		  (integerp n) (>= n 0)
-		  (< x (expt 2 n))
-		  (integerp k) (> k 0)
-		  (< k n))
-	     (= (fl (/ x (expt 2 k)))
-		(bits x (1- n) k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits)
-           :use ((:instance mod-does-nothing (m x) (n (expt 2 n))))))))
-
-(local
-(defthm logand-slice-<-pos
-    (implies (and (integerp x) (>= x 0)
-		  (integerp n) (>= n 0)
-		  (< x (expt 2 n))
-		  (integerp k) (> k 0)
-		  (< k n)
-		  (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
-		     (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
-	     (= (logand x (- (expt 2 n) (expt 2 k)))
-		(* (expt 2 k) (bits x (1- n) k))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance logand-slice-<-pos-6)
-			(:instance logand-slice-<-pos-7))))))
-
-;move?
-(local
- (defun and-bits-induct (x n k)
-   (if (and (integerp k) (>= k 0))
-       (if (= k 0)
-           (list x n k)
-         (and-bits-induct (fl (/ x 2)) (1- n) (1- k)))
-     ())))
-
-(local
- (defthm logand-slice-<
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0)
-                 (< x (expt 2 n))
-                 (integerp k) (>= k 0)
-                 (< k n))
-            (= (logand x (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (bits x (1- n) k))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable expt)
-            :induct (and-bits-induct x n k))
-           ("Subgoal *1/1" :use ((:instance logand-slice-<-0)))
-           ("Subgoal *1/2" :use ((:instance logand-slice-<-pos))))))
-
-(local
- (defthm logand-slice-1
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (< k n))
-            (= (logand x (- (expt 2 n) (expt 2 k)))
-               (logand (mod x (expt 2 n)) (- (expt 2 n) (expt 2 k)))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance and-dist-d (x (- (expt 2 n) (expt 2 k))) (y x))
-                         (:instance expt-weak-monotone (n k) (m n))
-                         )))))
-
-(local
- (defthm logand-slice-2
-   (implies (and (integerp x) (>= x 0)
-                 (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (< k n))
-            (= (logand x (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (bits (mod x (expt 2 n)) (1- n) k))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance logand-slice-1)
-                         (:instance logand-slice-< (x (mod x (expt 2 n))))
-                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-                         )))))
-
-(defthm logand-slice
-  (implies (and (integerp x) (>= x 0)
-                (integerp n) (>= n 0)
-                (integerp k) (>= k 0)
-                (< k n))
-           (= (logand x (- (expt 2 n) (expt 2 k)))
-              (* (expt 2 k) (bits x (1- n) k))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable bits) ;yuck?
-           :use ((:instance logand-slice-2)))))
-
-
-
-;move these to logxor.lisp?
-(encapsulate
- ()
- (local (defthm logxor-rewrite-1
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
-                              (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))
-                      (logior (logand (fl (/ x 2)) (fl (/ (lnot y n) 2)))
-                              (logand (fl (/ y 2)) (fl (/ (lnot x n) 2))))))
-          :rule-classes ()
-          :hints (("Goal" :in-theory (e/d (bvecp) ( lnot))
-                   :use ((:instance lnot-fl-original (k 1))
-                         (:instance lnot-fl-original (k 1) (x y)))))))
-
- (local (defthm logxor-rewrite-2
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (logior (logand (fl (/ x 2)) (fl (/ (lnot y n) 2)))
-                              (logand (fl (/ y 2)) (fl (/ (lnot x n) 2))))
-                      (logior (fl (/ (logand x (lnot y n)) 2))
-                              (fl (/ (logand y (lnot x n)) 2)))))
-          :rule-classes ()
-          :hints (("Goal" :in-theory (disable ;logand-fl-rewrite
-                                      lnot)
-                   :use ( ;(:instance logand-fl (y (lnot y n)))
-;(:instance logand-fl (x y) (y (lnot x n)))
-                         )))))
-
- (local (defthm logxor-rewrite-3
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
-                              (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))
-                      (logior (fl (/ (logand x (lnot y n)) 2))
-                              (fl (/ (logand y (lnot x n)) 2)))))
-          :rule-classes ()
-          :hints (("Goal" :use ((:instance logxor-rewrite-1)
-                                (:instance logxor-rewrite-2))))))
-
- (local (defthm logxor-rewrite-4
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (logior (fl (/ (logand x (lnot y n)) 2))
-                              (fl (/ (logand y (lnot x n)) 2)))
-                      (fl (/ (logior (logand x (lnot y n))
-                                     (logand y (lnot x n)))
-                             2))))
-          :rule-classes ()
-          :hints (("Goal" :use ( ;(:instance logior-fl 
-;                        (i (logand x (lnot y n)))
-;                       (j (logand y (lnot x n))))
-                                )))))
-
- (local (defthm logxor-rewrite-5
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
-                              (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))
-                      (fl (/ (logior (logand x (lnot y n))
-                                     (logand y (lnot x n)))
-                             2))))
-          :rule-classes ()
-          :hints (("Goal" :use ((:instance logxor-rewrite-3)
-                                (:instance logxor-rewrite-4))))))
-
- (local (defthm logxor-rewrite-6
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n))
-                        (= (logxor (fl (/ x 2)) (fl (/ y 2)))
-                           (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
-                                   (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))))
-                   (= (fl (/ (logxor x y) 2))
-                      (fl (/ (logior (logand x (lnot y n))
-                                     (logand y (lnot x n)))
-                             2))))
-          :rule-classes ()
-          :hints (("Goal" :use ((:instance logxor-rewrite-5)
-                                (:instance fl-logxor-by-2 (i x) (j y)))))))
-
-
-
- (local (defthm logxor-rewrite-8
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (mod (logxor x y) 2)
-                      (logior (logand (mod x 2) (lnot (mod y 2) 1))
-                              (logand (mod y 2) (lnot (mod x 2) 1)))))
-          :rule-classes ()
-          :hints (("Goal" ;:in-theory (disable logxor)
-                   :use ( ;(:instance logxor-mod (i x) (j y))
-                         (:instance mod012 (m x))
-                         (:instance mod012 (m y)))))))
-
- (local (defthm logxor-rewrite-9
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (mod (logxor x y) 2)
-                      (logior (logand (mod x 2) (mod (lnot y n) 2))
-                              (logand (mod y 2) (mod (lnot x n) 2)))))
-          :rule-classes ()
-          :hints (("Goal" :in-theory (disable lnot logxor)
-                   :use ((:instance logxor-rewrite-8)
-                         )))))
-
- (local (defthm logxor-rewrite-10
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (mod (logxor x y) 2)
-                      (logior (mod (logand x (lnot y n)) 2)
-                              (mod (logand y (lnot x n)) 2))))
-          :rule-classes ()
-          :hints (("Goal" ;:in-theory (disable logxor)
-                   :use ((:instance logxor-rewrite-9)
-                         )))))
-
- (local (defthm logxor-rewrite-11
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n)))
-                   (= (mod (logxor x y) 2)
-                      (mod (logior (logand x (lnot y n))
-                                   (logand y (lnot x n)))
-                           2)))
-          :rule-classes ()
-          :hints (("Goal" ;:in-theory (disable logxor)
-                   :use ((:instance logxor-rewrite-10))))))
-
- (local (defthm logxor-rewrite-12
-          (implies (and (integerp n) (> n 1)
-                        (integerp x) (>= x 0) (< x (expt 2 n))
-                        (integerp y) (>= y 0) (< y (expt 2 n))
-                        (= (logxor (fl (/ x 2)) (fl (/ y 2)))
-                           (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
-                                   (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))))
-                   (= (logxor x y)
-                      (logior (logand x (lnot y n))
-                              (logand y (lnot x n)))))
-          :rule-classes ()
-          :hints (("Goal" ;:in-theory (disable logxor)
-                   :use ((:instance logxor-rewrite-6)
-                         (:instance logxor-rewrite-11)
-                         (:instance quot-mod
-                                    (m (logxor x y))
-                                    (n 2))
-;			(:instance logxor-nat (i x) (j y))
-                         (:instance quot-mod
-                                    (m (logior (logand x (lnot y n))
-                                               (logand y (lnot x n))))
-                                    (n 2)))))))
-
-
-;move?
- (local
-  (defun logxor-induct (x y n)
-    (if (and (integerp n) (>= n 1))
-        (if (= n 1)
-            (list x y)
-          (logxor-induct (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-      ())))
-
- (local (defthm x01
-          (implies (and (integerp x)
-                        (>= x 0)
-                        (< x 2))
-                   (or (= x 0) (= x 1)))
-          :rule-classes ()))
-
-;move to logxor.lisp?
-;it seems gross that this series uses lnot...
- (defthmd LOGXOR-REWRITE
-   (implies (and (< x (expt 2 n))
-                 (< y (expt 2 n))
-                 (integerp n) (>= n 1) ;gen?
-                 (integerp x) (>= x 0)
-                 (integerp y) (>= y 0))
-            (= (logxor x y)
-               (logior (logand x (lnot y n))
-                       (logand y (lnot x n)))))
-   :hints (("Goal" :in-theory (disable lnot logxor)
-            :induct (logxor-induct x y n))
-           ("Subgoal *1/2" :in-theory (set-difference-theories
-                                       (enable expt-split)
-                                       '(a15))
-            :use (logxor-rewrite-12))
-           ("Subgoal *1/1" :in-theory (enable lnot)
-            :use ((:instance x01)
-                  (:instance x01 (x y))
-                  (:instance lnot-fl-original (x 0) (k 1))))))
- )
-
-;n is a free var
-(defthmd logxor-rewrite-2
-    ;; ! Do we really want to get rid of logxor?
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-                  (natp n)
-		  (not (= n 0)))
-	     (equal (logxor x y)
-		    (logior (logand x (lnot y n))
-			    (logand y (lnot x n)))))
-    :rule-classes ((:rewrite :match-free :all))
-    :hints (("Goal" :in-theory (enable bvecp)
-             :use (logxor-rewrite))))
-
-
-(defthm bitn-logxor
-  (implies (and (case-split (integerp x))
-                (case-split (integerp y))
-                (case-split (integerp n))
-                (case-split (>= n 0))
-                )
-           (equal (bitn (logxor x y) n)
-                  (logxor (bitn x n) (bitn y n))))
-  :hints (("Goal" :induct (op-dist-induct x y n))
-	  ("Subgoal *1/1" :use ( ;(:instance logxor-mod (i x) (j y))
-				(:instance bitn-rec-0)
-				(:instance bitn-rec-0 (x y))
-				(:instance bitn-rec-0 (x (logxor x y)))))
-	  ("Subgoal *1/2" :use ((:instance bitn-rec-pos (n n))
-				(:instance bitn-rec-pos (n n) (x y))
-				(:instance bitn-rec-pos (n n) (x (logxor x y)))
-                                ))))
-
-
-
-
-
-(encapsulate
- ()
-
- (local (defthm bits-logxor-1
-               (implies (and (integerp x) (>= x 0) (< x (expt 2 n))
-                             (integerp y) (>= y 0) (< y (expt 2 n))
-                             (integerp n) (>= n i)
-                             (integerp i) (>= i j)
-                             (integerp j) (>= j 0)
-                             )
-                        (= (bits (logxor x y) i j)
-                           (logior (logand (bits x i j) (bits (lnot y n) i j))
-                                   (logand (bits y i j) (bits (lnot x n) i j)))))
-               :rule-classes ()
-               :hints (("Goal" :in-theory (disable lnot-bvecp lnot bvecp)
-                        :use (logxor-rewrite
-                              lnot-bvecp
-                              (:instance lnot-bvecp (x y))
-                              (:instance bits-logior (x (logand x (lnot y n))) (y (logand y (lnot x n))))
-
-                              (:instance bits-logand (y (lnot y n)))
-                              (:instance bits-logand (x y) (y (lnot x n))))))))
-
- (local (defthm bits-logxor-2
-               (implies (and (integerp x) (>= x 0) (< x (expt 2 n))
-                             (integerp y) (>= y 0) (< y (expt 2 n))
-                             (integerp n) (> n i)
-                             (integerp i) (>= i j)
-                             (integerp j) (>= j 0))
-                        (= (bits (logxor x y) i j)
-                           (logior (logand (bits x i j) (lnot (bits y i j) (1+ (- i j))))
-                                   (logand (bits y i j) (lnot (bits x i j) (1+ (- i j)))))))
-               :rule-classes ()
-               :hints (("Goal" :in-theory (set-difference-theories
-                                           (enable bvecp)
-                                           '(lnot-bvecp lnot))
-                        :use (bits-logxor-1
-                              (:instance bits-lnot (n n))
-                              (:instance bits-lnot (x y) (n n)))))))
-
-
- (local (defthm bits-logxor-aux
-          (implies (and (bvecp x n) ; Free variable n is bound here
-                        (bvecp y n)
-                        (natp n)
-                        (natp i)
-                        (natp j)
-                        (> n i)
-                        (>= i j))
-                   (equal (bits (logxor x y) i j)
-                          (logxor (bits x i j) (bits y i j))))
-          :rule-classes nil
-          :hints (("Goal" :in-theory (e/d (bvecp) ( lnot-bvecp lnot))
-                   :use (bits-logxor-2
-                         (:instance logxor-rewrite (x (bits x i j)) (y (bits y i j)) (n (1+ (- i j))))
-;                         (:instance bits<)
- ;                        (:instance bits< (x y))
-                         )))))
-
-;a nice fact?  make into a better lemma?
- (local (defthm hack1
-               (implies (natp x)
-                        (> (expt 2 x) x))
-
-               :rule-classes ()))
-
- (defthm bits-logxor
-   (implies (and (case-split (natp x))
-                 (case-split (natp y))
-                 (case-split (natp i))
-                 (case-split (natp j))
-                 ;(>= i j)
-                 )
-            (equal (bits (logxor x y) i j)
-                   (logxor (bits x i j) (bits y i j))))
-   :hints (("Goal" :in-theory (set-difference-theories
-                               (enable bvecp natp expt-split)
-                               '())
-            :use ((:instance hack1 (x (+ i x y)))
-                  (:instance bits-logxor-aux (n (+ i x y)))))))
- )
-
diff -Nru acl2-6.2/books/rtl/rel5/support/log.lisp acl2-6.3/books/rtl/rel5/support/log.lisp
--- acl2-6.2/books/rtl/rel5/support/log.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/log.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,257 +0,0 @@
-;;;**************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-(in-package "ACL2")
-
-;This book includes theorems mixing the logical operators (logand, etc.) with bits and bitn.
-
-(include-book "ground-zero")
-
-(local (include-book "log-proofs"))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(include-book "lnot")
-(include-book "logand")
-(include-book "logior")
-(include-book "logxor")
-
-;move!
-;rename! mod-lognot-by-2
-(defthm mod-logior-9
-  (implies (integerp i)
-           (iff (= (mod (lognot i) 2) 0)
-                (not (= (mod i 2) 0)))))
-
-;move!
-(defthm mod-logior-10
-  (implies (and (integerp i)
-                (integerp j))
-           (iff (and (= (mod i 2) 0) (= (mod j 2) 0))
-                (= (mod (logior i j) 2) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use mod-logior-by-2
-           :in-theory (set-difference-theories
-                       (enable mod-by-2)
-                       '(logior)))))
-
-;BOZO export!
-;gen?
-(defthm logior-logand
-  (implies (and (integerp x)
-                (<= 0 x)
-                (integerp y)
-                (<= 0 y)
-                (integerp z)
-                (<= 0 z))
-           (equal (logior x (logand y z))
-                  (logand (logior x y) (logior x z))))
-  :rule-classes ())
-
-;BOZO export!
-(defthm logior-logand-alt
-  (implies (and (integerp x)
-                (<= 0 x)
-                (integerp y)
-                (<= 0 y)
-                (integerp z)
-                (<= 0 z))
-           (equal (logior (logand y z) x)
-                  (logand (logior x y) (logior x z))))
-  :rule-classes ())
-
-(defthm logand-logior
-  (implies (and (integerp x) (<= 0 x)
-                (integerp y) (<= 0 y)
-                (integerp z) (<= 0 z))
-           (equal (logand x (logior y z))
-                  (logior (logand x y) (logand x z))))
-  :rule-classes ())
-
-(defthm logand-logior-alt
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp z) (>= z 0))
-           (equal (logand (logior y z) x)
-                  (logior (logand y x) (logand z x))))
-  :rule-classes ())
-
-(defthm mod-logand-aux
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp n) (>= n 0))
-           (= (mod (logand x y) (expt 2 n))
-              (logand (mod x (expt 2 n)) y)))
-  :rule-classes ())
-
-;generalize (mod y (expt 2 n)) to anything < 2^n?
-(defthm and-dist-d
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0)
-		  (< x (expt 2 n)))
-	     (= (logand x y)
-		(logand x (mod y (expt 2 n)))))
-  :rule-classes ())
-
-;compare to mod-logand-aux
-;we can wrap the mod around x or y or both (same for bits of logand?)
-(defthm mod-logand
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp n) (>= n 0))
-           (equal (mod (logand x y) (expt 2 n))
-                  (logand (mod x (expt 2 n)) (mod y (expt 2 n))))))
-
-;prove that we can wrap the bits around either arg in the conclusion or both...
-;will have to shift if we don't wrap bits??
-(defthm bits-logand
-   (implies (and     ;(<= i j)
-             (case-split (natp x)) ;drop?
-             (case-split (natp y)) ;drop?
-             (case-split (natp i))
-             (case-split (natp j))
-             )
-            (equal (bits (logand x y) i j)
-                   (logand (bits x i j) (bits y i j)))))
-
-(defthm bitn-logand
-  (implies (and (integerp x) ; (>= x 0)
-                (integerp y) ; (>= y 0)
-                (integerp n) (>= n 0)
-                )
-           (equal (bitn (logand x y) n)
-                  (logand (bitn x n) (bitn y n)))))
-
-(defthm bits-logior
-    (implies (and ;(>= i j)
-                  (case-split (natp x))
-                  (case-split (natp y))
-                  (case-split (natp i))
-                  (case-split (natp j))
-                  )
-	     (equal (bits (logior x y) i j)
-		    (logior (bits x i j) (bits y i j)))))
-
-;someday prove from bits-logior (will have to generalize bits-logior?)?
-(defthm bitn-logior
-    (implies (and (integerp x)
-		  (integerp y)
-		  (integerp n)
-                  (>= n 0))
-	     (equal (bitn (logior x y) n)
-                    (logior (bitn x n) (bitn y n)))))
-
-;give better name, perhaps "logand-with-power2" ?
-(defthm and-bits-a
-    (implies (and (integerp x) (>= x 0)
-		  (integerp k) (>= k 0))
-	     (= (logand x (expt 2 k))
-		(* (expt 2 k) (bitn x k))))
-  :rule-classes ())
-
-(defthm and-bits-b
-  (implies (and (integerp x) (>= x 0)
-                (integerp k) (>= k 0))
-           (= (logior x (expt 2 k))
-              (+ x
-                 (* (expt 2 k) 
-                    (- 1 (bitn x k))))))
-  :rule-classes ())
-
-(defthm logand-slice
-  (implies (and (integerp x) (>= x 0)
-                (integerp n) (>= n 0)
-                (integerp k) (>= k 0)
-                (< k n))
-           (= (logand x (- (expt 2 n) (expt 2 k)))
-              (* (expt 2 k) (bits x (1- n) k))))
-  :rule-classes ())
-
-;move to logxor.lisp?
-(defthmd logxor-rewrite
-   (implies (and (< x (expt 2 n))
-                 (< y (expt 2 n))
-                 (integerp n) (>= n 1) ;gen?
-                 (integerp x) (>= x 0)
-                 (integerp y) (>= y 0))
-            (= (logxor x y)
-               (logior (logand x (lnot y n))
-                       (logand y (lnot x n))))))
-
-;n is a free var
-(defthmd logxor-rewrite-2
-    ;; ! Do we really want to get rid of logxor?
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-                  (natp n)
-		  (not (= n 0)))
-	     (equal (logxor x y)
-		    (logior (logand x (lnot y n))
-			    (logand y (lnot x n)))))
-    :rule-classes ((:rewrite :match-free :all)))
-
-(defthm bitn-logxor
-  (implies (and (case-split (integerp x))
-                (case-split (integerp y))
-                (case-split (integerp n))
-                (case-split (>= n 0))
-                )
-           (equal (bitn (logxor x y) n)
-                  (logxor (bitn x n) (bitn y n)))))
-
-
-
-(defthm bits-logxor
-  (implies (and (case-split (natp x))
-                (case-split (natp y))
-                (case-split (natp i))
-                (case-split (natp j))
-;(>= i j)
-                )
-           (equal (bits (logxor x y) i j)
-                  (logxor (bits x i j) (bits y i j))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bvecp natp expt-split)
-                              '())
-           :use ((:instance hack1 (x (+ i x y)))
-                 (:instance bits-logxor-aux (n (+ i x y)))))))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/logand-proofs.lisp acl2-6.3/books/rtl/rel5/support/logand-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/logand-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logand-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,647 +0,0 @@
-(in-package "ACL2")
-
-;make some of these local?
-(include-book "ground-zero")
-(include-book "../arithmetic/fl")
-(include-book "../arithmetic/induct")
-(local (include-book "lognot"))
-(local (include-book "../arithmetic/top"))
-
-;(in-theory (disable binary-logand))
-
-(defthm logand-with-zero
-  (equal (logand 0 j) 0)
-  :hints (("Goal" :in-theory (enable logand))))
-
-(defthm logand-with-non-integer-arg
-  (implies (or (not (integerp i))
-               (not (integerp j)))
-           (equal (logand i j)
-                  0))
-  :hints (("Goal" :in-theory (enable logand))))
-
-
-
-;Normalize logand terms
-
-
-(defthm logand-commutative
-  (equal (logand j i)
-         (logand i j))
-  :hints (("Goal" :in-theory (enable logand))))
-
-(encapsulate
- ()
- (local (defthm logand-associative-helper
-          (implies (and (case-split (integerp i))
-                        (case-split (integerp j))
-                        (case-split (integerp k))
-                        )
-                   (equal (logand (logand i j) k)
-                          (logand i (logand j k))))
-          :hints (("Goal" :in-theory (enable logand evenp)
-                   :induct (logand-three-args-induct i j k)))))
-
- (defthm logand-associative
-   (equal (logand (logand i j) k)
-          (logand i (logand j k)))))
-
-(defthm logand-commutative-2
-  (equal (logand j i k)
-         (logand i j k))
-  :hints (("Goal" :in-theory (disable LOGAND-ASSOCIATIVE
-                                      logand-commutative)
-           :use (LOGAND-ASSOCIATIVE
-                 logand-commutative
-                 (:instance LOGAND-ASSOCIATIVE (j i) (i j))))))
-
-(defthm logand-combine-constants
-  (implies (syntaxp (and (quotep i)
-                         (quotep j)))
-           (equal (logand i j k)
-                  (logand (logand i j) k))))
-
- 
-(defthm logand-with-minus-one
-   (implies (case-split (integerp i))
-            (equal (logand -1 i) i))
-  :hints (("Goal" :in-theory (enable logand))))
-
-;Didn't make this a rewrite rule to avoid backchaining on (integerp (logand i j)) -- should never happen, but
-;just in case.
-(defthm logand-non-negative-integer-type-prescription
-  (implies (or (<= 0 i)
-               (<= 0 j))
-           (and (<= 0 (logand i j))
-                (integerp (logand i j))))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logand))))
-
-(defthm logand-negative-integer-type-prescription
-  (implies (and (< i 0)
-                (< j 0)
-                (case-split (integerp i))
-                (case-split (integerp j)))
-           (and (< (logand i j) 0)
-                (integerp (logand i j))))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logand))))
-
-; rewrites (<= 0 (logand i j)) and (< (logand i j) 0)
-;could this perhaps not fire (say, during backchaining) because of case-splitting of the conclusion, causing
-;us to wish we had a simple rule that the rhs implies the lhs?
-;BOZO consider combining with logand-non-negative
-(defthm logand-negative-rewrite
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (< (logand i j) 0)
-                  (and (< i 0)
-                       (< j 0))))
-  :hints (("Goal" :in-theory (enable logand))))
-
-(defthm logand-non-negative
-  (implies (or (<= 0 x)
-               (<= 0 y)
-               )
-           (<= 0 (logand x y))))
-
-;This one is a loner.
-;There's no nice logand-positive rule.  Nor is there a clear rewrite for (< 0 (logand i j))
-;For logand to be positive, the arguments must have bits that overlap, and there's no way to state this.
-(defthm logand-non-positive-integer-type-prescription
-    (implies (and (<= i 0)
-                  (<= j 0))
-	     (and (<= (logand i j) 0)
-		  (integerp (logand i j))))
-  :hints (("Goal" :in-theory (enable logand)))
-  :rule-classes (:type-prescription))
-
-(defthm logand-non-positive-rewrite
-    (implies (and (<= i 0)
-                  (<= j 0))
-	     (<= (logand i j) 0))
-  :hints (("Goal" :in-theory (enable logand))))
-
-#| do we want this?
-(defthm logand-negative
-  (implies (and (< i 0)
-                (< j 0)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (integerp (logand i j))
-                (< (logand i j) 0)))
-  :hints (("Goal" :in-theory (enable logand)))
-  :rule-classes (:rewrite (:type-prescription)))
-|#
-
-;think about logand when the args differ in sign
-
-(defthm logand-self
-  (implies (case-split (integerp i))
-           (equal (logand i i) i))
-    :hints (("Goal" :in-theory (enable logand evenp))))
-
-(defthm logand-equal-minus-one
-  (equal (equal (logand i j) -1)
-         (and (equal i -1) (equal j -1)))
-  :hints (("goal" :in-theory (enable logand evenp))))
-
-(defthm logand-even
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (integerp (* 1/2 (logand i j)))
-                  (or (integerp (* 1/2 i))
-                      (integerp (* 1/2 j)))))
-  :hints (("goal" :in-theory (enable logand evenp))))
-
-(local (in-theory (enable evenp)))
-
-(defthm logand-0-when-one-arg-is-odd
-   (implies (and (not (integerp (* 1/2 j)))
-                 (case-split (integerp j))
-                 (case-split (integerp i))
-                 )
-            (and (equal (equal (logand i j) 0)
-                        (and (integerp (* 1/2 i))
-                             (equal (logand (fl (* 1/2 i)) (fl (* 1/2 j))) 0)))
-                 (equal (equal (logand j i) 0)
-                        (and (integerp (* 1/2 i))
-                             (equal (logand (fl (* 1/2 i)) (fl (* 1/2 j))) 0)))))
-   :hints (("goal" :in-theory (enable logand))))
-
-(defthm logand-simp-1
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (LOGAND (+ 1 (* 2 i))
-                          (+ 1 (* 2 j)))
-                  (+ 1 (* 2 (logand i j)))))
-  :hints (("Goal" :in-theory (enable logand))))
-
-(defthm logand-less-than-minus-one
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< (logand i j) -1)
-                  (or (and (<= i -1) (< j -1))
-                      (and (<= j -1) (< i -1))))))
-
-;simplify the conclusion?
-(defthm logand-negative-5
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< -1 (logand i j))
-                  (and (or (< -1 i)
-                           (< -1 j)
-                           (and (<= -1 j)
-                                (<= -1 i))
-                           )
-                       (or (not (equal i -1))
-                           (not (equal j -1))))))
-  :hints (("Goal" :cases ((equal j -1) (equal i -1))
-           :in-theory (enable logand))))
-
-
-
-;add to this
-;linear?
-;another rule for j?
-(defthm logand-upper-bound-1
-  (implies (<= 0 i)
-           (<= (logand i j) i))
-  :hints (("Goal" :in-theory (enable logand)
-           :induct ( LOG-INDUCT i j))))
-
-
-;phrase in terms of low bit being 0 or 1?
-;try disabled...
-(defthm LOGAND-with-1
-  (implies (case-split (integerp i))
-           (and (equal (logand 1 i)
-                       (if (evenp i)
-                           0
-                         1))
-                ))
-  :hints (("Goal" :in-theory (enable logand))))
-
-;move
-(defthm mod-x-2-rewrite
-  (implies (case-split (integerp x))
-           (equal (mod x 2)
-                  (if (INTEGERP (* 1/2 X))
-                      0
-                    1)))
-  :hints (("Goal" :in-theory (enable mod))))
-
-(defthmd logand-def
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (logand i j)
-              (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
-                 (logand (mod i 2) (mod j 2)))))
-  :rule-classes  ((:definition :controller-alist ((binary-logand t t))))
-  :hints (("goal" :in-theory (enable logand))))
-
-(defthm fl-logand-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (fl (* 1/2 (logand i j)))
-                  (logand (fl (* 1/2 i)) (fl (* 1/2 j)))))
-  :hints (("goal" :in-theory (disable logand fl)
-           :use ((:instance logand-def)))))
-
-(defthm floor-logand-by-2
-    (implies (and (case-split (integerp i))
-		  (case-split (integerp j)))
-	     (equal (floor (logand i j) 2)
-                    (logand (floor i 2) (floor j 2)))))
-
-
-(defthm mod-logand-by-2
-  (equal (mod (logand i j) 2)
-         (logand (mod i 2) (mod j 2)))
-  :hints (("Goal" :in-theory (enable logand mod))))
-
-(defthm logand-i-lognot-i
-  (implies (case-split (integerp i))
-           (equal (LOGAND i (LOGNOT i))
-                  0))
-  :hints (("Goal" :in-theory (enable logand)
-           :induct (LOG-INDUCT i (LOGNOT i)))))
-
-
-
-(defthm logand-special-value
-  (implies (case-split (integerp j))
-           (EQUAL (equal (LOGAND 1 j) j)
-                  (or (equal j 0) (equal j 1))))
-  :hints (("Goal" :in-theory (enable logand)))
-)
-
-(defun or-dist-induct (y n)
-  (if (and (integerp n) (>= n 0))
-      (if (= n 0)
-	  y
-	(or-dist-induct (fl (/ y 2)) (1- n)))
-    ()))
-
-
-(encapsulate 
- ()
- (local (defthm logand-2**n-1-aux
-  (implies (and (< i (expt 2 n))
-                (integerp n) ;drop this one
-                (<= 0 i)
-                (case-split (integerp i))
-                )
-           (equal (logand i (+ -1 (expt 2 n)))
-                  i))
-  :hints (("Goal" :in-theory (enable logand expt)
-           :induct (or-dist-induct i n)))))
-
- (defthmd logand-ones
-  (implies (and (< i (expt 2 n)) ;bozo drop and wrap bits around i? (will have to put that proof elsewhere?)
-                (<= 0 i)
-                (case-split (integerp i))
-                )
-           (equal (logand i (+ -1 (expt 2 n)))
-                  i))
-   :hints (("Goal" :cases ((integerp n)))))
-)
-
-
-(encapsulate 
- ()
- (local
-  (defthm and-dist-b-1
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (> n 0))
-	     (= (logand (* (expt 2 n) x) y)
-		(* 2 (logand (* (expt 2 (1- n)) x)
-			     (fl (/ y 2))))))
-    :rule-classes ()
-    :hints (("Goal" :in-theory (set-difference-theories (enable expt-split)
-                                                        '())
-             :use ((:instance logand-def (j y) (i (* (expt 2 n) x)))
-;			(:instance rem-2*i (i (* (expt 2 (1- n)) x)))
-                   )))))
-
- (local
-  (defthm and-dist-b-2
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (> n 0)
-		  (= (logand (* (expt 2 (1- n)) x) (fl (/ y 2))) 
-		     (* (expt 2 (1- n)) (logand x (fl (/ (fl (/ y 2)) (expt 2 (1- n))))))))
-	     (= (logand (* (expt 2 n) x) y)
-		(* 2 
-		   (* (expt 2 (1- n))
-		      (logand x
-			      (fl (/ (fl (/ y 2)) (expt 2 (1- n)))))))))
-    :rule-classes ()
-    :hints (("Goal" :use ((:instance and-dist-b-1))))))
-
- (local
-  (defthm and-dist-b-3
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (> n 0)
-		  (= (logand (* (expt 2 (1- n)) x) (fl (/ y 2))) 
-		     (* (expt 2 (1- n)) (logand x (fl (/ (fl (/ y 2)) (expt 2 (1- n))))))))
-	     (= (logand (* (expt 2 n) x) y)
-		(* 2 
-		   (* (expt 2 (1- n))
-		      (logand x
-			      (fl (/ y (expt 2 n))))))))
-    :rule-classes ()
-    :hints (("Goal"  :in-theory (set-difference-theories (enable expt-split)
-                                                         '())
-             :use ((:instance and-dist-b-2)
-                   (:instance fl/int-rewrite (x (/ y 2)) (n (expt 2 (1- n)))))))))
-
- (defthm AND-DIST-B
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (>= n 0))
-            (= (logand (* (expt 2 n) x) y)
-               (* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
-   :rule-classes ()
-   :hints (("Goal" :induct (or-dist-induct y n))
-           ("Subgoal *1/2" :use ((:instance and-dist-b-3))))))
-
-
-
-#|
-
-(local
-(defthm and-dist-c-1
-    (implies (and (integerp x) (>= x 0)
-		  (integerp n) (>= n 0))
-	     (= x (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
-			  (mod x (expt 2 n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance mod-fl-2 (x x) (y (expt 2 n)))
-			(:instance or-dist-b (x (fl (/ x (expt 2 n)))) (y (mod x (expt 2 n))))
-			(:instance mod<n (m x) (n (expt 2 n)))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-                        )))))
-
-(local
-(defthm and-dist-c-2
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0))
-	     (= (logand x y)
-		(logior (logand (* (expt 2 n) (fl (/ x (expt 2 n))))
-				y)
-			(logand (mod x (expt 2 n))
-				y))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance and-dist-c-1)
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-			(:instance bit-basic-h 
-				   (x y)
-				   (y (* (expt 2 n) (fl (/ x (expt 2 n)))))
-				   (z (mod x (expt 2 n))))
-			(:instance bit-basic-c (x (* (expt 2 n) (fl (/ x (expt 2 n))))))
-			(:instance bit-basic-c (x (mod x (expt 2 n))))
-			(:instance bit-basic-c
-				   (x (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
-					      (mod x (expt 2 n))))))))))
-
-(local
- (defthm and-dist-c-3
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0))
-	     (= (logand x y)
-		(logior (* (expt 2 n) 
-			   (logand (fl (/ x (expt 2 n)))
-				   (fl (/ y (expt 2 n)))))
-			(logand (mod x (expt 2 n))
-				y))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance and-dist-c-2)
-			(:instance and-dist-b (x (fl (/ x (expt 2 n))))))))))
-
-(local
-(defthm and-dist-c-4
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0))
-	     (= (logand x y)
-		(+ (* (expt 2 n) 
-		      (logand (fl (/ x (expt 2 n)))
-			      (fl (/ y (expt 2 n)))))
-		   (logand (mod x (expt 2 n))
-			   y))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance and-dist-c-3)
-			(:instance or-dist-b
-				   (x (logand (fl (/ x (expt 2 n)))
-					      (fl (/ y (expt 2 n)))))
-				   (y (logand (mod x (expt 2 n))
-					      y)))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))			
-			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
-			(:instance and-dist-a (x (mod x (expt 2 n)))))))))
-
-(defthm AND-DIST-C
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0))
-	     (= (mod (logand x y) (expt 2 n))
-		(logand (mod x (expt 2 n)) y)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance and-dist-c-4)
-;			(:instance mod+-thm 
-	;			   (m (logand (mod x (expt 2 n)) y)) 
-		;		   (n (expt 2 n))
-			;	   (a (logand (fl (/ x (expt 2 n))) (fl (/ y (expt 2 n))))))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))			
-			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
-			(:instance and-dist-a (x (mod x (expt 2 n))))
-			(:instance mod-does-nothing (m (logand (mod x (expt 2 n)) y))
-                                   (n (expt 2 n)))))))
-
-
-(defthm logand-def
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (logand i j)
-                  (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
-                     (logand (mod i 2) (mod j 2)))))
-  :rule-classes nil :hints
-  (("goal" :in-theory (enable logand))))
-
-(defun op-dist-induct-2 (i j n)
-  (if (and (integerp n) (>= n 0))
-      (if  (= n 0)
-	  (list i j)
-	(op-dist-induct (floor i 2) (floor j 2) (1- n)))
-    ()))
-
-(DEFTHM LOGAND-DEF-hack
-  (IMPLIES (AND (syntaxp (equal i 'x))
-                (CASE-SPLIT (INTEGERP I))
-                (CASE-SPLIT (INTEGERP J)))
-           (EQUAL (LOGAND I J)
-                  (+ (* 2
-                        (LOGAND (FL (* 1/2 I)) (FL (* 1/2 J))))
-                     (LOGAND (MOD I 2) (MOD J 2)))))
-
-)
-
-
-(DEFTHM LOGAND-DEF-hack-2
-  (IMPLIES (AND (syntaxp (equal i 'y))
-                (CASE-SPLIT (INTEGERP I))
-                (CASE-SPLIT (INTEGERP J)))
-           (EQUAL (LOGAND I J)
-                  (+ (* 2
-                        (LOGAND (FL (* 1/2 I)) (FL (* 1/2 J))))
-                     (LOGAND (MOD I 2) (MOD J 2)))))
-
-)
-
-
-(defthm AND-DIST-C
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0)
-;                  (< x (expt 2 n))
-)
-	     (= (mod (logand x y) (expt 2 n))
-		(logand (mod x (expt 2 n)) y)))
-  :rule-classes ()
-  :hints (
-          ("goal" :in-theory (enable logand-def expt-split)
-           :induct (op-dist-induct x y n))))
-
-  :hints (("Goal" :use ((:instance and-dist-c-4)
-;			(:instance mod+-thm 
-	;			   (m (logand (mod x (expt 2 n)) y)) 
-		;		   (n (expt 2 n))
-			;	   (a (logand (fl (/ x (expt 2 n))) (fl (/ y (expt 2 n))))))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))			
-			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
-			(:instance and-dist-a (x (mod x (expt 2 n))))
-			(:instance mod-does-nothing (m (logand (mod x (expt 2 n)) y))
-                                   (n (expt 2 n)))))))
-
-
-;(local (include-book "bitn"))
-
-
-;change name and param names eventually
-(defthm AND-BITS-A
-  (implies (and (integerp x); (>= x 0)
-                (integerp k); (>= k 0)
-                )
-           (equal (logand x (expt 2 k))
-                  (* (expt 2 k) (bitn x k))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories (enable expt-split bitn bits logand)
-                                                      '())
-           :induct (or-dist-induct x k))))
-
-(defthm LOGAND-def
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (logand i j)
-                  (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
-                     (logand (mod i 2) (mod j 2)))))
-  :hints (("Goal" :in-theory (enable logand))))
-|#
-
-(defthm logand-0 
-  (equal (logand 0 j) 0)
-  :hints (("goal" :in-theory (enable logand)))
-  )
-
-(defthm logand-even-2
-  (implies (and (integerp i)
-                (integerp j))
-           (equal (or (= (mod i 2) 0)
-                      (= (mod j 2) 0))
-                  (= (mod (logand i j) 2) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable mod-by-2))))
-
-
-
-#|
-
-
-;BOZO try!
-
-(defun op-dist-induct-special (i j n)
-  (if (and (integerp n) (>= n 0))
-      (if  (= n 0)
-	  (list i j)
-	(op-dist-induct-special (fl (/ i 2)) j n))
-    ()))
-
-(defun induct-fun (i)
-  (if (zp i)
-      nil
-    (induct-fun (fl (/ i 2)))))
-
-(defun op-dist-induct-negative (i j n)
-  (if (and (integerp n) (<= n 0))
-      (if (= n 0)
-	  (list i j)
-	(op-dist-induct-negative (fl (/ i 2)) (fl (/ j 2)) (1+ n)))
-    ()))
-  
-(defthm mod-logand-aux
-    (implies (and (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0))
-	     (= (mod (logand x y) (expt 2 n))
-		(logand (mod x (expt 2 n)) y)))
-    :otf-flg t
-  :rule-classes ()
-  :hints (("Goal" :do-not-induct t 
-           :do-not '(generalize)
-           :induct ( op-dist-induct x y n)
-           :expand (LOGAND Y (MOD X (EXPT 2 N)))
-           :in-theory (e/d (logand zip expt-split) (evenp)))))
-  )
-
-
-|#
-
-(defthm integer-tighten-bound
-  (implies (integerp x)
-           (equal (< -1 x)
-                  (<= 0 x))))
-
-;BOZO dup?
-(defthmd logand-rewrite
-  (implies (and (case-split (integerp x))
-                (case-split (integerp y))
-                )
-           (equal (logand x y)
-                  (+ (* 2 (logand (fl (/ x 2)) (fl (/ y 2))))
-                     (logand (mod x 2) (mod y 2)))))
-  :hints (("Goal" :in-theory (enable LOGAND-DEF)))
-  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
-
-
-(defthm logand-bnd
-   (implies (<= 0 x)
-            (<= (logand x y) x))
-   :rule-classes :linear
-   )
-
-(defthm logand-integer-type-prescription
-  (integerp (logand i j))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logand))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/logand.lisp acl2-6.3/books/rtl/rel5/support/logand.lisp
--- acl2-6.2/books/rtl/rel5/support/logand.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logand.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,359 +0,0 @@
-(in-package "ACL2")
-
-#|
-This book includes lemmas about LOGAND.  Note that LOGAND is a macro which expands to nested calls to
-BINARY-LOGAND. Both LOGAND and BINARY-LOGAND are built into ACL2.
-
-This book contains only results; all the proofs are done in the book logand-proofs.
-
-Todo:
- use set-invisible-fns-alist - or find a better way?
- rules for logand x with lognot x anywhere in there?
- should logand-with-0 be both sides? what about logand-with-minus-one
- how order rules for efficiency? perhaps make a separate documentation book?
- any other log lemmas?
- are the 4 enough for assoc comm functions? 
-
-|#
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ground-zero")
-(local (include-book "logand-proofs"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-;;
-;; Rules to normalize logand terms (recall that LOGAND is a macro for BINARY-LOGAND):
-;;
-
-(defthm logand-associative
-  (equal (logand (logand i j) k)
-         (logand i (logand j k))))
-
-(defthm logand-commutative
-  (equal (logand j i)
-         (logand i j)))
-
-(defthm logand-commutative-2
-  (equal (logand j i k)
-         (logand i j k)))
-
-(defthm logand-combine-constants
-  (implies (syntaxp (and (quotep i)
-                         (quotep j)))
-           (equal (logand i j k)
-                  (logand (logand i j) k))))
-
-
-;;
-;; LOGAND with special values
-;;
-
-(defthm logand-with-non-integer-arg
-  (implies (or (not (integerp i))
-               (not (integerp j)))
-           (equal (logand i j)
-                  0)))
-
-;0 should always be brought to the front of logand
-;should we have a rule with the second arg being 0?
-(defthm logand-with-zero
-  (equal (logand 0 j) 0))
-
-;-1 should always be brought to the front of logand
-;should we have both cases or not?
-(defthm logand-with-minus-one
-  (implies (case-split (integerp i))
-           (equal (logand -1 i) i)))
-
-
-
-;;
-;; Type facts
-;;
-
-;this goes through:
-;(thm (integerp (logand i j)))
-
-
-(defthm logand-integer-type-prescription
-  (integerp (logand i j))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logand))))
-
-
-
-;These three go together.
-
-;logand is negative iff either arg is negative
-
-;Didn't make this a rewrite rule to avoid backchaining on (integerp (logand i j)) -- should never happen, but
-;just in case.
-(defthm logand-non-negative-integer-type-prescription
-  (implies (or (<= 0 i)
-               (<= 0 j))
-           (and (<= 0 (logand i j))
-                (integerp (logand i j))))
-  :rule-classes (:type-prescription))
-
-(defthm logand-negative-integer-type-prescription
-  (implies (and (< i 0)
-                (< j 0)
-                (case-split (integerp i))
-                (case-split (integerp j)))
-           (and (< (logand i j) 0)
-                (integerp (logand i j))))
-  :rule-classes (:type-prescription))
-
-; rewrites (<= 0 (logand i j)) and (< (logand i j) 0)
-;could this perhaps not fire (say, during backchaining) because of case-splitting of the conclusion, causing
-;us to wish we had a simple rule that natp args imply logand is natp?
-;maybe don't want this one?
-(defthm logand-negative-rewrite
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (< (logand i j) 0)
-                  (and (< i 0)
-                       (< j 0)))))
-
-(defthm logand-non-negative
-  (implies (or (<= 0 x)
-               (<= 0 y)
-               )
-           (<= 0 (logand x y))))
-
-;There's no nice logand-positive rule.  Nor is there a clear rewrite for (< 0 (logand i j))
-;For logand to be positive, the arguments must have bits that overlap, and there's no way to state this.
-(defthm logand-non-positive-integer-type-prescription
-    (implies (and (<= i 0)
-                  (<= j 0))
-	     (and (<= (logand i j) 0)
-		  (integerp (logand i j))))
-  :rule-classes (:type-prescription))
-
-(defthm logand-non-positive-rewrite
-    (implies (and (<= i 0)
-                  (<= j 0))
-	     (<= (logand i j) 0)))
-
-#| do we want this?
-(defthm logand-negative
-  (implies (and (< i 0)
-                (< j 0)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (integerp (logand i j))
-                (< (logand i j) 0)))
-  :hints (("Goal" :in-theory (enable logand)))
-  :rule-classes (:rewrite (:type-prescription)))
-|#
-
-
-
-; If logand is less than -1, then both i and j are <= -1, and at least one of them is strictly < -1. 
-(defthm logand-less-than-minus-one
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< (logand i j) -1)
-                  (or (and (<= i -1) (< j -1))
-                      (and (<= j -1) (< i -1))))))
-
-;BOZO move!
-;perhaps put on a backchain limit?
-(defthm integer-tighten-bound
-  (implies (integerp x)
-           (equal (< -1 x)
-                  (<= 0 x))))
-#|
-;rewrite < -1 to <= 0?
-;simplify the conclusion?
-(defthm logand-negative-5
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< -1 (logand i j))
-                  (not (and (< i 0)
-                            (< j 0))))))
-
-:hints (("Goal" :cases ((equal j -1) (equal i -1))
-         :in-theory (enable logand))))
-
-|#
-
-
-
-(defthm logand-self
-  (implies (case-split (integerp i))
-           (equal (logand i i) i)))
-
-(defthm logand-equal-minus-one
-  (equal (EQUAL (LOGAND i j) -1)
-         (and (equal i -1)
-              (equal j -1))))
-
-(defthm logand-even
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (INTEGERP (* 1/2 (logand i j)))
-                  (or (INTEGERP (* 1/2 i))
-                      (INTEGERP (* 1/2 j))))))
-
-;weird?
-(defthm logand-0-when-one-arg-is-odd
-  (implies (and (not (integerp (* 1/2 j)))
-                (case-split (integerp j))
-                (case-split (integerp i))
-                )
-           (and (equal (equal (logand i j) 0)
-                       (and (integerp (* 1/2 i))
-                            (equal (logand (fl (* 1/2 i)) (fl (* 1/2 j))) 0)))
-                (equal (equal (logand j i) 0)
-                       (and (integerp (* 1/2 i))
-                            (equal (logand (fl (* 1/2 i)) (fl (* 1/2 j))) 0))))))
-
-(defthm logand-simp-1
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (LOGAND (+ 1 (* 2 i))
-                          (+ 1 (* 2 j)))
-                  (+ 1 (* 2 (logand i j))))))
-
-;add to this
-;make linear?
-(defthm logand-upper-bound-1
-  (implies (<= 0 i)
-           (<= (logand i j) i)))
-
-
-;BOZO same as  logand-upper-bound-1
-(defthm logand-bnd
-   (implies (<= 0 x)
-            (<= (logand x y) x))
-   :rule-classes :linear
-   )
-
-
-;trying disabled...
-(defthmd logand-with-1
-  (implies (case-split (integerp i))
-           (equal (logand 1 i)
-                  (if (evenp i)
-                      0
-                    1))))
-
-;trying disabled...
-;rename
-;BOZO make a nice rule for logand with 1?
-(defthmd logand-special-value
-  (implies (case-split (integerp j))
-           (equal (equal (logand 1 j) j)
-                  (or (equal j 0) (equal j 1)))))
-
-(defthmd logand-def
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (logand i j)
-              (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
-                 (logand (mod i 2) (mod j 2)))))
-  :rule-classes  ((:definition :controller-alist ((binary-logand t t)))))
-
-
-(defthm fl-logand-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (fl (* 1/2 (logand i j)))
-                  (logand (fl (* 1/2 i)) (fl (* 1/2 j))))))
-
-(defthm floor-logand-by-2
-    (implies (and (case-split (integerp i))
-		  (case-split (integerp j)))
-	     (equal (floor (logand i j) 2)
-                    (logand (floor i 2) (floor j 2)))))
-
-(defthm mod-logand-by-2
-  (equal (mod (logand i j) 2)
-         (logand (mod i 2) (mod j 2))))
-
-;allow them to occur in other orders (perhaps with intervening terms)?
-;think about this
-;make a version for logior
-(defthm logand-i-lognot-i
-  (implies (case-split (integerp i))
-           (equal (LOGAND i (LOGNOT i))
-                  0)))
-
-
-
-
-
-
-;make a nice recognizer?
-;handle negative case?
-;rename?
-(defthmd logand-ones
-  (implies (and (< i (expt 2 n)) ;drop and wrap bits around i?
-                (<= 0 i)
-                (case-split (integerp i))
-                )
-           (equal (logand i (1- (expt 2 n)))
-                  i)))
-
-#|
-
-;change name and param names eventually
-(defthm AND-BITS-A
-  (implies (and (integerp x); (>= x 0)
-                (integerp k); (>= k 0)
-                )
-           (equal (logand x (expt 2 k))
-                  (* (expt 2 k) (bitn x k))))
-  :rule-classes ())
-
-|#
-
-(defthm AND-DIST-B
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (>= n 0))
-            (= (logand (* (expt 2 n) x) y)
-               (* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
-   :rule-classes ())
-
-
-;BOZO also have logand-with-zero
-(defthm logand-0 
-  (equal (logand 0 j) 0))
-
-
-(defthmd logand-rewrite
-  (implies (and (case-split (integerp x))
-                (case-split (integerp y))
-                )
-           (equal (logand x y)
-                  (+ (* 2 (logand (fl (/ x 2)) (fl (/ y 2))))
-                     (logand (mod x 2) (mod y 2)))))
-  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
-
-(defthm logand-even-2
-  (implies (and (integerp i)
-                (integerp j))
-           (equal (or (= (mod i 2) 0)
-                      (= (mod j 2) 0))
-                  (= (mod (logand i j) 2) 0)))
-  :rule-classes ())
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/logeqv.lisp acl2-6.3/books/rtl/rel5/support/logeqv.lisp
--- acl2-6.2/books/rtl/rel5/support/logeqv.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logeqv.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,121 +0,0 @@
-(in-package "ACL2")
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ground-zero")
-(local (include-book "../arithmetic/top"))
-(local (include-book "logior"))
-(local (include-book "logand"))
-(local (include-book "logorc1"))
-(local (include-book "lognot"))
-
-
-(local (in-theory (enable logorc1))) ;remove
-
-;type?
-
-(defthm logeqv-bound
-  (implies (and (<= 0 i)
-                (<= 0 j))
-           (<= (logeqv i j) -1))
-  :hints (("goal" :in-theory (enable logeqv logior))))
-
-(defthm logeqv-with-zero
-  (equal (logeqv 0 i)
-         (lognot i))
-  :hints (("goal" :in-theory (enable lognot logeqv)))
-  )
-
-(defthm logeqv-commutative
-  (equal (logeqv i j)
-         (logeqv j i))
-  :hints (("goal" :in-theory (enable lognot logeqv)))
-  )
-
-(defthm logeqv-with-minus-1
-  (implies (case-split (integerp i))
-           (equal (logeqv -1 i)
-                  i))
-  :hints (("goal" :in-theory (enable logeqv))))
-
-(defthm logeqv-even
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (integerp (* 1/2 (logeqv i j)))
-                  (or (and (not (integerp (* 1/2 i)))
-                           (integerp (* 1/2 j)))
-                      (and (integerp (* 1/2 i))
-                           (not (integerp (* 1/2 j)))))))
-  :hints (("goal" :in-theory (enable logeqv))))
-
-
-(defthm logeqv-with-non-integer-arg
-  (implies (not (integerp i))
-           (and (equal (binary-logeqv i j)
-                       (lognot j))
-                (equal (binary-logeqv j i)
-                       (lognot j))))
-  :hints (("goal" :in-theory (enable binary-logeqv))))
-
-(defthm logeqv-self
-  (equal (logeqv x x) -1)
-  :hints (("goal" :in-theory (enable logeqv))))
-
-(defthm floor-logeqv-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (floor (logeqv i j) 2)
-                  (logeqv (floor i 2) (floor j 2))))
-  :hints (("goal" :in-theory (enable logeqv))))
-
-(defthm fl-logeqv-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (fl (* 1/2 (logeqv i j)))
-                  (logeqv (fl (* 1/2 i)) (fl (* 1/2 j)))))
-  :hints (("goal" :in-theory (enable logeqv))))
-
-;i'm not sure which way this rule should go but note that both parts of this rule rewrite to the same rhs
-(defthm lognot-logeqv
-  (and (equal (logeqv (lognot i) j)
-              (lognot (logeqv i j)))
-       (equal (logeqv j (lognot i))
-              (lognot (logeqv i j))))
-  :hints (("goal" :in-theory (enable logeqv logand logior logorc1 
-                                     evenp ;BOZO prove evenp-lognot and drop this
-                                     )
-           :induct (log-induct-allows-negatives i j))))
-
-
-
-#|
-
-
-(local(defthm logeqv-mod-1
-    (implies (and (integerp i) (>= i 0)
-		  (integerp j) (>= j 0))
-	     (iff (= (mod (logeqv i j) 2) 0)
-		  (or (= (mod (logorc1 i j) 2) 0)
-		      (= (mod (logorc1 j i) 2) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logorc1 logand)
-		  :use ((:instance logand-even (i (logorc1 i j)) (j (logorc1 j i))))))))
-
-(local(defthm logeqv-mod
-    (implies (and (integerp i) (>= i 0)
-		  (integerp j) (>= j 0))
-	     (iff (= (mod (logeqv i j) 2) 0)
-		  (not (= (logxor (mod i 2) (mod j 2))
-			  0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logorc1 logeqv)
-		  :use ((:instance logeqv-mod-1)
-			(:instance logorc1-mod)
-			(:instance logorc1-mod (i j) (j i))
-			(:instance mod012 (x i))
-			(:instance mod012 (x j)))))))
-|#
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/logior-proofs.lisp acl2-6.3/books/rtl/rel5/support/logior-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/logior-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logior-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,711 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(include-book "ground-zero")
-
-;the order of these matters (lognot should come late)
-(local (include-book "logand"))
-(local (include-book "lognot"))
-(local (include-book "../arithmetic/top")) ;try
-
-(local (in-theory (enable evenp)))
-
-;split?
-(defthm logior-with-non-integer-arg
-  (implies (not (integerp i))
-           (and (equal (logior i j)
-                       (ifix j))
-                (equal (logior j i)
-                       (ifix j))))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-0
-  (implies (case-split (integerp j))
-           (equal (logior 0 j)
-                  j))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-commutative
-  (equal (logior j i)
-         (logior i j))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-associative
-  (equal (logior (logior i j) k)
-         (logior i (logior j k)))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-commutative-2
-  (equal (logior j i k)
-         (logior i j k))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-combine-constants
-  (implies (syntaxp (and (quotep i)
-                         (quotep j)))
-           (equal (logior i j k)
-                  (logior (logior i j) k))))
-
-(defthm logior-with-an-arg-of-minus-one
-  (implies (case-split (integerp i))
-           (equal (logior -1 i) -1))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-non-negative-integerp-type
-  (and (implies (and (<= 0 i)
-                     (<= 0 j))
-                (and (integerp (logior i j))
-                     (<= 0 (logior i j)))))
-  :rule-classes ( :type-prescription)
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-non-negative
-  (and (implies (and (<= 0 i)
-                     (<= 0 j))
-                (<= 0 (logior i j)))))
-
-(defthm logior-equal-0
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (equal (logior i j) 0)
-                  (and (equal i 0) (equal j 0))))
-  :hints (("goal" :in-theory (enable logior))))
-
-(defthm logior-even
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (integerp (* 1/2 (logior i j)))
-                  (and (integerp (* 1/2 i))
-                       (integerp (* 1/2 j)))))
-  :hints (("goal" :in-theory (enable logior))))
-
-(defthm logior-negative-1
-  (implies (and (< i 0)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (integerp (logior i j))
-                (< (logior i j) 0)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-negative-2
-  (implies (and (< j 0)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (integerp (logior i j))
-                (< (logior i j) 0)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-negative-3
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< (logior i j) 0)
-                  (or (< i 0)
-                      (< j 0))))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-non-positive
-  (implies (and (<= i 0)
-                (<= j 0)
-                )
-           (<= (logior i j) 0))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-self
-  (implies (case-split (integerp i))
-           (equal (logior i i) i))
-    :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-simp-1
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (logior (* 2 i) (* 2 j))
-                  (* 2 (logior i j))))
-  :hints (("Goal" :in-theory (enable logior))))
-
-
-
-
-(defthm logior-positive
-  (implies (and (< 0 i)
-                (< 0 j)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (integerp (logior i j))
-                (< 0 (logior i j))))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-positive-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (< 0 (logior i j))
-                  (and (<= 0 i)
-                       (<= 0 j)
-                       (or (< 0 i)
-                           (< 0 j)))))
-  :hints (("Goal" :in-theory (enable logior))))
-  
-
-(defthm logior-negative-5
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< -1 (logior i j))
-                  (AND (< -1 I) (< -1 J))
-                  ))
-  :hints (("Goal" :cases ((equal j -1) (equal i -1))
-           :in-theory (enable logior))))
-
-(defthm logior-i-lognot-i
-  (implies (case-split (integerp i))
-           (equal (logior i (lognot i))
-                  -1))
-  :hints (("goal" :in-theory (enable logior)
-           :induct (log-induct i (lognot i)))))
-
-;move? odd...
-(defthm fl-expression-rewrites-to-last-bit
-  (implies (integerp i)
-           (equal (+ I (* -2 (FL (* 1/2 I))))
-                  (if (evenp i)
-                      0
-                    1))))
-
-(defthm fl-logior-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (fl (* 1/2 (logior i j)))
-                  (logior (fl (/ i 2)) (fl (/ j 2)))))
-  :hints (("goal" :in-theory (enable logior))))
-
-
-(defthm floor-logior-by-2
-    (implies (and (case-split (integerp i))
-		  (case-split (integerp j)))
-	     (equal (floor (logior i j) 2)
-                    (logior (floor i 2) (floor j 2)))))
-
-(defthm mod-logior-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (mod (logior i j) 2)
-                  (logior (mod i 2) (mod j 2))))
-  :hints (("goal" :in-theory (enable mod-by-2))))
-
-(defthmd logior-def
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (logior i j)
-                  (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
-                     (logior (mod i 2) (mod j 2)))))
-  :rule-classes ((:definition :controller-alist ((binary-logior t t))))
-  :hints (("goal"; :in-theory (enable  mod)
-           :use ((:instance mod-fl-2 (x (logior i j)) (y 2)))
-;           :use ((:instance mod (x i) (y j)))
-           )))
-
-
-
-
-
-
-(local (include-book "bvecp")) ;;try
-
-
-(local (defun ls-induct (k x)
-   (if (zp k)
-       x
-     (ls-induct (1- k) (fl (/ x 2))))))
-
-(local (defthm logior-ones-3-1
-     (implies (and (integerp k) (> k 0))
-              (= (fl (/ (1- (expt 2 k)) 2))
-                 (1- (expt 2 (1- k)))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (set-difference-theories
-                               (enable expt)
-                               '())
-           :use ((:instance fl-unique (x (/ (1- (expt 2 k)) 2)) (n (1- (expt 2 (1- k))))))))))
-
-(local (defthm logior-ones-3-2
-              (implies (and (integerp k) (> k 0))
-                       (= (mod (1- (expt 2 k)) 2) 1))
-              :rule-classes ()
-              :hints (("Goal" :in-theory (e/d (expt) (mod-2*i))
-                       :use ((:instance mod012 (m (1- (expt 2 k))))
-                             (:instance mod-mod-2-not-equal (m (1- (expt 2 k))))
-                             (:instance mod-2*i (i (expt 2 (1- k))))
-                             )))))
-
-(local (defthm logior-ones-3
-    (implies (and (integerp k) (>= k 0)
-		  (integerp x) (>= x 0) (< x (expt 2 k)))
-	     (= (logior (1- (expt 2 k)) x)
-		(1- (expt 2 k))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt mod-mult-of-n)
-           :induct (ls-induct k x))
-	  ("Subgoal *1/2" :use (logior-ones-3-1
-				logior-ones-3-2
-				(:instance mod012 (m x))
-				(:instance quot-mod (m x) (n 2))
-				(:instance quot-mod (m (logior (1- (expt 2 k)) x)) (n 2))
-;				(:instance natp-logior (i (1- (expt 2 k))) (j x))
-				(:instance fl-def-linear (x (/ x 2)))
-;				(:instance logior-fl-2 (i (1- (expt 2 k))) (j x))
-	;			(:instance logior-mod-2 (i (1- (expt 2 k))) (j x))
-                                )))))
-
-;make into a better form for rewriting?
-;gen to make conclusion the cat of the high bits of x (none if x is a bvecp) with a vector of ones?
-(defthm logior-ones
-    (implies (and (natp n) ;gen?
-		  (bvecp x n))
-	     (equal (logior x (1- (expt 2 n)))
-		    (1- (expt 2 n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable  bvecp)
-           :use ((:instance logior-ones-3 (k n))))))
-
-;rename
-(defthm logior-1-x
-    (implies (bvecp x 1)
-	     (equal (logior 1 x) 1))
-  :hints (("Goal" :use ((:instance logior-ones (n 1))))))
-
-
-(local (defthm or-dist-a-helper
-  (implies (and (< i (expt 2 n))
-                (< j (expt 2 n))
-                (integerp i)
-                (>= i 0)
-                )
-           (< (logior i j) (expt 2 n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable ;expt ;yuck
-                              expt-split
-                              )
-           :induct (op-dist-induct i j n))
-	  ("Subgoal *1/2" :use ((:instance logior-def)
-				(:instance mod012 (m i))
-				(:instance mod012 (m j))))
-          ("Subgoal *1/3" :use ((:instance logior-def)
-                                (:instance mod012 (m i))
-				(:instance mod012 (m j))
-                                )))))
-
-;n is a free var
-;rename
-;consider :linear?
-(defthm or-dist-a
-  (implies (and (< i (expt 2 n))
-                (< j (expt 2 n))
-                )
-           (< (logior i j) (expt 2 n)))
-  :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :use ( or-dist-a-helper))))
-
-(defthm logior-bvecp
-  (implies (and (bvecp x n)
-                (bvecp y n))
-           (bvecp (logior x y) n))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-
-
-
-;gen?
-;whoa.  this is a lower bound
-;unfortunate to have to disable those rules..
-(defthm logior-bnd
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp y)
-                (>= y 0))
-           (<= x (logior x y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d () (LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE
-                                      FL-<-INTEGER
-                                      FL->-INTEGER
-                                      FL-LOGIOR-BY-2
-                                      FL-OF-EVEN/2)
-                                  )
-           :induct (log-induct x y))
-	  ("Subgoal *1/2" :use ((:instance logior-def (i x) (j y))
-				(:instance quot-mod (m x) (n 2))
-				(:instance mod012 (m x))
-				(:instance mod012 (m y))
-                                ))))
-
-
-
-(local
-;gen
- (defthm or-dist-b-1
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0)
-                 (< y (expt 2 n)))
-            (= (logior (* (expt 2 n) x) y)
-               (+ (* 2 (logior (fl (* (expt 2 (1- n)) x))
-                               (fl (/ y 2))))
-                  (logior (mod (* (expt 2 n) x) 2)
-                          (mod y 2)))))
-   :rule-classes ()
-   :hints (("Goal"  :in-theory (enable expt-split)
-            :use ((:instance logior-def (i (* (expt 2 n) x)) (j y)))))))
-
-(local
- (defthm or-dist-b-2
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0)
-                 (< y (expt 2 n)))
-            (= (logior (* (expt 2 n) x) y)
-               (+ (* 2 (logior (* (expt 2 (1- n)) x)
-                               (fl (/ y 2))))
-                  (mod y 2))))
-   :rule-classes ()
-   :hints (("Goal"  :in-theory (enable expt) ;yuck
-            :use ((:instance or-dist-b-1)
-                  (:instance fl-int (x (* (expt 2 (1- n)) x)))
-                  (:instance mod-2*i (i (* (expt 2 (1- n)) x))))))))
-
-(local
- (defthm or-dist-b-3
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0)
-                 (< y (expt 2 n))
-                 (= (logior (* (expt 2 (1- n)) x)
-                            (fl (/ y 2)))
-                    (+ (* (expt 2 (1- n)) x)
-                       (fl (/ y 2)))))
-            (= (logior (* (expt 2 n) x) y)
-               (+ (* (expt 2 n) x)
-                  (* 2	(fl (/ y 2)))
-                  (mod y 2))))
-   :rule-classes ()
-   :hints (("Goal"  :in-theory (enable expt-split)
-            :use ((:instance or-dist-b-2))))))
-
-(local
- (defthm or-dist-b-4
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0)
-                 (< y (expt 2 n))
-                 (= (logior (* (expt 2 (1- n)) x)
-                            (fl (/ y 2)))
-                    (+ (* (expt 2 (1- n)) x)
-                       (fl (/ y 2)))))
-            (= (logior (* (expt 2 n) x) y)
-               (+ (* (expt 2 n) x) y)))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance or-dist-b-3)
-                         (:instance quot-mod (m y) (n 2)))))))
-
-;generalize to or of disjoint ranges?
-(defthm OR-DIST-B
-    (implies (and (< y (expt 2 n))
-                  (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0)
-		  )
-	     (= (logior (* (expt 2 n) x) y)
-		(+ (* (expt 2 n) x) y)))
-  :rule-classes ()
-  :hints (("Goal"  :in-theory (enable expt)
-           :induct (or-dist-induct y n))
-	  ("Subgoal *1/2" :use ((:instance or-dist-b-4)))))
-
-
-
-(local
- (defthm or-dist-c-1
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0))
-            (= (logior (* (expt 2 n) x)
-                       (* (expt 2 n) y))
-               (+ (* 2 (logior (* (expt 2 (1- n)) x)
-                               (* (expt 2 (1- n)) y)))
-                  (logior (mod (* (expt 2 n) x) 2)
-                          (mod (* (expt 2 n) y) 2)))))
-   :rule-classes ()
-   :hints (("Goal"  :in-theory (enable expt)
-            :use ((:instance logior-def (i (* (expt 2 n) x)) (j (* (expt 2 n) y))))))))
-
-(local
- (defthm or-dist-c-2
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0))
-            (= (logior (* (expt 2 n) x)
-                       (* (expt 2 n) y))
-               (* 2 (logior (* (expt 2 (1- n)) x)
-                            (* (expt 2 (1- n)) y)))))
-   :rule-classes ()
-   :hints (("Goal"  :in-theory (enable expt)
-            :use ((:instance or-dist-c-1)
-                  (:instance mod-2*i (i (* (expt 2 (1- n)) x)))
-                  (:instance mod-2*i (i (* (expt 2 (1- n)) y))))))))
-
-(local
- (defthm or-dist-c-3
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0)
-                 (= (logior (* (expt 2 (1- n)) x)
-                            (* (expt 2 (1- n)) y))
-                    (* (expt 2 (1- n)) (logior x y))))			     
-            (= (logior (* (expt 2 n) x)
-                       (* (expt 2 n) y))
-               (* (expt 2 n)
-                  (logior x y))))
-   :rule-classes ()
-   :hints (("Goal"  :in-theory (enable expt)
-            :use ((:instance or-dist-c-2))))))
-
-;BOZO rename!
-(defthm or-dist-c
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp n) (>= n 0))
-           (= (logior (* (expt 2 n) x)
-                      (* (expt 2 n) y))
-              (* (expt 2 n) (logior x y))))
-  :rule-classes ()
-  :hints (("Goal" :induct (induct-nat n))
-	  ("Subgoal *1/1" :use ((:instance or-dist-c-3)))))
-
-
-
-(local
- (defthm mod-logior-1
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0))
-            (= (logior x y)
-               (logior (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
-                               (mod x (expt 2 n)))
-                       (logior (* (expt 2 n) (fl (/ y (expt 2 n))))
-                               (mod y (expt 2 n))))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance quot-mod (m x) (n (expt 2 n)))
-                         (:instance quot-mod (m y) (n (expt 2 n)))
-                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
-                         (:instance mod-bnd-1 (m y) (n (expt 2 n)))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-;		(:instance mod>=0 (m y) (n (expt 2 n)))
-                         (:instance or-dist-b (x (fl (/ x (expt 2 n)))) (y (mod x (expt 2 n))))
-                         (:instance or-dist-b (x (fl (/ y (expt 2 n)))) (y (mod y (expt 2 n)))))))))
-
-(local
- (defthm mod-logior-3
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0))
-            (= (logior x y)
-               (logior (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
-                               (* (expt 2 n) (fl (/ y (expt 2 n)))))
-                       (logior (mod x (expt 2 n))
-                               (mod y (expt 2 n))))))
-   :rule-classes ()
-   :hints (("Goal" :use ( ;(:instance mod>=0 (m x) (n (expt 2 n)))
-;(:instance mod>=0 (m y) (n (expt 2 n)))
-                         (:instance mod-logior-1)
-                         )))))
-
-
-(local
- (defthm mod-logior-4
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0))
-            (= (logior x y)
-               (+ (* (expt 2 n)
-                     (logior (fl (/ x (expt 2 n)))
-                             (fl (/ y (expt 2 n)))))
-                  (logior (mod x (expt 2 n))
-                          (mod y (expt 2 n))))))
-   :rule-classes ()
-   :hints (("Goal"
-            :use ((:instance mod-logior-3)
-                         (:instance or-dist-c (x (fl (/ x (expt 2 n)))) (y (fl (/ y (expt 2 n)))))
-                         (:instance or-dist-b
-                                    (x (logior (fl (/ x (expt 2 n)))
-                                               (fl (/ y (expt 2 n)))))
-                                    (y (logior (mod x (expt 2 n))
-                                               (mod y (expt 2 n)))))
-                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
-                         (:instance mod-bnd-1 (m y) (n (expt 2 n)))
-;                         (:instance or-dist-a (x (mod x (expt 2 n))) (y (mod y (expt 2 n))))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-;		(:instance mod>=0 (m y) (n (expt 2 n)))
-                         )))))
-
-(local
- (defthm mod-logior-5-not-by-2
-   (implies (and (integerp x) (>= x 0)
-                 (integerp y) (>= y 0)
-                 (integerp n) (> n 0))
-            (= (mod (logior x y) (expt 2 n))
-               (mod (logior (mod x (expt 2 n)) (mod y (expt 2 n)))
-                    (expt 2 n))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance mod-logior-4)
-                         (:instance mod-mult-eric
-                                    (x (logior (mod x (expt 2 n)) (mod y (expt 2 n))))
-                                    (y (expt 2 n))
-                                    (a (logior (fl (/ x (expt 2 n)))
-                                               (fl (/ y (expt 2 n))))))
-                         (:instance n<=fl-linear (x (/ x (expt 2 n))) (n 0))
-                         (:instance n<=fl-linear (x (/ y (expt 2 n))) (n 0))
-;			(:instance logior-nat (i (fl (/ x (expt 2 n)))) (j (fl (/ y (expt 2 n)))))
-;		(:instance logior-nat (i (mod x (expt 2 n))) (j (mod y (expt 2 n))))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-;		(:instance mod>=0 (m y) (n (expt 2 n)))
-                         )))))
-
-(defthmd mod-logior
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp n) (>= n 0)
-                )
-           (equal (mod (logior x y) (expt 2 n))
-                  (logior (mod x (expt 2 n)) (mod y (expt 2 n)))))
-  :hints (("Goal" :use ((:instance mod-logior-5-not-by-2)
-			(:instance mod-does-nothing
-				   (m (logior (mod x (expt 2 n)) (mod y (expt 2 n))))
-				   (n (expt 2 n)))
-;/			(:instance mod>=0 (m x) (n (expt 2 n)))
-	;		(:instance mod>=0 (m y) (n (expt 2 n)))
-;			(:instance logior-nat (i (mod x (expt 2 n))) (j (mod y (expt 2 n))))
-			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
-			(:instance mod-bnd-1 (m y) (n (expt 2 n)))
-;			(:instance or-dist-a (x (mod x (expt 2 n))) (y (mod y (expt 2 n))))
-                        ))))
-
-
-#|
-
-
-(defthmd logior-simp-1-alt
-  (implies (and (syntaxp (and (should-have-a-2-factor-multiplied-in i)
-                              (should-have-a-2-factor-multiplied-in j)))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (* 2 (logior i j))
-                  (logior (* 2 i) (* 2 j))))
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-negative-6
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< (logior i j) -1)
-                  (AND (< -1 I) (< -1 J))
-                  ))
-  :hints (("Goal" :cases ((equal j -1) (equal i -1))
-           :in-theory (enable logior))))
-
-;weird
-;trying disabled
-(defthmd logior-ones-when-one-arg-is-even
-  (implies (and (integerp (* 1/2 j))
-                (case-split (integerp j))
-                (case-split (integerp i))
-                )
-           (and (equal (equal (logior i j) -1)
-                       (and (not (integerp (* 1/2 i)))
-                            (equal (logior (fl (/ i 2)) (fl (/ j 2))) -1)))
-                (equal (equal (logior j i) -1)
-                       (and (not (integerp (* 1/2 i)))
-                            (equal (logior (fl (/ i 2)) (fl (/ j 2))) -1)))))
-  :hints (("Goal" :in-theory (e/d (logior) (fl-int))))
-  )
-
-
-;move!
-;disable?
-;more general version loops
-(defthm tighten-integer-bound
-  (implies (integerp x)
-           (equal (< x 1)
-                  (<= x 0))))
-
-;move!
-;disable?
-(defthm integer-<-fraction-expt-case
-  (implies (and (< n 0)
-                (integerp x))
-           (equal (< X (EXPT 2 N))
-                  (<= X 0)))
-  :hints (("Goal" :in-theory (disable  EXPT-COMPARE)
-           :use (:instance  EXPT-COMPARE
-                            (lhs (expt 2 0))
-                            (rhs (expt 2 n))))))
-
-(local (include-book
-        "../arithmetic/expt"))
-
-(local (defun logior-+-hint (x i)
-  (if (= (nfix i) 0)
-      x
-    (logior-+-hint (floor x 2) (1- i)))))
-
-;follows from  OR-DIST-B?
-(defthm logior-+
-  (implies (and (integerp i)
-                (<= 0 i)
-                (integerp x)
-                (<= 0 x)
-                (< x (expt 2 i)))
-           (equal (logior (expt 2 i) x)
-                  (+ (expt 2 i) x)))
-  :hints (("Goal" :induct (logior-+-hint x i)
-                  :in-theory
-                   (set-difference-theories
-                       (enable logior logand lognot
-                               functional-commutativity-of-minus-*-right
-                               functional-commutativity-of-minus-*-left)
-                       '(a2 a5))))
-  :rule-classes nil)
-
-|#
-
-
-(defthm logior-non-negative-integerp
-  (implies (and (<= 0 i)
-                (<= 0 j))
-           (and (integerp (logior i j))
-                (<= 0 (logior i j))))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable logior))))
diff -Nru acl2-6.2/books/rtl/rel5/support/logior.lisp acl2-6.3/books/rtl/rel5/support/logior.lisp
--- acl2-6.2/books/rtl/rel5/support/logior.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logior.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,288 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(include-book "ground-zero")
-
-(local (include-book "logior-proofs"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-;split?
-(defthm logior-with-non-integer-arg
-  (implies (not (integerp i))
-           (and (equal (logior i j)
-                       (ifix j))
-                (equal (logior j i)
-                       (ifix j)))))
-
-(defthm logior-0
-  (implies (case-split (integerp j))
-           (equal (logior 0 j)
-                  j)))
-
-(defthm logior-commutative
-  (equal (logior j i)
-         (logior i j)))
-
-(defthm logior-associative
-  (equal (logior (logior i j) k)
-         (logior i (logior j k))))
-
-(defthm logior-commutative-2
-  (equal (logior j i k)
-         (logior i j k)))
-
-(defthm logior-combine-constants
-  (implies (syntaxp (and (quotep i)
-                         (quotep j)))
-           (equal (logior i j k)
-                  (logior (logior i j) k))))
-
-(defthm logior-with-an-arg-of-minus-one
-  (implies (case-split (integerp i))
-           (equal (logior -1 i) -1)))
-
-;BOZO dup!
-;figure this out
-(defthm logior-non-negative-integerp
-  (implies (and (<= 0 i)
-                (<= 0 j))
-           (and (integerp (logior i j))
-                (<= 0 (logior i j))))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable logior))))
-
-(defthm logior-non-negative-integerp-type
-  (implies (and (<= 0 i)
-                (<= 0 j))
-           (and (integerp (logior i j))
-                (<= 0 (logior i j))))
-  :rule-classes ( :type-prescription))
-
-(defthm logior-non-negative
-  (and (implies (and (<= 0 i)
-                     (<= 0 j))
-                (<= 0 (logior i j)))))
-
-(defthm logior-equal-0
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (equal (logior i j) 0)
-                  (and (equal i 0) (equal j 0)))))
-
-(defthm logior-even
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (integerp (* 1/2 (logior i j)))
-                  (and (integerp (* 1/2 i))
-                       (integerp (* 1/2 j))))))
-
-(defthm logior-negative-1
-  (implies (and (< i 0)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (integerp (logior i j))
-                (< (logior i j) 0)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm logior-negative-2
-  (implies (and (< j 0)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (integerp (logior i j))
-                (< (logior i j) 0)))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm logior-negative-3
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< (logior i j) 0)
-                  (or (< i 0)
-                      (< j 0)))))
-
-(defthm logior-non-positive
-  (implies (and (<= i 0)
-                (<= j 0)
-                )
-           (<= (logior i j) 0)))
-
-(defthm logior-self
-  (implies (case-split (integerp i))
-           (equal (logior i i) i)))
-
-;bad name?
-(defthm logior-simp-1
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (logior (* 2 i) (* 2 j))
-                  (* 2 (logior i j)))))
-
-(defthm logior-positive
-  (implies (and (< 0 i)
-                (< 0 j)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (integerp (logior i j))
-                (< 0 (logior i j))))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm logior-positive-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (< 0 (logior i j))
-                  (and (<= 0 i)
-                       (<= 0 j)
-                       (or (< 0 i)
-                           (< 0 j))))))
-
-(defthm logior-negative-5
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< -1 (logior i j))
-                  (AND (< -1 I) (< -1 J))
-                  )))
-
-(defthm logior-i-lognot-i
-  (implies (case-split (integerp i))
-           (equal (logior i (lognot i))
-                  -1)))
-
-;move? odd...
-(defthm fl-expression-rewrites-to-last-bit
-  (implies (integerp i)
-           (equal (+ I (* -2 (FL (* 1/2 I))))
-                  (if (evenp i)
-                      0
-                    1))))
-
-(defthm fl-logior-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (fl (* 1/2 (logior i j)))
-                  (logior (fl (/ i 2)) (fl (/ j 2))))))
-
-(defthm floor-logior-by-2
-    (implies (and (case-split (integerp i))
-		  (case-split (integerp j)))
-	     (equal (floor (logior i j) 2)
-                    (logior (floor i 2) (floor j 2)))))
-
-(defthm mod-logior-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (mod (logior i j) 2)
-                  (logior (mod i 2) (mod j 2)))))
-
-(defthmd logior-def
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (logior i j)
-                  (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
-                     (logior (mod i 2) (mod j 2)))))
-  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
-
-
-
-;make into a better form for rewriting?
-;gen to make conclusion the cat of the high bits of x (none if x is a bvecp) with a vector of ones?
-;BOZO reverse hyp order
-;see  lshiftamt-low-4
-(defthm logior-ones
-    (implies (and (natp n) ;gen?
-		  (bvecp x n))
-	     (equal (logior x (1- (expt 2 n)))
-		    (1- (expt 2 n))))
-  :rule-classes ())
-
-;rename
-(defthm logior-1-x
-  (implies (bvecp x 1)
-           (equal (logior 1 x) 1)))
-
-
-
-
-;n is a free var
-;BOZO rename
-;consider :linear?
-(defthm or-dist-a
-  (implies (and (< i (expt 2 n))
-                (< j (expt 2 n))
-                )
-           (< (logior i j) (expt 2 n)))
-  :rule-classes ((:rewrite :match-free :all)))
-
-(defthm logior-bvecp
-  (implies (and (bvecp x n)
-                (bvecp y n))
-           (bvecp (logior x y) n)))
-
-;gen?
-;whoa.  this is a lower bound
-;unfortunate to have to disable those rules..
-(defthm logior-bnd
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp y)
-                (>= y 0))
-           (<= x (logior x y)))
-  :rule-classes ())
-
-
-;generalize to or of disjoint ranges?
-(defthm OR-DIST-B
-    (implies (and (< y (expt 2 n))
-                  (integerp x) (>= x 0)
-		  (integerp y) (>= y 0)
-		  (integerp n) (>= n 0)
-		  )
-	     (= (logior (* (expt 2 n) x) y)
-		(+ (* (expt 2 n) x) y)))
-  :rule-classes ())
-
-;BOZO rename!
-;consider making rewrite?
-(defthm or-dist-c
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp n) (>= n 0))
-           (= (logior (* (expt 2 n) x)
-                      (* (expt 2 n) y))
-              (* (expt 2 n) (logior x y))))
-  :rule-classes ())
-
-(defthmd mod-logior
-  (implies (and (integerp x) (>= x 0)
-                (integerp y) (>= y 0)
-                (integerp n) (>= n 0)
-                )
-           (equal (mod (logior x y) (expt 2 n))
-                  (logior (mod x (expt 2 n)) (mod y (expt 2 n))))))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/logior1-proofs.lisp acl2-6.3/books/rtl/rel5/support/logior1-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/logior1-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logior1-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-(in-package "ACL2")
-
-(defund logior1 (x)
-  (declare (xargs :guard t))
-  (if (equal x 0) 0 1))
-
-(defthm logior1-logior1
-  (equal (logior1 (logior1 x))
-         (logior1 x))
-  :hints (("Goal" :in-theory (enable logior1))))
-
-(defthm logior1-equal-0
-  (equal (equal (logior1 x) 0)
-         (equal x 0))
-  :hints (("goal" :in-theory (enable logior1))))
-
-(defthm logior1-equal-1
-  (equal (equal (logior1 x)
-                1)
-         (not (equal x 0)))
-  :hints (("goal" :in-theory (enable logior1))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/logior1.lisp acl2-6.3/books/rtl/rel5/support/logior1.lisp
--- acl2-6.2/books/rtl/rel5/support/logior1.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logior1.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,22 +0,0 @@
-(in-package "ACL2")
-
-;Perhaps we want to keep LOGIOR1 enabled, but if not here are some rules about it...  More are in logs.lisp
-;(more those here?).
-
-(local (include-book "logior1-proofs"))
-
-(defund logior1 (x)
-  (declare (xargs :guard t))
-  (if (equal x 0) 0 1))
-
-(defthm logior1-logior1
-  (equal (logior1 (logior1 x))
-         (logior1 x)))
-
-(defthm logior1-equal-0
-  (equal (equal (logior1 x) 0)
-         (equal x 0)))
-
-(defthm logior1-equal-1
-  (equal (equal (logior1 x) 1)
-         (not (equal x 0))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/lognot.lisp acl2-6.3/books/rtl/rel5/support/lognot.lisp
--- acl2-6.2/books/rtl/rel5/support/lognot.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lognot.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,125 +0,0 @@
-(in-package "ACL2")
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ground-zero")
-(local (include-book "../arithmetic/top"))
-
-(defthm lognot-of-non-integer
-  (implies (not (integerp i))
-           (equal (lognot i)
-                  -1))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-lognot
-  (implies (case-split (integerp i))
-           (equal (lognot (lognot i))
-                  i))
-  :hints (("Goal" :in-theory (enable lognot))))
-                  
-(defthm lognot-integerp
-  (integerp (lognot i))
-    :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-equal-minus-one
-  (implies (case-split (integerp i))
-           (equal (EQUAL (LOGNOT i) -1)
-                  (equal i 0)))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-equal-0
-  (implies (case-split (integerp i))
-           (equal (EQUAL (LOGNOT i) 0)
-                  (equal i -1)))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-<-0
-  (implies (case-split (integerp i))
-           (equal (< (lognot i) 0)
-                  (<= 0 i)))
-    :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot->-0
-  (implies (case-split (integerp i))
-           (equal (< 0 (lognot i))
-                  (< i -1)))
-    :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-even
-  (implies (case-split (integerp i))
-           (equal (integerp (* 1/2 (lognot i)))
-                  (not (integerp (* 1/2 i)))))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-of-double
-  (implies (case-split (integerp i))
-           (EQUAL (LOGNOT (* 2 i))
-                  (+ 1 (* 2 (LOGNOT i)))))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-of-double-minus-1
-  (implies (case-split (integerp i))
-           (EQUAL (LOGNOT (1- (* 2 i)))
-                  (* 2 (LOGNOT (1- i)))))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-simp
-  (implies (case-split (integerp i))
-           (equal (LOGNOT (+ 1 (* 2 i)))
-                  (* 2 (LOGNOT i))))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-bound-1
-  (implies (case-split (integerp i))
-           (equal (< (LOGNOT I) -1)
-                  (< 0 i)))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-bound-2
-  (implies (case-split (integerp i))
-           (equal (< -1 (LOGNOT I))
-                  (< i 0)))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-bound-gen
-  (implies (and (case-split (integerp i))
-                (case-split (rationalp k)))
-           (equal (< (LOGNOT I) k)
-                  (< (1- (- k)) i)))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm lognot-bound-gen-2
-  (implies (and (case-split (integerp i))
-                (case-split (rationalp k)))
-           (equal (< k (LOGNOT I))
-                  (< i (1- (- k)))))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-
-;from ihs
-(defthm cancel-equal-lognot
-  (equal (equal (lognot i) (lognot j))
-         (equal (ifix i) (ifix j)))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-
-
-(defthm fl-lognot
-  (implies (case-split (integerp i))
-           (= (fl (* 1/2 (lognot i)))
-              (lognot (fl (* 1/2 i)))))
-  :hints (("Goal" :in-theory (enable lognot))))
-
-(defthm floor-lognot
-  (implies (case-split (integerp i))
-           (equal (floor (lognot i) 2)
-                  (lognot (floor i 2)))))
-
-(defthm mod-lognot-by-2
-  (implies (case-split (integerp i))
-           (equal (mod (lognot i) 2)
-                  (+ 2 (lognot (mod i 2)))))
-  :hints (("Goal" :in-theory (enable lognot mod-mult-of-n mod-by-2-rewrite-to-even)))
-  )
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/logorc1.lisp acl2-6.3/books/rtl/rel5/support/logorc1.lisp
--- acl2-6.2/books/rtl/rel5/support/logorc1.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logorc1.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,69 +0,0 @@
-(in-package "ACL2")
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(include-book "ground-zero")
-(local (include-book "logior"))
-(local (include-book "../arithmetic/fl"))
-(local (include-book "lognot"))
-
-(defthm floor-logorc1-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (floor (logorc1 i j) 2)
-                  (logorc1 (floor i 2) (floor j 2))))
-  :hints (("Goal" :in-theory (enable logorc1))))
-
-(defthm fl-logorc1-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (fl (* 1/2 (logorc1 i j)))
-                  (logorc1 (fl (* 1/2 i)) (fl (* 1/2 j)))))
-  :hints (("Goal" :in-theory (enable logorc1))))
-
-#| not true
-(defthm mod-LOGORC1
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (mod (logorc1 i j) 2)
-                  (logorc1 (mod i 2) (mod j 2))))
-  :hints (("Goal" :in-theory (enable logorc1))))
-|#
-
-#|
-
-(local
-(defthm logorc1-mod-1
-    (implies (and (integerp i) (integerp j))
-	     (iff (= (mod (logorc1 i j) 2) 0)
-		  (and (= (mod (lognot i) 2) 0)
-		       (= (mod j 2) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior lognot)
-		  :use ((:instance mod-logior-10 (i (lognot i))))))))
-
-(local(defthm logorc1-mod
-    (implies (and (integerp i) (>= i 0)
-		  (integerp j))
-	     (iff (= (mod (logorc1 i j) 2) 0)
-		  (and (= (mod i 2) 1)
-		       (= (mod j 2) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior lognot)
-		  :use ((:instance mod-logior-9)
-			(:instance logorc1-mod-1)
-			(:instance mod012 (x i)))))))
-|#
-
-(defthm logorc1-type
-  (implies (and (<= 0 i)
-                (<= 0 j))
-           (< (logorc1 i j) 0))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("Goal" :in-theory (enable logorc1 lognot))))
-  
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/logs.lisp acl2-6.3/books/rtl/rel5/support/logs.lisp
--- acl2-6.2/books/rtl/rel5/support/logs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,287 +0,0 @@
-(in-package "ACL2")
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-;what is this file??
-
-
-;; 2. equality comparison
-
-(defun log= (x y)
-  (declare (xargs :guard t))
-  (if (equal x y) 1 0))
-
-(defun log<> (x y)
-  (declare (xargs :guard t))
-  (if (equal x y) 0 1))
-
-
-;; 3. unsigned inequalities
-
-(defun log< (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (< x y) 1 0))
-
-(defun log<= (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (<= x y) 1 0))
-
-(defun log> (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (> x y) 1 0))
-
-(defun log>= (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (>= x y) 1 0))
-
-
-;; 4. signed inequalities
-
-;; The following function is not generated by translate-rtl, it is only needed
-;; for the definitions of comp2<, comp2<=, etc.
-(defun comp2 (x n)
-  (declare (xargs :guard (and (rationalp x) (integerp n))))
-  (if (< x (expt 2 (1- n)))
-      x
-    (- (- (expt 2 n) x))))
-
-(defun comp2< (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
-  (log< (comp2 x n) (comp2 y n)))
-
-(defun comp2<= (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
-  (log<= (comp2 x n) (comp2 y n)))
-
-(defun comp2> (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
-  (log> (comp2 x n) (comp2 y n)))
-
-(defun comp2>= (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
-  (log>= (comp2 x n) (comp2 y n)))
-
- 
-;; 5. unary logical operations
-
-;make separate books for these? logior1 has one?
-(defun logand1 (x n)
-  (declare (xargs :guard (integerp n)))
-  (log= x (1- (expt 2 n))))
-
-(defun logior1 (x)
-  (declare (xargs :guard t))
-  (if (equal x 0) 0 1))
-
-(defun logxor1 (src)
-  (declare (xargs :guard (integerp src)))
-  (if (oddp (logcount src)) 1 0))
-
-
-
-
-;should rtl.lisp disable these fns?
-
-
-;; log<
-
-(defthm log<-bvecp
-  (bvecp (log< x y) 1)
-  :hints (("Goal" :in-theory (enable log<))))
-
-(defthm log<-nonnegative-integer-type
-  (and (integerp (log< x y))
-       (<= 0 (log< x y)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable log<))))
-
-;this rule is no better than log<-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log<)))
-
-;just a rewrite rule
-(defthm log<-natp
-  (natp (log< x y)))
-
-
-
-;; log<=
-
-(defthm log<=-bvecp
-  (bvecp (log<= x y) 1)
-  :hints (("Goal" :in-theory (enable log<=))))
-
-(defthm log<=-nonnegative-integer-type
-  (and (integerp (log<= x y))
-       (<= 0 (log<= x y)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable log<=))))
-
-;this rule is no better than log<=-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log<=)))
-
-;just a rewrite rule
-(defthm log<=-natp
-  (natp (log<= x y)))
-
-
-;; log>
-
-(defthm log>-bvecp
-  (bvecp (log> x y) 1)
-  :hints (("Goal" :in-theory (enable log>))))
-
-(defthm log>-nonnegative-integer-type
-  (and (integerp (log> x y))
-       (<= 0 (log> x y)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable log>))))
-
-;this rule is no better than log>-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log>)))
-
-;just a rewrite rule
-(defthm log>-natp
-  (natp (log> x y)))
-
-
-
-
-;; log>=
-
-(defthm log>=-bvecp
-  (bvecp (log>= x y) 1)
-  :hints (("Goal" :in-theory (enable log>=))))
-
-(defthm log>=-nonnegative-integer-type
-  (and (integerp (log>= x y))
-       (<= 0 (log>= x y)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable log>=))))
-
-;this rule is no better than log>=-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log>=)))
-
-;just a rewrite rule
-(defthm log>=-natp
-  (natp (log>= x y)))
-
-
-;; log=
-
-(defthm log=-bvecp
-  (bvecp (log= x y) 1)
-  :hints (("Goal" :in-theory (enable log=))))
-
-(defthm log=-nonnegative-integer-type
-  (and (integerp (log= x y))
-       (<= 0 (log= x y)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable log=))))
-
-(defthm log=-commutative
-  (equal (log= x y)
-         (log= y x)))
-
-;this rule is no better than log=-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log=)))
-
-;just a rewrite rule
-(defthm log=-natp
-  (natp (log= x y)))
-
-
-;; log<>
-
-(defthm log<>-bvecp
-  (bvecp (log<> x y) 1)
-  :hints (("Goal" :in-theory (enable log<>))))
-
-(defthm log<>-nonnegative-integer-type
-  (and (integerp (log<> x y))
-       (<= 0 (log<> x y)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable log<>))))
-
-;this rule is no better than log<>-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription log<>)))
-
-;just a rewrite rule
-(defthm log<>-natp
-  (natp (log<> x y)))
-
-(defthm log<>-commutative
-  (equal (log<> x y)
-         (log<> y x)))
-
-
-;; logand1
-
-(defthm logand1-bvecp
-  (bvecp (logand1 x y) 1)
-  :hints (("Goal" :in-theory (enable logand1))))
-
-(defthm logand1-nonnegative-integer-type
-  (and (integerp (logand1 x y))
-       (<= 0 (logand1 x y)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logand1))))
-
-;this rule is no better than logand1-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription logand1)))
-
-;just a rewrite rule
-(defthm logand1-natp
-  (natp (logand1 x y)))
-
-
-;; logior1 
-(defthm logior1-bvecp
-  (bvecp (logior1 x) 1)
-  :hints (("Goal" :in-theory (enable logior1))))
-
-(defthm logior1-nonnegative-integer-type
-  (and (integerp (logior1 x))
-       (<= 0 (logior1 x)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logior1))))
-
-;this rule is no better than logior1-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription logior1)))
-
-;just a rewrite rule
-(defthm logior1-natp
-  (natp (logior1 x)))
-
-
-;; logxor1
-
-(defthm logxor1-bvecp
-  (bvecp (logxor1 x) 1)
-  :hints (("Goal" :in-theory (enable logxor1))))
-
-(defthm logxor1-nonnegative-integer-type
-  (and (integerp (logxor1 x))
-       (<= 0 (logxor1 x)))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logxor1))))
-
-;this rule is no better than logxor1-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription logxor1)))
-
-;just a rewrite rule
-(defthm logxor1-natp
-  (natp (logxor1 x)))
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/logxor.lisp acl2-6.3/books/rtl/rel5/support/logxor.lisp
--- acl2-6.2/books/rtl/rel5/support/logxor.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/logxor.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,208 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(include-book "ground-zero")
-(local (include-book "logeqv"))
-(local (include-book "logorc1"))
-(local (include-book "lognot"))
-(local (include-book "../arithmetic/top"))
-
-(defthm logxor-integerp-type
-  (integerp (logxor i j))
-  :rule-classes :type-prescription)
-
-(defthm logxor-0
-  (implies (case-split (integerp i))
-           (equal (logxor 0 i)
-                  i))
-  :hints (("goal" :in-theory (enable logxor))))
-
-(defthm logxor-non-negative-integer-type-prescription
-  (implies (and (<= 0 i)
-                (<= 0 j))
-           (and (<= 0 (logxor i j))
-                (integerp (logxor i j))))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable logxor))))
-
-(defthm logxor-non-negative
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                )
-           (<= 0 (logxor i j)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints (("goal" :in-theory (enable logxor))))
-
-(defthm logxor-even
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (integerp (* 1/2 (logxor i j)))
-                  (or (and (integerp (* 1/2 i))
-                           (integerp (* 1/2 j)))
-                      (and (not (integerp (* 1/2 j)))
-                           (not (integerp (* 1/2 i)))))))
-  :hints (("goal" :in-theory (enable logxor))))
-
-
-(defthm logxor-commutative
-  (equal (logxor j i)
-         (logxor i j))
-  :hints (("goal" :in-theory (enable logxor))))
-
-(defthm logxor-with-non-integer-arg
-  (implies (not (integerp i))
-           (and (equal (logxor i j)
-                       (ifix j))
-                (equal (logxor j i)
-                       (ifix j))))
-  :hints (("goal" :in-theory (enable logxor))))
-
-;do we really want to go to lognot?
-(defthm logxor-with-an-arg-of-minus-one
-  (implies (case-split (integerp i))
-           (equal (logxor -1 i)
-                  (lognot i)))
-  :hints (("goal" :in-theory (enable logxor))))
-
-(defthmd floor-logxor-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (floor (logxor i j) 2)
-                  (logxor (floor i 2) (floor j 2))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable logxor)
-                              '(lognot logeqv floor)))))
-
-(defthm fl-logxor-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (fl (* 1/2 (logxor i j)))
-                  (logxor (fl (* 1/2 i)) (fl (* 1/2 j)))))
-  :hints (("goal" :in-theory (enable logxor))))
-
-(defthm mod-logxor-by-2
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (mod (logxor i j) 2)
-                  (logxor (mod i 2) (mod j 2))))
-  :hints (("Goal" :in-theory (enable mod-by-2))))
-
-
-
-(defthmd logxor-def
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (logxor i j)
-                  (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
-                     (logxor (mod i 2) (mod j 2)))))
-  :rule-classes ((:definition :controller-alist ((binary-logxor t t))))
-  :hints (("goal" :use (:instance fl-mod-equal 
-                                  (x (logxor i j))
-                                  (y (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
-                     (logxor (mod i 2) (mod j 2)))))
-           :in-theory (enable mod-by-2))))
-
-;i'm not sure which way this rule should go but note that both parts of this rule rewrite to the same rhs
-(defthm lognot-logxor
-  (and (equal (logxor (lognot i) j)
-              (lognot (logxor i j)))
-       (equal (logxor j (lognot i))
-              (lognot (logxor i j))))
-  :hints (("goal" :in-theory (enable logxor ))))
-
-(defthm logxor-associative
-  (equal (logxor (logxor i j) k)
-         (logxor i (logxor j k)))
-  :hints (("subgoal *1/2" :use ( ;(:instance logxor-assoc-1)
-                                (:instance fl-mod-equal
-                                           (x (logxor (logxor i j) k))
-                                           (y (logxor i (logxor j k))))))
-          ("goal" :in-theory (enable logxor-def mod-by-2)
-           :induct ( logand-three-args-induct i j k))
-          ))
-
-(defthm logxor-commutative-2
-  (equal (logxor j i k)
-         (logxor i j k))
-  :hints (("Goal" :in-theory (disable LOGXOR-ASSOCIATIVE
-                                      logxor-commutative)
-           :use (LOGXOR-ASSOCIATIVE
-                 logxor-commutative
-                 (:instance LOGXOR-ASSOCIATIVE (j i) (i j))))))
- 
-(defthm logxor-combine-constants
-  (implies (syntaxp (and (quotep i)
-                         (quotep j)))
-           (equal (logxor i j k)
-                  (logxor (logxor i j) k))))
-
-(defthm logxor-self
-  (equal (logxor i i) 0)
-  :hints (("goal" :in-theory (enable logxor))))
-
-(defthmd logxor-def-rewrite
-  (implies (and (case-split (integerp x))
-                (case-split (integerp y))
-                )
-           (equal (logxor x y)
-                  (+ (* 2 (logxor (fl (/ x 2)) (fl (/ y 2))))
-                     (logxor (mod x 2) (mod y 2)))))
-  :hints (("Goal" :in-theory (enable logxor-def)))
-  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
-
-;gen?
-(defthm logxor-upper-bound-tight
-  (implies (and (< i (expt 2 n))
-                (< j (expt 2 n))
-                (integerp i) (>= i 0)
-                (integerp j) (>= j 0)
-                (integerp n) (>= n 0)
-                )
-           (<= (logxor i j) (1- (expt 2 n))))
-  :hints (("Goal" :induct (op-dist-induct i j n))
-	  ("Subgoal *1/2" :in-theory (set-difference-theories
-                                      (enable expt-split
-                                              )
-                                      '(a15))
-           :use ((:instance logxor-def)
-                 (:instance mod012 (m i))
-                 (:instance mod012 (m j))))))
-
-;change var names
-(defthm logxor-upper-bound
-  (implies (and (< i (expt 2 n))
-                (< j (expt 2 n))
-                (integerp i) (>= i 0)
-                (integerp j) (>= j 0)
-                (integerp n) (>= n 0)
-                )
-           (< (logxor i j) (expt 2 n)))
-  :hints (("Goal" :in-theory (disable logxor-upper-bound-tight)
-           :use (:instance  logxor-upper-bound-tight))))
-
-(defthm logxor-bvecp
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-                  (natp n) ;gen?
-		  )
-	     (bvecp (logxor x y) n))
-  :hints (("Goal" :in-theory (enable bvecp))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/lop1-proofs.lisp acl2-6.3/books/rtl/rel5/support/lop1-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/lop1-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lop1-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1121 +0,0 @@
-(in-package "ACL2")
-
-(include-book "merge")
-(local (include-book "bitn"))
-(local (include-book "bits"))
-(local (include-book "../arithmetic/top"))
-
-(local
- (defund C (k a b)
-   (- (bitn a k) (bitn b k))))
-
-; Here is the original version of lop.  Our current definition uses let to
-; avoid calling function c, but we want to preserve existing proofs.
-(local
- (defund LOP0 (a b d k)
-   (if (and (integerp k) (>= k 0))
-       (if (= k 0)
-           0
-         (if (= d 0)
-             (lop0 a b (c (1- k) a b) (1- k))
-           (if (= d (- (c (1- k) a b)))
-               (lop0 a b (- (c (1- k) a b)) (1- k))
-             k)))
-     0)))
-
-(defund lop (a b d k)
-  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
-    (if (and (integerp k) (>= k 0))
-	(if (= k 0)
-	    0
-	  (if (= d 0)
-	      (lop a b c (1- k))
-	    (if (= d (- c))
-		(lop a b (- c) (1- k))
-	      k)))
-      0)))
-
-(local (defthmd lop0-is-lop
-         (equal (lop0 a b d k)
-                (lop  a b d k))
-         :hints (("Goal" :in-theory (enable c lop0 lop)))))
-
-(local (defun lop0-induct (a b d k)
-  (if (and (integerp k) (>= k 0))
-      (if (= k 0)
-	  0
-	(and (lop0-induct a b (c (1- k) a b) (1- k))
-	     (lop0-induct a b (- (c (1- k) a b)) (1- k))))
-    d)))
-
-(local (defthm c-lemma
-    (implies (< b a)
-	     (equal (c k b a) (- (c k a b))))
-    :hints (("Goal" :in-theory (enable c)))))
-
-(local (defthm lop0-d
-    (implies (and (integerp a)
-		  (integerp b)
-		  (< b a)
-		  (integerp d)
-		  (integerp k)
-		  (>= k 0))
-	     (= (lop0 a b d k)
-		(lop0 b a (- d) k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop0)
-		  :induct (lop0-induct a b d k)))))
-
-
-(local (defthm mod-c
-    (implies (and (integerp x)
-		  (>= x 0)
-		  (integerp y)
-		  (>= y 0)
-		  (integerp j)
-		  (>= j 0)
-		  (integerp k)
-		  (> k j))
-	     (equal (c j (mod x (expt 2 k)) (mod y (expt 2 k)))
-		    (c j x y)))
-    :hints (("Goal" :in-theory (enable c bitn-mod)))))
-
-(local (defthm mod-c-2
-    (implies (and (integerp x)
-		  (>= x 0)
-		  (integerp y)
-		  (>= y 0)
-		  (integerp j)
-		  (>= j 0)
-		  (integerp k)
-		  (> k j))
-	     (equal (c j (mod x (* 2 (expt 2 (1- k)))) (mod y (* 2 (expt 2 (1- k)))))
-		    (c j x y)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '( mod-c)
-                              )
-		  :use (mod-c)))))
-
-(local-defthm LOP0-MOD
-    (implies (and (integerp a)
-		  (>= a 0)
-		  (integerp b)
-		  (>= b 0)
-		  (integerp d)
-		  (integerp j)
-		  (>= j 0)
-		  (integerp k)
-		  (>= k j))
-	     (= (lop0 a b d j)
-		(lop0 (mod a (expt 2 k)) (mod b (expt 2 k)) d j)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop0)
-		  :induct (lop0-induct a b d j))
-	  ("Subgoal *1/2" :expand ((lop0 a b d j)
-				   (LOP0 (MOD A (* 2 (EXPT 2 (1- K))))
-					(MOD B (* 2 (EXPT 2 (1- K))))
-					d
-					j)))))
-
-(defthm LOP-MOD
-    (implies (and (integerp a)
-		  (>= a 0)
-		  (integerp b)
-		  (>= b 0)
-		  (integerp d)
-		  (integerp j)
-		  (>= j 0)
-		  (integerp k)
-		  (>= k j))
-	     (= (lop a b d j)
-		(lop (mod a (expt 2 k)) (mod b (expt 2 k)) d j)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop0-is-lop)
-           :use lop0-mod)))
-
-(local (defun lop0-1-induct (n a b)
-  (if (and (integerp n) (>= n 0))
-      (if (> n 1)
-	  (if (= (c (1- n) a b) 0)
-	      (lop0-1-induct (1- n) (mod a (expt 2 (1- n))) (mod b (expt 2 (1- n))))
-	    (if (= (c (- n 2) a b) -1)
-		(lop0-1-induct (1- n) (- a (expt 2 (- n 2))) (- b (expt 2 (- n 2))))
-	      t))
-	t)
-    t)))
-
-(local (defthm lop0-1-1
-    (implies (and (integerp a)
-		  (integerp b)
-		  (integerp n)
-		  (>= a 0)
-		  (>= b 0)
-		  (>= n 0)
-		  (<= n 1)
-		  (< b a)
-		  (< a (expt 2 n))
-		  (< b (expt 2 n)))
-	     (= n 1))
-  :rule-classes ()))
-
-(local (defthm lop0-1-2
-    (implies (and (integerp a)
-		  (integerp b)
-		  (>= a 0)
-		  (>= b 0)
-		  (< b a)
-		  (< a 2)
-		  (< b 2))
-	     (and (= a 1) (= b 0)))
-  :rule-classes ()))
-
-(local (defthm lop0-1-3
-    (= (lop0 1 0 0 1) (expo 1))
-  :rule-classes ()))
-
-(local (defthm lop0-1-4
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (<= N 1))
-	     (IMPLIES (AND (INTEGERP A)
-			   (INTEGERP B)
-			   (INTEGERP N)
-			   (<= 0 A)
-			   (<= 0 B)
-			   (<= 0 N)
-			   (< B A)
-			   (< A (EXPT 2 N))
-			   (< B (EXPT 2 N)))
-		      (OR (= (LOP0 A B 0 N) (EXPO (+ A (- B))))
-			  (= (LOP0 A B 0 N)
-			     (+ 1 (EXPO (+ A (- B))))))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop0-1-1 lop0-1-2 lop0-1-3)))))
-
-(local (defthm lop0-1-5
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (1- N) A B) 0))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (and (= (bitn a (1- n)) 1)
-		  (= (bitn b (1- n)) 0)
-		  (= (c (1- n) a b) 1)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable c)
-           :use ((:instance bitn-0-1 (x a) (n (1- n)))
-			(:instance bitn-0-1 (x b) (n (1- n)))
-			(:instance bit-expo-a (x b) (n (1- n)))
-			(:instance bit-expo-b (x a) (n (1- n))))))))
-
-(local (defthm lop0-1-6
-         (IMPLIES (AND (INTEGERP N)
-                       (< 1 N)
-                       (NOT (= (C (1- N) A B) 0))
-                       (NOT (= (C (+ -2 N) A B) -1))
-                       (INTEGERP A)
-                       (INTEGERP B)
-                       (INTEGERP N)
-                       (<= 0 A)
-                       (<= 0 B)
-                       (<= 0 N)
-                       (< B A)
-                       (< A (EXPT 2 N))
-                       (< B (EXPT 2 N)))
-                  (= (LOP0 A B 0 N) 
-                     (1- n)))
-         :rule-classes ()
-         :hints (("Goal"  :expand ((LOP0 A B 1 (1- N)))
-                  :in-theory (enable expt-split
-                                      lop0)
-		  :use (lop0-1-5)))))
-
-(local (defthm lop0-1-7
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (1- N) A B) 0))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (and (>= a (expt 2 (1- n)))
-		  (< b (expt 2 (1- n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance lop0-1-5)
-			(:instance bit-expo-a (x a) (n (1- n)))
-			(:instance bit-expo-b (x b) (n (1- n))))))))
-
-(local (defthm lop0-1-8
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (1- N) A B) 0))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< b (expt 2 (- n 2)))
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (> (- a b) (expt 2 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt)
-           :use ((:instance lop0-1-7)
-                 (:instance expt-split (r 2) (i (- 2 n)) (j 1)))))))
-
-(local (in-theory (disable c-lemma)))
-
-(local (defthm lop0-1-9
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (NOT (= (C (+ -2 N) A B) -1))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (>= b (expt 2 (- n 2)))
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (bitn a (- n 2)) 1))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable c)
-		  :use (lop0-1-7
-			(:instance bitn-0-1 (x a) (n (- n 2)))
-			(:instance bitn-0-1 (x b) (n (- n 2)))
-			(:instance bit-expo-b (x b) (n (- n 2))))))))
-
-(local (defthm lop0-1-10
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (NOT (= (C (+ -2 N) A B) -1))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (>= b (expt 2 (- n 2)))
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (bitn (- a (expt 2 (1- n))) (- n 2))
-		1))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-9
-			lop0-1-7
-			(:instance  bitn-plus-expt-2 (x (- a (expt 2 (1- n)))) (m (1- n)) (n (- n 2))))))))
-
-(local (defthm lop0-1-11
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (NOT (= (C (+ -2 N) A B) -1))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (>= b (expt 2 (- n 2)))
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (>= (- a b) (expt 2 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-10
-			lop0-1-7
-			(:instance bit-expo-a (x (- a (expt 2 (1- n)))) (n (- n 2))))))))
-
-(local (defthm lop0-1-12
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (NOT (= (C (+ -2 N) A B) -1))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (>= (- a b) (expt 2 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-11
-			lop0-1-8)))))
-
-(local (defthm lop0-1-13
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (NOT (= (C (+ -2 N) A B) -1))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (>= (expo (- a b)) (- n 2)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-12
-			(:instance expo>= (x (- a b)) (n (- n 2))))))))
-
-(local (defthm lop0-1-14
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (NOT (= (C (+ -2 N) A B) -1))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (<= (expo (- a b)) (- n 1)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt)
-           :use ((:instance expo-monotone (x (- a b)) (y a))
-			(:instance expo<= (x a) (n (- n 1))))))))
-
-(local (defthm lop0-1-15
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (NOT (= (C (+ -2 N) A B) -1))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (OR (= (LOP0 A B 0 N) (EXPO (+ A (- B))))
-		 (= (LOP0 A B 0 N)
-		    (+ 1 (EXPO (+ A (- B)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                                      EXPO-COMPARISON-REWRITE-TO-BOUND
-                                     )
-           :use (lop0-1-14 lop0-1-13 lop0-1-6)))))
-
-(local (defthm lop0-1-16
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (and (= (bitn b (- n 2)) 1)
-		  (= (bitn a (- n 2)) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable c)
-           :use ((:instance bitn-0-1 (x a) (n (- n 2)))
-			(:instance bitn-0-1 (x b) (n (- n 2))))))))
-
-(local (defthm lop0-1-17
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (>= b (expt 2 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-16
-			(:instance bit-expo-a (x b) (n (- n 2))))))))
-
-(local (defthm lop0-1-18
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (< a (- (expt 2 n) (expt 2 (- n 2)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (bvecp) ( expt))
-		  :use (lop0-1-16
-;			(:instance bit-expo-c (x a) (k (- n 2)))
-                        (:instance bvecp-bitn-2 (x a) (k (- n 2)))
-                        )))))
-
-
-(local (defthm lop0-1-19
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (< a (+ (expt 2 (- n 1)) (expt 2 (- n 2)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split)
-		  :use (lop0-1-18)))))
-
-
-(local (defthm lop0-1-20
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (IMPLIES (AND (INTEGERP (+ A (- (EXPT 2 (+ -2 N)))))
-				(INTEGERP (+ B (- (EXPT 2 (+ -2 N)))))
-				(INTEGERP (+ -1 N))
-				(<= 0 (+ A (- (EXPT 2 (+ -2 N)))))
-				(<= 0 (+ B (- (EXPT 2 (+ -2 N)))))
-				(<= 0 (+ -1 N))
-				(< (+ B (- (EXPT 2 (+ -2 N))))
-				   (+ A (- (EXPT 2 (+ -2 N)))))
-				(< (+ A (- (EXPT 2 (+ -2 N))))
-				   (EXPT 2 (+ -1 N)))
-				(< (+ B (- (EXPT 2 (+ -2 N))))
-				   (EXPT 2 (+ -1 N))))
-			   (OR (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
-				       (+ B (- (EXPT 2 (+ -2 N))))
-				       0 (+ -1 N))
-				  (EXPO (+ (+ A (- (EXPT 2 (+ -2 N))))
-					   (- (+ B (- (EXPT 2 (+ -2 N))))))))
-			       (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
-				       (+ B (- (EXPT 2 (+ -2 N))))
-				       0 (+ -1 N))
-				  (+ 1
-				     (EXPO (+ (+ A (- (EXPT 2 (+ -2 N))))
-					      (- (+ B (- (EXPT 2 (+ -2 N)))))))))))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (OR (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
-			 (+ B (- (EXPT 2 (+ -2 N))))
-			 0 
-			 (+ -1 N))
-		    (EXPO (+ A (- B))))
-		 (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
-			 (+ B (- (EXPT 2 (+ -2 N))))
-			 0 
-			 (+ -1 N))
-		    (+ 1 (EXPO (+ A (- B)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-7 
-			lop0-1-17
-			lop0-1-19
-			(:instance expt-split (r 2) (i (- n 1)) (j 1))
-			(:instance expt-split (r 2) (i (- n 2)) (j 1)))))))
-
-(local (defthm lop0-1-21
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 a b 0 n)
-		(lop0 a b 1 (- n 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop0)
-		  :use (lop0-1-5)))))
-
-(local (defthm lop0-1-22
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 a b 0 n)
-		(lop0 a b 1 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :expand (LOP0 A B 1 (+ -1 N))
-		  :use (lop0-1-5 lop0-1-21)))))
-
-(local (defthm lop0-1-23
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 (mod a (expt 2 (- n 2)))
-		     (mod b (expt 2 (- n 2)))
-		     1
-		     (- n 2))
-		(lop0 a b 1 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use ((:instance lop0-mod (d 1) (j (- n 2)) (k (- n 2))))))))
-
-(local (defthm lop0-1-24
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 (mod (- a (expt 2 (- n 2)))
-			  (expt 2 (- n 2)))
-		     (mod (- b (expt 2 (- n 2)))
-			  (expt 2 (- n 2)))
-		     1
-		     (- n 2))
-		(lop0 (- a (expt 2 (- n 2)))
-		     (- b (expt 2 (- n 2)))
-		     1 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-17
-			(:instance lop0-mod
-				   (a (- a (expt 2 (- n 2))))
-				   (b (- b (expt 2 (- n 2))))
-				   (d 1) 
-				   (j (- n 2))
-				   (k (- n 2))))))))
-
-(local (defthm lop0-1-25
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 (mod (- a (expt 2 (- n 2)))
-			  (expt 2 (- n 2)))
-		     (mod (- b (expt 2 (- n 2)))
-			  (expt 2 (- n 2)))
-		     1
-		     (- n 2))
-		(lop0 (mod a
-			  (expt 2 (- n 2)))
-		     (mod b
-			  (expt 2 (- n 2)))
-		     1
-		     (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-17
-;			(:instance mod+-thm (m (- a (expt 2 (- n 2)))) (a 1) (n (expt 2 (- n 2))))
-	;		(:instance mod+-thm (m (- b (expt 2 (- n 2)))) (a 1) (n (expt 2 (- n 2))))
-                             )))))
-
-(local (defthm lop0-1-26
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 a b 0 n)
-		(lop0 (- a (expt 2 (- n 2)))
-		     (- b (expt 2 (- n 2)))
-		     1 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-22 lop0-1-23 lop0-1-24 lop0-1-25)))))
-
-(local (defthm lop0-1-27
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (bitn (- b (expt 2 (- n 2))) (- n 2))
-		0))
-  :rule-classes ()
-  :hints (("Goal" :use (lop0-1-7
-			lop0-1-17
-
-			(:instance bit-expo-a (x (- b (expt 2 (- n 2)))) (n (- n 2))))
-		  :in-theory (enable expt-split)))))
-
-(local (defthm lop0-1-28
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (bitn (- a (expt 2 (- n 2))) (- n 2))
-		1))
-  :rule-classes ()
-  :hints (("Goal" :use (lop0-1-7
-			lop0-1-19
-;			(:instance expt-split (r 2) (i (- n 2)) (j 1))
-			(:instance bit-expo-b (x (- a (expt 2 (- n 2)))) (n (- n 2))))
-		  :in-theory (enable expt-split)))))
-
-(local (defthm lop0-1-29
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 (- a (expt 2 (- n 2)))
-		     (- b (expt 2 (- n 2)))
-		     0 (- n 1))
-		(lop0 (- a (expt 2 (- n 2)))
-		     (- b (expt 2 (- n 2)))
-		     1 (- n 2))))
-  :rule-classes ()
-  :hints (("Goal" :expand (LOP0 (+ A (* -1 (EXPT 2 (+ -2 N))))
-			       (+ B (* -1 (EXPT 2 (+ -2 N))))
-			       0 (+ -1 N))
-		  :use (lop0-1-27 lop0-1-28)
-		  :in-theory (enable c)))))
-
-(local (defthm lop0-1-30
-    (IMPLIES (AND (INTEGERP N)
-		  (< 1 N)
-                  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 a b 0 n)
-		(lop0 (- a (expt 2 (- n 2)))
-		     (- b (expt 2 (- n 2)))
-		     0 (- n 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-26 lop0-1-29)))))
-
-(local (defthm lop0-1-31
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (NOT (= (C (+ -1 N) A B) 0))
-		  (= (C (+ -2 N) A B) -1)
-		  (IMPLIES (AND (INTEGERP (+ A (- (EXPT 2 (+ -2 N)))))
-				(INTEGERP (+ B (- (EXPT 2 (+ -2 N)))))
-				(INTEGERP (+ -1 N))
-				(<= 0 (+ A (- (EXPT 2 (+ -2 N)))))
-				(<= 0 (+ B (- (EXPT 2 (+ -2 N)))))
-				(<= 0 (+ -1 N))
-				(< (+ B (- (EXPT 2 (+ -2 N))))
-				   (+ A (- (EXPT 2 (+ -2 N)))))
-				(< (+ A (- (EXPT 2 (+ -2 N))))
-				   (EXPT 2 (+ -1 N)))
-				(< (+ B (- (EXPT 2 (+ -2 N))))
-				   (EXPT 2 (+ -1 N))))
-			   (OR (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
-				       (+ B (- (EXPT 2 (+ -2 N))))
-				       0 (+ -1 N))
-				  (EXPO (+ (+ A (- (EXPT 2 (+ -2 N))))
-					   (- (+ B (- (EXPT 2 (+ -2 N))))))))
-			       (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
-				       (+ B (- (EXPT 2 (+ -2 N))))
-				       0 (+ -1 N))
-				  (+ 1
-				     (EXPO (+ (+ A (- (EXPT 2 (+ -2 N))))
-					      (- (+ B (- (EXPT 2 (+ -2 N)))))))))))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (OR (= (LOP0 A B 0 N) (EXPO (+ A (- B))))
-		 (= (LOP0 A B 0 N)
-		    (+ 1 (EXPO (+ A (- B)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-20 lop0-1-30)))))
-
-(local (defthm lop0-1-32
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (= (bitn a (- n 1)) 0)
-		  (= (bitn b (- n 1)) 0)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (- a b)
-		(- (mod a (expt 2 (- n 1)))
-		   (mod b (expt 2 (- n 1))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance mod-does-nothing (m a) (n (expt 2 (- n 1))))
-			(:instance mod-does-nothing (m b) (n (expt 2 (- n 1))))
-			(:instance bit-expo-b (x a) (n (- n 1)))
-			(:instance bit-expo-b (x b) (n (- n 1))))))))
-
-(local (defthm lop0-1-33
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (= (bitn a (- n 1)) 1)
-		  (INTEGERP A)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 N)
-		  (< A (EXPT 2 N)))
-	     (= (mod a (expt 2 (- n 1)))
-		(- a (expt 2 (- n 1)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split)
-           :use ((:instance mod-does-nothing (m (- a (expt 2 (- n 1)))) (n (expt 2 (- n 1))))
-		;	(:instance expt-split (r 2) (i (- n 1)) (j 1))
-			(:instance bit-expo-a (x a) (n (- n 1)))
-;			(:instance mod+-thm (m (- a (expt 2 (- n 1)))) (a 1) (n (expt 2 (- n 1))))
-                        )))))
-
-(local (defthm lop0-1-34
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (= (bitn a (- n 1)) 1)
-		  (= (bitn b (- n 1)) 1)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (- a b)
-		(- (mod a (expt 2 (- n 1)))
-		   (mod b (expt 2 (- n 1))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance lop0-1-33)
-			(:instance lop0-1-33 (a b)))))))
-
-(local (defthm lop0-1-35
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (= (C (+ -1 N) A B) 0)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (- a b)
-		(- (mod a (expt 2 (- n 1)))
-		   (mod b (expt 2 (- n 1))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable c)
-		  :use (lop0-1-34
-			lop0-1-32
-			(:instance bitn-0-1 (x a) (n (- n 1)))
-			(:instance bitn-0-1 (x b) (n (- n 1))))))))
-
-
-
-(local (defthm lop0-1-36
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (= (C (+ -1 N) A B) 0)
-		  (IMPLIES (AND (INTEGERP (MOD A (EXPT 2 (+ -1 N))))
-				(INTEGERP (MOD B (EXPT 2 (+ -1 N))))
-				(INTEGERP (+ -1 N))
-				(<= 0 (MOD A (EXPT 2 (+ -1 N))))
-				(<= 0 (MOD B (EXPT 2 (+ -1 N))))
-				(<= 0 (+ -1 N))
-				(< (MOD B (EXPT 2 (+ -1 N)))
-				   (MOD A (EXPT 2 (+ -1 N))))
-				(< (MOD A (EXPT 2 (+ -1 N)))
-				   (EXPT 2 (+ -1 N)))
-				(< (MOD B (EXPT 2 (+ -1 N)))
-				   (EXPT 2 (+ -1 N))))
-			   (OR (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
-				       (MOD B (EXPT 2 (+ -1 N)))
-				       0 (+ -1 N))
-				  (EXPO (+ (MOD A (EXPT 2 (+ -1 N)))
-					   (- (MOD B (EXPT 2 (+ -1 N)))))))
-			       (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
-				       (MOD B (EXPT 2 (+ -1 N)))
-				       0 (+ -1 N))
-				  (+ 1
-				     (EXPO (+ (MOD A (EXPT 2 (+ -1 N)))
-					      (- (MOD B (EXPT 2 (+ -1 N))))))))))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (OR (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
-			 (MOD B (EXPT 2 (+ -1 N)))
-			 0 (+ -1 N))
-		    (EXPO (+ A (- B))))
-		 (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
-			 (MOD B (EXPT 2 (+ -1 N)))
-			 0 (+ -1 N))
-		    (+ 1 (EXPO (+ A (- B)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-35
-;			(:instance mod>=0 (m a) (n (expt 2 (- n 1))))
-	;		(:instance mod>=0 (m b) (n (expt 2 (- n 1))))
-			(:instance mod-bnd-1 (m a) (n (expt 2 (- n 1))))
-			(:instance mod-bnd-1 (m b) (n (expt 2 (- n 1))))
-                        )))))
-
-(local (defthm lop0-1-37
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (= (C (+ -1 N) A B) 0)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (= (lop0 a b 0 n)
-		(LOP0 (MOD A (EXPT 2 (+ -1 N)))
-		     (MOD B (EXPT 2 (+ -1 N)))
-		     0 (+ -1 N))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop0)
-		  :use ((:instance lop0-mod (d 0) (j (- n 1)) (k (- n 1))))))))
-
-(local (defthm lop0-1-38
-    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
-		  (< 1 N)
-		  (= (C (+ -1 N) A B) 0)
-		  (IMPLIES (AND (INTEGERP (MOD A (EXPT 2 (+ -1 N))))
-				(INTEGERP (MOD B (EXPT 2 (+ -1 N))))
-				(INTEGERP (+ -1 N))
-				(<= 0 (MOD A (EXPT 2 (+ -1 N))))
-				(<= 0 (MOD B (EXPT 2 (+ -1 N))))
-				(<= 0 (+ -1 N))
-				(< (MOD B (EXPT 2 (+ -1 N)))
-				   (MOD A (EXPT 2 (+ -1 N))))
-				(< (MOD A (EXPT 2 (+ -1 N)))
-				   (EXPT 2 (+ -1 N)))
-				(< (MOD B (EXPT 2 (+ -1 N)))
-				   (EXPT 2 (+ -1 N))))
-			   (OR (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
-				       (MOD B (EXPT 2 (+ -1 N)))
-				       0 (+ -1 N))
-				  (EXPO (+ (MOD A (EXPT 2 (+ -1 N)))
-					   (- (MOD B (EXPT 2 (+ -1 N)))))))
-			       (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
-				       (MOD B (EXPT 2 (+ -1 N)))
-				       0 (+ -1 N))
-				  (+ 1
-				     (EXPO (+ (MOD A (EXPT 2 (+ -1 N)))
-					      (- (MOD B (EXPT 2 (+ -1 N))))))))))
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP N)
-		  (<= 0 A)
-		  (<= 0 B)
-		  (<= 0 N)
-		  (< B A)
-		  (< A (EXPT 2 N))
-		  (< B (EXPT 2 N)))
-	     (OR (= (LOP0 A B 0 N) (EXPO (+ A (- B))))
-		 (= (LOP0 A B 0 N)
-		    (+ 1 (EXPO (+ A (- B)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expt)
-		  :use (lop0-1-36 lop0-1-37)))))
-
-(local (defthm lop0-1-39
-    (implies (and (integerp a)
-		  (integerp b)
-		  (integerp n)
-		  (>= a 0)
-		  (>= b 0)
-		  (>= n 0)
-		  (< b a)
-		  (< a (expt 2 n))
-		  (< b (expt 2 n)))
-	     (or (= (lop0 a b 0 n) (expo (- a b)))
-		 (= (lop0 a b 0 n) (1+ (expo (- a b))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable c)
-		  :induct (lop0-1-induct n a b))
-	  ("Subgoal *1/4" :use (lop0-1-4))
-	  ("Subgoal *1/3" :use (lop0-1-15))
-	  ("Subgoal *1/2" :use (lop0-1-31))
-	  ("Subgoal *1/1" :use (lop0-1-38)))))
-
-
-(local-defthm LOP0-BNDS
-    (implies (and (integerp a)
-		  (integerp b)
-		  (integerp n)
-		  (>= a 0)
-		  (>= b 0)
-		  (>= n 0)
-		  (not (= a b))
-		  (< a (expt 2 n))
-		  (< b (expt 2 n)))
-	     (or (= (lop0 a b 0 n) (expo (- a b)))
-		 (= (lop0 a b 0 n) (1+ (expo (- a b))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable c lop0 expo-minus)
-		  :use (lop0-1-39
-			(:instance expo-minus (x (- a b)))
-			(:instance lop0-1-39 (a b) (b a))
-			(:instance lop0-d (a b) (b a) (d 0) (k n))))))
-
-(defthm LOP-BNDS
-    (implies (and (integerp a)
-		  (integerp b)
-		  (integerp n)
-		  (>= a 0)
-		  (>= b 0)
-		  (>= n 0)
-		  (not (= a b))
-		  (< a (expt 2 n))
-		  (< b (expt 2 n)))
-	     (or (= (lop a b 0 n) (expo (- a b)))
-		 (= (lop a b 0 n) (1+ (expo (- a b))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop0-is-lop)
-           :use lop0-bnds)))
diff -Nru acl2-6.2/books/rtl/rel5/support/lop1.lisp acl2-6.3/books/rtl/rel5/support/lop1.lisp
--- acl2-6.2/books/rtl/rel5/support/lop1.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lop1.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "lop1-proofs"))
-(include-book "merge") ;BOZO drop
-
-(defund lop (a b d k)
-  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
-    (if (and (integerp k) (>= k 0))
-	(if (= k 0)
-	    0
-	  (if (= d 0)
-	      (lop a b c (1- k))
-	    (if (= d (- c))
-		(lop a b (- c) (1- k))
-	      k)))
-      0)))
-
-(defthm LOP-MOD
-  (implies (and (integerp a)
-                (>= a 0)
-                (integerp b)
-                (>= b 0)
-                (integerp d)
-                (integerp j)
-                (>= j 0)
-                (integerp k)
-                (>= k j))
-           (= (lop a b d j)
-              (lop (mod a (expt 2 k)) (mod b (expt 2 k)) d j)))
-  :rule-classes ())
-
-(defthm LOP-BNDS
-  (implies (and (integerp a)
-                (integerp b)
-                (integerp n)
-                (>= a 0)
-                (>= b 0)
-                (>= n 0)
-                (not (= a b))
-                (< a (expt 2 n))
-                (< b (expt 2 n)))
-           (or (= (lop a b 0 n) (expo (- a b)))
-               (= (lop a b 0 n) (1+ (expo (- a b))))))
-  :rule-classes ())
-
diff -Nru acl2-6.2/books/rtl/rel5/support/lop2-proofs.lisp acl2-6.3/books/rtl/rel5/support/lop2-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/lop2-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lop2-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,671 +0,0 @@
-(in-package "ACL2")
-
-(include-book "lop1")
-(include-book "lior0")
-(local (include-book "../arithmetic/top"))
-(local (include-book "bitn"))
-(local (include-book "bits"))
-
-(local (defun lop2-induct (n a b)
-  (if (and (integerp n) (>= n 0))
-      (if (> n 0)
-	  (lop2-induct (1- n) a (mod b (expt 2 (1- n))))
-	a)
-    b)))
-
-(local (defthm lop2-1
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (= (bitn a (1- k)) 0)
-		  (= (bitn b (1- k)) 1)
-		  (IMPLIES (AND (INTEGERP A)
-				(<= 0 A)
-				(INTEGERP (MOD B (EXPT 2 (+ -1 K))))
-				(<= 0 (MOD B (EXPT 2 (+ -1 K))))
-				(INTEGERP (+ -1 K))
-				(<= 0 (+ -1 K))
-				(< A (EXPT 2 (+ -1 K)))
-				(< (MOD B (EXPT 2 (+ -1 K)))
-				   (EXPT 2 (+ -1 K))))
-			   (= (LOP A (MOD B (EXPT 2 (+ -1 K)))
-				   1 (+ -1 K))
-			      (EXPO (LOGIOR (* 2 A)
-					    (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
-						   (+ 1 -1 K))))))
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (LOP A 
-		     (MOD B (EXPT 2 (+ -1 K)))
-		     1 (1- K))
-		(EXPO (LOGIOR (* 2 A)
-			      (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
-				     k)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance mod-bnd-1 (m b) (n (expt 2 (1- k))))
-;			(:instance mod>=0 (m b) (n (expt 2 (1- k))))
-			(:instance bit-expo-b (x a) (n (1- k))))))))
-
-(local (defthm lop2-2
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (= (bitn a (1- k)) 0)
-		  (= (bitn b (1- k)) 1)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (LOP A b 1 k)
-		(lop a b 1 (1- k))))
-    :hints (("Goal" :in-theory (enable lop)))
-  :rule-classes ()))
-
-(local (defthm lop2-3
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (= (bitn a (1- k)) 0)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K)))
-	     (= (mod a (expt 2 (1- k)))
-		a))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance mod-does-nothing (m a) (n (expt 2 (1- k))))
-;			(:instance expt-pos (x (1- k)))
-			(:instance bit-expo-b (x a) (n (- k 1))))))))
-
-(local (defthm lop2-4
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (= (bitn a (1- k)) 0)
-		  (= (bitn b (1- k)) 1)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (LOP A b 1 k)
-		(lop a (mod b (expt 2 (1- k))) 1 (1- k))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop2-3
-			lop2-2
-			(:instance lop-mod (d 1) (j (1- k)) (k (1- k))))))))
-
-(local (defthm lop2-5
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (= (bitn a (1- k)) 0)
-		  (= (bitn b (1- k)) 1)
-		  (IMPLIES (AND (INTEGERP A)
-				(<= 0 A)
-				(INTEGERP (MOD B (EXPT 2 (+ -1 K))))
-				(<= 0 (MOD B (EXPT 2 (+ -1 K))))
-				(INTEGERP (+ -1 K))
-				(<= 0 (+ -1 K))
-				(< A (EXPT 2 (+ -1 K)))
-				(< (MOD B (EXPT 2 (+ -1 K)))
-				   (EXPT 2 (+ -1 K))))
-			   (= (LOP A (MOD B (EXPT 2 (+ -1 K)))
-				   1 (+ -1 K))
-			      (EXPO (LOGIOR (* 2 A)
-					    (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
-						   (+ 1 -1 K))))))
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (LOP A b 1 k)
-		(EXPO (LOGIOR (* 2 A)
-			      (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
-				     k)))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop2-1 lop2-4)))))
-
-(local (defthm lop2-6
-    (IMPLIES (AND (INTEGERP k)
-		  (< 0 k)
-		  (= (bitn b (- k 1)) 1)
-		  (INTEGERP b)
-		  (INTEGERP k)
-		  (<= 0 b)
-		  (< b (EXPT 2 k)))
-	     (= (mod b (expt 2 (- k 1)))
-		(- b (expt 2 (- k 1)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split)
-           :use ((:instance mod-does-nothing (m (- b (expt 2 (- k 1)))) (n (expt 2 (- k 1))))
-;			(:instance expt-pos (x (- k 1)))
-			(:instance expt-split (r 2) (i (- k 1)) (j 1))
-			(:instance bit-expo-a (x b) (n (- k 1)))
-;			(:instance mod+-thm (m (- b (expt 2 (- k 1)))) (a 1) (n (expt 2 (- k 1))))
-                        )))))
-
-(local (defthm lop2-7
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (= (bitn a (1- k)) 0)
-		  (= (bitn b (1- k)) 1)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (lnot (* 2 (mod b (expt 2 (1- k))))
-		       k)
-		(lnot (* 2 b) (1+ k))))		
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable lnot expt bits-reduce)
-                              '())
-           :use (lop2-6)))))
-
-(local (defthm lop2-8
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (= (bitn a (1- k)) 0)
-		  (= (bitn b (1- k)) 1)
-		  (IMPLIES (AND (INTEGERP A)
-				(<= 0 A)
-				(INTEGERP (MOD B (EXPT 2 (+ -1 K))))
-				(<= 0 (MOD B (EXPT 2 (+ -1 K))))
-				(INTEGERP (+ -1 K))
-				(<= 0 (+ -1 K))
-				(< A (EXPT 2 (+ -1 K)))
-				(< (MOD B (EXPT 2 (+ -1 K)))
-				   (EXPT 2 (+ -1 K))))
-			   (= (LOP A (MOD B (EXPT 2 (+ -1 K)))
-				   1 (+ -1 K))
-			      (EXPO (LOGIOR (* 2 A)
-					    (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
-						   (+ 1 -1 K))))))
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (LOP A b 1 k)
-		(EXPO (LOGIOR (* 2 A)
-			      (LNOT (* 2 b) (1+ k))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable lnot lop)
-		  :use (lop2-5 lop2-7)))))
-
-(local (defthm lop2-9
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (not (and (= (bitn a (1- k)) 0)
-			    (= (bitn b (1- k)) 1)))
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (LOP A b 1 k) k))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop)
-           :use ((:instance bitn-0-1 (x a) (n (1- k)))
-                 (:instance bitn-0-1 (x b) (n (1- k))))))))
-
-(local (defthm lop2-10
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (< (* 2 a) (expt 2 (1+ k))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt)
-                              '(a15))
-                              :use ((:instance *-strongly-monotonic (x 2) (y a) (y+ (expt 2 k))))))))
-
-(local (defthm lop2-11
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (< (LNOT (* 2 b) (1+ k))
-		(expt 2 (1+ k))))
-    :hints (("Goal"  :in-theory (set-difference-theories
-                              (enable expt lnot)
-                              '(a15))))
-  :rule-classes ()))
-
-(local (defthm lop2-12
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (< (logior (* 2 a)
-			(LNOT (* 2 b) (1+ k)))
-		(expt 2 (1+ k))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop2-10
-			lop2-11
-;			(:instance or-dist-a
-	;			   (x (* 2 a))
-		;		   (y (lnot (* 2 b) (1+ k)))
-			;	   (n (1+ k)))
-                        )))))
-
-(local (defthm lop2-13
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (<= (expo (logior (* 2 a)
-			       (LNOT (* 2 b) (1+ k))))
-		 k))
-  :rule-classes ()
-  :hints (("Goal" :use (lop2-12
-			(:instance expo<= (x (logior (* 2 a) (LNOT (* 2 b) (1+ k)))) (n k)))))))
-
-(local (include-book "logior")) ;remove if log includes logior
-
-(local (defthm lop2-14
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (= (bitn a (1- k)) 1)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (bitn (logior (* 2 a) (LNOT (* 2 b) (1+ k)))
-		      k)
-		1))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
-		  :use ((:instance bitn-shift (x a) (k 1) (n (1- k)))
-			(:instance bitn-0-1 (x (LNOT (* 2 b) (1+ k))) (n k)))))))
-
-(local (defthm lop2-15
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (= (bitn b (1- k)) 0)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (bitn (logior (* 2 a) (LNOT (* 2 b) (1+ k)))
-		      k)
-		1))
-  :rule-classes ()
-  :hints (("Goal"  :in-theory (set-difference-theories
-                              (enable bits-reduce)
-                              '(a15  BITN-KNOWN-NOT-0-REPLACE-WITH-1))
-		  :use ((:instance bitn-shift (x b) (k 1) (n (1- k)))
-			(:instance bitn-0-1 (x (LNOT (* 2 b) (1+ k))) (n k))
-			(:instance bitn-0-1 (x (* 2 a)) (n k))
-			(:instance bitn-lnot-not-equal
-				   (x (* 2 b))
-				   (n (1+ k))))))))
-
-(local (defthm lop2-16
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (not (and (= (bitn a (1- k)) 0)
-			    (= (bitn b (1- k)) 1)))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (bitn (logior (* 2 a) (LNOT (* 2 b) (1+ k)))
-		      k)
-		1))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior)
-		  :use (lop2-14
-			lop2-15
-			(:instance bitn-0-1 (x a) (n (1- k)))
-			(:instance bitn-0-1 (x b) (n (1- k))))))))
-
-(local (defthm lop2-17
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (not (and (= (bitn a (1- k)) 0)
-			    (= (bitn b (1- k)) 1)))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (>= (logior (* 2 a) (LNOT (* 2 b) (1+ k)))
-		 (expt 2 k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior)
-		  :use (lop2-16
-			(:instance bit-expo-a (x (logior (* 2 a) (LNOT (* 2 b) (1+ k)))) (n k)))))))
-
-(local (defthm lop2-18
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (not (and (= (bitn a (1- k)) 0)
-			    (= (bitn b (1- k)) 1)))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (>= (expo (logior (* 2 a) (LNOT (* 2 b) (1+ k))))
-		 k))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior)
-		  :use (lop2-17
-			(:instance expo>= (x (logior (* 2 a) (LNOT (* 2 b) (1+ k)))) (n k)))))))
-
-(local (defthm lop2-19
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (not (and (= (bitn a (1- k)) 0)
-			    (= (bitn b (1- k)) 1)))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (expo (logior (* 2 a) (LNOT (* 2 b) (1+ k))))
-		k))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior)
-		  :use (lop2-13 lop2-18)))))
-
-(local (defthm lop2-20
-    (IMPLIES (AND (INTEGERP K)
-		  (< 0 K)
-		  (IMPLIES (AND (INTEGERP A)
-				(<= 0 A)
-				(INTEGERP (MOD B (EXPT 2 (+ -1 K))))
-				(<= 0 (MOD B (EXPT 2 (+ -1 K))))
-				(INTEGERP (+ -1 K))
-				(<= 0 (+ -1 K))
-				(< A (EXPT 2 (+ -1 K)))
-				(< (MOD B (EXPT 2 (+ -1 K)))
-				   (EXPT 2 (+ -1 K))))
-			   (= (LOP A (MOD B (EXPT 2 (+ -1 K)))
-				   1 (+ -1 K))
-			      (EXPO (LOGIOR (* 2 A)
-					    (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
-						   (+ 1 -1 K))))))
-		  (INTEGERP A)
-		  (<= 0 A)
-		  (INTEGERP B)
-		  (<= 0 B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< A (EXPT 2 K))
-		  (< B (EXPT 2 K)))
-	     (= (LOP A b 1 k)
-		(EXPO (LOGIOR (* 2 A)
-			      (LNOT (* 2 b) (1+ k))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable lnot logior lop)
-		  :use (lop2-8 lop2-19 lop2-9)))))
-
-(local (defthm lop2-21
-    (implies (and (integerp a)
-		  (>= a 0)
-		  (integerp b)
-		  (>= b 0)
-		  (integerp k)
-		  (>= k 0)
-		  (< a (expt 2 k))
-		  (< b (expt 2 k)))
-	     (= (lop a b 1 k)
-		(expo (logior (* 2 a) (lnot (* 2 b) (1+ k))))))
-  :rule-classes ()
-  :hints (("Goal" :induct (lop2-induct k a b))
-	  ("Subgoal *1/1" :use (lop2-20)))))
-
-(local (defthm lop2-22
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e))
-	     (= (bitn a e) 1))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expo-upper-bound (x a))
-			(:instance expo-monotone (x 1) (y a))
-			(:instance expo-lower-bound (x a))
-			(:instance bit-expo-b (x a) (n e)))))))
-
-;move?
-(local (defthm lop2-23
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e))
-	     (= (bitn b e) 0))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
-                                      EXPO-BOUND-ERIC
-                                      expt-compare
-                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-           :use ((:instance expo-upper-bound (x b))
-			(:instance expo-monotone (x 1) (y a))
-			(:instance expt-weak-monotone (n (1+ (expo b))) (m e))
-			(:instance bit-expo-a (x b) (n e)))))))
-
-(local (defthm lop2-24
-         (implies (and (integerp a)
-                       (> a 0)
-                       (integerp b)
-                       (> b 0)
-                       (= e (expo a))
-                       (< (expo b) e))
-                  (= (lop a b 0 (1+ e))
-                     (lop a b 1 e)))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (enable lop)
-                  :use (lop2-22 
-			lop2-23
-			(:instance expo-monotone (x 1) (y a)))))))
-
-(local (defthm lop2-25
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e)
-		  (= lambda
-		     (logior (* 2 (mod a (expt 2 e)))
-			     (lnot (* 2 b) (1+ e)))))
-	     (= (lop (mod a (expt 2 e)) b 1 e)
-		(expo lambda)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
-                                      EXPO-BOUND-ERIC
-                                      expt-compare
-                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-           :use ((:instance lop2-21 (a (mod a (expt 2 e))) (k e))
-			(:instance expo-upper-bound (x b))
-			(:instance expo-monotone (x 1) (y a))
-			(:instance expt-weak-monotone (n (1+ (expo b))) (m e))
-;			(:instance mod>=0 (m a) (n (expt 2 e)))
-			(:instance mod-bnd-1 (m a) (n (expt 2 e))))))) )
-
-(local (defthm lop2-26
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e)
-		  (= lambda
-		     (logior (* 2 (mod a (expt 2 e)))
-			     (lnot (* 2 b) (1+ e)))))
-	     (= (lop (mod a (expt 2 e)) b 1 e)
-		(lop a b 1 e)))
-  :rule-classes ()
-  :hints (("Goal"  :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
-                                      EXPO-BOUND-ERIC
-                                      expt-compare
-                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-           :use ((:instance lop-mod (d 1) (j e) (k e))
-			(:instance mod-does-nothing (m b) (n (expt 2 e)))
-			(:instance expo-upper-bound (x b))
-			(:instance expo-monotone (x 1) (y a))
-			(:instance expt-weak-monotone (n (1+ (expo b))) (m e)))))))
-
-(local (defthm lop2-27
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e)
-		  (= lambda
-		     (logior (* 2 (mod a (expt 2 e)))
-			     (lnot (* 2 b) (1+ e)))))
-	     (= (lop a b 0 (1+ e))
-		(expo lambda)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior lop)
-		  :use (lop2-24 lop2-25 lop2-26)))))
-
-(defthm olop-thm-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e)
-		  (= lambda
-		     (logior (* 2 (mod a (expt 2 e)))
-			     (lnot (* 2 b) (1+ e)))))
-	     (or (= (expo (- a b)) (expo lambda))
-		 (= (expo (- a b)) (1- (expo lambda)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior lop)
-		  :use (lop2-27
-			(:instance expo-upper-bound (x b))
-			(:instance expo-monotone (x 1) (y a))
-			(:instance expt-weak-monotone (n (1+ (expo b))) (m e))
-			(:instance expo-upper-bound (x a))
-			(:instance lop-bnds (n (1+ e)))))))
-
-
-
-(local (defthm hack-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e))
-	     (bvecp (* 2 (mod a (expt 2 e)))
-		    (1+ e)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lior0 bvecp bits-tail)
-		  :expand ((EXPT 2 (+ 1 (EXPO A))))
-		  :use ((:instance mod-bnd-1 (m a) (n (expt 2 e)))
-			(:instance expo-monotone (x 1) (y a))))))			)
-
-(local (defthm hack-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e))
-	     (bvecp (lnot (* 2 b) (1+ e))
-		    (1+ e)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (union-theories (disable bits-bvecp) '(lnot bvecp))
-		  :use ((:instance expo-monotone (x 1) (y a))
-			(:instance bits-bvecp (x (* 2 b)) (i e) (j 0) (k (1+ e)))
-			(:instance expo-upper-bound (x b)))))))
-
-(defthm lop-thm-1-original
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (< (expo b) e)
-		  (= lambda
-		     (lior0 (* 2 (mod a (expt 2 e)))
-			   (lnot (* 2 b) (1+ e))
-			   (1+ e))))
-	     (or (= (expo (- a b)) (expo lambda))
-		 (= (expo (- a b)) (1- (expo lambda)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lior0 bits-tail)
-		  :use (olop-thm-1
-			hack-1
-			hack-2))))
diff -Nru acl2-6.2/books/rtl/rel5/support/lop2.lisp acl2-6.3/books/rtl/rel5/support/lop2.lisp
--- acl2-6.2/books/rtl/rel5/support/lop2.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lop2.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,20 +0,0 @@
-(in-package "ACL2")
-
-(include-book "lop1") ;BOZO
-(include-book "lior0");BOZO
-(local (include-book "lop2-proofs"))
-
-(defthm lop-thm-1-original
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (= e (expo a))
-                (< (expo b) e)
-                (= lambda
-                   (lior0 (* 2 (mod a (expt 2 e)))
-                         (lnot (* 2 b) (1+ e))
-                         (1+ e))))
-           (or (= (expo (- a b)) (expo lambda))
-               (= (expo (- a b)) (1- (expo lambda)))))
-  :rule-classes ())
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/lop3-proofs.lisp acl2-6.3/books/rtl/rel5/support/lop3-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/lop3-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lop3-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,2576 +0,0 @@
-(in-package "ACL2")
-
-(include-book "lop2")
-(local (include-book "../arithmetic/top"))
-(local (include-book "bitn"))
-(local (include-book "bits"))
-
-(local
- (defund C (k a b)
-   (- (bitn a k) (bitn b k))))
-
-(defund OLAMT (a b e)
-  (logxor a (lnot b (1+ e))))
-
-(defund OLAMG (a b e)
-  (logand a (lnot b (1+ e))))
-
-(defund OLAMZ (a b e)
-  (lnot (logior a (lnot b (1+ e))) (1+ e)))
-
-(defund OLAM1 (a b e)
-  (logand (bits (olamt a b e) e 2) 
-	  (logand (bits (olamg a b e) (1- e) 1)
-		  (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
-
-(defund OLAM2 (a b e)
-  (logand (lnot (bits (olamt a b e) e 2) (1- e))
-	  (logand (bits (olamz a b e) (1- e) 1)
-		  (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
-
-(defund OLAM3 (a b e)
-  (logand (bits (olamt a b e) e 2) 
-	  (logand (bits (olamz a b e) (1- e) 1)
-		  (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
-
-(defund OLAM4 (a b e)
-  (logand (lnot (bits (olamt a b e) e 2) (1- e))
-	  (logand (bits (olamg a b e) (1- e) 1)
-		  (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
-
-(defund OLAM0 (a b e)
-  (logior (olam1 a b e)
-	  (logior (olam2 a b e)
-		  (logior (olam3 a b e)
-			  (olam4 a b e)))))
-
-(defund OLAMB (a b e)
-  (+ (* 2 (olam0 a b e))
-     (lnot (bitn (olamt a b e) 0) 1)))
-
-(local (defthm bitn-olamt
-    (implies (and (integerp a)
-		  (>= a 0) ;(> a 0)
-		  (integerp b)
-		  (>= b 0) ;(> b 0)
-;		  (not (= a b))
-;		  (= e (expo a))
-		  (= e (expo b))
-;		  (> e 0)
-		  (integerp k)
-		  (>= k 0)
-		  (<= k e)
-                  )
-	     (iff (= (bitn (olamt a b e) k) 1)
-		  (= (c k a b) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable c olamt)
-		  :use ((:instance bitn-lnot-not-equal (x b) (n (1+ e)))
-			(:instance bitn-0-1 (x a) (n k))
-			(:instance bitn-0-1 (x b) (n k))
-			(:instance bitn-0-1 (x (lnot b (1+ e))) (n k))
-			(:instance expo-upper-bound (x b))
-			(:instance bitn-logxor (x a) (y (lnot b (1+ e))) (n k)))))))
-
-(defthm OLAMT-NAT
-  (implies (and (integerp a)
-                (>= a 0) ;(> a 0)
-;                (integerp b)
- ;               (> b 0)
-  ;              (not (= a b))
-   ;             (= e (expo a))
-    ;            (= e (expo b))
-     ;           (> e 0)
-                )
-           (and (integerp (olamt a b e))
-                (>= (olamt a b e) 0)))
-;  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olamt)
-           )))
-
-(local (defthm bitn-olamg
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 0)
-		  (integerp k)
-		  (>= k 0)
-		  (<= k e))
-	     (iff (= (bitn (olamg a b e) k) 1)
-		  (= (c k a b) 1)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d ( c olamg) (EXPO-BOUND-ERIC
-                                              EXPO-COMPARISON-REWRITE-TO-BOUND
-                                              EXPO-COMPARISON-REWRITE-TO-BOUND-2))
-		  :use ((:instance bitn-lnot-not-equal (x b) (n (1+ e)))
-			(:instance bitn-0-1 (x a) (n k))
-			(:instance bitn-0-1 (x b) (n k))
-			(:instance bitn-0-1 (x (lnot b (1+ e))) (n k))
-			(:instance expo-upper-bound (x b)))))))
-
-(defthm OLAMG-NAT
-    (implies (and (integerp a)
-		  (> a 0)
-                  )
-	     (and (integerp (olamg a b e))
-		  (>= (olamg a b e) 0)))
-;  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olamg))))
-
-(local (defthm bitn-olamz-1
-         (implies (and (integerp a)
-                       (> a 0)
-                       (integerp b)
-                       (> b 0)
-                       (not (= a b))
-                       (= e (expo a))
-                       (= e (expo b))
-                       (> e 0)
-                       (integerp k)
-                       (>= k 0)
-                       (<= k e))
-                  (iff (= (bitn (logior a (lnot b (1+ e))) k) 0)
-                       (= (c k a b) -1)))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (e/d (c) (EXPO-BOUND-ERIC
-                                              EXPO-COMPARISON-REWRITE-TO-BOUND
-                                              EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                                              BITN-KNOWN-NOT-0-REPLACE-WITH-1))
-		  :use ((:instance bitn-lnot-not-equal (x b) (n (1+ e)))
-			(:instance bitn-0-1 (x a) (n k))
-			(:instance bitn-0-1 (x b) (n k))
-			(:instance bitn-0-1 (x (lnot b (1+ e))) (n k))
-			(:instance expo-upper-bound (x b)))))))
-
-(local (defthm bitn-olamz
-         (implies (and (integerp a)
-                       (> a 0)
-                       (integerp b)
-                       (> b 0)
-                       (not (= a b))
-                       (= e (expo a))
-                       (= e (expo b))
-                       (> e 0)
-                       (integerp k)
-                       (>= k 0)
-                       (<= k e))
-                  (iff (= (bitn (olamz a b e) k) 1)
-                       (= (c k a b) -1)))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (set-difference-theories
-                                     (enable  olamz
-                                              bits-reduce)
-                                     '(BITN-KNOWN-NOT-0-REPLACE-WITH-1
-                                       EXPO-BOUND-ERIC
-                                       EXPO-COMPARISON-REWRITE-TO-BOUND
-                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2))
-		  :use (bitn-olamz-1
-			(:instance bitn-lnot-not-equal (x (logior a (lnot b (1+ e)))) (n (1+ e)))
-
-			(:instance bitn-0-1 (x (olamz a b e)) (n k))
-			(:instance bitn-0-1 (x (logior a (lnot b (1+ e)))) (n k))
-			(:instance expo-upper-bound (x b))
-                    ;			(:instance or-dist-a (x a) (y (lnot b (1+ e))) (n (1+ e)))
-			(:instance expo-upper-bound (x a)))))))
-
-(defthm OLAMZ-NAT
-    (implies (and (integerp a)
-		  (> a 0)
-;		  (integerp b)
-	;	  (> b 0)
-		;  (not (= a b))
-		 ; (= e (expo a))
-		 ; (= e (expo b))
-		  ;(> e 0)
-                  )
-	     (and (integerp (olamz a b e))
-		  (>= (olamz a b e) 0))))
-
-(local (defthm bitn-olam1-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (>= k 0))
-	     (equal (bitn (olam1 a b e) k)
-		    (logand (bitn (bits (olamt a b e) e 2) k)
-			    (logand (bitn (bits (olamg a b e) (1- e) 1) k)
-				    (bitn (lnot (bits (olamz a b e) (- e 2) 0) (1- e)) k)))))
-  :hints (("Goal" :in-theory (enable olam1)))))
-
-(local (defthm bitn-olam1-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (>= k 0))
-	     (iff (= (bitn (olam1 a b e) k) 1)
-		  (and (= (bitn (bits (olamt a b e) e 2) k) 1)
-		       (= (bitn (bits (olamg a b e) (1- e) 1) k) 1)
-		       (= (bitn (lnot (bits (olamz a b e) (- e 2) 0) (1- e)) k) 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable bits olam1 logand)
-		  :use ((:instance bitn-0-1 (x (bits (olamt a b e) e 2)) (n k))
-			(:instance bitn-0-1 (x (bits (olamg a b e) (1- e) 1)) (n k))
-			(:instance bitn-0-1 (x (lnot (bits (olamz a b e) (- e 2) 0) (1- e))) (n k)))))))
-
-(local (in-theory (disable bitn-olam1-1)))
-
-(local (defthm bitn-olam1-3
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam1 a b e) k) 1)
-		  (and (= (bitn (bits (olamt a b e) e 2) k) 1)
-		       (= (bitn (bits (olamg a b e) (1- e) 1) k) 1)
-		       (= (bitn (bits (olamz a b e) (- e 2) 0) k) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olam1 bits lnot logand)
-		  :use (;olamz-nat
-			bitn-olam1-2
-;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
-			(:instance bitn-0-1 (x (lnot (bits (olamz a b e) (- e 2) 0) (1- e))) (n k))
-			(:instance bitn-lnot-not-equal (x (bits (olamz a b e) (- e 2) 0)) (n (1- e)))
-			(:instance bitn-0-1 (x (bits (olamz a b e) (- e 2) 0)) (n k)))))))
-
-(local (defthm bitn-olam1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam1 a b e) k) 1)
-		  (and (= (bitn (olamt a b e) (+ 2 k)) 1)
-		       (= (bitn (olamg a b e) (+ 1 k)) 1)
-		       (= (bitn (olamz a b e) k) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olam1 bits logand)
-		  :use (;olamz-nat
-			;olamt-nat
-			;olamg-nat
-			bitn-olam1-3
-;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
-			(:instance bitn-0-1 (x (olamz a b e)) (n k))
-;			(:instance bitn-bits (x (olamt a b e)) (i e) (j 2))
-;			(:instance bitn-bits (x (olamg a b e)) (i (- e 1)) (j 1))
-	;		(:instance bitn-bits (x (olamz a b e)) (i (- e 2)) (j 0))
-                        )))))
-
-(defthm OLAM1-NAT
-    (implies (and (integerp a)
-		  (> a 0)
-		 ; (integerp b)
-		  ;(> b 0)
-	;	  (not (= a b))
-		;  (= e (expo a))
-		 ; (= e (expo b))
-		 ; (> e 1)
-		 ; (integerp k)
-		 ; (<= k (- e 2))
-		 ; (>= k 0)
-                  )
-	     (and (integerp (olam1 a b e))
-		  (>= (olam1 a b e) 0)))
-;  :rule-classes ()
-  :hints (("Goal" :in-theory (disable bits logand)
-		  :use (;olamz-nat
-			;olamt-nat
-			;olamg-nat
-;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
-                        ))))
-
-(local (defthm bitn-olam3-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (>= k 0))
-	     (equal (bitn (olam3 a b e) k)
-		    (logand (bitn (bits (olamt a b e) e 2) k)
-			    (logand (bitn (bits (olamz a b e) (1- e) 1) k)
-				    (bitn (lnot (bits (olamg a b e) (- e 2) 0) (1- e)) k)))))
-  :hints (("Goal" :in-theory (enable olam3)))))
-
-(local (defthm bitn-olam3-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (>= k 0))
-	     (iff (= (bitn (olam3 a b e) k) 1)
-		  (and (= (bitn (bits (olamt a b e) e 2) k) 1)
-		       (= (bitn (bits (olamz a b e) (1- e) 1) k) 1)
-		       (= (bitn (lnot (bits (olamg a b e) (- e 2) 0) (1- e)) k) 1))))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable bits olam3 logand)
-		  :use ((:instance bitn-0-1 (x (bits (olamt a b e) e 2)) (n k))
-			(:instance bitn-0-1 (x (bits (olamz a b e) (1- e) 1)) (n k))
-			(:instance bitn-0-1 (x (lnot (bits (olamg a b e) (- e 2) 0) (1- e))) (n k)))))))
-
-(local (in-theory (disable bitn-olam3-1)))
-
-(local (defthm bitn-olam3-3
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam3 a b e) k) 1)
-		  (and (= (bitn (bits (olamt a b e) e 2) k) 1)
-		       (= (bitn (bits (olamz a b e) (1- e) 1) k) 1)
-		       (= (bitn (bits (olamg a b e) (- e 2) 0) k) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olam3 bits lnot logand)
-		  :use (;olamg-nat
-			bitn-olam3-2
-;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
-			(:instance bitn-0-1 (x (lnot (bits (olamg a b e) (- e 2) 0) (1- e))) (n k))
-			(:instance bitn-lnot-not-equal (x (bits (olamg a b e) (- e 2) 0)) (n (1- e)))
-			(:instance bitn-0-1 (x (bits (olamg a b e) (- e 2) 0)) (n k)))))))
-
-(local (defthm bitn-olam3
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam3 a b e) k) 1)
-		  (and (= (bitn (olamt a b e) (+ 2 k)) 1)
-		       (= (bitn (olamz a b e) (+ 1 k)) 1)
-		       (= (bitn (olamg a b e) k) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olam3 bits logand)
-		  :use (;olamg-nat
-			;olamt-nat
-			;olamz-nat
-			bitn-olam3-3
-;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
-			(:instance bitn-0-1 (x (olamg a b e)) (n k))
-;			(:instance bitn-bits (x (olamt a b e)) (i e) (j 2))
-	;		(:instance bitn-bits (x (olamz a b e)) (i (- e 1)) (j 1))
-		;	(:instance bitn-bits (x (olamg a b e)) (i (- e 2)) (j 0))
-                        )))))
-
-(defthm OLAM3-NAT
-    (implies (and (integerp a)
-		  (> a 0)
-;		  (integerp b)
-	;	  (> b 0)
-;		  (not (= a b))
-	;	  (= e (expo a))
-		;  (= e (expo b))
-		 ; (> e 1)
-		 ; (integerp k)
-		 ; (<= k (- e 2))
-		 ; (>= k 0)
-                  )
-	     (and (integerp (olam3 a b e))
-		  (>= (olam3 a b e) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable bits logand)
-		  :use (;olamg-nat
-			;olamt-nat
-			;olamz-nat
-;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
-                        ))))
-
-(local (defthm bitn-olam2-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (>= k 0))
-	     (equal (bitn (olam2 a b e) k)
-		    (logand (bitn (lnot (bits (olamt a b e) e 2) (1- e)) k)
-			    (logand (bitn (bits (olamz a b e) (1- e) 1) k)
-				    (bitn (lnot (bits (olamz a b e) (- e 2) 0) (1- e)) k)))))
-  :hints (("Goal" :in-theory (enable olam2)))))
-
-(local (defthm bitn-olam2-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (>= k 0))
-	     (iff (= (bitn (olam2 a b e) k) 1)
-		  (and (= (bitn (lnot (bits (olamt a b e) e 2) (1- e)) k) 1)
-		       (= (bitn (bits (olamz a b e) (1- e) 1) k) 1)
-		       (= (bitn (lnot (bits (olamz a b e) (- e 2) 0) (1- e)) k) 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable bits olam2 logand)
-		  :use ((:instance bitn-0-1 (x (lnot (bits (olamt a b e) e 2) (1- e))) (n k))
-			(:instance bitn-0-1 (x (bits (olamz a b e) (1- e) 1)) (n k))
-			(:instance bitn-0-1 (x (lnot (bits (olamz a b e) (- e 2) 0) (1- e))) (n k)))))))
-
-(local (in-theory (disable bitn-olam2-1)))
-
-(local (defthm bitn-olam2-3
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam2 a b e) k) 1)
-		  (and (= (bitn (bits (olamt a b e) e 2) k) 0)
-		       (= (bitn (bits (olamz a b e) (1- e) 1) k) 1)
-		       (= (bitn (bits (olamz a b e) (- e 2) 0) k) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olam2 bits lnot logand)
-		  :use (;olamz-nat
-			;olamt-nat
-			bitn-olam2-2
-;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
-			(:instance bitn-0-1 (x (lnot (bits (olamt a b e) e 2) (1- e))) (n k))
-			(:instance bitn-lnot-not-equal (x (bits (olamt a b e) e 2)) (n (1- e)))
-			(:instance bitn-0-1 (x (bits (olamt a b e) e 2)) (n k))
-;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
-			(:instance bitn-0-1 (x (lnot (bits (olamz a b e) (- e 2) 0) (1- e))) (n k))
-			(:instance bitn-lnot-not-equal (x (bits (olamz a b e) (- e 2) 0)) (n (1- e)))
-			(:instance bitn-0-1 (x (bits (olamz a b e) (- e 2) 0)) (n k)))))))
-
-(local (defthm bitn-olam2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam2 a b e) k) 1)
-		  (and (= (bitn (olamt a b e) (+ 2 k)) 0)
-		       (= (bitn (olamz a b e) (+ 1 k)) 1)
-		       (= (bitn (olamz a b e) k) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olam2 bits logand)
-		  :use (;olamz-nat
-			;olamt-nat
-			bitn-olam2-3
-;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
-			(:instance bitn-0-1 (x (olamz a b e)) (n k))
-;			(:instance bitn-bits (x (olamt a b e)) (i e) (j 2))
-	;		(:instance bitn-bits (x (olamz a b e)) (i (- e 1)) (j 1))
-		;	(:instance bitn-bits (x (olamz a b e)) (i (- e 2)) (j 0))
-                        )))))
-
-(defthm OLAM2-NAT
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-;		  (> b 0)
-	;	  (not (= a b))
-		;  (= e (expo a))
-		 ; (= e (expo b))
-;		  (> e 1)
-	;	  (integerp k)
-		;  (<= k (- e 2))
-		 ; (>= k 0)
-                  )
-	     (and (integerp (olam2 a b e))
-		  (>= (olam2 a b e) 0)))
-;  :rule-classes ()
-  :hints (("Goal" :in-theory (disable bits logand)
-		  :use (;olamz-nat
-			;olamt-nat
-;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
-	;		(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
-))))
-
-(local (defthm bitn-olam4-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (>= k 0))
-	     (equal (bitn (olam4 a b e) k)
-		    (logand (bitn (lnot (bits (olamt a b e) e 2) (1- e)) k)
-			    (logand (bitn (bits (olamg a b e) (1- e) 1) k)
-				    (bitn (lnot (bits (olamg a b e) (- e 2) 0) (1- e)) k)))))
-  :hints (("Goal" :in-theory (enable olam4)))))
-
-(local (defthm bitn-olam4-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (>= k 0))
-	     (iff (= (bitn (olam4 a b e) k) 1)
-		  (and (= (bitn (lnot (bits (olamt a b e) e 2) (1- e)) k) 1)
-		       (= (bitn (bits (olamg a b e) (1- e) 1) k) 1)
-		       (= (bitn (lnot (bits (olamg a b e) (- e 2) 0) (1- e)) k) 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable bits olam4 logand)
-		  :use ((:instance bitn-0-1 (x (lnot (bits (olamt a b e) e 2) (1- e))) (n k))
-			(:instance bitn-0-1 (x (bits (olamg a b e) (1- e) 1)) (n k))
-			(:instance bitn-0-1 (x (lnot (bits (olamg a b e) (- e 2) 0) (1- e))) (n k)))))))
-
-(local (in-theory (disable bitn-olam4-1)))
-
-(local (defthm bitn-olam4-3
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam4 a b e) k) 1)
-		  (and (= (bitn (bits (olamt a b e) e 2) k) 0)
-		       (= (bitn (bits (olamg a b e) (1- e) 1) k) 1)
-		       (= (bitn (bits (olamg a b e) (- e 2) 0) k) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olam4 bits lnot logand)
-		  :use (;olamg-nat
-			;olamt-nat
-			bitn-olam4-2
-;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
-			(:instance bitn-0-1 (x (lnot (bits (olamt a b e) e 2) (1- e))) (n k))
-			(:instance bitn-lnot-not-equal (x (bits (olamt a b e) e 2)) (n (1- e)))
-			(:instance bitn-0-1 (x (bits (olamt a b e) e 2)) (n k))
-;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
-			(:instance bitn-0-1 (x (lnot (bits (olamg a b e) (- e 2) 0) (1- e))) (n k))
-			(:instance bitn-lnot-not-equal (x (bits (olamg a b e) (- e 2) 0)) (n (1- e)))
-			(:instance bitn-0-1 (x (bits (olamg a b e) (- e 2) 0)) (n k)))))))
-
-(local (defthm bitn-olam4
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam4 a b e) k) 1)
-		  (and (= (bitn (olamt a b e) (+ 2 k)) 0)
-		       (= (bitn (olamg a b e) (+ 1 k)) 1)
-		       (= (bitn (olamg a b e) k) 0))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olam4 bits logand)
-		  :use (;olamg-nat
-			;olamt-nat
-			bitn-olam4-3
-;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
-			(:instance bitn-0-1 (x (olamg a b e)) (n k))
-;			(:instance bitn-bits (x (olamt a b e)) (i e) (j 2))
-	;		(:instance bitn-bits (x (olamg a b e)) (i (- e 1)) (j 1))
-		;	(:instance bitn-bits (x (olamg a b e)) (i (- e 2)) (j 0))
-                        )))))
-
-(defthm OLAM4-NAT
-    (implies (and (integerp a)
-		  (> a 0)
-                  )
-	     (and (integerp (olam4 a b e))
-		  (>= (olam4 a b e) 0)))
-;  :rule-classes ()
-)
-
-(local (defthm bitn-olam0-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (equal (bitn (olam0 a b e) k) 
-		    (logior (bitn (olam1 a b e) k)
-			    (logior (bitn (olam2 a b e) k)
-				    (logior (bitn (olam3 a b e) k)
-					    (bitn (olam4 a b e) k))))))
-  :hints (("Goal" :in-theory (enable olam0)))))
-
-(local (defthm bitn-olam0-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam0 a b e) k) 1)
-		  (or (= (bitn (olam1 a b e) k) 1)
-		      (= (bitn (olam2 a b e) k) 1)
-		      (= (bitn (olam3 a b e) k) 1)
-		      (= (bitn (olam4 a b e) k) 1))))
-  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
-		  :use (;olam1-nat
-			;olam2-nat
-			;olam3-nat
-			;olam4-nat
-			(:instance bitn-0-1 (x (olam1 a b e)) (n k))
-			(:instance bitn-0-1 (x (olam2 a b e)) (n k))
-			(:instance bitn-0-1 (x (olam3 a b e)) (n k))
-			(:instance bitn-0-1 (x (olam4 a b e)) (n k)))))))
-
-(local (in-theory (disable bitn-olam0-1)))
-
-(local (defthm bitn-olam0-3
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam0 a b e) k) 1)
-		  (or (and (= (bitn (olamt a b e) (+ 2 k)) 1)
-			   (= (bitn (olamg a b e) (+ 1 k)) 1)
-			   (= (bitn (olamz a b e) k) 0))
-		      (and (= (bitn (olamt a b e) (+ 2 k)) 0)
-			   (= (bitn (olamz a b e) (+ 1 k)) 1)
-			   (= (bitn (olamz a b e) k) 0))
-		      (and (= (bitn (olamt a b e) (+ 2 k)) 1)
-			   (= (bitn (olamz a b e) (+ 1 k)) 1)
-			   (= (bitn (olamg a b e) k) 0))
-		      (and (= (bitn (olamt a b e) (+ 2 k)) 0)
-			   (= (bitn (olamg a b e) (+ 1 k)) 1)
-			   (= (bitn (olamg a b e) k) 0)))))
-  :hints (("Goal" :in-theory (disable olam0)
-		  :use (bitn-olam0-2 bitn-olam1 bitn-olam2 bitn-olam3 bitn-olam4)))))
-
-(local (defthm bitn-olam0-4
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam0 a b e) k) 1)
-		  (or (and (= (bitn (olamt a b e) (+ 2 k)) 1)
-			   (= (bitn (olamg a b e) (+ 1 k)) 1)
-			   (not (= (bitn (olamz a b e) k) 1)))
-		      (and (not (= (bitn (olamt a b e) (+ 2 k)) 1))
-			   (= (bitn (olamz a b e) (+ 1 k)) 1)
-			   (not (= (bitn (olamz a b e) k) 1)))
-		      (and (= (bitn (olamt a b e) (+ 2 k)) 1)
-			   (= (bitn (olamz a b e) (+ 1 k)) 1)
-			   (not (= (bitn (olamg a b e) k) 1)))
-		      (and (not (= (bitn (olamt a b e) (+ 2 k)) 1))
-			   (= (bitn (olamg a b e) (+ 1 k)) 1)
-			   (not (= (bitn (olamg a b e) k) 1))))))
-  :hints (("Goal" :in-theory (disable olam0)
-		  :use (bitn-olam0-3
-			(:instance bitn-0-1 (x (olamz a b e)) (n k))
-			(:instance bitn-0-1 (x (olamg a b e)) (n k))
-			(:instance bitn-0-1 (x (olamt a b e)) (n (+ 2 k))))))))
-
-(local (defthm c-0-1
-         (or (= (c k a b) 0)
-             (= (c k a b) 1)
-             (= (c k a b) -1))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (enable c)
-                  :use ((:instance bitn-0-1 (x a) (n k))
-			(:instance bitn-0-1 (x b) (n k)))))))
-
-(local (defthm bitn-olam0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (iff (= (bitn (olam0 a b e) k) 1)
-		  (and (not (= (c (1+ k) a b) 0))
-		       (not (= (c (1+ k) a b)
-			       (if (= (c (+ 2 k) a b) 0)
-				   (- (c k a b))
-				 (c k a b)))))))
-  :hints (("Goal" :in-theory (disable c olam0
-                                      EXPO-COMPARISON-REWRITE-TO-BOUND-2
-                                      EXPO-COMPARISON-REWRITE-TO-BOUND)
-		  :use (bitn-olam0-4
-			bitn-olamg
-			bitn-olamz
-			c-0-1
-			(:instance c-0-1 (k (+ 1 k)))
-			(:instance c-0-1 (k (+ 2 k)))
-			(:instance bitn-olamt (k (+ 2 k)))
-			(:instance bitn-olamz (k (1+ k)))
-			(:instance bitn-olamg (k (1+ k))))))))
-
-(defthm OLAM0-NAT
-    (implies (and (integerp a)
-		  (> a 0)
-                  )
-	     (and (integerp (olam0 a b e))
-		  (>= (olam0 a b e) 0)))
-;  :rule-classes ()
-  :hints (("Goal" :in-theory (disable logior))))
-
-(defthm OLAMB-NAT
-    (implies (and (integerp a)
-		  (> a 0)
-;		  (integerp b)
-	;	  (> b 0)
-		;  (not (= a b))
-		 ; (= e (expo a))
-		 ; (= e (expo b))
-		 ; (> e 1)
-                  )
-	     (and (integerp (olamb a b e))
-		  (>= (olamb a b e) 0)))
-;  :rule-classes ()
-  :hints (("Goal" :use (;olam0-nat
-			(:instance bitn-0-1 (x (olamt a b e)) (n 0))))))
-
-(local (defthm bitn-olamb-1
-         (implies (and (integerp a)
-                       (> a 0)
-                       (integerp b)
-                       (> b 0)
-                       (not (= a b))
-                       (= e (expo a))
-                       (= e (expo b))
-                       (> e 1))
-                  (= (fl (/ (olamb a b e) 2))
-                     (olam0 a b e)))
-         :hints (("Goal" :in-theory (enable olamb)
-                  :use ( ;olam0-nat
-			(:instance fl-unique (x (/ (olamb a b e) 2)) (n (olam0 a b e)))
-			(:instance bitn-0-1 (x (olamt a b e)) (n 0)))))))
-
-
-(local (defthm bitn-olamb-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp n)
-		  (> n 0))
-	     (= (bitn (olamb a b e) n)
-		(bitn (olam0 a b e) (1- n))))
-  :hints (("Goal" :use (;olamb-nat
-			bitn-olamb-1
-			(:instance bitn-rec-pos (x (olamb a b e)) (n n)))))))
-
-(local (defthm bitn-olamb
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp n)
-		  (<= n (- e 1))
-		  (> n 0))
-	     (iff (= (bitn (olamb a b e) n) 1)
-		  (and (not (= (c n a b) 0))
-		       (not (= (c n a b)
-			       (if (= (c (+ n 1) a b) 0)
-				   (- (c (1- n) a b))
-				 (c (1- n) a b)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
-                                      EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-		  :use (;bitn-olamb-2
-			(:instance bitn-olam0 (k (1- n))))))))
-
-
-(local (defthm lop3-1
-    (implies (and (integerp a)
-		  (>= a 0)
-		  (integerp b)
-		  (>= b 0)
-		  (integerp n)
-		  (> n 0)
-		  (= (mod a (expt 2 n)) (mod b (expt 2 n)))
-		  (= (bitn a n) (bitn b n)))
-	     (= (mod a (expt 2 (1+ n)))
-		(mod b (expt 2 (1+ n)))))
-  :rule-classes ()
-  :hints (("Goal" :use (mod-n+1
-			(:instance mod-n+1 (a b)))))))
-
-(local (defthm lop3-2
-    (implies (and (integerp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (= (bitn x n) 1))
-	     (= (expo (mod x (expt 2 (1+ n))))
-		n))
-  :rule-classes ()
-  :hints (("Goal" :use (;(:instance mod>=0 (m x) (n (expt 2 (1+ n))))
-			(:instance mod-bnd-1 (m x) (n (expt 2 (1+ n))))
-			(:instance expo-unique (x (mod x (expt 2 (1+ n)))))
-			(:instance bitn-mod (n (1+ n)) (k n))
-			(:instance bit-expo-a (x (mod x (expt 2 (1+ n))))))))))
-
-(local (defthm lop3-3
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (= (c n a b) 0)
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (MOD (OLAMB A B E) (EXPT 2 N)) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 N)))
-			    (lop a b (c (1- n) a b) (1- n)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (e/d ( lop c) (EXPO-COMPARISON-REWRITE-TO-BOUND-2))
-                  :use (lop3-1)))))
-
-(local (defthm lop3-4
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (= (c n a b) 0)
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (bitn (olamb a b e) n) 0))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-           :use (bitn-olamb
-			(:instance bitn-0-1 (x (olamb a b e))))))))
-
-(local (defthm lop3-5
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (= (c n a b) 0)
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (mod (olamb a b e) (expt 2 (1+ n)))
-		(mod (olamb a b e) (expt 2 n))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-4
-			;olamb-nat
-			(:instance mod-n+1 (a (olamb a b e))))))))
-
-(local (defthm lop3-6
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (= (c n a b) 0)
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (lop a b (c n a b) n)
-		(lop a b (c (1- n) a b) (1- n))))
-    :hints (("Goal" :in-theory (enable lop c)))
-  :rule-classes ()))
-
-(local (defthm lop3-7
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (= (c n a b) 0)
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
-			    (IF (OR (= (C N A B) 0)
-				    (= (C (+ 1 N) A B) 0))
-				(LOP A B (C N A B) N)
-				(LOP A B (- (C N A B)) N)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (disable lop)
-			 :use (lop3-3 lop3-5 lop3-6)))))
-
-(local (defthm lop3-8
-    (implies (and (integerp a)
-		  (>= a 0)
-		  (integerp b)
-		  (>= b 0)
-		  (integerp n)
-		  (>= n 0)
-		  (= (mod a (expt 2 (1+ n))) (mod b (expt 2 (1+ n)))))
-	     (= (bitn a n) (bitn b n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance bitn-mod (x a) (n (1+ n)) (k n))
-			(:instance bitn-mod (x b) (n (1+ n)) (k n)))))))
-
-(local (defthm lop3-8-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (integerp n)
-		  (> n 0)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (not (= (mod (olamb a b e) (expt 2 n)) 0)))
-	     (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable olamb)
-		  :use (;olamb-nat
-			(:instance mod-does-nothing (m 0) (n (expt 2 n)))
-			(:instance mod-of-mod-cor (x (olamb a b e)) (a (1+ n)) (b n)))))))
-
-(local (defthm lop3-9
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (= (c (1+ n) a b) 0)
-			 (= (c (1- n) a b) (- (c n a b)))
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 N)))
-			    (lop a b (- (c (1- n) a b)) (1- n)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (e/d ( lop c) (EXPO-COMPARISON-REWRITE-TO-BOUND-2))
-                  :use (lop3-8-1
-			       (:instance lop3-8 (n (1- n))))))))
-
-(local (defthm lop3-10
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (= (c (1+ n) a b) 0)
-		  (= (c (1- n) a b) (- (c n a b)))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (bitn (olamb a b e) n) 0))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-           :use (bitn-olamb
-			(:instance bitn-0-1 (x (olamb a b e))))))))
-
-(local (defthm lop3-11
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (= (c (1+ n) a b) 0)
-		  (= (c (1- n) a b) (- (c n a b)))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (mod (olamb a b e) (expt 2 (1+ n)))
-		(mod (olamb a b e) (expt 2 n))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-10
-			;olamb-nat
-			(:instance mod-n+1 (a (olamb a b e))))))))
-
-(local (defthm lop3-12
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (= (c (1+ n) a b) 0)
-		  (= (c (1- n) a b) (- (c n a b)))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (lop a b (- (c (1- n) a b)) n)
-		(lop a b (- (c (1- n) a b)) (1- n))))
-    :hints (("Goal" :in-theory (enable lop c)))
-  :rule-classes ()))
-
-(local (defthm lop3-13
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (= (c (1+ n) a b) 0)
-		  (= (c (1- n) a b) (- (c n a b)))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (INTEGERP N)
-		  (<= 0 N))
-	     (EQUAL (LOP A B (* -1 (C (+ -1 N) A B)) (+ -1 N))
-		    (LOP A B (C N A B) N)))
-    :hints (("Goal" :in-theory (enable lop c)))))
-
-(local (defthm lop3-14
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (= (c (1+ n) a b) 0)
-			 (= (c (1- n) a b) (- (c n a b)))
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
-			    (IF (OR (= (C N A B) 0)
-				    (= (C (+ 1 N) A B) 0))
-				(LOP A B (C N A B) N)
-				(LOP A B (- (C N A B)) N)))))
-	 :rule-classes ()
-	 :hints (("Goal" :use (lop3-9 lop3-11 lop3-12)))))
-
-(local (defthm lop3-15
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (= (c (1+ n) a b) 0)
-		  (not (= (c (1- n) a b) (- (c n a b))))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (bitn (olamb a b e) n) 1))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-           :use (bitn-olamb)))))
-
-(local (defthm lop3-16
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (= (c (1+ n) a b) 0)
-		  (not (= (c (1- n) a b) (- (c n a b))))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-		  (= (expo (mod (olamb a b e) (expt 2 (1+ n)))) n)))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-15
-			;olamb-nat
-			(:instance lop3-2 (x (olamb a b e))))))))
-
-(local (defthm lop3-17
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (= (c (1+ n) a b) 0)
-		  (not (= (c (1- n) a b) (- (c n a b))))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (lop a b (c n a b) n) n))
-    :hints (("Goal" :in-theory (enable lop c)))
-  :rule-classes ()))
-
-(local (defthm lop3-18
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (= (c (1+ n) a b) 0)
-			 (not (= (c (1- n) a b) (- (c n a b))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
-			    (IF (OR (= (C N A B) 0)
-				    (= (C (+ 1 N) A B) 0))
-				(LOP A B (C N A B) N)
-				(LOP A B (- (C N A B)) N)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (disable lop c)
-			 :use (lop3-16 lop3-17)))))
-
-(local (defthm lop3-19
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (= (c (1+ n) a b) 0)
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
-			    (IF (OR (= (C N A B) 0)
-				    (= (C (+ 1 N) A B) 0))
-				(LOP A B (C N A B) N)
-				(LOP A B (- (C N A B)) N)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (disable lop c)
-			 :use (lop3-14 lop3-18)))))
-
-(local (defthm lop3-20
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (not (= (c (1+ n) a b) 0))
-			 (= (c (1- n) a b) (c n a b))
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 N)))
-			    (lop a b (- (c (1- n) a b)) (1- n)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (e/d ( lop c) (EXPO-COMPARISON-REWRITE-TO-BOUND-2))
-                  :use (lop3-8-1
-			       (:instance lop3-8 (n (1- n))))))))
-
-(local (in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2))) ;yuck
-
-(local (defthm lop3-21
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (not (= (c (1+ n) a b) 0))
-		  (= (c (1- n) a b) (c n a b))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (bitn (olamb a b e) n) 0))
-  :rule-classes ()
-  :hints (("Goal" :use (bitn-olamb
-			(:instance bitn-0-1 (x (olamb a b e))))))))
-
-(local (defthm lop3-22
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (not (= (c (1+ n) a b) 0))
-		  (= (c (1- n) a b) (c n a b))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (mod (olamb a b e) (expt 2 (1+ n)))
-		(mod (olamb a b e) (expt 2 n))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-21
-			;olamb-nat
-			(:instance mod-n+1 (a (olamb a b e))))))))
-
-(local (defthm lop3-23
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (not (= (c (1+ n) a b) 0))
-		  (= (c (1- n) a b) (c n a b))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (lop a b (- (c (1- n) a b)) n)
-		(lop a b (- (c (1- n) a b)) (1- n))))
-    :hints (("Goal" :in-theory (enable lop c)))
-  :rule-classes ()))
-
-(local (defthm lop3-24
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (not (= (c (1+ n) a b) 0))
-		  (= (c (1- n) a b) (c n a b))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (INTEGERP N)
-		  (<= 0 N))
-	     (EQUAL (LOP A B (* -1 (C (+ -1 N) A B)) (+ -1 N))
-		    (LOP A B (- (C N A B)) N)))
-    :hints (("Goal" :in-theory (enable lop c)))))
-
-(local (defthm lop3-25
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (not (= (c (1+ n) a b) 0))
-			 (= (c (1- n) a b) (c n a b))
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
-			    (IF (OR (= (C N A B) 0)
-				    (= (C (+ 1 N) A B) 0))
-				(LOP A B (C N A B) N)
-				(LOP A B (- (C N A B)) N)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (disable lop c)
-			 :use (lop3-20 lop3-22 lop3-23)))))
-
-(local (defthm lop3-26
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (not (= (c (1+ n) a b) 0))
-		  (not (= (c (1- n) a b) (c n a b)))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (bitn (olamb a b e) n) 1))
-  :rule-classes ()
-  :hints (("Goal" :use (bitn-olamb)))))
-
-(local (defthm lop3-27
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (not (= (c (1+ n) a b) 0))
-			 (not (= (c (1- n) a b) (c n a b)))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (expo (mod (olamb a b e) (expt 2 (1+ n)))) n)))
-	 :rule-classes ()
-	 :hints (("Goal" :use (lop3-26
-			       ;olamb-nat
-			       (:instance lop3-2 (x (olamb a b e))))))))
-
-(local (defthm lop3-28
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (not (= (c n a b) 0))
-		  (not (= (c (1+ n) a b) 0))
-		  (not (= (c (1- n) a b) (c n a b)))
-		  (INTEGERP A)
-		  (< 0 A)
-		  (INTEGERP B)
-		  (< 0 B)
-		  (= E (EXPO A))
-		  (= E (EXPO B))
-		  (< 0 E)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (< N E)
-		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-			  (MOD B (EXPT 2 (+ 1 N))))))
-	     (= (lop a b (- (c n a b)) n) n))
-    :hints (("Goal" :in-theory (enable lop c)))
-    :rule-classes ()))
-
-(local (defthm lop3-29
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (not (= (c (1+ n) a b) 0))
-			 (not (= (c (1- n) a b) (c n a b)))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
-			    (IF (OR (= (C N A B) 0)
-				    (= (C (+ 1 N) A B) 0))
-				(LOP A B (C N A B) N)
-				(LOP A B (- (C N A B)) N)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (disable lop c)
-			 :use (lop3-27 lop3-28)))))
-
-(local (defthm lop3-30
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (not (= (c n a b) 0))
-			 (not (= (c (1+ n) a b) 0))
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
-			    (IF (OR (= (C N A B) 0)
-				    (= (C (+ 1 N) A B) 0))
-				(LOP A B (C N A B) N)
-				(LOP A B (- (C N A B)) N)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (disable lop c)
-			 :use (lop3-25 lop3-29)))))
-
-(local (defthm lop3-31
-	   (IMPLIES (AND (INTEGERP N)
-			 (< 0 N)
-			 (IMPLIES (AND (INTEGERP A)
-				       (< 0 A)
-				       (INTEGERP B)
-				       (< 0 B)
-				       (= E (EXPO A))
-				       (= E (EXPO B))
-				       (< 0 E)
-				       (INTEGERP (+ -1 N))
-				       (<= 0 (+ -1 N))
-				       (< (+ -1 N) E)
-				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
-					       (MOD B (EXPT 2 (+ 1 -1 N))))))
-				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
-				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
-					  (IF (OR (= (C (+ -1 N) A B) 0)
-						  (= (C (+ 1 -1 N) A B) 0))
-					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
-					      (LOP A B (- (C (+ -1 N) A B))
-						   (+ -1 N))))))
-			 (INTEGERP A)
-			 (< 0 A)
-			 (INTEGERP B)
-			 (< 0 B)
-			 (= E (EXPO A))
-			 (= E (EXPO B))
-			 (< 0 E)
-			 (INTEGERP N)
-			 (<= 0 N)
-			 (< N E)
-			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
-				 (MOD B (EXPT 2 (+ 1 N))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
-			    (IF (OR (= (C N A B) 0)
-				    (= (C (+ 1 N) A B) 0))
-				(LOP A B (C N A B) N)
-				(LOP A B (- (C N A B)) N)))))
-	 :rule-classes ()
-	 :hints (("Goal" :use (lop3-30 lop3-19
-                                       lop3-7)))))
-
-(local (defthm lop3-32
-    (implies (and (integerp x)
-		  (> x 0)
-		  (= (expo x) 1))
-	     (or (= x 2) (= x 3)))
-  :rule-classes ()
-  :hints (("Goal" :use (expo-upper-bound expo-lower-bound)))))
-
-
-
-(local (defthm lop3-33
-	   (implies (and (integerp a)
-			 (> a 0)
-			 (integerp b)
-			 (> b 0)
-			 (= e (expo a))
-			 (= e (expo b))
-			 (> e 0)
-			 (not (= (mod a 2) (mod b 2))))
-		    (equal (expo (mod (olamb a b e) 2)) 0))
-	 :hints (("Goal" :use (;olamb-natural
-			       (:instance mod012 (m (olamb a b e))))))))
-
-(local (in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)))
-
-(local (defthm lop3-33-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-	          (not (= (bitn a 0) (bitn b 0))))
-	     (= (bitn a 0) (bitn (lnot b (1+ e)) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expo-upper-bound (x b))
-			(:instance bitn-lnot-not-equal (x b) (n (1+ e)) (k 0))
-			(:instance bitn-0-1 (x a) (n 0))
-			(:instance bitn-0-1 (x b) (n 0))
-			(:instance bitn-0-1 (x (lnot b (1+ e))) (n 0)))))))
-
-(local (defthm lop3-33-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-	          (not (= (mod a 2) (mod b 2))))
-	     (= (bitn a 0) (bitn (lnot b (1+ e)) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-33-1
-			(:instance bitn-def (x a) (n 0))
-			(:instance bitn-def (x b) (n 0)))))))
-
-(local (defthm lop3-33-3
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-	          (not (= (mod a 2) (mod b 2))))
-	     (= (bitn (olamt a b e) 0) 0))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olamt)
-		  :use (lop3-33-2
-			(:instance expo-upper-bound (x b))
-			(:instance bitn-logxor (x a) (y (lnot b (1+ e))) (n 0))
-			(:instance bitn-0-1 (x a) (n 0)))))))
-
-(local (defthm lop3-33-4
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-	          (not (= (mod a 2) (mod b 2))))
-	     (not (= (mod (olamb a b e) 2) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olamb)
-		  :use (lop3-33-3
-;			olam0-nat
-;			(:instance mod+-thm (m 1) (n 2) (a (olam0 a b e)))
-                             )))))
-
-(local (defthm lop3-34
-	   (implies (and (integerp a)
-			 (> a 0)
-			 (integerp b)
-			 (> b 0)
-			 (= e (expo a))
-			 (= e (expo b))
-			 (> e 1)
-			 (integerp n)
-			 (>= n 0)
-			 (< n e)
-			 (not (= (mod a (expt 2 (1+ n)))
-				 (mod b (expt 2 (1+ n))))))
-		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
-			 (= (expo (mod (olamb a b e) (expt 2 (1+ n))))
-			    (if (or (= (c n a b) 0)
-				    (= (c (1+ n) a b) 0))
-				(lop a b (c n a b) n)
-			      (lop a b (- (c n a b)) n)))))
-	 :rule-classes ()
-	 :hints (("Goal" :in-theory (e/d (lop) (olamb))
-			 :induct (natp-induct n))
-		 ("Subgoal *1/2"; :in-theory (disable lop c)
-				 :use (lop3-31))
-		 ("Subgoal *1/1" :use lop3-33-4))))
-
-(defthm OLAM1-BND
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (< (olam1 a b e) (expt 2 (- e 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olam1)
-		  :use (;olamz-nat
-			;olamt-nat
-			;olamg-nat
-;			(:instance lnot-bnds (x (bits (olamz a b e) (- e 2) 0)) (n (1- e)))
-;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
-	;		(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
-			(:instance logand-bnd
-				   (x (bits (olamt a b e) e 2))
-				   (y (logand (bits (olamg a b e) (1- e) 1)
-					      (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))))))
-
-(defthm OLAM3-BND
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (< (olam3 a b e) (expt 2 (- e 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olam3)
-		  :use (;olamg-nat
-			;olamt-nat
-			;olamz-nat
-;			(:instance lnot-bnds (x (bits (olamg a b e) (- e 2) 0)) (n (1- e)))
-;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
-	;		(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
-			(:instance logand-bnd ;and-dist-a
-				   (x (bits (olamt a b e) e 2))
-				   (y (logand (bits (olamz a b e) (1- e) 1)
-					      (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
-))))
-
-(defthm OLAM2-BND
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (< (olam2 a b e) (expt 2 (- e 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olam2)
-		  :use (;olamz-nat
-			;olamt-nat
-;			(:instance lnot-bnds (x (bits (olamt a b e) e 2)) (n (1- e)))
-	;		(:instance lnot-bnds (x (bits (olamz a b e) (- e 2) 0)) (n (1- e)))
-;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
-	;		(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
-			(:instance logand-bnd 
-				   (x (lnot (bits (olamt a b e) e 2) (1- e)))
-				   (y (logand (bits (olamz a b e) (1- e) 1)
-					      (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
-))))
-
-(defthm OLAM4-BND
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (integerp k)
-		  (<= k (- e 2))
-		  (>= k 0))
-	     (< (olam4 a b e) (expt 2 (- e 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olam4)
-		  :use (;olamg-nat
-			;olamt-nat
-;			(:instance lnot-bnds (x (bits (olamt a b e) e 2)) (n (1- e)))
-	;		(:instance lnot-bnds (x (bits (olamg a b e) (- e 2) 0)) (n (1- e)))
-;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
-	;		(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
-			(:instance logand-bnd
-				   (x (lnot (bits (olamt a b e) e 2) (1- e)))
-				   (y (logand (bits (olamg a b e) (1- e) 1)
-					      (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
-))))
-
-(local (in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)))
-
-(local (defthm olam0-bnd-1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (and (integerp (logior (olam3 a b e) (olam4 a b e)))
-		  (>= (logior (olam3 a b e) (olam4 a b e))
-		      0)
-		  (< (logior (olam3 a b e) (olam4 a b e))
-		     (expt 2 (- e 1)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable)
-		  :use ((:instance olam3-bnd (k 0))
-			(:instance olam4-bnd (k 0))
-;			(:instance olam3-nat)
-	;		(:instance olam4-nat)
-;			(:instance or-dist-a (n (- e 1)) (x (olam3 a b e)) (y (olam4 a b e)))
-)))))
-
-(local (defthm olam0-bnd-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (and (integerp (logior (olam2 a b e)
-				    (logior (olam3 a b e)
-					    (olam4 a b e))))
-		  (>= (logior (olam2 a b e)
-			      (logior (olam3 a b e)
-				      (olam4 a b e)))
-		      0)
-		  (< (logior (olam2 a b e)
-			     (logior (olam3 a b e)
-				     (olam4 a b e)))
-		     (expt 2 (- e 1)))))
-  :rule-classes ()
-  :hints (("Goal" :use (olam0-bnd-1
-			(:instance olam2-bnd (k 0))
-;			(:instance olam2-nat)
-;			(:instance or-dist-a
-	;			   (n (- e 1))
-		;		   (x (olam2 a b e))
-			;	   (y (logior (olam3 a b e) (olam4 a b e))))
-                        )))))
-
-(defthm OLAM0-BND
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (< (olam0 a b e) (expt 2 (- e 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olam0)
-		  :use (olam0-bnd-2
-			;(:instance olam1-nat)
-			(:instance olam1-bnd (k 0))
-;			(:instance or-dist-a
-	;			   (n (- e 1))
-		;		   (x (olam1 a b e))
-			;	   (y (logior (olam2 a b e)
-				;	      (logior (olam3 a b e)
-					;	      (olam4 a b e)))))
-                        ))))
-
-(defthm OLAMB-BND
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (< (olamb a b e) (expt 2 e)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable olamb expt ;yuck!
-                                     )
-           :use (olam0-bnd
-			;olam0-nat
-			(:instance bitn-0-1 (x (olamt a b e)) (n 0))))))
-
-(local (defthm olamb-mod
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (= (mod (olamb a b e) (expt 2 e))
-		(olamb a b e)))
-  :rule-classes ()
-  :hints (("Goal" :use (olamb-bnd
-			;olamb-nat
-			(:instance mod-does-nothing (m (olamb a b e)) (n (expt 2 e))))))))
-
-(local (defthm lop3-35
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (= (c e a b) 0)
-		  (not (= (mod a (expt 2 e))
-			  (mod b (expt 2 e)))))
-	     (and (not (= (mod (olamb a b e) (expt 2 e)) 0))
-		  (= (expo (mod (olamb a b e) (expt 2 e)))
-		     (lop a b (c (- e 1) a b) (- e 1)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance lop3-34 (n (- e 1))))))))
-
-(local (defthm lop3-36
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (= (c e a b) 0)
-		  (not (= (mod a (expt 2 e))
-			  (mod b (expt 2 e)))))
-	     (and (not (= (olamb a b e) 0))
-		  (= (expo (olamb a b e))
-		     (lop a b (c (- e 1) a b) (- e 1)))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-35 olamb-mod)))))
-
-(local (defthm lop3-37
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1)
-		  (not (= (mod a (expt 2 e))
-			  (mod b (expt 2 e)))))
-	     (and (not (= (olamb a b e) 0))
-		  (= (expo (olamb a b e))
-		     (lop a b (c (- e 1) a b) (- e 1)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop c)
-           :use (lop3-36
-			(:instance expo-upper-bound (x a))
-			(:instance expo-upper-bound (x b))
-			(:instance expo-lower-bound (x a))
-			(:instance expo-lower-bound (x b))
-			(:instance bit-expo-b (x a) (n e))
-			(:instance bit-expo-b (x b) (n e)))))))
-
-(local (defthm lop3-38
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (and (not (= (olamb a b e) 0))
-		  (= (expo (olamb a b e))
-		     (lop a b (c (- e 1) a b) (- e 1)))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-37
-			(:instance expo-upper-bound (x a))
-			(:instance expo-upper-bound (x b))
-			(:instance expo-lower-bound (x a))
-			(:instance expo-lower-bound (x b))
-			(:instance bit-expo-b (x a) (n e))
-			(:instance bit-expo-b (x b) (n e))
-			(:instance mod-does-nothing (m a) (n (expt 2 (1+ e))))
-			(:instance mod-does-nothing (m b) (n (expt 2 (1+ e))))
-			(:instance lop3-1 (n e)))))))
-
-(local (defthm lop3-39
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (= (lop a b 0 (1+ e))
-		(lop a b (c (- e 1) a b) (- e 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lop c)
-           :use ((:instance expo-upper-bound (x a))
-			(:instance expo-upper-bound (x b))
-			(:instance expo-lower-bound (x a))
-			(:instance expo-lower-bound (x b))
-			(:instance bit-expo-b (x a) (n e))
-			(:instance bit-expo-b (x b) (n e)))))))
-
-(local (defthm lop3-40
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (= (expo (olamb a b e))
-		(lop a b 0 (1+ e))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-38 lop3-39)))))
-
-(defthm olop-thm-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (and (not (= (olamb a b e) 0))
-		  (or (= (expo (- a b)) (expo (olamb a b e)))
-		      (= (expo (- a b)) (1- (expo (olamb a b e)))))))
-  :rule-classes ()
-  :hints (("Goal" :use (lop3-40
-			lop3-38
-			(:instance lop-bnds (n (1+ e)))
-			(:instance expo-upper-bound (x a))
-			(:instance expo-upper-bound (x b))))))
-
-
-
-
-
-
-
-(include-book "land0")
-(include-book "lior0")
-(include-book "lxor0")
-
-(defun lamt-0 (a b e)
-  (lxor0 a (lnot b (1+ e)) (1+ e)))
-
-(defun lamg-0 (a b e)
-  (land0 a (lnot b (1+ e)) (1+ e)))
-
-(defun lamz-0 (a b e)
-  (lnot (lior0 a (lnot b (1+ e)) (1+ e)) (1+ e)))
-
-(defun lam1-0 (a b e)
-  (land0 (bits (lamt-0 a b e) e 2) 
-	(land0 (bits (lamg-0 a b e) (1- e) 1)
-	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam2-0 (a b e)
-  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
-	(land0 (bits (lamz-0 a b e) (1- e) 1)
-	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam3-0 (a b e)
-  (land0 (bits (lamt-0 a b e) e 2) 
-	(land0 (bits (lamz-0 a b e) (1- e) 1)
-	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam4-0 (a b e)
-  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
-	(land0 (bits (lamg-0 a b e) (1- e) 1)
-	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam0-0 (a b e)
-  (lior0 (lam1-0 a b e)
-	(lior0 (lam2-0 a b e)
-	      (lior0 (lam3-0 a b e)
-		    (lam4-0 a b e)
-		    (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lamb-0 (a b e)
-  (+ (* 2 (lam0-0 a b e))
-     (lnot (bitn (lamt-0 a b e) 0) 1)))
-
-(in-theory (enable bits-tail bvecp-expo))
-
-(local
-(defthm bvecp-lamt-0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (bvecp (lamt-0 a b e) (+ 1 e))))
-)
-
-(local
-(defthm lamt-0-olamt
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lamt-0 a b e) (olamt a b e)))
-  :hints (("Goal" :in-theory (enable olamt land0 lior0 lxor0))))
-)
-
-(local
-(defthm bvecp-lamg-0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (bvecp (lamg-0 a b e) (+ 1 e))))
-)
-
-(local
-(defthm lamg-0-olamg
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lamg-0 a b e) (olamg a b e)))
-  :hints (("Goal" :in-theory (enable olamg land0 lior0 lxor0))))
-)
-
-(local
-(defthm bvecp-lamz-0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (bvecp (lamz-0 a b e) (+ 1 e))))
-)
-
-(local
-(defthm lamz-0-olamz
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lamz-0 a b e) (olamz a b e)))
-  :hints (("Goal" :in-theory (enable olamz land0 lior0 lxor0))))
-)
-
-(local
-(defthm bvecp-lam1-0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (bvecp (lam1-0 a b e) (+ -1 e))))
-)
-
-(local
-(defthm lam1-0-olam1
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lam1-0 a b e) (olam1 a b e)))
-  :hints (("Goal" :in-theory (enable olam1 land0 lior0 lxor0)
-		  :use (bvecp-lamt-0 bvecp-lamz-0 bvecp-lamg-0))))
-)
-
-(local
-(defthm bvecp-lam2-0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (bvecp (lam2-0 a b e) (+ -1 e))))
-)
-
-(local
-(defthm lam2-0-olam2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lam2-0 a b e) (olam2 a b e)))
-  :hints (("Goal" :in-theory (enable olam2 land0 lior0 lxor0))))
-)
-
-(local
-(defthm bvecp-lam3-0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (bvecp (lam3-0 a b e) (+ -1 e))))
-)
-
-(local
-(defthm lam3-0-olam3
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lam3-0 a b e) (olam3 a b e)))
-  :hints (("Goal" :in-theory (enable olam3 land0 lior0 lxor0))))
-)
-
-(local
-(defthm bvecp-lam4-0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (bvecp (lam4-0 a b e) (+ -1 e))))
-)
-
-(local
-(defthm lam4-0-olam4
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lam4-0 a b e) (olam4 a b e)))
-  :hints (("Goal" :in-theory (enable olam4 land0 lior0 lxor0))))
-)
-
-(local
-(defthm bvecp-lam0-0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (bvecp (lam0-0 a b e) (+ -1 e))))
-)
-
-(local
-(defthm lam0-0-olam0
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lam0-0 a b e) (olam0 a b e)))
-  :hints (("Goal" :in-theory (enable olam0 land0 lior0 lxor0)
-		  :use (bvecp-lam1-0 bvecp-lam2-0 bvecp-lam3-0 bvecp-lam4-0))))
-)
-
-(local
-(defthm lamb-0-olamb
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (equal (lamb-0 a b e) (olamb a b e)))
-  :hints (("Goal" :in-theory (enable olamb))))
-)
-
-(defthm lop-thm-2-original
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (and (not (= (lamb-0 a b e) 0))
-		  (or (= (expo (- a b)) (expo (lamb-0 a b e)))
-		      (= (expo (- a b)) (1- (expo (lamb-0 a b e)))))))
-  :rule-classes ()
-  :hints (("Goal" :use olop-thm-2)))
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/lop3.lisp acl2-6.3/books/rtl/rel5/support/lop3.lisp
--- acl2-6.2/books/rtl/rel5/support/lop3.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lop3.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,276 +0,0 @@
-(in-package "ACL2")
-
-(include-book "lop2") ;BOZO yuck!
-(local (include-book "lop3-proofs"))
-
-(defund OLAMT (a b e)
-  (logxor a (lnot b (1+ e))))
-
-(defund OLAMG (a b e)
-  (logand a (lnot b (1+ e))))
-
-(defund OLAMZ (a b e)
-  (lnot (logior a (lnot b (1+ e))) (1+ e)))
-
-(defund OLAM1 (a b e)
-  (logand (bits (olamt a b e) e 2) 
-	  (logand (bits (olamg a b e) (1- e) 1)
-		  (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
-
-(defund OLAM2 (a b e)
-  (logand (lnot (bits (olamt a b e) e 2) (1- e))
-	  (logand (bits (olamz a b e) (1- e) 1)
-		  (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
-
-(defund OLAM3 (a b e)
-  (logand (bits (olamt a b e) e 2) 
-	  (logand (bits (olamz a b e) (1- e) 1)
-		  (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
-
-(defund OLAM4 (a b e)
-  (logand (lnot (bits (olamt a b e) e 2) (1- e))
-	  (logand (bits (olamg a b e) (1- e) 1)
-		  (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
-
-(defund OLAM0 (a b e)
-  (logior (olam1 a b e)
-	  (logior (olam2 a b e)
-		  (logior (olam3 a b e)
-			  (olam4 a b e)))))
-
-(defund OLAMB (a b e)
-  (+ (* 2 (olam0 a b e))
-     (lnot (bitn (olamt a b e) 0) 1)))
-
-(defthm OLAMT-NAT
-  (implies (and (integerp a)
-                (>= a 0)
-                )
-           (and (integerp (olamt a b e))
-                (>= (olamt a b e) 0))))
-
-(defthm OLAMG-NAT
-  (implies (and (integerp a)
-                (> a 0)
-                )
-           (and (integerp (olamg a b e))
-                (>= (olamg a b e) 0))))
-
-(defthm OLAMZ-NAT
-  (implies (and (integerp a)
-                (> a 0)
-                )
-           (and (integerp (olamz a b e))
-                (>= (olamz a b e) 0))))
-
-(defthm OLAM1-NAT
-  (implies (and (integerp a)
-                (> a 0)
-                )
-           (and (integerp (olam1 a b e))
-                (>= (olam1 a b e) 0))))
-
-(defthm OLAM3-NAT
-  (implies (and (integerp a)
-                (> a 0)
-                )
-           (and (integerp (olam3 a b e))
-                (>= (olam3 a b e) 0)))
-  :rule-classes ())
-
-(defthm OLAM2-NAT
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                )
-           (and (integerp (olam2 a b e))
-                (>= (olam2 a b e) 0))))
-
-(defthm OLAM4-NAT
-  (implies (and (integerp a)
-                (> a 0)
-                )
-           (and (integerp (olam4 a b e))
-                (>= (olam4 a b e) 0))))
-
-(defthm OLAM0-NAT
-  (implies (and (integerp a)
-                (> a 0)
-                )
-           (and (integerp (olam0 a b e))
-                (>= (olam0 a b e) 0))))
-
-(defthm OLAMB-NAT
-  (implies (and (integerp a)
-                (> a 0)
-                )
-           (and (integerp (olamb a b e))
-                (>= (olamb a b e) 0))))
-
-(defthm OLAM1-BND
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (not (= a b))
-                (= e (expo a))
-                (= e (expo b))
-                (> e 1)
-                (integerp k)
-                (<= k (- e 2))
-                (>= k 0))
-           (< (olam1 a b e) (expt 2 (- e 1))))
-  :rule-classes ())
-
-(defthm OLAM3-BND
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (not (= a b))
-                (= e (expo a))
-                (= e (expo b))
-                (> e 1)
-                (integerp k)
-                (<= k (- e 2))
-                (>= k 0))
-           (< (olam3 a b e) (expt 2 (- e 1))))
-  :rule-classes ())
-
-(defthm OLAM2-BND
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (not (= a b))
-                (= e (expo a))
-                (= e (expo b))
-                (> e 1)
-                (integerp k)
-                (<= k (- e 2))
-                (>= k 0))
-           (< (olam2 a b e) (expt 2 (- e 1))))
-  :rule-classes ())
-
-(defthm OLAM4-BND
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (not (= a b))
-                (= e (expo a))
-                (= e (expo b))
-                (> e 1)
-                (integerp k)
-                (<= k (- e 2))
-                (>= k 0))
-           (< (olam4 a b e) (expt 2 (- e 1))))
-  :rule-classes ())
-
-(defthm OLAM0-BND
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (not (= a b))
-                (= e (expo a))
-                (= e (expo b))
-                (> e 1))
-           (< (olam0 a b e) (expt 2 (- e 1))))
-  :rule-classes ())
-
-(defthm OLAMB-BND
-  (implies (and (integerp a)
-                (> a 0)
-                (integerp b)
-                (> b 0)
-                (not (= a b))
-                (= e (expo a))
-                (= e (expo b))
-                (> e 1))
-           (< (olamb a b e) (expt 2 e)))
-  :rule-classes ())
-
-(defthm olop-thm-2
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (and (not (= (olamb a b e) 0))
-		  (or (= (expo (- a b)) (expo (olamb a b e)))
-		      (= (expo (- a b)) (1- (expo (olamb a b e)))))))
-  :rule-classes ())
-
-(include-book "land0")
-(include-book "lior0")
-(include-book "lxor0")
-
-(defun lamt-0 (a b e)
-  (lxor0 a (lnot b (1+ e)) (1+ e)))
-
-(defun lamg-0 (a b e)
-  (land0 a (lnot b (1+ e)) (1+ e)))
-
-(defun lamz-0 (a b e)
-  (lnot (lior0 a (lnot b (1+ e)) (1+ e)) (1+ e)))
-
-(defun lam1-0 (a b e)
-  (land0 (bits (lamt-0 a b e) e 2) 
-	(land0 (bits (lamg-0 a b e) (1- e) 1)
-	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam2-0 (a b e)
-  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
-	(land0 (bits (lamz-0 a b e) (1- e) 1)
-	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam3-0 (a b e)
-  (land0 (bits (lamt-0 a b e) e 2) 
-	(land0 (bits (lamz-0 a b e) (1- e) 1)
-	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam4-0 (a b e)
-  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
-	(land0 (bits (lamg-0 a b e) (1- e) 1)
-	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lam0-0 (a b e)
-  (lior0 (lam1-0 a b e)
-	(lior0 (lam2-0 a b e)
-	      (lior0 (lam3-0 a b e)
-		    (lam4-0 a b e)
-		    (1- e))
-	      (1- e))
-	(1- e)))
-
-(defun lamb-0 (a b e)
-  (+ (* 2 (lam0-0 a b e))
-     (lnot (bitn (lamt-0 a b e) 0) 1)))
-
-(in-theory (enable bits-tail bvecp-expo)) ;BOZO yuck!
-
-(defthm lop-thm-2-original
-    (implies (and (integerp a)
-		  (> a 0)
-		  (integerp b)
-		  (> b 0)
-		  (not (= a b))
-		  (= e (expo a))
-		  (= e (expo b))
-		  (> e 1))
-	     (and (not (= (lamb-0 a b e) 0))
-		  (or (= (expo (- a b)) (expo (lamb-0 a b e)))
-		      (= (expo (- a b)) (1- (expo (lamb-0 a b e)))))))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/support/lxor.lisp acl2-6.3/books/rtl/rel5/support/lxor.lisp
--- acl2-6.2/books/rtl/rel5/support/lxor.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lxor.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,511 +0,0 @@
-; Port lxor0 theorems to lxor.  The original definition of lxor (in rel4) was
-; that of lxor0 in the current release.  So the port is to keep all the lemmas
-; about lxor0 and then use equality of lxor0 with lxor to port them to lxor.
-
-(in-package "ACL2")
-
-(include-book "lxor0")
-(local (include-book "top1")) ; for lxor0-bits-1 and lxor0-bits-2
-
-(defun binary-lxor (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :measure (nfix n)
-                  :verify-guards nil))
-  (mbe :logic
-       (cond ((zp n)
-              0)
-             ((equal n 1)
-              (if (iff (equal (bitn x 0) 1)
-                       (equal (bitn y 0) 1))
-                  0
-                1))
-             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                   (binary-lxor (mod x 2) (mod y 2) 1))))
-       :exec ; (lxor0 x y n)
-       (logxor (bits x (1- n) 0)
-               (bits y (1- n) 0))))
-
-(defmacro lxor (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
-         `(binary-lxor ,@x))
-        (t         
-         `(binary-lxor ,(car x)
-                       (lxor ,@(cdr x))
-                       ,(car (last x))))))
-
-; We attempt to derive all lxor results from corresponding lxor0 results.
-
-(encapsulate
- ()
-
- (local
-  (defun p0 (x y n)
-    (equal (lxor x y n)
-           (lxor0 x y n))))
-
- (local
-  (defthm p0-holds-inductive-step
-    (implies (and (not (zp n))
-                  (not (equal n 1))
-                  (p0 (fl (* x 1/2))
-                      (fl (* y 1/2))
-                      (+ -1 n))
-                  (p0 (mod x 2) (mod y 2) 1))
-             (p0 x y n))
-    :hints (("Goal" :use (lxor0-def binary-lxor)))))
-
- (local
-  (defthm p0-holds-base-1
-    (p0 x y 1)
-    :hints (("Goal" :in-theory (enable bitn)
-             :expand ((binary-lxor0 x y 1))))))
-
- (local
-  (defthm p0-holds-base-0
-    (implies (zp n)
-             (p0 x y n))
-    :hints (("Goal" :expand ((binary-lxor0 x y n))))))
-
- (local
-  (defthm p0-holds
-    (p0 x y n)
-    :hints (("Goal" :induct (lxor x y n)
-             :in-theory (disable p0)))
-    :rule-classes nil))
-
- (defthmd lxor-is-lxor0
-   (equal (lxor x y n)
-          (lxor0 x y n))
-   :hints (("Goal" :use p0-holds))))
-
-(local (in-theory (e/d (lxor-is-lxor0) (binary-lxor))))
-
-;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
-(add-macro-alias lxor binary-lxor)
-
-(defthm lxor-nonnegative-integer-type
-  (and (integerp (lxor x y n))
-       (<= 0 (lxor x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lxor)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lxor-natp
-  (natp (lxor x y n)))
-
-(defthm lxor-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (lxor x y n)
-                  0)))
-
-(defthmd lxor-bvecp-simple
-  (bvecp (lxor x y n) n))
-
-(defthm lxor-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lxor x y n) k)))
-
-
-;;
-;; Rules to normalize lxor terms (recall that LXOR is a macro for BINARY-LXOR):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm lxor-associative
-  (equal (lxor (lxor x y n) z n)
-         (lxor x (lxor y z n) n)))
-
-(defthm lxor-commutative
-  (equal (lxor y x n)
-         (lxor x y n)))
-
-(defthm lxor-commutative-2
-  (equal (lxor y (lxor x z n) n)
-         (lxor x (lxor y z n) n)))
-
-(defthm lxor-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (lxor x (lxor y z n) n)
-                  (lxor (lxor x y n) z n))))
-
-(defthm lxor-0
-  (implies (case-split (bvecp y n))
-           (equal (lxor 0 y n)
-                  y)))
-
-;nicer than the analogous rule for logand?
-(defthm lxor-1
-  (implies (case-split (bvecp y 1))
-           (equal (lxor 1 y 1)
-                  (lnot y 1))))
-
-(defthm lxor-self
-  (implies (case-split (bvecp x n))
-           (equal (lxor x x n)
-                  0)))
-
-
-(defthmd bits-lxor-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lxor x y n) i j)
-                  (lxor (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j))))))
-
-(defthmd bits-lxor-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lxor x y n) i j)
-                  (lxor (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j))))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-lxor
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (lxor x y n) i j)
-                  (lxor (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-lxor-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor x y n) m)
-                  (lxor (bitn x m) 
-                        (bitn y m) 
-                        1))))
-(defthmd bitn-lxor-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-lxor
-  (implies (and (case-split (<= 0 k))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor x y n) k)
-                  (if (< k n)
-                      (lxor (bitn x k) 
-                            (bitn y k) 
-                            1)
-                    0))))
-
-
-(defthm lxor-ones
-  (implies (case-split (bvecp x n))
-           (equal (lxor (1- (expt 2 n)) x n)
-                  (lnot x n)))
-  :rule-classes ()
-  :hints (("Goal" :use lxor0-ones)))
-
-;lxor-with-all-ones will rewrite (lxor x n) [note there's only one value being ANDed], because (lxor x n)
-;expands to (BINARY-LXOR X (ALL-ONES N) N) - now moot???
-(defthm lxor-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (lxor (all-ones n) x n)
-                  (lnot x n))))
-
-(defthm lxor-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-                (case-split (bvecp x n)))
-           (equal (lxor k x n)
-                  (lnot x n)))
-  :hints (("Goal" :use lxor0-ones-rewrite)))
-
-(defthm lxor-def-original
-  (implies (and (< 0 n)
-                (integerp n))
-           (equal (lxor x y n)
-                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (lxor (mod x 2) (mod y 2) 1))))
-  :rule-classes ()
-  :hints (("Goal" :use lxor0-def)))
-
-(defthm lxor-mod-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (mod (lxor x y n) 2)
-                  (lxor (mod x 2) (mod y 2) 1)))
-  :hints (("Goal" :use lxor0-mod-2)))
-
-(defthm lxor-fl-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (fl (/ (lxor x y n) 2))
-                  (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-  :hints (("Goal" :use lxor0-fl-2)))
-
-(in-theory (disable lxor-mod-2 lxor-fl-2))
-
-(defthm bitn-lxor-0
-  (implies (and (integerp x)
-                (integerp y)
-                (not (zp n))
-                )
-           (= (bitn (lxor x y n) 0)
-              (bitn (+ x y) 0)))		
-  :rule-classes ()
-  :hints (("Goal" :use bitn-lxor0-0)))
-
-;BOZO rename
-(defthm lxor-x-y-0
-  (equal (lxor x y 0) 0))
-
-
-;N is a free variable
-(defthm lxor-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (< n m)
-		  (case-split (integerp m))
-		  )
-	     (equal (lxor x y m) 
-                    (lxor x y n))))
-
-(defthm lxor-upper-bound
-  (implies (and (integerp n)
-                (<= 0 n))
-           (< (lxor x y n) (expt 2 n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm lxor-upper-bound-tight
-  (implies (and (integerp n)
-                (<= 0 n))
-           (<= (lxor x y n) (1- (expt 2 n)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; Added in move to rel5 (should perhaps be in a -proofs file):
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defthm lxor-bvecp-2
-  (implies (and (bvecp x m)
-                (bvecp y m))
-           (bvecp (lxor x y n) m))
-  :hints (("Goal" :use ((:instance lxor-reduce
-                                   (n m)
-                                   (m n))))))
-
-; Start proof of fl-lxor (copied from proof of fl-land with very small changes).
-
-(local
- (defun fl-lxor-induction (k n)
-   (if (zp k)
-       n
-     (fl-lxor-induction (1- k) (1+ n)))))
-
-
-(local
- (defthmd fl-lxor-induction-step-1
-   (implies (not (zp k))
-            (equal (lxor (fl (* x (/ (expt 2 k))))
-                         (fl (* y (/ (expt 2 k))))
-                         n)
-                   (lxor (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
-                         (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
-                         n)))
-   :hints (("Goal" :in-theory (disable lxor-is-lxor0
-                                       fl/int-rewrite)
-            :expand ((expt 2 k))
-            :use ((:instance fl/int-rewrite
-                             (x (* x (/ (expt 2 (1- k)))))
-                             (n 2))
-                  (:instance fl/int-rewrite
-                             (x (* y (/ (expt 2 (1- k)))))
-                             (n 2)))))))
-
-(local
- (defthmd fl-lxor-induction-step-2
-   (equal (lxor (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
-                (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
-                n)
-          (fl (/ (lxor (fl (* x (/ (expt 2 (1- k)))))
-                       (fl (* y (/ (expt 2 (1- k)))))
-                       (1+ n))
-                 2)))
-   :hints (("Goal" :in-theory (disable lxor-is-lxor0
-                                       fl/int-rewrite)
-            :expand ((lxor (fl (* x (/ (expt 2 (1- k)))))
-                           (fl (* y (/ (expt 2 (1- k)))))
-                           (1+ n)))))))
-
-(local
- (defthmd fl-lxor-induction-step-3
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (lxor x y (+ k n))))
-                        (lxor (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (/ (lxor (fl (* x (/ (expt 2 (1- k)))))
-                                (fl (* y (/ (expt 2 (1- k)))))
-                                (1+ n))
-                          2))
-                   (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
-                                 (lxor x y (+ k n))))
-                          2))))))
-
-(local
- (defthmd fl-lxor-induction-step-4
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (lxor x y (+ k n))))
-                        (lxor (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
-                                 (lxor x y (+ k n))))
-                          2))
-                   (fl (* (/ (expt 2 k))
-                          (lxor x y (+ k n))))))
-   :hints (("Goal" :expand ((expt 2 k))))))
-
-(local
- (defthm fl-lxor-induction-step
-   (implies (and (not (zp k))
-                 (equal (fl (* (/ (expt 2 (+ -1 k)))
-                               (lxor x y (+ k n))))
-                        (lxor (fl (* x (/ (expt 2 (+ -1 k)))))
-                              (fl (* y (/ (expt 2 (+ -1 k)))))
-                              (+ 1 n)))
-                 (natp x)
-                 (natp y)
-                 (natp n))
-            (equal (fl (* (/ (expt 2 k))
-                          (lxor x y (+ k n))))
-                   (lxor (fl (* x (/ (expt 2 k))))
-                         (fl (* y (/ (expt 2 k))))
-                         n)))
-   :hints (("Goal" :use (fl-lxor-induction-step-1
-                         fl-lxor-induction-step-2
-                         fl-lxor-induction-step-3
-                         fl-lxor-induction-step-4)))))
-
-(defthmd fl-lxor
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (natp k))
-           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
-                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
-  :hints (("Goal" :induct (fl-lxor-induction k n)
-           :in-theory (disable lxor-is-lxor0))))
-
-(defthm lxor-fl-1
-  (equal (lxor (fl x) y n)
-         (lxor x y n))
-  :hints (("Goal" :in-theory (enable lxor lxor0))))
-
-(defthm lxor-fl-2-eric
-  (equal (lxor x (fl y) n)
-         (lxor x y n))
-  :hints (("Goal" :in-theory (enable lxor lxor0))))
-
-(defthmd lxor-def
-  (implies (and (integerp x)
-                (integerp y)
-                (integerp n)
-                (> n 0))
-           (equal (lxor x y n)
-                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (lxor (bitn x 0) (bitn y 0) 1))))
-  :hints (("Goal" :in-theory (enable bitn-rec-0)
-           :use lxor-def-original)))
-
-(local
- (defun lxor-shift-induction (n k)
-   (if (zp k)
-       (+ k n)
-     (lxor-shift-induction (1- n) (1- k)))))
-
-(defthm lxor-shift
-  (implies (and (integerp x)
-                (integerp y)
-                (natp k))
-           (= (lxor (* (expt 2 k) x)
-                    (* (expt 2 k) y)
-                    n)
-              (* (expt 2 k) (lxor x y (- n k)))))
-  :hints (("Goal" :induct (lxor-shift-induction n k)
-           :expand ((expt 2 k)
-                    (lxor (* 2 x (expt 2 (+ -1 k)))
-                          (* 2 y (expt 2 (+ -1 k)))
-                          n))
-           :in-theory (e/d (bitn-negative-bit-of-integer)
-                           (lxor-is-lxor0))))
-  :rule-classes ())
-
-; See land.lisp for analogous lemma and a hand proof of it.
-(defthmd mod-lxor
-  (implies (and (integerp n)
-                (integerp k)
-                (<= k n))
-           (equal (mod (lxor x y n) (expt 2 k))
-                  (lxor x y k)))
-  :hints (("Goal"
-           :use
-           ((:instance bits-lxor (x x) (y y) (n k) (i (1- k)) (j 0))
-            (:instance mod-bits (x (lxor x y n)) (i (1- n)) (j k))))))
-
-(defthmd lxor-bits-1
-  (equal (lxor (bits x (1- n) 0)
-               y
-               n)
-         (lxor x y n))
-  :hints (("Goal" :use lxor0-bits-1)))
-
-(defthmd lxor-bits-2
-  (equal (lxor x
-               (bits y (1- n) 0)
-               n)
-         (lxor x y n))
-  :hints (("Goal" :use lxor0-bits-2)))
-
-(defthm lxor-base
-  (equal (lxor x y 1)
-         (if (iff (equal (bitn x 0) 1)
-                  (equal (bitn y 0) 1))
-             0
-           1))
-  :hints (("Goal" :use lxor0-base))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/lxor0-proofs.lisp acl2-6.3/books/rtl/rel5/support/lxor0-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/lxor0-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lxor0-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,527 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LXOR0, a nice version of LOGXOR.  LXOR0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-todo: ;add analogs of the thms in land0.lisp past bitn-land0
-
-|#
-
-;add macro alias
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(local (include-book "all-ones"))
-(local (include-book "merge"))
-(local (include-book "bvecp"))
-(local (include-book "logand"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "../arithmetic/top"))
-
-
-(defund binary-lxor0 (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logxor (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro lxor0 (&rest x)
-  (declare (xargs :guard (consp x)))
-  (cond ((endp (cdddr x)) ;(lxor0 x y n) -- the base case
-         `(binary-lxor0 ,@x))
-        (t         
-         `(binary-lxor0 ,(car x)
-                       (lxor0 ,@(cdr x))
-                       ,(car (last x))))))
-
-
-;Allows things like (in-theory (disable lxor0)) to refer to binary-lxor0.
-(add-macro-alias lxor0 binary-lxor0)
-
-
-(defthm lxor0-nonnegative-integer-type
-  (and (integerp (lxor0 x y n))
-       (<= 0 (lxor0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lxor0) is no better than lxor0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lxor0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lxor0-natp
-  (natp (lxor0 x y n)))
-
-(defthm lxor0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (lxor0 x y n)
-                  0))
-  :hints (("Goal" :cases ((acl2-numberp n))
-           :in-theory (enable lxor0)))
-  )
-
-(defthmd lxor0-bvecp-simple
-  (bvecp (lxor0 x y n) n)
-  :hints (("Goal" :cases ((natp n))
-           :in-theory (enable lxor0))))
-
-(defthm lxor0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lxor0 x y n) k))
-  :hints (("Goal" :in-theory (disable lxor0-bvecp-simple)
-           :use lxor0-bvecp-simple)))
-
-
-;;
-;; Rules to normalize lxor0 terms (recall that LXOR0 is a macro for BINARY-LXOR0):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm lxor0-associative
-  (equal (lxor0 (lxor0 x y n) z n)
-         (lxor0 x (lxor0 y z n) n))
-  :hints (("Goal" :cases ((natp n))
-           :in-theory (enable lxor0 bits-tail))))
-
-(defthm lxor0-commutative
-  (equal (lxor0 y x n)
-         (lxor0 x y n))
-  :hints (("Goal" :in-theory (enable lxor0))))
-
-(defthm lxor0-commutative-2
-  (equal (lxor0 y (lxor0 x z n) n)
-         (lxor0 x (lxor0 y z n) n))
-  :hints (("Goal"  :cases ((natp n))
-           :in-theory (enable lxor0 bits-tail))))
-
-(defthm lxor0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (lxor0 x (lxor0 y z n) n)
-                  (lxor0 (lxor0 x y n) z n))))
-
-(defthm lxor0-0
-  (implies (case-split (bvecp y n))
-           (equal (lxor0 0 y n)
-                  y))
-  :hints (("Goal" :in-theory (enable lxor0 bits-tail))))
-
-;nicer than the analogous rule for logand?
-(defthm lxor0-1
-  (implies (case-split (bvecp y 1))
-           (equal (lxor0 1 y 1)
-                  (lnot y 1)))
-  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-(defthm lxor0-self
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 x x n)
-                  0))
-  :hints (("Goal" :in-theory (enable lxor0 bits-tail))))
-
-
-(defthmd bits-lxor0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable lxor0 bits-logand))))
-
-
-(defthmd bits-lxor0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable lxor0 bits-logand))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-lxor0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j)))))
-  :hints (("Goal" :in-theory (enable bits-lxor0-1 bits-lxor0-2))))
-
-(defthmd bitn-lxor0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  (lxor0 (bitn x m) 
-                        (bitn y m) 
-                        1)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn)
-                              '(BITS-N-N-REWRITE)))))
-(defthmd bitn-lxor0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  0))
-  :hints (("Goal" :in-theory (enable BVECP-BITN-0))))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-lxor0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  (if (< m n)
-                      (lxor0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0)))
-  :hints (("Goal" :in-theory (enable bitn-lxor0-1 bitn-lxor0-2))))
-
-
-(defthm lxor0-ones
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 (1- (expt 2 n)) x n)
-                  (lnot x n)))
-  :rule-classes ()
-  :hints
-  (("subgoal 1" :use logxor-ones)
-   ("goal" :cases ((natp n))
-    :in-theory (enable lxor0 bits-tail)
-    )))
-
-;lxor0-with-all-ones will rewrite (lxor0 x n) [note there's only one value being ANDed], because (lxor0 x n)
-;expands to (BINARY-LXOR0 X (ALL-ONES N) N) - now moot???
-(defthm lxor0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 (all-ones n) x n)
-                  (lnot x n)))
-  :hints
-  (("goal" :use lxor0-ones
-    :in-theory (enable all-ones))))
-
-(defthm lxor0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-                (case-split (bvecp x n)))
-           (equal (lxor0 k x n)
-                  (lnot x n)))
-  :hints (("Goal" :use lxor0-ones)))
-
-(local (in-theory (disable mod-by-2-rewrite-to-even mod-mult-of-n mod-equal-0)))
-
-(encapsulate
- ()
-
- (local
-  (defthm lxor0-def-integerp
-    (implies (and (integerp x)
-                  (integerp y)
-                  (> n 0)
-                  (integerp n))
-             (equal (lxor0 x y n)
-                    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (lxor0 (mod x 2) (mod y 2) 1))))
-    :rule-classes ()
-    :hints (("Goal" :in-theory (e/d (lxor0 bits-fl-by-2) ())
-             :use ((:instance logxor-def (i (bits x (1- n) 0)) (j (bits y (1- n) 0)))
-                   (:instance mod012 (m x))
-                   (:instance mod012 (m y)))))))
-
-; Now we want to eliminate the (integerp x) and (integerp y) hypotheses from
-; lxor0-def-integerp.  First suppose x is not rational.
-
- (local
-  (defthm lxor0-is-0-if-not-rational-1
-    (implies (not (rationalp x))
-             (equal (lxor0 x y n)
-                    (lxor0 0 y n)))
-    :hints (("Goal" :expand ((lxor0 x y n)
-                             (lxor0 0 y n))))))
-
- (local
-  (defthm lxor0-is-0-if-not-rational-2
-    (implies (not (rationalp y))
-             (equal (lxor0 x y n)
-                    (lxor0 x 0 n)))
-    :hints (("Goal" :expand ((lxor0 x y n)
-                             (lxor0 0 x n))))))
-
- (local
-  (defthm fl-1/2-is-0-if-not-rational
-    (implies (not (rationalp x))
-             (equal (fl (* 1/2 x)) 0))
-    :hints (("Goal" :cases ((acl2-numberp x))))))
-
- (local
-  (defthm mod-2-if-not-rational
-    (implies (not (rationalp x))
-             (equal (mod x 2)
-                    (fix x)))
-    :hints (("Goal" :expand ((mod x 2))))))
-
- (local
-  (defthm lxor0-fl-1
-    (equal (lxor0 (fl x) y n)
-           (lxor0 x y n))
-    :hints (("Goal" :expand ((lxor0 y (fl x) n)
-                             (lxor0 x y n))))))
-
- (local
-  (defthm lxor0-fl-2
-    (equal (lxor0 y (fl x) n)
-           (lxor0 y x n))
-    :hints (("Goal" :expand ((lxor0 y (fl x) n)
-                             (lxor0 x y n))))))
-
- (local
-  (defthm lxor0-def-rational-hack
-    (implies (and (rationalp x)
-                  (rationalp y)
-                  (>= n 0)
-                  (integerp n))
-             (equal (lxor0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
-                    (lxor0 (* 1/2 x) (* 1/2 y) n)))
-    :hints (("Goal" :expand ((lxor0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
-                             (lxor0 (* 1/2 x) (* 1/2 y) n))))))
-
- (local
-  (defthm lxor0-def-rational
-    (implies (and (rationalp x)
-                  (rationalp y)
-                  (> n 0)
-                  (integerp n))
-             (equal (lxor0 x y n)
-                    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (lxor0 (mod x 2) (mod y 2) 1))))
-    :rule-classes ()
-    :hints (("Goal"
-             :use ((:instance lxor0-def-integerp (x (fl x)) (y (fl y))))
-             :in-theory (e/d (mod-fl-eric) (fl-mod))))))
-
- (local
-  (defthm lxor0-def-not-rational-1
-    (implies (and (not (rationalp x))
-                  (rationalp y)
-                  (> n 0)
-                  (integerp n))
-             (equal (lxor0 x y n)
-                    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (lxor0 (mod x 2) (mod y 2) 1))))
-    :hints (("Goal" :use ((:instance lxor0-def-rational
-                                     (x 0)))))
-    :rule-classes nil))
-
- (local
-  (defthm lxor0-def-not-rational-2
-    (implies (and (rationalp x)
-                  (not (rationalp y))
-                  (> n 0)
-                  (integerp n))
-             (equal (lxor0 x y n)
-                    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                       (lxor0 (mod x 2) (mod y 2) 1))))
-    :hints (("Goal" :use ((:instance lxor0-def-rational
-                                     (y 0)))))
-    :rule-classes nil))
-
- (defthm lxor0-def
-   (implies (and (> n 0)
-                 (integerp n))
-            (equal (lxor0 x y n)
-                   (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                      (lxor0 (mod x 2) (mod y 2) 1))))
-   :rule-classes ()
-   :hints (("Goal" :use (lxor0-def-not-rational-1
-                         lxor0-def-not-rational-2
-                         lxor0-def-rational)))))
-
-(defthm lxor0-mod-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (mod (lxor0 x y n) 2)
-		    (lxor0 (mod x 2) (mod y 2) 1)))
-  :hints (("Goal" :use (lxor0-def
-			(:instance mod012 (m x))
-			(:instance mod012 (m y))
-			(:instance quot-mod (m (lxor0 x y n)) (n 2))))))
-
-(defthm lxor0-fl-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (fl (/ (lxor0 x y n) 2))
-		    (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-  :hints (("Goal" :use (lxor0-def
-			(:instance mod012 (m x))
-			(:instance mod012 (m y))
-			(:instance quot-mod (m (lxor0 x y n)) (n 2))))))
-
-(in-theory (disable lxor0-mod-2 lxor0-fl-2))
-
-(defthm bitn-lxor0-0
-    (implies (and (integerp x)
-                  (integerp y)
-		  (not (zp n))
-                  )
-	     (= (bitn (lxor0 x y n) 0)
-		(bitn (+ x y) 0)))		
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance bitn-logxor-0 (a (bits x (1- n) 0)) (b (bits y (1- n) 0)))
-			(:instance mod-mod-sum (n (expt 2 n)) (a x) (b y))
-			(:instance mod-of-mod-cor (a n) (b 1) (x (+ x y)))
-			(:instance mod-of-mod-cor (a n) (b 1) (x (+ (mod x (expt 2 n)) (mod y (expt 2 n))))))
-		  :in-theory (enable lxor0 bitn-rec-0 bits-mod bitn-bits))))
-
-(defthm lxor0-x-y-0
-  (equal (lxor0 x y 0) 0)
-  :hints (("Goal" :in-theory (enable lxor0))))
-
-
-;N is a free variable
-(defthm lxor0-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (< n m)
-		  (case-split (integerp m))
-		  )
-	     (equal (lxor0 x y m) 
-                    (lxor0 x y n)))
-  :hints (("Goal" :in-theory (enable lxor0))))
-
-
-;move
-(defthm lxor0-upper-bound
-  (implies (and (integerp n)
-                (<= 0 n))
-           (< (lxor0 x y n) (expt 2 n)))
-  :rule-classes (:rewrite :linear)
-  :hints (("Goal" :in-theory (enable lxor0))))
-
-;move
-(defthm lxor0-upper-bound-tight
-  (implies (and (integerp n)
-                (<= 0 n))
-           (<= (lxor0 x y n) (1- (expt 2 n)))))
-
-(defthmd lxor0-bits-1
-  (equal (lxor0 (bits x (1- n) 0)
-               y
-               n)
-         (lxor0 x y n))
-  :hints (("Goal" :in-theory (e/d (lxor0) (logior lxor0-commutative)))))
-
-(defthmd lxor0-bits-2
-  (equal (lxor0 x
-               (bits y (1- n) 0)
-               n)
-         (lxor0 x y n))
-  :hints (("Goal" :in-theory (e/d (lxor0) (logior lxor0-commutative)))))
-
-(local
- (defthm lxor0-base-lemma
-   (implies (and (bvecp x 1) (bvecp y 1))
-            (equal (lxor0 x y 1)
-                   (if (iff (equal (bitn x 0) 1)
-                            (equal (bitn y 0) 1))
-                       0
-                     1)))
-   :rule-classes nil))
-
-(defthm lxor0-base
-  (equal (lxor0 x y 1)
-         (if (iff (equal (bitn x 0) 1)
-                  (equal (bitn y 0) 1))
-             0
-           1))
-  :hints (("Goal" :use ((:instance lxor0-base-lemma
-                                   (x (bits x 0 0))
-                                   (y (bits y 0 0)))
-                        (:instance lxor0-bits-1
-                                   (x x)
-                                   (y (bits y 0 0))
-                                   (n 1))
-                        (:instance lxor0-bits-2 (n 1)))))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/lxor0.lisp acl2-6.3/books/rtl/rel5/support/lxor0.lisp
--- acl2-6.2/books/rtl/rel5/support/lxor0.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/lxor0.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,324 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LXOR0, a nice version of LOGXOR.  LXOR0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-todo: ;add analogues of the thms in land0.lisp past bitn-land0
-
-|#
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(local (include-book "lxor0-proofs"))
-
-(defund binary-lxor0 (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logxor (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro lxor0 (&rest x)
-  (declare (xargs :guard (consp x)))
-  (cond ((endp (cdddr x)) ;(lxor0 x y n) -- the base case
-         `(binary-lxor0 ,@x))
-        (t         
-         `(binary-lxor0 ,(car x)
-                       (lxor0 ,@(cdr x))
-                       ,(car (last x))))))
-
-
-;Allows things like (in-theory (disable lxor0)) to refer to binary-lxor0.
-(add-macro-alias lxor0 binary-lxor0)
-
-(defthm lxor0-nonnegative-integer-type
-  (and (integerp (lxor0 x y n))
-       (<= 0 (lxor0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lxor0) is no better than lxor0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lxor0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lxor0-natp
-  (natp (lxor0 x y n)))
-
-(defthm lxor0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (lxor0 x y n)
-                  0)))
-
-(defthmd lxor0-bvecp-simple
-  (bvecp (lxor0 x y n) n))
-
-(defthm lxor0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lxor0 x y n) k)))
-
-
-;;
-;; Rules to normalize lxor0 terms (recall that LXOR0 is a macro for BINARY-LXOR0):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm lxor0-associative
-  (equal (lxor0 (lxor0 x y n) z n)
-         (lxor0 x (lxor0 y z n) n)))
-
-(defthm lxor0-commutative
-  (equal (lxor0 y x n)
-         (lxor0 x y n)))
-
-(defthm lxor0-commutative-2
-  (equal (lxor0 y (lxor0 x z n) n)
-         (lxor0 x (lxor0 y z n) n)))
-
-(defthm lxor0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (lxor0 x (lxor0 y z n) n)
-                  (lxor0 (lxor0 x y n) z n))))
-
-(defthm lxor0-0
-  (implies (case-split (bvecp y n))
-           (equal (lxor0 0 y n)
-                  y)))
-
-;nicer than the analogous rule for logand?
-(defthm lxor0-1
-  (implies (case-split (bvecp y 1))
-           (equal (lxor0 1 y 1)
-                  (lnot y 1))))
-
-(defthm lxor0-self
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 x x n)
-                  0)))
-
-
-(defthmd bits-lxor0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j))))))
-
-(defthmd bits-lxor0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j))))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-lxor0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-lxor0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  (lxor0 (bitn x m) 
-                        (bitn y m) 
-                        1))))
-(defthmd bitn-lxor0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-lxor0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  (if (< m n)
-                      (lxor0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0))))
-
-
-(defthm lxor0-ones
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 (1- (expt 2 n)) x n)
-                  (lnot x n)))
-  :rule-classes ())
-
-;lxor0-with-all-ones will rewrite (lxor0 x n) [note there's only one value being ANDed], because (lxor0 x n)
-;expands to (BINARY-LXOR0 X (ALL-ONES N) N) - now moot???
-(defthm lxor0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 (all-ones n) x n)
-                  (lnot x n))))
-
-(defthm lxor0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-                (case-split (bvecp x n)))
-           (equal (lxor0 k x n)
-                  (lnot x n))))
-
-(defthm lxor0-def
-    (implies (and (< 0 n)
-                  (integerp n))
-	     (equal (lxor0 x y n)
-		    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-		       (lxor0 (mod x 2) (mod y 2) 1))))
-  :rule-classes ())
-
-(defthm lxor0-mod-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (mod (lxor0 x y n) 2)
-		    (lxor0 (mod x 2) (mod y 2) 1))))
-
-(defthm lxor0-fl-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (fl (/ (lxor0 x y n) 2))
-		    (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
-
-(in-theory (disable lxor0-mod-2 lxor0-fl-2))
-
-(defthm bitn-lxor0-0
-    (implies (and (integerp x)
-                  (integerp y)
-		  (not (zp n))
-                  )
-	     (= (bitn (lxor0 x y n) 0)
-		(bitn (+ x y) 0)))		
-  :rule-classes ())
-
-;BOZO rename
-(defthm lxor0-x-y-0
-  (equal (lxor0 x y 0) 0))
-
-
-;N is a free variable
-(defthm lxor0-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (< n m)
-		  (case-split (integerp m))
-		  )
-	     (equal (lxor0 x y m) 
-                    (lxor0 x y n))))
-
-(defthm lxor0-upper-bound
-  (implies (and (integerp n)
-                (<= 0 n))
-           (< (lxor0 x y n) (expt 2 n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm lxor0-upper-bound-tight
-  (implies (and (integerp n)
-                (<= 0 n))
-           (<= (lxor0 x y n) (1- (expt 2 n)))))
-
-(defthmd lxor0-bits-1
-  (equal (lxor0 (bits x (1- n) 0)
-               y
-               n)
-         (lxor0 x y n)))
-
-(defthmd lxor0-bits-2
-  (equal (lxor0 x
-               (bits y (1- n) 0)
-               n)
-         (lxor0 x y n)))
-
-(defthm lxor0-base
-  (equal (lxor0 x y 1)
-         (if (iff (equal (bitn x 0) 1)
-                  (equal (bitn y 0) 1))
-             0
-           1))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/merge.lisp acl2-6.3/books/rtl/rel5/support/merge.lisp
--- acl2-6.2/books/rtl/rel5/support/merge.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/merge.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,2272 +0,0 @@
-(in-package "ACL2")
-
-#|
-;This book is intended to include lemmas mixing two or types of functions.  
-
-History of this file:
-David Russinoff created the original version of this file.  In
-9/99, Matt Kaufmann modified some of the lemmas with an eye toward
-increasing the automation provided by this book.  In the process,
-some previous stylistic conventions fell by the wayside, such as
-disabling :rewrite rules immediate after their statements.
-In 7/2001, Eric Smith moved many of the lemmas into basic.lisp
-and other books in the floating point library
-In 6/2002-7/2002, Eric Smith made more changes to this book, incorporating some
-lemmas from merge4.lisp, add.lisp, etc.
-
-todo:
-
-this book does a lot of including other books locally in encapsulates.  it'd be nice if books like
-arithmetic/expt could be included in this book without breakign stuff
-
-See also merge2.lisp.
-
-|#
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund decode (x n)
-  (declare (xargs :guard (rationalp n)))
-  (if (and (natp x) (< x n)) 
-      (ash 1 x) 
-    0))
-
-(defund logior1 (x)
-  (declare (xargs :guard t))
-  (if (equal x 0) 0 1))
-
-(include-book "ground-zero")
-(include-book "log")
-(include-book "float")  ;can't drop this, since exactp is used below...
-
-(local (include-book "../arithmetic/top")) 
-
-(local (include-book "bvecp"))
-(local (include-book "bitn"))
-(local (include-book "lnot")) ;make non-local?
-(local (include-book "bits")) ;try making non-local?
-(local (include-book "logior")) 
-(local (include-book "logand")) 
-(local (include-book "logxor")) 
-(local (include-book "ocat")) 
-
-(local (in-theory (enable expt-minus)))
-(local (in-theory (enable expt-split)))
-
-(defthm bits-tail
-  (implies (and (bvecp x (1+ i))
-                (case-split (acl2-numberp i)))
-           (equal (bits x i 0)
-                  x)))
-
-(local (in-theory (enable bitn-mod))) ;BOZO why?
-
-;proved in logior
-(defthm logior-bvecp
-  (implies (and (bvecp x n)
-                (bvecp y n))
-           (bvecp (logior x y) n)))
-
-
-(encapsulate
- ()
- (local (defthm mod-n+1-1
-          (implies (and (rationalp a);(integerp a)
-;                        (>= a 0)
-                        (integerp n)
-                        (>= n 0))
-                   (< (/ (mod a (expt 2 (1+ n))) (expt 2 n))
-                      2))
-          :rule-classes ()
-          :hints (("goal" :in-theory (set-difference-theories
-                                      (enable expt-split)
-                                      '( *-weakly-monotonic))
-                   :use ((:instance mod-bnd-1 (m a) (n (expt 2  (1+ n))))
-                         (:instance *-weakly-monotonic 
-                                    (x (expt 2 n)) 
-                                    (y 2)
-                                    (y+ (/ (mod a (expt 2 (1+ n))) (expt 2 n)))))))))
-
- (local (defthm mod-n+1-2
-          (implies (and (rationalp a) ;(integerp a)
-                        ;(>= a 0)
-                        (integerp n)
-                        (>= n 0))
-                   (< (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))
-                      2))
-          :rule-classes ()
-          :hints (("goal" :use (mod-n+1-1)))))
-
- (local (defthm mod-n+1-3
-          (implies (and (rationalp a); (integerp a)
-                        ;(>= a 0)
-                        (integerp n)
-                        (>= n 0))
-                   (<= 0 (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))))
-          :rule-classes ()
-          :hints (("goal" :use ( ;(:instance mod>=0 (m a) (n (expt 2 (1+ n))))
-                                )))))
-
- (local (defthm mod-n+1-4
-          (implies (and  (rationalp a) ;(integerp a)
-;                        (>= a 0)
-                        (integerp n)
-                        (>= n 0))
-                   (or (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n))) 0)
-                       (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n))) 1)))
-          :rule-classes ()
-          :hints (("goal" :in-theory (disable EXPT-COMPARE expt-split)
-                   :use (mod-n+1-2
-                                mod-n+1-3)))))
-
- (local (defthm mod-n+1-5
-          (implies (and (rationalp a) ;(integerp a)
-  ;                      (>= a 0)
-                        (integerp n)
-                        (>= n 0))
-                   (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))
-                      (mod (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n))) 2)))
-          :rule-classes ()
-          :hints (("goal" :use (mod-n+1-4)))))
-
- (local (defthm mod-n+1-6
-          (implies (and (rationalp a) ;(integerp a)
-   ;                     (>= a 0)
-                        (integerp n)
-                        (>= n 0))
-                   (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))
-                      (bitn (mod a (expt 2 (1+ n))) n)))
-          :rule-classes ()
-          :hints (("goal" :use (mod-n+1-5
-                     ;			(:instance mod>=0 (m a) (n (expt 2 (1+ n))))
-                                (:instance bitn-def (x (mod a (expt 2 (1+ n)))) (n n)))))))
-
- (local (defthm mod-n+1-7
-          (implies (and (rationalp a) ;(integerp a)
-    ;                    (>= a 0)
-                        (integerp n)
-                        (>= n 0))
-                   (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))
-                      (bitn a n)))
-          :rule-classes ()
-          :hints (("goal" :in-theory (disable bitn-mod)
-                   :use (mod-n+1-6
-                         (:instance bitn-mod (x a) (n (1+ n)) (k n))
-                         )))))
-
-;export?  generalize?
- (local (defthm mod-n+1-8
-          (implies (and (rationalp a) ;(integerp a)
-     ;                   (>= a 0)
-                        (integerp n)
-                        (> n 0))
-                   (= (mod (mod a (expt 2 (1+ n))) (expt 2 n))
-                      (mod a (expt 2 n))))
-          :rule-classes ()
-          :hints (("goal" :use ((:instance mod-of-mod-cor (x a) (a (1+ n)) (b n)))))))
-
-;like bitn-plus-bits
-;bad name?
-;should this be exported?
- (defthm mod-n+1
-   (implies (and (rationalp a) ;(integerp a)
-      ;           (>= a 0)
-                 (integerp n)
-                 (>= n 0)
-                 )
-            (= (mod a (expt 2 (1+ n)))
-               (+ (* (bitn a n) (expt 2 n))
-                  (mod a (expt 2 n)))))
-   :rule-classes ()
-   :hints (("goal" :use (mod-n+1-8
-                         mod-n+1-7
-                     ;			(:instance mod>=0 (m a) (n (expt 2 (1+ n))))
-                         (:instance quot-mod (m (mod a (expt 2 (1+ n)))) (n (expt 2 n)))))))
-
- )
-
-;prove from bits-mod-0?
-(defthm mod-n-n+1
-    (implies (and (rationalp a)
-		  (integerp n)
-		  (>= n 0) 
-                  )
-	     (iff (= (mod a (expt 2 (1+ n))) 0)
-		  (and (= (mod a (expt 2 n)) 0)
-		       (= (bitn a n) 0))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance mod-n+1)
-;			(:instance mod>=0 (m a) (n (expt 2 n)))
-			(:instance bitn-0-1 (x a))))))
-
-;prove without so many enables?
-(defthm bitn-logxor-0
-  (implies (and (integerp a)
-                (integerp b)
-                )
-           (equal (bitn (+ a b) 0)
-                  (bitn (logxor a b) 0)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable 
-                              bits bitn
-                              mod-by-2
-                              integerp-sum-of-odds-over-2
-                              ))))
-
-;rename; is about fl...
-;export?
-;this is basically fl of sig
-;move to somewhere in arithmetic/ ?
-(defthmd mod-expo-1
-  (implies (and (< 0 x)
-                (rationalp x)
-                )
-           (equal (fl (/ x (expt 2 (expo x))))
-                  1))
-  :hints (("goal" :use ((:instance fl-unique (x (/ x (expt 2 (expo x)))) (n 1))))))
-
-;move to somewhere in arithmetic/ ?
-(defthmd mod-expo
-  (implies (and (< 0 x)
-                (rationalp x)
-                )
-           (equal (mod x (expt 2 (expo x)))
-                  (- x (expt 2 (expo x)))))
-  :hints (("goal" :in-theory (enable mod  mod-expo-1))))
-
-(encapsulate
- ()
- (local (defthm mod-logxor-1
-               (implies (and (integerp n) (>= n 1)
-                             (integerp m) (>= m n)
-                             (integerp x) (>= x 0) (< x (expt 2 m))
-                             (integerp y) (>= y 0) (< y (expt 2 m)))
-                        (= (mod (logxor x y) (expt 2 n))
-                           (logior (mod (logand x (lnot y m)) (expt 2 n))
-                                   (mod (logand y (lnot x m)) (expt 2 n)))))
-               :rule-classes ()
-               :hints (("goal" :use ((:instance logxor-rewrite (n m))
-                                     (:instance mod-logior 
-                                                (x (logand x (lnot y m)))
-                                                (y (logand y (lnot x m)))))))))
-
-
- (local (defthm mod-logxor-2
-               (implies (and (integerp n) (>= n 1)
-                             (integerp m) (>= m n)
-                             (integerp x) (>= x 0) (< x (expt 2 m))
-                             (integerp y) (>= y 0) (< y (expt 2 m)))
-                        (= (mod (logxor x y) (expt 2 n))
-                           (logior (logand (mod x (expt 2 n))
-                                           (mod (lnot y m) (expt 2 n)))
-                                   (logand (mod y (expt 2 n))
-                                           (mod (lnot x m) (expt 2 n))))))
-               :rule-classes ()
-               :hints (("goal" :use (mod-logxor-1
-                                     (:instance mod-logand (y (lnot y m)))
-                                     (:instance mod-logand (x y) (y (lnot x m))))))))
-
- (local (defthm mod-logxor-3
-               (implies (and (integerp n) (>= n 1)
-                             (integerp m) (>= m n)
-                             (integerp x) (>= x 0) (< x (expt 2 m))
-                             (integerp y) (>= y 0) (< y (expt 2 m)))
-                        (= (mod (logxor x y) (expt 2 n))
-                           (logior (logand (mod x (expt 2 n))
-                                           (lnot (mod y (expt 2 n)) n))
-                                   (logand (mod y (expt 2 n))
-                                           (lnot (mod x (expt 2 n)) n)))))
-               :rule-classes ()
-               :hints (("goal" :in-theory (disable lnot)
-                        :use (mod-logxor-2
-                              (:instance mod-lnot (x x) (k n) (n m))
-                              (:instance mod-lnot (x y) (k n) (n m)))))))
-
- (local (defthm mod-logxor-4
-               (implies (and (integerp n) (>= n 1)
-                             (integerp m) (>= m n)
-                             (integerp x) (>= x 0) (< x (expt 2 m))
-                             (integerp y) (>= y 0) (< y (expt 2 m)))
-                        (= (mod (logxor x y) (expt 2 n))
-                           (logxor (mod x (expt 2 n))
-                                   (mod y (expt 2 n)))))
-               :rule-classes ()
-               :hints (("goal" :in-theory (disable lnot)
-                        :use (mod-logxor-3
-                              (:instance logxor-rewrite (x (mod x (expt 2 n))) (y (mod y (expt 2 n))))
-;			(:instance mod>=0 (m x) (n (expt 2 n)))
-;		(:instance mod>=0 (m y) (n (expt 2 n)))
-                              (:instance mod-bnd-1 (m x) (n (expt 2 n)))
-                              (:instance mod-bnd-1 (m y) (n (expt 2 n))))))))
-
-
-
- (defthmd mod-logxor
-   (implies (and (integerp n) (<= 0 n)
-                 (integerp x) (<= 0 x)
-                 (integerp y) (<= 0 y))
-            (equal (mod (logxor x y) (expt 2 n))
-                   (logxor (mod x (expt 2 n))
-                           (mod y (expt 2 n)))))
-   :hints (("goal" :in-theory (disable  expo-comparison-rewrite-to-bound
-                                        expo-comparison-rewrite-to-bound-2)
-            :use ((:instance mod-logxor-4 (m (max n (max (1+ (expo x)) (1+ (expo y))))))
-                  (:instance expo>= (n (max n (max (1+ (expo x)) (1+ (expo y))))))
-                  (:instance expo>= (n (max n (max (1+ (expo x)) (1+ (expo y))))) (x y)))))))
-
-(defthm exact-bits-1 
-  (implies (and (equal (expo x) (1- n))
-                (rationalp x)
-                (integerp k)
-                )
-           (equal (integerp (/ x (expt 2 k)))
-                  (exactp x (- n k))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance exactp2 (n (- n k)))))))
-
-;strange rule?
-(defthm exact-bits-2 ; exact-bits-a-c
-  (implies (and (equal (expo x) (1- n))
-                (rationalp x)
-                (<= 0 x) ;or put abs in conclusion?
-                (integerp k)
-                )
-           (equal (integerp (/ x (expt 2 k)))
-                  (equal (bits x (1- n) k)
-                         (/ x (expt 2 k)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable bits)
-           :use ((:instance fl-int (x (/ x (expt 2 k))))
-                 (:instance mod-does-nothing (m x) (n (expt 2 n)))
-                 (:instance expo-upper-bound)))))
-
-#|
-;BOZO move?
-;proved in mod-expt...
-(defthm mod-integerp-when-y-is-power-of-2
-  (implies (integerp x)
-           (integerp (mod x (expt 2 i))))
-  :rule-classes (:rewrite :type-prescription))
-|#
-
-(defthm exact-bits-3
-  (implies (integerp x)
-           (equal (integerp (/ x (expt 2 k)))
-                  (equal (bits x (1- k) 0)
-                         0)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable bits)
-           :use ((:instance quot-mod (m x) (n (expt 2 k)))))))
-
-(defthm exact-bits-b-d
-  (implies (and (equal (expo x) (1- n))
-                (integerp x)
-                (integerp k)
-                )
-           (equal (exactp x (- n k))
-                  (equal (bits x (1- k) 0)
-                         0)))
-  :rule-classes ()
-  :hints (("goal" :use (exact-bits-3 exact-bits-1))))
-
-
-(encapsulate
- ()
- (local (defthm bvecp-exactp-aux
-          (implies (and (case-split (natp n))
-                        (bvecp x n))
-                   (exactp x n))
-          :hints (("Goal" :in-theory (set-difference-theories
-                                      (enable expt-split zip bvecp natp)
-                                      '())
-                   :use ((:instance exact-bits-1 (n (1+ (expo x))) (k 0))
-                         (:instance expo<= (n (1- n)))
-                         (:instance expo>= (n 0))
-                         (:instance exactp-<= (m (1+ (expo x)))))))))
- (defthm bvecp-exactp
-   (implies (bvecp x n)
-            (exactp x n))
-
-   ))
-
-
-
-
-
-#| kill this comment if all certifies..
-
-;could combine these next two?
-
-;BOZO move to bitn?
-;BOZO enable!
-(defthmd bvecp-bitn-0
-  (implies (bvecp x n)
-           (equal (bitn x n) 0))
-  :hints (("Goal" :in-theory (enable bitn bvecp-bits-0))))
-
-
-;BOZO move to bitn?
-;make an alt version?
-(defthm bitn-bvecp-0
-  (implies (and (bvecp x n)
-                (<= 0 m)
-                )
-           (equal (bitn x (+ m n)) 0))
-  :hints (("Goal" :in-theory (disable bvecp-bitn-0)
-           :use ((:instance bvecp-bitn-0 (n (+ m n)))))))
-
-;move to bitn?
-;k is a free var
-;do we need this, if we have bvecp-longer?
-(defthm bitn-bvecp-0-eric
-  (implies (and (bvecp x k)
-                (<= k n))
-           (equal (bitn x n) 0))
-  :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :in-theory (enable bvecp-bitn-0))))
-
-|#
-
-
-;proved in bvecp.lisp...
-(defthm bvecp-product
-  (implies (and (bvecp x m)
-                (bvecp y n)
-                )
-           (bvecp (* x y) (+ m n)))
-  :rule-classes ())
-
-;proved in bvecp.lisp...
-(defthmd bvecp-1-rewrite
-  (equal (bvecp x 1)
-	 (or (equal x 0) (equal x 1)))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-;proved in bvecp.lisp...
-(defthm bvecp-1-0
-    (implies (and (bvecp x 1)
-		  (not (equal x 1)))
-	     (equal x 0))
-  :rule-classes :forward-chaining)
-
-#| kill if all certs
-;sort of a "bitn-tail" like bits-tail?
-(defthm bitn-bvecp-1
-    (implies (bvecp x 1)
-	     (equal (bitn x 0) x))
-    :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-
-
-;rename
-(defthmd bvecp-bitn-1
-    (implies (and (bvecp x (1+ n))
-		  (<= (expt 2 n) x)
-                  (natp n))
-	     (equal (bitn x n) 1))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (bit-expo-b))))
-
-|#
-
-;add bitn-ash?
-
-(defthm bitn-decode
-  (implies (and (case-split (integerp x))
-                (case-split (<= 0 x))
-                (case-split (< x n))
-                )
-           (equal (bitn (decode x n) n2)
-                  (if (equal x n2)
-                      1
-                    0)))
-  :hints (("Goal" :in-theory (enable floor-fl decode ash)))
-  )
-
-
-
-
-
-
-
-;;;**********************************************************************
-;;;                         BITS
-;;;**********************************************************************
-
-
-
-#|
-(local
- (defthm logand-expt-4-1
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (bits (- (1- (expt 2 n)) (expt 2 l)) (1- n) k))))
-   :rule-classes ()
-   :hints (("goal"  :in-theory (disable expt-compare)
-            :use ((:instance logand-slice (x (- (1- (expt 2 n)) (expt 2 l))))
-                  (:instance expt-strong-monotone (n l) (m n)))))))
-|#
-
-(local
- (defthm logand-expt-4-2
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (fl (/ (mod (- (1- (expt 2 n)) (expt 2 l)) (expt 2 n)) (expt 2 k))))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (e/d (bits
-                                    ) ( EXPT-EXCEEDS-2 ;bozo why needed?
-                                    expt-compare
-                                    ))
-            :use ((:instance logand-slice (x (- (1- (expt 2 n)) (expt 2 l))))
-                  (:instance expt-strong-monotone (n l) (m n))
-                  )))))
-
-(local
- (defthm logand-expt-4-3
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (mod (- (1- (expt 2 n)) (expt 2 l)) (expt 2 n))
-               (- (1- (expt 2 n)) (expt 2 l))))
-   :rule-classes ()
-   :hints (("goal"   :in-theory (disable expt-compare)
-            :use ((:instance expt-strong-monotone (n l) (m n))
-;			(:instance expt-pos (x l))
-                  (:instance mod-does-nothing (m (- (1- (expt 2 n)) (expt 2 l)))
-                             (n (expt 2 n))))))))
-
-(local
- (defthm logand-expt-4-4
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (fl (/ (mod (- (1- (expt 2 n)) (expt 2 l)) (expt 2 n))
-                      (expt 2 k)))
-               (fl (/ (- (1- (expt 2 n)) (expt 2 l))
-                      (expt 2 k)))))		       
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable mod-does-nothing)
-            :use (logand-expt-4-3
-)))))
-
-(local
- (defthm logand-expt-4-5
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (fl (/ (- (1- (expt 2 n)) (expt 2 l)) (expt 2 k))))))
-   :rule-classes ()
-   :hints (("goal" :hands-off (expt mod fl)
-            :use ((:instance logand-expt-4-2)
-                  (:instance logand-expt-4-4))))))
-
-(local
- (defthm logand-expt-4-6
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (fl (/ (- (1- (expt 2 n)) (expt 2 l)) (expt 2 k)))
-               (fl (- (expt 2 (- n k)) (/ (1+ (expt 2 l)) (expt 2 k))))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance expt-split (r 2) (i (- n k)) (j k)))))))
-
-(local
- (defthm logand-expt-4-8
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (fl (- (expt 2 (- n k)) (/ (1+ (expt 2 l)) (expt 2 k))))
-               (- (expt 2 (- n k)) 1)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-2-integerp
-                                       )
-            :use (logand-expt-4-6
-;                  logand-expt-4-7
-                  (:instance expt-2-integerp (i (- n k)))
-                  (:instance fl-unique 
-                             (x (- (expt 2 (- n k)) (/ (1+ (expt 2 l)) (expt 2 k))))
-                             (n (- (expt 2 (- n k)) 1))))))))
-
-(local
- (defthm logand-expt-4-9
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (fl (/ (- (1- (expt 2 n)) (expt 2 l)) (expt 2 k)))
-               (- (expt 2 (- n k)) 1)))
-   :rule-classes ()
-   :hints (("goal" :use (logand-expt-4-8
-                         logand-expt-4-6)))))
-
-(local
- (defthm logand-expt-4-10
-   (implies (and (integerp n) (>= n 0)
-                 (integerp k) (>= k 0)
-                 (integerp l) (>= l 0) (< l k)
-                 (< k n))
-            (= (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
-               (* (expt 2 k) (- (expt 2 (- n k)) 1))))
-   :rule-classes ()
-   :hints (("goal" :hands-off (expt mod fl)
-            :use ((:instance logand-expt-4-5)
-                  (:instance logand-expt-4-9))))))
-
-;BOZO is this used anywhere?
-;move?
-;rename! 
-(defthm logand-expt-4
-  (implies (and (integerp n) (>= n 0)
-                (integerp k) (>= k 0)
-                (integerp l) (>= l 0) (< l k)
-                (<= k n))
-           (= (logand (- (1- (expt 2 n)) (expt 2 l))
-                      (- (expt 2 n) (expt 2 k)))
-              (- (expt 2 n) (expt 2 k))))
-  :rule-classes ()
-  :hints (("goal" :hands-off (expt mod fl)
-           :use ((:instance logand-expt-4-10)
-                 (:instance expt-split (r 2) (i (- n k)) (j k))))))
-
-
-;;;**********************************************************************
-;;;                       LOGAND, LOGIOR, and LOGXOR
-;;;**********************************************************************
-
-;move a bunch of these:
-
-;proved in log.lisp
-(defthmd logxor-rewrite-2
-    ;; ! Do we really want to get rid of logxor?
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-                  (natp n)
-		  (not (= n 0)))
-	     (equal (logxor x y)
-		    (logior (logand x (lnot y n))
-			    (logand y (lnot x n)))))
-    :rule-classes ((:rewrite :match-free :all)))
-
-;move!
-(defthm logior-expt
-    (implies (and (natp n)
-		  (natp x)
-		  (bvecp y n))
-	     (= (logior (* (expt 2 n) x) y)
-		(+ (* (expt 2 n) x) y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (or-dist-b))))
-
-;move!
-(defthm logior-expt-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n))
-	     (= (logior (* (expt 2 n) x)
-			(* (expt 2 n) y))
-		(* (expt 2 n) (logior x y))))
-  :rule-classes ()
-  :hints (("Goal" :use (or-dist-c))))
-
-;move?
-(defthm logand-bvecp
-    (implies (and (natp n)
-		  (bvecp x n)
-		  (natp y))
-	     (bvecp (logand x y) n))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use ( logand-bnd))))
-
-;name doesn't match land0-expt
-(defthm logand-expt
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n))
-	     (= (logand (* (expt 2 n) x) y)
-		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
-  :rule-classes ()
-  :hints (("Goal" :use (and-dist-b))))
-
-(defthm mod-logand-expt
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n))
-	     (= (mod (logand x y) (expt 2 n))
-		(logand (mod x (expt 2 n)) y)))
-  :rule-classes ()
-  :hints (("Goal" :use (mod-logand-aux))))
-
-(defthm logand-mod-expt
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (< x (expt 2 n)))
-	     (= (logand x y)
-		(logand x (mod y (expt 2 n)))))
-  :rule-classes ()
-  :hints (("Goal" :use (and-dist-d))))
-
-#|
-;proved in logxor...
-(defthm logxor-bvecp
-  (implies (and (bvecp x n)
-                (bvecp y n)
-                (natp n) ;gen?
-                )
-           (bvecp (logxor x y) n)))
-|#
-
-(defthm logand-expt-2
-    (implies (and (natp x)
-		  (natp k))
-	     (= (logand x (expt 2 k))
-		(* (expt 2 k) (bitn x k))))
-  :rule-classes ()
-  :hints (("Goal" :use (and-bits-a))))
-
-(defthm logior-expt-3
-    (implies (and (natp x)
-		  (natp k))
-	     (= (logior x (expt 2 k))
-		(+ x
-		   (* (expt 2 k) 
-		      (- 1 (bitn x k))))))
-  :rule-classes ()
-  :hints (("Goal" :use (and-bits-b))))
-
-;;;**********************************************************************
-;;;                            LNOT
-;;;**********************************************************************
-
-#|
-test of having this commented out:
-
-;proved in lnot.lisp
-(defthm lnot-x-0
-  (equal (lnot x 0) 0)
-  :hints (("Goal" :in-theory (enable lnot))))
-
-;proved in lnot.lisp
-(defthm lnot-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lnot x n) k)))
-
-;proved in lnot.litp
-(defthm bitn-lnot-not-equal
-  (implies (and (< k n)
-                (integerp n)
-                (<= 0 n)
-                (integerp k)
-                (<= 0 k)
-                )
-           (not (= (bitn (lnot x n) k)
-                   (bitn x k))))
-  :hints (("Goal"; :in-theory (enable bvecp)
-           :use (:instance bitn-0-1 (n k))
-           ))
-  :rule-classes ())
-|#
-
-
-
-;;**********************************************************************
-;;                        NEW STUFF
-;;**********************************************************************
-
-(defun ls-induct (k x)
-  (if (zp k)
-      x
-    (ls-induct (1- k) (fl (/ x 2)))))
-
-(local (defthm lshiftamt-low-3-1
-    (implies (and (integerp k) (> k 0))
-	     (= (fl (/ (1- (expt 2 k)) 2))
-		(1- (expt 2 (1- k)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '())
-           :use ((:instance fl-unique
-                                   (x (/ (1- (expt 2 k)) 2))
-                                   (n (1- (expt 2 (1- k))))))))))
-
-(local (defthm lshiftamt-low-3-2
-    (implies (and (integerp k) (> k 0))
-	     (= (mod (1- (expt 2 k)) 2) 1))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable expt-split)
-                              '())
-           :use ((:instance mod012 (m (1- (expt 2 k))))
-			(:instance mod-mod-2-not-equal (m (1- (expt 2 k))))
-			(:instance mod-2*i (i (expt 2 (1- k)))))))))
-
-
-
-(local (defthm lshiftamt-low-3
-    (implies (and (integerp k) (>= k 0)
-		  (integerp x) (>= x 0) (< x (expt 2 k)))
-	     (= (logior (1- (expt 2 k)) x)
-		(1- (expt 2 k))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d ( expt-split mod-mult-of-n) ( logior-even))
-           :induct (ls-induct k x))
-	  ("Subgoal *1/2" :use (lshiftamt-low-3-1
-				lshiftamt-low-3-2
-				(:instance mod012 (m x))
-				(:instance quot-mod (m x) (n 2))
-				(:instance quot-mod (m (logior (1- (expt 2 k)) x)) (n 2))
-				(:instance fl-def-linear (x (/ x 2)))
-                                )))))
-;where used?
-;this is sort of like logior-ones?
-;BOZO kill or move this?
-(local (defthm lshiftamt-low-4
-              (implies (and (integerp k) (>= k 0)
-                            (integerp x) (> x 0)
-                            (= (expo x) k))
-                       (= (logior x (1- (expt 2 k)))
-                          (1- (expt 2 (1+ k)))))
-              :rule-classes ()
-              :hints (("Goal" :in-theory (e/d( expt-split) (EXPO-COMPARISON-REWRITE-TO-BOUND 
-                                                            expo-bound-eric
-                                                            MOVE-NEGATIVE-CONSTANT-1
-                                                            EXPO-COMPARISON-REWRITE-TO-BOUND-2))
-                       :use (expo-upper-bound
-                             expo-lower-bound
-;			(:instance expt-pos (x k))
-;			(:instance bit-basic-d (x (- x (expt 2 k))) (y (1- (expt 2 k))))
-                             (:instance or-dist-b (n k) (x 1) (y (- x (expt 2 k))))
-;			(:instance bit-basic-f (x (expt 2 k)) (y (- x (expt 2 k))) (z (1- (expt 2 k))))
-                             (:instance lshiftamt-low-3 (x (- x (expt 2 k))))
-                             (:instance or-dist-b (n k) (x 1) (y (1- (expt 2 k)))))))))
-
-
-;;
-;; ocat
-;;
-
-
-#|old definition
-(defun OCAT (x y n)
-  (+ (* (expt 2 n) x) y))
-|#
-
-;now always returns a nat
-(defund ocat (x y n)
-  (declare (xargs :guard t))
-  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
-
-
-(defthm ocat-nonnegative-integer-type
-  (and (integerp (OCAT X Y N))
-       (<= 0 (OCAT X Y N)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than ocat-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription ocat)))
-
-;just a rewrite rule
-(defthm ocat-natp
-  (natp (ocat x y n)))
-
-;proved in ocat.lisp
-(defthm ocat-bvecp
-  (implies (and (>= k n) ;handle other case?
-                (bvecp x (- k n))
-                (case-split (natp n))
-                (case-split (natp k))
-                (case-split (bvecp y n))
-                )
-           (bvecp (ocat x y n) k)))
-
-;add ocat-bvecp-rewrite!
-
-;this has caused problems in the past (size information is lost)?
-;proved in ocat.lisp
-(defthm ocat-0-rewrite
-    (implies (and (case-split (integerp x))
-		  (case-split (<= 0 x)))
-	     (equal (ocat 0 x n) x)))
-
-;proved in ocat.lisp
-(defthm ocat-associative
-  (implies (and (case-split (<= 0 m)) ;new now that ocat fixes its args
-                (case-split (<= 0 n)) ;new now that ocat fixes its args
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (ocat (ocat x y m) z n)
-                  (ocat x (ocat y z n) (+ m n)))))
-
-;;bits-ocat
-;this stuff should be moved to cat? or ocat?
-(defthm bits-ocat-1
-  (implies (and (< i n)
-                (case-split (natp y))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp n))
-                )
-           (equal (bits (ocat x y n) i j)
-                  (bits y i j)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable ocat)
-                              '(;expt-2-integerp
-                                ))
-           :use (;(:instance mod-bits (x (ocat x y n))) ;try
-;                 (:instance expt-2-integerp (i (- n (1+ i)))) ;elim?
-;                 (:instance mod-mult-eric (y (expt 2 (1+ i))) (x y) (a (* x (expt 2 (- n (1+ i))))))
-                 ))))
-
-(defthm bits-ocat-2
-  (implies (and (>= j n)
-                (case-split (natp x))
-                (case-split (bvecp y n))
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (ocat x y n) i j)
-                  (bits x (- i n) (- j n))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable ocat bvecp)
-                              '(CANCEL_PLUS-EQUAL-CORRECT
-                                CANCEL_PLUS-LESSP-CORRECT))
-           :use ((:instance fl-unique (x (/ (ocat x y n) (expt 2 n))) (n x))
-                 (:instance bits-shift-down-1 (i (- i n)) (j (- j n)) (x (ocat x y n)) (k n))
-                 ))))
-
-
-
-(defthm bits-ocat-3
-  (implies (and (>= i n)
-                (< j n)
-                (case-split (bvecp y n))
-                (case-split (natp x))
-                (case-split (natp n))
-                (case-split (natp i))
-                (case-split (natp j))
-                )
-           (equal (bits (ocat x y n) i j)
-                  (ocat (bits x (- i n) 0)
-                       (bits y (1- n) j)
-                       (- n j))))
-  :hints (("Goal" :in-theory (enable ocat bvecp-forward  bits-plus-mult-1)
-           :use ((:instance bits-plus-bits (x (ocat x y n)) (p n) (n i) (m j)))
-           )))
-
-;includes both bits-ocat-1, bits-ocat-2, and bits-ocat-3
-;we expect the indices to be constants, so this won't cause case-splits
-(defthm bits-ocat
-  (implies (and (case-split (bvecp y n))
-                (case-split (natp x))
-                (case-split (natp n))
-                (case-split (natp i))
-                (case-split (natp j))
-                )
-           (equal (bits (ocat x y n) i j)
-                  (if (< i n)
-                      (bits y i j)
-                    (if (>= j n)
-                        (bits x (- i n) (- j n))
-                      (ocat (bits x (- i n) 0)
-                           (bits y (1- n) j)
-                           (- n j))))))
-  :hints (("Goal" :in-theory (enable bvecp)))
-  )
-
-;bits-ocat should be all we need for simplifying (bits (ocat...))
-(in-theory (disable bits-ocat-1 bits-ocat-2 bits-ocat-3))
-
-;; bitn-ocat
-
-(defthm bitn-ocat-1
-  (implies (and (< i n)
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (natp x))
-                (case-split (natp y))
-                )
-           (equal (bitn (ocat x y n) i)
-                  (bitn y i)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn bits-ocat-1)
-                              '()))))
-
-(defthm bitn-ocat-2
-  (implies (and (>= i n)
-                (case-split (bvecp y n))
-                (case-split (natp x))
-                (case-split (natp n))
-                (case-split (integerp i))
-                )
-           (equal (bitn (ocat x y n) i)
-                  (bitn x (- i n))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn)
-                              '()))))
-
-;includes both bitn-ocat-1 and bitn-ocat-2
-(defthm bitn-ocat
-  (implies (and (case-split (bvecp y n))
-                (case-split (natp x))
-                (case-split (natp n))
-                (case-split (integerp i))
-                )
-           (equal (bitn (ocat x y n) i)
-                  (if (< i n)
-                      (bitn y i)
-                    (bitn x (- i n)))))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-;bitn-ocat should be all we need for simplifying (bitn (ocat...))
-(in-theory (disable bitn-ocat-1 bitn-ocat-2))
-
-
-; The following rule allows us to relieve (integerp x) hypotheses when
-; a rule applies to show (natp x).
-;This rule can be very expensive.  We don't want to backchain to natp if all we need is integerp!
-;Our plan is to enable natp in RTL proofs, so we disable this.
-;move
-(defthmd natp-integerp
-  (implies (natp x)
-           (integerp x)))
-
-;proved in bitn...
-(defthm bitn-bitn-0
-  (equal (bitn (bitn x n) 0)
-         (bitn x n)))
-
-(include-book "sumbits") ; used in lemmas about cat, below (search for sumbits)
-
-;BOZO proved in logior...
-(defthm logior-ones
-  (implies (and (natp n)
-                (bvecp x n))
-           (equal (logior x (1- (expt 2 n)))
-                  (1- (expt 2 n))))
-  :rule-classes ())
-
-(defthm logxor-ones
-  (implies (and (natp n)
-                (bvecp x n) ;drop this hyp?
-                )
-           (equal (logxor x (1- (expt 2 n)))
-                  (lnot x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable lnot bvecp)
-                              '(lnot-bvecp))
-           :use (lnot-bvecp
-                 (:instance logxor-rewrite-2 (y (1- (expt 2 n))))
-                 (:instance logand-ones (i (lnot x n)))))))
-
-
-
-
-;(in-theory (disable bitn-bvecp-0)) ;why?
-
-(defun logop-3-induct (x y z)
-  (declare (xargs :measure (+ (nfix x) (nfix y) (nfix z))))
-  (if (and (natp x) (natp y) (natp z))
-      (if (and (zp x) (zp y) (zp z))
-	  t
-	(logop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
-    t))
-
-(defun log3a (x y z)
-  (logior (logand x y) (logior (logand x z) (logand y z))))
-
-(defun log3b (x y z)
-  (logior (logand x y) (logand (logxor x y) z)))
-
-(local (in-theory (disable mod-equal-0 mod-by-2-rewrite-to-even)))
-
-(local (defthm log3-1
-    (implies (and (natp x) (natp y) (natp z)
-		  (equal (log3a (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)))
-			 (log3b (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)))))
-	     (equal (log3a x y z)
-		    (log3b x y z)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable)
-		  :use ((:instance mod012 (m x))
-			(:instance mod012 (m y))
-			(:instance mod012 (m z))
-			(:instance quot-mod (m (log3a x y z)) (n 2))
-			(:instance quot-mod (m (log3b x y z)) (n 2)))))))
-
-(defun logop-induct (x y z)
-  (declare (xargs :measure (+ (nfix x) (nfix y) (nfix z))))
-  (if (and (natp x) (natp y) (natp z))
-      (if (and (zp x) (zp y) (zp z))
-	  t
-	(logop-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
-    t))
-
-;make a logtop book and put this in it?
-;or move this to log.lisp?
-(defthm log3
-    (implies (and (natp x) (natp y) (natp z))
-	     (equal (logior (logand x y) (logior (logand x z) (logand y z)))
-		    (logior (logand x y) (logand (logxor x y) z))))
-  :rule-classes ()
-  :hints (("Goal" :induct (logop-induct x y z))
-	  ("Subgoal *1/2" :use (log3-1))))
-
-
-
-
-(defthm exact-k+1
-    (implies (and (natp n)
-		  (natp x)
-		  (= (expo x) (1- n))
-		  (natp k)
-		  (< k (1- n))
-		  (exactp x (- n k)))
-	     (iff (exactp x (1- (- n k)))
-		  (= (bitn x k) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use (exact-bits-b-d
-			(:instance exact-bits-b-d (k (1+ k)))
-			(:instance bits-0-bitn-0 (n k))))))
-
-;from bits.  included so i can disable it
-(defthmd bits-reduce
-  (implies (and (< x (expt 2 (+ 1 i)))
-                (case-split (integerp x))
-                (case-split (<= 0 x))
-                (case-split (integerp i))
-                )
-           (equal (bits x i 0)
-                  x)))
-
-(in-theory (disable bits-tail)) ;yuck?
-
-
-;===
-
-;!! drop??
-;or move to lnot?
-(defthmd lnot-fl-rewrite
-  (implies (and (not (zp n))
-                (bvecp x n))
-           (equal (fl (* 1/2 (lnot x n)))
-                  (lnot (fl (* 1/2 x)) (1- n))))
-  :hints (("Goal" :use ((:instance lnot-fl-original (k 1))))))
-
-;(in-theory (enable logxor-bvecp)) ;why ever disabled?
-
-
-(local (defthm lnot-logxor-1
-    (implies (and (not (zp n))
-		  (bvecp x n)
-		  (bvecp y n)
-		  (equal (lnot (logxor (fl (/ x 2)) (fl (/ y 2))) (1- n))
-			 (logxor (lnot (fl (/ x 2)) (1- n)) (fl (/ y 2)))))
-	     (equal (lnot (logxor x y) n)
-		    (logxor (lnot x n) y)))
-  :rule-classes ()
-  :otf-flg t
-  :hints (("Goal" :in-theory (e/d ( ;lnot-mod-by-2-alt ;drop?
-                                     lnot-bvecp
-				     lnot-fl-rewrite
-                                     mod-lnot-by-2)
-                                  ( LNOT-FL-eric))
-		  :use ((:instance mod012 (m x))
-			(:instance mod012 (m y))
-			(:instance quot-mod (m (lnot (logxor x y) n)) (n 2))
-			(:instance quot-mod (m (logxor (lnot x n) y)) (n 2)))))))
-
-(defun logop2-induct (x y n)
-  (if (zp n)
-      (cons x y)
-    (logop2-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-
-;move up?
-(defthm bvecp-fl
-    (implies (and (not (zp n))
-		  (bvecp x n))
-	     (bvecp (fl (* 1/2 x)) (1- n)))
-  :hints (("Goal" :in-theory (enable bvecp expt-split))))
-
-
-
-(defthmd lnot-logxor
-  (implies (and (natp n)
-                (bvecp x n)
-                (bvecp y n))
-           (equal (lnot (logxor x y) n)
-                  (logxor (lnot x n) y)))
-  :hints (("Goal" :induct (logop2-induct x y n))
-	  ("Subgoal *1/2" :use (lnot-logxor-1))))
-
-;may be very expensive if we backchain from rationalp to integerp
-;move
-(defthmd integerp-rationalp
-  (implies (integerp x)
-           (rationalp x)))
-
-;move
-(defun logop-2-induct (x y)
-  (if (or (zp x) (zp y))
-      ()
-    (logop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
-
-;move
-(defun logop-2-n-induct (x y n)
-  (if (zp n)
-      (cons x y)
-    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
-
-;move to log?
-;not exported anywhere?
-;BOZO put bitn in conclusion and gen hyp..
-(defthm logand-1-x
-    (implies (bvecp x 1)
-	     (equal (logand 1 x) x))
-  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
-
-(defthm ocat-bits-bits
-  (implies (and (equal j (1+ k))
-                (equal n (+ 1 (- l) k))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (integerp i))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (ocat (bits x i j) (bits x k l) n)
-                  (bits x i l)))
-  :hints (("Goal" :in-theory (enable ocat)
-           :use ((:instance bits-plus-bits (n i) (p j) (m l))))))
-
-(defthm ocat-bitn-bits
-    (implies (and (equal j (+ 1 k))
-		  (equal n (+ 1 (- l) k))
-		  (case-split (<= l k))
-		  (case-split (integerp j))
-                  (case-split (integerp k))
-                  (case-split (integerp l))
-		  )
-	     (equal (ocat (bitn x j) (bits x k l) n)
-		    (bits x j l)))
-    :hints (("Goal" :in-theory (set-difference-theories
-                                (enable bitn)
-                                '()))))
-
-(defthm ocat-bits-bitn
-  (implies (and (equal j (+ 1 k))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (ocat (bits x i j) (bitn x k) 1)
-                  (bits x i k)))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn)
-                              '()))))
-
-;perhaps just use bvecp-expo-rewrite?
-(defthm bvecp-expo
-  (implies (case-split (natp x))
-           (bvecp x (+ 1 (expo x))))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (expo-upper-bound))))
-
-(defthm bvecp-expo-rewrite
-  (equal (bvecp x (+ 1 (expo x)))
-         (natp x)) ;rephrase to remove natp?
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-
-
-
-;if leading bit is zero, can drop it
-;move to bits?
-;make this better? make more like this?
-(defthmd lead-bit-0
-  (implies (and (equal (bitn x n) 0)
-                (bvecp x (+ 1 n))
-                (rationalp n)
-                )
-           (equal (bits x (- n 1) 0)
-                  x))
-  :hints (("goal" :in-theory (enable bits-tail)
-           :use ((:instance bitn-plus-bits
-                                   (x x)
-                                   (m 0)
-                                   (n n) )))))
-
-;Splits (bits x i j) into three pieces, where (bits x k l) is the middle piece.
-;Not a rewrite rule since it does the same thing as ocat-bits-bits firing twice.
-(defthm ocat-bits-bits-bits
-  (implies (and (<= k i)
-                (<= l k)
-                (<= j l)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp l)
-                )
-           (equal (ocat (bits x i (+ 1 k))
-                        (ocat (bits x k l)
-                              (bits x (1- l) j)
-                              (+ l (- j)))
-                        (+ 1 (- j) k))
-                  (bits x i j)))
-  :rule-classes nil)
-
-
-
-;make about cat and add to lib/
-(defthm logior1-ocat
-  (implies (and (case-split (bvecp y n))
-                (case-split (natp x)))
-           (equal (logior1 (ocat x y n))
-                  (logior (logior1 x)
-                          (logior1 y))))
-  :hints (("Goal" :in-theory (enable logior1 bvecp))))
-
-;move to bitn?
-(defthm bitn-bits-gen
-  (implies (and (case-split (<= 0 k))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (bitn (bits x i j) k)
-                  (if (<= k (- i j))
-                      (bitn x (+ j k))
-                    0)))
-  :hints (("Goal" :in-theory (enable bitn-bits BVECP-BITN-0))))
-
-(defthmd bvecp-shift-down
-  (implies (and (bvecp x n)
-                (natp n)
-                (natp k))
-           (bvecp (fl (/ x (expt 2 k))) (- n k)))
-  :hints (("Goal" :in-theory (enable bvecp expt-split))))
-
-;like bvecp-shift?  prove from that?
-(defthmd bvecp-shift-up
-    (implies (and (bvecp x (- n k))
-                  ;(<= k n)
-                  (natp k)
-                  (integerp n) ;(natp n)
-		  )
-	     (bvecp (* x (expt 2 k)) n))
-  :hints (("Goal" :in-theory (enable bvecp))))
-
-;export!! enable?
-;gen?
-(defthmd expt2-of-non-integer-special
-  (implies (case-split (not (integerp i)))
-           (equal (expt 2 (+ 1 i))
-                  (if (acl2-numberp i)
-                      1
-                    2))))
-
-(local
- (defthm bits-sum-2
-    (implies (and (integerp i)
-                  (integerp j)
-		  (>= i j)
-		  (>= j 0)
-                  )
-	     (equal (+ (bits x i 0)
-		       (bits y i 0))
-		    (+ (* (expt 2 j)
-			  (+ (bits x i j)
-			     (bits y i j)
-			     (bitn (+ (bits x (1- j) 0)
-				      (bits y (1- j) 0))
-				   j)))
-		       (bits (+ (bits x (1- j) 0)
-				(bits y (1- j) 0))
-			     (1- j)
-			     0))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance bits-plus-bits (n i) (p j) (m 0))
-			(:instance bits-plus-bits (x y) (n i) (p j) (m 0))
-			(:instance bitn-plus-bits (x (+ (bits x (1- j) 0) (bits y (1- j) 0))) (n j) (m 0)))))))
-
-
-
-(defthm bits-sum-helper
-  (implies (and (integerp x) ;logically necessary
-                (integerp y) ;logically necessary
-                (integerp i)
-                )
-           (equal (bits (+ x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bitn (+ (bits x (1- j) 0)
-                                    (bits y (1- j) 0))
-                                 j))
-                        (- i j) 0)))
-  :rule-classes nil
-  :hints (("Goal" :use (bits-sum-2 
-;			bits-sum-6
-			(:instance bits-plus-mult-1
-				   (x (bits (+ (bits x (1- j) 0)
-					       (bits y (1- j) 0))
-					    (1- j)
-					    0))
-				   (y (+ (bits x i j)
-					 (bits y i j)
-					 (bitn (+ (bits x (1- j) 0)
-						  (bits y (1- j) 0))
-					       j)))
-				   (k j)
-				   (n i)
-				   (m j))))))
-
-
-;The hyps are logically necessary because the conclusion chops off those bits of x and y which are past the
-;binary point.  (So the theorem is only true for integers, which have no such bits).
-(defthm bits-sum-original
-  (implies (and (integerp x)
-                (integerp y)
-                )
-           (equal (bits (+ x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (bitn (+ (bits x (1- j) 0)
-                                    (bits y (1- j) 0))
-                                 j))
-                        (- i j) 0)))
-  :rule-classes ()
-  :hints (("subgoal 3" :use bits-sum-helper)
-          ("Goal" :cases ((and (integerp i) (integerp j))
-                          (and (integerp i) (not (integerp j)))
-                          (and (not (integerp i)) (integerp j)))
-           :in-theory (e/d () (BITN-IN-SUM-SPLIT-CASES)))))
-
-
-#|
-;helpful or not?
-(defthm bitn-sum
-  (implies (and (integerp x) ;logically necessary
-                (integerp y) ;logically necessary
-                )
-           (equal (bitn (+ x y) n)
-                  (bitn (+ (bitn x n)
-                           (bitn y n)
-                           (bitn (+ (bits x (1- n) 0)
-                                    (bits y (1- n) 0))
-                                 n))
-                        0)))
-  :rule-classes ()
-  :hints (("Goal" :use (:instance bits-sum-original (i n) (j n))
-           :in-theory (e/d (bitn) ()))))
-
-(defthm bitn-of-integer-with-n-negative
-  (implies (and (< n 0)
-                (integerp x))
-           (equal (bitn x n)
-                  0))
-  :hints (("Goal" :in-theory (e/d (bitn) ()))))
-
-;generalize?
-if we know that (bits x i j) = a constant, then we know what any sub-vector of (bits x i j) equals
-(defthm bits-0-implies-subrange-0
-  (implies (and (equal 0 (bits x i+ j)) ;j+ is a free var
-                (< i i+)
-                (integerp j+)
-                (integerp i)
-                )
-           (equal (bits x i j)
-                  0))
-  :hints (("Goal" :use ((:instance bits-plus-bits (x x)
-                                   (n i+)
-                                   (m j)
-                                   (p (+ 1 i)))))))
-
-                  
-
-(defthm bits-sum-special-case-helper
-  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
-                (natp i) (natp j) (natp x) (natp y))
-           (equal (bitn (+ (bits x (1- j) 0)
-                           (bits y (1- j) 0))
-                        j)
-                  (logior (bitn x (1- j)) (bitn y (1- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1 BITS-SUM-1 BITS-SPLIT-AROUND-ZERO)
-           :use ((:instance bits-plus-bits (x (+ (BITS X (+ -1 J) 0)
-                                                 (BITS Y (+ -1 J) 0)))
-                            (n j)
-                            (m 0)
-                            (p (+ -1 j)))
-                 (:instance bits-sum-4 (i (+ -1 j)) (j 0))))))
-
-(:instance bitn-plus-bits (x (+ (BITS X (+ -1 J) 0)
-                                                 (BITS Y (+ -1 J) 0)))
-                            (n (+ -1 j))
-                            (m 0))
-
-(defthm bits-sum-special-case-helper
-  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
-                (natp i) (natp j) (natp x) (natp y))
-           (equal (bitn (+ (bits x (1- j) 0)
-                           (bits y (1- j) 0))
-                        j)
-                  (logior (bitn x (1- j)) (bitn y (1- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
-           :use ((:instance  bitn-sum (n (+ -1 j))) 
-))))
-                 )))
-
-
-
-(defthm bits-sum-special-case-helper
-  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
-                (natp i) (natp j) (natp x) (natp y))
-           (equal (bitn (+ (bits x (1- j) 0)
-                           (bits y (1- j) 0))
-                        j)
-                  (logior (bitn x (1- j)) (bitn y (1- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (e/d () ()))))
-           :use (
-
-                 ))))
-
-
-
-
-
-(defthm bits-sum-special-case-helper
-  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
-                (natp i) (natp j) (natp x) (natp y))
-           (equal (bitn (+ (bits x (1- j) 0)
-                           (bits y (1- j) 0))
-                        j)
-                  (logior (bitn x (1- j)) (bitn y (1- j)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
-           :use ((:instance bitn-0-1 (x x) (n (+ -1 j)))
-                 (:instance bitn-0-1 (x y) (n (+ -1 j)))
-                 (:instance bitn-sum (n (+ -1 j)))
-                 (:instance bitn-plus-bits (x x)
-                                   (n (+ -1 j)) (m 0))
-                 (:instance bitn-plus-bits (x y)
-                                   (n (+ -1 j)) (m 0))
-                 ))))
-
-
-
-(defthm bits-sum-special-case-helper
-  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
-                (natp i) (natp j) (natp x) (natp y))
-           (equal (bitn (+ (bits x (1- j) 0)
-                           (bits y (1- j) 0))
-                        j)
-                  (logior (bitn x (1- j)) (bitn y (1- j)))))
-  :otf-flg t
-  :hints (("Goal" :use ((:instance bitn-plus-bits (x (+ (bits x (1- j) 0)
-                                                        (bits y (1- j) 0)))
-                                   (n j) (m 0))
-                        (:instance bitn-plus-bits (x x)
-                                   (n (+ -1 j)) (m 0))
-                        (:instance bitn-plus-bits (x y)
-                                   (n (+ -1 j)) (m 0))
-                        (:instance bitn-plus-bits (x (+ x y))
-                                   (n (+ -1 j)) (m 0))
-                        ))))
-
-
-                        (:instance bitn-plus-bits (x (+ (bits x (1- j) 0)
-                                                        (bits y (1- j) 0)))
-                                   (n j) (m 0))
-
-)
-
-
-
-
- )      
-
-
-                 
-                        
-
-(defthm bits-sum-special-case
-    (implies (and (= (bits (+ x y) (1- j) 0) 0)
-                  (natp x)
-		  (natp y)
-		  (natp i)
-		  (natp j)
-		  (>= i j)
-		  (> j 0)
-		  )
-	     (equal (bits (+ x y) i j)
-		    (bits (+ (bits x i j) (bits y i j) (logior (bitn x (1- j)) (bitn y (1- j))))
-			  (- i j) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable BITN-IN-SUM-SPLIT-CASES
-                                      BITN-KNOWN-NOT-0-REPLACE-WITH-1)
-           :use (bits-sum-original
-                 bits-sum-special-case-helper)))) 
-
-
-(defthm bits-of-negative-integer
-  (implies (and (integerp x)
-                (< 0 x)) ;gen
-           (equal (bits (- x) i j)
-                  zz)))
-
-
-;BOZO.  This looped!
-(in-theory (disable BITN-DROP-CRUCIAL-BIT-AND-FLIP-RESULT-ALT-GEN))
-
-
-
-;gen to any bits of any constant?
-(defthm bits-of-constant-integer-down-to-0
-  (implies (and (integerp x)
-                (<= 0 x)
-                (<= (expo x) i))
-           (equal (bits x i 0)
-                  (bits x (expo x) 0)))
-  :hints (("Goal" :in-theory (enable bits-tail)))
-  )
-
-(defthm bits-1
-  (implies (case-split (integerp i))
-           (equal (bits 1 i 0)
-                  (if (<= 0 i)
-                      1
-                    0))))
-
-
-
-rewrite:
-
-(defthm bits-less-than-x-rewrite
-  (implies (and (natp i)
-                (natp j)
-                (natp x)
-                (< 0 x)
-                (<= j i)
-                )
-           (equal (< (bits x i j) x)
-                  (if (< 0 j)
-                      t
-                    (if (<= i (expo x))
-                        nil
-                      t)))))
-
-
-(defthm bits-x-equal-x
-  (implies (and (natp i)
-                (natp j)
-                (natp x)
-                (< 0 x)
-                (<= j i)
-                )
-           (implies (equal (bits x i j) x)
-                    (and (equal j 0)
-                         (<= (expo x) i))))
-  :rule-classes nil
-  :hints (("goal" :in-theory (enable bits)))
-  )
-
-(defthm bits-1-gen
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (<= 0 j))
-                )
-           (equal (bits 1 i j)
-                  (if (< 1 j)
-                      0
-                    (if (<= 0 i)
-                        1
-                      0))))
-  :hints (("Goal"; :in-theory (enable bits)
-           :cases ((equal 0 j))))
-  )
-
-
-
-(defthm bits-with-indices-in-the-wrong-order-2
-  (implies (case-split (< i j))
-           (equal (bits x i j)
-                  0)))
-
-;;This should be in lib/ ???:
-;prove from bits-sum-original ?
-(defthm bits-sum-plus-1-original
-    (implies (and (integerp x)
-                  (integerp y)
-		  (natp i)
-		  (natp j)
-		  (>= i j)
-		  (>= j 0))
-	     (equal (bits (+ 1 x y) i j)
-		    (bits (+ (bits x i j)
-			     (bits y i j)
-			     (bitn (+ 1
-				      (bits x (1- j) 0)
-				      (bits y (1- j) 0))
-				   j))
-			  (- i j) 0)))
-    :otf-flg t
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance bits-sum-original (x (+ x y)) (y 1))
-                        (:instance bits-sum-original))
-))
-)
-
-  |#
-
-
-
-
-
-
-
-;sort of a special case of another thm?
-(local (defthm sticky-21-1
-              (implies (and (= (bits (+ x y) (1- k) 0) 0)
-                            (integerp x)
-                            (integerp y)
-                            )
-                       (= (bits (+ (bits x (1- k) 0)
-                                   (bits y (1- k) 0))
-                                (1- k) 0)
-                          0))
-              :rule-classes ()
-              :hints (("Goal" ;:in-theory (enable bits-mod)
-                       :use ( ;(:instance mod-mod-sum (a x) (b y) (n (expt 2 k)))
-                             )))))
-
-;Either there is a carry or there isn't.
-(local (defthm sticky-21-6
-    (implies (and (= (bits (+ x y) (1- k) 0) 0)
-                  (integerp x)
-		  (integerp y)
-;		  (natp k)
-		  ;(> k 0)
-		  )
-	     (member (+ (bits x (1- k) 0)
-			(bits y (1- k) 0))
-		     (list (expt 2 k) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits fl-equal-rewrite)
-		  :use (;sticky-21-5
-			sticky-21-1
-			(:instance quot-mod
-				   (m (+ (bits x (1- k) 0)
-					 (bits y (1- k) 0)))
-				   (n (expt 2 k))))))))
-
-(local (defthm sticky-21-7
-              (implies (and (integerp x)
-                            (integerp y)
-      ;                            (integerp k)
-      ;                            (natp k)
-      ;(>= k 2)
-                            (= (bits (+ x y) (1- k) 0) 0)
-                            (= (bitn x (1- k)) 0)
-                            (= (bitn y (1- k)) 0))
-                       (equal (+ (bits x (1- k) 0)
-                                 (bits y (1- k) 0))
-                              0))
-              :rule-classes ()
-              :hints (("Goal" :in-theory (enable   bits-of-non-integer-special)
-                       :use (sticky-21-6
-                             (:instance bitn-plus-bits (n (1- k)) (m 0))
-                             (:instance bitn-plus-bits (x y) (n (1- k)) (m 0)))))))
-
-
-
-(local (defthm sticky-21-8-2
-    (implies (and (integerp x)
-		  (integerp y)
-		  (>= k 1)
-		  (= (bits (+ x y) (1- k) 0) 0)
-		  (or (= (bitn x (1- k)) 1)
-		      (= (bitn y (1- k)) 1)))
-	     (equal (+ (bits x (1- k) 0)
-		       (bits y (1- k) 0))
-		    (expt 2 k)))
-  :rule-classes ()
-  :hints (("Goal" :use (sticky-21-6
-;			hack-8
-;			hack-9
-			(:instance bitn-plus-bits (n (1- k)) (m 0))
-			(:instance bitn-plus-bits (x y) (n (1- k)) (m 0)))))))
-
-
-;similar to another lemma
-(local (defthm bitn+0
-    (implies (and (integerp x)
-		  (integerp y)
-                  )
-	     (= (bitn (+ x y) 0)
-		(bitn (+ (bitn x 0) (bitn y 0)) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-rec-0)
-		  :use ((:instance mod-sum (a (bitn x 0)) (b y) (n 2))
-			(:instance mod-sum (a y) (b x) (n 2)))))))
-
-(local (defthm sticky-21-8-1
-    (implies (and (integerp x)
-		  (integerp y)
-		  (= (bits (+ x y) 0 0) 0)
-		  (or (= (bitn x 0) 1)
-		      (= (bitn y 0) 1)))
-	     (equal (+ (bits x 0 0)
-		       (bits y 0 0))
-		    2))
-    :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits-n-n-rewrite ;yuck?
-                                     )
-		  :use (bitn+0
-			(:instance bitn-0-1 (n 0))
-			(:instance bitn-0-1 (x y) (n 0)))))))
-
-;move
-(defthmd bitn-of-non-integer-special
-  (implies (case-split (not (integerp i)))
-           (equal (bitn x i)
-                  0)))
-
-;move
-;BOZO try enabled
-(defthmd bitn-negative-bit-of-integer
-  (implies (and (integerp x)
-                (case-split (< i 0)))
-           (equal (bitn x i)
-                  0))
-  :hints (("Goal" :in-theory (e/d (bitn) ()))))
-
-(local (defthm sticky-21-8
-              (implies (and (integerp x)
-                            (integerp y)
-                            (= (bits (+ x y) (1- k) 0) 0)
-                            (or (= (bitn x (1- k)) 1)
-                                (= (bitn y (1- k)) 1)))
-                       (equal (+ (bits x (1- k) 0)
-                                 (bits y (1- k) 0))
-                              (expt 2 k)))
-              :rule-classes ()
-              :hints (("Goal" :in-theory (enable bitn-of-non-integer-special
-                                                 bitn-negative-bit-of-integer)
-                       :use (sticky-21-8-2
-                             sticky-21-8-1)))))
-
-(local (defthm sticky-21-9
-    (implies (and (integerp x)
-		  (integerp y)
-;		  (natp k)
-;		  (>= k 1)
-		  (= (bits (+ x y) (1- k) 0) 0))
-	     (equal (+ (bits x (1- k) 0)
-		       (bits y (1- k) 0))
-		    (* (expt 2 k)
-		       (logior (bitn y (1- k))
-			       (bitn x (1- k))))))
-  :rule-classes ()
-  :hints (("Goal" :use (sticky-21-7
-			sticky-21-8
-			(:instance bitn-0-1 (n (1- k)))
-			(:instance bitn-0-1 (x y) (n (1- k))))))))
-
-(local (defthm sticky-21-10
-    (implies (and (integerp x)
-		  (integerp y)
-                  (integerp k)
-;		  (natp k)
-;		  (>= k 1)
-;		  (natp n)
-		  (>= n k)
-		  (= (bits (+ x y) (1- k) 0) 0))
-	     (equal (* (expt 2 k) (bits (+ x y) n k))
-		    (bits (+ (bits x n 0) (bits y n 0))
-			  n 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable mod-sum bits)
-		  :use ((:instance bits-plus-bits (x (+ x y)) (n n) (p k) (m 0))
-			;(:instance mod-mod-sum (a x) (b y) (n (expt 2 k)))
-                        )))))
-
-(local (defthm sticky-21-11
-              (implies (and (integerp x)
-                            (integerp y)
-;                            (natp k)
-;                            (> k 0)
-;                            (natp n)
-                            (>= n k)
-                            (= (bits (+ x y) (1- k) 0) 0))
-                       (equal (* (expt 2 k) (bits (+ x y) n k))
-                              (bits (* (expt 2 k)
-                                       (+ (bits x n k) (bits y n k) (logior (bitn x (1- k)) (bitn y (1- k)))))
-                                    n 0)))
-              :rule-classes ()
-              :hints (("Goal" ; :in-theory (enable expt)
-                       :use (sticky-21-10
-                             sticky-21-9
-                             (:instance bits-plus-bits (n n) (p k) (m 0))
-                             (:instance bits-plus-bits (x y) (n n) (p k) (m 0)))))))
-
-;export??? rename!
-(local (defthm sticky-21
-    (implies (and (integerp x)
-		  (integerp y)
-;		  (natp k)
-		  (> k 0)
-;		  (natp n)
-		  (>= n k)
-		  (= (bits (+ x y) (1- k) 0) 0))
-	     (equal (bits (+ x y) n k)
-		    (bits (+ (bits x n k) (bits y n k) (logior (bitn x (1- k)) (bitn y (1- k))))
-			  (- n k) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-of-non-integer-special)
-           :use (sticky-21-11
-			(:instance bits-shift-up-2
-				   (x (+ (bits x n k) (bits y n k) (logior (bitn x (1- k)) (bitn y (1- k)))))
-				   (i (- n k))))))))
-
-;Used to be among the sticky lemmas.
-;prove from bits-sum-original?
-;BOZO gen!
-(defthm bits-sum-special-case
-  (implies (and (= (bits (+ x y) (1- j) 0) 0)
-                (integerp x)
-                (integerp y)
-                (>= j 0) ;gen?
-                )
-           (equal (bits (+ x y) i j)
-                  (bits (+ (bits x i j)
-                           (bits y i j)
-                           (logior (bitn x (1- j))
-                                   (bitn y (1- j))))
-                        (- i j) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-negative-bit-of-integer)
-           :use ((:instance sticky-21 (n i) (k j))))))
-
-
-
-
-(local (defthm bits-sum-1-1
-    (implies (and; (natp x)
-;		  (natp y)
-;		  (natp j)
-                  (integerp j)
-		  (>= j 0)
-                  )
-	     (equal (BITS (+ 1
-			     (BITS X (+ -1 J) 0)
-			     (BITS Y (+ -1 J) 0))
-			  J 0)
-		    (+ 1
-		       (BITS X (+ -1 J) 0)
-		       (BITS Y (+ -1 J) 0))))
-  :hints (("Goal" :in-theory (union-theories (disable bits-bvecp) '(natp expt-split bvecp))
-		  :use ((:instance bits-bvecp (i (1- j)) (j 0) (k j))
-			(:instance bits-bvecp (x y) (i (1- j)) (j 0) (k j))
-			(:instance bits-tail (x (+ 1 (BITS X (+ -1 J) 0) (BITS Y (+ -1 J) 0))) (i j)))))))
-
-(local (defthm bits-sum-1-2
-    (implies (and; (natp x)
-;		  (natp y)
-		  (natp i)
-		  (natp j)
-		  (>= i j)
-		  (>= j 0))
-	     (equal (+ 1
-		       (bits x i 0)
-		       (bits y i 0))
-		    (+ (* (expt 2 j)
-			  (+ (bits x i j)
-			     (bits y i j)
-			     (bitn (+ 1
-				      (bits x (1- j) 0)
-				      (bits y (1- j) 0))
-				   j)))
-		       (bits (+ 1
-				(bits x (1- j) 0)
-				(bits y (1- j) 0))
-			     (1- j)
-			     0))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance bits-plus-bits (n i) (p j) (m 0))
-			(:instance bits-plus-bits (x y) (n i) (p j) (m 0))
-			(:instance bitn-plus-bits (x (+ 1 (bits x (1- j) 0) (bits y (1- j) 0))) (n j) (m 0)))))))
-
-(local (defthm bits-sum-1-3
-    (implies (and; (natp x)
-		 ; (natp y)
-              (integerp x)
-              (integerp y)
-		  (natp i)
-		  (natp j)
-		  (>= i j)
-		  (>= j 0))
-	     (equal (mod (+ 1
-			    (bits x i 0)
-			    (bits y i 0))
-			 (expt 2 (1+ i)))
-		    (mod (+ 1 x y)
-			 (expt 2 (1+ i)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (union-theories (disable expt) '(bits-mod))
-		  :use ((:instance mod-sum (a (1+ (bits x i 0))) (b y) (n (expt 2 (1+ i))))
-			(:instance mod-sum (a (1+ y)) (b x) (n (expt 2 (1+ i)))))))))
-
-(local (defthm bits-sum-1-4
-    (implies (and (integerp x)
-                  (integerp y)
-		  (natp i)
-		  (natp j)
-		  (>= i j)
-		  (>= j 0))
-	     (equal (bits (+ 1 x y) i j)
-		    (bits (+ 1
-			     (bits x i 0)
-			     (bits y i 0))
-			  i j)))
-  :rule-classes ()
-  :hints (("Goal" :use (bits-sum-1-3
-			(:instance mod-bits-equal (x (+ 1 x y)) (y (+ 1 (bits x i 0) (bits y i 0)))))))))
-
-(local (defthm bits-sum-1-5
-    (implies (and (integerp x)
-                  (integerp y)
-		  (natp i)
-		  (natp j)
-		  (>= i j)
-		  (>= j 0))
-	     (equal (bits (+ 1 x y) i j)
-		    (bits (+ (* (expt 2 j)
-				(+ (bits x i j)
-				   (bits y i j)
-				   (bitn (+ 1
-					    (bits x (1- j) 0)
-					    (bits y (1- j) 0))
-					 j)))
-			     (bits (+ 1
-				      (bits x (1- j) 0)
-				      (bits y (1- j) 0))
-				   (1- j)
-				   0))
-			  i j)))
-  :rule-classes ()
-  :hints (("Goal" :use (bits-sum-1-4 bits-sum-1-2)))))
-
-(local (defthm bits-sum-1-6
-    (implies (and (integerp x)
-                  (integerp y)
-		  (natp i)
-		  (natp j)
-		  (>= i j)
-		  (>= j 0))
-	     (< (bits (+ 1
-			 (bits x (1- j) 0)
-			 (bits y (1- j) 0))
-		      (1- j)
-		      0)
-		(expt 2 j)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits-mod)
-		  :use ((:instance mod-bnd-1 (m (+ 1 (bits x (1- j) 0) (bits y (1- j) 0))) (n (expt 2 j))))))))
-
-;;This should be in lib/ ???:
-;prove from bits-sum-original ?
-#|
-When we add two bit vectors of length n, we only need to look at 1 bit of carry.  
-
-When we add three bitvectors of length n, we need to consider 2 bits of carry.  However, when one of those
-three bit vectors is 1, we need only consider 1 bit of carry.
-
-|#
-(defthm bits-sum-plus-1-original
-    (implies (and (integerp x)
-                  (integerp y)
-		  (natp i)
-		  (natp j)
-		  (>= i j)
-		  (>= j 0))
-	     (equal (bits (+ 1 x y) i j)
-		    (bits (+ (bits x i j)
-			     (bits y i j)
-			     (bitn (+ 1
-				      (bits x (1- j) 0)
-				      (bits y (1- j) 0))
-				   j))
-			  (- i j) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use (bits-sum-1-5 
-			bits-sum-1-6
-			(:instance bits-plus-mult-1
-				   (x (bits (+ 1
-					       (bits x (1- j) 0)
-					       (bits y (1- j) 0))
-					    (1- j)
-					    0))
-				   (y (+ (bits x i j)
-					 (bits y i j)
-					 (bitn (+ 1
-						  (bits x (1- j) 0)
-						  (bits y (1- j) 0))
-					       j)))
-				   (k j)
-				   (n i)
-				   (m j))))))
-
-
-
-
-;generalize to remove bits from the LHS?
-(defthm expo-bits-when-top-bit-is-1
-  (implies (and (equal 1 (bitn x i))
-                (case-split (<= j i))
-                (case-split (integerp j))
-		)
-	   (equal (expo (bits x i j))
-                  (+ i (- j))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (disable EQUAL-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE)
-           :use ((:instance expo-unique (x (bits x i j)) (n (+ i (- j))))
-                 (:instance bitn-plus-bits (n i) (m j))))))
-
-;generalize to remove bits from the LHS?
-(defthm sig-bits-when-top-bit-is-1
-  (implies (and (equal 1 (bitn x i))
-                (case-split (<= j i))
-                (case-split (integerp j))
-		)
-	   (equal (sig (bits x i j))
-                  (/ (bits x i j) (expt 2  (+ i (- j))))))
-  :hints (("Goal" :in-theory (enable sig))))
-
-
-;hack for now:
-;I could do this much better (if we know that (bits x i j) equals a constant, we know what any subrange equals.
-(defthm bits-0-means-top-bit-0
-  (implies (and (equal 0 (bits x i j))
-                (<= j i)
-                (integerp j)
-                )
-           (equal (bitn x i)
-                  0))
-  :hints (("Goal" :use (:instance bitn-plus-bits (n i) (m j)))))
-
-;BOZO This can be kind of expensive. Add back-chain-limit?
-(defthm bvecp-tighten
-  (implies (and (equal (bitn x (1- n)) 0)
-                (natp n))
-           (equal (bvecp x n)
-                  (bvecp x (1- n))))
-  :hints (("Goal" :use (:instance bitn-plus-bits (n (1- n)) (m 0))
-           :in-theory (e/d (bvecp)
-                           (BITS-SPLIT-AROUND-ZERO
-                            ;BITS-REDUCE-EXACTP
-                            )))))
-
-;add a bits-0-0-of-sig rule?  
-(defthm bitn-0-of-sig
-  (implies (and (rationalp x)
-                (not (equal x 0)))
-           (equal (bitn (sig x) 0)
-                  1))
-  :hints (("Goal" :in-theory (e/d ( bitn bits) ()))))
-
-
-;BOZO add
-;disable?
-(defthm bits-reduce-exactp
-  (implies (and (equal i (expo x))
-                (exactp x (+ 1 i (- j)))
-                (integerp j)
-                (rationalp x)
-                (<= 0 x) ;drop?
-                )
-           (equal (bits x i j)
-                  (/ x (expt 2 j))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable exactp sig)
-           :use ((:instance exact-bits-2 (n (+ 1 i)) (k j))
-                 ;(:instance exact-bits-2 (x (- x)) (n (+ 1 i)) (k j))
-                 ))))
-                        
-
-(defthm fp-rep-collapse
-  (implies (rationalp x)
-           (equal (* (sig x) (expt 2 (expo x)))
-                  (abs x)))
-  :hints (("goal" :in-theory (enable sig)))
-  )
-
-
-#|
-
-;move to somewhere else in library?
-(defthm bitn-1
-  (implies (and (equal (bitn x k) 1)
-                (integerp x)
-                (<= 0 x)
-                )
-           (>= x (expt 2 k)))
-  :hints (("Goal"
-           :use ((:instance bvecp-bitn-0 (x x) (n k)))
-           :in-theory (enable bvecp))) 
-  :rule-classes nil
-  )
-
-
-
-|#
-
-;BOZO, handle this right
-
-(defmacro mod- (x y n)
-  `(bits (- ,x ,y) (1- ,n) 0))
-
-;This won't fire, since mod- is a macro?
-(defthm mod--bvecp
-  (bvecp (mod- x y n) n))
-
-(include-book "cat")
-
-(defthm lnot-cat
-  (implies (and (case-split (natp n))
-		(case-split (natp m))
-		(equal l (+ m n)))
-	   (equal (lnot (cat x m y n) l)
-		  (cat (lnot x m) m (lnot y n) n)))
-  :hints (("Goal" :use (:instance cat-upper-bound)
-           :in-theory (e/d (lnot cat expt-split bits-reduce)
-                           (cat-upper-bound)))))
diff -Nru acl2-6.2/books/rtl/rel5/support/merge2.lisp acl2-6.3/books/rtl/rel5/support/merge2.lisp
--- acl2-6.2/books/rtl/rel5/support/merge2.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/merge2.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,207 +0,0 @@
-(in-package "ACL2")
-
-; This book includes theorems we would like to put in merge, but cannot because
-; that would introduce circular dependences.  For example, below we include the
-; land0 book, but land0 includes land0-proofs which includes merge.  (Perhaps
-; land0-proofs does not need to include merge, but we take the easy path here.)
-
-; Finally, lemmas relating lior0 and cat.  The first of these use sumbits.
-
-(include-book "merge")
-
-(include-book "lior0")
-
-(local
- (defthmd lior0-cat-1
-   (implies (and (case-split (integerp n))
-                 (case-split (integerp m))
-                 (>= n 0)
-                 (>= m 0)
-                 (equal l (+ m n))
-                 (integerp k)
-                 (<= 0 k)
-                 (< k l))
-            (equal (bitn (lior0 (cat x1 m y1 n) (cat x2 m y2 n) l) k)
-                   (bitn (cat (lior0 x1 x2 m) m (lior0 y1 y2 n) n) k)))
-   :hints (("Goal" :in-theory (enable bitn-cat)))))
-
-(defthmd lior0-cat
-  (implies (and (case-split (natp n))
-                (case-split (integerp m))
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (lior0 (cat x1 m y1 n) (cat x2 m y2 n) l)
-                  (cat (lior0 x1 x2 m) m (lior0 y1 y2 n) n)))
-  :hints (("Goal"
-           :in-theory (e/d (sumbits-badguy-is-correct
-                            sumbits-badguy-bounds
-                            lior0-cat-1)
-                           (bitn-lior0))
-           :restrict ((sumbits-badguy-is-correct ((k (+ m n))))))))
-
-(local
- (defthm lior0-bits-1-alt
-   (implies (and (case-split (integerp n))
-                 (case-split (integerp i))
-                 (>= (1+ i) n))
-            (equal (lior0 (bits x i 0) y n)
-                   (lior0 x y n)))
-   :hints (("Goal" :in-theory (e/d (lior0) (lior0-commutative))))))
-
-(defthm lior0-cat-constant
-  (implies (and (case-split (integerp n))
-                (case-split (integerp m))
-                (syntaxp (quotep c))
-                (> n 0)
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (lior0 c (cat x2 m y2 n) l)
-                  (cat (lior0 (bits c (+ -1 m n) n) x2 m)
-                       m
-                       (lior0 (bits c (1- n) 0) y2 n)
-                       n)))
-  :hints (("Goal" :use (:instance lior0-cat (x2 x2) (y2 y2) (m m) (n n)
-                                  (x1 (bits c (+ -1 m n) n))
-                                  (y1 (bits c (1- n) 0))
-                                  (l (+ m n))))))
-
-; Copy the above events but modify for land.
-
-(include-book "land0")
-
-(local
- (defthmd land0-cat-1
-   (implies (and (case-split (integerp n))
-                 (case-split (integerp m))
-                 (>= n 0)
-                 (>= m 0)
-                 (equal l (+ m n))
-                 (integerp k)
-                 (<= 0 k)
-                 (< k l))
-            (equal (bitn (land0 (cat x1 m y1 n) (cat x2 m y2 n) l) k)
-                   (bitn (cat (land0 x1 x2 m) m (land0 y1 y2 n) n) k)))
-   :hints (("Goal" :in-theory (enable bitn-cat)))))
-
-(defthmd land0-cat
-  (implies (and (case-split (natp n))
-                (case-split (integerp m))
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (land0 (cat x1 m y1 n) (cat x2 m y2 n) l)
-                  (cat (land0 x1 x2 m) m (land0 y1 y2 n) n)))
-  :hints (("Goal"
-           :in-theory (e/d (sumbits-badguy-is-correct
-                            sumbits-badguy-bounds
-                            land0-cat-1)
-                           (bitn-land0))
-           :restrict ((sumbits-badguy-is-correct ((k (+ m n))))))))
-
-(local
- (defthm land0-bits-1-alt
-   (implies (and (case-split (integerp n))
-                 (case-split (integerp i))
-                 (>= (1+ i) n))
-            (equal (land0 (bits x i 0) y n)
-                   (land0 x y n)))
-   :hints (("Goal" :in-theory (e/d (land0) (land0-commutative))))))
-
-(defthm land0-cat-constant
-  (implies (and (case-split (integerp n))
-                (case-split (integerp m))
-                (syntaxp (quotep c))
-                (> n 0)
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (land0 c (cat x2 m y2 n) l)
-                  (cat (land0 (bits c (+ -1 m n) n) x2 m)
-                       m
-                       (land0 (bits c (1- n) 0) y2 n)
-                       n)))
-  :hints (("Goal" :use (:instance land0-cat (x2 x2) (y2 y2) (m m) (n n)
-                                  (x1 (bits c (+ -1 m n) n))
-                                  (y1 (bits c (1- n) 0))
-                                  (l (+ m n))))))
-
-; Copy the above events but modify for lxor.
-
-(include-book "lxor0")
-
-(local
- (defthmd lxor0-cat-1
-   (implies (and (case-split (integerp n))
-                 (case-split (integerp m))
-                 (>= n 0)
-                 (>= m 0)
-                 (equal l (+ m n))
-                 (integerp k)
-                 (<= 0 k)
-                 (< k l))
-            (equal (bitn (lxor0 (cat x1 m y1 n) (cat x2 m y2 n) l) k)
-                   (bitn (cat (lxor0 x1 x2 m) m (lxor0 y1 y2 n) n) k)))
-   :hints (("Goal" :in-theory (enable bitn-cat)))))
-
-(defthmd lxor0-cat
-  (implies (and (case-split (natp n))
-                (case-split (integerp m))
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (lxor0 (cat x1 m y1 n) (cat x2 m y2 n) l)
-                  (cat (lxor0 x1 x2 m) m (lxor0 y1 y2 n) n)))
-  :hints (("Goal"
-           :in-theory (e/d (sumbits-badguy-is-correct
-                            sumbits-badguy-bounds
-                            lxor0-cat-1)
-                           (bitn-lxor0))
-           :restrict ((sumbits-badguy-is-correct ((k (+ m n))))))))
-
-(local
- (defthm lxor0-bits-1-alt
-   (implies (and (case-split (integerp n))
-                 (case-split (integerp i))
-                 (>= (1+ i) n))
-            (equal (lxor0 (bits x i 0) y n)
-                   (lxor0 x y n)))
-   :hints (("Goal" :in-theory (e/d (lxor0) (lxor0-commutative))))))
-
-(defthm lxor0-cat-constant
-  (implies (and (case-split (integerp n))
-                (case-split (integerp m))
-                (syntaxp (quotep c))
-                (> n 0)
-                (> m 0)
-                (equal l (+ m n)))
-           (equal (lxor0 c (cat x2 m y2 n) l)
-                  (cat (lxor0 (bits c (+ -1 m n) n) x2 m)
-                       m
-                       (lxor0 (bits c (1- n) 0) y2 n)
-                       n)))
-  :hints (("Goal" :use (:instance lxor0-cat (x2 x2) (y2 y2) (m m) (n n)
-                                  (x1 (bits c (+ -1 m n) n))
-                                  (y1 (bits c (1- n) 0))
-                                  (l (+ m n))))))
-
-;;;;;;;;;;;
-
-(include-book "logs")
-
-(local (include-book "bvecp"))
-
-(defthmd log=-cat-constant
-  (implies (and (syntaxp (quotep k))
-                (case-split (bvecp k (+ m n)))
-                (case-split (bvecp x m))
-                (case-split (bvecp y n))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (<= 0 m)))
-           (equal (log= k (cat x m y n))
-                  (land0 (log= x (bits k (+ -1 m n) n))
-                        (log= y (bits k (1- n) 0))
-                        1)))
-  :hints (("Goal" :use (:instance cat-equal-rewrite (x2 x) (y2 y) (n n) (m m)
-                                  (x1 (bits k (+ -1 m n) n))
-                                  (y1 (bits k (1- n) 0)))
-           :in-theory (enable log=))))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/mod4.lisp acl2-6.3/books/rtl/rel5/support/mod4.lisp
--- acl2-6.2/books/rtl/rel5/support/mod4.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/mod4.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,135 +0,0 @@
-(in-package "ACL2")
-
-;perhaps this book should be in arithmetic/
-
-
-
-;just a helper function
-(defund even-aux (x)
-  (if (zp x)
-      t
-    (if (eql 1 x)
-        nil
-      (even-aux (+ -2 x)))))
-
-;A recursive recognizer for even integers.
-;Note that EVEN is not the same as the built in function EVENP
-(defund even (x)
-  (if (not (integerp x))
-      nil
-    (if (< x 0)
-        (even-aux (- x))
-      (even-aux x))))
-
-;A recognizer for odd integers.
-(defund odd (x)
-  (and (integerp x)
-       (not (even x))))
-
-(local (include-book "../arithmetic/top"))
-
-;or maybe we do want mod4 to agree with (mod n 4) on weird values??
-;no, we want a nice t-p rule?
-(defund mod4 (n)
-  (if (not (integerp n))
-      0
-    (mod n 4)))
-
-
-
-(defthm mod4-values
-  (or (equal 0 (mod4 n))
-      (equal 1 (mod4 n))
-      (equal 2 (mod4 n))
-      (equal 3 (mod4 n)))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (e/d (mod4))))
-  )
-
-(defthm mod4-type-prescription
-  (and (integerp (mod4 n))
-       (<= 0 (mod4 n)))
-  :hints (("Goal" :use mod4-values))
-  :rule-classes ((:type-prescription :typed-term (mod4 n))))
-
-;The syntaxp hyps prevent looping.
-(defthm mod4-sum-move-safe
-  (implies (and (syntaxp (and (quotep k1)
-                              (quotep k2)))
-                (case-split (<= 0 k1))
-                (case-split (< k1 4))
-                (rationalp n)
-                (rationalp k1)
-                (integerp n)
-                (integerp k1)
-                (integerp k2)
-                )
-           (equal (equal k1 (mod4 (+ k2 n)))
-                  (equal (mod4 (+ k1 (- k2))) (mod4 n))))
-  :hints (("Goal" :in-theory (enable mod4)
-           :use (:instance mod-sum-move (x n) (y 4)))))
-
-;orient the other way?
-(defthmd even-to-mod
-  (implies (integerp n)
-           (equal (even n)
-                  (equal 0 (mod n 2))))
-  :hints (("Goal" :in-theory (enable even-is-evenp evenp mod-by-2-rewrite-to-even)))
-  )
-
-
-;should these next 4 be rewrite rules?
-;do we need to forward from facts about even/odd to facts about mod?
-(defthm mod4-is-0-fw-to-even
-  (implies (and (equal 0 (mod4 n))
-                (case-split (integerp n))
-                )
-           (even n))
-  :rule-classes (:forward-chaining)
-  :hints (("Goal" :in-theory (e/d (mod4 even-to-mod mod-equal-0) (integerp-prod))
-           :use (:instance integerp-prod (x (* 1/4 N)) (y 2)))))
-
-;We forward-chain to (not (even n)) instead of to (odd n) because we intend to keep ODD enabled.
-(defthm mod4-is-1-fw-to-not-even
-  (implies (and (equal 1 (mod4 n))
-                (case-split (integerp n))
-                )
-           (not (even n)))
-  :rule-classes (:forward-chaining)
-  :hints (("Goal" :in-theory (e/d (odd) (MOD4-IS-0-FW-TO-EVEN))
-           :use (:instance  mod4-is-0-fw-to-even (n (+ -1 n))))))
-
-(defthm mod4-is-2-fw-to-even
-  (implies (and (equal 2 (mod4 n))
-                (case-split (integerp n))
-                )
-           (even n))
-  :rule-classes (:forward-chaining)
-  :hints (("Goal" :in-theory (e/d (odd) (MOD4-IS-0-FW-TO-EVEN))
-           :use (:instance  mod4-is-0-fw-to-even (n (+ -2 n))))))
-
-;We forward-chain to (not (even n)) instead of to (odd n) because we intend to keep ODD enabled.
-(defthm mod4-is-3-fw-to-not-even
-  (implies (and (equal 3 (mod4 n))
-                (case-split (integerp n))
-                )
-           (not (even n)))
-  :rule-classes (:forward-chaining)
-  :hints (("Goal" :in-theory (e/d (odd) (MOD4-IS-0-FW-TO-EVEN))
-           :use (:instance  mod4-is-0-fw-to-even (n (+ -3 n))))))
-
-
-
-
-#|
-;gen -4 to any multiple of 4?
-;gen to normalize the constant -4??
-(defthmd mod4-reduce-by-4
-  (implies (case-split (integerp n))
-           (equal (mod4 (+ -4 n))
-                  (mod4 n)))
-  :hints (("goal" :cases ((= n 1) (= n 2))
-           :in-theory (enable  mod4  mod4-neg-reduce-by-4  mod4-pos-reduce-by-4)))
-  )
-|#
-
diff -Nru acl2-6.2/books/rtl/rel5/support/model-helpers.lisp acl2-6.3/books/rtl/rel5/support/model-helpers.lisp
--- acl2-6.2/books/rtl/rel5/support/model-helpers.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,18 +0,0 @@
-(in-package "ACL2")
-
-;I believe this theorem is used to admit model.lisp when it contains -aux functions
-
-(include-book "rtl")
-
-(local (include-book "bits"))
-
-(defthmd bits-reduce
-  (implies (and (< x (expt 2 (+ 1 i)))
-                (case-split (integerp x))
-                (case-split (<= 0 x))
-                (case-split (integerp i))
-                )
-           (equal (bits x i 0) x)))
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/mulcat-proofs.lisp acl2-6.3/books/rtl/rel5/support/mulcat-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/mulcat-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/mulcat-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,185 +0,0 @@
-(in-package "ACL2")
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-
-(local (include-book "../arithmetic/top"))
-(local (include-book "bvecp"))
-(include-book "cat-def")
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "cat"))
-
-(defund mulcat (l n x)
-
-; We introduce mbe not because we want particularly fast execution, but because
-; the existing logic definition does not satisfy the guard of cat, which can't
-; be changed because of the guard of bits.
-
-  (declare (xargs :guard (and (integerp l)
-                              (< 0 l)
-                              (acl2-numberp n)
-                              (natp x))
-                  :verify-guards nil))
-  (mbe :logic (if (and (integerp n) (> n 0))
-                  (cat (mulcat l (1- n) x)
-                       (* l (1- n))
-                       x
-                       l)
-                0)
-       :exec  (cond
-               ((eql n 1)
-                (bits x (1- l) 0))
-               ((and (integerp n) (> n 0))
-                (cat (mulcat l (1- n) x)
-                     (* l (1- n))
-                     x
-                     l))
-               (t 0))))
-
-;(defthm rationalp-mulcat
-;  (and (rationalp (mulcat l n x))
-;       (<= 0 (mulcat l n x)))
-;  :rule-classes :type-prescription)
-
-;(verify-guards mulcat)
-
-(local (in-theory (disable a15)))
-
-(defthm mulcat-nonnegative-integer-type
-  (and (integerp (mulcat l n x))
-       (<= 0 (mulcat l n x)))
-  :hints (("Goal" :in-theory (enable mulcat)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than mulcat-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription mulcat)))
-
-(defthm mulcat-1
-    (implies (natp l)
-	     (equal (mulcat l 1 x) 
-		    (bits x (1- l) 0)))
-  :hints (("Goal" :in-theory (enable mulcat bits-tail)
-		  :expand ((mulcat l 1 x)))))
-
-(defthm mulcat-bvecp-simple
-  (implies (and (= p (* l n))
-                (case-split (natp l)))
-           (bvecp (mulcat l n x) p))
-  :hints (("Goal" :in-theory (enable mulcat)))
-  :rule-classes ())
-
-(defthm mulcat-bvecp
-  (implies (and (>= p (* l n))
-                (case-split (integerp p))
-                (case-split (natp l)))
-           (bvecp (mulcat l n x) p))
-  :hints (("Goal" :in-theory (disable bvecp-longer)
-           :use ((:instance mulcat-bvecp-simple (p (* l n)))
-                 (:instance bvecp-longer (x (mulcat l n x)) (k2 p) (k1 (* l n)))))))
-
-(defthm mulcat-0
-  (equal (mulcat l n 0) 0)
-  :hints (("Goal" :in-theory (enable mulcat))))
-
-(defthm mulcat-0-two
-  (equal (mulcat l 0 x) 0)
-  :hints (("Goal" :in-theory (enable mulcat))))
-
-(defthm bvecp-mulcat-1
-    (implies (natp n)
-	     (bvecp (mulcat 1 n 1) n))
-  :rule-classes ())
-
-
-
-(local (defthm mulcat-n-1-1
-    (implies (and (natp n)
-		  (> n 0))
-	     (equal (mulcat 1 n 1)
-		    (1+ (* 2 (mulcat 1 (1- n) 1)))))
-    :hints (("Goal" :in-theory (enable mulcat cat bits-tail)))))
-
-(defthm mulcat-n-1
-    (implies (case-split (<= 0 n))
-	     (equal (mulcat 1 n 1)
-		    (1- (expt 2 n))))
-  :hints (("Goal" :in-theory (enable mulcat expt-split))))
-
-(defun mulcat-induct (n n2)
-  (IF (AND (INTEGERP N) (> N 0) (INTEGERP N2) (> N2 0))
-      (mulcat-induct (1- n) (1- n2))
-      0))
-
-(local (include-book "merge"))  ;yuck
-
-;BOZO prove a bits-mulcat? could be used to prove-bitn-mulcat
-
-;BOZO generalize to bits of mulcat when x is larger than 1?
-;not general (note the 1 for the l parameter)
-;and to when (<= n m)
-;add to lib/ ?
-(defthm bitn-mulcat-1
-  (implies (and (< m n)
-                (case-split (bvecp x 1))
-                (case-split (natp m))
-                (case-split (integerp n)) ;(case-split (natp n))
-                )
-           (equal (bitn (mulcat 1 n x) m)
-                  x))
-  :hints (("Goal" :induct (mulcat-induct n m)
-		  :do-not '(generalize)
-		  :expand ((mulcat 1 n x))
-		  :in-theory (enable mulcat))))
-
-(defthm bitn-mulcat-2
-  (implies (and (<= (* l n) n2)
-                (natp n)
-                (natp l)
-                (natp n2)
-                (case-split (bvecp x l))
-                )
-           (equal (bitn (mulcat l n x) n2)
-                  0))
-  :hints (("Goal" :use ((:instance bvecp-bitn-0 (x (mulcat l n x)) (n n2))))))
-
-(defthmd mulcat-bits
-  (implies (and (integerp l)
-                (integerp x))
-           (equal (mulcat l n (bits x (1- l) 0))
-                  (mulcat l n x)))
-  :hints (("Goal" :in-theory (enable mulcat))))
diff -Nru acl2-6.2/books/rtl/rel5/support/mulcat.lisp acl2-6.3/books/rtl/rel5/support/mulcat.lisp
--- acl2-6.2/books/rtl/rel5/support/mulcat.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/mulcat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,146 +0,0 @@
-(in-package "ACL2")
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(include-book "cat-def")
-(local (include-book "mulcat-proofs"))
-
-(defund mulcat (l n x)
-
-; We introduce mbe not because we want particularly fast execution, but because
-; the existing logic definition does not satisfy the guard of cat, which can't
-; be changed because of the guard of bits.
-
-  (declare (xargs :guard (and (integerp l)
-                              (< 0 l)
-                              (acl2-numberp n)
-                              (natp x))
-                  :verify-guards nil))
-  (mbe :logic (if (and (integerp n) (> n 0))
-                  (cat (mulcat l (1- n) x)
-                       (* l (1- n))
-                       x
-                       l)
-                0)
-       :exec  (cond
-               ((eql n 1)
-                (bits x (1- l) 0))
-               ((and (integerp n) (> n 0))
-                (cat (mulcat l (1- n) x)
-                     (* l (1- n))
-                     x
-                     l))
-               (t 0))))
-
-(defthm mulcat-nonnegative-integer-type
-  (and (integerp (mulcat l n x))
-       (<= 0 (mulcat l n x)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than mulcat-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription mulcat)))
-
-(defthm mulcat-1
-    (implies (natp l)
-	     (equal (mulcat l 1 x) 
-		    (bits x (1- l) 0))))
-
-(defthm mulcat-bvecp-simple
-  (implies (and (= p (* l n))
-                (case-split (natp l)))
-           (bvecp (mulcat l n x) p))
-  :rule-classes ())
-
-(defthm mulcat-bvecp
-  (implies (and (>= p (* l n))
-                (case-split (integerp p))
-                (case-split (natp l)))
-           (bvecp (mulcat l n x) p)))
-
-(defthm mulcat-0
-  (equal (mulcat l n 0) 
-         0))
-
-(defthm mulcat-0-two
-  (equal (mulcat l 0 x) 
-         0))
-
-(defthm bvecp-mulcat-1
-    (implies (natp n)
-	     (bvecp (mulcat 1 n 1) n))
-  :rule-classes ())
-
-(defthm mulcat-n-1
-    (implies (case-split (<= 0 n))
-	     (equal (mulcat 1 n 1)
-		    (1- (expt 2 n)))))
-
-(defun mulcat-induct (n n2)
-  (if (and (integerp n) (> n 0) (integerp n2) (> n2 0))
-      (mulcat-induct (1- n) (1- n2))
-      0))
-
-;BOZO prove a bits-mulcat? could be used to prove-bitn-mulcat
-
-;BOZO generalize to bits of mulcat when x is larger than 1?
-;not general (note the 1 for the l parameter)
-;and to when (<= n m)
-;add to lib/ ?
-(defthm bitn-mulcat-1
-  (implies (and (< m n)
-                (case-split (bvecp x 1))
-                (case-split (natp m))
-                (case-split (integerp n)) ;(case-split (natp n))
-                )
-           (equal (bitn (mulcat 1 n x) m)
-                  x)))
-
-(defthm bitn-mulcat-2
-  (implies (and (<= (* l n) n2)
-                (natp n)
-                (natp l)
-                (natp n2)
-                (case-split (bvecp x l))
-                )
-           (equal (bitn (mulcat l n x) n2)
-                  0)))
-
-(defthmd mulcat-bits
-  (implies (and (integerp l)
-                (integerp x))
-           (equal (mulcat l n (bits x (1- l) 0))
-                  (mulcat l n x))))
diff -Nru acl2-6.2/books/rtl/rel5/support/near+-proofs.lisp acl2-6.3/books/rtl/rel5/support/near+-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/near+-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/near+-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1479 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "trunc"))
-(local (include-book "away"))
-(local (include-book "float"))
-;BOZO include all of arithmetic?
-;(local (include-book "../arithmetic/top"))
-(local (include-book "../arithmetic/predicate"))
-(local (include-book "../arithmetic/cg"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-
-;;
-;; New stuff:
-;;
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near+ (x n)
-  (if (< (re (* (expt 2 (1- n)) (sig x)))
-	 1/2)
-      (trunc x n)
-    (away x n)))
-
-(local
- (defthm near+trunc-1
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (< (re (* (expt 2 (1- n)) (sig x))) 1/2))
-            (< (+ x (expt 2 (- (expo x) n)))
-               (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable sgn trunc near+ re)
-            :use (fp-rep
-                  (:instance expt-split (r 2) (i (1- n)) (j (- (1+ (expo x)) n)))
-                  (:instance expt-split (r 2) (i -1) (j (- (1+ (expo x)) n)))
-                  (:instance *-strongly-monotonic
-                             (x (expt 2 (- (1+ (expo x)) n)))
-                             (y (re (* (expt 2 (1- n)) (sig x))))
-                             (y+ 1/2)))))))
-
-(local
- (defthm near+trunc-2
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (< (re (* (expt 2 (1- n)) (sig x))) 1/2))
-            (< (trunc (+ x (expt 2 (- (expo x) n))) n)
-               (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (disable re)
-            :use (near+trunc-1
-                  (:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
-;			(:instance expt-pos (x (- (expo x) n)))
-                  )))))
-
-(local
-(defthm near+trunc-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (< (re (* (expt 2 (1- n)) (sig x))) 1/2))
-	     (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable re)
-		  :use (near+trunc-2
-			(:instance fp+2 (x (trunc x n)) (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))
-
-(local
-(defthm near+trunc-4
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable re)
-		  :use ((:instance trunc-monotone (y (+ x (expt 2 (- (expo x) n)))))
-;			(:instance expt-pos (x (- (expo x) n)))
-                        )))))
-
-(local
- (defthm near+trunc-5
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (< (re (* (expt 2 (1- n)) (sig x))) 1/2))
-            (= (near+ x n)
-               (trunc (+ x (expt 2 (- (expo x) n))) n)))		
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable trunc-rewrite near+)
-            :use (near+trunc-3
-                  near+trunc-4)))))
-
-(local
- (defthm near+trunc-6
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (>= (re (* (expt 2 (1- n)) (sig x))) 1/2))
-            (>= (+ x (expt 2 (- (expo x) n)))
-                (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable sgn trunc near+ re)
-            :use (fp-rep
-                  (:instance expt-split (r 2) (i (1- n)) (j (- (1+ (expo x)) n)))
-                  (:instance expt-split (r 2) (i -1) (j (- (1+ (expo x)) n)))
-                  (:instance *-weakly-monotonic
-                             (x (expt 2 (- (1+ (expo x)) n)))
-                             (y+ (re (* (expt 2 (1- n)) (sig x))))
-                             (y 1/2)))))))
-
-(local
-(defthm near+trunc-7
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))
-		 (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable trunc-exactp-c re)
-		  :use ((:instance fp+1 (x (trunc x n)))
-;			(:instance expt-pos (x (- (1+ (expo x)) n)))
-			(:instance trunc-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
-			(:instance away-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
-
-(local
-(defthm near+trunc-8
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (>= (re (* (expt 2 (1- n)) (sig x))) 1/2))
-	     (>= (+ x (expt 2 (- (expo x) n)))
-		 (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :use (near+trunc-7 near+trunc-6)))))
-
-(local
-(defthm near+trunc-9
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (>= (re (* (expt 2 (1- n)) (sig x))) 1/2))
-	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		 (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable trunc-exactp-c re)
-		  :use (near+trunc-8
-			(:instance trunc-exactp-c (x (+ x (expt 2 (- (expo x) n)))) (a (away x n))))))))
-
-(local
-(defthm near+trunc-10
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(fp+ (away x n) n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable trunc-exactp-c re)
-		  :use (expo-away
-;			(:instance expt-pos (x (- (expo x) n)))
-			(:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo (away x n))) n))))))))
-
-(local
-(defthm near+trunc-11
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		 (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable trunc-exactp-c re)
-		  :use (near+trunc-10
-			(:instance fp+2 (x (away x n)) (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))
-
-(local
- (defthm near+trunc-12
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 0)
-                 (>= (re (* (expt 2 (1- n)) (sig x))) 1/2))
-            (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-               (near+ x n)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable  near+)
-            :use (near+trunc-11 near+trunc-9)))))
-
-(defthm near+trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (= (near+ x n)
-		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
-  :rule-classes ()
-  :hints (("Goal" :use (near+trunc-12 near+trunc-5))))
-
-;why disabled?
-(defthmd near+-minus
-  (= (near+ (* -1 x) n) 
-     (* -1 (near+ x n)))
-  :hints (("goal" :in-theory (enable near+)
-           :use (trunc-minus
-                 away-minus
-                 sig-minus))))
-
-;why disabled?
-(defthmd near+-shift
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (integerp k))
-	     (= (near+ (* x (expt 2 k)) n)
-		(* (near+ x n) (expt 2 k))))
-  :hints (("goal" :in-theory (enable near+)
-		  :use (trunc-shift
-			away-shift
-			(:instance sig-expo-shift (n k))))))
-
-(local
- (defthm sgn-near+-1
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (> n 0))
-            (= (trunc x n)
-               (* (sgn x) (trunc (abs x) n))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable trunc sig)
-            :use (sig-minus expo-minus)))))
-
-(local
- (defthm sgn-near+-2-local
-   (implies (and (rationalp x)
-                 (integerp n)
-                 (> n 0))
-            (= (away x n)
-               (* (sgn x) (away (abs x) n))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable away sig)
-            :use (sig-minus expo-minus)))))
-
-;bad name!
-(defthm sgn-near+
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (= (near+ x n)
-              (* (sgn x) (near+ (abs x) n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable near+)
-                              '(sgn-away abs-pos  sig))
-           :use (sgn-near+-2-local sgn-near+-1 sig-minus away-minus))))
-
-(defthm near+-0
-  (equal (near+ 0 n) 0)
-  :hints (("Goal" :in-theory (enable near+)
-           :use trunc-0)))
-
-(defthm near+-1-1
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0))
-           (= (- x (trunc x n))
-              (* (expt 2 (- (1+ (expo x)) n)) (re (* (expt 2 (1- n)) (sig x))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable re a15)
-           :use ((:instance trunc)
-                 (:instance fp-rep)))))
-
-(defthm near+-1-2
-  (implies (and (rationalp c)
-                (rationalp f)
-                (rationalp p)
-                (= c (+ 1 f)))
-           (= (* c p) (+ p (* f p))))
-  :rule-classes ())
-
-(defthm near+-1-3
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0)
-                (not (integerp (* (expt 2 (1- n)) (sig x)))))
-           (= (- (away x n) x)
-              (* (expt 2 (- (1+ (expo x)) n)) (- 1 (re (* (expt 2 (1- n)) (sig x)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable re a15)
-           :use ((:instance away)
-                 (:instance fl-cg (x (* (expt 2 (1- n)) (sig x))))
-                 (:instance fp-rep)
-                 (:instance near+-1-2 
-                            (c (cg (* (expt 2 (1- n)) (sig x))))
-                            (f (fl (* (expt 2 (1- n)) (sig x))))
-                            (p (expt 2 (- (1+ (expo x)) n))))))))
-
-(defthm near+-1-4
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0)
-                (integerp (* (expt 2 (1- n)) (sig x))))
-           (= (trunc x n) x))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable a15)
-           :use ((:instance trunc)
-                 (:instance fl-int (x (* (expt 2 (1- n)) (sig x))))
-                 (:instance fp-rep)))))
-
-(defthm near+-1-5
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0)
-                (integerp (* (expt 2 (1- n)) (sig x))))
-           (= (away x n) x))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable a15)
-           :use ((:instance away)
-                 (:instance cg-int (x (* (expt 2 (1- n)) (sig x))))
-                 (:instance fp-rep)))))
-;drop?
-(defthm near+-1-6
-  (implies (and (rationalp p)
-                (> p 0)
-                (rationalp f)
-                (< (* p f) (* p (- 1 f))))
-           (< f 1/2))
-  :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE
-                                      )))
-  :rule-classes ())
-
-(defthm near+-1-7
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0)
-                (not (integerp (* (expt 2 (1- n)) (sig x))))
-                (< (- x (trunc x n)) (- (away x n) x)))
-           (= (near+ x n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near+-1-1)
-			(:instance near+-1-3)
-			(:instance near+-1-6 
-				   (p (expt 2 (- (1+ (expo x)) n))) 
-				   (f (re (* (expt 2 (1- n)) (sig x)))))
-			(:instance near+)))))
-;drop?
-(defthm near+-1-8
-  (implies (and (rationalp p)
-                (> p 0)
-                (rationalp f)
-                (> (* p f) (* p (- 1 f))))
-           (> f 1/2))
-  :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE
-                                      )))
-  :rule-classes ())
-
-(defthm near+-1-9
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (not (integerp (* (expt 2 (1- n)) (sig x))))
-		  (> (- x (trunc x n)) (- (away x n) x)))
-	     (= (near+ x n) (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near+-1-1)
-			(:instance near+-1-3)
-			(:instance near+-1-8 
-				   (p (expt 2 (- (1+ (expo x)) n))) 
-				   (f (re (* (expt 2 (1- n)) (sig x)))))
-			(:instance near+)))))
-
-(defthm near+1-a
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (< (- x (trunc x n)) (- (away x n) x)))
-	     (= (near+ x n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near+-1-7)
-			(:instance near+-1-4)
-			(:instance near+-1-5)))))
-
-(defthm near+1-b
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (> (- x (trunc x n)) (- (away x n) x)))
-	     (= (near+ x n) (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near+-1-9)
-			(:instance near+-1-4)
-			(:instance near+-1-5)))))
-
-(defthm near+2-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near+ x n) (trunc x n)))
-	     (>= (abs (- x y)) (- x (trunc x n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable away-exactp-c 
-				      near+ trunc-exactp-c)
-		  :use ((:instance near+1-b)
-			(:instance away-lower-pos)
-			(:instance trunc-upper-pos)
-			(:instance trunc-exactp-c (a y))
-			(:instance away-exactp-c (a y))))))
-
-(defthm near+2-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near+ x n) (away x n)))
-	     (>= (abs (- x y)) (- (away x n) x)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable away-exactp-c 
-				      trunc-exactp-c)
-		  :use ((:instance near+1-a)
-			(:instance away-lower-pos)
-			(:instance trunc-upper-pos)
-			(:instance trunc-exactp-c (a y))
-			(:instance away-exactp-c (a y))))))
-
-(defthm near+-choice
-  (or (= (near+ x n) (trunc x n))
-      (= (near+ x n) (away x n)))
-  :hints (("Goal" :in-theory (enable near+)))
-  :rule-classes ())
-
-(defthm near+2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n))
-	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near+)
-		  :use ((:instance near+2-1)
-			(:instance near+2-2)
-			(:instance near+-choice)
-			(:instance away-lower-pos)
-			(:instance trunc-upper-pos)))))
-
-(defthm near+-exactp-b
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (exactp (near+ x n) n))
-  :hints (("Goal" :in-theory (disable near+ trunc-exactp-b away-exactp-b)
-		  :use ((:instance near+-choice)
-			(:instance trunc-exactp-b)
-			(:instance away-exactp-b)))))
-
-(defthm sgn-near+-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (equal (sgn (near+ x n))
-		    (sgn x)))
-  :hints (("Goal" :use (near+-choice
-			sgn-trunc
-			sgn-away))))
-
-(defthm near+-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (near+ x n))
-		  (exactp x n)))
-  :rule-classes ()
-  :hints (("Goal" :use (near+-choice
-			trunc-exactp-a
-			away-exactp-a))))
-
-
-
-(defthm near+-exactp-c
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (>= a x))
-	     (>= a (near+ x n)))
-  :hints (("Goal" :use (near+-choice
-			away-exactp-c
-			trunc-upper-pos))))
-
-(defthm near+-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (near+ x n)))
-  :hints (("Goal" :use (near+-choice
-			away-lower-pos
-			trunc-exactp-c))))
-
-(defthm near+-pos
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0))
-           (> (near+ x n) 0))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (disable near+)
-           :use ((:instance near+-choice)
-))))
-
-(defthmd near+-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (< 0 x)
-                (integerp n)
-                (> n 0))
-           (<= (near+ x n) (near+ y n)))
-  :hints (("Goal" :in-theory (disable near+ trunc-exactp-b away-exactp-b)
-           :use ((:instance near+-pos)
-                 (:instance near+-pos (x y))
-                 (:instance near+2 (y (near+ y n)))
-                 (:instance near+2 (x y) (y (near+ x n)))))))
-
-(defund near+-witness (x y n)
-  (if (= (expo x) (expo y))
-      (/ (+ (near+ x n) (near+ y n)) 2)
-    (expt 2 (expo y))))
-
-(local 
- (defthm near+-near+-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (expo x) (expo y))))
-	     (and (<= x (near+-witness x y n))
-		  (<= (near+-witness x y n) y)
-		  (exactp (near+-witness x y n) (1+ n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable near+-witness)
-		  :use ((:instance exactp-2**n (n (expo y)) (m (1+ n)))
-			(:instance expo-upper-bound)
-			(:instance expo-monotone)
-			(:instance expt-weak-monotone (n (1+ (expo x))) (m (expo y)))
-			(:instance expo-lower-bound (x y)))))))
-
-(local
- (defthm near+-near+-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near+ x n) (near+ y n))
-		  (= (expo x) (expo y)))
-	     (and (<= x (near+-witness x y n))
-		  (<= (near+-witness x y n) y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable near+-witness)
-		  :use ((:instance near+2 (y (near+ y n)))
-			(:instance near+2 (x y) (y (near+ x n)))
-			(:instance near+-pos)
-			(:instance near+-pos (x y)))))))
-
-(local
- (defthm near+-near+-3
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (near+ x n) (near+ y n)))
-		  (= (expo x) (expo y)))
-	     (and (<= x (near+-witness x y n))
-		  (<= (near+-witness x y n) y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near+-monotone)
-		  :use ((:instance near+-near+-2)
-			(:instance near+-monotone))))))
-
-(defthm near+<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (near+ x n) (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near+-choice)
-			(:instance trunc-upper-pos)
-			(:instance away-lower-pos)))))
-
-(defthm near+>=trunc
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0))
-           (>= (near+ x n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near+-choice)
-			(:instance trunc-upper-pos)
-			(:instance away-lower-pos)))))
-(local
- (defthm near+-near+-4
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near+ x n) (near+ y n))
-		  (= (expo x) (expo y)))
-	     (<= (expo (near+-witness x y n)) (expo y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (near+-witness) ( abs-away away-lower-pos))
-		  :use ((:instance near+<=away (x y))
-			(:instance away-exactp-d (x y))
-			(:instance near+-pos)
-;			(:instance away-pos (x y))
-			(:instance expo-upper-2 (x (near+-witness x y n)) (n (1+ (expo y)))))))))
-
-(defthm near+-neg
-    (implies (and (< x 0)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (near+ x n) 0))
-  :rule-classes :linear
-  :hints (("Goal" :in-theory (disable near+)
-		  :use ((:instance near+-choice)
-	))))
-
-(defthm near+-0-0
-  (implies (and (case-split (< 0 n))
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (equal (equal (near+ x n) 0)
-                  (equal x 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable near+))))
-
-(local
- (defthm near+-near+-5
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near+ x n) (near+ y n))
-		  (= (expo x) (expo y)))
-	     (integerp (* (near+ x n) (expt 2 (- (1- n) (expo y))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near+ expo-trunc abs-trunc abs-away)
-		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near+ x n)))
-			(:instance expo-monotone (x (trunc x n)) (y (near+ x n)))
-			(:instance near+-0-0)
-;			(:instance trunc-pos)
-			(:instance near+-pos)
-			(:instance expo-trunc)
-;			(:instance trunc-0-0)
-			(:instance near+>=trunc))))))
-
-(local
- (defthm near+-near+-6
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near+ x n) (near+ y n))
-		  (= (expo x) (expo y)))
-	     (integerp (* (near+ y n) (expt 2 (- (1- n) (expo y))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near+ expo-trunc abs-trunc abs-away)
-		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near+ y n)))
-			(:instance expo-monotone (x (trunc x n)) (y (near+ y n)))
-			(:instance near+-0-0)
-			(:instance near+-monotone)
-;			(:instance trunc-pos)
-			(:instance near+-pos)
-			(:instance expo-trunc)
-;			(:instance trunc-0-0)
-			(:instance near+>=trunc))))))
-
-(local
- (defthm near+-near+-7
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k))
-	     (= (+ (* x (expt 2 (1- k)))
-		   (* y (expt 2 (1- k))))
-		(* (/ (+ x y) 2) (expt 2 k))))
-    :hints (("Goal" :in-theory (enable expt)))
-  :rule-classes ()))
-
-(local
- (defthm near+-near+-8
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-	          (integerp (* x (expt 2 (1- k))))
-	          (integerp (* y (expt 2 (1- k)))))
-	     (integerp (* (/ (+ x y) 2) (expt 2 k))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near+-near+-7))))))
-
-(local
- (defthm near+-near+-9
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near+ x n) (near+ y n))
-		  (= (expo x) (expo y)))
-	     (exactp (near+-witness x y n) (1+ n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable near+-witness)
-           :use ((:instance near+-near+-5)
-			(:instance near+-near+-6)
-			(:instance near+-near+-4)
-			(:instance near+-near+-8 (x (near+ x n)) (y (near+ y n)) (k (- n (expo y))))
-			(:instance exactp->=-expo (n (1+ n)) (e (expo y)) (x (near+-witness x y n))))))))
-
-(defthm near+-near+-lemma
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (near+ x n) (near+ y n))))
-	     (and (<= x (near+-witness x y n))
-		  (<= (near+-witness x y n) y)
-		  (exactp (near+-witness x y n) (1+ n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near+ near+-monotone)
-		  :use ((:instance near+-near+-2)
-			(:instance near+-near+-1)
-			(:instance near+-near+-9)
-			(:instance near+-monotone)))))
-
-(local
- (defthm near+-near+-10
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp a)
-		  (integerp n)
-		  (integerp k)
-		  (> k 0)
-		  (>= n k)		  
-		  (< 0 a)
-		  (< a x)
-		  (< 0 y)
-		  (< x y)
-		  (< y (fp+ a (1+ n)))
-		  (exactp a (1+ n)))
-	     (= (near+ y k) (near+ x k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near+ near+-monotone)
-		  :use ((:instance near+-near+-lemma (n k))
-			(:instance exactp-<= (x (near+-witness x y k)) (m (1+ k)) (n (1+ n)))
-			(:instance fp+2 (x a) (y (near+-witness x y k)) (n (1+ n))))))))
-
-(defthm near+-near+
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp a)
-		  (integerp n)
-		  (integerp k)
-		  (> k 0)
-		  (>= n k)		  
-		  (< 0 a)
-		  (< a x)
-		  (< 0 y)
-		  (< y (fp+ a (1+ n)))
-		  (exactp a (1+ n)))
-	     (<= (near+ y k) (near+ x k)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near+-near+-10)
-			(:instance near+-monotone (n k) (x y) (y x))))))
-
-(local
-(defthm near+-a-a-1
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (> (near+ x n) a))
-	     (>= (near+ x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance fp+2 (x a) (y (near+ x n)))
-			;(:instance exactp-near+)
-                        )))))
-
-(local
-(defthm near+-a-a-2
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (rationalp d) (> d 0)
-		  (integerp n) (> n 0)
-		  (<= (near+ x n) a)
-		  (> x (+ a d)))
-	     (> (abs (- (near+ x n) x))
-		(abs (- (+ a d d)
-			x))))
-  :rule-classes ()))
-
-(local
-(defthm near+-a-a-3
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (<= (near+ x n) a)
-		  (> x (+ a (expt 2 (- (expo a) n)))))
-	     (> (abs (- (near+ x n) x))
-		(abs (- (+ a 
-			   (expt 2 (- (expo a) n))
-			   (expt 2 (- (expo a) n)))
-			x))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near+-a-a-2 (d (expt 2 (- (expo a) n))))
-;			(:instance expt-pos (x (- (expo a) n)))
-                        )))))
-
-(local
-(defthm near+-a-a-4
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (<= (near+ x n) a)
-		  (> x (+ a (expt 2 (- (expo a) n)))))
-	     (> (abs (- (near+ x n) x))
-		(abs (- (+ a (expt 2 (- (1+ (expo a)) n)))
-			x))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-a-a-3)
-			(:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))
-
-(defthm near+-a-a
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (> x (+ a (expt 2 (- (expo a) n)))))
-	     (>= (near+ x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near+2 (y (+ a (expt 2 (- (1+ (expo a)) n)))))
-			(:instance near+-a-a-4)
-			(:instance near+-a-a-1)
-			(:instance fp+1 (x a))
-;			(:instance expt-pos (x (- (1+ (expo a)) n)))
-                        ))))
-
-(local
-(defthm near+-a-b-1
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (rationalp d) (> d 0)
-		  (integerp n) (> n 0)
-		  (>= (near+ x n) (+ a d d))
-		  (< x (+ a d)))
-	     (> (abs (- (near+ x n) x))
-		(abs (- a x))))
-  :rule-classes ()))
-
-(local
-(defthm near+-a-b-2
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (>= (near+ x n) 
-		      (+ a
-			 (expt 2 (- (expo a) n))
-			 (expt 2 (- (expo a) n))))
-		  (< x (+ a (expt 2 (- (expo a) n)))))
-	     (> (abs (- (near+ x n) x))
-		(abs (- a x))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near+-a-b-1 (d (expt 2 (- (expo a) n))))
-;			(:instance expt-pos (x (- (expo a) n)))
-                        )))))
-
-(local
-(defthm near+-a-b-3
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (>= (near+ x n) 
-		      (+ a (expt 2 (- (1+ (expo a)) n))))
-		  (< x (+ a (expt 2 (- (expo a) n)))))
-	     (> (abs (- (near+ x n) x))
-		(abs (- a x))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-a-b-2)
-			(:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))
-
-(defthm near+-a-b
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x (+ a (expt 2 (- (expo a) n)))))
-	     (<= (near+ x n) a))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+2 (y a))
-			(:instance near+-a-b-3)
-			(:instance near+-a-a-1)))))
-
-(local
-(defthm near+-a-c-1
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (>= x a))
-	     (>= (near+ x n) a))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-monotone (x a) (y x))
-			(:instance near+-choice (x a))
-			(:instance trunc-exactp-a (x a))
-			(:instance away-exactp-a (x a)))))))
-
-(local
-(defthm near+-a-c-2
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a))
-	     (>= a 
-		 (+ (expt 2 (expo x))
-		    (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance expo-lower-bound)
-			(:instance fp+2 (x (expt 2 (expo x))) (y a))
-			(:instance exactp-2**n (n (expo x)) (m n)))))))
-
-(local
-(defthm near+-a-c-3
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (> x (- a (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance expt-weak-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))
-
-(local
-(defthm near+-a-c-4
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (= (expo (- a (expt 2 (- (1+ (expo x)) n))))
-		(expo x)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near+-a-c-2)
-			(:instance near+-a-c-3)
-;			(:instance expt-pos (x (expo x)))
-			(:instance expo-upper-bound)
-			(:instance expo-unique
-				   (x (- a (expt 2 (- (1+ (expo x)) n))))
-				   (n (expo x))))))))
-
-(local
-(defthm near+-a-c-5
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (integerp (* (- a (expt 2 (- (1+ (expo x)) n)))
-			  (expt 2 (- (1- n) (expo x))))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance expt-split (r 2) (i (- (1+ (expo x)) n)) (j (- (1- n) (expo x))))
-			(:instance exactp-<=-expo (x a) (e (expo x)))
-			(:instance near+-a-c-3)
-			(:instance expo-monotone (x (- a (expt 2 (- (1+ (expo x)) n)))) (y a))
-			(:instance expo-monotone (y a)))))))
-
-(local
-(defthm near+-a-c-6
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (exactp (- a (expt 2 (- (1+ (expo x)) n)))
-		     n))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable; expt ;expt-pos
-                              )
-		  :use ((:instance exactp2 (x (- a (expt 2 (- (1+ (expo x)) n)))))
-			(:instance near+-a-c-5)
-			(:instance near+-a-c-2)
-;			(:instance expt-pos (x (expo x)))
-			(:instance near+-a-c-4))))))
-
-(local
-(defthm near+-a-c-7
-    (implies (and (rationalp x)
-		  (rationalp a)
-		  (rationalp e)
-		  (> x (- a e)))
-	     (> x (+ (- a (* 2 e))
-		     e)))
-  :rule-classes ()))
-
-(local
-(defthm near+-a-c-8
-    (implies (and (rationalp x)
-		  (rationalp a)
-		  (integerp n)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (> x (+ (- a (expt 2 (- (1+ (expo x)) n)))
-		     (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance expt-split (r 2) (i 1) (j (- (expo x) n)))
-			(:instance near+-a-c-7 (e (expt 2 (- (expo x) n)))))))))
-
-(local
-(defthm near+-a-c-9
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (> (- a (expt 2 (- (1+ (expo x)) n)))
-		0))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near+-a-c-2)
-;			(:instance expt-pos (x (expo x)))
-                        )))))
-
-(defthm near+-a-c
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (>= (near+ x n) a))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-a-a (a (- a (expt 2 (- (1+ (expo x)) n)))))
-			(:instance near+-a-c-8)
-			(:instance near+-a-c-6)
-			(:instance near+-a-c-4)
-			(:instance near+-a-c-9)))))
-
-(local
- (defthm near+-exact-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n)))
-	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
-	       (and (< f 1) (< 0 f))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable re)
-           :use ((:instance fl-def-linear (x (* (expt 2 (1- n)) (sig x))))
-			(:instance exactp))))))
-
-(local
- (defthm near+-exact-2
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (exactp x (1+ n)))
-	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
-	       (integerp (* 2 f))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable re expt)
-           :use ((:instance exactp (n (1+ n))))))))
-
-(local
- (defthm near+-exact-3
-    (implies (and (integerp 2f)
-		  (< 0 2f)
-		  (< 2f 2))
-	     (= 2f 1))
-  :rule-classes ()))
-
-(local
- (defthm near+-exact-4
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n)))
-	     (= (re (* (expt 2 (1- n)) (sig x)))
-		1/2))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-exact-1)
-			(:instance near+-exact-2)
-			(:instance near+-exact-3 (2f (* 2 (re (* (expt 2 (1- n)) (sig x)))))))))))
-
-(local
- (defthm near+-exact-10
-     (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n)))
-	     (= (near+ x n)
-		(* (cg (* (expt 2 (1- n)) (sig x)))
-		   (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+)
-			(:instance near+-exact-4)
-			(:instance away))))))
-
-(local
- (defthm near+-exact-11
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n)))
-	     (= (near+ x n)
-		(* (1+ (fl (* (expt 2 (1- n)) (sig x))))
-		   (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable near+ re)
-           :use ((:instance near+-exact-10)
-                 (:instance near+-exact-1)
-                 (:instance fl-cg (x (* (expt 2 (1- n)) (sig x)))))))))
-
-(local
- (defthm near+-exact-12
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n)))
-	     (= (* (expt 2 (- (- n 2) (expo x)))
-		   (* (1+ (fl (* (expt 2 (1- n)) (sig x))))
-		      (expt 2 (- (1+ (expo x)) n))))
-		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
-		   2)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable a15)
-           :use ((:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (expt 2 (- (1+ (expo x)) n)))))))))
-
-(local
- (defthm near+-exact-13
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n)))
-	     (= (* (expt 2 (- (- n 2) (expo x)))
-		   (near+ x n))
-		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
-		   2)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-exact-11)
-			(:instance near+-exact-12))))))
-
-(local
-(defthm near+-est-1
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (> (abs (- x (near+ x n)))
-		     (expt 2 (- (expo x) n))))
-	     (< (trunc x n)
-		(- x (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+2 (y (trunc x n)))
-			(:instance trunc-exactp-b)
-;			(:instance trunc-pos)
-			(:instance trunc-upper-pos))))))
-
-(local
-(defthm near+-est-2
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (> (abs (- x (near+ x n)))
-		     (expt 2 (- (expo x) n))))
-	     (> (away x n)
-		(+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable near+-exactp-c)
-           :use ((:instance near+2 (y (away x n)))
-			(:instance away-exactp-b)
-;			(:instance away-pos)
-			(:instance away-lower-pos))))))
-
-(local
-(defthm near+-est-3
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (> (abs (- x (near+ x n)))
-		     (expt 2 (- (expo x) n))))
-	     (> (away x n)
-		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable a15)
-		  :use ((:instance near+-est-1)
-			(:instance expt-split (r 2) (i (- (expo x) n)) (j 1))
-			(:instance near+-est-2))))))
-
-(local
-(defthm near+-est-4
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (> (abs (- x (near+ x n)))
-		     (expt 2 (- (expo x) n))))
-	     (> x
-		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-est-3)
-			(:instance fp+1 (x (trunc x n)))
-			(:instance trunc-exactp-b)
-;			(:instance trunc-pos)
-			(:instance expo-trunc)
-			(:instance away-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
-
-
-(defthm near+-est
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0))
-	     (<= (abs (- x (near+ x n)))
-		 (expt 2 (- (expo x) n))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-est-4)
-			(:instance trunc-lower-1)
-;			(:instance trunc-pos)
-                        ))))
-
-(local
-(defthm near+-power-b-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		 (expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance exactp-2**n (n (1+ (expo x))) (m n))
-;			(:instance expt-pos (x (- (expo x) n)))
-			(:instance trunc-exactp-c 
-				   (x (+ x (expt 2 (- (expo x) n))))
-				   (a (expt 2 (1+ (expo x))))))))))
-
-(local
-(defthm near+-power-b-2
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x))))
-		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-			  (expt 2 (1+ (expo x))))))
-	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-power-b-1))))))
-
-(local
-(defthm near+-power-b-3
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x))))
-		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-			  (expt 2 (1+ (expo x))))))
-	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		 (+ (expt 2 (1+ (expo x)))
-		    (expt 2 (- (+ 2 (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near+-power-b-2)
-			(:instance exactp-2**n (n (1+ (expo x))) (m n))
-			(:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n)))))
-;			(:instance expt-pos (x (1+ (expo x))))
-			(:instance expo-2**n (n (1+ (expo x))))
-			(:instance fp+2 
-				   (x (expt 2 (1+ (expo x))))
-				   (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))
-
-(local
-(defthm near+-power-b-4
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x))))
-		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-			  (expt 2 (1+ (expo x))))))
-	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-power-b-3)
-			(:instance expo-upper-bound)
-			(:instance expt-weak-monotone (n (- (expo x) n)) (m (- (+ 2 (expo x)) n))))))))
-
-(defthm near+-power
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (near+ x n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use (near+trunc
-			(:instance near+-power-b-4)
-			(:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
-;			(:instance expt-pos (x (- (expo x) n)))
-                        ))))
-
-
-(local (include-book "../arithmetic/top"))
-
-; The next two lemmas are copied from near-proofs.lisp.
-
-(defthm plus-near-1
-  (implies (and (exactp x (+ k (- (expo x) (expo y))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                )
-           (= (re (* (expt 2 (1- k)) (sig y)))
-              (re (* (expt 2 (1- (+ k (- (expo (+ x y)) (expo y)))))
-                     (sig (+ x y))))))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (enable re sig exactp expt-split expt-minus))))
-
-(defthm plus-near-2
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y)))))
-           (iff (evenp (fl (* (expt 2 (1- k)) (sig y))))
-                (evenp (fl (* (expt 2
-                                    (1- (+ k (- (expo (+ x y)) (expo y)))))
-                              (sig (+ x y)))))))
-  :otf-flg t
-  :rule-classes nil 
-  :hints (("Goal" :in-theory (e/d (expt-split
-                                   expt-minus
-                                   exactp sig ; EXPT-SPLIT-leading-constant
-                                   evenp ;this is sort of cheating...
-                                   ) ())
-           :use ((:instance exactp2 (n (+ k (expo x) (- (expo y)))))
-                 (:instance exactp-<=
-                            (m (+ -1 k (expo x) (- (expo y))))
-                            (n (+ k (expo x) (- (expo y)))))))))
-
-(defthm plus-near+
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y)))))
-           (= (+ x (near+ y k))
-              (near+ (+ x y)
-                     (+ k (- (expo (+ x y)) (expo y))))))
-  :hints (("Goal" :in-theory (enable near+)
-           :use (plus-trunc plus-away plus-near-1 plus-near-2
-                            (:instance exactp-<=
-                                       (m (+ -1 k (expo x) (* -1 (expo y))))
-                                       (n (+ k (expo x) (* -1 (expo y))))))))
-  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel5/support/near+.lisp acl2-6.3/books/rtl/rel5/support/near+.lisp
--- acl2-6.2/books/rtl/rel5/support/near+.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/near+.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,384 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "near+-proofs"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-
-;;
-;; New stuff:
-;;
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near+ (x n)
-  (if (< (re (* (expt 2 (1- n)) (sig x)))
-	 1/2)
-      (trunc x n)
-    (away x n)))
-
-(defthm near+trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (= (near+ x n)
-		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
-  :rule-classes ())
-
-;why disabled?
-(defthmd near+-minus
-  (= (near+ (* -1 x) n) 
-     (* -1 (near+ x n))))
-
-;why disabled?
-(defthmd near+-shift
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (integerp k))
-	     (= (near+ (* x (expt 2 k)) n)
-		(* (near+ x n) (expt 2 k)))))
-
-
-;bad name!
-(defthm sgn-near+
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (= (near+ x n)
-              (* (sgn x) (near+ (abs x) n))))
-  :rule-classes ())
-
-(defthm near+-0
-  (equal (near+ 0 n)
-         0))
-
-;delete?
-(defthm near+-1-1
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0))
-           (= (- x (trunc x n))
-              (* (expt 2 (- (1+ (expo x)) n)) (re (* (expt 2 (1- n)) (sig x))))))
-  :rule-classes ())
-
-;delete?
-(defthm near+-1-3
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0)
-                (not (integerp (* (expt 2 (1- n)) (sig x)))))
-           (= (- (away x n) x)
-              (* (expt 2 (- (1+ (expo x)) n)) (- 1 (re (* (expt 2 (1- n)) (sig x)))))))
-  :rule-classes ())
-
-(defthm near+1-a
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (< (- x (trunc x n)) (- (away x n) x)))
-	     (= (near+ x n) (trunc x n)))
-  :rule-classes ())
-
-(defthm near+1-b
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (> (- x (trunc x n)) (- (away x n) x)))
-	     (= (near+ x n) (away x n)))
-  :rule-classes ())
-
-(defthm near+2-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near+ x n) (trunc x n)))
-	     (>= (abs (- x y)) (- x (trunc x n))))
-  :rule-classes ())
-
-(defthm near+2-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near+ x n) (away x n)))
-	     (>= (abs (- x y)) (- (away x n) x)))
-  :rule-classes ())
-
-(defthm near+-choice
-  (or (= (near+ x n) (trunc x n))
-      (= (near+ x n) (away x n)))
-  :rule-classes ())
-
-(defthm near+2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n))
-	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
-  :rule-classes ())
-
-(defthm near+-exactp-b
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (exactp (near+ x n) n)))
-
-(defthm sgn-near+-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (equal (sgn (near+ x n))
-		    (sgn x))))
-
-(defthm near+-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (near+ x n))
-		  (exactp x n)))
-  :rule-classes ())
-
-
-
-(defthm near+-exactp-c
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (>= a x))
-	     (>= a (near+ x n))))
-
-(defthm near+-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (near+ x n))))
-
-(defthm near+-pos
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0))
-           (> (near+ x n) 0))
-  :rule-classes :linear)
-
-(defthm near+-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (< 0 x)
-                (integerp n)
-                (> n 0))
-           (<= (near+ x n) (near+ y n)))
-  :hints (("Goal" :in-theory (disable near+ trunc-exactp-b away-exactp-b)
-           :use ((:instance near+-pos)
-                 (:instance near+-pos (x y))
-                 (:instance near+2 (y (near+ y n)))
-                 (:instance near+2 (x y) (y (near+ x n)))))))
-
-(defund near+-witness (x y n)
-  (if (= (expo x) (expo y))
-      (/ (+ (near+ x n) (near+ y n)) 2)
-    (expt 2 (expo y))))
-
-(defthm near+<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (near+ x n) (away x n)))
-  :rule-classes ())
-
-(defthm near+>=trunc
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0))
-           (>= (near+ x n) (trunc x n)))
-  :rule-classes ())
-
-
-(defthm near+-neg
-    (implies (and (< x 0)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (near+ x n) 0))
-  :rule-classes :linear)
-
-(defthm near+-0-0
-  (implies (and (case-split (< 0 n))
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (equal (equal (near+ x n) 0)
-                  (equal x 0)))
-  :rule-classes ())
-
-(defthm near+-near+-lemma
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (near+ x n) (near+ y n))))
-	     (and (<= x (near+-witness x y n))
-		  (<= (near+-witness x y n) y)
-		  (exactp (near+-witness x y n) (1+ n))))
-  :rule-classes ())
-
-(defthm near+-near+
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp a)
-		  (integerp n)
-		  (integerp k)
-		  (> k 0)
-		  (>= n k)		  
-		  (< 0 a)
-		  (< a x)
-		  (< 0 y)
-		  (< y (fp+ a (1+ n)))
-		  (exactp a (1+ n)))
-	     (<= (near+ y k) (near+ x k)))
-  :rule-classes ())
-
-(defthm near+-a-a
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (> x (+ a (expt 2 (- (expo a) n)))))
-	     (>= (near+ x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
-  :rule-classes ())
-
-
-
-(defthm near+-a-b
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x (+ a (expt 2 (- (expo a) n)))))
-	     (<= (near+ x n) a))
-  :rule-classes ())
-
-(defthm near+-a-c
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (>= (near+ x n) a))
-  :rule-classes ())
-
-(defthm near+-est
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0))
-	     (<= (abs (- x (near+ x n)))
-		 (expt 2 (- (expo x) n))))
-  :rule-classes ())
-
-(defthm near+-power
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (near+ x n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-
-(defthm plus-near+
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y)))))
-           (= (+ x (near+ y k))
-              (near+ (+ x y)
-                     (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes nil)
-
-;BOZO clean cruft from this book
diff -Nru acl2-6.2/books/rtl/rel5/support/near-proofs.lisp acl2-6.3/books/rtl/rel5/support/near-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/near-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/near-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,2129 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-(in-package "ACL2")
-
-(local (include-book "../arithmetic/top"))
-(local (include-book "float"))
-(local (include-book "away"))
-(local (include-book "trunc"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-
-;;
-;; New stuff:
-;;
-
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-(defthm near-minus
-  (equal (near (* -1 x) n)
-         (* -1 (near x n)))
-  :hints (("goal" :in-theory (enable near sig-minus))))
-
-(defthm near-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (near x n)
-                  0))
-  :hints (("goal" :in-theory (enable near sig))))
-
-(defthm near-choice
-  (or (= (near x n) (trunc x n))
-      (= (near x n) (away x n)))
-  :hints (("Goal" :in-theory (enable near)))
-  :rule-classes ())
-
-;BOZO better r-c on these? :rewrite?
-(defthm near-pos
-  (implies (and (< 0 x)
-                (< 0 n)
-                (rationalp x)
-                (integerp n)
-                )
-           (< 0 (near x n)))
-  :rule-classes (:type-prescription :linear)
-  :hints (("Goal" :use ((:instance near-choice)))))
-
-(defthm near-neg
-    (implies (and (< x 0)
-		  (< 0 n)
-                  (rationalp x)
-		  (integerp n)
-		  )
-	     (< (near x n) 0))
-  :rule-classes (:type-prescription :linear)
-  :hints (("Goal" :use ((:instance near-choice)))))
-
-(defthm near-rational-type-prescription
-  (rationalp (near x n))
-  :rule-classes (:rewrite :type-prescription))
-
-(defthm near-non-negative-rational-type-prescription
-  (implies (<= 0 x)
-           (and (<= 0 (near x n))
-                (rationalp (near x n))))
-  :hints (("Goal" :use ((:instance near-choice))))
-  :rule-classes :type-prescription)
-
-(defthm near-non-positive-rational-type-prescription
-  (implies (<= x 0)
-           (and (<= (near x n) 0)
-                (rationalp (near x n))))
-  :hints (("Goal" :use ((:instance near-choice))))
-  :rule-classes :type-prescription)
-
-
-(local (defthm near1-1
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  ;(> n 0)
-                  )
-	     (= (- x (trunc x n))
-		(* (expt 2 (- (1+ (expo x)) n)) (re (* (expt 2 (1- n)) (sig x))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable re a15)
-		  :use ((:instance trunc)
-			(:instance fp-rep))))))
-
-(local (defthm near1-3
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-;		  (> n 0)
-		  (not (integerp (* (expt 2 (1- n)) (sig x))))
-                  )
-	     (= (- (away x n) x)
-		(* (expt 2 (- (1+ (expo x)) n)) (- 1 (re (* (expt 2 (1- n)) (sig x)))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable re a15)
-		  :use ((:instance away)
-			(:instance fl-cg (x (* (expt 2 (1- n)) (sig x))))
-			(:instance fp-rep)
-		)))))
-
-
-(local (defthm near1-6
-    (implies (and (rationalp p)
-		  (> p 0)
-		  (rationalp f)
-		  (< (* p f) (* p (- 1 f))))
-	     (< f 1/2))
-;    :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE)))
-    :rule-classes ()))
-
-(local (defthm near1-7
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (not (integerp (* (expt 2 (1- n)) (sig x)))) ;easy to drop, since trunc, away, and near all
-                    ;= x
-		  (< (- x (trunc x n)) (- (away x n) x)))
-	     (= (near x n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance near1-1)
-			(:instance near1-3)
-			(:instance near1-6 
-				   (p (expt 2 (- (1+ (expo x)) n))) 
-				   (f (re (* (expt 2 (1- n)) (sig x)))))
-			(:instance near))))))
-
-(local (defthm near1-8
-    (implies (and (rationalp p)
-		  (> p 0)
-		  (rationalp f)
-		  (> (* p f) (* p (- 1 f))))
-	     (> f 1/2))
-    :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE)))
-    :rule-classes ()))
-
-(local (defthm near1-9
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (not (integerp (* (expt 2 (1- n)) (sig x))))
-		  (> (- x (trunc x n)) (- (away x n) x)))
-	     (= (near x n) (away x n)))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance near1-1)
-			(:instance near1-3)
-			(:instance near1-8 
-				   (p (expt 2 (- (1+ (expo x)) n))) 
-				   (f (re (* (expt 2 (1- n)) (sig x)))))
-			(:instance near))))))
-
-(defthm near1-a-helper
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  (< (- x (trunc x n)) (- (away x n) x)))
-	     (= (near x n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp)
-		  :use ((:instance near1-7)
-                        trunc-exactp-a
-                        away-exactp-a
-			;(:instance near1-4)
-			;(:instance near1-5)
-                        ))))
-
-;disable re?
-;use  near1-7? no, this is the "negative n case"
-(defthm near1-a-negative-n
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (<= n 0)
-                (< (- x (trunc x n)) (- (away x n) x)))
-           (= (near x n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable sgn
-                                      re
-;                                      sig
-                                      near; expo>=-2
-                                      expt-split)
-                              '(;integerp-prod
-                                expt-compare
-                                a15
-                                ;expo>=-2
-                                ))
-           :use ((:instance expt-weak-monotone (n n) (m 0))
-                 (:instance expt-weak-monotone (n n) (m -1))
-                 sig-upper-bound
-                 (:instance fl-unique (x (* 1/2 (SIG X) (EXPT 2 N))) (n 0))))))
-
-(defthm near1-a
-  (implies (and (< (- x (trunc x n)) (- (away x n) x))
-                (rationalp x)
-                (>= x 0)
-                (integerp n)
-; (> n 0)
-                )
-           (equal (near x n)
-                  (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near trunc away)
-           :use (near1-a-helper near1-a-negative-n))))
-
-
-(defthm near1-b
-    (implies (and (> (- x (trunc x n)) (- (away x n) x))
-                  (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0)
-		  )
-	     (equal (near x n)
-                    (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp)
-		  :use ((:instance near1-9)
-                        trunc-exactp-a
-                        away-exactp-a))))
-
-(defthm near2-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (>= x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near x n) (trunc x n)))
-	     (>= (abs (- x y)) (- x (trunc x n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable away-exactp-c 
-				      near trunc-exactp-c)
-		  :use ((:instance near1-b)
-			(:instance away-lower-bound)
-			(:instance trunc-upper-bound)
-			(:instance trunc-exactp-c (a y))
-			(:instance away-exactp-c (a y))))))
-
-(defthm near2-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near x n) (away x n)))
-	     (>= (abs (- x y)) (- (away x n) x)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable away-exactp-c 
-				      trunc-exactp-c)
-		  :use ((:instance near1-a)
-			(:instance away-lower-pos)
-			(:instance trunc-upper-pos)
-			(:instance trunc-exactp-c (a y))
-			(:instance away-exactp-c (a y))))))
-
-
-
-(defthm near2
-    (implies (and (exactp y n)
-                  (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  )
-	     (>= (abs (- x y)) (abs (- x (near x n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near)
-		  :use ((:instance near2-1)
-			(:instance near2-2)
-			(:instance near-choice)
-			(:instance away-lower-pos)
-			(:instance trunc-upper-pos)))))
-
-(defthm near-exactp-b
-  (implies (< 0 n) ;can't drop?
-           (exactp (near x n) n))
-  :hints (("Goal" :in-theory (disable near trunc-exactp-b away-exactp-b)
-           :use ((:instance near-choice)
-                 (:instance trunc-exactp-b)
-                 (:instance away-exactp-b)))))
-
-(defthm sgn-near-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (equal (sgn (near x n))
-		    (sgn x)))
-  :hints (("Goal" :use (near-choice
-			sgn-trunc
-			sgn-away))))
-
-(defthm near-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (near x n))
-		  (exactp x n)))
-  :rule-classes ()
-  :hints (("Goal" :use (near-choice
-			trunc-exactp-a
-			away-exactp-a))))
-
-
-
-(defthm near-exactp-c
-    (implies (and (exactp a n)
-		  (>= a x)
-                  (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  )
-	     (>= a (near x n)))
-  :hints (("Goal" :use (near-choice
-			away-exactp-c
-			trunc-upper-pos))))
-
-(defthm near-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (near x n)))
-  :hints (("Goal" :use (near-choice
-			away-lower-pos
-			trunc-exactp-c))))
-
-
-;BOZO gen!
-(defthm near-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (< 0 x)
-                (integerp n)
-                (> n 0))
-           (<= (near x n) (near y n)))
-  :hints (("Goal" :in-theory (disable near trunc-exactp-b away-exactp-b)
-           :use ((:instance near-pos)
-                 (:instance near-pos (x y))
-                 (:instance near2 (y (near y n)))
-                 (:instance near2 (x y) (y (near x n)))))))
-
-(defund near-witness (x y n)
-  (if (= (expo x) (expo y))
-      (/ (+ (near x n) (near y n)) 2)
-    (expt 2 (expo y))))
-
-(local 
- (defthm near-near-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (expo x) (expo y))))
-	     (and (<= x (near-witness x y n))
-		  (<= (near-witness x y n) y)
-		  (exactp (near-witness x y n) (1+ n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable near-witness)
-		  :use ((:instance exactp-2**n (n (expo y)) (m (1+ n)))
-			(:instance expo-upper-bound)
-			(:instance expo-monotone)
-			(:instance expt-weak-monotone (n (1+ (expo x))) (m (expo y)))
-			(:instance expo-lower-bound (x y)))))))
-
-(local
- (defthm near-near-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near x n) (near y n))
-		  (= (expo x) (expo y)))
-	     (and (<= x (near-witness x y n))
-		  (<= (near-witness x y n) y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable near-witness)
-		  :use ((:instance near2 (y (near y n)))
-			(:instance near2 (x y) (y (near x n)))
-			(:instance near-pos)
-			(:instance near-pos (x y)))))))
-
-(local
- (defthm near-near-3
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (near x n) (near y n)))
-		  (= (expo x) (expo y)))
-	     (and (<= x (near-witness x y n))
-		  (<= (near-witness x y n) y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near near-monotone near-witness)
-		  :use ((:instance near-near-2)
-			(:instance near-monotone))))))
-
-(defthm near<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (near x n) (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near)
-		  :use ((:instance near-choice)
-			(:instance trunc-upper-pos)
-			(:instance away-lower-pos)))))
-
-(defthm near>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (near x n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near)
-		  :use ((:instance near-choice)
-			(:instance trunc-upper-pos)
-			(:instance away-lower-pos)))))
-(local
- (defthm near-near-4
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near x n) (near y n))
-		  (= (expo x) (expo y)))
-	     (<= (expo (near-witness x y n)) (expo y)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable near-witness)
-                              '( abs-away  away-lower-pos))
-		  :use ((:instance near<=away (x y))
-			(:instance away-exactp-d (x y))
-			(:instance near-pos)
-;			(:instance away-pos (x y))
-			(:instance expo-upper-2 (x (near-witness x y n)) (n (1+ (expo y)))))))))
-
-
-
-(defthm near-0-0
-  (implies (and (case-split (< 0 n))
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (equal (equal (near x n) 0)
-		  (equal x 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable near))))
-
-(local
- (defthm near-near-5
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near x n) (near y n))
-		  (= (expo x) (expo y)))
-	     (integerp (* (near x n) (expt 2 (- (1- n) (expo y))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expo-trunc EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near x n)))
-			(:instance expo-monotone (x (trunc x n)) (y (near x n)))
-;			(:instance trunc-pos)
-			(:instance near-pos)
-			(:instance expo-trunc)
-			(:instance near>=trunc))))))
-
-(local
- (defthm near-near-6
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near x n) (near y n))
-		  (= (expo x) (expo y)))
-	     (integerp (* (near y n) (expt 2 (- (1- n) (expo y))))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expo-trunc  EXPO-COMPARISON-REWRITE-TO-BOUND-2)
-		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near y n)))
-			(:instance expo-monotone (x (trunc x n)) (y (near y n)))
-			(:instance near-monotone)
-;			(:instance trunc-pos)
-			(:instance near-pos)
-			(:instance expo-trunc)
-			(:instance near>=trunc))))))
-
-;gross?
-(local
- (defthm near-near-7
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k))
-	     (= (+ (* x (expt 2 (1- k)))
-		   (* y (expt 2 (1- k))))
-		(* (/ (+ x y) 2) (expt 2 k))))
-    :hints (("Goal" :in-theory (enable expt))) ;yuck
-  :rule-classes ()))
-
-(local
- (defthm near-near-8
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-	          (integerp (* x (expt 2 (1- k))))
-	          (integerp (* y (expt 2 (1- k)))))
-	     (integerp (* (/ (+ x y) 2) (expt 2 k))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near-near-7))))))
-
-(local
- (defthm near-near-9
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (< (near x n) (near y n))
-		  (= (expo x) (expo y)))
-	     (exactp (near-witness x y n) (1+ n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable near-witness)
-           :use ((:instance near-near-5)
-			(:instance near-near-6)
-			(:instance near-near-4)
-			(:instance near-near-8 (x (near x n)) (y (near y n)) (k (- n (expo y))))
-			(:instance exactp->=-expo (n (1+ n)) (e (expo y)) (x (near-witness x y n))))))))
-
-(defthm near-near-lemma
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (near x n) (near y n))))
-	     (and (<= x (near-witness x y n))
-		  (<= (near-witness x y n) y)
-		  (exactp (near-witness x y n) (1+ n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near near-monotone)
-		  :use ((:instance near-near-2)
-			(:instance near-near-1)
-			(:instance near-near-9)
-			(:instance near-monotone)))))
-
-(local
- (defthm near-near-10
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp a)
-		  (integerp n)
-		  (integerp k)
-		  (> k 0)
-		  (>= n k)		  
-		  (< 0 a)
-		  (< a x)
-		  (< 0 y)
-		  (< x y)
-		  (< y (fp+ a (1+ n)))
-		  (exactp a (1+ n)))
-	     (= (near y k) (near x k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable near near-monotone)
-		  :use ((:instance near-near-lemma (n k))
-			(:instance exactp-<= (x (near-witness x y k)) (m (1+ k)) (n (1+ n)))
-			(:instance fp+2 (x a) (y (near-witness x y k)) (n (1+ n))))))))
-
-;bad name?
-(defthm near-near
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp a)
-		  (integerp n)
-		  (integerp k)
-		  (> k 0)
-		  (>= n k)		  
-		  (< 0 a)
-		  (< a x)
-		  (< 0 y)
-		  (< y (fp+ a (1+ n)))
-		  (exactp a (1+ n)))
-	     (<= (near y k) (near x k)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance near-near-10)
-			(:instance near-monotone (n k) (x y) (y x))))))
-
-
-;why disabled?
-(defthmd near-shift
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (integerp k))
-	     (= (near (* x (expt 2 k)) n)
-		(* (near x n) (expt 2 k))))
-  :hints (("goal" :in-theory (enable near)
-		  :use (trunc-shift
-			away-shift
-			(:instance sig-expo-shift (n k))))))
-
-
-(local
- (defthm near-a-a-1
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (exactp a n)
-                 (> (near x n) a))
-            (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance fp+2 (x a) (y (near x n)))
-)))))
-
-(local
- (defthm near-a-a-2
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (rationalp d) (> d 0)
-                 (integerp n) (> n 0)
-                 (<= (near x n) a)
-                 (> x (+ a d)))
-            (> (abs (- (near x n) x))
-               (abs (- (+ a d d)
-                       x))))
-   :rule-classes ()))
-
-(local
- (defthm near-a-a-3
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (<= (near x n) a)
-                 (> x (+ a (expt 2 (- (expo a) n)))))
-            (> (abs (- (near x n) x))
-               (abs (- (+ a 
-                          (expt 2 (- (expo a) n))
-                          (expt 2 (- (expo a) n)))
-                       x))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;expt-pos
-                               )
-            :use ((:instance near-a-a-2 (d (expt 2 (- (expo a) n))))
-;			(:instance expt-pos (x (- (expo a) n)))
-                  )))))
-
-(local
- (defthm near-a-a-4
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (<= (near x n) a)
-                 (> x (+ a (expt 2 (- (expo a) n)))))
-            (> (abs (- (near x n) x))
-               (abs (- (+ a (expt 2 (- (1+ (expo a)) n)))
-                       x))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-compare-equal)
-            :use ((:instance near-a-a-3)
-                         (:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))
-
-(defthm near-a-a
-  (implies (and (rationalp x) (> x 0)
-                (rationalp a) (> a 0)
-                (integerp n) (> n 0)
-                (exactp a n)
-                (> x (+ a (expt 2 (- (expo a) n)))))
-           (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-           :use ((:instance near2 (y (+ a (expt 2 (- (1+ (expo a)) n)))))
-                 (:instance near-a-a-4)
-                 (:instance near-a-a-1)
-                 (:instance fp+1 (x a))
-;			(:instance expt-pos (x (- (1+ (expo a)) n)))
-                 ))))
-
-(local
- (defthm near-a-b-1
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (rationalp d) (> d 0)
-                 (integerp n) (> n 0)
-                 (>= (near x n) (+ a d d))
-                 (< x (+ a d)))
-            (> (abs (- (near x n) x))
-               (abs (- a x))))
-   :rule-classes ()))
-
-(local
- (defthm near-a-b-2
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (>= (near x n) 
-                     (+ a
-                        (expt 2 (- (expo a) n))
-                        (expt 2 (- (expo a) n))))
-                 (< x (+ a (expt 2 (- (expo a) n)))))
-            (> (abs (- (near x n) x))
-               (abs (- a x))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;expt-pos
-                               )
-            :use ((:instance near-a-b-1 (d (expt 2 (- (expo a) n))))
-;			(:instance expt-pos (x (- (expo a) n)))
-                  )))))
-
-(local
- (defthm near-a-b-3
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (>= (near x n) 
-                     (+ a (expt 2 (- (1+ (expo a)) n))))
-                 (< x (+ a (expt 2 (- (expo a) n)))))
-            (> (abs (- (near x n) x))
-               (abs (- a x))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-compare-equal)
-            :use ((:instance near-a-b-2)
-                  (:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))
-
-(defthm near-a-b
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x (+ a (expt 2 (- (expo a) n)))))
-	     (<= (near x n) a))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near2 (y a))
-			(:instance near-a-b-3)
-			(:instance near-a-a-1)))))
-
-(local
- (defthm near-a-c-1
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (exactp a n)
-                 (>= x a))
-            (>= (near x n) a))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance near-monotone (x a) (y x))
-                         (:instance near-choice (x a))
-                         (:instance trunc-exactp-a (x a))
-                         (:instance away-exactp-a (x a)))))))
-
-(local
-(defthm near-a-c-2
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a))
-	     (>= a 
-		 (+ (expt 2 (expo x))
-		    (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance expo-lower-bound)
-			(:instance fp+2 (x (expt 2 (expo x))) (y a))
-			(:instance exactp-2**n (n (expo x)) (m n)))))))
-
-(local
- (defthm near-a-c-3
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (> x (- a (expt 2 (- (expo x) n)))))
-            (> x (- a (expt 2 (- (1+ (expo x)) n)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-compare)
-            :use ((:instance expt-weak-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))
-
-(local
- (defthm near-a-c-4
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (exactp a n)
-                 (< x a)
-                 (> x (- a (expt 2 (- (expo x) n)))))
-            (= (expo (- a (expt 2 (- (1+ (expo x)) n))))
-               (expo x)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;expt-pos
-                               )
-            :use ((:instance near-a-c-2)
-                  (:instance near-a-c-3)
-;			(:instance expt-pos (x (expo x)))
-                  (:instance expo-upper-bound)
-                  (:instance expo-unique
-                             (x (- a (expt 2 (- (1+ (expo x)) n))))
-                             (n (expo x))))))))
-
-(local
-(defthm near-a-c-5
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (integerp (* (- a (expt 2 (- (1+ (expo x)) n)))
-			  (expt 2 (- (1- n) (expo x))))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance expt-split (r 2) (i (- (1+ (expo x)) n)) (j (- (1- n) (expo x))))
-			(:instance exactp-<=-expo (x a) (e (expo x)))
-			(:instance near-a-c-3)
-			(:instance expo-monotone (x (- a (expt 2 (- (1+ (expo x)) n)))) (y a))
-			(:instance expo-monotone (y a)))))))
-
-(local
-(defthm near-a-c-6
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (exactp (- a (expt 2 (- (1+ (expo x)) n)))
-		     n))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance exactp2 (x (- a (expt 2 (- (1+ (expo x)) n)))))
-			(:instance near-a-c-5)
-			(:instance near-a-c-2)
-;			(:instance expt-pos (x (expo x)))
-			(:instance near-a-c-4))))))
-
-(local
-(defthm near-a-c-7
-    (implies (and (rationalp x)
-		  (rationalp a)
-		  (rationalp e)
-		  (> x (- a e)))
-	     (> x (+ (- a (* 2 e))
-		     e)))
-  :rule-classes ()))
-
-(local
- (defthm near-a-c-8
-   (implies (and (rationalp x)
-                 (rationalp a)
-                 (integerp n)
-                 (> x (- a (expt 2 (- (expo x) n)))))
-            (> x (+ (- a (expt 2 (- (1+ (expo x)) n)))
-                    (expt 2 (- (expo x) n)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-compare-equal)
-            :use ((:instance expt-split (r 2) (i 1) (j (- (expo x) n)))
-                  (:instance near-a-c-7 (e (expt 2 (- (expo x) n)))))))))
-
-(local
- (defthm near-a-c-9
-   (implies (and (rationalp x) (> x 0)
-                 (rationalp a) (> a 0)
-                 (integerp n) (> n 0)
-                 (exactp a n)
-                 (< x a)
-                 (> x (- a (expt 2 (- (expo x) n)))))
-            (> (- a (expt 2 (- (1+ (expo x)) n)))
-               0))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;expt-pos
-                               )
-            :use ((:instance near-a-c-2)
-;			(:instance expt-pos (x (expo x)))
-                  )))))
-
-(defthm near-a-c
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (>= (near x n) a))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-a-a (a (- a (expt 2 (- (1+ (expo x)) n)))))
-			(:instance near-a-c-8)
-			(:instance near-a-c-6)
-			(:instance near-a-c-4)
-			(:instance near-a-c-9)))))
-
-
-
-
-(local
- (defthm near-exact-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n)))
-	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
-	       (and (< f 1) (< 0 f))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable re)
-           :use ((:instance fl-def-linear (x (* (expt 2 (1- n)) (sig x))))
-			(:instance exactp))))))
-
-(local
- (defthm near-exact-2
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (exactp x (1+ n)))
-	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
-	       (integerp (* 2 f))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable expt re)
-           :use ((:instance exactp (n (1+ n))))))))
-
-(local
- (defthm near-exact-3
-    (implies (and (integerp 2f)
-		  (< 0 2f)
-		  (< 2f 2))
-	     (= 2f 1))
-  :rule-classes ()))
-
-(local
- (defthm near-exact-4
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n)))
-	     (= (re (* (expt 2 (1- n)) (sig x)))
-		1/2))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-1)
-			(:instance near-exact-2)
-			(:instance near-exact-3 (2f (* 2 (re (* (expt 2 (1- n)) (sig x)))))))))))
-
-(local
- (defthm near-exact-5
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
-	     (= (near x n)
-		(* (fl (* (expt 2 (1- n)) (sig x)))
-		   (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near)
-			(:instance near-exact-4)
-			(:instance trunc))))))
-
-(local
- (defthm near-exact-6
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
-	     (= (* (expt 2 (- (- n 2) (expo x)))
-		   (near x n))
-		(/ (fl (* (expt 2 (1- n)) (sig x)))
-		   2)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable a15)
-           :use ((:instance near-exact-5)
-			(:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (expt 2 (- (1+ (expo x)) n)))))))))
-
-(local
- (defthm near-exact-7
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
-	     (integerp (* (expt 2 (- (- n 2) (expo x)))
-			  (near x n))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-6)
-			(:instance evenp (x (fl (* (expt 2 (1- n)) (sig x))))))))))
-
-(local
- (defthm near-exact-8
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
-	     (= (expo (near x n)) (expo x)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-4)
-			(:instance near)
-			(:instance expo-trunc))))))
-
-(local
- (defthm near-exact-9
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
-	     (exactp (near x n) (1- n)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-7)
-			(:instance near-exact-8)
-			(:instance near-pos)
-			(:instance exactp2 (x (near x n)) (n (1- n))))))))
-
-(local
- (defthm near-exact-10
-     (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
-	     (= (near x n)
-		(* (cg (* (expt 2 (1- n)) (sig x)))
-		   (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near)
-			(:instance near-exact-4)
-			(:instance away))))))
-
-(local
- (defthm near-exact-11
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
-	     (= (near x n)
-		(* (1+ (fl (* (expt 2 (1- n)) (sig x))))
-		   (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable re)
-           :use ((:instance near-exact-10)
-			(:instance near-exact-1)
-			(:instance fl-cg (x (* (expt 2 (1- n)) (sig x)))))))))
-
-(local
- (defthm near-exact-12
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
-	     (= (* (expt 2 (- (- n 2) (expo x)))
-		   (* (1+ (fl (* (expt 2 (1- n)) (sig x))))
-		      (expt 2 (- (1+ (expo x)) n))))
-		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
-		   2)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable a15)
-           :use ((:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (expt 2 (- (1+ (expo x)) n)))))))))
-
-(local
- (defthm near-exact-13
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
-	     (= (* (expt 2 (- (- n 2) (expo x)))
-		   (near x n))
-		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
-		   2)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-11)
-			(:instance near-exact-12))))))
-
-(local
- (defthm near-exact-14
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
-	     (integerp (* (expt 2 (- (- n 2) (expo x)))
-			  (near x n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable a9; rearrange-fractional-coefs-equal
-                                      distributivity)
-		  :use ((:instance near-exact-13)
-			(:instance evenp (x (fl (* (expt 2 (1- n)) (sig x)))))
-			(:instance x-or-x/2 (x (fl (* (expt 2 (1- n)) (sig x))))))))))
-
-(local
- (defthm near-exact-15
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (not (= (near x n) (expt 2 (1+ (expo x)))))
-		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
-	     (= (expo (near x n)) (expo x)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-4)
-			(:instance near)
-			(:instance away)
-;			(:instance away-pos)
-			(:instance expo-away))))))
-
-(local
- (defthm near-exact-16
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (not (= (near x n) (expt 2 (1+ (expo x)))))
-		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
-	     (exactp (near x n) (1- n)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-14)
-			(:instance near-exact-15)
-			(:instance near-pos)
-			(:instance exactp2 (x (near x n)) (n (1- n))))))))
-
-(local
- (defthm near-exact-17
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (exactp x n))
-		  (exactp x (1+ n))
-		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
-	     (exactp (near x n) (1- n)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-16)
-			(:instance exactp-2**n (n (1+ (expo x))) (m (1- n))))))))
-
-(defthm near-exact
-  (implies (and (rationalp x) (> x 0)
-                (integerp n) (> n 1)
-                (exactp x (1+ n))
-                (not (exactp x n)))
-           (exactp (near x n) (1- n)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-exact-17)
-			(:instance near-exact-9)))))
-
-
-(local
- (defthm near-est-1
-   (implies (and (integerp n) (> n 0)
-                 (rationalp x) (> x 0)
-                 (> (abs (- x (near x n)))
-                    (expt 2 (- (expo x) n))))
-            (< (trunc x n)
-               (- x (expt 2 (- (expo x) n)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable TRUNC-EXACTP-B REARRANGE-NEGATIVE-COEFS-<)
-            :use ((:instance near2 (y (trunc x n)))
-                  (:instance trunc-exactp-b)
-;			(:instance trunc-pos)
-                  (:instance trunc-upper-pos))))))
-
-(local
-(defthm near-est-2
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (> (abs (- x (near x n)))
-		     (expt 2 (- (expo x) n))))
-	     (> (away x n)
-		(+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable near-exactp-c)
-           :use ((:instance near2 (y (away x n)))
-			(:instance away-exactp-b)
-;			(:instance away-pos)
-			(:instance away-lower-pos))))))
-
-(local
-(defthm near-est-3
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (> (abs (- x (near x n)))
-		     (expt 2 (- (expo x) n))))
-	     (> (away x n)
-		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable a15 expt-compare-equal)
-		  :use ((:instance near-est-1)
-			(:instance expt-split (r 2) (i (- (expo x) n)) (j 1))
-			(:instance near-est-2))))))
-
-(local
-(defthm near-est-4
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (> (abs (- x (near x n)))
-		     (expt 2 (- (expo x) n))))
-	     (> x
-		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-est-3)
-			(:instance fp+1 (x (trunc x n)))
-			(:instance trunc-exactp-b)
-;			(:instance trunc-pos)
-			(:instance expo-trunc)
-			(:instance away-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
-
-(defthm near-est
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0))
-	     (<= (abs (- x (near x n)))
-		 (expt 2 (- (expo x) n))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-est-4)
-			(:instance trunc-lower-1)
-;			(:instance trunc-pos)
-                        ))))
-
-(local
-(defthm near-power-a-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (= (near x n)
-			  (expt 2 (1+ (expo x))))))
-	     (= (expo (near x n)) (expo x)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near)
-			(:instance away)
-;			(:instance away-pos)
-			(:instance expo-trunc)
-			(:instance expo-away))))))
-
-(local
- (defthm near-power-a-2
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 0)
-                 (not (= (near x n)
-                         (expt 2 (1+ (expo x))))))
-            (< (near x n) (expt 2 (1+ (expo x)))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance near-power-a-1)
-                         (:instance expo-upper-bound (x (near x n)))
-                         (:instance near-pos))))))
-
-(local
- (defthm near-power-a-3
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 0)
-                 (not (= (near x n)
-                         (expt 2 (1+ (expo x))))))
-            (<= (+ (near x n) (expt 2 (- (1+ (expo x)) n)))
-                (expt 2 (1+ (expo x)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable EXACTP-2**N-REWRITE EXACTP-2**N)
-            :use ((:instance near-power-a-2)
-                 (:instance near-power-a-1)
-;                 (:instance exactp-near)
-                 (:instance fp+2 (x (near x n)) (y (expt 2 (1+ (expo x)))))
-                 (:instance exactp-2**n (n (1+ (expo x))) (m n))
-                 (:instance near-pos))))))
-
-(local
- (defthm near-power-a-4
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 0)
-                 (not (= (near x n)
-                         (expt 2 (1+ (expo x))))))
-            (<= (+ (- x (expt 2 (- (expo x) n)))
-                   (expt 2 (- (1+ (expo x)) n)))
-                (expt 2 (1+ (expo x)))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance near-power-a-3)
-                         (:instance near-est))))))
-
-(local
- (defthm near-power-a-5
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 0)
-                 (not (= (near x n)
-                         (expt 2 (1+ (expo x))))))
-            (<= (+ x (expt 2 (- (expo x) n)))
-                (expt 2 (1+ (expo x)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-compare-equal)
-            :use ((:instance near-power-a-4)
-                  (:instance expt-split (r 2) (i (- (expo x) n)) (j 1)))))))
-
-(local
-(defthm near-power-a-6
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (= (near x n)
-			  (expt 2 (1+ (expo x)))))
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (+ x (expt 2 (- (expo x) n)))
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-power-a-5))))))
-
-(local
-(defthm near-power-a-7
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (= (near x n)
-			  (expt 2 (1+ (expo x)))))
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= x 
-		(- (expt 2 (1+ (expo x)))
-		   (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-power-a-6))))))
-
-(local
-(defthm near-power-a-8
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (= (near x n)
-			  (expt 2 (1+ (expo x)))))
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (integerp (* (- (expt 2 (1+ (expo x)))
-			     (expt 2 (- (expo x) n)))
-			  (expt 2 (- n (expo x))))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-power-a-7)
-			(:instance expt-split (r 2) (i (- n (expo x))) (j (1+ (expo x))))
-			(:instance expt-split (r 2) (i (- n (expo x))) (j (- (expo x) n))))))))
-
-(local
-(defthm hack-90
-    (implies (and (= x y)
-		  (integerp (* y e)))
-	     (integerp (* x e)))
-  :rule-classes ()))
-
-(local
-(defthm near-power-a-9
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (= (near x n)
-			  (expt 2 (1+ (expo x)))))
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (integerp (* x (expt 2 (- n (expo x))))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-power-a-7)
-			(:instance hack-90 
-				   (y (- (expt 2 (1+ (expo x))) (expt 2 (- (expo x) n))))
-				   (e (expt 2 (- n (expo x)))))
-			(:instance near-power-a-8))))))
-
-(local
-(defthm near-power-a-10
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (= (near x n)
-			  (expt 2 (1+ (expo x)))))
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (exactp x (1+ n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable exactp2)
-		  :use ((:instance near-power-a-9))))))
-
-(local
-(defthm near-power-a-11
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (= (near x n)
-			  (expt 2 (1+ (expo x)))))
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (not (exactp x n)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-power-a-6)
-			(:instance expo-upper-bound)
-			(:instance fp+2 (y (expt 2 (1+ (expo x)))))
-			(:instance exactp-2**n (n (1+ (expo x))) (m n))
-			(:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))
-
-(local
-(defthm near-power-a-12
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (= (near x n)
-			  (expt 2 (1+ (expo x)))))
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (exactp (near x n) (1- n)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-power-a-10)
-			(:instance near-power-a-11)
-			(:instance near-exact))))))
-
-(local
- (defthm near-power-a-13
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (not (= (near x n)
-                         (expt 2 (1+ (expo x)))))
-                 (>= (+ x (expt 2 (- (expo x) n)))
-                     (expt 2 (1+ (expo x)))))
-            (<= (+ (near x n) (expt 2 (- (+ (expo x) 2) n)))
-                (expt 2 (1+ (expo x)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable exactp-2**n exactp-2**n-rewrite)
-            :use ((:instance near-power-a-12)
-                  (:instance near-power-a-2)
-                  (:instance near-pos)
-                  (:instance fp+2 (x (near x n)) (n (1- n)) (y (expt 2 (1+ (expo x)))))
-                  (:instance exactp-2**n (n (1+ (expo x))) (m (1- n)))
-                  (:instance near-power-a-1))))))
-
-(local
- (defthm near-power-a-14
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (not (= (near x n)
-                         (expt 2 (1+ (expo x)))))
-                 (>= (+ x (expt 2 (- (expo x) n)))
-                     (expt 2 (1+ (expo x)))))
-            (>= (+ (near x n) (expt 2 (- (+ (expo x) 1) n)))
-                (expt 2 (1+ (expo x)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable expt-split)
-            :use ((:instance near-est))))))
-
-(defthm near-power-a
-  (implies (and (rationalp x) (> x 0)
-                (integerp n) (> n 1)
-                (>= (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x)))))
-           (= (near x n)
-              (expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable expt-compare)
-           :use ((:instance near-power-a-13)
-                 (:instance near-power-a-14)
-                 (:instance expt-strong-monotone
-                            (n (- (+ (expo x) 1) n))
-                            (m (- (+ (expo x) 2) n)))))))
-
-(local
-(defthm near-power-b-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		 (expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance exactp-2**n (n (1+ (expo x))) (m n))
-;			(:instance expt-pos (x (- (expo x) n)))
-			(:instance trunc-exactp-c 
-				   (x (+ x (expt 2 (- (expo x) n))))
-				   (a (expt 2 (1+ (expo x))))))))))
-
-(local
-(defthm near-power-b-2
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x))))
-		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-			  (expt 2 (1+ (expo x))))))
-	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-power-b-1))))))
-
-(local
-(defthm near-power-b-3
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x))))
-		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-			  (expt 2 (1+ (expo x))))))
-	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		 (+ (expt 2 (1+ (expo x)))
-		    (expt 2 (- (+ 2 (expo x)) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near-power-b-2)
-			(:instance exactp-2**n (n (1+ (expo x))) (m n))
-			(:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n)))))
-;			(:instance expt-pos (x (1+ (expo x))))
-			(:instance expo-2**n (n (1+ (expo x))))
-			(:instance fp+2 
-				   (x (expt 2 (1+ (expo x))))
-				   (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))
-
-(local
-(defthm near-power-b-4
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x))))
-		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-			  (expt 2 (1+ (expo x))))))
-	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable expt-compare)
-           :use ((:instance near-power-b-3)
-			(:instance expo-upper-bound)
-			(:instance expt-weak-monotone (n (- (expo x) n)) (m (- (+ 2 (expo x)) n))))))))
-
-(defthm near-power-b
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near-power-b-4)
-			(:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
-;			(:instance expt-pos (x (- (expo x) n)))
-                        ))))
-
-(local
- (defthm near-trunc-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (near x n)
-		(if (and (exactp x (1+ n)) (not (exactp x n)))
-		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
-		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near-power-a)
-			(:instance near-power-b)
-			(:instance exactp-2**n (n (1+ (expo x))) (m (1- n)))
-			(:instance trunc-trunc (x (+ x (expt 2 (- (expo x) n)))) (m (1- n)))
-			(:instance trunc-exactp-a
-				   (x (trunc (+ x (expt 2 (- (expo x) n))) n))
-				   (n (1- n)))
-;			(:instance expt-pos (x (- (expo x) n)))
-                        )))))
-
-(local
- (defthm near-trunc-2
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x)))))
-            (= (expo (near x n))
-               (expo x)))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance near-power-a-1)
-                         (:instance near-est))))))
-
-(local
- (defthm near-trunc-3
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x)))))
-            (= (expo (+ x (expt 2 (- (expo x) n))))
-               (expo x)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;expt-pos
-                               )
-            :use ((:instance expo-unique (x (+ x (expt 2 (- (expo x) n)))) (n (expo x)))
-                  (:instance expo-lower-bound)
-;			(:instance expt-pos (x (- (expo x) n)))
-                  )))))
-
-(local
- (defthm near-trunc-4
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (exactp x n))
-            (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
-                x))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;expt-pos
-                               )
-            :use ((:instance trunc-exactp-c
-                             (x (+ x (expt 2 (- (expo x) n))))
-                             (a x))
-;			(:instance expt-pos (x (- (expo x) n)))
-                  )))))
-
-(local
- (defthm near-trunc-5
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (exactp x n))
-            (<(trunc (+ x (expt 2 (- (expo x) n))) n)
-              (fp+ x n)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-compare
-                                       )
-            :use ((:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
-                  (:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n)))
-;			(:instance expt-pos (x (- (expo x) n)))
-                  )))))
-
-(local
-(defthm near-trunc-6
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (< (+ x (expt 2 (- (expo x) n)))
-		     (expt 2 (1+ (expo x))))
-		  (exactp x n))
-	     (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		 x))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near-trunc-5)
-			(:instance fp+2 (y (trunc (+ x (expt 2 (- (expo x) n))) n)))
-			(:instance trunc-exactp-a (x (+ x (expt 2 (- (expo x) n)))))
-;			(:instance expt-pos (x (- (expo x) n)))
-                        )))))
-
-(local
-(defthm near-trunc-7
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (< (+ x (expt 2 (- (expo x) n)))
-		     (expt 2 (1+ (expo x))))
-		  (exactp x n))
-	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		x))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-trunc-4)
-			(:instance near-trunc-6))))))
-
-(defthm near-exactp
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (exactp x n))
-	     (equal (near x n) x))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-choice)
-			(:instance trunc-exactp-a)
-			(:instance away-exactp-a)))))
-			
-(local
- (defthm near-trunc-case-1
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (exactp x n))
-            (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-               (near x n)))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance near-trunc-7)
-                         (:instance near-exactp)
-                         (:instance trunc-exactp-a (x (+ x (expt 2 (- (expo x) n))))))))))
-
-(local
- (defthm near-trunc-8
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (= (near x n)
-                    (- x (expt 2 (- (expo x) n)))))
-            (exactp x (1+ n)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;exactp-near
-                                       NEAR-EXACTP-D
-                                       )
-            :use ((:instance near-trunc-2)
-                  (:instance near-pos)
-;	(:instance exactp-near)
-                  (:instance fp+1 (x (near x n)) (n (1+ n)))
-                  (:instance exactp-<= (x (near x n)) (m n) (n (1+ n))))))))
-
-(local
- (defthm near-trunc-9
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (not (exactp x (1+ n))))
-            (> (near x n)
-               (- x (expt 2 (- (expo x) n)))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance near-trunc-8)
-                         (:instance near-est))))))
-
-(local
- (defthm near-trunc-10
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1))
-            (<= (near x n)
-                (trunc (+ x (expt 2 (- (expo x) n))) n)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;exactp-near
-                                       )
-            :use (;(:instance exactp-near)
-                  (:instance trunc-exactp-c (x (+ x (expt 2 (- (expo x) n)))) (a (near x n)))
-                  (:instance near-est))))))
-
-(local
- (defthm near-trunc-11
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (not (exactp x (1+ n))))
-            (< (trunc (+ x (expt 2 (- (expo x) n))) n)
-               (+ (near x n)
-                  (expt 2 (- (expo x) n))
-                  (expt 2 (- (expo x) n)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;expt-pos
-                               )
-            :use ((:instance near-trunc-9)
-                  (:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
-;			(:instance expt-pos (x (- (expo x) n)))
-                  )))))
-
-(local
- (defthm near-trunc-12
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (not (exactp x (1+ n))))
-            (< (trunc (+ x (expt 2 (- (expo x) n))) n)
-               (+ (near x n)
-                  (expt 2 (- (1+ (expo x)) n)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable expt-compare-equal)
-            :use ((:instance near-trunc-11)
-                         (:instance expt-split (r 2) (i (- (expo x) n)) (j 1)))))))
-
-(local
- (defthm near-trunc-13
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (not (exactp x (1+ n))))
-            (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
-                (near x n)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;exactp-near
-                                       trunc-exactp-b ;expt-pos
-                                       NEAR-EXACTP-D
-                                       )
-            :use ((:instance near-trunc-12)
-                  (:instance fp+2
-                             (x (near x n))
-                             (y (trunc (+ x (expt 2 (- (expo x) n))) n)))
-                  (:instance near-trunc-2)
-;			(:instance expt-pos (x (- (expo x) n)))
-;                  (:instance exactp-near)
-                  (:instance near-pos)
-                  (:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n))))))))))
-
-(local
- (defthm near-trunc-case-2
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (not (exactp x (1+ n))))
-            (= (near x n)
-               (trunc (+ x (expt 2 (- (expo x) n))) n)))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance near-trunc-10)
-                         (:instance near-trunc-13))))))
-
-(local
-(defthm near-trunc-14
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (< (+ x (expt 2 (- (expo x) n)))
-		     (expt 2 (1+ (expo x))))
-		  (exactp x (1+ n))
-		  (not (exactp x n))
-		  (> (near x n) x))
-	     (= (near x n)
-		(+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-est)
-;			(:instance exactp-near)
-			(:instance exactp-<= (x (near x n)) (m n) (n (1+ n)))
-			(:instance fp+2 (n (1+ n)) (y (near x n))))))))
-
-(local
-(defthm near-trunc-15
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (< (+ x (expt 2 (- (expo x) n)))
-		     (expt 2 (1+ (expo x))))
-		  (exactp x (1+ n))
-		  (not (exactp x n))
-		  (> (near x n) x))
-	     (= (near x n)
-		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-trunc-14)
-			(:instance near-exact)
-			(:instance trunc-exactp-a (x (near x n)) (n (1- n))))))))
-
-(local
-(defthm near-trunc-16
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (< (+ x (expt 2 (- (expo x) n)))
-		     (expt 2 (1+ (expo x))))
-		  (exactp x (1+ n))
-		  (not (exactp x n))
-		  (< (near x n) x))
-	     (<= (near x n)
-		 (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable ;expt-pos
-                              )
-		  :use ((:instance near-exact)
-;			(:instance expt-pos (x (- (expo x) n)))
-			(:instance trunc-exactp-c
-				   (x (+ x (expt 2 (- (expo x) n))))
-				   (n (1- n))
-				   (a (near x n))))))))
-
-(local
-(defthm near-trunc-17
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (< (+ x (expt 2 (- (expo x) n)))
-		     (expt 2 (1+ (expo x))))
-		  (exactp x (1+ n))
-		  (not (exactp x n))
-		  (< (near x n) x))
-	     (>= (+ (near x n)
-		    (expt 2 (- (1+ (expo x)) n)))
-		 (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable expt-split)
-                              
-		  :use ((:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))) (n (1- n)))
-			(:instance near-est))))))
-
-(local
-(defthm near-trunc-18
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (> (+ (near x n)
-		   (expt 2 (- (+ 2 (expo x)) n)))
-		(+ (near x n)
-		   (expt 2 (- (1+ (expo x)) n)))))		 
-  :rule-classes ()
-  :hints (("goal" :use ((:instance expt-strong-monotone 
-				   (n (- (1+ (expo x)) n)) 
-				   (m (- (+ 2 (expo x)) n))))))))
-
-(local
- (defthm near-trunc-19
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (exactp x (1+ n))
-                 (not (exactp x n))
-                 (< (near x n) x))
-            (> (+ (near x n)
-                  (expt 2 (- (+ 2 (expo x)) n)))
-               (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable  expt-compare)
-            :use ((:instance near-trunc-17)
-                  (:instance near-trunc-18))))))
-
-(local
- (defthm near-trunc-20
-   (implies (and (rationalp x) (> x 0)
-                 (integerp n) (> n 1)
-                 (< (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x))))
-                 (exactp x (1+ n))
-                 (not (exactp x n))
-                 (< (near x n) x))
-            (>= (near x n)
-                (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (disable ;expt-pos 
-                               NEAR-EXACTP-D
-                               )
-            :use ((:instance near-exact)
-;			(:instance expt-pos (x (- (expo x) n)))
-                  (:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n)))) (n (1- n)))
-                  (:instance fp+2 
-                             (x (near x n)) 
-                             (y (trunc (+ x (expt 2 (- (expo x) n))) (1- n)))
-                             (n (1- n)))
-                  (:instance near-pos)
-                  (:instance near-trunc-19)
-                  (:instance near-trunc-2))))))
-
-(local
-(defthm near-trunc-21
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (< (+ x (expt 2 (- (expo x) n)))
-		     (expt 2 (1+ (expo x))))
-		  (exactp x (1+ n))
-		  (not (exactp x n))
-		  (< (near x n) x))
-	     (= (near x n)
-		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-trunc-16)
-			(:instance near-trunc-20))))))
-
-(local
- (defthm near-trunc-case-3
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (< (+ x (expt 2 (- (expo x) n)))
-		     (expt 2 (1+ (expo x))))
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (near x n)
-		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable near-exactp-b)
-		  :use ((:instance near-trunc-21)
-			(:instance near-exactp-b)
-			(:instance near-trunc-15))))))
-
-(defthm near-trunc
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (= (near x n)
-		(if (and (exactp x (1+ n)) (not (exactp x n)))
-		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
-		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-trunc-1)
-			(:instance near-trunc-case-1)
-			(:instance near-trunc-case-2)
-			(:instance near-trunc-case-3)))))
-
-(defthm near-0
-  (equal (near 0 n)
-         0)
-  :hints (("Goal" :in-theory (enable near))))
-
-;BOZO yuck?
-(defthm sgn-near
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (= (near x n)
-              (* (sgn x) (near (abs x) n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable abs))))
-
-
-
-
-(defthm plus-near-1
-  (implies (and (exactp x (+ k (- (expo x) (expo y))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                )
-           (= (re (* (expt 2 (1- k)) (sig y)))
-              (re (* (expt 2 (1- (+ k (- (expo (+ x y)) (expo y)))))
-                     (sig (+ x y))))))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (enable re sig exactp expt-split expt-minus))))
-
-(defthm plus-near-2
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y)))))
-           (iff (evenp (fl (* (expt 2 (1- k)) (sig y))))
-                (evenp (fl (* (expt 2
-                                    (1- (+ k (- (expo (+ x y)) (expo y)))))
-                              (sig (+ x y)))))))
-  :otf-flg t
-  :rule-classes nil 
-  :hints (("Goal" :in-theory (e/d (expt-split
-                                   expt-minus
-                                   exactp sig ; EXPT-SPLIT-leading-constant
-                                   evenp ;this is sort of cheating...
-                                   ) ())
-           :use ((:instance exactp2 (n (+ k (expo x) (- (expo y)))))
-                 (:instance exactp-<=
-                            (m (+ -1 k (expo x) (- (expo y))))
-                            (n (+ k (expo x) (- (expo y)))))))))
-
-(defthm plus-near
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y)))))
-           (= (+ x (near y k))
-              (near (+ x y)
-                    (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (enable near)
-           :use (plus-trunc plus-away plus-near-1 plus-near-2
-                            (:instance exactp-<=
-                                       (m (+ -1 k (expo x) (* -1 (expo y))))
-                                       (n (+ k (expo x) (* -1 (expo y)))))))))
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/near.lisp acl2-6.3/books/rtl/rel5/support/near.lisp
--- acl2-6.2/books/rtl/rel5/support/near.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/near.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,455 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-(local (include-book "near-proofs"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;;
-;; New stuff:
-;;
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-(defthm near-minus
-  (equal (near (* -1 x) n)
-         (* -1 (near x n))))
-
-(defthm near-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (near x n)
-                  0))
-  :hints (("goal" :in-theory (enable near sig))))
-
-(defthm near-0
-  (equal (near 0 n)
-         0))
-
-(defthm near-rational-type-prescription
-  (rationalp (near x n))
-  :rule-classes (:rewrite :type-prescription))
-
-
-(defthm near-non-negative-rational-type-prescription
-  (implies (<= 0 x)
-           (and (<= 0 (near x n))
-                (rationalp (near x n))))
-  :rule-classes :type-prescription)
-
-(defthm near-non-positive-rational-type-prescription
-  (implies (<= x 0)
-           (and (<= (near x n) 0)
-                (rationalp (near x n))))
-  :rule-classes :type-prescription)
-
-(defthm near-pos
-  (implies (and (< 0 x)
-                (< 0 n)
-                (rationalp x)
-                (integerp n)
-                )
-           (< 0 (near x n)))
-  :rule-classes (:type-prescription :linear)
-  :hints (("Goal" :use ((:instance near-choice)))))
-
-(defthm near-neg
-    (implies (and (< x 0)
-		  (< 0 n)
-                  (rationalp x)
-		  (integerp n)
-		  )
-	     (< (near x n) 0))
-  :rule-classes (:type-prescription :linear)
-  :hints (("Goal" :use ((:instance near-choice)))))
-
-
-
-(defthm near1-a
-  (implies (and (< (- x (trunc x n)) (- (away x n) x))
-                (rationalp x)
-                (>= x 0)
-                (integerp n)
-                )
-           (equal (near x n)
-                  (trunc x n)))
-  :rule-classes ())
-
-(defthm near1-b
-  (implies (and (> (- x (trunc x n)) (- (away x n) x))
-                (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0)
-                )
-           (equal (near x n) 
-                  (away x n)))
-  :rule-classes ())
-
-(defthm near2-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (>= x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near x n) (trunc x n)))
-	     (>= (abs (- x y)) (- x (trunc x n))))
-  :rule-classes ())
-
-(defthm near2-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near x n) (away x n)))
-	     (>= (abs (- x y)) (- (away x n) x)))
-  :rule-classes ())
-
-(defthm near-choice
-  (or (= (near x n) (trunc x n))
-      (= (near x n) (away x n)))
-  :rule-classes ())
-
-(defthm near2
-  (implies (and (exactp y n)
-                (rationalp x)
-                (rationalp y)
-                (> x 0)
-                (> y 0)
-                (integerp n)
-                (> n 0)
-                )
-           (>= (abs (- x y)) (abs (- x (near x n)))))
-  :rule-classes ())
-
-(defthm near-exactp-b
-  (implies (< 0 n)
-           (exactp (near x n) n)))
-
-(defthm sgn-near-2
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (equal (sgn (near x n))
-                  (sgn x))))
-
-(defthm near-exactp-a
-  (implies (and (rationalp x)
-                (integerp n) 
-                (> n 0))
-           (iff (= x (near x n))
-                (exactp x n)))
-  :rule-classes ())
-
-(defthmd near-exactp-c
-  (implies (and (exactp a n)
-                (>= a x)
-                (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (rationalp a)
-                )
-           (>= a (near x n))))
-
-(defthm near-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (near x n))))
-
-
-
-;BOZO gen!
-(defthm near-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (< 0 x)
-                (integerp n)
-                (> n 0))
-           (<= (near x n) (near y n))))
-
-(defund near-witness (x y n)
-  (if (= (expo x) (expo y))
-      (/ (+ (near x n) (near y n)) 2)
-    (expt 2 (expo y))))
-
-(defthm near<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (near x n) (away x n)))
-  :rule-classes ())
-
-(defthm near>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (near x n) (trunc x n)))
-  :rule-classes ())
-
-
-
-(defthm near-0-0
-  (implies (and (case-split (< 0 n))
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (equal (equal (near x n) 0)
-		  (equal x 0)))
-  :rule-classes ())
-
-(defthm near-near-lemma
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (near x n) (near y n))))
-	     (and (<= x (near-witness x y n))
-		  (<= (near-witness x y n) y)
-		  (exactp (near-witness x y n) (1+ n))))
-  :rule-classes ())
-
-;bad name?
-(defthm near-near
-  (implies (and (rationalp x)
-                (rationalp y)
-                (rationalp a)
-                (integerp n)
-                (integerp k)
-                (> k 0)
-                (>= n k)		  
-                (< 0 a)
-                (< a x)
-                (< 0 y)
-                (< y (fp+ a (1+ n)))
-                (exactp a (1+ n)))
-           (<= (near y k) (near x k)))
-  :rule-classes ())
-
-;BOZO why disabled?
-(defthmd near-shift
-  (implies (and (rationalp x)
-                (integerp n)
-                (integerp k))
-           (= (near (* x (expt 2 k)) n)
-              (* (near x n) (expt 2 k)))))
-
-(defthm near-a-a
-  (implies (and (rationalp x) (> x 0)
-                (rationalp a) (> a 0)
-                (integerp n) (> n 0)
-                (exactp a n)
-                (> x (+ a (expt 2 (- (expo a) n)))))
-           (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
-  :rule-classes ())
-
-(defthm near-a-b
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x (+ a (expt 2 (- (expo a) n)))))
-	     (<= (near x n) a))
-  :rule-classes ())
-
-(defthm near-a-c
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (>= (near x n) a))
-  :rule-classes ())
-
-;bad name?
-(defthm near-exact
-  (implies (and (rationalp x) (> x 0)
-                (integerp n) (> n 1)
-                (exactp x (1+ n))
-                (not (exactp x n)))
-           (exactp (near x n) (1- n)))
-  :rule-classes ())
-
-(defthm near-est
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0))
-	     (<= (abs (- x (near x n)))
-		 (expt 2 (- (expo x) n))))
-  :rule-classes ())
-
-(defthm near-power-a
-  (implies (and (rationalp x) (> x 0)
-                (integerp n) (> n 1)
-                (>= (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x)))))
-           (= (near x n)
-              (expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthm near-power-b
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-;bad name?
-(defthm near-exactp
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (exactp x n))
-	     (equal (near x n) x))
-  :rule-classes ())
-
-(defthm near-trunc
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (= (near x n)
-		(if (and (exactp x (1+ n)) (not (exactp x n)))
-		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
-		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
-  :rule-classes ())
-
-
-;BOZO yuck? bad name!
-(defthm sgn-near
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (= (near x n)
-              (* (sgn x) (near (abs x) n))))
-  :rule-classes ())
-
-(defthm plus-near-1
-  (implies (and (exactp x (+ k (- (expo x) (expo y))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                )
-           (= (re (* (expt 2 (1- k)) (sig y)))
-              (re (* (expt 2 (1- (+ k (- (expo (+ x y)) (expo y)))))
-                     (sig (+ x y))))))
-  :rule-classes nil)
-
-(defthm plus-near-2
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y)))))
-           (iff (evenp (fl (* (expt 2 (1- k)) (sig y))))
-                (evenp (fl (* (expt 2
-                                    (1- (+ k (- (expo (+ x y)) (expo y)))))
-                              (sig (+ x y)))))))
-
-  :rule-classes nil)
-
-(defthm plus-near
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y)))))
-           (= (+ x (near y k))
-              (near (+ x y)
-                    (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes nil)
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/ocat.lisp acl2-6.3/books/rtl/rel5/support/ocat.lisp
--- acl2-6.2/books/rtl/rel5/support/ocat.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/ocat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,370 +0,0 @@
-(in-package "ACL2")
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(local (include-book "../arithmetic/expt"))
-(local (include-book "../arithmetic/expo"))
-(local (include-book "../arithmetic/arith2"))
-(local (include-book "../arithmetic/fp2"))
-(local (include-book "../arithmetic/integerp"))                
-
-(local (in-theory (enable expt-minus)))
-
-(defund ocat (x y n)
-  (declare (xargs :guard t))
-  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
-
-
-(defthm ocat-nonnegative-integer-type
-  (and (integerp (OCAT X Y N))
-       (<= 0 (OCAT X Y N)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than ocat-nonnegative-integer-type and might be worse
-(in-theory (disable (:type-prescription ocat)))
-
-;just a rewrite rule
-(defthm ocat-natp
-  (natp (ocat x y n)))
-
-;became less general when we made ocat nfix its args
-(defthm ocat-0
-    (implies (and (case-split (<= 0 y))
-                  (case-split (integerp y)))		  
-	     (equal (ocat 0 y n) y))
-    :hints (("Goal" :in-theory (enable ocat))))
-
-;became less general when we made ocat nfix its args
-(defthm ocat-x-0-0
-  (implies (and (case-split (<= 0 x))
-                (case-split (integerp x)))
-           (equal (ocat x 0 0)
-                  x))
-  :hints (("Goal" :in-theory (enable ocat))))
-
-
-#|
-;old form:
-(defthm ocat-upper-bound
-  (implies (and (integerp x)
-                (bvecp y n) ;expensive?
-                (integerp n))
-           (< (ocat x y n)
-              (+ (* (expt 2 n) x) (expt 2 n))))
-  :hints (("Goal" :in-theory (enable ocat bvecp)))
-  :rule-classes (:rewrite (:linear :trigger-terms ((ocat x y n))))
-  )
-
-|#
-
-;this can be really expensive
-;old form:
-(defthm ocat-upper-bound
-  (implies (and (< y (expt 2 n))
-                (<= 0 x)
-                (integerp x)
-                (<= 0 y)
-                (integerp n)
-                (<= 0 n)
-                )
-           (< (ocat x y n)
-              (+ (* (expt 2 n) x) (expt 2 n))))
-  :hints (("Goal" :in-theory (enable ocat )))
-  :rule-classes (:rewrite (:linear :trigger-terms ((ocat x y n))))
-  )
-
-
-
-
-
-
-(encapsulate
- ()
- (local (defthm ocat-bvecp-rewrite-fw
-          (implies (and (integerp n)
-                        (<= 0 n)
-                        (integerp k)
-                        (<= 0 k)
-                        (integerp x)
-                        (<= 0 x)
-                        (>= k n) ;drop?
-                        (force (bvecp y n))
-                        )
-                   (implies (bvecp (ocat x y n) k)
-                            (bvecp x (- k n))))
-          :rule-classes nil
-          :hints (("goal" :in-theory (enable bvecp expt-split ocat)))
-          ))
-
- (local (defthm hack-hack
-          (implies (and (integerp x)
-                        (integerp y)
-                        (integerp m)
-                        (<= 0 m)
-                        (integerp n)
-                        (<= 0 n)
-                        (< x (expt 2 m))
-                        (< y (expt 2 n))
-                        )
-                   (< (+ (/ y (expt 2 n)) x)
-                      (expt 2 m)))
-          :hints (("goal" :in-theory (set-difference-theories
-                                      (enable expt-split)
-                                      '())))))
-
- (local (defthm hack-ocat
-          (implies (and (integerp x)
-                        (integerp y)
-                        (integerp m)
-                        (<= 0 m)
-                        (integerp n)
-                        (<= 0 n)
-
-                        (< x (expt 2 m))
-                        (< y (expt 2 n))
-                        )
-                   (< (+ y (* x (expt 2 n)))
-                      (expt 2 (+ m n))))
-          :hints (("goal" :in-theory (set-difference-theories
-                                      (enable expt-split)
-                                      '( hack-hack))
-                   :use (hack-hack
-                         (:instance  mult-both-sides-of-<-by-positive (a (+ x (* y (/ (expt 2 n)))))
-                                     (b (expt 2 m))
-                                     (c (expt 2 n))))))))
-
- (local (in-theory (enable bvecp)))
-           
- (local (defthm ocat-bvecp-rewrite-bk
-          (implies (and (integerp n)
-                        (<= 0 n)
-                        (integerp k)
-                        (<= 0 k)
-                        (integerp x)
-                        (<= 0 x)
-                        (>= k n) ;drop?
-                        (force (bvecp y n))
-                        )
-                   (implies
-                    (bvecp x (- k n))
-                    (bvecp (ocat x y n) k)))
-          :rule-classes nil
-          :hints (("goal" :in-theory (set-difference-theories
-                                      (enable ocat)
-                                      '(hack-ocat))
-                   :use (:instance hack-ocat (n n) (m (- k n)))))))
-
- (defthm ocat-bvecp-rewrite
-   (implies (and (>= k n) ;handle the other case?
-                 (case-split (integerp x))
-                 (case-split (<= 0 x))
-                 (case-split (bvecp y n))
-                 (case-split (natp n))
-                 (case-split (natp k))
-                 )
-            (equal (bvecp (ocat x y n) k)
-                   (bvecp x (- k n))))
-   :hints (("goal" 
-            :use (ocat-bvecp-rewrite-fw ocat-bvecp-rewrite-bk))
-           ))
-
- (local (defthm hack-4
-          (implies (and (integerp x)
-                        (<= 0 x)
-                        (not (equal x 0)))
-                   (>= x 1))))
-
-;expensive? handle this better somehow?
- (local (defthm hack-3
-          (implies (and (integerp x)
-                        (<= 0 x)
-                        (not (equal x 0))
-                        (rationalp a)
-                        (<= 0 a)
-                        )
-                   (>= (* x a) a))
-          :rule-classes :linear
-          :hints (("goal" :in-theory (disable
-                                      hack-4
-;                                      cancel-in-prods-<
- ;                                     cancel-times-<-eric-1
-                                      )
-                   :use (hack-4
-                         (:instance mult-both-sides-of-<-by-positive
-                                    (b a) (a (* a x)) (c (/ a))))))))
-
-
-;better names?
- (defthm ocat-bvecp-other-case
-   (implies (and (< p n)
-                 (integerp n)
-                 (<= 0 n)
-                 (integerp p)
-                 (<= 0 p)
-                 (integerp x)
-                 (<= 0 x)
-                 (integerp y)
-                 (<= 0 y)
-                 )
-            (equal (bvecp (ocat x y n) p)
-                   (and (bvecp y p)
-                        (equal 0 x)))
-            )
-   :hints (("goal" :in-theory (set-difference-theories
-                               (enable power2p ocat)
-                               '(expt-compare
-                                 ))
-            :use (:instance expt-compare (lhs (expt 2 p)) (rhs (expt 2 n)))))
-   :otf-flg t
-   )
- )
-
-
-#|
-;make more general
-;also make ncat ver
-(defthm highbits-ocat
-  (implies (and (integerp x)
-                (<= 0 x)
-                (force (bvecp y n))
-                (integerp n)
-                (<= 0 n)
-                )
-           (equal (highbits (OCAT x y n) n)
-                  x))
-  :hints (("Goal" :in-theory (enable expt-split
-                                     ocat 
-                                     highbits))))
-|#
-
-(local (defthm hack-10
-    (implies (and (integerp x)
-		  (integerp y)
-		  (< x y))
-	     (<= x (1- y)))
-  :rule-classes ()))
-
-(local (defthm ocat-bvecp-simple
-    (implies (and (natp n)
-		  (natp k)
-		  (bvecp x m)
-		  (natp m)
-		  (bvecp y n)
-		  (>= k (+ m n)))
-	     (bvecp (ocat x y n) k))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable natp bvecp ocat)
-                              '(expt-compare EXPT-COMPARE-EQUAL))
-		  :use ((:instance expt-split (i m) (j n) (r 2))
-			(:instance hack-10 (y (expt 2 m)))
-			(:instance expt-weak-monotone (m p))
-			(:instance expt-weak-monotone (m k) (n (+ m n))))))))
-
-(defthm ocat-bvecp
-    (implies (and (>= k n) ;handle other case?
-                  (bvecp x (- k n))
-                  (case-split (natp n))
-		  (case-split (natp k))
-		  (case-split (bvecp y n))
-                  )
-	     (bvecp (ocat x y n) k))
-  :hints (("Goal" :in-theory (enable natp bvecp)
-		  :use ((:instance ocat-bvecp-simple (m (- k n)))))))
-
-(defthm ocat-0-rewrite
-    (implies (and (case-split (integerp x))
-		  (case-split (<= 0 x)))
-	     (equal (ocat 0 x n) x))
-    :hints (("Goal" :in-theory (enable ocat))))
-
-(defthm ocat-with-x-not-a-natural
-  (implies (or (not (integerp x))
-               (< x 0))
-           (equal (ocat x y n)
-                  (nfix y)))
-  :hints (("Goal" :in-theory (enable ocat))))
-
-(defthm ocat-with-y-not-a-natural
-  (implies (or (not (integerp y))
-               (< y 0))
-           (equal (ocat x y n)
-                  (* (nfix x) (expt 2 (nfix n)))))
-  :hints (("Goal" :in-theory (enable ocat))))
-
-(defthm ocat-with-n-not-a-natural
-  (implies (or (not (integerp n))
-               (< n 0))
-           (equal (ocat x y n)
-                  (+ (nfix x) (nfix y))))
-  :hints (("Goal" :in-theory (enable ocat))))
-
-
-
-;might be able to generalize this more
-;this look like it will fire as often as we'd like
-(defthm ocat-upper-bound-2
-  (implies (and (< x (expt 2 k)) ; k is a free var. huh?
-                (case-split (< y (expt 2 n)))
-                (case-split (integerp k))
-                (case-split (<= 0 k))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (< (ocat x y n)
-              (expt 2 (+ n k))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bvecp expt-split)
-                              '(OCAT-BVECP-REWRITE OCAT-BVECP ))
-           :use ((:instance <-TRANSITIVE (a y) (b (expt 2 n)) (c (* (EXPT 2 K) (EXPT 2 N))))
-                 (:instance ocat-bvecp (k (+ n k)))))))
-
-(defthm ocat-associative
-  (implies (and (case-split (<= 0 m)) ;new now that ocat fixes its args
-                (case-split (<= 0 n)) ;new now that ocat fixes its args
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (ocat (ocat x y m) z n)
-                  (ocat x (ocat y z n) (+ m n))))
-  :hints (("Goal" :in-theory (enable ocat))))
-
-(defthm ocat-equal-0
-  (implies  (and (case-split (<= 0 x))
-                 (case-split (<= 0 y))
-                 (case-split (integerp x))
-                 (case-split (integerp y))
-                 )
-            (equal (equal (ocat x y n) 0)
-                   (and (equal x 0)
-                        (equal y 0))))
-  :hints (("Goal" :in-theory (enable ocat)))
-  )
-
-(defthm ocat-combine-constants
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep y)
-                              (quotep n)
-                              (quotep m)))
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= m n))
-                (case-split (integerp m))
-                (case-split (integerp n)))
-           (equal (ocat x (ocat y z m) n)
-                  (ocat (ocat x y (- n m)) z m)))
-  :otf-flg t
-  :hints
-  (("goal" :in-theory (enable ocat))))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/oddr-proofs.lisp acl2-6.3/books/rtl/rel5/support/oddr-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/oddr-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/oddr-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,658 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-;(include-book "near")
-(local (include-book "../arithmetic/top"))
-(local (include-book "float"))
-(local (include-book "trunc"))
-(local (include-book "away"))
-(local (include-book "near"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-;;
-;; New stuff:
-;;
-
-(defund oddr (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x)))))
-    (if (evenp z)
-	(* (sgn x) (1+ z) (expt 2 (- (1+ (expo x)) n)))
-      (* (sgn x) z (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm oddr-pos
-  (implies (and (< 0 x)
-                (rationalp x)
-                (integerp n)
-                (> n 0))
-           (< 0 (oddr x n)))
-  :rule-classes ()
-  :otf-flg t
-  :hints (("Goal" :in-theory (e/d (oddr) ( SIG-LESS-THAN-1-MEANS-X-0 sig-lower-bound))
-           :use ((:instance sig-lower-bound)))))
-
-(defthm oddr>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (oddr x n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable oddr)
-		  :use ((:instance trunc)
-                        ))))
-
-;BOZO just opens up ODDR when x is positive
-;leave disabled!
-(defthmd oddr-rewrite
-    (implies (and (< 0 x) ;note this hyp
-                  (rationalp x)
-		  (integerp n)
-		  (< 0 n))
-	     (equal (oddr x n)
-		    (let ((z (fl (* (expt 2 (- (1- n) (expo x))) x))))
-		      (if (evenp z)
-			  (* (1+ z) (expt 2 (- (1+ (expo x)) n)))
-			(* z (expt 2 (- (1+ (expo x)) n)))))))
-  :hints (("Goal" :in-theory (enable sig sgn oddr expt-split))))
-
-(local 
- (defthm hack2
-    (implies (and (integerp n)
-		  (rationalp x))
-	     (= (fl (* 1/2 x (expt 2 n)))
-		(fl (* x (expt 2 (1- n))))))
-    :hints (("Goal" :in-theory (enable expt)))
-  :rule-classes ()))
-
-(local
- (defthm oddr-other-1
-    (implies (and (rationalp x)
-		 (> x 0)
-		 (integerp n)
-		 (> n 1))
-	     (= (trunc x (1- n))
-		(* (fl (/ (* (expt 2 (- (1- n) (expo x))) x) 2))
-		   (expt 2 (- (+ 2 (expo x)) n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable trunc-pos-rewrite)		  
-		  :use ((:instance hack2 (n (- (1- n) (expo x)))))))))
-
-(local
- (defthm oddr-other-2
-    (implies (and (rationalp x)
-		 (> x 0)
-		 (integerp n)
-		 (> n 1))
-	     (= (trunc x (1- n))
-		(* (fl (/ (fl (* (expt 2 (- (1- n) (expo x))) x)) 2))
-		   (expt 2 (- (+ 2 (expo x)) n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable fl/int-rewrite)
-		  :use ((:instance oddr-other-1)
-			(:instance fl/int-rewrite (x (* (expt 2 (- (1- n) (expo x))) x)) (n 2)))))))
-
-;move!
-(defthm fl/2
-  (implies (integerp z)
-           (= (fl (/ z 2))
-              (if (evenp z)
-                  (/ z 2)
-                (/ (1- z) 2))))
-  :hints (("Goal" :in-theory (enable evenp)))
-  :rule-classes ())
-
-(local
- (defthm oddr-other-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n) 
-		  (> n 1)
-		  (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
-		  (evenp z))
-	     (= (trunc x (1- n))
-		(* z (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance fl/2)
-			(:instance expt-split (r 2) (j (- (1+ (expo x)) n)) (i 1))
-			(:instance oddr-other-2))))))
-
-(local
- (defthm oddr-other-4
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n) 
-		  (> n 1)
-		  (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
-		  (not (evenp z)))
-	     (= (* (fl (/ (fl (* (expt 2 (- (1- n) (expo x))) x)) 2))
-		   (expt 2 (- (+ 2 (expo x)) n)))
-		(* (fl (/ z 2)) (expt 2 (- (+ 2 (expo x)) n)))))
-  :rule-classes ()))
-
-(local
- (defthm oddr-other-5
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n) 
-		  (> n 1)
-		  (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
-		  (not (evenp z)))
-	     (= (trunc x (1- n))
-		(* (fl (/ z 2)) (expt 2 (- (+ 2 (expo x)) n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance oddr-other-2)
-			(:instance oddr-other-4))))))
-
-(local 
- (defthm hack3
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp z)
-		  (equal x y))
-	     (= (* x z) (* y z)))
-  :rule-classes ()))
-
-(local
- (defthm oddr-other-6
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 1)
-		  (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
-		  (not (evenp z)))
-	     (= (trunc x (1- n))
-		(* (/ (1- z) 2) (expt 2 (- (+ 2 (expo x)) n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance fl/2)
-			(:instance oddr-other-5)
-			(:instance hack3
-				   (x (/ (1- z) 2))
-				   (y (fl (/ z 2)))
-				   (z (expt 2 (- (+ 2 (expo x)) n)))))))))
-
-(local
- (defthm oddr-other-7
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp n)
-                 (> n 1)
-                 (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
-                 (not (evenp z)))
-            (= (trunc x (1- n))
-               (* (1- z) (expt 2 (- (1+ (expo x)) n)))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (enable expt-split)
-            :use ((:instance oddr-other-6)
-                  (:instance expt-split (r 2) (j (- (1+ (expo x)) n)) (i 1)))))))
-
-(defthm oddr-other
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n) 
-		  (> n 1))
-	     (= (oddr x n)
-		(+ (trunc x (1- n))
-		   (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance oddr-other-3 (z (fl (* (expt 2 (- (1- n) (expo x))) x))))
-			(:instance oddr-other-7 (z (fl (* (expt 2 (- (1- n) (expo x))) x))))
-			(:instance oddr-rewrite)))))
-
-(local
- (defthm expo-oddr-1
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 0))
-	     (< (trunc x n) (expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d () ( expo-trunc abs-trunc))
-		  :use ((:instance expo-trunc)
-;			(:instance trunc-pos)
-			(:instance expo-upper-bound (x (trunc x n))))))))
-
-(local
- (defthm expo-oddr-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (< (oddr x n) (expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (expt-split) ( expo-trunc abs-trunc))
-		  :use ((:instance expo-oddr-1 (n (1- n)))
-			(:instance oddr-other)
-			(:instance exactp-2**n (m (1- n)) (n (1+ (expo x))))
-			(:instance expo-trunc (n (1- n)))
-			(:instance expt-strong-monotone (n (- (1+ (expo x)) n)) (m (- (1+ (expo x)) (1- n))))
-;			(:instance trunc-pos (n (1- n)))
-			(:instance fp+2 (n (1- n)) (x (trunc x (1- n))) (y (expt 2 (1+ (expo x))))))))))
-
-(local
- (defthm expo-oddr-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (<= (expo (oddr x n)) (expo x)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expo-oddr-2)
-			(:instance oddr-pos)
-			(:instance expo-upper-2 (x (oddr x n)) (n (1+ (expo x)))))))))
-
-(defthm expo-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (equal (expo (oddr x n)) (expo x)))
-  :hints (("Goal" :in-theory (e/d ( expt-split ) (EXPO-COMPARISON-REWRITE-TO-BOUND
-                                                  EXPO-COMPARISON-REWRITE-TO-BOUND-2))
-		  :use ((:instance expo-oddr-3)
-			(:instance oddr-other)
-;			(:instance expt-pos (x (- (1+ (expo x)) n)))
-			(:instance expo-monotone (y (oddr x n)) (x (trunc x (1- n))))
-			(:instance oddr-pos)
-;			(:instance trunc-pos (n (1- n)))
-                        ))))
-
-(local
- (defthm exactp-oddr-1
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (= (* (+ (trunc x (1- n))
-		      (expt 2 (- (1+ (expo x)) n)))
-		   (expt 2 (- (1- n) (expo x))))
-		(1+ (* (trunc x (1- n)) (expt 2 (- (1- n) (expo x)))))))
-	     :rule-classes ()
-  :hints (("Goal" :in-theory (disable ;expt-pos
-                                      abs-trunc)
-		  :use ((:instance expt-split (r 2) (j (- (1- n) (expo x))) (i (- (1+ (expo x)) n))))))))
-
-(local
- (defthm exactp-oddr-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (= (* (oddr x n) (expt 2 (- (1- n) (expo x))))
-		(1+ (* (trunc x (1- n)) (expt 2 (- (1- n) (expo x)))))))
-	     :rule-classes ()
-  :hints (("Goal" :in-theory (disable ;expt-pos
-                                      abs-trunc)
-		  :use ((:instance oddr-other)
-			(:instance exactp-oddr-1))))))
-
-(local
- (defthm exactp-oddr-3
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (= (expt 2 (- (1- n) (expo x)))
-		(* 2 (expt 2 (- (- n 2) (expo x))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance expt-split (r 2) (j (- (- n 2) (expo x))) (i 1)))))))
-
-(local
- (defthm exactp-oddr-4
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n))
-	     (= (* y 2 (expt 2 (- (- n 2) (expo x))))
-		(* 2 y (expt 2 (- (- n 2) (expo x))))))
-  :rule-classes ()))
-
-(local
- (defthm exactp-oddr-5
-    (implies (and (rationalp x)
-		  (integerp n))
-	     (= (* (trunc x (1- n)) (expt 2 (- (1- n) (expo x))))
-		(* 2 (trunc x (1- n)) (expt 2 (- (- n 2) (expo x))))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance exactp-oddr-3)
-			(:instance exactp-oddr-4 (y (trunc x (1- n)))))))))
-
-(local
- (defthm exactp-oddr-6
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (= (* (oddr x n) (expt 2 (- (1- n) (expo x))))
-		(1+ (* 2 (* (trunc x (1- n)) (expt 2 (- (- n 2) (expo x))))))))
-	     :rule-classes ()
-  :hints (("Goal" :in-theory (disable ;expt-pos
-                                      abs-trunc)
-		  :use ((:instance exactp-oddr-2)
-			(:instance exactp-oddr-5))))))
-
-(defthm exactp-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (exactp (oddr x n) n))
-	     :rule-classes ()
-  :hints (("Goal" :in-theory (disable ;expt-pos
-                                      abs-trunc)
-		  :use ((:instance exactp-oddr-6)
-			(:instance exactp2 (x (oddr x n)))
-			(:instance exactp2 (x (trunc x (1- n))) (n (1- n)))))))
-(local
- (defthm not-exactp-oddr-1
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (= (* (+ (trunc x (1- n)) (expt 2 (- (1+ (expo x)) n)))
-		   (expt 2 (- (- n 2) (expo x))))
-		(+ (* (trunc x (1- n)) (expt 2 (- (- n 2) (expo x)))) 1/2)))
-	     :rule-classes ()
-	     :hints (("Goal" :use ((:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (- (1+ (expo x)) n))))))))
-
-(local
- (defthm not-exactp-oddr-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (= (* (oddr x n)
-		   (expt 2 (- (- n 2) (expo x))))
-		(+ (* (trunc x (1- n)) (expt 2 (- (- n 2) (expo x)))) 1/2)))
-	     :rule-classes ()
-  :hints (("Goal" :use ((:instance oddr-other)
-			(:instance not-exactp-oddr-1))))))
-
-(defthm not-exactp-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (not (exactp (oddr x n) (1- n))))
-	     :rule-classes ()
-  :hints (("Goal" :in-theory (disable ;expt-pos
-                              EQUAL-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE
-                                      abs-trunc)
-		  :use ((:instance not-exactp-oddr-2)
-			(:instance exactp2 (x (oddr x n)) (n (1- n)))
-			(:instance exactp2 (x (trunc x (1- n))) (n (1- n)))))))
-
-(local
- (defthm trunc-oddr-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 1))
-	     (= (trunc (oddr x n) (1- n))
-		(* (fl (* (expt 2 (- (- n 2) (expo x))) 
-			  (+ (* (fl (* (expt 2 (- (- n 2) (expo x)))
-				       x))
-				(expt 2 (- (+ (expo x) 2) n)))
-			     (expt 2 (- (1+ (expo x)) n)))))
-		   (expt 2 (- (+ (expo x) 2) n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable trunc-pos-rewrite)
-		  :use ((:instance oddr-other)
-			(:instance oddr-pos))))))
-
-(local
- (defthm trunc-oddr-2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 1))
-	     (= (trunc (oddr x n) (1- n))
-		(* (fl (+ (fl (* (expt 2 (- (- n 2) (expo x)))
-				 x))
-			  1/2))
-		   (expt 2 (- (+ (expo x) 2) n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable a15)
-           :use ((:instance trunc-oddr-1)
-			(:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (- (+ (expo x) 2) n)))
-			(:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (- (+ (expo x) 1) n))))))))
-
-(local
- (defthm trunc-oddr-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 1))
-	     (= (trunc (oddr x n) (1- n))
-		(* (fl (* (expt 2 (- (- n 2) (expo x)))
-			  x))
-		   (expt 2 (- (+ (expo x) 2) n)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance trunc-oddr-2))))))
-
-(local
- (defthm trunc-oddr-4
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 1))
-	     (= (trunc (oddr x n) (1- n))
-		(trunc x (1- n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable trunc-pos-rewrite)
-		  :use ((:instance trunc-oddr-3))))))
-
-(defthm trunc-oddr
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (> n m))
-	     (= (trunc (oddr x n) m)
-		(trunc x m)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable trunc-trunc)
-           :use ((:instance trunc-oddr-4)
-			(:instance oddr-pos)
-			(:instance trunc-trunc (n (1- n)))
-			(:instance trunc-trunc (n (1- n)) (x (oddr x n)))
-                        ))))
-
-(defun kp (k x y)
-  (+ k (- (expo (+ x y)) (expo y))))
-
-(defthm oddr-plus
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-		  (> x 0)
-		  (> y 0)
-		  (> k 1)
-		  (> (+ (1- k) (- (expo x) (expo y))) 0)
-		  (exactp x (+ (1- k) (- (expo x) (expo y)))))
-	     (= (+ x (oddr y k))
-		(oddr (+ x y) (kp k x y))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance oddr-other (n k) (x y))
-			(:instance expo-monotone (x y) (y (+ x y)))
-			(:instance plus-trunc (k (1- k)))
-			(:instance oddr-other (x (+ x y)) (n (kp k x y)))))))
-
-(defthm trunc-trunc-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (trunc x k) (trunc (oddr y m) k)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance trunc-oddr (x y) (m k) (n m))
-			(:instance trunc-monotone (x y) (y x) (n k))))))
-
-(local
- (defthm away-away-oddr-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (> (away x k) (trunc y (1- m))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance away-lower-pos (n k))
-			(:instance trunc-upper-pos (x y) (n (1- m))))))))
-
-(local
- (defthm away-away-oddr-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (away x k) (+ (trunc y (1- m)) (expt 2 (- (+ (expo y) 2) m)))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance away-away-oddr-1)
-			(:instance fp+2 (x (trunc y (1- m))) (y (away x k)) (n (1- m)))
-			(:instance expo-trunc (x y) (n (1- m)))
-			(:instance trunc-exactp-b (x y) (n (1- m)))
-			(:instance away-exactp-b (n k))
-;			(:instance trunc-pos (x y) (n (1- m)))
-			(:instance exactp-<= (x (away x k)) (m k) (n (1- m))))))))
-
-(local
- (defthm away-away-oddr-3
-   (implies (and (rationalp x)
-                 (rationalp y)
-                 (integerp m)
-                 (integerp k)
-                 (> x y)
-                 (> y 0)
-                 (> k 0)
-                 (>= (- m 2) k))
-            (> (away x k) (oddr y m)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (disable EXPT-COMPARE)
-            :use ((:instance away-away-oddr-2)
-                  (:instance oddr-other (x y) (n m))
-                  (:instance expt-strong-monotone (n (- (1+ (expo y)) m)) (m (- (+ (expo y) 2) m))))))))
-
-(defthm away-away-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (away x k) (away (oddr y m) k)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance away-away-oddr-3)
-			(:instance oddr-pos (x y) (n m))
-			(:instance away-exactp-c (a (away x k)) (x (oddr y m)) (n k))
-			(:instance away-exactp-b (n k))))))
-
-(defthm near-near-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (near x k) (near (oddr y m) k)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance trunc-exactp-b (n (1- m)) (x y))
-			(:instance oddr-pos (x y) (n m))
-;			(:instance trunc-pos (x y) (n (1- m)))
-			(:instance trunc-upper-pos (x y) (n (1- m)))
-			(:instance expo-trunc (x y) (n (1- m)))
-			(:instance oddr-other (x y) (n m))
-			(:instance expt-strong-monotone 
-				   (n (- (1+ (expo y)) m)) 
-				   (m (- (+ 2 (expo y)) m)))
-			(:instance near-near
-				   (n (- m 2))
-				   (a (trunc y (1- m)))
-				   (y (oddr y m)))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/oddr.lisp acl2-6.3/books/rtl/rel5/support/oddr.lisp
--- acl2-6.2/books/rtl/rel5/support/oddr.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/oddr.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,227 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-(local (include-book "oddr-proofs"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-;;
-;; New stuff:
-;;
-
-(defund oddr (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x)))))
-    (if (evenp z)
-	(* (sgn x) (1+ z) (expt 2 (- (1+ (expo x)) n)))
-      (* (sgn x) z (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm oddr-pos
-    (implies (and (< 0 x)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< 0 (oddr x n)))
-  :rule-classes ())
-
-(defthm oddr>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (oddr x n) (trunc x n)))
-  :rule-classes ())
-
-;BOZO just opens up ODDR when x is positive
-;leave disabled!
-(defthmd oddr-rewrite
-    (implies (and (< 0 x) ;note this hyp
-                  (rationalp x)
-		  (integerp n)
-		  (< 0 n))
-	     (equal (oddr x n)
-		    (let ((z (fl (* (expt 2 (- (1- n) (expo x))) x))))
-		      (if (evenp z)
-			  (* (1+ z) (expt 2 (- (1+ (expo x)) n)))
-			(* z (expt 2 (- (1+ (expo x)) n))))))))
-
-;move!
-(defthm fl/2
-  (implies (integerp z)
-           (= (fl (/ z 2))
-              (if (evenp z)
-                  (/ z 2)
-                (/ (1- z) 2))))
-  :rule-classes ())
-
-(defthm oddr-other
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n) 
-		  (> n 1))
-	     (= (oddr x n)
-		(+ (trunc x (1- n))
-		   (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes ())
-
-(defthm expo-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (equal (expo (oddr x n)) (expo x))))
-
-(defthm exactp-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (exactp (oddr x n) n))
-	     :rule-classes ())
-
-
-(defthm not-exactp-oddr
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> x 0)
-		  (> n 1))
-	     (not (exactp (oddr x n) (1- n))))
-	     :rule-classes ())
-
-(defthm trunc-oddr
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (> n m))
-	     (= (trunc (oddr x n) m)
-		(trunc x m)))
-  :rule-classes ())
-
-;disable?
-(defun kp (k x y)
-  (+ k (- (expo (+ x y)) (expo y))))
-
-(defthm oddr-plus
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-		  (> x 0)
-		  (> y 0)
-		  (> k 1)
-		  (> (+ (1- k) (- (expo x) (expo y))) 0)
-		  (exactp x (+ (1- k) (- (expo x) (expo y)))))
-	     (= (+ x (oddr y k))
-		(oddr (+ x y) (kp k x y))))
-  :rule-classes ())
-
-(defthm trunc-trunc-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (trunc x k) (trunc (oddr y m) k)))
-  :rule-classes ())
-
-(defthm away-away-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (away x k) (away (oddr y m) k)))
-  :rule-classes ())
-
-(defthm near-near-oddr
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp m)
-		  (integerp k)
-		  (> x y)
-		  (> y 0)
-		  (> k 0)
-		  (>= (- m 2) k))
-	     (>= (near x k) (near (oddr y m) k)))
-  :rule-classes ())
-
diff -Nru acl2-6.2/books/rtl/rel5/support/openers.lisp acl2-6.3/books/rtl/rel5/support/openers.lisp
--- acl2-6.2/books/rtl/rel5/support/openers.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/openers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-(in-package "ACL2")
-
-(program)
-
-; In this file, an event-control (evctl) data structure is either (posedge
-; clk), (negedge clk), or (even n).
-
-(defun negate-event-control (evctl)
-  (if (equal evctl '(even n))
-      (list 'not evctl)
-    (let* ((edge0 (car evctl))
-           (clk (cadr evctl))
-           (edge (case edge0
-                   (posedge 'pedge)
-                   (negedge 'nedge)
-                   (otherwise
-                    (er hard 'gen-model-preamble-common
-                        "Unable to handle edge specifier ~x0."
-                        edge0)))))
-      `(not (,edge (,clk (1- n)) (,clk n))))))
-
-(defun negate-event-control-list (x)
-  (declare (xargs :guard (true-listp x)))
-  (if (endp x)
-      nil
-    (cons (negate-event-control (car x))
-          (negate-event-control-list (cdr x)))))
-
-(defmacro def$open (name type &rest evctl-lst)
-  (if (eq type :skipped)
-      `(value-triple '(def$open ,name :skipped))
-    (let ((evctl-lst (if (eq type :input)
-                         (assert$ (null evctl-lst)
-                                  '((even n)))
-                       evctl-lst)))
-      `(defthm ,(intern-in-package-of-symbol
-                 (concatenate 'string (symbol-name name) "$OPEN")
-                 name)
-         (implies (and (integerp n)
-                       (< 0 n)
-                       ,@(negate-event-control-list evctl-lst))
-                  (equal (,name n)
-                         (,name (1- n))))
-         :hints (("Goal"
-                  :expand ((,name n)
-                           ,@(and (eq type :wire) `((,name (1- n)))))))))))
diff -Nru acl2-6.2/books/rtl/rel5/support/package-defs.lisp acl2-6.3/books/rtl/rel5/support/package-defs.lisp
--- acl2-6.2/books/rtl/rel5/support/package-defs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/package-defs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,53 +0,0 @@
-(in-package "ACL2")
-
-;;Miscellaneous symbols that are not in *acl2-exports*:
-
-(defmacro other-acl2-symbols ()
-  ''(local-defun local-defthm local-in-theory
-                 n ; clock argument
-                 defbvecp ; macro written out by compiler
-                 defclock ; macro written out by compiler
-                 defperiodic
-                 fast-clock  ;BOZO, is importing these into the packages, the right way to handle this?
-                 slow-clock-one-quantum-wide
-                 slow-clock-one-quantum-wide-shifted
-                 slow-clock-two-quanta-wide
-                 slow-clock-two-quanta-wide-shifted
-                 always-1
-                 posedge negedge edge ; for defclock macro, which we used to use
-                 pedge nedge ;for defperiodic macro
-                 $path ; path argument of signal functions
-                 sub1-induction ; for bvecp lemma hints
-                 ))
-
-;;Symbols that occur in the RTL translation.  Formerly the symbol UNKNOWN was excluded from this
-;;list so that the corresponding symbol in the "*" package could be assigned a different function
-;;definition; but the first argument of unknown can be in any package desired.
-
-(defmacro rtl-symbols ()
-  ''(log= log<> log< log<= log> log>= lnot logand1 logior1 logxor1 shft lshft
-          rshft cat mulcat bitn bits setbits setbitn mod+ mod* mod- bind
-          case-select if1 cond1 reset reset2 land lior lxor lcat n! arr0 natp1
-          as ag mk-bvarr mk-bvec ag2 as2
-          abs trunc near minf inf sticky sig expo bitvec ; appeared May 2004 (from rpl_main.cc)
-          expt ; appeared May 2004 (seems to come from r2s)
-          prop gen
-          unknown unknown2))
-
-;;Functions that are defined in the FP library:
-
-(defmacro fp-symbols ()
-  ''(natp fl cg fl-half bvecp bv-arrp sumbits sigm kap tau lamt lamg lamz lam1 lam2 lam3 lam4 lam0 lamb
-          expo sgn sig 
-          exactp fp+ bias esgnf eexpof esigf erepp eencodingp eencode edecode ndecode rebias-expo isgnf iexpof isigf 
-          nrepp drepp irepp nencodingp dencodingp iencodingp nencode dencode iencode ddecode idecode trunc away re 
-          near near-witness near+ sticky oddr kp inf minf ieee-mode-p rnd flip rnd-const drnd))
-
-;;ACL2 symbols that are imported by all packages:
-
-(defmacro shared-symbols ()
-  '(union-eq *acl2-exports*
-    (union-eq *common-lisp-symbols-from-main-lisp-package*
-     (union-eq (other-acl2-symbols)
-      (union-eq (fp-symbols)
-       (rtl-symbols))))))
diff -Nru acl2-6.2/books/rtl/rel5/support/rewrite-theory.lisp acl2-6.3/books/rtl/rel5/support/rewrite-theory.lisp
--- acl2-6.2/books/rtl/rel5/support/rewrite-theory.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/rewrite-theory.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-; This little utility, rewrite-theory, was written by Matt Kaufmann.
-
-(in-package "ACL2")
-
-(program)
-
-(defun collect-rewrites (runes ans)
-  (cond
-   ((endp runes) (reverse ans))
-   ((eq (caar runes) :rewrite)
-    (collect-rewrites (cdr runes) (cons (car runes) ans)))
-   (t
-    (collect-rewrites (cdr runes) ans))))
-
-(defun rewrite-theory-fn (from to wrld)
-; Returns all rewrite rules introduced after FROM, up to and including TO.
-  (let ((diff (set-difference-theories-fn
-               (universal-theory-fn to wrld)
-               (universal-theory-fn from wrld)
-               t
-               wrld)))
-    (collect-rewrites diff nil)))
-
-(defmacro rewrite-theory (from &optional (to ':here))
-  ; Returns all rewrite rules introduced after FROM up to and including TO.
-  (list 'rewrite-theory-fn from to 'world))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/rnd.lisp acl2-6.3/books/rtl/rel5/support/rnd.lisp
--- acl2-6.2/books/rtl/rel5/support/rnd.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/rnd.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1140 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-;put all the new defuns in this book together at the t
-
-(in-package "ACL2")
-
-(local (include-book "float"))
-(local (include-book "trunc"))
-(local (include-book "away"))
-(local (include-book "near"))
-(local (include-book "near+"))
-(local (include-book "sticky"))
-(local (include-book "bitn")) ; for roundup
-(local (include-book "land0")) ; for roundup
-(local (include-book "lior0")) ; for roundup
-
-;; Necessary functions:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-(defund near+ (x n)
-  (if (< (re (* (expt 2 (1- n)) (sig x)))
-	 1/2)
-      (trunc x n)
-    (away x n)))
-
-(defund sticky (x n)
-  (cond ((exactp x (1- n)) x)
-	(t (+ (trunc x (1- n))
-              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-;;
-;; New stuff:
-;;
-
-;Typically, we may plan to have inf and minf enabled, but we have a few lemmas about them anyway..
-
-(defund inf (x n)
-  (if (>= x 0)
-      (away x n)
-    (trunc x n)))
-
-(defund minf (x n)
-  (if (>= x 0)
-      (trunc x n)
-    (away x n)))
-
-(defund IEEE-MODE-P (mode)
-  (member mode '(trunc inf minf near)))
-
-(defund rounding-mode-p (mode)
-  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
-
-(defund rnd (x mode n)
-  (case mode
-    (away (away x n))
-    (near+ (near+ x n))
-    (trunc (trunc x n))
-    (inf (inf x n))
-    (minf (minf x n))
-    (near (near x n))
-    (otherwise 0)))
-
-(defund flip (m)
-  (case m
-    (inf 'minf)
-    (minf 'inf)
-    (t m)))
-
-;rounding constant..
-(defun rnd-const (e mode n)
-  (case mode
-    ((near near+) (expt 2 (- e n)))
-    ((inf away) (1- (expt 2 (1+ (- e n)))))
-    (otherwise 0)))
-
-(defthmd inf-minus
-  (equal (inf (* -1 x) n)
-         (* -1 (minf x n)))
-  :hints (("Goal" :in-theory (enable inf minf))))
-
-(defthmd minf-minus
-  (equal (minf (* -1 x) n)
-         (* -1 (inf x n)))
-  :hints (("Goal" :in-theory (enable inf minf))))
-
-(defthm inf-shift
-  (implies (and (rationalp x)
-                (integerp n)
-                (integerp k))
-           (= (inf (* x (expt 2 k)) n)
-              (* (inf x n) (expt 2 k))))
-  :hints (("Goal" :in-theory (enable inf)
-           )))
-
-(defthm minf-shift
-  (implies (and (rationalp x)
-                (integerp n)
-                (integerp k))
-           (= (minf (* x (expt 2 k)) n)
-              (* (minf x n) (expt 2 k))))
-  :hints (("Goal"  :in-theory (enable minf))))
-
-(defthm ieee-mode-p-implies-rounding-mode-p
-  (implies (IEEE-mode-p mode)
-           (rounding-mode-p mode))
-  :hints (("Goal" :in-theory (enable rounding-mode-p)))
-  :rule-classes (:rewrite; :forward-chaining
-                 ))
-
-(defthm rationalp-rnd
-  (rationalp (rnd x mode n))
-  :hints (("Goal" :in-theory (enable rnd)))
-  :rule-classes (:type-prescription))
-
-(defthmd rnd-minus
-  (equal (rnd (* -1 x) mode n)
-         (* -1 (rnd x (flip mode) n)))
-  :hints (("Goal" :in-theory (enable rnd flip  minf-minus inf-minus near+-minus))))
-
-(local (defthm rnd-const-thm-1
-         (implies (and (integerp n)
-                       (> n 1)
-                       (integerp x)
-                       (> x 0)
-                       (>= (expo x) n))
-                  (= (near x n)
-                     (if (and (exactp x (1+ n))
-                              (not (exactp x n)))
-                         (trunc (+ x (rnd-const (expo x) 'near n)) (1- n))
-                       (trunc (+ x (rnd-const (expo x) 'near n)) n))))
-         :rule-classes ()
-         :hints (("Goal"
-                  :use ((:instance near-trunc))))))
-
-(local (defthm rnd-const-thm-2
-    (implies (and (integerp n)
-		  (> n 1)
-		  (integerp x)
-		  (> x 0)
-		  (>= (expo x) n))
-	     (= (away x n)
-		(trunc (+ x (rnd-const (expo x) 'inf n)) n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2)
-		  :use ((:instance away-imp (m (1+ (expo x)))))))))
-
-(local (defthm rnd-const-thm-3
-    (implies (and (integerp n)
-		  (> n 1)
-		  (integerp x)
-		  (> x 0)
-		  (>= (expo x) n))
-	     (= (near+ x n)
-		(trunc (+ x (rnd-const (expo x) 'near+ n)) n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable exactp2)
-		  :use ((:instance near+trunc))))))
-
-(defthm RND-CONST-THM
-    (implies (and (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 1)
-		  (integerp x)
-		  (> x 0)
-		  (>= (expo x) n))
-	     (= (rnd x mode n)
-		(if (and (eql mode 'near)
-			 (exactp x (1+ n))
-			 (not (exactp x n)))
-		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
-		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
-  :rule-classes ()
-  :hints (("Goal"  :in-theory (enable inf minf rnd rounding-mode-p ieee-mode-p)
-           :use (rnd-const-thm-1 rnd-const-thm-2 rnd-const-thm-3))))
-
-(defun roundup (x mode n)
-; Returns T when we should add an ulp after truncating x to n digits.
-  (case mode
-    (near+ (= (bitn x (- (expo x) n)) 1))
-    (near (and (= (bitn x (- (expo x) n)) 1)
-               (or (not (exactp x (1+ n)))
-                   (= (bitn x (- (1+ (expo x)) n)) 1))))
-    ((inf away) (not (exactp x n)))
-    (otherwise nil)))
-
-(local
- (defthm exactp-preserved-up ; could perhaps manage with exactp-<= instead
-   (implies (and (integerp n)
-                 (< 0 n)
-                 (exactp x n))
-            (exactp x (1+ n)))
-   :hints (("Goal" :in-theory (enable exactp)
-            :expand ((expt 2 n))))))
-
-(local (include-book "merge"))
-
-(local
- (defthm roundup-thm-1
-   (implies (and (rounding-mode-p mode)
-                 (not (eq mode 'near))
-                 (not (eq mode 'near+))
-                 (integerp n)
-                 (> n 1)
-                 (integerp x)
-                 (> x 0)
-                 (>= (expo x) n))
-            (= (rnd x mode n)
-               (if (roundup x mode n)
-                   (fp+ (trunc x n) n)
-                 (trunc x n))))
-   :hints (("Goal"  :in-theory (enable inf minf rnd rounding-mode-p
-                                       ieee-mode-p)
-            :use (trunc-away trunc-exactp-a away-exactp-a)))))
-
-(local (include-book "bits-trunc"))
-
-(local
- (defthm roundup-thm-2-1-1-1
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                        0))
-            (equal (trunc x n)
-                   (trunc x (1- n))))
-   :hints (("Goal" :use ((:instance bits-trunc-2 (k n)
-                                    (n (1+ (expo x))))
-                         (:instance bits-trunc-2 (k (1- n))
-                                    (n (1+ (expo x))))
-                         (:instance bits-plus-bitn (n (expo x))
-                                    (m (+ 1 (expo x) (* -1 n)))))
-            :expand ((expt 2 (+ 2 (expo x) (* -1 n))))))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-1-1
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                        0))
-            (exactp (trunc x n) (1- n)))
-   :hints (("Goal" :use roundup-thm-2-1-1-1))))
-
-(local
- (defthm roundup-thm-2-1-2
-   (implies (and (not (exactp x n))
-                 (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (exactp x (+ 1 n)))
-            (equal (+ x (expt 2 (+ (expo x) (* -1 n))))
-                   (+ (trunc x n)
-                      (expt 2 (1+ (+ (expo x) (* -1 n)))))))
-   :hints (("Goal" :use trunc-away-a
-            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-1
-   (implies (and (not (exactp x n))
-                 (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (exactp x (+ 1 n))
-                 (not (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                             1)))
-            (equal (trunc (+ x (expt 2 (+ (expo x) (* -1 n))))
-                          (1- n))
-                   (trunc x n)))
-   :hints (("Goal" :in-theory (enable plus-trunc-corollary
-                                      expt-strong-monotone)
-            :use roundup-thm-2-1-2))))
-
-(local
- (defthm roundup-thm-2-2
-   (implies (and (not (exactp x n))
-                 (exactp x (+ 1 n))
-                 (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x)))
-            (equal (bitn x (+ (expo x) (* -1 n)))
-                   1))
-   :hints (("Goal" :use ((:instance exact-k+1
-                                    (n (1+ (expo x)))
-                                    (k (+ (expo x) (* -1 n)))))))))
-
-(local
- (encapsulate
-  ()
-
-  (local
-   (defthm roundup-thm-2-3-1-1-1
-     (implies (and (not (exactp x n))
-                   (exactp x (+ 1 n))
-                   (integerp n)
-                   (< 1 n)
-                   (integerp x)
-                   (< 0 x)
-                   (<= n (expo x))
-                   (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                          1))
-              (equal (bits x (expo x)
-                           (+ 1 (expo x) (* -1 n)))
-                     (+ 1
-                        (* 2
-                           (bits x (expo x)
-                                 (+ 2 (expo x) (* -1 n)))))))
-     :hints (("Goal" :use ((:instance bits-plus-bitn (n (expo x))
-                                      (m (+ 1 (expo x) (* -1 n)))))))))
-
-  (defthm roundup-thm-2-3-1-1
-    (implies (and (not (exactp x n))
-                  (exactp x (+ 1 n))
-                  (integerp n)
-                  (< 1 n)
-                  (integerp x)
-                  (< 0 x)
-                  (<= n (expo x))
-                  (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                         1))
-             (equal x
-                    (+ (trunc x (1- n))
-                       (expt 2 (+ (expo x) (* -1 n)))
-                       (expt 2 (+ 1 (expo x) (* -1 n))))))
-    :hints (("Goal"
-             :use ((:instance bits-trunc-2 (n (1+ (expo x)))
-                              (k (1+ n)))
-                   (:instance bits-plus-bitn (n (expo x))
-                              (m (+ (expo x) (* -1 n))))
-                   (:instance bits-plus-bitn (n (expo x))
-                              (m (+ 1 (expo x) (* -1 n))))
-                   (:instance bits-trunc-2 (n (1+ (expo x)))
-                              (k (1- n))))
-             :expand
-             ((expt 2 (+ 2 (expo x) (* -1 n)))))
-            ;; BOZO!! We can't put the following as part of Goal's :expand hint.
-            ("Subgoal 4" :expand ((expt 2 (+ 1 (expo x) (* -1 n)))))
-            ("Subgoal 1" :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
-    :rule-classes nil)))
-
-(local
- (defthm roundup-thm-2-3-1-2
-   (implies (and (not (exactp x n))
-                 (exactp x (+ 1 n))
-                 (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                        1))
-            (equal (+ x (expt 2 (+ (expo x) (* -1 n))))
-                   (+ (trunc x (1- n))
-                      (expt 2 (+ 2 (expo x) (* -1 n))))))
-   :hints (("Goal" :use roundup-thm-2-3-1-1
-            :expand ((expt 2 (+ 2 (expo x) (* -1 n)))))
-           ("Subgoal 1" ; !! BOZO: avoid infinite by using separate subgoal hint
-            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-3-1
-   (implies (and (not (exactp x n))
-                 (exactp x (+ 1 n))
-                 (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                        1))
-            (exactp (+ x (expt 2 (+ (expo x) (* -1 n))))
-                    (1- n)))
-   :hints (("Goal" :use (roundup-thm-2-3-1-1
-                         roundup-thm-2-3-1-2
-                         (:instance fp+1
-                                    (x (trunc x (1- n)))
-                                    (n (1- n))))))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-3-2
-   (implies (and (not (exactp x n))
-                 (exactp x (+ 1 n))
-                 (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                        1))
-            (equal (+ (trunc x n)
-                      (expt 2 (+ 1 (expo x) (* -1 n))))
-                   (+ x (expt 2 (+ (expo x) (* -1 n))))))
-   :hints (("Goal" :use trunc-away-a
-            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-3
-   (implies (and (not (exactp x n))
-                 (exactp x (+ 1 n))
-                 (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
-                        1))
-            (equal (trunc (+ x (expt 2 (+ (expo x) (* -1 n))))
-                          (1- n))
-                   (+ (trunc x n)
-                      (expt 2 (+ 1 (expo x) (* -1 n))))))
-   :hints (("Goal" :use (roundup-thm-2-3-1
-                         roundup-thm-2-3-2
-                         (:instance trunc-exactp-a
-                                    (x (+ x (expt 2 (+ (expo x) (* -1 n)))))
-                                    (n (1- n))))))))
-
-; We need a special case of the following lemma for roundup-thm-2-4, so let's
-; prove a nice version to include in the library.
-
-(defthmd trunc-split
-  (implies (and (= n (1+ (expo x)))
-                (>= x 0)
-                (integerp m)
-                (> m k)
-                (integerp k)
-                (> k 0))
-           (equal (trunc x m)
-                  (+ (trunc x k)
-                     (* (expt 2 (- n m))
-                        (bits x (1- (- n k)) (- n m))))))
-  :hints (("Goal" :use ((:instance expt-split (r 2)
-                                   (i (+ m (* -1 k)))
-                                   (j (+ 1 (expo x) (* -1 m))))
-                        bits-trunc-2
-                        (:instance bits-trunc-2 (k m)
-                                   (n (1+ (expo x))))
-                        (:instance bits-plus-bits (n (expo x))
-                                   (m (- (1+ (expo x)) m))
-                                   (p (- (1+ (expo x)) k)))))))
-
-(defund trunc-rem (x n)
-  (- x (trunc x n)))
-
-(defthm trunc-rem-small
-  (implies (and (integerp n)
-                (<= 0 n)
-                (rationalp x)
-                (<= 0 x))
-           (< (trunc-rem x n)
-              (expt 2 (+ 1 (expo x) (* -1 n)))))
-  :hints (("Goal" :use (trunc-diff-pos trunc-rem)))
-  :rule-classes :linear)
-
-(defthm trunc-rem-nonnegative
-  (implies (and (integerp n)
-                (<= 0 n)
-                (rationalp x)
-                (<= 0 x))
-           (and (rationalp (trunc-rem x n))
-                (<= 0 (trunc-rem x n))))
-  :hints (("Goal" :use (trunc-lower-pos trunc-rem)))
-  :rule-classes :type-prescription)
-
-; First, break x into the high n bits, the next bit, and the rest.
-
-(local
- (defthm roundup-thm-2-4-1
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ (expo x) (* -1 n)))
-                        1))
-            (equal x
-                   (+ (trunc x n)
-                      (expt 2 (- (expo x) n))
-                      (trunc-rem x (1+ n)))))
-   :hints (("Goal" :use ((:instance trunc-split
-                                    (n (1+ (expo x)))
-                                    (m (1+ n))
-                                    (k n)))
-            :in-theory (enable trunc-rem bitn)))
-   :rule-classes nil))
-
-; Next, trivially introduce fp+.  A key fact is that (exactp (fp+ (trunc x n)
-; n) n), by fp+1 and trunc-exact-b.  We need that fact in order to apply
-; plus-trunc-corollary.
-
-(local
- (defthm roundup-thm-2-4-2
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ (expo x) (* -1 n)))
-                        1))
-            (equal (+ x (expt 2 (+ (expo x) (* -1 n))))
-                   (+ (fp+ (trunc x n) n)
-                      (trunc-rem x (1+ n)))))
-   :hints (("Goal" :use (roundup-thm-2-4-1)
-            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
-   :rule-classes nil))
-
-(local
- (defthm expt-2-+-constant
-   (implies (and (syntaxp (quotep k))
-                 (integerp n)
-                 (<= 0 n)
-                 (integerp k)
-                 (<= 0 k))
-            (equal (expt 2 (+ k n))
-                   (* 2 (expt 2 (+ (1- k) n)))))
-   :hints (("Goal" :expand ((expt 2 (+ k n)))))))
-
-; Note: fp+-positive was first discovered at about this point.
-
-(local
- (defthm roundup-thm-2-4-3
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ (expo x) (* -1 n)))
-                        1))
-            (equal (trunc (+ (fp+ (trunc x n) n)
-                             (trunc-rem x (1+ n)))
-                          n)
-                   (fp+ (trunc x n) n)))
-   :hints (("Goal" :use ((:instance fp+1 (x (trunc x n)))
-                         (:instance plus-trunc-corollary
-                                    (x (fp+ (trunc x n) n))
-                                    (y (trunc-rem x (1+ n))))
-                         (:instance trunc-rem-small (n (1+ n)))
-                         (:instance fp+1-2 (x (trunc x n))))
-            :in-theory (disable fp+ plus-trunc-corollary)))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-4
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ (expo x) (* -1 n)))
-                        1))
-            (equal (trunc (+ x (expt 2 (+ (expo x) (* -1 n))))
-                          n)
-                   (+ (trunc x n)
-                      (expt 2 (+ 1 (expo x) (* -1 n))))))
-   :hints (("Goal" :use (roundup-thm-2-4-2 roundup-thm-2-4-3)))))
-
-(local
- (defthm roundup-thm-2-5-1
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ (expo x) (* -1 n)))
-                        0))
-            (equal x
-                   (+ (trunc x n)
-                      (trunc-rem x (1+ n)))))
-   :hints (("Goal" :use ((:instance trunc-split
-                                    (n (1+ (expo x)))
-                                    (m (1+ n))
-                                    (k n)))
-            :in-theory (enable trunc-rem bitn)))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-5-2
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (equal (bitn x (+ (expo x) (* -1 n)))
-                        0))
-            (equal (+ x (expt 2 (+ (expo x) (* -1 n))))
-                   (+ (trunc x n)
-                      (expt 2 (+ (expo x) (* -1 n)))
-                      (trunc-rem x (1+ n)))))
-   :hints (("Goal" :use (roundup-thm-2-5-1)
-            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-5-3
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x)))
-            (< (+ (expt 2 (+ (expo x) (* -1 n)))
-                  (trunc-rem x (1+ n)))
-               (expt 2 (+ 1 (expo x) (* -1 n)))))
-   :hints (("Goal" :expand ((expt 2 (+ 1 (expo x) (* -1 n))))
-            :use ((:instance trunc-rem-small (n (1+ n))))))
-   :rule-classes nil))
-
-(local
- (defthm roundup-thm-2-5
-   (implies (and (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x))
-                 (not (equal (bitn x (+ (expo x) (* -1 n)))
-                             1)))
-            (equal (trunc (+ x (expt 2 (+ (expo x) (* -1 n))))
-                          n)
-                   (trunc x n)))
-   :hints (("Goal" :use ((:instance plus-trunc-corollary
-                                    (x (trunc x n))
-                                    (y (+ (trunc-rem x (+ 1 n))
-                                          (expt 2 (+ (expo x) (* -1 n))))))
-                         roundup-thm-2-5-2
-                         roundup-thm-2-5-3)
-            :in-theory (disable fp+ plus-trunc-corollary)))))
-
-(local
- (defthm roundup-thm-2-6
-   (implies (and (exactp x n)
-                 (integerp n)
-                 (< 1 n)
-                 (integerp x)
-                 (< 0 x)
-                 (<= n (expo x)))
-            (equal (bitn x (+ (expo x) (* -1 n)))
-                   0))
-   :hints (("Goal" :use ((:instance exact-bits-1
-                                    (n (1+ (expo x)))
-                                    (k (- (1+ (expo x)) n)))
-                         (:instance exact-bits-3
-                                    (k (- (1+ (expo x)) n))))))))
-
-(local
- (defthm roundup-thm-2
-   (implies (and (eq mode 'near)
-                 (integerp n)
-                 (> n 1)
-                 (integerp x)
-                 (> x 0)
-                 (>= (expo x) n))
-            (= (rnd x mode n)
-               (if (roundup x mode n)
-                   (fp+ (trunc x n) n)
-                 (trunc x n))))
-   :hints (("Goal"  :in-theory (enable rnd)
-            :use (near-exactp-a rnd-const-thm-1)))
-   :rule-classes ()))
-
-(local
- (defthm roundup-thm-3
-   (implies (and (eq mode 'near+)
-                 (integerp n)
-                 (> n 1)
-                 (integerp x)
-                 (> x 0)
-                 (>= (expo x) n))
-            (= (rnd x mode n)
-               (if (roundup x mode n)
-                   (fp+ (trunc x n) n)
-                 (trunc x n))))
-   :hints (("Goal"  :in-theory (enable rnd)
-            :use near+trunc))
-   :rule-classes ()))
-
-(defthm roundup-thm
-    (implies (and (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 1)
-		  (integerp x)
-		  (> x 0)
-		  (>= (expo x) n))
-	     (= (rnd x mode n)
-                (if (roundup x mode n)
-                    (fp+ (trunc x n) n)
-                  (trunc x n))))
-  :hints (("Goal"  :in-theory (enable rounding-mode-p)
-           :use (roundup-thm-1
-                 roundup-thm-2
-                 roundup-thm-3)))
-  :rule-classes ())
-
-;rephrase?
-(defthmd rnd-sticky
-  (implies (and (> n (1+ k))
-                (rounding-mode-p mode)
-                (rationalp x) (> x 0)
-                (integerp k) (> k 0)
-                (integerp n) )
-           (equal (rnd (sticky x n) mode k)
-                  (rnd x mode k)))
-  :hints (("Goal" :in-theory (enable rnd minf inf)
-           :use (sticky-pos
-                 (:instance trunc-sticky (m k))
-                 (:instance away-sticky (m k))
-                 (:instance near-sticky (m k))
-                 (:instance near+-sticky (m k))))))
-
-(defthm rnd-shift
-  (implies (and (rationalp x)
-                (integerp n)
-                (rounding-mode-p mode)
-                (integerp k))
-           (= (rnd (* x (expt 2 k)) mode n)
-              (* (rnd x mode n) (expt 2 k))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable rnd IEEE-MODE-P
-                                     rounding-mode-p)
-           :use (trunc-shift
-                 away-shift
-                 near-shift
-                 near+-shift
-                 inf-shift
-                 minf-shift
-                 ))))
-;elim <-- why?
-(defthm expo-rnd
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0)
-		  (rounding-mode-p mode)
-		  (not (= (abs (rnd x mode n))
-			  (expt 2 (1+ (expo x))))))
-	     (= (expo (rnd x mode n))
-		(expo x)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable rounding-mode-p
-                                     ieee-mode-p near near+ rnd minf inf)
-		  :use (expo-trunc expo-away))))
-
-;better rule-classes?
-(defthm rnd-pos
-  (implies (and (< 0 x)
-                (rationalp x)
-                (integerp n)
-                (> n 0)
-                (rounding-mode-p mode))
-           (> (rnd x mode n) 0))
-  :rule-classes (:type-prescription)
-  :hints (("goal" :in-theory (enable rounding-mode-p ieee-mode-p near rnd inf minf)
-           :use ())))
-
-(defthm rnd-0
-  (equal (rnd 0 mode n) 
-         0)
-  :hints (("Goal" :in-theory (enable rnd rounding-mode-p ieee-mode-p inf minf)
-           :use (trunc-0 away-0))))
-
-;better rule-classes?
-(defthm rnd-neg
-  (implies (and (< x 0)
-                (rationalp x)
-                (integerp n)
-                (> n 0)
-                (rounding-mode-p mode))
-           (< (rnd x mode n) 0))
-  :rule-classes (:type-prescription)
-  :hints (("Goal" :in-theory (enable rnd rounding-mode-p ieee-mode-p inf minf)
-           :use (
-                 near-neg))))
-
-;would like to not open minf, inf here?
-(defthm rnd-non-pos
-  (implies (<= x 0)
-           (<= (rnd x mode n) 0))
-  :hints (("goal" :in-theory (enable rnd near+ inf minf)))
-  :rule-classes (:rewrite :type-prescription :linear))
-
-;would like to not open minf, inf here?
-;add to lib?
-(defthm rnd-non-neg
-  (implies (<= 0 x)
-           (<= 0 (rnd x mode n)))
-  :hints (("goal" :in-theory (enable rnd near+ inf minf)))
-  :rule-classes (:rewrite :type-prescription :linear))
-
-(defthm sgn-rnd
-  (implies (and; (rationalp x)
-                (rounding-mode-p mode)
-                (integerp n)
-                (> n 0)
-                )
-           (equal (sgn (rnd x mode n))
-                  (sgn x)))
-  :hints (("Goal" :in-theory (enable ieee-mode-p rounding-mode-p rnd near+ inf minf) 
-           :use (sgn-trunc
-                 sgn-away
-                 sgn-near-2))))
-
-;enable?
-(defthmd rnd-exactp-a
-  (implies (and (rationalp x)
-                (rounding-mode-p mode)
-                (integerp n) 
-                (> n 0))
-           (equal (equal x (rnd x mode n))
-                  (exactp x n)))
-  :hints (("Goal" :in-theory (enable ieee-mode-p rounding-mode-p rnd near+ minf inf)
-           :use (near-exactp-a
-                 trunc-exactp-a
-                 away-exactp-a))))
-
-(defthm rnd-exactp-b
-    (implies (< 0 n)
-	     (exactp (rnd x mode n) n))
-  :hints (("Goal" :in-theory (enable rnd near+ minf inf))))
-
-(defthm rnd-exactp-c
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (>= a x))
-	     (>= a (rnd x mode n)))
-  :hints (("Goal" :in-theory (enable ieee-mode-p rnd minf inf)
-		  :use (near-exactp-c
-			away-exactp-c
-			trunc-upper-pos))))
-
-(defthm rnd-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (rnd x mode n)))
-  :hints (("Goal" :in-theory (enable ieee-mode-p rounding-mode-p rnd minf inf)
-		  :use (near-exactp-c
-			trunc-exactp-c
-			away-lower-pos))))
-
-
-(defthm rnd<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0))
-	     (<= (rnd x mode n) (away x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable ieee-mode-p rnd minf inf)
-		  :use (trunc-upper-pos
-			away-lower-pos
-			near-choice))))
-
-(defthm rnd>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0))
-	     (>= (rnd x mode n) (trunc x n)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable ieee-mode-p rounding-mode-p rnd minf inf)
-		  :use (trunc-upper-pos
-			away-lower-pos
-			near-choice))))
-
-(defthm rnd-monotone
-    (implies (and (<= x y)
-                  (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (rounding-mode-p mode)
-		  (integerp n)
-		  (> n 0))
-	     (<= (rnd x mode n) (rnd y mode n)))
-  :hints (("Goal" :in-theory (enable ieee-mode-p rnd minf inf)
-		  :use (trunc-monotone
-			away-monotone
-			near-monotone))))
-
-(defthm exactp-rnd
-  (implies (and (rationalp x)
-                (rounding-mode-p mode)
-                (integerp n)
-                (> n 0))
-           (exactp (rnd x mode n) n))
-  :hints (("Goal" :in-theory (enable ieee-mode-p rounding-mode-p rnd inf minf))))
-
-(defthm rnd-choice
-  (implies (rounding-mode-p mode)
-           (or (equal (rnd x mode n) (rnd x 'away n))
-               (equal (rnd x mode n) (rnd x 'trunc n))))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable rnd near+ inf minf near rounding-mode-p ieee-mode-p)
-                              '(re evenp))))
-  :rule-classes nil)
-
-(defthm ieee-mode-p-flip
-    (implies (ieee-mode-p m)
-	     (ieee-mode-p (flip m)))
-    :hints (("Goal" :in-theory (enable ieee-mode-p flip))))
-
-(defthm rounding-mode-p-flip
-    (implies (rounding-mode-p m)
-	     (rounding-mode-p (flip m)))
-    :hints (("Goal" :in-theory (enable ieee-mode-p flip))))
-
-
-(defthm expo-rnd-bnd
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0)
-		  (rounding-mode-p mode))
-	     (>= (expo (rnd x mode n))
-		 (expo x)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable expo-minus)
-           :use (expo-rnd
-			(:instance expo-minus (x (rnd x mode n)))))))
-
-(defthm plus-inf
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (rationalp y)
-		  (>= y 0)
-		  (integerp k)
-		  (exactp x (+ k (- (expo x) (expo y)))))
-	     (= (+ x (inf y k))
-		(inf (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable inf)
-           :use plus-away)))
-
-(defthm plus-minf
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (rationalp y)
-		  (>= y 0)
-		  (integerp k)
-		  (exactp x (+ k (- (expo x) (expo y)))))
-	     (= (+ x (minf y k))
-		(minf (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable minf)
-           :use plus-trunc)))
-
-;make alt form too?
-; add to lib?
-(defthm plus-rnd
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ -1 k (- (expo x) (expo y))))
-                (rounding-mode-p mode))
-           (= (+ x (rnd y mode k))
-              (rnd (+ x y)
-                   mode
-                   (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes nil
-  :hints (("Goal" :in-theory (enable rnd ieee-mode-p ROUNDING-MODE-P) 
-           :use (plus-near
-                 plus-near+
-                 plus-away
-                 plus-trunc 
-                 plus-minf 
-                 plus-inf
-                 (:instance exactp-<= (m (+ -1 k (- (expo x) (expo y))))
-                            (n (+  k (- (expo x) (expo y)))))))))
-
-(defthm rnd-rarely-zero
-  (implies (and (rationalp x)
-                (integerp k)
-                (case-split (< 0 k))
-                (case-split (rounding-mode-p mode)))
-           (equal (equal (rnd x mode k) 0)
-                  (equal x 0)
-           ))
-  :hints (("Goal" :in-theory (enable rnd near+ minf inf near ROUNDING-MODE-P ieee-mode-p))))
-
-;add to lib?
-(defthm flip-flip
-  (equal (flip (flip mode))
-         mode)
-  :hints (("Goal" :in-theory (enable flip))))
-
-;add to lib?
-(defthm inf-lower-bound
-  (implies (and (rationalp x)
-                (integerp n))
-           (>= (inf x n) x))
-  :hints (("Goal" :in-theory (enable inf)
-           :use trunc-upper-bound))
-  :rule-classes (:rewrite :linear))
-
-;add to lib?
-(defthm minf-upper-bound
-  (implies (and (rationalp x)
-                (integerp n))
-           (<= (minf x n) x))
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable minf)
-                              '(abs-away))
-           :use away-lower-bound))
-  :rule-classes (:rewrite :linear))
-
-
-;add to lib?
-(defthm rnd-diff
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0)
-                (rounding-mode-p mode))
-           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n))))
-  :hints (("Goal" :in-theory (enable rnd near near+ inf minf ieee-mode-p rounding-mode-p)
-           :use (trunc-diff away-diff))))
diff -Nru acl2-6.2/books/rtl/rel5/support/rom-helpers.lisp acl2-6.3/books/rtl/rel5/support/rom-helpers.lisp
--- acl2-6.2/books/rtl/rel5/support/rom-helpers.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/rom-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,38 +0,0 @@
-(in-package "ACL2")
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-(local (in-theory (enable bvecp)))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defun check-array (name a dim1 dim2)
-  (if (zp dim1)
-      t
-    (and (bvecp (aref1 name a (1- dim1)) dim2)
-	 (check-array name a (1- dim1) dim2))))
-
-(defthm check-array-lemma-1
-    (implies (and (not (zp dim1))
-		  (check-array name a dim1 dim2)
-		  (natp i)
-		  (< i dim1))
-	     (bvecp (aref1 name a i) dim2))
-  :rule-classes ())
-
-(defthm check-array-lemma
-    (implies (and (bvecp i n)
-		  (not (zp (expt 2 n)))
-		  (check-array name a (expt 2 n) dim2))		  
-	     (bvecp (aref1 name a i) dim2))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance check-array-lemma-1 (dim1 (expt 2 n)))))))
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/round-extra.lisp acl2-6.3/books/rtl/rel5/support/round-extra.lisp
--- acl2-6.2/books/rtl/rel5/support/round-extra.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/round-extra.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,263 +0,0 @@
-(in-package "ACL2")
-
-; This book was originally certified (in some directory, probably not support/)
-; starting with:
-
-; (include-book "rtl/rel4/lib/top" :dir :system)
-
-; Then that form was replaced by the forms below, up through the form (local
-; (in-theory (theory 'lib-top1))).  See the comments at the top of
-; fadd-extra.lisp for further explanation of how to extend the library.
-
-(include-book "sticky") ; needed for some definitions
-(include-book "util")   ; needed for definition of local-defthm
-
-; Now put ourselves in what amounts to the environment of ../lib/top, as
-; explained above.
-(local (include-book "top1"))
-(local (in-theory (theory 'lib-top1)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; sticky-monotone
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; Here is David Russinoff's proof outline for sticky-monotone.
-
-; Proof:
-; 
-; By sticky-pos, sticky-0, and sticky-minus, we may assume x > 0.
-; 
-; By expo-sticky, we nay assume expo(x) = expo(y).
-; 
-; By trunc-monotone and the definition of sticky, we nay assume that
-; y is (n-1)-exact and x is not (n-1)-exact.
-; 
-; By fp+2, since y > x > trunc(x,n-1), 
-; 
-;   sticky(y,n) = y 
-;              >= fp+(trunc(x,n-1),n-1)
-;               = trunc(x,n-1) + 2^(expo(trunc(x,n-1)) + 1 - (n-1))
-;               > trunc(x,n-1) + 2^(expo(trunc(x,n-1)) + 1 - n)
-;               = trunc(x,n-1) + 2^(expo(x) + 1 - n)
-;               = sticky(x,n).
-
-; [end of proof outline for sticky-monotone]
-
-(local-defthm main-1
-  (implies (and (<= x y)
-                (< 0 x)
-                (equal (expo x) (expo y))
-                (exactp y (1- n))
-                (not (exactp x (1- n)))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 1))
-           (>= y (fp+ (trunc x (1- n)) (1- n))))
-  :hints (("Goal" :use ((:instance fp+2
-                                   (y y)
-                                   (x (trunc x (1- n)))
-                                   (n (1- n))))
-           :in-theory (enable trunc-upper-pos)))
-  :rule-classes nil)
-
-(local-defthm main-2
-  (implies (and (<= x y)
-                (< 0 x)
-                (equal (expo x) (expo y))
-                (exactp y (1- n))
-                (not (exactp x (1- n)))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 1))
-           (> (fp+ (trunc x (1- n)) (1- n))
-              (+ (trunc x (1- n))
-                 (expt 2 (+ (expo (trunc x (1- n)))
-                            1
-                            (- n))))))
-  :hints (("Goal" :use ((:instance expt-strong-monotone
-                                   (n (+ 1 (expo x) (* -1 n)))
-                                   (m (+ 2 (expo x) (* -1 n)))))))
-  :rule-classes nil)
-
-(local-defthm main
-  (implies (and (<= x y)
-                (< 0 x)
-                (equal (expo x) (expo y))
-                (exactp y (1- n))
-                (not (exactp x (1- n)))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 1))
-           (>= y (sticky x n)))
-  :hints (("Goal" :use (main-1 main-2)
-           :in-theory (enable sgn)
-           :expand ((sticky x n))))
-  :rule-classes nil)
-
-(local-defthm sticky-monotone-pos-main-1
-  (implies (and (<= x y)
-                (< 0 x)
-                (equal (expo x) (expo y))
-                (exactp y (1- n))
-                (not (exactp x (1- n)))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 1))
-           (<= (sticky x n) (sticky y n)))
-  :hints (("Goal" :use main
-           :expand ((sticky y n))))
-  :rule-classes nil)
-
-(local-defthm sticky-monotone-pos-main-2
-  (implies (and (<= x y)
-                (< 0 x)
-                (equal (expo x) (expo y))
-                (not (exactp y (1- n)))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 1))
-           (<= (sticky x n) (sticky y n)))
-  :hints (("Goal" :in-theory (enable sticky sgn)
-           :use ((:instance trunc-monotone (n (1- n)))
-                 (:instance trunc-exactp-a (x x) (n (1- n))))))
-  :rule-classes nil)
-
-(local-defthm sticky-monotone-pos-main-3
-  (implies (and (<= x y)
-                (< 0 x)
-                (equal (expo x) (expo y))
-                (exactp x (1- n))
-                (exactp y (1- n))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 1))
-           (<= (sticky x n) (sticky y n)))
-  :hints (("Goal" :in-theory (enable sticky)))
-  :rule-classes nil)
-
-(defthm sticky-monotone-pos-main-n=1
-  (implies (and (<= x y)
-                (< 0 x)
-                (equal (expo x) (expo y))
-                (rationalp x)
-                (rationalp y))
-           (<= (sticky x 1) (sticky y 1)))
-  :hints (("Goal" :expand ((sticky x 1) (sticky y 1))
-           :in-theory (enable sgn)))
-  :rule-classes nil)
-
-(local-defthm sticky-monotone-pos-main
-  (implies (and (<= x y)
-                (< 0 x)
-                (equal (expo x) (expo y))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0))
-           (<= (sticky x n) (sticky y n)))
-  :hints (("Goal" :use (sticky-monotone-pos-main-1
-                        sticky-monotone-pos-main-2
-                        sticky-monotone-pos-main-3
-                        sticky-monotone-pos-main-n=1)
-           :in-theory (enable sgn)))
-  :rule-classes nil)
-
-(local-defthm sticky-monotone-pos-main-alt-1
-  (implies (and (<= x y)
-                (< 0 x)
-                (< (expo x) (expo y))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0))
-           (< (expo (sticky x n)) (expo (sticky y n))))
-  :hints (("Goal" :use ((:instance expo-sticky (x x))
-                        (:instance expo-sticky (x y)))))
-  :rule-classes nil)
-
-(local-defthm sticky-monotone-pos-main-alt
-  (implies (and (<= x y)
-                (< 0 x)
-                (< (expo x) (expo y))
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0))
-           (<= (sticky x n) (sticky y n)))
-  :hints (("Goal" :use (sticky-monotone-pos-main-alt-1
-                        (:instance expo-monotone
-                                   (x (sticky y n))
-                                   (y (sticky x n))))
-
-           :in-theory (enable sticky-pos)))
-  :rule-classes nil)
-
-(local-defthm sticky-monotone-pos
-  (implies (and (<= x y)
-                (< 0 x)
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0))
-           (<= (sticky x n) (sticky y n)))
-  :hints (("Goal" :use (sticky-monotone-pos-main
-                        sticky-monotone-pos-main-alt
-                        expo-monotone)))
-  :rule-classes nil)
-
-(local-defthm sticky-monotone-neg
-  (implies (and (<= x y)
-                (< y 0)
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0))
-           (<= (sticky x n) (sticky y n)))
-  :hints (("Goal" :use ((:instance sticky-monotone-pos
-                                   (x (- y))
-                                   (y (- x))))
-           :in-theory (enable sticky-minus)))
-  :rule-classes nil)
-
-(local-defthm sticky-nonneg-type-prescription
-  (implies (and (<= 0 x)
-                (rationalp x)
-                (integerp n)
-                (> n 0))
-           (and (rationalp (sticky x n))
-                (>= (sticky x n) 0)))
-  :hints (("Goal" :in-theory (enable sticky-pos)
-           :use ((:theorem (implies (and (<= 0 x)
-                                         (rationalp x))
-                                    (or (equal x 0)
-                                        (< 0 x)))))))
-  :rule-classes :type-prescription)
-
-(local-defthm sticky-nonpos-type-prescription
-  (implies (and (<= x 0)
-                (rationalp x)
-                (integerp n)
-                (> n 0))
-           (and (rationalp (sticky x n))
-                (<= (sticky x n) 0)))
-  :hints (("Goal" :use ((:instance sticky-nonneg-type-prescription
-                                   (x (- x))))
-           :in-theory (enable sticky-minus)))
-  :rule-classes :type-prescription)
-
-(defthmd sticky-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (> n 0))
-           (<= (sticky x n) (sticky y n)))
-  :hints (("Goal" :use (sticky-monotone-pos
-                        sticky-monotone-neg)))
-  :rule-classes :linear)
diff -Nru acl2-6.2/books/rtl/rel5/support/rtl.lisp acl2-6.3/books/rtl/rel5/support/rtl.lisp
--- acl2-6.2/books/rtl/rel5/support/rtl.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/rtl.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,594 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-The file deals with the RTL primitives, as well as natp, bvecp, unknown, unknown2, reset, and reset2.
-
-Keep this file roughly in sync with Rob's version of rtl.lisp, currently:
-/u/acl2/translator/linux27/lisp/model2-c/rtl.lisp
-
-Most of the functions introduced are disabled.
-
-!! add god type-prescription rules!
-
-|#
-
-(include-book "ground-zero")
-(include-book "rtlarr") ;includes the defn of bvecp
-(include-book "cat-def")
-
-;;Definitions of the ACL2 functions that are used in the
-;;formalization of the RTL semantics
-
-;leave enabled
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-
-;; 1. bit-vector constants
-
-(defmacro n! (i n)
-  (declare (ignore n)
-           (xargs :guard (and (natp i)
-                              (natp n)
-                              (bvecp i n))))
-  i)
-
-;; 2. equality comparison
-
-(defund log= (x y)
-  (declare (xargs :guard t))
-  (if (equal x y) 1 0))
-
-(defund log<> (x y)
-  (declare (xargs :guard t))
-  (if (equal x y) 0 1))
-
-
-;; 3. unsigned inequalities
-
-(defund log< (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (< x y) 1 0))
-
-(defund log<= (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (<= x y) 1 0))
-
-(defund log> (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (> x y) 1 0))
-
-(defund log>= (x y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y))))
-  (if (>= x y) 1 0))
-
-
-;; 4. signed inequalities
-
-;; The following function is not generated by translate-rtl, it is only needed
-;; for the definitions of comp2<, comp2<=, etc.
-(defund comp2 (x n)
-  (declare (xargs :guard (and (rationalp x) (integerp n))))
-  (if (< x (expt 2 (1- n)))
-      x
-    (- (- (expt 2 n) x))))
-
-(defund comp2< (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))
-                  :guard-hints (("goal" :in-theory (enable COMP2)))))
-  (log< (comp2 x n) (comp2 y n)))
-
-(defund comp2<= (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))
-                  :guard-hints (("goal" :in-theory (enable COMP2)))))
-  (log<= (comp2 x n) (comp2 y n)))
-
-(defund comp2> (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))
-                  :guard-hints (("goal" :in-theory (enable COMP2)))))
-  (log> (comp2 x n) (comp2 y n)))
-
-(defund comp2>= (x y n)
-  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))
-                  :guard-hints (("goal" :in-theory (enable COMP2)))))
-  (log>= (comp2 x n) (comp2 y n)))
-
- 
-;; 5. unary logical operations
-
-(defund logand1 (x n)
-  (declare (xargs :guard (integerp n)))
-  (log= x (1- (expt 2 n))))
-
-(defund logior1 (x)
-  (declare (xargs :guard t))
-  (if (equal x 0) 0 1))
-
-(defund logxor1 (src)
-  (declare (xargs :guard (integerp src)))
-  (if (oddp (logcount src)) 1 0))
-
-
-;; 6. bit-vector shifting operations
-
-;; The following function will not be seen in the output from translate-rtl, it
-;; is only provided here to define shft.
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-#|
-(defun shft (x s l)
-  (mod (fl (* (expt 2 s) x)) (expt 2 l)))
-|#
-
-;; The following function will not be seen in the output from translate-rtl, it
-;; is only provided here to define lshft and rshft.
-(defund shft (x s l)
-  (declare (xargs :guard (and (integerp s) (rationalp x))))
-  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
-
-(defmacro lshft (x s l)
-  `(shft ,x ,s ,l))
-
-(defmacro rshft (x s l)
-  `(shft ,x (- ,s) ,l))
-
-
-;; 7. concatenation operations
-
-;drop? and add cat?
-(defund ocat (x y n)
-  (declare (xargs :guard t))
-  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
-
-#|
-(defund omulcat (l n x)
-  (declare (xargs :guard t))
-  (if (and (integerp n) (> n 0))
-      (ocat (omulcat l (1- n) x)
-	   x
-	   l)
-    0))
-|#
-
-(defund mulcat (l n x)
-
-; We introduce mbe not because we want particularly fast execution, but because
-; the existing logic definition does not satisfy the guard of cat, which can't
-; be changed because of the guard of bits.
-
-  (declare (xargs :guard (and (integerp l)
-                              (< 0 l)
-                              (acl2-numberp n)
-                              (natp x))
-                  :verify-guards nil))
-  (mbe :logic (if (and (integerp n) (> n 0))
-                  (cat (mulcat l (1- n) x)
-                       (* l (1- n))
-                       x
-                       l)
-                0)
-       :exec  (cond
-               ((eql n 1)
-                (bits x (1- l) 0))
-               ((and (integerp n) (> n 0))
-                (cat (mulcat l (1- n) x)
-                     (* l (1- n))
-                     x
-                     l))
-               (t 0))))
-
-
-;; 8. bit-vector access and update
-
-#| old versions:
-(defun bits (x i j)
-  (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-
-(defun bits (x i j)
-  (if (or (not (integerp i))
-          (not (integerp j)))
-      0
-  (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j)))))
-
-(defund bits (x i j)
-  (declare (xargs :guard (rationalp x)))
-  (if (or (not (integerp i))
-          (not (integerp j)))
-      0
-    (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j)))))
-
-(defun bitn (x n)
-  (if (logbitp n x) 1 0))
-
-(defund bitn (x n)
-    (declare (xargs :guard (rationalp x)))
-  (bits x n n))
-
-|#
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))
-                  :verify-guards nil))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-;setbits has a new parameter, w, indicating the size of the expression returned
-;Note: when j is 0, there is not lower part of x, but we have cat-with-n-0 to handle this case. 
-(defund setbits (x w i j y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp i)
-                              (integerp j)
-                              (<= 0 j)
-                              (<= j i)
-                              (integerp w)
-                              (< i w))
-                  :verify-guards nil))
-  (mbe :logic (cat (bits x (1- w) (1+ i))
-                   (+ -1 w (- i))
-                   (cat (bits y (+ i (- j)) 0)
-                        (+ 1 i (- j))
-                        (bits x (1- j) 0)
-                        j)
-                   (1+ i))
-       :exec  (cond ((int= j 0)
-                     (cond ((int= (1+ i) w)
-                            (bits y (+ i (- j)) 0))
-                           (t
-                            (cat (bits x (1- w) (1+ i))
-                                 (+ -1 w (- i))
-                                 (bits y (+ i (- j)) 0)
-                                 (1+ i)))))
-                    ((int= (1+ i) w)
-                     (cat (bits y (+ i (- j)) 0)
-                          (+ 1 i (- j))
-                          (bits x (1- j) 0)
-                          j))
-                    (t
-                     (cat (bits x (1- w) (1+ i))
-                          (+ -1 w (- i))
-                          (cat (bits y (+ i (- j)) 0)
-                               (+ 1 i (- j))
-                               (bits x (1- j) 0)
-                               j)
-                          (1+ i))))))
-
-(defund setbitn (x w n y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (<= 0 n)
-                              (integerp w)
-                              (< n w))
-                  :verify-guards nil))
-  (setbits x w n n y))
-
-
-;; 9. bitwise operations
-
-;; logand, logior, logxor are predefined ACL2 functions
-
-#| old version
-(defun lnot (x n)
-  (1- (- (expt 2 n) x)))
-|#
-
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-
-;; 10. array access and update
-
-;; aref1, aref2, aset1, aset2 are predefined ACL2 functions
-
-;; actually, we now generate ag and as, which are defined in rtlarr.lisp
-;; in the rtl library.
-
-
-
-
-;; 11. arithmetic operations
-
-(defmacro mod+ (x y n)
-  `(bits (+ ,x ,y) (1- ,n) 0))
-
-(defmacro mod* (x y n)
-  `(bits (* ,x ,y) (1- ,n) 0))
-
-#|
-Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
-i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
-about the old defintion of mod-:
-
-(thm
- (implies (and (bvecp x n)
-	       (bvecp y n)
-	       (natp n)
-	       )
-	  (equal (mod- x y n)
-		 (bits (- x y) (1- n) 0)))
-	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
-)
-
-We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
-any behavior we care about.
-
-Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
-get rid of the bits call.
-|#
-
-(defmacro mod- (x y n)
-  `(bits (- ,x ,y) (1- ,n) 0))
-
-
-#| Old definition of mod- :
-
-;; the following function is not generated in the translate-rtl output. It is
-;; only needed to define 'mod-
-(defund comp2-inv (x n)
-  (declare (xargs :guard (and (rationalp x)
-                              (integerp n))))
-  (if (< x 0)
-      (+ x (expt 2 n))
-    x))
-
-(defund mod- (x y n)
-  (declare (xargs :guard (and (rationalp x)
-                              (rationalp y)
-                              (integerp n))))
-  (comp2-inv (- x y) n))
-|#
-
-
-;; NOTE -- the following definition of decode is "flawed". We still need to add
-;; assumptions to "allow" this definition to be used.
-
-(defund decode (x n)
-  (declare (xargs :guard (rationalp n)))
-  (if (and (natp x) (< x n)) 
-      (ash 1 x) 
-    0))
-
-(defund encode (x n)
-    (declare (xargs :guard (and (acl2-numberp x)
-                                (integerp n)
-                                (<= 0 n))))
-  (if (zp n) 
-      0
-    (if (= x (ash 1 n))
-        n
-      (encode x (1- n)))))
-
-;; floor, rem are predefined ACL2 functions
-
-
-;; 12. evaluation control operators
-
-(defmacro bind (v x y)
-  `(let ((,v ,x)) ,y))
-
-(defun if1 (x y z)
-  (declare (xargs :guard (integerp x)))
-  (if (eql x 0) z y))
-
-(defthm if1-0
-  (equal (if1 0 y z)
-         z))
-
-(defthm if1-non-0
-  (implies (not (equal x 0))
-           (equal (if1 x y z)
-                  y)))
-
-(defthm if1-x-x
-  (equal (if1 tst x x)
-         x))
-
-(defthm bvecp-if1
-  (equal (bvecp (if1 x y z) n)
-         (if1 x (bvecp y n) (bvecp z n))))
-
-(defun cond1-macro (clauses)
-  ;; Based on cond-macro.
-  (declare (xargs :guard (cond-clausesp clauses)))
-  (if (consp clauses)
-      (if (and (eq (car (car clauses)) t)
-               (eq (cdr clauses) nil))
-          (if (cdr (car clauses))
-              (car (cdr (car clauses)))
-            (car (car clauses)))
-        (list 'if1 (car (car clauses))
-              (if (cdr (car clauses))
-                  (car (cdr (car clauses)))
-                (car (car clauses)))
-              (cond1-macro (cdr clauses))))
-    0))
-
-(defmacro cond1 (&rest clauses)
-  (declare (xargs :guard (cond-clausesp clauses)))
-  (cond1-macro clauses))
-
-
-;; 13. extra operators
-
-(defun natp1 (x)
-  (declare (xargs :guard t))
-  (if (and (integerp x)
-           (<= 0 x))
-      1
-    0))
-
-
-;land0
-
-
-(defund binary-land0 (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logand (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro land0 (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(land0 x y n) -- the base case
-         `(binary-land0 ,@x))
-        (t         
-         `(binary-land0 ,(car x)
-                       (land0 ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable land0)) to refer to binary-land0.
-(add-macro-alias land0 binary-land0)
-
-;;lior0
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-
-(defund binary-lior0 (x y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logior (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defmacro lior0 (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lior0 x y n) -- the base case
-         `(binary-lior0 ,@x))
-        (t         
-         `(binary-lior0 ,(car x)
-                       (lior0 ,@(cdr x))
-                       ,(car (last x))))))
-
-
-;Allows things like (in-theory (disable lior0)) to refer to binary-lior0.
-(add-macro-alias lior0 binary-lior0)
-
-;;lxor0
-
-(defund binary-lxor0 (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))
-                  :verify-guards nil))
-  (logxor (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defmacro lxor0 (&rest x)
-  (declare (xargs :guard (consp x)))
-  (cond ((endp (cdddr x)) ;(lxor0 x y n) -- the base case
-         `(binary-lxor0 ,@x))
-        (t         
-         `(binary-lxor0 ,(car x)
-                       (lxor0 ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable lxor0)) to refer to binary-lxor0.
-(add-macro-alias lxor0 binary-lxor0)
-
-
-
-
-;;4 functions that occur in the translated RTL, representing bit vectors of
-;;determined length but undetermined value:
-
-(encapsulate 
- ((reset (key size) t))
- (local (defun reset (key size) (declare (ignore key size)) 0))
- (defthm bvecp-reset (bvecp (reset key size) size)
-   :hints (("Goal" :in-theory (enable bvecp expt)))
-   :rule-classes 
-   (:rewrite 
-    (:forward-chaining :trigger-terms ((reset key size)))	
-    (:type-prescription :corollary
-                        (and (integerp (reset key size)) 
-                             (>= (reset key size) 0))
-                        :hints
-                        (("Goal" :in-theory '(implies bvecp)))))))
-
-(encapsulate 
- ((unknown (key size n) t))
- (local (defun unknown (key size n) (declare (ignore key size n)) 0))
- (defthm bvecp-unknown (bvecp (unknown key size n) size)
-   :hints (("Goal" :in-theory (enable bvecp expt)))
-   :rule-classes 
-   (:rewrite
-    (:forward-chaining :trigger-terms ((unknown key size n)))
-    (:type-prescription :corollary
-                        (and (integerp (unknown key size n))
-                             (>= (unknown key size n) 0))
-                        :hints
-                        (("Goal" :in-theory '(implies bvecp)))))))
-
-(encapsulate 
- ((reset2 (key size) t))
- (local (defun reset2 (key size) (declare (ignore key size)) nil))
- 
-;do we need rule-classes on this thm?
- (defthm bv-arrp-reset2
-   (bv-arrp (reset2 key size) size)
-   :hints
-   (("goal" :in-theory (enable bv-arrp)))
-   ))
-
-(encapsulate 
- ((unknown2 (key size n) t))
- (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
- 
-;do we need rule-classes on this thm?
- (defthm bv-arrp-unknown2
-   (bv-arrp (unknown2 key size n) size)
-   :hints
-   (("goal" :in-theory (enable bv-arrp)))
-   ))
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/rtlarr.lisp acl2-6.3/books/rtl/rel5/support/rtlarr.lisp
--- acl2-6.2/books/rtl/rel5/support/rtlarr.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/rtlarr.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,474 +0,0 @@
-; Rob Sumners
-
-(in-package "ACL2")
-
-#|
-
-We define properties of a generic record accessor function and updater function
-we will use for RTL arrays.  The basic functions are (ag a r) and (as a v r)
-where a is an array index, v is a value, r is an "array" or record, and 
-(ag a r) returns the value set to index a in array r, and (as a v r) returns 
-a new array with index a set to value v in array r.
-
-The following main lemmas are "exported" about record (ag)et and (as)et:
-
-(defthm ag-same-as
-  (equal (ag a (as a v r)) 
-         v))
-
-(defthm ag-diff-as
-  (implies (not (equal a b))
-           (equal (ag a (as b v r))
-                  (ag a r))))
-
-(defthm as-same-ag
-  (equal (as a (ag a r) r) 
-         r))
-
-(defthm as-same-as
-  (equal (as a y (as a x r))
-         (as a y r)))
-
-(defthm as-diff-as
-  (implies (not (equal a b))
-           (equal (as b y (as a x r))
-                  (as a x (as b y r))))
-  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
-
-
-We also include some auxiliary lemmas which have proven useful.
-
-(defthm ag-of-nil-is-default
-  (equal (ag a nil) (default-get-valu)))
-
-(defthm as-non-default-cannot-be-nil
-  (implies (not (equal v (default-get-valu)))
-           (as a v r))
-  :hints (("Goal" 
-           :in-theory (disable rcd->acl2-of-record-non-nil)
-           :use (:instance rcd->acl2-of-record-non-nil
-                           (r (as-aux a v (acl2->rcd r)))))))
-
-(defthm non-nil-if-ag-not-default
-  (implies (not (equal (ag a r) 
-                       (default-get-valu)))
-           r)
-  :rule-classes :forward-chaining)
-
-
-We also include some "type" lemmas for accesses and updates of rtl arrays.
-
-(defthm as-maps-bv-arr-to-bv-arr
-  (implies (and (bv-arrp r k)
-                (bvecp v k))
-           (bv-arrp (as a v r) k)))
-
-(defthm ag-maps-bv-arr-to-bvecp
-  (implies (bv-arrp r k)
-           (bvecp (ag a r) k)))
-
-
-Note we also define as2 and ag2 for 2-dimensional arrays but these simply
-macro-expand into appropriate as and ag calls.
-
-We normalize the array structures (which allows the 'equal-ity based rewrite
-rules) as alists where the keys (cars) are ordered using the total-order added
-to ACL2 and defined in the included book. We define a set of "-aux" functions
-which assume well-formed records -- defined by rcdp -- and then prove the
-desired properties using hypothesis assuming well-formed records.
-
-We then remove these well-formed record hypothesis by defining an invertible
-mapping (acl2->rcd) taking any ACL2 object and returning a well-formed
-record. We then prove the desired properties using the proper translations of
-the -aux functions to the acl2 objects, and subsequently remove the
-well-formed record hypothesis.
-
-|#
-
-(include-book "misc/total-order" :dir :system)
-
-;; BEGIN records definitions.
-
-(defmacro default-get-valu () 0)
-
-(defun rcdp (x)
-  (declare (xargs :guard t))
-  (or (null x)
-      (and (consp x)
-           (consp (car x))
-           (rcdp (cdr x))
-           (not (equal (cdar x) 
-                       (default-get-valu)))
-           (or (null (cdr x))
-               (<< (caar x) (caadr x))))))
-
-(defthm rcdp-implies-alistp
-  (implies (rcdp x) (alistp x)))
-
-(defmacro ifrp-tag ()
-  ''unlikely-to-ever-occur-in-an-executable-counterpart)
-
-(defun ifrp (x) ;; ill-formed rcdp 
-  (declare (xargs :guard t))
-  (or (not (rcdp x))
-      (and (consp x)
-           (null (cdr x))
-           (consp (car x))
-           (equal (cdar x) (ifrp-tag))
-           (ifrp (caar x)))))
-
-(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
-  (declare (xargs :guard t))
-  (if (ifrp x) (list (cons x (ifrp-tag))) x))
-
-(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
-  (declare (xargs :guard (rcdp r)))
-  (if (ifrp r) (caar r) r))
-
-(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
-  (declare (xargs :guard (rcdp r)))
-  (cond ((or (endp r)
-             (<< a (caar r)))
-         (default-get-valu))
-        ((equal a (caar r))
-         (cdar r))
-        (t
-         (ag-aux a (cdr r)))))
-
-(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
-  (declare (xargs :guard t))
-  (ag-aux a (acl2->rcd x)))
-
-(defun acons-if (a v r)
-  (declare (xargs :guard (rcdp r)))
-  (if (equal v (default-get-valu)) r (acons a v r)))
-
-(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
-  (declare (xargs :guard (rcdp r)))
-  (cond ((or (endp r)
-             (<< a (caar r)))
-         (acons-if a v r))
-        ((equal a (caar r))
-         (acons-if a v (cdr r)))
-        (t 
-         (cons (car r) (as-aux a v (cdr r))))))
-
-;; we need the following theorems in order to get the guard for s to verify.
-
-(local
-(defthm as-aux-is-bounded
-  (implies (and (rcdp r)
-                (as-aux a v r)
-                (<< e a)
-                (<< e (caar r)))
-           (<< e (caar (as-aux a v r))))))
-
-(local
-(defthm as-aux-preserves-rcdp
-  (implies (rcdp r)
-           (rcdp (as-aux a v r)))))
-
-(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
-  (declare (xargs :guard t))
-  (rcd->acl2 (as-aux a v (acl2->rcd x))))
-
-
-;;;; basic property of records ;;;;
-
-(local
-(defthm rcdp-implies-true-listp
-  (implies (rcdp x)
-           (true-listp x))
-  :rule-classes (:forward-chaining
-                 :rewrite)))
-
-
-;;;; initial properties of s-aux and g-aux ;;;;
-
-(local
-(defthm ag-aux-same-as-aux
-  (implies (rcdp r)
-           (equal (ag-aux a (as-aux a v r))
-                  v))))
-
-(local
-(defthm ag-aux-diff-as-aux
-  (implies (and (rcdp r)
-                (not (equal a b)))
-           (equal (ag-aux a (as-aux b v r))
-                  (ag-aux a r)))))
-
-(local
-(defthm as-aux-same-ag-aux
-  (implies (rcdp r)
-           (equal (as-aux a (ag-aux a r) r) 
-                  r))))
-
-(local
-(defthm as-aux-same-as-aux
-  (implies (rcdp r)
-           (equal (as-aux a y (as-aux a x r))
-                  (as-aux a y r)))))
-
-(local
-(defthm as-aux-diff-as-aux
-  (implies (and (rcdp r)
-                (not (equal a b)))
-           (equal (as-aux b y (as-aux a x r))
-                  (as-aux a x (as-aux b y r))))
-  :rule-classes ((:rewrite :loop-stopper ((b a as))))))
-
-(local
-(defthm as-aux-non-nil-cannot-be-nil
-  (implies (and (not (equal v (default-get-valu)))
-                (rcdp r))
-           (as-aux a v r))))
-
-(local
-(defthm ag-aux-is-nil-for-<<
-  (implies (and (rcdp r)
-                (<< a (caar r)))
-           (equal (ag-aux a r)
-                  (default-get-valu)))))
-
-
-;;;; properties of acl2->rcd and rcd->acl2 ;;;;
-
-(local
-(defthm acl2->rcd-rcd->acl2-of-rcdp
-  (implies (rcdp x)
-           (equal (acl2->rcd (rcd->acl2 x))
-                  x))))
-
-(local
-(defthm acl2->rcd-returns-rcdp
-  (rcdp (acl2->rcd x))))
-
-(local
-(defthm acl2->rcd-preserves-equality
-  (iff (equal (acl2->rcd x) (acl2->rcd y))
-       (equal x y))))
-
-(local
-(defthm rcd->acl2-acl2->rcd-inverse
-  (equal (rcd->acl2 (acl2->rcd x)) x)))
-
-(local
-(defthm rcd->acl2-of-record-non-nil
-  (implies (and r (rcdp r))
-           (rcd->acl2 r))))
-
-(in-theory (disable acl2->rcd rcd->acl2))
-
-
-;;;; final (exported) properties of record g(et) and s(et) ;;;;
-
-;; NOTE that these theorems basically follow from the "equivalent" properties
-;; for s-aux and g-aux with rcdp hypothesis, and the lemmas about the acl2->rcd
-;; and its inverse rcd->acl2. If the user wanted to add to the following set of
-;; exported theorems, they should add the corresponding lemma about s-aux and
-;; g-aux using rcdp hypothesis and then add the theorem here about the generic
-;; s(et) and g(et) they wish to export from the book.
-
-(defthm ag-same-as
-  (equal (ag a (as a v r)) 
-         v))
-
-(defthm ag-diff-as
-  (implies (not (equal a b))
-           (equal (ag a (as b v r))
-                  (ag a r))))
-
-;;;; NOTE: The following can be used instead of the above rules to force ACL2
-;;;; to do a case-split. We disable this rule by default since it can lead to
-;;;; an expensive case explosion, but in many cases, this rule may be more
-;;;; effective than two rules above and should be enabled.
-
-(defthm ag-of-as-redux
-  (equal (ag a (as b v r))
-         (if (equal a b) v (ag a r))))
-
-(in-theory (disable ag-of-as-redux))
-
-(defthm as-same-ag
-  (equal (as a (ag a r) r) 
-         r))
-
-(defthm as-same-as
-  (equal (as a y (as a x r))
-         (as a y r)))
-
-(defthm as-diff-as
-  (implies (not (equal a b))
-           (equal (as b y (as a x r))
-                  (as a x (as b y r))))
-  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
-
-;; the following theorems are less relevant but have been useful in dealing
-;; with a default record of NIL.
-
-(defthm ag-of-nil-is-default
-  (equal (ag a nil) (default-get-valu)))
-
-(defthm as-non-default-cannot-be-nil
-  (implies (not (equal v (default-get-valu)))
-           (as a v r))
-  :hints (("Goal" 
-           :in-theory (disable rcd->acl2-of-record-non-nil)
-           :use (:instance rcd->acl2-of-record-non-nil
-                           (r (as-aux a v (acl2->rcd r)))))))
-
-(defthm non-nil-if-ag-not-default
-  (implies (not (equal (ag a r) 
-                       (default-get-valu)))
-           r)
-  :rule-classes :forward-chaining)
-
-;; OK, we add here some properties for typing the records and the values which
-;; are stored in the records. This "typing" is pretty generic, but we choose the
-;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
-
-(defun bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defun bv-arrp (x k)
-  (declare (xargs :guard (integerp k)))
-  (or (null x)
-      (and (consp x)
-           (consp (car x))
-           (bv-arrp (cdr x) k)
-           (not (equal (cdar x) 
-                       (default-get-valu)))
-           (bvecp (cdar x) k)
-           (or (null (cdr x))
-               (<< (caar x) (caadr x))))))
-
-(local
-(defthm bvecp-of-default-get-valu-is-true
-  (bvecp (default-get-valu) k)))
-
-(local
-(defthm bvecp-of-ifrp-tag-is-false
-  (not (bvecp (ifrp-tag) k))))
-
-(in-theory (disable bvecp))
-
-(local
-(defthm bv-arrp-implies-rcdp
-  (implies (bv-arrp r k)
-           (rcdp r))))
-
-(local
-(defthm as-aux-maps-bv-rcd-to-bv-rcd
-  (implies (and (bv-arrp r k)
-                (bvecp v k))
-           (bv-arrp (as-aux a v r) k))))
-
-(local
-(defthm ag-aux-maps-bv-rcd-to-bvecp
-  (implies (bv-arrp r k)
-           (bvecp (ag-aux a r) k))))
-
-(local
-(defthm bv-arrp-implies-not-ifrp
-  (implies (bv-arrp x k)
-           (not (ifrp x)))))
-
-(local
-(defthm bv-arrp-acl2->rcd-transfers
-  (implies (bv-arrp x k)
-           (bv-arrp (acl2->rcd x) k))
-  :hints (("Goal" :in-theory (enable acl2->rcd)))))
-
-(local
-(defthm bv-arrp-rcd->acl2-transfers
-  (implies (bv-arrp r k)
-           (bv-arrp (rcd->acl2 r) k))
-  :hints (("Goal" :in-theory (enable rcd->acl2)))))
-
-(defthm as-maps-bv-arr-to-bv-arr
-  (implies (and (bv-arrp r k)
-                (bvecp v k))
-           (bv-arrp (as a v r) k)))
-
-(defthm ag-maps-bv-arr-to-bvecp
-  (implies (bv-arrp r k)
-           (bvecp (ag a r) k)))
-
-(defun mk-bvarr (r k)
-  (declare (xargs :guard (integerp k)))
-  (if (bv-arrp r k) r ()))
-
-(defthm mk-bvarr-is-bv-arrp
-  (bv-arrp (mk-bvarr r k) k))
-
-(defthm mk-bvarr-identity
-  (implies (bv-arrp r k)
-           (equal (mk-bvarr r k) r)))
-
-(in-theory (disable bv-arrp mk-bvarr))
-
-;; finally we define some "2D" array accessors.
-
-(defmacro ag2 (a b r)
-  `(ag (cons ,a ,b) ,r))
-
-(defmacro as2 (a b v r)
-  `(as (cons ,a ,b) ,v ,r))
-
-
-;; We disable s and g, assuming the rules proven in this book are sufficient to
-;; manipulate record terms which are encountered.
-
-(in-theory (disable as ag))
-
-; Begin events added March 2005 when it was discovered that they are in
-; ../lib/rtlarr.lisp but not in this file.
-
-(defun positive-integer-listp (l)
-  (declare (xargs :guard t))
-  (cond ((atom l)
-         (equal l nil))
-        (t (and (integerp (car l))
-                (< 0 (car l))
-                (positive-integer-listp (cdr l))))))
-
-(defmacro arr0 (&rest dims)
-  (declare (ignore dims)
-           (xargs :guard (positive-integer-listp dims)))
-  nil)
-
-;;Functions representing bit vectors of determined length but undetermined value:
-
-(encapsulate 
- ((reset2 (key size) t))
- (local (defun reset2 (key size) (declare (ignore key size)) nil))
- (defthm bv-arrp-reset2
-   (bv-arrp (reset2 key size) size)
-   :hints
-   (("goal" :in-theory (enable bv-arrp)))
-   ))
-
-(encapsulate 
- ((unknown2 (key size n) t))
- (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
- (defthm bv-arrp-unknown2
-   (bv-arrp (unknown2 key size n) size)
-   :hints
-   (("goal" :in-theory (enable bv-arrp)))
-   ))
-
-(defun if1 (x y z)
-  (declare (xargs :guard (integerp x)))
-  (if (eql x 0) z y))
-
-;BOZO where in lib/ should this go?
-(defthm bv-arrp-if1
-  (equal (bv-arrp (if1 x y z) n)
-         (if1 x (bv-arrp y n) (bv-arrp z n))))
-
-; End events added March 2005 when it was discovered that they are in
-; ../lib/rtlarr.lisp but not in this file.
diff -Nru acl2-6.2/books/rtl/rel5/support/setbitn-proofs.lisp acl2-6.3/books/rtl/rel5/support/setbitn-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/setbitn-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/setbitn-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,210 +0,0 @@
-(in-package "ACL2")
-
-(include-book "cat-def")
-
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund setbits (x w i j y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp i)
-                              (integerp j)
-                              (<= 0 j)
-                              (<= j i)
-                              (integerp w)
-                              (< i w))
-                  :verify-guards nil))
-  (mbe :logic (cat (bits x (1- w) (1+ i))
-                   (+ -1 w (- i))
-                   (cat (bits y (+ i (- j)) 0)
-                        (+ 1 i (- j))
-                        (bits x (1- j) 0)
-                        j)
-                   (1+ i))
-       :exec  (cond ((int= j 0)
-                     (cond ((int= (1+ i) w)
-                            (bits y (+ i (- j)) 0))
-                           (t
-                            (cat (bits x (1- w) (1+ i))
-                                 (+ -1 w (- i))
-                                 (bits y (+ i (- j)) 0)
-                                 (1+ i)))))
-                    ((int= (1+ i) w)
-                     (cat (bits y (+ i (- j)) 0)
-                          (+ 1 i (- j))
-                          (bits x (1- j) 0)
-                          j))
-                    (t
-                     (cat (bits x (1- w) (1+ i))
-                          (+ -1 w (- i))
-                          (cat (bits y (+ i (- j)) 0)
-                               (+ 1 i (- j))
-                               (bits x (1- j) 0)
-                               j)
-                          (1+ i))))))
-
-(local (include-book "setbits"))
-(local (include-book "../arithmetic/top"))
-(local (include-book "bits"))
-(local (include-book "cat"))
-
-(defund setbitn (x w n y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (<= 0 n)
-                              (integerp w)
-                              (< n w))
-                  :verify-guards nil))
-  (setbits x w n n y))
-
-(defthm setbitn-nonnegative-integer-type
-  (and (integerp (setbitn x w n y))
-       (<= 0 (setbitn x w n y)))
-  :hints (("Goal" :in-theory (enable setbitn)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than setbits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription setbitn)))
-
-(defthm setbitn-natp
-  (natp (setbitn x w n y)))
-
-;add setbitn-bvecp-simple?
-
-(defthm setbitn-bvecp
-  (implies (and (<= w k)
-                (case-split (integerp k)))
-           (bvecp (setbitn x w n y) k))
-  :hints (("goal" :in-theory (enable setbitn))))
-
-(defthm setbitn-rewrite
-  (implies (syntaxp (quotep n))
-           (equal (setbitn x w n y)
-                  (setbits x w n n y)))
-  :hints (("Goal" :in-theory (enable setbitn))))
-
-;gen?
-(defthm bitn-setbitn
-  (implies (and (case-split (bvecp y 1))
-                (case-split (< 0 w))
-                (case-split (< n w))
-                (case-split (< k w))
-                (case-split (<= 0 k))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                (<= 0 n)
-                (case-split (integerp k))
-                )
-           (equal (bitn (setbitn x w n y) k)
-                  (if (equal n k)
-                      y
-                    (bitn x k))))
-  :hints (("Goal" :cases ((< n k) (= n k))
-           :in-theory (enable setbitn bitn bits-does-nothing)))
-  )
-
-
-
-(defthm setbitn-setbitn
-  (implies (and (case-split (<= 0 n))
-                (case-split (< n w))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                )
-           (equal (setbitn (setbitn x w n y) w n y2)
-                  (setbitn x w n y2)))
-  :hints (("Goal"
-           :in-theory (enable setbits setbitn natp)))
-  )
-
-(defthm setbitn-does-nothing
-  (implies (and (case-split (<= 0 n))
-                (case-split (< n w))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                )
-           (equal (setbitn x w n (bitn x n))
-                  (bits x (1- w) 0))
-           )
-  :hints (("Goal" :cases ((< (+ -1 W) (+ 1 N)))
-           :in-theory (enable bitn setbits setbitn natp)))
-  )
-
-#|
-;bad name?
-(defthm setbitn-commutativity
-  (implies (and (< n n2);(not (equal n n2))
-                (case-split (<= 0 n))
-                (case-split (<= 0 n2))
-                (case-split (< n w))
-                (case-split (< n2 w))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                (case-split (integerp n2))
-                (case-split (bvecp y 1))
-                (case-split (bvecp y2 1))
-                (case-split (bvecp x w)) ;drop!
-)
-           (equal (setbitn (setbitn x w n y) w n2 y2)
-                  (setbitn (setbitn x w n2 y2) w n y)
-))
-  :rule-classes ((:rewrite :loop-stopper ((n n2 s))))
-  :hints (("Goal"
-           :in-theory (enable setbitn setbits-rewrite setbits-rewrite-when-j-is-0)))
-  )
-
-
-(defthm setbitn-commutativity
-  (implies (and (< n n2);(not (equal n n2))
-                (case-split (<= 0 n))
-                (case-split (<= 0 n2))
-                (case-split (< n w))
-                (case-split (< n2 w))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                (case-split (integerp n2))
-                (case-split (bvecp y 1))
-                (case-split (bvecp y2 1))
-                (case-split (bvecp x w)) ;drop!
-)
-           (equal (setbitn (setbitn x w n y) w n2 y2)
-                  (setbitn (setbitn x w n2 y2) w n y)
-))
-  :rule-classes ((:rewrite :loop-stopper ((n n2 s))))
-  :hints (("Goal"
-           :in-theory (set-difference-theories
-                       (enable setbitn setbits-rewrite setbits-rewrite-when-j-is-0 
- ;                              bits-bits-1
-  ;                             bits-bits-2
-                               bits-ocat-1
-                               bits-ocat-2
-                               bits-ocat-3
-;                               natp
-                              )
-                       '(bits-bits bits-ocat)
-                       ))
-          ))
-
-prove bits-setbitn?
-
-|#
diff -Nru acl2-6.2/books/rtl/rel5/support/setbitn.lisp acl2-6.3/books/rtl/rel5/support/setbitn.lisp
--- acl2-6.2/books/rtl/rel5/support/setbitn.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/setbitn.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,131 +0,0 @@
-(in-package "ACL2")
-
-(include-book "cat-def")
-(local (include-book "setbitn-proofs"))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund setbits (x w i j y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp i)
-                              (integerp j)
-                              (<= 0 j)
-                              (<= j i)
-                              (integerp w)
-                              (< i w))
-                  :verify-guards nil))
-  (mbe :logic (cat (bits x (1- w) (1+ i))
-                   (+ -1 w (- i))
-                   (cat (bits y (+ i (- j)) 0)
-                        (+ 1 i (- j))
-                        (bits x (1- j) 0)
-                        j)
-                   (1+ i))
-       :exec  (cond ((int= j 0)
-                     (cond ((int= (1+ i) w)
-                            (bits y (+ i (- j)) 0))
-                           (t
-                            (cat (bits x (1- w) (1+ i))
-                                 (+ -1 w (- i))
-                                 (bits y (+ i (- j)) 0)
-                                 (1+ i)))))
-                    ((int= (1+ i) w)
-                     (cat (bits y (+ i (- j)) 0)
-                          (+ 1 i (- j))
-                          (bits x (1- j) 0)
-                          j))
-                    (t
-                     (cat (bits x (1- w) (1+ i))
-                          (+ -1 w (- i))
-                          (cat (bits y (+ i (- j)) 0)
-                               (+ 1 i (- j))
-                               (bits x (1- j) 0)
-                               j)
-                          (1+ i))))))
-
-(defund setbitn (x w n y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (<= 0 n)
-                              (integerp w)
-                              (< n w))
-                  :verify-guards nil))
-  (setbits x w n n y))
-
-(defthm setbitn-nonnegative-integer-type
-  (and (integerp (setbitn x w n y))
-       (<= 0 (setbitn x w n y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than setbits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription setbitn)))
-
-(defthm setbitn-natp
-  (natp (setbitn x w n y)))
-
-;add setbitn-bvecp-simple?
-
-(defthm setbitn-bvecp
-  (implies (and (<= w k)
-                (case-split (integerp k)))
-           (bvecp (setbitn x w n y) k)))
-
-(defthm setbitn-rewrite
-  (implies (syntaxp (quotep n))
-           (equal (setbitn x w n y)
-                  (setbits x w n n y))))
-
-;gen?
-(defthm bitn-setbitn
-  (implies (and (case-split (bvecp y 1))
-                (case-split (< 0 w))
-                (case-split (< n w))
-                (case-split (< k w))
-                (case-split (<= 0 k))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                (<= 0 n)
-                (case-split (integerp k))
-                )
-           (equal (bitn (setbitn x w n y) k)
-                  (if (equal n k)
-                      y
-                    (bitn x k)))))
-
-(defthm setbitn-setbitn
-  (implies (and (case-split (<= 0 n))
-                (case-split (< n w))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                )
-           (equal (setbitn (setbitn x w n y) w n y2)
-                  (setbitn x w n y2))))
-
-(defthm setbitn-does-nothing
-  (implies (and (case-split (<= 0 n))
-                (case-split (< n w))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                )
-           (equal (setbitn x w n (bitn x n))
-                  (bits x (1- w) 0))))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/setbits-proofs.lisp acl2-6.3/books/rtl/rel5/support/setbits-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/setbits-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/setbits-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,442 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(include-book "cat-def")
-(local (include-book "../arithmetic/top"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "bvecp"))
-(local (include-book "cat"))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-#|
-
-Currently we expect to leave setbits enabled so that it rewrites to cat, but there are some lemmas below which
-might be useful if we choose to keep setbits disabled...
-
-is this comment still valid? :
-;it may happen that setbitn is called with an index which is a signal rather than a constant.
-;in that case, we probably don't want it to expand to setbits. 
-;thus, we always expect the indices in setbits calls to be constants
-
-
-;Set bits I down to J of the W-bit value X to Y.
-
-(setbits x w i j y) is only well-defined when the following predicate is true:
-
-(and (natp w)
-     (bvecp x w)
-     (integerp i)
-     (integerp j)
-     (<= 0 j)
-     (<= j i)
-     (< i w)
-     (bvecp y (+ 1 i (- j))))
-
-|#
-
-#| old:
-(defund setbits (x w i j y)
-  (declare (xargs :guard (and (rationalp x) (rationalp y)
-                              (acl2-numberp i) (acl2-numberp j) (acl2-numberp w))))
-  (if (not (natp w))
-      0
-    (cat (bits x (1- w) (+ 1 i))
-         (+ -1 w (- i))
-         (cat (bits y (+ i (- j)) 0)
-              (+ 1 i (- j))
-              (bits x (1- j) 0)
-              j)
-         (+ 1 i))))
-|#
-
-;Note: when j is 0, there is not lower part of x, but we have cat-with-n-0 to handle this case. 
-(defund setbits (x w i j y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp i)
-                              (integerp j)
-                              (<= 0 j)
-                              (<= j i)
-                              (integerp w)
-                              (< i w))
-                  :verify-guards nil))
-  (mbe :logic (cat (bits x (1- w) (1+ i))
-                   (+ -1 w (- i))
-                   (cat (bits y (+ i (- j)) 0)
-                        (+ 1 i (- j))
-                        (bits x (1- j) 0)
-                        j)
-                   (1+ i))
-       :exec  (cond ((int= j 0)
-                     (cond ((int= (1+ i) w)
-                            (bits y (+ i (- j)) 0))
-                           (t
-                            (cat (bits x (1- w) (1+ i))
-                                 (+ -1 w (- i))
-                                 (bits y (+ i (- j)) 0)
-                                 (1+ i)))))
-                    ((int= (1+ i) w)
-                     (cat (bits y (+ i (- j)) 0)
-                          (+ 1 i (- j))
-                          (bits x (1- j) 0)
-                          j))
-                    (t
-                     (cat (bits x (1- w) (1+ i))
-                          (+ -1 w (- i))
-                          (cat (bits y (+ i (- j)) 0)
-                               (+ 1 i (- j))
-                               (bits x (1- j) 0)
-                               j)
-                          (1+ i))))))
-
-
-
-#| old defn
-(defun setbits (x i j y)
-  (ocat (ocat (ash x (- (1+ i)))
-	    y
-	    (1+ (- i j)))
-       (bits x (1- j) 0)
-       j))
-|#
-
-(defthm setbits-nonnegative-integer-type
-  (and (integerp (setbits x w i j y))
-       (<= 0 (setbits x w i j y)))
-  :hints (("Goal" :in-theory (enable setbits)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than setbits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription setbits)))
-
-(defthm setbits-natp
-  (natp (setbits x w i j y)))
-
-;BOZO r-c?
-(defthm setbits-upper-bound
-  (< (setbits x w i j y) (expt 2 w))
-  :hints (("Goal" :in-theory (enable setbits cat-upper-bound))))
-
-(defthm setbits-bvecp-simple
-  (bvecp (setbits x w i j y) w)
-  :hints (("goal" :in-theory (enable bvecp))))
-
-(defthm setbits-bvecp
-  (implies (and (<= w k)
-                (case-split (integerp k))
-                )
-           (bvecp (setbits x w i j y) k))
-  :hints (("goal" :use setbits-bvecp-simple
-           :in-theory (disable setbits-bvecp-simple))))
-
-(defthm setbits-does-nothing
-  (implies (and (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (<= 0 j))
-                )
-           (equal (setbits x w i j (bits x i j))
-                  (bits x (1- w) 0)))
-  :hints (("Goal" :in-theory (enable setbits))))
-
-
-#| old, prove the two match for bvecps
-(defun oldsetbits (x i j y)
-  (ocat (ocat (ash x (- (1+ i)))
-	    y
-	    (1+ (- i j)))
-       (bits x (1- j) 0)
-       j))
-
-;we had this before
-(defthm oldsetbits-rewrite-1
-    (implies (and (bvecp x n)
-		  (natp n)
-		  (> n 0)
-		  (natp i)
-		  (natp j)
-		  (<= j i)
-		  (bvecp y (1+ (- i j))))
-	     (equal (oldsetbits x i j y)
-		    (ocat (ocat (bits x (1- n) (1+ i))
-			      y
-			      (1+ (- i j)))
-			 (bits x (1- j) 0)
-			 j))))
-
-(defthm setbits-match
-  (implies (and (bvecp x n)
-                (natp n)
-                (> n 0)
-                (natp w)
-                (<= n w)
-                (bvecp y (1+ (- i j)))
-                (natp i)
-                (natp j)
-                (<= j i))
-           (equal (oldsetbits x i j y)
-                  (setbits x w i j y)))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable setbits oldsetbits bits-does-nothing
-                                     natp))))
-
-|#
-
-;taking bits from the lower third
-;slow proof with may cases!
-(defthm bits-setbits-1
-  (implies (and (< k j)
-                (case-split (<= 0 w))
-                (case-split (< i w))
-                (case-split (<= 0 l))
-                (case-split (<= j i)) ;drop?
-                (case-split (integerp w))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits x k l)))
-  :hints (("Goal" :in-theory (enable setbits))))
-
-;taking bits from the middle third
-;slow proof with may cases!
-(defthm bits-setbits-2
-  (implies (and (<= k i)
-                (<= j l)
-                (case-split (integerp i))
-                (case-split (<= 0 j))
-                (case-split (integerp j))
-                (case-split (acl2-numberp k));		  (case-split (integerp k))
-                (case-split (acl2-numberp l)) ;	  (case-split (integerp l))
-                (case-split (integerp w))
-                (case-split (<= 0 w))
-                (case-split (< i w))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits y (- k j) (- l j))))
-  :hints (("Goal" :in-theory (enable setbits natp))))
-
-;taking bits from the upper third
-(defthm bits-setbits-3
-  (implies (and (< i l)
-                (case-split (< i w))
-                (case-split (< k w)) ;handle this?
-                (case-split (<= j i))
-                (case-split (<= 0 l))
-                (case-split (<= 0 j))
-                (case-split (<= 0 w))
-                (case-split (integerp l))
-                (case-split (integerp w))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits x k l)))
-  :hints (("Goal" :in-theory (enable setbits natp))))
-
-
-(defthm setbits-with-0-width
-  (equal (setbits x 0 i j y)
-         0)
-  :hints (("Goal" :cases ((integerp j))
-           :in-theory (enable setbits))))
-
-;add case-splits?
-;why can't i prove this from bits-setbits?
-(defthm bitn-setbits-1
-  (implies (and (< k j) ;case 1
-                (< i w)
-                (<= 0 i)
-                (<= 0 j) 
-                (<= 0 k)
-                (<= j i)
-                (integerp k)
-                (integerp w)
-                (integerp i)
-                (integerp j)
-                )
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn x k)))
-  :hints (("Goal" :in-theory (enable setbits)))
-  )
-
-(defthm bitn-setbits-2
-  (implies (and(<= k i) ;;case-2
-               (<= j k) ;;case-2
-               (<= 0 i)
-               (<= 0 j) 
-               (< i w)
-               (integerp k)
-               (integerp w)
-               (integerp i)
-               (integerp j)
-               )
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn y (- k j))))
-  :hints (("Goal" :in-theory (enable setbits)))
-  )
-
-(defthm bitn-setbits-3
-  (implies (and (< i k) ;;case-3
-                (< k w) ;;case-3
-;                (< i w)
-                (<= 0 i)
-                (<= 0 j) 
-                (<= j i)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp w))
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn x k)))
-  :hints (("Goal" :in-theory (enable setbits)))
-  )
-
-
-;taking a slice of each of the lower two thirds.
-(defthm bits-setbits-4
-  (implies (and (<= k i) ;;case-4
-                (<= j k) ;;case-4
-                (< l j) ;;case-4
-                (< i w)
-                (<= 0 j)
-                (<= 0 l)
-                (integerp i)
-                (integerp j)
-                (integerp w) 
-                (acl2-numberp l) ;(integerp l)
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (cat (bits y (- k j) 0)
-                       (+ 1 k (- j))
-                       (bits x (1- j) l)
-                       (- j l))))
-  :hints (("Goal" :in-theory (enable setbits))))
-
-;taking a slice of each of the upper two thirds.
-(defthm bits-setbits-5
-    (implies (and (< i k)  ;case-5
-		  (<= l i) ;case-5
-		  (<= j l) ;case-5
-                  (< k w)  ;case-5 ;BOZO drop stuff like this?
-                  (<= 0 j)
-                  (integerp i)
-                  (integerp j)
-                  (integerp w)
-                  (acl2-numberp l) ;(integerp l)
-                  )
-	     (equal (bits (setbits x w i j y) k l)
-		    (cat (bits x k (1+ i))
-                         (+ k (- i))
-			 (bits y (- i j) (- l j))
-			 (1+ (- i l)))))
-    :hints (("Goal" :in-theory (enable setbits))))
-
-;taking a slice of each of the thirds.
-;make one huge bits-setbits lemma?
-(defthm bits-setbits-6
-  (implies (and (< i k) ;;case-6
-                (< l j) ;;case-6
-                (<= j i)
-                (< k w)
-                (<= 0 l)
-                (integerp i)
-                (integerp j)
-                (acl2-numberp l) ; (integerp l)
-                (integerp w)
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (cat (bits x k (1+ i))
-                       (+ k (- i))
-                       (cat (bits y (+ i (- j)) 0)
-                            (1+ (- i j))
-                            (bits x (1- j) l)
-                            (- j l))
-                       (+ 1 i (- l)))))
-  :hints (("Goal" :in-theory (enable setbits))))
-
-;prove that if (not (natp w)) setbits = 0 .
-
-;combining these adjacent ranges [i..j][k..l]
-(defthm setbits-combine
-  (implies (and (equal j (+ k 1))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l))
-                )
-  (equal (setbits (setbits x w k l y1) w i j y2)
-         (setbits x w i l (cat y2
-                                (+ 1 i (- j))
-                                y1
-                                (+ 1 k (- l))
-                                ))))
-  :hints (("goal" :in-theory (enable setbits))))
-
-(defthm setbits-combine-2
-  (implies (and (equal j (+ k 1))
-                (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l))
-                )
-  (equal (setbits (setbits x w i j y2) w k l y1)
-         (setbits x w i l (cat y2
-                                (+ 1 i (- j))
-                                y1
-                                (+ 1 k (- l))
-                                ))))
-  :hints (("goal" :in-theory (enable setbits))))
-
-(defthm setbits-combine-3
-  (implies (and (equal j (+ k 1))
-                (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l)))
-           (equal (setbits (setbits x w i j y2) w k l y1)
-                  (setbits x w i l
-                           (cat y2 (+ 1 i (- j))
-                                 y1 (+ 1 k (- l)))))))
-
-
-(defthm setbits-all
-  (implies (and (equal i (1- w))
-                (case-split (bvecp y w))
-                )
-  (equal (setbits x w i 0 y)
-         y))
-  :hints (("goal" :in-theory (enable setbits))))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/setbits.lisp acl2-6.3/books/rtl/rel5/support/setbits.lisp
--- acl2-6.2/books/rtl/rel5/support/setbits.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/setbits.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,349 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(include-book "cat-def")
-(local (include-book "setbits-proofs"))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))
-                  :verify-guards nil))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-#|
-
-Currently we expect to leave setbits enabled so that it rewrites to cat, but there are some lemmas below which
-might be useful if we choose to keep setbits disabled...
-
-is this comment still valid? :
-;it may happen that setbitn is called with an index which is a signal rather than a constant.
-;in that case, we probably don't want it to expand to setbits. 
-;thus, we always expect the indices in setbits calls to be constants
-
-
-;Set bits I down to J of the W-bit value X to Y.
-
-(setbits x w i j y) is only well-defined when the following predicate is true:
-
-(and (natp w)
-     (bvecp x w)
-     (integerp i)
-     (integerp j)
-     (<= 0 j)
-     (<= j i)
-     (< i w)
-     (bvecp y (+ 1 i (- j))))
-
-|#
-
-;Note: when j is 0, there is no lower part of x, but we have cat-with-n-0 to handle this case. 
-(defund setbits (x w i j y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp i)
-                              (integerp j)
-                              (<= 0 j)
-                              (<= j i)
-                              (integerp w)
-                              (< i w))
-                  :verify-guards nil))
-  (mbe :logic (cat (bits x (1- w) (1+ i))
-                   (+ -1 w (- i))
-                   (cat (bits y (+ i (- j)) 0)
-                        (+ 1 i (- j))
-                        (bits x (1- j) 0)
-                        j)
-                   (1+ i))
-       :exec  (cond ((int= j 0)
-                     (cond ((int= (1+ i) w)
-                            (bits y (+ i (- j)) 0))
-                           (t
-                            (cat (bits x (1- w) (1+ i))
-                                 (+ -1 w (- i))
-                                 (bits y (+ i (- j)) 0)
-                                 (1+ i)))))
-                    ((int= (1+ i) w)
-                     (cat (bits y (+ i (- j)) 0)
-                          (+ 1 i (- j))
-                          (bits x (1- j) 0)
-                          j))
-                    (t
-                     (cat (bits x (1- w) (1+ i))
-                          (+ -1 w (- i))
-                          (cat (bits y (+ i (- j)) 0)
-                               (+ 1 i (- j))
-                               (bits x (1- j) 0)
-                               j)
-                          (1+ i))))))
-
-(defthm setbits-nonnegative-integer-type
-  (and (integerp (setbits x w i j y))
-       (<= 0 (setbits x w i j y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than setbits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription setbits)))
-
-(defthm setbits-natp
-  (natp (setbits x w i j y)))
-
-;BOZO r-c?
-;tighten?
-(defthm setbits-upper-bound
-  (< (setbits x w i j y) (expt 2 w)))
-
-(defthm setbits-bvecp-simple
-  (bvecp (setbits x w i j y) w))
-
-(defthm setbits-bvecp
-  (implies (and (<= w k) ;gen?
-                (case-split (integerp k))
-                )
-           (bvecp (setbits x w i j y) k)))
-
-(defthm setbits-does-nothing
-  (implies (and (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (<= 0 j))
-                )
-           (equal (setbits x w i j (bits x i j))
-                  (bits x (1- w) 0))))
-
-;taking bits from the lower third
-(defthm bits-setbits-1
-  (implies (and (< k j)
-                (case-split (<= 0 w))
-                (case-split (< i w))
-                (case-split (<= 0 l))
-                (case-split (<= j i)) ;drop?
-                (case-split (integerp w))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits x k l)))
-  :hints (("Goal" :in-theory (enable setbits))))
-
-;taking bits from the middle third
-;gen?
-(defthm bits-setbits-2
-  (implies (and (<= k i)
-                (<= j l)
-                (case-split (integerp i))
-                (case-split (<= 0 j))
-                (case-split (integerp j))
-                (case-split (acl2-numberp k));		  (case-split (integerp k))
-                (case-split (acl2-numberp l)) ;	  (case-split (integerp l))
-                (case-split (integerp w))
-                (case-split (<= 0 w))
-                (case-split (< i w))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits y (- k j) (- l j))))
-  :hints (("Goal" :in-theory (enable setbits natp))))
-
-;taking bits from the upper third
-(defthm bits-setbits-3
-  (implies (and (< i l)
-                (case-split (< i w))
-                (case-split (< k w)) ;handle this?
-                (case-split (<= j i))
-                (case-split (<= 0 l))
-                (case-split (<= 0 j))
-                (case-split (<= 0 w))
-                (case-split (integerp l))
-                (case-split (integerp w))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits x k l)))
-  :hints (("Goal" :in-theory (enable setbits natp))))
-
-(defthm setbits-with-w-0
-  (equal (setbits x 0 i j y)
-         0))
-
-;add case-splits to the bitn-setbits rules?
-;why can't i prove this from bits-setbits?
-(defthm bitn-setbits-1
-  (implies (and (< k j) ;case 1
-                (< i w)
-                (<= 0 i)
-                (<= 0 j) 
-                (<= 0 k)
-                (<= j i)
-                (integerp k)
-                (integerp w)
-                (integerp i)
-                (integerp j)
-                )
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn x k))))
-
-(defthm bitn-setbits-2
-  (implies (and(<= k i) ;;case-2
-               (<= j k) ;;case-2
-               (<= 0 i)
-               (<= 0 j) 
-               (< i w)
-               (integerp k)
-               (integerp w)
-               (integerp i)
-               (integerp j)
-               )
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn y (- k j)))))
-
-(defthm bitn-setbits-3
-  (implies (and (< i k) ;;case-3
-                (< k w) ;;case-3
-;                (< i w)
-                (<= 0 i)
-                (<= 0 j) 
-                (<= j i)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp w))
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn x k))))
-
-;taking a slice of each of the lower two thirds.
-(defthm bits-setbits-4
-  (implies (and (<= k i) ;;case-4
-                (<= j k) ;;case-4
-                (< l j) ;;case-4
-                (< i w)
-                (<= 0 j)
-                (<= 0 l)
-                (integerp i)
-                (integerp j)
-                (integerp w) 
-                (acl2-numberp l) ;(integerp l)
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (cat (bits y (- k j) 0)
-                       (+ 1 k (- j))
-                       (bits x (1- j) l)
-                       (- j l))))
-  :hints (("Goal" :in-theory (enable setbits))))
-
-;taking a slice of each of the upper two thirds.
-(defthm bits-setbits-5
-    (implies (and (< i k)  ;case-5
-		  (<= l i) ;case-5
-		  (<= j l) ;case-5
-                  (< k w)  ;case-5 ;BOZO drop stuff like this?
-                  (<= 0 j)
-                  (integerp i)
-                  (integerp j)
-                  (integerp w)
-                  (acl2-numberp l) ;(integerp l)
-                  )
-	     (equal (bits (setbits x w i j y) k l)
-		    (cat (bits x k (1+ i))
-                         (+ k (- i))
-			 (bits y (- i j) (- l j))
-			 (1+ (- i l))))))
-
-;taking a slice of each of the thirds.
-;make one huge bits-setbits lemma?
-(defthm bits-setbits-6
-  (implies (and (< i k) ;;case-6
-                (< l j) ;;case-6
-                (<= j i)
-                (< k w)
-                (<= 0 l)
-                (integerp i)
-                (integerp j)
-                (acl2-numberp l) ; (integerp l)
-                (integerp w)
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (cat (bits x k (1+ i))
-                       (+ k (- i))
-                       (cat (bits y (+ i (- j)) 0)
-                            (1+ (- i j))
-                            (bits x (1- j) l)
-                            (- j l))
-                       (+ 1 i (- l))))))
-
-;prove that if (not (natp w)) setbits = 0 .
-
-;are our setbits-combine rules sufficient to cover all of the cases?
-
-;combining these adjacent ranges [i..j][k..l]
-(defthm setbits-combine
-  (implies (and (equal j (+ k 1))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l))
-                )
-  (equal (setbits (setbits x w k l y1) w i j y2)
-         (setbits x w i l (cat y2
-                                (+ 1 i (- j))
-                                y1
-                                (+ 1 k (- l))
-                                )))))
-
-(defthm setbits-combine-2
-  (implies (and (equal j (+ k 1))
-                (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l))
-                )
-  (equal (setbits (setbits x w i j y2) w k l y1)
-         (setbits x w i l (cat y2
-                                (+ 1 i (- j))
-                                y1
-                                (+ 1 k (- l))
-                                )))))
-
-(defthm setbits-combine-3
-  (implies (and (equal j (+ k 1))
-                (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l)))
-           (equal (setbits (setbits x w i j y2) w k l y1)
-                  (setbits x w i l
-                           (cat y2 (+ 1 i (- j))
-                                 y1 (+ 1 k (- l)))))))
-
-
-(defthm setbits-all
-  (implies (and (equal i (1- w))
-                (case-split (bvecp y w))
-                )
-  (equal (setbits x w i 0 y)
-         y)))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/sgn.lisp acl2-6.3/books/rtl/rel5/support/sgn.lisp
--- acl2-6.2/books/rtl/rel5/support/sgn.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/sgn.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,13 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "float"))
-
-
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0 (if (< x 0) -1 1)))
-
-(defthm sgn-of-not-rationalp
-  (implies (not (rationalp x))
-           (equal (sgn x) 0)))
diff -Nru acl2-6.2/books/rtl/rel5/support/shft.lisp acl2-6.3/books/rtl/rel5/support/shft.lisp
--- acl2-6.2/books/rtl/rel5/support/shft.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/shft.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-
-(local (include-book "../arithmetic/top"))
-
-(defund shft (x s l)
-  (declare (xargs :guard (and (integerp s) (rationalp x))))
-  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
-
-(defthm shft-nonnegative-integer-type
-  (and (integerp (shft x s l))
-       (<= 0 (shft x s l)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription shft)))
-
-(defthm shft-natp
-  (natp (shft x s n)))
-
-(defthm shft-bvecp-simple
-  (bvecp (shft x s n) n)
-  :hints (("Goal" :in-theory (enable bvecp shft))))
-
-(local (include-book "bvecp"))
-
-(defthm shft-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (shft x s n) k))
-  :hints (("Goal" :in-theory (disable shft-bvecp-simple)
-           :use shft-bvecp-simple)))
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel5/support/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel5/support/simple-loop-helpers.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,338 +0,0 @@
-(IN-PACKAGE "ACL2")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Helpers from support:
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(include-book "rtl")
-
-(local (include-book "merge"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "setbitn"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Other helpful stuff;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(DEFCONST *EXPT-2-32*
-  (EXPT 2 32))
-
-(DEFTHM BITS-31-0
-  (IMPLIES (AND (NATP I)
-                (< I *EXPT-2-32*))
-           (EQUAL (BITS I 31 0)
-                  I))
-  :HINTS (("Goal" 
-           :IN-THEORY (ENABLE bits-reduce))))
-
-(DEFTHM BVECP-BITN
-  (BVECP (BITN Y I) 1))
-
-(DEFTHM BITN-SETBITN-NOT-EQUAL
-
-; This holds without needing (CASE-SPLIT (BVECP Y 1)).
-
-  (IMPLIES (AND (NOT (EQUAL N K))
-                (CASE-SPLIT (< 0 W))
-                (CASE-SPLIT (< N W))
-                (CASE-SPLIT (< K W))
-                (CASE-SPLIT (<= 0 K))
-                (CASE-SPLIT (INTEGERP W))
-                (CASE-SPLIT (INTEGERP N))
-                (<= 0 N)
-                (CASE-SPLIT (INTEGERP K)))
-           (EQUAL (BITN (SETBITN X W N Y) K)
-                  (BITN X K)))
-  :HINTS (("GOAL" :IN-THEORY (E/D (SETBITN SETBITS)
-                                  (BITN-SETBITN BITS-N-N-REWRITE))
-           :USE ((:INSTANCE BITN-SETBITN
-                            (Y (BITS Y 0 0)))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generic theory for counting up, non-arrays
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ENCAPSULATE
- (($$LOOP_0$ADJ (Y+ I) T)
-  ($$LOOP_0$HIGH () T))
-
- (LOCAL
-  (DEFUN $$LOOP_0$HIGH () 3))
-
- (DEFTHM NATP-$$LOOP_0$HIGH
-   (AND (INTEGERP ($$LOOP_0$HIGH))
-        (<= 0 ($$LOOP_0$HIGH)))
-   :RULE-CLASSES :TYPE-PRESCRIPTION)
-
- (LOCAL
-  (DEFUN $$LOOP_0$ADJ (Y+ I)
-    (DECLARE (IGNORE I))
-    Y+))
-
- (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
-   (IMPLIES (AND (NATP I)
-                 (NATP J)
-                 (NOT (EQUAL I J))
-                 (<= I ($$LOOP_0$HIGH))
-                 (<= J ($$LOOP_0$HIGH)))
-            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
-                   (BITN Y+ J)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
-
- (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
-   (IMPLIES (AND (NATP I)
-                 (<= I ($$LOOP_0$HIGH))
-                 (NATP J)
-                 (<= J ($$LOOP_0$HIGH))
-                 (<= I J))
-            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
-                                       J)
-                         J)
-                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
-
-(DEFUN $$LOOP_0 (Y+ I)
-  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))
-                  :HINTS
-                  (("Goal" :IN-THEORY
-                    (ENABLE LOG< LOG<= LOGAND NATP1)))))
-  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
-      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
-                (+ I 1))
-      Y+))
-
-(DEFTHM BITN-$$LOOP_0
-  (IMPLIES (AND (NATP I)
-                (NATP J)
-                (<= I ($$LOOP_0$HIGH))
-                (<= J ($$LOOP_0$HIGH)))
-           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
-                  (IF (<= I J)
-                      (BITN ($$LOOP_0$ADJ Y+ J) J)
-                      (BITN Y+ J)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generic theory for counting down, non-arrays
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ENCAPSULATE
- (($$LOOP_1$ADJ (Y+ I) T)
-  ($$LOOP_1$LOW () T)
-  ($$LOOP_1$HIGH () t))
-
- (LOCAL
-  (DEFUN $$LOOP_1$LOW () 2))
-
- (LOCAL
-  (DEFUN $$LOOP_1$HIGH () 4))
-
- (DEFTHM NATP-$$LOOP_1$LOW
-   (AND (INTEGERP ($$LOOP_1$LOW))
-        (<= 0 ($$LOOP_1$LOW)))
-   :RULE-CLASSES :TYPE-PRESCRIPTION)
-
- (LOCAL
-  (DEFUN $$LOOP_1$ADJ (Y+ I)
-    (DECLARE (IGNORE I))
-    Y+))
-
- (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
-   (IMPLIES (AND (NATP I)
-                 (NATP J)
-                 (NOT (EQUAL I J))
-                 (>= I ($$LOOP_1$LOW))
-                 (>= J ($$LOOP_1$LOW))
-                 (< I ($$LOOP_1$HIGH))
-                 (< J ($$LOOP_1$HIGH)))
-            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
-                   (BITN Y+ J)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
-
- (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
-   (IMPLIES (AND (NATP I)
-                 (>= I ($$LOOP_1$low))
-                 (NATP J)
-                 (>= J ($$LOOP_1$LOW))
-                 (< I ($$LOOP_1$HIGH))
-                 (< J ($$LOOP_1$HIGH))
-                 (<= J I))
-            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
-                                       J)
-                         J)
-                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
-
-(DEFUN $$LOOP_1 (Y+ I)
-  (DECLARE (XARGS :MEASURE (NFIX (1+ I))
-                  :HINTS
-                  (("Goal" :IN-THEORY
-                    (ENABLE LOG< LOG<= LOGAND NATP1)))))
-  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
-      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
-                (- I 1))
-      Y+))
-
-(DEFTHM BITN-$$LOOP_1
-  (IMPLIES (AND (NATP I)
-                (NATP J)
-                (>= I ($$LOOP_1$LOW))
-                (>= J ($$LOOP_1$LOW))
-                (< I ($$LOOP_1$HIGH))
-                (< J ($$LOOP_1$HIGH)))
-           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
-                  (IF (>= I J)
-                      (BITN ($$LOOP_1$ADJ Y+ J) J)
-                      (BITN Y+ J))))
-  :HINTS (("Goal" :EXPAND (($$LOOP_1 Y+ 0)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generic theory for counting up, arrays
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ENCAPSULATE
- (($$LOOP_2$ADJ (Y+ I) T)
-  ($$LOOP_2$HIGH () T))
-
- (LOCAL
-  (DEFUN $$LOOP_2$HIGH () 3))
-
- (DEFTHM NATP-$$LOOP_2$HIGH
-   (AND (INTEGERP ($$LOOP_2$HIGH))
-        (<= 0 ($$LOOP_2$HIGH)))
-   :RULE-CLASSES :TYPE-PRESCRIPTION)
-
- (LOCAL
-  (DEFUN $$LOOP_2$ADJ (Y+ I)
-    (DECLARE (IGNORE I))
-    Y+))
-
- (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
-   (IMPLIES (AND (NATP I)
-                 (NATP J)
-                 (NOT (EQUAL I J))
-                 (<= I ($$LOOP_2$HIGH))
-                 (<= J ($$LOOP_2$HIGH)))
-            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
-                   (AG J Y+)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
-
- (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
-   (IMPLIES (AND (NATP I)
-                 (<= I ($$LOOP_2$HIGH))
-                 (NATP J)
-                 (<= J ($$LOOP_2$HIGH))
-                 (<= I J))
-            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
-                                       J))
-                   (AG J ($$LOOP_2$ADJ Y+ J))))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
-
-(DEFUN $$LOOP_2 (Y+ I)
-  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))
-                  :HINTS
-                  (("Goal" :IN-THEORY
-                    (ENABLE LOG< LOG<= LOGAND NATP1)))))
-  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
-      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
-                (+ I 1))
-      Y+))
-
-(DEFTHM AG-$$LOOP_2
-  (IMPLIES (AND (NATP I)
-                (NATP J)
-                (<= I ($$LOOP_2$HIGH))
-                (<= J ($$LOOP_2$HIGH)))
-           (EQUAL (AG J ($$LOOP_2 Y+ I))
-                  (IF (<= I J)
-                      (AG J ($$LOOP_2$ADJ Y+ J))
-                      (AG J Y+)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Generic theory for counting down, arrays
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(ENCAPSULATE
- (($$LOOP_3$ADJ (Y+ I) T)
-  ($$LOOP_3$LOW () T)
-  ($$LOOP_3$HIGH () t))
-
- (LOCAL
-  (DEFUN $$LOOP_3$LOW () 2))
-
- (LOCAL
-  (DEFUN $$LOOP_3$HIGH () 4))
-
- (DEFTHM NATP-$$LOOP_3$LOW
-   (AND (INTEGERP ($$LOOP_3$LOW))
-        (<= 0 ($$LOOP_3$LOW)))
-   :RULE-CLASSES :TYPE-PRESCRIPTION)
-
- (LOCAL
-  (DEFUN $$LOOP_3$ADJ (Y+ I)
-    (DECLARE (IGNORE I))
-    Y+))
-
- (DEFTHM AG-$$LOOP_3$ADJ
-   (IMPLIES (AND (NATP I)
-                 (NATP J)
-                 (NOT (EQUAL I J))
-                 (>= I ($$LOOP_3$LOW))
-                 (>= J ($$LOOP_3$LOW))
-                 (< I ($$LOOP_3$HIGH))
-                 (< J ($$LOOP_3$HIGH)))
-            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
-                   (AG J Y+)))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
-
- (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
-   (IMPLIES (AND (NATP I)
-                 (>= I ($$LOOP_3$low))
-                 (NATP J)
-                 (>= J ($$LOOP_3$low))
-                 (< I ($$LOOP_3$HIGH))
-                 (< J ($$LOOP_3$HIGH))
-                 (<= J I))
-            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
-                                       J))
-                   (AG J ($$LOOP_3$ADJ Y+ J))))
-   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
-
-(DEFUN $$LOOP_3 (Y+ I)
-  (DECLARE (XARGS :MEASURE (NFIX (1+ I))
-                  :HINTS
-                  (("Goal" :IN-THEORY
-                    (ENABLE LOG< LOG<= LOGAND NATP1)))))
-  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
-      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
-                (- I 1))
-      Y+))
-
-(DEFTHM AG-$$LOOP_3
-  (IMPLIES (AND (NATP I)
-                (NATP J)
-                (>= I ($$LOOP_3$LOW))
-                (>= J ($$LOOP_3$LOW))
-                (< I ($$LOOP_3$HIGH))
-                (< J ($$LOOP_3$HIGH)))
-           (EQUAL (AG J ($$LOOP_3 Y+ I))
-                  (IF (>= I J)
-                      (AG J ($$LOOP_3$ADJ Y+ J))
-                      (AG J Y+))))
-  :HINTS (("Goal" :EXPAND (($$LOOP_3 Y+ 0)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Miscellany
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-#| can't be uncommented since is redefined in lib/simple-loop-helpers.lisp
-(deftheory simple-loop-thy-1
-  (UNION-THEORIES
-   '(BITN-SETBITN-NOT-EQUAL
-     AG-DIFF-AS
-     BITS-31-0
-     NATP)
-   (THEORY 'MINIMAL-THEORY)))
-|#
-
-(in-theory (enable setbits))
diff -Nru acl2-6.2/books/rtl/rel5/support/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel5/support/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel5/support/simplify-model-helpers.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,83 +0,0 @@
-(in-package "ACL2")
-
-(include-book "rtl")
-(local (include-book "bits"))
-
-(local (in-theory (enable lnot bvecp log=)))
-
-(defthm equal-log=-0
-  (equal (equal (log= k x)
-                0)
-         (not (equal k x))))
-
-(defthm equal-log=-1 ; possibly not needed
-  (equal (equal (log= k x)
-                1)
-         (equal k x)))
-
-(defthm equal-lnot-0
-  (implies (bvecp x 1)
-           (equal (equal (lnot x 1) 0)
-                  (equal x 1))))
-
-(defthm equal-lnot-1 ; possibly not needed
-  (implies (bvecp x 1)
-           (equal (equal (lnot x 1) 1)
-                  (equal x 0)))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-(defthm bits-if
-  (equal (bits (if x y z) i j)
-         (if x (bits y i j) (bits z i j))))
-
-(defthm bitn-if
-  (equal (bitn (if x y z) i)
-         (if x (bitn y i) (bitn z i))))
-
-(defthm bits-if1
-  (equal (bits (if1 x y z) i j)
-         (if1 x (bits y i j) (bits z i j)))
-  :hints (("Goal" :in-theory (enable if1))))
-
-(defthm bitn-if1
-  (equal (bitn (if1 x y z) i)
-         (if1 x (bitn y i) (bitn z i)))
-  :hints (("Goal" :in-theory (enable if1))))
-
-(defthm log=-0-rewrite
-  (implies (bvecp k 1)
-           (equal (log= 0 k)
-                  (lnot k 1)))
-  :hints (("Goal" :in-theory (enable log=))))
-
-(defthm log=-1-rewrite
-  (implies (bvecp k 1)
-           (equal (log= 1 k)
-                  k))
-  :hints (("Goal" :in-theory (enable log=))))
-
-(defthm log<>-is-lnot-log=
-  (equal (log<> x y) (lnot (log= x y) 1))
-  :hints (("Goal" :in-theory (enable log<>))))
-
-(local (include-book "cat"))
-
-(defthm cat-combine-constants
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep m)
-                              (quotep y)
-                              (quotep n)))
-                (equal (+ n p) r)
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 p))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                )
-           (equal (cat x m (cat y n z p) r)
-                  (cat (cat x m y n) (+ m n) z p))))
-
-(defthm bvecp-if
-  (equal (bvecp (if test x y) k)
-         (if test (bvecp x k) (bvecp y k))))
diff -Nru acl2-6.2/books/rtl/rel5/support/stick-proofs.lisp acl2-6.3/books/rtl/rel5/support/stick-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/stick-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/stick-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1521 +0,0 @@
-(in-package "ACL2")
-
-(include-book "merge") ;try removing?
-(include-book "land0")
-(include-book "lior0")
-(include-book "lxor0")
-
-(local (include-book "../arithmetic/top"))
-(local (include-book "bvecp"))
-(local (include-book "bits"))
-(local (include-book "bitn"))
-(local (include-book "lnot"))
-
-
-(local (in-theory (disable fl-def-linear; mod-equal
-                           )))
-
-;(local (in-theory (enable expt-inverse))) ;BOZO
-
-(defund sigm-0 (a b c n)
-  (if (= c 0)
-      (lnot (lxor0 a b n) n)
-    (lxor0 a b n)))
-
-(defund KAP-0 (a b c n)
-  (if (= c 0)
-      (* 2 (lior0 a b n))
-    (* 2 (land0 a b n))))
-
-;why n+1 instead of n twice below?
-(defund TAU-0 (a b c n)
-  (lnot (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (1+ n)) (1+ n)))
-
-(defthm bvecp-sigm-0
-  (bvecp (sigm-0 a b c n) n)
-  :hints (("Goal" :in-theory (enable sigm-0)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm-0 a b c n)))))
-
-(defthm bvecp-kap-0
-    (implies (and (integerp n)
-                  (<= 0 n)
-                  )
-	     (bvecp (kap-0 a b c n) (1+ n)))
-  :hints (("Goal" :in-theory (enable kap-0)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap-0 a b c n)))))
-
-(defthm bvecp-tau-0
-  (bvecp (tau-0 a b c n) (1+ n))
-  :hints (("Goal" :in-theory (enable tau-0)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau-0 a b c n)))))
-
-
-(defthm SIGM-0-BNDS
-  (implies (and (integerp n)
-                (>= n 0)
-                )
-           (and (integerp (sigm-0 a b c n))
-                (>= (sigm-0 a b c n) 0)
-                (< (sigm-0 a b c n) (expt 2 n))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sigm-0))))
-
-
-(defthm KAP-0-BNDS
-  (implies (and (integerp n)
-                (>= n 0)
-                )
-           (and (integerp (kap-0 a b c n))
-                (>= (kap-0 a b c n) 0)
-                (< (kap-0 a b c n) (expt 2 (1+ n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable kap-0 expt-split ))))
-
-(defthm TAU-0-BNDS
-    (implies (and (integerp n)
-		  (>= n 0)
-                  )
-	     (and (integerp (tau-0 a b c n))
-		  (>= (tau-0 a b c n) 0)
-		  (< (tau-0 a b c n) (expt 2 (1+ n)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable tau-0))))
-
-
-
-(local (defthm top-1
-         (implies (and (integerp n)
-                       (>= n 0)
-                       (integerp k)
-                       (>= k 0)
-                       (<= k n)
-;(or (equal c 0) (equal c 1))
-                       )
-                  (not (equal (bitn (tau-0 a b c n) k)
-                              (bitn (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (+ 1 n)) k))))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (enable tau-0)
-		  :use (sigm-0-bnds
-			kap-0-bnds
-			(:instance bitn-lnot-not-equal (x (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (+ 1 n))) (n (1+ n)))
-;			(:instance logxor<2**n (x (osigm a b c n)) (y (okap a b c)) (n (1+ n)))
-;			(:instance logxor-nat (i (osigm a b c n)) (j (okap a b c)))
-                        )))))
-
-(local (in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)))
-
-(local (defthm top-2
-         (implies (and (integerp n)
-                       (>= n 0)
-
-                       (integerp k)
-                       (>= k 0)
-                       (<= k n)
-                       )
-                  (iff (equal (bitn (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (+ 1 n)) k)
-                              (bitn (sigm-0 a b c n) k))
-                       (equal (bitn (kap-0 a b c n) k)
-                              0)))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
-		  :use (sigm-0-bnds
-			kap-0-bnds
-			(:instance bitn-0-1 (x (sigm-0 a b c n)) (n k))
-			(:instance bitn-0-1 (x (kap-0 a b c n)) (n k))
-;			(:instance bitn-logxor (x (osigm a b c n)) (y (okap a b c)) (n k))
-                        )))))
-
-(local (defthm top-3
-         (implies (and (integerp n)
-                       (>= n 0)
-                       (integerp k)
-                       (>= k 0)
-                       (<= k n)
-                       )
-                  (iff (equal (bitn (tau-0 a b c n) k)
-                              (bitn (sigm-0 a b c n) k))
-                       (equal (bitn (kap-0 a b c n) k)
-                              1)))
-         :rule-classes ()
-         :hints (("Goal" ; :in-theory (disable)
-		  :use (top-1
-			top-2
-			(:instance bitn-0-1 (x (sigm-0 a b c n)) (n k))
-			(:instance bitn-0-1 (x (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (+ 1 n))) (n k))
-			(:instance bitn-0-1 (x (kap-0 a b c n)) (n k))
-			(:instance bitn-0-1 (x (tau-0 a b c n)) (n k)))))))
-
-(local (defthm top-4
-         (equal (bitn (kap-0 a b c n) 0)
-                0)
-         :rule-classes ()
-         :hints (("Goal" :in-theory (enable kap-0)
-                  :use ((:instance bitn-plus-mult (x 0) (k (lior0 a b n)) (m 1) (n 0))
-                        (:instance bitn-plus-mult (x 0) (k (land0 a b n)) (m 1) (n 0))
-                        )))))
-
-(local (defthm top-5
-         (implies (and (integerp n)
-                       (>= n 0)
-                       )		  
-                  (not (equal (bitn (tau-0 a b c n) 0)
-                              (bitn (sigm-0 a b c n) 0))))
-         :rule-classes ()
-         :hints (("Goal" ; :in-theory (disable lnot tau-0 sigm-0 kap-0)
-		  :use (top-4
-			(:instance top-3 (k 0)))))))
-(local (defthm top-7
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (INTEGERP A)
-		  (INTEGERP B)
-                  )
-	     (IFF (equal (bitn (+ A B) 0) 0)
-		  (equal (bitn (TAU-0 A B 0 N) 0) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (sigm-0) ())
-		  :use ( (:instance bitn-lxor0-0 (x a) (y b))
-			(:instance top-5 (c 0))
-;			(:instance logxor-nat (i a) (j b))
-;			(:instance logxor<2**n (x a) (y b))
-			(:instance bitn-lnot-not-equal (k 0) (x (logxor a b n)))
-			(:instance bitn-0-1 (x (tau-0 a b 0 n)) (n 0))
-			(:instance bitn-0-1 (x (sigm-0 a b 0 n)) (n 0))
-			(:instance bitn-0-1 (x (lxor0 a b n)) (n 0)))))))
-
-(local (defthm top-8
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (INTEGERP A)
-		  (INTEGERP B)
-                  )
-	     (IFF (equal (mod (+ A B) 2) 0)
-		  (equal (mod (TAU-0 A B 0 N) 2) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn-def)
-                              '())
-		  :use (top-7
-			(:instance tau-0-bnds (c 0)))))))
-
-(local
- (defthm top-9
-   (implies (and (integerp a)
-                 (integerp b)
-                 (integerp n)
-                 (<= 1 n)
-                 )
-            (not (equal (bitn (+ a b 1) 0)
-                        (bitn (lxor0 a b n) 0))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance bitn-0-1 (x a) (n 0))
-                         (:instance bitn-0-1 (x b) (n 0))
-                         
-                         (:instance bitn-logxor-0)
-                         (:instance bitn-logxor-0 (a (+ 1 a)))
-                         (:instance bitn-logxor-0 (b 1))
-                         (:instance mod-mod-2-not-equal (m (+ a b))))))))
-
-
-(local (defthm top-10
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (INTEGERP A)
-		  
-		  (INTEGERP B)
-		  )
-	     (IFF (equal (bitn (+ A B 1) 0) 0)
-		  (equal (bitn (TAU-0 A B 1 N) 0) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-negative-bit-of-integer sigm-0 kap-0)
-		  :use (top-9
-			(:instance top-5 (c 1))
-;			(:instance logxor-nat (i a) (j b))
-;			(:instance logxor<2**n (x a) (y b))
-			(:instance bitn-0-1 (x (tau-0 a b 1 n)) (n 0))
-			(:instance bitn-0-1 (x (sigm-0 a b 1 n)) (n 0))
-			(:instance bitn-0-1 (x (+ a b 1)) (n 0)))))))
-
-(local (defthm top-11
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (INTEGERP A)
-
-		  (INTEGERP B)
-)
-	     (IFF (equal (mod (+ A B 1) 2) 0)
-		  (equal (mod (TAU-0 A B 1 N) 2) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (set-difference-theories
-                              (enable bitn-def)
-                              '())
-		  :use (top-10
-			(:instance tau-0-bnds (c 1)))))))
-
-(local (defthm top-12
-    (IMPLIES (AND (INTEGERP N)
-		  (< 0 N)
-		  (INTEGERP A)
-
-		  (INTEGERP B)
-
-		  (OR (equal C 0) (equal C 1)))
-	     (IFF (equal (MOD (+ A B C) 2) 0)
-		  (equal (MOD (TAU-0 A B C N) 2) 0)))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable tau-0)
-		  :use (top-11 top-8)))))
-
-(local (defthm top-13
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (IMPLIES (AND (INTEGERP N)
-				(<= 0 N)
-				(INTEGERP A)
-				(INTEGERP B)
-				(INTEGERP (+ -1 K))
-				(<= 0 (+ -1 K))
-				(< (+ -1 K) N)
-				(OR (equal C 0) (equal C 1)))
-			   (IFF (equal (MOD (+ A B C) (EXPT 2 k))  0)
-				(equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)))
-		  (not (and (equal (MOD (+ A B C) (EXPT 2 k))  0)
-			    (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)))
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (OR (equal C 0) (equal C 1)))
-	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 (+ 1 K)))
-		     0)))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable tau-0)
-		  :use (tau-0-bnds
-			(:instance mod-n-n+1 (a (tau-0 a b c n)) (n k))
-			(:instance mod-n-n+1 (a (+ a b c)) (n k)))))))
-
-(local (defthm top-14
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-		  (equal (bitn (+ a b c) k) (bitn (tau-0 a b c n) k))
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-
-		  (INTEGERP B)
-
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (OR (equal C 0) (equal C 1)))
-	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 (+ 1 K)))
-		     0)))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable tau-0)
-		  :use (tau-0-bnds
-			(:instance mod-n-n+1 (a (tau-0 a b c n)) (n k))
-			(:instance mod-n-n+1 (a (+ a b c)) (n k)))))))
-
-;move?
-(local (defthm top-15
-         (implies (and ;(integerp a)
-                       ;(>= a 0)
-                       (integerp k)
-                       (>= k 0))
-                  (equal (fl (/ a (expt 2 k)))
-                         (+ (* 2 (fl (/ a (expt 2 (1+ k)))))
-                            (bitn a k))))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (e/d ( bitn-def expt) (fl/int-rewrite))
-		  :use ((:instance quot-mod (m (fl (/ a (expt 2 k)))) (n 2))
-			(:instance fl/int-rewrite (x (/ a (expt 2 k))) (n 2))
-                        )))))
-
-;move?
-(local (defthm top-16-1
-    (implies (and ;(integerp a)
-		  ;(>= a 0)
-		  (integerp k)
-		  (>= k 0))
-	     (equal (/ a (expt 2 k))
-		    (/ (+ (* (expt 2 k) (fl (/ a (expt 2 k))))
-			  (mod a (expt 2 k)))
-		       (expt 2 k))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance quot-mod (m a) (n (expt 2 k)))
-			)))))
-
-;move?
-(local (defthm top-16-2
-    (implies (and ;(integerp a)
-		  ;(>= a 0)
-		  (integerp k)
-		  (>= k 0))
-	     (equal (/ a (expt 2 k))
-		    (+ (/ (* (expt 2 k) (fl (/ a (expt 2 k)))) (expt 2 k))
-		       (/ (mod a (expt 2 k)) (expt 2 k)))))
-  :rule-classes ()
-  :hints (("Goal" :use (top-16-1)))))
-
-;move?
-(local (defthm top-16
-    (implies (and ;(integerp a)
-		  ;(>= a 0)
-		  (integerp k)
-		  (>= k 0))
-	     (equal (/ a (expt 2 k))
-		    (+ (fl (/ a (expt 2 k)))
-		       (/ (mod a (expt 2 k)) (expt 2 k)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable a15)
-           :use (top-16-2)))))
-
-;move?
-(local (defthm top-17
-    (implies (and ;(integerp a)
-		  ;(>= a 0)
-		  (integerp k)
-		  (>= k 0))
-	     (equal (/ a (expt 2 k))
-		(+ (* 2 (fl (/ a (expt 2 (1+ k)))))
-		   (bitn a k)
-		   (/ (mod a (expt 2 k)) (expt 2 k)))))
-  :rule-classes ()
-  :hints (("Goal" :use (top-15
-			top-16
-)))))
-
-(local
- (defthm top-18
-   (IMPLIES (AND (INTEGERP K) 
-                 (< 0 K)
-                 (equal (MOD (+ A B C) (EXPT 2 k))  0)
-                 (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-                 (INTEGERP N)
-                 (<= 0 N)
-                 (INTEGERP A)
-;		  (<= 0 A)
-;	  (< A (EXPT 2 N))
-                 (INTEGERP B)
-;  (<= 0 B)
-; (< B (EXPT 2 N))
-                 (INTEGERP K)
-                 (<= 0 K)
-                 (< K N)
-;(OR (equal C 0) (equal C 1))
-                 )
-            (equal (/ (+ a b c) (expt 2 k))
-                   (+ (bitn a k)
-                      (bitn b k)
-                      (* 2 (fl (/ a (expt 2 (1+ k)))))
-                      (* 2 (fl (/ b (expt 2 (1+ k)))))
-                      (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-                         (expt 2 k)))))
-   :rule-classes ()
-   :hints (("Goal" :use ((:instance top-17)
-                         (:instance top-17 (a b)))))))
-
-(local
- (defthm top-19
-   (IMPLIES (AND (INTEGERP K) 
-                 (< 0 K)
-                 (equal (MOD (+ A B C) (EXPT 2 k))  0)
-                 (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-                 (INTEGERP N)
-                 (<= 0 N)
-                 (INTEGERP A)
-;                 (<= 0 A)
- ;                (< A (EXPT 2 N))
-                 (INTEGERP B)
-  ;               (<= 0 B)
-   ;              (< B (EXPT 2 N))
-                 (INTEGERP K)
-                 (<= 0 K)
-                 (< K N)
-                 (rationalp c);                 (OR (equal C 0) (equal C 1))
-                 )
-            (equal (fl (/ (+ a b c) (expt 2 k)))
-               (+ (bitn a k)
-                  (bitn b k)
-                  (* 2 (fl (/ a (expt 2 (1+ k)))))
-                  (* 2 (fl (/ b (expt 2 (1+ k)))))
-                  (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-                         (expt 2 k))))))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (e/d (expt-inverse
-                                    ;expt-split
-                                    ;expt-minus
-                                    ) ( fl+int-rewrite expo-shift-general))
-            :use ((:instance top-18)
-                  (:instance fl+int-rewrite
-                             (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-                                   (expt 2 k)))
-                             (n (+ (bitn a k)
-                                   (bitn b k)
-                                   (* 2 (fl (/ a (expt 2 (1+ k)))))
-                                   (* 2 (fl (/ b (expt 2 (1+ k)))))))))))))
-;slow!
-;drop?
-(local (defthm top-20
-    (IMPLIES (AND (INTEGERP K) 
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP K)
-		  (<= 0 K)
-                  )
-	     (equal (mod (+ (bitn a k)
-			(bitn b k)
-			(* 2 (fl (/ a (expt 2 (1+ k)))))
-			(* 2 (fl (/ b (expt 2 (1+ k)))))
-			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-			       (expt 2 k))))
-		     2)
-		(mod (+ (bitn a k)
-			(bitn b k)
-			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-			       (expt 2 k))))
-		     2)))
-    :hints (("Goal" :in-theory (disable MOD-DOES-NOTHING ;the disables are just for efficiency
-                                        FL-DEF-LINEAR-PART-2
-                                        FL-DEF-LINEAR-PART-1
-                                        ;MOD-EQUAL
-                                        MOD-QUOTIENT-INTEGERP
-                                        MOD-BND-1)))
-    :rule-classes ()))
-
-(local (defthm top-21
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (rationalp c) ;(OR (equal C 0) (equal C 1))
-                  )
-	     (equal (mod (fl (/ (+ a b c) (expt 2 k))) 2)
-		(mod (+ (bitn a k)
-			(bitn b k)
-			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-			       (expt 2 k))))
-		     2)))
-  :rule-classes ()
-  :hints (("Goal" :hands-off (mod bitn fl expt)
-		  :use (top-19 top-20)))))
-
-;move?
-(local (defthm top-23
-    (implies (and; (integerp a)
-;		  (integerp b)
-		  (integerp k)
-;		  (>= a 0)
-	;	  (>= b 0)
-		  (>= k 0)
-                  (integerp n)
-                  (<= 0 n)
-                  (< k n)
-                  )
-	     (equal (bitn (lxor0 a b n) k)
-		(mod (+ (bitn a k) (bitn b k)) 2)))
-  :rule-classes ()
-  :hints (("Goal" :use (;(:instance bitn-logxor (x a) (y b) (n k))
-			(:instance bitn-0-1 (x a) (n k))
-			(:instance bitn-0-1 (x b) (n k)))))))
-
-(local (defthm top-22
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (rationalp c) ;(OR (equal C 0) (equal C 1))
-                  )
-	     (equal (bitn (+ a b c) k)
-		(mod (+ (bitn a k)
-			(bitn b k)
-			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-			       (expt 2 k))))
-		     2)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-def)
-		  :use (top-21)))))
-
-
-
-(local (defthm top-24
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (rationalp c) ;(OR (equal C 0) (equal C 1))
-                  )
-	     (iff (equal (bitn (+ a b c) k)
-		     (mod (+ (bitn a k) (bitn b k)) 2))
-		  (equal (mod (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-				 (expt 2 k)))
-			  2)
-		     0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable INTEGERP-PROD ;some of the disables are for efficiency
-                                      BITN-UPPER-BOUND-LINEAR
-                                      BITN-IN-SUM-SPLIT-CASES
-                                      ;BITN-NONNEGATIVE-INTEGER-TYPE
-                                      BITN-<=-1
-                                      MOD-QUOTIENT-INTEGERP
-                                      FL-DEF-LINEAR-PART-1
-                                      FL-DEF-LINEAR-PART-2
-                                      ;MOD-EQUAL
-                                      FL-NON-NEGATIVE-LINEAR
-                                      NONNEG-+-TYPE
-                                      )
-           :use (top-22)))))
-
-(local (defthm top-25
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-;		  (<= 0 A)
-	;	  (< A (EXPT 2 N))
-		  (INTEGERP B)
-		;  (<= 0 B)
-		 ; (< B (EXPT 2 N))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (rationalp c);(OR (equal C 0) (equal C 1))
-                  )
-	     (iff (equal (bitn (+ a b c) k)
-		     (bitn (lxor0 a b n) k))
-		  (equal (mod (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-				 (expt 2 k)))
-			  2)
-		     0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (;expt-inverse
-                                   expt-minus
-                                   expt-split
-                                   ) (;expo-shift-general
-                                      ))
-           :use (top-24 top-23)))))
-
-(local (defthm top-26
-    (implies (and (integerp a)
-		  (integerp b) 
-		  (integerp k)
-		  (>= k 0)
-		  (or (equal c 0) (equal c 1)))
-	     (< (+ (mod a (expt 2 k))
-		   (mod b (expt 2 k))
-		   c)
-		(expt 2 (1+ k))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable  expt-split)
-           :use ()))))
-
-(local (defthm top-27
-    (implies (and (integerp a)
-;		  (>= a 0)
-		  (integerp b) 
-	;	  (>= b 0)
-		  (integerp k)
-		  (>= k 0)
-		  (or (equal c 0) (equal c 1)))
-	     (< (/ (+ (mod a (expt 2 k))
-		      (mod b (expt 2 k))
-		      c)
-		   (expt 2 k))
-		2))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable  a15)
-           :use (top-26
-			(:instance *-strongly-monotonic
-				   (x (expt 2 (- k)))
-				   (y (+ (mod a (expt 2 k))
-					 (mod b (expt 2 k))
-					 c))
-				   (y+ (expt 2 (1+ k)))))))))
-
-(local (defthm top-28
-    (implies (and (integerp a)
-;		  (>= a 0)
-		  (integerp b) 
-	;	  (>= b 0)
-		  (integerp k)
-		  (>= k 0)
-		  (or (equal c 0) (equal c 1)))
-	     (< (fl (/ (+ (mod a (expt 2 k))
-			  (mod b (expt 2 k))
-			  c)
-		       (expt 2 k)))
-		2))
-  :rule-classes ()
-  :hints (("Goal" :use (top-27
-			(:instance fl-def-linear (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k)))))))))
-
-(local (defthm top-29
-    (implies (and (integerp a)
-;		  (>= a 0)
-		  (integerp b) 
-	;	  (>= b 0)
-		  (integerp k)
-		  (>= k 0)
-		  (or (equal c 0) (equal c 1)))
-	     (>= (fl (/ (+ (mod a (expt 2 k))
-			   (mod b (expt 2 k))
-			   c)
-			(expt 2 k)))
-		 0))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance n<=fl-linear
-				   (n 0) 
-				   (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k))))
-;			(:instance mod>=0 (m a) (n (expt 2 k)))
-	;		(:instance mod>=0 (m b) (n (expt 2 k)))
-                        )))))
-
-(local (defthm top-30
-    (implies (and (integerp a)
-;		  (>= a 0)
-		  (integerp b) 
-	;	  (>= b 0)
-		  (integerp k)
-		  (>= k 0)
-		  (or (equal c 0) (equal c 1))
-                  )
-	     (equal (mod (fl (/ (+ (mod a (expt 2 k))
-			       (mod b (expt 2 k))
-			       c)
-			    (expt 2 k)))
-		     2)
-		(fl (/ (+ (mod a (expt 2 k))
-			  (mod b (expt 2 k))
-			  c)
-		       (expt 2 k)))))
-  :rule-classes ()
-  :hints (("Goal" :use (top-28
-			top-29
-			(:instance mod-does-nothing
-				   (m (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k))))
-				   (n 2)))))))
-
-(local (defthm top-31
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-;		  (<= 0 A)
-		  ;(< A (EXPT 2 N))
-		  (INTEGERP B)
-	;	  (<= 0 B)
-		  ;(< B (EXPT 2 N))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (OR (equal C 0) (equal C 1))
-                  )
-	     (iff (equal (bitn (+ a b c) k)
-		     (bitn (lxor0 a b n) k))
-		  (equal (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-			    (expt 2 k)))
-		     0)))
-  :rule-classes ()
-  :hints (("Goal"  :in-theory (e/d (;expt-inverse
-                                    )
-                                   ;; MattK: The following disable is needed by
-                                   ;; v2-8-alpha-12-30-03.  I didn't
-                                   ;; investigate why.
-                                   (FL-INTEGER-TYPE)) 
-           :use (top-25 top-30)))))
-
-(local (defthm top-32
-    (implies (and (rationalp x)
-		  (>= (fl x) 0))
-	     (iff (equal (fl x) 0) (< x 1)))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance fl-unique (n 0))
-			(:instance fl-def-linear))))))
-
-(local (defthm top-33
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-;		  (<= 0 A)
-	;	  (< A (EXPT 2 N))
-		  (INTEGERP B)
-		;  (<= 0 B)
-		 ; (< B (EXPT 2 N))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (OR (equal C 0) (equal C 1)))
-	     (iff (equal (bitn (+ a b c) k)
-		     (bitn (lxor0 a b n) k))
-		  (< (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-			(expt 2 k))
-		     1)))
-  :rule-classes ()
-  :hints (("Goal" :use (top-31 
-			top-29
-			(:instance top-32 (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k)))))))))
-
-(local (defthm top-34
-         (IMPLIES (AND (INTEGERP K) 
-                       (< 0 K)
-                       (equal (MOD (+ A B C) (EXPT 2 k))  0)
-                       (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-                       (INTEGERP N)
-                       (<= 0 N)
-                       (INTEGERP A)
-;	  (<= 0 A)
-;		  (< A (EXPT 2 N))
-                       (INTEGERP B)
-;  (<= 0 B)
-; (< B (EXPT 2 N))
-                       (INTEGERP K)
-                       (<= 0 K)
-                       (< K N)
-                       (OR (equal C 0) (equal C 1)))
-                  (iff (equal (bitn (+ a b c) k)
-                              (bitn (lxor0 a b n) k))
-                       (< (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-                          (expt 2 k))))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (enable a15)
-                  :use (top-33
-			(:instance *-strongly-monotonic
-				   (x (expt 2 (- k)))
-				   (y (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c))
-				   (y+ (expt 2 k)))
-			(:instance *-strongly-monotonic
-				   (x (expt 2 k))
-				   (y (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
-					 (expt 2 k)))
-				   (y+ 1)))))))
-
-(local (defthm top-35
-         (implies (and (integerp n)
-                       (>= n 0)
-                       (integerp a)
-;		  (>= a 0)
-;	  (< a (expt 2 n))
-                       (integerp b)
-;  (>= b 0)
-; (< b (expt 2 n))
-                       (integerp k)
-                       (> k 0)
-                       (<= k n))
-                  (iff (equal (bitn (kap-0 a b 0 n) k) 0)
-                       (and (equal (bitn a (1- k)) 0)
-                            (equal (bitn b (1- k)) 0))))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (enable kap-0)
-                  :use ((:instance bitn-shift (k 1) (n (1- k)) (x (logior a b)))
-			(:instance bitn-0-1 (x a) (n (1- k)))
-			(:instance bitn-0-1 (x b) (n (1- k)))
-;			(:instance bit-dist-b (x a) (y b) (n (1- k)))
-                        )))))
-
-(local (defthm top-36
-         (implies (and (rationalp a) ;(integerp a)
-;(>= a 0)
-                       (integerp k)
-                       (> k 0))
-                  (iff (equal (bitn a (1- k)) 0)
-                       (< (mod a (expt 2 k)) (expt 2 (1- k)))))
-         :rule-classes ()
-         :hints (("Goal" :in-theory (enable bitn-mod)
-                  :use ( ;(:instance bitn-mod (x a) (n k) (k (1- k)))
-;			(:instance mod>=0 (m a) (n (expt 2 k)))
-			(:instance mod-bnd-1 (m a) (n (expt 2 k)))
-			(:instance bit-expo-a (x (mod a (expt 2 k))) (n (1- k)))
-			(:instance bit-expo-b (x (mod a (expt 2 k))) (n (1- k))))))))
-
-(local (defthm top-37
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp a)
-;		  (>= a 0)
-	;	  (< a (expt 2 n))
-		  (integerp b)
-		;  (>= b 0)
-		 ; (< b (expt 2 n))
-		  (integerp k)
-		  (> k 0)
-		  (<= k n)
-		  (equal (bitn (kap-0 a b 0 n) k) 0))
-	     (< (+ (mod a (expt 2 k))
-		   (mod b (expt 2 k)))
-		(expt 2 k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split)
-           :use (top-35
-                 top-36
-                 (:instance top-36 (a b)))))))
-
-(local (defthm top-38
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp a)
-;		  (>= a 0)
-	;	  (< a (expt 2 n))
-		  (integerp b)
-		;  (>= b 0)
-		 ; (< b (expt 2 n))
-		  (integerp k)
-		  (> k 0)
-		  (<= k n)
-		  (not (equal (bitn (kap-0 a b 0 n) k) 0)))
-	     (>= (+ (mod a (expt 2 k))
-		    (mod b (expt 2 k)))
-		 (expt 2 (1- k))))
-  :rule-classes ()
-  :hints (("Goal" :use (top-35
-			top-36
-			(:instance top-36 (a b))
-;			(:instance mod>=0 (m a) (n (expt 2 k)))
-	;		(:instance mod>=0 (m b) (n (expt 2 k)))
-                        )))))
-
-(local (defthm top-39
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp a)
-;		  (>= a 0)
-		  (equal (mod (+ a b) (expt 2 k)) 0)
-	;	  (< a (expt 2 n))
-		  (integerp b)
-		;  (>= b 0)
-		 ; (< b (expt 2 n))
-		  (integerp k)
-		  (> k 0)
-		  (<= k n)
-		  (not (equal (bitn (kap-0 a b 0 n) k) 0)))
-	     (>= (+ (mod a (expt 2 k))
-		    (mod b (expt 2 k)))
-		 (expt 2 k)))
-  :rule-classes ()
-  :hints (("Goal" :use (top-38
-			(:instance mod-sum (n (expt 2 k)))
-;			(:instance mod>=0 (m a) (n (expt 2 k)))
-	;		(:instance mod>=0 (m b) (n (expt 2 k)))
-			(:instance mod-sum (a (mod b (expt 2 k))) (b a) (n (expt 2 k)))
-			(:instance mod-does-nothing (m (+ (mod a (expt 2 k)) (mod b (expt 2 k))))
-                                   (n (expt 2 k))))))))
-
-(local (defthm top-40
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp a)
-;		  (>= a 0)
-		  (equal (mod (+ a b) (expt 2 k)) 0)
-	;	  (< a (expt 2 n))
-		  (integerp b)
-		;  (>= b 0)
-		 ; (< b (expt 2 n))
-		  (integerp k)
-		  (> k 0)
-		  (<= k n))
-	     (iff (equal (bitn (kap-0 a b 0 n) k) 0)
-		  (< (+ (mod a (expt 2 k))
-			(mod b (expt 2 k)))
-		     (expt 2 k))))
-  :rule-classes ()
-  :hints (("Goal" :use (top-39 top-37)))))
-
-(local (defthm top-41
-         (IMPLIES (AND (INTEGERP K) 
-                       (< 0 K)
-                       (equal (MOD (+ A B) (EXPT 2 k))  0)
-                       (equal (MOD (TAU-0 A B 0 N) (EXPT 2 k)) 0)
-                       (INTEGERP N)
-                       (<= 0 N)
-                       (INTEGERP A)
-;		  (<= 0 A)
-;	  (< A (EXPT 2 N))
-                       (INTEGERP B)
-; (<= 0 B)
-;  (< B (EXPT 2 N))
-                       (INTEGERP K)
-                       (<= 0 K)
-                       (< K N))
-                  (iff (equal (bitn (+ a b) k)
-                              (bitn (lxor0 a b n) k))
-                       (equal (bitn (kap-0 a b 0 n) k)
-                              0)))
-         :rule-classes ()
-         :hints (("Goal" :use ((:instance top-34 (c 0)) top-40)))))
-
-(local (defthm top-42
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B 0 N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-		  (INTEGERP B)
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N))
-	     (equal (bitn (+ a b) k) (bitn (tau-0 a b 0 n) k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (sigm-0) ())
-		  :use (top-41
-			(:instance top-3 (c 0))
-			(:instance bitn-0-1 (x (kap-0 a b 0 n)) (n k))
-			(:instance bitn-0-1 (x (lxor0 a b n)) (n k))
-			(:instance bitn-0-1 (x (sigm-0 a b 0 n)) (n k))
-			(:instance bitn-0-1 (x (tau-0 a b 0 n)) (n k))
-			(:instance bitn-0-1 (x (+ a b)) (n k))
-			(:instance bitn-lnot-not-equal (x (lxor0 a b n)))
-;			(:instance logxor<2**n (x a) (y b))
-;			(:instance logxor-nat (i a) (j b))
-                        )))))
-
-(local
- (defthm top-43
-   (IMPLIES (AND (INTEGERP K) 
-                 (< 0 K)
-                 (equal (MOD (+ A B 1) (EXPT 2 k))  0)
-                 (equal (MOD (TAU-0 A B 1 N) (EXPT 2 k)) 0)
-                 (INTEGERP N)
-                 (<= 0 N)
-                 (INTEGERP A)
-;		  (<= 0 A)
-;	  (< A (EXPT 2 N))
-                 (INTEGERP B)
-;  (<= 0 B)
-; (< B (EXPT 2 N))
-                 (INTEGERP K)
-                 (<= 0 K)
-                 (< K N))
-            (equal (+ (mod a (expt 2 k))
-                      (mod b (expt 2 k))
-                      1)
-                   (expt 2 k)))
-   :rule-classes ()
-   :hints (("Goal" :in-theory (disable MOD-SUMS-CANCEL-1)
-            :use ((:instance top-26 (c 1))
-                  (:instance mod-must-be-n
-                             (m (+ (mod a (expt 2 k)) (mod b (expt 2 k)) 1))
-                             (n (expt 2 k)))
-;			(:instance mod>=0 (n (expt 2 k)) (m a))
-;		(:instance mod>=0 (n (expt 2 k)) (m b))
-                  (:instance mod-sum (n (expt 2 k)) (a (+ (mod a (expt 2 k)) 1)))
-                  (:instance mod-sum (n (expt 2 k)) (a (+ b 1)) (b a)))))))
-
-(local
- (defthm top-44
-   (IMPLIES (AND (INTEGERP K) 
-                 (< 0 K)
-                 (equal (MOD (+ A B 1) (EXPT 2 k))  0)
-                 (equal (MOD (TAU-0 A B 1 N) (EXPT 2 k)) 0)
-                 (INTEGERP N)
-                 (<= 0 N)
-                 (INTEGERP A)
-                 (INTEGERP B)
-                 (INTEGERP K)
-                 (<= 0 K)
-                 (< K N))
-            (not (equal (bitn (+ a b 1) k)
-                        (bitn (lxor0 a b n) k))))
-   :rule-classes ()
-   :hints (("Goal"; :in-theory (disable tau-0)
-            :use (top-43
-                  (:instance top-34 (c 1)))))))
-
-(local (defthm top-45
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp a)
-;		  (>= a 0)
-	;	  (< a (expt 2 n))
-		  (integerp b)
-		;  (>= b 0)
-		 ; (< b (expt 2 n))
-		  (integerp k)
-		  (> k 0)
-		  (<= k n))
-	     (iff (equal (bitn (kap-0 a b 1 n) k) 1)
-		  (and (equal (bitn a (1- k)) 1)
-		       (equal (bitn b (1- k)) 1))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable kap-0)
-           :use ((:instance bitn-shift (k 1) (n (1- k)) (x (land0 a b n)))
-			(:instance bitn-0-1 (x a) (n (1- k)))
-			(:instance bitn-0-1 (x b) (n (1- k)))
-                        )))))
-
-(local (defthm top-46
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp a)
-;		  (>= a 0)
-	;	  (< a (expt 2 n))
-		  (integerp b)
-		;  (>= b 0)
-		 ; (< b (expt 2 n))
-		  (integerp k)
-		  (> k 0)
-		  (<= k n)
-		  (equal (bitn (kap-0 a b 1 n) k) 1))
-	     (>= (+ (mod a (expt 2 k))
-		    (mod b (expt 2 k)))
-		 (expt 2 k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable expt-split)
-           :use (top-45
-			top-36
-			(:instance top-36 (a b)))))))
-
-(local (defthm top-47
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B 1) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B 1 N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-;		  (<= 0 A)
-	;	  (< A (EXPT 2 N))
-		  (INTEGERP B)
-		;  (<= 0 B)
-		 ; (< B (EXPT 2 N))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N))
-	     (equal (bitn (kap-0 a b 1 n) k) 0))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable tau-0)
-		  :use (top-46
-			top-43
-			(:instance bitn-0-1 (x (kap-0 a b 1 n)) (n k)))))))
-
-(local (defthm top-48
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B 1) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B 1 N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-;		  (<= 0 A)
-	;	  (< A (EXPT 2 N))
-		  (INTEGERP B)
-		;  (<= 0 B)
-		 ; (< B (EXPT 2 N))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N))
-	     (equal (bitn (+ a b 1) k) (bitn (tau-0 a b 1 n) k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d ( sigm-0) ())
-		  :use (top-47
-			top-44
-			(:instance top-3 (c 1))
-			(:instance bitn-0-1 (x (lxor0 a b n)) (n k))
-			(:instance bitn-0-1 (x (sigm-0 a b 1 n)) (n k))
-			(:instance bitn-0-1 (x (tau-0 a b 1 n)) (n k))
-			(:instance bitn-0-1 (x (+ a b 1)) (n k)))))))
-
-(local (defthm top-49
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-;		  (<= 0 A)
-	;	  (< A (EXPT 2 N))
-		  (INTEGERP B)
-		;  (<= 0 B)
-		 ; (< B (EXPT 2 N))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (OR (equal C 0) (equal C 1)))
-	     (equal (bitn (+ a b c) k) (bitn (tau-0 a b c n) k)))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable tau-0)
-		  :use (top-48 top-42)))))
-
-(local (defthm top-50
-    (IMPLIES (AND (INTEGERP K) 
-		  (< 0 K)
-		  (IMPLIES (AND (INTEGERP N)
-				(<= 0 N)
-				(INTEGERP A)
-			;	(<= 0 A)
-				;(< A (EXPT 2 N))
-				(INTEGERP B)
-				;(<= 0 B)
-				;(< B (EXPT 2 N))
-				(INTEGERP (+ -1 K))
-				(<= 0 (+ -1 K))
-				(< (+ -1 K) N)
-				(OR (equal C 0) (equal C 1)))
-			   (IFF (equal (MOD (+ A B C) (EXPT 2 k))  0)
-				(equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)))
-		  (INTEGERP N)
-		  (<= 0 N)
-		  (INTEGERP A)
-;		  (<= 0 A)
-	;	  (< A (EXPT 2 N))
-		  (INTEGERP B)
-		;  (<= 0 B)
-		 ; (< B (EXPT 2 N))
-		  (INTEGERP K)
-		  (<= 0 K)
-		  (< K N)
-		  (OR (equal C 0) (equal C 1)))
-	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
-		  (equal (MOD (TAU-0 A B C N) (EXPT 2 (+ 1 K)))
-		     0)))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable tau-0)
-		  :use (top-13 top-14 top-49)))))
-
-;local?
-(defthm STICK-LEMMA
-    (implies (and (integerp n)
-		  (>= n 0)
-		  (integerp a)
-;		  (>= a 0)
-	;	  (< a (expt 2 n))
-		  (integerp b)
-		;  (>= b 0)
-		 ; (< b (expt 2 n))
-		  (integerp k)
-		  (>= k 0)
-		  (< k n)
-		  (or (equal c 0) (equal c 1)))
-	     (iff (equal (mod (+ a b c) (expt 2 (1+ k))) 0)
-		  (equal (mod (tau-0 a b c n) (expt 2 (1+ k))) 0)))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable tau-0)
-		  :induct (natp-induct k))
-	  ("Subgoal *1/2"; :in-theory (disable tau-0)
-			  :use (top-50))
-	  ("Subgoal *1/1" :use (top-12))))
-
-
-(defthm top-thm-2-old
-  (implies (and (natp n)
-                (integerp a) ;		  (bvecp a n)
-                (integerp b) ;(bvecp b n)
-                (natp k)
-                (< k n)
-                (or (equal c 0) (equal c 1)))
-           (equal (equal (bits (+ a b c) k 0) 0)
-                  (equal (bits (tau-0 a b c n) k 0) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use (stick-lemma
-                 (:instance bits-mod (x (+ a b c)) (i k))
-                 (:instance bits-mod (x (tau-0 a b c n)) (i k))))))
-
-
-;BOZO prove a bits thm to make this go through
-(local (defthm stick-lemma-3-1
-    (implies (and (integerp a);(natp a)
-		  (integerp b);(natp b)
-                  (integerp k)
-;		  (natp k)
-                  )
-	     (equal (bits (+ a b 1) k 0)
-		    (bits (+ (bits a k 0)
-			     (bits b k 0)
-			     1)
-			  k 0)))
-  :rule-classes ()
-  :hints (("Goal" :use (:instance bits-sum-plus-1-original (x a) (y b) (i k) (j 0)) ;weird hint
-           ))))
-
-(local (defthm stick-lemma-3-2
-    (implies (and (natp n)
-		  (natp k)
-		  (natp j)
-		  (< k n)
-		  (<= j k)
-		  (integerp a) ;(bvecp a n)
-		  (integerp b) ;(bvecp b n)
-                  )
-	     (equal (bits (lnot (lxor0 a b n) n) k j)
-		    (lnot (lxor0 (bits a k j) (bits b k j) (1+ (- k j))) (1+ (- k j)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits-lnot bits-logxor natp bvecp-forward)))))
-
-;drop?
-(local (defthm stick-lemma-3-3
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (integerp a);(bvecp a n)
-		  (integerp b) ;(bvecp b n)
-                  )
-	     (equal (bitn (lnot (lxor0 a b n) n) k)
-		    (lnot (lxor0 (bitn a k) (bitn b k) 1) 1)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits-n-n-rewrite lnot-bvecp)
-		  :use ((:instance stick-lemma-3-2 (j k)))))))
-
-(local (defthm stick-lemma-3-4
-    (implies (and (natp n)
-		  (> n 0)
-		  (integerp a);(bvecp a n)
-		  (integerp b) ;(bvecp b n)
-                  )
-	     (equal (bits (+ a b 1) 0 0)
-		    (bits (lnot (lxor0 a b n) n) 0 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits-n-n-rewrite lnot-bvecp bvecp-forward)
-		  :use ((:instance stick-lemma-3-1 (k 0))
-			(:instance stick-lemma-3-2 (k 0) (j 0))
-			(:instance bitn-0-1 (x a) (n 0))
-			(:instance bitn-0-1 (x b) (n 0)))))))
-
-(local (defthm stick-lemma-3-5
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b) ;(bvecp b n)
-		  (iff (equal (bits (+ a b 1) (1- k) 0)
-			      0)
-		       (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			      0))
-		  (not (equal (bits (+ a b 1) (1- k) 0) 0)))
-	     (iff (equal (bits (+ a b 1) k 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) k 0)
-			 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable lnot-bvecp bits-n-n-rewrite)
-		  :use ((:instance bitn-plus-bits
-				   (x (lnot (lxor0 a b n) n))
-				   (n k)
-				   (m 0))
-			(:instance bitn-plus-bits
-				   (x (+ a b 1))
-				   (n k)
-				   (m 0))
-			(:instance bits-0-bitn-0
-				   (x (lnot (lxor0 a b n) n))
-				   (n k))
-			(:instance bits-0-bitn-0
-				   (x (+ a b 0))
-				   (n k)))))))
-
-
-(local (defthm stick-lemma-3-7
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b) ;(bvecp b n)
-		  (equal (bits (+ a b 1) (1- k) 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			 0))
-	     (equal (+ (bits a (1- k) 0) (bits b (1- k) 0) 1)
-		(expt 2 k)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits-mod bvecp-forward)
-		  :use (;stick-lemma-3-6
-			(:instance stick-lemma-3-1 (k (1- k)))
-			(:instance mod-must-be-n
-				   (m (+ (bits a (1- k) 0) (bits b (1- k) 0) 1))
-				   (n (expt 2 k))))))))
-
-(local (defthm stick-lemma-3-8
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b);(bvecp b n)
-		  (equal (bits (+ a b 1) (1- k) 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			 0)
-                  )
-	     (equal (bits (+ a b 1) k 0)
-		(bits (* (expt 2 k) (+ (bitn a k) (bitn b k) 1)) k 0)))
-  :rule-classes ()
-  :otf-flg t
-  :hints (("Goal" :in-theory (e/d (bits-tail bits-n-n-rewrite ) (BITS-SHIFT-BY-CONSTANT-POWER-OF-2)) ;BOZO remove disable
-           :use ((:instance bitn-plus-bits (x (+ 1 A B)) (n k) (m 0))
-                 (:instance bitn-0-1 (x a) (n k))
-                 (:instance bitn-0-1 (x b) (n k))
-                 (:instance bitn-0-1 (x (+ 1 A B)) (n k))
-                 (:instance bits-sum-plus-1-original (x a) (y b) (i k) (j k))
-                 stick-lemma-3-7
-                 )))))
-
-(local (defthm stick-lemma-3-9
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b);(bvecp b n)
-		  (equal (bits (+ a b 1) (1- k) 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			 0))
-	     (equal (bits (+ a b 1) k 0)
-		(* (expt 2 k) 
-		   (bits (+ (bitn a k) (bitn b k) 1) 0 0))))
-  :rule-classes ()
-  :hints (("Goal" :use (stick-lemma-3-8
-			(:instance bits-shift-up-2 (x (+ (bitn a k) (bitn b k) 1)) (i 0)))))))
-
-(local (defthm stick-lemma-3-10
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b);(bvecp b n)
-		  (equal (bits (+ a b 1) (1- k) 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			 0))
-	     (iff (equal (bits (+ a b 1) k 0) 0)
-		  (equal (bits (+ (bitn a k) (bitn b k) 1) 0 0) 0)))
-  :rule-classes ()
-  :hints (("Goal" :use (stick-lemma-3-9)))))
-
-(local (defthm stick-lemma-3-11
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b) ;(bvecp b n)
-		  (equal (bits (+ a b 1) (1- k) 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			 0))
-	     (iff (equal (bits (+ a b 1) k 0) 0)
-		  (equal (lnot (lxor0 (bits a k k) (bits b k k) 1) 1) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits-n-n-rewrite)
-		  :use (stick-lemma-3-10
-			(:instance bitn-0-1 (x a) (n k))
-			(:instance bitn-0-1 (x b) (n k)))))))
-
-(local (defthm stick-lemma-3-12
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b) ;(bvecp b n)
-		  (equal (bits (+ a b 1) (1- k) 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			 0))
-	     (iff (equal (bits (+ a b 1) k 0) 0)
-		  (equal (bits (lnot (lxor0 a b n) n) k k) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bits-lnot lnot-logxor bitn-lnot ;BOZO these should be enabled?
-                                     bits-logxor lnot-bvecp bitn-logxor)
-		  :use (stick-lemma-3-11)))))
-
-(local (defthm stick-lemma-3-13
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b);(bvecp b n)
-		  (equal (bits (+ a b 1) (1- k) 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			 0))
-	     (iff (equal (bits (+ a b 1) k 0) 0)
-		  (equal (bits (lnot (lxor0 a b n) n) k 0) 0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-logxor bitn-lnot bits-n-n-rewrite bits-lnot
-                                     bits-logxor lnot-bvecp)
-		  :use (stick-lemma-3-12
-			(:instance bits-0-bitn-0
-				   (x (lnot (lxor0 a b n) n))
-				   (n k)))))))
-
-(local (defthm stick-lemma-3-14
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (< 0 k)
-		  (integerp a);(bvecp a n)
-		  (integerp b) ;(bvecp b n)
-		  (iff (equal (bits (+ a b 1) (1- k) 0)
-			      0)
-		       (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
-			      0)))
-	     (iff (equal (bits (+ a b 1) k 0)
-			 0)
-		  (equal (bits (lnot (lxor0 a b n) n) k 0)
-			 0)))
-  :rule-classes ()
-  :hints (("Goal" :use (stick-lemma-3-5
-			stick-lemma-3-13)))))
-
-(defthm top-thm-1-original
-  (implies (and (natp n)
-                (natp k)
-                (< k n)
-                (integerp a) ;(bvecp a n)
-                (integerp b) ;(bvecp b n)
-                )
-           (equal (equal (bits (+ a b 1) k 0)
-                         0)
-                  (equal (bits (lnot (lxor0 a b n) n) k 0)
-                         0)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable bitn-logxor)
-           :induct (natp-induct k))
-	  ("Subgoal *1/2" :use stick-lemma-3-14)
-	  ("Subgoal *1/1" :use stick-lemma-3-4)))
-
diff -Nru acl2-6.2/books/rtl/rel5/support/stick.lisp acl2-6.3/books/rtl/rel5/support/stick.lisp
--- acl2-6.2/books/rtl/rel5/support/stick.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/stick.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,59 +0,0 @@
-(in-package "ACL2")
-
-(include-book "rtl")
-(local (include-book "stick-proofs"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-(defthm top-thm-1-original
-  (implies (and (natp n)
-                (natp k)
-                (< k n)
-                (integerp a) ;(bvecp a n)
-                (integerp b) ;(bvecp b n)
-                )
-           (equal (equal (bits (+ a b 1) k 0)
-                         0)
-		  (equal (bits (lnot (lxor0 a b n) n) k 0)
-                         0)))
-  :rule-classes ())
-
-(defund sigm-0 (a b c n)
-  (if (= c 0)
-      (lnot (lxor0 a b n) n)
-    (lxor0 a b n)))
-
-(defund kap-0 (a b c n)
-  (if (= c 0)
-      (* 2 (lior0 a b n))
-    (* 2 (land0 a b n))))
-
-(defund tau-0 (a b c n)
-  (lnot (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (1+ n)) (1+ n)))
-
-(defthm bvecp-sigm-0
-  (bvecp (sigm-0 a b c n) n)
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm-0 a b c n)))))
-
-(defthm bvecp-kap-0
-  (implies (and (integerp n) (<= 0 n))
-           (bvecp (kap-0 a b c n) (1+ n)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap-0 a b c n)))))
-
-(defthm bvecp-tau-0
-  (bvecp (tau-0 a b c n) (1+ n))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau-0 a b c n)))))
-
-(defthm top-thm-2-old
-  (implies (and (natp n)
-                (integerp a) ;(bvecp a n)
-                (integerp b) ;(bvecp b n)
-                (natp k)
-                (< k n)
-                (or (equal c 0) (equal c 1)))
-           (equal (equal (bits (+ a b c) k 0) 0)
-		  (equal (bits (tau-0 a b c n) k 0) 0)))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/support/sticky-proofs.lisp acl2-6.3/books/rtl/rel5/support/sticky-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/sticky-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/sticky-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1062 +0,0 @@
-;;;***************************************************************
-;;;an acl2 library of floating point arithmetic
-;;;david m. russinoff
-;;;advanced micro devices, inc.
-;;;february, 1998
-;;;***************************************************************
-
-(in-package "ACL2")
-
-(local (include-book "../arithmetic/arith"))
-(local (include-book "float"))
-(local (include-book "trunc"))
-(local (include-book "away"))
-(local (include-book "near"))
-(local (include-book "near+"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-(defund near+ (x n)
-  (if (< (re (* (expt 2 (1- n)) (sig x)))
-	 1/2)
-      (trunc x n)
-    (away x n)))
-
-
-;;
-;; New stuff:
-;;
-
-
-(defund sticky (x n)
-  (cond ((exactp x (1- n)) x)
-	(t (+ (trunc x (1- n))
-              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
-
-(defthm sticky-1
-  (implies (rationalp x)
-           (equal (sticky x 1)
-                  (* (sgn x) (expt 2 (expo x)))))
-  :hints (("goal" :in-theory (enable sticky)
-           :use ((:instance only-0-is-0-or-negative-exact (n 0))
-                        (:instance trunc-to-0-or-fewer-bits (n 0))))))
-
-;more rule-classes?
-(defthm sticky-pos
-    (implies (and (< 0 x) (rationalp x)
-		  (integerp n) (> n 0))
-	     (< 0 (sticky x n)))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (enable sticky)
-		  :use ((:instance trunc-to-0-or-fewer-bits (n 0))
-                        ))))
-
-(defthm sticky-shift
-    (implies (and (rationalp x)
-		  (integerp n) (> n 0)
-		  (integerp k))
-	     (= (sticky (* (expt 2 k) x) n)
-		(* (expt 2 k) (sticky x n))))		
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky a15)
-		  :use (;(:instance expt-pos (x k))
-			(:instance sig-expo-shift (n k))
-			(:instance expt-split (r 2) (i k) (j (expo x)))
-			(:instance trunc-shift (n  (1- n)))
-			(:instance exactp-shift (n (1- n)) (k k))
-			(:instance exactp-shift (n (1- n)) (k (- k)) (x (* x (expt 2 k))))))))
-
-;BOZO why isn't a5 firing here? if i comment out the (integerp n) hyp but leave the rational hyp?
-(defthm sticky-minus
-  (equal (sticky (* -1 x) n)
-         (* -1 (sticky x n)))
-  :hints (("goal" :in-theory (e/d (sgn sticky) (TRUNC-NEGATIVE-RATIONAL-TYPE-PRESCRIPTION ;prevents bad-ass problem
-                                                )))))
-
-;gen?
-(defthm sticky-exactp
-  (implies (and (rationalp x) (>= x 0)
-                (integerp n) (> n 0)
-                )
-           (exactp (sticky x n) n))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable sticky exactp-<= exactp-2**n)
-                              '( trunc-exactp-b
-                                 ))
-           :use ((:instance fp+1 (x (trunc x (1- n))))
-                 (:instance trunc-exactp-b (n  (1- n)))
-                 (:instance expo-trunc (n (1- n)))
-                 )
-           )
-          ))
-
-(defthm sticky-exactp-n-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (iff (exactp (sticky x n) (1- n))
-		  (exactp x (1- n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable sticky)
-                              '( trunc-exactp-b))
-		  :use ((:instance trunc-exactp-b (n  (1- n)))
-			(:instance expo-trunc (n (1- n)))
-			(:instance expt-strong-monotone 
-				   (n (1+ (- (expo x) n)))
-				   (m (+ 2 (- (expo x) n))))
-;			(:instance trunc-pos (n (1- n)))
-;			(:instance expt-pos (x (1+ (- (expo x) n))))
-			(:instance fp+2
-				   (y (sticky x n))
-				   (n (1- n))
-				   (x (trunc x (1- n))))
-                        ))))
-
-(local (defthm expo-sticky-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (<= (expt 2 (expo x))
-		 (sticky x n)))
-  :rule-classes ()
-  :hints (("goal" 
-           :in-theory (enable sticky)
-           :use ((:instance expo-trunc (n (1- n)))
-			(:instance expo-lower-bound (x (trunc x (1- n))))
-;			(:instance trunc-pos (n (1- n)))
-			(:instance trunc-upper-pos (n (1- n)))
-;			(:instance expt-pos (x (1+ (- (expo x) n))))
-                        )))))
-
-(local (defthm expo-sticky-2
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (<= (+ (trunc x (1- n))
-		    (expt 2 (+ 2 (- (expo x) n))))
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable trunc-exactp-b abs-trunc)
-		  :use ((:instance trunc-exactp-b (n  (1- n)))
-			(:instance expo-trunc (n (1- n)))
-			(:instance exactp-2**n (n (1+ (expo x))) (m (1- n)))
-			(:instance expo-upper-bound (x (trunc x (1- n))))
-			(:instance expo-upper-bound)
-;			(:instance trunc-pos (n (1- n)))
-;			(:instance expt-pos (x (1+ (- (expo x) n))))
-			(:instance fp+2
-				   (y (expt 2 (1+ (expo x))))
-				   (n (1- n))
-				   (x (trunc x (1- n)))))))))
-
-(local (defthm expo-sticky-3
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (< (sticky x n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable sticky)
-                              '(trunc-exactp-b))
-		  :use ((:instance expo-sticky-2)
-			(:instance expo-upper-bound)
-			(:instance expt-strong-monotone 
-				   (n (1+ (- (expo x) n)))
-				   (m (+ 2 (- (expo x) n)))))))))
-
-(local (defthm expo-sticky-4
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (= (expo (sticky x n))
-		(expo x)))
-  :rule-classes ()
-  :hints (("goal" :use (expo-sticky-1
-			expo-sticky-3
-			sticky-pos
-			(:instance expo-unique (x (sticky x n)) (n (expo x))))))))
-
-(defthm expo-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0))
-	     (= (expo (sticky x n))
-		(expo x)))
-  :rule-classes ()
-  :hints (("goal" :use (expo-sticky-4
-			expo-upper-bound
-			expo-lower-bound
-			(:instance trunc-to-0-or-fewer-bits (n 0))
-                        (:instance expo-unique (x (expt 2 (expo x))) (n (expo x)))))))
-
-(local (defthm trunc-sticky-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (= (trunc (sticky x n) (1- n))
-		(trunc x (1- n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky)
-           :use (sticky-exactp
-			expo-sticky
-			sticky-exactp-n-1
-			sticky-pos
-;			(:instance trunc-trunc (n (1- n)) (m (1- n)))
-			(:instance trunc-away-a (x (sticky x n)) (n (1- n))))))))
-
-(defthm trunc-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n m))
-	     (= (trunc (sticky x n) m)
-		(trunc x m)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable sticky trunc-trunc)
-		  :use (trunc-sticky-1
-			sticky-pos
-			(:instance trunc-trunc (n (1- n)))
-			(:instance trunc-trunc (n (1- n)) (x (sticky x n)))
-                        ))))
-
-(local (defthm away-sticky-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (exactp x (1- n))))
-	     (= (away (sticky x n) (1- n))
-		(+ (trunc x (1- n))
-		   (expt 2 (+ (expo x) 2 (- n))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky)
-           :use (sticky-exactp
-			expo-sticky
-			sticky-exactp-n-1
-			sticky-pos
-			(:instance expt-split (r 2) (i (1+ (- (expo x) n))) (j 1))
-			(:instance trunc-away-b (x (sticky x n)) (n (1- n))))))))
-
-(local (defthm away-sticky-2
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (exactp x (1- n))))
-	     (<= (+ (trunc x (1- n))
-		    (expt 2 (+ (expo x) 2 (- n))))
-		 (away x (1- n))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance fp+2 (x (trunc x (1- n))) (n (1- n)) (y (away x (1- n))))
-			(:instance away-exactp-b (n (1- n)))
-			(:instance trunc-exactp-b (n (1- n)))
-			(:instance trunc-exactp-a (n (1- n)))
-;			(:instance trunc-pos (n (1- n)))
-			(:instance trunc-upper-pos (n (1- n)))
-			(:instance away-lower-pos (n (1- n))))))))
-
-(local (defthm away-sticky-3
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (not (exactp x (1- n))))
-	     (>= (+ (trunc x (1- n))
-		    (expt 2 (+ (expo x) 2 (- n))))
-		 (away x (1- n))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance fp+1 (x (trunc x (1- n))) (n (1- n)))
-			(:instance trunc-exactp-b (n (1- n)))
-;			(:instance trunc-pos (n (1- n)))
-			(:instance trunc-diff-pos (n (1- n)))
-			(:instance away-exactp-c 
-				   (n (1- n)) 
-				   (a (+ (trunc x (1- n))
-					 (expt 2 (+ (expo x) 2 (- n)))))))))))
-
-(local (defthm away-sticky-4
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (= (away (sticky x n) (1- n))
-		(away x (1- n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky)
-           :use (away-sticky-1
-			away-sticky-2
-			away-sticky-3)))))
-
-(defthm away-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n m))
-	     (= (away (sticky x n) m)
-		(away x m)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable sticky)
-		  :use (away-sticky-4
-			sticky-pos
-			(:instance away-away (n (1- n)))
-			(:instance away-away (n (1- n)) (x (sticky x n)))))))
-
-(local (defthm near-sticky-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (<= x y)
-		  (integerp m)
-		  (> m 0)
-		  (= (trunc x (1+ m)) (trunc y (1+ m)))
-		  (not (= (near x m) (near y m))))
-	     (= x (near-witness x y m)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-near-lemma (n m))
-			(:instance trunc-upper-pos (n (1+ m)))
-			(:instance trunc-exactp-c (x y) (n (1+ m)) (a (near-witness x y m))))))))
-
-(local (defthm near-sticky-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (<= x y)
-		  (integerp m)
-		  (> m 0)
-		  (= (away x (1+ m)) (away y (1+ m)))
-		  (not (= (near x m) (near y m))))
-	     (= y (near-witness x y m)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable away-exactp-c)
-		  :use ((:instance near-near-lemma (n m))
-			(:instance away-lower-pos (x y) (n (1+ m)))
-			(:instance away-exactp-c (n (1+ m)) (a (near-witness x y m))))))))
-
-(local (defthm near-sticky-3
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< 0 y)
-		  (integerp m)
-		  (> m 0)
-		  (= (trunc x (1+ m)) (trunc y (1+ m)))
-		  (= (away x (1+ m)) (away y (1+ m))))
-	     (= (near x m) (near y m)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near-sticky-1 (x y) (y x))
-			(:instance near-sticky-2 (x y) (y x))
-			(:instance near-sticky-1)
-			(:instance near-sticky-2))))))
-
-(defthm near-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n (1+ m)))
-	     (= (near (sticky x n) m)
-		(near x m)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable sticky)
-		  :use ((:instance near-sticky-3 (y (sticky x n)))
-			(:instance trunc-sticky (m (1+ m)))
-			(:instance away-sticky (m (1+ m)))
-			sticky-pos))))
-
-(local (defthm near+-sticky-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (<= x y)
-		  (integerp m)
-		  (> m 0)
-		  (= (trunc x (1+ m)) (trunc y (1+ m)))
-		  (not (= (near+ x m) (near+ y m))))
-	     (= x (near+-witness x y m)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-near+-lemma (n m))
-			(:instance trunc-upper-pos (n (1+ m)))
-			(:instance trunc-exactp-c (x y) (n (1+ m)) (a (near+-witness x y m))))))))
-
-(local (defthm near+-sticky-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (<= x y)
-		  (integerp m)
-		  (> m 0)
-		  (= (away x (1+ m)) (away y (1+ m)))
-		  (not (= (near+ x m) (near+ y m))))
-	     (= y (near+-witness x y m)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable away-exactp-c)
-		  :use ((:instance near+-near+-lemma (n m))
-			(:instance away-lower-pos (x y) (n (1+ m)))
-			(:instance away-exactp-c (n (1+ m)) (a (near+-witness x y m))))))))
-
-(local (defthm near+-sticky-3
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< 0 y)
-		  (integerp m)
-		  (> m 0)
-		  (= (trunc x (1+ m)) (trunc y (1+ m)))
-		  (= (away x (1+ m)) (away y (1+ m))))
-	     (= (near+ x m) (near+ y m)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance near+-sticky-1 (x y) (y x))
-			(:instance near+-sticky-2 (x y) (y x))
-			(:instance near+-sticky-1)
-			(:instance near+-sticky-2))))))
-
-(defthm near+-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n (1+ m)))
-	     (= (near+ (sticky x n) m)
-		(near+ x m)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable sticky)
-		  :use ((:instance near+-sticky-3 (y (sticky x n)))
-			(:instance trunc-sticky (m (1+ m)))
-			(:instance away-sticky (m (1+ m)))
-			sticky-pos))))
-
-(local (defthm minus-trunc-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (> k 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (* (- (* x (expt 2 (- (1- k) (expo y))))
-			  (fl (* y (expt 2 (- (1- k) (expo y))))))
-		       (expt 2 (- (1+ (expo y)) k)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable trunc-rewrite)
-           :use ((:instance expt-split (r 2) (i (- (1- k) (expo y))) (j (- (1+ (expo y)) k))))))))
-
-(local (defthm minus-trunc-2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (> k 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (* (- (fl (* (- y x) (expt 2 (- (1- k) (expo y))))))
-		       (expt 2 (- (1+ (expo y)) k)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable fl+int-rewrite expo trunc-rewrite)
-		  :use ((:instance minus-trunc-1)
-			exactp2
-			(:instance fl+int-rewrite 
-				   (x (* y (expt 2 (- (1- k) (expo y)))))
-				   (n (- (* x (expt 2 (- (1- k) (expo y))))))))))))
-
-(local (defthm minus-trunc-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (> k 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (* (cg (* (- x y) (expt 2 (- (1- k) (expo y)))))
-		       (expt 2 (- (1+ (expo y)) k)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable cg)
-		  :use ((:instance minus-trunc-2))))))
-
-(defthm minus-trunc-4
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< y x)
-		  (integerp k)
-		  (> k 0)
-		  (> (+ k (- (expo (- x y)) (expo y))) 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable away-rewrite)
-           :use ((:instance minus-trunc-3)))))
-
-(defthm minus-trunc-5
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< x y)
-		  (integerp k)
-		  (> k 0)
-		  (> (+ k (- (expo (- x y)) (expo y))) 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable trunc-rewrite)
-                              '( expo-minus))
-           :use ((:instance minus-trunc-2)
-                 (:instance expo-minus (x (- x y)))))))
-
-(local (defthm sticky-plus-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (iff (exactp y (1- k))
-		  (exactp (+ x y) (1- k2))))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance exactp2 (n (1- k1)))
-			(:instance exactp2 (x y) (n (1- k)))
-			(:instance exactp2 (x (+ x y)) (n (1- k2))))))))
-
-(local (defthm sticky-plus-2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (exactp y (1- k))
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky)
-           :use ((:instance sticky-plus-1))))))
-
-(local (defthm sticky-plus-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (not (exactp y (1- k)))
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky)
-           :use (sticky-plus-1
-			(:instance plus-trunc (k (1- k))))))))
-
-(defthm sticky-plus
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ()
-  :hints (("goal" :use (sticky-plus-2 sticky-plus-3))))
-
-(local (defthm hack1
-    (implies (and (integerp x)
-		  (integerp y))
-	     (integerp (- x y)))
-  :rule-classes ()))
-
-(local (defthm shack2
-    (implies (and (rationalp x) (rationalp y))
-	     (equal (+ x (* -1 (+ x (* -1 y))))
-		    y))
-  :rule-classes ()))
-
-(local (defthm shack3
-    (implies (and (integerp x)
-		  (rationalp y)
-		  (integerp (- x y)))
-	     (integerp y))
-  :rule-classes ()
-  :hints (("goal" :use (shack2 (:instance hack1 (y (- x y))))))))
-
-(local (defthm minus-sticky-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (iff (exactp y (1- k))
-		  (exactp (- x y) (1- k2))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable exactp2)
-		  :use ((:instance expo-minus (x y))
-			(:instance shack3
-				   (x (* x (expt 2 (+ -2 k (* -1 (expo (* -1 y)))))))
-				   (y (* y (expt 2 (+ -2 k (* -1 (expo (* -1 y)))))))))))))
-
-(local (defthm minus-sticky-2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (exactp y (1- k))
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (- x (sticky y k))
-		(sticky (- x y) k2)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky)
-           :use ((:instance minus-sticky-1))))))
-
-(local (defthm minus-sticky-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< x y)
-		  (not (exactp y (1- k)))
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (- x (sticky y k))
-		(- (sticky (- y x) k2))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable exactp2 sticky trunc-rewrite a15)
-                              '(expo-minus))
-		  :use ((:instance minus-sticky-1)
-			(:instance expo-minus (x (- x y)))
-			(:instance minus-trunc-5 (n (+ k (- (expo x) (expo y)))) (k (1- k))))))))
-
-(local (defthm minus-sticky-4
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< y x)
-		  (not (exactp y (1- k)))
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (- x (sticky y k))
-		(- (away (- x y) (1- k2))
-		   (expt 2 (1+ (- (expo (- x y)) k2))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky)
-           :use ((:instance minus-sticky-1)
-			(:instance minus-trunc-4 (n (+ -1 k (- (expo x) (expo y)))) (k (1- k))))))))
-
-(defthm trunc-away
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n)))
-	     (= (away x n)
-		(+ (trunc x n)
-		   (expt 2 (+ (expo x) 1 (- n))))))		
-  :rule-classes ()
-  :hints (("goal" :use ((:instance away-sticky-2 (n (1+ n)))
-			(:instance away-sticky-3 (n (1+ n)))))))
-
-(local (defthm minus-sticky-5
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< y x)
-		  (not (exactp y (1- k)))
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (- x (sticky y k))
-		(sticky (- x y) k2)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable sticky)
-           :use ((:instance minus-sticky-4)
-			(:instance minus-sticky-1)
-			(:instance trunc-away (x (- x y)) (n (1- k2)))
-			(:instance expt-split (r 2) (i (1+ (- (expo (- x y)) k2))) (j 1)))))))
-
-
-
-
-(local (defthm minus-sticky-6
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (not (= y x))
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (- x (sticky y k))
-		(sticky (- x y) k2)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable sticky sticky-minus)
-		  :use ((:instance minus-sticky-2)
-			(:instance minus-sticky-3)
-			(:instance sticky-minus (x (- x y)) (n k2))
-			(:instance minus-sticky-5))))))
-
-(defthm sticky-0
-  (equal (sticky 0 n) 0)
-  :hints (("Goal" :in-theory (enable sticky trunc))))
-
-(local (defthm minus-sticky-7
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k2 1)
-		  (exactp x (1- k)))
-	     (= (- x (sticky x k))
-		(sticky 0 k2)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sticky)
-          :use ((:instance sticky-0 (n k2)))))))
-
-(defthm minus-sticky
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (- x (sticky y k))
-		(sticky (- x y) k2)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable sticky)
-		  :use ((:instance minus-sticky-7)
-			(:instance minus-sticky-6)))))
-
-(local (defthm sticky-lemma-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (< y 0)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable sticky)
-		  :use ((:instance minus-sticky (y (- y)))
-			(:instance expo-minus (x y))
-			(:instance sticky-minus (x y) (n k)))))))
-
-(local (defthm sticky-lemma-2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (= y 0)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sticky)
-           :use ((:instance sticky-0 (n k)))))))
-
-(defthm STICKY-LEMMA
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ()
-  :hints (("Goal" :use (sticky-plus sticky-lemma-1 sticky-lemma-2 
-                                    (:instance
-                                     trunc-0
-                                     (n (+ -1 K (* -1 (EXPO Y)))))))))
-
-
-;from add3
-(local 
- (defthm sticky-sticky-1
-   (implies (and (rationalp x)
-;                 (> x 0)
-                 (integerp m)
-                 (> m 1)
-                 (integerp n)
-                 (>= n m)
-                 (exactp x (1- n)))
-            (= (sticky (sticky x n) m)
-               (sticky x m)))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance sticky))))))
-
-(local 
- (defthm sticky-sticky-2
-   (implies (and (rationalp x)
-;                 (> x 0)
-                 (integerp m)
-                 (> m 1)
-                 (integerp n)
-                 (>= n m)
-                 (not (exactp x (1- n))))
-            (not (exactp x (1- m))))
-   :rule-classes ()
-   :hints (("goal" :use ((:instance exactp-<= (m (1- m)) (n (1- n))))))))
-
-(local
- (defthm sticky-sticky-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp m)
-		  (> m 1)
-		  (integerp n)
-		  (>= n m)
-		  (not (exactp x (1- n))))
-	     (not (exactp (sticky x n) (1- m))))
-  :rule-classes ()
-  :hints (("goal" :use (sticky-exactp-n-1
-			(:instance exactp-<= (x (sticky x n)) (m (1- m)) (n (1- n))))))))
-
-(local
- (defthm sticky-sticky-4
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp m)
-                 (> m 1)
-                 (integerp n)
-                 (>= n m)
-                 (not (exactp x (1- n))))
-            (= (sticky (sticky x n) m)
-               (+ (trunc (sticky x n) (1- m))
-                  (expt 2 (1+ (- (expo x) m))))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable sgn)
-            :use (expo-sticky
-                  sticky-pos
-                  sticky-sticky-3
-                  (:instance sticky (x (sticky x n)) (n m)))))))
-
-(local
- (defthm sticky-sticky-5
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp m)
-                 (> m 1)
-                 (integerp n)
-                 (>= n m)
-                 (not (exactp x (1- n))))
-            (= (sticky (sticky x n) m)
-               (+ (trunc x (1- m))
-                  (expt 2 (1+ (- (expo x) m))))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable sgn)
-            :use (sticky-sticky-4
-                  (:instance trunc-sticky (m (1- m))))))))
-
-(local
- (defthm sticky-sticky-6
-   (implies (and (rationalp x)
-                 (> x 0)
-                 (integerp m)
-                 (> m 1)
-                 (integerp n)
-                 (>= n m)
-                 (not (exactp x (1- n))))
-            (= (sticky (sticky x n) m)
-               (sticky x m)))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable sgn)
-            :use (sticky-sticky-5
-                  sticky-sticky-2
-                  (:instance trunc-0 (n (+ -1 m)))
-                  (:instance sticky (n m)))))))
-
-(local
- (defthm sticky-sticky-old
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp m)
-		  (> m 1)
-		  (integerp n)
-		  (>= n m))
-	     (= (sticky (sticky x n) m)
-		(sticky x m)))
-  :rule-classes ()
-  :hints (("goal" :use (sticky-sticky-6
-			sticky-sticky-1)))))
-
-(defthm sticky-sticky
-  (implies (and (rationalp x)
-                (integerp m)
-                (> m 1)
-                (integerp n)
-                (>= n m))
-           (= (sticky (sticky x n) m)
-              (sticky x m)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable sticky)
-           :use ((:instance sticky-sticky-old)
-                 (:instance sticky-sticky-old (x (- x)))))))
-
-(local (defthm sticky-exactp-m-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp m)
-		  (integerp n) 
-		  (> n m)
-		  (> m 0))
-	     (iff (exactp (sticky x n) m)
-		  (exactp x m)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sticky-minus)
-                  :use (sticky-exactp-n-1
-			sticky
-			(:instance exactp-<= (n (1- n)))
-			(:instance exactp-<= (n (1- n)) (x (sticky x n))))))))
-
-;;One for the library:
-
-(defthm sticky-exactp-m
-    (implies (and (rationalp x)
-		  (integerp m)
-		  (integerp n) 
-		  (> n m)
-		  (> m 0))
-	     (iff (exactp (sticky x n) m)
-		  (exactp x m)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable sticky-minus)
-                  :use (sticky-exactp-m-1
-                        (:instance sticky-exactp-m-1 (x (- x)))
-;                        (:instance exactp- (n m))
- ;                       (:instance exactp- (x (- x)) (n m))
-  ;                      (:instance exactp- (x (sticky x n)) (n m))
-   ;                     (:instance exactp- (x (- (sticky x n))) (n m))
-                        ))))
-
-          
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/sticky.lisp acl2-6.3/books/rtl/rel5/support/sticky.lisp
--- acl2-6.2/books/rtl/rel5/support/sticky.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/sticky.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,295 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;an acl2 library of floating point arithmetic
-;;;david m. russinoff
-;;;advanced micro devices, inc.
-;;;february, 1998
-;;;***************************************************************
-
-(local (include-book "sticky-proofs"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-(defund near+ (x n)
-  (if (< (re (* (expt 2 (1- n)) (sig x)))
-	 1/2)
-      (trunc x n)
-    (away x n)))
-
-
-;;
-;; New stuff:
-;;
-
-
-(defund sticky (x n)
-  (cond ((exactp x (1- n)) x)
-	(t (+ (trunc x (1- n))
-              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
-
-(defthm sticky-1
-  (implies (rationalp x)
-           (equal (sticky x 1)
-                  (* (sgn x) (expt 2 (expo x))))))
-
-;more rule-classes?
-(defthm sticky-pos
-    (implies (and (< 0 x)
-                  (rationalp x)
-		  (integerp n) (> n 0))
-	     (< 0 (sticky x n)))
-  :rule-classes :linear)
-
-(defthm sticky-shift
-    (implies (and (rationalp x)
-		  (integerp n) (> n 0)
-		  (integerp k))
-	     (= (sticky (* (expt 2 k) x) n)
-		(* (expt 2 k) (sticky x n))))		
-  :rule-classes ())
-
-(defthm sticky-minus
-  (equal (sticky (* -1 x) n)
-         (* -1 (sticky x n))))
-
-;gen?
-(defthm sticky-exactp
-  (implies (and (rationalp x) (>= x 0)
-                (integerp n) (> n 0)
-                )
-           (exactp (sticky x n) n))
-  :rule-classes ())
-
-(defthm sticky-exactp-n-1
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (iff (exactp (sticky x n) (1- n))
-		  (exactp x (1- n))))
-  :rule-classes ())
-
-(defthm expo-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0))
-	     (= (expo (sticky x n))
-		(expo x)))
-  :rule-classes ())
-
-(defthm trunc-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n m))
-	     (= (trunc (sticky x n) m)
-		(trunc x m)))
-  :rule-classes ())
-
-(defthm away-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n m))
-	     (= (away (sticky x n) m)
-		(away x m)))
-  :rule-classes ())
-
-(defthm near-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n (1+ m)))
-	     (= (near (sticky x n) m)
-		(near x m)))
-  :rule-classes ())
-
-(defthm near+-sticky
-    (implies (and (rationalp x) (> x 0)
-		  (integerp m) (> m 0)
-		  (integerp n) (> n (1+ m)))
-	     (= (near+ (sticky x n) m)
-		(near+ x m)))
-  :rule-classes ())
-
-;make local?
-(defthm minus-trunc-4
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< y x)
-		  (integerp k)
-		  (> k 0)
-		  (> (+ k (- (expo (- x y)) (expo y))) 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
-  :rule-classes ())
-
-;make local?
-(defthm minus-trunc-5
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (< x y)
-		  (integerp k)
-		  (> k 0)
-		  (> (+ k (- (expo (- x y)) (expo y))) 0)
-		  (= n (+ k (- (expo x) (expo y))))
-		  (exactp x n))
-	     (equal (- x (trunc y k))
-		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
-  :rule-classes ())
-
-(defthm sticky-plus
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (+ x (sticky y k))
-		(sticky (+ x y) k2)))
-  :rule-classes ())
-
-;BOZO move?
-(defthm trunc-away
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (not (exactp x n)))
-	     (= (away x n)
-		(+ (trunc x n)
-		   (expt 2 (+ (expo x) 1 (- n))))))		
-  :rule-classes ())
-
-(defthm sticky-0
-  (equal (sticky 0 n) 
-         0))
-
-(defthm minus-sticky
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp k)
-		  (= k1 (+ k (- (expo x) (expo y))))
-		  (= k2 (+ k (- (expo (- x y)) (expo y))))
-		  (> k 1)
-		  (> k1 1)
-		  (> k2 1)
-		  (exactp x (1- k1)))
-	     (= (- x (sticky y k))
-		(sticky (- x y) k2)))
-  :rule-classes ())
-
-(defthm sticky-lemma
-  (implies (and (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (integerp k)
-                (= k1 (+ k (- (expo x) (expo y))))
-                (= k2 (+ k (- (expo (+ x y)) (expo y))))
-                (> k 1)
-                (> k1 1)
-                (> k2 1)
-                (exactp x (1- k1)))
-           (= (+ x (sticky y k))
-              (sticky (+ x y) k2)))
-  :rule-classes ())
-
-(defthm sticky-sticky
-  (implies (and (rationalp x)
-                (integerp m)
-                (> m 1)
-                (integerp n)
-                (>= n m))
-           (= (sticky (sticky x n) m)
-              (sticky x m)))
-  :rule-classes ())
-
-(defthm sticky-exactp-m
-    (implies (and (rationalp x)
-		  (integerp m)
-		  (integerp n) 
-		  (> n m)
-		  (> m 0))
-	     (iff (exactp (sticky x n) m)
-		  (exactp x m)))
-  :rule-classes ())
-
-          
-
-
diff -Nru acl2-6.2/books/rtl/rel5/support/sumbits.lisp acl2-6.3/books/rtl/rel5/support/sumbits.lisp
--- acl2-6.2/books/rtl/rel5/support/sumbits.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/sumbits.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,63 +0,0 @@
-(in-package "ACL2")
-
-(include-book "bitn")
-(include-book "bits")
-
-(defun sumbits (x n)
-  (if (zp n)
-      0
-    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
-       (sumbits x (1- n)))))
-
-(defthmd sumbits-bits
-  (implies (and (natp x)
-                (natp n)
-                (> n 0))
-           (equal (sumbits x n)
-                  (bits x (1- n) 0)))
-  :hints (("Goal" :in-theory (enable bits-n-n-rewrite) ;yuck?
-           :induct (sumbits x n))
-          ("Subgoal *1/2" :use ((:instance bitn-plus-bits (n (1- n)) (m 0))))))
-
-(defthmd sumbits-thm
-     (implies (and (bvecp x n)
-                   (natp n)
-                   (> n 0))
-              (equal (sumbits x n)
-                     x))
-   :hints (("Goal" :in-theory (enable sumbits-bits bvecp))))
-
-(defun sumbits-badguy (x y k)
-  (if (zp k)
-      0 ; arbitrary
-    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
-        (1- k)
-      (sumbits-badguy x y (1- k)))))
-
-(local
- (defthm sumbits-badguy-is-correct-lemma
-   (implies (equal (bitn x (sumbits-badguy x y k))
-                   (bitn y (sumbits-badguy x y k)))
-            (equal (sumbits x k)
-                   (sumbits y k)))
-   :rule-classes nil))
-
-(defthmd sumbits-badguy-is-correct
-  (implies (and (bvecp x k)
-                (bvecp y k)
-                (equal (bitn x (sumbits-badguy x y k))
-                       (bitn y (sumbits-badguy x y k)))
-                (integerp k)
-                (< 0 k))
-           (equal (equal x y) t))
-  :hints (("Goal"
-           :use sumbits-badguy-is-correct-lemma
-           :in-theory (enable sumbits-thm))))
-
-(defthmd sumbits-badguy-bounds
-  (implies (and (integerp k)
-                (< 0 k))
-           (let ((badguy (sumbits-badguy x y k)))
-             (and (integerp badguy)
-                  (<= 0 badguy)
-                  (< badguy k)))))
diff -Nru acl2-6.2/books/rtl/rel5/support/top.lisp acl2-6.3/books/rtl/rel5/support/top.lisp
--- acl2-6.2/books/rtl/rel5/support/top.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/top.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,16 +0,0 @@
-(in-package "ACL2")
-
-(include-book "top1")
-
-(include-book "lextra")
-
-(include-book "fadd-extra")
-
-(include-book "float-extra")
-
-(include-book "round-extra")
-
-(include-book "guards")
-
-; Could probably be part of top1, but was handled later.
-(include-book "badguys")
diff -Nru acl2-6.2/books/rtl/rel5/support/top1.lisp acl2-6.3/books/rtl/rel5/support/top1.lisp
--- acl2-6.2/books/rtl/rel5/support/top1.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/top1.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,986 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;June, 2001
-;;;***************************************************************
-
-(in-package "ACL2")
-
-;the comments represent Eric's best guess as to how to summarize each book
-
-(include-book "util") ;includes the local-defthm macro, etc.
-(include-book "ground-zero") ;disables a bunch of functions, includes util
-(include-book "rewrite-theory") ; a little utility, which we don't use much...
-
-(include-book "rtl") ;definitions of the RTL primitives
-(include-book "rtlarr") ;RTL arrays
-(include-book "bvecp-lemmas") ;bvecp lemmas for all(?) of the RTL primitives  (what's the point of this book,
-  ;given that we have lib/bvecp-raw-helpers?)
-
-(include-book "bits")
-(include-book "bitn")
-
-(include-book "ocat")    ;soon to be removed, since I don't think we use ocat
-(include-book "cat-def") ;the definition of cat (since it's a bit complicated).
-(include-book "cat")
-(include-book "bvecp")
-(include-book "ash")
-(include-book "decode")
-(include-book "encode")
-(include-book "mulcat")
-(include-book "shft")
-(include-book "all-ones")
-(include-book "merge2")  ;includes merge
-                         ;a mix of lemmas.  eric is sorting these out into appropriate books
-                         ;but some lemmas really do mix several functions
-(include-book "logior1")
-(include-book "setbits")
-(include-book "setbitn")
-
-(include-book "float") ;theorems about floating point numbers (factorization into sgn, sig, and expo;
-;exactness)
-;Eric might want to sort these out into books call sig.lisp, exactp,list, etc.
-
-;floating-point representations:
-(include-book "bias") ;Exponent bias for floating point representations.
-(include-book "ereps") ;Floating point representations with explicit leading 1 in the mantissa.
-(include-book "ireps") ;Floating point representations with implicit leading 1 in the mantissa.
-
-;built-in logical operators:
-(include-book "logeqv")
-(include-book "logorc1")
-(include-book "lognot")
-(include-book "logand")
-(include-book "logior")
-(include-book "logxor")
-
-(include-book "log") ;theorems mixing logical operators with bits and bitn, etc.  some junk in here to sort
-  ;out?
-  ;figure out the difference between this and merge?
-
-;new logical operators:
-(include-book "lnot")
-(include-book "land0")
-(include-book "lior0")
-(include-book "lxor0")
-(include-book "lextra0")
-
-(include-book "logs") ;other "logical" operators, especially type (bvecp/natp) lemmas
-
-;floating-point rounding:
-(include-book "trunc") ;the trunc rounding-mode
-(include-book "away") ;the away rounding-mode
-(include-book "near") ;the near rounding-mode
-(include-book "near+") ;the near+ rounding-mode
-(include-book "oddr") ;the odd rounding-mode
-(include-book "sticky") ;sticky rounding
-(include-book "rnd") ;rnd (our top level rounding function), and the inf and minf rounding modes
-(include-book "drnd") ;rounding of denormal numbers
-
-(include-book "bits-trunc") ;theorems about how we implement trunc rounding...
-
-;theorems about circuits for addition
-(include-book "add3") ;theorems about how we implement addition of (2 or) 3 bit vectors using land0, lior0, and lxor0
-(include-book "lop1") ;leading-one prediction
-(include-book "lop2") ;leading-one prediction
-(include-book "lop3") ;leading-one prediction
-(include-book "stick") ;Some special-purpose lemmas by Russinoff, probably about sticky bit computation
-
-;helpers
-(include-book "bvecp-helpers")
-(include-book "model-helpers") ; do we use this?
-(include-book "rom-helpers")
-(include-book "simple-loop-helpers")
-;BOZO consider moving lib/simplify-model-helpers to support/ of (better yet), move all the helpers books to lib/
-
-(include-book "clocks")
-(include-book "openers")
-(include-book "package-defs")
-(include-book "simplify-model-helpers")
-
-(include-book "../arithmetic/top")
-(include-book "../arithmetic/fp")
-
-(include-book "fadd")
-
-; The following form evaluates to (prints out) the list of runes shown below,
-; in the environment created by starting up ACL2 and then executing
-; (include-book "../lib/top") when ../lib/top was built on top of
-; ../support/top1.
-
-#|
-; Here is the correct result, which however is more verbose than necessary.
-(let ((world (w state)))
-  (union-theories
-   ;; non-built-in rules
-   (set-difference-theories (current-theory :here)
-                            (universal-theory 'ground-zero))
-   ;; built-in rules
-   (intersection-theories (current-theory :here)
-                          (universal-theory 'ground-zero))))
-
-But note that:
-(let* ((world (w state))
-       (cgz (current-theory 'ground-zero))
-       (ugz (universal-theory 'ground-zero))
-       (here (current-theory :here)))
-  (equal (intersection-theories here ugz)
-         (union-theories (set-difference-theories
-                          cgz
-                          (set-difference-theories cgz here))
-                         (intersection-theories (set-difference-theories ugz
-                                                                         cgz)
-                                                here))))
-
-And the following are small:
-
-(let* ((world (w state))
-       (cgz (current-theory 'ground-zero))
-       (here (current-theory :here)))
-  (set-difference-theories cgz here))
-
-(let* ((world (w state))
-       (cgz (current-theory 'ground-zero))
-       (ugz (universal-theory 'ground-zero))
-       (here (current-theory :here)))
-  (intersection-theories (set-difference-theories ugz cgz)
-                         here))
-
-So the correct result is, alteratively:
-
-(let* ((world (w state))
-       (cgz (current-theory 'ground-zero))
-       (ugz (universal-theory 'ground-zero))
-       (here (current-theory :here))
-       (small1 (set-difference-theories cgz here))
-       (small2 (intersection-theories (set-difference-theories ugz cgz)
-                                      here)))
-  (union-theories
-   ;; non-built-in rules
-   (set-difference-theories (current-theory :here)
-                            (universal-theory 'ground-zero))
-   ;; built-in rules
-   (union-theories (set-difference-theories cgz small1)
-                   small2)))
-
-|# ; |
-
-; After Version_4.2, changes to defpkg eliminated the creation of rewrite rules
-; for hidden defpkgs, e.g., (:REWRITE U-PACKAGE).  We tried replacing the next
-; two forms below with more flexible forms (at least, in
-; rtl/rel4/support/top.lisp) that are more likely to survive version changes,
-; including the one just mentioned; but the theorem bits-guard failed in
-; rtl/rel4/support/guards.cert.  So we just comment out the offending rules in
-; the first deftheory below.
-
-(deftheory lib-top1-non-built-ins
-
-;(let ((world (w state)))
-;  (set-difference-theories (current-theory :here) (universal-theory 'ground-zero)))
-
-  '(
-;    (:REWRITE U-PACKAGE)
-;    (:REWRITE ACL2-ASG-PACKAGE)
-;    (:REWRITE ACL2-AGP-PACKAGE)
-;    (:REWRITE ACL2-CRG-PACKAGE)
-    (:EXECUTABLE-COUNTERPART FL)
-    (:TYPE-PRESCRIPTION FL)
-    (:EXECUTABLE-COUNTERPART BITS)
-    (:EXECUTABLE-COUNTERPART BITN)
-    (:EXECUTABLE-COUNTERPART BINARY-CAT)
-    (:DEFINITION FORMAL-+)
-    (:EXECUTABLE-COUNTERPART FORMAL-+)
-    (:TYPE-PRESCRIPTION FORMAL-+)
-    (:DEFINITION CAT-SIZE)
-    (:EXECUTABLE-COUNTERPART CAT-SIZE)
-    (:TYPE-PRESCRIPTION CAT-SIZE)
-    (:INDUCTION CAT-SIZE)
-    (:EXECUTABLE-COUNTERPART MULCAT)
-    (:EXECUTABLE-COUNTERPART LNOT)
-    (:EXECUTABLE-COUNTERPART BINARY-LAND0)
-    (:EXECUTABLE-COUNTERPART BINARY-LIOR0)
-    (:EXECUTABLE-COUNTERPART BINARY-LXOR0)
-    (:DEFINITION SETBITS)
-    (:EXECUTABLE-COUNTERPART SETBITS)
-    (:TYPE-PRESCRIPTION SETBITS)
-    (:EXECUTABLE-COUNTERPART SETBITN)
-    (:EXECUTABLE-COUNTERPART LOG=)
-    (:EXECUTABLE-COUNTERPART LOG<>)
-    (:EXECUTABLE-COUNTERPART LOG<)
-    (:EXECUTABLE-COUNTERPART LOG<=)
-    (:EXECUTABLE-COUNTERPART LOG>)
-    (:EXECUTABLE-COUNTERPART LOG>=)
-    (:EXECUTABLE-COUNTERPART COMP2)
-    (:TYPE-PRESCRIPTION COMP2)
-    (:EXECUTABLE-COUNTERPART COMP2<)
-    (:TYPE-PRESCRIPTION COMP2<)
-    (:EXECUTABLE-COUNTERPART COMP2<=)
-    (:TYPE-PRESCRIPTION COMP2<=)
-    (:EXECUTABLE-COUNTERPART COMP2>)
-    (:TYPE-PRESCRIPTION COMP2>)
-    (:EXECUTABLE-COUNTERPART COMP2>=)
-    (:TYPE-PRESCRIPTION COMP2>=)
-    (:EXECUTABLE-COUNTERPART LOGAND1)
-    (:TYPE-PRESCRIPTION LOGAND1)
-    (:EXECUTABLE-COUNTERPART LOGIOR1)
-    (:TYPE-PRESCRIPTION LOGIOR1)
-    (:EXECUTABLE-COUNTERPART LOGXOR1)
-    (:TYPE-PRESCRIPTION LOGXOR1)
-    (:EXECUTABLE-COUNTERPART SHFT)
-    (:EXECUTABLE-COUNTERPART DECODE)
-    (:EXECUTABLE-COUNTERPART ENCODE)
-    (:EXECUTABLE-COUNTERPART IF1)
-    (:TYPE-PRESCRIPTION IF1)
-    (:REWRITE IF1-0)
-    (:REWRITE IF1-NON-0)
-    (:REWRITE IF1-X-X)
-    (:DEFINITION COND1-MACRO)
-    (:EXECUTABLE-COUNTERPART COND1-MACRO)
-    (:TYPE-PRESCRIPTION COND1-MACRO)
-    (:INDUCTION COND1-MACRO)
-    (:EXECUTABLE-COUNTERPART NATP1)
-    (:TYPE-PRESCRIPTION NATP1)
-    (:EXECUTABLE-COUNTERPART BVECP)
-    (:TYPE-PRESCRIPTION BVECP)
-    (:REWRITE BVECP-IF1)
-    (:EXECUTABLE-COUNTERPART MK-BVEC)
-    (:TYPE-PRESCRIPTION MK-BVEC)
-    (:REWRITE MK-BVEC-IS-BVECP)
-    (:REWRITE MK-BVEC-IDENTITY)
-    (:REWRITE BVECP-RESET)
-    (:FORWARD-CHAINING BVECP-RESET)
-    (:TYPE-PRESCRIPTION BVECP-RESET)
-    (:REWRITE BVECP-UNKNOWN)
-    (:FORWARD-CHAINING BVECP-UNKNOWN)
-    (:TYPE-PRESCRIPTION BVECP-UNKNOWN)
-    (:EXECUTABLE-COUNTERPART <<)
-    (:TYPE-PRESCRIPTION <<)
-    (:REWRITE <<-IRREFLEXIVE)
-    (:REWRITE <<-TRANSITIVE)
-    (:REWRITE <<-ASYMMETRIC)
-    (:REWRITE <<-TRICHOTOMY)
-    (:REWRITE <<-IMPLIES-LEXORDER)
-    (:DEFINITION RCDP)
-    (:EXECUTABLE-COUNTERPART RCDP)
-    (:TYPE-PRESCRIPTION RCDP)
-    (:INDUCTION RCDP)
-    (:REWRITE RCDP-IMPLIES-ALISTP)
-    (:DEFINITION IFRP)
-    (:EXECUTABLE-COUNTERPART IFRP)
-    (:TYPE-PRESCRIPTION IFRP)
-    (:INDUCTION IFRP)
-    (:DEFINITION ACL2->RCD)
-    (:EXECUTABLE-COUNTERPART ACL2->RCD)
-    (:TYPE-PRESCRIPTION ACL2->RCD)
-    (:DEFINITION RCD->ACL2)
-    (:EXECUTABLE-COUNTERPART RCD->ACL2)
-    (:TYPE-PRESCRIPTION RCD->ACL2)
-    (:DEFINITION AG-AUX)
-    (:EXECUTABLE-COUNTERPART AG-AUX)
-    (:TYPE-PRESCRIPTION AG-AUX)
-    (:INDUCTION AG-AUX)
-    (:EXECUTABLE-COUNTERPART AG)
-    (:TYPE-PRESCRIPTION AG)
-    (:DEFINITION ACONS-IF)
-    (:EXECUTABLE-COUNTERPART ACONS-IF)
-    (:TYPE-PRESCRIPTION ACONS-IF)
-    (:DEFINITION AS-AUX)
-    (:EXECUTABLE-COUNTERPART AS-AUX)
-    (:TYPE-PRESCRIPTION AS-AUX)
-    (:INDUCTION AS-AUX)
-    (:EXECUTABLE-COUNTERPART AS)
-    (:TYPE-PRESCRIPTION AS)
-    (:REWRITE AG-SAME-AS)
-    (:REWRITE AG-DIFF-AS)
-    (:REWRITE AS-SAME-AG)
-    (:REWRITE AS-SAME-AS)
-    (:REWRITE AS-DIFF-AS)
-    (:REWRITE AG-OF-NIL-IS-DEFAULT)
-    (:REWRITE AS-NON-DEFAULT-CANNOT-BE-NIL)
-    (:FORWARD-CHAINING NON-NIL-IF-AG-NOT-DEFAULT)
-    (:EXECUTABLE-COUNTERPART BV-ARRP)
-    (:TYPE-PRESCRIPTION BV-ARRP)
-    (:REWRITE AS-MAPS-BV-ARR-TO-BV-ARR)
-    (:REWRITE AG-MAPS-BV-ARR-TO-BVECP)
-    (:EXECUTABLE-COUNTERPART MK-BVARR)
-    (:TYPE-PRESCRIPTION MK-BVARR)
-    (:REWRITE MK-BVARR-IS-BV-ARRP)
-    (:REWRITE MK-BVARR-IDENTITY)
-    (:DEFINITION POSITIVE-INTEGER-LISTP)
-    (:EXECUTABLE-COUNTERPART POSITIVE-INTEGER-LISTP)
-    (:TYPE-PRESCRIPTION POSITIVE-INTEGER-LISTP)
-    (:INDUCTION POSITIVE-INTEGER-LISTP)
-    (:REWRITE BV-ARRP-RESET2)
-    (:REWRITE BV-ARRP-UNKNOWN2)
-    (:REWRITE BV-ARRP-IF1)
-    (:EXECUTABLE-COUNTERPART CG)
-    (:TYPE-PRESCRIPTION CG)
-    (:TYPE-PRESCRIPTION FL-INTEGER-TYPE)
-    (:TYPE-PRESCRIPTION CG-INTEGER-TYPE)
-    (:REWRITE FL-INTEGERP)
-    (:REWRITE CG-INTEGERP)
-    (:LINEAR FL-DEF-LINEAR)
-    (:LINEAR CG-DEF-LINEAR)
-    (:LINEAR FL-MONOTONE-LINEAR)
-    (:LINEAR CG-MONOTONE-LINEAR)
-    (:LINEAR N<=FL-LINEAR)
-    (:LINEAR N>=CG-LINEAR)
-    (:REWRITE FL+INT-REWRITE)
-    (:REWRITE CG+INT-REWRITE)
-    (:REWRITE FL/INT-REWRITE)
-    (:REWRITE FL/INT-REWRITE-ALT)
-    (:REWRITE CG/INT-REWRITE)
-    (:REWRITE CG/INT-REWRITE-ALT)
-    (:REWRITE EXPT-2-POSITIVE-RATIONAL-TYPE)
-    (:TYPE-PRESCRIPTION EXPT-2-POSITIVE-RATIONAL-TYPE)
-    (:TYPE-PRESCRIPTION EXPT-2-POSITIVE-INTEGER-TYPE)
-    (:LINEAR EXPT-2-TYPE-LINEAR)
-    (:REWRITE ASH-REWRITE)
-    (:REWRITE MOD-0)
-    (:REWRITE RATIONALP-MOD)
-    (:TYPE-PRESCRIPTION RATIONALP-MOD)
-    (:REWRITE INTEGERP-MOD)
-    (:TYPE-PRESCRIPTION INTEGERP-MOD)
-    (:TYPE-PRESCRIPTION NATP-MOD)
-    (:LINEAR MOD-BND-1)
-    (:LINEAR MOD-BND-2)
-    (:REWRITE MOD-MULT)
-    (:REWRITE MOD-DIFF)
-    (:REWRITE MOD-DOES-NOTHING)
-    (:REWRITE MOD-BY-1)
-    (:REWRITE MOD-OF-MOD)
-    (:REWRITE MOD-PROD)
-    (:LINEAR MOD-BND-3)
-    (:LINEAR QUOT-BND)
-    (:REWRITE MOD-MULT-2)
-    (:LINEAR NK>=K-LINEAR)
-    (:REWRITE MOD-MULT-2-GEN)
-    (:REWRITE MOD-MULT-2-ALT-GEN)
-    (:REWRITE MOD-2*M+1-REWRITE)
-    (:EXECUTABLE-COUNTERPART FL-HALF)
-    (:TYPE-PRESCRIPTION FL-HALF)
-    (:FORWARD-CHAINING BVECP-FORWARD)
-    (:FORWARD-CHAINING BVECP-1-0)
-    (:FORWARD-CHAINING BVECP-0-1)
-    (:DEFINITION BITVEC)
-    (:EXECUTABLE-COUNTERPART BITVEC)
-    (:TYPE-PRESCRIPTION BITVEC)
-    (:TYPE-PRESCRIPTION BITN-NONNEGATIVE-INTEGER)
-    (:REWRITE BITN-BVECP)
-    (:FORWARD-CHAINING BITN-BVECP-FORWARD)
-    (:REWRITE BITN-BVECP-1)
-    (:REWRITE BITN-BITN-0)
-    (:REWRITE BITN-0)
-    (:REWRITE BVECP-BITN-0)
-    (:TYPE-PRESCRIPTION BITS-NONNEGATIVE-INTEGERP-TYPE)
-    (:REWRITE BITS-0)
-    (:REWRITE BITS-WITH-INDICES-IN-THE-WRONG-ORDER)
-    (:REWRITE BITS-N-N-REWRITE)
-    (:REWRITE BITS-TAIL)
-    (:REWRITE BITS-BVECP)
-    (:REWRITE BITS-BVECP-SIMPLE)
-    (:REWRITE BITS-BVECP-SIMPLE-2)
-    (:DEFINITION SUMBITS)
-    (:EXECUTABLE-COUNTERPART SUMBITS)
-    (:TYPE-PRESCRIPTION SUMBITS)
-    (:INDUCTION SUMBITS)
-    (:REWRITE BITN-BITS)
-    (:REWRITE BITS-BITS)
-    (:REWRITE BITS-PLUS-MULT-2)
-    (:REWRITE BITS-DROP-FROM-MINUS)
-    (:TYPE-PRESCRIPTION CAT-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE CAT-BVECP)
-    (:REWRITE CAT-ASSOCIATIVE)
-    (:REWRITE CAT-0)
-    (:REWRITE CAT-WITH-N-0)
-    (:REWRITE CAT-WITH-M-0)
-    (:REWRITE BITN-CAT-CONSTANTS)
-    (:REWRITE BITS-CAT-CONSTANTS)
-    (:REWRITE CAT-BITS-BITS)
-    (:REWRITE CAT-BITN-BITS)
-    (:REWRITE CAT-BITS-BITN)
-    (:REWRITE CAT-BITN-BITN)
-    (:TYPE-PRESCRIPTION MULCAT-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE MULCAT-BVECP)
-    (:REWRITE MULCAT-1)
-    (:REWRITE MULCAT-0)
-    (:REWRITE MULCAT-N-1)
-    (:REWRITE BITN-MULCAT-1)
-    (:REWRITE SETBITN-REWRITE)
-    (:TYPE-PRESCRIPTION SETBITN-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE SETBITN-BVECP)
-    (:REWRITE BITN-SETBITN)
-    (:TYPE-PRESCRIPTION SHFT-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE SHFT-BVECP)
-    (:TYPE-PRESCRIPTION LNOT-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LNOT-BVECP)
-    (:REWRITE LNOT-LNOT)
-    (:TYPE-PRESCRIPTION LAND0-NONNEGATIVE-INTEGER-TYPE)
-    (:TYPE-PRESCRIPTION LIOR0-NONNEGATIVE-INTEGER-TYPE)
-    (:TYPE-PRESCRIPTION LXOR0-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LAND0-BVECP)
-    (:REWRITE LIOR0-BVECP)
-    (:REWRITE LXOR0-BVECP)
-    (:REWRITE LAND0-X-Y-0)
-    (:REWRITE LIOR0-X-Y-0)
-    (:REWRITE LXOR0-X-Y-0)
-    (:DEFINITION LOGOP-2-INDUCT)
-    (:EXECUTABLE-COUNTERPART LOGOP-2-INDUCT)
-    (:TYPE-PRESCRIPTION LOGOP-2-INDUCT)
-    (:INDUCTION LOGOP-2-INDUCT)
-    (:DEFINITION LOGOP-2-N-INDUCT)
-    (:EXECUTABLE-COUNTERPART LOGOP-2-N-INDUCT)
-    (:TYPE-PRESCRIPTION LOGOP-2-N-INDUCT)
-    (:INDUCTION LOGOP-2-N-INDUCT)
-    (:DEFINITION LOGOP-3-INDUCT)
-    (:EXECUTABLE-COUNTERPART LOGOP-3-INDUCT)
-    (:TYPE-PRESCRIPTION LOGOP-3-INDUCT)
-    (:INDUCTION LOGOP-3-INDUCT)
-    (:REWRITE LAND0-COMMUTATIVE)
-    (:REWRITE LIOR0-COMMUTATIVE)
-    (:REWRITE LXOR0-COMMUTATIVE)
-    (:REWRITE LAND0-ASSOCIATIVE)
-    (:REWRITE LIOR0-ASSOCIATIVE)
-    (:REWRITE LXOR0-ASSOCIATIVE)
-    (:REWRITE LAND0-COMMUTATIVE-2)
-    (:REWRITE LIOR0-COMMUTATIVE-2)
-    (:REWRITE LXOR0-COMMUTATIVE-2)
-    (:REWRITE LAND0-COMBINE-CONSTANTS)
-    (:REWRITE LIOR0-COMBINE-CONSTANTS)
-    (:REWRITE LXOR0-COMBINE-CONSTANTS)
-    (:REWRITE LAND0-SELF)
-    (:REWRITE LIOR0-SELF)
-    (:REWRITE LXOR0-SELF)
-    (:REWRITE LAND0-0)
-    (:REWRITE LIOR0-0)
-    (:REWRITE LXOR0-0)
-    (:REWRITE LAND0-ONES-REWRITE)
-    (:REWRITE LIOR0-ONES-REWRITE)
-    (:REWRITE LXOR0-ONES-REWRITE)
-    (:REWRITE BITS-LAND0)
-    (:REWRITE BITN-LAND0)
-    (:REWRITE BITS-LIOR0)
-    (:REWRITE BITN-LIOR0)
-    (:REWRITE BITS-LXOR0)
-    (:REWRITE BITN-LXOR0)
-    (:REWRITE LAND0-BND)
-    (:LINEAR LAND0-BND)
-    (:REWRITE LIOR0-BND)
-    (:LINEAR LIOR0-BND)
-    (:REWRITE LIOR0-BVECP-2)
-    (:REWRITE LIOR0-CAT-CONSTANT)
-    (:TYPE-PRESCRIPTION LOGAND1-NONNEGATIVE-INTEGER-TYPE)
-    (:TYPE-PRESCRIPTION LOGIOR1-NONNEGATIVE-INTEGER-TYPE)
-    (:TYPE-PRESCRIPTION LOGXOR1-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LOGAND1-BVECP)
-    (:REWRITE LOGIOR1-BVECP)
-    (:REWRITE LOGXOR1-BVECP)
-    (:REWRITE LOG<-BVECP)
-    (:TYPE-PRESCRIPTION LOG<-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LOG<=-BVECP)
-    (:TYPE-PRESCRIPTION LOG<=-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LOG>-BVECP)
-    (:TYPE-PRESCRIPTION LOG>-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LOG>=-BVECP)
-    (:TYPE-PRESCRIPTION LOG>=-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LOG=-BVECP)
-    (:TYPE-PRESCRIPTION LOG=-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LOG=-COMMUTATIVE)
-    (:REWRITE LOG<>-BVECP)
-    (:TYPE-PRESCRIPTION LOG<>-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE LOG<>-COMMUTATIVE)
-    (:REWRITE LOG=-CAT-CONSTANT)
-    (:REWRITE ENCODE-BVECP)
-    (:TYPE-PRESCRIPTION ENCODE-NONNEGATIVE-INTEGER-TYPE)
-    (:TYPE-PRESCRIPTION DECODE-NONNEGATIVE-INTEGER-TYPE)
-    (:REWRITE DECODE-BVECP)
-    (:EXECUTABLE-COUNTERPART EXPO)
-    (:TYPE-PRESCRIPTION EXPO)
-    (:EXECUTABLE-COUNTERPART SGN)
-    (:TYPE-PRESCRIPTION SGN)
-    (:EXECUTABLE-COUNTERPART SIG)
-    (:TYPE-PRESCRIPTION SIG)
-    (:REWRITE EXPO-2**N)
-    (:REWRITE ALREADY-SIG)
-    (:REWRITE SIG-SIG)
-    (:EXECUTABLE-COUNTERPART EXACTP)
-    (:TYPE-PRESCRIPTION EXACTP)
-    (:REWRITE EXACTP-MINUS)
-    (:REWRITE BVECP-EXACTP)
-    (:REWRITE EXACTP-SIG)
-    (:DEFINITION FP+)
-    (:EXECUTABLE-COUNTERPART FP+)
-    (:TYPE-PRESCRIPTION FP+)
-    (:TYPE-PRESCRIPTION FP+-POSITIVE)
-    (:EXECUTABLE-COUNTERPART BIAS)
-    (:TYPE-PRESCRIPTION BIAS)
-    (:TYPE-PRESCRIPTION BIAS-NON-NEGATIVE-INTEGERP-TYPE-PRESCRIPTION)
-    (:DEFINITION ESGNF)
-    (:EXECUTABLE-COUNTERPART ESGNF)
-    (:TYPE-PRESCRIPTION ESGNF)
-    (:DEFINITION EEXPOF)
-    (:EXECUTABLE-COUNTERPART EEXPOF)
-    (:TYPE-PRESCRIPTION EEXPOF)
-    (:DEFINITION ESIGF)
-    (:EXECUTABLE-COUNTERPART ESIGF)
-    (:TYPE-PRESCRIPTION ESIGF)
-    (:EXECUTABLE-COUNTERPART EREPP)
-    (:TYPE-PRESCRIPTION EREPP)
-    (:EXECUTABLE-COUNTERPART EENCODINGP)
-    (:TYPE-PRESCRIPTION EENCODINGP)
-    (:EXECUTABLE-COUNTERPART EENCODE)
-    (:TYPE-PRESCRIPTION EENCODE)
-    (:EXECUTABLE-COUNTERPART EDECODE)
-    (:TYPE-PRESCRIPTION EDECODE)
-    (:REWRITE EENCODINGP-NOT-ZERO)
-    (:REWRITE EREPP-EDECODE)
-    (:REWRITE EENCODINGP-EENCODE)
-    (:REWRITE EDECODE-EENCODE)
-    (:REWRITE EENCODE-EDECODE)
-    (:REWRITE EXPO-EDECODE)
-    (:REWRITE SGN-EDECODE)
-    (:REWRITE SIG-EDECODE)
-    (:DEFINITION REBIAS-EXPO)
-    (:EXECUTABLE-COUNTERPART REBIAS-EXPO)
-    (:TYPE-PRESCRIPTION REBIAS-EXPO)
-    (:REWRITE NATP-REBIAS-UP)
-    (:REWRITE NATP-REBIAS-DOWN)
-    (:REWRITE BVECP-REBIAS-UP)
-    (:REWRITE BVECP-REBIAS-DOWN)
-    (:DEFINITION ISGNF)
-    (:EXECUTABLE-COUNTERPART ISGNF)
-    (:TYPE-PRESCRIPTION ISGNF)
-    (:DEFINITION IEXPOF)
-    (:EXECUTABLE-COUNTERPART IEXPOF)
-    (:TYPE-PRESCRIPTION IEXPOF)
-    (:DEFINITION ISIGF)
-    (:EXECUTABLE-COUNTERPART ISIGF)
-    (:TYPE-PRESCRIPTION ISIGF)
-    (:EXECUTABLE-COUNTERPART NREPP)
-    (:TYPE-PRESCRIPTION NREPP)
-    (:EXECUTABLE-COUNTERPART DREPP)
-    (:TYPE-PRESCRIPTION DREPP)
-    (:EXECUTABLE-COUNTERPART IREPP)
-    (:TYPE-PRESCRIPTION IREPP)
-    (:EXECUTABLE-COUNTERPART NENCODINGP)
-    (:TYPE-PRESCRIPTION NENCODINGP)
-    (:EXECUTABLE-COUNTERPART DENCODINGP)
-    (:TYPE-PRESCRIPTION DENCODINGP)
-    (:EXECUTABLE-COUNTERPART IENCODINGP)
-    (:TYPE-PRESCRIPTION IENCODINGP)
-    (:EXECUTABLE-COUNTERPART NENCODE)
-    (:TYPE-PRESCRIPTION NENCODE)
-    (:EXECUTABLE-COUNTERPART DENCODE)
-    (:TYPE-PRESCRIPTION DENCODE)
-    (:EXECUTABLE-COUNTERPART IENCODE)
-    (:TYPE-PRESCRIPTION IENCODE)
-    (:EXECUTABLE-COUNTERPART NDECODE)
-    (:TYPE-PRESCRIPTION NDECODE)
-    (:EXECUTABLE-COUNTERPART DDECODE)
-    (:TYPE-PRESCRIPTION DDECODE)
-    (:EXECUTABLE-COUNTERPART IDECODE)
-    (:TYPE-PRESCRIPTION IDECODE)
-    (:REWRITE SGN-NDECODE)
-    (:REWRITE EXPO-NDECODE)
-    (:REWRITE SIG-NDECODE)
-    (:REWRITE SGN-DDECODE)
-    (:REWRITE EXPO-DDECODE)
-    (:REWRITE SIG-DDECODE)
-    (:REWRITE SGN-IDECODE)
-    (:REWRITE EXPO-IDECODE)
-    (:REWRITE SIG-IDECODE)
-    (:REWRITE DENCODINGP-DENCODE)
-    (:REWRITE IENCODINGP-IENCODE)
-    (:REWRITE NREPP-NDECODE)
-    (:REWRITE DREPP-DDECODE)
-    (:REWRITE IREPP-IDECODE)
-    (:REWRITE NENCODINGP-NENCODE)
-    (:REWRITE NDECODE-NENCODE)
-    (:REWRITE DDECODE-DENCODE)
-    (:REWRITE IDECODE-IENCODE)
-    (:REWRITE NENCODE-NDECODE)
-    (:REWRITE DENCODE-DDECODE)
-    (:REWRITE IENCODE-IDECODE)
-    (:EXECUTABLE-COUNTERPART TRUNC)
-    (:TYPE-PRESCRIPTION TRUNC)
-    (:REWRITE TRUNC-POSITIVE)
-    (:LINEAR TRUNC-POSITIVE)
-    (:REWRITE TRUNC-NEGATIVE)
-    (:LINEAR TRUNC-NEGATIVE)
-    (:REWRITE TRUNC-0)
-    (:REWRITE TRUNC-EXACTP-B)
-    (:REWRITE EXPO-TRUNC)
-    (:EXECUTABLE-COUNTERPART AWAY)
-    (:TYPE-PRESCRIPTION AWAY)
-    (:REWRITE AWAY-POSITIVE)
-    (:LINEAR AWAY-POSITIVE)
-    (:REWRITE AWAY-NEGATIVE)
-    (:LINEAR AWAY-NEGATIVE)
-    (:REWRITE AWAY-0)
-    (:REWRITE AWAY-EXACTP-B)
-    (:DEFINITION RE)
-    (:EXECUTABLE-COUNTERPART RE)
-    (:TYPE-PRESCRIPTION RE)
-    (:EXECUTABLE-COUNTERPART NEAR)
-    (:TYPE-PRESCRIPTION NEAR)
-    (:TYPE-PRESCRIPTION NEAR-POS)
-    (:LINEAR NEAR-POS)
-    (:REWRITE NEAR-0)
-    (:REWRITE NEAR-EXACTP-B)
-    (:REWRITE NEAR-MONOTONE)
-    (:EXECUTABLE-COUNTERPART NEAR-WITNESS)
-    (:TYPE-PRESCRIPTION NEAR-WITNESS)
-    (:EXECUTABLE-COUNTERPART NEAR+)
-    (:TYPE-PRESCRIPTION NEAR+)
-    (:REWRITE SGN-NEAR+-2)
-    (:LINEAR NEAR+-POS)
-    (:LINEAR NEAR+-NEG)
-    (:REWRITE NEAR+-0)
-    (:REWRITE NEAR+-MONOTONE)
-    (:REWRITE NEAR+-EXACTP-B)
-    (:REWRITE NEAR+-EXACTP-C)
-    (:REWRITE NEAR+-EXACTP-D)
-    (:EXECUTABLE-COUNTERPART STICKY)
-    (:TYPE-PRESCRIPTION STICKY)
-    (:REWRITE STICKY-1)
-    (:REWRITE STICKY-0)
-    (:EXECUTABLE-COUNTERPART ODDR)
-    (:TYPE-PRESCRIPTION ODDR)
-    (:REWRITE EXPO-ODDR)
-    (:DEFINITION KP)
-    (:EXECUTABLE-COUNTERPART KP)
-    (:TYPE-PRESCRIPTION KP)
-    (:DEFINITION INF)
-    (:EXECUTABLE-COUNTERPART INF)
-    (:TYPE-PRESCRIPTION INF)
-    (:DEFINITION MINF)
-    (:EXECUTABLE-COUNTERPART MINF)
-    (:TYPE-PRESCRIPTION MINF)
-    (:EXECUTABLE-COUNTERPART IEEE-MODE-P)
-    (:TYPE-PRESCRIPTION IEEE-MODE-P)
-    (:DEFINITION ROUNDING-MODE-P)
-    (:EXECUTABLE-COUNTERPART ROUNDING-MODE-P)
-    (:TYPE-PRESCRIPTION ROUNDING-MODE-P)
-    (:EXECUTABLE-COUNTERPART RND)
-    (:TYPE-PRESCRIPTION RND)
-    (:TYPE-PRESCRIPTION RATIONALP-RND)
-    (:REWRITE RND-NON-POS)
-    (:TYPE-PRESCRIPTION RND-NON-POS)
-    (:LINEAR RND-NON-POS)
-    (:REWRITE RND-NON-NEG)
-    (:TYPE-PRESCRIPTION RND-NON-NEG)
-    (:LINEAR RND-NON-NEG)
-    (:TYPE-PRESCRIPTION RND-POS)
-    (:TYPE-PRESCRIPTION RND-NEG)
-    (:REWRITE RND-0)
-    (:EXECUTABLE-COUNTERPART FLIP)
-    (:TYPE-PRESCRIPTION FLIP)
-    (:REWRITE IEEE-MODE-P-FLIP)
-    (:REWRITE ROUNDING-MODE-P-FLIP)
-    (:REWRITE RND-EXACTP-A)
-    (:REWRITE RND-EXACTP-B)
-    (:REWRITE EXACTP-RND)
-    (:DEFINITION RND-CONST)
-    (:EXECUTABLE-COUNTERPART RND-CONST)
-    (:TYPE-PRESCRIPTION RND-CONST)
-    (:DEFINITION ROUNDUP)
-    (:EXECUTABLE-COUNTERPART ROUNDUP)
-    (:TYPE-PRESCRIPTION ROUNDUP)
-    (:EXECUTABLE-COUNTERPART DRND)
-    (:TYPE-PRESCRIPTION DRND)
-    (:REWRITE DRND-0)
-    (:EXECUTABLE-COUNTERPART SMALLEST-POSITIVE-NORMAL)
-    (:TYPE-PRESCRIPTION SMALLEST-POSITIVE-NORMAL)
-    (:LINEAR POSITIVE-SPN)
-    (:REWRITE NREPP-SPN)
-    (:REWRITE SMALLEST-SPN)
-    (:EXECUTABLE-COUNTERPART SMALLEST-POSITIVE-DENORMAL)
-    (:TYPE-PRESCRIPTION SMALLEST-POSITIVE-DENORMAL)
-    (:REWRITE POSITIVE-SPD)
-    (:REWRITE DREPP-SPD)
-    (:REWRITE SMALLEST-SPD)
-    (:REWRITE DRND-OF-DREPP-IS-NOP)
-    (:REWRITE DRND-SPN-IS-SPN-GENERAL)
-    (:REWRITE DRND-TRUNC-NEVER-GOES-AWAY-FROM-ZERO)
-    (:REWRITE DRND-AWAY-NEVER-GOES-TOWARD-ZERO)
-    (:REWRITE DRND-INF-NEVER-GOES-DOWN)
-    (:REWRITE DRND-MINF-NEVER-GOES-UP)
-    (:REWRITE DRND-TRUNC-SKIPS-NO-DENORMALS)
-    (:REWRITE DRND-AWAY-SKIPS-NO-DENORMALS)
-    (:REWRITE DRND-INF-SKIPS-NO-DENORMALS)
-    (:REWRITE DRND-MINF-SKIPS-NO-DENORMALS)
-    (:REWRITE DRND-DIFF)
-    (:EXECUTABLE-COUNTERPART NEXT-DENORMAL)
-    (:TYPE-PRESCRIPTION NEXT-DENORMAL)
-    (:REWRITE DENORMAL-SPACING)
-    (:REWRITE NO-DENORMAL-IS-CLOSER-THAN-WHAT-DRND-NEAR-RETURNS)
-    (:DEFINITION GEN)
-    (:EXECUTABLE-COUNTERPART GEN)
-    (:TYPE-PRESCRIPTION GEN)
-    (:INDUCTION GEN)
-    (:DEFINITION PROP)
-    (:EXECUTABLE-COUNTERPART PROP)
-    (:TYPE-PRESCRIPTION PROP)
-    (:INDUCTION PROP)
-    (:REWRITE LAND0-GEN-0)
-    (:REWRITE BVECP-1-GEN)
-    (:FORWARD-CHAINING BVECP-1-GEN)
-    (:REWRITE BVECP-1-PROP)
-    (:FORWARD-CHAINING BVECP-1-PROP)
-    (:DEFINITION LAMT-0)
-    (:EXECUTABLE-COUNTERPART LAMT-0)
-    (:TYPE-PRESCRIPTION LAMT-0)
-    (:DEFINITION LAMG-0)
-    (:EXECUTABLE-COUNTERPART LAMG-0)
-    (:TYPE-PRESCRIPTION LAMG-0)
-    (:DEFINITION LAMZ-0)
-    (:EXECUTABLE-COUNTERPART LAMZ-0)
-    (:TYPE-PRESCRIPTION LAMZ-0)
-    (:DEFINITION LAM1-0)
-    (:EXECUTABLE-COUNTERPART LAM1-0)
-    (:TYPE-PRESCRIPTION LAM1-0)
-    (:DEFINITION LAM2-0)
-    (:EXECUTABLE-COUNTERPART LAM2-0)
-    (:TYPE-PRESCRIPTION LAM2-0)
-    (:DEFINITION LAM3-0)
-    (:EXECUTABLE-COUNTERPART LAM3-0)
-    (:TYPE-PRESCRIPTION LAM3-0)
-    (:DEFINITION LAM4-0)
-    (:EXECUTABLE-COUNTERPART LAM4-0)
-    (:TYPE-PRESCRIPTION LAM4-0)
-    (:DEFINITION LAM0-0)
-    (:EXECUTABLE-COUNTERPART LAM0-0)
-    (:TYPE-PRESCRIPTION LAM0-0)
-    (:DEFINITION LAMB-0)
-    (:EXECUTABLE-COUNTERPART LAMB-0)
-    (:TYPE-PRESCRIPTION LAMB-0)
-    (:REWRITE A1)
-    (:REWRITE A2)
-    (:REWRITE A3)
-    (:REWRITE A4)
-    (:REWRITE A5)
-    (:REWRITE A6)
-    (:REWRITE A7)
-    (:REWRITE A8)
-    (:REWRITE A9)
-    (:REWRITE A10)
-    (:LINEAR A12)
-    (:LINEAR A13)
-    (:TYPE-PRESCRIPTION A14 . 1)
-    (:TYPE-PRESCRIPTION A14 . 2)
-    (:REWRITE A15)
-    (:REWRITE A16)
-    (:FORWARD-CHAINING /-WEAKLY-MONOTONIC)
-    (:LINEAR /-WEAKLY-MONOTONIC)
-    (:FORWARD-CHAINING /-STRONGLY-MONOTONIC)
-    (:LINEAR /-STRONGLY-MONOTONIC)
-    (:FORWARD-CHAINING *-WEAKLY-MONOTONIC . 1)
-    (:LINEAR *-WEAKLY-MONOTONIC . 1)
-    (:FORWARD-CHAINING *-WEAKLY-MONOTONIC . 2)
-    (:LINEAR *-WEAKLY-MONOTONIC . 2)
-    (:FORWARD-CHAINING *-STRONGLY-MONOTONIC . 1)
-    (:LINEAR *-STRONGLY-MONOTONIC . 1)
-    (:FORWARD-CHAINING *-STRONGLY-MONOTONIC . 2)
-    (:LINEAR *-STRONGLY-MONOTONIC . 2)
-    (:FORWARD-CHAINING *-WEAKLY-MONOTONIC-NEGATIVE-MULTIPLIER
-                       . 1)
-    (:LINEAR *-WEAKLY-MONOTONIC-NEGATIVE-MULTIPLIER
-             . 1)
-    (:FORWARD-CHAINING *-WEAKLY-MONOTONIC-NEGATIVE-MULTIPLIER
-                       . 2)
-    (:LINEAR *-WEAKLY-MONOTONIC-NEGATIVE-MULTIPLIER
-             . 2)
-    (:FORWARD-CHAINING *-STRONGLY-MONOTONIC-NEGATIVE-MULTIPLIER
-                       . 1)
-    (:LINEAR *-STRONGLY-MONOTONIC-NEGATIVE-MULTIPLIER
-             . 1)
-    (:FORWARD-CHAINING *-STRONGLY-MONOTONIC-NEGATIVE-MULTIPLIER
-                       . 2)
-    (:LINEAR *-STRONGLY-MONOTONIC-NEGATIVE-MULTIPLIER
-             . 2)
-    (:FORWARD-CHAINING FL-WEAKLY-MONOTONIC . 1)
-    (:LINEAR FL-WEAKLY-MONOTONIC . 1)
-    (:FORWARD-CHAINING FL-WEAKLY-MONOTONIC . 2)
-    (:LINEAR FL-WEAKLY-MONOTONIC . 2)
-    (:REWRITE REARRANGE-NEGATIVE-COEFS-<)
-    (:REWRITE REARRANGE-NEGATIVE-COEFS-EQUAL)
-    (:REWRITE REARRANGE-FRACTIONAL-COEFS-<)
-    (:REWRITE REARRANGE-FRACTIONAL-COEFS-EQUAL)
-    (:EXECUTABLE-COUNTERPART POINT-RIGHT-MEASURE)
-    (:TYPE-PRESCRIPTION POINT-RIGHT-MEASURE)
-    (:EXECUTABLE-COUNTERPART POINT-LEFT-MEASURE)
-    (:TYPE-PRESCRIPTION POINT-LEFT-MEASURE)
-    (:DEFINITION FIRSTN)
-    (:EXECUTABLE-COUNTERPART FIRSTN)
-    (:TYPE-PRESCRIPTION FIRSTN)
-    (:INDUCTION FIRSTN)
-    (:DEFINITION DROPN)
-    (:EXECUTABLE-COUNTERPART DROPN)
-    (:TYPE-PRESCRIPTION DROPN)
-    (:INDUCTION DROPN)
-    (:DEFINITION WCMP)
-    (:EXECUTABLE-COUNTERPART WCMP)
-    (:TYPE-PRESCRIPTION WCMP)
-    (:DEFINITION OCMP-AUX)
-    (:EXECUTABLE-COUNTERPART OCMP-AUX)
-    (:TYPE-PRESCRIPTION OCMP-AUX)
-    (:INDUCTION OCMP-AUX)
-    (:DEFINITION OCMP)
-    (:EXECUTABLE-COUNTERPART OCMP)
-    (:TYPE-PRESCRIPTION OCMP)
-    (:DEFINITION OMEGA-TERM)
-    (:EXECUTABLE-COUNTERPART OMEGA-TERM)
-    (:TYPE-PRESCRIPTION OMEGA-TERM)
-    (:DEFINITION OMEGA)
-    (:EXECUTABLE-COUNTERPART OMEGA)
-    (:TYPE-PRESCRIPTION OMEGA)
-    (:DEFINITION O-MAX)
-    (:EXECUTABLE-COUNTERPART O-MAX)
-    (:TYPE-PRESCRIPTION O-MAX)
-    (:DEFINITION LIMITPART)
-    (:EXECUTABLE-COUNTERPART LIMITPART)
-    (:TYPE-PRESCRIPTION LIMITPART)
-    (:INDUCTION LIMITPART)
-    (:DEFINITION NATPART)
-    (:EXECUTABLE-COUNTERPART NATPART)
-    (:TYPE-PRESCRIPTION NATPART)
-    (:INDUCTION NATPART)
-    (:DEFINITION LIMITP)
-    (:EXECUTABLE-COUNTERPART LIMITP)
-    (:TYPE-PRESCRIPTION LIMITP)
-    (:DEFINITION OLEN)
-    (:EXECUTABLE-COUNTERPART OLEN)
-    (:TYPE-PRESCRIPTION OLEN)
-    (:INDUCTION OLEN)
-    (:DEFINITION O-LAST-EXPT)
-    (:EXECUTABLE-COUNTERPART O-LAST-EXPT)
-    (:TYPE-PRESCRIPTION O-LAST-EXPT)
-    (:INDUCTION O-LAST-EXPT)
-    (:DEFINITION OB+)
-    (:EXECUTABLE-COUNTERPART OB+)
-    (:TYPE-PRESCRIPTION OB+)
-    (:INDUCTION OB+)
-    (:DEFINITION O-)
-    (:EXECUTABLE-COUNTERPART O-)
-    (:TYPE-PRESCRIPTION O-)
-    (:INDUCTION O-)
-    (:DEFINITION COUNT1)
-    (:EXECUTABLE-COUNTERPART COUNT1)
-    (:TYPE-PRESCRIPTION COUNT1)
-    (:INDUCTION COUNT1)
-    (:DEFINITION COUNT2)
-    (:EXECUTABLE-COUNTERPART COUNT2)
-    (:TYPE-PRESCRIPTION COUNT2)
-    (:DEFINITION PADD)
-    (:EXECUTABLE-COUNTERPART PADD)
-    (:TYPE-PRESCRIPTION PADD)
-    (:INDUCTION PADD)
-    (:DEFINITION PMULT)
-    (:EXECUTABLE-COUNTERPART PMULT)
-    (:TYPE-PRESCRIPTION PMULT)
-    (:INDUCTION PMULT)
-    (:DEFINITION OB*)
-    (:EXECUTABLE-COUNTERPART OB*)
-    (:TYPE-PRESCRIPTION OB*)
-    (:INDUCTION OB*)
-    (:DEFINITION O^1)
-    (:EXECUTABLE-COUNTERPART O^1)
-    (:TYPE-PRESCRIPTION O^1)
-    (:INDUCTION O^1)
-    (:DEFINITION O^2)
-    (:EXECUTABLE-COUNTERPART O^2)
-    (:TYPE-PRESCRIPTION O^2)
-    (:DEFINITION O^3H)
-    (:EXECUTABLE-COUNTERPART O^3H)
-    (:TYPE-PRESCRIPTION O^3H)
-    (:INDUCTION O^3H)
-    (:DEFINITION O^3)
-    (:EXECUTABLE-COUNTERPART O^3)
-    (:TYPE-PRESCRIPTION O^3)
-    (:DEFINITION O^4)
-    (:EXECUTABLE-COUNTERPART O^4)
-    (:TYPE-PRESCRIPTION O^4)
-    (:DEFINITION OB^)
-    (:EXECUTABLE-COUNTERPART OB^)
-    (:TYPE-PRESCRIPTION OB^)
-    (:INDUCTION OB^)
-    (:DEFINITION E0-ORD-<)
-    (:EXECUTABLE-COUNTERPART E0-ORD-<)
-    (:TYPE-PRESCRIPTION E0-ORD-<)
-    (:INDUCTION E0-ORD-<)
-    (:DEFINITION E0-ORDINALP)
-    (:EXECUTABLE-COUNTERPART E0-ORDINALP)
-    (:TYPE-PRESCRIPTION E0-ORDINALP)
-    (:INDUCTION E0-ORDINALP)
-    (:DEFINITION COPYN)
-    (:EXECUTABLE-COUNTERPART COPYN)
-    (:TYPE-PRESCRIPTION COPYN)
-    (:INDUCTION COPYN)
-    (:EXECUTABLE-COUNTERPART CTOA)
-    (:TYPE-PRESCRIPTION CTOA)
-    (:REWRITE CTOA-<-EQUIV)
-    (:FORWARD-CHAINING |oc.x  <=>  oa(ctoa.x)|)
-    (:REWRITE |oc.x  <=>  oa(ctoa.x)|)
-    (:EXECUTABLE-COUNTERPART ATOC)
-    (:TYPE-PRESCRIPTION ATOC)
-    (:REWRITE |oa.x  <=>  oc(atoc.x)|)
-    (:REWRITE ATOC-<-EQUIV)
-    (:WELL-FOUNDED-RELATION E0-ORDINAL-WELL-FOUNDED-CNF)
-    (:REWRITE RECURSION-BY-POINT-RIGHT)
-    (:REWRITE RECURSION-BY-POINT-LEFT)
-    (:DEFINITION SUB1-INDUCTION)
-    (:EXECUTABLE-COUNTERPART SUB1-INDUCTION)
-    (:TYPE-PRESCRIPTION SUB1-INDUCTION)
-    (:INDUCTION SUB1-INDUCTION)
-    (:DEFINITION SPLIT-LIST)
-    (:EXECUTABLE-COUNTERPART SPLIT-LIST)
-    (:TYPE-PRESCRIPTION SPLIT-LIST)
-    (:INDUCTION SPLIT-LIST)))
-
-(deftheory lib-top1-built-ins-helper-1
-
-; (let* ((world (w state))
-;        (cgz (current-theory 'ground-zero))
-;        (here (current-theory :here)))
-;   (set-difference-theories cgz here)))
-
-  '((:DEFINITION FLOOR)
-    (:REWRITE INVERSE-OF-*)
-    (:DEFINITION TRUNCATE)
-    (:DEFINITION MOD)
-    (:DEFINITION REM)
-    (:DEFINITION LOGNOT)
-    (:DEFINITION EXPT)
-    (:INDUCTION EXPT)
-    (:DEFINITION ASH)
-    (:DEFINITION AREF1)
-    (:DEFINITION ASET1)
-    (:DEFINITION AREF2)
-    (:DEFINITION ASET2)
-    (:DEFINITION BINARY-LOGAND)
-    (:INDUCTION BINARY-LOGAND)
-    (:DEFINITION BINARY-LOGIOR)
-    (:DEFINITION LOGORC1)
-    (:DEFINITION BINARY-LOGEQV)
-    (:DEFINITION BINARY-LOGXOR)))
-
-(deftheory lib-top1-built-ins-helper-2
-
-; (let* ((world (w state))
-;        (cgz (current-theory 'ground-zero))
-;        (ugz (universal-theory 'ground-zero))
-;        (here (current-theory :here)))
-;   (intersection-theories (set-difference-theories ugz cgz)
-;                          here))
-
-  nil)
-
-(deftheory lib-top1
-  (union-theories
-   (theory 'lib-top1-non-built-ins)
-   (union-theories (set-difference-theories
-                    (current-theory 'ground-zero)
-                    (theory 'lib-top1-built-ins-helper-1))
-                   (theory 'lib-top1-built-ins-helper-2))))
diff -Nru acl2-6.2/books/rtl/rel5/support/trunc-proofs.lisp acl2-6.3/books/rtl/rel5/support/trunc-proofs.lisp
--- acl2-6.2/books/rtl/rel5/support/trunc-proofs.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/trunc-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1271 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;an acl2 library of floating point arithmetic
-
-;;;david m. russinoff
-;;;advanced micro devices, inc.
-;;;february, 1998
-;;;***************************************************************
-
-;make local some of the events in this book
-
-(include-book "ground-zero")
-(local (include-book "float"))
-(local (include-book "../arithmetic/top"))
-
-;;Necessary defuns
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-
-;;
-;; New stuff:
-;;
-
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;generated automatically by ACL2 when we define trunc, but included here just to be safe
-;could have disabled (:type-prescription trunc) for slight efficiency gain at the cost of making the output of :pe a
-;little deceptive
-(defthm trunc-rational-type-prescription
-  (rationalp (trunc x n))
-  :rule-classes :type-prescription)
-
-(defthm trunc-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (trunc x n)
-                  0))
-  :hints (("goal" :in-theory (enable trunc sig))))
-
-#| would be nice:
-(defthm trunc-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (trunc x n)
-                  ...)))
-|#
-
-
-
-(defthm trunc-to-0-or-fewer-bits
-  (implies (and (<= n 0)
-                (integerp n)
-                )
-           (equal (trunc x n)
-                  0))
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable trunc expt-split)
-                              '())
-           :use ((:instance fl-unique
-                            (x (* 1/2 (sig x) (expt 2 n)))
-                            (n 0))
-                 (:instance expt-weak-monotone
-                            (n n)
-                            (m 0))))))
-
-;make alt version? use negative-syntaxp?
-(defthm trunc-minus
-  (equal (trunc (* -1 x) n)
-         (* -1 (trunc x n)))
-  :hints (("Goal" :in-theory (enable trunc))))
-
-
-;change what trunc does with n not a positive int?
-(defthm trunc-positive
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (< 0 (trunc x n)))
-  :rule-classes (:rewrite :linear)
-  :hints (("goal" :in-theory (e/d ( trunc expt-split) (SIG-LESS-THAN-1-MEANS-X-0 SIG-LOWER-BOUND))
-           :use ((:instance sig-lower-bound)))))
-
-
-;I think this rule has caused the "bad-ass" problem regarding the (case-split (< 0 n)) hyp.
-;BOZO should this include rationalp, to have a more type-like conclusion?
-(defthm trunc-positive-rational-type-prescription
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n)))
-           (< 0 (trunc x n)))
-  :rule-classes :type-prescription)
-
-(defthm trunc-negative
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n)))
-           (< (trunc x n) 0))
-  :rule-classes (:rewrite :linear)
-  :hints (("goal" :in-theory (e/d ( trunc expt-split) ( SIG-LESS-THAN-1-MEANS-X-0  SIG-LOWER-BOUND))
-           :use ((:instance sig-lower-bound)))))
-
-;BOZO should this include rationalp, to have a more type-like conclusion?
-(defthm trunc-negative-rational-type-prescription
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (< (trunc x n) 0))
-  :rule-classes :type-prescription)
-
-(defthm trunc-0 
-  (equal (trunc 0 n) 
-         0)
-  :hints (("goal" :in-theory (enable trunc))))
-
-;trying the case-split
-(defthm trunc-of-non-rationalp-is-0-alt
-  (implies (case-split (not (rationalp x)))
-           (equal (trunc x n)
-                  0)))
-
-
-(defthm trunc-non-negative-rational-type-prescription
-  (implies (and (<= 0 x)
-                (case-split (integerp n))
-                )
-           (and (<= 0 (trunc x n))
-                (rationalp (trunc x n))))
-  :hints (("Goal" :cases ((equal x 0) (and (not (equal x 0)) (<= n 0)))))
-  :rule-classes :type-prescription)
-
-(defthm trunc-non-positive-rational-type-prescription
-  (implies (and (<= x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-;                (case-split (< 0 n))
-                )
-           (and (<= (trunc x n) 0)
-                (rationalp (trunc x n))))
-  :hints (("Goal" :cases ((equal x 0) (and (not (equal x 0)) (<= n 0)))))
-  :rule-classes :type-prescription)
-
-;make an away version?
-(defthm trunc-non-negative-linear
-  (implies (and (<= 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (<= 0 (trunc x n)))
-  :rule-classes :linear)
-
-;make an away version?
-(defthm trunc-non-positive-linear
-  (implies (and (<= x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (<= (trunc x n) 0))
-  :rule-classes :linear)
-
-(defthm sgn-trunc
-  (implies (and (< 0 n)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (sgn (trunc x n))
-                  (sgn x)))
-  :hints (("goal" :cases ((equal x 0) (< x 0)))))
-
-
-;why not just open up trunc and sgn?
-;keep this disabled, since it basically opens up TRUNC
-(defthmd abs-trunc
-  (equal (abs (trunc x n))
-         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-  :hints (("goal" :in-theory (enable trunc)
-           )))
-
-(defthm trunc-upper-bound
-  (implies (and (rationalp x)
-                (integerp n))
-           (<= (abs (trunc x n)) (abs x)))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (e/d (abs-trunc) 
-                                  ( ;CANCEL-IN-PRODS-<-3-OF-3-WITH-2-OF-2
-                                   EXPT-COMPARE-EQUAL ;BOZO why?
-                                   CANCEL-COMMON-FACTORS-IN-<
-                                   ))
-           :use (trunc-to-0-or-fewer-bits
-                 (:instance *-weakly-monotonic
-                            (x (expt 2 (- (1+ (expo x)) n)))
-                            (y (fl (* (sig x) (expt 2 (1- n)))))
-                            (y+ (* (sig x) (expt 2 (1- n)))))
-                 (:instance fp-abs)
-                 (:instance expt-split (r 2) (i (1- n)) (j (- (1+ (expo x)) n)))
-                 ))))
-
-
-
-
-;BOZO bad name. should be trunc-equal-0
-(defthm trunc-equal-0-rewrite
-  (implies (and (> n 0)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (equal (trunc x n) 0)
-                  (equal x 0)))
-  :hints (("Goal" :cases ((< x 0) (equal x 0) (< 0 x))
-           )))
-
-(defthm trunc-upper-pos
-    (implies (and (<= 0 x)
-                  (rationalp x)
-		  (integerp n))
-	     (<= (trunc x n) x))
-    :rule-classes :linear
-    :hints (("goal" :in-theory (disable abs-trunc trunc)
-             :use ((:instance trunc-upper-bound)
-                   ))))
-
-#| BOZO prove this and use below
-
-(defthm fl-unique-rewrite
-    (implies (and (<= n x)
-		  (< x (1+ n))
-                  (rationalp x)
-		  (integerp n)
-		  )
-	     (equal (fl x)
-                    n)))
-
-(defthm fl-unique-rewrite-2
-    (implies (and (< x n)
-                  (<= (1- n) x)
-                  (rationalp x)
-		  (integerp n)
-		  )
-	     (equal (fl x)
-                    (1- n))))
-
-;gen to negative x?
-(defthm expo-fl
-  (implies (<= 0 x)
-           (equal (expo (fl x))
-                  (if (<= 1 (abs x))	
-                      (expo x)	
-                    0)
-                  ))
-  :otf-flg t
-  :hints (("Goal" :in-theory (enable expo-equality-reduce-to-bounds
-;expt-split
-                                     ) ;BOZO consider enabling this gloablly?
-;(or make a version for constants, same for expo-comparison...)
-           :use (:instance expo-unique (x (fl x)) (n 0)))))
-
-
-(defthm expo-trunc
-   (implies (and (< 0 n)
-                 (rationalp x)
-                 (integerp n)
-                 )
-            (equal (expo (trunc x n))
-                   (expo x)))
-   :hints (("goal" :in-theory (e/d ( trunc sig)
-                                   (LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)))))
-
-
-|#
-
-(encapsulate
- ()
-;BOZO this seems dumb, given expo-trunc
- (local (defthm expo-trunc-upper-bound
-          (implies (and (< 0 n)
-                        (rationalp x)
-                        (integerp n)
-                        )
-                   (<= (expo (trunc x n)) (expo x)))
-          :rule-classes nil
-          :hints (("goal" 
-                   :use ((:instance trunc-upper-bound)
-
-                         (:instance expo-monotone (x (trunc x n)) (y x)))))))
-
- (local (defthm expo-trunc-lower-bound
-          (implies (and (rationalp x)
-                        (not (= x 0))
-                        (integerp n)
-                        (> n 0))
-                   (>= (abs (trunc x n)) (expt 2 (expo x))))
-          :rule-classes nil
-          :hints (("goal" :in-theory (e/d (abs-trunc) ( expt-compare-equal))
-                   :use ((:instance sig-lower-bound)
-                         (:instance *-weakly-monotonic
-                                    (y (expt 2 (1- n)))
-                                    (y+ (fl (* (sig x) (expt 2 (1- n)))))
-                                    (x (expt 2 (- (1+ (expo x)) n))))
-                         (:instance expt-split (r 2) (i (1- n)) (j (- (1+ (expo x)) n)))
-                         (:instance fl-monotone-linear (x (expt 2 (1- n))) (y (* (expt 2 (1- n)) (sig x)))))))))
-
- (defthm expo-trunc
-   (implies (and (< 0 n)
-                 (rationalp x)
-                 (integerp n)
-                 )
-            (equal (expo (trunc x n))
-                   (expo x)))
-   :hints (("goal" :in-theory (disable abs-trunc)
-            :use ((:instance expo-trunc-lower-bound)
-                  (:instance expo-trunc-upper-bound)
-                  (:instance expo-upper-bound (x (trunc x n)))
-                  (:instance expt-strong-monotone (n (expo x)) (m (1+ (expo (trunc x n)))))))))
- )
-
-(local
-   (defthm trunc-lower-1-2
-     (implies (and (rationalp u)
-                   (rationalp v)
-                   (rationalp r)
-                   (> r 0)
-                   (< u (1+ v)))
-              (< (* r u) (* r (1+ v))))
-     :rule-classes ()))
-
-(defthm trunc-lower-1-3
-    (implies (and (rationalp u)
-                  (rationalp v)
-                  (rationalp r)
-                  (> r 0)
-                  (< u (1+ v)))
-             (< (* r u) (+ r (* r v))))
-    :rule-classes ()
-    :hints (("goal" :in-theory (disable *-strongly-monotonic)
-             :use ((:instance trunc-lower-1-2)))))
-
-(defthm trunc-lower-1
-  (implies (and (rationalp x)
-                (integerp n))
-           (> (abs (trunc x n))
-              (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable expt-split expt-minus abs-trunc)
-                              '())
-           :use ((:instance fp-abs)
-                 (:instance trunc-lower-1-3
-                            (u (* (sig x) (expt 2 (1- n))))
-                            (v (fl (* (sig x) (expt 2 (1- n)))))
-                            (r (expt 2 (- (1+ (expo x)) n))))))))
-
-
-(defthm trunc-lower-2-1
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expt 2 (- (1+ (expo x)) n)) (* (abs x) (expt 2 (- 1 n)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable abs EXPT-COMPARE-EQUAL)
-		  :use ((:instance expo-lower-bound)
-			(:instance expt-split (r 2) (i (expo x)) (j (- 1 n)))))))
-
-(defthm trunc-lower-2
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (disable abs)
-		  :use ((:instance trunc-lower-1)
-			(:instance trunc-lower-2-1)))))
-
-(defthm trunc-lower-pos
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (disable abs-trunc abs-pos)
-		  :use ((:instance trunc-lower-2)))))
-
-(defthm trunc-lower-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (disable abs)
-		  :use ((:instance trunc-lower-1)
-			(:instance trunc-lower-2-1)))))
-(local
- (defthm trunc-lower-4-1
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (abs (trunc x n)) (- (abs x) (* (abs x) (expt 2 (- 1 n))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable abs-trunc)
-		  :use ((:instance trunc-lower-3))))))
-
-(local
- (defthm trunc-lower-4-2
-    (implies (and (rationalp x)
-		  (< x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (trunc x n) x))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable abs-trunc)
-		  :use ((:instance trunc-upper-bound))))))
-
-(defthm trunc-lower-4
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (trunc x n) (- x (* (abs x) (expt 2 (- 1 n))))))
-  :rule-classes :linear
-  :hints (("goal" :in-theory (disable abs-trunc)
-		  :use ((:instance trunc-lower-4-1)
-			(:instance trunc-lower-4-2)
-;			(:instance trunc-pos)
-	;		(:instance trunc-neg)
-                        ))))
-
-(defthm trunc-diff
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable abs-trunc)
-		  :use (;(:instance trunc-diff-1 (y (trunc x n)))  ;drop?
-;			(:instance trunc-neg)
-	;		(:instance trunc-pos)
-			(:instance trunc-upper-bound)
-			(:instance trunc-lower-1)))))
-
-(defthm trunc-diff-pos
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable abs-trunc)
-		  :use ((:instance trunc-diff)
-		;	(:instance trunc-pos)
-			(:instance trunc-upper-bound)))))
-
-
-(defthm trunc-diff-expo-1
-    (implies (and (rationalp x)
-		  (not (= x (trunc x n)))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable abs abs-trunc)
-		  :use ((:instance trunc-diff)
-			(:instance expo-lower-bound (x (- x (trunc x n))))
-			(:instance expt-strong-monotone 
-				   (n (expo (- x (trunc x n))))
-				   (m (- (1+ (expo x)) n)))))))
-;just gets rid of sig...
-(defthmd trunc-rewrite
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0) ;gen?  this isn't in pos-rewrite!
-                  )
-	     (equal (trunc x n)
-		    (* (sgn x) 
-		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
-		       (expt 2 (- (1+ (expo x)) n)))))
-    :hints (("Goal" :in-theory (enable trunc sig expt-split))))
-
-;yuck?
-(local
- (defthm trunc-exactp-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (rationalp z)
-		  (not (= x 0))
-		  (not (= z 0)))
-	     (iff (= (* x y z) (* x (fl y) z))
-		  (integerp y)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable fl-int fl-integerp fl)
-		  :use ((:instance fl-integerp (x y))
-			(:instance *cancell (x (fl y)) (z (* x z))))))))
-
-(defthm trunc-exactp-a
-  (implies (and (rationalp x)
-                (integerp n) 
-                (> n 0))
-           (iff (= x (trunc x n))
-                (exactp x n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable expt-split expt-minus trunc-rewrite exactp2)
-                              '( REARRANGE-NEGATIVE-COEFS-EQUAL
-                                 FL->-INTEGER
-                                 FL-<-INTEGER
-                                 FL-LESS-THAN-ZERO
-                                 fl-strong-monotone
-                                 ))
-           :use ((:instance trunc-exactp-2
-                            (x (sgn x))
-                            (y (* (expt 2 (- (1- n) (expo x))) (abs x)))
-                            (z (expt 2 (- (1+ (expo x)) n))))
-                 ))))
-
-
-(defthm trunc-diff-expo
-    (implies (and (rationalp x)
-		  (not (exactp x n))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable abs abs-trunc)
-		  :use ((:instance trunc-diff-expo-1)
-			(:instance trunc-exactp-a)))))
-(local
- (defthm trunc-exactp-b-2
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0)
-                  )
-	     (integerp (* (trunc x n) (expt 2 (- (1- n) (expo x))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable trunc-rewrite)
-		  :use ()))))
-
-(defthm trunc-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (trunc x n)
-                  (if (acl2-numberp n)
-                      (sgn x)
-                    0)))
-  :hints (("Goal" :in-theory (enable trunc))))
-
-(local (defthm trunc-exactp-b-helper
-    (implies (and; (rationalp x)
-		  (integerp n) ;drop?
-                  )
-	     (exactp (trunc x n) n))
-  :hints (("goal" :in-theory (e/d (exactp2 expt-split) ())
-		  :use ( 
-                         (:instance trunc-exactp-b-2)
-                        (:instance trunc-to-0-or-fewer-bits)
-                        )))))
-
-;improve by concluding (exactp (trunc x n) m+) if m+ >= m ??
-(defthm trunc-exactp-b
-  (exactp (trunc x n) n)
-  :hints (("goal" :in-theory (e/d () (trunc-exactp-b-helper))
-           :use (trunc-exactp-b-helper))))
-
-
-(defthm trunc-exactp-c
-    (implies (and (exactp a n)
-		  (<= a x)
-                  (rationalp x)
-		  (integerp n)
-		  (rationalp a)
-		  )
-	     (<= a (trunc x n)))
-  :hints (("goal" :in-theory (disable abs-trunc trunc-exactp-b)
-		  :use ((:instance trunc-exactp-b)
-			(:instance trunc-exactp-a)
-			(:instance fp+2 (x (trunc x n)) (y a))
-			(:instance trunc-lower-1)
-                        (:instance trunc-upper-bound)
-;			(:instance trunc-pos)
-                        (:instance only-0-is-0-or-negative-exact (x a))
-;
-;                        trunc-non-neg
-                        ))))
-
-(local
- (defthm trunc-monotone-old
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (integerp n)
-		  (>= x 0)
-		  (> n 0)
-		  (<= x y))
-	     (<= (trunc x n) (trunc y n)))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable abs-trunc
-                                      trunc-exactp-b trunc-exactp-c)
-		  :use ((:instance trunc-exactp-b)
-			(:instance trunc-upper-pos)
-			(:instance trunc-exactp-c (x y) (a (trunc x n))))))))
-
-;bad :linear rule; has a free var
-;disable, or not?
-(defthmd trunc-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                )
-           (<= (trunc x n) (trunc y n)))
-  :hints (("Goal" :in-theory (disable trunc-upper-pos)
-           :use (trunc-monotone-old 
-                 (:instance trunc-monotone-old (x (- y))
-                            (y (- x))))))
-  :rule-classes :linear)
-
-(defthmd trunc-pos-rewrite
-  (implies (and (>= x 0)
-                (rationalp x)
-                (integerp n))
-           (equal (trunc x n)
-                  (* (fl (* (expt 2 (- (1- n) (expo x))) x))
-                     (expt 2 (- (1+ (expo x)) n)))))
-  :hints (("goal" :in-theory (enable trunc sgn a15)
-           :use fp-abs)))
-
-(local
- (defthm trunc-trunc-1
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (trunc (trunc x n) m)
-		(* (fl (* (expt 2 (- (1- m) (expo x)))
-			  (* (fl (* (expt 2 (- (1- n) (expo x))) x))
-			     (expt 2 (- (1+ (expo x)) n)))))
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable trunc-pos-rewrite)
-                              '( expo-trunc))
-		  :use (;(:instance trunc-pos)
-			(:instance expo-trunc)
-			(:instance expo-trunc (x (trunc x n)) (n m)))))))
-
-(local
- (defthm trunc-trunc-2
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (trunc (trunc x n) m)
-		(* (fl (* (fl (* (expt 2 (- (1- n) (expo x))) x)) (expt 2 (- m n)))) 
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable EXPT-COMPARE-EQUAL)
-		  :use ((:instance trunc-trunc-1)
-			(:instance expt-split (r 2) (j (- (1- m) (expo x))) (i (- (1+ (expo x)) n))))))))
-
-(local
- (defthm trunc-trunc-3
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (trunc (trunc x n) m)
-		(* (fl (/ (fl (* (expt 2 (- (1- n) (expo x))) x)) (expt 2 (- n m)))) 
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable expt-split expt-minus)
-		  :use ((:instance trunc-trunc-2))))))
-
-(local
- (defthm trunc-trunc-4
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (= (trunc (trunc x n) m)
-		(* (fl (/ (* (expt 2 (- (1- n) (expo x))) x) (expt 2 (- n m)))) 
-		   (expt 2 (- (1+ (expo x)) m)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable fl/int-rewrite )
-           :use (
-                        (:instance trunc-trunc-3)
-			(:instance fl/int-rewrite 
-				   (x (* (expt 2 (- (1- n) (expo x))) x))
-				   (n (expt 2 (- n m)))))))))
-
-(local
- (defthm trunc-trunc-5
-   (implies (and (rationalp x)
-                 (>= x 0)
-                 (integerp n)
-                 (integerp m)
-                 (> m 0)
-                 (>= n m))
-            (= (trunc (trunc x n) m)
-               (* (fl (* (expt 2 (- (1- m) (expo x))) x))
-                  (expt 2 (- (1+ (expo x)) m)))))
-   :rule-classes ()
-   :hints (("goal" :in-theory (enable expt-split expt-minus)
-            :use ((:instance trunc-trunc-4))))))
-
-(local
- (defthm trunc-trunc-old
-    (implies (and ;(rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (>= n m))
-	     (equal (trunc (trunc x n) m)
-		    (trunc x m)))
-  :rule-classes ()
-  :hints (("goal" :use ((:instance trunc-trunc-5)
-                        (:instance TRUNC-POS-REWRITE (n m))
-                        )))))
-
-
-(defthm trunc-trunc
-  (implies (and (>= n m) ;what about other case?
-                (integerp n)
-                (integerp m)
-                )
-           (equal (trunc (trunc x n) m)
-                  (trunc x m)))
-  :hints (("goal" :use (trunc-trunc-old
-                        (:instance trunc-trunc-old (x (- x)))))))
-
-(local
- (defthm plus-trunc-2
-  (implies (and (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (> y 0)
-                (integerp k)
-                (> k 0)
-                (= n (+ k (- (expo x) (expo y))))
-                (exactp x n))
-           (equal (+ x (trunc y k))
-                  (* (fl (* (+ x y) (expt 2 (- (1- k) (expo y)))))
-                     (expt 2 (- (1+ (expo y)) k)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable exactp2 trunc-pos-rewrite a15)
-                              '( fl+int-rewrite))
-           :use ((:instance fl+int-rewrite 
-                            (x (* y (expt 2 (- (1- k) (expo y)))))
-                            (n (* x (expt 2 (- (1- k) (expo y)))))))))))
-
-(defthm plus-trunc
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ k (- (expo x) (expo y)))))
-           (= (+ x (trunc y k))
-              (trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (enable exactp2 trunc-pos-rewrite a15)
-           :use ((:instance plus-trunc-2)
-                 (:instance expo-monotone (y (+ x y)))))))
-
-(defthm trunc-plus-1
-    (implies (and (rationalp y)
-		  (> y 0)
-		  (integerp e)
-		  (< y (expt 2 e)))
-	     (< (expo y) e))
-  :rule-classes ()
-  :hints (("goal" :in-theory (disable expo)
-		  :use ((:instance expo-lower-bound (x y))
-			(:instance expt-strong-monotone (n (expo y)) (m e))))))
-
-(defthm trunc-plus-2
-  (implies (and (rationalp y)
-                (> y 0)
-                (integerp e)
-                (< y (expt 2 e)))
-           (< (+ (expt 2 e) y) (expt 2 (1+ e))))
-  :hints (("Goal" :in-theory (enable expt-split)))
-  :rule-classes ())
-
-#|
-;proved elsewhere?
-(defthm trunc-plus-3
-    (implies (and (rationalp y)
-		  (> y 0)
-		  (integerp e)
-		  (< y (expt 2 e)))
-	     (= (expo (+ (expt 2 e) y)) e))
-  :rule-classes ()
-  :hints (("goal"
-		  :use ((:instance expo-lower-bound (x (+ (expt 2 e) y)))
-			(:instance expo-upper-bound (x (+ (expt 2 e) y)))
-			(:instance trunc-plus-2)
-			(:instance expt-strong-monotone (n (expo (+ (expt 2 e) y))) (m (1+ e)))
-			(:instance expt-strong-monotone (n e) (m (1+ (expo (+ (expt 2 e) y)))))))))
-|#
-
-;a nice lemma?
-(defthm trunc-plus-4
-    (implies (and (rationalp y)
-		  (> y 0)
-		  (integerp e)
-		  (< y (expt 2 e))
-		  (integerp m)
-		  (> m 0)
-		  (integerp k)
-		  (> k 0)
-		  (<= m (1+ k)))
-	     (= (+ (expt 2 e) (trunc y k))
-		(trunc (+ (expt 2 e) y) (- (+ k e) (expo y)))))
-  :rule-classes ()
-  :hints (("goal" :in-theory (e/d (a15) (EXPO-COMPARISON-REWRITE-TO-BOUND))
-		  :use (
-                        (:instance trunc-plus-1)
-;			(:instance trunc-plus-3)
-			(:instance plus-trunc (x (expt 2 e)) )))))
-
-(defthm trunc-plus
-    (implies (and (rationalp y)
-		  (> y 0)
-		  (integerp e)
-		  (< y (expt 2 e))
-		  (integerp m)
-		  (> m 0)
-		  (integerp k)
-		  (> k 0)
-		  (<= m (1+ k)))
-	     (= (trunc (+ (expt 2 e) (trunc y k)) m)
-		(trunc (+ (expt 2 e) y) m)))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)
-		  :use ((:instance trunc-plus-4)
-			(:instance trunc-plus-1)
-;			(:instance trunc-trunc (x (+ (expt 2 e) y)) (n (- (+ k e) (expo y))))
-                        ))))
-
-(defthm trunc-n+k-1
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (= e (- (1+ (expo x)) n))
-		  (= y (- x (trunc x n))))
-	     (< y (expt 2 e)))
-  :rule-classes ()
-  :hints (("Goal"
-		  :use ((:instance trunc-diff-pos)))))
-
-(defthm trunc-n+k-2
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (not (= x (trunc x n)))
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (trunc (+ (expt 2 e) y) (1+ k))
-		(trunc (+ (expt 2 e) z) (1+ k))))
-  :rule-classes ()
-  :hints (("Goal"; :in-theory (disable expo)
-		  :use ((:instance trunc-n+k-1)
-			(:instance trunc-upper-pos)
-			(:instance trunc-plus (k n) (m (1+ k)))))))
-
-(defthm trunc-n+k-3
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (and (equal (trunc x n) (* (fl (* x (expt 2 (- e)))) (expt 2 e)))
-		  (equal (trunc x (+ n k)) (* (fl (* x (expt 2 (- k e)))) (expt 2 (- e k))))))
-    :hints (("Goal" :in-theory (enable trunc-pos-rewrite)))
-  :rule-classes ())
-
-(defthm trunc-n+k-4
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(* (- (fl (* x (expt 2 (- k e))))
-		      (* (expt 2 k) (fl (* x (expt 2 (- e))))))
-		   (expt 2 (- e k)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable trunc-pos-rewrite a15))))
-
-(defthm trunc-n+k-5
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(* (fl (- (* x (expt 2 (- k e)))
-			  (* (expt 2 k) (fl (* x (expt 2 (- e)))))))
-		   (expt 2 (- e k)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable   fl+int-rewrite)
-		  :use ((:instance trunc-n+k-4)
-			(:instance fl+int-rewrite 
-				   (x (* x (expt 2 (- k e)))) 
-				   (n (* (expt 2 k) (fl (* x (expt 2 (- e)))))))))))
-
-(defthm trunc-n+k-6
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(* (fl (* y (expt 2 (- k e))))
-		   (expt 2 (- e k)))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable trunc-pos-rewrite a15)
-		  :use ((:instance trunc-n+k-5)))))
-
-(defthm trunc-n+k-7
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(- (* (+ (expt 2 k) (fl (* y (expt 2 (- k e)))))
-		      (expt 2 (- e k)))
-		   (expt 2 e))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (enable a15 )
-		  :use ((:instance trunc-n+k-6)))))
-
-(defthm trunc-n+k-8
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(- (* (fl (+ (expt 2 k) (* y (expt 2 (- k e)))))
-		      (expt 2 (- e k)))
-		   (expt 2 e))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (disable  fl+int-rewrite)
-		  :use ((:instance trunc-n+k-7)
-			(:instance fl+int-rewrite (x (* y (expt 2 (- k e)))) (n (expt 2 k)))))))
-
-(defthm trunc-n+k-9
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(- (* (fl (* (expt 2 (- k e)) (+ y (expt 2 e))))
-		      (expt 2 (- e k)))
-		   (expt 2 e))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance trunc-n+k-8)
-			(:instance expt-split (r 2) (j e) (i (- k e)))))))
-
-(defthm trunc-n+k-10
-    (implies (and (rationalp y)
-		  (integerp e)
-		  (<= 0 y))
-	     (< 0 (+ y (expt 2 e))))
-  :rule-classes ())
-
-(defthm trunc-n+k-11
-    (implies (and (integerp k)
-		  (> k 0)
-		  (rationalp y)
-		  (> y 0)
-		  (integerp e)
-		  (= (expo (+ (expt 2 e) y)) e))
-	     (= (* (fl (* (expt 2 (- k e)) (+ y (expt 2 e))))
-		   (expt 2 (- e k)))
-		(trunc (+ (expt 2 e) y) (1+ k))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance trunc-n+k-10)
-			(:instance trunc-pos-rewrite (x (+ y (expt 2 e))) (n (1+ k)))))))
-
-(defthm trunc-n+k-12
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (not (= x (trunc x n)))
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(- (trunc (+ (expt 2 e) y) (1+ k))
-		   (expt 2 e))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance trunc-n+k-9)
-			(:instance trunc-n+k-1)
-			(:instance trunc-n+k-11)
-                        (:instance EXPO-X+2**K (x y) (k e))
-;			(:instance trunc-plus-3)
-			(:instance trunc-diff-pos)
-			(:instance trunc-upper-pos)))))
-
-(defthm trunc-n+k-13
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (not (= x (trunc x n)))
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-		  (= y (- x (trunc x n))))
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(- (* (sig (trunc (+ (expt 2 e) y) (1+ k))) (expt 2 e))
-		   (expt 2 e))))
-  :rule-classes ()
-  :hints (("Goal" :in-theory (e/d (sig a15) 
-                                  ())
-		  :use ((:instance trunc-n+k-12)
-			(:instance trunc-n+k-1)
-			(:instance trunc-n+k-11)
-                        (:instance EXPO-X+2**K (x y) (k e))
-;			(:instance trunc-plus-3)
-			(:instance trunc-diff-pos)
-			;(:instance trunc-pos)
-			(:instance trunc-upper-pos)))))
-
-(defthm trunc-n+k-14
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (not (= x (trunc x n)))
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-;		  (= y (- x (trunc x n))) ;removed by eric, had to mention y in
-;the hints
-                  )
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
-		   (expt 2 e))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance trunc-n+k-2 (y (- x (trunc x n))))
-			(:instance trunc-n+k-13 (y (- x (trunc x n))))))))
-
-(defthm trunc-n+k
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp k)
-		  (> k 0)
-		  (integerp n)
-		  (>= n k)
-		  (not (exactp x n))  		  ;;this isn't really needed, but it won't hurt me.
-		  (= e (- (1+ (expo x)) n))
-		  (= z (trunc (- x (trunc x n)) n))
-;		  (= y (- x (trunc x n))) ;removed
-                  )
-	     (= (- (trunc x (+ n k)) (trunc x n))
-		(* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
-		   (expt 2 e))))
-  :rule-classes ()
-  :hints (("Goal" :use ((:instance trunc-n+k-14)
-			(:instance trunc-exactp-a)))))
-
-
- (defthm trunc-shift
-   (implies (integerp n)
-            (equal (trunc (* x (expt 2 k)) n)
-                   (* (trunc x n) (expt 2 k))))
-   :hints (("Goal" :cases ((integerp k))
-            :in-theory (set-difference-theories
-                        (enable sig trunc expt-split)
-                        '()))))
-
-;bad t-p rule? make rewrite too?
-(defthm trunc-integer-type-prescription
-  (implies (and (>= (expo x) n)
-                (case-split (integerp n))
-                )
-           (integerp (trunc x n)))
-  :rule-classes :type-prescription
-  :hints (("goal" :in-theory (set-difference-theories
-                              (enable trunc)
-                              '(EXPT-2-INTEGERP
-                                expt-2-positive-integer-type))
-           :use ((:instance expt-2-positive-integer-type (i (- (1+ (expo x)) n)))))))
-
-;prove a them about trunc of a power of 2?
-
-
-;add to lib?  (alternate form of plus-trunc)
-(defthm plus-trunc-alt
-  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp j)
-                )
-           (= (trunc (+ x y) j)
-              (+ x (trunc y (+ j (- (expo (+ x y))) (expo y))))))
-  :rule-classes ()
-  :hints (("goal" 
-           :use (:instance plus-trunc
-                           (k (+ j (- (expo (+ x y))) (expo y)))))))
-
-;add to lib?
-(defthm plus-trunc-corollary
-  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
-                (exactp x n)
-                (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp n)
-                )
-           (= (trunc (+ x y) n)
-              x))
-  :hints (("Goal"  :in-theory (e/d
-                               (expt-split expt-minus)
-                               ( TRUNC-TO-0-OR-FEWER-BITS
-                                 EXPO-COMPARISON-REWRITE-TO-BOUND
-                                 EXPT-COMPARE-EQUAL))
-           :use ((:instance only-0-is-0-or-negative-exact) 
-                             (:instance trunc-exactp-a)
-                              expo-of-sum-of-disjoint 
-                             (:instance expo<=
-                                        (x y)
-                                        (n (+ (EXPO X) (* -1 N))))
-                             (:instance trunc-to-0-or-fewer-bits (x y)
-                                        (n (+ N (EXPO Y) (* -1 (EXPO (+ X Y))))))
-                             (:instance plus-trunc-alt
-                                        (j n))))))
-
-(defthm trunc-exactp-c-eric
-    (implies (and (exactp a n)
-                  (<= (abs a) (abs x))
-                  (rationalp x)
-		  (integerp n)
-		  (rationalp a)
-		  )
-	     (<= (abs a) (abs (trunc x n))))
-  :hints (("goal" :in-theory (disable abs-trunc trunc-rewrite trunc-exactp-b)
-		  :use (trunc-exactp-c
-                        trunc-upper-bound
-;                        (:instance trunc-rarely-zero (k n))
-                        (:instance trunc-exactp-c (x (- x)) (a a))
-                        (:instance trunc-exactp-c (x x) (a (- a)))
-                        (:instance trunc-exactp-c (x (- x)) (a (- a))))))
-  :otf-flg t)
-
-(defthm trunc-goes-down-rewrite
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (equal (< (trunc x n) x)
-                  (and (< 0 x)
-                       (not (exactp x n)))))
-  :otf-flg t
-  :hints (("Goal" :use (trunc-upper-bound
-                        trunc-exactp-a))))
-
-(defthm trunc-goes-up-rewrite
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (equal (< x (trunc x n))
-                  (and (< x 0)
-                       (not (exactp x n)))))
-  :otf-flg t
-  :hints (("Goal" :in-theory (disable trunc-goes-down-rewrite)
-           :use ((:instance trunc-upper-bound (x (- x)))
-                 trunc-exactp-a))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/trunc.lisp acl2-6.3/books/rtl/rel5/support/trunc.lisp
--- acl2-6.2/books/rtl/rel5/support/trunc.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/trunc.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,476 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;an acl2 library of floating point arithmetic
-
-;;;david m. russinoff
-;;;advanced micro devices, inc.
-;;;february, 1998
-;;;***************************************************************
-
-;some of the things in this book may be cruft which can be deleted...
-
-(include-book "ground-zero")
-(local (include-book "trunc-proofs"))
-
-;;Necessary defuns
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-
-;;
-;; New stuff:
-;;
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;generated automatically by ACL2 when we define trunc, but included here just to be safe could have disabled
-;(:type-prescription trunc) for slight efficiency gain at the cost of making the output of :pe a little
-;deceptive
-(defthm trunc-rational-type-prescription
-  (rationalp (trunc x n))
-  :rule-classes :type-prescription)
-
-(defthm trunc-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (trunc x n)
-                  0)))
-
-(defthm trunc-to-0-or-fewer-bits
-  (implies (and (<= n 0)
-                (integerp n)
-                )
-           (equal (trunc x n)
-                  0)))
-
-;make alt version? use negative-syntaxp?
-(defthm trunc-minus
-  (equal (trunc (* -1 x) n)
-         (* -1 (trunc x n))))
-
-;change what trunc does with n not a positive int?
-(defthm trunc-positive
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (< 0 (trunc x n)))
-  :rule-classes (:rewrite :linear))
-
-;I think this rule has caused the "bad-ass" problem regarding the (case-split (< 0 n)) hyp.
-;BOZO should this include rationalp, to have a more type-like conclusion?
-(defthm trunc-positive-rational-type-prescription
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n)))
-           (< 0 (trunc x n)))
-  :rule-classes :type-prescription)
-
-(defthm trunc-negative
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n)))
-           (< (trunc x n) 0))
-  :rule-classes (:rewrite :linear))
-
-;BOZO should this include rationalp, to have a more type-like conclusion?
-(defthm trunc-negative-rational-type-prescription
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (< (trunc x n) 0))
-  :rule-classes :type-prescription)
-
-(defthm trunc-0 
-  (equal (trunc 0 n) 
-         0))
-
-;trying the case-split
-(defthm trunc-of-non-rationalp-is-0-alt
-  (implies (case-split (not (rationalp x)))
-           (equal (trunc x n)
-                  0)))
-
-(defthm trunc-non-negative-rational-type-prescription
-  (implies (and (<= 0 x)
-                (case-split (integerp n))
-                )
-           (and (<= 0 (trunc x n))
-                (rationalp (trunc x n))))
-  :rule-classes :type-prescription)
-
-(defthm trunc-non-positive-rational-type-prescription
-  (implies (and (<= x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (and (<= (trunc x n) 0)
-                (rationalp (trunc x n))))
-  :rule-classes :type-prescription)
-
-;make an away version?
-(defthm trunc-non-negative-linear
-  (implies (and (<= 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (<= 0 (trunc x n)))
-  :rule-classes :linear)
-
-;make an away version?
-(defthm trunc-non-positive-linear
-  (implies (and (<= x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (<= (trunc x n) 0))
-  :rule-classes :linear)
-
-(defthm sgn-trunc
-  (implies (and (< 0 n)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (sgn (trunc x n))
-                  (sgn x))))
-
-
-;why not just open up trunc and sgn?
-;keep this disabled, since it basically opens up TRUNC
-(defthmd abs-trunc
-  (equal (abs (trunc x n))
-         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
-
-(defthm trunc-upper-bound
-  (implies (and (rationalp x)
-                (integerp n))
-           (<= (abs (trunc x n)) (abs x)))
-  :rule-classes :linear)
-
-;BOZO bad name. should be trunc-equal-0
-(defthm trunc-equal-0-rewrite
-  (implies (and (> n 0)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (equal (trunc x n) 0)
-                  (equal x 0))))
-
-(defthm trunc-upper-pos
-    (implies (and (<= 0 x)
-                  (rationalp x)
-		  (integerp n))
-	     (<= (trunc x n) x))
-    :rule-classes :linear)
-
-(defthm expo-trunc
-   (implies (and (< 0 n)
-                 (rationalp x)
-                 (integerp n)
-                 )
-            (equal (expo (trunc x n))
-                   (expo x))))
-
-;which of these do we want to export?
-(defthm trunc-lower-1
-  (implies (and (rationalp x)
-                (integerp n))
-           (> (abs (trunc x n))
-              (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes :linear)
-
-(defthm trunc-lower-2-1
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expt 2 (- (1+ (expo x)) n)) (* (abs x) (expt 2 (- 1 n)))))
-  :rule-classes ())
-
-(defthm trunc-lower-2
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-lower-pos
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-lower-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-lower-4
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (trunc x n) (- x (* (abs x) (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-diff
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes ())
-
-(defthm trunc-diff-pos
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes ())
-
-(defthm trunc-diff-expo-1
-    (implies (and (rationalp x)
-		  (not (= x (trunc x n)))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
-  :rule-classes ())
-
-;just gets rid of sig...
-(defthmd trunc-rewrite
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0) ;gen?  this isn't in pos-rewrite!
-                  )
-	     (equal (trunc x n)
-		    (* (sgn x) 
-		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
-		       (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm trunc-exactp-a
-  (implies (and (rationalp x)
-                (integerp n) 
-                (> n 0))
-           (iff (= x (trunc x n))
-                (exactp x n)))
-  :rule-classes ())
-
-(defthm trunc-diff-expo
-    (implies (and (rationalp x)
-		  (not (exactp x n))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
-  :rule-classes ())
-
-;improve by concluding (exactp (trunc x n) m+) if m+ >= m ??
-(defthm trunc-exactp-b
-  (exactp (trunc x n) n))
-
-(defthmd trunc-exactp-c
-  (implies (and (exactp a n)
-                (<= a x)
-                (rationalp x)
-                (integerp n)
-                (rationalp a)
-                )
-           (<= a (trunc x n))))
-
-(defthm trunc-exactp-c-eric
-    (implies (and (exactp a n)
-                  (<= (abs a) (abs x))
-                  (rationalp x)
-		  (integerp n)
-		  (rationalp a)
-		  )
-	     (<= (abs a) (abs (trunc x n)))))
-
-;bad :linear rule; has a free var
-;disable, or not?
-(defthmd trunc-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                )
-           (<= (trunc x n) (trunc y n)))
-  :rule-classes :linear)
-
-(defthmd trunc-pos-rewrite
-  (implies (and (>= x 0)
-                (rationalp x)
-                (integerp n))
-           (equal (trunc x n)
-                  (* (fl (* (expt 2 (- (1- n) (expo x))) x))
-                     (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm trunc-trunc
-  (implies (and (>= n m) ;what about other case?
-                (integerp n)
-                (integerp m)
-                )
-           (equal (trunc (trunc x n) m)
-                  (trunc x m))))
-
-(defthm plus-trunc
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ k (- (expo x) (expo y)))))
-           (= (+ x (trunc y k))
-              (trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ())
-
-(defthm trunc-plus
-    (implies (and (rationalp y)
-		  (> y 0)
-		  (integerp e)
-		  (< y (expt 2 e))
-		  (integerp m)
-		  (> m 0)
-		  (integerp k)
-		  (> k 0)
-		  (<= m (1+ k)))
-	     (= (trunc (+ (expt 2 e) (trunc y k)) m)
-		(trunc (+ (expt 2 e) y) m)))
-  :rule-classes ())
-
-;what's the purpose of this one?
-(defthm trunc-n+k
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp k)
-                (> k 0)
-                (integerp n)
-                (>= n k)
-                (not (exactp x n)) ;;this isn't really needed, but it won't hurt me.
-                (= e (- (1+ (expo x)) n))
-                (= z (trunc (- x (trunc x n)) n))
-;		  (= y (- x (trunc x n))) ;removed
-                )
-           (= (- (trunc x (+ n k)) (trunc x n))
-              (* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
-                 (expt 2 e))))
-  :rule-classes ())
-
- (defthm trunc-shift
-   (implies (integerp n)
-            (equal (trunc (* x (expt 2 k)) n)
-                   (* (trunc x n) (expt 2 k)))))
-
-;bad t-p rule? make rewrite too?
-(defthm trunc-integer-type-prescription
-  (implies (and (>= (expo x) n)
-                (case-split (integerp n))
-                )
-           (integerp (trunc x n)))
-  :rule-classes :type-prescription)
-
-;prove a them about trunc of a power of 2?
-
-
-;add to lib?  (alternate form of plus-trunc)
-(defthm plus-trunc-alt
-  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
-                (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp j)
-                )
-           (= (trunc (+ x y) j)
-              (+ x (trunc y (+ j (- (expo (+ x y))) (expo y))))))
-  :rule-classes ())
-
-;add to lib?
-(defthm plus-trunc-corollary
-  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
-                (exactp x n)
-                (rationalp x)
-                (> x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp n)
-                )
-           (= (trunc (+ x y) n)
-              x)))
-
-(defthm trunc-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (trunc x n)
-                  (if (acl2-numberp n)
-                      (sgn x)
-                    0))))
-
-;do we want these enabled?
-
-(defthm trunc-goes-down-rewrite
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (equal (< (trunc x n) x)
-                  (and (< 0 x)
-                       (not (exactp x n))))))
-
-(defthm trunc-goes-up-rewrite
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (equal (< x (trunc x n))
-                  (and (< x 0)
-                       (not (exactp x n))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/support/util.lisp acl2-6.3/books/rtl/rel5/support/util.lisp
--- acl2-6.2/books/rtl/rel5/support/util.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/support/util.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,123 +0,0 @@
-(in-package "ACL2")
-
-;;These macros facilitate localization of events:
-
-(defmacro local-defun (&rest body)
-  (list 'local (cons 'defun body)))
-
-(defmacro local-defund (&rest body)
-  (list 'local (cons 'defund body)))
-
-(defmacro local-defthm (&rest body)
-  (list 'local (cons 'defthm body)))
-
-(defmacro local-defthmd (&rest body)
-  (list 'local (cons 'defthmd body)))
-
-(defmacro local-in-theory (&rest body)
-  (cons 'local
-	(cons (cons 'in-theory (append body 'nil))
-	      'nil)))
-
-(defmacro defbvecp (name formals width &key thm-name hyp hints)
-  (let* ((thm-name
-          (or thm-name
-              (intern-in-package-of-symbol
-               (concatenate 'string
-                            (if (consp width)
-                                "BV-ARRP$"
-                              "BVECP$")
-                            (symbol-name name))
-               name)))
-         (x (cons name formals))
-         (typed-term (if (consp width)
-                         (list 'ag 'index x)
-                       x))
-         (bvecp-concl (if (consp width)
-                          (list 'bv-arrp x (car (last width)))
-                        (list 'bvecp x width)))
-         (concl (list 'and
-                      (list 'integerp typed-term)
-                      (list '<= 0 typed-term))))
-    (list* 'defthm thm-name
-           (if hyp
-               (list 'implies hyp bvecp-concl)
-             bvecp-concl)
-           :rule-classes
-           (list
-            :rewrite
-            (list :forward-chaining :trigger-terms (list x))
-            (list :type-prescription
-                  :corollary
-                  (if hyp
-                      (list 'implies hyp concl)
-                    concl)
-                  :typed-term typed-term
-                  ;; hints for the corollary 
-                  :hints
-                  (if (consp width)
-                      '(("Goal"
-                         :in-theory
-                         '(implies bvecp
-                                   bv-arrp-implies-nonnegative-integerp)))
-                    '(("Goal"
-                       :in-theory
-                       '(implies bvecp))))))
-           (if hints (list :hints hints) nil))))
-
-(defun sub1-induction (n)
-      (if (zp n)
-          n
-        (sub1-induction (1- n))))
-
-; These will be the functions to disable in acl2 proofs about signal bodies.
-; We use this in the compiler.
-;BOZO This doesn't include cons, which can now appear in signals defs.  I think that's okay, right?  think
-;about this and remove the BOZO
-(defconst *rtl-operators-after-macro-expansion*
-  '(log= log<> 
-    log< log<= log> log>= 
-    comp2< comp2<= comp2> comp2>=
-    land lior lxor lnot
-    logand1 logior1 logxor1
-    shft
-    cat mulcat
-    bits bitn setbits setbitn 
-    ag as
-    * + ; from macroexpansion of mod* or mod+
-    ;mod- ;now a macro!
-    floor rem decode encode
-    ;; bind ; handled specially in fixup-term
-    ;; if1 ;  a macro, so we don't disable it
-    ;; quote, n!, arr0 ; handled specially in fixup-term
-    natp1 ; doesn't matter, only occurs in for-loop defuns (must be enabled in those proofs anyway)
-    mk-bvarr mk-bvec
-    ))
-
-; Macro fast-and puts conjunctions in a tree form, which can avoid stack
-; overflows by ACL2's translate functions.
-
-(defun split-list (lst lo hi)
-  (cond ((endp lst) 
-         (mv lo hi))
-        ((endp (cdr lst)) 
-         (mv (cons (car lst) lo) hi))
-        (t
-         (split-list (cddr lst)
-                     (cons (car lst) lo)
-                     (cons (cadr lst) hi)))))
-
-(defun fast-and-fn (conjuncts)
-  (declare (xargs :mode :program))
-  (cond ((endp conjuncts) ''t)
-        ((endp (cdr conjuncts)) (car conjuncts))
-        (t
-         (mv-let (hi lo)
-             (split-list conjuncts () ())
-           (list 'if
-                 (fast-and-fn hi)
-                 (fast-and-fn lo)
-                 'nil)))))
-
-(defmacro fast-and (&rest conjuncts)
-  (fast-and-fn conjuncts))
diff -Nru acl2-6.2/books/rtl/rel5/user/Makefile acl2-6.3/books/rtl/rel5/user/Makefile
--- acl2-6.2/books/rtl/rel5/user/Makefile	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-include ../../../Makefile-generic
--include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel5/user/README acl2-6.3/books/rtl/rel5/user/README
--- acl2-6.2/books/rtl/rel5/user/README	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/README	1970-01-01 00:00:00.000000000 +0000
@@ -1,22 +0,0 @@
-Please email suggestions for improvements to the ACL2 developers or to
-ewsmith@stanford.edu.
-
-Use user/ at your own risk!  The user/ directory is an attempt to pull out some useful rules which were in
-support/ but not in lib/.  However, like support/, user/ is kind of a mess. There wasn't time to think through
-all of the rules we added to user/, but it seemed better to create it than to do nothing.  Someday, we'd like
-to think through user/ and create a really nice set of books.
-
-Many or most (or all) of the user/ books were derived from books with the same names in support/.  More
-extensive comments can be found in the latter, along with extra lemmas in some cases. The reader is welcomed
-to compare correponding user/ and support/ books to see what is missing from user/, and to suggest
-improvements.
-
-BOZO Currently, there may be a problem with user/: Eventually we want to make it good enough to be a
-replacement for lib/, but right now, it lacks some rules from lib/ (not all the books we plan to put in user/
-have been created).  So one should include books from lib/ and the optional user/ books.  But this means that
-a rule disabled in lib/ but intentionally enabled in user/ will still be disabled for that person.  We could
-add explicit enables in user/ (and include user/ after including lib/) as we discover such lemmas.
-
-For rules about functions not mentioned in user/ here but which arise from opening up functions dealt with in
-user/ (e.g., binary-logand which arises from opening binary-land), see the appropriate books in support/ e.g.,
-support/binary-logand).
diff -Nru acl2-6.2/books/rtl/rel5/user/away.lisp acl2-6.3/books/rtl/rel5/user/away.lisp
--- acl2-6.2/books/rtl/rel5/user/away.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/away.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,359 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-;there may be some cruft to be deleted from this file...
-
-(include-book "trunc") ;make local?
-(local (include-book "../support/away"))
-
-;; Necessary defuns
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-;;
-;; Start of new stuff
-;;
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;generated automatically by ACL2 when we define away, but included here just to be safe
-;could disable (:type-prescription away) for slight efficiency gain at the cost of making the output of :pe a
-;little deceptive
-(defthm away-rational-type-prescription
-  (rationalp (away x n))
-  :rule-classes :type-prescription)
- 
-(defthm away-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (away x n)
-                  0)))
-
-;make alt version? use negative-syntaxp?
-(defthm away-minus
-  (= (away (* -1 x) n)
-     (* -1 (away x n))))
-
-(defthm away-positive
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                )
-           (< 0 (away x n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm away-positive-rational-type-prescription
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                )
-           (and (< 0 (away x n))
-                (rationalp (away x n))))
-  :rule-classes :type-prescription)
-
-(defthm away-negative
-    (implies (and (< x 0)
-                  (case-split (rationalp x))
-                  )
-	     (< (away x n) 0))
-    :rule-classes (:rewrite :linear))
-
-(defthm away-negative-rational-type-prescription
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                )
-           (< (away x n) 0))
-  :rule-classes :type-prescription)
-
-(defthm away-0
-  (equal (away 0 n)
-         0))
-
-(defthm away-non-negative-rational-type-prescription
-  (implies (<= 0 x)
-           (and (<= 0 (away x n))
-                (rationalp (away x n))))
-  :rule-classes :type-prescription)
-
-(defthm away-non-positive-rational-type-prescription
-  (implies (<= x 0)
-           (and (<= (away x n) 0)
-                (rationalp (away x n))))
-  :rule-classes :type-prescription)
-
-(defthm away-equal-0-rewrite
-  (implies (rationalp x)
-           (equal (equal (away x n) 0)
-                  (equal x 0))))
-
-(defthm sgn-away
-  (equal (sgn (away x n))
-         (sgn x)))
-
-;keep this disabled, since it basically opens up AWAY
-(defthmd abs-away
-  (implies (and (rationalp x)
-                (integerp n))
-           (equal (abs (away x n))
-                  (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
-
-;kind of gross...
-(defthm away-to-0-or-fewer-bits
-  (implies (and (<= n 0)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (away x n)
-                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
-
-(defthm away-lower-bound
-    (implies (and (case-split (rationalp x))
-		  (case-split (integerp n))
-                  )
-	     (>= (abs (away x n)) (abs x)))
-  :rule-classes :linear)
-
-(defthm away-lower-pos
-    (implies (and (>= x 0)
-                  (case-split (rationalp x))
-		  (case-split (integerp n))
-                  )
-	     (>= (away x n) x))
-  :rule-classes :linear)
-
-;elim?
-(defthm expo-away-lower-bound
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (>= (expo (away x n)) (expo x)))
-  :rule-classes :linear)
-
-(defthm away-upper-1
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes :linear)
-
-(defthm away-upper-2
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (integerp n)
-                (> n 0))
-           (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm away-upper-pos
-    (implies (and (> x 0)
-                  (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (away x n) (* x (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm away-upper-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm away-diff
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes :linear)
-
-(defthm away-diff-pos
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes :linear)
-
-
-(defthm away-diff-expo-1
-    (implies (and (rationalp x)
-		  (not (= x (away x n)))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- (away x n) x)) (- (expo x) n)))
-  :rule-classes :linear)
-;slow
-(defthmd away-rewrite
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (equal (away x n)
-                  (* (sgn x) 
-                     (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
-                     (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm away-exactp-a
-    (implies (and (rationalp x)
-		  (integerp n) 
-		  (> n 0))
-	     (iff (= x (away x n))
-		  (exactp x n)))
-  :rule-classes ())
-
-(defthm away-diff-expo
-    (implies (and (rationalp x)
-		  (not (exactp x n))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- (away x n) x)) (- (expo x) n)))
-  :rule-classes :linear)
-
-(defthm away-exactp-b
-    (implies (case-split (< 0 n))
-	     (exactp (away x n) n)))
-
-(defthmd away-exactp-c
-    (implies (and (exactp a n)
-		  (>= a x)
-                  (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  )
-	     (>= a (away x n))))
-
-;trying disabled?
-(defthmd away-monotone
-  (implies (and (rationalp x)
-                (rationalp y)
-                (integerp n)
-                (<= x y))
-           (<= (away x n) (away y n)))
-  :rule-classes :linear)
-
-(defthm away-exactp-d
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthmd away-pos-rewrite
-  (implies (and (rationalp x)
-                (>= x 0)
-                (integerp n))
-           (equal (away x n)
-                  (* (cg (* (expt 2 (- (1- n) (expo x))) x))
-                     (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm expo-away
-  (implies (and (rationalp x)
-                (not (= x 0))
-                (integerp n)
-                (> n 0)
-                (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
-           (equal (expo (away x n))
-                  (expo x)))
-  :rule-classes ())
-
-;handle the case where n<m?
-(defthm away-away
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (integerp m)
-		  (> m 0)
-		  (>= n m))
-	     (equal (away (away x n) m)
-		    (away x m))))
-
-(defthm away-shift
-  (implies (integerp n)
-           (= (away (* x (expt 2 k)) n)
-              (* (away x n) (expt 2 k)))))
-
-;BOZO move to trunc! ?
-(defthm trunc-away-a
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (- x (expt 2 (- (expo x) n)))
-		(trunc x n)))
-  :rule-classes ())
-
-(defthm trunc-away-b
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0)
-		  (exactp x (1+ n))
-		  (not (exactp x n)))
-	     (= (away x n)
-		(+ x (expt 2 (- (expo x) n)))))
-  :rule-classes ())
-
-(defthm away-imp
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (integerp m)
-		  (>= m n)
-		  (exactp x m))
-	     (= (away x n)
-		(trunc (+ x
-			  (expt 2 (- (1+ (expo x)) n))
-			  (- (expt 2 (- (1+ (expo x)) m))))
-		       n)))
-  :rule-classes ())
-
diff -Nru acl2-6.2/books/rtl/rel5/user/bias.lisp acl2-6.3/books/rtl/rel5/user/bias.lisp
--- acl2-6.2/books/rtl/rel5/user/bias.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/bias.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,54 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "../support/bias"))
-
-;; Necessary defuns
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-;; Start of new stuff
-
-; bias of a q bit exponent field is 2^(q-1)-1 
-(defund bias (q) (- (expt 2 (- q 1)) 1) )
-
-(defthm bias-non-negative-integerp-type-prescription
-  (implies (and (case-split (integerp q))
-                (case-split (< 0 q))
-                )
-           (and (integerp (bias q))
-                (<= 0 (bias q))))
-  :rule-classes :TYPE-PRESCRIPTION)
-
-;BOZO rename q2 to k?
-(defthm bias-bvecp
-   (implies (and (<= (+ -1 q) q2)
-                 (case-split (< 0 q))
-                 (case-split (integerp q))
-                 (case-split (integerp q2))
-                 )
-            (bvecp (bias q) q2)))
-
-(defthm bias-integerp-rewrite
-  (equal (integerp (bias q))
-         (or (and (acl2-numberp q) (not (integerp q)))
-             (<= 1 q))))
-
-;where's bias-integerp?
-(defthm bias-integerp
-  (implies (case-split (< 0 k))
-           (integerp (bias k))))
-
-(defthm bias-with-q-an-acl2-number-but-not-an-integer
-  (implies (and (not (integerp q))
-                (case-split (acl2-numberp q)))
-           (equal (bias q)
-                  0)))
-
-(defthm bias-with-q-not-an-acl2-number
-  (implies (not (acl2-numberp q))
-           (equal (bias q)
-                  -1/2)))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/user/bitn.lisp acl2-6.3/books/rtl/rel5/user/bitn.lisp
--- acl2-6.2/books/rtl/rel5/user/bitn.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/bitn.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,636 +0,0 @@
-(in-package "ACL2")
-
-;(include-book "ground-zero")
-(include-book "../arithmetic/power2p")
-(include-book "../arithmetic/negative-syntaxp")
-(local (include-book "../support/bitn"))
-(local (include-book "../support/guards"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-;; Necessary defuns:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;;
-;; Begin bitn stuff...
-;;
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defthm bitn-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (bitn x n)
-                  0)))
-
-(defthm bitn-of-non-rational
-  (implies (not (rationalp x))
-           (equal (bitn x n)
-                  0)))
-
-(defthm bitn-nonnegative-integer
-  (and (integerp (bitn x n))
-       (<= 0 (bitn x n)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than bitn-nonnegative-integer and might be worse:
-(in-theory (disable (:type-prescription bitn)))
-
-(defthm bitn-natp
-  (natp (bitn x n)))
-
-(defthm bitn-upper-bound
-  (<= (bitn x n) 1))
-
-(defthm bitn-upper-bound-linear
-  (<= (bitn x n) 1)
-  :rule-classes ((:LINEAR :TRIGGER-TERMS ((bitn x n)))))
-
-;include separate cases?
-;BOZO one of the branches simplifies to 0 - see bits-minus
-(defthm bitn-minus
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x)) ;gen?
-                (case-split (integerp n))
-                )
-           (equal (bitn x n)
-                  (if (integerp (/ x (expt 2 (+ 1 n))))
-                      (- (bitn (- x) n))
-                    (if (integerp (/ x (expt 2 n)))
-                        (- 2 (bitn (- x) n))
-                      (- 1 (bitn (- x) n)))))))
-;1 rewrite to odd?
-;trying disabled
-(defthmd bitn-0-rewrite-to-even
-  (implies (integerp x)
-           (equal (equal (bitn x 0) 0)
-                  (integerp (* 1/2 x)))))
-
-;we probably want this enanled in lib/ but not in support/
-(defthmd bits-n-n-rewrite
-  (equal (bits x n n)
-         (bitn x n)))
-
-(theory-invariant (incompatible (:rewrite bits-n-n-rewrite)
-                                (:definition bitn)
-                                )
-                  :key bitn-and-bits-n-n-can-loop)
-
-(defthm bitn-0-1
-  (or (equal (bitn x n) 0)
-      (equal (bitn x n) 1))
-  :rule-classes nil)
-
-
-;my strategy with the rules below is to prefer (not (equal (bitn x n) 0)) over (equal (bitn x n) 1)
-;this allows subsumption to ...
-;but maybe this is a bad idea!
-;BOZO if we have f-w chaining rule to handle this issue, perhaps drop these rules?
-
-;bad to have both?
-(defthm bitn-not-0-means-1
-  (equal (not (equal (bitn x n) 0))
-         (equal (bitn x n) 1)))
-
-(defthm bitn-not-1-means-0
-  (equal (not (equal (bitn x n) 1))
-         (equal (bitn x n) 0)))
-
-;these are bad rules?
-(in-theory (disable bitn-not-1-means-0 bitn-not-0-means-1))
-
-(defthm bitn-bitn
-  (equal (bitn (bitn x n) 0)
-         (bitn x n)))
-
-(defthm bitn-known-not-0-replace-with-1
-  (implies (not (equal (bitn x n) 0)) ; backchain-limit?
-           (equal (bitn x n)
-                  1))
-  :rule-classes ((:rewrite :backchain-limit-lst (1)))
-  )
-
-;needed?
-(defthm bitn->-0
-  (equal (< 0 (bitn x n))
-         (not (equal 0 (bitn x n)))))
-
-(defthm bitn-<-1
-  (equal (< (BITN X n) 1)
-         (equal (BITN X n) 0)))
-
-;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
-(defthm bitn-not->-1
-  (implies (and (syntaxp (quotep k))
-                (<= 1 k))
-           (equal (< k (bitn x n))
-                  nil)))
-
-;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
-(defthm bitn-<=-1
-  (implies (and (syntaxp (quotep k))
-                (< 1 k))
-           (equal (< (bitn x n) k)
-                  t)))
-
-(defthmd bitn-rec-0
-  (implies (integerp x)
-           (equal (bitn x 0)
-                  (mod x 2))))
-
-;rename?
-;is there a bits analog of this theorem?
-;BOZO change formal k to n
-(defthmd bitn-rec-pos
-  (implies (< 0 n) ;n cannot be 0 or negative
-           (equal (bitn x n)
-                  (bitn (fl (/ x 2)) (1- n))))
-  :rule-classes ((:definition :controller-alist ((bitn t t)))))
-
-;BOZO change k param to n
-(defthmd bitn-def
-  (implies (case-split (integerp n))
-           (equal (bitn x n)
-                  (mod (fl (/ x (expt 2 n)))
-                       2))))
-
-;make bit-not, bit-and, etc. ?
-;BOZO or remove this function?
-(defun not-eric (x)
-  (if (equal x 0)
-      1
-    0))
-
-(defthm bitn-drop-crucial-bit-and-flip-result
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp n)) ;drop?
-                )
-           (and (equal (bitn (+ (expt 2 n) x) n)
-                       (not-eric (bitn x n)))
-                (equal (bitn (+ x (expt 2 n)) n)
-                       (not-eric (bitn x n))))))
-
-;BOZO this looped!
-(defthmd bitn-drop-crucial-bit-and-flip-result-alt-gen
-  (implies (and (syntaxp (and (quotep j) 
-                              (< (cadr j) (expt 2 (+ 1 (cadr n)))) ;bitn-sum-lowbits does most of the work
-                              (>= (cadr j) (expt 2 (cadr n)))))
-                (rationalp j)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (bitn (+ j x) n)
-                  (not-eric (bitn (+ (- j (expt 2 n)) x) n)))))
-
-;for negative constants j
-;might be slow if the negative constant has a large absolute value
-;make a negative version of bitn-sum-lowbits
-(defthm bitn-add-crucial-bit-and-flip-result
-  (implies (and (syntaxp (and (quotep j) 
-                              (quotep n)
-                              (< (cadr j) 0)))
-                (rationalp j)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (bitn (+ j x) n)
-                  (not-eric (bitn (+ (+ j (expt 2 n)) x) n)))))
-
-(defthm bitn-equal-to-silly-value
-  (implies (and (syntaxp (quotep k))
-                (not (or (equal 0 k) (equal 1 k)))
-                )
-           (equal (equal k (bitn x n))
-                  nil)))
-                         
-(defthm bitn-split-around-zero
-  (implies (and (<= (- (expt 2 n)) x)
-                (< x (expt 2 n))
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (equal (bitn x n) 0)
-                  (<= 0 x))))
-
-;drop silly hyps like: (<= -128 (bitn x 24))
-(defthm bitn-drop-silly-bound
-  (implies (and (syntaxp (quotep k))
-                (<= k 0)
-                )
-           (equal (< (bitn x n) k)
-                  nil)))
-
-(defthm bitn-drop-silly-bound-2
-  (implies (and (syntaxp (quotep k))
-                (< k 0)
-                )
-           (equal (< k (bitn x n))
-                  t)))
-
-;there are many other ways to say that something is even (include those?)
-(defthm bitn-even-means-0
-  (equal (integerp (* 1/2 (bitn x n)))
-         (equal (bitn x n) 0)))
-
-;new - export disabled?
-(defthm bitn-too-small
-  (implies (and (< x (expt 2 n))
-                (<= 0 x) ;case-split?
-                )
-           (equal (bitn x n)
-                  0))
-  :rule-classes ((:rewrite :backchain-limit-lst (1 nil))))
-
-;not sure how to handle this.
-(defthmd bitn-normal-form
-  (equal (equal (bitn x n) 1)
-         (not (equal (bitn x n) 0))))
-
-(defthm bitn-bvecp
-  (implies (and (<= 1 k)
-                (case-split (integerp k)))
-           (bvecp (bitn x n) k)))
-
-(defthm bitn-times-fraction-integerp 
-  (implies (and (not (integerp k))
-                (case-split (acl2-numberp k))
-                )
-           (equal (INTEGERP (* k (BITN x n)))
-                  (equal (BITN x n) 0))))
-
-(defthm bitn-in-product-split-cases
-  (and (implies (case-split (acl2-numberp k))
-                (equal (* (bitn x n) k)
-                       (if (equal (bitn x n) 0)
-                           0
-                         k)))
-       (implies (case-split (acl2-numberp k))
-                (equal (* k (bitn x n))
-                       (if (equal (bitn x n) 0)
-                           0
-                         k)))))
-
-(defthm bitn-in-sum-split-cases
-  (and (implies (case-split (acl2-numberp k))
-                (equal (+ k (bitn x n))
-                       (if (equal (bitn x n) 0)
-                           k
-                         (+ k 1))))
-       (implies (case-split (acl2-numberp k))
-                (equal (+ (bitn x n) k)
-                       (if (equal (bitn x n) 0)
-                           k
-                         (+ k 1))))))
-
-;BOZO change params
-(defthm bitn-0
-  (equal (bitn 0 k)
-         0))
-
-(defthmd bitn-fw-1
-  (implies (not (equal (bitn x n) 0))
-           (equal (bitn x n) 1)
-           )
-  :rule-classes (:forward-chaining))
-
-(defthmd bitn-fw-2
-  (implies (not (equal (bitn x n) 1))
-           (equal (bitn x n) 0)
-           )
-  :rule-classes (:forward-chaining))
-
-;may cause case splits (maybe that's good?) 
-(defthm bitn-expt-gen
-  (implies (case-split (integerp i))
-           (equal (bitn (expt 2 i) n)
-                  (if (equal i n)
-                      1
-                    0))))
-
-;BOZO consider having only the rule above?
-(defthmd bitn-expt
-  (implies (case-split (integerp n))
-           (equal (bitn (expt 2 n) n) 1)))
-
-
-;These are intended for the (perhaps weird) case when x in (bitn x n) is a constant but n is not a constant.
-;I actually had this term in a proof: (EQUAL (BITN 128 (BITS <signal-name> 8 6)) 0)
-(defthm bitn-of-expt-equal-0
-  (implies (and (syntaxp (quotep x))
-                (equal x (expt 2 (expo x))) ;means x is a power of 2
-                )
-           (equal (equal (bitn x n) 0)
-                  (not (equal n (expo x))))));note that (expo x) will be a constant since x is
-
-(defthm bitn-of-expt-equal-1
-  (implies (and (syntaxp (quotep x))
-                (equal x (expt 2 (expo x))) ;means x is a power of 2
-                )
-           (equal (equal (bitn x n) 1)
-                  (equal n (expo x))))) ;note that (expo x) will be a constant since x is
-
-(defthmd bitn-expt-0
-  (implies (and (not (equal i n))
-		(case-split (integerp i)))
-	   (equal (bitn (expt 2 i) n) 0)))
-
-(defthm bitn-0-1
-    (or (equal (bitn x n) 0)
-        (equal (bitn x n) 1))
-  :rule-classes ())
-
-;BOZO enable?
-(defthmd bitn-shift-eric
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* x (expt 2 k)) n)
-                  (bitn x (+ n (- k))))))
-
-(defthmd bitn-shift-eric-2
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* (expt 2 k) x) n)
-                  (bitn x (+ n (- k))))))
-
-;BOZO replace with bitn-shift-eric ??
-(defthmd bitn-shift
-  (implies (and (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (* x (expt 2 k)) (+ n k))  ;BOZO rewrite the (+ n k) to match better
-                  (bitn x n)))) 
-
-;dammit, ACL2 unifies 0 with (* 2 x), so this rule can loop!
-(defthm bitn-shift-by-2
-  (implies (and (syntaxp (not (quotep x)))
-                (acl2-numberp n))
-           (equal (BITN (* 2 x) n)
-                  (bitn x (+ -1 n)))))
-
-(defthmd bitn-plus-mult
-  (implies (and (< n m)
-                (integerp m)
-                (integerp k)
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn x n))))
-
-;we almost always want to leave this disabled!
-(defthmd bitn-plus-bits
-  (implies (and (<= m n)
-                (integerp m)
-                (integerp n)
-                )
-           (= (bits x n m)
-              (+ (* (bitn x n) (expt 2 (- n m)))
-                 (bits x (1- n) m)))))
-
-;BOZO it's in r-c nil.  we almost always want to leave this disabled!
-(defthm bits-plus-bitn
-    (implies (and (<= m n)
-                  (integerp m)
-		  (integerp n)
-		  )
-	     (= (bits x n m)
-		(+ (bitn x m)
-		   (* 2 (bits x n (1+ m))))))
-  :rule-classes ())
-
-;drop?
-(defthm bits-0-bitn-0
-  (implies (and (<= 0 n)
-                (integerp n)
-                )
-           (iff (= (bits x n 0) 0)
-                (and (= (bitn x n) 0)
-                     (= (bits x (1- n) 0) 0))))
-  :rule-classes ())
-
-;Follows from bits-shift-down
-(defthmd bitn-shift-down
-  (implies (and (natp i)
-                (integerp k))
-           (equal (bitn (fl (/ x (expt 2 k))) i)
-                  (bitn x (+ i k)))))
-
-(defthm bitn-shift-by-constant-power-of-2
-  (implies (and (syntaxp (quotep k))
-                (power2p k)
-                (case-split (integerp n))
-                )
-           (equal (bitn (* k x) n)
-                  (bitn x (- n (expo k))))))
-
-
-
-;generalize to bits-mod?
-(defthmd bitn-mod
-  (implies (and (< k n)
-                (integerp n)
-                (integerp k)
-                )
-           (equal (bitn (mod x (expt 2 n)) k)
-                  (bitn x k))))
-
-;dup?
-(defthm BIT-EXPO-A
-  (implies (and (< x (expt 2 n))
-                (>= x 0)
-                (integerp n)
-                )
-           (equal (bitn x n) 0))
-  :rule-classes ())
-
-;special case of  bit-expo-c?
-(defthm BIT-EXPO-B
-  (implies (and (<= (expt 2 n) x)
-                (< x (expt 2 (1+ n)))
-                (rationalp x)
-                (integerp n)
-                ;(>= x 0)
-                ;(>= n 0)
-                )
-           (equal (bitn x n) 1))
-  :rule-classes ())
-
-;bozo. combine these next 2?
-
-;bozo. dup?
-(defthm bitn-plus-expt-1
-  (implies (and (rationalp x)
-                (integerp n)
-                )
-           (not (equal (bitn (+ x (expt 2 n)) n)
-                       (bitn x n))))
-  :rule-classes ()
-)
-
-
-;bozo. dup?
-;prove from bitn-plus-mult?
-(defthm bitn-plus-expt-2
-  (implies (and (< n m)
-                (integerp n)
-                (integerp m)
-                )
-           (equal (bitn (+ x (expt 2 m)) n)
-                  (bitn x n))))
-
-
-;this is the most interesting case. perhaps add the other cases for k<0 and k>i-j
-(defthm bitn-bits
-  (implies (and (<= k (- i j))
-                (case-split (<= 0 k))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (bitn (bits x i j) k)
-                  (bitn x (+ j k)))))
-
-(defthmd bitn-shift-3
-  (implies (and (bvecp x m)
-                (<= m n)
-                (integerp k)
-                (case-split (integerp n))
-                (case-split (integerp m))
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn k (- n m)))))
-
-;reconcile param names with bits version?
-;like  bitn-shift-3
-;rename!
-
-(defthmd bit+*k-2
-  (implies (and (< x (expt 2 m))
-                (<= 0 x)
-                (rationalp x)
-                (<= m n)
-                (integerp k)
-                (case-split (integerp n))
-                (case-split (integerp m))
-                )
-           (equal (bitn (+ x (* k (expt 2 m))) n)
-                  (bitn k (- n m)))))
-
-(defthm bit-expo-c
-    (implies (and (<= (- (expt 2 n) (expt 2 k)) x)
-                  (< x (expt 2 n))
-                  (< k n)
-                  (rationalp x);(integerp x) ;gen more!
-		  (integerp n)
-		  (integerp k)
-		  )
-	     (equal (bitn x k) 1))
-  :rule-classes ())
-
-;Follows from bit-expo-c
-;requires x to be an integer, unlike bit-expo-c.
-(defthmd bvecp-bitn-2
-    (implies (and (bvecp x n) ; bind free var n here
-                  (< k n)
-                  (<= (- (expt 2 n) (expt 2 k)) x)
-                  (integerp n)
-		  (integerp k)
-		  )
-	     (equal (bitn x k) 1))
-    :rule-classes ((:rewrite :match-free :all))
-  :hints (("Goal" :in-theory (enable bvecp)
-           :use (bit-expo-c))))
-
-(defthm bitn-bvecp-forward
-  (bvecp (bitn x n) 1)
-  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
-
-;could combine these next two?
-
-;BOZO enable?
-(defthmd bvecp-bitn-0
-  (implies (bvecp x n)
-           (equal (bitn x n) 0)))
-
-;make an alt version?
-;trying disabled..
-(defthmd bitn-bvecp-0
-  (implies (and (bvecp x n)
-                (<= 0 m)
-                )
-           (equal (bitn x (+ m n)) 0)))
-
-;k is a free var
-;do we need this, if we have bvecp-longer?
-(defthm bitn-bvecp-0-eric
-  (implies (and (bvecp x k)
-                (<= k n))
-           (equal (bitn x n) 0))
-  :rule-classes ((:rewrite :match-free :all)))
-
-;sort of a "bitn-tail" like bits-tail?
-(defthm bitn-bvecp-1
-  (implies (bvecp x 1)
-           (equal (bitn x 0) x)))
-
-;rename
-(defthmd bvecp-bitn-1
-    (implies (and (bvecp x (1+ n))
-		  (<= (expt 2 n) x)
-                  (natp n))
-	     (equal (bitn x n) 1)))
-
-;handle the case where we don't go down to 0?
-(defthm bits-bitn
-  (implies (and (case-split (integerp i))
-                (case-split (<= 0 i))
-                )
-  (equal (bits (bitn x n) i 0)
-         (bitn x n))))
diff -Nru acl2-6.2/books/rtl/rel5/user/bits-trunc.lisp acl2-6.3/books/rtl/rel5/user/bits-trunc.lisp
--- acl2-6.2/books/rtl/rel5/user/bits-trunc.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/bits-trunc.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,92 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-;BOZO include less...
-;(include-book "log")
-;(include-book "float")
-;(include-book "trunc")
-(include-book "land")
-(local (include-book "../support/bits-trunc"))
-
-;; Necessary defuns: BOZO some aren't necessary?
-
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-;exactp
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-
-(defthm bits-trunc-2
-  (implies (and (= n (1+ (expo x)))
-                (>= x 0)
-                (integerp k) 
-                (> k 0)
-                )
-           (= (trunc x k)
-              (* (expt 2 (- n k))
-                 (bits x (1- n) (- n k)))))
-  :rule-classes ())
-
-(defthm bits-trunc-original
-  (implies (and (>= x (expt 2 (1- n)))
-                (< x (expt 2 n))
-                (integerp x) (> x 0)
-                (integerp m) (>= m n)
-                (integerp n) (> n k)
-                (integerp k) (> k 0)
-                )
-           (= (trunc x k)
-              (land0 x (- (expt 2 m) (expt 2 (- n k))) n)))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/user/bits.lisp acl2-6.3/books/rtl/rel5/user/bits.lisp
--- acl2-6.2/books/rtl/rel5/user/bits.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/bits.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,770 +0,0 @@
-(in-package "ACL2")
-
-(include-book "../arithmetic/negative-syntaxp")
-(include-book "../arithmetic/power2p")
-(local (include-book "../support/bits")) 
-(local (include-book "../support/guards"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-;; Necessary defuns:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-;In proofs about RTL terms, i and j are almost always constants
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;;
-;;Start of new stuff
-;;
-
-(defthm bits-nonnegative-integerp-type
-  (and (<= 0 (bits x i j))
-       (integerp (bits x i j)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than bits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription bits)))
-
-(defthm bits-natp
-  (natp (bits x i j)))
-
-(defthm bits-with-x-0
-  (equal (bits 0 i j)
-         0))
-
-(defthm bits-with-x-not-rational
-  (implies (not (rationalp x))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-i-not-an-integer
-  (implies (not (integerp i))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-j-not-an-integer
-  (implies (not (integerp j))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-indices-in-the-wrong-order
-  (implies (< i j)
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-upper-bound
-  (< (bits x i j) (expt 2 (+ 1 i (- j))))
-  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j)))))
-
-;tigher bound for the usual case
-(defthm bits-upper-bound-tighter
-  (implies (case-split (<= j i))
-           (<= (bits x i j) (+ -1 (expt 2 (+ i 1 (- j))))))
-  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j)))))
-
-;this might help stupid hyps get rewritten away...
-;perhaps require that z be a constant?
-(defthm bits-upper-bound-2
-  (implies (<= (expt 2 (+ 1 i (- j))) z)
-           (< (bits x i j) z)))
-
-;a is a free var
-(defthm bits-force
-  (implies (and (<= (* a (expt 2 (+ i 1))) x)
-                (< x (* (1+ a) (expt 2 (+ i 1))))
-                (integerp x)
-                (integerp i)
-                (integerp a)
-                )
-           (equal (bits x i 0)
-                  (- x (* a (expt 2 (+ i 1))))))
-  :rule-classes nil
-  )
-
-;BOZO expensive? disable?
-(defthm bits-force-with-a-chosen-neg
-  (implies (and (< x 0) ;rarely the case?
-                (<= (* -1 (expt 2 (+ i 1))) x)
-                (integerp x)
-                (integerp i)
-                )
-           (equal (bits x i 0)
-                  (- x (* -1 (expt 2 (+ i 1)))))))
-
-;eventually, I'd like to add a bind-free rule to handle the bits-shift case?
-(defthm bits-shift
-  (implies (and (case-split (integerp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (and (equal (bits (* (expt 2 n) x) i j)
-                       (bits x (- i n) (- j n)))
-                (equal (bits (* x (expt 2 n)) i j)
-                       (bits x (- i n) (- j n))))))
-
-(defthm bits-shift-second-with-more
-  (implies (and (case-split (integerp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (* x (expt 2 n) y) i j)
-                  (bits (* x y) (- i n) (- j n)))))
-
-(defthm bits-shift-by-constant-power-of-2
-  (implies (and (syntaxp (quotep k))
-                (power2p k)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (* k x) i j)
-                  (bits x (- i (expo k)) (- j (expo k))))))
-
-;allows you to split bit vectors into two parts
-;free var n (where to split)
-;BOZO get rid of the other in favor of this one?
-(defthm bits-plus-bits2
-  (implies (and ;(rationalp x)
-                (integerp i) 
-                (integerp j)
-                (integerp n)
-                (<= j n)
-                (<= n i))
-           (equal (bits x i j)
-                  (+ (* (bits x i n) (expt 2 (- n j)))
-                     (bits x (1- n) j))))
-  :rule-classes nil)
-
-(defthm bits-plus-bits
-  (implies (and (integerp m)
-                (integerp p)
-                (integerp n)
-                (<= m p)
-                (<= p n))
-           (= (bits x n m)
-              (+ (bits x (1- p) m)
-                 (* (expt 2 (- p m)) (bits x n p)))))
-  :rule-classes ())
-
-;this really has two separate cases
-;generalize with j not 0?
-;this rule often seems helpful, but I'm not sure exactly why
-(defthm bits-split-around-zero
-  (implies (and (>= x (- (expt 2 (+ i 1))))
-                (< x (expt 2 (+ i 1)))
-                (integerp x)
-                (case-split (integerp i))
-                (case-split (<= 0 i))
-                )
-           (equal (bits x i 0)
-                  (if (<= 0 x)
-                      x
-                    (+ x (expt 2 (+ i 1)))))))
-
-;this should fire after bits-bvecp, so we list it first
-(defthm bits-bvecp-when-x-is	
-  (implies (and (bvecp x k)	;gen k to be something less that the k in the rhs?
-                (case-split (<= 0 j))
-                )
-           (bvecp (bits x i j) k)))
-
-(defthm bits-bvecp
-  (implies (and (<= (+ 1 i (- j)) k)
-                (case-split (integerp k))
-                )
-           (bvecp (bits x i j) k)))
-
-;BOZO do we want this rule enabled?
-;this is sort of odd
-(defthm bits-bvecp-fw
-  (implies (equal n (- (1+ i) j)) ; note the EQUAL here to help with the fw chaining
-           (bvecp (bits x i j) n))
-  :rule-classes
-  ((:forward-chaining :trigger-terms ((bits x i j)))))
-
-;BOZO make this one a fw-chaining rule instead of the one above?
-(defthm bits-bvecp-simple
-  (implies (equal k (+ 1 i (* -1 j)))
-           (bvecp (bits x i j) k)))
-
-;included in case bits-bvecp has the problem described above...
-(defthm bits-bvecp-simple-2
-  (bvecp (bits x (+ -1 i) 0) i))
-
-
-
-;I have many theorems dealing with the simplification of bits of a sum
-
-;better names: make the dropped term x, the others a,b,c,...
-;;; more bits thms like this!
-
-(defthm bits-sum-drop-irrelevant-term-2-of-2
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ x y) i j)
-                  (bits x i j))))
-
-(defthm bits-sum-drop-irrelevant-term-1-of-2
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ y x) i j)
-                  (bits x i j))))
-
-(defthm bits-sum-drop-irrelevant-term-3-of-3
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ w x y) i j)
-                  (bits (+ w x) i j))))
-
-(defthm bits-sum-drop-irrelevant-term-2-of-3
-  (implies (integerp (/ y (expt 2 (+ 1 i))))
-           (equal (bits (+ w y x) i j)
-                  (bits (+ w x) i j))))
-
-;kind of yucky
-(defthmd bits-minus
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (<= j i)) ;drop?
-                (case-split (integerp j))
-                )
-           (equal (bits (* -1 x) i j)
-                  (if (integerp (* 1/2 x (/ (expt 2 i))))
-                      0
-                    (if (integerp (* x (/ (expt 2 j))))
-                        (+ (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))
-                      (+ -1 (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j))))))))
-
-(defthm bits-minus-alt
-  (implies (and (syntaxp (negative-syntaxp x))
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (<= j i))
-                (case-split (integerp j))
-                )
-           (equal (bits x i j)
-                  (if (integerp (* 1/2 (- X) (/ (EXPT 2 I))))
-                    0
-                    (if (INTEGERP (* (- X) (/ (EXPT 2 J))))
-                        (+ (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j)))
-                      (+ -1 (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j))))))))
-
-;drops hyps like this: (<= (BITS x 30 24) 253)
-;Recall that <= gets rewritten to < during proofs
-(defthm bits-drop-silly-upper-bound
-  (implies (and (syntaxp (quotep k))
-                (>= k (+ -1 (expt 2 (+ 1 i (- j)))))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (< k (bits x i j))
-                  nil)))
-
-;rewrite things like (<= 4096 (BITS x 23 12)) to false
-;Recall that <= gets rewritten to < during proofs
-(defthm bits-drop-silly-lower-bound
-  (implies (and (syntaxp (quotep k))
-                (> k (+ -1 (expt 2 (+ 1 i (- j)))))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-  (equal (< (bits x i j) k)
-         t)))
-
-;rewrite (< -64 (BITS <signal> 64 59)) to t
-(defthm bits-drop-silly-bound-3
-  (implies (and (syntaxp (quotep k))
-                (< k 0)
-                )
-           (equal (< k (bits x i j))
-                  t)))
-
-(defthm bits-drop-silly-bound-4
-  (implies (and (syntaxp (quotep k))
-                (<= k 0)
-                )
-           (equal (< (bits x i j) k)
-                  nil)))
-
-;This is the rule for which I wish I knew the "parity" of the term being rewritten...
-(defthm bits-<-1
-  (equal (< (bits x i j) 1)
-         (equal (bits x i j) 0)))
-
-;put bits-cancel- in the name?
-(defthm bits-at-least-zeros
-  (implies (and (syntaxp (quotep k))
-                (equal k (expt 2 (- j2 j)))
-                (<= j j2)
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-           (equal (< (bits x i j)
-                     (* k (bits x i j2)))
-                  nil)))
-
-(defthm bits-upper-with-subrange
-  (implies (and (syntaxp (quotep k))
-                (<= j j2)
-                (equal k (expt 2 (- j2 j)))
-                (case-split (<= j2 i)) ;drop?
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-           (< (BITS x i j) 
-              (BINARY-+ k (BINARY-* k (BITS x i j2))))))
-
-(defthm bits-upper-with-subrange-alt
-  (implies (and (syntaxp (quotep k))
-                (<= j j2)
-                (equal k (expt 2 (- j2 j)))
-                (case-split (<= j2 i)) ;drop?
-                (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp j2))
-                )
-           (equal (< (BINARY-+ k (BINARY-* k (BITS x i j2))) 
-                     (BITS x i j))
-                  nil)))
-
-;make another version for k negative? (t-p should handle?)
-(defthm bits-equal-impossible-constant
-  (implies (and (syntaxp (quotep k)) ;require that i and j be constants too?
-                (<= (expt 2 (+ 1 i (- j))) k)
-                )
-           (not (equal (bits x i j) k))))
-
-;will this fire?
-(defthm bits-compare-to-zero
-  (implies (and (case-split (rationalp x))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (not (< 0 (bits x i j)))
-                  (equal 0 (bits x i j)))))
-
-;expensive?
-;have we done enough to prevent loops?
-;should we make a version where we require j to be a constant and then disable this version?
-(defthm bits-ignore-negative-bits-of-integer
-   (implies (and (syntaxp (not (and (quotep j) (equal 0 (cadr j))))) ;prevents loops
-                 (<= j 0)
-                 (integerp x)
-                 (case-split (integerp j))
-                 )
-            (equal (bits x i j)
-                   (* (expt 2 (- j)) (bits x i 0)))))
-
-;disable since it can be bad to leave "naked" signals and we never want to see expt
-(defthmd bits-does-nothing-2
-  (implies (and (<= j 0) ;a bit strange (j will usually be zero?)
-                (bvecp x (+ i 1)) ;expand?
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits x i j)
-                  (* (expt 2 (- j)) x))))
-
-;has the right pattern to rewrite stuff like this: (<= (EXPT 2 J) (BITS Y (+ -1 J) 0)) to nil
-(defthm bits-upper-bound-special
-  (< (bits x (+ -1 i) 0) (expt 2 i)))
-
-;like bits-reduce
-;was called bits-tail
-;BOZO choose a name for this...
-(defthmd bits-does-nothing
-  (implies (and (bvecp x (1+ i))
-                (case-split (integerp i))
-                )
-           (equal (bits x i 0)
-                  x)))
-
-(defthm bits-with-bad-index-2
-  (implies (not (integerp i))
-           (equal (bits x (+ -1 i) 0)
-                  0)))
-
-;BOZO rename to begin with "bits-"
-(defthmd bvecp-bits-0
-   (implies (bvecp x j)
-            (equal (bits x i j) 0)))
-
-;to handle mod- correctly
-;make an alt version?
-(defthm bits-drop-from-minus
-  (implies (and (bvecp x (1+ i))
-                (bvecp y (1+ i))
-                (<= y x)
-		(case-split (acl2-numberp i)))
-	   (equal (bits (+ x (* -1 y)) i 0)
-		  (+ x (* -1 y)))))
-
-;backchain-limit?
-(defthm bits-tail
-   (implies (and (bvecp x (1+ i))
-                 (case-split (acl2-numberp i)))
-            (equal (bits x i 0)
-                   x)))
-
-(defthm bits-tail-special
-   (implies (bvecp x i)
-            (equal (bits x (+ -1 i) 0)
-                   x)))
-
-(defthmd bits-alt-def
-  (equal (bits x i j)
-         (if (or (not (integerp i))
-                 (not (integerp j)))
-             0
-           (mod (fl (/ x (expt 2 j))) (expt 2 (+ 1 i (- j)))))))
-
-(defthmd bits-plus-mult-2
-   (implies (and (< n k)
-                 (integerp y)
-                 (integerp k)
-                 )
-            (equal (bits (+ x (* y (expt 2 k))) n m)
-                   (bits x n m))))
-
-
-
-;can we replace 0 with any non-negative j?
-(defthm bits-less-than-x
-  (implies (<= 0 x)
-	   (<= (bits x i 0) x))
-  :rule-classes (:rewrite :linear))
-
-;should say <= instead of less-than
-(defthm bits-less-than-x-gen
-  (implies (and (<= 0 x) ;case-split?
-                (case-split (<= 0 j))
-                (case-split (not (complex-rationalp x)))
-                )
-	   (<= (bits x i j) x))
-  :rule-classes (:rewrite :linear))
-
-
-(defthmd bits-bits-1
-  (implies (and (<= k (- i j))
-                (case-split (<= 0 l))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (bits x (+ k j) (+ l j)))))
-
-(defthmd bits-bits-2
-  (implies (and (> k (- i j))
-                (case-split (<= 0 l))
-;                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (bits x i (+ l j)))))
-
-(defthm bits-bits
-  (implies (and (case-split (<= 0 l))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (bits (bits x i j) k l)
-                  (if (<= k (- i j))
-                      (bits x (+ k j) (+ l j))
-                    (bits x i (+ l j))))))
-
-(defthm bits-reduce
-  (implies (and (< x (expt 2 (+ 1 i)))
-                (case-split (integerp x))
-                (case-split (<= 0 x))
-                (case-split (integerp i))
-                )
-           (equal (bits x i 0)
-                  x)))
-
-(defthm bits-0
-  (equal (bits 0 i j) 
-         0))
-
-
-
-;could prove a version where we drop bits from both args?
-(defthm bits-sum-drop-bits-around-arg-2
-  (implies (and (<= i i+)
-                (integerp y)
-                (case-split (integerp i+))
-                )
-           (equal (bits (+ x (bits y i+ 0)) i j)
-                  (bits (+ x y) i j))))
-
-;Follows from BITS-SUM-DROP-BITS-AROUND-ARG-2.
-(defthm bits-sum-drop-bits-around-arg-1
-  (implies (and (<= i i+)
-                (integerp x)
-                (case-split (integerp i+))
-                )
-           (equal (bits (+ (bits x i+ 0) y) i j)
-                  (bits (+ x y) i j))))
-
-(defthm bits-sum-drop-bits-around-arg-2-special-case
-  (implies (integerp y)
-           (equal (bits (+ x (bits y i 0)) i j)
-                  (bits (+ x y) i j))))
-
-(defthm bits-sum-drop-bits-around-arg-1-special-case
-  (implies (integerp x)
-           (equal (bits (+ (bits x i 0) y) i j)
-                  (bits (+ x y) i j))))
-
-;rename
-;Follows from BVECP-SUM-OF-BVECPS.
-(defthm bits-sum-1
-  (equal (bits (+ (bits x (+ -1 i) 0)
-                  (bits y (+ -1 i) 0))
-               i ;actually, this could be anything >= i ??
-               0)
-         (+ (bits x (+ -1 i) 0)
-            (bits y (+ -1 i) 0))))
-
-
-;export!! enable?
-;gen?
-;BOZO rename!
-(defthmd bits-of-non-integer-special
-  (implies (case-split (not (integerp i)))
-           (equal (bits x (+ -1 i) 0)
-                  0)))
-
-(defthm bits-fl
-  (implies (<= 0 j)
-           (equal (bits (fl x) i j)
-                  (bits x i j))))
-
-;just use bits-fl-eric and bits-shift!
-;BOZO drop the fl from the lhs, since it'll be rewritten away...
-(defthmd bits-shift-down-1
-  (implies (and (<= 0 j)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                )
-           (equal (bits (fl (/ x (expt 2 k)))
-                        i
-                        j)
-                  (bits x (+ i k) (+ j k)))))
-
-(defthmd bits-shift-down-eric
-  (implies (and (<= 0 j)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                )
-           (equal (bits (* x (/ (expt 2 k)))
-                        i
-                        j)
-                  (bits x (+ i k) (+ j k)))))
-
-; like  bits-plus-mult-1 - remove one of them?
-(defthmd bits+2**k-2
-  (implies (and (< x (expt 2 k))
-                (<= 0 x)
-                (rationalp x) ;(integerp x)
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* y (expt 2 k))) n m)
-                  (bits y (- n k) (- m k)))))
-
-(defthm bits+2**k-2-alt
-  (implies (and (< x (expt 2 k))
-                (<= 0 x)
-                (rationalp x) ;(integerp x)
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* (expt 2 k) y)) n m)
-                  (bits y (- n k) (- m k)))))
-
-(defthmd bits-fl-by-2
-  (equal (fl (* 1/2 (bits x i 0)))
-         (bits x i 1)))
-
-(defthm mod-bits-by-2
-  (implies (and (integerp x)
-                (<= 0 i)
-                (integerp i)
-                )
-           (equal (mod (bits x i 0) 2)
-                  (mod x 2))))
-
-;basically the same as bits+2**k-2; drop one?
-;move
-(defthmd bits-plus-mult-1
-  (implies (and (bvecp x k) ;actually, x need not be an integer...
-                (<= k m)
-                (integerp y)
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp k))
-                )
-           (equal (bits (+ x (* y (expt 2 k))) n m)
-                  (bits y (- n k) (- m k)))))
-
-(defthm bits-mod-0
-  (implies (and (integerp x)
-                (>= x 0)
-                (integerp m)
-                (>= m 0)
-                (integerp n)
-                (>= n 0))
-           (iff (= (mod x (expt 2 (+ m n 1))) 0)
-                (and (= (bits x (+ m n) n) 0)
-                     (= (mod x (expt 2 n)) 0))))
-  :rule-classes ())
-
-;this is silly? just open up bits!
-(defthm mod-bits-equal
-  (implies (= (mod x (expt 2 (1+ i))) (mod y (expt 2 (1+ i))))
-           (= (bits x i j) (bits y i j)))
-  :rule-classes ())
-
-
-;not needed?  just expand bits?
-(defthmd bits-mod
-  (implies (and (case-split (integerp x))
-                (case-split (integerp i)) ;gen?
-;(case-split (<= 0 i))
-                )
-           (equal (bits x i 0)
-                  (mod x (expt 2 (1+ i))))))
-
-(defthm bits-shift-up-1
-  (implies (and (integerp k)
-		(integerp i)
-		(integerp j))
-	   (equal (bits (* (expt 2 k) x) i j)
-		  (bits x (- i k) (- j k))))
-  :rule-classes ())
-
-;reorder? make rewrite?
-(defthm bits-shift-up-2
-  (implies (and (integerp x)
-                (integerp k)
-                (<= 0 k)
-                (integerp i)
-                )
-           (equal (* (expt 2 k) (bits x i 0))
-                  (bits (* (expt 2 k) x) (+ i k) 0)))
-  :rule-classes ())
-
-;export!
-;more forms of this? (bits (/ (expt 2 k)) i j)
-;bits of a constant power of 2??
-;bits of a range of ones (i.e., a difference of powers of 2).
-;use power2p??
-(defthm bits-expt
-  (implies (and (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k)) ;BOZO gen?
-                )
-           (equal (bits (expt 2 k) i j)
-                  (if (or (< i j)
-                          (< k j)
-                          (< i k))
-                      0
-                    (expt 2 (- k j))))))
-
-(defthm bits-expt-constant
-  (implies (and (syntaxp (and (quotep k) (power2p (cadr k))))
-                (force (power2p k)) ;bozo do the computation only once
-                (case-split (integerp k)) ;gen?
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits k i j)
-                  (if (or (< i j)
-                          (< (expo k) j)
-                          (< i (expo k)))
-                      0
-                    (expt 2 (- (expo k) j))))))
-
-
-;BOZO add case-splits?
-(defthm mod-bits
-  (implies (and (<= 0 i)
-                (<= 0 j)
-                (integerp j)
-                (integerp i))
-           (equal (mod (bits x i 0) (expt 2 j))
-                  (bits x (min i (+ -1 j)) 0))))
-
-
-
-;Unlike bits-tail, this allows j to be non-zero.
-;Note that the conclusion is (bits x ...), not just x.
-;i is a free variable
-;watch out for loops with this rule
-(defthmd bits-tighten
-  (implies (and (bvecp x i)
-                (<= i n) 
-                (case-split (integerp n))
-                )
-           (equal (bits x n j)
-                  (bits x (+ -1 i) j)))
-  :rule-classes ((:rewrite :match-free :all)))
diff -Nru acl2-6.2/books/rtl/rel5/user/brat.lisp acl2-6.3/books/rtl/rel5/user/brat.lisp
--- acl2-6.2/books/rtl/rel5/user/brat.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/brat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,161 +0,0 @@
-; This file was created by J Moore and Matt Kaufmann in 1995 in support of
-; their proof of the AMD-K5 division code.
-
-(in-package "ACL2")
-
-;BOZO move this to support and uncomment these:
-;(set-inhibit-warnings "theory") ; avoid warning in the next event
-;(local (in-theory nil))
-;(set-inhibit-warnings) ; restore theory warnings (optional)
-
-
-;This should be kept local, so that we can safely include brat in top.
-(local (include-book "../arithmetic/fl"))
-
-; Since the above include-book is local, we need the following here.
-(defun fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-; We say a rational p/q is a "binary rational" if q is a power of 2.
-; A pair (n . i) consisting of two integers is called a "binary pair"
-; and represents the binary rational n/2**i.
-
-; We implement rather elaborate notational conventions to use in the
-; output of test routines.
-
-; We can represent a binary rational as a rational, a string, or a
-; symbol, as illustrated below.  The fn listed on the right has the
-; property that when given a legal object of any one of these three
-; types it produces the equivalent object of the type indicated by the
-; function's name.
-
-; 209/16          rationalp   BRAT  
-; "B1101.0001"    stringp     BSTR
-; "b1101.0001"    stringp
-; B1101.0001      symbolp     BSYM
-
-; In addition, negatives may be written in the more or less obvious ways:
-;-209/16          rationalp   BRAT  
-;"-B1101.0001"    stringp     BSTR
-;"-b1101.0001"    stringp
-;-B1101.0001      symbolp     BSYM
-
-; For example, given a rational, string or symbol, x, representing a
-; binary rational, (BRAT x) will produce the equivalent rational,
-; (BSTR x) will produce the equivalent string, and (BSYM x) will
-; produce the equivalent symbol.
-
-(defun log2 (x)
-  (if (< (nfix x) 2) 0 (1+ (log2 (fl (/ x 2))))))
-
-(defun binary-stringp (i str max pointp)
-  (declare (xargs :mode :program))
-  (cond ((>= i max) (> max 0))
-        ((eq (char str i) #\.)
-         (if pointp nil (binary-stringp (1+ i) str max t)))
-        ((or (eq (char str i) #\1)
-             (eq (char str i) #\0))
-         (binary-stringp (1+ i) str max pointp))
-        (t nil)))
-
-(defun chk-binary (x)
-  (declare (xargs :mode :program))
-  (cond ((or (symbolp x)
-             (stringp x))
-         (let* ((str (if (stringp x) x (symbol-name x)))
-                (max (length str)))
-           (cond ((and (> max 2)
-                       (or (eql (char str 0) #\B)
-                           (eql (char str 0) #\b)
-                           (and (or (eql (char str 0) #\-)
-                                    (eql (char str 0) #\+))
-                                (or (eql (char str 1) #\B)
-                                    (eql (char str 1) #\b)))
-                           (binary-stringp
-                            (if (or (eql (char str 0) #\-)
-                                    (eql (char str 0) #\+))
-                                2 1)
-                            str max nil)))
-                  t)
-                 (t (illegal 'binary-conversion
-                             "Illegal or unrecognized binary syntax, ~p0."
-                             (list (cons #\0 x)))))))
-        ((and (rationalp x)
-              (= (denominator x) (expt 2 (log2 (denominator x)))))
-         t)
-        (t (illegal 'binary-conversion
-                    "Illegal or unrecognized binary syntax, ~p0."
-                    (list (cons #\0 x))))))
-
-(defun binary-string-to-rat (i str max p ans)
-  (declare (xargs :mode :program))
-  (cond ((>= i max) ans)
-        ((eq (char str i) #\0)
-         (if (null p)
-             (binary-string-to-rat (1+ i) str max nil (* 2 ans))
-           (binary-string-to-rat (1+ i) str max (/ p 2) ans)))
-        ((eq (char str i) #\1)
-         (if (null p)
-             (binary-string-to-rat (1+ i) str max nil (1+ (* 2 ans)))
-           (binary-string-to-rat (1+ i) str max (/ p 2) (+ ans p))))
-        (t ;;; (eq (char str i) #\.) and (null p)
-         (binary-string-to-rat (1+ i) str max 1/2 ans))))
-
-(defun string-or-symbol-to-rat (x)
-; We assume (chk-binary x) = t and x is a stringp or symbolp
-  (declare (xargs :mode :program))
-  (let* ((str (if (stringp x) x (symbol-name x)))
-         (max (length str)))
-    (cond ((eql (char str 0) #\-)
-           (- (binary-string-to-rat 2 str max nil 0)))
-          ((eql (char str 0) #\+)
-           (binary-string-to-rat 2 str max nil 0))
-          (t (binary-string-to-rat 1 str max nil 0)))))
-
-(defun brat (x)
-  (declare (xargs :mode :program))
-  (cond ((and (chk-binary x)
-              (or (symbolp x)
-                  (stringp x)))
-         (string-or-symbol-to-rat x))
-        (t x)))
-
-(defun nat-to-binary-charlist (x lst)
-  (declare (xargs :mode :program))
-  (cond ((= x 0) lst)
-        (t (nat-to-binary-charlist (floor x 2)
-                                   (cons (if (= (mod x 2) 1) #\1 #\0) lst)))))
-
-(defun rat-to-str2 (lst place e)
-  (declare (xargs :mode :program))  
-  (cond ((= place e) (cons #\. lst))
-        ((null lst)
-         (cons #\0 (rat-to-str2 nil (1+ place) e)))
-        (t (cons (car lst) (rat-to-str2 (cdr lst) (1+ place) e)))))
-
-(defun rat-to-str1 (m e)
-  (declare (xargs :mode :program))  
-  (let* ((lst (nat-to-binary-charlist m nil))
-         (place (- (length lst))))
-    (cond ((< e place)
-           (cons #\. (make-list-ac (- place e) #\0 lst)))
-          (t (rat-to-str2 lst place e)))))
-
-(defun bstr (x)
-  (declare (xargs :mode :program))  
-  (let* ((rat (brat x))
-         (abs-rat (abs rat))
-         (sgn-rat (if (< rat 0) -1 +1)))
-    (coerce
-     (append (if (= sgn-rat -1) '(#\-) '(#\Space))
-             (cons #\B
-                   (let ((lst (rat-to-str1 (numerator abs-rat)
-                                           (- (log2 (denominator abs-rat))))))
-                     (if (eql (car lst) #\.) (cons #\0 lst) lst))))
-     'string)))
-
-(defun bsym (x)
-  (declare (xargs :mode :program))
-  (intern (bstr x) "ACL2"))
-
diff -Nru acl2-6.2/books/rtl/rel5/user/bvecp.lisp acl2-6.3/books/rtl/rel5/user/bvecp.lisp
--- acl2-6.2/books/rtl/rel5/user/bvecp.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/bvecp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,191 +0,0 @@
-(in-package "ACL2")
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(local (include-book "../support/bvecp"))
-
-;; New stuff:
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defthm bvecp-with-n-not-a-positive-integer
-  (implies (or (not (integerp k))
-               (<= k 0))
-           (equal (bvecp x k)
-                  (equal 0 x))))
-
-(defthm bvecp-0
-  (bvecp 0 k))
-
-;drop?
-;just a special case of bvecp-with-n-not-a-positive-integer
-(defthm bvecp-0-thm
-  (equal (bvecp x 0)
-         (equal x 0)))
-
-(defthm bvecp-ones
-  (implies (case-split (<= 0 k))
-           (bvecp (+ -1 (expt 2 k)) k)))
-
-;k1 is a free var
-(defthm bvecp-longer
-   (implies (and (bvecp x k1)
-                 (<= k1 k2)
-                 (case-split (integerp k2))
-                 )
-            (bvecp x k2))
-   :rule-classes ((:rewrite :match-free :all)))
-
-;expensive and so disabled
-;no free var
-(defthmd bvecp-one-longer
-  (implies (and (integerp k)
-                (bvecp x (- k 1)))
-           (bvecp x k))
-  :rule-classes ((:rewrite :backchain-limit-lst (nil 2))))
-
-
-(defthm bvecp-of-non-integer
-  (implies (not (integerp x))
-           (not (bvecp x k))))
-
-;gen (replace n+1 with an arbitrary integer > n)?
-(defthm bvecp-expt-2-n
-  (implies (and (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (bvecp (expt 2 n) (+ 1 n))))
-
-; The following lemma can be critical during backchaining.  Imagine that ACL2
-; backchains to (bvecp (if test x y) k) and we know (bvecp x k) and (bvecp y
-; k). ACL2 may fail to relieve the hyp because it is merely rewriting; there is
-; no case splitting.  So we need a rule about bvecp applied to an if
-; expression.
-(defthm bvecp-if
-  (equal (bvecp (if test x y) k)
-         (if test (bvecp x k) (bvecp y k))))
-
-
-; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
-
-;better name?
-(defund mk-bvec (r k)
-  (declare (xargs :guard (integerp k)))
-  (if (bvecp r k) r 0))
-
-(defthm mk-bvec-is-bvecp
-  (bvecp (mk-bvec r k) k))
-
-(defthm mk-bvec-identity
-  (implies (bvecp r k)
-           (equal (mk-bvec r k) r)))
-
-;BOZO make a version to shift by a constant!
-(defthm bvecp-shift
-  (implies (and (integerp x) ;note!
-		(<= 0 m)
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* x (expt 2 m)) n)
-		  (bvecp x (- n m)))))
-
-(defthm bvecp-shift-alt
-  (implies (and (integerp x) ;note!
-		(<= 0 m)
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* (expt 2 m) x) n)
-		  (bvecp x (- n m)))))
-
-;gen this!
-;BOZO will this unify (* 2 x) with 0??
-(defthm bvecp-shift-by-2
-  (implies (and (syntaxp (not (quotep x))) ;prevents loops...
-                (integerp x)
-		(<= 0 m) ;gen?
-		(case-split (integerp m))
-		(case-split (integerp n))
-		)
-	   (equal (bvecp (* 2 x) n)
-		  (bvecp x (- n 1)))))
-
-
-;gen?
-;in general, rewrite (bvecp k n) where k is a constant to a fact about n
-(defthm bvecp-1
-  (implies (and (<= 1 n)
-                (integerp n))
-           (bvecp 1 n)))
-
-;n is a free variable
-;Disabled since may cause expensive backchaining.
-(defthmd natp-bvecp
-  (implies (bvecp x n)
-           (natp x))
-  :rule-classes ((:rewrite :match-free :once)))
-
-(defthmd bvecp-forward
-  (implies (bvecp x k)
-           (and (integerp x)
-                (<= 0 x)
-                (< x (expt 2 k)))) ;tigher-bound?
-  :rule-classes :forward-chaining)
-
-(defthm bvecp-product
-  (implies (and (bvecp x m)
-                (bvecp y n)
-                )
-           (bvecp (* x y) (+ m n)))
-  :rule-classes ())
-
-(defthmd bvecp-1-rewrite
-  (equal (bvecp x 1)
-	 (or (equal x 0) (equal x 1))))
-
-;make another for not-equal-0 implies equal-1?
-(defthm bvecp-1-0
-    (implies (and (bvecp x 1)
-		  (not (equal x 1)))
-	     (equal x 0))
-  :rule-classes :forward-chaining)
-
-(defthm bvecp+1
-  (implies (and (natp n)
-                (bvecp x n))
-           (bvecp x (+ 1 n))))
-
-;same as bvecp-longer.decide which param names to use.  j and k??
-(defthmd bvecp-monotone
-    (implies (and (bvecp x n)
-		  (<= n m)
-                  (case-split (integerp m))
-                  )		  
-	     (bvecp x m)))
-
-
-;This bounds the amount of carry out that we can have from the sum.
-(defthm bvecp-sum-of-bvecps
-  (implies (and (bvecp x (+ -1 k))
-                (bvecp y (+ -1 k))
-                (case-split (integerp k)))
-           (bvecp (+ x y) k)))
-
-
-;add rule that (not (natp x)) implies (not (bvecp x k)) ??
-
-;exported in lib/
-(defthmd bvecp-0-1
-  (implies (and (bvecp x 1)
-                (not (equal x 0)))
-           (equal x 1))
-  :rule-classes :forward-chaining)
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/user/cat.lisp acl2-6.3/books/rtl/rel5/user/cat.lisp
--- acl2-6.2/books/rtl/rel5/user/cat.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/cat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,808 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "../support/cat"))
-(local (include-book "../support/guards"))
-
-;; Necessary defuns
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-
-
-;; New stuff:
-
-#|
-Concatenate the M-bit value X onto the N-bit value Y.  X will occupy the high bits of the result.
-
-(cat x m y n) is well-defined only when the following predicate is true:
-
-(and (natp m)
-     (bvecp x m)
-     (natp n)
-     (bvecp y n))
-
-|#
-
-(defund binary-cat (x m y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp m) (< 0 m)
-                              (integerp n) (< 0 n))))
-  (if (and (natp m) (natp n))
-      (+ (* (expt 2 n) (bits x (1- m) 0))
-         (bits y (1- n) 0))
-    0))
-
-(defun formal-+ (x y)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
-;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
-;;not need to specify this in the guard, and leaving it out of that guard
-;;simplifies the guard proof.
-
-(defun cat-size (x)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
-  (if (endp (cddr x))
-      (cadr x)
-    (formal-+ (cadr x)
-	      (cat-size (cddr x)))))
-
-(defmacro cat (&rest x)
-  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
-  (cond ((endp (cddr x))
-         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
-        ((endp (cddddr x))
-         `(binary-cat ,@x))
-        (t
-         `(binary-cat ,(car x) 
-                      ,(cadr x) 
-                      (cat ,@(cddr x)) 
-                      ,(cat-size (cddr x))))))
-
-;Allows things like (in-theory (disable cat)) to refer to binary-cat.
-(add-macro-alias cat binary-cat)
-
-(defthm cat-nonnegative-integer-type
-  (and (integerp (cat x m y n))
-       (<= 0 (cat x m y n)))
-  :rule-classes (:type-prescription)
-  )
-
-;this rule is no better than cat-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-cat)))
-
-;just a rewrite rule
-(defthm cat-natp
-  (natp (cat x m y n)))
-
-;bozo disable? drop bvecp hyp and wrap bits around conclusion??
-(defthm cat-0
-  (implies (and (case-split (bvecp y n))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )		  
-           (equal (cat 0 m y n) y)))
-
-;BOZO just use this one??
-(defthm cat-0-alt
-  (implies (and ;(case-split (bvecp y n))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )		  
-           (equal (cat 0 m y n) (bits y (+ -1 n) 0))))
-
-;We can rely on bits-tail to complete the simplification down to x if desired.
-(defthm cat-with-n-0
-  (equal (binary-cat x m y 0)
-         (bits x (+ -1 m) 0)))
-
-;bozo disable?
-(defthm cat-with-n-0-alt
-  (implies (case-split (bvecp x m))
-           (equal (cat x m y 0)
-                  x)))
-
-;We can rely on bits-tail to complete the simplification down to y if desired.
-(defthm cat-with-m-0
-  (equal (binary-cat x 0 y n)
-         (bits y (+ -1 n) 0)))
-
-;bozo disable?
-(defthm cat-with-m-0-alt
-  (implies (case-split (bvecp y n))
-           (equal (cat x 0 y n)
-                  y)))
-
-;change this behavior?? no, it makes for a nice setbits bvecp lemma
-(defthm cat-with-n-not-a-natural
-  (implies (or (not (integerp n))
-               (< n 0))
-           (equal (cat x m y n)
-                  0)))
-
-(defthm cat-with-m-not-a-natural
-  (implies (or (not (integerp m))
-               (< m 0))
-           (equal (cat x m y n)
-                  0)))
-
-(defthm cat-bvecp-simple
-  (bvecp (cat x m y n) (+ m n)))
-
-(defthm cat-bvecp
-  (implies (and (<= (+ m n) k)
-                (case-split (integerp k)))
-           (bvecp (cat x m y n) k)))
-
-(defthm cat-associative
-  (implies (and (case-split (<= (+ m n) p)) ;gen?
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 q))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                (case-split (integerp q))
-                )
-           (equal (cat (cat x m y n) p z q)
-                  (cat x m (cat y n z q) (+ n q)))))
-
-;prove from something more general (cat-equal-split??)
-;BOZO move hyps to conclusion?
-(defthm cat-equal-0
-  (implies (and (case-split (bvecp x m))
-                (case-split (bvecp y n))
-                (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat x m y n) 0)
-                  (and (equal x 0)
-                       (equal y 0)))))
-
-(defthm cat-combine-constants
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep m)
-                              (quotep y)
-                              (quotep n)))
-                (equal (+ n p) r)
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 p))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                )
-           (equal (cat x m (cat y n z p) r)
-                  (cat (cat x m y n) (+ m n) z p))))
-
-;allows r to be > n+p
-;perhaps we only want this one, not cat-combine-constants ??
-(defthm cat-combine-constants-gen
-  (implies (and (syntaxp (and (quotep x)
-                              (quotep m)
-                              (quotep y)
-                              (quotep r)
-                              (quotep p)))
-                (case-split (<= (+ n p) r)) ;other case?
-                (case-split (bvecp y n)) ;BOZO instead put bits in the conclusion?
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (<= 0 p))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                (case-split (integerp p))
-                (case-split (integerp r))
-                )
-           (equal (cat x m (cat y n z p) r)
-                  (cat (cat x m y (+ r (- p))) (+ m r (- p)) z p))))
-
-(defthm cat-constant-equal-constant-hack
-  (implies (and (syntaxp (and (quotep k1) (quotep k2)))
-                (case-split (bvecp x n))
-                (case-split (bvecp k1 m))
-                (case-split (rationalp k2))
-                (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat k1 m x n) k2)
-                  (equal x (- k2 (* (expt 2 n) k1))))))
-
-(defthm cat-upper-bound
-  (< (cat x m y n)
-     (expt 2 (+ m n)))
-  :rule-classes (:rewrite :linear))
-
-;perhaps the :linear rule cat-upper-bound is enough, but this may help stupid hyps be rewritten away
-(defthm cat-compare-to-constant-1
-  (implies (and (syntaxp (quotep k))
-                (<= (expt 2 (+ m n)) k))
-           (< (cat x m y n) k)))
-
-;provides a tighter bound
-(defthm cat-upper-bound-tight
-  (implies (and (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (<= (cat x m y n)
-               (+ -1 (expt 2 (+ n m))))))
-
-
-(defthm cat-compare-to-constant-2
-  (implies (and (syntaxp (quotep k))
-                (<= (+ -1 (expt 2 (+ m n))) k)
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (not (< k (cat x m y n)))))
-
-;BOZO consider adding?
-;problem if we case-split something that turns out to be false?
-(defthm bits-with-i-not-an-integer-2
-  (implies (case-split (not (integerp i)))
-           (equal (bits x i j)
-                  0)))
-
-(defthm bits-with-j-not-an-integer-2
-  (implies (case-split (not (integerp j)))
-           (equal (bits x i j)
-                  0)))
-
-;also case-split that i>=j in any call to bits?
-
-
-;loops with bits-<-1
-;BOZO add theory invariant!
-;BOZO ask matt about parity..
-(defthmd bits-equal-0-to-bound
-  (equal (equal 0 (bits x i j))
-         (< (bits x i j) 1)))
-
-;we had a special case where j was 0, but I think this is better (it's certainly more general):
-;better name?
-;think about whether this can be proved without opening bits (including bits-plus-bits??)
-;prove bvecp-bits from this??
-;the regular bits-bvecp should fire first...
-(defthm bits-slice-zero-gen
-  (implies (and (case-split (<= 0 k))
-                (case-split (integerp k))
-                (case-split (integerp j))
-                )
-           (equal (bvecp (bits x i j) k)
-                  (equal 0 (bits x i (+ k j))))))
-
-;BOZO move!
-;this can help, especially when we aren't multiplying through by inverted factors
-(defthm bits-upper-bound-new
-  (< (* (/ (expt 2 i)) (bits x (+ -1 i) 0)) 1)
-  :rule-classes (:rewrite :linear)
-   )
-
- (defthmd cat-bvecp-rewrite
-   (implies (and (case-split (<= 0 k))
-                 (case-split (<= 0 n))
-                 (case-split (<= 0 m))
-                 (case-split (integerp n)) 
-                 (case-split (integerp m)) 
-                 (case-split (integerp k)) 
-                 )
-            (equal (bvecp (cat x m y n) k)
-                   (if (<= (+ m n) k)
-                       t
-                     (if (<= n k)
-                         (equal 0 (bits x (+ -1 m) (+ k (* -1 n))))                      
-                       (and (equal 0 (bits x (+ -1 m) 0))
-                            (equal 0 (bits y (+ -1 n) k))))))))
-
-(defthm cat-bvecp-rewrite-constants
-  (implies (and (syntaxp (and (quotep k) (quotep m) (quotep n)))
-                (case-split (<= 0 k))
-                (case-split (<= 0 n))
-                (case-split (<= 0 m))
-                (case-split (integerp n)) 
-                (case-split (integerp m)) 
-                (case-split (integerp k)) 
-                )
-           (equal (bvecp (cat x m y n) k)
-                  (if (<= (+ m n) k)
-                      t
-                    (if (<= n k)
-                        (equal 0 (bits x (+ -1 m) (+ k (* -1 n))))                      
-                      (and (equal 0 (bits x (+ -1 m) 0))
-                           (equal 0 (bits y (+ -1 n) k))))))))
-
-;k is a free variable.
-;There is no real analogue of this for y (that is, we can't change n to something smaller).
-(defthm cat-tighten-x
-  (implies (and (bvecp x k) ;k becomes bound here
-                (< k m) ;if k=m, this rule can loop
-                (case-split (<= 0 k))
-                (case-split (integerp k))
-                (case-split (integerp m))
-                )
-           (equal (cat x m y n)
-                  (cat x k y n))))
-
-(defthm cat-equal-y
-  (implies (and (bvecp y (+ m n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (equal (bits y (+ -1 m n) n)
-                         (bits x (+ -1 m) 0)))))
-
-(defthm cat-equal-y-alt
-  (implies (and (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (if (bvecp y (+ m n))
-                      (equal (bits y (+ -1 m n) n)
-                             (bits x (+ -1 m) 0))
-                    nil))))
-
-(defthm cat-equal-bits-of-y
-  (implies (and; (case-split (bvecp y n))
-;                (case-split (bvecp x m))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal (bits y (+ -1 n) 0) (binary-cat x m y n))
-                  (equal (bits x (+ -1 m) 0) 0))))
-
-;requires y to be a bvecp of length n
-;drop this one?
-(defthm cat-equal-y-special
-  (implies (and (case-split (bvecp y n))
-                (case-split (integerp m))
-                (case-split (<= 0 m)) ;gen!
-                (case-split (integerp n))
-                (case-split (<= 0 n)))
-           (equal (equal y (binary-cat x m y n))
-                  (equal 0 (bits x (+ -1 m) 0)))))
-
-;enable?
-;make into 2 separate lemmas (can drop the bits from x or from y)
-(defthmd cat-ignores-bits
-  (equal (cat (bits x (+ -1 m) 0)
-              m (bits y (+ -1 n) 0)
-              n)
-         (cat x m y n)))
-
-(defthmd bits-cat-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits y i j))))
-
-(defthmd bits-cat-2-1
-  (implies (and (<= n j) ;case 2
-                (< i (+ m n))  ;case 2-1
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (- i n) (- j n)))))
-
-(defthmd bits-cat-2-2
-  (implies (and (<= n j)  ;case 2
-                (<= (+ m n) i)  ;case 2-1
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (+ m -1) (- j n)))))
-
-;note the IF in the conclusion
-(defthmd bits-cat-2
-  (implies (and (<= n j)  ;case 2
-                (case-split (natp n))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (natp m))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (bits x (if (< i (+ m n))
-                              (- i n)
-                            (+ -1 m))
-                        (- j n)))))
-
-
-;Note the IF in the conclusion
-(defthmd bits-cat-3
-  (implies (and (>= i n)
-                (< j n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                (case-split (natp j))
-                )
-           (equal (bits (cat x m y n) i j)
-                  (cat (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (+ -1 m))
-                              0)
-                        (+ 1 (- i n))
-                        (bits y (1- n) j)
-                        (- n j)))))
-
-;includes both bits-cat-1, bits-cat-2, and bits-cat-3
-;we expect the indices to be constants, so this won't cause case-splits
-;gen
-(defthm bits-cat
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                (case-split (natp j)))
-           (equal (bits (cat x m y n) i j)
-                  (if (< i n)
-                      (bits y i j)
-                    (if (>= j n)
-                        (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (+ -1 m)) 
-                              (- j n))
-                      (cat (bits x (if (< i (+ m n))
-                                        (- i n)
-                                      (+ -1 m)) 0)
-                            (+ 1 (- i n))
-                            (bits y (1- n) j)
-                            (- n j)))))))
-
-;The following trivial corollary of bits-cat is worth keeping enabled.
-
-(defthm bits-cat-constants
-  (implies (and (syntaxp (quotep n))
-                (syntaxp (quotep m))
-                (syntaxp (quotep i))
-                (syntaxp (quotep j))
-                (natp n)
-                (natp m)
-                (natp i)
-                (natp j))
-           (equal (bits (cat x m y n) i j)
-                  (if (< i n)
-                      (bits y i j)
-                    (if (>= j n)
-                        (bits x (if (< i (+ m n))
-                                    (- i n)
-                                  (+ -1 m)) 
-                              (- j n))
-                      (cat (bits x (if (< i (+ m n))
-                                       (- i n)
-                                     (+ -1 m)) 0)
-                           (+ 1 (- i n))
-                           (bits y (1- n) j)
-                           (- n j)))))))
-
-;bitn-cat should be all we need for simplifying (bitn (cat...))
-(defthmd bitn-cat-1
-  (implies (and (< i n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i))
-                )
-           (equal (bitn (cat x m y n) i)
-                  (bitn y i))))
-
-;bitn-cat should be all we need for simplifying (bitn (cat...))
-(defthmd bitn-cat-2
-  (implies (and (>= i n)
-                (case-split (natp n))
-                (case-split (natp m))
-                (case-split (integerp i))
-                )
-           (equal (bitn (cat x m y n) i)
-                  (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0))))
-
-;includes both bitn-cat-1 and bitn-cat-2
-(defthm bitn-cat
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                (case-split (natp i)))
-           (equal (bitn (cat x m y n) i)
-                  (if (< i n)
-                      (bitn y i)
-                    (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0)))))
-
-;The following trivial corollary of bitn-cat is worth keeping enabled.
-
-(defthm bitn-cat-constants
-  (implies (and (syntaxp (quotep n))
-                (syntaxp (quotep m))
-                (syntaxp (quotep i))
-                (natp n)
-                (natp m)
-                (natp i))
-           (equal (bitn (cat x m y n) i)
-                  (if (< i n)
-                      (bitn y i)
-                    (if (< i (+ m n))
-                      (bitn x (- i n))
-                    0)))))
-
-(defthm cat-bits-bits
-  (implies (and (equal j (1+ k))
-                (equal n (+ 1 (- l) k))
-                (case-split (<= (+ 1 (- j) i) m))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (integerp i))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                (case-split (integerp m))
-                )
-           (equal (cat (bits x i j) m (bits x k l) n)
-                  (bits x i l))))
-
-(defthm cat-bitn-bits
-    (implies (and (equal j (+ 1 k))
-		  (equal n (+ 1 (- l) k))
-                  (case-split (<= 1 m))
-		  (case-split (<= l k))
-		  (case-split (integerp j))
-                  (case-split (integerp k))
-                  (case-split (integerp l))
-                  (case-split (integerp m))
-		  )
-	     (equal (cat (bitn x j) m (bits x k l) n)
-		    (bits x j l))))
-
-(defthm cat-bits-bitn
-  (implies (and (equal j (+ 1 k))
-                (case-split (<= (+ 1 (- j) i) m))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp m))
-                )
-           (equal (cat (bits x i j) m (bitn x k) 1)
-                  (bits x i k))))
-
-(defthm cat-bitn-bitn
-  (implies (and (equal i (+ 1 j))
-                (case-split (integerp i))
-                (case-split (integerp j)))
-           (equal (cat (bitn x i) 1 (bitn x j) 1)
-                  (bits x i j))))
-
-
-;may not want this enabled (but probably do want CAT-EQUAL-CONSTANT enabled)
-;the BITS calls around X and Y in the conclusion allow us to drop the hyps that X and Y are bvecps.
-(defthmd cat-split-equality
-  (implies (and (case-split (bvecp k (+ m n))) ;if not, K can't be equal to the CAT expression
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (equal (equal k (cat x m y n))
-                  (and (equal (bits y (+ -1 n) 0) (bits k (+ -1 n) 0))
-                       (equal (bits x (+ -1 m) 0) (bits k (+ -1 m n) n))))))
-
-
-
-;generalize this by dropping the bvecp-hyps and wrapping bits around x and y in the conclusion?
-;follows trivially from   cat-split-equality
-;prove a version of this without the bvecp hyps?
-(defthm cat-equal-constant
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep m)
-                              (quotep n)))
-                (case-split (bvecp y n))
-                (case-split (bvecp x m))
-                (case-split (< k (expt 2 (+ m n)))) ;drop!
-                (case-split (integerp k))
-                (case-split (<= 0 k))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                )
-           (equal (equal k (cat x m y n))
-                  (and (equal y (bits k (+ -1 n) 0))
-                       (equal x (bits k (+ -1 m n) n))))))
-
-;lacks the bvecp hyps.  do we want this or cat-equal-rewrite?
-(defthm cat-equal-rewrite-alt
-  (implies (and (case-split (natp n))
-                (case-split (natp m))
-                )
-           (equal (equal (cat x1 m y1 n)
-                         (cat x2 m y2 n))
-                  (and (equal (bits x1 (1- m) 0) (bits x2 (1- m) 0))
-                       (equal (bits y1 (1- n) 0) (bits y2 (1- n) 0))))))
-
-;move hyps to conclusion?
-(defthm cat-equal-rewrite
-  (implies (and (case-split (bvecp x1 m))
-                (case-split (bvecp y1 n))
-                (case-split (bvecp x2 m))
-                (case-split (bvecp y2 n))
-                (case-split (integerp n))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (<= 0 m))
-                )
-           (equal (equal (cat x1 m y1 n)
-                         (cat x2 m y2 n))
-                  (and (equal x1 x2)
-                       (equal y1 y2)))))
-
-(defthm cat-bits-bits-bits
-  (implies (and (<= k i)
-                (<= l k)
-                (<= j l)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp l)
-                )
-           (equal (cat (bits x i (+ 1 k))
-                       (+ 2 i (- k))
-                       (cat (bits x k l)
-                            (+ 1 k (- l))
-                            (bits x (+ -1 l) j)
-                            (+ l (- j)))
-                       (+ 1 (- j) k))
-                  (bits x i j)))
-  :rule-classes nil)
-
-#|
-bits-dont-match can prove things like this:
-(thm (IMPLIES (EQUAL 7 (BITS x 8 6))
-              (NOT (EQUAL 3 (BITS x 15 6)))))
-|#
-
-(defthm bits-dont-match 
-  (implies (and (syntaxp (and (quotep i)
-                              (quotep j)
-                              (quotep k)))
-                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
-                (syntaxp (and (quotep i2)
-                              (quotep j2)
-                              (quotep k2)))
-                (<= j2 j) (<= j i) (<= i i2)
-                (not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
-                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
-                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
-                )
-           (equal (equal k (bits x i j))
-                  nil)))
-
-(defthm bits-match
-  (implies (and (syntaxp (and (quotep i)
-                              (quotep j)
-                              (quotep k)))
-                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
-                (syntaxp (and (quotep i2)
-                              (quotep j2)
-                              (quotep k2)))
-                (<= j2 j) (<= j i) (<= i i2)
-                (equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
-                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
-                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
-                )
-           (equal (equal k (bits x i j))
-                  t)))
-
-
-;make into a rewrite rule
-(defthm cat-with-slice-of-x-equal-x
-  (implies (and (bvecp x (+ m n))
-                (case-split (bvecp y n))
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (equal x (cat (bits x (+ -1 m n) n) m y n))
-                  (equal (bits x (+ -1 n) 0) y))
-           ))
-
-;cat-with-slice-of-x-equal-x won't match, so we use kk here
-;add a syntaxp hyp?
-(defthm cat-with-slice-of-x-equal-x-rewrite
-  (implies (and (equal kk (+ -1 m n))
-                (bvecp x (+ m n))
-                (case-split (bvecp y n))
-                (case-split (<= 0 m))
-                (case-split (<= 0 n))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (equal x (cat (bits x kk n) m y n))
-                  (equal (bits x (+ -1 n) 0) y))
-           ))
-
-;If X and Y have identical bits in the range [i..j], then they also match on any subrange [k..l] of [i..j]
-(defthmd bits-equal-implies-subranges-equal-helper
-  (implies (and (equal (bits x i j) (bits y i j))
-                (<= j l)
-                (<= k i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                (case-split (integerp l))
-                )
-           (equal (equal (bits x k l) (bits y k l))
-                  t))
-  :rule-classes ((:rewrite :match-free :all)))
-
-(defthm bits-equal-implies-subranges-equal
-  (implies (and (equal (bits x i j) (bits y i j))
-                (<= j l)
-                (<= k i)
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (equal (bits x k l) (bits y k l))
-                  t))
-  :rule-classes ((:rewrite :match-free :all)))
-
diff -Nru acl2-6.2/books/rtl/rel5/user/decode.lisp acl2-6.3/books/rtl/rel5/user/decode.lisp
--- acl2-6.2/books/rtl/rel5/user/decode.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/decode.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "../support/decode"))
-
-;;Necessary defuns:
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-;; New stuff:
-
-(defund decode (x n)
-  (declare (xargs :guard (rationalp n)))
-  (if (and (natp x) (< x n)) 
-      (ash 1 x) 
-    0))
-
-(defthm decode-nonnegative-integer-type
-  (and (integerp (decode x n))
-       (<= 0 (decode x n)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than decode-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription decode)))
-
-(defthm decode-natp
-  (natp (decode x n)))
-
-(defthm decode-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k))
-                )
-           (bvecp (decode x n) k)))
diff -Nru acl2-6.2/books/rtl/rel5/user/ereps.lisp acl2-6.3/books/rtl/rel5/user/ereps.lisp
--- acl2-6.2/books/rtl/rel5/user/ereps.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/ereps.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,389 +0,0 @@
-(in-package "ACL2")
-
-; Eric Smith, David Russinoff, with contributions and suggestions by Matt Kaufmann
-; AMD, June 2001 
-
-(local (include-book "../support/ereps"))
-(local (include-book "../support/guards"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-
-;;Necessary defuns: BOZO is all this necessary?
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-
-(defund binary-cat (x m y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp m) (< 0 m)
-                              (integerp n) (< 0 n))))
-  (if (and (natp m) (natp n))
-      (+ (* (expt 2 n) (bits x (1- m) 0))
-         (bits y (1- n) 0))
-    0))
-
-(defun formal-+ (x y)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
-;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
-;;not need to specify this in the guard, and leaving it out of that guard
-;;simplifies the guard proof.
-
-(defun cat-size (x)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
-  (if (endp (cddr x))
-      (cadr x)
-    (formal-+ (cadr x)
-	      (cat-size (cddr x)))))
-
-(defmacro cat (&rest x)
-  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
-  (cond ((endp (cddr x))
-         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
-        ((endp (cddddr x))
-         `(binary-cat ,@x))
-        (t
-         `(binary-cat ,(car x) 
-                      ,(cadr x) 
-                      (cat ,@(cddr x)) 
-                      ,(cat-size (cddr x))))))
-
-;Allows things like (in-theory (disable cat)) to refer to binary-cat.
-(add-macro-alias cat binary-cat)
-
-(defund mulcat (l n x)
-
-; We introduce mbe not because we want particularly fast execution, but because
-; the existing logic definition does not satisfy the guard of cat, which can't
-; be changed because of the guard of bits.
-
-  (declare (xargs :guard (and (integerp l)
-                              (< 0 l)
-                              (acl2-numberp n)
-                              (natp x))))
-  (mbe :logic (if (and (integerp n) (> n 0))
-                  (cat (mulcat l (1- n) x)
-                       (* l (1- n))
-                       x
-                       l)
-                0)
-       :exec  (cond ((eql n 1)
-                     (bits x (1- l) 0))
-                    ((and (integerp n) (> n 0))
-                     (cat (mulcat l (1- n) x)
-                          (* l (1- n))
-                          x
-                          l))
-                    (t 0))))
-
-
-;;
-;; New stuff:
-;;
-
-
-; bias of a q bit exponent field is 2^(q-1)-1 
-(defund bias (q) (- (expt 2 (- q 1)) 1) )
-
-;;Encoding of floating-point numbers with explicit leading one:
-;;bit vectors of length p+q+1, consisting of 1-bit sign field, 
-;;q-bit exponent field (bias = 2**(q-1)-1), and p-bit significand field.
-
-(defund esgnf  (x p q) (bitn x (+ p q)))
-(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
-(defund esigf  (x p)   (bits x (1- p) 0))
-
-;;;**********************************************************************
-;;;                       REPRESENTABLE NUMBERS
-;;;**********************************************************************
-
-(defun erepp (x p q)
-  (and (rationalp x)
-       (not (= x 0))
-       (bvecp (+ (expo x) (bias q)) q)
-       (exactp x p)))
-
-
-;;;**********************************************************************
-;;;                      VALID ENCODINGS
-;;;**********************************************************************
-
-(defun eencodingp (x p q)
-  (and (bvecp x (+ p q 1))
-       (= (bitn x (- p 1)) 1)))
-
-
-;;;**********************************************************************
-;;;                       EENCODE
-;;;**********************************************************************
-
-
-
-; sig, expo, and sgn are defined in float.lisp
-
-
-;bozo disable!
-(defun eencode (x p q)
-  (cat (cat (if (= (sgn x) 1) 0 1)
-	    1
-	    (+ (expo x) (bias q))
-	    q)
-       (1+ q)
-       (* (sig x) (expt 2 (- p 1)))
-       p) )
-
-
-
-
-;;;**********************************************************************
-;;;                       EDECODE
-;;;**********************************************************************
-
-
-(defun edecode (x p q)
-  (* (if (= (esgnf x p q) 0) 1 -1)
-     (esigf x p)
-     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
-
-
-
-;;;**********************************************************************
-;;;                      Encoding and Decoding are Inverses
-;;;**********************************************************************
-
-(defthm erepp-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (erepp (edecode x p q) p q)))
-
-
-(defthm eencodingp-eencode
-  (implies (and (erepp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (eencodingp (eencode x p q) p q) ))
-
-(defthm edecode-eencode
-  (implies (and (erepp x p q)
-                (integerp p)
-;                (> p 0)
-                (integerp q)
- ;               (> q 0)
-                )
-           (equal (edecode (eencode x p q) p q)
-                  x )))
-
-(defthm eencode-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (>= p 0)
-                (integerp q)
-                (> q 0))
-           (equal (eencode (edecode x p q) p q)
-                  x )))
-
-(defthm expo-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))  
-           (equal (expo (edecode x p q))
-                  (- (eexpof x p q) (bias q))
-                  )))
-
-(defthm sgn-edecode
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (equal (sgn (edecode  x p q))
-                  (if (= (esgnf x p q) 0) 1 -1))))
-
-(defthm sig-edecode
-  (implies (and (eencodingp  x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (equal (sig (edecode  x p q))
-                  (/ (esigf x p) (expt 2 (- p 1))))))
-
-(defthm eencodingp-not-zero
-  (implies (and (eencodingp x p q)
-                (integerp p)
-                (> p 0)
-                (integerp q)
-                (> q 0))
-           (not (equal (edecode x p q) 0))))
-
-(defun rebias-expo (expo old new)
-  (+ expo (- (bias new) (bias old))))
-
-;;I actually needed all four of the following lemmas, although I would have thought
-;;that the two bvecp lemmas would be enough.
-
-(defthm natp-rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x m))
-	     (natp (rebias-expo x m n)))
-    :hints (("goal" :in-theory (e/d ( expt-split rebias-expo bvecp natp bias
-                                                  ) (expt-compare))
-		  :use (:instance expt-weak-monotone (n m) (m n)))))
-
-(defthm natp-rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (natp (rebias-expo x n m)))
-    :hints (("goal" :in-theory (enable rebias-expo bvecp natp bias))))
-
-(defthm bvecp-rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x m))
-	     (bvecp (rebias-expo x m n) n)))
-
-(defthm bvecp-rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (< 0 m)
-		  (<= m n)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (bvecp (rebias-expo x n m) m)))
-
-(defthm rebias-up
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x m))
-	     (equal (rebias-expo x m n)
-		    (cat (cat (bitn x (1- m))
-			      1
-			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
-			      (- n m))
-			 (1+ (- n m))
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ())
-
-(defthm rebias-down
-    (implies (and (natp n)
-		  (natp m)
-		  (> n m)
-		  (> m 1)
-		  (bvecp x n)
-		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
-		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
-	     (equal (rebias-expo x n m)
-		    (cat (bitn x (1- n))
-			 1
-			 (bits x (- m 2) 0)
-			 (1- m))))
-  :rule-classes ())
-
diff -Nru acl2-6.2/books/rtl/rel5/user/land.lisp acl2-6.3/books/rtl/rel5/user/land.lisp
--- acl2-6.2/books/rtl/rel5/user/land.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/land.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,373 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LAND0, a nice version of LOGAND.  LAND0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-|#
-
-(local (include-book "../support/guards"))
-
-;;Necessary defuns:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-(local (include-book "../support/land0"))
-
-;; New stuff
-
-;We expect n to be a positive integer, and x and y to be bit vectors of length n.
-(defund binary-land0 (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))))
-  (logand (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro land0 (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(land0 x y n) -- the base case
-         `(binary-land0 ,@x))
-        (t         
-         `(binary-land0 ,(car x)
-                       (land0 ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable land0)) to refer to binary-land0.
-(add-macro-alias land0 binary-land0)
-
-(defthm land0-nonnegative-integer-type
-  (and (integerp (land0 x y n))
-       (<= 0 (land0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription land0) is no better than land0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-land0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm land0-natp
-  (natp (land0 x y n)))
-
-;BOZO split into 2 rules?
-(defthm land0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (land0 x y n)
-                  0)))
-
-(defthmd land0-bvecp-simple
-  (bvecp (land0 x y n) n))
-
-(defthm land0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (land0 x y n) k)))
-
-
-;;
-;; Rules to normalize land0 terms (recall that LAND0 is a macro for BINARY-LAND0):
-;;
-
-;This guarantees that the n parameters to nested LAND0 calls match.
-;Note the MIN in the conclusion.
-;BOZO do we expect MIN to be enabled?  Maybe we should use IF instead for this and other rules?
-(defthm land0-nest-tighten
-  (implies (and (syntaxp (not (equal m n)))
-                (case-split (integerp m))
-                (case-split (integerp n))
-                )
-           (equal (land0 x (land0 y z m) n)
-                  (land0 x (land0 y z (min m n)) (min m n)))))
-
-; allow the n's to differ on this?
-(defthm land0-associative
-  (equal (land0 (land0 x y n) z n)
-         (land0 x (land0 y z n) n)))
-
-(defthm land0-commutative
-  (equal (land0 y x n)
-         (land0 x y n)))
-
-; allow the n's to differ on this?
-(defthm land0-commutative-2
-  (equal (land0 y (land0 x z n) n)
-         (land0 x (land0 y z n) n)))
-
-; allow the n's to differ on this?
-(defthm land0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (land0 x (land0 y z n) n)
-                  (land0 (land0 x y n) z n))))
-
-(defthm land0-0
-  (equal (land0 0 y n)
-         0))
-
-;nicer than the analogous rule for logand? is it really?
-;BOZO gen the second 1 in the lhs?
-(defthm land0-1
-  (equal (land0 1 y 1)
-         (bitn y 0)))
-
-(defthm land0-self
-  (equal (land0 x x n)
-         (bits x (+ -1 n) 0)))
-
-;perhaps use only the main rule, bits-land0?
-(defthmd bits-land0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j))))))
-
-;perhaps use only the main rule, bits-land0?
-(defthmd bits-land0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j))))))
-
-;Notice the call to MIN in the conclusion.
-(defthm bits-land0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (land0 x y n) i j)
-                  (land0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-land0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  (land0 (bitn x m) 
-                        (bitn y m) 
-                        1))))
-(defthmd bitn-land0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-land0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (land0 x y n) m)
-                  (if (< m n)
-                      (land0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0))))
-
-;BOZO see land0-equal-0
-;drop bvecp hyps and put bitn in conclusion?
-(defthm land0-of-single-bits-equal-0
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 0 (land0 x y 1))
-                  (or (equal x 0)
-                      (equal y 0)))))
-
-(defthm land0-of-single-bits-equal-1
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 1 (land0 x y 1))
-                  (and (equal x 1)
-                       (equal y 1)))))
-
-(defthm land0-ones
-  (equal (land0 (+ -1 (expt 2 n)) x n)
-         (bits x (+ -1 n) 0))
-  :rule-classes ())
-
-;land0-with-all-ones will rewrite (land0 x n) [note there's only one value being ANDed], because (land0 x n)
-;expands to (BINARY-LAND0 X (ALL-ONES N) N) - now moot???
-;BOZO drop bvecp hyp and move to conclusion?
-(defthm land0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (land0 (all-ones n) x n)
-                  x)))
-
-(defthmd land0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k) (quotep n)))
-                (equal k (1- (expt 2 n))) ;this computes on constants...
-                )
-           (equal (land0 k x n)
-                  (bits x (+ -1 n) 0))))
-
-(defthm land0-def
-  (implies (and (> n 0)
-                (integerp n)
-                )
-           (equal (land0 x y n)
-                  (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-                     (land0 (mod x 2) (mod y 2) 1))))
-  :rule-classes ())
-
-(defthmd land0-mod-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (mod (land0 x y n) 2)
-                  (land0 (mod x 2) (mod y 2) 1))))
-
-;BOZO RHS isn't simplified...
-(defthmd land0-fl-2
-  (implies (and (natp x)
-                (natp y)
-                (natp n)
-                (> n 0))
-           (equal (fl (/ (land0 x y n) 2))
-                  (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
-
-;BOZO rename to land0-with-n-0
-;what if n is negative? or not an integer?
-(defthm land0-x-y-0
-  (equal (land0 x y 0) 0))
-
-;actually, maybe only either x or y must be a bvecp of length n
-;n is a free var
-(defthm land0-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (natp n)
-		  (natp m)
-		  (< n m))
-	     (equal (land0 x y m)
-                    (land0 x y n))))
-
-;deceptive name; this only works for single bits!
-(defthm land0-equal-0
-  (implies (and (bvecp i 1)
-                (bvecp j 1))
-           (equal (equal 0 (land0 i j 1))
-                  (or (equal i 0)
-                      (equal j 0)))))
-
-;make alt version?
-(defthm land0-bnd
-  (implies (case-split (<= 0 x))
-           (<= (land0 x y n) x))
-  :rule-classes (:rewrite :linear))
-
-;enable? make an alt version??
-(defthmd land0-ignores-bits
-  (equal (land0 (bits x (+ -1 n) 0) y n)
-         (land0 x y n)))
-
-(defthmd land0-with-shifted-arg
-  (implies (and (integerp x) ;gen?
-                (rationalp y)
-                (integerp m)
-                (integerp n)
-                (<= 0 m)
-                )
-           (equal (land0 (* (expt 2 m) x) y n)
-                  (* (expt 2 m) (land0 x (bits y (+ -1 n) m) (+ n (- m)))))))
-
-(defthmd land0-expt
-  (implies (and (natp n)
-                (natp k)
-                (< k n))
-           (equal (land0 x (expt 2 k) n)
-                  (* (expt 2 k) (bitn x k)))))
-
-(defthm land0-slice
-  (implies (and (<= j i) ;drop? or not?
-                (<= i n)
-                (integerp n)
-                (integerp i)
-                (integerp j)
-                (<= 0 j)
-                )
-           (equal (land0 x (- (expt 2 i) (expt 2 j)) n)
-                  (* (expt 2 j) (bits x (1- i) j))))
-  :rule-classes ())
-
-(defthm land0-upper-bound
-  (implies (and (integerp n)
-                (<= 0 n))
-           (< (land0 x y n) (expt 2 n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm land0-upper-bound-tight
-  (implies (and (integerp n)
-                (<= 0 n))
-           (<= (land0 x y n) (+ -1 (expt 2 n)))))
-
-(defthm land0-fl-1
-  (equal (land0 (fl x) y n)
-         (land0 x y n)))
-
-(defthm land0-fl-2-eric ;BOZO name conflicted...
-  (equal (land0 x (fl y) n)
-         (land0 x y n)))
diff -Nru acl2-6.2/books/rtl/rel5/user/lextra.lisp acl2-6.3/books/rtl/rel5/user/lextra.lisp
--- acl2-6.2/books/rtl/rel5/user/lextra.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/lextra.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-(in-package "ACL2")
-
-(include-book "land")
-(include-book "lior")
-(include-book "lxor")
-(local (include-book "../support/lextra0"))
-
-;theorems mixing two or more of the new logical operators.
-
-;BOZO really the -1 and -2 names below should be switched?
-
-(defthmd lior0-land0-1
-  (equal (lior0 x (land0 y z n) n)
-         (land0 (lior0 x y n) (lior0 x z n) n)))
-
-(defthmd lior0-land0-2
-  (equal (lior0 (land0 y z n) x n)
-         (land0 (lior0 x y n) (lior0 x z n) n)))
-
-(defthmd land0-lior0-1
-  (equal (land0 x (lior0 y z n) n)
-         (lior0 (land0 x y n) (land0 x z n) n)))
-
-(defthmd land0-lior0-2
-  (equal (land0 (lior0 y z n) x n)
-         (lior0 (land0 x y n) (land0 x z n) n)))
-
-(defthmd lior0-land0-lxor0
-  (equal (lior0 (land0 x y n) (lior0 (land0 x z n) (land0 y z n) n) n)
-         (lior0 (land0 x y n) (land0 (lxor0 x y n) z n) n)))
-
-(defthmd lxor0-rewrite
-  (equal (lxor0 x y n)
-         (lior0 (land0 x (lnot y n) n)
-               (land0 y (lnot x n) n)
-               n)))
-
-(defthmd lnot-lxor0
-  (equal (lnot (lxor0 x y n) n)
-         (lxor0 (lnot x n) y n)))
-
-;consider enabling?
-(defthmd lnot-lior0
-  (equal (lnot (lior0 x y n) n)
-         (land0 (lnot x n) (lnot y n) n)))
-
-;consider enabling?
-(defthmd lnot-land0
-  (equal (lnot (land0 x y n) n)
-         (lior0 (lnot x n) (lnot y n) n)))
-
diff -Nru acl2-6.2/books/rtl/rel5/user/lior.lisp acl2-6.3/books/rtl/rel5/user/lior.lisp
--- acl2-6.2/books/rtl/rel5/user/lior.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/lior.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,378 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LIOR0, a nice version of LOGIOR.  LIOR0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-|#
-
-(local (include-book "../support/lior0"))
-(local (include-book "../support/guards"))
-
-;; Necessary defuns:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-;; Start of new stuff:
-
-(defund binary-lior0 (x y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))))
-  (logior (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro lior0 (&rest x)
-  (declare (xargs :guard (and (consp x)
-                              (consp (cdr x))
-                              (consp (cddr x)))))
-  (cond ((endp (cdddr x)) ;(lior0 x y n) -- the base case
-         `(binary-lior0 ,@x))
-        (t         
-         `(binary-lior0 ,(car x)
-                       (lior0 ,@(cdr x))
-                       ,(car (last x))))))
-
-;Allows things like (in-theory (disable lior0)) to refer to binary-lior0.
-(add-macro-alias lior0 binary-lior0)
-
-(defthm lior0-nonnegative-integer-type
-  (and (integerp (lior0 x y n))
-       (<= 0 (lior0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lior0) is no better than lior0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lior0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lior0-natp
-  (natp (lior0 x y n)))
-
-(defthm lior0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (lior0 x y n)
-                  0)))
-
-(defthmd lior0-bvecp-simple
-  (bvecp (lior0 x y n) n))
-
-(defthm lior0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lior0 x y n) k)))
-
-
-;;
-;; Rules to normalize lior0 terms (recall that LIOR0 is a macro for BINARY-LIOR0):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm lior0-associative
-  (equal (lior0 (lior0 x y n) z n)
-         (lior0 x (lior0 y z n) n)))
-
-(defthm lior0-commutative
-  (equal (lior0 y x n)
-         (lior0 x y n)))
-
-(defthm lior0-commutative-2
-  (equal (lior0 y (lior0 x z n) n)
-         (lior0 x (lior0 y z n) n)))
-
-(defthm lior0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (lior0 x (lior0 y z n) n)
-                  (lior0 (lior0 x y n) z n))))
-
-(defthm lior0-0
-  (implies (case-split (bvecp y n))
-           (equal (lior0 0 y n)
-                  y)))
-
-;nicer than the analogous rule for logior?
-(defthm lior0-1
-  (implies (case-split (bvecp y 1))
-           (equal (lior0 1 y 1)
-                  1)))
-
-(defthm lior0-self
-  (implies (and (case-split (bvecp x n))
-                (case-split (integerp n)))
-           (equal (lior0 x x n)
-                  x)))
-
-(defthmd bits-lior0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j))))))
-
-(defthmd bits-lior0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j))))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-lior0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (lior0 x y n) i j)
-                  (lior0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-lior0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  (lior0 (bitn x m) 
-                        (bitn y m) 
-                        1))))
-
-(defthmd bitn-lior0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-lior0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lior0 x y n) m)
-                  (if (< m n)
-                      (lior0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0))))
-
-;or could wrap bits around conclusion?
-(defthm lior0-equal-0
-  (implies (and (case-split (bvecp x n))
-                (case-split (bvecp y n))
-                (case-split (integerp n))
-                )
-           (equal (equal 0 (lior0 x y n))
-                  (and (equal x 0)
-                       (equal y 0)))))
-
-(defthm lior0-of-single-bits-equal-0
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 0 (lior0 x y 1))
-                  (and (equal x 0)
-                       (equal y 0)))))
-
-(defthm lior0-of-single-bits-equal-1
-  (implies (and (case-split (bvecp x 1))
-                (case-split (bvecp y 1))
-                )
-           (equal (equal 1 (lior0 x y 1))
-                  (or (equal x 1)
-                      (equal y 1)))))
-
-(defthm lior0-ones
-  (implies (and (case-split (bvecp x n))
-                (case-split (natp n)) ;gen
-                )
-           (equal (lior0 (1- (expt 2 n)) x n)
-                  (1- (expt 2 n))))
-  :rule-classes ())
-
-;lior0-with-all-ones will rewrite (lior0 x n) [note there's only one value being ANDed], because (lior0 x n)
-;expands to (BINARY-LIOR0 X (ALL-ONES N) N) - now moot???
-(defthm lior0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (lior0 (all-ones n) x n)
-                  (all-ones n))))
-
-(defthm lior0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-		(case-split (natp n))
-                (case-split (bvecp x n)))
-           (equal (lior0 k x n)
-                  (1- (expt 2 n)))))
-
-(defthm lior0-def
-    (implies (and (< 0 n)
-		  (integerp n))
-	     (equal (lior0 x y n)
-		    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-		       (lior0 (mod x 2) (mod y 2) 1))))
-  :rule-classes ())
-
-(defthm lior0-mod-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (mod (lior0 x y n) 2)
-		    (lior0 (mod x 2) (mod y 2) 1))))
-
-(defthm lior0-fl-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (fl (/ (lior0 x y n) 2))
-		    (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
-
-(in-theory (disable lior0-mod-2 lior0-fl-2))
-
-;BOZO rename
-(defthm lior0-x-y-0
-  (equal (lior0 x y 0) 0))
-
-(defthm lior0-reduce
-  (implies (and (bvecp x n)
-                (bvecp y n)
-                (< n m)
-                (natp n) ;gen?
-                (natp m)
-                )
-           (equal (lior0 x y m) (lior0 x y n))))
-
-;whoa! this is a *lower* bound !
-;make alt version?
-(defthm lior0-bnd
-  (implies (case-split (bvecp x n))
-           (<= x (lior0 x y n)))
-  :rule-classes (:rewrite :linear))
-
-;get rid of the bvecp hyps (do that for many lemmas like this one)
-(defthm lior0-with-shifted-arg
-    (implies (and (bvecp y m)
-		  (bvecp x (- n m))
-                  (<= m n)
-		  (natp m)
-                  (integerp n)
-                  )
-	     (= (lior0 (* (expt 2 m) x) y n)
-		(+ (* (expt 2 m) x) y)))
-  :rule-classes ())
-
-(defthm lior0-shift
-    (implies (and (bvecp x (- n m))
-		  (bvecp y (- n m))
-                  (integerp n) ;(not (zp n))
-		  (natp m)
-		  (<= m n)
-                  )
-	     (= (lior0 (* (expt 2 m) x)
-		      (* (expt 2 m) y)
-		      n)
-		(* (expt 2 m) (lior0 x y (- n m)))))
-  :rule-classes ())
-
-(defthm lior0-expt-original
-    (implies (and (natp n)
-		  (natp k)
-		  (< k n)
-		  (bvecp x n))
-	     (= (lior0 x (expt 2 k) n)
-		(+ x (* (expt 2 k) (- 1 (bitn x k))))))
-  :rule-classes ())
-
-(defthm lior0-expt
-  (implies (and (natp n)
-                (natp k)
-                (< k n))
-           (= (lior0 x (expt 2 k) n)
-              (+ (bits x (1- n) 0)
-                 (* (expt 2 k) (- 1 (bitn x k))))))
-  :rule-classes ())
-
-;interesting.  not the same as lior0-bvecp (here, m can be smaller than n)
-;rename !!
-(defthm lior0-bvecp-2
-  (implies (and (bvecp x m)
-                (bvecp y m)
-                )
-           (bvecp (lior0 x y n) m)))
-
-(defthm lior0-upper-bound
-  (< (lior0 x y n) (expt 2 n))
-  :rule-classes (:rewrite :linear))
-
-(defthm lior0-upper-bound-tight
-  (implies (<= 0 n)
-           (<= (lior0 x y n) (+ -1 (expt 2 n))))
-  :rule-classes (:rewrite :linear))
-
-(defthm lior0-fl-1
-  (equal (lior0 (fl x) y n)
-         (lior0 x y n)))
-
-(defthm lior0-fl-2-eric
-  (equal (lior0 x (fl y) n)
-         (lior0 x y n)))
diff -Nru acl2-6.2/books/rtl/rel5/user/lnot.lisp acl2-6.3/books/rtl/rel5/user/lnot.lisp
--- acl2-6.2/books/rtl/rel5/user/lnot.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/lnot.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,238 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "../support/guards"))
-
-;; Necessary defuns
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(local (include-book "../support/lnot"))
-
-;;New stuff:
-
-;used to be called COMP1
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-;note that this isn't a rewrite rule b/c we believe it will never need to be
-;BOZO make it one anyway?
-(defthm lnot-nonnegative-integer-type
-  (and (integerp (lnot x n))
-       (<= 0 (lnot x n)))
-  :rule-classes ((:type-prescription :typed-term (lnot x n))))
-
-;lnot-nonnegative-integer-type is strictly better, and we don't need both
-(in-theory (disable (:type-prescription lnot))) 
-
-(defthm lnot-natp
-  (natp (lnot x n)))
-
-(defthm lnot-upper-bound
-  (< (lnot x n) (expt 2 n))
-  :rule-classes (:rewrite :linear)
-  )
-
-;why is bvecp enabled here?
-
-(defthm lnot-bvecp-simple
-  (bvecp (lnot x n) n))
-
-(defthm lnot-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lnot x n) k)))
-
-;perhaps conclude with bits of x and drop the bvecp hyp?
-(defthm lnot-lnot
-  (implies (and (case-split (natp n))
-                (case-split (bvecp x n))
-                )
-           (equal (lnot (lnot x n) n)
-                  x)))
-
-;reorient this rule?
-(defthmd lnot-times-2
-   (implies (and (case-split (natp x))
-                 (case-split (natp n))
-                 )
-            (equal (+ 1 (* 2 (lnot x n)))
-                   (lnot (* 2 x) (1+ n)))))
-
-(defthm lnot-x-0
-  (equal (lnot x 0) 0))
-
-;gen?
-;make a by-2 version?
-;change param name?
-;make a better rewrite rule
-;RHS isn't simplified!
-(defthmd lnot-fl-original
-  (implies (and (<= k n)
-                ;(bvecp x n)
-                (<= 0 k)
-                (integerp n) 
-                (integerp k)
-                )
-           (equal (fl (* (/ (expt 2 k)) (lnot x n)))
-                  (lnot (fl (/ x (expt 2 k))) (- n k)))))
-
-;gen
-;add case-splits
-(defthmd mod-lnot
-  (implies (and (<= k n)
-                (natp k)
-                (integerp n)
-                )
-           (equal (mod (lnot x n) (expt 2 k))
-                  (lnot (mod x (expt 2 k)) k))))
-
-(defthm mod-lnot-by-2
-  (implies (and (< 0 n)
-                (integerp x) ;gen?
-                (integerp n)
-                )
-           (equal (mod (lnot x n) 2)
-                  (lnot (mod x 2) 1))))
-
-;disable?
-(defthm lnot-bits-1
-  (equal (lnot (bits x (+ -1 n) 0) n)
-         (lnot x n)))
-
-(defthmd lnot-ignores-bits-2
-  (implies (and (integerp i)
-                (<= (+ -1 n) i))
-           (equal (lnot (bits x i 0) n)
-                  (lnot x n))))
-
-(defthm bits-lnot
-  (implies (and (case-split (natp j))
-		(case-split (integerp n))
-		(case-split (integerp i)))
-	   (equal (bits (lnot x n) i j)
-                  (if (< i n)
-                      (lnot (bits x i j)
-                            (1+ (- i j)))
-                    (lnot (bits x (1- n) j)
-                          (- n j))))))
-
-;gen?
-(defthm bitn-lnot
-  (implies (and (case-split (natp k))
-                (case-split (natp n))
-                )
-           (equal (bitn (lnot x n) k)
-                  (if (< k n)
-                      (lnot (bitn x k) 1)
-                    0))))
-
-;do we still need this, given bitn-lnot?
-(defthm bitn-lnot-not-equal
-  (implies (and (< k n)
-                (integerp n)
-                (<= 0 n)
-                (integerp k)
-                (<= 0 k)
-                )
-           (not (= (bitn (lnot x n) k)
-                   (bitn x k))))
-  :rule-classes ())
-
-;could generalize these a lot (when lnot equals a constant, take the lnot of both sides)
-;drop bvecp hyp by wrapping bits around conclusion?
-(defthm lnot-bvecp-equal-0
-  (implies (case-split (bvecp x 1))
-           (equal (equal (lnot x 1) 0)
-                  (not (equal x 0)))))
-
-(defthm lnot-bvecp-equal-1
-  (implies (case-split (bvecp x 1))
-           (equal (equal (lnot x 1) 1)
-                  (equal x 0))))
-
-;consider enabling?
-(defthmd lnot-ignores-mod-special
-  (equal (lnot (mod x (expt 2 m)) m)
-         (lnot x m)))
-
-;consider enabling?
-(defthmd lnot-ignores-mod
-  (implies (and (<= m n)
-                (case-split (integerp n)))
-           (equal (lnot (mod x (expt 2 n)) m)
-                  (lnot x m))))
-
-(defthmd lnot-shift
-  (implies (and (case-split (integerp x))
-                (case-split (natp n))
-                (natp k))
-           (equal (lnot (* (expt 2 k) x) n)
-                  (if (<= k n)
-                      (+ (* (expt 2 k) (lnot x (- n k)))
-                         (1- (expt 2 k)))
-                    (1- (expt 2 n)))))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-;consider enabling?
-(defthmd lnot-shift-2
-  (implies (and (syntaxp (not (quotep x))) ;prevents loops
-                (case-split (integerp x))
-                (case-split (< 0 n))
-                (case-split (integerp n))
-                )
-           (equal (lnot (* 2 x) n)
-                  (+ 1 (* 2 (lnot x (1- n))))))
-  :hints (("Goal" :in-theory (enable lnot))))
-
-;disable?
-;BOZO rename the other lnot-fl.  this one should be called lnot-fl.
-(defthm lnot-fl-eric
-  (equal (lnot (fl x) n)
-         (lnot x n)))
-
-(defthm lnot-with-n-not-an-integer
-  (implies (not (integerp n))
-           (equal (lnot x n)
-                  0)))
-
-(defthm lnot-with-n-not-positive
-  (implies (<= n 0)
-           (equal (lnot x n)
-                  0)))
diff -Nru acl2-6.2/books/rtl/rel5/user/logior1.lisp acl2-6.3/books/rtl/rel5/user/logior1.lisp
--- acl2-6.2/books/rtl/rel5/user/logior1.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/logior1.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,22 +0,0 @@
-(in-package "ACL2")
-
-;Perhaps we want to keep LOGIOR1 enabled, but if not here are some rules about it...  More are in logs.lisp
-;(more those here?).
-
-(local (include-book "../support/logior1"))
-
-(defund logior1 (x)
-  (declare (xargs :guard t))
-  (if (equal x 0) 0 1))
-
-(defthm logior1-logior1
-  (equal (logior1 (logior1 x))
-         (logior1 x)))
-
-(defthm logior1-equal-0
-  (equal (equal (logior1 x) 0)
-         (equal x 0)))
-
-(defthm logior1-equal-1
-  (equal (equal (logior1 x) 1)
-         (not (equal x 0))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel5/user/lxor.lisp acl2-6.3/books/rtl/rel5/user/lxor.lisp
--- acl2-6.2/books/rtl/rel5/user/lxor.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/lxor.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,307 +0,0 @@
-(in-package "ACL2")
-
-#|
-
-This book is about LXOR0, a nice version of LOGXOR.  LXOR0 takes an extra size parameter, N, and always returns
-a bit vector of length N.
-
-todo: ;add analogues of the thms in land0.lisp past bitn-land0
-
-|#
-
-(local (include-book "../support/guards"))
-
-;; Necessary defuns:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund lnot (x n)
-  (declare (xargs :guard (and (natp x)
-                              (integerp n)
-                              (< 0 n))))
-  (if (natp n)
-      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
-    0))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund all-ones (n)
-  (declare (xargs :guard (and (integerp n) (<= 0 n))))
-  (if (zp n)
-      0 ;degenerate case
-    (1- (expt 2 n))))
-
-;Start of new stuff;
-
-(local (include-book "../support/lxor0"))
-
-(defund binary-lxor0 (x y n)
-  (declare (xargs :guard (and (natp x) 
-                              (natp y)
-                              (integerp n)
-                              (< 0 n))))
-  (logxor (bits x (1- n) 0)
-          (bits y (1- n) 0)))
-
-(defun formal-+ (x y)
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-(defmacro lxor0 (&rest x)
-  (declare (xargs :guard (consp x)))
-  (cond ((endp (cdddr x)) ;(lxor0 x y n) -- the base case
-         `(binary-lxor0 ,@x))
-        (t         
-         `(binary-lxor0 ,(car x)
-                       (lxor0 ,@(cdr x))
-                       ,(car (last x))))))
-
-
-;Allows things like (in-theory (disable lxor0)) to refer to binary-lxor0.
-(add-macro-alias lxor0 binary-lxor0)
-
-(defthm lxor0-nonnegative-integer-type
-  (and (integerp (lxor0 x y n))
-       (<= 0 (lxor0 x y n)))
-  :rule-classes (:type-prescription))
-
-;(:type-prescription lxor0) is no better than lxor0-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription binary-lxor0)))
-
-;drop this if we plan to keep natp enabled?
-(defthm lxor0-natp
-  (natp (lxor0 x y n)))
-
-(defthm lxor0-with-n-not-a-natp
-  (implies (not (natp n))
-           (equal (lxor0 x y n)
-                  0)))
-
-(defthmd lxor0-bvecp-simple
-  (bvecp (lxor0 x y n) n))
-
-(defthm lxor0-bvecp
-  (implies (and (<= n k)
-                (case-split (integerp k)))
-           (bvecp (lxor0 x y n) k)))
-
-
-;;
-;; Rules to normalize lxor0 terms (recall that LXOR0 is a macro for BINARY-LXOR0):
-;;
-
-;; allow sizes to differ on these?
-
-(defthm lxor0-associative
-  (equal (lxor0 (lxor0 x y n) z n)
-         (lxor0 x (lxor0 y z n) n)))
-
-(defthm lxor0-commutative
-  (equal (lxor0 y x n)
-         (lxor0 x y n)))
-
-(defthm lxor0-commutative-2
-  (equal (lxor0 y (lxor0 x z n) n)
-         (lxor0 x (lxor0 y z n) n)))
-
-(defthm lxor0-combine-constants
-  (implies (syntaxp (and (quotep x)
-                         (quotep y)
-                         (quotep n)))
-           (equal (lxor0 x (lxor0 y z n) n)
-                  (lxor0 (lxor0 x y n) z n))))
-
-(defthm lxor0-0
-  (implies (case-split (bvecp y n))
-           (equal (lxor0 0 y n)
-                  y)))
-
-;nicer than the analogous rule for logand?
-(defthm lxor0-1
-  (implies (case-split (bvecp y 1))
-           (equal (lxor0 1 y 1)
-                  (lnot y 1))))
-
-(defthm lxor0-self
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 x x n)
-                  0)))
-
-
-(defthmd bits-lxor0-1
-  (implies (and (< i n)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ 1 i (- j))))))
-
-(defthmd bits-lxor0-2
-  (implies (and (<= n i)
-                (case-split (<= 0 j))
-                (case-split (integerp n))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ n (- j))))))
-
-;notice the call to MIN in the conclusion
-(defthm bits-lxor0
-  (implies (and (case-split (<= 0 j))
-                (case-split (integerp n))
-                (case-split (integerp i))
-                )
-           (equal (bits (lxor0 x y n) i j)
-                  (lxor0 (bits x i j) 
-                        (bits y i j) 
-                        (+ (min n (+ 1 i)) (- j))))))
-
-(defthmd bitn-lxor0-1
-  (implies (and (< m n)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  (lxor0 (bitn x m) 
-                        (bitn y m) 
-                        1))))
-(defthmd bitn-lxor0-2
-  (implies (and (<= n m)
-                (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  0)))
-
-;notice the IF in the conclusion
-;we expect this to cause case splits only rarely, since m and n will usually be constants
-(defthm bitn-lxor0
-  (implies (and (case-split (<= 0 m))
-                (case-split (integerp n))
-                )
-           (equal (bitn (lxor0 x y n) m)
-                  (if (< m n)
-                      (lxor0 (bitn x m) 
-                            (bitn y m) 
-                            1)
-                    0))))
-
-
-(defthm lxor0-ones
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 (1- (expt 2 n)) x n)
-                  (lnot x n)))
-  :rule-classes ())
-
-;lxor0-with-all-ones will rewrite (lxor0 x n) [note there's only one value being ANDed], because (lxor0 x n)
-;expands to (BINARY-LXOR0 X (ALL-ONES N) N) - now moot???
-(defthm lxor0-with-all-ones
-  (implies (case-split (bvecp x n))
-           (equal (lxor0 (all-ones n) x n)
-                  (lnot x n))))
-
-(defthm lxor0-ones-rewrite
-  (implies (and (syntaxp (and (quotep k)
-                              (quotep n)
-                              (equal (cadr k) (1- (expt 2 (cadr n))))))
-                (force (equal k (1- (expt 2 n))))
-                (case-split (bvecp x n)))
-           (equal (lxor0 k x n)
-                  (lnot x n))))
-
-(defthm lxor0-def
-    (implies (and (< 0 n)
-                  (integerp n)
-		  )
-	     (equal (lxor0 x y n)
-		    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
-		       (lxor0 (mod x 2) (mod y 2) 1))))
-  :rule-classes ())
-
-(defthm lxor0-mod-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (mod (lxor0 x y n) 2)
-		    (lxor0 (mod x 2) (mod y 2) 1))))
-
-(defthm lxor0-fl-2
-    (implies (and (natp x)
-		  (natp y)
-		  (natp n)
-		  (> n 0))
-	     (equal (fl (/ (lxor0 x y n) 2))
-		    (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
-
-(in-theory (disable lxor0-mod-2 lxor0-fl-2))
-
-(defthm bitn-lxor0-0
-    (implies (and (integerp x)
-                  (integerp y)
-		  (not (zp n))
-                  )
-	     (= (bitn (lxor0 x y n) 0)
-		(bitn (+ x y) 0)))		
-  :rule-classes ())
-
-;BOZO rename
-(defthm lxor0-x-y-0
-  (equal (lxor0 x y 0) 0))
-
-
-;N is a free variable
-(defthm lxor0-reduce
-    (implies (and (bvecp x n)
-		  (bvecp y n)
-		  (< n m)
-		  (case-split (integerp m))
-		  )
-	     (equal (lxor0 x y m) 
-                    (lxor0 x y n))))
-
-(defthm lxor0-upper-bound
-  (implies (and (integerp n)
-                (<= 0 n))
-           (< (lxor0 x y n) (expt 2 n)))
-  :rule-classes (:rewrite :linear))
-
-(defthm lxor0-upper-bound-tight
-  (implies (and (integerp n)
-                (<= 0 n))
-           (<= (lxor0 x y n) (+ -1 (expt 2 n)))))
diff -Nru acl2-6.2/books/rtl/rel5/user/mulcat.lisp acl2-6.3/books/rtl/rel5/user/mulcat.lisp
--- acl2-6.2/books/rtl/rel5/user/mulcat.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/mulcat.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,186 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "../support/mulcat"))
-(local (include-book "../support/guards"))
-
-;;Necessary defuns:
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund binary-cat (x m y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp m) (< 0 m)
-                              (integerp n) (< 0 n))))
-  (if (and (natp m) (natp n))
-      (+ (* (expt 2 n) (bits x (1- m) 0))
-         (bits y (1- n) 0))
-    0))
-
-(defun formal-+ (x y)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
-;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
-;;not need to specify this in the guard, and leaving it out of that guard
-;;simplifies the guard proof.
-
-(defun cat-size (x)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
-  (if (endp (cddr x))
-      (cadr x)
-    (formal-+ (cadr x)
-	      (cat-size (cddr x)))))
-
-(defmacro cat (&rest x)
-  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
-  (cond ((endp (cddr x))
-         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
-        ((endp (cddddr x))
-         `(binary-cat ,@x))
-        (t
-         `(binary-cat ,(car x) 
-                      ,(cadr x) 
-                      (cat ,@(cddr x)) 
-                      ,(cat-size (cddr x))))))
-
-;Allows things like (in-theory (disable cat)) to refer to binary-cat.
-(add-macro-alias cat binary-cat)
-
-;; New stuff:
-
-
-(defund mulcat (l n x)
-
-; We introduce mbe not because we want particularly fast execution, but because
-; the existing logic definition does not satisfy the guard of cat, which can't
-; be changed because of the guard of bits.
-
-  (declare (xargs :guard (and (integerp l)
-                              (< 0 l)
-                              (acl2-numberp n)
-                              (natp x))))
-  (mbe :logic (if (and (integerp n) (> n 0))
-                  (cat (mulcat l (1- n) x)
-                       (* l (1- n))
-                       x
-                       l)
-                0)
-       :exec  (cond ((eql n 1)
-                     (bits x (1- l) 0))
-                    ((and (integerp n) (> n 0))
-                     (cat (mulcat l (1- n) x)
-                          (* l (1- n))
-                          x
-                          l))
-                    (t 0))))
-
-(defthm mulcat-nonnegative-integer-type
-  (and (integerp (mulcat l n x))
-       (<= 0 (mulcat l n x)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than mulcat-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription mulcat)))
-
-(defthm mulcat-1
-    (implies (natp l)
-	     (equal (mulcat l 1 x) 
-		    (bits x (1- l) 0))))
-
-(defthm mulcat-bvecp-simple
-  (implies (and (= p (* l n))
-                (case-split (natp l)))
-           (bvecp (mulcat l n x) p))
-  :rule-classes ())
-
-(defthm mulcat-bvecp
-  (implies (and (>= p (* l n))
-                (case-split (integerp p))
-                (case-split (natp l)))
-           (bvecp (mulcat l n x) p)))
-
-(defthm mulcat-0
-  (equal (mulcat l n 0) 
-         0))
-
-(defthm mulcat-0-two
-  (equal (mulcat l 0 x) 
-         0))
-
-(defthm bvecp-mulcat-1
-    (implies (natp n)
-	     (bvecp (mulcat 1 n 1) n))
-  :rule-classes ())
-
-(defthm mulcat-n-1
-    (implies (case-split (<= 0 n))
-	     (equal (mulcat 1 n 1)
-		    (1- (expt 2 n)))))
-
-(defun mulcat-induct (n n2)
-  (if (and (integerp n) (> n 0) (integerp n2) (> n2 0))
-      (mulcat-induct (1- n) (1- n2))
-      0))
-
-;BOZO prove a bits-mulcat? could be used to prove-bitn-mulcat
-
-;BOZO generalize to bits of mulcat when x is larger than 1?
-;not general (note the 1 for the l parameter)
-;and to when (<= n m)
-;add to lib/ ?
-(defthm bitn-mulcat-1
-  (implies (and (< m n)
-                (case-split (bvecp x 1))
-                (case-split (natp m))
-                (case-split (integerp n)) ;(case-split (natp n))
-                )
-           (equal (bitn (mulcat 1 n x) m)
-                  x)))
-
-(defthm bitn-mulcat-2
-  (implies (and (<= (* l n) n2)
-                (natp n)
-                (natp l)
-                (natp n2)
-                (case-split (bvecp x l))
-                )
-           (equal (bitn (mulcat l n x) n2)
-                  0)))
diff -Nru acl2-6.2/books/rtl/rel5/user/near.lisp acl2-6.3/books/rtl/rel5/user/near.lisp
--- acl2-6.2/books/rtl/rel5/user/near.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/near.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,391 +0,0 @@
-(in-package "ACL2")
-
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;February, 1998
-;;;***************************************************************
-
-(local (include-book "../support/near"))
-
-;; Necessary functions:
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund cg (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (- (fl (- x))))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-(defun fp+ (x n)
-  (+ x (expt 2 (- (1+ (expo x)) n))))
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-
-(defund away (x n)
-  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;; New stuff
-
-(defund re (x)
-  (- x (fl x)))
-
-(defund near (x n)
-  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
-	(f (re (* (expt 2 (1- n)) (sig x)))))
-    (if (< f 1/2)
-	(trunc x n)
-      (if (> f 1/2)
-	  (away x n)
-	(if (evenp z)
-	    (trunc x n)
-	  (away x n))))))
-
-(defthm near-minus
-  (equal (near (* -1 x) n)
-         (* -1 (near x n))))
-
-(defthm near-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (near x n)
-                  0))
-  :hints (("goal" :in-theory (enable near sig))))
-
-(defthm near-0
-  (equal (near 0 n)
-         0))
-
-(defthm near1-a
-  (implies (and (< (- x (trunc x n)) (- (away x n) x))
-                (rationalp x)
-                (>= x 0)
-                (integerp n)
-                )
-           (equal (near x n)
-                  (trunc x n)))
-  :rule-classes ())
-
-(defthm near1-b
-  (implies (and (> (- x (trunc x n)) (- (away x n) x))
-                (rationalp x)
-                (>= x 0)
-                (integerp n)
-                (> n 0)
-                )
-           (equal (near x n) 
-                  (away x n)))
-  :rule-classes ())
-
-(defthm near2-1
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (>= x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near x n) (trunc x n)))
-	     (>= (abs (- x y)) (- x (trunc x n))))
-  :rule-classes ())
-
-(defthm near2-2
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (> x 0)
-		  (> y 0)
-		  (integerp n)
-		  (> n 0)
-		  (exactp y n)
-		  (= (near x n) (away x n)))
-	     (>= (abs (- x y)) (- (away x n) x)))
-  :rule-classes ())
-
-(defthm near-choice
-  (or (= (near x n) (trunc x n))
-      (= (near x n) (away x n)))
-  :rule-classes ())
-
-(defthm near2
-  (implies (and (exactp y n)
-                (rationalp x)
-                (rationalp y)
-                (> x 0)
-                (> y 0)
-                (integerp n)
-                (> n 0)
-                )
-           (>= (abs (- x y)) (abs (- x (near x n)))))
-  :rule-classes ())
-
-(defthm near-exactp-b
-  (implies (< 0 n)
-           (exactp (near x n) n)))
-
-(defthm sgn-near-2
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (equal (sgn (near x n))
-                  (sgn x))))
-
-(defthm near-exactp-a
-  (implies (and (rationalp x)
-                (integerp n) 
-                (> n 0))
-           (iff (= x (near x n))
-                (exactp x n)))
-  :rule-classes ())
-
-(defthmd near-exactp-c
-  (implies (and (exactp a n)
-                (>= a x)
-                (rationalp x)
-                (> x 0)
-                (integerp n)
-                (> n 0)
-                (rationalp a)
-                )
-           (>= a (near x n))))
-
-(defthm near-exactp-d
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0)
-		  (rationalp a)
-		  (exactp a n)
-		  (<= a x))
-	     (<= a (near x n))))
-
-(defthm near-pos
-  (implies (and (< 0 x)
-                (< 0 n)
-                (rationalp x)
-                (integerp n)
-                )
-           (< 0 (near x n)))
-  :rule-classes (:type-prescription :linear))
-
-;BOZO gen!
-(defthm near-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (< 0 x)
-                (integerp n)
-                (> n 0))
-           (<= (near x n) (near y n))))
-
-(defund near-witness (x y n)
-  (if (= (expo x) (expo y))
-      (/ (+ (near x n) (near y n)) 2)
-    (expt 2 (expo y))))
-
-(defthm near<=away
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (<= (near x n) (away x n)))
-  :rule-classes ())
-
-(defthm near>=trunc
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (>= (near x n) (trunc x n)))
-  :rule-classes ())
-
-(defthm near-neg
-  (implies (and (< x 0)
-                (< 0 n)
-                (rationalp x)
-                (integerp n)
-                )
-           (< (near x n) 0))
-  :rule-classes (:type-prescription :linear))
-
-(defthm near-0-0
-  (implies (and (case-split (< 0 n))
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (equal (equal (near x n) 0)
-		  (equal x 0)))
-  :rule-classes ())
-
-(defthm near-near-lemma
-    (implies (and (rationalp x)
-		  (rationalp y)
-		  (< 0 x)
-		  (< x y)
-		  (integerp n)
-		  (> n 0)
-		  (not (= (near x n) (near y n))))
-	     (and (<= x (near-witness x y n))
-		  (<= (near-witness x y n) y)
-		  (exactp (near-witness x y n) (1+ n))))
-  :rule-classes ())
-
-;bad name?
-(defthm near-near
-  (implies (and (rationalp x)
-                (rationalp y)
-                (rationalp a)
-                (integerp n)
-                (integerp k)
-                (> k 0)
-                (>= n k)		  
-                (< 0 a)
-                (< a x)
-                (< 0 y)
-                (< y (fp+ a (1+ n)))
-                (exactp a (1+ n)))
-           (<= (near y k) (near x k)))
-  :rule-classes ())
-
-;why disabled?
-(defthmd near-shift
-  (implies (and (rationalp x)
-                (integerp n)
-                (integerp k))
-           (= (near (* x (expt 2 k)) n)
-              (* (near x n) (expt 2 k)))))
-
-(defthm near-a-a
-  (implies (and (rationalp x) (> x 0)
-                (rationalp a) (> a 0)
-                (integerp n) (> n 0)
-                (exactp a n)
-                (> x (+ a (expt 2 (- (expo a) n)))))
-           (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
-  :rule-classes ())
-
-(defthm near-a-b
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x (+ a (expt 2 (- (expo a) n)))))
-	     (<= (near x n) a))
-  :rule-classes ())
-
-(defthm near-a-c
-    (implies (and (rationalp x) (> x 0)
-		  (rationalp a) (> a 0)
-		  (integerp n) (> n 0)
-		  (exactp a n)
-		  (< x a)
-		  (> x (- a (expt 2 (- (expo x) n)))))
-	     (>= (near x n) a))
-  :rule-classes ())
-
-;bad name?
-(defthm near-exact
-  (implies (and (rationalp x) (> x 0)
-                (integerp n) (> n 1)
-                (exactp x (1+ n))
-                (not (exactp x n)))
-           (exactp (near x n) (1- n)))
-  :rule-classes ())
-
-(defthm near-est
-    (implies (and (integerp n) (> n 0)
-		  (rationalp x) (> x 0))
-	     (<= (abs (- x (near x n)))
-		 (expt 2 (- (expo x) n))))
-  :rule-classes ())
-
-(defthm near-power-a
-  (implies (and (rationalp x) (> x 0)
-                (integerp n) (> n 1)
-                (>= (+ x (expt 2 (- (expo x) n)))
-                    (expt 2 (1+ (expo x)))))
-           (= (near x n)
-              (expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-(defthm near-power-b
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1)
-		  (>= (+ x (expt 2 (- (expo x) n)))
-		      (expt 2 (1+ (expo x)))))
-	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
-		(expt 2 (1+ (expo x)))))
-  :rule-classes ())
-
-;bad name?
-(defthm near-exactp
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 0)
-		  (exactp x n))
-	     (equal (near x n) x))
-  :rule-classes ())
-
-(defthm near-trunc
-    (implies (and (rationalp x) (> x 0)
-		  (integerp n) (> n 1))
-	     (= (near x n)
-		(if (and (exactp x (1+ n)) (not (exactp x n)))
-		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
-		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
-  :rule-classes ())
-
-
-;BOZO yuck? bad name!
-(defthm sgn-near
-  (implies (and (rationalp x)
-                (integerp n)
-                (> n 0))
-           (= (near x n)
-              (* (sgn x) (near (abs x) n))))
-  :rule-classes ())
-
-
-
-
diff -Nru acl2-6.2/books/rtl/rel5/user/setbitn.lisp acl2-6.3/books/rtl/rel5/user/setbitn.lisp
--- acl2-6.2/books/rtl/rel5/user/setbitn.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/setbitn.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,195 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "../support/setbitn"))
-(local (include-book "../support/guards"))
-
-;; Necessary defuns:
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund binary-cat (x m y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp m) (< 0 m)
-                              (integerp n) (< 0 n))))
-  (if (and (natp m) (natp n))
-      (+ (* (expt 2 n) (bits x (1- m) 0))
-         (bits y (1- n) 0))
-    0))
-
-(defun formal-+ (x y)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
-;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
-;;not need to specify this in the guard, and leaving it out of that guard
-;;simplifies the guard proof.
-
-(defun cat-size (x)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
-  (if (endp (cddr x))
-      (cadr x)
-    (formal-+ (cadr x)
-	      (cat-size (cddr x)))))
-
-(defmacro cat (&rest x)
-  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
-  (cond ((endp (cddr x))
-         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
-        ((endp (cddddr x))
-         `(binary-cat ,@x))
-        (t
-         `(binary-cat ,(car x) 
-                      ,(cadr x) 
-                      (cat ,@(cddr x)) 
-                      ,(cat-size (cddr x))))))
-
-;Allows things like (in-theory (disable cat)) to refer to binary-cat.
-(add-macro-alias cat binary-cat)
-
-(defund setbits (x w i j y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp i)
-                              (integerp j)
-                              (<= 0 j)
-                              (<= j i)
-                              (integerp w)
-                              (< i w))))
-  (mbe :logic (cat (bits x (1- w) (1+ i))
-                   (+ -1 w (- i))
-                   (cat (bits y (+ i (- j)) 0)
-                        (+ 1 i (- j))
-                        (bits x (1- j) 0)
-                        j)
-                   (1+ i))
-       :exec  (cond ((int= j 0)
-                     (cond ((int= (1+ i) w)
-                            (bits y (+ i (- j)) 0))
-                           (t
-                            (cat (bits x (1- w) (1+ i))
-                                 (+ -1 w (- i))
-                                 (bits y (+ i (- j)) 0)
-                                 (1+ i)))))
-                    ((int= (1+ i) w)
-                     (cat (bits y (+ i (- j)) 0)
-                          (+ 1 i (- j))
-                          (bits x (1- j) 0)
-                          j))
-                    (t
-                     (cat (bits x (1- w) (1+ i))
-                          (+ -1 w (- i))
-                          (cat (bits y (+ i (- j)) 0)
-                               (+ 1 i (- j))
-                               (bits x (1- j) 0)
-                               j)
-                          (1+ i))))))
-
-;;
-;; New stuff:
-;;
-
-(defund setbitn (x w n y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp n)
-                              (<= 0 n)
-                              (integerp w)
-                              (< n w))))
-  (setbits x w n n y))
-
-(defthm setbitn-nonnegative-integer-type
-  (and (integerp (setbitn x w n y))
-       (<= 0 (setbitn x w n y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than setbits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription setbitn)))
-
-(defthm setbitn-natp
-  (natp (setbitn x w n y)))
-
-;add setbitn-bvecp-simple?
-
-(defthm setbitn-bvecp
-  (implies (and (<= w k)
-                (case-split (integerp k)))
-           (bvecp (setbitn x w n y) k)))
-
-(defthm setbitn-rewrite
-  (implies (syntaxp (quotep n))
-           (equal (setbitn x w n y)
-                  (setbits x w n n y))))
-
-;gen?
-(defthm bitn-setbitn
-  (implies (and (case-split (bvecp y 1))
-                (case-split (< 0 w))
-                (case-split (< n w))
-                (case-split (< k w))
-                (case-split (<= 0 k))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                (<= 0 n)
-                (case-split (integerp k))
-                )
-           (equal (bitn (setbitn x w n y) k)
-                  (if (equal n k)
-                      y
-                    (bitn x k)))))
-
-(defthm setbitn-setbitn
-  (implies (and (case-split (<= 0 n))
-                (case-split (< n w))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                )
-           (equal (setbitn (setbitn x w n y) w n y2)
-                  (setbitn x w n y2))))
-
-(defthm setbitn-does-nothing
-  (implies (and (case-split (<= 0 n))
-                (case-split (< n w))
-                (case-split (integerp w))
-                (case-split (integerp n))
-                )
-           (equal (setbitn x w n (bitn x n))
-                  (bits x (+ -1 w) 0))))
-
diff -Nru acl2-6.2/books/rtl/rel5/user/setbits.lisp acl2-6.3/books/rtl/rel5/user/setbits.lisp
--- acl2-6.2/books/rtl/rel5/user/setbits.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/setbits.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,410 +0,0 @@
-(in-package "ACL2")
-
-(local (include-book "../support/setbits"))
-(local (include-book "../support/guards"))
-
-;; Necessary defuns
-
-(local ; ACL2 primitive
- (defun natp (x)
-   (declare (xargs :guard t))
-   (and (integerp x)
-        (<= 0 x))))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund binary-cat (x m y n)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp m) (< 0 m)
-                              (integerp n) (< 0 n))))
-  (if (and (natp m) (natp n))
-      (+ (* (expt 2 n) (bits x (1- m) 0))
-         (bits y (1- n) 0))
-    0))
-
-(defun formal-+ (x y)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard t))
-  (if (and (acl2-numberp x) (acl2-numberp y))
-      (+ x y)
-    (list '+ x y)))
-
-;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
-;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
-;;not need to specify this in the guard, and leaving it out of that guard
-;;simplifies the guard proof.
-
-(defun cat-size (x)
-  ;;an auxiliary function that does not appear in translate-rtl output.
-  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
-  (if (endp (cddr x))
-      (cadr x)
-    (formal-+ (cadr x)
-	      (cat-size (cddr x)))))
-
-(defmacro cat (&rest x)
-  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
-  (cond ((endp (cddr x))
-         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
-        ((endp (cddddr x))
-         `(binary-cat ,@x))
-        (t
-         `(binary-cat ,(car x) 
-                      ,(cadr x) 
-                      (cat ,@(cddr x)) 
-                      ,(cat-size (cddr x))))))
-
-;Allows things like (in-theory (disable cat)) to refer to binary-cat.
-(add-macro-alias cat binary-cat)
-
-#|
-
-Currently we expect to leave setbits enabled so that it rewrites to cat, but there are some lemmas below which
-might be useful if we choose to keep setbits disabled...
-
-is this comment still valid? :
-;it may happen that setbitn is called with an index which is a signal rather than a constant.
-;in that case, we probably don't want it to expand to setbits. 
-;thus, we always expect the indices in setbits calls to be constants
-
-
-;Set bits I down to J of the W-bit value X to Y.
-
-(setbits x w i j y) is only well-defined when the following predicate is true:
-
-(and (natp w)
-     (bvecp x w)
-     (integerp i)
-     (integerp j)
-     (<= 0 j)
-     (<= j i)
-     (< i w)
-     (bvecp y (+ 1 i (- j))))
-
-|#
-
-;; New stuff:
-
-;Note: when j is 0, there is no lower part of x, but we have cat-with-n-0 to handle this case. 
-(defund setbits (x w i j y)
-  (declare (xargs :guard (and (natp x)
-                              (natp y)
-                              (integerp i)
-                              (integerp j)
-                              (<= 0 j)
-                              (<= j i)
-                              (integerp w)
-                              (< i w))))
-  (mbe :logic (cat (bits x (1- w) (1+ i))
-                   (+ -1 w (- i))
-                   (cat (bits y (+ i (- j)) 0)
-                        (+ 1 i (- j))
-                        (bits x (1- j) 0)
-                        j)
-                   (1+ i))
-       :exec  (cond ((int= j 0)
-                     (cond ((int= (1+ i) w)
-                            (bits y (+ i (- j)) 0))
-                           (t
-                            (cat (bits x (1- w) (1+ i))
-                                 (+ -1 w (- i))
-                                 (bits y (+ i (- j)) 0)
-                                 (1+ i)))))
-                    ((int= (1+ i) w)
-                     (cat (bits y (+ i (- j)) 0)
-                          (+ 1 i (- j))
-                          (bits x (1- j) 0)
-                          j))
-                    (t
-                     (cat (bits x (1- w) (1+ i))
-                          (+ -1 w (- i))
-                          (cat (bits y (+ i (- j)) 0)
-                               (+ 1 i (- j))
-                               (bits x (1- j) 0)
-                               j)
-                          (1+ i))))))
-
-(defthm setbits-nonnegative-integer-type
-  (and (integerp (setbits x w i j y))
-       (<= 0 (setbits x w i j y)))
-  :rule-classes (:type-prescription))
-
-;this rule is no better than setbits-nonnegative-integer-type and might be worse:
-(in-theory (disable (:type-prescription setbits)))
-
-(defthm setbits-natp
-  (natp (setbits x w i j y)))
-
-;BOZO r-c?
-;tighten?
-(defthm setbits-upper-bound
-  (< (setbits x w i j y) (expt 2 w)))
-
-(defthm setbits-bvecp-simple
-  (bvecp (setbits x w i j y) w))
-
-(defthm setbits-bvecp
-  (implies (and (<= w k) ;gen?
-                (case-split (integerp k))
-                )
-           (bvecp (setbits x w i j y) k)))
-
-(defthm setbits-does-nothing
-  (implies (and (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (<= 0 j))
-                )
-           (equal (setbits x w i j (bits x i j))
-                  (bits x (+ -1 w) 0))))
-
-;taking bits from the lower third
-(defthm bits-setbits-1
-  (implies (and (< k j)
-                (case-split (<= 0 w))
-                (case-split (< i w))
-                (case-split (<= 0 l))
-                (case-split (<= j i)) ;drop?
-                (case-split (integerp w))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits x k l)))
-  :hints (("Goal" :in-theory (enable setbits))))
-
-;taking bits from the middle third
-;gen?
-(defthm bits-setbits-2
-  (implies (and (<= k i)
-                (<= j l)
-                (case-split (integerp i))
-                (case-split (<= 0 j))
-                (case-split (integerp j))
-                (case-split (acl2-numberp k));		  (case-split (integerp k))
-                (case-split (acl2-numberp l)) ;	  (case-split (integerp l))
-                (case-split (integerp w))
-                (case-split (<= 0 w))
-                (case-split (< i w))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits y (- k j) (- l j))))
-  :hints (("Goal" :in-theory (enable setbits natp))))
-
-;taking bits from the upper third
-(defthm bits-setbits-3
-  (implies (and (< i l)
-                (case-split (< i w))
-                (case-split (< k w)) ;handle this?
-                (case-split (<= j i))
-                (case-split (<= 0 l))
-                (case-split (<= 0 j))
-                (case-split (<= 0 w))
-                (case-split (integerp l))
-                (case-split (integerp w))
-                (case-split (integerp i))
-                (case-split (integerp j))
-                (case-split (integerp k))
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (bits x k l)))
-  :hints (("Goal" :in-theory (enable setbits natp))))
-
-(defthm setbits-with-w-0
-  (equal (setbits x 0 i j y)
-         0))
-
-;add case-splits to the bitn-setbits rules?
-;why can't i prove this from bits-setbits?
-(defthm bitn-setbits-1
-  (implies (and (< k j) ;case 1
-                (< i w)
-                (<= 0 i)
-                (<= 0 j) 
-                (<= 0 k)
-                (<= j i)
-                (integerp k)
-                (integerp w)
-                (integerp i)
-                (integerp j)
-                )
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn x k))))
-
-(defthm bitn-setbits-2
-  (implies (and(<= k i) ;;case-2
-               (<= j k) ;;case-2
-               (<= 0 i)
-               (<= 0 j) 
-               (< i w)
-               (integerp k)
-               (integerp w)
-               (integerp i)
-               (integerp j)
-               )
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn y (- k j)))))
-
-(defthm bitn-setbits-3
-  (implies (and (< i k) ;;case-3
-                (< k w) ;;case-3
-;                (< i w)
-                (<= 0 i)
-                (<= 0 j) 
-                (<= j i)
-                (integerp i)
-                (integerp j)
-                (integerp k)
-                (integerp w))
-           (equal (bitn (setbits x w i j y) k)
-                  (bitn x k))))
-
-;taking a slice of each of the lower two thirds.
-(defthm bits-setbits-4
-  (implies (and (<= k i) ;;case-4
-                (<= j k) ;;case-4
-                (< l j) ;;case-4
-                (< i w)
-                (<= 0 j)
-                (<= 0 l)
-                (integerp i)
-                (integerp j)
-                (integerp w) 
-                (acl2-numberp l) ;(integerp l)
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (cat (bits y (- k j) 0)
-                       (+ 1 k (- j))
-                       (bits x (1- j) l)
-                       (- j l))))
-  :hints (("Goal" :in-theory (enable setbits))))
-
-;taking a slice of each of the upper two thirds.
-(defthm bits-setbits-5
-    (implies (and (< i k)  ;case-5
-		  (<= l i) ;case-5
-		  (<= j l) ;case-5
-                  (< k w)  ;case-5 ;BOZO drop stuff like this?
-                  (<= 0 j)
-                  (integerp i)
-                  (integerp j)
-                  (integerp w)
-                  (acl2-numberp l) ;(integerp l)
-                  )
-	     (equal (bits (setbits x w i j y) k l)
-		    (cat (bits x k (1+ i))
-                         (+ k (- i))
-			 (bits y (- i j) (- l j))
-			 (1+ (- i l))))))
-
-;taking a slice of each of the thirds.
-;make one huge bits-setbits lemma?
-(defthm bits-setbits-6
-  (implies (and (< i k) ;;case-6
-                (< l j) ;;case-6
-                (<= j i)
-                (< k w)
-                (<= 0 l)
-                (integerp i)
-                (integerp j)
-                (acl2-numberp l) ; (integerp l)
-                (integerp w)
-                )
-           (equal (bits (setbits x w i j y) k l)
-                  (cat (bits x k (1+ i))
-                       (+ k (- i))
-                       (cat (bits y (+ i (- j)) 0)
-                            (1+ (- i j))
-                            (bits x (1- j) l)
-                            (- j l))
-                       (+ 1 i (- l))))))
-
-;prove that if (not (natp w)) setbits = 0 .
-
-;combining these adjacent ranges [i..j][k..l]
-(defthm setbits-combine
-  (implies (and (equal j (+ k 1))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l))
-                )
-  (equal (setbits (setbits x w k l y1) w i j y2)
-         (setbits x w i l (cat y2
-                                (+ 1 i (- j))
-                                y1
-                                (+ 1 k (- l))
-                                )))))
-
-(defthm setbits-combine-2
-  (implies (and (equal j (+ k 1))
-                (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l))
-                )
-  (equal (setbits (setbits x w i j y2) w k l y1)
-         (setbits x w i l (cat y2
-                                (+ 1 i (- j))
-                                y1
-                                (+ 1 k (- l))
-                                )))))
-
-(defthm setbits-combine-3
-  (implies (and (equal j (+ k 1))
-                (case-split (< i w))
-                (case-split (<= j i))
-                (case-split (<= l k))
-                (case-split (natp w))
-                (case-split (natp i))
-                (case-split (natp j))
-                (case-split (natp k))
-                (case-split (natp l)))
-           (equal (setbits (setbits x w i j y2) w k l y1)
-                  (setbits x w i l
-                           (cat y2 (+ 1 i (- j))
-                                 y1 (+ 1 k (- l)))))))
-
-
-(defthm setbits-all
-  (implies (and (equal i (+ -1 w))
-                (case-split (bvecp y w))
-                )
-  (equal (setbits x w i 0 y)
-         y)))
-
diff -Nru acl2-6.2/books/rtl/rel5/user/stick.lisp acl2-6.3/books/rtl/rel5/user/stick.lisp
--- acl2-6.2/books/rtl/rel5/user/stick.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/stick.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,61 +0,0 @@
-(in-package "ACL2")
-
-(include-book "land")
-(include-book "lior")
-(include-book "lxor")
-(include-book "lnot") ;BOZO 
-
-(local (include-book "../support/stick"))
-
-(set-inhibit-warnings "theory") ; avoid warning in the next event
-(local (in-theory nil))
-
-(defthm top-thm-1-original
-  (implies (and (natp n)
-                (natp k)
-                (< k n)
-                (integerp a) ;(bvecp a n)
-                (integerp b) ;(bvecp b n)
-                )
-           (equal (equal (bits (+ a b 1) k 0)
-                         0)
-		  (equal (bits (lnot (lxor0 a b n) n) k 0)
-                         0)))
-  :rule-classes ())
-
-(defund sigm-0 (a b c n)
-  (if (= c 0)
-      (lnot (lxor0 a b n) n)
-    (lxor0 a b n)))
-
-(defund kap-0 (a b c n)
-  (if (= c 0)
-      (* 2 (lior0 a b n))
-    (* 2 (land0 a b n))))
-
-(defund tau-0 (a b c n)
-  (lnot (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (1+ n)) (1+ n)))
-
-(defthm bvecp-sigm-0
-  (bvecp (sigm-0 a b c n) n)
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm-0 a b c n)))))
-
-(defthm bvecp-kap-0
-  (implies (and (integerp n) (<= 0 n))
-           (bvecp (kap-0 a b c n) (1+ n)))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap-0 a b c n)))))
-
-(defthm bvecp-tau-0
-  (bvecp (tau-0 a b c n) (1+ n))
-  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau-0 a b c n)))))
-
-(defthm top-thm-2-old
-  (implies (and (natp n)
-                (integerp a) ;(bvecp a n)
-                (integerp b) ;(bvecp b n)
-                (natp k)
-                (< k n)
-                (or (equal c 0) (equal c 1)))
-           (equal (equal (bits (+ a b c) k 0) 0)
-		  (equal (bits (tau-0 a b c n) k 0) 0)))
-  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel5/user/sumbits.lisp acl2-6.3/books/rtl/rel5/user/sumbits.lisp
--- acl2-6.2/books/rtl/rel5/user/sumbits.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/sumbits.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,95 +0,0 @@
-; This book can provide help for reducing equality of bit vectors to equality
-; of respective bits.  It provides the "badguy" trick.  For an example, see the
-; proof of lior0-cat in ../support/merge2.lisp.
-
-(in-package "ACL2")
-
-(local (include-book "../support/sumbits"))
-(local (include-book "../support/guards"))
-
-; We need some definitions to be present.  We define them using defun rather
-; than defund because we don't want inclusion of this book to affect whether or
-; not these functions are disabled, if they were already defined.
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defund bits (x i j)
-  (declare (xargs :guard (and (natp x)
-                              (natp i)
-                              (natp j))))
-  (mbe :logic (if (or (not (integerp i))
-                      (not (integerp j)))
-                  0
-                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
-       :exec  (if (< i j)
-                  0
-                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
-
-(defund bitn (x n)
-  (declare (xargs :guard (and (natp x)
-                              (natp n))))
-  (mbe :logic (bits x n n)
-       :exec  (if (evenp (ash x (- n))) 0 1)))
-
-(defund bvecp (x k)
-  (declare (xargs :guard (integerp k)))
-  (and (integerp x)
-       (<= 0 x)
-       (< x (expt 2 k))))
-
-(local (in-theory (disable fl bits bitn bvecp)))
-
-;; New stuff
-
-(defun sumbits (x n)
-  (if (zp n)
-      0
-    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
-       (sumbits x (1- n)))))
-
-(defthmd sumbits-bits
-  (implies (and (natp x)
-                (natp n)
-                (> n 0))
-           (equal (sumbits x n)
-                  (bits x (1- n) 0)))
-  :hints (("Goal" :in-theory (enable bits-n-n-rewrite) ;yuck?
-           :induct (sumbits x n))
-          ("Subgoal *1/2" :use ((:instance bitn-plus-bits (n (1- n)) (m 0))))))
-
-(defthmd sumbits-thm
-     (implies (and (bvecp x n)
-                   (natp n)
-                   (> n 0))
-              (equal (sumbits x n)
-                     x))
-   :hints (("Goal" :in-theory (enable sumbits-bits bvecp))))
-
-(defun sumbits-badguy (x y k)
-  (if (zp k)
-      0 ; arbitrary
-    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
-        (1- k)
-      (sumbits-badguy x y (1- k)))))
-
-(defthmd sumbits-badguy-is-correct
-  (implies (and (bvecp x k)
-                (bvecp y k)
-                (equal (bitn x (sumbits-badguy x y k))
-                       (bitn y (sumbits-badguy x y k)))
-                (integerp k)
-                (< 0 k))
-           (equal (equal x y) t))
-  :hints (("Goal"
-           :use sumbits-badguy-is-correct-lemma
-           :in-theory (enable sumbits-thm))))
-
-(defthmd sumbits-badguy-bounds
-  (implies (and (integerp k)
-                (< 0 k))
-           (let ((badguy (sumbits-badguy x y k)))
-             (and (integerp badguy)
-                  (<= 0 badguy)
-                  (< badguy k)))))
diff -Nru acl2-6.2/books/rtl/rel5/user/top.lisp acl2-6.3/books/rtl/rel5/user/top.lisp
--- acl2-6.2/books/rtl/rel5/user/top.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/top.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,86 +0,0 @@
-;;;***************************************************************
-;;;An ACL2 Library of Floating Point Arithmetic
-
-;;;David M. Russinoff
-;;;Advanced Micro Devices, Inc.
-;;;June, 2001
-;;;***************************************************************
-
-;This book is a modified version of support/top.  BOZO clean this up.
-
-(in-package "ACL2")
-
-(include-book "bits")
-(include-book "bitn")
-(include-book "cat")
-(include-book "bvecp")
-;(include-book "ash")
-;(include-book "decode")
-;(include-book "encode")
-(include-book "mulcat")
-;(include-book "shft")
-;(include-book "all-ones")
-;(include-book "merge")  ;a mix of lemmas.  eric is sorting these out into appropriate books
-                        ;but some lemmas really do mix several functions
-(include-book "logior1")
-(include-book "setbits")
-(include-book "setbitn")
-
-;(include-book "float") ;theorems about floating point numbers (factorization into sgn, sig, and expo;
-;exactness)
-;Eric might want to sort these out into books call sig.lisp, exactp,list, etc.
-
-;floating-point representations:
-(include-book "bias")
-(include-book "ereps")
-;(include-book "ireps")
-
-;built-in logical operators:
-;(include-book "logeqv")
-;(include-book "logorc1")
-;(include-book "lognot")
-;(include-book "logand")
-;(include-book "logior")
-;(include-book "logxor")
-
-;(include-book "log") ;theorems mixing logical operators with bits and bitn, etc.  some junk in here to sort
-  ;out?
-  ;figure out the difference between this and merge?
-
-;new logical operators:
-(include-book "lnot")
-(include-book "land")
-(include-book "lior")
-(include-book "lxor")
-(include-book "lextra")
-
-;(include-book "logs") ;other "logical" operators
-
-;floating-point rounding:
-(include-book "trunc")
-(include-book "away")
-(include-book "near")
-;(include-book "near+")
-;(include-book "oddr")
-;(include-book "sticky")
-;(include-book "rnd")
-;(include-book "drnd")
-
-(include-book "bits-trunc") ;theorems about how we implement trunc rounding...
-
-;theorems about circuits for addition
-;(include-book "add3") ;theorems about how we implement addition of (2 or) 3 bit vectors
-;(include-book "lop1") ;leading-one prediction
-;(include-book "lop2") ;leading-one prediction
-;(include-book "lop3") ;leading-one prediction
-(include-book "stick") ;sticky-bit computation?
-
-(include-book "sumbits") ;help for reducing equality of bit vectors to equality
-                         ;of respective bits
-
-;helpers
-;(include-book "bvecp-helpers")
-;(include-book "model-helpers") ; do we use this?
-;(include-book "rom-helpers")
-;(include-book "simple-loop-helpers")
-;BOZO consider moving lib/simplify-model-helpers to support/ of (better yet), move all the helpers books to lib/
diff -Nru acl2-6.2/books/rtl/rel5/user/trunc.lisp acl2-6.3/books/rtl/rel5/user/trunc.lisp
--- acl2-6.2/books/rtl/rel5/user/trunc.lisp	2013-06-06 17:11:53.000000000 +0000
+++ acl2-6.3/books/rtl/rel5/user/trunc.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,411 +0,0 @@
-;;;***************************************************************
-;;;an acl2 library of floating point arithmetic
-
-;;;david m. russinoff
-;;;advanced micro devices, inc.
-;;;february, 1998
-;;;***************************************************************
-
-;some of the things in this book are cruft which can be deleted...
-
-(in-package "ACL2")
-(local (include-book "../support/trunc"))
-
-
-;;Necessary defuns
-
-
-(defund fl (x)
-  (declare (xargs :guard (real/rationalp x)))
-  (floor x 1))
-
-(defun expo-measure (x)
-;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
-  (cond ((not (rationalp x)) 0)
-	((< x 0) '(2 . 0))
-	((< x 1) (cons 1 (fl (/ x))))
-	(t (fl x))))
-
-(defund expo (x)
-  (declare (xargs :guard t
-                  :measure (expo-measure x)))
-  (cond ((or (not (rationalp x)) (equal x 0)) 0)
-	((< x 0) (expo (- x)))
-	((< x 1) (1- (expo (* 2 x))))
-	((< x 2) 0)
-	(t (1+ (expo (/ x 2))))))
-
-;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
-(defund sig (x)
-  (declare (xargs :guard t))
-  (if (rationalp x)
-      (if (< x 0)
-          (- (* x (expt 2 (- (expo x)))))
-        (* x (expt 2 (- (expo x)))))
-    0))
-
-;make defund?
-(defun sgn (x)
-  (declare (xargs :guard t))
-  (if (or (not (rationalp x)) (equal x 0))
-      0
-    (if (< x 0)
-        -1
-      1)))
-
-(defund exactp (x n)
-;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
-  (integerp (* (sig x) (expt 2 (1- n)))))
-
-
-(defund trunc (x n)
-  (declare (xargs :guard (integerp n)))
-  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
-
-;; New stuff:
-
-;generated automatically by ACL2 when we define trunc, but included here just to be safe could have disabled
-;(:type-prescription trunc) for slight efficiency gain at the cost of making the output of :pe a little
-;deceptive
-(defthm trunc-rational-type-prescription
-  (rationalp (trunc x n))
-  :rule-classes :type-prescription)
-
-(defthm trunc-of-non-rationalp-is-0
-  (implies (not (rationalp x))
-           (equal (trunc x n)
-                  0)))
-
-(defthm trunc-to-0-or-fewer-bits
-  (implies (and (<= n 0)
-                (integerp n)
-                )
-           (equal (trunc x n)
-                  0)))
-
-;make alt version? use negative-syntaxp?
-(defthm trunc-minus
-  (equal (trunc (* -1 x) n)
-         (* -1 (trunc x n))))
-
-;change what trunc does with n not a positive int?
-(defthm trunc-positive
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (< 0 (trunc x n)))
-  :rule-classes (:rewrite :linear))
-
-;I think this rule has caused the "bad-ass" problem regarding the (case-split (< 0 n)) hyp.
-;BOZO should this include rationalp, to have a more type-like conclusion?
-(defthm trunc-positive-rational-type-prescription
-  (implies (and (< 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n)))
-           (< 0 (trunc x n)))
-  :rule-classes :type-prescription)
-
-(defthm trunc-negative
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n)))
-           (< (trunc x n) 0))
-  :rule-classes (:rewrite :linear))
-
-;BOZO should this include rationalp, to have a more type-like conclusion?
-(defthm trunc-negative-rational-type-prescription
-  (implies (and (< x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                (case-split (< 0 n))
-                )
-           (< (trunc x n) 0))
-  :rule-classes :type-prescription)
-
-(defthm trunc-0 
-  (equal (trunc 0 n) 
-         0))
-
-;trying the case-split
-(defthm trunc-of-non-rationalp-is-0-alt
-  (implies (case-split (not (rationalp x)))
-           (equal (trunc x n)
-                  0)))
-
-(defthm trunc-non-negative-rational-type-prescription
-  (implies (and (<= 0 x)
-                (case-split (integerp n))
-                )
-           (and (<= 0 (trunc x n))
-                (rationalp (trunc x n))))
-  :rule-classes :type-prescription)
-
-(defthm trunc-non-positive-rational-type-prescription
-  (implies (and (<= x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (and (<= (trunc x n) 0)
-                (rationalp (trunc x n))))
-  :rule-classes :type-prescription)
-
-;make an away version?
-(defthm trunc-non-negative-linear
-  (implies (and (<= 0 x)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (<= 0 (trunc x n)))
-  :rule-classes :linear)
-
-;make an away version?
-(defthm trunc-non-positive-linear
-  (implies (and (<= x 0)
-                (case-split (rationalp x))
-                (case-split (integerp n))
-                )
-           (<= (trunc x n) 0))
-  :rule-classes :linear)
-
-(defthm sgn-trunc
-  (implies (and (< 0 n)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (sgn (trunc x n))
-                  (sgn x))))
-
-
-;why not just open up trunc and sgn?
-;keep this disabled, since it basically opens up TRUNC
-(defthmd abs-trunc
-  (equal (abs (trunc x n))
-         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
-
-(defthm trunc-upper-bound
-  (implies (and (rationalp x)
-                (integerp n))
-           (<= (abs (trunc x n)) (abs x)))
-  :rule-classes :linear)
-
-;BOZO bad name. should be trunc-equal-0
-(defthm trunc-equal-0-rewrite
-  (implies (and (> n 0)
-                (rationalp x)
-                (integerp n)
-                )
-           (equal (equal (trunc x n) 0)
-                  (equal x 0))))
-
-(defthm trunc-upper-pos
-    (implies (and (<= 0 x)
-                  (rationalp x)
-		  (integerp n))
-	     (<= (trunc x n) x))
-    :rule-classes :linear)
-
-(defthm expo-trunc
-   (implies (and (< 0 n)
-                 (rationalp x)
-                 (integerp n)
-                 )
-            (equal (expo (trunc x n))
-                   (expo x))))
-
-;which of these do we want to export?
-(defthm trunc-lower-1
-  (implies (and (rationalp x)
-                (integerp n))
-           (> (abs (trunc x n))
-              (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
-  :rule-classes :linear)
-
-(defthm trunc-lower-2-1
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expt 2 (- (1+ (expo x)) n)) (* (abs x) (expt 2 (- 1 n)))))
-  :rule-classes ())
-
-(defthm trunc-lower-2
-    (implies (and (rationalp x)
-		  (not (= x 0))
-		  (integerp n)
-		  (> n 0))
-	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-lower-pos
-    (implies (and (rationalp x)
-		  (> x 0)
-		  (integerp n)
-		  (> n 0))
-	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-lower-3
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-lower-4
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (>= (trunc x n) (- x (* (abs x) (expt 2 (- 1 n))))))
-  :rule-classes :linear)
-
-(defthm trunc-diff
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0))
-	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes ())
-
-(defthm trunc-diff-pos
-    (implies (and (rationalp x)
-		  (>= x 0)
-		  (integerp n)
-		  (> n 0))
-	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
-  :rule-classes ())
-
-(defthm trunc-diff-expo-1
-    (implies (and (rationalp x)
-		  (not (= x (trunc x n)))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
-  :rule-classes ())
-
-;just gets rid of sig...
-(defthmd trunc-rewrite
-    (implies (and (rationalp x)
-		  (integerp n)
-		  (> n 0) ;gen?  this isn't in pos-rewrite!
-                  )
-	     (equal (trunc x n)
-		    (* (sgn x) 
-		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
-		       (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm trunc-exactp-a
-  (implies (and (rationalp x)
-                (integerp n) 
-                (> n 0))
-           (iff (= x (trunc x n))
-                (exactp x n)))
-  :rule-classes ())
-
-(defthm trunc-diff-expo
-    (implies (and (rationalp x)
-		  (not (exactp x n))
-		  (integerp n)
-		  (> n 0))
-	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
-  :rule-classes ())
-
-;improve by concluding (exactp (trunc x n) m+) if m+ >= m ??
-(defthm trunc-exactp-b
-  (exactp (trunc x n) n))
-
-(defthmd trunc-exactp-c
-  (implies (and (exactp a n)
-                (<= a x)
-                (rationalp x)
-                (integerp n)
-                (rationalp a)
-                )
-           (<= a (trunc x n))))
-
-;bad :linear rule; has a free var
-;disable, or not?
-(defthmd trunc-monotone
-  (implies (and (<= x y)
-                (rationalp x)
-                (rationalp y)
-                (integerp n)
-                )
-           (<= (trunc x n) (trunc y n)))
-  :rule-classes :linear)
-
-(defthmd trunc-pos-rewrite
-  (implies (and (>= x 0)
-                (rationalp x)
-                (integerp n))
-           (equal (trunc x n)
-                  (* (fl (* (expt 2 (- (1- n) (expo x))) x))
-                     (expt 2 (- (1+ (expo x)) n))))))
-
-(defthm trunc-trunc
-  (implies (and (>= n m) ;what about other case?
-                (integerp n)
-                (integerp m)
-                )
-           (equal (trunc (trunc x n) m)
-                  (trunc x m))))
-
-(defthm plus-trunc
-  (implies (and (rationalp x)
-                (>= x 0)
-                (rationalp y)
-                (>= y 0)
-                (integerp k)
-                (exactp x (+ k (- (expo x) (expo y)))))
-           (= (+ x (trunc y k))
-              (trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
-  :rule-classes ())
-
-(defthm trunc-plus
-    (implies (and (rationalp y)
-		  (> y 0)
-		  (integerp e)
-		  (< y (expt 2 e))
-		  (integerp m)
-		  (> m 0)
-		  (integerp k)
-		  (> k 0)
-		  (<= m (1+ k)))
-	     (= (trunc (+ (expt 2 e) (trunc y k)) m)
-		(trunc (+ (expt 2 e) y) m)))
-  :rule-classes ())
-
-;what's the purpose of this one?
-(defthm trunc-n+k
-  (implies (and (rationalp x)
-                (> x 0)
-                (integerp k)
-                (> k 0)
-                (integerp n)
-                (>= n k)
-                (not (exactp x n)) ;;this isn't really needed, but it won't hurt me.
-                (= e (- (1+ (expo x)) n))
-                (= z (trunc (- x (trunc x n)) n))
-;		  (= y (- x (trunc x n))) ;removed
-                )
-           (= (- (trunc x (+ n k)) (trunc x n))
-              (* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
-                 (expt 2 e))))
-  :rule-classes ())
-
- (defthm trunc-shift
-   (implies (integerp n)
-            (equal (trunc (* x (expt 2 k)) n)
-                   (* (trunc x n) (expt 2 k)))))
-
-;bad t-p rule? make rewrite too?
-(defthm trunc-integer-type-prescription
-  (implies (and (>= (expo x) n)
-                (case-split (integerp n))
-                )
-           (integerp (trunc x n)))
-  :rule-classes :type-prescription)
-
-;prove a them about trunc of a power of 2?
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/Makefile acl2-6.3/books/rtl/rel9/Makefile
--- acl2-6.2/books/rtl/rel9/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/Makefile	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,3 @@
+DIRS = arithmetic support lib
+
+include ../../Makefile-subdirs
diff -Nru acl2-6.2/books/rtl/rel9/README acl2-6.3/books/rtl/rel9/README
--- acl2-6.2/books/rtl/rel9/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/README	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,318 @@
+This directory contains an ACL2 library of register-transfer logic, developed
+at AMD from 1995 to the present in support of the mechanical verification of 
+various components of the AMD microprocessors that were designed during that 
+period, especially their floating-point arithmetic units.
+
+This library is a work in progress.  Its primary author is David Russinoff.
+Matt Kaufmann and Eric Smith have made significant contributions.  Development
+continues by Russinoff and assisted by Hanbing Liu.
+
+The library's core definitions and lemmas are contained in the subdirectory
+"lib/".  A parallel subdirectory, "support/", contains a superset of these
+events, including all sublemmas that were required for the proofs of the
+library lemmas.  The "support/" directory is organized in such a way to allow
+for the evolution of "lib/".  Read the following section "How to add new
+theorems to lib/" and "support/README" to learn how to "evolve" the "lib/" and
+"support/" directories.  Users should consider that "lib/" is the RTL library,
+and are discouraged from accessing "support/" directly.
+
+A more powerful (but perhaps more risky) arithmetic library is available in the
+directory "arithmetic/".  To use this library, we recommend including the book
+"arithmetic/top".
+
+Previous releases (before rel8) of this library contain another subdirectory,
+"user/".  "user/" contains many good rules which we haven't included in "lib/"
+because we wanted to keep "lib/" uncluttered.  We have not update and maintain
+it. We do not include it in this release. 
+
+
+See the comments in lib/top.lisp for information on what each book in lib/
+contains. 
+
+The library files contain virtually no documentation.  A detailed companion
+document is available online.
+
+    D.M. Russinoff, A formal theory of register-transfer logic and computer
+    arithmetic, 2006.  
+
+    http://www.russinoff.com/libman/
+
+Many of the interesting events are formal versions of definitions and lemmas
+that are stated and proved in the earlier sections of the following papers,
+which document various applications of the library:
+
+  D.M. Russinoff, A mechanically checked proof of correctness of the AMD-K5
+  floating point square root microcode, Formal Methods in System Design 14, 
+  75-125 (1999).  See
+  http://www.onr.com/user/russ/david/fsqrt.html.
+
+  D.M. Russinoff, A mechanically checked proof of IEEE compliance of the AMD-K7
+  floating point multiplication, division, and square root instructions,
+  London Mathematical Society Journal of Computation and Mathematics (1), 
+  pp. 148-200, December, 1998.  See
+  http://www.russinoff.com/david/k7-div-sqrt.html.
+
+  D.M. Russinoff, A case study in formal verification of register-transfer 
+  logic with ACL2: the floating point adder of the AMD Athlon processor,
+  invited paper, FMCAD 2000.  See
+  http://www.russinoff.com/david/fadd.html.
+
+For a discussion of our pipeline verification methodology:
+
+  M. Kaufmann and D. M. Russinoff, Verification of Pipeline circuits.  See
+  http://www.russinoff.com/david/pipeline.html.
+
+=========================================================================
+
+How to add new theorems to lib/:
+
+Suppose you want to make changes to books in "lib/"
+
+We first make changes to the books in "lib/".  We then need to update the
+"support/" directory to make "lib/" recertifiable again.  We also want to
+maintain the "invariants" on the "support/" directory (see support/README).
+
+The ground rules are
+
+   (1) Avoid changing any of the existing files in "support/"
+
+   (2) Create new directories and new books as necessary.
+
+   (3) Make creative use of local include-book of the existing
+       books to do new proofs.
+
+   (4) But keep the dependencies between books simple
+
+
+Unless the updates to the lib books are really really trivial (adding
+documentation), we recommend the following approach.
+
+If the updates are simple (say, we only add or remove exported events):
+
+   We create a new directory of "lib<n>.delta<m+1>", where n and m is the
+   largest index of libN.deltaM style directories in support/.
+
+   Suppose the float.lisp in the lib/ is being updated.  We first create a new
+   book, say, float-extra.lisp in lib<n>.delta<m+1>/" directory. The
+   float-extra.lisp will start with a '(include-book "../lib<n>/top")'.  We
+   then do our proofs in the theory of "../libn/top".
+
+   We update support/top.lisp in such a way that the resulting support/top.lisp
+   contains the exact the same list of events as the "lib/top.lisp".  To
+   maintain this invariant, we often need to include a copy updated
+   "float.lisp" in "support/lib<n>.delta<m+1>/", that incorporates the new
+   results from float-extra.lisp.
+
+
+If the updates are difficult (say, either the new lib/ redefines more than a
+few functions and theorems, or we have already accumulated a large number of
+deltas to current support/lib<n>/):
+
+   In these cases, the list of events from "lib/top.lisp" is quite different
+   from those of "suppport/lib<n>/top.lisp".
+
+   We create a support/lib<n+1> directory, where the n is largest of existing
+   lib<n> style directories.  We copy lib/* into support/lib<n+1>/.  We copy
+   "support/top.lisp" to support/lib<n+1>/base.lisp. We update include-book
+   forms in those books as necessary.
+
+   We create a support/lib<n+1>.delta1, and do all our proofs in this directory
+   and these proofs may be done in a theory of "support/lib<n+1>/top".
+
+   We update support/top.lisp as necessary.
+
+
+To see what we mean by "creative use of local include-book", we give the
+following example:
+
+Suppose we need to update lib/round.lisp by strengthening a theorem foo. 
+
+Suppose in "support/" that we have "lib1" through "lib8", and "lib8.delta1"
+through "lib8.delta3".
+
+If none of the lib8.delta<n> contains an updated round.lisp, we can
+ 
+   Create a directory lib8.delta4/ 
+
+   Create the following books.
+
+    ============================================================
+    ; book lib8.delta4/foo-new.lisp
+
+    ; Here, prove stronger version of foo; but call it foo-new.
+    ; We may find that the original version of foo is useful, 
+    ; We can do something like. 
+
+     (local 
+      (encapsulate () 
+         (local (include-book "../lib8/round"))
+         (defthm foo
+                 ....)))   ; extract the original foo theorem. 
+ 
+     (defthm foo-new 
+             ...
+             )
+
+    ============================================================
+    ; book lib8.delta4/round-partial.lisp
+
+    (local (include-book "../lib8/round"))
+    (local (include-book "foo-new"))
+    <Insert all of round.lisp, except delete foo.>
+
+    ============================================================
+    ; book lib8.delta4/round.lisp
+
+    (local (include-book "round-partial"))
+    (local (include-book "foo-new"))
+    <Insert ../lib8/round.lisp, but replace the original foo with foo-new
+     proved in foo-new.lisp, where however we rename foo-new to foo and
+     give the hint :by foo-new.>
+
+    ============================================================
+    ; book top.lisp 
+     change 
+        (include-book "lib8/round.lisp")
+     into 
+        (include-book "lib8.delta4/round")
+
+
+If one of the lib8.delta1-3 contains an updated round.lisp already, and we feel
+that changing foo into the new version may affect other existing lemma, we can
+chose to take a "snapshot" of current lib by creating a "lib9" and make
+modification in the "lib9.delta1" instead.
+
+   Create a directory lib9/  
+
+        1) copy current ../lib/* into lib9/
+        2) copy top.lisp into lib9/base.lisp 
+        3) update lib9/* to adjust the pathname in include-book forms. 
+         
+   
+   Create a directory lib9.delta1/  
+  
+    ============================================================
+    ; book lib9.delta1/foo-new.lisp
+
+    ; Here, prove stronger version of foo; but call it foo-new.
+    ; We may find that the original version of foo is useful, 
+    ; We can do something like. 
+
+     (local 
+      (encapsulate () 
+         (local (include-book "../lib9/round"))
+         (defthm foo
+                 ....)))   ; extract the original foo theorem. 
+ 
+     (defthm foo-new 
+             ...
+             )
+
+
+    ============================================================
+    ; book lib9/round-partial.lisp
+
+    (local (include-book "../lib9/round"))
+    (local (include-book "foo-new"))
+    <Insert all of round.lisp, except delete foo.>
+
+    ============================================================
+    ; book lib9.delta1/round.lisp
+
+    (local (include-book "round-partial"))
+    (local (include-book "foo-new"))
+    <Insert ../lib8/round.lisp, but replace the original foo with foo-new
+     proved in foo-new.lisp, where however we rename foo-new to foo and
+     give the hint :by foo-new.>
+
+    ============================================================
+    ; book top.lisp 
+
+     change 
+        (include-book "lib9/round")
+     into 
+        (include-book "lib9.delta1/round")
+
+
+=========================================================================
+
+Beginning of Eric's notes for users of the library [This is still a work in
+progress]:
+
+Personally, I wouldn't include lib/top since it includes lib/arith (which
+contains the old arithmetic rules) and also includes other books you probably
+don't need (e.g., fadd lemmas, maybe brat).  (But maybe including lib/top is
+okay, since I expect the arithmetic rules to at least be somewhat compatible
+with mine.  [At least, lib/arith and arithmetic/top can both be included in one
+session.] But maybe you don't want both, because I may have essentially the
+same rule under a better name, and the duplication may slow down the rewriter
+and be a pain if you have to disable a rule -- since you'd have to disable both
+mine and the one in lib/arith.)
+
+Of the lib/ books, including your certified model.lisp should include
+lib/rtl
+lib/rtl-arr
+lib/util
+lib/clocks2
+lib/package-defs
+
+To start doing proofs, I'd include:
+
+lib/bits - which itself includes lib/rtl
+lib/round - since you'll be reasoning about rounding
+lib/reps - you will be reasoning about floating-point representations, right?
+
+You'll probably also want lib/basic and lib/float, at least until I can come up
+with a replacement for these books.  But note that arithmetic/ contains many
+more lemmas about the functions mentioned in basic, especially mod, fl, and
+expt.
+
+You probably don't need lib/fadd.  
+
+You'll also need an arithmetic book (or books).  The safest course would be to
+include lib/arith.  However, I have lots of arithmetic books that you might
+want to use instead.  (I think my books and lib/arith are compatible [check
+this?], so it's probably safe to include both.)  Actually, many of the rules in
+lib/arith exist in arithmetic/ too.
+
+The books in arithmetic/ are far from finished, but there is a lot of good
+stuff in there.  There may be looping rules, but there are also powerful rules
+which can save you a lot of hassle.  I should probably spend more time
+separating the safe stuff from the potentially dangerous stuff.
+
+It might help to read through some of the books in arithmetic/.  For example,
+if you'll be proving a lot of stuff about mod, you should read through
+arithmetic/mod2.lisp?  [I should probably combine mod.lisp and mod2.lisp.
+Mod.lisp contains "Doc's" lemmas, and "mod2.lisp" contains Eric's lemmas.  Once
+I get all of support working with mod2.lisp included, I can combine it with
+mod.lisp.]  For some books, I've pulled out the proofs in to a separate book
+(e.g., expo2-proofs.lisp).
+
+For a quick overview of the books in arithmetic, see the comments in
+arithmetic/top.lisp.
+
+Misc notes: Generally, I assign a lemma to a book based on which function the
+lemma is "about".  So if you're missing a fact about bvecp, look in
+support/bvecp.lisp.  Or if you're missing a lemma about mod, look in
+arithmetic/mod.lisp.  Sometimes it's hard to tell which function a lemma is
+"about".  I tend to rely on a rough mental picture of the directed acyclic
+graph created by the definitions of the functions we use.  Thus if FOO calls
+BAR, a lemma about FOO and BAR goes in the FOO book.  Also, I tend to classify
+a lemma as being "about" to most complicated function it mentions. So a lemma
+about mod of a sum, goes in the mod book since mod is more complicated than
++. (+ is used to define mod!).  Sometimes it's not clear where to put a lemma
+and I create a special book, such as "arithmetic/mod-expt.lisp", which contains
+lemmas mixing mod and expt.
+
+See also arithmetic/README.
+
+Examples of two useful greps (modify appropriately):
+
+Find all mentions of "mod-equal" in .lisp files:
+
+  grep -i "mod-equal" */*.lisp
+
+Find all mentions of the rule "mod-equal" in .out files (including all the
+times it was used in proofs):
+
+  grep -i "mod-equal" */*.out
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/Makefile acl2-6.3/books/rtl/rel9/arithmetic/Makefile
--- acl2-6.2/books/rtl/rel9/arithmetic/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,12 @@
+include ../../../Makefile-generic
+
+
+# BOOKS = ground-zero induct predicate rationalp negative-syntaxp integerp inverted-factor fp2 fp arith2 arith denominator numerator unary-divide product-proofs product nniq basic cg complex-rationalp even-odd  expt-proofs expt expo expo-proofs fl-proofs fl fl-expt floor floor-proofs hacks mod-proofs mod mod-expt power2p product unary-divide x-2xx even-odd2-proofs even-odd2 fl-hacks top extra-rules common-factor-defuns common-factor
+
+# remove float?
+# remove util?
+# remove hacks?
+# remove induct?
+#  land lextra lior log logand logand-proofs logeqv logior logior1 lognot logorc1 logs logxor lxor lnot ash 
+
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/README acl2-6.3/books/rtl/rel9/arithmetic/README
--- acl2-6.2/books/rtl/rel9/arithmetic/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/README	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,43 @@
+This directory contains the start of "arithmetic" library.  Some of the rules and files in this directory were
+previously in support/.  Others are new.
+
+This library includes lemmas about the following functions:
+
++ 
+* 
+unary-- (note that - is a macro)
+unary-/ (note that - is a macro)
+<       (and so also > <= and >=)
+integerp
+rationalp
+complex-rationalp
+numerator                    (We hope the user doesn't have to reason about this directly.)
+denominator                  (We hope the user doesn't have to reason about this directly.)
+nonnegative-integer-quotient (We hope the user doesn't have to reason about this directly.)
+expt
+floor
+mod
+abs (sort of)
+fl (not built-in, but related to floor)
+cg (not built-in, but related to fl)
+expo (not built-in, but initmately tied up with expt)
+even (not built-in; recursive version of evenp)
+odd  (not built-in; recursive version of oddp)
+
+
+See the comments in top.lisp.  See also ../README
+
+The user of the library probably wants some arithmetic books, to help him/her reason about + and * and so on.
+The safest thing to do would be to include lib/arith.  This is essentially the old "fp.lisp" book.  Note that
+lib/basic include more arithmetic-style lemmas.  The more agressive use might want to try including this
+arithmetic library (i.e., the book arithmetic/top) instead of lib/arith.
+
+Normal Forms:
+
+We rewrite (- x) to (* -1 x).
+
+Scattering vs. gathering exponents: Currently, we are agnostic about which to do.  (Neither is enabled by
+default after one includes arithmetic/top).  To scatter exponents, enable expt-split and expt-miuns.  To
+gather exponents, enable a15 and expt-inverse (and disable expo-shift-general, which currently doesn't work
+with gathering -- that is, it can loop!).
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/arith.lisp acl2-6.3/books/rtl/rel9/arithmetic/arith.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/arith.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/arith.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,71 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;This book contains basic arith stuff which i'm pretty sure won't hurt anything.
+
+(local (include-book "arith2"))
+
+;This is a meta rule to cancel identical terms from both sides of an equality of sums.
+(include-book "../../../meta/meta-plus-equal")
+
+;This is a meta rule to cancel identical terms from both sides of a < of sums.
+(include-book "../../../meta/meta-plus-lessp")
+
+;This is a meta rule to cancel identical terms from both sides of an equality of products (I think).
+(include-book "../../../meta/meta-times-equal")
+
+;Note!  There is not meta-times-lessp, which would be really nice to have.  I now have a bind-free rule to do that...
+
+(defthm collect-constants-in-equal-of-sums
+  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
+                (case-split (acl2-numberp c1))
+                )
+           (and (equal (equal (+ c2 x) c1)
+                       (equal (fix x) (- c1 c2)))
+                (equal (equal c1 (+ c2 x))
+                       (equal (fix x) (- c1 c2))))))
+
+(defthm collect-constants-in-equal-of-sums-2
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (and (equal (equal (+ c2 x) (+ c1 y))
+                       (equal (fix x) (+ (- c1 c2) y))))))
+
+(defthm collect-constants-in-<-of-sums
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (and (equal (< (+ c2 x) c1)
+                       (< x (- c1 c2)))
+                (equal (< c1 (+ c2 x))
+                       (< (- c1 c2) x)))))
+
+(defthm collect-constants-in-<-of-sums-2
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (< (+ c2 x) (+ c1 y))
+                  (< x (+ (- c1 c2) y)))))
+
+;I put this in because it seems to help rewrite stupid hyps quickly.
+(defthm dumb
+  (equal (< x x)
+         nil))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/arith2.lisp acl2-6.3/books/rtl/rel9/arithmetic/arith2.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/arith2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/arith2.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,597 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+This book contains a hodgepodge of useful arithmetic rules.
+It's still kind of a mess.  But it's better now that we have the rules in common-factor.lisp.
+
+|#
+
+(include-book "fp2")
+(include-book "predicate")
+(include-book "product")
+(include-book "../../../meta/meta-times-equal")
+(include-book "../../../meta/meta-plus-equal")
+(include-book "../../../meta/meta-plus-lessp")
+
+
+;get more rules from arithmetic-2 ?
+
+
+
+
+;;=================================================================================
+;; Collect leading constants in comparisons.
+;; This section is complete.  [what about products??]
+;;===================================================================================
+
+(defthm collect-constants-in-equal-of-sums
+  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
+                (case-split (acl2-numberp c1))
+                )
+           (and (equal (equal (+ c2 x) c1)
+                       (equal (fix x) (- c1 c2)))
+                (equal (equal c1 (+ c2 x))
+                       (equal (fix x) (- c1 c2))))))
+
+(defthm collect-constants-in-equal-of-sums-2
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (and (equal (equal (+ c2 x) (+ c1 y))
+                       (equal (fix x) (+ (- c1 c2) y))))))
+
+(defthm collect-constants-in-<-of-sums
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (and (equal (< (+ c2 x) c1)
+                       (< x (- c1 c2)))
+                (equal (< c1 (+ c2 x))
+                       (< (- c1 c2) x)))))
+
+(defthm collect-constants-in-<-of-sums-2
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (< (+ c2 x) (+ c1 y))
+                  (< x (+ (- c1 c2) y)))))
+
+
+;this book includes (how many?) main types of lemmas
+
+;there's stuff in inverted-factor too
+
+
+;collecting constants
+; equal with sums
+; < with sums
+; < with products
+; equal with products
+
+;rearranging negative coeffs
+;getting rid of fractional coeffs
+
+;cancelling factors in comparisons of sums (these sums may each have only 1 addend)
+
+;misc lemmas (comparing products to 0)
+
+;see equal-constant-+ in equalities.lisp
+
+;see also see MULT-BOTH-SIDES-OF-EQUAL
+(defthmd mult-both-sides-of-<-by-positive
+  (implies (and (<= 0 c)
+                (rationalp c)
+                (case-split (< 0 c))
+                )
+           (equal (< (* c a) (* c b))
+                  (< a b))))
+
+
+(include-book "../../../meta/meta-times-equal")
+(include-book "../../../meta/meta-plus-equal")
+(include-book "../../../meta/meta-plus-lessp")
+
+
+(defthm mult-both-sides-of-equal
+  (implies (and (case-split (acl2-numberp a))
+                (case-split (acl2-numberp b))
+                (case-split (acl2-numberp c))
+                )
+           (equal (equal (* a c) (* b c)) 
+                  (if (equal c 0)
+                      t
+                    (equal a b))))
+  :rule-classes nil)
+
+
+
+#|
+
+;instead of these, we should just cancel common factors from the constants
+
+;open question: how to handle (equal (* 2 x) (* 3 y)) -- should we collect the constants or not? 
+;maybe so, since doing so would let us substitue for one of the vars (x or y).
+
+;don't yet handle negative constants
+;prefers that quotient of the constants be > 1  -perhaps we want the quotient to be < 1???
+;maybe the constant should be by itself?
+(defthm collect-constants-in-product-<-1-of-2-with-1-of-2
+  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
+                (rationalp c1)
+                (rationalp c2)
+                (< 0 c1) ;gen
+                (< 0 c2) ;gen
+                (rationalp a)
+                (rationalp b))
+           (equal (< (* c1 a) (* c2 b))
+                  (if (> c1 c2)
+                      (< (* (/ c1 c2) a) b)
+                    (< a (* (/ c2 c1) b)))))
+  :hints (("Goal" :use ((:instance mult-both-sides-of-<-by-positive 
+                                   (a (* c1 a))
+                                   (b (* c2 b))
+                                   (c (/ c1)))
+                        (:instance mult-both-sides-of-<-by-positive 
+                                   (a (* c1 a))
+                                   (b (* c2 b))
+                                   (c (/ c2)))))))
+
+(defthm collect-constants-in-product-<-1-of-1-with-1-of-2
+  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
+                (rationalp c1)
+                (rationalp c2)
+                (< 0 c1) ;gen
+                (< 0 c2) ;gen
+                (rationalp b))
+           (equal (< c1 (* c2 b))
+                  (< (/ c1 c2) b)))
+  :hints (("Goal" :use ((:instance mult-both-sides-of-<-by-positive 
+                                   (a c1)
+                                   (b (* c2 b))
+                                   (c (/ c2)))))))
+
+(defthm collect-constants-in-product-<-1-of-2-with-1-of-1
+  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
+                (rationalp c1)
+                (rationalp c2)
+                (< 0 c1) ;gen
+                (< 0 c2) ;gen
+                (rationalp b))
+           (equal (< (* c2 b) c1)
+                  (< b (/ c1 c2))))
+  :hints (("Goal" :use ((:instance mult-both-sides-of-<-by-positive 
+                                   (b c1)
+                                   (a (* c2 b))
+                                   (c (/ c2)))))))
+
+
+|#
+
+
+
+;generalize to acl2-numberp whenever possible
+;make more like these!
+
+;BOZO generalize this hack
+;drop?
+;is this like rearrange-negative coeffs?
+(defthm rearr-neg-eric
+  (implies (and (rationalp a)
+                (rationalp b)
+                (rationalp c)
+                (rationalp d))
+           (equal (EQUAL (+ a (* -1 b) c)
+                         d)
+                  (equal (+ a c) (+ b d)))))
+
+;add "equal" to the name?
+;more like this?
+;BOZO bad name...
+(defthm collect-constants-with-division
+  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
+                (rationalp c2)
+                (acl2-numberp c1)
+                (not (equal c2 0))
+                (rationalp x))
+           (equal (equal c1 (* c2 x))
+                  (equal (/ c1 c2) x))))
+
+
+;; ==================================================================================================
+;;
+;;;comparing a product to 0
+
+;; may cause case splits (which, for my purposes, is acceptable)
+
+;; ==================================================================================================
+
+
+
+#|
+;BOZO I have more rules about this in product.lisp !!!
+
+;case split on the sign of A
+(defthm prod->-0-cancel-pos
+  (implies (and (< 0 a)
+                (rationalp x)
+                (rationalp a)
+                )
+           (equal (< 0 (* a x))
+                  (< 0 x))))
+
+(defthm prod-<-0-cancel-pos
+  (implies (and (< 0 a)
+                (rationalp x)
+                (rationalp a)
+                )
+           (equal (< (* a x) 0)
+                  (< x 0))))
+
+
+(defthm prod-<-0-cancel-neg
+  (implies (and (< a 0)
+                (rationalp x)
+                (rationalp a)
+                )
+           (equal (< (* a x) 0)
+                  (< 0 x))))
+
+(defthm prod->-0-cancel-neg
+  (implies (and (< a 0)
+                (rationalp x)
+                (rationalp a)
+                )
+           (equal (< 0 (* a x))
+                  (< x 0))))
+
+
+;reorder to make the most likely case of the if first?
+(defthm prod->-0-cancel
+  (implies (and (rationalp x)
+                (rationalp a))
+           (equal (< 0 (* a x))
+                  (if (< 0 a)
+                      (< 0 x)
+                    (if (equal 0 a)
+                        nil
+                      (< x 0))))))
+
+
+(defthm prod-<-0-cancel
+  (implies (and (rationalp x)
+                (rationalp a))
+           (equal (< (* a x) 0)
+                  (if (equal a 0)
+                      nil
+                    (if (< a 0)
+                        (< 0 x)
+                      (< x 0))))))
+
+
+(in-theory (disable prod-<-0-cancel-neg 
+                    prod-<-0-cancel-pos
+                    prod->-0-cancel-neg  
+                    prod->-0-cancel-pos))
+
+
+|#
+
+
+(defthmd cancel-in-prods-<-case-x->-0
+  (implies (and (rationalp x)
+                (< 0 x)
+                (rationalp a)
+                (rationalp b))
+           (equal  (< (* x a) (* x b))
+                   (< a b)))
+  )
+
+(defthmd cancel-in-prods-<-case-x-<-0
+  (implies (and (rationalp x)
+                (> 0 x)
+                (rationalp a)
+                (rationalp b))
+           (equal  (< (* x a) (* x b))
+                   (> a b)))
+  )
+
+;changed the var names 'cause "x" was too heavy
+;disabled, since we have a bind-free rule to cancel
+(defthmd cancel-in-prods-<
+  (implies (and (rationalp a)
+                (rationalp b)
+                (rationalp c))
+           (equal (< (* a b) (* a c))
+                  (if (equal 0 a)
+                      nil
+                    (if (> a 0)
+                        (< b c)
+                      (> b c)))))
+  :hints (("Goal" :in-theory (enable  cancel-in-prods-<-case-x-<-0
+                                      cancel-in-prods-<-case-x->-0)))
+  )
+
+
+
+;it shouldn't be too hard to write a bind-free function for cancelling common factors; that rule could replace
+;many of the cancelling rules below
+
+
+;use negative-syntaxp? (or a version of it that operates on single addends only (i.e., has no '+ case)
+;do we need this?
+(defthmd move-a-negative-coeff
+  (equal (< (+ a (* -1 b)) c)
+         (< a (+ b c))))
+  
+;can simplify the *-1 term to have only one var 
+;do we need this?
+(defthm rearr-negative-coeffs-<-sums-blah
+  (equal (< (+ A e (* -1 C)) B)
+         (< (+ A e) (+ (* C) B)))
+  :hints (("Goal" :use (:instance
+                        move-a-negative-coeff (a (+ a e)) (b (* c)) (c b)))))
+
+(defthm collect-constant-mults-<-1-of-2-with-1-of-2-term-len-2
+  (implies (and (syntaxp (and (quotep c1) (quotep c2)))
+                (rationalp c1)
+                (rationalp c2)
+                (rationalp a)
+                (rationalp b)
+                (rationalp c)
+                (rationalp d))
+           (equal (< (+ (* c1 c d) a) (+ (* c2 c d) b))
+                  (< (+ (* (- c1 c2) c d) a) b))))
+
+
+(include-book "inverted-factor")
+
+
+;events in :rule-classes nil which can be :used in hacks
+
+(defthm <-transitive
+  (implies (and (< a b)
+                (< b c)
+                )
+           (< a c)
+           )
+  :rule-classes nil
+  )
+
+(defthm <=-transitive
+  (implies (and (<= a b)
+                (<= b c)
+                )
+           (<= a c)
+           )
+  :rule-classes nil
+  )
+
+;a<b and b<=c together imply a<c
+(defthm <-and-<=-transitivity
+  (implies (and (< a b)	
+                (<= b c)	
+                )
+           (< a c)
+           )
+  :rule-classes nil
+  )
+
+;a<=b and b<c together imply a<c
+(defthm <=-and-<-transitivity
+  (implies (and (< a b)	
+                (<= b c)	
+                )
+           (< a c)
+           )
+  :rule-classes nil
+  )
+
+
+;used only as a hack:
+
+
+(defthm equal-transitive
+  (implies (and (equal a b)
+                (equal b c))
+           (equal a c))
+  :rule-classes nil)
+
+;there's a conflict in my arithmetic normal forms:
+; do we prefer (< (* 2 x) 1) or (< x 1/2) ?
+
+
+(defthm collect-again
+  (implies (and (syntaxp (quotep k))
+                (rationalp x)
+                (rationalp y))
+           (equal (< (+ x y) (* k x))
+                  (< y (* (- k 1) x)))))
+
+
+
+;natp is defined here to try to make sure its always enabled
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(in-theory (enable natp))
+
+;an odd rule
+(defthm two-natps-add-to-1
+  (implies (and (natp n)
+                (natp x))
+           (equal (equal 1 (+ x n))
+                  (or (and (equal x 1) (equal n 0))
+                      (and (equal x 0) (equal n 1))))))
+
+;backchain-limit?
+;why needed?
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (not (< (+ x y) 0))))
+
+;improve this? make the conclusion more type-like?
+(defthm nonneg-+-type
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (not (< (+ x y) 0)))
+  :rule-classes (:type-prescription))
+
+(defthm move-negative-constant-1
+  (implies (and (syntaxp (and (quotep k) (< (cadr k) 0)))
+                (acl2-numberp x)
+                (acl2-numberp y))
+           (equal (equal x (+ k y))
+                  (equal (+ x (- k)) y))))
+;move?
+(defthm rationalp-sum
+  (implies (rationalp k)
+           (and (equal (rationalp (+ k x))
+                       (not (complex-rationalp x)))
+                (equal (rationalp (+ x k))
+                       (not (complex-rationalp x))))))
+
+;move?
+;make rationalp-sum like this?
+(defthm rationalp-prod
+  (implies (and (rationalp k)
+                (case-split (not (equal k 0)))
+                )
+           (and (equal (rationalp (* k x))
+                       (not (complex-rationalp x)))
+                (equal (rationalp (* x k))
+                       (not (complex-rationalp x))))))
+;move?
+(defthm complex-rationalp-prod
+  (implies (and (rationalp k)
+                (case-split (not (equal k 0)))
+                )
+           (and (equal (complex-rationalp (* k x))
+                       (complex-rationalp x))
+                (equal (complex-rationalp (* x k))
+                       (complex-rationalp x)))))
+
+
+
+(defthm collect-1
+  (implies (and (syntaxp (and (quotep k) (quotep j)))
+                (rationalp k)
+                (rationalp j)
+                (rationalp x)
+                (rationalp y)
+                )
+           (equal (< (+ y (* k x)) (* j x))
+                  (< (+ (* (- k j) x) y) 0))))
+
+(defthm collect-2
+  (implies (and (syntaxp (and (quotep k) (quotep j)))
+                (rationalp k)
+                (rationalp j)
+                (rationalp x)
+                (rationalp y)
+                )
+           (equal (< (+ (* k x) y) (* j x))
+                  (< (+ (* (- k j) x) y) 0))))
+
+(defthm collect-another
+  (implies (and (syntaxp (and (quotep k) (quotep j)))
+                (rationalp k)
+                (rationalp j)
+                (rationalp x)
+                (rationalp y)
+                (rationalp z))
+           (equal (< (+ (* k x) y) (+ (* j x) z))
+                  (< (+ (* (- k j) x) y) z))))
+
+
+;simplify this
+(defthm collect-in-<-of-sums-2
+  (implies (syntaxp (and (quotep k) (quotep j)))
+           (equal (< (+ a (* k x) d) (+ b e (* j       x) f))
+                  (< (+ a         d) (+ b e (* (- j k) x) f)))))
+
+(defthm collect-in-<-of-sums-1
+  (implies (syntaxp (and (quotep k) (quotep j)))
+           (equal (< (+ a d (* k x) y) (+ b e f z (* j       x) g))
+                  (< (+ a d         y) (+ b e f z (* (- j k) x) g)))))
+
+
+(defthm cancel-in-sum-equal-zero-1
+  (implies (and (rationalp y)
+                (case-split (not (equal 0 y)))
+                (rationalp x1)
+                (rationalp x2)
+                (rationalp x3)
+                (rationalp x4)
+                (rationalp x5)
+                (rationalp x6))
+           (equal (EQUAL 0 (+ (* Y x1)
+                              (* x2 Y x3)
+                              (* Y x4)
+                              (* x5 Y x6)))
+                  (equal 0 (+ x1 (* x2 x3) x4 (* x5 x6)))))
+  :hints (("Goal" :in-theory (disable product-equal-zero)
+           :use (:instance product-equal-zero (x y) (y (+ x1 (* x2 x3) x4 (* x5 x6))))))
+  
+  )
+
+;expensive?
+(defthm integerp-implies-not-complex-rationalp
+  (implies (integerp x)
+           (not (complex-rationalp x))))
+
+;don't need this if we have frac-coeff rules?
+;move to unary-/ ?
+(defthm <-of-two-inverses
+  (implies (and (rationalp x)
+                (rationalp y)
+                (< 0 y)
+                (< 0 x)
+                )
+           (equal (< (/ x) (/ y))
+                  (< y x))))
+
+
+#|
+;move up?
+(defthm pos*
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> x 0)
+                (> y 0))
+           (> (* x y) 0))
+  :rule-classes ())
+
+;bad name
+;find a way to make this a rewrite rule wihtout looping?
+(defthm tighten-integer-bound
+  (implies (and (< x (expt 2 i))
+                (integerp x)
+                (case-split (natp i))
+                )
+           (<= x (+ -1 (expt 2 i))))
+  :rule-classes :linear
+  )
+
+|#
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/basic.lisp acl2-6.3/books/rtl/rel9/arithmetic/basic.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/basic.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,322 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+(in-package "ACL2")
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "fp2")
+(local (include-book "even-odd"))
+
+;;; natp ;;;
+;Currently, we plan to leave natp enabled...
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(defthm natp-compound-recognizer
+  (equal (natp x)
+         (and (integerp x)
+              (<= 0 x)))
+  :rule-classes :compound-recognizer)
+
+; The fpaf3a proof of far-exp-low-lemma-1 in far.lisp requires the
+; following to be a :rewrite rule, not just a :type-prescription rule.
+; Let's make most or all of our :type-prescription rules into :rewrite
+; rules as well.
+(defthmd natp+
+    (implies (and (natp x) (natp y))
+	     (natp (+ x y))))
+
+;move
+(defthmd natp*
+    (implies (and (natp x) (natp y))
+	     (natp (* x y))))
+
+
+
+;abs
+;Currently, we plan to leave abs enabled, but here are some rules about it:
+
+(defthm abs-nonnegative-acl2-numberp-type
+  (implies (case-split (acl2-numberp x))
+           (and (<= 0 (abs x))
+                (acl2-numberp (abs x))))
+  :rule-classes (:TYPE-PRESCRIPTION))
+
+(defthm abs-nonnegative-rationalp-type
+  (implies (case-split (rationalp x))
+           (and (<= 0 (abs x))
+                (rationalp (abs x))))
+  :rule-classes (:TYPE-PRESCRIPTION))
+
+(defthm abs-nonnegative-integerp-type
+  (implies (integerp x)
+           (and (<= 0 (abs x))
+                (rationalp (abs x))))
+  :rule-classes (:TYPE-PRESCRIPTION))
+
+(defthm abs-nonnegative
+  (<= 0 (abs x)))
+
+
+
+
+(local (include-book "fl"))
+
+(defthm fl-def-linear
+  (implies (case-split (rationalp x))
+           (and (<= (fl x) x)
+                (< x (1+ (fl x)))))
+  :rule-classes :linear)
+
+;(in-theory (disable a13)) ;the same rule as fl-def-linear!
+
+;bad? free var.
+(defthm fl-monotone-linear
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y))
+           (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+
+;may need to disable? <-- why did I write that? expensive backchaining?
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+
+;from fl.lisp
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n) ;can't gen?
+                (rationalp x))
+           (equal (fl (/ (fl x) n))
+                  (fl (/ x n))))
+  :hints (("Goal" :use ((:instance fl/int-1)
+			(:instance fl/int-2)))))
+
+
+;needed?
+(defthm fl-integer-type
+  (integerp (fl x))
+  :rule-classes (:type-prescription))
+
+(defthmd fl-def ; use defthmd to avoid wrecking old proofs (rel4->rel5 transition)
+  (and (integerp (fl x))    
+       (implies (case-split (rationalp x))
+	        (and (<= (fl x) x)
+		     (< x (1+ (fl x))))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (<= (fl x) x)
+                                        (< x (1+ (fl x))))))
+                 (:type-prescription :corollary
+                                     (integerp (fl x)))))
+
+;this rule is no better than fl-integer-type and might be worse:
+(in-theory (disable (:type-prescription fl)))
+
+(defthm fl-int
+    (implies (integerp x)
+	     (equal (fl x) x)))
+
+(encapsulate
+ ()
+ (local (include-book "fl"))
+ (defthm fl-integerp
+   (equal (equal (fl x) x)
+          (integerp x))))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+
+
+(encapsulate
+ ()
+ (local (include-book "expt")) 
+
+ (defthm expt-2-positive-rational-type
+   (and (rationalp (expt 2 i))
+        (< 0 (expt 2 i)))
+   :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
+
+ (defthm expt-2-positive-integer-type
+   (implies (<= 0 i)
+            (and (integerp (expt 2 i))
+                 (< 0 (expt 2 i))))
+   :rule-classes (:type-prescription))
+ 
+;the rewrite rule counterpart to expt-2-positive-integer-type
+ (defthm expt-2-integerp
+   (implies (<= 0 i)
+            (integerp (expt 2 i))))
+ 
+
+
+; (in-theory (disable a14)) ;the rules above are better than this one for (expt 2 i)
+
+
+ (defthm expt-2-type-linear
+   (implies (<= 0 i)
+            (<= 1 (expt 2 i)))
+   :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
+
+ (defthmd expt-split
+   (implies (and (integerp i)
+                 (integerp j)
+                 (case-split (acl2-numberp r)) ;(integerp r)
+                 (case-split (not (equal r 0)))
+                 )
+            (equal (expt r (+ i j))
+                   (* (expt r i)
+                      (expt r j)))))
+
+ (theory-invariant (incompatible (:rewrite expt-split)
+                                 (:definition a15))
+                   :key expt-split-invariant)
+ 
+ (defthmd expt-weak-monotone
+   (implies (and (integerp n)
+                 (integerp m))
+            (equal (<= (expt 2 n) (expt 2 m))
+                   (<= n m))))
+
+ (defthmd expt-weak-monotone-linear
+   (implies (and (<= n m)
+                 (case-split (integerp n))
+                 (case-split (integerp m)))
+            (<= (expt 2 n) (expt 2 m)))
+  :rule-classes ((:linear :match-free :all)))
+
+ (defthmd expt-strong-monotone
+   (implies (and (integerp n)
+                 (integerp m))
+            (equal (< (expt 2 n) (expt 2 m))
+                   (< n m))))
+ (defthmd expt-strong-monotone-linear
+   (implies (and (< n m)
+                 (case-split (integerp n))
+                 (case-split (integerp m))
+                 )
+            (< (expt 2 n) (expt 2 m)))
+  :rule-classes ((:linear :match-free :all)))
+
+ (defthmd a15
+   (implies (and (rationalp i)
+                 (not (equal i 0))
+                 (integerp j1)
+                 (integerp j2))
+            (and (equal (* (expt i j1) (expt i j2))
+                        (expt i (+ j1 j2)))
+                 (equal (* (expt i j1) (* (expt i j2) x))
+                        (* (expt i (+ j1 j2)) x))))
+
+   )
+
+ )
+
+; The next two events were added by Matt K. June 2004: Some proofs require
+; calls of expt to be evaluated, but some calls are just too large (2^2^n for
+; large n).  So we use the following hack, which allows calls of 2^n for n<130
+; to be evaluated even when the executable-counterpart of expt is disabled.
+; The use of 130 is somewhat arbitrary, chosen in the hope that it suffices for
+; relieving of hyps related to widths of bit vectors
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))
+                  :guard-hints (("Goal" :expand (hide (expt r i))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n)))
+  :hints (("Goal" :expand ((hide (expt 2 n))))))
+
+;weakly?
+;cases for other signs?
+(defthm *-doubly-monotonic
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp a)
+                (rationalp b)
+                (<= 0 x)
+                (<= 0 y)
+                (<= 0 a)
+                (<= 0 b)
+                (<= x y)
+                (<= a b))
+           (<= (* x a) (* y b)))
+  :rule-classes ())
+
+(defund fl-half (x)
+;  (declare (xargs :guard (real/rationalp x)))
+  (1- (fl (/ (1+ x) 2))))
+
+
+(defthm fl-half-lemma
+    (implies (and (integerp x)
+		  (not (integerp (/ x 2)))) ;if x is odd, ...
+	     (= x (1+ (* 2 (fl-half x)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (e/d (fl-half) (fl-int))
+           :use ((:instance x-or-x/2)
+                 (:instance fl-int (x (/ (1+ x) 2)))))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/cg.lisp acl2-6.3/books/rtl/rel9/arithmetic/cg.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/cg.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/cg.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,168 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;This book introduces the function cg (for "ceiling"), which is in many ways analogous to fl and which is used
+;in the definition of the "away" rounding mode.
+
+;todo: prove more thms about cg analogous to those about fl (maybe not worth doing since only fl is used to
+;define, for example, bits).
+
+(local (include-book "fl"))
+(local (include-book "fp2"))
+(local (include-book "integerp"))
+(local (include-book "integerp"))
+(local (include-book "arith2"))
+(local (include-book "common-factor"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defthm cg-def-linear
+  (implies (case-split (rationalp x))
+           (and (>= (cg x) x)
+                (> (1+ x) (cg x))))
+  :hints (("Goal" :in-theory (enable cg)))
+  :rule-classes :linear)
+
+(defthm cg-monotone-linear
+  (implies (and (rationalp x)
+                (rationalp y)
+                (<= x y))
+           (<= (cg x) (cg y)))
+  :rule-classes :linear)
+
+(defthm n>=cg-linear
+  (implies (and (>= n x)
+                (rationalp x)
+                (integerp n))
+           (>= n (cg x)))
+  :rule-classes :linear)
+
+(defthm cg+int-rewrite
+  (implies (and (integerp n)
+                (rationalp x))
+           (equal (cg (+ x n)) (+ (cg x) n))))
+
+(local
+ (defthm cg/int-1
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (cg (/ (cg x) n))
+		 (cg (/ x n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance cg-def-linear)
+			(:instance cg-monotone-linear (x (/ x n)) (y (/ (cg x) n))))))))
+
+(local
+ (defthm cg/int-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (<= (cg (/ (cg x) n))
+		 (cg (/ x n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance n>=cg-linear (n (* n (cg (/ x n)))))
+			(:instance n>=cg-linear (n (cg (/ x n))) (x (/ (cg x) n)))
+			(:instance cg-def-linear (x (/ x n))))))))
+
+(defthm cg/int-rewrite
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (cg x) (/ n)))
+                  (cg (/ x n))))
+  :hints (("Goal" :use ((:instance cg/int-1)
+			(:instance cg/int-2)))))
+
+(defthm cg/int-rewrite-alt
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (/ n) (cg x)))
+                  (cg (/ x n))))
+  :hints (("Goal" :use ((:instance cg/int-1)
+			(:instance cg/int-2)))))
+
+(defthm int-cg-rules
+  (implies (rationalp x)
+           (integerp (cg x)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm cg-int
+    (implies (integerp x)
+	     (equal (cg x) x)))
+
+(defthm cg-integerp
+    (implies (rationalp x)
+	     (equal (equal (cg x) x)
+                    (integerp x))))
+
+(defthm cg-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (>= n x)
+		  (> (1+ x) n))
+	     (equal (cg x) n))
+  :rule-classes ())
+
+
+
+(defthm fl-cg
+  (implies (rationalp x)
+           (equal (cg x)
+                  (if (integerp x)
+                      (fl x)
+                    (1+ (fl x)))))
+  :rule-classes ())
+
+(defthm cg-integer-type
+  (integerp (cg x))
+  :rule-classes ( :type-prescription))
+
+(defthmd cg-def
+  (and (integerp (cg x))
+       (implies (case-split (rationalp x))
+                (and (>= (cg x) x)
+                     (> (1+ x) (cg x)))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (>= (cg x) x)
+                                        (> (1+ x) (cg x)))))
+                 (:type-prescription :corollary
+                                     (integerp (cg x)))))
+
+(defthm cg-positive
+  (implies (case-split (not (complex-rationalp x)))
+           (equal (< 0 (cg x))
+                  (< 0 x)))
+  :hints (("Goal" :in-theory (enable cg)))
+  )
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/common-factor-defuns.lisp acl2-6.3/books/rtl/rel9/arithmetic/common-factor-defuns.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/common-factor-defuns.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/common-factor-defuns.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,190 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "inverted-factor")
+
+;combine with inverted-factor?
+
+#|
+
+Note.  I'd really like to use multi-sets to handle common factors that appear multiple times (e.g., x in 
+(+ (* x x) (* a x x)).  But for right now, we only handle one ocurrence of each factor.  (Multiple occurrences
+will be handled the next time our rules are tried.
+
+|#
+
+;todo: make these tail-recursive...
+
+(defund my-intersection-equal (x y)
+  (declare (xargs :guard (and (true-listp x) (true-listp y))))
+  (cond ((endp x) nil)
+	((member-equal (car x) y)
+	 (cons (car x) (my-intersection-equal (cdr x) y)))
+	(t (my-intersection-equal (cdr x) y))))
+
+(defun adjoin-equal (x l)
+  (declare (xargs :guard (true-listp l)))
+  (if (member-equal x l)
+      l
+    (cons x l)))
+
+
+;remove the first occurrence of x from l, if any...
+(defund remove-one (x l)
+  (declare (xargs :guard (true-listp l)))
+  (cond ((endp l) nil)
+        ((equal x (car l)) (cdr l))
+        (t (cons (car l) (remove-one x (cdr l))))))
+
+(defthm remove-one-preserves-true-listp
+  (implies (true-listp l)
+           (true-listp (remove-one x l)))
+  :hints (("Goal" :in-theory (enable remove-one))))
+
+
+;In this book, "ground-term" means any term except those which are calls to binary-+ or binary-*.
+
+;TERM is a product of one or more ground-terms.
+;Returns a list of the ground-terms which are multiplied in TERM.  The list will contain no duplicates.
+;Assumes TERM is normalized (either a single ground-term or a correctly associated product of ground-terms.)
+(defund get-factors-of-product (term)
+  (declare (xargs :guard (pseudo-termp term)))
+  (if (not (consp term)) ;term was a symbol
+      (list term)
+    (if (not (equal (car term) 'binary-*))
+        (list term) ;must be a ground-term...
+      (adjoin-equal (cadr term) (get-factors-of-product (caddr term))))))
+
+(defthm get-factors-of-product-true-listp
+  (true-listp (get-factors-of-product term))
+  :hints (("Goal" :in-theory (enable get-factors-of-product))))
+
+(in-theory (disable true-listp
+                    FACTOR-SYNTAXP
+                    PRODUCT-SYNTAXP
+                    SUM-OF-PRODUCTS-SYNTAXP))
+
+(defund find-inverted-factors-in-list (lst)
+  (declare (xargs :guard (true-listp lst)))  
+  (if (endp lst)
+      nil
+    (if (and (consp (car lst))
+             (equal (caar lst) 'unary-/))
+        (cons (car lst) (find-inverted-factors-in-list (cdr lst)))
+       (find-inverted-factors-in-list (cdr lst)))))
+
+(defund remove-cancelling-factor-pairs-helper (inverted-factor-lst lst)
+  (declare (xargs :guard (and (true-listp lst)
+                              (true-listp inverted-factor-lst))))
+  (if (endp inverted-factor-lst)
+      lst
+    (let* ((inverted-factor (car inverted-factor-lst))
+           (non-inverted-factor (and (consp inverted-factor)
+                                     (consp (cdr inverted-factor))
+                                     (cadr inverted-factor))))
+      (if (member-equal non-inverted-factor lst)
+          (remove-cancelling-factor-pairs-helper
+           (cdr inverted-factor-lst)
+           (remove-one inverted-factor 
+                       (remove-one non-inverted-factor 
+                                   lst)))
+        (remove-cancelling-factor-pairs-helper (cdr inverted-factor-lst) lst)))))
+
+(defthm remove-cancelling-factor-pairs-helper-preserves-true-listp
+  (implies (true-listp l)
+           (true-listp (remove-cancelling-factor-pairs-helper i l)))
+  :hints (("Goal" :in-theory (enable  remove-cancelling-factor-pairs-helper))))
+
+;removes any pair of elements <term> and (/ <term>) from the list, so that we don't cancel something that will
+;get blown away anyway.  Note that this is only an issue if we have unnormalized subterms, which *can* happen.
+(defund remove-cancelling-factor-pairs (lst)
+  (declare (xargs :guard (true-listp lst)))  
+  (let* ((inverted-factor-lst (find-inverted-factors-in-list lst)))
+    (if inverted-factor-lst
+        (remove-cancelling-factor-pairs-helper inverted-factor-lst lst)
+      lst)))
+
+(defthm remove-cancelling-factor-pairs-preserves-true-listp
+  (implies (true-listp l)
+           (true-listp (remove-cancelling-factor-pairs l)))
+  :hints (("Goal" :in-theory (enable  remove-cancelling-factor-pairs))))
+
+
+;TERM should be a "normalized sum of products" - "should" in what sense? BOZO
+;returns a list of the factors common to each product in TERM
+(defund find-common-factors-in-sum-of-products-aux (term)
+  (declare (xargs :guard (pseudo-termp term)))
+  (if (not (sum-of-products-syntaxp term))
+      nil
+    (if (not (consp term)) ;term was a symbol
+        (list term)
+      (case (car term)	
+        (binary-+ (my-intersection-equal (get-factors-of-product (cadr term))
+                                         (find-common-factors-in-sum-of-products-aux (caddr term))))
+        (otherwise (get-factors-of-product term)) ;must be a single product...
+        ))))
+
+(defthm find-common-factors-in-sum-of-products-aux-true-listp
+  (true-listp (find-common-factors-in-sum-of-products-aux term))
+  :hints (("Goal" :in-theory (enable find-common-factors-in-sum-of-products-aux))))
+
+;helps ensure that we don't cancel a factor whose inverse is also a factor (in this case the bad factor won't
+;be considered a "common factor" of whichever side also has its inverse among its factors.
+(defund find-common-factors-in-sum-of-products (term)
+  (declare (xargs :guard (pseudo-termp term)))  
+  (remove-cancelling-factor-pairs (find-common-factors-in-sum-of-products-aux term)))
+
+(defthm find-common-factors-in-sum-of-products-true-listp
+  (true-listp (find-common-factors-in-sum-of-products term))
+  :hints (("Goal" :in-theory (enable find-common-factors-in-sum-of-products))))
+
+;(REMOVE-CANCELLING-FACTOR-PAIRS '(a b (unary-/ a) d d d c (unary-/ d) (unary-/ d) (unary-/ d)))
+
+(defund make-product-from-list-of-factors (lst)
+  (declare (xargs :guard (true-listp lst)))  
+  (if (endp lst)
+      1
+    (if (endp (cdr lst))
+        (car lst)
+      (list 'binary-* (car lst) (make-product-from-list-of-factors (cdr lst))))))
+
+(defun find-common-factors-to-cancel (lhs rhs)
+  (declare (xargs :guard (and (pseudo-termp lhs) (pseudo-termp rhs))))  
+  (remove-cancelling-factor-pairs ; do we need this call?
+   (my-intersection-equal
+    (find-common-factors-in-sum-of-products lhs)
+    (find-common-factors-in-sum-of-products rhs))))
+
+(defund bind-k-to-common-factors (lhs rhs)
+  (declare (xargs :guard-hints (("Goal" :use (:instance remove-cancelling-factor-pairs-preserves-true-listp
+                                                        (l (MY-INTERSECTION-EQUAL (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS LHS)
+                                                                                  (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS RHS))))))
+                  :guard (and (pseudo-termp lhs) (pseudo-termp rhs))))
+  (let* ((common-factor-list (find-common-factors-to-cancel lhs rhs)))
+    (if (endp common-factor-list)
+        nil
+      (list (cons 'k (make-product-from-list-of-factors common-factor-list))))))
+                  
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/common-factor.lisp acl2-6.3/books/rtl/rel9/arithmetic/common-factor.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/common-factor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/common-factor.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,153 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+                  
+(include-book "../../../meta/meta-times-equal")
+(include-book "../../../meta/meta-plus-equal")
+(include-book "../../../meta/meta-plus-lessp")
+
+(include-book "common-factor-defuns")
+
+(defthm mult-both-sides-of-equal
+  (implies (and (case-split (acl2-numberp a))
+                (case-split (acl2-numberp b))
+                (case-split (acl2-numberp c))
+                )
+           (equal (equal (* a c) (* b c)) 
+                  (if (equal c 0)
+                      t
+                    (equal a b))))
+  :rule-classes nil)
+
+;BOZO see a9
+(defthm COMMUTATIVITY-2-OF-*
+  (equal (* x (* y z)) (* y (* x z))))
+
+;BOZO see a8
+(defthm inverse-of-*-2
+  (implies (and (case-split (acl2-numberp x))
+                (case-split (not (equal x 0))))
+           (equal (* x (* (/ x) y)) (fix y)))
+  :hints (("Goal" :cases ((acl2-numberp x))))
+  )
+   
+(defthm cancel-common-factors-in-equal
+  (implies (and (bind-free (bind-k-to-common-factors lhs rhs) (k))
+                (case-split (not (equal 0 k)))
+                (case-split (acl2-numberp k))
+                (case-split (acl2-numberp lhs))
+                (case-split (acl2-numberp rhs))
+                )
+                (equal (equal lhs rhs)
+                       (equal (* (/ k) lhs) (* (/ k) rhs))))
+  :hints (("Goal" :use (:instance  mult-both-sides-of-equal (a lhs) (b rhs) (c (/ k))))))
+
+(local (include-book "predicate"))
+(local (include-book "fp2"))
+
+;changed the var names 'cause "x" was too heavy
+;BOZO gen?, rephrase
+(defthm cancel-in-prods-<
+  (implies (and (rationalp a)
+                (rationalp b)
+                (rationalp c))
+           (equal (< (* a b) (* a c))
+                  (if (equal 0 a)
+                      nil
+                    (if (> a 0)
+                        (< b c)
+                      (> b c))))))
+
+;BOZO gen?
+(defthm cancel-common-factors-in-<
+  (implies (and (bind-free (bind-k-to-common-factors lhs rhs) (k))
+                (syntaxp (not (equal lhs rhs))) ;don't apply to (< x x) since we can cause case-splits...
+                ;BOZO is a check like the above needed for the equal case?  I'm guessing not...
+                (case-split (not (equal 0 k)))
+                (case-split (rationalp k))
+                (case-split (rationalp lhs))
+                (case-split (rationalp rhs))
+                )
+                (equal (< lhs rhs)
+                       (if (< 0 k)
+                           (< (* (/ k) lhs) (* (/ k) rhs))
+                         (if (equal 0 k)
+                             nil
+                           (< (* (/ k) rhs) (* (/ k) lhs))
+                           ))))
+  :hints (("Goal" :use (:instance  cancel-in-prods-< (a lhs) (b rhs) (c (/ k))))))
+
+(defun find-common-factors-to-cancel-1 (expr)
+  (declare (xargs :guard (and (pseudo-termp expr))))  
+  (remove-cancelling-factor-pairs
+   (find-common-factors-in-sum-of-products expr)))
+
+(defund bind-k-to-common-factors-1 (expr)
+  (declare (xargs :guard-hints (("Goal" :use (:instance remove-cancelling-factor-pairs-preserves-true-listp
+                                                        (l (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS expr)))))
+                  :guard (and (pseudo-termp expr))))
+  (let* ((common-factor-list (find-common-factors-to-cancel-1 expr)))
+    (if (endp common-factor-list)
+        nil
+      (list (cons 'k (make-product-from-list-of-factors common-factor-list))))))
+
+(local (include-book "product"))
+
+(defthm cancel-common-factors-in-equal-with-0
+  (implies (and (bind-free (bind-k-to-common-factors-1 rhs) (k))
+                (syntaxp (not (equal k rhs))) ;helps prevent loops
+                (case-split (not (equal 0 k)))
+                (case-split (rationalp k))
+                (case-split (rationalp lhs))
+                (case-split (rationalp rhs))
+                )
+           (equal (equal 0 rhs)
+                  (or (equal 0 k) (equal 0 (* (/ k) rhs))))))
+
+#|
+;BOZO
+(defthm cancel-common-factors-<-0
+  (implies (and (bind-free (bind-k-to-common-factors-1 rhs) (k))
+                (case-split (not (equal 0 k)))
+                (case-split (rationalp k))
+                (case-split (rationalp lhs))
+                (case-split (rationalp rhs))
+                )
+           (equal (equal 0 rhs)
+                  (or (equal 0 k) (equal 0 (* (/ k) rhs))))))
+|#
+
+
+  
+
+
+;check that the inverse isn't a factor too...
+
+
+;returns an alist binding k to the product of all common factors in term 
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/complex-rationalp.lisp acl2-6.3/books/rtl/rel9/arithmetic/complex-rationalp.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/complex-rationalp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/complex-rationalp.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,65 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "predicate"))
+
+(defthm complex-rationalp-+-when-second-term-is-rational
+  (implies (rationalp y)
+           (equal (complex-rationalp (+ x y))
+                  (complex-rationalp x))))
+
+(defthm complex-rationalp-+-when-second-term-is-not-complex
+  (implies (not (complex-rationalp y))
+           (equal (complex-rationalp (+ x y))
+                  (complex-rationalp x))))
+
+(defthm complex-rationalp-+-when-first-term-is-rational
+  (implies (rationalp x)
+           (equal (complex-rationalp (+ x y))
+                  (complex-rationalp y))))
+
+(defthm complex-rationalp-+-when-first-term-is-not-complex
+  (implies (not (complex-rationalp x))
+           (equal (complex-rationalp (+ x y))
+                  (complex-rationalp y))))
+
+;add more cases
+(defthm complex-rationalp-*-drop-first-term-if-rational
+  (implies (and (case-split (not (equal y 0)))
+                (rationalp y))
+           (equal (complex-rationalp (* y x))
+                  (complex-rationalp x))))
+
+
+#|
+(defthm complex-rationalp-*-drop-first-term-if-not-complex
+  (implies (and (case-split (not (equal y 0)))
+                (not (complex-rationalp y))
+                )
+           (equal (complex-rationalp (* y x))
+                  (complex-rationalp x))))
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/denominator.lisp acl2-6.3/books/rtl/rel9/arithmetic/denominator.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/denominator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/denominator.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,70 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "ground-zero"))
+(local (include-book "fp2"))
+
+;denom of non-rat?
+
+(defthm denominator-positive-integer-type-prescription
+  (and (< 0 (denominator x))
+       (integerp (denominator x)))
+  :rule-classes (:type-prescription))
+
+(defthm denominator-positive
+  (< 0 (denominator x))
+  :rule-classes (:rewrite :linear))
+
+(defthm denominator-integerp
+  (integerp (denominator x)))
+
+(defthm denominator-one-means-integer
+  (implies (case-split (rationalp x))
+           (equal (equal (denominator x) 1)
+                  (integerp x)))
+  :hints (("goal" :in-theory (disable rational-implies2)
+           :use (rational-implies2
+                 (:instance lowest-terms 
+                            (n (denominator x))
+                            (r x) 
+                            (q 1))))))
+
+(defthm denominator-of-integer-is-one
+  (implies (integerp x)
+           (equal (denominator x)
+                  1)))
+;linear?
+(encapsulate
+ ()
+ (local (include-book "../../../arithmetic/mod-gcd"))
+ (defthm denominator-lower-bound
+   (implies (and (< 0 q)
+                 (integerp p)
+                 (integerp q)
+                 )
+            (<= (denominator (* p (/ q))) q))
+   :hints (("goal" :use (:instance least-numerator-denominator-<= (n p) (d q))))
+   ))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/even-odd.lisp acl2-6.3/books/rtl/rel9/arithmetic/even-odd.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/even-odd.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/even-odd.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,245 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "integerp"))
+(local (include-book "predicate"))
+(local (include-book "fp2"))
+
+;a funny little rule:
+;can be expensive!
+;perhaps should export disabled
+;make a forward-chaining rule?
+(defthmd even-int-implies-int
+  (implies (and (integerp (* 1/2 x))
+                (rationalp x) ;gen?
+                )
+           (integerp x))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil)))
+  :hints (("Goal" :in-theory (disable integerp-prod)
+           :use (:instance integerp-prod (x (* 1/2 x)) (y 2)))))
+
+;this book is currently a mess.
+
+;normal forms: leave evenp and oddp enabled
+
+;from basic
+(defun INDUCT-NAT (x)
+  (if (and (integerp x)
+	   (> x 0))
+      (induct-nat (1- x))
+    ()))
+
+
+(local
+ (defthm x-or-x/2-4
+   (implies (and (integerp x) (>= x 0))
+            (or (integerp (/ x 2)) (integerp (/ (1+ x) 2))))
+   :rule-classes ()
+   :hints (("Goal" :induct (induct-nat x)))))
+
+;is this sort of thing elsewhere? integerp.lisp?
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+(defthm x-or-x/2
+  (implies (integerp x) 
+           (or (integerp (/ x 2)) (integerp (/ (1+ x) 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable integerp-+)
+           :use ((:instance integerp-+ (x (+ 1/2 (* -1/2 X))) (y x))
+                 (:instance x-or-x/2-4)
+                 (:instance x-or-x/2-4 (x (- x)))))))
+
+
+
+;end stuff from basic
+
+(encapsulate
+ ()
+ (local (defthm hack-int
+          (implies (and (integerp x)
+                        (integerp y))
+                   (integerp (+ x y)))))
+
+ (defthm integerp-sum-of-odds-over-2
+   (implies (and (rationalp x)
+                 (rationalp y)
+                 (integerp (* 2 x)) ;these two hyps say x is of the form (odd)/2
+                 (not (integerp x)) ;
+                 )
+            (equal (integerp (+ x y))
+                   (and (integerp (* 2 y))
+                        (not (integerp y)) ; (oddp (* 2 y)) ;rephrase the oddp hyps?
+                        )))
+   :hints (("Goal" :in-theory (disable even-int-implies-int)
+            :use ( (:instance even-int-implies-int (x (+ (* 2 x) (* 2 y))))
+                   (:instance hack-int (x (+ 1/2 X)) (y (+ 1/2 y)))
+                   (:instance x-or-x/2 (x (* 2 x)))
+                   (:instance x-or-x/2 (x (* 2 y)))))))
+ )
+
+;derive the results below from the above (or eliminate them)
+
+(in-theory (disable integerp-sum-of-odds-over-2))
+
+;make this a rewrite?
+;special case
+(defthm integerp-sum-of-odds-over-2-leading-constant
+  (implies (and (syntaxp (and (quotep x)
+                              (integerp (* 2 x)) ;;these two hyps say x is of the form (odd)/2
+                              (not (integerp x)) ;; 
+                              ))
+                (rationalp x)
+                (rationalp y)
+                (integerp (* 2 x)) ;;these two hyps say x is of the form (odd)/2
+                (not (integerp x)) ;;
+                (integerp (* 2 y))
+                (not (integerp y)) ; (oddp (* 2 y)) ;rephrase the oddp hyps?
+                )
+           (integerp (+ x y)))
+  :hints (("Goal" :use integerp-sum-of-odds-over-2)))
+
+;do we need all this stuff?
+
+;(defthm even-or-odd
+ ; (implies (integerp x)
+  ;         (or (evenp x) (oddp x)))
+  ;:rule-classes nil)
+
+;should be a rewrite? - general rewrites for evenp/oddp of sum/diff?
+;(defthm odd-+-1
+ ; (implies (and (integerp x)
+  ;              (oddp x))
+   ;        (evenp (+ 1 x)))
+  ;:hints (("Goal" :use (:instance x-or-x/2 ))))
+
+;(defthm odd/2-plus-1/2
+ ; (implies (and (integerp x)
+  ;              (oddp x))
+   ;        (integerp (+ 1/2 (/ x 2))))
+  ;:hints (("Goal" :use (:instance odd-+-1))))
+
+;hack, don't leave enabled ;rewrite?
+;(defthm integerp-next
+ ; (implies (and (rationalp x)
+  ;              (integerp (+ x 1)))
+   ;        (integerp x)))
+
+;(defthm odd/2-minus-1/2
+ ; (implies (and (integerp x)
+  ;              (oddp x))
+   ;        (integerp (+ -1/2 (/ x 2))))
+  ;:hints (("Goal" :use (:instance odd/2-plus-1/2))))
+
+;(in-theory (disable integerp-next))
+
+;(defthm odd/2-minus-1/2-alt
+ ; (implies (and (integerp x)
+  ;              (oddp x))
+   ;        (integerp (+ -1/2 (* 1/2 x))))
+ ; :hints (("Goal" :in-theory (disable  odd/2-minus-1/2)
+  ;         :use (:instance  odd/2-minus-1/2))))
+
+;floor of odd/2 is odd/2 -1/2
+
+
+ ;; :hints (("Goal" :use ( (:instance  fl-unique 
+   ;                                  (x (* 1/2 x))
+    ;                                 (n (- (* 1/2 x) 1/2)))))))
+
+
+;needed?
+
+(defthm even-and-odd-alternate-eric
+  (implies (and (rationalp x)
+                (integerp (* 2 x)))
+           (equal (integerp (+ 1/2 x))
+                  (not (integerp x)))))
+
+
+;should this go in type.lisp?
+;needed? ;lets change any leading constant of -1/2 to 1/2 and elim this rule
+(defthm even-and-odd-alternate-3
+  (implies (and (integerp x))
+           (equal (integerp (+ -1/2 (* -1/2 x)))
+                  (not (integerp (* 1/2 x)))))
+  :hints (("Goal" :in-theory (disable integerp-minus)
+           :use (:instance integerp-minus (x (+ -1/2 (* -1/2 x)))))))
+
+#| never finished this
+(defthm integerp-+-odd-over-2-reduce
+  (implies (and (rationalp x)
+                (integerp (* 2 x)) ;these two hyps say x is of the form (odd)/2
+                (not (integerp x))
+                (rationalp y))
+           (implies (integerp (+ x y))
+                    (and (integerp (* 2 y)) ;these two hyps say x is of the form (odd)/2
+                         (not (integerp y))))) ;
+  :otf-flg t
+  :hints (("Goal" :use  integerp-sum-of-odds-over-2)))
+|#
+
+
+
+
+(defthm even-and-odd-alternate-eric-2-bk
+  (implies (rationalp x)
+           (implies (and (integerp (* 2 x))
+                         (not (integerp x)))
+                    (integerp (+ 1/2 x)))))
+
+;if s is even, then s-1 is odd
+(defthm even-odd-5
+  (implies (and (rationalp x)
+                (integerp (* 1/2 x)))
+           (and (integerp (- x 1))
+                (not (integerp (* 1/2 (- x 1))))))
+  :hints (("Goal" :in-theory (enable even-int-implies-int)))
+)
+
+
+(defthm even-and-odd-alternate-eric-2-fw
+  (implies (rationalp x)
+           (implies (integerp (+ 1/2 x))
+                  (and (integerp (* 2 x))
+                       (not (integerp x)))))
+  :hints (("Goal"
+           :in-theory (disable even-odd-5)
+           :use (:instance even-odd-5 (x (+ 1 (* 2 x)))))))
+
+
+;replace the 1/2 rules above and similarly generalize the rules at the top to be equal rules
+(defthm even-and-odd-alternate-eric-2
+  (implies (rationalp x)
+           (equal (integerp (+ 1/2 x))
+                  (and (integerp (* 2 x))
+                       (not (integerp x))))))
+
+(in-theory (disable  even-and-odd-alternate-eric-2-fw even-and-odd-alternate-eric-2-bk))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/even-odd2-proofs.lisp acl2-6.3/books/rtl/rel9/arithmetic/even-odd2-proofs.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/even-odd2-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/even-odd2-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,304 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;This is different from the book even-odd.  (We define new functions here.)
+
+;I could take pains to define functions that agree with evenp and oddp for all inputs (complex-rationalps are
+;a little weird).  But for now, I'll just focus on the integers.
+
+;more stuff like this is in x-2xx.lisp
+
+;a recursive version of even
+
+(local (include-book "integerp"))
+(local (include-book "arith"))
+(local (include-book "arith2"))
+(local (include-book "fp2")) ;ugh
+
+(in-theory (disable evenp))
+
+;x should be a non-negative integer
+(defund even-aux (x)
+  (if (zp x)
+      t
+    (if (eql 1 x)
+        nil
+      (even-aux (+ -2 x)))))
+
+(defthm even-aux-reduce-1
+  (implies (case-split (not (zp x)))
+           (equal (even-aux (+ -1 x))
+                  (not (even-aux x))))
+  :hints (("goal" :in-theory (enable even-aux)))
+  )
+
+;this loops with defn even-aux?
+(defthmd even-aux-reduce-2
+  (implies (and (integerp x)
+                (< 1 x))
+           (equal (even-aux (+ -2 x))
+                  (even-aux x)))
+  :hints (("goal" :in-theory (enable even-aux)))
+  )
+
+(defthm even-aux-reduce-3
+  (implies (case-split (not (zp x)))
+           (equal (even-aux (+ 1 x))
+                  (not (even-aux x))))
+  :hints (("goal" :expand (EVEN-AUX (+ 1 X))
+           :in-theory (enable even-aux-reduce-2)))
+  )
+
+(defthm even-plus-even-pos-aux
+  (implies (and (even-aux x)
+                (even-aux y)
+                (integerp x)
+                (<= 0 x)
+                (<= 0 y)
+                )
+           (even-aux (+ x y)))
+  :hints (("Goal" :in-theory (enable even-aux zp))))
+
+(defthm even-minus-even-pos-aux
+  (implies (and (even-aux x)
+                (even-aux y)
+                (integerp x)
+                (integerp y)
+                (<= 0 x)
+                (<= 0 y)
+                )
+           (even-aux (- x y)))
+  :hints (("Subgoal *1/6" :cases ((equal y x) (equal y (+ -1 x)))
+           :in-theory (set-difference-theories  
+                       (enable even-aux-reduce-2)
+                       '(even-aux)))
+          ("Goal" :cases (<= y x)
+           :in-theory (enable even-aux))))
+
+;note that even is not the same as the built in function evenp
+;handle complex numbers?
+(defund even (x)
+  (if (not (integerp x))
+      nil
+    (if (< x 0)
+        (even-aux (- x))
+      (even-aux x))))
+
+;keep disabled?
+(defthmd even-is-evenp-pos
+  (implies (and (integerp x)
+                (<= 0 x))
+           (equal (even-aux x) (evenp x)))
+  :hints (("Goal" :in-theory (enable even-aux evenp))))
+
+(defthmd even-is-evenp
+  (implies (integerp x)
+           (equal (even x) (evenp x)))
+  :hints (("Goal" :in-theory (enable even evenp ;or prove evenp-minus
+                                     even-is-evenp-pos
+                                      ))))
+
+(defthm even-aux-negative
+  (implies (<= x 0)
+           (even-aux x))
+  :hints (("Goal" :in-theory (enable even-aux)))
+  )
+
+(defthm even-minus
+  (implies (case-split (acl2-numberp x))
+           (equal (EVEN (* -1 X))
+                  (even x)))
+  :hints (("Goal" :in-theory (enable even)))
+  )
+
+(defthm even-means-integerp
+  (implies (even x)
+           (integerp x))
+  :hints (("Goal" :in-theory (enable even)))
+  :rule-classes (;:compound-recognizer
+                 :forward-chaining))
+
+;export
+(defthm even-plus-even
+  (implies (and (even x)
+                (even y)
+                )
+           (even (+ x y)))
+  :otf-flg t
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable EVEN)
+                              '( even-minus-even-pos-aux EVEN-PLUS-EVEN-POS-aux))
+           :use( (:instance even-plus-even-pos-aux (x x) (y y))
+                 (:instance even-plus-even-pos-aux (x (- x)) (y (- y)))
+                 (:instance even-minus-even-pos-aux (x x) (y (- y)))
+                 (:instance even-minus-even-pos-aux (x (- x)) (y y))
+                 (:instance even-minus-even-pos-aux (x (- y)) (y x))
+                 (:instance even-minus-even-pos-aux (x y) (y (- x)))))))
+
+;export
+;we don't disable even-plus-even, despite the use hint
+(defthm even-sum-rewrite-1
+  (implies (and (even x)
+                (case-split (acl2-numberp y))
+                )
+           (and (equal (even (+ x y))
+                       (even y))
+                (equal (even (+ y x))
+                       (even y))))
+  :hints (("Goal" :use (:instance even-plus-even (x (* -1 x)) (y (+ x y)))))) 
+
+(defund odd (x)
+  (and (integerp x)
+       (not (even x))))
+
+(defthm odd-means-integerp
+  (implies (odd x)
+           (integerp x))
+  :hints (("Goal" :in-theory (enable odd)))
+  :rule-classes (;:compound-recognizer
+                 :forward-chaining))
+
+(defthm odd-plus-even
+  (implies (and (odd x)
+                (even y))
+           (and (odd (+ x y))
+                (odd (+ y x))))
+  :hints (("Goal" :in-theory (enable odd))))
+
+
+(defthm odd-sum-rewrite-1
+  (implies (even x)
+           (and (equal (odd (+ x y))
+                       (odd y))
+                (equal (odd (+ y x))
+                       (odd y))))
+  :hints (("Goal" :in-theory (enable odd) )))
+
+#|
+
+there are plenty more nice even-odd theorems
+
+(defthm even-sum-rewrite
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (even (+ x y))
+                  (or (and (even x) (even y))
+                      (and (odd x) (odd y)))))
+  :hints (("Goal" :in-theory (enable odd))))
+
+plus rules to rewrite oddp and evenp   
+
+(defthm oddp-sum
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (oddp (+ x y))
+                  (or (and (oddp x) (evenp y))
+                      (and (evenp x) (oddp y))))))
+|#
+
+
+
+
+;yuck.  generalize?
+;does this loop with the defn of even?
+(defthm even-reduce
+  (implies (case-split (integerp n))
+           (equal (EVEN (+ -1 N))
+                  (not (even n))))
+  :hints (("Goal" :in-theory (enable even)))
+)
+
+
+(defthm odd-reduce
+  (implies (case-split (integerp n))
+           (equal (ODD (+ -1 N))
+                  (not (odd n))))
+  :hints (("Goal" :in-theory (enable odd))))
+
+
+(defthm odd-plus-odd
+  (implies (and (odd x)
+                (odd y))
+           (even (+ x y)))
+  :hints (("Goal" 
+           :use ((:instance odd-reduce (n (+ x y 1)))
+                 (:instance odd-reduce (n (+ x 1)))
+                 (:instance even-plus-even (x (+ 1 X Y)) (y (- (+ 1 x))))
+                 )
+           :in-theory (set-difference-theories
+                       (enable odd)
+                       '(odd-reduce)))))
+
+(defthm odd-sum-rewrite-2
+  (implies (and (odd x)
+                (case-split (acl2-numberp y))
+                )
+           (and (equal (odd (+ x y))
+                       (even y))
+                (equal (odd (+ y x))
+                       (even y))))
+  :hints (("Goal" :in-theory (enable odd) )))
+
+(defun induct-scheme (n)
+  (if (zp n)
+      t
+    (cons 'a (induct-scheme (+ -1 n)))))
+
+(defthm even-double-pos
+  (implies (and (integerp x)
+                (<= 0 x))
+           (even (* 2 x)))
+  :hints (("Goal" :induct (induct-scheme x)
+           :in-theory (enable even even-aux))))
+
+(defthm even-double
+  (implies (integerp x)
+           (even (* 2 x)))
+  :hints (("Goal" :use ((:instance even-double-pos)
+                        (:instance even-minus (x (* 2 x))); or improve even-minus with negative-syntaxp?
+                        (:instance even-double-pos (x (- x))))
+           :in-theory (disable even-minus even-double-pos))))
+
+(defthm odd-double
+  (implies (integerp x)
+           (not (odd (* 2 x))))
+  :hints (("Goal" :in-theory (enable odd))))
+
+
+(defthm even-sum-rewrite-2
+  (implies (odd x)
+           (and (equal (even (+ x y))
+                       (odd y))
+                (equal (even (+ y x))
+                       (odd y))))
+  :hints (("Goal" :cases ((acl2-numberp y))
+           :in-theory (enable odd))))
+
+(defthm even-means-half-is-integer
+  (implies (even x)
+           (integerp (* 1/2 x)))
+  :hints (("goal" :use even-is-evenp
+           :in-theory (enable evenp))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/even-odd2.lisp acl2-6.3/books/rtl/rel9/arithmetic/even-odd2.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/even-odd2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/even-odd2.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,187 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;This is different from the book even-odd.  (We define new functions EVEN and ODD here.)
+;This book contains only the results I want to export.  The proofs are in even-odd2-proofs.lisp
+;I could take pains to define functions that agree with evenp and oddp for all inputs (complex-rationalps are
+;a little weird).  But for now, I'll just focus on the integers.
+;Perhaps see also the function REVEN in x-2xx.lisp
+
+(include-book "ground-zero")
+(local (include-book "even-odd2-proofs"))
+
+;just a helper function
+(defund even-aux (x)
+  (if (zp x)
+      t
+    (if (eql 1 x)
+        nil
+      (even-aux (+ -2 x)))))
+
+;A recursive recognizer for even integers.
+;Note that EVEN is not the same as the built in function EVENP
+;handle complex numbers?
+(defund even (x)
+  (if (not (integerp x))
+      nil
+    (if (< x 0)
+        (even-aux (- x))
+      (even-aux x))))
+
+;A recognizer for odd integers.
+;Most theorems about ODD follow from theorems about EVEN.
+(defund odd (x)
+  (and (integerp x)
+       (not (even x))))
+
+;keep disabled?
+(defthmd even-is-evenp
+  (implies (integerp x)
+           (equal (even x) (evenp x))))
+
+(defthm even-minus
+  (implies (case-split (acl2-numberp x))
+           (equal (even (* -1 x))
+                  (even x))))
+
+;not currently a rewrite rule
+(defthm even-means-integerp
+  (implies (even x)
+           (integerp x))
+  :rule-classes (;:compound-recognizer
+                 :forward-chaining)) 
+
+;not currently a rewrite rule
+(defthm odd-means-integerp
+  (implies (odd x)
+           (integerp x))
+  :rule-classes (;:compound-recognizer
+                 :forward-chaining))
+
+(defthm even-sum-rewrite-1
+  (implies (and (even x)
+                (case-split (acl2-numberp y))
+                )
+           (and (equal (even (+ x y))
+                       (even y))
+                (equal (even (+ y x))
+                       (even y)))))
+
+(defthm even-sum-rewrite-2
+  (implies (odd x)
+           (and (equal (even (+ x y))
+                       (odd y))
+                (equal (even (+ y x))
+                       (odd y)))))
+
+(defthm odd-sum-rewrite-1
+  (implies (even x)
+           (and (equal (odd (+ x y))
+                       (odd y))
+                (equal (odd (+ y x))
+                       (odd y)))))
+
+(defthm odd-sum-rewrite-2
+  (implies (and (odd x)
+                (case-split (acl2-numberp y))
+                )
+           (and (equal (odd (+ x y))
+                       (even y))
+                (equal (odd (+ y x))
+                       (even y)))))
+
+
+;avoid loops
+;wait, why would even ever be around?
+(theory-invariant (incompatible (:rewrite even-reduce) (:definition even-aux)))
+
+;yuck.  generalize?
+(defthm even-reduce
+  (implies (case-split (integerp n))
+           (equal (even (+ -1 n))
+                  (not (even n)))))
+
+
+(defthm odd-reduce
+  (implies (case-split (integerp n))
+           (equal (odd (+ -1 n))
+                  (not (odd n)))))
+
+(defthm even-double
+  (implies (integerp x)
+           (even (* 2 x))))
+
+(defthm odd-double
+  (implies (integerp x)
+           (not (odd (* 2 x)))))
+
+
+;do we want this enabled?
+;Eric needed this for an RTL proof, but perhaps we should think more about how to handle this.
+(defthm even-means-half-is-integer
+  (implies (even x)
+           (integerp (* 1/2 x))))
+
+#|
+
+there are plenty more nice even-odd theorems
+
+(defthm even-sum-rewrite
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (even (+ x y))
+                  (or (and (even x) (even y))
+                      (and (odd x) (odd y)))))
+  :hints (("Goal" :in-theory (enable odd))))
+
+plus rules to rewrite oddp and evenp   
+
+(defthm oddp-sum
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (oddp (+ x y))
+                  (or (and (oddp x) (evenp y))
+                      (and (evenp x) (oddp y))))))
+
+
+
+;move? ;or just prove rules like EVEN-SUM-REWRITE-1, etc. about even-aux
+(defthm even-aux-reduce-by-4
+  (implies (and (case-split (integerp n))
+                (case-split (<= 4 n)))
+           (equal (even-aux (+ -4 n))
+                  (even-aux n)))
+  :hints (("Goal" :in-theory (e/d (even odd) (ODD-REDUCE EVEN-REDUCE  EVEN-SUM-REWRITE-1
+                                                   ODD-SUM-REWRITE-1
+                                                    EVEN-SUM-REWRITE-2
+                                                     ODD-SUM-REWRITE-2))
+           :use ((:instance even-reduce (n n))
+                 (:instance even-reduce (n (+ -1 n)))
+                 (:instance even-reduce (n (+ -2 n)))
+                 (:instance even-reduce (n (+ -3 n)))))))
+|#
+
+   
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/expo-proofs.lisp acl2-6.3/books/rtl/rel9/arithmetic/expo-proofs.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/expo-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/expo-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,952 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;this book includes proofs mixing expo and expt and power2p.
+
+;(include-book
+; "include-book-macros")
+;(include-book
+; "float") ;remove!
+(include-book "negative-syntaxp")
+(include-book "power2p")
+(include-book "unary-divide")
+(include-book "arith2")
+(include-book "integerp")
+(local (include-book "fl"))
+(local (include-book "expt"))
+;(local (include-book "expo"))
+
+(local (in-theory (enable expt-minus)))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "../../../ordinals/e0-ordinal")
+(set-well-founded-relation e0-ord-<)
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+;probably get this anyway when we define expo
+(defthm expo-integer-type
+  (integerp (expo x))
+  :rule-classes :type-prescription)
+
+;(:type-prescription expo) is no better than expo-integer-type and might be worse:
+(in-theory (disable (:type-prescription expo)))
+
+(defthm expo-of-not-rationalp
+  (implies (not (rationalp x))
+           (equal (expo x) 0))
+  :hints (("Goal" :in-theory (enable expo))))
+
+
+;be careful: if you enable expo, the x<0 case of expo can loop with expo-minus
+;(see expo-minus-invariant)
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x))
+  :hints (("Goal" :in-theory (enable expo))))
+
+;rename?
+(defthm expo-minus-eric
+  (implies (syntaxp (negative-syntaxp x))
+           (equal (expo x) 
+                  (expo (* -1 x))))
+  :hints (("Goal" :in-theory (enable expo-minus))))
+
+
+(theory-invariant
+ (not (and (or (active-runep '(:rewrite expo-minus))
+               (active-runep '(:rewrite expo-minus-eric)))
+           (active-runep '(:definition expo))))
+ :key expo-minus-invariant)
+
+
+(local (in-theory (disable expo-minus expo-minus-eric)))
+
+(defthm expo-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (enable expo expt-split))))
+
+(defthm expo-lower-pos
+  (implies (and (< 0 x)
+                (rationalp x)
+                )
+           (<= (expt 2 (expo x)) x))
+  :rule-classes :linear)
+
+(local
+ (defthm expo-upper-bound-old
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expo expt-split)
+                              '())
+           :cases ((equal x 0))))))
+
+
+                
+(defthm expo-upper-bound
+  (implies (rationalp x)
+           (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear
+  :hints (("Goal" :use (expo-upper-bound-old))))
+
+(defthm expo-upper-pos
+  (implies (rationalp x)
+           (< x (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+
+
+(local
+ (defthm expo-unique-2
+   (implies (and (rationalp x)
+                 (not (equal x 0))
+                 (integerp n)
+                 (> n (expo x)))
+            (> (expt 2 n) (abs x)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (disable abs)
+            :use ( ;(:instance expo-upper-bound)
+                  (:instance expt-weak-monotone (n (1+ (expo x))) (m n)))))))
+
+(local
+ (defthm expo-unique-1
+   (implies (and (rationalp x)
+                 (not (equal x 0))
+                 (integerp n)
+                 (< n (expo x)))
+            (<= (expt 2 (1+ n)) (abs x)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (disable abs)
+            :use ((:instance expt-weak-monotone (n (1+ n)) (m (expo x))))))))
+
+
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal n (expo x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+           :use ((:instance expo-unique-1)
+                 (:instance expo-unique-2)))))
+
+;shouldn't have the abs??
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y))
+                )
+           (<= (expo x) (expo y)))
+  :rule-classes :linear
+  :hints (("Goal"
+           :use (;(:instance expo-lower-bound)
+                 (:instance expo-unique-2 (n (expo x)) (x y))))))
+
+(defthm expo-2**n
+  (implies (integerp n)
+           (equal (expo (expt 2 n))
+                  n))
+  :hints (("Goal" :use ((:instance expo-unique (x (expt 2 n)))
+			(:instance expt-strong-monotone (m (1+ n)))))))
+
+;expo-half (and expo-double, sort of) makes the proof of expo-shift go through
+;move
+;worry about loops?
+(defthm expo-half
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                )
+           (equal (expo (* 1/2 x))
+              (+ -1 (expo x))))
+  :hints (("Goal" :in-theory (enable expo expt))))
+
+;move
+;worry about loops?
+(defthm expo-double
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                )
+           (equal (expo (* 2 x))
+              (+ 1 (expo x))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expo expt)
+                              '(expo-minus)))))
+
+(theory-invariant (incompatible (:rewrite expo-half)
+                                (:definition expo)
+                                )
+                  :key expo-half-loops-with-defn-expo)
+
+(theory-invariant (incompatible (:rewrite expo-double)
+                                (:definition expo)
+                                )
+                  :key expo-double-loops-with-defn-expo)
+
+(defthm expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x))
+                  (+ n (expo x))))
+  :hints (("Goal" :in-theory (e/d (expt)
+                                  ()))))
+
+(defthm expo-shift-alt
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* x (expt 2 n)))
+                  (+ n (expo x))))
+  :hints (("Goal" :use  expo-shift
+           :in-theory (e/d ()
+                                  ( expo-shift)))))
+
+(include-book "common-factor-defuns")
+
+;BOZO pull this stuff into a different book:
+
+;An "expt-factor" has the shape (expt 2 i) or the shape (/ (expt 2 i))
+(defun get-expt-factors (factor-list)
+  (declare (xargs :guard (true-listp factor-list)))
+  (if (endp factor-list)
+      nil
+    (let* ((factor (car factor-list)))
+      (if (and (consp factor)
+               (or (and (equal (car factor) 'expt)
+                        (consp (cdr factor))
+                        (equal (cadr factor) ''2))
+                   (and (equal (car factor) 'unary-/)
+                        (consp (cdr factor))
+                        (consp (cadr factor))
+                        (equal (caadr factor) 'expt)
+                        (consp (cdadr factor))
+                        (equal (cadadr factor) ''2))))
+          (cons factor (get-expt-factors (cdr factor-list)))
+        (get-expt-factors (cdr factor-list))))))
+
+(defun find-common-expt-factors-to-cancel (expr)
+  (declare (xargs :guard (and (pseudo-termp expr))))
+  (get-expt-factors
+   (remove-cancelling-factor-pairs
+    (find-common-factors-in-sum-of-products expr))))
+
+(defund bind-k-to-common-expt-factors (expr)
+  (declare (xargs :guard-hints (("Goal" :use (:instance remove-cancelling-factor-pairs-preserves-true-listp
+                                                        (l (MY-INTERSECTION-EQUAL (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS LHS)
+                                                                                  (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS RHS))))))
+                  :guard (and (pseudo-termp expr))))
+  (let* ((common-factor-list (find-common-expt-factors-to-cancel expr)))
+    (if (endp common-factor-list)
+        nil
+      (list (cons 'k (make-product-from-list-of-factors common-factor-list))))))
+
+
+
+(defthmd power2p-rewrite
+  (equal (power2p x)
+         (equal x (expt 2 (expo x))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable power2p
+                                      expt-split
+                                      expt-between-one-and-two
+                                      )
+                              
+                              '(POWER2P-SHIFT)))))
+
+(in-theory (disable EXPO-2**N)) ;why?
+
+;dont export?
+;like EXPO-2**N but better (now hypothesis-free)
+(defthm expo-expt2
+  (equal (expo (expt 2 i))
+         (if (integerp i)
+             i
+           0))
+  :hints (("goal" :in-theory (enable expt))))
+
+(defthm power2p-expt2-i
+  (power2p (expt 2 i))
+  :hints (("Goal" :in-theory (enable expt power2p))))
+
+(defthm power2p-shift-special
+  (equal (power2p (* (expt 2 i) x))
+         (power2p x))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '()))))
+
+(defthm expo-expt2-inverse
+  (equal (expo (/ (expt 2 i)))
+         (if (integerp i)
+             (- i)
+           0))
+  :hints (("goal" :in-theory (disable expo-expt2)
+           :use (:instance expo-expt2 (i (- i))))))
+
+(defthmd expo-/-power2p
+  (implies (power2p x)
+           (equal (expo (/ x))
+                  (- (expo x))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable power2p)
+                              '( power2p-shift EXPO-EXPT2  EXPO-EXPT2-INVERSE)))))
+
+;restrict to only x's which look like powers of 2
+(defthm expo-/-power2p-alt
+  (implies (and (syntaxp (power2-syntaxp x))
+                (force (power2p x)))
+           (equal (expo (/ x))
+                  (- (expo x))))
+  :hints (("Goal" :in-theory (e/d ( expo-/-power2p) ( EXPO-EXPT2  EXPO-EXPT2-INVERSE)))))
+
+;should we shift out by a constant using this rule?  or do we have another rule for that?
+(defthm expo-shift-general
+  (implies (and (bind-free (bind-k-to-common-expt-factors x) (k))
+                (syntaxp (not (equal k x))) ;helps prevent loops
+                (force (power2p k))
+                (case-split (rationalp x)) ;if not, we want to know about it
+                (case-split (not (equal x 0))) ;if x=0 we can simplify further
+                )
+           (equal (expo x)
+                  (+ (expo k) (expo (* (/ k) x)))))
+  :hints (("goal" :in-theory (enable power2p-rewrite)
+           :use (:instance expo-shift (n (- (expo k)))))))
+
+;BOZO think about this.  expo-shift-general depends on combining (expt 2 i) and (/ (expt 2 i)) but if
+;we rewrite  (/ (expt 2 i)) to (expt 2 (* -1 i)) then this may not happen...
+(theory-invariant (incompatible (:rewrite expo-shift-general)
+                                (:rewrite expt-inverse)
+                                )
+                  :key expt-shift-general-can-loop-with-expt-inverse)
+
+
+
+;BOZO defn expt loops 
+
+
+;(in-theory (disable expo-shift))
+
+(defthm expo>=
+  (implies (and (<= (expt 2 n) x)
+                (rationalp x)
+                (integerp n)
+                )
+           (<= n (expo x)))
+  :otf-flg t
+  :rule-classes :linear
+  :hints (("goal" :use ((:instance expo-monotone (x (expt 2 n)) (y x))))))
+
+(defthm expo<=
+  (implies (and (< x (* 2 (expt 2 n)))
+                (< 0 x)
+                (rationalp x)
+                (integerp n)
+                )
+           (<= (expo x) n))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (enable expt-split)
+           :use (expo-lower-bound
+                 (:instance expt-weak-monotone (n (1+ n)) (m (expo x)))))))
+
+(in-theory (disable expo<= expo>=))
+
+(local (in-theory (enable expo-minus)))
+
+;more gen than expo-of-non-negative-integerp in irepsproofs
+;sort of a weird way of proving this?
+(encapsulate
+ ()
+ (local (defthm expo-of-non-negative-integerp
+          (implies (and (integerp x)
+                        (>= x 0))
+                   (>= (expo x) 0))
+          :hints (("Goal" 
+                   :use ((:instance expo>= 
+                                    (x x)
+                                    (n 0)))))))
+
+ (defthm expo-of-integer
+   (implies (integerp x)
+            (<= 0 (expo x)))
+   :hints (("Goal" :in-theory (disable expo-of-non-negative-integerp)
+            :use ((:instance  expo-of-non-negative-integerp (x x))
+                  (:instance  expo-of-non-negative-integerp (x (- x))))))
+   :rule-classes (:rewrite)))
+
+(defthm expo-of-integer-type
+  (implies (integerp x)
+           (and (integerp (expo x)) ;included to make the conclusion a "type" fact
+                (<= 0 (expo x))))
+  :rule-classes ((:type-prescription :typed-term (expo x))))
+
+
+(local (in-theory (disable expo-minus)))
+
+(local (include-book "common-factor"))
+
+
+
+
+
+
+
+;local in support/float:
+
+;(local (in-theory (disable expt-compare)))
+
+;kill
+(local
+ (defthm expo-unique-1
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n)
+                (< n (expo x)))
+           (<= (expt 2 (1+ n)) (abs x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expo abs)
+           :use ((:instance expt-weak-monotone (n (1+ n)) (m (expo x))))))))
+
+;kill
+(local
+ (defthm expo-unique-2-alt
+  (implies (and (rationalp x)
+;                (not (equal x 0))
+                (integerp n)
+                (> n (expo x)))
+           (> (expt 2 n) (abs x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expo abs)
+           :use (;(:instance expo-upper-bound)
+                 (:instance expt-weak-monotone (n (1+ (expo x))) (m n)))))))
+;kill
+;expensive?
+;n is a free var
+(defthmd expo-unique-eric
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (expo x) n))
+  :hints (("goal" :in-theory (disable expo abs)
+           :use ((:instance expo-unique-1)
+                 (:instance expo-unique-2)))))
+
+
+
+
+
+;could be even better if move hyps into the conclusion? (perhaps only when n is a constant?)
+; wow! this actually worked when the one above didn't!
+;reorder hyps
+(defthm expo-unique-eric-2
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (equal (expo x) n)
+                  t))
+  :hints (("goal" :in-theory (disable expo abs)
+           :use ((:instance expo-unique)))))
+
+;find a way to make this hit (EQUAL (+ I (EXPO (/ X))) -1) to (i.e., an expression containing one call to expo)
+(defthm expo-equality-reduce-to-bounds
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (expo x) n)
+                  (if (equal 0 x)
+                      (equal 0 n)
+                    (and (<= (expt 2 n) (abs x))
+                         (< (abs x) (expt 2 (1+ n)))))))
+  :hints (("goal" :in-theory (disable expo abs)
+           :cases ((equal x 0)))))
+
+(in-theory (disable expo-equality-reduce-to-bounds))
+
+#|
+(in-theory (enable expo-minus))
+
+(defthm expo-minus-const-mult
+  (implies (and (syntaxp (and (quotep k) (< (cadr k) 0))))
+           (equal (EXPO (* k X)) 
+                  (EXPO (* -1 k X)))))
+|#
+
+;combine this with others? ;BOZO delete comments?
+(DEFTHM EXPO-SHIFT-constant
+  (IMPLIES (AND (syntaxp (quotep k))
+                (equal k (expt 2 (expo k))) ; use power2p?
+                (RATIONALP X)
+                (NOT (equal X 0)))
+           (equal (EXPO (* k X))
+              (+ (expo k) (EXPO X))))
+  :HINTS (("Goal" :in-theory (disable  )
+           :USE (:instance expo-shift (n (expo k))))))
+
+;(local (in-theory (enable power2p)))
+
+
+#|
+(defthm expo-x+2**k-eric
+    (implies (and (syntaxp (quotep k))
+                  (power2p k)
+		  (rationalp x)
+		  (<= 0 x)
+		  (< (expo x) (expo k)))
+	     (equal (expo (+ k x))
+		    (expo k)))
+    :hints (("Goal" :in-theory (disable expo-x+2**k)
+             :use (:instance expo-x+2**k (k (expo k))))))
+
+|#
+
+
+
+;these next 2 can be very expensive since (expt 2 k) gets calculated!
+
+;restrict to constants k?
+(defthm expo-comparison-rewrite-to-bound
+  (implies (and (syntaxp (not (power2-syntaxp x))) ;helps prevent loops
+                (case-split (not (equal 0 x)))
+                (integerp k) ;gen?
+                (case-split (rationalp x))
+                )
+           (equal (< (expo x) k)
+                  (< (abs x) (expt 2 k))))
+  :otf-flg t
+  :hints (("Goal" :use ((:instance expo-monotone (x (expt 2 k)) (y x))
+                        (:instance expo-monotone (y (expt 2 k)) (x x))))
+          )
+  )
+
+;restrict to constants k?
+(defthm expo-comparison-rewrite-to-bound-2
+  (implies (and (syntaxp (not (power2-syntaxp x))) ;helps prevent loops
+                (case-split (not (equal 0 x)))
+                (integerp k) ;gen?
+                (case-split (rationalp x))
+                )
+           (equal (< k (expo x))
+                  (<= (expt 2 (+ k 1)) (abs x))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)
+           :use ((:instance expo-monotone (x (expt 2 (+ 1 k))) (y x))
+                 (:instance expo-monotone (y (expt 2 (+ 1 k))) (x x))))
+          )
+  )
+
+
+
+
+;have a better version but need this for the proofs
+
+
+
+#| true only for powers of 2
+(defthm expo-/
+  (equal (expo (/ x))
+         (- (expo x)))
+  :hints (("Goal" :in-theory (enable expo)))
+)
+|#
+
+
+#| these might be nice:
+(defthm expo-/-notpower2p
+  (implies (and (not (equal x 0))
+                (rationalp x)
+                (not (power2p x)))
+           (equal (expo (/ x))
+                  (+ -1 (- (expo x)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expo expt-split  expo-equality-reduce-to-bounds)
+                              '())))
+)
+
+|#
+
+
+
+
+  
+
+
+
+
+(defthm expo-bound-eric
+  (implies (case-split (rationalp x))
+           (and (equal (< (* 2 (expt 2 (expo x))) x)
+                       nil)
+                (equal (< x (* 2 (expt 2 (expo x))))
+                       t)
+                (equal (< (expt 2 (+ 1 (expo x))) x)
+                       nil)
+                (equal (< x (expt 2 (+ 1 (expo x))))
+                       t)
+                ))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '())
+           :use expo-upper-bound)))
+
+
+
+;if this loops, disable all the expo-shift rules!
+(defthm expo-/-notpower2p
+  (implies (and (not (power2p x))
+                (case-split (not (equal x 0)))
+                (<= 0 x)
+                (case-split (rationalp x))
+                )
+           (equal (expo (/ x))
+                  (+ -1 (- (expo x)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable power2p; expo
+                                      expt-split expo-equality-reduce-to-bounds)
+                              '( power2p-shift expo-shift-constant)))))
+
+(in-theory (disable expo-/-notpower2p))
+
+(in-theory (disable power2p-shift-special))
+
+
+#|
+(defthm power2p-quotient
+  (implies (and (syntaxp (power2-syntaxp y))
+                (case-split (power2p y)) ;this should be true if the syntaxp hyp is satisfied
+                )
+           (equal (power2p (/ y x))
+                  (power2p x)))
+  :hints (("Goal" :in-theory (disable power2p)
+           :use (:instance power2p-shift (x (/ x))))))
+
+(defthm power2p-quotient-2
+  (implies (and (syntaxp (power2-syntaxp y))
+                (case-split (power2p y)) ;this should be true if the syntaxp hyp is satisfied
+                )
+           (equal (power2p (/ x y))
+                  (power2p x)))
+  :hints (("Goal" :in-theory (disable power2p POWER2P-/)
+           :use (:instance power2p-shift (y (/ y))))))
+|#
+
+#|
+(include-book
+ "abs")
+
+(defthm expo-of-x-minus-1-nopower2-case
+  (implies (and (integerp x)
+                (not (power2p x))
+                (<= 0 x) ;gen and add abs phrasing?
+                )
+           (equal (expo (+ -1 x))
+                  (expo x)))
+  :hints (("Goal" :use (:instance expo-unique
+                                 (x (+ -1 x))
+                                 (n (expo x)))
+           :in-theory (enable power2p))))
+
+
+
+
+(defthm expo-of-x-minus-1-power2-case
+  (implies (and (integerp x) ;drop?
+                (power2p x)
+                (case-split (< 1 x)) ;gen?
+                )
+           (equal (expo (+ -1 x))
+                  (+ -1 (expo x))))
+  :hints (("Goal" :use (:instance expo-unique
+                                  (x (+ -1 x))
+                                  (n (+ -1 (expo x))))
+           :in-theory (enable power2p expt-split))))
+
+
+;add more conclusions.  is (expt 2...) < or <= n?
+(defthm expt-expo-bound-1
+  (implies (and (integerp n)
+                (case-split (< 0 n))
+                )
+           (equal (< N (EXPT 2 (EXPO (+ -1 N))))
+                  nil))
+  :otf-flg t
+  :hints (("Goal" :cases ((power2p n))
+           :in-theory (enable expt-split)))
+  )
+
+|#
+
+(defthm expt-compare
+  (implies (and (syntaxp (and (power2-syntaxp lhs)
+                              (power2-syntaxp rhs)))
+                (case-split (power2p lhs))
+                (case-split (power2p rhs)))
+           (equal (< lhs rhs)
+                  (< (expo lhs) (expo rhs))))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable power2p-rewrite ; expt-strong-monotone
+                                      )
+                              '( ;EXPO-COMPARISON-REWRITE-TO-BOUND-1
+                                EXPO-COMPARISON-REWRITE-TO-BOUND-2 ;yuck
+                                power2p-shift))
+           :use (:instance expt-strong-monotone (m (expo lhs)) (n (expo rhs)))
+           ))
+  :otf-flg t
+  )
+
+
+(defthm expt-compare
+  (implies (and (syntaxp (and (power2-syntaxp lhs)
+                              (power2-syntaxp rhs)))
+                (case-split (power2p lhs))
+                (case-split (power2p rhs)))
+           (equal (< lhs rhs)
+                  (< (expo lhs) (expo rhs))))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable power2p-rewrite expt)
+                              '( power2p-shift))
+           :use (:instance expt-strong-monotone (m (expo lhs)) (n (expo rhs)))
+           ))
+  :otf-flg t
+  )
+
+(DEFTHM EXPT-COMPARE-equal
+  (IMPLIES (AND (syntaxp (and (power2-syntaxp lhs)
+                              (power2-syntaxp rhs)))
+                (case-split (power2p lhs)) ;if the syntacp hyp goes through we expect these to also
+                (case-split (power2p rhs))
+                )
+           (equal (equal lhs rhs)
+                  (equal (expo lhs) (expo rhs))))
+  :hints (("Goal"  :in-theory (set-difference-theories
+                               (enable power2p-rewrite expt)
+                               '( POWER2P-SHIFT))
+
+           ))
+)
+
+
+(defthm power2-integer
+  (implies (and (syntaxp (power2-syntaxp x))
+                (force (power2p x)))
+           (equal (integerp x)
+                  (<= 0 (expo x))))
+  :hints (("Goal" :use (:instance expt2-integer (i (expo x)))
+             :in-theory (set-difference-theories
+                         (enable power2p-rewrite expt)
+                         '( POWER2P-SHIFT expt2-integer)))))
+
+#| old stuff
+(defthm a14
+  (and
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= 0 j))
+            (and (integerp (expt i j))
+                 (<= 0 (expt i j))))
+   (implies (and (rationalp i)
+                 (not (equal i 0)))
+            (not (equal (expt i j) 0))))
+  :hints
+  (("Goal" :in-theory (enable expt)))
+  :rule-classes
+  ((:type-prescription
+    :corollary
+    (implies (and (integerp i)
+                  (<= 0 i)
+                  (<= 0 j))
+             (and (integerp (expt i j))
+                  (<= 0 (expt i j)))))
+   (:type-prescription
+    :corollary
+    (implies (and (rationalp i)
+                  (not (equal i 0)))
+             (not (equal (expt i j) 0))))))
+
+
+
+
+(defthm a16
+  (equal (expt (* a b) i)
+         (* (expt a i) (expt b i)))
+  :hints
+  (("Goal" :in-theory (enable distributivity-of-expt-over-*))))
+(defthm my-exponents-add
+  (implies (and (not (equal 0 r))
+                (acl2-numberp r)
+                (integerp i)
+                (integerp j))
+           (equal (expt r (+ i j))
+                  (* (expt r i)
+                     (expt r j))))
+  :rule-classes nil)
+
+|#
+
+
+#|
+(defthm expt-2-reduce-leading-constant-gen
+  (implies (case-split (integerp (+ k d)))
+           (equal (expt 2 (+ k d))
+                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d)))))
+  :otf-flg t
+   :hints (("Goal" :in-theory (set-difference-theories
+                                (enable; fl
+)
+                                '(expt-split mod))
+             :use (:instance expt-split (r 2) (i (fl k)) (j (+ (mod k 1) d))))))
+|#
+
+
+
+(defthm expo-shift-16
+  (implies (and (case-split (integerp n))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                )
+           (equal (expo (* (/ (expt 2 n)) x))
+                  (+ (- n) (expo x))))
+
+           
+  )
+
+(defthm expo-lower-bound-2
+  (implies (and (case-split (rationalp x))
+                (case-split (<= 0 x))
+                (case-split (not (equal x 0)))
+                )
+           (<= (expt 2 (expo x)) x))
+  :rule-classes :linear
+)
+
+(defthmd expo-upper-bound-tight
+  (implies (integerp x)
+           (<= (abs x) (+ -1 (expt 2 (1+ (expo x))))))
+  :hints (("Goal" :use (expo-upper-bound)))
+  :rule-classes :linear)
+
+;BOZO simplify the conclusion?
+(defthm expo-x+a*2**k
+  (implies (and (< (expo x) k)
+                (< 0 a)
+                (integerp a)
+                (case-split (<= 0 x))
+                (case-split (integerp k))
+                (case-split (rationalp x))
+                )
+           (equal (expo (+ x (* a (expt 2 k))))
+                  (expo (* a (expt 2 k)))))
+  :hints (("goal" :in-theory (e/d (expt-split) ( ;EXPO-BOUND-ERIC
+                                                 ;CANCEL-IN-PRODS-<-2-OF-2-WITH-2-OF-3
+                                                 ))
+           :use ((:instance expo-lower-bound (x (* a (expt 2 k))))
+                 (:instance expo-upper-bound-tight (x a))
+                 (:instance expo-unique 
+                            (x (+ x (* a (expt 2 k)))) (n (expo (* a (expt 2 k))))))))
+  :otf-flg t)
+
+(defthm expo-x+2**k
+    (implies (and (< (expo x) k)
+                  (<= 0 x)
+                  (case-split (integerp k))
+		  (case-split (rationalp x))
+		  )
+	     (equal (expo (+ x (expt 2 k)))
+		    k))
+  :hints (("Goal" :use (:instance  expo-x+a*2**k (a 1)))))
+
+
+
+
+
+(local (defthmd between-0-and-1-means-not-integerp
+  (implies (and (< 0 x) (< x 1))
+           (not (integerp x)))))
+
+(defthm expo-times-2-not-a-factor
+  (implies (rationalp x)
+           (equal (integerp (* 1/2 x (/ (expt 2 (expo x)))))
+                  (equal 0 x)))
+  :hints (("Goal" :in-theory (enable expt-minus expt-split)
+           :use ( expo-lower-bound
+                  expo-upper-bound
+                  (:instance  BETWEEN-0-AND-1-MEANS-NOT-INTEGERP
+                              (x  (* 1/2 (abs X) (EXPT 2 (* -1 (EXPO X))))))))))
+
+(local (defthmd between-1-and-2-means-not-integerp
+  (implies (and (< 1 x) (< x 2))
+           (not (integerp x)))))
+
+(local (defthm expo-a-factor-means-power2-helper
+  (implies (and (<= 0 x)
+                (rationalp x))
+           (equal (integerp (* x (/ (expt 2 (expo x)))))
+                  (or (equal 0 x)
+                      (power2p (abs x)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (e/d( expt-minus expt-split power2p-rewrite) ( EXPO-BOUND-ERIC))
+           :use (expo-lower-bound
+                 expo-upper-bound
+                 (:instance BETWEEN-1-AND-2-MEANS-NOT-INTEGERP (x (* x (/ (expt 2 (expo x)))))))))))
+
+(defthm expo-a-factor-means-power2
+  (implies (acl2-numberp x)
+           (equal (integerp (* x (/ (expt 2 (expo x)))))
+                  (or (equal 0 x)
+                      (power2p (abs x)))))
+  :hints (("Goal" :in-theory (enable expo-minus-eric)
+           :use ((:instance  expo-a-factor-means-power2-helper (x x))
+                        (:instance  expo-a-factor-means-power2-helper (x (- x)))))))
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/expo.lisp acl2-6.3/books/rtl/rel9/arithmetic/expo.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/expo.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/expo.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,545 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;This book contains theorems mixing expt and expo and power2p.
+;It is the top-level book for reasoning about powers of two.
+;Eric believes that the function EXPO is intimately connected to EXPT (they are inverses).  Some of his
+;theorems about EXPT require EXPO for their statements.
+
+;Todo: 
+;1. Write a more general version of EXPO that isn't tied to using 2 as the base?
+;2. Use more consistent names for lemmas, including using expt2 for lemmas which only apply when the r paramater
+;to expt is 2.
+
+(include-book "ground-zero")
+(include-book "negative-syntaxp")
+(include-book "power2p")
+(local (include-book "expo-proofs"))  ;there's now a separate expo-proofs book !!!
+;ad local in-thoery nil
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+;probably get this anyway when we define expo
+(defthm expo-integer-type
+  (integerp (expo x))
+  :rule-classes :type-prescription)
+
+;(:type-prescription expo) is no better than expo-integer-type and might be worse:
+(in-theory (disable (:type-prescription expo)))
+
+(defthm expo-of-not-rationalp
+  (implies (not (rationalp x))
+           (equal (expo x) 0)))
+
+
+;be careful: if you enable expo, the x<0 case of expo can loop with expo-minus
+;(see expo-minus-invariant)
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+;rename?
+(defthm expo-minus-eric
+  (implies (syntaxp (negative-syntaxp x))
+           (equal (expo x) 
+                  (expo (* -1 x)))))
+
+
+(theory-invariant
+ (not (and (or (active-runep '(:rewrite expo-minus))
+               (active-runep '(:rewrite expo-minus-eric)))
+           (active-runep '(:definition expo))))
+ :key expo-minus-invariant)
+
+;Eric doesn't like the presence of ABS here...
+(defthm expo-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthm expo-lower-pos
+  (implies (and (< 0 x)
+                (rationalp x)
+                )
+           (<= (expt 2 (expo x)) x))
+  :rule-classes :linear)
+
+;make expo-lower-neg? expo-upper-neg? bad names? expo-lower-neg would really be an upper bound!
+
+(defthm expo-upper-bound
+  (implies (rationalp x)
+           (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-upper-pos
+  (implies (rationalp x)
+           (< x (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal n (expo x)))
+  :rule-classes ())
+
+;bad to have the abs there?
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y))
+                )
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+;BOZO. drop this in favor of expo-expt2?
+(defthmd expo-2**n
+  (implies (integerp n)
+           (equal (expo (expt 2 n))
+                  n)))
+
+;dont export?
+;like EXPO-2**N but better (now hypothesis-free)
+;This rule, together with expt-compare allows any comparison using <, >, <=, or >= of two terms which have the
+;form of powers of 2 to be rewritten to a claim about the exponents.  actually, we need a rule about (expo (/ <powerof2>))
+;can kill more specialized rules
+;use ifix?
+(defthm expo-expt2
+  (equal (expo (expt 2 i))
+         (if (integerp i)
+             i
+           0)))
+
+;Can loop with defn expo. See theory-invariant.
+;expo-half (and expo-double, sort of) makes the proof of expo-shift go through
+(defthm expo-half
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                )
+           (equal (expo (* 1/2 x))
+                  (+ -1 (expo x)))))
+
+(theory-invariant (incompatible (:rewrite expo-half)
+                                (:definition expo)
+                                )
+                  :key expo-half-loops-with-defn-expo)
+
+(theory-invariant (incompatible (:rewrite expo-double)
+                                (:definition expo)
+                                )
+                  :key expo-double-loops-with-defn-expo)
+
+
+
+;Can loop with defn expo.  See the theory-invariant.
+(defthm expo-double
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                )
+           (equal (expo (* 2 x))
+                  (+ 1 (expo x)))))
+
+(defthm expo-x+a*2**k
+  (implies (and (< (expo x) k)
+                (< 0 a)
+                (integerp a)
+                (case-split (<= 0 x))
+                (case-split (integerp k))
+                (case-split (rationalp x))
+                )
+           (equal (expo (+ x (* a (expt 2 k))))
+                  (expo (* a (expt 2 k))))))
+
+;special case of the above
+(defthm expo-x+2**k
+    (implies (and (< (expo x) k)
+                  (<= 0 x)
+                  (case-split (integerp k))
+		  (case-split (rationalp x))
+		  )
+	     (equal (expo (+ x (expt 2 k)))
+		    k)))
+
+
+
+(defthmd expo>=
+  (implies (and (<= (expt 2 n) x)
+                (rationalp x)
+                (integerp n)
+                )
+           (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+  (implies (and (< x (* 2 (expt 2 n)))
+                (< 0 x)
+                (rationalp x)
+                (integerp n)
+                )
+           (<= (expo x) n))
+  :rule-classes :linear)
+
+(defthm expo-of-integer-type
+  (implies (integerp x)
+           (and (integerp (expo x)) ;included to make the conclusion a "type" fact
+                (<= 0 (expo x))))
+  :rule-classes ((:type-prescription :typed-term (expo x))))
+
+;!! rc?
+;actually, maybe we should rewrite the conclusion instead? <-- how?
+(defthm expo-of-integer
+  (implies (integerp x)
+           (<= 0 (expo x)))
+  :rule-classes (:rewrite))
+
+
+
+;expensive?
+;n is a free var
+;gotta get rid of the abs if we hope to bind n appropriately
+(defthmd expo-unique-eric
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (expo x) n)))
+
+
+
+
+
+;could be even better if move hyps into the conclusion? (perhaps only when n is a constant?)
+; wow! this actually worked when the one above didn't! (probably because this one doesn't have a free var)
+;expensive??
+(defthm expo-unique-eric-2
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (equal (expo x) n)
+                  t))
+)
+
+;find a way to make this hit (EQUAL (+ I (EXPO (/ X))) -1) to (i.e., an expression containing one call to expo)
+(defthmd expo-equality-reduce-to-bounds
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (expo x) n)
+                  (if (equal 0 x)
+                      (equal 0 n)
+                    (and (<= (expt 2 n) (abs x))
+                         (< (abs x) (expt 2 (1+ n))))))))
+
+
+
+
+
+
+;these next 2 can be very expensive since (expt 2 k) gets calculated!  Meh.
+
+;disable??
+;restrict to constants k?
+(defthm expo-comparison-rewrite-to-bound
+  (implies (and (syntaxp (not (power2-syntaxp x))) ;helps prevent loops
+                (case-split (not (equal 0 x)))
+                (integerp k) ;gen?
+                (case-split (rationalp x))
+                )
+           (equal (< (expo x) k)
+                  (< (abs x) (expt 2 k)))))
+;disable?
+;restrict to constants k?
+(defthm expo-comparison-rewrite-to-bound-2
+  (implies (and (syntaxp (not (power2-syntaxp x))) ;helps prevent loops
+                (case-split (not (equal 0 x)))
+                (integerp k) ;gen?
+                (case-split (rationalp x))
+                )
+           (equal (< k (expo x))
+                  (<= (expt 2 (+ k 1)) (abs x)))))
+
+
+
+(defthm power2p-expt2-i
+  (power2p (expt 2 i)))
+
+
+;have a better version but need this for the proofs - huh?
+;BOZO, so don't export this! ??
+(defthmd expo-expt2-inverse
+  (equal (expo (/ (expt 2 i)))
+         (if (integerp i)
+             (- i)
+           0)))
+
+;why disabled?
+(defthmd power2p-shift-special
+  (equal (power2p (* (expt 2 i) x))
+         (power2p x)))
+
+(defthmd expo-/-power2p-1
+  (equal (expo (/ (expt 2 i)))
+         (- (expo (expt 2 i)))))
+
+;drop, since we have the one below?
+(defthmd expo-/-power2p
+  (implies (power2p x)
+           (equal (expo (/ x))
+                  (- (expo x)))))
+
+;restrict to only x's which look like powers of 2
+(defthm expo-/-power2p-alt
+  (implies (and (syntaxp (power2-syntaxp x))
+                (force (power2p x)))
+           (equal (expo (/ x))
+                  (- (expo x)))))
+
+
+
+
+
+(defthm expo-bound-eric
+  (implies (case-split (rationalp x))
+           (and (equal (< (* 2 (EXPT 2 (EXPO X))) X)
+                       nil)
+                (equal (< X (* 2 (EXPT 2 (EXPO X))))
+                       t)
+                (equal (< (EXPT 2 (+ 1 (EXPO X))) X)
+                       nil)
+                (equal (< X (EXPT 2 (+ 1 (EXPO X))))
+                       t)
+                )))
+
+
+
+;if this loops, disable all the expo-shift rules!
+(defthmd expo-/-notpower2p
+  (implies (and (not (power2p x))
+                (case-split (not (equal x 0)))
+                (<= 0 x)
+                (case-split (rationalp x))
+                )
+           (equal (expo (/ x))
+                  (+ -1 (- (expo x))))))
+
+(defthmd power2p-rewrite
+  (equal (power2p x)
+         (equal x (expt 2 (expo x)))))
+
+;rename to powers-of-2-less-than?
+;An inequality between powers of two can be rewritten to an inequality about their exponents...
+;this allows LHS or RHS (or both) to be a gross term like, e.g., this: (* 2 (* (expt 2 j) (expt 2 (+ k (* -1 j)))))
+;we expect the EXPO introduced in the conclusion go away (it will crawl to the leaves of RHS and LHS, each of which is
+;either a constant or of the form (EXPT 2 I).
+(defthm expt-compare
+  (implies (and (syntaxp (and (power2-syntaxp lhs)
+                              (power2-syntaxp rhs)))
+                (case-split (power2p lhs)) ;use force?
+                (case-split (power2p rhs)))
+           (equal (< lhs rhs)
+                  (< (expo lhs) (expo rhs))))
+
+  :otf-flg t
+  )
+
+(defthm expt-compare-equal
+  (implies (and (syntaxp (and (power2-syntaxp lhs)
+                              (power2-syntaxp rhs)))
+                (case-split (power2p lhs)) ;if the syntaxp hyp goes through we expect these to also
+                (case-split (power2p rhs)) ;use force?
+                )
+           (equal (equal lhs rhs)
+                  (equal (expo lhs) (expo rhs)))))
+
+
+;this can be a powerful rule...
+;We expect the call to EXPO in the conclusion to go away (it should be pushed to the leaves...)
+(defthm power2-integer
+  (implies (and (syntaxp (power2-syntaxp x))
+                (force (power2p x)))
+           (equal (integerp x)
+                  (<= 0 (expo x)) 
+                  )))
+
+
+
+;BOZO dup with expo-lower-pos
+(defthm expo-lower-bound-2
+  (implies (and (case-split (rationalp x))
+                (case-split (<= 0 x))
+                (case-split (not (equal x 0)))
+                )
+           (<= (expt 2 (expo x)) x))
+  :rule-classes :linear)
+
+
+;we need these next 2, even though we have expt-shift-general
+;why did i say the above??
+;BOZO rename params.  put ifix around i
+(defthm expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x))
+                  (+ n (expo x)))))
+
+(defthm expo-shift-alt
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* x (expt 2 n)))
+                  (+ n (expo x)))))
+
+(defthm expo-shift-16
+  (implies (and (case-split (integerp n))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                )
+           (equal (expo (* (/ (expt 2 n)) x))
+                  (+ (- n) (expo x)))))
+
+;BOZO combine this with others?
+(defthm expo-shift-constant
+  (implies (and (syntaxp (quotep k))
+                (equal k (expt 2 (expo k))) ; use power2p?
+                (rationalp x)
+                (not (equal x 0)))
+           (equal (expo (* k x))
+                  (+ (expo k) (expo x)))))
+
+(include-book "common-factor-defuns")
+
+;An "expt-factor" has the shape (expt 2 i) or the shape (/ (expt 2 i))
+;does not consider constants to be "expt-factors", so we have expo-shift-constant
+(defun get-expt-factors (factor-list)
+  (declare (xargs :guard (true-listp factor-list)))
+  (if (endp factor-list)
+      nil
+    (let* ((factor (car factor-list)))
+      (if (and (consp factor)
+               (or (and (equal (car factor) 'expt)
+                        (consp (cdr factor))
+                        (equal (cadr factor) ''2))
+                   (and (equal (car factor) 'unary-/)
+                        (consp (cdr factor))
+                        (consp (cadr factor))
+                        (equal (caadr factor) 'expt)
+                        (consp (cdadr factor))
+                        (equal (cadadr factor) ''2))))
+          (cons factor (get-expt-factors (cdr factor-list)))
+        (get-expt-factors (cdr factor-list))))))
+
+
+(defun find-common-expt-factors-to-cancel (expr)
+  (declare (xargs :guard (and (pseudo-termp expr))))
+  (get-expt-factors
+   (remove-cancelling-factor-pairs
+    (find-common-factors-in-sum-of-products expr))))
+
+(defund bind-k-to-common-expt-factors (expr)
+  (declare (xargs :guard-hints (("Goal" :use (:instance remove-cancelling-factor-pairs-preserves-true-listp
+                                                        (l (MY-INTERSECTION-EQUAL (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS LHS)
+                                                                                  (FIND-COMMON-FACTORS-IN-SUM-OF-PRODUCTS RHS))))))
+                  :guard (and (pseudo-termp expr))))
+  (let* ((common-factor-list (find-common-expt-factors-to-cancel expr)))
+    (if (endp common-factor-list)
+        nil
+      (list (cons 'k (make-product-from-list-of-factors common-factor-list))))))
+
+
+
+(defthm expo-shift-general
+  (implies (and (bind-free (bind-k-to-common-expt-factors x) (k))
+                (syntaxp (not (equal k x))) ;helps prevent loops
+                (force (power2p k))
+                (case-split (rationalp x)) ;if not, we want to know about it
+                (case-split (not (equal x 0))) ;if x=0 we can simplify further
+                )
+           (equal (expo x)
+                  (+ (expo k) (expo (* (/ k) x)))))
+  :hints (("goal" :in-theory (enable power2p-rewrite)
+           :use (:instance expo-shift (n (- (expo k)))))))
+
+
+;BOZO think about this.  expo-shift-general depends on combining (expt 2 i) and (/ (expt 2 i)) but if we
+;rewrite (/ (expt 2 i)) to (expt 2 (* -1 i)) then this may not happen...  (We don't have a complete set of
+;rules for gathering expt terms, especially in cases like this: (* (expt 2 i) x y w z (expt 2 (* -1 i)))
+;So currently one cannot have both expt-inverse and expt-shift enabled...  
+;We could address this by writing a rule which will always gather expt
+;terms in a product, even if other terms intervene between them.  If we are guaranteed to always do all
+;gathering, then expo-shift-general should work okay (i.e., shouldn't loop).
+;Man, I can't figure out how to write an easy bind-free rule to do all gathering. Even if we walk through the
+;term and decide what to cancel out, e.g., the (expt 2 i) and the (expt 2 (* -1 i)) in  
+;  (* (expt 2 i) x y w z (expt 2 (* -1 i)))
+;we can't just multiply through by their inverses (which would be the standard way to cancel something in a
+;product) because the inverting would get sucked in by expt-inverse.  So an attempt to cancel by multiplying
+;through by (/ (expt 2 i)) and (/ (expt 2 (* -1 i))) would be the same as multipying through by (expt 2 (* -1 i)) 
+;and (expt 2 (* -1 (* -1 i))) = (expt 2 i), respectively.  Yuck.  Maybe we can use some sort of bubble-down
+;strategy like Rober Krug does.
+;It's unfortunate that we don't get any expo-shifting if we are gathering exponents...
+(theory-invariant (incompatible (:rewrite expo-shift-general)
+                                (:rewrite expt-inverse)
+                                )
+                  :key expo-shift-general-can-loop-with-expt-inverse)
+
+
+
+(defthm expo-times-2-not-a-factor
+  (implies (rationalp x)
+           (equal (integerp (* 1/2 x (/ (expt 2 (expo x)))))
+                  (equal 0 x))))
+
+(defthm expo-a-factor-means-power2
+  (implies (acl2-numberp x)
+           (equal (integerp (* x (/ (expt 2 (expo x)))))
+                  (or (equal 0 x)
+                      (power2p (abs x))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/expt-proofs.lisp acl2-6.3/books/rtl/rel9/arithmetic/expt-proofs.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/expt-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/expt-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,866 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;this book contains very basic expt stuff (i couldn't include expt.lisp in basic.lisp because of a circular dependency)
+
+;todo: 
+;make a separate expt-proofs book
+;there's a distinction between expt and expt-2 rules
+;make consistent names:  expt vs. expt2   
+;think about the rules to combine and split exponents
+;generalize some of these rules to be about expt with any base (not just 2)
+
+;remove this?
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "ground-zero")
+(include-book "negative-syntaxp")
+(local (include-book "predicate"))
+(local (include-book "fp2"))
+(local (include-book "numerator"))
+(local (include-book "denominator"))
+(local (include-book "integerp"))
+(local (include-book "fl")) ;or use floor?
+(local (include-book "arith2"))
+
+(encapsulate 
+ ()
+ (local (include-book "../../../arithmetic/top"))
+ (defthm a16
+   (equal (expt (* a b) i)
+          (* (expt a i) (expt b i)))
+   :hints
+   (("Goal" :in-theory (enable distributivity-of-expt-over-*))))
+
+;gen
+;split off the non-integer case
+;make an expt2-split?
+;instead of i1 and i2, use i and j?
+ (defthmd expt-split
+   (implies (and (integerp i)
+                 (integerp j)
+                 (case-split (acl2-numberp r)) ;(integerp r)
+                 (case-split (not (equal r 0)))
+                 )
+            (equal (expt r (+ i j))
+                   (* (expt r i) (expt r j))))
+   :hints (("Goal" :in-theory (enable expt)))
+   )
+ )
+
+(theory-invariant
+  (not (and (active-runep '(:rewrite expt-split))
+            (active-runep '(:rewrite a15))))
+  :key expt-split-invariant)
+
+(theory-invariant
+  (not (and (active-runep '(:rewrite expt-split))
+            (active-runep '(:definition expt))))
+  :key expt-split-invariant-2)
+
+
+;see also a14
+;generalize?  use arith books?
+(defthm expt-2-positive-rational-type
+  (and (rationalp (expt 2 i))
+       (< 0 (expt 2 i)))
+  :hints (("Goal" :in-theory (enable expt) ))
+  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
+
+;like a14?
+(defthm expt-2-positive-integer-type
+  (implies (<= 0 i)
+           (and (integerp (expt 2 i))
+                (< 0 (expt 2 i))))
+  :hints (("Goal" :in-theory (enable expt)))
+  :rule-classes (:type-prescription))
+
+;someday our rules may be better, but right now, ours only talk about when when the base is 2
+;(in-theory (disable (:TYPE-PRESCRIPTION EXPT)))
+
+
+;the rewrite rule counterpart to expt-2-positive-integer-type
+(defthm expt-2-integerp
+  (implies (<= 0 i)
+           (integerp (expt 2 i))))
+
+(defthm expt-2-type-linear
+  (implies (<= 0 i)
+           (<= 1 (expt 2 i)))
+  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
+
+
+
+;when you disable either of the two rules below, you might want to also disable expt-compare?
+;took these rules out of :rewrite since we have expt-compare?
+;are these bad :linear rules because they have free vars?
+
+(encapsulate
+ ()
+ (local (defthm expt-strong-monotone-1
+          (implies (and (integerp n)
+                        (integerp k)
+                        (> k 0))
+                   (< (expt 2 n) (expt 2 (+ n k))))
+          :hints (("Goal" :in-theory (enable expt
+                                             )))
+          :rule-classes ()))
+
+ (defthmd expt-strong-monotone
+   (implies (and (integerp n)
+                 (integerp m))
+            (equal (< (expt 2 n) (expt 2 m))
+                   (< n m)))
+   :hints (("Goal" :use ((:instance expt-strong-monotone-1 (k (- m n)))
+                         (:instance expt-strong-monotone-1 (k (- n m)) (n m))
+                         )))))
+
+;improve to handle i non-integer?
+(defthm expt2-integer
+  (implies (case-split (integerp i))
+           (equal (integerp (expt 2 i))
+                  (<= 0 i)))
+  :hints (("Goal" :use (:instance expt-strong-monotone (n i) (m 0)))))
+
+;trying :match-free :all
+;why disabled?
+(defthmd expt-strong-monotone-linear
+  (implies (and (< n m)
+                (case-split (integerp n))
+                (case-split (integerp m))
+                )
+           (< (expt 2 n) (expt 2 m)))
+  :rule-classes ((:linear :match-free :all))
+  :hints (("Goal" :use expt-strong-monotone)))
+
+;why disabled?
+(defthmd expt-weak-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (<= (expt 2 n) (expt 2 m))
+		  (<= n m)))
+  :hints (("Goal" :use (expt-strong-monotone
+			(:instance expt-strong-monotone (m n) (n m))))))
+
+;disabled because of the free var
+;but is occasionally helpful
+;make linear?
+;BOZO rename params?
+;trying :match-free :all
+(defthmd expt-weak-monotone-linear
+  (implies (and (<= n m)
+                (case-split (integerp n))
+                (case-split (integerp m)))
+           (<= (expt 2 n) (expt 2 m)))
+  :rule-classes ((:linear :match-free :all))
+  :hints (("Goal" :use (expt-strong-monotone
+			(:instance expt-strong-monotone (m n) (n m))))))
+
+;generalize? rewrite (< (expt 2 i) k) to a comparison of (expt 2 i) and the greatest power of 2 <= k
+;is this what expt-compare does?
+(defthmd expt-between-one-and-two
+  (implies (and (<= 1 (expt 2 i))
+                (< (expt 2 i) 2))
+           (equal (expt 2 i) 1))
+  :hints (("goal" 
+           :in-theory (enable expt zip))
+          ("subgoal *1/7" :use (:instance expt-weak-monotone (n (+ i 1)) (m 0)))))
+
+
+
+;We could disable this if it causes problems (but it seems okay).
+;should always use case-split n hyps that say exponents are integers
+(defthm expt-with-i-non-integer
+  (implies (not (integerp i))
+           (equal (expt r i)
+                  1))
+  :hints (("Goal" :in-theory (enable expt))))
+
+(defthmd expt-minus-helper
+  (equal (expt r (* -1 i))
+         (/ (expt r i)))
+  :otf-flg t
+  :hints (("Goal" :cases ((integerp i) (and (not (integerp i)) (acl2-numberp i)))
+           :in-theory (enable expt))))
+
+;BOZO disable or enable by default?
+;Loops with expt-inverse. How do we want to handle this??
+;I'd rather have the inverting done outside EXPT since most rules don't look inside EXPT.
+;This rule can be said to scatter exponents...
+(defthmd expt-minus
+  (implies (syntaxp (negative-syntaxp i))
+           (equal (expt r i)
+                  (/ (expt r (* -1 i)))))
+  :hints (("Goal" :in-theory (enable expt-minus-helper
+                                     expt-split))))
+
+(local (in-theory (enable expt-minus)))
+
+;This can loop with expt-minus (see theory-invariant).
+(defthmd expt-inverse
+  (equal (/ (expt 2 i))
+         (expt 2 (* -1 i))))
+
+(theory-invariant
+  (not (and (active-runep '(:rewrite expt-minus))
+            (active-runep '(:rewrite expt-inverse))))
+  :key expt-minus-invariant)
+
+
+;could prove a rule for (expt (* -1 r) i) ... or maybe we have a rule for expt when r is a product...
+
+;rename to expt-gather? !
+;Note that this rule isn't enough to gather exponents in every situation.  For example, two factors, (expt 2 i)
+;and (expt 2 j), won't be gathered if there are intervening factors between them.
+;BOZO change param names
+(defthmd a15
+  (implies (and (rationalp i)
+                (not (equal i 0))
+                (integerp j1)
+                (integerp j2))
+           (and (equal (* (expt i j1) (expt i j2))
+                       (expt i (+ j1 j2)))
+                (equal (* (expt i j1) (* (expt i j2) x))
+                       (* (expt i (+ j1 j2)) x))))
+  :hints (("Goal" :in-theory (enable expt-split))))
+
+(defthm expt-r-0
+  (equal (expt r 0)
+         1)
+  :hints (("Goal" :in-theory (enable expt))))
+
+
+
+
+
+(defthm expt-0-i
+  (implies (and (case-split (integerp i))      ;since expt with a non-integer index is 1
+                (case-split (not (equal 0 i))) ;since (expt 0 0) is 1
+                )
+           (equal (expt 0 i)
+                  0))
+  :hints (("Goal" :in-theory (enable expt))))
+
+
+
+
+
+;==== A scheme for preventing massively expensive calls to expt =======
+
+#| When ACL2 encounters a function call with constant arguments, the simplifier just evaluates the function on
+those arguments.  However, calls of (expt r i) with huge i can be very expensive to compute.  (I suppose calls
+with huge r might be very expensive too, but r is almost always 2 in my work.)  The scheme below prevents
+(expt r i) from being evaluated when i is too large (but allows evaluation in the case of small i).
+
+|#
+
+(in-theory (disable (:executable-counterpart expt)))
+
+(set-compile-fns t)
+(defun expt-execute (r i) (expt r i))
+
+;Allows expt calls with small exponents to be computed  
+;You can change 1000 to your own desired bound.
+(defthm expt-execute-rewrite
+  (implies (and (syntaxp (and (quotep r) (quotep i) (< (abs (cadr i)) 1000))))
+           (equal (expt r i)
+                  (expt-execute r i))))
+
+
+#|
+The rules below are not complete, I proved them as needed to simplify terms like:
+(* x
+   (EXPT 2 1000001)
+   (/ (EXPT 2 1000000))
+   y)
+
+Note that we could just compute (EXPT 2 1000001) and (EXPT 2 1000000) but that would be very expensive.
+
+Perhaps we can make this into a complete theory, based on the observation that if a product contains two
+factors of the form (expt 2 k) of (/ (expt 2 k)), where k is a constant, those factors will be brought
+together because they are very close in the term order used order arguments to * (recall that unary-/ is
+ignored when we decide how to order arguments to *).  
+|#
+
+;this could be made more general (replace the lhs with its second arg...)
+(defthm expt2-constants-collect-special-1
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (rationalp y))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal  (* (EXPT 2 i1)
+                      (/ (EXPT 2 i2))
+                      y)
+                   (* (expt 2 (- i1 i2)) y)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '())))
+  )
+
+(defthm expt2-constants-collect-special-2
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal  (* (EXPT 2 i1)
+                      (/ (EXPT 2 i2))
+                      )
+                   (expt 2 (- i1 i2))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '())))
+  )
+
+(defthm expt2-constants-collect-special-4
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (rationalp y))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal (* (/ (EXPT 2 i2)) (EXPT 2 i1) y)
+                  (* (expt 2 (- i1 i2)) y)))
+  
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '()))))
+
+(defthm expt2-constants-collect-special-5
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal  (* (/ (EXPT 2 i2)) (EXPT 2 i1))
+                   (expt 2 (- i1 i2))))
+  
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '()))))
+
+
+
+;will this happen?
+(defthm expt2-constants-collect-special-6
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (rationalp x))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal  (* (EXPT 2 i2) x (EXPT 2 i1))
+                   (* (expt 2 (+ i1 i2)) x)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '()))))
+
+
+;whoa this one is sort of different... (it rewrites an equality)
+(defthm expt2-constants-collect-special-3
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (rationalp x))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal (equal (* x (EXPT 2 i1)) (EXPT 2 i2))
+                  (equal x (expt 2 (- i2 i1)))))
+  
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '())))
+)
+
+
+
+
+
+
+;==================================================================
+
+;expt-compare
+;handle constants as args?
+(defthm expt2-1-to-1
+  (implies (and (integerp i1)
+                (integerp i2))
+           (equal (equal (expt 2 i1) (expt 2 i2))
+                  (equal i1 i2)))
+  :hints (("Goal"
+           :use ((:instance expt-strong-monotone (n i1) (m i2))
+                 (:instance expt-strong-monotone (n i2) (m i1))))))
+
+
+
+
+
+
+
+;could gen? move hyps to concl?
+(defthm expt-even
+  (implies (and (< 0 i)
+                (case-split (integerp i))
+                )
+           (integerp (* 1/2 (expt 2 i))))
+  :hints (("goal" :in-theory (enable expt))))
+
+
+;generalize rules like this with a power2-syntaxp (not power2p!) ?
+;make conclusion an equality?
+(defthm expt-quotient-integerp
+  (implies (and (<= j i)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (integerp (* (expt 2 i) (/ (expt 2 j)))))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (e/d (expt-split) ( expt-2-integerp))
+           :use (:instance expt-2-positive-integer-type (i (- i j))))))
+
+(defthm expt-quotient-integerp-alt
+  (implies (and (<= j i)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (integerp (* (/ (expt 2 j)) (expt 2 i))))
+  :rule-classes (:rewrite :type-prescription))
+
+
+;is there a 2 term version?
+(defthm expt-prod-integer-3-terms
+  (implies (and (integerp n)
+                (<= 0 (+ i j))
+                (integerp i)
+                (integerp j)
+                )
+           (integerp (* (expt 2 i) (expt 2 j) n)))
+  :hints (("Goal" :in-theory (enable a15))))
+
+
+;drop these?
+;generalize to comparisons to any constant (any power of 2)?
+
+;bad name?
+
+(defthm expt2-inverse-integer
+  (implies (case-split (integerp i))
+           (equal (integerp (/ (expt 2 i)))
+                  (<= i 0)))
+  :hints (("Goal" :in-theory (disable expt2-integer)
+           :use (:instance expt2-integer (i (- i))))))
+
+;figure out a better solution to this problem
+;perhaps say if a term is a power of 2, then it's an integer iff its expo is >=0
+(defthm expt-prod-integer-3-terms-2
+  (implies (and (<= 0 (+ i (- j) (- l)))
+                (integerp i)
+                (integerp j)
+                (integerp l)
+                )
+           (integerp (* (expt 2 i) (/ (expt 2 j)) (/ (expt 2 l)))))
+  :hints (("Goal" :in-theory (set-difference-theories (enable a15 expt-inverse)
+                                                      '(expt-minus))))
+  )
+
+#| would be nice (use expt2-1-to-1)?
+(defthm expt2-equal-1
+  (implies (integerp i)
+           (equal (EQUAL (EXPT 2 i) 1)
+                  (equal i 0)))
+;  :rule-classes nil
+  :hints (("Goal" :in-theory (enable expt-split-rewrite)))
+)
+|#
+
+(defthm expt2-inverse-even
+  (implies (case-split (integerp i))
+           (equal (integerp (* 1/2 (/ (expt 2 i))))
+                  (<= (+ 1 i) 0)))
+  :otf-flg t
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '(expt2-integer  EXPT2-INVERSE-INTEGER))
+           :use (:instance expt2-integer (i (+ -1 (- i)))))))
+
+
+;loops with a15?
+; (expt (* 2 i)) was matching with (expt 2 0) (booo!) so I added the syntaxp hyp
+(defthmd expt-2-split-product-index
+  (implies (and (syntaxp (not (quotep i)))
+                (case-split (rationalp r))
+                (case-split (integerp i)))
+           (equal (expt r (* 2 i))
+                  (* (expt r i) (expt r i))))
+  :hints (("Goal" :in-theory (disable expt-split)
+           :use (:instance expt-split (i i) (j i)))))
+
+
+;linear?
+(defthm expt-bigger-than-i
+  (implies (integerp i)
+           (< i (expt 2 i)))
+  :hints (("Goal" :in-theory (enable expt)))
+  )
+
+;BOZO this might loop with expt-split
+;i'm not sure that this is a good rewrite anyway
+(defthmd expt-compare-with-double
+  (implies (and (integerp x)
+                (integerp i))
+           (equal (< (* 2 x) (expt 2 i))
+                  (< x (expt 2 (+ -1 i)))))
+  :hints (("Goal" :in-theory (enable expt-split))))
+
+;leave this disabled?
+(defthmd expt-2-reduce-leading-constant-gen
+  (implies (case-split (integerp (+ k d)))
+           (equal (expt 2 (+ k d))
+                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d)))))
+    :hints (("Goal" :in-theory (set-difference-theories
+                                (enable mod)
+                                '(expt-split))
+             :use (:instance expt-split (r 2) (i (fl k)) (j (+ (mod k 1) d))))))
+
+
+;handles the case when k isn't even an integer!
+;loops with a15!  add theory invariant....
+(defthmd expt-2-reduce-leading-constant
+  (implies (and (syntaxp (and (quotep k)
+                         (or (>= (cadr k) 1) (< (cadr k) 0))))
+                (case-split (integerp (+ k d)))
+                )
+           (equal (expt 2 (+ k d))
+                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d)))))
+    :hints (("Goal" :in-theory (set-difference-theories
+                                (enable)
+                                '(expt-split))
+             :use (expt-2-reduce-leading-constant-gen
+                   (:instance expt-split (r 2) (i (fl k)) (j (+ (mod k 1) d)))))))
+
+; BOZO better than a15?
+(defthmd expt-combine
+  (implies (and (case-split (rationalp r))
+                (case-split (not (equal r 0)))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (and (equal (* (expt r i1) (expt r i2))
+                       (expt r (+ i1 i2)))
+                (equal (* (expt r i1) (* (expt r i2) x))
+                       (* (expt r (+ i1 i2)) x))))
+  :hints (("goal" :in-theory (enable a15))))
+
+
+;remove since we have expt-compare?
+(defthm expt-with-small-n
+  (implies (<= n 0)
+           (<= (expt 2 n) 1))
+  :hints (("Goal" :use (:instance expt-weak-monotone (m 0)))) 
+  :rule-classes (:linear))
+
+
+#|
+(include-book
+ "factor-2")
+
+
+;which way do we want to do this?
+;disable later?
+;add a "can have a 2 multiplied in" hyp to this series?
+(defthm expt-2-combine-like-is
+  (implies (and (syntaxp (should-have-a-2-factor-multiplied-in i))
+                (integerp i))
+           (equal (* (expt 2 i) (expt 2 i))
+                  (expt 2 (* 2 i))))
+  :hints (("Goal" :in-theory (disable expt-split)
+           :use (:instance expt-split (r 2) (i i) (j i)))))
+
+(defthm expt-2-combine-like-is-3-and-4-of-6
+  (implies (and (syntaxp (should-have-a-2-factor-multiplied-in i))
+                (integerp i)
+                (rationalp a)
+                (rationalp b)
+                (rationalp c)
+                (rationalp d)
+                )
+           (equal (* a b (expt 2 i) (expt 2 i) c d )
+                  (* a b c d (expt 2 (* 2 i)))))
+  :hints (("Goal" :in-theory (disable expt-split)
+           :use (:instance expt-split (r 2) (i i) (j i)))))
+
+(defthm expt-2-combine-like-is-4-and-5-of-6
+  (implies (and (syntaxp (should-have-a-2-factor-multiplied-in i))
+                (integerp i)
+                (rationalp a)
+                (rationalp b)
+                (rationalp c)
+                (rationalp d)
+                )
+           (equal (* a b c (expt 2 i) (expt 2 i) d )
+                  (* a b c d (expt 2 (* 2 i)))))
+  :hints (("Goal" :in-theory (disable expt-split)
+           :use (:instance expt-split (r 2) (i i) (j i)))))
+
+
+
+(defthm expt-2-combine-like-is-inverted
+  (implies (and (syntaxp (should-have-a-2-factor-multiplied-in i))
+                (integerp i))
+           (equal (* (/ (EXPT 2 i))
+                     (/ (EXPT 2 i)))
+                  (/ (expt 2 (* 2 i)))))
+  :hints (("Goal" :in-theory (disable 
+                              expt-2-combine-like-is
+                              expt-split)
+           :use (:instance  expt-split (r 2) (i (* 1/2 i)) (j (* 1/2 i))))))
+
+|#
+
+
+
+
+
+
+
+#|
+(defthm expt-prod-integer-4-terms
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp l)
+                (<= 0 (+ i (- j) l))
+                (integerp n))
+           (integerp (* (expt 2 i) (/ (expt 2 j)) (expt 2 l) n)))
+  :hints (("Goal" :in-theory (set-difference-theories (enable a15 expt-inverse)
+                                                      '(expt-minus))))
+  )
+
+
+
+
+would be nice (use expt2-1-to-1)?
+(defthm expt2-equal-1
+  (implies (integerp i)
+           (equal (EQUAL (EXPT 2 i) 1)
+                  (equal i 0)))
+;  :rule-classes nil
+  :hints (("Goal" :in-theory (enable expt-split)))
+)
+
+
+;remove?
+;actually, maybe this is good whether we are scattering or gathering...
+;bad name?
+;in general, are there rules which are good for scattering and for gathering?
+(defthm expt-simp
+  (implies (integerp x)
+           (equal (* 2 (EXPT 2 (+ -1 x)))
+                  (expt 2 x)))
+  :hints (("Goal" :use (:instance a15 (i 2) (j1 1) (j2 (+ -1 x))))))
+
+
+(defthmd expt-next
+  (implies (and (integerp i1)
+                (integerp i2)
+                (< (expt 2 i1) (expt 2 i2)))
+           (<= (expt 2 i1) (expt 2 (+ -1 i2)))))
+
+
+
+|#
+
+
+(local (include-book "even-odd"))
+
+;move? make fw-chaining rule?
+(defthmd even-not-equal-odd
+  (implies (and (evenp x)
+                (oddp y))
+           (not (equal x y)))
+  :hints (("Goal" :in-theory (enable oddp))))
+
+;this is sort of strange...
+(defthm expt-2-is-not-odd
+  (implies (and (evenp x)
+                (< 0 i) ;drop?
+                (integerp i)
+                )
+           (equal (equal (expt 2 i)
+                         (+ 1 x))
+                  nil))
+  :hints (("Goal" :in-theory (enable evenp oddp  even-not-equal-odd)))  ;shouldn't have to enable oddp
+  :otf-flg t)
+
+
+(defthm a14
+  (and
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= 0 j))
+            (and (integerp (expt i j))
+                 (<= 0 (expt i j))))
+   (implies (and (rationalp i)
+                 (not (equal i 0)))
+            (not (equal (expt i j) 0))))
+  :hints
+  (("Goal" :in-theory (enable expt)))
+  :rule-classes
+  ((:type-prescription
+    :corollary
+    (implies (and (integerp i)
+                  (<= 0 i)
+                  (<= 0 j))
+             (and (integerp (expt i j))
+                  (<= 0 (expt i j)))))
+   (:type-prescription
+    :corollary
+    (implies (and (rationalp i)
+                  (not (equal i 0)))
+             (not (equal (expt i j) 0))))))
+
+
+#|
+;this will get rewritten away?
+(defthm expt-in-product-linear	
+  (implies (and (<= 0 i)	
+		(<= 0 x)
+                (case-split (rationalp x))
+                )	
+	   (<= x (* x (expt 2 i))))
+  :rule-classes (:linear)
+  )
+
+;this will get rewritten away?
+(defthm expt-in-product-linear-2
+   (implies (and (case-split (<= i 0))	
+                 (case-split (<= 0 x))
+                 (case-split (rationalp x))
+                 )	
+            (<= (* x (expt 2 i)) x))
+   :rule-classes (:linear)
+   )
+
+|#
+
+;crap.  This unifies with (EXPT '2 '0), which we see because we disable the executable counterpart of expt to
+;prevent massively expensive calls.
+;loops with a15!!
+;add theory invar!
+;does this already exist?
+(defthmd expt-with-product-exponent
+  (implies (and (syntaxp (not (quotep i)))
+                (case-split (integerp i)))
+	   (equal (expt 2 (* 2 i))	
+		  (* (expt 2 i) (expt 2 i))))
+  :hints (("Goal" :in-theory (enable a15))))
+
+
+
+;yuck
+;perhaps use only expt-2-positive-integer-type;
+;don't need this if natp is enabled?
+(defthmd natp-expt
+  (implies (natp n)
+           (and (integerp (expt 2 n))
+                (< 0 (expt 2 n))))
+  :rule-classes (:type-prescription :rewrite))
+
+
+
+#|
+
+these deal with arbitrary bases (not just 2):
+
+(local (include-book
+        "../../../arithmetic-2/meta/expt"))
+(local
+ (include-book
+  "../arithmetic/product"))
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (>= x 0)))
+
+
+
+;allows both a and b to be non-integers:
+(defthm expt-non-negative
+  (implies (and (<= 0 a)	
+		(<= 0 b)	 		
+		(case-split (rationalp a))	
+		)					
+	   (<= 0 (expt a b))))
+
+(defthm expt-integerp
+  (implies (and (natp a)	
+		(<= 0 b) 		
+		)					
+	   (integerp (expt a b))))
+
+|#
+
+
+;there are funny little rules...
+
+(defthm expt-exceeds-another-by-more-than-1
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                (integerp i)
+                (integerp j)
+                )
+           (implies (< (+ 1 i) j)
+                    (< (+ 1 (expt 2 i)) (expt 2 j))))
+  :hints (("Goal" :in-theory (enable expt-split)
+           :use (:instance expt-strong-monotone (n (+ 1 i)) (m j)))))
+
+
+(defthm expt-exceeds-2
+  (IMPLIES (AND (< i j)
+                (<= 0 i)
+                (<= 0 j)
+                (INTEGERP i)
+                (INTEGERP j)
+                )
+           (<= (+ 1 (EXPT 2 i)) (EXPT 2 j)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use (:instance expt-strong-monotone (n i) (m j)))))
+
+#|
+
+Are there some rules (such as this one) which we want enabled for both scaterring and gathering exponents?
+
+(defthm expt-hack
+  (equal (* (expt 2 n) (expt 2 (* -1 n))) 1)
+  :hints (("Goal" :in-theory (e/d () (EXPT-minus)))))
+
+(defthm expt-hack-2
+  (equal (* (expt 2 (* -1 n)) (expt 2 n)) 1)
+  :hints (("Goal" :in-theory (e/d () (EXPT-minus)))))
+|#
+
+
+(defthm expt-with-i-non-integer-special
+  (implies (not (integerp i))
+           (equal (EXPT 2 (+ -1 i))
+                  (if (acl2-numberp i)
+                      1
+                    1/2))))
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/expt.lisp acl2-6.3/books/rtl/rel9/arithmetic/expt.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/expt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/expt.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,560 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;this book contains very basic expt stuff (i couldn't include expt.lisp in basic.lisp because of a circular dependency)
+
+;todo: 
+;make a separate expt-proofs book
+;there's a distinction between expt and expt-2 rules
+;make consistent names:  expt vs. expt2   
+;think about the rules to combine and split exponents
+;generalize some of these rules to be about expt with any base (not just 2)
+
+;remove this?
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "ground-zero")
+(include-book "negative-syntaxp")
+(local (include-book "expt-proofs"))
+
+(defthm a16
+  (equal (expt (* a b) i)
+         (* (expt a i) (expt b i))))
+
+
+;gen
+;split off the non-integer case
+;make an expt2-split?
+;instead of i1 and i2, use i and j?
+(defthmd expt-split
+  (implies (and (integerp i)
+                (integerp j)
+                (case-split (acl2-numberp r)) ;(integerp r)
+                (case-split (not (equal r 0)))
+                )
+           (equal (expt r (+ i j))
+                  (* (expt r i) (expt r j)))))
+
+
+
+(theory-invariant
+  (not (and (active-runep '(:rewrite expt-split))
+            (active-runep '(:rewrite a15))))
+  :key expt-split-invariant)
+
+(theory-invariant
+  (not (and (active-runep '(:rewrite expt-split))
+            (active-runep '(:definition expt))))
+  :key expt-split-invariant-2)
+
+
+;see also a14
+;generalize?  use arith books?
+(defthm expt-2-positive-rational-type
+  (and (rationalp (expt 2 i))
+       (< 0 (expt 2 i)))
+  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
+
+;like a14?
+(defthm expt-2-positive-integer-type
+  (implies (<= 0 i)
+           (and (integerp (expt 2 i))
+                (< 0 (expt 2 i))))
+  :rule-classes (:type-prescription))
+
+(defthm a14
+  (and
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= 0 j))
+            (and (integerp (expt i j))
+                 (<= 0 (expt i j))))
+   (implies (and (rationalp i)
+                 (not (equal i 0)))
+            (not (equal (expt i j) 0))))
+
+  :rule-classes
+  ((:type-prescription
+    :corollary
+    (implies (and (integerp i)
+                  (<= 0 i)
+                  (<= 0 j))
+             (and (integerp (expt i j))
+                  (<= 0 (expt i j)))))
+   (:type-prescription
+    :corollary
+    (implies (and (rationalp i)
+                  (not (equal i 0)))
+             (not (equal (expt i j) 0))))))
+
+
+;someday our rules may be better, but right now, ours only talk about when when the base is 2
+;(in-theory (disable (:TYPE-PRESCRIPTION EXPT)))
+
+
+;the rewrite rule counterpart to expt-2-positive-integer-type
+(defthm expt-2-integerp
+  (implies (<= 0 i)
+           (integerp (expt 2 i))))
+
+(defthm expt-2-type-linear
+  (implies (<= 0 i)
+           (<= 1 (expt 2 i)))
+  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
+
+
+
+;when you disable either of the two rules below, you might want to also disable expt-compare?
+;took these rules out of :rewrite since we have expt-compare?
+;are these bad :linear rules because they have free vars?
+
+(defthmd expt-strong-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (< (expt 2 n) (expt 2 m))
+                  (< n m))))
+
+;improve to handle i non-integer?
+(defthm expt2-integer
+  (implies (case-split (integerp i))
+           (equal (integerp (expt 2 i))
+                  (<= 0 i))))
+
+;trying :match-free :all
+;why disabled?
+(defthmd expt-strong-monotone-linear
+  (implies (and (< n m)
+                (case-split (integerp n))
+                (case-split (integerp m))
+                )
+           (< (expt 2 n) (expt 2 m)))
+  :rule-classes ((:linear :match-free :all)))
+
+;why disabled?
+(defthmd expt-weak-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (<= (expt 2 n) (expt 2 m))
+		  (<= n m))))
+
+;disabled because of the free var
+;but is occasionally helpful
+;make linear?
+;BOZO rename params?
+;trying :match-free :all
+(defthmd expt-weak-monotone-linear
+  (implies (and (<= n m)
+                (case-split (integerp n))
+                (case-split (integerp m)))
+           (<= (expt 2 n) (expt 2 m)))
+  :rule-classes ((:linear :match-free :all)))
+
+;generalize? rewrite (< (expt 2 i) k) to a comparison of (expt 2 i) and the greatest power of 2 <= k
+;is this what expt-compare does?
+(defthmd expt-between-one-and-two
+  (implies (and (<= 1 (expt 2 i))
+                (< (expt 2 i) 2))
+           (equal (expt 2 i) 1)))
+
+
+;We could disable this if it causes problems (but it seems okay).
+;should always use case-split n hyps that say exponents are integers
+(defthm expt-with-i-non-integer
+  (implies (not (integerp i))
+           (equal (expt r i)
+                  1)))
+
+(defthmd expt-minus-helper
+  (equal (expt r (* -1 i))
+         (/ (expt r i))))
+
+;BOZO disable or enable by default?
+;Loops with expt-inverse. How do we want to handle this??
+;I'd rather have the inverting done outside EXPT since most rules don't look inside EXPT.
+;This rule can be said to scatter exponents...
+(defthmd expt-minus
+  (implies (syntaxp (negative-syntaxp i))
+           (equal (expt r i)
+                  (/ (expt r (* -1 i))))))
+
+;This can loop with expt-minus (see theory-invariant).
+(defthmd expt-inverse
+  (equal (/ (expt 2 i))
+         (expt 2 (* -1 i))))
+
+(theory-invariant
+  (not (and (active-runep '(:rewrite expt-minus))
+            (active-runep '(:rewrite expt-inverse))))
+  :key expt-minus-invariant)
+
+
+;could prove a rule for (expt (* -1 r) i) ... or maybe we have a rule for expt when r is a product...
+
+;rename to expt-gather? !
+;Note that this rule isn't enough to gather exponents in every situation.  For example, two factors, (expt 2 i)
+;and (expt 2 j), won't be gathered if there are intervening factors between them.
+;BOZO change param names
+(defthmd a15
+  (implies (and (rationalp i)
+                (not (equal i 0))
+                (integerp j1)
+                (integerp j2))
+           (and (equal (* (expt i j1) (expt i j2))
+                       (expt i (+ j1 j2)))
+                (equal (* (expt i j1) (* (expt i j2) x))
+                       (* (expt i (+ j1 j2)) x)))))
+
+(defthm expt-r-0
+  (equal (expt r 0)
+         1))
+
+(defthm expt-0-i
+  (implies (and (case-split (integerp i))      ;since expt with a non-integer index is 1
+                (case-split (not (equal 0 i))) ;since (expt 0 0) is 1
+                )
+           (equal (expt 0 i)
+                  0)))
+
+
+
+
+
+;==== A scheme for preventing massively expensive calls to expt =======
+
+#| When ACL2 encounters a function call with constant arguments, the simplifier just evaluates the function on
+those arguments.  However, calls of (expt r i) with huge i can be very expensive to compute.  (I suppose calls
+with huge r might be very expensive too, but r is almost always 2 in my work.)  The scheme below prevents
+(expt r i) from being evaluated when i is too large (but allows evaluation in the case of small i).
+
+|#
+
+(in-theory (disable (:executable-counterpart expt)))
+
+(set-compile-fns t)
+(defun expt-execute (r i) (expt r i))
+
+;Allows expt calls with small exponents to be computed  
+;You can change 1000 to your own desired bound.
+(defthm expt-execute-rewrite
+  (implies (and (syntaxp (and (quotep r) (quotep i) (< (abs (cadr i)) 1000))))
+           (equal (expt r i)
+                  (expt-execute r i))))
+#|
+The rules below are not complete, I proved them as needed to simplify terms like:
+(* x
+   (EXPT 2 1000001)
+   (/ (EXPT 2 1000000))
+   y)
+
+Note that we could just compute (EXPT 2 1000001) and (EXPT 2 1000000) but that would be very expensive.
+
+Perhaps we can make this into a complete theory, based on the observation that if a product contains two
+factors of the form (expt 2 k) of (/ (expt 2 k)), where k is a constant, those factors will be brought
+together because they are very close in the term order used order arguments to * (recall that unary-/ is
+ignored when we decide how to order arguments to *).  
+|#
+
+;this could be made more general (replace the lhs with its second arg...)
+(defthm expt2-constants-collect-special-1
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (rationalp y))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal  (* (EXPT 2 i1)
+                      (/ (EXPT 2 i2))
+                      y)
+                   (* (expt 2 (- i1 i2)) y))))
+
+(defthm expt2-constants-collect-special-2
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal  (* (EXPT 2 i1)
+                      (/ (EXPT 2 i2))
+                      )
+                   (expt 2 (- i1 i2)))))
+
+(defthm expt2-constants-collect-special-4
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (rationalp y))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal (* (/ (EXPT 2 i2)) (EXPT 2 i1) y)
+                  (* (expt 2 (- i1 i2)) y))))
+
+(defthm expt2-constants-collect-special-5
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal  (* (/ (EXPT 2 i2)) (EXPT 2 i1))
+                   (expt 2 (- i1 i2)))))
+
+
+
+;will this happen?
+(defthm expt2-constants-collect-special-6
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (rationalp x))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal  (* (EXPT 2 i2) x (EXPT 2 i1))
+                   (* (expt 2 (+ i1 i2)) x))))
+
+
+;whoa this one is sort of different... (it rewrites an equality)
+(defthm expt2-constants-collect-special-3
+  (implies (and (syntaxp (and (quotep i1) (quotep i2))) 
+                (case-split (rationalp x))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (equal (equal (* x (EXPT 2 i1)) (EXPT 2 i2))
+                  (equal x (expt 2 (- i2 i1))))))
+
+
+
+
+
+
+;==================================================================
+
+;expt-compare
+;handle constants as args?
+(defthm expt2-1-to-1
+  (implies (and (integerp i1)
+                (integerp i2))
+           (equal (equal (expt 2 i1) (expt 2 i2))
+                  (equal i1 i2))))
+
+;could gen? move hyps to concl?
+(defthm expt-even
+  (implies (and (< 0 i)
+                (case-split (integerp i))
+                )
+           (integerp (* 1/2 (expt 2 i)))))
+
+
+;generalize rules like this with a power2-syntaxp (not power2p!) ?
+;make conclusion an equality?
+(defthm expt-quotient-integerp
+  (implies (and (<= j i)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (integerp (* (expt 2 i) (/ (expt 2 j)))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm expt-quotient-integerp-alt
+  (implies (and (<= j i)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (integerp (* (/ (expt 2 j)) (expt 2 i))))
+  :rule-classes (:rewrite :type-prescription))
+
+
+;is there a 2 term version?
+(defthm expt-prod-integer-3-terms
+  (implies (and (integerp n)
+                (<= 0 (+ i j))
+                (integerp i)
+                (integerp j)
+                )
+           (integerp (* (expt 2 i) (expt 2 j) n))))
+
+
+;drop these?
+;generalize to comparisons to any constant (any power of 2)?
+
+;bad name?
+
+(defthm expt2-inverse-integer
+  (implies (case-split (integerp i))
+           (equal (integerp (/ (expt 2 i)))
+                  (<= i 0))))
+
+;figure out a better solution to this problem
+;perhaps say if a term is a power of 2, then it's an integer iff its expo is >=0
+(defthm expt-prod-integer-3-terms-2
+  (implies (and (<= 0 (+ i (- j) (- l)))
+                (integerp i)
+                (integerp j)
+                (integerp l)
+                )
+           (integerp (* (expt 2 i) (/ (expt 2 j)) (/ (expt 2 l))))))
+
+
+(defthm expt2-inverse-even
+  (implies (case-split (integerp i))
+           (equal (integerp (* 1/2 (/ (expt 2 i))))
+                  (<= (+ 1 i) 0))))
+
+
+;loops with a15?
+; (expt (* 2 i)) was matching with (expt 2 0) (booo!) so I added the syntaxp hyp
+(defthmd expt-2-split-product-index
+  (implies (and (syntaxp (not (quotep i)))
+                (case-split (rationalp r))
+                (case-split (integerp i)))
+           (equal (expt r (* 2 i))
+                  (* (expt r i) (expt r i)))))
+
+
+;linear?
+(defthm expt-bigger-than-i
+  (implies (integerp i)
+           (< i (expt 2 i))))
+
+;BOZO this might loop with expt-split
+;i'm not sure that this is a good rewrite anyway
+(defthmd expt-compare-with-double
+  (implies (and (integerp x)
+                (integerp i))
+           (equal (< (* 2 x) (expt 2 i))
+                  (< x (expt 2 (+ -1 i))))))
+
+;leave this disabled?
+(defthmd expt-2-reduce-leading-constant-gen
+  (implies (case-split (integerp (+ k d)))
+           (equal (expt 2 (+ k d))
+                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d))))))
+
+
+;handles the case when k isn't even an integer!
+;loops with a15!  add theory invariant....
+(defthmd expt-2-reduce-leading-constant
+  (implies (and (syntaxp (and (quotep k)
+                         (or (>= (cadr k) 1) (< (cadr k) 0))))
+                (case-split (integerp (+ k d)))
+                )
+           (equal (expt 2 (+ k d))
+                  (* (expt 2 (fl k)) (expt 2 (+ (mod k 1) d))))))
+
+; BOZO better than a15?
+(defthmd expt-combine
+  (implies (and (case-split (rationalp r))
+                (case-split (not (equal r 0)))
+                (case-split (integerp i1))
+                (case-split (integerp i2)))
+           (and (equal (* (expt r i1) (expt r i2))
+                       (expt r (+ i1 i2)))
+                (equal (* (expt r i1) (* (expt r i2) x))
+                       (* (expt r (+ i1 i2)) x)))))
+
+
+
+;remove since we have expt-compare?
+(defthm expt-with-small-n
+  (implies (<= n 0)
+           (<= (expt 2 n) 1))
+  :rule-classes (:linear))
+
+
+
+
+
+
+
+
+;move? make fw-chaining rule?
+(defthmd even-not-equal-odd
+  (implies (and (evenp x)
+                (oddp y))
+           (not (equal x y))))
+
+;this is sort of strange...
+(defthm expt-2-is-not-odd
+  (implies (and (evenp x)
+                (< 0 i) ;drop?
+                (integerp i)
+                )
+           (equal (equal (expt 2 i)
+                         (+ 1 x))
+                  nil)))
+
+
+
+
+
+;crap.  This unifies with (EXPT '2 '0), which we see because we disable the executable counterpart of expt to
+;prevent massively expensive calls.
+;loops with a15!!
+;add theory invar!
+;does this already exist?
+(defthmd expt-with-product-exponent
+  (implies (and (syntaxp (not (quotep i)))
+                (case-split (integerp i)))
+	   (equal (expt 2 (* 2 i))	
+		  (* (expt 2 i) (expt 2 i)))))
+
+
+
+;yuck
+;perhaps use only expt-2-positive-integer-type;
+;don't need this if natp is enabled?
+(defthmd natp-expt
+  (implies (natp n)
+           (and (integerp (expt 2 n))
+                (< 0 (expt 2 n))))
+  :rule-classes (:type-prescription :rewrite))
+
+
+
+
+;there are funny little rules...
+
+(defthm expt-exceeds-another-by-more-than-1
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                (integerp i)
+                (integerp j)
+                )
+           (implies (< (+ 1 i) j)
+                    (< (+ 1 (expt 2 i)) (expt 2 j)))))
+
+
+(defthm expt-exceeds-2
+  (IMPLIES (AND (< i j)
+                (<= 0 i)
+                (<= 0 j)
+                (INTEGERP i)
+                (INTEGERP j)
+                )
+           (<= (+ 1 (EXPT 2 i)) (EXPT 2 j)))
+  :rule-classes (:rewrite :linear))
+
+(defthm expt-with-i-non-integer-special
+  (implies (not (integerp i))
+           (equal (EXPT 2 (+ -1 i))
+                  (if (acl2-numberp i)
+                      1
+                    1/2))))
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/extra-rules.lisp acl2-6.3/books/rtl/rel9/arithmetic/extra-rules.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/extra-rules.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/extra-rules.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,337 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+;this books contains rules which aren't used anywhere in lib/ or support/
+
+(in-package "ACL2")
+
+;(include-book "fp2")
+;(local (include-book "even-odd"))
+(local (include-book "basic")) ;yuck
+
+
+(defthm exp+1-1
+  (implies (and (integerp m)
+                (integerp n)
+                (<= n m))
+           (<= (+ (expt 2 m) (expt 2 n))
+               (expt 2 (1+ m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-weak-monotone)
+			(:instance expt-split (r 2) (i 1) (j m))))))
+
+(defthm exp+1
+    (implies (and (integerp m)
+		  (integerp n)
+		  (<= n m))
+	     (> (* (- 1 (expt 2 m)) (- 1 (expt 2 n)))
+		(- 1 (expt 2 (1+ m)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable)
+		  :use ((:instance exp+1-1)
+                        ))))
+
+(defthm exp+2-1
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (<= (* (expt 2 m) (expt 2 n))
+		 (expt 2 m)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-weak-monotone (n (+ m n)))
+			(:instance expt-split (r 2))))))
+
+(defthm exp+2-2
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (<= (+ (expt 2 m) (expt 2 n) (* (expt 2 m) (expt 2 n)))
+		 (* 3 (expt 2 m))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable)
+		  :use ((:instance expt-weak-monotone)
+			(:instance exp+2-1)))))
+
+(defthm exp+2-3
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (< (+ (expt 2 m) (expt 2 n) (* (expt 2 m) (expt 2 n)))
+		 (* 4 (expt 2 m))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable)
+		  :use (
+			(:instance exp+2-2)
+			(:instance *-strongly-monotonic (x (expt 2 m)) (y 3) (y+ 4))))))
+
+(defthm exp+2
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (< (* (1+ (expt 2 m)) (1+ (expt 2 n)))
+		(1+ (expt 2 (+ m 2)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance exp+2-3)
+			(:instance expt-split (r 2) (i 2) (j m))))))
+
+
+(defthm exp-invert-1
+    (implies (and (integerp n)
+		  (<= n -1))
+	     (<= (* (expt 2 n) (expt 2 (1+ n)))
+		 (expt 2 n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-weak-monotone (n (1+ n)) (m 0))
+			(:instance *-weakly-monotonic (x (expt 2 n)) (y (expt 2 (1+ n))) (y+ 1))))))
+
+(defthm exp-invert-2
+    (implies (and (integerp n)
+		  (<= n -1))
+	     (>= (* (- 1 (expt 2 n))
+		    (1+ (expt 2 (1+ n))))
+		 1))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-split (r 2) (i n) (j 1))
+			(:instance exp-invert-1)))))
+
+(defthm cancel-x
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (<= 1 (* x y)))
+	     (<= (/ x) y))
+  :rule-classes ())
+
+(defthm exp-invert
+    (implies (and (integerp n)
+		  (<= n -1))
+	     (<= (/ (- 1 (expt 2 n)))
+		 (1+ (expt 2 (1+ n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance cancel-x (x (- 1 (expt 2 n))) (y (1+ (expt 2 (1+ n)))))
+			(:instance exp-invert-1)
+			(:instance expt-weak-monotone (m -1))))))
+
+
+(local
+ (defthm sq-sq-1
+    (implies (and (rationalp a)
+		  (rationalp b)
+		  (rationalp p)
+		  (integerp n)
+		  (>= p 0)
+		  (<= (* (- 1 (expt 2 n)) p) (* a a))
+		  (<= (* a a) p)
+		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
+	     (<= (* (* a b) (* a b))
+		 (* (expt 2 (- (* 2 n) 2)) (* p p))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-doubly-monotonic 
+				   (x (* a a)) (a (* b b)) 
+				   (y p) (b (* (expt 2 (- (* 2 n) 2)) p))))))))
+;not exported anywhere!
+;rephrase?
+(defthm sqrt<=
+    (implies (and (rationalp x)
+		  (rationalp a)
+		  (>= a 0)
+		  (<= (* x x) (* a a)))
+	     (<= x a))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-strongly-monotonic (y a) (y+ x))
+			(:instance *-strongly-monotonic (x a) (y a) (y+ x))))))
+(local
+ (defthm sq-sq-2
+    (implies (and (rationalp a)
+		  (rationalp b)
+		  (rationalp p)
+		  (integerp n)
+		  (>= p 0)
+		  (<= (* (- 1 (expt 2 n)) p) (* a a))
+		  (<= (* a a) p)
+		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
+	     (<= (* (* (expt 2 (1- n)) p) (* (expt 2 (1- n)) p))
+		 (* (expt 2 (- (* 2 n) 2)) (* p p))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-split (r 2) (i (1- n)) (j (1- n))))))))
+
+
+(local
+ (defthm sq-sq-3
+    (implies (and (rationalp a)
+		  (rationalp b)
+		  (rationalp p)
+		  (integerp n)
+		  (>= p 0)
+		  (<= (* (- 1 (expt 2 n)) p) (* a a))
+		  (<= (* a a) p)
+		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
+	     (>= (* (expt 2 (1- n)) p) 0))
+  :rule-classes ()))
+
+(local
+ (defthm sq-sq-4
+    (implies (and (rationalp a)
+		  (rationalp b)
+		  (rationalp p)
+		  (integerp n)
+		  (>= p 0)
+		  (<= (* (- 1 (expt 2 n)) p) (* a a))
+		  (<= (* a a) p)
+		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
+	     (<= (* a b)
+		 (* (expt 2 (1- n)) p)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable a15)
+           :use ((:instance sq-sq-1)
+			(:instance sq-sq-3)
+			(:instance sqrt<= (x (* a b)) (a (* (expt 2 (1- n)) p)))
+			(:instance sq-sq-2))))))
+
+(local
+ (defthm sq-sq-5
+    (implies (and (rationalp x)
+		  (rationalp p)
+		  (integerp n)
+		  (<= x (* (expt 2 (1- n)) p)))
+	     (<= (* 2 x) (* (expt 2 n) p)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable *-weakly-monotonic)
+		  :use ((:instance expt-split (r 2) (i (1- n)) (j 1))
+			(:instance *-weakly-monotonic (x 2) (y x) (y+ (* (expt 2 (1- n)) p))))))))
+
+
+(local
+ (defthm sq-sq-6
+    (implies (and (rationalp a)
+		  (rationalp b)
+		  (rationalp p)
+		  (integerp n)
+		  (>= p 0)
+		  (<= (* (- 1 (expt 2 n)) p) (* a a))
+		  (<= (* a a) p)
+		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
+	     (<= (* 2 a b)
+		 (* (expt 2 n) p)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sq-sq-4)
+			(:instance sq-sq-5 (x (* a b))))))))
+
+(local
+ (defthm sq-sq-7
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (>= (* (- a b) (- a b))
+		 (- (* a a) (* 2 a b))))
+  :rule-classes ()))
+
+(local
+ (defthm sq-sq-8
+    (implies (and (rationalp a)
+		  (rationalp b)
+		  (rationalp p)
+		  (integerp n)
+		  (>= p 0)
+		  (<= (* (- 1 (expt 2 n)) p) (* a a))
+		  (<= (* a a) p)
+		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
+	     (>= (* (- a b) (- a b))
+		 (- (* (- 1 (expt 2 n)) p)
+		    (* (expt 2 n) p))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sq-sq-6)
+			(:instance sq-sq-7))))))
+
+(local
+ (defthm sq-sq-9
+    (implies (and (rationalp p)
+		  (integerp n))
+	     (= (- (* (- 1 (expt 2 n)) p)
+		   (* (expt 2 n) p))
+		(* (- 1 (expt 2 (1+ n))) p)))
+  :rule-classes ()))
+
+;where is this used?
+;doesn't seem to be used anywhere or exported in lib?
+(defthm sq-sq
+    (implies (and (rationalp a)
+		  (rationalp b)
+		  (rationalp p)
+		  (integerp n)
+		  (<= (* (- 1 (expt 2 n)) p) (* a a))
+		  (<= (* a a) p)
+		  (<= (* b b) (* (expt 2 (- (* 2 n) 2)) p)))
+	     (>= (* (- a b) (- a b))
+		 (* (- 1 (expt 2 (1+ n))) p)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sq-sq-8)
+			(:instance sq-sq-9)))))
+
+;kill some of these 4 abs lemmas (they are from divsqrt and don't seem to be
+;needed in support/ or exported in lib/) ?
+
+(defthm abs-+
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z))
+           (<= (abs (- x y))
+               (+ (abs (- x z))
+                  (abs (- y z)))))
+  :rule-classes ())
+
+(defthm abs->=
+  (implies (and (rationalp x)
+                (rationalp y))
+           (>= (abs (- y x)) (- (abs x) (abs y))))
+  :rule-classes ())
+
+;kill?
+(local 
+ (defthm abs+
+   (implies (and (rationalp x)
+                 (rationalp y))
+            (<= (abs (+ x y))
+                (+ (abs x) (abs y))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable abs)))))
+
+(defthm abs-
+  (implies (and (rationalp x)
+                (rationalp y))
+           (<= (abs (- x y))
+               (+ (abs x) (abs y))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable abs))))
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/fl-expt.lisp acl2-6.3/books/rtl/rel9/arithmetic/fl-expt.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/fl-expt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/fl-expt.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,168 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;don't need everything in this book!
+(local (include-book "numerator"))
+(local (include-book "denominator"))
+(local (include-book "nniq"))
+(local (include-book "arith2"))
+;(local (include-book "type"))
+(local (include-book "ground-zero"))
+(local (include-book "floor"))
+(local (include-book "integerp"))
+(local (include-book "rationalp"))
+(local (include-book "unary-divide"))
+(local (include-book "expt"))
+(local (include-book "expo"))
+(local (include-book "power2p"))
+(local (include-book "fl"))
+
+(local (in-theory (enable expt-minus)))
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+;more general vesions of this below.  kill this one?
+(defthm fl-simp
+  (implies (case-split (rationalp x))
+           (equal (FL (* 1/2 (FL (* X (/ (EXPT 2 N))))))
+                  (FL (* 1/2 X (/ (EXPT 2 N))))))
+  :hints (("Goal" :in-theory (disable fl-def-linear)
+           :use 
+           ((:instance fl-unique 
+                       (x (* 1/2 (FL (* X (/ (EXPT 2 N))))))
+                       (n (FL (* 1/2 X (/ (EXPT 2 N))))))
+            (:instance fl-def-linear (x (* 1/2 X (/ (EXPT 2 N)))))))))
+
+
+
+(encapsulate
+ ()
+ (local (defthm fl-shift-fl-case-1
+          (implies (<= 0 m)
+                   (equal (FL (* (FL X) (/ (expt 2 m))))
+                          (FL (* X (/ (EXPT 2 m))))))
+          :hints (("Goal" :cases ((rationalp x))))
+          ))
+
+ (local (defthm fl-shift-fl-case-2
+          (implies (AND (< m 0)
+                        (case-split (INTEGERP M))
+                        )
+                   (equal (FL (* (FL X) (/ (expt 2 m))))
+                          (* (FL x) (/ (expt 2 m)))))
+          :hints  (("Goal" :in-theory (disable fl-int)
+                    :use (:instance fl-int (x (* (/ (expt 2 m)) (FL X))))))))
+
+
+
+;can this be extended to let the out fl be of a sum?
+;leave the case-1 event enabled too (not integerp hyp)?
+ (defthm fl-shift-fl
+   (implies (case-split (INTEGERP M))
+            (equal (FL (* (/ (expt 2 m)) (FL X)))
+                   (if (<= 0 m)
+                       (FL (* (/ (EXPT 2 m)) X))
+                     (* (/ (expt 2 m)) (FL x)))))
+   :hints (("Goal" :cases ((< m 0))))
+   )
+ )
+
+
+#|
+(defthm fl-shift-fl-case-1-gen
+  (implies (and (rationalp x)
+                (rationalp y)
+                (integerp m)
+                (<= 0 m)
+                )
+           (equal (fl (* (/ (expt 2 m)) (+ y (* 2 (fl (* 1/2 x))))))
+                  (fl (* (/ (expt 2 m)) (+ y x)))))
+  :otf-flg t
+ :hints (("Goal" :in-theory (disable  FL-DEF-LINEAR-PART-1
+                                       FL-DEF-LINEAR-PART-2
+                                       FL-WEAK-MONOTONE
+;                                        LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE
+                                       )
+          :use (
+          (:instance FL-DEF-LINEAR-part-1  
+                     (x (+ (* X (/ (EXPT 2 M)))
+                           (* Y (/ (EXPT 2 M))))))
+          (:instance FL-DEF-LINEAR-part-1  
+                     (x x))
+          (:instance FL-DEF-LINEAR-part-2  
+                     (x (+ (* X (/ (EXPT 2 M)))
+                           (* Y (/ (EXPT 2 M))))))
+          (:instance FL-DEF-LINEAR-part-2  
+                     (x x))
+
+          (:instance fl-unique 
+                     (x (* (/ (expt 2 m)) (+ y (* 2 (FL (* 1/2 X))))))
+                     (n (FL (* (/ (EXPT 2 m)) (+ y X)))))))))
+|#
+
+(defthm fl-shift-fl-2-factors
+  (implies (AND ;(case-split (rationalp x))
+                (case-split (INTEGERP M))
+                (case-split (INTEGERP n))
+                )
+           (equal (FL (* (/ (expt 2 m)) (expt 2 n) (FL X)))
+                  (if (<= 0 (- m n))
+                      (FL (* (/ (EXPT 2 (- m n))) X))
+                    (* (/ (expt 2 (- m n))) (FL x)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '( fl-shift-fl  ;EXPO-COMPARISON-REWRITE-TO-BOUND
+                                              ))
+           :use (:instance fl-shift-fl (m (- m n))))))
+
+(defthm fl-shift-fl-2-factors-2
+  (implies (AND ;(case-split (rationalp x))
+                (case-split (INTEGERP M))
+                (case-split (INTEGERP n))
+                )
+           (equal (FL (* (expt 2 n) (/ (expt 2 m)) (FL X)))
+                  (if (<= 0 (- m n))
+                      (fl (* (/ (EXPT 2 (- m n))) X))
+                    (* (/ (expt 2 (- m n))) (FL x)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '( fl-shift-fl EXPO-COMPARISON-REWRITE-TO-BOUND))
+           :use (:instance fl-shift-fl (m (- m n))))))
+
+
+
+;(FL (* 2 (/ (EXPT 2 K)) (FL (* 1/2 X))))
+
+
+(defthm fl-shift-fl-by-1
+  (EQUAL (FL (* 1/2 (FL X)))
+         (FL (* 1/2 X)))
+  :hints (("Goal" :use (:instance fl-shift-fl (m 1)))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/fl-hacks.lisp acl2-6.3/books/rtl/rel9/arithmetic/fl-hacks.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/fl-hacks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/fl-hacks.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,107 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+#|
+This book contains a few hacks about fl which aren't used elsewhere in support/.
+
+|#
+
+(in-package "ACL2")
+
+(include-book "ground-zero")
+;(include-book "basic") ;drop?
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(local (include-book "inverted-factor"))
+(local (include-book "nniq"))
+(local (include-book "numerator"))
+(local (include-book "denominator"))
+(local (include-book "fp2"))
+(local (include-book "predicate"))
+(local (include-book "product"))
+(local (include-book "unary-divide"))
+(local (include-book "rationalp"))
+(local (include-book "integerp"))
+(local (include-book "fl")) ;drop?
+(local (include-book "mod"))
+(local (include-book "even-odd"))
+(local (include-book "../../../meta/meta-plus-equal"))
+
+(local (include-book "arith"))
+
+;used anywhere?
+;exported in lib/basic
+(defthm fl-m-1
+  (implies (and (< 0 n) ;(not (equal n 0))
+                (integerp m)
+                (integerp n)
+                )
+           (= (fl (- (/ (1+ m) n)))
+              (1- (- (fl (/ m n))))))
+  :otf-flg t
+  :rule-classes ()
+  :hints (
+          ("goal" :in-theory (disable fl-def-linear-part-2
+                                      LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)
+           :use ((:instance  fl-of-fraction-min-change
+                             (p (+ 1 m)) (q n))
+                 (:instance fl-unique (x (* M (/ N)))
+                            (n (+ -1 (+ (/ N) (* M (/ N))))))
+                 (:instance fl-unique (x (+ (/ N) (* M (/ N))))
+                            (n (FL (* M (/ N)))))
+
+                 ))))
+
+(defthm fl-m-n
+  (implies (and (< 0 n)
+                (integerp m)
+                (integerp n))
+           (= (fl (- (/ m n)))
+              (1- (- (fl (/ (1- m) n))))))
+  :hints (("Goal" :use ((:instance fl-m-1 (m (1- m))))))
+  :rule-classes ())
+
+;remove?  doesn't seem to be used anywhere or exported in lib/
+;just a special case of the above...
+(defthm fl-lemma
+    (implies (integerp m)
+	     (= (fl (- (/ (1+ m) 2)))
+		(1- (- (fl (/ m 2))))))
+  :rule-classes ()
+  :hints (("goal" :use (:instance fl-m-1 (n 2)))))
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/fl-proofs.lisp acl2-6.3/books/rtl/rel9/arithmetic/fl-proofs.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/fl-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/fl-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,891 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;My approach (and I believe this is Russinoff's approach too) for reasoning about floor and related
+;functions is to write everything in terms of fl.  Unlike floor, fl takes only 1 argument.  Furthermore, all
+;calls to floor can be rewritten to calls to fl using floor-fl
+
+;don't need everything in this book!
+(local (include-book "numerator"))
+(local (include-book "denominator"))
+(local (include-book "nniq"))
+(local (include-book "arith2"))
+(local (include-book "ground-zero"))
+(local (include-book "floor"))
+(local (include-book "integerp"))
+(local (include-book "rationalp"))
+(local (include-book "unary-divide"))
+(local (include-book "common-factor"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+;remove syntaxp hyp?
+;weird rule...
+(defthm integerp-<-non-integerp
+  (implies (and (and (syntaxp (quotep x)))
+                (not (integerp x)) 
+                (integerp n) ;backchain limit?
+                (case-split (rationalp x))
+                )
+           (equal (< n x)
+                  (<= n (fl x))))
+  :hints (("Goal" :in-theory (enable fl)))
+)
+
+;remove syntaxp hyp?
+;weird rule...
+(defthm non-integerp-<-integerp
+  (implies (and (and (syntaxp (quotep x)))
+                (not (integerp x)) 
+                (integerp n) ;backchain limit?
+                (case-split (rationalp x))
+                )
+           (equal (< x n)
+                  (< (fl x) n)))
+  :hints (("Goal" :in-theory (enable fl))))
+
+(defthm a10
+  (and (implies (integerp i) (equal (fl i) i))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))) ;drop?
+                (and (equal (fl (+ i x1)) (+ i (fl x1)))
+                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2)))
+                (and (equal (fl (+ x1 (+ i x2)))
+                            (+ i (fl (+ x1 x2))))
+                     (equal (fl (+ x1 (+ x2 i)))
+                            (+ i (fl (+ x1 x2))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3)))
+                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
+                            (+ i (fl (+ x1 x2 x3))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
+                            (+ i (fl (+ x1 x2 x3))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3))
+                     (case-split (rationalp x4)))
+                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
+                            (+ i (fl (+ x1 x2 x3 x4)))))))
+  :hints (("Goal" :in-theory (enable fl)))
+)
+
+(defthm a12
+  (implies (and (integerp i)
+                (integerp j)
+                (< 1 j)
+                (< j i))
+           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
+                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
+  :hints (("Goal" :in-theory (enable fl)))
+  :rule-classes :linear
+)
+
+;why "fl-def" in the names?  this isn't a definition...
+
+;make a separate rewrite-version
+(defthm fl-def-linear-part-1
+  (implies (case-split (not (complex-rationalp x))) 
+           (<= (fl x) x))
+  :hints (("goal" :in-theory (enable fl floor)))
+  :rule-classes (:rewrite (:linear :trigger-terms ((fl x))))
+  )
+
+(defthm fl-def-linear-part-2
+  (implies (case-split (not (complex-rationalp x)))
+           (< x (1+ (fl x))))
+  :hints (("goal" :in-theory (enable fl floor)))
+  :rule-classes (:rewrite (:linear :trigger-terms ((fl x)))))
+
+;later, drop the hyp completely
+;disabled since we have the rules above
+;drop this whole rule
+(defthmd a13
+  (implies (case-split (rationalp x)) ;this hyp isn't needed for the first conslusion?
+           (and (< (1- x) (fl x))
+                (<= (fl x) x)))
+  :hints (("Goal" :in-theory (enable fl)))
+  :rule-classes :linear)
+
+;disabled since we have the next rules above
+(defthmd fl-def-linear
+  (implies (case-split (rationalp x)) ;gen?
+           (and (<= (fl x) x)
+                (< x (1+ (fl x)))))
+  :rule-classes :linear)
+
+
+
+
+;note that FL is not strongly monotonic.  That is, x<x+ does not always imply (fl x) < (fl x+)
+;change param names to x, x+
+;try match-free :all
+(defthm fl-weakly-monotonic
+  (implies (and (<= y y+)
+                (case-split (rationalp y)) ;drop?
+                (case-split (rationalp y+)) ;drop?
+                )
+           (<= (fl y) (fl y+)))
+  :hints (("Goal" :in-theory (enable fl)))
+  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
+                 (:linear)
+                 (:forward-chaining
+                  :trigger-terms ((fl y) (fl y+))
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))
+                 (:linear
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))))
+
+;add a separate "fl of complex is 0" ?
+;because of this, I can put make (rationalp x) into (case-split (rationalp x)) for all arguments x of fl
+; (since we always can simplify the other case, the split is nice)
+(defthm fl-of-non-rational
+  (implies (not (rationalp x))
+           (equal (fl x)
+                  0))
+  :hints (("Goal" :in-theory (enable fl))))
+
+
+(defthmd fl-minus
+  (implies (rationalp x)
+           (equal (fl (* -1 x))
+                  (if (integerp x)
+                      (* -1 x)
+                    (1- (* -1 (fl x)))))))
+
+;bad? free var.
+(defthm fl-monotone-linear
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y))
+           (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+
+;may need to disable?
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+(local
+ (defthm fl/int-1
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= 0 n)
+                  )
+	     (<= (fl (/ (fl x) n))
+		 (fl (/ x n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable fl-def-linear-part-1
+                                     fl-def-linear-part-2)
+           :use ((:instance fl-def-linear))))))
+
+
+
+
+(local
+ (defthm fl/int-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (fl (/ (fl x) n))
+		 (fl (/ x n))))
+  :rule-classes ()
+  :hints (("Goal"  :in-theory (disable fl-def-linear-part-1
+                                       fl-def-linear-part-2)
+           :use ((:instance fl-def-linear)
+                 (:instance n<=fl-linear (n (* n (fl (/ x n)))))
+                 (:instance n<=fl-linear (n (fl (/ x n))) (x (/ (fl x) n)))
+                 (:instance fl-def-linear (x (/ x n)))
+                 (:instance fl-def-linear (x (/ (fl x) n))))))))
+
+;BOZO will this match?
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (/ (fl x) n))
+                  (fl (/ x n))))
+  :hints (("Goal" :use ((:instance fl/int-1)
+			(:instance fl/int-2)))))
+
+(defthm fl/int-rewrite-alt
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (/ n) (fl x)))
+                  (fl (/ x n))))
+  :hints (("Goal" :in-theory (disable fl/int-rewrite)
+           :use ( fl/int-rewrite))))
+
+
+(defthm fl-integer-type
+  (integerp (fl x))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than fl-integer-type and might be worse
+(in-theory (disable (:type-prescription fl)))
+
+(defthm fl-int
+  (implies (integerp x)
+           (equal (fl x) x)))
+
+;bad name?
+(defthm fl-integerp
+  (equal (equal (fl x) x)
+         (integerp x)))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+
+
+
+;ACL2 already knows these facts about FL, but we include them anyway
+(defthm fl-rational
+  (rationalp (fl x)))
+
+(defthm fl-integer
+  (integerp (fl x)))
+
+
+
+;add "fl of negative is negative" type rule? (actually 2 posibilities?)
+(defthm fl-non-negative-integer-type-prescription
+  (implies (<= 0 x)
+           (and (<= 0 (fl x))
+                (integerp (fl x))))
+  :rule-classes (:type-prescription))
+
+(defthm fl-less-than-zero
+  (implies (case-split (rationalp x))
+           (equal (< (fl x) 0)
+                  (< x 0)))
+  :hints (("Goal" :in-theory (enable fl)))
+  )
+
+;use rifx?
+;prove a version for fl negative? (also t-p rules for that?)
+(defthm fl-non-negative-linear
+  (implies (<= 0 x)
+           (<= 0 (fl x)))
+  :rule-classes (:linear))
+
+
+
+;rename to start with fl-
+;needed? - any constant, not just integers
+;replace the rule to pull out an integer?
+;BOZO do we want to use rem here???
+(defthm pull-constant-out-of-fl
+  (implies (and (syntaxp (and (quotep c1) (>= (abs (cadr c1)) 1)))
+                (rationalp c1)
+                (rationalp x))
+           (equal (fl (+ c1 x))
+                  (+ (truncate c1 1) (fl (+ (rem c1 1) x)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rem)
+                              '(truncate)))))
+
+
+
+;fl-minus?
+
+(defthm fl-minus-factor
+  (implies (and (syntaxp (quotep k))
+                (< k 0)
+                (rationalp k)
+                (rationalp x))
+           (equal (fl (* k x))
+                  (if (integerp (* k x))
+                      (* -1 (fl (* (- k) x)))
+                      (+ -1 (- (fl (* (- k) x))))))))
+
+
+
+
+
+
+
+(defthm fl-<-integer
+  (implies (and (integerp y)
+                (case-split (rationalp x)))
+           (equal (< (fl x) y)
+                  (< x y))))
+
+(defthm fl->-integer
+  (implies (and (integerp y)
+                (case-split (rationalp x)))
+           (equal (< y (fl x))
+                  (<= (+ 1 y) x))))
+             
+
+;should this be disabled?
+(defthm fl-equal-0
+  (implies (case-split (rationalp x))
+           (equal (equal (fl x) 0)
+                  (and (<= 0 x)
+                       (< x 1)))))
+
+;kill this? or is this nice b/c it makes no change if its hyps fail to be satisfied?
+(defthmd fl-equal-0-alt
+  (implies (and (< x 1)
+                (<= 0 x)
+                (case-split (rationalp x))
+                )
+           (equal (fl x) 0)))
+
+;bad names?                  
+;fl-def-linear isn't rewrite!
+;remove this??
+(defthm fl-strong-monotone
+  (implies (and (< x y)
+                (rationalp x)
+                (rationalp y)
+                )
+           (< (fl x) y)))
+
+
+;remove this??
+;make linear?
+(defthm fl-weak-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                )
+           (<= (fl x) y)))
+
+
+
+
+;kill one of these?
+(defthm fl-def-linear-quotient
+  (implies (and (< 0 y)
+                (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (and (not (< X (* Y (FL (* X (/ Y))))))
+                (not (< X (* Y (FL (* (/ Y) X)))))))
+  :hints (("Goal" :in-theory (disable fl-strong-monotone
+                                      FL-WEAK-MONOTONE FL-DEF-LINEAR-part-1)
+           :use (:instance FL-DEF-LINEAR-part-1 (x (/ x y))))))
+
+;Our scheme for dealing with FLOOR is to always rewrite calls of it to FL
+(defthm floor-fl
+  (equal (floor m n) 
+         (fl (/ m n)))
+  :hints (("goal" :in-theory (e/d (fl) ( RATIONALP-PRODUCT))
+           :cases ((rationalp m) ;drop this hint?
+                   ))))
+
+(theory-invariant (incompatible (:rewrite floor-fl)
+                                (:definition fl))
+                  :key floor-fl--and--fl--conflict)
+
+
+;perhaps always split on even/odd for fl(x/2)
+;needed? was in proof.lisp for x87 recip proof
+(defthm fl-of-odd/2
+  (implies (and (integerp x)
+                (not (integerp (* 1/2 x)))
+                )
+           (equal (fl (* 1/2 x))
+                  (- (* 1/2 x) 1/2))))
+
+(defthm fl-of-even/2
+  (implies (and (INTEGERP (* X (/ 2))))
+           (equal (fl (* 1/2 x))
+                  (* 1/2 x)))
+)
+
+;new version
+(defthm fl-force-to-0
+  (implies (case-split (rationalp x))
+           (equal (equal 0 (fl x))
+                  (and (<= 0 x)
+                       (< x 1)))))
+
+
+(in-theory (disable fl-force-to-0)) ;may be expensive
+
+;generalize to any amount of shifting each time and to any base (2,3, etc.)?
+
+;is there a linear rule missing?  why did we need to :use fl-def-linear?
+;(both expressions shift x right n+1 spots and chop)
+
+
+
+
+
+#|
+;represents the fractional part of a number
+(defun md (x)
+  (- x (fl x)))
+
+(defthm fl-plus-md
+  (implies (acl2-numberp x)
+           (equal (+ (fl x) (md x))
+                  x)))
+
+(defthm md-nonnegative
+  (implies (rationalp x)
+           (<= 0 (md x))))
+
+(defthm md-less-than-1
+  (implies (rationalp x)
+           (<= 0 (md x))))
+
+(defthm md-type-rationalp
+  (implies (rationalp x)
+           (rationalp (md x))))
+
+
+(in-theory (disable fl-plus-md))
+
+(in-theory (disable md))
+
+|#
+
+
+
+;attempted addition 1/7/02:
+
+;make linear?
+(defthm fl-factor-out-integer-bound
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x)
+                )
+           (<= (* n (fl x))
+               (fl (* n x)))))
+
+;make linear?
+(defthm fl-factor-out-integer-bound-2
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp m)
+                )
+           (<= (* n (fl (* m (/ n))))
+               (fl m))))
+
+
+
+
+
+;see sse-div.lisp for better versions of the above
+
+
+#| for reference:
+(DEFTHM FL-DEF-LINEAR
+  (IMPLIES (RATIONALP X)
+           (AND (<= (FL X) X) (< X (1+ (FL X)))))
+  :RULE-CLASSES :LINEAR)
+|#
+
+;these thms are about getting rid of one of two (roughly) "nested" calls to fl
+
+;why??
+(defthm fl-plus-integer-eric
+  (implies (and (integerp n)
+                (case-split (rationalp x)) ;not true if x is a complex-rationalp
+                )
+           (equal (fl (+ x n))
+                  (+ n (fl x)))))
+
+(local (in-theory (disable floor-fl)))
+
+;move
+;strictly better than the version in the arithmetic books
+(DEFTHM QUOTIENT-NUMER-DENOM-eric
+  (IMPLIES (AND (INTEGERP X)
+                (<= 0 X) ; was (< 0 x)
+                (INTEGERP Y)
+                (<= 0 Y)) ;was (< 0 y)
+           (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (NUMERATOR (/ X Y))
+                                                (DENOMINATOR (/ X Y)))
+                  (NONNEGATIVE-INTEGER-QUOTIENT X Y)))
+  :hints (("Goal" :cases ((and (= x 0) (=  y 0))
+                          (and (not (= x 0)) (= y 0))
+                          (and (= x 0) (not (= y 0)))))))
+
+;(in-theory (disable QUOTIENT-NUMER-DENOM))
+
+
+
+
+
+
+
+; rewrites things like (EQUAL (* 32768 (FL (* 1/32768 x))) x)
+(defthm fl-claim-rewrite-to-integerp-claim-gen
+  (implies (and (equal k-inverse (/ k))
+                (case-split (acl2-numberp k))
+                (case-split (not (equal k 0)))
+                (case-split (acl2-numberp x))
+                )
+           (and (equal (EQUAL (* k (FL (* k-inverse X))) X)
+                       (integerp (* k-inverse x)))
+                (equal (EQUAL (* k (FL (* X k-inverse))) X)
+                       (integerp (* k-inverse x)))))
+  :hints (("Goal" :in-theory (disable FL-INTEGERP
+                                      )
+           :use (:instance fl-integerp (x (* k-inverse X)))
+           )
+          ))
+(in-theory (disable fl-claim-rewrite-to-integerp-claim-gen))
+
+(defthm fl-claim-rewrite-to-integerp-claim-gen-2
+  (implies (and (equal k-inverse (/ k))
+                (case-split (acl2-numberp k))
+                (case-split (not (equal k 0)))
+                (case-split (acl2-numberp x))
+                (case-split (acl2-numberp y))
+                )
+           (and (equal (EQUAL (* k (FL (* k-inverse X y))) (* X y))
+                       (integerp (* k-inverse x y)))
+                (equal (EQUAL (* k (FL (* X k-inverse y))) (* X y))
+                       (integerp (* k-inverse x y)))
+                (equal (EQUAL (* k (FL (* X y k-inverse))) (* X y))
+                       (integerp (* k-inverse x y)))))
+  :hints (("Goal" :in-theory (disable FL-INTEGERP
+                                      )
+           :use (:instance  fl-claim-rewrite-to-integerp-claim-gen
+                            (x (* x y))))))
+
+
+
+
+(defthm fl-claim-rewrite-to-integerp-claim
+  (implies (and (syntaxp (and (quotep k-inverse)
+                              (quotep k)))
+                (equal k-inverse (/ k))
+                (case-split (acl2-numberp k))
+                (case-split (not (equal k 0)))
+                (case-split (acl2-numberp x))
+                )
+           (and (equal (EQUAL (* k (FL (* k-inverse X))) X)
+                       (integerp (* k-inverse x)))
+                (equal (EQUAL (* k (FL (* X k-inverse))) X)
+                       (integerp (* k-inverse x)))))
+  :hints (("Goal" :in-theory (disable FL-INTEGERP
+;                           (:type-prescription fl)
+                                      )
+           :use (:instance fl-integerp (x (* k-inverse X)))
+           )
+          ))
+
+#|
+(defthm fl-chops-off-1/2
+  (implies (and (not (integerp x))
+                (integerp (* 2 x))
+                (case-split (rationalp x))
+                )
+           (equal (fl x)
+                  (- x 1/2)))
+  :hints (("Goal" :use (:instance fl-unique (n                  (- x 1/2)))))
+)
+(in-theory (disable  fl-chops-off-1/2))
+
+(defthm fl-chops-off-1/2-2
+  (implies (and (syntaxp (not (and (quotep x)
+                                   (equal (cadr x) 1/2))))
+                (not (integerp x))
+                (integerp (* 2 x))
+                (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (and (equal (fl (+ y x))
+                       (+ (fl x) (fl (+ 1/2 y))))
+                (equal (fl (+ x y))
+                       (+ (fl x) (fl (+ 1/2 y))))))
+  :otf-flg t
+    :hints (("Goal" :in-theory (enable  fl-chops-off-1/2)
+             :use (:instance fl-unique
+                             (x (+ x y))
+                                    (n (+ (fl x) (fl (+ 1/2 y)))))))
+    )
+(in-theory (disable fl-chops-off-1/2-2))
+|#
+
+;rename?
+(defthm y-is-odd
+  (equal (EQUAL Y (+ 1 (* 2 (FL (* 1/2 Y)))))
+         (and (integerp y)
+              (not (integerp (* 1/2 y))))))
+
+(include-book "negative-syntaxp")
+
+(defthm fl-minus-gen
+  (implies (and (syntaxp (negative-syntaxp x))
+                (case-split (rationalp x))
+                )
+          (EQUAL (FL x)
+                 (IF (INTEGERP X)
+                     (* -1 (FL (* -1 X)))
+                     (+ -1 (- (FL (* -1 X))))))))
+;this can loop with fl-minus-gen (when the result of applying fl-minus-gen doesn't get simplfied before we
+;build the linear pot list)
+(in-theory (disable fl-minus-factor))
+
+
+(defthmd fl-of-fraction-max-change-case-1
+  (implies (and (not (integerp (/ p q))) ;this case
+                (integerp p)
+                (integerp q)
+                (< 0 q)
+                )
+           (>= (+ 1 (fl (/ p q)))
+               (+ (/ p q) (/ q))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable fl floor)
+                              '(floor-fl 
+                                ;quotient-numer-denom
+                                ;nniq-lower-bound-non-integer-case
+                                ))
+           :use ((:instance  <=-transitive 
+                             (a (+ (/ Q) (* P (/ Q))))
+                             (b (+ (* P (/ Q))
+                                   (/ (DENOMINATOR (* P (/ Q))))))
+                             (c (+ 1
+                                   (NONNEGATIVE-INTEGER-QUOTIENT (NUMERATOR (* P (/ Q)))
+                                                                 (DENOMINATOR (* P (/ Q)))))))
+                 (:instance nniq-eric-8 (p (- p)))
+                 (:instance quotient-numer-denom (x (- p)) (y q))
+                 (:instance nniq-lower-bound-non-integer-case  (x (/ p q)))))))
+
+(defthmd fl-of-fraction-max-change-case-2
+  (implies (and (integerp (/ p q)) ;this case
+                (integerp p)
+                (integerp q)
+                (< 0 q)
+                )
+           (>= (+ 1 (fl (/ p q)))
+               (+ (/ p q) (/ q))))
+  :otf-flg t
+  :hints (("Goal" :use (:instance (:instance mult-both-sides-of-<-by-positive (a 1) (b (/ q)) (c q))))))
+
+;fl(p/q) + 1 >= p/q + 1/q
+;similar to  fl-of-fraction-upper-bound
+;rephrase the conclusion
+; if fl changes it argument, it does so by at most 1-1/q
+(defthm fl-of-fraction-max-change
+  (implies (and (< 0 q)
+                (integerp p)
+                (integerp q)
+                )
+           (>= (+ 1 (fl (/ p q)))
+               (+ (/ p q) (/ q))))
+  :otf-flg t
+  :hints (("Goal" :use ( fl-of-fraction-max-change-case-2  fl-of-fraction-max-change-case-1))))
+
+; Two integers, both in the interval (x,y], whose width is at most 1, must be equal.
+;make other versions?
+;move?
+(defthm int-unique
+  (implies (and (integerp i)
+                (integerp j)
+                (rationalp x)
+                (rationalp y)
+                (<= x y)
+                (< x i) (<= i y)
+                (< x j) (<= j y)
+                (<= (- y x) 1)
+                )
+           (equal i j))
+  :rule-classes nil
+  )
+
+;replace fl-unique?
+(defthm fl-unique-2
+  (implies (rationalp x)
+           (equal (and (integerp n)
+                       (<= n x)
+                       (< x (1+ n)))
+                  (equal (fl x) n)))
+  :rule-classes nil)  
+
+(encapsulate
+ ()
+ (local (defthm FL-M+1-1
+          (implies (and (integerp m)
+                        (integerp n)
+                        (>= m 0)
+                        (> n 0)
+                        (INTEGERP (+ (/ N) (* M (/ N)))))
+                   (= (fl (- (/ (1+ m) n)))
+                      (1- (- (fl (/ m n))))))
+          :hints (("Goal" :use (:instance fl-unique (x (* M (/ N)))
+                                          (n (/ (+ 1 (- n) m) n)))))
+          :rule-classes ()
+          ))         
+
+
+ (local (defthm FL-M+1-2
+          (implies (and (integerp m)
+                        (integerp n)
+                        (>= m 0)
+                        (> n 0)
+                        (not (INTEGERP (+ (/ N) (* M (/ N))))))
+                   (= (fl (- (/ (1+ m) n)))
+                      (1- (- (fl (/ m n))))))
+          :otf-flg t
+          :rule-classes ()
+          :hints (("Goal" :in-theory (disable FL-INTEGER-TYPE ;yuck!  had to disable these!!
+                                              FL-NON-NEGATIVE-INTEGER-TYPE-PRESCRIPTION
+                                              ;; The following needed disabling
+                                              ;; for v2-8-alpha-12-30-03; I
+                                              ;; (mattk) don't know why.
+                                              FL-DEF-LINEAR-PART-2)
+                   :use( (:instance fl-def-linear (x (+ (/ N) (* M (/ N)))))
+                         (:instance fl-of-fraction-max-change (p m) (q n))
+                         (:instance fl-unique-2 (x (* M (/ N)))
+                                    (n (+ -1 (/ N) (* M (/ N)))))
+                         (:instance int-unique
+                                    (i (FL (+ (/ N) (* M (/ N)))))
+                                    (j (FL (* M (/ N))))
+                                    (x (+ (/ m n) (/ n) -1))
+                                    (y (+ (/ m n) (/ n))))))
+                  )))
+
+
+ (defthm fl-m+1
+   (implies (and (integerp m)
+                 (integerp n)
+                 (>= m 0)
+                 (> n 0))
+            (= (fl (- (/ (1+ m) n)))
+               (1- (- (fl (/ m n))))))
+   :hints (("Goal" :use(fl-m+1-1 fl-m+1-2)))
+   :rule-classes ()))
+
+
+
+
+
+;this was the point of nniq-eric-5 to nniq-8 in basic.  how does this get proved without nniq-eric-8?
+;if fl changes its argument of p/q, it does so by at least a qth
+;rephrase concl?
+;make a linear rule?
+(defthmd fl-of-fraction-min-change
+  (implies (and (not (integerp (/ p q)))
+;                (<= 0 q)
+                (integerp p)
+                (integerp q)
+                )
+           (<= (/ q)
+               (- (/ p q) (fl (/ p q)))))  ;the amt of change made by fl
+  :otf-flg t
+  :hints (("Goal" 
+           :do-not-induct t
+           :in-theory (set-difference-theories
+                              (enable fl floor)
+                              '(nniq-eric-8
+                                fl-of-fraction-max-change
+                                )) 
+          :use (;(:instance nniq-eric-8 (p (- p)) )
+                (:instance fl-of-fraction-max-change (p (- p)))
+                (:instance fl-of-fraction-max-change (q (- q)))
+;                 nniq-eric-8
+                ))))
+
+;bad name? improve this?
+;BOZO call quot-bnd-2? or fl-bnd-2?
+(defthm fl-bound
+  (implies (and (< 0 y)
+                (rationalp x)
+                (rationalp y)
+                )
+           (<= (* y (FL (* x (/ y)))) x))
+  :hints (("Goal" :use  (:instance floor-upper-bound (i x) (j y) )
+           :in-theory (e/d (fl) (floor-upper-bound)))))
+
+;see fl-bound
+;BOZO rename params
+(defthm quot-bnd
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* y (fl (/ x y)))
+               x))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (disable  FL-WEAK-MONOTONE FL-DEF-LINEAR-PART-1) ;how similar are the 2 rules I
+    ;had to disable?
+           :use (:instance FL-DEF-LINEAR-PART-1 (x (/ x y))))))
+
+;move!
+;i just added this; is it expensive?
+;this was causing problems, so I disabled it.
+(defthmd x-times-something>=1
+  (implies (and (case-split (<= 1 y))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                (case-split (<= 0 x)))
+           (<= x (* x y)))
+  :rule-classes :linear
+  )
+
+(defthm fl-<=-y
+  (implies (and (<= x y)
+                (case-split (not (complex-rationalp x))))
+           (<= (fl x) y)))
+
+;make a version where n is a constant?
+(defthmd fl-equal-rewrite
+  (implies (and (rationalp x)
+                (integerp n)) ;move to conclusion?
+           (equal (equal (fl x) n)
+                  (and (<= n x)
+                       (< x (+ 1 n))))))
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/fl.lisp acl2-6.3/books/rtl/rel9/arithmetic/fl.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/fl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/fl.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,611 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;My approach (and I believe this is Russinoff's approach too) for reasoning about floor and related
+;functions is to write everything in terms of fl.  Unlike floor, fl takes only 1 argument.  Furthermore, all
+;calls to floor can be rewritten to calls to fl using floor-fl
+
+(include-book "negative-syntaxp")
+(local (include-book "fl-proofs"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+;remove syntaxp hyp?
+;weird rule...
+(defthm integerp-<-non-integerp
+  (implies (and (and (syntaxp (quotep x)))
+                (not (integerp x)) 
+                (integerp n) ;backchain limit?
+                (case-split (rationalp x))
+                )
+           (equal (< n x)
+                  (<= n (fl x)))))
+
+;remove syntaxp hyp?
+;weird rule...
+(defthm non-integerp-<-integerp
+  (implies (and (and (syntaxp (quotep x)))
+                (not (integerp x)) 
+                (integerp n) ;backchain limit?
+                (case-split (rationalp x))
+                )
+           (equal (< x n)
+                  (< (fl x) n))))
+
+(defthm a10
+  (and (implies (integerp i) (equal (fl i) i))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))) ;drop?
+                (and (equal (fl (+ i x1)) (+ i (fl x1)))
+                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2)))
+                (and (equal (fl (+ x1 (+ i x2)))
+                            (+ i (fl (+ x1 x2))))
+                     (equal (fl (+ x1 (+ x2 i)))
+                            (+ i (fl (+ x1 x2))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3)))
+                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
+                            (+ i (fl (+ x1 x2 x3))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
+                            (+ i (fl (+ x1 x2 x3))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3))
+                     (case-split (rationalp x4)))
+                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))))))
+
+(defthm a12
+  (implies (and (integerp i)
+                (integerp j)
+                (< 1 j)
+                (< j i))
+           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
+                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
+  :rule-classes :linear)
+
+;why "fl-def" in the names?  this isn't a definition...
+
+;make a separate rewrite-version
+(defthm fl-def-linear-part-1
+  (implies (case-split (not (complex-rationalp x))) 
+           (<= (fl x) x))
+  :rule-classes (:rewrite (:linear :trigger-terms ((fl x)))))
+
+(defthm fl-def-linear-part-2
+  (implies (case-split (not (complex-rationalp x)))
+           (< x (1+ (fl x))))
+  :rule-classes (:rewrite (:linear :trigger-terms ((fl x)))))
+
+;later, drop the hyp completely
+;disabled since we have the rules above
+;drop this whole rule
+(defthmd a13
+  (implies (case-split (rationalp x)) ;this hyp isn't needed for the first conslusion?
+           (and (< (1- x) (fl x))
+                (<= (fl x) x)))
+  :rule-classes :linear)
+
+;disabled since we have the next rules above
+(defthmd fl-def-linear
+  (implies (case-split (rationalp x)) ;gen?
+           (and (<= (fl x) x)
+                (< x (1+ (fl x)))))
+  :rule-classes :linear)
+
+;note that FL is not strongly monotonic.  That is, x<x+ does not always imply (fl x) < (fl x+)
+;change param names to x, x+
+;try match-free :all
+(defthm fl-weakly-monotonic
+  (implies (and (<= y y+)
+                (case-split (rationalp y)) ;drop?
+                (case-split (rationalp y+)) ;drop?
+                )
+           (<= (fl y) (fl y+)))
+  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
+                 (:linear)
+                 (:forward-chaining
+                  :trigger-terms ((fl y) (fl y+))
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))
+                 (:linear
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))))
+
+;add a separate "fl of complex is 0" ?
+;because of this, I can put make (rationalp x) into (case-split (rationalp x)) for all arguments x of fl
+; (since we always can simplify the other case, the split is nice)
+(defthm fl-of-non-rational
+  (implies (not (rationalp x))
+           (equal (fl x)
+                  0)))
+
+(defthmd fl-minus
+  (implies (rationalp x)
+           (equal (fl (* -1 x))
+                  (if (integerp x)
+                      (* -1 x)
+                    (1- (* -1 (fl x)))))))
+
+;bad? free var.
+(defthm fl-monotone-linear
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y))
+           (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+
+;may need to disable?
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (fl x) (/ n)))
+                  (fl (/ x n)))))
+
+(defthm fl/int-rewrite-alt
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (/ n) (fl x)))
+                  (fl (/ x n)))))
+
+(defthm fl-integer-type
+  (integerp (fl x))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than fl-integer-type and might be worse
+(in-theory (disable (:type-prescription fl)))
+
+(defthm fl-int
+  (implies (integerp x)
+           (equal (fl x) x)))
+
+;bad name?
+(defthm fl-integerp
+  (equal (equal (fl x) x)
+         (integerp x)))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+;ACL2 already knows these facts about FL, but we include them anyway
+(defthm fl-rational
+  (rationalp (fl x)))
+
+(defthm fl-integer
+  (integerp (fl x)))
+
+;add "fl of negative is negative" type rule? (actually 2 posibilities?)
+(defthm fl-non-negative-integer-type-prescription
+  (implies (<= 0 x)
+           (and (<= 0 (fl x))
+                (integerp (fl x))))
+  :rule-classes (:type-prescription))
+
+(defthm fl-less-than-zero
+  (implies (case-split (rationalp x))
+           (equal (< (fl x) 0)
+                  (< x 0))))
+
+;use rifx?
+;prove a version for fl negative? (also t-p rules for that?)
+(defthm fl-non-negative-linear
+  (implies (<= 0 x)
+           (<= 0 (fl x)))
+  :rule-classes (:linear))
+
+
+
+;rename to start with fl-
+;needed? - any constant, not just integers
+;replace the rule to pull out an integer?
+;BOZO do we want to use rem here???
+(defthm pull-constant-out-of-fl
+  (implies (and (syntaxp (and (quotep c1) (>= (abs (cadr c1)) 1)))
+                (rationalp c1)
+                (rationalp x))
+           (equal (fl (+ c1 x))
+                  (+ (truncate c1 1) (fl (+ (rem c1 1) x))))))
+
+;fl-minus?
+
+;this can loop with fl-minus-gen (when the result of applying fl-minus-gen doesn't get simplfied before we
+;build the linear pot list)??
+;maybe fl-minus-gen is enough?
+;why disabled?
+(defthmd fl-minus-factor
+  (implies (and (syntaxp (quotep k))
+                (< k 0)
+                (rationalp k)
+                (rationalp x))
+           (equal (fl (* k x))
+                  (if (integerp (* k x))
+                      (* -1 (fl (* (- k) x)))
+                      (+ -1 (- (fl (* (- k) x))))))))
+
+(defthm fl-<-integer
+  (implies (and (integerp y)
+                (case-split (rationalp x)))
+           (equal (< (fl x) y)
+                  (< x y))))
+
+(defthm fl->-integer
+  (implies (and (integerp y)
+                (case-split (rationalp x)))
+           (equal (< y (fl x))
+                  (<= (+ 1 y) x))))
+             
+
+;should this be disabled?
+(defthm fl-equal-0
+  (implies (case-split (rationalp x))
+           (equal (equal (fl x) 0)
+                  (and (<= 0 x)
+                       (< x 1)))))
+
+;kill this? or is this nice b/c it makes no change if its hyps fail to be satisfied?
+(defthmd fl-equal-0-alt
+  (implies (and (< x 1)
+                (<= 0 x)
+                (case-split (rationalp x))
+                )
+           (equal (fl x) 0)))
+
+;bad names?                  
+;fl-def-linear isn't rewrite!
+;remove this??
+(defthm fl-strong-monotone
+  (implies (and (< x y)
+                (rationalp x)
+                (rationalp y)
+                )
+           (< (fl x) y)))
+
+;remove this??
+;make linear?
+(defthm fl-weak-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                )
+           (<= (fl x) y)))
+
+;kill one of these?
+(defthm fl-def-linear-quotient
+  (implies (and (< 0 y)
+                (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (and (not (< X (* Y (FL (* X (/ Y))))))
+                (not (< X (* Y (FL (* (/ Y) X))))))))
+
+;Our scheme for dealing with FLOOR is to always rewrite calls of it to FL
+(defthm floor-fl
+  (equal (floor m n) 
+         (fl (/ m n))))
+
+(theory-invariant (incompatible (:rewrite floor-fl)
+                                (:definition fl))
+                  :key floor-fl--and--fl--conflict)
+
+;perhaps always split on even/odd for fl(x/2)
+;needed? was in proof.lisp for x87 recip proof
+(defthm fl-of-odd/2
+  (implies (and (integerp x)
+                (not (integerp (* 1/2 x)))
+                )
+           (equal (fl (* 1/2 x))
+                  (- (* 1/2 x) 1/2))))
+
+(defthm fl-of-even/2
+  (implies (and (INTEGERP (* X (/ 2))))
+           (equal (fl (* 1/2 x))
+                  (* 1/2 x))))
+
+;new version
+;may be expensive
+(defthmd fl-force-to-0
+  (implies (case-split (rationalp x))
+           (equal (equal 0 (fl x))
+                  (and (<= 0 x)
+                       (< x 1)))))
+
+;generalize to any amount of shifting each time and to any base (2,3, etc.)?
+
+;is there a linear rule missing?  why did we need to :use fl-def-linear?
+;(both expressions shift x right n+1 spots and chop)
+
+
+;attempted addition 1/7/02:
+
+;make linear?
+;bad name?
+(defthm fl-factor-out-integer-bound
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x)
+                )
+           (<= (* n (fl x))
+               (fl (* n x)))))
+
+;make linear?
+;bad name?
+(defthm fl-factor-out-integer-bound-2
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp m)
+                )
+           (<= (* n (fl (* m (/ n))))
+               (fl m))))
+
+;see sse-div.lisp for better versions of the above
+
+#| for reference:
+(DEFTHM FL-DEF-LINEAR
+  (IMPLIES (RATIONALP X)
+           (AND (<= (FL X) X) (< X (1+ (FL X)))))
+  :RULE-CLASSES :LINEAR)
+|#
+
+;these thms are about getting rid of one of two (roughly) "nested" calls to fl
+
+;why??
+(defthm fl-plus-integer-eric
+  (implies (and (integerp n)
+                (case-split (rationalp x)) ;not true if x is a complex-rationalp
+                )
+           (equal (fl (+ x n))
+                  (+ n (fl x)))))
+
+(local (in-theory (disable floor-fl)))
+
+;BOZO move!
+;strictly better than the version in the arithmetic books
+(defthm quotient-numer-denom-eric
+  (implies (and (integerp x)
+                (<= 0 x) ; was (< 0 x)
+                (integerp y)
+                (<= 0 y)) ;was (< 0 y)
+           (equal (nonnegative-integer-quotient (numerator (/ x y))
+                                                (denominator (/ x y)))
+                  (nonnegative-integer-quotient x y))))
+
+;(in-theory (disable QUOTIENT-NUMER-DENOM))
+
+; rewrites things like (EQUAL (* 32768 (FL (* 1/32768 x))) x)
+(defthmd fl-claim-rewrite-to-integerp-claim-gen
+  (implies (and (equal k-inverse (/ k))
+                (case-split (acl2-numberp k))
+                (case-split (not (equal k 0)))
+                (case-split (acl2-numberp x))
+                )
+           (and (equal (EQUAL (* k (FL (* k-inverse X))) X)
+                       (integerp (* k-inverse x)))
+                (equal (EQUAL (* k (FL (* X k-inverse))) X)
+                       (integerp (* k-inverse x))))))
+
+(defthm fl-claim-rewrite-to-integerp-claim-gen-2
+  (implies (and (equal k-inverse (/ k))
+                (case-split (acl2-numberp k))
+                (case-split (not (equal k 0)))
+                (case-split (acl2-numberp x))
+                (case-split (acl2-numberp y))
+                )
+           (and (equal (EQUAL (* k (FL (* k-inverse X y))) (* X y))
+                       (integerp (* k-inverse x y)))
+                (equal (EQUAL (* k (FL (* X k-inverse y))) (* X y))
+                       (integerp (* k-inverse x y)))
+                (equal (EQUAL (* k (FL (* X y k-inverse))) (* X y))
+                       (integerp (* k-inverse x y))))))
+
+(defthm fl-claim-rewrite-to-integerp-claim
+  (implies (and (syntaxp (and (quotep k-inverse)
+                              (quotep k)))
+                (equal k-inverse (/ k))
+                (case-split (acl2-numberp k))
+                (case-split (not (equal k 0)))
+                (case-split (acl2-numberp x))
+                )
+           (and (equal (EQUAL (* k (FL (* k-inverse X))) X)
+                       (integerp (* k-inverse x)))
+                (equal (EQUAL (* k (FL (* X k-inverse))) X)
+                       (integerp (* k-inverse x))))))
+
+;move! rename?
+(defthm y-is-odd
+  (equal (EQUAL Y (+ 1 (* 2 (FL (* 1/2 Y)))))
+         (and (integerp y)
+              (not (integerp (* 1/2 y))))))
+
+(defthm fl-minus-gen
+  (implies (and (syntaxp (negative-syntaxp x))
+                (case-split (rationalp x))
+                )
+          (EQUAL (FL x)
+                 (IF (INTEGERP X)
+                     (* -1 (FL (* -1 X)))
+                     (+ -1 (- (FL (* -1 X))))))))
+
+(defthmd fl-of-fraction-max-change-case-1
+  (implies (and (not (integerp (/ p q))) ;this case
+                (integerp p)
+                (integerp q)
+                (< 0 q)
+                )
+           (>= (+ 1 (fl (/ p q)))
+               (+ (/ p q) (/ q)))))
+
+(defthmd fl-of-fraction-max-change-case-2
+  (implies (and (integerp (/ p q)) ;this case
+                (integerp p)
+                (integerp q)
+                (< 0 q)
+                )
+           (>= (+ 1 (fl (/ p q)))
+               (+ (/ p q) (/ q)))))
+
+;fl(p/q) + 1 >= p/q + 1/q
+;similar to  fl-of-fraction-upper-bound
+;rephrase the conclusion
+; if fl changes it argument, it does so by at most 1-1/q
+(defthm fl-of-fraction-max-change
+  (implies (and (< 0 q)
+                (integerp p)
+                (integerp q)
+                )
+           (>= (+ 1 (fl (/ p q)))
+               (+ (/ p q) (/ q)))))
+
+; Two integers, both in the interval (x,y], whose width is at most 1, must be equal.
+;make other versions?
+;move?
+(defthm int-unique
+  (implies (and (integerp i)
+                (integerp j)
+                (rationalp x)
+                (rationalp y)
+                (<= x y)
+                (< x i) (<= i y)
+                (< x j) (<= j y)
+                (<= (- y x) 1)
+                )
+           (equal i j))
+  :rule-classes nil
+  )
+
+;replace fl-unique?
+(defthm fl-unique-2
+  (implies (rationalp x)
+           (equal (and (integerp n)
+                       (<= n x)
+                       (< x (1+ n)))
+                  (equal (fl x) n)))
+  :rule-classes nil)  
+
+(defthm fl-m+1
+  (implies (and (integerp m)
+                (integerp n)
+                (>= m 0)
+                (> n 0))
+           (= (fl (- (/ (1+ m) n)))
+              (1- (- (fl (/ m n))))))
+  :rule-classes ())
+
+
+
+
+
+;this was the point of nniq-eric-5 to nniq-8 in basic.  how does this get proved without nniq-eric-8?
+;if fl changes its argument of p/q, it does so by at least a qth
+;rephrase concl?
+;make a linear rule?
+(defthmd fl-of-fraction-min-change
+  (implies (and (not (integerp (/ p q)))
+                (integerp p)
+                (integerp q)
+                )
+           (<= (/ q)
+               (- (/ p q) (fl (/ p q)))))  ;the amt of change made by fl
+  )
+
+;bad name? improve this?
+;BOZO call quot-bnd-2? or fl-bnd-2?
+(defthm fl-bound
+  (implies (and (< 0 y)
+                (rationalp x)
+                (rationalp y)
+                )
+           (<= (* y (FL (* x (/ y)))) x)))
+
+;see fl-bound
+;BOZO rename?, params
+(defthm quot-bnd
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* y (fl (/ x y)))
+               x))
+  :rule-classes :linear)
+
+;move!
+;i just added this; is it expensive?
+;this was causing problems, so I disabled it.
+(defthmd x-times-something>=1
+  (implies (and (case-split (<= 1 y))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                (case-split (<= 0 x)))
+           (<= x (* x y)))
+  :rule-classes :linear
+  )
+
+(defthm fl-<=-y
+  (implies (and (<= x y)
+                (case-split (not (complex-rationalp x))))
+           (<= (fl x) y)))
+
+;make a version where n is a constant?
+(defthmd fl-equal-rewrite
+  (implies (and (rationalp x)
+                (integerp n)) ;move to conclusion?
+           (equal (equal (fl x) n)
+                  (and (<= n x)
+                       (< x (+ 1 n))))))
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/floor-proofs.lisp acl2-6.3/books/rtl/rel9/arithmetic/floor-proofs.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/floor-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/floor-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,306 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "ground-zero"))
+(local (include-book "fp2"))
+(local (include-book "denominator"))
+(local (include-book "numerator"))
+(local (include-book "predicate"))
+(local (include-book "nniq"))
+(local (include-book "product"))
+(local (include-book "unary-divide"))
+(local (include-book "rationalp"))
+(local (include-book "inverted-factor"))
+(local (include-book "../../../meta/meta-plus-lessp"))
+; (thm (rationalp (floor i j)))) goes through
+
+
+
+(defthm floor-non-negative-integerp-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                (case-split (not (complex-rationalp j))) ;gen?
+                )
+           (and (<= 0 (floor i j))
+                (integerp (floor i j))))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable floor)
+                              '()))
+          ))
+
+;nope. (floor #C(0 -1)  #C(0 -1)) = 1
+;(defthm floor-with-j-non-rational
+;  (implies (not (rationalp j))
+ ;          (equal (floor i j)
+  ;                0))
+;  :hints (("Goal" :in-theory (set-difference-theories
+ ;                             (enable floor)
+  ;                            '(a13 FL-WEAKLY-MONOTONIC)))
+   ;       ))
+
+
+(defthm floor-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                (case-split (not (complex-rationalp i)));drop?
+                ;(case-split (rationalp j))
+                )
+           (<= 0 (floor i j)))
+
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable floor)
+                              '()))
+          ))
+
+
+(defthm floor-with-i-not-rational-but-j-rational
+  (implies (and (not (rationalp i))
+                (rationalp j)
+                )
+           (equal (floor i j)
+                  0))
+  :hints (("Goal" :in-theory (enable floor)))
+)
+
+
+(defthm floor-compare-to-zero
+  (implies (and (case-split (rationalp i))
+                (case-split (rationalp j)))
+           (equal (< (floor i j) 0)
+                  (or (and (< i 0) (< 0 j))
+                      (and (< 0 i) (< j 0))
+                      )))
+  :hints (("Goal" :in-theory (enable floor)))
+  )
+
+(defthm floor-of-non-acl2-number
+  (implies (not (acl2-numberp i))
+           (and (equal (floor i j)
+                       0)
+                (equal (floor j i)
+                       0)))
+  :hints (("Goal" :in-theory (enable floor)))
+  )
+
+;linear? how should it be phrased?
+;too many hints.  without the frac-coeff rule, things worked out here
+(defthm floor-upper-bound
+    (implies (and (case-split (rationalp i))
+                  (case-split (rationalp j))
+                  )
+	     (<= (floor i j) (/ i j)))
+    :hints (("Goal" :use ( (:instance nonnegative-integer-quotient-lower-bound-rewrite
+                                      (i (* -1 (NUMERATOR (* I (/ J)))))
+                                      (j (DENOMINATOR (* I (/ J)))))
+                           (:instance  nonnegative-integer-quotient-upper-bound-rewrite
+                                      (i (* -1 (NUMERATOR (* I (/ J)))))
+                                      (j (DENOMINATOR (* I (/ J)))))
+                           (:instance  nonnegative-integer-quotient-lower-bound-rewrite
+                                      (i (NUMERATOR (* I (/ J))))
+                                      (j (DENOMINATOR (* I (/ J)))))
+                           (:instance  nonnegative-integer-quotient-upper-bound-rewrite
+                                      (i (NUMERATOR (* I (/ J))))
+                                      (j (DENOMINATOR (* I (/ J))))))
+                           
+             :in-theory (set-difference-theories
+                         (enable floor)
+                         '(  nonnegative-integer-quotient-lower-bound-rewrite
+                             nonnegative-integer-quotient-upper-bound-rewrite
+                           ))))
+    :rule-classes (:rewrite (:linear :trigger-terms ((floor i j))))
+  )
+
+
+
+(defthm floor-equal-i-over-j-rewrite
+  (implies (and (case-split (not (equal j 0)))
+                (case-split (rationalp i))
+                (case-split (rationalp j))
+                )
+           (equal (EQUAL (* J (FLOOR I J)) I)
+                  (integerp (* i (/ j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable floor)
+                              '( nonnegative-integer-quotient-lower-bound-rewrite
+                                 nonnegative-integer-quotient-max-value-rewrite))
+           :use(
+                (:instance  nonnegative-integer-quotient-max-value-rewrite
+                            (i (* -1 (NUMERATOR (* I (/ J)))))
+                            (j (DENOMINATOR (* I (/ J)))))
+           
+                (:instance  nonnegative-integer-quotient-lower-bound-rewrite
+                            (i (* -1 (NUMERATOR (* I (/ J)))))
+                            (j (DENOMINATOR (* I (/ J))))))
+           )  )
+  )
+
+
+
+(defthm dumb
+  (equal (< x x)
+         nil))
+
+(defthm floor-with-j-zero
+  (equal (floor i 0)
+                  0)
+  :hints (("Goal" :in-theory (enable floor)))
+)
+
+
+;(defthm floor-greater-than-zero-rewrite
+ ; (equal (< 0 (fl i j))
+  ;       (
+
+(defthm floor-upper-bound-2
+  (implies (and (<= 0 j)
+                (case-split (rationalp i))
+                (case-split (rationalp j))
+                (case-split (not (equal j 0)))
+                )
+           (<= (* j (floor i j)) i))
+  :hints (("Goal" :in-theory (disable  floor-upper-bound)
+           :use  floor-upper-bound))
+  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j))))
+
+  )
+
+
+(defthm floor-upper-bound-3
+  (implies (and (<= j 0)
+                (case-split (rationalp i))
+                (case-split (rationalp j))
+                (case-split (not (equal j 0)))
+                )
+           (<= i (* j (floor i j))))
+  :hints (("Goal" :in-theory (disable  floor-upper-bound)
+           :use  floor-upper-bound))
+  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j))))
+
+  )
+
+
+;BOZO remove the disables (and prove better nniq rules, and disable nniq!)
+(defthm floor-lower-bound
+  (implies (and (case-split (rationalp i))
+                (case-split (rationalp j))
+                )
+           (< (+ -1 (* i (/ j))) (floor i j)))
+  :otf-flg t
+  :hints (("Goal"
+             
+           :in-theory (set-difference-theories
+                       (enable floor)
+                       '( ;why do these disables help so much?
+                         less-than-multiply-through-by-inverted-factor-from-left-hand-side
+                         less-than-multiply-through-by-inverted-factor-from-right-hand-side
+                         EQUAL-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE
+                         )
+                       )))
+  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
+
+
+
+
+
+(defthm floor-when-arg-quotient-isnt-rational
+  (IMPLIES (NOT (RATIONALP (* i (/ j))))
+           (EQUAL (FLOOR i j) 0))
+  :hints (("Goal" :in-theory (enable floor))))
+
+(defthm floor-of-non-rational-by-one
+  (implies (not (rationalp i))
+           (equal (floor i 1)
+                  0))
+  :hints (("Goal" :in-theory (enable floor))))
+
+(defthm floor-of-rational-and-complex
+  (implies (and (rationalp i)
+                (not (rationalp j))
+                (case-split (acl2-numberp j)))
+           (and (equal (floor i j)
+                       0)
+                (equal (floor j i)
+                       0)))
+  :hints (("Goal" :in-theory (enable floor))))
+
+#|
+(defthm floor-of-two-complexes
+  (implies (and (complex-rationalp i)
+                (complex-rationalp j))
+           (equal (floor i j)
+                  (if (rationalp (/ i j))
+                      (floor (/ i j) 1)
+                    0)))
+  :hints (("Goal" :in-theory (enable floor))))
+|#
+
+(defthm floor-with-i-not-rational
+  (implies (not (rationalp i))
+           (equal (floor i j)
+                  (if (and (complex-rationalp i) (complex-rationalp j) (rationalp (/ i j)))
+                      (floor (/ i j) 1)
+                    0)))
+  :hints (("Goal" :in-theory (enable floor))))
+
+(defthm floor-with-j-not-rational
+  (implies (not (rationalp j))
+           (equal (floor i j)
+                  (if (and (complex-rationalp i) (complex-rationalp j) (rationalp (/ i j)))
+                      (floor (/ i j) 1)
+                    0)))
+  :hints (("Goal" :in-theory (enable floor))))
+
+
+
+
+(defthm floor-with-j-not-rational-but-i-rational
+  (implies (and (not (rationalp i))
+                (rationalp j)
+                )
+           (equal (floor i j)
+                  0)))
+
+#|
+(defthm floor-by-one-equal-zero
+  (implies (and (rationalp i)
+                (rationalp j))
+           (equal (EQUAL 0 (FLOOR (* i (/ j)) 1))
+                  (integerp (* i (/ j)))))
+  :hints (("Goal" :in-theory (enable floor)))
+)
+|#
+
+(defthm floor-of-zero
+  (equal (floor 0 j)
+         0))
+
+(defthm floor-of-integer-by-1
+  (implies (integerp i)
+           (equal (floor i 1)
+                  i))
+  :hints (("Goal" :in-theory (enable  floor))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/floor.lisp acl2-6.3/books/rtl/rel9/arithmetic/floor.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/floor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/floor.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,223 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;see floor-proofs for all proofs (and todos?)
+
+(local (include-book "floor-proofs"))
+
+;;
+;; Behavior of floor when its guards are violated
+;;
+
+;this looks like it might loop! add syntaxp hyp that j isn't 1?
+(defthm floor-with-i-not-rational
+  (implies (not (rationalp i))
+           (equal (floor i j)
+                  (if (and (complex-rationalp i) (complex-rationalp j) (rationalp (/ i j)))
+                      (floor (/ i j) 1) ;yuck, defines floor in terms of itself
+                    0))))
+
+(defthm floor-with-j-not-rational
+  (implies (not (rationalp j))
+           (equal (floor i j)
+                  (if (and (complex-rationalp i) (complex-rationalp j) (rationalp (/ i j)))
+                      (floor (/ i j) 1) ;yuck, defines floor in terms of itself
+                    0))))
+
+;special case of floor-with-i-not-rational but contains no if
+(defthm floor-with-i-not-rational-but-j-rational
+  (implies (and (not (rationalp i))
+                (rationalp j)
+                )
+           (equal (floor i j)
+                  0)))
+
+;special case of floor-with-j-not-rational but contains no if
+(defthm floor-with-j-not-rational-but-i-rational
+  (implies (and (not (rationalp i))
+                (rationalp j)
+                )
+           (equal (floor i j)
+                  0)))
+
+;;
+;; type prescriptions
+;;
+
+; (thm (integerp (floor i j)))) goes through
+
+;to gen this, prove that the quotient of 2 positive complexes is either complex or positive. (that's a type!)
+;I have a marvelous proof of that fact, but this buffer is too small to contain it.
+;(Actually, it's in my green notebook.)
+
+(defthm floor-non-negative-integerp-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                (case-split (not (complex-rationalp j))) ;I think I can drop this hyp, but it will take some work.
+                )
+           (and (<= 0 (floor i j))
+                (integerp (floor i j))))
+  :rule-classes (:type-prescription))
+
+
+
+;(floor #C(-4 -3) #C(4 3))= -1
+
+(defthm floor-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                (case-split (not (complex-rationalp i)));(case-split (rationalp i));drop?
+                )
+           (<= 0 (floor i j))))
+
+
+
+
+
+(defthm floor-compare-to-zero
+  (implies (and (case-split (rationalp i))
+                (case-split (rationalp j)))
+           (equal (< (floor i j) 0)
+                  (or (and (< i 0) (< 0 j))
+                      (and (< 0 i) (< j 0))
+                      ))))
+
+(defthm floor-of-non-acl2-number
+  (implies (not (acl2-numberp i))
+           (and (equal (floor i j)
+                       0)
+                (equal (floor j i)
+                       0))))
+
+;linear? how should it be phrased?
+(defthm floor-upper-bound
+  (implies (and (case-split (rationalp i))
+                (case-split (rationalp j))
+                )
+           (<= (floor i j) (/ i j)))
+  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
+
+
+
+(defthm floor-equal-i-over-j-rewrite
+  (implies (and (case-split (not (equal j 0)))
+                (case-split (rationalp i))
+                (case-split (rationalp j))
+                )
+           (equal (equal (* j (floor i j)) i)
+                  (integerp (* i (/ j))))))
+;move
+(defthm dumb
+  (equal (< x x)
+         nil))
+
+(defthm floor-with-j-zero
+  (equal (floor i 0)
+         0))
+
+(defthm floor-with-i-zero
+  (equal (floor 0 j)
+         0))
+
+
+;(defthm floor-greater-than-zero-rewrite
+ ; (equal (< 0 (floor i j))
+  ;       (
+
+(defthm floor-upper-bound-2
+  (implies (and (<= 0 j)
+                (case-split (rationalp i))
+                (case-split (rationalp j))
+                (case-split (not (equal j 0)))
+                )
+           (<= (* j (floor i j)) i))
+  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
+
+
+(defthm floor-upper-bound-3
+  (implies (and (<= j 0) ;rarely true
+                (case-split (rationalp i))
+                (case-split (rationalp j))
+                (case-split (not (equal j 0)))
+                )
+           (<= i (* j (floor i j))))
+  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
+
+
+(defthm floor-lower-bound
+  (implies (and (case-split (rationalp i))
+                (case-split (rationalp j))
+                )
+           (< (+ -1 (* i (/ j))) (floor i j)))
+  :rule-classes (:rewrite (:linear :trigger-terms ((floor i j)))))
+
+;a bit odd
+(defthm floor-when-arg-quotient-isnt-rational
+  (implies (not (rationalp (* i (/ j))))
+           (equal (floor i j) 0)))
+
+(defthm floor-of-non-rational-by-one
+  (implies (not (rationalp i))
+           (equal (floor i 1)
+                  0)))
+
+(defthm floor-of-rational-and-complex
+  (implies (and (rationalp i)
+                (not (rationalp j))
+                (case-split (acl2-numberp j)))
+           (and (equal (floor i j)
+                       0)
+                (equal (floor j i)
+                       0))))
+
+#|
+(defthm floor-of-two-complexes
+  (implies (and (complex-rationalp i)
+                (complex-rationalp j))
+           (equal (floor i j)
+                  (if (rationalp (/ i j))
+                      (floor (/ i j) 1)
+                    0)))
+  :hints (("Goal" :in-theory (enable floor))))
+|#
+
+
+
+
+#|
+(local
+ (defthm floor*2
+   (implies (integerp x)
+            (equal (floor (* 2 x) 2) x))
+   :hints (("Goal" :in-theory (enable floor)))
+   ))
+|#
+
+(defthm floor-of-integer-by-1
+  (implies (integerp i)
+           (equal (floor i 1)
+                  i))
+  :hints (("Goal" :in-theory (enable  floor))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/fp.lisp acl2-6.3/books/rtl/rel9/arithmetic/fp.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/fp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/fp.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,334 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;Rename this book, since the guts have been ripped out?
+;BOZO clean up this book?
+;BOZO move these lemmas to extra?
+#|
+
+This book contains a few lemmas which are exported in lib/arith but which aren't needed in support/ or
+arithmetic/.  
+
+|#
+
+(local (include-book "fp2"))
+
+(defthm rearrange-fractional-coefs-<
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< (* (/ c) x) z)
+                   (< x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ (* (/ c) x) y) z)
+                   (< (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ y (* (/ c) x)) z)
+                   (< (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< (+ y1 y2 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< (+ y1 y2 y3 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) (* c y3) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< z (* (/ c) x))
+                   (< (* c z) x)))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ (* (/ c) x) y))
+                   (< (* c z) (+ x (* c y)))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ y (* (/ c) x)))
+                   (< (* c z) (+ (* c y) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 y3 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) (* c y3) x))))))
+
+
+(defthm rearrange-fractional-coefs-equal
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (equal (* (/ c) x) z)
+                 (equal x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ (* (/ c) x) y) z)
+                 (equal (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ y (* (/ c) x)) z)
+                 (equal (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 (* (/ c) x)) z)
+                 (equal (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 y3 (* (/ c) x)) z)
+                 (equal (+ (* c y1) (* c y2) (* c y3) x) (* c z))))))
+
+
+
+; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
+; product of a and b given intervals for a and b.  We consider three kinds of intervals.
+; We discuss only the a case.
+
+; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
+
+; nonneg-open intervals mean 0<=a<amax.
+
+; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
+
+; We now prove theorems with names like abs*nonneg-open, etc. characterizing
+; the product of two elements from two such interals.  All of these theorems
+; are made with :rule-classes nil because I don't know how to control their
+; use.
+
+(encapsulate nil
+  (local 
+   (defthm renaming
+    (implies (and (rationalp a)
+                  (rationalp xmax)
+                  (rationalp b)
+                  (rationalp bmax)
+                  (< (- xmax) a)
+                  (<= a xmax)
+                  (< 0 xmax)
+                  (<= 0 b)
+                  (< b bmax))
+             (and (< (- (* xmax bmax)) (* a b))
+                  (< (* a b) (* xmax bmax))))
+    :hints (("Goal" :cases ((equal b 0))))))
+
+; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
+; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
+; lemma would be no different.
+
+  (defthm abs*nonneg-open
+    (implies (and (rationalp a)
+                  (rationalp amax)
+                  (rationalp b)
+                  (rationalp bmax)
+                  (< (- amax) a)
+                  (<= a amax)       ; (< a amax) is all we'll ever use, I bet.
+                  (< 0 amax)
+                  (<= 0 b)
+                  (< b bmax))
+             (and (< (- (* amax bmax)) (* a b))
+                  (< (* a b) (* amax bmax))))
+    :hints (("Goal" :by renaming))
+    :rule-classes nil))
+
+(defthm abs*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :hints (("Goal" :cases ((equal b 0))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* b a))
+                (< (* b a) (* amax bmax))))
+  :hints (("Goal" :use abs*nonneg-closed))
+  :rule-classes nil)
+
+(defthm nonneg-open*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* bmax amax)) (* a b))
+                (< (* a b) (* bmax amax))))
+    :hints (("Goal" :use abs*nonneg-open))
+    :rule-classes nil)
+
+; The next three, which handle nonnegative open intervals in the first argument,
+; can actually be seen as uses of the abs intervals above.  Simply observe that
+; if 0<=a<amax then -amax<a<amax.
+
+(defthm nonneg-open*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :hints (("Goal" :use abs*nonneg-closed))
+  :rule-classes nil)
+
+(defthm nonneg-open*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :hints (("Goal" :use abs*nonneg-open))
+  :rule-classes nil)
+
+; and the commuted version
+(defthm nonneg-closed*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* b a))
+                (< (* b a) (* amax bmax))))
+  :hints (("Goal" :use nonneg-open*nonneg-closed))
+  :rule-classes nil)
+
+(defthm nonneg-closed*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (<= a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (<= (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm abs*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (< (- bmax) b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :hints (("Goal" :cases ((< b 0) (> b 0))))
+  :rule-classes nil)  
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/fp2.lisp acl2-6.3/books/rtl/rel9/arithmetic/fp2.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/fp2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/fp2.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,804 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This file was created by J Moore and Matt Kaufmann in 1995 in support of
+; their proof of the AMD-K5 division code.
+
+;this is eric's version of fp.lisp
+;note that it doesn't mention fl
+
+(in-package "ACL2")
+
+
+(local (include-book "../../../ihs/ihs-definitions"))
+(local (include-book "../../../ihs/ihs-lemmas"))
+(local (include-book "../../../ihs/ihs-lemmas"))
+
+; The following is (minimal-ihs-theory)
+(local (PROGN (IN-THEORY NIL)
+              (IN-THEORY (ENABLE BASIC-BOOT-STRAP
+                                 IHS-MATH QUOTIENT-REMAINDER-RULES
+                                 LOGOPS-LEMMAS-THEORY))))
+
+(local (in-theory (enable logops-definitions-theory)))
+
+
+
+(defthm a1 (equal (+ x (+ y z)) (+ y (+ x z))))
+(defthm a2 (equal (- x) (* -1 x)))
+
+(local (in-theory (disable functional-commutativity-of-minus-*-right
+                           functional-commutativity-of-minus-*-left)))
+
+(defthm a3
+  (and (implies (syntaxp (and (quotep c1) (quotep c2)))
+                (and (equal (+ (* c1 x) (* c2 x)) (* (+ c1 c2) x))
+                     (equal (+ (* c1 x) (+ (* c2 x) y)) (+ (* (+ c1 c2) x) y))))
+       (implies (syntaxp (quotep c2))
+                (and (equal (+ x (* c2 x)) (* (+ 1 c2) x))
+                     (equal (+ x (+ (* c2 x) y1)) (+ (* (+ 1 c2) x) y1))
+                     (equal (+ x (+ y1 (* c2 x))) (+ (* (+ 1 c2) x) y1))
+                     (equal (+ x (+ y1 (+ (* c2 x) y2))) (+ (* (+ 1 c2) x) y1 y2))
+                     (equal (+ x (+ y1 (+ y2 (* c2 x)))) (+ (* (+ 1 c2) x) y1 y2))
+                     (equal (+ x (+ y1 (+ y2 (+ y3 (* c2 x)))))
+                            (+ (* (+ 1 c2) x) y1 y2 y3))
+                     (equal (+ x (+ y1 (+ y2 (+ (* c2 x) y3))))
+                            (+ (* (+ 1 c2) x) y1 y2 y3))))
+       (and (equal (+ x x) (* 2 x))
+            (equal (+ x (+ x y1)) (+ (* 2 x) y1)))))
+
+(defthm a4
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (+ c1 (+ c2 y1)) (+ (+ c1 c2) y1))))
+(defthm a5
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (* c1 (* c2 y1)) (* (* c1 c2) y1))))
+
+(defthm a6
+  (equal (/ (/ x)) (fix x)))
+
+(defthm a7
+  (equal (/ (* x y)) (* (/ x) (/ y))))
+
+;replaced force with case-split
+(defthm a8
+  (implies (and (case-split (acl2-numberp x))
+                (case-split (not (equal x 0))))
+           (and (equal (* x (* (/ x) y)) (fix y))
+                (equal (* x (/ x)) 1)))
+  :hints (("Goal" :cases ((acl2-numberp x))))
+)
+
+(in-theory (disable inverse-of-*))
+
+;separate these out?
+(defthm a9
+  (and (equal (* 0 x) 0)
+       (equal (* x (* y z)) (* y (* x z)))
+       (equal (* x (+ y z)) (+ (* x y) (* x z)))
+       (equal (* (+ y z) x) (+ (* y x) (* z x)))))
+
+
+
+#|
+
+(local (defthm evenp--k
+  (implies (integerp k) (equal (evenp (- k)) (evenp k)))
+  :hints
+  (("Goal" :in-theory (set-difference-theories
+                       (enable evenp
+                               functional-commutativity-of-minus-*-right
+                               functional-commutativity-of-minus-*-left)
+                       '(a2 a5))))))
+
+(local (defthm evenp-2k
+  (implies (integerp k) (evenp (* 2 k)))
+  :hints (("Goal" :in-theory (enable evenp)))))
+                                              
+(local (defthm evenp-expt-2
+  (implies (and (integerp k)
+                (> k 0))
+           (evenp (expt 2 k)))
+  :hints (("Goal" :in-theory (enable evenp expt)))))
+                                              
+(local (defthm evenp-+-even
+  (implies (evenp j) (equal (evenp (+ i j)) (evenp i)))
+  :hints (("Goal" :in-theory (enable evenp)))))
+
+
+|#
+
+;I want to use some theoremes in arithmetic-2, but the theorems I want to prove have the same names as those,
+;so I export them from the encapsulate with -alt appended to the names.
+
+
+(local 
+ (encapsulate 
+  ()
+             
+  (local (include-book "../../../arithmetic-2/meta/non-linear"))
+
+;BOZO generalize the (rationalp x) hyp (is it enough that, say, y be rational?)
+  (defthm *-weakly-monotonic-alt
+    (implies (and (<= y y+)
+                  (<= 0 x) ;reordered to put this first!
+                  (rationalp x) ; This does not hold if x, y, and z are complex!
+                  )
+             (<= (* x y) (* x y+)))
+    :hints (("Goal" :cases ((equal x 0))))
+    :rule-classes
+    ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+     (:linear)
+     (:forward-chaining
+      :trigger-terms ((* y x) (* y+ x))
+      :corollary
+      (implies (and (<= y y+)
+                    (<= 0 x)
+                    (rationalp x)
+                    )
+               (<= (* y x) (* y+ x))))
+     (:linear
+      :corollary
+      (implies (and (<= y y+)
+                    (rationalp x)
+                    (<= 0 x))
+               (<= (* y x) (* y+ x))))))
+
+  (defthm *-strongly-monotonic-alt
+    (implies (and (< y y+)
+                  (rationalp x)
+                  (< 0 x))
+             (< (* x y) (* x y+)))
+    :rule-classes
+    ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+     (:linear)
+     (:forward-chaining
+      :trigger-terms ((* y x) (* y+ x))
+      :corollary
+      (implies (and (< y y+)
+                    (rationalp x)
+                    (< 0 x))
+               (< (* y x) (* y+ x))))
+     (:linear
+      :corollary
+      (implies (and (< y y+)
+                    (rationalp x)
+                    (< 0 x))
+               (< (* y x) (* y+ x))))))
+
+  (defthm *-weakly-monotonic-negative-multiplier-alt
+    (implies (and (<= y y+)
+                  (rationalp x)
+                  (< x 0))
+             (<= (* x y+) (* x y)))
+    :rule-classes
+    ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+     (:linear)
+     (:forward-chaining
+      :trigger-terms ((* y x) (* y+ x))
+      :corollary
+      (implies (and (<= y y+)
+                    (rationalp x)
+                    (< x 0))
+               (<= (* y+ x) (* y x))))
+     (:linear
+      :corollary
+      (implies (and (<= y y+)
+                    (rationalp x)
+                    (< x 0))
+               (<= (* y+ x) (* y x))))))
+
+  (defthm *-strongly-monotonic-negative-multiplier-alt
+    (implies (and (< y y+)
+                  (rationalp x)
+                  (< x 0))
+             (< (* x y+) (* x y)))
+    :rule-classes
+    ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+     (:linear)
+     (:forward-chaining
+      :trigger-terms ((* y x) (* y+ x))
+      :corollary
+      (implies (and (< y y+)
+                    (rationalp x)
+                    (< x 0))
+               (< (* y+ x) (* y x))))
+     (:linear
+      :corollary
+      (implies (and (< y y+)
+                    (rationalp x)
+                    (< x 0))
+               (< (* y+ x) (* y x))))))
+
+
+  (defthm /-weakly-monotonic-alt
+    (implies (and (<= y y+)
+                  (rationalp y)
+                  (rationalp y+)
+                  (< 0 y))
+             (<= (/ y+) (/ y)))
+    :rule-classes
+    ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+
+  (defthm /-strongly-monotonic-alt
+    (implies (and (< y y+)
+                  (rationalp y)
+                  (rationalp y+)
+                  (< 0 y))
+             (< (/ y+) (/ y)))
+    :rule-classes
+    ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+  )
+ )
+
+
+
+
+
+(defthm /-weakly-monotonic
+  (implies (and (<= y y+)
+;                (not (equal 0 y))
+                (< 0 y) ;gen?
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (<= (/ y+) (/ y)))
+  :hints (("Goal" :use ( /-WEAKLY-MONOTONIC-ALT
+                  )))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+
+(defthm /-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 y) ;gen?
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (< (/ y+) (/ y)))
+  :hints (("Goal" :use ( /-strongly-MONOTONIC-ALT
+                  )))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+         
+(defthm *-weakly-monotonic
+  (implies (and
+                (<= y y+)
+                (<= 0 x)                 ;this hyp was last... re-order bad?
+                (case-split (rationalp x)) ; This does not hold if x, y, and z are complex!
+                )
+           (<= (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and
+                  (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and
+                  (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))))
+
+#| Here is the complex counterexample to which we alluded above.
+
+(let ((y  #c(1 -1))
+      (y+ #c(1 1))
+      (x  #c(1 1)))
+    (implies (and (<= y y+)
+                  (<= 0 x))
+             (<= (* x y) (* x y+))))
+|#
+
+;could we generalize the (rationalp x) hyp to (not (complex-rationalp)) ?
+(defthm *-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and
+                  (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and
+                  (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))))
+
+(defthm *-weakly-monotonic-negative-multiplier
+  (implies (and (<= y y+)
+                (< x 0)
+                (case-split (rationalp x))
+                )
+           (<= (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and
+                  (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and
+                  (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))))
+
+(defthm *-strongly-monotonic-negative-multiplier
+  (implies (and
+                (< y y+)
+                (< x 0)
+                (case-split (rationalp x))
+                )
+           (< (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and
+                  (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and
+                  (< y y+)
+                   (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))))
+
+
+
+; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
+; product of a and b given intervals for a and b.  We consider three kinds of intervals.
+; We discuss only the a case.
+
+; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
+
+; nonneg-open intervals mean 0<=a<amax.
+
+; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
+
+; We now prove theorems with names like abs*nonneg-open, etc. characterizing
+; the product of two elements from two such interals.  All of these theorems
+; are made with :rule-classes nil because I don't know how to control their
+; use.
+
+;BOZO move these to extra-rules? these are copied in fp.lisp!
+(encapsulate nil
+  (local 
+   (defthm renaming
+    (implies (and (rationalp a)
+                  (rationalp xmax)
+                  (rationalp b)
+                  (rationalp bmax)
+                  (< (- xmax) a)
+                  (<= a xmax)
+                  (< 0 xmax)
+                  (<= 0 b)
+                  (< b bmax))
+             (and (< (- (* xmax bmax)) (* a b))
+                  (< (* a b) (* xmax bmax))))
+    :hints (("Goal" :cases ((equal b 0))))))
+
+; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
+; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
+; lemma would be no different.
+
+  (defthm abs*nonneg-open
+    (implies (and (rationalp a)
+                  (rationalp amax)
+                  (rationalp b)
+                  (rationalp bmax)
+                  (< (- amax) a)
+                  (<= a amax)       ; (< a amax) is all we'll ever use, I bet.
+                  (< 0 amax)
+                  (<= 0 b)
+                  (< b bmax))
+             (and (< (- (* amax bmax)) (* a b))
+                  (< (* a b) (* amax bmax))))
+    :hints (("Goal" :by renaming))
+    :rule-classes nil))
+
+(defthm abs*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :hints (("Goal" :cases ((equal b 0))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* b a))
+                (< (* b a) (* amax bmax))))
+  :hints (("Goal" :use abs*nonneg-closed))
+  :rule-classes nil)
+
+(defthm nonneg-open*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* bmax amax)) (* a b))
+                (< (* a b) (* bmax amax))))
+    :hints (("Goal" :use abs*nonneg-open))
+    :rule-classes nil)
+
+; The next three, which handle nonnegative open intervals in the first argument,
+; can actually be seen as uses of the abs intervals above.  Simply observe that
+; if 0<=a<amax then -amax<a<amax.
+
+(defthm nonneg-open*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :hints (("Goal" :use abs*nonneg-closed))
+  :rule-classes nil)
+
+(defthm nonneg-open*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :hints (("Goal" :use abs*nonneg-open))
+  :rule-classes nil)
+
+; and the commuted version
+(defthm nonneg-closed*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* b a))
+                (< (* b a) (* amax bmax))))
+  :hints (("Goal" :use nonneg-open*nonneg-closed))
+  :rule-classes nil)
+
+(defthm nonneg-closed*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (<= a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (<= (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm abs*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (< (- bmax) b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :hints (("Goal" :cases ((< b 0) (> b 0))))
+  :rule-classes nil)  
+
+;Apparenlty, ACL2 will match (- c) to -1...
+;This rule is incomplete...
+;make a bind-free rule for this...
+(defthm rearrange-negative-coefs-<
+  (and (equal (< (* (- c) x) z)
+              (< 0 (+ (* c x) z)))
+       (equal (< (+ (* (- c) x) y) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y (* (- c) x)) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y1 y2 (* (- c) x)) z)
+              (< (+ y1 y2) (+ (* c x) z)))
+       (equal (< (+ y1 y2 y3 (* (- c) x)) z)
+              (< (+ y1 y2 y3) (+ (* c x) z)))
+       (equal (< z (+ (* (- c) x) y))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y (* (- c) x)))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y1 y2 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2)))
+       (equal (< z (+ y1 y2 y3 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2 y3)))))
+
+;make a bind-free rule for this...
+(defthm rearrange-negative-coefs-equal
+  (and (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp z)))
+                (equal (equal (* (- c) x) z)
+                       (equal 0 (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ (* (- c) x) y) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y (* (- c) x)) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 (* (- c) x)) z)
+                       (equal (+ y1 y2) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 y3 (* (- c) x)) z)
+                       (equal (+ y1 y2 y3) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ (* (- c) x) y))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y (* (- c) x)))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 y3 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2 y3))))))
+
+(include-book "inverted-factor")
+
+;Sometimes we don't want these rules enabled (especially when we're doing linear reasoning about "quotients"
+;like calls to / or floor or fl or nonnegative-integer-quotient).
+(defthm equal-multiply-through-by-inverted-factor-from-left-hand-side
+  (implies (and (bind-free (find-inverted-factor lhs) (k))
+                (syntaxp (not (is-a-factor k lhs)))
+                (syntaxp (sum-of-products-syntaxp lhs))
+                (syntaxp (sum-of-products-syntaxp rhs))
+                (syntaxp (not (quotep lhs))) ;if lhs is a constant (e.g., (equal x '1/2)) then do nothing
+                (case-split (not (equal k 0)))
+                (case-split (acl2-numberp k))
+                (case-split (acl2-numberp lhs))
+                (case-split (acl2-numberp rhs))
+                )
+           (equal (equal lhs rhs)
+                  (equal (* lhs k) (* rhs k)))))
+
+(defthm equal-multiply-through-by-inverted-factor-from-right-hand-side
+  (implies (and (bind-free (find-inverted-factor rhs) (k))
+                (syntaxp (not (is-a-factor k rhs)))
+                (syntaxp (sum-of-products-syntaxp lhs))
+                (syntaxp (sum-of-products-syntaxp rhs))
+                (syntaxp (not (quotep rhs))) ;if rhs is a constant (e.g., (equal '1/2 x)) then do nothing
+                (case-split (not (equal k 0)))
+                (case-split (acl2-numberp k))
+                (case-split (acl2-numberp lhs))
+                (case-split (acl2-numberp rhs))
+                )
+           (equal (equal lhs rhs)
+                  (equal (* lhs k) (* rhs k)))))
+
+#|
+;are the case splits caused by these 2 rules bad?  
+;prove more rules with positive (and then negative) hyps?
+;maybe we can rewrite LHS first, to prevent loops.  can we rely on the rewriting to simplify LHS enough?  what
+;about funny cases?
+ Note on loops: Consider when LHS is (* k (/ k)).  This has not been
+;simplified, but (very unfortunately), we cannot rely on ACL2 to have rewritten subterms before rewriting a
+;term.
+In this case, we must be sure that we don't multiply through by k (since we found the inverted factor (/ k).
+
+|#
+(defthm less-than-multiply-through-by-inverted-factor-from-left-hand-side
+  (implies (and (bind-free (find-inverted-factor lhs) (k))
+                (syntaxp (not (is-a-factor k lhs))) ;helps prevent loops.
+                (syntaxp (sum-of-products-syntaxp lhs))
+                (syntaxp (sum-of-products-syntaxp rhs))
+                (case-split (not (equal k 0)))
+                (case-split (rationalp k)) ;gen!
+                )
+           (equal (< lhs rhs)
+                  (if (<= 0 k)
+                      (< (* lhs k) (* rhs k))
+                    (< (* rhs k) (* lhs k))))))
+
+(defthm less-than-multiply-through-by-inverted-factor-from-right-hand-side
+  (implies (and (bind-free (find-inverted-factor rhs) (k))
+                (syntaxp (not (is-a-factor k rhs)))
+                (syntaxp (sum-of-products-syntaxp lhs))
+                (syntaxp (sum-of-products-syntaxp rhs))
+                (case-split (not (equal k 0)))
+                (case-split (rationalp k))
+                )
+           (equal (< lhs rhs)
+                  (if (<= 0 k)
+                      (< (* lhs k) (* rhs k))
+                    (< (* rhs k) (* lhs k))))))
+
+;move to extra?
+(defthm x*/y=1->x=y
+  (implies (and (rationalp x)
+                (rationalp y)
+                (not (equal x 0))
+                (not (equal y 0)))
+           (equal (equal (* x (/ y)) 1)
+                  (equal x y)))
+  :rule-classes nil)
+
+;move this stuff?                
+(defun point-right-measure (x)
+  (floor (if (and (rationalp x) (< 0 x)) (/ x) 0) 1))
+
+(defun point-left-measure (x)
+  (floor (if (and (rationalp x) (> x 0)) x 0) 1))
+
+(include-book "../../../ordinals/e0-ordinal")
+
+(defthm recursion-by-point-right
+  (and (e0-ordinalp (point-right-measure x))
+       (implies (and (rationalp x)
+                     (< 0 x)
+                     (< x 1))
+                (e0-ord-< (point-right-measure (* 2 x))
+                          (point-right-measure x)))))
+
+(defthm recursion-by-point-left
+  (and (e0-ordinalp (point-left-measure x))
+       (implies (and (rationalp x)
+                     (>= x 2))
+                (e0-ord-< (point-left-measure (* 1/2 x))
+                          (point-left-measure x)))))
+
+(in-theory (disable point-right-measure point-left-measure))
+
+(defthm x<x*y<->1<y
+  (implies (and (rationalp x)
+                (< 0 x)
+                (rationalp y))
+           (equal (< x (* x y))
+                  (< 1 y)))
+  :rule-classes nil)
+
+(defthm cancel-equal-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (not (equal a 0)))
+           (equal (equal (* a r) (* a s))
+                  (equal r s)))
+  :rule-classes nil)
+
+
+;not used anywhere in support/
+;i have a better rule...
+(defthm cancel-<-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (< 0 a))
+           (equal (< (* a r) (* a s))
+                  (< r s)))
+  :rule-classes nil)
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/ground-zero.lisp acl2-6.3/books/rtl/rel9/arithmetic/ground-zero.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/ground-zero.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/ground-zero.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,48 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+;includes changes to the default theory (mostly disabling built-in functions)
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable evenp)) ;new
+(in-theory (disable oddp)) ;new
+(in-theory (disable nonnegative-integer-quotient)) ;new
+;abs?
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/hacks.lisp acl2-6.3/books/rtl/rel9/arithmetic/hacks.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/hacks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/hacks.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,91 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;This book contains arithmetic hacks removed from basic.lisp
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(local (include-book "fp2"))
+
+(defthm delta1-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp d)
+		  (>= y 0)
+		  (>= x (+ y y))
+		  (>= d 0))
+	     (<= (* y d) (* (- x y) d)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (x d) (y+ (- x y)))))))
+
+
+(defthm delta1-a
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp d)
+		  (>= y 0)
+		  (>= x (+ y y))
+		  (>= d 0))
+	     (>= (- x (* y (+ 1 d)))
+		 (* (- x y) (- 1 d))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance delta1-1)))))
+
+(defthm delta1-b
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp d)
+		  (>= y 0)
+		  (>= x (+ y y))
+		  (>= d 0))
+	     (<= (- x (* y (- 1 d)))
+		 (* (- x y) (+ 1 d))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance delta1-1)))))
+
+(defthm delta2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp d)
+		  (>= (* x d) 0))
+	     (>= (+ x (* y (- 1 d)))
+		 (* (+ x y) (- 1 d))))
+  :rule-classes ())
+
+(defthm natp-
+    (implies (and (natp x)
+		  (natp y)
+		  (>= x y))
+	     (natp (+ x (* -1 y))))
+  :hints (("Goal" :in-theory (enable natp))))
+
+;disable, since we intend to keep natp enabled?
+(defthmd natp>=0
+  (implies (natp x)
+           (>= x 0)))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/induct.lisp acl2-6.3/books/rtl/rel9/arithmetic/induct.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/induct.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/induct.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,97 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;Necessary definitions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(local (include-book "fl")) ; yuck?
+
+(defun or-dist-induct (y n)
+  (if (and (integerp n) (>= n 0))
+      (if (= n 0)
+	  y
+	(or-dist-induct (fl (/ y 2)) (1- n)))
+    ()))
+
+(defun log-induct (i j)
+  (if (and (integerp i) (>= i 0)
+	   (integerp j) (>= j 0))
+      (if (or (= i 0) (= j 0))
+	  ()
+	(log-induct (fl (/ i 2)) (fl (/ j 2))))
+    ()))
+
+(DEFUN logand-three-args-induct (I J K)
+  (declare (xargs :measure (ACL2-COUNT (abs i))
+                  :hints (("Goal" :in-theory (enable abs)))))
+  (IF (AND (INTEGERP I)
+           (INTEGERP J)
+           (INTEGERP K)
+           )
+      (IF (OR (= I 0) (= J 0) (= K 0)
+              (= I -1) (= J -1) (= K -1))
+          NIL
+          (logand-three-args-induct
+           (FL (/ I 2))
+           (FL (/ J 2))
+           (FL (/ K 2))))
+      NIL))
+
+
+(DEFUN LOG-INDUCT-allows-negatives (i j)
+  (IF (AND (INTEGERP i)
+           (INTEGERP j)
+           )
+      (IF (OR (= i 0) (= j 0) (= i -1) (= j -1))
+          NIL
+          (LOG-INDUCT-allows-negatives (FL (/ i 2)) (FL (/ j 2))))
+      NIL))
+
+(defun op-dist-induct (i j n)
+  (if (and (integerp n) (>= n 0))
+      (if  (= n 0)
+	  (list i j)
+	(op-dist-induct (fl (/ i 2)) (fl (/ j 2)) (1- n)))
+    ()))
+
+#|
+(defun op-dist-induct-negative (i j n)
+  (if (and (integerp n) (<= n 0))
+      (if (= n 0)
+	  (list i j)
+	(op-dist-induct-negative (fl (/ i 2)) (fl (/ j 2)) (1+ n)))
+    ()))
+|#
+
+
+;move?
+(defun natp-induct (k)
+  (if (zp k)
+      t
+    (natp-induct (1- k))))
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/integerp.lisp acl2-6.3/books/rtl/rel9/arithmetic/integerp.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/integerp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/integerp.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,142 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;make an integerp-proofs book?
+
+(include-book "negative-syntaxp")
+(local (include-book "predicate"))
+(local (include-book "fp2")) ;gross?
+
+(local (in-theory (disable a2)))
+
+(encapsulate
+ ()
+ (local (defthm no-room-for-an-integerp-between-0-and-1
+          (implies (and (< x 1)
+                        (< 0 x))
+                   (not (integerp x)))))
+ 
+ (defthm quotient-not-integerp
+   (implies (and (< i j)
+                 (<= 0 i)
+                 (<= 0 j)
+                 (case-split (< 0 i)) ;if we can show (<= 0 i) but not (< 0 i), split cases
+                 (case-split (< 0 j))
+                 (case-split (rationalp j)) ;gen?
+                 )
+            (not (integerp (/ i j))))
+   ))
+
+
+;integerp-minus-aux
+(encapsulate
+ ()
+ (local (defthm minus-1-rewrite
+          (equal (* -1 x)
+                 (- x))))
+             
+ (defthm integerp-minus-aux
+   (implies (acl2-numberp x) ;can't gen?
+            (equal (integerp (* -1 x))
+                   (integerp x)))))
+
+
+(defthm integerp-minus
+  (implies (and (syntaxp (negative-syntaxp x)) ;the negative-syntaxp test makes this rule quite general
+                (case-split (acl2-numberp x))
+                )
+           (equal (integerp x)
+                  (integerp (* -1 x)))))
+
+(in-theory (disable integerp-minus-aux))
+
+
+
+#|
+ 
+ simplify integerp of a sum. see robert krug's meta rules on this subject
+
+|#
+
+(defthm integerp-sum-take-out-known-integer
+   (implies (integerp n)
+            (and (equal (integerp (+ n x))
+                        (integerp (fix x)))
+                 (equal (integerp (+ x n))
+                        (integerp (fix x))))))
+
+(defthm integerp-sum-take-out-known-integer-3
+  (implies (integerp n)
+           (and ;(equal (integerp (+ n x y))      ;this case not needed?
+                 ;      (integerp (fix (+ x y))))
+                (equal (integerp (+ x n y))
+                       (integerp (fix (+ x y))))
+                (equal (integerp (+ x y n))
+                       (integerp (fix (+ x y))))))
+  :hints (("Goal" :in-theory (disable integerp-sum-take-out-known-integer)
+           :use (:instance  integerp-sum-take-out-known-integer (x (+ x y))))))
+
+
+#|
+ 
+ simplify integerp of a product. see robert krug's meta rules on this subject
+
+|#
+
+(defthm integerp-prod
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (* x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+;are these expensive?
+(defthm integerp-prod-of-3-last-two
+  (implies (and (integerp (* b c))
+                (integerp a))
+           (integerp (* a b c))))
+
+(defthm integerp-prod-of-3-first-and-last
+  (implies (and (integerp (* a c))
+                (integerp b))
+           (integerp (* a b c)))
+  :hints (("Goal" :in-theory (disable integerp-prod-of-3-last-two)
+           :use (:instance integerp-prod-of-3-last-two (a b) (b a)))))
+
+(defthm integerp-prod-of-3-first-two
+  (implies (and (integerp (* a b))
+                (integerp c))
+           (integerp (* a b c)))
+  :hints (("Goal" :in-theory (disable integerp-prod-of-3-last-two 
+                                      integerp-prod-of-3-first-and-last)
+           :use (:instance integerp-prod-of-3-last-two (a c) (c a)))))
+
+
+;forces the constant to be in the range [0,1)  (and for 0, will be simplified further)
+(defthm integerp-+-reduce-leading-constant
+  (implies (syntaxp (and (quotep k)
+                         (or (>= (cadr k) 1) (< (cadr k) 0))))
+           (equal (integerp (+ k x))
+                  (integerp (+ (+ k (- (floor k 1))) x))))) ;use mod?
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/inverted-factor.lisp acl2-6.3/books/rtl/rel9/arithmetic/inverted-factor.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/inverted-factor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/inverted-factor.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,142 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;(local (include-book "../../../meta/meta-times-equal"))
+;(local (INCLUDE-BOOK "predicate"))
+;(local (INCLUDE-BOOK "fp2"))
+
+#|
+treat constants separately.  careful.  do we prefer (equal x 1/2) or (equal (* 2 x) 1) ?
+Now I think we definitely prefer (equal x 1/2) because this allows us to substitue for x.
+
+when this
+ (+ 1 x (* 2 x) (* x y (/ z)))
+ appears in an equality, we want to multiply through by z
+either returns nil or a term to multiply through
+
+this assumes the term is already normalized.  this will be the case if we call this function on, say (equal
+lhs rhs) because by the time the equal term is processed, lhs and rhs are each individually normalized
+not necessarily!
+
+
+warning; multiplying through by these factors can cause problems with linear arithmetic (expand on this...)
+
+watch out.  how do we handle (< x 1/2) ?  do we multiply through by 2?
+
+binds the variable k
+
+(This used to be called find-frac-coeff.)
+
+|#
+
+(defun find-inverted-factor (term)
+  (declare (xargs :guard (pseudo-termp term)))
+  (if (not (consp term)) ;term was a symbol
+      nil
+    (case (car term)	
+      (quote (if (integerp (cadr term)) 
+                 nil ;no denominator
+               (if (rationalp (cadr term))
+                   `((k . ',(denominator (cadr term))))
+                 nil)))  ;we found one!
+      (binary-+ (or (find-inverted-factor (cadr term))
+                    (find-inverted-factor (caddr term))))
+      (binary-* (or (find-inverted-factor (cadr term))
+                    (find-inverted-factor (caddr term))))
+      (unary-/ (list (cons 'k (cadr term)))) ;we found one!
+      (otherwise nil)
+      )))
+
+;todo: generalize this
+;TERM is a product containing FACTOR as (at least) one factor
+(defun is-a-factor (factor term)
+  (declare (xargs :guard (pseudo-termp term)))
+  (if (not (consp term)) ;term was a symbol
+      (equal factor term)
+    (case (car term)	
+      (binary-* (if (equal factor (cadr term))
+                    t
+                  (is-a-factor factor (caddr term))))
+      (otherwise (equal factor term)) ;anything else is not a prduct [what about a sum, each of whose addends is a multiple of FACTOR?]
+      )))
+
+
+;;
+;; Detect that distributity and assoc rules have fired
+;; (doesn't check that comm and comm-2 have fired)
+;;
+
+
+;Checks whether TERM is a factor, which we define as either a variable, or a call to a function other than *
+;or +
+;Some example factors: x  '3  (mod x y)  (/ x)  (/ (bits (* 2 x) i j))
+;our normal form requires that the arg to (/ ... ) not be a product!
+;it is basic to our normal form that (/ (* x y)) be rewritten to (* (/ x) (/ y))
+;we can now have the routine check whether the term is a quoted constant..
+(defun factor-syntaxp (term can-be-a-constant)
+  (declare (xargs :guard (pseudo-termp term)))
+  (if (not (consp term)) ;term was a symbol
+      t
+    (case (car term)	
+      (binary-* nil) ;associativity of * must not have fired (or we are in the (* x y) of a (/ (* x y))
+      (binary-+ nil) ;distributivity must not have fired...
+      (unary-/ (and (consp (cdr term))
+                    (factor-syntaxp (cadr term) nil)))
+      (quote can-be-a-constant)
+      (otherwise t))))
+
+
+;Checks whether TERM is a product of (1 or more) "factors".
+;Also checks that only the first factor (if any) is a constant...  (If the constants aren't collected, the 
+;term isn't yet normalized, and rules can loop). BOZO document why the cancelling rule is okay even though
+;constants are a little weird..
+(defun product-syntaxp (term first-factor-can-be-a-constant)
+  (declare (xargs :guard (pseudo-termp term)))
+  (if (not (consp term)) ;term was a symbol
+      t
+    (case (car term)	
+      (binary-* (and (factor-syntaxp (cadr term) first-factor-can-be-a-constant)
+                     (product-syntaxp (caddr term) nil)))
+;check that term is a single factor..
+      (otherwise (factor-syntaxp term first-factor-can-be-a-constant)))))
+
+;Checks whether TERM is a sum of one or more products..
+;rejects TERM if distributivity or associativity haven't fired yet.
+;i suppose we could check that the terms have been commutted into the right order, but we don't do that
+;either.
+;But we do check that only the first factor (if any) of each product is a constant...
+(defun sum-of-products-syntaxp (term)
+  (declare (xargs :guard (pseudo-termp term)))
+  (if (not (consp term)) ;term was a symbol
+      t
+    (case (car term)	
+      (binary-+ (and (product-syntaxp (cadr term) t)
+                     (sum-of-products-syntaxp (caddr term))))
+      (otherwise (product-syntaxp term t)))))
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/mod-expt.lisp acl2-6.3/books/rtl/rel9/arithmetic/mod-expt.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/mod-expt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/mod-expt.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,346 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;one of these is still broken
+
+
+(include-book "power2p")
+
+
+;don't need everything in this book!
+(local (include-book "numerator"))
+(local (include-book "denominator"))
+(local (include-book "nniq"))
+(local (include-book "arith2"))
+(local (include-book "ground-zero"))
+(local (include-book "floor"))
+(local (include-book "integerp"))
+(local (include-book "rationalp"))
+(local (include-book "unary-divide"))
+(local (include-book "expt"))
+(local (include-book "expo"))
+(local (include-book "fl-expt"))
+(local (include-book "mod"))
+(local (include-book "fl"))
+
+(local (in-theory (enable expt-minus)))
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defthmd fl-shift-pull-inside-mod
+  (implies (and ;(rationalp x)
+                (<= j i) ;what if not?
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (FL (* (/ (EXPT 2 J))
+                         (MOD x (EXPT 2 i))))
+                  (mod (FL (* x (/ (EXPT 2 J))))
+                       (expt 2 (- i j)))))
+  :hints (("Goal" :in-theory (enable mod expt-split))))
+
+(defthm mod-integerp-when-y-is-power-of-2
+  (implies (integerp x)
+           (integerp (mod x (expt 2 i))))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :cases ((< i 0)))))
+
+;Helpful, since if we split exponents, the rule above may not fire.
+(defthm mod-integerp-when-y-is-power-of-2-gen
+  (implies (and (integerp x)
+                (syntaxp (power2-syntaxp y))
+                (force (power2p y)))
+           (integerp (mod x y)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable power2p-rewrite))))
+
+(encapsulate
+ ()
+ (local (defthm mod-pull-inside-fl-shift-usual-case
+          (implies (and (<= 0 i) ;this case
+;                (rationalp x)
+                        (case-split (integerp i)) ;may be droppable
+                        (case-split (integerp j))
+                        )
+                   (equal (mod (FL (* x (/ (EXPT 2 J))))
+                               (expt 2 i))
+                          (FL (* (/ (EXPT 2 J))
+                                 (MOD x (EXPT 2 (+ i j)))))))
+          :otf-flg t
+          :hints (("Goal" :use ((:instance fl-def-linear-part-1 (x (* X (/ (EXPT 2 I))
+                                                                      (/ (EXPT 2 J)))))
+                                (:instance fl-def-linear-part-2 (x (* X (/ (EXPT 2 I))
+                                                                      (/ (EXPT 2 J))))))
+                   :in-theory (set-difference-theories
+                               (enable mod expt-split)
+                               '(  FL-WEAK-MONOTONE
+                                   fl-def-linear-part-1
+                                   fl-def-linear-part-2)
+                               )))))
+
+
+ (local (defthm mod-pull-inside-fl-shift-other-case
+          (implies (and (< i 0) ;this case
+;                (rationalp x)
+                        (case-split (integerp i))
+                        (case-split (integerp J))
+
+                        )
+                   (equal (mod (FL (* x (/ (EXPT 2 J))))
+                               (expt 2 i))
+                          (FL (* (/ (EXPT 2 J))
+                                 (MOD x (EXPT 2 (+ i j)))))))
+          :otf-flg t
+          :hints (("Goal" :use ((:instance <-transitive 
+                                           (a x)
+                                           (b (+ (* (EXPT 2 I) (EXPT 2 J))
+                                                 (* (EXPT 2 I)
+                                                    (EXPT 2 J)
+                                                    (FL (* X (/ (EXPT 2 I)) (/ (EXPT 2 J)))))))
+                                           (c (+ (EXPT 2 J)
+                                                 (* (EXPT 2 I)
+                                                    (EXPT 2 J)
+                                                    (FL (* X (/ (EXPT 2 I))
+                                                           (/ (EXPT 2 J))))))))
+                                (:instance fl-def-linear-part-1 (x (* X (/ (EXPT 2 I))
+                                                                      (/ (EXPT 2 J)))))
+                                (:instance fl-def-linear-part-2 (x (* X (/ (EXPT 2 I))
+                                                                      (/ (EXPT 2 J))))))
+                   :in-theory (set-difference-theories
+                               (enable mod expt-split)
+                               '(FL-WEAK-MONOTONE
+;                         expt-compare
+                                 fl-def-linear-part-1
+                                 fl-def-linear-part-2)
+                               )))))
+
+
+;Basic idea: mod chops off some high bits from x and fl chops off some low bits.  We can do the chops in
+;either order.
+ (defthm mod-pull-inside-fl-shift
+   (implies (and ;no hyp about x
+             (case-split (integerp i))
+             (case-split (integerp j))
+             )
+            (equal (mod (fl (* x (/ (expt 2 j))))
+                        (expt 2 i))
+                   (fl (* (/ (expt 2 j))
+                          (mod x (expt 2 (+ i j)))))))
+   :otf-flg t
+   :hints (("goal" :cases ( (<= 0 i)))))
+ )
+
+
+(defthm mod-pull-inside-fl-shift-alt
+  (implies (and ;(rationalp x)
+                (integerp i)
+                (integerp j)
+                )
+           (equal (mod (FL (* (/ (EXPT 2 J)) x))
+                       (expt 2 i))
+                  (FL (* (/ (EXPT 2 J))
+                         (MOD x (EXPT 2 (+ i j))))))))
+
+(defthm mod-pull-inside-fl-shift-alt-alt
+  (implies (and ;(rationalp x)
+                (integerp i)
+                (integerp j)
+                )
+           (equal (mod (FL (* (/ (EXPT 2 J)) x))
+                       (* 2 (expt 2 i)))
+                  (FL (* (/ (EXPT 2 J))
+                         (MOD x (EXPT 2 (+ i 1 j)))))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '(MOD-PULL-INSIDE-FL-SHIFT
+                                mod-pull-inside-fl-shift-alt))
+           :use (:instance mod-pull-inside-fl-shift
+                           (i (+ i 1))))))
+
+(defthm mod-pull-inside-fl-shift-alt-alt-alt
+  (implies (and ;(rationalp x)
+                (integerp j)
+                )
+           (equal (mod (FL (* (/ (EXPT 2 J)) x))
+                       2)
+                  (FL (* (/ (EXPT 2 J))
+                         (MOD x (EXPT 2 (+ 1 j)))))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '( MOD-PULL-INSIDE-FL-SHIFT
+                                 mod-pull-inside-fl-shift-alt
+                                 mod-pull-inside-fl-shift-alt-alt))
+           :use (:instance mod-pull-inside-fl-shift-alt-alt
+                           (i 0)))))
+
+(defthm mod-pull-inside-fl-shift-alt-alt-alt-alt
+  (implies (and ;(rationalp x)
+                (integerp j)
+                )
+           (equal (mod (FL (* x (/ (EXPT 2 J)))) ;factors commuted
+                       2)
+                  (FL (* (/ (EXPT 2 J))
+                         (MOD x (EXPT 2 (+ 1 j)))))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '( MOD-PULL-INSIDE-FL-SHIFT
+                                 mod-pull-inside-fl-shift-alt
+                                 mod-pull-inside-fl-shift-alt-alt
+                                 mod-pull-inside-fl-shift-alt-alt-alt))
+           :use (:instance mod-pull-inside-fl-shift-alt-alt
+                           (i 0)))))
+
+
+;gen and move?
+(defthm fl-mod-zero
+  (implies (and (<= i2 i1)
+                (integerp i1)
+                (integerp i2)
+                )
+           (equal (FL (* (/ (EXPT 2 i1))
+                         (MOD X (EXPT 2 i2))))
+                  0))
+
+  )
+
+
+
+;generalize?
+(defthm mod-pull-inside-fl-shift-alt-5
+  (implies (and; (rationalp x)
+                (integerp i)
+                (integerp j)
+                )
+           (equal (mod (FL (* (/ (EXPT 2 J)) x))
+                       (* 2 (expt 2 i)))
+                  (FL (* (/ (EXPT 2 J))
+                         (MOD x (EXPT 2 (+ 1 i j)))))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '(
+                               MOD-PULL-INSIDE-FL-SHIFT
+                               mod-pull-inside-fl-shift-alt
+                               mod-pull-inside-fl-shift-alt-alt
+                               mod-pull-inside-fl-shift-alt-alt-alt))
+           :use (:instance  mod-pull-inside-fl-shift-alt (i (+ i 1))))))
+
+
+(defthm mod-pull-inside-fl-shift-alt-6
+  (implies (and; (case-split (rationalp x))
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                )
+           (equal (mod (FL (* x (/ (EXPT 2 J))))
+                       (* 2 (expt 2 i) (/ (expt 2 k))))
+                  (FL (* (/ (EXPT 2 J))
+                         (MOD x (EXPT 2 (+ 1 (- k) i j)))))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '(
+                               MOD-PULL-INSIDE-FL-SHIFT
+                               mod-pull-inside-fl-shift-alt
+                               mod-pull-inside-fl-shift-alt-alt
+                               mod-pull-inside-fl-shift-alt-alt-alt
+                               ))
+           :use (:instance  mod-pull-inside-fl-shift-alt (i (+ i (- k) 1))))))
+
+;why disable?
+;use i and j
+(defthmd mod-mod-eric
+  (implies (and (<= i1 i2)
+                (case-split (integerp i1))
+                (case-split (integerp i2))
+                )
+           (= (mod (mod x (expt 2 i2)) (expt 2 i1))
+              (mod x (expt 2 i1)))))
+
+
+;conclude from something more general?
+; NOTE: This is now a corollary of mod-of-mod.  But we might as well retain the
+; original proof.
+(defthmd mod-of-mod-cor
+  (implies (and (<= b a)
+                (case-split (integerp b))
+                (case-split (integerp a))
+                )
+           (equal (mod (mod x (expt 2 a)) (expt 2 b))
+                  (mod x (expt 2 b))))
+  :hints (("Goal" :in-theory (enable mod-mod-eric)))
+  )
+
+
+
+#|
+
+nice rules?
+
+(local
+ (defthm mod-2m-2n-k-1
+   (implies (and (integerp m) (>= m n)
+                 (integerp n) (> n k)
+                 (integerp k) (> k 0))
+            (= (mod (- (expt 2 m) (expt 2 (- n k)))
+                    (expt 2 n))
+               (mod (- (expt 2 n) (expt 2 (- n k)))
+                    (expt 2 n))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable  a15)
+            :use ((:instance mod-mult-eric
+                             (x (- (expt 2 n) (expt 2 (- n k))))
+                             (y (expt 2 n))
+                             (a (1- (expt 2 (- m n)))))
+                  (:instance expt-weak-monotone (n (- n k)) (m n)))))))
+
+(local
+(defthm mod-2m-2n-k-2
+    (implies (and (integerp n) (> n k)
+		  (integerp k) (> k 0))
+	     (= (mod (- (expt 2 n) (expt 2 (- n k)))
+		     (expt 2 n))
+		(- (expt 2 n) (expt 2 (- n k)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance mod-does-nothing (m (- (expt 2 n) (expt 2 (- n k)))) (n (expt 2 n)))
+			(:instance expt-weak-monotone (n (- n k)) (m n))))
+)))
+
+;nice rule?
+(local
+ (defthm mod-2m-2n-k
+   (implies (and (integerp m) (>= m n)
+                 (integerp n) (> n k)
+                 (integerp k) (> k 0))
+            (= (mod (- (expt 2 m) (expt 2 (- n k)))
+                    (expt 2 n))
+               (- (expt 2 n) (expt 2 (- n k)))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance mod-2m-2n-k-1)
+                         (:instance mod-2m-2n-k-2))))))
+
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/mod-proofs.lisp acl2-6.3/books/rtl/rel9/arithmetic/mod-proofs.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/mod-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/mod-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1660 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "ground-zero")
+(include-book "negative-syntaxp")
+
+(local (include-book "floor"))
+(local (include-book "arith2"))
+(local (include-book "power2p"))
+(local (include-book "fp2"))
+(local (include-book "arith"))
+(local (include-book "integerp"))
+(local (include-book "product"))
+(local (include-book "complex-rationalp"))
+(local (include-book "../../../meta/meta-plus-equal"))
+(local (include-book "../../../meta/meta-plus-lessp"))
+(local (include-book "predicate"))
+(local (include-book "rationalp"))
+
+
+#| 
+
+Todo: We could probably prove REM analogs for most of the rules in this book (since REM and MOD agree on a
+certain range of inputs), but we don't use REM much at all in the library (for good reason, thinks Eric), so
+perhaps this isn't worth spending time on.
+
+|#
+
+
+
+
+(defthm mod-rational-when-y-is-rational-rewrite
+  (implies (and (rationalp y)
+                (case-split (acl2-numberp x)))
+           (equal (rationalp (mod x y))
+                  (rationalp x)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+;mod when x is complex?
+
+(defthm mod-with-x-a-non-acl2-number-is-zero
+  (implies (not (acl2-numberp x))
+           (equal (mod x y)
+                  0))
+  :hints (("Goal" :in-theory (enable mod))))
+
+
+
+
+(defthmd mod-when-y-is-complex-rationalp
+  (implies (complex-rationalp y)
+           (equal (mod x y)
+                  (if (not (complex-rationalp x))
+                      (fix x)
+                    (if (not (rationalp (/ x y)))
+                        x
+                      (if (integerp (/ x y))
+                          0 
+                        (+ X (* -1 Y (FLOOR (* X (/ Y)) 1))) ;this case is gross (basically the defn of mod)
+                        )))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable mod))))
+
+;enable?
+(defthmd mod-when-y-is-not-an-acl2-numberp
+  (implies (not (acl2-numberp y))
+           (equal (mod x y)
+                  (fix x)))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable mod))))
+
+
+;we probably get this when mod is defined.  perhaps we should disable mod's t-p rule since this duplicates it. 
+(defthm mod-acl2-numberp-type-prescription
+  (acl2-numberp (mod x y))
+  :rule-classes (:type-prescription))
+
+;Perhaps we don't need this as a rewrite rule, but here it is anyway:
+(defthm mod-acl2-numberp
+  (acl2-numberp (mod x y)))
+
+;add a weaker vesion of this in case we can establish (rationalp x) but not (not (complex-rationalp x)) ?
+(defthm mod-rationalp
+  (implies (case-split (not (complex-rationalp x)))
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :cases ((rationalp x))
+           :in-theory (enable mod))))
+
+;I weakened the hyp on x as much as possible and then weakened the hyps on y as much as possible.  (We might
+;get a different rule by doing the reverse of that.)
+(defthm mod-non-negative
+  (implies (and (case-split (< 0 y)) ;can't gen: (mod -1 0) = -1 and  (mod 3 -2) = -1
+                (case-split (not (complex-rationalp x))) ;can't gen: (mod #C(-4 -3) 1) = #c(-4 -3)
+                (case-split (not (complex-rationalp y))) ;can't gen: (mod -3 #c(1 1)) = -3
+                )
+           (<= 0 (mod x y)))
+  :hints (("Goal" :cases ((acl2-numberp y))
+           :in-theory (enable mod))))
+
+(defthm mod-non-negative-rationalp-type-prescription
+  (implies (and (case-split (< 0 y))                     
+                (case-split (not (complex-rationalp x))) 
+                (case-split (not (complex-rationalp y))) 
+                )
+           (and (<= 0 (mod x y))
+                (rationalp (mod x y)) ;we might as well include this
+                ))
+  :rule-classes ((:type-prescription :typed-term (mod x y))))
+
+(defthm mod-non-negative-linear
+  (implies (and (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (<= 0 (mod x y)))
+  :rule-classes ((:linear :trigger-terms ((mod x y)))))
+
+(defthm mod-upper-bound
+  (implies (and (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (< (mod x y) y))
+  :hints (("Goal" :in-theory (enable mod) :cases ((rationalp x)))))
+
+(defthm mod-upper-bound-linear
+  (implies (and (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (< (mod x y) y))
+  :rule-classes ((:linear :trigger-terms ((mod x y)))))
+
+;included to help a hyp which matches this rule's conclusion get written away quickly
+(defthm mod-upper-bound-less-tight-rewrite
+  (implies (and (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (<= (mod x y) y)))
+
+;do we need this?  is it expensive?
+(defthm mod-upper-bound-3
+  (implies (and (<= y z)
+                (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (< (mod x y) z)))
+
+(defthm mod-upper-bound-2
+  (implies (and (<= 0 x)
+                (case-split (not (complex-rationalp x)))
+                )
+           (<= (mod x y) x))
+  :rule-classes (:rewrite (:linear :trigger-terms ((mod x y))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm mod-integerp
+  (implies (and (integerp x) ;can't gen: (mod 2/3   5)=2/3
+                (integerp y) ;can't gen: (mod 5   2/3)=1/3
+                )
+           (integerp (mod x y)))
+  :hints (("Goal" :in-theory (enable mod)))
+  :rule-classes (:rewrite :type-prescription))
+
+;what about when x is a known int?
+(defthm mod-integerp-2
+  (implies (and (integerp y)
+                (case-split (acl2-numberp x))
+                )
+           (equal (integerp (mod x y))
+                  (integerp x)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm mod-0
+    (and (equal (mod 0 y)
+                0)
+         (equal (mod x 0)
+                (fix x)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm mod-complex-rationalp-rewrite
+  (implies (case-split (rationalp y))
+           (equal (complex-rationalp (mod x y))
+                  (complex-rationalp x)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+;Don't make this a rewrite rule (we don't want to backchain to (< y 0) to establish (rationalp (mod x y))
+(defthm mod-non-positive-type-prescription
+  (implies (and (< y 0) ;rarely will be the case
+                (rationalp x)
+                (rationalp y)
+                )
+           (and (rationalp (mod x y))
+                (<= (mod x y) 0)))
+  :hints (("Goal" :in-theory (enable mod)))
+  :rule-classes (:type-prescription))
+
+(defthm mod-non-positive
+  (implies (and (< y 0) ;rarely will be the case
+                (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (<= (mod x y) 0)))
+
+;rewrite a claim about mod being non-positive to a claim about y?
+
+(local (include-book "fl")) ;drop?
+
+(defthm mod-drop-irrelevant-first-term
+  (implies (and (integerp (* k (/ y)))
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                (case-split (not (complex-rationalp x)))
+                )
+           (equal (mod (+ k x) y)
+                  (mod x y)))
+  :hints (("Goal"  :in-theory (enable mod))))
+
+(defthm mod-drop-irrelevant-second-term
+  (implies (and (integerp (* k (/ y)))
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                (case-split (not (complex-rationalp x)))
+                )
+           (equal (mod (+ x k) y)
+                  (mod x y))))
+
+(defthm mod-drop-irrelevant-second-term-with-more-terms
+  (implies (and (integerp (* k (/ y)))
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp x2)))
+                )
+           (equal (mod (+ x k x2) y)
+                  (mod (+ x x2) y))))
+
+(defthm mod-drop-irrelevant-third-term
+  (implies (and (integerp (* k (/ y)))
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp x2)))
+                )
+           (equal (mod (+ x x2 k) y)
+                  (mod (+ x x2) y))))
+
+;We could make analogs to MOD-DROP-IRRELEVANT-SECOND-TERM in which we drop the third, fourth, etc. term.
+
+(defthm mod-mult-eric
+  (implies (and (integerp a)
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y))) ;gen?
+                )
+           (equal (mod (+ x (* a y)) y)
+                  (mod x y))))
+
+;similar lemmas in mod.lisp
+;change params on the rest?
+
+;could we generalize (mod x2 y) to (* k (mod x2 y)) ??
+;I don't think we can drop either hyp.
+(defthm mod-sum-elim-second
+  (implies (and (case-split (not (complex-rationalp x1)))
+                (case-split (not (complex-rationalp x2))) 
+                )
+           (equal (mod (+ x1 (mod x2 y)) y)
+                  (mod (+ x1 x2) y)))
+  :hints (("Goal" :in-theory (enable mod)
+           :cases ((and (rationalp x2) (equal y 0) (rationalp x1))
+                   (and (rationalp x2) (equal y 0) (not (rationalp x1)))
+                   (and (rationalp x2) (not (equal y 0)) (rationalp x1))
+                   (and (rationalp x2) (not (equal y 0)) (not (rationalp x1)))
+                   (and (not (acl2-numberp x2)) (equal y 0) (rationalp x1))
+                   (and (not (acl2-numberp x2)) (equal y 0) (not (rationalp x1)))
+                   (and (not (acl2-numberp x2)) (not (equal y 0)) (rationalp x1))
+                   (and (not (acl2-numberp x2)) (not (equal y 0)) (not (rationalp x1)))))))
+
+(defthm mod-sum-elim-second-gen
+  (implies (and (integerp (/ y2 y))
+                (case-split (not (complex-rationalp x1)))
+                (case-split (not (complex-rationalp x2))) 
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                )
+           (equal (mod (+ x1 (mod x2 y2)) y)
+                  (mod (+ x1 x2) y)))
+  :hints (("Goal" :in-theory (enable mod)
+           :cases ((and (rationalp x2) (equal y 0) (rationalp x1))
+                   (and (rationalp x2) (equal y 0) (not (rationalp x1)))
+                   (and (rationalp x2) (not (equal y 0)) (rationalp x1))
+                   (and (rationalp x2) (not (equal y 0)) (not (rationalp x1)))
+                   (and (not (acl2-numberp x2)) (equal y 0) (rationalp x1))
+                   (and (not (acl2-numberp x2)) (equal y 0) (not (rationalp x1)))
+                   (and (not (acl2-numberp x2)) (not (equal y 0)) (rationalp x1))
+                   (and (not (acl2-numberp x2)) (not (equal y 0)) (not (rationalp x1)))))))
+
+
+;Follows from MOD-SUM-ELIM-SECOND
+(defthm mod-sum-elim-first
+  (implies (and (case-split (not (complex-rationalp a)))
+                (case-split (not (complex-rationalp b)))
+                )
+           (equal (mod (+ (mod b y) a) y)
+                  (mod (+ a b) y))))
+
+;Follows from MOD-SUM-ELIM-SECOND-GEN
+(defthm mod-sum-elim-first-gen
+  (implies (and (integerp (/ y2 y))
+                (case-split (not (complex-rationalp x1)))
+                (case-split (not (complex-rationalp x2))) 
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                )
+           (equal (mod (+ (mod x2 y2) x1) y)
+                  (mod (+ x1 x2) y))))
+
+;Follows from MOD-SUM-ELIM-SECOND and MOD-SUM-ELIM-FIRST
+;Do we really need this if we have the other two?
+(defthm mod-sum-elim-both
+  (implies (and (case-split (not (complex-rationalp a)))
+                (case-split (not (complex-rationalp b)))
+                )
+           (equal (mod (+ (mod a y) (mod b y)) y)
+                  (mod (+ a b) y))))
+
+;see mod-diff
+(defthm mod-difference-elim-second
+  (implies (and (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (mod (+ x1 (* -1 (mod x2 y))) y)
+                  (mod (+ x1 (* -1 x2)) y)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+;Follows from MOD-DIFFERENCE-ELIM-SECOND
+;bad name?
+(defthm mod-sum-elim-negative-first-arg
+  (implies (and (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (mod (+ (* -1 (mod x2 y)) x1) y)
+                  (mod (+ (* -1 x2) x1) y))))
+
+(defthm mod-by-1
+  (implies (integerp m)
+           (equal (mod m 1)
+                  0)))
+
+;I'm going to try keeping this disabled, since relieving the first hyp may be expensive.
+;rename: no more n!
+;(integerp (* x (/ y))) basically says that x is a multiple of y, which is 
+;basicially what (equal (mod x y) 0) says too.
+(defthmd mod-mult-of-n
+  (implies (and (integerp (* x (/ y)))
+                (not (equal y 0))
+                (rationalp x)
+                (rationalp y)
+                )
+           (equal (mod x y)
+                  0))
+  :hints (("goal" :in-theory (enable mod))))
+
+;prove a rule for negative x too?
+;try disabling?
+(defthmd mod-negative-y
+  (implies (and (< 0 y)
+                (integerp x)
+                (integerp y)
+                )
+           (equal (mod x (- y))
+                  (if (integerp (/ x y))
+                      0
+                    (+ (- y) (mod x y)))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+
+;BOZO
+;try disabling???
+(defthm mod-does-nothing
+  (implies (and (< m n)
+                (<= 0 m)
+                (case-split (rationalp m)))
+           (equal (mod m n)
+                  m))
+  :hints (("Goal" :in-theory (enable mod))))
+
+
+;better name
+;can derive mod-of-mod, mod-idempotent from this?
+;perhaps keep this disabled??
+(defthm mod-mod-e
+  (implies (and (integerp (/ y1 y2))
+                (case-split (not (equal y2 0)))
+                (case-split (rationalp y1))
+                (case-split (rationalp y2))
+                )
+           (equal (mod (mod x y1) y2)
+                  (mod x y2)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm mod-of-mod
+  (implies (and (case-split (natp k))
+                (case-split (natp n)))
+           (equal (mod (mod x (* k n)) n)
+                  (mod x n))))
+
+;Follows from mod-mod-e and mod-by-0
+(defthm mod-idempotent
+  (implies (and (case-split (rationalp x)) ;(integerp x)
+                (case-split (rationalp y)) ;(integerp y)
+                )
+           (equal (mod (mod x y) y)
+                  (mod x y))))
+
+
+;cute; why does this help so much?
+;like quot-mod
+(defthm mod-fl-2
+  (implies (case-split (acl2-numberp x))
+           (equal (+ (* y (fl (/ x y))) (mod x y))
+                  x))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable floor-fl mod))))
+
+(defthm mod-def
+  (implies (case-split (acl2-numberp x))
+           (equal (mod x y)
+                  (- x (* y (fl (/ x y))))))
+  :hints (("Goal"
+           :in-theory (union-theories (current-theory :here)
+                                      (theory 'ground-zero))))
+  :rule-classes ())
+
+;a is a free var
+(defthmd mod-force-eric
+  (implies (and (<= (* a y) x)
+                (< x (* (1+ a) y))
+                (integerp a)
+                (rationalp x)
+                (rationalp y)
+                )
+           (equal (mod x y)
+                  (- x (* a y))))
+  :hints
+  (("goal" :in-theory (enable mod)
+    :use ((:instance fl-unique (x (/ x y)) (n a))))))
+
+
+
+;chose a in mod-force-eric to be -1
+;expensive?
+(defthmd mod-force-chosen-a-neg
+    (implies (and (< x 0)
+		  (<= (* -1 y) x)
+                  (rationalp x)
+                  (rationalp y)
+                  )
+	     (equal (mod x y)
+                    (- x (* -1 y))))
+    :hints (("Goal" :in-theory (disable mod-force-eric)
+         :use (:instance mod-force-eric (a -1)))))
+
+;gen?
+;or could rewrite to (equal 0 (mod x 2))
+(defthm mod-even
+  (implies (rationalp x)
+           (equal (integerp (* 1/2 (mod x 2)))
+                  (integerp (* 1/2 x))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+;gen 2 to m?
+(defthm mod-even-gen
+  (implies (and (rationalp x)
+                (integerp n)
+                (integerp (* 1/2 n)) ;address the other case?
+                )
+           (equal (integerp (* 1/2 (mod x n)))
+                  (integerp (* 1/2 x))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+
+;Enforces a new normal form for mod in which we force the second arg to be 1.
+;Maybe this is just a weird idea.
+;BOZO bad name?
+(defthmd mod-cancel
+  (implies (syntaxp (not (and (quotep y) (equal (cadr y) 1)))) ;prevents looping
+           (equal (mod x y)
+                  (if (acl2-numberp x)
+                      (if (acl2-numberp y)
+                          (if (equal 0 y)
+                              x
+                            (* y (mod (/ x y) 1)))
+                        x)
+                    0)))
+  :hints (("Goal" :in-theory (enable mod inverse-of-*)))
+  )
+
+
+;can derive at least 1 thm above from this?
+(defthmd mod-equal-0
+  (implies (and ;(case-split (rationalp x))
+                (case-split (rationalp y)) ;gen?
+                (case-split (not (equal y 0)))
+                )
+           (equal (equal (mod x y) 0)
+                  (integerp (* (/ y) x))))
+  :hints (("Goal" 
+           :in-theory (enable mod))))
+
+(defthmd mod-minus-case-non-integerp
+  (implies (and (not (integerp (/ x y)))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (equal (mod (* -1 x) y)
+                  (- y (mod x y))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthmd mod-minus-case-integerp
+  (implies (and (integerp (/ x y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (equal (mod (* -1 x) y)
+                  (- (mod x y))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthmd mod-minus-case-integerp-better
+  (implies (and (integerp (/ x y))
+                (case-split (not (equal 0 y)))
+                (case-split (rationalp y))
+                )
+           (equal (mod (* -1 x) y)
+                  0))
+  :hints (("Goal" :use (mod-minus-case-integerp mod-equal-0))))
+
+;old version
+;disable?
+(defthm mod-minus
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (equal (mod (* -1 x) y)
+                  (if (equal 0 y)
+                      (- x)
+                    (if (integerp (/ x y))
+                        0
+                      (- y (mod x y))))))
+  :hints (("Goal" :in-theory (e/d ( mod-minus-case-integerp-better
+                                    mod-minus-case-non-integerp)
+                                  ())
+           :cases ((integerp (/ x y))))))  
+
+(defthm mod-minus-alt
+  (implies (and (syntaxp (negative-syntaxp x))
+                (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (equal (mod x y)
+                  (if (equal 0 y)
+                      x
+                    (if (integerp (/ (- x) y))
+                        0
+                      (- y (mod (- x) y))))))
+           :hints (("Goal" :in-theory (disable mod-minus) :use (:instance mod-minus (x (- x))))))
+
+(defthm mod-1-integerp
+  (implies (case-split (acl2-numberp x))
+           (equal (integerp (mod x 1))
+                  (integerp x)))
+  :hints (("Goal" :in-theory (enable mod)))
+  )
+
+
+
+
+; needs fl-of-odd/2
+;keep this disabled
+;gen?
+(defthmd mod-by-2-rewrite-to-even
+  (implies (integerp x)
+           (equal (equal (mod x 2) 0)
+                  (integerp (* 1/2 x))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm fl-plus-md
+  (implies (rationalp x)
+           (equal (+ (fl x) (mod x 1))
+                  x))
+  :hints (("Goal" :in-theory (enable mod))))
+
+;sort of an odd rule...
+(defthm mod-1-sum-integer
+  (implies (and (rationalp x)
+                (rationalp y))
+           (equal (integerp (+ x (mod y 1)))
+                  (integerp (+ x y))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+;needed?
+;expensive?
+#|
+??
+ex:   (INTEGERP (* (/ (EXPT 2 J))
+               (MOD X (* 2 (EXPT 2 I)))))
+|#
+;bad name?
+(defthm mod-quotient-integerp
+  (implies (and (integerp (* y k))
+                (rationalp x)
+                (rationalp y)
+                (rationalp k)
+                )
+           (equal (integerp (* k (mod x y)))
+                  (integerp (* k x))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+
+
+
+
+
+
+;gen
+;may someday subsume mod-idempotent
+(defthm mod-mod-2-thm
+  (implies (and (<= y1 y2)
+;test                (case-split (<= 0 y2))
+                (case-split (< 0 y1))                 ;drop?
+                (case-split (acl2-numberp x)) ;gen?
+                (case-split (rationalp y1))
+                (case-split (rationalp y2))
+                (case-split (not (equal y1 0)))
+                )
+           (equal (mod (mod x y1) y2)
+                  (mod x y1)))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable mod))))
+
+
+
+
+;keep disabled?
+(defthmd mod-2-1-means-odd
+  (implies (integerp x)
+           (equal (equal (mod x 2) 1)
+                  (not (integerp (* 1/2 x)))))
+  :hints (("Goal" :in-theory (enable mod))))
+
+;unlikely to fire automatically
+;make a t-p rule too?
+(defthm mod-integerp-2-2
+  (implies (and (integerp y)
+                (integerp x))
+           (integerp (mod x (/ y))))
+  :hints (("Goal" :cases ((equal 0 y))
+           :in-theory (enable mod))))
+
+
+;like mod-prod?
+(defthm mod-cancel-special-1
+  (implies (and (acl2-numberp x)
+                (rationalp k)
+                (acl2-numberp y)
+                (not (equal y 0))
+                (not (equal k 0)))
+           (equal (mod (* k x)
+                       (* y k))
+                  (* k (mod x y))))
+  :hints (("goal" :in-theory (enable mod-cancel))))
+
+;move up
+;expensive?
+(defthm mod-integerp-when-y-is-an-inverse
+  (implies (and (integerp (/ y))
+                (integerp x))
+           (integerp (mod x y)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+;this is a bit odd..
+(defthm mod-when-y-is-an-inverse
+  (implies (and (integerp (/ y))
+                (integerp x)
+                (case-split (< 0 y))
+                )
+           (equal (mod x y)
+                  0))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm fl-mod-x-1
+  (equal (fl (mod x 1)) 
+         0))
+
+(defthmd mod-by-2
+  (implies (integerp x)
+           (equal (mod x 2)
+                  (if (integerp (* 1/2 x))
+                      0
+                    1)))
+  :hints (("Goal" :in-theory (enable mod-by-2-rewrite-to-even mod-2-1-means-odd))))
+
+
+
+
+
+#|
+(defthm mod-with-y-not-rational
+  (implies (and (acl2-numberp x)
+                (not (rationalp y)))
+           (equal (mod x y)
+                  x))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm mod-negative-rewrite
+  (implies (and ;(< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp x)))
+           (implies (< (mod x y) 0)
+                    (and (not (integerp (* x (/ y))))
+                         (< y 0)
+                         )))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (enable mod)))
+)
+
+
+not done
+(defthm mod-of-complex
+  (implies (complex-rationalp x)
+           (equal (mod x y)
+                  xx))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable mod)
+           :cases ((rationalp y) (not (acl2-numberp y))))))
+|#
+
+
+
+
+(encapsulate
+ ()
+ (local (defthm mod-sum-move-forward-implication
+          (implies (and (case-split (<= 0 k1))
+                        (case-split (< k1 y))
+                        (rationalp y)
+                        (rationalp x)
+                        (rationalp k1)
+                        )
+                   (implies (equal k1 (mod (+ k2 x) y))
+                            (equal (mod (+ k1 (- k2)) y) (mod x y))))
+          :rule-classes nil
+          ))
+
+ (local (defthm mod-sum-move-backward-implication
+          (implies (and (case-split (<= 0 k1))
+                        (case-split (< k1 y))
+                        (rationalp y)
+                        (rationalp x)
+                        (rationalp k1)
+                        )
+                   (implies (equal (mod (+ k1 (- k2)) y) (mod x y))
+                            (equal k1 (mod (+ k2 x) y))))
+          :rule-classes nil
+          :hints (("Goal" :use ((:instance mod-sum-move-forward-implication
+                                           (k1 (mod x y))
+                                           (x k1)
+                                           (k2 (- k2))
+                                           ))))))
+
+;I put this in :rule-classes nil, because it can loop if it is a rewrite rule..
+ (defthm mod-sum-move
+   (implies (and (case-split (<= 0 k1))
+                 (case-split (< k1 y))
+                 (case-split (rationalp y))
+                 (case-split (rationalp x))
+                 (case-split (rationalp k1))
+;(rationalp k2)
+                 )
+            (equal (equal k1 (mod (+ k2 x) y))
+                   (equal (mod (+ k1 (- k2)) y) (mod x y))))
+   :rule-classes nil
+   :hints (("Goal" :use (mod-sum-move-forward-implication
+                         mod-sum-move-backward-implication)))))
+
+
+;Unlike the above, this rule shouldn't loop; since k1 and k2 are constants and we compute (+ k1 (- k2)) in the
+;conclusion...
+(defthm mod-sum-move-constants
+  (implies (and (syntaxp (and (quotep k1)
+                              (quotep k2)
+;                              (quotep y)  ;drop?
+                              )
+                         )
+                (case-split (<= 0 k1))
+                (case-split (< k1 y))
+                (rationalp y)
+                (rationalp x)
+                (rationalp k1)
+    ;(rationalp k2)
+                )
+           (equal (equal k1 (mod (+ k2 x) y))
+                  (equal (mod (+ k1 (- k2)) y) (mod x y))))
+  :hints (("Goal" :use mod-sum-move)))
+
+
+
+;BOZO don't need some of these?
+(defthm mod-sums-cancel-1
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (equal (mod (+ k x1) y) (mod (+ k x2) y))
+                  (equal (mod x1 y) (mod x2 y))))
+  :hints (("Goal" :use (:instance mod-sum-move (k2 k) (x x2) (k1 (mod (+ k x1) y))))))
+
+(defthm mod-sums-cancel-2
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (equal (mod (+ x1 k) y) (mod (+ k x2) y))
+                  (equal (mod x1 y) (mod x2 y)))))
+
+(defthm mod-sums-cancel-3
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (equal (mod (+ x1 k) y) (mod (+ x2 k) y))
+                  (equal (mod x1 y) (mod x2 y)))))
+
+;don't need this one..?
+(defthm mod-sums-cancel-4
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (equal (mod (+ k x1) y) (mod (+ x2 k) y))
+                  (equal (mod x1 y) (mod x2 y)))))
+
+(defthm mod-sums-cancel-5
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                )
+           (equal (equal (mod k y) (mod (+ x k) y))
+                  (equal 0 (mod x y))))
+  :hints (("Goal" :use (:instance mod-sums-cancel-4 (x1 0) (x2 x)))))
+
+(defthm mod-sums-cancel-6
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                )
+           (equal (equal (mod k y) (mod (+ k x) y))
+                  (equal 0 (mod x y))))
+  :hints (("Goal" :use (:instance mod-sums-cancel-4 (x1 0) (x2 x)))))
+
+;don't need this one..?
+(defthm mod-sums-cancel-7
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                )
+           (equal (equal (mod (+ k x) y) (mod k y))
+                  (equal 0 (mod x y))))
+  :hints (("Goal" :use (:instance mod-sums-cancel-4 (x1 0) (x2 x)))))
+
+;don't need this one..?
+(defthm mod-sums-cancel-8
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                )
+           (equal (equal (mod (+ x k) y) (mod k y))
+                  (equal 0 (mod x y))))
+  :hints (("Goal" :use (:instance mod-sums-cancel-4 (x1 0) (x2 x)))))
+  
+
+
+
+#|
+;weird case
+;not quite right
+(thm
+ (implies (and ;(<= 0 x1)
+               ;(<= 0 x2)
+               (rationalp x1)
+               (rationalp x2)
+               (rationalp y)
+               (<= 0 y)
+               (< x1 0)
+               (< 0 x2)
+               (< (+ x1 x2) 0)
+               (< (- y) (+ x1 x2))
+               )
+          (equal (+ (mod x1 y) (mod x2 y))
+                 (+ y (mod (+ x1 x2) y))))
+ :hints (("Goal" :in-theory (enable  mod-force-chosen-a-neg)))
+ )
+|#
+
+
+(defthm fl-mod-equal
+  (implies (and (equal (fl (/ x 2)) (fl (/ y 2)))
+                (equal (mod x 2) (mod y 2))
+                (acl2-numberp x)
+                (acl2-numberp y)
+                )
+           (equal x y))
+  :hints (("goal" :in-theory (enable mod)))
+  :rule-classes nil)
+
+
+#|
+
+;there are many ways to say that x is even.  perhaps we should forward chain from any of them to each of the others.
+(defthmd blah
+  (equal (equal (mod x 2) 0)
+         (evenp x))
+  :hints (("Goal" :in-theory (enable evenp mod-equal-0)))
+  )
+
+(defthm mod-of-1-plus-even
+  (equal (mod (+ 1 (* 2 x)) y)
+	 (+ 1 (* 2 (mod x (/ y 2)))))
+  :hints (("Goal" :in-theory (e/d (mod)
+                                  (LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE)))))
+
+|#
+
+
+
+;====
+
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+
+
+
+;comes from mod-upper-bound
+(defthmd mod-bnd-1
+  (implies (and (case-split (< 0 n))
+                (case-split (not (complex-rationalp m)))
+                (case-split (not (complex-rationalp n)))
+                )
+           (< (mod m n) n))
+  :rule-classes :linear)
+
+;why not just enable mod whenever we'd use this rule?
+;make an alternate definition of MOD in terms of FL?
+(defthm quot-mod
+  (implies (case-split (acl2-numberp m))
+           (equal (+ (* n (fl (/ m n))) (mod m n))
+                  m))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (mod floor-fl)))))
+
+;proved in mod2
+;like old mod+-thm
+;make alt
+(defthm mod-mult-eric
+  (implies (and (integerp a)
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y))) ;gen?
+                )
+           (equal (mod (+ x (* a y)) y)
+                  (mod x y))))
+
+
+
+(defthm integerp-mod
+    (implies (and (integerp m)
+		  (integerp n))
+	     (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable mod))))  
+
+; Matt K., November 2006:
+; We prefer to export (to lib) a version of the following rule that does not
+; have a case-split in the hypothesis, because the case-split significantly
+; slowed down a proofs in the regression suite in
+; books/workshops/2004/schmaltz-borrione/support and
+; books/workshops/2004/legato/support/, and we want to be compatible with
+; books/arithmetic-3/.  (The rule rationalp-mod also appears in
+; books/arithmetic-3/floor-mod/floor-mod.lisp, in support of those books.)
+; However, we need the case-split version for mod-bits in
+; ../support/support/bits-proofs.lisp.
+
+(defthm rationalp-mod
+  (implies (rationalp x)
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm rationalp-mod-case-split
+  (implies (case-split (rationalp x))
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable mod))))
+
+(in-theory (disable rationalp-mod))
+
+
+;better conclusion?
+;this follows pretty trivially from quot-mod
+;never used in support/
+(defthm mod-0-fl
+    (implies (acl2-numberp m)
+	     (iff (= (mod m n) 0)
+		  (= m (* (fl (/ m n)) n))))
+  :rule-classes ()
+  :hints (("goal" :use (quot-mod))))
+
+
+;wow! this just goes through!
+(defthm mod-0-0
+  (implies (and (integerp p)
+                (rationalp m)
+                (rationalp n)
+                )
+           (iff (= (mod m (* n p)) 0)
+                (and (= (mod m n) 0)
+                     (= (mod (fl (/ m n)) p) 0))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable mod))))
+
+;BOZO more like this?
+(defthmd mod-prod
+  (implies (and (rationalp m)
+                (rationalp n)
+                (rationalp k)
+                )
+           (equal (mod (* k m) (* k n))
+                  (* k (mod m n))))
+  :hints (("goal" :in-theory (enable mod-cancel))))
+
+(defthm mod012
+  (implies (integerp m)
+           (or (equal (mod m 2) 0)
+               (equal (mod m 2) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-bnd-1 (m m) (n 2))))))
+
+;gen the 2?
+;bad name?
+(defthm mod-mod-2-not-equal
+   (implies (acl2-numberp m) ;(integerp m)
+            (not (= (mod m 2) (mod (1+ m) 2))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance quot-mod (m m) (n 2))
+                         (:instance quot-mod (m (1+ m)) (n 2))))))
+
+;change the formals on these?
+;these are from mod2
+(encapsulate
+ ()
+ (defthmd mod-sum
+   (implies (and (rationalp a)
+                 (rationalp b)
+                 )
+            (equal (mod (+ a (mod b n)) n)
+                   (mod (+ a b) n))))
+
+ (defthm mod-mod-sum
+   (implies (and (rationalp a)
+                 (rationalp b)
+                 )
+            (equal (mod (+ (mod a n) (mod b n)) n)
+                   (mod (+ a b) n))))
+;BOZO
+ (defthmd mod-bnd-2
+   (implies (and (<= 0 m)
+                 (case-split (rationalp m))
+                 )
+            (<= (mod m n) m))  
+   :rule-classes :linear)
+
+ )
+
+;BOZO make this into a better rewrite rule (and generalize)
+;this is sort of a cancellation rule
+;prove from my mod cancellation rules?
+(defthm mod-plus-mod-2
+  (implies (and (integerp a)
+                (integerp b))
+           (iff (= (mod (+ a b) 2) (mod a 2))
+                (= (mod b 2) 0)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (e/d (mod-mult-of-n)
+                                  (MOD-SUM-ELIM-SECOND
+                                   MOD-DROP-IRRELEVANT-SECOND-TERM
+                                   MOD-2-1-MEANS-ODD
+                                   ))
+           :use ((:instance mod012 (m b))
+                 (:instance mod-sum (a a) (b b) (n 2))
+                 (:instance mod-mod-2-not-equal)))))
+
+;bad name
+;The only multiple of N between 0 and 2N is N itself.
+(defthm mod-must-be-n
+    (implies (and (= (mod m n) 0)
+                  (< m (* 2 n))
+		  (< 0 m)
+                  (rationalp m);(integerp m)
+		  (rationalp n);(integerp n)
+		  )
+	     (= m n))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable  MOD-does-nothing)
+           :use ((:instance mod-does-nothing (m m) (n n))
+                 (:instance mod-does-nothing (n n) (m (- m n)))
+;			(:instance mod+-thm (m (- m n)) (a 1))
+                 ))))
+
+;We need this here so that ACL2 knows how to make natp-mod into a type-prescription rule.
+(defthm natp-compound-recognizer
+  (equal (natp x)
+         (and (integerp x)
+              (<= 0 x)))
+  :rule-classes :compound-recognizer)
+
+
+;drop?
+(defthm natp-mod
+  (implies (and (natp m)
+                (natp n))
+           (natp (mod m n)))
+  :rule-classes ((:type-prescription :typed-term (mod m n)))
+  :hints (("Goal" :use (:instance mod-non-negative (x m) (y n)))))
+           
+(defthm natp-mod-rewrite
+  (implies (and (natp m)
+                (natp n))
+           (natp (mod m n))))
+
+;BOZO kill ;gen?  make alt?
+;see mod-mult-eric
+(defthmd mod-mult
+    (implies (and (integerp a)
+                  (rationalp m)
+		  (rationalp n))
+	     (equal (mod (+ m (* a n)) n)
+		    (mod m n)))
+  :hints (("Goal" ;:use mod+-thm
+           )))
+
+;gen?
+;essentially  mod-difference-elim-second
+(defthmd mod-diff
+    (implies (and (case-split (rationalp a))
+                  (case-split (rationalp b))
+                  )
+	     (equal (mod (- a (mod b n)) n)
+		    (mod (- a b) n))))
+
+
+;this doesn't seem to be used anywhere
+(defthmd mod-bnd-3
+    (implies (and (< m (+ (* a n) r))
+		  (<= (* a n) m)
+                  (integerp a)
+                  (case-split (rationalp m))
+		  (case-split (rationalp n))
+		  )
+	     (< (mod m n) r))
+  ;; Free variables make this rule very weak, but it seems harmless
+  ;; enough to make it a :linear rule.
+  :rule-classes :linear
+  :hints (("goal" :in-theory (disable FL-<-INTEGER) ;why needed?
+           :use ((:instance quot-mod)
+			(:instance n<=fl-linear (x (/ m n)) (n a))))))
+
+(defthm mod-force
+  (implies (and (<= (* a n) m)
+                (< m (* (1+ a) n))
+                (integerp a)
+                (rationalp m)
+                (rationalp n)
+                )
+           (= (mod m n) (- m (* a n))))
+  :rule-classes nil :hints
+  (("goal" :use
+    ((:instance quot-mod)
+     (:instance fl-unique (x (/ m n)) (n a))))))
+
+
+(local
+ (defthm mod=mod-1
+   (implies (and (= (mod a n) (mod b n))
+                 (rationalp a) ; (>= a 0)
+                 (rationalp b); (>= b 0)
+;                 (integerp n) ;(> n 0)
+                 )
+            (= (- a (* n (fl (/ a n))))
+               (- b (* n (fl (/ b n))))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance quot-mod (m a))
+                         (:instance quot-mod (m b)))))))
+
+(local
+ (defthm mod=mod-2
+   (implies (and (= (mod a n) (mod b n))
+                 (rationalp a) ; (>= a 0)
+                 (rationalp b) ; (>= b 0)
+;                 (integerp n) ;(> n 0)
+                 )
+            (= (- a b) (* n (- (fl (/ a n)) (fl (/ b n))))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance mod=mod-1))))))
+
+(local
+ (defthm hack-m10
+   (implies (and (rationalp a) (rationalp b) (rationalp c) (> b 0) (= a (* b c)))
+            (= (/ a b) c))
+   :rule-classes ()))
+
+(local
+ (defthm mod=mod-3
+   (implies (and (= (mod a n) (mod b n))
+                 (rationalp a) ; (>= a 0)
+                 (rationalp b); (>= b 0)
+;                 (integerp n) ;(> n 0)
+                 )
+            (= (/ (- a b) n) (- (fl (/ a n)) (fl (/ b n)))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance mod=mod-2)
+                         (:instance hack-m10 (a (- a b)) (b n) (c (- (fl (/ a n)) (fl (/ b n))))))))))
+
+; If A and B are congruent mod N, then their difference is a multiple of N; and conversely.
+; First, the forward direction.
+
+(defthm mod-equal-int
+  (implies (and (= (mod a n) (mod b n))
+                (rationalp a)
+                (rationalp b))
+           (integerp (/ (- a b) n)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance mod=mod-3)))))
+
+(local
+ (defthm mod-equal-int-reverse-1
+   (implies (and (rationalp a)
+                 (rationalp b))
+            (equal (integerp (/ (- a b) n))
+                   (integerp (/ (- (mod a n) (mod b n))
+                                n))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance mod-def
+                                    (x a) (y n))
+                         (:instance mod-def
+                                    (x b) (y n)))))))
+
+(local
+ (defthm mod-equal-int-reverse-2
+   (implies (and (rationalp a)
+                 (rationalp b))
+            (equal (integerp (/ (- a b) n))
+                   (integerp (/ (- (mod a n) (mod b n))
+                                n))))
+   :rule-classes ()
+   :hints (("goal" :use mod-equal-int-reverse-1))))
+
+(local
+ (defthm mod-equal-int-reverse-3-1-1-1
+   (implies (and (rationalp i)
+                 (<= 0 i)
+                 (rationalp n)
+                 (< i n))
+            (implies (integerp (/ i n))
+                     (= i 0)))
+   :rule-classes nil))
+
+(local
+ (defthm mod-equal-int-reverse-3-1-1
+   (implies (and (rationalp i)
+                 (rationalp n)
+                 (< (abs i) n))
+            (implies (integerp (/ i n))
+                     (= i 0)))
+   :hints (("Goal" :use (mod-equal-int-reverse-3-1-1-1
+                         (:instance mod-equal-int-reverse-3-1-1-1
+                                    (i (- i))))))
+   :rule-classes nil))
+
+(local
+ (defthm mod-equal-int-reverse-3-1
+   (implies (and (rationalp i)
+                 (<= 0 i)
+                 (rationalp j)
+                 (<= 0 j)
+                 (rationalp n)
+                 (< i n)
+                 (< j n))
+            (implies (integerp (/ (- i j) n))
+                     (= i j)))
+   :hints (("Goal" :use ((:instance mod-equal-int-reverse-3-1-1
+                                    (i (- i j))))))
+   :rule-classes nil))
+
+(local
+ (defthm mod-equal-int-reverse-3
+   (implies (and (rationalp a)
+                 (rationalp b)
+                 (rationalp n)
+                 (< 0 n))
+            (implies (integerp (/ (- a b) n))
+                     (= (mod a n) (mod b n))))
+   :rule-classes ()
+   :hints (("goal" :use (mod-equal-int-reverse-2
+                         (:instance mod-equal-int-reverse-3-1
+                                    (i (mod a n))
+                                    (j (mod b n))))))))
+
+(local
+ (defthm mod-equal-int-reverse-4
+   (implies (and (rationalp a)
+                 (rationalp b)
+                 (rationalp n)
+                 (< 0 n))
+            (implies (= (mod a n) (mod b n))
+                     (integerp (/ (- a b) n))))
+   :rule-classes ()
+  :hints (("goal" :use (mod=mod-3)))))
+
+(defthm mod-equal-int-reverse
+  (implies (and (integerp (/ (- a b) n))
+                (rationalp a)
+                (rationalp b)
+                (rationalp n)
+                (< 0 n))
+           (= (mod a n) (mod b n)))
+  :rule-classes ()
+  :hints (("goal" :use (mod-equal-int-reverse-3 mod-equal-int-reverse-4))))
+
+(defthmd mod-mult-2
+  (implies (integerp a)
+           (equal (mod (* a n) n)
+                  0))
+  :hints (("goal" :in-theory (enable mod-when-y-is-complex-rationalp)
+           :use ((:instance mod-mult-eric (x 0) (y n))
+                 ))))
+
+(defthmd mod-mult-2-alt
+  (implies (integerp a)
+           (equal (mod (* n a) n)
+                  0))
+  :hints (("Goal" :in-theory (enable mod-mult-2))))
+
+(defthmd mod-mult-n
+  (equal (mod (* a n) n)
+         (* n (mod a 1)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthmd mod-mult-n-commuted
+  (equal (mod (* n a) n)
+         (* n (mod a 1)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthm mod-0-int
+  (implies (and (integerp m)
+                (integerp n)
+                (not (= n 0)))
+           (iff (= (mod m n) 0)
+                (integerp (/ m n))))
+  :hints (("Goal" :use ((:instance mod-equal-int
+                                   (a m) (b 0) (n n))
+                        quot-mod)))
+  :rule-classes ())
+
+;rename params on these:
+
+;just a special case of mod-mult-2-alt
+;generalize?
+;; Rule A3 in fp.lisp suggests using (* 2 i) instead of
+;; (+ i i).
+(defthm mod-2*i
+  (implies (integerp i)
+           (equal (mod (* 2 i) 2)
+                  0))
+  :hints (("Goal" :in-theory (enable mod-mult-2-alt))))
+
+;gen the 2?
+(defthm mod-2*m+1-rewrite
+  (implies (integerp m)
+           (equal (mod (1+ (* 2 m)) 2)
+                  1)))
+
+;eliminate this
+;in fact, it equals 1!
+(defthm mod-2*i+1
+  (implies (integerp i)
+           (not (equal (mod (1+ (* 2 i)) 2)
+                       0))))
+
+(defun INDUCT-NAT (x)
+  (if (and (integerp x)
+	   (> x 0))
+      (induct-nat (1- x))
+    ()))
+
+
+(local (defthm nk>=k-1
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp k)
+		  (> k 0)
+		  (not (= (* n k) 0))
+                  )
+	     (>= (* n k) k))
+  :rule-classes ()
+  :hints (("goal" :induct (induct-nat n)))
+   ))
+
+(local (defthm nk>=k-2
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp k)
+		  (> k 0)
+		  (not (= (* n k) 0)))
+	     (>= (abs (* n k)) k))
+  :rule-classes ()
+  :hints (("goal" :use (nk>=k-1)))))
+
+
+
+
+
+(local (defthm nk>=k-3
+    (implies (and (integerp n)
+		  (<= n 0)
+		  (integerp k)
+		  (> k 0)
+		  (not (= (* n k) 0)))
+	     (>= (abs (* n k)) k))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance nk>=k-2 (n (- n))))))))
+
+;BOZO move or drop?
+(defthm nk>=k
+    (implies (and (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (not (= (* n k) 0)))
+	     (>= (abs (* n k)) k))
+  :rule-classes ()
+  :hints (("goal" :use (nk>=k-2 nk>=k-3))))
+
+;BOZO gen?
+;not used anywhere but exported by lib/basic
+(defthm mod-force-equal
+  (implies (and (< (abs (- a b)) n)
+                (rationalp a) ;                  (natp a)
+                (rationalp b) ;(natp b)
+                (integerp n) ;(rationalp n) ;(natp n)
+                )
+           (iff (= (mod a n) (mod b n))
+                (= a b)))
+  :rule-classes ()
+  :hints (("goal" :use ( mod-equal-int
+                         (:instance nk>=k (k n) (n (/ (- a b) n)))
+;			(:instance *cancell (x a) (y b) (z n))
+                         ))))
+
+
+;yuck? BOZO used anywhere?
+(defthm nk>=k-linear
+    (implies (and (integerp n)
+		  (integerp k)
+		  (not (= n 0)))
+	     (>= (abs (* n k)) k))
+  :rule-classes :linear
+  :hints (("Goal" :use nk>=k)))
+
+
+;BOZO more like this.  get rid of mod-mult-alt-2?
+(defthm mod-mult-2-gen
+  (equal (mod (* a n) n)
+         (* n (mod a 1)))
+  :hints (("Goal" :in-theory (enable mod-cancel))))
+(defthm mod-mult-2-alt-gen
+  (equal (mod (* n a) n)
+         (* n (mod a 1)))
+  :hints (("Goal" :in-theory (enable mod-cancel))))
+
+#|
+(defthm mod-sum-subst
+  (implies (and (syntaxp (not (quotep z)))
+                (equal (mod z y) k)
+                (syntaxp (quotep k))
+                (rationalp z)
+                (rationalp x)
+                )
+           (equal (mod (+ x z) y)
+                  (mod (+ x k) y)))) 
+                        
+
+(defthm mod-split-around-zero
+  (implies (and (< x y)
+                (< (* -1 y) x)
+                (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (mod x y)
+                  (if (< x 0) 
+                      (+ x y)
+                      x)))
+  :hints (("Goal" :in-theory (enable mod-does-nothing  mod-force-chosen-a-neg)))
+)
+
+(defthm hack-ky
+  (implies (and; (syntaxp (and (quotep k) (quotep y)))
+                (< k y)
+                (<= 0 k)
+                ;(<= 0 y)
+                (rationalp x)
+                (rationalp y)
+                (rationalp k)
+                )
+           (equal (mod (+ k x) y)
+                  (if (< (+ k (mod x y)) y)
+                      (+ k (mod x y))
+                    (+ (- k y) (mod x y)))))
+  :hints (("Goal" :use((:instance mod-does-nothing (m (+ k (mod x y))) (n y))
+                       (:instance mod-does-nothing (m (+ (- k y) (mod x y))) (n y)))
+           :in-theory (disable mod-does-nothing)))
+  )
+
+(defthm mod-normalize-leading-constant
+  (implies (and (syntaxp (and (quotep k)
+                              (or (< (cadr k) 0)
+                                  (<= (cadr y) (cadr k)))))
+                (syntaxp (quotep y))
+                (rationalp k)
+                (rationalp x)
+                (rationalp y)
+                )
+           (equal (mod (+ k x) y)
+                  (mod (+ (mod k y) x) y))))
+
+
+
+
+(defthm hack
+  (equal (INTEGERP (* 1/8 x))
+         (equal 0 (mod x 8)))
+  :hints (("Goal" :in-theory (enable mod)))
+)
+
+
+
+|#
+
+
+(defthm fl-mod
+  (implies (and (rationalp x)
+                (natp y)
+                )
+           (equal (fl (mod x y))
+                  (mod (fl x) y)))
+  :hints (("Goal" :in-theory (enable mod)))
+  )
+
+; a powerful rule!
+(defthmd mod-sum-cases
+  (implies (and; (syntaxp (and (quotep k) (quotep y)))
+;                (< k y)
+;                (<= 0 k)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y)
+                (rationalp k)
+                )
+           (equal (mod (+ k x) y)
+                  (if (< (+ (mod k y) (mod x y)) y)
+                      (+ (mod k y) (mod x y))
+                    (+ (mod k y) (mod x y) (* -1 y)))))
+  :otf-flg t
+  :hints (("Goal" :use((:instance mod-does-nothing (m (+ (mod k y) (mod x y))) (n y))
+                       (:instance  mod-force-eric (a 1) (x (+ (MOD K Y) (MOD X Y))))
+                       )
+           :in-theory (disable mod-does-nothing)))
+  )
+
+
+
+;BOZO move
+(defthmd mod-fl-eric
+  (implies (and (<= 0 y)
+                (integerp y)
+                )
+           (equal (mod (fl x) y)
+                  (fl (mod x y))))
+  :hints (("Goal" :use (:instance fl/int-rewrite (n y))
+           :in-theory (enable mod ))))
+
+(defthm mod-squeeze
+  (implies (and (= (mod m n) 0)
+                (< m (* (1+ a) n))
+                (< (* (1- a) n) m)
+                (integerp a)
+                (integerp m)
+                (integerp n))
+           (= m (* a n)))
+  :hints (("Goal" :use (mod-0-int
+                        (:theorem
+                         (implies (and (< m (* (1+ a) n))
+                                       (< (* (1- a) n) m)
+                                       (rationalp n))
+                                  (and (< (1- a) (/ m n))
+                                       (< (/ m n) (1+ a))))))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/mod.lisp acl2-6.3/books/rtl/rel9/arithmetic/mod.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/mod.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/mod.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1121 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "ground-zero")
+(include-book "negative-syntaxp")
+
+(local (include-book "mod-proofs"))
+
+#| 
+
+Todo: We could probably prove REM analogs for most of the rules in this book (since REM and MOD agree on a
+certain range of inputs), but we don't use REM much at all in the library (for good reason, thinks Eric), so
+perhaps this isn't worth spending time on.
+
+|#
+
+
+;This fact is built in to ACL2 as (:TYPE-PRESCRIPTION MOD), so we disable it. 
+(defthmd mod-acl2-numberp-type-prescription
+  (acl2-numberp (mod x y))
+  :rule-classes (:type-prescription))
+
+;Perhaps we don't need this as a rewrite rule, but here it is anyway:
+(defthm mod-acl2-numberp
+  (acl2-numberp (mod x y)))
+
+;BOZO make sure we have a rule around which backchains from (not (complex-rationalp x)) to (rationalp x).
+;BOZO maybe we don't want the case-split in the t-p rule?
+(defthm mod-rationalp
+  (implies (case-split (not (complex-rationalp x)))
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+;BOZO do we even need this?
+(defthm mod-rational-when-y-is-rational-rewrite
+  (implies (and (rationalp y)
+                (case-split (acl2-numberp x))
+                )
+           (equal (rationalp (mod x y))
+                  (rationalp x))))
+
+;see also mod-integerp-when-y-is-power-of-2-gen
+(defthm mod-integerp
+  (implies (and (integerp x) ;can't gen: (mod 2/3   5)=2/3
+                (integerp y) ;can't gen: (mod 5   2/3)=1/3
+                )
+           (integerp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+;what about when x is a known int?
+(defthm mod-integerp-2
+  (implies (and (integerp y)
+                (case-split (acl2-numberp x))
+                )
+           (equal (integerp (mod x y))
+                  (integerp x))))
+
+
+
+
+
+;mod when x is complex?
+
+(defthm mod-with-x-a-non-acl2-number-is-zero
+  (implies (not (acl2-numberp x))
+           (equal (mod x y)
+                  0)))
+
+;enable?
+(defthmd mod-when-y-is-not-an-acl2-numberp
+  (implies (not (acl2-numberp y))
+           (equal (mod x y)
+                  (fix x))))
+
+(defthmd mod-when-y-is-complex-rationalp
+  (implies (complex-rationalp y)
+           (equal (mod x y)
+                  (if (not (complex-rationalp x))
+                      (fix x)
+                    (if (not (rationalp (/ x y)))
+                        x
+                      (if (integerp (/ x y))
+                          0 
+                        (+ X (* -1 Y (FLOOR (* X (/ Y)) 1))) ;this case is gross (basically the defn of mod)
+                        ))))))
+
+
+
+
+
+;I weakened the hyp on x as much as I could and then weakened the hyps on y as much as possible.  (We might
+;get a different rule by doing the reverse of that.)
+(defthm mod-non-negative
+  (implies (and (case-split (< 0 y)) ;can't gen: (mod -1 0) = -1 and  (mod 3 -2) = -1
+                (case-split (not (complex-rationalp x))) ;can't gen: (mod #C(-4 -3) 1) = #c(-4 -3)
+                (case-split (not (complex-rationalp y))) ;can't gen: (mod -3 #c(1 1)) = -3
+                )
+           (<= 0 (mod x y))))
+
+(defthm mod-non-negative-rationalp-type-prescription
+  (implies (and (case-split (< 0 y))                     
+                (case-split (not (complex-rationalp x))) 
+                (case-split (not (complex-rationalp y))) 
+                )
+           (and (<= 0 (mod x y))
+                (rationalp (mod x y)) ;we might as well include this
+                ))
+  :rule-classes ((:type-prescription :typed-term (mod x y))))
+
+(defthm mod-non-negative-linear
+  (implies (and (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (<= 0 (mod x y)))
+  :rule-classes ((:linear :trigger-terms ((mod x y)))))
+
+(defthm mod-upper-bound
+  (implies (and (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (< (mod x y) y)))
+
+(defthm mod-upper-bound-linear
+  (implies (and (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (< (mod x y) y))
+  :rule-classes ((:linear :trigger-terms ((mod x y)))))
+
+;included to help a hyp which matches this rule's conclusion get written away quickly
+(defthm mod-upper-bound-less-tight-rewrite
+  (implies (and (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (<= (mod x y) y)))
+
+;do we need this?  is it expensive?
+(defthm mod-upper-bound-3
+  (implies (and (<= y z)
+                (case-split (< 0 y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y)))
+                )
+           (< (mod x y) z)))
+
+(defthm mod-upper-bound-2
+  (implies (and (<= 0 x)
+                (case-split (not (complex-rationalp x)))
+                )
+           (<= (mod x y) x))
+  :rule-classes (:rewrite (:linear :trigger-terms ((mod x y)))))
+
+(defthm mod-0
+    (and (equal (mod 0 y)
+                0)
+         (equal (mod x 0)
+                (fix x))))
+
+(defthm mod-complex-rationalp-rewrite
+  (implies (case-split (rationalp y))
+           (equal (complex-rationalp (mod x y))
+                  (complex-rationalp x))))
+
+;Don't make this a rewrite rule (we don't want to backchain to (< y 0) to establish (rationalp (mod x y))
+(defthm mod-non-positive-type-prescription
+  (implies (and (< y 0) ;rarely will be the case
+                (rationalp x)
+                (rationalp y)
+                )
+           (and (rationalp (mod x y))
+                (<= (mod x y) 0)))
+  :rule-classes (:type-prescription))
+
+(defthm mod-non-positive
+  (implies (and (< y 0) ;rarely will be the case
+                (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (<= (mod x y) 0)))
+
+;rewrite a claim about mod being non-positive to a claim about y?
+
+(local (include-book "fl")) ;drop?
+
+(defthm mod-drop-irrelevant-first-term
+  (implies (and (integerp (* k (/ y)))
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                (case-split (not (complex-rationalp x)))
+                )
+           (equal (mod (+ k x) y)
+                  (mod x y))))
+
+(defthm mod-drop-irrelevant-second-term
+  (implies (and (integerp (* k (/ y)))
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                (case-split (not (complex-rationalp x)))
+                )
+           (equal (mod (+ x k) y)
+                  (mod x y))))
+
+(defthm mod-drop-irrelevant-second-term-with-more-terms
+  (implies (and (integerp (* k (/ y)))
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp x2)))
+                )
+           (equal (mod (+ x k x2) y)
+                  (mod (+ x x2) y))))
+
+(defthm mod-drop-irrelevant-third-term
+  (implies (and (integerp (* k (/ y)))
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp x2)))
+                )
+           (equal (mod (+ x x2 k) y)
+                  (mod (+ x x2) y))))
+
+;We could make analogs to MOD-DROP-IRRELEVANT-SECOND-TERM in which we drop the third, fourth, etc. term.
+
+(defthm mod-mult-eric
+  (implies (and (integerp a)
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y))) ;gen?
+                )
+           (equal (mod (+ x (* a y)) y)
+                  (mod x y))))
+
+;similar lemmas below?
+;change params on the rest?
+
+;could we generalize (mod x2 y) to (* k (mod x2 y)) ??
+;I don't think we can drop either hyp.
+(defthm mod-sum-elim-second
+  (implies (and (case-split (not (complex-rationalp x1)))
+                (case-split (not (complex-rationalp x2))) 
+                )
+           (equal (mod (+ x1 (mod x2 y)) y)
+                  (mod (+ x1 x2) y))))
+
+(defthm mod-sum-elim-second-gen
+  (implies (and (integerp (/ y2 y))
+                (case-split (not (complex-rationalp x1)))
+                (case-split (not (complex-rationalp x2))) 
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                )
+           (equal (mod (+ x1 (mod x2 y2)) y)
+                  (mod (+ x1 x2) y))))
+
+
+;Follows from MOD-SUM-ELIM-SECOND
+(defthm mod-sum-elim-first
+  (implies (and (case-split (not (complex-rationalp a)))
+                (case-split (not (complex-rationalp b)))
+                )
+           (equal (mod (+ (mod b y) a) y)
+                  (mod (+ a b) y))))
+
+;Follows from MOD-SUM-ELIM-SECOND-GEN
+(defthm mod-sum-elim-first-gen
+  (implies (and (integerp (/ y2 y))
+                (case-split (not (complex-rationalp x1)))
+                (case-split (not (complex-rationalp x2))) 
+                (case-split (not (equal y 0)))
+                (case-split (rationalp y))
+                )
+           (equal (mod (+ (mod x2 y2) x1) y)
+                  (mod (+ x1 x2) y))))
+
+;Follows from MOD-SUM-ELIM-SECOND and MOD-SUM-ELIM-FIRST
+;Do we really need this if we have the other two?
+(defthm mod-sum-elim-both
+  (implies (and (case-split (not (complex-rationalp a)))
+                (case-split (not (complex-rationalp b)))
+                )
+           (equal (mod (+ (mod a y) (mod b y)) y)
+                  (mod (+ a b) y))))
+
+;see mod-diff
+(defthm mod-difference-elim-second
+  (implies (and (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (mod (+ x1 (* -1 (mod x2 y))) y)
+                  (mod (+ x1 (* -1 x2)) y))))
+
+;Follows from MOD-DIFFERENCE-ELIM-SECOND
+;bad name?
+(defthm mod-sum-elim-negative-first-arg
+  (implies (and (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (mod (+ (* -1 (mod x2 y)) x1) y)
+                  (mod (+ (* -1 x2) x1) y))))
+
+(defthm mod-by-1
+  (implies (integerp m)
+           (equal (mod m 1)
+                  0)))
+
+;I'm going to try keeping this disabled, since relieving the first hyp may be expensive.
+;rename: no more n!
+;(integerp (* x (/ y))) basically says that x is a multiple of y, which is 
+;basicially what (equal (mod x y) 0) says too.
+(defthmd mod-mult-of-n
+  (implies (and (integerp (* x (/ y)))
+                (not (equal y 0))
+                (rationalp x)
+                (rationalp y)
+                )
+           (equal (mod x y)
+                  0)))
+
+;prove a rule for negative x too?
+;try disabling?
+(defthmd mod-negative-y
+  (implies (and (< 0 y)
+                (integerp x)
+                (integerp y)
+                )
+           (equal (mod x (- y))
+                  (if (integerp (/ x y))
+                      0
+                    (+ (- y) (mod x y))))))
+
+;BOZO
+;try disabling???
+(defthm mod-does-nothing
+  (implies (and (< m n)
+                (<= 0 m)
+                (case-split (rationalp m)))
+           (equal (mod m n)
+                  m)))
+
+;better name
+;can derive mod-of-mod, mod-idempotent from this?
+;perhaps keep this disabled??
+(defthm mod-mod-e
+  (implies (and (integerp (/ y1 y2))
+                (case-split (not (equal y2 0)))
+                (case-split (rationalp y1))
+                (case-split (rationalp y2))
+                )
+           (equal (mod (mod x y1) y2)
+                  (mod x y2))))
+
+(defthm mod-of-mod
+  (implies (and (case-split (natp k))
+                (case-split (natp n)))
+           (equal (mod (mod x (* k n)) n)
+                  (mod x n))))
+
+;Follows from mod-mod-e and mod-by-0
+(defthm mod-idempotent
+  (implies (and (case-split (rationalp x)) ;(integerp x)
+                (case-split (rationalp y)) ;(integerp y)
+                )
+           (equal (mod (mod x y) y)
+                  (mod x y))))
+
+
+;cute; why does this help so much?
+;like quot-mod
+(defthm mod-fl-2
+  (implies (case-split (acl2-numberp x))
+           (equal (+ (* y (fl (/ x y))) (mod x y))
+                  x))
+  :rule-classes ())
+
+(defthm mod-def
+  (implies (case-split (acl2-numberp x))
+           (equal (mod x y)
+                  (- x (* y (fl (/ x y))))))
+  :rule-classes ())
+
+;why not just enable mod whenever we'd use this rule?
+;make an alternate definition of MOD in terms of FL?
+(defthm quot-mod
+  (implies (case-split (acl2-numberp m))
+           (equal (+ (* n (fl (/ m n))) (mod m n))
+                  m))
+  :rule-classes ())
+
+;a is a free var
+(defthmd mod-force-eric
+  (implies (and (<= (* a y) x)
+                (< x (* (1+ a) y))
+                (integerp a)
+                (rationalp x)
+                (rationalp y)
+                )
+           (equal (mod x y)
+                  (- x (* a y)))))
+
+
+
+;chose a in mod-force-eric to be -1
+;expensive?
+(defthmd mod-force-chosen-a-neg
+    (implies (and (< x 0)
+		  (<= (* -1 y) x)
+                  (rationalp x)
+                  (rationalp y)
+                  )
+	     (equal (mod x y)
+                    (- x (* -1 y)))))
+
+;gen?
+;or could rewrite to (equal 0 (mod x 2))
+(defthm mod-even
+  (implies (rationalp x)
+           (equal (integerp (* 1/2 (mod x 2)))
+                  (integerp (* 1/2 x)))))
+
+;gen 2 to m?
+(defthm mod-even-gen
+  (implies (and (rationalp x)
+                (integerp n)
+                (integerp (* 1/2 n)) ;address the other case?
+                )
+           (equal (integerp (* 1/2 (mod x n)))
+                  (integerp (* 1/2 x)))))
+
+
+;Enforces a new normal form for mod in which we force the second arg to be 1.
+;Maybe this is just a weird idea.
+;BOZO bad name?
+(defthmd mod-cancel
+  (implies (syntaxp (not (and (quotep y) (equal (cadr y) 1)))) ;prevents looping
+           (equal (mod x y)
+                  (if (acl2-numberp x)
+                      (if (acl2-numberp y)
+                          (if (equal 0 y)
+                              x
+                            (* y (mod (/ x y) 1)))
+                        x)
+                    0))))
+
+
+;old version
+(defthmd mod-minus
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (mod (* -1 x) y)
+                  (if (equal 0 y)
+                      (- x)
+                    (if (integerp (/ x y))
+                        0
+                      (- y (mod x y)))))))
+
+
+(defthm mod-minus-alt
+  (implies (and (syntaxp (negative-syntaxp x))
+                (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (equal (mod x y)
+                  (if (equal 0 y)
+                      x
+                    (if (integerp (/ (- x) y))
+                        0
+                      (- y (mod (- x) y)))))))
+
+(defthm mod-1-integerp
+  (implies (case-split (acl2-numberp x))
+           (equal (integerp (mod x 1))
+                  (integerp x))))
+
+; needs fl-of-odd/2
+;keep this disabled
+;gen?
+(defthmd mod-by-2-rewrite-to-even
+  (implies (integerp x)
+           (equal (equal (mod x 2) 0)
+                  (integerp (* 1/2 x)))))
+
+(defthm fl-plus-md
+  (implies (rationalp x)
+           (equal (+ (fl x) (mod x 1))
+                  x)))
+
+;sort of an odd rule...
+(defthm mod-1-sum-integer
+  (implies (and (rationalp x)
+                (rationalp y))
+           (equal (integerp (+ x (mod y 1)))
+                  (integerp (+ x y)))))
+
+;needed?
+;expensive?
+#|
+??
+ex:   (INTEGERP (* (/ (EXPT 2 J))
+               (MOD X (* 2 (EXPT 2 I)))))
+|#
+
+
+;bad name?
+(defthm mod-quotient-integerp
+  (implies (and (integerp (* y k))
+                (rationalp x)
+                (rationalp y)
+                (rationalp k)
+                )
+           (equal (integerp (* k (mod x y)))
+                  (integerp (* k x)))))
+
+;gen
+;may someday subsume mod-idempotent
+(defthm mod-mod-2-thm
+  (implies (and (<= y1 y2)
+;test                (case-split (<= 0 y2))
+                (case-split (< 0 y1))                 ;drop?
+                (case-split (acl2-numberp x)) ;gen?
+                (case-split (rationalp y1))
+                (case-split (rationalp y2))
+                (case-split (not (equal y1 0)))
+                )
+           (equal (mod (mod x y1) y2)
+                  (mod x y1))))
+
+
+;new
+;can derive at least 1 thm above from this?
+(defthmd mod-equal-0
+  (implies (and ;(case-split (rationalp x))
+                (case-split (rationalp y)) ;gen?
+                (case-split (not (equal y 0)))
+                )
+           (equal (equal (mod x y) 0)
+                  (integerp (* (/ y) x)))))
+
+;keep disabled?
+(defthmd mod-2-1-means-odd
+  (implies (integerp x)
+           (equal (equal (mod x 2) 1)
+                  (not (integerp (* 1/2 x))))))
+
+;unlikely to fire automatically
+;make a t-p rule too?
+(defthm mod-integerp-2-2
+  (implies (and (integerp y)
+                (integerp x))
+           (integerp (mod x (/ y)))))
+
+
+;like mod-prod?
+(defthm mod-cancel-special-1
+  (implies (and (acl2-numberp x)
+                (rationalp k)
+                (acl2-numberp y)
+                (not (equal y 0))
+                (not (equal k 0)))
+           (equal (mod (* k x)
+                       (* y k))
+                  (* k (mod x y)))))
+
+;move up
+;expensive?
+(defthm mod-integerp-when-y-is-an-inverse
+  (implies (and (integerp (/ y))
+                (integerp x))
+           (integerp (mod x y))))
+
+;this is a bit odd..
+(defthm mod-when-y-is-an-inverse
+  (implies (and (integerp (/ y))
+                (integerp x)
+                (case-split (< 0 y))
+                )
+           (equal (mod x y)
+                  0)))
+
+(defthm fl-mod-x-1
+  (equal (fl (mod x 1)) 
+         0))
+
+(defthmd mod-by-2
+  (implies (integerp x)
+           (equal (mod x 2)
+                  (if (integerp (* 1/2 x))
+                      0
+                    1))))
+
+
+
+
+
+
+
+
+;I put this in :rule-classes nil, because it can loop if it is a rewrite rule..
+(defthm mod-sum-move
+   (implies (and (case-split (<= 0 k1))
+                 (case-split (< k1 y))
+                 (case-split (rationalp y))
+                 (case-split (rationalp x))
+                 (case-split (rationalp k1))
+;(rationalp k2)
+                 )
+            (equal (equal k1 (mod (+ k2 x) y))
+                   (equal (mod (+ k1 (- k2)) y) (mod x y))))
+   :rule-classes nil)
+
+;Unlike the above, this rule shouldn't loop; since k1 and k2 are constants and we compute (+ k1 (- k2)) in the
+;conclusion...
+(defthm mod-sum-move-constants
+  (implies (and (syntaxp (and (quotep k1)
+                              (quotep k2)
+;                              (quotep y)  ;drop?
+                              )
+                         )
+                (case-split (<= 0 k1))
+                (case-split (< k1 y))
+                (rationalp y)
+                (rationalp x)
+                (rationalp k1)
+    ;(rationalp k2)
+                )
+           (equal (equal k1 (mod (+ k2 x) y))
+                  (equal (mod (+ k1 (- k2)) y) (mod x y)))))
+
+
+
+;BOZO don't need some of these?
+(defthm mod-sums-cancel-1
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (equal (mod (+ k x1) y) (mod (+ k x2) y))
+                  (equal (mod x1 y) (mod x2 y)))))
+
+(defthm mod-sums-cancel-2
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (equal (mod (+ x1 k) y) (mod (+ k x2) y))
+                  (equal (mod x1 y) (mod x2 y)))))
+
+(defthm mod-sums-cancel-3
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (equal (mod (+ x1 k) y) (mod (+ x2 k) y))
+                  (equal (mod x1 y) (mod x2 y)))))
+
+;don't need this one..?
+(defthm mod-sums-cancel-4
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x1))
+                (case-split (rationalp x2))
+                )
+           (equal (equal (mod (+ k x1) y) (mod (+ x2 k) y))
+                  (equal (mod x1 y) (mod x2 y)))))
+
+(defthm mod-sums-cancel-5
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                )
+           (equal (equal (mod k y) (mod (+ x k) y))
+                  (equal 0 (mod x y)))))
+
+(defthm mod-sums-cancel-6
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                )
+           (equal (equal (mod k y) (mod (+ k x) y))
+                  (equal 0 (mod x y)))))
+
+;don't need this one..?
+(defthm mod-sums-cancel-7
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                )
+           (equal (equal (mod (+ k x) y) (mod k y))
+                  (equal 0 (mod x y)))))
+
+;don't need this one..?
+(defthm mod-sums-cancel-8
+  (implies (and (case-split (<= 0 y))
+                (case-split (rationalp k))
+                (case-split (rationalp y))
+                (case-split (rationalp x))
+                )
+           (equal (equal (mod (+ x k) y) (mod k y))
+                  (equal 0 (mod x y)))))
+  
+
+
+
+(defthm fl-mod-equal
+  (implies (and (equal (fl (/ x 2)) (fl (/ y 2)))
+                (equal (mod x 2) (mod y 2))
+                (acl2-numberp x)
+                (acl2-numberp y)
+                )
+           (equal x y))
+  :rule-classes nil)
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+;comes from mod-upper-bound
+(defthmd mod-bnd-1
+  (implies (and (case-split (< 0 n))
+                (case-split (not (complex-rationalp m)))
+                (case-split (not (complex-rationalp n)))
+                )
+           (< (mod m n) n))
+  :rule-classes :linear)
+
+;proved in mod2
+;like old mod+-thm
+;make alt
+(defthm mod-mult-eric
+  (implies (and (integerp a)
+                (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y))) ;gen?
+                )
+           (equal (mod (+ x (* a y)) y)
+                  (mod x y))))
+
+
+
+(defthm integerp-mod
+    (implies (and (integerp m)
+		  (integerp n))
+	     (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription))  
+
+; Matt K., November 2006:
+; We prefer to export (to lib) a version of the following rule that does not
+; have a case-split in the hypothesis, because the case-split significantly
+; slowed down a proofs in the regression suite in
+; books/workshops/2004/schmaltz-borrione/support and
+; books/workshops/2004/legato/support/, and we want to be compatible with
+; books/arithmetic-3/.  (The rule rationalp-mod also appears in
+; books/arithmetic-3/floor-mod/floor-mod.lisp, in support of those books.)
+; However, we need the case-split version for mod-bits in
+; ../support/support/bits-proofs.lisp.
+
+(defthm rationalp-mod
+  (implies (rationalp x)
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm rationalp-mod-case-split
+  (implies (case-split (rationalp x))
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable mod))))
+
+(in-theory (disable rationalp-mod))
+
+;better conclusion?
+;this follows pretty trivially from quot-mod
+;never used in support/
+(defthm mod-0-fl
+    (implies (acl2-numberp m)
+	     (iff (= (mod m n) 0)
+		  (= m (* (fl (/ m n)) n))))
+  :rule-classes ())
+
+
+
+
+;wow! this just goes through!
+(defthm mod-0-0
+  (implies (and (integerp p)
+                (rationalp m)
+                (rationalp n)
+                )
+           (iff (= (mod m (* n p)) 0)
+                (and (= (mod m n) 0)
+                     (= (mod (fl (/ m n)) p) 0))))
+  :rule-classes ())
+
+
+;BOZO see mod-cancel?
+(defthmd mod-prod
+  (implies (and (rationalp m)
+                (rationalp n)
+                (rationalp k)
+                )
+           (equal (mod (* k m) (* k n))
+                  (* k (mod m n)))))
+
+(defthm mod012
+  (implies (integerp m)
+           (or (equal (mod m 2) 0)
+               (equal (mod m 2) 1)))
+  :rule-classes ())
+
+
+;gen the 2?
+;bad name?
+(defthm mod-mod-2-not-equal
+   (implies (acl2-numberp m) ;(integerp m)
+            (not (= (mod m 2) (mod (1+ m) 2))))
+   :rule-classes ())
+
+;change the formals on these?
+;these are from mod2
+(encapsulate
+ ()
+ (defthmd mod-sum
+   (implies (and (rationalp a)
+                 (rationalp b)
+                 )
+            (equal (mod (+ a (mod b n)) n)
+                   (mod (+ a b) n))))
+
+ (defthm mod-mod-sum
+   (implies (and (rationalp a)
+                 (rationalp b)
+                 )
+            (equal (mod (+ (mod a n) (mod b n)) n)
+                   (mod (+ a b) n))))
+;BOZO
+ (defthmd mod-bnd-2
+   (implies (and (<= 0 m)
+                 (case-split (rationalp m))
+                 )
+            (<= (mod m n) m))  
+   :rule-classes :linear)
+
+ )
+
+;BOZO make this into a better rewrite rule (and generalize)
+;this is sort of a cancellation rule
+;prove from my mod cancellation rules?
+(defthm mod-plus-mod-2
+  (implies (and (integerp a)
+                (integerp b))
+           (iff (= (mod (+ a b) 2) (mod a 2))
+                (= (mod b 2) 0)))
+  :rule-classes ())
+
+;bad name
+;The only multiple of N between 0 and 2N is N itself.
+(defthm mod-must-be-n
+    (implies (and (= (mod m n) 0)
+                  (< m (* 2 n))
+		  (< 0 m)
+                  (rationalp m);(integerp m)
+		  (rationalp n);(integerp n)
+		  )
+	     (= m n))
+  :rule-classes ())
+
+(defthm natp-compound-recognizer
+  (equal (natp x)
+         (and (integerp x) (<= 0 x)))
+  :rule-classes :compound-recognizer)
+
+;drop?
+(defthm natp-mod
+  (implies (and (natp m)
+                (natp n))
+           (natp (mod m n)))
+  :rule-classes ((:type-prescription :typed-term (mod m n))))
+           
+(defthm natp-mod-rewrite
+  (implies (and (natp m)
+                (natp n))
+           (natp (mod m n))))
+
+;BOZO kill ;gen?  make alt?
+;see mod-mult-eric
+(defthmd mod-mult
+    (implies (and (integerp a)
+                  (rationalp m)
+		  (rationalp n))
+	     (equal (mod (+ m (* a n)) n)
+		    (mod m n))))
+
+;gen?
+;essentially  mod-difference-elim-second
+(defthmd mod-diff
+    (implies (and (case-split (rationalp a))
+                  (case-split (rationalp b))
+                  )
+	     (equal (mod (- a (mod b n)) n)
+		    (mod (- a b) n))))
+
+
+;this doesn't seem to be used anywhere
+(defthmd mod-bnd-3
+    (implies (and (< m (+ (* a n) r))
+		  (<= (* a n) m)
+                  (integerp a)
+                  (case-split (rationalp m))
+		  (case-split (rationalp n))
+		  )
+	     (< (mod m n) r))
+  ;; Free variables make this rule very weak, but it seems harmless
+  ;; enough to make it a :linear rule.
+  :rule-classes :linear)
+
+(defthm mod-force
+  (implies (and (<= (* a n) m)
+                (< m (* (1+ a) n))
+                (integerp a)
+                (rationalp m)
+                (rationalp n)
+                )
+           (= (mod m n) (- m (* a n))))
+  :rule-classes nil)
+
+; If A and B are congruent mod N, then their difference is a multiple of N, and
+; conversely.
+
+(defthm mod-equal-int
+  (implies (and (= (mod a n) (mod b n))
+                (rationalp a)
+                (rationalp b))
+           (integerp (/ (- a b) n)))
+  :rule-classes ())
+
+(defthm mod-equal-int-reverse
+  (implies (and (integerp (/ (- a b) n))
+                (rationalp a)
+                (rationalp b)
+                (rationalp n)
+                (< 0 n))
+           (= (mod a n) (mod b n)))
+  :rule-classes ())
+
+(defthmd mod-mult-2
+  (implies (integerp a)
+           (equal (mod (* a n) n)
+                  0)))
+
+(defthmd mod-mult-2-alt
+  (implies (integerp a)
+           (equal (mod (* n a) n)
+                  0)))
+
+(defthmd mod-mult-n
+  (equal (mod (* a n) n)
+         (* n (mod a 1))))
+
+(defthmd mod-mult-n-commuted
+  (equal (mod (* n a) n)
+         (* n (mod a 1))))
+
+(defthm mod-0-int
+  (implies (and (integerp m)
+                (integerp n)
+                (not (= n 0)))
+           (iff (= (mod m n) 0)
+                (integerp (/ m n))))
+  :rule-classes ())
+
+(defthm mod-mult-2-gen
+  (equal (mod (* a n) n)
+         (* n (mod a 1))))
+
+(defthm mod-mult-2-alt-gen
+  (equal (mod (* n a) n)
+         (* n (mod a 1))))
+
+;rename params on these:
+
+;just a special case of mod-mult-2-alt
+;generalize?
+;; Rule A3 in fp.lisp suggests using (* 2 i) instead of
+;; (+ i i).
+(defthm mod-2*i
+  (implies (integerp i)
+           (equal (mod (* 2 i) 2)
+                  0)))
+
+;gen the 2?
+(defthm mod-2*m+1-rewrite
+  (implies (integerp m)
+           (equal (mod (1+ (* 2 m)) 2)
+                  1)))
+
+;eliminate this
+;in fact, it equals 1!
+(defthm mod-2*i+1
+  (implies (integerp i)
+           (not (equal (mod (1+ (* 2 i)) 2)
+                       0))))
+
+(defun INDUCT-NAT (x)
+  (if (and (integerp x)
+	   (> x 0))
+      (induct-nat (1- x))
+    ()))
+
+;BOZO move or drop?
+;try disabled
+(defthm nk>=k
+    (implies (and (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (not (= (* n k) 0)))
+	     (>= (abs (* n k)) k))
+  :rule-classes ())
+
+;BOZO gen?
+;not used anywhere but exported by lib/basic
+(defthm mod-force-equal
+  (implies (and (< (abs (- a b)) n)
+                (rationalp a) ;                  (natp a)
+                (rationalp b) ;(natp b)
+                (integerp n) ;(rationalp n) ;(natp n)
+                )
+           (iff (= (mod a n) (mod b n))
+                (= a b)))
+  :rule-classes ()
+  :hints (("goal" :use ( mod-equal-int
+                         (:instance nk>=k (k n) (n (/ (- a b) n)))
+;			(:instance *cancell (x a) (y b) (z n))
+                         ))))
+
+
+;yuck? BOZO used anywhere?
+(defthmd nk>=k-linear
+    (implies (and (integerp n)
+		  (integerp k)
+		  (not (= n 0)))
+	     (>= (abs (* n k)) k))
+  :rule-classes :linear)
+
+
+
+
+; BOZO add case-splits
+(defthm fl-mod
+  (implies (and (rationalp x)
+                (natp y)
+                )
+           (equal (fl (mod x y))
+                  (mod (fl x) y))))
+
+;BOZO a powerful rule!
+(defthmd mod-sum-cases
+  (implies (and (<= 0 y)
+                (rationalp x)
+                (rationalp y)
+                (rationalp k)
+                )
+           (equal (mod (+ k x) y)
+                  (if (< (+ (mod k y) (mod x y)) y)
+                      (+ (mod k y) (mod x y))
+                    (+ (mod k y) (mod x y) (* -1 y))))))
+
+(defthmd mod-fl-eric
+  (implies (and (<= 0 y)
+                (integerp y)
+                )
+           (equal (mod (fl x) y)
+                  (fl (mod x y)))))
+
+(defthm mod-squeeze
+  (implies (and (= (mod m n) 0)
+                (< m (* (1+ a) n))
+                (< (* (1- a) n) m)
+                (integerp a)
+                (integerp m)
+                (integerp n))
+           (= m (* a n)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/negative-syntaxp.lisp acl2-6.3/books/rtl/rel9/arithmetic/negative-syntaxp.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/negative-syntaxp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/negative-syntaxp.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,111 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+Briefly, negative-syntaxp recognizes terms which are "syntactically negative."  These are terms which could
+be simplified by multiplying them by -1.  For example, the term
+  (+ -1/2 (* -1 x))
+could be simplified by multiplying it by -1, yielding (with distributivity enabled) the term
+  (+ 1/2 x)
+. Often, a statement about a negative term can be simplified by rewriting it into a statement about the term's
+positive analogue.  For example, (integerp (* -1 x)) can be simplified to (integerp x), if x is an
+acl2-numberp.  However, a rule rewriting (integerp (* -1 x)) to (integerp x) is not general enough to catch all
+"negative" terms.  For example, the rule would not fire on (integerp (- x)).  negative-syntaxp provides a
+general and extensible facility for making such rules.
+
+Note that the notion of "syntactically negative" pays no attention to *values*. E.g., (- x) is "syntactically
+negative" regardless of the sign of the value of x.
+
+|#
+
+
+
+;This function operates on translated terms!
+;This function should be extended to recognize more terms.
+;do I need to test that binary-+ and binary-* have the right number of arguments?
+;Worry: What happens on (+ -2 b)
+(defun negative-syntaxp (term)
+  (if (not (consp term))
+      nil
+    (case (car term)
+      (quote (and (rationalp (cadr term)) 
+                  (< (cadr term) 0)))
+      (unary-- (not (negative-syntaxp (cadr term))))  ;perhaps we should use "positive-syntaxp" here...
+      (binary-+ (and ;(equal (length term) 3) ;ok since binary-+ should always have 2 args
+                 (negative-syntaxp (cadr term))
+                 (negative-syntaxp (caddr term))))
+      (binary-* (and ;(equal (length term) 3)
+                 (or (and (negative-syntaxp (cadr term))
+                          (not (negative-syntaxp (caddr term))))
+                     (and (not (negative-syntaxp (cadr term)))
+                          (negative-syntaxp (caddr term))))))
+      (otherwise nil))))
+
+
+#|
+
+The following terms are "negative":
+ negative constants
+ (- x)
+ (* -1 x)
+ (* -5/7 x)
+ (/ (- a)) - how do we simp this? - not currently handled...
+ (+ -1/2 (* -1/2 x))
+ the sum of two (or more) negative terms
+
+
+neg
+ negative numeric constants
+ (- <non-neg>)
+ a product with an odd number of negative factors
+ a sum of two or more negative terms
+
+pos
+ positive numeric constants
+ variables
+ function calls other than +,*
+ a product with an even number of negative factors
+ a sum of two or more positive terms?
+
+It might be nice to someday decide how to handle a mixed sum.  For example, we might prefer 
+  (integerp (+ 2 (* -1 x) y))
+to
+  (integerp (+ -1 x (* -1 y)) 
+since the former has one fewer negated addend.  And, when exactly half the terms are negated, we might prefer 
+  (integerp (+ x (* -1 y)))
+to
+  (integerp (+ (* -1 x) y))
+since the latter has the negation around the "smaller" term.  Or something like that. 
+
+
+so that the rules don't loop, we must ensure that a negative term * -1 is not negative
+
+
+|#
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/nniq.lisp acl2-6.3/books/rtl/rel9/arithmetic/nniq.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/nniq.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/nniq.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,626 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "ground-zero")
+(local (include-book "fp2"))
+(local (include-book "denominator"))
+(local (include-book "numerator"))
+(local (include-book "predicate"))
+(local (include-book "unary-divide"))
+(local (include-book "product"))
+(local (include-book "integerp"))
+(local (include-book "arith"))
+
+;lemmas if non-rat args?
+
+(defthm nonnegative-integer-quotient-with-a-non-integer-arg
+  (implies (not (integerp i))
+           (equal (nonnegative-integer-quotient i j)
+                  0))
+  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
+
+(defthm nonnegative-integer-quotient-with-a-non-integer-arg-2
+  (implies (not (integerp j))
+           (equal (nonnegative-integer-quotient i j)
+                  0))
+  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
+
+(defthm nonnegative-integer-quotient-with-a-non-positive-arg
+  (implies (<= i 0)
+           (equal (nonnegative-integer-quotient i j)
+                  0))
+  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
+
+(defthm nonnegative-integer-quotient-with-a-non-positive-arg-2
+  (implies (<= j 0)
+           (equal (nonnegative-integer-quotient i j)
+                  0))
+    :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
+
+;like doc's floor-m+1-3?
+(defthm nonnegative-integer-quotient-upper-bound-rewrite
+  (implies (and (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                (case-split (rationalp j))
+                )
+           (<= (nonnegative-integer-quotient i j) (/ i j)))
+  :hints (("Goal" :cases ((rationalp i)
+                          )
+           :in-theory (enable nonnegative-integer-quotient))))
+
+;BOZO strict < when quotient isn't an integer
+(defthm nonnegative-integer-quotient-upper-bound-linear
+  (implies (and (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                (case-split (rationalp j))
+                )
+           (<= (nonnegative-integer-quotient i j) (/ i j)))
+  :rule-classes ((:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
+
+#|
+(defthm nonnegative-integer-quotient-upper-bound-linear-strict
+  (implies (and (not (integerp (NOT (INTEGERP (* I (/ J)))))) ;allows the strict bound
+                (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                (case-split (rationalp j))
+                )
+           (< (nonnegative-integer-quotient i j) (/ i j)))
+  :hints (("Goal" :use  nonnegative-integer-quotient-upper-bound-linear
+           ))
+  :rule-classes ((:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
+|#
+
+
+#|
+;what should the trigger terms be?
+(defthm nonnegative-integer-quotient-upper-bound-2
+  (implies (and (case-split (<= 0 i))
+                (case-split (<= 0 j))
+;                (case-split (rationalp i))
+                (case-split (rationalp j))
+                )
+           (<= (* j (nonnegative-integer-quotient i j)) i))
+  :hints (("Goal" :cases ((rationalp i))
+           :in-theory (enable nonnegative-integer-quotient)))
+  :rule-classes (:rewrite (:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
+|#
+
+#|
+(defthm nonnegative-integer-quotient-upper-bound-3
+  (implies (and (case-split (<= 0 i))
+                (case-split (<= 0 j))
+;                (case-split (rationalp i))
+                (case-split (rationalp j))
+                )
+           (<= (* j (nonnegative-integer-quotient i j)) i))
+  :hints (("Goal" :cases ((rationalp i))
+           :in-theory (enable nonnegative-integer-quotient)))
+  :rule-classes (:rewrite (:linear :trigger-terms ((* j (nonnegative-integer-quotient i j))))))
+|#
+
+;rewrite nniq to (/ i j) when quotient is known integer?
+(defthm nonnegative-integer-quotient-max-value-rewrite
+  (implies (and (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (equal (nonnegative-integer-quotient i j) (/ i j))
+                  (integerp (/ i j))))
+  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
+
+(defthm nonnegative-integer-quotient-lower-bound-rewrite
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                )
+           (< (+ -1 (/ i j)) (nonnegative-integer-quotient i j)))
+  :hints (("Goal" :in-theory (enable nonnegative-integer-quotient))))
+
+(defthm nonnegative-integer-quotient-lower-bound-linear
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                )
+           (< (+ -1 (/ i j)) (nonnegative-integer-quotient i j)))
+  :rule-classes ((:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
+
+#|
+;what should the trigger terms be?
+(defthm nonnegative-integer-quotient-lower-bound-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                (case-split (not (equal 0 j)))
+                )
+           (< (+ i (* -1 j)) (* j (nonnegative-integer-quotient i j))))
+  :hints (("Goal" :in-theory (disable  nonnegative-integer-quotient-lower-bound)
+           :use  nonnegative-integer-quotient-lower-bound))
+  :rule-classes (:rewrite (:linear :trigger-terms ((nonnegative-integer-quotient i j)))))
+|#
+
+#|
+(defthm nonnegative-integer-quotient-lower-bound-3
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                (case-split (not (equal 0 j)))
+                )
+           (< (+ i (* -1 j)) (* j (nonnegative-integer-quotient i j))))
+  :hints (("Goal" :in-theory (disable  nonnegative-integer-quotient-lower-bound)
+           :use  nonnegative-integer-quotient-lower-bound))
+  :rule-classes (:rewrite (:linear :trigger-terms ((* j (nonnegative-integer-quotient i j))))))
+
+|#
+
+#|
+
+         (<= (* J
+                (NONNEGATIVE-INTEGER-QUOTIENT (NUMERATOR (* I (/ J)))
+                                              (DENOMINATOR (* I (/ J)))))
+             I)
+
+|#
+
+
+(defthm nonnegative-integer-quotient-upper-bound-linear-stronger
+  (implies (and (case-split (<= 0 i))
+                (case-split (<= 0 j))
+                (NOT (INTEGERP (* I (/ J))))
+                (case-split (acl2-numberp i))
+                (case-split (rationalp j))
+                (case-split (rationalp k))
+                (case-split (< 0 k))
+                )
+           (< (* k (nonnegative-integer-quotient i j)) (* k (/ i j))))
+  :hints (("Goal" :cases ((rationalp i))
+           :in-theory (enable nonnegative-integer-quotient)))
+  :rule-classes ((:linear :trigger-terms ((* k (nonnegative-integer-quotient i j))
+                                          ))))
+
+
+#|
+;was this ever proved?
+(defthm nonnegative-integer-quotient-upper-bound-linear-stronger
+   (implies (and (case-split (<= 0 i))
+                 (case-split (<= 0 j))
+                 (NOT (INTEGERP (* I (/ J))))
+                 (case-split (acl2-numberp i))
+                 (case-split (rationalp j))
+                 (case-split (rationalp k))
+                 (case-split (< 0 k))
+                 )
+            (< (* k (nonnegative-integer-quotient i j)) (* k (/ i j))))
+   :hints (("Goal" :cases ((rationalp i))
+            :in-theory (enable nonnegative-integer-quotient)))
+   :rule-classes ((:linear :trigger-terms ((* k (nonnegative-integer-quotient i j))))))
+
+
+
+|#
+
+(defthm nonnegative-integer-quotient-when-j-is-0
+  (equal (nonnegative-integer-quotient i 0)
+         0))
+
+
+;gen?
+(encapsulate ()
+              (local (defthm nniq-no-rounding-to-do-all-but-j=0
+                       (implies (and (integerp (* i (/ j)))
+                                     (integerp i)
+                                     (>= i 0)
+                                     (integerp j)
+                                     (> j 0)
+                                     )
+                                (equal (nonnegative-integer-quotient i j)
+                                       (/ i j)))))
+
+              (defthm nniq-no-rounding-to-do
+                       (implies (and (integerp (* i (/ j)))
+                                     (case-split (integerp i))
+                                     (case-split (<= 0 i))
+                                     (case-split (integerp j))
+                                     (case-split (<= 0 j))
+                                     )
+                                (equal (nonnegative-integer-quotient i j)
+                                       (/ i j)))))
+
+;begin stuff from elib27/rel2/nniq
+;i haven't organized the stuff below
+
+;move!
+;if the denom of a fraction is 1, the numerator is the whole fraction!
+(defthm denom-1-means-num-is-all
+  (implies (and (rationalp x)
+                (equal (denominator x) 1))
+           (equal (numerator x)
+                  x))
+  :hints (("Goal" :in-theory (disable rational-implies2)
+           :use rational-implies2)))
+
+(defthm nonnegative-integer-quotient-by-1
+  (implies (and
+            (integerp x)
+            (<= 0 x))
+           (equal (nonnegative-integer-quotient x 1)
+                  x)))
+#|
+;drop?
+;will backchain on (integerp x)!
+(defthm integer-has-denom-1-other-way
+  (implies (and
+            (rationalp x) ;acl2-numberp?
+            (equal (denominator x) 1))
+           (integerp x))
+   :hints (("Goal" :in-theory (disable rational-implies2)
+           :use (rational-implies2
+                 (:instance Lowest-terms 
+                           (n (denominator x))
+                           (r x) 
+                           (q 1))))))
+|#
+
+
+
+(defthm division-by-zero-yields-zero
+  (equal (/ m 0)
+         0))
+
+;expensive?
+(defthm fraction-less-than-1
+  (IMPLIES (AND (< (abs M) (abs N))
+                (rationalp m)
+                (rationalp n))
+           (<= (* m (/ n)) 1))
+  :hints (("Goal" :cases ((> n 0) (= n 0)))))
+
+(defthm nniq-int
+  (implies (and (integerp x)
+                (case-split (<= 0 x))
+                )
+           (equal (nonnegative-integer-quotient (numerator x)
+                                                (denominator x))
+                  x)))
+
+
+
+(encapsulate ()
+             (local (include-book "../../../arithmetic/rationals"))
+             (local (include-book "../../../arithmetic/idiv"))
+
+             (defthm quotient-numer-denom
+               (implies (and (integerp x) (< 0 x) (integerp y) (< 0 y))
+                        (equal (nonnegative-integer-quotient (numerator (/ x y))
+                                                             (denominator (/ x y)))
+                               (nonnegative-integer-quotient x y)))) 
+
+             (defthm 
+               Numerator-minus
+               (equal (numerator (- i))
+                      (- (numerator i))))
+
+             (defthm
+               Denominator-unary-minus
+               (implies (rationalp x)
+                        (equal (denominator (- x))
+                               (denominator x))))
+
+             (defthm 
+               Denominator-plus
+               (implies (and (rationalp r)
+                             (integerp i))
+                        (equal (denominator (+ i r))
+                               (denominator r))))
+             (defthm 
+               Denominator-plus-2
+               (implies (and (rationalp r)
+                             (integerp i))
+                        (equal (denominator (+ r i))
+                               (denominator r))))
+
+;add to arith books?
+             (defthm numerator-plus
+               (implies (and (rationalp x)
+                             (integerp i))
+                        (equal (numerator (+ x i))
+                               (+ (* i (denominator x)) (numerator x))))
+               :hints (("Goal" :in-theory (disable rational-implies2)
+                        :use (:instance rational-implies2 (x (+ x i)))))))
+
+(defthm numerator-plus-alt
+  (implies (and (rationalp x)
+                (integerp i))
+           (equal (numerator (+ i x))
+                  (+ (* i (denominator x)) (numerator x))))
+  :hints (("Goal" :in-theory (disable numerator-plus)
+           :use (:instance numerator-plus))))
+
+(defthm Numerator-minus-eric
+  (equal (numerator (* -1 i))
+         (* -1 (numerator i)))
+  :hints (("Goal" :in-theory (disable Numerator-minus) 
+           :use Numerator-minus)))
+
+(defthm Denominator-unary-minus-eric
+  (implies (rationalp x)
+           (equal (denominator (* -1 x))
+                  (denominator x)))
+  :hints (("Goal" :in-theory (disable Denominator-unary-minus) 
+           :use Denominator-unary-minus)))
+
+
+
+(encapsulate ()
+              (local (defthm NONNEGATIVE-INTEGER-QUOTIENT-sum-on-top
+                       (implies (and (integerp x)
+                                     (>= x 0)
+                                     (integerp y)
+                                     (> y 0)
+                                     )
+                                (equal (NONNEGATIVE-INTEGER-QUOTIENT (+ x y) y)
+                                       (+ 1 (NONNEGATIVE-INTEGER-QUOTIENT x y))))))
+
+              (local (defun nniq-induct (x y a)
+                       (if (zp a)
+                           1
+                         (* x y (nniq-induct x y (- a 1))))))
+
+              (local (DEFTHM NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-GEN
+                       (IMPLIES (AND (INTEGERP X)
+                                     (>= X 0)
+                                     (INTEGERP A)
+                                     (INTEGERP Y)
+                                     (> Y 0)
+                                     (>= A 0)
+                                     )
+                                (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (+ X (* A Y))
+                                                                     Y)
+                                       (+ A (NONNEGATIVE-INTEGER-QUOTIENT X Y))))
+                       :HINTS
+                       (("subgoal *1/2" :IN-THEORY (DISABLE NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP)
+                         :USE
+                         ((:INSTANCE NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP
+                                     (X (+ X (* (- A 1) Y))))))
+                        ("Goal" :DO-NOT '(GENERALIZE)
+                         :INDUCT (NNIQ-INDUCT X Y A)))))
+
+              (local (defthm NONNEGATIVE-INTEGER-QUOTIENT-sum-on-top-back
+                       (implies (and (integerp x)
+                                     (>= x 0)
+                                     (integerp y)
+                                     (> y 0)
+                                     (>= (+ x (- y)) 0)
+                                     )
+                                (equal (NONNEGATIVE-INTEGER-QUOTIENT (+ x (* -1 y)) y)
+                                       (+ -1 (NONNEGATIVE-INTEGER-QUOTIENT x y))))))
+
+              (local (defun nniq-induct-2 (x y a)
+                       (if (or (not (integerp a)) (>= a 0))
+                           1
+                         (* x y (nniq-induct-2 x y (+ a 1))))))
+
+
+
+              (local (DEFTHM NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-GEN-back
+                       (IMPLIES (AND (INTEGERP X)
+                                     (>= X 0)
+                                     (INTEGERP A)
+                                     (INTEGERP Y)
+                                     (> Y 0)
+                                     (< A 0)
+                                     (<= 0 (+ x (* a y)))
+                                     )
+                                (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (+ X (* A Y))
+                                                                     Y)
+                                       (+ A (NONNEGATIVE-INTEGER-QUOTIENT X Y))))
+                       :otf-flg t
+                       :HINTS
+                       (("subgoal *1/" :IN-THEORY (DISABLE NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-back)
+                         :USE
+                         ((:INSTANCE NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-back
+                                     (X (+ X (* (+ A 1) Y))))))
+                        ("Goal" :DO-NOT '(GENERALIZE)
+                         :INDUCT (NNIQ-INDUCT-2 X Y A)))))
+
+              (DEFTHM NONNEGATIVE-INTEGER-QUOTIENT-SUM-ON-TOP-GEN-both-cases
+                (IMPLIES (AND (INTEGERP X)
+                              (>= X 0)
+                              (INTEGERP A)
+                              (INTEGERP j)
+                              (> j 0)
+                              (<= 0 (+ x (* a j))) ;drop?
+                              )
+                         (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (+ X (* A j)) j)
+                                (+ A (NONNEGATIVE-INTEGER-QUOTIENT X j))))
+                :hints (("Goal" :cases ((>= a 0))))))
+
+;(in-theory (disable NONNEGATIVE-INTEGER-QUOTIENT-sum-on-top))
+
+
+
+(encapsulate ()
+             (local (include-book "../../../arithmetic/idiv"))
+             (local (INCLUDE-BOOK "../../../arithmetic/top-with-meta"))
+
+             (defthm nniq-eric-1
+               (implies (and (rationalp x)
+                             (not (integerp x)))
+                        (> (+ 1 (nonnegative-integer-quotient (numerator x) (denominator x))) ;the ceiling of x
+                           x))
+               :hints (("Goal" :in-theory (disable QUOTIENT-UPPER-BOUND
+                                                   NONNEGATIVE-INTEGER-QUOTIENT)
+                        :use (:instance QUOTIENT-UPPER-BOUND (x (numerator x)) (y (denominator x))))))
+             )
+
+
+;this sequence is used for nniq-lower-bound-non-integer-case
+(defthm nniq-eric-2
+  (implies (and (rationalp x)
+                (not (integerp x)))
+           (> (+ (denominator x) (* (denominator x) (nonnegative-integer-quotient (numerator x) (denominator x))))
+              (numerator x)))
+  :hints (("Goal" :in-theory  (disable nniq-eric-1 RATIONAL-IMPLIES2)
+           :use  (nniq-eric-1 RATIONAL-IMPLIES2))))
+
+
+(defthm nniq-eric-3
+  (implies (and (rationalp x)
+                (not (integerp x)))
+           (>= (+ (denominator x) (* (denominator x) (nonnegative-integer-quotient (numerator x) (denominator x))))
+              (+ 1 (numerator x))))
+  :hints (("Goal" :in-theory  (disable nniq-eric-2)
+           :use  (nniq-eric-2))))
+
+
+(defthm nniq-eric-4
+  (implies (and (rationalp x)
+                (not (integerp x)))
+           (>= (+ 1 (nonnegative-integer-quotient (numerator x) (denominator x)))
+               (+ (/ (numerator x) (denominator x)) (/ (denominator x)))))
+  :hints (("Goal" :in-theory  (disable nniq-eric-3 RATIONAL-IMPLIES2)
+           :use  (nniq-eric-3))))
+
+(defthm nniq-lower-bound-non-integer-case
+  (implies (and (rationalp x)
+                (not (integerp x)))
+           (>= (+ 1 (nonnegative-integer-quotient (numerator x) (denominator x)))
+               (+ x (/ (denominator x)))))
+  :hints (("Goal" :in-theory  (disable NNIQ-ERIC-3 nniq-eric-4)
+           :use  (nniq-eric-4))))
+
+
+(in-theory (disable  nniq-eric-1  nniq-eric-2  nniq-eric-3  nniq-eric-4))
+
+
+
+(defthm nniq-eric-5
+  (implies (and (integerp p)
+                (integerp q)
+                (not (integerp (/ p q)))
+                (< 0 p)
+                (< 0 q))
+           (< (nonnegative-integer-quotient p q)
+              (/ p q)))
+  :hints (("Goal" :in-theory  (disable nniq-eric-1 RATIONAL-IMPLIES2)
+           :use  (nniq-eric-1 RATIONAL-IMPLIES2))))
+
+
+(defthm nniq-eric-6
+  (implies (and (integerp p)
+                (integerp q)
+                (not (integerp (/ p q)))
+                (< 0 p)
+                (< 0 q))
+           (< (* q (nonnegative-integer-quotient p q))
+              p))
+  :hints (("Goal" :in-theory  (disable nonnegative-integer-quotient nniq-eric-5)
+           :use  (nniq-eric-5))))
+
+(defthm nniq-eric-7
+  (implies (and (integerp p)
+                (integerp q)
+                (not (integerp (/ p q)))
+                (< 0 p)
+                (< 0 q))
+           (<= (+ 1 (* q (nonnegative-integer-quotient p q)))
+              p))
+  :hints (("Goal" :in-theory  (disable nonnegative-integer-quotient nniq-eric-6)
+           :use  (nniq-eric-6))))
+
+
+(defthm nniq-eric-8
+  (implies (and (integerp p)
+                (integerp q)
+                (not (integerp (/ p q)))
+                (< 0 p)
+                (< 0 q))
+           (<= (+ (/ q) (nonnegative-integer-quotient p q))
+               (/ p q)))
+  :hints (("Goal" :in-theory  (disable nonnegative-integer-quotient nniq-eric-7)
+           :use  (nniq-eric-7))))
+
+(in-theory (disable  nniq-eric-5 nniq-eric-6 nniq-eric-7 nniq-eric-8))
+
+
+
+
+
+
+
+
+#|
+;too hard?
+(DEFTHM NONNEGATIVE-INTEGER-QUOTIENT-split-sum-case-1
+  (IMPLIES (AND (INTEGERP i1)
+                (> i1 0)
+                (INTEGERP i2)
+                (> i2 0)
+                (INTEGERP j)
+                (> j 0)
+                (< (+ (mod i1 j)
+                      (mod i2 j)) j)
+                )
+           (EQUAL (NONNEGATIVE-INTEGER-QUOTIENT (+ i1 i2)
+                                                j)
+                  (+  (NONNEGATIVE-INTEGER-QUOTIENT i1 j)
+                      (NONNEGATIVE-INTEGER-QUOTIENT i2 j))))
+
+
+)
+
+
+
+
+
+
+
+
+
+
+;integers
+;nniq of x+a*y and y is nniq of x and y, + a
+
+
+
+i/j = (nniq i j) + (mod/rem i j)  
+
+
+
+
+
+
+
+
+
+
+
+
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/numerator.lisp acl2-6.3/books/rtl/rel9/arithmetic/numerator.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/numerator.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/numerator.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,104 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;ass also some stuff in nniq.lisp
+
+(local (include-book "ground-zero"))
+(local (include-book "fp2"))
+(local (include-book "denominator")) ;drop?
+(local (include-book "predicate"))
+
+(defthm numerator-of-non-rational-is-zero
+  (implies (not (rationalp x))
+           (equal (numerator x)
+                  0)))
+
+
+;;
+;; type-prescriptions
+;;
+
+;(thm (integerp (numerator x))) goes through
+
+(defthm numerator-negative-integer-type-prescription
+  (implies (and (< x 0)
+                (case-split (rationalp x)))
+           (and (< (numerator x) 0)
+                (integerp (numerator x))))
+  :rule-classes (:type-prescription))
+
+(defthm numerator-positive-integer-type-prescription
+  (implies (and (< 0 x)
+                (case-split (rationalp x)))
+           (and (< 0 (numerator x))
+                (integerp (numerator x))))
+  :rule-classes (:type-prescription))
+           
+(defthm numerator-non-positive-integer-type-prescription
+  (implies (<= x 0)
+           (and (<= (numerator x) 0)
+                (integerp (numerator x))))
+  :rule-classes (:type-prescription))
+
+(defthm numerator-non-negative-integer-type-prescription
+  (implies (<= 0 x)
+           (and (<= 0 (numerator x))
+                (integerp (numerator x))))
+  :rule-classes (:type-prescription))
+
+;;
+;; comparisons with zero
+;;
+
+
+(defthm numerator-less-than-zero
+  (implies (case-split (rationalp x))
+           (equal (< (numerator x) 0)
+                  (< x 0)))
+   :hints (("goal" :in-theory (disable rational-implies2)
+           :use (rational-implies2))))
+
+(defthm numerator-greater-than-zero
+  (implies (case-split (rationalp x))
+           (equal (< 0 (numerator x))
+                  (< 0 x)))
+   :hints (("goal" :in-theory (disable rational-implies2)
+           :use (rational-implies2))))
+
+(defthm numerator-equal-zero
+  (implies (case-split (rationalp x))
+           (equal (equal (numerator x) 0)
+                  (equal x 0))))
+
+
+;;
+
+(defthm numerator-of-integer-is-the-integer-itself
+  (implies (integerp x)
+           (equal (numerator x)
+                  x))
+   :hints (("Goal" :in-theory (disable rational-implies2)
+           :use (rational-implies2))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/power2p.lisp acl2-6.3/books/rtl/rel9/arithmetic/power2p.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/power2p.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/power2p.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,190 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;The rule power2p-rewrite has proven quite helpful.
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(local (include-book "fl")) ;or could use floor?
+(local (include-book "fp2"))
+(local (include-book "predicate"))
+(local (include-book "unary-divide"))
+
+;old version
+;(defun power2p (x)
+ ; (equal x (expt 2 (expo x))))
+
+(include-book "../../../ordinals/e0-ordinal")
+(set-well-founded-relation e0-ord-<)
+
+(defund power2p-measure (x)
+  (declare (xargs :guard (and (rationalp x) (not (equal x 0)))))
+  (cond ((or (not (rationalp x))
+             (<= x 0)) 0)
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund power2p (x)
+  (declare (xargs :guard t
+                  :measure (power2p-measure x)
+                  :hints (("goal" :in-theory (enable power2p-measure)))))
+  (cond ((or (not (rationalp x))
+             (<= x 0))
+         nil)
+        ((< x 1) (power2p (* 2 x)))
+        ((<= 2 x) (power2p (* 1/2 x)))
+        ((equal x 1) t)
+        (t nil) ;got a number in the doubly-open interval (1,2)
+        ))
+
+#| A term fits the "power of 2" pattern iff it is a tree built using * and /  (actually, binary-* and unary-/)
+in which each leaf is either a rational constant which is a power of 2 or a term of the form (EXPT 2 I).
+|#
+
+(defund power2-syntaxp (term)
+  (if (not (consp term))
+      nil
+    (case (car term)
+      (quote (and (rationalp (cadr term)) 
+                  (power2p (cadr term))))
+      (expt (equal (cadr term) '(quote 2))) ;allow the base to be any power of 2?  (constants only? or (expt 2 n)??
+      (binary-* (and (power2-syntaxp (cadr term))
+                     (power2-syntaxp (caddr term))))
+      (unary-/ (power2-syntaxp (cadr term)))
+      (otherwise nil))))
+
+#|
+
+Notes:
+
+(power2-syntaxp ''2)
+(power2-syntaxp '(expt 2 i))
+(power2-syntaxp '(unary-/ (expt 2 i)))
+(power2-syntaxp '(binary-/ (expt 2 i) (expt 2 j)))
+(power2-syntaxp '(binary-* (expt 2 i) (expt 2 j)))
+(power2-syntaxp '(binary-* '2 (binary-* (expt '2 j) (expt '2 k))))
+(power2-syntaxp '(binary-* '2 (binary-* (expt '2 j) (expt '2 (binary-+ k (binary-* '-1 j))))))
+
+|#
+
+
+;induction?
+(defthmd power2p-with-arg-between-one-and-two
+  (implies (and (< 1/2 x)
+                (< x 1)
+                )
+           (not (power2p x)))
+  :hints (("goal" :in-theory  (enable power2p)))
+  )
+
+(defthm power2p-of-non-rational
+  (implies (not (rationalp x))
+           (equal (power2p x)
+                  nil))
+  :hints (("goal" :in-theory (enable power2p))))
+
+(defthm power2p-of-non-positive
+  (implies (not (< 0 x))
+           (equal (power2p x)
+                  nil))
+  :hints (("goal" :in-theory (enable power2p))))
+
+;induction
+(defthm power2p-inverse
+  (and (equal (power2p (/ x))
+              (power2p x))
+       (equal (power2p (/ 1 x)) ;do we need this?
+              (power2p x)))
+  :otf-flg t
+  :hints (("goal" :in-theory (enable power2p
+                                     power2p-with-arg-between-one-and-two))))
+
+;what about (/ -1 x) ? (/ 1 (- x)) ?
+;in general, what if x is negative, and we have something like (power2p (- x)) ?
+
+;power2p-double and power2p-half helped clean up the proof of power2p-prod
+(defthmd power2p-double
+  (equal (power2p (* 2 x))
+         (power2p x))
+  :hints (("goal" :in-theory (enable power2p
+                                     power2p-with-arg-between-one-and-two))))
+
+(defthmd power2p-half
+  (equal (power2p (* 1/2 x))
+         (power2p x))
+  :hints (("goal" :in-theory (enable power2p
+                                     power2p-with-arg-between-one-and-two))))
+;consider enabling?
+(defthmd power2p-prod
+  (implies (and (power2p x)
+                (power2p y))
+           (power2p (* x y)))
+  :hints (("goal" :in-theory (enable power2p power2p-double power2p-half
+                                     power2p-with-arg-between-one-and-two))))
+
+;robustify with power2p-quotient?
+
+;reorder hyps?  make conclusion into an equality?
+(defthmd power2p-prod-not
+  (implies (and (not (power2p x))
+                (power2p y)
+                )
+           (not (power2p (* x y))))
+   :hints (("goal" :in-theory (disable power2p-prod)
+            :use (:instance power2p-prod (x (* x y)) (y (/ y))))))
+
+(defthm power2p-shift
+  (implies (and (syntaxp (power2-syntaxp x))
+                (force (power2p x)) ;this should be true if the syntaxp hyp is satisfied
+                )
+           (equal (power2p (* x y))
+                  (power2p y)))
+  :hints (("goal"
+           :use ((:instance power2p-prod-not (y x) (x y))
+                 (:instance power2p-prod (y x) (x y))))))
+
+(defthm power2p-shift-2
+  (implies (and (syntaxp (power2-syntaxp y))
+                (force (power2p y)) ;this should be true if the syntaxp hyp is satisfied
+                )
+           (equal (power2p (* x y))
+                  (power2p x)))
+  :hints (("goal" :in-theory (disable power2p)
+           :use ( power2p-prod-not power2p-prod))))
+
+
+;make rules for quotient of powers of 2
+
+
+(defthm power2p-means-positive-rationalp
+  (implies (power2p x)
+           (and (< 0 x)
+                (rationalp x)))
+  :rule-classes ((:forward-chaining :trigger-terms ((POWER2P X)))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/predicate.lisp acl2-6.3/books/rtl/rel9/arithmetic/predicate.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/predicate.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/predicate.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,49 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;Rewrites an equality of two "predicates" to, essentially, an iff.  This can save you from having to do two
+;proofs, one for each of the forward and back directions.
+
+;Feel free to add more predicates to this list as time goes on.
+(defun predicatep (term)
+  (and (consp term) ;drop this test?
+       (member (car term) '(< integerp power2p complex-rationalp rationalp bvecp))))
+
+;This can cause case-splits, but that's sort of the point.
+;We could actually rewrite to iff instead of the and of the implies...
+(defthm equal-of-preds-rewrite
+  (implies (and (syntaxp (and (predicatep a)
+                              (predicatep b)))
+                (case-split (booleanp a)) ;or force?
+                (case-split (booleanp b)) ;or force?
+                )
+           (equal (equal a b)
+                  (and (implies a b)
+                       (implies b a)))))
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/product-proofs.lisp acl2-6.3/books/rtl/rel9/arithmetic/product-proofs.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/product-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/product-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,137 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;These rules may cause case splits, but that's sort of the point.
+
+(local (include-book "predicate"))
+(local (include-book "fp2"))
+
+(local (defthm hack2
+         (implies
+          (and (< y 0)
+               (rationalp x)
+               (case-split (< x 0))
+               )
+          (<= 0 (* x y)))
+       ))
+
+;BOZO instead of having 2 rules below, consider putting an OR inside the CASE-SPLIT
+;make these 2 nicer? ;do we need both?
+
+
+#| the conclusion of product-less-than-zero used to be this, which didn't mention acl2-numberp of x...
+                  (or (and (< x 0) (< 0 y))
+                      (and (< y 0) (< 0 x)))
+|#
+
+(defthm product-less-than-zero-1
+  (implies (case-split (not (complex-rationalp x))) ;can't gen: (* #C(-1 9) #C(-1 9))=#c(-80 -18)
+           (equal (< (* x y) 0)
+                  (if (< x 0)
+                      (< 0 y)
+                    (if (equal 0 x)
+                        nil
+                      (if (not (acl2-numberp x))
+                          nil
+                        (< y 0))))))
+  :otf-flg t
+  :hints (("Goal" :cases ((and (rationalp x) (rationalp y))
+                          (and (complex-rationalp x) (rationalp y))
+                          (and (not (acl2-numberp x)) (rationalp y))
+                          (and (rationalp x) (complex-rationalp y))
+                          (and (complex-rationalp x) (complex-rationalp y))
+                          (and (not (acl2-numberp x)) (complex-rationalp y))
+                          ))))
+
+(defthm product-less-than-zero-2
+  (implies (case-split (not (complex-rationalp y))) ;(case-split (rationalp y))
+           (equal (< (* x y) 0)
+                  (or (and (< x 0) (< 0 y))
+                      (and (< y 0) (< 0 x)))))
+  :hints (("Goal" :in-theory (disable product-less-than-zero-1)
+           :use (:instance  product-less-than-zero-1 (x y) (y x)))))
+
+(defthm product-less-than-zero
+  (implies (case-split (or (not (complex-rationalp x))
+                           (not (complex-rationalp y)))) ;can't gen: (* #C(-1 9) #C(-1 9))=#c(-80 -18)
+           (equal (< (* x y) 0)
+                  (if (< x 0)
+                      (< 0 y)
+                    (if (equal 0 x)
+                        nil
+                      (if (not (acl2-numberp x))
+                          nil
+                        (< y 0)))))))
+
+
+;combine the next twp by case-splittin on an OR?
+(defthm product-greater-than-zero
+  (implies (case-split (not (complex-rationalp y)))
+           (equal (< 0 (* x y))
+                  (or (and (< 0 x) (< 0 y))
+                      (and (< y 0) (< x 0)))))
+  :hints (("Goal" :cases (complex-rationalp x))))
+
+(defthm product-greater-than-zero-2
+  (implies (case-split (not (complex-rationalp x)))
+           (equal (< 0 (* x y))
+                  (or (and (< 0 x) (< 0 y))
+                      (and (< y 0) (< x 0)))))
+  :hints (("Goal" :in-theory (disable product-greater-than-zero)
+           :use (:instance  product-greater-than-zero (x y) (y x)))))
+
+;could write the conclusion using an OR...
+(defthm product-equal-zero
+  (equal (equal 0 (* x y))
+         (if (not (acl2-numberp x))
+             t
+           (if (not (acl2-numberp y))
+               t
+             (if (equal 0 x)
+                 t
+               (equal 0 y)))))
+  :hints (("Goal" :cases (complex-rationalp x))))
+
+
+#|
+;product-equal-zero is better?
+(defthm equal-zero-product
+  (implies (and (not (equal 0 x))
+                (case-split (acl2-numberp x))
+                (case-split (acl2-numberp y))
+                )
+           (equal (equal 0 (* x y))
+                  (equal 0 y))))
+
+;product-equal-zero is better?
+(defthm equal-zero-product-2
+  (implies (and (case-split (acl2-numberp x))
+                (case-split (acl2-numberp y))
+                (case-split (not (equal 0 x)))
+                )
+           (equal (equal 0 (* y x))
+                  (equal 0 y))))
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/product.lisp acl2-6.3/books/rtl/rel9/arithmetic/product.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/product.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/product.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,87 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;These rules may cause case splits, but that's sort of the point.
+
+(local (include-book "product-proofs"))
+
+(defthm product-less-than-zero
+  (implies (case-split (or (not (complex-rationalp x))
+                           (not (complex-rationalp y)))) ;can't gen: (* #C(-1 9) #C(-1 9))=#c(-80 -18)
+           (equal (< (* x y) 0)
+                  (if (< x 0)
+                      (< 0 y)
+                    (if (equal 0 x)
+                        nil
+                      (if (not (acl2-numberp x))
+                          nil
+                        (< y 0)))))))
+
+
+#|
+(defthm product-less-than-zero
+  (implies (case-split (not (complex-rationalp x))) ;can't gen: (* #C(-1 9) #C(-1 9))=#c(-80 -18)
+           (equal (< (* x y) 0)
+                  (if (< x 0)
+                      (< 0 y)
+                    (if (equal 0 x)
+                        nil
+                      (if (not (acl2-numberp x))
+                          nil
+                        (< y 0)))))))
+
+;this use hint shouldn't be needed
+(defthm product-less-than-zero-2
+  (implies (case-split (not (complex-rationalp y))) ;(case-split (rationalp y))
+           (equal (< (* x y) 0)
+                  (or (and (< x 0) (< 0 y))
+                      (and (< y 0) (< 0 x))))))
+|#
+
+;combine the next two by case-splittin on an OR?
+(defthm product-greater-than-zero
+  (implies (case-split (not (complex-rationalp y)))
+           (equal (< 0 (* x y))
+                  (or (and (< 0 x) (< 0 y))
+                      (and (< y 0) (< x 0))))))
+
+(defthm product-greater-than-zero-2
+  (implies (case-split (not (complex-rationalp x)))
+           (equal (< 0 (* x y))
+                  (or (and (< 0 x) (< 0 y))
+                      (and (< y 0) (< x 0))))))
+
+;could write the conclusion using an OR...
+(defthm product-equal-zero
+  (equal (equal 0 (* x y))
+         (if (not (acl2-numberp x))
+             t
+           (if (not (acl2-numberp y))
+               t
+             (if (equal 0 x)
+                 t
+               (equal 0 y))))))
+
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/rationalp.lisp acl2-6.3/books/rtl/rel9/arithmetic/rationalp.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/rationalp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/rationalp.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,80 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "predicate"))
+
+(defthm rationalp-product-when-one-arg-is-rational
+  (implies (and (rationalp x)
+                (case-split (not (equal x 0)))
+                (case-split (acl2-numberp y))
+                )
+           (and (equal (rationalp (* x y))
+                       (rationalp y))
+                (equal (rationalp (* y x))
+                       (rationalp y)))))
+
+(defthm rationalp-sum-when-one-arg-is-rational
+  (implies (and (rationalp x)
+                (case-split (acl2-numberp y)))
+           (and (equal (rationalp (+ x y))
+                       (rationalp y))
+                (equal (rationalp (+ y x))
+                       (rationalp y)))))
+
+(defthm rationalp-unary-divide
+  (implies (case-split (acl2-numberp x))
+           (equal (rationalp (/ x))
+                  (rationalp x))))
+
+
+                
+
+                
+#|
+
+(defthm rationalp-*-when-first-factor-is-rat
+  (implies (and (rationalp x)
+                (case-split (not (equal x 0))) ;if x is 0, then...
+                )
+           (equal (rationalp (* x y))
+                  (not (complex-rationalp y)))))
+
+(thm
+  (implies (and (rationalp x)
+                (case-split (not (equal x 0))) ;if x is 0, then...
+                )
+           (equal (rationalp (* x y))
+                  (not (complex-rationalp y)))))
+
+|#
+
+
+;try
+
+(defthm rationalp-product
+  (implies (and (case-split (not (complex-rationalp x)))
+                (case-split (not (complex-rationalp y))))
+           (rationalp (* x y))))
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/top.lisp acl2-6.3/books/rtl/rel9/arithmetic/top.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/top.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,82 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;An attempt to include all the books in arithmetic/ (to check for name conflicts and so forth).
+
+;Keep this list up-to-date:
+
+(include-book "ground-zero") ;disables some of the built-in functions which should be disabled when ACL2 starts
+
+(include-book "induct") ;Induction schemes			
+
+(include-book "denominator")		 
+(include-book "numerator")			
+(include-book "nniq") ;lemmas about nonnegative-integer-quotient			
+
+(include-book "complex-rationalp")		
+(include-book "rationalp")			
+(include-book "integerp")			
+
+;BOZO What's the difference between these 4?
+(include-book "arith")			
+(include-book "arith2")			
+(include-book "fp2")			
+(include-book "basic") ;this is Doc's book.  mixed lemmas about fl, mod, expt, and squaring
+
+(include-book "unary-divide")		
+(include-book "product") ;mostly stuff about comparing a product to zero.
+
+(include-book "inverted-factor")			
+
+(include-book "negative-syntaxp") ;handy recognizer for terms with look negative, needed by some of the other books.
+
+(include-book "predicate") ;splits an equality of two "predicates" into two implications			
+(include-book "x-2xx") ;A very special-purpose lemma having to do with 2x^2
+
+(include-book "power2p") ;recognizer for powers of 2			
+(include-book "expt")			
+(include-book "expo") ;sort of my top-level book dealing with powers of 2.
+
+;I commented out these two because we don't need them in support/.  
+;(include-book "hacks")			 ;BOZO Figure out exactly what this is.
+(include-book "fl-hacks") ; needed for fl-m-n, at the least
+
+(include-book "even-odd2") ;recursive analogues of evenp and oddp			
+(include-book "even-odd") ;lemmas 1/2 and even and odd numbers
+
+
+;;(include-book "floor-proofs")
+(include-book "floor")
+(include-book "fl")				
+(include-book "cg")				
+(include-book "mod")  
+
+(include-book "fl-expt") ;lemmas mixing fl and expt			
+(include-book "mod-expt") ;lemmas mixing mod and expt			
+
+(include-book "common-factor") ;
+
+               
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/unary-divide.lisp acl2-6.3/books/rtl/rel9/arithmetic/unary-divide.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/unary-divide.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/unary-divide.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,95 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "predicate"))
+(local (include-book "fp2"))
+(local (include-book "inverted-factor"))
+
+(defthm unary-divide-less-than-zero
+  (implies (case-split (not (complex-rationalp x))) ;drop?
+           (equal (< (/ x) 0)
+                  (< x 0))))
+
+#|
+;try
+(defthm unary-divide-less-than-zero
+  (implies t;(case-split (not (complex-rationalp x))) ;drop?
+           (equal (< (/ x) 0)
+                  (< x 0))))
+|#
+
+;perhaps we don't need these, if we have rules like
+;less-than-multiply-through-by-inverted-factor-from-left-hand-side ?
+(defthm unary-divide-greater-than-zero
+  (implies (case-split (not (complex-rationalp x))) ;drop?
+           (equal (< 0 (/ x))
+                  (< 0 x))))
+
+(defthm unary-divide-equal-0
+  (implies (case-split (acl2-numberp x))
+           (equal (equal 0 (/ x))
+                  (equal 0 x))))
+
+;BOZO Why do we require the constant to be non-zero?
+(defthm unary-divide-equal-non-zero-constant
+  (implies (and (syntaxp (and (quotep k)
+                              ;(not (equal 0 (cadr k)))
+                              ))  ;drop?
+                ;(case-split (not (equal 0 k)))
+                (case-split (acl2-numberp x))
+                (case-split (acl2-numberp k))
+                )
+           (equal (equal k (/ x))
+                  (equal (/ k) x))))
+
+;make a negative case?
+(defthm unary-divide-less-than-non-zero-constant
+  (implies (and (syntaxp (and (quotep k) (not (equal 0 (cadr k)))))  ;drop?
+                (<= 0 k)
+                (case-split (<= 0 x))
+                (case-split (not (equal 0 k)))
+                (case-split (not (equal 0 x)))
+                (case-split (rationalp x))
+                (case-split (rationalp k))
+                )
+           (equal (< (/ x) k)
+                  (< (/ k) x))))
+
+
+;once with this msg failed:
+;1x (:REWRITE UNARY-DIVIDE-GREATER-THAN-NON-ZERO-CONSTANT) failed because it permutes a big term forward.
+;so I changed the conclusion to not use unary-/
+(defthm unary-divide-greater-than-non-zero-constant
+  (implies (and (syntaxp (and (quotep k) (not (equal 0 (cadr k)))))  ;drop?
+                (<= 0 k)
+                (case-split (<= 0 x))
+                (case-split (not (equal 0 k)))
+                (case-split (not (equal 0 x)))
+                (case-split (rationalp x))
+                (case-split (rationalp k))
+                )
+           (equal (< k (/ x))
+                  (< x (/ 1 k)))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/arithmetic/x-2xx.lisp acl2-6.3/books/rtl/rel9/arithmetic/x-2xx.lisp
--- acl2-6.2/books/rtl/rel9/arithmetic/x-2xx.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/arithmetic/x-2xx.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,166 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+; The following proof is due to John Cowles.
+
+(in-package "ACL2")
+
+(local (include-book "../../../arithmetic/top-with-meta"))
+
+(local (include-book "../../../arithmetic/mod-gcd"))
+
+;; The definition of nonneg-int-gcd often interacts with the rewrite rule,
+;; commutativity-of-nonneg-int-gcd, to cause the rewriter to loop and stack
+;; overflow. 
+(local (in-theory (disable commutativity-of-nonneg-int-gcd)))
+
+(local
+ (defthm lemma-1
+   (implies (and (rationalp x)
+                 (integerp (* 2 x x)))
+            (equal
+             (* 2 (abs (numerator x))(abs (numerator x)))
+             (* (denominator x)(denominator x)(numerator (* 2 x x)))))
+   :rule-classes nil))
+
+(local
+ (defthm lemma-2
+   (implies (and (integerp x)
+                 (> x 0)
+                 (integerp y)
+                 (equal (* x y) z))
+            (equal (nonneg-int-mod z x) 0))
+   :rule-classes nil))
+
+(local
+ (defthm lemma-3
+   (implies (and (rationalp x)
+                 (integerp (* 2 x x)))
+            (equal (nonneg-int-mod (* 2 (abs (numerator x)))
+                                   (denominator x))
+                   0))
+   :hints (("Goal"
+            :in-theory (disable abs)
+            :use ((:instance
+                   Divisor-of-product-divides-factor
+	           (x (* 2 (abs (numerator x))))
+                   (y (abs (numerator x)))
+                   (z (denominator x)))
+		  lemma-1
+		  (:instance
+                   lemma-2
+                   (x (denominator x))
+                   (y (* (denominator x)(numerator (* 2 x x))))
+		   (z (* 2 (abs (numerator x))(abs (numerator x)))))
+		  Nonneg-int-gcd-numerator-denominator)))))
+
+(local
+ (defthm lemma-4
+   (implies (and (rationalp x)
+                 (integerp (* 2 x x)))
+            (equal (nonneg-int-mod 2 (denominator x))
+                   0))
+   :hints (("Goal"
+            :in-theory (disable abs)
+            :use ((:instance
+                   Divisor-of-product-divides-factor
+	           (x 2)
+                   (y (abs (numerator x)))
+                   (z (denominator x)))
+		  Nonneg-int-gcd-numerator-denominator)))))
+
+(local
+ (defthm lemma-5
+   (implies (and (rationalp x)
+                 (integerp (* 2 x x)))
+            (or (equal (denominator x) 1)
+                (equal (denominator x) 2)))
+   :rule-classes nil
+   :hints (("Goal"
+            :use (:instance
+                  Divisor-<=
+                  (d (denominator x))
+                  (n 2))))))
+
+(local
+ (defthm lemma-6
+   (implies (and (rationalp x)
+                 (integerp (* 2 x x))
+                 (equal (denominator x) 2))
+            (equal (* (abs (numerator x))(abs (numerator x)))
+                   (* 2 (numerator (* 2 x x)))))
+   :hints (("Goal"
+            :in-theory (disable abs)
+            :use lemma-1)))) 
+
+(local
+ (defthm lemma-7
+   (implies (and (rationalp x)
+                 (integerp (* 2 x x))
+                 (equal (denominator x) 2))
+            (equal (nonneg-int-mod (* (abs (numerator x))(abs (numerator x)))
+                                   2)
+                   0))
+   :hints (("Goal"
+            :in-theory (disable abs)
+            :use (:instance
+                  lemma-2
+                  (x 2)
+                  (y (numerator (* 2 x x)))
+                  (z (* (abs (numerator x))(abs (numerator x)))))))))
+
+(local
+ (defthm lemma-8
+   (implies (and (rationalp x)
+                 (integerp (* 2 x x))
+                 (equal (denominator x) 2))
+            (equal (nonneg-int-mod (abs (numerator x))
+                                   2)
+                   0))
+   :hints (("Goal"
+            :use ((:instance
+                   Divisor-of-product-divides-factor
+                   (x (abs (numerator x)))
+                   (y (abs (numerator x)))
+                   (z (denominator x)))
+                  Nonneg-int-gcd-numerator-denominator
+                  lemma-7)))))
+
+(defthm x-2xx
+  (implies (and (rationalp x)
+		(integerp (* 2 x x)))
+	   (integerp x))
+  :hints (("Goal"
+	   :in-theory (disable abs)
+	   :use (lemma-5
+		 Nonneg-int-gcd-numerator-denominator)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/lib/Makefile acl2-6.3/books/rtl/rel9/lib/Makefile
--- acl2-6.2/books/rtl/rel9/lib/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,11 @@
+include ../../../Makefile-generic
+
+BOOKS = basic bits log logn float reps round \
+        rtl rtlarr bvecp-raw-helpers bvecp-helpers simple-loop-helpers \
+        simplify-model-helpers util add rom-helpers clocks package-defs \
+        openers mult \
+	logn2log  srt sqrt masc  \
+	top
+ 
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/lib/add.lisp acl2-6.3/books/rtl/rel9/lib/add.lisp
--- acl2-6.2/books/rtl/rel9/lib/add.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/add.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,537 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+;; From bits.lisp:
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; We define a macro, CAT, that takes a list of a list X of alternating data values 
+;; and sizes.  CAT-SIZE returns the formal sum of the sizes.  X must contain at 
+;; least 1 data/size pair, but we do not need to specify this in the guard, and 
+;; leaving it out of the guard simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;; From float.lisp:
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (logand u v) 1 (logxor u v) 1)))
+  :rule-classes ())
+
+(defthm add-2
+    (implies (and (natp x) (natp y))
+	     (equal (+ x y)
+		    (+ (logxor x y)
+		       (* 2 (logand x y)))))
+  :rule-classes ())
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (logior (logand u v) (logior (logand u w) (logand v w))) 1 
+                       (logxor u (logxor v w)) 1)))
+  :rule-classes ())
+
+(defthm add-3
+    (implies (and (natp x)
+		  (natp y)
+		  (natp z))
+	     (= (+ x y z)
+		(+ (logxor x (logxor y z))
+		   (* 2 (logior (logand x y)
+				(logior (logand x z)
+					(logand y z)))))))
+  :rule-classes ())
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (logior (logand (bitn x (1- k)) (bitn y (1- k)))
+	    (logior (logand (bitn x (1- k)) (rc-carry x y (1- k)))
+		    (logand (bitn y (1- k)) (rc-carry x y (1- k)))))))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (logxor (bitn x (1- k))
+		 (logxor (bitn y (1- k)) (rc-carry x y (1- k))))
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :rule-classes ())
+
+(defun gen (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+(defun prop (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(defthmd gen-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen x y i j)
+                  (if (>= (+ (bits x i j) (bits y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j) (bits y i j))
+			(1+ (- i j))))))
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0)))))
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (logior (bitn x i) (bitn y i))))
+  :rule-classes ())
+
+(defthmd prop-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop x y i j)
+                  (if (= (+ (bits x i j) (bits y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthmd prop-as-logxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (logxor (bits x i j) (bits y i j))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthm gen-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (gen x y i j)
+		    (logior (gen x y i (1+ k))
+			    (logand (prop x y i (1+ k))
+				    (gen x y k j)))))
+  :rule-classes ())
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :rule-classes ())
+
+(defthm prop-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (prop x y i j)
+		    (logand (prop x y i (1+ k))
+			    (prop x y k j))))
+  :rule-classes ())
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp i) 
+		  (natp j)
+		  (> j 0)
+		  (>= i j))
+           (equal (bits (+ (* (expt 2 j) x) y) i j)
+                  (bits (+ (bits (* (expt 2 j) x) i j)
+                           (bits y i j))
+                        (- i j) 0)))
+    :rule-classes ())
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j))))
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j)))))
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-plus-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (bits x i j)
+			     (bits y i j)
+			     (logior (prop x y (1- j) 0) 
+				     (gen x y (1- j) 0) ))
+			  (- i j) 0)))
+  :rule-classes ())
+
+(defthmd logand-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand (bits x i j) (bits y i j)) 0))
+           (equal (gen x y i j) 0)))
+
+
+(defthm logand-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand x y) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :rule-classes ())
+
+(defthmd gen-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (logand z y) 0)
+		(= (gen x y k 0) 1))
+	   (equal (gen (+ x y) z k 0) 0)))
+
+(defthmd gen-extend-3
+    (implies (and (natp i)
+		  (natp j)
+		  (> i j)
+		  (natp x)
+		  (natp y)
+		  (bvecp z (1+ j))
+		  (= (logand y z) 0))		  
+	     (equal (gen (+ x y) z i 0)
+		    (logand (prop x y i (1+ j))
+			    (gen (+ x y) z j 0)))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm lop-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ())
+
+(defthm lop-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (bits (lognot (* 2 b)) e 0))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
+
+(defun lamt (a b e)
+  (logxor a (bits (lognot b) e 0)))
+
+(defun lamg (a b e)
+  (logand a (bits (lognot b) e 0)))
+
+(defun lamz (a b e)
+  (bits (lognot (logior a (bits (lognot b) e 0))) e 0))
+
+(defun lam1 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam2 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam3 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam4 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam0 (a b e)
+  (logior (lam1 a b e)
+	  (logior (lam2 a b e)
+		  (logior (lam3 a b e)
+			  (lam4 a b e)))))
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (bitn (lognot(lamt a b e)) 0)))
+
+(defthm lop-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lognot (logxor a b)) k 0) 0)))
+  :rule-classes ())
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (logxor (logxor a b) 
+                                       (cat (logior a b) n c 1))
+                               k 0) 
+                         0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/lib/basic.lisp acl2-6.3/books/rtl/rel9/lib/basic.lisp
--- acl2-6.2/books/rtl/rel9/lib/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/basic.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,445 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                       FLOOR and CEILING
+;;;**********************************************************************
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defthm fl-def
+  (and (integerp (fl x))    
+       (implies (case-split (rationalp x))
+	        (and (<= (fl x) x)
+		     (< x (1+ (fl x))))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (<= (fl x) x)
+                                        (< x (1+ (fl x))))))
+                 (:type-prescription :corollary
+                                     (integerp (fl x)))))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+(defthm fl-integerp
+  (equal (equal (fl x) x)
+         (integerp x)))
+
+(defthm quot-bnd
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* y (fl (/ x y)))
+               x))
+  :rule-classes :linear)
+
+(defthm fl-monotone-linear
+    (implies (and (<= x y)
+		  (rationalp x)
+		  (rationalp y))
+	     (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (fl x) (/ n)))
+                  (fl (/ x n)))))
+
+(defthm fl/int-rewrite-alt
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (/ n) (fl x)))
+                  (fl (/ x n)))))
+
+(defthmd fl-minus
+  (implies (rationalp x)
+           (equal (fl (* -1 x))
+                  (if (integerp x)
+                      (* -1 x)
+                    (1- (* -1 (fl x)))))))
+
+(defthm fl-m-n
+  (implies (and (< 0 n)
+                (integerp m)
+                (integerp n))
+           (= (fl (- (/ m n)))
+              (1- (- (fl (/ (1- m) n))))))
+  :rule-classes ())
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defthm cg-def
+  (and (integerp (cg x))
+       (implies (case-split (rationalp x))
+                (and (>= (cg x) x)
+                     (> (1+ x) (cg x)))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (>= (cg x) x)
+                                        (> (1+ x) (cg x)))))
+                 (:type-prescription :corollary
+                                     (integerp (cg x)))))
+
+(defthm cg-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (>= n x)
+		  (> (1+ x) n))
+	     (equal (cg x) n))
+  :rule-classes ())
+
+(defthm cg-integerp
+    (implies (rationalp x)
+	     (equal (equal (cg x) x)
+                    (integerp x))))
+
+(defthm cg-monotone-linear
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= x y))
+	     (<= (cg x) (cg y)))
+  :rule-classes :linear)
+
+(defthm n>=cg-linear
+    (implies (and (>= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (>= n (cg x)))
+  :rule-classes :linear)
+
+(defthm cg+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (cg (+ x n)) (+ (cg x) n))))
+
+(defthm cg/int-rewrite
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (cg x) (/ n)))
+                  (cg (/ x n)))))
+
+(defthm cg/int-rewrite-alt
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (/ n) (cg x)))
+                  (cg (/ x n)))))
+
+(defthm fl-cg
+  (implies (rationalp x)
+           (equal (cg x)
+                  (if (integerp x)
+                      (fl x)
+                    (1+ (fl x)))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                         MOD
+;;;**********************************************************************
+
+(in-theory (disable mod))
+
+(defthm mod-def
+  (implies (case-split (acl2-numberp x))
+           (equal (mod x y)
+                  (- x (* y (fl (/ x y))))))
+  :rule-classes ())
+
+(defthm mod-0
+    (and (equal (mod 0 y)
+                0)
+         (equal (mod x 0)
+                (fix x))))
+
+(defthm rationalp-mod
+  (implies (rationalp x)
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm integerp-mod
+  (implies (and (integerp m) (integerp n))
+           (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm natp-mod
+   (implies (and (natp m)
+                 (natp n))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+(defthm natp-mod-2
+   (implies (and (integerp m)
+                 (integerp n)
+                 (> n 0))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+(defthm mod-bnd-1
+  (implies (and (case-split (< 0 n))
+                (case-split (not (complex-rationalp m)))
+                (case-split (not (complex-rationalp n))))
+           (< (mod m n) n))
+  :rule-classes :linear)
+
+(defthm mod-by-1
+  (implies (integerp m)
+           (equal (mod m 1)
+                  0)))
+
+(defthm mod-bnd-2
+  (implies (and (<= 0 m)
+                (case-split (rationalp m)))
+           (<= (mod m n) m))
+  :rule-classes :linear)
+
+(defthm mod-does-nothing
+  (implies (and (< m n)
+                (<= 0 m)
+                (case-split (rationalp m)))
+           (equal (mod m n)
+                  m)))
+
+(defthm mod-0-fl
+  (implies (acl2-numberp m)
+           (iff (= (mod m n) 0)
+	        (= m (* (fl (/ m n)) n))))
+  :rule-classes ())
+
+(defthm mod-0-int
+  (implies (and (integerp m)
+                (integerp n)
+                (not (= n 0)))
+           (iff (= (mod m n) 0)
+                (integerp (/ m n))))
+  :rule-classes ())
+
+(defthm mod-mult-n
+  (equal (mod (* a n) n)
+         (* n (mod a 1))))
+
+(defthm mod-mult-n-alt
+  (equal (mod (* n a) n)
+         (* n (mod a 1))))
+
+(defthm mod-squeeze
+    (implies (and (= (mod m n) 0)
+		  (< m (* (1+ a) n))
+                  (< (* (1- a) n) m)
+                  (integerp a)
+		  (integerp m)
+		  (integerp n))
+	     (= m (* a n)))
+  :rule-classes ())
+
+(defthm mod-must-be-n
+    (implies (and (= (mod m n) 0)
+		  (< m (* 2 n))
+                  (< 0 m)
+		  (rationalp m)
+		  (rationalp n))
+	     (= m n))
+  :rule-classes ())
+
+(defthm mod-0-0
+  (implies (and (integerp p)
+                (rationalp m)
+                (rationalp n))
+           (iff (= (mod m (* n p)) 0)
+                (and (= (mod m n) 0)
+                     (= (mod (fl (/ m n)) p) 0))))
+  :rule-classes ())
+
+(defthm mod-equal-int
+  (implies (and (= (mod a n) (mod b n))
+                (rationalp a)
+                (rationalp b))
+           (integerp (/ (- a b) n)))
+  :rule-classes ())
+
+(defthm mod-equal-int-reverse
+  (implies (and (integerp (/ (- a b) n))
+                (rationalp a)
+                (rationalp b)
+                (rationalp n)
+                (< 0 n))
+           (= (mod a n) (mod b n)))
+  :rule-classes ())
+
+(defthm mod-force-equal
+  (implies (and (< (abs (- a b)) n)
+                (rationalp a)
+                (rationalp b)
+                (integerp n))
+          (iff (= (mod a n) (mod b n))
+               (= a b)))
+  :rule-classes ())
+
+(defthmd mod-mult
+    (implies (and (integerp a)
+                  (rationalp m)
+		  (rationalp n))
+	     (equal (mod (+ m (* a n)) n)
+		    (mod m n))))
+
+(defthm mod-force
+  (implies (and (<= (* a n) m)
+                (< m (* (1+ a) n))
+                (integerp a)
+                (rationalp m)
+                (rationalp n))
+           (= (mod m n) (- m (* a n))))
+  :rule-classes ())
+
+(defthm mod-bnd-3
+  (implies (and (< m (+ (* a n) r))
+                (<= (* a n) m)
+                (integerp a)
+                (case-split (rationalp m))
+                (case-split (rationalp n)))
+           (< (mod m n) r))
+  :rule-classes :linear)
+
+(defthmd mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ a (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthmd mod-mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ (mod a n) (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthmd mod-diff
+  (implies (and (case-split (rationalp a))
+                (case-split (rationalp b)))
+           (equal (mod (- a (mod b n)) n)
+                  (mod (- a b) n))))
+
+(defthmd mod-of-mod
+  (implies (and (case-split (natp k))
+                (case-split (natp n)))
+           (equal (mod (mod x (* k n)) n)
+                  (mod x n))))
+
+(defthmd mod-of-mod-cor
+  (implies (and (<= b a)
+                (case-split (integerp b))
+                (case-split (integerp a)))
+           (equal (mod (mod x (expt 2 a)) (expt 2 b))
+                  (mod x (expt 2 b)))))
+
+(defthmd mod-prod
+  (implies (and (rationalp m)
+                (rationalp n)
+                (rationalp k))
+           (equal (mod (* k m) (* k n))
+                  (* k (mod m n)))))
+
+(defthm mod012
+  (implies (integerp m)
+           (or (equal (mod m 2) 0)
+               (equal (mod m 2) 1)))
+  :rule-classes ())
+
+(defthm mod-plus-mod-2
+  (implies (and (integerp a)
+                (integerp b))
+           (iff (= (mod (+ a b) 2) (mod a 2))
+                (= (mod b 2) 0)))
+  :rule-classes ())
+
+(defthm mod-mod-2-not-equal
+  (implies (acl2-numberp m)
+           (not (= (mod m 2) (mod (1+ m) 2))))
+  :rule-classes ())
+
+(defthm mod-2*m+1-rewrite
+  (implies (integerp m)
+           (equal (mod (1+ (* 2 m)) 2) 1)))
+
+(defthm mod-mod-times
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (> n 0))
+	     (= (mod (* (mod a n) b) n)
+		(mod (* a b) n)))
+  :rule-classes ())
+
+(defthm mod-times-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (* a c) n) (mod (* b c) n)))
+  :rule-classes ())
+
+(defthm mod-plus-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (+ a c) n) (mod (+ b c) n)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/lib/bits.lisp acl2-6.3/books/rtl/rel9/lib/bits.lisp
--- acl2-6.2/books/rtl/rel9/lib/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/bits.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,970 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defun nats (n) (if (zp n) () (cons (1- n) (nats (1- n)))))
+
+(defthm bvecp-member
+  (implies (and (natp n)
+                (bvecp x n))
+           (member x (nats (expt 2 n))))
+  :rule-classes ())
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm bits-bounds
+    (implies (and (integerp i)
+		  (integerp j))
+	     (and (natp (bits x i j))
+		  (< (bits x i j) (expt 2 (1+ (- i j))))))
+  :rule-classes())
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ (bits x k 0) y) i j)
+		  (bits (+ x y) i j))))
+
+(defthmd bits-bits-sum-alt
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (bits y k 0)) i j)
+		  (bits (+ x y) i j))))
+
+(defthmd bits-bits-diff
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (- (bits y k 0))) i j)
+		  (bits (- x y) i j))))
+
+(defthmd bits-bits-prod
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (* x (bits y k 0)) i j)
+		  (bits (* x y) i j))))
+
+(defthm bits-diff-equal
+    (implies (and (natp n)
+		  (integerp x)
+		  (integerp y)
+		  (< (abs (- x y)) (expt 2 n)))
+	     (iff (= x y)
+		  (= (bits (- x y) (1- n) 0) 0)))
+  :rule-classes ())
+
+
+(defthm bits-fl-diff
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i)))))))
+  :rule-classes ())
+
+(defthm bits-neg-indices
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-reverse-indices
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthmd neg-bits-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (1- (expt 2 (1+ (- i j)))))))
+
+(defthmd bits-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (1- (expt 2 (1+ (- i j)))))))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-diff-0
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+(defthm bits-tail-gen
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthmd bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k)))))
+
+(defthmd bits-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0))))
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthmd bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free variables
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1)))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0)))
+
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0)))
+
+(defthmd bitn-minus-1
+    (implies (natp i)
+	     (equal (bitn -1 i) 1)))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bitn-shift-up
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthmd bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthm bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m))))
+  :rule-classes ())
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+;; The next two lemmas allow one to prove equality of two bit vectors of width k by 
+;; proving each of these has the same value at bit i, for 0 <= i < k.
+
+(defun diff-bit (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (diff-bit x y (1- k)))))
+
+(defthmd diff-bit-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((i (diff-bit x y k)))
+             (and (natp i)
+                  (< i k)))))
+
+(defthmd diff-bit-equal
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (not (zp k))
+                (equal (bitn x (diff-bit x y k))
+                       (bitn y (diff-bit x y k))))
+           (equal (equal x y) t)))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; We define a macro, CAT, that takes a list of a list X of alternating data values 
+;; and sizes.  CAT-SIZE returns the formal sum of the sizes.  X must contain at 
+;; least 1 data/size pair, but we do not need to specify this in the guard, and 
+;; leaving it out of the guard simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthmd cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+;; We introduce mbe for MULCAT not because we want particularly fast execution, 
+;; but because the existing logic definition does not satisfy the guard of cat, 
+;; which can't be changed because of the guard of bits.
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
+
+;;;**********************************************************************
+;;;		      Signed Integer Encodings
+;;;**********************************************************************
+
+(defun intval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm intval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (intval w (bits x (1- w) 0))
+                x))
+    :rule-classes nil)
+
+(defun sign-extend (n m x)
+  (bits (intval m x) (1- n) 0))
+
+(defthmd intval-sign-extend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (intval n (sign-extend n m x))
+		    (intval m x))))
diff -Nru acl2-6.2/books/rtl/rel9/lib/bvecp-helpers.lisp acl2-6.3/books/rtl/rel9/lib/bvecp-helpers.lisp
--- acl2-6.2/books/rtl/rel9/lib/bvecp-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/bvecp-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,63 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(local (include-book "../support/top/top"))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (integerp (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/bvecp-raw-helpers.lisp acl2-6.3/books/rtl/rel9/lib/bvecp-raw-helpers.lisp
--- acl2-6.2/books/rtl/rel9/lib/bvecp-raw-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/bvecp-raw-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,801 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;Contains bvecp lemmas about the RTL primitives.
+;Also contains type lemmas (non-negative integer, natp, etc.)
+
+(include-book "rtl")
+(include-book "rtlarr")
+
+(include-book "bits")
+(include-book "float")
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") 
+(local (in-theory nil))
+
+(set-match-free-default :all)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;; bits
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+   (implies (and (<= (+ 1 i (- j)) k)
+                 (case-split (integerp k))
+                 )
+            (bvecp (bits x i j) k)))
+
+
+;; setbits
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k)))
+
+
+;; setbitn
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k)))
+
+
+
+;; log<
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+
+;; log<=
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+
+
+;; log>
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+
+
+;; log>=
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+
+
+;; log=
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+
+
+;; log<>
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+
+
+;; logand1
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+
+
+;; logior1
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+
+
+;; logxor1
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+
+
+;; lnot
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+;; bitn
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes ( :type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+;; shft
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k)))
+
+;; cat
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+
+;; logand
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n)))
+
+
+;; logior
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+
+;; mulcat
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n)))
+|#
+
+;; encode
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k)))
+           (bvecp (encode x n) k)))
+
+
+;; decode
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+;BOZO dup?
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+
+; land
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+;; lior
+
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+;; lxor
+
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+;; cat
+
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x)))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x)))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
+
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
+
+;remove these?
+
+
+;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
+;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
+;;;;;;;;;;;;;;;;;;; statements have no default.
+
+;maybe leave this one?
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t)))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t)))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t)))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t)))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t)))
+|#
+
+#|
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+|#
+
+#|
+;drop?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j))
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/clocks.lisp acl2-6.3/books/rtl/rel9/lib/clocks.lisp
--- acl2-6.2/books/rtl/rel9/lib/clocks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/clocks.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,199 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Most or all of this was originally written by Eric Smith while an intern at AMD.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../support/support/clocks")
+
+; The analysis of clocks uses some new functions.
+; 
+; First, even and odd are not the same as evenp and oddp.  For one thing, even
+; and odd are defined recursively, and I've proved a bunch of nice rules about
+; them which we probably want to use and which may not be proved about evenp and
+; oddp (and which may be nicer than what is proveable about evenp and oddp).  One
+; nice property of even and odd is that each implies integerp.  (By contrast,
+; evenp returns t for non-numbers like nil or '(a b).)  So rules which would
+; naturally have both the hyp (integerp n) and the hyp (evenp n) now can just
+; have (even n).
+; 
+; Second, I also define a function, MOD4. I didn't want to use MOD itself in the
+; clocking logic because reasoning about clocks needs to be fast and predictable.
+; (I can imagine that we'll have rules about MOD, especially when doing FP
+; proofs, which will just get in the way of our reasoning about clocks. We might
+; even open up MOD on occasion.)  So, in order to get complete control over the
+; rules which fire when we reason about clocks, I introduced MOD4, which we
+; expect never to have to open after proving a nice set of rules about it.
+; 
+; Also, theorems about MOD4 may be nicer than their analogs for MOD.  For
+; example, MOD4 is always equal to 0, 1, 2, or 3, but (mod #c(0 1) 4) = #c(0 1),
+; which isn't even rational.
+
+(defund pedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 0)
+       (equal y 1)))
+
+(defund nedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 1)
+       (equal y 0)))
+
+(defmacro posedge (clk)
+  `(and (not (zp n))
+        (pedge (,clk (1- n)) (,clk n))))
+
+(defmacro negedge (clk)
+  `(and (not (zp n))
+        (nedge (,clk (1- n)) (,clk n))))
+
+(defthm pedge-known-false-1
+  (not (pedge x 0)))
+
+(defthm pedge-known-false-2
+  (not (pedge 1 y)))
+
+(defthm nedge-known-false-1
+  (not (nedge x 1)))
+
+(defthm nedge-known-false-2
+  (not (nedge 0 y)))
+
+
+; The call (defperiodic NAME TYPE) creates 1) a defun which defines NAME to be
+; a periodic signal of the specified TYPE and 2) a bvecp lemma for that defun
+; (all periodics have width 1).
+
+; We intend the user to smash certain periodic inputs to his top level module
+; and replace their translations with calls to defperiodic.
+
+; Currently we support the following types of periodic signals:
+
+#|
+
+'fast-clock : 
+
+ _   _   _   _   _   _   _
+| |_| |_| |_| |_| |_| |_| |_|
+
+
+'slow-clock-one-quantum-wide
+
+ _       _       _       _
+| |_____| |_____| |_____| |__
+
+
+'slow-clock-one-quantum-wide-shifted :
+
+     _       _       _       _
+____| |_____| |_____| |_____| |__
+
+
+'slow-clock-two-quanta-wide :
+
+ ___     ___     ___     ___     
+|   |___|   |___|   |___|   |___|
+
+
+'slow-clock-two-quanta-wide-shifted :
+
+     ___     ___     ___     
+|___|   |___|   |___|   |___|
+
+'always-1 :
+
+  ___________________________
+..
+
+
+|#
+
+; As the need arises, we can easily change defperiodic to add support for more
+; types of signal.
+
+; BTW, currently, the definitions generated by defperiodic return unknown
+; values (calls to reset) at time 0 (and whenever N is not a natp).  Perhaps
+; this is too conservative, and perhaps defining the value at time 0 would
+; allow nicer rewrite rules to be proved.
+
+(defconst *defperiodic-types*
+
+; Keep this in sync with the corresponding definition in the compiler.
+
+  '(fast-clock
+    slow-clock-one-quantum-wide
+    slow-clock-one-quantum-wide-shifted
+    slow-clock-two-quanta-wide
+    slow-clock-two-quanta-wide-shifted
+    always-1))
+
+(defmacro defperiodic (name type)
+  (declare (xargs :guard (member-eq type *defperiodic-types*)))
+  (list*
+   'encapsulate
+   nil
+   (case type
+     (fast-clock
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (even n) 1 0))))
+     (slow-clock-one-quantum-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 0 (mod4 n)) 1 0))))
+     (slow-clock-one-quantum-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 2 (mod4 n)) 1 0))))
+     (slow-clock-two-quanta-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 0 (mod4 n))
+                   (equal 1 (mod4 n)))
+               1
+             0))))
+     (slow-clock-two-quanta-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 2 (mod4 n))
+                   (equal 3 (mod4 n)))
+               1
+             0))))
+     (always-1
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           1)))
+     (otherwise (er hard 'defperiodic
+                    "Bad type, ~x0, for defperiodic."
+                    type)))
+   `((defbvecp ,name (n) 1 :hints (("Goal" :in-theory (enable ,name)))))))
diff -Nru acl2-6.2/books/rtl/rel9/lib/float.lisp acl2-6.3/books/rtl/rel9/lib/float.lisp
--- acl2-6.2/books/rtl/rel9/lib/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/float.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,480 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t) 
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+;; From bits.lisp:
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+(defthmd sig-self
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (equal (sig x) x)))
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exactp-abs
+  (equal (exactp (abs x) n)
+         (exactp x n)))
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ())
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ())
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ())
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ())
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+(defthm exactp-fp-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :hints (("Goal" :use (fp-1))))
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/lib/log.lisp acl2-6.3/books/rtl/rel9/lib/log.lisp
--- acl2-6.2/books/rtl/rel9/lib/log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/log.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,582 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t) ; for some reason, acl2 4.3 complains about  logand-natp 
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+;; From bits.lisp:
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;;**********************************************************************
+;;;                       LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+(in-theory (disable logand logior logxor))
+
+(defthmd logand-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logand i j)
+		    (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logand (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+(defthmd logior-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logior i j)
+		    (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+(defthmd logxor-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logxor i j)
+		    (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+;; (defthmd logand-natp
+;;     (implies (and (natp i)
+;; 		  (integerp j))
+;; 	     (natp (logand i j)))
+;;   :rule-classes (:type-prescription :rewrite))
+
+;; (defthm logand-natp-2
+;;     (implies (and (integerp i)
+;; 		  (natp j))
+;; 	     (natp (logand i j)))
+;;   :rule-classes (:type-prescription :rewrite))
+
+(defthm logand-bvecp
+    (implies (and (natp n)
+		  (bvecp x n)
+		  (integerp y))
+	     (bvecp (logand x y) n)))
+
+;; (defthm logior-natp
+;;     (implies (and (natp i)
+;; 		  (natp j))
+;; 	     (natp (logior i j)))
+;;   :rule-classes (:type-prescription :rewrite))
+
+(defthm logior-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n))
+	     (bvecp (logior x y) n)))
+
+;; (defthm logxor-natp
+;;     (implies (and (natp i)
+;; 		  (natp j))
+;; 	     (natp (logxor i j)))
+;;   :rule-classes (:type-prescription :rewrite))
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n))
+	     (bvecp (logxor x y) n)))
+
+;; Some useful induction schemes:
+
+(defun logop-2-induct-g (x y)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)))))
+  (if (and (integerp x) (integerp y))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1)))
+          t
+        (logop-2-induct-g (fl (/ x 2)) (fl (/ y 2))))
+    t))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun logop-3-induct-g (x y z)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)) (nfix (abs z)))))
+  (if (and (integerp x) (integerp y) (integerp z))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1))
+               (or (equal z 0)
+                   (equal z -1)))
+	  t
+	(logop-3-induct-g (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defthmd logand-fl-2-rewrite
+    (implies (and (natp x)
+		  (natp y))
+	     (equal (fl (* 1/2 (logand x y)))
+		    (logand (fl (* 1/2 x)) (fl (* 1/2 y))))))
+
+(defthmd logior-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logior i j)))
+		    (logior (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthmd logxor-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logxor i j)))
+		    (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthm logior-not-0
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (logior x y) 0))
+	     (and (= x 0) (= y 0)))
+  :rule-classes ())
+
+(defthm logior-expt
+    (implies (and (natp n)
+		  (integerp x)
+		  (bvecp y n))
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ())
+
+(defthm logior-expt-2
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logior (* (expt 2 n) x)
+			(* (expt 2 n) y))
+		(* (expt 2 n) (logior x y))))
+  :rule-classes ())
+
+(defthm logand-bnd
+    (implies (<= 0 x)
+	     (<= (logand x y) x))
+  :rule-classes :linear)
+
+(defthm logand-expt
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logand (* (expt 2 n) x) y)
+		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+  :rule-classes ())
+
+(defthmd bitn-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logand x y) n)
+		    (logand (bitn x n) (bitn y n)))))
+
+(defthmd logand-bvecp-2
+  (implies (and (natp n)
+                (bvecp x (1+ n))
+                (integerp y))
+           (equal (logand x (bits y n 0))
+                  (logand x y))))
+
+(defthmd bitn-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logior x y) n)
+		    (logior (bitn x n) (bitn y n)))))
+
+(defthmd bits-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logior x y) i j)
+		    (logior (bits x i j) (bits y i j)))))
+
+(defthmd bitn-logxor
+    (implies (and (case-split (integerp x))
+		  (case-split (integerp y))
+		  (case-split (integerp n)))
+	     (equal (bitn (logxor x y) n)
+		    (logxor (bitn x n) (bitn y n)))))
+
+(defthmd bits-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (bits (logxor x y) i j)
+                  (logxor (bits x i j) (bits y i j)))))
+
+(defthmd logand-expt-2
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logand x (expt 2 k))
+		    (* (expt 2 k) (bitn x k)))))
+
+(defthmd logior-expt-3
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logior x (expt 2 k))
+		    (+ x
+		       (* (expt 2 k) 
+			  (- 1 (bitn x k)))))))
+
+(defthmd logand-expt-3
+    (implies (and (integerp x)
+		  (natp n)
+		  (natp k)
+		  (< k n))
+	     (equal (logand x (- (expt 2 n) (expt 2 k)))
+		    (* (expt 2 k) (bits x (1- n) k)))))
+
+(defthmd logand-expt-4
+    (implies (and (natp n)
+		  (natp k)
+		  (natp l)
+		  (< l k)
+		  (<= k n))
+	     (equal (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+		    (- (expt 2 n) (expt 2 k)))))
+
+(defthmd logand-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logand (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logand x y)))))
+
+(defthmd logxor-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logxor (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logxor x y)))))
+
+(defthmd logior-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logior (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logior x y)))))
+
+(defthmd fl-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logand x y) (expt 2 k)))
+                  (logand (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logior x y) (expt 2 k)))
+                  (logior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logxor
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logxor x y) (expt 2 k)))
+                  (logxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+
+;;;**********************************************************************
+;;;                               LOGNOT
+;;;**********************************************************************
+
+(in-theory (disable lognot))
+
+(defthmd lognot-def
+    (implies (integerp x)
+	     (equal (lognot x)
+		    (1- (- x)))))
+
+(defthmd bitn-lognot
+    (implies (and (integerp x)
+		  (integerp n)
+		  (> n 0))
+	     (not (equal (bitn (lognot x) n)
+			 (bitn x n)))))
+
+(defthmd logand-bitn-lognot-1
+  (implies (and (integerp n)
+                (integerp x)
+                (integerp y))                
+           (equal (logand (bitn (lognot x) n) (bitn y n))
+                  (logand (lognot (bitn x n)) (bitn y n)))))
+
+(defthmd logand-bitn-lognot-alt
+  (implies (and (integerp n)
+                (integerp x)
+                (integerp y))
+           (equal (logand (bitn y n) (bitn (lognot x) n))
+                  (logand (bitn y n) (lognot (bitn x n))))))
+
+(defthmd bits-lognot
+    (implies (and (natp i)
+		  (natp j)
+		  (<= j i)
+		  (integerp x))
+	     (equal (bits (lognot x) i j)
+		    (- (1- (expt 2 (- (1+ i) j))) (bits x i j)))))
+
+(defthmd bits-lognot-bits
+  (implies (and (integerp x)
+                (natp i)
+                (natp j)
+                (natp k)
+                (natp l)
+                (<= l k)
+                (<= k (- i j)))
+           (equal (bits (lognot (bits x i j)) k l)
+                  (bits (lognot x) (+ k j) (+ l j)))))
+
+(defthmd bits-lognot-bits-lognot
+  (implies (and (integerp x)
+                (natp i)
+                (natp j)
+                (natp k)
+                (natp l)
+                (<= l k)
+                (<= k (- i j)))
+           (equal (bits (lognot (bits (lognot x) i j)) k l)
+                  (bits x (+ k j) (+ l j)))))
+
+(defthmd logand-bits-lognot
+  (implies (and (integerp x)
+                (integerp n)
+                (bvecp y (1+ n)))
+           (equal (logand y (bits (lognot x) n 0))
+                  (logand y (lognot (bits x n 0))))))
+
+(defthmd lognot-shift
+  (implies (and (integerp x)
+                (natp k))
+           (equal (lognot (* (expt 2 k) x))
+		  (+ (* (expt 2 k) (lognot x))
+		     (1- (expt 2 k))))))
+
+(defthmd lognot-fl
+  (implies (and (integerp x)
+                (not (zp n)))
+           (equal (lognot (fl (/ x n)))
+                  (fl (/ (lognot x) n)))))
+
+
+;;;**********************************************************************
+;;;                         Algebraic Properties
+;;;**********************************************************************
+
+(defthm lognot-lognot
+    (implies (case-split (integerp i))
+	     (equal (lognot (lognot i))
+		    i)))
+
+(defthm logand-x-0
+    (equal (logand x 0) 0))
+
+(defthm logand-0-y
+    (equal (logand 0 y) 0))
+
+(defthm logior-x-0
+    (implies (integerp x)
+	     (equal (logior x 0) x)))
+
+(defthm logior-0-y
+    (implies (integerp y)
+	     (equal (logior 0 y) y)))
+
+(defthm logxor-x-0
+    (implies (integerp x)
+	     (equal (logxor x 0) x)))
+
+(defthm logxor-0-y
+    (implies (integerp y)
+	     (equal (logxor 0 y) y)))
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logior-self
+    (implies (case-split (integerp i))
+	     (equal (logior i i) i)))
+
+(defthm logxor-self
+  (equal (logxor i i) 0))
+
+(defthm logand-x-m1
+    (implies (integerp x)
+	     (equal (logand x -1) x)))
+
+(defthm logand-m1-y
+    (implies (integerp y)
+	     (equal (logand -1 y) y)))
+
+(defthm logand-x-1
+    (implies (bvecp x 1)
+	     (equal (logand x 1) x)))
+
+(defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x)))
+
+(defthm logior-x-m1
+    (implies (integerp x)
+	     (equal (logior x -1) -1)))
+
+(defthm logior-m1-y
+    (implies (integerp y)
+	     (equal (logior -1 y) -1)))
+
+(defthm logior-1-x
+  (implies (bvecp x 1)
+           (equal (logior 1 x) 1)))
+
+(defthm logior-x-1
+  (implies (bvecp x 1)
+           (equal (logior x 1) 1)))
+
+(defthm logxor-m1
+    (implies (integerp x)
+	     (equal (logxor x -1)
+		    (lognot x))))
+
+(defthm logand-commutative
+    (equal (logand j i) (logand i j)))
+
+(defthm logior-commutative
+    (equal (logior j i) (logior i j)))
+
+(defthm logxor-commutative
+    (equal (logxor j i) (logxor i j)))
+
+(defthm logand-associative
+    (equal (logand (logand i j) k)
+           (logand i (logand j k))))
+
+(defthm logior-associative
+    (equal (logior (logior i j) k)
+	   (logior i (logior j k))))
+
+(defthm logxor-associative
+    (equal (logxor (logxor i j) k)
+	   (logxor i (logxor j k))))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+	 (logand i j k)))
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+	 (logior i j k)))
+
+(defthm logxor-commutative-2
+  (equal (logxor j i k)
+	 (logxor i j k)))
+
+(defthmd lognot-logxor
+    (and (equal (logxor (lognot i) j)
+                (lognot (logxor i j)))
+         (equal (logxor j (lognot i))
+                (lognot (logxor i j)))))
+
+(defthmd logior-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z)))))
+
+(defthmd logand-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand x (logior y z))
+	   (logior (logand x y) (logand x z)))))
+
+(defthmd logior-logand-2
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand  (logior y z) x)
+	   (logior (logand y x) (logand z x)))))
+
+(defthmd log3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+	   (logior (logand x y) (logand (logxor x y) z)))))
+
+(defthmd logxor-rewrite-2
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (logxor x y)
+                  (logior (logand x (lognot y))
+                          (logand y (lognot x))))))
diff -Nru acl2-6.2/books/rtl/rel9/lib/logn.lisp acl2-6.3/books/rtl/rel9/lib/logn.lisp
--- acl2-6.2/books/rtl/rel9/lib/logn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/logn.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,854 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "bits")
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                     LNOT
+;;;**********************************************************************
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthmd lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot x n) k)))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n))))))
+
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n)))))))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n))))
+
+(defthm mod-lnot
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot x n) (expt 2 k))
+                  (lnot (mod x (expt 2 k)) k))))
+
+(defthmd bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j))))))
+
+(defthmd bitn-lnot
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn (lnot x n) k)
+		  (if (< k n)
+		      (lnot (bitn x k) 1)
+		    0))))
+
+(defthmd lnot-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot (cat x m y n) l)
+		  (cat (lnot x m) m (lnot y n) n))))
+
+
+;;;**********************************************************************
+;;;                LAND, LIOR, and LXOR
+;;;**********************************************************************
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land)))
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior)))
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor)))
+
+(defun lognop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun lognop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun lognop-3-induct (x y z)
+  (declare (xargs :measure (:? x y z)))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defthm land-x-y-0
+    (equal (land x y 0) 0))
+
+(defthm lior-x-y-0
+    (equal (lior x y 0) 0))
+
+(defthm lxor-x-y-0
+    (equal (lxor x y 0) 0))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0) y n)
+         (land x y n)))
+
+(defthmd land-bits-2
+  (equal (land x (bits y (1- n) 0) n)
+         (land x y n)))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0) y n)
+         (lior x y n)))
+
+(defthmd lior-bits-2
+  (equal (lior x (bits y (1- n) 0) n)
+         (lior x y n)))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0) y n)
+         (lxor x y n)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x (bits y (1- n) 0) n)
+         (lxor x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land x y n) k)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior x y n) k)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor x y n) k)))
+
+(defthm land-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land x y n) m)))
+
+(defthm lior-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior x y n) m)))
+
+(defthm lxor-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor x y n) m)))
+
+(defthmd land-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land x y m) (land x y n))))
+
+(defthmd lior-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior x y m) (lior x y n))))
+
+(defthmd lxor-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor x y m) (lxor x y n))))
+
+(defthmd land-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lior-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lxor-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (bitn x 0) (bitn y 0) 1)))))
+
+(defthm land-0
+  (equal (land 0 y n)
+	 0))
+
+(defthmd land-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land i j 1))
+		  (or (equal i 0)
+		      (equal j 0)))))
+
+(defthm lior-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior 0 y n) y)))
+
+(defthmd lior-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior x y n))
+		  (and (equal x 0)
+		       (equal y 0)))))
+
+(defthm lxor-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor 0 y n) y)))
+
+(defthm land-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land x y (- n k)))))
+  :rule-classes ())
+
+(defthm lxor-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor x y (- n k)))))
+  :rule-classes ())
+
+(defthm lior-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior x y (- n k)))))
+  :rule-classes ())
+
+(defthmd fl-land
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
+                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lior
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
+                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lxor
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
+                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd mod-land
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land x y n) (expt 2 k))
+                  (land x y k))))
+
+(defthmd mod-lior
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior x y n) (expt 2 k))
+                  (lior x y k))))
+
+(defthmd mod-lxor
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor x y n) (expt 2 k))
+                  (lxor x y k))))
+
+(defthm bits-land
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (land x y n) i j)
+		  (land (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lior
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lior x y n) i j)
+		  (lior (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lxor
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lxor x y n) i j)
+		  (lxor (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bitn-land
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (land x y n) k)
+		  (if (< k n)
+		      (land (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lior
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lior x y n) k)
+		  (if (< k n)
+		      (lior (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lxor
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lxor x y n) k)
+		  (if (< k n)
+		      (lxor (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthmd land-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (land x1 x2 m) m (land y1 y2 n) n))))
+
+(defthm land-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land c (cat x2 m y2 n) l)
+		  (cat (land (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (land (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lior-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lior x1 x2 m) m (lior y1 y2 n) n))))
+
+(defthm lior-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior c (cat x2 m y2 n) l)
+		  (cat (lior (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lior (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lxor-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n))))
+
+(defthm lxor-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor c (cat x2 m y2 n) l)
+		  (cat (lxor (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthm land-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land x y n) x))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior x y n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm lxor-bnd
+  (<= (lxor x y n) (lior x y n))
+  :rule-classes (:rewrite :linear))
+
+(defthmd lior-plus
+  (implies (= (land x y n) 0)
+           (equal (lior x y n)
+                  (+ (bits x (1- n) 0)
+                     (bits y (1- n) 0)))))
+
+(defthmd land-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m)))))))
+
+(defthm lior-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ())
+
+(defthmd land-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land x (expt 2 k) n)
+		  (* (expt 2 k) (bitn x k)))))
+
+(defthm lior-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior x (expt 2 k) n)
+		(+ (bits x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ())
+
+(defthmd lxor-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor x (expt 2 k) n)
+		  (+ (bits x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn x k))))))))
+
+(defthm land-ones
+  (equal (land (1- (expt 2 n)) x n)
+	 (bits x (1- n) 0))
+  :rule-classes nil)
+
+(defthm land-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land k x n)
+		  (bits x (1- n) 0))))
+
+(defthm lior-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ())
+
+(defthm lior-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior k x n)
+		  (1- (expt 2 n)))))
+
+(defthm lxor-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor (1- (expt 2 n)) x n)
+		  (lnot x n)))
+  :rule-classes ())
+
+(defthm lxor-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor k x n)
+		  (lnot x n))))
+
+(defthm land-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ())
+
+(defthmd lior-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j))))
+
+(defthmd lxor-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i) (- n i)
+                       (lnot (bits x (1- i) j) (- i j)) (- i j)
+                       (bits x (1- j) 0) j))))
+
+(defthmd land-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot (lnot x n) n)
+		  x)))
+
+(defthm land-commutative
+  (equal (land y x n)
+	 (land x y n)))
+
+(defthm lior-commutative
+  (equal (lior y x n)
+	 (lior x y n)))
+
+(defthm lxor-commutative
+  (equal (lxor y x n)
+	 (lxor x y n)))
+
+(defthm land-associative
+  (equal (land (land x y n) z n)
+	 (land x (land y z n) n)))
+
+(defthm lior-associative
+  (equal (lior (lior x y n) z n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-associative
+  (equal (lxor (lxor x y n) z n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-commutative-2
+  (equal (land y (land x z n) n)
+	 (land x (land y z n) n)))
+
+(defthm lior-commutative-2
+  (equal (lior y (lior x z n) n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-commutative-2
+  (equal (lxor y (lxor x z n) n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land x (land y z n) n)
+		  (land (land x y n) z n))))
+
+(defthm lior-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior x (lior y z n) n)
+		  (lior (lior x y n) z n))))
+
+(defthm lxor-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor x (lxor y z n) n)
+		  (lxor (lxor x y n) z n))))
+
+(defthm land-self
+  (equal (land x x n)
+	 (bits x (1- n) 0)))
+
+(defthm lior-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior x x n) x)))
+
+(defthm lxor-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor x x n) 0)))
+
+(defthmd lior-land-1
+  (equal (lior x (land y z n) n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd lior-land-2
+  (equal (lior (land y z n) x n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd land-lior-1
+  (equal (land x (lior y z n) n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd land-lior-2
+  (equal (land (lior y z n) x n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd lior-land-lxor
+  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
+	 (lior (land x y n) (land (lxor x y n) z n) n)))
+
+(defthmd lxor-rewrite
+  (equal (lxor x y n)
+	 (lior (land x (lnot y n) n)
+	       (land y (lnot x n) n)
+	       n)))
+
+(defthmd lnot-lxor
+  (equal (lnot (lxor x y n) n)
+	 (lxor (lnot x n) y n)))
diff -Nru acl2-6.2/books/rtl/rel9/lib/logn2log.lisp acl2-6.3/books/rtl/rel9/lib/logn2log.lisp
--- acl2-6.2/books/rtl/rel9/lib/logn2log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/logn2log.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,82 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "log")
+(include-book "logn")
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+(defthm land-logand
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (land x y n)
+                  (logand x y))))
+
+(defthm lior-logior
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lior x y n)
+                  (logior x y))))
+
+(defthm lxor-logxor
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lxor x y n)
+                  (logxor x y))))
+
+(defthm logior-bvecp
+  (implies (and (bvecp x n) (bvecp y n))
+           (bvecp (logior x y) n)))
+           
+(defthm logand-bvecp
+  (implies (and (natp n) (bvecp x n) (integerp y))
+           (bvecp (logand x y) n)))
+
+(defthm logxor-bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (bvecp (logxor x y) n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+;; (defthm lnot-lognot
+;;   (implies (and (integerp x)
+;;                 (natp n))
+;;            (equal (lnot x n)
+;;                   (bits (lognot x) (1- n) 0)))
+;;   :hints (("Goal" :use (lnot-lognot-1))))
diff -Nru acl2-6.2/books/rtl/rel9/lib/masc.lisp acl2-6.3/books/rtl/rel9/lib/masc.lisp
--- acl2-6.2/books/rtl/rel9/lib/masc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/masc.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,340 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/lib3.delta2/masc"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                      Bit Manipulation
+;;;**********************************************************************
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defun intval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+;;CAT (concatenation):
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
+(defun setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (integerp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (integerp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits x w n n y))
+
+
+;;;**********************************************************************
+;;;                      Boolean Functions
+;;;**********************************************************************
+
+(defun log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defun log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+(defun log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defun log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defun log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defun log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+(defun logior1 (x y)
+  (if (and (equal x 0) (equal y 0)) 0 1))
+
+(defun logand1 (x y)
+  (if (or (equal x 0) (equal y 0)) 0 1))
+
+(defun lognot1 (x)
+  (if (equal x 0) 1 0))
+
+(defun true () 1)
+
+(defun false () 0)
+
+(defmacro if1 (x y z) `(if (eql ,x 0) ,z ,y))    
+
+(defmacro in-function (fn term)
+  `(if ,term () (er hard ',fn "Assertion ~x0 failed" ',term)))
+
+
+;;;**********************************************************************
+;;;                           Arrays
+;;;**********************************************************************
+
+(INCLUDE-BOOK "misc/total-order" :dir :system)
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;Basic properties of arrays:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r)))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;;We disable as and ag, assuming the rules proved in this book are 
+;;sufficient to manipulate any record terms that are encountered.
+
+(in-theory (disable as ag))
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/mult.lisp acl2-6.3/books/rtl/rel9/lib/mult.lisp
--- acl2-6.2/books/rtl/rel9/lib/mult.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/mult.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,511 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+;; From bits.lisp:
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; We define a macro, CAT, that takes a list of a list X of alternating data values 
+;; and sizes.  CAT-SIZE returns the formal sum of the sizes.  X must contain at 
+;; least 1 data/size pair, but we do not need to specify this in the guard, and 
+;; leaving it out of the guard simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+	       
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+(defun theta (i y)
+  (+ (bitn y (1- (* 2 i))) 
+     (bitn y (* 2 i))
+     (* -2 (bitn y (1+ (* 2 i))))))
+
+(defun sum-theta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta (1- m) y))
+	(sum-theta (1- m) y))))
+
+(defthm sum-theta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta m y)))
+  :rule-classes ())
+
+(defun bmux4 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (0  0)))
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+(defun pp4 (i x n)
+  (if (zerop i)
+      (cat 1 1
+	   (bitn (lognot (neg (zeta i))) 0) 1
+	   (bmux4 (zeta i) x n) n)
+    (cat 1 1
+	 (bitn (lognot (neg (zeta i))) 0) 1
+	 (bmux4 (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4 (x m n)
+  (if (zp m)
+      0
+    (+ (pp4 (1- m) x n)
+       (sum-pp4 x (1- m) n))))
+
+(defthm booth4-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4 x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ())
+
+(defun pp4-theta (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (theta i y))) 0) 1
+	    (bmux4 (theta i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (theta i y))) 0) 1
+	  (bmux4 (theta i y) x n) n
+	  0 1
+	  (neg (theta (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-theta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-theta (1- m) x y n)
+       (sum-pp4-theta x y (1- m) n))))
+
+(defthm booth4-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+(mutual-recursion
+ (defun mu (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits y (1+ (* 2 i)) (* 2 i)) (chi i y)))
+ 
+ (defun chi (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu (1- i) y) 3)
+	 1
+       0))))
+
+(defun phi (i y)
+  (if (= (bits (mu i y) 1 0) 3)
+      -1
+    (bits (mu i y) 1 0)))
+
+(defthm phi-bnd
+    (member (phi i y) '(-1 0 1 2)))
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+(defthm chi-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+  :rule-classes())
+
+(defthm phi-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi (1- m) y) 0))
+  :rule-classes())
+
+(defun sum-phi (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi (1- m) y))
+	(sum-phi (1- m) y))))
+
+(defthm sum-phi-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi m y)))
+  :rule-classes ())
+
+(defun pp4-phi (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (phi i y))) 0) 1
+	    (bmux4 (phi i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (phi i y))) 0) 1
+	  (bmux4 (phi i y) x n) n
+	  0 1
+	  (neg (phi (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-phi (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-phi (1- m) x y n)
+       (sum-pp4-phi x y (1- m) n))))
+
+(defthm static-booth
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+(defun gamma (i a b c)
+   (if (zp i)
+       (bitn c 0)
+     (logior (bitn  a (+ -1  (* 2 i)))
+ 	     (bitn  b (+ -1  (* 2 i))))))
+
+(defun delta (i a b c d)
+  (if (zp i)
+      (bitn d 0)
+    (logand (logior (logand (bitn a (+ -2 (* 2 i))) 
+			    (bitn b (+ -2 (* 2 i))))
+		    (logior (logand (bitn a (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))
+			    (logand (bitn b (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))))
+	    (lognot (logxor (bitn a (1- (* 2 i))) 
+			    (bitn b (1- (* 2 i))))))))
+
+(defun psi (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits a (1+ (* 2 i)) (* 2 i))
+       (bits b (1+ (* 2 i)) (* 2 i))
+       (gamma i a b c)
+       (delta i a b c d)
+       (* -4 (+ (gamma (1+ i) a b c)
+                (delta (1+ i) a b c d))))))
+
+(defthm psi-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))   
+		  (bvecp b (- (* 2 m) 2))  
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma m a b c) 0)
+		  (equal (delta m a b c d) 0)
+		  (>= (psi (1- m) a b c d) 0)))
+  :rule-classes ())
+
+(defun sum-psi (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi (1- m) a b c d))
+	(sum-psi (1- m) a b c d))))
+
+(defthm sum-psi-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi m a b c d)))
+  :rule-classes ())
+
+(defthmd psi-bnd
+  (and (integerp (psi i a b c d))
+       (<= (psi i a b c d) 2)
+       (>= (psi i a b c d) -2)))
+
+(defun pp4-psi (i x a b c d n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (psi i a b c d))) 0) 1
+	    (bmux4 (psi i a b c d) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (psi i a b c d))) 0) 1
+	  (bmux4 (psi i a b c d) x n) n
+	  0 1
+	  (neg (psi (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-psi (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4-psi (1- m) x a b c d n)
+       (sum-pp4-psi x a b c d (1- m) n))))
+
+(defthm redundant-booth
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+(defun eta (i y)
+  (+ (bitn y (1- (* 3 i))) 
+     (bitn y (* 3 i))
+     (* 2 (bitn y (1+ (* 3 i))))
+     (* -4 (bitn y (+ 2 (* 3 i))))))
+
+(defun sum-eta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta (1- m) y))
+	(sum-eta (1- m) y))))
+
+(defthm sum-eta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta m y)))
+  :rule-classes ())
+
+(defun bmux8 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (3  (* 3 x))
+    (-3 (bits (lognot (* 3 x)) (1- n) 0))
+    (4  (* 4 x))
+    (-4 (bits (lognot (* 4 x)) (1- n) 0))
+    (0  0)))
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+(defun pp8 (i x n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (xi i))) 0) 1
+	   (bmux8 (xi i) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (xi i))) 0) 1
+	 (bmux8 (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8 (x m n)
+  (if (zp m)
+      0
+    (+ (pp8 (1- m) x n)
+       (sum-pp8 x (1- m) n))))
+
+
+(defthm booth8-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8 x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ())
+
+(defun pp8-eta (i x y n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (eta i y))) 0) 1
+	   (bmux8 (eta i y) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (eta i y))) 0) 1
+	 (bmux8 (eta i y) x n) n
+	 0 2
+	 (neg (eta (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+(defun sum-pp8-eta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8-eta (1- m) x y n)
+       (sum-pp8-eta x y (1- m) n))))
+
+(defthm booth8-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8-eta x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/lib/openers.lisp acl2-6.3/books/rtl/rel9/lib/openers.lisp
--- acl2-6.2/books/rtl/rel9/lib/openers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/openers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,74 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/support/openers"))
+
+(program)
+
+; In this file, an event-control (evctl) data structure is either (posedge
+; clk), (negedge clk), or (even n).
+
+(defun negate-event-control (evctl)
+  (if (equal evctl '(even n))
+      (list 'not evctl)
+    (let* ((edge0 (car evctl))
+           (clk (cadr evctl))
+           (edge (case edge0
+                   (posedge 'pedge)
+                   (negedge 'nedge)
+                   (otherwise
+                    (er hard 'gen-model-preamble-common
+                        "Unable to handle edge specifier ~x0."
+                        edge0)))))
+      `(not (,edge (,clk (1- n)) (,clk n))))))
+
+(defun negate-event-control-list (x)
+  (declare (xargs :guard (true-listp x)))
+  (if (endp x)
+      nil
+    (cons (negate-event-control (car x))
+          (negate-event-control-list (cdr x)))))
+
+(defmacro def$open (name type &rest evctl-lst)
+  (if (eq type :skipped)
+      `(value-triple '(def$open ,name :skipped))
+    (let ((evctl-lst (if (eq type :input)
+                         (assert$ (null evctl-lst)
+                                  '((even n)))
+                       evctl-lst)))
+      `(defthm ,(intern-in-package-of-symbol
+                 (concatenate 'string (symbol-name name) "$OPEN")
+                 name)
+         (implies (and (integerp n)
+                       (< 0 n)
+                       ,@(negate-event-control-list evctl-lst))
+                  (equal (,name n)
+                         (,name (1- n))))
+         :hints (("Goal"
+                  :expand ((,name n)
+                           ,@(and (eq type :wire) `((,name (1- n)))))))))))
diff -Nru acl2-6.2/books/rtl/rel9/lib/package-defs.lisp acl2-6.3/books/rtl/rel9/lib/package-defs.lisp
--- acl2-6.2/books/rtl/rel9/lib/package-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/package-defs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,82 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/support/package-defs"))
+
+;;Miscellaneous symbols that are not in *acl2-exports*:
+
+(defmacro other-acl2-symbols ()
+  ''(local-defun local-defthm local-in-theory
+                 n ; clock argument
+                 defbvecp ; macro written out by compiler
+                 defclock ; macro written out by compiler
+                 defperiodic
+                 fast-clock  ;BOZO, is importing these into the packages, the right way to handle this?
+                 slow-clock-one-quantum-wide
+                 slow-clock-one-quantum-wide-shifted
+                 slow-clock-two-quanta-wide
+                 slow-clock-two-quanta-wide-shifted
+                 always-1
+                 posedge negedge edge ; for defclock macro, which we used to use
+                 pedge nedge ;for defperiodic macro
+                 $path ; path argument of signal functions
+                 sub1-induction ; for bvecp lemma hints
+                 ))
+
+;;Symbols that occur in the RTL translation.  Formerly the symbol UNKNOWN was excluded from this
+;;list so that the corresponding symbol in the "*" package could be assigned a different function
+;;definition; but the first argument of unknown can be in any package desired.
+
+(defmacro rtl-symbols ()
+  ''(log= log<> log< log<= log> log>= lnot logand1 logior1 logxor1 shft lshft
+          rshft cat mulcat bitn bits setbits setbitn mod+ mod* mod- bind
+          case-select if1 cond1 reset reset2 land lior lxor lcat n! arr0 natp1
+          as ag mk-bvarr mk-bvec ag2 as2
+          abs trunc near minf inf sticky sig expo bitvec ; appeared May 2004 (from rpl_main.cc)
+          expt ; appeared May 2004 (seems to come from r2s)
+          prop gen
+          unknown unknown2))
+
+;;Functions that are defined in the FP library:
+
+(defmacro fp-symbols ()
+  ''(natp fl cg fl-half bvecp bv-arrp sumbits sigm kap tau lamt lamg lamz lam1 lam2 lam3 lam4 lam0 lamb
+          expo sgn sig 
+          exactp fp+ bias esgnf eexpof esigf erepp eencodingp eencode edecode ndecode rebias-expo isgnf iexpof isigf 
+          nrepp drepp irepp nencodingp dencodingp iencodingp nencode dencode iencode ddecode idecode trunc away re 
+          near near-witness near+ sticky oddr kp inf minf ieee-mode-p rnd flip
+          rnd-const drnd drnd-original))
+
+;;ACL2 symbols that are imported by all packages:
+
+(defmacro shared-symbols ()
+  '(union-eq *acl2-exports*
+    (union-eq *common-lisp-symbols-from-main-lisp-package*
+     (union-eq (other-acl2-symbols)
+      (union-eq (fp-symbols)
+       (rtl-symbols))))))
diff -Nru acl2-6.2/books/rtl/rel9/lib/reps.lisp acl2-6.3/books/rtl/rel9/lib/reps.lisp
--- acl2-6.2/books/rtl/rel9/lib/reps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/reps.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,703 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+;; From bits.lisp:
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; We define a macro, CAT, that takes a list of a list X of alternating data values 
+;; and sizes.  CAT-SIZE returns the formal sum of the sizes.  X must contain at 
+;; least 1 data/size pair, but we do not need to specify this in the guard, and 
+;; leaving it out of the guard simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;; From float.lisp:
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;; Should these be disabled?
+(defun esgnf  (x p q) (bitn x (+ p q)))
+(defun eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defun esigf  (x p)   (bits x (1- p) 0))
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+(defthm eencodingp-not-zero
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode x p q) 0))))
+
+(defthm erepp-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode x p q) p q)))
+
+(defthm eencodingp-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp (eencode x p q) p q) ))
+
+(defthm edecode-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode (eencode x p q) p q)
+		    x)))
+
+(defthm eencode-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode (edecode x p q) p q)
+		    x)))
+
+(defthm expo-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode x p q))
+		    (- (eexpof x p q) (bias q)))))
+
+(defthm sgn-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode  x p q))
+		    (if (= (esgnf x p q) 0) 1 -1))))
+
+(defthm sig-edecode
+    (implies (and (eencodingp  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode  x p q))
+		    (/ (esigf x p) (expt 2 (- p 1))))))
+
+(defund rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthmd rebias-lower
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m)))))
+
+(defthmd rebias-higher
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (bitn (lognot x) (1- m)))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m)))))
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(defund iencodingp (x p q)
+  (or (nencodingp x p q)
+      (dencodingp x p q)))
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp-and-dencodingp
+    (implies (iencodingp x p q)
+	     (iff (nencodingp x p q) (not (dencodingp x p q))))
+  :rule-classes ())
+
+
+;;Encoding functions:
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(defund iencode (x p q)
+  (cond ((nrepp x p q)
+	 (nencode x p q))
+	((drepp x p q)
+	 (dencode x p q))))
+
+
+;;Decoding functions:
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(defund idecode (x p q)
+  (cond ((nencodingp x p q)
+	 (ndecode x p q))
+	((dencodingp x p q)
+	 (ddecode x p q))))
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+(defthm sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+(defthm sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+(defthm sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+(defthm sgn-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode x p q))
+	      (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode x p q))
+	      (cond ((nencodingp x p q)
+		     (- (iexpof x p q) (bias q)))         
+		    ((dencodingp x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))))
+
+(defthm sig-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode x p q))
+		    (cond ((nencodingp x p q)
+			   (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
+			  ((dencodingp x p q)
+			   (sig (isigf x p)))))))
+
+;;Inversions:
+
+(defthm dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+(defthm iencodingp-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp (iencode x p q) p q)))
+
+(defthm nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+(defthm drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+(defthm irepp-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode x p q) p q)))
+
+(defthm nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+(defthm ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+(defthm ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+(defthm idecode-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode (iencode x p q) p q)
+		    x)))
+
+(defthm nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+(defthm dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+(defthm iencode-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode (idecode x p q) p q)
+		    x)))
+
+;; Smallest positive normal:
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+;; Smallest positive denormal:
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q)))) 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
diff -Nru acl2-6.2/books/rtl/rel9/lib/rom-helpers.lisp acl2-6.3/books/rtl/rel9/lib/rom-helpers.lisp
--- acl2-6.2/books/rtl/rel9/lib/rom-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/rom-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,64 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/support/rom-helpers"))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+(local (in-theory (enable bvecp)))
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(defun check-array (name a dim1 dim2)
+  (if (zp dim1)
+      t
+    (and (bvecp (aref1 name a (1- dim1)) dim2)
+	 (check-array name a (1- dim1) dim2))))
+
+(defthm check-array-lemma-1
+    (implies (and (not (zp dim1))
+		  (check-array name a dim1 dim2)
+		  (natp i)
+		  (< i dim1))
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+(defthm check-array-lemma
+    (implies (and (bvecp i n)
+		  (not (zp (expt 2 n)))
+		  (check-array name a (expt 2 n) dim2))		  
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/round.lisp acl2-6.3/books/rtl/rel9/lib/round.lisp
--- acl2-6.2/books/rtl/rel9/lib/round.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/round.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1666 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+;; From bits.lisp:
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+;; From float.lisp:
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+;; From reps.lisp:
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ())
+
+(defthm trunc-logand
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) ;(> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0))
+           (= (trunc x k)
+              (logand x (- (expt 2 m) (expt 2 (- n k))))))
+  :rule-classes ())
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m)))))))
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-is-common-rounding
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode))
+  :hints (("Goal" :in-theory (enable common-rounding-mode-p))))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+(defun roundup (x mode n)
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ())
+  
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/lib/rtl.lisp acl2-6.3/books/rtl/rel9/lib/rtl.lisp
--- acl2-6.2/books/rtl/rel9/lib/rtl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/rtl.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,700 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;This book contains definitions of the ACL2 functions that are used in the
+;;formalization of RTL semantics.
+
+	       
+;;Bit-vector access:
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;;LNOT (bitwise complement):
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+;LAND (bitwise and):
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec ; (land0 x y n)
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land)) to refer to binary-land.
+(add-macro-alias land binary-land)
+
+;;LIOR (bitwise inclusive or):
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec ; (lior0 x y n)
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior)) to refer to binary-lior:
+(add-macro-alias lior binary-lior)
+
+;;LXOR (bitwise exclusive or):
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor0 x y n)
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
+(add-macro-alias lxor binary-lxor)
+
+
+;;Bit-vector update:
+
+; We have decided to allow setbits to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits x w n n y))
+
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;;Signed inequalities:
+
+(defund comp2 (x n)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;;Unary logical operations:
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;;Shifting operations:
+
+(defund shft (x s l)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;;Arithmetic operations
+
+(defmacro mod+ (x y n)
+  `(bits (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod* (x y n)
+  `(bits (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
+i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
+get rid of the bits call.
+|#
+
+(defmacro mod- (x y n)
+  `(bits (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still
+;; need to add assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+
+;;Evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO Where in lib/ should these go?
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;;Natural number recognizer
+
+(defund natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(defund bvecp (x k)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+(defun mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+
+; Finally, we include bvecp (and, occasionally, related) lemmas for several
+; functions that are disabled.  These are not included elsewhere, presumably
+; because the functions will generally be enabled (hence blown away) by the
+; user.
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (shft x s n) k)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+;;The definitions of these functions are best disabled:
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable mk-bvec))
+(in-theory (disable if1))
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/rtlarr.lisp acl2-6.3/books/rtl/rel9/lib/rtlarr.lisp
--- acl2-6.2/books/rtl/rel9/lib/rtlarr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/rtlarr.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,256 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+;;We define generic record accessing and updating functions to be used 
+;;with RTL arrays.  The basic functions are (ag a r) and (as a v r)
+;;where a is an array index, v is a value, r is an "array" or record.
+;;(ag a r) returns the value at index a in array r, and (as a v r) returns 
+;;a new array with index a set to value v in array r.
+
+(include-book "misc/total-order" :dir :system)
+
+(include-book "rtl")
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;Basic properties of arrays:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r)))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;; OK, we add here some properties for typing the records and the values which
+;; are stored in the records. This "typing" is pretty generic, but we choose the
+;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
+
+(defun bv-arrp (x k)
+  (declare (xargs :guard (integerp k)))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (bv-arrp (cdr x) k)
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (bvecp (cdar x) k)
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm as-maps-bv-arr-to-bv-arr
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as a v r) k)))
+
+(defthm ag-maps-bv-arr-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag a r) k)))
+
+(defun mk-bvarr (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bv-arrp r k) r ()))
+
+(defthm mk-bvarr-is-bv-arrp
+  (bv-arrp (mk-bvarr r k) k))
+
+(defthm mk-bvarr-identity
+  (implies (bv-arrp r k)
+           (equal (mk-bvarr r k) r)))
+
+(in-theory (disable bv-arrp mk-bvarr))
+
+;;We also define as2 and ag2 for 2-dimensional arrays but these simply
+;;macro-expand into appropriate as and ag calls.
+
+(defmacro ag2 (a b r)
+  `(ag (cons ,a ,b) ,r))
+
+(defmacro as2 (a b v r)
+  `(as (cons ,a ,b) ,v ,r))
+
+
+;;We disable as and ag, assuming the rules proved in this book are 
+;;sufficient to manipulate any record terms that are encountered.
+
+(in-theory (disable as ag))
+
+(defun positive-integer-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (equal l nil))
+        (t (and (integerp (car l))
+                (< 0 (car l))
+                (positive-integer-listp (cdr l))))))
+
+(defmacro arr0 (&rest dims)
+  (declare (ignore dims)
+           (xargs :guard (positive-integer-listp dims)))
+  nil)
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(encapsulate 
+ ((reset2 (key size) t))
+ (local (defun reset2 (key size) (declare (ignore key size)) nil))
+ (defthm bv-arrp-reset2
+   (bv-arrp (reset2 key size) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+(encapsulate 
+ ((unknown2 (key size n) t))
+ (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
+ (defthm bv-arrp-unknown2
+   (bv-arrp (unknown2 key size n) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+;BOZO where in lib/ should this go?
+(defthm bv-arrp-if1
+  (equal (bv-arrp (if1 x y z) n)
+         (if1 x (bv-arrp y n) (bv-arrp z n))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel9/lib/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel9/lib/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/simple-loop-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,358 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(include-book "bits")
+(include-book "log")
+(include-book "../arithmetic/top")
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I)))
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+
+;; (defthm bitn-setbitn-setbitn
+;;   (implies (and (<  j w)
+;;                 (<= 0 j) 
+;;                 (integerp w)
+;;                 (integerp j))
+;;            (equal (bitn (setbitn x w j y)
+;;                         j)
+;;                   (bitn y 0))))
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;not in support/simple-loop-helpers since would be redefined here (which is illegal)
+
+(deftheory simple-loop-thy-0
+  (union-theories '(if1) (theory 'minimal-theory)))
+
+(deftheory simple-loop-thy-1
+  (union-theories
+   '(bitn-setbitn-not-equal
+     ag-diff-as
+     bits-31-0
+     natp)
+   (theory 'simple-loop-thy-0)))
+
+(in-theory (enable setbits bitn-cat))
diff -Nru acl2-6.2/books/rtl/rel9/lib/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel9/lib/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/lib/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/simplify-model-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,118 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+;(include-book "arith")
+(include-book "bits")
+(local (include-book "../support/top/top"))
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1)))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(defthm cat-bitn-m-equal-cat-bitn-1
+  (implies (and (syntaxp (and (quote m)
+                              (natp (cadr m))
+                              (> (cadr m) 1)))
+                (natp m)
+                (> m 1))
+           (equal (cat (bitn x i) m y n)
+                  (cat (bitn x i) 1 y n))))
+
+(in-theory (enable bvecp-monotone))
+(in-theory (enable bvecp-bits-0))
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/sqrt.lisp acl2-6.3/books/rtl/rel9/lib/sqrt.lisp
--- acl2-6.2/books/rtl/rel9/lib/sqrt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/sqrt.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,374 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+;; From float.lisp:
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+;; From round.lisp:
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defun re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defund inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+(defund minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defund common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+
+;;;**********************************************************************
+;;;		    	      SQRT66
+;;;**********************************************************************
+
+(defund trunc-sqrt (x n)
+  (if (zp n)
+      0
+    (let* ((lower (trunc-sqrt x (1- n)))
+           (upper (+ lower (expt 2 (- n)))))
+      (if (<= (* upper upper) x)
+          upper
+        lower))))
+
+(defund sticky-sqrt (x n)
+  (let ((trunc (trunc-sqrt x (1- n))))
+    (if (< (* trunc trunc) x)
+        (+ trunc (expt 2 (- n)))
+      trunc)))
+
+(defund sqrt66 (x)
+  (let ((e (1+ (fl (/ (expo x) 2)))))
+    (* (expt 2 e)
+       (sticky-sqrt (/ x (expt 2 (* 2 e))) 66))))
+
+(defthmd sqrt66-pos
+  (implies (and (rationalp x)
+                (> x 0))
+           (> (sqrt66 x) 0)))
+
+(defthmd sqrt66-shift
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n))
+           (equal (sqrt66 (* (expt 2 (* 2 n)) x))
+                  (* (expt 2 n) (sqrt66 x)))))
+
+(defthm trunc-sqrt-bounds
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n)))
+           (and (<= 1/2 (trunc-sqrt x n))
+                (<= (trunc-sqrt x n) (- 1 (expt 2 (- n))))))
+  :rule-classes ())                                
+
+(defthm expo-trunc-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n)))
+           (equal (expo (trunc-sqrt x n))
+                  -1)))
+
+(defthm exactp-trunc-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n)))
+           (exactp (trunc-sqrt x n)
+                   n))
+  :rule-classes ())
+
+(defthmd trunc-trunc-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp m))
+                (natp n)
+                (>= n m))
+           (equal (trunc (trunc-sqrt x n) m)
+                  (trunc-sqrt x m))))
+
+(defthm trunc-sqrt-square-bounds
+  (implies (and (not (zp n))
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))                
+           (and (<= (* (trunc-sqrt x n)
+                       (trunc-sqrt x n))
+                    x)
+                (< x
+                   (* (+ (trunc-sqrt x n) (expt 2 (- n)))
+                      (+ (trunc-sqrt x n) (expt 2 (- n)))))))
+  :rule-classes ())
+
+(defthm trunc-sqrt-unique
+  (implies (and (not (zp n))
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp a)
+                (exactp a n)
+                (>= a 1/2)
+                (<= (* a a) x)
+                (< x (* (+ a (expt 2 (- n))) (+ a (expt 2 (- n))))))
+           (= a (trunc-sqrt x n)))
+  :rule-classes ())
+
+(defthm sticky-sqrt-bounds
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (natp n)
+                (>= n 2))
+           (and (<= 1/2 (sticky-sqrt x n))
+                (< (sticky-sqrt x n) 1)))
+  :rule-classes ())
+
+(defthm expo-sticky-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (natp n)
+                (>= n 2))
+           (equal (expo (sticky-sqrt x n))
+                  -1)))
+
+(defthmd exactp-sticky-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (natp n)
+                (>= n 2))
+           (exactp (sticky-sqrt x n) n)))
+
+(defthm sticky-sqrt-lower
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x))
+           (<= (sticky l n)
+               (sticky-sqrt x n)))
+  :rule-classes ())
+
+(defthm sticky-sqrt-upper
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x))
+           (>= (sticky h n)
+               (sticky-sqrt x n)))
+  :rule-classes ())
+
+(defthmd sticky-sticky-sqrt
+  (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (>= m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (equal (sticky (sticky-sqrt x m) n)
+                  (sticky-sqrt x n))))
+
+(defthm rnd-sticky-sqrt
+  (implies (and (not (zp k))
+                (natp n)
+                (>= n (+ k 2))
+                (natp m)
+                (>= m n)
+                (common-rounding-mode-p mode)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (= (rnd (sticky-sqrt x m) mode k)
+              (rnd (sticky-sqrt x n) mode k)))
+  :rule-classes ())
+
+(defthmd trunc-sticky-sqrt
+  (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (> m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (equal (trunc (sticky-sqrt x m) n)
+                  (trunc-sqrt x n))))
+
+(defthm trunc-trunc-sticky
+   (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (> m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)) 
+           (iff (= (* (trunc-sqrt x n) (trunc-sqrt x n)) x)
+                (= (sticky-sqrt x m) (trunc-sqrt x n))))
+  :rule-classes ())
+
+(defthmd sqrt66-sticky-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (equal (sqrt66 x)
+                  (sticky-sqrt x 66))))
+
+(defthm sqrt66-lower
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp l)
+                (<= (* l l) x)
+                (common-rounding-mode-p mode)
+                (not (zp k))
+                (<= k 64))
+           (<= (rnd l mode k)
+               (rnd (sqrt66 x) mode k)))
+  :rule-classes ())
+
+(defthm sqrt66-upper
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (common-rounding-mode-p mode)
+                (not (zp k))
+                (<= k 64))
+           (>= (rnd h mode k)
+               (rnd (sqrt66 x) mode k)))
+  :rule-classes ())
+
+(defthm rnd-sqrt66-sticky-sqrt
+  (implies (and (rationalp x)
+                (> x 0)
+                (common-rounding-mode-p mode)
+                (not (zp k))
+                (natp n)
+                (>= n (+ k 2))
+                (<= n 66))
+           (let* ((e (1+ (fl (/ (expo x) 2))))
+                  (x0 (/ x (expt 2 (* 2 e)))))
+             (= (* (expt 2 e) (rnd (sticky-sqrt x0 n) mode k))
+                (rnd (sqrt66 x) mode k))))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/srt.lisp acl2-6.3/books/rtl/rel9/lib/srt.lisp
--- acl2-6.2/books/rtl/rel9/lib/srt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/srt.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1677 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;; From basic.lisp:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+;; From bits.lisp:
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+
+;;**********************************************************************************
+;; Formula for Division Partial Remainder
+;;**********************************************************************************
+
+(encapsulate (((rho$) => *) ((x$) => *) ((d$) => *) ((h$ *) => *))
+  (local (defun rho$ () 1))
+  (local (defun x$ () 0))
+  (local (defun d$ () 1))
+  (local (defun h$ (k) (declare (ignore k)) 0))
+  (defthm rho$-constraint
+    (integerp (rho$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm x$-constraint
+    (rationalp (x$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm d$-constraint
+    (and (rationalp (d$))
+         (> (d$) 0))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm integerp-h$ 
+    (implies (not (zp k))
+             (integerp (h$ k)))
+    :rule-classes (:rewrite :type-prescription)))
+
+(defund p$ (k) 
+  (if (zp k)
+      (x$)
+    (- (* (expt 2 (rho$)) (p$ (1- k)))
+       (* (h$ k) (d$)))))
+
+(defund q$ (k)
+  (if (zp k)
+      0
+    (+ (q$ (1- k))
+       (/ (h$ k) (expt 2 (* k (rho$)))))))
+
+(defthmd div-remainder-formula
+  (implies (natp k)
+           (equal (p$ k)
+                  (* (expt 2 (* k (rho$)))
+                     (- (x$) (* (q$ k) (d$)))))))
+
+(defthm div-remainder-formula-corollary
+  (implies (and (natp k)
+                (<= (- (d$)) (p$ k))
+                (< (p$ k) (d$)))
+           (and (<= (- (/ (expt 2 (* k (rho$)))))
+                    (- (/ (x$) (d$)) (q$ k)))
+                (< (- (/ (x$) (d$)) (q$ k))
+                   (/ (expt 2 (* k (rho$))))))) 
+  :rule-classes ())
+
+
+;;**********************************************************************************
+;; admissible-div-table-p
+;;**********************************************************************************
+
+(defund delta0 (j n)
+  (1+ (/ j (expt 2 n))))
+
+(defund pi0 (i m)
+  (if (< i (expt 2 (1- m)))
+      (/ i (expt 2 (- m 2)))
+    (- (/ i (expt 2 (- m 2)))
+       4)))
+
+(defund div-accessible-p (i j m n)
+  (and (< (- (- (delta0 j n)) (+ (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n))))))
+
+(defund lower (i j rho m n)
+  (min (1- (expt 2 rho))
+       (if (or (< i (expt 2 (1- m)))
+               (= i (1- (expt 2 m))))
+           (1- (cg (* (expt 2 rho) 
+                      (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                         (delta0 j n)))))
+         (1- (cg (* (expt 2 rho) 
+                    (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                       (+ (delta0 j n) (/ (expt 2 n))))))))))
+
+(defund upper (i j rho m n)
+  (max (- 1 (expt 2 rho)) 
+       (if (< i (expt 2 (1- m)))
+           (1+ (fl (* (expt 2 rho) 
+                      (/ (pi0 i m)
+                         (+ (delta0 j n) (/ (expt 2 n)))))))
+         (1+ (fl (* (expt 2 rho) 
+                    (/ (pi0 i m)
+                       (delta0 j n))))))))
+
+(defund lookup (i j table)
+  (ifix (nth j (nth i table))))
+
+(defund check-div-entry (i j rho m n entry)
+  (or (not (div-accessible-p i j m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (<= (lower i j rho m n)
+               entry)
+           (<= entry
+               (upper i j rho m n)))))
+
+(defund check-div-row (i j rho m n row)
+  (if (zp j)
+      t
+    (and (check-div-entry i (1- j) rho m n (ifix (nth (1- j) row)))
+         (check-div-row i (1- j) rho m n row))))
+
+(defund check-div-rows (i rho m n rows)
+  (if (zp i)
+      t
+    (and (check-div-row (1- i) (expt 2 n) rho m n (nth (1- i) rows))
+         (check-div-rows (1- i) rho m n rows))))
+
+(defund admissible-div-table-p (rho m n table)
+  (check-div-rows (expt 2 m) rho m n table))
+
+;;**********************************************************************************
+;; First we prove that the definition of admissibility ensures the desired property.
+;;**********************************************************************************
+
+(defthm admissible-div-table-criterion
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (rationalp p)
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (rationalp d)
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (<= (- d) p) 
+                (< p d)
+                (= k (lookup i j table)))
+           (and (< (- (expt 2 rho)) k)
+                (< k (expt 2 rho))
+                (<= (- d) (- (* (expt 2 rho) p) (* d k)))
+                (< (- (* (expt 2 rho) p) (* d k)) d)))
+  :rule-classes ())
+
+
+;;**********************************************************************************
+;; Next we prove the converse of the above. This requires that we define witness
+;; functions that produce a violation of the desired property for a given table that
+;; fails to satisfy the definition.
+;;**********************************************************************************
+
+;; Assume that dmin < dmax and pmin < pmax.  Consider the closed rectangle
+;;   R = {(d,p) | dmin <= d <= dmax and pmin <= p <= pmax}
+;; and the halh-open rectangle
+;;   R' = {(d,p) | dmin <= d < dmax and pmin <= p < pmax}.
+;; If there exists (d,p) in R such that p < h*d, then (d1,p1) is a point
+;; in R' with p1 < h*d1:
+
+(defund d1 (dmin pmin dmax pmax h)
+  (declare (ignore pmax))
+  (if (< pmin (* h dmin))
+      dmin
+    (/ (+ (/ pmin h) dmax) 2)))
+
+(defund p1 (dmin pmin dmax pmax h)
+  (declare (ignore dmin dmax pmax h))
+  pmin)
+
+;; If there exists (d,p) in R such that p > h*d, then (d2,p2) is a point
+;; in R' with p1 > h*d1:
+
+(defund d2 (dmin pmin dmax pmax h)
+  (declare (ignore pmin))
+  (if (> pmax (* h dmin))
+      dmin
+    (/ (+ (/ pmax h) dmax) 2)))
+
+(defund p2 (dmin pmin dmax pmax h)
+  (let ((d2 (d2 dmin pmin dmax pmax h)))
+    (if (> pmin (* h d2))
+        pmin
+      (/ (+ (* h d2) pmax) 2))))
+
+;; If (d1,p1) and (d2,p2) are in points in R' such that p1 < h*d1 and
+;; p2 > h*d2, then (d3,p3) is in R' and p3 = h*d3:
+
+(defund d3 (d1 p1 d2 p2 h)
+  (if (= h 0)
+      d1
+    (if (<= p1 p2)
+        (if (<= p2 (* h d1))
+            (/ p2 h)
+          d1)
+      (if (<= p1 (* h d2))          
+          d2
+        (/ p1 h)))))
+
+(defund p3 (d1 p1 d2 p2 h)
+  (if (= h 0)
+      0
+    (if (<= p1 p2)
+        (if (<= p2 (* h d1))
+            p2
+          (* h d1))
+      (if (<= p1 (* h d2))
+          (* h d2)
+        p1))))
+
+;; Assume hmin < hmax.  If there exist (d1,p1) and (d2,p2) in R such 
+;; that p1 < hmax*d1 and p2 > hmin*d2, then (d4,p4) is in R' and 
+;; hmin*d4 < p4 < hmax*d4:
+
+(defund d4 (dmin pmin dmax pmax hmin hmax)
+  (let ((d1 (d1 dmin pmin dmax pmax hmax))
+        (p1 (p1 dmin pmin dmax pmax hmax)))
+    (if (> p1 (* hmin d1))
+        d1
+      (let ((d2 (d2 dmin pmin dmax pmax hmin))
+            (p2 (p2 dmin pmin dmax pmax hmin)))
+        (if (< p2 (* hmax d2))
+            d2
+          (d3 d1 p1 d2 p2 (/ (+ hmin hmax) 2)))))))
+
+(defund p4 (dmin pmin dmax pmax hmin hmax)
+  (let ((d1 (d1 dmin pmin dmax pmax hmax))
+        (p1 (p1 dmin pmin dmax pmax hmax)))
+    (if (> p1 (* hmin d1))
+        p1
+      (let ((d2 (d2 dmin pmin dmax pmax hmin))
+            (p2 (p2 dmin pmin dmax pmax hmin)))
+        (if (< p2 (* hmax d2))
+            p2
+          (p3 d1 p1 d2 p2 (/ (+ hmin hmax) 2)))))))
+
+;; Suppose that admissible-div-table-p rho m n table) = NIL.
+;; Let i = (i-witness rho m n table), j = (j-witness rho m n table),
+;; and entry = (nth j (nth i table)
+;; Then 0 <= i < 2^m, 0 <= j < 2^n, and
+;; (check-div-entry i j rho m n entry) = NIL.
+;; Let d = (d-witness rho m n table) and p = (p-witness rho m n table).
+;; If -2^rho < entry < 2^rho, then (d,p) is in S_ij, |p| <= d, and
+;;   |2^rho * p - entry * d| > d:
+
+(defund i-witness-aux (i rho m n table)
+  (if (zp i)
+      ()
+    (if (check-div-row (1- i) (expt 2 n) rho m n (nth (1- i) table))
+        (i-witness-aux (1- i) rho m n table)
+      (1- i))))
+ 
+(defund i-witness (rho m n table)
+  (i-witness-aux (expt 2 m) rho m n table))
+
+(defund j-witness-aux (i j rho m n row)
+  (if (zp j)
+      ()
+    (if (check-div-entry i (1- j) rho m n (ifix (nth (1- j) row)))
+        (j-witness-aux i (1- j) rho m n row)
+      (1- j))))
+
+(defund j-witness (rho m n table)
+  (let ((i (i-witness rho m n table)))
+    (j-witness-aux i (expt 2 n) rho m n (nth i table))))
+
+(defund d-witness (rho m n table)
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (entry (lookup i j table)))
+    (if (or (>= entry (expt 2 rho))
+            (<= entry (- (expt 2 rho))))
+        (d4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            1)
+      (if (< entry (lower i j rho m n))
+          (d4 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              (/ (1+ entry) (expt 2 rho))
+              1)
+        (d4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            (/ (1- entry) (expt 2 rho)))))))
+
+(defund p-witness (rho m n table)
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (entry (lookup i j table)))
+    (if (or (>= entry (expt 2 rho))
+            (<= entry (- (expt 2 rho))))
+        (p4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            1)
+      (if (< entry (lower i j rho m n))
+          (p4 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              (/ (1+ entry) (expt 2 rho))
+              1)
+        (p4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            (/ (1- entry) (expt 2 rho)))))))
+
+(defthm admissible-div-table-criterion-converse
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (not (admissible-div-table-p rho m n table)))
+             (let* ((i (i-witness rho m n table))
+                    (j (j-witness rho m n table))
+                    (p (p-witness rho m n table))
+                    (d (d-witness rho m n table))
+                    (k (lookup i j table)))
+               (and (natp i)
+                    (< i (expt 2 m))
+                    (natp j)
+                    (< j (expt 2 n))
+                    (rationalp d)
+                    (rationalp p)
+                    (< (abs p) d)
+                    (<= (delta0 j n) d)
+                    (< d (+ (delta0 j n) (/ (expt 2 n))))
+                    (<= (pi0 i m) p)
+                    (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                    (or (<= k (- (expt 2 rho)))
+                        (>= k (expt 2 rho))
+                        (> (abs (- (* (expt 2 rho) p) (* d k))) d)))))
+  :rule-classes ())
+
+;;**********************************************************************************
+;; Existence of SRT Table for Division
+;;**********************************************************************************
+
+(defund srt-entry (i j rho m n)
+  (max (- 1 (expt 2 rho)) 
+       (lower i j rho m n)))
+
+(defund srt-row (i j rho m n)
+  (declare (xargs :measure (nfix (- (expt 2 n) j))))
+  (if (and (natp j)
+           (natp n)
+           (< j (expt 2 n)))
+      (cons (srt-entry i j rho m n)
+            (srt-row i (1+ j) rho m n))
+    ()))
+
+(defund srt-rows (i rho m n)
+  (declare (xargs :measure (nfix (- (expt 2 m) i))))
+  (if (and (natp i)
+           (natp m)
+           (< i (expt 2 m)))
+      (cons (srt-row i 0 rho m n)
+            (srt-rows (1+ i) rho m n))
+    ()))
+
+(defund srt-table (rho m n)
+  (srt-rows 0 rho m n))
+
+(defthm admissible-div-table-p-2-5-2
+  (admissible-div-table-p 2 5 2 (srt-table 2 5 2))
+  :rule-classes ())
+
+(defthm admissible-div-table-p-3-7-3
+  (admissible-div-table-p 3 7 3 (srt-table 3 7 3))
+  :rule-classes ())
+
+(defund check-exists-div-entry (i j rho m n)
+  (or (not (div-accessible-p i j m n))
+      (<= (lower i j rho m n)
+          (upper i j rho m n))))
+
+(defund check-exists-div-row (i j rho m n)
+  (if (zp j)
+      t
+    (and (check-exists-div-entry i (1- j) rho m n)
+         (check-exists-div-row i (1- j) rho m n))))
+
+(defund check-exists-div-rows (i rho m n)
+  (if (zp i)
+      t
+    (and (check-exists-div-row (1- i) (expt 2 n) rho m n)
+         (check-exists-div-rows (1- i) rho m n))))
+
+(defund exists-div-table-p (rho m n)
+  (check-exists-div-rows (expt 2 m) rho m n))
+
+(defthm div-table-existence-a
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (exists-div-table-p rho m n))
+           (admissible-div-table-p rho m n (srt-table rho m n))))
+
+(defthm div-table-existence-b
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (admissible-div-table-p rho m n table))
+           (exists-div-table-p rho m n)))
+
+
+;;**********************************************************************************
+;; Main Theorem on Division
+;;**********************************************************************************
+
+(encapsulate (((rho%) => *) ((m%) => *) ((n%) => *) ((table%) => *) ((d%) => *) ((x%) => *) ((j%) => *)
+              ((p% *) => *) ((h% *) => *) ((i% *) => *))
+
+(local (defun rho% () 2))
+(local (defun m% () 5))
+(local (defun n% () 2))
+(local (defun table% () (srt-table 2 5 2)))
+(local (defun d% () 1))
+(local (defun x% () 0))
+(local (defun j% () (fl (* (expt 2 (n%)) (1- (d%))))))
+
+(local (mutual-recursion
+
+(defun p% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      (x%)
+    (- (* (expt 2 (rho%)) (p% (1- k)))
+       (* (h% k) (d%)))))
+
+(defun h% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 1)))
+  (lookup (i% k) (j%) (table%)))
+
+(defun i% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (bits (fl (* (expt 2 (- (m%) 2)) (p% (1- k)))) (1- (m%)) 0)))
+))
+
+(defthmd rho%-constraint
+  (not (zp (rho%))))
+
+(defthmd m%-constraint
+  (not (zp (m%))))
+
+(defthmd n%-constraint
+  (not (zp (n%))))
+
+(defthmd table%-constraint
+  (admissible-div-table-p (rho%) (m%) (n%) (table%)))
+
+(defthmd d%-constraint
+  (and (rationalp (d%))
+       (<= 1 (d%))
+       (< (d%) 2)))
+
+(defthmd x%-constraint
+  (and (rationalp (x%))
+       (< (abs (x%)) (d%))))
+
+(defthmd p%-def
+  (equal (p% k)
+         (if (zp k)
+             (x%)
+           (- (* (expt 2 (rho%)) (p% (1- k)))
+              (* (h% k) (d%)))))
+  :rule-classes (:definition))
+
+(defthmd h%-def
+  (equal (h% k)
+         (lookup (i% k) (j%) (table%)))
+  :rule-classes (:definition))
+
+(defthmd i%-constraint
+  (implies (and (not (zp k))
+                (rationalp (p% (1- k)))
+                (< (abs (p% (1- k))) 2))
+           (and (bvecp (i% k) (m%))
+                (<= (pi0 (i% k) (m%))
+                    (p% (1- k)))
+                (< (p% (1- k))
+                   (+ (pi0 (i% k) (m%))
+                      (/ (expt 2 (- (m%) 3)))))))
+  :hints (("Goal" :use ((:instance i-bounds (p (p% (1- k))) (m (m%)))))))
+
+(defthmd j%-constraint
+  (and (bvecp (j%) (n%))
+       (<= (delta0 (j%) (n%)) (d%))
+       (< (d%) (+ (delta0 (j%) (n%)) (expt 2 (- (n%))))))
+  :hints (("Goal" :use ((:instance j-bounds (d (d%)) (n (n%)))))))
+
+)
+
+(defund q% (k)
+  (if (zp k)
+      0
+    (+ (q% (1- k))
+       (/ (h% k) (expt 2 (* k (rho%)))))))
+
+(defthm srt-div-theorem-a
+  (implies (natp k)
+           (and (<= (- (/ (expt 2 (* k (rho%)))))
+                    (- (/ (x%) (d%)) (q% k)))
+                (< (- (/ (x%) (d%)) (q% k))
+                   (/ (expt 2 (* k (rho%)))))))
+  :rule-classes ())
+
+(defthm srt-div-theorem-b
+  (< (abs (p% k)) 2)
+  :rule-classes ())
+
+(defthm srt-div-theorem-c
+  (implies (not (zp k))
+           (div-accessible-p (i% k) (j%) (m%) (n%)))
+  :rule-classes ())
+
+
+;;**********************************************************************************
+;; Formula for Square Root Partial Remainder
+;;**********************************************************************************
+
+(encapsulate (((rho$$) => *) ((x$$) => *) ((h$$ *) => *))
+  (local (defun rho$$ () 1))
+  (local (defun x$$ () 0))
+  (local (defun h$$ (k) (declare (ignore k)) 0))
+  (defthm rho$$-constraint
+    (integerp (rho$$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm x$$-constraint
+    (rationalp (x$$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm integerp-h$$ 
+    (implies (not (zp k))
+             (integerp (h$$ k)))
+    :rule-classes (:rewrite :type-prescription)))
+
+(defund q$$ (k)
+  (if (zp k)
+      0
+    (+ (q$$ (1- k))
+       (/ (h$$ k) (expt 2 (* k (rho$$)))))))
+
+(defund p$$ (k) 
+  (if (zp k)
+      (x$$)
+    (- (* (expt 2 (rho$$)) (p$$ (1- k)))
+       (* (h$$ k) 
+          (+ (* 2 (q$$ (1- k))) 
+             (/ (h$$ k) (expt 2 (* k (rho$$)))))))))
+
+(defthmd sqrt-remainder-formula
+  (implies (natp k)
+           (equal (p$$ k)
+                  (* (expt 2 (* k (rho$$)))
+                     (- (x$$) (* (q$$ k) (q$$ k)))))))
+
+;;**********************************************************************************
+;; Equivalent Bounds on Partial Remainder
+;;**********************************************************************************
+
+(defthm equiv-bounds-a-b
+  (implies (not (zp k))
+           (iff (and (<= (* (- (q$$ k) (expt 2 (- (* k (rho$$))))) (- (q$$ k) (expt 2 (- (* k (rho$$))))))
+                         (x$$))
+                     (< (x$$)
+                        (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) (+ (q$$ k) (expt 2 (- (* k (rho$$))))))))
+                (and (<= (- (* 2 (q$$ k)))
+                         (- (p$$ k) (expt 2 (- (* k (rho$$))))))
+                     (< (- (p$$ k) (expt 2 (- (* k (rho$$)))))
+                        (* 2 (q$$ k))))))
+  :rule-classes ())
+
+(defthm equiv-bounds-b-c
+  (implies (not (zp k))
+           (iff (and (<= (- (* 2 (q$$ k)))
+                         (- (p$$ k) (expt 2 (- (* k (rho$$))))))
+                     (< (- (p$$ k) (expt 2 (- (* k (rho$$)))))
+                        (* 2 (q$$ k))))
+                (and (<= (* (expt 2 (- (rho$$)))
+                            (1- (h$$ k))
+                            (+ (* 2 (q$$ (1- k)))
+                               (* (1- (h$$ k)) (expt 2 (- (* k (rho$$)))))))
+                         (p$$ (1- k)))
+                     (< (p$$ (1- k))
+                        (* (expt 2 (- (rho$$)))
+                           (1+ (h$$ k))
+                           (+ (* 2 (q$$ (1- k)))
+                              (* (1+ (h$$ k)) (expt 2 (- (* k (rho$$)))))))))))
+  :rule-classes ())
+
+
+;;**********************************************************************************
+;; Lemma 3.3
+;;**********************************************************************************
+
+(defthm sqrt-partial-remainder-bounds
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (<= (* (- (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))) (- (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))))
+                    (x$$))
+                (< (x$$)
+                   (* (+ (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))) (+ (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))))))
+           (< (abs (p$$ (1- k))) 2))
+  :rule-classes())
+
+(defthm partial-root-bounds
+  (implies (and (not (zp (rho$$)))
+                (> (x$$) 1/4)
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (< (h$$ k) (expt 2 (rho$$)))
+                (> (h$$ k) (- (expt 2 (rho$$))))
+                (<= (x$$) (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) 
+                             (+ (q$$ k) (expt 2 (- (* k (rho$$))))))))
+           (and (<= 1/2 (q$$ k))
+                (< (q$$ k) 1)))
+  :rule-classes())
+
+
+;;**********************************************************************************
+;; admissible-for-iteration-p
+;;**********************************************************************************
+
+(defund sqrt-accessible-p (i j k rho m n)
+  (and (< (- (expt 2 (* (- 1 k) rho)) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n)) (expt 2 (* (- 1 k) rho))))))
+
+(defund check-upper-bound (entry i j k rho m n)
+  (or (= entry (1- (expt 2 rho)))
+      (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+          (if (or (< i (expt 2 (1- m)))
+                  (= i (1- (expt 2 m))))
+              (* (/ (1+ entry) (expt 2 rho))
+                 (+ (delta0 j n) (* (1+ entry) (expt 2 (- (* k rho))))))
+            (* (/ (1+ entry) (expt 2 rho))
+               (+ (delta0 j n) (expt 2 (- n)) (* (1+ entry) (expt 2 (- (* k rho))))))))))
+
+(defund check-lower-bound (entry i j k rho m n)
+  (or (= entry (- 1 (expt 2 rho)))
+      (>= (pi0 i m)
+          (if (< i (expt 2 (1- m)))
+              (* (/ (1- entry) (expt 2 rho))
+                 (+ (delta0 j n) (expt 2 (- n)) (* (1- entry) (expt 2 (- (* k rho))))))
+            (* (/ (1- entry) (expt 2 rho))
+               (+ (delta0 j n) (* (1- entry) (expt 2 (- (* k rho))))))))))
+
+(defund check-sqrt-entry (i j k rho m n entry)
+  (or (not (sqrt-accessible-p i j k rho m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (check-upper-bound entry i j k rho m n)
+           (check-lower-bound entry i j k rho m n))))
+
+(defund check-sqrt-row (i j k rho m n row)
+  (if (zp j)
+      t
+    (and (check-sqrt-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+         (check-sqrt-row i (1- j) k rho m n row))))
+
+(defund check-sqrt-rows (i k rho m n rows)
+  (if (zp i)
+      t
+    (and (check-sqrt-row (1- i) (expt 2 n) k rho m n (nth (1- i) rows))
+         (check-sqrt-rows (1- i) k rho m n rows))))
+
+(defund admissible-for-iteration-p (k rho m n table)
+  (check-sqrt-rows (expt 2 m) k rho m n table))
+
+;;**********************************************************************************
+;; First we prove that the definition of admissibility ensures the desired property.
+;;**********************************************************************************
+
+(defthm admissible-sqrt-table-criterion
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (not (zp k))
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+          (and (< h (expt 2 rho))
+               (> h (- (expt 2 rho)))
+               (< p
+                 (* (/ (1+ h) (expt 2 rho))
+                    (+ d (* (1+ h) (expt 2 (- (* k rho)))))))  
+               (>= p              
+                  (* (/ (1- h) (expt 2 rho))
+                     (+ d (* (1- h) (expt 2 (- (* k rho)))))))))
+  :rule-classes ())
+
+;;**********************************************************************************
+;; Next we prove the converse of the above. This requires that we define witness
+;; functions that produce a violation of the desired property for a given table that
+;; fails to satisfy the definition for a given k.
+;;**********************************************************************************
+
+;; Assume that dmin < dmax and pmin < pmax.  Consider the closed rectangle
+;;   R = {(d,p) | dmin <= d <= dmax and pmin <= p <= pmax},
+;; the half-closed rectangle
+;;   R' = {(d,p) | dmin <= d < dmax and pmin <= p < pmax},
+;; and the quarter-closed rectangle
+;;   R" = {(d,p) | dmin < d < dmax and pmin <= p < pmax}.
+;; If there exists (d,p) in R such that p < h*d + b, then (d5,p5) is a point
+;; in R" with p5 < h*d5 + b:
+
+(defund d5 (dmin pmin dmax pmax h b)
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h))))
+    ;; (d1,p1) is in R' and p1 < h*d1 + b.
+    (if (> d1 dmin)
+        d1
+      (if (>= (+ (* h dmax) b) p1)
+          (/ (+ dmin dmax) 2)
+        (/ (+ (/ (- p1 b) h) dmin) 2)))))
+
+(defund p5 (dmin pmin dmax pmax h b)
+  (+ b (p1 dmin (- pmin b) dmax (- pmax b) h)))
+
+;; If there exists (d,p) in R such that p > h*d + b, then (d6,p6) is a point
+;; in R" with p6 > h*d6 + b:
+
+(defund d6 (dmin pmin dmax pmax h b)
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h))))
+    ;; (d2,p2) is in R' and p2 > h*d2 + b.
+    (if (> d2 dmin)
+        d2
+      (if (>= p2 (+ (* h dmax) b))
+          (/ (+ dmin dmax) 2)
+        (/ (+ (/ (- p2 b) h) dmin) 2)))))
+
+(defund p6 (dmin pmin dmax pmax h b)
+  (+ b (p2 dmin (- pmin b) dmax (- pmax b) h)))
+
+;; Assume h2 < h1 and h2 + b2 <= h1 + b1.  Then for all d > 1,
+;
+;;   (h1*d + b1) - (h2*d + b2) = (h1 - h2)*d + (b1 - b2)
+;;                             > (h1 - h2) + (b1 - b2)
+;;                             >= 0.
+;;
+;; Assume dmin >= 1.  If there exist (d1,p1) and (d2,p2) in R such that
+;; p1 < h1*d1 + b1 and p2 > h2*d2 + b2, then (d7,p7) is in R" and 
+;; h2*d7 + b2 < p7 < h1*d7 + b1:
+
+(defund d7 (dmin pmin dmax pmax h1 b1 h2 b2)
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2)))
+    (if (> p5 (+ (* h2 d5) b2))
+        d5
+      (if (< p6 (+ (* h1 d6) b1))
+          d6
+        (if (<= p5 (+ (* h2 d6) b2))
+            d6
+          (if (>= p5 (+ (* h1 d6) b1))
+              (/ (+ (/ (- p5 b1) h1) (/ (- p5 b2) h2)) 2)
+            d6))))))
+
+(defund p7 (dmin pmin dmax pmax h1 b1 h2 b2)
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2)))
+    (if (> p5 (+ (* h2 d5) b2))
+        p5
+      (if (< p6 (+ (* h1 d6) b1))
+          p6
+        (if (<= p5 (+ (* h2 d6) b2))
+            (/ (+ (* (+ h1 h2) d6) b1 b2) 2)
+          p5)))))
+
+;; We have p5 < h1*d5 + b1 and p6 > h2*d6 + b2.
+;; The claim is proved by the following case analysis:
+
+;; Case 1: p5 > h2*d5 + b2.
+;;   (d7,p7) = (d5,p5).
+;;   h2*d7 + b2 = h2*d5 + b2  < p5 = p7 < h1*d7 + b1.
+
+;; Case 2: p6 < h1*d6 + b1.
+;;   (d7,p7) = (d6,p6).
+;;   h2*d7 + b2 = h2*d6 + b2 < p6 = p7 < h1*d6 + b1.
+
+;; Case 3: p6 >= h1*d6 + b1, p5 <= h2*d6 + b2.
+;;   (d7,p7) = (d6,((h1+h2)*d6+b1+b1)/2).
+;;   Let y1 = h1*d6 + b1 and y2 = h2*d6 + b2.  Then p7 = (y1+y2)/2 and
+;;   h2*d7 + b2 = h2*d6 + b2 < h1*d6 + b1 = h1*d7 + b1.
+;;   Since p5 <= y2 < y1 <= p6, pmin < p5 < p7 < p6 < pmax.
+
+;; Case 4: p5 <= h2*d5 + b2, p5 > h2*d6 + b2, p5 >= h1*d6 + b1.
+;;   (d7,p7) = ((x1+x2)/2,p5), where x1 = (p5-b1)/h1 and x2 = (p5-b2)/h2.
+;;   Since h2*d6 + b2 < p5 <= h2*d5 + b2, h2*(d5 - d6) > 0.
+
+;;   Case 4a: d5 > d6.
+;;     h1 > h2 > 0.
+;;     Since h2*d6 + b2 < p5 <= h2*d5 + b2, d6 < (p5-b2)/h2 = x2 < d5.
+;;     Since p5 >= h1*d6 + b1, x1 = (p5-b1)/h1 >= d6.
+;;     Since h1*(x2 - x1) = h1*x2 - p5 + b1
+;;                        = h1*x2 - (h2*x2 + b2) + b1
+;;                        = (h1*x2 + b1) - (h2*x2 + b2)
+;;                        > 0,
+;;     x2 > x1.
+;;     Thus, dmin < d6 <= x1 < x2 < d5 < dmax and
+;;     (p5-b1)/h1 = x1 < d7 < x2 = (p5-b2)/h2, which implies
+;;     h2*d7 + b2 < p5 < h1*d7 + b1.
+
+;;   Case 4b: d5 < d6.
+;;     h2 < 0 and d5 <= (p5-b2)/h2 = x2 < d6.
+;;     Since h1*d5 + b1 > h2*d5 + b2 >= p5 >= h1*d6 + b1,
+;;     h1*(d6 - d5) < 0, which implies h1 < 0.
+;;     Since p5 >= h1*d6 + b1, x1 = (p5-b1)/h1 <= d6.
+;;     Since p5 <= h2*d5 + b2 < h1*d5 + b1, (p5-b1)/h1 > d5 > 1.
+;;     Since h2*(x1-x2) = h2*x1 - p5 + b2
+;;                      = h2*x1 - (h2*x1 + b2) + b1
+;;                      = (h2*x1 + b1) - (h2*x1 + b2)
+;;                      < 0,
+;;     x1 > x2.
+;;     Thus, dmin < d5 <= x2 < x1 <= d6 < dmax and
+;;     (p5-b2)/h2 = x2 < d7 < x1 = (p5-b1)/h1, which implies
+;;     h2*d7 + b2 < p5 < h1*d7 + b1.
+
+;;   Case 5: p5 > h2*d6 + b2, p5 < h1*d6 + b1.
+;;     (d7,p7) = (d6,p5).
+;;     h2*d7 + b2 = h2*d6 + b2 > p5 = p7 < h1*d7 + b1 = h1*d6 + b1.
+
+
+;; Suppose that (admissible-for-iteration-p k rho m n table) = NIL.
+;; Let i = (i-sqrt k rho m n table), j = (j-sqrt k rho m n table),
+;; and h = (lookup i j table).
+;; Then 0 <= i < 2^m, 0 <= j < 2^n, and
+;; (check-sqrt-entry i j k rho m n h) = NIL.
+;; Let d = (d-sqrt k rho m n table) and p = (p-sqrt k rho m n table).
+;; Then (d,p) is in S_ij and |p - 2^((1-k)*rho)| < d.
+;; If -2^rho < h < 2^rho, then either
+;;   p < ((h-1)/2^rho)*(d + (h-1)2^(-k*rho))
+;; or
+;;   p > ((h+1)/2^rho)*(d + (h+1)2^(-k*rho)).
+
+(defund i-sqrt-aux (i k rho m n table)
+  (if (zp i)
+      ()
+    (if (check-sqrt-row (1- i) (expt 2 n) k rho m n (nth (1- i) table))
+        (i-sqrt-aux (1- i) k rho m n table)
+      (1- i))))
+ 
+(defund i-sqrt (k rho m n table)
+  (i-sqrt-aux (expt 2 m) k rho m n table))
+
+(defund j-sqrt-aux (i j k rho m n row)
+  (if (zp j)
+      ()
+    (if (check-sqrt-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+        (j-sqrt-aux i (1- j) k rho m n row)
+      (1- j))))
+
+(defund j-sqrt (k rho m n table)
+  (let ((i (i-sqrt k rho m n table)))
+    (j-sqrt-aux i (expt 2 n) k rho m n (nth i table))))
+
+(defund d-sqrt (k rho m n table)
+  (let* ((i (i-sqrt k rho m n table))
+         (j (j-sqrt k rho m n table))
+         (h (lookup i j table)))
+    (if (or (not (integerp h))
+            (>= h (expt 2 rho))
+            (<= h (- (expt 2 rho))))
+        (d7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            1
+            (expt 2 (* (- 1 k) rho))
+            -1
+            (expt 2 (* (- 1 k) rho)))
+      (if (not (check-upper-bound h i j k rho m n))
+          (d7 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              1
+              (expt 2 (* (- 1 k) rho))
+              (/ (1+ h) (expt 2 rho))
+              (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+        (d7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            (/ (1- h) (expt 2 rho))
+            (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+            -1
+            (expt 2 (* (- 1 k) rho)))))))
+
+(defund p-sqrt (k rho m n table)
+  (let* ((i (i-sqrt k rho m n table))
+         (j (j-sqrt k rho m n table))
+         (h (lookup i j table)))
+    (if (or (not (integerp h))
+            (>= h (expt 2 rho))
+            (<= h (- (expt 2 rho))))
+        (p7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            1
+            (expt 2 (* (- 1 k) rho))
+            -1
+            (expt 2 (* (- 1 k) rho)))
+      (if (not (check-upper-bound h i j k rho m n))
+          (p7 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              1
+              (expt 2 (* (- 1 k) rho))
+              (/ (1+ h) (expt 2 rho))
+              (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+        (p7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            (/ (1- h) (expt 2 rho))
+            (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+            -1
+            (expt 2 (* (- 1 k) rho)))))))
+
+(defthm admissible-sqrt-table-criterion-converse
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (> k 1)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table)) 
+                  (p (p-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (/ (expt 2 n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                  (< (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                  (or (<= h (- (expt 2 rho)))
+                      (>= h (expt 2 rho))
+                      (< p (* (/ (1- h) (expt 2 rho))
+                              (+ d (* (1- h) (expt 2 (- (* k rho)))))))
+                      (> p (* (/ (1+ h) (expt 2 rho))
+                              (+ d (* (1+ h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ())
+
+
+;;**********************************************************************************
+;; Main Theorem on Square Root
+;;**********************************************************************************
+
+(defthm admissible-for-iteration-p-2-2-6-2
+  (implies (and (natp k)
+                (> k 2))
+           (admissible-for-iteration-p k 2 6 2 (srt-table 2 6 2))))
+
+(encapsulate (((rho%%) => *) ((m%%) => *) ((n%%) => *) ((k%%) => *) ((table%%) => *))
+
+(local (defun rho%% () 2))
+(local (defun m%% () 6))
+(local (defun n%% () 2))
+(local (defun k%% () 2))
+(local (defun table%% () (srt-table 2 6 2)))
+
+(defthmd rho%%-constraint
+  (not (zp (rho%%))))
+
+(defthmd m%%-constraint
+  (not (zp (m%%))))
+
+(defthmd n%%-constraint
+  (not (zp (n%%))))
+
+(defthmd k%%-constraint
+  (and (natp (k%%)) (> (k%%) 1)))
+
+(defthm table%%-constraint
+  (implies (and (natp k)
+                (> k (k%%)))
+           (admissible-for-iteration-p k (rho%%) (m%%) (n%%) (table%%)))
+  :hints (("Goal" :in-theory (disable srt-table (table%%) (srt-table)))))
+
+)
+
+(encapsulate (((x%%) => *) ((p%% *) => *) ((q%% *) => *) ((h%% *) => *) ((i%% *) => *) ((j%% *) => *))
+
+(local (defun x%% () 1/2))
+
+(local (mutual-recursion
+
+(defun p%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      (x%%)
+    (- (* (expt 2 (rho%%)) (p%% (1- k)))
+       (* (h%% k) (+ (* 2 (q%% (1- k))) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))))
+
+(defun q%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      0
+    (+ (q%% (1- k)) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))
+
+(defun h%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 1)))
+  (lookup (i%% k) (j%% k) (table%%)))
+
+(defun i%% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (bits (fl (* (expt 2 (- (m%%) 2)) (p%% (1- k)))) (1- (m%%)) 0)))
+
+(defun j%% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (fl (* (expt 2 (n%%)) (1- (* 2 (q%% (1- k))))))))
+
+))
+
+(defthmd x%%-constraint
+  (and (rationalp (x%%))
+       (< 1/4 (x%%))
+       (< (x%%) 1)))
+
+(defthm p%%-def
+  (equal (p%% k)
+         (if (zp k)
+             (x%%)
+           (- (* (expt 2 (rho%%)) (p%% (1- k)))
+              (* (h%% k) (+ (* 2 (q%% (1- k))) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))))
+  :rule-classes (:definition))
+
+(defthm q%%-def
+  (equal (q%% k)
+         (if (zp k)
+             0
+           (+ (q%% (1- k)) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))
+  :rule-classes (:definition))
+
+(defthm integerp-h%%
+  (integerp (h%% k))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthmd h%%-def
+  (implies (and (natp k)
+                (> k (k%%)))
+           (equal (h%% k)
+                  (lookup (i%% k) (j%% k) (table%%))))
+  :rule-classes (:definition))
+
+(defun all-sqrt-accessible-p%% (k)
+  (if (or (zp k) (<= k (k%%)))
+      t
+    (and (sqrt-accessible-p (i%% k) (j%% k) k (rho%%) (m%%) (n%%))
+         (all-sqrt-accessible-p%% (1- k)))))
+
+(defthmd i%%-constraint
+  (implies (and (natp k)
+                (> k (k%%))
+                (rationalp (p%% (1- k)))
+                (< (abs (p%% (1- k))) 2)
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (bvecp (i%% k) (m%%))
+                (<= (pi0 (i%% k) (m%%))
+                    (p%% (1- k)))
+                (< (p%% (1- k))
+                   (+ (pi0 (i%% k) (m%%))
+                      (/ (expt 2 (- (m%%) 3)))))))
+  :hints (("Goal" :use (m%%-constraint 
+                        k%%-constraint 
+                        (:instance i-bounds (p (p%% (1- k))) (m (m%%)))
+                        (:instance local-lemma (x (P%% (+ -1 K)))
+                                               (y1 (EXPT 2 (+ 2 (- (M%%)))))
+                                               (y2 (EXPT 2 (+ 3 (- (M%%)))))
+                                               (z (pi0 (i%% k) (m%%))))))))
+
+(defthmd j%%-constraint
+  (implies (and (natp k)
+                (> k (k%%))
+                (rationalp (q%% (1- k)))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1))
+           (and (bvecp (j%% k) (n%%))
+                (<= (delta0 (j%% k) (n%%)) (* 2 (q%% (1- k))))
+                (< (* 2 (q%% (1- k))) (+ (delta0 (j%% k) (n%%)) (expt 2 (- (n%%)))))))
+  :hints (("Goal" :use (n%%-constraint (:instance j-bounds (d (* 2 (q%% (1- k)))) (n (n%%)))))))
+
+)
+
+(defthm srt-sqrt-theorem-a
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                            (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (>= k (k%%)))
+           (and (< (x%%) (* (+ (q%% k) (expt 2 (- (* k (rho%%))))) 
+                            (+ (q%% k) (expt 2 (- (* k (rho%%)))))))
+                (>= (x%%) (* (- (q%% k) (expt 2 (- (* k (rho%%))))) 
+                             (- (q%% k) (expt 2 (- (* k (rho%%)))))))))
+  :rule-classes ())
+
+(defthm srt-sqrt-theorem-b
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (>= k (k%%)))
+           (< (abs (p%% k)) 2))
+  :rule-classes ())
+
+(defthmd srt-sqrt-theorem-c
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                            (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (> k (k%%)))
+           (sqrt-accessible-p (i%% k) (j%% k) k (rho%%) (m%%) (n%%))))
+
+
+;;**********************************************************************************
+;; An Admissible Square Root Table is Also an Admissible Division Table
+;;**********************************************************************************
+
+(defthm sqrt-table-is-div-table
+  (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%))
+  :rule-classes ())
+
+;;**********************************************************************************
+;; Admissible SRT Tables
+;;**********************************************************************************
+
+(defund accessible-p (i j k rho m n)
+  (and (< (- (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n)) (expt 2 (- (* k rho)))))))
+
+(defthm div-accessible-accessible
+  (implies (and (integerp m)
+                (integerp n)
+                (integerp rho)
+                (integerp k)
+                (integerp i)
+                (integerp j)
+                (div-accessible-p i j m n))
+           (accessible-p i j k rho m n)))
+
+(defthm sqrt-accessible-accessible
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (bvecp i m)
+                (bvecp j n)
+                (natp k1)
+                (> k1 k)
+                (sqrt-accessible-p i j k1 rho m n))
+           (accessible-p i j k rho m n))
+  :rule-classes ())
+
+(defund check-entry (i j k rho m n entry)
+  (or (not (accessible-p i j k rho m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (>= entry (lower i j rho m n))
+           (check-lower-bound entry i j (1+ k) rho m n))))
+
+(defund check-row (i j k rho m n row)
+  (if (zp j)
+      t
+    (and (check-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+         (check-row i (1- j) k rho m n row))))
+
+(defund check-rows (i k rho m n rows)
+  (if (zp i)
+      t
+    (and (check-row (1- i) (expt 2 n) k rho m n (nth (1- i) rows))
+         (check-rows (1- i) k rho m n rows))))
+
+(defund admissible-srt-table-p (k rho m n table)
+  (check-rows (expt 2 m) k rho m n table))
+  
+;;**********************************************************************************
+;; Equivalence of Admissibility Definitions
+;;**********************************************************************************
+
+(defthm admissibility-equivalence-a
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp k1)
+                (> k1 k)
+                (admissible-srt-table-p k rho m n table))
+           (admissible-for-iteration-p k1 rho m n table))
+  :rule-classes ())
+
+(encapsulate (((xtable%%) => *))
+
+(local (defund xtable-entry (i j)
+  (if (and (> (pi0 i (m%%))
+              (- (+ (delta0 j (n%%)) 
+                    (expt 2 (- (n%%))) 
+                    (expt 2 (- 3 (m%%))))))
+           (<= (pi0 i (m%%))
+               (- (expt 2 (- (* (k%%) (rho%%))))
+                  (+ (delta0 j (n%%))
+                     (expt 2 (- (n%%))) 
+                     (expt 2 (- 3 (m%%)))))))
+      (- 1 (expt 2 (rho%%)))
+    (lookup i j (table%%)))))
+
+(local (defun xtable-row (i j)
+  (declare (xargs :measure (nfix (- (expt 2 (n%%)) j))))
+  (if (and (natp j)
+           (< j (expt 2 (n%%))))
+      (cons (xtable-entry i j)
+            (xtable-row i (1+ j)))
+    ())))
+
+(local (defun xtable-rows (i)
+  (declare (xargs :measure (nfix (- (expt 2 (m%%)) i))))
+  (if (and (natp i)
+           (< i (expt 2 (m%%))))
+      (cons (xtable-row i 0)
+            (xtable-rows (1+ i)))
+    ())))
+
+(local (defund xtable%% ()
+  (xtable-rows 0)))
+
+(local (defun xtable-induct (j k)
+  (if (zp j)
+      k
+    (xtable-induct (1- j) (1+ k)))))
+
+(local (defthmd xtable-1
+  (implies (and (natp j)
+                (natp k)
+                (< (+ j k) (expt 2 (n%%))))
+           (equal (nth j (xtable-row i k))
+                  (xtable-entry i (+ j k))))
+  :hints (("Goal" :induct (xtable-induct j k))
+          ("Subgoal *1/2" :expand ((xtable-row i k)))
+          ("Subgoal *1/1" :expand ((xtable-row i k))))))
+
+(local (defthmd xtable-2
+  (implies (and (natp i)
+                (natp k)
+                (< (+ i k) (expt 2 (m%%))))
+           (equal (nth i (xtable-rows k))
+                  (xtable-row (+ i k) 0)))
+  :hints (("Goal" :induct (xtable-induct i k))
+          ("Subgoal *1/1" :expand ((xtable-rows k))))))
+
+(local (defthmd xtable-3
+  (implies (and (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (nth j (xtable-row i 0))
+                  (xtable-entry i j)))
+  :hints (("Goal" :use (:instance xtable-1 (k 0))))))
+
+(local (defthmd xtable-4
+  (implies (and (natp i)
+                (< i (expt 2 (m%%))))
+           (equal (nth i (xtable-rows 0))
+                  (xtable-row i 0)))
+  :hints (("Goal" :use (:instance xtable-2 (k 0))))))
+
+(local (defthm xtable-5
+  (integerp (xtable-entry i j))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable xtable-entry)))))
+
+(local (defthmd xtable-6
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (lookup i j (xtable%%))
+                  (xtable-entry i j)))
+  :hints (("Goal" :in-theory (enable lookup xtable%%)
+                  :use (xtable-4 xtable-3)))))
+
+(defthmd xtable-def
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (lookup i j (xtable%%))
+                  (if (and (> (pi0 i (m%%))
+                           (- (+ (delta0 j (n%%)) 
+                                 (expt 2 (- (n%%))) 
+                                 (expt 2 (- 3 (m%%))))))
+                           (<= (pi0 i (m%%))
+                               (- (expt 2 (- (* (k%%) (rho%%))))
+                                  (+ (delta0 j (n%%))
+                                     (expt 2 (- (n%%))) 
+                                     (expt 2 (- 3 (m%%)))))))
+                      (- 1 (expt 2 (rho%%)))
+                    (lookup i j (table%%)))))
+  :hints (("Goal" :in-theory (enable xtable-entry)
+                  :use (xtable-6))))
+
+)
+
+(defthm admissibility-equivalence-b
+  (admissible-srt-table-p (k%%) (rho%%) (m%%) (n%%) (xtable%%))
+  :rule-classes ())
+
+;; Examples:
+
+(defthm admissible-srt-table-p-2-2-6-2
+  (admissible-srt-table-p 2 2 6 2 (srt-table 2 6 2)))
+
+(defthm admissible-srt-table-p-2-3-7-4
+  (admissible-srt-table-p 2 3 7 4 (srt-table 3 7 4)))
+
+(defthm admissible-srt-table-p-2-3-8-3
+  (admissible-srt-table-p 2 3 8 3 (srt-table 3 8 3)))
+
+(defthm admissible-for-iteration-p-2-2-6-2
+  (implies (and (natp k)
+                (> k 2))
+           (admissible-for-iteration-p k 2 6 2 (srt-table 2 6 2))))
+
+
+;;**********************************************************************************
+;; Criterion for Existence of SRT Table
+;;**********************************************************************************
+
+(defund check-exists-entry (i j k rho m n)
+  (or (not (accessible-p i j k rho m n))
+      (<= (lower i j rho m n) (- 1 (expt 2 rho)))
+      (check-lower-bound (lower i j rho m n) i j (1+ k) rho m n)))
+
+(defund check-exists-row (i j k rho m n)
+  (if (zp j)
+      t
+    (and (check-exists-entry i (1- j) k rho m n)
+         (check-exists-row i (1- j) k rho m n))))
+
+(defund check-exists-rows (i k rho m n)
+  (if (zp i)
+      t
+    (and (check-exists-row (1- i) (expt 2 n) k rho m n)
+         (check-exists-rows (1- i) k rho m n))))
+
+(defund exists-srt-table-p (k rho m n)
+  (check-exists-rows (expt 2 m) k rho m n))
+
+(defthm exists-srt-table-p-2-2-6-2
+  (exists-srt-table-p 2 2 6 2))
+
+(defthm exists-srt-table-p-2-3-7-4
+  (exists-srt-table-p 2 3 7 4))
+
+(defthm exists-srt-table-p-2-3-8-3
+  (exists-srt-table-p 2 3 8 3))
+
+(defthm not-exists-srt-table-p-100-2-5-2
+  (not (exists-srt-table-p 100 2 5 2)))
+
+(defthm not-exists-srt-table-p-100-3-6-4
+  (not (exists-srt-table-p 100 3 6 4)))
+
+(defthm srt-table-existence-a
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (exists-srt-table-p k rho m n))
+           (admissible-srt-table-p k rho m n (srt-table rho m n))))
+
+(defthm srt-table-existence-b
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (admissible-srt-table-p k rho m n table))
+           (exists-srt-table-p k rho m n)))
+
+
+;;**********************************************************************************
+;; Seed Table Requirements
+;;**********************************************************************************
+
+(encapsulate (((rho**) => *) ((k**) => *) ((x**) => *) ((s**) => *))
+
+(local (defun k** () 1))
+
+(local (defun rho** () 2))
+
+(defthm k**-rho**-constraint
+  (and (not (zp (k**)))
+       (not (zp (rho**)))
+       (>= (* (k**) (rho**)) 2))
+  :rule-classes ())
+  
+(local (defun x** () 1/2))
+
+(defthm x**-constraint
+  (and (rationalp (x**))
+       (> (x**) 1/4)
+       (< (x**) 1))
+  :rule-classes ())
+
+(defun l** () (fl (* (expt 2 (* (k**) (rho**))) (x**))))
+
+(local (defun s** () 3))
+
+(defthm s**-constraint
+  (and (integerp (s**))
+       (<= (expt 2 (1- (* (k**) (rho**)))) (s**))
+       (< (s**) (expt 2 (* (k**) (rho**))))
+       (<= (* (expt 2 (- (* (k**) (rho**)))) (expt (1- (s**)) 2))
+           (l**))
+       (>= (* (expt 2 (- (* (k**) (rho**)))) (expt (1+ (s**)) 2))
+           (1+ (l**))))
+  :rule-classes ())
+
+(defun q0** () (* (expt 2 (- (* (k**) (rho**)))) (s**)))
+
+)
+
+(defthm seed-req-a
+  (and (<= 1/2 (q0**))
+       (< (q0**) 1)
+       (>= (x**) (expt (- (q0**) (expt 2 (- (* (k**) (rho**))))) 2))
+       (< (x**) (expt (+ (q0**) (expt 2 (- (* (k**) (rho**))))) 2)))
+  :rule-classes ())
+
+(defun s1** ()
+  (if (or (= (mod (s**) 2) 1)
+          (>= (x**) (* (q0**) (q0**))))
+      (s**)
+    (1- (s**))))
+
+(defun q1** () (* (expt 2 (- (* (k**) (rho**)))) (s1**)))
+
+(defthm seed-req-b
+  (and (<= 1/2 (q1**))
+       (< (q1**) 1)
+       (>= (x**) (expt (- (q1**) (expt 2 (- (* (k**) (rho**))))) 2))
+       (< (x**) (expt (+ (q1**) (expt 2 (- (* (k**) (rho**))))) 2)))
+  :rule-classes ())
+
+(encapsulate (((h** *) => *) ((q** *) => *))
+
+(local (defun h** (k) (declare (ignore k)) 0))
+
+(defthm h**-constraint
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (and (integerp (h** k))
+                (< (abs (h** k)) (expt 2 (rho**)))))
+  :rule-classes ())
+
+(local (defun q** (k) 
+  (if (or (zp k)
+          (<= k (k**)))
+      (q1**)
+    (+ (q** (1- k))
+       (* (expt 2 (- (* k (rho**))))
+          (h** k))))))
+
+(defthm q**-constraint
+  (and (= (q** (k**)) (q1**))
+       (implies (and (not (zp k))
+                     (> k (k**)))
+                (= (q** k)
+                   (+ (q** (1- k))
+                      (* (expt 2 (- (* k (rho**))))
+                         (h** k))))))
+  :hints (("Goal" :use (q** s**-constraint k**-rho**-constraint
+                        (:instance q** (k (k**))))))
+  :rule-classes ())
+
+)
+
+(defthm seed-req-c
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (x**) (expt (+ (q** k) (expt 2 (- (* k (rho**))))) 2)))
+           (= (fl (* (expt 2 (1- (* (k**) (rho**)))) (q** k)))
+              (fl (* (expt 2 (1- (* (k**) (rho**)))) (q1**)))))
+  :rule-classes ())
+
+
+;;**********************************************************************************
+;; A Compliant Seed Table
+;;**********************************************************************************
+
+(defun cg-sqrt (x min max)
+  (declare (xargs :measure (nfix (- (1+ max) min))))  
+  (if (and (natp min)
+           (natp max)
+           (<= min max))
+      (if (>= (* min min) x)
+          min
+        (cg-sqrt x (1+ min) max))
+    0))
+
+(defun seed (l k rho)
+  (1- (cg-sqrt (* (expt 2 (* k rho)) (1+ l)) 
+               (if (= (* k rho) 1)
+                   1
+                 (expt 2 (- (* k rho) 2)))
+               (expt 2 (* k rho)))))
+
+(defthm cg-sqrt-lemma
+  (implies (and (rationalp x)
+                (not (zp min))
+                (not (zp max))
+                (<= (* min min) x)
+                (<= x (* max max)))
+           (let ((y (cg-sqrt x min max)))
+             (and (<= x (* y y))
+                  (< (* (1- y) (1- y)) x))))
+  :rule-classes ())
+
+(defthm seed-compliance
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (and (integerp (seed l k rho))
+                (<= (expt 2 (1- (* k rho))) (seed l k rho))
+                (< (seed l k rho) (expt 2 (* k rho)))
+                (<= (* (expt 2 (- (* k rho))) (expt (1- (seed l k rho)) 2))
+                    l)
+                (>= (* (expt 2 (- (* k rho))) (expt (1+ (seed l k rho)) 2))
+                    (1+ l))))
+  :rule-classes ())
+
+
+;;**********************************************************************************
+;; Initial K Iterations
+;;**********************************************************************************
+
+(defund digit (i seed k rho )
+  (bits seed (1- (* (- (1+ k) i) rho)) (* (- k i) rho)))
+
+(defund root (i seed k rho)
+  (if (zp i)
+      0
+    (+ (root (1- i) seed k rho)
+       (* (expt 2 (- (* i rho)))
+          (digit i seed k rho)))))
+
+(defthm seed-digits
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp seed)
+                (<= (expt 2 (- (* k rho) 2)) seed)
+                (< seed (expt 2 (* k rho))))
+           (= (root k seed k rho)
+              (* (expt 2 (- (* k rho))) seed)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/lib/top.lisp acl2-6.3/books/rtl/rel9/lib/top.lisp
--- acl2-6.2/books/rtl/rel9/lib/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/top.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,71 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+;; The books included here are useful for most floating-point applications:
+
+(include-book "basic") ;basic arithmetic functions: floor, ceiling, and remainder
+
+(include-book "bits") ;bit vectors
+
+(include-book "log") ;logical operations
+
+(include-book "float") ;floating-point numbers
+
+(include-book "reps") ;floating-point formats and representations
+
+(include-book "round") ;floating-point rounding
+
+(include-book "util") ;misc helpful stuff including a few macros
+
+;; Special-purpose theories:
+
+;;(include-book "add") ;support for reasoning about addition
+
+;;(include-book "mult") ;integer multiplication
+
+;;(include-book "sqrt") ;approximation to square root
+
+;;(include-book "srt") ;SRT division and square root
+
+;; These are relevant to code derived from Verilog:
+
+;;(include-book "rtl") ;semantics of the basic RTL primitives
+
+;;(include-book "rtlarr") ;semantics of RTL array primitives
+
+;; This is relevant to code derived from SystemC and is inconsistent with the last two above:
+
+;;(include-book "masc")
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/lib/util.lisp acl2-6.3/books/rtl/rel9/lib/util.lisp
--- acl2-6.2/books/rtl/rel9/lib/util.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/lib/util.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,173 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top/top"))
+
+;;These macros facilitate localization of events:
+
+(defmacro local-defun (&rest body)
+  (list 'local (cons 'defun body)))
+
+(defmacro local-defund (&rest body)
+  (list 'local (cons 'defund body)))
+
+(defmacro local-defthm (&rest body)
+  (list 'local (cons 'defthm body)))
+
+(defmacro local-defthmd (&rest body)
+  (list 'local (cons 'defthmd body)))
+
+(defmacro local-in-theory (&rest body)
+  (cons 'local
+	(cons (cons 'in-theory (append body 'nil))
+	      'nil)))
+
+(defmacro defbvecp (name formals width &key thm-name hyp hints)
+  (let* ((thm-name
+          (or thm-name
+              (intern-in-package-of-symbol
+               (concatenate 'string
+                            (if (consp width)
+                                "BV-ARRP$"
+                              "BVECP$")
+                            (symbol-name name))
+               name)))
+         (x (cons name formals))
+         (typed-term (if (consp width)
+                         (list 'ag 'index x)
+                       x))
+         (bvecp-concl (if (consp width)
+                          (list 'bv-arrp x (car (last width)))
+                        (list 'bvecp x width)))
+         (concl (list 'and
+                      (list 'integerp typed-term)
+                      (list '<= 0 typed-term))))
+    (list* 'defthm thm-name
+           (if hyp
+               (list 'implies hyp bvecp-concl)
+             bvecp-concl)
+           :rule-classes
+           (list
+            :rewrite
+            (list :forward-chaining :trigger-terms (list x))
+            (list :type-prescription
+                  :corollary
+                  (if hyp
+                      (list 'implies hyp concl)
+                    concl)
+                  :typed-term typed-term
+                  ;; hints for the corollary 
+                  :hints
+                  (if (consp width)
+                      '(("Goal"
+                         :in-theory
+                         '(implies bvecp
+                                   bv-arrp-implies-nonnegative-integerp)))
+                    '(("Goal"
+                       :in-theory
+                       '(implies bvecp))))))
+           (if hints (list :hints hints) nil))))
+
+(defun sub1-induction (n)
+      (if (zp n)
+          n
+        (sub1-induction (1- n))))
+
+; These will be the functions to disable in acl2 proofs about signal bodies.
+; We use this in the compiler.
+
+(defconst *rtl-operators-after-macro-expansion*
+  '(log= log<> 
+    log< log<= log> log>= 
+    comp2< comp2<= comp2> comp2>=
+    land lior lxor lnot
+    logand1 logior1 logxor1
+    shft
+    cat mulcat
+    bits bitn setbits setbitn 
+    ag as
+    * + ; from macroexpansion of mod* or mod+
+    ;mod- ;now a macro!
+    floor rem decode encode
+    ;; bind ; handled specially in fixup-term
+    ;; if1 ;  a macro, so we don't disable it
+    ;; quote, n!, arr0 ; handled specially in fixup-term
+    natp1 ; doesn't matter, only occurs in for-loop defuns (must be enabled in those proofs anyway)
+    mk-bvarr mk-bvec
+    ))
+
+; Macro fast-and puts conjunctions in a tree form, which can avoid stack
+; overflows by ACL2's translate functions.
+
+(defun split-list (lst lo hi)
+  (cond ((endp lst) 
+         (mv lo hi))
+        ((endp (cdr lst)) 
+         (mv (cons (car lst) lo) hi))
+        (t
+         (split-list (cddr lst)
+                     (cons (car lst) lo)
+                     (cons (cadr lst) hi)))))
+
+(defun fast-and-fn (conjuncts)
+  (declare (xargs :mode :program))
+  (cond ((endp conjuncts) ''t)
+        ((endp (cdr conjuncts)) (car conjuncts))
+        (t
+         (mv-let (hi lo)
+             (split-list conjuncts () ())
+           (list 'if
+                 (fast-and-fn hi)
+                 (fast-and-fn lo)
+                 'nil)))))
+
+(defmacro fast-and (&rest conjuncts)
+  (fast-and-fn conjuncts))
+
+(defmacro defsig (name param body)
+  (declare (ignore param))
+  (let ((realname  (intern-in-package-of-symbol
+                    (concatenate 'string
+                                 (symbol-name name)
+                                 "$")
+                    name)))
+    `(progn (defund ,realname (n $path) 
+              ,body)
+            (defmacro ,name (n)
+              (list ',realname n '$path))
+            (add-macro-alias ,name ,realname))))
+
+(defmacro defsigd (name params body)
+  (let ((realname (intern-in-package-of-symbol
+                    (concatenate 'string (symbol-name name) "$")
+                    name)))
+    `(progn (defund ,realname (,@params $path) 
+              ,body)
+            (defmacro ,name ,params
+              (list ',realname ,@params '$path))
+            (add-macro-alias ,name ,realname))))
diff -Nru acl2-6.2/books/rtl/rel9/support/Makefile acl2-6.3/books/rtl/rel9/support/Makefile
--- acl2-6.2/books/rtl/rel9/support/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/Makefile	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,2 @@
+DIRS = support lib1 lib1.delta1 lib1.delta2 lib2 lib2.delta1 lib2.delta2 lib2.delta3 lib3 lib3.delta1 lib3.delta2 top
+include ../../../Makefile-subdirs
diff -Nru acl2-6.2/books/rtl/rel9/support/README acl2-6.3/books/rtl/rel9/support/README
--- acl2-6.2/books/rtl/rel9/support/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/README	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,48 @@
+We intend to keep this directory organized as follows. 
+
+   ./              
+   ./top.lisp           --- A summary of exported events.   
+                            (We intend to keep this to be the same set of events from 
+                             ../lib/top.lisp, in the same order too.)
+ 
+   ./support            --- Effectively: lib0 + lib0.delta1  (where lib0 is empty)
+
+   ./lib1               --- Summary of exported events in "support/"
+   ./lib1.delta1        --- Updates to lib1 
+   ./lib1.delta2        --- Other updates to lib1 
+
+
+   ./lib2               --- Summary of exported events in lib1 + lib1.delta<1-N>
+   ./lib2.delta1        --- ....  
+   ./lib2.delta2        --- ....    
+
+   ... 
+
+The file "top.lisp" is a summary of exported events that should be a super set
+of events in "../lib/". So that certification of each book included in the
+"../lib/top.lisp" can pass trivially --- assuming "top.lisp" certifies.
+
+In fact, we intend to maintain "top.lisp" in such away, that it contains the
+exact the same list of events as the"../lib/top.lisp" contains.
+
+The directory "lib1/" is roughly a copy of "../lib" from rel5 of the RTL book.
+It serves as a foundation for developing lib1.delta<1-N>.
+
+The "lib1.deltaN" directories are means for grouping updates to the "lib1/".  A
+book from "lib1.deltaN/" may likely to start with a "(include-book
+"../lib1/top")".  In order to tidy up dependencies between different
+directories, we discourage including books from directories other than current
+directory, "lib1/" or previous "delta"s.
+
+
+In addition to doing "lib1.deltaN" style development, one may (at some point)
+chose to create a "lib2/" that contains a whole set of books so that "../lib"
+is just an almost exact "shadow" of "lib2/".
+
+The directory "support/" contains both the legacy proofs and specific *-helper
+files.  It can be considered as "sum" of the imaginary "lib0/" and
+"lib0.delta1/".
+
+See ../README "How to add new theorems to 'lib/'" section for how to organize
+this directory.
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/Makefile acl2-6.3/books/rtl/rel9/support/lib1/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib1/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/Makefile	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,9 @@
+include ../../../../Makefile-generic
+
+# BOOKS = arith basic bits log float reps round \
+#         rtl rtlarr bvecp-raw-helpers bvecp-helpers simple-loop-helpers \
+#         simplify-model-helpers util add top rom-helpers clocks package-defs \
+#         openers
+
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/README acl2-6.3/books/rtl/rel9/support/lib1/README
--- acl2-6.2/books/rtl/rel9/support/lib1/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/README	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,3 @@
+This is a updated copy of the lib/ directory from Release 5 of the RTL
+library.  It serves as basis for new development in lib1.delata1. See 
+../README for how support directory is organized. 
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/add.lisp acl2-6.3/books/rtl/rel9/support/lib1/add.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/add.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/add.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,468 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "round")
+
+(local (include-book "../support/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (land u v 1) 1 (lxor u v 1) 1)))
+  :rule-classes ())
+
+(defthm add-2
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n))
+           (equal (+ x y)
+                  (+ (lxor x y n)
+                     (* 2 (land x y n)))))
+  :rule-classes ())
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (lior (land u v 1) (lior (land u w 1) (land v w 1) 1) 1) 1 
+                       (lxor u (lxor v w 1) 1) 1)))
+  :rule-classes ())
+
+(defthm add-3
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n)
+                (bvecp z n))
+           (equal (+ x y z)
+                  (+ (lxor x (lxor y z n) n)
+                     (* 2 (lior (land x y n)
+                                (lior (land x z n)
+                                      (land y z n)
+                                      n)
+                                n)))))
+  :rule-classes ())
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (lior (land (bitn x (1- k)) (bitn y (1- k)) 1)
+	  (lior (land (bitn x (1- k)) (rc-carry x y (1- k)) 1)
+		(land (bitn y (1- k)) (rc-carry x y (1- k)) 1)
+		1)
+	  1)))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (lxor (bitn x (1- k))
+	       (lxor (bitn y (1- k)) (rc-carry x y (1- k)) 1)
+	       1)
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :rule-classes ())
+
+(defun gen (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+(defun prop (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(defthmd gen-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen x y i j)
+                  (if (>= (+ (bits x i j) (bits y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j) (bits y i j))
+			(1+ (- i j))))))
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0)))))
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (lior (bitn x i) (bitn y i) 1)))
+  :rule-classes ())
+
+(defthmd prop-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop x y i j)
+                  (if (= (+ (bits x i j) (bits y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthmd prop-as-lxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (lxor (bits x i j) (bits y i j) (1+ (- i j)))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthm gen-extend
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp k)
+                (> i k)
+                (>= k j)
+                (>= j 0))
+           (equal (gen x y i j)
+                  (lior (gen x y i (1+ k))
+                        (land (prop x y i (1+ k))
+                              (gen x y k j)
+                              1)
+                        1)))
+  :rule-classes ())
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :rule-classes ())
+
+(defthm prop-extend
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp k)
+                (> i k)
+                (>= k j)
+                (>= j 0))
+           (equal (prop x y i j)
+                  (land (prop x y i (1+ k))
+                        (prop x y k j)
+                        1)))
+  :rule-classes ())
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j))))
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j)))))
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-plus-1
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0))
+           (equal (bits (+ 1 x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (lior (prop x y (1- j) 0) 
+                                 (gen x y (1- j) 0) 
+                                 1))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthmd land-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (land (bits x i j) (bits y i j) (1+ (- i j))) 0))
+           (equal (gen x y i j) 0)))
+
+(defthm land-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n i)
+                (>= i j)
+                (>= j 0)
+                (= (land x y n) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :rule-classes ())
+
+(defthmd gen-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (land z y (1+ k)) 0)
+		(= (gen x y k 0) 1))
+	   (equal (gen (+ x y) z k 0) 0)))
+
+(defthmd gen-extend-3
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                (= (land y z (1+ j)) 0))		  
+           (equal (gen (+ x y) z i 0)
+                  (land (prop x y i (1+ j))
+                        (gen (+ x y) z j 0)			  
+                        1))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm lop-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ())
+
+(defthm lop-thm-1
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (= e (expo a))
+                (< (expo b) e)
+                (= lambda
+                   (lior (* 2 (mod a (expt 2 e)))
+                         (lnot (* 2 b) (1+ e))
+                         (1+ e))))
+           (or (= (expo (- a b)) (expo lambda))
+               (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
+
+(defun lamt (a b e)
+  (lxor a (lnot b (1+ e)) (1+ e)))
+
+(defun lamg (a b e)
+  (land a (lnot b (1+ e)) (1+ e)))
+
+(defun lamz (a b e)
+  (lnot (lior a (lnot b (1+ e)) (1+ e)) (1+ e)))
+
+(defun lam1 (a b e)
+  (land (bits (lamt a b e) e 2) 
+	(land (bits (lamg a b e) (1- e) 1)
+	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam2 (a b e)
+  (land (lnot (bits (lamt a b e) e 2) (1- e))
+	(land (bits (lamz a b e) (1- e) 1)
+	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam3 (a b e)
+  (land (bits (lamt a b e) e 2) 
+	(land (bits (lamz a b e) (1- e) 1)
+	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam4 (a b e)
+  (land (lnot (bits (lamt a b e) e 2) (1- e))
+	(land (bits (lamg a b e) (1- e) 1)
+	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam0 (a b e)
+  (lior (lam1 a b e)
+	(lior (lam2 a b e)
+	      (lior (lam3 a b e)
+		    (lam4 a b e)
+		    (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (lnot (bitn (lamt a b e) 0) 1)))
+
+(defthm lop-thm-2
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1))
+           (and (not (= (lamb a b e) 0))
+                (or (= (expo (- a b)) (expo (lamb a b e)))
+                    (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lnot (lxor a b n) n) k 0) 0)))
+  :rule-classes ())
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (lxor (lxor a b n) 
+                                     (cat (lior a b n) n c 1)
+                                     (1+ n)) 
+                               k 0) 
+                         0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/arith.lisp acl2-6.3/books/rtl/rel9/support/lib1/arith.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/arith.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/arith.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,843 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This file is based on the old "fp book", which was initially created by J
+; Moore and Matt Kaufmann in 1995 in support of their proof of the AMD-K5
+; division code.    Here, we have moved
+; non-local in-theory events to the end.  All events should be redundant, so we
+; have deleted all local in-theory events and added (local (in-theory nil)) to
+; the beginning.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../../arithmetic/fp"))
+(local (include-book "../../arithmetic/fp2"))
+(local (include-book "../../arithmetic/fl"))
+(local (include-book "../../arithmetic/expt"))
+(local (include-book "../../arithmetic/expo"))
+(local (include-book "../../arithmetic/extra-rules"))
+(local (include-book "../support/ash"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+(defthm a1 (equal (+ x (+ y z)) (+ y (+ x z))))
+(defthm a2 (equal (- x) (* -1 x)))
+
+(defthm a3
+  (and
+   (implies
+    (syntaxp (and (quotep c1) (quotep c2)))
+    (and (equal (+ (* c1 x) (* c2 x)) (* (+ c1 c2) x))
+         (equal (+ (* c1 x) (+ (* c2 x) y)) (+ (* (+ c1 c2) x) y))))
+   (implies
+    (syntaxp (quotep c2))
+    (and (equal (+ x (* c2 x)) (* (+ 1 c2) x))
+         (equal (+ x (+ (* c2 x) y1)) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (* c2 x))) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (+ (* c2 x) y2))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (* c2 x)))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (+ y3 (* c2 x)))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))
+         (equal (+ x (+ y1 (+ y2 (+ (* c2 x) y3))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))))
+   (and (equal (+ x x) (* 2 x))
+        (equal (+ x (+ x y1)) (+ (* 2 x) y1)))))
+(defthm a4
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (+ c1 (+ c2 y1)) (+ (+ c1 c2) y1))))
+(defthm a5
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (* c1 (* c2 y1)) (* (* c1 c2) y1))))
+
+
+
+
+
+(defthm a6
+  (equal (/ (/ x)) (fix x)))
+(defthm a7
+  (equal (/ (* x y)) (* (/ x) (/ y))))
+
+;replaced force with case-split
+(defthm a8
+  (implies (and (case-split (acl2-numberp x))
+                (case-split (not (equal x 0))))
+           (and (equal (* x (* (/ x) y)) (fix y))
+                (equal (* x (/ x)) 1))))
+
+(defthm a9
+  (and (equal (* 0 x) 0)
+       (equal (* x (* y z)) (* y (* x z)))
+       (equal (* x (+ y z)) (+ (* x y) (* x z)))
+       (equal (* (+ y z) x) (+ (* y x) (* z x)))))
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+
+(defthm a10
+  (and (implies (integerp i) (equal (fl i) i))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1)) ;can actually drop this
+                     )
+                (and (equal (fl (+ i x1)) (+ i (fl x1)))
+                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2)))
+                (and (equal (fl (+ x1 (+ i x2))) (+ i (fl (+ x1 x2))))
+                     (equal (fl (+ x1 (+ x2 i))) (+ i (fl (+ x1 x2))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3)))
+                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
+                            (+ i (fl (+ x1 x2 x3))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
+                            (+ i (fl (+ x1 x2 x3))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3))
+                     (case-split (rationalp x4)))
+                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))))))
+
+(defthm a12
+  (implies (and (integerp i)
+                (integerp j)
+                (< 1 j)
+                (< j i))
+           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
+                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
+  :rule-classes :linear)
+
+
+;replaced force with case-split                
+;later, drop the hyp completely
+(defthm a13
+  (implies (case-split (rationalp x)) ;drop!
+           (and (< (1- x) (fl x))
+                (<= (fl x) x)))
+  :rule-classes :linear)
+
+(defthm a14
+  (and
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= 0 j))
+            (and (integerp (expt i j))
+                 (<= 0 (expt i j))))
+   (implies (and (rationalp i)
+                 (not (equal i 0)))
+            (not (equal (expt i j) 0))))
+  :rule-classes
+  ((:type-prescription
+    :corollary
+    (implies (and (integerp i)
+                  (<= 0 i)
+                  (<= 0 j))
+             (and (integerp (expt i j))
+                  (<= 0 (expt i j)))))
+   (:type-prescription
+    :corollary
+    (implies (and (rationalp i)
+                  (not (equal i 0)))
+             (not (equal (expt i j) 0))))))
+
+(defthm a15
+  (implies (and (rationalp i)
+                (not (equal i 0))
+                (integerp j1)
+                (integerp j2))
+           (and (equal (* (expt i j1) (expt i j2))
+                       (expt i (+ j1 j2)))
+                (equal (* (expt i j1) (* (expt i j2) x))
+                       (* (expt i (+ j1 j2)) x)))))
+(defthm a16
+  (equal (expt (* a b) i)
+         (* (expt a i) (expt b i))))
+
+(defthm /-weakly-monotonic
+  (implies (and (<= y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (<= (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+
+(defthm /-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (< (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+         
+(defthm *-weakly-monotonic
+  (implies (and (<= y y+)
+                (<= 0 x)
+                (case-split (rationalp x)) ; This does not hold if x, y, and z are complex!
+                )
+           (<= (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))))
+
+#| Here is the complex counterexample to which we alluded above.
+
+(let ((y  #c(1 -1))
+      (y+ #c(1 1))
+      (x  #c(1 1)))
+    (implies (and (<= y y+)
+                  (<= 0 x))
+             (<= (* x y) (* x y+))))
+|#
+
+(defthm *-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))))
+
+(defthm *-weakly-monotonic-negative-multiplier
+  (implies (and (<= y y+)
+               (< x 0)
+               (case-split (rationalp x))
+               )
+           (<= (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))))
+
+(defthm *-strongly-monotonic-negative-multiplier
+  (implies (and (< y y+)
+                (< x 0)
+                (case-split (rationalp x))
+                )
+           (< (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))))
+
+(defthm fl-weakly-monotonic
+  (implies (and (<= y y+)
+                (case-split (rationalp y)) ;drop?
+                (case-split (rationalp y+)) ;drop?
+                )
+           (<= (fl y) (fl y+)))
+  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
+                 (:linear)
+                 (:forward-chaining
+                  :trigger-terms ((fl y) (fl y+))
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))
+                 (:linear
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))))
+
+ (deftheory arith-fc-monotonicity
+   '((:forward-chaining /-weakly-monotonic)
+     (:forward-chaining /-strongly-monotonic)
+     (:forward-chaining *-weakly-monotonic . 1)
+     (:forward-chaining *-weakly-monotonic . 2)
+     (:forward-chaining *-strongly-monotonic . 1)
+     (:forward-chaining *-strongly-monotonic . 2)
+     (:forward-chaining *-weakly-monotonic-negative-multiplier . 1)
+     (:forward-chaining *-weakly-monotonic-negative-multiplier . 2)
+     (:forward-chaining *-strongly-monotonic-negative-multiplier . 1)
+     (:forward-chaining *-strongly-monotonic-negative-multiplier . 2)
+     (:forward-chaining fl-weakly-monotonic . 1)
+     (:forward-chaining fl-weakly-monotonic . 2)
+     ))
+
+; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
+; product of a and b given intervals for a and b.  We consider three kinds of intervals.
+; We discuss only the a case.
+
+; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
+
+; nonneg-open intervals mean 0<=a<amax.
+
+; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
+
+; We now prove theorems with names like abs*nonneg-open, etc. characterizing
+; the product of two elements from two such intervals.  All of these theorems
+; are made with :rule-classes nil because I don't know how to control their
+; use.
+
+; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
+; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
+; lemma would be no different.
+
+(defthm abs*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+
+
+(defthm abs*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* bmax amax)) (* a b))
+                (< (* a b) (* bmax amax))))
+  :rule-classes nil)
+
+; The next three, which handle nonnegative open intervals in the first argument,
+; can actually be seen as uses of the abs intervals above.  Simply observe that
+; if 0<=a<amax then -amax<a<amax.
+
+(defthm nonneg-open*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+; and the commuted version
+(defthm nonneg-closed*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (<= a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (<= (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm abs*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (< (- bmax) b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)  
+
+(defthm rearrange-negative-coefs-<
+  (and (equal (< (* (- c) x) z)
+              (< 0 (+ (* c x) z)))
+       (equal (< (+ (* (- c) x) y) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y (* (- c) x)) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y1 y2 (* (- c) x)) z)
+              (< (+ y1 y2) (+ (* c x) z)))
+       (equal (< (+ y1 y2 y3 (* (- c) x)) z)
+              (< (+ y1 y2 y3) (+ (* c x) z)))
+       (equal (< z (+ (* (- c) x) y))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y (* (- c) x)))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y1 y2 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2)))
+       (equal (< z (+ y1 y2 y3 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2 y3)))))
+
+(defthm rearrange-negative-coefs-equal
+  (and (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp z)))
+                (equal (equal (* (- c) x) z)
+                       (equal 0 (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ (* (- c) x) y) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y (* (- c) x)) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 (* (- c) x)) z)
+                       (equal (+ y1 y2) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 y3 (* (- c) x)) z)
+                       (equal (+ y1 y2 y3) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ (* (- c) x) y))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y (* (- c) x)))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 y3 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2 y3))))))
+
+(defthm rearrange-fractional-coefs-<
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< (* (/ c) x) z)
+                   (< x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ (* (/ c) x) y) z)
+                   (< (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ y (* (/ c) x)) z)
+                   (< (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< (+ y1 y2 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< (+ y1 y2 y3 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) (* c y3) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< z (* (/ c) x))
+                   (< (* c z) x)))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ (* (/ c) x) y))
+                   (< (* c z) (+ x (* c y)))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ y (* (/ c) x)))
+                   (< (* c z) (+ (* c y) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 y3 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) (* c y3) x))))))
+
+(defthm rearrange-fractional-coefs-equal
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (equal (* (/ c) x) z)
+                   (equal x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ (* (/ c) x) y) z)
+                   (equal (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ y (* (/ c) x)) z)
+                   (equal (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 y3 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) (* c y3) x) (* c z))))))
+
+(defthm x*/y=1->x=y
+  (implies (and (rationalp x)
+                (rationalp y)
+                (not (equal x 0))
+                (not (equal y 0)))
+           (equal (equal (* x (/ y)) 1)
+                  (equal x y)))
+  :rule-classes nil)
+                
+(defun point-right-measure (x)
+  (floor (if (and (rationalp x) (< 0 x)) (/ x) 0) 1))
+
+(defun point-left-measure (x)
+  (floor (if (and (rationalp x) (> x 0)) x 0) 1))
+
+(include-book "ordinals/e0-ordinal" :dir :system)
+(set-well-founded-relation e0-ord-<)
+
+(defthm recursion-by-point-right
+  (and (e0-ordinalp (point-right-measure x))
+       (implies (and (rationalp x)
+                     (< 0 x)
+                     (< x 1))
+                (e0-ord-< (point-right-measure (* 2 x))
+                          (point-right-measure x)))))
+
+(defthm recursion-by-point-left
+  (and (e0-ordinalp (point-left-measure x))
+       (implies (and (rationalp x)
+                     (>= x 2))
+                (e0-ord-< (point-left-measure (* 1/2 x))
+                          (point-left-measure x)))))
+
+(defthm x<x*y<->1<y
+  (implies (and (rationalp x)
+                (< 0 x)
+                (rationalp y))
+           (equal (< x (* x y)) (< 1 y)))
+  :rule-classes nil)
+
+(defthm cancel-equal-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (not (equal a 0)))
+           (equal (equal (* a r) (* a s))
+                  (equal r s)))
+  :rule-classes nil)
+
+(defthmd expt-split
+  (implies (and (integerp i)
+                (integerp j)
+                (case-split (acl2-numberp r)) ;(integerp r)
+                (case-split (not (equal r 0)))
+                )
+           (equal (expt r (+ i j))
+                  (* (expt r i) (expt r j)))))
+
+(defthm cancel-<-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (< 0 a))
+           (equal (< (* a r) (* a s))
+                  (< r s)))
+  :rule-classes nil)
+
+(in-theory (disable fl
+                    inverse-of-*
+                    point-right-measure point-left-measure))
+
+
+;;;**********************************************************************
+;;;                       EXPONENTIATION
+;;;**********************************************************************
+
+(defthm expt-2-positive-rational-type
+  (and (rationalp (expt 2 i))
+       (< 0 (expt 2 i)))
+  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
+
+(defthm expt-2-positive-integer-type
+  (implies (<= 0 i)
+           (and (integerp (expt 2 i))
+                (< 0 (expt 2 i))))
+  :rule-classes (:type-prescription))
+
+(defthm expt-2-type-linear
+  (implies (<= 0 i)
+           (<= 1 (expt 2 i)))
+  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
+
+(defthmd expt-weak-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (<= (expt 2 n) (expt 2 m))
+		  (<= n m))))
+
+(defthmd expt-strong-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (< (expt 2 n) (expt 2 m))
+		  (< n m))))
+
+(defthmd expt-inverse
+  (equal (/ (expt 2 i))
+         (expt 2 (* -1 i))))
+
+(defthm ash-rewrite
+    (implies (integerp n)
+	     (equal (ash n i)
+		    (fl (* n (expt 2 i))))))
+
+(defthm exp+1
+    (implies (and (integerp m)
+		  (integerp n)
+		  (<= n m))
+	     (> (* (- 1 (expt 2 m)) (- 1 (expt 2 n)))
+		(- 1 (expt 2 (1+ m)))))
+  :rule-classes ())
+
+(defthm exp+2
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (< (* (1+ (expt 2 m)) (1+ (expt 2 n)))
+		(1+ (expt 2 (+ m 2)))))
+  :rule-classes ())
+
+(defthm exp-invert
+    (implies (and (integerp n)
+		  (<= n -1))
+	     (<= (/ (- 1 (expt 2 n)))
+		 (1+ (expt 2 (1+ n)))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/basic.lisp acl2-6.3/books/rtl/rel9/support/lib1/basic.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/basic.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,409 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                       FLOOR and CEILING
+;;;**********************************************************************
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defthm fl-def
+  (and (integerp (fl x))    
+       (implies (case-split (rationalp x))
+	        (and (<= (fl x) x)
+		     (< x (1+ (fl x))))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (<= (fl x) x)
+                                        (< x (1+ (fl x))))))
+                 (:type-prescription :corollary
+                                     (integerp (fl x)))))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+(defthm fl-integerp
+  (equal (equal (fl x) x)
+         (integerp x)))
+
+(defthm quot-bnd
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* y (fl (/ x y)))
+               x))
+  :rule-classes :linear)
+
+(defthm fl-monotone-linear
+    (implies (and (<= x y)
+		  (rationalp x)
+		  (rationalp y))
+	     (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (fl x) (/ n)))
+                  (fl (/ x n)))))
+
+(defthm fl/int-rewrite-alt
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (/ n) (fl x)))
+                  (fl (/ x n)))))
+
+(defthmd fl-minus
+  (implies (rationalp x)
+           (equal (fl (* -1 x))
+                  (if (integerp x)
+                      (* -1 x)
+                    (1- (* -1 (fl x)))))))
+
+(defthm fl-m-n
+  (implies (and (< 0 n)
+                (integerp m)
+                (integerp n))
+           (= (fl (- (/ m n)))
+              (1- (- (fl (/ (1- m) n))))))
+  :rule-classes ())
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defthm cg-def
+  (and (integerp (cg x))
+       (implies (case-split (rationalp x))
+                (and (>= (cg x) x)
+                     (> (1+ x) (cg x)))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (>= (cg x) x)
+                                        (> (1+ x) (cg x)))))
+                 (:type-prescription :corollary
+                                     (integerp (cg x)))))
+
+(defthm cg-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (>= n x)
+		  (> (1+ x) n))
+	     (equal (cg x) n))
+  :rule-classes ())
+
+(defthm cg-integerp
+    (implies (rationalp x)
+	     (equal (equal (cg x) x)
+                    (integerp x))))
+
+(defthm cg-monotone-linear
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= x y))
+	     (<= (cg x) (cg y)))
+  :rule-classes :linear)
+
+(defthm n>=cg-linear
+    (implies (and (>= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (>= n (cg x)))
+  :rule-classes :linear)
+
+(defthm cg+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (cg (+ x n)) (+ (cg x) n))))
+
+(defthm cg/int-rewrite
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (cg x) (/ n)))
+                  (cg (/ x n)))))
+
+(defthm cg/int-rewrite-alt
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (/ n) (cg x)))
+                  (cg (/ x n)))))
+
+(defthm fl-cg
+  (implies (rationalp x)
+           (equal (cg x)
+                  (if (integerp x)
+                      (fl x)
+                    (1+ (fl x)))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                         MOD
+;;;**********************************************************************
+
+(defthm mod-def
+  (implies (case-split (acl2-numberp x))
+           (equal (mod x y)
+                  (- x (* y (fl (/ x y))))))
+  :rule-classes ())
+
+(defthm mod-0
+    (and (equal (mod 0 y)
+                0)
+         (equal (mod x 0)
+                (fix x))))
+
+(defthm rationalp-mod
+  (implies (rationalp x)
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm integerp-mod
+  (implies (and (integerp m) (integerp n))
+           (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm natp-mod
+  (implies (and (natp m)
+                (natp n))
+           (natp (mod m n)))
+  :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+(defthm mod-bnd-1
+  (implies (and (case-split (< 0 n))
+                (case-split (not (complex-rationalp m)))
+                (case-split (not (complex-rationalp n))))
+           (< (mod m n) n))
+  :rule-classes :linear)
+
+(defthm mod-by-1
+  (implies (integerp m)
+           (equal (mod m 1)
+                  0)))
+
+(defthm mod-bnd-2
+  (implies (and (<= 0 m)
+                (case-split (rationalp m)))
+           (<= (mod m n) m))
+  :rule-classes :linear)
+
+(defthm mod-does-nothing
+  (implies (and (< m n)
+                (<= 0 m)
+                (case-split (rationalp m)))
+           (equal (mod m n)
+                  m)))
+
+(defthm mod-0-fl
+  (implies (acl2-numberp m)
+           (iff (= (mod m n) 0)
+	        (= m (* (fl (/ m n)) n))))
+  :rule-classes ())
+
+(defthm mod-0-int
+  (implies (and (integerp m)
+                (integerp n)
+                (not (= n 0)))
+           (iff (= (mod m n) 0)
+                (integerp (/ m n))))
+  :rule-classes ())
+
+(defthm mod-mult-n
+  (equal (mod (* a n) n)
+         (* n (mod a 1))))
+
+(defthm mod-mult-n-commuted
+  (equal (mod (* n a) n)
+         (* n (mod a 1))))
+
+(defthm mod-squeeze
+    (implies (and (= (mod m n) 0)
+		  (< m (* (1+ a) n))
+                  (< (* (1- a) n) m)
+                  (integerp a)
+		  (integerp m)
+		  (integerp n))
+	     (= m (* a n)))
+  :rule-classes ())
+
+(defthm mod-must-be-n
+    (implies (and (= (mod m n) 0)
+		  (< m (* 2 n))
+                  (< 0 m)
+		  (rationalp m)
+		  (rationalp n))
+	     (= m n))
+  :rule-classes ())
+
+(defthm mod-0-0
+  (implies (and (integerp p)
+                (rationalp m)
+                (rationalp n))
+           (iff (= (mod m (* n p)) 0)
+                (and (= (mod m n) 0)
+                     (= (mod (fl (/ m n)) p) 0))))
+  :rule-classes ())
+
+(defthm mod-equal-int
+  (implies (and (= (mod a n) (mod b n))
+                (rationalp a)
+                (rationalp b))
+           (integerp (/ (- a b) n)))
+  :rule-classes ())
+
+(defthm mod-equal-int-reverse
+  (implies (and (integerp (/ (- a b) n))
+                (rationalp a)
+                (rationalp b)
+                (rationalp n)
+                (< 0 n))
+           (= (mod a n) (mod b n)))
+  :rule-classes ())
+
+(defthm mod-force-equal
+  (implies (and (< (abs (- a b)) n)
+                (rationalp a)
+                (rationalp b)
+                (integerp n))
+          (iff (= (mod a n) (mod b n))
+               (= a b)))
+  :rule-classes ())
+
+(defthm mod-mult
+    (implies (and (integerp a)
+                  (rationalp m)
+		  (rationalp n))
+	     (equal (mod (+ m (* a n)) n)
+		    (mod m n))))
+
+(defthm mod-force
+  (implies (and (<= (* a n) m)
+                (< m (* (1+ a) n))
+                (integerp a)
+                (rationalp m)
+                (rationalp n))
+           (= (mod m n) (- m (* a n))))
+  :rule-classes ())
+
+(defthm mod-bnd-3
+  (implies (and (< m (+ (* a n) r))
+                (<= (* a n) m)
+                (integerp a)
+                (case-split (rationalp m))
+                (case-split (rationalp n)))
+           (< (mod m n) r))
+  :rule-classes :linear)
+
+(defthmd mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ a (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthmd mod-mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ (mod a n) (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthm mod-diff
+  (implies (and (case-split (rationalp a))
+                (case-split (rationalp b)))
+           (equal (mod (- a (mod b n)) n)
+                  (mod (- a b) n))))
+
+(defthm mod-of-mod
+  (implies (and (case-split (natp k))
+                (case-split (natp n)))
+           (equal (mod (mod x (* k n)) n)
+                  (mod x n))))
+
+(defthm mod-of-mod-cor
+  (implies (and (<= b a)
+                (case-split (integerp b))
+                (case-split (integerp a)))
+           (equal (mod (mod x (expt 2 a)) (expt 2 b))
+                  (mod x (expt 2 b)))))
+
+(defthm mod-prod
+  (implies (and (rationalp m)
+                (rationalp n)
+                (rationalp k))
+           (equal (mod (* k m) (* k n))
+                  (* k (mod m n)))))
+
+(defthm mod012
+  (implies (integerp m)
+           (or (equal (mod m 2) 0)
+               (equal (mod m 2) 1)))
+  :rule-classes ())
+
+(defthm mod-plus-mod-2
+  (implies (and (integerp a)
+                (integerp b))
+           (iff (= (mod (+ a b) 2) (mod a 2))
+                (= (mod b 2) 0)))
+  :rule-classes ())
+
+(defthm mod-mod-2-not-equal
+  (implies (acl2-numberp m)
+           (not (= (mod m 2) (mod (1+ m) 2))))
+  :rule-classes ())
+
+(defthm mod-2*m+1-rewrite
+  (implies (integerp m)
+           (equal (mod (1+ (* 2 m)) 2) 1)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/bits.lisp acl2-6.3/books/rtl/rel9/support/lib1/bits.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/bits.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,850 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "basic")
+
+(local (include-book "../support/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0))))
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i))))))))
+
+(defthm bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (natp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :rule-classes ())
+
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+		(integerp k)
+		(<= 0 k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ())
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthm bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+;;See also bits-dont-match.
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+;;See also bits-match.
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthmd bitn-shift
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthmd bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m)))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (natp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+; The lemmas sumbits-badguy-is-correct and sumbits-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t)))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp m) (< 0 m)
+                              (integerp n) (< 0 n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;;Definition of the macro, cat:
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/bvecp-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib1/bvecp-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/bvecp-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/bvecp-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,65 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(local (include-book "../support/bvecp-helpers"))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (integerp (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+(local (include-book "../../arithmetic/basic"))
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/bvecp-raw-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib1/bvecp-raw-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/bvecp-raw-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/bvecp-raw-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,816 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;Contains bvecp lemmas about the RTL primitives.
+;Also contains type lemmas (non-negative integer, natp, etc.)
+
+(include-book "rtl")
+(include-book "rtlarr")
+;(include-book "util") ?
+(local (include-book "../support/bvecp-helpers"))
+(local (include-book "../support/bits"))
+(local (include-book "../support/bitn"))
+(local (include-book "../support/setbits"))
+(local (include-book "../support/setbitn"))
+(local (include-book "../support/logs"))
+(local (include-book "../support/lnot"))
+(local (include-book "../support/shft"))
+(local (include-book "../support/cat"))
+(local (include-book "../support/mulcat"))
+(local (include-book "../support/encode"))
+(local (include-book "../support/decode"))
+(local (include-book "../support/land"))
+(local (include-book "../support/lior"))
+(local (include-book "../support/lxor"))
+(local (include-book "../support/guards"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+(set-match-free-default :all)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(local (include-book "../../arithmetic/expo"))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;; bits
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+   (implies (and (<= (+ 1 i (- j)) k)
+                 (case-split (integerp k))
+                 )
+            (bvecp (bits x i j) k)))
+
+
+;; setbits
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k)))
+
+
+;; setbitn
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k)))
+
+
+
+;; log<
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+
+;; log<=
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+
+
+;; log>
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+
+
+;; log>=
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+
+
+;; log=
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+
+
+;; log<>
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+
+
+;; logand1
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+
+
+;; logior1
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+
+
+;; logxor1
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+
+
+;; lnot
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+;; bitn
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes ( :type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+;; shft
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k)))
+
+;; cat
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+
+;; logand
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n)))
+
+
+;; logior
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+
+;; mulcat
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n)))
+|#
+
+;; encode
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k)))
+           (bvecp (encode x n) k)))
+
+
+;; decode
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+;BOZO dup?
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+
+; land
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+;; lior
+
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+;; lxor
+
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+;; cat
+
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x)))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x)))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
+
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+(local (include-book "../../arithmetic/basic"))
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
+
+;remove these?
+
+
+;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
+;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
+;;;;;;;;;;;;;;;;;;; statements have no default.
+
+;maybe leave this one?
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t)))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t)))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t)))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t)))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t)))
+|#
+
+#|
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+|#
+
+#|
+;drop?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j))
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+|#
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/clocks.lisp acl2-6.3/books/rtl/rel9/support/lib1/clocks.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/clocks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/clocks.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,199 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Most or all of this was originally written by Eric Smith while an intern at AMD.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../support/clocks")
+
+; The analysis of clocks uses some new functions.
+; 
+; First, even and odd are not the same as evenp and oddp.  For one thing, even
+; and odd are defined recursively, and I've proved a bunch of nice rules about
+; them which we probably want to use and which may not be proved about evenp and
+; oddp (and which may be nicer than what is proveable about evenp and oddp).  One
+; nice property of even and odd is that each implies integerp.  (By contrast,
+; evenp returns t for non-numbers like nil or '(a b).)  So rules which would
+; naturally have both the hyp (integerp n) and the hyp (evenp n) now can just
+; have (even n).
+; 
+; Second, I also define a function, MOD4. I didn't want to use MOD itself in the
+; clocking logic because reasoning about clocks needs to be fast and predictable.
+; (I can imagine that we'll have rules about MOD, especially when doing FP
+; proofs, which will just get in the way of our reasoning about clocks. We might
+; even open up MOD on occasion.)  So, in order to get complete control over the
+; rules which fire when we reason about clocks, I introduced MOD4, which we
+; expect never to have to open after proving a nice set of rules about it.
+; 
+; Also, theorems about MOD4 may be nicer than their analogs for MOD.  For
+; example, MOD4 is always equal to 0, 1, 2, or 3, but (mod #c(0 1) 4) = #c(0 1),
+; which isn't even rational.
+
+(defund pedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 0)
+       (equal y 1)))
+
+(defund nedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 1)
+       (equal y 0)))
+
+(defmacro posedge (clk)
+  `(and (not (zp n))
+        (pedge (,clk (1- n)) (,clk n))))
+
+(defmacro negedge (clk)
+  `(and (not (zp n))
+        (nedge (,clk (1- n)) (,clk n))))
+
+(defthm pedge-known-false-1
+  (not (pedge x 0)))
+
+(defthm pedge-known-false-2
+  (not (pedge 1 y)))
+
+(defthm nedge-known-false-1
+  (not (nedge x 1)))
+
+(defthm nedge-known-false-2
+  (not (nedge 0 y)))
+
+
+; The call (defperiodic NAME TYPE) creates 1) a defun which defines NAME to be
+; a periodic signal of the specified TYPE and 2) a bvecp lemma for that defun
+; (all periodics have width 1).
+
+; We intend the user to smash certain periodic inputs to his top level module
+; and replace their translations with calls to defperiodic.
+
+; Currently we support the following types of periodic signals:
+
+#|
+
+'fast-clock : 
+
+ _   _   _   _   _   _   _
+| |_| |_| |_| |_| |_| |_| |_|
+
+
+'slow-clock-one-quantum-wide
+
+ _       _       _       _
+| |_____| |_____| |_____| |__
+
+
+'slow-clock-one-quantum-wide-shifted :
+
+     _       _       _       _
+____| |_____| |_____| |_____| |__
+
+
+'slow-clock-two-quanta-wide :
+
+ ___     ___     ___     ___     
+|   |___|   |___|   |___|   |___|
+
+
+'slow-clock-two-quanta-wide-shifted :
+
+     ___     ___     ___     
+|___|   |___|   |___|   |___|
+
+'always-1 :
+
+  ___________________________
+..
+
+
+|#
+
+; As the need arises, we can easily change defperiodic to add support for more
+; types of signal.
+
+; BTW, currently, the definitions generated by defperiodic return unknown
+; values (calls to reset) at time 0 (and whenever N is not a natp).  Perhaps
+; this is too conservative, and perhaps defining the value at time 0 would
+; allow nicer rewrite rules to be proved.
+
+(defconst *defperiodic-types*
+
+; Keep this in sync with the corresponding definition in the compiler.
+
+  '(fast-clock
+    slow-clock-one-quantum-wide
+    slow-clock-one-quantum-wide-shifted
+    slow-clock-two-quanta-wide
+    slow-clock-two-quanta-wide-shifted
+    always-1))
+
+(defmacro defperiodic (name type)
+  (declare (xargs :guard (member-eq type *defperiodic-types*)))
+  (list*
+   'encapsulate
+   nil
+   (case type
+     (fast-clock
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (even n) 1 0))))
+     (slow-clock-one-quantum-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 0 (mod4 n)) 1 0))))
+     (slow-clock-one-quantum-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 2 (mod4 n)) 1 0))))
+     (slow-clock-two-quanta-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 0 (mod4 n))
+                   (equal 1 (mod4 n)))
+               1
+             0))))
+     (slow-clock-two-quanta-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 2 (mod4 n))
+                   (equal 3 (mod4 n)))
+               1
+             0))))
+     (always-1
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           1)))
+     (otherwise (er hard 'defperiodic
+                    "Bad type, ~x0, for defperiodic."
+                    type)))
+   `((defbvecp ,name (n) 1 :hints (("Goal" :in-theory (enable ,name)))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/float.lisp acl2-6.3/books/rtl/rel9/support/lib1/float.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/float.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,461 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "log")
+
+(local (include-book "../support/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ())
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ())
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ())
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ())
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/log.lisp acl2-6.3/books/rtl/rel9/support/lib1/log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/log.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,854 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "bits")
+
+(local (include-book "../support/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                     LNOT
+;;;**********************************************************************
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthmd lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot x n) k)))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n))))))
+
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n)))))))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n))))
+
+(defthm mod-lnot
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot x n) (expt 2 k))
+                  (lnot (mod x (expt 2 k)) k))))
+
+(defthmd bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j))))))
+
+(defthmd bitn-lnot
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn (lnot x n) k)
+		  (if (< k n)
+		      (lnot (bitn x k) 1)
+		    0))))
+
+(defthmd lnot-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot (cat x m y n) l)
+		  (cat (lnot x m) m (lnot y n) n))))
+
+
+;;;**********************************************************************
+;;;                LAND, LIOR, and LXOR
+;;;**********************************************************************
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land)))
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior)))
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor)))
+
+(defun logop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (logop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun logop-3-induct (x y z)
+  (declare (xargs :measure (:? z y x)))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(logop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defthm land-x-y-0
+    (equal (land x y 0) 0))
+
+(defthm lior-x-y-0
+    (equal (lior x y 0) 0))
+
+(defthm lxor-x-y-0
+    (equal (lxor x y 0) 0))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0) y n)
+         (land x y n)))
+
+(defthmd land-bits-2
+  (equal (land x (bits y (1- n) 0) n)
+         (land x y n)))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0) y n)
+         (lior x y n)))
+
+(defthmd lior-bits-2
+  (equal (lior x (bits y (1- n) 0) n)
+         (lior x y n)))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0) y n)
+         (lxor x y n)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x (bits y (1- n) 0) n)
+         (lxor x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land x y n) k)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior x y n) k)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor x y n) k)))
+
+(defthm land-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land x y n) m)))
+
+(defthm lior-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior x y n) m)))
+
+(defthm lxor-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor x y n) m)))
+
+(defthmd land-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land x y m) (land x y n))))
+
+(defthmd lior-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior x y m) (lior x y n))))
+
+(defthmd lxor-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor x y m) (lxor x y n))))
+
+(defthmd land-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lior-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lxor-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (bitn x 0) (bitn y 0) 1)))))
+
+(defthm land-0
+  (equal (land 0 y n)
+	 0))
+
+(defthmd land-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land i j 1))
+		  (or (equal i 0)
+		      (equal j 0)))))
+
+(defthm lior-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior 0 y n) y)))
+
+(defthmd lior-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior x y n))
+		  (and (equal x 0)
+		       (equal y 0)))))
+
+(defthm lxor-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor 0 y n) y)))
+
+(defthm land-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land x y (- n k)))))
+  :rule-classes ())
+
+(defthm lxor-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor x y (- n k)))))
+  :rule-classes ())
+
+(defthm lior-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior x y (- n k)))))
+  :rule-classes ())
+
+(defthmd fl-land
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
+                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lior
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
+                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lxor
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
+                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd mod-land
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land x y n) (expt 2 k))
+                  (land x y k))))
+
+(defthmd mod-lior
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior x y n) (expt 2 k))
+                  (lior x y k))))
+
+(defthmd mod-lxor
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor x y n) (expt 2 k))
+                  (lxor x y k))))
+
+(defthm bits-land
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (land x y n) i j)
+		  (land (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lior
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lior x y n) i j)
+		  (lior (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lxor
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lxor x y n) i j)
+		  (lxor (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bitn-land
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (land x y n) k)
+		  (if (< k n)
+		      (land (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lior
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lior x y n) k)
+		  (if (< k n)
+		      (lior (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lxor
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lxor x y n) k)
+		  (if (< k n)
+		      (lxor (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthmd land-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (land x1 x2 m) m (land y1 y2 n) n))))
+
+(defthm land-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land c (cat x2 m y2 n) l)
+		  (cat (land (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (land (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lior-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lior x1 x2 m) m (lior y1 y2 n) n))))
+
+(defthm lior-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior c (cat x2 m y2 n) l)
+		  (cat (lior (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lior (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lxor-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n))))
+
+(defthm lxor-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor c (cat x2 m y2 n) l)
+		  (cat (lxor (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthm land-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land x y n) x))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior x y n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm lxor-bnd
+  (<= (lxor x y n) (lior x y n))
+  :rule-classes (:rewrite :linear))
+
+(defthmd lior-plus
+  (implies (= (land x y n) 0)
+           (equal (lior x y n)
+                  (+ (bits x (1- n) 0)
+                     (bits y (1- n) 0)))))
+
+(defthmd land-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m)))))))
+
+(defthm lior-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ())
+
+(defthmd land-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land x (expt 2 k) n)
+		  (* (expt 2 k) (bitn x k)))))
+
+(defthm lior-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior x (expt 2 k) n)
+		(+ (bits x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ())
+
+(defthmd lxor-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor x (expt 2 k) n)
+		  (+ (bits x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn x k))))))))
+
+(defthm land-ones
+  (equal (land (1- (expt 2 n)) x n)
+	 (bits x (1- n) 0))
+  :rule-classes nil)
+
+(defthm land-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land k x n)
+		  (bits x (1- n) 0))))
+
+(defthm lior-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ())
+
+(defthm lior-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior k x n)
+		  (1- (expt 2 n)))))
+
+(defthm lxor-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor (1- (expt 2 n)) x n)
+		  (lnot x n)))
+  :rule-classes ())
+
+(defthm lxor-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor k x n)
+		  (lnot x n))))
+
+(defthm land-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ())
+
+(defthmd lior-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j))))
+
+(defthmd lxor-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i) (- n i)
+                       (lnot (bits x (1- i) j) (- i j)) (- i j)
+                       (bits x (1- j) 0) j))))
+
+(defthmd land-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot (lnot x n) n)
+		  x)))
+
+(defthm land-commutative
+  (equal (land y x n)
+	 (land x y n)))
+
+(defthm lior-commutative
+  (equal (lior y x n)
+	 (lior x y n)))
+
+(defthm lxor-commutative
+  (equal (lxor y x n)
+	 (lxor x y n)))
+
+(defthm land-associative
+  (equal (land (land x y n) z n)
+	 (land x (land y z n) n)))
+
+(defthm lior-associative
+  (equal (lior (lior x y n) z n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-associative
+  (equal (lxor (lxor x y n) z n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-commutative-2
+  (equal (land y (land x z n) n)
+	 (land x (land y z n) n)))
+
+(defthm lior-commutative-2
+  (equal (lior y (lior x z n) n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-commutative-2
+  (equal (lxor y (lxor x z n) n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land x (land y z n) n)
+		  (land (land x y n) z n))))
+
+(defthm lior-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior x (lior y z n) n)
+		  (lior (lior x y n) z n))))
+
+(defthm lxor-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor x (lxor y z n) n)
+		  (lxor (lxor x y n) z n))))
+
+(defthm land-self
+  (equal (land x x n)
+	 (bits x (1- n) 0)))
+
+(defthm lior-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior x x n) x)))
+
+(defthm lxor-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor x x n) 0)))
+
+(defthmd lior-land-1
+  (equal (lior x (land y z n) n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd lior-land-2
+  (equal (lior (land y z n) x n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd land-lior-1
+  (equal (land x (lior y z n) n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd land-lior-2
+  (equal (land (lior y z n) x n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd lior-land-lxor
+  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
+	 (lior (land x y n) (land (lxor x y n) z n) n)))
+
+(defthmd lxor-rewrite
+  (equal (lxor x y n)
+	 (lior (land x (lnot y n) n)
+	       (land y (lnot x n) n)
+	       n)))
+
+(defthmd lnot-lxor
+  (equal (lnot (lxor x y n) n)
+	 (lxor (lnot x n) y n)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/openers.lisp acl2-6.3/books/rtl/rel9/support/lib1/openers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/openers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/openers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,74 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/openers"))
+
+(program)
+
+; In this file, an event-control (evctl) data structure is either (posedge
+; clk), (negedge clk), or (even n).
+
+(defun negate-event-control (evctl)
+  (if (equal evctl '(even n))
+      (list 'not evctl)
+    (let* ((edge0 (car evctl))
+           (clk (cadr evctl))
+           (edge (case edge0
+                   (posedge 'pedge)
+                   (negedge 'nedge)
+                   (otherwise
+                    (er hard 'gen-model-preamble-common
+                        "Unable to handle edge specifier ~x0."
+                        edge0)))))
+      `(not (,edge (,clk (1- n)) (,clk n))))))
+
+(defun negate-event-control-list (x)
+  (declare (xargs :guard (true-listp x)))
+  (if (endp x)
+      nil
+    (cons (negate-event-control (car x))
+          (negate-event-control-list (cdr x)))))
+
+(defmacro def$open (name type &rest evctl-lst)
+  (if (eq type :skipped)
+      `(value-triple '(def$open ,name :skipped))
+    (let ((evctl-lst (if (eq type :input)
+                         (assert$ (null evctl-lst)
+                                  '((even n)))
+                       evctl-lst)))
+      `(defthm ,(intern-in-package-of-symbol
+                 (concatenate 'string (symbol-name name) "$OPEN")
+                 name)
+         (implies (and (integerp n)
+                       (< 0 n)
+                       ,@(negate-event-control-list evctl-lst))
+                  (equal (,name n)
+                         (,name (1- n))))
+         :hints (("Goal"
+                  :expand ((,name n)
+                           ,@(and (eq type :wire) `((,name (1- n)))))))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/package-defs.lisp acl2-6.3/books/rtl/rel9/support/lib1/package-defs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/package-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/package-defs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,82 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/package-defs"))
+
+;;Miscellaneous symbols that are not in *acl2-exports*:
+
+(defmacro other-acl2-symbols ()
+  ''(local-defun local-defthm local-in-theory
+                 n ; clock argument
+                 defbvecp ; macro written out by compiler
+                 defclock ; macro written out by compiler
+                 defperiodic
+                 fast-clock  ;BOZO, is importing these into the packages, the right way to handle this?
+                 slow-clock-one-quantum-wide
+                 slow-clock-one-quantum-wide-shifted
+                 slow-clock-two-quanta-wide
+                 slow-clock-two-quanta-wide-shifted
+                 always-1
+                 posedge negedge edge ; for defclock macro, which we used to use
+                 pedge nedge ;for defperiodic macro
+                 $path ; path argument of signal functions
+                 sub1-induction ; for bvecp lemma hints
+                 ))
+
+;;Symbols that occur in the RTL translation.  Formerly the symbol UNKNOWN was excluded from this
+;;list so that the corresponding symbol in the "*" package could be assigned a different function
+;;definition; but the first argument of unknown can be in any package desired.
+
+(defmacro rtl-symbols ()
+  ''(log= log<> log< log<= log> log>= lnot logand1 logior1 logxor1 shft lshft
+          rshft cat mulcat bitn bits setbits setbitn mod+ mod* mod- bind
+          case-select if1 cond1 reset reset2 land lior lxor lcat n! arr0 natp1
+          as ag mk-bvarr mk-bvec ag2 as2
+          abs trunc near minf inf sticky sig expo bitvec ; appeared May 2004 (from rpl_main.cc)
+          expt ; appeared May 2004 (seems to come from r2s)
+          prop gen
+          unknown unknown2))
+
+;;Functions that are defined in the FP library:
+
+(defmacro fp-symbols ()
+  ''(natp fl cg fl-half bvecp bv-arrp sumbits sigm kap tau lamt lamg lamz lam1 lam2 lam3 lam4 lam0 lamb
+          expo sgn sig 
+          exactp fp+ bias esgnf eexpof esigf erepp eencodingp eencode edecode ndecode rebias-expo isgnf iexpof isigf 
+          nrepp drepp irepp nencodingp dencodingp iencodingp nencode dencode iencode ddecode idecode trunc away re 
+          near near-witness near+ sticky oddr kp inf minf ieee-mode-p rnd flip
+          rnd-const drnd drnd-original))
+
+;;ACL2 symbols that are imported by all packages:
+
+(defmacro shared-symbols ()
+  '(union-eq *acl2-exports*
+    (union-eq *common-lisp-symbols-from-main-lisp-package*
+     (union-eq (other-acl2-symbols)
+      (union-eq (fp-symbols)
+       (rtl-symbols))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/reps.lisp acl2-6.3/books/rtl/rel9/support/lib1/reps.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/reps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/reps.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,540 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/ereps"))
+(local (include-book "../support/ireps"))
+(local (include-book "../support/guards"))
+
+(include-book "log")
+(include-book "float")
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;BOZO add rewrite rule?
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;BOZO disable?
+(defun esgnf  (x p q) (bitn x (+ p q)))
+(defun eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defun esigf  (x p)   (bits x (1- p) 0))
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+(defthm eencodingp-not-zero
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode x p q) 0))))
+
+(defthm erepp-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode x p q) p q)))
+
+
+(defthm eencodingp-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp (eencode x p q) p q) ))
+
+(defthm edecode-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode (eencode x p q) p q)
+		    x)))
+
+(defthm eencode-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode (edecode x p q) p q)
+		    x)))
+
+(defthm expo-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode x p q))
+		    (- (eexpof x p q) (bias q)))))
+
+(defthm sgn-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode  x p q))
+		    (if (= (esgnf x p q) 0) 1 -1))))
+
+(defthm sig-edecode
+    (implies (and (eencodingp  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode  x p q))
+		    (/ (esigf x p) (expt 2 (- p 1))))))
+
+;BOZO disable?
+(defun rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(defund iencodingp (x p q)
+  (or (nencodingp x p q)
+      (dencodingp x p q)))
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp-and-dencodingp
+    (implies (iencodingp x p q)
+	     (iff (nencodingp x p q) (not (dencodingp x p q))))
+  :rule-classes ())
+
+
+;;Encoding functions:
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(defund iencode (x p q)
+  (cond ((nrepp x p q)
+	 (nencode x p q))
+	((drepp x p q)
+	 (dencode x p q))))
+
+
+;;Decoding functions:
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(defund idecode (x p q)
+  (cond ((nencodingp x p q)
+	 (ndecode x p q))
+	((dencodingp x p q)
+	 (ddecode x p q))))
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+(defthm sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+(defthm sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+(defthm sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+(defthm sgn-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode x p q))
+	      (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode x p q))
+	      (cond ((nencodingp x p q)
+		     (- (iexpof x p q) (bias q)))         
+		    ((dencodingp x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))))
+
+(defthm sig-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode x p q))
+		    (cond ((nencodingp x p q)
+			   (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
+			  ((dencodingp x p q)
+			   (sig (isigf x p)))))))
+
+
+;;Inversions:
+
+(defthm dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+(defthm iencodingp-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp (iencode x p q) p q)))
+
+(defthm nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+(defthm drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+(defthm irepp-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode x p q) p q)))
+
+(defthm nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+(defthm ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+(defthm ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+(defthm idecode-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode (iencode x p q) p q)
+		    x)))
+
+(defthm nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+(defthm dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+(defthm iencode-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode (idecode x p q) p q)
+		    x)))
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/rom-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib1/rom-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/rom-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/rom-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,65 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/rom-helpers"))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+(local (in-theory (enable bvecp)))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x))))
+
+(defun check-array (name a dim1 dim2)
+  (if (zp dim1)
+      t
+    (and (bvecp (aref1 name a (1- dim1)) dim2)
+	 (check-array name a (1- dim1) dim2))))
+
+(defthm check-array-lemma-1
+    (implies (and (not (zp dim1))
+		  (check-array name a dim1 dim2)
+		  (natp i)
+		  (< i dim1))
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+(defthm check-array-lemma
+    (implies (and (bvecp i n)
+		  (not (zp (expt 2 n)))
+		  (check-array name a (expt 2 n) dim2))		  
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/round.lisp acl2-6.3/books/rtl/rel9/support/lib1/round.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/round.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/round.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1949 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top"))
+
+(include-book "reps")
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;**********************************************************************
+;;;                            TRUNC
+;;;**********************************************************************
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+;replaces trunc-pos
+;BOZO now a rewrite rule too; okay?
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+;replaces trunc-neg
+;BOZO now a rewrite rule too; okay?
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n)
+		  )
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a)
+		  )
+	     (<= a (trunc x n))))
+
+;we called int-trunc
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-3
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-4
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (trunc x n) (- x (* (abs x) (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                )
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n)
+		  )
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m)
+		  )
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm plus-trunc-alt
+  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp j))
+           (= (trunc (+ x y) j)
+              (+ x
+                 (trunc y (+ j (- (expo (+ x y))) (expo y))))))
+  :rule-classes ())
+
+(defthmd plus-trunc-corollary
+  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
+                (exactp x n)
+                (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp n))
+           (= (trunc (+ x y) n) x)))
+
+(defthm trunc-plus
+    (implies (and (rationalp y)
+		  (> y 0)
+		  (integerp e)
+		  (< y (expt 2 e))
+		  (integerp m)
+		  (> m 0)
+		  (integerp k)
+		  (> k 0)
+		  (<= m (1+ k)))
+	     (= (trunc (+ (expt 2 e) (trunc y k)) m)
+		(trunc (+ (expt 2 e) y) m)))
+  :rule-classes ())
+
+(defthm trunc-n+k
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  ;;this isn't really needed, but it won't hurt me.
+		  (not (exactp x n))          
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n)))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
+		   (expt 2 e))))
+  :rule-classes ())
+
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0)
+                )
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ())
+
+(defthm trunc-land
+    (implies (and (>= x (expt 2 (1- n)))
+		  (< x (expt 2 n))
+                  (integerp x) (> x 0)
+		  (integerp m) (>= m n)
+		  (integerp n) (> n k)
+		  (integerp k) (> k 0)
+		  )
+	     (= (trunc x k)
+		(land x (- (expt 2 m) (expt 2 (- n k))) n)))
+  :rule-classes ())
+
+
+(defthm trunc-away-a
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m)))))))
+
+;;;**********************************************************************
+;;;                            AWAY
+;;;**********************************************************************
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+;replaces away-pos
+;BOZO wasn't a rewrite rule..
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+;replaces away-neg
+;BOZO wasn't a rewrite rule..
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (away x n))))
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+;; ;; (defthmd expo-away-lower-bound
+;; ;;     (implies (and (rationalp x)
+;; ;; 		  (integerp n)
+;; ;; 		  (> n 0))
+;; ;; 	     (>= (expo (away x n)) (expo x)))
+;; ;;   :rule-classes :linear)
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+                  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-1
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd away-upper-3
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+(defthm away-exactp-d
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+
+;; (defthm expo-away
+;;     (implies (and (rationalp x)
+;; 		  (not (= x 0))
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (away x n))
+;;                    (expo x)))
+;;   :rule-classes ())
+
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm plus-away-alt
+  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp j))
+           (= (away (+ x y) j)
+              (+ x
+                 (away y (+ j (- (expo (+ x y))) (expo y))))))
+  :rule-classes ())
+
+(defthmd plus-away-corollary
+  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
+                (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (integerp n)
+                (exactp x n))
+           (= (away (+ x y) n)
+              (fp+ x n))))
+
+(defthm trunc-away-b
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+;bad name?
+(defthm minus-trunc-4
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< y x)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+;BOZO move to away section?
+(defthm minus-trunc-5
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                            NEAR
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near1-a
+  (implies (and (< (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n))) (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+(defthm near-pos
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:TYPE-PRESCRIPTION :LINEAR))
+
+(defthmd near-neg
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:TYPE-PRESCRIPTION :LINEAR))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+(defthmd sgn-near-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  ;; (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  ;;(> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+;was called monotone-near
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;; (< 0 x)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+(defthm near2
+  (implies (and (exactp y n)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+(defthm near-est
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) )
+                  ;;(> x 0))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+(defthm near-a-a
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (> x (+ a (expt 2 (- (expo a) n)))))
+	     (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
+  :rule-classes ())
+
+(defthm near-a-b
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x (+ a (expt 2 (- (expo a) n)))))
+	     (<= (near x n) a))
+  :rule-classes ())
+
+(defthm near-a-c
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (>= (near x n) a))
+  :rule-classes ())
+
+(defthm near-exact
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                            NEAR+
+;;;**********************************************************************
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+(defthm sgn-near+-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(* (sgn x) (near+ (abs x) n))))
+  :rule-classes ())
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+(defthm near+-pos
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+;BOZO make :t-p?
+(defthm near+-neg
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+ 		  (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+ 		  (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+2
+  (implies (and (exactp y n)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+    :rule-classes ())
+
+
+;was called monotone-near+
+
+;; (defthm near+-monotone
+;;   (implies (and (<= x y)
+;;                 (rationalp x)
+;;                 (rationalp y)
+;;                 (< 0 x)
+;;                 (integerp n)
+;;                 (> n 0))
+;;            (<= (near+ x n) (near+ y n))))
+
+(defthm near+-monotone
+   (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(integerp n)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+ 
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+(defthm near+-exactp-c
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (rationalp a)
+                (exactp a n)
+                (>= a x))
+           (>= a (near+ x n))))
+
+(defthm near+-exactp-d
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (rationalp a)
+                (exactp a n)
+                (<= a x))
+           (<= a (near+ x n))))
+
+;; (defthm near+-exactp-c
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (>= a x))
+;; 	     (>= a (near+ x n))))
+
+;; (defthm near+-exactp-d
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (<= a x))
+;; 	     (<= a (near+ x n))))
+
+
+;;;**********************************************************************
+;;;                           STICKY
+;;;**********************************************************************
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defthm sticky-1
+  (implies (rationalp x)
+           (equal (sticky x 1)
+                  (* (sgn x) (expt 2 (expo x))))))
+
+(defthmd sticky-pos
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+(defthm sticky-exactp
+    (implies (and (rationalp x) ;; (>= x 0)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+(defthm trunc-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+(defthm away-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+(defthm away-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+
+(defthm near-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+
+(defthm near+-sticky
+    (implies (and (rationalp x) 
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+ 
+(defthm sticky-plus-original ;; Fri Oct 13 14:40:05 2006
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+(defthm minus-sticky
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (- x (sticky y k))
+		(sticky (- x y) k2)))
+  :rule-classes ())
+
+(defthm sticky-lemma
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+;;;**********************************************************************
+;;;                              ODDR 
+;;;**********************************************************************
+
+;was called "odd" but that name conflicted with another function we wanted (a recursive version of oddp)
+(defund oddr (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x)))))
+    (if (evenp z)
+	(* (sgn x) (1+ z) (expt 2 (- (1+ (expo x)) n)))
+      (* (sgn x) z (expt 2 (- (1+ (expo x)) n))))))
+
+(defthm oddr-pos
+    (implies (and (< 0 x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< 0 (oddr x n)))
+  :rule-classes ())
+
+(defthm oddr>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (oddr x n) (trunc x n)))
+  :rule-classes ())
+
+;keep disabled..
+(defthmd oddr-rewrite
+    (implies (and (< 0 x)
+                  (rationalp x)
+		  (integerp n)
+		  (< 0 n))
+	     (equal (oddr x n)
+		    (let ((z (fl (* (expt 2 (- (1- n) (expo x))) x))))
+		      (if (evenp z)
+			  (* (1+ z) (expt 2 (- (1+ (expo x)) n)))
+			(* z (expt 2 (- (1+ (expo x)) n))))))))
+
+(defthm oddr-other
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n) 
+		  (> n 1))
+	     (= (oddr x n)
+		(+ (trunc x (1- n))
+		   (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ())
+
+(defthm expo-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (equal (expo (oddr x n)) (expo x))))
+
+(defthm exactp-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (exactp (oddr x n) n))
+  :rule-classes ())
+
+(defthm not-exactp-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (not (exactp (oddr x n) (1- n))))
+  :rule-classes ())
+
+(defthm trunc-oddr
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (> n m))
+	     (= (trunc (oddr x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+(defun kp (k x y)
+  (+ k (- (expo (+ x y)) (expo y))))
+
+(defthm oddr-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (> x 0)
+		  (> y 0)
+		  (> k 1)
+		  (> (+ (1- k) (- (expo x) (expo y))) 0)
+		  (exactp x (+ (1- k) (- (expo x) (expo y)))))
+	     (= (+ x (oddr y k))
+		(oddr (+ x y) (kp k x y))))
+  :rule-classes ())
+
+(defthm trunc-trunc-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (trunc x k) (trunc (oddr y m) k)))
+  :rule-classes ())
+
+(defthm away-away-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (away x k) (away (oddr y m) k)))
+  :rule-classes ())
+
+(defthm near-near-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (near x k) (near (oddr y m) k)))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;        IEEE Rounding (most theorems also apply to AWAY and NEAR+) 
+;;;**********************************************************************
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defund ieee-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-pos
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :RULE-CLASSES (:TYPE-PRESCRIPTION))
+
+(defthm rnd-neg
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :RULE-CLASSES (:TYPE-PRESCRIPTION))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+(defthmd sgn-rnd
+    (implies (and; (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+;a very similar rule was called rnd-flip
+;enable?
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  ;(> x 0)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  ;(> x 0)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+                  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (integerp n)
+                  (> n 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+(defthm exactp-rnd
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (rnd x mode n) n)))
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  ;; (not (= x 0))
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+(defthm expo-rnd-bnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (>= (expo (rnd x mode n))
+		 (expo x)))
+  :rule-classes ())
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+(defun roundup (x mode n)
+; Returns T when we should add an ulp after truncating x to n digits.
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ())
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+(defund drnd-original (x mode n k)
+  (- (rnd (+ x (* (sgn x) (expt 2 (- 2 (expt 2 (1- k)))))) mode n)
+     (* (sgn x) (expt 2 (- 2 (expt 2 (1- k)))))))
+
+(defthm drnd-original-0
+  (equal (drnd-original 0 mode n k)
+         0))
+
+; a very similar rule was called drnd-original-flip
+(defthmd drnd-original-minus
+  (equal (drnd-original (* -1 x) mode n k)
+         (* -1 (drnd-original x (flip mode) n k))))
+
+(defthm drnd-original-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp n)
+		  (> n 0)
+		  (natp m)
+		  (> m 1)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (<= (expo x) (- 1 (expt 2 (1- k))))
+		  (<= (expo x) (- m (+ n (expt 2 (1- k))))))
+	     (equal (drnd-original (sticky x m) mode n k)
+		    (drnd-original x mode n k)))
+  :rule-classes ())
+
+(defthm drnd-original-tiny-equal
+    (implies (and (ieee-mode-p m)
+		  (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (< (abs x) (expt 2 (- 2 (+ n (expt 2 (1- k))))))
+		  (rationalp y)
+		  (< (abs y) (expt 2 (- 2 (+ n (expt 2 (1- k))))))
+		  (equal (sgn x) (sgn y)))
+	     (equal (drnd-original x m n k)
+		    (drnd-original y m n k)))
+  :rule-classes ())
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+;;These next three show that spn really is what it claims to be
+
+(defthm positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+;;These next three show that spd really is what it claims to be
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+;; (defthm positive-spd
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0))
+;;            (> (spd p q) 0))
+;;     :rule-classes  :linear)
+
+(defthm drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthm smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+;DRND returns a denormal, or zero, or the smallest normal:
+
+(defthm drnd-original-type
+  (implies (and (rationalp x)
+                (<= (abs x) (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd-original x mode n k) n k)
+               (= (drnd-original x mode n k) 0)
+               (= (drnd-original x mode n k) (* (sgn x) (spn k)))))
+  :rule-classes ())
+
+(defthmd drnd-original-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn k))
+                (common-rounding-mode-p mode)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (equal (drnd-original x mode n k)
+                  (rnd x 
+                       mode
+                       (+ n 
+                          (- (expo (spn k))) 
+                          (expo x))))))
+
+(defthm drnd-original-of-drepp-is-NOP
+  (implies (and (drepp x n k)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd-original x mode n k)
+                  x)))
+
+(defthm drnd-original-spn-is-spn-general
+  (implies (and (= (abs x) (spn k))
+                (common-rounding-mode-p mode)
+                (integerp n)
+                (>= n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x))
+           (= (drnd-original x mode n k) x)))
+
+(defthm drnd-original-trunc-never-goes-away-from-zero
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k)))
+           (<= (abs (drnd-original x 'trunc n k))
+               (abs x))))
+
+(defthm drnd-original-away-never-goes-toward-zero
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k)))
+           (>= (abs (drnd-original x 'away n k))
+               (abs x))))
+
+(defthm drnd-original-inf-never-goes-down
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k)))
+           (>= (drnd-original x 'inf n k)
+               x)))
+
+(defthm drnd-original-minf-never-goes-up
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k)))
+           (<= (drnd-original x 'minf n k)
+               x)))
+
+(defthm drnd-original-trunc-skips-no-denormals
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (drepp a n k)
+                (<= (abs a) (abs x))
+                )
+           (<= (abs a)
+               (abs (drnd-original x 'trunc n k)))))
+
+(defthm drnd-original-away-skips-no-denormals
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (drepp a n k)
+                (>= (abs a) (abs x))
+                )
+           (>= (abs a) (abs (drnd-original x 'away n k)))))
+
+
+(defthm drnd-original-inf-skips-no-denormals
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (drepp a n k)
+                (>= a x))
+           (>= a (drnd-original x 'inf n k))))
+
+(defthm drnd-original-minf-skips-no-denormals
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (drepp a n k)
+                (<= a x))
+           (<= a (drnd-original x 'minf n k))))
+
+(defthm drnd-original-diff
+  (implies (and (rationalp x)
+                (<= (ABS X) (SPN K))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd-original x mode n k))) (spd n k))))
+
+(defund next-denormal (x n k)
+  (+ x (spd n k)))
+
+;;NEXT-DENORMAL behaves as expected:
+
+(defthm denormal-spacing
+  (implies (and (integerp n)
+                (integerp k)
+                (> k 0)
+                (> n 1)
+                (drepp x n k)
+                (drepp x+ n k)
+                (>= x 0)
+                (> x+ x))
+           (>= x+ (next-denormal x n k))))
+
+(defthm no-denormal-is-closer-than-what-drnd-original-near-returns
+  (implies (and (rationalp x)
+                (<= (abs x) (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (drepp a n k))
+           (>= (abs (- x a)) (abs (- x (drnd-original x 'near n k))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/rtl.lisp acl2-6.3/books/rtl/rel9/support/lib1/rtl.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/rtl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/rtl.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,699 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;This book contains definitions of the ACL2 functions that are used in the
+;;formalization of RTL semantics.
+
+
+;;Bit-vector access:
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp m) (< 0 m)
+                              (integerp n) (< 0 n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;;LNOT (bitwise complement):
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+;LAND (bitwise and):
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec ; (land0 x y n)
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land)) to refer to binary-land.
+(add-macro-alias land binary-land)
+
+;;LIOR (bitwise inclusive or):
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec ; (lior0 x y n)
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior)) to refer to binary-lior:
+(add-macro-alias lior binary-lior)
+
+;;LXOR (bitwise exclusive or):
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor0 x y n)
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
+(add-macro-alias lxor binary-lxor)
+
+
+;;Bit-vector update:
+
+; We have decided to allow setbits to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits x w n n y))
+
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;;Signed inequalities:
+
+(defund comp2 (x n)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;;Unary logical operations:
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;;Shifting operations:
+
+(defund shft (x s l)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;;Arithmetic operations
+
+(defmacro mod+ (x y n)
+  `(bits (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod* (x y n)
+  `(bits (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
+i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
+get rid of the bits call.
+|#
+
+(defmacro mod- (x y n)
+  `(bits (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still
+;; need to add assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+
+;;Evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO Where in lib/ should these go?
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;;Natural number recognizer
+
+(defund natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(defund bvecp (x k)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+(defun mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+
+; Finally, we include bvecp (and, occasionally, related) lemmas for several
+; functions that are disabled.  These are not included elsewhere, presumably
+; because the functions will generally be enabled (hence blown away) by the
+; user.
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (shft x s n) k)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+;;The definitions of these functions are best disabled:
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable mk-bvec))
+(in-theory (disable if1))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/rtlarr.lisp acl2-6.3/books/rtl/rel9/support/lib1/rtlarr.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/rtlarr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/rtlarr.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,258 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/rtlarr"))
+(local (include-book "../support/bvecp-helpers"))
+(local (include-book "../support/guards"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+;;We define generic record accessing and updating functions to be used 
+;;with RTL arrays.  The basic functions are (ag a r) and (as a v r)
+;;where a is an array index, v is a value, r is an "array" or record.
+;;(ag a r) returns the value at index a in array r, and (as a v r) returns 
+;;a new array with index a set to value v in array r.
+
+(include-book "misc/total-order" :dir :system)
+
+(include-book "rtl")
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;Basic properties of arrays:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r)))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;; OK, we add here some properties for typing the records and the values which
+;; are stored in the records. This "typing" is pretty generic, but we choose the
+;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
+
+(defun bv-arrp (x k)
+  (declare (xargs :guard (integerp k)))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (bv-arrp (cdr x) k)
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (bvecp (cdar x) k)
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm as-maps-bv-arr-to-bv-arr
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as a v r) k)))
+
+(defthm ag-maps-bv-arr-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag a r) k)))
+
+(defun mk-bvarr (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bv-arrp r k) r ()))
+
+(defthm mk-bvarr-is-bv-arrp
+  (bv-arrp (mk-bvarr r k) k))
+
+(defthm mk-bvarr-identity
+  (implies (bv-arrp r k)
+           (equal (mk-bvarr r k) r)))
+
+(in-theory (disable bv-arrp mk-bvarr))
+
+;;We also define as2 and ag2 for 2-dimensional arrays but these simply
+;;macro-expand into appropriate as and ag calls.
+
+(defmacro ag2 (a b r)
+  `(ag (cons ,a ,b) ,r))
+
+(defmacro as2 (a b v r)
+  `(as (cons ,a ,b) ,v ,r))
+
+
+;;We disable as and ag, assuming the rules proved in this book are 
+;;sufficient to manipulate any record terms that are encountered.
+
+(in-theory (disable as ag))
+
+(defun positive-integer-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (equal l nil))
+        (t (and (integerp (car l))
+                (< 0 (car l))
+                (positive-integer-listp (cdr l))))))
+
+(defmacro arr0 (&rest dims)
+  (declare (ignore dims)
+           (xargs :guard (positive-integer-listp dims)))
+  nil)
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(encapsulate 
+ ((reset2 (key size) t))
+ (local (defun reset2 (key size) (declare (ignore key size)) nil))
+ (defthm bv-arrp-reset2
+   (bv-arrp (reset2 key size) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+(encapsulate 
+ ((unknown2 (key size n) t))
+ (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
+ (defthm bv-arrp-unknown2
+   (bv-arrp (unknown2 key size n) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+;BOZO where in lib/ should this go?
+(defthm bv-arrp-if1
+  (equal (bv-arrp (if1 x y z) n)
+         (if1 x (bv-arrp y n) (bv-arrp z n))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib1/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/simple-loop-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,348 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(include-book "arith")
+(include-book "log")
+(local (include-book "../support/simple-loop-helpers"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I)))
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;not in support/simple-loop-helpers since would be redefined here (which is illegal)
+
+(deftheory simple-loop-thy-0
+  (union-theories '(if1) (theory 'minimal-theory)))
+
+(deftheory simple-loop-thy-1
+  (union-theories
+   '(bitn-setbitn-not-equal
+     ag-diff-as
+     bits-31-0
+     natp)
+   (theory 'simple-loop-thy-0)))
+
+(in-theory (enable setbits))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib1/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/simplify-model-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,107 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "arith")
+(include-book "bits")
+(local (include-book "../support/simplify-model-helpers"))
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1)))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(in-theory (enable bvecp-monotone))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/top.lisp acl2-6.3/books/rtl/rel9/support/lib1/top.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/top.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,59 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "misc/rtl-untranslate" :dir :system)
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "rtl") ;semantics of the basic RTL primitives
+
+(include-book "rtlarr") ;semantics RTL array primitives
+
+(include-book "basic") ;properties of basic arithmetic functions: floor, ceiling, 
+;                       exponential, and remainder
+
+(include-book "bits") ;bit vectors
+
+(include-book "log") ;logical operations
+
+(include-book "float") ;floating-point numbers
+
+(include-book "reps") ;floating-point formats and representations
+
+(include-book "round") ;floating-point rounding
+
+(include-book "add") ;support for reasoning about floating-point addition
+;                      (leading one prediction and sticky bit computation)
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../../arithmetic/top")
+(include-book "arith") ;general arithmetic package
+
+(include-book "util") ;misc helpful stuff including a few macros
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1/util.lisp acl2-6.3/books/rtl/rel9/support/lib1/util.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1/util.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1/util.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,151 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/util"))
+
+;;These macros facilitate localization of events:
+
+(defmacro local-defun (&rest body)
+  (list 'local (cons 'defun body)))
+
+(defmacro local-defund (&rest body)
+  (list 'local (cons 'defund body)))
+
+(defmacro local-defthm (&rest body)
+  (list 'local (cons 'defthm body)))
+
+(defmacro local-defthmd (&rest body)
+  (list 'local (cons 'defthmd body)))
+
+(defmacro local-in-theory (&rest body)
+  (cons 'local
+	(cons (cons 'in-theory (append body 'nil))
+	      'nil)))
+
+(defmacro defbvecp (name formals width &key thm-name hyp hints)
+  (let* ((thm-name
+          (or thm-name
+              (intern-in-package-of-symbol
+               (concatenate 'string
+                            (if (consp width)
+                                "BV-ARRP$"
+                              "BVECP$")
+                            (symbol-name name))
+               name)))
+         (x (cons name formals))
+         (typed-term (if (consp width)
+                         (list 'ag 'index x)
+                       x))
+         (bvecp-concl (if (consp width)
+                          (list 'bv-arrp x (car (last width)))
+                        (list 'bvecp x width)))
+         (concl (list 'and
+                      (list 'integerp typed-term)
+                      (list '<= 0 typed-term))))
+    (list* 'defthm thm-name
+           (if hyp
+               (list 'implies hyp bvecp-concl)
+             bvecp-concl)
+           :rule-classes
+           (list
+            :rewrite
+            (list :forward-chaining :trigger-terms (list x))
+            (list :type-prescription
+                  :corollary
+                  (if hyp
+                      (list 'implies hyp concl)
+                    concl)
+                  :typed-term typed-term
+                  ;; hints for the corollary 
+                  :hints
+                  (if (consp width)
+                      '(("Goal"
+                         :in-theory
+                         '(implies bvecp
+                                   bv-arrp-implies-nonnegative-integerp)))
+                    '(("Goal"
+                       :in-theory
+                       '(implies bvecp))))))
+           (if hints (list :hints hints) nil))))
+
+(defun sub1-induction (n)
+      (if (zp n)
+          n
+        (sub1-induction (1- n))))
+
+; These will be the functions to disable in acl2 proofs about signal bodies.
+; We use this in the compiler.
+;BOZO This doesn't include cons, which can now appear in signals defs.  I think that's okay, right?  think
+;about this and remove the BOZO
+(defconst *rtl-operators-after-macro-expansion*
+  '(log= log<> 
+    log< log<= log> log>= 
+    comp2< comp2<= comp2> comp2>=
+    land lior lxor lnot
+    logand1 logior1 logxor1
+    shft
+    cat mulcat
+    bits bitn setbits setbitn 
+    ag as
+    * + ; from macroexpansion of mod* or mod+
+    ;mod- ;now a macro!
+    floor rem decode encode
+    ;; bind ; handled specially in fixup-term
+    ;; if1 ;  a macro, so we don't disable it
+    ;; quote, n!, arr0 ; handled specially in fixup-term
+    natp1 ; doesn't matter, only occurs in for-loop defuns (must be enabled in those proofs anyway)
+    mk-bvarr mk-bvec
+    ))
+
+; Macro fast-and puts conjunctions in a tree form, which can avoid stack
+; overflows by ACL2's translate functions.
+
+(defun split-list (lst lo hi)
+  (cond ((endp lst) 
+         (mv lo hi))
+        ((endp (cdr lst)) 
+         (mv (cons (car lst) lo) hi))
+        (t
+         (split-list (cddr lst)
+                     (cons (car lst) lo)
+                     (cons (cadr lst) hi)))))
+
+(defun fast-and-fn (conjuncts)
+  (declare (xargs :mode :program))
+  (cond ((endp conjuncts) ''t)
+        ((endp (cdr conjuncts)) (car conjuncts))
+        (t
+         (mv-let (hi lo)
+             (split-list conjuncts () ())
+           (list 'if
+                 (fast-and-fn hi)
+                 (fast-and-fn lo)
+                 'nil)))))
+
+(defmacro fast-and (&rest conjuncts)
+  (fast-and-fn conjuncts))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/Makefile acl2-6.3/books/rtl/rel9/support/lib1.delta1/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,6 @@
+include ../../../../Makefile-generic
+
+# BOOKS = float-extra2 round-extra2 mult-proofs float round mult basic-extra basic arith-extra arith bvecp-raw-helpers simple-loop-helpers-extra simple-loop-helpers bits-extra bits
+ 
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/README acl2-6.3/books/rtl/rel9/support/lib1.delta1/README
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/README	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,8 @@
+This directory contains two updated books: float.lisp, round.lisp as well as a
+new book, mult.lisp.  The actual proof work appears in float-extra2.lisp,
+round-extra2.lisp and mult-proofs.lisp.
+
+These proofs are done with existing rules from "../lib1".
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/arith-extra.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/arith-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/arith-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/arith-extra.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,38 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib1/arith")
+(local (include-book "../../arithmetic/top"))
+
+(defthm expt-positive-integer-type
+    (implies (and (integerp a)
+		  (integerp i)
+		  (>= i 0))
+	     (integerp (expt a i)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable expt))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/arith.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/arith.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/arith.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/arith.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,854 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This file is based on the old "fp book", which was initially created by J
+; Moore and Matt Kaufmann in 1995 in support of their proof of the AMD-K5
+; division code.    Here, we have moved
+; non-local in-theory events to the end.  All events should be redundant, so we
+; have deleted all local in-theory events and added (local (in-theory nil)) to
+; the beginning.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../lib1/arith"))
+(local (include-book "arith-extra"))
+
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+(defthm a1 (equal (+ x (+ y z)) (+ y (+ x z))))
+(defthm a2 (equal (- x) (* -1 x)))
+
+(defthm a3
+  (and
+   (implies
+    (syntaxp (and (quotep c1) (quotep c2)))
+    (and (equal (+ (* c1 x) (* c2 x)) (* (+ c1 c2) x))
+         (equal (+ (* c1 x) (+ (* c2 x) y)) (+ (* (+ c1 c2) x) y))))
+   (implies
+    (syntaxp (quotep c2))
+    (and (equal (+ x (* c2 x)) (* (+ 1 c2) x))
+         (equal (+ x (+ (* c2 x) y1)) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (* c2 x))) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (+ (* c2 x) y2))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (* c2 x)))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (+ y3 (* c2 x)))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))
+         (equal (+ x (+ y1 (+ y2 (+ (* c2 x) y3))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))))
+   (and (equal (+ x x) (* 2 x))
+        (equal (+ x (+ x y1)) (+ (* 2 x) y1)))))
+(defthm a4
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (+ c1 (+ c2 y1)) (+ (+ c1 c2) y1))))
+(defthm a5
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (* c1 (* c2 y1)) (* (* c1 c2) y1))))
+
+
+
+
+
+(defthm a6
+  (equal (/ (/ x)) (fix x)))
+(defthm a7
+  (equal (/ (* x y)) (* (/ x) (/ y))))
+
+;replaced force with case-split
+(defthm a8
+  (implies (and (case-split (acl2-numberp x))
+                (case-split (not (equal x 0))))
+           (and (equal (* x (* (/ x) y)) (fix y))
+                (equal (* x (/ x)) 1))))
+
+(defthm a9
+  (and (equal (* 0 x) 0)
+       (equal (* x (* y z)) (* y (* x z)))
+       (equal (* x (+ y z)) (+ (* x y) (* x z)))
+       (equal (* (+ y z) x) (+ (* y x) (* z x)))))
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+
+(defthm a10
+  (and (implies (integerp i) (equal (fl i) i))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1)) ;can actually drop this
+                     )
+                (and (equal (fl (+ i x1)) (+ i (fl x1)))
+                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2)))
+                (and (equal (fl (+ x1 (+ i x2))) (+ i (fl (+ x1 x2))))
+                     (equal (fl (+ x1 (+ x2 i))) (+ i (fl (+ x1 x2))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3)))
+                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
+                            (+ i (fl (+ x1 x2 x3))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
+                            (+ i (fl (+ x1 x2 x3))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3))
+                     (case-split (rationalp x4)))
+                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))))))
+
+(defthm a12
+  (implies (and (integerp i)
+                (integerp j)
+                (< 1 j)
+                (< j i))
+           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
+                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
+  :rule-classes :linear)
+
+
+;replaced force with case-split                
+;later, drop the hyp completely
+(defthm a13
+  (implies (case-split (rationalp x)) ;drop!
+           (and (< (1- x) (fl x))
+                (<= (fl x) x)))
+  :rule-classes :linear)
+
+(defthm a14
+  (and
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= 0 j))
+            (and (integerp (expt i j))
+                 (<= 0 (expt i j))))
+   (implies (and (rationalp i)
+                 (not (equal i 0)))
+            (not (equal (expt i j) 0))))
+  :rule-classes
+  ((:type-prescription
+    :corollary
+    (implies (and (integerp i)
+                  (<= 0 i)
+                  (<= 0 j))
+             (and (integerp (expt i j))
+                  (<= 0 (expt i j)))))
+   (:type-prescription
+    :corollary
+    (implies (and (rationalp i)
+                  (not (equal i 0)))
+             (not (equal (expt i j) 0))))))
+
+(defthm a15
+  (implies (and (rationalp i)
+                (not (equal i 0))
+                (integerp j1)
+                (integerp j2))
+           (and (equal (* (expt i j1) (expt i j2))
+                       (expt i (+ j1 j2)))
+                (equal (* (expt i j1) (* (expt i j2) x))
+                       (* (expt i (+ j1 j2)) x)))))
+(defthm a16
+  (equal (expt (* a b) i)
+         (* (expt a i) (expt b i))))
+
+(defthm /-weakly-monotonic
+  (implies (and (<= y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (<= (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+
+(defthm /-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (< (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+         
+(defthm *-weakly-monotonic
+  (implies (and (<= y y+)
+                (<= 0 x)
+                (case-split (rationalp x)) ; This does not hold if x, y, and z are complex!
+                )
+           (<= (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))))
+
+#| Here is the complex counterexample to which we alluded above.
+
+(let ((y  #c(1 -1))
+      (y+ #c(1 1))
+      (x  #c(1 1)))
+    (implies (and (<= y y+)
+                  (<= 0 x))
+             (<= (* x y) (* x y+))))
+|#
+
+(defthm *-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))))
+
+(defthm *-weakly-monotonic-negative-multiplier
+  (implies (and (<= y y+)
+               (< x 0)
+               (case-split (rationalp x))
+               )
+           (<= (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))))
+
+(defthm *-strongly-monotonic-negative-multiplier
+  (implies (and (< y y+)
+                (< x 0)
+                (case-split (rationalp x))
+                )
+           (< (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))))
+
+(defthm fl-weakly-monotonic
+  (implies (and (<= y y+)
+                (case-split (rationalp y)) ;drop?
+                (case-split (rationalp y+)) ;drop?
+                )
+           (<= (fl y) (fl y+)))
+  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
+                 (:linear)
+                 (:forward-chaining
+                  :trigger-terms ((fl y) (fl y+))
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))
+                 (:linear
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))))
+
+(local 
+ (deftheory arith-fc-monotonicity-local
+  '((:forward-chaining /-weakly-monotonic)
+    (:forward-chaining /-strongly-monotonic)
+    (:forward-chaining *-weakly-monotonic . 1)
+    (:forward-chaining *-weakly-monotonic . 2)
+    (:forward-chaining *-strongly-monotonic . 1)
+    (:forward-chaining *-strongly-monotonic . 2)
+    (:forward-chaining *-weakly-monotonic-negative-multiplier . 1)
+    (:forward-chaining *-weakly-monotonic-negative-multiplier . 2)
+    (:forward-chaining *-strongly-monotonic-negative-multiplier . 1)
+    (:forward-chaining *-strongly-monotonic-negative-multiplier . 2)
+    (:forward-chaining fl-weakly-monotonic . 1)
+    (:forward-chaining fl-weakly-monotonic . 2)
+    )))
+
+; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
+; product of a and b given intervals for a and b.  We consider three kinds of intervals.
+; We discuss only the a case.
+
+; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
+
+; nonneg-open intervals mean 0<=a<amax.
+
+; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
+
+; We now prove theorems with names like abs*nonneg-open, etc. characterizing
+; the product of two elements from two such intervals.  All of these theorems
+; are made with :rule-classes nil because I don't know how to control their
+; use.
+
+; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
+; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
+; lemma would be no different.
+
+(defthm abs*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+
+
+(defthm abs*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* bmax amax)) (* a b))
+                (< (* a b) (* bmax amax))))
+  :rule-classes nil)
+
+; The next three, which handle nonnegative open intervals in the first argument,
+; can actually be seen as uses of the abs intervals above.  Simply observe that
+; if 0<=a<amax then -amax<a<amax.
+
+(defthm nonneg-open*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+; and the commuted version
+(defthm nonneg-closed*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (<= a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (<= (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm abs*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (< (- bmax) b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)  
+
+(defthm rearrange-negative-coefs-<
+  (and (equal (< (* (- c) x) z)
+              (< 0 (+ (* c x) z)))
+       (equal (< (+ (* (- c) x) y) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y (* (- c) x)) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y1 y2 (* (- c) x)) z)
+              (< (+ y1 y2) (+ (* c x) z)))
+       (equal (< (+ y1 y2 y3 (* (- c) x)) z)
+              (< (+ y1 y2 y3) (+ (* c x) z)))
+       (equal (< z (+ (* (- c) x) y))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y (* (- c) x)))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y1 y2 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2)))
+       (equal (< z (+ y1 y2 y3 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2 y3)))))
+
+(defthm rearrange-negative-coefs-equal
+  (and (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp z)))
+                (equal (equal (* (- c) x) z)
+                       (equal 0 (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ (* (- c) x) y) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y (* (- c) x)) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 (* (- c) x)) z)
+                       (equal (+ y1 y2) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 y3 (* (- c) x)) z)
+                       (equal (+ y1 y2 y3) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ (* (- c) x) y))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y (* (- c) x)))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 y3 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2 y3))))))
+
+(defthm rearrange-fractional-coefs-<
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< (* (/ c) x) z)
+                   (< x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ (* (/ c) x) y) z)
+                   (< (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ y (* (/ c) x)) z)
+                   (< (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< (+ y1 y2 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< (+ y1 y2 y3 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) (* c y3) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< z (* (/ c) x))
+                   (< (* c z) x)))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ (* (/ c) x) y))
+                   (< (* c z) (+ x (* c y)))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ y (* (/ c) x)))
+                   (< (* c z) (+ (* c y) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 y3 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) (* c y3) x))))))
+
+(defthm rearrange-fractional-coefs-equal
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (equal (* (/ c) x) z)
+                   (equal x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ (* (/ c) x) y) z)
+                   (equal (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ y (* (/ c) x)) z)
+                   (equal (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 y3 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) (* c y3) x) (* c z))))))
+
+(defthm x*/y=1->x=y
+  (implies (and (rationalp x)
+                (rationalp y)
+                (not (equal x 0))
+                (not (equal y 0)))
+           (equal (equal (* x (/ y)) 1)
+                  (equal x y)))
+  :rule-classes nil)
+                
+(defun point-right-measure (x)
+  (floor (if (and (rationalp x) (< 0 x)) (/ x) 0) 1))
+
+(defun point-left-measure (x)
+  (floor (if (and (rationalp x) (> x 0)) x 0) 1))
+
+(include-book "ordinals/e0-ordinal" :dir :system)
+(set-well-founded-relation e0-ord-<)
+
+(defthm recursion-by-point-right
+  (and (e0-ordinalp (point-right-measure x))
+       (implies (and (rationalp x)
+                     (< 0 x)
+                     (< x 1))
+                (e0-ord-< (point-right-measure (* 2 x))
+                          (point-right-measure x)))))
+
+(defthm recursion-by-point-left
+  (and (e0-ordinalp (point-left-measure x))
+       (implies (and (rationalp x)
+                     (>= x 2))
+                (e0-ord-< (point-left-measure (* 1/2 x))
+                          (point-left-measure x)))))
+
+(defthm x<x*y<->1<y
+  (implies (and (rationalp x)
+                (< 0 x)
+                (rationalp y))
+           (equal (< x (* x y)) (< 1 y)))
+  :rule-classes nil)
+
+(defthm cancel-equal-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (not (equal a 0)))
+           (equal (equal (* a r) (* a s))
+                  (equal r s)))
+  :rule-classes nil)
+
+(defthmd expt-split
+  (implies (and (integerp i)
+                (integerp j)
+                (case-split (acl2-numberp r)) ;(integerp r)
+                (case-split (not (equal r 0)))
+                )
+           (equal (expt r (+ i j))
+                  (* (expt r i) (expt r j)))))
+
+(defthm cancel-<-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (< 0 a))
+           (equal (< (* a r) (* a s))
+                  (< r s)))
+  :rule-classes nil)
+
+(in-theory (disable fl
+                    inverse-of-*
+                    point-right-measure point-left-measure))
+
+
+;;;**********************************************************************
+;;;                       EXPONENTIATION
+;;;**********************************************************************
+
+(defthm expt-positive-integer-type
+    (implies (and (integerp a)
+		  (integerp i)
+		  (>= i 0))
+	     (integerp (expt a i)))
+  :rule-classes (:type-prescription))
+
+(defthm expt-2-positive-integer-type
+  (implies (<= 0 i)
+           (and (integerp (expt 2 i))
+                (< 0 (expt 2 i))))
+  :rule-classes (:type-prescription))
+
+
+(defthm expt-2-positive-rational-type
+  (and (rationalp (expt 2 i))
+       (< 0 (expt 2 i)))
+  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
+
+(defthm expt-2-positive-integer-type
+  (implies (<= 0 i)
+           (and (integerp (expt 2 i))
+                (< 0 (expt 2 i))))
+  :rule-classes (:type-prescription))
+
+(defthm expt-2-type-linear
+  (implies (<= 0 i)
+           (<= 1 (expt 2 i)))
+  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
+
+(defthmd expt-weak-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (<= (expt 2 n) (expt 2 m))
+		  (<= n m))))
+
+(defthmd expt-strong-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (< (expt 2 n) (expt 2 m))
+		  (< n m))))
+
+(defthmd expt-inverse
+  (equal (/ (expt 2 i))
+         (expt 2 (* -1 i))))
+
+(defthm ash-rewrite
+    (implies (integerp n)
+	     (equal (ash n i)
+		    (fl (* n (expt 2 i))))))
+
+(defthm exp+1
+    (implies (and (integerp m)
+		  (integerp n)
+		  (<= n m))
+	     (> (* (- 1 (expt 2 m)) (- 1 (expt 2 n)))
+		(- 1 (expt 2 (1+ m)))))
+  :rule-classes ())
+
+(defthm exp+2
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (< (* (1+ (expt 2 m)) (1+ (expt 2 n)))
+		(1+ (expt 2 (+ m 2)))))
+  :rule-classes ())
+
+(defthm exp-invert
+    (implies (and (integerp n)
+		  (<= n -1))
+	     (<= (/ (- 1 (expt 2 n)))
+		 (1+ (expt 2 (1+ n)))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/basic-extra.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/basic-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/basic-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/basic-extra.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,93 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib1/basic")
+(include-book "../../arithmetic/floor")
+
+
+(local (in-theory (disable mod floor)))
+(local (include-book "../../arithmetic/top"))
+
+;;;**********************************************************************
+;;;                       FLOOR and CEILING
+;;;**********************************************************************
+
+;;; <same> 
+
+;;;**********************************************************************
+;;;                         MOD
+;;;**********************************************************************
+
+
+(defthm natp-mod-2
+  (implies (and (integerp m)
+                (integerp n)
+                (> n 0))
+           (natp (mod m n)))
+  :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm mod-mod-times
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (> n 0))
+	     (= (mod (* (mod a n) b) n)
+		(mod (* a b) n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-equal-int-reverse (a (* (mod a n) b)) (b (* a b)))
+			(:instance mod-does-nothing (m a))
+			(:instance mod-bnd-1 (m a))
+			(:instance natp-mod-2 (m a))
+			(:instance mod-equal-int (b (mod a n)))
+			(:instance integerp-prod (x (/ (- a (mod a n)) n)) (y (- b)))))))
+
+
+
+(defthm mod-times-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (* a c) n) (mod (* b c) n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-mod-times (b c))
+			(:instance mod-mod-times (a b) (b c))))))
+
+
+(defthm mod-plus-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (+ a c) n) (mod (+ b c) n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-sum (a c))
+			(:instance mod-sum (b a) (a c))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/basic.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/basic.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/basic.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,451 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../lib1/basic"))
+(local (include-book "basic-extra"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                       FLOOR and CEILING
+;;;**********************************************************************
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defthm fl-def
+  (and (integerp (fl x))    
+       (implies (case-split (rationalp x))
+	        (and (<= (fl x) x)
+		     (< x (1+ (fl x))))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (<= (fl x) x)
+                                        (< x (1+ (fl x))))))
+                 (:type-prescription :corollary
+                                     (integerp (fl x)))))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+(defthm fl-integerp
+  (equal (equal (fl x) x)
+         (integerp x)))
+
+(defthm quot-bnd
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* y (fl (/ x y)))
+               x))
+  :rule-classes :linear)
+
+(defthm fl-monotone-linear
+    (implies (and (<= x y)
+		  (rationalp x)
+		  (rationalp y))
+	     (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (fl x) (/ n)))
+                  (fl (/ x n)))))
+
+(defthm fl/int-rewrite-alt
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (/ n) (fl x)))
+                  (fl (/ x n)))))
+
+(defthmd fl-minus
+  (implies (rationalp x)
+           (equal (fl (* -1 x))
+                  (if (integerp x)
+                      (* -1 x)
+                    (1- (* -1 (fl x)))))))
+
+(defthm fl-m-n
+  (implies (and (< 0 n)
+                (integerp m)
+                (integerp n))
+           (= (fl (- (/ m n)))
+              (1- (- (fl (/ (1- m) n))))))
+  :rule-classes ())
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defthm cg-def
+  (and (integerp (cg x))
+       (implies (case-split (rationalp x))
+                (and (>= (cg x) x)
+                     (> (1+ x) (cg x)))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (>= (cg x) x)
+                                        (> (1+ x) (cg x)))))
+                 (:type-prescription :corollary
+                                     (integerp (cg x)))))
+
+(defthm cg-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (>= n x)
+		  (> (1+ x) n))
+	     (equal (cg x) n))
+  :rule-classes ())
+
+(defthm cg-integerp
+    (implies (rationalp x)
+	     (equal (equal (cg x) x)
+                    (integerp x))))
+
+(defthm cg-monotone-linear
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= x y))
+	     (<= (cg x) (cg y)))
+  :rule-classes :linear)
+
+(defthm n>=cg-linear
+    (implies (and (>= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (>= n (cg x)))
+  :rule-classes :linear)
+
+(defthm cg+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (cg (+ x n)) (+ (cg x) n))))
+
+(defthm cg/int-rewrite
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (cg x) (/ n)))
+                  (cg (/ x n)))))
+
+(defthm cg/int-rewrite-alt
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (/ n) (cg x)))
+                  (cg (/ x n)))))
+
+(defthm fl-cg
+  (implies (rationalp x)
+           (equal (cg x)
+                  (if (integerp x)
+                      (fl x)
+                    (1+ (fl x)))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                         MOD
+;;;**********************************************************************
+(in-theory (disable mod))
+
+(defthm mod-def
+  (implies (case-split (acl2-numberp x))
+           (equal (mod x y)
+                  (- x (* y (fl (/ x y))))))
+  :rule-classes ())
+
+(defthm mod-0
+    (and (equal (mod 0 y)
+                0)
+         (equal (mod x 0)
+                (fix x))))
+
+(defthm rationalp-mod
+  (implies (rationalp x)
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm integerp-mod
+  (implies (and (integerp m) (integerp n))
+           (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription))
+
+
+(defthm natp-mod
+   (implies (and (natp m)
+                 (natp n))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm natp-mod-2
+   (implies (and (integerp m)
+                 (integerp n)
+                 (> n 0))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm mod-bnd-1
+  (implies (and (case-split (< 0 n))
+                (case-split (not (complex-rationalp m)))
+                (case-split (not (complex-rationalp n))))
+           (< (mod m n) n))
+  :rule-classes :linear)
+
+(defthm mod-by-1
+  (implies (integerp m)
+           (equal (mod m 1)
+                  0)))
+
+(defthm mod-bnd-2
+  (implies (and (<= 0 m)
+                (case-split (rationalp m)))
+           (<= (mod m n) m))
+  :rule-classes :linear)
+
+(defthm mod-does-nothing
+  (implies (and (< m n)
+                (<= 0 m)
+                (case-split (rationalp m)))
+           (equal (mod m n)
+                  m)))
+
+(defthm mod-0-fl
+  (implies (acl2-numberp m)
+           (iff (= (mod m n) 0)
+	        (= m (* (fl (/ m n)) n))))
+  :rule-classes ())
+
+(defthm mod-0-int
+  (implies (and (integerp m)
+                (integerp n)
+                (not (= n 0)))
+           (iff (= (mod m n) 0)
+                (integerp (/ m n))))
+  :rule-classes ())
+
+(defthm mod-mult-n
+  (equal (mod (* a n) n)
+         (* n (mod a 1))))
+
+(defthm mod-mult-n-commuted
+  (equal (mod (* n a) n)
+         (* n (mod a 1))))
+
+(defthm mod-squeeze
+    (implies (and (= (mod m n) 0)
+		  (< m (* (1+ a) n))
+                  (< (* (1- a) n) m)
+                  (integerp a)
+		  (integerp m)
+		  (integerp n))
+	     (= m (* a n)))
+  :rule-classes ())
+
+(defthm mod-must-be-n
+    (implies (and (= (mod m n) 0)
+		  (< m (* 2 n))
+                  (< 0 m)
+		  (rationalp m)
+		  (rationalp n))
+	     (= m n))
+  :rule-classes ())
+
+(defthm mod-0-0
+  (implies (and (integerp p)
+                (rationalp m)
+                (rationalp n))
+           (iff (= (mod m (* n p)) 0)
+                (and (= (mod m n) 0)
+                     (= (mod (fl (/ m n)) p) 0))))
+  :rule-classes ())
+
+(defthm mod-equal-int
+  (implies (and (= (mod a n) (mod b n))
+                (rationalp a)
+                (rationalp b))
+           (integerp (/ (- a b) n)))
+  :rule-classes ())
+
+(defthm mod-equal-int-reverse
+  (implies (and (integerp (/ (- a b) n))
+                (rationalp a)
+                (rationalp b)
+                (rationalp n)
+                (< 0 n))
+           (= (mod a n) (mod b n)))
+  :rule-classes ())
+
+(defthm mod-force-equal
+  (implies (and (< (abs (- a b)) n)
+                (rationalp a)
+                (rationalp b)
+                (integerp n))
+          (iff (= (mod a n) (mod b n))
+               (= a b)))
+  :rule-classes ())
+
+(defthm mod-mult
+    (implies (and (integerp a)
+                  (rationalp m)
+		  (rationalp n))
+	     (equal (mod (+ m (* a n)) n)
+		    (mod m n))))
+
+(defthm mod-force
+  (implies (and (<= (* a n) m)
+                (< m (* (1+ a) n))
+                (integerp a)
+                (rationalp m)
+                (rationalp n))
+           (= (mod m n) (- m (* a n))))
+  :rule-classes ())
+
+(defthm mod-bnd-3
+  (implies (and (< m (+ (* a n) r))
+                (<= (* a n) m)
+                (integerp a)
+                (case-split (rationalp m))
+                (case-split (rationalp n)))
+           (< (mod m n) r))
+  :rule-classes :linear)
+
+(defthmd mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ a (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthmd mod-mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ (mod a n) (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthm mod-diff
+  (implies (and (case-split (rationalp a))
+                (case-split (rationalp b)))
+           (equal (mod (- a (mod b n)) n)
+                  (mod (- a b) n))))
+
+(defthm mod-of-mod
+  (implies (and (case-split (natp k))
+                (case-split (natp n)))
+           (equal (mod (mod x (* k n)) n)
+                  (mod x n))))
+
+(defthm mod-of-mod-cor
+  (implies (and (<= b a)
+                (case-split (integerp b))
+                (case-split (integerp a)))
+           (equal (mod (mod x (expt 2 a)) (expt 2 b))
+                  (mod x (expt 2 b)))))
+
+(defthm mod-prod
+  (implies (and (rationalp m)
+                (rationalp n)
+                (rationalp k))
+           (equal (mod (* k m) (* k n))
+                  (* k (mod m n)))))
+
+(defthm mod012
+  (implies (integerp m)
+           (or (equal (mod m 2) 0)
+               (equal (mod m 2) 1)))
+  :rule-classes ())
+
+(defthm mod-plus-mod-2
+  (implies (and (integerp a)
+                (integerp b))
+           (iff (= (mod (+ a b) 2) (mod a 2))
+                (= (mod b 2) 0)))
+  :rule-classes ())
+
+(defthm mod-mod-2-not-equal
+  (implies (acl2-numberp m)
+           (not (= (mod m 2) (mod (1+ m) 2))))
+  :rule-classes ())
+
+(defthm mod-2*m+1-rewrite
+  (implies (integerp m)
+           (equal (mod (1+ (* 2 m)) 2) 1)))
+
+
+
+(defthm mod-mod-times
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (> n 0))
+	     (= (mod (* (mod a n) b) n)
+		(mod (* a b) n)))
+  :rule-classes ())
+
+(defthm mod-times-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (* a c) n) (mod (* b c) n)))
+  :rule-classes ())
+
+(defthm mod-plus-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (+ a c) n) (mod (+ b c) n)))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/bits-extra.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/bits-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/bits-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/bits-extra.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,39 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;; (include-book "log")
+
+(set-enforce-redundancy nil)
+
+(include-book "../lib1/top")
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+
+;;; add on extra definition to bits
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/bits.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/bits.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/bits.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,860 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../lib1/bits")
+
+(local (include-book "bits-extra"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0))))
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i))))))))
+
+(defthm bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (natp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :rule-classes ())
+
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+		(integerp k)
+		(<= 0 k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ())
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthm bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+;;See also bits-dont-match.
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+;;See also bits-match.
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+
+;;;;; for use with RTL->ACL2 tool, we add the folllowing back 
+;;;;; bitvec is originally defined in rel4 of the bits.lisp 
+;;;;; hanbing Fri Aug  3 12:36:35 2007
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthmd bitn-shift
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthmd bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m)))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (natp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+; The lemmas sumbits-badguy-is-correct and sumbits-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t)))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp m) (< 0 m)
+                              (integerp n) (< 0 n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;;Definition of the macro, cat:
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/bvecp-raw-helpers-extra.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/bvecp-raw-helpers-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/bvecp-raw-helpers-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/bvecp-raw-helpers-extra.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,356 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib1/rtl")
+
+
+(local (include-book "../lib1/bits"))
+
+(local 
+ (defthmd cat-expand-bits
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep n)))
+                (natp n)
+                (acl2-numberp k))
+           (equal (equal (cat x 1 y n) k)
+                  (equal (bits y (+ -1 n) 0)
+                         (if (equal (bitn x 0) 1)
+                             (+ k (* -1 (expt 2 n)))
+                           k))))
+  :hints (("Goal" :in-theory (enable binary-cat)))))
+
+
+(defthm cat-fact
+  (implies (equal (cat x 1 3 2) 3)
+           (not (equal (cat x 1 y 1 1 1) 5)))
+  :hints (("Goal" :in-theory (enable cat-expand-bits))))
+
+
+(defthm cat-fact-2
+  (implies (equal (cat x 1 y 1 1 1) 5)
+           (not (equal (cat x 1 y 1 z 1) 7)))
+  :hints (("Goal" :in-theory (enable cat-expand-bits))))
+
+(defthm cat-fact-3
+  (implies (equal (cat x 1 3 2) 3)
+           (not (equal (cat x 1 y 1 z 1) 7)))
+  :hints (("Goal" :in-theory (enable cat-expand-bits))))
+
+(defthm cat-fact-4
+  (implies (equal (cat x 1 y 1 1 1) 5)
+           (not (equal (cat x 1 y 1 z 1) 6)))
+  :hints (("Goal" :in-theory (enable cat-expand-bits))))
+
+(defthm cat-fact-5
+  (implies (equal (cat x 1 3 2) 3)
+           (not (equal (cat x 1 y 1 z 1) 6)))
+  :hints (("Goal" :in-theory (enable cat-expand-bits))))
+
+
+(defthm cat-fact-6
+  (implies (equal (cat 1 1 x 1 y 1) 4)
+           (not (equal (cat z 1 x 1 y 1) 5)))
+  :hints (("Goal" :in-theory (enable cat-expand-bits))))
+
+
+
+
+(local 
+ (defthmd bitn-0-or-1
+   (implies (not (equal (bitn x 0) 0))
+            (equal (bitn x 0) 1))
+   :hints (("Goal" :use ((:instance bitn-0-1))))))
+
+(local 
+ (defthm bitn-0-less-than-1
+   (<= (bitn x 0) 1)
+   :hints (("Goal" :use ((:instance bitn-0-1))))
+   :rule-classes (:linear)))
+
+(local
+ (defthm bitn-0-less-than-2
+   (>= (bitn x 0) 0)
+   :hints (("Goal" :use ((:instance bitn-0-1))))
+   :rule-classes (:linear :type-prescription)))
+
+(local 
+ (defthmd bits-than-2
+   (implies (and (integerp n)
+                 (>= n 0))
+            (< (bits x n 0)
+               (expt 2 (+ 1 n))))
+   :rule-classes (:linear)
+   :hints (("Goal" :in-theory (e/d () (bits-bvecp
+                                       BITS-BVECP-SIMPLE))
+            :use ((:instance bits-bvecp
+                             (i n) (j 0) (k (+ 1 n))))
+            :expand (bvecp (bits x n 0) (+ 1 n))))))
+           
+(local (in-theory (enable bits-than-2)))
+
+(local 
+ (defthm cat-expansion-specific
+   (implies (and (integerp n)
+                 (> n 0))
+            (equal (cat x 1 y n)
+                   (if (equal (bitn x 0) 0)
+                       (bits y (+ -1 n) 0)
+                     (+ (expt 2 n) (bits y (+ -1 n) 0)))))
+   :hints (("Goal" :in-theory (enable acl2::binary-cat)))))
+
+
+
+(local 
+ (encapsulate () 
+    (local (include-book "../../arithmetic/top"))
+    (defthm bits-plus-reduce
+      (implies (and (integerp n)
+                    (> c 0)
+                    (integerp c)
+                    (integerp y)
+                    (<= c (expt 2 n))
+                    (<= 0 y)
+                    (< y (expt 2 n))
+                    (> n 0))
+               (equal (bits (+ c y) n 0)
+                      (+ c y)))
+      :hints (("Goal" :use ((:instance BITS-BITS-SUM
+                                       (x c)
+                                       (i n)
+                                       (y (bits y n 0)))
+                            (:instance sumbits-bits
+                                       (x (+ c y))
+                                       (n (+ 1 n)))
+                            (:instance sumbits-thm
+                                       (x (+ c y))
+                                       (n (+ 1 n)))
+                            (:instance sumbits-thm
+                                       (x y)
+                                       (n (+ 1 n)))
+                            (:instance sumbits-bits
+                                       (x y) 
+                                       (n (+ 1 n))))
+               :in-theory (e/d (bvecp
+                                expt-2-reduce-leading-constant)
+                               (sumbits)))))))
+
+
+
+ 
+
+(DEFTHM CAT-FACT-7
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1) 1)
+           (NOT (EQUAL (CAT X 1 Y1 1 Z1 1) 7))))
+
+(DEFTHM CAT-FACT-8
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1) 3)
+           (NOT (EQUAL (CAT X 1 Y1 1 Z1 1) 5))))
+ 
+(DEFTHM CAT-FACT-9
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1) 1)
+           (NOT (EQUAL (CAT X 1 Y 1 Z1 1) 3))))
+ 
+
+(DEFTHM CAT-FACT-10
+  (IMPLIES (EQUAL (CAT 1 1 X 1 Y 1) 4)
+           (NOT (EQUAL (CAT Z 1 X 1 Y 1) 1))))
+ 
+
+
+(DEFTHM CAT-FACT-11
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                  125)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127)))) 
+
+(DEFTHM CAT-FACT-12
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                  123)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125)))) 
+
+(DEFTHM CAT-FACT-13
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3) 119)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                       123))))
+
+
+ 
+(DEFTHM CAT-FACT-14
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3)
+                       119))))
+ 
+
+(DEFTHM CAT-FACT-15
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111))))
+ 
+(DEFTHM CAT-FACT-16
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 31 5) 95))))
+ 
+
+(DEFTHM CAT-FACT-17
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111))))
+ 
+(DEFTHM CAT-FACT-18
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3)
+                       119))))
+ 
+
+(DEFTHM CAT-FACT-19
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                       123))))
+ 
+
+(DEFTHM CAT-FACT-20
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125))))
+ 
+
+(DEFTHM CAT-FACT-21
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+(DEFTHM CAT-FACT-22
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3)
+                       119))))
+ 
+
+(DEFTHM CAT-FACT-23
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                       123))))
+ 
+
+(DEFTHM CAT-FACT-24
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125))))
+ 
+
+(DEFTHM CAT-FACT-25
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-26
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-27
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125))))
+ 
+
+(DEFTHM CAT-FACT-28
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                       123))))
+ 
+(DEFTHM CAT-FACT-29
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3)
+                       119))))
+ 
+
+(DEFTHM CAT-FACT-30
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3) 119)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125))))
+ 
+
+(DEFTHM CAT-FACT-31
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3) 119)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-32
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                  123)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-33
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                  125)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-34
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                  125)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-35
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                  123)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-36
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3) 119)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-37
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-38
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-39
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/bvecp-raw-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/bvecp-raw-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/bvecp-raw-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/bvecp-raw-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1044 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+
+(include-book "../lib1/rtl")
+(include-book "../lib1/rtlarr")
+
+(local (include-book "../lib1/bvecp-raw-helpers"))
+(local (include-book "../lib1.delta1/bvecp-raw-helpers-extra"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+
+(set-match-free-default :all)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(local (include-book "../../arithmetic/expo"))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;; bits
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+   (implies (and (<= (+ 1 i (- j)) k)
+                 (case-split (integerp k))
+                 )
+            (bvecp (bits x i j) k)))
+
+
+;; setbits
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k)))
+
+
+;; setbitn
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k)))
+
+
+
+;; log<
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+
+;; log<=
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+
+
+;; log>
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+
+
+;; log>=
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+
+
+;; log=
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+
+
+;; log<>
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+
+
+;; logand1
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+
+
+;; logior1
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+
+
+;; logxor1
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+
+
+;; lnot
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+;; bitn
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes ( :type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+;; shft
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k)))
+
+;; cat
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+
+;; logand
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n)))
+
+
+;; logior
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+
+;; mulcat
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n)))
+|#
+
+;; encode
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k)))
+           (bvecp (encode x n) k)))
+
+
+;; decode
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+;BOZO dup?
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+
+; land
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+;; lior
+
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+;; lxor
+
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+;; cat
+
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x)))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x)))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
+
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+(local (include-book "../../arithmetic/basic"))
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
+
+;remove these?
+
+
+;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
+;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
+;;;;;;;;;;;;;;;;;;; statements have no default.
+
+;maybe leave this one?
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t)))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t)))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t)))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t)))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t)))
+|#
+
+#|
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+|#
+
+#|
+;drop?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j))
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+|#
+
+
+;;; BOZO BOZO.
+;;;
+;;; Tue Jul  3 14:55:18 2007
+;;;
+;;; this following are added to allow ACL2 to reason about 
+;;; simple inequalities by concluding from the differences 
+;;; in bit positions quickly
+;;; 
+;;; They are proved with a general result 
+;;;
+;;; in lib1.delta1/bvecp-raw-helpers-extra.lisp
+;;;
+;;; enable the general rule in the bvecp-raw.lisp proof will
+;;; be too inefficient  
+
+(defthm cat-fact
+  (implies (equal (cat x 1 3 2) 3)
+           (not (equal (cat x 1 y 1 1 1) 5)))
+  :hints (("Goal" :in-theory (enable cat-expand-x))))
+
+
+(defthm cat-fact-2
+  (implies (equal (cat x 1 y 1 1 1) 5)
+           (not (equal (cat x 1 y 1 z 1) 7))))
+
+
+(defthm cat-fact-3
+  (implies (equal (cat x 1 3 2) 3)
+           (not (equal (cat x 1 y 1 z 1) 7))))
+
+
+(defthm cat-fact-4
+  (implies (equal (cat x 1 y 1 1 1) 5)
+           (not (equal (cat x 1 y 1 z 1) 6))))
+
+
+(defthm cat-fact-5
+  (implies (equal (cat x 1 3 2) 3)
+           (not (equal (cat x 1 y 1 z 1) 6))))
+
+
+(defthm cat-fact-6
+  (implies (equal (cat 1 1 x 1 y 1) 4)
+           (not (equal (cat z 1 x 1 y 1) 5))))
+
+
+
+ 
+
+(DEFTHM CAT-FACT-7
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1) 1)
+           (NOT (EQUAL (CAT X 1 Y1 1 Z1 1) 7))))
+
+(DEFTHM CAT-FACT-8
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1) 3)
+           (NOT (EQUAL (CAT X 1 Y1 1 Z1 1) 5))))
+ 
+(DEFTHM CAT-FACT-9
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1) 1)
+           (NOT (EQUAL (CAT X 1 Y 1 Z1 1) 3))))
+ 
+
+(DEFTHM CAT-FACT-10
+  (IMPLIES (EQUAL (CAT 1 1 X 1 Y 1) 4)
+           (NOT (EQUAL (CAT Z 1 X 1 Y 1) 1))))
+ 
+
+
+(DEFTHM CAT-FACT-11
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                  125)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127)))) 
+
+(DEFTHM CAT-FACT-12
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                  123)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125)))) 
+
+(DEFTHM CAT-FACT-13
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3) 119)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                       123))))
+
+
+ 
+(DEFTHM CAT-FACT-14
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3)
+                       119))))
+ 
+
+(DEFTHM CAT-FACT-15
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111))))
+ 
+(DEFTHM CAT-FACT-16
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 31 5) 95))))
+ 
+
+(DEFTHM CAT-FACT-17
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111))))
+ 
+(DEFTHM CAT-FACT-18
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3)
+                       119))))
+ 
+
+(DEFTHM CAT-FACT-19
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                       123))))
+ 
+
+(DEFTHM CAT-FACT-20
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125))))
+ 
+
+(DEFTHM CAT-FACT-21
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+(DEFTHM CAT-FACT-22
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3)
+                       119))))
+ 
+
+(DEFTHM CAT-FACT-23
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                       123))))
+ 
+
+(DEFTHM CAT-FACT-24
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125))))
+ 
+
+(DEFTHM CAT-FACT-25
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-26
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-27
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125))))
+ 
+
+(DEFTHM CAT-FACT-28
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                       123))))
+ 
+(DEFTHM CAT-FACT-29
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3)
+                       119))))
+ 
+
+(DEFTHM CAT-FACT-30
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3) 119)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                       125))))
+ 
+
+(DEFTHM CAT-FACT-31
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3) 119)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-32
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                  123)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-33
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                  125)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       127))))
+ 
+
+(DEFTHM CAT-FACT-34
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 1 1)
+                  125)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-35
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 3 2)
+                  123)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-36
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 U 1 7 3) 119)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-37
+  (IMPLIES (EQUAL (CAT X 1 Y 1 Z 1 15 4) 111)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-38
+  (IMPLIES (EQUAL (CAT X 1 Y 1 31 5) 95)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+(DEFTHM CAT-FACT-39
+  (IMPLIES (EQUAL (CAT X 1 63 6) 63)
+           (NOT (EQUAL (CAT X 1 Y 1 Z 1 U 1 V 1 W 1 P 1)
+                       126))))
+ 
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/float-extra2.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/float-extra2.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/float-extra2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/float-extra2.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1098 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;; (include-book "log")
+
+(set-enforce-redundancy nil)
+
+(include-book "../lib1/top")
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+
+
+(encapsulate ()
+ (local 
+ (defthm lemma-expt-muliply-2-reduce
+   (implies (integerp y)
+            (equal (* 2 (expt 2 y))
+                   (expt 2 (+ 1 y))))
+   :hints (("Goal" :expand (expt 2 (+ 1 y))
+            :in-theory (enable expt-split)))))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :hints (("Goal" :in-theory (enable abs nrepp spn
+                                     expo-minus)
+           :cases ((< 0 x)))
+          ("Subgoal 2" :use ((:instance expo<= (n (* -1 (bias q)))
+                                        (x (* -1 x)))))
+          ("Subgoal 1" :use ((:instance expo<= (n (* -1 (bias q)))))))
+  :rule-classes 
+  ((:rewrite :match-free :once))))
+
+
+
+;; (defund dencodingp (x p q)
+;;   (and (bvecp x (+ p q))
+;;        (= (iexpof x p q) 0)
+;;        (not (= (isigf x p) 0))))
+
+
+;; (defund ddecode (x p q)
+;;   (* (if (= (isgnf x p q) 0) 1 -1)
+;;      (isigf x p)
+;;      (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+;; (defthmd sgn-ddecode
+;;     (implies (and (dencodingp x p q)
+;; 		  (integerp p)
+;; 		  (> p 1)
+;; 		  (integerp q)
+;; 		  (> q 0))
+;; 	     (equal (sgn (ddecode x p q))
+;; 		    (if (= (isgnf x p q) 0) 1 -1))))
+
+
+;; (defthmd expo-ddecode
+;;     (implies (and (dencodingp x p q)
+;; 		  (integerp p)
+;; 		  (> p 1)
+;; 		  (integerp q)
+;; 		  (> q 0))
+;; 	     (equal (expo (ddecode x p q))
+;; 		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+
+;; (defthmd sig-ddecode
+;;     (implies (and (dencodingp x p q)
+;; 		  (integerp p)
+;; 		  (> p 1)
+;; 		  (integerp q)
+;; 		  (> q 0))
+;; 	     (equal (sig (ddecode x p q))
+;; 		    (sig (isigf x p)))))
+
+
+;; (defund drepp (x p q)
+;;   (and (rationalp x)
+;;        (not (= x 0))
+;;        (<= (- 2 p) (+ (expo x) (bias q)))
+;;        (<= (+ (expo x) (bias q)) 0)
+;;        ;number of bits available in the sig field = p - 1 - ( - bias - expo(r))
+;;        (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+;; (defund dencode (x p q)
+;;   (cat (cat (if (= (sgn x) 1) 0 1)
+;; 	    1
+;;             0
+;;             q)
+;;        (1+ q)
+;;        (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+;;        (- p 1)))
+
+
+;; (defthmd drepp-ddecode
+;;     (implies (and (dencodingp x p q)
+;; 		  (integerp p)
+;; 		  (> p 1)
+;; 		  (integerp q)
+;; 		  (> q 0))
+;; 	     (drepp (ddecode x p q) p q)))
+
+
+;; (defthmd dencode-ddecode
+;;     (implies (and (dencodingp x p q)
+;; 		  (integerp p)
+;; 		  (> p 1)
+;; 		  (integerp q)
+;; 		  (> q 0))
+;; 	     (equal (dencode (ddecode x p q) p q)
+;; 		    x)))
+
+
+;; (defthmd dencodingp-dencode
+;;     (implies (and (drepp x p q)
+;; 		  (integerp p)
+;; 		  (integerp q)
+;; 		  (> q 0))
+;; 	     (dencodingp (dencode x p q) p q)))
+
+
+;; (defthmd ddecode-dencode
+;;     (implies (and (drepp x p q)
+;; 		  (integerp p)
+;; 		  (> p 1)
+;; 		  (integerp q)
+;; 		  (> q 0))
+;; 	     (equal (ddecode (dencode x p q) p q)
+;; 		    x)))
+
+
+
+;; (defund spd (p q)
+;;      (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+
+;; (defthmd positive-spd
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0))
+;;            (> (spd p q) 0)))
+
+
+;; (local 
+;;   (defthm sig-expt-2-reduce
+;;     (equal (SIG (EXPT 2 n))
+;;            1)
+;;     :hints (("Goal" :use ((:instance SIG-SHIFT (x 1)))))))
+
+
+;; (local 
+;;  (defthm expo-shift-specific
+;;   (implies (integerp n)
+;;            (equal (EXPO (EXPT 2 n)) 
+;;                   n))
+;;   :hints (("Goal" :in-theory (enable expo-shift)
+;;            :cases ((equal (* (expt 2 n) 1)
+;;                           (expt 2 n)))))))
+
+;; (local (in-theory (disable LEMMA-EXPT-MULIPLY-2-REDUCE)))
+
+;; (defthmd drepp-spd-2
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0))
+;;            (drepp (spd p q) p q))
+;;   :hints (("Goal" :in-theory (enable bias spd drepp exactp))))
+
+;;(local (in-theory (enable LEMMA-EXPT-MULIPLY-2-REDUCE)))
+
+;; (local 
+;;  (defthm lemma-expt-muliply-2-reduce
+;;    (implies (integerp y)
+;;             (equal (* 2 (expt 2 y))
+;;                    (expt 2 (+ 1 y))))
+;;    :hints (("Goal" :expand (expt 2 (+ 1 y))
+;;             :in-theory (enable expt-split)))))
+
+;; >  D          (DEFTHM EXPO<=
+;;                       (IMPLIES (AND (< X (* 2 (EXPT 2 N)))
+;;                                     (< 0 X)
+;;                                     (RATIONALP X)
+;;                                     (INTEGERP N))
+;;                                (<= (EXPO X) N))
+;;                       :RULE-CLASSES :LINEAR)
+
+;; (defthm specific-plus-less
+;;   (implies (and (<= z 0)
+;;                 (<= (+ R (EXPT 2 (+ 3 (* -1 P)))) 0))
+;;            (<= (+ R (EXPT 2 (+ 3 (* -1 P))) 
+                
+
+;; >  D          (DEFTHM EXPO-LOWER-BOUND
+;;                       (IMPLIES (AND (RATIONALP X) (NOT (EQUAL X 0)))
+;;                                (<= (EXPT 2 (EXPO X)) (ABS X)))
+;;                       :RULE-CLASSES :LINEAR)
+
+
+;; (encapsulate ()
+;;    (local (include-book "rtl/rel5/arithmetic/expt" :dir :system))
+;;    (local 
+;;     (defthmd expt-weak-monotone-linear
+;;       (implies (and (<= n m)
+;;                     (case-split (integerp n))
+;;                     (case-split (integerp m)))
+;;                (<= (expt 2 n) (expt 2 m)))
+;;       :rule-classes ((:linear :match-free :all))))
+
+;;    (defthm expt-value-monotonic-specific
+;;      (implies (and (integerp p)
+;;                    (integerp q)
+;;                    (< 0 q)
+;;                    (<= 2 (+ P (BIAS Q) (EXPO R))))
+;;               (<= (EXPT 2 (+ 2 (* -1 (BIAS Q)) (* -1 P)))
+;;                   (expt 2 (expo r))))
+;;      :hints (("Goal" :in-theory (enable bias)
+;;               :use ((:instance expt-weak-monotone-linear
+;;                                (n (+ 2  (* -1 (BIAS Q)) (* -1 P)))
+;;                                (m (expo r))))))))
+
+
+
+;; (defthmd smallest-spd-2
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (not (= r 0))
+;;                 (integerp q)
+;;                 (> q 0)
+;;                 (drepp r p q))
+;;            (>= (abs r) (spd p q)))
+;;   :hints (("Goal" :in-theory (enable drepp spd
+;;                                      expo-minus)
+;;            :use ((:instance expt-value-monotonic-specific)
+;;                  (:instance expo-lower-bound
+;;                             (x r))))))
+
+
+;----------------------------------------------------------------------
+
+;; (local 
+;;  (defthm local-inverse-specific
+;;    (implies (integerp x)
+;;             (equal (/ (expt 2 x))
+;;                    (expt 2 (* -1 x))))
+;;    :hints (("Goal" :in-theory (enable zip)))
+;;    :rule-classes nil))
+
+;; (local 
+;;  (defthm local-integerp-specific
+;;   (implies (and (integerp p)
+;;                 (integerp q)
+;;                 (< 0 q))
+;;            (equal (INTEGERP (* R
+;;                                (/ (EXPT 2
+;;                                         (+ 3 (* -1 P)
+;;                                            (* -1 (EXPT 2 (+ -1 Q))))))))
+;;                   (integerp (* r (expt 2 (+ -3 P (expt 2 (+ -1 q))))))))
+;;   :hints (("Goal" :use ((:instance  local-inverse-specific
+;;                                     (x (+ 3 (* -1 P)
+;;                                           (* -1 (EXPT 2 (+ -1 Q)))))))
+;;            :in-theory (disable EQUAL-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)))))
+
+;----------------------------------------------------------------------
+
+
+(local 
+ (defun am (m p g)
+   (* m (spd p g))))  
+
+;; this probably a bad choice!! we could have used "+"
+
+(local 
+ (defun am-induct (m p g)
+   (if (zip m)
+       (list m p g)
+     (if (< m 1)
+         (list m p g)
+       (if (>= m (expt 2 (1- p)))
+           (list m p g)
+         (am-induct (- m 1) p g))))))
+
+
+
+;; (defun fp+ (x n)
+;;   (+ x (expt 2 (- (1+ (expo x)) n))))
+
+
+(local 
+ (defthm expo-shift-specific
+  (implies (integerp n)
+           (equal (EXPO (EXPT 2 n)) 
+                  n))
+  :hints (("Goal" :in-theory (enable expo-shift)
+           :cases ((equal (* (expt 2 n) 1)
+                          (expt 2 n)))))))
+
+
+;; (sig x) (expo (1- n))
+(local 
+ (defthm am-is-fp+1
+  (implies (and (integerp m)
+                (<= 1 m)
+                (< m (expt 2 (1- p)))
+                (integerp p)
+                (integerp q)
+                (exactp (am m p q) (+ -2 P (EXPT 2 (- Q 1)) (EXPO (am m p q))))
+                (< 0 q)
+                (< 1 p))
+           (equal (am (1+ m) p q)
+                  (fp+ (am m p q)
+                       (+ -2 P (EXPT 2 (- Q 1)) (EXPO (am m p q))))))
+  :hints (("Goal" :in-theory (e/d (fp+ spd bias spn)
+                                  (EXPO-SHIFT-SPECIFIC))))))
+
+
+
+;; ;; (defthmd expo-monotone
+;; ;;   (implies (and (<= (abs x) (abs y))
+;; ;;                 (case-split (rationalp x))
+;; ;;                 (case-split (not (equal x 0)))
+;; ;;                 (case-split (rationalp y)))
+;; ;;            (<= (expo x) (expo y)))
+;; ;;   :rule-classes :linear)
+
+;; ;; (defthmd expo-prod-upper
+;; ;;     (implies (and (rationalp x)
+;; ;; 		  (not (= x 0))
+;; ;; 		  (rationalp y)
+;; ;; 		  (not (= y 0)))
+;; ;; 	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+;; ;;   :rule-classes :linear)
+
+(local 
+ (defthm expo-m-<=-specific
+  (implies (and (<= 1 m)
+                (integerp m)
+                (integerp p)
+                (< m (expt 2 (+ -1 p))))
+           (<= (EXPO M)
+               (- p 1)))
+  :hints (("Goal" :use ((:instance expo-monotone
+                                   (x m)
+                                   (y (expt 2 (+ -1 p)))))))))
+
+(local 
+ (defthm expo-m-<=-specific-2
+  (implies (and (<= 1 m)
+                (integerp m)
+                (integerp p)
+                (< 1 p)
+                (< m (expt 2 (+ -1 p))))
+           (<= (EXPO M)
+               (- p 2)))
+  :hints (("Goal" :cases ((equal (expo m)
+                                 (- p 1)))
+           :in-theory (disable expo-m-<=-specific))
+          ("Subgoal 2" :use ((:instance expo-m-<=-specific)))
+          ("Subgoal 1" :use ((:instance expo-lower-bound
+                                        (x m)))))
+  :rule-classes :linear))
+                                        
+(local 
+ (defthm bias-big-enough-induct-step-drepp-am-1-6
+ (implies (and (<= 1 m)
+               (integerp p)
+               (integerp q)
+               (< 0 q)
+               (< 1 p)
+               (integerp m)
+               (< m (expt 2 (+ -1 p))))
+          (<= (+ (BIAS Q) (EXPO (* M (SPD P Q))))
+              0))
+ :hints (("Goal" :in-theory (e/d (spd expo-shift) ())
+          :use ((:instance expo-m-<=-specific-2)
+                (:instance expo-shift
+                           (n (+ 2 (* -1 P) (* -1 (BIAS Q))))
+                           (x m)))))
+ :rule-classes :linear))
+
+
+
+(local 
+ (defthm fact-expo-am-specific
+   (implies (and (integerp m)
+                 (< 0 x)
+                 (rationalp x)
+                 (< 1 m))
+            (<= (expo (+ (* -1 x)
+                         (* m x)))
+                (expo (* m x))))
+   :rule-classes :linear
+   :hints (("Goal" 
+            :do-not '(fertilize)
+            :in-theory (enable spd)
+            :use ((:instance expo-monotone
+                             (x (+ (* -1 x)
+                                   (* m x)))
+                             (y (* m x))))))))
+
+(local 
+  (defthm induct-step-drepp-am-1-9
+     (implies (and (integerp m)
+                   (integerp p)
+                   (integerp q)
+                   (< 1 m)
+                   (< 1 p)
+                   (< 0 q)
+                   (<= 2
+                       (+ P (BIAS Q)
+                          (EXPO (+ (* -1 (SPD P Q)) (* M (SPD P Q)))))))
+              (<= 2
+                  (+ P (BIAS Q) (EXPO (* M (SPD P Q))))))
+     :hints (("Goal" :use ((:instance fact-expo-am-specific
+                                      (x (spd p q))))))))
+
+
+
+;; ;; >  D          (DEFTHM EXACTP-<=
+;; ;;                       (IMPLIES (AND (EXACTP X M)
+;; ;;                                     (<= M N)
+;; ;;                                     (RATIONALP X)
+;; ;;                                     (INTEGERP N)
+;; ;;                                     (INTEGERP M))
+;; ;;                                (EXACTP X N)))
+
+
+(local (include-book "../../arithmetic/basic"))
+
+;; (local (defthm rationalp-spd
+;;          (rationalp (spd p q)))) 
+
+
+
+(local 
+ (defthm induct-step-drepp-am-1-5
+  (implies (and (integerp m)
+                (integerp p)
+                (integerp q)
+                (< 0 q)
+                (< 1 m)
+                (< 1 p)
+                (EXACTP (* M (SPD P Q))
+                        (+ -2 P (EXPT 2 (+ -1 Q))
+                           (EXPO (+ (* -1 (SPD P Q)) (* M (SPD P Q)))))))
+           (EXACTP (* M (SPD P Q))
+                   (+ -2 P (EXPT 2 (+ -1 Q))
+                      (EXPO (* M (SPD P Q))))))
+  :hints (("Goal" :in-theory (e/d (expo-monotone) (spd))
+           :use ((:instance exactp-<=
+                            (x (* M (SPD P Q)))
+                            (m (+ -2 P (EXPT 2 (+ -1 Q))
+                                  (EXPO (+ (* -1 (SPD P Q)) 
+                                           (* m (SPD P q))))))
+                            (n (+ -2 P (EXPT 2 (+ -1 Q))
+                                  (EXPO (* M (SPD P Q)))))))))))
+
+
+
+(local 
+ (defthm induct-step-drepp-am
+   (IMPLIES (AND (DREPP (SPD P Q) P Q)
+                 (<= 1 M)
+                 (< M (EXPT 2 (+ -1 p)))
+                 (DREPP (+ (* -1 (SPD P Q)) (* M (SPD P Q)))
+                        P Q)
+                 (INTEGERP P)
+                 (< 1 P)
+                 (INTEGERP Q)
+                 (< 0 Q)
+                 (INTEGERP M))
+            (DREPP (* M (SPD P Q)) P Q))
+   :hints (("Goal" :cases ((not (equal m 1))))
+           ("Subgoal 1" :in-theory (e/d (drepp positive-spd) (fp+ spd))
+            :use ((:instance FP+1
+                             (x (am (1- m) p q))
+                             (n (+ -2 P (EXPT 2 (- Q 1)) 
+                                   (EXPO (am (1- m) p q)))))
+                  (:instance am-is-fp+1
+                             (m (1- m)))
+                  (:instance induct-step-drepp-am-1-5)))
+           ("Subgoal 1.1" :in-theory (enable bias)))))
+
+(local 
+(defthmd spd-mult-1
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (<= 1 m)
+                (integerp m)
+                (< m (expt 2 (1- p))))
+           (drepp (am m p q) p q))
+  :hints (("Goal" :induct (am-induct m p q)
+           :do-not '(generalize))
+          ("Subgoal *1/2" :use drepp-spd))))
+
+
+(local
+ (defthm am-in-between-1
+  (implies (and (> r 0)
+                (rationalp r)
+                (integerp p) 
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (<= (am (fl (/ r (spd p q))) p q)
+               r))
+  :rule-classes :linear))
+
+;; (local (in-theory (enable positive-spd)))  
+
+(local 
+ (defthm fl-fact-specific
+   (implies (and (> r 0)
+                 (rationalp r)
+                 (> x 0)
+                 (rationalp x))
+            (< r  (+ x (* x (fl (/ r x))))))
+   :rule-classes :linear))
+
+
+(local
+ (defthm am-in-between-2
+  (implies (and (> r 0)
+                (rationalp r)
+                (integerp p) 
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (< r
+              (am (+ 1 (fl (/ r (spd p q)))) p q)))
+  :rule-classes :linear))
+
+ 
+
+
+;; (defthm expo-unique
+;;   (implies (and (<= (expt 2 n) (abs x))
+;;                 (< (abs x) (expt 2 (1+ n)))
+;;                 (rationalp x)
+;;                 (integerp n))
+;;            (equal n (expo x)))
+;;   :rule-classes ())
+
+
+(local
+ (defthm rationalp-is-am
+  (implies (and (integerp p)
+                (integerp q)
+                (integerp m)
+                (< 0 q))
+           (RATIONALP (AM m P Q)))))
+
+
+
+;; (defthmd smallest-spd
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (not (= r 0))
+;;                 (integerp q)
+;;                 (> q 0)
+;;                 (drepp r p q))
+;;            (>= (abs r) (spd p q)))
+;;   :hints (("Goal" :in-theory (enable drepp spd
+;;                                      expo-minus)
+;;            :use ((:instance expt-value-monotonic-specific)
+;;                  (:instance expo-lower-bound
+;;                             (x r))))))
+
+;; (defthm expt-positive-specific
+;;   (implies (integerp any)
+;;            (< 0 (expt 2 any))))
+
+;; (defthm equal-mulitply-positive-zero
+;;   (implies (and (equal (* x p) 0)
+;;                 (< 0 p)
+;;                 (acl2-numberp p)
+;;                 (acl2-numberp x))
+;;            (equal x 0))
+;;   :rule-classes :forward-chaining)
+
+(local
+ (defthm am-is-zero-implies-r-less-than-spd
+  (implies (and (equal (am x p q) 0)
+                (rationalp x)
+                (integerp p) 
+                (< 1 p)
+                (< 0 q)
+                (integerp q))
+           (equal x 0))
+  :hints (("Goal" :in-theory (enable positive-spd)))
+  :rule-classes :forward-chaining))
+
+(local
+ (defthm fl-zero-implies-less-than
+  (implies (and (equal (fl (/ r x)) 0)
+                (< 0 x)
+                (< 0 r)
+                (rationalp r)
+                (rationalp x))
+           (< r x))
+  :rule-classes :forward-chaining))
+           
+
+
+;; (defthmd smallest-spd
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (not (= r 0))
+;;                 (integerp q)
+;;                 (> q 0)
+;;                 (drepp r p q))
+;;            (>= (abs r) (spd p q)))
+;;   :hints (("Goal" :in-theory (enable drepp spd
+;;                                      expo-minus)
+;;            :use ((:instance expt-value-monotonic-specific)
+;;                  (:instance expo-lower-bound
+;;                             (x r))))))
+
+;; (skip-proofs 
+;;  (defthm am-positive
+;;    (implies (and (rationalp r)
+;;                  (integerp p)
+;;                  (integerp q)
+;;                  (< 1 p)
+;;                  (< 0 q))
+;;             (<= 0 (AM (FL (* R (/ (SPD P Q)))) P Q)))
+;;    :hints (("Goal" :in-theory (enable positive-spd)))
+;;    :rule-classes :type-prescription))
+
+
+
+;; (defthm am-in-between-1
+;;   (implies (and (> r 0)
+;;                 (rationalp r)
+;;                 (integerp p) 
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0))
+;;            (<= (am (fl (/ r (spd p q))) p q)
+;;                r))
+;;   :rule-classes :linear)
+
+
+;; (defthmd expo-monotone
+;;   (implies (and (<= (abs x) (abs y))
+;;                 (case-split (rationalp x))
+;;                 (case-split (not (equal x 0)))
+;;                 (case-split (rationalp y)))
+;;            (<= (expo x) (expo y)))
+;;   :rule-classes :linear)
+
+;; (encapsulate ()
+;;    (local (include-book "rtl/rel5/arithmetic/expt" :dir :system))
+;;    (defthmd expt-weak-monotone-linear
+;;       (implies (and (<= n m)
+;;                     (case-split (integerp n))
+;;                     (case-split (integerp m)))
+;;                (<= (expt 2 n) (expt 2 m)))
+;;       :rule-classes ((:linear :match-free :all))))
+
+
+(local
+ (defthm am-in-between-1-specific
+  (implies (and (> r 0)
+                (rationalp r)
+                (integerp p) 
+                (> p 1)
+                (drepp r p q)
+                (integerp q)
+                (> q 0))
+           (<= (expt 2 (expo (am (fl (/ r (spd p q))) p q)))
+               r))
+  :hints (("Goal" 
+           :use ((:instance expo-lower-bound
+                            (x (am (fl (/ r (spd p q))) p q)))
+                 (:instance expo-monotone
+                            (x (am (fl (/ r (spd p q))) p q))
+                            (y r))
+                 (:instance am-in-between-1)
+                 (:instance fl-zero-implies-less-than
+                            (x (spd p q)))
+                 (:instance am-is-zero-implies-r-less-than-spd
+                            (x (fl (/ r (spd p q)))))
+                 (:instance smallest-spd))))
+  :rule-classes :linear))
+                        
+
+
+;; (defthm am-is-fp+1
+;;   (implies (and (integerp m)
+;;                 (<= 1 m)
+;;                 (< m (expt 2 (1- p)))
+;;                 (integerp p)
+;;                 (integerp q)
+;;                 (exactp (am m p q) (+ -2 P (EXPT 2 (- Q 1)) (EXPO (am m p q))))
+;;                 (< 0 q)
+;;                 (< 1 p))
+;;            (equal (am (1+ m) p q)
+;;                   (fp+ (am m p q)
+;;                        (+ -2 P (EXPT 2 (- Q 1)) (EXPO (am m p q))))))
+;;   :hints (("Goal" :in-theory (e/d (fp+ spd bias spn)
+;;                                   (EXPO-SHIFT-SPECIFIC)))))
+
+(local
+ (defthm am-positive
+  (implies (and (integerp m)
+                (integerp p)
+                (integerp q)
+                (< 1 p)
+                (< 0 q)
+                (<= 0 m))
+           (<= 0 (AM m P Q)))
+  :hints (("Goal" :in-theory (enable positive-spd)))
+  :rule-classes :type-prescription))
+
+(local
+ (defthm am-positive-strong
+  (implies (and (integerp m)
+                (integerp p)
+                (integerp q)
+                (< 1 p)
+                (< 0 q)
+                (<= 1 m))
+           (< 0 (AM m P Q)))
+  :hints (("Goal" :in-theory (enable positive-spd)))
+  :rule-classes :linear))
+
+;; (defthmd exactp-2**n
+;;   (implies  (and (case-split (integerp m))
+;;                  (case-split (> m 0)))
+;;             (exactp (expt 2 n) m)))
+
+
+;; (defthm expo-m-positive
+;;   (implies (and (integerp p)
+;;                 (integerp q)
+;;                 (< 1 p)
+;;                 (< 0 q)
+;;                 (integerp m)
+;;                 (<= 1 m)
+;;                 (< m (expt 2 (1- p))))
+;;            (< 0 (+ -2 P (EXPT 2 (+ -1 Q))
+;;                     (EXPO (* M (SPD P Q))))))
+;;   :hints (("
+
+
+(local
+ (defthm exactp-2**n-specific
+  (implies (and (<= 2
+                    (+ -1 P (EXPT 2 (+ -1 Q))
+                       (EXPO (* M (SPD P Q)))))
+                (integerp p)
+                (integerp q)
+                (integerp m)
+                (< 0 q)
+                (< 1 p)
+                (<= 1 m))
+           (EXACTP (EXPT 2 (+ 1 (EXPO (* M (SPD P Q)))))
+                   (+ -2 P (EXPT 2 (+ -1 Q))
+                      (EXPO (* M (SPD P Q))))))
+  :hints (("Goal" :in-theory (enable exactp-2**n)))))
+
+(local
+ (defthm fp+2-specific
+  (implies (and (integerp p)
+                (integerp q)
+                (< 0 q)
+                (< 1 p)
+                (integerp m)
+                (<= 1 m)
+                (< m (expt 2 (1- p)))
+                (drepp (am m p q) p q)
+                (< (am m p q)
+                   (EXPT 2
+                         (+ 1
+                            (EXPO (am m p q))))))
+           (<= (am (+ 1 m) p q)
+               (EXPT 2
+                     (+ 1
+                        (EXPO (am m p q))))))
+  :hints (("Goal" 
+           :in-theory (e/d (am bias drepp) (exactp-2**n))
+           :use ((:instance fp+2 
+                            (x (am m p q))
+                            (y (expt 2 (+ 1 (expo (am m p q)))))
+                            (n (+ -2 P (EXPT 2 (- Q 1)) (EXPO (am m p q)))))
+                 (:instance am-is-fp+1))))))
+                        
+
+(local
+ (encapsulate () 
+  (local (include-book "../../arithmetic/basic"))
+  (local 
+   (defthm expt-i+j-combine
+     (implies (and (integerp j1)
+                   (integerp j2))
+              (equal (* (expt 2 j1) (expt 2 j2))
+                     (expt 2 (+ j1 j2))))
+     :hints (("Goal" :use ((:instance a15 (i 2)))))))
+
+  (local 
+   (defthm equal-expt-2-1-p-is-1-q
+     (implies (and (integerp p)
+                   (< 1 p)
+                   (< 0 q)
+                   (integerp q))
+              (equal (* (expt 2 (+ -1 p))
+                        (spd p q))
+                     (spn q)))
+     :hints (("Goal" :in-theory (enable bias spd spn)))))
+
+
+  (local (defthm expo-upper-bound-chain
+           (implies (and (<= (expo r) y)
+                         (rationalp r)
+                         (< 0 r)
+                         (integerp y))
+                    (< r (expt 2 (+ 1 y))))
+           :hints (("Goal" :use ((:instance expo-upper-bound
+                                            (x r))
+                                 (:instance expt-strong-monotone-linear
+                                            (n (+ 1 (expo r)))
+                                            (m (+ 1 y))))))))
+
+  (local 
+   (defthm r-less-than-spn
+     (implies (and (<= (+ (BIAS Q) (EXPO R)) 0)
+                   (rationalp r)
+                   (< 0 r)
+                   (integerp p)
+                   (integerp q)
+                   (< 1 p)
+                   (< 0 q))
+              (< r  (spn q)))
+     :hints (("Goal" :in-theory (enable expt-strong-monotone-linear
+                                        spn)
+              :use ((:instance EXPO-UPPER-BOUND-chain
+                               (r r)
+                               (y (* -1 (bias q)))))))))
+  
+  (defthm fl-r-spd-less-than
+     (implies (and (DREPP R P Q)
+                   (integerp p)
+                   (< 0 r)
+                  (< 1 p)
+                  (< 0 q)
+                  (integerp q)
+                  (rationalp r))
+             (< (fl (* r (/ (spd p q))))
+                (expt 2 (+ -1 p))))
+  :hints (("Goal" :in-theory (e/d (drepp) 
+                                  (EQUAL-EXPT-2-1-P-IS-1-Q
+                                   r-less-than-spn))
+           :use ((:instance r-less-than-spn)
+                 (:instance equal-expt-2-1-p-is-1-q))))
+  :rule-classes :linear)))
+
+(local 
+ (defthm am-in-between-2-specific
+  (implies (and (> r 0)
+                (rationalp r)
+                (integerp p) 
+                (> p 1)
+                (DREPP R P Q)
+                (integerp q)
+                (> q 0))
+           (< r
+              (EXPT 2
+
+                    (+ 1
+                       (EXPO (AM (FL (* R (/ (SPD P Q)))) P Q))))))
+  :hints (("Goal" 
+           :use ((:instance expo-upper-bound
+                            (x (am (fl (/ r (spd p q))) p q)))
+                   (:instance expo-monotone
+                              (x r)
+                              (y (am (+ 1 (fl (/ r (spd p q)))) p q)))
+                   (:instance fp+2-specific
+                              (m (fl (* R (/ (spd p q))))))
+                   (:instance am-in-between-2)
+                   (:instance fl-zero-implies-less-than
+                              (x (spd p q)))
+                   (:instance am-is-zero-implies-r-less-than-spd
+                              (x (fl (/ r (spd p q)))))
+                   (:instance spd-mult-1
+                              (m (fl (* R (/ (spd p q))))))
+                   (:instance smallest-spd))))
+  :rule-classes :linear))
+
+(local
+ (defthm expo-r-equal-expo-am
+  (implies (and (> r 0)
+                (rationalp r)
+                (integerp p) 
+                (> p 1)
+                (drepp r p q)
+                (integerp q)
+                (> q 0))
+           (equal (expo r)
+                  (expo (am (fl (/ r (spd p q)))
+                            p q))))
+  :hints (("Goal" :in-theory (disable drepp am)
+           :use ((:instance expo-unique
+                            (x r)
+                            (n (expo (am (fl (/ r (spd p q))) p q)))))))
+  :rule-classes nil))
+                           
+
+;;;;
+;;;; not so useful!!! 
+;;;;
+
+
+;; (defthmd diff-representable-r
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;;                 (rationalp r)
+;;                 (> r 0)
+;;                 (drepp r p q))
+;;            (drepp (- r (am (fl (/ r (spd p q)))
+;;                            p q))
+;;                   p q))
+;;   :hints (("Goal" :in-theory (e/d (bias drepp) (am))
+;;            :do-not '(generalize)
+;;            :use ((:instance expo-r-equal-expo-am)
+;;                  (:instance exactp-diff-cor
+;;                             (x r)
+;;                             (y (am (fl (/ r (spd p q))) p q))
+;;                             (n (+ -2 P (EXPT 2 (- Q 1)) (EXPO r))))
+;;                  (:instance smallest-spd)
+;;                  (:instance spd-mult-1
+;;                             (m (fl (* R (/ (spd p q))))))))))
+
+;(i-am-here) ;; 
+
+(local 
+ (defthmd spd-mult-2
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp r)
+                (> r 0)
+                (drepp r p q))
+           (equal (am (fl (/ r (spd p q))) p q)
+                  r))
+  :hints (("Goal" :in-theory (e/d (drepp bias) (am))
+           :use ((:instance fp+2
+                            (x (am (fl (/ r (spd p q))) p q))
+                            (y r)
+                            (n (+ -2 P (EXPT 2 (- Q 1)) (EXPO r))))
+                 (:instance expo-r-equal-expo-am)
+                 (:instance spd-mult-1
+                            (m (fl (* R (/ (spd p q))))))
+                 (:instance am-is-fp+1
+                            (m (fl (* R (/ (spd p q))))))
+                 (:instance smallest-spd))))))
+                 
+(local
+ (defthmd spd-mult-2-specific
+   (implies (and (integerp p)
+                 (> p 1)
+                 (integerp q)
+                 (> q 0)
+                 (rationalp r)
+                 (> r 0)
+                 (drepp r p q))
+            (equal (am (/ r (spd p q)) p q)
+                   r))
+   :hints (("Goal" :in-theory (e/d (am) (drepp bias spd))
+            :use ((:instance spd-mult-2))))))
+
+
+;;  (defthm fl-r-spd-less-than
+;;    (implies (and (DREPP R P Q)
+;;                  (integerp p)
+;;                  (< 0 r)
+;;                  (< 1 p)
+;;                  (< 0 q)
+;;                  (integerp q)
+;;                  (rationalp r))
+;;             (< (fl (* r (/ (spd p q))))
+;;                (expt 2 (+ -1 p))))
+;;    :hints (("Goal" :in-theory (enable bias drepp)))
+;;    :rule-classes :linear))
+
+(local
+ (defthm drepp-maximal-r
+  (implies (and  (DREPP R P Q)
+                 (integerp p)
+                 (< 0 r)
+                 (< 1 p)
+                 (< 0 q)
+                 (integerp q)
+                 (rationalp r))
+           (< R (* (EXPT 2 (+ -1 P)) (SPD P Q))))
+  :hints (("Goal" :in-theory (enable drepp)
+           :use ((:instance fl-r-spd-less-than)
+                 (:instance positive-spd))))))
+
+
+(local
+ (defthmd spd-mult-2-specific-further
+   (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+	        (drepp r p q))
+      (and (natp (* r (/ (spd p q))))
+           (<= 1 (* r (/ (spd p q))))
+           (<    (* r (/ (spd p q))) (expt 2 (1- p)))))
+  :hints (("Goal" :in-theory (disable spd-mult-2-specific
+                                      spd-mult-2)
+           :use ((:instance spd-mult-2)
+                 (:instance smallest-spd))))))
+
+(local
+ (defthmd spd-mult-1-specific-further
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+                (<= 1 m)
+                (integerp m)
+                (< m (expt 2 (1- p)))
+                (equal (/ r (spd p q)) m))
+           (drepp r p q))
+  :hints (("Goal" :in-theory (disable spd-mult-1)
+           :use ((:instance spd-mult-1))))))
+
+
+;;; only this is new!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p))))))
+  :hints (("Goal" :in-theory (e/d () (am spd drepp
+                                         spd-mult-1-specific-further
+                                         spd-mult-2-specific-further)))
+          ("Subgoal 5" :cases ((< (* R (/ (SPD P Q)))  
+                                  (expt 2 (1- p)))))
+          ("Subgoal 5.1" :use ((:instance spd-mult-1-specific-further
+                                          (m (/ r (spd p q))))))
+          ("Subgoal 3" :use ((:instance spd-mult-1-specific-further
+                                        (m (/ r (spd p q))))))
+          ("Subgoal 2" :use ((:instance spd-mult-2-specific-further)))
+          ("Subgoal 1" :use ((:instance smallest-spd)))))
+
+;------------------------------------------------------------------------------
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/float.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/float.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/float.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,900 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../lib1/log")
+
+(local (include-book "../lib1/float"))
+(local (include-book "float-extra2"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ())
+
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ())
+
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ())
+
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ())
+
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
+
+;;;***************************************************************
+;;;                 Floating-Point formats
+;;;***************************************************************
+
+
+(defund esgnf  (x p q) (bitn x (+ p q)))
+(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defund esigf  (x p)   (bits x (1- p) 0))
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defthmd sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+
+(defthmd expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+
+(defthmd sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+
+(defthmd nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+
+(defthmd nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+
+(defthmd nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+
+(defthmd ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+(defthmd sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+
+(defthmd expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+
+(defthmd sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(r))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+(defthmd drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+
+(defthmd dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+
+(defthmd dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+
+(defthmd ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+
+;; (defthmd spd-mult
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;; 		(rationalp r)
+;; 		(= m (/ r (spd p q))))
+;; 	   (iff (drepp r p q)
+;; 		(and (natp m)
+;; 		     (<= 1 m)
+;; 		     (< m (expt 2 (1- p)))))))
+;; not true!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
+
+
+(defund rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/mult-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/mult-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/mult-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/mult-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,2101 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;(include-book "add")
+
+(include-book "../support/rtl")
+(include-book "../support/sumbits")
+(include-book "../support/util")
+
+;; (set-inhibit-warnings "theory")
+;;
+;; (local (in-theory nil))
+
+(local (include-book "../../arithmetic/top"))
+
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta (i y)
+  (+ (bitn y (1- (* 2 i))) 
+     (bitn y (* 2 i))
+     (* -2 (bitn y (1+ (* 2 i))))))
+
+(defun sum-theta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta (1- m) y))
+        (sum-theta (1- m) y))))
+
+
+;----------------------------------------------------------------------
+
+
+;; (local-defthm  
+;;  expt-merge-specific
+;;  (implies (integerp i)
+;;           (EQUAL (+ (EXPT 2 (+ -1 i))
+;;                     (* 2 (EXPT 2 (+ -2 i))))
+;;                  (EXPT 2 i)))
+;;  :hints (("Goal" :in-theory (enable EXPT-2-REDUCE-LEADING-CONSTANT))))
+
+
+
+;; (local-defthm 
+;;  bitn-minus-1-is-0
+;;  (implies (integerp x)
+;;           (equal (bitn x -1) 0))
+;;  :hints (("Goal" :in-theory (enable bitn bits))))
+
+
+
+(defthm sum-theta-lemma-i
+  (implies (and (not (zp m))
+                (integerp k)
+                (integerp y)
+                (<= 0 k)
+                (<= k m))
+           (equal (sumbits y (* 2 k))
+                  (+ (sum-theta k y)
+                     (* (expt 2 (* 2 k))
+                        (bitn y (+ -1 (* 2 k)))))))
+  :hints (("Goal" :do-not '(generalize fertilize)
+           :in-theory (enable expt-2-reduce-leading-constant
+                              bitn-neg)
+           :induct (sum-theta k y)))
+  :rule-classes ())
+
+
+(local-defthm 
+ bvecp-integerp
+ (implies (bvecp x k)
+          (integerp x))
+ :hints (("Goal" :in-theory (enable bvecp)))
+ :rule-classes :forward-chaining)
+
+
+(defthm sum-theta-lemma
+  (implies (and (not (zp m))
+                (bvecp y (1- (* 2 m))))
+           (equal y (sum-theta m y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-theta-lemma-i 
+                                   (k m))
+                        (:instance  sumbits-thm 
+                                    (n (+ -1  (* 2 m)))
+                                    (x y)))
+           :expand (SUMBITS Y (* 2 M))
+           :do-not-induct t
+           :do-not '(fertilize))))
+
+
+;----------------------------------------------------------------------
+
+(defun bmux4 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (lnot x n))
+    (2  (* 2 x))
+    (-2 (lnot (* 2 x) n))
+    (0  0)))
+
+(defun neg (x) (if (< x 0) 1 0))
+
+
+
+
+
+(local-defthm bvecp-bvecp
+  (implies  (and (BVECP X (+ -1 N))
+                 (integerp n))
+            (bvecp x n))
+  :hints (("Goal" :in-theory (e/d (bvecp) (expt-compare))
+           :use ((:instance expt-weak-monotone
+                            (n (+ -1 n))
+                            (m n))))))
+
+
+
+(defthm bmux4-reduce-to
+  (implies (and (integerp zeta)
+                (<= zeta 2)
+                (<= -2 zeta)
+                (integerp n)
+                (bvecp x (+ -1 n))
+                (>= n 0))
+           (equal (bmux4 zeta x n)
+                  (if (<= 0 zeta)
+                      (* zeta x)
+                    (+ -1 (expt 2 n)
+                       (* zeta x)))))
+  :hints (("Goal" :in-theory (enable lnot BITS-TAIL-SPECIAL))))
+
+;(include-book "bits")
+
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+(defun pp4 (i x n)
+  (if (zerop i)
+      (cat 1 1
+	   (lnot (neg (zeta i)) 1) 1
+	   (bmux4 (zeta i) x n) n)
+    (cat 1 1
+	 (lnot (neg (zeta i)) 1) 1
+	 (bmux4 (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))
+
+(defun sum-pp4 (x m n)
+  (if (zp m)
+      0
+    (+ (pp4 (1- m) x n)
+       (sum-pp4 x (1- m) n))))
+
+
+
+(encapsulate ()
+  (local (include-book "../support/cat"))
+  (defthmd cat-bvecp-2
+    (implies (and (<= (+ a0 a1) a)
+                  (case-split (integerp a)))
+             (bvecp (cat x1 a1 x0 a0) a))))
+
+
+(local-defthmd binary-cat-2
+              (implies (and (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a1)
+                            (natp a0))
+                       (equal (cat x1 a1 x0 a0)
+                              (+ x0 
+                                 (* x1 (expt 2 a0)))))
+              :hints (("Goal" :in-theory (enable binary-cat))))
+
+
+(local-defthmd bcevp-sum-2
+              (implies (and (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a1)
+                            (natp a0)
+                            (equal (+ a0 a1) a))
+                       (bvecp (+ x0
+                                 (* x1  (expt 2 a0)))                                 
+                              a))
+              :hints (("Goal" :use ((:instance cat-bvecp-2)
+                                    (:instance binary-cat-2)))))
+
+(local-defthmd binary-cat-3
+              (implies (and (bvecp x2 a2)
+                            (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a2)
+                            (natp a1)
+                            (natp a0))
+                       (equal (cat x2 a2 x1 a1 x0 a0)
+                              (+ x0 
+                                 (* x1 (expt 2 a0))
+                                 (* x2 (expt 2 (+ a0 a1))))))
+              :hints (("Goal" :use ((:instance binary-cat-2
+                                               (x1 x2)
+                                               (a1 a2)
+                                               (x0 (cat x1 a1 x0 a0))
+                                               (a0 (+ a0 a1)))
+                                    (:instance binary-cat-2)
+                                    (:instance bcevp-sum-2
+                                               (a (+ a0 a1)))))))
+
+
+
+(defthmd cat-bvecp-3
+    (implies (and (<= (+ a0 a1 a2) a)
+                  (case-split (integerp a)))
+             (bvecp (cat x2 a2  x1 a1 x0 a0) a))
+    :hints (("Goal" :in-theory (enable cat-bvecp-2))))
+
+
+(local-defthmd bcevp-sum-3
+              (implies (and (bvecp x2 a2)
+                            (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a2)
+                            (natp a1)
+                            (natp a0)
+                            (equal (+ a0 a1 a2) a))
+                       (bvecp (+ x0
+                                 (* x1  (expt 2 a0))
+                                 (* x2  (expt 2 (+ a0 a1))))
+                              a))
+              :hints (("Goal" :use ((:instance binary-cat-3)
+                                    (:instance cat-bvecp-3)))))
+
+
+
+(local-defthmd binary-cat-4
+              (implies (and (bvecp x3 a3)
+                            (bvecp x2 a2)
+                            (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a3)
+                            (natp a2)
+                            (natp a1)
+                            (natp a0))
+                       (equal (cat x3 a3 x2 a2 x1 a1 x0 a0)
+                              (+ x0 
+                                 (* x1 (expt 2 a0))
+                                 (* x2 (expt 2 (+ a0 a1)))
+                                 (* x3 (expt 2 (+ a0 a1 a2))))))
+              :hints (("Goal" :use ((:instance binary-cat-2
+                                        (x1 x3)
+                                        (a1 a3)
+                                        (x0 (cat x2 a2 x1 a1 x0 a0))
+                                        (a0 (+ a0 a1 a2)))
+                                    (:instance binary-cat-3)
+                                    (:instance bcevp-sum-3
+                                               (a (+ a0 a1 a2)))))))
+                       
+
+                                                 
+(defthmd cat-bvecp-4
+    (implies (and (<= (+ a0 a1 a2 a3) a)
+                  (case-split (integerp a)))
+             (bvecp (cat x3 a3 x2 a2  x1 a1 x0 a0) a))
+    :hints (("Goal" :in-theory (enable cat-bvecp-2))))
+
+
+(local-defthmd bcevp-sum-4
+              (implies (and (bvecp x3 a3)
+                            (bvecp x2 a2)
+                            (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a3)
+                            (natp a2)
+                            (natp a1)
+                            (natp a0)
+                            (equal (+ a0 a1 a2 a3) a))
+                       (bvecp (+ x0
+                                 (* x1  (expt 2 a0))
+                                 (* x2  (expt 2 (+ a0 a1)))
+                                 (* x3  (expt 2 (+ a0 a1 a2))))
+                              a))
+              :hints (("Goal" :use ((:instance cat-bvecp-4)
+                                    (:instance binary-cat-4)))))
+
+
+
+
+
+(local-defthmd binary-cat-5
+              (implies (and (bvecp x4 a4)
+                            (bvecp x3 a3)
+                            (bvecp x2 a2)
+                            (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a4)
+                            (natp a3)
+                            (natp a2)
+                            (natp a1)
+                            (natp a0))
+                       (equal (cat x4 a4 x3 a3 x2 a2 x1 a1 x0 a0)
+                              (+ x0 
+                                 (* x1 (expt 2 a0))
+                                 (* x2 (expt 2 (+ a0 a1)))
+                                 (* x3 (expt 2 (+ a0 a1 a2)))
+                                 (* x4 (expt 2 (+ a0 a1 a2 a3))))))
+              :hints (("Goal" :use ((:instance binary-cat-2
+                                        (x1 x4)
+                                        (a1 a4)
+                                        (x0 (cat x3 a3 x2 a2 x1 a1 x0 a0))
+                                        (a0 (+ a0 a1 a2 a3)))
+                                    (:instance binary-cat-4)
+                                    (:instance bcevp-sum-4
+                                               (a (+ a0 a1 a2 a3)))))))
+                       
+
+                                                 
+(defthmd cat-bvecp-5
+    (implies (and (<= (+ a0 a1 a2 a3 a4) a)
+                  (case-split (integerp a)))
+             (bvecp (cat x4 a4 x3 a3 x2 a2  x1 a1 x0 a0) a))
+    :hints (("Goal" :in-theory (enable cat-bvecp-2))))
+
+
+(local-defthmd bcevp-sum-5
+              (implies (and (bvecp x4 a4)
+                            (bvecp x3 a3)
+                            (bvecp x2 a2)
+                            (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a4)
+                            (natp a3)
+                            (natp a2)
+                            (natp a1)
+                            (natp a0)
+                            (equal (+ a0 a1 a2 a3 a4) a))
+                       (bvecp (+ x0
+                                 (* x1  (expt 2 a0))
+                                 (* x2  (expt 2 (+ a0 a1)))
+                                 (* x3  (expt 2 (+ a0 a1 a2)))
+                                 (* x4  (expt 2 (+ a0 a1 a2 a3))))
+                              a))
+              :hints (("Goal" :use ((:instance cat-bvecp-5)
+                                    (:instance binary-cat-5)))))
+
+
+
+
+
+(local-defthmd binary-cat-6
+              (implies (and (bvecp x5 a5)
+                            (bvecp x4 a4)
+                            (bvecp x3 a3)
+                            (bvecp x2 a2)
+                            (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a5)
+                            (natp a4)
+                            (natp a3)
+                            (natp a2)
+                            (natp a1)
+                            (natp a0))
+                       (equal (cat x5 a5 x4 a4 x3 a3 x2 a2 x1 a1 x0 a0)
+                              (+ x0 
+                                 (* x1 (expt 2 a0))
+                                 (* x2 (expt 2 (+ a0 a1)))
+                                 (* x3 (expt 2 (+ a0 a1 a2)))
+                                 (* x4 (expt 2 (+ a0 a1 a2 a3)))
+                                 (* x5 (expt 2 (+ a0 a1 a2 a3 a4))))))
+              :hints (("Goal" :use ((:instance binary-cat-2
+                                        (x1 x5)
+                                        (a1 a5)
+                                        (x0 (cat x4 a4 x3 a3 x2 a2 x1 a1 x0 a0))
+                                        (a0 (+ a0 a1 a2 a3 a4)))
+                                    (:instance binary-cat-5)
+                                    (:instance bcevp-sum-5
+                                               (a (+ a0 a1 a2 a3 a4)))))))
+                       
+
+(defthmd cat-bvecp-6
+    (implies (and (<= (+ a0 a1 a2 a3 a4 a5) a)
+                  (case-split (integerp a)))
+             (bvecp (cat x5 a5 x4 a4 x3 a3 x2 a2  x1 a1 x0 a0) a))
+    :hints (("Goal" :in-theory (enable cat-bvecp-2))))
+
+
+(local-defthmd bcevp-sum-6
+              (implies (and (bvecp x5 a5)
+                            (bvecp x4 a4)
+                            (bvecp x3 a3)
+                            (bvecp x2 a2)
+                            (bvecp x1 a1)
+                            (bvecp x0 a0)
+                            (natp a5)
+                            (natp a4)
+                            (natp a3)
+                            (natp a2)
+                            (natp a1)
+                            (natp a0)
+                            (equal (+ a0 a1 a2 a3 a4 a5) a))
+                       (bvecp (+ x0
+                                 (* x1  (expt 2 a0))
+                                 (* x2  (expt 2 (+ a0 a1)))
+                                 (* x3  (expt 2 (+ a0 a1 a2)))
+                                 (* x4  (expt 2 (+ a0 a1 a2 a3)))
+                                 (* x5  (expt 2 (+ a0 a1 a2 a3 a4))))
+                              a))
+              :hints (("Goal" :use ((:instance cat-bvecp-6)
+                                    (:instance binary-cat-6)))))
+
+
+
+
+
+(defthm zeta-bnd-properties
+  (integerp (zeta i))
+  :rule-classes :type-prescription)
+
+
+(defthm zeta-bnd-properties-2
+  (<= (zeta i) 2)
+  :rule-classes :linear)
+
+(defthm zeta-bnd-properties-3
+  (<= -2 (zeta i))
+  :rule-classes :linear)
+  
+
+(local 
+ (encapsulate () 
+     (local-defthm x-zeta-bnd-specific
+                   (implies (and (<= 0 x)
+                                 (< (* 2 x) y)
+                                 (integerp y)
+                                 (integerp n)
+                                 (integerp x))
+                            (>=  (+ (* x (zeta i)) y) 1))
+                   :hints (("Goal" :in-theory (disable zeta-bnd)
+                            :use ((:instance zeta-bnd))))
+                   :rule-classes nil)
+
+     (local-defthm arith-hack-local
+                   (implies (and (< x y)
+                                 (<= (* 2 y) z))
+                            (< (* 2 x) z))
+                   :rule-classes nil)
+
+
+     (local-defthm zeta-i-rationalp
+                   (RATIONALP (ZETA I))
+                   :hints (("Goal" :use ((:instance zeta-bnd)))))
+
+     (local-defthm x-expt-hack-2
+                   (implies (and (<= 0 x)
+                                 (rationalp x))
+                            (<= (* x (zeta i))
+                                (* 2 x)))
+                   :hints (("Goal" :use zeta-bnd))
+                   :rule-classes nil)
+
+  (defthm bvecp-bmux4
+    (implies (and (bvecp x (+ -1 n))
+                  (integerp n)
+                  (< 0 n))
+             (bvecp (bmux4 (zeta i) x n) n))
+    :hints (("Goal" :in-theory (e/d (bvecp zeta-bnd EXPT-2-REDUCE-LEADING-CONSTANT) ())
+             :use ((:instance expt-weak-monotone-linear
+                              (n (+ -1 n))
+                              (m n))))
+            ("Subgoal 2" :use ((:instance x-zeta-bnd-specific
+                                          (y (expt 2 n)))
+                               (:instance arith-hack-local
+                                          (x x)
+                                          (z (expt 2 n))
+                                          (y (expt 2 (+ -1 n))))
+                               (:instance expt-weak-monotone-linear
+                                          (n (+ -1 n))
+                                          (m n))))
+            ("Subgoal 1" :use x-expt-hack-2)))))
+
+
+(local-defthm lnot-bvecp-1
+              (implies (and (> i 0)
+                            (integerp i))
+                       (bvecp (lnot any 1) i))
+              :hints (("Goal" :in-theory (enable lnot bvecp))))
+
+(local-defthm neg-bvecp-1
+              (implies (and (> i 0)
+                            (integerp i))
+                       (bvecp (neg any) i))
+              :hints (("Goal" :in-theory (enable bvecp))))
+
+(local-defthm zero-bvecp-1
+              (bvecp 0 any)
+              :hints (("Goal" :in-theory (enable bvecp))))
+
+
+(local-defthm one-bvecp-1
+              (implies (and (integerp i)
+                            (< 0 i))
+                       (bvecp 1 i))
+              :hints (("Goal" :in-theory (enable bvecp))))
+
+
+(local-defthm neg-lnot
+              (EQUAL (+ (NEG any)
+                        (LNOT (neg any) 1))
+                     1)
+              :hints (("Goal" :in-theory (enable neg lnot))))
+       
+
+(defthm pp4-reduce-to-1
+  (implies (and (integerp n)
+                (integerp i)
+                (< 0 i)
+                (bvecp x (+ -1 n))
+                (> n 0))
+           (equal (pp4 i x n)
+                 (+ (EXPT 2 (+ 1 N (* 2 I)))
+                    (EXPT 2 (+ N (* 2 I)))
+                    (* -1 (NEG (ZETA I))
+                       (EXPT 2 (+ N (* 2 I))))
+                    (* (EXPT 2 (* 2 I))
+                       (BMUX4 (ZETA I) X N))
+                    (* (NEG (ZETA (+ -1 I)))
+                       (EXPT 2 (+ -2 (* 2 I)))))))
+  :hints (("Goal" :in-theory (disable bmux4-reduce-to bmux4 neg)
+           :use ((:instance binary-cat-6
+                                   (x5 1)
+                                   (a5 1)
+                                   (x4 (lnot (neg (zeta i)) 1))
+                                   (a4 1)
+                                   (x3 (bmux4 (zeta i) x n))
+                                   (a3 n)
+                                   (x2 0)
+                                   (a2 1)
+                                   (x1 (neg (zeta (+ -1 i))))
+                                   (a1 1)
+                                   (x0 0)
+                                   (a0 (* 2 (+ -1 i))))))))
+
+
+(defthm pp4-reduce-to-2
+  (implies (and (integerp n)
+                (bvecp x (+ -1 n))
+                (> n 0))
+           (equal (pp4 0 x n)
+                  (+ (EXPT 2 (+ 1 N))
+                     (EXPT 2 (+ N))
+                     (* -1 (NEG (ZETA 0))
+                        (EXPT 2 (+ N)))
+                     (BMUX4 (ZETA 0) X N))))
+  :hints (("Goal" :in-theory (disable bmux4-reduce-to bmux4 neg)
+           :use ((:instance binary-cat-3
+                                   (x2 1)
+                                   (a2 1)
+                                   (x1 (lnot (neg (zeta 0)) 1))
+                                   (a1 1)
+                                   (x0 (bmux4 (zeta 0) x n))
+                                   (a0 n))))))
+
+
+
+(defun sum-pp4-part1 (i n)
+  (if (zp i)
+      0
+    (+ (sum-pp4-part1 (+ -1 i) n)
+       (+ (expt 2 (+ 1 n (* 2 (+ -1 i))))
+          (expt 2 (+ n (* 2 (+ -1 i))))))))
+
+
+(defthm sum-pp4-part1-reduce-to-expt-n-2m
+  (implies (and (integerp n)
+                (integerp m)
+                (< 0 m))
+           (equal (+ (expt 2 n) 
+                     (sum-pp4-part1 m n))
+                  (expt 2 (+ n (* 2 m)))))
+  :hints (("Goal" :do-not '(generalize)
+           :in-theory (enable expt-2-reduce-leading-constant))
+          ("Subgoal *1/3" :expand ((SUM-PP4-PART1 1 N)))))
+
+
+(defun sum-pp4-part3 (m)
+  (if (zp m)
+      0
+    (if (equal m 1)
+        0
+      (+ (sum-pp4-part3 (+ -1 m))
+         (* (neg (zeta (+ -2 m)))
+            (expt 2 (+ -2 (* 2 (+ -1 m)))))))))
+
+
+(defun sum-pp4-part2 (m x n)
+  (if (zp m)
+      0
+    (+ (sum-pp4-part2 (+ -1 m) x n)
+       (+ (* -1 (neg (zeta (+ -1 m)))
+             (expt 2 (+ n (* 2 (+ -1 m)))))
+          (* (EXPT 2 (* 2 (+ -1 m)))
+             (bmux4 (zeta (+ -1 m)) x n))))))
+
+
+(defthm integerp-bmux4
+  (implies (and (natp n)
+                (integerp x))
+           (INTEGERP (BMUX4 (ZETA I) X N)))
+  :hints (("Goal" :in-theory (e/d (lnot)
+                                  (zeta-bnd))
+           :use ((:instance zeta-bnd)))))
+
+(defthm integerp-bmux4-f
+  (implies (and (natp n)
+                (integerp x))
+           (integerp (BMUX4 (ZETA I) X N)))
+  :hints (("Goal" :in-theory (disable bmux4 zeta-bnd)))
+  :rule-classes :type-prescription)
+
+
+
+
+(defthm sum-pp4-reduce-to
+  (implies (and (integerp n)
+                (bvecp x (+ -1 n))
+                (> n 0)
+                (integerp m)
+                (< 0 m))
+           (equal (sum-pp4 x m n)
+                  (+ (sum-pp4-part1 m n)
+                     (sum-pp4-part2 m x n)
+                     (sum-pp4-part3 m))))
+  :hints (("Goal" :in-theory (disable pp4 bmux4-reduce-to zeta-bnd neg lnot
+                                      bmux4)
+           :do-not '(generalize))))
+
+(defthm integerp-sum-pp4-part2
+  (implies (and (integerp x)
+                (integerp n)
+                (< 0 n)
+                (integerp n)
+                (< 0 m))
+           (integerp (sum-pp4-part2 m x n)))
+  :hints (("Goal" :in-theory (e/d () (bmux4 bmux4-reduce-to))))
+  :rule-classes :type-prescription)
+                    
+
+
+;; (defun sum-bmux4 (x m n)
+;;   (if (zp m) 0
+;;     (+ (sum-bmux4 x (+ -1 m) n)
+;;        (* (bmux4 (zeta (+ -1 m)) x n)
+;;           (expt 2 (* 2 (+ -1 m)))))))
+
+
+;; :pe bmux4-reduce-to
+;;          18  (DEFTHM
+;;                 BMUX4-REDUCE-TO
+;;                 (IMPLIES (AND (INTEGERP ZETA)
+;;                               (<= ZETA 2)
+;;                               (<= -2 ZETA)
+;;                               (INTEGERP N)
+;;                               (BVECP X (+ -1 N))
+;;                               (>= N 0))
+;;                          (EQUAL (BMUX4 ZETA X N)
+;;                                 (IF (<= 0 ZETA)
+;;                                     (* ZETA X)
+;;                                     (+ -1 (EXPT 2 N) (* ZETA X)))))
+       
+
+;; (defthm part2-item-reduce-to-alt
+;;   (equal (+ (* -1 (NEG (ZETA i))
+;;                (EXPT 2 (+ N (* 2 i))))
+;;             (* (EXPT 2 (* 2 i))
+;;                (BMUX4 (ZETA i) X N)))
+;;          (+ (* x (zeta i)))))
+  
+
+
+
+;(BMUX4 (ZETA (+ -1 M)) X N))
+
+;;          (EQUAL (+ (EXPT 2 (* 2 M))
+;;                    (* (EXPT 2 (* 2 M))
+;;                       (BMUX4 (ZETA (+ -1 M)) X N)))
+;;                 (+ (EXPT 2 (+ N (* 2 M)))
+;;                    (* X (ZETA (+ -1 M))
+;;                       (EXPT 2 (* 2 M)))))).
+
+
+
+(local-defthm arith-hack-reduce
+               (implies (and (not (equal x 0))
+                             (acl2-numberp x)
+                             (acl2-numberp v)
+                             (acl2-numberp w))
+                        (equal (equal (+ x (* x y))
+                                      (+ z (* v w x)))
+                               (equal (+ 1 y)
+                                      (+ (/ z x) (* v w)))))
+               :rule-classes nil)
+
+
+(local-defthm sum-pp4-part2-reduce-lemma
+  (implies (and (integerp n)
+                (bvecp x (+ -1 n))
+                (< 0 m)
+                (integerp m)
+                (>= n 0))
+           (EQUAL (+ (* (NEG (ZETA (+ -1 M)))
+                        (EXPT 2 (+ -2 (* 2 M))))
+                     (* -1 (NEG (ZETA (+ -1 M)))
+                        (EXPT 2 (+ -2 N (* 2 M))))
+                     (* (EXPT 2 (+ -2 (* 2 M)))
+                        (BMUX4 (ZETA (+ -1 M)) X N)))
+                  (* X (ZETA (+ -1 M))
+                     (EXPT 2 (+ -2 (* 2 M))))))
+  :hints (("Goal" :in-theory (e/d (expt-2-reduce-leading-constant)
+                                  (bmux4 bmux4-reduce-to zeta-bnd
+                                         EQUAL-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE))
+           :use ((:instance bmux4-reduce-to
+                            (zeta (zeta (+ -1 m))))
+                 (:instance zeta-bnd (i (+ -1 m)))
+                 (:instance arith-hack-reduce
+                            (x (expt 2 (* 2 m)))
+                            (y (bmux4 (zeta (+ -1 m)) x n))
+                            (z (expt 2 (+ n (* 2 m))))
+                            (v x)
+                            (w (zeta (+ -1 m)))))))
+  :rule-classes nil)
+
+
+(defthm integerp-sum-zeta
+  (integerp (sum-zeta m))
+  :rule-classes :type-prescription)
+
+(defthm integerp-sum-zeta-specific
+  (integerp (sum-zeta 1))
+  :rule-classes :type-prescription)
+
+(defthm integerp-zeta
+  (integerp (zeta i))
+  :rule-classes :type-prescription)
+
+(defthm sum-zeta-1-is-zeta-0
+  (equal (SUM-ZETA 1)
+         (zeta 0))
+  :hints (("Goal" :in-theory (disable (sum-zeta)))))
+
+
+(local-defthm sum-pp4-part2-reduce
+  (implies (and (integerp n)
+                (integerp m)
+                (< 0 m)
+                (bvecp x (+ -1 n))
+                (>= n 0))
+           (equal (+ (sum-pp4-part2 m x n)
+                     (sum-pp4-part3 m)
+                     (* (neg (zeta (+ -1 m)))
+                        (expt 2 (* 2 (+ -1 m)))))
+                  (* x (sum-zeta m))))
+  :hints (("Goal"
+
+; The following hint, :induct t, was added by Matt Kaufmann on 9/28/2013 so
+; that the proof goes through with ACL2(hp) and, presumably, ACL2(p).  A
+; difference between those two and "vanilla" ACL2 is in the algorithm for
+; reverting to prove the original goal by induction: this can happen later with
+; ACL2(p) and ACL2(hp) than with ACL2.  In this case, without :induct t,
+; ACL2(hp) created subgoals such as Subgoal 1.1.1.1.1.1.1.2'', while on the
+; other hand ACL2 aborted immediately after Subgoal 1.2'' to prove the original
+; goal by induction.
+
+           :induct t
+           :in-theory (e/d ()
+                           (bmux4 (sum-zeta) 
+                                  bmux4-reduce-to neg lnot zeta-bnd))
+           :do-not '(generalize))
+          ("Subgoal *1/3" :use sum-pp4-part2-reduce-lemma)
+          ("Subgoal *1/2" :in-theory (e/d (neg lnot zeta-bnd) ((sum-zeta)))
+           :expand ((BMUX4 (ZETA 0) X N)))))
+
+
+(defthm booth4-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4 x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+    :hints (("Goal" :do-not '(generalize fertilize)
+             :do-not-induct t
+             :in-theory (disable sum-pp4 sum-zeta sum-pp4-part2-reduce
+                                 sum-pp4-part2
+                                 sum-pp4-part3
+                                 sum-pp4-part1
+                                 (sum-zeta)
+                                 sum-pp4-part1-reduce-to-expt-n-2m)
+             :use ((:instance sum-pp4-part2-reduce)
+                   (:instance sum-pp4-part1-reduce-to-expt-n-2m))))
+  :rule-classes ())
+
+
+
+
+(defun pp4-theta (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (theta i y)) 1) 1
+	    (bmux4 (theta i y) x n) n)
+     (cat 1 1
+	  (lnot (neg (theta i y)) 1) 1
+	  (bmux4 (theta i y) x n) n
+	  0 1
+	  (neg (theta (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+
+(defun sum-pp4-theta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-theta (1- m) x y n)
+       (sum-pp4-theta x y (1- m) n))))
+
+       
+
+(local-defthm booth4-corollary-lemma
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-theta m y))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (theta (1- m) y)))))))
+  :rule-classes ()
+  :hints (("Goal" 
+           :use ((:functional-instance
+                  booth4-thm
+                  (zeta (lambda (i) (theta i y)))
+                  (sum-zeta (lambda (m) (sum-theta m y)))
+                  (pp4  (lambda (i x n) (pp4-theta i x y n)))
+                  (sum-pp4  (lambda (x m n) (sum-pp4-theta x y m n))))))
+          ("Subgoal 2" :in-theory (disable pp4-theta))))
+
+;; (defthm sum-theta-lemma
+;;   (implies (and (not (zp m))
+;;                 (integerp m)
+;;                 (bvecp y (1- (* 2 m))))
+;;            (equal y (sum-theta m y)))
+
+(defthm theta-m-minus-1
+  (implies (bvecp y (1- (* 2 m)))
+           (equal (neg (theta (+ -1 m) y)) 
+                  0)))
+                  
+(defthm booth4-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth4-corollary-lemma)
+                        (:instance sum-theta-lemma))
+           :in-theory (disable pp4-theta theta
+                               sum-pp4-theta sum-theta))))
+                        
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits y (1+ (* 2 i)) (* 2 i)) (chi i y)))
+ 
+ (defun chi (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu (1- i) y) 3)
+	 1
+       0))))
+
+
+(defun phi (i y)
+  (if (= (bits (mu i y) 1 0) 3)
+      -1
+    (bits (mu i y) 1 0)))
+
+(defthm phi-bnd
+    (member (phi i y) '(-1 0 1 2)))
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+;; Subgoal *1/4'
+;; (IMPLIES (AND (NOT (ZP M))
+;;               (< (SUM-ODD-POWERS-OF-2 (+ -1 M)) Y)
+;;               (<= 0 M)
+;;               (INTEGERP Y)
+;;               (<= 0 Y)
+;;               (<= Y
+;;                   (+ (SUM-ODD-POWERS-OF-2 (+ -1 M))
+;;                      (EXPT 2 (+ -1 (* 2 M))))))
+;;          (< (+ (CHI (+ -1 M) Y)
+;;                (BITS Y (+ -1 (* 2 M)) (+ -2 (* 2 M))))
+;;             3)).
+
+(local 
+ (encapsulate ()
+              (local (include-book "../support/cat"))
+              (defthm cat-bits-bits
+                (implies (and (equal j (1+ k))
+                              (equal n (+ 1 (- l) k))
+                              (case-split (<= (+ 1 (- j) i) m))
+                              (case-split (<= j i))
+                              (case-split (<= l k))
+                              (case-split (integerp i))
+                              (case-split (integerp k))
+                              (case-split (integerp l))
+                              (case-split (integerp m))
+                              )
+                         (equal (cat (bits x i j) m (bits x k l) n)
+                                (bits x i l))))))
+              
+
+;; (local-defthmd binary-cat-2
+;;               (implies (and (bvecp x1 a1)
+;;                             (bvecp x0 a0)
+;;                             (natp a1)
+;;                             (natp a0))
+;;                        (equal (cat x1 a1 x0 a0)
+;;                               (+ x0 
+;;                                  (* x1 (expt 2 a0)))))
+;;               :hints (("Goal" :in-theory (enable binary-cat))))
+
+
+
+
+(local-defthm bits-bits-split
+              (implies (and (natp i)
+                            (natp j)
+                            (natp l)
+                            (< l j)
+                            (< j i))
+                       (equal (bits x i l)
+                              (+ (* (expt 2 (+ (* -1 l) j)) 
+                                    (bits x i j))
+                                 (bits x (+ -1 j) l))))
+              :hints (("Goal" :in-theory (disable cat-bits-bits)
+                       :use ((:instance cat-bits-bits
+                                        (k (+ -1 j))
+                                        (m (+ 1 i (* -1 j)))
+                                        (n (+ j (* -1 l))))
+                             (:instance binary-cat-2
+                                        (x1 (bits x i j))
+                                        (a1 (+ 1 i (* -1 j)))
+                                        (x0 (bits x (+ -1 j) l))
+                                        (a0 (+ j (* -1 l)))))))
+              :rule-classes nil)
+
+
+(local-defthm y-expand-local
+              (implies (and (integerp k)
+                            (<= 0 k))
+                       (equal (bits  y (+ 1 (* 2 k)) 0)
+                              (+ (* (expt 2 (* 2 k))
+                                    (bits y (+ 1 (* 2 k)) (* 2 k)))
+                                 (bits y (+ -1 (* 2 k)) 0))))
+              :hints (("Goal" 
+                       :use ((:instance bits-bits-split
+                                        (x y)
+                                        (i (+ 1 (* 2 k)))
+                                        (l 0)
+                                        (j (* 2 k))))))
+              :rule-classes nil)
+
+
+(defun sum-powers-of-2 (n)
+  (if (zp n) 0
+    (+ (expt 2 (+ -1 n))
+       (sum-powers-of-2 (+ -1 n)))))
+
+
+(defthm expt-0-is-1
+  (equal (EQUAL 1 (EXPT 2 0)) t)
+  :hints (("Goal" :expand ((expt 2 0)))))
+
+(local-defthmd sum-powers-of-2-equal
+              (implies (natp n)
+                       (equal (sum-powers-of-2 n)
+                              (+ -1 (expt 2 n))))
+              :hints (("Goal" :do-not '(fertilize generalize))
+                      ("Subgoal *1/4" :cases ((equal (+ (expt 2 (+ -1 n))
+                                                        (expt 2 (+ -1 n)))
+                                                     (expt 2 n))))
+                      ("Subgoal *1/4.1" :in-theory (disable a3))))
+
+
+(local-defthmd sum-odd-powers-upper-bound-lemma
+               (implies (and (integerp k)
+                             (< 0 k))
+                        (< (sum-odd-powers-of-2 k)
+                           (sum-powers-of-2 (* 2 k))))
+               :rule-classes :linear)
+
+
+(local-defthmd sum-odd-powers-upper-bound-weak
+               (implies (and (integerp k)
+                             (< 0 k))
+                        (< (sum-odd-powers-of-2 k)
+                           (+ -1 (expt 2 (* 2 k)))))
+               :rule-classes :linear
+               :hints (("Goal" :use ((:instance
+                                      sum-odd-powers-upper-bound-lemma)
+                                     (:instance sum-powers-of-2-equal
+                                                (n (* 2 k)))))))
+
+(local-defthmd y-lower-bound
+              (implies (and (integerp k)
+                            (<= 0 k))
+                       (<= (* (expt 2 (* 2 k))
+                              (bits y (+ 1 (* 2 k)) (* 2 k)))
+                           (bits y (+ 1 (* 2 k)) 0)))
+              :hints (("Goal" :use ((:instance y-expand-local)))))
+
+
+(local-defthmd chi-m-subgoal-1-5
+  (IMPLIES (AND (EQUAL (BITS Y (+ -1 (* 2 M)) (+ -2 (* 2 M)))
+                       3)
+                (integerp y)
+                (NOT (ZP M))
+                (<= 0 M))
+           (< (+ (SUM-ODD-POWERS-OF-2 (+ -1 M))
+                 (EXPT 2 (+ -1 (* 2 M))))
+              (bits y (+ -1 (* 2 m)) 0)))
+  :hints (("Goal" :in-theory (enable EXPT-2-REDUCE-LEADING-CONSTANT
+                                     expt-weak-monotone-linear)
+           :use ((:instance sum-odd-powers-upper-bound-weak
+                            (k (+ -1 m)))
+                 (:instance y-lower-bound
+                            (k (+ -1 m)))))))
+                            
+
+
+
+(local-defthmd chi-upper-bound
+               (<= (chi  m y)
+                   1)
+               :hints (("Goal" :expand (chi m y)))
+               :rule-classes :linear)
+
+
+
+(local-defthm chi-m-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= (bits y (+ -1 (* 2 m)) 0)
+                      (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+    :hints (("Goal" :do-not '(generalize))
+            ("Subgoal *1/5":use chi-m-subgoal-1-5)
+            ("Subgoal *1/4":cases ((not (<= (bits y (+ -1 (* 2 m))
+                                                  (+ -2 (* 2 m)))
+                                            1))))
+            ("Subgoal *1/4.2" :in-theory (enable chi-upper-bound))
+            ("Subgoal *1/4.1" :cases ((not (equal (BITS Y (+ -1 (* 2 M)) 
+                                                        (+ -2 (* 2 m))) 3))))
+            ("Subgoal *1/4.1.2" :use chi-m-subgoal-1-5)
+            ("Subgoal *1/4.1.1" :use ((:instance y-expand-local
+                                                 (k (+ -1 m))))
+             :in-theory (enable expt-2-reduce-leading-constant)))
+  :rule-classes())
+
+(defthm chi-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y
+                      (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+    :hints (("Goal" :use chi-m-lemma))
+    :rule-classes ())
+
+(local-defthm chi-m-equal-0-implies-mu-less-than-3
+              (implies (and (equal (chi m y) 0)
+                            (not (zp m)))
+                       (< (mu (+ -1 m) y) 3))
+              :hints (("Goal" :in-theory (disable mu)
+                       :expand ((chi m y)))))
+
+(defthm phi-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi (1- m) y) 0))
+    :hints (("Goal" :use ((:instance chi-m)
+                          (:instance chi-m-equal-0-implies-mu-less-than-3))
+             :do-not-induct t
+             :in-theory (disable chi mu)))
+    :rule-classes())
+
+
+(defun sum-phi (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi (1- m) y))
+	(sum-phi (1- m) y))))
+
+
+(local-defthmd mu-upper-bound
+               (<= (mu i y) 4)
+               :hints (("Goal" :in-theory (enable chi-upper-bound))))
+
+
+(local-defthmd mu-upper-bound
+               (<= (mu i y) 4)
+               :hints (("Goal" :in-theory (enable chi-upper-bound))))
+
+
+(local-defthmd chi-lower-bound
+               (<= 0 (chi  m y))
+               :hints (("Goal" :expand (chi m y)))
+               :rule-classes :linear)
+
+(local-defthmd mu-lower-bound
+               (<= 0 (mu i y))
+               :hints (("Goal" :in-theory (enable chi-lower-bound))))
+
+
+(local-defthmd bitn-2-of-mu-is-chi
+               (implies (not (equal (mu i y) 3))
+                        (equal (bitn (mu i y) 2) (chi (+ 1 i) y)))
+               :hints (("Goal" :cases ((not (equal (mu i y) 4))))
+                       ("Subgoal 1" :use ((:instance mu-upper-bound)))))
+
+
+(local-defthmd bitn-plus-bits-reduce
+              (implies (and (integerp x)
+                            (<= 0 x)
+                            (< x 8))
+                       (equal (+ (bits x 1 0)
+                                 (* 4 (bitn x 2)))
+                              x))
+              :hints (("Goal" :in-theory (enable mu-upper-bound)
+                       :use ((:instance BITN-PLUS-BITS
+                                        (m 0)
+                                        (n 2))))))
+
+
+(local-defthmd 4-chi-plus-phi-is-mu
+              (implies (natp i)
+                       (equal (+ (phi i y) (* 4 (chi (+ 1 i) y)))
+                              (mu i y)))
+              :hints (("Goal" :cases ((not (equal (mu i y) 3))))
+                      ("Subgoal 1" :in-theory (e/d () (mu))
+                       :use ((:instance bitn-2-of-mu-is-chi)
+                             (:instance bitn-plus-bits-reduce
+                                        (x (mu i y)))
+                             (:instance mu-upper-bound)))))
+
+
+(local-defthm sum-phi-lemma-k
+               (implies (natp m)
+                        (equal (bits y (+ -1 (* 2 m)) 0)  
+                               ;; could have used sumbits here. 
+                               (+ (sum-phi m y)
+                                  (* (chi m y) (expt 2 (* 2 m))))))
+               :hints (("Goal" :do-not '(generalize)
+                        :in-theory (e/d (expt-2-reduce-leading-constant)  (chi phi)))
+                       ("Subgoal *1/4" :use ((:instance y-expand-local
+                                                        (k (+ -1 m)))
+                                             (:instance 4-chi-plus-phi-is-mu
+                                                        (i (+ -1 m)))))
+                       ("Subgoal *1/1" :expand ((chi 0 y))))
+  :rule-classes ())
+
+(local-defthmd y-upper-bound
+  (implies (and (<= y (sum-odd-powers-of-2 m))
+                (integerp m)
+                (< 0 m))
+           (<  y (expt 2 (* 2 m))))
+  :hints (("Goal" :in-theory (enable SUM-ODD-POWERS-UPPER-BOUND-WEAK
+                                     sum-odd-powers-upper-bound-lemma)))
+  :rule-classes :linear)
+                                   
+
+
+(defthm sum-phi-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi m y)))
+    :hints (("Goal" :in-theory (e/d () (chi phi mu))
+             :do-not '(fertilize generalize)
+             :do-not-induct t
+             :use ((:instance sum-phi-lemma-k)
+                   (:instance chi-m)
+                   (:instance y-upper-bound))))
+  :rule-classes ())
+
+
+(defun pp4-phi (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (phi i y)) 1) 1
+	    (bmux4 (phi i y) x n) n)
+     (cat 1 1
+	  (lnot (neg (phi i y)) 1) 1
+	  (bmux4 (phi i y) x n) n
+	  0 1
+	  (neg (phi (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-phi (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-phi (1- m) x y n)
+       (sum-pp4-phi x y (1- m) n))))
+
+
+(local-defthm static-booth4-corollary-lemma
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-phi m y))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (phi (1- m) y)))))))
+  :rule-classes ()
+  :hints (("Goal" 
+           :use ((:functional-instance
+                  booth4-thm
+                  (zeta (lambda (i) (phi i y)))
+                  (sum-zeta (lambda (m) (sum-phi m y)))
+                  (pp4  (lambda (i x n) (pp4-phi i x y n)))
+                  (sum-pp4  (lambda (x m n) (sum-pp4-phi x y m n))))))
+          ("Subgoal 2" :in-theory (disable pp4-phi))))
+
+
+(local-defthm neg-phi-m-1-is-0
+              (implies (and (<= y (sum-odd-powers-of-2 m))
+                            (natp m)
+                            (natp y))
+                       (equal (neg (phi (+ -1 m) y)) 0))
+              :hints (("Goal" :in-theory (e/d () (phi))
+                       :use phi-m-1)))
+
+
+(defthm static-booth
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance static-booth4-corollary-lemma)
+                        (:instance sum-phi-lemma)
+                        (:instance phi-m-1))
+           :in-theory (e/d () (pp4-phi phi
+                               sum-pp4-phi sum-phi)))))
+
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+(include-book "../support/lior")
+(include-book "../support/land")
+(include-book "../support/lxor")
+
+
+(defun gamma (i a b c)
+   (if (zp i)
+       (bitn c 0)
+     (lior (bitn  a (+ -1  (* 2 i)))
+ 	   (bitn  b (+ -1  (* 2 i)))
+ 	  1)))
+
+
+(defun delta (i a b c d)
+  (if (zp i)
+      (bitn d 0)
+    (land (lior (land (bitn a (+ -2 (* 2 i))) 
+                      (bitn b (+ -2 (* 2 i)))
+                      1)
+		(lior (land (bitn a (+ -2 (* 2 i)))
+                            (gamma (1- i) a b c) 
+                            1)
+		      (land (bitn b (+ -2 (* 2 i)))
+                            (gamma (1- i) a b c)
+                            1)
+                      1)
+                1)
+	  (lnot (lxor (bitn a (1- (* 2 i))) 
+                      (bitn b (1- (* 2 i))) 
+                      1) 
+                1)
+	  1)))
+
+
+
+(defun psi (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits a (1+ (* 2 i)) (* 2 i))
+       (bits b (1+ (* 2 i)) (* 2 i))
+       (gamma i a b c)
+       (delta i a b c d)
+       (* -4 (+ (gamma (1+ i) a b c)
+                (delta (1+ i) a b c d))))))
+
+
+;; (local-defthm bitn-not-less-than
+;;               (implies (and (<= 0 b)
+;;                             (< b (expt 2 k)))
+;;                        (equal (bitn b k) 0)))
+                    
+
+;;see  bitn-too-small
+
+(defthm psi-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))  ;; 
+		  (bvecp b (- (* 2 m) 2))  ;;
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma m a b c) 0)
+		  (equal (delta m a b c d) 0)
+		  (>= (psi (1- m) a b c d) 0)))
+    :hints (("Goal" :in-theory (enable bvecp expt-2-reduce-leading-constant
+                                       expt-weak-monotone-linear)))
+  :rule-classes ())
+
+
+(defun sum-psi (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi (1- m) a b c d))
+	(sum-psi (1- m) a b c d))))
+
+
+
+(local-defthmd gamma-0-is-c
+               (implies (bvecp c 1)
+                        (equal (gamma 0 a b c)
+                               c)))
+
+(local-defthmd delta-0-is-d
+               (implies (bvecp d 1)
+                        (equal (delta 0 a b c d)
+                               d)))
+           
+
+(local-defthm sum-psi-lemma-k
+    (implies (and (natp k)
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ (bits a (+ -1 (* 2 k)) 0)
+                       (bits b (+ -1 (* 2 k)) 0)
+                       c d)
+                    (+ (sum-psi k a b c d)
+                       (* (expt 2 (* 2 k))
+                          (+ (gamma k a b c)
+                             (delta k a b c d))))))
+    :hints (("Goal" :induct (sum-psi k a b c d)
+             :do-not '(generalize)
+             :in-theory (e/d (expt-2-reduce-leading-constant
+                              gamma-0-is-c delta-0-is-d
+                              ) (gamma delta)))
+            ("Subgoal *1/2" :use ((:instance y-expand-local
+                                             (y a)
+                                             (k (+ -1 k)))
+                                  (:instance y-expand-local
+                                             (y b)
+                                             (k (+ -1 k))))))
+  :rule-classes ())
+
+(local-defthmd gamma-m-is-zero-when-a-b-small
+               (implies (and (bvecp a (+ -2 (* 2 m)))
+                             (bvecp b (+ -2 (* 2 m)))
+                             (< 0 m)
+                             (integerp m))
+                        (equal (gamma m a b c)
+                               0))
+               :hints (("Goal" :in-theory (enable BITN-BVECP-0))))
+
+
+(local-defthmd delta-m-is-zero-when-a-b-small
+              (implies (and (bvecp a (+ -2 (* 2 m)))
+                            (bvecp b (+ -2 (* 2 m)))
+                            (< 0 m)
+                            (integerp m))
+                       (equal (delta m a b c d)
+                              0))
+              :hints (("Goal" :in-theory (enable ;bvecp
+                                          bitn-bvecp-0
+                                          expt-weak-monotone-linear
+                                          expt-2-reduce-leading-constant))))
+
+
+(local-defthmd bits-tail-general
+               (implies (and (bvecp x k)
+                             (integerp k)
+                             (integerp j)
+                             (<= k (+ 1 j)))
+                        (equal (bits x j 0) x))
+               :hints (("Goal" :in-theory (enable bvecp
+                                                  expt-weak-monotone-linear)
+                        :cases ((not (<= (expt 2 k) (expt 2 (+ 1 j))))))))
+
+(defthm sum-psi-lemma
+    (implies (and (natp m)
+                  (<= 1 m)
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi m a b c d)))
+    :hints (("Goal" :use ((:instance sum-psi-lemma-k
+                                     (k m)))
+             :in-theory (e/d (gamma-0-is-c
+                              gamma-m-is-zero-when-a-b-small
+                              delta-0-is-d
+                              delta-m-is-zero-when-a-b-small
+                              bits-tail-general)
+                             (gamma delta sum-psi BITS-REDUCE))))
+  :rule-classes ())
+
+
+
+            
+(local-defthm delta-bnd-1
+  (<= 0 (delta i a b c d))
+  :rule-classes :linear)
+
+(local-defthm delta-bnd-2
+  (<= (delta i a b c d) 1)
+  :rule-classes :linear)
+
+
+(local-defthm gamma-bnd-1
+  (<= 0 (gamma i a b c))
+  :rule-classes :linear)
+
+(local-defthm gamma-bnd-2
+  (<= (gamma i a b c) 1)
+  :rule-classes :linear)
+
+
+(local-defthm bitn-gamma-gamma
+  (equal (bitn (gamma i a b c) 0)
+         (gamma i a b c)))
+
+(local-defthm bitn-delta-delta
+  (equal (bitn (delta i a b c d) 0)
+         (delta i a b c d)))
+
+
+
+;; (local-defthmd binary-cat-2
+;;               (implies (and (bvecp x1 a1)
+;;                             (bvecp x0 a0)
+;;                             (natp a1)
+;;                             (natp a0))
+;;                        (equal (cat x1 a1 x0 a0)
+;;                               (+ x0 
+;;                                  (* x1 (expt 2 a0)))))
+;;               :hints (("Goal" :in-theory (enable binary-cat))))
+
+
+(local-defthmd bits-expand-specific
+  (implies (natp i)
+           (equal (BITS x (+ 1 (* 2 I)) (* 2 I))
+                  (+ (* 2 (bitn x (+ 1 (* 2 i))))
+                     (bitn x (* 2 i)))))
+  :hints (("Goal" :in-theory (enable bitn)
+           :use ((:instance cat-bits-bits
+                            (i (+ 1 (* 2 i)))
+                            (j (+ 1 (* 2 i)))
+                            (m 1)
+                            (n 1)
+                            (k (* 2 i))
+                            (l (* 2 i)))
+                 (:instance binary-cat-2
+                            (x1 (bitn x (+ 1 (* 2 i))))
+                            (a1 1)
+                            (x0 (bitn x (* 2 i)))
+                            (a0 1))))))
+
+
+(defthmd psi-bnd
+  (and (integerp (psi i a b c d))
+       (<= (psi i a b c d) 2)
+       (>= (psi i a b c d) -2))
+  :hints (("Goal" :in-theory (e/d (bits-expand-specific)
+                                  (bits bitn
+                                        gamma 
+                                        delta))
+           :expand ((gamma (+ 1 i) a b c)
+                    (DELTA (+ 1 I) A B C D)))))
+
+
+
+
+
+
+(defun pp4-psi (i x a b c d n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (psi i a b c d)) 1) 1
+	    (bmux4 (psi i a b c d) x n) n)
+     (cat 1 1
+	  (lnot (neg (psi i a b c d)) 1) 1
+	  (bmux4 (psi i a b c d) x n) n
+	  0 1
+	  (neg (psi (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-psi (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4-psi (1- m) x a b c d n)
+       (sum-pp4-psi x a b c d (1- m) n))))
+
+(defthm integerp-psi
+  (integerp (psi i a b c d)))
+
+
+(local-defthm 
+ redundant-booth4-corollary-lemma
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-psi m a b c d))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (psi (1- m) a b c d)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (psi-bnd) (psi pp4-psi))
+           :do-not-induct t
+           :use ((:functional-instance
+                  booth4-thm
+                  (zeta (lambda (m) (psi m a b c d)))
+                  (sum-zeta (lambda (m) (sum-psi m a b c d)))
+                  (pp4  (lambda (m x n) (pp4-psi m x a b c d  n)))
+                  (sum-pp4  (lambda (x m n) (sum-pp4-psi x a b c d m n))))))
+          ("Subgoal 1" :in-theory (enable pp4-psi))))
+
+
+
+(local-defthm neg-psi-m-1-is-0
+              (implies (and (NATP M)
+                              (>= M 1)
+                              (BVECP A (- (* 2 M) 2))
+                              (BVECP B (- (* 2 M) 2))
+                              (BVECP C 1)
+                              (BVECP D 1))
+                       (equal (neg (psi (+ -1 m) a b c d)) 0))
+              :hints (("Goal" :in-theory (e/d () (psi))
+                       :use psi-m-1)))
+
+
+(defthm redundant-booth
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+    :hints (("Goal" :in-theory (disable psi sum-pp4-psi)
+             :use ((:instance redundant-booth4-corollary-lemma)
+                   (:instance sum-psi-lemma))))
+          
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+(defun eta (i y)
+  (+ (bitn y (1- (* 3 i))) 
+     (bitn y (* 3 i))
+     (* 2 (bitn y (1+ (* 3 i))))
+     (* -4 (bitn y (+ 2 (* 3 i))))))
+
+(defun sum-eta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta (1- m) y))
+	(sum-eta (1- m) y))))
+
+
+
+(defthm sum-eta-lemma-i
+  (implies (and (not (zp m))
+                (integerp k)
+                (integerp y)
+                (<= 0 k)
+                (<= k m))
+           (equal (sumbits y (* 3 k))
+                  (+ (sum-eta k y)
+                     (* (expt 2 (* 3 k))
+                        (bitn y (+ -1 (* 3 k)))))))
+  :hints (("Goal" :do-not '(generalize fertilize)
+           :in-theory (enable bitn-neg 
+                              expt-2-reduce-leading-constant)
+           :induct (sum-eta k y))
+          ("Subgoal *1/2" :expand ((SUMBITS Y (* 3 K))
+                                   (SUMBITS Y (+ -1 (* 3 K)))
+                                   (SUMBITS Y (+ -2 (* 3 K))))))
+  :rule-classes ())
+
+
+(defthm sum-eta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta m y)))
+  :hints (("Goal" :use ((:instance sum-eta-lemma-i 
+                                   (k m))
+                        (:instance  sumbits-thm 
+                                    (n (+ -1  (* 3 m)))
+                                    (x y)))
+           :do-not-induct t
+           :do-not '(fertilize)))
+  :rule-classes ())
+
+
+(defun bmux8 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (lnot x n))
+    (2  (* 2 x))
+    (-2 (lnot (* 2 x) n))
+    (3  (* 3 x))
+    (-3 (lnot (* 3 x) n))
+    (4  (* 4 x))
+    (-4 (lnot (* 4 x) n))
+    (0  0)))
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+(defun pp8 (i x n)
+  (if (zerop i)
+      (cat 3 2
+	   (lnot (neg (xi i)) 1) 1
+	   (bmux8 (xi i) x n) n)
+    (cat 3 2
+	 (lnot (neg (xi i)) 1) 1
+	 (bmux8 (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+
+
+(defun sum-pp8 (x m n)
+  (if (zp m)
+      0
+    (+ (pp8 (1- m) x n)
+       (sum-pp8 x (1- m) n))))
+
+
+
+
+(defthm bmux8-reduce-to
+  (implies (and (integerp eta)
+                (<= eta 2)
+                (<= -2 eta)
+                (integerp n)
+                (bvecp x (+ -1 n))
+                (>= n 0))
+           (equal (bmux8 eta x n)
+                  (if (<= 0 eta)
+                      (* eta x)
+                    (+ -1 (expt 2 n)
+                       (* eta x)))))
+  :hints (("Goal" :in-theory (enable lnot BITS-TAIL-SPECIAL))))
+
+
+
+
+(defthm xi-bnd-properties
+  (integerp (xi i))
+  :rule-classes :type-prescription)
+
+
+(defthm xi-bnd-properties-2
+  (<= (xi i) 4)
+  :rule-classes :linear)
+
+(defthm xi-bnd-properties-3
+  (<= -4 (xi i))
+  :rule-classes :linear)
+  
+
+(defthm bvecp-bmux8
+  (implies (and (bvecp x (+ -2 n))
+                (integerp i)
+                (integerp n)
+                (< 0 n))
+           (bvecp (bmux8 (xi i) x n) n))
+  :hints (("Goal" :in-theory (e/d (bvecp lnot xi-bnd EXPT-2-REDUCE-LEADING-CONSTANT) ())
+           :use ((:instance expt-weak-monotone-linear
+                            (n (+ -2 n))
+                            (m n))))))
+
+          
+
+
+(defthm pp8-reduce-to-1
+  (implies (and (integerp n)
+                (integerp i)
+                (< 0 i)
+                (bvecp x (+ -2 n))
+                (> n 0))
+           (equal (pp8 i x n)
+                 (+ (EXPT 2 (+ 2 N (* 3 I)))
+                    (EXPT 2 (+ 1 N (* 3 I)))
+                    (EXPT 2 (+ N (* 3 I)))
+                    (* -1 (NEG (XI I))
+                       (EXPT 2 (+ N (* 3 I))))
+                    (* (EXPT 2 (* 3 I))
+                       (BMUX8 (XI i) X N))
+                    (* (NEG (XI (+ -1 I)))
+                       (EXPT 2 (+ -3 (* 3 I)))))))
+  :hints (("Goal" :in-theory (e/d (expt-2-reduce-leading-constant)
+                                  (bmux8-reduce-to bmux8 (bmux8) neg))
+           :use ((:instance binary-cat-6
+                                   (x5 3)
+                                   (a5 2)
+                                   (x4 (lnot (neg (xi i)) 1))
+                                   (a4 1)
+                                   (x3 (bmux8 (xi i) x n))
+                                   (a3 n)
+                                   (x2 0)
+                                   (a2 2)
+                                   (x1 (neg (xi (+ -1 i))))
+                                   (a1 1)
+                                   (x0 0)
+                                   (a0 (* 3 (+ -1 i))))))))
+
+
+
+;;                         (CAT 3 2 (LNOT (NEG (XI I)) 1)
+;;                              1 (BMUX8 (XI I) X N)
+;;                              N)
+
+(defthm pp8-reduce-to-2
+  (implies (and (integerp n)
+                (bvecp x (+ -2 n))
+                (> n 0))
+           (equal (pp8 0 x n)
+                  (+ (EXPT 2 (+ 2 N))
+                     (EXPT 2 (+ 1 N))
+                     (EXPT 2 N)
+                     (* -1 (NEG (xi 0))
+                        (EXPT 2 (+ N)))
+                     (BMUX8 (xi 0) X N))))
+  :hints (("Goal" :in-theory (e/d (expt-2-reduce-leading-constant)
+                                  (bmux8-reduce-to bmux8 neg))
+           :use ((:instance binary-cat-3
+                                   (x2 3)
+                                   (a2 2)
+                                   (x1 (lnot (neg (xi 0)) 1))
+                                   (a1 1)
+                                   (x0 (bmux8 (xi 0) x n))
+                                   (a0 n))))))
+
+
+
+;(i-am-here) ;; Fri Oct 20 11:08:20 2006
+
+
+(defun sum-pp8-part1 (i n)
+  (if (zp i)
+      0
+    (+ (sum-pp8-part1 (+ -1 i) n)
+       (+ (expt 2 (+ 2 n (* 3 (+ -1 i))))
+          (expt 2 (+ 1 n (* 3 (+ -1 i))))
+          (expt 2 (+ n (* 3 (+ -1 i))))))))
+
+
+(defthm sum-pp8-part1-reduce-to-expt-n-3m
+  (implies (and (integerp n)
+                (integerp m)
+                (< 0 m))
+           (equal (+ (expt 2 n) 
+                     (sum-pp8-part1 m n))
+                  (expt 2 (+ n (* 3 m)))))
+  :hints (("Goal" :do-not '(generalize)
+           :in-theory (enable expt-2-reduce-leading-constant))
+          ("Subgoal *1/3" :expand ((SUM-PP8-PART1 1 N)))))
+
+
+
+(defun sum-pp8-part3 (m)
+  (if (zp m)
+      0
+    (if (equal m 1)
+        0
+      (+ (sum-pp8-part3 (+ -1 m))
+         (* (neg (xi (+ -2 m)))
+            (expt 2 (* 3 (+ -2 m))))))))
+
+
+(defun sum-pp8-part2 (m x n)
+  (if (zp m)
+      0
+    (+ (sum-pp8-part2 (+ -1 m) x n)
+       (+ (* -1 (neg (xi (+ -1 m)))
+             (expt 2 (+ n (* 3 (+ -1 m)))))
+          (* (EXPT 2 (* 3 (+ -1 m)))
+             (bmux8 (xi (+ -1 m)) x n))))))
+
+
+(defthm sum-pp8-reduce-to
+  (implies (and (integerp n)
+                (bvecp x (+ -2 n))
+                (> n 0)
+                (integerp m)
+                (< 0 m))
+           (equal (sum-pp8 x m n)
+                  (+ (sum-pp8-part1 m n)
+                     (sum-pp8-part2 m x n)
+                     (sum-pp8-part3 m))))
+  :hints (("Goal" :in-theory (e/d (expt-2-reduce-leading-constant)
+                                  (pp8 bmux8-reduce-to xi-bnd neg lnot
+                                       bmux8))
+           :do-not '(generalize))))
+
+
+
+(local-defthmd bvecp-bits-specific-2
+               (implies (and (bvecp x (+ -2 n))
+                             (integerp n))
+                        (equal (BITS X (+ -1 N) 0)
+                               x))
+               :hints (("Goal" :in-theory (e/d (bvecp) (expt-compare bits-reduce))
+                        :use ((:instance expt-weak-monotone-linear
+                                         (n (+ -2 n))
+                                         (m n))
+                              (:instance bits-reduce
+                                         (i (+ -1 n)))))))
+
+
+(local-defthmd bvecp-bits-specific-3
+               (implies (and (bvecp x (+ -2 n))
+                             (integerp n))
+                        (equal (BITS (* 3 X) (+ -1 N) 0)
+                               (* 3 x)))
+               :hints (("Goal" :in-theory (e/d (bvecp expt-2-reduce-leading-constant) 
+                                               (expt-compare
+                                                bits-reduce))
+                        :use ((:instance bits-reduce
+                                         (x (* 3 x))
+                                         (i (+ -1 n)))))))
+
+
+
+
+(local-defthm sum-pp8-part2-reduce-lemma
+  (implies (and (integerp n)
+                (bvecp x (+ -2 n))
+                (< 0 m)
+                (integerp m)
+                (>= n 0))
+           (EQUAL (+ (* (NEG (xi (+ -1 M)))
+                        (EXPT 2 (+ -3 (* 3 M))))
+                     (* -1 (NEG (xi (+ -1 M)))
+                        (EXPT 2 (+ -3 N (* 3 M))))
+                     (* (EXPT 2 (+ -3 (* 3 M)))
+                        (BMUX8 (xi (+ -1 M)) X N)))
+                  (* X (xi (+ -1 M))
+                     (EXPT 2 (+ -3 (* 3 M))))))
+  :hints (("Goal" :in-theory (e/d (expt-2-reduce-leading-constant 
+                                   lnot 
+                                   bvecp-bits-specific-2 
+                                   bvecp-bits-specific-3)
+                                  (bmux4 bmux8-reduce-to xi-bnd 
+                                         EQUAL-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE))
+           :use ((:instance bmux8-reduce-to
+                            (eta (+ -1 m)))
+                 (:instance xi-bnd (i (+ -1 m))))))
+  :rule-classes nil)
+
+
+(local-defthm sum-pp8-part2-reduce
+  (implies (and (integerp n)
+                (integerp m)
+                (< 0 m)
+                (bvecp x (+ -2 n))
+                (>= n 0))
+           (equal (+ (sum-pp8-part2 m x n)
+                     (sum-pp8-part3 m)
+                     (* (neg (xi (+ -1 m)))
+                        (expt 2 (* 3 (+ -1 m)))))
+                  (* x (sum-xi m))))
+  :hints (("Goal" :in-theory (e/d ()
+                                  (bmux8 (sum-xi) 
+                                         bmux8-reduce-to neg lnot xi-bnd))
+           :do-not '(generalize))
+          ("Subgoal *1/3" :use sum-pp8-part2-reduce-lemma)
+          ("Subgoal *1/2" :in-theory (e/d (bvecp-bits-specific-3
+                                           bvecp-bits-specific-2 neg lnot
+                                           xi-bnd)
+                                          ((sum-xi)))
+           :expand ((BMUX8 (ZETA 0) X N)))))
+
+
+(defthm booth8-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8 x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+    :hints (("Goal" :do-not '(generalize fertilize)
+             :do-not-induct t
+             :in-theory (disable sum-pp8 sum-xi sum-pp8-part2-reduce
+                                 sum-pp8-part2
+                                 sum-pp8-part3
+                                 sum-pp8-part1
+                                 (sum-xi)
+                                 sum-pp8-part1-reduce-to-expt-n-3m)
+             :use ((:instance sum-pp8-part2-reduce)
+                   (:instance sum-pp8-part1-reduce-to-expt-n-3m))))
+  :rule-classes ())
+
+
+(defun pp8-eta (i x y n)
+  (if (zerop i)
+      (cat 3 2
+	   (lnot (neg (eta i y)) 1) 1
+	   (bmux8 (eta i y) x n) n)
+    (cat 3 2
+	 (lnot (neg (eta i y)) 1) 1
+	 (bmux8 (eta i y) x n) n
+	 0 2
+	 (neg (eta (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+
+(defun sum-pp8-eta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8-eta (1- m) x y n)
+       (sum-pp8-eta x y (1- m) n))))
+
+
+
+;; (defthm sum-eta-lemma
+;;     (implies (and (not (zp m))
+;; 		  (bvecp y (1- (* 3 m))))
+;; 	     (equal y (sum-eta m y)))
+;;   :hints (("Goal" :use ((:instance sum-eta-lemma-i 
+;;                                    (k m))
+;;                         (:instance  sumbits-thm 
+;;                                     (n (+ -1  (* 3 m)))
+;;                                     (x y)))
+;;            :do-not-induct t
+;;            :do-not '(fertilize)))
+;;   :rule-classes ())
+
+
+(local-defthmd eta-m-1-lemma
+  (implies (bvecp y (+ -1 (* 3 m)))
+           (equal (bitn y (+ -1 (* 3 m))) 0))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+
+(local-defthmd eta-m-1
+  (implies (bvecp y (+ -1 (* 3 m)))
+           (>= (eta (+ -1 m) y) 0))
+  :hints (("Goal" :in-theory (enable bvecp eta-m-1-lemma))))
+
+(defthm neg-eta-m-1-is-0
+  (implies (bvecp y (+ -1 (* 3 m)))
+           (equal (neg (eta (+ -1 m) y)) 0))
+  :hints (("Goal" :in-theory (enable neg eta-m-1))))
+
+
+(defthm eta-bnd
+  (and (integerp (eta i y))
+       (<= (eta i y) 4)
+       (<= -4 (eta i y))))
+
+
+(defthm booth8-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8-eta x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :hints (("Goal" 
+           :in-theory (disable sum-eta
+                               pp8-eta
+                               bmux8
+                               sum-pp8-eta
+                               pp8-reduce-to-2
+                               pp8-reduce-to-1
+                               bmux8-reduce-to)
+           :do-not-induct t
+           :use ((:functional-instance
+                  booth8-thm
+                  (xi (lambda (i) (eta i y)))
+                  (sum-xi (lambda (m) (sum-eta m y)))
+                  (pp8  (lambda (i x n) (pp8-eta i x y n)))
+                  (sum-pp8  (lambda (x m n) (sum-pp8-eta x y m n))))
+                 (:instance sum-eta-lemma)))
+          ("Subgoal 3" :in-theory (enable sum-eta))
+          ("Subgoal 2" :in-theory (e/d (sum-pp8-eta) (pp8-eta)))
+          ("Subgoal 1" :in-theory (e/d (pp8-eta) (bmux8 bmux8-reduce-to))))
+  :rule-classes ())
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/mult.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/mult.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/mult.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/mult.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,484 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../lib1/add")
+
+(local (include-book "mult-proofs"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta (i y)
+  (+ (bitn y (1- (* 2 i))) 
+     (bitn y (* 2 i))
+     (* -2 (bitn y (1+ (* 2 i))))))
+
+
+(defun sum-theta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta (1- m) y))
+	(sum-theta (1- m) y))))
+
+
+
+(defthm sum-theta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta m y)))
+  :rule-classes ())
+
+
+(defun bmux4 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (lnot x n))
+    (2  (* 2 x))
+    (-2 (lnot (* 2 x) n))
+    (0  0)))
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+
+(defun pp4 (i x n)
+  (if (zerop i)
+      (cat 1 1
+	   (lnot (neg (zeta i)) 1) 1
+	   (bmux4 (zeta i) x n) n)
+    (cat 1 1
+	 (lnot (neg (zeta i)) 1) 1
+	 (bmux4 (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4 (x m n)
+  (if (zp m)
+      0
+    (+ (pp4 (1- m) x n)
+       (sum-pp4 x (1- m) n))))
+
+
+(defthm booth4-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4 x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ())
+
+(defun pp4-theta (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (theta i y)) 1) 1
+	    (bmux4 (theta i y) x n) n)
+     (cat 1 1
+	  (lnot (neg (theta i y)) 1) 1
+	  (bmux4 (theta i y) x n) n
+	  0 1
+	  (neg (theta (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-theta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-theta (1- m) x y n)
+       (sum-pp4-theta x y (1- m) n))))
+
+
+(defthm booth4-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits y (1+ (* 2 i)) (* 2 i)) (chi i y)))
+ 
+ (defun chi (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu (1- i) y) 3)
+	 1
+       0))))
+
+
+(defun phi (i y)
+  (if (= (bits (mu i y) 1 0) 3)
+      -1
+    (bits (mu i y) 1 0)))
+
+(defthm phi-bnd
+    (member (phi i y) '(-1 0 1 2)))
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+
+(defthm chi-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+  :rule-classes())
+
+
+(defthm phi-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi (1- m) y) 0))
+  :rule-classes())
+
+(defun sum-phi (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi (1- m) y))
+	(sum-phi (1- m) y))))
+
+
+(defthm sum-phi-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi m y)))
+  :rule-classes ())
+
+(defun pp4-phi (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (phi i y)) 1) 1
+	    (bmux4 (phi i y) x n) n)
+     (cat 1 1
+	  (lnot (neg (phi i y)) 1) 1
+	  (bmux4 (phi i y) x n) n
+	  0 1
+	  (neg (phi (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-phi (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-phi (1- m) x y n)
+       (sum-pp4-phi x y (1- m) n))))
+
+
+(defthm static-booth
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+
+(defun gamma (i a b c)
+   (if (zp i)
+       (bitn c 0)
+     (lior (bitn  a (+ -1  (* 2 i)))
+ 	   (bitn  b (+ -1  (* 2 i)))
+ 	  1)))
+
+(defun delta (i a b c d)
+  (if (zp i)
+      (bitn d 0)
+    (land (lior (land (bitn a (+ -2 (* 2 i))) 
+                      (bitn b (+ -2 (* 2 i)))
+                      1)
+		(lior (land (bitn a (+ -2 (* 2 i)))
+                            (gamma (1- i) a b c) 
+                            1)
+		      (land (bitn b (+ -2 (* 2 i)))
+                            (gamma (1- i) a b c)
+                            1)
+                      1)
+                1)
+	  (lnot (lxor (bitn a (1- (* 2 i))) 
+                      (bitn b (1- (* 2 i))) 
+                      1) 
+                1)
+	  1)))
+
+
+(defun psi (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits a (1+ (* 2 i)) (* 2 i))
+       (bits b (1+ (* 2 i)) (* 2 i))
+       (gamma i a b c)
+       (delta i a b c d)
+       (* -4 (+ (gamma (1+ i) a b c)
+                (delta (1+ i) a b c d))))))
+
+
+(defthm psi-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))  ;; 
+		  (bvecp b (- (* 2 m) 2))  ;;
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma m a b c) 0)
+		  (equal (delta m a b c d) 0)
+		  (>= (psi (1- m) a b c d) 0)))
+    :hints (("Goal" :in-theory (enable bvecp expt-2-reduce-leading-constant
+                                       expt-weak-monotone-linear)))
+  :rule-classes ())
+
+
+(defun sum-psi (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi (1- m) a b c d))
+	(sum-psi (1- m) a b c d))))
+
+
+(defthm sum-psi-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi m a b c d)))
+  :rule-classes ())
+
+
+
+(defthmd psi-bnd
+  (and (integerp (psi i a b c d))
+       (<= (psi i a b c d) 2)
+       (>= (psi i a b c d) -2)))
+
+(defun pp4-psi (i x a b c d n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (psi i a b c d)) 1) 1
+	    (bmux4 (psi i a b c d) x n) n)
+     (cat 1 1
+	  (lnot (neg (psi i a b c d)) 1) 1
+	  (bmux4 (psi i a b c d) x n) n
+	  0 1
+	  (neg (psi (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-psi (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4-psi (1- m) x a b c d n)
+       (sum-pp4-psi x a b c d (1- m) n))))
+
+
+
+(defthm redundant-booth
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+
+(defun eta (i y)
+  (+ (bitn y (1- (* 3 i))) 
+     (bitn y (* 3 i))
+     (* 2 (bitn y (1+ (* 3 i))))
+     (* -4 (bitn y (+ 2 (* 3 i))))))
+
+
+(defun sum-eta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta (1- m) y))
+	(sum-eta (1- m) y))))
+
+
+(defthm sum-eta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta m y)))
+  :rule-classes ())
+
+
+(defun bmux8 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (lnot x n))
+    (2  (* 2 x))
+    (-2 (lnot (* 2 x) n))
+    (3  (* 3 x))
+    (-3 (lnot (* 3 x) n))
+    (4  (* 4 x))
+    (-4 (lnot (* 4 x) n))
+    (0  0)))
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+
+(defun pp8 (i x n)
+  (if (zerop i)
+      (cat 3 2
+	   (lnot (neg (xi i)) 1) 1
+	   (bmux8 (xi i) x n) n)
+    (cat 3 2
+	 (lnot (neg (xi i)) 1) 1
+	 (bmux8 (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8 (x m n)
+  (if (zp m)
+      0
+    (+ (pp8 (1- m) x n)
+       (sum-pp8 x (1- m) n))))
+
+
+(defthm booth8-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8 x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ())
+
+(defun pp8-eta (i x y n)
+  (if (zerop i)
+      (cat 3 2
+	   (lnot (neg (eta i y)) 1) 1
+	   (bmux8 (eta i y) x n) n)
+    (cat 3 2
+	 (lnot (neg (eta i y)) 1) 1
+	 (bmux8 (eta i y) x n) n
+	 0 2
+	 (neg (eta (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+(defun sum-pp8-eta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8-eta (1- m) x y n)
+       (sum-pp8-eta x y (1- m) n))))
+
+
+(defthm booth8-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8-eta x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/round-extra2.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/round-extra2.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/round-extra2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/round-extra2.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,6519 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+
+
+(include-book "../lib1/top")
+
+(set-inhibit-warnings "theory")
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+;; (defund trunc (x n)
+;;   (declare (xargs :guard (integerp n)))
+;;   (* (sgn x) 
+;;      (fl (* (expt 2 (1- n)) (sig x))) 
+;;      (expt 2 (- (1+ (expo x)) n))))
+
+;; (defthmd trunc-integer-type-prescription
+;;   (implies (and (>= (expo x) n)
+;;                 (case-split (integerp n))
+;;                 )
+;;            (integerp (trunc x n)))
+;;   :rule-classes :type-prescription)
+
+;; (defthmd trunc-rewrite
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (equal (trunc x n)
+;; 		    (* (sgn x) 
+;; 		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+;; 		       (expt 2 (- (1+ (expo x)) n))))))
+
+;; (defthmd abs-trunc
+;;   (equal (abs (trunc x n))
+;;          (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+
+;; (encapsulate ()
+;;   (local 
+;;    (defthm fl-sig-expt-2-lemma-1
+;;      (implies (and (<= n 0)
+;;                    (integerp n))
+;;               (< (* (SIG X) (EXPT 2 (+ -1 N))) 1))
+;;      :hints (("Goal" :in-theory (enable expt-weak-monotone-linear)
+;;               :cases ((not (<= (expt 2 (+ -1 n)) (/ 2)))))
+;;              ("Subgoal 2" 
+;;               :use ((:instance sig-upper-bound)))
+;;              ("Subgoal 1" 
+;;               :use ((:instance expt-weak-monotone-linear
+;;                                (n (+ -1 n))
+;;                                (m -1)))))))
+              
+
+;;   (local 
+;;    (defthm fl-is-0
+;;      (implies (and (rationalp x)
+;;                    (< x 1)
+;;                    (<= 0 x))
+;;               (equal (fl x) 0))
+;;      :rule-classes nil))
+                               
+
+
+;;   (local 
+;;    (defthm fl-sig-expt-2
+;;      (implies (and (<= n 0)
+;;                    (rationalp x)
+;;                    (integerp n))
+;;               (equal (fl (* (SIG X) (EXPT 2 (+ -1 N)))) 0))
+;;      :hints (("Goal" :use ((:instance fl-is-0
+;;                                       (x (* (sig x)
+;;                                             (expt 2 (+ -1 n)))))
+;;                            (:instance sig-lower-bound))))))
+
+
+;;   (defthm trunc-to-0
+;;       (implies (and (rationalp x)
+;;   		  (integerp n)
+;;   		  (<= n 0))
+;;   	     (equal (trunc x n) 0))
+;;       :hints (("Goal" :in-theory (enable trunc)))))
+
+;; ;; moved to trunc.lisp
+;; (defthm trunc-to-0
+;;   (implies (and (rationalp x)
+;;                 (integerp n)
+;;                 (<= n 0))
+;;            (equal (trunc x n) 0))
+;;   :hints (("Goal" :in-theory (enable trunc))))
+
+
+;; (defthmd sgn-trunc
+;;       (implies (and (< 0 n)
+;;                     (rationalp x)
+;;   		  (integerp n))
+;;   	     (equal (sgn (trunc x n))
+;;     		    (sgn x))))
+
+
+(encapsulate ()
+  (local (include-book "../support/trunc"))
+  (set-enforce-redundancy nil)
+  (defthm trunc-to-0
+    (implies (and (integerp n)
+                  (<= n 0))
+             (equal (trunc x n) 0))))
+
+; (set-enforce-redundancy t)
+
+;; (defthm trunc-positive
+;;    (implies (and (< 0 x)
+;;                  (case-split (rationalp x))
+;;                  (case-split (integerp n))
+;;                  (case-split (< 0 n))
+;;                  )
+;;             (< 0 (trunc x n)))
+;;    :rule-classes (:rewrite :linear))
+
+
+;; (defthm trunc-negative
+;;   (implies (and (< x 0)
+;;                 (case-split (rationalp x))
+;;                 (case-split (integerp n))
+;;                 (case-split (< 0 n)))
+;;            (< (trunc x n) 0))
+;;   :rule-classes (:rewrite :linear))
+
+
+;; (defthm trunc-0
+;;   (equal (trunc 0 n) 0))
+
+
+;; (defthmd trunc-minus
+;;   (equal (trunc (* -1 x) n)
+;;          (* -1 (trunc x n))))
+
+
+;; (defthmd trunc-shift
+;;   (implies (integerp n)
+;;            (equal (trunc (* x (expt 2 k)) n)
+;;                   (* (trunc x n) (expt 2 k)))))
+
+
+;; (defthmd trunc-upper-bound
+;;     (implies (and (rationalp x)
+;; 		  (integerp n))
+;; 	     (<= (abs (trunc x n)) (abs x)))
+;;   :rule-classes :linear)
+
+;; (defthmd trunc-upper-pos
+;;     (implies (and (<= 0 x)
+;;                   (rationalp x)
+;; 		  (integerp n))
+;; 	     (<= (trunc x n) x))
+;;   :rule-classes :linear)
+
+
+;; (defthm expo-trunc
+;;     (implies (and (< 0 n)
+;;                   (rationalp x)
+;; 		  (integerp n))
+;; 	     (equal (expo (trunc x n))
+;;                     (expo x))))
+
+
+;; (defthm expo-trunc-strong
+;;     (implies (and (nat n)
+;;                   (rationalp x)
+;; 		  (integerp n))
+;; 	     (equal (expo (trunc x n))
+;;                     (expo x))))
+;;; wrong
+;;;
+(set-enforce-redundancy nil)
+
+(encapsulate () 
+ (local (include-book "../support/trunc"))
+ (defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+    :hints (("Goal" :by trunc-lower-1))
+    :rule-classes (:linear))
+
+ (defthmd trunc-lower-2
+   (implies (and (rationalp x)
+                 (not (= x 0))
+                 (integerp n)
+                 (> n 0))
+            (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+   :rule-classes :linear)
+
+ (defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear
+  :hints (("Goal" :by trunc-lower-pos))))
+
+;; moved into trunc.lisp ?? 
+ 
+
+;----------------------------------------------------------------------
+
+;; (defthm trunc-diff
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;;                   (> n 0))
+;; 	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+;;   :rule-classes ())
+
+;; (defthm trunc-diff-pos
+;;     (implies (and (rationalp x)
+;; 		  (>= x 0)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+;;   :rule-classes ())
+
+
+;; (defthm trunc-exactp-a
+;;   (exactp (trunc x n) n)
+;;   :hints (("Goal" :use ((:instance trunc-exactp-b---rtl-rel5-support)))))
+
+
+;; (defthm trunc-diff-expo
+;;     (implies (and (rationalp x)
+;; 		  (not (exactp x n))
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+;;   :rule-classes ())
+
+
+;; (defthm trunc-exactp-b
+;;     (implies (and (rationalp x)
+;; 		  (integerp n) 
+;; 		  (> n 0))
+;; 	     (iff (= x (trunc x n))
+;; 		  (exactp x n)))
+;;   :hints (("Goal" :use ((:instance trunc-exactp-a---rtl-rel5-support))))
+;;   :rule-classes ())
+
+
+;; (defthmd trunc-exactp-c
+;;     (implies (and (exactp a n)
+;; 		  (<= a x)
+;;                   (rationalp x)
+;; 		  (integerp n)
+;; 		  (rationalp a))
+;; 	     (<= a (trunc x n))))
+
+
+;; (defthmd trunc-monotone
+;;   (implies (and (<= x y)
+;;                 (rationalp x)
+;;                 (rationalp y)
+;;                 (integerp n))
+;;            (<= (trunc x n) (trunc y n)))
+;;   :rule-classes :linear)
+
+;----------------------------------------------------------------------
+
+
+;; (defthm trunc-diff
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;;                   (> n 0))
+;; 	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+;;   :rule-classes ())
+
+;; (defthm exactp-diff-cor
+;;     (implies (and (rationalp x)
+;; 		  (rationalp y)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (exactp x n)
+;; 		  (exactp y n)
+;; 		  (<= (abs (- x y)) (abs x))
+;; 		  (<= (abs (- x y)) (abs y)))
+;; 	     (exactp (- x y) n))
+;;   :rule-classes ())
+
+
+(encapsulate () 
+  (local (include-book "../../arithmetic/basic"))
+  (local 
+  (defthm not-exact-strictly-greater-than
+    (implies (and (rationalp x)
+                  (not (exactp x n))
+                  (integerp n)
+                  (> n 0)
+                  (> x 0))
+             (> x (expt 2 (expo x))))
+    :hints (("Goal" :in-theory (enable exactp-2**n)
+             :cases ((= x (expt 2 (expo x)))))
+            ("Subgoal 2" :use ((:instance expo-lower-bound))))))
+
+  ;; (defthm fp+2
+  ;;     (implies (and (rationalp x)
+  ;; 		  (> x 0)
+  ;; 		  (rationalp y)
+  ;; 		  (> y x)
+  ;; 		  (integerp n)
+  ;; 		  (> n 0)
+  ;; 		  (exactp x n)
+  ;; 		  (exactp y n))
+  ;; 	     (>= y (fp+ x n)))
+  ;;   :rule-classes ())
+
+             
+  (local 
+  (defthm strictly-greater-than-implies-no-less-than-fp+
+    (implies (and (rationalp x)
+                  (exactp x (1+ n))
+                  (> x (expt 2 (expo x)))
+                  (integerp n)
+                  (> n 0))
+            (>= x (+ (expt 2 (expo x))
+                     (expt 2 (- (EXPO X) N)))))
+    :hints (("Goal" :in-theory (enable exactp-2**n)
+             :use ((:instance fp+2 
+                              (x (expt 2 (expo x)))
+                              (y x)
+                              (n (1+ n))))))))
+
+  ;; (defthmd expo-monotone
+  ;;   (implies (and (<= (abs x) (abs y))
+  ;;                 (case-split (rationalp x))
+  ;;                 (case-split (not (equal x 0)))
+  ;;                 (case-split (rationalp y)))
+  ;;            (<= (expo x) (expo y)))
+  ;;   :rule-classes :linear)
+
+  (local 
+   (defthm expo-of-x-minus-extra-bit-is-expo-x
+     (implies (and (exactp x (1+ n))
+                   (not (exactp x n))
+                   (rationalp x)
+                   (integerp n)
+                   (> x 0)
+                   (> n 0))
+              (equal (expo (+  x (* -1 (expt 2 (+ (expo x) (* -1 n))))))
+                     (expo x)))
+     :hints (("Goal" :in-theory (enable exactp-2**n)
+              :use ((:instance expo-monotone
+                               (x (- x (expt 2 (- (expo x) n))))
+                               (y x))
+                    (:instance expo-monotone
+                               (x (expt 2 (expo x)))
+                               (y (- x (expt 2 (- (expo x) n)))))
+                    (:instance strictly-greater-than-implies-no-less-than-fp+))))))
+
+   ;; next we want to prove (- x (expt 2 (- (exp x) n))) is exactp  n
+
+  (local 
+   (encapsulate ()
+                (local (include-book "../../arithmetic/even-odd"))
+                (defthm integerp-x-not-1/2x-lemma
+                  (implies (and (integerp x)
+                                (not (integerp (* x (/ 2)))))
+                           (integerp (+ (* x (/ 2)) (* -1 (/ 2))))))))
+   
+   ;; may need some rule to merge 1/2 into expt 2 
+   (local 
+    (defthm merged-1/2-into-expt2
+      (implies (and (integerp n)
+                    (rationalp x))
+               (equal (* 1/2 x (expt 2 n))
+                      (* x (expt 2 (+ -1 n)))))
+      :hints (("Goal" 
+               :use ((:instance a15 
+                                (i 2)
+                                (j1 -1)
+                                (j2 n)))))))
+
+
+   (local 
+    (defthm a-is-n-exact
+     (implies (and (not (exactp x n))
+                   (exactp x (1+ n))
+                   (> x 0)
+                   (rationalp x)
+                   (integerp n)
+                   (> n 0))
+              (exactp (+ x (* -1 (expt 2 (+ (expo x) (* -1 n)))))
+                      n))
+     :hints (("Goal" :in-theory (enable exactp2 a15)
+              :use ((:instance integerp-x-not-1/2x-lemma
+                               (x (* X (EXPT 2 (+ N (* -1 (EXPO X))))))))))))
+                      
+   ;; (defthm fp+1
+   ;;     (implies (and (rationalp x)
+   ;; 		  (> x 0)
+   ;; 		  (integerp n)
+   ;; 		  (> n 0)
+   ;; 		  (exactp x n))
+   ;; 	     (exactp (fp+ x n) n))
+   ;;   :rule-classes ())
+
+
+   ;; (local 
+   ;; (defthm not-exact-strictly-greater-than
+   ;;   (implies (and (rationalp x)
+   ;;                 (not (exactp x n))
+   ;;                 (integerp n)
+   ;;                 (> n 0)
+   ;;                 (> x 0))
+   ;;            (> x (expt 2 (expo x))))
+   ;;   :hints (("Goal" :in-theory (enable exactp-2**n)
+   ;;            :cases ((= x (expt 2 (expo x)))))
+   ;;           ("Subgoal 2" :use ((:instance expo-lower-bound))))))
+
+
+   (local 
+    (defthm expt-2-minus-half
+      (implies (integerp n)
+               (equal (+ (EXPT 2 (+ 1 n))
+                         (* -1 (EXPT 2 n)))
+                      (expt 2 n)))
+      :hints (("Goal" 
+               :use ((:instance a15 
+                                (i 2)
+                                (j1 1)
+                                (j2 n)))))))
+
+  ;;; lots of stupid lemmas!!  
+
+   (local 
+    (defthm b-is-n-exact
+      (implies (and (not (exactp x n))
+                    (exactp x (1+ n))
+                    (> x 0)
+                    (rationalp x)
+                    (integerp n)
+                    (> n 0))
+               (exactp (+ x (expt 2 (+ (expo x) (* -1 n)))) n))
+      :hints (("Goal" 
+               :use ((:instance a-is-n-exact)
+                     (:instance expo-lower-bound)
+                     (:instance expt-strong-monotone-linear
+                                (m (expo x))
+                                (n (+ (expo x) (* -1 n))))
+                     (:instance fp+1 
+                                (x (- x (expt 2 (+ (expo x) (* -1 n)))))))))))
+
+  ;; (defthmd trunc-exactp-c
+  ;;     (implies (and (exactp a n)
+  ;; 		  (<= a x)
+  ;;                   (rationalp x)
+  ;; 		  (integerp n)
+  ;; 		  (rationalp a))
+  ;; 	     (<= a (trunc x n))))
+
+   (local 
+    (defthm trunc-midpoint-lemma
+      (implies (and (> n 0)
+                    (integerp n)
+                    (rationalp x) (> x 0)
+                    (exactp x (1+ n))
+                    (not (exactp x n)))
+               (= (- x (expt 2 (- (expo x) n)))
+                  (trunc x n)))
+      :hints (("Goal" :in-theory (enable trunc-upper-pos)
+               :cases ((< (- x (expt 2 (- (expo x) n))) (trunc x n))))
+              ("Subgoal 2" :use ((:instance trunc-exactp-c
+                                            (a (- x (expt 2 (- (expo x) n)))))))
+              ("Subgoal 1" :use ((:instance fp+2
+                                            (y (trunc x n))
+                                            (x (- x (expt 2 (- (expo x) n)))))
+                                 (:instance expo-lower-bound)
+                                 (:instance expt-strong-monotone-linear
+                                            (m (expo x))
+                                            (n (+ (expo x) (* -1 n)))))))
+      :rule-classes ()))
+
+   ;; (defthmd sig-lower-bound
+   ;;   (implies (and (rationalp x)
+   ;;                 (not (equal x 0)))
+   ;;            (<= 1 (sig x)))
+   ;;   :rule-classes (:rewrite :linear))
+
+
+   ;; (defthmd sig-upper-bound
+   ;;   (< (sig x) 2)
+   ;;   :rule-classes (:rewrite :linear))
+
+
+
+   (local 
+    (defthm sig-x-integerp
+      (implies (and (integerp (sig x))
+                    (rationalp x)
+                    (< 0 x))
+               (equal (sig x) 1))
+      :hints (("Goal" :in-theory (enable sig-lower-bound
+                                         sig-upper-bound)))))
+                      
+
+
+   ;;; The following are exported!!! 
+   ;;; Thu Oct 12 13:57:55 2006
+
+   (defthm trunc-midpoint
+     (implies (and (natp n)
+                   (rationalp x) (> x 0)
+                   (exactp x (1+ n))
+                   (not (exactp x n)))
+              (= (- x (expt 2 (- (expo x) n)))
+                 (trunc x n)))
+     :hints (("Goal" :cases ((equal n 0)))
+             ("Subgoal 2" :use ((:instance trunc-midpoint-lemma)))
+             ("Subgoal 1" :in-theory (enable exactp sgn trunc)
+              :use ((:instance fp-rep (x x)))))
+     :rule-classes ())
+
+
+   (defthm expo-of-x-minus-extra-bit-is-expo-x
+     (implies (and (exactp x (1+ n))
+                   (not (exactp x n))
+                   (rationalp x)
+                   (integerp n)
+                   (> x 0)
+                   (> n 0))
+              (equal (expo (+  x (* -1 (expt 2 (+ (expo x) (* -1 n))))))
+                     (expo x))))
+
+
+
+   (defthm a-is-n-exact
+     (implies (and (not (exactp x n))
+                   (exactp x (1+ n))
+                   (> x 0)
+                   (rationalp x)
+                   (integerp n)
+                   (> n 0))
+              (exactp (+ x (* -1 (expt 2 (+ (expo x) (* -1 n)))))
+                      n)))
+
+
+
+   (defthm b-is-n-exact
+     (implies (and (not (exactp x n))
+                   (exactp x (1+ n))
+                   (> x 0)
+                   (rationalp x)
+                   (integerp n)
+                   (> n 0))
+              (exactp (+ x (expt 2 (+ (expo x) (* -1 n))))
+                      n)))
+
+
+     )
+
+;; TODO: consider move this to trunc.lisp and trunc-proofs.lisp
+;; Thu Oct 12 09:28:40 2006
+
+
+;----------------------------------------------------------------------
+
+;; (defthmd trunc-trunc
+;;     (implies (and (>= n m)
+;;                   (integerp n)
+;; 		  (integerp m))
+;; 	     (equal (trunc (trunc x n) m)
+;; 		    (trunc x m))))
+
+
+;; (defthm plus-trunc
+;;     (implies (and (rationalp x)
+;; 		  (>= x 0)
+;; 		  (rationalp y)
+;; 		  (>= y 0)
+;; 		  (integerp k)
+;; 		  (exactp x (+ k (- (expo x) (expo y)))))
+;; 	     (= (+ x (trunc y k))
+;; 		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+;;   :rule-classes ())
+
+;----------------------------------------------------------------------
+
+;;(i-am-here)
+(encapsulate () 
+  (local 
+   (defthm minus-trunc-1-lemma
+     (implies (and (rationalp x)
+                   (> x 0)
+                  (rationalp y)
+                  (> y 0)
+                  (< x y)
+                  (integerp k)
+                  (> k 0)
+                  (> (+ k (- (expo (- x y)) (expo y))) 0)
+                  (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                  (exactp x (+ k (- (expo x) (expo y)))))
+             (equal (- x (trunc y k))
+                    (trunc (- x y) (+ k (- (expo (- x y)) (expo y))))))
+    :hints (("Goal" :in-theory (enable trunc-rewrite exactp2 sgn a15)
+             :use ((:instance fl+int-rewrite
+                              (x (* Y (EXPT 2 (+ -1 K (* -1 (EXPO Y))))))
+                              (n (* -1 X (EXPT 2 (+ -1 K (* -1 (EXPO Y))))))))))))
+
+
+  (defthm minus-trunc-1
+    (implies (and (rationalp x)
+                  (> x 0)
+                  (rationalp y)
+                  (> y 0)
+                  (< x y)
+                  (integerp k)
+                  (> k 0)
+                  (> (+ k (- (expo (- x y)) (expo y))) 0)
+                  (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                  (exactp x (+ k (- (expo x) (expo y)))))
+             (equal (- x (trunc y k))
+                    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+    :hints (("Goal" :use ((:instance trunc-minus
+                                     (x (- x y))
+                                     (n (+ k (- (expo (- x y)) (expo y)))))
+                          (:instance minus-trunc-1-lemma))))
+    :rule-classes nil)
+                                      
+
+)
+
+;----------------------------------------------------------------------
+
+;; (defthm bits-trunc
+;;   (implies (and (= n (1+ (expo x)))
+;;                 (>= x 0)
+;;                 (integerp k)
+;;                 (> k 0))
+;;            (= (trunc x k)
+;;               (* (expt 2 (- n k))
+;;                  (bits x (1- n) (- n k)))))
+;;   :hints (("Goal" :use ((:instance bits-trunc-2---rtl-rel5-support))))
+;;   :rule-classes ())
+
+
+;; (defthm trunc-land
+;;     (implies (and (>= x (expt 2 (1- n)))
+;; 		  (< x (expt 2 n))
+;;                   (integerp x) (> x 0)
+;; 		  (integerp m) (>= m n)
+;; 		  (integerp n) (> n k)
+;; 		  (integerp k) (> k 0))
+;; 	     (= (trunc x k)
+;; 		(land x (- (expt 2 m) (expt 2 (- n k))) n)))
+;;     :hints (("Goal" :use ((:instance bits-trunc-
+;;   :rule-classes ())
+
+;;
+;; make change directly into rel5/lib/round.lisp, rel5/support/lextra.lisp
+;; 
+
+;; (defthmd trunc-split
+;;   (implies (and (= n (1+ (expo x)))
+;;                 (>= x 0)
+;;                 (integerp m)
+;;                 (> m k)
+;;                 (integerp k)
+;;                 (> k 0))
+;;            (equal (trunc x m)
+;;                   (+ (trunc x k)
+;;                      (* (expt 2 (- n m))
+;;                         (bits x (1- (- n k)) (- n m)))))))
+
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+
+;; (defund away (x n)
+;;   (* (sgn x) 
+;;      (cg (* (expt 2 (1- n)) (sig x))) 
+;;      (expt 2 (- (1+ (expo x)) n))))
+
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :hints (("Goal" :in-theory (enable away)))
+  :rule-classes :type-prescription)
+
+;; (defthmd away-rewrite
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (equal (away x n)
+;; 		    (* (sgn x) 
+;; 		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+;; 		       (expt 2 (- (1+ (expo x)) n))))))
+
+
+;; (defthmd abs-away
+;;     (implies (and (rationalp x)
+;; 		  (integerp n))
+;; 	     (equal (abs (away x n)) 
+;; 		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+;;; this is true?? 
+
+;; ;; (local 
+;; ;;  (defthm fl-sig-is-minus-1
+;; ;;    (implies (and (rationalp x)
+;; ;;                  (not (equal x 0)))
+;; ;;             (equal (FL (* -1/2 (SIG X)))
+;; ;;                    -1))
+;; ;;    :hints (("Goal" 
+;; ;;             :in-theory (enable fl-minus)
+;; ;;             :use ((:instance sig-upper-bound)
+;; ;;                   (:instance sig-lower-bound))))))
+
+
+
+(encapsulate () 
+   (local (include-book "../support/away"))
+   (defthm away-to-0
+     (implies (and (<= n 0)
+                   (rationalp x)
+                   (integerp n)
+                   )
+              (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n))))))
+     :hints (("Goal" :by  away-to-0-or-fewer-bits))))
+
+
+
+
+;;    (defthm away-to-0
+;;      (implies (and (rationalp x) (not (= x 0)))
+;;               (equal (away x 0)
+;;                      (* (sgn x) (expt 2 (1+ (expo x))))))
+;; 
+;; druss this is what you wrote in the  lemma
+
+
+
+;; (defthmd sgn-away
+;;   (equal (sgn (away x n))
+;;          (sgn x)))
+
+;; (defthm away-positive
+;;   (implies (and (< 0 x)
+;;                 (case-split (rationalp x))
+;;                 )
+;;            (< 0 (away x n)))
+;;   :rule-classes (:rewrite :linear))
+
+;; (defthm away-negative
+;;     (implies (and (< x 0)
+;;                   (case-split (rationalp x))
+;;                   )
+;; 	     (< (away x n) 0))
+;;     :rule-classes (:rewrite :linear))
+
+;; (defthm away-0
+;;   (equal (away 0 n) 0))
+
+
+;; (defthmd away-minus
+;;   (= (away (* -1 x) n) (* -1 (away x n))))
+
+
+;; (defthmd away-shift
+;;     (implies (integerp n)
+;; 	     (= (away (* x (expt 2 k)) n)
+;; 		(* (away x n) (expt 2 k)))))
+
+
+;; (defthmd away-lower-bound
+;;     (implies (and (case-split (rationalp x))
+;; 		  (case-split (integerp n)))
+;; 	     (>= (abs (away x n)) (abs x)))
+;;   :rule-classes :linear)
+
+;; (defthmd away-lower-pos
+;;     (implies (and (>= x 0)
+;;                   (case-split (rationalp x))
+;; 		  (case-split (integerp n)))
+;; 	     (>= (away x n) x))
+;;   :rule-classes :linear)
+
+
+;; ;----------------------------------------------------------------------
+
+(defthmd away-upper-bound
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0))
+           (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :hints (("Goal" :use away-upper-1))
+  :rule-classes :linear)
+
+;; ;----------------------------------------------------------------------
+
+;; (defthmd away-upper-2
+;;     (implies (and (rationalp x)
+;; 		  (not (= x 0))
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+;;   :rule-classes :linear)
+
+
+;; (defthmd away-diff
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+;;   :rule-classes :linear)
+
+;; (defthmd away-diff-pos
+;;     (implies (and (rationalp x)
+;; 		  (>= x 0)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+;;   :rule-classes :linear)
+
+;; ;; (defthm away-exactp-d
+;; ;;     (implies (and (rationalp x)
+;; ;; 		  (not (= x 0))
+;; ;; 		  (integerp n)
+;; ;; 		  (> n 0))
+;; ;; 	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+;; ;;   :rule-classes ())
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+    :hints (("Goal" 
+             :cases ((equal n 0)))
+            ("Subgoal 2" :use ((:instance away-exactp-d)))
+            ("Subgoal 1" :in-theory (enable abs away sgn natp)))
+  :rule-classes ())
+;; why not :linear? 
+
+;; (defthmd expo-away-lower-bound
+;;     (implies (and (rationalp x)
+;; 		  (natp n))
+;; 	     (>= (expo (away x n)) (expo x)))
+;;     :hints (("Goal" :cases ((equal n 0)))
+;;             ("Subgoal 2" :use ((:instance
+;;                                 expo-away-lower-bound---rtl-rel5-support)))
+;;             ("Subgoal 1" :cases ((equal x 0))
+;;              :in-theory (enable sgn))
+;;             ("Subgoal 1.2" :use ((:instance expo-prod-lower
+;;                                             (x (sgn x))
+;;                                             (y (expt 2 (+ 1 (expo x))))))))
+;;     :rule-classes (:linear))
+
+;; included in round.lisp already. 
+;; Thu Oct 12 10:15:13 2006. Fixed (and (integerp n) (> n 0)) into (natp n)
+
+
+(encapsulate () 
+ (local 
+ (defthm away-x-zero-implies-zero
+   (implies (rationalp x)
+            (equal (equal (away x n) 0)
+                   (equal x 0)))
+   :hints (("Goal" :cases ((< 0 x)
+                           (< x 0)
+                           (equal x 0))))))
+
+ (defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+    :hints (("Goal" :in-theory (enable expo-monotone)
+             :cases ((equal x 0)))
+            ("Subgoal 2" 
+             :use ((:instance away-expo-upper)
+                   (:instance expo-monotone
+                              (x (away x n))
+                              (y (expt 2 (+ 1 (expo x)))))
+                   (:instance expo-monotone
+                              (x (* -1 (away x n)))
+                              (y (expt 2 (+ 1 (expo x))))))))
+  :rule-classes :linear))
+
+;;
+;; TODO: refactor into away.lisp!!! 
+;; Thu Oct 12 10:17:09 2006
+
+
+;; (defthm expo-away
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (away x n))
+;;                     (expo x)))
+;;     :hints (("Goal" :cases ((equal x 0) (< x 0) (> x 0)))
+;;             ("Subgoal 2" :in-theory (enable sgn)
+;;              :use ((:instance expo-away---rtl-rel5-support)))
+;;             ("Subgoal 1" :in-theory (enable sgn)
+;;              :use ((:instance expo-away---rtl-rel5-support)))))
+
+
+;; (defthm away-exactp-a
+;;     (implies (case-split (< 0 n))
+;; 	     (exactp (away x n) n))
+;;     :hints (("Goal" :use ((:instance away-exactp-b---rtl-rel5-support)))))
+
+
+;; (defthmd away-diff-expo
+;;     (implies (and (rationalp x)
+;; 		  (not (exactp x n))
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+;;   :rule-classes :linear)
+
+
+;; (defthm away-exactp-b
+;;     (implies (and (rationalp x)
+;; 		  (integerp n) 
+;; 		  (> n 0))
+;; 	     (iff (= x (away x n))
+;; 		  (exactp x n)))
+;;     :hints (("Goal" :use ((:instance away-exactp-a---rtl-rel5-support))))
+;;   :rule-classes ())
+
+;; (defthmd away-exactp-c
+;;     (implies (and (exactp a n)
+;; 		  (>= a x)
+;;                   (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  )
+;; 	     (>= a (away x n))))
+
+;; (defthmd away-exactp-c
+;;     (implies (and (exactp a n)
+;; 		  (>= a x)
+;;                   (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a))
+;; 	     (>= a (away x n))))
+
+
+;; (defthmd away-monotone
+;;     (implies (and (rationalp x)
+;; 		  (rationalp y)
+;; 		  (integerp n)
+;; 		  (<= x y))
+;; 	     (<= (away x n) (away y n)))
+;;   :rule-classes :linear)
+
+
+;; (defthm trunc-away
+;;     (implies (and (rationalp x) (> x 0)
+;; 		  (integerp n) (> n 0)
+;; 		  (not (exactp x n)))
+;; 	     (= (away x n)
+;; 		(+ (trunc x n)
+;; 		   (expt 2 (+ (expo x) 1 (- n))))))		
+;;   :rule-classes ())
+
+;----------------------------------------------------------------------
+
+(encapsulate () 
+
+   (local 
+    (defthm local-expt-expand
+      (implies (integerp n)
+               (equal (EXPT 2 (+ 1 n))
+                      (* 2 (expt 2 n))))
+      :hints (("Goal" :use ((:instance a15
+                                       (i 2)
+                                       (j1 1)
+                                       (j2 n)))))))
+
+   (local 
+    (defthm away-midpoint-lemma
+      (implies (and (> n 0)
+                    (integerp n)
+                    (rationalp x) (> x 0)
+                    (exactp x (1+ n))
+                    (not (exactp x n)))
+               (= (+ x (expt 2 (- (expo x) n)))
+                  (away x n)))
+      :hints (("Goal" :in-theory (enable a15)
+               :use ((:instance trunc-away)
+                     (:instance trunc-midpoint)
+                     (:instance local-expt-expand
+                                (n (expt 2 (+ (expo x) (* -1 n))))))))
+      :rule-classes ()))
+
+
+   (local 
+    (defthm sig-x-integerp
+      (implies (and (integerp (sig x))
+                    (rationalp x)
+                    (< 0 x))
+               (equal (sig x) 1))
+      :hints (("Goal" :in-theory (enable sig-lower-bound
+                                         sig-upper-bound)))))
+
+   (defthm away-midpoint
+     (implies (and (natp n)
+                   (rationalp x) (> x 0)
+                   (exactp x (1+ n))
+                   (not (exactp x n)))
+               (= (away x n)
+                  (+ x (expt 2 (- (expo x) n)))))
+     :hints (("Goal" :cases ((equal n 0)))
+             ("Subgoal 2" :use away-midpoint-lemma)
+             ("Subgoal 1" :in-theory (enable exactp sgn)
+              :use ((:instance fp-rep (x x)))))
+      :rule-classes ())
+
+)
+;----------------------------------------------------------------------
+
+;; (defthmd away-away
+;;     (implies (and (rationalp x)
+;; 		  (>= x 0)
+;; 		  (integerp n)
+;; 		  (integerp m)
+;; 		  (> m 0)
+;; 		  (>= n m))
+;; 	     (equal (away (away x n) m)
+;; 		    (away x m))))
+
+
+;; (defthm plus-away
+;;   (implies (and (exactp x (+ k (- (expo x) (expo y))))
+;;                 (rationalp x)
+;;                 (>= x 0)
+;;                 (rationalp y)
+;;                 (>= y 0)
+;;                 (integerp k))
+;;            (= (+ x (away y k))
+;;               (away (+ x y)
+;;                     (+ k (- (expo (+ x y)) (expo y))))))
+;;   :rule-classes ())
+
+;----------------------------------------------------------------------
+
+
+
+;; (defthm minus-trunc-1
+;;   (implies (and (rationalp x)
+;;                 (> x 0)
+;;                 (rationalp y)
+;;                 (> y 0)
+;;                 (< x y)
+;;                 (integerp k)
+;;                 (> k 0)
+;;                 (> (+ k (- (expo (- x y)) (expo y))) 0)
+;;                 (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+;;                 (exactp x (+ k (- (expo x) (expo y)))))
+;;            (equal (- x (trunc y k))
+;;                   (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+;;   :hints (("Goal" :use ((:instance trunc-minus
+;;                                    (x (- x y))
+;;                                    (n (+ k (- (expo (- x y)) (expo y)))))
+;;                         (:instance minus-trunc-1-lemma)))))
+                                    
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :hints (("Goal" :in-theory (enable away-rewrite trunc-rewrite cg exactp2 sgn
+                                     a15)))
+  :rule-classes ())
+
+;----------------------------------------------------------------------
+
+(encapsulate () 
+ 
+  (local 
+   (defthm trunc-minus-specific
+     (equal (TRUNC (+ (* -1 X) (* -1 Y)) n)
+            (* -1 (trunc (+ x y) n)))
+     :hints (("Goal" :use ((:instance  trunc-minus
+                                       (x (+ (* -1 x)
+                                             (* -1 y)))))))))
+                   
+  (local 
+   (defthm expo-minus-specific
+     (equal (EXPO (+ (* -1 X) (* -1 Y)))
+            (expo (+ x y)))
+     :hints (("Goal" :use ((:instance  expo-minus
+                                       (x (+ (* -1 x)
+                                             (* -1 y)))))))))
+
+  (local 
+   (defthm away-minus-specific
+     (equal (away (+ (* -1 X) (* -1 Y)) n)
+            (* -1 (away (+ x y) n)))
+     :hints (("Goal" :use ((:instance  away-minus
+                                       (x (+ (* -1 x)
+                                             (* -1 y)))))))))
+
+
+  (local 
+   (defthm trunc-plus-minus-lemmma
+     (implies (and (rationalp x)
+                   (rationalp y)
+                   (> x 0)
+                   (not (= y 0))
+                   (not (= (+ x y) 0))
+                   (integerp k)
+                   (> k 0)
+                   (= k1 (+ k (- (expo x) (expo y))))
+                   (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                   (exactp x k1)
+                   (> k2 0))
+              (equal (+ x (trunc y k))
+                     (if (= (sgn (+ x y)) (sgn y))
+                         (trunc (+ x y) k2)
+                       (away (+ x y) k2))))
+     :hints (("Goal" :cases ((< y 0))
+              :in-theory (enable sgn trunc-minus away-minus expo-minus))
+             ("Subgoal 2" :use ((:instance plus-trunc)))
+             ("Subgoal 1" :cases ((< (* -1 y) x)))
+             ("Subgoal 1.2" :use ((:instance minus-trunc-1
+                                             (y (* -1 y))
+                                             (n k1))))
+             ("Subgoal 1.1" :use ((:instance minus-trunc-2
+                                             (y (* -1 y))
+                                             (n k1)))))))
+
+  (defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ()
+    :hints (("Goal" :cases ((not (< 0 x)))
+             :in-theory (enable sgn trunc-minus away-minus expo-minus))
+            ("Subgoal 2" :use ((:instance trunc-plus-minus-lemmma)))
+            ("Subgoal 1" :use ((:instance trunc-plus-minus-lemmma
+                                          (x (* -1 x))
+                                          (y (* -1 y)))))))
+
+)
+
+;; (defthm away-imp
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (integerp m)
+;; 		  (>= m n)
+;; 		  (exactp x m))
+;; 	     (= (away x n)
+;; 		(trunc (+ x
+;; 			  (expt 2 (- (1+ (expo x)) n))
+;; 			  (- (expt 2 (- (1+ (expo x)) m))))
+;; 		       n)))
+;;   :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+;; (defun re (x)
+;;   (- x (fl x)))
+
+
+;; (defund near (x n)
+;;   (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+;; 	(f (re (* (expt 2 (1- n)) (sig x)))))
+;;     (if (< f 1/2)
+;; 	(trunc x n)
+;;       (if (> f 1/2)
+;; 	  (away x n)
+;; 	(if (evenp z)
+;; 	    (trunc x n)
+;; 	  (away x n))))))
+
+
+;; (defthm near-choice
+;;     (or (= (near x n) (trunc x n))
+;; 	(= (near x n) (away x n)))
+;;   :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x)))
+    :hints (("Goal" :in-theory (enable sgn-near-2))))
+
+;; probably want to disable sgn-near in support/near.lisp    
+;; this is what originall is sgn-near-2 in the rel5
+
+;; ;; (defthm near-pos
+;; ;;     (implies (and (< 0 x)
+;; ;;                   (< 0 n)
+;; ;;                   (rationalp x)
+;; ;; 		  (integerp n))
+;; ;; 	     (< 0 (near x n)))
+;; ;;   :rule-classes (:TYPE-PRESCRIPTION :LINEAR))
+
+;; ;; (defthmd near-neg
+;; ;;   (implies (and (< x 0)
+;; ;;                 (< 0 n)
+;; ;;                 (rationalp x)
+;; ;;                 (integerp n)
+;; ;; 		)
+;; ;;            (< (near x n) 0))
+;; ;;   :rule-classes (:TYPE-PRESCRIPTION :LINEAR))
+
+;; ;; (defthm near-0
+;; ;;   (equal (near 0 n) 
+;; ;;          0))
+
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+    :hints (("Goal" :by near-pos))
+    :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :hints (("Goal" :in-theory (enable near-neg)))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+   (equal (near 0 n) 
+          0))
+
+
+;; (defthm near-exactp-a
+;;     (implies (< 0 n)
+;; 	     (exactp (near x n) n))
+;;     :hints (("Goal" :use ((:instance near-exactp-b---rtl-rel5-support)))))
+
+
+;; (defthm near-exactp-b
+;;     (implies (and (rationalp x)
+;; 		  (integerp n) 
+;; 		  (> n 0))
+;; 	     (iff (= x (near x n))
+;; 		  (exactp x n)))
+;;     :hints (("Goal" :use ((:instance near-exactp-a---rtl-rel5-support))))
+;;   :rule-classes ())
+
+
+;; (encapsulate () 
+
+;;  (local 
+;;   (defthmd near-minus
+;;     (equal (near (* -1 x) n)
+;;            (* -1 (near x n)))))
+
+;;   (local
+;;    (defthmd near-exactp-c-lemma
+;;        (implies (and (exactp a n)
+;;                      (> x 0)
+;;    		  (>= a x)
+;;                      (rationalp x)
+;;    		  (integerp n)
+;;    		  (> n 0)
+;;    		  (rationalp a)
+;;    		  )
+;;    	     (>= a (near x n)))
+;;        :hints (("Goal" 
+;;                 :use ((:instance near-exactp-c---rtl-rel5-support))))))
+
+;;   (local 
+;;    (defthmd near-exactp-d-lemma
+;;        (implies (and (rationalp x)
+;;                      (> x 0)
+;;    		  (integerp n)
+;;    		  (> n 0)
+;;    		  (rationalp a)
+;;    		  (exactp a n)
+;;    		  (<= a x))
+;;    	     (<= a (near x n)))
+;;        :hints (("Goal" 
+;;                 :use ((:instance near-exactp-d---rtl-rel5-support))))))
+      
+
+;;   (defthmd near-exactp-c
+;;       (implies (and (exactp a n)
+;;   		  (>= a x)
+;;                     (rationalp x)
+;;   		  (integerp n)
+;;   		  (> n 0)
+;;   		  (rationalp a)
+;;   		  )
+;;   	     (>= a (near x n)))
+;;       :hints (("Goal" :cases ((< x 0))
+;;                :in-theory (enable near-minus))
+;;               ("Subgoal 2" :use ((:instance near-exactp-c-lemma)))
+;;               ("Subgoal 1" :use ((:instance near-exactp-d-lemma
+;;                                             (x (* -1 x))
+;;                                             (a (* -1 a)))))))
+              
+
+               
+
+;;   (defthmd near-exactp-d
+;;       (implies (and (rationalp x)
+;;   		  (integerp n)
+;;   		  (> n 0)
+;;   		  (rationalp a)
+;;   		  (exactp a n)
+;;   		  (<= a x))
+;;   	     (<= a (near x n)))
+;;       :hints (("Goal" :cases ((< x 0))
+;;                :in-theory (enable near-minus))
+;;               ("Subgoal 2" :use ((:instance near-exactp-d-lemma)))
+;;               ("Subgoal 1" :use ((:instance near-exactp-c-lemma
+;;                                             (x (* -1 x))
+;;                                             (a (* -1 a)))))))
+
+;; )
+
+
+
+;; (defthm expo-trunc-strong
+;;      (implies (and (natp n)
+;;                    (rationalp x)
+;;                    (not (= (abs (trunc x n)) (expt 2 (1+ (expo x))))))
+;;  	     (equal (expo (trunc x n))
+;;                     (expo x)))
+;;      :hints (("Goal" :cases ((equal n 0)))))
+;;              ("Subgoal 1" :in-theory (enable trunc-rewrite))))
+             
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+    :hints (("Goal" :cases ((equal (near x n) (trunc x n))))
+            ("Subgoal 2"   :use ((:instance near-choice)
+                                 (:instance expo-away))))
+  :rule-classes ())
+
+
+;; (defthm near<=away
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (<= (near x n) (away x n)))
+;;   :rule-classes ())
+
+
+;; (defthm near>=trunc
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (>= (near x n) (trunc x n)))
+;;   :rule-classes ())
+
+
+;; (defthmd near-shift
+;;     (implies (and (rationalp x)
+;;                   (integerp n)
+;; 		  (integerp k))
+;; 	     (= (near (* x (expt 2 k)) n)
+;; 		(* (near x n) (expt 2 k)))))
+
+
+;; (defthmd near-minus
+;;   (equal (near (* -1 x) n)
+;;          (* -1 (near x n))))
+
+
+
+;----------------------------------------------------------------------
+
+;; (encapsulate () 
+
+;;      (local 
+;;      (defthm equal-diff-trunc-away-1
+;;        (implies (and (exactp y n)
+;;                      (rationalp x)
+;;                      (> x 0)
+;;                      (case-split (<= x y))
+;;                      (rationalp y)
+;;                      (equal (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                             x)))
+;;                      (integerp n)
+;;                      (> n 0))
+;;      	     (>= (abs (- x y)) (abs (- x (near x n)))))
+;;        :hints (("Goal" :use ((:instance trunc-upper-pos)
+;;                              (:instance near-choice)
+;;                              (:instance away-lower-pos)
+;;                              (:instance away-exactp-c
+;;                                         (a y)))))))
+
+
+;;      (local 
+;;      (defthm equal-diff-trunc-away-2
+;;        (implies (and (exactp y n)
+;;                      (rationalp x)
+;;                      (> x 0)
+;;                      (case-split (<= y x))
+;;                      (rationalp y)
+;;                      (equal (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                             x)))
+;;                      (integerp n)
+;;                      (> n 0))
+;;      	     (>= (abs (- x y)) (abs (- x (near x n)))))
+;;        :hints (("Goal" :use ((:instance near-choice)
+;;                              (:instance trunc-upper-pos)
+;;                              (:instance away-lower-pos)
+;;                              (:instance trunc-exactp-c
+;;                                         (a y)))))))
+
+
+
+;;      (local
+;;      (defthm near2-lemma
+;;          (implies (and (exactp y n)
+;;                        (rationalp x)
+;;                        (> x 0)
+;;      		  (rationalp y)
+;;                        (case-split (not (equal (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                                                x)))))
+;;      		  (integerp n)
+;;      		  (> n 0))
+;;      	     (>= (abs (- x y)) (abs (- x (near x n)))))
+;;          :hints (("Goal" :cases ((not (> (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                                          x))))))
+;;                  ("Subgoal 2" :cases ((not (< x y))))
+;;                  ("Subgoal 2.2" :use  ((:instance near1-b)
+;;                                        (:instance trunc-upper-pos)
+;;                                        (:instance away-lower-pos)
+;;                                        (:instance away-exactp-c
+;;                                                   (a y))))
+;;                  ("Subgoal 2.1" :use  ((:instance near1-b)
+;;                                        (:instance trunc-upper-pos)
+;;                                        (:instance away-lower-pos)
+;;                                        (:instance trunc-exactp-c
+;;                                                   (a y))))
+;;                  ("Subgoal 1" :cases ((not (< x y))))
+;;                  ("Subgoal 1.2" :use  ((:instance near1-a)
+;;                                        (:instance trunc-upper-pos)
+;;                                        (:instance away-lower-pos)
+;;                                        (:instance away-exactp-c
+;;                                                   (a y))))
+;;                  ("Subgoal 1.1" :use  ((:instance near1-a)
+;;                                        (:instance trunc-upper-pos)
+;;                                        (:instance away-lower-pos)
+;;                                        (:instance trunc-exactp-c
+;;                                                   (a y)))))))
+
+
+;;      ;; (loca
+;;      ;; (defthm exactp-equal-trunc-equal
+;;      ;;   (implies (and (exactp x n)
+;;      ;;                 (integerp n)
+;;      ;;                 (rationalp x))
+;;      ;;            (equal (trunc x n) x))
+;;      ;;   :hints (("Goal" :in-theory (enable exactp trunc)
+;;      ;;            :use ((:instance fp-rep)
+;;      ;;                  (:instance a15
+;;      ;;                             (i 2)
+;;      ;;                             (j1 (+ -1 N))
+;;      ;;                             (j2 (+ 1 (EXPO X) (* -1 N))))))))
+
+
+
+
+;;      ;; (defthm exactp-equal-away-equal
+;;      ;;   (implies (and (exactp x n)
+;;      ;;                 (integerp n)
+;;      ;;                 (rationalp x))
+;;      ;;            (equal (away x n) x))
+;;      ;;   :hints (("Goal" :in-theory (enable cg exactp away)
+;;      ;;            :use ((:instance fp-rep)
+;;      ;;                  (:instance a15
+;;      ;;                             (i 2)
+;;      ;;                             (j1 (+ -1 N))
+;;      ;;                             (j2 (+ 1 (EXPO X) (* -1 N))))))))
+
+
+;;      (local 
+;;      (defthm near2-lemma-futher
+;;          (implies (and (exactp y n)
+;;                        (rationalp x)
+;;                        (> x 0)
+;;      		  (rationalp y)
+;;      		  (integerp n)
+;;      		  (> n 0))
+;;      	     (>= (abs (- x y)) (abs (- x (near x n)))))
+;;          :hints (("Goal" :cases ((equal (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                                                x)))))
+;;                  ("Subgoal 2" :use ((:instance near2-lemma)))
+;;                  ("Subgoal 1" :cases ((not (< x y))))
+;;                  ("Subgoal 1.2" :use ((:instance equal-diff-trunc-away-1)))
+;;                  ("Subgoal 1.1" :use ((:instance equal-diff-trunc-away-2))))))
+
+
+
+;;      (defthm near2
+;;          (implies (and (exactp y n)
+;;                        (rationalp x)
+;;      		  (rationalp y)
+;;      		  (integerp n)
+;;      		  (> n 0))
+;;      	     (>= (abs (- x y)) (abs (- x (near x n)))))
+;;          :hints (("Goal" :cases ((not (> x 0)))
+;;                   :in-theory (enable near-minus trunc-minus away-minus
+;;                                      exactp-minus))
+;;                  ("Subgoal 2" :use ((:instance near2-lemma-futher)))
+;;                  ("Subgoal 1" :use ((:instance near2-lemma-futher
+;;                                                (x (* -1 x))
+;;                                                (y (* -1 y)))))))
+;; )
+
+;; (defthm near-est
+;;     (implies (and (integerp n) 
+;; 		  (> n 0)
+;; 		  (rationalp x))
+;; 	     (<= (abs (- x (near x n)))
+;; 		 (expt 2 (- (expo x) n))))
+;;     :hints (("Goal" :cases ((not (> x 0)))
+;;              :in-theory (enable near-minus expo-minus))
+;;             ("Subgoal 2" :use ((:instance near-est---rtl-rel5-support)))
+;;             ("Subgoal 1" :use ((:instance near-est---rtl-rel5-support
+;;                                           (x (* -1 x))))))
+;;   :rule-classes ())
+
+
+
+;; (encapsulate ()
+
+;; (local 
+;;  (defthm fl-1/2-sig-x-is-zero-specific
+;;    (implies (rationalp x)
+;;             (equal (fl (* 1/2 (sig x)))
+;;                    0))
+;;    :hints (("Goal" :use ((:instance sig-upper-bound)
+;;                          (:instance sig-lower-bound))))))
+
+
+;; (defthm near-monotone
+;;   (implies (and (<= x y)
+;;                 (rationalp x)
+;;                 (rationalp y)
+;;                 (integerp n)
+;;                 (natp n)
+;;                 (> n 0))
+;;            (<= (near x n) (near y n)))
+;;   :hints (("Goal" :in-theory (enable near-minus)
+;;            :cases ((not (equal x 0))))
+;;           ("Subgoal 2" :use ((:instance near-negative
+;;                                           (x (* -1 y)))))
+;;           ("Subgoal 1" :cases ((not (> x 0))))
+;;           ("Subgoal 1.2" :use ((:instance
+;;                                 near-monotone---rtl-rel5-support)))
+;;           ("Subgoal 1.1" :cases ((not (> y 0))))
+;;           ("Subgoal 1.1.2" :use ((:instance near-positive (x y))
+;;                                  (:instance near-positive (x (* -1 x)))))
+;;           ("Subgoal 1.1.1" :use ((:instance near-monotone---rtl-rel5-support
+;;                                             (x (* -1 y))
+;;                                             (y (* -1 x)))
+;;                                  (:instance near-positive (x (* -1 x)))))))
+                                 
+;; )
+
+
+;;(i-am-here)
+
+;; (defund near-witness (x y n)
+;;   (if (= (expo x) (expo y))
+;;       (/ (+ (near x n) (near y n)) 2)
+;;     (expt 2 (expo y))))
+
+
+
+;; (defthm near-near-lemma
+;;     (implies (and (rationalp x)
+;; 		  (rationalp y)
+;; 		  (< 0 x)
+;; 		  (< x y)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (not (= (near x n) (near y n))))
+;; 	     (and (<= x (near-witness x y n))
+;; 		  (<= (near-witness x y n) y)
+;; 		  (exactp (near-witness x y n) (1+ n))))
+;;   :rule-classes ())
+
+;; (defthm near-near
+;;     (implies (and (rationalp x)
+;; 		  (rationalp y)
+;; 		  (rationalp a)
+;; 		  (integerp n)
+;; 		  (integerp k)
+;; 		  (> k 0)
+;; 		  (>= n k)		  
+;; 		  (< 0 a)
+;; 		  (< a x)
+;; 		  (< 0 y)
+;; 		  (< y (fp+ a (1+ n)))
+;; 		  (exactp a (1+ n)))
+;; 	     (<= (near y k) (near x k)))
+;;   :rule-classes ())
+
+
+;----------------------------------------------------------------------
+
+;;;
+;;; either (near x n) < (near a n)
+;;; or     (near a n) < (near y n)
+;;;
+
+;;(encapsulate () 
+;----------------------------------------------------------------------
+
+; i am here !!! 
+
+;;   (defthm a-is-n-exact
+;;      (implies (and (not (exactp x n))
+;;                    (exactp x (1+ n))
+;;                    (> x 0)
+;;                    (rationalp x)
+;;                    (integerp n)
+;;                    (> n 0))
+;;               (exactp (+ x (* -1 (expt 2 (+ (expo x) (* -1 n)))))
+;;                       n))
+;;      :hints (("Goal" :in-theory (enable exactp2 a15)
+;;               :use ((:instance integerp-x-not-1/2x-lemma
+;;                                (x (* X (EXPT 2 (+ N (* -1 (EXPO X)))))))))))
+                      
+;; >             (DEFTHM FP+2
+;;                       (IMPLIES (AND (RATIONALP X)
+;;                                     (> X 0)
+;;                                     (RATIONALP Y)
+;;                                     (> Y X)
+;;                                     (INTEGERP N)
+;;                                     (> N 0)
+;;                                     (EXACTP X N)
+;;                                     (EXACTP Y N))
+;;                                (>= Y (FP+ X N)))
+;;                       :RULE-CLASSES NIL)
+
+
+
+(encapsulate ()
+      (local (include-book "../../arithmetic/basic"))
+      (local 
+      (defthm hack-artithm-1
+        (implies (and (< 0 x)
+                      (< x y)
+                      (rationalp x)
+                      (rationalp y)
+                      (rationalp z)
+                      (<= 1 z))
+                 (< x (* z y)))))
+
+
+      (local
+      (defthm expo-a-less-than-specific
+        (implies (and (integerp n)
+                      (< 0 n)
+                      (< 0 a)
+                      (rationalp a))
+                 (< (EXPT 2 (+ (EXPO A) (* -1 N))) a))
+        :hints (("Goal" :in-theory (enable sgn)
+                 :use ((:instance expt-strong-monotone-linear
+                                  (n (+ (expo a) (* -1 n)))
+                                  (m (expo a)))
+                       (:instance fp-rep (x a))
+                       (:instance sig-lower-bound (x a))
+                       (:instance hack-artithm-1 
+                                  (x (expt 2 (+ (expo a) (* -1 n))))
+                                  (y (expt 2 (expo a)))
+                                  (z (sig a))))))
+        :rule-classes :linear))
+        
+      (local
+      (defthm abs-less-than-lemma
+        (implies (and (equal (- a b) d)
+                      (equal (- c a) d)
+                      (> d 0)
+                      (< 0 x)
+                      (< x a)
+                      (>= y c))
+                 (< (abs (- b x))
+                    (abs (- y x))))))
+
+
+      ;; (defthm abs-less-than-lemma-2
+      ;;   (implies (and (< x b)
+      ;;                 (> y x)
+      ;;                 (rationalp b)
+      ;;                 (rationalp y)
+      ;;                 (rationalp x))
+      ;;            (< (abs (- b x))
+      ;;               (abs (- y x)))))
+
+
+      (local 
+       (defthm local-expt-2-expand
+         (implies (and (rationalp x)
+                       (integerp n))
+                  (equal (EXPT 2 (+ 1 (EXPO X) (* -1 N)))
+                         (* 2 (EXPT 2 (+ (expo x) (* -1 N))))))
+         :hints (("Goal" :use ((:instance a15 (i 2) (j1 1) (j2 (+ (expo x)
+              
+                                                          (* -1 N)))))))))
+
+      (local
+      (defthm near-boundary-lemma-1-lemma
+        (implies (and (rationalp x)
+                      (rationalp a)
+                      (< 0 x)
+                      (< x a)
+                      (< (+ a (* -1 
+                                     (expt 2 (+ (expo a) 
+                                                (* -1 n)))))
+                         (near x n))
+                      (integerp n)
+                      (> n 0)
+                      (exactp a (1+ n))
+                      (not (exactp a n)))
+                 (<  (abs (- (+ a (* -1 
+                                     (expt 2 (+ (expo a) 
+                                                (* -1 n)))))
+                             x))
+                     (abs (- (near x n) x))))
+        :hints (("Goal" :in-theory (disable a-is-n-exact
+                                            b-is-n-exact)
+                :use ((:instance a-is-n-exact
+                                 (x a))
+                      (:instance fp+2 
+                                 (x (+ a (* -1 
+                                            (expt 2 (+ (expo a) 
+                                                       (* -1 n))))))
+                                 (y (near x n)))
+                      (:instance abs-less-than-lemma
+                                 (a a)
+                                 (b (+ a (* -1 
+                                            (expt 2 (+ (expo a) 
+                                                       (* -1 n))))))
+                                 (c (+ a (expt 2 (+ (expo a) 
+                                                    (* -1 n)))))
+                                 (d (expt 2 (+ (expo a) (* -1 n))))
+                                 (y (near x n))
+                                 (x x)))))))
+
+      ;;      (defthm near2
+      ;;          (implies (and (exactp y n)
+      ;;                        (rationalp x)
+      ;;      		  (rationalp y)
+      ;;      		  (integerp n)
+      ;;      		  (> n 0))
+      ;;      	     (>= (abs (- x y)) (abs (- x (near x n)))))
+      ;;          :hints (("Goal" :cases ((not (> x 0)))
+      ;;                   :in-theory (enable near-minus trunc-minus away-minus
+      ;;                                      exactp-minus))
+      ;;                  ("Subgoal 2" :use ((:instance near2-lemma-futher)))
+      ;;                  ("Subgoal 1" :use ((:instance near2-lemma-futher
+      ;;                                                (x (* -1 x))
+      ;;                                                (y (* -1 y)))))))
+
+      (local
+      (defthm near-boundary-lemma-1
+        (implies (and (rationalp x)
+                      (rationalp a)
+                      (< 0 x)
+                      (< x a)
+                      (integerp n)
+                      (> n 0)
+                      (exactp a (1+ n))
+                      (not (exactp a n)))
+                 (<=  (near x n)
+                      (+ a (* -1 
+                              (expt 2 (+ (expo a) 
+                                         (* -1 n)))))))
+        :hints (("Goal" :in-theory (disable a-is-n-exact
+                                            b-is-n-exact)
+                :use 
+                ((:instance near-boundary-lemma-1-lemma)
+                 (:instance a-is-n-exact (x a))
+                 (:instance near2 
+                            (x x)
+                            (y (+ a (* -1 
+                                       (expt 2 (+ (expo a) 
+                                                  (* -1 n))))))))))
+        :rule-classes :linear))
+                                  
+
+      (local
+      (defthm abs-less-than-lemma-2
+        (implies (and (equal (- a b) d)
+                      (equal (- c a) d)
+                      (> d 0)
+                      (< 0 a)
+                      (< a y)
+                      (<= near-y b)
+                      (rationalp a)
+                      (rationalp b)
+                      (rationalp c) 
+                      (rationalp d) 
+                      (rationalp y) 
+                      (rationalp near-y))
+                 (< (abs (- c y))
+                    (abs (- near-y y))))
+        :rule-classes nil))
+
+
+      ;; (defthm fp-+
+      ;;   (implies (and (rationalp x)
+      ;;                 (> x 0)
+      ;;                 (integerp n)
+      ;;                 (> n 0)
+      ;;                 (exactp x n))
+      ;;            (equal (fp- (fp+ x n) n)
+      ;;                   x)))
+
+      (local
+      (defthm near-boundary-lemma-2-lemma
+        (implies (and (rationalp a)
+                      (rationalp y)
+                      (< 0 a)
+                      (< a y)
+                      (< (near y n)
+                         (+ a (expt 2 (+ (expo a) 
+                                         (* -1 n)))))
+                      (integerp n)
+                      (> n 0)
+                      (exactp a (1+ n))
+                      (not (exactp a n)))
+                 (<  (abs (- (+ a (expt 2 (+ (expo a) 
+                                             (* -1 n))))
+                             y))
+                     (abs (- (near y n) y))))
+        :hints (("Goal" :in-theory (disable a-is-n-exact
+                                            b-is-n-exact)
+                :use ((:instance b-is-n-exact
+                                 (x a))
+                      (:instance a-is-n-exact
+                                 (x a))
+                      (:instance  fp-+
+                                  (x (+ a (* -1 (expt 2 (+ (expo a) 
+                                                           (* -1 n))))))
+                                  (n n))
+                      (:instance fp-2 
+                                 (x (+ a (expt 2 (+ (expo a) 
+                                                    (* -1 n)))))
+                                 (y (near y n)))
+                      (:instance abs-less-than-lemma-2
+                                 (a a)
+                                 (b (- a (expt 2 (+ (expo a) 
+                                                    (* -1 n)))))
+                                 (c (+ a (expt 2 (+ (expo a) 
+                                                    (* -1 n)))))
+                                 (d (expt 2 (+ (expo a) (* -1 n))))
+                                 (near-y (near y n))
+                                 (y y)))))))
+
+      (local
+      (defthm near-boundary-lemma-2
+        (implies (and (rationalp y)
+                      (rationalp a)
+                      (< 0 a)
+                      (< a y)
+                      (integerp n)
+                      (> n 0)
+                      (exactp a (1+ n))
+                      (not (exactp a n)))
+                 (<=  (+ a (expt 2 (+ (expo a) 
+                                      (* -1 n))))
+                      (near y n)))
+        :hints (("Goal" :in-theory (disable a-is-n-exact
+                                            b-is-n-exact)
+                :use 
+                ((:instance near-boundary-lemma-2-lemma)
+                 (:instance b-is-n-exact (x a))
+                 (:instance near2 
+                            (x y)
+                            (y (+ a (expt 2 (+ (expo a) 
+                                               (* -1 n)))))))))
+        :rule-classes :linear))
+                                  
+
+          
+  (defthm near-boundary
+      (implies (and (rationalp x)
+  		  (rationalp y)
+  		  (rationalp a)
+  		  (< 0 x)
+  		  (< x a)
+  		  (< a y)
+  		  (integerp n)
+  		  (> n 0)
+  		  (exactp a (1+ n))
+  		  (not (exactp a n)))
+  	     (< (near x n) (near y n)))
+    :rule-classes ())
+
+)
+
+;; Thu Oct 12 17:22:29 2006. New.
+
+
+;----------------------------------------------------------------------
+
+;; (defthm near-exact
+;;     (implies (and (rationalp x)
+;; 		  (integerp n) 
+;; 		  (> n 1)
+;; 		  (exactp x (1+ n))
+;; 		  (not (exactp x n)))
+;; 	     (exactp (near x n) (1- n)))
+;;     :hints (("Goal" :cases ((not (equal x 0)))
+;;              :in-theory (enable near-minus))
+;;             ("Subgoal 2" :in-theory (enable exactp))
+;;             ("Subgoal 1" :cases  ((not (> x 0))))
+;;             ("Subgoal 1.2" :use near-exact---rtl-rel5-support)
+;;             ("Subgoal 1.1" :use ((:instance near-exact---rtl-rel5-support
+;;                                             (x (* -1 x))))))
+;;   :rule-classes ())
+
+
+;; (defund near+ (x n)
+;;   (if (< (re (* (expt 2 (1- n)) (sig x)))
+;; 	 1/2)
+;;       (trunc x n)
+;;     (away x n)))
+
+
+;; (defthm near+-choice
+;;     (or (= (near+ x n) (trunc x n))
+;; 	(= (near+ x n) (away x n)))
+;;   :rule-classes ())
+
+
+;; (defthm near+<=away
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (<= (near+ x n) (away x n)))
+;;   :rule-classes ())
+
+
+;; (defthm near+>=trunc
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (>= (near+ x n) (trunc x n)))
+;;   :rule-classes ())
+
+
+;; (defthmd near+-shift
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (integerp k))
+;; 	     (= (near+ (* x (expt 2 k)) n)
+;; 		(* (near+ x n) (expt 2 k)))))
+
+
+;; (defthmd near+-minus
+;;   (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+;; (defthm near+-0
+;;   (equal (near+ 0 n) 0))
+
+;; (defthm near+-0-0
+;;   (implies (and (case-split (< 0 n))
+;;                 (case-split (rationalp x))
+;;                 (case-split (integerp n)))
+;;            (equal (equal (near+ x n) 0)
+;; 		  (equal x 0)))
+;;   :rule-classes ())
+
+;; >             (DEFTHM SGN-NEAR+
+;;                       (IMPLIES (AND (RATIONALP X) (INTEGERP N) (> N 0))
+;;                                (= (NEAR+ X N)
+;;                                   (* (SGN X) (NEAR+ (ABS X) N))))
+;;                       :RULE-CLASSES NIL)
+
+;; (defthm sgn-near+
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (equal (sgn (near+ x n))
+;; 		    (sgn x)))
+;;     :hints (("Goal" :use ((:instance sgn-near+---rtl-rel5-support)))))
+ 
+;; (i-am-here) ;; Fri Oct 13 09:45:43 2006
+
+;; (defthm near+-exactp-a
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (exactp (near+ x n) n))
+;;     :hints (("Goal" :use ((:instance near+-exactp-b---rtl-rel5-support)))))
+
+
+;; (defthm near+-exactp-b
+;;     (implies (and (rationalp x)
+;; 		  (integerp n) 
+;; 		  (> n 0))
+;; 	     (iff (= x (near+ x n))
+;; 		  (exactp x n)))
+;;     :hints (("Goal" :use ((:instance near+-exactp-a---rtl-rel5-support))))
+;;   :rule-classes ())
+
+
+;;  (defthm near+-exactp-d
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (<= a x))
+;; 	     (<= a (near+ x n)))
+;;     :hints (("Goal" :cases ((not (equal x 0))))
+;;             ("Subgoal 2" :in-theory (enable near+))
+;;             ("Subgoal 1" :cases ((not (> x 0))))
+;;             ("Subgoal 1.2" :use ((:instance near+-exactp-d---rtl-rel5-support)))
+;;             ("Subgoal 1.1" :use ((:instance near+-exactp-c---rtl-rel5-support
+;;                                             (x (* -1 x)) (a (* -1 a))))
+;;              :in-theory (e/d (near+ trunc-minus away-minus fl-minus 
+;;                                     sig-minus) ()))))
+;; )
+
+;; ACL2 !>(expo (near+ (+ 1/4 1/8) 0))
+;; -1
+;; ACL2 !>(expo (+ 1/4 1/8))
+;; -2
+
+;;     :hints (("Goal" :cases ((equal (near x n) (trunc x n))))
+;;             ("Subgoal 2"   :use ((:instance near-choice)
+;
+;                                  (:instance expo-away))))
+
+;; (i-am-here) ;; Thu Oct 12 18:15:18 2006
+
+(encapsulate ()
+             (local 
+              (defthm fl-1/2-sig-x-is-zero-specific
+                (implies (rationalp x)
+                         (equal (fl (* 1/2 (sig x)))
+                                0))
+                :hints (("Goal" :use ((:instance sig-upper-bound)
+                                      (:instance sig-lower-bound))))))
+
+ (defthm expo-near+
+   (implies (and (rationalp x)
+                 (natp n)
+                 (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+            (equal (expo (near+ x n))
+                   (expo x)))
+   :hints (("Goal" :in-theory (e/d (near+ sgn
+                                          expo-trunc expo-away re
+                                          sig-lower-bound)
+                                   (trunc away))
+            :cases ((equal (near+ x n) (trunc x n))))
+           ("Subgoal 1" :cases ((equal n 0)))
+           ("Subgoal 1.1" :cases ((not (equal x 0)))))
+   :rule-classes ())
+)
+
+;----------------------------------------------------------------------
+
+;; 
+;; (defthm near+1-a-1
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+;; 	     (= (near+ x n) (trunc x n)))
+;;     :hints (("Goal" :cases ((not (equal x 0)))
+;;              :in-theory (enable trunc-minus near+-minus trunc-upper-pos
+;;                                 away-lower-pos
+;;                                 away-minus))
+;;             ("Subgoal 1" :cases ((not (> x 0))))
+;;             ("Subgoal 1.2" :use ((:instance near+1-a---rtl-rel5-support)))
+;;             ("Subgoal 1.1" :use ((:instance near+1-a---rtl-rel5-support
+;;                                             (x (* -1 x)))
+;;                                  (:instance trunc-upper-pos
+;;                                             (x (* -1 x)))
+;;                                  (:instance away-lower-pos
+;;                                             (x (* -1 x)))
+;;                                  (:instance trunc-exactp-b)
+;;                                  (:instance away-exactp-b))))
+;;   :rule-classes ())
+
+
+;; (defthm near+1-b-1
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+;; 	     (= (near+ x n) (away x n)))
+;;     :hints (("Goal" :cases ((not (equal x 0)))
+;;              :in-theory (enable trunc-minus near+-minus trunc-upper-pos
+;;                                 away-lower-pos
+;;                                 away-minus))
+;;             ("Subgoal 1" :cases ((not (> x 0))))
+;;             ("Subgoal 1.2" :use ((:instance near+1-b---rtl-rel5-support)))
+;;             ("Subgoal 1.1" :use ((:instance near+1-b---rtl-rel5-support
+;;                                             (x (* -1 x)))
+;;                                  (:instance trunc-upper-pos
+;;                                             (x (* -1 x)))
+;;                                  (:instance away-lower-pos
+;;                                             (x (* -1 x)))
+;;                                  (:instance trunc-exactp-b)
+;;                                  (:instance away-exactp-b))))
+;;   :rule-classes ())
+
+
+;; (encapsulate ()
+;;   (local   
+;;   (encapsulate ()
+;;                (local          
+;;                 (defthm fl-1/2-sig-x-is-zero-lemma
+;;                   (implies (and (rationalp x)
+;;                                 (rationalp y)
+;;                                 (< 0 y)
+;;                                 (<= y 1/2))
+;;                            (equal (fl (* (sig x) y))
+;;                                   0))
+;;                   :hints (("Goal" :use ((:instance sig-upper-bound)
+;;                                         (:instance sig-lower-bound))))))
+
+       
+;;                (local 
+;;                 (defthm fl-1/2-sig-x-is-zero-lemma-2
+;;                   (implies (and (rationalp x)
+;;                                 (rationalp y)
+;;                                 (not (equal x 0))
+;;                                 (< 0 y)
+;;                                 (<= y 1/2))
+;;                            (equal (fl (* -1 (sig x) y))
+;;                                   -1))
+;;                   :hints (("Goal" :in-theory (enable sig fl-minus)
+;;                            :use ((:instance fl-1/2-sig-x-is-zero-lemma))))))
+
+
+;;                (local 
+;;                 (defthm expt-merge
+;;                   (implies (and (rationalp x)
+;;                                 (integerp n))
+;;                            (equal (* (expt 2 (expo x))
+;;                                      (EXPT 2 (+ -1 N))
+;;                                      (EXPT 2 (* -1 (EXPO X))))
+;;                                   (expt 2 (+ -1 n))))
+;;                   :hints (("Goal" :in-theory (enable a15)))))
+
+;;                (local (defthm expt-fact-1
+;;                         (implies (and (integerp n)
+;;                                       (<= n 0))
+;;                                  (<= (* 2 (EXPT 2 (+ -1 N))) 1))
+;;                         :hints (("Goal" :use ((:instance expt-weak-monotone-linear
+;;                                                          (n (+ -1 n))
+;;                                                          (m -1)))))
+;;                         :rule-classes :linear))
+
+;;                (local
+;;                 (defthm fl-is-zero-if-n-less-than-minus-1
+;;                   (implies (and (rationalp x)
+;;                                 (> x 0)
+;;                                 (integerp n)
+;;                                 (<= n 0))
+;;                            (equal (FL (* -1 X (EXPT 2 (+ -1 N))
+;;                                          (EXPT 2 (* -1 (EXPO X)))))
+;;                                   -1))
+;;                   :hints (("Goal" :in-theory (e/d (expo-shift sgn)
+;;                                                   (fl-1/2-sig-x-is-zero-lemma-2))
+;;                            :use ((:instance fp-rep (x x))
+;;                                  (:instance fl-1/2-sig-x-is-zero-lemma-2
+;;                                             (y (expt 2 (+ -1 n)))))))))
+
+;;                (local 
+;;                 (defthm fl-is-zero-if-n-less-than-zero
+;;                   (implies (and (rationalp x)
+;;                                 (> x 0)
+;;                                 (integerp n)
+;;                                 (<= n 0))
+;;                            (equal (FL (* X (EXPT 2 (+ -1 N))
+;;                                          (EXPT 2 (* -1 (EXPO X)))))
+;;                                   0))
+;;                   :hints (("Goal" :in-theory (e/d (expo-shift sgn)
+;;                                                   (fl-1/2-sig-x-is-zero-lemma))
+;;                            :use ((:instance fp-rep (x x))
+;;                                  (:instance fl-1/2-sig-x-is-zero-lemma
+;;                                             (y (expt 2 (+ -1 n)))))))))
+
+
+
+
+
+;;                (local (defthm expt-fact-2
+;;                         (implies (and (integerp n)
+;;                                       (< n 0))
+;;                                  (<= (* 4 (EXPT 2 (+ -1 N))) 1))
+;;                         :hints (("Goal" :use ((:instance expt-weak-monotone-linear
+;;                                                          (n (+ -1 n))
+;;                                                          (m -2)))))
+;;                         :rule-classes :linear))
+
+;;                (local 
+;;                 (defthm arith-hack
+;;                   (implies (and (< sig-x 2)
+;;                                 (> y 0)
+;;                                 (<= (* 4 y) 1)
+;;                                 (rationalp y))
+;;                            (< (* 2 sig-x y)
+;;                               (* 1)))))
+    
+
+
+;;                (local 
+;;                 (defthm less-than-1-if-n-is-negative
+;;                   (implies (and (rationalp x)
+;;                                 (> x 0)
+;;                                 (integerp n)
+;;                                 (< n 0))
+;;                            (< (* 2 X (EXPT 2 (+ -1 N))
+;;                                  (EXPT 2 (* -1 (EXPO X))))
+;;                               1))
+;;                   :hints (("Goal" :in-theory (e/d (expo-shift  sgn) ())
+;;                            :use ((:instance fp-rep (x x))
+;;                                  (:instance sig-upper-bound)
+;;                                  (:instance arith-hack
+;;                                             (sig-x (sig x))
+;;                                             (y (expt 2 (+ -1 n)))))))
+;;                   :rule-classes :linear))
+
+;;                (local 
+;;                 (encapsulate () 
+;;                              (local 
+;;                               (defthm local-expt-expand
+;;                                 (implies (rationalp x)
+;;                                          (equal (EXPT 2 (+ 1 (EXPO X)))
+;;                                                 (* 2 (expt 2 (expo x)))))
+;;                                 :hints (("Goal" :use ((:instance a15 (i 2) (j1 1) (j2 (expo x))))))))
+                  
+;;                              (defthm x-lower-bound
+;;                                (implies (and (rationalp x)
+;;                                              (> x 0))
+;;                                         (>= (* 2 X) (EXPT 2 (+ 1 (EXPO X)))))
+;;                                :hints (("Goal" :use ((:instance expo-lower-bound))))
+;;                                :rule-classes :linear)))
+
+
+
+;;      ;;;; these 4 are important!!! 
+
+;;                (defthm fl-is-zero-if-n-less-than-minus-1
+;;                  (implies (and (rationalp x)
+;;                                (> x 0)
+;;                                (integerp n)
+;;                                (<= n 0))
+;;                           (equal (FL (* -1 X (EXPT 2 (+ -1 N))
+;;                                         (EXPT 2 (* -1 (EXPO X)))))
+;;                                  -1)))
+
+
+;;                (defthm fl-is-zero-if-n-less-than-zero
+;;                  (implies (and (rationalp x)
+;;                                (> x 0)
+;;                                (integerp n)
+;;                                (<= n 0))
+;;                           (equal (FL (* X (EXPT 2 (+ -1 N))
+;;                                         (EXPT 2 (* -1 (EXPO X)))))
+;;                                  0)))
+
+;;                (defthm less-than-1-if-n-is-negative
+;;                  (implies (and (rationalp x)
+;;                                (> x 0)
+;;                                (integerp n)
+;;                                (< n 0))
+;;                           (< (* 2 X (EXPT 2 (+ -1 N))
+;;                                 (EXPT 2 (* -1 (EXPO X))))
+;;                              1))
+;;                  :rule-classes :linear)
+
+;;                (defthm x-lower-bound
+;;                  (implies (and (rationalp x)
+;;                                (> x 0))
+;;                           (>= (* 2 X) (EXPT 2 (+ 1 (EXPO X)))))
+;;                  :rule-classes :linear)))
+
+;;   (local
+;;    (defthm near+1-a-2-2
+;;      (implies (and (rationalp x)
+;;                    (> x 0)
+;;                    (integerp n)
+;;                    (<= n 0)
+;;                    (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+;;               (= (near+ x n) (trunc x n)))
+;;      :hints (("Goal" :in-theory (enable near+ sgn cg away trunc sig re)
+;;               :cases ((equal n 0))))
+;;      :rule-classes ()))
+
+
+  
+;;   (local (defthm x-upper-bound-1
+;;          (implies (and (rationalp x)
+;;                        (> x 0)
+;;                        (integerp n)
+;;                        (< n 0))
+;;                   (> (EXPT 2 (+ 1 (EXPO X) (* -1 N))) X))
+;;          :rule-classes :linear
+;;          :hints (("Goal" :in-theory (enable expo-upper-bound)
+;;                   :use ((:instance expt-strong-monotone-linear
+;;                                    (n (+ 1 (expo x)))
+;;                                    (m (+ 1 (expo x) (* -1 n)))))))))
+
+
+;;   (local (defthm x-upper-bound-2
+;;          (implies (and (rationalp x)
+;;                        (> x 0)
+;;                        (integerp n)
+;;                        (< n 0))
+;;                   (>= (EXPT 2 (+ 1 (EXPO X) (* -1 N))) (* 2 X)))
+;;          :rule-classes :linear
+;;          :hints (("Goal" :in-theory (enable expo-upper-bound)
+;;                   :use ((:instance expt-weak-monotone-linear
+;;                                    (n (+ 2 (expo x)))
+;;                                    (m (+ 1 (expo x) (* -1 n))))
+;;                         (:instance a15 (i 2)
+;;                                    (j1 1) (j2 (+ 1 (expo x)))))))))
+
+
+;;   (local (defthm x-upper-bound-3
+;;          (implies (and (rationalp x)
+;;                        (> x 0))
+;;                   (> (EXPT 2 (+ 1 (EXPO X))) x))
+;;          :rule-classes :linear
+;;          :hints (("Goal" :in-theory (enable expo-upper-bound)))))
+
+
+
+
+
+
+;; ;;      (defthm fl-is-zero-if-n-less-than-zero
+;; ;;        (implies (and (rationalp x)
+;; ;;                      (> x 0)
+;; ;;                      (integerp n)
+;; ;;                      (<= n 0))
+;; ;;                 (equal (FL (* X (EXPT 2 (+ -1 N))
+;; ;;                               (EXPT 2 (* -1 (EXPO X)))))
+;; ;;                        0)))
+
+
+
+;;   (local (defthm x-upper-bound-4
+;;          (implies (and (rationalp x)
+;;                        (> x 0))
+;;                   (<= 1 (* X (EXPT 2 (* -1 (EXPO X))))))
+;;          :rule-classes :linear
+;;          :hints (("Goal" :use ((:instance fp-rep))
+;;                   :in-theory (enable sgn a15 sig-lower-bound
+;;                                      expo-shift)))))
+
+
+
+
+;;   (local
+;;      (defthm fl-is-zero-if-n-less-than-zero-2
+;;        (implies (and (rationalp x)
+;;                      (> x 0))
+;;                 (equal (FL (* 1/2 X 
+;;                               (EXPT 2 (* -1 (EXPO X)))))
+;;                        0))
+;;        :hints (("Goal" :use ((:instance fl-is-zero-if-n-less-than-zero
+;;                                         (n 0)))
+;;                 :in-theory (disable fl-is-zero-if-n-less-than-zero)))))
+       
+
+;;   (local
+;;    (defthm near+1-b-2-2
+;;      (implies (and (rationalp x)
+;;                    (> x 0)
+;;                    (integerp n)
+;;                    (<= n 0)
+;;                    (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+;;               (= (near+ x n) (away x n)))
+;;      :hints (("Goal" :in-theory (enable away-lower-pos trunc-upper-pos
+;;                                         near+ sgn cg away trunc sig re)
+;;               :cases ((equal n 0))))
+;;      :rule-classes ()))
+
+
+
+;;   (defthm near+1-a-2
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;;                   (<= n 0)
+;; 		  (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+;; 	     (= (near+ x n) (trunc x n)))
+;;     :hints (("Goal" :cases ((not (equal x 0)))
+;;              :in-theory (enable  trunc-minus near+-minus trunc-upper-pos
+;;                                  away-lower-pos
+;;                                  away-minus))
+;;             ("Subgoal 1" :cases ((not (> x 0))))
+;;             ("Subgoal 1.2" :use ((:instance near+1-a-2-2)))
+;;             ("Subgoal 1.1" :use ((:instance near+1-a-2-2
+;;                                             (x (* -1 x))))))
+;;     :rule-classes ())
+
+;;   (defthm near+1-b-2
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;;                   (<= n 0)
+;; 		  (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+;; 	     (= (near+ x n) (away x n)))
+;;     :hints (("Goal" :cases ((not (equal x 0)))
+;;              :in-theory (enable  trunc-minus near+-minus trunc-upper-pos
+;;                                  away-lower-pos
+;;                                  away-minus))
+;;             ("Subgoal 1" :cases ((not (> x 0))))
+;;             ("Subgoal 1.2" :use ((:instance near+1-b-2-2)))
+;;             ("Subgoal 1.1" :use ((:instance near+1-b-2-2
+;;                                             (x (* -1 x))))))
+;;     :rule-classes ()))
+
+
+
+
+
+;; (defthm near+1-a
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+;; 	     (= (near+ x n) (trunc x n)))
+;;     :hints (("Goal" :cases ((not (> n 0))))
+;;             ("Subgoal 2" :use ((:instance near+1-a-1)))
+;;             ("Subgoal 1" :use ((:instance near+1-a-2))))
+;;   :rule-classes ())
+
+
+;; (defthm near+1-b
+;;     (implies (and (rationalp x)
+;;                   (natp n)
+;; 		  (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+;; 	     (= (near+ x n) (away x n)))
+;;     :hints (("Goal" :cases ((not (> n 0))))
+;;             ("Subgoal 2" :use ((:instance near+1-b-1)))
+;;             ("Subgoal 1" :use ((:instance near+1-b-2))))
+;;   :rule-classes ())
+
+
+;----------------------------------------------------------------------
+
+;; (i-am-here) ;; Fri Oct 13 11:19:13 2006
+
+
+;; (encapsulate () 
+
+;;     (local 
+;;     (defthm equal-diff-trunc-away-1
+;;       (implies (and (exactp y n)
+;;                     (rationalp x)
+;;                     (> x 0)
+;;                     (case-split (<= x y))
+;;                     (rationalp y)
+;;                     (equal (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                            x)))
+;;                     (integerp n)
+;;                     (> n 0))
+;;     	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+;;       :hints (("Goal" :use ((:instance trunc-upper-pos)
+;;                             (:instance near+-choice)
+;;                             (:instance away-lower-pos)
+;;                             (:instance away-exactp-c
+;;                                        (a y)))))))
+
+
+;;     (local 
+;;     (defthm equal-diff-trunc-away-2
+;;       (implies (and (exactp y n)
+;;                     (rationalp x)
+;;                     (> x 0)
+;;                     (case-split (<= y x))
+;;                     (rationalp y)
+;;                     (equal (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                            x)))
+;;                     (integerp n)
+;;                     (> n 0))
+;;     	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+;;       :hints (("Goal" :in-theory (disable NEAR+-EXACTP-D)
+;;                :use ((:instance near+-choice)
+;;                      (:instance trunc-upper-pos)
+;;                      (:instance away-lower-pos)
+;;                      (:instance trunc-exactp-c
+;;                                 (a y)))))))
+
+
+
+;;     (local
+;;     (defthm near2+-lemma
+;;         (implies (and (exactp y n)
+;;                       (rationalp x)
+;;                       (> x 0)
+;;     		  (rationalp y)
+;;                       (case-split (not (equal (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                                               x)))))
+;;     		  (integerp n)
+;;     		  (> n 0))
+;;     	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+;;         :hints (("Goal" :cases ((not (> (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                                         x)))))
+;;                  :in-theory (disable near+-exactp-d))
+;;                 ("Subgoal 2" :cases ((not (< x y))))
+;;                 ("Subgoal 2.2" :use  ((:instance near+1-b)
+;;                                       (:instance trunc-upper-pos)
+;;                                       (:instance away-lower-pos)
+;;                                       (:instance away-exactp-c
+;;                                                  (a y))))
+;;                 ("Subgoal 2.1" :use  ((:instance near+1-b)
+;;                                       (:instance trunc-upper-pos)
+;;                                       (:instance away-lower-pos)
+;;                                       (:instance trunc-exactp-c
+;;                                                  (a y))))
+;;                 ("Subgoal 1" :cases ((not (< x y))))
+;;                 ("Subgoal 1.2" :use  ((:instance near+1-a)
+;;                                       (:instance trunc-upper-pos)
+;;                                       (:instance away-lower-pos)
+;;                                       (:instance away-exactp-c
+;;                                                  (a y))))
+;;                 ("Subgoal 1.1" :use  ((:instance near+1-a)
+;;                                       (:instance trunc-upper-pos)
+;;                                       (:instance away-lower-pos)
+;;                                       (:instance trunc-exactp-c
+;;                                                  (a y)))))))
+
+
+;;     ;; (loca
+;;     ;; (defthm exactp-equal-trunc-equal
+;;     ;;   (implies (and (exactp x n)
+;;     ;;                 (integerp n)
+;;     ;;                 (rationalp x))
+;;     ;;            (equal (trunc x n) x))
+;;     ;;   :hints (("Goal" :in-theory (enable exactp trunc)
+;;     ;;            :use ((:instance fp-rep)
+;;     ;;                  (:instance a15
+;;     ;;                             (i 2)
+;;     ;;                             (j1 (+ -1 N))
+;;     ;;                             (j2 (+ 1 (EXPO X) (* -1 N))))))))
+
+
+
+
+;;     ;; (defthm exactp-equal-away-equal
+;;     ;;   (implies (and (exactp x n)
+;;     ;;                 (integerp n)
+;;     ;;                 (rationalp x))
+;;     ;;            (equal (away x n) x))
+;;     ;;   :hints (("Goal" :in-theory (enable cg exactp away)
+;;     ;;            :use ((:instance fp-rep)
+;;     ;;                  (:instance a15
+;;     ;;                             (i 2)
+;;     ;;                             (j1 (+ -1 N))
+;;     ;;                             (j2 (+ 1 (EXPO X) (* -1 N))))))))
+
+
+;;     (local 
+;;     (defthm near2+-lemma-futher
+;;         (implies (and (exactp y n)
+;;                       (rationalp x)
+;;                       (> x 0)
+;;     		  (rationalp y)
+;;     		  (integerp n)
+;;     		  (> n 0))
+;;     	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+;;         :hints (("Goal" :cases ((equal (abs (- x (trunc x n))) (abs (- (away x n)
+;;                                                                               x)))))
+;;                 ("Subgoal 2" :use ((:instance near2+-lemma)))
+;;                 ("Subgoal 1" :cases ((not (< x y))))
+;;                 ("Subgoal 1.2" :use ((:instance equal-diff-trunc-away-1)))
+;;                 ("Subgoal 1.1" :use ((:instance equal-diff-trunc-away-2))))))
+
+
+
+;;     (defthm near+2
+;;         (implies (and (exactp y n)
+;;                       (rationalp x)
+;;     		  (rationalp y)
+;;     		  (integerp n)
+;;     		  (> n 0))
+;;     	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+;;         :hints (("Goal" :cases ((not (> x 0)))
+;;                  :in-theory (enable near+-minus trunc-minus away-minus
+;;                                     exactp-minus))
+;;                 ("Subgoal 2" :use ((:instance near2+-lemma-futher)))
+;;                 ("Subgoal 1" :use ((:instance near2+-lemma-futher
+;;                                               (x (* -1 x))
+;;                                                    (y (* -1 y))))))
+;;         :rule-classes ())
+;;     )
+
+;; (i-am-here) ;; Fri Oct 13 11:38:14 2006
+
+;; (encapsulate ()
+;;     (local 
+;;     (defthm fl-1/2-sig-x-is-zero-specific
+;;       (implies (rationalp x)
+;;                (equal (fl (* 1/2 (sig x)))
+;;                       0))
+;;       :hints (("Goal" :use ((:instance sig-upper-bound)
+;;                             (:instance sig-lower-bound))))))
+
+
+;;    (local 
+;;     (defthm near+-monotone-lemma1
+;;       (implies (and (<= x y)
+;;                     (rationalp x)
+;;                     (rationalp y))
+;;                (<= (near+ x 0) (near+ y 0)))
+;;       :hints (("Goal" :in-theory (enable near+ sgn away-minus)
+;;                :cases ((not (equal x 0))))
+;;               ("Subgoal 2" :use ((:instance away-negative
+;;                                             (x (* -1 y)) (n 0))))
+;;               ("Subgoal 1" :cases ((not (> x 0))))
+;;               ("Subgoal 1.2" :use ((:instance sig-lower-bound (x y))
+;;                                    (:instance expt-weak-monotone-linear
+;;                                               (n (+ 1 (expo x)))
+;;                                               (m (+ 1 (expo y))))
+;;                                    (:instance expo-monotone)))
+;;               ("Subgoal 1.1" :cases ((not (> y 0)))
+;;                :in-theory (enable away near+ sgn cg))
+;;               ("Subgoal 1.1.1" 
+;;                :use ((:instance expt-weak-monotone-linear
+;;                                 (n (+ 1 (expo y)))
+;;                                 (m (+ 1 (expo x))))
+;;                      (:instance expo-monotone
+;;                                 (x y) (y x))
+;;                      (:instance sig-lower-bound))))))
+            
+
+;;  (defthm near+-monotone
+;;    (implies (and (<= x y)
+;;                 (rationalp x)
+;;                 (rationalp y)
+;;                 (integerp n)
+;;                 (natp n))
+;;            (<= (near+ x n) (near+ y n)))
+;;   :hints (("Goal" :cases ((not (equal n 0)))
+;;            :in-theory (enable near+-minus))
+;;           ("Subgoal 2" :use ((:instance near+-monotone-lemma1)))
+;;           ("Subgoal 1" :cases ((not (equal x 0))))
+;;           ("Subgoal 1.2" :use ((:instance near+-negative
+;;                                           (x (* -1 y)))))
+;;           ("Subgoal 1.1" :cases ((not (> x 0))))
+;;           ("Subgoal 1.1.2" :use ((:instance
+;;                                   near+-monotone---rtl-rel5-support)))
+;;           ("Subgoal 1.1.1" :use ((:instance near+-monotone---rtl-rel5-support
+;;                                             (x (* -1 y))
+;;                                             (y (* -1 x)))))))
+          
+;; )
+
+;----------------------------------------------------------------------
+
+(encapsulate ()
+  (local (include-book "../../arithmetic/top"))
+  (local 
+   (defthm z-integerp-not-integer
+     (implies (and (not (integerp x))
+                   (rationalp x)
+                   (integerp (* 2 x)))
+              (equal (+ x (* -1 (fl x))) 1/2))))
+
+  (local 
+     (defthm integerp-x-integerp-2*x
+       (implies (and (integerp (* x (expt 2 n)))
+                     (integerp n))
+                (integerp (* 2 x (expt 2 (+ -1 n)))))
+       :hints (("Goal" 
+                :use ((:instance a15 
+                                 (i 2)
+                                 (j1 1)
+                                 (j2 (+ -1 n))))))))
+
+  (defthm near+-midpoint
+      (implies (and (rationalp x)
+  		  (integerp n)
+  		  (exactp x (1+ n))
+  		  (not (exactp x n)))
+  	     (equal (near+ x n) (away x n)))
+      :hints (("Goal" :in-theory (enable exactp near+)
+               :use ((:instance z-integerp-not-integer
+                                (x (* (sig x)
+                                      (expt 2 (+ -1 n))))))))
+    :rule-classes ())
+)
+;----------------------------------------------------------------------
+
+;; (defthm near-power-a
+;;     (implies (and (rationalp x) (> x 0)
+;; 		  (integerp n) (> n 1)
+;; 		  (>= (+ x (expt 2 (- (expo x) n)))
+;; 		      (expt 2 (1+ (expo x)))))
+;; 	     (= (near x n)
+;; 		(expt 2 (1+ (expo x)))))
+;;   :rule-classes ())
+
+
+;; (defthm near-power-b
+;;     (implies (and (rationalp x) (> x 0)
+;; 		  (integerp n) (> n 1)
+;; 		  (>= (+ x (expt 2 (- (expo x) n)))
+;; 		      (expt 2 (1+ (expo x)))))
+;; 	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+;; 		(expt 2 (1+ (expo x)))))
+;;   :rule-classes ())
+
+
+;; (defthm near+-power
+;;     (implies (and (rationalp x) (> x 0)
+;; 		  (integerp n) (> n 1)
+;; 		  (>= (+ x (expt 2 (- (expo x) n)))
+;; 		      (expt 2 (1+ (expo x)))))
+;; 	     (= (near+ x n)
+;; 		(expt 2 (1+ (expo x)))))
+;;   :rule-classes ())
+
+
+;----------------------------------------------------------------------
+
+(encapsulate () 
+  ;; referring to the folllowing
+  ;;                            Fri Oct 13 12:05:54 2006
+  ;; (defthm plus-trunc
+  ;;     (implies (and (rationalp x)
+  ;; 		  (>= x 0)
+  ;; 		  (rationalp y)
+  ;; 		  (>= y 0)
+  ;; 		  (integerp k)
+  ;; 		  (exactp x (+ k (- (expo x) (expo y)))))
+  ;; 	     (= (+ x (trunc y k))
+  ;; 		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  ;;   :rule-classes ())
+
+
+
+  ;; (defthm plus-away
+  ;;   (implies (and (exactp x (+ k (- (expo x) (expo y))))
+  ;;                 (rationalp x)
+  ;;                 (>= x 0)
+  ;;                 (rationalp y)
+  ;;                 (>= y 0)
+  ;;                 (integerp k))
+  ;;            (= (+ x (away y k))
+  ;;               (away (+ x y)
+  ;;                     (+ k (- (expo (+ x y)) (expo y))))))
+  ;;   :rule-classes ())
+
+  ;; (local (include-book "../../arithmetic/top"))
+           
+  ;; Following the steps in Lemma 5.3.33. on 
+  ;; http://www.russinoff.com/libman/top.html
+
+  (local 
+   (defun z (y k)
+     (fl (* (sig y) (expt 2 (+ -1 k))))))
+
+  (local 
+   (defun f (y k)
+     (- (* (expt 2 (+ -1 k)) (sig y))  (z y k))))
+
+  (local 
+   (defthm re-equal-if-f-equal
+     (implies (equal (f y1 k1)
+                     (f y2 k2))
+              (equal (re (* (expt 2 (+ -1 k1)) (sig y1)))
+                     (re (* (expt 2 (+ -1 k2)) (sig y2)))))
+     :rule-classes nil))
+                     
+  (local 
+  (defthm integerp-1/2-integerp
+    (implies (and (integerp d)
+                  (rationalp x))
+             (iff (integerp (+ d x))
+                  (integerp x)))))
+
+  (local
+  (defthm evenp-perserved-by-plus-even
+    (implies (and (evenp d)
+                  (integerp d)
+                  (integerp x))
+             (and (iff (evenp (+ x d))
+                       (evenp x))
+                  (iff (oddp (+ x d))
+                       (oddp x))))))
+
+
+  (local 
+   (defthm evenp-iff-difference
+     (implies (and (evenp (- z1 z2))
+                   (integerp z1)
+                   (integerp z2))
+              (iff (evenp z1)
+                   (evenp z2)))
+     :hints (("Goal" :use ((:instance evenp-perserved-by-plus-even
+                                      (d (- z1 z2))
+                                      (x z2)))))))
+
+
+  (local 
+   (defthm evenp-iff-difference-specific
+     (implies (evenp (+ (z y k) (* -1 (z (+ x y) (+ k (expo (+ x y)) (* -1 (expo y)))))))
+              (iff (evenp (fl (* (sig (+ x y)) (expt 2 (+ -1 k  (* -1 (expo y)) (expo (+ x y)))))))
+                   (evenp (fl (* (sig y) (expt 2 (+ -1 k)))))))
+     :hints (("Goal" :in-theory (disable evenp EVENP-IFF-DIFFERENCE)
+              :use ((:instance evenp-iff-difference
+                                      (z1 (z y k))
+                                      (z2 (z (+ x y) (+ k (expo (+ x y)) (* -1 (expo y)))))))))))
+
+  
+  (local
+  (defthm near-plus-lemma-if-fl-equal
+    (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                  (equal (f y k)
+                         (f (+ x y) (+ k (expo (+ x y)) (* -1 (expo y)))))
+                  (evenp (+ (z y k) 
+                            (* -1 (z (+ x y) (+ k (* -1 (expo y)) (expo (+ x y)))))))
+                  (rationalp x)
+                  (>= x 0)
+                  (rationalp y)
+                  (>= y 0)
+                  (integerp k))
+             (= (+ x (near y k))
+                (near (+ x y)
+                      (+ k (- (expo (+ x y)) (expo y))))))
+    :hints (("Goal" :in-theory (e/d (near exactp-<=) (evenp z f re))
+             :use ((:instance plus-trunc)
+                   (:instance plus-away)
+                   (:instance evenp-iff-difference-specific)
+                   (:instance re-equal-if-f-equal
+                              (y1 y) (k1 k)
+                              (y2 (+ x y)) (k2 (+ k (- (expo (+ x y)) (expo y))))))))
+    :rule-classes ()))
+
+  ;; >             (DEFTHM FL+INT-REWRITE
+  ;;                       (IMPLIES (AND (INTEGERP N) (RATIONALP X))
+  ;;                                (EQUAL (FL (+ X N)) (+ (FL X) N))))
+  
+  (local 
+  (defthm f-equal-if-difference-integerp
+    (implies (and (integerp (+ (* (sig y1) (expt 2 (+ -1 k1)))
+                               (* -1 (sig y2) (expt 2 (+ -1 k2)))))
+                  (rationalp y2))
+             (equal (f y1 k1)
+                    (f y2 k2)))
+    :hints (("Goal" 
+             :use ((:instance fl+int-rewrite
+                              (x (* (sig y2) (expt 2 (+ -1 k2))))
+                              (n (+ (* (sig y1) (expt 2 (+ -1 k1)))
+                                    (* -1 (sig y2) (expt 2 (+ -1 k2)))))))))
+    :rule-classes nil))
+  
+  (local 
+  (defthm z-difference-evenp-evenp
+    (implies (equal (f y1 k1)
+                    (f y2 k2))
+             (equal (+ (z y1 k1)
+                       (* -1 (z y2 k2)))
+                    (+ (* (sig y1) (expt 2 (+ -1 k1)))
+                       (* -1 (sig y2) (expt 2 (+ -1 k2))))))
+    :rule-classes nil))
+
+  (local
+  (defthm expo-normalize
+    (implies (rationalp x)
+             (equal (EXPO (* (SGN X)
+                             (SIG X)
+                             (EXPT 2 (EXPO X))))
+                    (expo x)))
+    :hints (("Goal" :use ((:instance fp-rep))))))
+
+  (local 
+  (defthm sig-multiply-normalize
+    (implies (and (rationalp x)
+                  (>= x 0)
+                  (integerp v)
+                  (integerp w))
+             (equal (* (sig x) (expt 2 (+ v w (expo x))))
+                    (* x (expt 2 (+ v w)))))
+    :hints (("Goal" :in-theory (enable sgn)
+             :use ((:instance fp-rep (x x))
+                          (:instance a15 (i 2)
+                                     (j1 (expo x))
+                                     (j2 (+ v w))))))
+    :rule-classes nil))
+                                     
+  (local 
+  (defthm sig-y1-y2-equal
+    (implies (and (rationalp y)
+                  (>= x 0)
+                  (>= y 0)
+                  (integerp k)
+                  (rationalp x))
+             (equal (+ (* (sig (+ x y))
+                          (expt 2 (+ -1 k (* -1 (expo y))
+                                     (expo (+ x y)))))
+                       (* -1 (sig y) (expt 2 (+ -1 k))))
+                    (* x (expt 2 (+ -1 k (* -1 (expo y)))))))
+    :hints (("Goal" :in-theory (enable sgn)
+             :cases ((not (equal (* (sig (+ x y))
+                                    (expt 2 (+ -1 k (* -1 (expo y))
+                                               (expo (+ x y)))))
+                                 (* (+ x y) 
+                                    (expt 2 (+ -1 k (* -1 (expo y)))))))
+                     (not (equal (* (sig y)
+                                    (expt 2 (+ -1 k)))
+                                 (* y (expt 2 (+ -1 k (* -1 (expo y)))))))))
+            ("Subgoal 2" :use ((:instance sig-multiply-normalize
+                                          (x (+ x y))
+                                          (v -1)
+                                          (w (+ K (* -1 (EXPO Y)))))))
+            ("Subgoal 1" :use ((:instance fp-rep (x y))
+                               (:instance a15 (i 2) (j1 (expo y)) 
+                                          (j2 (+ -1 K (* -1 (EXPO Y))))))))))
+
+
+
+  (local 
+   (defthm local-expt-2-expand
+     (implies (and (rationalp x)
+                   (integerp k))
+              (equal (EXPT 2 (+ -1 K (* -1 (EXPO Y))))
+                     (* 2 (EXPT 2 (+ -2 K (* -1 (EXPO Y)))))))
+     :hints (("Goal" :use ((:instance a15 (i 2) (j1 1) 
+                                      (j2 (+ -2 K (* -1 (EXPO Y))))))))))
+
+  (local 
+  (defthm integerp-x-expt-k
+    (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                  (rationalp x)
+                  (integerp k))
+             (integerp (* x (expt 2 (+ -1 k (* -1 (expo y)))))))
+    :hints (("Goal" :use ((:instance exactp2 (x x)
+                                     (n (1- (+ k (- (expo x) (expo y)))))))))))
+
+
+  (local 
+  (defthm evenp-x-expt-k
+    (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                  (rationalp x)
+                  (integerp k))
+             (evenp (* x (expt 2 (+ -1 k (* -1 (expo y)))))))
+    :hints (("Goal" :use ((:instance exactp2 (x x)
+                                     (n (1- (+ k (- (expo x) (expo y)))))))))))
+
+  (local
+   (defthm integerp-minus
+     (implies (acl2-numberp x)
+              (iff (integerp (* -1 x))
+                   (integerp x)))
+     :hints (("Goal" :in-theory (disable a2)
+              :cases ((equal (* -1 x) (- x)))))))
+              
+
+  (local 
+   (defthm even-minus
+     (implies (acl2-numberp x)
+              (iff (evenp (* -1 x))
+                   (evenp x)))
+     :hints (("Goal" :in-theory (disable a2 a5)
+              :cases ((equal (* -1 x) (- x)))))))
+
+  (defthm near-plus
+    (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                  (rationalp x)
+                  (>= x 0)
+                  (rationalp y)
+                  (>= y 0)
+                  (integerp k))
+             (= (+ x (near y k))
+                (near (+ x y)
+                      (+ k (- (expo (+ x y)) (expo y))))))
+    :hints (("Goal" :in-theory (disable evenp z f
+                                        evenp-x-expt-k
+                                        integerp-x-expt-k
+                                        LOCAL-EXPT-2-EXPAND
+                                        SIG-Y1-Y2-EQUAL near)
+             :use ((:instance near-plus-lemma-if-fl-equal)
+                   (:instance f-equal-if-difference-integerp
+                              (k1 k) (k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                              (y1 y) (y2 (+ x y)))
+                   (:instance z-difference-evenp-evenp
+                              (k1 k) (k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                              (y1 y) (y2 (+ x y)))
+                   (:instance sig-y1-y2-equal)
+                   (:instance integerp-x-expt-k)
+                   (:instance evenp-x-expt-k))))
+    :rule-classes ())
+
+
+
+
+  (local
+    (defthm near+-plus-lemma-if-fl-equal
+      (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                    (equal (f y k)
+                           (f (+ x y) (+ k (expo (+ x y)) (* -1 (expo y)))))
+                    (rationalp x)
+                    (>= x 0)
+                    (rationalp y)
+                    (>= y 0)
+                    (integerp k))
+               (= (+ x (near+ y k))
+                  (near+ (+ x y)
+                         (+ k (- (expo (+ x y)) (expo y))))))
+      :hints (("Goal" :in-theory (e/d (near+ exactp-<=) (evenp z f re))
+               :use ((:instance plus-trunc)
+                     (:instance plus-away)
+                     (:instance re-equal-if-f-equal
+                                (y1 y) (k1 k)
+                                (y2 (+ x y)) (k2 (+ k (- (expo (+ x y)) (expo y))))))))
+      :rule-classes ()))
+
+
+
+  (local 
+    (defthm integerp-x-expt-k-2
+      (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                    (rationalp x)
+                    (integerp k))
+               (integerp (* x (expt 2 (+ -1 k (* -1 (expo y)))))))
+      :hints (("Goal" :use ((:instance exactp2 (x x)
+                                       (n (+ k (- (expo x) (expo y))))))))))
+
+
+  (defthm near+-plus
+    (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                  (rationalp x)
+                  (>= x 0)
+                  (rationalp y)
+                  (>= y 0)
+                  (integerp k))
+             (= (+ x (near+ y k))
+                (near+ (+ x y)
+                       (+ k (- (expo (+ x y)) (expo y))))))
+    :hints (("Goal" :in-theory (disable evenp z f
+                                        integerp-x-expt-k-2
+                                        LOCAL-EXPT-2-EXPAND
+                                        SIG-Y1-Y2-EQUAL near+)
+             :use ((:instance near+-plus-lemma-if-fl-equal)
+                          (:instance f-equal-if-difference-integerp
+                                     (k1 k) (k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                                     (y1 y) (y2 (+ x y)))
+                          (:instance sig-y1-y2-equal)
+                          (:instance integerp-x-expt-k-2))))
+    :rule-classes ())
+)
+
+
+;----------------------------------------------------------------------
+
+;----------------------------------------------------------------------
+
+;; (defthm near-trunc
+;;     (implies (and (rationalp x) (> x 0)
+;; 		  (integerp n) (> n 1))
+;; 	     (= (near x n)
+;; 		(if (and (exactp x (1+ n)) (not (exactp x n)))
+;; 		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+;; 		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+;;   :rule-classes ())
+
+
+;; (defthm near+trunc
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (= (near+ x n)
+;; 		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+;;   :rule-classes ())
+
+;----------------------------------------------------------------------
+
+(encapsulate () 
+    ;; (defthm fp+2
+    ;;     (implies (and (rationalp x)
+    ;; 		  (> x 0)
+    ;; 		  (rationalp y)
+    ;; 		  (> y x)
+    ;; 		  (integerp n)
+    ;; 		  (> n 0)
+    ;; 		  (exactp x n)
+    ;; 		  (exactp y n))
+    ;; 	     (>= y (fp+ x n)))
+    ;;   :rule-classes ())
+
+     
+    (local (include-book "../../arithmetic/expt"))
+    ;; we just want expt-weak-monotone-linear 
+
+    (local 
+     (defun y (x m)
+       (+ (trunc x (+ 1 m)) 
+          (expt 2 (+ (* -1 m) (expo x))))))
+
+
+
+
+    ;; (local 
+    ;;  (defun y (x m)
+    ;;    (+ (trunc x (+ 1 m)) 
+    ;;       (expt 2 (+ -1 (* -1 m) (expo x))))))
+
+
+
+    ;; (defthm expo-trunc
+    ;;     (implies (and (< 0 n)
+    ;;                   (rationalp x)
+    ;; 		  (integerp n))
+    ;; 	     (equal (expo (trunc x n))
+    ;;                     (expo x))))
+
+
+    (local 
+     (defthm expt-2-less-than-specific
+       (implies (and (rationalp x)
+                     (> x 0)
+                     (integerp m)
+                     (> m 0))
+                (<= (expt 2 (+ (expo x) (* -1 M)))
+                    (EXPT 2
+                          (+ (* -1 M)
+                             (EXPO (+ (TRUNC X (+ 1 M))
+                                      (EXPT 2 (+ (EXPO X) (* -1 M)))))))))
+       :hints (("Goal" :use ((:instance trunc-lower-bound
+                                        (x x) (n (+ 1 m)))
+                             (:instance expo-monotone
+                                        (x (trunc x (+ 1 m)))
+                                        (y (+ (trunc x (+ 1 m))
+                                              (EXPT 2 (+ (EXPO X) (* -1 M))))))
+                             (:instance expt-weak-monotone-linear
+                                        (n (+ (EXPO X) (* -1 M)))
+                                        (m (+ (* -1 M)
+                                              (EXPO (+ (TRUNC X (+ 1 M))
+                                                       (EXPT 2 (+ (EXPO X) (* -1 M)))))))))))
+       :rule-classes :linear))
+
+
+
+    ;; (local 
+    ;;  (defthm expt-2-less-than-specific
+    ;;    (implies (and (rationalp x)
+    ;;                  (> x 0)
+    ;;                  (integerp m)
+    ;;                  (> m 0))
+    ;;             (<= (expt 2 (+ (expo x) (* -1 M)))
+    ;;                 (EXPT 2
+    ;;                       (+ (* -1 M)
+    ;;                          (EXPO (+ (TRUNC X (+ 1 M))
+    ;;                                   (EXPT 2 (+ -1 (EXPO X) (* -1 M)))))))))
+    ;;    :hints (("Goal" :use ((:instance trunc-lower-bound
+    ;;                                     (x x) (n (+ 1 m)))
+    ;;                          (:instance expo-monotone
+    ;;                                     (x (trunc x (+ 1 m)))
+    ;;                                     (y (+ (trunc x (+ 1 m))
+    ;;                                           (EXPT 2 (+ -1 (EXPO X) (* -1 M))))))
+    ;;                          (:instance expt-weak-monotone-linear
+    ;;                                     (n (+ (EXPO X) (* -1 M)))
+    ;;                                     (m (+ (* -1 M)
+    ;;                                           (EXPO (+ (TRUNC X (+ 1 M))
+    ;;                                                    (EXPT 2 (+ -1 (EXPO X) (* -1 M)))))))))))
+    ;;    :rule-classes :linear))
+
+    (local 
+     (defthm trunc-less-than
+       (implies (and (rationalp x)
+                     (> x 0)
+                     (integerp m))
+                (< (trunc (+ x (expt 2 (+ (* -1 m) (expo x)))) m)
+                   (fp+ (y x m) (+ 1 m))))
+       :hints (("Goal" :use ((:instance trunc-upper-pos
+                                        (x (+ x (expt 2 (+ (* -1 m) (expo x)))))
+                                        (n m))
+                             (:instance trunc-lower-bound
+                                        (x x)
+                                        (n (+ 1 m)))
+                             (:instance expt-2-less-than-specific))))))
+                             
+
+
+
+    ;; (local 
+    ;;  (defthm trunc-less-than
+    ;;    (implies (and (rationalp x)
+    ;;                  (> x 0)
+    ;;                  (integerp m))
+    ;;             (< (trunc (+ x (expt 2 (+ (* -1 m) (expo x)))) m)
+    ;;                (fp+ (y x m) (+ 1 m))))
+    ;;    :hints (("Goal" :use ((:instance trunc-upper-pos
+    ;;                                     (x (+ x (expt 2 (+ (* -1 m) (expo x)))))
+    ;;                                     (n m))
+    ;;                          (:instance trunc-lower-bound
+    ;;                                     (x x)
+    ;;                                     (n (+ 1 m)))
+    ;;                          (:instance expt-2-less-than-specific))))))
+                             
+
+
+    (local 
+     (defthm exactp-fact
+       (implies (and (rationalp x)
+                     (integerp m)
+                     (> m 0))
+                (EXACTP (TRUNC (+ X (EXPT 2 (+ (EXPO X) (* -1 M))))
+                               M)
+                        (+ 1 M)))
+       :hints (("Goal" :in-theory (enable trunc-exactp-a)
+                :use ((:instance exactp-<=
+                                 (m m)
+                                 (x (TRUNC (+ X (EXPT 2 (+ (EXPO X) (* -1 M))))
+                                           M))
+                                 (n (+ 1 m))))))))
+                                 
+
+
+    (local 
+     (defthm exactp-fact-1
+       (implies (and (rationalp x)
+                     (integerp m)
+                     (> m 0))
+                (EXACTP (TRUNC (+ X (EXPT 2 (+ (EXPO X) (* -1 M))))
+                               M)
+                        M))
+       :hints (("Goal" :in-theory (enable trunc-exactp-a)
+                :use ((:instance exactp-<=
+                                 (m m)
+                                 (x (TRUNC (+ X (EXPT 2 (+ (EXPO X) (* -1 M))))
+                                           M))
+                                 (n (+ 1 m))))))))
+                                 
+
+
+    (local 
+     (defthm exactp-fact-2
+          (implies (and (rationalp x)
+                        (> x 0)
+                        (integerp m)
+                        (> m 0))
+                   (EXACTP (+ (TRUNC X (+ 1 M))
+                              (EXPT 2 (+ (EXPO X) (* -1 M))))
+                           (+ 1 M)))
+          :hints (("Goal" :use ((:instance fp+1
+                                           (x (TRUNC X (+ 1 M)))
+                                           (n (+ 1 m))))))))
+
+
+
+
+    (local 
+     (defthm trunc-m+1-plus-is-trunc-plus-C-lemma
+       (implies (and (integerp m)
+                     (rationalp x)
+                     (> x 0)
+                     (> m 0))
+                (>= (y x m)
+                    (trunc (+ x (expt 2 (+ (* -1 m) (expo x)))) m)))
+       :hints (("Goal" :in-theory (disable fp+)
+                :use ((:instance fp+2
+                                 (y (trunc (+ x (expt 2 (+ (* -1 m) (expo x)))) m))
+                                 (x (y x m))
+                                 (n (+ 1 m)))
+                      (:instance trunc-less-than))))))
+
+
+
+    ;; (local 
+    ;;  (defun y (x m)
+    ;;    (+ (trunc x (+ 1 m)) 
+    ;;       (expt 2 (+ (* -1 m) (expo x))))))
+
+                      
+
+
+    (local 
+     (defthm trunc-m+1-plus-is-trunc-plus-C
+       (implies (and (integerp m)
+                     (rationalp x)
+                     (> x 0)
+                     (> m 0))
+                (= (trunc (y x m) m)
+                   (trunc (+ x (expt 2 (+ (* -1 m) (expo x)))) m)))
+       :hints (("Goal" :in-theory (disable fp+)
+                :use ((:instance trunc-m+1-plus-is-trunc-plus-C-lemma)
+                      (:instance trunc-exactp-c
+                                 (a (trunc (+ x (expt 2 (+ (* -1 m) (expo x)))) m))
+                                 (x (y x m))
+                                 (n m))
+                      (:instance trunc-monotone
+                                 (x (y x m))
+                                 (y (+ x (expt 2 (+ (* -1 m) (expo x)))))
+                                 (n m))
+                      (:instance trunc-upper-pos
+                                 (x x)
+                                 (n (+ 1 m))))))
+       :rule-classes nil))
+
+    ;; (defthm near+trunc
+    ;;     (implies (and (rationalp x)
+    ;; 		  (> x 0)
+    ;; 		  (integerp n)
+    ;; 		  (> n 0))
+    ;; 	     (= (near+ x n)
+    ;; 		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+    ;;   :rule-classes ())
+
+    (local
+    (defthm near+-trunc-cor-lemma
+        (implies (and (rationalp x)
+                      (> x 0)
+    		  (integerp m)
+    		  (> m 0))
+    	     (= (near+ (trunc x (+ 1 m)) m)
+    		(near+ x m)))
+        :hints (("Goal" :in-theory (enable trunc-trunc)
+                 :use ((:instance near+trunc
+                                  (x (trunc x (+ 1 m)))
+                                  (n m))
+                       (:instance near+trunc
+                                  (x x)
+                                  (n m))
+                       (:instance trunc-m+1-plus-is-trunc-plus-C))))
+      :rule-classes ()))
+
+    (local 
+    (defthm near+-trunc-cor-lemma-2
+        (implies (and (rationalp x)
+    		  (integerp m)
+    		  (> m 0))
+    	     (= (near+ (trunc x (+ 1 m)) m)
+    		(near+ x m)))
+        :hints (("Goal" :cases ((not (equal x 0)))
+                 :in-theory (enable trunc-minus near+-minus))
+                ("Subgoal 1" :cases ((not (> x 0))))
+                ("Subgoal 1.2" :use ((:instance near+-trunc-cor-lemma)))
+                ("Subgoal 1.1" :use ((:instance near+-trunc-cor-lemma
+                                                (x (* -1 x))))))
+      :rule-classes ()))
+
+
+    (defthm near+-trunc-cor
+        (implies (and (rationalp x)
+                      (integerp m)
+                      (integerp n)
+                      (> n m)
+    		  (> m 0))
+    	     (= (near+ (trunc x n) m)
+    		(near+ x m)))
+        :hints (("Goal" :cases ((not (> n (+ 1 m)))))
+                ("Subgoal 2" :use ((:instance near+-trunc-cor-lemma-2
+                                              (x (trunc x n))
+                                              (m m))
+                                   (:instance near+-trunc-cor-lemma-2
+                                              (x x)
+                                              (m m))
+                                   (:instance trunc-trunc
+                                              (x x)
+                                              (n n)
+                                              (m (+ 1 m)))))
+                ("Subgoal 1" :use ((:instance near+-trunc-cor-lemma-2))))
+      :rule-classes ())
+
+)
+
+;----------------------------------------------------------------------
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+
+;; (defund sticky (x n)
+;;   (cond ((exactp x (1- n)) x)
+;; 	(t (+ (trunc x (1- n))
+;;               (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+
+;; (i-am-here)
+
+(local 
+ (defthm sgn-x-plus-y
+   (implies (and (equal (sgn x) (sgn y))
+                 (rationalp x)
+                 (rationalp y))
+            (equal (sgn (+ x y))
+                   (sgn x)))
+   :hints (("Goal" :in-theory (enable sgn)))))
+
+(local 
+ (defthm sgn-sgn-id
+   (equal (sgn (sgn x)) 
+          (sgn x))
+   :hints (("Goal" :in-theory (enable sgn)))))
+
+(local 
+ (defthm sgn-expt-1
+   (equal (SGN (EXPT 2 n))
+          1)
+   :hints (("Goal" :in-theory (enable sgn)))))
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x)))
+    :hints (("Goal" :in-theory (enable sticky  
+                                       sgn-trunc
+                                       sgn-prod)
+             :cases ((not (> n 1))))
+            ("Subgoal 2" 
+             :use ((:instance sgn-x-plus-y
+                              (x (trunc x (+ -1 n)))
+                              (y (* (SGN X)
+                                    (EXPT 2 (+ 1 (EXPO X) (* -1 N))))))))))
+
+(local 
+ (defthm positive-sgn-1
+   (implies (rationalp x)
+            (iff (equal (sgn x) 1)
+                 (> x 0)))
+   :hints (("Goal" :in-theory (enable sgn)))))
+
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+    :hints (("Goal" :use ((:instance sgn-sticky)
+                          (:instance positive-sgn-1
+                                     (x x))
+                          (:instance positive-sgn-1
+                                     (x (sticky x n))))))
+  :rule-classes :linear)
+
+(local 
+ (defthm positive-sgn-2
+   (implies (rationalp x)
+            (iff (equal (sgn x) -1)
+                 (< x 0)))
+   :hints (("Goal" :in-theory (enable sgn)))))
+
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+    :hints (("Goal" :use ((:instance sgn-sticky)
+                          (:instance positive-sgn-2
+                                     (x x))
+                          (:instance positive-sgn-2
+                                     (x (sticky x n))))))
+  :rule-classes :linear)
+
+;; (defthm sticky-0
+;;   (equal (sticky 0 n) 0))
+
+
+;; (defthmd sticky-minus
+;;   (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+
+;; (defthm sticky-shift
+;;     (implies (and (rationalp x)
+;; 		  (integerp n) (> n 0)
+;; 		  (integerp k))
+;; 	     (= (sticky (* (expt 2 k) x) n)
+;; 		(* (expt 2 k) (sticky x n))))		
+;;   :rule-classes ())
+
+
+;; (defthm expo-sticky
+;;     (implies (and (rationalp x) (> x 0)
+;; 		  (integerp n) (> n 0))
+;; 	     (= (expo (sticky x n))
+;; 		(expo x)))
+;;   :rule-classes ())
+
+
+(local 
+ (defthm sticky-exactp-a-lemma
+    (implies (and (rationalp x)
+                  (> x 0)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+    :hints (("Goal" :in-theory (enable sgn exactp-2**n sticky)
+             :cases ((not (equal n 1))))
+            ("Subgoal 1" 
+             :use ((:instance trunc-exactp-a (n (- 1 n)))
+                   (:instance fp+1 
+                              (x (trunc x (+ -1 n)))
+                              (n n))
+                   (:instance exactp-<=
+                              (m (+ -1 n))
+                              (n n)
+                              (x (trunc x (+ -1 n))))
+                   (:instance exactp-<=
+                              (m (+ -1 n))
+                              (n n)
+                              (x x)))))
+    :rule-classes ()))
+
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+    :hints (("Goal" :cases ((not (equal x 0)))
+             :in-theory (enable sticky-minus))
+            ("Subgoal 2" :in-theory (enable sticky exactp))
+            ("Subgoal 1" :cases ((not (> x 0))))
+            ("Subgoal 1.2" :use ((:instance sticky-exactp-a-lemma)))
+            ("Subgoal 1.1" :use ((:instance sticky-exactp-a-lemma
+                                            (x (* -1 x))))))
+    :rule-classes ())
+
+
+(local 
+  (defthm sig-fact
+    (implies (and (rationalp x)
+                  (> x 0))
+             (iff (equal (EXPT 2 (EXPO X)) x)
+                  (INTEGERP (SIG X))))
+    :hints (("Goal" :use ((:instance fp-rep)
+                          (:instance sig-lower-bound)
+                          (:instance sig-upper-bound))
+             :in-theory (enable sgn))
+            ("Subgoal 1" :cases ((not (< 1 (sig x))))))))
+
+
+(local
+ (defthm sticky-exactp-b-lemma
+    (implies (and (rationalp x)
+                  (> x 0)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+    :hints (("Goal" :in-theory (enable expo-trunc 
+                                       trunc-exactp-a
+                                       sig-upper-bound
+                                       sig-lower-bound
+                                exactp-2**n sticky sgn)
+             :cases ((not (exactp x (+ -1 n)))))
+            ("Subgoal 2" :use ((:instance exactp-<=
+                                          (m (+ -1 n))
+                                          (n n)
+                                          (x x))))
+            ("Subgoal 1" :cases ((not (equal n 1))))
+            ("Subgoal 1.2" :in-theory (enable exactp
+                                              exactp-2**n
+                                              sticky sgn))
+            ("Subgoal 1.1" :use ((:instance trunc-midpoint
+                                            (x x)
+                                            (n (+ -1 n)))
+                                 (:instance fp+1 
+                                            (x (trunc x (+ -1 n)))
+                                            (n n))
+                                 (:instance exactp-<=
+                                          (m (+ -1 n))
+                                          (n n)
+                                          (x (trunc x (+ -1 n)))))))
+  :rule-classes ()))
+
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+    :hints (("Goal" :cases ((not (equal x 0)))
+             :in-theory (enable sticky-minus))
+            ("Subgoal 2" :in-theory (enable sticky exactp))
+            ("Subgoal 1" :cases ((not (> x 0))))
+            ("Subgoal 1.2" :use ((:instance sticky-exactp-b-lemma)))
+            ("Subgoal 1.1" :use ((:instance sticky-exactp-b-lemma
+                                            (x (* -1 x))))))
+    :rule-classes ())
+
+;; (local 
+;;  (defthm fl-1/2-sig-x-is-zero-lemma
+;;    (implies (and (rationalp x)
+;;                  (rationalp y)
+;;                  (< 0 y)
+;;                  (<= y 1/2))
+;;             (equal (fl (* (sig x) y))
+;;                    0))
+;;    :hints (("Goal" :use ((:instance sig-upper-bound)
+;;                          (:instance sig-lower-bound))))))
+
+
+
+;; (local 
+;;   (defthm |1/2-sig-x-not-integerp-lemma|
+;;     (implies (and (rationalp x)
+;;                   (not (equal x 0))
+;;                   (rationalp y)
+;;                   (< 0 y)
+;;                   (<= y 1/2))
+;;              (not (integerp (* (sig x) y))))
+;;     :hints (("Goal" :use ((:instance sig-upper-bound)
+;;                           (:instance sig-lower-bound))))))
+
+
+;; (local (include-book "../../arithmetic/expt"))
+
+;; (local 
+;;  (defthm exactp-minus-fact
+;;    (implies (and (integerp n)
+;;                  (rationalp x)
+;;                  (not (equal x 0))
+;;                  (<= n 0))
+;;             (not (exactp x n)))
+;;    :hints (("Goal" :in-theory (enable exactp)
+;;             :use ((:instance sig-upper-bound)
+;;                   (:instance sig-lower-bound)
+;;                   (:instance |1/2-sig-x-not-integerp-lemma|
+;;                              (y (expt 2 (+ -1 n))))
+;;                   (:instance expt-weak-monotone-linear
+;;                              (n (+ -1 n))
+;;                              (m -1)))))))
+
+;; (defthmd sticky-monotone
+;;   (implies (and (<= x y)
+;;                 (rationalp x)
+;;                 (rationalp y)
+;;                 (natp n))
+;;            (<= (sticky x n) (sticky y n)))
+;;   :hints (("Goal" :cases ((not (equal n 0)))
+;;            :in-theory (enable sticky sgn))
+;;           ("Subgoal 2" :cases ((not (equal y 0))))
+;;           ("Subgoal 2.1" :use ((:instance expo-monotone
+;;                                           (y x)
+;;                                           (x y))
+;;                                (:instance expo-monotone
+;;                                           (x x)
+;;                                           (y y))
+;;                                (:instance expt-weak-monotone-linear
+;;                                           (n (+ 1 (expo y)))
+;;                                           (m (+ 1 (expo x))))
+;;                                (:instance expt-weak-monotone-linear
+;;                                           (n (+ 1 (expo x)))
+;;                                           (m (+ 1 (expo y))))))
+;;           ("Subgoal 1" :use ((:instance sticky-monotone---rtl-rel5-support))))
+;;   :rule-classes :linear)
+
+
+;; (defthm sticky-exactp-m
+;;     (implies (and (rationalp x)
+;; 		  (integerp m)
+;; 		  (integerp n) 
+;; 		  (> n m)
+;; 		  (> m 0))
+;; 	     (iff (exactp (sticky x n) m)
+;; 		  (exactp x m)))
+;;   :rule-classes ())
+
+;; (i-am-here)
+
+;; (defthm trunc-sticky
+;;     (implies (and (rationalp x)
+;; 		  (integerp m) (> m 0)
+;; 		  (integerp n) (> n m))
+;; 	     (= (trunc (sticky x n) m)
+;; 		(trunc x m)))
+;;     :hints (("Goal" :cases ((not (equal x 0))))
+;;             ("Subgoal 1" :cases ((not (> x 0))))
+;;             ("Subgoal 1.2" :use ((:instance trunc-sticky---rtl-rel5-support)))
+;;             ("Subgoal 1.1" :use ((:instance trunc-sticky---rtl-rel5-support
+;;                                             (x (* -1 x))))
+;;              :in-theory (enable trunc-minus sticky-minus)))
+;;   :rule-classes ())
+
+
+;; (defthm away-sticky
+;;     (implies (and (rationalp x)
+;; 		  (integerp m) (> m 0)
+;; 		  (integerp n) (> n m))
+;; 	     (= (away (sticky x n) m)
+;; 		(away x m)))
+;;     :hints (("Goal" :cases ((not (equal x 0))))
+;;             ("Subgoal 1" :cases ((not (> x 0))))
+;;             ("Subgoal 1.2" :use ((:instance away-sticky---rtl-rel5-support)))
+;;             ("Subgoal 1.1" :use ((:instance away-sticky---rtl-rel5-support
+;;                                             (x (* -1 x))))
+;;              :in-theory (enable away-minus sticky-minus)))
+;;   :rule-classes ())
+
+
+;; (defthm near-sticky
+;;     (implies (and (rationalp x)
+;; 		  (integerp m) (> m 0)
+;; 		  (integerp n) (> n (1+ m)))
+;; 	     (= (near (sticky x n) m)
+;; 		(near x m)))
+;;     :hints (("Goal" :cases ((not (equal x 0))))
+;;             ("Subgoal 1" :cases ((not (> x 0))))
+;;             ("Subgoal 1.2" :use ((:instance near-sticky---rtl-rel5-support)))
+;;             ("Subgoal 1.1" :use ((:instance near-sticky---rtl-rel5-support
+;;                                             (x (* -1 x))))
+;;              :in-theory (enable near-minus sticky-minus)))
+;;   :rule-classes ())
+
+
+;----------------------------------------------------------------------
+
+
+;; (defthm near+-sticky
+;;     (implies (and (rationalp x)
+;; 		  (integerp m) (> m 0)
+;; 		  (integerp n) (> n (1+ m)))
+;; 	     (= (near+ (sticky x n) m)
+;; 		(near+ x m)))
+;;     :hints (("Goal" :use ((:instance near+-trunc-cor
+;;                                      (x (sticky x n))
+;;                                      (n (+ 1 m))
+;;                                      (m m))
+;;                           (:instance trunc-sticky
+;;                                      (m (+ 1 m)))
+;;                           (:instance near+-trunc-cor
+;;                                      (x x)
+;;                                      (n (+ 1 m))
+;;                                      (m m)))))
+;;   :rule-classes ())
+
+;----------------------------------------------------------------------
+
+;; (defthm sticky-sticky
+;;     (implies (and (rationalp x)
+;; 		  (integerp m)
+;; 		  (> m 1)
+;; 		  (integerp n)
+;; 		  (>= n m))
+;; 	     (= (sticky (sticky x n) m)
+;; 		(sticky x m)))
+;;   :rule-classes ())
+
+;----------------------------------------------------------------------
+
+;;
+;; sticky-plus---rtl-rel5-support
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (rationalp y)
+;; 		  (> y 0)
+;; 		  (integerp k)
+;; 		  (= k1 (+ k (- (expo x) (expo y))))
+;; 		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+;; 		  (> k 1)
+;; 		  (> k1 1)
+;; 		  (> k2 1)
+;; 		  (exactp x (1- k1)))
+;; 	     (= (+ x (sticky y k))
+;; 		(sticky (+ x y) k2)))
+;;     :hints (("Goal" :by sticky-plus))
+;;   :rule-classes ())
+;;
+;; doesn't support well. Tue Jan 31 12:56:09 2006
+;;
+
+;;   (defthm trunc-plus-minus
+;;     (implies (and (rationalp x)
+;;                   (rationalp y)
+;;                   (not (= x 0))
+;;                   (not (= y 0))
+;;                   (not (= (+ x y) 0))
+;;                   (integerp k)
+;;                   (> k 0)
+;;                   (= k1 (+ k (- (expo x) (expo y))))
+;;                   (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+;;                   (exactp x k1)
+;;                   (> k2 0))
+;;              (equal (+ x (trunc y k))
+;;                     (if (= (sgn (+ x y)) (sgn y))
+;;                         (trunc (+ x y) k2)
+;;                       (away (+ x y) k2))))
+
+
+
+(encapsulate ()
+
+   (local 
+    (defthm exactp-fact-1
+      (implies (and (EXACTP X  (+ -1 K (EXPO X) (* -1 (EXPO Y))))
+                    (rationalp x)
+                    (rationalp y)
+                    (integerp k))
+               (iff (exactp (+ x y) (+ -1 K (* -1 (EXPO Y))
+                                       (EXPO (+ X Y))))
+                    (exactp y  (+ -1 k))))
+      :hints (("Goal" :in-theory (enable exactp2)))))
+
+
+
+   (local 
+    (defthm local-expt-2-expand
+      (implies (and (rationalp x)
+                    (integerp k))
+               (equal (EXPT 2 (+ 2 (EXPO Y) (* -1 K)))
+                      (* 2 (EXPT 2 (+ 1 (EXPO Y) (* -1 k))))))
+      :hints (("Goal" :use ((:instance a15 (i 2) (j1 1) 
+                                       (j2 (+ 1 (EXPO Y)
+                                              (* -1 k)))))))))
+ 
+   (defthm sticky-plus
+     (implies (and (rationalp x)
+                   (rationalp y)
+                   (not (= y 0))
+                   (not (= (+ x y) 0))
+                   (integerp k)
+                   (= k1 (+ k (- (expo x) (expo y))))
+                   (= k2 (+ k (- (expo (+ x y)) (expo y))))
+                   (> k 1)
+                   (> k1 1)
+                   (> k2 1)
+                   (exactp x (1- k1)))
+              (= (+ x (sticky y k))
+                 (sticky (+ x y) k2)))
+     :hints (("Goal" :cases ((not (exactp y (+ -1 k))))
+              :in-theory (enable sticky))
+             ("Subgoal 1" :use ((:instance trunc-plus-minus
+                                           (k1 (+ -1 k (expo x) (* -1 (expo y))))
+                                           (k2 (+ -1 k (* -1 (expo y)) (expo (+
+                                                                              x
+                                                                              y))))
+                                           (k (+ -1 k)))))
+             ("Subgoal 1.1" :cases ((not (> (+ x y) 0))))
+             ("Subgoal 1.1.2" :use ((:instance trunc-away 
+                                               (x (+ x y))
+                                               (n (+ -1 K (* -1 (EXPO Y))
+                                                     (EXPO (+ X Y))))))
+              :in-theory (enable sgn expo-minus trunc-minus away-minus))
+             ("Subgoal 1.1.1" :use ((:instance trunc-away 
+                                               (x (* -1 (+ x y)))
+                                               (n (+ -1 K (* -1 (EXPO Y))
+                                                     (EXPO (+ X Y))))))
+              :in-theory (enable sgn expo-minus trunc-minus away-minus)))
+     :rule-classes ()))
+
+
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+;; (i-am-here);; Fri Oct 13 15:10:44 2006
+;; (defun inf (x n)
+;;   (if (>= x 0)
+;;       (away x n)
+;;     (trunc x n)))
+
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+    :hints (("Goal" :use ((:instance trunc-upper-bound)
+                          (:instance away-lower-bound)))
+            ("Subgoal 1" :cases ((not (equal x 0)))))
+  :rule-classes :linear)
+
+
+;; (defun minf (x n)
+;;   (if (>= x 0)
+;;       (trunc x n)
+;;     (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+    :hints (("Goal" :use ((:instance trunc-upper-bound)
+                          (:instance away-lower-bound))))
+  :rule-classes :linear)
+
+;; (defund IEEE-mode-p (mode)
+;;   (member mode '(trunc inf minf near)))
+
+
+;; (defun common-rounding-mode-p (mode)
+;;   (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+;; (defthmd ieee-mode-p-implies-common-rounding-mode-p
+;;   (implies (IEEE-mode-p mode)
+;;            (common-rounding-mode-p mode)))
+
+;; (defund rnd (x mode n)
+;;   (case mode
+;;     (away (away x n))
+;;     (near+ (near+ x n))
+;;     (trunc (trunc x n))
+;;     (inf (inf x n))
+;;     (minf (minf x n))
+;;     (near (near x n))
+;;     (otherwise 0)))
+
+
+;; (defthm rationalp-rnd
+;;   (rationalp (rnd x mode n))
+;;   :rule-classes (:type-prescription))
+
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :hints (("Goal" :use ((:instance near+-choice)
+                        (:instance near-choice))
+           :in-theory (enable rnd IEEE-mode-p)))
+  :rule-classes ())
+
+;; (encapsulate ()
+;;    (local 
+;;     (defthm not-rational-rnd-redcue-to-zero
+;;       (implies (not (rationalp x))
+;;                (equal (rnd x mode n) 0))
+;;       :hints (("Goal" :in-theory (enable away near sig trunc near+ rnd)))))
+
+;;    (local 
+;;     (defthm not-rational-sgn-redcue-to-zero
+;;       (implies (not (rationalp x))
+;;                (equal (sgn x) 0))
+;;       :hints (("Goal" :in-theory (enable sgn)))))
+
+
+;;    (defthmd sgn-rnd
+;;        (implies (and (common-rounding-mode-p mode)
+;;                      (integerp n)
+;;                      (> n 0))
+;;    	     (equal (sgn (rnd x mode n))
+;;    		    (sgn x)))
+;;        :hints (("Goal" :cases ((not (rationalp x)))
+;;                 :in-theory 
+;;                 (enable sgn-away sgn-trunc 
+;;                      sgn-near rnd IEEE-mode-p)))))
+
+
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :hints (("Goal" 
+           :in-theory 
+           (enable rnd IEEE-mode-p)))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :hints (("Goal" 
+           :in-theory 
+           (enable rnd near IEEE-mode-p)))
+  :rule-classes (:type-prescription))
+
+;; (defthm rnd-0
+;;   (equal (rnd 0 mode n)
+;;          0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+;; (defthm rnd-non-pos
+;;     (implies (<= x 0)
+;; 	     (<= (rnd x mode n) 0))
+;;   :rule-classes (:rewrite :type-prescription :linear))
+
+;; (defthm rnd-non-neg
+;;     (implies (<= 0 x)
+;; 	     (<= 0 (rnd x mode n)))
+;;   :rule-classes (:rewrite :type-prescription :linear))
+
+;; (defund flip (m)
+;;   (case m
+;;     (inf 'minf)
+;;     (minf 'inf)
+;;     (t m)))
+
+;; (defthm ieee-mode-p-flip
+;;     (implies (ieee-mode-p m)
+;; 	     (ieee-mode-p (flip m))))
+
+
+;; (defthm common-rounding-mode-p-flip
+;;     (implies (common-rounding-mode-p m)
+;; 	     (common-rounding-mode-p (flip m))))
+
+
+;; (defthmd rnd-minus
+;;   (equal (rnd (* -1 x) mode n)
+;;          (* -1 (rnd x (flip mode) n))))
+
+
+
+
+;; (defthm rnd-exactp-a
+;;     (implies (< 0 n)
+;; 	     (exactp (rnd x mode n) n))
+;;     :hints (("Goal" :by rnd-exactp-b---rtl-rel5-support)))
+
+
+;; (defthm rnd-exactp-b
+;;   (implies (and (rationalp x)
+;;                 (common-rounding-mode-p mode)
+;;                 (integerp n) 
+;;                 (> n 0))
+;;            (equal (equal x (rnd x mode n))
+;; 		  (exactp x n)))
+;;   :hints (("Goal" :use ((:instance rnd-exactp-a---rtl-rel5-support)))))
+
+
+;; (defthmd rnd-exactp-c
+;;     (implies (and (rationalp x)
+;; 		  (common-rounding-mode-p mode)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (>= a x))
+;; 	     (>= a (rnd x mode n)))
+;;     :hints (("Goal" :in-theory (enable trunc-minus 
+;;                                        ieee-mode-p flip rnd)
+;;              :use ((:instance trunc-exactp-c
+;;                               (x (* -1 x)) (a (* -1 a)))
+;;                    (:instance away-exactp-c)
+;;                    (:instance near-exactp-c)
+;;                    (:instance near+-exactp-c)))))
+
+
+;; (defthmd rnd-exactp-d
+;;     (implies (and (rationalp x)
+;; 		  (common-rounding-mode-p mode)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (<= a x))
+;; 	     (<= a (rnd x mode n)))
+;;     :hints (("Goal" :in-theory (enable away-minus 
+;;                                        ieee-mode-p flip rnd)
+;;              :use ((:instance trunc-exactp-c)
+;;                    (:instance away-exactp-c
+;;                               (x (* -1 x)) (a (* -1 a)))
+;;                    (:instance near-exactp-d)
+;;                    (:instance near+-exactp-d)))))
+
+
+;; (defthm rnd<=away
+;;     (implies (and (rationalp x)
+;; 		  (>= x 0)
+;; 		  (common-rounding-mode-p mode)
+;; 		  (natp n))
+;; 	     (<= (rnd x mode n) (away x n)))
+;;     :hints (("Goal" :in-theory (enable ieee-mode-p
+;;                                        near near+
+;;                                        minf inf
+;;                                        trunc-upper-pos
+;;                                        away-lower-pos
+;;                                        flip rnd)))
+;;   :rule-classes ())
+
+
+
+;; (defthm rnd>=trunc
+;;     (implies (and (rationalp x)
+;; 		  (>= x 0)
+;; 		  (common-rounding-mode-p mode)
+;; 		  (natp n))
+;; 	     (>= (rnd x mode n) (trunc x n)))
+;;     :hints (("Goal" :in-theory (enable ieee-mode-p
+;;                                        near near+
+;;                                        inf minf
+;;                                        common-rounding-mode-p
+;;                                        trunc-upper-pos
+;;                                        away-lower-pos
+;;                                        flip rnd)))
+;;   :rule-classes ())
+
+
+;; (defthmd rnd-diff
+;;   (implies (and (rationalp x)
+;;                 (integerp n)
+;;                 (> n 0)
+;;                 (common-rounding-mode-p mode))
+;;            (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n))))
+;;   :hints (("Goal" :use ((:instance rnd-diff---rtl-rel5-support)))))
+
+;; (i-am-here) ;; Fri Oct 13 15:29:42 2006
+
+;; (defthm expo-rnd
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (common-rounding-mode-p mode)
+;; 		  (not (= (abs (rnd x mode n))
+;; 			  (expt 2 (1+ (expo x))))))
+;; 	     (= (expo (rnd x mode n))
+;; 		(expo x)))
+;;   :hints (("Goal" :use ((:instance expo-rnd---rtl-rel5-support))))
+;;   :rule-classes ())
+
+
+;; (encapsulate ()
+
+;; (local 
+;;  (defthm |Subgoal 5|
+;;    (IMPLIES (AND (RATIONALP X)
+;;                  (RATIONALP Y)
+;;                  (INTEGERP N)
+;;                  (<= 0 N)
+;;                  (<= 0 Y)
+;;                  (< X 0))
+;;             (<= (TRUNC X N) (AWAY Y N)))
+;;    :hints (("Goal" :cases ((not (equal y 0)))
+;;             :in-theory (enable trunc-negative sgn
+;;                                away-positive)))
+;;    :rule-classes :linear))
+
+
+
+;; ;; (defthm near+-monotone
+;; ;;   (implies (and (<= x y)
+;; ;;                 (rationalp x)
+;; ;;                 (rationalp y)
+;; ;;                 (< 0 x)    ;;; not good enough!!! 
+;; ;;                 (integerp n)
+;; ;;                 (> n 0))   
+;; ;;            (<= (near+ x n) (near+ y n))))
+
+
+;; (defthmd rnd-monotone
+;;     (implies (and (<= x y)
+;;                   (rationalp x)
+;; 		  (rationalp y)
+;; 		  (common-rounding-mode-p mode)
+;;                   (integerp n)
+;;                   (> n 0))
+;; 	     (<= (rnd x mode n) (rnd y mode n)))
+;;     :hints (("Goal" :in-theory (enable ieee-mode-p
+;;                                        common-rounding-mode-p
+;;                                 trunc-positive
+;;                                 trunc-negative
+;;                                 away-positive
+;;                                 away-negative
+;;                                 away-monotone
+;;                                 trunc-monotone
+;;                                 near-monotone
+;;                                 near+-monotone
+;;                                 flip rnd)
+;;              :use ((:instance away-monotone)))))
+
+;; )
+
+
+;; (defthm rnd-shift
+;;     (implies (and (rationalp x)
+;; 		  (integerp n)
+;; 		  (common-rounding-mode-p mode)
+;; 		  (integerp k))
+;; 	     (= (rnd (* x (expt 2 k)) mode n)
+;; 		(* (rnd x mode n) (expt 2 k))))
+;;     :hints (("Goal" :use ((:instance rnd-shift---rtl-rel5-support))))
+;;   :rule-classes ())
+
+
+;; (defthm plus-rnd
+;;   (implies (and (rationalp x)
+;;                 (>= x 0)
+;;                 (rationalp y)
+;;                 (>= y 0)
+;;                 (integerp k)
+;;                 (exactp x (+ -1 k (- (expo x) (expo y))))
+;;                 (common-rounding-mode-p mode))
+;;            (= (+ x (rnd y mode k))
+;;               (rnd (+ x y)
+;;                    mode
+;;                    (+ k (- (expo (+ x y)) (expo y))))))
+;;   :hints (("Goal" :use ((:instance plus-rnd---rtl-rel5-support))))
+;;   :rule-classes ())
+
+
+;; (defthmd rnd-sticky
+;;   (implies (and (common-rounding-mode-p mode)
+;;                 (rationalp x)
+;;                 (integerp m) 
+;; 		(> m 0)
+;;                 (integerp n) 
+;; 		(>= n (+ m 2)))
+;;            (equal (rnd (sticky x n) mode m)
+;;                   (rnd x mode m)))
+;;   :hints (("Goal" :cases ((not (equal x 0)))
+;;            :in-theory (enable rnd-minus flip rnd sticky-minus))
+;;           ("Subgoal 1" :cases ((not (> x 0))))
+;;           ("Subgoal 1.2" 
+;;            :use ((:instance rnd-sticky---rtl-rel5-support
+;;                                         (k m))))
+;;           ("Subgoal 1.1" 
+;;            :use ((:instance rnd-sticky---rtl-rel5-support
+;;                                         (k m)
+;;                                         (mode (flip mode))
+;;                                         (x (* -1 x)))))))
+
+
+
+
+;; (defun rnd-const (e mode n)
+;;   (case mode
+;;     ((near near+) (expt 2 (- e n)))
+;;     ((inf away) (1- (expt 2 (1+ (- e n)))))
+;;     (otherwise 0)))
+
+
+;; (defthm rnd-const-thm
+;;     (implies (and (common-rounding-mode-p mode)
+;; 		  (integerp n)
+;; 		  (> n 1)
+;; 		  (integerp x)
+;; 		  (> x 0)
+;; 		  (>= (expo x) n))
+;; 	     (= (rnd x mode n)
+;; 		(if (and (eql mode 'near)
+;; 			 (exactp x (1+ n))
+;; 			 (not (exactp x n)))
+;; 		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+;; 		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+;;     :hints (("Goal" :use rnd-const-thm---rtl-rel5-support))
+;;   :rule-classes ())
+
+
+;; (defun roundup (x mode n)
+;;   (case mode
+;;     (near+ (= (bitn x (- (expo x) n)) 1))
+;;     (near (and (= (bitn x (- (expo x) n)) 1)
+;;                (or (not (exactp x (1+ n)))
+;;                    (= (bitn x (- (1+ (expo x)) n)) 1))))
+;;     ((inf away) (not (exactp x n)))
+;;     (otherwise ())))
+
+
+;; (defthm roundup-thm
+;;     (implies (and (common-rounding-mode-p mode)
+;; 		  (integerp n)
+;; 		  (> n 1)
+;; 		  (integerp x)
+;; 		  (> x 0)
+;; 		  (>= (expo x) n))
+;; 	     (= (rnd x mode n)
+;;                 (if (roundup x mode n)
+;;                     (fp+ (trunc x n) n)
+;;                   (trunc x n))))
+;;     :hints (("Goal" :use roundup-thm---rtl-rel5-support))
+;;   :rule-classes ())
+
+;;;
+;;; very nice theorems!! good!! Tue Jan 31 16:37:49 2006
+;;; relating bits and their rounded values!! 
+;;;
+
+;;; Sun Oct 15 16:41:11 2006
+
+;; (i-am-here) ;; Sun Oct 15 17:00:23 2006
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+;;; because of the drnd definition changed, we abandon all the proofs in
+;;; lib/round.lisp
+;;;
+;;; we could prove that two definitions are the same thus reuse the older
+;;; proofs!
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q)))
+  :hints (("Goal" :in-theory (enable drnd expo-minus  rnd-minus))))
+
+;----------------------------------------------------------------------
+
+(local (include-book "../../arithmetic/expt"))
+
+(local 
+ (encapsulate ()
+
+       (local 
+          (defthm fl-1/2-sig-x-is-zero-lemma
+            (implies (and (rationalp x)
+                          (rationalp y)
+                          (< 0 y)
+                          (<= y 1/2))
+                     (equal (fl (* (sig x) y))
+                            0))
+            :hints (("Goal" :use ((:instance sig-upper-bound)
+                                  (:instance sig-lower-bound))))))
+
+       ;; we really need these two lemma
+       (defthm fl-1/2-sig-x-is-zero-lemma-2
+         (implies (and (rationalp x)
+                       (rationalp y)
+                       (not (equal x 0))
+                       (< 0 y)
+                       (<= y 1/2))
+                  (equal (fl (* -1 (sig x) y))
+                         -1))
+         :hints (("Goal" :in-theory (enable sig fl-minus)
+                  :use ((:instance fl-1/2-sig-x-is-zero-lemma)))))
+
+       (defthm expt-2-no-greater-than-1 
+            (implies (and (<= (+ p (expo x))
+                              (expo (spn q)))
+                          (integerp p))
+                     (<= (* 2
+                            (EXPT 2
+                                  (+ -1 P (EXPO X)
+                                     (* -1 (EXPO (SPN Q))))))
+                         1))
+            :hints (("Goal" :use ((:instance expt-weak-monotone-linear
+                                             (n (+ -1 P (EXPO X)
+                                                   (* -1 (EXPO (SPN Q)))))
+                                             (m -1)))))
+            :rule-classes :linear)
+
+       (defthm fl-1/2-sig-x-is-zero
+           (implies (and (rationalp x)
+                         (case-split (not (equal x 0)))
+                         (integerp p)
+                         (<= (+ p (expo x))
+                             (expo (spn q))))
+                    (equal (FL (* (SIG X)
+                                  (EXPT 2
+                                        (+ -1 P (EXPO X)
+                                           (* -1 (EXPO (SPN Q)))))))
+                           0))
+           :hints (("Goal" :use ((:instance fl-1/2-sig-x-is-zero-lemma
+                                            (y (EXPT 2
+                                                     (+ -1 P (EXPO X) 
+                                                        (* -1 (EXPO (SPN q)))))))))))
+
+
+       (defthm fl-1/2-sig-x-is-zero-2
+           (implies (and (rationalp x)
+                         (case-split (not (equal x 0)))
+                         (integerp p)
+                         (<= (+ p (expo x))
+                             (expo (spn q))))
+                    (equal (FL (* -1 (SIG X)
+                                  (EXPT 2
+                                        (+ -1 P (EXPO X)
+                                           (* -1 (EXPO (SPN Q)))))))
+                           -1))
+           :hints (("Goal" :use ((:instance fl-1/2-sig-x-is-zero-lemma-2
+                                            (y (EXPT 2
+                                                     (+ -1 P (EXPO X) 
+                                                        (* -1 (EXPO (SPN q)))))))))))))
+
+
+;----------------------------------------------------------------------
+
+(encapsulate () 
+
+
+;;; prove the first condition in drepp 
+             ;;
+             ;;L d            (DEFUN DREPP (X P Q)
+             ;;                      (AND (RATIONALP X)
+             ;;                           (NOT (= X 0))
+             ;;                           (<= (- 2 P) (+ (EXPO X) (BIAS Q)))
+             ;;                           (<= (+ (EXPO X) (BIAS Q)) 0)
+             ;;                           (EXACTP X (+ -2 P (EXPT 2 (- Q 1)) (EXPO X)))))
+
+             (local (encapsulate ()
+;;;;
+;;;;          (<= (+ (EXPO X) (BIAS Q)) 0)  if x < (spn q)
+;;;; 
+                                 (local
+                                  (defthm expo-less-than-minus-1-lemma
+                                    (IMPLIES (AND (< N (EXPO X))
+                                                  (< 0 X)
+                                                  (integerp n)
+                                                  (RATIONALP X))
+                                             (<= (EXPT 2 (+ 1 N)) X))
+                                    :hints (("Goal" :use ((:instance expt-weak-monotone-linear
+                                                                     (n (+ 1 n))
+                                                                     (m (expo x)))
+                                                          (:instance expo-lower-bound))))))
+
+                                 (local
+                                  (defthm expo-less-than-minus-1
+                                    (implies (and (< 0 x)
+                                                  (integerp n)
+                                                  (rationalp x)
+                                                  (< X (EXPT 2 (+ 1 n))))
+                                             (<= (expo x) n))
+                                    :hints (("Goal" :cases ((> (expo x) n))))
+                                    :rule-classes :linear))
+
+                                 (defthm less-than-spn-implies-expo-less
+                                   (implies (and (< (abs x) (spn q))
+                                                 (> q 0)
+                                                 (> x 0)
+                                                 (integerp q)
+                                                 (rationalp x))
+                                            (>= 0 (+ (bias q) (expo x))))
+                                   :hints (("Goal" :in-theory (enable spn expo-minus)
+                                            :use ((:instance expo-monotone (x (abs x)) (y (spn q))))))
+                                   :rule-classes :linear))
+
+                    ) ;;; END OF    (<= (+ (EXPO X) (BIAS Q)) 0)  if x < (spn q)
+
+
+             (local (encapsulate () 
+
+;;;
+;;;     (EXACTP X (+ -2 P (EXPT 2 (- Q 1)) (EXPO X)))))
+;;;
+
+                                 (defthm exactp-drnd-specific
+                                   (implies (and (rationalp x)
+                                                 (> (+ p (expo x))
+                                                    (expo (spn q)))
+                                                 (integerp p)
+                                                 (integerp q)
+                                                 (> q 0))
+                                            (EXACTP (DRND X MODE P Q)
+                                                    (+ -2 P (EXPO X) (EXPT 2 (+ -1 Q)))))
+                                   :hints (("Goal" :in-theory (enable drnd spn bias)
+                                            :use ((:instance RND-EXACTP-A
+                                                             (X x) (mode MODE)
+                                                             (n (+ -1 P (BIAS Q) (EXPO X)))))))))
+                    ) ;;; END OF  (EXACTP X (+ -2 P (EXPT 2 (- Q 1)) (EXPO X)))))
+
+
+
+             (local (encapsulate () 
+
+                                 (local
+                                  (defthm expt-equal-specific-lemma
+                                    (implies (and (EQUAL 0 (+ y x))
+                                                  (integerp x)
+                                                  (integerp y))
+                                             (equal (expt 2 (+ 1 x))
+                                                    (expt 2 (+ 1 (* -1 y)))))
+                                    :hints (("Goal" :cases ((equal x (* -1 y)))))))
+
+
+                                 (defthm expt-equal-specific
+                                   (implies (and (EQUAL 0 (+ (BIAS Q) (EXPO X)))
+                                                 (rationalp x)
+                                                 (integerp q)
+                                                 (> q 0))
+                                            (equal (expt 2 (+ 1 (expo x)))
+                                                   (expt 2 (+ 1 (* -1 (bias q))))))
+                                   :hints (("Goal" :cases ((equal (expo x)
+                                                                  (* -1 (bias q)))))))
+                                 )) ;; don't know why we need this. 
+
+
+
+
+             (local (encapsulate () 
+
+                                 (defthm minus-expt-reduce
+                                   (implies (and (integerp p)
+                                                 (integerp q)
+                                                 (> q 0)
+                                                 (rationalp x))
+                                            (equal (+ -1 P (EXPO X) (EXPT 2 (+ -1 Q)))
+                                                   (+ 1 p (expo x) (* -1 (expo (spn q))))))
+                                   :hints (("Goal" :in-theory (enable spn bias expo-2**n))))
+
+
+                                 ))
+
+             (local (encapsulate ()
+;;;
+;;;           (<= (- 2 P) (+ (EXPO X) (BIAS Q)))
+;;;
+                                 (defthm p-expo-x-expo-spn
+                                   (implies (and (> (+ p (expo x))
+                                                    (expo (spn q)))
+                                                 (rationalp x)
+                                                 (integerp p)
+                                                 (integerp q)
+                                                 (> q 0))
+                                            (>= (+ (BIAS Q) (EXPO x))
+                                                (+ 2 (* -1 p))))
+                                   :hints (("Goal" :in-theory (enable spn)))
+                                   :rule-classes :linear))
+
+                    ) ;;;  END OF          (<= (- 2 P) (+ (EXPO X) (BIAS Q)))
+
+
+             (local
+              (defthm drnd-exactp-a-lemma
+                (implies (and (rationalp x)
+                              (< (EXPO (SPN Q)) (+ P (EXPO X)))
+                              (> x 0)
+                              (< (abs x) (spn q))
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (common-rounding-mode-p mode))
+                         (or (drepp (drnd x mode p q) p q)
+                             (= (drnd x mode p q) 0)
+                             (= (drnd x mode p q) (* (sgn x) (spn q)))))
+                :rule-classes ()
+                :hints (("Goal"  :in-theory (e/d (drepp rnd) ())
+                         :do-not '(fertilize)
+                         :cases ((not (equal (expo (drnd x mode p q)) (expo x)))))
+                        ("Subgoal 2" :use ((:instance less-than-spn-implies-expo-less)))
+                        ("Subgoal 1" :in-theory (enable drepp exactp-2**n)
+                         :cases ((not (equal (drnd x mode p q) (expt 2 (+ 1 (expo x)))))))
+                        ("Subgoal 1.2" :cases ((not (equal (expo x) (* -1 (bias q))))))
+                        ("Subgoal 1.2.2" :in-theory (enable sgn spn))
+                        ("Subgoal 1.2.1" :use ((:instance less-than-spn-implies-expo-less)))
+                        ("Subgoal 1.1" :in-theory (enable drnd)
+                         :use ((:instance expo-rnd
+                                          (n (+ P (EXPO X) (- (EXPO (SPN Q)))))))))))
+
+
+             (defthm drepp-minus
+               (implies (and (rationalp x)
+                             (integerp p)
+                             (integerp q))
+                        (equal (drepp (* -1 x) p q)
+                               (drepp x p q)))
+               :hints (("Goal" :in-theory (enable expo-minus drepp))))
+
+             (encapsulate ()
+                          (local 
+                           (defthm bias-expo-reduce
+                             (implies (and (integerp q)
+                                           (> q 0))
+                                      (equal (+ (bias q) (expo (spn q)))
+                                             1))
+                             :hints (("Goal" :in-theory (enable spn)))))
+         
+                          (local
+                           (defthm integerp-less-than
+                             (implies (and (integerp p)
+                                           (integerp q)
+                                           (> q 0)
+                                           (> p 1))
+                                      (<= (+ 1 (BIAS Q) (* -1 P) (EXPO (SPN Q))) 0))
+                             :hints (("Goal" :in-theory (enable spn)))
+                             :rule-classes :linear))
+
+                          (local
+                           (defthm exactp-fact
+                             (implies (and (integerp p)
+                                           (integerp q)
+                                           (> q 0)
+                                           (> p 1))
+                                      (EXACTP (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q))))
+                                              (+ -1 (EXPO (SPN Q))
+                                                 (EXPT 2 (+ -1 Q)))))
+                             :hints (("Goal" :in-theory (enable spn exactp-2**n bias)))))
+
+
+
+                          (local 
+                           (defthm expt-2-no-greater-than-2
+                             (implies (and (integerp q)
+                                           (> q 0))
+                                      (<= (EXPT 2
+                                                (+ 1 (* -1 q)))
+                                          1))
+                             :hints (("Goal" :use ((:instance expt-weak-monotone-linear
+                                                              (n (+ 1 (* -1 q)))
+                                                              (m 0)))))
+                             :rule-classes :linear))
+
+             (defthm exactp-spn-p
+               (implies (and (integerp p)
+                             (integerp q)
+                             (> q 0)
+                             (> p 1))
+                        (exactp (spn q) p))
+               :hints (("Goal" :in-theory (enable spn
+                                                  exactp-2**n))))
+
+
+
+
+             
+             (defthm local-rewrite-hack
+               (implies (and (equal (+ x (spn q)) 0)
+                             (< (EXPO (SPN Q)) (+ P (EXPO X)))
+                             (common-rounding-mode-p mode)
+                             (integerp p)
+                             (integerp q)
+                             (> p 1)
+                             (> q 0))
+                        (EQUAL (+ (SPN Q)
+                                  (RND X MODE
+                                       (+ P (EXPO X)
+                                          (* -1 (EXPO (SPN Q))))))
+                               0))
+               :hints (("Goal" :cases ((not (equal x (* -1 (spn
+                                                            q)))))
+                        :in-theory (enable rnd-exactp-b
+                                           expo-minus
+                                           rnd-minus))))
+
+
+
+               (defthm drnd-exactp-a1
+                 (implies (and (rationalp x)
+                               (<= (abs x) (spn q))
+                               (integerp p)
+                               (> p 1)
+                               (integerp q)
+                               (> q 0)
+                               (common-rounding-mode-p mode))
+                          (or (drepp (drnd x mode p q) p q)
+                              (= (drnd x mode p q) 0)
+                              (= (drnd x mode p q) (* (sgn x) (spn q)))))
+                 :hints (("Goal" :in-theory (enable rnd-minus drepp-minus
+                                                    sgn 
+                                                    flip drnd rnd-exactp-b
+                                                    expo-minus sgn-minus)
+                          :cases ((not (<= (+ p (expo x) (- (expo (spn q))))
+                                           0))))
+                         ("Subgoal 2" :in-theory (enable drepp  expo-minus sgn
+                                                         drnd near near+ 
+                                                         away cg rnd))
+                         ("Subgoal 1" :cases ((not (equal x 0))))
+                         ("Subgoal 1.2" :in-theory (enable drnd))
+                         ("Subgoal 1.1" :cases ((not (> x 0))))
+                         ("Subgoal 1.1.2" :use ((:instance drnd-exactp-a-lemma)))
+                         ("Subgoal 1.1.1" :use ((:instance drnd-exactp-a-lemma
+                                                           (x (* -1 x))
+                                                           (mode (flip
+                                                                  mode)))
+                                                (:instance rnd-exactp-b
+                                                           (x (* -1 x))
+                                                           (mode (flip mode))))))
+                 :rule-classes ()))
+
+
+
+         (defthm drnd-exactp-a
+           (implies (and (rationalp x)
+                         (<= (abs x) (spn q))
+                         (integerp p)
+                         (> p 1)
+                         (integerp q)
+                         (> q 0)
+                         (common-rounding-mode-p mode))
+                    (or (drepp (drnd x mode p q) p q)
+                        (= (drnd x mode p q) 0)
+                        (= (drnd x mode p q) (* (sgn x) (spn q)))))
+           :hints (("Goal" :cases ((not (equal (abs x) (spn q))))
+                    :in-theory (enable sgn drnd rnd-minus expo-minus))
+                   ("Subgoal 2" :cases ((equal x (spn q))
+                                        (equal x (* -1 (spn q)))))
+                   ("Subgoal 1" :use drnd-exactp-a1))
+           :rule-classes ())
+
+
+             ) ;; end of drnd-exactp-a
+
+;;; 
+;;; extremely bad proof!! 
+;;;
+;;; We could resolve to mid-range, small-range, large range. 
+;;;
+
+(defthmd drnd-exactp-b
+     (implies (and (rationalp x)
+   	        (drepp x p q)
+                   (integerp p)
+                   (> p 1)
+                   (integerp q)
+                   (> q 0)
+                   (common-rounding-mode-p mode))
+              (equal (drnd x mode p q)
+                     x))
+     :hints (("Goal" :in-theory (e/d (drepp spn bias drnd)
+                                     (common-rounding-mode-p))
+              :use ((:instance rnd-exactp-b
+                               (n (+ P (EXPO X) (- (EXPO (SPN Q))))))))))
+
+
+;----------------------------------------------------------------------
+
+
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x)))
+  :hints (("Goal" :in-theory (enable drnd rnd)
+           :use ((:instance trunc-upper-bound 
+                            (x x)
+                            (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))))))
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x)))
+  :hints (("Goal" :in-theory (enable drnd rnd)
+           :use ((:instance away-lower-bound
+                            (x x)
+                            (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))))))
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x))
+    :hints (("Goal" :in-theory (enable drnd rnd)
+           :use ((:instance minf-lower-bound
+                            (x x)
+                            (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))))))
+
+
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x))
+    :hints (("Goal" :in-theory (enable drnd rnd)
+           :use ((:instance inf-lower-bound
+                            (x x)
+                            (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))))))
+
+
+
+;----------------------------------------------------------------------
+
+
+(local 
+ (defthm exactp-c-lemma-1
+   (IMPLIES (AND (RATIONALP X)
+                 (< 0 X)
+                 (<= X (SPN Q))
+                 (RATIONALP A)
+                 (DREPP A P Q)
+                 (<= X A)
+                 (INTEGERP P)
+                 (< 1 P)
+                 (INTEGERP Q)
+                 (< 0 Q))
+            (<= (TRUNC X (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))
+                A))
+      :hints (("Goal" 
+               :use ((:instance trunc-upper-bound 
+                                (x x)
+                                (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))
+      :rule-classes :linear))
+
+
+;; (i-am-here) ;; Sun Oct 15 17:16:34 2006
+
+
+(local 
+   (encapsulate ()
+
+      (local 
+       (encapsulate () 
+         (local (include-book "float-extra2"))               
+           (defthmd spd-mult
+             (implies (and (integerp p)
+                           (> p 1)
+                           (integerp q)
+                           (> q 0)
+                           (> r 0)
+           		(rationalp r)
+           		(= m (/ r (spd p q))))
+           	   (iff (drepp r p q)
+           		(and (natp m)
+           		     (<= 1 m)
+           		     (< m (expt 2 (1- p)))))))))
+
+      (local 
+         (defthm equal-spd
+           (implies (and (integerp p)
+                         (integerp q)
+                         (> p 1)
+                         (> q 0))
+                    (equal (spd p q)
+                           (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q))))))
+           :hints (("Goal" :in-theory (enable spd spn bias)))))
+
+      (local 
+           (defund denormal-norm (r p q)
+             (/ r (spd p q))))
+
+      (local
+          (defthm spd-mult-specific
+            (implies (and (integerp p)
+                          (> p 1)
+                          (integerp q)
+                          (> q 0)
+                          (> r 0)
+                          (rationalp r))
+                     (= r (* (denormal-norm r p q) (spd p q))))
+            :hints (("Goal" :in-theory (enable denormal-norm)))
+            :rule-classes nil))
+
+      (local 
+          (defthm drepp-implies-denormal-norm-integerp
+            (implies (and (drepp r p q)
+                          (integerp p)
+                          (> p 1)
+                          (integerp q)
+                          (> q 0)
+                          (> r 0)
+                          (rationalp r))
+                     (integerp (denormal-norm r p q)))
+            :hints (("Goal" :use ((:instance spd-mult
+                                             (m (denormal-norm r p q)))
+                                  (:instance spd-mult-specific))))
+            :rule-classes :type-prescription))
+
+
+      (local 
+          (defthm drepp-implies-denormal-norm-less-than
+            (implies (and (drepp r p q)
+                          (integerp p)
+                          (> p 1)
+                          (integerp q)
+                          (> q 0)
+                          (> r 0)
+                          (rationalp r))
+                     (<= (denormal-norm r p q)
+                         (+ -1 (expt 2 (+ -1 p)))))
+            :hints (("Goal" :use ((:instance spd-mult
+                                             (m (denormal-norm r p q)))
+                                  (:instance spd-mult-specific))))
+            :rule-classes :linear))
+
+      (local
+          (defthm denormal-normal-monotone
+            (implies (and (< r1 r2)
+                          (integerp (denormal-norm r1 p q))
+                          (integerp (denormal-norm r2 p q)))
+                     (<= (+ 1 (denormal-norm r1 p q))
+                         (denormal-norm r2 p q)))
+            :hints (("Goal" :in-theory (enable spd denormal-norm)))
+            :rule-classes :linear))
+
+      (local 
+      (defthm drepp-diff
+           (implies (and (rationalp r1)
+                         (rationalp r2)
+                         (> r1 r2)
+                         (> r2 0)
+                         (integerp p)
+                         (integerp q)
+                         (> p 1)
+                         (> q 0)
+                         (drepp r1 p q)
+                         (drepp r2 p q))
+                    (<= (+ r2 (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q)))))
+                        r1))
+           :hints (("Goal" :use ((:instance spd-mult-specific
+                                            (r r1))
+                                 (:instance spd-mult-specific
+                                            (r r2))
+                                 (:instance denormal-normal-monotone
+                                            (r1 r2)
+                                            (r2 r1)))))
+           :rule-classes nil))
+
+
+      (local 
+       (defthm expt-merge
+         (implies (and (integerp p)
+                       (integerp q)
+                       (> q 0))
+                  (equal (* (EXPT 2 (+ -1 P))
+                            (EXPT 2 (+ 2 (* -1 P) (* -1 (BIAS Q)))))
+                         (expt 2 (+ 1 (* -1 (bias q))))))
+         :hints (("Goal" :in-theory (enable a15)))))
+
+
+      (local 
+       (encapsulate () 
+                   (local (include-book "../../arithmetic/basic"))
+                    (defthm arithm-hack-specific
+                      (implies (and (<= (DENORMAL-NORM R P Q)
+                                        (+ -1 (EXPT 2 (+ -1 P))))
+                                    (rationalp r)
+                                    (integerp p)
+                                    (integerp q)
+                                    (> q 0))
+                               (<= (+ (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q))))
+                                      (* (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q))))
+                                         (denormal-norm r p q)))
+                                   (spn q)))
+                      :hints (("Goal" :in-theory (e/d (spn denormal-norm 
+                                                           spd) ())))
+                      :rule-classes nil)))
+
+
+      (defthm maximal-drepp
+         (implies (and (drepp r p q)
+                       (integerp p)
+                       (> p 1)
+                       (integerp q)
+                       (> q 0)
+                       (> r 0)
+                       (rationalp r))
+                  (<= (+ r (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q)))))
+                      (spn q)))
+         :hints (("Goal" :use ((:instance drepp-implies-denormal-norm-less-than)
+                               (:instance spd-mult-specific)
+                               (:instance arithm-hack-specific))))
+         :rule-classes :linear)
+
+
+      (defthm drepp-diff
+           (implies (and (rationalp r1)
+                         (rationalp r2)
+                         (> r1 r2)
+                         (> r2 0)
+                         (integerp p)
+                         (integerp q)
+                         (> p 1)
+                         (> q 0)
+                         (drepp r1 p q)
+                         (drepp r2 p q))
+                    (<= (+ r2 (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q)))))
+                        r1))
+           :hints (("Goal" :use ((:instance spd-mult-specific
+                                            (r r1))
+                                 (:instance spd-mult-specific
+                                            (r r2))
+                                 (:instance denormal-normal-monotone
+                                            (r1 r2)
+                                            (r2 r1)))))
+           :rule-classes nil)
+
+
+
+   ))
+
+
+
+(local 
+ (encapsulate ()
+              (local 
+               (defthm spd-spd-less-than
+                 (implies (and (integerp p)
+                               (integerp q)
+                               (> p 1)
+                               (> q 0))
+                          (iff (<= (SPD P Q) A)
+                               (<= (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q))))
+                                   A)))
+                 :hints (("Goal" :in-theory (enable spn spd)))))
+
+              (defthm exactp-c-lemma-2
+                (implies (and (integerp p)
+                              (> p 1)
+                              (> x 0)
+                              (rationalp a)
+                              (integerp q)
+                              (> q 0)
+                              (rationalp x)
+                              (>= a x)
+                              (drepp a p q)
+                              (<= (abs x) (spn q)))
+                         (<= (AWAY X (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))
+                             a))
+                :hints (("Goal" :cases ((not (>= (+ p (expo x)) (expo (spn q))))))
+                        ("Subgoal 2"           
+                         :in-theory (enable drnd rnd sgn positive-spd)
+                         :use ((:instance drnd-exactp-a
+                                          (mode 'away))
+                               (:instance away-upper-bound
+                                          (x x)
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                               (:instance drepp-diff
+                                          (r2 a)
+                                          (r1 (AWAY X (+ P (EXPO X) 
+                                                         (* -1 (EXPO (SPN Q)))))))))
+                        ("Subgoal 1" :in-theory (enable drnd rnd away cg sgn)
+                         :use ((:instance smallest-spd (r a)))))
+                :rule-classes :linear)))
+
+
+(local 
+   (defthmd drnd-exactp-c-lemma
+     (implies (and (rationalp x)
+                   (> x 0)
+                   (<= (abs x) (spn q))
+   		(rationalp a)
+                   (drepp a p q)
+   		(>= a x)
+                   (integerp p)
+                   (> p 1)
+                   (integerp q)
+                   (> q 0)
+                   (common-rounding-mode-p mode))
+              (>= a (drnd x mode p q)))
+     :hints (("Goal" :in-theory (enable sgn drnd rnd))
+;fcd/Satriani v3.7 Moore - used to be Subgoal 5
+             ("Subgoal 4"
+              :use ((:instance near-choice
+                               (x x)
+                               (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))))
+             ("Subgoal 2" 
+              :use ((:instance near+-choice
+                               (x x)
+                               (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+
+              
+
+
+(local 
+    (defthm exactp-d-lemma-1
+      (IMPLIES (AND (RATIONALP X)
+                    (< 0 X)
+                    (<= X (SPN Q))
+                    (RATIONALP A)
+                    (DREPP A P Q)
+                    (<= A X)
+                    (INTEGERP P)
+                    (< 1 P)
+                    (INTEGERP Q)
+                    (< 0 Q))
+            (<= A (AWAY X (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))
+      :hints (("Goal" 
+               :use ((:instance away-lower-bound
+                                (x x)
+                                (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))
+      :rule-classes :linear))
+
+
+
+;;    (local 
+;;     (defthm never-zero-drepp
+;;       (not (DREPP 0 P Q))
+;;       :hints (("Goal" :in-theory (enable drepp)))))
+;;
+
+(local 
+    (defthm x-less-than-spd-if-negative
+      (implies (and (<= (+ P (EXPO X) (* -1 (EXPO (SPN Q)))) 0)
+                    (> x 0)
+                    (rationalp x)
+                    (integerp p)
+                    (integerp q)
+                    (> q 0))
+               (< x (spd p q)))
+      :hints (("Goal" :in-theory (enable spd spn)
+               :use ((:instance expo-monotone
+                                (x (spd p q))
+                                (y x)))))))
+
+(local 
+    (defthm exactp-d-lemma-2  
+      (IMPLIES (AND (RATIONALP X)
+                    (<= X (SPN Q))
+                    (< 0 X)
+                    (RATIONALP A)
+                    (DREPP A P Q)
+                    (<= A X)
+                    (INTEGERP P)
+                    (< 1 P)
+                    (INTEGERP Q)
+                    (< 0 Q))
+            (<= A
+                (TRUNC X
+                       (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))
+      :hints (("Goal" :cases ((not (> (+ p (expo x)) (expo (spn q))))))
+              ("Subgoal 2" 
+               :in-theory (enable drnd rnd sgn positive-spd)
+               :use ((:instance drnd-exactp-a
+                                (mode 'trunc))
+                     (:instance trunc-lower-bound
+                               (x x)
+                               (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                     (:instance drepp-diff
+                               (r1 a)
+                               (r2 (trunc X (+ P (EXPO X)
+                                               (* -1 (EXPO (SPN Q)))))))))
+              ("Subgoal 1" :in-theory (enable drnd rnd spd trunc sgn)
+               :use ((:instance smallest-spd (r a))
+                     (:instance x-less-than-spd-if-negative))))
+     :rule-classes :linear))
+
+
+(defthmd drnd-exactp-d-lemma
+     (implies (and (rationalp x)
+                   (<= (abs x) (spn q))
+                   (> x 0)
+   		(rationalp a)
+                   (drepp a p q)
+   		(<= a x)
+                   (integerp p)
+                   (> p 1)
+                   (integerp q)
+                   (> q 0)
+                   (common-rounding-mode-p mode))
+              (<= a (drnd x mode p q)))
+     :hints (("Goal" :in-theory (enable ieee-mode-p drnd rnd))
+; fcd/Satriani v3.7 Moore - used to be Subgoal 1
+             ("Subgoal 4" 
+              :use ((:instance near-choice
+                               (x x)
+                               (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))))
+             ("Subgoal 2" 
+              :use ((:instance near+-choice
+                               (x x)
+                               (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))))))
+
+
+
+
+(defthmd drnd-exactp-c
+     (implies (and (rationalp x)
+                   (<= (abs x) (spn q))
+                   (rationalp a)
+                   (drepp a p q)
+                   (>= a x)
+                   (integerp p)
+                   (> p 1)
+                   (integerp q)
+                   (> q 0)
+                   (common-rounding-mode-p mode))
+              (>= a (drnd x mode p q)))
+     :hints (("Goal" :cases ((not (equal x 0)))
+              :in-theory (enable drnd-minus flip drepp-minus))
+             ("Subgoal 2" :in-theory (enable drnd rnd))
+             ("Subgoal 1" :cases ((not (> x 0))))
+             ("Subgoal 1.2" :use ((:instance drnd-exactp-c-lemma)))
+             ("Subgoal 1.1" :use ((:instance drnd-exactp-d-lemma
+                                             (x (* -1 x))
+                                             (a (* -1 a))                                         
+                                             (mode (flip mode)))))))
+
+
+
+(defthmd drnd-exactp-d
+     (implies (and (rationalp x)
+                   (<= (abs x) (spn q))
+   		(rationalp a)
+                   (drepp a p q)
+   		(<= a x)
+                   (integerp p)
+                   (> p 1)
+                   (integerp q)
+                   (> q 0)
+                   (common-rounding-mode-p mode))
+              (<= a (drnd x mode p q)))
+     :hints (("Goal" :cases ((not (equal x 0)))
+              :in-theory (enable drnd-minus flip drepp-minus))
+             ("Subgoal 2" :in-theory (enable drnd rnd))
+             ("Subgoal 1" :cases ((not (> x 0))))
+             ("Subgoal 1.2" :use ((:instance drnd-exactp-d-lemma)))
+             ("Subgoal 1.1" :use ((:instance drnd-exactp-c-lemma
+                                             (x (* -1 x))
+                                             (a (* -1 a))                                         
+                                             (mode (flip mode)))))))
+
+
+
+;----------------------------------------------------------------------
+
+(local
+   (encapsulate ()
+    
+       (local 
+        (defthm equal-spd
+          (implies (and (integerp p)
+                        (integerp q)
+                        (> p 1)
+                        (> q 0))
+                   (equal (spd p q)
+                          (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q))))))
+          :hints (("Goal" :in-theory (enable spd spn bias)))))
+
+       (local 
+        (defthm x-less-than-spd-if-negative
+          (implies (and (<= (+ P (EXPO X) (* -1 (EXPO (SPN Q)))) 0)
+                        (> x 0)
+                        (rationalp x)
+                        (integerp p)
+                        (integerp q)
+                        (> q 0))
+                   (< x (spd p q)))
+          :hints (("Goal" :in-theory (enable spd spn)
+                   :use ((:instance expo-monotone
+                                    (x (spd p q))))))))
+
+
+       (defthm drnd-non-negative
+         (implies (and (< 0 x)
+                       (rationalp x)
+                       (integerp p)
+                       (integerp q)
+                       (> p 1)
+                       (> q 0)
+                       (common-rounding-mode-p mode))
+                  (>= (drnd x mode p q) 0))
+         :hints (("Goal" :in-theory (enable ieee-mode-p near near+ drnd rnd)))
+         :rule-classes (:type-prescription :linear))
+
+
+
+       (defthm drnd-diff-lemma
+         (implies (and (rationalp x)
+                       (<= x (spn q))
+                       (> x 0)
+                       (integerp p)
+                       (> p 1)
+                       (integerp q)
+                       (> q 0)
+                       (common-rounding-mode-p mode))
+                  (< (abs (- x (drnd x mode p q))) (spd p q)))
+         :hints (("Goal" :cases ((not (> (+ p (expo x)) (expo (spn q))))))
+                 ("Subgoal 2" :in-theory (enable drnd)
+                  :use ((:instance rnd-diff
+                                   (n (+ P (EXPO X) (* -1 (EXPO (SPN
+                                                                 Q))))))))
+                 ("Subgoal 1" 
+                  :use ((:instance drnd-exactp-c
+                                   (a (spd p q)))
+                        (:instance drepp-spd)
+                        (:instance x-less-than-spd-if-negative)))))))
+
+(defthm drnd-diff
+        (implies (and (rationalp x)
+                   (<= (abs x) (spn q))
+                   (integerp p)
+                   (> p 1)
+                   (integerp q)
+                   (> q 0)
+                   (common-rounding-mode-p mode))
+              (< (abs (- x (drnd x mode p q))) (spd p q)))
+     :hints (("Goal" :cases ((not (equal x 0))))
+             ("Subgoal 2" :in-theory (enable drnd rnd spd))
+             ("Subgoal 1" :cases ((not (> x 0))))
+             ("Subgoal 1.2" :use ((:instance drnd-diff-lemma)))
+             ("Subgoal 1.1" :in-theory (enable flip drnd drnd-minus)
+              :use ((:instance drnd-diff-lemma
+                               (x (* -1 x))
+                               (mode (flip mode)))))))
+
+
+
+;----------------------------------------------------------------------
+
+(encapsulate () 
+
+             (local
+              (defthm drnd-near-est-lemma-1
+                (implies (and (rationalp x)
+                              (equal (expo a) (expo x))
+                              (<= x (spn q))
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near p q)))))
+                :hints (("Goal" 
+                         :in-theory (enable rnd drnd bias DREPP spn)
+                         :use ((:instance near2
+                                          (y a)
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+
+
+
+             (local
+              (defthm rationalp-drepp
+                (implies (drepp a p q)
+                         (rationalp a))
+                :hints (("Goal" :in-theory (enable drepp)))
+                :rule-classes :forward-chaining))
+
+             (local
+              (defthm drnd-near-est-lemma-2-1
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (equal (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                     (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))) x))
+                              (> a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near p q)))))
+                :hints (("Goal" :in-theory (enable drnd rnd)
+                         :use ((:instance near-choice (x x)
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+
+
+             (local
+              (defthm drnd-near-est-lemma-2-2
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (not (equal (expo x) (expo a)))
+                              (<  (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                  (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))) x))
+                              (> a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near p q)))))
+                :hints (("Goal" :in-theory (enable drnd rnd)
+                         :do-not '(fertilize)
+                         :use ((:instance near1-a
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                               (:instance trunc-upper-bound
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+
+
+
+                               
+             (local
+              (defthm drnd-near-est-lemma-2-3
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (not (equal (expo x) (expo a)))
+                              (>  (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                  (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))) x))
+                              (> a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near p q)))))
+                :hints (("Goal" :in-theory (enable drnd rnd)
+                         :do-not '(fertilize)
+                         :use ((:instance near1-b
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                               (:instance away-lower-bound
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+
+
+
+
+
+             (local
+              (defthm drnd-near-est-lemma-2
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (not (equal (expo a) (expo x)))
+                              (> a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near p q)))))
+                :hints (("Goal" :cases ((not (equal (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                                    (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN
+                                                                                          Q))))) x))))
+                         :in-theory (disable abs drnd))
+                        ("Subgoal 2" :use ((:instance drnd-near-est-lemma-2-1)))
+                        ("Subgoal 1" :cases ((not (< (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                                     (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN
+                                                                                           Q))))) x)))))
+                        ("Subgoal 1.2" :use ((:instance drnd-near-est-lemma-2-2)))
+                        ("Subgoal 1.1" :use ((:instance drnd-near-est-lemma-2-3))))))
+
+
+
+
+             (local
+              (defthm drnd-near-est-lemma-3
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (not (equal (expo a) (expo x)))
+                              (< a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near p q)))))
+                :hints (("Goal" :use ((:instance smallest-spd (r a))
+                                      (:instance drnd-diff
+                                                 (mode 'near)))))))
+                                   
+
+
+             (local 
+              (defthm never-zero-drepp
+                (not (DREPP 0 P Q))
+                :hints (("Goal" :in-theory (enable drepp)))))
+
+             (local
+              (defthm drnd-near-est-lemma
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near p q)))))
+                :hints (("Goal" :cases ((not (equal (expo a) (expo x)))))
+                        ("Subgoal 2" :use ((:instance drnd-near-est-lemma-1)))
+                        ("Subgoal 1":cases ((not (equal a 0))))
+                        ("Subgoal 1.1":cases ((not (> a 0))))
+                        ("Subgoal 1.1.2":use ((:instance drnd-near-est-lemma-2)))
+                        ("Subgoal 1.1.1":use ((:instance drnd-near-est-lemma-3))))))
+
+    (defthm drnd-near-est
+      (implies (and (rationalp x)
+                    (<= (abs x) (spn q))
+                    (integerp p)
+                    (> p 1)
+                    (integerp q)
+                    (> q 0)
+                    (drepp a p q))
+               (>= (abs (- x a)) (abs (- x (drnd x 'near p q)))))
+      :hints (("Goal" :cases ((not (equal x 0))))
+              ("Subgoal 2" :in-theory (enable drnd rnd))
+              ("Subgoal 1" :cases ((not (> x 0))))
+              ("Subgoal 1.2" :use ((:instance drnd-near-est-lemma)))
+              ("Subgoal 1.1" :use ((:instance drnd-near-est-lemma
+                                              (x (* -1 x))
+                                              (a (* -1 a))))
+               :in-theory (enable drnd-minus))))
+
+             )
+
+;----------------------------------------------------------------------
+
+(encapsulate () 
+
+             (local
+              (defthm drnd-near+-est-lemma-1
+                (implies (and (rationalp x)
+                              (equal (expo a) (expo x))
+                              (<= x (spn q))
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q)))))
+                :hints (("Goal" 
+                         :in-theory (enable rnd drnd bias DREPP spn)
+                         :use ((:instance near+2
+                                          (y a)
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+
+
+
+
+             (local
+              (defthm rationalp-drepp
+                (implies (drepp a p q)
+                         (rationalp a))
+                :hints (("Goal" :in-theory (enable drepp)))
+                :rule-classes :forward-chaining))
+
+
+
+             (local
+              (defthm drnd-near+-est-lemma-2-1
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (equal (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                     (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))) x))
+                              (> a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q)))))
+                :hints (("Goal" :in-theory (enable drnd rnd)
+                         :use ((:instance near+-choice (x x)
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+
+
+;----------------------------------------------------------------------
+
+
+
+             (local
+              (defthm drnd-near+-est-lemma-2-2
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (not (equal (expo x) (expo a)))
+                              (<  (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                  (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))) x))
+                              (> a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q)))))
+                :hints (("Goal" :in-theory (enable drnd rnd)
+                         :do-not '(fertilize)
+                         :use ((:instance near+1-a
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                               (:instance trunc-upper-bound
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+                               
+             (local
+              (defthm drnd-near+-est-lemma-2-3
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (not (equal (expo x) (expo a)))
+                              (>  (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                  (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))) x))
+                              (> a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q)))))
+                :hints (("Goal" :in-theory (enable drnd rnd)
+                         :do-not '(fertilize)
+                         :use ((:instance near+1-b
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                               (:instance away-lower-bound
+                                          (n (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))))))
+                               
+
+             (local
+              (defthm drnd-near+-est-lemma-2
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (not (equal (expo a) (expo x)))
+                              (> a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q)))))
+                :hints (("Goal" :cases ((not (equal (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                                    (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN
+                                                                                          Q))))) x))))
+                         :in-theory (disable abs drnd))
+                        ("Subgoal 2" :use ((:instance drnd-near+-est-lemma-2-1)))
+                        ("Subgoal 1" :cases ((not (< (- x (trunc x (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))
+                                                     (- (away x (+ P (EXPO X) (* -1 (EXPO (SPN
+                                                                                           Q))))) x)))))
+                        ("Subgoal 1.2" :use ((:instance drnd-near+-est-lemma-2-2)))
+                        ("Subgoal 1.1" :use ((:instance drnd-near+-est-lemma-2-3))))))
+
+
+;----------------------------------------------------------------------
+
+             (local
+              (defthm drnd-near+-est-lemma-3
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (not (equal (expo a) (expo x)))
+                              (< a 0)
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q)))))
+                :hints (("Goal" :use ((:instance smallest-spd (r a))
+                                      (:instance drnd-diff
+                                                 (mode 'near+)))))))
+                                   
+
+             (local 
+              (defthm never-zero-drepp
+                (not (DREPP 0 P Q))
+                :hints (("Goal" :in-theory (enable drepp)))))
+
+
+
+             (local
+              (defthm drnd-near+-est-lemma
+                (implies (and (rationalp x)
+                              (<= x (spn q))
+                              (> x 0)
+                              (integerp p)
+                              (> p 1)
+                              (integerp q)
+                              (> q 0)
+                              (drepp a p q))
+                         (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q)))))
+                :hints (("Goal" :cases ((not (equal (expo a) (expo x)))))
+                        ("Subgoal 2" :use ((:instance drnd-near+-est-lemma-1)))
+                        ("Subgoal 1":cases ((not (equal a 0))))
+                        ("Subgoal 1.1":cases ((not (> a 0))))
+                        ("Subgoal 1.1.2":use ((:instance drnd-near+-est-lemma-2)))
+                        ("Subgoal 1.1.1":use ((:instance drnd-near+-est-lemma-3))))))
+
+     (defthm drnd-near+-est
+       (implies (and (rationalp x)
+                     (<= (abs x) (spn q))
+                     (integerp p)
+                     (> p 1)
+                     (integerp q)
+                     (> q 0)
+                     (drepp a p q))
+                (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q)))))
+       :hints (("Goal" :cases ((not (equal x 0))))
+               ("Subgoal 2" :in-theory (enable drnd rnd))
+               ("Subgoal 1" :cases ((not (> x 0))))
+               ("Subgoal 1.2" :use ((:instance drnd-near+-est-lemma)))
+               ("Subgoal 1.1" :use ((:instance drnd-near+-est-lemma
+                                               (x (* -1 x))
+                                               (a (* -1 a))))
+                :in-theory (enable drnd-minus))))
+
+             )
+
+;;
+;; Sat Feb  4 12:35:01 2006 finally! 
+;;
+;----------------------------------------------------------------------
+
+
+(encapsulate () 
+
+
+   (local (encapsulate () 
+
+          (defthm fl-expt-n-minus-1-minus-1
+            (implies (and (rationalp x)
+                          (case-split (not (equal x 0)))
+                          (integerp n)
+                          (<= n 0))
+                     (equal (fl (* -1 (sig x) (expt 2 (+ -1 n))))
+                            -1))
+            :hints (("Goal" :use ((:instance fl-1/2-sig-x-is-zero-lemma-2
+                                             (y (expt 2 (+ -1 n))))
+                                  (:instance expt-weak-monotone-linear
+                                             (n (+ -1 n))
+                                             (m -1))))))
+
+
+         (defthm n-zero-away-reduce
+           (implies (and (rationalp x)
+                         (> x 0)
+                         (integerp n)
+                         (<= n 0))
+                    (equal (away x n)
+                           (EXPT 2 (+ 1 (EXPO X) (* -1 n)))))
+           :hints (("Goal" :in-theory (enable sgn away cg))))
+
+
+         (defthm drnd-lemma-trunc-small
+           (implies (and (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (<= (+ p (expo x)) (expo (spn q))))
+                    (equal (drnd x 'trunc p q)  0))
+           :hints (("Goal" :in-theory (enable drnd rnd))))
+
+
+         (defthm drnd-lemma-away-small
+           (implies (and (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (<= (+ p (expo x)) (expo (spn q))))
+                    (equal (drnd x 'away p q)  
+                           (expt 2 (+ 1 (EXPO (SPN Q)) (* -1 p)))))
+           :hints (("Goal" :in-theory (enable drnd rnd))))
+
+
+
+         (defthm drnd-lemma-minf-small
+           (implies (and (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (<= (+ p (expo x)) (expo (spn q))))
+                    (equal (drnd x 'minf p q)  0))
+           :hints (("Goal" :in-theory (enable drnd rnd))))
+
+
+
+         (defthm drnd-lemma-inf-small
+           (implies (and (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (<= (+ p (expo x)) (expo (spn q))))
+                    (equal (drnd x 'inf p q)
+                           (expt 2 (+ 1 (EXPO (SPN Q)) (* -1 p)))))
+           :hints (("Goal" :in-theory (enable drnd rnd))))
+
+
+
+         (local 
+          (defthm local-expt-expand 
+            (implies (and (integerp p)
+                          (integerp q)
+                          (> q 0))
+                     (equal (EXPT 2 (+ 1 (* -1 P) (EXPO (SPN Q))))
+                            (* 2 (expt 2 (+  (* -1 p) (expo (spn q)))))))
+            :hints (("Goal" :use ((:instance a15 (i 2) (j1 1)
+                                             (j2 (+ (* -1 P) (EXPO (SPN Q))))))))))
+
+
+         (defthm drnd-lemma-near-small-1
+           (implies (and (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (< x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                         (<= (+ p (expo x)) (expo (spn q))))
+                    (equal (drnd x 'near p q)
+                           0))
+           :hints (("Goal" :in-theory (enable drnd rnd)
+                    :use ((:instance near1-a (n (+ p (expo x) (* -1 (expo (spn
+                                                                           q))))))))))
+
+
+         (defthm drnd-lemma-near-small-2
+           (implies (and (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (> x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                         (<= (+ p (expo x)) (expo (spn q))))
+                    (equal (drnd x 'near p q)
+                           (expt 2 (+ 1 (EXPO (SPN Q)) (* -1 p)))))
+           :hints (("Goal" :in-theory (enable drnd rnd)
+                    :use ((:instance near1-b (n (+ p (expo x) (* -1 (expo (spn q))))))))))
+
+
+
+
+         (defthm drnd-lemma-near+-small-1
+           (implies (and (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (< x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                         (<= (+ p (expo x)) (expo (spn q))))
+                    (equal (drnd x 'near+ p q)
+                           0))
+           :hints (("Goal" :in-theory (enable drnd rnd)
+                    :use ((:instance near+1-a (n (+ p (expo x) (* -1 (expo (spn
+                                                                            q))))))))))
+
+
+         (defthm drnd-lemma-near+-small-2
+           (implies (and (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (> x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                         (<= (+ p (expo x)) (expo (spn q))))
+                    (equal (drnd x 'near+ p q)
+                           (expt 2 (+ 1 (EXPO (SPN Q)) (* -1 p)))))
+           :hints (("Goal" :in-theory (enable drnd rnd)
+                    :use ((:instance near+1-b (n (+ p (expo x) (* -1 (expo (spn q))))))))))
+
+
+         (encapsulate ()
+                      (local 
+                       (defthm spd-/2-rewrite
+                         (implies (and (integerp p)
+                                       (integerp q)
+                                       (> q 0))
+                                  (equal (/ (spd p q) 2)
+                                         (expt 2 (+ (* -1 p) (expo (spn q))))))
+                         :hints (("Goal" :in-theory (enable spd spn)
+                                  :use ((:instance a15 (i 2) (j1 1)
+                                                   (j2 (+ 1 (* -1 P) (* -1 (BIAS Q))))))))))
+                   
+                      (local 
+                       (defthm less-than-1/2-spd-implies-expo-x-small
+                         (implies (and (< x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                                       (> x 0)
+                                       (rationalp x)
+                                       (integerp p)
+                                       (integerp q)
+                                       (> q 0))
+                                  (<= (+ p (expo x)) (expo (spn q))))
+                         :hints (("Goal" :use ((:instance expo-monotone
+                                                          (x x)
+                                                          (y (expt 2 (+ (* -1 p) (expo (spn
+                                                                                        q)))))))
+                                  :in-theory (enable expo-2**n)))))
+
+                      (defthm drnd-tiny-equal-lemma
+                        (implies (and (common-rounding-mode-p mode)
+                                      (natp p)
+                                      (> p 1)
+                                      (natp q)
+                                      (> q 0)
+                                      (rationalp x)
+                                      (< 0 x)
+                                      (< x (/ (spd p q) 2))
+                                      (rationalp y)
+                                      (< 0 y)
+                                      (< y (/ (spd p q) 2)))
+                                 (equal (drnd x mode p q)
+                                        (drnd y mode p q)))
+                        :hints (("Goal" :in-theory (enable ieee-mode-p)))
+                        :rule-classes nil))
+
+
+         (defthm sticky-never-increase-over-expt
+           (implies (and (< x (expt 2 k))
+                         (integerp k)
+                         (rationalp x)
+                         (> x 0)
+                         (> n 0)
+                         (integerp n))
+                    (< (sticky x n) 
+                       (expt 2 k)))
+           :hints (("Goal" :use ((:instance expo-sticky)
+                                 (:instance expo-monotone
+                                            (x (expt 2 k))
+                                            (y (sticky x n)))
+                                 (:instance expt-weak-monotone-linear
+                                            (n k)
+                                            (m (expo x)))
+                                 (:instance expo-lower-bound
+                                            (x x))))))
+
+         (defthm sticky-preserves-inequality
+           (implies  (and (< x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                          (rationalp x)
+                          (> x 0)
+                          (> n 0)
+                          (integerp n)
+                          (integerp p)
+                          (integerp q)
+                          (> p 1)
+                          (> q 0))
+                     (< (sticky x n)
+                        (expt 2 (+ (* -1 p) (expo (spn q))))))
+           :hints (("Goal"  :use ((:instance sticky-never-increase-over-expt
+                                             (k (+ (* -1 p)
+                                                   (expo (spn q)))))))))
+
+         (defthm greater-than-1/2-spd-implies-n-no-less-than-2
+           (implies (and (> x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                         (rationalp x)
+                         (> x 0)
+                         (> n 0)
+                         (integerp n)
+                         (integerp p)
+                         (integerp q)
+                         (>= n (+ p (expo x) (- (expo (spn q))) 2))
+                         (> p 1)
+                         (> q 0))
+                    (>= n 2))
+           :hints (("Goal" :use ((:instance expo-monotone
+                                            (x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                                            (y x)))
+                    :in-theory (enable expo-2**n)))
+           :rule-classes nil)
+
+         (local 
+          (defthm trunc-1-m-is-1
+            (implies (and (integerp n)
+                          (> n 0))
+                     (equal (trunc 1 n)
+                            1))
+            :hints (("Goal" :in-theory (enable trunc a15)))))
+
+         (defthm trunc-2**n
+           (implies (and (integerp n)
+                         (integerp m)
+                         (> m 0))
+                    (equal (trunc (expt 2 n) m)
+                           (expt 2 n)))
+           :hints (("Goal" :use ((:instance trunc-shift
+                                            (x 1)
+                                            (k n)
+                                            (n m)))
+                    :in-theory (enable trunc))))
+
+
+         (defthm sticky-preserves-inequality-2-strong
+           (implies  (and (> x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                          (rationalp x)
+                          (> x 0)
+                          (> n 0)
+                          (integerp n)
+                          (integerp p)
+                          (integerp q)
+                          (>= n (+ p (expo x) (- (expo (spn q))) 2))
+                          (> p 1)
+                          (> q 0))
+                     (> (sticky x n)
+                        (expt 2 (+ (* -1 p) (expo (spn q))))))
+           :hints (("Goal" :in-theory (enable sticky trunc-shift sgn)
+                    :use ((:instance trunc-monotone
+                                     (x (expt 2 (+ (* -1 p) (expo (spn q)))))
+                                     (y x)
+                                     (n (+ -1 n)))
+                          (:instance greater-than-1/2-spd-implies-n-no-less-than-2)))))
+
+
+         (defthm exactp-expt-2-1
+           (implies (and (integerp n)
+                         (integerp m)
+                         (> n 0))
+                    (exactp (expt 2 m) n))
+           :hints (("Goal" :in-theory (enable a15 sig exactp))))
+
+
+         (defthm equal-x-1/2-spd-sticky-n-1/2-spd
+           (implies (and (integerp p)
+                         (integerp n)
+                         (integerp q)
+                         (> p 1)
+                         (> q 0)
+                         (> n 0))
+                    (equal (sticky (expt 2 (+ (* -1 p) (expo (spn q)))) n)
+                           (expt 2 (+ (* -1 p) (expo (spn q))))))
+           :hints (("Goal" :in-theory (e/d (expo-2**n sticky)
+                                           (exactp-expt-2-1))
+                    :use ((:instance exactp-expt-2-1
+                                     (m (+ (* -1 P) (EXPO (SPN Q)))) 
+                                     (n (+ -1 n)))))))
+
+
+         (defthm expo-sticky-strong
+           (implies (and (rationalp x)
+                         (integerp n) (> n 0))
+                    (= (expo (sticky x n))
+                       (expo x)))
+           :hints (("Goal" :cases ((not (> x 0)))
+                    :in-theory (enable expo-minus sticky-minus))
+                   ("Subgoal 2" :use ((:instance expo-sticky)))
+                   ("Subgoal 1" :use ((:instance expo-sticky
+                                                 (x (* -1 x)))))))
+
+
+;----------------------------------------------------------------------
+
+         (defthm n-equal-zero-implies-ultra-small
+           (implies (and (>= 0 (+ p (expo x) (- (expo (spn q))) 2))
+                         (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x))
+                    (< x (expt 2 (+ -1 (* -1 p) (expo (spn q))))))
+           :hints (("Goal" :use ((:instance expo-upper-bound)
+                                 (:instance expt-weak-monotone-linear
+                                            (n (+ 1 (expo x)))
+                                            (m (+ -1 (* -1 p) (expo (spn q)))))))))
+
+
+         ;; (i-am-here) ;; Sun Oct 15 18:19:29 2006
+
+
+                  
+         (defthm sticky-0-reduce
+           (implies (and (> x 0)
+                         (rationalp x))
+                    (equal (sticky x 0)
+                           (EXPT 2 (1+ (EXPO X)))))
+           :hints (("Goal" :in-theory (e/d (sticky exactp sgn)
+                                           (sig-lower-bound
+                                            sig-upper-bound))
+                    :use ((:instance  sig-lower-bound)
+                          (:instance sig-upper-bound)))))
+
+
+
+         (defthm small-fl-is-minus-1
+           (implies (and (rationalp x)
+                         (> x 0)
+                         (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (< x (expt 2 (+ -1 (* -1 p) (expo (spn q))))))
+                    (equal (FL (* -1 (SIG X)
+                                  (EXPT 2
+                                        (+ -1 P (EXPO X)
+                                           (* -1 (EXPO (SPN Q)))))))
+                           -1))
+           :hints (("Goal" :use ((:instance fl-1/2-sig-x-is-zero-2)
+                                 (:instance expo-monotone
+                                            (x x)
+                                            (y (expt 2 (+ -1 (* -1 p) (expo (spn q))))))))))
+                                   
+
+         (defthm small-fl-is-zero-1
+           (implies (and (rationalp x)
+                         (> x 0)
+                         (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (< x (expt 2 (+ -1 (* -1 p) (expo (spn q))))))
+                    (equal (FL (* (SIG X)
+                                  (EXPT 2
+                                        (+ -1 P (EXPO X)
+                                           (* -1 (EXPO (SPN Q)))))))
+                           0))
+           :hints (("Goal" :use ((:instance fl-1/2-sig-x-is-zero)
+                                 (:instance expo-monotone
+                                            (x x)
+                                            (y (expt 2 (+ -1 (* -1 p) (expo (spn q))))))))))
+                                   
+
+
+                             
+         (defthm small-fl-is-minus-1-v2
+           (implies (and (rationalp x)
+                         (> x 0)
+                         (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (< x (expt 2 (+ -1 (* -1 p) (expo (spn q))))))
+                    (equal (FL (* -1 (SIG (EXPT 2 (+ 1 (EXPO X))))
+                                  (EXPT 2
+                                        (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))
+                           -1))
+           :hints (("Goal" :use ((:instance fl-1/2-sig-x-is-zero-2
+                                            (x (expt 2 (+ 1 (expo x)))))
+                                 (:instance expo-monotone
+                                            (x x)
+                                            (y (expt 2 (+ -1 (* -1 p) (expo (spn q))))))))))
+           
+  
+                             
+         (defthm small-fl-is-zero-1-v2
+           (implies (and (rationalp x)
+                         (> x 0)
+                         (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (< x (expt 2 (+ -1 (* -1 p) (expo (spn q))))))
+                    (equal (FL (* (SIG (EXPT 2 (+ 1 (EXPO X))))
+                                  (EXPT 2
+                                        (+ P (EXPO X) (* -1 (EXPO (SPN Q)))))))
+                           0))
+           :hints (("Goal" :use ((:instance fl-1/2-sig-x-is-zero
+                                            (x (expt 2 (+ 1 (expo x)))))
+                                 (:instance expo-monotone
+                                            (x x)
+                                            (y (expt 2 (+ -1 (* -1 p) (expo (spn q))))))))))
+           
+
+         ;; (defthm expo-monotone-strong
+         ;;   (implies (and (< x (expt 2 n))
+         ;;                 (equal 
+         ;;             (rationalp x)
+
+           
+         (defthm small-small-lemma
+           (implies (<= (+ 2 P (EXPO X)) (EXPO (SPN Q)))
+                    (<= (+ -1 p (expo x) (* -1 (expo (spn q))))
+                        -3)))
+
+         (defthm small-small-lemma-2
+           (implies (<= (+ 2 P (EXPO X)) (EXPO (SPN Q)))
+                    (<= (+ p (expo x) (* -1 (expo (spn q))))
+                        -2)))
+
+         (defthm small-is-small
+           (implies (and (>= 0 (+ p (expo x) (- (expo (spn q))) 2))
+                         (rationalp x)
+                         (> x 0)
+                         (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0))
+                    (> 1
+                       (* 2 (SIG X)
+                          (EXPT 2
+                                (+ -1 P (EXPO X)
+                                   (* -1 (EXPO (SPN q))))))))
+           :hints (("Goal" :use ((:instance sig-upper-bound)
+                                 (:instance expt-weak-monotone-linear
+                                            (n (+ -1 P (EXPO X)
+                                                  (* -1 (EXPO (SPN q)))))
+                                            (m -3)))))
+           :rule-classes :linear)
+           
+         (encapsulate () 
+                      (local      
+                       (defthm sig-expt-fact
+                         (implies (integerp n)
+                                  (equal (sig (expt 2 n)) 1))
+                         :hints (("Goal" :in-theory (enable sig a15)))))
+
+                      (defthm small-is-small-v2
+                        (implies (and (>= 0 (+ p (expo x) (- (expo (spn q))) 2))
+                                      (rationalp x)
+                                      (> x 0)
+                                      (natp p)
+                                      (> x 0)
+                                      (> p 1)
+                                      (natp q)
+                                      (> q 0))
+                                 (> 1
+                                    (* 2 (SIG (EXPT 2 (+ 1 (EXPO X))))
+                                       (EXPT 2
+                                             (+ P (EXPO X) (* -1 (EXPO (SPN Q))))))))
+                        :hints (("Goal" :use ((:instance expt-weak-monotone-linear
+                                                         (n (+ P (EXPO X)
+                                                               (* -1 (EXPO (SPN q)))))
+                                                         (m -2)))))
+                        :rule-classes :linear))
+                
+
+
+
+         (defthm extra-small-drnd-is-equal
+           (implies (and (< x (expt 2 (+ -1 (* -1 p) (expo (spn q)))))
+                         (>= 0 (+ p (expo x) (- (expo (spn q))) 2))
+                         (> x 0)
+                         (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x))
+                    (equal (drnd (sticky x 0) mode p q)
+                           (drnd x mode p q)))
+           :hints (("Goal" :in-theory (enable drnd trunc sgn cg near+ near away rnd sticky))))
+
+
+         (defthm drnd-sticky-lemma
+           (implies (and (common-rounding-mode-p mode)
+                         (natp p)
+                         (> x 0)
+                         (> p 1)
+                         (natp q)
+                         (> q 0)
+                         (rationalp x)
+                         (<= x (spn q))
+                         (>= n 0)
+                         (integerp n)
+                         (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+                    (equal (drnd (sticky x n) mode p q)
+                           (drnd x mode p q)))
+           :hints (("Goal" :cases ((not (> (+ p (expo x)) (expo (spn q))))))
+                   ("Subgoal 2" :cases ((not (equal n 0))))
+                   ("Subgoal 2.1"  :use ((:instance rnd-sticky
+                                                    (m (+ p (expo x) 
+                                                          (- (expo (spn q)))))))
+                    :in-theory (enable drnd))
+                   ("Subgoal 1" :in-theory (e/d (common-rounding-mode-p
+                                                 sticky-positive ieee-mode-p)
+                                                (drnd rnd))
+                    :cases ((not (equal x (expt 2 (+ (* -1 p)
+                                                     (expo (spn q))))))))
+                   ("Subgoal 1.1"  :cases ((not (equal n 0))))
+                   ("Subgoal 1.1.2" :use ((:instance extra-small-drnd-is-equal)
+                                          (:instance
+                                           n-equal-zero-implies-ultra-small)))
+                   ("Subgoal 1.1.1" :cases ((not (> x (expt 2 (+ (* -1 p)
+                                                                 (expo (spn q)))))))))
+           :rule-classes nil)))
+
+
+  (defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+    :rule-classes ()
+    :hints (("Goal" :cases ((not (equal x 0)))
+             :in-theory (enable sticky-minus expo-minus
+                                drnd-minus flip))
+            ("Subgoal 1" :cases ((not (> x 0))))
+            ("Subgoal 1.2" :use ((:instance drnd-sticky-lemma)))
+            ("Subgoal 1.1" :use ((:instance drnd-sticky-lemma
+                                            (x (* -1 x))
+                                            (mode (flip mode)))))))
+
+
+
+
+  (defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1)
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :hints (("Goal" :use ((:instance drnd-tiny-equal-lemma))))
+    :rule-classes nil)
+
+)
+
+;----------------------------------------------------------------------
+(encapsulate ()
+
+ (local (encapsulate () 
+
+                     ;; (defthm plus-rnd
+                     ;;   (implies (and (rationalp x)
+                     ;;                 (>= x 0)
+                     ;;                 (rationalp y)
+                     ;;                 (>= y 0)
+                     ;;                 (integerp k)
+                     ;;                 (exactp x (+ -1 k (- (expo x) (expo y))))
+                     ;;                 (common-rounding-mode-p mode))
+                     ;;            (= (+ x (rnd y mode k))
+                     ;;               (rnd (+ x y)
+                     ;;                    mode
+                     ;;                    (+ k (- (expo (+ x y)) (expo y))))))
+                     ;;   :hints (("Goal" :use ((:instance plus-rnd---rtl-rel5-support))))
+                     ;;   :rule-classes ())
+
+                     (defthm exactp-spn-fact
+                       (implies (and (integerp p)
+                                     (> p 1)
+                                     (integerp q)
+                                     (> q 0))
+                                (EXACTP (SPN Q) (+ -1 P)))
+                       :hints (("Goal" :in-theory (enable spn exactp-2**n))))
+
+                     (defthm exactp-spn-fact-2
+                       (implies (and (integerp p)
+                                     (> p 1)
+                                     (integerp q)
+                                     (> q 0))
+                                (EXACTP (SPN Q) P))
+                       :hints (("Goal" :in-theory (enable spn exactp-2**n))))
+
+                     (defthm exactp-spn-fact-3
+                       (implies (and (integerp p)
+                                     (> p 1)
+                                     (integerp q)
+                                     (> q 0))
+                                (EXACTP (* 2 (SPN Q)) P))
+                       :hints (("Goal" :in-theory (enable spn exactp-2**n)
+                                :use ((:instance a15 (i 2) (j1 1) (j2 (+ 1 (* -1 (BIAS Q)))))))))
+
+
+                     ;; (defthm expo-unique
+                     ;;   (implies (and (<= (expt 2 n) (abs x))
+                     ;;                 (< (abs x) (expt 2 (1+ n)))
+                     ;;                 (rationalp x)
+                     ;;                 (integerp n))
+                     ;;            (equal n (expo x)))
+                     ;;   :rule-classes ())
+
+
+                     (encapsulate () 
+                                  (local 
+                                   (defthm local-expt-expand 
+                                     (implies (integerp n)
+                                              (equal (EXPT 2 (+ 1 n))
+                                                     (* 2 (expt 2 n))))
+                                     :hints (("Goal" :use ((:instance a15 (i 2) (j1 1)
+                                                                      (j2 n)))))))
+
+                                  (defthm expo-x-plus-spn-equal-expo-spn-lemma
+                                    (implies (and (rationalp x)
+                                                  (> x 0)
+                                                  (< x (expt 2 n))
+                                                  (integerp n))
+                                             (equal (expo (+ x (expt 2 n)))
+                                                    n))
+                                    :hints (("Goal" :use ((:instance expo-unique
+                                                                     (x (+ x (expt 2 n)))
+                                                                     (n n)))
+                                             :in-theory (enable expo-2**n
+                                                                spn)))
+                                    :rule-classes nil))
+
+
+                     (defthm expo-x-plus-spn-equal-expo-spn
+                       (implies (and (rationalp x)
+                                     (> x 0)
+                                     (< x (spn q))
+                                     (integerp q)
+                                     (> q 0))
+                                (equal (expo (+ x (spn q)))
+                                       (expo (spn q))))
+                       :hints (("Goal" :in-theory (e/d (spn expo-2**n) ())
+                                :use ((:instance expo-x-plus-spn-equal-expo-spn-lemma
+                                                 (n (expo (spn q))))))))
+
+
+
+
+                     (defthmd drnd-rewrite-lemma
+                       (implies (and (rationalp x)
+                                     (>= x 0)
+                                     (<= x (spn q))
+                                     (common-rounding-mode-p mode)
+                                     (integerp p)
+                                     (> p 1)
+                                     (integerp q)
+                                     (> q 0))
+                                (equal (drnd x mode p q)
+                                       (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+                                          (* (sgn x) (spn q)))))
+                       :hints (("Goal" :cases ((not (equal x (spn q)))))
+                               ("Subgoal 2" :in-theory (e/d (drnd sgn)
+                                                            (rnd-exactp-b))
+                                :use ((:instance rnd-exactp-b (x (spn q))
+                                                 (n p))
+                                      (:instance rnd-exactp-b (x (* 2 (spn q)))
+                                                 (n p))))
+                               ("Subgoal 1" :use ((:instance
+                                                   plus-rnd
+                                                             (x (spn q))
+                                                             (y x)
+                                                             (k (+ p (expo x) (* -1 (expo (spn q)))))))
+                                :in-theory (e/d (drnd sgn bias exactp-2**n) (common-rounding-mode-p)))))
+
+
+                      (defthm collect-neg-specific
+                        (equal (+ (* -1 X) (* -1 (SGN X) (SPN Q)))
+                               (* -1 (+ x (* (sgn x) (spn q))))))))
+
+        (defthmd drnd-rewrite
+          (implies (and (rationalp x)
+                        (<= (abs x) (spn q))
+                        (common-rounding-mode-p mode)
+                        (integerp p)
+                        (> p 1)
+                        (integerp q)
+                        (> q 0))
+                   (equal (drnd x mode p q)
+                          (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+                             (* (sgn x) (spn q)))))
+          :hints (("Goal" :cases ((not (>= x 0))))
+                  ("Subgoal 2" :use ((:instance drnd-rewrite-lemma)))
+                  ("Subgoal 1" :use ((:instance drnd-rewrite-lemma
+                                                (x (* -1 x))
+                                                (mode (flip mode))))
+                   :in-theory (enable drnd-minus sgn-minus
+                                      rnd-minus expo-minus flip))))
+
+        )
+
+;----------------------------------------------------------------------
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/round.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/round.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/round.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/round.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1770 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "float")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../lib1/round"))
+(local (include-book "round-extra2"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ())
+
+
+(defthm trunc-land
+    (implies (and (>= x (expt 2 (1- n)))
+		  (< x (expt 2 n))
+                  (integerp x) (> x 0)
+		  (integerp m) (>= m n)
+		  (integerp n) (> n k)
+		  (integerp k) (> k 0))
+	     (= (trunc x k)
+		(land x (- (expt 2 m) (expt 2 (- n k))) n)))
+  :rule-classes ())
+
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m)))))))
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+;; druss -- the following are wrong. 
+;;
+;; (defthm trunc-plus-minus
+;;     (implies (and (rationalp x)
+;; 		  (rationalp y)
+;; 		  (not (= x 0))
+;; 		  (not (= y 0))
+;; 		  (not (= (+ x y) 0))
+;; 		  (integerp k)
+;; 		  (> k 0)
+;; 		  (= k1 (+ k (- (expo x) (expo y))))
+;; 		  (= k2 (- (expo (+ x y)) (expo y)))
+;; 		  (exactp x k1)
+;; 		  (> k2 0))
+;; 	     (equal (+ x (trunc y k))
+;; 		    (if (= (sgn (+ x y)) (sgn y))
+;; 			(trunc (+ x y) k2)
+;; 		      (away (+ x y) k2))))
+;;   :rule-classes ())
+;; 
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+;;
+;; druss: the following may be wrong. 
+;;
+;; (defthm expo-near
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (near x n))
+;;                     (expo x)))
+;;   :rule-classes ())
+
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+(defun roundup (x mode n)
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+
+
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/simple-loop-helpers-extra.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/simple-loop-helpers-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/simple-loop-helpers-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/simple-loop-helpers-extra.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,40 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(include-book "../lib1/rtl")
+(include-book "../lib1/rtlarr")
+(include-book "../lib1/bits")
+
+
+(defthm bitn-setbitn-setbitn
+  (implies (and (<  j w)
+                (<= 0 j) 
+                (integerp w)
+                (integerp j))
+           (equal (bitn (setbitn x w j y)
+                        j)
+                  (bitn y 0)))
+  :hints (("Goal" :in-theory (enable setbitn BITN-CAT))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta1/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta1/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta1/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta1/simple-loop-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,347 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(set-enforce-redundancy t)
+
+
+
+(include-book "../lib1/rtl")
+(include-book "../lib1/rtlarr")
+(include-book "arith")
+(include-book "../lib1/log")
+(local (include-book "../lib1/simple-loop-helpers"))
+(local (include-book "simple-loop-helpers-extra"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I)))
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+
+(defthm bitn-setbitn-setbitn
+  (implies (and (<  j w)
+                (<= 0 j) 
+                (integerp w)
+                (integerp j))
+           (equal (bitn (setbitn x w j y)
+                        j)
+                  (bitn y 0))))
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-theory (enable setbits))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta2/Makefile acl2-6.3/books/rtl/rel9/support/lib1.delta2/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib1.delta2/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta2/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,6 @@
+include ../../../../Makefile-generic
+
+# BOOKS = float-extra float
+ 
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta2/float-extra.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta2/float-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta2/float-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta2/float-extra.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,41 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;; (include-book "log")
+
+(set-enforce-redundancy nil)
+
+(include-book "../lib1/top")
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+
+
+(defthm bcevp-nencode
+  (implies (and (equal k (+ p q))
+                (natp p)
+                (natp q))
+           (bvecp (nencode x p q) k))
+  :hints (("Goal" :in-theory (enable nencode))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib1.delta2/float.lisp acl2-6.3/books/rtl/rel9/support/lib1.delta2/float.lisp
--- acl2-6.2/books/rtl/rel9/support/lib1.delta2/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib1.delta2/float.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,906 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../lib1/log")
+
+(local (include-book "../lib1.delta1/float"))
+(local (include-book "float-extra"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ())
+
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ())
+
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ())
+
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ())
+
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
+
+;;;***************************************************************
+;;;                 Floating-Point formats
+;;;***************************************************************
+
+
+(defund esgnf  (x p q) (bitn x (+ p q)))
+(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defund esigf  (x p)   (bits x (1- p) 0))
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defthmd sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+
+(defthmd expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+
+(defthmd sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+
+(defthm bcevp-nencode
+  (implies (and (equal k (+ p q))
+                (natp p)
+                (natp q))
+           (bvecp (nencode x p q) k)))
+
+(defthmd nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+
+(defthmd nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+
+(defthmd nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+
+(defthmd ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+(defthmd sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+
+(defthmd expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+
+(defthmd sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(r))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+(defthmd drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+
+(defthmd dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+
+(defthmd dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+
+(defthmd ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+
+;; (defthmd spd-mult
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;; 		(rationalp r)
+;; 		(= m (/ r (spd p q))))
+;; 	   (iff (drepp r p q)
+;; 		(and (natp m)
+;; 		     (<= 1 m)
+;; 		     (< m (expt 2 (1- p)))))))
+;; not true!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
+
+
+(defund rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/Makefile acl2-6.3/books/rtl/rel9/support/lib2/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib2/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/Makefile	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,10 @@
+include ../../../../Makefile-generic
+
+
+# BOOKS = base arith basic bits log float reps round \
+#         rtl rtlarr bvecp-raw-helpers bvecp-helpers simple-loop-helpers \
+#         simplify-model-helpers util add top rom-helpers clocks package-defs \
+#         openers mult 
+ 
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/README acl2-6.3/books/rtl/rel9/support/lib2/README
--- acl2-6.2/books/rtl/rel9/support/lib2/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/README	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,16 @@
+In order to include all books of the library, simply include the book
+"lib/top".  (All of the "support" books may similarly be loaded via
+the book "support/top".)  Alternatively, a subset of these books may
+be loaded, according to the user's intentions.  In particular,
+
+(1) "rtlarr" is needed only if arrays are involved in the application.
+
+(2) "basic", "float", "reps", "round", "fadd", "brat" and "package-defs"
+    are intended to be used specifically for floating-point applications.
+
+(3) "util" has no effect on the proof process and may be omitted.
+
+(4) "arith" contains a set of arithmetic rules that past users have found
+     useful; it may be omitted or replaced by another ACL2 arithmetic package.
+    (We recommend the package in the "arithmetic/" directory, since it enforces normal 
+    forms which the rules in "lib/" may depend on.
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/add.lisp acl2-6.3/books/rtl/rel9/support/lib2/add.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/add.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/add.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,468 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "round")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (land u v 1) 1 (lxor u v 1) 1)))
+  :rule-classes ())
+
+(defthm add-2
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n))
+           (equal (+ x y)
+                  (+ (lxor x y n)
+                     (* 2 (land x y n)))))
+  :rule-classes ())
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (lior (land u v 1) (lior (land u w 1) (land v w 1) 1) 1) 1 
+                       (lxor u (lxor v w 1) 1) 1)))
+  :rule-classes ())
+
+(defthm add-3
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n)
+                (bvecp z n))
+           (equal (+ x y z)
+                  (+ (lxor x (lxor y z n) n)
+                     (* 2 (lior (land x y n)
+                                (lior (land x z n)
+                                      (land y z n)
+                                      n)
+                                n)))))
+  :rule-classes ())
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (lior (land (bitn x (1- k)) (bitn y (1- k)) 1)
+	  (lior (land (bitn x (1- k)) (rc-carry x y (1- k)) 1)
+		(land (bitn y (1- k)) (rc-carry x y (1- k)) 1)
+		1)
+	  1)))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (lxor (bitn x (1- k))
+	       (lxor (bitn y (1- k)) (rc-carry x y (1- k)) 1)
+	       1)
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :rule-classes ())
+
+(defun gen (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+(defun prop (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(defthmd gen-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen x y i j)
+                  (if (>= (+ (bits x i j) (bits y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j) (bits y i j))
+			(1+ (- i j))))))
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0)))))
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (lior (bitn x i) (bitn y i) 1)))
+  :rule-classes ())
+
+(defthmd prop-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop x y i j)
+                  (if (= (+ (bits x i j) (bits y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthmd prop-as-lxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (lxor (bits x i j) (bits y i j) (1+ (- i j)))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthm gen-extend
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp k)
+                (> i k)
+                (>= k j)
+                (>= j 0))
+           (equal (gen x y i j)
+                  (lior (gen x y i (1+ k))
+                        (land (prop x y i (1+ k))
+                              (gen x y k j)
+                              1)
+                        1)))
+  :rule-classes ())
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :rule-classes ())
+
+(defthm prop-extend
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp k)
+                (> i k)
+                (>= k j)
+                (>= j 0))
+           (equal (prop x y i j)
+                  (land (prop x y i (1+ k))
+                        (prop x y k j)
+                        1)))
+  :rule-classes ())
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j))))
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j)))))
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-plus-1
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0))
+           (equal (bits (+ 1 x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (lior (prop x y (1- j) 0) 
+                                 (gen x y (1- j) 0) 
+                                 1))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthmd land-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (land (bits x i j) (bits y i j) (1+ (- i j))) 0))
+           (equal (gen x y i j) 0)))
+
+(defthm land-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n i)
+                (>= i j)
+                (>= j 0)
+                (= (land x y n) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :rule-classes ())
+
+(defthmd gen-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (land z y (1+ k)) 0)
+		(= (gen x y k 0) 1))
+	   (equal (gen (+ x y) z k 0) 0)))
+
+(defthmd gen-extend-3
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                (= (land y z (1+ j)) 0))		  
+           (equal (gen (+ x y) z i 0)
+                  (land (prop x y i (1+ j))
+                        (gen (+ x y) z j 0)			  
+                        1))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm lop-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ())
+
+(defthm lop-thm-1
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (= e (expo a))
+                (< (expo b) e)
+                (= lambda
+                   (lior (* 2 (mod a (expt 2 e)))
+                         (lnot (* 2 b) (1+ e))
+                         (1+ e))))
+           (or (= (expo (- a b)) (expo lambda))
+               (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
+
+(defun lamt (a b e)
+  (lxor a (lnot b (1+ e)) (1+ e)))
+
+(defun lamg (a b e)
+  (land a (lnot b (1+ e)) (1+ e)))
+
+(defun lamz (a b e)
+  (lnot (lior a (lnot b (1+ e)) (1+ e)) (1+ e)))
+
+(defun lam1 (a b e)
+  (land (bits (lamt a b e) e 2) 
+	(land (bits (lamg a b e) (1- e) 1)
+	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam2 (a b e)
+  (land (lnot (bits (lamt a b e) e 2) (1- e))
+	(land (bits (lamz a b e) (1- e) 1)
+	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam3 (a b e)
+  (land (bits (lamt a b e) e 2) 
+	(land (bits (lamz a b e) (1- e) 1)
+	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam4 (a b e)
+  (land (lnot (bits (lamt a b e) e 2) (1- e))
+	(land (bits (lamg a b e) (1- e) 1)
+	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam0 (a b e)
+  (lior (lam1 a b e)
+	(lior (lam2 a b e)
+	      (lior (lam3 a b e)
+		    (lam4 a b e)
+		    (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (lnot (bitn (lamt a b e) 0) 1)))
+
+(defthm lop-thm-2
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1))
+           (and (not (= (lamb a b e) 0))
+                (or (= (expo (- a b)) (expo (lamb a b e)))
+                    (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lnot (lxor a b n) n) k 0) 0)))
+  :rule-classes ())
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (lxor (lxor a b n) 
+                                     (cat (lior a b n) n c 1)
+                                     (1+ n)) 
+                               k 0) 
+                         0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/arith.lisp acl2-6.3/books/rtl/rel9/support/lib2/arith.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/arith.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/arith.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,858 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This file is based on the old "fp book", which was initially created by J
+; Moore and Matt Kaufmann in 1995 in support of their proof of the AMD-K5
+; division code.    Here, we have moved
+; non-local in-theory events to the end.  All events should be redundant, so we
+; have deleted all local in-theory events and added (local (in-theory nil)) to
+; the beginning.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;; (local (include-book "../arithmetic/fp"))
+;; (local (include-book "../arithmetic/fp2"))
+;; (local (include-book "../arithmetic/fl"))
+;; (local (include-book "../arithmetic/expt"))
+;; (local (include-book "../arithmetic/expo"))
+;; (local (include-book "../arithmetic/extra-rules"))
+;; (local (include-book "../support/ash"))
+
+(local (include-book "base"))
+
+;; these already have lib1.delta1's
+;; arith.lisp!!  deftheory??? 
+;; Why I can't do that?? 
+
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+(defthm a1 (equal (+ x (+ y z)) (+ y (+ x z))))
+(defthm a2 (equal (- x) (* -1 x)))
+
+(defthm a3
+  (and
+   (implies
+    (syntaxp (and (quotep c1) (quotep c2)))
+    (and (equal (+ (* c1 x) (* c2 x)) (* (+ c1 c2) x))
+         (equal (+ (* c1 x) (+ (* c2 x) y)) (+ (* (+ c1 c2) x) y))))
+   (implies
+    (syntaxp (quotep c2))
+    (and (equal (+ x (* c2 x)) (* (+ 1 c2) x))
+         (equal (+ x (+ (* c2 x) y1)) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (* c2 x))) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (+ (* c2 x) y2))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (* c2 x)))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (+ y3 (* c2 x)))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))
+         (equal (+ x (+ y1 (+ y2 (+ (* c2 x) y3))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))))
+   (and (equal (+ x x) (* 2 x))
+        (equal (+ x (+ x y1)) (+ (* 2 x) y1)))))
+(defthm a4
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (+ c1 (+ c2 y1)) (+ (+ c1 c2) y1))))
+(defthm a5
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (* c1 (* c2 y1)) (* (* c1 c2) y1))))
+
+
+
+
+
+(defthm a6
+  (equal (/ (/ x)) (fix x)))
+(defthm a7
+  (equal (/ (* x y)) (* (/ x) (/ y))))
+
+;replaced force with case-split
+(defthm a8
+  (implies (and (case-split (acl2-numberp x))
+                (case-split (not (equal x 0))))
+           (and (equal (* x (* (/ x) y)) (fix y))
+                (equal (* x (/ x)) 1))))
+
+(defthm a9
+  (and (equal (* 0 x) 0)
+       (equal (* x (* y z)) (* y (* x z)))
+       (equal (* x (+ y z)) (+ (* x y) (* x z)))
+       (equal (* (+ y z) x) (+ (* y x) (* z x)))))
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+
+(defthm a10
+  (and (implies (integerp i) (equal (fl i) i))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1)) ;can actually drop this
+                     )
+                (and (equal (fl (+ i x1)) (+ i (fl x1)))
+                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2)))
+                (and (equal (fl (+ x1 (+ i x2))) (+ i (fl (+ x1 x2))))
+                     (equal (fl (+ x1 (+ x2 i))) (+ i (fl (+ x1 x2))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3)))
+                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
+                            (+ i (fl (+ x1 x2 x3))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
+                            (+ i (fl (+ x1 x2 x3))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3))
+                     (case-split (rationalp x4)))
+                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))))))
+
+(defthm a12
+  (implies (and (integerp i)
+                (integerp j)
+                (< 1 j)
+                (< j i))
+           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
+                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
+  :rule-classes :linear)
+
+
+;replaced force with case-split                
+;later, drop the hyp completely
+(defthm a13
+  (implies (case-split (rationalp x)) ;drop!
+           (and (< (1- x) (fl x))
+                (<= (fl x) x)))
+  :rule-classes :linear)
+
+(defthm a14
+  (and
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= 0 j))
+            (and (integerp (expt i j))
+                 (<= 0 (expt i j))))
+   (implies (and (rationalp i)
+                 (not (equal i 0)))
+            (not (equal (expt i j) 0))))
+  :rule-classes
+  ((:type-prescription
+    :corollary
+    (implies (and (integerp i)
+                  (<= 0 i)
+                  (<= 0 j))
+             (and (integerp (expt i j))
+                  (<= 0 (expt i j)))))
+   (:type-prescription
+    :corollary
+    (implies (and (rationalp i)
+                  (not (equal i 0)))
+             (not (equal (expt i j) 0))))))
+
+(defthm a15
+  (implies (and (rationalp i)
+                (not (equal i 0))
+                (integerp j1)
+                (integerp j2))
+           (and (equal (* (expt i j1) (expt i j2))
+                       (expt i (+ j1 j2)))
+                (equal (* (expt i j1) (* (expt i j2) x))
+                       (* (expt i (+ j1 j2)) x)))))
+(defthm a16
+  (equal (expt (* a b) i)
+         (* (expt a i) (expt b i))))
+
+(defthm /-weakly-monotonic
+  (implies (and (<= y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (<= (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+
+(defthm /-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (< (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+         
+(defthm *-weakly-monotonic
+  (implies (and (<= y y+)
+                (<= 0 x)
+                (case-split (rationalp x)) ; This does not hold if x, y, and z are complex!
+                )
+           (<= (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))))
+
+#| Here is the complex counterexample to which we alluded above.
+
+(let ((y  #c(1 -1))
+      (y+ #c(1 1))
+      (x  #c(1 1)))
+    (implies (and (<= y y+)
+                  (<= 0 x))
+             (<= (* x y) (* x y+))))
+|#
+
+(defthm *-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))))
+
+(defthm *-weakly-monotonic-negative-multiplier
+  (implies (and (<= y y+)
+               (< x 0)
+               (case-split (rationalp x))
+               )
+           (<= (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))))
+
+(defthm *-strongly-monotonic-negative-multiplier
+  (implies (and (< y y+)
+                (< x 0)
+                (case-split (rationalp x))
+                )
+           (< (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))))
+
+(defthm fl-weakly-monotonic
+  (implies (and (<= y y+)
+                (case-split (rationalp y)) ;drop?
+                (case-split (rationalp y+)) ;drop?
+                )
+           (<= (fl y) (fl y+)))
+  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
+                 (:linear)
+                 (:forward-chaining
+                  :trigger-terms ((fl y) (fl y+))
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))
+                 (:linear
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))))
+
+(deftheory arith-fc-monotonicity
+  '((:forward-chaining /-weakly-monotonic)
+    (:forward-chaining /-strongly-monotonic)
+    (:forward-chaining *-weakly-monotonic . 1)
+    (:forward-chaining *-weakly-monotonic . 2)
+    (:forward-chaining *-strongly-monotonic . 1)
+    (:forward-chaining *-strongly-monotonic . 2)
+    (:forward-chaining *-weakly-monotonic-negative-multiplier . 1)
+    (:forward-chaining *-weakly-monotonic-negative-multiplier . 2)
+    (:forward-chaining *-strongly-monotonic-negative-multiplier . 1)
+    (:forward-chaining *-strongly-monotonic-negative-multiplier . 2)
+    (:forward-chaining fl-weakly-monotonic . 1)
+    (:forward-chaining fl-weakly-monotonic . 2)
+    ))
+
+; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
+; product of a and b given intervals for a and b.  We consider three kinds of intervals.
+; We discuss only the a case.
+
+; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
+
+; nonneg-open intervals mean 0<=a<amax.
+
+; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
+
+; We now prove theorems with names like abs*nonneg-open, etc. characterizing
+; the product of two elements from two such intervals.  All of these theorems
+; are made with :rule-classes nil because I don't know how to control their
+; use.
+
+; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
+; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
+; lemma would be no different.
+
+(defthm abs*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+
+
+(defthm abs*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* bmax amax)) (* a b))
+                (< (* a b) (* bmax amax))))
+  :rule-classes nil)
+
+; The next three, which handle nonnegative open intervals in the first argument,
+; can actually be seen as uses of the abs intervals above.  Simply observe that
+; if 0<=a<amax then -amax<a<amax.
+
+(defthm nonneg-open*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+; and the commuted version
+(defthm nonneg-closed*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (<= a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (<= (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm abs*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (< (- bmax) b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)  
+
+(defthm rearrange-negative-coefs-<
+  (and (equal (< (* (- c) x) z)
+              (< 0 (+ (* c x) z)))
+       (equal (< (+ (* (- c) x) y) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y (* (- c) x)) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y1 y2 (* (- c) x)) z)
+              (< (+ y1 y2) (+ (* c x) z)))
+       (equal (< (+ y1 y2 y3 (* (- c) x)) z)
+              (< (+ y1 y2 y3) (+ (* c x) z)))
+       (equal (< z (+ (* (- c) x) y))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y (* (- c) x)))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y1 y2 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2)))
+       (equal (< z (+ y1 y2 y3 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2 y3)))))
+
+(defthm rearrange-negative-coefs-equal
+  (and (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp z)))
+                (equal (equal (* (- c) x) z)
+                       (equal 0 (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ (* (- c) x) y) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y (* (- c) x)) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 (* (- c) x)) z)
+                       (equal (+ y1 y2) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 y3 (* (- c) x)) z)
+                       (equal (+ y1 y2 y3) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ (* (- c) x) y))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y (* (- c) x)))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 y3 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2 y3))))))
+
+(defthm rearrange-fractional-coefs-<
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< (* (/ c) x) z)
+                   (< x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ (* (/ c) x) y) z)
+                   (< (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ y (* (/ c) x)) z)
+                   (< (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< (+ y1 y2 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< (+ y1 y2 y3 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) (* c y3) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< z (* (/ c) x))
+                   (< (* c z) x)))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ (* (/ c) x) y))
+                   (< (* c z) (+ x (* c y)))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ y (* (/ c) x)))
+                   (< (* c z) (+ (* c y) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 y3 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) (* c y3) x))))))
+
+(defthm rearrange-fractional-coefs-equal
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (equal (* (/ c) x) z)
+                   (equal x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ (* (/ c) x) y) z)
+                   (equal (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ y (* (/ c) x)) z)
+                   (equal (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 y3 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) (* c y3) x) (* c z))))))
+
+(defthm x*/y=1->x=y
+  (implies (and (rationalp x)
+                (rationalp y)
+                (not (equal x 0))
+                (not (equal y 0)))
+           (equal (equal (* x (/ y)) 1)
+                  (equal x y)))
+  :rule-classes nil)
+                
+(defun point-right-measure (x)
+  (floor (if (and (rationalp x) (< 0 x)) (/ x) 0) 1))
+
+(defun point-left-measure (x)
+  (floor (if (and (rationalp x) (> x 0)) x 0) 1))
+
+(include-book "ordinals/e0-ordinal" :dir :system)
+(set-well-founded-relation e0-ord-<)
+
+(defthm recursion-by-point-right
+  (and (e0-ordinalp (point-right-measure x))
+       (implies (and (rationalp x)
+                     (< 0 x)
+                     (< x 1))
+                (e0-ord-< (point-right-measure (* 2 x))
+                          (point-right-measure x)))))
+
+(defthm recursion-by-point-left
+  (and (e0-ordinalp (point-left-measure x))
+       (implies (and (rationalp x)
+                     (>= x 2))
+                (e0-ord-< (point-left-measure (* 1/2 x))
+                          (point-left-measure x)))))
+
+(defthm x<x*y<->1<y
+  (implies (and (rationalp x)
+                (< 0 x)
+                (rationalp y))
+           (equal (< x (* x y)) (< 1 y)))
+  :rule-classes nil)
+
+(defthm cancel-equal-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (not (equal a 0)))
+           (equal (equal (* a r) (* a s))
+                  (equal r s)))
+  :rule-classes nil)
+
+(defthmd expt-split
+  (implies (and (integerp i)
+                (integerp j)
+                (case-split (acl2-numberp r)) ;(integerp r)
+                (case-split (not (equal r 0)))
+                )
+           (equal (expt r (+ i j))
+                  (* (expt r i) (expt r j)))))
+
+(defthm cancel-<-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (< 0 a))
+           (equal (< (* a r) (* a s))
+                  (< r s)))
+  :rule-classes nil)
+
+(in-theory (disable fl
+                    inverse-of-*
+                    point-right-measure point-left-measure))
+
+
+;;;**********************************************************************
+;;;                       EXPONENTIATION
+;;;**********************************************************************
+
+(defthm expt-positive-integer-type
+    (implies (and (integerp a)
+		  (integerp i)
+		  (>= i 0))
+	     (integerp (expt a i)))
+  :rule-classes (:type-prescription))
+
+
+(defthm expt-2-positive-rational-type
+  (and (rationalp (expt 2 i))
+       (< 0 (expt 2 i)))
+  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
+
+(defthm expt-2-positive-integer-type
+  (implies (<= 0 i)
+           (and (integerp (expt 2 i))
+                (< 0 (expt 2 i))))
+  :rule-classes (:type-prescription))
+
+(defthm expt-2-type-linear
+  (implies (<= 0 i)
+           (<= 1 (expt 2 i)))
+  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
+
+(defthmd expt-weak-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (<= (expt 2 n) (expt 2 m))
+		  (<= n m))))
+
+(defthmd expt-strong-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (< (expt 2 n) (expt 2 m))
+		  (< n m))))
+
+(defthmd expt-inverse
+  (equal (/ (expt 2 i))
+         (expt 2 (* -1 i))))
+
+(defthm ash-rewrite
+    (implies (integerp n)
+	     (equal (ash n i)
+		    (fl (* n (expt 2 i))))))
+
+(defthm exp+1
+    (implies (and (integerp m)
+		  (integerp n)
+		  (<= n m))
+	     (> (* (- 1 (expt 2 m)) (- 1 (expt 2 n)))
+		(- 1 (expt 2 (1+ m)))))
+  :rule-classes ())
+
+(defthm exp+2
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (< (* (1+ (expt 2 m)) (1+ (expt 2 n)))
+		(1+ (expt 2 (+ m 2)))))
+  :rule-classes ())
+
+(defthm exp-invert
+    (implies (and (integerp n)
+		  (<= n -1))
+	     (<= (/ (- 1 (expt 2 n)))
+		 (1+ (expt 2 (1+ n)))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/base.lisp acl2-6.3/books/rtl/rel9/support/lib2/base.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/base.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/base.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,72 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "../lib1/rtl") ;semantics of the basic RTL primitives
+
+(include-book "../lib1/rtlarr") ;semantics RTL array primitives
+
+(include-book "../lib1.delta1/basic") ;properties of basic arithmetic functions: floor, ceiling, 
+;                       exponential, and remainder;;  Mon Mar  5 13:46:31 2007
+
+;(include-book "../lib1/bits") ;bit vectors
+(include-book "../lib1.delta1/bits") ;bit vectors ;; Fri Aug  3 12:38:57 2007
+; added back the definition of bitvec
+
+(include-book "../lib1/log") ;logical operations
+
+(include-book "../lib1.delta2/float") ;floating-point numbers
+
+(include-book "../lib1/reps") ;floating-point formats and representations
+
+(include-book "../lib1.delta1/round") ;floating-point rounding
+
+(include-book "../lib1/add") ;support for reasoning about floating-point addition
+;                      (leading one prediction and sticky bit computation)
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../arithmetic/top")
+
+(include-book "../lib1.delta1/mult")  ; integerp multiplier
+
+;(include-book "../lib1/arith") ;general arithmetic package
+
+(include-book "../lib1.delta1/arith") ;general arithmetic package;; Mon Mar  5 13:46:39 2007
+
+(include-book "../lib1/util") ;misc helpful stuff including a few macros
+
+
+(include-book "../lib1.delta1/bvecp-raw-helpers")  
+; better bvecp-raw-helpers.lisp, Fri Jun 29 10:13:32 2007
+
+(include-book "../lib1.delta1/simple-loop-helpers")  
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/basic.lisp acl2-6.3/books/rtl/rel9/support/lib2/basic.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/basic.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,452 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                       FLOOR and CEILING
+;;;**********************************************************************
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defthm fl-def
+  (and (integerp (fl x))    
+       (implies (case-split (rationalp x))
+	        (and (<= (fl x) x)
+		     (< x (1+ (fl x))))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (<= (fl x) x)
+                                        (< x (1+ (fl x))))))
+                 (:type-prescription :corollary
+                                     (integerp (fl x)))))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+(defthm fl-integerp
+  (equal (equal (fl x) x)
+         (integerp x)))
+
+(defthm quot-bnd
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* y (fl (/ x y)))
+               x))
+  :rule-classes :linear)
+
+(defthm fl-monotone-linear
+    (implies (and (<= x y)
+		  (rationalp x)
+		  (rationalp y))
+	     (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (fl x) (/ n)))
+                  (fl (/ x n)))))
+
+(defthm fl/int-rewrite-alt
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (/ n) (fl x)))
+                  (fl (/ x n)))))
+
+(defthmd fl-minus
+  (implies (rationalp x)
+           (equal (fl (* -1 x))
+                  (if (integerp x)
+                      (* -1 x)
+                    (1- (* -1 (fl x)))))))
+
+(defthm fl-m-n
+  (implies (and (< 0 n)
+                (integerp m)
+                (integerp n))
+           (= (fl (- (/ m n)))
+              (1- (- (fl (/ (1- m) n))))))
+  :rule-classes ())
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defthm cg-def
+  (and (integerp (cg x))
+       (implies (case-split (rationalp x))
+                (and (>= (cg x) x)
+                     (> (1+ x) (cg x)))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (>= (cg x) x)
+                                        (> (1+ x) (cg x)))))
+                 (:type-prescription :corollary
+                                     (integerp (cg x)))))
+
+(defthm cg-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (>= n x)
+		  (> (1+ x) n))
+	     (equal (cg x) n))
+  :rule-classes ())
+
+(defthm cg-integerp
+    (implies (rationalp x)
+	     (equal (equal (cg x) x)
+                    (integerp x))))
+
+(defthm cg-monotone-linear
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= x y))
+	     (<= (cg x) (cg y)))
+  :rule-classes :linear)
+
+(defthm n>=cg-linear
+    (implies (and (>= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (>= n (cg x)))
+  :rule-classes :linear)
+
+(defthm cg+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (cg (+ x n)) (+ (cg x) n))))
+
+(defthm cg/int-rewrite
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (cg x) (/ n)))
+                  (cg (/ x n)))))
+
+(defthm cg/int-rewrite-alt
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (/ n) (cg x)))
+                  (cg (/ x n)))))
+
+(defthm fl-cg
+  (implies (rationalp x)
+           (equal (cg x)
+                  (if (integerp x)
+                      (fl x)
+                    (1+ (fl x)))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                         MOD
+;;;**********************************************************************
+(in-theory (disable mod))
+
+(defthm mod-def
+  (implies (case-split (acl2-numberp x))
+           (equal (mod x y)
+                  (- x (* y (fl (/ x y))))))
+  :rule-classes ())
+
+(defthm mod-0
+    (and (equal (mod 0 y)
+                0)
+         (equal (mod x 0)
+                (fix x))))
+
+(defthm rationalp-mod
+  (implies (rationalp x)
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm integerp-mod
+  (implies (and (integerp m) (integerp n))
+           (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription))
+
+
+(defthm natp-mod
+   (implies (and (natp m)
+                 (natp n))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm natp-mod-2
+   (implies (and (integerp m)
+                 (integerp n)
+                 (> n 0))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm mod-bnd-1
+  (implies (and (case-split (< 0 n))
+                (case-split (not (complex-rationalp m)))
+                (case-split (not (complex-rationalp n))))
+           (< (mod m n) n))
+  :rule-classes :linear)
+
+(defthm mod-by-1
+  (implies (integerp m)
+           (equal (mod m 1)
+                  0)))
+
+(defthm mod-bnd-2
+  (implies (and (<= 0 m)
+                (case-split (rationalp m)))
+           (<= (mod m n) m))
+  :rule-classes :linear)
+
+(defthm mod-does-nothing
+  (implies (and (< m n)
+                (<= 0 m)
+                (case-split (rationalp m)))
+           (equal (mod m n)
+                  m)))
+
+(defthm mod-0-fl
+  (implies (acl2-numberp m)
+           (iff (= (mod m n) 0)
+	        (= m (* (fl (/ m n)) n))))
+  :rule-classes ())
+
+(defthm mod-0-int
+  (implies (and (integerp m)
+                (integerp n)
+                (not (= n 0)))
+           (iff (= (mod m n) 0)
+                (integerp (/ m n))))
+  :rule-classes ())
+
+(defthm mod-mult-n
+  (equal (mod (* a n) n)
+         (* n (mod a 1))))
+
+(defthm mod-mult-n-commuted
+  (equal (mod (* n a) n)
+         (* n (mod a 1))))
+
+(defthm mod-squeeze
+    (implies (and (= (mod m n) 0)
+		  (< m (* (1+ a) n))
+                  (< (* (1- a) n) m)
+                  (integerp a)
+		  (integerp m)
+		  (integerp n))
+	     (= m (* a n)))
+  :rule-classes ())
+
+(defthm mod-must-be-n
+    (implies (and (= (mod m n) 0)
+		  (< m (* 2 n))
+                  (< 0 m)
+		  (rationalp m)
+		  (rationalp n))
+	     (= m n))
+  :rule-classes ())
+
+(defthm mod-0-0
+  (implies (and (integerp p)
+                (rationalp m)
+                (rationalp n))
+           (iff (= (mod m (* n p)) 0)
+                (and (= (mod m n) 0)
+                     (= (mod (fl (/ m n)) p) 0))))
+  :rule-classes ())
+
+(defthm mod-equal-int
+  (implies (and (= (mod a n) (mod b n))
+                (rationalp a)
+                (rationalp b))
+           (integerp (/ (- a b) n)))
+  :rule-classes ())
+
+(defthm mod-equal-int-reverse
+  (implies (and (integerp (/ (- a b) n))
+                (rationalp a)
+                (rationalp b)
+                (rationalp n)
+                (< 0 n))
+           (= (mod a n) (mod b n)))
+  :rule-classes ())
+
+(defthm mod-force-equal
+  (implies (and (< (abs (- a b)) n)
+                (rationalp a)
+                (rationalp b)
+                (integerp n))
+          (iff (= (mod a n) (mod b n))
+               (= a b)))
+  :rule-classes ())
+
+(defthm mod-mult
+    (implies (and (integerp a)
+                  (rationalp m)
+		  (rationalp n))
+	     (equal (mod (+ m (* a n)) n)
+		    (mod m n))))
+
+(defthm mod-force
+  (implies (and (<= (* a n) m)
+                (< m (* (1+ a) n))
+                (integerp a)
+                (rationalp m)
+                (rationalp n))
+           (= (mod m n) (- m (* a n))))
+  :rule-classes ())
+
+(defthm mod-bnd-3
+  (implies (and (< m (+ (* a n) r))
+                (<= (* a n) m)
+                (integerp a)
+                (case-split (rationalp m))
+                (case-split (rationalp n)))
+           (< (mod m n) r))
+  :rule-classes :linear)
+
+(defthmd mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ a (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthmd mod-mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ (mod a n) (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthm mod-diff
+  (implies (and (case-split (rationalp a))
+                (case-split (rationalp b)))
+           (equal (mod (- a (mod b n)) n)
+                  (mod (- a b) n))))
+
+(defthm mod-of-mod
+  (implies (and (case-split (natp k))
+                (case-split (natp n)))
+           (equal (mod (mod x (* k n)) n)
+                  (mod x n))))
+
+(defthm mod-of-mod-cor
+  (implies (and (<= b a)
+                (case-split (integerp b))
+                (case-split (integerp a)))
+           (equal (mod (mod x (expt 2 a)) (expt 2 b))
+                  (mod x (expt 2 b)))))
+
+(defthm mod-prod
+  (implies (and (rationalp m)
+                (rationalp n)
+                (rationalp k))
+           (equal (mod (* k m) (* k n))
+                  (* k (mod m n)))))
+
+(defthm mod012
+  (implies (integerp m)
+           (or (equal (mod m 2) 0)
+               (equal (mod m 2) 1)))
+  :rule-classes ())
+
+(defthm mod-plus-mod-2
+  (implies (and (integerp a)
+                (integerp b))
+           (iff (= (mod (+ a b) 2) (mod a 2))
+                (= (mod b 2) 0)))
+  :rule-classes ())
+
+(defthm mod-mod-2-not-equal
+  (implies (acl2-numberp m)
+           (not (= (mod m 2) (mod (1+ m) 2))))
+  :rule-classes ())
+
+(defthm mod-2*m+1-rewrite
+  (implies (integerp m)
+           (equal (mod (1+ (* 2 m)) 2) 1)))
+
+;; Mon Mar  5 13:50:08 2007
+
+(defthm mod-mod-times
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (> n 0))
+	     (= (mod (* (mod a n) b) n)
+		(mod (* a b) n)))
+  :rule-classes ())
+
+
+(defthm mod-times-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (* a c) n) (mod (* b c) n)))
+  :rule-classes ())
+
+
+(defthm mod-plus-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (+ a c) n) (mod (+ b c) n)))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/bits.lisp acl2-6.3/books/rtl/rel9/support/lib2/bits.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/bits.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,852 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "basic")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0))))
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i))))))))
+
+(defthm bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (natp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :rule-classes ())
+
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+		(integerp k)
+		(<= 0 k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ())
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthm bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+;;See also bits-dont-match.
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+;;See also bits-match.
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthmd bitn-shift
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthmd bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m)))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (natp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+; The lemmas sumbits-badguy-is-correct and sumbits-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t)))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp m) (< 0 m)
+                              (integerp n) (< 0 n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;;Definition of the macro, cat:
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/bvecp-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2/bvecp-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/bvecp-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/bvecp-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,65 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(local (include-book "../support/bvecp-helpers"))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (integerp (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+(local (include-book "../../arithmetic/basic"))
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/bvecp-raw-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2/bvecp-raw-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/bvecp-raw-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/bvecp-raw-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,799 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;Contains bvecp lemmas about the RTL primitives.
+;Also contains type lemmas (non-negative integer, natp, etc.)
+
+(include-book "rtl")
+(include-book "rtlarr")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+(set-match-free-default :all)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;; bits
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+   (implies (and (<= (+ 1 i (- j)) k)
+                 (case-split (integerp k))
+                 )
+            (bvecp (bits x i j) k)))
+
+
+;; setbits
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k)))
+
+
+;; setbitn
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k)))
+
+
+
+;; log<
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+
+;; log<=
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+
+
+;; log>
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+
+
+;; log>=
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+
+
+;; log=
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+
+
+;; log<>
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+
+
+;; logand1
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+
+
+;; logior1
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+
+
+;; logxor1
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+
+
+;; lnot
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+;; bitn
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes ( :type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+;; shft
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k)))
+
+;; cat
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+
+;; logand
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n)))
+
+
+;; logior
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+
+;; mulcat
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n)))
+|#
+
+;; encode
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k)))
+           (bvecp (encode x n) k)))
+
+
+;; decode
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+;BOZO dup?
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+
+; land
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+;; lior
+
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+;; lxor
+
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+;; cat
+
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x)))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x)))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
+
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
+
+;remove these?
+
+
+;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
+;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
+;;;;;;;;;;;;;;;;;;; statements have no default.
+
+;maybe leave this one?
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t)))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t)))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t)))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t)))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t)))
+|#
+
+#|
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+|#
+
+#|
+;drop?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j))
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/cert.lsp acl2-6.3/books/rtl/rel9/support/lib2/cert.lsp
--- acl2-6.2/books/rtl/rel9/support/lib2/cert.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/cert.lsp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,51 @@
+(certify-book "rtl")
+
+:u
+
+(certify-book "rtlarr")
+
+:u
+
+(certify-book "basic")
+
+:u
+
+(certify-book "bits")
+
+:u
+
+(certify-book "log")
+
+:u
+
+(certify-book "float")
+
+:u
+
+(certify-book "reps")
+
+:u
+
+(certify-book "round")
+
+:u
+
+(certify-book "add")
+
+:u
+
+(certify-book "arith")
+
+:u
+
+(certify-book "package-defs")
+
+:u
+
+(certify-book "util")
+
+:u
+
+(certify-book "top")
+
+:u
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/clocks.lisp acl2-6.3/books/rtl/rel9/support/lib2/clocks.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/clocks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/clocks.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,199 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Most or all of this was originally written by Eric Smith while an intern at AMD.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../support/clocks")
+
+; The analysis of clocks uses some new functions.
+; 
+; First, even and odd are not the same as evenp and oddp.  For one thing, even
+; and odd are defined recursively, and I've proved a bunch of nice rules about
+; them which we probably want to use and which may not be proved about evenp and
+; oddp (and which may be nicer than what is proveable about evenp and oddp).  One
+; nice property of even and odd is that each implies integerp.  (By contrast,
+; evenp returns t for non-numbers like nil or '(a b).)  So rules which would
+; naturally have both the hyp (integerp n) and the hyp (evenp n) now can just
+; have (even n).
+; 
+; Second, I also define a function, MOD4. I didn't want to use MOD itself in the
+; clocking logic because reasoning about clocks needs to be fast and predictable.
+; (I can imagine that we'll have rules about MOD, especially when doing FP
+; proofs, which will just get in the way of our reasoning about clocks. We might
+; even open up MOD on occasion.)  So, in order to get complete control over the
+; rules which fire when we reason about clocks, I introduced MOD4, which we
+; expect never to have to open after proving a nice set of rules about it.
+; 
+; Also, theorems about MOD4 may be nicer than their analogs for MOD.  For
+; example, MOD4 is always equal to 0, 1, 2, or 3, but (mod #c(0 1) 4) = #c(0 1),
+; which isn't even rational.
+
+(defund pedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 0)
+       (equal y 1)))
+
+(defund nedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 1)
+       (equal y 0)))
+
+(defmacro posedge (clk)
+  `(and (not (zp n))
+        (pedge (,clk (1- n)) (,clk n))))
+
+(defmacro negedge (clk)
+  `(and (not (zp n))
+        (nedge (,clk (1- n)) (,clk n))))
+
+(defthm pedge-known-false-1
+  (not (pedge x 0)))
+
+(defthm pedge-known-false-2
+  (not (pedge 1 y)))
+
+(defthm nedge-known-false-1
+  (not (nedge x 1)))
+
+(defthm nedge-known-false-2
+  (not (nedge 0 y)))
+
+
+; The call (defperiodic NAME TYPE) creates 1) a defun which defines NAME to be
+; a periodic signal of the specified TYPE and 2) a bvecp lemma for that defun
+; (all periodics have width 1).
+
+; We intend the user to smash certain periodic inputs to his top level module
+; and replace their translations with calls to defperiodic.
+
+; Currently we support the following types of periodic signals:
+
+#|
+
+'fast-clock : 
+
+ _   _   _   _   _   _   _
+| |_| |_| |_| |_| |_| |_| |_|
+
+
+'slow-clock-one-quantum-wide
+
+ _       _       _       _
+| |_____| |_____| |_____| |__
+
+
+'slow-clock-one-quantum-wide-shifted :
+
+     _       _       _       _
+____| |_____| |_____| |_____| |__
+
+
+'slow-clock-two-quanta-wide :
+
+ ___     ___     ___     ___     
+|   |___|   |___|   |___|   |___|
+
+
+'slow-clock-two-quanta-wide-shifted :
+
+     ___     ___     ___     
+|___|   |___|   |___|   |___|
+
+'always-1 :
+
+  ___________________________
+..
+
+
+|#
+
+; As the need arises, we can easily change defperiodic to add support for more
+; types of signal.
+
+; BTW, currently, the definitions generated by defperiodic return unknown
+; values (calls to reset) at time 0 (and whenever N is not a natp).  Perhaps
+; this is too conservative, and perhaps defining the value at time 0 would
+; allow nicer rewrite rules to be proved.
+
+(defconst *defperiodic-types*
+
+; Keep this in sync with the corresponding definition in the compiler.
+
+  '(fast-clock
+    slow-clock-one-quantum-wide
+    slow-clock-one-quantum-wide-shifted
+    slow-clock-two-quanta-wide
+    slow-clock-two-quanta-wide-shifted
+    always-1))
+
+(defmacro defperiodic (name type)
+  (declare (xargs :guard (member-eq type *defperiodic-types*)))
+  (list*
+   'encapsulate
+   nil
+   (case type
+     (fast-clock
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (even n) 1 0))))
+     (slow-clock-one-quantum-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 0 (mod4 n)) 1 0))))
+     (slow-clock-one-quantum-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 2 (mod4 n)) 1 0))))
+     (slow-clock-two-quanta-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 0 (mod4 n))
+                   (equal 1 (mod4 n)))
+               1
+             0))))
+     (slow-clock-two-quanta-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 2 (mod4 n))
+                   (equal 3 (mod4 n)))
+               1
+             0))))
+     (always-1
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           1)))
+     (otherwise (er hard 'defperiodic
+                    "Bad type, ~x0, for defperiodic."
+                    type)))
+   `((defbvecp ,name (n) 1 :hints (("Goal" :in-theory (enable ,name)))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/float.lisp acl2-6.3/books/rtl/rel9/support/lib2/float.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/float.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,906 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "log")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ())
+
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ())
+
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ())
+
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ())
+
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
+
+;;;***************************************************************
+;;;                 Floating-Point formats
+;;;***************************************************************
+
+
+(defund esgnf  (x p q) (bitn x (+ p q)))
+(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defund esigf  (x p)   (bits x (1- p) 0))
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defthmd sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+
+(defthmd expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+
+(defthmd sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+
+(defthm bcevp-nencode
+  (implies (and (equal k (+ p q))
+                (natp p)
+                (natp q))
+           (bvecp (nencode x p q) k)))
+
+(defthmd nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+
+(defthmd nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+
+(defthmd nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+
+(defthmd ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+(defthmd sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+
+(defthmd expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+
+(defthmd sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(r))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+(defthmd drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+
+(defthmd dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+
+(defthmd dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+
+(defthmd ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+
+;; (defthmd spd-mult
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;; 		(rationalp r)
+;; 		(= m (/ r (spd p q))))
+;; 	   (iff (drepp r p q)
+;; 		(and (natp m)
+;; 		     (<= 1 m)
+;; 		     (< m (expt 2 (1- p)))))))
+;; not true!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
+
+
+(defund rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/log.lisp acl2-6.3/books/rtl/rel9/support/lib2/log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/log.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,854 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "bits")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                     LNOT
+;;;**********************************************************************
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthmd lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot x n) k)))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n))))))
+
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n)))))))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n))))
+
+(defthm mod-lnot
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot x n) (expt 2 k))
+                  (lnot (mod x (expt 2 k)) k))))
+
+(defthmd bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j))))))
+
+(defthmd bitn-lnot
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn (lnot x n) k)
+		  (if (< k n)
+		      (lnot (bitn x k) 1)
+		    0))))
+
+(defthmd lnot-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot (cat x m y n) l)
+		  (cat (lnot x m) m (lnot y n) n))))
+
+
+;;;**********************************************************************
+;;;                LAND, LIOR, and LXOR
+;;;**********************************************************************
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land)))
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior)))
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor)))
+
+(defun logop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (logop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun logop-3-induct (x y z)
+  (declare (xargs :measure (:? x y z)))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(logop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defthm land-x-y-0
+    (equal (land x y 0) 0))
+
+(defthm lior-x-y-0
+    (equal (lior x y 0) 0))
+
+(defthm lxor-x-y-0
+    (equal (lxor x y 0) 0))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0) y n)
+         (land x y n)))
+
+(defthmd land-bits-2
+  (equal (land x (bits y (1- n) 0) n)
+         (land x y n)))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0) y n)
+         (lior x y n)))
+
+(defthmd lior-bits-2
+  (equal (lior x (bits y (1- n) 0) n)
+         (lior x y n)))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0) y n)
+         (lxor x y n)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x (bits y (1- n) 0) n)
+         (lxor x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land x y n) k)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior x y n) k)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor x y n) k)))
+
+(defthm land-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land x y n) m)))
+
+(defthm lior-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior x y n) m)))
+
+(defthm lxor-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor x y n) m)))
+
+(defthmd land-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land x y m) (land x y n))))
+
+(defthmd lior-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior x y m) (lior x y n))))
+
+(defthmd lxor-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor x y m) (lxor x y n))))
+
+(defthmd land-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lior-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lxor-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (bitn x 0) (bitn y 0) 1)))))
+
+(defthm land-0
+  (equal (land 0 y n)
+	 0))
+
+(defthmd land-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land i j 1))
+		  (or (equal i 0)
+		      (equal j 0)))))
+
+(defthm lior-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior 0 y n) y)))
+
+(defthmd lior-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior x y n))
+		  (and (equal x 0)
+		       (equal y 0)))))
+
+(defthm lxor-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor 0 y n) y)))
+
+(defthm land-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land x y (- n k)))))
+  :rule-classes ())
+
+(defthm lxor-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor x y (- n k)))))
+  :rule-classes ())
+
+(defthm lior-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior x y (- n k)))))
+  :rule-classes ())
+
+(defthmd fl-land
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
+                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lior
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
+                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lxor
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
+                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd mod-land
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land x y n) (expt 2 k))
+                  (land x y k))))
+
+(defthmd mod-lior
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior x y n) (expt 2 k))
+                  (lior x y k))))
+
+(defthmd mod-lxor
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor x y n) (expt 2 k))
+                  (lxor x y k))))
+
+(defthm bits-land
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (land x y n) i j)
+		  (land (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lior
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lior x y n) i j)
+		  (lior (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lxor
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lxor x y n) i j)
+		  (lxor (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bitn-land
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (land x y n) k)
+		  (if (< k n)
+		      (land (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lior
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lior x y n) k)
+		  (if (< k n)
+		      (lior (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lxor
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lxor x y n) k)
+		  (if (< k n)
+		      (lxor (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthmd land-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (land x1 x2 m) m (land y1 y2 n) n))))
+
+(defthm land-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land c (cat x2 m y2 n) l)
+		  (cat (land (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (land (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lior-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lior x1 x2 m) m (lior y1 y2 n) n))))
+
+(defthm lior-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior c (cat x2 m y2 n) l)
+		  (cat (lior (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lior (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lxor-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n))))
+
+(defthm lxor-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor c (cat x2 m y2 n) l)
+		  (cat (lxor (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthm land-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land x y n) x))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior x y n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm lxor-bnd
+  (<= (lxor x y n) (lior x y n))
+  :rule-classes (:rewrite :linear))
+
+(defthmd lior-plus
+  (implies (= (land x y n) 0)
+           (equal (lior x y n)
+                  (+ (bits x (1- n) 0)
+                     (bits y (1- n) 0)))))
+
+(defthmd land-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m)))))))
+
+(defthm lior-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ())
+
+(defthmd land-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land x (expt 2 k) n)
+		  (* (expt 2 k) (bitn x k)))))
+
+(defthm lior-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior x (expt 2 k) n)
+		(+ (bits x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ())
+
+(defthmd lxor-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor x (expt 2 k) n)
+		  (+ (bits x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn x k))))))))
+
+(defthm land-ones
+  (equal (land (1- (expt 2 n)) x n)
+	 (bits x (1- n) 0))
+  :rule-classes nil)
+
+(defthm land-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land k x n)
+		  (bits x (1- n) 0))))
+
+(defthm lior-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ())
+
+(defthm lior-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior k x n)
+		  (1- (expt 2 n)))))
+
+(defthm lxor-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor (1- (expt 2 n)) x n)
+		  (lnot x n)))
+  :rule-classes ())
+
+(defthm lxor-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor k x n)
+		  (lnot x n))))
+
+(defthm land-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ())
+
+(defthmd lior-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j))))
+
+(defthmd lxor-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i) (- n i)
+                       (lnot (bits x (1- i) j) (- i j)) (- i j)
+                       (bits x (1- j) 0) j))))
+
+(defthmd land-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot (lnot x n) n)
+		  x)))
+
+(defthm land-commutative
+  (equal (land y x n)
+	 (land x y n)))
+
+(defthm lior-commutative
+  (equal (lior y x n)
+	 (lior x y n)))
+
+(defthm lxor-commutative
+  (equal (lxor y x n)
+	 (lxor x y n)))
+
+(defthm land-associative
+  (equal (land (land x y n) z n)
+	 (land x (land y z n) n)))
+
+(defthm lior-associative
+  (equal (lior (lior x y n) z n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-associative
+  (equal (lxor (lxor x y n) z n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-commutative-2
+  (equal (land y (land x z n) n)
+	 (land x (land y z n) n)))
+
+(defthm lior-commutative-2
+  (equal (lior y (lior x z n) n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-commutative-2
+  (equal (lxor y (lxor x z n) n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land x (land y z n) n)
+		  (land (land x y n) z n))))
+
+(defthm lior-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior x (lior y z n) n)
+		  (lior (lior x y n) z n))))
+
+(defthm lxor-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor x (lxor y z n) n)
+		  (lxor (lxor x y n) z n))))
+
+(defthm land-self
+  (equal (land x x n)
+	 (bits x (1- n) 0)))
+
+(defthm lior-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior x x n) x)))
+
+(defthm lxor-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor x x n) 0)))
+
+(defthmd lior-land-1
+  (equal (lior x (land y z n) n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd lior-land-2
+  (equal (lior (land y z n) x n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd land-lior-1
+  (equal (land x (lior y z n) n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd land-lior-2
+  (equal (land (lior y z n) x n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd lior-land-lxor
+  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
+	 (lior (land x y n) (land (lxor x y n) z n) n)))
+
+(defthmd lxor-rewrite
+  (equal (lxor x y n)
+	 (lior (land x (lnot y n) n)
+	       (land y (lnot x n) n)
+	       n)))
+
+(defthmd lnot-lxor
+  (equal (lnot (lxor x y n) n)
+	 (lxor (lnot x n) y n)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/mult.lisp acl2-6.3/books/rtl/rel9/support/lib2/mult.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/mult.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/mult.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,482 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "add")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta (i y)
+  (+ (bitn y (1- (* 2 i))) 
+     (bitn y (* 2 i))
+     (* -2 (bitn y (1+ (* 2 i))))))
+
+
+(defun sum-theta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta (1- m) y))
+	(sum-theta (1- m) y))))
+
+
+
+(defthm sum-theta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta m y)))
+  :rule-classes ())
+
+
+(defun bmux4 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (lnot x n))
+    (2  (* 2 x))
+    (-2 (lnot (* 2 x) n))
+    (0  0)))
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+
+(defun pp4 (i x n)
+  (if (zerop i)
+      (cat 1 1
+	   (lnot (neg (zeta i)) 1) 1
+	   (bmux4 (zeta i) x n) n)
+    (cat 1 1
+	 (lnot (neg (zeta i)) 1) 1
+	 (bmux4 (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4 (x m n)
+  (if (zp m)
+      0
+    (+ (pp4 (1- m) x n)
+       (sum-pp4 x (1- m) n))))
+
+
+(defthm booth4-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4 x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ())
+
+(defun pp4-theta (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (theta i y)) 1) 1
+	    (bmux4 (theta i y) x n) n)
+     (cat 1 1
+	  (lnot (neg (theta i y)) 1) 1
+	  (bmux4 (theta i y) x n) n
+	  0 1
+	  (neg (theta (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-theta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-theta (1- m) x y n)
+       (sum-pp4-theta x y (1- m) n))))
+
+
+(defthm booth4-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits y (1+ (* 2 i)) (* 2 i)) (chi i y)))
+ 
+ (defun chi (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu (1- i) y) 3)
+	 1
+       0))))
+
+
+(defun phi (i y)
+  (if (= (bits (mu i y) 1 0) 3)
+      -1
+    (bits (mu i y) 1 0)))
+
+(defthm phi-bnd
+    (member (phi i y) '(-1 0 1 2)))
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+
+(defthm chi-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+  :rule-classes())
+
+
+(defthm phi-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi (1- m) y) 0))
+  :rule-classes())
+
+(defun sum-phi (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi (1- m) y))
+	(sum-phi (1- m) y))))
+
+
+(defthm sum-phi-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi m y)))
+  :rule-classes ())
+
+(defun pp4-phi (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (phi i y)) 1) 1
+	    (bmux4 (phi i y) x n) n)
+     (cat 1 1
+	  (lnot (neg (phi i y)) 1) 1
+	  (bmux4 (phi i y) x n) n
+	  0 1
+	  (neg (phi (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-phi (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-phi (1- m) x y n)
+       (sum-pp4-phi x y (1- m) n))))
+
+
+(defthm static-booth
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+
+(defun gamma (i a b c)
+   (if (zp i)
+       (bitn c 0)
+     (lior (bitn  a (+ -1  (* 2 i)))
+ 	   (bitn  b (+ -1  (* 2 i)))
+ 	  1)))
+
+(defun delta (i a b c d)
+  (if (zp i)
+      (bitn d 0)
+    (land (lior (land (bitn a (+ -2 (* 2 i))) 
+                      (bitn b (+ -2 (* 2 i)))
+                      1)
+		(lior (land (bitn a (+ -2 (* 2 i)))
+                            (gamma (1- i) a b c) 
+                            1)
+		      (land (bitn b (+ -2 (* 2 i)))
+                            (gamma (1- i) a b c)
+                            1)
+                      1)
+                1)
+	  (lnot (lxor (bitn a (1- (* 2 i))) 
+                      (bitn b (1- (* 2 i))) 
+                      1) 
+                1)
+	  1)))
+
+
+(defun psi (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits a (1+ (* 2 i)) (* 2 i))
+       (bits b (1+ (* 2 i)) (* 2 i))
+       (gamma i a b c)
+       (delta i a b c d)
+       (* -4 (+ (gamma (1+ i) a b c)
+                (delta (1+ i) a b c d))))))
+
+
+(defthm psi-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))   
+		  (bvecp b (- (* 2 m) 2))  
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma m a b c) 0)
+		  (equal (delta m a b c d) 0)
+		  (>= (psi (1- m) a b c d) 0)))
+  :rule-classes ())
+
+
+(defun sum-psi (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi (1- m) a b c d))
+	(sum-psi (1- m) a b c d))))
+
+
+(defthm sum-psi-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi m a b c d)))
+  :rule-classes ())
+
+
+
+(defthmd psi-bnd
+  (and (integerp (psi i a b c d))
+       (<= (psi i a b c d) 2)
+       (>= (psi i a b c d) -2)))
+
+(defun pp4-psi (i x a b c d n)
+   (if (zerop i)
+       (cat 1 1
+	    (lnot (neg (psi i a b c d)) 1) 1
+	    (bmux4 (psi i a b c d) x n) n)
+     (cat 1 1
+	  (lnot (neg (psi i a b c d)) 1) 1
+	  (bmux4 (psi i a b c d) x n) n
+	  0 1
+	  (neg (psi (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-psi (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4-psi (1- m) x a b c d n)
+       (sum-pp4-psi x a b c d (1- m) n))))
+
+
+
+(defthm redundant-booth
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+
+(defun eta (i y)
+  (+ (bitn y (1- (* 3 i))) 
+     (bitn y (* 3 i))
+     (* 2 (bitn y (1+ (* 3 i))))
+     (* -4 (bitn y (+ 2 (* 3 i))))))
+
+
+(defun sum-eta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta (1- m) y))
+	(sum-eta (1- m) y))))
+
+
+(defthm sum-eta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta m y)))
+  :rule-classes ())
+
+
+(defun bmux8 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (lnot x n))
+    (2  (* 2 x))
+    (-2 (lnot (* 2 x) n))
+    (3  (* 3 x))
+    (-3 (lnot (* 3 x) n))
+    (4  (* 4 x))
+    (-4 (lnot (* 4 x) n))
+    (0  0)))
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+
+(defun pp8 (i x n)
+  (if (zerop i)
+      (cat 3 2
+	   (lnot (neg (xi i)) 1) 1
+	   (bmux8 (xi i) x n) n)
+    (cat 3 2
+	 (lnot (neg (xi i)) 1) 1
+	 (bmux8 (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8 (x m n)
+  (if (zp m)
+      0
+    (+ (pp8 (1- m) x n)
+       (sum-pp8 x (1- m) n))))
+
+
+(defthm booth8-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8 x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ())
+
+(defun pp8-eta (i x y n)
+  (if (zerop i)
+      (cat 3 2
+	   (lnot (neg (eta i y)) 1) 1
+	   (bmux8 (eta i y) x n) n)
+    (cat 3 2
+	 (lnot (neg (eta i y)) 1) 1
+	 (bmux8 (eta i y) x n) n
+	 0 2
+	 (neg (eta (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+(defun sum-pp8-eta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8-eta (1- m) x y n)
+       (sum-pp8-eta x y (1- m) n))))
+
+
+(defthm booth8-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8-eta x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/openers.lisp acl2-6.3/books/rtl/rel9/support/lib2/openers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/openers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/openers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,74 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/openers"))
+
+(program)
+
+; In this file, an event-control (evctl) data structure is either (posedge
+; clk), (negedge clk), or (even n).
+
+(defun negate-event-control (evctl)
+  (if (equal evctl '(even n))
+      (list 'not evctl)
+    (let* ((edge0 (car evctl))
+           (clk (cadr evctl))
+           (edge (case edge0
+                   (posedge 'pedge)
+                   (negedge 'nedge)
+                   (otherwise
+                    (er hard 'gen-model-preamble-common
+                        "Unable to handle edge specifier ~x0."
+                        edge0)))))
+      `(not (,edge (,clk (1- n)) (,clk n))))))
+
+(defun negate-event-control-list (x)
+  (declare (xargs :guard (true-listp x)))
+  (if (endp x)
+      nil
+    (cons (negate-event-control (car x))
+          (negate-event-control-list (cdr x)))))
+
+(defmacro def$open (name type &rest evctl-lst)
+  (if (eq type :skipped)
+      `(value-triple '(def$open ,name :skipped))
+    (let ((evctl-lst (if (eq type :input)
+                         (assert$ (null evctl-lst)
+                                  '((even n)))
+                       evctl-lst)))
+      `(defthm ,(intern-in-package-of-symbol
+                 (concatenate 'string (symbol-name name) "$OPEN")
+                 name)
+         (implies (and (integerp n)
+                       (< 0 n)
+                       ,@(negate-event-control-list evctl-lst))
+                  (equal (,name n)
+                         (,name (1- n))))
+         :hints (("Goal"
+                  :expand ((,name n)
+                           ,@(and (eq type :wire) `((,name (1- n)))))))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/package-defs.lisp acl2-6.3/books/rtl/rel9/support/lib2/package-defs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/package-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/package-defs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,82 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/package-defs"))
+
+;;Miscellaneous symbols that are not in *acl2-exports*:
+
+(defmacro other-acl2-symbols ()
+  ''(local-defun local-defthm local-in-theory
+                 n ; clock argument
+                 defbvecp ; macro written out by compiler
+                 defclock ; macro written out by compiler
+                 defperiodic
+                 fast-clock  ;BOZO, is importing these into the packages, the right way to handle this?
+                 slow-clock-one-quantum-wide
+                 slow-clock-one-quantum-wide-shifted
+                 slow-clock-two-quanta-wide
+                 slow-clock-two-quanta-wide-shifted
+                 always-1
+                 posedge negedge edge ; for defclock macro, which we used to use
+                 pedge nedge ;for defperiodic macro
+                 $path ; path argument of signal functions
+                 sub1-induction ; for bvecp lemma hints
+                 ))
+
+;;Symbols that occur in the RTL translation.  Formerly the symbol UNKNOWN was excluded from this
+;;list so that the corresponding symbol in the "*" package could be assigned a different function
+;;definition; but the first argument of unknown can be in any package desired.
+
+(defmacro rtl-symbols ()
+  ''(log= log<> log< log<= log> log>= lnot logand1 logior1 logxor1 shft lshft
+          rshft cat mulcat bitn bits setbits setbitn mod+ mod* mod- bind
+          case-select if1 cond1 reset reset2 land lior lxor lcat n! arr0 natp1
+          as ag mk-bvarr mk-bvec ag2 as2
+          abs trunc near minf inf sticky sig expo bitvec ; appeared May 2004 (from rpl_main.cc)
+          expt ; appeared May 2004 (seems to come from r2s)
+          prop gen
+          unknown unknown2))
+
+;;Functions that are defined in the FP library:
+
+(defmacro fp-symbols ()
+  ''(natp fl cg fl-half bvecp bv-arrp sumbits sigm kap tau lamt lamg lamz lam1 lam2 lam3 lam4 lam0 lamb
+          expo sgn sig 
+          exactp fp+ bias esgnf eexpof esigf erepp eencodingp eencode edecode ndecode rebias-expo isgnf iexpof isigf 
+          nrepp drepp irepp nencodingp dencodingp iencodingp nencode dencode iencode ddecode idecode trunc away re 
+          near near-witness near+ sticky oddr kp inf minf ieee-mode-p rnd flip
+          rnd-const drnd drnd-original))
+
+;;ACL2 symbols that are imported by all packages:
+
+(defmacro shared-symbols ()
+  '(union-eq *acl2-exports*
+    (union-eq *common-lisp-symbols-from-main-lisp-package*
+     (union-eq (other-acl2-symbols)
+      (union-eq (fp-symbols)
+       (rtl-symbols))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/reps.lisp acl2-6.3/books/rtl/rel9/support/lib2/reps.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/reps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/reps.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,542 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;; (local (include-book "../support/ereps"))
+;; (local (include-book "../support/ireps"))
+;; (local (include-book "../support/guards"))
+
+(local (include-book "base"))
+
+(include-book "log")
+(include-book "float")
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;BOZO add rewrite rule?
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;BOZO disable?
+(defun esgnf  (x p q) (bitn x (+ p q)))
+(defun eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defun esigf  (x p)   (bits x (1- p) 0))
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+(defthm eencodingp-not-zero
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode x p q) 0))))
+
+(defthm erepp-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode x p q) p q)))
+
+
+(defthm eencodingp-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp (eencode x p q) p q) ))
+
+(defthm edecode-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode (eencode x p q) p q)
+		    x)))
+
+(defthm eencode-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode (edecode x p q) p q)
+		    x)))
+
+(defthm expo-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode x p q))
+		    (- (eexpof x p q) (bias q)))))
+
+(defthm sgn-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode  x p q))
+		    (if (= (esgnf x p q) 0) 1 -1))))
+
+(defthm sig-edecode
+    (implies (and (eencodingp  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode  x p q))
+		    (/ (esigf x p) (expt 2 (- p 1))))))
+
+;BOZO disable?
+(defun rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(defund iencodingp (x p q)
+  (or (nencodingp x p q)
+      (dencodingp x p q)))
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp-and-dencodingp
+    (implies (iencodingp x p q)
+	     (iff (nencodingp x p q) (not (dencodingp x p q))))
+  :rule-classes ())
+
+
+;;Encoding functions:
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(defund iencode (x p q)
+  (cond ((nrepp x p q)
+	 (nencode x p q))
+	((drepp x p q)
+	 (dencode x p q))))
+
+
+;;Decoding functions:
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(defund idecode (x p q)
+  (cond ((nencodingp x p q)
+	 (ndecode x p q))
+	((dencodingp x p q)
+	 (ddecode x p q))))
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+(defthm sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+(defthm sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+(defthm sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+(defthm sgn-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode x p q))
+	      (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode x p q))
+	      (cond ((nencodingp x p q)
+		     (- (iexpof x p q) (bias q)))         
+		    ((dencodingp x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))))
+
+(defthm sig-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode x p q))
+		    (cond ((nencodingp x p q)
+			   (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
+			  ((dencodingp x p q)
+			   (sig (isigf x p)))))))
+
+
+;;Inversions:
+
+(defthm dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+(defthm iencodingp-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp (iencode x p q) p q)))
+
+(defthm nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+(defthm drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+(defthm irepp-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode x p q) p q)))
+
+(defthm nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+(defthm ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+(defthm ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+(defthm idecode-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode (iencode x p q) p q)
+		    x)))
+
+(defthm nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+(defthm dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+(defthm iencode-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode (idecode x p q) p q)
+		    x)))
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/rom-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2/rom-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/rom-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/rom-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,64 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../support/rom-helpers"))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+(local (in-theory (enable bvecp)))
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(defun check-array (name a dim1 dim2)
+  (if (zp dim1)
+      t
+    (and (bvecp (aref1 name a (1- dim1)) dim2)
+	 (check-array name a (1- dim1) dim2))))
+
+(defthm check-array-lemma-1
+    (implies (and (not (zp dim1))
+		  (check-array name a dim1 dim2)
+		  (natp i)
+		  (< i dim1))
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+(defthm check-array-lemma
+    (implies (and (bvecp i n)
+		  (not (zp (expt 2 n)))
+		  (check-array name a (expt 2 n) dim2))		  
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/round.lisp acl2-6.3/books/rtl/rel9/support/lib2/round.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/round.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/round.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1770 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "float")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ())
+
+
+(defthm trunc-land
+    (implies (and (>= x (expt 2 (1- n)))
+		  (< x (expt 2 n))
+                  (integerp x) (> x 0)
+		  (integerp m) (>= m n)
+		  (integerp n) (> n k)
+		  (integerp k) (> k 0))
+	     (= (trunc x k)
+		(land x (- (expt 2 m) (expt 2 (- n k))) n)))
+  :rule-classes ())
+
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m)))))))
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+;; druss -- the following are wrong. 
+;;
+;; (defthm trunc-plus-minus
+;;     (implies (and (rationalp x)
+;; 		  (rationalp y)
+;; 		  (not (= x 0))
+;; 		  (not (= y 0))
+;; 		  (not (= (+ x y) 0))
+;; 		  (integerp k)
+;; 		  (> k 0)
+;; 		  (= k1 (+ k (- (expo x) (expo y))))
+;; 		  (= k2 (- (expo (+ x y)) (expo y)))
+;; 		  (exactp x k1)
+;; 		  (> k2 0))
+;; 	     (equal (+ x (trunc y k))
+;; 		    (if (= (sgn (+ x y)) (sgn y))
+;; 			(trunc (+ x y) k2)
+;; 		      (away (+ x y) k2))))
+;;   :rule-classes ())
+;; 
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+;;
+;; druss: the following may be wrong. 
+;;
+;; (defthm expo-near
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (near x n))
+;;                     (expo x)))
+;;   :rule-classes ())
+
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+(defun roundup (x mode n)
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+
+
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/rtl.lisp acl2-6.3/books/rtl/rel9/support/lib2/rtl.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/rtl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/rtl.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,699 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;This book contains definitions of the ACL2 functions that are used in the
+;;formalization of RTL semantics.
+
+
+;;Bit-vector access:
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp m) (< 0 m)
+                              (integerp n) (< 0 n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;;LNOT (bitwise complement):
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+;LAND (bitwise and):
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec ; (land0 x y n)
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land)) to refer to binary-land.
+(add-macro-alias land binary-land)
+
+;;LIOR (bitwise inclusive or):
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec ; (lior0 x y n)
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior)) to refer to binary-lior:
+(add-macro-alias lior binary-lior)
+
+;;LXOR (bitwise exclusive or):
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor0 x y n)
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
+(add-macro-alias lxor binary-lxor)
+
+
+;;Bit-vector update:
+
+; We have decided to allow setbits to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits x w n n y))
+
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;;Signed inequalities:
+
+(defund comp2 (x n)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;;Unary logical operations:
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;;Shifting operations:
+
+(defund shft (x s l)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;;Arithmetic operations
+
+(defmacro mod+ (x y n)
+  `(bits (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod* (x y n)
+  `(bits (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
+i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
+get rid of the bits call.
+|#
+
+(defmacro mod- (x y n)
+  `(bits (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still
+;; need to add assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+
+;;Evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO Where in lib/ should these go?
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;;Natural number recognizer
+
+(defund natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(defund bvecp (x k)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+(defun mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+
+; Finally, we include bvecp (and, occasionally, related) lemmas for several
+; functions that are disabled.  These are not included elsewhere, presumably
+; because the functions will generally be enabled (hence blown away) by the
+; user.
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (shft x s n) k)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+;;The definitions of these functions are best disabled:
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable mk-bvec))
+(in-theory (disable if1))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/rtlarr.lisp acl2-6.3/books/rtl/rel9/support/lib2/rtlarr.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/rtlarr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/rtlarr.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,261 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;; (local (include-book "../support/rtlarr"))
+;; (local (include-book "../support/bvecp-helpers"))
+;; (local (include-book "../support/guards"))
+;; Fri Oct 27 15:38:29 2006
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+;;We define generic record accessing and updating functions to be used 
+;;with RTL arrays.  The basic functions are (ag a r) and (as a v r)
+;;where a is an array index, v is a value, r is an "array" or record.
+;;(ag a r) returns the value at index a in array r, and (as a v r) returns 
+;;a new array with index a set to value v in array r.
+
+(include-book "misc/total-order" :dir :system)
+
+(include-book "rtl")
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;Basic properties of arrays:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r)))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;; OK, we add here some properties for typing the records and the values which
+;; are stored in the records. This "typing" is pretty generic, but we choose the
+;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
+
+(defun bv-arrp (x k)
+  (declare (xargs :guard (integerp k)))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (bv-arrp (cdr x) k)
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (bvecp (cdar x) k)
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm as-maps-bv-arr-to-bv-arr
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as a v r) k)))
+
+(defthm ag-maps-bv-arr-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag a r) k)))
+
+(defun mk-bvarr (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bv-arrp r k) r ()))
+
+(defthm mk-bvarr-is-bv-arrp
+  (bv-arrp (mk-bvarr r k) k))
+
+(defthm mk-bvarr-identity
+  (implies (bv-arrp r k)
+           (equal (mk-bvarr r k) r)))
+
+(in-theory (disable bv-arrp mk-bvarr))
+
+;;We also define as2 and ag2 for 2-dimensional arrays but these simply
+;;macro-expand into appropriate as and ag calls.
+
+(defmacro ag2 (a b r)
+  `(ag (cons ,a ,b) ,r))
+
+(defmacro as2 (a b v r)
+  `(as (cons ,a ,b) ,v ,r))
+
+
+;;We disable as and ag, assuming the rules proved in this book are 
+;;sufficient to manipulate any record terms that are encountered.
+
+(in-theory (disable as ag))
+
+(defun positive-integer-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (equal l nil))
+        (t (and (integerp (car l))
+                (< 0 (car l))
+                (positive-integer-listp (cdr l))))))
+
+(defmacro arr0 (&rest dims)
+  (declare (ignore dims)
+           (xargs :guard (positive-integer-listp dims)))
+  nil)
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(encapsulate 
+ ((reset2 (key size) t))
+ (local (defun reset2 (key size) (declare (ignore key size)) nil))
+ (defthm bv-arrp-reset2
+   (bv-arrp (reset2 key size) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+(encapsulate 
+ ((unknown2 (key size n) t))
+ (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
+ (defthm bv-arrp-unknown2
+   (bv-arrp (unknown2 key size n) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+;BOZO where in lib/ should this go?
+(defthm bv-arrp-if1
+  (equal (bv-arrp (if1 x y z) n)
+         (if1 x (bv-arrp y n) (bv-arrp z n))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/simple-loop-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,357 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(include-book "arith")
+(include-book "log")
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I)))
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+
+;; (defthm bitn-setbitn-setbitn
+;;   (implies (and (<  j w)
+;;                 (<= 0 j) 
+;;                 (integerp w)
+;;                 (integerp j))
+;;            (equal (bitn (setbitn x w j y)
+;;                         j)
+;;                   (bitn y 0))))
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;not in support/simple-loop-helpers since would be redefined here (which is illegal)
+
+(deftheory simple-loop-thy-0
+  (union-theories '(if1) (theory 'minimal-theory)))
+
+(deftheory simple-loop-thy-1
+  (union-theories
+   '(bitn-setbitn-not-equal
+     ag-diff-as
+     bits-31-0
+     natp)
+   (theory 'simple-loop-thy-0)))
+
+(in-theory (enable setbits bitn-cat))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/simplify-model-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,107 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "arith")
+(include-book "bits")
+(local (include-book "../support/simplify-model-helpers"))
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1)))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(in-theory (enable bvecp-monotone))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/top.lisp acl2-6.3/books/rtl/rel9/support/lib2/top.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/top.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,62 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "rtl") ;semantics of the basic RTL primitives
+
+(include-book "rtlarr") ;semantics RTL array primitives
+
+(include-book "basic") ;properties of basic arithmetic functions: floor, ceiling, 
+;                       exponential, and remainder
+
+(include-book "bits") ;bit vectors
+
+(include-book "log") ;logical operations
+
+(include-book "float") ;floating-point numbers
+
+(include-book "reps") ;floating-point formats and representations
+
+(include-book "round") ;floating-point rounding
+
+(include-book "add") ;support for reasoning about floating-point addition
+;                      (leading one prediction and sticky bit computation)
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../arithmetic/top")
+
+(include-book "mult")  ; integerp multiplier
+
+(include-book "arith") ;general arithmetic package
+
+(include-book "util") ;misc helpful stuff including a few macros
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2/util.lisp acl2-6.3/books/rtl/rel9/support/lib2/util.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2/util.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2/util.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,151 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+;;These macros facilitate localization of events:
+
+(defmacro local-defun (&rest body)
+  (list 'local (cons 'defun body)))
+
+(defmacro local-defund (&rest body)
+  (list 'local (cons 'defund body)))
+
+(defmacro local-defthm (&rest body)
+  (list 'local (cons 'defthm body)))
+
+(defmacro local-defthmd (&rest body)
+  (list 'local (cons 'defthmd body)))
+
+(defmacro local-in-theory (&rest body)
+  (cons 'local
+	(cons (cons 'in-theory (append body 'nil))
+	      'nil)))
+
+(defmacro defbvecp (name formals width &key thm-name hyp hints)
+  (let* ((thm-name
+          (or thm-name
+              (intern-in-package-of-symbol
+               (concatenate 'string
+                            (if (consp width)
+                                "BV-ARRP$"
+                              "BVECP$")
+                            (symbol-name name))
+               name)))
+         (x (cons name formals))
+         (typed-term (if (consp width)
+                         (list 'ag 'index x)
+                       x))
+         (bvecp-concl (if (consp width)
+                          (list 'bv-arrp x (car (last width)))
+                        (list 'bvecp x width)))
+         (concl (list 'and
+                      (list 'integerp typed-term)
+                      (list '<= 0 typed-term))))
+    (list* 'defthm thm-name
+           (if hyp
+               (list 'implies hyp bvecp-concl)
+             bvecp-concl)
+           :rule-classes
+           (list
+            :rewrite
+            (list :forward-chaining :trigger-terms (list x))
+            (list :type-prescription
+                  :corollary
+                  (if hyp
+                      (list 'implies hyp concl)
+                    concl)
+                  :typed-term typed-term
+                  ;; hints for the corollary 
+                  :hints
+                  (if (consp width)
+                      '(("Goal"
+                         :in-theory
+                         '(implies bvecp
+                                   bv-arrp-implies-nonnegative-integerp)))
+                    '(("Goal"
+                       :in-theory
+                       '(implies bvecp))))))
+           (if hints (list :hints hints) nil))))
+
+(defun sub1-induction (n)
+      (if (zp n)
+          n
+        (sub1-induction (1- n))))
+
+; These will be the functions to disable in acl2 proofs about signal bodies.
+; We use this in the compiler.
+;BOZO This doesn't include cons, which can now appear in signals defs.  I think that's okay, right?  think
+;about this and remove the BOZO
+(defconst *rtl-operators-after-macro-expansion*
+  '(log= log<> 
+    log< log<= log> log>= 
+    comp2< comp2<= comp2> comp2>=
+    land lior lxor lnot
+    logand1 logior1 logxor1
+    shft
+    cat mulcat
+    bits bitn setbits setbitn 
+    ag as
+    * + ; from macroexpansion of mod* or mod+
+    ;mod- ;now a macro!
+    floor rem decode encode
+    ;; bind ; handled specially in fixup-term
+    ;; if1 ;  a macro, so we don't disable it
+    ;; quote, n!, arr0 ; handled specially in fixup-term
+    natp1 ; doesn't matter, only occurs in for-loop defuns (must be enabled in those proofs anyway)
+    mk-bvarr mk-bvec
+    ))
+
+; Macro fast-and puts conjunctions in a tree form, which can avoid stack
+; overflows by ACL2's translate functions.
+
+(defun split-list (lst lo hi)
+  (cond ((endp lst) 
+         (mv lo hi))
+        ((endp (cdr lst)) 
+         (mv (cons (car lst) lo) hi))
+        (t
+         (split-list (cddr lst)
+                     (cons (car lst) lo)
+                     (cons (cadr lst) hi)))))
+
+(defun fast-and-fn (conjuncts)
+  (declare (xargs :mode :program))
+  (cond ((endp conjuncts) ''t)
+        ((endp (cdr conjuncts)) (car conjuncts))
+        (t
+         (mv-let (hi lo)
+             (split-list conjuncts () ())
+           (list 'if
+                 (fast-and-fn hi)
+                 (fast-and-fn lo)
+                 'nil)))))
+
+(defmacro fast-and (&rest conjuncts)
+  (fast-and-fn conjuncts))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/Makefile acl2-6.3/books/rtl/rel9/support/lib2.delta1/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,36 @@
+include ../../../../Makefile-generic
+
+# BOOKS = bits-new-proofs bits-new \
+#         log-new-proofs log-new \
+#         rtl-new-proofs rtl-new \
+#         float-new-proofs float-new \
+#         round-new-proofs round-new \
+# 	add-new-proofs add-new \
+# 	log-support-proofs log-support \
+#         mult-new-proofs mult-new \
+#         reps-new-proofs reps-new \
+#         rtlarr-new  \
+#         bits-proofs bits \
+#         log-proofs log \
+# 	rtl-proofs rtl \
+#         float-proofs float  \
+# 	round-proofs round \
+#         reps-proofs reps \
+# 	add-proofs add \
+# 	mult-proofs mult \
+# 	rtlarr \
+# 	logn-new-proofs logn-new \
+# 	logn-proofs logn \
+# 	bvecp-raw-helpers-proofs  bvecp-raw-helpers \
+# 	simple-loop-helpers-proofs simple-loop-helpers \
+# 	arith \
+# 	bvecp-helpers \
+# 	simplify-model-helpers-new-proofs simplify-model-helpers-new \
+# 	simplify-model-helpers-proofs simplify-model-helpers \
+# 	util \
+# 	log-support-proofs log-support \
+# 	logn2log-proofs logn2log \
+# 	top
+
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/add-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/add-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/add-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/add-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1780 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "round-new")
+
+(local (include-book "../lib2/top"))
+
+
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "bits-new-proofs"))
+
+             (defthm bits_alt-is-bits
+               (equal (bits_alt x i j)
+                      (bits x i j)))
+
+             
+             (defthm bitn_alt-is-bitn
+               (equal (bitn_alt x n)
+                      (bitn x n)))
+
+
+             (defthm binary-cat_alt-is-binary-cat
+               (equal (binary-cat_alt x m y n)
+                      (binary-cat x m y n)))
+
+             ))
+               
+
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(encapsulate () 
+    (local (include-book "../../arithmetic/top"))
+
+(local 
+ (defthm bvecp-fl-1/2
+   (implies (bvecp x (+ 1 n))
+            (BVECP (FL (* 1/2 X)) n))
+   :hints (("Goal" :in-theory (e/d (bvecp
+                                    expt-2-reduce-leading-constant) ())))))
+
+(local 
+ (defthm bvecp-mod-2
+   (implies (integerp x)
+            (BVECP (MOD X 2) 1))
+   :hints (("Goal" :in-theory (e/d (bvecp) ())))))
+
+
+
+(local 
+ (defthm land-logand
+   (implies (and (bvecp x n)
+                 (bvecp y n)
+                 (natp n))
+            (equal (land x y n)
+                   (logand x y)))
+   :hints (("Goal" :in-theory (e/d (binary-land)
+                                   ())
+            :induct (binary-land x y n))
+           ("Subgoal *1/4" :use ((:instance logand-def
+                                            (i x)
+                                            (j y)))))))
+
+
+
+(local 
+ (defthm lxor-logxor
+   (implies (and (bvecp x n)
+                 (bvecp y n)
+                 (natp n))
+            (equal (lxor x y n)
+                   (logxor x y)))
+   :hints (("Goal" :in-theory (e/d (binary-lxor)
+                                   ())
+            :induct (binary-lxor x y n))
+           ("Subgoal *1/4" :use ((:instance logxor-def
+                                            (i x)
+                                            (j y)))))))
+(local 
+ (defthm logior-1-x
+   (implies (bvecp x 1)
+            (equal (logior 1 x) 1))
+   :hints (("Goal" :in-theory (e/d (bvecp) ())
+            :cases ((equal x 0))))))
+
+
+(local 
+ (defthm lior-logior
+   (implies (and (bvecp x n)
+                 (bvecp y n)
+                 (natp n))
+            (equal (lior x y n)
+                   (logior x y)))
+   :hints (("Goal" :in-theory (e/d (binary-lior)
+                                   ())
+            :induct (binary-lior x y n))
+           ("Subgoal *1/4" :use ((:instance logior-def
+                                            (i x)
+                                            (j y)))))))
+
+(defthm half-adder_alt
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat_alt (logand u v) 1 (logxor u v) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance half-adder)))))
+
+(local 
+ (defthm bvecp-1-plus
+   (implies (natp x)
+            (bvecp x (+ 1 (expo x))))
+   :hints (("Goal" :in-theory (e/d (bvecp) ())))))
+
+
+(local 
+ (defthm bvecp-max-1
+   (implies (and (natp x)
+                 (integerp m))
+            (bvecp x (max (+ 1 (expo x)) m)))
+   :hints (("Goal" :use ((:instance bvecp-monotone
+                                    (x x)
+                                    (m m)
+                                    (n (+ 1 (expo x)))))))))
+
+
+
+(local 
+ (defthm bvecp-max-2
+   (implies (and (natp x)
+                 (integerp m))
+            (bvecp x (max m (+ 1 (expo x)))))
+   :hints (("Goal" :use ((:instance bvecp-monotone
+                                    (x x)
+                                    (m m)
+                                    (n (+ 1 (expo x)))))))))
+
+
+
+(defthm add-2_alt
+    (implies (and (natp x) (natp y))
+	     (equal (+ x y)
+		    (+ (logxor x y)
+		       (* 2 (logand x y)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d () (max))
+           :use ((:instance add-2
+                            (n (max (+ 1 (expo x))
+                                    (+ 1 (expo y)))))))))
+
+(defthm full-adder_alt
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat_alt (logior (logand u v) (logior (logand u w) (logand v w))) 1 
+                       (logxor u (logxor v w)) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance full-adder)))))
+
+
+(local 
+ (defthm bvecp-max-backchain-1
+   (implies (and (natp x)
+                 (integerp m)
+                 (integerp n)
+                 (bvecp x n))
+            (bvecp x (MAX n m)))
+   :hints (("Goal" :use ((:instance bvecp-monotone
+                                    (x x)
+                                    (m m)
+                                    (n n)))))))
+
+
+
+(local 
+ (defthm bvecp-max-backchain-2
+   (implies (and (natp x)
+                 (integerp m)
+                 (integerp n)
+                 (bvecp x m))
+            (bvecp x (MAX n m)))
+   :hints (("Goal" :use ((:instance bvecp-monotone
+                                    (x x)
+                                    (m n)
+                                    (n m)))))))
+
+
+
+(defthm add-3_alt
+    (implies (and (natp x)
+		  (natp y)
+		  (natp z))
+	     (= (+ x y z)
+		(+ (logxor x (logxor y z))
+		   (* 2 (logior (logand x y)
+				(logior (logand x z)
+					(logand y z)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d () (max))
+           :use ((:instance add-3 
+                            (n (max (+ 1 (expo x))
+                                    (max (+ 1 (expo y))
+                                         (+ 1 (expo z))))))))))
+
+)
+
+(defun rc-carry_alt (x y k)
+  (if (zp k)
+      0
+    (logior (logand (bitn_alt x (1- k)) (bitn_alt y (1- k)))
+	    (logior (logand (bitn_alt x (1- k)) (rc-carry_alt x y (1- k)))
+		    (logand (bitn_alt y (1- k)) (rc-carry_alt x y (1- k)))))))
+
+
+
+(local (include-book "../../arithmetic/top"))
+
+(local 
+ (defthm logand-1-x-g
+   (implies (integerp x)
+            (equal (LOGAND 1 x)
+                   (bitn x 0)))
+   :hints (("Goal" :in-theory (e/d (logand bitn mod 
+                                           evenp
+                                           bits-mod)
+                                   (bits-n-n-rewrite))))))
+
+
+
+
+(local 
+ (encapsulate ()
+              (local (include-book "../support/logior"))
+              (defthm logior-1-x
+                (implies (bvecp x 1)
+                         (equal (logior 1 x) 1)))))
+ 
+(local 
+ (defthm rc-carry_alt-is-rc-carry
+   (equal (rc-carry_alt x y k)
+          (rc-carry x y k))
+   :hints (("Goal" :induct (rc-carry_alt x y k))
+           ("Subgoal *1/2" :use ((:instance bitn-0-1
+                                            (x x)
+                                            (n (+ -1 k)))
+                                 (:instance bitn-0-1
+                                            (x y)
+                                            (n (+ -1 k))))))))
+
+(defun rc-sum_alt (x y k)
+  (if (zp k)
+      0
+    (cat_alt (logxor (bitn_alt x (1- k))
+                     (logxor (bitn_alt y (1- k)) (rc-carry_alt x y (1- k))))
+	 1
+	 (rc-sum_alt x y (1- k))
+	 (1- k))))
+
+
+
+
+(local 
+ (defthm logxor-1-x-g
+   (implies (bvecp x 1)
+            (equal (LOGXOR 1 x)
+                   (lnot x 1)))
+   :hints (("Goal" :in-theory (enable bvecp)
+            :cases ((equal x 0))))))
+
+(local 
+ (defthm lxor-1
+   (implies (case-split (bvecp y 1))
+            (equal (lxor 1 y 1)
+                   (lnot y 1)))
+   :hints (("Goal" :in-theory (enable bvecp)
+            :cases ((equal x 0))))))
+
+
+
+(local 
+ (defthm lxor-0-g
+   (implies (case-split (bvecp y 1))
+            (equal (lxor 0 y 1)
+                   y))
+   :hints (("Goal" :in-theory (enable bvecp)
+            :cases ((equal x 0))))))
+
+(local 
+ (defthm bvecp-1-rc-carry
+   (bvecp (rc-carry x y k) 1)))
+
+(local 
+ (defthm rc-sum_alt-is-rc-sum
+   (equal (rc-sum_alt x y k)
+          (rc-sum x y k))
+   :hints (("Goal" :induct (rc-sum_alt x y k))
+           ("Subgoal *1/2" :use ((:instance bitn-0-1
+                                            (x x)
+                                            (n (+ -1 k)))
+                                 (:instance bitn-0-1
+                                            (x y)
+                                            (n (+ -1 k))))))))
+                                 
+
+(defthm ripple-carry_alt
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits_alt x (1- n) 0) (bits_alt y (1- n) 0))
+                  (cat_alt (rc-carry_alt x y n) 1 (rc-sum_alt x y n) n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance ripple-carry)))))
+
+
+(defun gen_alt (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn_alt x i) (bitn_alt y i))
+	  (bitn_alt x i)
+	(gen_alt x y (1- i) j))
+    0))
+
+
+(local 
+ (defthm gen_alt-is-gen
+   (equal (gen_alt x y i j)
+          (gen x y i j))))
+
+
+
+
+(defun prop_alt (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn_alt x i) (bitn_alt y i))
+	  0
+	(prop_alt x y (1- i) j))
+    1))
+
+
+(local 
+ (defthm prop_alt-is-prop
+   (equal (prop_alt x y i j)
+          (prop x y i j))))
+
+
+
+(defthm bvecp-1-gen_alt
+  (bvecp (gen_alt x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen_alt x y i j)))))
+
+(defthm bvecp-1-prop_alt
+  (bvecp (prop_alt x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop_alt x y i j)))))
+
+(defthmd gen_alt-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen_alt x y i j)
+                  (if (>= (+ (bits_alt x i j) (bits_alt y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance gen-val)))))
+
+(defthmd gen_alt-val-cor1
+  (implies (natp j)
+           (equal (gen_alt x y i j)
+                  (bitn_alt (+ (bits_alt x i j) (bits_alt y i j))
+			(1+ (- i j)))))
+  :hints (("Goal" :use ((:instance gen-val-cor1)))))
+
+(defthmd gen_alt-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits_alt x i 0) (bits_alt y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen_alt x y i 0))
+		     (bits_alt (+ x y) i 0))))
+  :hints (("Goal" :use ((:instance gen-val-cor2)))))
+
+
+(local 
+ (defthm lior-bitn-is
+   (equal (lior (bitn x i) 
+                (bitn y i) 
+                1)
+          (logior (bitn x i)
+                  (bitn y i)))
+   :hints (("Goal" :use ((:instance bitn-0-1
+                                    (x x)
+                                    (n i))
+                         (:instance bitn-0-1
+                                    (x y)
+                                    (n i)))))))
+                         
+                  
+;;                                       (LIOR (BITN X I) (BITN Y I) 1)))
+
+
+
+(defthm gen_alt-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn_alt (+ (bits_alt x i j) (bits_alt y i j)) (- i j)) 0))
+           (equal (gen_alt x y i j)
+                  (logior (bitn_alt x i) (bitn_alt y i))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance gen-special-case)))))
+
+
+
+
+
+(defthmd prop_alt-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop_alt x y i j)
+                  (if (= (+ (bits_alt x i j) (bits_alt y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance prop-val)))))
+
+
+(local 
+ (defthm bvecp-fl-1/2
+   (implies (bvecp x (+ 1 n))
+            (BVECP (FL (* 1/2 X)) n))
+   :hints (("Goal" :in-theory (e/d (bvecp
+                                    expt-2-reduce-leading-constant) ())))))
+
+(local 
+ (defthm bvecp-mod-2
+   (implies (integerp x)
+            (BVECP (MOD X 2) 1))
+   :hints (("Goal" :in-theory (e/d (bvecp) ())))))
+
+(local 
+ (defthm lxor-bits-are-g
+   (implies (and (bvecp x n)
+                 (bvecp y n)
+                 (natp n))
+            (equal (lxor x y n)
+                   (logxor x y)))
+   :hints (("Goal" :in-theory (e/d (binary-lxor)
+                                   ())
+            :induct (binary-lxor x y n))
+           ("Subgoal *1/4" :use ((:instance logxor-def
+                                            (i x)
+                                            (j y)))))))
+
+
+
+(defthmd prop_alt-as-logxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop_alt x y i j)
+                  (if (equal (logxor (bits_alt x i j) (bits_alt y i j))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance prop-as-lxor)))))
+
+
+(defthm gen_alt-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (gen_alt x y i j)
+		    (logior (gen_alt x y i (1+ k))
+			    (logand (prop_alt x y i (1+ k))
+				    (gen_alt x y k j)))))
+    :rule-classes ()
+    :hints (("Goal" :use ((:instance gen-extend)))))
+
+
+(defthm gen_alt-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen_alt x y i j)
+                  (bitn_alt (+ (bits_alt x i (1+ k))
+                           (bits_alt y i (1+ k))
+                           (gen_alt x y k j))
+                        (- i k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance gen-extend-cor)))))
+
+(defthm prop_alt-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (prop_alt x y i j)
+		    (logand (prop_alt x y i (1+ k))
+			    (prop_alt x y k j))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance prop-extend)))))
+
+(defthm bits_alt-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits_alt (+ x y) i j)
+                  (bits_alt (+ (bits_alt x i j)
+                           (bits_alt y i j)
+                           (gen_alt x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-sum)))))
+
+(defthmd bits_alt-sum-swallow
+  (implies (and (equal (bitn_alt x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits_alt (+ x y) i j)
+                  (bits_alt x i j)))
+  :hints (("Goal" :use ((:instance bits-sum-swallow)))))
+
+(defthmd bits_alt-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen_alt x y i j) 0)
+                (= (gen_alt x y (1- j) 0) 0))
+           (equal (bits_alt (+ x y) i j)
+                  (+ (bits_alt x i j) (bits_alt y i j))))
+  :hints (("Goal" :use ((:instance bits-sum-cor)))))
+
+(defthm bits_alt-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits_alt (+ x y z) i j)
+                  (bits_alt (+ (bits_alt x i j)
+                           (bits_alt y i j)
+                           (bits_alt z i j)
+                           (gen_alt x y (1- j) 0)
+                           (gen_alt (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-sum-3)))))
+
+
+
+
+(local 
+ (defthm lior-logior
+   (implies (and (bvecp x n)
+                 (bvecp y n)
+                 (natp n))
+            (equal (lior x y n)
+                   (logior x y)))
+   :hints (("Goal" :in-theory (e/d (binary-lior)
+                                   ())
+            :induct (binary-lior x y n))
+           ("Subgoal *1/4" :use ((:instance logior-def
+                                            (i x)
+                                            (j y)))))))
+
+
+
+(defthm bits_alt-sum-plus-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits_alt (+ 1 x y) i j)
+		    (bits_alt (+ (bits_alt x i j)
+			     (bits_alt y i j)
+			     (logior (prop_alt x y (1- j) 0) 
+				     (gen_alt x y (1- j) 0) ))
+			  (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-sum-plus-1)))))
+
+
+
+(local 
+ (defthm land-logand
+   (implies (and (bvecp x n)
+                 (bvecp y n)
+                 (natp n))
+            (equal (land x y n)
+                   (logand x y)))
+   :hints (("Goal" :in-theory (e/d (binary-land)
+                                   ())
+            :induct (binary-land x y n))
+           ("Subgoal *1/4" :use ((:instance logand-def
+                                            (i x)
+                                            (j y)))))))
+
+
+
+(defthmd logand-gen_alt-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand (bits_alt x i j) (bits_alt y i j)) 0))
+           (equal (gen_alt x y i j) 0))
+  :hints (("Goal" :use ((:instance land-gen-0)))))
+
+(defthm logand-gen_alt-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand x y) 0))
+           (equal (bits_alt (+ x y) i j)
+                  (+ (bits_alt x i j) (bits_alt y i j))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logand-gen_alt-0)
+                        (:instance logand-gen_alt-0
+                                   (i (+ -1 j))
+                                   (j 0))
+                        (:instance bits_alt-sum-cor)
+                        (:instance bits_alt-logand)
+                        (:instance bits_alt-logand
+                                   (i (+ -1 j))
+                                   (j 0))))))
+
+
+
+;; (local (include-book "../../arithmetic/top"))
+
+;; (local 
+;;  (defthmd bitn-mod-2
+;;    (implies (integerp x)
+;;             (equal (bitn (mod x 2) 0)
+;;                    (mod x 2)))
+;;    :hints (("Goal" :in-theory (e/d (bitn bits-mod)
+;;                                    (bits-n-n-rewrite))))))
+
+(local 
+ (defthm bits-land-specific
+   (implies (and (natp n)
+                 (> n 0))
+            (equal (LAND (BITS X (+ -1 N) 0)
+                         (BITS Y (+ -1 N) 0)
+                         N)
+                   (land x y n)))
+   :hints (("Goal" :cases ((equal (bits (land x y n) (+ -1 n) 0)
+                                  (land x y n))))
+           ("Subgoal 2" :cases ((bvecp (land x y n) n))
+            :in-theory (e/d () (bits-land))))))
+            
+
+
+
+(local 
+ (defthmd land-logand-g
+   (implies (and (natp n)
+                 (> n 0)
+                 (natp x)
+                 (natp y))
+            (equal (land x y n)
+                   (logand (bits x (+ -1 n) 0)
+                           (bits y (+ -1 n) 0))))
+   :hints (("Goal" :use ((:instance land-logand
+                                    (x (bits x (+ -1 n) 0))
+                                    (y (bits y (+ -1 n) 0))
+                                    (n n)))
+            :in-theory (e/d (bits-land-specific)
+                            (land-logand))))))
+                                   
+
+
+
+(defthmd gen_alt-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (logand z y) 0)
+		(= (gen_alt x y k 0) 1))
+	   (equal (gen_alt (+ x y) z k 0) 0))
+  :hints (("Goal" :use ((:instance gen-plus)
+                        (:instance land-logand-g
+                                   (x z)
+                                   (y y)
+                                   (n (+ 1 k)))
+                        (:instance bits_alt-logand
+                                   (x z)
+                                   (y y)
+                                   (i k)
+                                   (j 0))))))
+                                   
+           
+
+(defthmd gen_alt-extend-3
+    (implies (and (natp i)
+		  (natp j)
+		  (> i j)
+		  (natp x)
+		  (natp y)
+		  (bvecp z (1+ j))
+		  (= (logand y z) 0))		  
+	     (equal (gen_alt (+ x y) z i 0)
+		    (logand (prop_alt x y i (1+ j))
+			    (gen_alt (+ x y) z j 0))))
+    :hints (("Goal" :use ((:instance gen-extend-3)
+                          (:instance land-logand-g
+                                     (x z)
+                                     (y y)
+                                     (n (+ 1 j)))
+                        (:instance bits_alt-logand
+                                   (x z)
+                                   (y y)
+                                   (i j)
+                                   (j 0))))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop_alt (a b d k)
+  (let ((c (- (bitn_alt a (1- k)) (bitn_alt b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop_alt a b c (1- k))
+	    (if (= d (- c))
+		(lop_alt a b (- c) (1- k))
+	      k)))
+      0)))
+
+(local 
+ (defthm lop_alt-is-lop
+   (equal (lop_alt a b d k)
+          (lop a b d k))
+   :hints (("Goal" :in-theory (e/d (lop_alt lop) ())))))
+
+
+
+(defthm lop_alt-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop_alt a b 0 n) (expo (- a b)))
+               (= (lop_alt a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop-bnds)))))
+
+
+
+;;;
+
+
+;; (defthm olop-thm-1
+;;     (implies (and (integerp a)
+;; 		  (> a 0)
+;; 		  (integerp b)
+;; 		  (> b 0)
+;; 		  (= e (expo a))
+;; 		  (< (expo b) e)
+;; 		  (= lambda
+;; 		     (logior (* 2 (mod a (expt 2 e)))
+;; 			     (lnot (* 2 b) (1+ e)))))
+;; 	     (or (= (expo (- a b)) (expo lambda))
+;; 		 (= (expo (- a b)) (1- (expo lambda)))))
+;;   :rule-classes ()
+;;   :hints (("Goal" :in-theory (disable logior lop)
+;; 		  :use (lop2-27
+;; 			(:instance expo-upper-bound (x b))
+;; 			(:instance expo-monotone (x 1) (y a))
+;; 			(:instance expt-weak-monotone (n (1+ (expo b))) (m e))
+;; 			(:instance expo-upper-bound (x a))
+;; 			(:instance lop-bnds (n (1+ e)))))))
+;;
+
+
+;; (local 
+;;  (defthm lior-logior
+;;    (implies (and (bvecp x n)
+;;                  (bvecp y n)
+;;                  (natp n))
+;;             (equal (lior x y n)
+;;                    (logior x y)))
+;;    :hints (("Goal" :in-theory (e/d (binary-lior)
+;;                                    ())
+;;             :induct (binary-lior x y n))
+;;            ("Subgoal *1/4" :use ((:instance logior-def
+;;                                             (i x)
+;;                                             (j y)))))))
+
+(local 
+ (defthm bvecp-2-muliply
+   (implies (integerp a)
+            (bvecp (* 2 (mod a (expt 2 e))) (+ 1 e)))
+   :hints (("Goal" :in-theory (e/d (bvecp
+                                    expt-2-reduce-leading-constant
+                                    ) ())))))
+
+
+
+(local 
+ (defund bvequal (v1 v2 n)
+  (equal (sumbits v1 n)
+         (sumbits v2 n))))
+
+
+(local
+ (defthm bvequal-then-equal
+  (implies (and (bvequal x y n)
+                (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal x y))
+  :hints (("Goal" :use ((:instance sumbits-thm
+                                   (x x))
+                        (:instance sumbits-thm
+                                   (x y)))
+           :in-theory (enable bvequal)))
+  :rule-classes nil))
+
+(local 
+ (encapsulate () 
+              (local (include-book "log-new"))
+              
+              
+              (defthmd bitn-lognot-g
+                (implies (and (integerp x)
+                              (integerp n)
+                              (>= n 0))
+                         (not (equal (bitn (lognot x) n)
+                                     (bitn x n))))
+                :hints (("Goal" :cases ((equal n 0)))
+                        ("Subgoal 2" :use ((:instance bitn_alt-lognot)))
+                        ("Subgoal 1" :in-theory (e/d (lognot bitn-def mod)
+                                                     ()))))
+              ))
+
+
+
+
+(local 
+ (defthmd bitn-lnot-lognot-bvequal-lemma
+   (implies (and (integerp x)
+                 (natp n)
+                 (> n 0)
+                 (natp n)
+                 (natp i)
+                 (<= i (+ -1 n)))
+            (equal (bitn (lnot x n) i)
+                   (bitn (bits (lognot x) (+ -1 n) 0) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-lnot) ())
+            :use ((:instance bitn-lognot-g
+                             (n i))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n i)))))))
+
+
+(local 
+ (defthm lnot-lognot-bvequal
+   (implies (and (integerp x)
+                 (natp n)
+                 (> n 0)
+                 (natp n)
+                 (natp i)
+                 (<= i n))
+            (bvequal (lnot x n)
+                     (bits (lognot x) (+ -1 n) 0)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal bitn-lnot-lognot-bvequal-lemma) (bitn-bits))))))
+
+
+
+(local 
+ (defthm lnot-lognot
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x))
+           (equal (lnot x n)
+                  (bits (lognot x) (+ -1 n) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (lnot x n))
+                                   (y (bits (lognot x) (+ -1 n) 0))
+                                   (n n)))
+           :in-theory (e/d (lnot-lognot-bvequal) ())))))
+
+
+
+(defthm lop_alt-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (bits_alt (lognot (* 2 b)) e 0))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop-thm-1)))))
+                        
+
+;;;
+;;;
+;;; We need set of theorem about how lxor is equal logxor
+;;;
+;;;                                  land is logand 
+;;; 
+;;
+
+(defun lamt_alt (a b e)
+  (logxor a (bits_alt (lognot b) e 0)))
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "log-new-proofs"))
+              
+              (defthmd bitn_alt-logxor
+                (implies (and (case-split (integerp x))
+                              (case-split (integerp y))
+                              (case-split (integerp n)))
+                         (equal (bitn_alt (logxor x y) n)
+                                (logxor (bitn_alt x n) (bitn_alt y n)))))
+              ))
+
+
+
+
+
+
+(local 
+ (defthmd bitn-lxor-logxor-bvequal-lemma
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i (+ -1 n)))
+            (equal (bitn (lxor x y n) i)
+                   (bitn (bits (logxor x y) (+ -1 n)  0) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-lxor) ())
+            :use ((:instance bitn_alt-logxor
+                             (n i))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n i))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n i)))))))
+
+
+
+
+(local 
+ (defthmd lxor-logxor-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i n))
+            (bvequal (lxor x y n) 
+                     (bits (logxor x y) (+ -1 n)  0)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal bitn-lxor-logxor-bvequal-lemma)
+                                   ())))))
+
+(local 
+(defthm lxor-logxor
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x)
+                (integerp y))
+           (equal (lxor x y n)
+                  (bits (logxor x y) (+ -1 n) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (lxor x y n))
+                                   (y (bits (logxor x y) (+ -1 n) 0))
+                                   (n n)))
+           :in-theory (e/d (lxor-logxor-bvequal) ())))))
+
+
+
+(local 
+ (defthm lamt_alt-is-lamt
+   (implies (and (natp e)
+                 (integerp a)
+                 (integerp b))
+            (equal (bits (lamt_alt a b e) e 0)
+                   (lamt a b e)))
+   :hints (("Goal" :in-theory (e/d (lxor-logxor
+                                    lnot-lognot)
+                                   ())
+            :use ((:instance bits_alt-logxor
+                             (x a)
+                             (y (bits (lognot b) e 0))
+                             (i e)
+                             (j 0)))))))
+           
+
+
+
+
+(local 
+ (defthm lamt_alt-is-lamt-g
+   (implies (and (natp e)
+                 (natp i)
+                 (<= i e)
+                 (integerp a)
+                 (integerp b))
+            (equal (bits (lamt_alt a b e) e i)
+                   (bits (lamt a b e) e i)))
+   :hints (("Goal" :in-theory (e/d (lxor-logxor
+                                    lnot-lognot)
+                                   ())
+            :use ((:instance bits_alt-logxor
+                             (x a)
+                             (y (bits (lognot b) e 0))
+                             (i e)
+                             (j i)))))))
+           
+
+
+(defun lamg_alt (a b e)
+  (logand a (bits_alt (lognot b) e 0)))
+
+
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "log-new-proofs"))
+              
+              (defthmd bitn_alt-logand
+                (implies (and (integerp x)
+                              (integerp y)
+                              (integerp n))
+                         (equal (bitn_alt (logand x y) n)
+                                (logand (bitn_alt x n) (bitn_alt y n)))))
+              ))
+
+
+
+(local 
+ (defthmd bitn-land-logand-bvequal-lemma
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i (+ -1 n)))
+            (equal (bitn (land x y n) i)
+                   (bitn (bits (logand x y) (+ -1 n)  0) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-land) ())
+            :use ((:instance bitn_alt-logand
+                             (n i))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n i))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n i)))))))
+
+
+
+
+(local 
+ (defthmd land-logand-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i n))
+            (bvequal (land x y n) 
+                     (bits (logand x y) (+ -1 n)  0)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal bitn-land-logand-bvequal-lemma)
+                                   ())))))
+
+
+(local 
+ (defthmd land-logand-g2
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x)
+                (integerp y))
+            (equal (land x y n)
+                  (bits (logand x y) (+ -1 n) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (land x y n))
+                                   (y (bits (logand x y) (+ -1 n) 0))
+                                   (n n)))
+           :in-theory (e/d (land-logand-bvequal) ())))))
+
+
+
+;; (defthm logand-bvecp-g
+;;   (implies (and (natp n)
+;;                 (bvecp x n)
+;;                 (integerp y))
+;;            (bvecp (logand x y) n))
+;;   :hints (("Goal" :use ((:instance logand-bnd))
+;;            :in-theory (e/d (bvecp) ()))))
+
+;; (i-am-here) ;; Mon Feb 16 14:49:46 2009
+
+(local 
+ (defthm lamg_alt-is-lamg
+   (implies (and (natp e)
+                 (integerp a)
+                 (integerp b))
+            (equal (lamg_alt a b e)
+                   (lamg a b e)))
+   :hints (("Goal" :in-theory (e/d (land-logand
+                                    land-logand-g2
+                                    lnot-lognot)
+                                   ())
+            :use ((:instance bits_alt-logand
+                             (x a)
+                             (y (bits (lognot b) e 0))
+                             (i e)
+                             (j 0)))
+            :cases ((bvecp (logand a (bits (lognot b) e 0)) (+ 1 e))))
+           ("Subgoal 2" :use ((:instance logand-bvecp-g
+                                         (x (bits (lognot b) e 0))
+                                         (y a)
+                                         (n (+ 1 e))))
+            :in-theory (e/d (logand-bvecp-g) ())))))
+                                         
+
+
+
+(defun lamz_alt (a b e)
+  (bits_alt (lognot (logior a (bits_alt (lognot b) e 0))) e 0))
+
+
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "log-new-proofs"))
+              
+              (defthmd bitn_alt-logior
+                (implies (and (integerp x)
+                              (integerp y)
+                              (integerp n))
+                         (equal (bitn_alt (logior x y) n)
+                                (logior (bitn_alt x n) (bitn_alt y n)))))
+              ))
+
+
+
+(local 
+ (defthmd bitn-lior-logior-bvequal-lemma
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i (+ -1 n)))
+            (equal (bitn (lior x y n) i)
+                   (bitn (bits (logior x y) (+ -1 n)  0) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-lior) ())
+            :use ((:instance bitn_alt-logior
+                             (n i))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n i))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n i)))))))
+
+
+
+
+
+(local 
+ (defthmd lior-logior-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i n))
+            (bvequal (lior x y n) 
+                     (bits (logior x y) (+ -1 n)  0)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal bitn-lior-logior-bvequal-lemma)
+                                   ())))))
+
+
+
+
+(local 
+ (defthmd lior-logior-g
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x)
+                 (integerp y))
+            (equal (lior x y n)
+                   (bits (logior x y) (+ -1 n) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (lior x y n))
+                                   (y (bits (logior x y) (+ -1 n) 0))
+                                   (n n)))
+           :in-theory (e/d (lior-logior-bvequal) ())))))
+
+
+(local 
+ (defthmd bits-lognot-is-specific
+   (implies (and (integerp x)
+                 (natp e))
+            (equal  (bits (lognot (bits x e 0)) e 0)
+                    (bits (lognot x) e 0)))
+   :hints (("Goal" :in-theory (e/d (lognot bits-mod mod) ())))))
+          
+
+
+(local 
+ (defthm lamz_alt-is-lamz
+   (implies (and (natp e)
+                 (integerp a)
+                 (integerp b))
+            (equal (lamz_alt a b e)
+                   (lamz a b e)))
+   :hints (("Goal" :in-theory (e/d (lnot-lognot lior-logior-g
+                                                bits-lognot-is-specific
+                                                ) ())))))
+
+
+
+(defun lam1_alt (a b e)
+  (logand (bits_alt (lamt_alt a b e) e 2) 
+	  (logand (bits_alt (lamg_alt a b e) (1- e) 1)
+		  (bits_alt (lognot (lamz_alt a b e)) (- e 2) 0))))
+
+(local 
+ (defthm lam1_alt-is-lam1
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e))
+            (equal (lam1_alt a b e)
+                   (lam1 a b e)))
+   :hints (("Goal" :in-theory (e/d (land-logand-g2
+                                    bits-lognot-is-specific
+                                    lnot-lognot)
+                                   (lamg_alt
+                                    lamz_alt
+                                    lamt_alt
+                                    lamt
+                                    lamg
+                                    lamz))
+            :cases ((<= 2 e))))))
+
+                                    
+
+(defun lam2_alt (a b e)
+  (logand (bits_alt (lognot (lamt_alt a b e)) e 2)
+	  (logand (bits_alt (lamz_alt a b e) (1- e) 1)
+		  (bits_alt (lognot (lamz_alt a b e)) (- e 2) 0))))
+
+
+
+(local 
+ (defthmd bits-bits-specific
+   (implies (and (natp e)
+                 (natp i)
+                 (> i 0)
+                 (<= i e))
+            (equal (bits (lognot x) e i)
+                   (bits (bits (lognot x) e 0) e i)))))
+
+
+(local 
+ (defthmd bits-lognot-is-specific-2
+   (implies (and (integerp x)
+                 (natp e)
+                 (natp i)
+                 (<= i e))
+            (equal  (bits (lognot (bits x e 0)) e  i)
+                    (bits (lognot x) e i)))
+   :hints (("Goal" :in-theory (e/d (bits-bits-specific
+                                    bits-lognot-is-specific)
+                                   (bits-bits))
+            :cases ((equal i 0))))))
+
+
+
+
+;;               (defthmd bitn-lognot-g
+;;                 (implies (and (integerp x)
+;;                               (integerp n)
+;;                               (>= n 0))
+;;                          (not (equal (bitn (lognot x) n)
+;;                                      (bitn x n))))
+;;                 :hints (("Goal" :cases ((equal n 0)))
+;;                         ("Subgoal 2" :use ((:instance bitn_alt-lognot)))
+;;                         ("Subgoal 1" :in-theory (e/d (lognot bitn-def mod)
+;;                                                      ()))))
+
+
+
+(local 
+ (defthm bitn-bits-lognot-bits-lognot-bvequal-lemma
+   (implies (and (integerp x)
+                 (natp e)
+                 (natp i)
+                 (<= i e)
+                 (natp j)
+                 (<= j (+ e (* -1 i))))
+            (equal (bitn (bits (lognot (bits x e 0)) e i) j)
+                   (bitn (bits (lognot (bits x e i))
+                               (+ e (* -1 i))
+                               0)
+                         j)))
+   :hints (("Goal" :in-theory (e/d (bitn-bits) ())
+            :use ((:instance bitn-lognot-g
+                             (x (BITS X E 0))
+                             (n (+ i j)))
+                  (:instance bitn-lognot-g
+                             (x (BITS X E i))
+                             (n j))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n (+ i j))))))))
+                  
+
+
+
+
+
+
+(local 
+ (defthm bits-lognot-bits-lognot-bvequal
+   (implies (and (integerp x)
+                 (natp e)
+                 (natp i)
+                 (<= i e)
+                 (natp j)
+                 (<= j (+ 1  e (* -1 i))))
+            (bvequal (bits (lognot (bits x e 0))
+                           e i)
+                     (bits (lognot (bits x e i))
+                           (+ e (* -1 i))
+                           0)
+                     j))
+   :hints (("Goal" :in-theory (e/d (bvequal
+                                    bitn-bits-lognot-bits-lognot-bvequal-lemma
+                                    ) ())))))
+
+
+
+(local 
+ (defthmd bits-lognot-is-specific-3
+   (implies (and (integerp x)
+                 (natp e)
+                 (natp i)
+                 (<= i e))
+            (equal  (bits (lognot (bits x e 0)) e  i)
+                    (bits (lognot (bits x e i)) (+ e (* -1 i)) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (bits (lognot (bits x e 0)) e  i))
+                                   (y (bits (lognot (bits x e i)) (+ e (* -1 i)) 0))
+                                   (n (+ 1 e (* -1 i)))))
+           :in-theory (e/d (bits-lognot-bits-lognot-bvequal) ())))))
+
+ 
+
+
+
+                                
+
+
+
+
+(local 
+ (defthm lam2_alt-is-lam2
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e))
+            (equal (lam2_alt a b e)
+                   (lam2 a b e)))
+   :hints (("Goal" :in-theory (e/d (land-logand-g2
+                                    bits-lognot-is-specific
+                                    lnot-lognot)
+                                   (lamz_alt
+                                    lamt_alt
+                                    lamt
+                                    lamz
+                                    bits-bits))
+            :cases ((<= 2 e)))
+           ("Subgoal 1" :use ((:instance bits-lognot-is-specific-2
+                                         (i 2)
+                                         (x (LAMT_ALT A B E)))
+                              (:instance bits-lognot-is-specific-3
+                                         (x (lamt a b e))
+                                         (i 2)))))))
+
+
+(defun lam3_alt (a b e)
+  (logand (bits_alt (lamt_alt a b e) e 2) 
+	  (logand (bits_alt (lamz_alt a b e) (1- e) 1)
+		  (bits_alt (lognot (lamg_alt a b e)) (- e 2) 0))))
+
+
+;; (defthm bvecp-lamg
+;;   (implies (and (equal n (+ 1 e))
+;;                 (natp e))
+;;            (bvecp (lamg a b e) n)))
+
+(local 
+ (defthm lam3_alt-is-lam3
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e))
+            (equal (lam3_alt a b e)
+                   (lam3 a b e)))
+   :hints (("Goal" :in-theory (e/d (land-logand-g2
+                                    lnot-lognot)
+                                   (lamz_alt
+                                    lamg_alt
+                                    lamt_alt
+                                    lamt
+                                    lamg
+                                    lamz))
+            :cases ((<= 2 e)))
+           ("Subgoal 1" :use ((:instance bits-lognot-is-specific-2
+                                         (i 0)
+                                         (e (+ -2 e))
+                                         (x (LAMG A B E))))))))
+
+
+
+
+
+(defun lam4_alt (a b e)
+  (logand (bits_alt (lognot (lamt_alt a b e)) e 2)
+	  (logand (bits_alt (lamg_alt a b e) (1- e) 1)
+		  (bits_alt (lognot (lamg_alt a b e)) (- e 2) 0))))
+
+
+
+(local 
+ (defthm lam4_alt-is-lam4
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e))
+            (equal (lam4_alt a b e)
+                   (lam4 a b e)))
+   :hints (("Goal" :in-theory (e/d (land-logand-g2
+                                    lnot-lognot)
+                                   (lamz_alt
+                                    lamg_alt
+                                    lamt_alt
+                                    lamt
+                                    lamg
+                                    lamz))
+            :cases ((<= 2 e)))
+           ("Subgoal 1" :use ((:instance bits-lognot-is-specific-2
+                                         (i 2)
+                                         (x (LAMT_ALT A B E)))
+                              (:instance bits-lognot-is-specific-3
+                                         (x (lamt a b e))
+                                         (i 2))
+                              (:instance bits-lognot-is-specific-2
+                                         (i 0)
+                                         (e (+ -2 e))
+                                         (x (LAMG A B E))))))))
+
+
+
+(defun lam0_alt (a b e)
+  (logior (lam1_alt a b e)
+	  (logior (lam2_alt a b e)
+		  (logior (lam3_alt a b e)
+			  (lam4_alt a b e)))))
+
+           
+;; (defthmd bits_alt-logior
+;;    (implies (and (integerp x)
+;;                  (integerp y)
+;;                  (integerp i)
+;;                  (integerp j))
+;;             (equal (bits_alt (logior x y) i j)
+;;                    (logior (bits_alt x i j) (bits_alt y i j))))
+(local 
+   (DEFTHMD BITS-LOGIOR
+     (IMPLIES (AND (INTEGERP X)
+                   (INTEGERP Y)
+                   (INTEGERP I)
+                   (INTEGERP J))
+              (EQUAL (BITS (LOGIOR X Y) I J)
+                     (LOGIOR (BITS X I J)
+                             (BITS Y I J))))
+     :hints (("Goal" :use ((:instance bits_alt-logior))))))
+
+
+(local 
+ (defthmd lam0_alt-is-lam0-lemma
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e)
+                 (> e 1))
+            (equal (bits (lam0_alt a b e) (+ -2 e) 0)
+                   (lam0 a b e)))
+   :hints (("Goal" :in-theory (e/d (lior-logior-g
+                                    BITS-LOGIOR
+                                    lnot-lognot)
+                                   (lamz_alt
+                                    lamg_alt
+                                    lamt_alt
+                                    lamt
+                                    lamg
+                                    lamz
+                                    lam1_alt
+                                    lam1
+                                    lam2_alt
+                                    lam2
+                                    lam3_alt
+                                    lam3
+                                    lam4_alt
+                                    lam4))))))
+
+
+
+(local 
+ (defthm lam0_alt-is-lam0
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e)
+                 (> e 1))
+            (equal (lam0_alt a b e)
+                   (lam0 a b e)))                   
+   :hints (("Goal" :cases ((bvecp (lam0_alt a b e) (+ -1 e))))
+           ("Subgoal 1" :use ((:instance lam0_alt-is-lam0-lemma))))))
+
+
+
+
+
+(defun lamb_alt (a b e)
+  (+ (* 2 (lam0_alt a b e))
+     (bitn_alt (lognot(lamt_alt a b e)) 0)))
+
+
+
+
+;; (local 
+;;  (defthmd bits-lognot-is-specific-2
+;;    (implies (and (integerp x)
+;;                  (natp e)
+;;                  (natp i)
+;;                  (<= i e))
+;;             (equal  (bits (lognot (bits x e 0)) e  i)
+;;                     (bits (lognot x) e i)))
+;;    :hints (("Goal" :in-theory (e/d (bits-bits-specific
+;;                                     bits-lognot-is-specific)
+;;                                    (bits-bits))
+;;             :cases ((equal i 0))))))
+
+
+
+;; (local 
+;;  (defthm lamt_alt-is-lamt-g
+;;    (implies (and (natp e)
+;;                  (natp i)
+;;                  (<= i e)
+;;                  (integerp a)
+;;                  (integerp b))
+;;             (equal (bits (lamt_alt a b e) e i)
+;;                    (bits (lamt a b e) e i)))
+;;    :hints (("Goal" :in-theory (e/d (lxor-logxor
+;;                                     lnot-lognot)
+;;                                    ())
+;;             :use ((:instance bits_alt-logxor
+;;                              (x a)
+;;                              (y (bits (lognot b) e 0))
+;;                              (i e)
+;;                              (j i)))))))
+           
+
+;; (BITN (LOGNOT (LAMT_ALT A B E)) 0)
+;; (BITN (LOGNOT (BITN (LAMT A B E) 0))
+;;                      0)))
+
+
+(local 
+ (defthm bitn-lamt_alt-is-lamt
+   (implies (and (natp e)
+                 (natp i)
+                 (<= i e)
+                 (integerp a)
+                 (integerp b))
+            (equal (bitn (lamt_alt a b e) i)
+                   (bitn (lamt a b e) i)))
+   :hints (("Goal" :use ((:instance lamt_alt-is-lamt))))))
+                                    
+   
+
+
+
+
+(local 
+ (defthm lamb_alt-is-lamb
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e)
+                 (> e 1))
+            (equal (lamb_alt a b e)
+                   (lamb a b e)))
+   :hints (("Goal" :in-theory (e/d ()
+                                   (lamt_alt
+                                    lam0
+                                    lam0_alt
+                                    lamt
+                                    bitn_alt-lognot))
+            :use ((:instance BITN-LOGNOT-g
+                             (x (lamt_alt a b e))
+                             (n 0))
+                  (:instance bitn-0-1
+                             (x (lamt a b e))
+                             (n 0)))))))
+
+
+
+
+(defthm lop_alt-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb_alt a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb_alt a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb_alt a b e)))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop-thm-2))
+           :in-theory (e/d () 
+                           (lamb_alt
+                            lamb)))))
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1-alt
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits_alt (+ a b 1) k 0) 0)
+		  (equal (bits_alt (lognot (logxor a b)) k 0) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance top-thm-1)
+                        (:instance bits-lognot-is-specific-2
+                                   (i 0)
+                                   (e k)
+                                   (x (BITS (LOGXOR A B) (+ -1 N) 0)))
+                        (:instance bits-lognot-is-specific-2
+                                   (i 0)
+                                   (e k)
+                                   (x (LOGXOR A B)))))))
+                                                      
+
+
+
+;; >  D          (DEFTHM BITS_ALT-LOGXOR
+;;                       (IMPLIES (AND (CASE-SPLIT (INTEGERP X))
+;;                                     (CASE-SPLIT (INTEGERP Y))
+;;                                     (CASE-SPLIT (INTEGERP I))
+;;                                     (CASE-SPLIT (INTEGERP J)))
+;;                                (EQUAL (BITS_ALT (LOGXOR X Y) I J)
+;;                                       (LOGXOR (BITS_ALT X I J)
+;;                                               (BITS_ALT Y I J)))))
+
+(local 
+ (defthm bits-logxor
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp i)
+                 (integerp j))
+            (equal (bits (logxor x y) i j)
+                   (logxor (bits x i j)
+                           (bits y i j))))
+   :hints (("Goal" :use ((:instance bits_alt-logxor))))))
+
+
+(defthm top-thm-2-alt
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits_alt (+ a b c) k 0) 0)
+                  (equal (bits_alt (logxor (logxor a b) 
+                                       (cat_alt (logior a b) n c 1))
+                               k 0) 
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance top-thm-2)
+                        (:instance bitn-0-1
+                                   (x a)
+                                   (n 0))
+                        (:instance bitn-0-1
+                                   (x b)
+                                   (n 0)))
+           :in-theory (e/d (bits-cat
+                            BITS-LOGIOR
+                            bits-logxor
+                            ) ()))))
+
+
+;;;;
+;;;;
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/add-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/add-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/add-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/add-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,532 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "round-new")
+
+(local (include-book "add-new-proofs"))
+
+
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(defthm half-adder_alt
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat_alt (logand u v) 1 (logxor u v) 1)))
+  :rule-classes ())
+
+(defthm add-2_alt
+    (implies (and (natp x) (natp y))
+	     (equal (+ x y)
+		    (+ (logxor x y)
+		       (* 2 (logand x y)))))
+  :rule-classes ())
+
+(defthm full-adder_alt
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat_alt (logior (logand u v) (logior (logand u w) (logand v w))) 1 
+                       (logxor u (logxor v w)) 1)))
+  :rule-classes ())
+
+(defthm add-3_alt
+    (implies (and (natp x)
+		  (natp y)
+		  (natp z))
+	     (= (+ x y z)
+		(+ (logxor x (logxor y z))
+		   (* 2 (logior (logand x y)
+				(logior (logand x z)
+					(logand y z)))))))
+  :rule-classes ())
+
+
+(defun rc-carry_alt (x y k)
+  (if (zp k)
+      0
+    (logior (logand (bitn_alt x (1- k)) (bitn_alt y (1- k)))
+	    (logior (logand (bitn_alt x (1- k)) (rc-carry_alt x y (1- k)))
+		    (logand (bitn_alt y (1- k)) (rc-carry_alt x y (1- k)))))))
+
+
+
+(defun rc-sum_alt (x y k)
+  (if (zp k)
+      0
+    (cat_alt (logxor (bitn_alt x (1- k))
+                     (logxor (bitn_alt y (1- k)) (rc-carry_alt x y (1- k))))
+	 1
+	 (rc-sum_alt x y (1- k))
+	 (1- k))))
+
+
+(defthm ripple-carry_alt
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits_alt x (1- n) 0) (bits_alt y (1- n) 0))
+                  (cat_alt (rc-carry_alt x y n) 1 (rc-sum_alt x y n) n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance ripple-carry)))))
+
+
+(defun gen_alt (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn_alt x i) (bitn_alt y i))
+	  (bitn_alt x i)
+	(gen_alt x y (1- i) j))
+    0))
+
+
+(defun prop_alt (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn_alt x i) (bitn_alt y i))
+	  0
+	(prop_alt x y (1- i) j))
+    1))
+
+
+
+(defthm bvecp-1-gen_alt
+  (bvecp (gen_alt x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen_alt x y i j)))))
+
+(defthm bvecp-1-prop_alt
+  (bvecp (prop_alt x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop_alt x y i j)))))
+
+(defthmd gen_alt-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen_alt x y i j)
+                  (if (>= (+ (bits_alt x i j) (bits_alt y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance gen-val)))))
+
+(defthmd gen_alt-val-cor1
+  (implies (natp j)
+           (equal (gen_alt x y i j)
+                  (bitn_alt (+ (bits_alt x i j) (bits_alt y i j))
+			(1+ (- i j)))))
+  :hints (("Goal" :use ((:instance gen-val-cor1)))))
+
+(defthmd gen_alt-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits_alt x i 0) (bits_alt y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen_alt x y i 0))
+		     (bits_alt (+ x y) i 0))))
+  :hints (("Goal" :use ((:instance gen-val-cor2)))))
+
+
+(defthm gen_alt-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn_alt (+ (bits_alt x i j) (bits_alt y i j)) (- i j)) 0))
+           (equal (gen_alt x y i j)
+                  (logior (bitn_alt x i) (bitn_alt y i))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance gen-special-case)))))
+
+
+
+
+
+(defthmd prop_alt-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop_alt x y i j)
+                  (if (= (+ (bits_alt x i j) (bits_alt y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance prop-val)))))
+
+
+(defthmd prop_alt-as-logxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop_alt x y i j)
+                  (if (equal (logxor (bits_alt x i j) (bits_alt y i j))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance prop-as-lxor)))))
+
+
+(defthm gen_alt-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (gen_alt x y i j)
+		    (logior (gen_alt x y i (1+ k))
+			    (logand (prop_alt x y i (1+ k))
+				    (gen_alt x y k j)))))
+    :rule-classes ()
+    :hints (("Goal" :use ((:instance gen-extend)))))
+
+
+(defthm gen_alt-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen_alt x y i j)
+                  (bitn_alt (+ (bits_alt x i (1+ k))
+                           (bits_alt y i (1+ k))
+                           (gen_alt x y k j))
+                        (- i k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance gen-extend-cor)))))
+
+(defthm prop_alt-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (prop_alt x y i j)
+		    (logand (prop_alt x y i (1+ k))
+			    (prop_alt x y k j))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance prop-extend)))))
+
+(defthm bits_alt-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits_alt (+ x y) i j)
+                  (bits_alt (+ (bits_alt x i j)
+                           (bits_alt y i j)
+                           (gen_alt x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-sum)))))
+
+(defthmd bits_alt-sum-swallow
+  (implies (and (equal (bitn_alt x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits_alt (+ x y) i j)
+                  (bits_alt x i j)))
+  :hints (("Goal" :use ((:instance bits-sum-swallow)))))
+
+(defthmd bits_alt-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen_alt x y i j) 0)
+                (= (gen_alt x y (1- j) 0) 0))
+           (equal (bits_alt (+ x y) i j)
+                  (+ (bits_alt x i j) (bits_alt y i j))))
+  :hints (("Goal" :use ((:instance bits-sum-cor)))))
+
+(defthm bits_alt-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits_alt (+ x y z) i j)
+                  (bits_alt (+ (bits_alt x i j)
+                           (bits_alt y i j)
+                           (bits_alt z i j)
+                           (gen_alt x y (1- j) 0)
+                           (gen_alt (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-sum-3)))))
+
+
+
+(defthm bits_alt-sum-plus-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits_alt (+ 1 x y) i j)
+		    (bits_alt (+ (bits_alt x i j)
+			     (bits_alt y i j)
+			     (logior (prop_alt x y (1- j) 0) 
+				     (gen_alt x y (1- j) 0) ))
+			  (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-sum-plus-1)))))
+
+
+(defthmd logand-gen_alt-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand (bits_alt x i j) (bits_alt y i j)) 0))
+           (equal (gen_alt x y i j) 0))
+  :hints (("Goal" :use ((:instance land-gen-0)))))
+
+(defthm logand-gen_alt-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand x y) 0))
+           (equal (bits_alt (+ x y) i j)
+                  (+ (bits_alt x i j) (bits_alt y i j))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logand-gen_alt-0)
+                        (:instance logand-gen_alt-0
+                                   (i (+ -1 j))
+                                   (j 0))
+                        (:instance bits_alt-sum-cor)
+                        (:instance bits_alt-logand)
+                        (:instance bits_alt-logand
+                                   (i (+ -1 j))
+                                   (j 0))))))
+
+
+
+(defthmd gen_alt-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (logand z y) 0)
+		(= (gen_alt x y k 0) 1))
+	   (equal (gen_alt (+ x y) z k 0) 0))
+  :hints (("Goal" :use ((:instance gen-plus)
+                        (:instance land-logand-g
+                                   (x z)
+                                   (y y)
+                                   (n (+ 1 k)))
+                        (:instance bits_alt-logand
+                                   (x z)
+                                   (y y)
+                                   (i k)
+                                   (j 0))))))
+                                   
+           
+
+(defthmd gen_alt-extend-3
+    (implies (and (natp i)
+		  (natp j)
+		  (> i j)
+		  (natp x)
+		  (natp y)
+		  (bvecp z (1+ j))
+		  (= (logand y z) 0))		  
+	     (equal (gen_alt (+ x y) z i 0)
+		    (logand (prop_alt x y i (1+ j))
+			    (gen_alt (+ x y) z j 0))))
+    :hints (("Goal" :use ((:instance gen-extend-3)
+                          (:instance land-logand-g
+                                     (x z)
+                                     (y y)
+                                     (n (+ 1 j)))
+                        (:instance bits_alt-logand
+                                   (x z)
+                                   (y y)
+                                   (i j)
+                                   (j 0))))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop_alt (a b d k)
+  (let ((c (- (bitn_alt a (1- k)) (bitn_alt b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop_alt a b c (1- k))
+	    (if (= d (- c))
+		(lop_alt a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm lop_alt-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop_alt a b 0 n) (expo (- a b)))
+               (= (lop_alt a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop-bnds)))))
+
+
+
+;;;
+
+(defthm lop_alt-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (bits_alt (lognot (* 2 b)) e 0))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop-thm-1)))))
+                        
+
+
+(defun lamt_alt (a b e)
+  (logxor a (bits_alt (lognot b) e 0)))
+
+
+(defun lamg_alt (a b e)
+  (logand a (bits_alt (lognot b) e 0)))
+
+
+(defun lamz_alt (a b e)
+  (bits_alt (lognot (logior a (bits_alt (lognot b) e 0))) e 0))
+
+
+
+(defun lam1_alt (a b e)
+  (logand (bits_alt (lamt_alt a b e) e 2) 
+	  (logand (bits_alt (lamg_alt a b e) (1- e) 1)
+		  (bits_alt (lognot (lamz_alt a b e)) (- e 2) 0))))
+
+
+(defun lam2_alt (a b e)
+  (logand (bits_alt (lognot (lamt_alt a b e)) e 2)
+	  (logand (bits_alt (lamz_alt a b e) (1- e) 1)
+		  (bits_alt (lognot (lamz_alt a b e)) (- e 2) 0))))
+
+
+(defun lam3_alt (a b e)
+  (logand (bits_alt (lamt_alt a b e) e 2) 
+	  (logand (bits_alt (lamz_alt a b e) (1- e) 1)
+		  (bits_alt (lognot (lamg_alt a b e)) (- e 2) 0))))
+
+
+(defun lam4_alt (a b e)
+  (logand (bits_alt (lognot (lamt_alt a b e)) e 2)
+	  (logand (bits_alt (lamg_alt a b e) (1- e) 1)
+		  (bits_alt (lognot (lamg_alt a b e)) (- e 2) 0))))
+
+
+(defun lam0_alt (a b e)
+  (logior (lam1_alt a b e)
+	  (logior (lam2_alt a b e)
+		  (logior (lam3_alt a b e)
+			  (lam4_alt a b e)))))
+
+           
+
+(defun lamb_alt (a b e)
+  (+ (* 2 (lam0_alt a b e))
+     (bitn_alt (lognot(lamt_alt a b e)) 0)))
+
+
+(defthm lop_alt-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb_alt a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb_alt a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb_alt a b e)))))))
+  :rule-classes ())
+
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1-alt
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits_alt (+ a b 1) k 0) 0)
+		  (equal (bits_alt (lognot (logxor a b)) k 0) 0)))
+  :rule-classes ())
+                                                      
+
+(defthm top-thm-2-alt
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits_alt (+ a b c) k 0) 0)
+                  (equal (bits_alt (logxor (logxor a b) 
+                                       (cat_alt (logior a b) n c 1))
+                               k 0) 
+                         0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/add-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/add-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/add-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/add-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,669 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "round")
+(local (include-book "add-new"))
+
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (logand u v) 1 (logxor u v) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance half-adder_alt)))))
+
+
+
+
+(defthm add-2
+    (implies (and (natp x) (natp y))
+	     (equal (+ x y)
+		    (+ (logxor x y)
+		       (* 2 (logand x y)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance add-2_alt)))))
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (logior (logand u v) (logior (logand u w) (logand v w))) 1 
+                       (logxor u (logxor v w)) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance full-adder_alt)))))
+
+(defthm add-3
+    (implies (and (natp x)
+		  (natp y)
+		  (natp z))
+	     (= (+ x y z)
+		(+ (logxor x (logxor y z))
+		   (* 2 (logior (logand x y)
+				(logior (logand x z)
+					(logand y z)))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance add-3_alt)))))
+
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (logior (logand (bitn x (1- k)) (bitn y (1- k)))
+	    (logior (logand (bitn x (1- k)) (rc-carry x y (1- k)))
+		    (logand (bitn y (1- k)) (rc-carry x y (1- k)))))))
+
+
+
+(local 
+ (defthm rc-carry-is-rc-carry_alt
+   (equal (rc-carry x y k)
+          (rc-carry_alt x y k))
+   :hints (("Goal" :induct (rc-carry x y k)))))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (logxor (bitn x (1- k))
+                     (logxor (bitn y (1- k)) (rc-carry x y (1- k))))
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+
+(local 
+ (defthm rc-sum-is-rc-sum_alt
+   (equal (rc-sum x y k)
+          (rc-sum_alt x y k))
+   :hints (("Goal" :induct (rc-sum x y k)))))
+                                 
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance ripple-carry_alt)))))
+
+
+(defun gen (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+
+(local 
+ (defthm gen-is-gen_alt
+   (equal (gen x y i j)
+          (gen_alt x y i j))))
+
+
+
+
+(defun prop (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+
+(local 
+ (defthm prop-is-prop_alt
+   (equal (prop x y i j)
+          (prop_alt x y i j))))
+
+
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(defthmd gen-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen x y i j)
+                  (if (>= (+ (bits x i j) (bits y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance gen_alt-val)))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j) (bits y i j))
+			(1+ (- i j)))))
+  :hints (("Goal" :use ((:instance gen_alt-val-cor1)))))
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0))))
+  :hints (("Goal" :use ((:instance gen_alt-val-cor2)))))
+
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (logior (bitn x i) (bitn y i))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance gen_alt-special-case)))))
+
+
+
+
+
+(defthmd prop-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop x y i j)
+                  (if (= (+ (bits x i j) (bits y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance prop_alt-val)))))
+
+
+(defthmd prop-as-logxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (logxor (bits x i j) (bits y i j))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0)))
+  :hints (("Goal" :use ((:instance prop_alt-as-logxor)))))
+
+
+(defthm gen-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (gen x y i j)
+		    (logior (gen x y i (1+ k))
+			    (logand (prop x y i (1+ k))
+				    (gen x y k j)))))
+    :rule-classes ()
+    :hints (("Goal" :use ((:instance gen_alt-extend)))))
+
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance gen_alt-extend-cor)))))
+
+(defthm prop-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (prop x y i j)
+		    (logand (prop x y i (1+ k))
+			    (prop x y k j))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance prop_alt-extend)))))
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-sum)))))
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j)))
+  :hints (("Goal" :use ((:instance bits_alt-sum-swallow)))))
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :hints (("Goal" :use ((:instance bits_alt-sum-cor)))))
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-sum-3)))))
+
+
+(defthm bits-sum-plus-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (bits x i j)
+			     (bits y i j)
+			     (logior (prop x y (1- j) 0) 
+				     (gen x y (1- j) 0) ))
+			  (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-sum-plus-1)))))
+
+
+
+(defthmd logand-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand (bits x i j) (bits y i j)) 0))
+           (equal (gen x y i j) 0))
+  :hints (("Goal" :use ((:instance logand-gen_alt-0)))))
+
+(defthm logand-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand x y) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logand-gen_alt-0-cor)))))
+
+
+(defthmd gen-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (logand z y) 0)
+		(= (gen x y k 0) 1))
+	   (equal (gen (+ x y) z k 0) 0))
+  :hints (("Goal" :use ((:instance gen_alt-plus)))))
+                                   
+           
+
+(defthmd gen-extend-3
+    (implies (and (natp i)
+		  (natp j)
+		  (> i j)
+		  (natp x)
+		  (natp y)
+		  (bvecp z (1+ j))
+		  (= (logand y z) 0))		  
+	     (equal (gen (+ x y) z i 0)
+		    (logand (prop x y i (1+ j))
+			    (gen (+ x y) z j 0))))
+    :hints (("Goal" :use ((:instance gen_alt-extend-3)))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(local 
+ (defthm lop-is-lop
+   (equal (lop a b d k)
+          (lop_alt a b d k))
+   :hints (("Goal" :in-theory (e/d (lop lop_alt) ())))))
+
+
+(defthm lop-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop_alt-bnds)))))
+
+
+
+(defthm lop-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (bits (lognot (* 2 b)) e 0))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop_alt-thm-1)))))
+                        
+
+;;;
+;;;
+;;; We need set of theorem about how lxor is equal logxor
+;;;
+;;;                                  land is logand 
+;;; 
+;;
+
+(defun lamt (a b e)
+  (logxor a (bits (lognot b) e 0)))
+
+(local 
+ (defthm lamt-is-lamt_alt
+   (equal (lamt a b e)
+          (lamt_alt a b e))
+   :hints (("Goal" :in-theory (e/d (lamt lamt_alt) ())))))
+
+(defun lamg (a b e)
+  (logand a (bits (lognot b) e 0)))
+
+
+(local 
+ (defthm lamg-is-lamg_alt
+   (equal (lamg a b e)
+          (lamg_alt a b e))
+   :hints (("Goal" :in-theory (e/d (lamg lamg_alt) ())))))
+
+
+(defun lamz (a b e)
+  (bits (lognot (logior a (bits (lognot b) e 0))) e 0))
+
+
+(local 
+ (defthm lamz-is-lamz_alt
+   (implies (and (natp e)
+                 (integerp a)
+                 (integerp b))
+            (equal (lamz a b e)
+                   (lamz_alt a b e)))
+   :hints (("Goal" :in-theory (e/d (lamz lamz_alt) ())))))
+
+
+(defun lam1 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(local 
+ (defthm lam1-is-lam1_alt
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e))
+            (equal (lam1 a b e)
+                   (lam1_alt a b e)))
+   :hints (("Goal" :in-theory (e/d (lam1 lam1_alt) ())))))
+
+                                    
+
+(defun lam2 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+
+
+(local 
+ (defthm lam2-is-lam2_alt
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e))
+            (equal (lam2 a b e)
+                   (lam2_alt a b e)))
+   :hints (("Goal" :in-theory (e/d (lam2 lam2_alt) ())))))
+
+
+(defun lam3 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+
+(local 
+ (defthm lam3-is-lam3_alt
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e))
+            (equal (lam3 a b e)
+                   (lam3_alt a b e)))
+   :hints (("Goal" :in-theory (e/d (lam3 lam3_alt) ())))))
+
+
+
+
+(defun lam4 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+
+
+(local 
+ (defthm lam4-is-lam4_alt
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e))
+            (equal (lam4 a b e)
+                   (lam4_alt a b e)))
+   :hints (("Goal" :in-theory (e/d (lam4 lam4_alt) ())))))
+
+
+(defun lam0 (a b e)
+  (logior (lam1 a b e)
+	  (logior (lam2 a b e)
+		  (logior (lam3 a b e)
+			  (lam4 a b e)))))
+
+
+(local 
+ (defthm lam0-is-lam0_alt
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e)
+                 (> e 1))
+            (equal (lam0 a b e)
+                   (lam0_alt a b e)))                   
+   :hints (("Goal" :in-theory (e/d (lam0 lam0_alt)
+                                   ())))))
+                                         
+
+
+
+
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (bitn (lognot(lamt a b e)) 0)))
+
+
+
+(local 
+ (defthm lamb-is-lamb
+   (implies (and (integerp a)
+                 (integerp b)
+                 (natp e)
+                 (> e 1))
+            (equal (lamb a b e)
+                   (lamb_alt a b e)))
+   :hints (("Goal" :in-theory (e/d (lamb lamb_alt)
+                                   ())))))
+
+
+
+(defthm lop-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop_alt-thm-2))
+           :in-theory (e/d () 
+                           (lamb
+                            lamb_alt)))))
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lognot (logxor a b)) k 0) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance top-thm-1-alt)))))
+                                                      
+
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (logxor (logxor a b) 
+                                       (cat (logior a b) n c 1))
+                               k 0) 
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance top-thm-2-alt)))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/add.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/add.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/add.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/add.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,444 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "round")
+
+(local (include-book "add-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (logand u v) 1 (logxor u v) 1)))
+  :rule-classes ())
+
+(defthm add-2
+    (implies (and (natp x) (natp y))
+	     (equal (+ x y)
+		    (+ (logxor x y)
+		       (* 2 (logand x y)))))
+  :rule-classes ())
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (logior (logand u v) (logior (logand u w) (logand v w))) 1 
+                       (logxor u (logxor v w)) 1)))
+  :rule-classes ())
+
+(defthm add-3
+    (implies (and (natp x)
+		  (natp y)
+		  (natp z))
+	     (= (+ x y z)
+		(+ (logxor x (logxor y z))
+		   (* 2 (logior (logand x y)
+				(logior (logand x z)
+					(logand y z)))))))
+  :rule-classes ())
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (logior (logand (bitn x (1- k)) (bitn y (1- k)))
+	    (logior (logand (bitn x (1- k)) (rc-carry x y (1- k)))
+		    (logand (bitn y (1- k)) (rc-carry x y (1- k)))))))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (logxor (bitn x (1- k))
+		 (logxor (bitn y (1- k)) (rc-carry x y (1- k))))
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :rule-classes ())
+
+(defun gen (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+(defun prop (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(defthmd gen-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen x y i j)
+                  (if (>= (+ (bits x i j) (bits y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j) (bits y i j))
+			(1+ (- i j))))))
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0)))))
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (logior (bitn x i) (bitn y i))))
+  :rule-classes ())
+
+(defthmd prop-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop x y i j)
+                  (if (= (+ (bits x i j) (bits y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthmd prop-as-logxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (logxor (bits x i j) (bits y i j))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthm gen-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (gen x y i j)
+		    (logior (gen x y i (1+ k))
+			    (logand (prop x y i (1+ k))
+				    (gen x y k j)))))
+  :rule-classes ())
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :rule-classes ())
+
+(defthm prop-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (prop x y i j)
+		    (logand (prop x y i (1+ k))
+			    (prop x y k j))))
+  :rule-classes ())
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j))))
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j)))))
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-plus-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (bits x i j)
+			     (bits y i j)
+			     (logior (prop x y (1- j) 0) 
+				     (gen x y (1- j) 0) ))
+			  (- i j) 0)))
+  :rule-classes ())
+
+(defthmd logand-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand (bits x i j) (bits y i j)) 0))
+           (equal (gen x y i j) 0)))
+
+
+(defthm logand-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand x y) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :rule-classes ())
+
+(defthmd gen-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (logand z y) 0)
+		(= (gen x y k 0) 1))
+	   (equal (gen (+ x y) z k 0) 0)))
+
+(defthmd gen-extend-3
+    (implies (and (natp i)
+		  (natp j)
+		  (> i j)
+		  (natp x)
+		  (natp y)
+		  (bvecp z (1+ j))
+		  (= (logand y z) 0))		  
+	     (equal (gen (+ x y) z i 0)
+		    (logand (prop x y i (1+ j))
+			    (gen (+ x y) z j 0)))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm lop-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ())
+
+(defthm lop-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (bits (lognot (* 2 b)) e 0))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
+
+(defun lamt (a b e)
+  (logxor a (bits (lognot b) e 0)))
+
+(defun lamg (a b e)
+  (logand a (bits (lognot b) e 0)))
+
+(defun lamz (a b e)
+  (bits (lognot (logior a (bits (lognot b) e 0))) e 0))
+
+(defun lam1 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam2 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam3 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam4 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam0 (a b e)
+  (logior (lam1 a b e)
+	  (logior (lam2 a b e)
+		  (logior (lam3 a b e)
+			  (lam4 a b e)))))
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (bitn (lognot(lamt a b e)) 0)))
+
+(defthm lop-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lognot (logxor a b)) k 0) 0)))
+  :rule-classes ())
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (logxor (logxor a b) 
+                                       (cat (logior a b) n c 1))
+                               k 0) 
+                         0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/arith.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/arith.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/arith.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/arith.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,863 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This file is based on the old "fp book", which was initially created by J
+; Moore and Matt Kaufmann in 1995 in support of their proof of the AMD-K5
+; division code.    Here, we have moved
+; non-local in-theory events to the end.  All events should be redundant, so we
+; have deleted all local in-theory events and added (local (in-theory nil)) to
+; the beginning.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;; (local (include-book "../arithmetic/fp"))
+;; (local (include-book "../arithmetic/fp2"))
+;; (local (include-book "../arithmetic/fl"))
+;; (local (include-book "../arithmetic/expt"))
+;; (local (include-book "../arithmetic/expo"))
+;; (local (include-book "../arithmetic/extra-rules"))
+;; (local (include-book "../support/ash"))
+
+(local (include-book "../lib2/top"))
+
+;; these already have lib1.delta1's
+;; arith.lisp!!  deftheory??? 
+;; Why I can't do that?? 
+
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+(defthm a1 (equal (+ x (+ y z)) (+ y (+ x z))))
+(defthm a2 (equal (- x) (* -1 x)))
+
+(defthm a3
+  (and
+   (implies
+    (syntaxp (and (quotep c1) (quotep c2)))
+    (and (equal (+ (* c1 x) (* c2 x)) (* (+ c1 c2) x))
+         (equal (+ (* c1 x) (+ (* c2 x) y)) (+ (* (+ c1 c2) x) y))))
+   (implies
+    (syntaxp (quotep c2))
+    (and (equal (+ x (* c2 x)) (* (+ 1 c2) x))
+         (equal (+ x (+ (* c2 x) y1)) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (* c2 x))) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (+ (* c2 x) y2))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (* c2 x)))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (+ y3 (* c2 x)))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))
+         (equal (+ x (+ y1 (+ y2 (+ (* c2 x) y3))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))))
+   (and (equal (+ x x) (* 2 x))
+        (equal (+ x (+ x y1)) (+ (* 2 x) y1)))))
+(defthm a4
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (+ c1 (+ c2 y1)) (+ (+ c1 c2) y1))))
+(defthm a5
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (* c1 (* c2 y1)) (* (* c1 c2) y1))))
+
+
+
+
+
+(defthm a6
+  (equal (/ (/ x)) (fix x)))
+(defthm a7
+  (equal (/ (* x y)) (* (/ x) (/ y))))
+
+;replaced force with case-split
+(defthm a8
+  (implies (and (case-split (acl2-numberp x))
+                (case-split (not (equal x 0))))
+           (and (equal (* x (* (/ x) y)) (fix y))
+                (equal (* x (/ x)) 1))))
+
+(defthm a9
+  (and (equal (* 0 x) 0)
+       (equal (* x (* y z)) (* y (* x z)))
+       (equal (* x (+ y z)) (+ (* x y) (* x z)))
+       (equal (* (+ y z) x) (+ (* y x) (* z x)))))
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+
+(defthm a10
+  (and (implies (integerp i) (equal (fl i) i))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1)) ;can actually drop this
+                     )
+                (and (equal (fl (+ i x1)) (+ i (fl x1)))
+                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2)))
+                (and (equal (fl (+ x1 (+ i x2))) (+ i (fl (+ x1 x2))))
+                     (equal (fl (+ x1 (+ x2 i))) (+ i (fl (+ x1 x2))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3)))
+                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
+                            (+ i (fl (+ x1 x2 x3))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
+                            (+ i (fl (+ x1 x2 x3))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3))
+                     (case-split (rationalp x4)))
+                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))))))
+
+(defthm a12
+  (implies (and (integerp i)
+                (integerp j)
+                (< 1 j)
+                (< j i))
+           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
+                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
+  :rule-classes :linear)
+
+
+;replaced force with case-split                
+;later, drop the hyp completely
+(defthm a13
+  (implies (case-split (rationalp x)) ;drop!
+           (and (< (1- x) (fl x))
+                (<= (fl x) x)))
+  :rule-classes :linear)
+
+(defthm a14
+  (and
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= 0 j))
+            (and (integerp (expt i j))
+                 (<= 0 (expt i j))))
+   (implies (and (rationalp i)
+                 (not (equal i 0)))
+            (not (equal (expt i j) 0))))
+  :rule-classes
+  ((:type-prescription
+    :corollary
+    (implies (and (integerp i)
+                  (<= 0 i)
+                  (<= 0 j))
+             (and (integerp (expt i j))
+                  (<= 0 (expt i j)))))
+   (:type-prescription
+    :corollary
+    (implies (and (rationalp i)
+                  (not (equal i 0)))
+             (not (equal (expt i j) 0))))))
+
+(defthm a15
+  (implies (and (rationalp i)
+                (not (equal i 0))
+                (integerp j1)
+                (integerp j2))
+           (and (equal (* (expt i j1) (expt i j2))
+                       (expt i (+ j1 j2)))
+                (equal (* (expt i j1) (* (expt i j2) x))
+                       (* (expt i (+ j1 j2)) x)))))
+(defthm a16
+  (equal (expt (* a b) i)
+         (* (expt a i) (expt b i))))
+
+(defthm /-weakly-monotonic
+  (implies (and (<= y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (<= (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+
+(defthm /-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (< (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+         
+(defthm *-weakly-monotonic
+  (implies (and (<= y y+)
+                (<= 0 x)
+                (case-split (rationalp x)) ; This does not hold if x, y, and z are complex!
+                )
+           (<= (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))))
+
+#| Here is the complex counterexample to which we alluded above.
+
+(let ((y  #c(1 -1))
+      (y+ #c(1 1))
+      (x  #c(1 1)))
+    (implies (and (<= y y+)
+                  (<= 0 x))
+             (<= (* x y) (* x y+))))
+|#
+
+(defthm *-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))))
+
+(defthm *-weakly-monotonic-negative-multiplier
+  (implies (and (<= y y+)
+               (< x 0)
+               (case-split (rationalp x))
+               )
+           (<= (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))))
+
+(defthm *-strongly-monotonic-negative-multiplier
+  (implies (and (< y y+)
+                (< x 0)
+                (case-split (rationalp x))
+                )
+           (< (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))))
+
+(defthm fl-weakly-monotonic
+  (implies (and (<= y y+)
+                (case-split (rationalp y)) ;drop?
+                (case-split (rationalp y+)) ;drop?
+                )
+           (<= (fl y) (fl y+)))
+  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
+                 (:linear)
+                 (:forward-chaining
+                  :trigger-terms ((fl y) (fl y+))
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))
+                 (:linear
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))))
+
+;; Fri Feb 20 16:24:25 2009
+;;
+;; ;; (deftheory arith-fc-monotonicity
+;; ;;   '((:forward-chaining /-weakly-monotonic)
+;; ;;     (:forward-chaining /-strongly-monotonic)
+;; ;;     (:forward-chaining *-weakly-monotonic . 1)
+;; ;;     (:forward-chaining *-weakly-monotonic . 2)
+;; ;;     (:forward-chaining *-strongly-monotonic . 1)
+;; ;;     (:forward-chaining *-strongly-monotonic . 2)
+;; ;;     (:forward-chaining *-weakly-monotonic-negative-multiplier . 1)
+;; ;;     (:forward-chaining *-weakly-monotonic-negative-multiplier . 2)
+;; ;;     (:forward-chaining *-strongly-monotonic-negative-multiplier . 1)
+;; ;;     (:forward-chaining *-strongly-monotonic-negative-multiplier . 2)
+;; ;;     (:forward-chaining fl-weakly-monotonic . 1)
+;; ;;     (:forward-chaining fl-weakly-monotonic . 2)
+;; ;;     ))
+;;
+;; Fri Feb 20 16:24:30 2009
+
+
+; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
+; product of a and b given intervals for a and b.  We consider three kinds of intervals.
+; We discuss only the a case.
+
+; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
+
+; nonneg-open intervals mean 0<=a<amax.
+
+; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
+
+; We now prove theorems with names like abs*nonneg-open, etc. characterizing
+; the product of two elements from two such intervals.  All of these theorems
+; are made with :rule-classes nil because I don't know how to control their
+; use.
+
+; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
+; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
+; lemma would be no different.
+
+(defthm abs*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+
+
+(defthm abs*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* bmax amax)) (* a b))
+                (< (* a b) (* bmax amax))))
+  :rule-classes nil)
+
+; The next three, which handle nonnegative open intervals in the first argument,
+; can actually be seen as uses of the abs intervals above.  Simply observe that
+; if 0<=a<amax then -amax<a<amax.
+
+(defthm nonneg-open*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+; and the commuted version
+(defthm nonneg-closed*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (<= a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (<= (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm abs*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (< (- bmax) b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)  
+
+(defthm rearrange-negative-coefs-<
+  (and (equal (< (* (- c) x) z)
+              (< 0 (+ (* c x) z)))
+       (equal (< (+ (* (- c) x) y) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y (* (- c) x)) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y1 y2 (* (- c) x)) z)
+              (< (+ y1 y2) (+ (* c x) z)))
+       (equal (< (+ y1 y2 y3 (* (- c) x)) z)
+              (< (+ y1 y2 y3) (+ (* c x) z)))
+       (equal (< z (+ (* (- c) x) y))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y (* (- c) x)))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y1 y2 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2)))
+       (equal (< z (+ y1 y2 y3 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2 y3)))))
+
+(defthm rearrange-negative-coefs-equal
+  (and (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp z)))
+                (equal (equal (* (- c) x) z)
+                       (equal 0 (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ (* (- c) x) y) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y (* (- c) x)) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 (* (- c) x)) z)
+                       (equal (+ y1 y2) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 y3 (* (- c) x)) z)
+                       (equal (+ y1 y2 y3) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ (* (- c) x) y))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y (* (- c) x)))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 y3 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2 y3))))))
+
+(defthm rearrange-fractional-coefs-<
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< (* (/ c) x) z)
+                   (< x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ (* (/ c) x) y) z)
+                   (< (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ y (* (/ c) x)) z)
+                   (< (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< (+ y1 y2 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< (+ y1 y2 y3 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) (* c y3) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< z (* (/ c) x))
+                   (< (* c z) x)))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ (* (/ c) x) y))
+                   (< (* c z) (+ x (* c y)))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ y (* (/ c) x)))
+                   (< (* c z) (+ (* c y) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 y3 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) (* c y3) x))))))
+
+(defthm rearrange-fractional-coefs-equal
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (equal (* (/ c) x) z)
+                   (equal x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ (* (/ c) x) y) z)
+                   (equal (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ y (* (/ c) x)) z)
+                   (equal (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 y3 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) (* c y3) x) (* c z))))))
+
+(defthm x*/y=1->x=y
+  (implies (and (rationalp x)
+                (rationalp y)
+                (not (equal x 0))
+                (not (equal y 0)))
+           (equal (equal (* x (/ y)) 1)
+                  (equal x y)))
+  :rule-classes nil)
+                
+(defun point-right-measure (x)
+  (floor (if (and (rationalp x) (< 0 x)) (/ x) 0) 1))
+
+(defun point-left-measure (x)
+  (floor (if (and (rationalp x) (> x 0)) x 0) 1))
+
+(include-book "ordinals/e0-ordinal" :dir :system)
+(set-well-founded-relation e0-ord-<)
+
+(defthm recursion-by-point-right
+  (and (e0-ordinalp (point-right-measure x))
+       (implies (and (rationalp x)
+                     (< 0 x)
+                     (< x 1))
+                (e0-ord-< (point-right-measure (* 2 x))
+                          (point-right-measure x)))))
+
+(defthm recursion-by-point-left
+  (and (e0-ordinalp (point-left-measure x))
+       (implies (and (rationalp x)
+                     (>= x 2))
+                (e0-ord-< (point-left-measure (* 1/2 x))
+                          (point-left-measure x)))))
+
+(defthm x<x*y<->1<y
+  (implies (and (rationalp x)
+                (< 0 x)
+                (rationalp y))
+           (equal (< x (* x y)) (< 1 y)))
+  :rule-classes nil)
+
+(defthm cancel-equal-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (not (equal a 0)))
+           (equal (equal (* a r) (* a s))
+                  (equal r s)))
+  :rule-classes nil)
+
+(defthmd expt-split
+  (implies (and (integerp i)
+                (integerp j)
+                (case-split (acl2-numberp r)) ;(integerp r)
+                (case-split (not (equal r 0)))
+                )
+           (equal (expt r (+ i j))
+                  (* (expt r i) (expt r j)))))
+
+(defthm cancel-<-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (< 0 a))
+           (equal (< (* a r) (* a s))
+                  (< r s)))
+  :rule-classes nil)
+
+(in-theory (disable fl
+                    inverse-of-*
+                    point-right-measure point-left-measure))
+
+
+;;;**********************************************************************
+;;;                       EXPONENTIATION
+;;;**********************************************************************
+
+(defthm expt-positive-integer-type
+    (implies (and (integerp a)
+		  (integerp i)
+		  (>= i 0))
+	     (integerp (expt a i)))
+  :rule-classes (:type-prescription))
+
+
+(defthm expt-2-positive-rational-type
+  (and (rationalp (expt 2 i))
+       (< 0 (expt 2 i)))
+  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
+
+(defthm expt-2-positive-integer-type
+  (implies (<= 0 i)
+           (and (integerp (expt 2 i))
+                (< 0 (expt 2 i))))
+  :rule-classes (:type-prescription))
+
+(defthm expt-2-type-linear
+  (implies (<= 0 i)
+           (<= 1 (expt 2 i)))
+  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
+
+(defthmd expt-weak-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (<= (expt 2 n) (expt 2 m))
+		  (<= n m))))
+
+(defthmd expt-strong-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (< (expt 2 n) (expt 2 m))
+		  (< n m))))
+
+(defthmd expt-inverse
+  (equal (/ (expt 2 i))
+         (expt 2 (* -1 i))))
+
+(defthm ash-rewrite
+    (implies (integerp n)
+	     (equal (ash n i)
+		    (fl (* n (expt 2 i))))))
+
+(defthm exp+1
+    (implies (and (integerp m)
+		  (integerp n)
+		  (<= n m))
+	     (> (* (- 1 (expt 2 m)) (- 1 (expt 2 n)))
+		(- 1 (expt 2 (1+ m)))))
+  :rule-classes ())
+
+(defthm exp+2
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (< (* (1+ (expt 2 m)) (1+ (expt 2 n)))
+		(1+ (expt 2 (+ m 2)))))
+  :rule-classes ())
+
+(defthm exp-invert
+    (implies (and (integerp n)
+		  (<= n -1))
+	     (<= (/ (- 1 (expt 2 n)))
+		 (1+ (expt 2 (1+ n)))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/bits-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/bits-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/bits-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/bits-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1693 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+(include-book "../lib2/bits")
+
+(local (include-book "../lib2/top"))
+(local (include-book "../../arithmetic/top"))
+
+
+(local 
+  (defthmd bits_alt-mbe-lemma-subgoal-2
+    (IMPLIES (AND (INTEGERP J)
+                  (INTEGERP I)
+                  (INTEGERP X)
+                  (< I J))
+             (EQUAL (FL (* (/ (EXPT 2 J))
+                           (MOD X (EXPT 2 (+ 1 I)))))
+                    0))))
+
+
+(encapsulate () 
+             ;; a proof for logone-ones-g
+             
+             (local (encapsulate () 
+             
+                                 (encapsulate ()
+                                              (local (include-book "../support/log"))  
+                                              (defthm bitn-logand
+                                                (implies (and (integerp x) ; (>= x 0)
+                                                              (integerp y) ; (>= y 0)
+                                                              (integerp n) (>= n 0)
+                                                              )
+                                                         (equal (bitn (logand x y) n)
+                                                                (logand (bitn x n) (bitn y n)))))
+
+
+                                              )
+   
+
+
+
+                                 (encapsulate ()
+                                              (local (include-book "../support/merge"))  
+
+                                              (defthmd logand-1-x
+                                                (implies (bvecp x 1)
+                                                         (equal (logand 1 x) x)))
+
+                                              )
+   
+
+
+
+                                 (encapsulate () 
+                                              (local (include-book "../support/logand"))
+
+                                              (defthm logand-bnd
+                                                (implies (<= 0 x)
+                                                         (<= (logand x y) x))
+                                                :rule-classes :linear
+                                                )
+
+
+                                              (defthm logand-commutative
+                                                (equal (logand j i)
+                                                       (logand i j)))
+             
+
+                                              (defthm logand-non-negative
+                                                (implies (or (<= 0 x)
+                                                             (<= 0 y)
+                                                             )
+                                                         (<= 0 (logand x y))))
+
+
+                                              (DEFTHM LOGAND-NON-NEGATIVE-INTEGER-TYPE-PRESCRIPTION
+                                                (IMPLIES (OR (<= 0 I) (<= 0 J))
+                                                         (AND (<= 0 (LOGAND I J))
+                                                              (INTEGERP (LOGAND I J))))
+                                                :RULE-CLASSES (:TYPE-PRESCRIPTION))
+
+                                              )
+
+
+
+                                 (encapsulate ()
+                                              (local (include-book "../support/badguys"))
+
+                                              (defun sumbits-badguy (x y k)
+                                                (if (zp k)
+                                                    0 ; arbitrary
+                                                  (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+                                                      (1- k)
+                                                    (sumbits-badguy x y (1- k)))))
+
+
+                                              (defthmd sumbits-badguy-is-correct
+                                                (implies (and (bvecp x k)
+                                                              (bvecp y k)
+                                                              (equal (bitn x (sumbits-badguy x y k))
+                                                                     (bitn y (sumbits-badguy x y k)))
+                                                              (integerp k)
+                                                              (< 0 k))
+                                                         (equal (equal x y) t))
+                                                :hints (("Goal"
+                                                         :use sumbits-badguy-is-correct-lemma
+                                                         :in-theory (enable sumbits-thm))))
+
+                                              (defthmd sumbits-badguy-bounds
+                                                (implies (and (integerp k)
+                                                              (< 0 k))
+                                                         (let ((badguy (sumbits-badguy x y k)))
+                                                           (and (integerp badguy)
+                                                                (<= 0 badguy)
+                                                                (< badguy k)))))
+                                              )
+             
+
+                                 (encapsulate ()
+                                              (local (include-book "../lib2/bits"))
+                                              (defthmd bitn-mod
+                                                (implies (and (< k n)
+                                                              (integerp n)
+                                                              (integerp k))
+                                                         (equal (bitn (mod x (expt 2 n)) k)
+                                                                (bitn x k)))))
+
+
+
+                                 (defthmd logand-ones-g-lemma-lemma
+                                   (implies (and (<= 0 k)
+                                                 (<= k (+ -1 n))
+                                                 (integerp n)
+                                                 (> n 0)
+                                                 (integerp k))
+                                            (equal (bitn (+ -1 (expt 2 n)) k) 1))
+                                   :hints (("Goal" :in-theory (e/d (bitn bits 
+                                                                         expt-2-reduce-leading-constant)
+                                                                   (bits-n-n-rewrite)))))
+
+
+
+                                 (defthmd logand-ones-g-lemma-1
+                                   (implies (and (<= 0 k)
+                                                 (<= k (+ -1 n))
+                                                 (< 0 n)
+                                                 (integerp n)
+                                                 (integerp x)
+                                                 (integerp k))
+                                            (equal (bitn (logand x (+ -1 (expt 2 n))) k)
+                                                   (bitn (mod x (expt 2 n)) k)))
+                                   :hints (("Goal" :in-theory (e/d (bitn-logand
+                                                                    bitn-mod
+                                                                    logand-1-x
+                                                                    logand-ones-g-lemma-lemma)
+                                                                   ()))))
+
+
+
+                                 (defthmd sumbits-badguy-fact
+                                   (implies (and (<= 0 k)
+                                                 (<= k n)
+                                                 (< 0 n)
+                                                 (integerp n)
+                                                 (integerp x)
+                                                 (integerp k))
+                                            (equal (bitn (logand x (+ -1 (expt 2 n)))
+                                                         (sumbits-badguy (logand x (+ -1 (expt 2 n)))
+                                                                         (mod x (expt 2 n))
+                                                                         k))
+                                                   (bitn (mod x (expt 2 n)) 
+                                                         (sumbits-badguy (logand x (+ -1 (expt 2 n)))
+                                                                         (mod x (expt 2 n)) k))))
+                                   :hints (("Goal" :in-theory (e/d (logand-ones-g-lemma-1)
+                                                                   (bitn-logand bitn-mod)))))
+
+
+
+                                 (defthm logand-ones-g-lemma-2
+                                   (implies (and (integerp x)
+                                                 (natp n))
+                                            (bvecp (logand x (+ -1 (expt 2 n))) n))
+                                   :hints (("Goal" 
+                                            :cases ((equal (logand x (+ -1 (expt 2 n)))
+                                                           (logand (+ -1 (expt 2 n)) x))))
+                                           ("Subgoal 1" 
+                                            :in-theory (e/d (bvecp) 
+                                                            (logand-bnd
+                                                             logand-commutative
+                                                             logand-non-negative))
+                                            :use ((:instance logand-bnd
+                                                             (x (+ -1 (expt 2 n)))
+                                                             (y x))
+                                                  (:instance logand-non-negative
+                                                             (x x)
+                                                             (y (+ -1 (expt 2 n))))))))
+
+
+
+                                 (defthm logand-ones-g-lemma-3
+                                   (implies (integerp x)
+                                            (bvecp (mod x (expt 2 n)) n))
+                                   :hints (("Goal" :in-theory (enable bvecp))))
+                                 ))
+
+             (defthmd logand-ones-g
+               (implies (and (integerp i)
+                             (case-split (integerp i))
+                             )
+                        (equal (logand i (1- (expt 2 n)))
+                               (mod i (expt 2 n))))
+               :hints (("Goal" :in-theory (e/d (sumbits-badguy-fact)
+                                               (sumbits-badguy-is-correct
+                                                bitn-mod
+                                                bitn-logand
+                                                logand-1-x))
+                        :cases ((not (and (integerp n)
+                                          (> n 0)))))
+                       ("Subgoal 2"  :use ((:instance sumbits-badguy-is-correct
+                                                      (x (logand i (+ -1 (expt 2 n))))
+                                                      (y (mod i (expt 2 n)))
+                                                      (k n))))
+                       ("Subgoal 1.1" :in-theory (enable binary-logand))))
+                            
+
+             )
+
+
+
+
+(local 
+ (defthmd bits_alt-mbe-lemma-subgoal-1-lemma-1
+   (IMPLIES (AND (INTEGERP J)
+                 (INTEGERP I)
+                 (INTEGERP X)
+                 (<= J I))
+            (EQUAL (FL (* (/ (EXPT 2 J))
+                          (MOD X (EXPT 2 (+ 1 I)))))
+                   (mod (FL (* X (EXPT 2 (* -1 J))))
+                        (EXPT 2 (+ 1 I (* -1 J))))))
+   :hints (("Goal" :in-theory (e/d (mod
+                                    acl2::expt-minus) 
+                                   ())))))
+
+
+
+
+(local 
+ (defthmd bits_alt-mbe-lemma-subgoal-1-lemma-2
+   (IMPLIES (AND (INTEGERP J)
+                 (INTEGERP I)
+                 (INTEGERP X)
+                 (<= J I))
+            (EQUAL (LOGAND (FL (* X (EXPT 2 (* -1 J))))
+                           (+ -1 (EXPT 2 (+ 1 I (* -1 J)))))
+                   (mod (FL (* X (EXPT 2 (* -1 J))))
+                        (EXPT 2 (+ 1 I (* -1 J))))))
+   :hints (("Goal" :in-theory (e/d (mod acl2::expt-minus
+                                        logand-ones-g)
+                                   ())))))
+
+
+
+(local 
+ (defthmd bits_alt-mbe-lemma-subgoal-1
+   (IMPLIES (AND (INTEGERP J)
+                 (INTEGERP I)
+                 (INTEGERP X)
+                 (<= J I))
+            (EQUAL (FL (* (/ (EXPT 2 J))
+                          (MOD X (EXPT 2 (+ 1 I)))))
+                   (LOGAND (FL (* X (EXPT 2 (* -1 J))))
+                           (+ -1 (EXPT 2 (+ 1 I (* -1 J)))))))
+   :hints (("Goal" :in-theory (e/d (bits_alt-mbe-lemma-subgoal-1-lemma-2
+                                    bits_alt-mbe-lemma-subgoal-1-lemma-1
+                                    ) ())))))
+
+
+
+
+
+(defund bits_alt (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))
+                  :guard-hints (("Goal" :in-theory (e/d
+                                                    (bits_alt-mbe-lemma-subgoal-1
+                                                     bits_alt-mbe-lemma-subgoal-2) ())))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+
+
+(defthmd bits_alt-is-bits
+  (equal (bits_alt x i j)
+         (bits x i j))
+  :hints (("Goal" :in-theory (e/d (bits_alt bits)
+                                  ()))))
+
+
+
+
+(defthm bits_alt-nonnegative-integerp-type
+  (and (<= 0 (bits_alt x i j))
+       (integerp (bits_alt x i j)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-nonnegative-integerp-type)))))
+
+(in-theory (disable (:type-prescription bits_alt)))
+
+(defthm bits_alt-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits_alt x i j) k))
+    :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                    ())
+             :use ((:instance bits-bvecp)))))
+                    
+
+;;Here is a variation of bits_alt-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits_alt-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits_alt x i j) k))
+    :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                    ())
+             :use ((:instance bits-bvecp-simple)))))
+
+(defthm mod-bits_alt-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits_alt x i j) (bits_alt y i j)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance mod-bits-equal)))))
+
+(defthmd mod-bits_alt-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits_alt (mod x (expt 2 n)) i j)
+		    (bits_alt x i j)))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance mod-bits-equal-cor)))))
+
+(defthmd bits_alt-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits_alt x i 0)
+		  (mod x (expt 2 (1+ i)))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-mod)))))
+  
+
+(defthmd bits_alt-bits_alt-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits_alt (+ (bits_alt x i 0) y) i 0)
+		  (bits_alt (+ x y) i 0)))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-bits-sum)))))
+
+
+(defthmd bits_alt-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits_alt x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i)))))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-mod-2)))))
+
+
+(defthm bits_alt-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits_alt x i j) 0))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-neg)))))
+
+;;;
+;;; may want to write an macro that does this proof step!!! 
+;;;
+
+(defthm bits_alt-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits_alt x i j)
+		  0))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-with-indices-in-the-wrong-order)))))
+
+(defthmd bvecp-bits_alt-0
+  (implies (bvecp x j)
+	   (equal (bits_alt x i j) 0))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bvecp-bits-0)))))
+
+(defthm bits_alt-0
+  (equal (bits_alt 0 i j) 0)
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-0)))))
+
+;;;;;;
+;;;;;;  Thu Feb  5 15:06:32 2009
+;;;;;;
+
+
+(local 
+ (defthmd fl-small-neg
+   (implies (and (real/rationalp x)
+                 (<= -1 x)
+                 (< x 0))
+            (equal (fl x) 
+                   -1))
+   :hints (("Goal" :in-theory (e/d (fl floor)
+                                   (floor-fl))))))
+            
+(defthmd neg-bits_alt-1
+  (implies (and (integerp x)
+                (natp i)
+                (natp j)
+                (< x 0)
+                (>= x (- (expt 2 j)))
+                (>= i j))
+           (equal (bits_alt x i j) 
+                  (+ -1 (expt 2 (+ 1 i (* -1 j))))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   fl-small-neg)
+                                  ())
+           :cases ((< (/ (expt 2 (+ 1 i)))
+                      (/ (expt 2 j))))
+           :use ((:instance BITS-MOD-2
+                            (i (+ 1 i))
+                            (j j))))))
+
+
+
+(defthmd bits_alt-minus-1
+  (implies (and (natp i)
+                (natp j)
+                (>= i j))
+           (equal (bits_alt -1 i j) 
+                  (+ -1  (expt 2 (+ 1 i (* -1 j))))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits fl-small-neg)
+                                  ())
+           :use ((:instance bits-mod-2
+                            (x -1)
+                            (i (+ 1 i))
+                            (j j))))))
+
+
+
+
+(defthm bits_alt-tail
+  (implies (and (bvecp x (1+ i))
+                (case-split (acl2-numberp i)))
+           (equal (bits_alt x i 0) x))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-tail)))))
+   
+
+;;;;
+;;;; 
+
+;; (i-am-here) ;; Mon Feb 23 16:31:22 2009
+
+
+(defthm bits_alt-tail-2
+  (implies (and (integerp x)
+                (natp i)
+                (< x (expt 2 i))
+                (>= x (- (expt 2 (+ 1 i)))))
+           (equal (bits_alt x i 0)
+                  (if (>= x 0)
+                      x
+                    (+ x (expt 2 (+ 1 i))))))
+   :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                    bits-mod
+                                    fl-small-neg
+                                    mod)
+                                   ()))
+           ("Subgoal 2" 
+            :cases ((<= -1 (* x (/ (expt 2 (+ 1 i)))))))
+           ("Subgoal 2.2" :in-theory (e/d (expt-2-reduce-leading-constant) ()))
+           ("Subgoal 1" :in-theory (e/d (expt-2-reduce-leading-constant) ()))))
+
+
+(defthm bits_alt-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+                (case-split (acl2-numberp i)))
+           (equal (bits_alt (+ x (* -1 y)) i 0)
+                  (+ x (* -1 y))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-drop-from-minus)))))
+  
+
+(defthmd bits_alt-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits_alt (fl (/ x (expt 2 k))) i j)
+		  (bits_alt x (+ i k) (+ j k))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-shift-down-1)))))
+
+
+(defthmd bits_alt-shift-down-2
+  (implies (and (integerp x)
+                (natp i)
+                (natp k))
+           (equal (fl (/ (bits_alt x (+ i k) 0) (expt 2 k)))
+                  (bits_alt (fl (/ x (expt 2 k))) i 0)))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   bits-mod)
+                                  ()))))
+
+
+(defthm bits_alt-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits_alt (* (expt 2 k) x) i j)
+		  (bits_alt x (- i k) (- j k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-shift-up-1)))))
+
+
+(defthm bits_alt-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits_alt x i 0))
+		  (bits_alt (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-shift-up-2)))))
+
+
+(defthmd bits_alt-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits_alt (+ x (* y (expt 2 k))) n m)
+		  (bits_alt y (- n k) (- m k))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-plus-mult-1)))))
+
+
+(defthm bits_alt-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits_alt (+ x (* y (expt 2 k))) n m)
+		  (bits_alt x n m)))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-plus-mult-2)))))
+
+(defthmd bits_alt-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits_alt (+ c x) n m)
+                   (bits_alt x n m)))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-plus-mult-2-rewrite)))))
+
+(defthm bits_alt-plus-bits_alt
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits_alt x n m)
+		(+ (bits_alt x (1- p) m)
+		   (* (expt 2 (- p m)) (bits_alt x n p)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-plus-bits)))))
+  
+
+(defthm bits_alt-bits_alt
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits_alt (bits_alt x i j) k l)
+		  (if (<= k (- i j))
+		      (bits_alt x (+ k j) (+ l j))
+		    (bits_alt x i (+ l j)))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-bits)))))
+
+  
+
+;;bits_alt-match can prove things like this:
+;;(thm (implies (equal 12 (bits_alt x 15 6))
+;;		(equal 4 (bits_alt x 8 6))))
+;;See also bits_alt-dont-match.
+
+(defthmd bits_alt-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits_alt x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits_alt k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits_alt x i j))
+		  t))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-match)))))
+
+;;bits_alt-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits_alt x 8 6))
+;;		(not (equal 4 (bits_alt x 15 6)))))
+;;See also bits_alt-match.
+
+(defthmd bits_alt-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits_alt x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits_alt k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits_alt x i j))
+		  nil))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-dont-match)))))
+
+;;;;;
+;;;;;
+
+
+;;;**********************************************************************
+;;;				BITN_ALT
+;;;**********************************************************************
+
+(local 
+ (defthmd evenp-sum
+   (implies (and (evenp x)
+                 (evenp y))
+            (evenp (- x y)))
+   :hints (("Goal" :in-theory (e/d (evenp) ())))))
+
+(local 
+ (defthmd evenp-2-factor
+   (implies (integerp x)
+            (evenp (* 2 x)))
+   :hints (("Goal" :in-theory (e/d (evenp) ())))))
+
+(local 
+ (defthmd bitn_alt-mbe-subgoal-2-lemma
+   (IMPLIES (AND (INTEGERP N)
+                 (INTEGERP X)
+                (evenp (FL (* X (EXPT 2 (* -1 N))))))
+            (evenp (BITN X N)))
+  :hints (("Goal" :in-theory (e/d (bitn expt-minus
+                                        evenp-2-factor)
+                                  (bits-n-n-rewrite))
+           :use ((:instance bits-mod-2
+                            (x x)
+                            (i (+ 1 n))
+                            (j n))
+                 (:instance evenp-sum
+                            (x (fl (* x (/ (expt 2 n)))))
+                            (y (* 2 (fl (* x (/ (expt 2 (+ 1 n)))))))))))))
+
+
+
+
+(defthmd bitn_alt-mbe-subgoal-2
+  (IMPLIES (AND (INTEGERP N)
+                (INTEGERP X)
+                (evenp (FL (* X (EXPT 2 (* -1 N))))))
+           (EQUAL (BITN X N) 0))
+  :hints (("Goal" :use ((:instance bitn-0-1
+                                   (x x)
+                                   (n n))
+                        (:instance bitn_alt-mbe-subgoal-2-lemma))
+           :in-theory (e/d (evenp) ()))))
+
+
+
+(local 
+ (defthmd not-evenp-sum
+   (implies (and (not (evenp x))
+                 (evenp y))
+            (not (evenp (- x y))))
+   :hints (("Goal" :in-theory (e/d (evenp) ())))))
+
+
+(local 
+ (defthmd bitn_alt-mbe-subgoal-1-lemma
+   (IMPLIES (AND (INTEGERP N)
+                 (INTEGERP X)
+                 (not (evenp (FL (* X (EXPT 2 (* -1 N)))))))
+            (not (evenp (BITN X N))))
+  :hints (("Goal" :in-theory (e/d (bitn expt-minus
+                                        evenp-2-factor)
+                                  (bits-n-n-rewrite))
+           :use ((:instance bits-mod-2
+                            (x x)
+                            (i (+ 1 n))
+                            (j n))
+                 (:instance not-evenp-sum
+                            (x (fl (* x (/ (expt 2 n)))))
+                            (y (* 2 (fl (* x (/ (expt 2 (+ 1 n)))))))))))))
+
+
+
+
+(defthmd bitn_alt-mbe-subgoal-1
+  (IMPLIES (AND (INTEGERP N)
+                (INTEGERP X)
+                (NOT (evenp (FL (* X (EXPT 2 (* -1 N)))))))
+           (EQUAL (BITN X N) 1))
+  :hints (("Goal" :use ((:instance bitn-0-1
+                                   (x x)
+                                   (n n))
+                        (:instance bitn_alt-mbe-subgoal-1-lemma))
+           :in-theory (e/d (evenp) ()))))
+
+
+
+(defund bitn_alt (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))
+                  :guard-hints (("Goal" :in-theory (e/d (bitn_alt-mbe-subgoal-1
+                                                         bitn_alt-mbe-subgoal-2
+                                                         bits_alt-is-bits) ())))))
+  (mbe :logic (bits_alt x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthmd bitn_alt-is-bitn
+  (equal (bitn_alt x n)
+         (bitn x n))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   bitn_alt
+                                   bits_alt)
+                                  ()))))
+   
+
+
+(defthm bitn_alt-nonnegative-integer
+  (and (integerp (bitn_alt x n))
+       (<= 0 (bitn_alt x n)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-nonnegative-integer)))))
+
+(in-theory (disable (:type-prescription bitn_alt)))
+
+(defthm bits_alt-n-n-rewrite
+  (equal (bits_alt x n n)
+	 (bitn_alt x n))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   bitn_alt-is-bitn) ())
+           :use ((:instance bits-n-n-rewrite)))))
+
+(defthmd bitn_alt-def
+  (implies (case-split (integerp n))
+	   (equal (bitn_alt x n)
+		  (mod (fl (/ x (expt 2 n))) 2)))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-def)))))
+
+;;A recursive formulation:
+
+(defthmd bitn_alt-rec-0
+  (implies (integerp x)
+	   (equal (bitn_alt x 0) (mod x 2)))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-rec-0)))))
+
+
+(defthmd bitn_alt-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn_alt x n)
+		    (bitn_alt (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn_alt t t))))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-rec-pos)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn_alt-0-1
+    (or (equal (bitn_alt x n) 0)
+	(equal (bitn_alt x n) 1))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-0-1)))))
+
+(defthm bitn_alt-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn_alt x n) k))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-bvecp)))))
+
+;;The following is a special case of bitn_alt-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn_alt-bvecp-forward
+  (bvecp (bitn_alt x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn_alt x n))))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-bvecp-forward)))))
+
+(defthm bitn_alt-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn_alt x n) 0))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-neg)))))
+
+
+(defthm bitn_alt-0
+  (equal (bitn_alt 0 k) 0)
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-0)))))
+
+(defthm bitn_alt-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn_alt x 0) x))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-bvecp-1)))))
+
+(defthm bitn_alt-bitn_alt-0
+    (equal (bitn_alt (bitn_alt x n) 0)
+	   (bitn_alt x n))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-bitn-0)))))
+
+(defthmd bitn_alt-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn_alt (mod x (expt 2 n)) k)
+		    (bitn_alt x k)))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-mod)))))
+
+(defthm bvecp-bitn_alt-0
+    (implies (bvecp x n)
+	     (equal (bitn_alt x n) 0))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bvecp-bitn-0)))))
+
+
+
+(defthm neg-bitn_alt-1
+  (implies (and (integerp x)
+                (integerp n)
+                (< x 0)
+                (>= x (- (expt 2 n))))
+           (equal (bitn_alt x n) 1))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn
+                                   bits_alt-is-bits
+                                   bitn
+                                   ) (bits-n-n-rewrite))
+           :use ((:instance neg-bits_alt-1
+                            (x x)
+                            (i n)
+                            (j n))))))
+
+
+(defthmd bitn_alt-shift
+  (implies (and (integerp n)
+                (integerp k))
+           (equal (bitn_alt (* x (expt 2 k)) (+ n k))
+                  (bitn_alt x n)))
+   :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+            :use ((:instance bitn-shift)))))
+
+
+(defthmd bitn_alt-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn_alt (fl (/ x (expt 2 k))) i)
+		  (bitn_alt x (+ i k))))
+   :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+            :use ((:instance bitn-shift-down)))))
+
+(defthm bitn_alt-bits_alt
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn_alt (bits_alt x i j) k)
+		  (bitn_alt x (+ j k))))
+   :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                    bitn_alt-is-bitn) ())
+            :use ((:instance bitn-bits)))))
+
+(defthmd bitn_alt-plus-bits_alt
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits_alt x n m)
+		(+ (* (bitn_alt x n) (expt 2 (- n m)))
+		   (bits_alt x (1- n) m))))
+   :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                    bitn_alt-is-bitn) ())
+            :use ((:instance bitn-plus-bits)))))
+
+(defthm bits_alt-plus-bitn_alt
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits_alt x n m)
+		(+ (bitn_alt x m)
+		   (* 2 (bits_alt x n (1+ m))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   bitn_alt-is-bitn) ())
+           :use ((:instance bits-plus-bitn)))))
+
+(defun sumbits_alt (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn_alt x (1- n)))
+       (sumbits_alt x (1- n)))))
+
+(local 
+ (defthmd sumbits_alt-is-sumbits
+   (equal (sumbits_alt x n)
+          (sumbits x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())))))
+ 
+
+(defthmd sumbits_alt-bits_alt
+  (implies (and (integerp x)
+                (natp n)
+                (> n 0))
+           (equal (sumbits_alt x n)
+                  (bits_alt x (1- n) 0)))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   binary-cat
+                                   sumbits_alt-is-sumbits) (cat-bitn-bits))
+            :induct (sumbits x n))
+           ("Subgoal *1/2" 
+            :use ((:instance cat-bitn-bits
+                             (x x)
+                             (j (+ -1 n))
+                             (m 1)
+                             (k (+ -2 n))
+                             (l 0)
+                             (n (+ -1 n)))))))
+
+(defthmd sumbits_alt-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits_alt x n)
+		    x))
+   :hints (("Goal" :in-theory (e/d (sumbits_alt-is-sumbits) ())
+            :use ((:instance sumbits-thm)))))
+    
+
+; The lemmas sumbits_alt-badguy-is-correct and sumbits_alt-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits_alt-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn_alt x (1- k)) (bitn_alt y (1- k))))
+        (1- k)
+      (sumbits_alt-badguy x y (1- k)))))
+
+
+(defthmd sumbits_alt-badguy-is-sumbits-badguy
+  (equal (sumbits_alt-badguy x y k)
+         (sumbits-badguy x y k))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ()))))
+
+
+(defthmd sumbits_alt-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn_alt x (sumbits_alt-badguy x y k))
+                       (bitn_alt y (sumbits_alt-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t))
+  :hints (("Goal" :in-theory (e/d (sumbits_alt-badguy-is-sumbits-badguy
+                                   bitn_alt-is-bitn) ())
+           :use ((:instance sumbits-badguy-is-correct)))))
+
+(defthmd sumbits_alt-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits_alt-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k))))
+  :hints (("Goal" :in-theory (e/d (sumbits_alt-badguy-is-sumbits-badguy
+                                   bitn_alt-is-bitn) ())
+           :use ((:instance sumbits-badguy-bounds)))))
+
+;; from existing file. 
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn_alt
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn_alt (sum-b b n) k)
+	          (nth k b)))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn)
+                                  ())
+           :use ((:instance sum-bitn)))))
+
+
+(defthmd bvecp-bitn_alt-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn_alt x n) 1))
+    :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+             :use ((:instance bvecp-bitn-1)))))
+
+(defthmd bvecp-bitn_alt-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn_alt x k) 1))
+  :rule-classes ((:rewrite :match-free :all))
+    :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+             :use ((:instance bvecp-bitn-2)))))
+
+;;;;
+
+;;;
+;;; the leading 0. 
+;;;
+(local 
+ (defthmd fl-neg-fact-2
+   (implies (and (<= -2 x)
+                 (< x -1)
+                 (rationalp x))
+            (equal (fl x)
+                   -2))))
+            
+
+
+
+(defthmd neg-bitn_alt-0-lemma
+  (implies (and (integerp x)
+                (natp n)
+                (< x (- (expt 2 n)))
+                (>= x (- (expt 2 (1+ n)))))
+            (evenp (bitn x n)))
+  :hints (("Goal" :in-theory (e/d (fl-neg-fact-2
+                                   evenp-2-factor
+                                   bitn)
+                                  (bits-n-n-rewrite
+                                   REARRANGE-NEGATIVE-COEFS-EQUAL
+                                   MOVE-NEGATIVE-CONSTANT-1
+                                   evenp))
+           :cases ((not (and (<= -2 (* x (/ (expt 2 n))))
+                             (< (* x (/ (expt 2 n))) -1)))))
+          ("Subgoal 2" :use ((:instance bits-mod-2
+                                        (x x)
+                                        (i (+ 1 n))
+                                        (j n))
+                             (:instance evenp-sum
+                                        (x -2)
+                                        (y (* 2 (fl (* x (/ (expt 2 (+ 1
+                                                                       n))))))))))
+          ("Subgoal 1" :in-theory (e/d (expt-2-reduce-leading-constant) ()))))
+
+;;;;
+;;;; could have other way to prove this. 
+;;;;
+(defthm neg-bitn_alt-0
+  (implies (and (integerp x)
+                (natp n)
+                (< x (- (expt 2 n)))
+                (>= x (- (expt 2 (1+ n)))))
+            (equal (bitn_alt x n) 0))
+  :hints (("Goal" :use ((:instance neg-bitn_alt-0-lemma)
+                        (:instance bitn-0-1))
+           :in-theory (e/d (bitn_alt-is-bitn) ()))))
+
+(local 
+ (defthmd mod-x-is
+  (implies (and (integerp x)
+                (integerp n)
+                (integerp k)
+                (< k n)
+                (< x (- (expt 2 k) (expt 2 n)))
+                (>= x (- (expt 2 n))))
+           (and (<= 0 (mod x (expt 2 n)))
+                (< (mod x (expt 2 n)) 
+                   (expt 2 k))))
+  :hints (("Goal" :in-theory (e/d (mod fl-small-neg) ())
+           :cases ((not (and (<= -1 (* x (/ (expt 2 n))))
+                             (< x 0))))))))
+
+               
+  
+
+(defthm neg-bitn_alt-2
+  (implies (and (integerp x)
+                (integerp n)
+                (integerp k)
+                (< k n)
+                (< x (- (expt 2 k) (expt 2 n)))
+                (>= x (- (expt 2 n))))
+	     (equal (bitn_alt x k) 0))
+  :hints (("Goal"  :cases ((bvecp (mod x (expt 2 n)) k)))
+          ("Subgoal 2" :in-theory (e/d (bvecp) ())
+           :use ((:instance mod-x-is)))
+          ("Subgoal 1" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance bitn-mod)))))
+           
+
+(defthmd bitn_alt-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn_alt (expt 2 n) n)
+		    1))
+   :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+            :use ((:instance bitn-expt)))))
+
+(defthmd bitn_alt-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn_alt (expt 2 i) n)
+		  0))
+   :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+            :use ((:instance bitn-expt-0)))))
+
+(defthm bitn_alt-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn_alt (+ x (expt 2 n)) n)
+			 (bitn_alt x n))))
+    :rule-classes ()
+    :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+            :use ((:instance bitn-plus-expt-1)))))
+
+(defthmd bitn_alt-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn_alt (+ x (* k (expt 2 m))) n)
+		    (bitn_alt x n)))
+    :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+            :use ((:instance bitn-plus-mult)))))
+
+(defthmd bitn_alt-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn_alt (+ c x) n)
+		    (bitn_alt x n)))
+    :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+            :use ((:instance bitn-plus-mult-rewrite)))))
+
+
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+
+(defund binary-cat_alt (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits_alt x (1- m) 0))
+         (bits_alt y (1- n) 0))
+    0))
+
+
+(defthmd binary-cat_alt-is-binary-cat
+  (equal (binary-cat_alt x m y n)
+         (binary-cat x m y n))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   binary-cat_alt
+                                   binary-cat)
+                                  ()))))
+  
+
+;;Definition of the macro, cat_alt:
+
+;;X is a list of alternating data values and sizes.  CAT_ALT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat_alt (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits_alt ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat_alt ,@x))
+        (t
+         `(binary-cat_alt ,(car x) 
+                      ,(cadr x) 
+                      (cat_alt ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+
+(defthm cat_alt-nonnegative-integer-type
+  (and (integerp (cat_alt x m y n))
+       (<= 0 (cat_alt x m y n)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat) ())
+           :use ((:instance cat-nonnegative-integer-type)))))
+                                   
+
+(in-theory (disable (:type-prescription binary-cat_alt)))
+
+(defthm cat_alt-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat_alt x m y n) k))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat) ())
+           :use ((:instance cat-bvecp)))))
+
+(defthm cat_alt-with-n-0
+  (equal (binary-cat_alt x m y 0)
+	 (bits_alt x (1- m) 0))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits) ())
+           :use ((:instance cat-with-n-0)))))
+
+(defthm cat_alt-with-m-0
+  (equal (binary-cat_alt x 0 y n)
+	 (bits_alt y (1- n) 0))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits) ())
+           :use ((:instance cat-with-m-0)))))
+
+(defthm cat_alt-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat_alt 0 m y n) y))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat)
+                                  ())
+           :use ((:instance cat-0)))))
+
+(defthmd cat_alt-bits_alt-1
+    (equal (cat_alt (bits_alt x (1- m) 0) m y n)
+	   (cat_alt x m y n))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance cat-bits-1)))))
+
+(defthmd cat_alt-bits_alt-2
+    (equal (cat_alt x m (bits_alt y (1- n) 0) n)
+	   (cat_alt x m y n))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance cat-bits-2)))))
+
+
+
+(defthm cat_alt-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat_alt (cat_alt x m y n) p z q)
+		  (cat_alt x m (cat_alt y n z q) (+ n q))))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat)
+                                  ())
+           :use ((:instance cat-associative)))))
+
+(defthmd cat_alt-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat_alt x m y n))
+		  (and (equal y (bits_alt k (1- n) 0))
+		       (equal x (bits_alt k (+ -1 m n) n)))))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance cat-equal-constant)))))
+
+(defthmd cat_alt-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat_alt x1 m y1 n)
+			 (cat_alt x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2))))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat)
+                                  ())
+           :use ((:instance cat-equal-rewrite)))))
+
+(defthm cat_alt-bits_alt-bits_alt
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat_alt (bits_alt x i j) m (bits_alt x k l) n)
+		  (bits_alt x i l)))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance cat-bits-bits)))))
+
+(defthm cat_alt-bitn_alt-bits_alt
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat_alt (bitn_alt x j) m (bits_alt x k l) n)
+		    (bits_alt x j l)))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bitn_alt-is-bitn
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance cat-bitn-bits)))))
+
+(defthm cat_alt-bits_alt-bitn_alt
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat_alt (bits_alt x i j) m (bitn_alt x k) 1)
+		  (bits_alt x i k)))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bitn_alt-is-bitn
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance cat-bits-bitn)))))
+
+(defthm cat_alt-bitn_alt-bitn_alt
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat_alt (bitn_alt x i) 1 (bitn_alt x j) 1)
+		  (bits_alt x i j)))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits
+                                   bitn_alt-is-bitn)
+                                  ())
+           :use ((:instance cat-bitn-bitn)))))
+
+(defthmd bits_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits_alt (cat_alt x m y n) i j)
+		  (if (< i n)
+		      (bits_alt y i j)
+		    (if (>= j n)
+			(bits_alt x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat_alt (bits_alt x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits_alt y (1- n) j)
+			    (- n j))))))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-cat)))))
+
+
+(defthm bits_alt-cat_alt-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits_alt (cat_alt x m y n) i j)
+		  (if (< i n)
+		      (bits_alt y i j)
+		    (if (>= j n)
+			(bits_alt x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat_alt (bits_alt x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits_alt y (1- n) j)
+			   (- n j))))))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance bits-cat-constants)))))
+
+(defthmd bitn_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn_alt (cat_alt x m y n) i)
+		  (if (< i n)
+		      (bitn_alt y i)
+		    (if (< i (+ m n))
+		      (bitn_alt x (- i n))
+		    0))))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bitn_alt-is-bitn)
+                                  ())
+           :use ((:instance bitn-cat)))))
+
+(defthm bitn_alt-cat_alt-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn_alt (cat_alt x m y n) i)
+		  (if (< i n)
+		      (bitn_alt y i)
+		    (if (< i (+ m n))
+		      (bitn_alt x (- i n))
+		    0))))
+  :hints (("Goal" :in-theory (e/d (binary-cat_alt-is-binary-cat
+                                   bitn_alt-is-bitn)
+                                  ())
+           :use ((:instance bitn-cat-constants)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat_alt, which can't
+; be changed because of the guard of bits_alt.
+(defund mulcat_alt (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat_alt (mulcat_alt l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits_alt x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat_alt (mulcat_alt l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+
+(defthmd mulcat_alt-is-mul-cat
+  (equal (mulcat_alt l n x)
+         (mulcat l n x))
+  :hints (("Goal" :in-theory (e/d (mulcat_alt
+                                   binary-cat_alt-is-binary-cat
+                                   mulcat) ()))))
+
+(defthm mulcat_alt-nonnegative-integer-type
+  (and (integerp (mulcat_alt l n x))
+       (<= 0 (mulcat_alt l n x)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (e/d (mulcat_alt-is-mul-cat)
+                                  ())
+           :use ((:instance mulcat-nonnegative-integer-type)))))
+  
+
+(in-theory (disable (:type-prescription mulcat_alt)))
+
+(defthmd mulcat_alt-bits_alt
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat_alt l n (bits_alt x (1- l) 0))
+		    (mulcat_alt l n x)))
+  :hints (("Goal" :in-theory (e/d (mulcat_alt-is-mul-cat
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance mulcat-bits)))))
+
+(defthm mulcat_alt-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat_alt l n x) p))
+  :hints (("Goal" :in-theory (e/d (mulcat_alt-is-mul-cat)
+                                  ())
+           :use ((:instance mulcat-bvecp)))))
+
+
+(defthm mulcat_alt-1
+    (implies (natp l)
+	     (equal (mulcat_alt l 1 x) 
+		    (bits_alt x (1- l) 0)))
+  :hints (("Goal" :in-theory (e/d (mulcat_alt-is-mul-cat
+                                   bits_alt-is-bits)
+                                  ())
+           :use ((:instance mulcat-1)))))
+
+(defthm mulcat_alt-0
+  (equal (mulcat_alt l n 0) 0)
+  :hints (("Goal" :in-theory (e/d (mulcat_alt-is-mul-cat)
+                                  ())
+           :use ((:instance mulcat-0)))))
+
+
+
+(defthm mulcat_alt-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat_alt 1 n 1)
+		  (1- (expt 2 n))))
+  :hints (("Goal" :in-theory (e/d (mulcat_alt-is-mul-cat)
+                                  ())
+           :use ((:instance mulcat-n-1)))))
+
+(defthm bitn_alt-mulcat_alt-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn_alt (mulcat_alt 1 n x) m)
+		  x))
+  :hints (("Goal" :in-theory (e/d (mulcat_alt-is-mul-cat
+                                   bitn_alt-is-bitn)
+                                  ())
+           :use ((:instance bitn-mulcat-1)))))
+
+
+;; (i-am-here)  Fri Feb 13 12:04:51 2009
+
+;; new addition. 
+
+(local 
+ (defthm bits-bits-times-1
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp i))
+            (= (bits (* (bits x i 0) y) i 0)
+               (bits (* x y) i 0)))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance mod-mod-times (a x) (b y) (n (expt 2 (1+ i)))))
+            :in-theory (enable bits-mod)))))
+
+(defthmd bits_alt-bits_alt-times
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i))
+	     (equal (bits_alt (* (bits_alt x i 0) y) i 0)
+                    (bits_alt (* x y) i 0)))
+  :hints (("Goal" :use (bits-bits-times-1)
+           :in-theory (e/d (bits_alt-is-bits) ()))))
+                            
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/bits-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/bits-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/bits-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/bits-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,933 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../lib2/basic")
+
+(local (include-book "bits-new-proofs"))  
+
+;; It is important that we don't have export a definition of "bits",
+;; "bitn". 
+;; 
+;; eventually we will add a wrapper to redefine "bits_alt" as new "bits" 
+;;                                              "bitn_alt" as new "bitn"
+;;
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+;;; Thu Feb  5 09:13:20 2009. no change from lib2/bits.lisp
+
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS_ALT
+;;;**********************************************************************
+
+;;;
+;;; Thu Feb  5 09:13:43 2009. new definition for bits 
+;;;
+;;; later we will redefine bits to have the same definition of bits_alt. 
+;;;
+
+(defund bits_alt (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+
+
+
+(defthm bits_alt-nonnegative-integerp-type
+  (and (<= 0 (bits_alt x i j))
+       (integerp (bits_alt x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits_alt)))
+
+(defthm bits_alt-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits_alt x i j) k)))
+
+;;Here is a variation of bits_alt-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits_alt-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits_alt x i j) k)))
+
+(defthm mod-bits_alt-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits_alt x i j) (bits_alt y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits_alt-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits_alt (mod x (expt 2 n)) i j)
+		    (bits_alt x i j))))
+
+(defthmd bits_alt-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits_alt x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits_alt-bits_alt-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits_alt (+ (bits_alt x i 0) y) i 0)
+		  (bits_alt (+ x y) i 0))))
+
+(defthmd bits_alt-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits_alt x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i))))))))
+
+(defthm bits_alt-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits_alt x i j) 0)))
+
+(defthm bits_alt-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits_alt x i j)
+		  0)))
+
+(defthmd bvecp-bits_alt-0
+  (implies (bvecp x j)
+	   (equal (bits_alt x i j) 0)))
+
+(defthm bits_alt-0
+  (equal (bits_alt 0 i j) 0))
+
+(defthmd neg-bits_alt-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits_alt x i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j)))))))
+
+(defthmd bits_alt-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits_alt -1 i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j)))))))
+
+(defthm bits_alt-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits_alt x i 0) x)))
+
+(defthm bits_alt-tail-2
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits_alt x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+
+(defthm bits_alt-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits_alt (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+(defthmd bits_alt-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits_alt (fl (/ x (expt 2 k))) i j)
+		  (bits_alt x (+ i k) (+ j k)))))
+
+(defthmd bits_alt-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits_alt x (+ i k) 0) (expt 2 k)))
+		  (bits_alt (fl (/ x (expt 2 k))) i 0))))
+
+(defthm bits_alt-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits_alt (* (expt 2 k) x) i j)
+		  (bits_alt x (- i k) (- j k))))
+  :rule-classes ())
+
+(defthm bits_alt-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits_alt x i 0))
+		  (bits_alt (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ())
+
+(defthmd bits_alt-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits_alt (+ x (* y (expt 2 k))) n m)
+		  (bits_alt y (- n k) (- m k)))))
+
+(defthm bits_alt-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits_alt (+ x (* y (expt 2 k))) n m)
+		  (bits_alt x n m))))
+
+(defthmd bits_alt-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits_alt (+ c x) n m)
+                   (bits_alt x n m))))
+
+(defthm bits_alt-plus-bits_alt
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits_alt x n m)
+		(+ (bits_alt x (1- p) m)
+		   (* (expt 2 (- p m)) (bits_alt x n p)))))
+  :rule-classes ())
+
+(defthm bits_alt-bits_alt
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits_alt (bits_alt x i j) k l)
+		  (if (<= k (- i j))
+		      (bits_alt x (+ k j) (+ l j))
+		    (bits_alt x i (+ l j))))))
+
+;;bits_alt-match can prove things like this:
+;;(thm (implies (equal 12 (bits_alt x 15 6))
+;;		(equal 4 (bits_alt x 8 6))))
+;;See also bits_alt-dont-match.
+
+(defthmd bits_alt-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits_alt x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits_alt k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits_alt x i j))
+		  t)))
+
+;;bits_alt-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits_alt x 8 6))
+;;		(not (equal 4 (bits_alt x 15 6)))))
+;;See also bits_alt-match.
+
+(defthmd bits_alt-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits_alt x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits_alt k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits_alt x i j))
+		  nil)))
+
+;;
+;; Thu Feb  5 10:09:26 2009: from lib2/bits.lisp
+;; 
+
+(defun bitvec (x n)
+   (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN_ALT
+;;;**********************************************************************
+
+(defund bitn_alt (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits_alt x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn_alt-nonnegative-integer
+  (and (integerp (bitn_alt x n))
+       (<= 0 (bitn_alt x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn_alt)))
+
+(defthm bits_alt-n-n-rewrite
+  (equal (bits_alt x n n)
+	 (bitn_alt x n)))
+
+(defthmd bitn_alt-def
+  (implies (case-split (integerp n))
+	   (equal (bitn_alt x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn_alt-rec-0
+  (implies (integerp x)
+	   (equal (bitn_alt x 0) (mod x 2))))
+
+(defthmd bitn_alt-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn_alt x n)
+		    (bitn_alt (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn_alt t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn_alt-0-1
+    (or (equal (bitn_alt x n) 0)
+	(equal (bitn_alt x n) 1))
+  :rule-classes ())
+
+(defthm bitn_alt-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn_alt x n) k)))
+
+;;The following is a special case of bitn_alt-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn_alt-bvecp-forward
+  (bvecp (bitn_alt x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn_alt x n)))))
+
+(defthm bitn_alt-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn_alt x n) 0)))
+
+(defthm bitn_alt-0
+  (equal (bitn_alt 0 k) 0))
+
+(defthm bitn_alt-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn_alt x 0) x)))
+
+(defthm bitn_alt-bitn_alt-0
+    (equal (bitn_alt (bitn_alt x n) 0)
+	   (bitn_alt x n)))
+
+(defthmd bitn_alt-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn_alt (mod x (expt 2 n)) k)
+		    (bitn_alt x k))))
+
+(defthm bvecp-bitn_alt-0
+    (implies (bvecp x n)
+	     (equal (bitn_alt x n) 0)))
+
+(defthm neg-bitn_alt-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn_alt x n) 1)))
+
+(defthmd bitn_alt-shift
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn_alt (* x (expt 2 k)) (+ n k))
+		  (bitn_alt x n))))
+
+(defthmd bitn_alt-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn_alt (fl (/ x (expt 2 k))) i)
+		  (bitn_alt x (+ i k)))))
+
+(defthm bitn_alt-bits_alt
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn_alt (bits_alt x i j) k)
+		  (bitn_alt x (+ j k)))))
+
+(defthmd bitn_alt-plus-bits_alt
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits_alt x n m)
+		(+ (* (bitn_alt x n) (expt 2 (- n m)))
+		   (bits_alt x (1- n) m)))))
+
+(defthm bits_alt-plus-bitn_alt
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits_alt x n m)
+		(+ (bitn_alt x m)
+		   (* 2 (bits_alt x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits_alt (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn_alt x (1- n)))
+       (sumbits_alt x (1- n)))))
+
+(defthmd sumbits_alt-bits_alt
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits_alt x n)
+		    (bits_alt x (1- n) 0))))
+
+(defthmd sumbits_alt-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits_alt x n)
+		    x)))
+
+; The lemmas sumbits_alt-badguy-is-correct and sumbits_alt-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits_alt-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn_alt x (1- k)) (bitn_alt y (1- k))))
+        (1- k)
+      (sumbits_alt-badguy x y (1- k)))))
+
+(defthmd sumbits_alt-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn_alt x (sumbits_alt-badguy x y k))
+                       (bitn_alt y (sumbits_alt-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t)))
+
+(defthmd sumbits_alt-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits_alt-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn_alt
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn_alt (sum-b b n) k)
+	          (nth k b))))
+
+(defthmd bvecp-bitn_alt-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn_alt x n) 1)))
+
+(defthmd bvecp-bitn_alt-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn_alt x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthm neg-bitn_alt-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn_alt x n) 0)))
+
+(defthm neg-bitn_alt-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn_alt x k) 0)))
+
+(defthmd bitn_alt-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn_alt (expt 2 n) n)
+		    1)))
+
+(defthmd bitn_alt-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn_alt (expt 2 i) n)
+		  0)))
+
+(defthm bitn_alt-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn_alt (+ x (expt 2 n)) n)
+			 (bitn_alt x n))))
+  :rule-classes ())
+
+(defthmd bitn_alt-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn_alt (+ x (* k (expt 2 m))) n)
+		    (bitn_alt x n))))
+
+(defthmd bitn_alt-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn_alt (+ c x) n)
+		    (bitn_alt x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat_alt (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits_alt x (1- m) 0))
+         (bits_alt y (1- n) 0))
+    0))
+
+;;Definition of the macro, cat_alt:
+
+;;X is a list of alternating data values and sizes.  CAT_ALT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat_alt (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits_alt ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat_alt ,@x))
+        (t
+         `(binary-cat_alt ,(car x) 
+                      ,(cadr x) 
+                      (cat_alt ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat_alt-nonnegative-integer-type
+  (and (integerp (cat_alt x m y n))
+       (<= 0 (cat_alt x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat_alt)))
+
+(defthm cat_alt-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat_alt x m y n) k)))
+
+(defthm cat_alt-with-n-0
+  (equal (binary-cat_alt x m y 0)
+	 (bits_alt x (1- m) 0)))
+
+(defthm cat_alt-with-m-0
+  (equal (binary-cat_alt x 0 y n)
+	 (bits_alt y (1- n) 0)))
+
+(defthm cat_alt-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat_alt 0 m y n) y)))
+
+(defthmd cat_alt-bits_alt-1
+    (equal (cat_alt (bits_alt x (1- m) 0) m y n)
+	   (cat_alt x m y n)))
+
+(defthmd cat_alt-bits_alt-2
+    (equal (cat_alt x m (bits_alt y (1- n) 0) n)
+	   (cat_alt x m y n)))
+
+(defthm cat_alt-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat_alt (cat_alt x m y n) p z q)
+		  (cat_alt x m (cat_alt y n z q) (+ n q)))))
+
+(defthmd cat_alt-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat_alt x m y n))
+		  (and (equal y (bits_alt k (1- n) 0))
+		       (equal x (bits_alt k (+ -1 m n) n))))))
+
+(defthmd cat_alt-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat_alt x1 m y1 n)
+			 (cat_alt x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat_alt-bits_alt-bits_alt
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat_alt (bits_alt x i j) m (bits_alt x k l) n)
+		  (bits_alt x i l))))
+
+(defthm cat_alt-bitn_alt-bits_alt
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat_alt (bitn_alt x j) m (bits_alt x k l) n)
+		    (bits_alt x j l))))
+
+(defthm cat_alt-bits_alt-bitn_alt
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat_alt (bits_alt x i j) m (bitn_alt x k) 1)
+		  (bits_alt x i k))))
+
+(defthm cat_alt-bitn_alt-bitn_alt
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat_alt (bitn_alt x i) 1 (bitn_alt x j) 1)
+		  (bits_alt x i j))))
+
+(defthmd bits_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits_alt (cat_alt x m y n) i j)
+		  (if (< i n)
+		      (bits_alt y i j)
+		    (if (>= j n)
+			(bits_alt x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat_alt (bits_alt x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits_alt y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits_alt-cat_alt-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits_alt (cat_alt x m y n) i j)
+		  (if (< i n)
+		      (bits_alt y i j)
+		    (if (>= j n)
+			(bits_alt x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat_alt (bits_alt x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits_alt y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn_alt (cat_alt x m y n) i)
+		  (if (< i n)
+		      (bitn_alt y i)
+		    (if (< i (+ m n))
+		      (bitn_alt x (- i n))
+		    0)))))
+
+(defthm bitn_alt-cat_alt-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn_alt (cat_alt x m y n) i)
+		  (if (< i n)
+		      (bitn_alt y i)
+		    (if (< i (+ m n))
+		      (bitn_alt x (- i n))
+		    0)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat_alt, which can't
+; be changed because of the guard of bits_alt.
+(defund mulcat_alt (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat_alt (mulcat_alt l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits_alt x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat_alt (mulcat_alt l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat_alt-nonnegative-integer-type
+  (and (integerp (mulcat_alt l n x))
+       (<= 0 (mulcat_alt l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat_alt)))
+
+(defthmd mulcat_alt-bits_alt
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat_alt l n (bits_alt x (1- l) 0))
+		    (mulcat_alt l n x))))
+
+(defthm mulcat_alt-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat_alt l n x) p)))
+
+(defthm mulcat_alt-1
+    (implies (natp l)
+	     (equal (mulcat_alt l 1 x) 
+		    (bits_alt x (1- l) 0))))
+
+(defthm mulcat_alt-0
+  (equal (mulcat_alt l n 0) 0))
+
+(defthm mulcat_alt-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat_alt 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn_alt-mulcat_alt-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn_alt (mulcat_alt 1 n x) m)
+		  x)))
+
+;;;;;
+;;;;;
+
+(defthmd bits_alt-bits_alt-times
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i))
+	     (equal (bits_alt (* (bits_alt x i 0) y) i 0)
+                    (bits_alt (* x y) i 0))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/bits-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/bits-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/bits-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/bits-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1415 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib2/basic") ;; no change from rel8 
+
+(local (include-book "bits-new"))
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+(encapsulate () 
+
+             (local (include-book "../../arithmetic/top"))
+  (local (encapsulate ()
+
+
+
+                      (defthmd bits-mbe-lemma-subgoal-2
+                        (IMPLIES (AND (INTEGERP J)
+                                      (INTEGERP I)
+                                      (INTEGERP X)
+                                      (< I J))
+                                 (EQUAL (FL (* (/ (EXPT 2 J))
+                                               (MOD X (EXPT 2 (+ 1 I)))))
+                                        0)))
+
+                      (encapsulate () 
+
+                                   (local (encapsulate () 
+
+                                                       (encapsulate ()
+                                                                    (local (include-book "log-new"))
+                                                                    (defthm bitn_alt-logand
+                                                                      (implies (and (integerp x) ; (>= x 0)
+                                                                                    (integerp y) ; (>= y 0)
+                                                                                    (integerp n) ;
+                                                                                    )
+                                                                               (equal (bitn_alt (logand x y) n)
+                                                                                      (logand (bitn_alt x n) (bitn_alt y n)))))
+
+
+                                                                    )
+   
+
+                                                       (encapsulate ()
+                                                                    (local (include-book "log-new"))
+
+                                                                    (defthmd logand-1-x_alt
+                                                                      (implies (bvecp x 1)
+                                                                               (equal (logand 1 x) x)))
+
+                                                                    )
+   
+
+
+
+                                                       (encapsulate () 
+                                                                    (local (include-book "../support/logand"))
+
+                                                                    (defthm logand-bnd
+                                                                      (implies (<= 0 x)
+                                                                               (<= (logand x y) x))
+                                                                      :rule-classes :linear
+                                                                      )
+
+
+                                                                    (defthm logand-commutative
+                                                                      (equal (logand j i)
+                                                                             (logand i j)))
+             
+                                                                    ;;
+
+
+                                                                    (defthm logand-non-negative
+                                                                      (implies (or (<= 0 x)
+                                                                                   (<= 0 y)
+                                                                                   )
+                                                                               (<= 0 (logand x y))))
+
+
+                                                                    (DEFTHM LOGAND-NON-NEGATIVE-INTEGER-TYPE-PRESCRIPTION
+                                                                      (IMPLIES (OR (<= 0 I) (<= 0 J))
+                                                                               (AND (<= 0 (LOGAND I J))
+                                                                                    (INTEGERP (LOGAND I J))))
+                                                                      :RULE-CLASSES (:TYPE-PRESCRIPTION))
+
+                                                                    )
+
+
+
+
+
+
+
+                                                       (defund bvequal (v1 v2 n)
+                                                         (equal (sumbits_alt v1 n)
+                                                                (sumbits_alt v2 n)))
+                                 
+                                 
+                                                       (defthm bvequal-then-equal
+                                                         (implies (and (bvequal x y n)
+                                                                       (bvecp x n)
+                                                                       (bvecp y n)
+                                                                       (natp n))
+                                                                  (equal x y))
+                                                         :hints (("Goal" :use ((:instance sumbits_alt-thm
+                                                                                          (x x))
+                                                                               (:instance sumbits_alt-thm
+                                                                                          (x y)))
+                                                                  :in-theory (enable bvequal)))
+                                                         :rule-classes nil)
+
+                                 
+
+                                                       (encapsulate ()
+                                                                    (local (include-book "bits-new"))
+                                                                    (defthmd bitn_alt-mod
+                                                                      (implies (and (< k n)
+                                                                                    (integerp n)
+                                                                                    (integerp k))
+                                                                               (equal (bitn_alt (mod x (expt 2 n)) k)
+                                                                                      (bitn_alt x k)))))
+
+
+
+                                                       (defthmd logand-ones-g-lemma-lemma
+                                                         (implies (and (<= 0 k)
+                                                                       (<= k (+ -1 n))
+                                                                       (integerp n)
+                                                                       (> n 0)
+                                                                       (integerp k))
+                                                                  (equal (bitn_alt (+ -1 (expt 2 n)) k) 1))
+                                                         :hints (("Goal" :in-theory (e/d (bitn_alt bits_alt
+                                                                                                   expt-2-reduce-leading-constant)
+                                                                                         (bits_alt-n-n-rewrite)))))
+
+
+                                                       (defthmd logand-ones-g-lemma-1
+                                                         (implies (and (<= 0 k)
+                                                                       (<= k (+ -1 n))
+                                                                       (< 0 n)
+                                                                       (integerp n)
+                                                                       (integerp x)
+                                                                       (integerp k))
+                                                                  (equal (bitn_alt (logand x (+ -1 (expt 2 n))) k)
+                                                                         (bitn_alt (mod x (expt 2 n)) k)))
+                                                         :hints (("Goal" :in-theory (e/d (bitn_alt-logand
+                                                                                          bitn_alt-mod
+                                                                                          logand-1-x_alt
+                                                                                          logand-ones-g-lemma-lemma)
+                                                                                         ()))))
+
+
+                                                       (defthm logand-ones-bvequal
+                                                         (implies (and (<= 0 k)
+                                                                       (<= k n)
+                                                                       (< 0 n)
+                                                                       (integerp n)
+                                                                       (integerp x)
+                                                                       (integerp k))
+                                                                  (bvequal (logand x (+ -1 (expt 2 n)))
+                                                                           (mod x (expt 2 n))
+                                                                           k))
+                                                         :hints (("Goal" :in-theory (e/d
+                                                                                     (logand-ones-g-lemma-1
+                                                                                      bvequal) ()))))
+
+
+
+                                                       (defthm logand-ones-g-lemma-2
+                                                         (implies (and (integerp x)
+                                                                       (natp n))
+                                                                  (bvecp (logand x (+ -1 (expt 2 n))) n))
+                                                         :hints (("Goal" 
+                                                                  :cases ((equal (logand x (+ -1 (expt 2 n)))
+                                                                                 (logand (+ -1 (expt 2 n)) x))))
+                                                                 ("Subgoal 1" 
+                                                                  :in-theory (e/d (bvecp) 
+                                                                                  (logand-bnd
+                                                                                   logand-commutative
+                                                                                   logand-non-negative))
+                                                                  :use ((:instance logand-bnd
+                                                                                   (x (+ -1 (expt 2 n)))
+                                                                                   (y x))
+                                                                        (:instance logand-non-negative
+                                                                                   (x x)
+                                                                                   (y (+ -1 (expt 2 n))))))))
+
+
+
+                                                       (defthm logand-ones-g-lemma-3
+                                                         (implies (integerp x)
+                                                                  (bvecp (mod x (expt 2 n)) n))
+                                                         :hints (("Goal" :in-theory (enable bvecp))))
+                                                       ))
+
+                                   (defthmd logand-ones-g
+                                     (implies (and (integerp i)
+                                                   (case-split (integerp i))
+                                                   )
+                                              (equal (logand i (1- (expt 2 n)))
+                                                     (mod i (expt 2 n))))
+                                     :hints (("Goal" :in-theory (e/d (logand-ones-bvequal) ())
+                                              :cases ((not (and (integerp n)
+                                                                (> n 0)))))
+                                             ("Subgoal 2"  :use ((:instance bvequal-then-equal
+                                                                            (x (logand i (+ -1 (expt 2 n))))
+                                                                            (y (mod i (expt 2 n)))
+                                                                            (n n))))
+                                             ("Subgoal 1.1" :in-theory (enable binary-logand))))
+                            
+
+                                   )
+
+
+                      (local 
+                       (defthmd bits-mbe-lemma-subgoal-1-lemma-1
+                         (IMPLIES (AND (INTEGERP J)
+                                       (INTEGERP I)
+                                       (INTEGERP X)
+                                       (<= J I))
+                                  (EQUAL (FL (* (/ (EXPT 2 J))
+                                                (MOD X (EXPT 2 (+ 1 I)))))
+                                         (mod (FL (* X (EXPT 2 (* -1 J))))
+                                              (EXPT 2 (+ 1 I (* -1 J))))))
+                         :hints (("Goal" :in-theory (e/d (mod
+                                                          acl2::expt-minus) 
+                                                         ())))))
+
+
+
+
+                      (local 
+                       (defthmd bits-mbe-lemma-subgoal-1-lemma-2
+                         (IMPLIES (AND (INTEGERP J)
+                                       (INTEGERP I)
+                                       (INTEGERP X)
+                                       (<= J I))
+                                  (EQUAL (LOGAND (FL (* X (EXPT 2 (* -1 J))))
+                                                 (+ -1 (EXPT 2 (+ 1 I (* -1 J)))))
+                                         (mod (FL (* X (EXPT 2 (* -1 J))))
+                                              (EXPT 2 (+ 1 I (* -1 J))))))
+                         :hints (("Goal" :in-theory (e/d (mod acl2::expt-minus
+                                                              logand-ones-g)
+                                                         ())))))
+
+
+
+                      (defthmd bits-mbe-lemma-subgoal-1
+                        (IMPLIES (AND (INTEGERP J)
+                                      (INTEGERP I)
+                                      (INTEGERP X)
+                                       (<= J I))
+                                 (EQUAL (FL (* (/ (EXPT 2 J))
+                                               (MOD X (EXPT 2 (+ 1 I)))))
+                                        (LOGAND (FL (* X (EXPT 2 (* -1 J))))
+                                                (+ -1 (EXPT 2 (+ 1 I (* -1 J)))))))
+                        :hints (("Goal" :in-theory (e/d (bits-mbe-lemma-subgoal-1-lemma-2
+                                                         bits-mbe-lemma-subgoal-1-lemma-1
+                                                         ) ()))))
+
+
+
+                      ))
+
+  (defund bits (x i j)
+    (declare (xargs :guard (and (integerp x)
+                                (integerp i)
+                                (integerp j))
+                    :guard-hints (("Goal" :in-theory (e/d
+                                                      (bits-mbe-lemma-subgoal-1
+                                                       ash
+                                                       bits-mbe-lemma-subgoal-2) ())))))
+    (mbe :logic (if (or (not (integerp i))
+                        (not (integerp j)))
+                    0
+                  (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+         :exec  (if (< i j)
+                    0
+                  (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+  
+  )
+
+
+(local 
+ (defthm bits_alt-is-bits
+   (equal (bits_alt x i j)
+          (bits x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+
+
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :use ((:instance bits_alt-nonnegative-integerp-type)))))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k))
+    :hints (("Goal" :use ((:instance bits_alt-bvecp)))))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k))
+  :hints (("Goal" :use ((:instance bits_alt-bvecp-simple)))))
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-bits_alt-equal)))))
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j)))
+  :hints (("Goal" :use ((:instance mod-bits_alt-equal-cor)))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i)))))
+  :hints (("Goal" :use ((:instance bits_alt-mod)))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0)))
+  :hints (("Goal" :use ((:instance bits_alt-bits_alt-sum)))))
+
+
+(defthmd bits-bits-times
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i))
+	     (equal (bits (* (bits x i 0) y) i 0)
+                    (bits (* x y) i 0)))
+  :hints (("Goal" :use ((:instance bits_alt-bits_alt-times)))))
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i)))))))
+  :hints (("Goal" :use ((:instance bits_alt-mod-2)))))
+
+(defthm bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0))
+  :hints (("Goal" :use ((:instance bits_alt-neg)))))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0))
+  :hints (("Goal" :use ((:instance bits_alt-with-indices-in-the-wrong-order)))))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0))
+  :hints (("Goal" :use ((:instance bvecp-bits_alt-0)))))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0)
+  :hints (("Goal" :use ((:instance bits_alt-0)))))
+
+(defthmd neg-bits-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j))))))
+  :hints (("Goal" :use ((:instance neg-bits_alt-1)))))
+
+(defthmd bits-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j))))))
+  :hints (("Goal" :use ((:instance bits_alt-minus-1)))))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x))
+  :hints (("Goal" :use ((:instance bits_alt-tail)))))
+
+(defthm bits-tail-2
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i))))))
+  :hints (("Goal" :use ((:instance bits_alt-tail-2)))))
+
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y))))
+  :hints (("Goal" :use ((:instance bits_alt-drop-from-minus)))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k))))
+  :hints (("Goal" :use ((:instance bits_alt-shift-down-1)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0)))
+  :hints (("Goal" :use ((:instance bits_alt-shift-down-2)))))
+
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-shift-up-1)))))
+
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-shift-up-2)))))
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k))))
+  :hints (("Goal" :use ((:instance bits_alt-plus-mult-1)))))
+
+(defthm bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m)))
+  :hints (("Goal" :use ((:instance bits_alt-plus-mult-2)))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m)))
+  :hints (("Goal" :use ((:instance bits_alt-plus-mult-2-rewrite)))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-plus-bits_alt)))))
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j)))))
+  :hints (("Goal" :use ((:instance bits_alt-bits_alt)))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+;;See also bits-dont-match.
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t))
+  :hints (("Goal" :use ((:instance bits_alt-match)))))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+;;See also bits-match.
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil))
+  :hints (("Goal" :use ((:instance bits_alt-dont-match)))))
+
+;;
+;; Thu Feb  5 10:09:26 2009: from lib2/bits.lisp
+;; 
+
+(defun bitvec (x n)
+   (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(encapsulate ()
+
+ (local (include-book "../../arithmetic/top"))
+
+  
+ (local (encapsulate () 
+                     (local 
+                      (defthmd evenp-sum
+                        (implies (and (evenp x)
+                                      (evenp y))
+                                 (evenp (- x y)))
+                        :hints (("Goal" :in-theory (e/d (evenp) ())))))
+
+                     (local 
+                      (defthmd evenp-2-factor
+                        (implies (integerp x)
+                                 (evenp (* 2 x)))
+                        :hints (("Goal" :in-theory (e/d (evenp) ())))))
+
+                     (local 
+                      (defthmd bitn-mbe-subgoal-2-lemma
+                        (IMPLIES (AND (INTEGERP N)
+                                      (INTEGERP X)
+                                      (evenp (FL (* X (EXPT 2 (* -1 N))))))
+                                 (evenp (BITN_alt X N)))
+                        :hints (("Goal" :in-theory (e/d (bitn_alt expt-minus
+                                                                  evenp-2-factor)
+                                                        (bits_alt-n-n-rewrite
+                                                         bits_alt-is-bits))
+                                 :use ((:instance bits_alt-mod-2
+                                                  (x x)
+                                                  (i (+ 1 n))
+                                                  (j n))
+                                       (:instance evenp-sum
+                                                  (x (fl (* x (/ (expt 2 n)))))
+                                                  (y (* 2 (fl (* x (/ (expt 2 (+ 1 n)))))))))))))
+
+  
+                     (defthmd bitn-mbe-subgoal-2
+                       (IMPLIES (AND (INTEGERP N)
+                                     (INTEGERP X)
+                                     (evenp (FL (* X (EXPT 2 (* -1 N))))))
+                                (EQUAL (BITN_alt X N) 0))
+                       :hints (("Goal" :use ((:instance bitn_alt-0-1
+                                                        (x x)
+                                                        (n n))
+                                             (:instance bitn-mbe-subgoal-2-lemma))
+                                :in-theory (e/d (evenp) ()))))
+
+                     ))
+
+ (local (encapsulate () 
+                     (local 
+                      (defthmd not-evenp-sum
+                        (implies (and (not (evenp x))
+                                      (evenp y))
+                                 (not (evenp (- x y))))
+                        :hints (("Goal" :in-theory (e/d (evenp) ())))))
+
+                     (local 
+                      (defthmd evenp-2-factor
+                        (implies (integerp x)
+                                 (evenp (* 2 x)))
+                        :hints (("Goal" :in-theory (e/d (evenp) ())))))
+
+
+                     (local 
+                      (defthmd bitn-mbe-subgoal-1-lemma
+                        (IMPLIES (AND (INTEGERP N)
+                                      (INTEGERP X)
+                                      (not (evenp (FL (* X (EXPT 2 (* -1 N)))))))
+                                 (not (evenp (BITN_alt X N))))
+                        :hints (("Goal" :in-theory (e/d (bitn_alt expt-minus
+                                                                  evenp-2-factor)
+                                                        (bits_alt-n-n-rewrite
+                                                         bits_alt-is-bits))
+                                 :use ((:instance bits_alt-mod-2
+                                                  (x x)
+                                                  (i (+ 1 n))
+                                                  (j n))
+                                       (:instance not-evenp-sum
+                                                  (x (fl (* x (/ (expt 2 n)))))
+                                                  (y (* 2 (fl (* x (/ (expt 2 (+ 1 n)))))))))))))
+
+
+
+
+                     (defthmd bitn-mbe-subgoal-1
+                       (IMPLIES (AND (INTEGERP N)
+                                     (INTEGERP X)
+                                     (NOT (evenp (FL (* X (EXPT 2 (* -1 N)))))))
+                                (EQUAL (BITN_alt X N) 1))
+                       :hints (("Goal" :use ((:instance bitn_alt-0-1
+                                                        (x x)
+                                                        (n n))
+                                             (:instance bitn-mbe-subgoal-1-lemma))
+                                :in-theory (e/d (evenp) ()))))
+                     ))
+
+
+
+ (defund bitn (x n)
+   (declare (xargs :guard (and (integerp x)
+                               (integerp n))
+                   :guard-hints (("Goal" :in-theory (e/d (bitn-mbe-subgoal-1
+                                                          bitn-mbe-subgoal-2
+                                                          ash
+                                                          ) (bits_alt-is-bits))
+                                  :use ((:instance bits_alt-is-bits
+                                                   (x x) (i n) (j n)))))))
+   (mbe :logic (bits x n n)
+        :exec  (if (evenp (ash x (- n))) 0 1)))
+
+ )
+
+
+(local 
+ (defthm bitn_alt-is-bitn
+   (equal (bitn_alt x n)
+          (bitn x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :use ((:instance bitn_alt-nonnegative-integer)))))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n))
+  :hints (("Goal" :use ((:instance bits_alt-n-n-rewrite)))))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2)))
+  :hints (("Goal" :use ((:instance bitn_alt-def)))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2)))
+  :hints (("Goal" :use ((:instance bitn_alt-rec-0)))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t))))
+  :hints (("Goal" :use ((:instance bitn_alt-rec-pos)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bitn_alt-0-1)))))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k))
+  :hints (("Goal" :use ((:instance bitn_alt-bvecp)))))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n))))
+  :hints (("Goal" :use ((:instance bitn_alt-bvecp-forward)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0))
+  :hints (("Goal" :use ((:instance bitn_alt-neg)))))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0)
+  :hints (("Goal" :use ((:instance bitn_alt-0)))))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x))
+  :hints (("Goal" :use ((:instance bitn_alt-bvecp-1)))))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n))
+  :hints (("Goal" :use ((:instance bitn_alt-bitn_alt-0)))))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k)))
+  :hints (("Goal" :use ((:instance bitn_alt-mod)))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0))
+  :hints (("Goal" :use ((:instance bvecp-bitn_alt-0)))))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1))
+  :hints (("Goal" :use ((:instance neg-bitn_alt-1)))))
+
+(defthmd bitn-shift
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n)))
+  :hints (("Goal" :use ((:instance bitn_alt-shift)))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k))))
+  :hints (("Goal" :use ((:instance bitn_alt-shift-down)))))
+
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k))))
+  :hints (("Goal" :use ((:instance bitn_alt-bits_alt)))))
+
+(defthmd bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m))))
+  :hints (("Goal" :use ((:instance bitn_alt-plus-bits_alt)))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-plus-bitn_alt)))))
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+
+(local 
+ (defthm sumbits_alt-is-sumbits
+   (equal (sumbits_alt x n)
+          (sumbits x n))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0)))
+  :hints (("Goal" :use ((:instance sumbits_alt-bits_alt)))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x))
+  :hints (("Goal" :use ((:instance sumbits_alt-thm)))))
+
+; The lemmas sumbits-badguy-is-correct and sumbits-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(local 
+ (defthm sumbits-badguy-is-sumbits_alt-badguys
+   (equal (sumbits_alt-badguy x y k)
+          (sumbits-badguy x y k))))
+
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t))
+  :hints (("Goal" :use ((:instance sumbits_alt-badguy-is-correct)))))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k))))
+  :hints (("Goal" :use ((:instance sumbits_alt-badguy-bounds)))))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b)))
+  :hints (("Goal" :use ((:instance sum-bitn_alt)))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1))
+  :hints (("Goal" :use ((:instance bvecp-bitn_alt-1)))))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :use ((:instance bvecp-bitn_alt-2)))))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0))
+  :hints (("Goal" :use ((:instance neg-bitn_alt-0)))))
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0))
+  :hints (("Goal" :use ((:instance neg-bitn_alt-2)))))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1))
+  :hints (("Goal" :use ((:instance bitn_alt-expt)))))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0))
+  :hints (("Goal" :use ((:instance bitn_alt-expt-0)))))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bitn_alt-plus-expt-1)))))
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n)))
+  :hints (("Goal" :use ((:instance bitn_alt-plus-mult)))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n)))
+  :hints (("Goal" :use ((:instance bitn_alt-plus-mult-rewrite)))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(local 
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat_alt x m y n)
+          (binary-cat x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat binary-cat_alt))))))
+
+
+;;Definition of the macro, cat:
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :use ((:instance cat_alt-nonnegative-integer-type)))))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k))
+  :hints (("Goal" :use ((:instance cat_alt-bvecp)))))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0))
+  :hints (("Goal" :use ((:instance cat_alt-with-n-0)))))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0))
+  :hints (("Goal" :use ((:instance cat_alt-with-m-0)))))
+
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y))
+  :hints (("Goal" :use ((:instance cat_alt-0)))))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n))
+  :hints (("Goal" :use ((:instance cat_alt-bits_alt-1)))))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n))
+  :hints (("Goal" :use ((:instance cat_alt-bits_alt-2)))))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q))))
+  :hints (("Goal" :use ((:instance cat_alt-associative)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n)))))
+  :hints (("Goal" :use ((:instance cat_alt-equal-constant)))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2))))
+  :hints (("Goal" :use ((:instance cat_alt-equal-rewrite)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l)))
+  :hints (("Goal" :use ((:instance cat_alt-bits_alt-bits_alt)))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l)))
+  :hints (("Goal" :use ((:instance cat_alt-bitn_alt-bits_alt)))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k)))
+  :hints (("Goal" :use ((:instance cat_alt-bits_alt-bitn_alt)))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j)))
+  :hints (("Goal" :use ((:instance cat_alt-bitn_alt-bitn_alt)))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j))))))
+  :hints (("Goal" :use ((:instance bits_alt-cat_alt)))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j))))))
+  :hints (("Goal" :use ((:instance bits_alt-cat_alt-constants)))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0))))
+  :hints (("Goal" :use ((:instance bitn_alt-cat_alt)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0))))
+  :hints (("Goal" :use ((:instance bitn_alt-cat_alt-constants)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+(local (include-book "../../arithmetic/top"))
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(local 
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat_alt l n x)
+          (mulcat l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :use ((:instance mulcat_alt-nonnegative-integer-type)))))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x)))
+  :hints (("Goal" :use ((:instance mulcat_alt-bits_alt)))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p))
+  :hints (("Goal" :use ((:instance mulcat_alt-bvecp)))))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0)))
+  :hints (("Goal" :use ((:instance mulcat_alt-1)))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0)
+  :hints (("Goal" :use ((:instance mulcat_alt-0)))))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n))))
+  :hints (("Goal" :use ((:instance mulcat_alt-n-1)))))
+
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x))
+  :hints (("Goal" :use ((:instance bitn_alt-mulcat_alt-1)))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/bits.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/bits.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/bits.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,917 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../lib2/basic")
+
+(local (include-book "bits-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0))))
+
+(defthmd bits-bits-times
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i))
+	     (equal (bits (* (bits x i 0) y) i 0)
+                    (bits (* x y) i 0))))
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i))))))))
+
+(defthm bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+
+(defthmd neg-bits-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j))))))
+  :hints (("Goal" :use ((:instance neg-bits_alt-1)))))
+
+
+
+(defthmd bits-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j))))))
+  :hints (("Goal" :use ((:instance bits_alt-minus-1)))))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-tail-2
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :rule-classes ())
+
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ())
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthm bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+;;See also bits-dont-match.
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+;;See also bits-match.
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1)))
+
+
+(defthmd bitn-shift
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthmd bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m)))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+; The lemmas sumbits-badguy-is-correct and sumbits-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t)))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0)))
+
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0)))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;;Definition of the macro, cat:
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/bvecp-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/bvecp-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/bvecp-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/bvecp-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,61 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "rtl")
+(include-book "rtlarr")
+(local (include-book "bvecp-raw-helpers"))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (integerp (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/bvecp-raw-helpers-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/bvecp-raw-helpers-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/bvecp-raw-helpers-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/bvecp-raw-helpers-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,839 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;; (set-enforce-redundancy t)
+
+;Contains bvecp lemmas about the RTL primitives.
+;Also contains type lemmas (non-negative integer, natp, etc.)
+
+(include-book "rtl")
+(include-book "rtlarr")
+
+(include-book "bits")
+(include-book "float")
+
+(local (include-book "logn"))
+
+(local (include-book "../../arithmetic/top"))
+
+(set-match-free-default :all)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;; bits
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+   (implies (and (<= (+ 1 i (- j)) k)
+                 (case-split (integerp k))
+                 )
+            (bvecp (bits x i j) k)))
+
+
+;; setbits
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k))
+  :hints (("Goal" :use ((:instance bvecp-monotone
+                                   (x (setbits x w i j y))
+                                   (m k)
+                                   (n w)))
+           :cases ((not (natp w))))
+          ("Subgoal 1" :in-theory (e/d (bvecp cat) ()))))
+
+
+
+
+
+;; setbitn
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k))
+  :hints (("Goal" :use ((:instance bvecp-monotone
+                                   (x (setbitn x w n y))
+                                   (m k)
+                                   (n w)))
+           :cases ((not (natp w))))
+          ("Subgoal 1" :in-theory (e/d (bvecp cat) ()))))
+
+
+;; log<
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+
+;; log<=
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+
+
+;; log>
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+
+
+;; log>=
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+
+
+;; log=
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+
+
+;; log<>
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+
+
+;; logand1
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+
+
+;; logior1
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+
+
+;; logxor1
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+
+
+;; lnot
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n)))
+  :hints (("Goal" :in-theory (e/d (lnot) ()))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k))
+  :hints (("Goal" :in-theory (e/d (bvecp lnot) ())
+           :cases ((not (and (integerp n)
+                             (bvecp (bits x (+ -1 n) 0) n)))))))
+
+
+;; bitn
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes ( :type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+;; shft
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (e/d (shft) ()))))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k)))
+
+;; cat
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+
+;; logand
+(local (include-book "../support/logand"))
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n)))
+
+
+;; logior
+(local (include-book "../support/logior"))
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+
+;; mulcat
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n)))
+|#
+
+;; encode
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(local (include-book "../support/encode"))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k)))
+           (bvecp (encode x n) k)))
+
+
+;; decode
+
+(local (include-book "../support/decode"))
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+
+;BOZO dup?
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :use (:instance
+                        ag-maps-bv-arr-to-bvecp (a index) (r obj) (k size))
+           :in-theory (set-difference-theories
+                       (enable bvecp)
+                       '(ag-maps-bv-arr-to-bvecp))))
+  )
+
+
+; land
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+;; lior
+
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+;; lxor
+
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+;; cat
+
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n))
+  :hints (("Goal" :use ((:instance cat-nonnegative-integer-type)))))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x)))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x)))
+  :hints (("Goal" :in-theory (enable expt-2-reduce-leading-constant
+                                     bits))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x))))
+  :hints (("Goal" :in-theory (enable expt-2-reduce-leading-constant
+                                     bits))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil)))
+  :hints (("Goal" :in-theory (e/d (bvecp) ()))))
+
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
+
+;remove these?
+
+
+;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
+;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
+;;;;;;;;;;;;;;;;;;; statements have no default.
+
+;maybe leave this one?
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t)))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t)))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t)))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t)))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t)))
+|#
+
+#|
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+|#
+
+#|
+;drop?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j))
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/bvecp-raw-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/bvecp-raw-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/bvecp-raw-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/bvecp-raw-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,801 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;Contains bvecp lemmas about the RTL primitives.
+;Also contains type lemmas (non-negative integer, natp, etc.)
+
+(include-book "rtl")
+(include-book "rtlarr")
+
+(include-book "bits")
+(include-book "float")
+
+(local (include-book "bvecp-raw-helpers-proofs"))
+
+(set-inhibit-warnings "theory") 
+(local (in-theory nil))
+
+(set-match-free-default :all)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;; bits
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+   (implies (and (<= (+ 1 i (- j)) k)
+                 (case-split (integerp k))
+                 )
+            (bvecp (bits x i j) k)))
+
+
+;; setbits
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k)))
+
+
+;; setbitn
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k)))
+
+
+
+;; log<
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+
+;; log<=
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+
+
+;; log>
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+
+
+;; log>=
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+
+
+;; log=
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+
+
+;; log<>
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+
+
+;; logand1
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+
+
+;; logior1
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+
+
+;; logxor1
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+
+
+;; lnot
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+;; bitn
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes ( :type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+;; shft
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k)))
+
+;; cat
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+
+;; logand
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n)))
+
+
+;; logior
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+
+;; mulcat
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n)))
+|#
+
+;; encode
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k)))
+           (bvecp (encode x n) k)))
+
+
+;; decode
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+;BOZO dup?
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+
+; land
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+;; lior
+
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+;; lxor
+
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+;; cat
+
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x)))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x)))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
+
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
+
+;remove these?
+
+
+;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
+;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
+;;;;;;;;;;;;;;;;;;; statements have no default.
+
+;maybe leave this one?
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t)))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t)))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t)))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t)))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t)))
+|#
+
+#|
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+|#
+
+#|
+;drop?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j))
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/float-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/float-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/float-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/float-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,975 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "log-new")
+
+(local (include-book "../lib2/top"))
+
+(local 
+ (encapsulate () 
+              (local (include-book "bits-new-proofs"))
+
+             (defthmd bits_alt-is-bits
+               (equal (bits_alt x i j)
+                      (bits x i j)))
+
+             
+             (defthmd bitn_alt-is-bitn
+               (equal (bitn_alt x n)
+                      (bitn x n)))
+
+             ))
+               
+
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+
+;;;
+;;; the only different part.  Fri Feb 13 12:24:43 2009
+;;;
+
+
+(defthm exact-bits_alt-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits) ())
+           :use ((:instance exact-bits-1)))))
+
+
+
+
+
+(defthm exact-bits_alt-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits_alt x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits) ())
+           :use ((:instance exact-bits-2)))))
+
+
+(defthm exact-bits_alt-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits_alt x (1- k) 0)
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits) ())
+           :use ((:instance exact-bits-3)))))
+
+
+(defthm exact-k+1_alt
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn_alt x k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance exact-k+1)))))
+
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
+
+;;;***************************************************************
+;;;                 Floating-Point formats
+;;;***************************************************************
+
+
+(defund esgnf_alt  (x p q) (bitn_alt x (+ p q)))
+(defund eexpof_alt (x p q) (bits_alt x (1- (+ p q)) p)) 
+(defund esigf_alt  (x p)   (bits_alt x (1- p) 0))
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+(local (in-theory (e/d (bits_alt-is-bits
+                        bitn_alt-is-bitn) ())))
+
+(local 
+ (defthm esgnf_alt-is-esgnf
+   (equal (esgnf_alt x p q) (esgnf x p q))
+   :hints (("Goal" :in-theory (e/d (esgnf_alt esgnf) ())))))
+
+
+(local 
+ (defthm eexpof_alt-is-eexpof
+   (equal (eexpof_alt x p q) (eexpof x p q))
+   :hints (("Goal" :in-theory (e/d (eexpof_alt eexpof) ())))))
+
+
+(local 
+ (defthm esigf_alt-is-esigf
+   (equal (esigf_alt x p) (esigf x p))
+   :hints (("Goal" :in-theory (e/d (esigf_alt esigf) ())))))
+
+
+
+(defund edecode_alt (x p q)
+  (* (if (= (esgnf_alt x p q) 0) 1 -1)
+     (esigf_alt x p)
+     (expt 2 (+ 1 (- p) (eexpof_alt x p q) (- (bias q))))))
+
+
+
+(local 
+ (defthm edecode_alt-is-edecode_alt
+   (equal (edecode_alt x p q) (edecode x p q))
+   :hints (("Goal" :in-theory (e/d (edecode_alt edecode) ())))))
+
+(defun isgnf_alt (x p q) (bitn_alt x (1- (+ p q))))
+(defun iexpof_alt (x p q) (bits_alt x (- (+ p q) 2) (1- p)))
+(defun isigf_alt (x p) (bits_alt x (- p 2) 0))
+
+
+
+(local 
+ (defthm isgnf_alt-is-isgnf
+   (equal (isgnf_alt x p q) (isgnf x p q))
+   :hints (("Goal" :in-theory (e/d (isgnf_alt isgnf) ())))))
+
+
+(local 
+ (defthm iexpof_alt-is-iexpof
+   (equal (iexpof_alt x p q) (iexpof x p q))
+   :hints (("Goal" :in-theory (e/d (iexpof_alt iexpof) ())))))
+
+
+(local 
+ (defthm isigf_alt-is-isigf
+   (equal (isigf_alt x p) (isigf x p))
+   :hints (("Goal" :in-theory (e/d (isigf_alt isigf) ())))))
+
+
+
+
+(defund nencodingp_alt (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof_alt x p q))
+       (< (iexpof_alt x p q) (- (expt 2 q) 1))))
+
+
+(local 
+ (defthm nencodingp_alt-is-nencodingp
+   (equal (nencodingp_alt x p q)
+          (nencodingp x p q))
+   :hints (("Goal" :in-theory (e/d (nencodingp_alt
+                                    nencodingp) ())))))
+
+
+(defund ndecode_alt (x p q)
+  (* (if (= (isgnf_alt x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof_alt x p q) (bias q)))
+        (* (isigf_alt x p)
+           (expt 2 (+ 1 (iexpof_alt x p q) (- (bias q)) (- p)))))))
+
+(local 
+ (defthm ndecode_alt-is-ndecode
+   (equal (ndecode_alt x p q)
+          (ndecode x p q))
+   :hints (("Goal" :in-theory (e/d (ndecode_alt
+                                    ndecode) ())))))
+
+
+(defthmd sgn-ndecode_alt
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode_alt x p q))
+		    (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :in-theory (enable sgn-ndecode))))
+
+
+(defthmd expo-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode_alt x p q))
+		    (- (iexpof_alt x p q) (bias q))))
+    :hints (("Goal" :in-theory (enable expo-ndecode))))
+
+
+(defthmd sig-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode_alt x p q))
+		    (+ 1 (/ (isigf_alt x p) (expt 2 (- p 1))))))
+    :hints (("Goal" :in-theory (enable sig-ndecode))))
+
+
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(local 
+ (defthm cat_alt-is-cat
+   (equal (binary-cat_alt x m y n)
+          (binary-cat x m y n))
+   :hints (("Goal" :in-theory (enable binary-cat_alt
+                                      binary-cat)))))
+                                      
+          
+
+
+(defund nencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(local 
+ (defthm nencode_alt-is-nencode
+   (equal (nencode_alt x p q)
+          (nencode x p q))
+   :hints (("Goal" :in-theory (e/d (nencode_alt nencode) ())))))
+
+
+
+(defthm bvecp-nencode_alt
+  (implies (and (equal k (+ p q))
+                (natp p)
+                (natp q))
+           (bvecp (nencode_alt x p q) k)))
+
+(defthmd nrepp-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode_alt x p q) p q))
+    :hints (("Goal" :in-theory (enable nrepp-ndecode))))
+
+
+(defthmd nencode_alt-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode_alt (ndecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :in-theory (enable nencode-ndecode))))
+
+
+(defthmd nencodingp_alt-nencode_alt
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp_alt (nencode_alt x p q) p q))
+    :hints (("Goal" :in-theory (enable nencodingp-nencode))))
+
+
+(defthmd ndecode_alt-nencode_alt
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode_alt (nencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :in-theory (enable ndecode-nencode))))
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+
+(defund dencodingp_alt (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof_alt x p q) 0)
+       (not (= (isigf_alt x p) 0))))
+
+
+(local 
+ (defthm dencodingp_alt-is-dencodingp
+   (equal (dencodingp_alt x p q)
+          (dencodingp x p q))
+   :hints (("Goal" :in-theory (e/d (dencodingp_alt 
+                                    dencodingp) ())))))
+
+
+(defund ddecode_alt (x p q)
+  (* (if (= (isgnf_alt x p q) 0) 1 -1)
+     (isigf_alt x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+
+(local 
+ (defthm ddecode_alt-is-decode
+   (equal (ddecode_alt x p q)
+          (ddecode x p q))
+   :hints (("Goal" :in-theory (e/d (ddecode_alt
+                                    ddecode) ())))))
+
+(defthmd sgn-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode_alt x p q))
+		    (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :in-theory (e/d (sgn-ddecode) ()))))
+
+
+(defthmd expo-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode_alt x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf_alt x p)))))
+    :hints (("Goal" :in-theory (e/d (expo-ddecode) ()))))
+
+
+(defthmd sig-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode_alt x p q))
+		    (sig (isigf_alt x p))))
+    :hints (("Goal" :in-theory (e/d (sig-ddecode) ()))))
+
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits_alt available in the sig field = p - 1 - ( - bias - expo(r))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+
+(defund dencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+(local 
+ (defthm dencode_alt-is-dencode
+   (equal (dencode_alt x p q)
+          (dencode x p q))
+   :hints (("Goal" :in-theory (e/d (dencode_alt dencode) ())))))
+
+
+(defthmd drepp-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode_alt x p q) p q))
+    :hints (("Goal" :in-theory (e/d (drepp-ddecode) ()))))
+
+
+(defthmd dencode_alt-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode_alt (ddecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :in-theory (e/d (dencode-ddecode) ()))))
+
+
+(defthmd dencodingp_alt-dencode_alt
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp_alt (dencode_alt x p q) p q))
+    :hints (("Goal" :in-theory (e/d (dencodingp-dencode) ()))))
+
+
+(defthmd ddecode_alt-dencode_alt
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode_alt (dencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :in-theory (e/d (ddecode-dencode) ()))))
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+
+;; (defthmd spd-mult
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;; 		(rationalp r)
+;; 		(= m (/ r (spd p q))))
+;; 	   (iff (drepp r p q)
+;; 		(and (natp m)
+;; 		     (<= 1 m)
+;; 		     (< m (expt 2 (1- p)))))))
+;; not true!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/float-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/float-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/float-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/float-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,867 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "log-new")
+
+(local (include-book "float-new-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+
+;;;
+;;; the only different part.  Fri Feb 13 12:24:43 2009
+;;;
+
+
+(defthm exact-bits_alt-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits) ())
+           :use ((:instance exact-bits-1)))))
+
+
+
+
+
+(defthm exact-bits_alt-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits_alt x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits) ())
+           :use ((:instance exact-bits-2)))))
+
+
+(defthm exact-bits_alt-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits_alt x (1- k) 0)
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits) ())
+           :use ((:instance exact-bits-3)))))
+
+
+(defthm exact-k+1_alt
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn_alt x k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn) ())
+           :use ((:instance exact-k+1)))))
+
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
+
+;;;***************************************************************
+;;;                 Floating-Point formats
+;;;***************************************************************
+
+
+(defund esgnf_alt  (x p q) (bitn_alt x (+ p q)))
+(defund eexpof_alt (x p q) (bits_alt x (1- (+ p q)) p)) 
+(defund esigf_alt  (x p)   (bits_alt x (1- p) 0))
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+
+(defund edecode_alt (x p q)
+  (* (if (= (esgnf_alt x p q) 0) 1 -1)
+     (esigf_alt x p)
+     (expt 2 (+ 1 (- p) (eexpof_alt x p q) (- (bias q))))))
+
+
+
+(defun isgnf_alt (x p q) (bitn_alt x (1- (+ p q))))
+(defun iexpof_alt (x p q) (bits_alt x (- (+ p q) 2) (1- p)))
+(defun isigf_alt (x p) (bits_alt x (- p 2) 0))
+
+
+
+
+(defund nencodingp_alt (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof_alt x p q))
+       (< (iexpof_alt x p q) (- (expt 2 q) 1))))
+
+
+
+(defund ndecode_alt (x p q)
+  (* (if (= (isgnf_alt x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof_alt x p q) (bias q)))
+        (* (isigf_alt x p)
+           (expt 2 (+ 1 (iexpof_alt x p q) (- (bias q)) (- p)))))))
+
+
+(defthmd sgn-ndecode_alt
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode_alt x p q))
+		    (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :in-theory (enable sgn-ndecode))))
+
+
+(defthmd expo-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode_alt x p q))
+		    (- (iexpof_alt x p q) (bias q))))
+    :hints (("Goal" :in-theory (enable expo-ndecode))))
+
+
+(defthmd sig-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode_alt x p q))
+		    (+ 1 (/ (isigf_alt x p) (expt 2 (- p 1))))))
+    :hints (("Goal" :in-theory (enable sig-ndecode))))
+
+
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+
+(defund nencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+
+
+(defthm bvecp-nencode_alt
+  (implies (and (equal k (+ p q))
+                (natp p)
+                (natp q))
+           (bvecp (nencode_alt x p q) k)))
+
+(defthmd nrepp-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode_alt x p q) p q))
+    :hints (("Goal" :in-theory (enable nrepp-ndecode))))
+
+
+(defthmd nencode_alt-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode_alt (ndecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :in-theory (enable nencode-ndecode))))
+
+
+(defthmd nencodingp_alt-nencode_alt
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp_alt (nencode_alt x p q) p q))
+    :hints (("Goal" :in-theory (enable nencodingp-nencode))))
+
+
+(defthmd ndecode_alt-nencode_alt
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode_alt (nencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :in-theory (enable ndecode-nencode))))
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+
+(defund dencodingp_alt (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof_alt x p q) 0)
+       (not (= (isigf_alt x p) 0))))
+
+
+(defund ddecode_alt (x p q)
+  (* (if (= (isgnf_alt x p q) 0) 1 -1)
+     (isigf_alt x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+
+(defthmd sgn-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode_alt x p q))
+		    (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :in-theory (e/d (sgn-ddecode) ()))))
+
+
+(defthmd expo-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode_alt x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf_alt x p)))))
+    :hints (("Goal" :in-theory (e/d (expo-ddecode) ()))))
+
+
+(defthmd sig-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode_alt x p q))
+		    (sig (isigf_alt x p))))
+    :hints (("Goal" :in-theory (e/d (sig-ddecode) ()))))
+
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits_alt available in the sig field = p - 1 - ( - bias - expo(r))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+(defund dencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+(defthmd drepp-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode_alt x p q) p q))
+    :hints (("Goal" :in-theory (e/d (drepp-ddecode) ()))))
+
+
+(defthmd dencode_alt-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode_alt (ddecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :in-theory (e/d (dencode-ddecode) ()))))
+
+
+(defthmd dencodingp_alt-dencode_alt
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp_alt (dencode_alt x p q) p q))
+    :hints (("Goal" :in-theory (e/d (dencodingp-dencode) ()))))
+
+
+(defthmd ddecode_alt-dencode_alt
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode_alt (dencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :in-theory (e/d (ddecode-dencode) ()))))
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+
+;; (defthmd spd-mult
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;; 		(rationalp r)
+;; 		(= m (/ r (spd p q))))
+;; 	   (iff (drepp r p q)
+;; 		(and (natp m)
+;; 		     (<= 1 m)
+;; 		     (< m (expt 2 (1- p)))))))
+;; not true!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/float-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/float-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/float-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/float-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,985 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "log")
+
+(local (include-book "float-new"))
+
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+          
+
+;;;;
+
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+
+
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-1)))
+
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-2)))
+
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-3)))
+
+
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use exact-k+1_alt)))
+
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
+
+;;;***************************************************************
+;;;                 Floating-Point formats
+;;;***************************************************************
+
+
+(defund esgnf  (x p q) (bitn x (+ p q)))
+
+(local 
+ (defthm esgnf-is-esgnf_alt
+   (equal (esgnf x p q)
+          (esgnf_alt x p q))
+   :hints (("Goal" :in-theory (e/d (esgnf esgnf_alt) ())))))
+
+
+(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
+
+
+(local 
+ (defthm eexpof-is-eexpof_alt
+   (equal (eexpof x p q)
+          (eexpof_alt x p q))
+   :hints (("Goal" :in-theory (e/d (eexpof eexpof_alt) ())))))
+
+
+
+(defund esigf  (x p)   (bits x (1- p) 0))
+
+
+(local 
+ (defthm esigf-is-esigf_alt
+   (equal (esigf x p)
+          (esigf_alt x p))
+   :hints (("Goal" :in-theory (e/d (esigf esigf_alt) ())))))
+
+
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+
+(local 
+ (defthm edecode-is-edecode_alt 
+   (equal (edecode x p q)
+          (edecode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (edecode 
+                                    edecode_alt) ())))))
+
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+
+(local 
+ (defthm isgnf-is-isgn_alt
+   (equal (isgnf x p q)
+          (isgnf_alt x p q))
+   :hints (("Goal" :in-theory (e/d (isgnf_alt isgnf) ())))))
+
+
+
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+
+
+(local 
+ (defthm iexpof-is-iexpo_alt
+   (equal (iexpof x p q)
+          (iexpof_alt x p q))
+   :hints (("Goal" :in-theory (e/d (iexpof_alt iexpof) ())))))
+
+
+
+(defun isigf (x p) (bits x (- p 2) 0))
+
+(local 
+ (defthm isigf-is-isigf_alt 
+   (equal (isigf x p)
+          (isigf_alt x p))
+   :hints (("Goal" :in-theory (e/d (isigf_alt isigf) ())))))
+
+
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+
+(local 
+ (defthm nencodingp-is-nencoding_alt 
+   (equal (nencodingp x p q)
+          (nencodingp_alt x p q))
+   :hints (("Goal" :in-theory (e/d (nencodingp_alt nencodingp) ())))))
+
+
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+
+(local 
+ (defthm ndecode-is-ndecode_alt 
+   (equal (ndecode x p q)
+          (ndecode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (ndecode_alt ndecode) ())))))
+
+(defthmd sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use sgn-ndecode_alt)))
+
+
+(defthmd expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q))))
+    :hints (("Goal" :use expo-ndecode_alt)))
+
+
+(defthmd sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1))))))
+    :hints (("Goal" :use sig-ndecode_alt)))
+
+
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(local 
+ (defthm nencode-is-nencode_alt 
+   (equal (nencode x p q)
+          (nencode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (nencode_alt nencode) ())))))
+
+
+(defthm bvecp-nencode
+  (implies (and (equal k (+ p q))
+                (natp p)
+                (natp q))
+           (bvecp (nencode x p q) k))
+   :hints (("Goal" :use bvecp-nencode_alt)))
+
+(defthmd nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q))
+   :hints (("Goal" :use nrepp-ndecode_alt)))
+    
+
+
+(defthmd nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x))
+   :hints (("Goal" :use nencode_alt-ndecode_alt)))
+
+
+(defthmd nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q))
+   :hints (("Goal" :use nencodingp_alt-nencode_alt)))
+
+
+(defthmd ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x))
+   :hints (("Goal" :use ndecode_alt-nencode_alt)))
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(local 
+ (defthm dencodingp-is-dencodingp_alt
+   (equal (dencodingp x p q)
+          (dencodingp_alt x p q))
+   :hints (("Goal" :in-theory (e/d (dencodingp 
+                                    dencodingp_alt) ())))))
+
+
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(local 
+ (defthm ddecode-is-ddecode_alt 
+   (equal (ddecode x p q)
+          (ddecode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (ddecode_alt
+                                    ddecode) ())))))
+
+
+
+(defthmd sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use sgn-ddecode_alt)))
+
+
+
+(defthmd expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))
+    :hints (("Goal" :use expo-ddecode_alt)))
+
+
+(defthmd sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p))))
+    :hints (("Goal" :use sig-ddecode_alt)))
+
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(r))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+(local 
+ (defthm dencode-is-dencode_alt 
+   (equal (dencode x p q)
+          (dencode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (dencode_alt dencode) ())))))
+
+
+(defthmd drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q))
+    :hints (("Goal" :use drepp-ddecode_alt)))
+
+
+(defthmd dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x))
+    :hints (("Goal" :use dencode_alt-ddecode_alt)))
+
+
+(defthmd dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q))
+    :hints (("Goal" :use dencodingp_alt-dencode_alt)))
+
+
+(defthmd ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x))
+    :hints (("Goal" :use ddecode_alt-dencode_alt)))
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+
+;; (defthmd spd-mult
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;; 		(rationalp r)
+;; 		(= m (/ r (spd p q))))
+;; 	   (iff (drepp r p q)
+;; 		(and (natp m)
+;; 		     (<= 1 m)
+;; 		     (< m (expt 2 (1- p)))))))
+;; not true!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/float.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/float.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/float.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,904 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "log")
+
+(local (include-book "float-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+
+
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-1)))
+
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-2)))
+
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-3)))
+
+
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use exact-k+1_alt)))
+
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
+
+;;;***************************************************************
+;;;                 Floating-Point formats
+;;;***************************************************************
+
+
+(defund esgnf  (x p q) (bitn x (+ p q)))
+
+
+
+
+(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
+
+
+
+
+
+
+(defund esigf  (x p)   (bits x (1- p) 0))
+
+
+
+
+
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+
+
+
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+
+
+
+
+
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+
+
+
+
+
+
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+
+
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+
+
+
+
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+
+
+
+(defthmd sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use sgn-ndecode_alt)))
+
+
+(defthmd expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q))))
+    :hints (("Goal" :use expo-ndecode_alt)))
+
+
+(defthmd sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1))))))
+    :hints (("Goal" :use sig-ndecode_alt)))
+
+
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+
+
+
+(defthm bvecp-nencode
+  (implies (and (equal k (+ p q))
+                (natp p)
+                (natp q))
+           (bvecp (nencode x p q) k))
+   :hints (("Goal" :use bvecp-nencode_alt)))
+
+(defthmd nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q))
+   :hints (("Goal" :use nrepp-ndecode_alt)))
+    
+
+
+(defthmd nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x))
+   :hints (("Goal" :use nencode_alt-ndecode_alt)))
+
+
+(defthmd nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q))
+   :hints (("Goal" :use nencodingp_alt-nencode_alt)))
+
+
+(defthmd ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x))
+   :hints (("Goal" :use ndecode_alt-nencode_alt)))
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+
+
+
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+
+
+
+(defthmd sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use sgn-ddecode_alt)))
+
+
+
+(defthmd expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))
+    :hints (("Goal" :use expo-ddecode_alt)))
+
+
+(defthmd sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p))))
+    :hints (("Goal" :use sig-ddecode_alt)))
+
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(r))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+
+(defthmd drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q))
+    :hints (("Goal" :use drepp-ddecode_alt)))
+
+
+(defthmd dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x))
+    :hints (("Goal" :use dencode_alt-ddecode_alt)))
+
+
+(defthmd dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q))
+    :hints (("Goal" :use dencodingp_alt-dencode_alt)))
+
+
+(defthmd ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x))
+    :hints (("Goal" :use ddecode_alt-dencode_alt)))
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+
+;; (defthmd spd-mult
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;; 		(rationalp r)
+;; 		(= m (/ r (spd p q))))
+;; 	   (iff (drepp r p q)
+;; 		(and (natp m)
+;; 		     (<= 1 m)
+;; 		     (< m (expt 2 (1- p)))))))
+;; not true!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1718 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "bits-new")
+(local (include-book "bits-new-proofs"))
+
+(local (include-book "../lib2/top"))
+(local (include-book "../../arithmetic/top"))
+(local (include-book "../support/logand"))
+(local (include-book "../support/logior"))
+(local (include-book "../support/logxor"))
+(local (include-book "../support/log"))
+
+
+;; (local (include-book "../support/merge"))
+
+;;;**********************************************************************
+;;;                       LOGNOT, LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+(in-theory (disable lognot logand logior logxor))
+
+
+
+;;;
+;;; we want prove some result about lognot is lnot(x, (1 + expo(x))) -
+;;; 2^(1+(expo(x))
+;;;
+
+;;; lognot(x) = if x >= 0 
+;;;                lnot(x, (1+expo(x))) - 2^(1+(expo(x)))) 
+;;;     
+;;;             abs(x)-1
+ 
+;;; 
+;;; logand(x, y) = land(x,y, 1+min(expo(x),expo(y)))
+;;; 
+;;; what about this? 
+
+(defthmd lognot-def
+    (implies (integerp x)
+	     (equal (lognot x)
+		    (1- (- x))))
+    :hints (("Goal" :in-theory (e/d (lognot) ()))))
+
+
+(defthmd logand-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logand i j)
+		    (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logand (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+
+(defthmd logior-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logior i j)
+		    (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+
+(defthmd logxor-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logxor i j)
+		    (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+
+;;;;;;
+;;;;;;
+
+
+(defthm logand-natp
+    (implies (and (natp i)
+		  (integerp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logand-natp-2
+    (implies (and (integerp i)
+		  (natp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+;; (defthm logand-natp
+;;     (implies (and (natp i)
+;; 		  (integerp j))
+;; 	     (natp (logand i j)))
+;;   :rule-classes (:type-prescription :rewrite))
+
+;; (defthm logand-natp-2
+;;     (implies (and (integerp i)
+;; 		  (natp j))
+;; 	     (natp (logand i j)))
+;;   :rule-classes (:type-prescription :rewrite))
+
+
+;;  from ../support/logand.lisp
+;;
+;; (defthm logand-bnd
+;;    (implies (<= 0 x)
+;;             (<= (logand x y) x))
+;;    :rule-classes :linear
+;;    )
+
+(defthm logand-bvecp-g
+  (implies (and (natp n)
+                (bvecp x n)
+                (integerp y))
+           (bvecp (logand x y) n))
+  :hints (("Goal" :use ((:instance logand-bnd))
+           :in-theory (e/d (bvecp) ()))))
+
+(defthm logior-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logior i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logior-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n))
+	     (bvecp (logior x y) n)))
+
+(defthm logxor-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logxor i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n))
+	     (bvecp (logxor x y) n)))
+
+
+
+(defun logop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (logop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+
+(defun logop-3-induct (x y z)
+  (declare (xargs :measure (:? x y z)))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(logop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+(defthm integerp-fl-1
+  (implies (and (integerp y)
+                (< y 0))
+           (<= y (fl (* 1/2 y))))
+  :rule-classes :linear)
+
+(defthm integerp-fl-2
+  (implies (and (integerp y)
+                (< y 0)
+                (not (equal y -1)))
+           (< y (fl (* 1/2 y))))
+  :rule-classes :linear)
+      
+
+
+;; (defun logop-3-induct (x y z)
+;;   (if (and (natp x) (natp y) (natp z))
+;;       (if (and (zp x) (zp y) (zp z))
+;; 	  t
+;; 	(logop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+;;     t))
+
+(defthmd logand-fl-2-rewrite
+    (implies (and (natp x)
+		  (natp y))
+	     (equal (fl (* 1/2 (logand x y)))
+		    (logand (fl (* 1/2 x)) (fl (* 1/2 y))))))
+
+(defthmd logior-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logior i j)))
+		    (logior (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthmd logxor-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logxor i j)))
+		    (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+;; we appear to have a better rule than logior
+;; 
+;; (DEFTHM LOGIOR-EQUAL-0
+;;   (IMPLIES (AND (CASE-SPLIT (INTEGERP I))
+;;                 (CASE-SPLIT (INTEGERP J)))
+;;            (EQUAL (EQUAL (LOGIOR I J) 0)
+;;                   (AND (EQUAL I 0) (EQUAL J 0)))))
+
+(defthm logior-not-0
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (logior x y) 0))
+	     (and (= x 0) (= y 0)))
+  :rule-classes ())
+
+;;;
+;;; these following two are genuninely new. 
+;;;
+
+(local 
+ (encapsulate () 
+  
+              (defthmd bvecp-fl-1/2
+                (implies (bvecp y (+ 1 n))
+                         (bvecp (fl (* 1/2 y)) n))
+                :hints (("Goal" :in-theory (e/d (bvecp
+                                                 expt-2-reduce-leading-constant) ()))))
+
+              ;; we can prove the following. 
+              ;;
+              ;; (skip-proofs 
+              ;;  ;; proved in bits-new-proofs.lisp
+              ;;  (defthmd logand-ones-g
+              ;;    (implies (and (integerp i)
+              ;;                  (case-split (integerp i))
+              ;;                  )
+              ;;             (equal (logand i (1- (expt 2 n)))
+              ;;                    (mod i (expt 2 n))))))
+
+              ;; (defthmd logand-ones-g-specific
+              ;;    (implies (and (integerp i)
+              ;;                  (case-split (integerp i))
+              ;;                  )
+              ;;             (equal (logand i -1)
+              ;;                    i))
+              ;;    :hints (("Goal" :use ((:instance logand-ones-g
+              ;;                                     (n 0))))))
+
+              (defthmd mod-2-expt-2-is-zero
+                (implies (and (integerp n)
+                              (> n 0)
+                              (integerp x))
+                         (equal (mod (* x (expt 2 n)) 2)
+                                0))
+                :hints (("Goal" :in-theory (e/d (mod) ()))))
+
+              (defthmd integer-decompose
+                (implies (integerp y)
+                         (equal (FL (* 1/2 Y))
+                                (* 1/2 (- y (mod y 2)))))
+                :hints (("Goal" :in-theory (e/d (mod evenp) ()))))
+            
+              ))         
+
+(defthm logior-expt-g
+  (implies (and (natp n)
+                (integerp x)
+                (bvecp y n))
+           (= (logior (* (expt 2 n) x) y)
+              (+ (* (expt 2 n) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (mod-2-expt-2-is-zero
+                                   expt-2-reduce-leading-constant
+                                   bvecp-fl-1/2)
+                                  ((logior)))
+           :induct (logop-2-n-induct (* (expt 2 n) x)
+                                     y
+                                     n))
+          ("Subgoal *1/2" :use ((:instance logior-def
+                                           (i (* (expt 2 n) x))
+                                           (j y))
+                                (:instance integer-decompose)))))
+
+(defthm logior-expt-2-g
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n))
+           (= (logior (* (expt 2 n) x)
+                      (* (expt 2 n) y))
+              (* (expt 2 n) (logior x y))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (mod-2-expt-2-is-zero
+                                   expt-2-reduce-leading-constant)
+                                  ((logior)))
+           :induct (logop-2-n-induct (* (expt 2 n) x)
+                                     (* (expt 2 n) y)
+                                     n))
+          ("Subgoal *1/2" :use ((:instance logior-def
+                                           (i (* (expt 2 n) x))
+                                           (j (* (expt 2 n) y)))
+                                (:instance integer-decompose)))))
+
+
+
+
+;; (defthm logand-bnd
+;;     (implies (and (natp x)
+;; 		  (integerp y))
+;; 	     (<= (logand x y) x))
+;;   :rule-classes :linear)
+
+
+(defthm logand-bnd
+    (implies (<= 0 x)
+	     (<= (logand x y) x))
+  :rule-classes :linear)
+
+(local 
+ (defthmd fl-fl-reduce
+   (implies (and (integerp n)
+                 (> n 0))
+            (equal (FL (* 2 (/ (EXPT 2 N)) (FL (* 1/2 Y))))
+                  (fl (* y (/ (expt 2 n))))))
+   :hints (("Goal" :use ((:instance FL-SHIFT-FL-2-FACTORS-2
+                                    (n 1)
+                                    (m n)
+                                    (x (* 1/2 y))))
+            :in-theory (e/d (expt-2-reduce-leading-constant) ())))))
+                                   
+
+(defthm logand-expt-g
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n))
+           (= (logand (* (expt 2 n) x) y)
+              (* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+   :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (mod-2-expt-2-is-zero
+                                   fl-fl-reduce
+                                   expt-2-reduce-leading-constant)
+                                  ((logand)))
+           :induct (logop-2-n-induct (* (expt 2 n) x)
+                                     y
+                                     n))
+          ("Subgoal *1/2" :use ((:instance logand-def
+                                           (i (* (expt 2 n) x))
+                                           (j y))))))
+
+
+;;;;;; Mon Feb  9 12:53:20 2009   
+
+;;;; strategy? 
+;;;;
+;;;; bitn(lnot(x, n), i) vs bitn(lognot(x), i)
+;;;;
+
+;; >  D          (DEFTHM BITN-MOD
+;;                       (IMPLIES (AND (< K N) (INTEGERP N) (INTEGERP K))
+;;                                (EQUAL (BITN (MOD X (EXPT 2 N)) K)
+;;                                       (BITN X K))))
+
+;;
+;; bitn-mod lemma are pretty powerful. Mon Feb  9 13:17:51 2009
+;;
+
+(local 
+ (defthmd bitn_alt-lognot-lemma
+  (implies (and (integerp x)
+                (integerp n)
+                (> n 0))
+           (equal (bitn_alt (lognot x) n)
+                  (bitn (lnot x (+ 1 n)) n)))
+   :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn
+                                    lnot
+                                    bits-mod
+                                    lognot-def)
+                                   (bits-n-n-rewrite
+                                    bitn-0
+                                    MOD-MINUS-ALT))
+            :use ((:instance bitn-mod
+                             (x (+ -1 (* -1 x)))
+                             (k n)
+                             (n (+ 1 n)))
+                  (:instance bitn-mod
+                             (x (+ -1 (expt 2 (+ 1 n))
+                                   (* -1 (bits x n 0))))
+                             (k n)
+                             (n (+ 1 n)))))))
+)                                
+
+
+(defthmd bitn_alt-lognot
+  (implies (and (integerp x)
+                (integerp n)
+                (> n 0))
+           (not (equal (bitn_alt (lognot x) n)
+                       (bitn_alt x n))))
+   :hints (("Goal" :in-theory (e/d (bitn_alt-lognot-lemma
+                                    bitn-lnot)
+                                   ()))
+           ("Goal''" :in-theory (e/d (bitn_alt-is-bitn lnot)
+                                     ()))))
+                  
+;;;;;
+;;;;;
+;;;;; 
+
+;;;
+;;; this is generalized to allow n to be negative. 
+;;;
+
+(defthmd bitn_alt-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n))
+           (equal (bitn_alt (logand x y) n)
+                  (logand (bitn_alt x n) (bitn_alt y n))))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn bitn-neg)
+                                  (bitn-logand))
+           :use ((:instance bitn-logand)))))
+
+
+
+
+;;;
+;;; this following is generalized to allow negative indexs. 
+;;; 
+;;; We can prove the following using the above result. 
+;;;
+
+
+;; (local 
+;;  (encapsulate ()
+;;               (local (include-book "../support/badguys"))
+
+;;              (defun sumbits-badguy (x y k)
+;;                (if (zp k)
+;;                    0 ; arbitrary
+;;                  (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+;;                      (1- k)
+;;                    (sumbits-badguy x y (1- k)))))
+
+
+;;              (defthmd sumbits-badguy-is-correct
+;;                (implies (and (bvecp x k)
+;;                              (bvecp y k)
+;;                              (equal (bitn x (sumbits-badguy x y k))
+;;                                     (bitn y (sumbits-badguy x y k)))
+;;                              (integerp k)
+;;                              (< 0 k))
+;;                         (equal (equal x y) t))
+;;                :hints (("Goal"
+;;                         :use sumbits-badguy-is-correct-lemma
+;;                         :in-theory (enable sumbits-thm))))
+
+;;              (defthmd sumbits-badguy-bounds
+;;                (implies (and (integerp k)
+;;                              (< 0 k))
+;;                         (let ((badguy (sumbits-badguy x y k)))
+;;                           (and (integerp badguy)
+;;                                (<= 0 badguy)
+;;                                (< badguy k)))))
+;;              ))
+
+
+
+(local 
+ (defund bvequal (v1 v2 n)
+  (equal (sumbits v1 n)
+         (sumbits v2 n))))
+
+
+(local
+ (defthm bvequal-then-equal
+  (implies (and (bvequal x y n)
+                (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal x y))
+  :hints (("Goal" :use ((:instance sumbits-thm
+                                   (x x))
+                        (:instance sumbits-thm
+                                   (x y)))
+           :in-theory (enable bvequal)))
+  :rule-classes nil))
+
+
+(local 
+ (defthmd bitn-logand-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                (integerp n))
+            (equal (bitn (logand x y) n)
+                   (logand (bitn x n) (bitn y n))))
+  :hints (("Goal" :use ((:instance bitn-logand))
+           :in-theory (e/d (bitn-neg) ())))))
+
+(local 
+ (defthmd  bvequal-bits-logand
+   (implies (and (integerp x)
+                 (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (<= 0 k)
+                (<= k (+ 1 i (* -1 j)))
+                (>= i j))
+           (bvequal (bits (logand x y) i j)
+                    (logand (bits x i j)
+                            (bits y i j))
+                    k))
+  :hints (("Goal" :in-theory (e/d (bvequal sumbits 
+                                           bitn-logand-bvequal
+                                           bitn-bits) (bits-logand))))))
+           
+
+(defthmd bits_alt-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j))
+           (equal (bits_alt (logand x y) i j)
+                  (logand (bits_alt x i j) (bits_alt y i j))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   bvequal-bits-logand) (bits-logand))
+           :cases ((>= i j)))
+          ("Subgoal 1"  :use ((:instance bvequal-then-equal
+                                         (n (+ 1 i (* -1 j)))
+                                         (x (bits (logand x y) i j))
+                                         (y (logand (bits x i j) (bits y i j))))))))
+
+
+
+
+(defthmd bitn_alt-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n))
+           (equal (bitn_alt (logior x y) n)
+                  (logior (bitn_alt x n) (bitn_alt y n))))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn bitn-neg)
+                                  ())
+           :use ((:instance bitn-logior)))))
+
+
+
+
+
+(local 
+ (defthmd bitn-logior-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp n))
+            (equal (bitn (logior x y) n)
+                   (logior (bitn x n) (bitn y n))))
+   :hints (("Goal" :use ((:instance bitn-logior))
+            :in-theory (e/d (bitn-neg) ())))))
+
+
+(local 
+ (defthmd  bvequal-bits-logior
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp i)
+                 (integerp j)
+                 (integerp k)
+                 (<= 0 k)
+                 (<= k (+ 1 i (* -1 j)))
+                 (>= i j))
+            (bvequal (bits (logior x y) i j)
+                     (logior (bits x i j)
+                             (bits y i j))
+                     k))
+   :hints (("Goal" :in-theory (e/d (bvequal sumbits 
+                                            bitn-logior-bvequal
+                                            bitn-bits) (bits-logior))))))
+           
+(defthmd bits_alt-logior
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp i)
+                 (integerp j))
+            (equal (bits_alt (logior x y) i j)
+                   (logior (bits_alt x i j) (bits_alt y i j))))
+   :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                    bvequal-bits-logior) (bits-logior))
+            :cases ((>= i j)))
+           ("Subgoal 1"  :use ((:instance bvequal-then-equal
+                                          (n (+ 1 i (* -1 j)))
+                                          (x (bits (logior x y) i j))
+                                          (y (logior (bits x i j) (bits y i j))))))))
+
+
+;;;;;;;
+
+
+(defthmd bitn_alt-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp n)))
+           (equal (bitn_alt (logxor x y) n)
+                  (logxor (bitn_alt x n) (bitn_alt y n))))
+  :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn bitn-neg)  
+                                  ())
+           :use ((:instance bitn-logxor)))))
+
+
+
+(local 
+ (defthmd bitn-logxor-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp n))
+            (equal (bitn (logxor x y) n)
+                   (logxor (bitn x n) (bitn y n))))
+   :hints (("Goal" :use ((:instance bitn-logxor))
+            :in-theory (e/d (bitn-neg) ())))))
+
+
+(local 
+ (defthmd  bvequal-bits-logxor
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp i)
+                 (integerp j)
+                 (integerp k)
+                 (<= 0 k)
+                 (<= k (+ 1 i (* -1 j)))
+                 (>= i j))
+            (bvequal (bits (logxor x y) i j)
+                     (logxor (bits x i j)
+                             (bits y i j))
+                     k))
+   :hints (("Goal" :in-theory (e/d (bvequal sumbits 
+                                            bitn-logxor-bvequal
+                                            bitn-bits) (bits-logxor))))))
+           
+
+
+
+
+(defthmd bits_alt-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (bits_alt (logxor x y) i j)
+                  (logxor (bits_alt x i j) (bits_alt y i j))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   bvequal-bits-logxor) (bits-logxor))
+           :cases ((>= i j)))
+          ("Subgoal 1"  :use ((:instance bvequal-then-equal
+                                         (n (+ 1 i (* -1 j)))
+                                         (x (bits (logxor x y) i j))
+                                         (y (logxor (bits x i j) (bits y i j))))))))
+
+
+
+
+;;;;;;
+;;;;;;
+
+;; we can prove the following. 
+;;
+(local 
+ (encapsulate () 
+;; proved in bits-new-proofs.lisp
+(defthmd logand-ones-g
+  (implies (and (integerp i)
+                (case-split (integerp i))
+                )
+           (equal (logand i (1- (expt 2 n)))
+                  (mod i (expt 2 n)))))
+
+(defthmd logand-ones-g-specific
+   (implies (and (integerp i)
+                 (case-split (integerp i))
+                 )
+            (equal (logand 1 i)
+                   (bitn i 0)))
+   :hints (("Goal" :use ((:instance logand-ones-g
+                                    (n 1)))
+            :in-theory (e/d (bitn bits-mod)
+                            (bits-n-n-rewrite)))))
+
+
+(defthmd bits-expt-n
+  (equal (BITS (EXPT 2 K) (+ -1 K) 0)
+         0)
+  :hints (("Goal" :in-theory (e/d (bits mod)
+                                  ()))))
+
+(defthmd bitn-expt-n
+  (implies (natp k)
+           (equal (BITN (EXPT 2 K) k)
+                  1))
+  :hints (("Goal" :in-theory (e/d (bits bitn mod)
+                                  ())
+           :use ((:instance bits-mod-2
+                            (x (expt 2 k))
+                            (i (+ 1 k))
+                            (j k))))))
+
+(defthmd bvecp-logand-specific
+  (implies (and (natp k)
+                (integerp x))
+           (bvecp (LOGAND X (EXPT 2 K)) (+ 1 k)))
+  :hints (("Goal" :use ((:instance logand-bvecp-g
+                                   (x (expt 2 k))
+                                   (y x)
+                                   (n (+ 1 k))))
+           :cases ((bvecp (expt 2 k) (+ 1 k))))
+          ("Subgoal 2" :in-theory (e/d (bvecp) ()))))
+
+;;;
+;;; the proof looks awkward. 
+;;;
+))
+
+(defthmd logand-expt-2-g
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logand x (expt 2 k))
+		    (* (expt 2 k) (bitn_alt x k))))
+    :hints (("Goal" :in-theory (e/d (bitn_alt-is-bitn
+                                     cat
+                                     bits_alt-is-bits
+                                     bits-expt-n
+                                     bitn-expt-n
+                                     logand-ones-g-specific
+                                     bvecp-logand-specific)
+                                    (cat-bitn-bits
+                                     bits-logand
+                                     bitn-logand
+                                     bitn-logand-bvequal))
+             :use ((:instance cat-bitn-bits
+                              (x (logand x (expt 2 k)))
+                              (j k)
+                              (m 1)
+                              (k (+ -1 k))
+                              (l 0)
+                              (n k))))
+            ("Subgoal 1" 
+             :use ((:instance bits_alt-logand
+                              (x x)
+                              (y (expt 2 k))
+                              (i (+ -1 k))
+                              (j 0))
+                   (:instance bitn_alt-logand
+                              (x x)
+                              (y (expt 2 k))
+                              (n k))))))
+;;;;
+;;;; we don't want to include the merge.lisp here. Mon Feb  9 16:48:35 2009
+;;;;
+;;;;
+
+
+
+(local                                           
+;;;
+;;;
+ (defthmd bitn-fl-k
+   (implies (and (integerp k)
+                 (integerp x)
+                 (> k 0))
+            (equal (BITN (FL (* 1/2 X)) (+ -1 K))
+                   (bitn x k)))
+   :hints (("Goal" :in-theory (e/d (bitn-def 
+                                    fl-fl-reduce
+                                    expt-2-reduce-leading-constant
+                                    mod)
+                                   ())))))
+
+
+
+(local 
+ (defthmd mod-expt-2n
+   (implies (and (integerp k)
+                 (> k 0))
+            (equal (MOD (EXPT 2 K) 2)
+                   0))
+   :hints (("Goal" :in-theory (e/d (mod) ())))))
+
+
+
+;; (defthm logior-0-y
+;;      (implies (integerp y)
+;;               (equal (logior 0 y) y)))
+
+;;; these are new from merge.lisp
+
+(defthmd logior-expt-3-g
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logior x (expt 2 k))
+		    (+ x
+		       (* (expt 2 k) 
+			  (- 1 (bitn_alt x k))))))
+    :hints (("Goal" :in-theory (e/d (bitn-fl-k
+                                     bitn_alt-is-bitn)
+                                    ())
+             :induct (logop-2-n-induct x (expt 2 k) k))
+            ("Subgoal *1/2" :use ((:instance logior-def
+                                             (i x)
+                                             (j (expt 2 k)))
+                                  (:instance integer-decompose
+                                             (y x)))
+             :in-theory (e/d (bitn-fl-k  
+                              mod-expt-2n
+                              bitn_alt-is-bitn
+                              expt-2-reduce-leading-constant)
+                             ()))
+            ("Subgoal *1/1" :in-theory (e/d (bitn_alt-is-bitn
+                                             bitn-def)
+                                            ())
+             :use ((:instance logior-def
+                              (i 1)
+                              (j x))
+                   (:instance integer-decompose
+                              (y x)))
+             :cases ((equal (mod x 2) 1)))))
+
+             
+;;;
+;;; many ways to prove the following. 
+;;;
+;;; use the bvequal approach
+;;;
+
+
+
+(local 
+ (encapsulate () 
+
+ (local 
+  (encapsulate () 
+
+               (defun all-ones-p (x n)
+                 (if (zp n)
+                     t
+                   (and (equal (bitn x (+ -1 n)) 1)
+                        (all-ones-p x (+ -1 n)))))
+
+
+               (defthmd sumbits-less-than
+                 (implies (natp n)
+                          (<= (sumbits x n) (+ -1 (expt 2 n))))
+                 :hints (("Goal" :do-not '(generalize)
+                          :in-theory (enable expt-2-reduce-leading-constant))
+                         ("Subgoal *1/4'" :use ((:instance bitn-0-1
+                                                           (x x)
+                                                           (n (+ -1 n))))))
+                 :rule-classes :linear)
+
+               (defthmd all-bits-sumbits-is
+                 (implies (equal (sumbits x n) (+ -1 (expt 2 n)))
+                          (all-ones-p x n))
+                 :hints (("Goal" :do-not '(generalize)
+                          :in-theory (enable expt-2-reduce-leading-constant))
+                         ("Subgoal *1/4" :use ((:instance sumbits-less-than
+                                                          (x x)
+                                                          (n (+ -1 n)))))))
+
+               (defthmd bits-tail-specific
+                 (implies (and (natp n)
+                               (> n 0))
+                          (equal (BITS (+ -1 (EXPT 2 N)) (+ -1 N) 0)
+                                 (+ -1 (expt 2 n))))
+                 :hints (("Goal" :cases ((bvecp (+ -1 (expt 2 n)) n)))
+                         ("Subgoal 2" :in-theory (enable bvecp))))
+
+               (defthmd all-bits-sumbits-is-strong
+                 (implies (and (natp n)
+                               (> n 0))
+                          (all-ones-p (+ -1 (expt 2 n)) n))
+                 :hints (("Goal" :do-not '(generalize)
+                          :in-theory (enable sumbits-bits
+                                             bits-tail-specific)
+                          :use ((:instance all-bits-sumbits-is
+                                           (x (+ -1 (expt 2 n))))))))
+
+
+               (defthmd all-bits-sumbits-is-2
+                 (implies (and (all-ones-p x n)
+                               (natp n))
+                          (equal (sumbits x n) (+ -1 (expt 2 n))))
+                 :hints (("Goal" :do-not '(generalize)
+                          :in-theory (enable expt-2-reduce-leading-constant))))
+
+
+
+               (defthm all-bits-sumbits-is-2-strong
+                 (implies (and (not (equal x (+ -1 (expt 2 n))))
+                               (bvecp x n)
+                               (natp n)
+                               (> n 0))
+                          (not (all-ones-p x n)))
+                 :hints (("Goal" :do-not '(generalize)
+                          :use ((:instance all-bits-sumbits-is-2))
+                          :in-theory (enable sumbits-bits 
+                                             all-bits-sumbits-is-strong
+                                             bits-tail-specific))))
+
+
+
+
+               (defthm bitn-all-ones-is-one
+                 (implies (and (all-ones-p x n)
+                               (natp i)
+                               (natp n)
+                               (< i n))
+                          (equal (bitn x i) 1)))
+
+
+
+               (defun all-ones-p-alt (x n)
+                 (if (zp n)
+                     t
+                   (and (equal (bitn x (+ -1 n)) 1)
+                        (all-ones-p-alt x (+ -1 n)))))
+
+                 
+               
+               (defthmd all-ones-p-bits-all-ones
+                 (implies (and (all-ones-p x n)
+                               (natp n)
+                               (natp i)
+                               (natp j)
+                               (natp k)
+                               (< i n)
+                               (<= j i)
+                               (<= k (+ 1 i (* -1 j))))
+                          (all-ones-p-alt (bits x i j) k))
+                 :hints (("Goal" :induct (all-ones-p-alt (bits x i j)
+                                                         k)
+                          :in-theory (e/d (bitn-bits)
+                                          (all-ones-p
+                                           bitn-all-ones-is-one)))
+                         ("Subgoal *1/3" :use ((:instance bitn-all-ones-is-one
+                                                          (i (+ -1 j k)))))))
+
+
+
+
+
+
+               (defthm all-ones-p-alt-is-all-one-p
+                 (equal (all-ones-p-alt x n)
+                        (all-ones-p x n)))
+               
+               ))
+
+
+
+
+ (defthmd bits-all-ones-is-all-ones
+   (implies (and (natp m)
+                 (> m 0)
+                 (natp i)
+                 (natp j)
+                 (> m  i)
+                 (>= i j))
+            (equal (bits (+ -1 (expt 2 m))
+                         i j)
+                   (+ -1 (expt 2 (+ 1 i (* -1 j))))))
+   :hints (("Goal" :use ((:instance all-bits-sumbits-is-strong
+                                    (n m))
+                         (:instance all-ones-p-bits-all-ones
+                                    (x (+ -1 (expt 2 m)))
+                                    (n m)
+                                    (i i)
+                                    (j j)
+                                    (k (+ 1 i (* -1 j))))
+                         (:instance all-bits-sumbits-is-2-strong
+                                    (x (bits (+ -1 (expt 2 m)) i j))
+                                    (n (+ 1 i (* -1 j))))))))
+
+
+
+
+ ))
+
+;; (defthmd bitn-shift
+;;   (implies (and (integerp n)
+;; 		(integerp k))
+;; 	   (equal (bitn (* x (expt 2 k)) (+ n k))
+;; 		  (bitn x n))))
+
+(local 
+(defthmd expt-merge-hack
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (* (expt 2 n) (expt 2 m))
+                  (expt 2 (+ n m))))))
+
+
+(local
+(defthmd bitn-expt-expt-i
+  (implies (and (natp n)
+                (natp k)
+                (natp i)
+                (<= k n)
+                (< i n)) ;; could remove this. 
+           (equal (BITN (+ (EXPT 2 N) (* -1 (EXPT 2 K)))
+                        i)
+                  (if (and (<= k i)
+                           (< i n))
+                      1
+                    0)))
+  :hints (("Goal" :cases ((equal (bitn (+ (expt 2 n) (* -1 (expt 2 k))) i)
+                                 (bitn (+ -1 (expt 2 (+ n (* -1 k))))
+                                       (+ i (* -1 k))))))
+          ("Subgoal 2" :use ((:instance bitn-shift
+                                        (x (+ -1 (expt 2 (+ n (* -1 k)))))
+                                        (k k)
+                                        (n (+ i (* -1 k)))))
+           :in-theory (e/d (expt-merge-hack) ()))
+          ("Subgoal 1" :use ((:instance bits-all-ones-is-all-ones
+                                        (m (+ n (* -1 k)))
+                                        (i (+ i (* -1 k)))
+                                        (j (+ i (* -1 k)))))
+           :in-theory (e/d (bitn) (bits-n-n-rewrite)))))
+)
+
+             
+
+(local         
+(defthmd bitn-shift-fact-expt
+  (implies (and (integerp n)
+                (integerp i)
+                (integerp x))
+           (equal (bitn (* (expt 2 n) x) i)
+                  (bitn x (+ i (* -1 n)))))
+  :hints (("Goal" 
+           :cases ((equal (* (expt 2 n) (expt 2 (* -1 i)))
+                          (expt 2 (+ n (* -1 i))))))
+          ("Subgoal 1" :in-theory (e/d (bitn-def mod
+                                                 expt-inverse
+                                                 expt-2-reduce-leading-constant
+                                                 ) (EXPO-SHIFT-GENERAL
+                                                    EXPT-COMPARE-EQUAL)))))
+)
+
+;; (defthm logand-1-x
+;;     (implies (bvecp x 1)
+;; 	     (equal (logand 1 x) x)))
+
+(local            
+(defthmd logand-expt-3-bvequal
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k) 
+                (natp i)
+                (<= k n)
+                (< i n))
+           (equal (bitn (logand x (+ (expt 2 n)
+                                     (* -1 (expt 2 k))))
+                        i)
+                  (bitn (* (expt 2 k)
+                           (bits x (+ -1 n) k)) i)))
+  :hints (("Goal" :use ((:instance bitn-logand-bvequal
+                                   (x x)
+                                   (y (+ (expt 2 n)
+                                         (* -1 (expt 2 k))))
+                                   (n i)))
+           :in-theory (e/d (bitn-expt-expt-i 
+                            logand-ones-g-specific
+                            bitn-shift-fact-expt
+                            bitn-bits)
+                           ()))))
+)
+
+(local 
+(defthmd  bvequal-logand-expt-3
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k)
+                (<= k n)
+                (natp i)
+                (<= i n))
+           (bvequal (logand x (+ (expt 2 n)
+                                 (* -1 (expt 2 k))))
+                    (* (expt 2 k)
+                       (bits x (+ -1 n) k))
+                    i))
+  :hints (("Goal" :in-theory (e/d (bvequal sumbits 
+                                           logand-expt-3-bvequal
+                                           bitn-bits) (bits-logand)))))
+)
+
+(local
+(defthmd bvecp-logand-specific-2
+  (implies (and (natp k)
+                (natp n)
+                (<= k n)
+                (integerp x))
+           (bvecp (LOGAND X (+ (expt 2 n) 
+                               (* -1 (EXPT 2 K)))) n))
+  :hints (("Goal" :use ((:instance logand-bvecp-g
+                                   (x (+ (expt 2 n)
+                                         (* -1 (expt 2 k))))
+                                   (y x)
+                                   (n n)))
+           :cases ((bvecp (+ (expt 2 n)
+                             (* -1 (expt 2 k))) n)))
+          ("Subgoal 2" :in-theory (e/d (bvecp) ()))))
+)
+
+(local 
+(defthmd bvecp-logand-specific-3
+  (implies (and (natp k)
+                (natp n)
+                (<= k n)
+                (integerp x))
+           (bvecp (* (expt 2 k)
+                     (bits X (+ -1 n) k)) n))
+  :hints (("Goal" :in-theory (e/d (bvecp) ())
+           :cases ((bvecp (bits x (+ -1 n) k)
+                          (+ n (* -1 k)))))
+          ("Subgoal 1" :cases ((equal (expt 2 (+ n (* -1 k)))
+                                      (* (expt 2 n)
+                                         (/ (expt 2 k))))))
+          ("Subgoal 1.1" :in-theory (e/d (bvecp) (EXPT-COMPARE-EQUAL)))))
+       )                   
+
+           
+
+(defthmd logand-expt-3-g
+    (implies (and (integerp x)
+		  (natp n)
+		  (natp k)
+		  (< k n))
+	     (equal (logand x (+ (expt 2 n) (- (expt 2 k))))
+		    (* (expt 2 k) (bits_alt x (1- n) k))))
+  :hints (("Goal" :in-theory (e/d (bits_alt-is-bits
+                                   bvecp-logand-specific-3
+                                   bvecp-logand-specific-2
+                                   bvequal-logand-expt-3) (bits-logand))
+             :use ((:instance bvequal-then-equal
+                              (n n)
+                              (x (logand x (+ (expt 2 n)
+                                              (* -1 (expt 2 k)))))
+                              (y (* (expt 2 k)
+                                    (bits x (+ -1 n) k))))))))
+
+
+;;;;
+ 
+;; (defthm logand-expt-4
+;;   (implies (and (integerp n) (>= n 0)
+;;                 (integerp k) (>= k 0)
+;;                 (integerp l) (>= l 0) (< l k)
+;;                 (<= k n))
+;;            (= (logand (- (1- (expt 2 n)) (expt 2 l))
+;;                       (- (expt 2 n) (expt 2 k)))
+;;               (- (expt 2 n) (expt 2 k))))
+;;   :rule-classes ()
+;;   :hints (("goal" :hands-off (expt mod fl)
+;;            :use ((:instance logand-expt-4-10)
+;;                  (:instance expt-split (r 2) (i (- n k)) (j k))))))
+
+(encapsulate () 
+     (local (include-book "../support/merge"))
+
+
+     (defthmd logand-expt-4-g
+       (implies (and (natp n)
+                     (natp k)
+                     (natp l)
+                     (< l k)
+                     (<= k n))
+                (equal (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+                       (- (expt 2 n) (expt 2 k))))
+       :hints (("Goal" :use ((:instance logand-expt-4)))))
+       )
+
+
+(defthmd lognot-shift
+  (implies (and (integerp x)
+                (natp k))
+           (equal (lognot (* (expt 2 k) x))
+		  (+ (* (expt 2 k) (lognot x))
+		     (1- (expt 2 k)))))
+  :hints (("Goal" :in-theory (e/d (lognot) ()))))
+
+
+
+
+;;               (defthmd mod-2-expt-2-is-zero
+;;                 (implies (and (integerp n)
+;;                               (> n 0)
+;;                               (integerp x))
+;;                          (equal (mod (* x (expt 2 n)) 2)
+;;                                 0))
+;;                 :hints (("Goal" :in-theory (e/d (mod) ()))))
+
+;;               (defthmd integer-decompose
+;;                 (implies (integerp y)
+;;                          (equal (FL (* 1/2 Y))
+;;                                 (* 1/2 (- y (mod y 2)))))
+;;                 :hints (("Goal" :in-theory (e/d (mod evenp) ()))))
+
+
+(defthmd logand-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logand (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logand x y))))
+    :hints (("Goal" :induct (logop-2-n-induct (* (expt 2 k) x)
+                                              (* (expt 2 k) y)
+                                              k)
+             :in-theory (e/d (mod-2-expt-2-is-zero
+                              expt-2-reduce-leading-constant) ()))
+            ("Subgoal *1/2" :use ((:instance logand-def
+                                             (i (* (expt 2 k) x))
+                                             (j (* (expt 2 k) y)))))))
+
+                                              
+
+(defthmd logxor-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logxor (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logxor x y))))
+    :hints (("Goal" :induct (logop-2-n-induct (* (expt 2 k) x)
+                                              (* (expt 2 k) y)
+                                              k)
+             :in-theory (e/d (mod-2-expt-2-is-zero
+                              expt-2-reduce-leading-constant) ()))
+            ("Subgoal *1/2" :use ((:instance logxor-def
+                                             (i (* (expt 2 k) x))
+                                             (j (* (expt 2 k) y)))))))
+
+
+
+(defthmd logior-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logior (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logior x y))))
+    :hints (("Goal" :induct (logop-2-n-induct (* (expt 2 k) x)
+                                              (* (expt 2 k) y)
+                                              k)
+             :in-theory (e/d (mod-2-expt-2-is-zero
+                              expt-2-reduce-leading-constant) ()))
+            ("Subgoal *1/2" :use ((:instance logior-def
+                                             (i (* (expt 2 k) x))
+                                             (j (* (expt 2 k) y)))))))
+
+
+;;;;;
+;;;;;
+
+;; (defthm fl-lognot
+;;   (implies (case-split (integerp i))
+;;            (= (fl (* 1/2 (lognot i)))
+;;               (lognot (fl (* 1/2 i)))))
+;;   :hints (("Goal" :in-theory (enable lognot))))
+
+(encapsulate () 
+             (local (include-book "../support/lognot"))
+
+
+             (defthm fl-lognot
+               (implies (case-split (integerp i))
+                        (= (fl (* 1/2 (lognot i)))
+                           (lognot (fl (* 1/2 i))))))
+
+
+             )
+
+
+;; We already have this 
+;;
+;; (defthm fl-logand-by-2
+;;   (implies (and (case-split (integerp i))
+;;                 (case-split (integerp j))
+;;                 )
+;;            (equal (fl (* 1/2 (logand i j)))
+;;                   (logand (fl (* 1/2 i)) (fl (* 1/2 j))))))
+;;
+;; easy. Mon Feb  9 17:20:12 2009
+
+(defun fl-induct (x y k)
+  (if (zp k) 
+      (list x y k)
+    (fl-induct  (fl (* 1/2 x))
+                (fl (* 1/2 y))
+                (+ -1 k))))
+
+
+
+
+(defthmd fl-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logand x y) (expt 2 k)))
+                  (logand (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))))))
+  :hints (("Goal" :induct (fl-induct x y k))
+          ("Subgoal *1/2" :use ((:instance fl-logand-by-2
+                                           (i x)
+                                           (j y)))
+           :in-theory (e/d ()
+                           (fl-logand-by-2)))
+          ("Subgoal *1/2'''" :in-theory (e/d (expt-2-reduce-leading-constant) 
+                                             ()))))
+
+
+(defthmd fl-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logior x y) (expt 2 k)))
+                  (logior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))))))
+  :hints (("Goal" :induct (fl-induct x y k))
+          ("Subgoal *1/2" :use ((:instance fl-logior-by-2
+                                           (i x)
+                                           (j y)))
+           :in-theory (e/d ()
+                           (fl-logior-by-2)))
+          ("Subgoal *1/2'''" :in-theory (e/d (expt-2-reduce-leading-constant) 
+                                             ()))))
+
+(defthmd fl-logxor
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logxor x y) (expt 2 k)))
+                  (logxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))))))
+  :hints (("Goal" :induct (fl-induct x y k))
+          ("Subgoal *1/2" :use ((:instance fl-logxor-by-2
+                                           (i x)
+                                           (j y)))
+           :in-theory (e/d ()
+                           (fl-logxor-by-2)))
+          ("Subgoal *1/2'''" :in-theory (e/d (expt-2-reduce-leading-constant) 
+                                             ()))))
+
+;;;;;
+;;;;;
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(encapsulate () 
+             (local (include-book "../support/lognot"))
+             
+             (defthm lognot-lognot
+               (implies (case-split (integerp i))
+                        (equal (lognot (lognot i))
+                               i))))
+
+(defthm logand-x-0
+    (equal (logand x 0) 0))
+
+(defthm logand-0-y
+    (equal (logand 0 y) 0))
+
+(defthm logior-x-0
+    (implies (integerp x)
+	     (equal (logior x 0) x)))
+
+(defthm logior-0-y
+    (implies (integerp y)
+	     (equal (logior 0 y) y)))
+
+(defthm logxor-x-0
+    (implies (integerp x)
+	     (equal (logxor x 0) x)))
+
+(defthm logxor-0-y
+    (implies (integerp y)
+	     (equal (logxor 0 y) y)))
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logior-self
+    (implies (case-split (integerp i))
+	     (equal (logior i i) i)))
+
+
+(defthm logxor-self
+  (equal (logxor i i) 0))
+
+(defthm logand-x-m1
+    (implies (integerp x)
+	     (equal (logand x -1) x)))
+
+(defthm logand-m1-y
+    (implies (integerp y)
+	     (equal (logand -1 y) y)))
+
+(encapsulate () 
+  (local (include-book "../support/merge"))
+  (defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x))))
+
+(defthm logand-x-1
+    (implies (bvecp x 1)
+	     (equal (logand x 1) x)))
+
+
+(encapsulate ()
+             (local (include-book "../support/logior"))
+             (defthm logior-1-x
+               (implies (bvecp x 1)
+                        (equal (logior 1 x) 1))))
+
+(defthm logior-x-1
+  (implies (bvecp x 1)
+           (equal (logior x 1) 1)))
+
+
+
+(defthm logior-x-m1
+    (implies (integerp x)
+	     (equal (logior x -1) -1)))
+
+(defthm logior-m1-y
+    (implies (integerp y)
+	     (equal (logior -1 y) -1)))
+
+(defthm logxor-m1
+    (implies (integerp x)
+	     (equal (logxor x -1)
+		    (lognot x))))
+
+(defthm logand-commutative
+    (equal (logand j i) (logand i j)))
+
+(defthm logior-commutative
+    (equal (logior j i) (logior i j)))
+
+(defthm logxor-commutative
+    (equal (logxor j i) (logxor i j)))
+
+(defthm logand-associative
+    (equal (logand (logand i j) k)
+           (logand i (logand j k))))
+
+(defthm logior-associative
+    (equal (logior (logior i j) k)
+	   (logior i (logior j k))))
+
+(defthm logxor-associative
+    (equal (logxor (logxor i j) k)
+	   (logxor i (logxor j k))))
+
+(DEFTHM LOGAND-COMMUTATIVE-2
+  (EQUAL (LOGAND J I K) (LOGAND I J K)))
+
+
+(DEFTHM LOGIOR-COMMUTATIVE-2
+  (EQUAL (LOGIOR J I K) (LOGIOR I J K)))
+
+
+(DEFTHM LOGXOR-COMMUTATIVE-2
+  (EQUAL (LOGXOR J I K) (LOGXOR I J K)))
+
+
+(DEFTHM LOGNOT-LOGXOR
+  (AND (EQUAL (LOGXOR (LOGNOT I) J)
+              (LOGNOT (LOGXOR I J)))
+       (EQUAL (LOGXOR J (LOGNOT I))
+              (LOGNOT (LOGXOR I J)))))
+
+
+;; (DEFTHM LOGIOR-LOGAND
+;;   (IMPLIES (AND (INTEGERP X)
+;;                 (<= 0 X)
+;;                 (INTEGERP Y)
+;;                 (<= 0 Y)
+;;                 (INTEGERP Z)
+;;                 (<= 0 Z))
+;;            (EQUAL (LOGIOR X (LOGAND Y Z))
+;;                   (LOGAND (LOGIOR X Y) (LOGIOR X Z))))
+;;   :RULE-CLASSES NIL)
+
+;; fl-logand-by-2
+
+(defthm mod-2-0-1
+  (implies (integerp x)
+           (or (equal (mod x 2) 1)
+               (equal (mod x 2) 0)))
+  :rule-classes nil)
+         
+
+
+(defun logop-3-induct-g (x y z)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)) (nfix (abs z)))))
+  (if (and (integerp x) (integerp y) (integerp z))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1))
+               (or (equal z 0)
+                   (equal z -1)))
+	  t
+	(logop-3-induct-g (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+
+(defthmd logior-logand-specific
+  (implies (integerp x)
+           (equal (LOGAND (LOGIOR (MOD X 2) (MOD Y 2))
+                          (LOGIOR (MOD X 2) (MOD Z 2)))
+                  (logior (mod x 2) (logand (mod y 2) (mod z 2)))))
+  :hints (("Goal" :use ((:instance mod-2-0-1
+                                   (x x))
+                        (:instance mod-2-0-1
+                                   (x y))
+                        (:instance mod-2-0-1
+                                   (x z))))))
+                        
+
+
+(defthmd logior-logand-g
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z))))
+  :hints (("Goal" :induct (logop-3-induct-g x y z)
+           :in-theory (e/d (logior-logand-specific) ()))
+          ("Subgoal *1/2" :use ((:instance logior-def
+                                           (i x)
+                                           (j (logand y z)))
+                                (:instance logand-def
+                                           (i (logior x y))
+                                           (j (logior x z)))))))
+
+           
+
+
+(defthmd logand-logior-specific
+  (implies (integerp x)
+           (equal (LOGior (LOGand (MOD X 2) (MOD Y 2))
+                          (LOGand (MOD X 2) (MOD Z 2)))
+                  (logand (mod x 2) (logior (mod y 2) (mod z 2)))))
+  :hints (("Goal" :use ((:instance mod-2-0-1
+                                   (x x))
+                        (:instance mod-2-0-1
+                                   (x y))
+                        (:instance mod-2-0-1
+                                   (x z))))))
+                        
+
+                                     
+
+
+(defthmd logand-logior-g
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand x (logior y z))
+	   (logior (logand x y) (logand x z))))
+  :hints (("Goal" :induct (logop-3-induct-g x y z)
+           :in-theory (e/d (logand-logior-specific) ()))
+          ("Subgoal *1/2" :use ((:instance logand-def
+                                           (i x)
+                                           (j (logior y z)))
+                                (:instance logior-def
+                                           (i (logand x y))
+                                           (j (logand x z)))))))
+
+
+
+(defthmd logior-logand-2
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logand  (logior y z) x)
+                  (logior (logand y x) (logand z x))))
+  :hints (("Goal" :in-theory (e/d (logand-logior-g)))))
+                                   
+
+
+(defun logop-2-induct-g (x y)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)))))
+  (if (and (integerp x) (integerp y))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1)))
+          t
+        (logop-2-induct-g (fl (/ x 2)) (fl (/ y 2))))
+    t))
+
+(defthmd mod-lognot-is-lognot-mod
+  (implies (integerp x)
+           (equal (mod (lognot x) 2)
+                  (+ 1 (* -1 (mod x 2)))))
+  :hints (("Goal" :in-theory (e/d (lognot mod evenp) ()))))
+
+
+(defthmd logxor-specific
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (LOGIOR (LOGAND (MOD X 2) (MOD (LOGNOT Y) 2))
+                          (LOGAND (MOD Y 2) (MOD (LOGNOT X) 2)))
+                  (LOGXOR (MOD X 2) (MOD Y 2))))
+  :hints (("Goal" :use ((:instance mod-2-0-1
+                                   (x x))
+                        (:instance mod-2-0-1
+                                   (x y))
+                        (:instance mod-2-0-1
+                                   (x (lognot x)))
+                        (:instance mod-2-0-1
+                                   (x (lognot y)))
+                        (:instance mod-lognot-is-lognot-mod
+                                   (x x))
+                        (:instance mod-lognot-is-lognot-mod
+                                   (x y))))))
+                        
+
+
+
+(defthmd logxor-rewrite-2-g
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (logxor x y)
+                  (logior (logand x (lognot y))
+                          (logand y (lognot x)))))
+  :hints (("Goal" :induct (logop-2-induct-g x y)
+           :in-theory (e/d (logxor-specific) (logxor-commutative)))
+          ("Subgoal *1/2" :use ((:instance logxor-def
+                                           (i x)
+                                           (j y))
+                                (:instance logior-def
+                                           (i (logand x (lognot y)))
+                                           (j (logand y (lognot x))))))))
+
+
+
+
+(defthmd log3-specific
+  (equal (LOGIOR (LOGAND (MOD X 2) (MOD Y 2))
+                 (LOGAND (MOD X 2) (MOD Z 2))
+                 (LOGAND (MOD Y 2) (MOD Z 2)))
+         (logior (logand (mod x 2) (mod y 2))
+                 (logand (logxor (mod x 2) 
+                                 (mod y 2))
+                         (mod z 2))))
+  :hints (("Goal" :use ((:instance mod-2-0-1
+                                   (x x))
+                        (:instance mod-2-0-1
+                                   (x y))
+                        (:instance mod-2-0-1
+                                   (x z))))))
+  
+
+(defthmd log3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+                  (logior (logand x y) (logand (logxor x y) z))))
+  :hints (("Goal" :induct (logop-3-induct-g x y z)
+           :in-theory (e/d (logop-3-induct-g
+                            log3-specific)
+                           ()))
+          ("Subgoal *1/2" :use ((:instance logior-def
+                                           (i (logand x y))
+                                           (j (logior (logand x z) 
+                                                      (logand y z))))
+                                (:instance logior-def
+                                           (i (logand x y))
+                                           (j (logand (logxor x y)
+                                                      z)))))))
+
+          
+
+;;;;
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,553 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; (set-enforce-redundancy t)
+
+(include-book "bits-new")
+
+(local (include-book "log-new-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+;; 
+;; (local (in-theory nil))
+
+
+
+
+;;;**********************************************************************
+;;;                       LOGNOT, LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+(in-theory (disable lognot logand logior logxor))
+
+
+(defthmd lognot-def
+    (implies (integerp x)
+	     (equal (lognot x)
+		    (1- (- x)))))
+
+(defthmd logand-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logand i j)
+		    (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logand (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+(defthmd logior-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logior i j)
+		    (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+
+(defthmd logxor-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logxor i j)
+		    (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+
+(defthm logand-natp
+    (implies (and (natp i)
+		  (integerp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logand-natp-2
+    (implies (and (integerp i)
+		  (natp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+;;; 
+
+(defthm logand-bvecp-g
+    (implies (and (natp n)
+		  (bvecp x n)
+		  (integerp y))
+	     (bvecp (logand x y) n)))
+
+(defthm logior-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logior i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logior-bvecp
+     (implies (and (bvecp x n)
+                   (bvecp y n))
+ 	     (bvecp (logior x y) n)))
+
+(defthm logxor-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logxor i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+ 		  (bvecp y n)
+                  (natp n))
+ 	     (bvecp (logxor x y) n)))
+
+(defun logop-2-induct-g (x y)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)))))
+  (if (and (integerp x) (integerp y))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1)))
+          t
+        (logop-2-induct-g (fl (/ x 2)) (fl (/ y 2))))
+    t))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+
+
+;; (defun logop-3-induct (x y z)
+;;   (DECLARE (XARGS :MEASURE (:? X Y Z)))
+;;   (if (and (natp x) (natp y) (natp z))
+;;       (if (and (zp x) (zp y) (zp z))
+;; 	  t
+;; 	(logop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+;;     t))
+
+
+(defun logop-3-induct-g (x y z)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)) (nfix (abs z)))))
+  (if (and (integerp x) (integerp y) (integerp z))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1))
+               (or (equal z 0)
+                   (equal z -1)))
+	  t
+	(logop-3-induct-g (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+(defthmd logand-fl-2-rewrite
+    (implies (and (natp x)
+		  (natp y))
+	     (equal (fl (* 1/2 (logand x y)))
+		    (logand (fl (* 1/2 x)) (fl (* 1/2 y))))))
+
+(defthmd logior-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logior i j)))
+		    (logior (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthmd logxor-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logxor i j)))
+		    (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthm logior-not-0
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (logior x y) 0))
+	     (and (= x 0) (= y 0)))
+  :rule-classes ())
+
+
+(defthm logior-expt-g
+  (implies (and (natp n)
+                (integerp x)
+                (bvecp y n))
+           (= (logior (* (expt 2 n) x) y)
+              (+ (* (expt 2 n) x) y)))
+  :rule-classes ())
+
+
+(defthm logior-expt-2-g
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logior (* (expt 2 n) x)
+			(* (expt 2 n) y))
+		(* (expt 2 n) (logior x y))))
+  :rule-classes ())
+
+
+
+(defthm logand-bnd
+    (implies (<= 0 x)
+	     (<= (logand x y) x))
+  :rule-classes :linear)
+
+(defthm logand-expt-g
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logand (* (expt 2 n) x) y)
+		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+  :rule-classes ())
+
+(defthmd bitn_alt-lognot
+    (implies (and (integerp x)
+		  (integerp n)
+		  (> n 0)) ;; ?? n = 0? 
+	     (not (equal (bitn_alt (lognot x) n)
+			 (bitn_alt x n)))))
+
+(defthmd bitn_alt-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn_alt (logand x y) n)
+		    (logand (bitn_alt x n) (bitn_alt y n)))))
+
+
+(defthmd bits_alt-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits_alt (logand x y) i j)
+		    (logand (bits_alt x i j) (bits_alt y i j)))))
+
+
+(defthmd bitn_alt-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn_alt (logior x y) n)
+		    (logior (bitn_alt x n) (bitn_alt y n)))))
+
+
+(defthmd bits_alt-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits_alt (logior x y) i j)
+		    (logior (bits_alt x i j) (bits_alt y i j)))))
+
+
+
+(defthmd bitn_alt-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp n)))
+           (equal (bitn_alt (logxor x y) n)
+                  (logxor (bitn_alt x n) (bitn_alt y n)))))
+
+
+(defthmd bits_alt-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (bits_alt (logxor x y) i j)
+                  (logxor (bits_alt x i j) (bits_alt y i j)))))
+
+
+
+(defthmd logand-expt-2-g
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logand x (expt 2 k))
+		    (* (expt 2 k) (bitn_alt x k)))))
+
+(defthmd logior-expt-3-g
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logior x (expt 2 k))
+		    (+ x
+		       (* (expt 2 k) 
+			  (- 1 (bitn_alt x k)))))))
+
+;; (defthmd logand-expt-3-g
+;;     (implies (and (integerp x)
+;; 		  (natp n)
+;; 		  (natp k)
+;; 		  (< k n))
+;; 	     (equal (logand x (- (expt 2 n) (expt 2 k)))
+;; 		    (* (expt 2 k) (bits_alt x (1- n) k)))))
+
+(defthmd logand-expt-3-g
+    (implies (and (integerp x)
+		  (natp n)
+		  (natp k)
+		  (< k n))
+	     (equal (logand x (+ (expt 2 n) (- (expt 2 k))))
+		    (* (expt 2 k) (bits_alt x (1- n) k)))))
+
+
+
+(defthmd logand-expt-4-g
+  (implies (and (natp n)
+                (natp k)
+                (natp l)
+                (< l k)
+                (<= k n))
+           (equal (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+                  (- (expt 2 n) (expt 2 k)))))
+
+;;; not very good. as a rewrite rule. 
+
+;; (defthmd lognot-shift
+;;   (implies (and (integerp x)
+;;                 (natp k))
+;;            (equal (lognot (* (expt 2 k) x))
+;; 		  (+ (* (expt 2 k) (lognot x))
+;; 		     (1- (expt 2 k)))))
+
+
+(defthmd lognot-shift
+  (implies (and (integerp x)
+                (natp k))
+           (equal (lognot (* (expt 2 k) x))
+		  (+ (* (expt 2 k) (lognot x))
+		     (1- (expt 2 k))))))
+
+(defthmd logand-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logand (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logand x y)))))
+
+(defthmd logxor-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logxor (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logxor x y)))))
+
+(defthmd logior-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logior (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logior x y)))))
+
+(defthmd fl-lognot
+    (implies (case-split (integerp i))
+	     (= (fl (* 1/2 (lognot i)))
+                (lognot (fl (* 1/2 i))))))
+
+(defthmd fl-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logand x y) (expt 2 k)))
+                  (logand (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logior x y) (expt 2 k)))
+                  (logior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logxor
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logxor x y) (expt 2 k)))
+                  (logxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lognot-lognot
+    (implies (case-split (integerp i))
+	     (equal (lognot (lognot i))
+		    i)))
+
+(defthm logand-x-0
+    (equal (logand x 0) 0))
+
+(defthm logand-0-y
+    (equal (logand 0 y) 0))
+
+(defthm logior-x-0
+    (implies (integerp x)
+	     (equal (logior x 0) x)))
+
+(defthm logior-0-y
+    (implies (integerp y)
+	     (equal (logior 0 y) y)))
+
+(defthm logxor-x-0
+    (implies (integerp x)
+	     (equal (logxor x 0) x)))
+
+(defthm logxor-0-y
+    (implies (integerp y)
+	     (equal (logxor 0 y) y)))
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logior-self
+    (implies (case-split (integerp i))
+	     (equal (logior i i) i)))
+
+(defthm logxor-self
+  (equal (logxor i i) 0))
+
+(defthm logand-x-m1
+    (implies (integerp x)
+	     (equal (logand x -1) x)))
+
+(defthm logand-m1-y
+    (implies (integerp y)
+	     (equal (logand -1 y) y)))
+
+(defthm logand-x-1
+    (implies (bvecp x 1)
+	     (equal (logand x 1) x)))
+
+(defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x)))
+
+(defthm logior-x-m1
+    (implies (integerp x)
+	     (equal (logior x -1) -1)))
+
+(defthm logior-m1-y
+    (implies (integerp y)
+	     (equal (logior -1 y) -1)))
+
+(defthm logior-1-x
+  (implies (bvecp x 1)
+           (equal (logior 1 x) 1)))
+
+;;; not really necessary. 
+(defthm logior-x-1
+  (implies (bvecp x 1)
+           (equal (logior x 1) 1)))
+
+(defthm logxor-m1
+    (implies (integerp x)
+	     (equal (logxor x -1)
+		    (lognot x))))
+
+(defthm logand-commutative
+    (equal (logand j i) (logand i j)))
+
+(defthm logior-commutative
+    (equal (logior j i) (logior i j)))
+
+(defthm logxor-commutative
+    (equal (logxor j i) (logxor i j)))
+
+(defthm logand-associative
+    (equal (logand (logand i j) k)
+           (logand i (logand j k))))
+
+(defthm logior-associative
+    (equal (logior (logior i j) k)
+	   (logior i (logior j k))))
+
+(defthm logxor-associative
+    (equal (logxor (logxor i j) k)
+	   (logxor i (logxor j k))))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+	 (logand i j k)))
+
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+	 (logior i j k)))
+
+(defthm logxor-commutative-2
+  (equal (logxor j i k)
+	 (logxor i j k)))
+
+(defthmd lognot-logxor
+  (and (equal (logxor (lognot i) j)
+              (lognot (logxor i j)))
+       (equal (logxor j (lognot i))
+              (lognot (logxor i j)))))
+
+
+(defthmd logior-logand-g
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logior x (logand y z))
+	   (logand (logior x y) (logior x z)))))
+
+(defthmd logand-logior-g
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logand x (logior y z))
+                  (logior (logand x y) (logand x z)))))
+
+(defthmd logior-logand-2
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logand  (logior y z) x)
+                  (logior (logand y x) (logand z x)))))
+
+(defthmd log3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+	   (logior (logand x y) (logand (logxor x y) z)))))
+
+(defthmd logxor-rewrite-2-g
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (logxor x y)
+                  (logior (logand x (lognot y))
+                          (logand y (lognot x))))))
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,564 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib2/basic") ;; no change from rel8 
+
+(include-book "bits")
+
+(local (include-book "log-new"))
+
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+          
+ 
+
+
+;;;**********************************************************************
+;;;                       LOGNOT, LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+(in-theory (disable lognot logand logior logxor))
+
+(defthmd lognot-def
+    (implies (integerp x)
+	     (equal (lognot x)
+		    (1- (- x)))))
+
+(defthmd logand-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logand i j)
+		    (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logand (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+
+(defthmd logior-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logior i j)
+		    (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+
+
+(defthmd logxor-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logxor i j)
+		    (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+
+
+(defthm logand-natp
+    (implies (and (natp i)
+		  (integerp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logand-natp-2
+    (implies (and (integerp i)
+		  (natp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+
+(defthm logand-bvecp
+    (implies (and (natp n)
+		  (bvecp x n)
+		  (integerp y))
+	     (bvecp (logand x y) n))
+    :hints (("Goal" :by logand-bvecp-g)))
+
+(defthm logior-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logior i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logior-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n))
+	     (bvecp (logior x y) n)))
+
+(defthm logxor-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logxor i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n))
+	     (bvecp (logxor x y) n)))
+
+;;;;;;
+
+
+(defun logop-2-induct-g (x y)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)))))
+  (if (and (integerp x) (integerp y))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1)))
+          t
+        (logop-2-induct-g (fl (/ x 2)) (fl (/ y 2))))
+    t))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+
+(defun logop-3-induct-g (x y z)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)) (nfix (abs z)))))
+  (if (and (integerp x) (integerp y) (integerp z))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1))
+               (or (equal z 0)
+                   (equal z -1)))
+	  t
+	(logop-3-induct-g (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+
+(defthmd logand-fl-2-rewrite
+    (implies (and (natp x)
+		  (natp y))
+	     (equal (fl (* 1/2 (logand x y)))
+		    (logand (fl (* 1/2 x)) (fl (* 1/2 y))))))
+
+(defthmd logior-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logior i j)))
+		    (logior (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthmd logxor-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logxor i j)))
+		    (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+
+(defthm logior-not-0
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (logior x y) 0))
+	     (and (= x 0) (= y 0)))
+  :rule-classes ())
+
+(defthm logior-expt
+    (implies (and (natp n)
+		  (integerp x)
+		  (bvecp y n))
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-g)))
+
+(defthm logior-expt-2
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logior (* (expt 2 n) x)
+			(* (expt 2 n) y))
+		(* (expt 2 n) (logior x y))))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-2-g)))
+
+
+(defthm logand-bnd
+    (implies (<= 0 x)
+	     (<= (logand x y) x))
+  :rule-classes :linear)
+
+(defthm logand-expt
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logand (* (expt 2 n) x) y)
+		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+  :rule-classes ()
+  :hints (("Goal" :by logand-expt-g)))
+
+
+(defthmd bitn-lognot
+    (implies (and (integerp x)
+		  (integerp n)
+		  (> n 0))
+	     (not (equal (bitn (lognot x) n)
+			 (bitn x n))))
+    :hints (("Goal" :use bitn_alt-lognot)))
+
+(defthmd bitn-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logand x y) n)
+		    (logand (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logand)))
+
+
+(defthmd bits-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logand x y) i j)
+		    (logand (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logand)))
+
+
+
+(defthmd bitn-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logior x y) n)
+		    (logior (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logior)))
+
+
+(defthmd bits-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logior x y) i j)
+		    (logior (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logior)))
+
+
+(defthmd bitn-logxor
+    (implies (and (case-split (integerp x))
+		  (case-split (integerp y))
+		  (case-split (integerp n)))
+	     (equal (bitn (logxor x y) n)
+		    (logxor (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logxor)))
+
+(defthmd bits-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (bits (logxor x y) i j)
+                  (logxor (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logxor)))
+
+(defthmd logand-expt-2
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logand x (expt 2 k))
+		    (* (expt 2 k) (bitn x k))))
+    :hints (("Goal" :use logand-expt-2-g)))
+
+(defthmd logior-expt-3
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logior x (expt 2 k))
+		    (+ x
+		       (* (expt 2 k) 
+			  (- 1 (bitn x k))))))
+    :hints (("Goal" :use ((:instance logior-expt-3-g)))))
+
+(defthmd logand-expt-3
+    (implies (and (integerp x)
+		  (natp n)
+		  (natp k)
+		  (< k n))
+	     (equal (logand x (- (expt 2 n) (expt 2 k)))
+		    (* (expt 2 k) (bits x (1- n) k))))
+    :hints (("Goal" :use ((:instance logand-expt-3-g)))))
+
+(defthmd logand-expt-4
+    (implies (and (natp n)
+		  (natp k)
+		  (natp l)
+		  (< l k)
+		  (<= k n))
+	     (equal (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+		    (- (expt 2 n) (expt 2 k))))
+    :hints (("Goal" :use ((:instance logand-expt-4-g)))))
+
+(defthmd lognot-shift
+  (implies (and (integerp x)
+                (natp k))
+           (equal (lognot (* (expt 2 k) x))
+		  (+ (* (expt 2 k) (lognot x))
+		     (1- (expt 2 k))))))
+
+(defthmd logand-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logand (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logand x y)))))
+
+(defthmd logxor-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logxor (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logxor x y)))))
+
+(defthmd logior-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logior (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logior x y)))))
+
+(defthmd fl-lognot
+    (implies (case-split (integerp i))
+	     (= (fl (* 1/2 (lognot i)))
+                (lognot (fl (* 1/2 i))))))
+
+(defthmd fl-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logand x y) (expt 2 k)))
+                  (logand (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logior x y) (expt 2 k)))
+                  (logior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logxor
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logxor x y) (expt 2 k)))
+                  (logxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lognot-lognot
+    (implies (case-split (integerp i))
+	     (equal (lognot (lognot i))
+		    i)))
+
+(defthm logand-x-0
+    (equal (logand x 0) 0))
+
+(defthm logand-0-y
+    (equal (logand 0 y) 0))
+
+(defthm logior-x-0
+    (implies (integerp x)
+	     (equal (logior x 0) x)))
+
+(defthm logior-0-y
+    (implies (integerp y)
+	     (equal (logior 0 y) y)))
+
+(defthm logxor-x-0
+    (implies (integerp x)
+	     (equal (logxor x 0) x)))
+
+(defthm logxor-0-y
+    (implies (integerp y)
+	     (equal (logxor 0 y) y)))
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logior-self
+    (implies (case-split (integerp i))
+	     (equal (logior i i) i)))
+
+(defthm logxor-self
+  (equal (logxor i i) 0))
+
+(defthm logand-x-m1
+    (implies (integerp x)
+	     (equal (logand x -1) x)))
+
+(defthm logand-m1-y
+    (implies (integerp y)
+	     (equal (logand -1 y) y)))
+
+(defthm logand-x-1
+    (implies (bvecp x 1)
+	     (equal (logand x 1) x)))
+
+(defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x)))
+
+(defthm logior-x-m1
+    (implies (integerp x)
+	     (equal (logior x -1) -1)))
+
+(defthm logior-m1-y
+    (implies (integerp y)
+	     (equal (logior -1 y) -1)))
+
+
+(defthm logior-x-1
+    (implies (bvecp x 1)
+	     (equal (logior x 1) 1)))
+
+(defthm logior-1-x
+    (implies (bvecp x 1)
+	     (equal (logior 1 x) 1)))
+
+
+(defthm logxor-m1
+    (implies (integerp x)
+	     (equal (logxor x -1)
+		    (lognot x))))
+
+(defthm logand-commutative
+    (equal (logand j i) (logand i j)))
+
+(defthm logior-commutative
+    (equal (logior j i) (logior i j)))
+
+(defthm logxor-commutative
+    (equal (logxor j i) (logxor i j)))
+
+(defthm logand-associative
+    (equal (logand (logand i j) k)
+           (logand i (logand j k))))
+
+(defthm logior-associative
+    (equal (logior (logior i j) k)
+	   (logior i (logior j k))))
+
+(defthm logxor-associative
+    (equal (logxor (logxor i j) k)
+	   (logxor i (logxor j k))))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+	 (logand i j k)))
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+	 (logior i j k)))
+
+(defthm logxor-commutative-2
+  (equal (logxor j i k)
+	 (logxor i j k)))
+
+(defthmd lognot-logxor
+    (and (equal (logxor (lognot i) j)
+                (lognot (logxor i j)))
+         (EQUAL (LOGXOR J (LOGNOT I))
+                (LOGNOT (LOGXOR I J)))))
+    
+	   
+
+(defthmd logior-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z))))
+  :hints (("Goal" :by logior-logand-g)))
+
+(defthmd logand-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand x (logior y z))
+	   (logior (logand x y) (logand x z))))
+  :hints (("Goal" :by logand-logior-g)))
+
+
+(defthmd logior-logand-2
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand  (logior y z) x)
+	   (logior (logand y x) (logand z x)))))
+
+(defthmd log3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+	   (logior (logand x y) (logand (logxor x y) z)))))
+
+(defthmd logxor-rewrite-2
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (logxor x y)
+                  (logior (logand x (lognot y))
+                          (logand y (lognot x)))))
+  :hints (("Goal" :by logxor-rewrite-2-g)))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-support-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-support-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-support-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-support-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,463 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib2/top")
+
+(include-book "bits-new")
+
+(local (include-book "../../arithmetic/top"))
+;;;
+;;;
+
+(local 
+ (encapsulate () 
+              (local (include-book "bits-new-proofs"))
+
+             (defthm bits_alt-is-bits
+               (equal (bits_alt x i j)
+                      (bits x i j)))
+
+             
+             (defthm bitn_alt-is-bitn
+               (equal (bitn_alt x n)
+                      (bitn x n)))
+
+
+             (defthm binary-cat_alt-is-binary-cat
+               (equal (binary-cat_alt x m y n)
+                      (binary-cat x m y n)))
+
+             ))
+               
+
+;;;;;;;;;
+
+
+(local 
+ (defund bvequal (v1 v2 n)
+  (equal (sumbits v1 n)
+         (sumbits v2 n))))
+
+
+(local
+ (defthm bvequal-then-equal
+  (implies (and (bvequal x y n)
+                (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal x y))
+  :hints (("Goal" :use ((:instance sumbits-thm
+                                   (x x))
+                        (:instance sumbits-thm
+                                   (x y)))
+           :in-theory (enable bvequal)))
+  :rule-classes nil))
+
+(local 
+ (encapsulate () 
+              (local (include-book "log-new"))
+              
+              
+              (defthmd bitn-lognot-g
+                (implies (and (integerp x)
+                              (integerp n)
+                              (>= n 0))
+                         (not (equal (bitn (lognot x) n)
+                                     (bitn x n))))
+                :hints (("Goal" :cases ((equal n 0)))
+                        ("Subgoal 2" :use ((:instance bitn_alt-lognot)))
+                        ("Subgoal 1" :in-theory (e/d (lognot bitn-def mod)
+                                                     ()))))
+              ))
+
+
+
+
+(local 
+ (defthmd bitn-lnot-lognot-bvequal-lemma
+   (implies (and (integerp x)
+                 (natp n)
+                 (> n 0)
+                 (natp n)
+                 (natp i)
+                 (<= i (+ -1 n)))
+            (equal (bitn (lnot x n) i)
+                   (bitn (bits (lognot x) (+ -1 n) 0) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-lnot) ())
+            :use ((:instance bitn-lognot-g
+                             (n i))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n i)))))))
+
+
+(local 
+ (defthm lnot-lognot-bvequal
+   (implies (and (integerp x)
+                 (natp n)
+                 (> n 0)
+                 (natp n)
+                 (natp i)
+                 (<= i n))
+            (bvequal (lnot x n)
+                     (bits (lognot x) (+ -1 n) 0)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal bitn-lnot-lognot-bvequal-lemma) (bitn-bits))))))
+
+
+
+(defthm lnot-lognot
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x))
+           (equal (lnot x n)
+                  (bits (lognot x) (+ -1 n) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (lnot x n))
+                                   (y (bits (lognot x) (+ -1 n) 0))
+                                   (n n)))
+           :in-theory (e/d (lnot-lognot-bvequal) ()))))
+
+
+
+
+
+
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "log-new-proofs"))
+              
+              (defthmd bitn_alt-logand
+                (implies (and (integerp x)
+                              (integerp y)
+                              (integerp n))
+                         (equal (bitn_alt (logand x y) n)
+                                (logand (bitn_alt x n) (bitn_alt y n)))))
+              ))
+
+
+
+(local 
+ (defthmd bitn-land-logand-bvequal-lemma
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i (+ -1 n)))
+            (equal (bitn (land x y n) i)
+                   (bitn (bits (logand x y) (+ -1 n)  0) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-land) ())
+            :use ((:instance bitn_alt-logand
+                             (n i))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n i))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n i)))))))
+
+
+
+
+(local 
+ (defthmd land-logand-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i n))
+            (bvequal (land x y n) 
+                     (bits (logand x y) (+ -1 n)  0)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal bitn-land-logand-bvequal-lemma)
+                                   ())))))
+
+
+
+
+(defthmd land-logand
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x)
+                (integerp y))
+           (equal (land x y n)
+                  (bits (logand x y) (+ -1 n) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (land x y n))
+                                   (y (bits (logand x y) (+ -1 n) 0))
+                                   (n n)))
+           :in-theory (e/d (land-logand-bvequal) ()))))
+
+
+
+
+;;;;;
+
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "log-new-proofs"))
+              
+              (defthmd bitn_alt-logxor
+                (implies (and (case-split (integerp x))
+                              (case-split (integerp y))
+                              (case-split (integerp n)))
+                         (equal (bitn_alt (logxor x y) n)
+                                (logxor (bitn_alt x n) (bitn_alt y n)))))
+              ))
+
+
+
+(local 
+ (defthmd bitn-lxor-logxor-bvequal-lemma
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i (+ -1 n)))
+            (equal (bitn (lxor x y n) i)
+                   (bitn (bits (logxor x y) (+ -1 n)  0) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-lxor) ())
+            :use ((:instance bitn_alt-logxor
+                             (n i))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n i))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n i)))))))
+
+
+
+
+(local 
+ (defthmd lxor-logxor-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i n))
+            (bvequal (lxor x y n) 
+                     (bits (logxor x y) (+ -1 n)  0)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal bitn-lxor-logxor-bvequal-lemma)
+                                   ())))))
+
+
+(defthmd lxor-logxor
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x)
+                (integerp y))
+           (equal (lxor x y n)
+                  (bits (logxor x y) (+ -1 n) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (lxor x y n))
+                                   (y (bits (logxor x y) (+ -1 n) 0))
+                                   (n n)))
+           :in-theory (e/d (lxor-logxor-bvequal) ()))))
+
+
+;;;;;;
+
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "log-new-proofs"))
+              
+              (defthmd bitn_alt-logior
+                (implies (and (integerp x)
+                              (integerp y)
+                              (integerp n))
+                         (equal (bitn_alt (logior x y) n)
+                                (logior (bitn_alt x n) (bitn_alt y n)))))
+              ))
+
+
+
+(local 
+ (defthmd bitn-lior-logior-bvequal-lemma
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i (+ -1 n)))
+            (equal (bitn (lior x y n) i)
+                   (bitn (bits (logior x y) (+ -1 n)  0) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-lior) ())
+            :use ((:instance bitn_alt-logior
+                             (n i))
+                  (:instance bitn-0-1
+                             (x x)
+                             (n i))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n i)))))))
+
+
+
+
+(local 
+ (defthmd lior-logior-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (> n 0)
+                 (natp i)
+                 (<= i n))
+            (bvequal (lior x y n) 
+                     (bits (logior x y) (+ -1 n)  0)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal bitn-lior-logior-bvequal-lemma)
+                                   ())))))
+
+
+(defthmd lior-logior
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x)
+                (integerp y))
+           (equal (lior x y n)
+                  (bits (logior x y) (+ -1 n) 0)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (lior x y n))
+                                   (y (bits (logior x y) (+ -1 n) 0))
+                                   (n n)))
+           :in-theory (e/d (lior-logior-bvequal) ()))))
+
+
+
+;;;;;
+;;;;;
+
+
+
+(local 
+ (defthmd bitn-logand-logand-bvequal-lemma
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (natp i)
+                 (<= i n))
+            (equal (bitn (logand (bits x n 0)
+                                 y) i)
+                   (bitn (logand x y) i)))
+   :hints (("Goal" :in-theory (e/d (bitn-bits) ())
+            :use ((:instance bitn_alt-logand
+                             (x (bits x n 0))
+                             (y y)
+                             (n i))
+                  (:instance bitn_alt-logand
+                             (x x)
+                             (y y)
+                             (n i)))))))
+
+
+
+
+(local 
+ (defthmd logand-logand-bvequal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (natp n)
+                 (natp i)
+                 (<= i (+ 1 n)))
+            (bvequal (logand (bits x n 0) y)
+                     (logand x y)
+                     i))
+   :hints (("Goal" :in-theory (e/d (bvequal 
+                                    bitn-logand-logand-bvequal-lemma)
+                                   ())))))
+
+
+
+(local 
+ (encapsulate () 
+   (local (include-book "log-new"))
+   
+   (defthm logand-bvecp-g
+     (implies (and (natp n)
+                   (bvecp x n)
+                   (integerp y))
+              (bvecp (logand x y) n))
+     :hints (("Goal" :use ((:instance logand-bnd))
+              :in-theory (e/d (bvecp) ()))))
+
+   (defthm logand-bvecp-g2
+     (implies (and (natp n)
+                   (bvecp y n)
+                   (integerp x))
+              (bvecp (logand x y) n))
+     :hints (("Goal" :use ((:instance logand-bvecp-g
+                                      (x y)
+                                      (y x))))))))
+
+
+
+(defthmd logand-bits-reduce
+  (implies (and (syntaxp (or (and (consp y)
+                                  (not (equal (car y) 'bits)))
+                             (symbolp y)))
+                (bvecp y (+ 1 n))
+                (natp n)
+                (integerp x))
+           (equal (logand (bits x n 0)
+                          y)
+                  (logand x y)))
+  :hints (("Goal" :use ((:instance bvequal-then-equal
+                                   (x (logand (bits x n 0)
+                                              y))
+                                   (y (logand x y))
+                                   (n (+ 1 n))))
+           :in-theory (e/d (logand-logand-bvequal) ()))))
+
+
+
+
+
+(defthmd logand-bitn-reduce
+  (implies (and (syntaxp (or (and (consp y)
+                                  (not (equal (car y) 'bitn)))
+                             (symbolp y)))
+                (bvecp y 1)
+                (integerp x))
+           (equal (logand (bitn x 0)
+                          y)
+                  (logand x y)))
+  :hints (("Goal" :use ((:instance logand-bits-reduce
+                                   (n 0)))
+           :in-theory (e/d (bitn) (bits-n-n-rewrite)))))
+                                   
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-support.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-support.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/log-support.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/log-support.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,93 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib2/top")
+
+(local (include-book "log-support-proofs"))
+
+
+(defthmd lnot-lognot
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x))
+           (equal (lnot x n)
+                  (bits (lognot x) (+ -1 n) 0))))
+
+
+
+(defthmd land-logand
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x)
+                (integerp y))
+           (equal (land x y n)
+                  (bits (logand x y) (+ -1 n) 0))))
+
+(defthmd lxor-logxor
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x)
+                (integerp y))
+           (equal (lxor x y n)
+                  (bits (logxor x y) (+ -1 n) 0))))
+
+
+(defthmd lior-logior
+  (implies (and (natp n)
+                (> n 0)
+                (integerp x)
+                (integerp y))
+           (equal (lior x y n)
+                  (bits (logior x y) (+ -1 n) 0))))
+
+
+
+
+(defthmd logand-bits-reduce
+  (implies (and (syntaxp (or (and (consp y)
+                                  (not (equal (car y) 'bits)))
+                             (symbolp y)))
+                (bvecp y (+ 1 n))
+                (natp n)
+                (integerp x))
+           (equal (logand (bits x n 0)
+                          y)
+                  (logand x y))))
+
+
+(defthmd logand-bitn-reduce
+  (implies (and (syntaxp (or (and (consp y)
+                                  (not (equal (car y) 'bitn)))
+                             (symbolp y)))
+                (bvecp y 1)
+                (integerp x))
+           (equal (logand (bitn x 0)
+                          y)
+                  (logand x y))))
+
+
+;;;;
+;;;;
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/log.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/log.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,538 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib2/basic") ;; no change from rel8 
+
+(include-book "bits")
+
+(local (include-book "log-proofs"))
+
+
+;(set-inhibit-warnings "theory") ; avoid warning in the next event
+;(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                       LOGNOT, LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+(in-theory (disable lognot logand logior logxor))
+
+(defthmd lognot-def
+    (implies (integerp x)
+	     (equal (lognot x)
+		    (1- (- x)))))
+
+(defthmd logand-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logand i j)
+		    (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logand (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+
+(defthmd logior-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logior i j)
+		    (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+
+
+(defthmd logxor-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logxor i j)
+		    (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+
+(defthm logand-natp
+    (implies (and (natp i)
+		  (integerp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logand-natp-2
+    (implies (and (integerp i)
+		  (natp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logand-bvecp
+    (implies (and (natp n)
+		  (bvecp x n)
+		  (integerp y))
+	     (bvecp (logand x y) n))
+    :hints (("Goal" :by logand-bvecp-g)))
+
+(defthm logior-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logior i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logior-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n))
+	     (bvecp (logior x y) n)))
+
+(defthm logxor-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logxor i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n))
+	     (bvecp (logxor x y) n)))
+
+;;;;;;
+
+
+(defun logop-2-induct-g (x y)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)))))
+  (if (and (integerp x) (integerp y))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1)))
+          t
+        (logop-2-induct-g (fl (/ x 2)) (fl (/ y 2))))
+    t))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+
+(defun logop-3-induct-g (x y z)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)) (nfix (abs z)))))
+  (if (and (integerp x) (integerp y) (integerp z))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1))
+               (or (equal z 0)
+                   (equal z -1)))
+	  t
+	(logop-3-induct-g (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+
+(defthmd logand-fl-2-rewrite
+    (implies (and (natp x)
+		  (natp y))
+	     (equal (fl (* 1/2 (logand x y)))
+		    (logand (fl (* 1/2 x)) (fl (* 1/2 y))))))
+
+(defthmd logior-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logior i j)))
+		    (logior (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthmd logxor-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logxor i j)))
+		    (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+
+(defthm logior-not-0
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (logior x y) 0))
+	     (and (= x 0) (= y 0)))
+  :rule-classes ())
+
+(defthm logior-expt
+    (implies (and (natp n)
+		  (integerp x)
+		  (bvecp y n))
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-g)))
+
+(defthm logior-expt-2
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logior (* (expt 2 n) x)
+			(* (expt 2 n) y))
+		(* (expt 2 n) (logior x y))))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-2-g)))
+
+
+(defthm logand-bnd
+    (implies (<= 0 x)
+	     (<= (logand x y) x))
+  :rule-classes :linear)
+
+(defthm logand-expt
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logand (* (expt 2 n) x) y)
+		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+  :rule-classes ()
+  :hints (("Goal" :by logand-expt-g)))
+
+
+(defthmd bitn-lognot
+    (implies (and (integerp x)
+		  (integerp n)
+		  (> n 0))
+	     (not (equal (bitn (lognot x) n)
+			 (bitn x n))))
+    :hints (("Goal" :use bitn_alt-lognot)))
+
+(defthmd bitn-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logand x y) n)
+		    (logand (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logand)))
+
+
+(defthmd bits-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logand x y) i j)
+		    (logand (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logand)))
+
+
+
+(defthmd bitn-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logior x y) n)
+		    (logior (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logior)))
+
+
+(defthmd bits-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logior x y) i j)
+		    (logior (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logior)))
+
+
+(defthmd bitn-logxor
+    (implies (and (case-split (integerp x))
+		  (case-split (integerp y))
+		  (case-split (integerp n)))
+	     (equal (bitn (logxor x y) n)
+		    (logxor (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logxor)))
+
+(defthmd bits-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (bits (logxor x y) i j)
+                  (logxor (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logxor)))
+
+(defthmd logand-expt-2
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logand x (expt 2 k))
+		    (* (expt 2 k) (bitn x k))))
+    :hints (("Goal" :use logand-expt-2-g)))
+
+(defthmd logior-expt-3
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logior x (expt 2 k))
+		    (+ x
+		       (* (expt 2 k) 
+			  (- 1 (bitn x k))))))
+    :hints (("Goal" :use ((:instance logior-expt-3-g)))))
+
+(defthmd logand-expt-3
+    (implies (and (integerp x)
+		  (natp n)
+		  (natp k)
+		  (< k n))
+	     (equal (logand x (- (expt 2 n) (expt 2 k)))
+		    (* (expt 2 k) (bits x (1- n) k))))
+    :hints (("Goal" :use ((:instance logand-expt-3-g)))))
+
+(defthmd logand-expt-4
+    (implies (and (natp n)
+		  (natp k)
+		  (natp l)
+		  (< l k)
+		  (<= k n))
+	     (equal (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+		    (- (expt 2 n) (expt 2 k))))
+    :hints (("Goal" :use ((:instance logand-expt-4-g)))))
+
+(defthmd lognot-shift
+  (implies (and (integerp x)
+                (natp k))
+           (equal (lognot (* (expt 2 k) x))
+		  (+ (* (expt 2 k) (lognot x))
+		     (1- (expt 2 k))))))
+
+(defthmd logand-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logand (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logand x y)))))
+
+(defthmd logxor-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logxor (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logxor x y)))))
+
+(defthmd logior-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logior (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logior x y)))))
+
+(defthmd fl-lognot
+    (implies (case-split (integerp i))
+	     (= (fl (* 1/2 (lognot i)))
+                (lognot (fl (* 1/2 i))))))
+
+(defthmd fl-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logand x y) (expt 2 k)))
+                  (logand (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logior x y) (expt 2 k)))
+                  (logior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logxor
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logxor x y) (expt 2 k)))
+                  (logxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lognot-lognot
+    (implies (case-split (integerp i))
+	     (equal (lognot (lognot i))
+		    i)))
+
+(defthm logand-x-0
+    (equal (logand x 0) 0))
+
+(defthm logand-0-y
+    (equal (logand 0 y) 0))
+
+(defthm logior-x-0
+    (implies (integerp x)
+	     (equal (logior x 0) x)))
+
+(defthm logior-0-y
+    (implies (integerp y)
+	     (equal (logior 0 y) y)))
+
+(defthm logxor-x-0
+    (implies (integerp x)
+	     (equal (logxor x 0) x)))
+
+(defthm logxor-0-y
+    (implies (integerp y)
+	     (equal (logxor 0 y) y)))
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logior-self
+    (implies (case-split (integerp i))
+	     (equal (logior i i) i)))
+
+(defthm logxor-self
+  (equal (logxor i i) 0))
+
+(defthm logand-x-m1
+    (implies (integerp x)
+	     (equal (logand x -1) x)))
+
+(defthm logand-m1-y
+    (implies (integerp y)
+	     (equal (logand -1 y) y)))
+
+(defthm logand-x-1
+    (implies (bvecp x 1)
+	     (equal (logand x 1) x)))
+
+(defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x)))
+
+(defthm logior-x-m1
+    (implies (integerp x)
+	     (equal (logior x -1) -1)))
+
+(defthm logior-m1-y
+    (implies (integerp y)
+	     (equal (logior -1 y) -1)))
+
+
+(defthm logior-x-1
+    (implies (bvecp x 1)
+	     (equal (logior x 1) 1)))
+
+(defthm logior-1-x
+    (implies (bvecp x 1)
+	     (equal (logior 1 x) 1)))
+
+
+(defthm logxor-m1
+    (implies (integerp x)
+	     (equal (logxor x -1)
+		    (lognot x))))
+
+(defthm logand-commutative
+    (equal (logand j i) (logand i j)))
+
+(defthm logior-commutative
+    (equal (logior j i) (logior i j)))
+
+(defthm logxor-commutative
+    (equal (logxor j i) (logxor i j)))
+
+(defthm logand-associative
+    (equal (logand (logand i j) k)
+           (logand i (logand j k))))
+
+(defthm logior-associative
+    (equal (logior (logior i j) k)
+	   (logior i (logior j k))))
+
+(defthm logxor-associative
+    (equal (logxor (logxor i j) k)
+	   (logxor i (logxor j k))))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+	 (logand i j k)))
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+	 (logior i j k)))
+
+(defthm logxor-commutative-2
+  (equal (logxor j i k)
+	 (logxor i j k)))
+
+(defthmd lognot-logxor
+    (and (equal (logxor (lognot i) j)
+                (lognot (logxor i j)))
+         (EQUAL (LOGXOR J (LOGNOT I))
+                (LOGNOT (LOGXOR I J)))))
+    
+	   
+
+(defthmd logior-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z))))
+  :hints (("Goal" :by logior-logand-g)))
+
+(defthmd logand-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand x (logior y z))
+	   (logior (logand x y) (logand x z))))
+  :hints (("Goal" :by logand-logior-g)))
+
+
+(defthmd logior-logand-2
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand  (logior y z) x)
+	   (logior (logand y x) (logand z x)))))
+
+(defthmd log3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+	   (logior (logand x y) (logand (logxor x y) z)))))
+
+(defthmd logxor-rewrite-2
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (logxor x y)
+                  (logior (logand x (lognot y))
+                          (logand y (lognot x)))))
+  :hints (("Goal" :by logxor-rewrite-2-g)))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1024 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "bits-new")
+(include-book "rtl-new")
+(local (include-book "../lib2/top"))
+
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "bits-new-proofs"))
+
+             (defthm bits_alt-is-bits
+               (equal (bits_alt x i j)
+                      (bits x i j)))
+
+             
+             (defthm bitn_alt-is-bitn
+               (equal (bitn_alt x n)
+                      (bitn x n)))
+
+
+             (defthm binary-cat_alt-is-binary-cat
+               (equal (binary-cat_alt x m y n)
+                      (binary-cat x m y n)))
+
+             ))
+               
+
+
+
+;;;**********************************************************************
+;;;                     LNOT_ALT
+;;;**********************************************************************
+
+(defund lnot_alt (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits_alt x (1- n) 0)))
+    0))
+
+(local 
+ (defthm lnot_alt-is-lnot
+   (equal (lnot_alt x n)
+          (lnot x n))
+   :hints (("Goal" :in-theory (e/d (lnot lnot_alt) ())))))
+
+(defthm lnot_alt-nonnegative-integer-type
+  (and (integerp (lnot_alt x n))
+       (<= 0 (lnot_alt x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot_alt x n))))
+
+(in-theory (disable (:type-prescription lnot_alt))) 
+
+(defthmd lnot_alt-bits_alt-1
+  (equal (lnot_alt (bits_alt x (1- n) 0) n)
+         (lnot_alt x n))
+  :hints (("Goal" :use lnot-bits-1)))
+
+(defthm lnot_alt-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot_alt x n) k)))
+
+(defthm lnot_alt-x-0
+  (equal (lnot_alt x 0) 0)
+  :hints (("Goal" :use lnot-x-0)))
+
+(defthmd lnot_alt-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot_alt (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot_alt x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n)))))
+  :hints (("Goal" :use lnot-shift)))
+
+(defthmd lnot_alt-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot_alt (* 2 x) n)
+                  (+ 1 (* 2 (lnot_alt x (1- n))))))
+  :hints (("Goal" :use lnot-shift-2)))
+
+(defthmd lnot_alt-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot_alt x (+ n k))))
+                  (lnot_alt (fl (/ x (expt 2 k))) n)))
+  :hints (("Goal" :use lnot-fl)))
+
+(defthm mod-lnot_alt
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot_alt x n) (expt 2 k))
+                  (lnot_alt (mod x (expt 2 k)) k)))
+  :hints (("Goal" :use mod-lnot)))
+
+(defthmd bits_alt-lnot_alt
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits_alt (lnot_alt x n) i j)
+                  (if (< i n)
+                      (lnot_alt (bits_alt x i j)
+                            (1+ (- i j)))
+                    (lnot_alt (bits_alt x (1- n) j)
+                          (- n j)))))
+  :hints (("Goal" :use bits-lnot)))
+
+(defthmd bitn_alt-lnot_alt
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn_alt (lnot_alt x n) k)
+		  (if (< k n)
+		      (lnot_alt (bitn_alt x k) 1)
+		    0)))
+  :hints (("Goal" :use bitn-lnot)))
+
+(defthmd lnot_alt-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot_alt (cat_alt x m y n) l)
+		  (cat_alt (lnot_alt x m) m (lnot_alt y n) n)))
+  :hints (("Goal" :use lnot-cat)))
+
+
+;;;**********************************************************************
+;;;                LAND_ALT, LIOR_ALT, and LXOR_ALT
+;;;**********************************************************************
+
+
+(defun lognop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun lognop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun lognop-3-induct (x y z)
+  (declare (xargs :measure (+ (nfix x) (nfix y) (nfix z))))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+(local (include-book "log-new"))
+
+(defund binary-land_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn_alt x 0) 1)
+                       (equal (bitn_alt y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land_alt (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+(local 
+ (defthm land_alt-is-land
+   (equal (binary-land_alt x y n)
+          (binary-land x y n))
+   :hints (("Goal" :in-theory (e/d (binary-land_alt
+                                    binary-land) ())))))
+
+(defmacro land_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land_alt ,@x))
+        (t         
+         `(binary-land_alt ,(car x)
+                       (land_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land_alt-nonnegative-integer-type
+  (and (integerp (land_alt x y n))
+       (<= 0 (land_alt x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land_alt)))
+
+(defund binary-lior_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn_alt x 0) 1)
+                      (equal (bitn_alt y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior_alt (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+(local 
+ (defthm lior_alt-is-lior
+   (equal (binary-lior_alt x y n)
+          (binary-lior x y n))
+   :hints (("Goal" :in-theory (e/d (binary-lior_alt
+                                    binary-lior) ())))))
+
+(defmacro lior_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior_alt x y n) -- the base case
+         `(binary-lior_alt ,@x))
+        (t         
+         `(binary-lior_alt ,(car x)
+                       (lior_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior_alt-nonnegative-integer-type
+  (and (integerp (lior_alt x y n))
+       (<= 0 (lior_alt x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior_alt)))
+
+(defund binary-lxor_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn_alt x 0) 1)
+                       (equal (bitn_alt y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor_alt (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+(local 
+ (defthm lxor_alt-is-lxor
+   (equal (binary-lxor_alt x y n)
+          (binary-lxor x y n))
+   :hints (("Goal" :in-theory (e/d (binary-lxor_alt
+                                    binary-lxor) ())))))
+
+
+(defmacro lxor_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor_alt ,@x))
+        (t         
+         `(binary-lxor_alt ,(car x)
+                       (lxor_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor_alt-nonnegative-integer-type
+  (and (integerp (lxor_alt x y n))
+       (<= 0 (lxor_alt x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor_alt)))
+
+;; (defun lognop-2-induct (x y)
+;;   (if (or (zp x) (zp y))
+;;       ()
+;;     (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+;; (defun lognop-2-n-induct (x y n)
+;;   (if (zp n)
+;;       (cons x y)
+;;     (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+;; (defun lognop-3-induct (x y z)
+;;   (declare (xargs :measure (:? x y z)))
+;;   (if (and (natp x) (natp y) (natp z))
+;;       (if (and (zp x) (zp y) (zp z))
+;; 	  t
+;; 	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+;;     t))
+
+(defthm land_alt-x-y-0
+    (equal (land_alt x y 0) 0)
+    :hints (("Goal" :use land-x-y-0)))
+
+(defthm lior_alt-x-y-0
+    (equal (lior_alt x y 0) 0)
+    :hints (("Goal" :use lior-x-y-0)))
+
+(defthm lxor_alt-x-y-0
+    (equal (lxor_alt x y 0) 0)
+    :hints (("Goal" :use lxor-x-y-0)))
+
+(defthmd land_alt-bits_alt-1
+  (equal (land_alt (bits_alt x (1- n) 0) y n)
+         (land_alt x y n))
+    :hints (("Goal" :use land-bits-1)))
+
+(defthmd land_alt-bits_alt-2
+  (equal (land_alt x (bits_alt y (1- n) 0) n)
+         (land_alt x y n))
+    :hints (("Goal" :use land-bits-2)))
+
+(defthmd lior_alt-bits_alt-1
+  (equal (lior_alt (bits_alt x (1- n) 0) y n)
+         (lior_alt x y n))
+    :hints (("Goal" :use lior-bits-1)))
+
+(defthmd lior_alt-bits_alt-2
+  (equal (lior_alt x (bits_alt y (1- n) 0) n)
+         (lior_alt x y n))
+    :hints (("Goal" :use lior-bits-2)))
+
+(defthmd lxor_alt-bits_alt-1
+  (equal (lxor_alt (bits_alt x (1- n) 0) y n)
+         (lxor_alt x y n))
+    :hints (("Goal" :use lxor-bits-1)))
+
+(defthmd lxor_alt-bits_alt-2
+  (equal (lxor_alt x (bits_alt y (1- n) 0) n)
+         (lxor_alt x y n))
+    :hints (("Goal" :use lxor-bits-2)))
+
+(defthm land_alt-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land_alt x y n) k))
+    :hints (("Goal" :use land-bvecp)))
+
+(defthm lior_alt-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior_alt x y n) k))
+    :hints (("Goal" :use lior-bvecp)))
+
+(defthm lxor_alt-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor_alt x y n) k))
+    :hints (("Goal" :use lxor-bvecp)))
+
+(defthm land_alt-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land_alt x y n) m))
+    :hints (("Goal" :use land-bvecp-2)))
+
+(defthm lior_alt-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior_alt x y n) m))
+    :hints (("Goal" :use lior-bvecp-2)))
+
+(defthm lxor_alt-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor_alt x y n) m))
+    :hints (("Goal" :use lxor-bvecp-2)))
+
+(defthmd land_alt-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land_alt x y m) (land_alt x y n)))
+    :hints (("Goal" :use land-reduce)))
+
+(defthmd lior_alt-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior_alt x y m) (lior_alt x y n)))
+    :hints (("Goal" :use lior-reduce)))
+
+(defthmd lxor_alt-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor_alt x y m) (lxor_alt x y n)))
+    :hints (("Goal" :use lxor-reduce)))
+
+(defthmd land_alt-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land_alt x y n)
+                  (+ (* 2 (land_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land_alt (bitn_alt x 0) (bitn_alt y 0) 1))))
+    :hints (("Goal" :use land-def)))
+
+(defthmd lior_alt-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior_alt x y n)
+                  (+ (* 2 (lior_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior_alt (bitn_alt x 0) (bitn_alt y 0) 1))))
+    :hints (("Goal" :use lior-def)))
+
+(defthmd lxor_alt-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor_alt x y n)
+                  (+ (* 2 (lxor_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor_alt (bitn_alt x 0) (bitn_alt y 0) 1))))
+    :hints (("Goal" :use lxor-def)))
+
+(defthm land_alt-0
+  (equal (land_alt 0 y n)
+	 0)
+    :hints (("Goal" :use land-0)))
+
+(defthmd land_alt-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land_alt i j 1))
+		  (or (equal i 0)
+		      (equal j 0))))
+    :hints (("Goal" :use land-equal-0)))
+
+(defthm lior_alt-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior_alt 0 y n) y))
+    :hints (("Goal" :use lior-0)))
+
+(defthmd lior_alt-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior_alt x y n))
+		  (and (equal x 0)
+		       (equal y 0))))
+    :hints (("Goal" :use lior-equal-0)))
+
+(defthm lxor_alt-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor_alt 0 y n) y))
+    :hints (("Goal" :use lxor-0)))
+
+(defthm land_alt-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land_alt (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land_alt x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use land-shift)))
+
+(defthm lxor_alt-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor_alt (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor_alt x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use lxor-shift)))
+
+(defthm lior_alt-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior_alt (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior_alt x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use lior-shift)))
+
+(defthmd fl-land_alt
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land_alt x y (+ n k)) (expt 2 k)))
+                  (land_alt (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-land)))
+
+(defthmd fl-lior_alt
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior_alt x y (+ n k)) (expt 2 k)))
+                  (lior_alt (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-lior)))
+
+(defthmd fl-lxor_alt
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor_alt x y (+ n k)) (expt 2 k)))
+                  (lxor_alt (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-lxor)))
+
+(defthmd mod-land_alt
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land_alt x y n) (expt 2 k))
+                  (land_alt x y k)))
+  :hints (("Goal" :use mod-land)))
+
+(defthmd mod-lior_alt
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior_alt x y n) (expt 2 k))
+                  (lior_alt x y k)))
+  :hints (("Goal" :use mod-lior)))
+
+(defthmd mod-lxor_alt
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor_alt x y n) (expt 2 k))
+                  (lxor_alt x y k)))
+  :hints (("Goal" :use mod-lxor)))
+
+(defthm bits_alt-land_alt
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits_alt (land_alt x y n) i j)
+		  (land_alt (bits_alt x i j) 
+			(bits_alt y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits-land)))
+
+(defthm bits_alt-lior_alt
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits_alt (lior_alt x y n) i j)
+		  (lior_alt (bits_alt x i j) 
+			(bits_alt y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits-lior)))
+
+(defthm bits_alt-lxor_alt
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits_alt (lxor_alt x y n) i j)
+		  (lxor_alt (bits_alt x i j) 
+			(bits_alt y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits-lxor)))
+
+(defthm bitn_alt-land_alt
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn_alt (land_alt x y n) k)
+		  (if (< k n)
+		      (land_alt (bitn_alt x k) 
+			    (bitn_alt y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn-land)))
+
+(defthm bitn_alt-lior_alt
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn_alt (lior_alt x y n) k)
+		  (if (< k n)
+		      (lior_alt (bitn_alt x k) 
+			    (bitn_alt y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn-lior)))
+
+(defthm bitn_alt-lxor_alt
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn_alt (lxor_alt x y n) k)
+		  (if (< k n)
+		      (lxor_alt (bitn_alt x k) 
+			    (bitn_alt y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn-lxor)))
+
+(defthmd land_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land_alt (cat_alt x1 m y1 n) (cat_alt x2 m y2 n) l)
+		  (cat_alt (land_alt x1 x2 m) m (land_alt y1 y2 n) n)))
+  :hints (("Goal" :use land-cat)))
+
+(defthm land_alt-cat_alt-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land_alt c (cat_alt x2 m y2 n) l)
+		  (cat_alt (land_alt (bits_alt c (+ -1 m n) n) x2 m)
+		       m
+		       (land_alt (bits_alt c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use land-cat-constant)))
+
+(defthmd lior_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior_alt (cat_alt x1 m y1 n) (cat_alt x2 m y2 n) l)
+		  (cat_alt (lior_alt x1 x2 m) m (lior_alt y1 y2 n) n)))
+  :hints (("Goal" :use lior-cat)))
+
+(defthm lior_alt-cat_alt-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior_alt c (cat_alt x2 m y2 n) l)
+		  (cat_alt (lior_alt (bits_alt c (+ -1 m n) n) x2 m)
+		       m
+		       (lior_alt (bits_alt c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use lior-cat-constant)))
+
+(defthmd lxor_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor_alt (cat_alt x1 m y1 n) (cat_alt x2 m y2 n) l)
+		  (cat_alt (lxor_alt x1 x2 m) m (lxor_alt y1 y2 n) n)))
+  :hints (("Goal" :use lxor-cat)))
+
+(defthm lxor_alt-cat_alt-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor_alt c (cat_alt x2 m y2 n) l)
+		  (cat_alt (lxor_alt (bits_alt c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor_alt (bits_alt c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use lxor-cat-constant)))
+
+(defthm land_alt-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land_alt x y n) x))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use land-bnd)))
+
+(defthm lior_alt-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior_alt x y n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use lior-bnd)))
+
+(defthm lxor_alt-bnd
+  (<= (lxor_alt x y n) (lior_alt x y n))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use lxor-bnd)))
+
+(defthmd lior_alt-plus
+  (implies (= (land_alt x y n) 0)
+           (equal (lior_alt x y n)
+                  (+ (bits_alt x (1- n) 0)
+                     (bits_alt y (1- n) 0))))
+  :hints (("Goal" :use lior-plus)))
+
+(defthmd land_alt-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land_alt (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land_alt x (bits_alt y (1- n) m) (+ n (-
+                                                                        m))))))
+  :hints (("Goal" :use land-with-shifted-arg)))
+
+(defthm lior_alt-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior_alt (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :use lior-with-shifted-arg)))
+
+(defthmd land_alt-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land_alt x (expt 2 k) n)
+		  (* (expt 2 k) (bitn_alt x k))))
+  :hints (("Goal" :use land-expt)))
+
+(defthm lior_alt-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior_alt x (expt 2 k) n)
+		(+ (bits_alt x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn_alt x k))))))
+  :rule-classes ()
+  :hints (("Goal" :use lior-expt)))
+
+(defthmd lxor_alt-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor_alt x (expt 2 k) n)
+		  (+ (bits_alt x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn_alt x k)))))))
+  :hints (("Goal" :use lxor-expt)))
+
+(defthm land_alt-ones
+  (equal (land_alt (1- (expt 2 n)) x n)
+	 (bits_alt x (1- n) 0))
+  :rule-classes nil
+  :hints (("Goal" :use land-ones)))
+
+(defthm land_alt-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land_alt k x n)
+		  (bits_alt x (1- n) 0)))
+  :hints (("Goal" :use land-ones-rewrite)))
+
+(defthm lior_alt-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior_alt (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use lior-ones)))
+
+(defthm lior_alt-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior_alt k x n)
+		  (1- (expt 2 n))))
+  :hints (("Goal" :use lior-ones-rewrite)))
+
+(defthm lxor_alt-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor_alt (1- (expt 2 n)) x n)
+		  (lnot_alt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use lxor-ones)))
+
+(defthm lxor_alt-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor_alt k x n)
+		  (lnot_alt x n)))
+  :hints (("Goal" :use lxor-ones-rewrite)))
+
+(defthm land_alt-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land_alt x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits_alt x (1- i) j))))
+  :rule-classes ()
+  :hints (("Goal" :use land-slice)))
+
+(defthmd lior_alt-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior_alt x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat_alt (bits_alt x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits_alt x (1- j) 0)     j)))
+  :hints (("Goal" :use lior-slice)))
+
+(defthmd lxor_alt-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor_alt x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat_alt (bits_alt x (1- n) i) (- n i)
+                       (lnot_alt (bits_alt x (1- i) j) (- i j)) (- i j)
+                       (bits_alt x (1- j) 0) j)))
+  :hints (("Goal" :use lxor-slice)))
+
+(defthmd land_alt-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land_alt (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k)))))
+  :hints (("Goal" :use land-slices)))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot_alt-lnot_alt
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot_alt (lnot_alt x n) n)
+		  x))
+    :hints (("Goal" :use lnot-lnot)))
+
+(defthm land_alt-commutative
+  (equal (land_alt y x n)
+	 (land_alt x y n))
+    :hints (("Goal" :use land-commutative)))
+
+(defthm lior_alt-commutative
+  (equal (lior_alt y x n)
+	 (lior_alt x y n))
+    :hints (("Goal" :use lior-commutative)))
+
+(defthm lxor_alt-commutative
+  (equal (lxor_alt y x n)
+	 (lxor_alt x y n))
+    :hints (("Goal" :use lxor-commutative)))
+
+(defthm land_alt-associative
+  (equal (land_alt (land_alt x y n) z n)
+	 (land_alt x (land_alt y z n) n))
+    :hints (("Goal" :use land-associative)))
+
+(defthm lior_alt-associative
+  (equal (lior_alt (lior_alt x y n) z n)
+	 (lior_alt x (lior_alt y z n) n))
+    :hints (("Goal" :use lior-associative)))
+
+(defthm lxor_alt-associative
+  (equal (lxor_alt (lxor_alt x y n) z n)
+	 (lxor_alt x (lxor_alt y z n) n))
+    :hints (("Goal" :use lxor-associative)))
+
+(defthm land_alt-commutative-2
+  (equal (land_alt y (land_alt x z n) n)
+	 (land_alt x (land_alt y z n) n))
+    :hints (("Goal" :use land-commutative-2)))
+
+(defthm lior_alt-commutative-2
+  (equal (lior_alt y (lior_alt x z n) n)
+	 (lior_alt x (lior_alt y z n) n))
+    :hints (("Goal" :use lior-commutative-2)))
+
+(defthm lxor_alt-commutative-2
+  (equal (lxor_alt y (lxor_alt x z n) n)
+	 (lxor_alt x (lxor_alt y z n) n))
+    :hints (("Goal" :use lxor-commutative-2)))
+
+(defthm land_alt-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land_alt x (land_alt y z n) n)
+		  (land_alt (land_alt x y n) z n)))
+    :hints (("Goal" :use land-combine-constants)))
+
+(defthm lior_alt-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior_alt x (lior_alt y z n) n)
+		  (lior_alt (lior_alt x y n) z n)))
+    :hints (("Goal" :use lior-combine-constants)))
+
+(defthm lxor_alt-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor_alt x (lxor_alt y z n) n)
+		  (lxor_alt (lxor_alt x y n) z n)))
+    :hints (("Goal" :use lxor-combine-constants)))
+
+(defthm land_alt-self
+  (equal (land_alt x x n)
+	 (bits_alt x (1- n) 0))
+    :hints (("Goal" :use land-self)))
+
+(defthm lior_alt-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior_alt x x n) x))
+    :hints (("Goal" :use lior-self)))
+
+(defthm lxor_alt-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor_alt x x n) 0))
+    :hints (("Goal" :use lxor-self)))
+
+(defthmd lior_alt-land_alt-1
+  (equal (lior_alt x (land_alt y z n) n)
+	 (land_alt (lior_alt x y n) (lior_alt x z n) n))
+    :hints (("Goal" :use lior-land-1)))
+
+(defthmd lior_alt-land_alt-2
+  (equal (lior_alt (land_alt y z n) x n)
+	 (land_alt (lior_alt x y n) (lior_alt x z n) n))
+    :hints (("Goal" :use lior-land-2)))
+
+(defthmd land_alt-lior_alt-1
+  (equal (land_alt x (lior_alt y z n) n)
+	 (lior_alt (land_alt x y n) (land_alt x z n) n))
+    :hints (("Goal" :use land-lior-1)))
+
+(defthmd land_alt-lior_alt-2
+  (equal (land_alt (lior_alt y z n) x n)
+	 (lior_alt (land_alt x y n) (land_alt x z n) n))
+    :hints (("Goal" :use land-lior-2)))
+
+(defthmd lior_alt-land_alt-lxor_alt
+  (equal (lior_alt (land_alt x y n) (lior_alt (land_alt x z n) (land_alt y z n) n) n)
+	 (lior_alt (land_alt x y n) (land_alt (lxor_alt x y n) z n) n))
+    :hints (("Goal" :use lior-land-lxor)))
+
+(defthmd lxor_alt-rewrite
+  (equal (lxor_alt x y n)
+	 (lior_alt (land_alt x (lnot_alt y n) n)
+	       (land_alt y (lnot_alt x n) n)
+	       n))
+    :hints (("Goal" :use lxor-rewrite)))
+
+(defthmd lnot_alt-lxor_alt
+  (equal (lnot_alt (lxor_alt x y n) n)
+	 (lxor_alt (lnot_alt x n) y n))
+    :hints (("Goal" :use lnot-lxor)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,981 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "bits-new")
+(include-book "rtl-new")
+(local (include-book "logn-new-proofs"))
+
+
+;;;**********************************************************************
+;;;                     LNOT_ALT
+;;;**********************************************************************
+
+(defund lnot_alt (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits_alt x (1- n) 0)))
+    0))
+
+
+
+(defthm lnot_alt-nonnegative-integer-type
+  (and (integerp (lnot_alt x n))
+       (<= 0 (lnot_alt x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot_alt x n))))
+
+(in-theory (disable (:type-prescription lnot_alt))) 
+
+(defthmd lnot_alt-bits_alt-1
+  (equal (lnot_alt (bits_alt x (1- n) 0) n)
+         (lnot_alt x n))
+  :hints (("Goal" :use lnot-bits-1)))
+
+(defthm lnot_alt-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot_alt x n) k)))
+
+(defthm lnot_alt-x-0
+  (equal (lnot_alt x 0) 0)
+  :hints (("Goal" :use lnot-x-0)))
+
+(defthmd lnot_alt-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot_alt (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot_alt x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n)))))
+  :hints (("Goal" :use lnot-shift)))
+
+(defthmd lnot_alt-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot_alt (* 2 x) n)
+                  (+ 1 (* 2 (lnot_alt x (1- n))))))
+  :hints (("Goal" :use lnot-shift-2)))
+
+(defthmd lnot_alt-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot_alt x (+ n k))))
+                  (lnot_alt (fl (/ x (expt 2 k))) n)))
+  :hints (("Goal" :use lnot-fl)))
+
+(defthm mod-lnot_alt
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot_alt x n) (expt 2 k))
+                  (lnot_alt (mod x (expt 2 k)) k)))
+  :hints (("Goal" :use mod-lnot)))
+
+(defthmd bits_alt-lnot_alt
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits_alt (lnot_alt x n) i j)
+                  (if (< i n)
+                      (lnot_alt (bits_alt x i j)
+                            (1+ (- i j)))
+                    (lnot_alt (bits_alt x (1- n) j)
+                          (- n j)))))
+  :hints (("Goal" :use bits-lnot)))
+
+(defthmd bitn_alt-lnot_alt
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn_alt (lnot_alt x n) k)
+		  (if (< k n)
+		      (lnot_alt (bitn_alt x k) 1)
+		    0)))
+  :hints (("Goal" :use bitn-lnot)))
+
+(defthmd lnot_alt-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot_alt (cat_alt x m y n) l)
+		  (cat_alt (lnot_alt x m) m (lnot_alt y n) n)))
+  :hints (("Goal" :use lnot-cat)))
+
+
+;;;**********************************************************************
+;;;                LAND_ALT, LIOR_ALT, and LXOR_ALT
+;;;**********************************************************************
+
+
+(defun lognop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun lognop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun lognop-3-induct (x y z)
+  (declare (xargs :measure (+ (nfix x) (nfix y) (nfix z))))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+
+
+(defund binary-land_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn_alt x 0) 1)
+                       (equal (bitn_alt y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land_alt (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+
+(defmacro land_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land_alt ,@x))
+        (t         
+         `(binary-land_alt ,(car x)
+                       (land_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land_alt-nonnegative-integer-type
+  (and (integerp (land_alt x y n))
+       (<= 0 (land_alt x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land_alt)))
+
+(defund binary-lior_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn_alt x 0) 1)
+                      (equal (bitn_alt y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior_alt (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+
+
+(defmacro lior_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior_alt x y n) -- the base case
+         `(binary-lior_alt ,@x))
+        (t         
+         `(binary-lior_alt ,(car x)
+                       (lior_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior_alt-nonnegative-integer-type
+  (and (integerp (lior_alt x y n))
+       (<= 0 (lior_alt x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior_alt)))
+
+(defund binary-lxor_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn_alt x 0) 1)
+                       (equal (bitn_alt y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor_alt (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+
+
+
+(defmacro lxor_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor_alt ,@x))
+        (t         
+         `(binary-lxor_alt ,(car x)
+                       (lxor_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor_alt-nonnegative-integer-type
+  (and (integerp (lxor_alt x y n))
+       (<= 0 (lxor_alt x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor_alt)))
+
+;; (defun lognop-2-induct (x y)
+;;   (if (or (zp x) (zp y))
+;;       ()
+;;     (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+;; (defun lognop-2-n-induct (x y n)
+;;   (if (zp n)
+;;       (cons x y)
+;;     (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+;; (defun lognop-3-induct (x y z)
+;;   (declare (xargs :measure (:? x y z)))
+;;   (if (and (natp x) (natp y) (natp z))
+;;       (if (and (zp x) (zp y) (zp z))
+;; 	  t
+;; 	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+;;     t))
+
+(defthm land_alt-x-y-0
+    (equal (land_alt x y 0) 0)
+    :hints (("Goal" :use land-x-y-0)))
+
+(defthm lior_alt-x-y-0
+    (equal (lior_alt x y 0) 0)
+    :hints (("Goal" :use lior-x-y-0)))
+
+(defthm lxor_alt-x-y-0
+    (equal (lxor_alt x y 0) 0)
+    :hints (("Goal" :use lxor-x-y-0)))
+
+(defthmd land_alt-bits_alt-1
+  (equal (land_alt (bits_alt x (1- n) 0) y n)
+         (land_alt x y n))
+    :hints (("Goal" :use land-bits-1)))
+
+(defthmd land_alt-bits_alt-2
+  (equal (land_alt x (bits_alt y (1- n) 0) n)
+         (land_alt x y n))
+    :hints (("Goal" :use land-bits-2)))
+
+(defthmd lior_alt-bits_alt-1
+  (equal (lior_alt (bits_alt x (1- n) 0) y n)
+         (lior_alt x y n))
+    :hints (("Goal" :use lior-bits-1)))
+
+(defthmd lior_alt-bits_alt-2
+  (equal (lior_alt x (bits_alt y (1- n) 0) n)
+         (lior_alt x y n))
+    :hints (("Goal" :use lior-bits-2)))
+
+(defthmd lxor_alt-bits_alt-1
+  (equal (lxor_alt (bits_alt x (1- n) 0) y n)
+         (lxor_alt x y n))
+    :hints (("Goal" :use lxor-bits-1)))
+
+(defthmd lxor_alt-bits_alt-2
+  (equal (lxor_alt x (bits_alt y (1- n) 0) n)
+         (lxor_alt x y n))
+    :hints (("Goal" :use lxor-bits-2)))
+
+(defthm land_alt-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land_alt x y n) k))
+    :hints (("Goal" :use land-bvecp)))
+
+(defthm lior_alt-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior_alt x y n) k))
+    :hints (("Goal" :use lior-bvecp)))
+
+(defthm lxor_alt-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor_alt x y n) k))
+    :hints (("Goal" :use lxor-bvecp)))
+
+(defthm land_alt-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land_alt x y n) m))
+    :hints (("Goal" :use land-bvecp-2)))
+
+(defthm lior_alt-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior_alt x y n) m))
+    :hints (("Goal" :use lior-bvecp-2)))
+
+(defthm lxor_alt-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor_alt x y n) m))
+    :hints (("Goal" :use lxor-bvecp-2)))
+
+(defthmd land_alt-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land_alt x y m) (land_alt x y n)))
+    :hints (("Goal" :use land-reduce)))
+
+(defthmd lior_alt-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior_alt x y m) (lior_alt x y n)))
+    :hints (("Goal" :use lior-reduce)))
+
+(defthmd lxor_alt-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor_alt x y m) (lxor_alt x y n)))
+    :hints (("Goal" :use lxor-reduce)))
+
+(defthmd land_alt-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land_alt x y n)
+                  (+ (* 2 (land_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land_alt (bitn_alt x 0) (bitn_alt y 0) 1))))
+    :hints (("Goal" :use land-def)))
+
+(defthmd lior_alt-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior_alt x y n)
+                  (+ (* 2 (lior_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior_alt (bitn_alt x 0) (bitn_alt y 0) 1))))
+    :hints (("Goal" :use lior-def)))
+
+(defthmd lxor_alt-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor_alt x y n)
+                  (+ (* 2 (lxor_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor_alt (bitn_alt x 0) (bitn_alt y 0) 1))))
+    :hints (("Goal" :use lxor-def)))
+
+(defthm land_alt-0
+  (equal (land_alt 0 y n)
+	 0)
+    :hints (("Goal" :use land-0)))
+
+(defthmd land_alt-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land_alt i j 1))
+		  (or (equal i 0)
+		      (equal j 0))))
+    :hints (("Goal" :use land-equal-0)))
+
+(defthm lior_alt-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior_alt 0 y n) y))
+    :hints (("Goal" :use lior-0)))
+
+(defthmd lior_alt-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior_alt x y n))
+		  (and (equal x 0)
+		       (equal y 0))))
+    :hints (("Goal" :use lior-equal-0)))
+
+(defthm lxor_alt-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor_alt 0 y n) y))
+    :hints (("Goal" :use lxor-0)))
+
+(defthm land_alt-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land_alt (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land_alt x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use land-shift)))
+
+(defthm lxor_alt-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor_alt (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor_alt x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use lxor-shift)))
+
+(defthm lior_alt-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior_alt (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior_alt x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use lior-shift)))
+
+(defthmd fl-land_alt
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land_alt x y (+ n k)) (expt 2 k)))
+                  (land_alt (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-land)))
+
+(defthmd fl-lior_alt
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior_alt x y (+ n k)) (expt 2 k)))
+                  (lior_alt (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-lior)))
+
+(defthmd fl-lxor_alt
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor_alt x y (+ n k)) (expt 2 k)))
+                  (lxor_alt (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-lxor)))
+
+(defthmd mod-land_alt
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land_alt x y n) (expt 2 k))
+                  (land_alt x y k)))
+  :hints (("Goal" :use mod-land)))
+
+(defthmd mod-lior_alt
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior_alt x y n) (expt 2 k))
+                  (lior_alt x y k)))
+  :hints (("Goal" :use mod-lior)))
+
+(defthmd mod-lxor_alt
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor_alt x y n) (expt 2 k))
+                  (lxor_alt x y k)))
+  :hints (("Goal" :use mod-lxor)))
+
+(defthm bits_alt-land_alt
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits_alt (land_alt x y n) i j)
+		  (land_alt (bits_alt x i j) 
+			(bits_alt y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits-land)))
+
+(defthm bits_alt-lior_alt
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits_alt (lior_alt x y n) i j)
+		  (lior_alt (bits_alt x i j) 
+			(bits_alt y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits-lior)))
+
+(defthm bits_alt-lxor_alt
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits_alt (lxor_alt x y n) i j)
+		  (lxor_alt (bits_alt x i j) 
+			(bits_alt y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits-lxor)))
+
+(defthm bitn_alt-land_alt
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn_alt (land_alt x y n) k)
+		  (if (< k n)
+		      (land_alt (bitn_alt x k) 
+			    (bitn_alt y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn-land)))
+
+(defthm bitn_alt-lior_alt
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn_alt (lior_alt x y n) k)
+		  (if (< k n)
+		      (lior_alt (bitn_alt x k) 
+			    (bitn_alt y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn-lior)))
+
+(defthm bitn_alt-lxor_alt
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn_alt (lxor_alt x y n) k)
+		  (if (< k n)
+		      (lxor_alt (bitn_alt x k) 
+			    (bitn_alt y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn-lxor)))
+
+(defthmd land_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land_alt (cat_alt x1 m y1 n) (cat_alt x2 m y2 n) l)
+		  (cat_alt (land_alt x1 x2 m) m (land_alt y1 y2 n) n)))
+  :hints (("Goal" :use land-cat)))
+
+(defthm land_alt-cat_alt-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land_alt c (cat_alt x2 m y2 n) l)
+		  (cat_alt (land_alt (bits_alt c (+ -1 m n) n) x2 m)
+		       m
+		       (land_alt (bits_alt c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use land-cat-constant)))
+
+(defthmd lior_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior_alt (cat_alt x1 m y1 n) (cat_alt x2 m y2 n) l)
+		  (cat_alt (lior_alt x1 x2 m) m (lior_alt y1 y2 n) n)))
+  :hints (("Goal" :use lior-cat)))
+
+(defthm lior_alt-cat_alt-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior_alt c (cat_alt x2 m y2 n) l)
+		  (cat_alt (lior_alt (bits_alt c (+ -1 m n) n) x2 m)
+		       m
+		       (lior_alt (bits_alt c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use lior-cat-constant)))
+
+(defthmd lxor_alt-cat_alt
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor_alt (cat_alt x1 m y1 n) (cat_alt x2 m y2 n) l)
+		  (cat_alt (lxor_alt x1 x2 m) m (lxor_alt y1 y2 n) n)))
+  :hints (("Goal" :use lxor-cat)))
+
+(defthm lxor_alt-cat_alt-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor_alt c (cat_alt x2 m y2 n) l)
+		  (cat_alt (lxor_alt (bits_alt c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor_alt (bits_alt c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use lxor-cat-constant)))
+
+(defthm land_alt-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land_alt x y n) x))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use land-bnd)))
+
+(defthm lior_alt-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior_alt x y n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use lior-bnd)))
+
+(defthm lxor_alt-bnd
+  (<= (lxor_alt x y n) (lior_alt x y n))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use lxor-bnd)))
+
+(defthmd lior_alt-plus
+  (implies (= (land_alt x y n) 0)
+           (equal (lior_alt x y n)
+                  (+ (bits_alt x (1- n) 0)
+                     (bits_alt y (1- n) 0))))
+  :hints (("Goal" :use lior-plus)))
+
+(defthmd land_alt-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land_alt (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land_alt x (bits_alt y (1- n) m) (+ n (-
+                                                                        m))))))
+  :hints (("Goal" :use land-with-shifted-arg)))
+
+(defthm lior_alt-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior_alt (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :use lior-with-shifted-arg)))
+
+(defthmd land_alt-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land_alt x (expt 2 k) n)
+		  (* (expt 2 k) (bitn_alt x k))))
+  :hints (("Goal" :use land-expt)))
+
+(defthm lior_alt-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior_alt x (expt 2 k) n)
+		(+ (bits_alt x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn_alt x k))))))
+  :rule-classes ()
+  :hints (("Goal" :use lior-expt)))
+
+(defthmd lxor_alt-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor_alt x (expt 2 k) n)
+		  (+ (bits_alt x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn_alt x k)))))))
+  :hints (("Goal" :use lxor-expt)))
+
+(defthm land_alt-ones
+  (equal (land_alt (1- (expt 2 n)) x n)
+	 (bits_alt x (1- n) 0))
+  :rule-classes nil
+  :hints (("Goal" :use land-ones)))
+
+(defthm land_alt-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land_alt k x n)
+		  (bits_alt x (1- n) 0)))
+  :hints (("Goal" :use land-ones-rewrite)))
+
+(defthm lior_alt-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior_alt (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use lior-ones)))
+
+(defthm lior_alt-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior_alt k x n)
+		  (1- (expt 2 n))))
+  :hints (("Goal" :use lior-ones-rewrite)))
+
+(defthm lxor_alt-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor_alt (1- (expt 2 n)) x n)
+		  (lnot_alt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use lxor-ones)))
+
+(defthm lxor_alt-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor_alt k x n)
+		  (lnot_alt x n)))
+  :hints (("Goal" :use lxor-ones-rewrite)))
+
+(defthm land_alt-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land_alt x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits_alt x (1- i) j))))
+  :rule-classes ()
+  :hints (("Goal" :use land-slice)))
+
+(defthmd lior_alt-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior_alt x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat_alt (bits_alt x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits_alt x (1- j) 0)     j)))
+  :hints (("Goal" :use lior-slice)))
+
+(defthmd lxor_alt-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor_alt x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat_alt (bits_alt x (1- n) i) (- n i)
+                       (lnot_alt (bits_alt x (1- i) j) (- i j)) (- i j)
+                       (bits_alt x (1- j) 0) j)))
+  :hints (("Goal" :use lxor-slice)))
+
+(defthmd land_alt-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land_alt (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k)))))
+  :hints (("Goal" :use land-slices)))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot_alt-lnot_alt
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot_alt (lnot_alt x n) n)
+		  x))
+    :hints (("Goal" :use lnot-lnot)))
+
+(defthm land_alt-commutative
+  (equal (land_alt y x n)
+	 (land_alt x y n))
+    :hints (("Goal" :use land-commutative)))
+
+(defthm lior_alt-commutative
+  (equal (lior_alt y x n)
+	 (lior_alt x y n))
+    :hints (("Goal" :use lior-commutative)))
+
+(defthm lxor_alt-commutative
+  (equal (lxor_alt y x n)
+	 (lxor_alt x y n))
+    :hints (("Goal" :use lxor-commutative)))
+
+(defthm land_alt-associative
+  (equal (land_alt (land_alt x y n) z n)
+	 (land_alt x (land_alt y z n) n))
+    :hints (("Goal" :use land-associative)))
+
+(defthm lior_alt-associative
+  (equal (lior_alt (lior_alt x y n) z n)
+	 (lior_alt x (lior_alt y z n) n))
+    :hints (("Goal" :use lior-associative)))
+
+(defthm lxor_alt-associative
+  (equal (lxor_alt (lxor_alt x y n) z n)
+	 (lxor_alt x (lxor_alt y z n) n))
+    :hints (("Goal" :use lxor-associative)))
+
+(defthm land_alt-commutative-2
+  (equal (land_alt y (land_alt x z n) n)
+	 (land_alt x (land_alt y z n) n))
+    :hints (("Goal" :use land-commutative-2)))
+
+(defthm lior_alt-commutative-2
+  (equal (lior_alt y (lior_alt x z n) n)
+	 (lior_alt x (lior_alt y z n) n))
+    :hints (("Goal" :use lior-commutative-2)))
+
+(defthm lxor_alt-commutative-2
+  (equal (lxor_alt y (lxor_alt x z n) n)
+	 (lxor_alt x (lxor_alt y z n) n))
+    :hints (("Goal" :use lxor-commutative-2)))
+
+(defthm land_alt-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land_alt x (land_alt y z n) n)
+		  (land_alt (land_alt x y n) z n)))
+    :hints (("Goal" :use land-combine-constants)))
+
+(defthm lior_alt-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior_alt x (lior_alt y z n) n)
+		  (lior_alt (lior_alt x y n) z n)))
+    :hints (("Goal" :use lior-combine-constants)))
+
+(defthm lxor_alt-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor_alt x (lxor_alt y z n) n)
+		  (lxor_alt (lxor_alt x y n) z n)))
+    :hints (("Goal" :use lxor-combine-constants)))
+
+(defthm land_alt-self
+  (equal (land_alt x x n)
+	 (bits_alt x (1- n) 0))
+    :hints (("Goal" :use land-self)))
+
+(defthm lior_alt-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior_alt x x n) x))
+    :hints (("Goal" :use lior-self)))
+
+(defthm lxor_alt-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor_alt x x n) 0))
+    :hints (("Goal" :use lxor-self)))
+
+(defthmd lior_alt-land_alt-1
+  (equal (lior_alt x (land_alt y z n) n)
+	 (land_alt (lior_alt x y n) (lior_alt x z n) n))
+    :hints (("Goal" :use lior-land-1)))
+
+(defthmd lior_alt-land_alt-2
+  (equal (lior_alt (land_alt y z n) x n)
+	 (land_alt (lior_alt x y n) (lior_alt x z n) n))
+    :hints (("Goal" :use lior-land-2)))
+
+(defthmd land_alt-lior_alt-1
+  (equal (land_alt x (lior_alt y z n) n)
+	 (lior_alt (land_alt x y n) (land_alt x z n) n))
+    :hints (("Goal" :use land-lior-1)))
+
+(defthmd land_alt-lior_alt-2
+  (equal (land_alt (lior_alt y z n) x n)
+	 (lior_alt (land_alt x y n) (land_alt x z n) n))
+    :hints (("Goal" :use land-lior-2)))
+
+(defthmd lior_alt-land_alt-lxor_alt
+  (equal (lior_alt (land_alt x y n) (lior_alt (land_alt x z n) (land_alt y z n) n) n)
+	 (lior_alt (land_alt x y n) (land_alt (lxor_alt x y n) z n) n))
+    :hints (("Goal" :use lior-land-lxor)))
+
+(defthmd lxor_alt-rewrite
+  (equal (lxor_alt x y n)
+	 (lior_alt (land_alt x (lnot_alt y n) n)
+	       (land_alt y (lnot_alt x n) n)
+	       n))
+    :hints (("Goal" :use lxor-rewrite)))
+
+(defthmd lnot_alt-lxor_alt
+  (equal (lnot_alt (lxor_alt x y n) n)
+	 (lxor_alt (lnot_alt x n) y n))
+    :hints (("Goal" :use lnot-lxor)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1031 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "bits")
+(include-book "rtl")
+
+(local (include-book "logn-new"))
+
+
+
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+          
+ 
+
+
+
+;;;**********************************************************************
+;;;                     LNOT
+;;;**********************************************************************
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(local 
+ (defthm lnot-is-lnot_alt
+   (equal (lnot x n)
+          (lnot_alt x n))
+   :hints (("Goal" :in-theory (e/d (lnot lnot_alt) ())))))
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthmd lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n))
+  :hints (("Goal" :use lnot_alt-bits_alt-1)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot x n) k)))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0)
+  :hints (("Goal" :use lnot_alt-x-0)))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n)))))
+  :hints (("Goal" :use lnot_alt-shift)))
+
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n))))))
+  :hints (("Goal" :use lnot_alt-shift-2)))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n)))
+  :hints (("Goal" :use lnot_alt-fl)))
+
+(defthm mod-lnot
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot x n) (expt 2 k))
+                  (lnot (mod x (expt 2 k)) k)))
+  :hints (("Goal" :use mod-lnot_alt)))
+
+(defthmd bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j)))))
+  :hints (("Goal" :use bits_alt-lnot_alt)))
+
+(defthmd bitn-lnot
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn (lnot x n) k)
+		  (if (< k n)
+		      (lnot (bitn x k) 1)
+		    0)))
+  :hints (("Goal" :use bitn_alt-lnot_alt)))
+
+(defthmd lnot-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot (cat x m y n) l)
+		  (cat (lnot x m) m (lnot y n) n)))
+  :hints (("Goal" :use lnot_alt-cat)))
+
+
+;;;**********************************************************************
+;;;                LAND, LIOR, and LXOR
+;;;**********************************************************************
+
+
+(defun lognop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun lognop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun lognop-3-induct (x y z)
+  (declare (xargs :measure (+ (nfix x) (nfix y) (nfix z))))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+(local (include-book "log-new"))
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(local 
+ (defthm land-is-land
+   (equal (binary-land x y n)
+          (binary-land_alt x y n))
+   :hints (("Goal" :in-theory (e/d (binary-land_alt
+                                    binary-land) ())))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land)))
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+
+(local 
+ (defthm lior-is-lior
+   (equal (binary-lior x y n)
+          (binary-lior_alt x y n))
+   :hints (("Goal" :in-theory (e/d (binary-lior_alt
+                                    binary-lior) ())))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior)))
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+
+(local 
+ (defthm lxor-is-lxor
+   (equal (binary-lxor x y n)
+          (binary-lxor_alt x y n))
+   :hints (("Goal" :in-theory (e/d (binary-lxor_alt
+                                    binary-lxor) ())))))
+
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;; (defun lognop-2-induct (x y)
+;;   (if (or (zp x) (zp y))
+;;       ()
+;;     (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+;; (defun lognop-2-n-induct (x y n)
+;;   (if (zp n)
+;;       (cons x y)
+;;     (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+;; (defun lognop-3-induct (x y z)
+;;   (declare (xargs :measure (:? x y z)))
+;;   (if (and (natp x) (natp y) (natp z))
+;;       (if (and (zp x) (zp y) (zp z))
+;; 	  t
+;; 	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+;;     t))
+
+(defthm land-x-y-0
+    (equal (land x y 0) 0)
+    :hints (("Goal" :use land_alt-x-y-0)))
+
+(defthm lior-x-y-0
+    (equal (lior x y 0) 0)
+    :hints (("Goal" :use lior_alt-x-y-0)))
+
+(defthm lxor-x-y-0
+    (equal (lxor x y 0) 0)
+    :hints (("Goal" :use lxor_alt-x-y-0)))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0) y n)
+         (land x y n))
+    :hints (("Goal" :use land_alt-bits_alt-1)))
+
+(defthmd land-bits-2
+  (equal (land x (bits y (1- n) 0) n)
+         (land x y n))
+    :hints (("Goal" :use land_alt-bits_alt-2)))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0) y n)
+         (lior x y n))
+    :hints (("Goal" :use lior_alt-bits_alt-1)))
+
+(defthmd lior-bits-2
+  (equal (lior x (bits y (1- n) 0) n)
+         (lior x y n))
+    :hints (("Goal" :use lior_alt-bits_alt-2)))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0) y n)
+         (lxor x y n))
+    :hints (("Goal" :use lxor_alt-bits_alt-1)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x (bits y (1- n) 0) n)
+         (lxor x y n))
+    :hints (("Goal" :use lxor_alt-bits_alt-2)))
+
+(defthm land-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land x y n) k))
+    :hints (("Goal" :use land_alt-bvecp)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior x y n) k))
+    :hints (("Goal" :use lior_alt-bvecp)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor x y n) k))
+    :hints (("Goal" :use lxor_alt-bvecp)))
+
+(defthm land-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land x y n) m))
+    :hints (("Goal" :use land_alt-bvecp-2)))
+
+(defthm lior-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior x y n) m))
+    :hints (("Goal" :use lior_alt-bvecp-2)))
+
+(defthm lxor-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor x y n) m))
+    :hints (("Goal" :use lxor_alt-bvecp-2)))
+
+(defthmd land-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land x y m) (land x y n)))
+    :hints (("Goal" :use land_alt-reduce)))
+
+(defthmd lior-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior x y m) (lior x y n)))
+    :hints (("Goal" :use lior_alt-reduce)))
+
+(defthmd lxor-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor x y m) (lxor x y n)))
+    :hints (("Goal" :use lxor_alt-reduce)))
+
+(defthmd land-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (bitn x 0) (bitn y 0) 1))))
+    :hints (("Goal" :use land_alt-def)))
+
+(defthmd lior-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (bitn x 0) (bitn y 0) 1))))
+    :hints (("Goal" :use lior_alt-def)))
+
+(defthmd lxor-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (bitn x 0) (bitn y 0) 1))))
+    :hints (("Goal" :use lxor_alt-def)))
+
+(defthm land-0
+  (equal (land 0 y n)
+	 0)
+    :hints (("Goal" :use land_alt-0)))
+
+(defthmd land-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land i j 1))
+		  (or (equal i 0)
+		      (equal j 0))))
+    :hints (("Goal" :use land_alt-equal-0)))
+
+(defthm lior-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior 0 y n) y))
+    :hints (("Goal" :use lior_alt-0)))
+
+(defthmd lior-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior x y n))
+		  (and (equal x 0)
+		       (equal y 0))))
+    :hints (("Goal" :use lior_alt-equal-0)))
+
+(defthm lxor-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor 0 y n) y))
+    :hints (("Goal" :use lxor_alt-0)))
+
+(defthm land-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use land_alt-shift)))
+
+(defthm lxor-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use lxor_alt-shift)))
+
+(defthm lior-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior x y (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use lior_alt-shift)))
+
+(defthmd fl-land
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
+                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-land_alt)))
+
+(defthmd fl-lior
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
+                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-lior_alt)))
+
+(defthmd fl-lxor
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
+                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :use fl-lxor_alt)))
+
+(defthmd mod-land
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land x y n) (expt 2 k))
+                  (land x y k)))
+  :hints (("Goal" :use mod-land_alt)))
+
+(defthmd mod-lior
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior x y n) (expt 2 k))
+                  (lior x y k)))
+  :hints (("Goal" :use mod-lior_alt)))
+
+(defthmd mod-lxor
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor x y n) (expt 2 k))
+                  (lxor x y k)))
+  :hints (("Goal" :use mod-lxor_alt)))
+
+(defthm bits-land
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (land x y n) i j)
+		  (land (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits_alt-land_alt)))
+
+(defthm bits-lior
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lior x y n) i j)
+		  (lior (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits_alt-lior_alt)))
+
+(defthm bits-lxor
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lxor x y n) i j)
+		  (lxor (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j)))))
+  :hints (("Goal" :use bits_alt-lxor_alt)))
+
+(defthm bitn-land
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (land x y n) k)
+		  (if (< k n)
+		      (land (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn_alt-land_alt)))
+
+(defthm bitn-lior
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lior x y n) k)
+		  (if (< k n)
+		      (lior (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn_alt-lior_alt)))
+
+(defthm bitn-lxor
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lxor x y n) k)
+		  (if (< k n)
+		      (lxor (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0)))
+  :hints (("Goal" :use bitn_alt-lxor_alt)))
+
+(defthmd land-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (land x1 x2 m) m (land y1 y2 n) n)))
+  :hints (("Goal" :use land_alt-cat_alt)))
+
+(defthm land-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land c (cat x2 m y2 n) l)
+		  (cat (land (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (land (bits c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use land_alt-cat_alt-constant)))
+
+(defthmd lior-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lior x1 x2 m) m (lior y1 y2 n) n)))
+  :hints (("Goal" :use lior_alt-cat_alt)))
+
+(defthm lior-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior c (cat x2 m y2 n) l)
+		  (cat (lior (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lior (bits c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use lior_alt-cat_alt-constant)))
+
+(defthmd lxor-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n)))
+  :hints (("Goal" :use lxor_alt-cat_alt)))
+
+(defthm lxor-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor c (cat x2 m y2 n) l)
+		  (cat (lxor (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor (bits c (1- n) 0) y2 n)
+		       n)))
+  :hints (("Goal" :use lxor_alt-cat_alt-constant)))
+
+(defthm land-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land x y n) x))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use land_alt-bnd)))
+
+(defthm lior-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior x y n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use lior_alt-bnd)))
+
+(defthm lxor-bnd
+  (<= (lxor x y n) (lior x y n))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use lxor_alt-bnd)))
+
+(defthmd lior-plus
+  (implies (= (land x y n) 0)
+           (equal (lior x y n)
+                  (+ (bits x (1- n) 0)
+                     (bits y (1- n) 0))))
+  :hints (("Goal" :use lior_alt-plus)))
+
+(defthmd land-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (-
+                                                                        m))))))
+  :hints (("Goal" :use land_alt-with-shifted-arg)))
+
+(defthm lior-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :use lior_alt-with-shifted-arg)))
+
+(defthmd land-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land x (expt 2 k) n)
+		  (* (expt 2 k) (bitn x k))))
+  :hints (("Goal" :use land_alt-expt)))
+
+(defthm lior-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior x (expt 2 k) n)
+		(+ (bits x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ()
+  :hints (("Goal" :use lior_alt-expt)))
+
+(defthmd lxor-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor x (expt 2 k) n)
+		  (+ (bits x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn x k)))))))
+  :hints (("Goal" :use lxor_alt-expt)))
+
+(defthm land-ones
+  (equal (land (1- (expt 2 n)) x n)
+	 (bits x (1- n) 0))
+  :rule-classes nil
+  :hints (("Goal" :use land_alt-ones)))
+
+(defthm land-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land k x n)
+		  (bits x (1- n) 0)))
+  :hints (("Goal" :use land_alt-ones-rewrite)))
+
+(defthm lior-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use lior_alt-ones)))
+
+(defthm lior-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior k x n)
+		  (1- (expt 2 n))))
+  :hints (("Goal" :use lior_alt-ones-rewrite)))
+
+(defthm lxor-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor (1- (expt 2 n)) x n)
+		  (lnot x n)))
+  :rule-classes ()
+  :hints (("Goal" :use lxor_alt-ones)))
+
+(defthm lxor-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor k x n)
+		  (lnot x n)))
+  :hints (("Goal" :use lxor_alt-ones-rewrite)))
+
+(defthm land-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ()
+  :hints (("Goal" :use land_alt-slice)))
+
+(defthmd lior-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j)))
+  :hints (("Goal" :use lior_alt-slice)))
+
+(defthmd lxor-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i) (- n i)
+                       (lnot (bits x (1- i) j) (- i j)) (- i j)
+                       (bits x (1- j) 0) j)))
+  :hints (("Goal" :use lxor_alt-slice)))
+
+(defthmd land-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k)))))
+  :hints (("Goal" :use land_alt-slices)))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot (lnot x n) n)
+		  x))
+    :hints (("Goal" :use lnot_alt-lnot_alt)))
+
+(defthm land-commutative
+  (equal (land y x n)
+	 (land x y n))
+    :hints (("Goal" :use land_alt-commutative)))
+
+(defthm lior-commutative
+  (equal (lior y x n)
+	 (lior x y n))
+    :hints (("Goal" :use lior_alt-commutative)))
+
+(defthm lxor-commutative
+  (equal (lxor y x n)
+	 (lxor x y n))
+    :hints (("Goal" :use lxor_alt-commutative)))
+
+(defthm land-associative
+  (equal (land (land x y n) z n)
+	 (land x (land y z n) n))
+    :hints (("Goal" :use land_alt-associative)))
+
+(defthm lior-associative
+  (equal (lior (lior x y n) z n)
+	 (lior x (lior y z n) n))
+    :hints (("Goal" :use lior_alt-associative)))
+
+(defthm lxor-associative
+  (equal (lxor (lxor x y n) z n)
+	 (lxor x (lxor y z n) n))
+    :hints (("Goal" :use lxor_alt-associative)))
+
+(defthm land-commutative-2
+  (equal (land y (land x z n) n)
+	 (land x (land y z n) n))
+    :hints (("Goal" :use land_alt-commutative-2)))
+
+(defthm lior-commutative-2
+  (equal (lior y (lior x z n) n)
+	 (lior x (lior y z n) n))
+    :hints (("Goal" :use lior_alt-commutative-2)))
+
+(defthm lxor-commutative-2
+  (equal (lxor y (lxor x z n) n)
+	 (lxor x (lxor y z n) n))
+    :hints (("Goal" :use lxor_alt-commutative-2)))
+
+(defthm land-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land x (land y z n) n)
+		  (land (land x y n) z n)))
+    :hints (("Goal" :use land_alt-combine-constants)))
+
+(defthm lior-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior x (lior y z n) n)
+		  (lior (lior x y n) z n)))
+    :hints (("Goal" :use lior_alt-combine-constants)))
+
+(defthm lxor-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor x (lxor y z n) n)
+		  (lxor (lxor x y n) z n)))
+    :hints (("Goal" :use lxor_alt-combine-constants)))
+
+(defthm land-self
+  (equal (land x x n)
+	 (bits x (1- n) 0))
+    :hints (("Goal" :use land_alt-self)))
+
+(defthm lior-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior x x n) x))
+    :hints (("Goal" :use lior_alt-self)))
+
+(defthm lxor-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor x x n) 0))
+    :hints (("Goal" :use lxor_alt-self)))
+
+(defthmd lior-land-1
+  (equal (lior x (land y z n) n)
+	 (land (lior x y n) (lior x z n) n))
+    :hints (("Goal" :use lior_alt-land_alt-1)))
+
+(defthmd lior-land-2
+  (equal (lior (land y z n) x n)
+	 (land (lior x y n) (lior x z n) n))
+    :hints (("Goal" :use lior_alt-land_alt-2)))
+
+(defthmd land-lior-1
+  (equal (land x (lior y z n) n)
+	 (lior (land x y n) (land x z n) n))
+    :hints (("Goal" :use land_alt-lior_alt-1)))
+
+(defthmd land-lior-2
+  (equal (land (lior y z n) x n)
+	 (lior (land x y n) (land x z n) n))
+    :hints (("Goal" :use land_alt-lior_alt-2)))
+
+(defthmd lior-land-lxor
+  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
+	 (lior (land x y n) (land (lxor x y n) z n) n))
+    :hints (("Goal" :use lior_alt-land_alt-lxor_alt)))
+
+(defthmd lxor-rewrite
+  (equal (lxor x y n)
+	 (lior (land x (lnot y n) n)
+	       (land y (lnot x n) n)
+	       n))
+    :hints (("Goal" :use lxor_alt-rewrite)))
+
+(defthmd lnot-lxor
+  (equal (lnot (lxor x y n) n)
+	 (lxor (lnot x n) y n))
+    :hints (("Goal" :use lnot_alt-lxor_alt)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,854 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "bits")
+
+(local (include-book "logn-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                     LNOT
+;;;**********************************************************************
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthmd lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot x n) k)))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n))))))
+
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n)))))))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n))))
+
+(defthm mod-lnot
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot x n) (expt 2 k))
+                  (lnot (mod x (expt 2 k)) k))))
+
+(defthmd bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j))))))
+
+(defthmd bitn-lnot
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn (lnot x n) k)
+		  (if (< k n)
+		      (lnot (bitn x k) 1)
+		    0))))
+
+(defthmd lnot-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot (cat x m y n) l)
+		  (cat (lnot x m) m (lnot y n) n))))
+
+
+;;;**********************************************************************
+;;;                LAND, LIOR, and LXOR
+;;;**********************************************************************
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land)))
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior)))
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor)))
+
+(defun lognop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun lognop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun lognop-3-induct (x y z)
+  (declare (xargs :measure (:? x y z)))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defthm land-x-y-0
+    (equal (land x y 0) 0))
+
+(defthm lior-x-y-0
+    (equal (lior x y 0) 0))
+
+(defthm lxor-x-y-0
+    (equal (lxor x y 0) 0))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0) y n)
+         (land x y n)))
+
+(defthmd land-bits-2
+  (equal (land x (bits y (1- n) 0) n)
+         (land x y n)))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0) y n)
+         (lior x y n)))
+
+(defthmd lior-bits-2
+  (equal (lior x (bits y (1- n) 0) n)
+         (lior x y n)))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0) y n)
+         (lxor x y n)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x (bits y (1- n) 0) n)
+         (lxor x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land x y n) k)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior x y n) k)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor x y n) k)))
+
+(defthm land-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land x y n) m)))
+
+(defthm lior-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior x y n) m)))
+
+(defthm lxor-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor x y n) m)))
+
+(defthmd land-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land x y m) (land x y n))))
+
+(defthmd lior-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior x y m) (lior x y n))))
+
+(defthmd lxor-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor x y m) (lxor x y n))))
+
+(defthmd land-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lior-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lxor-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (bitn x 0) (bitn y 0) 1)))))
+
+(defthm land-0
+  (equal (land 0 y n)
+	 0))
+
+(defthmd land-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land i j 1))
+		  (or (equal i 0)
+		      (equal j 0)))))
+
+(defthm lior-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior 0 y n) y)))
+
+(defthmd lior-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior x y n))
+		  (and (equal x 0)
+		       (equal y 0)))))
+
+(defthm lxor-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor 0 y n) y)))
+
+(defthm land-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land x y (- n k)))))
+  :rule-classes ())
+
+(defthm lxor-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor x y (- n k)))))
+  :rule-classes ())
+
+(defthm lior-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior x y (- n k)))))
+  :rule-classes ())
+
+(defthmd fl-land
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
+                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lior
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
+                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lxor
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
+                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd mod-land
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land x y n) (expt 2 k))
+                  (land x y k))))
+
+(defthmd mod-lior
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior x y n) (expt 2 k))
+                  (lior x y k))))
+
+(defthmd mod-lxor
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor x y n) (expt 2 k))
+                  (lxor x y k))))
+
+(defthm bits-land
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (land x y n) i j)
+		  (land (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lior
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lior x y n) i j)
+		  (lior (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lxor
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lxor x y n) i j)
+		  (lxor (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bitn-land
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (land x y n) k)
+		  (if (< k n)
+		      (land (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lior
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lior x y n) k)
+		  (if (< k n)
+		      (lior (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lxor
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lxor x y n) k)
+		  (if (< k n)
+		      (lxor (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthmd land-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (land x1 x2 m) m (land y1 y2 n) n))))
+
+(defthm land-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land c (cat x2 m y2 n) l)
+		  (cat (land (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (land (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lior-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lior x1 x2 m) m (lior y1 y2 n) n))))
+
+(defthm lior-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior c (cat x2 m y2 n) l)
+		  (cat (lior (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lior (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lxor-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n))))
+
+(defthm lxor-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor c (cat x2 m y2 n) l)
+		  (cat (lxor (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthm land-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land x y n) x))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior x y n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm lxor-bnd
+  (<= (lxor x y n) (lior x y n))
+  :rule-classes (:rewrite :linear))
+
+(defthmd lior-plus
+  (implies (= (land x y n) 0)
+           (equal (lior x y n)
+                  (+ (bits x (1- n) 0)
+                     (bits y (1- n) 0)))))
+
+(defthmd land-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m)))))))
+
+(defthm lior-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ())
+
+(defthmd land-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land x (expt 2 k) n)
+		  (* (expt 2 k) (bitn x k)))))
+
+(defthm lior-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior x (expt 2 k) n)
+		(+ (bits x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ())
+
+(defthmd lxor-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor x (expt 2 k) n)
+		  (+ (bits x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn x k))))))))
+
+(defthm land-ones
+  (equal (land (1- (expt 2 n)) x n)
+	 (bits x (1- n) 0))
+  :rule-classes nil)
+
+(defthm land-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land k x n)
+		  (bits x (1- n) 0))))
+
+(defthm lior-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ())
+
+(defthm lior-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior k x n)
+		  (1- (expt 2 n)))))
+
+(defthm lxor-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor (1- (expt 2 n)) x n)
+		  (lnot x n)))
+  :rule-classes ())
+
+(defthm lxor-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor k x n)
+		  (lnot x n))))
+
+(defthm land-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ())
+
+(defthmd lior-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j))))
+
+(defthmd lxor-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i) (- n i)
+                       (lnot (bits x (1- i) j) (- i j)) (- i j)
+                       (bits x (1- j) 0) j))))
+
+(defthmd land-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot (lnot x n) n)
+		  x)))
+
+(defthm land-commutative
+  (equal (land y x n)
+	 (land x y n)))
+
+(defthm lior-commutative
+  (equal (lior y x n)
+	 (lior x y n)))
+
+(defthm lxor-commutative
+  (equal (lxor y x n)
+	 (lxor x y n)))
+
+(defthm land-associative
+  (equal (land (land x y n) z n)
+	 (land x (land y z n) n)))
+
+(defthm lior-associative
+  (equal (lior (lior x y n) z n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-associative
+  (equal (lxor (lxor x y n) z n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-commutative-2
+  (equal (land y (land x z n) n)
+	 (land x (land y z n) n)))
+
+(defthm lior-commutative-2
+  (equal (lior y (lior x z n) n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-commutative-2
+  (equal (lxor y (lxor x z n) n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land x (land y z n) n)
+		  (land (land x y n) z n))))
+
+(defthm lior-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior x (lior y z n) n)
+		  (lior (lior x y n) z n))))
+
+(defthm lxor-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor x (lxor y z n) n)
+		  (lxor (lxor x y n) z n))))
+
+(defthm land-self
+  (equal (land x x n)
+	 (bits x (1- n) 0)))
+
+(defthm lior-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior x x n) x)))
+
+(defthm lxor-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor x x n) 0)))
+
+(defthmd lior-land-1
+  (equal (lior x (land y z n) n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd lior-land-2
+  (equal (lior (land y z n) x n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd land-lior-1
+  (equal (land x (lior y z n) n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd land-lior-2
+  (equal (land (lior y z n) x n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd lior-land-lxor
+  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
+	 (lior (land x y n) (land (lxor x y n) z n) n)))
+
+(defthmd lxor-rewrite
+  (equal (lxor x y n)
+	 (lior (land x (lnot y n) n)
+	       (land y (lnot x n) n)
+	       n)))
+
+(defthmd lnot-lxor
+  (equal (lnot (lxor x y n) n)
+	 (lxor (lnot x n) y n)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn2log-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn2log-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn2log-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn2log-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,130 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+(include-book "log")
+(include-book "logn")
+
+
+(local (include-book "../../arithmetic/top"))
+
+;;;;
+;;;;
+
+(local 
+ (defthm bvecp-fl-1/2
+   (implies (bvecp x (+ 1 n))
+            (BVECP (FL (* 1/2 X)) n))
+   :hints (("Goal" :in-theory (e/d (bvecp
+                                    expt-2-reduce-leading-constant) ())))))
+
+(local 
+ (defthm bvecp-mod-2
+   (implies (integerp x)
+            (BVECP (MOD X 2) 1))
+   :hints (("Goal" :in-theory (e/d (bvecp) ())))))
+
+
+
+(defthm land-logand
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (land x y n)
+                  (logand x y)))
+  :hints (("Goal" :in-theory (e/d (binary-land)
+                                  ())
+           :induct (binary-land x y n))
+          ("Subgoal *1/4" :use ((:instance logand-def
+                                           (i x)
+                                           (j y))))))
+
+
+(defthm lior-logior
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lior x y n)
+                  (logior x y)))
+  :hints (("Goal" :in-theory (e/d (binary-lior)
+                                  ())
+           :induct (binary-lior x y n))
+          ("Subgoal *1/4" :use ((:instance logior-def
+                                           (i x)
+                                           (j y))))))
+
+(defthm lxor-logxor
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lxor x y n)
+                  (logxor x y)))
+  :hints (("Goal" :in-theory (e/d (binary-lxor)
+                                  ())
+           :induct (binary-lxor x y n))
+          ("Subgoal *1/4" :use ((:instance logxor-def
+                                           (i x)
+                                           (j y))))))
+
+
+;;;
+;;; then we have the following in the log.lisp
+;;;
+(encapsulate ()
+             (local (include-book "log"))
+
+             (DEFTHM LOGIOR-BVECP
+               (IMPLIES (AND (BVECP X N) (BVECP Y N))
+                        (BVECP (LOGIOR X Y) N)))
+           
+
+
+             (DEFTHM LOGAND-BVECP
+               (IMPLIES (AND (NATP N) (BVECP X N) (INTEGERP Y))
+                        (BVECP (LOGAND X Y) N)))
+
+             (defthm logxor-bvecp
+               (implies (and (bvecp x n)
+                             (bvecp y n)
+                             (natp n))
+                        (bvecp (logxor x y) n)))
+
+             )
+
+
+(encapsulate () 
+  (local (include-book "bvecp-raw-helpers"))
+
+  (defthm lnot-bvecp
+    (implies (and (<= n k)
+                  (case-split (integerp k)))
+             (bvecp (lnot x n) k))))
+
+
+
+
+
+         
+
+             
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn2log.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn2log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/logn2log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/logn2log.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,88 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "log")
+(include-book "logn")
+
+(local (include-book "logn2log-proofs"))
+
+(local (include-book "../../arithmetic/top"))
+
+;;;;
+;;;;
+
+
+(defthm land-logand
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (land x y n)
+                  (logand x y))))
+
+(defthm lior-logior
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lior x y n)
+                  (logior x y))))
+
+
+(defthm lxor-logxor
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lxor x y n)
+                  (logxor x y))))
+
+(defthm logior-bvecp
+  (implies (and (bvecp x n) (bvecp y n))
+           (bvecp (logior x y) n)))
+           
+
+
+(defthm logand-bvecp
+  (implies (and (natp n) (bvecp x n) (integerp y))
+           (bvecp (logand x y) n)))
+
+(defthm logxor-bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (bvecp (logxor x y) n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+
+
+
+
+         
+
+             
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/mult-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/mult-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/mult-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/mult-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,964 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "add-new")
+
+(local (include-book "../lib2/top"))
+(local (include-book "../../arithmetic/top"))
+(local (include-book "log-support"))
+
+(local 
+ (encapsulate () 
+              (local (include-book "bits-new-proofs"))
+
+             (defthm bits_alt-is-bits
+               (equal (bits_alt x i j)
+                      (bits x i j)))
+
+             
+             (defthm bitn_alt-is-bitn
+               (equal (bitn_alt x n)
+                      (bitn x n)))
+
+
+             (defthm binary-cat_alt-is-binary-cat
+               (equal (binary-cat_alt x m y n)
+                      (binary-cat x m y n)))
+
+             ))
+               
+
+	       
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta_alt (i y)
+  (+ (bitn_alt y (1- (* 2 i))) 
+     (bitn_alt y (* 2 i))
+     (* -2 (bitn_alt y (1+ (* 2 i))))))
+
+(local 
+ (defthm theta_alt-is-theta
+   (equal (theta_alt i y)
+          (theta i y))))
+
+
+
+(defun sum-theta_alt (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta_alt (1- m) y))
+	(sum-theta_alt (1- m) y))))
+
+
+(local 
+ (defthm sum-theta_alt-is-sum-theta
+   (equal (sum-theta_alt m y)
+          (sum-theta m y))))
+
+
+(defthm sum-theta_alt-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta_alt m y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-theta-lemma)))))
+
+
+
+
+
+(defun bmux4_alt (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits_alt (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits_alt (lognot (* 2 x)) (1- n) 0))
+    (0  0)))
+
+
+
+
+(local 
+ (defthm bmux4_alt-is-bmux4
+   (implies (and (natp n)
+                 (integerp x)
+                 (> n 0))
+            (equal (bmux4_alt zeta x n)
+                   (bmux4 zeta x n)))
+   :hints (("Goal" :in-theory (e/d (lnot-lognot) ())))))
+
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+
+(defun pp4_alt (i x n)
+  (if (zerop i)
+      (cat_alt 1 1
+	   (bitn_alt (lognot (neg (zeta i))) 0) 1
+	   (bmux4_alt (zeta i) x n) n)
+    (cat_alt 1 1
+	 (bitn_alt (lognot (neg (zeta i))) 0) 1
+	 (bmux4_alt (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+(local 
+ (defthm bvecp-mux4
+   (implies (and (bvecp x (+ -1 m))
+                 (natp m)
+                 (>= m n))
+            (BVECP (BMUX4 (ZETA 0) X N) m))
+   :hints (("Goal" :in-theory (e/d (bvecp bmux4 
+                                          expt-2-reduce-leading-constant) (ZETA-BND))
+            :use ((:instance zeta-bnd
+                             (i 0)))))))
+
+
+
+(local 
+ (defthm integerp-bmux4
+   (implies (integerp x)
+            (integerp (BMUX4 (ZETA i) X N)))
+   :rule-classes :type-prescription
+   :hints (("Goal" :in-theory (e/d (bmux4 
+                                    expt-2-reduce-leading-constant) (ZETA-BND))
+            :use ((:instance zeta-bnd
+                             (i i)))))))
+
+
+(local 
+ (defthm bvecp-0
+   (BVECP 0 n)
+   :hints (("Goal" :in-theory (e/d (bvecp) ())))))
+
+
+(local 
+ (defthm pp4_alt-is-pp4
+   (implies (and (natp n)
+                 (natp i)
+                 (bvecp x (+ -1 n))
+                 (integerp x)
+                 (> n 0))
+            (equal (pp4_alt i x n)
+                   (pp4 i x n)))
+   :hints (("Goal" :in-theory (e/d (lnot-lognot
+                                    bvecp-monotone
+                                    cat)
+                                   (bmux4 bmux4_alt))))))
+   
+
+
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4_alt (x m n)
+  (if (zp m)
+      0
+    (+ (pp4_alt (1- m) x n)
+       (sum-pp4_alt x (1- m) n))))
+
+(local 
+ (defthm sum-pp4_alt-is-sum-pp4
+   (implies (and (natp n)
+                 (natp i)
+                 (bvecp x (+ -1 n))
+                 (integerp x)
+                 (> n 0))
+            (equal (sum-pp4_alt x m n)
+                   (sum-pp4 x m n)))
+   :hints (("Goal" :in-theory (e/d () (pp4_alt pp4))))))
+
+
+
+(defthm booth4-thm_alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4_alt x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth4-thm))
+           :in-theory (e/d () (sum-pp4_alt sum-pp4)))))
+
+
+
+(defun pp4_alt-theta_alt (i x y n)
+   (if (zerop i)
+       (cat_alt 1 1
+	    (bitn_alt (lognot (neg (theta_alt i y))) 0) 1
+	    (bmux4_alt (theta_alt i y) x n) n)
+     (cat_alt 1 1
+	  (bitn_alt (lognot (neg (theta_alt i y))) 0) 1
+	  (bmux4_alt (theta_alt i y) x n) n
+	  0 1
+	  (neg (theta_alt (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+
+
+(local 
+ (defthm bvecp-mux4-theta
+   (implies (and (bvecp x (+ -1 m))
+                 (natp m)
+                 (>= m n))
+            (BVECP (BMUX4 (theta i y) X N) m))
+   :hints (("Goal" :in-theory (e/d (bvecp bmux4 
+                                          expt-2-reduce-leading-constant) (ZETA-BND))
+            :use ((:instance bitn-0-1
+                             (x y)
+                             (n (1- (* 2 I))))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n (* 2 I)))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n (+ 1 (* 2 I)))))))))
+                  
+                             
+
+
+
+
+(local 
+ (defthm integerp-bmux4-theta
+   (implies (integerp x)
+            (integerp (BMUX4 (theta i y) X N)))
+   :rule-classes :type-prescription
+   :hints (("Goal" :in-theory (e/d (bmux4 
+                                    expt-2-reduce-leading-constant) (ZETA-BND))
+            :use ((:instance bitn-0-1
+                             (x y)
+                             (n (1- (* 2 I))))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n (* 2 I)))
+                  (:instance bitn-0-1
+                             (x y)
+                             (n (+ 1 (* 2 I)))))))))
+
+
+
+
+(local 
+  (defthm pp4_alt-theta_alt-is-pp4-theta
+    (implies (and (not (zp n))
+                  (bvecp x (+ -1 n))
+                  (integerp i)
+                  (integerp y)
+                  (integerp x))
+             (equal (pp4_alt-theta_alt i x y n)
+                    (pp4-theta i x y n)))
+    :hints (("Goal" :in-theory (e/d ()
+                                    (theta_alt
+                                     theta
+                                     bmux4_alt
+                                     bmux4))))))
+
+
+
+(defun sum-pp4_alt-theta_alt (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4_alt-theta_alt (1- m) x y n)
+       (sum-pp4_alt-theta_alt x y (1- m) n))))
+
+
+(local 
+ (defthm sum-pp4_alt-theta_alt-is-sum-pp4-theta
+    (implies (and (not (zp n))
+                  (bvecp x (+ -1 n))
+                  (integerp i)
+                  (integerp y)
+                  (integerp x))
+             (equal (sum-pp4_alt-theta_alt x y m n)
+                    (sum-pp4-theta x y m n)))))
+          
+
+
+(defthm booth4-corollary-alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4_alt-theta_alt x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth4-corollary)))))
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu_alt (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits_alt y (1+ (* 2 i)) (* 2 i)) (chi_alt i y)))
+ 
+ (defun chi_alt (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu_alt (1- i) y) 3)
+	 1
+       0))))
+
+
+(local 
+ (encapsulate () 
+              (local (encapsulate () 
+
+                                  (defun mu-chi_alt (i y mode)
+                                    (declare (xargs :measure (if (and (not (equal mode 'mu))
+                                                                      (not (equal mode 'chi)))
+                                                                 0
+                                                               (m-mu-chi i mode))))
+                                    (if (equal mode 'mu)
+                                        (+ (bits_alt y (1+ (* 2 i)) (* 2 i)) (mu-chi_alt i y 'chi))
+                                      (if (equal mode 'chi)
+                                          (if (zp i)
+                                              0
+                                            (if (>= (mu-chi_alt (1- i) y 'mu) 3)
+                                                1
+                                              0))
+                                        nil)))
+
+        
+                                  (defthm mu-chi_alt-is
+                                    (equal (mu-chi_alt i y mode)
+                                           (if (equal mode 'mu)
+                                               (mu_alt i y)
+                                             (if (equal mode 'chi)
+                                                 (chi_alt i y)
+                                               (mu-chi_alt i y mode))))
+                                    :rule-classes nil)
+
+
+
+
+        
+                                  (defthm mu-chi_alt-is-2
+                                    (equal (mu-chi_alt i y mode)
+                                           (if (equal mode 'mu)
+                                               (mu i y)
+                                             (if (equal mode 'chi)
+                                                 (chi i y)
+                                               (mu-chi_alt i y mode))))
+                                    :rule-classes nil)
+                                  ))
+
+              (defthm mu_alt-is-mu
+                (equal (mu_alt i y)
+                       (mu i y))
+                :hints (("Goal" :use ((:instance mu-chi_alt-is
+                                                 (mode 'mu))
+                                      (:instance mu-chi_alt-is-2
+                                                 (mode 'mu))))))
+
+
+
+              (defthm chi_alt-is-chi
+                (equal (chi_alt i y)
+                       (chi i y))
+                :hints (("Goal" :use ((:instance mu-chi_alt-is
+                                                 (mode 'chi))
+                                      (:instance mu-chi_alt-is-2
+                                                 (mode 'chi))))))
+                        
+
+              ))
+
+
+  
+
+(defun phi_alt (i y)
+  (if (= (bits_alt (mu_alt i y) 1 0) 3)
+      -1
+    (bits_alt (mu_alt i y) 1 0)))
+
+(local 
+ (defthm phi_alt-is-phi
+   (equal (phi_alt i y)
+          (phi i y))))
+
+
+
+(defthm phi-bnd-alt
+    (member (phi_alt i y) '(-1 0 1 2))
+    :hints (("Goal" :in-theory (e/d (phi-bnd) (phi_alt phi)))))
+
+
+
+
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+
+(defthm chi_alt-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi_alt m y) 0))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance chi-m))
+           :in-theory (e/d () (chi_alt chi)))))
+
+
+(defthm phi_alt-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi_alt (1- m) y) 0))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance phi-m-1))
+           :in-theory (e/d () (phi_alt phi)))))
+
+
+(defun sum-phi_alt (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi_alt (1- m) y))
+	(sum-phi_alt (1- m) y))))
+
+
+(local 
+ (defthm sum-phi_alt-is-sum-phi
+   (equal (sum-phi_alt m y)
+          (sum-phi m y))
+   :hints (("Goal" :in-theory (e/d () (phi_alt
+                                       phi))))))
+
+
+
+(defthm sum-phi_alt-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi_alt m y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-phi-lemma)))))
+
+
+(defun pp4_alt-phi_alt (i x y n)
+   (if (zerop i)
+       (cat_alt 1 1
+	    (bitn_alt (lognot (neg (phi_alt i y))) 0) 1
+	    (bmux4_alt (phi_alt i y) x n) n)
+     (cat_alt 1 1
+	  (bitn_alt (lognot (neg (phi_alt i y))) 0) 1
+	  (bmux4_alt (phi_alt i y) x n) n
+	  0 1
+	  (neg (phi_alt (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+
+(local 
+ (defthm pp4_alt-phi_alt-is-pp4-phi
+   (implies (and (integerp x)
+                 (natp n)
+                 (> n 0))
+            (equal (pp4_alt-phi_alt i x y n)
+                   (pp4-phi i x y n)))
+   :hints (("Goal" :in-theory (e/d () (phi_alt
+                                       phi
+                                       pp4_alt
+                                       pp4
+                                       bmux4_alt
+                                       bmux4))))))
+                                       
+
+
+
+(defun sum-pp4_alt-phi_alt (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4_alt-phi_alt (1- m) x y n)
+       (sum-pp4_alt-phi_alt x y (1- m) n))))
+
+(local 
+ (defthm sum-pp4_alt-phi_alt-is-sum-pp4-phi
+   (implies (and (integerp x)
+                 (natp n)
+                 (> n 0))
+            (equal (sum-pp4_alt-phi_alt x y m n)
+                   (sum-pp4-phi x y m n)))
+   :hints (("Goal" :in-theory (e/d () 
+                                   (pp4-phi
+                                    pp4_alt-phi_alt))))))
+
+
+
+
+(defthm static-booth-alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4_alt-phi_alt x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance static-booth)))))
+           
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+
+(defun gamma_alt (i a b c)
+   (if (zp i)
+       (bitn_alt c 0)
+     (logior (bitn_alt  a (+ -1  (* 2 i)))
+ 	     (bitn_alt  b (+ -1  (* 2 i))))))
+
+(local 
+ (defthm gamma_alt-is-gamma
+   (equal (gamma_alt i a b c)
+          (gamma i a b c))
+   :hints (("Goal" :use ((:instance bitn-0-1
+                                    (x a)
+                                    (n (+ -1 (* 2 I))))
+                         (:instance bitn-0-1
+                                    (x b)
+                                    (n (+ -1 (* 2 I)))))))))
+                         
+
+
+(defun delta_alt (i a b c d)
+  (if (zp i)
+      (bitn_alt d 0)
+    (logand (logior (logand (bitn_alt a (+ -2 (* 2 i))) 
+			    (bitn_alt b (+ -2 (* 2 i))))
+		    (logior (logand (bitn_alt a (+ -2 (* 2 i)))
+				    (gamma_alt (1- i) a b c))
+			    (logand (bitn_alt b (+ -2 (* 2 i)))
+				    (gamma_alt (1- i) a b c))))
+	    (lognot (logxor (bitn_alt a (1- (* 2 i))) 
+			    (bitn_alt b (1- (* 2 i))))))))
+
+
+
+(local 
+ (DEFTHM LOGAND-BVECP-G_alt
+   (IMPLIES (AND (NATP N) (BVECP Y N) (INTEGERP X))
+            (BVECP (LOGAND X Y) N))
+   :hints (("Goal" :use ((:instance logand-bvecp-g
+                                    (x y)
+                                    (y x)))
+            :in-theory (e/d () (logand-bvecp-g))))))
+ 
+
+
+(local 
+ (defthm delta_alt-is-delta
+   (equal (delta_alt i a b c d)
+          (delta i a b c d))
+   :hints (("Goal" :in-theory (e/d (land-logand
+                                    logand-bitn-reduce
+                                    lnot-lognot
+                                    lxor-logxor
+                                    lior-logior)
+                                   (gamma_alt
+                                    gamma))))))
+                         
+
+;;;;
+;;;;
+;;;;
+
+(defun psi_alt (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits_alt a (1+ (* 2 i)) (* 2 i))
+       (bits_alt b (1+ (* 2 i)) (* 2 i))
+       (gamma_alt i a b c)
+       (delta_alt i a b c d)
+       (* -4 (+ (gamma_alt (1+ i) a b c)
+                (delta_alt (1+ i) a b c d))))))
+
+
+(local 
+ (defthm psi_alt-is-psi
+   (equal (psi_alt i a b c d)
+          (psi i a b c d))
+   :hints (("Goal" :in-theory (e/d () (delta_alt
+                                       delta
+                                       gamma_alt
+                                       gamma))))))
+
+
+
+(defthm psi_alt-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))   
+		  (bvecp b (- (* 2 m) 2))  
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma_alt m a b c) 0)
+		  (equal (delta_alt m a b c d) 0)
+		  (>= (psi_alt (1- m) a b c d) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance psi-m-1))
+           :in-theory (e/d () 
+                           (psi_alt
+                            psi
+                            gamma_alt
+                            gamma
+                            delta_alt
+                            delta)))))
+
+
+
+(defun sum-psi_alt (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi_alt (1- m) a b c d))
+	(sum-psi_alt (1- m) a b c d))))
+
+
+(local 
+ (defthm sum-psi_alt-is-sum-psi
+   (equal (sum-psi_alt m a b c d)
+          (sum-psi m a b c d))
+   :hints (("Goal" :in-theory (e/d () (psi_alt psi))))))
+
+
+
+(defthm sum-psi_alt-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi_alt m a b c d)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-psi-lemma)))))
+           
+
+
+
+(defthmd psi_alt-bnd
+  (and (integerp (psi_alt i a b c d))
+       (<= (psi_alt i a b c d) 2)
+       (>= (psi_alt i a b c d) -2))
+  :hints (("Goal" :use ((:instance psi-bnd)))))
+
+(defun pp4_alt-psi_alt (i x a b c d n)
+   (if (zerop i)
+       (cat_alt 1 1
+	    (bitn_alt (lognot (neg (psi_alt i a b c d))) 0) 1
+	    (bmux4_alt (psi_alt i a b c d) x n) n)
+     (cat_alt 1 1
+	  (bitn_alt (lognot (neg (psi_alt i a b c d))) 0) 1
+	  (bmux4_alt (psi_alt i a b c d) x n) n
+	  0 1
+	  (neg (psi_alt (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+
+(local 
+ (defthm pp4_alt-psi_alt-is-pp4-psi
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (pp4_alt-psi_alt i x a b c d n)
+                   (pp4-psi i x a b c d n)))
+   :hints (("Goal" :in-theory (e/d () 
+                                   (bmux4_alt
+                                    bmux4
+                                    psi_alt
+                                    psi))))))
+
+
+(defun sum-pp4_alt-psi_alt (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4_alt-psi_alt (1- m) x a b c d n)
+       (sum-pp4_alt-psi_alt x a b c d (1- m) n))))
+
+
+(local 
+ (defthm sum-pp4_alt-psi_alt-is-sum-pp4-psi
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (sum-pp4_alt-psi_alt x a b c d m n)
+                   (sum-pp4-psi x a b c d m n)))
+   :hints (("Goal" :in-theory (e/d () 
+                                   (pp4_alt-psi_alt
+                                    pp4-psi))))))
+
+
+
+
+
+(defthm redundant-booth_alt
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4_alt-psi_alt x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance redundant-booth)))))
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+
+(defun eta_alt (i y)
+  (+ (bitn_alt y (1- (* 3 i))) 
+     (bitn_alt y (* 3 i))
+     (* 2 (bitn_alt y (1+ (* 3 i))))
+     (* -4 (bitn_alt y (+ 2 (* 3 i))))))
+
+
+(local 
+ (defthm eta_alt-is-eta
+   (equal (eta_alt i y)
+          (eta i y))))
+
+
+(defun sum-eta_alt (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta_alt (1- m) y))
+	(sum-eta_alt (1- m) y))))
+
+(local 
+ (defthm sum-eta_alt-is-sum-eta
+   (equal (sum-eta_alt m y)
+          (sum-eta m y))))
+
+
+(defthm sum-eta_alt-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta_alt m y)))
+  :rule-classes ()
+  :hints (("Goal"   :use ((:instance sum-eta-lemma)))))
+
+
+
+
+(defun bmux8_alt (zeta_alt x n)
+  (case zeta_alt
+    (1  x)
+    (-1 (bits_alt (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits_alt (lognot (* 2 x)) (1- n) 0))
+    (3  (* 3 x))
+    (-3 (bits_alt (lognot (* 3 x)) (1- n) 0))
+    (4  (* 4 x))
+    (-4 (bits_alt (lognot (* 4 x)) (1- n) 0))
+    (0  0)))
+
+
+
+(local 
+ (defthm bmux8_alt-is-bmux8
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (bmux8_alt zeta x n)
+                   (bmux8 zeta x n)))
+   :hints (("Goal" :in-theory (e/d (lnot-lognot) ())))))
+
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+
+(defun pp8_alt (i x n)
+  (if (zerop i)
+      (cat_alt 3 2
+	   (bitn_alt (lognot (neg (xi i))) 0) 1
+	   (bmux8_alt (xi i) x n) n)
+    (cat_alt 3 2
+	 (bitn_alt (lognot (neg (xi i))) 0) 1
+	 (bmux8_alt (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+
+(local 
+ (defthm pp8_alt-is-pp8
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (pp8_alt i x n)
+                   (pp8 i x n)))
+   :hints (("Goal" :in-theory (e/d () (bmux8_alt
+                                       bmux8))))))
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8_alt (x m n)
+  (if (zp m)
+      0
+    (+ (pp8_alt (1- m) x n)
+       (sum-pp8_alt x (1- m) n))))
+
+
+(local 
+ (defthm sum-pp8_alt-sum-pp8
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (sum-pp8_alt x m n)
+                   (sum-pp8 x m n)))
+   :hints (("Goal" :in-theory (e/d () (pp8_alt pp8))))))
+
+
+
+(defthm booth8-thm_alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8_alt x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth8-thm))
+           :in-theory (e/d () (sum-pp8_alt sum-pp8)))))
+
+
+(defun pp8_alt-eta_alt (i x y n)
+  (if (zerop i)
+      (cat_alt 3 2
+	   (bitn_alt (lognot (neg (eta_alt i y))) 0) 1
+	   (bmux8_alt (eta_alt i y) x n) n)
+    (cat_alt 3 2
+	 (bitn_alt (lognot (neg (eta_alt i y))) 0) 1
+	 (bmux8_alt (eta_alt i y) x n) n
+	 0 2
+	 (neg (eta_alt (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+(local 
+ (defthm pp8_alt-eta_alt-is-pp8-eta
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (pp8_alt-eta_alt i x y n)
+                   (pp8-eta i x y n)))
+   :hints (("Goal" :in-theory (e/d (lnot-lognot)
+                                   (bmux8_alt
+                                    bmux8
+                                    eta_alt
+                                    eta))))))
+
+
+(defun sum-pp8_alt-eta_alt (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8_alt-eta_alt (1- m) x y n)
+       (sum-pp8_alt-eta_alt x y (1- m) n))))
+
+
+
+(local 
+ (defthm sum-pp8_alt-eta_alt-is-sum-pp8-eta
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (sum-pp8_alt-eta_alt x y m n)
+                   (sum-pp8-eta x y m n)))
+   :hints (("Goal" :in-theory (e/d () (pp8_alt-eta_alt
+                                       pp8-eta))))))
+
+
+(defthm booth8-corollary_alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8_alt-eta_alt x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth8-corollary)))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/mult-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/mult-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/mult-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/mult-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,523 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "add-new")
+
+(local (include-book "mult-new-proofs"))
+	       
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta_alt (i y)
+  (+ (bitn_alt y (1- (* 2 i))) 
+     (bitn_alt y (* 2 i))
+     (* -2 (bitn_alt y (1+ (* 2 i))))))
+
+
+(defun sum-theta_alt (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta_alt (1- m) y))
+	(sum-theta_alt (1- m) y))))
+
+
+(defthm sum-theta_alt-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta_alt m y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-theta-lemma)))))
+
+
+(defun bmux4_alt (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits_alt (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits_alt (lognot (* 2 x)) (1- n) 0))
+    (0  0)))
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+
+(defun pp4_alt (i x n)
+  (if (zerop i)
+      (cat_alt 1 1
+	   (bitn_alt (lognot (neg (zeta i))) 0) 1
+	   (bmux4_alt (zeta i) x n) n)
+    (cat_alt 1 1
+	 (bitn_alt (lognot (neg (zeta i))) 0) 1
+	 (bmux4_alt (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4_alt (x m n)
+  (if (zp m)
+      0
+    (+ (pp4_alt (1- m) x n)
+       (sum-pp4_alt x (1- m) n))))
+
+
+(defthm booth4-thm_alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4_alt x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth4-thm))
+           :in-theory (e/d () (sum-pp4_alt sum-pp4)))))
+
+
+
+(defun pp4_alt-theta_alt (i x y n)
+   (if (zerop i)
+       (cat_alt 1 1
+	    (bitn_alt (lognot (neg (theta_alt i y))) 0) 1
+	    (bmux4_alt (theta_alt i y) x n) n)
+     (cat_alt 1 1
+	  (bitn_alt (lognot (neg (theta_alt i y))) 0) 1
+	  (bmux4_alt (theta_alt i y) x n) n
+	  0 1
+	  (neg (theta_alt (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+
+
+(defun sum-pp4_alt-theta_alt (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4_alt-theta_alt (1- m) x y n)
+       (sum-pp4_alt-theta_alt x y (1- m) n))))
+
+
+(defthm booth4-corollary-alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4_alt-theta_alt x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth4-corollary)))))
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu_alt (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits_alt y (1+ (* 2 i)) (* 2 i)) (chi_alt i y)))
+ 
+ (defun chi_alt (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu_alt (1- i) y) 3)
+	 1
+       0))))
+
+  
+
+(defun phi_alt (i y)
+  (if (= (bits_alt (mu_alt i y) 1 0) 3)
+      -1
+    (bits_alt (mu_alt i y) 1 0)))
+
+
+(defthm phi-bnd-alt
+    (member (phi_alt i y) '(-1 0 1 2))
+    :hints (("Goal" :in-theory (e/d (phi-bnd) (phi_alt phi)))))
+
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+
+(defthm chi_alt-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi_alt m y) 0))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance chi-m))
+           :in-theory (e/d () (chi_alt chi)))))
+
+
+(defthm phi_alt-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi_alt (1- m) y) 0))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance phi-m-1))
+           :in-theory (e/d () (phi_alt phi)))))
+
+
+(defun sum-phi_alt (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi_alt (1- m) y))
+	(sum-phi_alt (1- m) y))))
+
+
+(defthm sum-phi_alt-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi_alt m y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-phi-lemma)))))
+
+
+(defun pp4_alt-phi_alt (i x y n)
+   (if (zerop i)
+       (cat_alt 1 1
+	    (bitn_alt (lognot (neg (phi_alt i y))) 0) 1
+	    (bmux4_alt (phi_alt i y) x n) n)
+     (cat_alt 1 1
+	  (bitn_alt (lognot (neg (phi_alt i y))) 0) 1
+	  (bmux4_alt (phi_alt i y) x n) n
+	  0 1
+	  (neg (phi_alt (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+
+(defun sum-pp4_alt-phi_alt (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4_alt-phi_alt (1- m) x y n)
+       (sum-pp4_alt-phi_alt x y (1- m) n))))
+
+
+
+(defthm static-booth-alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4_alt-phi_alt x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance static-booth)))))
+           
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+
+(defun gamma_alt (i a b c)
+   (if (zp i)
+       (bitn_alt c 0)
+     (logior (bitn_alt  a (+ -1  (* 2 i)))
+ 	     (bitn_alt  b (+ -1  (* 2 i))))))
+
+
+(defun delta_alt (i a b c d)
+  (if (zp i)
+      (bitn_alt d 0)
+    (logand (logior (logand (bitn_alt a (+ -2 (* 2 i))) 
+			    (bitn_alt b (+ -2 (* 2 i))))
+		    (logior (logand (bitn_alt a (+ -2 (* 2 i)))
+				    (gamma_alt (1- i) a b c))
+			    (logand (bitn_alt b (+ -2 (* 2 i)))
+				    (gamma_alt (1- i) a b c))))
+	    (lognot (logxor (bitn_alt a (1- (* 2 i))) 
+			    (bitn_alt b (1- (* 2 i))))))))
+
+
+;;;;;;
+
+
+(defun psi_alt (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits_alt a (1+ (* 2 i)) (* 2 i))
+       (bits_alt b (1+ (* 2 i)) (* 2 i))
+       (gamma_alt i a b c)
+       (delta_alt i a b c d)
+       (* -4 (+ (gamma_alt (1+ i) a b c)
+                (delta_alt (1+ i) a b c d))))))
+
+
+(defthm psi_alt-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))   
+		  (bvecp b (- (* 2 m) 2))  
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma_alt m a b c) 0)
+		  (equal (delta_alt m a b c d) 0)
+		  (>= (psi_alt (1- m) a b c d) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance psi-m-1))
+           :in-theory (e/d () 
+                           (psi_alt
+                            psi
+                            gamma_alt
+                            gamma
+                            delta_alt
+                            delta)))))
+
+
+
+(defun sum-psi_alt (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi_alt (1- m) a b c d))
+	(sum-psi_alt (1- m) a b c d))))
+
+
+
+(defthm sum-psi_alt-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi_alt m a b c d)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-psi-lemma)))))
+           
+
+
+
+(defthmd psi_alt-bnd
+  (and (integerp (psi_alt i a b c d))
+       (<= (psi_alt i a b c d) 2)
+       (>= (psi_alt i a b c d) -2))
+  :hints (("Goal" :use ((:instance psi-bnd)))))
+
+(defun pp4_alt-psi_alt (i x a b c d n)
+   (if (zerop i)
+       (cat_alt 1 1
+	    (bitn_alt (lognot (neg (psi_alt i a b c d))) 0) 1
+	    (bmux4_alt (psi_alt i a b c d) x n) n)
+     (cat_alt 1 1
+	  (bitn_alt (lognot (neg (psi_alt i a b c d))) 0) 1
+	  (bmux4_alt (psi_alt i a b c d) x n) n
+	  0 1
+	  (neg (psi_alt (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+
+(defun sum-pp4_alt-psi_alt (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4_alt-psi_alt (1- m) x a b c d n)
+       (sum-pp4_alt-psi_alt x a b c d (1- m) n))))
+
+
+(defthm redundant-booth_alt
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4_alt-psi_alt x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance redundant-booth)))))
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+
+(defun eta_alt (i y)
+  (+ (bitn_alt y (1- (* 3 i))) 
+     (bitn_alt y (* 3 i))
+     (* 2 (bitn_alt y (1+ (* 3 i))))
+     (* -4 (bitn_alt y (+ 2 (* 3 i))))))
+
+
+(defun sum-eta_alt (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta_alt (1- m) y))
+	(sum-eta_alt (1- m) y))))
+
+
+(defthm sum-eta_alt-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta_alt m y)))
+  :rule-classes ()
+  :hints (("Goal"   :use ((:instance sum-eta-lemma)))))
+
+
+
+
+(defun bmux8_alt (zeta_alt x n)
+  (case zeta_alt
+    (1  x)
+    (-1 (bits_alt (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits_alt (lognot (* 2 x)) (1- n) 0))
+    (3  (* 3 x))
+    (-3 (bits_alt (lognot (* 3 x)) (1- n) 0))
+    (4  (* 4 x))
+    (-4 (bits_alt (lognot (* 4 x)) (1- n) 0))
+    (0  0)))
+
+
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+
+(defun pp8_alt (i x n)
+  (if (zerop i)
+      (cat_alt 3 2
+	   (bitn_alt (lognot (neg (xi i))) 0) 1
+	   (bmux8_alt (xi i) x n) n)
+    (cat_alt 3 2
+	 (bitn_alt (lognot (neg (xi i))) 0) 1
+	 (bmux8_alt (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8_alt (x m n)
+  (if (zp m)
+      0
+    (+ (pp8_alt (1- m) x n)
+       (sum-pp8_alt x (1- m) n))))
+
+
+(defthm booth8-thm_alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8_alt x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth8-thm))
+           :in-theory (e/d () (sum-pp8_alt sum-pp8)))))
+
+
+(defun pp8_alt-eta_alt (i x y n)
+  (if (zerop i)
+      (cat_alt 3 2
+	   (bitn_alt (lognot (neg (eta_alt i y))) 0) 1
+	   (bmux8_alt (eta_alt i y) x n) n)
+    (cat_alt 3 2
+	 (bitn_alt (lognot (neg (eta_alt i y))) 0) 1
+	 (bmux8_alt (eta_alt i y) x n) n
+	 0 2
+	 (neg (eta_alt (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+
+(defun sum-pp8_alt-eta_alt (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8_alt-eta_alt (1- m) x y n)
+       (sum-pp8_alt-eta_alt x y (1- m) n))))
+
+
+(defthm booth8-corollary_alt
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8_alt-eta_alt x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth8-corollary)))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/mult-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/mult-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/mult-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/mult-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,855 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "add")
+
+(local (include-book "mult-new"))
+
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+
+
+
+	       
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta (i y)
+  (+ (bitn y (1- (* 2 i))) 
+     (bitn y (* 2 i))
+     (* -2 (bitn y (1+ (* 2 i))))))
+
+(local 
+ (defthm theta-is-theta_alt
+   (equal (theta i y)
+          (theta_alt i y))))
+
+
+
+(defun sum-theta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta (1- m) y))
+	(sum-theta (1- m) y))))
+
+
+(local 
+ (defthm sum-theta-is-sum-theta_alt
+   (equal (sum-theta m y)
+          (sum-theta_alt m y))))
+
+
+(defthm sum-theta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta m y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-theta_alt-lemma)))))
+
+
+(defun bmux4 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (0  0)))
+
+
+
+
+(local 
+ (defthm bmux4-is-bmux4_alt
+   (implies (and (natp n)
+                 (integerp x)
+                 (> n 0))
+            (equal (bmux4 zeta x n)
+                   (bmux4_alt zeta x n)))
+   :hints (("Goal" :in-theory (e/d (bmux4_alt
+                                    bmux4) ())))))
+
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+
+(defun pp4 (i x n)
+  (if (zerop i)
+      (cat 1 1
+	   (bitn (lognot (neg (zeta i))) 0) 1
+	   (bmux4 (zeta i) x n) n)
+    (cat 1 1
+	 (bitn (lognot (neg (zeta i))) 0) 1
+	 (bmux4 (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+
+(local 
+ (defthm pp4-is-pp4_alt
+   (implies (and (natp n)
+                 (natp i)
+                 (bvecp x (+ -1 n))
+                 (integerp x)
+                 (> n 0))
+            (equal (pp4 i x n)
+                   (pp4_alt i x n)))
+   :hints (("Goal" :in-theory (e/d (pp4 pp4_alt) ())))))
+   
+
+
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4 (x m n)
+  (if (zp m)
+      0
+    (+ (pp4 (1- m) x n)
+       (sum-pp4 x (1- m) n))))
+
+(local 
+ (defthm sum-pp4-is-sum-pp4_alt
+   (implies (and (natp n)
+                 (bvecp x (+ -1 n))
+                 (integerp x)
+                 (> n 0))
+            (equal (sum-pp4 x m n)
+                   (sum-pp4_alt x m n)))
+   :hints (("Goal" :in-theory (e/d () (pp4 pp4_alt))))))
+
+
+
+(defthm booth4-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4 x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth4-thm_alt))
+           :in-theory (e/d () (sum-zeta sum-pp4 sum-pp4_alt)))))
+
+
+
+
+(defun pp4-theta (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (theta i y))) 0) 1
+	    (bmux4 (theta i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (theta i y))) 0) 1
+	  (bmux4 (theta i y) x n) n
+	  0 1
+	  (neg (theta (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(local 
+  (defthm pp4-theta-is-pp4-theta_alt
+    (implies (and (not (zp n))
+                  (bvecp x (+ -1 n))
+                  (integerp i)
+                  (integerp y)
+                  (integerp x))
+             (equal (pp4-theta i x y n)
+                    (pp4_alt-theta_alt i x y n)))
+    :hints (("Goal" :in-theory (e/d (pp4_alt-theta_alt 
+                                     pp4-theta)
+                                    ())))))
+
+
+
+(defun sum-pp4-theta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-theta (1- m) x y n)
+       (sum-pp4-theta x y (1- m) n))))
+
+
+(local 
+ (defthm sum-pp4-theta-is-sum-pp4_alt-theta_alt
+    (implies (and (not (zp n))
+                  (bvecp x (+ -1 n))
+                  (integerp i)
+                  (integerp y)
+                  (integerp x))
+             (equal (sum-pp4-theta x y m n)
+                    (sum-pp4_alt-theta_alt x y m n)))))
+          
+
+
+(defthm booth4-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth4-corollary-alt)))))
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits y (1+ (* 2 i)) (* 2 i)) (chi i y)))
+ 
+ (defun chi (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu (1- i) y) 3)
+	 1
+       0))))
+
+
+(local 
+ (encapsulate () 
+              (local (encapsulate () 
+
+                                  (defun mu-chi (i y mode)
+                                    (declare (xargs :measure (if (and (not (equal mode 'mu))
+                                                                      (not (equal mode 'chi)))
+                                                                 0
+                                                               (m-mu-chi i mode))))
+                                    (if (equal mode 'mu)
+                                        (+ (bits y (1+ (* 2 i)) (* 2 i)) (mu-chi i y 'chi))
+                                      (if (equal mode 'chi)
+                                          (if (zp i)
+                                              0
+                                            (if (>= (mu-chi (1- i) y 'mu) 3)
+                                                1
+                                              0))
+                                        nil)))
+
+        
+                                  (defthm mu-chi-is
+                                    (equal (mu-chi i y mode)
+                                           (if (equal mode 'mu)
+                                               (mu_alt i y)
+                                             (if (equal mode 'chi)
+                                                 (chi_alt i y)
+                                               (mu-chi i y mode))))
+                                    :rule-classes nil)
+
+
+
+
+        
+                                  (defthm mu-chi-is-2
+                                    (equal (mu-chi i y mode)
+                                           (if (equal mode 'mu)
+                                               (mu i y)
+                                             (if (equal mode 'chi)
+                                                 (chi i y)
+                                               (mu-chi i y mode))))
+                                    :rule-classes nil)
+                                  ))
+
+              (defthm mu-is-mu
+                (equal (mu i y)
+                       (mu_alt i y))
+                :hints (("Goal" :use ((:instance mu-chi-is
+                                                 (mode 'mu))
+                                      (:instance mu-chi-is-2
+                                                 (mode 'mu))))))
+
+
+
+              (defthm chi-is-chi
+                (equal (chi i y)
+                       (chi_alt i y))
+                :hints (("Goal" :use ((:instance mu-chi-is
+                                                 (mode 'chi))
+                                      (:instance mu-chi-is-2
+                                                 (mode 'chi))))))
+                        
+
+              ))
+
+
+  
+
+(defun phi (i y)
+  (if (= (bits (mu i y) 1 0) 3)
+      -1
+    (bits (mu i y) 1 0)))
+
+(local 
+ (defthm phi-is-phi_alt
+   (equal (phi i y)
+          (phi_alt i y))))
+
+
+
+(defthm phi-bnd
+    (member (phi i y) '(-1 0 1 2))
+    :hints (("Goal" :in-theory (e/d (phi-bnd-alt)
+                                    (phi phi_alt)))))
+
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+
+(defthm chi-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance chi_alt-m)))))
+
+
+
+(defthm phi-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi (1- m) y) 0))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance phi_alt-m-1)))))
+
+
+(defun sum-phi (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi (1- m) y))
+	(sum-phi (1- m) y))))
+
+
+(local 
+ (defthm sum-phi-is-sum-phi_alt
+   (equal (sum-phi m y)
+          (sum-phi_alt m y))
+   :hints (("Goal" :in-theory (e/d () (phi_alt
+                                       phi))))))
+
+
+
+(defthm sum-phi-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi m y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-phi_alt-lemma)))))
+
+
+(defun pp4-phi (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (phi i y))) 0) 1
+	    (bmux4 (phi i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (phi i y))) 0) 1
+	  (bmux4 (phi i y) x n) n
+	  0 1
+	  (neg (phi (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+
+(local 
+ (defthm pp4-phi-is-pp4_alt-phi_alt
+   (implies (and (integerp x)
+                 (natp n)
+                 (> n 0))
+            (equal (pp4-phi i x y n)
+                   (pp4_alt-phi_alt i x y n)))
+   :hints (("Goal" :in-theory (e/d () (phi_alt
+                                       phi
+                                       pp4_alt
+                                       pp4
+                                       bmux4_alt
+                                       bmux4))))))
+                                       
+
+
+
+(defun sum-pp4-phi (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-phi (1- m) x y n)
+       (sum-pp4-phi x y (1- m) n))))
+
+(local 
+ (defthm sum-pp4-phi-is-sum-pp4_alt-phi_alt
+   (implies (and (integerp x)
+                 (natp n)
+                 (> n 0))
+            (equal (sum-pp4-phi x y m n)
+                   (sum-pp4_alt-phi_alt x y m n)))
+   :hints (("Goal" :in-theory (e/d () 
+                                   (pp4_alt-phi_alt
+                                    pp4-phi))))))
+
+
+
+
+(defthm static-booth
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance static-booth-alt)))))
+           
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+
+(defun gamma (i a b c)
+   (if (zp i)
+       (bitn c 0)
+     (logior (bitn  a (+ -1  (* 2 i)))
+ 	     (bitn  b (+ -1  (* 2 i))))))
+
+(local 
+ (defthm gamma-is-gamma_alt
+   (equal (gamma i a b c)
+          (gamma_alt i a b c))
+   :hints (("Goal" :in-theory (e/d (gamma_alt gamma) ())))))
+                         
+
+
+(defun delta (i a b c d)
+  (if (zp i)
+      (bitn d 0)
+    (logand (logior (logand (bitn a (+ -2 (* 2 i))) 
+			    (bitn b (+ -2 (* 2 i))))
+		    (logior (logand (bitn a (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))
+			    (logand (bitn b (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))))
+	    (lognot (logxor (bitn a (1- (* 2 i))) 
+			    (bitn b (1- (* 2 i))))))))
+
+
+(local 
+ (defthm delta-is-delta_alt
+   (equal (delta i a b c d)
+          (delta_alt i a b c d))
+   :hints (("Goal" :in-theory (e/d (delta_alt delta) ())))))
+                         
+
+
+(defun psi (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits a (1+ (* 2 i)) (* 2 i))
+       (bits b (1+ (* 2 i)) (* 2 i))
+       (gamma i a b c)
+       (delta i a b c d)
+       (* -4 (+ (gamma (1+ i) a b c)
+                (delta (1+ i) a b c d))))))
+
+
+(local 
+ (defthm psi-is-psi_alt
+   (equal (psi i a b c d)
+          (psi_alt i a b c d))
+   :hints (("Goal" :in-theory (e/d () (delta_alt
+                                       delta
+                                       gamma_alt
+                                       gamma))))))
+
+
+
+(defthm psi-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))   
+		  (bvecp b (- (* 2 m) 2))  
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma m a b c) 0)
+		  (equal (delta m a b c d) 0)
+		  (>= (psi (1- m) a b c d) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance psi_alt-m-1))
+           :in-theory (e/d () 
+                           (psi
+                            psi_alt
+                            gamma
+                            gamma_alt
+                            delta_alt
+                            delta)))))
+
+
+
+(defun sum-psi (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi (1- m) a b c d))
+	(sum-psi (1- m) a b c d))))
+
+
+(local 
+ (defthm sum-psi-is-sum-psi
+   (equal (sum-psi m a b c d)
+          (sum-psi_alt m a b c d))
+   :hints (("Goal" :in-theory (e/d () (psi psi_alt))))))
+
+
+
+(defthm sum-psi-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi m a b c d)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sum-psi_alt-lemma)))))
+           
+
+
+
+(defthmd psi-bnd
+  (and (integerp (psi i a b c d))
+       (<= (psi i a b c d) 2)
+       (>= (psi i a b c d) -2))
+  :hints (("Goal" :use ((:instance psi_alt-bnd)))))
+
+(defun pp4-psi (i x a b c d n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (psi i a b c d))) 0) 1
+	    (bmux4 (psi i a b c d) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (psi i a b c d))) 0) 1
+	  (bmux4 (psi i a b c d) x n) n
+	  0 1
+	  (neg (psi (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+
+(local 
+ (defthm pp4-psi-is-pp4_alt-psi_alt
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (pp4-psi i x a b c d n)
+                   (pp4_alt-psi_alt i x a b c d n)))
+   :hints (("Goal" :in-theory (e/d () 
+                                   (bmux4_alt
+                                    bmux4
+                                    psi_alt
+                                    psi))))))
+
+
+(defun sum-pp4-psi (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4-psi (1- m) x a b c d n)
+       (sum-pp4-psi x a b c d (1- m) n))))
+
+
+(local 
+ (defthm sum-pp4-psi-is-sum-pp4-psi
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (sum-pp4-psi x a b c d m n)
+                   (sum-pp4_alt-psi_alt x a b c d m n)))
+   :hints (("Goal" :in-theory (e/d () 
+                                   (pp4_alt-psi_alt
+                                    pp4-psi))))))
+
+
+
+
+
+(defthm redundant-booth
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance redundant-booth_alt)))))
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+
+(defun eta (i y)
+  (+ (bitn y (1- (* 3 i))) 
+     (bitn y (* 3 i))
+     (* 2 (bitn y (1+ (* 3 i))))
+     (* -4 (bitn y (+ 2 (* 3 i))))))
+
+
+(local 
+ (defthm eta-is-eta_alt
+   (equal (eta i y)
+          (eta_alt i y))))
+
+
+(defun sum-eta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta (1- m) y))
+	(sum-eta (1- m) y))))
+
+(local 
+ (defthm sum-eta-is-sum-eta_alt
+   (equal (sum-eta m y)
+          (sum-eta_alt m y))))
+
+
+(defthm sum-eta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta m y)))
+  :rule-classes ()
+  :hints (("Goal"   :use ((:instance sum-eta_alt-lemma)))))
+
+
+
+
+(defun bmux8 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (3  (* 3 x))
+    (-3 (bits (lognot (* 3 x)) (1- n) 0))
+    (4  (* 4 x))
+    (-4 (bits (lognot (* 4 x)) (1- n) 0))
+    (0  0)))
+
+
+
+(local 
+ (defthm bmux8-is-bmux8_alt
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (bmux8 zeta x n)
+                   (bmux8_alt zeta x n)))
+   :hints (("Goal" :in-theory (e/d (bmux8 bmux8_alt) ())))))
+
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+
+(defun pp8 (i x n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (xi i))) 0) 1
+	   (bmux8 (xi i) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (xi i))) 0) 1
+	 (bmux8 (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+
+(local 
+ (defthm pp8-is-pp8_alt
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (pp8 i x n)
+                   (pp8_alt i x n)))
+   :hints (("Goal" :in-theory (e/d () (bmux8_alt
+                                       bmux8))))))
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8 (x m n)
+  (if (zp m)
+      0
+    (+ (pp8 (1- m) x n)
+       (sum-pp8 x (1- m) n))))
+
+
+(local 
+ (defthm sum-pp8-sum-pp8_alt
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (sum-pp8 x m n)
+                   (sum-pp8_alt x m n)))
+   :hints (("Goal" :in-theory (e/d () (pp8 pp8_alt))))))
+
+
+
+(defthm booth8-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8 x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth8-thm_alt))
+           :in-theory (e/d () (sum-pp8 sum-pp8_alt)))))
+
+
+(defun pp8-eta (i x y n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (eta i y))) 0) 1
+	   (bmux8 (eta i y) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (eta i y))) 0) 1
+	 (bmux8 (eta i y) x n) n
+	 0 2
+	 (neg (eta (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+
+(local 
+ (defthm pp8-eta-is-pp8-eta_alt
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (pp8-eta i x y n)
+                   (pp8_alt-eta_alt i x y n)))
+   :hints (("Goal" :in-theory (e/d (pp8-eta pp8_alt-eta_alt) ())))))
+
+
+(defun sum-pp8-eta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8-eta (1- m) x y n)
+       (sum-pp8-eta x y (1- m) n))))
+
+
+
+(local 
+ (defthm sum-pp8-eta-is-sum-pp8_alt-eta_alt
+   (implies (and (natp n)
+                 (> n 0)
+                 (integerp x))
+            (equal (sum-pp8-eta x y m n)
+                   (sum-pp8_alt-eta_alt x y m n)))
+   :hints (("Goal" :in-theory (e/d () (pp8-eta
+                                       pp8_alt-eta_alt))))))
+
+
+(defthm booth8-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8-eta x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance booth8-corollary_alt)))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/mult.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/mult.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/mult.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/mult.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,486 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "add")
+
+(local (include-book "mult-proofs"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+	       
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta (i y)
+  (+ (bitn y (1- (* 2 i))) 
+     (bitn y (* 2 i))
+     (* -2 (bitn y (1+ (* 2 i))))))
+
+
+(defun sum-theta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta (1- m) y))
+	(sum-theta (1- m) y))))
+
+
+
+(defthm sum-theta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta m y)))
+  :rule-classes ())
+
+
+(defun bmux4 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (0  0)))
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+
+(defun pp4 (i x n)
+  (if (zerop i)
+      (cat 1 1
+	   (bitn (lognot (neg (zeta i))) 0) 1
+	   (bmux4 (zeta i) x n) n)
+    (cat 1 1
+	 (bitn (lognot (neg (zeta i))) 0) 1
+	 (bmux4 (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4 (x m n)
+  (if (zp m)
+      0
+    (+ (pp4 (1- m) x n)
+       (sum-pp4 x (1- m) n))))
+
+
+(defthm booth4-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4 x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ())
+
+(defun pp4-theta (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (theta i y))) 0) 1
+	    (bmux4 (theta i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (theta i y))) 0) 1
+	  (bmux4 (theta i y) x n) n
+	  0 1
+	  (neg (theta (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-theta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-theta (1- m) x y n)
+       (sum-pp4-theta x y (1- m) n))))
+
+
+(defthm booth4-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits y (1+ (* 2 i)) (* 2 i)) (chi i y)))
+ 
+ (defun chi (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu (1- i) y) 3)
+	 1
+       0))))
+
+
+(defun phi (i y)
+  (if (= (bits (mu i y) 1 0) 3)
+      -1
+    (bits (mu i y) 1 0)))
+
+(defthm phi-bnd
+    (member (phi i y) '(-1 0 1 2)))
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+
+(defthm chi-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+  :rule-classes())
+
+
+(defthm phi-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi (1- m) y) 0))
+  :rule-classes())
+
+(defun sum-phi (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi (1- m) y))
+	(sum-phi (1- m) y))))
+
+
+(defthm sum-phi-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi m y)))
+  :rule-classes ())
+
+(defun pp4-phi (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (phi i y))) 0) 1
+	    (bmux4 (phi i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (phi i y))) 0) 1
+	  (bmux4 (phi i y) x n) n
+	  0 1
+	  (neg (phi (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-phi (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-phi (1- m) x y n)
+       (sum-pp4-phi x y (1- m) n))))
+
+
+(defthm static-booth
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+
+(defun gamma (i a b c)
+   (if (zp i)
+       (bitn c 0)
+     (logior (bitn  a (+ -1  (* 2 i)))
+ 	     (bitn  b (+ -1  (* 2 i))))))
+
+(defun delta (i a b c d)
+  (if (zp i)
+      (bitn d 0)
+    (logand (logior (logand (bitn a (+ -2 (* 2 i))) 
+			    (bitn b (+ -2 (* 2 i))))
+		    (logior (logand (bitn a (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))
+			    (logand (bitn b (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))))
+	    (lognot (logxor (bitn a (1- (* 2 i))) 
+			    (bitn b (1- (* 2 i))))))))
+
+(defun psi (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits a (1+ (* 2 i)) (* 2 i))
+       (bits b (1+ (* 2 i)) (* 2 i))
+       (gamma i a b c)
+       (delta i a b c d)
+       (* -4 (+ (gamma (1+ i) a b c)
+                (delta (1+ i) a b c d))))))
+
+
+(defthm psi-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))   
+		  (bvecp b (- (* 2 m) 2))  
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma m a b c) 0)
+		  (equal (delta m a b c d) 0)
+		  (>= (psi (1- m) a b c d) 0)))
+  :rule-classes ())
+
+
+(defun sum-psi (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi (1- m) a b c d))
+	(sum-psi (1- m) a b c d))))
+
+
+(defthm sum-psi-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi m a b c d)))
+  :rule-classes ())
+
+
+
+(defthmd psi-bnd
+  (and (integerp (psi i a b c d))
+       (<= (psi i a b c d) 2)
+       (>= (psi i a b c d) -2)))
+
+(defun pp4-psi (i x a b c d n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (psi i a b c d))) 0) 1
+	    (bmux4 (psi i a b c d) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (psi i a b c d))) 0) 1
+	  (bmux4 (psi i a b c d) x n) n
+	  0 1
+	  (neg (psi (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-psi (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4-psi (1- m) x a b c d n)
+       (sum-pp4-psi x a b c d (1- m) n))))
+
+
+
+(defthm redundant-booth
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+
+(defun eta (i y)
+  (+ (bitn y (1- (* 3 i))) 
+     (bitn y (* 3 i))
+     (* 2 (bitn y (1+ (* 3 i))))
+     (* -4 (bitn y (+ 2 (* 3 i))))))
+
+
+(defun sum-eta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta (1- m) y))
+	(sum-eta (1- m) y))))
+
+
+(defthm sum-eta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta m y)))
+  :rule-classes ())
+
+
+
+;; (defun bmux8 (zeta x n)
+;;   (case zeta
+;;     (1  x)
+;;     (-1 (bits (lognot x) (1- n) 0))
+;;     (2  (* 2 x))
+;;     (-2 (bits (lognot (* 2 x)) (1- n) 0))
+;;     (3  (* 3 x))
+;;     (-3 (bits (lognot (* 3 x)) (1- n) 0))
+;;     (4  (* 4 x))
+;;     (-4 (bits (lognot (* 4 x)) (1- n) 0))
+;;     (0  0)))
+
+
+(defun bmux8 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (3  (* 3 x))
+    (-3 (bits (lognot (* 3 x)) (1- n) 0))
+    (4  (* 4 x))
+    (-4 (bits (lognot (* 4 x)) (1- n) 0))
+    (0  0)))
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+
+(defun pp8 (i x n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (xi i))) 0) 1
+	   (bmux8 (xi i) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (xi i))) 0) 1
+	 (bmux8 (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8 (x m n)
+  (if (zp m)
+      0
+    (+ (pp8 (1- m) x n)
+       (sum-pp8 x (1- m) n))))
+
+
+(defthm booth8-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8 x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ())
+
+(defun pp8-eta (i x y n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (eta i y))) 0) 1
+	   (bmux8 (eta i y) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (eta i y))) 0) 1
+	 (bmux8 (eta i y) x n) n
+	 0 2
+	 (neg (eta (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+(defun sum-pp8-eta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8-eta (1- m) x y n)
+       (sum-pp8-eta x y (1- m) n))))
+
+
+(defthm booth8-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8-eta x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/reps-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/reps-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/reps-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/reps-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,764 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "../lib2/top"))
+
+(include-book "log-new")
+(include-book "float-new")
+
+
+(local (include-book "log-support"))
+
+(local 
+ (encapsulate () 
+              (local (include-book "bits-new-proofs"))
+
+             (defthm bits_alt-is-bits
+               (equal (bits_alt x i j)
+                      (bits x i j)))
+
+             
+             (defthm bitn_alt-is-bitn
+               (equal (bitn_alt x n)
+                      (bitn x n)))
+
+
+             (defthm binary-cat_alt-is-binary-cat
+               (equal (binary-cat_alt x m y n)
+                      (binary-cat x m y n)))
+
+
+             (defthm mulcat_alt-is-mul-cat
+               (equal (mulcat_alt l n x)
+                      (mulcat l n x)))
+
+
+             ))
+               
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;BOZO add rewrite rule?
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;BOZO disable?
+(defun esgnf_alt  (x p q) (bitn_alt x (+ p q)))
+
+(local
+ (defthm esgnf_alt-is-esgnf
+   (equal (esgnf_alt x p q)
+          (esgnf x p q))
+   :hints (("Goal" :in-theory (e/d (esgnf_alt esgnf) ())))))
+
+
+(defun eexpof_alt (x p q) (bits_alt x (1- (+ p q)) p)) 
+
+(local
+ (defthm eexpof_alt-is-esgnf
+   (equal (eexpof_alt x p q)
+          (eexpof x p q))
+   :hints (("Goal" :in-theory (e/d (eexpof_alt eexpof) ())))))
+
+(defun esigf_alt  (x p)   (bits_alt x (1- p) 0))
+
+(local
+ (defthm esigf_alt-is-esigf
+   (equal (esigf_alt x p)
+          (esigf x p))
+   :hints (("Goal" :in-theory (e/d (esigf_alt esigf) ())))))
+
+
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp_alt (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn_alt x (- p 1)) 1)))
+
+(local 
+ (defthm eencodingp_alt-is-eencodingp
+   (equal (eencodingp_alt x p q)
+          (eencodingp x p q))
+   :hints (("Goal" :in-theory (e/d (eencodingp
+                                    eencodingp_alt) ())))))
+
+(defund eencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(local 
+ (defthm eencode_alt-is-eencode
+   (equal (eencode_alt x p q)
+          (eencode x p q))
+   :hints (("Goal" :in-theory (e/d (eencode_alt
+                                    eencode) ())))))
+
+
+(defund edecode_alt (x p q)
+  (* (if (= (esgnf_alt x p q) 0) 1 -1)
+     (esigf_alt x p)
+     (expt 2 (+ 1 (- p) (eexpof_alt x p q) (- (bias q))))))
+
+
+(local 
+ (defthm edecode_alt-is-edecode
+   (equal (edecode_alt x p q)
+          (edecode x p q))
+   :hints (("Goal" :in-theory (e/d (edecode_alt 
+                                    edecode) ())))))
+
+
+(defthm eencodingp_alt-not-zero
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode_alt x p q) 0)))
+    :hints (("Goal" :use ((:instance eencodingp-not-zero)))))
+
+
+(defthm erepp-edecode_alt
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance erepp-edecode)))))
+
+(defthm eencodingp_alt-eencode_alt
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp_alt (eencode_alt x p q) p q) )
+    :hints (("Goal" :use ((:instance eencodingp-eencode)))))
+
+(defthm edecode_alt-eencode_alt
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode_alt (eencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance edecode-eencode)))))
+
+(defthm eencode_alt-edecode_alt
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode_alt (edecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance eencode-edecode)))))
+
+(defthm expo-edecode_alt
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode_alt x p q))
+		    (- (eexpof_alt x p q) (bias q))))
+    :hints (("Goal" :use ((:instance expo-edecode)))))
+
+(defthm sgn-edecode_alt
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode_alt  x p q))
+		    (if (= (esgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-edecode)))))
+
+(defthm sig-edecode_alt
+    (implies (and (eencodingp_alt  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode_alt  x p q))
+		    (/ (esigf_alt x p) (expt 2 (- p 1)))))
+    :hints (("Goal" :use ((:instance sig-edecode)))))
+
+;BOZO disable?
+(defun rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm rebias-down_alt
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat_alt (bitn_alt x (1- n))
+			 1
+			 (bits_alt x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance rebias-down)))))
+
+
+(local (include-book "../../arithmetic/top"))
+
+(local 
+ (defthmd bitn-lognot-g
+   (implies (and (integerp x)
+                 (integerp n)
+                 (>= n 0))
+            (not (equal (bitn (lognot x) n)
+                        (bitn x n))))
+   :hints (("Goal" :cases ((equal n 0)))
+           ("Subgoal 2" :use ((:instance bitn_alt-lognot)))
+           ("Subgoal 1" :in-theory (e/d (lognot bitn-def mod)
+                                        ())))))
+
+
+(defthm rebias-up_alt
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat_alt (cat_alt (bitn_alt x (1- m))
+			      1
+			      (mulcat_alt 1 (- n m) (bitn_alt (lognot x) (1- m)))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits_alt x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance rebias-UP)
+                        (:instance bitn-lognot-g
+                                   (x (bitn x (+ -1 m)))
+                                   (n 0))
+                        (:instance bitn-lognot-g
+                                   (x x)
+                                   (n (+ -1 m)))
+                        (:instance bitn-0-1
+                                   (x x)
+                                   (n (+ -1 m))))
+           :in-theory (e/d (lnot-lognot
+                            bitn-lnot)
+                           (cat-0)))))
+
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf_alt (x p q) (bitn_alt x (1- (+ p q))))
+
+(local 
+ (defthm isgnf_alt-is-isgnf
+   (equal (isgnf_alt x p q)
+          (isgnf x p q))))
+
+
+(defun iexpof_alt (x p q) (bits_alt x (- (+ p q) 2) (1- p)))
+
+(local 
+ (defthm iexpof_alt-is-iexpof
+   (equal (iexpof_alt x p q)
+          (iexpof x p q))))
+
+(defun isigf_alt (x p) (bits_alt x (- p 2) 0))
+
+(local 
+ (defthm isigf_alt-is-isigf
+   (equal (isigf_alt x p)
+          (isigf x p))))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits_alt available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp_alt (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof_alt x p q))
+       (< (iexpof_alt x p q) (- (expt 2 q) 1))))
+
+(local 
+ (defthm nencodingp_alt-is-nencoding
+   (equal (nencodingp_alt x p q)
+          (nencodingp x p q))
+   :hints (("Goal" :in-theory (e/d (nencodingp_alt
+                                    nencodingp) ())))))
+
+
+(defund dencodingp_alt (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof_alt x p q) 0)
+       (not (= (isigf_alt x p) 0))))
+
+(local 
+ (defthm dencodingp_alt-is-dencoding
+   (equal (dencodingp_alt x p q)
+          (dencodingp x p q))
+   :hints (("Goal" :in-theory (e/d (dencodingp_alt
+                                    dencodingp) ())))))
+
+(defund iencodingp_alt (x p q)
+  (or (nencodingp_alt x p q)
+      (dencodingp_alt x p q)))
+
+
+(local 
+ (defthm iencodingp_alt-is-iencoding
+   (equal (iencodingp_alt x p q)
+          (iencodingp x p q))
+   :hints (("Goal" :in-theory (e/d (iencodingp_alt
+                                    iencodingp) ())))))
+
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp_alt-and-dencodingp_alt
+    (implies (iencodingp_alt x p q)
+	     (iff (nencodingp_alt x p q) (not (dencodingp_alt x p q))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance not-both-nencodingp-and-dencodingp)))))
+  
+
+
+;;Encoding functions:
+
+(defund nencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(local 
+ (defthm nencode_alt-is-nencode
+   (equal (nencode_alt x p q)
+          (nencode x p q))
+   :hints (("Goal" :in-theory (e/d (nencode_alt
+                                    nencode) ())))))
+ 
+
+
+(defund dencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(local 
+ (defthm dencode_alt-is-dencode
+   (equal (dencode_alt x p q)
+          (dencode x p q))
+   :hints (("Goal" :in-theory (e/d (dencode_alt
+                                    dencode) ())))))
+
+
+(defund iencode_alt (x p q)
+  (cond ((nrepp x p q)
+	 (nencode_alt x p q))
+	((drepp x p q)
+	 (dencode_alt x p q))))
+
+
+(local 
+ (defthm iencode_alt-is-iencode
+   (equal (iencode_alt x p q)
+          (iencode x p q))
+   :hints (("Goal" :in-theory (e/d (iencode_alt
+                                    iencode))))))
+
+
+;;Decoding functions:
+
+(defund ndecode_alt (x p q)
+  (* (if (= (isgnf_alt x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof_alt x p q) (bias q)))
+        (* (isigf_alt x p)
+           (expt 2 (+ 1 (iexpof_alt x p q) (- (bias q)) (- p)))))))
+
+
+
+(local 
+ (defthm ndecode_alt-is-ndecode
+   (equal (ndecode_alt x p q)
+          (ndecode x p q))
+   :hints (("Goal" :in-theory (e/d (ndecode_alt
+                                    ndecode))))))
+
+
+(defund ddecode_alt (x p q)
+  (* (if (= (isgnf_alt x p q) 0) 1 -1)
+     (isigf_alt x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(local 
+ (defthm ddecode_alt-is-decode
+   (equal (ddecode_alt x p q)
+          (ddecode x p q))
+   :hints (("Goal" :in-theory (e/d (ddecode_alt
+                                    ddecode))))))
+
+
+
+(defund idecode_alt (x p q)
+  (cond ((nencodingp_alt x p q)
+	 (ndecode_alt x p q))
+	((dencodingp_alt x p q)
+	 (ddecode_alt x p q))))
+
+
+(local 
+ (defthm idecode_alt-is-idecode
+   (equal (idecode_alt x p q)
+          (idecode x p q))
+   :hints (("Goal" :in-theory (e/d (idecode_alt
+                                    idecode))))))
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode_alt
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode_alt x p q))
+		    (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-ndecode)))))
+
+(defthm expo-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode_alt x p q))
+		    (- (iexpof_alt x p q) (bias q))))
+    :hints (("Goal" :use ((:instance expo-ndecode)))))
+
+(defthm sig-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode_alt x p q))
+		    (+ 1 (/ (isigf_alt x p) (expt 2 (- p 1))))))
+    :hints (("Goal" :use ((:instance sig-ndecode)))))
+
+(defthm sgn-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode_alt x p q))
+		    (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-ddecode)))))
+
+(defthm expo-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode_alt x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf_alt x p)))))
+    :hints (("Goal" :use ((:instance expo-ddecode)))))
+
+(defthm sig-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode_alt x p q))
+		    (sig (isigf_alt x p))))
+    :hints (("Goal" :use ((:instance sig-ddecode)))))
+
+(defthm sgn-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode_alt x p q))
+	      (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-idecode)))))
+
+(defthm expo-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode_alt x p q))
+	      (cond ((nencodingp_alt x p q)
+		     (- (iexpof_alt x p q) (bias q)))         
+		    ((dencodingp_alt x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf_alt x p)))))))
+    :hints (("Goal" :use ((:instance expo-idecode)))))
+
+(defthm sig-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode_alt x p q))
+		    (cond ((nencodingp_alt x p q)
+			   (+ 1 (/ (isigf_alt x p) (expt 2 (- p 1)))))
+			  ((dencodingp_alt x p q)
+			   (sig (isigf_alt x p))))))
+    :hints (("Goal" :use ((:instance sig-idecode)))))
+
+
+;;Inversions:
+
+(defthm dencodingp_alt-dencode_alt
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp_alt (dencode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance dencodingp-dencode)))))
+
+(defthm iencodingp_alt-iencode_alt
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp_alt (iencode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance iencodingp-iencode)))))
+
+(defthm nrepp-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance nrepp-ndecode)))))
+
+(defthm drepp-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance drepp-ddecode)))))
+
+(defthm irepp-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance irepp-idecode)))))
+
+(defthm nencodingp_alt-nencode_alt
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp_alt (nencode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance nencodingp-nencode)))))
+
+(defthm ndecode_alt-nencode_alt
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode_alt (nencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance ndecode-nencode)))))
+
+(defthm ddecode_alt-dencode_alt
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode_alt (dencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance ddecode-dencode)))))
+
+(defthm idecode_alt-iencode_alt
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode_alt (iencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance idecode-iencode)))))
+
+(defthm nencode_alt-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode_alt (ndecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance nencode-ndecode)))))
+
+(defthm dencode_alt-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode_alt (ddecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance dencode-ddecode)))))
+
+(defthm iencode_alt-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode_alt (idecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance iencode-idecode)))))
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/reps-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/reps-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/reps-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/reps-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,631 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "log-new")
+(include-book "float-new")
+
+(local (include-book "reps-new-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;BOZO add rewrite rule?
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;BOZO disable?
+(defun esgnf_alt  (x p q) (bitn_alt x (+ p q)))
+
+
+(defun eexpof_alt (x p q) (bits_alt x (1- (+ p q)) p)) 
+
+
+(defun esigf_alt  (x p)   (bits_alt x (1- p) 0))
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp_alt (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn_alt x (- p 1)) 1)))
+
+
+(defund eencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+
+(defund edecode_alt (x p q)
+  (* (if (= (esgnf_alt x p q) 0) 1 -1)
+     (esigf_alt x p)
+     (expt 2 (+ 1 (- p) (eexpof_alt x p q) (- (bias q))))))
+
+
+
+(defthm eencodingp_alt-not-zero
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode_alt x p q) 0)))
+    :hints (("Goal" :use ((:instance eencodingp-not-zero)))))
+
+
+(defthm erepp-edecode_alt
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance erepp-edecode)))))
+
+(defthm eencodingp_alt-eencode_alt
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp_alt (eencode_alt x p q) p q) )
+    :hints (("Goal" :use ((:instance eencodingp-eencode)))))
+
+(defthm edecode_alt-eencode_alt
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode_alt (eencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance edecode-eencode)))))
+
+(defthm eencode_alt-edecode_alt
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode_alt (edecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance eencode-edecode)))))
+
+(defthm expo-edecode_alt
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode_alt x p q))
+		    (- (eexpof_alt x p q) (bias q))))
+    :hints (("Goal" :use ((:instance expo-edecode)))))
+
+(defthm sgn-edecode_alt
+    (implies (and (eencodingp_alt x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode_alt  x p q))
+		    (if (= (esgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-edecode)))))
+
+(defthm sig-edecode_alt
+    (implies (and (eencodingp_alt  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode_alt  x p q))
+		    (/ (esigf_alt x p) (expt 2 (- p 1)))))
+    :hints (("Goal" :use ((:instance sig-edecode)))))
+
+;BOZO disable?
+(defun rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm rebias-down_alt
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat_alt (bitn_alt x (1- n))
+			 1
+			 (bits_alt x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance rebias-down)))))
+
+
+
+
+
+(defthm rebias-up_alt
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat_alt (cat_alt (bitn_alt x (1- m))
+			      1
+			      (mulcat_alt 1 (- n m) (bitn_alt (lognot x) (1- m)))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits_alt x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance rebias-UP)
+                        (:instance bitn-lognot-g
+                                   (x (bitn x (+ -1 m)))
+                                   (n 0))
+                        (:instance bitn-lognot-g
+                                   (x x)
+                                   (n (+ -1 m)))
+                        (:instance bitn-0-1
+                                   (x x)
+                                   (n (+ -1 m))))
+           :in-theory (e/d (lnot-lognot
+                            bitn-lnot)
+                           (cat-0)))))
+
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf_alt (x p q) (bitn_alt x (1- (+ p q))))
+
+
+
+
+(defun iexpof_alt (x p q) (bits_alt x (- (+ p q) 2) (1- p)))
+
+
+
+(defun isigf_alt (x p) (bits_alt x (- p 2) 0))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits_alt available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp_alt (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof_alt x p q))
+       (< (iexpof_alt x p q) (- (expt 2 q) 1))))
+
+
+
+
+(defund dencodingp_alt (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof_alt x p q) 0)
+       (not (= (isigf_alt x p) 0))))
+
+
+
+(defund iencodingp_alt (x p q)
+  (or (nencodingp_alt x p q)
+      (dencodingp_alt x p q)))
+
+
+
+
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp_alt-and-dencodingp_alt
+    (implies (iencodingp_alt x p q)
+	     (iff (nencodingp_alt x p q) (not (dencodingp_alt x p q))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance not-both-nencodingp-and-dencodingp)))))
+  
+
+
+;;Encoding functions:
+
+(defund nencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+
+
+
+(defund dencode_alt (x p q)
+  (cat_alt (cat_alt (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+
+
+(defund iencode_alt (x p q)
+  (cond ((nrepp x p q)
+	 (nencode_alt x p q))
+	((drepp x p q)
+	 (dencode_alt x p q))))
+
+
+
+
+
+;;Decoding functions:
+
+(defund ndecode_alt (x p q)
+  (* (if (= (isgnf_alt x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof_alt x p q) (bias q)))
+        (* (isigf_alt x p)
+           (expt 2 (+ 1 (iexpof_alt x p q) (- (bias q)) (- p)))))))
+
+
+
+
+
+
+(defund ddecode_alt (x p q)
+  (* (if (= (isgnf_alt x p q) 0) 1 -1)
+     (isigf_alt x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+
+
+
+(defund idecode_alt (x p q)
+  (cond ((nencodingp_alt x p q)
+	 (ndecode_alt x p q))
+	((dencodingp_alt x p q)
+	 (ddecode_alt x p q))))
+
+
+
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode_alt
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode_alt x p q))
+		    (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-ndecode)))))
+
+(defthm expo-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode_alt x p q))
+		    (- (iexpof_alt x p q) (bias q))))
+    :hints (("Goal" :use ((:instance expo-ndecode)))))
+
+(defthm sig-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode_alt x p q))
+		    (+ 1 (/ (isigf_alt x p) (expt 2 (- p 1))))))
+    :hints (("Goal" :use ((:instance sig-ndecode)))))
+
+(defthm sgn-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode_alt x p q))
+		    (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-ddecode)))))
+
+(defthm expo-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode_alt x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf_alt x p)))))
+    :hints (("Goal" :use ((:instance expo-ddecode)))))
+
+(defthm sig-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode_alt x p q))
+		    (sig (isigf_alt x p))))
+    :hints (("Goal" :use ((:instance sig-ddecode)))))
+
+(defthm sgn-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode_alt x p q))
+	      (if (= (isgnf_alt x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-idecode)))))
+
+(defthm expo-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode_alt x p q))
+	      (cond ((nencodingp_alt x p q)
+		     (- (iexpof_alt x p q) (bias q)))         
+		    ((dencodingp_alt x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf_alt x p)))))))
+    :hints (("Goal" :use ((:instance expo-idecode)))))
+
+(defthm sig-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode_alt x p q))
+		    (cond ((nencodingp_alt x p q)
+			   (+ 1 (/ (isigf_alt x p) (expt 2 (- p 1)))))
+			  ((dencodingp_alt x p q)
+			   (sig (isigf_alt x p))))))
+    :hints (("Goal" :use ((:instance sig-idecode)))))
+
+
+;;Inversions:
+
+(defthm dencodingp_alt-dencode_alt
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp_alt (dencode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance dencodingp-dencode)))))
+
+(defthm iencodingp_alt-iencode_alt
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp_alt (iencode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance iencodingp-iencode)))))
+
+(defthm nrepp-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance nrepp-ndecode)))))
+
+(defthm drepp-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance drepp-ddecode)))))
+
+(defthm irepp-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance irepp-idecode)))))
+
+(defthm nencodingp_alt-nencode_alt
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp_alt (nencode_alt x p q) p q))
+    :hints (("Goal" :use ((:instance nencodingp-nencode)))))
+
+(defthm ndecode_alt-nencode_alt
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode_alt (nencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance ndecode-nencode)))))
+
+(defthm ddecode_alt-dencode_alt
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode_alt (dencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance ddecode-dencode)))))
+
+(defthm idecode_alt-iencode_alt
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode_alt (iencode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance idecode-iencode)))))
+
+(defthm nencode_alt-ndecode_alt
+    (implies (and (nencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode_alt (ndecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance nencode-ndecode)))))
+
+(defthm dencode_alt-ddecode_alt
+    (implies (and (dencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode_alt (ddecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance dencode-ddecode)))))
+
+(defthm iencode_alt-idecode_alt
+    (implies (and (iencodingp_alt x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode_alt (idecode_alt x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance iencode-idecode)))))
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/reps-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/reps-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/reps-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/reps-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,749 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "log")
+
+(include-book "float")
+
+
+(local (include-book "reps-new"))
+
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;BOZO add rewrite rule?
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;BOZO disable?
+(defun esgnf  (x p q) (bitn x (+ p q)))
+
+(local
+ (defthm esgnf-is-esgnf_alt
+   (equal (esgnf x p q)
+          (esgnf_alt x p q))
+   :hints (("Goal" :in-theory (e/d (esgnf_alt esgnf) ())))))
+
+
+(defun eexpof (x p q) (bits x (1- (+ p q)) p)) 
+
+(local
+ (defthm eexpof-is-eexpof_alt
+   (equal (eexpof x p q)
+          (eexpof_alt x p q))
+   :hints (("Goal" :in-theory (e/d (eexpof_alt eexpof) ())))))
+
+(defun esigf  (x p)   (bits x (1- p) 0))
+
+(local
+ (defthm esigf-is-esigf_alt
+   (equal (esigf x p)
+          (esigf_alt x p))
+   :hints (("Goal" :in-theory (e/d (esigf esigf_alt) ())))))
+
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+(local 
+ (defthm eencodingp-is-eencodingp_alt
+   (equal (eencodingp x p q)
+          (eencodingp_alt x p q))
+   :hints (("Goal" :in-theory (e/d (eencodingp_alt
+                                    eencodingp) ())))))
+
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(local 
+ (defthm eencode-is-eencode_alt
+   (equal (eencode x p q)
+          (eencode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (eencode_alt
+                                    eencode) ())))))
+
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+
+(local 
+ (defthm edecode-is-edecode_alt
+   (equal (edecode x p q)
+          (edecode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (edecode_alt
+                                    edecode) ())))))
+
+
+(defthm eencodingp-not-zero
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode x p q) 0)))
+    :hints (("Goal" :use ((:instance eencodingp_alt-not-zero)))))
+
+
+(defthm erepp-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode x p q) p q))
+    :hints (("Goal" :use ((:instance erepp-edecode_alt)))))
+
+(defthm eencodingp-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp (eencode x p q) p q) )
+    :hints (("Goal" :use ((:instance eencodingp_alt-eencode_alt)))))
+
+(defthm edecode-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode (eencode x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance edecode_alt-eencode_alt)))))
+
+(defthm eencode-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode (edecode x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance eencode_alt-edecode_alt)))))
+
+(defthm expo-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode x p q))
+		    (- (eexpof x p q) (bias q))))
+    :hints (("Goal" :use ((:instance expo-edecode_alt)))))
+
+(defthm sgn-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode  x p q))
+		    (if (= (esgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-edecode_alt)))))
+
+(defthm sig-edecode
+    (implies (and (eencodingp  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode  x p q))
+		    (/ (esigf x p) (expt 2 (- p 1)))))
+    :hints (("Goal" :use ((:instance sig-edecode_alt)))))
+
+;BOZO disable?
+(defun rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance rebias-down_alt)))))
+
+
+;; (local (include-book "../../arithmetic/top"))
+
+;; (local 
+;;  (defthmd bitn-lognot-g
+;;    (implies (and (integerp x)
+;;                  (integerp n)
+;;                  (>= n 0))
+;;             (not (equal (bitn (lognot x) n)
+;;                         (bitn x n))))
+;;    :hints (("Goal" :cases ((equal n 0)))
+;;            ("Subgoal 2" :use ((:instance bitn_alt-lognot)))
+;;            ("Subgoal 1" :in-theory (e/d (lognot bitn_alt-def mod)
+;;                                         ())))))
+
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (bitn (lognot x) (1- m)))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use rebias-up_alt)))
+                        
+
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+
+(local 
+ (defthm isgnf-is-isgnf_alt
+   (equal (isgnf x p q)
+          (isgnf_alt x p q))))
+
+
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+
+(local 
+ (defthm iexpof-is-iexpof_alt
+   (equal (iexpof x p q)
+          (iexpof_alt x p q))))
+
+(defun isigf (x p) (bits x (- p 2) 0))
+
+(local 
+ (defthm isigf-is-isigf_alt
+   (equal (isigf x p)
+          (isigf_alt x p))))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+(local 
+ (defthm nencodingp-is-nencoding
+   (equal (nencodingp x p q)
+          (nencodingp_alt x p q))
+   :hints (("Goal" :in-theory (e/d (nencodingp
+                                    nencodingp_alt) ())))))
+
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(local 
+ (defthm dencodingp-is-dencoding
+   (equal (dencodingp x p q)
+          (dencodingp_alt x p q))
+   :hints (("Goal" :in-theory (e/d (dencodingp_alt
+                                    dencodingp) ())))))
+
+(defund iencodingp (x p q)
+  (or (nencodingp x p q)
+      (dencodingp x p q)))
+
+
+(local 
+ (defthm iencodingp-is-iencoding
+   (equal (iencodingp x p q)
+          (iencodingp_alt x p q))
+   :hints (("Goal" :in-theory (e/d (iencodingp_alt
+                                    iencodingp) ())))))
+
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp-and-dencodingp
+    (implies (iencodingp x p q)
+	     (iff (nencodingp x p q) (not (dencodingp x p q))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance not-both-nencodingp_alt-and-dencodingp_alt)))))
+  
+
+
+;;Encoding functions:
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(local 
+ (defthm nencode-is-nencode_alt
+   (equal (nencode x p q)
+          (nencode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (nencode_alt
+                                    nencode) ())))))
+ 
+
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(local 
+ (defthm dencode-is-dencode
+   (equal (dencode x p q)
+          (dencode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (dencode_alt
+                                    dencode) ())))))
+
+
+(defund iencode (x p q)
+  (cond ((nrepp x p q)
+	 (nencode x p q))
+	((drepp x p q)
+	 (dencode x p q))))
+
+
+(local 
+ (defthm iencode-is-iencode_alt
+   (equal (iencode x p q)
+          (iencode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (iencode_alt
+                                    iencode))))))
+
+
+;;Decoding functions:
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+
+
+(local 
+ (defthm ndecode-is-ndecode
+   (equal (ndecode x p q)
+          (ndecode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (ndecode_alt
+                                    ndecode))))))
+
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(local 
+ (defthm ddecode-is-decode
+   (equal (ddecode x p q)
+          (ddecode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (ddecode_alt
+                                    ddecode))))))
+
+
+
+(defund idecode (x p q)
+  (cond ((nencodingp x p q)
+	 (ndecode x p q))
+	((dencodingp x p q)
+	 (ddecode x p q))))
+
+
+(local 
+ (defthm idecode-is-idecode
+   (equal (idecode x p q)
+          (idecode_alt x p q))
+   :hints (("Goal" :in-theory (e/d (idecode_alt
+                                    idecode))))))
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-ndecode_alt)))))
+
+(defthm expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q))))
+    :hints (("Goal" :use ((:instance expo-ndecode_alt)))))
+
+(defthm sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1))))))
+    :hints (("Goal" :use ((:instance sig-ndecode_alt)))))
+
+(defthm sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-ddecode_alt)))))
+
+(defthm expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))
+    :hints (("Goal" :use ((:instance expo-ddecode_alt)))))
+
+(defthm sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p))))
+    :hints (("Goal" :use ((:instance sig-ddecode_alt)))))
+
+(defthm sgn-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode x p q))
+	      (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use ((:instance sgn-idecode_alt)))))
+
+(defthm expo-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode x p q))
+	      (cond ((nencodingp x p q)
+		     (- (iexpof x p q) (bias q)))         
+		    ((dencodingp x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))))
+    :hints (("Goal" :use ((:instance expo-idecode_alt)))))
+
+(defthm sig-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode x p q))
+		    (cond ((nencodingp x p q)
+			   (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
+			  ((dencodingp x p q)
+			   (sig (isigf x p))))))
+    :hints (("Goal" :use ((:instance sig-idecode_alt)))))
+
+
+;;Inversions:
+
+(defthm dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q))
+    :hints (("Goal" :use ((:instance dencodingp_alt-dencode_alt)))))
+
+(defthm iencodingp-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp (iencode x p q) p q))
+    :hints (("Goal" :use ((:instance iencodingp_alt-iencode_alt)))))
+
+(defthm nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q))
+    :hints (("Goal" :use ((:instance nrepp-ndecode_alt)))))
+
+(defthm drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q))
+    :hints (("Goal" :use ((:instance drepp-ddecode_alt)))))
+
+(defthm irepp-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode x p q) p q))
+    :hints (("Goal" :use ((:instance irepp-idecode_alt)))))
+
+(defthm nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q))
+    :hints (("Goal" :use ((:instance nencodingp_alt-nencode_alt)))))
+
+(defthm ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance ndecode_alt-nencode_alt)))))
+
+(defthm ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance ddecode_alt-dencode_alt)))))
+
+(defthm idecode-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode (iencode x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance idecode_alt-iencode_alt)))))
+
+(defthm nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance nencode_alt-ndecode_alt)))))
+
+(defthm dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance dencode_alt-ddecode_alt)))))
+
+(defthm iencode-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode (idecode x p q) p q)
+		    x))
+    :hints (("Goal" :use ((:instance iencode_alt-idecode_alt)))))
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/reps.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/reps.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/reps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/reps.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,538 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "reps-proofs"))
+
+(include-book "log")
+(include-book "float")
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;BOZO add rewrite rule?
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;BOZO disable?
+(defun esgnf  (x p q) (bitn x (+ p q)))
+(defun eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defun esigf  (x p)   (bits x (1- p) 0))
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+(defthm eencodingp-not-zero
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode x p q) 0))))
+
+(defthm erepp-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode x p q) p q)))
+
+
+(defthm eencodingp-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp (eencode x p q) p q) ))
+
+(defthm edecode-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode (eencode x p q) p q)
+		    x)))
+
+(defthm eencode-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode (edecode x p q) p q)
+		    x)))
+
+(defthm expo-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode x p q))
+		    (- (eexpof x p q) (bias q)))))
+
+(defthm sgn-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode  x p q))
+		    (if (= (esgnf x p q) 0) 1 -1))))
+
+(defthm sig-edecode
+    (implies (and (eencodingp  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode  x p q))
+		    (/ (esigf x p) (expt 2 (- p 1))))))
+
+;BOZO disable?
+(defun rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (bitn (lognot x) (1- m)))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(defund iencodingp (x p q)
+  (or (nencodingp x p q)
+      (dencodingp x p q)))
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp-and-dencodingp
+    (implies (iencodingp x p q)
+	     (iff (nencodingp x p q) (not (dencodingp x p q))))
+  :rule-classes ())
+
+
+;;Encoding functions:
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(defund iencode (x p q)
+  (cond ((nrepp x p q)
+	 (nencode x p q))
+	((drepp x p q)
+	 (dencode x p q))))
+
+
+;;Decoding functions:
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(defund idecode (x p q)
+  (cond ((nencodingp x p q)
+	 (ndecode x p q))
+	((dencodingp x p q)
+	 (ddecode x p q))))
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+(defthm sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+(defthm sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+(defthm sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+(defthm sgn-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode x p q))
+	      (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode x p q))
+	      (cond ((nencodingp x p q)
+		     (- (iexpof x p q) (bias q)))         
+		    ((dencodingp x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))))
+
+(defthm sig-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode x p q))
+		    (cond ((nencodingp x p q)
+			   (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
+			  ((dencodingp x p q)
+			   (sig (isigf x p)))))))
+
+
+;;Inversions:
+
+(defthm dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+(defthm iencodingp-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp (iencode x p q) p q)))
+
+(defthm nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+(defthm drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+(defthm irepp-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode x p q) p q)))
+
+(defthm nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+(defthm ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+(defthm ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+(defthm idecode-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode (iencode x p q) p q)
+		    x)))
+
+(defthm nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+(defthm dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+(defthm iencode-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode (idecode x p q) p q)
+		    x)))
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/round-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/round-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/round-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/round-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1888 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "float-new")
+
+(local (include-book "../lib2/top"))
+
+
+(local 
+ (encapsulate () 
+              (local (include-book "bits-new-proofs"))
+
+             (defthm bits_alt-is-bits
+               (equal (bits_alt x i j)
+                      (bits x i j)))
+
+             
+             (defthm bitn_alt-is-bitn
+               (equal (bitn_alt x n)
+                      (bitn x n)))
+
+             ))
+               
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+(defthm bits_alt-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits_alt x (1- n) (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-trunc)))))
+
+;;; Fri Feb 13 14:02:03 2009
+;;; 
+;;; Some truly new result. 
+
+
+
+;; (defthmd logand-expt-3-g
+;;     (implies (and (integerp x)
+;; 		  (natp n)
+;; 		  (natp k)
+;; 		  (< k n))
+;; 	     (equal (logand x (+ (expt 2 n) (- (expt 2 k))))
+;; 		    (* (expt 2 k) (bits_alt x (1- n) k)))))
+;;
+;; (DEFTHM TRUNC-LAND
+;;                       (IMPLIES (AND (>= X (EXPT 2 (1- N)))
+;;                                     (< X (EXPT 2 N))
+;;                                     (INTEGERP X)
+;;                                     (> X 0)
+;;                                     (INTEGERP M)
+;;                                     (>= M N)
+;;                                     (INTEGERP N)
+;;                                     (> N K)
+;;                                     (INTEGERP K)
+;;                                     (> K 0))
+;;                                (= (TRUNC X K)
+;;                                   (LAND X (- (EXPT 2 M) (EXPT 2 (- N K)))
+;;                                         N)))
+;;                       :RULE-CLASSES NIL)
+;;
+;;
+;; (defthm land-slice
+;;   (implies (and (<= j i) ;drop? or not?
+;;                 (<= i n)
+;;                 (integerp n)
+;;                 (integerp i)
+;;                 (integerp j)
+;;                 (<= 0 j)
+;;                 )
+;;            (equal (land x (- (expt 2 i) (expt 2 j)) n)
+;;                   (* (expt 2 j) (bits x (1- i) j))))
+;;   :hints (("Goal" :use land0-slice))
+;;   :rule-classes ())
+;;
+
+
+(local 
+ (encapsulate () 
+   (local (include-book "../support/land"))
+   
+   (defthm land-slice
+     (implies (and (<= j i) ;drop? or not?
+                   (<= i n)
+                   (integerp n)
+                   (integerp i)
+                   (integerp j)
+                   (<= 0 j)
+                   )
+              (equal (land x (- (expt 2 i) (expt 2 j)) n)
+                     (* (expt 2 j) (bits x (1- i) j))))
+     :rule-classes ()))
+ )
+
+(encapsulate () 
+  (local (encapsulate () 
+             (local (include-book "../../arithmetic/top"))
+             
+
+             (defthmd fl-small-pos
+               (implies (and (real/rationalp x)
+                             (<= 0 x)
+                             (< x 1))
+                        (equal (fl x) 
+                               0))
+               :hints (("Goal" :in-theory (e/d (fl floor)
+                                               (floor-fl)))))
+   
+
+             (defthmd bits-reduce-local
+               (implies (and (integerp x)
+                             (>= x (expt 2 (1- n)))
+                             (< x (expt 2 n))
+                             (integerp i)
+                             (integerp j)
+                             (integerp n)
+                             (<= j n)
+                             (<= (+ -1 n) i))
+                        (equal  (BITS X i j)
+                                (bits x (+ -1 n) j)))
+               :hints (("Goal" :in-theory (e/d () (FL-EQUAL-0))
+                        :use ((:instance bits-mod-2
+                                         (i (+ 1 i))
+                                         (j j))
+                              (:instance bits-mod-2
+                                         (i n)
+                                         (j j))
+                              (:instance fl-small-pos
+                                         (x (* x (/ (expt 2 n)))))
+                              (:instance fl-small-pos
+                                         (x (* x (/ (expt 2 (+ 1 i))))))))))
+
+             ))
+                         
+  
+  (defthm trunc-logand
+    (implies (and (>= x (expt 2 (1- n)))
+		  (< x (expt 2 n))
+                  (integerp x) ;(> x 0)
+		  (integerp m) (>= m n)
+		  (integerp n) (> n k)
+		  (integerp k) (> k 0))
+	     (= (trunc x k)
+		(logand x (- (expt 2 m) (expt 2 (- n k))))))
+    :rule-classes ()
+    :hints (("Goal" :use ((:instance trunc-land
+                                     (m n))
+                          (:instance logand-expt-3-g
+                                     (n m)
+                                     (k (- n k)))
+                          (:instance land-slice
+                                     (i n)
+                                     (j (- n k))
+                                     (n n))
+                          (:instance bits-reduce-local
+                                     (i (+ -1 m))
+                                     (j (- n k))))))))
+
+
+
+(defthmd trunc-split_alt
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits_alt x (1- (- n k)) (- n m))))))
+  :hints (("Goal" :use ((:instance trunc-split)))))
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+;;
+;; druss: the following may be wrong. 
+;;
+;; (defthm expo-near
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (near x n))
+;;                     (expo x)))
+;;   :rule-classes ())
+
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+;;;;
+
+
+(defun roundup_alt (x mode n)
+  (case mode
+    (near+ (= (bitn_alt x (- (expo x) n)) 1))
+    (near (and (= (bitn_alt x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn_alt x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+(local 
+ (defthm roundup_alt-is-roundup
+   (equal (roundup_alt x mode n)
+          (roundup x mode n))
+   :hints (("Goal" :in-theory (e/d (roundup_alt roundup)
+                                   ())))))
+
+
+
+
+(defthm roundup_alt-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup_alt x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance roundup-thm)))))
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+
+
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/round-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/round-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/round-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/round-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1797 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "float-new")
+
+(local (include-book "round-new-proofs"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+(defthm bits_alt-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits_alt x (1- n) (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-trunc)))))
+
+;;; Fri Feb 13 14:02:03 2009
+;;; 
+;;; Some truly new result. 
+
+
+
+;; (defthmd logand-expt-3-g
+;;     (implies (and (integerp x)
+;; 		  (natp n)
+;; 		  (natp k)
+;; 		  (< k n))
+;; 	     (equal (logand x (+ (expt 2 n) (- (expt 2 k))))
+;; 		    (* (expt 2 k) (bits_alt x (1- n) k)))))
+;;
+;; (DEFTHM TRUNC-LAND
+;;                       (IMPLIES (AND (>= X (EXPT 2 (1- N)))
+;;                                     (< X (EXPT 2 N))
+;;                                     (INTEGERP X)
+;;                                     (> X 0)
+;;                                     (INTEGERP M)
+;;                                     (>= M N)
+;;                                     (INTEGERP N)
+;;                                     (> N K)
+;;                                     (INTEGERP K)
+;;                                     (> K 0))
+;;                                (= (TRUNC X K)
+;;                                   (LAND X (- (EXPT 2 M) (EXPT 2 (- N K)))
+;;                                         N)))
+;;                       :RULE-CLASSES NIL)
+;;
+;;
+;; (defthm land-slice
+;;   (implies (and (<= j i) ;drop? or not?
+;;                 (<= i n)
+;;                 (integerp n)
+;;                 (integerp i)
+;;                 (integerp j)
+;;                 (<= 0 j)
+;;                 )
+;;            (equal (land x (- (expt 2 i) (expt 2 j)) n)
+;;                   (* (expt 2 j) (bits x (1- i) j))))
+;;   :hints (("Goal" :use land0-slice))
+;;   :rule-classes ())
+;;
+  
+(defthm trunc-logand
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) ;(> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0))
+           (= (trunc x k)
+              (logand x (- (expt 2 m) (expt 2 (- n k))))))
+  :rule-classes ())
+
+
+(defthmd trunc-split_alt
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits_alt x (1- (- n k)) (- n m))))))
+  :hints (("Goal" :use ((:instance trunc-split)))))
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+;;
+;; druss: the following may be wrong. 
+;;
+;; (defthm expo-near
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (near x n))
+;;                     (expo x)))
+;;   :rule-classes ())
+
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+;;;;
+
+
+(defun roundup_alt (x mode n)
+  (case mode
+    (near+ (= (bitn_alt x (- (expo x) n)) 1))
+    (near (and (= (bitn_alt x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn_alt x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+
+
+(defthm roundup_alt-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup_alt x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+
+
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/round-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/round-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/round-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/round-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1826 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+
+(include-book "float")
+(local (include-book "round-new"))
+
+
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-trunc)))))
+
+;;; Fri Feb 13 14:02:03 2009
+;;; 
+;;; Some truly new result. 
+
+
+
+;; (defthmd logand-expt-3-g
+;;     (implies (and (integerp x)
+;; 		  (natp n)
+;; 		  (natp k)
+;; 		  (< k n))
+;; 	     (equal (logand x (+ (expt 2 n) (- (expt 2 k))))
+;; 		    (* (expt 2 k) (bits x (1- n) k)))))
+;;
+;; (DEFTHM TRUNC-LAND
+;;                       (IMPLIES (AND (>= X (EXPT 2 (1- N)))
+;;                                     (< X (EXPT 2 N))
+;;                                     (INTEGERP X)
+;;                                     (> X 0)
+;;                                     (INTEGERP M)
+;;                                     (>= M N)
+;;                                     (INTEGERP N)
+;;                                     (> N K)
+;;                                     (INTEGERP K)
+;;                                     (> K 0))
+;;                                (= (TRUNC X K)
+;;                                   (LAND X (- (EXPT 2 M) (EXPT 2 (- N K)))
+;;                                         N)))
+;;                       :RULE-CLASSES NIL)
+;;
+;;
+;; (defthm land-slice
+;;   (implies (and (<= j i) ;drop? or not?
+;;                 (<= i n)
+;;                 (integerp n)
+;;                 (integerp i)
+;;                 (integerp j)
+;;                 (<= 0 j)
+;;                 )
+;;            (equal (land x (- (expt 2 i) (expt 2 j)) n)
+;;                   (* (expt 2 j) (bits x (1- i) j))))
+;;   :hints (("Goal" :use land0-slice))
+;;   :rule-classes ())
+;;
+  
+(defthm trunc-logand
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) ;(> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0))
+           (= (trunc x k)
+              (logand x (- (expt 2 m) (expt 2 (- n k))))))
+  :rule-classes ())
+
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m))))))
+  :hints (("Goal" :use ((:instance trunc-split_alt)))))
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+;;
+;; druss: the following may be wrong. 
+;;
+;; (defthm expo-near
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (near x n))
+;;                     (expo x)))
+;;   :rule-classes ())
+
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+;;;;
+
+
+(defun roundup (x mode n)
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+(local 
+ (defthm roundup-is-roundup_alt
+   (equal (roundup x mode n)
+          (roundup_alt x mode n))
+   :hints (("Goal" :in-theory (e/d (roundup_alt roundup) ())))))
+
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ()
+  :hints (("Goal" :use roundup_alt-thm)))
+  
+
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+
+
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/round.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/round.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/round.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/round.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1805 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "float")
+
+(set-enforce-redundancy t)
+
+(local (include-book "round-proofs"))
+
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+
+
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-trunc)))))
+
+;;; Fri Feb 13 14:02:03 2009
+;;; 
+;;; Some truly new result. 
+
+
+
+;; (defthmd logand-expt-3-g
+;;     (implies (and (integerp x)
+;; 		  (natp n)
+;; 		  (natp k)
+;; 		  (< k n))
+;; 	     (equal (logand x (+ (expt 2 n) (- (expt 2 k))))
+;; 		    (* (expt 2 k) (bits x (1- n) k)))))
+;;
+;; (DEFTHM TRUNC-LAND
+;;                       (IMPLIES (AND (>= X (EXPT 2 (1- N)))
+;;                                     (< X (EXPT 2 N))
+;;                                     (INTEGERP X)
+;;                                     (> X 0)
+;;                                     (INTEGERP M)
+;;                                     (>= M N)
+;;                                     (INTEGERP N)
+;;                                     (> N K)
+;;                                     (INTEGERP K)
+;;                                     (> K 0))
+;;                                (= (TRUNC X K)
+;;                                   (LAND X (- (EXPT 2 M) (EXPT 2 (- N K)))
+;;                                         N)))
+;;                       :RULE-CLASSES NIL)
+;;
+;;
+;; (defthm land-slice
+;;   (implies (and (<= j i) ;drop? or not?
+;;                 (<= i n)
+;;                 (integerp n)
+;;                 (integerp i)
+;;                 (integerp j)
+;;                 (<= 0 j)
+;;                 )
+;;            (equal (land x (- (expt 2 i) (expt 2 j)) n)
+;;                   (* (expt 2 j) (bits x (1- i) j))))
+;;   :hints (("Goal" :use land0-slice))
+;;   :rule-classes ())
+;;
+  
+(defthm trunc-logand
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) ;(> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0))
+           (= (trunc x k)
+              (logand x (- (expt 2 m) (expt 2 (- n k))))))
+  :rule-classes ())
+
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m))))))
+  :hints (("Goal" :use ((:instance trunc-split_alt)))))
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+;;
+;; druss: the following may be wrong. 
+;;
+;; (defthm expo-near
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (near x n))
+;;                     (expo x)))
+;;   :rule-classes ())
+
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+;;;;
+
+
+(defun roundup (x mode n)
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+
+
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ()
+  :hints (("Goal" :use roundup_alt-thm)))
+  
+
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+
+
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtl-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtl-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtl-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtl-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,797 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+
+(local (include-book "bits-new-proofs"))
+(local (include-book "log-new"))
+(local (include-book "../lib2/top"))
+
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;This book contains definitions of the ACL2 functions that are used in the
+;;formalization of RTL semantics.
+
+	       
+;;Bit-vector access:
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits_alt (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn_alt (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits_alt x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat_alt (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits_alt x (1- m) 0))
+         (bits_alt y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat_alt (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits_alt ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat_alt ,@x))
+        (t
+         `(binary-cat_alt ,(car x) 
+                      ,(cadr x) 
+                      (cat_alt ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat_alt.
+(add-macro-alias cat_alt binary-cat_alt)
+
+(defund mulcat_alt (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits_alt.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat_alt (mulcat_alt l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits_alt x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat_alt (mulcat_alt l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;;LNOT (bitwise complement):
+
+(defund lnot_alt (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits_alt x (1- n) 0)))
+    0))
+
+;LAND (bitwise and):
+
+
+(local (include-book "../../arithmetic/top"))
+
+(local 
+ (defthmd bitn-mod-2
+   (implies (integerp x)
+            (equal (bitn (mod x 2) 0)
+                   (mod x 2)))
+   :hints (("Goal" :in-theory (e/d (bitn bits-mod)
+                                   (bits-n-n-rewrite))))))
+
+
+(defund binary-land_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn_alt x 0) 1)
+                       (equal (bitn_alt y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land_alt (mod x 2) (mod y 2) 1))))
+       :exec ; (land_alt0 x y n)
+       (logand (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+
+(verify-guards binary-land_alt
+               :hints (("Goal" :in-theory (e/d (binary-land_alt
+                                                bits_alt-is-bits
+                                                bitn_alt-is-bitn
+                                                bits-mod
+                                                bitn-mod-2)
+                                               ())
+                        :induct (binary-land_alt x y n))
+                       ("Subgoal *1/4" :use ((:instance logand-def
+                                                        (i (bits x (+ -1 n) 0))
+                                                        (j (bits y (+ -1 n) 0)))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x x))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x y))))))
+
+
+
+
+(defmacro land_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land_alt x y n) -- the base case
+         `(binary-land_alt ,@x))
+        (t         
+         `(binary-land_alt ,(car x)
+                       (land_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land_alt)) to refer to binary-land_alt.
+(add-macro-alias land_alt binary-land_alt)
+
+;;LIOR_ALT (bitwise inclusive or):
+
+(defund binary-lior_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn_alt x 0) 1)
+                      (equal (bitn_alt y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior_alt (mod x 2) (mod y 2) 1))))
+       :exec ; (lior_alt0 x y n)
+       (logior (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+(local 
+ (encapsulate ()
+              (local (include-book "../support/logior"))
+              
+              (defthmd logior-1-x
+                (implies (bvecp x 1)
+                         (equal (logior 1 x) 1)))))
+ 
+
+
+(verify-guards binary-lior_alt
+               :hints (("Goal" :in-theory (e/d (binary-lior_alt
+                                                bits_alt-is-bits
+                                                bitn_alt-is-bitn
+                                                bits-mod
+                                                logior-1-x
+                                                bitn-mod-2)
+                                               ())
+                        :induct (binary-lior_alt x y n))
+                       ("Subgoal *1/4" :use ((:instance logior-def
+                                                        (i (bits x (+ -1 n) 0))
+                                                        (j (bits y (+ -1 n) 0)))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x x))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x y))))))
+
+
+
+
+
+(defmacro lior_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior_alt x y n) -- the base case
+         `(binary-lior_alt ,@x))
+        (t         
+         `(binary-lior_alt ,(car x)
+                       (lior_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior_alt)) to refer to binary-lior_alt:
+(add-macro-alias lior_alt binary-lior_alt)
+
+;;LXOR_ALT (bitwise exclusive or):
+
+(defund binary-lxor_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn_alt x 0) 1)
+                       (equal (bitn_alt y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor_alt (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor_alt0 x y n)
+       (logxor (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+(verify-guards binary-lxor_alt
+               :hints (("Goal" :in-theory (e/d (binary-lxor_alt
+                                                bits_alt-is-bits
+                                                bitn_alt-is-bitn
+                                                bits-mod
+                                                bitn-mod-2)
+                                               ())
+                        :induct (binary-lxor_alt x y n))
+                       ("Subgoal *1/4" :use ((:instance logxor-def
+                                                        (i (bits x (+ -1 n) 0))
+                                                        (j (bits y (+ -1 n) 0)))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x x))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x y))))))
+
+
+(defmacro lxor_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor_alt x y n) -- the base case
+         `(binary-lxor_alt ,@x))
+        (t         
+         `(binary-lxor_alt ,(car x)
+                       (lxor_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor_alt)) to refer to binary-lxor_alt.
+(add-macro-alias lxor_alt binary-lxor_alt)
+
+
+;;Bit-vector update:
+
+; We have decided to allow setbits_alt to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits_alt (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat_alt (bits_alt x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat_alt (bits_alt y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits_alt x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits_alt y (+ i (- j)) 0))
+                           (t
+                            (cat_alt (bits_alt x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits_alt y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat_alt (bits_alt y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits_alt x (1- j) 0)
+                          j))
+                    (t
+                     (cat_alt (bits_alt x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat_alt (bits_alt y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits_alt x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn_alt (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits_alt x w n n y))
+
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;;Signed inequalities:
+
+(defund comp2 (x n)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;;Unary logical operations:
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;;Shifting operations:
+
+(defund shft (x s l)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;;Arithmetic operations
+
+(defmacro mod+_alt (x y n)
+  `(bits_alt (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod*_alt (x y n)
+  `(bits_alt (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits_alt x
+i j) when x is negative.  However, bits_alt behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits_alt (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits_alt bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS_ALT-DROP-FROM-MINUS can
+get rid of the bits_alt call.
+|#
+
+(defmacro mod-_alt (x y n)
+  `(bits_alt (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still
+;; need to add assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+
+;;Evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO Where in lib/ should these go?
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr  clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;;Natural number recognizer
+
+(defund natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(defund bvecp (x k)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+(defun mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+
+; Finally, we include bvecp (and, occasionally, related) lemmas for several
+; functions that are disabled.  These are not included elsewhere, presumably
+; because the functions will generally be enabled (hence blown away) by the
+; user.
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (shft x s n) k)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+;;The definitions of these functions are best disabled:
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable mk-bvec))
+(in-theory (disable if1))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtl-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtl-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtl-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtl-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,707 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "rtl-new-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;This book contains definitions of the ACL2 functions that are used in the
+;;formalization of RTL semantics.
+
+
+	       
+;;Bit-vector access:
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits_alt (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn_alt (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits_alt x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat_alt (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits_alt x (1- m) 0))
+         (bits_alt y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat_alt (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits_alt ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat_alt ,@x))
+        (t
+         `(binary-cat_alt ,(car x) 
+                      ,(cadr x) 
+                      (cat_alt ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat_alt.
+(add-macro-alias cat_alt binary-cat_alt)
+
+(defund mulcat_alt (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits_alt.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat_alt (mulcat_alt l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits_alt x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat_alt (mulcat_alt l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;;LNOT (bitwise complement):
+
+(defund lnot_alt (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits_alt x (1- n) 0)))
+    0))
+
+;LAND (bitwise and):
+
+(defund binary-land_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn_alt x 0) 1)
+                       (equal (bitn_alt y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land_alt (mod x 2) (mod y 2) 1))))
+       :exec ; (land_alt0 x y n)
+       (logand (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+
+(defmacro land_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land_alt x y n) -- the base case
+         `(binary-land_alt ,@x))
+        (t         
+         `(binary-land_alt ,(car x)
+                       (land_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land_alt)) to refer to binary-land_alt.
+(add-macro-alias land_alt binary-land_alt)
+
+;;LIOR_ALT (bitwise inclusive or):
+
+(defund binary-lior_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn_alt x 0) 1)
+                      (equal (bitn_alt y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior_alt (mod x 2) (mod y 2) 1))))
+       :exec ; (lior_alt0 x y n)
+       (logior (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+(defmacro lior_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior_alt x y n) -- the base case
+         `(binary-lior_alt ,@x))
+        (t         
+         `(binary-lior_alt ,(car x)
+                       (lior_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior_alt)) to refer to binary-lior_alt:
+(add-macro-alias lior_alt binary-lior_alt)
+
+;;LXOR_ALT (bitwise exclusive or):
+
+(defund binary-lxor_alt (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn_alt x 0) 1)
+                       (equal (bitn_alt y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor_alt (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor_alt (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor_alt0 x y n)
+       (logxor (bits_alt x (1- n) 0)
+               (bits_alt y (1- n) 0))))
+
+
+
+(defmacro lxor_alt (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor_alt x y n) -- the base case
+         `(binary-lxor_alt ,@x))
+        (t         
+         `(binary-lxor_alt ,(car x)
+                       (lxor_alt ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor_alt)) to refer to binary-lxor_alt.
+(add-macro-alias lxor_alt binary-lxor_alt)
+
+
+;;Bit-vector update:
+
+; We have decided to allow setbits_alt to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits_alt (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat_alt (bits_alt x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat_alt (bits_alt y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits_alt x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits_alt y (+ i (- j)) 0))
+                           (t
+                            (cat_alt (bits_alt x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits_alt y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat_alt (bits_alt y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits_alt x (1- j) 0)
+                          j))
+                    (t
+                     (cat_alt (bits_alt x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat_alt (bits_alt y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits_alt x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn_alt (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits_alt x w n n y))
+
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;;Signed inequalities:
+
+(defund comp2 (x n)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;;Unary logical operations:
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;;Shifting operations:
+
+(defund shft (x s l)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;;Arithmetic operations
+
+(defmacro mod+_alt (x y n)
+  `(bits_alt (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod*_alt (x y n)
+  `(bits_alt (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits_alt x
+i j) when x is negative.  However, bits_alt behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits_alt (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits_alt bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS_ALT-DROP-FROM-MINUS can
+get rid of the bits_alt call.
+|#
+
+(defmacro mod-_alt (x y n)
+  `(bits_alt (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still
+;; need to add assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+
+;;Evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO Where in lib/ should these go?
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;;Natural number recognizer
+
+(defund natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(defund bvecp (x k)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+(defun mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+
+; Finally, we include bvecp (and, occasionally, related) lemmas for several
+; functions that are disabled.  These are not included elsewhere, presumably
+; because the functions will generally be enabled (hence blown away) by the
+; user.
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (shft x s n) k)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+;;The definitions of these functions are best disabled:
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable mk-bvec))
+(in-theory (disable if1))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtl-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtl-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtl-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtl-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,847 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "rtl-new"))
+
+(local (include-book "bits"))
+(local (include-book "bits-new"))
+(local (include-book "log-new"))
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+          
+
+;;;;;;
+;;;;;;
+
+
+;;This book contains definitions of the ACL2 functions that are used in the
+;;formalization of RTL semantics.
+
+	       
+;;Bit-vector access:
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;;LNOT (bitwise complement):
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+
+(local 
+ (defthm lnot-is-lnot_alt
+   (equal (lnot x n)
+          (lnot_alt x n))
+   :hints (("Goal" :in-theory (e/d (lnot lnot_alt) ())))))
+
+
+;LAND (bitwise and):
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec ; (land0 x y n)
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+
+
+
+(local (include-book "../../arithmetic/top"))
+
+(local 
+ (defthmd bitn_alt-mod-2
+   (implies (integerp x)
+            (equal (bitn_alt (mod x 2) 0)
+                   (mod x 2)))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bits_alt bits_alt-mod)
+                                   (bits_alt-n-n-rewrite))))))
+
+
+(verify-guards binary-land
+               :hints (("Goal" :in-theory (e/d (binary-land
+                                                bits-is-bits_alt
+                                                bitn-is-bitn_alt
+                                                bits_alt-mod
+                                                bitn_alt-mod-2)
+                                               ())
+                        :induct (binary-land x y n))
+                       ("Subgoal *1/4" :use ((:instance logand-def
+                                                        (i (bits_alt x (+ -1 n) 0))
+                                                        (j (bits_alt y (+ -1 n) 0)))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x x))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x y))))))
+
+
+
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land)) to refer to binary-land.
+(add-macro-alias land binary-land)
+
+;;LIOR (bitwise inclusive or):
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec ; (lior0 x y n)
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+
+(local 
+ (defthmd logior-1-x
+   (implies (bvecp x 1)
+            (equal (logior 1 x) 1))
+   :hints (("Goal" :in-theory (e/d (bvecp) ())
+            :cases ((equal x 0))))))
+ 
+
+ 
+
+
+(verify-guards binary-lior
+               :hints (("Goal" :in-theory (e/d (binary-lior
+                                                bits_alt-mod
+                                                logior-1-x
+                                                bitn_alt-mod-2)
+                                               ())
+                        :induct (binary-lior x y n))
+                       ("Subgoal *1/4" :use ((:instance logior-def
+                                                        (i (bits_alt x (+ -1 n) 0))
+                                                        (j (bits_alt y (+ -1 n) 0)))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x x))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x y))))))
+
+
+
+
+
+
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior)) to refer to binary-lior:
+(add-macro-alias lior binary-lior)
+
+;;LXOR (bitwise exclusive or):
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor0 x y n)
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+
+(verify-guards binary-lxor
+               :hints (("Goal" :in-theory (e/d (binary-lxor
+                                                bits_alt-mod
+                                                bitn_alt-mod-2)
+                                               ())
+                        :induct (binary-lxor x y n))
+                       ("Subgoal *1/4" :use ((:instance logxor-def
+                                                        (i (bits_alt x (+ -1 n) 0))
+                                                        (j (bits_alt y (+ -1 n) 0)))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x x))
+                                             (:instance FL-SHIFT-PULL-INSIDE-MOD
+                                                        (j 1)
+                                                        (i n)
+                                                        (x y))))))
+
+
+
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
+(add-macro-alias lxor binary-lxor)
+
+
+;;Bit-vector update:
+
+; We have decided to allow setbits to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(local 
+ (defthm setbits-is-setbits_alt
+   (equal (setbits x w i j y)
+          (setbits_alt x w i j y))
+   :hints (("Goal" :in-theory (e/d (setbits setbits_alt) ())))))
+
+
+(defun setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits x w n n y))
+
+(local 
+ (defthm setbitn-is-setbitn_alt
+   (equal (setbitn x w n y)
+          (setbitn_alt x w n y))
+   :hints (("Goal" :in-theory (e/d (setbitn setbitn_alt) ())))))
+
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;;Signed inequalities:
+
+(defund comp2 (x n)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;;Unary logical operations:
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;;Shifting operations:
+
+(defund shft (x s l)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;;Arithmetic operations
+
+(defmacro mod+ (x y n)
+  `(bits (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod* (x y n)
+  `(bits (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
+i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
+get rid of the bits call.
+|#
+
+(defmacro mod- (x y n)
+  `(bits (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still
+;; need to add assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+
+;;Evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO Where in lib/ should these go?
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr  clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;;Natural number recognizer
+
+(defund natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(defund bvecp (x k)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+(defun mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+
+; Finally, we include bvecp (and, occasionally, related) lemmas for several
+; functions that are disabled.  These are not included elsewhere, presumably
+; because the functions will generally be enabled (hence blown away) by the
+; user.
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (shft x s n) k)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+;;The definitions of these functions are best disabled:
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable mk-bvec))
+(in-theory (disable if1))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtl.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtl.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtl.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,700 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "rtl-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;This book contains definitions of the ACL2 functions that are used in the
+;;formalization of RTL semantics.
+
+	       
+;;Bit-vector access:
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;;LNOT (bitwise complement):
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+;LAND (bitwise and):
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec ; (land0 x y n)
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land)) to refer to binary-land.
+(add-macro-alias land binary-land)
+
+;;LIOR (bitwise inclusive or):
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec ; (lior0 x y n)
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior)) to refer to binary-lior:
+(add-macro-alias lior binary-lior)
+
+;;LXOR (bitwise exclusive or):
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor0 x y n)
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
+(add-macro-alias lxor binary-lxor)
+
+
+;;Bit-vector update:
+
+; We have decided to allow setbits to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits x w n n y))
+
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;;Signed inequalities:
+
+(defund comp2 (x n)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;;Unary logical operations:
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;;Shifting operations:
+
+(defund shft (x s l)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;;Arithmetic operations
+
+(defmacro mod+ (x y n)
+  `(bits (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod* (x y n)
+  `(bits (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
+i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
+get rid of the bits call.
+|#
+
+(defmacro mod- (x y n)
+  `(bits (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still
+;; need to add assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+
+;;Evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO Where in lib/ should these go?
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;;Natural number recognizer
+
+(defund natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(defund bvecp (x k)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+(defun mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+
+; Finally, we include bvecp (and, occasionally, related) lemmas for several
+; functions that are disabled.  These are not included elsewhere, presumably
+; because the functions will generally be enabled (hence blown away) by the
+; user.
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (shft x s n) k)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+;;The definitions of these functions are best disabled:
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable mk-bvec))
+(in-theory (disable if1))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtlarr-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtlarr-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtlarr-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtlarr-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,256 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../lib2/top"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+;;We define generic record accessing and updating functions to be used 
+;;with RTL arrays.  The basic functions are (ag a r) and (as a v r)
+;;where a is an array index, v is a value, r is an "array" or record.
+;;(ag a r) returns the value at index a in array r, and (as a v r) returns 
+;;a new array with index a set to value v in array r.
+
+(include-book "misc/total-order" :dir :system)
+
+(include-book "rtl-new")
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;Basic properties of arrays:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r)))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;; OK, we add here some properties for typing the records and the values which
+;; are stored in the records. This "typing" is pretty generic, but we choose the
+;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
+
+(defun bv-arrp (x k)
+  (declare (xargs :guard (integerp k)))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (bv-arrp (cdr x) k)
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (bvecp (cdar x) k)
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm as-maps-bv-arr-to-bv-arr
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as a v r) k)))
+
+(defthm ag-maps-bv-arr-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag a r) k)))
+
+(defun mk-bvarr (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bv-arrp r k) r ()))
+
+(defthm mk-bvarr-is-bv-arrp
+  (bv-arrp (mk-bvarr r k) k))
+
+(defthm mk-bvarr-identity
+  (implies (bv-arrp r k)
+           (equal (mk-bvarr r k) r)))
+
+(in-theory (disable bv-arrp mk-bvarr))
+
+;;We also define as2 and ag2 for 2-dimensional arrays but these simply
+;;macro-expand into appropriate as and ag calls.
+
+(defmacro ag2 (a b r)
+  `(ag (cons ,a ,b) ,r))
+
+(defmacro as2 (a b v r)
+  `(as (cons ,a ,b) ,v ,r))
+
+
+;;We disable as and ag, assuming the rules proved in this book are 
+;;sufficient to manipulate any record terms that are encountered.
+
+(in-theory (disable as ag))
+
+(defun positive-integer-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (equal l nil))
+        (t (and (integerp (car l))
+                (< 0 (car l))
+                (positive-integer-listp (cdr l))))))
+
+(defmacro arr0 (&rest dims)
+  (declare (ignore dims)
+           (xargs :guard (positive-integer-listp dims)))
+  nil)
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(encapsulate 
+ ((reset2 (key size) t))
+ (local (defun reset2 (key size) (declare (ignore key size)) nil))
+ (defthm bv-arrp-reset2
+   (bv-arrp (reset2 key size) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+(encapsulate 
+ ((unknown2 (key size n) t))
+ (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
+ (defthm bv-arrp-unknown2
+   (bv-arrp (unknown2 key size n) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+;BOZO where in lib/ should this go?
+(defthm bv-arrp-if1
+  (equal (bv-arrp (if1 x y z) n)
+         (if1 x (bv-arrp y n) (bv-arrp z n))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtlarr.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtlarr.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/rtlarr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/rtlarr.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,256 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "rtlarr-new"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+;;We define generic record accessing and updating functions to be used 
+;;with RTL arrays.  The basic functions are (ag a r) and (as a v r)
+;;where a is an array index, v is a value, r is an "array" or record.
+;;(ag a r) returns the value at index a in array r, and (as a v r) returns 
+;;a new array with index a set to value v in array r.
+
+(include-book "misc/total-order" :dir :system)
+
+(include-book "rtl")
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;Basic properties of arrays:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r)))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;; OK, we add here some properties for typing the records and the values which
+;; are stored in the records. This "typing" is pretty generic, but we choose the
+;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
+
+(defun bv-arrp (x k)
+  (declare (xargs :guard (integerp k)))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (bv-arrp (cdr x) k)
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (bvecp (cdar x) k)
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm as-maps-bv-arr-to-bv-arr
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as a v r) k)))
+
+(defthm ag-maps-bv-arr-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag a r) k)))
+
+(defun mk-bvarr (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bv-arrp r k) r ()))
+
+(defthm mk-bvarr-is-bv-arrp
+  (bv-arrp (mk-bvarr r k) k))
+
+(defthm mk-bvarr-identity
+  (implies (bv-arrp r k)
+           (equal (mk-bvarr r k) r)))
+
+(in-theory (disable bv-arrp mk-bvarr))
+
+;;We also define as2 and ag2 for 2-dimensional arrays but these simply
+;;macro-expand into appropriate as and ag calls.
+
+(defmacro ag2 (a b r)
+  `(ag (cons ,a ,b) ,r))
+
+(defmacro as2 (a b v r)
+  `(as (cons ,a ,b) ,v ,r))
+
+
+;;We disable as and ag, assuming the rules proved in this book are 
+;;sufficient to manipulate any record terms that are encountered.
+
+(in-theory (disable as ag))
+
+(defun positive-integer-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (equal l nil))
+        (t (and (integerp (car l))
+                (< 0 (car l))
+                (positive-integer-listp (cdr l))))))
+
+(defmacro arr0 (&rest dims)
+  (declare (ignore dims)
+           (xargs :guard (positive-integer-listp dims)))
+  nil)
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(encapsulate 
+ ((reset2 (key size) t))
+ (local (defun reset2 (key size) (declare (ignore key size)) nil))
+ (defthm bv-arrp-reset2
+   (bv-arrp (reset2 key size) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+(encapsulate 
+ ((unknown2 (key size n) t))
+ (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
+ (defthm bv-arrp-unknown2
+   (bv-arrp (unknown2 key size n) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+;BOZO where in lib/ should this go?
+(defthm bv-arrp-if1
+  (equal (bv-arrp (if1 x y z) n)
+         (if1 x (bv-arrp y n) (bv-arrp z n))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/simple-loop-helpers-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/simple-loop-helpers-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/simple-loop-helpers-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/simple-loop-helpers-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,368 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+
+(include-book "rtl")
+(include-book "rtlarr")
+(include-book "logn")
+
+(include-book "../../arithmetic/top")
+
+(local (include-book "bits"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I))
+  :hints (("Goal" :cases ((bvecp i 32)))
+          ("Subgoal 2" :in-theory (e/d (bvecp) ()))))
+
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+
+;; (defthm bitn-setbitn-setbitn
+;;   (implies (and (<  j w)
+;;                 (<= 0 j) 
+;;                 (integerp w)
+;;                 (integerp j))
+;;            (equal (bitn (setbitn x w j y)
+;;                         j)
+;;                   (bitn y 0))))
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K)))
+  :hints (("Goal" :in-theory (e/d (setbitn bitn-cat)
+                                  ()))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J))))
+  :hints (("Goal" :induct ($$loop_1 y+ i))
+          ("Subgoal *1/8" :expand ($$loop_1 y+ 0))
+          ("Subgoal *1/7" :expand ($$loop_1 y+ 0))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+))))
+  :hints (("Goal" :induct ($$loop_3 y+ i))
+          ("Subgoal *1/8" :expand ($$LOOP_3 Y+ 0))
+          ("Subgoal *1/7" :expand ($$LOOP_3 Y+ 0))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;not in support/simple-loop-helpers since would be redefined here (which is illegal)
+
+
+;; (deftheory simple-loop-thy-0
+;;   (union-theories '(if1) (theory 'minimal-theory)))
+
+;; (deftheory simple-loop-thy-1
+;;   (union-theories
+;;    '(bitn-setbitn-not-equal
+;;      ag-diff-as
+;;      bits-31-0
+;;      natp)
+;;    (theory 'simple-loop-thy-0)))
+
+;; (in-theory (enable setbits bitn-cat))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/simple-loop-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,356 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(include-book "log")
+(include-book "../../arithmetic/top")
+(local (include-book "simple-loop-helpers-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I)))
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+
+;; (defthm bitn-setbitn-setbitn
+;;   (implies (and (<  j w)
+;;                 (<= 0 j) 
+;;                 (integerp w)
+;;                 (integerp j))
+;;            (equal (bitn (setbitn x w j y)
+;;                         j)
+;;                   (bitn y 0))))
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;not in support/simple-loop-helpers since would be redefined here (which is illegal)
+
+;; (deftheory simple-loop-thy-0
+;;   (union-theories '(if1) (theory 'minimal-theory)))
+
+;; (deftheory simple-loop-thy-1
+;;   (union-theories
+;;    '(bitn-setbitn-not-equal
+;;      ag-diff-as
+;;      bits-31-0
+;;      natp)
+;;    (theory 'simple-loop-thy-0)))
+(in-theory (enable setbits bitn-cat))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-new-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-new-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-new-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-new-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,143 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+
+(include-book "bits-new")
+(include-book "logn-new")
+(include-book "arith")
+
+
+(local (include-book "../lib2/top"))
+
+(local 
+ (encapsulate () 
+              (local (include-book "bits-new-proofs"))
+
+             (defthm bits_alt-is-bits
+               (equal (bits_alt x i j)
+                      (bits x i j)))
+
+          
+             (defthm bitn_alt-is-bitn
+               (equal (bitn_alt x n)
+                      (bitn x n)))
+
+
+             (defthm binary-cat_alt-is-binary-cat
+               (equal (binary-cat_alt x m y n)
+                      (binary-cat x m y n)))
+
+             ))
+               
+;; ;;;;;
+
+(local 
+ (defthm lnot_alt-is-lnot
+   (equal (lnot_alt x n)
+          (lnot x n))
+   :hints (("Goal" :in-theory (e/d (lnot_alt lnot))))))
+
+
+(local (include-book "../lib2/simplify-model-helpers"))
+
+
+
+
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot_alt-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot_alt x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot_alt-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot_alt x 1) 1)
+                  (equal x 0))))
+
+(defthm bits_alt-if
+  (equal (bits_alt (if x y z) i j)
+         (if x (bits_alt y i j) (bits_alt z i j))))
+
+(defthm bitn_alt-if
+  (equal (bitn_alt (if x y z) i)
+         (if x (bitn_alt y i) (bitn_alt z i))))
+
+(defthm bits_alt-if1
+  (equal (bits_alt (if1 x y z) i j)
+         (if1 x (bits_alt y i j) (bits_alt z i j))))
+
+(defthm bitn_alt-if1
+  (equal (bitn_alt (if1 x y z) i)
+         (if1 x (bitn_alt y i) (bitn_alt z i))))
+
+(defthm log=-0-rewrite_alt
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot_alt k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot_alt-log=
+  (equal (log<> x y) (lnot_alt (log= x y) 1)))
+
+(defthm cat_alt-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat_alt x m (cat_alt y n z p) r)
+                  (cat_alt (cat_alt x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits_alt can introduce a call of cat_alt, which can introduce (bits_alt (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(in-theory (enable bvecp-monotone))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-new.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-new.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-new.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-new.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,109 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+
+(include-book "bits-new")
+(include-book "logn-new")
+(include-book "arith")
+
+(local (include-book "simplify-model-helpers-new-proofs"))
+
+
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot_alt-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot_alt x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot_alt-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot_alt x 1) 1)
+                  (equal x 0))))
+
+(defthm bits_alt-if
+  (equal (bits_alt (if x y z) i j)
+         (if x (bits_alt y i j) (bits_alt z i j))))
+
+(defthm bitn_alt-if
+  (equal (bitn_alt (if x y z) i)
+         (if x (bitn_alt y i) (bitn_alt z i))))
+
+(defthm bits_alt-if1
+  (equal (bits_alt (if1 x y z) i j)
+         (if1 x (bits_alt y i j) (bits_alt z i j))))
+
+(defthm bitn_alt-if1
+  (equal (bitn_alt (if1 x y z) i)
+         (if1 x (bitn_alt y i) (bitn_alt z i))))
+
+(defthm log=-0-rewrite_alt
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot_alt k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot_alt-log=
+  (equal (log<> x y) (lnot_alt (log= x y) 1)))
+
+(defthm cat_alt-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat_alt x m (cat_alt y n z p) r)
+                  (cat_alt (cat_alt x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits_alt can introduce a call of cat_alt, which can introduce (bits_alt (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(in-theory (enable bvecp-monotone))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-proofs.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers-proofs.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,143 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "rtl")
+(include-book "bits")
+(include-book "logn")
+(include-book "arith")
+
+(local (include-book "simplify-model-helpers-new"))
+
+
+
+(local 
+ (defthm bits-is-bits_alt
+   (equal (bits x i j)
+          (bits_alt x i j))
+   :hints (("Goal" :in-theory (e/d (bits_alt bits) ())))))
+              
+(local               
+ (defthm bitn-is-bitn_alt
+   (equal (bitn x n)
+          (bitn_alt x n))
+   :hints (("Goal" :in-theory (e/d (bitn_alt bitn) ())))))
+          
+(local               
+ (defthm binary-cat_alt-is-binary-cat
+   (equal (binary-cat x m y n)
+          (binary-cat_alt x m y n))
+   :hints (("Goal" :in-theory (e/d (binary-cat_alt binary-cat) ())))))
+          
+(local               
+ (defthm mulcat_alt-is-mulcat
+   (equal (mulcat l n x)
+          (mulcat_alt l n x))
+   :hints (("Goal" :in-theory (e/d (mulcat_alt mulcat) ())))))
+
+
+(local 
+ (defthm lnot_alt-is-lnot
+   (equal (lnot_alt x n)
+          (lnot x n))
+   :hints (("Goal" :in-theory (e/d (lnot_alt lnot) ())))))
+
+
+
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1)))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(in-theory (enable bvecp-monotone))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/simplify-model-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,106 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+
+(include-book "rtl")
+(include-book "arith")
+(include-book "bits")
+(local (include-book "simplify-model-helpers-proofs"))
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1)))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(in-theory (enable bvecp-monotone))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/top.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/top.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/top.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,74 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "rtl") ;semantics of the basic RTL primitives
+
+(include-book "rtlarr") ;semantics RTL array primitives
+
+(include-book "bits") ;bit vectors
+
+(include-book "log") ;logical operations
+
+(include-book "float") ;floating-point numbers
+
+(include-book "reps") ;floating-point formats and representations
+
+(include-book "round") ;floating-point rounding
+
+(include-book "add") ;support for reasoning about floating-point addition
+;                      (leading one prediction and sticky bit computation)
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../arithmetic/top")
+
+(include-book "mult")  ; integerp multiplier
+
+;; (include-book "arith") ;general arithmetic package
+
+(include-book "bvecp-raw-helpers") 
+
+
+(include-book "simple-loop-helpers") 
+
+
+(include-book "arith")
+
+(include-book "bvecp-helpers")
+
+(include-book "logn")
+
+
+(include-book "simplify-model-helpers")
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta1/util.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta1/util.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta1/util.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta1/util.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,164 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+
+(local (include-book "../lib2/top"))
+
+;;These macros facilitate localization of events:
+
+(defmacro local-defun (&rest body)
+  (list 'local (cons 'defun body)))
+
+(defmacro local-defund (&rest body)
+  (list 'local (cons 'defund body)))
+
+(defmacro local-defthm (&rest body)
+  (list 'local (cons 'defthm body)))
+
+(defmacro local-defthmd (&rest body)
+  (list 'local (cons 'defthmd body)))
+
+(defmacro local-in-theory (&rest body)
+  (cons 'local
+	(cons (cons 'in-theory (append body 'nil))
+	      'nil)))
+
+(defmacro defbvecp (name formals width &key thm-name hyp hints)
+  (let* ((thm-name
+          (or thm-name
+              (intern-in-package-of-symbol
+               (concatenate 'string
+                            (if (consp width)
+                                "BV-ARRP$"
+                              "BVECP$")
+                            (symbol-name name))
+               name)))
+         (x (cons name formals))
+         (typed-term (if (consp width)
+                         (list 'ag 'index x)
+                       x))
+         (bvecp-concl (if (consp width)
+                          (list 'bv-arrp x (car (last width)))
+                        (list 'bvecp x width)))
+         (concl (list 'and
+                      (list 'integerp typed-term)
+                      (list '<= 0 typed-term))))
+    (list* 'defthm thm-name
+           (if hyp
+               (list 'implies hyp bvecp-concl)
+             bvecp-concl)
+           :rule-classes
+           (list
+            :rewrite
+            (list :forward-chaining :trigger-terms (list x))
+            (list :type-prescription
+                  :corollary
+                  (if hyp
+                      (list 'implies hyp concl)
+                    concl)
+                  :typed-term typed-term
+                  ;; hints for the corollary 
+                  :hints
+                  (if (consp width)
+                      '(("Goal"
+                         :in-theory
+                         '(implies bvecp
+                                   bv-arrp-implies-nonnegative-integerp)))
+                    '(("Goal"
+                       :in-theory
+                       '(implies bvecp))))))
+           (if hints (list :hints hints) nil))))
+
+(defun sub1-induction (n)
+      (if (zp n)
+          n
+        (sub1-induction (1- n))))
+
+; These will be the functions to disable in acl2 proofs about signal bodies.
+; We use this in the compiler.
+;BOZO This doesn't include cons, which can now appear in signals defs.  I think that's okay, right?  think
+;about this and remove the BOZO
+(defconst *rtl-operators-after-macro-expansion*
+  '(log= log<> 
+    log< log<= log> log>= 
+    comp2< comp2<= comp2> comp2>=
+    land lior lxor lnot
+    logand1 logior1 logxor1
+    shft
+    cat mulcat
+    bits bitn setbits setbitn 
+    ag as
+    * + ; from macroexpansion of mod* or mod+
+    ;mod- ;now a macro!
+    floor rem decode encode
+    ;; bind ; handled specially in fixup-term
+    ;; if1 ;  a macro, so we don't disable it
+    ;; quote, n!, arr0 ; handled specially in fixup-term
+    natp1 ; doesn't matter, only occurs in for-loop defuns (must be enabled in those proofs anyway)
+    mk-bvarr mk-bvec
+    ))
+
+; Macro fast-and puts conjunctions in a tree form, which can avoid stack
+; overflows by ACL2's translate functions.
+
+(defun split-list (lst lo hi)
+  (cond ((endp lst) 
+         (mv lo hi))
+        ((endp (cdr lst)) 
+         (mv (cons (car lst) lo) hi))
+        (t
+         (split-list (cddr lst)
+                     (cons (car lst) lo)
+                     (cons (cadr lst) hi)))))
+
+(defun fast-and-fn (conjuncts)
+  (declare (xargs :mode :program))
+  (cond ((endp conjuncts) ''t)
+        ((endp (cdr conjuncts)) (car conjuncts))
+        (t
+         (mv-let (hi lo)
+             (split-list conjuncts () ())
+           (list 'if
+                 (fast-and-fn hi)
+                 (fast-and-fn lo)
+                 'nil)))))
+
+(defmacro fast-and (&rest conjuncts)
+  (fast-and-fn conjuncts))
+
+
+(defmacro defsig (name param body)
+  (declare (ignore param))
+  (let ((realname  (intern-in-package-of-symbol
+                    (concatenate 'string
+                                 (symbol-name name)
+                                 "$")
+                    name)))
+    `(progn (defund ,realname (n $path) 
+              ,body)
+            (defmacro ,name (n)
+              (list ',realname n '$path))
+            (add-macro-alias ,name ,realname))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta2/Makefile acl2-6.3/books/rtl/rel9/support/lib2.delta2/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib2.delta2/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta2/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,8 @@
+include ../../../../Makefile-generic
+
+# BOOKS = base \
+# 	add-lib \
+# 	log bits add 
+
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta2/add-lib.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta2/add-lib.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta2/add-lib.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta2/add-lib.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,212 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "base")
+(local (include-book "../lib2.delta1/arith"))
+
+;; Add to bits.lisp, after bits-bvecp:
+
+(defthm bits-bounds
+    (implies (and (integerp i)
+		  (integerp j))
+	     (and (natp (bits x i j))
+		  (< (bits x i j) (expt 2 (1+ (- i j))))))
+  :rule-classes()
+  :hints (("Goal" :in-theory (e/d (bvecp) (bits-bvecp bits-bvecp-simple))
+		  :use ((:instance bits-bvecp (k (1+ (- i j))))))))
+
+;; Add these to bits.lisp, after bits-bits-sum:
+
+(defthmd bits-bits-diff
+  (implies (and (integerp x)
+                (integerp y)
+                (natp i))
+	   (equal (bits (- x (bits y i 0)) i 0)
+		  (bits (- x y) i 0)))
+  :hints (("Goal" :use ((:instance mod-diff (a x) (b y) (n (expt 2 (1+ i)))))
+		  :in-theory (enable bits-mod))))
+
+(local-defthm bits-bits-times-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp i))
+	     (= (bits (* (bits x i 0) y) i 0)
+		(bits (* x y) i 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-mod-times (a x) (b y) (n (expt 2 (1+ i)))))
+		  :in-theory (enable bits-mod))))
+
+(defthmd bits-bits-times
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i))
+	     (equal (bits (* (bits x i 0) y) i 0)
+		    (bits (* x y) i 0)))
+  :hints (("Goal" :use (bits-bits-times-1))))
+
+(defthm bits-diff-equal
+    (implies (and (natp n)
+		  (integerp x)
+		  (integerp y)
+		  (< (abs (- x y)) (expt 2 n)))
+	     (iff (= x y)
+		  (= (bits (- x y) (1- n) 0) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-mod)
+		  :use ((:instance mod-force-equal (a (- x y)) (b 0) (n (expt 2 n)))))))
+
+
+;; Add these to bits.lisp,after bits-tail-2:
+
+(defun sgndintval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm sgndintval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (sgndintval w (bits x (1- w) 0))
+		x))
+  :hints (("Goal" :use ((:instance bits-tail (i (1- w)))
+			(:instance bits-tail-2 (i (1- w)))
+			(:instance expt-weak-monotone (n (1- w)) (m w))
+			(:instance bvecp-bitn-0 (n (1- w)))
+			(:instance bvecp-bitn-0 (n (1- w))))
+		  :in-theory (enable bvecp)))
+  :rule-classes ())
+
+
+(defun signextend (n m x)
+  (bits (SgndIntVal m x) (1- n) 0))
+
+(local-defthm sgndintval-signextend-1
+    (implies (and (natp n)
+		  (integerp z)
+		  (< z (expt 2 (1- n)))
+		  (<= (- (expt 2 (1- n))) z))
+	     (equal (sgndintval n (bits z (1- n) 0))
+		    z))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bvecp-bitn-0 (x z) (n (1- n)))
+			(:instance neg-bitn-1 (x z) (n (1- n)))
+			(:instance bits-tail (x z) (i (1- n)))
+			(:instance bits-tail-2 (x z) (i (1- n)))
+			(:instance expt-strong-monotone (n (1- n)) (m n)))
+		  :in-theory (enable bvecp))))
+
+(defthmd sgndintval-signextend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (sgndintval n (signextend n m x))
+		    (sgndintval m x)))
+  :hints (("Goal" :use ((:instance sgndintval-signextend-1 (z (sgndintval m x)))
+			(:instance expt-weak-monotone (n (1- m)) (m (1- n)))
+			(:instance a15 (i 2) (j1 (1- m)) (j2 1))
+			(:instance bitn-plus-bits (n (1- m)) (m 0))
+			(:instance bits-bounds (i (- m 2)) (j 0)))
+		  :in-theory (enable bvecp))))
+
+;; Add bits-lognot to log.lisp, after bitn-lognot:
+
+(local-defthm mod-lognot
+    (implies (and (integerp n)
+		  (> n 0)
+		  (integerp x))
+	     (equal (mod (lognot x) n)
+		    (- (1- n) (mod x n))))
+  :hints (("Goal" :in-theory (enable lognot)
+		  :use ((:instance mod-mult (m (1- (- x))) (a 1) (n n))
+			(:instance mod-diff (a (1- n)) (b x) (n n))
+			(:instance mod-does-nothing 
+				   (m (- (1- n) (mod x n)))
+				   (n n))
+			(:instance mod-bnd-2 (m x) (n n))
+			(:instance natp-mod-2 (m x) (n n))))))
+
+(local-defthmd bits-lognot-1
+    (implies (and (natp i)
+		  (integerp j)
+		  (<= j i)
+		  (integerp x))
+	     (equal (bits (lognot x) i j)
+		    (fl (/ (- (1- (expt 2 (1+ i)))
+			      (mod x (expt 2 (1+ i))))
+			   (expt 2 j)))))
+  :hints (("Goal" :in-theory (enable bits))))
+
+(local-defthm bits-lognot-2
+    (implies (and (integerp i)
+		  (integerp j))
+	     (equal (* (/ (EXPT 2 J)) (EXPT 2 (+ 1 I)))
+		    (expt 2 (- (1+ i) j))))
+  :hints (("Goal" :use ((:instance a15 (i 2) (j1 (1+ i)) (j2 (- j)))))))
+
+(local-defthmd bits-lognot-3
+    (implies (and (natp i)
+		  (integerp j)
+		  (<= j i)
+		  (integerp x))
+	     (equal (bits (lognot x) i j)
+		    (+ (expt 2 (- (1+ i) j)) 
+		       (fl (/ (1- (- (mod x (expt 2 (1+ i))))) (expt 2 j))))))
+  :hints (("Goal" :in-theory (enable bits-lognot-1)
+		  :use ((:instance fl+int-rewrite 
+				   (x (/ (1- (- (mod x (expt 2 (1+ i))))) (expt 2 j)))
+				   (n (expt 1 (- (1+ i) j))))))))
+
+(defthmd bits-lognot
+    (implies (and (natp i)
+		  (natp j)
+		  (<= j i)
+		  (integerp x))
+	     (equal (bits (lognot x) i j)
+		    (- (1- (expt 2 (- (1+ i) j))) (bits x i j))))
+  :hints (("Goal" :in-theory (enable bits bits-lognot-3)
+		  :use ((:instance fl-m-n (m (- (mod x (expt 2 (1+ i))))) (n (expt 2 j)))))))
+
+;;Add to add.lisp, after bits-sum:
+
+(defthm bits-sum-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp i) 
+		  (natp j)
+		  (> j 0)
+		  (>= i j))
+           (equal (bits (+ (* (expt 2 j) x) y) i j)
+                  (bits (+ (bits (* (expt 2 j) x) i j)
+                           (bits y i j))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable gen-val)
+		  :use ((:instance bits-sum (x (* (expt 2 j) x)))
+			(:instance bits-bounds (x y) (i (1- j)) (j 0))
+			(:instance bits-shift-up-2 (k j) (i -1))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta2/add.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta2/add.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta2/add.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta2/add.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,458 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;(set-enforce-redundancy t)
+
+;(include-book "round")
+
+(include-book "base")
+(local (include-book "add-lib"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (logand u v) 1 (logxor u v) 1)))
+  :rule-classes ())
+
+(defthm add-2
+    (implies (and (natp x) (natp y))
+	     (equal (+ x y)
+		    (+ (logxor x y)
+		       (* 2 (logand x y)))))
+  :rule-classes ())
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (logior (logand u v) (logior (logand u w) (logand v w))) 1 
+                       (logxor u (logxor v w)) 1)))
+  :rule-classes ())
+
+(defthm add-3
+    (implies (and (natp x)
+		  (natp y)
+		  (natp z))
+	     (= (+ x y z)
+		(+ (logxor x (logxor y z))
+		   (* 2 (logior (logand x y)
+				(logior (logand x z)
+					(logand y z)))))))
+  :rule-classes ())
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (logior (logand (bitn x (1- k)) (bitn y (1- k)))
+	    (logior (logand (bitn x (1- k)) (rc-carry x y (1- k)))
+		    (logand (bitn y (1- k)) (rc-carry x y (1- k)))))))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (logxor (bitn x (1- k))
+		 (logxor (bitn y (1- k)) (rc-carry x y (1- k))))
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :rule-classes ())
+
+(defun gen (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+(defun prop (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(defthmd gen-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen x y i j)
+                  (if (>= (+ (bits x i j) (bits y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j) (bits y i j))
+			(1+ (- i j))))))
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0)))))
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (logior (bitn x i) (bitn y i))))
+  :rule-classes ())
+
+(defthmd prop-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop x y i j)
+                  (if (= (+ (bits x i j) (bits y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthmd prop-as-logxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (logxor (bits x i j) (bits y i j))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthm gen-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (gen x y i j)
+		    (logior (gen x y i (1+ k))
+			    (logand (prop x y i (1+ k))
+				    (gen x y k j)))))
+  :rule-classes ())
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :rule-classes ())
+
+(defthm prop-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (prop x y i j)
+		    (logand (prop x y i (1+ k))
+			    (prop x y k j))))
+  :rule-classes ())
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp i) 
+		  (natp j)
+		  (> j 0)
+		  (>= i j))
+           (equal (bits (+ (* (expt 2 j) x) y) i j)
+                  (bits (+ (bits (* (expt 2 j) x) i j)
+                           (bits y i j))
+                        (- i j) 0)))
+    :rule-classes ())
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j))))
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j)))))
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-plus-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (bits x i j)
+			     (bits y i j)
+			     (logior (prop x y (1- j) 0) 
+				     (gen x y (1- j) 0) ))
+			  (- i j) 0)))
+  :rule-classes ())
+
+(defthmd logand-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand (bits x i j) (bits y i j)) 0))
+           (equal (gen x y i j) 0)))
+
+
+(defthm logand-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand x y) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :rule-classes ())
+
+(defthmd gen-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (logand z y) 0)
+		(= (gen x y k 0) 1))
+	   (equal (gen (+ x y) z k 0) 0)))
+
+(defthmd gen-extend-3
+    (implies (and (natp i)
+		  (natp j)
+		  (> i j)
+		  (natp x)
+		  (natp y)
+		  (bvecp z (1+ j))
+		  (= (logand y z) 0))		  
+	     (equal (gen (+ x y) z i 0)
+		    (logand (prop x y i (1+ j))
+			    (gen (+ x y) z j 0)))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm lop-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ())
+
+(defthm lop-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (bits (lognot (* 2 b)) e 0))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
+
+(defun lamt (a b e)
+  (logxor a (bits (lognot b) e 0)))
+
+(defun lamg (a b e)
+  (logand a (bits (lognot b) e 0)))
+
+(defun lamz (a b e)
+  (bits (lognot (logior a (bits (lognot b) e 0))) e 0))
+
+(defun lam1 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam2 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam3 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam4 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam0 (a b e)
+  (logior (lam1 a b e)
+	  (logior (lam2 a b e)
+		  (logior (lam3 a b e)
+			  (lam4 a b e)))))
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (bitn (lognot(lamt a b e)) 0)))
+
+(defthm lop-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lognot (logxor a b)) k 0) 0)))
+  :rule-classes ())
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (logxor (logxor a b) 
+                                       (cat (logior a b) n c 1))
+                               k 0) 
+                         0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta2/base.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta2/base.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta2/base.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta2/base.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,86 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "../lib2.delta1/rtl") ;semantics of the basic RTL primitives
+
+(include-book "../lib2.delta1/rtlarr") ;semantics RTL array primitives
+
+(include-book "../lib2/basic") ;properties of basic arithmetic functions: floor, ceiling, 
+;                       exponential, and remainder;;  Wed Feb  4 16:40:37 2009
+
+;(include-book "../lib1/bits") ;bit vectors
+(include-book "../lib2.delta1/bits") ;bit vectors ;; Wed Feb  4 16:40:43 2009
+
+
+(include-book "../lib2.delta1/log") ;logical operations
+
+(include-book "../lib2.delta1/float") ;floating-point numbers
+
+(include-book "../lib2.delta1/reps") ;floating-point formats and representations
+
+(include-book "../lib2.delta1/round") ;floating-point rounding
+
+(include-book "../lib2.delta1/add") ;support for reasoning about floating-point addition
+;                      (leading one prediction and sticky bit computation)
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../arithmetic/top")
+
+(include-book "../lib2.delta1/mult")  ; integerp multiplier
+
+;(include-book "../lib2.delta1/arith") ;general arithmetic package
+
+;
+; let go Thu Feb 19 09:43:32 2009
+
+(include-book "../lib2.delta1/util") ;misc helpful stuff including a few macros
+
+
+;(include-book "../lib2.delta1/bvecp-raw-helpers")  
+;; ; better bvecp-raw-helpers.lisp, Fri Jun 29 10:13:32 2007
+
+;(include-book "../lib2.delta1/simple-loop-helpers")  
+
+;(include-book "../lib2/rom-helpers")  
+
+
+;(include-book "../lib2.delta1/bvecp-helpers")
+
+;(include-book "../lib2.delta1/logn")
+
+
+;(include-book "../lib2.delta1/simplify-model-helpers")
+
+
+;(include-book "../lib2.delta1/logn2log")
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta2/bits.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta2/bits.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta2/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta2/bits.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,969 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;(set-enforce-redundancy t)
+
+;(include-book "basic")
+
+(include-book "base")
+(local (include-book "add-lib"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+(defthm bits-bounds
+    (implies (and (integerp i)
+		  (integerp j))
+	     (and (natp (bits x i j))
+		  (< (bits x i j) (expt 2 (1+ (- i j))))))
+  :rule-classes())
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0))))
+
+
+;;;; ?? (- x (bits y i 0)) may not be the normal form. 
+(defthmd bits-bits-diff
+  (implies (and (integerp x)
+                (integerp y)
+                (natp i))
+	   (equal (bits (- x (bits y i 0)) i 0)
+		  (bits (- x y) i 0))))
+
+(defthmd bits-bits-times
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i))
+	     (equal (bits (* (bits x i 0) y) i 0)
+		    (bits (* x y) i 0))))
+
+(defthm bits-diff-equal
+    (implies (and (natp n)
+		  (integerp x)
+		  (integerp y)
+		  (< (abs (- x y)) (expt 2 n)))
+	     (iff (= x y)
+		  (= (bits (- x y) (1- n) 0) 0)))
+  :rule-classes ())
+
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i))))))))
+
+(defthm bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+
+(defthmd neg-bits-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j)))))))
+
+(defthmd bits-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j)))))))
+
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-tail-2
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+
+(defun sgndintval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm sgndintval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (sgndintval w (bits x (1- w) 0))
+                x))
+    :rule-classes nil)
+
+
+
+(defun signextend (n m x)
+  (bits (SgndIntVal m x) (1- n) 0))
+
+(defthmd sgndintval-signextend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (sgndintval n (signextend n m x))
+		    (sgndintval m x))))
+
+;;
+
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :rule-classes ())
+
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ())
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthm bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+;;See also bits-dont-match.
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+;;See also bits-match.
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1)))
+
+
+(defthmd bitn-shift
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthmd bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m)))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+; The lemmas sumbits-badguy-is-correct and sumbits-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t)))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0)))
+
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0)))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;;Definition of the macro, cat:
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta2/log.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta2/log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta2/log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta2/log.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,543 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;(set-enforce-redundancy t)
+
+(include-book "base")
+(local (include-book "add-lib"))
+
+
+;;;**********************************************************************
+;;;                       LOGNOT, LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+(in-theory (disable lognot logand logior logxor))
+
+(defthmd lognot-def
+    (implies (integerp x)
+	     (equal (lognot x)
+		    (1- (- x)))))
+
+(defthmd logand-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logand i j)
+		    (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logand (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+
+(defthmd logior-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logior i j)
+		    (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+
+
+(defthmd logxor-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logxor i j)
+		    (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+
+(defthm logand-natp
+    (implies (and (natp i)
+		  (integerp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logand-natp-2
+    (implies (and (integerp i)
+		  (natp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logand-bvecp
+    (implies (and (natp n)
+		  (bvecp x n)
+		  (integerp y))
+	     (bvecp (logand x y) n))
+    :hints (("Goal" :by logand-bvecp-g)))
+
+(defthm logior-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logior i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logior-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n))
+	     (bvecp (logior x y) n)))
+
+(defthm logxor-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logxor i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n))
+	     (bvecp (logxor x y) n)))
+
+;;;;;;
+
+
+(defun logop-2-induct-g (x y)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)))))
+  (if (and (integerp x) (integerp y))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1)))
+          t
+        (logop-2-induct-g (fl (/ x 2)) (fl (/ y 2))))
+    t))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+
+(defun logop-3-induct-g (x y z)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)) (nfix (abs z)))))
+  (if (and (integerp x) (integerp y) (integerp z))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1))
+               (or (equal z 0)
+                   (equal z -1)))
+	  t
+	(logop-3-induct-g (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+
+(defthmd logand-fl-2-rewrite
+    (implies (and (natp x)
+		  (natp y))
+	     (equal (fl (* 1/2 (logand x y)))
+		    (logand (fl (* 1/2 x)) (fl (* 1/2 y))))))
+
+(defthmd logior-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logior i j)))
+		    (logior (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthmd logxor-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logxor i j)))
+		    (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+
+(defthm logior-not-0
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (logior x y) 0))
+	     (and (= x 0) (= y 0)))
+  :rule-classes ())
+
+(defthm logior-expt
+    (implies (and (natp n)
+		  (integerp x)
+		  (bvecp y n))
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-g)))
+
+(defthm logior-expt-2
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logior (* (expt 2 n) x)
+			(* (expt 2 n) y))
+		(* (expt 2 n) (logior x y))))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-2-g)))
+
+
+(defthm logand-bnd
+    (implies (<= 0 x)
+	     (<= (logand x y) x))
+  :rule-classes :linear)
+
+(defthm logand-expt
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logand (* (expt 2 n) x) y)
+		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+  :rule-classes ()
+  :hints (("Goal" :by logand-expt-g)))
+
+
+(defthmd bitn-lognot
+    (implies (and (integerp x)
+		  (integerp n)
+		  (> n 0))
+	     (not (equal (bitn (lognot x) n)
+			 (bitn x n))))
+    :hints (("Goal" :use bitn_alt-lognot)))
+
+(defthmd bits-lognot
+    (implies (and (natp i)
+		  (natp j)
+		  (<= j i)
+		  (integerp x))
+	     (equal (bits (lognot x) i j)
+		    (- (1- (expt 2 (- (1+ i) j))) (bits x i j)))))
+
+
+
+(defthmd bitn-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logand x y) n)
+		    (logand (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logand)))
+
+
+(defthmd bits-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logand x y) i j)
+		    (logand (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logand)))
+
+
+
+(defthmd bitn-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logior x y) n)
+		    (logior (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logior)))
+
+
+(defthmd bits-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logior x y) i j)
+		    (logior (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logior)))
+
+
+(defthmd bitn-logxor
+    (implies (and (case-split (integerp x))
+		  (case-split (integerp y))
+		  (case-split (integerp n)))
+	     (equal (bitn (logxor x y) n)
+		    (logxor (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logxor)))
+
+(defthmd bits-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (bits (logxor x y) i j)
+                  (logxor (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logxor)))
+
+(defthmd logand-expt-2
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logand x (expt 2 k))
+		    (* (expt 2 k) (bitn x k))))
+    :hints (("Goal" :use logand-expt-2-g)))
+
+(defthmd logior-expt-3
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logior x (expt 2 k))
+		    (+ x
+		       (* (expt 2 k) 
+			  (- 1 (bitn x k))))))
+    :hints (("Goal" :use ((:instance logior-expt-3-g)))))
+
+(defthmd logand-expt-3
+    (implies (and (integerp x)
+		  (natp n)
+		  (natp k)
+		  (< k n))
+	     (equal (logand x (- (expt 2 n) (expt 2 k)))
+		    (* (expt 2 k) (bits x (1- n) k))))
+    :hints (("Goal" :use ((:instance logand-expt-3-g)))))
+
+(defthmd logand-expt-4
+    (implies (and (natp n)
+		  (natp k)
+		  (natp l)
+		  (< l k)
+		  (<= k n))
+	     (equal (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+		    (- (expt 2 n) (expt 2 k))))
+    :hints (("Goal" :use ((:instance logand-expt-4-g)))))
+
+(defthmd lognot-shift
+  (implies (and (integerp x)
+                (natp k))
+           (equal (lognot (* (expt 2 k) x))
+		  (+ (* (expt 2 k) (lognot x))
+		     (1- (expt 2 k))))))
+
+(defthmd logand-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logand (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logand x y)))))
+
+(defthmd logxor-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logxor (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logxor x y)))))
+
+(defthmd logior-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logior (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logior x y)))))
+
+(defthmd fl-lognot
+    (implies (case-split (integerp i))
+	     (= (fl (* 1/2 (lognot i)))
+                (lognot (fl (* 1/2 i))))))
+
+(defthmd fl-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logand x y) (expt 2 k)))
+                  (logand (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logior x y) (expt 2 k)))
+                  (logior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logxor
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logxor x y) (expt 2 k)))
+                  (logxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lognot-lognot
+    (implies (case-split (integerp i))
+	     (equal (lognot (lognot i))
+		    i)))
+
+(defthm logand-x-0
+    (equal (logand x 0) 0))
+
+(defthm logand-0-y
+    (equal (logand 0 y) 0))
+
+(defthm logior-x-0
+    (implies (integerp x)
+	     (equal (logior x 0) x)))
+
+(defthm logior-0-y
+    (implies (integerp y)
+	     (equal (logior 0 y) y)))
+
+(defthm logxor-x-0
+    (implies (integerp x)
+	     (equal (logxor x 0) x)))
+
+(defthm logxor-0-y
+    (implies (integerp y)
+	     (equal (logxor 0 y) y)))
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logior-self
+    (implies (case-split (integerp i))
+	     (equal (logior i i) i)))
+
+(defthm logxor-self
+  (equal (logxor i i) 0))
+
+(defthm logand-x-m1
+    (implies (integerp x)
+	     (equal (logand x -1) x)))
+
+(defthm logand-m1-y
+    (implies (integerp y)
+	     (equal (logand -1 y) y)))
+
+(defthm logand-x-1
+    (implies (bvecp x 1)
+	     (equal (logand x 1) x)))
+
+(defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x)))
+
+(defthm logior-x-m1
+    (implies (integerp x)
+	     (equal (logior x -1) -1)))
+
+(defthm logior-m1-y
+    (implies (integerp y)
+	     (equal (logior -1 y) -1)))
+
+(defthm logior-1-x
+  (implies (bvecp x 1)
+           (equal (logior 1 x) 1)))
+
+(defthm logior-x-1
+  (implies (bvecp x 1)
+           (equal (logior x 1) 1)))
+
+
+(defthm logxor-m1
+    (implies (integerp x)
+	     (equal (logxor x -1)
+		    (lognot x))))
+
+(defthm logand-commutative
+    (equal (logand j i) (logand i j)))
+
+(defthm logior-commutative
+    (equal (logior j i) (logior i j)))
+
+(defthm logxor-commutative
+    (equal (logxor j i) (logxor i j)))
+
+(defthm logand-associative
+    (equal (logand (logand i j) k)
+           (logand i (logand j k))))
+
+(defthm logior-associative
+    (equal (logior (logior i j) k)
+	   (logior i (logior j k))))
+
+(defthm logxor-associative
+    (equal (logxor (logxor i j) k)
+	   (logxor i (logxor j k))))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+	 (logand i j k)))
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+	 (logior i j k)))
+
+(defthm logxor-commutative-2
+  (equal (logxor j i k)
+	 (logxor i j k)))
+
+(defthmd lognot-logxor
+    (and (equal (logxor (lognot i) j)
+                (lognot (logxor i j)))
+         (EQUAL (LOGXOR J (LOGNOT I))
+                (LOGNOT (LOGXOR I J)))))
+    
+	   
+
+(defthmd logior-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z))))
+  :hints (("Goal" :by logior-logand-g)))
+
+(defthmd logand-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand x (logior y z))
+	   (logior (logand x y) (logand x z))))
+  :hints (("Goal" :by logand-logior-g)))
+
+
+(defthmd logior-logand-2
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand  (logior y z) x)
+	   (logior (logand y x) (logand z x)))))
+
+(defthmd log3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+	   (logior (logand x y) (logand (logxor x y) z)))))
+
+(defthmd logxor-rewrite-2
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (logxor x y)
+                  (logior (logand x (lognot y))
+                          (logand y (lognot x)))))
+  :hints (("Goal" :by logxor-rewrite-2-g)))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta3/Makefile acl2-6.3/books/rtl/rel9/support/lib2.delta3/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib2.delta3/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta3/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,7 @@
+include ../../../../Makefile-generic
+
+
+# BOOKS = base simplify-model-helpers
+
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta3/base.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta3/base.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta3/base.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta3/base.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,86 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "../lib2.delta1/rtl") ;semantics of the basic RTL primitives
+
+(include-book "../lib2.delta1/rtlarr") ;semantics RTL array primitives
+
+(include-book "../lib2/basic") ;properties of basic arithmetic functions: floor, ceiling, 
+;                       exponential, and remainder;;  Wed Feb  4 16:40:37 2009
+
+;(include-book "../lib1/bits") ;bit vectors
+(include-book "../lib2.delta2/bits") ;bit vectors ;; Tue Feb 24 09:33:20 2009
+
+
+(include-book "../lib2.delta2/log") ;logical operations ;; Tue Feb 24 09:33:47 2009
+
+(include-book "../lib2.delta1/float") ;floating-point numbers
+
+(include-book "../lib2.delta1/reps") ;floating-point formats and representations
+
+(include-book "../lib2.delta1/round") ;floating-point rounding
+
+(include-book "../lib2.delta2/add") ;support for reasoning about floating-point addition
+;                      (leading one prediction and sticky bit computation)
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../arithmetic/top")
+
+(include-book "../lib2.delta1/mult")  ; integerp multiplier
+
+(include-book "../lib2.delta1/arith") ;general arithmetic package
+
+;
+; let go Thu Feb 19 09:43:32 2009
+
+(include-book "../lib2.delta1/util") ;misc helpful stuff including a few macros
+
+
+(include-book "../lib2.delta1/bvecp-raw-helpers")  
+;; ; better bvecp-raw-helpers.lisp, Fri Jun 29 10:13:32 2007
+
+(include-book "../lib2.delta1/simple-loop-helpers")  
+
+(include-book "../lib2/rom-helpers")  
+
+
+(include-book "../lib2.delta1/bvecp-helpers")
+
+(include-book "../lib2.delta1/logn")
+
+
+(include-book "../lib2.delta1/simplify-model-helpers")
+
+
+(include-book "../lib2.delta1/logn2log")
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib2.delta3/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib2.delta3/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib2.delta3/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib2.delta3/simplify-model-helpers.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,117 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib2.delta1/rtl")
+(include-book "../lib2.delta1/arith")
+(include-book "../lib2.delta2/bits")
+(local (include-book "base"))
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1)))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(defthm cat-bitn-m-equal-cat-bitn-1
+  (implies (and (syntaxp (and (quote m)
+                              (natp (cadr m))
+                              (> (cadr m) 1)))
+                (natp m)
+                (> m 1))
+           (equal (cat (bitn x i) m y n)
+                  (cat (bitn x i) 1 y n)))
+  :hints (("Goal" :in-theory (enable binary-cat))))
+
+(in-theory (enable bvecp-monotone))
+(in-theory (enable bvecp-bits-0))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/Makefile acl2-6.3/books/rtl/rel9/support/lib3/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib3/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/Makefile	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,9 @@
+include ../../../../Makefile-generic
+
+# BOOKS = base arith basic bits log logn logn2log float reps round add mult \
+#         rtl rtlarr bvecp-raw-helpers bvecp-helpers simple-loop-helpers \
+#         simplify-model-helpers util top rom-helpers clocks package-defs \
+#         openers
+ 
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/add.lisp acl2-6.3/books/rtl/rel9/support/lib3/add.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/add.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/add.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,458 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "round")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+
+
+;;;**********************************************************************
+;;;                      Bit Vector Addition
+;;;**********************************************************************
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (logand u v) 1 (logxor u v) 1)))
+  :rule-classes ())
+
+(defthm add-2
+    (implies (and (natp x) (natp y))
+	     (equal (+ x y)
+		    (+ (logxor x y)
+		       (* 2 (logand x y)))))
+  :rule-classes ())
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (logior (logand u v) (logior (logand u w) (logand v w))) 1 
+                       (logxor u (logxor v w)) 1)))
+  :rule-classes ())
+
+(defthm add-3
+    (implies (and (natp x)
+		  (natp y)
+		  (natp z))
+	     (= (+ x y z)
+		(+ (logxor x (logxor y z))
+		   (* 2 (logior (logand x y)
+				(logior (logand x z)
+					(logand y z)))))))
+  :rule-classes ())
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (logior (logand (bitn x (1- k)) (bitn y (1- k)))
+	    (logior (logand (bitn x (1- k)) (rc-carry x y (1- k)))
+		    (logand (bitn y (1- k)) (rc-carry x y (1- k)))))))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (logxor (bitn x (1- k))
+		 (logxor (bitn y (1- k)) (rc-carry x y (1- k))))
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :rule-classes ())
+
+(defun gen (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+(defun prop (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(defthmd gen-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen x y i j)
+                  (if (>= (+ (bits x i j) (bits y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j) (bits y i j))
+			(1+ (- i j))))))
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0)))))
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (logior (bitn x i) (bitn y i))))
+  :rule-classes ())
+
+(defthmd prop-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop x y i j)
+                  (if (= (+ (bits x i j) (bits y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthmd prop-as-logxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (logxor (bits x i j) (bits y i j))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthm gen-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (gen x y i j)
+		    (logior (gen x y i (1+ k))
+			    (logand (prop x y i (1+ k))
+				    (gen x y k j)))))
+  :rule-classes ())
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :rule-classes ())
+
+(defthm prop-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (prop x y i j)
+		    (logand (prop x y i (1+ k))
+			    (prop x y k j))))
+  :rule-classes ())
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp i) 
+		  (natp j)
+		  (> j 0)
+		  (>= i j))
+           (equal (bits (+ (* (expt 2 j) x) y) i j)
+                  (bits (+ (bits (* (expt 2 j) x) i j)
+                           (bits y i j))
+                        (- i j) 0)))
+    :rule-classes ())
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j))))
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j)))))
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-plus-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (bits x i j)
+			     (bits y i j)
+			     (logior (prop x y (1- j) 0) 
+				     (gen x y (1- j) 0) ))
+			  (- i j) 0)))
+  :rule-classes ())
+
+(defthmd logand-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand (bits x i j) (bits y i j)) 0))
+           (equal (gen x y i j) 0)))
+
+
+(defthm logand-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand x y) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :rule-classes ())
+
+(defthmd gen-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (logand z y) 0)
+		(= (gen x y k 0) 1))
+	   (equal (gen (+ x y) z k 0) 0)))
+
+(defthmd gen-extend-3
+    (implies (and (natp i)
+		  (natp j)
+		  (> i j)
+		  (natp x)
+		  (natp y)
+		  (bvecp z (1+ j))
+		  (= (logand y z) 0))		  
+	     (equal (gen (+ x y) z i 0)
+		    (logand (prop x y i (1+ j))
+			    (gen (+ x y) z j 0)))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm lop-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ())
+
+(defthm lop-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (bits (lognot (* 2 b)) e 0))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
+
+(defun lamt (a b e)
+  (logxor a (bits (lognot b) e 0)))
+
+(defun lamg (a b e)
+  (logand a (bits (lognot b) e 0)))
+
+(defun lamz (a b e)
+  (bits (lognot (logior a (bits (lognot b) e 0))) e 0))
+
+(defun lam1 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam2 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam3 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam4 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam0 (a b e)
+  (logior (lam1 a b e)
+	  (logior (lam2 a b e)
+		  (logior (lam3 a b e)
+			  (lam4 a b e)))))
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (bitn (lognot(lamt a b e)) 0)))
+
+(defthm lop-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lognot (logxor a b)) k 0) 0)))
+  :rule-classes ())
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (logxor (logxor a b) 
+                                       (cat (logior a b) n c 1))
+                               k 0) 
+                         0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/arith.lisp acl2-6.3/books/rtl/rel9/support/lib3/arith.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/arith.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/arith.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,858 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This file is based on the old "fp book", which was initially created by J
+; Moore and Matt Kaufmann in 1995 in support of their proof of the AMD-K5
+; division code.    Here, we have moved
+; non-local in-theory events to the end.  All events should be redundant, so we
+; have deleted all local in-theory events and added (local (in-theory nil)) to
+; the beginning.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;; (local (include-book "../arithmetic/fp"))
+;; (local (include-book "../arithmetic/fp2"))
+;; (local (include-book "../arithmetic/fl"))
+;; (local (include-book "../arithmetic/expt"))
+;; (local (include-book "../arithmetic/expo"))
+;; (local (include-book "../arithmetic/extra-rules"))
+;; (local (include-book "../support/support/ash"))
+
+(local (include-book "base"))
+
+;; these already have lib1.delta1's
+;; arith.lisp!!  deftheory??? 
+;; Why I can't do that?? 
+
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+(defthm a1 (equal (+ x (+ y z)) (+ y (+ x z))))
+(defthm a2 (equal (- x) (* -1 x)))
+
+(defthm a3
+  (and
+   (implies
+    (syntaxp (and (quotep c1) (quotep c2)))
+    (and (equal (+ (* c1 x) (* c2 x)) (* (+ c1 c2) x))
+         (equal (+ (* c1 x) (+ (* c2 x) y)) (+ (* (+ c1 c2) x) y))))
+   (implies
+    (syntaxp (quotep c2))
+    (and (equal (+ x (* c2 x)) (* (+ 1 c2) x))
+         (equal (+ x (+ (* c2 x) y1)) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (* c2 x))) (+ (* (+ 1 c2) x) y1))
+         (equal (+ x (+ y1 (+ (* c2 x) y2))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (* c2 x)))) (+ (* (+ 1 c2) x) y1 y2))
+         (equal (+ x (+ y1 (+ y2 (+ y3 (* c2 x)))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))
+         (equal (+ x (+ y1 (+ y2 (+ (* c2 x) y3))))
+                (+ (* (+ 1 c2) x) y1 y2 y3))))
+   (and (equal (+ x x) (* 2 x))
+        (equal (+ x (+ x y1)) (+ (* 2 x) y1)))))
+(defthm a4
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (+ c1 (+ c2 y1)) (+ (+ c1 c2) y1))))
+(defthm a5
+  (implies (syntaxp (and (quotep c1) (quotep c2)))
+           (equal (* c1 (* c2 y1)) (* (* c1 c2) y1))))
+
+
+
+
+
+(defthm a6
+  (equal (/ (/ x)) (fix x)))
+(defthm a7
+  (equal (/ (* x y)) (* (/ x) (/ y))))
+
+;replaced force with case-split
+(defthm a8
+  (implies (and (case-split (acl2-numberp x))
+                (case-split (not (equal x 0))))
+           (and (equal (* x (* (/ x) y)) (fix y))
+                (equal (* x (/ x)) 1))))
+
+(defthm a9
+  (and (equal (* 0 x) 0)
+       (equal (* x (* y z)) (* y (* x z)))
+       (equal (* x (+ y z)) (+ (* x y) (* x z)))
+       (equal (* (+ y z) x) (+ (* y x) (* z x)))))
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+
+(defthm a10
+  (and (implies (integerp i) (equal (fl i) i))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1)) ;can actually drop this
+                     )
+                (and (equal (fl (+ i x1)) (+ i (fl x1)))
+                     (equal (fl (+ x1 i)) (+ i (fl x1)))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2)))
+                (and (equal (fl (+ x1 (+ i x2))) (+ i (fl (+ x1 x2))))
+                     (equal (fl (+ x1 (+ x2 i))) (+ i (fl (+ x1 x2))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3)))
+                (and (equal (fl (+ x1 (+ x2 (+ i x3))))
+                            (+ i (fl (+ x1 x2 x3))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 i))))
+                            (+ i (fl (+ x1 x2 x3))))))
+       (implies (and (integerp i)
+                     (case-split (rationalp x1))
+                     (case-split (rationalp x2))
+                     (case-split (rationalp x3))
+                     (case-split (rationalp x4)))
+                (and (equal (fl (+ x1 (+ x2 (+ x3 (+ i x4)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))
+                     (equal (fl (+ x1 (+ x2 (+ x3 (+ x4 i)))))
+                            (+ i (fl (+ x1 x2 x3 x4))))))))
+
+(defthm a12
+  (implies (and (integerp i)
+                (integerp j)
+                (< 1 j)
+                (< j i))
+           (and (< (acl2-count (fl (/ i j))) (acl2-count i))
+                (< (acl2-count (fl (* (/ j) i))) (acl2-count i))))
+  :rule-classes :linear)
+
+
+;replaced force with case-split                
+;later, drop the hyp completely
+(defthm a13
+  (implies (case-split (rationalp x)) ;drop!
+           (and (< (1- x) (fl x))
+                (<= (fl x) x)))
+  :rule-classes :linear)
+
+(defthm a14
+  (and
+   (implies (and (integerp i)
+                 (<= 0 i)
+                 (<= 0 j))
+            (and (integerp (expt i j))
+                 (<= 0 (expt i j))))
+   (implies (and (rationalp i)
+                 (not (equal i 0)))
+            (not (equal (expt i j) 0))))
+  :rule-classes
+  ((:type-prescription
+    :corollary
+    (implies (and (integerp i)
+                  (<= 0 i)
+                  (<= 0 j))
+             (and (integerp (expt i j))
+                  (<= 0 (expt i j)))))
+   (:type-prescription
+    :corollary
+    (implies (and (rationalp i)
+                  (not (equal i 0)))
+             (not (equal (expt i j) 0))))))
+
+(defthm a15
+  (implies (and (rationalp i)
+                (not (equal i 0))
+                (integerp j1)
+                (integerp j2))
+           (and (equal (* (expt i j1) (expt i j2))
+                       (expt i (+ j1 j2)))
+                (equal (* (expt i j1) (* (expt i j2) x))
+                       (* (expt i (+ j1 j2)) x)))))
+(defthm a16
+  (equal (expt (* a b) i)
+         (* (expt a i) (expt b i))))
+
+(defthm /-weakly-monotonic
+  (implies (and (<= y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (<= (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+
+(defthm /-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 y)
+                (case-split (rationalp y))
+                (case-split (rationalp y+))
+                )
+           (< (/ y+) (/ y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((/ y+) (/ y))) :linear))
+         
+(defthm *-weakly-monotonic
+  (implies (and (<= y y+)
+                (<= 0 x)
+                (case-split (rationalp x)) ; This does not hold if x, y, and z are complex!
+                )
+           (<= (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (<= 0 x)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y x) (* y+ x))))))
+
+#| Here is the complex counterexample to which we alluded above.
+
+(let ((y  #c(1 -1))
+      (y+ #c(1 1))
+      (x  #c(1 1)))
+    (implies (and (<= y y+)
+                  (<= 0 x))
+             (<= (* x y) (* x y+))))
+|#
+
+(defthm *-strongly-monotonic
+  (implies (and (< y y+)
+                (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< (* x y) (* x y+)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< 0 x)
+                  (case-split (rationalp x))
+                  )
+             (< (* y x) (* y+ x))))))
+
+(defthm *-weakly-monotonic-negative-multiplier
+  (implies (and (<= y y+)
+               (< x 0)
+               (case-split (rationalp x))
+               )
+           (<= (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (<= y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (<= (* y+ x) (* y x))))))
+
+(defthm *-strongly-monotonic-negative-multiplier
+  (implies (and (< y y+)
+                (< x 0)
+                (case-split (rationalp x))
+                )
+           (< (* x y+) (* x y)))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((* x y) (* x y+)))
+   (:linear)
+   (:forward-chaining
+    :trigger-terms ((* y x) (* y+ x))
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))
+   (:linear
+    :corollary
+    (implies (and (< y y+)
+                  (< x 0)
+                  (case-split (rationalp x))
+                  )
+             (< (* y+ x) (* y x))))))
+
+(defthm fl-weakly-monotonic
+  (implies (and (<= y y+)
+                (case-split (rationalp y)) ;drop?
+                (case-split (rationalp y+)) ;drop?
+                )
+           (<= (fl y) (fl y+)))
+  :rule-classes ((:forward-chaining :trigger-terms ((fl y) (fl y+)))
+                 (:linear)
+                 (:forward-chaining
+                  :trigger-terms ((fl y) (fl y+))
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))
+                 (:linear
+                  :corollary (implies (and (< y y+)
+                                           (case-split (rationalp y))
+                                           (case-split (rationalp y+)))
+                                      (<= (fl y) (fl y+))))))
+
+(deftheory arith-fc-monotonicity
+  '((:forward-chaining /-weakly-monotonic)
+    (:forward-chaining /-strongly-monotonic)
+    (:forward-chaining *-weakly-monotonic . 1)
+    (:forward-chaining *-weakly-monotonic . 2)
+    (:forward-chaining *-strongly-monotonic . 1)
+    (:forward-chaining *-strongly-monotonic . 2)
+    (:forward-chaining *-weakly-monotonic-negative-multiplier . 1)
+    (:forward-chaining *-weakly-monotonic-negative-multiplier . 2)
+    (:forward-chaining *-strongly-monotonic-negative-multiplier . 1)
+    (:forward-chaining *-strongly-monotonic-negative-multiplier . 2)
+    (:forward-chaining fl-weakly-monotonic . 1)
+    (:forward-chaining fl-weakly-monotonic . 2)
+    ))
+
+; We now prove a bunch of bounds theorems for *.  We are concerned with bounding the
+; product of a and b given intervals for a and b.  We consider three kinds of intervals.
+; We discuss only the a case.
+
+; abs intervals mean (abs a) < amax or -amax < a < amax, where amax is positive.
+
+; nonneg-open intervals mean 0<=a<amax.
+
+; nonneg-closed intervals mean 0<=a<=amax, where amax is positive.
+
+; We now prove theorems with names like abs*nonneg-open, etc. characterizing
+; the product of two elements from two such intervals.  All of these theorems
+; are made with :rule-classes nil because I don't know how to control their
+; use.
+
+; This lemma is for lookup * d and lookup * away.  We don't need to consider 0
+; < b for the d case because we have 0 < 1 <= d and the conclusion of the new
+; lemma would be no different.
+
+(defthm abs*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+
+
+(defthm abs*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (<= a amax) ; (< a amax) is all we'll ever use, I bet.
+                (< 0 amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (< (- (* bmax amax)) (* a b))
+                (< (* a b) (* bmax amax))))
+  :rule-classes nil)
+
+; The next three, which handle nonnegative open intervals in the first argument,
+; can actually be seen as uses of the abs intervals above.  Simply observe that
+; if 0<=a<amax then -amax<a<amax.
+
+(defthm nonneg-open*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-open*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (< b bmax))
+           (and (<= 0 (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+; and the commuted version
+(defthm nonneg-closed*nonneg-open
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (< a amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* b a))
+                (< (* b a) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm nonneg-closed*nonneg-closed
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (<= 0 a)
+                (<= a amax)
+                (< 0 amax)
+                (<= 0 b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (<= 0 (* a b))
+                (<= (* a b) (* amax bmax))))
+  :rule-classes nil)
+
+(defthm abs*abs
+  (implies (and (rationalp a)
+                (rationalp amax)
+                (rationalp b)
+                (rationalp bmax)
+                (< (- amax) a)
+                (< a amax)
+                (< 0 amax)
+                (< (- bmax) b)
+                (<= b bmax)
+                (< 0 bmax))
+           (and (< (- (* amax bmax)) (* a b))
+                (< (* a b) (* amax bmax))))
+  :rule-classes nil)  
+
+(defthm rearrange-negative-coefs-<
+  (and (equal (< (* (- c) x) z)
+              (< 0 (+ (* c x) z)))
+       (equal (< (+ (* (- c) x) y) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y (* (- c) x)) z)
+              (< y (+ (* c x) z)))
+       (equal (< (+ y1 y2 (* (- c) x)) z)
+              (< (+ y1 y2) (+ (* c x) z)))
+       (equal (< (+ y1 y2 y3 (* (- c) x)) z)
+              (< (+ y1 y2 y3) (+ (* c x) z)))
+       (equal (< z (+ (* (- c) x) y))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y (* (- c) x)))
+              (< (+ (* c x) z) y))
+       (equal (< z (+ y1 y2 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2)))
+       (equal (< z (+ y1 y2 y3 (* (- c) x)))
+              (< (+ (* c x) z) (+ y1 y2 y3)))))
+
+(defthm rearrange-negative-coefs-equal
+  (and (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp z)))
+                (equal (equal (* (- c) x) z)
+                       (equal 0 (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ (* (- c) x) y) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y (* (- c) x)) z)
+                       (equal y (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 (* (- c) x)) z)
+                       (equal (+ y1 y2) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal (+ y1 y2 y3 (* (- c) x)) z)
+                       (equal (+ y1 y2 y3) (+ (* c x) z))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ (* (- c) x) y))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y (* (- c) x)))
+                       (equal (+ (* c x) z) y)))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2))))
+       (implies (and (case-split (rationalp c))
+                     (case-split (rationalp x))
+                     (case-split (rationalp y1))
+                     (case-split (rationalp y2))
+                     (case-split (rationalp y3))
+                     (case-split (rationalp z)))
+                (equal (equal z (+ y1 y2 y3 (* (- c) x)))
+                       (equal (+ (* c x) z) (+ y1 y2 y3))))))
+
+(defthm rearrange-fractional-coefs-<
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< (* (/ c) x) z)
+                   (< x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ (* (/ c) x) y) z)
+                   (< (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< (+ y (* (/ c) x)) z)
+                   (< (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< (+ y1 y2 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< (+ y1 y2 y3 (* (/ c) x)) z)
+                   (< (+ (* c y1) (* c y2) (* c y3) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (< z (* (/ c) x))
+                   (< (* c z) x)))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ (* (/ c) x) y))
+                   (< (* c z) (+ x (* c y)))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (< z (+ y (* (/ c) x)))
+                   (< (* c z) (+ (* c y) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) x))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (< z (+ y1 y2 y3 (* (/ c) x)))
+                   (< (* c z) (+ (* c y1) (* c y2) (* c y3) x))))))
+
+(defthm rearrange-fractional-coefs-equal
+  (and
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (< 0 c))
+            (equal (equal (* (/ c) x) z)
+                   (equal x (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ (* (/ c) x) y) z)
+                   (equal (+ x (* c y)) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y))
+                 (< 0 c))
+            (equal (equal (+ y (* (/ c) x)) z)
+                   (equal (+ (* c y) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) x) (* c z))))
+   (implies (and (case-split (rationalp c))
+                 (case-split (rationalp z))
+                 (case-split (rationalp x))
+                 (case-split (rationalp y1))
+                 (case-split (rationalp y2))
+                 (case-split (rationalp y3))
+                 (< 0 c))
+            (equal (equal (+ y1 y2 y3 (* (/ c) x)) z)
+                   (equal (+ (* c y1) (* c y2) (* c y3) x) (* c z))))))
+
+(defthm x*/y=1->x=y
+  (implies (and (rationalp x)
+                (rationalp y)
+                (not (equal x 0))
+                (not (equal y 0)))
+           (equal (equal (* x (/ y)) 1)
+                  (equal x y)))
+  :rule-classes nil)
+                
+(defun point-right-measure (x)
+  (floor (if (and (rationalp x) (< 0 x)) (/ x) 0) 1))
+
+(defun point-left-measure (x)
+  (floor (if (and (rationalp x) (> x 0)) x 0) 1))
+
+(include-book "ordinals/e0-ordinal" :dir :system)
+(set-well-founded-relation e0-ord-<)
+
+(defthm recursion-by-point-right
+  (and (e0-ordinalp (point-right-measure x))
+       (implies (and (rationalp x)
+                     (< 0 x)
+                     (< x 1))
+                (e0-ord-< (point-right-measure (* 2 x))
+                          (point-right-measure x)))))
+
+(defthm recursion-by-point-left
+  (and (e0-ordinalp (point-left-measure x))
+       (implies (and (rationalp x)
+                     (>= x 2))
+                (e0-ord-< (point-left-measure (* 1/2 x))
+                          (point-left-measure x)))))
+
+(defthm x<x*y<->1<y
+  (implies (and (rationalp x)
+                (< 0 x)
+                (rationalp y))
+           (equal (< x (* x y)) (< 1 y)))
+  :rule-classes nil)
+
+(defthm cancel-equal-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (not (equal a 0)))
+           (equal (equal (* a r) (* a s))
+                  (equal r s)))
+  :rule-classes nil)
+
+(defthmd expt-split
+  (implies (and (integerp i)
+                (integerp j)
+                (case-split (acl2-numberp r)) ;(integerp r)
+                (case-split (not (equal r 0)))
+                )
+           (equal (expt r (+ i j))
+                  (* (expt r i) (expt r j)))))
+
+(defthm cancel-<-*
+  (implies (and (rationalp r)
+                (rationalp s)
+                (rationalp a)
+                (< 0 a))
+           (equal (< (* a r) (* a s))
+                  (< r s)))
+  :rule-classes nil)
+
+(in-theory (disable fl
+                    inverse-of-*
+                    point-right-measure point-left-measure))
+
+
+;;;**********************************************************************
+;;;                       EXPONENTIATION
+;;;**********************************************************************
+
+(defthm expt-positive-integer-type
+    (implies (and (integerp a)
+		  (integerp i)
+		  (>= i 0))
+	     (integerp (expt a i)))
+  :rule-classes (:type-prescription))
+
+
+(defthm expt-2-positive-rational-type
+  (and (rationalp (expt 2 i))
+       (< 0 (expt 2 i)))
+  :rule-classes (:rewrite (:type-prescription :typed-term (expt 2 i))))
+
+(defthm expt-2-positive-integer-type
+  (implies (<= 0 i)
+           (and (integerp (expt 2 i))
+                (< 0 (expt 2 i))))
+  :rule-classes (:type-prescription))
+
+(defthm expt-2-type-linear
+  (implies (<= 0 i)
+           (<= 1 (expt 2 i)))
+  :rule-classes ((:linear :trigger-terms ((expt 2 i)))))
+
+(defthmd expt-weak-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (<= (expt 2 n) (expt 2 m))
+		  (<= n m))))
+
+(defthmd expt-strong-monotone
+  (implies (and (integerp n)
+                (integerp m))
+           (equal (< (expt 2 n) (expt 2 m))
+		  (< n m))))
+
+(defthmd expt-inverse
+  (equal (/ (expt 2 i))
+         (expt 2 (* -1 i))))
+
+(defthm ash-rewrite
+    (implies (integerp n)
+	     (equal (ash n i)
+		    (fl (* n (expt 2 i))))))
+
+(defthm exp+1
+    (implies (and (integerp m)
+		  (integerp n)
+		  (<= n m))
+	     (> (* (- 1 (expt 2 m)) (- 1 (expt 2 n)))
+		(- 1 (expt 2 (1+ m)))))
+  :rule-classes ())
+
+(defthm exp+2
+    (implies (and (integerp n)
+		  (integerp m)
+		  (<= n m)
+		  (<= m 0))
+	     (< (* (1+ (expt 2 m)) (1+ (expt 2 n)))
+		(1+ (expt 2 (+ m 2)))))
+  :rule-classes ())
+
+(defthm exp-invert
+    (implies (and (integerp n)
+		  (<= n -1))
+	     (<= (/ (- 1 (expt 2 n)))
+		 (1+ (expt 2 (1+ n)))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/base.lisp acl2-6.3/books/rtl/rel9/support/lib3/base.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/base.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/base.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,87 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "../lib2.delta1/rtl") ;semantics of the basic RTL primitives
+
+(include-book "../lib2.delta1/rtlarr") ;semantics RTL array primitives
+
+(include-book "../lib2/basic") ;properties of basic arithmetic functions: floor, ceiling, 
+;                       exponential, and remainder;;  Wed Feb  4 16:40:37 2009
+
+;(include-book "../lib1/bits") ;bit vectors
+(include-book "../lib2.delta2/bits") ;bit vectors ;; Tue Feb 24 09:33:20 2009
+
+
+(include-book "../lib2.delta2/log") ;logical operations ;; Tue Feb 24 09:33:47 2009
+
+(include-book "../lib2.delta1/float") ;floating-point numbers
+
+(include-book "../lib2.delta1/reps") ;floating-point formats and representations
+
+(include-book "../lib2.delta1/round") ;floating-point rounding
+
+(include-book "../lib2.delta2/add") ;support for reasoning about floating-point addition
+;                      (leading one prediction and sticky bit computation)
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../arithmetic/top")
+
+(include-book "../lib2.delta1/mult")  ; integerp multiplier
+
+(include-book "../lib2.delta1/arith") ;general arithmetic package
+
+;
+; let go Thu Feb 19 09:43:32 2009
+
+(include-book "../lib2.delta1/util") ;misc helpful stuff including a few macros
+
+
+(include-book "../lib2.delta1/bvecp-raw-helpers")  
+;; ; better bvecp-raw-helpers.lisp, Fri Jun 29 10:13:32 2007
+
+(include-book "../lib2.delta1/simple-loop-helpers")  
+
+(include-book "../lib2/rom-helpers")  
+
+
+(include-book "../lib2.delta1/bvecp-helpers")
+
+(include-book "../lib2.delta1/logn")
+
+
+(include-book "../lib2.delta3/simplify-model-helpers") ; Tue Feb  8 15:06:05
+  ; 2011. export new lemma.
+
+
+(include-book "../lib2.delta1/logn2log")
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/basic.lisp acl2-6.3/books/rtl/rel9/support/lib3/basic.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/basic.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,452 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                       FLOOR and CEILING
+;;;**********************************************************************
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defthm fl-def
+  (and (integerp (fl x))    
+       (implies (case-split (rationalp x))
+	        (and (<= (fl x) x)
+		     (< x (1+ (fl x))))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (<= (fl x) x)
+                                        (< x (1+ (fl x))))))
+                 (:type-prescription :corollary
+                                     (integerp (fl x)))))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+(defthm fl-integerp
+  (equal (equal (fl x) x)
+         (integerp x)))
+
+(defthm quot-bnd
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* y (fl (/ x y)))
+               x))
+  :rule-classes :linear)
+
+(defthm fl-monotone-linear
+    (implies (and (<= x y)
+		  (rationalp x)
+		  (rationalp y))
+	     (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (fl x) (/ n)))
+                  (fl (/ x n)))))
+
+(defthm fl/int-rewrite-alt
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (/ n) (fl x)))
+                  (fl (/ x n)))))
+
+(defthmd fl-minus
+  (implies (rationalp x)
+           (equal (fl (* -1 x))
+                  (if (integerp x)
+                      (* -1 x)
+                    (1- (* -1 (fl x)))))))
+
+(defthm fl-m-n
+  (implies (and (< 0 n)
+                (integerp m)
+                (integerp n))
+           (= (fl (- (/ m n)))
+              (1- (- (fl (/ (1- m) n))))))
+  :rule-classes ())
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defthm cg-def
+  (and (integerp (cg x))
+       (implies (case-split (rationalp x))
+                (and (>= (cg x) x)
+                     (> (1+ x) (cg x)))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (>= (cg x) x)
+                                        (> (1+ x) (cg x)))))
+                 (:type-prescription :corollary
+                                     (integerp (cg x)))))
+
+(defthm cg-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (>= n x)
+		  (> (1+ x) n))
+	     (equal (cg x) n))
+  :rule-classes ())
+
+(defthm cg-integerp
+    (implies (rationalp x)
+	     (equal (equal (cg x) x)
+                    (integerp x))))
+
+(defthm cg-monotone-linear
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= x y))
+	     (<= (cg x) (cg y)))
+  :rule-classes :linear)
+
+(defthm n>=cg-linear
+    (implies (and (>= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (>= n (cg x)))
+  :rule-classes :linear)
+
+(defthm cg+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (cg (+ x n)) (+ (cg x) n))))
+
+(defthm cg/int-rewrite
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (cg x) (/ n)))
+                  (cg (/ x n)))))
+
+(defthm cg/int-rewrite-alt
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (/ n) (cg x)))
+                  (cg (/ x n)))))
+
+(defthm fl-cg
+  (implies (rationalp x)
+           (equal (cg x)
+                  (if (integerp x)
+                      (fl x)
+                    (1+ (fl x)))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                         MOD
+;;;**********************************************************************
+(in-theory (disable mod))
+
+(defthm mod-def
+  (implies (case-split (acl2-numberp x))
+           (equal (mod x y)
+                  (- x (* y (fl (/ x y))))))
+  :rule-classes ())
+
+(defthm mod-0
+    (and (equal (mod 0 y)
+                0)
+         (equal (mod x 0)
+                (fix x))))
+
+(defthm rationalp-mod
+  (implies (rationalp x)
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm integerp-mod
+  (implies (and (integerp m) (integerp n))
+           (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription))
+
+
+(defthm natp-mod
+   (implies (and (natp m)
+                 (natp n))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm natp-mod-2
+   (implies (and (integerp m)
+                 (integerp n)
+                 (> n 0))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm mod-bnd-1
+  (implies (and (case-split (< 0 n))
+                (case-split (not (complex-rationalp m)))
+                (case-split (not (complex-rationalp n))))
+           (< (mod m n) n))
+  :rule-classes :linear)
+
+(defthm mod-by-1
+  (implies (integerp m)
+           (equal (mod m 1)
+                  0)))
+
+(defthm mod-bnd-2
+  (implies (and (<= 0 m)
+                (case-split (rationalp m)))
+           (<= (mod m n) m))
+  :rule-classes :linear)
+
+(defthm mod-does-nothing
+  (implies (and (< m n)
+                (<= 0 m)
+                (case-split (rationalp m)))
+           (equal (mod m n)
+                  m)))
+
+(defthm mod-0-fl
+  (implies (acl2-numberp m)
+           (iff (= (mod m n) 0)
+	        (= m (* (fl (/ m n)) n))))
+  :rule-classes ())
+
+(defthm mod-0-int
+  (implies (and (integerp m)
+                (integerp n)
+                (not (= n 0)))
+           (iff (= (mod m n) 0)
+                (integerp (/ m n))))
+  :rule-classes ())
+
+(defthm mod-mult-n
+  (equal (mod (* a n) n)
+         (* n (mod a 1))))
+
+(defthm mod-mult-n-commuted
+  (equal (mod (* n a) n)
+         (* n (mod a 1))))
+
+(defthm mod-squeeze
+    (implies (and (= (mod m n) 0)
+		  (< m (* (1+ a) n))
+                  (< (* (1- a) n) m)
+                  (integerp a)
+		  (integerp m)
+		  (integerp n))
+	     (= m (* a n)))
+  :rule-classes ())
+
+(defthm mod-must-be-n
+    (implies (and (= (mod m n) 0)
+		  (< m (* 2 n))
+                  (< 0 m)
+		  (rationalp m)
+		  (rationalp n))
+	     (= m n))
+  :rule-classes ())
+
+(defthm mod-0-0
+  (implies (and (integerp p)
+                (rationalp m)
+                (rationalp n))
+           (iff (= (mod m (* n p)) 0)
+                (and (= (mod m n) 0)
+                     (= (mod (fl (/ m n)) p) 0))))
+  :rule-classes ())
+
+(defthm mod-equal-int
+  (implies (and (= (mod a n) (mod b n))
+                (rationalp a)
+                (rationalp b))
+           (integerp (/ (- a b) n)))
+  :rule-classes ())
+
+(defthm mod-equal-int-reverse
+  (implies (and (integerp (/ (- a b) n))
+                (rationalp a)
+                (rationalp b)
+                (rationalp n)
+                (< 0 n))
+           (= (mod a n) (mod b n)))
+  :rule-classes ())
+
+(defthm mod-force-equal
+  (implies (and (< (abs (- a b)) n)
+                (rationalp a)
+                (rationalp b)
+                (integerp n))
+          (iff (= (mod a n) (mod b n))
+               (= a b)))
+  :rule-classes ())
+
+(defthm mod-mult
+    (implies (and (integerp a)
+                  (rationalp m)
+		  (rationalp n))
+	     (equal (mod (+ m (* a n)) n)
+		    (mod m n))))
+
+(defthm mod-force
+  (implies (and (<= (* a n) m)
+                (< m (* (1+ a) n))
+                (integerp a)
+                (rationalp m)
+                (rationalp n))
+           (= (mod m n) (- m (* a n))))
+  :rule-classes ())
+
+(defthm mod-bnd-3
+  (implies (and (< m (+ (* a n) r))
+                (<= (* a n) m)
+                (integerp a)
+                (case-split (rationalp m))
+                (case-split (rationalp n)))
+           (< (mod m n) r))
+  :rule-classes :linear)
+
+(defthmd mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ a (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthmd mod-mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ (mod a n) (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthm mod-diff
+  (implies (and (case-split (rationalp a))
+                (case-split (rationalp b)))
+           (equal (mod (- a (mod b n)) n)
+                  (mod (- a b) n))))
+
+(defthm mod-of-mod
+  (implies (and (case-split (natp k))
+                (case-split (natp n)))
+           (equal (mod (mod x (* k n)) n)
+                  (mod x n))))
+
+(defthm mod-of-mod-cor
+  (implies (and (<= b a)
+                (case-split (integerp b))
+                (case-split (integerp a)))
+           (equal (mod (mod x (expt 2 a)) (expt 2 b))
+                  (mod x (expt 2 b)))))
+
+(defthm mod-prod
+  (implies (and (rationalp m)
+                (rationalp n)
+                (rationalp k))
+           (equal (mod (* k m) (* k n))
+                  (* k (mod m n)))))
+
+(defthm mod012
+  (implies (integerp m)
+           (or (equal (mod m 2) 0)
+               (equal (mod m 2) 1)))
+  :rule-classes ())
+
+(defthm mod-plus-mod-2
+  (implies (and (integerp a)
+                (integerp b))
+           (iff (= (mod (+ a b) 2) (mod a 2))
+                (= (mod b 2) 0)))
+  :rule-classes ())
+
+(defthm mod-mod-2-not-equal
+  (implies (acl2-numberp m)
+           (not (= (mod m 2) (mod (1+ m) 2))))
+  :rule-classes ())
+
+(defthm mod-2*m+1-rewrite
+  (implies (integerp m)
+           (equal (mod (1+ (* 2 m)) 2) 1)))
+
+;; Mon Mar  5 13:50:08 2007
+
+(defthm mod-mod-times
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (> n 0))
+	     (= (mod (* (mod a n) b) n)
+		(mod (* a b) n)))
+  :rule-classes ())
+
+
+(defthm mod-times-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (* a c) n) (mod (* b c) n)))
+  :rule-classes ())
+
+
+(defthm mod-plus-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (+ a c) n) (mod (+ b c) n)))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/bits.lisp acl2-6.3/books/rtl/rel9/support/lib3/bits.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/bits.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,972 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "basic")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+(defthm bits-bounds
+    (implies (and (integerp i)
+		  (integerp j))
+	     (and (natp (bits x i j))
+		  (< (bits x i j) (expt 2 (1+ (- i j))))))
+  :rule-classes())
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0))))
+
+
+;;;; ?? (- x (bits y i 0)) may not be the normal form. 
+(defthmd bits-bits-diff
+  (implies (and (integerp x)
+                (integerp y)
+                (natp i))
+	   (equal (bits (- x (bits y i 0)) i 0)
+		  (bits (- x y) i 0))))
+
+(defthmd bits-bits-times
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i))
+	     (equal (bits (* (bits x i 0) y) i 0)
+		    (bits (* x y) i 0))))
+
+(defthm bits-diff-equal
+    (implies (and (natp n)
+		  (integerp x)
+		  (integerp y)
+		  (< (abs (- x y)) (expt 2 n)))
+	     (iff (= x y)
+		  (= (bits (- x y) (1- n) 0) 0)))
+  :rule-classes ())
+
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i))))))))
+
+(defthm bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+
+(defthmd neg-bits-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j)))))))
+
+(defthmd bits-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (+ -1 (expt 2 (+ 1 i (* -1 j)))))))
+
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-tail-2
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+;;
+
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :rule-classes ())
+
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ())
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthm bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+;;See also bits-dont-match.
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+;;See also bits-match.
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1)))
+
+
+(defthmd bitn-shift
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthmd bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m)))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+; The lemmas sumbits-badguy-is-correct and sumbits-badguy-bounds, below, let
+; one prove equality of two bit vectors of width k by proving each of these has
+; the same value at bit i, for arbitrary i from 0 to k-1.
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t)))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0)))
+
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0)))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;;Definition of the macro, cat:
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
+
+;;;;;
+
+
+(defun sgndintval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm sgndintval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (sgndintval w (bits x (1- w) 0))
+                x))
+    :rule-classes nil)
+
+
+
+(defun signextend (n m x)
+  (bits (SgndIntVal m x) (1- n) 0))
+
+(defthmd sgndintval-signextend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (sgndintval n (signextend n m x))
+		    (sgndintval m x))))
+
+
+;;;;;
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/bvecp-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3/bvecp-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/bvecp-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/bvecp-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,63 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(local (include-book "base"))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (integerp (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/bvecp-raw-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3/bvecp-raw-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/bvecp-raw-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/bvecp-raw-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,801 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;Contains bvecp lemmas about the RTL primitives.
+;Also contains type lemmas (non-negative integer, natp, etc.)
+
+(include-book "rtl")
+(include-book "rtlarr")
+
+(include-book "bits")
+(include-book "float")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") 
+(local (in-theory nil))
+
+(set-match-free-default :all)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;; bits
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+   (implies (and (<= (+ 1 i (- j)) k)
+                 (case-split (integerp k))
+                 )
+            (bvecp (bits x i j) k)))
+
+
+;; setbits
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k)))
+
+
+;; setbitn
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k)))
+
+
+
+;; log<
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+
+;; log<=
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+
+
+;; log>
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+
+
+;; log>=
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+
+
+;; log=
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+
+
+;; log<>
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+
+
+;; logand1
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+
+
+;; logior1
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+
+
+;; logxor1
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+
+
+;; lnot
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+;; bitn
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes ( :type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+;; shft
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k)))
+
+;; cat
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+
+;; logand
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n)))
+
+
+;; logior
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+
+;; mulcat
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n)))
+|#
+
+;; encode
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k)))
+           (bvecp (encode x n) k)))
+
+
+;; decode
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+;BOZO dup?
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+
+; land
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+;; lior
+
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+;; lxor
+
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+;; cat
+
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x)))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x)))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
+
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
+
+;remove these?
+
+
+;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
+;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
+;;;;;;;;;;;;;;;;;;; statements have no default.
+
+;maybe leave this one?
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t)))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t)))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t)))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t)))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t)))
+|#
+
+#|
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+|#
+
+#|
+;drop?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j))
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/clocks.lisp acl2-6.3/books/rtl/rel9/support/lib3/clocks.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/clocks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/clocks.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,199 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Most or all of this was originally written by Eric Smith while an intern at AMD.
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../../support/support/clocks")
+
+; The analysis of clocks uses some new functions.
+; 
+; First, even and odd are not the same as evenp and oddp.  For one thing, even
+; and odd are defined recursively, and I've proved a bunch of nice rules about
+; them which we probably want to use and which may not be proved about evenp and
+; oddp (and which may be nicer than what is proveable about evenp and oddp).  One
+; nice property of even and odd is that each implies integerp.  (By contrast,
+; evenp returns t for non-numbers like nil or '(a b).)  So rules which would
+; naturally have both the hyp (integerp n) and the hyp (evenp n) now can just
+; have (even n).
+; 
+; Second, I also define a function, MOD4. I didn't want to use MOD itself in the
+; clocking logic because reasoning about clocks needs to be fast and predictable.
+; (I can imagine that we'll have rules about MOD, especially when doing FP
+; proofs, which will just get in the way of our reasoning about clocks. We might
+; even open up MOD on occasion.)  So, in order to get complete control over the
+; rules which fire when we reason about clocks, I introduced MOD4, which we
+; expect never to have to open after proving a nice set of rules about it.
+; 
+; Also, theorems about MOD4 may be nicer than their analogs for MOD.  For
+; example, MOD4 is always equal to 0, 1, 2, or 3, but (mod #c(0 1) 4) = #c(0 1),
+; which isn't even rational.
+
+(defund pedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 0)
+       (equal y 1)))
+
+(defund nedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 1)
+       (equal y 0)))
+
+(defmacro posedge (clk)
+  `(and (not (zp n))
+        (pedge (,clk (1- n)) (,clk n))))
+
+(defmacro negedge (clk)
+  `(and (not (zp n))
+        (nedge (,clk (1- n)) (,clk n))))
+
+(defthm pedge-known-false-1
+  (not (pedge x 0)))
+
+(defthm pedge-known-false-2
+  (not (pedge 1 y)))
+
+(defthm nedge-known-false-1
+  (not (nedge x 1)))
+
+(defthm nedge-known-false-2
+  (not (nedge 0 y)))
+
+
+; The call (defperiodic NAME TYPE) creates 1) a defun which defines NAME to be
+; a periodic signal of the specified TYPE and 2) a bvecp lemma for that defun
+; (all periodics have width 1).
+
+; We intend the user to smash certain periodic inputs to his top level module
+; and replace their translations with calls to defperiodic.
+
+; Currently we support the following types of periodic signals:
+
+#|
+
+'fast-clock : 
+
+ _   _   _   _   _   _   _
+| |_| |_| |_| |_| |_| |_| |_|
+
+
+'slow-clock-one-quantum-wide
+
+ _       _       _       _
+| |_____| |_____| |_____| |__
+
+
+'slow-clock-one-quantum-wide-shifted :
+
+     _       _       _       _
+____| |_____| |_____| |_____| |__
+
+
+'slow-clock-two-quanta-wide :
+
+ ___     ___     ___     ___     
+|   |___|   |___|   |___|   |___|
+
+
+'slow-clock-two-quanta-wide-shifted :
+
+     ___     ___     ___     
+|___|   |___|   |___|   |___|
+
+'always-1 :
+
+  ___________________________
+..
+
+
+|#
+
+; As the need arises, we can easily change defperiodic to add support for more
+; types of signal.
+
+; BTW, currently, the definitions generated by defperiodic return unknown
+; values (calls to reset) at time 0 (and whenever N is not a natp).  Perhaps
+; this is too conservative, and perhaps defining the value at time 0 would
+; allow nicer rewrite rules to be proved.
+
+(defconst *defperiodic-types*
+
+; Keep this in sync with the corresponding definition in the compiler.
+
+  '(fast-clock
+    slow-clock-one-quantum-wide
+    slow-clock-one-quantum-wide-shifted
+    slow-clock-two-quanta-wide
+    slow-clock-two-quanta-wide-shifted
+    always-1))
+
+(defmacro defperiodic (name type)
+  (declare (xargs :guard (member-eq type *defperiodic-types*)))
+  (list*
+   'encapsulate
+   nil
+   (case type
+     (fast-clock
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (even n) 1 0))))
+     (slow-clock-one-quantum-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 0 (mod4 n)) 1 0))))
+     (slow-clock-one-quantum-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 2 (mod4 n)) 1 0))))
+     (slow-clock-two-quanta-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 0 (mod4 n))
+                   (equal 1 (mod4 n)))
+               1
+             0))))
+     (slow-clock-two-quanta-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 2 (mod4 n))
+                   (equal 3 (mod4 n)))
+               1
+             0))))
+     (always-1
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           1)))
+     (otherwise (er hard 'defperiodic
+                    "Bad type, ~x0, for defperiodic."
+                    type)))
+   `((defbvecp ,name (n) 1 :hints (("Goal" :in-theory (enable ,name)))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/float.lisp acl2-6.3/books/rtl/rel9/support/lib3/float.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/float.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,904 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "log")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exact-neg
+    (equal (exactp x n) (exactp (abs x) n))
+  :rule-classes ())
+
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+
+
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-1)))
+
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-2)))
+
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-3)))
+
+
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use exact-k+1_alt)))
+
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :rule-classes ())
+
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
+
+;;;***************************************************************
+;;;                 Floating-Point formats
+;;;***************************************************************
+
+
+(defund esgnf  (x p q) (bitn x (+ p q)))
+
+
+
+
+(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
+
+
+
+
+
+
+(defund esigf  (x p)   (bits x (1- p) 0))
+
+
+
+
+
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+
+
+
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+
+
+
+
+
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+
+
+
+
+
+
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+
+
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+
+
+
+
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+
+
+
+(defthmd sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use sgn-ndecode_alt)))
+
+
+(defthmd expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q))))
+    :hints (("Goal" :use expo-ndecode_alt)))
+
+
+(defthmd sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1))))))
+    :hints (("Goal" :use sig-ndecode_alt)))
+
+
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+
+
+
+(defthm bvecp-nencode
+  (implies (and (equal k (+ p q))
+                (natp p)
+                (natp q))
+           (bvecp (nencode x p q) k))
+   :hints (("Goal" :use bvecp-nencode_alt)))
+
+(defthmd nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q))
+   :hints (("Goal" :use nrepp-ndecode_alt)))
+    
+
+
+(defthmd nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x))
+   :hints (("Goal" :use nencode_alt-ndecode_alt)))
+
+
+(defthmd nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q))
+   :hints (("Goal" :use nencodingp_alt-nencode_alt)))
+
+
+(defthmd ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x))
+   :hints (("Goal" :use ndecode_alt-nencode_alt)))
+
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+
+
+
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+
+
+
+(defthmd sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1)))
+    :hints (("Goal" :use sgn-ddecode_alt)))
+
+
+
+(defthmd expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))
+    :hints (("Goal" :use expo-ddecode_alt)))
+
+
+(defthmd sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p))))
+    :hints (("Goal" :use sig-ddecode_alt)))
+
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(r))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+
+
+(defthmd drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q))
+    :hints (("Goal" :use drepp-ddecode_alt)))
+
+
+(defthmd dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x))
+    :hints (("Goal" :use dencode_alt-ddecode_alt)))
+
+
+(defthmd dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q))
+    :hints (("Goal" :use dencodingp_alt-dencode_alt)))
+
+
+(defthmd ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x))
+    :hints (("Goal" :use ddecode_alt-dencode_alt)))
+
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q))))
+
+
+;; (defthmd spd-mult
+;;   (implies (and (integerp p)
+;;                 (> p 1)
+;;                 (integerp q)
+;;                 (> q 0)
+;; 		(rationalp r)
+;; 		(= m (/ r (spd p q))))
+;; 	   (iff (drepp r p q)
+;; 		(and (natp m)
+;; 		     (<= 1 m)
+;; 		     (< m (expt 2 (1- p)))))))
+;; not true!! 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/log.lisp acl2-6.3/books/rtl/rel9/support/lib3/log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/log.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,552 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; (set-enforce-redundancy t) ;; Tue Feb 24 10:12:19 2009. 
+
+; somehow the logand-natp rule complains about not being redundant! 
+;
+
+(include-book "basic") ;; no change from rel8 
+
+(include-book "bits")
+
+(local (include-book "base"))
+
+
+;(set-inhibit-warnings "theory") ; avoid warning in the next event
+;(local (in-theory nil))
+
+;;;**********************************************************************
+;;;                       LOGNOT, LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+(in-theory (disable lognot logand logior logxor))
+
+(defthmd lognot-def
+    (implies (integerp x)
+	     (equal (lognot x)
+		    (1- (- x)))))
+
+(defthmd logand-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logand i j)
+		    (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logand (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+
+(defthmd logior-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logior i j)
+		    (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+
+
+(defthmd logxor-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logxor i j)
+		    (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+
+(defthm logand-natp
+    (implies (and (natp i)
+		  (integerp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logand-natp-2
+    (implies (and (integerp i)
+		  (natp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logand-bvecp
+    (implies (and (natp n)
+		  (bvecp x n)
+		  (integerp y))
+	     (bvecp (logand x y) n))
+    :hints (("Goal" :by logand-bvecp-g)))
+
+(defthm logior-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logior i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logior-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n))
+	     (bvecp (logior x y) n)))
+
+(defthm logxor-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logxor i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n))
+	     (bvecp (logxor x y) n)))
+
+;;;;;;
+
+
+(defun logop-2-induct-g (x y)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)))))
+  (if (and (integerp x) (integerp y))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1)))
+          t
+        (logop-2-induct-g (fl (/ x 2)) (fl (/ y 2))))
+    t))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+
+(defun logop-3-induct-g (x y z)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)) (nfix (abs z)))))
+  (if (and (integerp x) (integerp y) (integerp z))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1))
+               (or (equal z 0)
+                   (equal z -1)))
+	  t
+	(logop-3-induct-g (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+
+
+(defthmd logand-fl-2-rewrite
+    (implies (and (natp x)
+		  (natp y))
+	     (equal (fl (* 1/2 (logand x y)))
+		    (logand (fl (* 1/2 x)) (fl (* 1/2 y))))))
+
+(defthmd logior-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logior i j)))
+		    (logior (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthmd logxor-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logxor i j)))
+		    (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+
+(defthm logior-not-0
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (logior x y) 0))
+	     (and (= x 0) (= y 0)))
+  :rule-classes ())
+
+(defthm logior-expt
+    (implies (and (natp n)
+		  (integerp x)
+		  (bvecp y n))
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-g)))
+
+(defthm logior-expt-2
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logior (* (expt 2 n) x)
+			(* (expt 2 n) y))
+		(* (expt 2 n) (logior x y))))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-2-g)))
+
+
+(defthm logand-bnd
+    (implies (<= 0 x)
+	     (<= (logand x y) x))
+  :rule-classes :linear)
+
+(defthm logand-expt
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logand (* (expt 2 n) x) y)
+		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+  :rule-classes ()
+  :hints (("Goal" :by logand-expt-g)))
+
+
+(defthmd bitn-lognot
+    (implies (and (integerp x)
+		  (integerp n)
+		  (> n 0))
+	     (not (equal (bitn (lognot x) n)
+			 (bitn x n))))
+    :hints (("Goal" :use bitn_alt-lognot)))
+
+(defthmd bits-lognot
+    (implies (and (natp i)
+		  (natp j)
+		  (<= j i)
+		  (integerp x))
+	     (equal (bits (lognot x) i j)
+		    (- (1- (expt 2 (- (1+ i) j))) (bits x i j)))))
+
+
+
+(defthmd bitn-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logand x y) n)
+		    (logand (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logand)))
+
+
+(defthmd bits-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logand x y) i j)
+		    (logand (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logand)))
+
+
+
+(defthmd bitn-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logior x y) n)
+		    (logior (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logior)))
+
+
+(defthmd bits-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logior x y) i j)
+		    (logior (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logior)))
+
+
+(defthmd bitn-logxor
+    (implies (and (case-split (integerp x))
+		  (case-split (integerp y))
+		  (case-split (integerp n)))
+	     (equal (bitn (logxor x y) n)
+		    (logxor (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logxor)))
+
+(defthmd bits-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (bits (logxor x y) i j)
+                  (logxor (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logxor)))
+
+(defthmd logand-expt-2
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logand x (expt 2 k))
+		    (* (expt 2 k) (bitn x k))))
+    :hints (("Goal" :use logand-expt-2-g)))
+
+(defthmd logior-expt-3
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logior x (expt 2 k))
+		    (+ x
+		       (* (expt 2 k) 
+			  (- 1 (bitn x k))))))
+    :hints (("Goal" :use ((:instance logior-expt-3-g)))))
+
+(defthmd logand-expt-3
+    (implies (and (integerp x)
+		  (natp n)
+		  (natp k)
+		  (< k n))
+	     (equal (logand x (- (expt 2 n) (expt 2 k)))
+		    (* (expt 2 k) (bits x (1- n) k))))
+    :hints (("Goal" :use ((:instance logand-expt-3-g)))))
+
+(defthmd logand-expt-4
+    (implies (and (natp n)
+		  (natp k)
+		  (natp l)
+		  (< l k)
+		  (<= k n))
+	     (equal (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+		    (- (expt 2 n) (expt 2 k))))
+    :hints (("Goal" :use ((:instance logand-expt-4-g)))))
+
+(defthmd lognot-shift
+  (implies (and (integerp x)
+                (natp k))
+           (equal (lognot (* (expt 2 k) x))
+		  (+ (* (expt 2 k) (lognot x))
+		     (1- (expt 2 k))))))
+
+(defthmd logand-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logand (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logand x y)))))
+
+(defthmd logxor-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logxor (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logxor x y)))))
+
+(defthmd logior-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logior (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logior x y)))))
+
+(defthmd fl-lognot
+    (implies (case-split (integerp i))
+	     (= (fl (* 1/2 (lognot i)))
+                (lognot (fl (* 1/2 i))))))
+
+(defthmd fl-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logand x y) (expt 2 k)))
+                  (logand (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logior x y) (expt 2 k)))
+                  (logior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logxor
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logxor x y) (expt 2 k)))
+                  (logxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lognot-lognot
+    (implies (case-split (integerp i))
+	     (equal (lognot (lognot i))
+		    i)))
+
+(defthm logand-x-0
+    (equal (logand x 0) 0))
+
+(defthm logand-0-y
+    (equal (logand 0 y) 0))
+
+(defthm logior-x-0
+    (implies (integerp x)
+	     (equal (logior x 0) x)))
+
+(defthm logior-0-y
+    (implies (integerp y)
+	     (equal (logior 0 y) y)))
+
+(defthm logxor-x-0
+    (implies (integerp x)
+	     (equal (logxor x 0) x)))
+
+(defthm logxor-0-y
+    (implies (integerp y)
+	     (equal (logxor 0 y) y)))
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logior-self
+    (implies (case-split (integerp i))
+	     (equal (logior i i) i)))
+
+(defthm logxor-self
+  (equal (logxor i i) 0))
+
+(defthm logand-x-m1
+    (implies (integerp x)
+	     (equal (logand x -1) x)))
+
+(defthm logand-m1-y
+    (implies (integerp y)
+	     (equal (logand -1 y) y)))
+
+(defthm logand-x-1
+    (implies (bvecp x 1)
+	     (equal (logand x 1) x)))
+
+(defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x)))
+
+(defthm logior-x-m1
+    (implies (integerp x)
+	     (equal (logior x -1) -1)))
+
+(defthm logior-m1-y
+    (implies (integerp y)
+	     (equal (logior -1 y) -1)))
+
+(defthm logior-1-x
+  (implies (bvecp x 1)
+           (equal (logior 1 x) 1)))
+
+(defthm logior-x-1
+  (implies (bvecp x 1)
+           (equal (logior x 1) 1)))
+
+
+(defthm logxor-m1
+    (implies (integerp x)
+	     (equal (logxor x -1)
+		    (lognot x))))
+
+(defthm logand-commutative
+    (equal (logand j i) (logand i j)))
+
+(defthm logior-commutative
+    (equal (logior j i) (logior i j)))
+
+(defthm logxor-commutative
+    (equal (logxor j i) (logxor i j)))
+
+(defthm logand-associative
+    (equal (logand (logand i j) k)
+           (logand i (logand j k))))
+
+(defthm logior-associative
+    (equal (logior (logior i j) k)
+	   (logior i (logior j k))))
+
+(defthm logxor-associative
+    (equal (logxor (logxor i j) k)
+	   (logxor i (logxor j k))))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+	 (logand i j k)))
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+	 (logior i j k)))
+
+(defthm logxor-commutative-2
+  (equal (logxor j i k)
+	 (logxor i j k)))
+
+(defthmd lognot-logxor
+    (and (equal (logxor (lognot i) j)
+                (lognot (logxor i j)))
+         (EQUAL (LOGXOR J (LOGNOT I))
+                (LOGNOT (LOGXOR I J)))))
+    
+	   
+
+(defthmd logior-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z))))
+  :hints (("Goal" :by logior-logand-g)))
+
+(defthmd logand-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand x (logior y z))
+	   (logior (logand x y) (logand x z))))
+  :hints (("Goal" :by logand-logior-g)))
+
+
+(defthmd logior-logand-2
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand  (logior y z) x)
+	   (logior (logand y x) (logand z x)))))
+
+(defthmd log3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+	   (logior (logand x y) (logand (logxor x y) z)))))
+
+(defthmd logxor-rewrite-2
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (logxor x y)
+                  (logior (logand x (lognot y))
+                          (logand y (lognot x)))))
+  :hints (("Goal" :by logxor-rewrite-2-g)))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/logn.lisp acl2-6.3/books/rtl/rel9/support/lib3/logn.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/logn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/logn.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,854 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "bits")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                     LNOT
+;;;**********************************************************************
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthmd lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot x n) k)))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n))))))
+
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n)))))))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n))))
+
+(defthm mod-lnot
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot x n) (expt 2 k))
+                  (lnot (mod x (expt 2 k)) k))))
+
+(defthmd bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j))))))
+
+(defthmd bitn-lnot
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn (lnot x n) k)
+		  (if (< k n)
+		      (lnot (bitn x k) 1)
+		    0))))
+
+(defthmd lnot-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot (cat x m y n) l)
+		  (cat (lnot x m) m (lnot y n) n))))
+
+
+;;;**********************************************************************
+;;;                LAND, LIOR, and LXOR
+;;;**********************************************************************
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land)))
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior)))
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor)))
+
+(defun lognop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun lognop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun lognop-3-induct (x y z)
+  (declare (xargs :measure (:? x y z)))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defthm land-x-y-0
+    (equal (land x y 0) 0))
+
+(defthm lior-x-y-0
+    (equal (lior x y 0) 0))
+
+(defthm lxor-x-y-0
+    (equal (lxor x y 0) 0))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0) y n)
+         (land x y n)))
+
+(defthmd land-bits-2
+  (equal (land x (bits y (1- n) 0) n)
+         (land x y n)))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0) y n)
+         (lior x y n)))
+
+(defthmd lior-bits-2
+  (equal (lior x (bits y (1- n) 0) n)
+         (lior x y n)))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0) y n)
+         (lxor x y n)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x (bits y (1- n) 0) n)
+         (lxor x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land x y n) k)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior x y n) k)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor x y n) k)))
+
+(defthm land-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land x y n) m)))
+
+(defthm lior-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior x y n) m)))
+
+(defthm lxor-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor x y n) m)))
+
+(defthmd land-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land x y m) (land x y n))))
+
+(defthmd lior-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior x y m) (lior x y n))))
+
+(defthmd lxor-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor x y m) (lxor x y n))))
+
+(defthmd land-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lior-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lxor-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (bitn x 0) (bitn y 0) 1)))))
+
+(defthm land-0
+  (equal (land 0 y n)
+	 0))
+
+(defthmd land-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land i j 1))
+		  (or (equal i 0)
+		      (equal j 0)))))
+
+(defthm lior-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior 0 y n) y)))
+
+(defthmd lior-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior x y n))
+		  (and (equal x 0)
+		       (equal y 0)))))
+
+(defthm lxor-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor 0 y n) y)))
+
+(defthm land-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land x y (- n k)))))
+  :rule-classes ())
+
+(defthm lxor-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor x y (- n k)))))
+  :rule-classes ())
+
+(defthm lior-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior x y (- n k)))))
+  :rule-classes ())
+
+(defthmd fl-land
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
+                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lior
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
+                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lxor
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
+                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd mod-land
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land x y n) (expt 2 k))
+                  (land x y k))))
+
+(defthmd mod-lior
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior x y n) (expt 2 k))
+                  (lior x y k))))
+
+(defthmd mod-lxor
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor x y n) (expt 2 k))
+                  (lxor x y k))))
+
+(defthm bits-land
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (land x y n) i j)
+		  (land (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lior
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lior x y n) i j)
+		  (lior (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lxor
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lxor x y n) i j)
+		  (lxor (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bitn-land
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (land x y n) k)
+		  (if (< k n)
+		      (land (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lior
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lior x y n) k)
+		  (if (< k n)
+		      (lior (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lxor
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lxor x y n) k)
+		  (if (< k n)
+		      (lxor (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthmd land-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (land x1 x2 m) m (land y1 y2 n) n))))
+
+(defthm land-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land c (cat x2 m y2 n) l)
+		  (cat (land (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (land (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lior-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lior x1 x2 m) m (lior y1 y2 n) n))))
+
+(defthm lior-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior c (cat x2 m y2 n) l)
+		  (cat (lior (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lior (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lxor-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n))))
+
+(defthm lxor-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor c (cat x2 m y2 n) l)
+		  (cat (lxor (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthm land-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land x y n) x))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior x y n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm lxor-bnd
+  (<= (lxor x y n) (lior x y n))
+  :rule-classes (:rewrite :linear))
+
+(defthmd lior-plus
+  (implies (= (land x y n) 0)
+           (equal (lior x y n)
+                  (+ (bits x (1- n) 0)
+                     (bits y (1- n) 0)))))
+
+(defthmd land-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m)))))))
+
+(defthm lior-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ())
+
+(defthmd land-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land x (expt 2 k) n)
+		  (* (expt 2 k) (bitn x k)))))
+
+(defthm lior-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior x (expt 2 k) n)
+		(+ (bits x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ())
+
+(defthmd lxor-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor x (expt 2 k) n)
+		  (+ (bits x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn x k))))))))
+
+(defthm land-ones
+  (equal (land (1- (expt 2 n)) x n)
+	 (bits x (1- n) 0))
+  :rule-classes nil)
+
+(defthm land-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land k x n)
+		  (bits x (1- n) 0))))
+
+(defthm lior-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ())
+
+(defthm lior-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior k x n)
+		  (1- (expt 2 n)))))
+
+(defthm lxor-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor (1- (expt 2 n)) x n)
+		  (lnot x n)))
+  :rule-classes ())
+
+(defthm lxor-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor k x n)
+		  (lnot x n))))
+
+(defthm land-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ())
+
+(defthmd lior-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j))))
+
+(defthmd lxor-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i) (- n i)
+                       (lnot (bits x (1- i) j) (- i j)) (- i j)
+                       (bits x (1- j) 0) j))))
+
+(defthmd land-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot (lnot x n) n)
+		  x)))
+
+(defthm land-commutative
+  (equal (land y x n)
+	 (land x y n)))
+
+(defthm lior-commutative
+  (equal (lior y x n)
+	 (lior x y n)))
+
+(defthm lxor-commutative
+  (equal (lxor y x n)
+	 (lxor x y n)))
+
+(defthm land-associative
+  (equal (land (land x y n) z n)
+	 (land x (land y z n) n)))
+
+(defthm lior-associative
+  (equal (lior (lior x y n) z n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-associative
+  (equal (lxor (lxor x y n) z n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-commutative-2
+  (equal (land y (land x z n) n)
+	 (land x (land y z n) n)))
+
+(defthm lior-commutative-2
+  (equal (lior y (lior x z n) n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-commutative-2
+  (equal (lxor y (lxor x z n) n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land x (land y z n) n)
+		  (land (land x y n) z n))))
+
+(defthm lior-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior x (lior y z n) n)
+		  (lior (lior x y n) z n))))
+
+(defthm lxor-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor x (lxor y z n) n)
+		  (lxor (lxor x y n) z n))))
+
+(defthm land-self
+  (equal (land x x n)
+	 (bits x (1- n) 0)))
+
+(defthm lior-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior x x n) x)))
+
+(defthm lxor-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor x x n) 0)))
+
+(defthmd lior-land-1
+  (equal (lior x (land y z n) n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd lior-land-2
+  (equal (lior (land y z n) x n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd land-lior-1
+  (equal (land x (lior y z n) n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd land-lior-2
+  (equal (land (lior y z n) x n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd lior-land-lxor
+  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
+	 (lior (land x y n) (land (lxor x y n) z n) n)))
+
+(defthmd lxor-rewrite
+  (equal (lxor x y n)
+	 (lior (land x (lnot y n) n)
+	       (land y (lnot x n) n)
+	       n)))
+
+(defthmd lnot-lxor
+  (equal (lnot (lxor x y n) n)
+	 (lxor (lnot x n) y n)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/logn2log.lisp acl2-6.3/books/rtl/rel9/support/lib3/logn2log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/logn2log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/logn2log.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,87 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "log")
+(include-book "logn")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+(defthm land-logand
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (land x y n)
+                  (logand x y))))
+
+(defthm lior-logior
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lior x y n)
+                  (logior x y))))
+
+
+(defthm lxor-logxor
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lxor x y n)
+                  (logxor x y))))
+
+(defthm logior-bvecp
+  (implies (and (bvecp x n) (bvecp y n))
+           (bvecp (logior x y) n)))
+           
+
+
+(defthm logand-bvecp
+  (implies (and (natp n) (bvecp x n) (integerp y))
+           (bvecp (logand x y) n)))
+
+(defthm logxor-bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (bvecp (logxor x y) n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+
+
+
+
+         
+
+             
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/mult.lisp acl2-6.3/books/rtl/rel9/support/lib3/mult.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/mult.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/mult.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,486 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "add")
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+	       
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta (i y)
+  (+ (bitn y (1- (* 2 i))) 
+     (bitn y (* 2 i))
+     (* -2 (bitn y (1+ (* 2 i))))))
+
+
+(defun sum-theta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta (1- m) y))
+	(sum-theta (1- m) y))))
+
+
+
+(defthm sum-theta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta m y)))
+  :rule-classes ())
+
+
+(defun bmux4 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (0  0)))
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+
+(defun pp4 (i x n)
+  (if (zerop i)
+      (cat 1 1
+	   (bitn (lognot (neg (zeta i))) 0) 1
+	   (bmux4 (zeta i) x n) n)
+    (cat 1 1
+	 (bitn (lognot (neg (zeta i))) 0) 1
+	 (bmux4 (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4 (x m n)
+  (if (zp m)
+      0
+    (+ (pp4 (1- m) x n)
+       (sum-pp4 x (1- m) n))))
+
+
+(defthm booth4-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4 x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ())
+
+(defun pp4-theta (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (theta i y))) 0) 1
+	    (bmux4 (theta i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (theta i y))) 0) 1
+	  (bmux4 (theta i y) x n) n
+	  0 1
+	  (neg (theta (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-theta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-theta (1- m) x y n)
+       (sum-pp4-theta x y (1- m) n))))
+
+
+(defthm booth4-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits y (1+ (* 2 i)) (* 2 i)) (chi i y)))
+ 
+ (defun chi (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu (1- i) y) 3)
+	 1
+       0))))
+
+
+(defun phi (i y)
+  (if (= (bits (mu i y) 1 0) 3)
+      -1
+    (bits (mu i y) 1 0)))
+
+(defthm phi-bnd
+    (member (phi i y) '(-1 0 1 2)))
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+
+(defthm chi-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+  :rule-classes())
+
+
+(defthm phi-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi (1- m) y) 0))
+  :rule-classes())
+
+(defun sum-phi (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi (1- m) y))
+	(sum-phi (1- m) y))))
+
+
+(defthm sum-phi-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi m y)))
+  :rule-classes ())
+
+(defun pp4-phi (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (phi i y))) 0) 1
+	    (bmux4 (phi i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (phi i y))) 0) 1
+	  (bmux4 (phi i y) x n) n
+	  0 1
+	  (neg (phi (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-phi (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-phi (1- m) x y n)
+       (sum-pp4-phi x y (1- m) n))))
+
+
+(defthm static-booth
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+
+(defun gamma (i a b c)
+   (if (zp i)
+       (bitn c 0)
+     (logior (bitn  a (+ -1  (* 2 i)))
+ 	     (bitn  b (+ -1  (* 2 i))))))
+
+(defun delta (i a b c d)
+  (if (zp i)
+      (bitn d 0)
+    (logand (logior (logand (bitn a (+ -2 (* 2 i))) 
+			    (bitn b (+ -2 (* 2 i))))
+		    (logior (logand (bitn a (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))
+			    (logand (bitn b (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))))
+	    (lognot (logxor (bitn a (1- (* 2 i))) 
+			    (bitn b (1- (* 2 i))))))))
+
+(defun psi (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits a (1+ (* 2 i)) (* 2 i))
+       (bits b (1+ (* 2 i)) (* 2 i))
+       (gamma i a b c)
+       (delta i a b c d)
+       (* -4 (+ (gamma (1+ i) a b c)
+                (delta (1+ i) a b c d))))))
+
+
+(defthm psi-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))   
+		  (bvecp b (- (* 2 m) 2))  
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma m a b c) 0)
+		  (equal (delta m a b c d) 0)
+		  (>= (psi (1- m) a b c d) 0)))
+  :rule-classes ())
+
+
+(defun sum-psi (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi (1- m) a b c d))
+	(sum-psi (1- m) a b c d))))
+
+
+(defthm sum-psi-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi m a b c d)))
+  :rule-classes ())
+
+
+
+(defthmd psi-bnd
+  (and (integerp (psi i a b c d))
+       (<= (psi i a b c d) 2)
+       (>= (psi i a b c d) -2)))
+
+(defun pp4-psi (i x a b c d n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (psi i a b c d))) 0) 1
+	    (bmux4 (psi i a b c d) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (psi i a b c d))) 0) 1
+	  (bmux4 (psi i a b c d) x n) n
+	  0 1
+	  (neg (psi (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-psi (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4-psi (1- m) x a b c d n)
+       (sum-pp4-psi x a b c d (1- m) n))))
+
+
+
+(defthm redundant-booth
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+
+(defun eta (i y)
+  (+ (bitn y (1- (* 3 i))) 
+     (bitn y (* 3 i))
+     (* 2 (bitn y (1+ (* 3 i))))
+     (* -4 (bitn y (+ 2 (* 3 i))))))
+
+
+(defun sum-eta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta (1- m) y))
+	(sum-eta (1- m) y))))
+
+
+(defthm sum-eta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta m y)))
+  :rule-classes ())
+
+
+
+;; (defun bmux8 (zeta x n)
+;;   (case zeta
+;;     (1  x)
+;;     (-1 (bits (lognot x) (1- n) 0))
+;;     (2  (* 2 x))
+;;     (-2 (bits (lognot (* 2 x)) (1- n) 0))
+;;     (3  (* 3 x))
+;;     (-3 (bits (lognot (* 3 x)) (1- n) 0))
+;;     (4  (* 4 x))
+;;     (-4 (bits (lognot (* 4 x)) (1- n) 0))
+;;     (0  0)))
+
+
+(defun bmux8 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (3  (* 3 x))
+    (-3 (bits (lognot (* 3 x)) (1- n) 0))
+    (4  (* 4 x))
+    (-4 (bits (lognot (* 4 x)) (1- n) 0))
+    (0  0)))
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+
+(defun pp8 (i x n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (xi i))) 0) 1
+	   (bmux8 (xi i) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (xi i))) 0) 1
+	 (bmux8 (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8 (x m n)
+  (if (zp m)
+      0
+    (+ (pp8 (1- m) x n)
+       (sum-pp8 x (1- m) n))))
+
+
+(defthm booth8-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8 x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ())
+
+(defun pp8-eta (i x y n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (eta i y))) 0) 1
+	   (bmux8 (eta i y) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (eta i y))) 0) 1
+	 (bmux8 (eta i y) x n) n
+	 0 2
+	 (neg (eta (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+(defun sum-pp8-eta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8-eta (1- m) x y n)
+       (sum-pp8-eta x y (1- m) n))))
+
+
+(defthm booth8-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8-eta x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/openers.lisp acl2-6.3/books/rtl/rel9/support/lib3/openers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/openers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/openers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,74 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../../support/support/openers"))
+
+(program)
+
+; In this file, an event-control (evctl) data structure is either (posedge
+; clk), (negedge clk), or (even n).
+
+(defun negate-event-control (evctl)
+  (if (equal evctl '(even n))
+      (list 'not evctl)
+    (let* ((edge0 (car evctl))
+           (clk (cadr evctl))
+           (edge (case edge0
+                   (posedge 'pedge)
+                   (negedge 'nedge)
+                   (otherwise
+                    (er hard 'gen-model-preamble-common
+                        "Unable to handle edge specifier ~x0."
+                        edge0)))))
+      `(not (,edge (,clk (1- n)) (,clk n))))))
+
+(defun negate-event-control-list (x)
+  (declare (xargs :guard (true-listp x)))
+  (if (endp x)
+      nil
+    (cons (negate-event-control (car x))
+          (negate-event-control-list (cdr x)))))
+
+(defmacro def$open (name type &rest evctl-lst)
+  (if (eq type :skipped)
+      `(value-triple '(def$open ,name :skipped))
+    (let ((evctl-lst (if (eq type :input)
+                         (assert$ (null evctl-lst)
+                                  '((even n)))
+                       evctl-lst)))
+      `(defthm ,(intern-in-package-of-symbol
+                 (concatenate 'string (symbol-name name) "$OPEN")
+                 name)
+         (implies (and (integerp n)
+                       (< 0 n)
+                       ,@(negate-event-control-list evctl-lst))
+                  (equal (,name n)
+                         (,name (1- n))))
+         :hints (("Goal"
+                  :expand ((,name n)
+                           ,@(and (eq type :wire) `((,name (1- n)))))))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/package-defs.lisp acl2-6.3/books/rtl/rel9/support/lib3/package-defs.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/package-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/package-defs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,82 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../../support/support/package-defs"))
+
+;;Miscellaneous symbols that are not in *acl2-exports*:
+
+(defmacro other-acl2-symbols ()
+  ''(local-defun local-defthm local-in-theory
+                 n ; clock argument
+                 defbvecp ; macro written out by compiler
+                 defclock ; macro written out by compiler
+                 defperiodic
+                 fast-clock  ;BOZO, is importing these into the packages, the right way to handle this?
+                 slow-clock-one-quantum-wide
+                 slow-clock-one-quantum-wide-shifted
+                 slow-clock-two-quanta-wide
+                 slow-clock-two-quanta-wide-shifted
+                 always-1
+                 posedge negedge edge ; for defclock macro, which we used to use
+                 pedge nedge ;for defperiodic macro
+                 $path ; path argument of signal functions
+                 sub1-induction ; for bvecp lemma hints
+                 ))
+
+;;Symbols that occur in the RTL translation.  Formerly the symbol UNKNOWN was excluded from this
+;;list so that the corresponding symbol in the "*" package could be assigned a different function
+;;definition; but the first argument of unknown can be in any package desired.
+
+(defmacro rtl-symbols ()
+  ''(log= log<> log< log<= log> log>= lnot logand1 logior1 logxor1 shft lshft
+          rshft cat mulcat bitn bits setbits setbitn mod+ mod* mod- bind
+          case-select if1 cond1 reset reset2 land lior lxor lcat n! arr0 natp1
+          as ag mk-bvarr mk-bvec ag2 as2
+          abs trunc near minf inf sticky sig expo bitvec ; appeared May 2004 (from rpl_main.cc)
+          expt ; appeared May 2004 (seems to come from r2s)
+          prop gen
+          unknown unknown2))
+
+;;Functions that are defined in the FP library:
+
+(defmacro fp-symbols ()
+  ''(natp fl cg fl-half bvecp bv-arrp sumbits sigm kap tau lamt lamg lamz lam1 lam2 lam3 lam4 lam0 lamb
+          expo sgn sig 
+          exactp fp+ bias esgnf eexpof esigf erepp eencodingp eencode edecode ndecode rebias-expo isgnf iexpof isigf 
+          nrepp drepp irepp nencodingp dencodingp iencodingp nencode dencode iencode ddecode idecode trunc away re 
+          near near-witness near+ sticky oddr kp inf minf ieee-mode-p rnd flip
+          rnd-const drnd drnd-original))
+
+;;ACL2 symbols that are imported by all packages:
+
+(defmacro shared-symbols ()
+  '(union-eq *acl2-exports*
+    (union-eq *common-lisp-symbols-from-main-lisp-package*
+     (union-eq (other-acl2-symbols)
+      (union-eq (fp-symbols)
+       (rtl-symbols))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/reps.lisp acl2-6.3/books/rtl/rel9/support/lib3/reps.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/reps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/reps.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,538 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+(include-book "log")
+(include-book "float")
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;BOZO add rewrite rule?
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;BOZO disable?
+(defun esgnf  (x p q) (bitn x (+ p q)))
+(defun eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defun esigf  (x p)   (bits x (1- p) 0))
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+(defthm eencodingp-not-zero
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode x p q) 0))))
+
+(defthm erepp-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode x p q) p q)))
+
+
+(defthm eencodingp-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp (eencode x p q) p q) ))
+
+(defthm edecode-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode (eencode x p q) p q)
+		    x)))
+
+(defthm eencode-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode (edecode x p q) p q)
+		    x)))
+
+(defthm expo-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode x p q))
+		    (- (eexpof x p q) (bias q)))))
+
+(defthm sgn-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode  x p q))
+		    (if (= (esgnf x p q) 0) 1 -1))))
+
+(defthm sig-edecode
+    (implies (and (eencodingp  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode  x p q))
+		    (/ (esigf x p) (expt 2 (- p 1))))))
+
+;BOZO disable?
+(defun rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (bitn (lognot x) (1- m)))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(defund iencodingp (x p q)
+  (or (nencodingp x p q)
+      (dencodingp x p q)))
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp-and-dencodingp
+    (implies (iencodingp x p q)
+	     (iff (nencodingp x p q) (not (dencodingp x p q))))
+  :rule-classes ())
+
+
+;;Encoding functions:
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(defund iencode (x p q)
+  (cond ((nrepp x p q)
+	 (nencode x p q))
+	((drepp x p q)
+	 (dencode x p q))))
+
+
+;;Decoding functions:
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(defund idecode (x p q)
+  (cond ((nencodingp x p q)
+	 (ndecode x p q))
+	((dencodingp x p q)
+	 (ddecode x p q))))
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+(defthm sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+(defthm sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+(defthm sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+(defthm sgn-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode x p q))
+	      (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode x p q))
+	      (cond ((nencodingp x p q)
+		     (- (iexpof x p q) (bias q)))         
+		    ((dencodingp x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))))
+
+(defthm sig-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode x p q))
+		    (cond ((nencodingp x p q)
+			   (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
+			  ((dencodingp x p q)
+			   (sig (isigf x p)))))))
+
+
+;;Inversions:
+
+(defthm dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+(defthm iencodingp-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp (iencode x p q) p q)))
+
+(defthm nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+(defthm drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+(defthm irepp-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode x p q) p q)))
+
+(defthm nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+(defthm ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+(defthm ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+(defthm idecode-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode (iencode x p q) p q)
+		    x)))
+
+(defthm nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+(defthm dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+(defthm iencode-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode (idecode x p q) p q)
+		    x)))
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/rom-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3/rom-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/rom-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/rom-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,64 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../../support/support/rom-helpers"))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+(local (in-theory (enable bvecp)))
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(defun check-array (name a dim1 dim2)
+  (if (zp dim1)
+      t
+    (and (bvecp (aref1 name a (1- dim1)) dim2)
+	 (check-array name a (1- dim1) dim2))))
+
+(defthm check-array-lemma-1
+    (implies (and (not (zp dim1))
+		  (check-array name a dim1 dim2)
+		  (natp i)
+		  (< i dim1))
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+(defthm check-array-lemma
+    (implies (and (bvecp i n)
+		  (not (zp (expt 2 n)))
+		  (check-array name a (expt 2 n) dim2))		  
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/round.lisp acl2-6.3/books/rtl/rel9/support/lib3/round.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/round.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/round.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1805 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "float")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+
+
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-trunc)))))
+
+;;; Fri Feb 13 14:02:03 2009
+;;; 
+;;; Some truly new result. 
+
+
+
+;; (defthmd logand-expt-3-g
+;;     (implies (and (integerp x)
+;; 		  (natp n)
+;; 		  (natp k)
+;; 		  (< k n))
+;; 	     (equal (logand x (+ (expt 2 n) (- (expt 2 k))))
+;; 		    (* (expt 2 k) (bits x (1- n) k)))))
+;;
+;; (DEFTHM TRUNC-LAND
+;;                       (IMPLIES (AND (>= X (EXPT 2 (1- N)))
+;;                                     (< X (EXPT 2 N))
+;;                                     (INTEGERP X)
+;;                                     (> X 0)
+;;                                     (INTEGERP M)
+;;                                     (>= M N)
+;;                                     (INTEGERP N)
+;;                                     (> N K)
+;;                                     (INTEGERP K)
+;;                                     (> K 0))
+;;                                (= (TRUNC X K)
+;;                                   (LAND X (- (EXPT 2 M) (EXPT 2 (- N K)))
+;;                                         N)))
+;;                       :RULE-CLASSES NIL)
+;;
+;;
+;; (defthm land-slice
+;;   (implies (and (<= j i) ;drop? or not?
+;;                 (<= i n)
+;;                 (integerp n)
+;;                 (integerp i)
+;;                 (integerp j)
+;;                 (<= 0 j)
+;;                 )
+;;            (equal (land x (- (expt 2 i) (expt 2 j)) n)
+;;                   (* (expt 2 j) (bits x (1- i) j))))
+;;   :hints (("Goal" :use land0-slice))
+;;   :rule-classes ())
+;;
+  
+(defthm trunc-logand
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) ;(> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0))
+           (= (trunc x k)
+              (logand x (- (expt 2 m) (expt 2 (- n k))))))
+  :rule-classes ())
+
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m))))))
+  :hints (("Goal" :use ((:instance trunc-split_alt)))))
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    Unbiased Rounding
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+;;
+;; druss: the following may be wrong. 
+;;
+;; (defthm expo-near
+;;     (implies (and (rationalp x)
+;; 		  (natp n)
+;; 		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+;; 	     (equal (expo (near x n))
+;;                     (expo x)))
+;;   :rule-classes ())
+
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+
+(defun inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+
+(defun minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defun common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+;;;;
+
+
+(defun roundup (x mode n)
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+
+
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ()
+  :hints (("Goal" :use roundup_alt-thm)))
+  
+
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+
+
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/rtl.lisp acl2-6.3/books/rtl/rel9/support/lib3/rtl.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/rtl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/rtl.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,700 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;This book contains definitions of the ACL2 functions that are used in the
+;;formalization of RTL semantics.
+
+	       
+;;Bit-vector access:
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+;;LNOT (bitwise complement):
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+;LAND (bitwise and):
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec ; (land0 x y n)
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land)) to refer to binary-land.
+(add-macro-alias land binary-land)
+
+;;LIOR (bitwise inclusive or):
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec ; (lior0 x y n)
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior)) to refer to binary-lior:
+(add-macro-alias lior binary-lior)
+
+;;LXOR (bitwise exclusive or):
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor0 x y n)
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
+(add-macro-alias lxor binary-lxor)
+
+
+;;Bit-vector update:
+
+; We have decided to allow setbits to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits x w n n y))
+
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;;Signed inequalities:
+
+(defund comp2 (x n)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;;Unary logical operations:
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;;Shifting operations:
+
+(defund shft (x s l)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;;Arithmetic operations
+
+(defmacro mod+ (x y n)
+  `(bits (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod* (x y n)
+  `(bits (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
+i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
+get rid of the bits call.
+|#
+
+(defmacro mod- (x y n)
+  `(bits (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still
+;; need to add assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+
+;;Evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO Where in lib/ should these go?
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;;Natural number recognizer
+
+(defund natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(defund bvecp (x k)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+(defun mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+
+; Finally, we include bvecp (and, occasionally, related) lemmas for several
+; functions that are disabled.  These are not included elsewhere, presumably
+; because the functions will generally be enabled (hence blown away) by the
+; user.
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (shft x s n) k)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+;;The definitions of these functions are best disabled:
+
+(in-theory (disable aref1))
+(in-theory (disable aset1))
+(in-theory (disable aref2))
+(in-theory (disable aset2))
+(in-theory (disable floor))
+(in-theory (disable truncate))
+(in-theory (disable mod))
+(in-theory (disable rem))
+(in-theory (disable expt))
+(in-theory (disable ash))
+(in-theory (disable binary-logand))
+(in-theory (disable binary-logior))
+(in-theory (disable binary-logxor))
+(in-theory (disable binary-logeqv))
+(in-theory (disable logorc1))
+(in-theory (disable lognot))
+(in-theory (disable mk-bvec))
+(in-theory (disable if1))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/rtlarr.lisp acl2-6.3/books/rtl/rel9/support/lib3/rtlarr.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/rtlarr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/rtlarr.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,256 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+;;We define generic record accessing and updating functions to be used 
+;;with RTL arrays.  The basic functions are (ag a r) and (as a v r)
+;;where a is an array index, v is a value, r is an "array" or record.
+;;(ag a r) returns the value at index a in array r, and (as a v r) returns 
+;;a new array with index a set to value v in array r.
+
+(include-book "misc/total-order" :dir :system)
+
+(include-book "rtl")
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;Basic properties of arrays:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r)))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;; OK, we add here some properties for typing the records and the values which
+;; are stored in the records. This "typing" is pretty generic, but we choose the
+;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
+
+(defun bv-arrp (x k)
+  (declare (xargs :guard (integerp k)))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (bv-arrp (cdr x) k)
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (bvecp (cdar x) k)
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm as-maps-bv-arr-to-bv-arr
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as a v r) k)))
+
+(defthm ag-maps-bv-arr-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag a r) k)))
+
+(defun mk-bvarr (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bv-arrp r k) r ()))
+
+(defthm mk-bvarr-is-bv-arrp
+  (bv-arrp (mk-bvarr r k) k))
+
+(defthm mk-bvarr-identity
+  (implies (bv-arrp r k)
+           (equal (mk-bvarr r k) r)))
+
+(in-theory (disable bv-arrp mk-bvarr))
+
+;;We also define as2 and ag2 for 2-dimensional arrays but these simply
+;;macro-expand into appropriate as and ag calls.
+
+(defmacro ag2 (a b r)
+  `(ag (cons ,a ,b) ,r))
+
+(defmacro as2 (a b v r)
+  `(as (cons ,a ,b) ,v ,r))
+
+
+;;We disable as and ag, assuming the rules proved in this book are 
+;;sufficient to manipulate any record terms that are encountered.
+
+(in-theory (disable as ag))
+
+(defun positive-integer-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (equal l nil))
+        (t (and (integerp (car l))
+                (< 0 (car l))
+                (positive-integer-listp (cdr l))))))
+
+(defmacro arr0 (&rest dims)
+  (declare (ignore dims)
+           (xargs :guard (positive-integer-listp dims)))
+  nil)
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(encapsulate 
+ ((reset2 (key size) t))
+ (local (defun reset2 (key size) (declare (ignore key size)) nil))
+ (defthm bv-arrp-reset2
+   (bv-arrp (reset2 key size) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+(encapsulate 
+ ((unknown2 (key size n) t))
+ (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
+ (defthm bv-arrp-unknown2
+   (bv-arrp (unknown2 key size n) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))))
+
+;BOZO where in lib/ should this go?
+(defthm bv-arrp-if1
+  (equal (bv-arrp (if1 x y z) n)
+         (if1 x (bv-arrp y n) (bv-arrp z n))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/simple-loop-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,357 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "rtlarr")
+(include-book "log")
+(include-book "../../arithmetic/top")
+(local (include-book "base"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I)))
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+
+;; (defthm bitn-setbitn-setbitn
+;;   (implies (and (<  j w)
+;;                 (<= 0 j) 
+;;                 (integerp w)
+;;                 (integerp j))
+;;            (equal (bitn (setbitn x w j y)
+;;                         j)
+;;                   (bitn y 0))))
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; ;not in support/simple-loop-helpers since would be redefined here (which is illegal)
+
+;; (deftheory simple-loop-thy-0
+;;   (union-theories '(if1) (theory 'minimal-theory)))
+
+;; (deftheory simple-loop-thy-1
+;;   (union-theories
+;;    '(bitn-setbitn-not-equal
+;;      ag-diff-as
+;;      bits-31-0
+;;      natp)
+;;    (theory 'simple-loop-thy-0)))
+
+(in-theory (enable setbits bitn-cat))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/simplify-model-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,118 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "rtl")
+(include-book "arith")
+(include-book "bits")
+(local (include-book "base"))
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1)))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(defthm cat-bitn-m-equal-cat-bitn-1
+  (implies (and (syntaxp (and (quote m)
+                              (natp (cadr m))
+                              (> (cadr m) 1)))
+                (natp m)
+                (> m 1))
+           (equal (cat (bitn x i) m y n)
+                  (cat (bitn x i) 1 y n))))
+
+(in-theory (enable bvecp-monotone))
+(in-theory (enable bvecp-bits-0))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/top.lisp acl2-6.3/books/rtl/rel9/support/lib3/top.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/top.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,63 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "rtl") ;semantics of the basic RTL primitives
+
+(include-book "rtlarr") ;semantics RTL array primitives
+
+(include-book "basic") ;properties of basic arithmetic functions: floor, ceiling, 
+;                       exponential, and remainder
+
+(include-book "bits") ;bit vectors
+
+(include-book "log") ;logical operations
+
+; (include-book "logn") ;old land, lior logical operations with length parameter
+
+(include-book "float") ;floating-point numbers
+
+(include-book "reps") ;floating-point formats and representations
+
+(include-book "round") ;floating-point rounding
+
+(include-book "add") ;support for reasoning about addition
+
+(include-book "mult")  ; integerp multiplier
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../arithmetic/top")
+
+;(include-book "arith") ;general arithmetic package
+
+(include-book "util") ;misc helpful stuff including a few macros
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3/util.lisp acl2-6.3/books/rtl/rel9/support/lib3/util.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3/util.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3/util.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,176 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;(set-enforce-redundancy t)
+
+(local (include-book "base"))
+
+;;These macros facilitate localization of events:
+
+(defmacro local-defun (&rest body)
+  (list 'local (cons 'defun body)))
+
+(defmacro local-defund (&rest body)
+  (list 'local (cons 'defund body)))
+
+(defmacro local-defthm (&rest body)
+  (list 'local (cons 'defthm body)))
+
+(defmacro local-defthmd (&rest body)
+  (list 'local (cons 'defthmd body)))
+
+(defmacro local-in-theory (&rest body)
+  (cons 'local
+	(cons (cons 'in-theory (append body 'nil))
+	      'nil)))
+
+(defmacro defbvecp (name formals width &key thm-name hyp hints)
+  (let* ((thm-name
+          (or thm-name
+              (intern-in-package-of-symbol
+               (concatenate 'string
+                            (if (consp width)
+                                "BV-ARRP$"
+                              "BVECP$")
+                            (symbol-name name))
+               name)))
+         (x (cons name formals))
+         (typed-term (if (consp width)
+                         (list 'ag 'index x)
+                       x))
+         (bvecp-concl (if (consp width)
+                          (list 'bv-arrp x (car (last width)))
+                        (list 'bvecp x width)))
+         (concl (list 'and
+                      (list 'integerp typed-term)
+                      (list '<= 0 typed-term))))
+    (list* 'defthm thm-name
+           (if hyp
+               (list 'implies hyp bvecp-concl)
+             bvecp-concl)
+           :rule-classes
+           (list
+            :rewrite
+            (list :forward-chaining :trigger-terms (list x))
+            (list :type-prescription
+                  :corollary
+                  (if hyp
+                      (list 'implies hyp concl)
+                    concl)
+                  :typed-term typed-term
+                  ;; hints for the corollary 
+                  :hints
+                  (if (consp width)
+                      '(("Goal"
+                         :in-theory
+                         '(implies bvecp
+                                   bv-arrp-implies-nonnegative-integerp)))
+                    '(("Goal"
+                       :in-theory
+                       '(implies bvecp))))))
+           (if hints (list :hints hints) nil))))
+
+(defun sub1-induction (n)
+      (if (zp n)
+          n
+        (sub1-induction (1- n))))
+
+; These will be the functions to disable in acl2 proofs about signal bodies.
+; We use this in the compiler.
+;BOZO This doesn't include cons, which can now appear in signals defs.  I think that's okay, right?  think
+;about this and remove the BOZO
+(defconst *rtl-operators-after-macro-expansion*
+  '(log= log<> 
+    log< log<= log> log>= 
+    comp2< comp2<= comp2> comp2>=
+    land lior lxor lnot
+    logand1 logior1 logxor1
+    shft
+    cat mulcat
+    bits bitn setbits setbitn 
+    ag as
+    * + ; from macroexpansion of mod* or mod+
+    ;mod- ;now a macro!
+    floor rem decode encode
+    ;; bind ; handled specially in fixup-term
+    ;; if1 ;  a macro, so we don't disable it
+    ;; quote, n!, arr0 ; handled specially in fixup-term
+    natp1 ; doesn't matter, only occurs in for-loop defuns (must be enabled in those proofs anyway)
+    mk-bvarr mk-bvec
+    ))
+
+; Macro fast-and puts conjunctions in a tree form, which can avoid stack
+; overflows by ACL2's translate functions.
+
+(defun split-list (lst lo hi)
+  (cond ((endp lst) 
+         (mv lo hi))
+        ((endp (cdr lst)) 
+         (mv (cons (car lst) lo) hi))
+        (t
+         (split-list (cddr lst)
+                     (cons (car lst) lo)
+                     (cons (cadr lst) hi)))))
+
+(defun fast-and-fn (conjuncts)
+  (declare (xargs :mode :program))
+  (cond ((endp conjuncts) ''t)
+        ((endp (cdr conjuncts)) (car conjuncts))
+        (t
+         (mv-let (hi lo)
+             (split-list conjuncts () ())
+           (list 'if
+                 (fast-and-fn hi)
+                 (fast-and-fn lo)
+                 'nil)))))
+
+(defmacro fast-and (&rest conjuncts)
+  (fast-and-fn conjuncts))
+
+
+
+(defmacro defsig (name param body)
+  (declare (ignore param))
+  (let ((realname  (intern-in-package-of-symbol
+                    (concatenate 'string
+                                 (symbol-name name)
+                                 "$")
+                    name)))
+    `(progn (defund ,realname (n $path) 
+              ,body)
+            (defmacro ,name (n)
+              (list ',realname n '$path))
+            (add-macro-alias ,name ,realname))))
+
+(defmacro defsigd (name params body)
+  (let ((realname (intern-in-package-of-symbol
+                    (concatenate 'string (symbol-name name) "$")
+                    name)))
+    `(progn (defund ,realname (,@params $path) 
+              ,body)
+            (defmacro ,name ,params
+              (list ',realname ,@params '$path))
+            (add-macro-alias ,name ,realname))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta1/Makefile acl2-6.3/books/rtl/rel9/support/lib3.delta1/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib3.delta1/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta1/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,5 @@
+include ../../../../Makefile-generic
+
+# BOOKS = division sqrt seed srt sqrt66
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta1/division.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta1/division.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta1/division.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta1/division.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,4326 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "../lib3/bits")
+(include-book "../lib3/util")
+
+(set-prover-step-limit *default-step-limit*) 
+(local (include-book "../lib3/top"))
+
+(encapsulate ()
+
+(local (include-book "arithmetic-5/top" :dir :system))
+
+;;**********************************************************************************
+
+(encapsulate (((rho$) => *) ((x$) => *) ((d$) => *) ((h$ *) => *))
+  (local (defun rho$ () 1))
+  (local (defun x$ () 0))
+  (local (defun d$ () 1))
+  (local (defun h$ (k) (declare (ignore k)) 0))
+  (defthm rho$-constraint
+    (integerp (rho$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm x$-constraint
+    (rationalp (x$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm d$-constraint
+    (and (rationalp (d$))
+         (> (d$) 0))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm integerp-h$ 
+    (implies (not (zp k))
+             (integerp (h$ k)))
+    :rule-classes (:rewrite :type-prescription)))
+
+(defund p$ (k) 
+  (if (zp k)
+      (x$)
+    (- (* (expt 2 (rho$)) (p$ (1- k)))
+       (* (h$ k) (d$)))))
+
+(defund q$ (k)
+  (if (zp k)
+      0
+    (+ (q$ (1- k))
+       (/ (h$ k) (expt 2 (* k (rho$)))))))
+
+(local-defthm lemma-2-1-1
+  (implies (and (not (zp k))
+                (= (p$ (1- k))
+                   (* (expt 2 (* (1- k) (rho$)))
+                      (- (x$) (* (q$ (1- k)) (d$))))))
+           (equal (* (expt 2 (* k (rho$))) (- (x$) (* (q$ k) (d$))))
+                  (p$ k)))
+  :hints (("Goal" :in-theory (enable p$ q$)))
+  :rule-classes ())
+
+(local-defthm lemma-2-1-2
+  (implies (zp k)
+           (equal (- (x$) (* (q$ k) (d$)))
+                  (p$ k)))
+  :hints (("Goal" :in-theory (enable p$ q$)))
+  :rule-classes ())
+
+(defun natp-induct (n)
+  (if (zp n)
+      t
+    (natp-induct (1- n))))
+
+(defthmd lemma-2-1
+  (implies (natp k)
+           (equal (p$ k)
+                  (* (expt 2 (* k (rho$)))
+                     (- (x$) (* (q$ k) (d$))))))
+  :hints (("Goal" :induct (natp-induct k))
+          ("Subgoal *1/2" :use lemma-2-1-1)
+          ("Subgoal *1/1" :use lemma-2-1-2)))
+
+(local-defthm lemma-2-1-3
+  (implies (natp k)
+           (equal (/ (p$ k) (d$))
+                  (* (expt 2 (* k (rho$)))
+                     (- (/ (x$) (d$)) (q$ k)))))
+  :hints (("Goal" :in-theory (enable lemma-2-1)))
+  :rule-classes ())
+
+(local-defthm rat-p$
+  (rationalp (p$ k))
+  :hints (("Goal" :in-theory (enable p$))))
+
+(local-defthm lemma-2-1-4
+  (implies (and (<= (- (d$)) (p$ k))
+                (< (p$ k) (d$)))
+           (and (<= -1 (/ (p$ k) (d$)))
+                (< (/ (p$ k) (d$)) 1)))
+  :rule-classes ())
+
+(local-defthm lemma-2-1-5
+  (implies (and (natp k)
+                (<= (- (d$)) (p$ k))
+                (< (p$ k) (d$)))
+           (and (<= -1 
+                    (* (expt 2 (* k (rho$)))
+                       (- (/ (x$) (d$)) (q$ k))))
+                (< (* (expt 2 (* k (rho$)))
+                      (- (/ (x$) (d$)) (q$ k)))
+                   1)))
+  :hints (("Goal" :use (lemma-2-1-3
+                        lemma-2-1-4)))
+  :rule-classes ())
+
+(local-defthm *-weakly-monotonic
+  (implies (and (rationalp y)
+                (rationalp y+)
+                (rationalp x)
+                (> x 0))
+           (iff (<= y y+)
+                (<= (* x y) (* x y+))))
+  :rule-classes ())
+
+(local-defthm lemma-2-1-6
+  (implies (and (rationalp a)
+                (rationalp b)
+                (> a 0)
+                (<= -1 (* a b))
+                (< (* a b) 1))
+           (and (<= (- (/ a)) b)
+                (< b (/ a))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (x a) (y (- (/ a))) (y+ b))))))
+
+(local-defthm lemma-2-1-7
+  (implies (and (natp k)
+                (<= (- (d$)) (p$ k))
+                (< (p$ k) (d$)))
+           (and (<= (- (/ (expt 2 (* k (rho$)))))
+                    (- (/ (x$) (d$)) (q$ k)))
+                (<  (- (/ (x$) (d$)) (q$ k))
+                    (/ (expt 2 (* k (rho$)))))))
+  :hints (("Goal" :use (lemma-2-1-5
+                        (:instance lemma-2-1-6 (a (expt 2 (* k (rho$)))) (b (- (/ (x$) (d$)) (q$ k)))))))
+  :rule-classes ())
+
+(defthm lemma-2-1-corollary
+  (implies (and (natp k)
+                (<= (- (d$)) (p$ k))
+                (< (p$ k) (d$)))
+           (and (<= (- (/ (expt 2 (* k (rho$)))))
+                    (- (/ (x$) (d$)) (q$ k)))
+                (< (- (/ (x$) (d$)) (q$ k))
+                   (/ (expt 2 (* k (rho$))))))) 
+  :hints (("Goal" :use (lemma-2-1-7)))
+  :rule-classes ())
+
+)
+
+;;**********************************************************************************
+
+(encapsulate ()
+
+(local (include-book "rtl/rel8/lib/arith" :dir :system))
+(local (include-book "arithmetic-5/top" :dir :system))
+
+(defund delta0 (j n)
+  (1+ (/ j (expt 2 n))))
+
+(defund pi0 (i m)
+  (if (< i (expt 2 (1- m)))
+      (/ i (expt 2 (- m 2)))
+    (- (/ i (expt 2 (- m 2)))
+       4)))
+
+(defund div-accessible-p (i j m n)
+  (and (< (- (- (delta0 j n)) (+ (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n))))))
+
+(defund lower (i j rho m n)
+  (min (1- (expt 2 rho))
+       (if (or (< i (expt 2 (1- m)))
+               (= i (1- (expt 2 m))))
+           (1- (cg (* (expt 2 rho) 
+                      (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                         (delta0 j n)))))
+         (1- (cg (* (expt 2 rho) 
+                    (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                       (+ (delta0 j n) (/ (expt 2 n))))))))))
+
+(defund upper (i j rho m n)
+  (max (- 1 (expt 2 rho)) 
+       (if (< i (expt 2 (1- m)))
+           (1+ (fl (* (expt 2 rho) 
+                      (/ (pi0 i m)
+                         (+ (delta0 j n) (/ (expt 2 n)))))))
+         (1+ (fl (* (expt 2 rho) 
+                    (/ (pi0 i m)
+                       (delta0 j n))))))))
+
+(defund lookup (i j table)
+  (ifix (nth j (nth i table))))
+
+(defthm integerp-lookup
+  (integerp (lookup i j table))
+  :hints (("Goal" :in-theory (enable lookup)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defund check-div-entry (i j rho m n entry)
+  (or (not (div-accessible-p i j m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (<= (lower i j rho m n)
+               entry)
+           (<= entry
+               (upper i j rho m n)))))
+
+(defund check-div-row (i j rho m n row)
+  (if (zp j)
+      t
+    (and (check-div-entry i (1- j) rho m n (ifix (nth (1- j) row)))
+         (check-div-row i (1- j) rho m n row))))
+
+(defund check-div-rows (i rho m n rows)
+  (if (zp i)
+      t
+    (and (check-div-row (1- i) (expt 2 n) rho m n (nth (1- i) rows))
+         (check-div-rows (1- i) rho m n rows))))
+
+(defund admissible-div-table-p (rho m n table)
+  (check-div-rows (expt 2 m) rho m n table))
+
+(local-defthm check-div-row-lemma
+  (implies (and (natp j)
+                (natp k)
+                (< k j)
+                (check-div-row i j rho m n row))
+           (check-div-entry i k rho m n (ifix (nth k row))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-div-row))))
+
+(local-defthm check-div-rows-lemma
+  (implies (and (natp i)
+                (natp k)
+                (< k i)
+                (check-div-rows i rho m n rows))
+           (check-div-row k (expt 2 n) rho m n (nth k rows)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-div-rows))))
+
+(local-defthm check-div-table-lemma
+  (implies (and (natp m)
+                (natp n)
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (admissible-div-table-p rho m n table))
+           (check-div-entry i j rho m n (lookup i j table)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lookup admissible-div-table-p)
+                  :use ((:instance check-div-rows-lemma (rows table) (k i) (i (expt 2 m)))
+                        (:instance check-div-row-lemma (row (nth i table)) (k j) (j (expt 2 n)))))))
+
+(local (in-theory (disable a2)))
+
+(defthm div-table-1
+  (implies (and (natp m)
+                (natp n)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3))))))
+           (div-accessible-p i j m n))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable div-accessible-p))))
+
+(local-defthm div-table-2
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table)))
+           (and (integerp k)
+                (< (- (expt 2 rho)) k)
+                (< k (expt 2 rho))
+                (<= (lower i j rho m n) k)
+                (<= k (upper i j rho m n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-div-entry)
+                  :use (check-div-table-lemma div-table-1))))
+
+(local-defthm div-table-3
+  (implies (and (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (= k (1- (expt 2 rho))))
+           (< (* (expt 2 rho) p)
+              (* (1+ k) d)))
+  :rule-classes ()
+  :hints (("Goal" :use (check-div-table-lemma div-table-1))))
+
+(local-defthm div-table-4
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho)))))
+            (< k (1- (expt 2 rho))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-2))))
+
+(local-defthm div-table-5
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+            (>= k (1- (cg (* (expt 2 rho) 
+                             (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                (delta0 j n)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lower)
+                  :use (div-table-4 div-table-2))))
+
+(local-defthm div-table-6
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (natp i))
+            (>= (cg (* (expt 2 rho) 
+                       (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                          (delta0 j n))))
+                (* (expt 2 rho) 
+                   (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                      (delta0 j n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0 delta0))))
+
+(local-defthm div-table-7
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+            (>= k (1- (* (expt 2 rho) 
+                         (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                            (delta0 j n))))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-6
+                        div-table-5))))
+
+(local-defthm div-table-8
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+            (>= (1+ k)
+                (* (expt 2 rho)
+                   (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                      (delta0 j n)))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-7))))
+
+(local-defthm div-table-9
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+            (>= (* (1+ k) (delta0 j n))
+                (* (expt 2 rho)
+                   (+ (pi0 i m) (/ (expt 2 (- m 3)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0 delta0)
+                  :use (div-table-2 div-table-8))))
+
+(local-defthm div-table-10
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+            (and (integerp k)
+                 (rationalp (delta0 j n))
+                 (>= (delta0 j n) 1)
+                 (rationalp (pi0 i m))
+                 (>= (+ (pi0 i m) (/ (expt 2 (- m 3)))) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0 delta0)
+                  :use (div-table-2))))
+
+(local-defthm div-table-11
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+           (>= (1+ k) 0))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-10 div-table-8))))
+
+(local-defthm div-table-12
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+            (>= (* (1+ k) d)
+                (* (1+ k) (delta0 j n))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-10
+                        div-table-11
+                        (:instance *-WEAKLY-MONOTONIC (x (1+ k)) (y (delta0 j n)) (y+ d))))))
+
+(local-defthm div-table-13
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+            (>= (* (1+ k) d)
+                (* (expt 2 rho)
+                   (+ (pi0 i m) (/ (expt 2 (- m 3)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-9 div-table-12))))
+
+(local-defthm div-table-14
+  (implies (and (natp m)
+                (natp rho)
+                (rationalp p)
+                (natp i)
+                (< i (expt 2 m))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3))))))
+            (> (* (expt 2 rho)
+                  (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+               (* (expt 2 rho)
+                  p)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0))))
+
+(local-defthm div-table-15
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m))) (= i (1- (expt 2 m)))))
+            (> (* (1+ k) d)
+               (* (expt 2 rho) p)))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-14 div-table-13))))
+
+(local-defthm div-table-16
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+            (>= k (1- (cg (* (expt 2 rho) 
+                             (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                (+ (delta0 j n) (/ (expt 2 n)))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lower)
+                  :use (div-table-4 div-table-2))))
+
+(local-defthm div-table-17
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (natp i))
+            (>= (cg (* (expt 2 rho) 
+                       (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                          (+ (delta0 j n) (/ (expt 2 n))))))
+                (* (expt 2 rho) 
+                   (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                      (+ (delta0 j n) (/ (expt 2 n)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0 delta0))))
+
+(local-defthm div-table-18
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+            (>= k (1- (* (expt 2 rho) 
+                         (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                            (+ (delta0 j n) (/ (expt 2 n))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-16
+                        div-table-17))))
+
+(local-defthm div-table-19
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+            (>= (1+ k)
+                (* (expt 2 rho)
+                   (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                      (+ (delta0 j n) (/ (expt 2 n)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-18))))
+
+(local-defthm div-table-20
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+            (and (integerp k)
+                 (rationalp (delta0 j n))
+                 (>= (delta0 j n) 1)
+                 (rationalp (pi0 i m))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0 delta0)
+                  :use (div-table-2))))
+
+(local-defthm div-table-21
+  (implies (and (natp m)
+                (natp i)
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+           (<= (+ (pi0 i m) 4) 
+               (* (/ (expt 2 (- m 2))) (- (expt 2 m) 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0)
+                  :use ((:instance *-weakly-monotonic (x (/ (expt 2 (- m 2)))) (y i) (y+ (- (expt 2 m) 2)))))))
+
+(local-defthm expt-plus
+  (implies (and (integerp m) (integerp n))
+           (equal (expt 2 (+ m n))
+                  (* (expt 2 m) (expt 2 n))))
+  :rule-classes ())
+
+(local-defthm div-table-22
+  (implies (natp m)
+           (equal (* (/ (expt 2 (- m 2))) (- (expt 2 m) 2))
+                  (- 4 (expt 2 (- 3 m)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-plus (m (- 2 m)) (n m))
+                        (:instance expt-plus (m (- 2 m)) (n 1))))))
+
+(local-defthm div-table-23
+  (implies (and (natp m)
+                (natp i)
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+           (and (rationalp (pi0 i m))
+                (<= (pi0 i m)
+                    (- (/ (expt 2 (- m 3)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0)
+                  :use (div-table-22 div-table-21))))
+
+(local-defthm div-table-24
+  (implies (and (natp n)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (natp j)
+                (< d (+ (delta0 j n) (/ (expt 2 n)))))
+            (and (rationalp (delta0 j n))
+                 (< (/ (+ (delta0 j n) (/ (expt 2 n))))
+                    (/ d))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable delta0)
+                  :use (div-table-20))))
+
+(local-defthm div-table-25
+  (implies (and (natp m)
+                (natp i)
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m)))
+                (natp n)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (natp j)
+                (< d (+ (delta0 j n) (/ (expt 2 n)))))
+            (>= (* (expt 2 rho) 
+                   (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                      (+ (delta0 j n) (/ (expt 2 n)))))
+                (* (expt 2 rho) 
+                   (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                      d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-23
+                        div-table-24
+                        (:instance *-weakly-monotonic-negative-multiplier
+                                   (x (* (expt 2 rho) (+ (pi0 i m) (/ (expt 2 (- m 3))))))
+                                   (y (/ (+ (delta0 j n) (/ (expt 2 n)))))
+                                   (y+ (/ d)))))))
+
+(local-defthm div-table-26
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (>= x y)
+                (>= y z))
+           (>= x z))
+  :rule-classes ())
+
+(local-defthm div-table-27
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+            (>= (1+ k)
+                (* (expt 2 rho)
+                   (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                       d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-19 
+                        div-table-20 
+                        div-table-25
+                        (:instance div-table-26 
+                                   (x (1+ k))
+                                   (y (* (expt 2 rho) 
+                                         (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                            (+ (delta0 j n) (/ (expt 2 n))))))
+                                   (z (* (expt 2 rho) 
+                                         (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                            d))))))))
+
+(local-defthm div-table-28
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+            (>= (* (1+ k) d)
+                (* (expt 2 rho)
+                   (+ (pi0 i m) (/ (expt 2 (- m 3)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-27
+                        div-table-20
+                        (:instance *-weakly-monotonic 
+                                   (x d) 
+                                   (y+ (1+ k))
+                                   (y (* (expt 2 rho)
+                                         (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                            d))))))))
+
+(local-defthm div-table-29
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+            (>= (* (expt 2 rho)
+                   (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (* (expt 2 rho)
+                   p)))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-27
+                        div-table-20
+                        (:instance *-strongly-monotonic 
+                                   (x (expt 2 rho))
+                                   (y+ (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                                   (y p))))))
+
+(local-defthm div-table-30
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (1- (expt 2 rho))))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+            (> (* (1+ k) d)
+               (* (expt 2 rho)
+                  p)))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-28
+                        div-table-29))))
+
+(local-defthm div-table-31
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table)))
+            (> (* (1+ k) d)
+               (* (expt 2 rho) p)))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-3
+                        div-table-15
+                        div-table-30))))
+
+(local-defthm div-table-3-1
+  (implies (and (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (= k (- 1 (expt 2 rho))))
+           (>= (* (expt 2 rho) p)
+               (* (1- k) d)))
+  :rule-classes ()
+  :hints (("Goal" :use (check-div-table-lemma div-table-1))))
+
+(local-defthm div-table-4-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho)))))
+            (> k (- 1 (expt 2 rho))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-2))))
+
+(local-defthm div-table-5-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (< i (expt 2 (1- m))))
+            (<= k (1+ (fl (* (expt 2 rho) (/ (pi0 i m) (+ (delta0 j n) (expt 2 (- n)))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable upper)
+                  :use (div-table-4-1 div-table-2))))
+
+(local-defthm div-table-6-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (natp i))
+            (<= (fl (* (expt 2 rho) (/ (pi0 i m) (+ (delta0 j n) (expt 2 (- n))))))
+                (* (expt 2 rho) (/ (pi0 i m) (+ (delta0 j n) (expt 2 (- n)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0 delta0))))
+
+(local-defthm div-table-7-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (< i (expt 2 (1- m))))
+            (<= k (1+ (* (expt 2 rho) (/ (pi0 i m) (+ (delta0 j n) (expt 2 (- n))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-6-1
+                        div-table-5-1))))
+
+(local-defthm div-table-8-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (< i (expt 2 (1- m))))
+            (<= (1- k) (* (expt 2 rho) (/ (pi0 i m) (+ (delta0 j n) (expt 2 (- n)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-7-1))))
+
+(local-defthm div-table-9-1
+  (implies (and (natp m)
+                (natp n)
+                (natp j)
+                (< j (expt 2 n))
+                (natp i)
+                (< i (expt 2 (1- m))))
+            (and (rationalp (delta0 j n))
+                 (>= (delta0 j n) 1)
+                 (rationalp (pi0 i m))
+                 (>= (pi0 i m) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable delta0 pi0))))
+
+(local-defthm div-table-10-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (rationalp d)
+                (<= 1 d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (< j (expt 2 n))
+                (natp i)
+                (< i (expt 2 (1- m))))
+            (<= (* (expt 2 rho) (/ (pi0 i m) (+ (delta0 j n) (expt 2 (- n)))))
+                (* (expt 2 rho) (/ (pi0 i m) d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-9-1
+                        (:instance *-weakly-monotonic 
+                                   (x (* (expt 2 rho) (pi0 i m)))
+                                   (y (/ (+ (delta0 j n) (expt 2 (- n)))))
+                                   (y+ (/ d)))))))
+
+(local-defthm div-table-11-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (rationalp d)
+                (<= 1 d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (rationalp p)
+                (< (pi0 i m) p)
+                (< j (expt 2 n))
+                (natp i)
+                (< i (expt 2 (1- m))))
+            (<= (* (expt 2 rho) (/ (pi0 i m) d))
+                (* (expt 2 rho) (/ p d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-9-1
+                        (:instance *-weakly-monotonic 
+                                   (x (/ (expt 2 rho) d))
+                                   (y (pi0 i m))
+                                   (y+ p))))))
+
+(local-defthm div-table-12-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (rationalp d)
+                (<= 1 d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (rationalp p)
+                (<= (pi0 i m) p)
+                (< j (expt 2 n))
+                (natp i)
+                (< i (expt 2 (1- m))))
+            (<= (* (expt 2 rho) (/ (pi0 i m) (+ (delta0 j n) (expt 2 (- n)))))
+                (* (expt 2 rho) (/ p d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-9-1
+                        div-table-10-1
+                        div-table-11-1))))
+
+(local-defthm div-table-13-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (< i (expt 2 (1- m))))
+            (<= (1- k) (* (expt 2 rho) (/ p d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-2
+                        div-table-8-1
+                        div-table-9-1
+                        div-table-12-1
+                        (:instance div-table-26
+                                   (x (* (expt 2 rho) (/ p d)))
+                                   (y (* (expt 2 rho) (/ (pi0 i m) (+ (delta0 j n) (expt 2 (- n))))))
+                                   (z (1- k)))))))
+
+(local-defthm div-table-14-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (< i (expt 2 (1- m))))
+            (<= (* (1- k) d)
+                (* (expt 2 rho) p)))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-2
+                        div-table-8-1
+                        div-table-13-1
+                        (:instance *-weakly-monotonic
+                                   (x d)
+                                   (y (1- k))
+                                   (y+ (* (expt 2 rho) (/ p d))))))))
+
+(local-defthm div-table-15-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (>= i (expt 2 (1- m))))
+            (<= k (1+ (fl (* (expt 2 rho) (/ (pi0 i m) (delta0 j n)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable upper)
+                  :use (div-table-4-1 div-table-2))))
+
+(local-defthm div-table-16-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (natp i))
+            (<= (fl (* (expt 2 rho) (/ (pi0 i m) (delta0 j n))))
+                (* (expt 2 rho) (/ (pi0 i m) (delta0 j n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0 delta0))))
+
+(local-defthm div-table-17-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (>= i (expt 2 (1- m))))
+            (<= k (1+ (* (expt 2 rho) (/ (pi0 i m) (delta0 j n))))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-16-1
+                        div-table-15-1))))
+
+(local-defthm div-table-18-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (>= i (expt 2 (1- m))))
+            (<= (1- k) (* (expt 2 rho) (/ (pi0 i m) (delta0 j n)))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-17-1))))
+
+(local-defthm div-table-19-1
+  (implies (and (natp m)
+                (natp n)
+                (natp j)
+                (< j (expt 2 n))
+                (natp i)
+                (< i (expt 2 m))
+                (>= i (expt 2 (1- m))))
+            (and (rationalp (delta0 j n))
+                 (>= (delta0 j n) 1)
+                 (rationalp (pi0 i m))
+                 (<= (pi0 i m) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable delta0 pi0))))
+
+(local-defthm div-table-20-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (rationalp d)
+                (<= 1 d)
+                (>= d (delta0 j n))
+                (< j (expt 2 n))
+                (natp i)
+                (< i (expt 2 m))
+                (>= i (expt 2 (1- m))))
+            (<= (* (expt 2 rho) (/ (pi0 i m) (delta0 j n)))
+                (* (expt 2 rho) (/ (pi0 i m) d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-19-1
+                        (:instance *-weakly-monotonic-negative-multiplier 
+                                   (x (* (expt 2 rho) (pi0 i m)))
+                                   (y+ (/ (delta0 j n)))
+                                   (y (/ d)))))))
+
+(local-defthm div-table-21-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (rationalp d)
+                (<= 1 d)
+                (>= d (delta0 j n))
+                (rationalp p)
+                (< (pi0 i m) p)
+                (< j (expt 2 n))
+                (natp i)
+                (>= i (expt 2 (1- m))))
+            (<= (* (expt 2 rho) (/ (pi0 i m) d))
+                (* (expt 2 rho) (/ p d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-19-1
+                        (:instance *-weakly-monotonic 
+                                   (x (/ (expt 2 rho) d))
+                                   (y (pi0 i m))
+                                   (y+ p))))))
+
+(local-defthm div-table-22-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp j)
+                (rationalp d)
+                (<= 1 d)
+                (>= d (delta0 j n))
+                (rationalp p)
+                (<= (pi0 i m) p)
+                (< j (expt 2 n))
+                (natp i)
+                (< i (expt 2 m))
+                (>= i (expt 2 (1- m))))
+            (<= (* (expt 2 rho) (/ (pi0 i m) (delta0 j n)))
+                (* (expt 2 rho) (/ p d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-19-1
+                        div-table-20-1
+                        div-table-21-1))))
+
+(local-defthm div-table-23-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (>= i (expt 2 (1- m))))
+            (<= (1- k) (* (expt 2 rho) (/ p d))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-2
+                        div-table-18-1
+                        div-table-19-1
+                        div-table-22-1
+                        (:instance div-table-26
+                                   (x (* (expt 2 rho) (/ p d)))
+                                   (y (* (expt 2 rho) (/ (pi0 i m) (delta0 j n))))
+                                   (z (1- k)))))))
+
+(local-defthm div-table-24-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table))
+                (not (= k (- 1 (expt 2 rho))))
+                (>= i (expt 2 (1- m))))
+            (<= (* (1- k) d)
+                (* (expt 2 rho) p)))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-2
+                        div-table-18-1
+                        div-table-23-1
+                        (:instance *-weakly-monotonic
+                                   (x d)
+                                   (y (1- k))
+                                   (y+ (* (expt 2 rho) (/ p d))))))))
+
+(local-defthm div-table-25-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table)))
+            (<= (* (1- k) d)
+                (* (expt 2 rho) p)))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-24-1
+                        div-table-3-1
+                        div-table-14-1))))
+
+(local-defthm div-table-26-1
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (rationalp d)
+                (<= 1 d)
+                (< d 2)
+                (rationalp p)
+                (<= (- d) p) (< p d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= k (lookup i j table)))
+           (and (integerp k)
+                (< (- (expt 2 rho)) k)
+                (< k (expt 2 rho))
+                (<= (- d) (- (* (expt 2 rho) p) (* d k)))
+                (< (- (* (expt 2 rho) p) (* d k)) d)))
+  :rule-classes ()
+  :hints (("Goal" :use (div-table-25-1
+                        div-table-31
+                        div-table-2))))
+
+(local-defthm div-table-27-1
+  (implies (and (natp n)
+                (natp j)
+                (< j (expt 2 n)))
+           (and (<= 1 (delta0 j n))
+                (<= (+ (delta0 j n) (/ (expt 2 n))) 2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable delta0)
+                  :use (:instance *-weakly-monotonic (y (1+ j)) (y+ (expt 2 n)) (x (expt 2 (- n)))))))
+
+(defthm lemma-2-2
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (rationalp p)
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (rationalp d)
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (<= (- d) p) 
+                (< p d)
+                (= k (lookup i j table)))
+           (and (< (- (expt 2 rho)) k)
+                (< k (expt 2 rho))
+                (<= (- d) (- (* (expt 2 rho) p) (* d k)))
+                (< (- (* (expt 2 rho) p) (* d k)) d)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lookup)
+                  :use ((:instance div-table-26-1 (k (lookup i j table)))
+                        div-table-27-1))))
+
+)
+
+;;**********************************************************************************
+
+(include-book "arithmetic-5/top" :dir :system)
+
+;; Assume that dmin < dmax and pmin < pmax.  Consider the closed rectangle
+;;   R = {(d,p) | dmin <= d <= dmax and pmin <= p <= pmax}
+;; and the half-open rectangle
+;;   R' = {(d,p) | dmin <= d < dmax and pmin <= p < pmax}.
+;; If there exists (d,p) in R such that p < h*d, then (d1,p1) is a point
+;; in R' with p1 < h*d1:
+
+(defund d1 (dmin pmin dmax pmax h)
+  (declare (ignore pmax))
+  (if (< pmin (* h dmin))
+      dmin
+    (/ (+ (/ pmin h) dmax) 2)))
+
+(defund p1 (dmin pmin dmax pmax h)
+  (declare (ignore dmin dmax pmax h))
+  pmin)
+
+;; If there exists (d,p) in R such that p > h*d, then (d2,p2) is a point
+;; in R' with p2 > h*d2:
+
+(defund d2 (dmin pmin dmax pmax h)
+  (declare (ignore pmin))
+  (if (> pmax (* h dmin))
+      dmin
+    (/ (+ (/ pmax h) dmax) 2)))
+
+(defund p2 (dmin pmin dmax pmax h)
+  (let ((d2 (d2 dmin pmin dmax pmax h)))
+    (if (> pmin (* h d2))
+        pmin
+      (/ (+ (* h d2) pmax) 2))))
+
+;; If (d1,p1) and (d2,p2) are in points in R' such that p1 < h*d1 and
+;; p2 > h*d2, then (d3,p3) is in R' and p3 = h*d3:
+
+(defund d3 (d1 p1 d2 p2 h)
+  (if (= h 0)
+      d1
+    (if (<= p1 p2)
+        (if (<= p2 (* h d1))
+            (/ p2 h)
+          d1)
+      (if (<= p1 (* h d2))          
+          d2
+        (/ p1 h)))))
+
+(defund p3 (d1 p1 d2 p2 h)
+  (if (= h 0)
+      0
+    (if (<= p1 p2)
+        (if (<= p2 (* h d1))
+            p2
+          (* h d1))
+      (if (<= p1 (* h d2))
+          (* h d2)
+        p1))))
+
+;; Assume hmin < hmax.  If there exist (d1,p1) and (d2,p2) in R such 
+;; that p1 < hmax*d1 and p2 > hmin*d2, then (d4,p4) is in R' and 
+;; hmin*d4 < p4 < hmax*d4:
+
+(defund d4 (dmin pmin dmax pmax hmin hmax)
+  (let ((d1 (d1 dmin pmin dmax pmax hmax))
+        (p1 (p1 dmin pmin dmax pmax hmax)))
+    (if (> p1 (* hmin d1))
+        d1
+      (let ((d2 (d2 dmin pmin dmax pmax hmin))
+            (p2 (p2 dmin pmin dmax pmax hmin)))
+        (if (< p2 (* hmax d2))
+            d2
+          (d3 d1 p1 d2 p2 (/ (+ hmin hmax) 2)))))))
+
+(defund p4 (dmin pmin dmax pmax hmin hmax)
+  (let ((d1 (d1 dmin pmin dmax pmax hmax))
+        (p1 (p1 dmin pmin dmax pmax hmax)))
+    (if (> p1 (* hmin d1))
+        p1
+      (let ((d2 (d2 dmin pmin dmax pmax hmin))
+            (p2 (p2 dmin pmin dmax pmax hmin)))
+        (if (< p2 (* hmax d2))
+            p2
+          (p3 d1 p1 d2 p2 (/ (+ hmin hmax) 2)))))))
+
+;; Suppose that admissible-div-table-p rho m n table) = NIL.
+;; Let i = (i-witness rho m n table), j = (j-witness rho m n table),
+;; and entry = (lookup i j table).
+;; Then 0 <= i < 2^m, 0 <= j < 2^n, and
+;; (check-div-entry i j rho m n entry) = NIL.
+;; Let d = (d-witness rho m n table) and p = (p-witness rho m n table).
+;; Then (d,p) is in S_ij and |p| <= d.
+;; If -2^rho < entry < 2^rho, then |2^rho * p - entry * d| > d:
+
+(defund i-witness-aux (i rho m n table)
+  (if (zp i)
+      ()
+    (if (check-div-row (1- i) (expt 2 n) rho m n (nth (1- i) table))
+        (i-witness-aux (1- i) rho m n table)
+      (1- i))))
+ 
+(defund i-witness (rho m n table)
+  (i-witness-aux (expt 2 m) rho m n table))
+
+(defund j-witness-aux (i j rho m n row)
+  (if (zp j)
+      ()
+    (if (check-div-entry i (1- j) rho m n (ifix (nth (1- j) row)))
+        (j-witness-aux i (1- j) rho m n row)
+      (1- j))))
+
+(defund j-witness (rho m n table)
+  (let ((i (i-witness rho m n table)))
+    (j-witness-aux i (expt 2 n) rho m n (nth i table))))
+
+(defund d-witness (rho m n table)
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (entry (lookup i j table)))
+    (if (or (>= entry (expt 2 rho))
+            (<= entry (- (expt 2 rho))))
+        (d4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            1)
+      (if (< entry (lower i j rho m n))
+          (d4 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              (/ (1+ entry) (expt 2 rho))
+              1)
+        (d4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            (/ (1- entry) (expt 2 rho)))))))
+
+(defund p-witness (rho m n table)
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (entry (lookup i j table)))
+    (if (or (>= entry (expt 2 rho))
+            (<= entry (- (expt 2 rho))))
+        (p4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            1)
+      (if (< entry (lower i j rho m n))
+          (p4 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              (/ (1+ entry) (expt 2 rho))
+              1)
+        (p4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            (/ (1- entry) (expt 2 rho)))))))
+
+(local-defthm converse-1
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h) (= h 0)
+                (< p (* h d)))
+           (let ((d1 (d1 dmin pmin dmax pmax h))
+                 (p1 (p1 dmin pmin dmax pmax h)))
+             (and (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax))))
+;                  (< p1 (* h d1)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d1 p1))))
+
+(local-defthm converse-2
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h) 
+                (not (= h 0))
+                (< pmin (* h dmin))
+                (< p (* h d)))
+           (let ((d1 (d1 dmin pmin dmax pmax h))
+                 (p1 (p1 dmin pmin dmax pmax h)))
+             (and (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (< d1 dmax)
+                  (<= pmin p1)
+                  (< p1 pmax))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d1 p1))))
+
+(local-defthm converse-3
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h) 
+                (not (= h 0))
+                (< h 0)
+                (< p (* h d)))
+           (<= (* d h) (* h dmin)))
+  :rule-classes ())
+
+(local-defthm converse-4
+  (implies (and (rationalp a1)
+                (rationalp a2)
+                (rationalp a3)
+                (rationalp a4)
+                (<= a1 a2)
+                (< a2 a3)
+                (<= a3 a4))
+           (< a1 a4))
+  :rule-classes ())
+
+(local-defthm converse-5
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h) 
+                (not (= h 0))
+                (< h 0)
+                (< p (* h d)))
+           (< pmin (* h dmin)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-3
+                        (:instance converse-4 (a1 pmin) (a2 p) (a3 (* h d)) (a4 (* h dmin)))))))
+
+(local-defthm converse-6
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (>= pmin (* h dmin))
+                (> h 0)
+                (< p (* h d)))
+           (let ((d1 (/ (+ (/ pmin h) dmax) 2)))
+             (and (rationalp d1)
+                  (< pmin (* h d1)))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-4 (a1 pmin) (a2 p) (a3 (* h d)) (a4 (* h dmax))))))
+
+(local-defthm converse-7
+  (implies (and (rationalp a1)
+                (rationalp a2)
+                (rationalp a3)
+                (<= a1 a2)
+                (< a1 a3))
+           (< a1 (/ (+ a2 a3) 2)))
+  :rule-classes ())
+
+(local-defthm converse-8 
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp h)
+                (> h 0))
+           (iff (< (* pmin h) (* dmin h))
+                (< pmin dmin)))
+  :rule-classes ())
+
+(local-defthm converse-9
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp h)
+                (> h 0))
+            (iff (< (/ pmin h) dmin)
+                 (< pmin (* dmin h))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-8 (pmin (/ pmin h))))))
+
+(local-defthm converse-10
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (>= pmin (* h dmin))
+                (> h 0)
+                (< p (* h d)))
+           (let ((d1 (/ (+ (/ pmin h) dmax) 2)))
+             (<= dmin d1)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-9
+                        (:instance converse-7 (a1 dmin) (a2 (/ pmin h)) (a3 dmax))))))
+
+(local-defthm converse-11
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (>= pmin (* h dmin))
+                (> h 0)
+                (< p (* h d)))
+           (< pmin (* h dmax)))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-4 (a1 pmin) (a2 p) (a3 (* h d)) (a4 (* h dmax))))))
+
+(local-defthm converse-12
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (>= pmin (* h dmin))
+                (> h 0)
+                (< p (* h d)))
+           (< (/ pmin h) dmax))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-11
+                        (:instance converse-9 (dmin dmax))))))
+
+(local-defthm converse-13
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (>= pmin (* h dmin))
+                (> h 0)
+                (< p (* h d)))
+           (let ((d1 (/ (+ (/ pmin h) dmax) 2)))
+             (< d1 dmax)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-12))))
+
+(defthm d1-p1-lemma
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (< p (* h d)))
+           (let ((d1 (d1 dmin pmin dmax pmax h))
+                 (p1 (p1 dmin pmin dmax pmax h)))
+             (and (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (< d1 dmax)
+                  (<= pmin p1)
+                  (< p1 pmax)
+                  (< p1 (* h d1)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d1 p1)
+                  :use (converse-1 converse-2 converse-5 converse-6 converse-10 converse-13))))
+
+(local-defthm converse-14
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d))
+                (> pmax (* h dmin)))
+           (let ((d2 (d2 dmin pmin dmax pmax h)))
+             (and (rationalp d2)
+                  (<= dmin d2)
+                  (< d2 dmax)
+                  (> pmax (* h d2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d2))))
+
+(local-defthm converse-15
+  (implies (and (rationalp a1)
+                (rationalp a2)
+                (rationalp a3)
+                (rationalp a4)
+                (<= a1 a2)
+                (<= a2 a3)
+                (<= a3 a4))
+           (<= a1 a4))
+  :rule-classes ())
+
+(local-defthm converse-16
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d))
+                (<= pmax (* h dmin)))
+           (< h 0))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-15 (a1 p) (a2 pmax) (a3 (* h dmin)) (a4 (* h d))))))
+
+(local-defthm converse-17
+  (implies (and (rationalp pmax)
+                (rationalp dmin)
+                (rationalp h)
+                (< h 0))
+           (iff (<= pmax dmin)
+                (>= (* pmax h) (* dmin h))))
+  :rule-classes ())
+
+(local-defthm converse-18
+  (implies (and (rationalp pmax)
+                (rationalp dmin)
+                (rationalp h)
+                (< h 0))
+           (iff (<= pmax (* h dmin))
+                (>= (/ pmax h) dmin)))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-17 (dmin (* h dmin)) (h (/ h))))))
+
+(local-defthm converse-19
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d))
+                (<= pmax (* h dmin))
+                (< h 0))
+           (let ((d2 (/ (+ (/ pmax h) dmax) 2)))
+             (and (rationalp d2)
+                  (< dmin d2))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-18
+                        (:instance converse-7 (a1 dmin) (a2 (/ pmax h)) (a3 dmax))))))
+
+(local-defthm converse-20
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d))
+                (<= pmax (* h dmin))
+                (< h 0))
+           (> pmax (* h dmax)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-4 (a1 (* h dmax)) (a2 (* h d)) (a3 p) (a4 pmax))))))
+
+(local-defthm converse-21
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d))
+                (<= pmax (* h dmin))
+                (< h 0))
+           (< (/ pmax h) dmax))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-20
+                        (:instance converse-18 (dmin dmax))))))
+
+(local-defthm converse-22
+  (implies (and (rationalp a1)
+                (rationalp a2)
+                (rationalp a3)
+                (>= a1 a2)
+                (> a1 a3))
+           (> a1 (/ (+ a2 a3) 2)))
+  :rule-classes ())
+
+(local-defthm converse-23
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d))
+                (<= pmax (* h dmin))
+                (< h 0))
+           (let ((d2 (d2 dmin pmin dmax pmax h)))
+             (and (rationalp d2)
+                  (< dmin d2)
+                  (< d2 dmax))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d2)
+                  :use (converse-21
+                        converse-19
+                        (:instance converse-22 (a1 dmax) (a2 dmax) (a3 (/ pmax h)))))))
+
+(local-defthm converse-24
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d))
+                (<= pmax (* h dmin))
+                (< h 0))
+           (let ((d2 (d2 dmin pmin dmax pmax h)))
+             (and (rationalp d2)
+                  (< dmin d2)
+                  (< d2 dmax)
+                  (> pmax (* h d2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d2)
+                  :use (converse-21
+                        converse-23
+                        (:instance converse-17 (pmax (d2 dmin pmin dmax pmax h)) (dmin (/ pmax h)))
+                        (:instance converse-7 (a1 (/ pmax h)) (a2 (/ pmax h)) (a3 dmax))))))
+
+(local-defthm converse-25
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d)))
+           (let ((d2 (d2 dmin pmin dmax pmax h)))
+             (and (rationalp d2)
+                  (<= dmin d2)
+                  (< d2 dmax)
+                  (> pmax (* h d2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d2 p2)
+                  :use (converse-24 converse-14 converse-16))))
+
+(local-defthm converse-26
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d)))
+           (let ((d2 (d2 dmin pmin dmax pmax h))
+                 (p2 (p2 dmin pmin dmax pmax h)))
+             (implies (> pmin (* h d2))
+                      (and (rationalp p2)
+                           (<= pmin p2)
+                           (< p2 pmax)
+                           (> p2 (* h d2))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable p2)
+                  :use (converse-25))))
+
+(local-defthm converse-27
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d))
+                (rationalp d2)
+                (<= dmin d2)
+                (< d2 dmax)
+                (> pmax (* h d2))
+                (<= pmin (* h d2)))
+           (let ((p2 (/ (+ (* h d2) pmax) 2)))
+             (and (rationalp p2)
+                  (<= pmin p2)
+                  (< p2 pmax)
+                  (> p2 (* h d2)))))
+  :rule-classes ())
+
+(defthm d2-p2-lemma
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (> p (* h d)))
+           (let ((d2 (d2 dmin pmin dmax pmax h))
+                 (p2 (p2 dmin pmin dmax pmax h)))
+             (and (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (< d2 dmax)
+                  (<= pmin p2)
+                  (< p2 pmax)
+                  (> p2 (* h d2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable p2)
+                  :use (converse-27 converse-26 converse-25))))
+
+(local-defthm converse-28
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d1)
+                (rationalp p1)
+                (rationalp d2)
+                (rationalp p2)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d1)
+                (< d1 dmax)
+                (<= pmin p1)
+                (< p1 pmax)
+                (<= dmin d2)
+                (<= d2 dmax)
+                (<= pmin p2)
+                (<= p2 pmax)
+                (rationalp h)
+                (< p1 (* h d1))
+                (> p2 (* h d2))
+                (= h 0))
+           (let ((d3 (d3 d1 p1 d2 p2 h))
+                 (p3 (p3 d1 p1 d2 p2 h)))
+             (and (rationalp d3)
+                  (rationalp p3)
+                  (<= dmin d3)
+                  (< d3 dmax)
+                  (<= pmin p3)
+                  (< p3 pmax)
+                  (= p3 (* h d3)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d3 p3))))
+
+(local-defthm converse-29
+  (implies (and (rationalp p)
+                (rationalp h)
+                (rationalp d)
+                (not (= h 0)))
+           (if (> h 0)
+               (and (iff (> (* h a) (* h b))
+                         (> a b))
+                    (iff (< (* h a) (* h b))
+                         (< a b)))
+             (and (iff (> (* h a) (* h b))
+                       (< a b))
+                  (iff (< (* h a) (* h b))
+                       (> a b)))))
+  :rule-classes ())
+
+(local-defthm converse-30
+  (implies (and (rationalp p)
+                (rationalp h)
+                (rationalp d)
+                (not (= h 0)))
+           (if (> h 0)
+               (and (iff (> p (* h d))
+                         (> (/ p h) d))
+                    (iff (< p (* h d))
+                         (< (/ p h) d)))
+             (and (iff (> p (* h d))
+                       (< (/ p h) d))
+                  (iff (< p (* h d))
+                       (> (/ p h) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-29 (a (/ p h)) (b d)))))
+
+(local-defthm converse-31
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d1)
+                (rationalp p1)
+                (rationalp d2)
+                (rationalp p2)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d1)
+                (< d1 dmax)
+                (<= pmin p1)
+                (< p1 pmax)
+                (<= dmin d2)
+                (< d2 dmax)
+                (<= pmin p2)
+                (< p2 pmax)
+                (rationalp h)
+                (< p1 (* h d1))
+                (> p2 (* h d2))
+                (not (= h 0))
+                (<= p1 p2))
+           (let ((d3 (d3 d1 p1 d2 p2 h))
+                 (p3 (p3 d1 p1 d2 p2 h)))
+             (and (rationalp d3)
+                  (rationalp p3)
+                  (<= dmin d3)
+                  (< d3 dmax)
+                  (<= pmin p3)
+                  (< p3 pmax)
+                  (= p3 (* h d3)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d3 p3)
+                  :use ((:instance converse-30 (p p2) (d d1))
+                        (:instance converse-30 (p p2) (d d2))))))
+
+(local-defthm converse-32
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d1)
+                (rationalp p1)
+                (rationalp d2)
+                (rationalp p2)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d1)
+                (< d1 dmax)
+                (<= pmin p1)
+                (< p1 pmax)
+                (<= dmin d2)
+                (< d2 dmax)
+                (<= pmin p2)
+                (< p2 pmax)
+                (rationalp h)
+                (< p1 (* h d1))
+                (> p2 (* h d2))
+                (not (= h 0))
+                (> p1 p2))
+           (let ((d3 (d3 d1 p1 d2 p2 h))
+                 (p3 (p3 d1 p1 d2 p2 h)))
+             (and (rationalp d3)
+                  (rationalp p3)
+                  (<= dmin d3)
+                  (< d3 dmax)
+                  (<= pmin p3)
+                  (< p3 pmax)
+                  (= p3 (* h d3)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d3 p3)
+                  :use ((:instance converse-30 (p p1) (d d1))
+                        (:instance converse-30 (p p1) (d d2))))))
+
+(defthm d3-p3-lemma
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d1)
+                (rationalp p1)
+                (rationalp d2)
+                (rationalp p2)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d1)
+                (< d1 dmax)
+                (<= pmin p1)
+                (< p1 pmax)
+                (<= dmin d2)
+                (< d2 dmax)
+                (<= pmin p2)
+                (< p2 pmax)
+                (rationalp h)
+                (< p1 (* h d1))
+                (> p2 (* h d2)))
+           (let ((d3 (d3 d1 p1 d2 p2 h))
+                 (p3 (p3 d1 p1 d2 p2 h)))
+             (and (rationalp d3)
+                  (rationalp p3)
+                  (<= dmin d3)
+                  (< d3 dmax)
+                  (<= pmin p3)
+                  (< p3 pmax)
+                  (= p3 (* h d3)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-28 converse-31 converse-32))))
+
+(defthm d4-p4-lemma
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d1)
+                (rationalp p1)
+                (rationalp d2)
+                (rationalp p2)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d1)
+                (<= d1 dmax)
+                (<= pmin p1)
+                (<= p1 pmax)
+                (<= dmin d2)
+                (<= d2 dmax)
+                (<= pmin p2)
+                (<= p2 pmax)
+                (rationalp hmax)
+                (rationalp hmin)
+                (< hmin hmax)
+                (< p1 (* hmax d1))
+                (> p2 (* hmin d2)))
+           (let ((d4 (d4 dmin pmin dmax pmax hmin hmax))
+                 (p4 (p4 dmin pmin dmax pmax hmin hmax)))
+             (and (rationalp d4)
+                  (rationalp p4)
+                  (<= dmin d4)
+                  (< d4 dmax)
+                  (<= pmin p4)
+                  (< p4 pmax)
+                  (< p4 (* hmax d4))
+                  (> p4 (* hmin d4)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d4 p4)
+                  :use ((:instance d1-p1-lemma (d d1) (p p1) (h hmax))
+                        (:instance d2-p2-lemma (d d2) (p p2) (h hmin))
+                        (:instance d3-p3-lemma (d1 (d1 dmin pmin dmax pmax hmax))
+                                               (p1 (p1 dmin pmin dmax pmax hmax))
+                                               (d2 (d2 dmin pmin dmax pmax hmin))
+                                               (p2 (p2 dmin pmin dmax pmax hmin))
+                                               (h (/ (+ hmin hmax) 2)))))))
+
+
+
+(local-defthm converse-33
+  (implies (and (natp i)
+                (not (check-div-rows i rho m n table)))
+           (let ((w (i-witness-aux i rho m n table)))
+             (and (natp w)
+                  (< w i)
+                  (not (check-div-row w (expt 2 n) rho m n (nth w table))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable i-witness-aux check-div-rows))))
+
+(local-defthm converse-34
+  (implies (and (natp m)
+                (not (admissible-div-table-p rho m n table)))
+           (let ((i (i-witness rho m n table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (not (check-div-row i (expt 2 n) rho m n (nth i table))))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-33 (i (expt 2 m)))
+                  :in-theory (enable i-witness admissible-div-table-p))))
+
+(local-defthm converse-35
+  (implies (and (natp j)
+                (not (check-div-row i j rho m n row)))
+           (let ((w (j-witness-aux i j rho m n row)))
+             (and (natp w)
+                  (< w j)
+                  (not (check-div-entry i w rho m n (ifix (nth w row)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable j-witness-aux check-div-row))))
+
+(defthm div-witness-lemma
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (admissible-div-table-p rho m n table)))
+           (let* ((i (i-witness rho m n table))
+                  (j (j-witness rho m n table))
+                  (k (lookup i j table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (not (and (< (- (expt 2 rho)) k)
+                            (< k (expt 2 rho))
+                            (>= k (lower i j rho m n))
+                            (<= k (upper i j rho m n)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-34
+                        (:instance converse-35 (i (i-witness rho m n table)) 
+                                               (j (expt 2 n)) 
+                                               (row (nth (i-witness rho m n table) table))))
+                  :in-theory (enable lookup check-div-entry j-witness))))
+
+(local-defthm converse-37
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (< k (expt 2 rho))
+                (not (check-div-entry i j rho m n k)))
+           (and (< (- (- (delta0 j n)) (+ (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+                   (pi0 i m))
+                (< (pi0 i m)
+                   (+ (delta0 j n) (/ (expt 2 n))))
+                (or (< k (lower i j rho m n))
+                    (> k (upper i j rho m n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-div-entry div-accessible-p))))
+
+(local-defthm converse-38
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (< k (lower i j rho m n)))
+           (and (< k (1- (expt 2 rho)))
+                (or (< (1+ k) 
+                       (cg (* (expt 2 rho) 
+                              (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                 (delta0 j n)))))
+                    (< (1+ k)
+                       (cg (* (expt 2 rho) 
+                              (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                 (+ (delta0 j n) (/ (expt 2 n))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lower))))
+
+(local-defthm converse-39
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (and (rationalp (delta0 j n))
+                (rationalp (pi0 i m))
+                (>= (delta0 j n) 1)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable delta0 pi0))))
+
+(local-defthm converse-40
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (< k (lower i j rho m n)))
+           (or (< (1+ k) 
+                  (* (expt 2 rho) 
+                     (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                        (delta0 j n))))
+               (< (1+ k)
+                  (* (expt 2 rho) 
+                     (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                        (+ (delta0 j n) (/ (expt 2 n))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-38
+                        converse-39
+                        (:instance cg-unique 
+                                   (x (* (expt 2 rho) 
+                                         (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                            (+ (delta0 j n) (/ (expt 2 n))))))
+                                   (n (1+ k)))
+                        (:instance cg-unique 
+                                   (x (* (expt 2 rho) 
+                                         (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                            (+ (delta0 j n)))))
+                                   (n (1+ k)))))))
+
+(local-defthm converse-41
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (1+ k) 
+                  (* (expt 2 rho) 
+                     (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                        (delta0 j n)))))
+           (< (* (/ (1+ k) (expt 2 rho)) (delta0 j n))
+              (+ (pi0 i m) (/ (expt 2 (- m 3))))))           
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance converse-8
+                                   (pmin (1+ k))
+                                   (h (/ (delta0 j n) (expt 2 rho)))
+                                   (dmin (* (expt 2 rho) 
+                                            (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                               (delta0 j n)))))))))
+
+(local-defthm converse-42
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (rationalp x)
+                (> x 0)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (1+ k) 
+                  (* (expt 2 rho) 
+                     (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                        x))))
+           (< (* (/ (1+ k) (expt 2 rho)) x)
+              (+ (pi0 i m) (/ (expt 2 (- m 3))))))      
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance converse-8
+                                   (pmin (1+ k))
+                                   (h (/ x (expt 2 rho)))
+                                   (dmin (* (expt 2 rho) 
+                                            (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                               x))))))))
+
+(local-defthm converse-43
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (1+ k) 
+                  (* (expt 2 rho) 
+                     (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                        (+ (delta0 j n) (/ (expt 2 n)))))))
+           (< (* (/ (1+ k) (expt 2 rho)) (+ (delta0 j n) (/ (expt 2 n))))
+              (+ (pi0 i m) (/ (expt 2 (- m 3))))))      
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance converse-42 (x (+ (delta0 j n) (/ (expt 2 n)))))))))
+
+(local-defthm converse-44
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (< k (lower i j rho m n)))
+           (and (< k (1- (expt 2 rho))           )
+                (or (< (* (/ (1+ k) (expt 2 rho)) (delta0 j n))
+                       (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                    (< (* (/ (1+ k) (expt 2 rho)) (+ (delta0 j n) (/ (expt 2 n))))
+                       (+ (pi0 i m) (/ (expt 2 (- m 3))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-38
+                        converse-40
+                        converse-41
+                        converse-43))))
+
+(local-defthm converse-45
+  (implies (and (integerp rho)
+                (integerp k)
+                (< k (1- (expt 2 rho))))
+           (< (/ (1+ k) (expt 2 rho)) 1))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-8 (pmin (/ (1+ k) (expt 2 rho))) (dmin 1) (h (expt 2 rho)))))))
+
+(local-defthm converse-46
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (< (- (expt 2 rho)) k)
+                  (< k (1- (expt 2 rho)))
+                  (< k (lower i j rho m n))
+                  (< k (expt 2 rho))
+                  (< (* (/ (1+ k) (expt 2 rho)) (delta0 j n))
+                     (+ (pi0 i m) (/ (expt 2 (- m 3))))))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (< p d)
+                  (> p (* (/ (1+ k) (expt 2 rho)) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-45 (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))
+                        (:instance converse-39 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table)))
+                        (:instance d4-p4-lemma (dmin (delta0 (j-witness rho m n table) n))
+                                               (dmax (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                               (pmin (pi0 (i-witness rho m n table) m))
+                                               (pmax (+ (pi0 (i-witness rho m n table) m) (expt 2 (- 3 m))))
+                                               (d1 (+ (delta0 (j-witness rho m n table) n) (/ (expt 2 n))))
+                                               (p1 (pi0 (i-witness rho m n table) m))
+                                               (d2 (delta0 (j-witness rho m n table) n))
+                                               (p2 (+ (pi0 (i-witness rho m n table) m) (/ (expt 2 (- m 3)))))
+                                               (hmin (/ (1+ (lookup (i-witness rho m n table) (j-witness rho m n table) table))
+                                                        (expt 2 rho)))
+                                               (hmax 1)))
+                  :in-theory (enable div-accessible-p d-witness p-witness))))
+
+(local-defthm converse-47
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (< (- (expt 2 rho)) k)
+                  (< k (1- (expt 2 rho)))
+                  (< k (lower i j rho m n))
+                  (< k (expt 2 rho))
+                  (< (* (/ (1+ k) (expt 2 rho)) (+ (delta0 j n) (/ (expt 2 n))))
+                     (+ (pi0 i m) (/ (expt 2 (- m 3))))))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (< p d)
+                  (> p (* (/ (1+ k) (expt 2 rho)) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-45 (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))
+                        (:instance converse-39 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table)))
+                        (:instance d4-p4-lemma (dmin (delta0 (j-witness rho m n table) n))
+                                               (dmax (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                               (pmin (pi0 (i-witness rho m n table) m))
+                                               (pmax (+ (pi0 (i-witness rho m n table) m) (expt 2 (- 3 m))))
+                                               (d1 (+ (delta0 (j-witness rho m n table) n) (/ (expt 2 n))))
+                                               (p1 (pi0 (i-witness rho m n table) m))
+                                               (d2 (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                               (p2 (+ (pi0 (i-witness rho m n table) m) (/ (expt 2 (- m 3)))))
+                                               (hmin (/ (1+ (lookup (i-witness rho m n table) (j-witness rho m n table) table))
+                                                        (expt 2 rho)))
+                                               (hmax 1)))
+                  :in-theory (enable div-accessible-p d-witness p-witness))))
+
+(local-defthm converse-48
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (< (- (expt 2 rho)) k)
+                  (< k (expt 2 rho))
+                  (< k (lower i j rho m n)))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (< p d)
+                  (> p (* (/ (1+ k) (expt 2 rho)) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-46 
+                        converse-47
+                        (:instance converse-44 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table))
+                                               (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))))))
+
+(local-defthm converse-49
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (> (expt 2 rho) k)
+                (> k (upper i j rho m n)))
+           (and (> k (- 1 (expt 2 rho)))
+                (or (> (1- k) 
+                       (fl (* (expt 2 rho) 
+                              (/ (pi0 i m)
+                                 (delta0 j n)))))
+                    (> (1- k)
+                       (fl (* (expt 2 rho) 
+                              (/ (pi0 i m)
+                                 (+ (delta0 j n) (/ (expt 2 n))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39)
+                  :in-theory (enable upper))))
+
+(local-defthm converse-50
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (> (expt 2 rho) k)
+                (> k (upper i j rho m n)))
+           (and (> k (- 1 (expt 2 rho)))
+                (or (> (1- k) 
+                       (* (expt 2 rho) 
+                          (/ (pi0 i m)
+                             (delta0 j n))))
+                    (> (1- k)
+                       (* (expt 2 rho) 
+                          (/ (pi0 i m)
+                             (+ (delta0 j n) (/ (expt 2 n)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        converse-49
+                        (:instance fl-unique 
+                                   (x (* (expt 2 rho) 
+                                         (/ (pi0 i m)
+                                            (+ (delta0 j n) (/ (expt 2 n))))))
+                                   (n (1- k)))
+                        (:instance fl-unique 
+                                   (x (* (expt 2 rho) 
+                                         (/ (pi0 i m)
+                                            (+ (delta0 j n)))))
+                                   (n (1- k)))))))
+
+(local-defthm converse-51
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (> (1- k) 
+                   (* (expt 2 rho) 
+                      (/ (pi0 i m)
+                         (delta0 j n)))))
+           (> (* (/ (1- k) (expt 2 rho)) (delta0 j n))
+              (pi0 i m)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance converse-8
+                                   (dmin (1- k))
+                                   (h (/ (delta0 j n) (expt 2 rho)))
+                                   (pmin (* (expt 2 rho) 
+                                            (/ (pi0 i m)
+                                               (delta0 j n)))))))))
+
+(local-defthm converse-52
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (> (1- k) 
+                   (* (expt 2 rho) 
+                      (/ (pi0 i m)
+                         (+ (delta0 j n) (expt 2 (- n)))))))
+           (> (* (/ (1- k) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n))))
+              (pi0 i m)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance converse-8
+                                   (dmin (1- k))
+                                   (h (/ (+ (delta0 j n) (expt 2 (- n))) (expt 2 rho)))
+                                   (pmin (* (expt 2 rho) 
+                                            (/ (pi0 i m)
+                                               (+ (delta0 j n) (expt 2 (- n)))))))))))
+
+(local-defthm converse-53
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (> (expt 2 rho) k)
+                (> k (upper i j rho m n)))
+           (and (> k (- 1 (expt 2 rho))           )
+                (or (> (* (/ (1- k) (expt 2 rho)) (delta0 j n))
+                       (pi0 i m))
+                    (> (* (/ (1- k) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n))))
+                       (pi0 i m)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-50
+                        converse-51
+                        converse-52))))
+
+(local-defthm converse-54
+  (implies (and (integerp rho)
+                (integerp k)
+                (> k (- 1 (expt 2 rho))))
+           (> (/ (1- k) (expt 2 rho)) -1))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-8 (dmin (/ (1- k) (expt 2 rho))) (pmin -1) (h (expt 2 rho)))))))
+
+(local-defthm converse-55
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (> k (- 1 (expt 2 rho)))
+                  (>= k (lower i j rho m n))
+                  (< k (expt 2 rho))
+                  (> (* (/ (1- k) (expt 2 rho)) (delta0 j n))
+                     (pi0 i m)))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (> p (- d))
+                  (< p (* (/ (1- k) (expt 2 rho)) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-54 (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))
+                        (:instance converse-39 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table)))
+                        (:instance d4-p4-lemma (dmin (delta0 (j-witness rho m n table) n))
+                                               (dmax (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                               (pmin (pi0 (i-witness rho m n table) m))
+                                               (pmax (+ (pi0 (i-witness rho m n table) m) (expt 2 (- 3 m))))
+                                               (d2 (+ (delta0 (j-witness rho m n table) n) (/ (expt 2 n))))
+                                               (p2 (+ (pi0 (i-witness rho m n table) m) (expt 2 (- 3 m))))
+                                               (d1 (delta0 (j-witness rho m n table) n))
+                                               (p1 (pi0 (i-witness rho m n table) m))
+                                               (hmax (/ (1- (lookup (i-witness rho m n table) (j-witness rho m n table) table))
+                                                        (expt 2 rho)))
+                                               (hmin -1)))
+                  :in-theory (enable div-accessible-p d-witness p-witness))))
+
+(local-defthm converse-56
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (> k (- 1 (expt 2 rho)))
+                  (>= k (lower i j rho m n))
+                  (< k (expt 2 rho))
+                  (> (* (/ (1- k) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n))))
+                     (pi0 i m)))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (> p (- d))
+                  (< p (* (/ (1- k) (expt 2 rho)) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-54 (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))
+                        (:instance converse-39 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table)))
+                        (:instance d4-p4-lemma (dmin (delta0 (j-witness rho m n table) n))
+                                               (dmax (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                               (pmin (pi0 (i-witness rho m n table) m))
+                                               (pmax (+ (pi0 (i-witness rho m n table) m) (expt 2 (- 3 m))))
+                                               (d2 (+ (delta0 (j-witness rho m n table) n) (/ (expt 2 n))))
+                                               (p2 (+ (pi0 (i-witness rho m n table) m) (expt 2 (- 3 m))))
+                                               (d1 (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                               (p1 (pi0 (i-witness rho m n table) m))
+                                               (hmax (/ (1- (lookup (i-witness rho m n table) (j-witness rho m n table) table))
+                                                        (expt 2 rho)))
+                                               (hmin -1)))
+                  :in-theory (enable div-accessible-p d-witness p-witness))))
+
+(local-defthm converse-57
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (< (- (expt 2 rho)) k)
+                  (< k (expt 2 rho))
+                  (>= k (lower i j rho m n))
+                  (> k (upper i j rho m n)))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (> p (- d))
+                  (< p (* (/ (1- k) (expt 2 rho)) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-55 
+                        converse-56
+                        (:instance converse-53 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table))
+                                               (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))))))
+
+(local-defthm converse-58
+  (implies (and (integerp a)
+                (not (zp b))
+                (rationalp d)
+                (> d 0)
+                (< a b))
+           (< (* (/ a b) d) d))
+  :rule-classes ())
+
+(local-defthm converse-59
+  (implies (and (rationalp d)
+                (rationalp p)
+                (< 0 d)
+                (not (zp b))
+                (integerp a)
+                (< a b)
+                (< p (* (/ a b) d)))
+            (< p d))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable simplify-products-gather-exponents-<)
+                  :use (converse-58))))
+
+(local-defthm converse-60
+  (implies (and (rationalp d)
+                (rationalp p)
+                (< 0 d)
+                (> p (- d))
+                (natp rho)
+                (integerp k)
+                (< k (expt 2 rho))
+                (< p (* (/ (1- k) (expt 2 rho)) d)))
+            (< (abs p) d))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable abs)
+                  :use ((:instance converse-59 (a (1- k)) (b (expt 2 rho)))))))
+
+(local-defthm converse-61
+  (implies (and (rationalp d)
+                (rationalp p)
+                (natp rho)
+                (integerp k)
+                (< k (expt 2 rho))
+                (< p (* (/ (1- k) (expt 2 rho)) d)))
+            (> (abs (- (* (expt 2 rho) p) (* k d))) d))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-8 (pmin p) (dmin (* (/ (1- k) (expt 2 rho)) d)) (h (expt 2 rho)))))))
+
+(local-defthm converse-62
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (< (- (expt 2 rho)) k)
+                  (< k (expt 2 rho))
+                  (>= k (lower i j rho m n))
+                  (> k (upper i j rho m n)))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (< (abs p) d)
+                  (> (abs (- (* (expt 2 rho) p) (* k d))) d))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-57
+                        (:instance converse-39 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table)))
+                        (:instance converse-60 (p (p-witness rho m n table))
+                                               (d (d-witness rho m n table))
+                                               (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))
+                        (:instance converse-61 (p (p-witness rho m n table))
+                                               (d (d-witness rho m n table))
+                                               (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))))))
+
+(local-defthm converse-63
+  (implies (and (integerp a)
+                (not (zp b))
+                (rationalp d)
+                (> d 0)
+                (> a (- b)))
+           (> (* (/ a b) d) (- d)))
+  :rule-classes ())
+
+(local-defthm converse-64
+  (implies (and (rationalp d)
+                (rationalp p)
+                (< 0 d)
+                (not (zp b))
+                (integerp a)
+                (> a (- b))
+                (> p (* (/ a b) d)))
+            (> p (- d)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable simplify-products-gather-exponents-<)
+                  :use (converse-63))))
+
+(local-defthm converse-65
+  (implies (and (rationalp d)
+                (rationalp p)
+                (< 0 d)
+                (< p d)
+                (natp rho)
+                (integerp k)
+                (> k (- (expt 2 rho)))
+                (> p (* (/ (1+ k) (expt 2 rho)) d)))
+            (< (abs p) d))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable abs)
+                  :use ((:instance converse-64 (a (1+ k)) (b (expt 2 rho)))))))
+
+(local-defthm converse-66
+  (implies (and (rationalp d)
+                (rationalp p)
+                (natp rho)
+                (integerp k)
+                (> k (- (expt 2 rho)))
+                (> p (* (/ (1+ k) (expt 2 rho)) d)))
+            (> (abs (- (* (expt 2 rho) p) (* k d))) d))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-8 (dmin p) (pmin (* (/ (1+ k) (expt 2 rho)) d)) (h (expt 2 rho)))))))
+
+(local-defthm converse-67
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (< (- (expt 2 rho)) k)
+                  (< k (expt 2 rho))
+                  (< k (lower i j rho m n)))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (< (abs p) d)
+                  (> (abs (- (* (expt 2 rho) p) (* k d))) d))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-48
+                        (:instance converse-39 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table)))
+                        (:instance converse-65 (p (p-witness rho m n table))
+                                               (d (d-witness rho m n table))
+                                               (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))
+                        (:instance converse-66 (p (p-witness rho m n table))
+                                               (d (d-witness rho m n table))
+                                               (k (lookup (i-witness rho m n table) (j-witness rho m n table) table)))))))
+
+(local-defthm converse-68
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (d (d-witness rho m n table))
+         (p (p-witness rho m n table))
+         (k (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (div-accessible-p i j m n)
+                  (not (and (< (- (expt 2 rho)) k)
+                            (< k (expt 2 rho)))))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (< (abs p) d))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d-witness p-witness div-accessible-p)
+                  :use ((:instance converse-39 (i (i-witness rho m n table))
+                                               (j (j-witness rho m n table)))
+                        (:instance d4-p4-lemma 
+                                   (dmin (delta0 (j-witness rho m n table) n))
+                                   (dmax (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                   (pmin (pi0 (i-witness rho m n table) m))
+                                   (pmax (+ (pi0 (i-witness rho m n table) m) (expt 2 (- 3 m))))
+                                   (d1 (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                   (p1 (pi0 (i-witness rho m n table) m))
+                                   (d2 (+ (delta0 (j-witness rho m n table) n) (expt 2 (- n))))
+                                   (p2 (+ (pi0 (i-witness rho m n table) m) (expt 2 (- 3 m))))
+                                   (hmin -1)
+                                   (hmax 1))))))
+
+(defthm lemma-2-2-converse
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (not (admissible-div-table-p rho m n table)))
+             (let* ((i (i-witness rho m n table))
+                    (j (j-witness rho m n table))
+                    (p (p-witness rho m n table))
+                    (d (d-witness rho m n table))
+                    (k (lookup i j table)))
+               (and (natp i)
+                    (< i (expt 2 m))
+                    (natp j)
+                    (< j (expt 2 n))
+                    (rationalp d)
+                    (rationalp p)
+                    (< (abs p) d)
+                    (<= (delta0 j n) d)
+                    (< d (+ (delta0 j n) (/ (expt 2 n))))
+                    (<= (pi0 i m) p)
+                    (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                    (or (<= k (- (expt 2 rho)))
+                        (>= k (expt 2 rho))
+                        (> (abs (- (* (expt 2 rho) p) (* d k))) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use (div-witness-lemma converse-62 converse-67 converse-68))))
+
+
+
+;;**********************************************************************************
+
+(defund srt-entry (i j rho m n)
+  (max (- 1 (expt 2 rho)) 
+       (lower i j rho m n)))
+
+(defund srt-row (i j rho m n)
+  (declare (xargs :measure (nfix (- (expt 2 n) j))))
+  (if (and (natp j)
+           (natp n)
+           (< j (expt 2 n)))
+      (cons (srt-entry i j rho m n)
+            (srt-row i (1+ j) rho m n))
+    ()))
+
+(defund srt-rows (i rho m n)
+  (declare (xargs :measure (nfix (- (expt 2 m) i))))
+  (if (and (natp i)
+           (natp m)
+           (< i (expt 2 m)))
+      (cons (srt-row i 0 rho m n)
+            (srt-rows (1+ i) rho m n))
+    ()))
+
+(defund srt-table (rho m n)
+  (srt-rows 0 rho m n))
+
+(defthm admissible-div-table-p-2-5-2
+  (admissible-div-table-p 2 5 2 (srt-table 2 5 2))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable srt-table admissible-div-table-p))))
+
+(defthm admissible-div-table-p-3-7-3
+  (admissible-div-table-p 3 7 3 (srt-table 3 7 3))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable srt-table admissible-div-table-p))))
+
+(defund check-exists-div-entry (i j rho m n)
+  (or (not (div-accessible-p i j m n))
+      (<= (lower i j rho m n)
+          (upper i j rho m n))))
+
+(defund check-exists-div-row (i j rho m n)
+  (if (zp j)
+      t
+    (and (check-exists-div-entry i (1- j) rho m n)
+         (check-exists-div-row i (1- j) rho m n))))
+
+(defund check-exists-div-rows (i rho m n)
+  (if (zp i)
+      t
+    (and (check-exists-div-row (1- i) (expt 2 n) rho m n)
+         (check-exists-div-rows (1- i) rho m n))))
+
+(defund exists-div-table-p (rho m n)
+  (check-exists-div-rows (expt 2 m) rho m n))
+
+(local-defthm lemma-2-3-1
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (and (integerp (lower i j rho m n))
+                (< (lower i j rho m n) (expt 2 rho))))
+  :hints (("Goal" :in-theory (enable lower)))
+  :rule-classes ())
+
+(local-defthm lemma-2-3-2
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (and (integerp (srt-entry i j rho m n))
+                (< (srt-entry i j rho m n) (expt 2 rho))
+                (> (srt-entry i j rho m n) (- (expt 2 rho)))))                
+  :hints (("Goal" :in-theory (enable srt-entry)
+                  :use lemma-2-3-1))
+  :rule-classes ())
+
+(local-defthm lemma-2-3-3
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (check-exists-div-entry i j rho m n))
+           (check-div-entry i j rho m n (srt-entry i j rho m n)))
+  :hints (("Goal" :in-theory (enable upper srt-entry check-exists-div-entry check-div-entry)
+                  :use (lemma-2-3-1 lemma-2-3-2))))
+
+(defun srt-row-induct (j k)
+  (if (not (zp j))
+      (1+ (srt-row-induct (1- j) (1+ k)))
+    k))
+
+(local-defthm lemma-2-3-4
+  (implies (and (natp k)
+                (natp j)
+                (natp n)
+                (< (+ k j) (expt 2 n)))
+           (equal (nth j (srt-row i k rho m n))
+                  (srt-entry i (+ k j) rho m n)))
+  :hints (("Goal" :induct (srt-row-induct j k))
+          ("Subgoal *1/2" :expand ((SRT-ROW I K RHO M N)))
+          ("Subgoal *1/1" :expand ((SRT-ROW I K RHO M N)))))
+
+(local-defthm lemma-2-3-5
+  (implies (and (natp k)
+                (natp i)
+                (natp m)
+                (< (+ k i) (expt 2 m)))
+           (equal (nth i (srt-rows k rho m n))
+                  (srt-row (+ k i) 0 rho m n)))
+  :hints (("Goal" :induct (srt-row-induct i k))
+          ("Subgoal *1/2" :expand ((SRT-ROWS K RHO M N)))
+          ("Subgoal *1/1" :expand ((SRT-ROWS K RHO M N)))))
+
+(local-defthm lemma-2-3-6
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (equal (nth j (nth i (srt-table rho m n)))
+                  (srt-entry i j rho m n)))
+  :hints (("Goal" :in-theory (enable srt-table))))
+
+(local-defthm integerp-srt-entry
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (<= j (expt 2 n)))
+           (integerp (srt-entry i j rho m n)))
+  :hints (("Goal" :in-theory (enable lower srt-entry))))
+
+(local-defthm lemma-2-3-7
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (<= j (expt 2 n))
+                (check-exists-div-row i j rho m n))
+           (check-div-row i j rho m n (nth i (srt-table rho m n))))
+  :hints (("Goal" :in-theory (enable check-exists-div-row check-div-row))))
+
+(local-defthm lemma-2-3-8
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (<= i (expt 2 m))
+                (check-exists-div-rows i rho m n))
+           (check-div-rows i rho m n (srt-table rho m n)))
+  :hints (("Goal" :in-theory (enable check-exists-div-rows check-div-rows))))
+
+(defthm lemma-2-3-a
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (exists-div-table-p rho m n))
+           (admissible-div-table-p rho m n (srt-table rho m n)))
+  :hints (("Goal" :in-theory (enable exists-div-table-p admissible-div-table-p))))
+
+(local-defthm lemma-2-3-9
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (check-div-entry i j rho m n entry))
+           (check-exists-div-entry i j rho m n))           
+  :hints (("Goal" :in-theory (enable upper check-exists-div-entry check-div-entry)
+                  :use (lemma-2-3-1 lemma-2-3-2))))
+
+(local-defthm lemma-2-3-10
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (<= j (expt 2 n))
+                (check-div-row i j rho m n row))
+           (check-exists-div-row i j rho m n))           
+  :hints (("Goal" :in-theory (enable check-exists-div-row check-div-row))))
+
+(local-defthm lemma-2-3-11
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (<= i (expt 2 m))
+                (check-div-rows i rho m n rows))
+           (check-exists-div-rows i rho m n))           
+  :hints (("Goal" :in-theory (enable check-exists-div-rows check-div-rows))))
+
+(defthm lemma-2-3-b
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (admissible-div-table-p rho m n table))
+           (exists-div-table-p rho m n))
+  :hints (("Goal" :in-theory (enable exists-div-table-p admissible-div-table-p))))
+
+;;**********************************************************************************
+
+(local-defthm i-bounds-1
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (< (* (expt 2 (- m 2)) p)
+              (expt 2 (1- m))))
+  :rule-classes ())
+
+(local-defthm i-bounds-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (<= x y)
+                (< y z))
+           (< x z))
+:rule-classes ())
+
+(local-defthm i-bounds-3
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (< (fl (* (expt 2 (- m 2)) p))
+              (expt 2 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-1
+                        (:instance i-bounds-2 (x (fl (* (expt 2 (- m 2)) p)))
+                                             (y (* (expt 2 (- m 2)) p))
+                                             (z (expt 2 (1- m))))
+                        (:instance fl-def (x (* (expt 2 (- m 2)) p)))))))
+
+(local-defthm i-bounds-4
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (bvecp (fl (* (expt 2 (- m 2)) p)) (1- m)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bvecp)
+                  :use i-bounds-3)))
+
+(local-defthm i-bounds-5
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (bvecp (fl (* (expt 2 (- m 2)) p)) m))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bvecp-monotone)
+                  :use i-bounds-4)))
+
+(local-defthm i-bounds-6
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (equal (bits (FL (* p (EXPT 2 (+ -2 M)))) (+ -1 m) 0)
+                  (FL (* (EXPT 2 (+ -2 M)) P))))
+  :hints (("Goal" :use (i-bounds-5))))
+
+(local-defthm i-bounds-7
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (equal (pi0 (bits (FL (* (EXPT 2 (+ -2 M)) P)) (+ -1 m) 0) m)
+                  (/ (FL (* (EXPT 2 (+ -2 M)) P))
+                     (expt 2 (- m 2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0)
+                  :use (i-bounds-3))))
+
+(local-defthm i-bounds-8
+  (implies (and (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (<= x y))
+           (<= (* x (expt 2 n))
+               (* y (expt 2 n))))
+  :rule-classes ())
+
+(local-defthm i-bounds-9
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (<= (/ (FL (* (EXPT 2 (+ -2 M)) P)) (expt 2 (- m 2)))
+               p))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fl-def (x (* (EXPT 2 (+ -2 M)) P)))
+                        (:instance i-bounds-8 (x (FL (* (EXPT 2 (+ -2 M)) P)))
+                                              (y (* (EXPT 2 (+ -2 M)) P))
+                                              (n (- 2 m)))))))
+
+(local-defthm i-bounds-10
+  (implies (and (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (< x y))
+           (< (* x (expt 2 n))
+              (* y (expt 2 n))))
+  :rule-classes ())
+
+(local-defthm i-bounds-11
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (< p
+              (+ (/ (FL (* (EXPT 2 (+ -2 M)) P)) (expt 2 (- m 2)))
+                 (expt 2 (- 2 m)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fl-def (x (* (EXPT 2 (+ -2 M)) P)))
+                        (:instance i-bounds-10 (y (1+ (FL (* (EXPT 2 (+ -2 M)) P))))
+                                               (x (* (EXPT 2 (+ -2 M)) P))
+                                               (n (- 2 m)))))))
+
+(local-defthm i-bounds-12
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (>= p 0))
+           (and (<= (pi0 (bits (FL (* (EXPT 2 (+ -2 M)) P)) (+ -1 m) 0) m)
+                    p)
+                (< p
+                   (+ (pi0 (bits (FL (* (EXPT 2 (+ -2 M)) P)) (+ -1 m) 0) m)
+                      (expt 2 (- 2 m))))))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-7 i-bounds-9 i-bounds-11))))
+
+(local-defthm i-bounds-13
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (< p 0))
+           (> (* (expt 2 (- m 2)) p)
+              (- (expt 2 (1- m)))))
+  :rule-classes ())
+
+(local-defthm i-bounds-14
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (< p 0))
+           (> (fl (* (expt 2 (- m 2)) p))
+              (1- (* (expt 2 (- m 2)) p))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fl-def (x (* (expt 2 (- m 2)) p)))))))
+
+(local-defthm i-bounds-15
+  (implies (and (rationalp x)
+                (rationalp y)
+                (< x y))
+           (< (1- x) (1- y)))
+  :rule-classes ())
+
+(local-defthm i-bounds-16
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (< p 0))
+           (> (1- (* (expt 2 (- m 2)) p))
+              (1- (- (expt 2 (1- m))))))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-13
+                        (:instance i-bounds-15 (x (- (expt 2 (1- m)))) (y (* (expt 2 (- m 2)) p)))))))
+
+(local-defthm i-bounds-17
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (natp m)
+                (< p 0))
+           (> (fl (* (expt 2 (- m 2)) p))
+              (1- (- (expt 2 (1- m))))))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-16
+                        i-bounds-14))))
+
+(local-defthm i-bounds-18
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (>= (fl (* (expt 2 (- m 2)) p))
+               (- (expt 2 (1- m)))))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-17))))
+
+(local-defthm i-bounds-19
+  (implies (not (zp m))
+           (< (expt 2 (1- m))
+              (expt 2 m)))
+  :rule-classes ())
+
+(local-defthm i-bounds-20
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (< x y)
+                (<= y z))
+           (< x z))
+:rule-classes ())
+
+(local-defthm i-bounds-21
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (>= (fl (* (expt 2 (- m 2)) p))
+               (- (expt 2 m))))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-18
+                        i-bounds-19
+                        (:instance i-bounds-20 (x (- (expt 2 m))) (y (- (expt 2 (1- m)))) (z (fl (* (expt 2 (- m 2)) p))))))))
+
+(local-defthm i-bounds-22
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (equal (bits (FL (* p (EXPT 2 (+ -2 M)))) (+ -1 m) 0)
+                  (+ (expt 2 m) (FL (* (EXPT 2 (+ -2 M)) P)))))
+  :hints (("Goal" :in-theory (disable bits-tail-2)
+                  :use (i-bounds-21
+                        (:instance bits-tail-2 (x (FL (* p (EXPT 2 (+ -2 M))))) (i (1- m)))))))
+
+(local-defthm i-bounds-23
+  (implies (and (integerp m)
+                (rationalp x)
+                (>= (+ x (expt 2 (1- m))) 0))
+           (>= (+ (expt 2 (1- m)) (expt 2 (1- m)) x) (expt 2 (1- m))))
+  :rule-classes ())
+
+(local-defthm i-bounds-24
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (= (+ y y) z)
+                (>= x (- y)))
+           (>= (+ z x) y))
+  :rule-classes ())
+
+(local-defthm i-bounds-25
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (>= (bits (FL (* p (EXPT 2 (+ -2 M)))) (+ -1 m) 0)
+               (expt 2 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance i-bounds-24 (x (FL (* p (EXPT 2 (+ -2 M)))))
+                                               (y (expt 2 (1- m)))
+                                               (z (expt 2 m)))
+                        i-bounds-18))))
+
+(local-defthm i-bounds-26
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (equal (pi0 (bits (FL (* (EXPT 2 (+ -2 M)) P)) (+ -1 m) 0) m)
+                  (- (/ (bits (FL (* p (EXPT 2 (+ -2 M)))) (+ -1 m) 0)
+                        (expt 2 (- m 2)))
+                     4)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0)
+                  :use (i-bounds-25))))
+
+(local-defthm i-bounds-27
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (equal (* (expt 2 (- m 2)) 
+                     (pi0 (bits (FL (* (EXPT 2 (+ -2 M)) P)) (+ -1 m) 0) m))
+                  (FL (* p (EXPT 2 (+ -2 M))))))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-26))))
+
+(local-defthm i-bounds-28
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (<= (* (expt 2 (- m 2)) 
+                  (pi0 (bits (FL (* (EXPT 2 (+ -2 M)) P)) (+ -1 m) 0) m))
+               (* (EXPT 2 (+ -2 M))
+                  p)))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-27
+                        (:instance fl-def (x (* p (EXPT 2 (+ -2 M)))))))))
+
+(local-defthm i-bounds-29
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (<= (pi0 (bits (FL (* (EXPT 2 (+ -2 M)) P)) (+ -1 m) 0) m)
+               p))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-28))))
+
+
+(local-defthm i-bounds-30
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (< (* (EXPT 2 (+ -2 M))
+                 p)
+              (+ (* (expt 2 (- m 2)) 
+                    (pi0 (bits (FL (* (EXPT 2 (+ -2 M)) P)) (+ -1 m) 0) m))
+                 1)))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-27
+                        (:instance fl-def (x (* p (EXPT 2 (+ -2 M)))))))))
+
+(local-defthm i-bounds-31
+  (implies (and (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (< x y))
+           (< (* (expt 2 n) x) (* (expt 2 n) y)))
+  :rule-classes ())
+
+(local-defthm i-bounds-32
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m))
+                (< p 0))
+           (< p
+              (+ (pi0 (bits (FL (* p (EXPT 2 (+ -2 M)))) (+ -1 m) 0) m)
+                 (expt 2 (- 2 m)))))
+  :rule-classes ()
+  :hints (("Goal" :use (i-bounds-30
+                        i-bounds-26
+                        (:instance i-bounds-31 (x (* (EXPT 2 (+ -2 M)) p))
+                                               (y (+ 1 (* (EXPT 2 (+ -2 M)) (pi0 (bits (FL (* p (EXPT 2 (+ -2 M)))) (+ -1 m) 0) m))))
+                                               (n (- 2 m)))))))
+
+(defthm i-bounds
+  (implies (and (rationalp p)
+                (< (abs p) 2)
+                (not (zp m)))
+           (let ((i (bits (fl (* (expt 2 (- m 2)) p)) (1- m) 0)))
+              (and (bvecp i m)
+                   (<= (pi0 i m) p)
+                   (< p (+ (pi0 i m) (expt 2 (- 2 m)))))))
+  :hints (("Goal" :use (i-bounds-32
+                        i-bounds-29
+                        i-bounds-12
+                        (:instance bits-bvecp (x (fl (* (expt 2 (- m 2)) p))) (i (1- m)) (j 0) (k m)))
+                  :in-theory (disable BITS-BVECP-SIMPLE bits-bvecp))))
+
+(local-defthm j-bounds-1
+  (implies (and (rationalp d)
+                (natp n))
+           (and (<= (fl (* (expt 2 n) (1- d))) (* (expt 2 n) (1- d)))
+                (< (* (expt 2 n) (1- d)) (1+ (fl (* (expt 2 n) (1- d)))))))
+  :rule-classes ())
+
+(local-defthm j-bounds-2
+  (implies (and (rationalp d)
+                (natp n))
+           (<= (/ (fl (* (expt 2 n) (1- d))) (expt 2 n)) (1- d)))
+  :hints (("Goal" :use (j-bounds-1
+                        (:instance i-bounds-8 (x (fl (* (expt 2 n) (1- d)))) (y (* (expt 2 n) (1- d))) (n (- n))))))
+  :rule-classes ())
+
+(local-defthm j-bounds-3
+  (implies (and (rationalp d)
+                (natp n))
+           (<= (delta0 (fl (* (expt 2 n) (1- d))) n) d))
+  :hints (("Goal" :use (j-bounds-2)
+                  :in-theory (enable delta0)))
+  :rule-classes ())
+
+(local-defthm j-bounds-4
+  (implies (and (rationalp d)
+                (natp n))
+           (< (1- d)
+              (+ (expt 2 (- n)) (/ (fl (* (expt 2 n) (1- d))) (expt 2 n)))))
+  :hints (("Goal" :use (j-bounds-1
+                        (:instance i-bounds-10 (y (1+ (fl (* (expt 2 n) (1- d))))) (x (* (expt 2 n) (1- d))) (n (- n))))))
+  :rule-classes ())
+
+(local-defthm j-bounds-5
+  (implies (and (rationalp d)
+                (natp n))
+           (< d (+ (expt 2 (- n)) (delta0 (fl (* (expt 2 n) (1- d))) n))))
+  :hints (("Goal" :use (j-bounds-4)
+                  :in-theory (enable delta0)))
+  :rule-classes ())
+
+(local-defthm j-bounds-6
+  (implies (and (rationalp d)
+                (natp n)
+                (<= 0 d)
+                (< d 1))
+           (<= 0 (fl (* (expt 2 n) d))))
+  :hints (("Goal" :use (:instance fl-def (x (* (expt 2 n) d)))))
+  :rule-classes ())
+
+(local-defthm j-bounds-7
+  (implies (and (rationalp x)
+                (rationalp y)
+                (< x y))
+           (< (fl x) y))
+  :hints (("Goal" :use (fl-def)))
+  :rule-classes ())
+
+(local-defthm j-bounds-8
+  (implies (and (rationalp d)
+                (natp n)
+                (<= 0 d)
+                (< d 1))
+           (< (fl (* (expt 2 n) d)) (expt 2 n)))
+  :hints (("Goal" :use (:instance j-bounds-7 (x (* (expt 2 n) d)) (y (expt 2 n)))))
+  :rule-classes ())
+
+(defthm j-bounds
+  (implies (and (rationalp d)
+                (natp n)
+                (<= 1 d)
+                (< d 2))
+           (let ((j (fl (* (expt 2 n) (1- d)))))
+              (and (bvecp j n)
+                   (<= (delta0 j n) d)
+                   (< d (+ (delta0 j n) (expt 2 (- n)))))))
+  :hints (("Goal" :use (j-bounds-3 j-bounds-5 
+                        (:instance j-bounds-6 (d (1- d)))
+                        (:instance j-bounds-8 (d (1- d))))
+                  :in-theory (enable bvecp)))
+  :rule-classes ())
+
+
+(encapsulate (((rho%) => *) ((m%) => *) ((n%) => *) ((table%) => *) ((d%) => *) ((x%) => *) ((j%) => *)
+              ((p% *) => *) ((h% *) => *) ((i% *) => *))
+
+(local (defun rho% () 2))
+(local (defun m% () 5))
+(local (defun n% () 2))
+(local (defun table% () (srt-table 2 5 2)))
+(local (defun d% () 1))
+(local (defun x% () 0))
+(local (defun j% () (fl (* (expt 2 (n%)) (1- (d%))))))
+
+(local (mutual-recursion
+
+(defun p% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      (x%)
+    (- (* (expt 2 (rho%)) (p% (1- k)))
+       (* (h% k) (d%)))))
+
+(defun h% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 1)))
+  (lookup (i% k) (j%) (table%)))
+
+(defun i% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (bits (fl (* (expt 2 (- (m%) 2)) (p% (1- k)))) (1- (m%)) 0)))
+))
+
+(defthmd rho%-constraint
+  (not (zp (rho%))))
+
+(defthmd m%-constraint
+  (not (zp (m%))))
+
+(defthmd n%-constraint
+  (not (zp (n%))))
+
+(defthmd table%-constraint
+  (admissible-div-table-p (rho%) (m%) (n%) (table%)))
+
+(defthmd d%-constraint
+  (and (rationalp (d%))
+       (<= 1 (d%))
+       (< (d%) 2)))
+
+(defthmd x%-constraint
+  (and (rationalp (x%))
+       (< (abs (x%)) (d%))))
+
+(defthmd p%-def
+  (equal (p% k)
+         (if (zp k)
+             (x%)
+           (- (* (expt 2 (rho%)) (p% (1- k)))
+              (* (h% k) (d%)))))
+  :rule-classes (:definition))
+
+(defthmd h%-def
+  (equal (h% k)
+         (lookup (i% k) (j%) (table%)))
+  :rule-classes (:definition))
+
+(defthmd i%-constraint
+  (implies (and (not (zp k))
+                (rationalp (p% (1- k)))
+                (< (abs (p% (1- k))) 2))
+           (and (bvecp (i% k) (m%))
+                (<= (pi0 (i% k) (m%))
+                    (p% (1- k)))
+                (< (p% (1- k))
+                   (+ (pi0 (i% k) (m%))
+                      (/ (expt 2 (- (m%) 3)))))))
+  :hints (("Goal" :use ((:instance i-bounds (p (p% (1- k))) (m (m%)))))))
+
+(defthmd j%-constraint
+  (and (bvecp (j%) (n%))
+       (<= (delta0 (j%) (n%)) (d%))
+       (< (d%) (+ (delta0 (j%) (n%)) (expt 2 (- (n%))))))
+  :hints (("Goal" :use ((:instance j-bounds (d (d%)) (n (n%)))))))
+
+)
+
+(defund q% (k)
+  (if (zp k)
+      0
+    (+ (q% (1- k))
+       (/ (h% k) (expt 2 (* k (rho%)))))))
+
+(local-defthm theorem-1-1
+  (implies (and (not (zp k))
+                (rationalp (p% (1- k)))
+                (<= (- (d%)) (p% (1- k)))
+                (< (p% (1- k)) (d%)))
+           (and (integerp (h% k))
+                (rationalp (p% k))
+                (<= (- (d%)) (p% k))
+                (< (p% k) (d%))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%-constraint
+                        d%-constraint
+                        i%-constraint
+                        j%-constraint
+                        m%-constraint
+                        n%-constraint
+                        table%-constraint
+                        (:instance lemma-2-2 (m (m%)) (n (n%)) (rho (rho%)) (table (table%)) (d (d%)) (p (p% (1- k))) (i (i% k))
+                                             (j (j%)) (k (h% k))))
+                  :in-theory (enable p%-def h%-def bvecp))))
+
+(local-defthm theorem-1-2
+  (implies (zp k)
+           (and (rationalp (p% k))
+                (<= (- (d%)) (p% k))
+                (< (p% k) (d%))))
+  :rule-classes ()
+  :hints (("Goal" :use (x%-constraint p%-def))))
+
+(local-defthm theorem-1-3
+  (and (rationalp (p% k))
+       (<= (- (d%)) (p% k))
+       (< (p% k) (d%))
+       (implies (not (zp k))
+                (integerp (h% k))))
+  :rule-classes ()
+  :hints (("Goal" :induct (natp-induct k))
+          ("Subgoal *1/2" :use theorem-1-1)
+          ("Subgoal *1/1" :use theorem-1-2)))
+
+(local-defthm theorem-1-4
+  (implies (not (zp k))
+           (integerp (h% k)))
+  :hints (("Goal" :use (theorem-1-3))))
+
+(local-defthm theorem-1-5
+  (rationalp (p% k))
+  :hints (("Goal" :use (theorem-1-3))))
+
+(local-defthm theorem-1-6
+  (and (<= (- (d%)) (p% k))
+       (< (p% k) (d%)))
+  :hints (("Goal" :use (theorem-1-3))))
+
+(local-defthm theorem-1-7
+  (> (d%) 0)
+  :hints (("Goal" :use (d%-constraint))))
+
+(local-defthm theorem-1-8
+  (integerp (rho%))
+  :hints (("Goal" :use (rho%-constraint))))
+
+(defthm theorem-1-a
+  (implies (natp k)
+           (and (<= (- (/ (expt 2 (* k (rho%)))))
+                    (- (/ (x%) (d%)) (q% k)))
+                (< (- (/ (x%) (d%)) (q% k))
+                   (/ (expt 2 (* k (rho%)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable p%-def q% rho%-constraint x%-constraint d%-constraint)
+                  :use ((:functional-instance lemma-2-1-corollary
+                                              (rho$ rho%)
+                                              (x$ x%)
+                                              (d$ d%)
+                                              (h$ h%)
+                                              (p$ p%)
+                                              (q$ q%))))))
+
+(defthm theorem-1-b
+  (< (abs (p% k)) 2)
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable theorem-1-6)
+                  :use (d%-constraint theorem-1-6))))
+
+(defthm theorem-1-c
+  (implies (not (zp k))
+           (div-accessible-p (i% k) (j%) (m%) (n%)))
+  :rule-classes ()
+  :hints (("Goal" :use (m%-constraint
+                        n%-constraint
+                        d%-constraint
+                        i%-constraint
+                        j%-constraint
+                        (:instance theorem-1-b (k (1- k)))
+                        (:instance theorem-1-3 (k (1- k)))
+                        (:instance theorem-1-6 (k (1- k)))
+                        (:instance div-table-1 (m (m%)) (n (n%)) (i (i% k)) (j (j%)) (p (p% (1- k))) (d (d%)))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta1/seed.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta1/seed.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta1/seed.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta1/seed.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1588 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "sqrt")
+
+(local-defthm lemma-4-1-1
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (rationalp x)
+                (>= (* k rho) 2)
+                (< 1/4 x)
+                (< x 1))
+           (and (< (* (expt 2 (* k rho)) x)
+                   (expt 2 (* k rho)))
+                (> (* (expt 2 (* k rho)) x)
+                   (expt 2 (- (* k rho) 2)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-strongly-monotonic (x (expt 2 (* k rho))) 
+                                                        (y x) (y+ 1))
+                        (:instance *-strongly-monotonic (x (expt 2 (* k rho))) 
+                                                        (y+ x) (y 1/4))))))
+
+(local-defthm lemma-4-1-2
+  (implies (and (rationalp x)
+                (integerp a)
+                (integerp b)
+                (< x a)
+                (> x b))
+           (and (< (fl x) a)
+                (>= (fl x) b)))
+  :rule-classes ())
+
+(local-defthm lemma-4-1-3
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (rationalp x)
+                (>= (* k rho) 2)
+                (< 1/4 x)
+                (< x 1))
+            (let ((l (fl (* (expt 2 (* k rho)) x))))
+              (and (< l (expt 2 (* k rho)))
+                   (>= l (expt 2 (- (* k rho) 2))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-1
+                        (:instance lemma-4-1-2 (x (* (expt 2 (* k rho)) x))
+                                               (a (expt 2 (* k rho)))
+                                               (b (expt 2 (- (* k rho) 2))))))))
+
+(local-defthm lemma-4-1-5
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho)))s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (and (< q 1)
+                  (<= 1/2 q))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-3
+                        (:instance *-weakly-monotonic (x (expt 2 (* k rho)))
+                                                      (y 1/2)
+                                                      (y+ (* (expt 2 (- (* k rho))) s)))
+                        (:instance *-strongly-monotonic (x (expt 2 (* k rho)))
+                                                        (y+ 1)
+                                                        (y (* (expt 2 (- (* k rho))) s)))))))
+
+(local-defthm lemma-4-1-7
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho)))s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (<= (* (expt 2 (- (* k rho)))
+                    (expt (1- (* q (expt 2 (* k rho)))) 2))
+                 l)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-3))))
+
+(local-defthm lemma-4-1-8
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho)))s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (<= (* (expt 2 (* k rho))
+                    (expt (- q (expt 2 (- (* k rho)))) 2))
+                 l)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-7))))
+
+(local-defthm lemma-4-1-9
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho)))s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (<= (expt (- q (expt 2 (- (* k rho)))) 2)
+                 (* (expt 2 (- (* k rho)))
+                    l))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-8
+                        (:instance *-weakly-monotonic 
+                         (x (expt 2 (* k rho)))
+                         (y+ (* (expt 2 (- (* k rho)))
+                                (fl (* (expt 2 (* k rho)) x))))
+                         (y  (expt (- (* (expt 2 (- (* k rho))) s)
+                                      (expt 2 (- (* k rho))))
+                                   2)))))))
+
+(local-defthm lemma-4-1-10
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho)))s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (>= (* (expt 2 (- (* k rho)))
+                    (expt (1+ (* q (expt 2 (* k rho)))) 2))
+                 (1+ l))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-3))))
+
+(local-defthm lemma-4-1-11
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho)))s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (>= (* (expt 2 (* k rho))
+                    (expt (+ q (expt 2 (- (* k rho)))) 2))
+                 (1+ l))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-10))))
+
+(local-defthm lemma-4-1-12
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho)))s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (>= (expt (+ q (expt 2 (- (* k rho)))) 2)
+                 (* (expt 2 (- (* k rho)))
+                    (1+ l)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-11
+                        (:instance *-weakly-monotonic 
+                         (x (expt 2 (* k rho)))
+                         (y (* (expt 2 (- (* k rho)))
+                               (1+ (fl (* (expt 2 (* k rho)) x)))))
+                         (y+  (expt (+ (* (expt 2 (- (* k rho))) s)
+                                       (expt 2 (- (* k rho))))
+                                    2)))))))
+
+(local-defthm lemma-4-1-13
+  (let* ((l (fl (* (expt 2 (* k rho)) x))))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+              (and (<= l (* x (expt 2 (* k rho))))
+                   (> (1+ l) (* x (expt 2 (* k rho)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-1
+                        (:instance fl-def (x (* (expt 2 (* k rho)) x)))))))
+
+(local-defthm lemma-4-1-14
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (rationalp x)
+                (>= (* k rho) 2)
+                (< 1/4 x)
+                (< x 1))
+            (let ((l (fl (* (expt 2 (* k rho)) x))))
+              (<= (* (expt 2 (- (* k rho))) l)
+                  x)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-13
+                        (:instance *-weakly-monotonic (x (expt 2 (* k rho)))
+                                                      (y (* (fl (* (expt 2 (* k rho)) x)) 
+                                                            (expt 2 (- (* k rho)))))
+                                                      (y+ x))))))
+
+(local-defthm lemma-4-1-15
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (rationalp x)
+                (>= (* k rho) 2)
+                (< 1/4 x)
+                (< x 1))
+            (let ((l (fl (* (expt 2 (* k rho)) x))))
+              (> (* (expt 2 (- (* k rho))) (1+ l))
+                 x)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-13
+                        (:instance *-strongly-monotonic 
+                                   (x (expt 2 (* k rho)))
+                                   (y+ (* (1+ (fl (* (expt 2 (* k rho)) x)) )
+                                          (expt 2 (- (* k rho)))))
+                                   (y x))))))
+
+(local-defthm lemma-4-1-16
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (< x (expt (+ q (expt 2 (- (* k rho)))) 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-1-12 lemma-4-1-15))))
+
+(local-defthm lemma-4-1-17
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s)))
+    (implies (and (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (>= x (expt (- q (expt 2 (- (* k rho)))) 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-1-9 lemma-4-1-14))))
+
+(local-defthm lemma-4-1-a-1
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (rationalp x)
+                (>= (* k rho) 2)
+                (< 1/4 x)
+                (< x 1))
+    (let ((l (fl (* (expt 2 (* k rho)) x))))
+      (implies (and (integerp s)
+                    (<= (expt 2 (1- (* k rho))) s)
+                    (< s (expt 2 (* k rho)))
+                    (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                        l)
+                    (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                        (1+ l)))
+               (let ((q (* (expt 2 (- (* k rho))) s)))
+                 (and (<= 1/2 q)
+                      (< q 1)
+                      (>= x (expt (- q (expt 2 (- (* k rho)))) 2))
+                      (< x (expt (+ q (expt 2 (- (* k rho)))) 2)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-1-5 lemma-4-1-16 lemma-4-1-17))))
+
+(encapsulate (((rho**) => *) ((k**) => *) ((x**) => *) ((s**) => *))
+
+(local (defun k** () 1))
+
+(local (defun rho** () 2))
+
+(defthm k**-rho**-constraint
+  (and (not (zp (k**)))
+       (not (zp (rho**)))
+       (>= (* (k**) (rho**)) 2))
+  :rule-classes ())
+  
+(local (defun x** () 1/2))
+
+(defthm x**-constraint
+  (and (rationalp (x**))
+       (> (x**) 1/4)
+       (< (x**) 1))
+  :rule-classes ())
+
+(defun l** () (fl (* (expt 2 (* (k**) (rho**))) (x**))))
+
+(local (defun s** () 3))
+
+(defthm s**-constraint
+  (and (integerp (s**))
+       (<= (expt 2 (1- (* (k**) (rho**)))) (s**))
+       (< (s**) (expt 2 (* (k**) (rho**))))
+       (<= (* (expt 2 (- (* (k**) (rho**)))) (expt (1- (s**)) 2))
+           (l**))
+       (>= (* (expt 2 (- (* (k**) (rho**)))) (expt (1+ (s**)) 2))
+           (1+ (l**))))
+  :rule-classes ())
+
+(defun q0** () (* (expt 2 (- (* (k**) (rho**)))) (s**)))
+
+)
+
+(defthm lemma-4-1-a
+  (and (<= 1/2 (q0**))
+       (< (q0**) 1)
+       (>= (x**) (expt (- (q0**) (expt 2 (- (* (k**) (rho**))))) 2))
+       (< (x**) (expt (+ (q0**) (expt 2 (- (* (k**) (rho**))))) 2)))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint
+                        x**-constraint
+                        s**-constraint
+                        (:instance lemma-4-1-a-1 (k (k**)) (rho (rho**)) (x (x**)) (s (s**)))))))
+
+(local-defthm cg-sqrt-1
+  (implies (and (rationalp x)
+                (rationalp y)
+                (<= 0 x)
+                (<= 0 y))
+           (iff (<= x y)
+                (<= (* x x) (* y y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (x (+ x y)) (y 0) (y+ (- y x)))))))
+
+(local-defthm lemma-4-1-18
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (>= x (* q q)))
+                 s
+               (1- s))))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (> q 1/2)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance cg-sqrt-1 (x (* (expt 2 (- (* k rho))) s))
+                                             (y 1/2))))))
+
+(local-defthm lemma-4-1-19
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (>= x (* q q)))
+                 s
+               (1- s))))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (> s (expt 2 (1- (* k rho))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-18
+                        (:instance *-strongly-monotonic (x (expt 2 (* k rho))) (y 1/2) (y+ q))))))
+
+(local-defthm lemma-4-1-20
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (>= x (* q q)))
+                 s
+               (1- s))))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (>= s1 (expt 2 (1- (* k rho))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-19))))
+
+(local-defthm lemma-4-1-21
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (>= x (* q q)))
+                 s
+               (1- s)))
+         (q1 (* (expt 2 (- (* k rho))) s1)))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (>= q1 1/2)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-20
+                        (:instance *-weakly-monotonic (x (expt 2 (- (* k rho)))) (y (expt 2 (1- (* k rho)))) (y+ (1- s)))))))
+
+(local-defthm lemma-4-1-22
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (>= x (* q q)))
+                 s
+               (1- s)))
+         (q1 (* (expt 2 (- (* k rho))) s1)))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (< q1 q)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-20
+                        (:instance *-strongly-monotonic (x (expt 2 (- (* k rho)))) (y (1- s)) (y+ s))))))
+
+(local-defthm lemma-4-1-23
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (> x (* q q)))
+                 s
+               (1- s)))
+         (q1 (* (expt 2 (- (* k rho))) s1)))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (>= q1 (expt 2 (- (* k rho))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-21))))
+
+(local-defthm lemma-4-1-24
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (>= x (* q q)))
+                 s
+               (1- s)))
+         (q1 (* (expt 2 (- (* k rho))) s1)))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (<= (expt (- q1 (expt 2 (- (* k rho)))) 2)
+                 (expt (- q (expt 2 (- (* k rho)))) 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-23
+                        lemma-4-1-22
+                        (:instance cg-sqrt-1 (x (- (* (expt 2 (- (* k rho))) s) (expt 2 (- (* k rho))))) 
+                                             (y (- (* (expt 2 (- (* k rho))) (1- s)) (expt 2 (- (* k rho))))))))))
+
+(local-defthm lemma-4-1-25
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (>= x (* q q)))
+                 s
+               (1- s)))
+         (q1 (* (expt 2 (- (* k rho))) s1)))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (< x (expt (+ q1 (expt 2 (- (* k rho)))) 2))))
+  :rule-classes ())
+
+(local-defthm lemma-4-1-26
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (>= x y)
+                (>= y z))
+           (>= x z))
+  :rule-classes ())
+
+(local-defthm lemma-4-1-27
+  (let* ((l (fl (* (expt 2 (* k rho)) x)))
+         (q (* (expt 2 (- (* k rho))) s))
+         (s1 (if (or (= (mod s 2) 1)
+                     (>= x (* q q)))
+                 s
+               (1- s)))
+         (q1 (* (expt 2 (- (* k rho))) s1)))
+    (implies (and (= s1 (1- s))
+                  (not (zp k))
+                  (not (zp rho))
+                  (rationalp x)
+                  (>= (* k rho) 2)
+                  (< 1/4 x)
+                  (< x 1)
+                  (integerp s)
+                  (<= (expt 2 (1- (* k rho))) s)
+                  (< s (expt 2 (* k rho)))
+                  (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                      l)
+                  (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                      (1+ l)))
+             (<= (expt (- q1 (expt 2 (- (* k rho)))) 2) x)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-24
+                        lemma-4-1-a-1
+                        (:instance lemma-4-1-26 (y (expt (- (* (expt 2 (- (* k rho))) s) (expt 2 (- (* k rho)))) 2))
+                                                (z (expt (- (* (expt 2 (- (* k rho))) (1- s)) (expt 2 (- (* k rho)))) 2)))))))
+
+(local-defthm lemma-4-1-b-1
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (rationalp x)
+                (>= (* k rho) 2)
+                (< 1/4 x)
+                (< x 1))
+    (let ((l (fl (* (expt 2 (* k rho)) x))))
+      (implies (and (integerp s)
+                    (<= (expt 2 (1- (* k rho))) s)
+                    (< s (expt 2 (* k rho)))
+                    (<= (* (expt 2 (- (* k rho))) (expt (1- s) 2))
+                        l)
+                    (>= (* (expt 2 (- (* k rho))) (expt (1+ s) 2))
+                        (1+ l)))
+               (let* ((q (* (expt 2 (- (* k rho))) s))
+                      (s1 (if (or (= (mod s 2) 1)
+                                  (>= x (* q q)))
+                              s
+                            (1- s)))
+                      (q1 (* (expt 2 (- (* k rho))) s1)))
+                 (and (<= 1/2 q1)
+                      (< q1 1)
+                      (>= x (expt (- q1 (expt 2 (- (* k rho)))) 2))
+                      (< x (expt (+ q1 (expt 2 (- (* k rho)))) 2)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-a-1
+                        lemma-4-1-25
+                        lemma-4-1-27
+                        lemma-4-1-22
+                        lemma-4-1-21))))
+
+(defun s1** ()
+  (if (or (= (mod (s**) 2) 1)
+          (>= (x**) (* (q0**) (q0**))))
+      (s**)
+    (1- (s**))))
+
+(defun q1** () (* (expt 2 (- (* (k**) (rho**)))) (s1**)))
+
+(defthm lemma-4-1-b
+  (and (<= 1/2 (q1**))
+       (< (q1**) 1)
+       (>= (x**) (expt (- (q1**) (expt 2 (- (* (k**) (rho**))))) 2))
+       (< (x**) (expt (+ (q1**) (expt 2 (- (* (k**) (rho**))))) 2)))
+  :rule-classes ()
+  :hints (("Goal" :use (s1**
+                        k**-rho**-constraint
+                        x**-constraint
+                        s**-constraint
+                        (:instance lemma-4-1-b-1 (k (k**)) (rho (rho**)) (x (x**)) (s (s**)))))))
+
+(encapsulate (((h** *) => *) ((q** *) => *))
+
+(local (defun h** (k) (declare (ignore k)) 0))
+
+(defthm h**-constraint
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (and (integerp (h** k))
+                (< (abs (h** k)) (expt 2 (rho**)))))
+  :rule-classes ())
+
+(local (defun q** (k) 
+  (if (or (zp k)
+          (<= k (k**)))
+      (q1**)
+    (+ (q** (1- k))
+       (* (expt 2 (- (* k (rho**))))
+          (h** k))))))
+
+(defthm q**-constraint
+  (and (= (q** (k**)) (q1**))
+       (implies (and (not (zp k))
+                     (> k (k**)))
+                (= (q** k)
+                   (+ (q** (1- k))
+                      (* (expt 2 (- (* k (rho**))))
+                         (h** k))))))
+  :hints (("Goal" ;:in-theory (theory 'minimal-theory)
+                  :use (q** s**-constraint k**-rho**-constraint
+                        (:instance q** (k (k**))))))
+  :rule-classes ())
+
+)
+
+(local-defthm intp-s1
+  (integerp (s1**))
+  :hints (("Goal" :use (s1** s**-constraint)))
+  :rule-classes (:type-prescription :rewrite))
+
+(in-theory (disable (l**) (s1**) (q1**)))
+
+(local-defthm ratp-q1
+  (rationalp (q** (k**)))
+  :hints (("Goal" :use (q**-constraint k**-rho**-constraint)))
+  :rule-classes (:type-prescription :rewrite))
+
+(local-defthm lemma-4-1-28
+  (implies (and (integerp s)
+                (= (q** (k**)) (* (expt 2 (- (* (k**) (rho**)))) s))
+                (not (zp k))
+                (>= k (k**)))
+           (rationalp (q** k)))
+  :rule-classes (:type-prescription :rewrite)
+  :hints (("Goal" :use (k**-rho**-constraint h**-constraint))
+          ("Goal'" :induct (natp-induct k))
+          ("Subgoal *1/2" :use q**-constraint)
+          ("Subgoal *1/1" :use (:instance h**-constraint (k (1- k))))))
+
+(local-defthm lemma-4-1-28-2
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (rationalp (q** k)))
+  :rule-classes (:type-prescription :rewrite)
+  :hints (("Goal" :use (q**-constraint
+                        (:instance lemma-4-1-28 (s (s1**)))))))
+
+(local-defthm lemma-4-1-29
+  (implies (and (integerp a) (integerp b))
+           (integerp (* a b)))
+  :rule-classes ())
+
+(local-defthm lemma-4-1-30
+  (implies (and (not (zp k))
+                (> k (k**))
+                (integerp (* (expt 2 (* (1- k) (rho**)))
+                          (q** (1- k)))))
+           (integerp (* (expt 2 (* k (rho**)))
+                        (q** k))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint h**-constraint q**-constraint
+                        (:instance lemma-4-1-29 (a (* (expt 2 (* (1- k) (rho**))) (q** (1- k)))) (b (expt 2 (rho**))))))))
+
+(local-defthm lemma-4-1-30-1
+  (integerp (* (expt 2 (* (k**) (rho**)))
+               (q1**)))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint s**-constraint h**-constraint q1**))))
+
+(local-defthm lemma-4-1-30-2
+  (integerp (* (expt 2 (* (k**) (rho**)))
+               (q** (k**))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-1-30-1 k**-rho**-constraint h**-constraint q**-constraint))))
+
+(local-defthm lemma-4-1-31
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (integerp (* (expt 2 (* k (rho**)))
+                        (q** k))))
+  :rule-classes (:type-prescription :rewrite)
+  :hints (("Goal" :use (k**-rho**-constraint h**-constraint))
+          ("Goal'" :induct (natp-induct k))
+          ("Subgoal *1/2" :use (lemma-4-1-30-2 lemma-4-1-30))
+          ("Subgoal *1/1" :use (:instance h**-constraint (k (1- k))))))
+
+(local-defthmd q**-rewrite
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (equal (q** k)
+                  (+ (q** (1- k))
+                     (* (expt 2 (- (* k (rho**))))
+                        (h** k)))))
+  :hints (("Goal" :use (q**-constraint))))
+
+(local-defthm lemma-4-1-32
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (<= (abs (- (q** (1- k)) (q** k)))
+               (* (1- (expt 2 (rho**)))
+                  (expt 2 (- (* k (rho**)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q**-rewrite)
+                  :use (k**-rho**-constraint h**-constraint
+                        (:instance *-weakly-monotonic (x (expt 2 (- (* k (rho**))))) (y (h** k)) (y+ (1- (expt 2 (rho**)))))
+                        (:instance *-weakly-monotonic (x (expt 2 (- (* k (rho**))))) (y+ (h** k)) (y (- 1 (expt 2 (rho**)))))))))
+
+(local-defthm lemma-4-1-33
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (<= (abs (- (q** k) (q** (k**))))
+               (+ (abs (- (q** (1- k)) (q** (k**))))
+                  (abs (- (q** (1- k)) (q** k))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint h**-constraint))))
+
+(local-defthm lemma-4-1-34
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (and (rationalp (abs (- (q** k) (q** (k**)))))
+                (rationalp (abs (- (q** (1- k)) (q** (k**)))))
+                (rationalp (abs (- (q** (1- k)) (q** k))))
+                (rationalp (* (1- (expt 2 (rho**)))
+                              (expt 2 (- (* k (rho**))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint))))
+
+(local-defthm lemma-4-1-35
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (<= (abs (- (q** k) (q** (k**))))
+               (+ (abs (- (q** (1- k)) (q** (k**))))
+                  (* (1- (expt 2 (rho**)))
+                     (expt 2 (- (* k (rho**))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-1-34 lemma-4-1-33 lemma-4-1-32))))
+
+(local-defthm lemma-4-1-36
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (rationalp (- (expt 2 (- (* (k**) (rho**))))
+                         (expt 2 (- (* (1- k) (rho**)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint))))
+
+(local-defthm lemma-4-1-37
+  (implies (and (not (zp k))
+                (> k (k**))
+                (<= (abs (- (q** (1- k)) (q** (k**))))
+                    (- (expt 2 (- (* (k**) (rho**))))
+                       (expt 2 (- (* (1- k) (rho**)))))))
+           (<= (abs (- (q** k) (q** (k**))))
+               (+ (- (expt 2 (- (* (k**) (rho**))))
+                     (expt 2 (- (* (1- k) (rho**)))))
+                  (* (1- (expt 2 (rho**)))
+                     (expt 2 (- (* k (rho**))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-1-34 lemma-4-1-33 lemma-4-1-32 lemma-4-1-36 lemma-4-1-35))))
+
+(local-defthm lemma-4-1-38
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (= (+ (- (expt 2 (- (* (k**) (rho**))))
+                    (expt 2 (- (* (1- k) (rho**)))))
+                 (* (1- (expt 2 (rho**)))
+                    (expt 2 (- (* k (rho**))))))
+              (- (expt 2 (- (* (k**) (rho**))))
+                 (expt 2 (- (* k (rho**)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint))))
+
+(local-defthm lemma-4-1-39
+  (implies (and (not (zp k))
+                (> k (k**))
+                (<= (abs (- (q** (1- k)) (q** (k**))))
+                    (- (expt 2 (- (* (k**) (rho**))))
+                       (expt 2 (- (* (1- k) (rho**)))))))
+           (<= (abs (- (q** k) (q** (k**))))
+               (- (expt 2 (- (* (k**) (rho**))))
+                  (expt 2 (- (* k (rho**)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-1-34 lemma-4-1-36 lemma-4-1-38 lemma-4-1-37))))
+
+(local-defthm lemma-4-1-40
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (<= (abs (- (q** k) (q** (k**))))
+               (- (expt 2 (- (* (k**) (rho**))))
+                  (expt 2 (- (* k (rho**)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint))
+          ("Goal'" :induct (natp-induct k))
+          ("Subgoal *1/" :use lemma-4-1-39)))
+
+(local-defthm lemma-4-1-41
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (< (abs (- (q** k) (q** (k**))))
+              (expt 2 (- (* (k**) (rho**))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-40 k**-rho**-constraint))))
+
+(local-defthmd q**-rewrite-2
+  (equal (q** (k**)) (q1**))
+  :hints (("Goal" :use q**-constraint)))
+
+(in-theory (disable s1**))
+
+(local-defthm lemma-4-1-42
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (< (* (expt 2 (* (k**) (rho**))) (q** k))
+              (1+ (s1**))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q**-rewrite-2)
+                  :use (lemma-4-1-41 k**-rho**-constraint
+                        (:instance *-strongly-monotonic (x (expt 2 (* (k**) (rho**)))) 
+                                                        (y (q** k)) 
+                                                        (y+ (+ (q** (k**)) (expt 2 (- (* (k**) (rho**)))))))))))
+
+(local-defthm lemma-4-1-43
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (<= (fl (* (expt 2 (* (k**) (rho**))) (q** k)))
+               (* (expt 2 (* (k**) (rho**))) (q** (k**)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q**-rewrite-2)
+                  :use (lemma-4-1-42 k**-rho**-constraint
+                        (:instance fl-def (x (* (expt 2 (* (k**) (rho**))) (q** k))))))))
+
+(local-defthm lemma-4-1-44
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (<= (fl (* (expt 2 (1- (* (k**) (rho**)))) (q** k)))
+               (fl (* (expt 2 (1- (* (k**) (rho**)))) (q** (k**))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-43 k**-rho**-constraint
+                        (:instance fl-monotone-linear (x (/ (fl (* (expt 2 (* (k**) (rho**))) (q** k))) 2))
+                                                      (y (/ (* (expt 2 (* (k**) (rho**))) (q** (k**))) 2)))
+                        (:instance *-weakly-monotonic (x 1/2)
+                                                      (y (fl (* (expt 2 (* (k**) (rho**))) (q** k))))
+                                                      (y+ (* (expt 2 (* (k**) (rho**))) (q** (k**)))))))))
+
+(local-defthm lemma-4-1-45
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (>= (q** k) (q** (k**))))
+           (>= (fl (* (expt 2 (1- (* (k**) (rho**)))) (q** k)))
+               (fl (* (expt 2 (1- (* (k**) (rho**)))) (q** (k**))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint
+                        (:instance fl-monotone-linear (x (* (expt 2 (1- (* (k**) (rho**)))) (q** (k**))))
+                                                      (y (* (expt 2 (1- (* (k**) (rho**)))) (q** k))))
+                        (:instance *-weakly-monotonic (x (expt 2 (1- (* (k**) (rho**)))))
+                                                      (y (q** (k**)))
+                                                      (y+ (q** k)))))))
+
+(local-defthm lemma-4-1-46
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**)))
+                (>= (x**) (* (q0**) (q0**))))
+           (= (q1**) (q0**)))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint q1** q0** s1**))))
+
+(local-defthm lemma-4-1-47
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (integerp (* (expt 2 (* k (rho**)))
+                        (q** (k**)))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint
+                        (:instance lemma-4-1-31 (k (k**)))
+                        (:instance lemma-4-1-29 (a (* (expt 2 (* (k**) (rho**))) (q** (k**))))
+                                                (b (expt 2 (* (- k (k**)) (rho**)))))))))
+
+(local-defthm lemma-4-1-48
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**))))
+           (< (* (expt 2 (* k (rho**))) (q** k))
+              (* (expt 2 (* k (rho**))) (q** (k**)))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint
+                        (:instance *-strongly-monotonic (x (expt 2 (* k (rho**))))
+                                                        (y (q** k))
+                                                        (y+ (q** (k**))))))))
+
+(local-defthm lemma-4-1-49
+  (implies (and (integerp a) (integerp b) (< a b))
+           (<= a (1- b)))
+  :rule-classes ())
+
+(local-defthm lemma-4-1-50
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**))))
+           (<= (* (expt 2 (* k (rho**))) (q** k))
+               (1- (* (expt 2 (* k (rho**))) (q** (k**))))))               
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint lemma-4-1-31 lemma-4-1-47 lemma-4-1-48
+                        (:instance lemma-4-1-49 (a (* (expt 2 (* k (rho**))) (q** k))) (b (* (expt 2 (* k (rho**))) (q** (k**)))))))))
+
+(local-defthm lemma-4-1-51
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**))))
+           (<= (q** k)
+               (- (q** (k**))
+                  (expt 2 (- (* k (rho**)))))))            
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint lemma-4-1-50
+                        (:instance *-weakly-monotonic (x (expt 2 (- (* k (rho**)))))
+                                                      (y (* (expt 2 (* k (rho**))) (q** k)))
+                                                      (y+ (1- (* (expt 2 (* k (rho**))) (q** (k**))))))))))
+
+(local-defthm lemma-4-1-52
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (< (abs (- (q** k) (q** (k**))))
+              1/4))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-41 k**-rho**-constraint))))
+
+(local-defthm lemma-4-1-53
+  (implies (and (not (zp k))
+                (>= k (k**)))
+           (> (q** k) 0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q**-rewrite-2)
+                  :use (lemma-4-1-52 lemma-4-1-b))))
+
+(local-defthm lemma-4-1-54
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**))))
+           (<= (expt (+ (q** k) (expt 2 (- (* k (rho**))))) 2)
+               (* (q** (k**)) (q** (k**)))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint lemma-4-1-51 lemma-4-1-53
+                        (:instance cg-sqrt-1 (x (+ (q** k) (expt 2 (- (* k (rho**))))))
+                                             (y (q** (k**))))))))
+
+(local-defthm lemma-4-1-55
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**)))
+                (>= (x**) (* (q0**) (q0**))))
+           (<= (expt (+ (q** k) (expt 2 (- (* k (rho**))))) 2)
+               (* (q0**) (q0**))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q**-rewrite-2)
+                  :use (k**-rho**-constraint lemma-4-1-46 lemma-4-1-54))))
+
+(local-defthm lemma-4-1-56
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**)))
+                (>= (x**) (* (q0**) (q0**))))
+           (<= (expt (+ (q** k) (expt 2 (- (* k (rho**))))) 2)
+               (x**)))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint lemma-4-1-55))))
+
+(local-defthm lemma-4-1-57
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**)))
+                (< (x**) (* (q0**) (q0**))))
+           (= (mod (s1**) 2) 1))
+  :rule-classes ()
+  :hints (("Goal" :expand ((s1**))
+                  :use (k**-rho**-constraint s**-constraint
+                        (:instance mod-mod-2-not-equal (m (s**)))
+                        (:instance mod012 (m (s**)))))))
+
+(local-defthm lemma-4-1-58
+  (implies (and (integerp a) (= (mod a 2) 1))
+           (= (fl (/ a 2))
+              (- (/ a 2) 1/2)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-def (x a) (y 2))))))
+
+(local-defthm lemma-4-1-59
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**)))
+                (< (x**) (* (q0**) (q0**))))
+           (= (fl (* (expt 2 (1- (* (k**) (rho**)))) (q1**)))
+                  (- (* (expt 2 (1- (* (k**) (rho**)))) (q1**))
+                     1/2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q**-rewrite-2)
+                  :use (k**-rho**-constraint lemma-4-1-47 lemma-4-1-57
+                        (:instance lemma-4-1-58 (a (* (expt 2 (* (k**) (rho**))) (q1**))))))))
+
+(local-defthm lemma-4-1-60
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**)))
+                (< (x**) (* (q0**) (q0**))))
+           (> (* (expt 2 (1- (* (k**) (rho**)))) (q** k))
+              (- (* (expt 2 (1- (* (k**) (rho**)))) (q1**))
+                 1/2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q**-rewrite-2)
+                  :use (k**-rho**-constraint lemma-4-1-41
+                        (:instance *-strongly-monotonic (x (expt 2 (1- (* (k**) (rho**)))))
+                                                        (y+ (q** k))
+                                                        (y (- (q1**) (expt 2 (- (* (k**) (rho**)))))))))))
+
+(local-defthm lemma-4-1-61
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**)))
+                (< (x**) (* (q0**) (q0**))))
+           (> (* (expt 2 (1- (* (k**) (rho**)))) (q** k))
+              (fl (* (expt 2 (1- (* (k**) (rho**)))) (q1**)))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint lemma-4-1-60 lemma-4-1-59))))
+
+(local-defthm lemma-4-1-62
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (q** k) (q** (k**)))
+                (< (x**) (* (q0**) (q0**))))
+           (>= (fl (* (expt 2 (1- (* (k**) (rho**)))) (q** k)))
+               (fl (* (expt 2 (1- (* (k**) (rho**)))) (q1**)))))
+  :rule-classes ()
+  :hints (("Goal" :use (k**-rho**-constraint lemma-4-1-61))))
+
+(defthm lemma-4-1-c
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (x**) (expt (+ (q** k) (expt 2 (- (* k (rho**))))) 2)))
+           (= (fl (* (expt 2 (1- (* (k**) (rho**)))) (q** k)))
+              (fl (* (expt 2 (1- (* (k**) (rho**)))) (q1**)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q**-rewrite-2)
+                  :use (k**-rho**-constraint lemma-4-1-44 lemma-4-1-45 lemma-4-1-56 lemma-4-1-62))))
+
+(defun cg-sqrt (x min max)
+  (declare (xargs :measure (nfix (- (1+ max) min))))  
+  (if (and (natp min)
+           (natp max)
+           (<= min max))
+      (if (>= (* min min) x)
+          min
+        (cg-sqrt x (1+ min) max))
+    0))
+
+(defun seed (l k rho)
+  (1- (cg-sqrt (* (expt 2 (* k rho)) (1+ l)) 
+               (if (= (* k rho) 1)
+                   1
+                 (expt 2 (- (* k rho) 2)))
+               (expt 2 (* k rho)))))
+
+(local-defthm cg-sqrt-2
+  (implies (and (rationalp x)
+                (not (zp min))
+                (not (zp max))
+                (<= min max)
+                (< (* (1- min) (1- min)) x)
+                (<= x (* max max)))
+           (let ((y (cg-sqrt x min max)))
+             (and (<= x (* y y))
+                  (< (* (1- y) (1- y)) x))))
+  :rule-classes ()
+  :hints (("Subgoal *1/3" :use ((:instance cg-sqrt-1 (x min) (y max))))))
+
+(defthm cg-sqrt-lemma
+  (implies (and (rationalp x)
+                (not (zp min))
+                (not (zp max))
+                (<= (* min min) x)
+                (<= x (* max max)))
+           (let ((y (cg-sqrt x min max)))
+             (and (<= x (* y y))
+                  (< (* (1- y) (1- y)) x))))
+  :rule-classes ()
+  :hints (("Goal" :use (cg-sqrt-2
+                        (:instance cg-sqrt-1 (x min) (y max))))))
+
+(local-defthm natp-cg
+  (implies (natp min)
+           (natp (cg-sqrt x min max)))
+  :rule-classes (:rewrite :type-prescription))
+
+(in-theory (disable cg-sqrt))
+
+(local-defthm lemma-4-2-1
+  (IMPLIES (AND (NOT (ZP K))
+                (NOT (ZP RHO)))
+           (< (EXPT 2 (+ -4 (* K RHO)))
+              (EXPT 2 (+ -2 (* K RHO)))))
+:rule-classes ())
+
+(local-defthm lemma-4-2-2
+  (IMPLIES (AND (< l (EXPT 2 (+ -4 (* K RHO))))
+                (NOT (ZP K))
+                (NOT (ZP RHO))
+                (INTEGERP L))
+           (> (EXPT 2 (+ -2 (* K RHO))) L))
+  :hints (("Goal" :use (lemma-4-2-1)
+                  :in-theory (theory 'minimal-theory))))
+
+(local-defthm lemma-4-2-3
+  (IMPLIES (AND (< (+ 1 L) (EXPT 2 (+ -4 (* K RHO))))
+                (NOT (ZP K))
+                (NOT (ZP RHO))
+                (INTEGERP L))
+           (not (<= (EXPT 2 (+ -2 (* K RHO))) L)))
+  :hints (("Goal" :use (lemma-4-2-2))))
+
+(local-defthm lemma-4-2-4
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (>= (expt (1+ (seed l k rho)) 2)
+               (* (expt 2 (* k rho)) (1+ l))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance cg-sqrt-lemma (x (* (expt 2 (* k rho)) (1+ l)))
+                                                 (min (expt 2 (- (* k rho) 2)))
+                                                 (max (expt 2 (* k rho))))))))
+
+(local-defthm lemma-4-2-5
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (< (expt (seed l k rho) 2)
+              (* (expt 2 (* k rho)) (1+ l))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance cg-sqrt-lemma (x (* (expt 2 (* k rho)) (1+ l)))
+                                                 (min (expt 2 (- (* k rho) 2)))
+                                                 (max (expt 2 (* k rho))))))))
+
+(local-defthm lemma-4-2-6
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (> (* (expt 2 (* k rho)) (1+ l))
+              (expt 2 (- (* 2 k rho) 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2-4
+                        (:instance *-strongly-monotonic (x (expt 2 (* k rho))) (y+ (1+ l)) (y (expt 2 (- (* k rho) 2))))))))
+
+(local-defthm lemma-4-2-7
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (> (expt (1+ (seed l k rho)) 2)
+              (expt 2 (- (* 2 k rho) 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2-4 lemma-4-2-6)
+                  :in-theory (theory 'minimal-theory))))
+
+(in-theory (disable seed))
+
+(local-defthm lemma-4-2-8
+  (implies (integerp n)
+           (equal (expt 4 n)
+                  (expt 2 (* 2 n)))))
+
+(local-defthm lemma-4-2-9
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (> (1+ (seed l k rho))
+              (expt 2 (1- (* k rho)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2-7
+                        (:instance cg-sqrt-1 (x (1+ (seed l k rho))) (y (expt 2 (1- (* k rho)))))))
+          ("Goal'''" :in-theory (enable seed))))
+
+(local (in-theory (disable lemma-4-2-8)))
+
+(local-defthm lemma-4-2-10
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp l)
+                (< l (expt 2 (* k rho))))
+           (<= (* (expt 2 (* k rho)) (1+ l))
+               (expt 2 (* 2 k rho))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (x (expt 2 (* k rho))) (y (1+ l)) (y+ (expt 2 (* k rho))))))))
+
+(local-defthm lemma-4-2-11
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (< (expt (seed l k rho) 2)
+              (expt 2 (* 2 k rho))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-2-5 lemma-4-2-10))))
+
+(local-defthm lemma-4-2-12
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (< (seed l k rho)
+              (expt 2 (* k rho))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2-11
+                        (:instance cg-sqrt-1 (y (seed l k rho)) (x (expt 2 (* k rho))))))))
+
+(local (encapsulate ()
+ (local (set-default-hints
+         '((nonlinearp-default-hint stable-under-simplificationp
+                                    hist pspv))))
+ (defthm lemma-4-2-13
+   (implies (and (rationalp a)
+                 (rationalp b)
+                 (rationalp c)
+                 (<= 1 a)
+                 (< 0 b)
+                 (< 0 c)
+                 (<= (expt a 2) (* b (+ c 1)))
+                 (<= b (* 4 c)))
+            (< (expt (- a 1) 2) (* b c))))))
+
+(local-defthm lemma-4-2-14
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l))
+           (<= (expt 2 (* k rho))
+               (* 4 l)))
+  :rule-classes ())
+
+(local-defthm lemma-4-2-15
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (<= (expt (1- (seed l k rho)) 2)
+               (* (expt 2 (* k rho)) l)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2-5 lemma-4-2-9 lemma-4-2-14
+                        (:instance lemma-4-2-13 (a (seed l k rho)) (b (expt 2 (* k rho))) (c l))))))
+
+(local-defthm lemma-4-2-16
+  (implies (and (natp l)
+                (<= 1/2 l)
+                (< l 2))
+           (= l 1))
+  :rule-classes ())
+
+(local-defthm lemma-4-2-18
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (>= (* (expt 2 (- (* k rho))) (expt (1+ (seed l k rho)) 2))
+               (1+ l)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2-4
+                        (:instance *-weakly-monotonic (x (expt 2 (* k rho)))
+                                                      (y (1+ l))
+                                                      (y+ (* (expt 2 (- (* k rho))) (expt (1+ (seed l k rho)) 2))))))))
+
+(local-defthm lemma-4-2-19
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (>= (* k rho) 2)
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (<= (* (expt 2 (- (* k rho))) (expt (1- (seed l k rho)) 2))
+               l))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2-15
+                        (:instance *-weakly-monotonic (x (expt 2 (* k rho)))
+                                                      (y+ l)
+                                                      (y (* (expt 2 (- (* k rho))) (expt (1- (seed l k rho)) 2))))))))
+
+(defthm lemma-4-2-20
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (< (* k rho) 2))
+           (and (= k 1)
+                (= rho 1)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (x k) (y 2) (y+ rho))
+                        (:instance *-weakly-monotonic (x rho) (y 2) (y+ k))))))
+
+(defthm lemma-4-2
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (and (integerp (seed l k rho))
+                (<= (expt 2 (1- (* k rho))) (seed l k rho))
+                (< (seed l k rho) (expt 2 (* k rho)))
+                (<= (* (expt 2 (- (* k rho))) (expt (1- (seed l k rho)) 2))
+                    l)
+                (>= (* (expt 2 (- (* k rho))) (expt (1+ (seed l k rho)) 2))
+                    (1+ l))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2-9 lemma-4-2-12 lemma-4-2-18 lemma-4-2-19 lemma-4-2-16 lemma-4-2-20))))
+
+(defund digit (i seed k rho )
+  (bits seed (1- (* (- (1+ k) i) rho)) (* (- k i) rho)))
+
+(defund root (i seed k rho)
+  (if (zp i)
+      0
+    (+ (root (1- i) seed k rho)
+       (* (expt 2 (- (* i rho)))
+          (digit i seed k rho)))))
+
+(local-defthm lemma-4-3-1
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp seed)
+                (<= (expt 2 (- (* k rho) 2)) seed)
+                (< seed (expt 2 (* k rho))))
+           (= (* (expt 2 (* rho))
+                 (root 1 seed k rho))              
+              (bits seed (1- (* k rho)) (* (- k 1) rho))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable root digit))))
+
+(local-defthm lemma-4-3-2
+  (implies (and (not (zp i))
+                (not (zp rho))
+                (> i 1))
+           (>= (* i rho) (* 2 rho)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (x rho) (y 2) (y+ i))))))
+
+(local-defthm lemma-4-3-3
+  (implies (and (not (zp i))
+                (not (zp rho))
+                (> i 1))
+           (>= (* 2 rho) (1+ rho)))
+  :rule-classes ())
+
+(local-defthm lemma-4-3-4
+  (implies (and (not (zp i))
+                (not (zp rho))
+                (> i 1))
+           (>= (* i rho) (1+ rho)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (lemma-4-3-2 lemma-4-3-3))))
+
+(local-defthm lemma-4-3-5
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp seed)
+                (<= (expt 2 (- (* k rho) 2)) seed)
+                (< seed (expt 2 (* k rho)))
+                (not (zp i))
+                (> i 1)
+                (<= i k)
+                (= (* (expt 2 (* (1- i) rho))
+                      (root (1- i) seed k rho))                   
+                   (bits seed (1- (* k rho)) (* (- k (1- i)) rho))))
+           (= (* (expt 2 (* i rho))
+                 (root i seed k rho))              
+              (bits seed (1- (* k rho)) (* (- k i) rho))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable root digit)
+                  :use (lemma-4-3-4
+                        (:instance bits-plus-bits (x seed)
+                                                  (n (1- (* k rho)))
+                                                  (m (* (- k i) rho))
+                                                  (p (* (- k (1- i)) rho)))))))
+
+(local-defthm lemma-4-3-6
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp seed)
+                (<= (expt 2 (- (* k rho) 2)) seed)
+                (< seed (expt 2 (* k rho)))
+                (not (zp i))
+                (<= i k))
+           (= (* (expt 2 (* i rho))
+                 (root i seed k rho))              
+              (bits seed (1- (* k rho)) (* (- k i) rho))))
+  :rule-classes ()
+  :hints (("Goal" :induct (natp-induct i))
+          ("Subgoal *1/" :use (lemma-4-3-5 lemma-4-3-1))))
+
+(local-defthm lemma-4-3-7
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp seed)
+                (<= (expt 2 (- (* k rho) 2)) seed)
+                (< seed (expt 2 (* k rho))))
+           (= (* (expt 2 (* k rho))
+                 (root k seed k rho))              
+              seed))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bvecp)
+                  :use ((:instance lemma-4-3-6 (i k))
+                        (:instance bits-tail (x seed) (i (1- (expt 2 (* k rho)))))))))
+
+(defthm lemma-4-3
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp seed)
+                (<= (expt 2 (- (* k rho) 2)) seed)
+                (< seed (expt 2 (* k rho))))
+           (= (root k seed k rho)
+              (* (expt 2 (- (* k rho))) seed)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-3-7))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta1/sqrt.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta1/sqrt.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta1/sqrt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta1/sqrt.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,8884 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "division")
+
+;;**********************************************************************************
+
+(encapsulate (((rho$$) => *) ((x$$) => *) ((h$$ *) => *))
+  (local (defun rho$$ () 1))
+  (local (defun x$$ () 0))
+  (local (defun h$$ (k) (declare (ignore k)) 0))
+  (defthm rho$$-constraint
+    (integerp (rho$$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm x$$-constraint
+    (rationalp (x$$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm integerp-h$$ 
+    (implies (not (zp k))
+             (integerp (h$$ k)))
+    :rule-classes (:rewrite :type-prescription)))
+
+(defund q$$ (k)
+  (if (zp k)
+      0
+    (+ (q$$ (1- k))
+       (/ (h$$ k) (expt 2 (* k (rho$$)))))))
+
+(defund p$$ (k) 
+  (if (zp k)
+      (x$$)
+    (- (* (expt 2 (rho$$)) (p$$ (1- k)))
+       (* (h$$ k) 
+          (+ (* 2 (q$$ (1- k))) 
+             (/ (h$$ k) (expt 2 (* k (rho$$)))))))))
+
+(local-defthm lemma-3-1-1
+  (implies (not (zp k))
+           (= (* (expt 2 (* k (rho$$)))
+                 (- (x$$) (* (q$$ k) (q$$ k))))
+              (- (* (expt 2 (* k (rho$$)))
+                    (- (x$$) (* (q$$ (1- k)) (q$$ (1- k)))))
+                 (* (h$$ k) (+ (* 2 (q$$ (1- k))) (/ (h$$ k) (expt 2 (* k (rho$$)))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable q$$))))
+
+(local-defthm lemma-3-1-2
+  (implies (and (not (zp k))
+                (= (p$$ (1- k))
+                   (* (expt 2 (* (1- k) (rho$$)))
+                      (- (x$$) (* (q$$ (1- k)) (q$$ (1- k)))))))
+           (= (* (expt 2 (* k (rho$$)))
+                 (- (x$$) (* (q$$ (1- k)) (q$$ (1- k)))))
+              (* (expt 2 (rho$$))
+                 (p$$ (1- k)))))
+  :rule-classes ())
+
+(local-defthm lemma-3-1-3
+  (implies (and (rationalp a)
+                (rationalp b) 
+                (rationalp c)
+                (rationalp d)
+                (= a (- b c))
+                (= b d))
+           (= a (- d c)))
+:rule-classes ())
+
+(local-defthm lemma-3-1-4
+  (implies (and (not (zp k))
+                (= (p$$ (1- k))
+                   (* (expt 2 (* (1- k) (rho$$)))
+                      (- (x$$) (* (q$$ (1- k)) (q$$ (1- k)))))))
+           (= (* (expt 2 (* k (rho$$)))
+                 (- (x$$) (* (q$$ k) (q$$ k))))
+              (- (* (expt 2 (rho$$))
+                    (p$$ (1- k)))
+                 (* (h$$ k) (+ (* 2 (q$$ (1- k))) (/ (h$$ k) (expt 2 (* k (rho$$)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-1-1 
+                        lemma-3-1-2
+                        (:instance lemma-3-1-3 (a (* (expt 2 (* k (rho$$))) (- (x$$) (* (q$$ k) (q$$ k)))))
+                                               (b (* (expt 2 (* k (rho$$))) (- (x$$) (* (q$$ (1- k)) (q$$ (1- k))))))
+                                               (c (* (h$$ k) (+ (* 2 (q$$ (1- k))) (/ (h$$ k) (expt 2 (* k (rho$$)))))))
+                                               (d (* (expt 2 (rho$$)) (p$$ (1- k)))))))))
+
+(local-defthm lemma-3-1-5
+  (implies (and (not (zp k))
+                (= (p$$ (1- k))
+                   (* (expt 2 (* (1- k) (rho$$)))
+                      (- (x$$) (* (q$$ (1- k)) (q$$ (1- k)))))))
+           (= (p$$ k)
+              (* (expt 2 (* k (rho$$)))
+                 (- (x$$) (* (q$$ k) (q$$ k))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-1-4)
+                  :in-theory (enable q$$ p$$))))
+
+(local-defthm lemma-3-1-5
+  (implies (and (not (zp k))
+                (= (p$$ (1- k))
+                   (* (expt 2 (* (1- k) (rho$$)))
+                      (- (x$$) (* (q$$ (1- k)) (q$$ (1- k)))))))
+           (= (p$$ k)
+              (* (expt 2 (* k (rho$$)))
+                 (- (x$$) (* (q$$ k) (q$$ k))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-1-4)
+                  :in-theory (enable q$$ p$$))))
+
+(local-defthm lemma-3-1-6
+  (implies (zp k)
+           (= (p$$ k)
+              (- (x$$) (* (q$$ k) (q$$ k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable p$$ q$$))))
+
+(defthmd lemma-3-1
+  (implies (natp k)
+           (equal (p$$ k)
+                  (* (expt 2 (* k (rho$$)))
+                     (- (x$$) (* (q$$ k) (q$$ k))))))
+  :hints (("Goal" :induct (natp-induct k))
+          ("Subgoal *1/2" :use lemma-3-1-5)
+          ("Subgoal *1/1" :use lemma-3-1-6)))
+
+;;**********************************************************************************
+
+(defthm *-weakly-monotonic
+  (implies (and (rationalp y)
+                (rationalp y+)
+                (rationalp x)
+                (> x 0))
+           (iff (<= y y+)
+                (<= (* x y) (* x y+))))
+  :rule-classes ())
+
+(defthm *-strongly-monotonic
+  (implies (and (rationalp y)
+                (rationalp y+)
+                (rationalp x)
+                (> x 0))
+           (iff (< y y+)
+                (< (* x y) (* x y+))))
+  :rule-classes ())
+
+(defthm *-weakly-monotonic-neg
+  (implies (and (rationalp y)
+                (rationalp y+)
+                (rationalp x)
+                (< x 0))
+           (iff (<= y y+)
+                (>= (* x y) (* x y+))))
+  :rule-classes ())
+
+(defthm *-strongly-monotonic-neg
+  (implies (and (rationalp y)
+                (rationalp y+)
+                (rationalp x)
+                (< x 0))
+           (iff (< y y+)
+                (> (* x y) (* x y+))))
+  :rule-classes ())
+
+(local-defthm lemma-3-2-1
+  (implies (not (zp k))
+           (iff (<= (* (- (q$$ k) (expt 2 (- (* k (rho$$))))) (- (q$$ k) (expt 2 (- (* k (rho$$))))))
+                    (x$$))
+                (<= (+ (* (q$$ k) (q$$ k)) (- (* (expt 2 (- 1 (* k (rho$$)))) (q$$ k))) (expt 2 (- (* 2 k (rho$$)))))
+                    (x$$))))
+  :rule-classes ())
+
+(local-defthm lemma-3-2-2
+  (implies (not (zp k))
+           (iff (<= (+ (* (q$$ k) (q$$ k)) (- (* (expt 2 (- 1 (* k (rho$$)))) (q$$ k))) (expt 2 (- (* 2 k (rho$$)))))
+                    (x$$))
+                (<= (- (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                    (* (expt 2 (* k (rho$$))) (- (x$$) (* (q$$ k) (q$$ k)))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic 
+                                   (x (expt 2 (* k (rho$$)))) 
+                                   (y (+ (* (q$$ k) (q$$ k)) (- (* (expt 2 (- 1 (* k (rho$$)))) (q$$ k))) (expt 2 (- (* 2 k (rho$$))))))
+                                   (y+ (x$$)))))))
+
+(local-defthm lemma-3-2-3
+  (implies (not (zp k))
+           (iff (<= (+ (* (q$$ k) (q$$ k)) (- (* (expt 2 (- 1 (* k (rho$$)))) (q$$ k))) (expt 2 (- (* 2 k (rho$$)))))
+                    (x$$))
+                (<= (- (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                    (p$$ k))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-2)
+                  :in-theory (enable lemma-3-1))))
+
+(local-defthm lemma-3-2-4
+  (implies (not (zp k))
+           (iff (<= (* (- (q$$ k) (expt 2 (- (* k (rho$$))))) (- (q$$ k) (expt 2 (- (* k (rho$$))))))
+                    (x$$))
+                (<= (- (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                    (p$$ k))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-1 lemma-3-2-3))))
+
+(local-defthm lemma-3-2-5
+  (implies (not (zp k))
+           (iff (> (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) (+ (q$$ k) (expt 2 (- (* k (rho$$))))))
+                   (x$$))
+                (> (+ (* (q$$ k) (q$$ k)) (* (expt 2 (- 1 (* k (rho$$)))) (q$$ k)) (expt 2 (- (* 2 k (rho$$)))))
+                   (x$$))))
+  :rule-classes ())
+
+(local-defthm lemma-3-2-6
+  (implies (not (zp k))
+           (iff (> (+ (* (q$$ k) (q$$ k)) (* (expt 2 (- 1 (* k (rho$$)))) (q$$ k)) (expt 2 (- (* 2 k (rho$$)))))
+                   (x$$))
+                (> (+ (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                   (* (expt 2 (* k (rho$$))) (- (x$$) (* (q$$ k) (q$$ k)))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-strongly-monotonic 
+                                   (x (expt 2 (* k (rho$$)))) 
+                                   (y+ (+ (* (q$$ k) (q$$ k)) (* (expt 2 (- 1 (* k (rho$$)))) (q$$ k)) (expt 2 (- (* 2 k (rho$$))))))
+                                   (y (x$$)))))))
+
+(local-defthm lemma-3-2-7
+  (implies (not (zp k))
+           (iff (> (+ (* (q$$ k) (q$$ k)) (* (expt 2 (- 1 (* k (rho$$)))) (q$$ k)) (expt 2 (- (* 2 k (rho$$)))))
+                   (x$$))
+                (> (+ (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                   (p$$ k))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-6)
+                  :in-theory (enable lemma-3-1))))
+
+(local-defthm lemma-3-2-8
+  (implies (not (zp k))
+           (iff (> (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) (+ (q$$ k) (expt 2 (- (* k (rho$$))))))
+                   (x$$))
+                (> (+ (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                   (p$$ k))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-5 lemma-3-2-7))))
+
+(defthm lemma-3-2-a-b
+  (implies (not (zp k))
+           (iff (and (<= (* (- (q$$ k) (expt 2 (- (* k (rho$$))))) (- (q$$ k) (expt 2 (- (* k (rho$$))))))
+                         (x$$))
+                     (< (x$$)
+                        (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) (+ (q$$ k) (expt 2 (- (* k (rho$$))))))))
+                (and (<= (- (* 2 (q$$ k)))
+                         (- (p$$ k) (expt 2 (- (* k (rho$$))))))
+                     (< (- (p$$ k) (expt 2 (- (* k (rho$$)))))
+                        (* 2 (q$$ k))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-4 lemma-3-2-8))))
+
+(local-defthm lemma-3-2-9
+  (implies (not (zp k))
+           (iff (> (+ (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                   (p$$ k))
+                (< (* (expt 2 (rho$$)) (p$$ (1- k)))
+                   (* (1+ (h$$ k))
+                      (+ (* 2 (q$$ (1- k)))
+                         (* (1+ (h$$ k)) (expt 2 (- (* k (rho$$))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable p$$ q$$))))
+
+(local-defthm lemma-3-2-10
+  (implies (not (zp k))
+           (iff (< (* (expt 2 (rho$$)) (p$$ (1- k)))
+                   (* (1+ (h$$ k))
+                      (+ (* 2 (q$$ (1- k)))
+                         (* (1+ (h$$ k)) (expt 2 (- (* k (rho$$))))))))
+                (< (p$$ (1- k))
+                   (* (expt 2 (- (rho$$)))
+                      (1+ (h$$ k))
+                      (+ (* 2 (q$$ (1- k)))
+                         (* (1+ (h$$ k)) (expt 2 (- (* k (rho$$))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-strongly-monotonic
+                                   (x (expt 2 (- (rho$$))))
+                                   (y (* (expt 2 (rho$$)) (p$$ (1- k))))
+                                   (y+ (* (1+ (h$$ k))
+                                          (+ (* 2 (q$$ (1- k)))
+                                             (* (1+ (h$$ k)) (expt 2 (- (* k (rho$$)))))))))))))
+
+(local-defthm lemma-3-2-11
+  (implies (not (zp k))
+           (iff (> (+ (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                   (p$$ k))
+                (< (p$$ (1- k))
+                   (* (expt 2 (- (rho$$)))
+                      (1+ (h$$ k))
+                      (+ (* 2 (q$$ (1- k)))
+                         (* (1+ (h$$ k)) (expt 2 (- (* k (rho$$))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-9 lemma-3-2-10))))
+
+(local-defthm lemma-3-2-12
+  (implies (not (zp k))
+           (iff (<= (- (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                    (p$$ k))
+                (>= (* (expt 2 (rho$$)) (p$$ (1- k)))
+                    (* (1- (h$$ k))
+                       (+ (* 2 (q$$ (1- k)))
+                          (* (1- (h$$ k)) (expt 2 (- (* k (rho$$))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable p$$ q$$))))
+
+(local-defthm lemma-3-2-13
+  (implies (not (zp k))
+           (iff (>= (* (expt 2 (rho$$)) (p$$ (1- k)))
+                    (* (1- (h$$ k))
+                       (+ (* 2 (q$$ (1- k)))
+                          (* (1- (h$$ k)) (expt 2 (- (* k (rho$$))))))))
+                (>= (p$$ (1- k))
+                    (* (expt 2 (- (rho$$)))
+                       (1- (h$$ k))
+                       (+ (* 2 (q$$ (1- k)))
+                          (* (1- (h$$ k)) (expt 2 (- (* k (rho$$))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic
+                                   (x (expt 2 (- (rho$$))))
+                                   (y+ (* (expt 2 (rho$$)) (p$$ (1- k))))
+                                   (y (* (1- (h$$ k))
+                                         (+ (* 2 (q$$ (1- k)))
+                                            (* (1- (h$$ k)) (expt 2 (- (* k (rho$$)))))))))))))
+
+(local-defthm lemma-3-2-14
+  (implies (not (zp k))
+           (iff (<= (- (expt 2 (- (* k (rho$$)))) (* 2 (q$$ k)))
+                    (p$$ k))
+                (>= (p$$ (1- k))
+                    (* (expt 2 (- (rho$$)))
+                       (1- (h$$ k))
+                       (+ (* 2 (q$$ (1- k)))
+                          (* (1- (h$$ k)) (expt 2 (- (* k (rho$$))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-12 lemma-3-2-13))))
+
+(defthm lemma-3-2-b-c
+  (implies (not (zp k))
+           (iff (and (<= (- (* 2 (q$$ k)))
+                         (- (p$$ k) (expt 2 (- (* k (rho$$))))))
+                     (< (- (p$$ k) (expt 2 (- (* k (rho$$)))))
+                        (* 2 (q$$ k))))
+                (and (<= (* (expt 2 (- (rho$$)))
+                            (1- (h$$ k))
+                            (+ (* 2 (q$$ (1- k)))
+                               (* (1- (h$$ k)) (expt 2 (- (* k (rho$$)))))))
+                         (p$$ (1- k)))
+                     (< (p$$ (1- k))
+                        (* (expt 2 (- (rho$$)))
+                           (1+ (h$$ k))
+                           (+ (* 2 (q$$ (1- k)))
+                              (* (1+ (h$$ k)) (expt 2 (- (* k (rho$$)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-11 lemma-3-2-14))))
+
+;;**********************************************************************************
+
+(local-defthm lemma-3-3-1
+  (implies (and (not (zp (rho$$)))
+                (integerp n))
+           (integerp (* (expt 2 (rho$$)) n)))
+  :rule-classes())
+
+(local-defthm lemma-3-3-2
+  (implies (and (not (zp k))
+                (not (zp (rho$$)))
+                (integerp (* (expt 2 (* (1- k) (rho$$))) (q$$ (1- k)))))
+           (integerp (* (expt 2 (* k (rho$$))) (q$$ k))))
+  :rule-classes()
+  :hints (("Goal" :in-theory (enable q$$)
+                  :use (:instance lemma-3-3-1 (n (* (expt 2 (* (1- k) (rho$$))) (q$$ (1- k))))))))
+
+(local-defthm lemma-3-3-3
+  (implies (and (natp k)
+                (not (zp (rho$$))))
+           (integerp (* (expt 2 (* k (rho$$))) (q$$ k))))
+  :rule-classes()
+  :hints (("Goal" :induct (natp-induct k))
+          ("Subgoal *1/2" :use lemma-3-3-2)
+          ("Subgoal *1/1" :in-theory (enable q$$))))
+
+(local-defthm lemma-3-3-4
+  (implies (and (rationalp x)
+                (not (zp m))
+                (integerp (* x m))
+                (< x 1))
+           (< (* x m) m))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance *-strongly-monotonic (x m) (y x) (y+ 1)))))
+
+(local-defthm lemma-3-3-5
+  (implies (and (integerp n)
+                (integerp m)
+                (< n m))
+           (<= n (1- m)))
+  :rule-classes ())
+
+(local-defthm lemma-3-3-6
+  (implies (and (rationalp x)
+                (not (zp m))
+                (integerp (* x m))
+                (< x 1))
+           (<= (* x m) (1- m)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-3-4
+                        (:instance lemma-3-3-5 (n (* x m)))))))
+
+(local-defthm lemma-3-3-7
+  (implies (and (rationalp x)
+                (not (zp m))
+                (integerp (* x m))
+                (< x 1))
+           (<= x (- 1 (/ m))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-3-6
+                        (:instance *-weakly-monotonic (x m) (y x) (y+ (- 1 (/ m))))))))
+
+(local-defthm lemma-3-3-8
+  (implies (and (natp k)
+                (not (zp (rho$$)))
+                (< (q$$ k) 1))
+           (<= (q$$ k) (- 1 (expt 2 (- (* k (rho$$)))))))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-3
+                        (:instance lemma-3-3-7 (x (q$$ k)) (m (expt 2 (* k (rho$$)))))))))
+
+(local-defthm lemma-3-3-9
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (<= (- (* 2 (q$$ (1- k))))
+                    (- (p$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))))
+                (< (- (p$$ (1- k)) (expt 2 (- (* (1- k) (rho$$)))))
+                   (* 2 (q$$ (1- k)))))
+           (< (abs (p$$ (1- k))) 2))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance lemma-3-3-8 (k (1- k)))))))
+
+(defthm lemma-3-3-a
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (<= (* (- (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))) (- (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))))
+                    (x$$))
+                (< (x$$)
+                   (* (+ (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))) (+ (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))))))
+           (< (abs (p$$ (1- k))) 2))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-9
+                        (:instance lemma-3-2-a-b (k (1- k)))))))
+
+(local-defthm lemma-3-3-10
+  (implies (and (not (zp k))
+                (< (h$$ k) (expt 2 (rho$$))))
+           (< (* (expt 2 (- (* k (rho$$)))) (h$$ k))
+              (expt 2 (* (- 1 k) (rho$$)))))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance *-strongly-monotonic (x (expt 2 (- (* k (rho$$))))) (y (h$$ k)) (y+ (expt 2 (rho$$))))))))
+
+(local-defthm lemma-3-3-11
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (< (h$$ k) (expt 2 (rho$$))))
+           (<= (q$$ k) (+ 1 (- (expt 2 (* (- 1 k) (rho$$)))) (* (h$$ k) (expt 2 (- (* k (rho$$))))))))
+  :rule-classes()
+  :hints (("Goal" :in-theory (enable q$$)
+                  :use ((:instance lemma-3-3-8 (k (1- k)))))))
+
+(local-defthm lemma-3-3-12
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (<= x (+ 1 (- y) z))
+                (< z y))
+           (< x 1))
+:rule-classes ())
+
+(local-defthm lemma-3-3-13
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (< (h$$ k) (expt 2 (rho$$))))
+           (< (q$$ k) 1))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-10
+                        lemma-3-3-11
+                        (:instance lemma-3-3-12 (x (q$$ k)) (y (expt 2 (* (- 1 k) (rho$$)))) (z (* (h$$ k) (expt 2 (- (* k (rho$$)))))))))))
+
+(local-defthm lemma-3-3-14
+  (implies (and (rationalp x)
+                (not (zp m))
+                (integerp (* x (* 2 m)))
+                (< x 1/2))
+           (< (* 2 x m) m))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance *-strongly-monotonic (x m) (y x) (y+ 1/2)))))
+
+(local-defthm lemma-3-3-16
+  (implies (and (rationalp x)
+                (not (zp m))
+                (integerp (* 2 x m))
+                (< x 1/2))
+           (<= (* 2 x m) (1- m)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-3-14
+                        (:instance lemma-3-3-5 (n (* 2 x m)))))))
+
+(local-defthm lemma-3-3-17
+  (implies (and (rationalp x)
+                (not (zp m))
+                (integerp (* 2 x m))
+                (< x 1/2))
+           (<= x (- 1/2 (/ (* 2 m)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-3-16
+                        (:instance *-weakly-monotonic (x (* 2 m)) (y x) (y+ (- 1/2 (/ (* 2 m)))))))))
+
+(local-defthm lemma-3-3-18
+  (implies (and (not (zp k))
+                (not (zp (rho$$)))
+                (< (q$$ k) 1/2))
+           (<= (q$$ k) (- 1/2 (expt 2 (- (* k (rho$$)))))))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-3
+                        (:instance lemma-3-3-17 (x (q$$ k)) (m (expt 2 (1- (* k (rho$$))))))))))
+
+(local-defthm lemma-3-3-19
+  (implies (and (not (zp k))
+                (> (h$$ k) (- (expt 2 (rho$$)))))
+           (> (* (expt 2 (- (* k (rho$$)))) (h$$ k))
+              (- (expt 2 (* (- 1 k) (rho$$))))))
+  :rule-classes()
+  :hints (("Goal" :use ((:instance *-strongly-monotonic (x (expt 2 (- (* k (rho$$))))) (y+ (h$$ k)) (y (- (expt 2 (rho$$)))))))))
+
+(local-defthm lemma-3-3-20
+  (implies (and (integerp a)
+                (integerp b)
+                (<= a b))
+           (<= (expt 2 a) (expt 2 b)))
+  :rule-classes ())
+
+(local-defthm lemma-3-3-21
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1))
+           (>= (- (expt 2 (* (- 1 k) (rho$$))))
+               -1/2))
+  :rule-classes()
+  :hints (("Goal" :use (:instance lemma-3-3-20 (a (* (- 1 k) (rho$$))) (b -1)))))
+
+(local-defthm lemma-3-3-22
+  (implies (and (rationalp a)
+                (rationalp b)
+                (rationalp c)
+                (> a b)
+                (>= b c))
+           (> a c))
+  :rule-classes ())
+
+(local-defthm lemma-3-3-23
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))
+                (> (h$$ k) (- (expt 2 (rho$$)))))
+           (> (* (expt 2 (- (* k (rho$$)))) (h$$ k))
+              -1/2))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-19 
+                        lemma-3-3-21
+                        (:instance lemma-3-3-22 (a (* (expt 2 (- (* k (rho$$)))) (h$$ k)))
+                                                (b (- (expt 2 (* (- 1 k) (rho$$)))))
+                                                (c -1/2))))))
+
+(local-defthm lemma-3-3-24
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))
+                (> (h$$ k) (- (expt 2 (rho$$)))))
+           (> (q$$ k) 0))
+  :rule-classes()
+  :hints (("Goal" :in-theory (enable q$$)
+                  :use (lemma-3-3-23))))
+
+(local-defthm lemma-3-3-25
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))
+                (< (q$$ k) 1/2)
+                (> (h$$ k) (- (expt 2 (rho$$)))))
+           (and (< 0  (+ (q$$ k) (expt 2 (- (* k (rho$$))))))
+                (<= (+ (q$$ k) (expt 2 (- (* k (rho$$))))) 1/2)))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-18 lemma-3-3-24))))
+
+(local-defthm lemma-3-3-26
+  (implies (and (rationalp x)
+                (rationalp y)
+                (<= 0 x)
+                (<= x y))
+           (<= (* x x) (* y y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (y x) (y+ y))
+                        (:instance *-weakly-monotonic (x y) (y x) (y+ y))))))
+
+(local-defthm lemma-3-3-27
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (> x 1/4)
+                (<= 1/2 (q$$ (1- k)))
+                (< (q$$ k) 1/2)
+                (> (h$$ k) (- (expt 2 (rho$$)))))
+              (< (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) 
+                    (+ (q$$ k) (expt 2 (- (* k (rho$$))))))
+                 x))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-25
+                        (:instance lemma-3-3-26 (x (+ (q$$ k) (expt 2 (- (* k (rho$$)))))) 
+                                                (y 1/2))))))
+
+(defthm lemma-3-3-b
+  (implies (and (not (zp (rho$$)))
+                (> (x$$) 1/4)
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (< (h$$ k) (expt 2 (rho$$)))
+                (> (h$$ k) (- (expt 2 (rho$$))))
+                (<= (x$$) (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) 
+                             (+ (q$$ k) (expt 2 (- (* k (rho$$))))))))
+           (and (<= 1/2 (q$$ k))
+                (< (q$$ k) 1)))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-13
+                        (:instance lemma-3-3-27 (x (x$$)))))))
+
+;;**********************************************************************************
+
+(defund sqrt-accessible-p (i j k rho m n)
+  (and (< (- (expt 2 (* (- 1 k) rho)) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n)) (expt 2 (* (- 1 k) rho))))))
+
+(defund check-upper-bound (entry i j k rho m n)
+  (or (= entry (1- (expt 2 rho)))
+      (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+          (if (or (< i (expt 2 (1- m)))
+                  (= i (1- (expt 2 m))))
+              (* (/ (1+ entry) (expt 2 rho))
+                 (+ (delta0 j n) (* (1+ entry) (expt 2 (- (* k rho))))))
+            (* (/ (1+ entry) (expt 2 rho))
+               (+ (delta0 j n) (expt 2 (- n)) (* (1+ entry) (expt 2 (- (* k rho))))))))))
+
+(defund check-lower-bound (entry i j k rho m n)
+  (or (= entry (- 1 (expt 2 rho)))
+      (>= (pi0 i m)
+          (if (< i (expt 2 (1- m)))
+              (* (/ (1- entry) (expt 2 rho))
+                 (+ (delta0 j n) (expt 2 (- n)) (* (1- entry) (expt 2 (- (* k rho))))))
+            (* (/ (1- entry) (expt 2 rho))
+               (+ (delta0 j n) (* (1- entry) (expt 2 (- (* k rho))))))))))
+
+(defund check-sqrt-entry (i j k rho m n entry)
+  (or (not (sqrt-accessible-p i j k rho m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (check-upper-bound entry i j k rho m n)
+           (check-lower-bound entry i j k rho m n))))
+
+(defund check-sqrt-row (i j k rho m n row)
+  (if (zp j)
+      t
+    (and (check-sqrt-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+         (check-sqrt-row i (1- j) k rho m n row))))
+
+(defund check-sqrt-rows (i k rho m n rows)
+  (if (zp i)
+      t
+    (and (check-sqrt-row (1- i) (expt 2 n) k rho m n (nth (1- i) rows))
+         (check-sqrt-rows (1- i) k rho m n rows))))
+
+(defund admissible-for-iteration-p (k rho m n table)
+  (check-sqrt-rows (expt 2 m) k rho m n table))
+
+(local-defthm check-sqrt-row-lemma
+  (implies (and (natp j)
+                (natp jj)
+                (< jj j)
+                (check-sqrt-row i j k rho m n row))
+           (check-sqrt-entry i jj k rho m n (ifix (nth jj row))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-row))))
+
+(local-defthm check-sqrt-rows-lemma
+  (implies (and (natp i)
+                (natp ii)
+                (< ii i)
+                (check-sqrt-rows i k rho m n rows))
+           (check-sqrt-row ii (expt 2 n) k rho m n (nth ii rows)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-rows))))
+
+(local-defthm check-sqrt-table-lemma
+  (implies (and (natp m)
+                (natp n)
+                (natp i)
+                (natp j)
+                (natp k)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (admissible-for-iteration-p k rho m n table))
+           (check-sqrt-entry i j k rho m n (lookup i j table)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lookup admissible-for-iteration-p)
+                  :use ((:instance check-sqrt-rows-lemma (rows table) (ii i) (i (expt 2 m)))
+                        (:instance check-sqrt-row-lemma (row (nth i table)) (jj j) (j (expt 2 n)))))))
+
+(local-defthm sqrt-table-1
+  (implies (and (natp k)
+                (natp rho)
+                (natp m)
+                (natp n)
+                (rationalp d)
+                (rationalp p)
+                (<= (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                (natp j)
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3))))))
+           (sqrt-accessible-p i j k rho m n))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sqrt-accessible-p))))
+
+(local-defthm sqrt-table-2
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+           (and (integerp h)
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry)
+                  :use (check-sqrt-table-lemma sqrt-table-1))))
+
+(local-defthm sqrt-table-3
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+           (or (= h (1- (expt 2 rho)))
+               (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+                   (if (or (< i (expt 2 (1- m)))
+                           (= i (1- (expt 2 m))))
+                       (* (/ (1+ h) (expt 2 rho))
+                          (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))
+                     (* (/ (1+ h) (expt 2 rho))
+                        (+ (delta0 j n) (expt 2 (- n)) (* (1+ h) (expt 2 (- (* k rho))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry check-upper-bound)
+                  :use (check-sqrt-table-lemma sqrt-table-1))))
+
+(local-defthm sqrt-table-4
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+           (or (= h (- 1 (expt 2 rho)))
+               (>= (pi0 i m)
+                   (if (< i (expt 2 (1- m)))
+                       (* (/ (1- h) (expt 2 rho))
+                          (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* k rho))))))
+                     (* (/ (1- h) (expt 2 rho))
+                        (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry check-lower-bound)
+                  :use (check-sqrt-table-lemma sqrt-table-1))))
+
+(local-defthm sqrt-table-5
+  (implies (and (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (= h (1- (expt 2 rho))))
+           (< p (* (/ (1+ h) (expt 2 rho))
+                   (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ())
+
+(local-defthm sqrt-table-6
+  (implies (and (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (= h (- 1 (expt 2 rho))))
+           (>= p (* (/ (1- h) (expt 2 rho))
+                    (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ())
+
+(local-defthm sqrt-table-7
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (and (rationalp (delta0 j n))
+                (rationalp (pi0 i m))
+                (>= (delta0 j n) 1)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable delta0 pi0))))
+
+(local-defthm sqrt-table-8
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (integerp h)
+                (>= (1+ h) 0))
+          (<= (* (/ (1+ h) (expt 2 rho))
+                 (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))
+              (* (/ (1+ h) (expt 2 rho))
+                 (+ d (* (1+ h) (expt 2 (- (* k rho))))))))              
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        (:instance *-weakly-monotonic (x (/ (1+ h) (expt 2 rho))) (y (delta0 j n)) (y+ d))))))
+
+(local-defthm sqrt-table-9
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (rationalp w)
+                (< x y)
+                (<= y z)
+                (<= z w))
+           (< x w))
+  :rule-classes ())
+
+(local-defthm sqrt-table-10
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (natp i)
+                (< i (expt 2 m))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (integerp h)
+                (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+                    (* (/ (1+ h) (expt 2 rho))
+                       (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho)))))))
+                (>= (1+ h) 0))
+          (< p
+             (* (/ (1+ h) (expt 2 rho))
+                (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        sqrt-table-8
+                        (:instance sqrt-table-9 (x p)
+                                                (y (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                                                (z (* (/ (1+ h) (expt 2 rho))
+                                                      (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho)))))))
+                                                (w (* (/ (1+ h) (expt 2 rho))
+                                                      (+ d (* (1+ h) (expt 2 (- (* k rho))))))))))))
+
+(local-defthm sqrt-table-11
+  (implies (and (natp m)
+                (natp i)
+                (< i (expt 2 m))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m)))))
+          (> (+ (pi0 i m) (expt 2 (- 3 m))) 0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0))))
+
+(local-defthm sqrt-table-12
+  (implies (and (natp k)
+                (natp rho)
+                (integerp h)
+                (> h (- (expt 2 rho))))
+           (> (* (1+ h) (expt 2 (- (* k rho))))
+              (- (expt 2 (* (- 1 k) rho)))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance *-strongly-monotonic (x (expt 2 (- (* k rho)))) (y (- (expt 2 rho))) (y+ (1+ h))))))
+
+(local-defthm sqrt-table-13
+  (implies (and (not (zp k))
+                (natp rho))
+           (>= (- (expt 2 (* (- 1 k) rho)))
+               -1))
+  :rule-classes ())
+
+(local-defthm sqrt-table-14
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (> x y)
+                (>= y z))
+           (> x z))
+  :rule-classes ())
+
+(local-defthm sqrt-table-15
+  (implies (and (not (zp k))
+                (natp rho)
+                (integerp h)
+                (> h (- (expt 2 rho))))
+           (> (* (1+ h) (expt 2 (- (* k rho))))
+              -1))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-12
+                        sqrt-table-13
+                        (:instance sqrt-table-14 (x (* (1+ h) (expt 2 (- (* k rho))))) (y (- (expt 2 (* (- 1 k) rho)))) (z -1))))))
+
+(local-defthm sqrt-table-16
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (not (zp k))
+                (integerp h)
+                (> h (- (expt 2 rho))))
+           (> (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho)))))
+              0))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        sqrt-table-15))))
+
+(local-defthm sqrt-table-17
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (not (zp k))
+                (integerp h)
+                (< (1+ h) 0)
+                (> h (- (expt 2 rho))))
+           (< (* (/ (1+ h) (expt 2 rho))
+                 (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))
+              0))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-16
+                        sqrt-table-7
+                        (:instance *-strongly-monotonic-neg (x (/ (1+ h) (expt 2 rho)))
+                                                            (y 0)
+                                                            (y+ (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho)))))))))))
+
+(local-defthm sqrt-table-18
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (natp i)
+                (< i (expt 2 m))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m))))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (integerp h)
+                (> h (- (expt 2 rho)))
+                (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+                    (* (/ (1+ h) (expt 2 rho))
+                       (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))))
+           (>= (1+ h) 0))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-17
+                        sqrt-table-11))))
+
+(local-defthm sqrt-table-19
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (natp i)
+                (< i (expt 2 m))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m))))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (integerp h)
+                (> h (- (expt 2 rho)))
+                (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+                    (* (/ (1+ h) (expt 2 rho))
+                       (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))))
+          (< p
+             (* (/ (1+ h) (expt 2 rho))
+                (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-10
+                        sqrt-table-18))))
+
+(local-defthm sqrt-table-20
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m))))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+          (< p
+             (* (/ (1+ h) (expt 2 rho))
+                (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-19 sqrt-table-2 sqrt-table-3 sqrt-table-5))))
+
+(local-defthm sqrt-table-21
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (integerp h)
+                (<= (1+ h) 0))
+          (<= (* (/ (1+ h) (expt 2 rho))
+                 (+ (delta0 j n) (expt 2 (- n)) (* (1+ h) (expt 2 (- (* k rho))))))
+              (* (/ (1+ h) (expt 2 rho))
+                 (+ d (* (1+ h) (expt 2 (- (* k rho))))))))              
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        (:instance *-weakly-monotonic-neg (x (/ (1+ h) (expt 2 rho))) (y+ (+ (delta0 j n) (expt 2 (- n)))) (y d))))))
+
+(local-defthm sqrt-table-22
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (integerp h)
+                (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+                    (* (/ (1+ h) (expt 2 rho))
+                       (+ (delta0 j n) (expt 2 (- n)) (* (1+ h) (expt 2 (- (* k rho)))))))
+                (<= (1+ h) 0))
+          (< p
+             (* (/ (1+ h) (expt 2 rho))
+                (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        sqrt-table-21
+                        (:instance sqrt-table-9 (x p)
+                                                (y (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                                                (z (* (/ (1+ h) (expt 2 rho))
+                                                      (+ (delta0 j n) (expt 2 (- n)) (* (1+ h) (expt 2 (- (* k rho)))))))
+                                                (w (* (/ (1+ h) (expt 2 rho))
+                                                      (+ d (* (1+ h) (expt 2 (- (* k rho))))))))))))
+
+(local-defthm sqrt-table-23
+  (implies (and (natp m)
+                (natp i)
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+           (and (rationalp (pi0 i m))
+                (<= (+ (pi0 i m) 4) 
+                    (* (/ (expt 2 (- m 2))) (- (expt 2 m) 2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0)
+                  :use ((:instance *-weakly-monotonic (x (/ (expt 2 (- m 2)))) (y i) (y+ (- (expt 2 m) 2)))))))
+
+(local-defthm sqrt-table-24
+  (implies (and (natp m)
+                (natp i)
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+           (= (* (/ (expt 2 (- m 2))) (- (expt 2 m) 2))
+              (- 4 (expt 2 (- 3 m)))))
+  :rule-classes ())
+
+(local-defthm sqrt-table-25
+  (implies (and (natp m)
+                (natp i)
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m))))
+           (and (rationalp (pi0 i m))
+                (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+                    0)))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-23 sqrt-table-24))))
+
+(local-defthm sqrt-table-26
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (not (zp k))
+                (integerp h)
+                (>= (1+ h) 0)
+                (> h (- (expt 2 rho))))
+           (>= (* (/ (1+ h) (expt 2 rho))
+                  (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-16
+                        sqrt-table-7
+                        (:instance *-weakly-monotonic (x (/ (1+ h) (expt 2 rho)))
+                                                      (y 0)
+                                                      (y+ (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho)))))))))))
+
+(local-defthm sqrt-table-27
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m)))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (integerp h)
+                (>= (1+ h) 0)
+                (> h (- (expt 2 rho))))
+           (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+               (* (/ (1+ h) (expt 2 rho))
+                  (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-26
+                        sqrt-table-25))))
+
+(local-defthm sqrt-table-28
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m)))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (integerp h)
+                (>= (1+ h) 0)
+                (> h (- (expt 2 rho))))
+           (<= (* (/ (1+ h) (expt 2 rho))
+                  (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))
+               (* (/ (1+ h) (expt 2 rho))
+                  (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        (:instance *-weakly-monotonic (x (/ (1+ h) (expt 2 rho))) (y (delta0 j n)) (y+ d))))))
+
+(local-defthm sqrt-table-29
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m)))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (integerp h)
+                (>= (1+ h) 0)
+                (> h (- (expt 2 rho))))
+           (< p
+              (* (/ (1+ h) (expt 2 rho))
+                 (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-27
+                        sqrt-table-28
+                        sqrt-table-7
+                        (:instance sqrt-table-9 (x p)
+                                                (y (* (/ (1+ h) (expt 2 rho))
+                                                      (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho)))))))
+                                                (z (* (/ (1+ h) (expt 2 rho))
+                                                      (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho)))))))
+                                                (w (* (/ (1+ h) (expt 2 rho))
+                                                      (+ d (* (1+ h) (expt 2 (- (* k rho))))))))))))
+
+(local-defthm sqrt-table-30
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (< i (expt 2 m))
+                (< i (1- (expt 2 m)))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m)))
+                (integerp h)
+                (> h (- (expt 2 rho)))
+                (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+                    (* (/ (1+ h) (expt 2 rho))
+                       (+ (delta0 j n) (expt 2 (- n)) (* (1+ h) (expt 2 (- (* k rho))))))))
+          (< p
+             (* (/ (1+ h) (expt 2 rho))
+                (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-22
+                        sqrt-table-29))))
+
+(local-defthm sqrt-table-31
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (< i (expt 2 m))
+                (< i (1- (expt 2 m)))
+                (< i (1- (expt 2 m)))
+                (>= i (expt 2 (1- m)))
+                (= h (lookup i j table)))
+          (< p
+             (* (/ (1+ h) (expt 2 rho))
+                (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-30
+                        sqrt-table-2
+                        sqrt-table-3
+                        sqrt-table-5))))
+
+(local-defthm sqrt-table-32
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+          (< p
+             (* (/ (1+ h) (expt 2 rho))
+                (+ d (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-31
+                        sqrt-table-20))))
+
+(local-defthm sqrt-table-33
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (integerp h)
+                (>= (1- h) 0))
+          (>= (* (/ (1- h) (expt 2 rho))
+                 (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* k rho))))))
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))              
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        (:instance *-weakly-monotonic (x (/ (1- h) (expt 2 rho))) (y+ (+ (delta0 j n) (expt 2 (- n)))) (y d))))))
+
+
+(local-defthm sqrt-table-9-a
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (rationalp w)
+                (<= x y)
+                (<= y z)
+                (<= z w))
+           (<= x w))
+  :rule-classes ())
+
+(local-defthm sqrt-table-34
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (>= p (pi0 i m))
+                (integerp h)
+                (>= (pi0 i m)
+                    (* (/ (1- h) (expt 2 rho))
+                       (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* k rho)))))))
+                (>= (1- h) 0))
+          (>= p
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        sqrt-table-33
+                        (:instance sqrt-table-9-a (w p)
+                                                  (z (pi0 i m))
+                                                  (y (* (/ (1- h) (expt 2 rho))
+                                                        (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* k rho)))))))
+                                                  (x (* (/ (1- h) (expt 2 rho))
+                                                        (+ d (* (1- h) (expt 2 (- (* k rho))))))))))))
+
+(local-defthm sqrt-table-35
+  (implies (and (natp k)
+                (natp rho)
+                (integerp h)
+                (> h (- (expt 2 rho))))
+           (>= (* (1- h) (expt 2 (- (* k rho))))
+               (- (expt 2 (* (- 1 k) rho)))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance *-weakly-monotonic (x (expt 2 (- (* k rho)))) (y (- (expt 2 rho))) (y+ (1- h))))))
+
+(local-defthm sqrt-table-36
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (>= x y)
+                (>= y z))
+           (>= x z))
+  :rule-classes ())
+
+(local-defthm sqrt-table-37
+  (implies (and (not (zp k))
+                (natp rho)
+                (integerp h)
+                (> h (- (expt 2 rho))))
+           (>= (* (1- h) (expt 2 (- (* k rho))))
+               -1))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-35
+                        sqrt-table-13
+                        (:instance sqrt-table-36 (x (* (1- h) (expt 2 (- (* k rho))))) (y (- (expt 2 (* (- 1 k) rho)))) (z -1))))))
+
+(local-defthm sqrt-table-38
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (not (zp k))
+                (integerp h)
+                (rationalp d)
+                (<= (delta0 j n) d)
+                (> h (- (expt 2 rho))))
+           (>= (+ d (* (1- h) (expt 2 (- (* k rho)))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        sqrt-table-37))))
+
+(local-defthm sqrt-table-39
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (not (zp k))
+                (rationalp d)
+                (<= (delta0 j n) d)
+                (integerp h)
+                (< (1- h) 0)
+                (> h (- (expt 2 rho))))
+           (<= (* (/ (1- h) (expt 2 rho))
+                  (+ d (* (1- h) (expt 2 (- (* k rho))))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-38
+                        sqrt-table-7
+                        (:instance *-weakly-monotonic-neg (x (/ (1- h) (expt 2 rho)))
+                                                          (y 0)
+                                                          (y+ (+ d (* (1- h) (expt 2 (- (* k rho)))))))))))
+
+(local-defthm sqrt-table-40
+  (implies (and (natp m)
+                (natp i)
+                (< i (expt 2 m))
+                (< i (expt 2 (1- m))))
+          (>= (pi0 i m) 0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0))))
+
+(local-defthm sqrt-table-41
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (natp i)
+                (< i (expt 2 m))
+                (< i (expt 2 (1- m)))
+                (>= p (pi0 i m))
+                (integerp h)
+                (> h (- (expt 2 rho)))
+                (< p
+                   (* (/ (1- h) (expt 2 rho))
+                      (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+           (>= (1- h) 0))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-39
+                        sqrt-table-40
+                        (:instance sqrt-table-36 (x p) (y 0) 
+                                                 (z (* (/ (1- h) (expt 2 rho))
+                                                       (+ d (* (1- h) (expt 2 (- (* k rho))))))))))))
+
+(local-defthm sqrt-table-42
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (< i (expt 2 (1- m)))
+                (>= p (pi0 i m))
+                (integerp h)
+                (> h (- (expt 2 rho)))
+                (>= (pi0 i m)
+                    (* (/ (1- h) (expt 2 rho))
+                       (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* k rho))))))))
+          (>= p
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-34
+                        sqrt-table-41))))
+
+(local-defthm sqrt-table-43
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (natp i)
+                (< i (expt 2 m))
+                (< i (expt 2 (1- m)))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+          (>= p
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-42 sqrt-table-2 sqrt-table-4 sqrt-table-6))))
+
+(local-defthm sqrt-table-44
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (>= d (delta0 j n))
+                (integerp h)
+                (<= (1- h) 0))
+          (>= (* (/ (1- h) (expt 2 rho))
+                 (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho))))))
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))              
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        (:instance *-weakly-monotonic-neg (x (/ (1- h) (expt 2 rho))) 
+                                                          (y (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho))))))
+                                                          (y+ (+ d (* (1- h) (expt 2 (- (* k rho)))))))))))
+
+(local-defthm sqrt-table-45
+  (implies (and (natp m)
+                (natp n)
+                (natp k)
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (>= d (delta0 j n))
+                (natp i)
+                (< i (expt 2 m))
+                (>= p (pi0 i m))
+                (integerp h)
+                (>= (pi0 i m)
+                    (* (/ (1- h) (expt 2 rho))
+                       (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho)))))))
+                (<= (1- h) 0))
+          (>= p
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-7
+                        sqrt-table-44
+                        (:instance sqrt-table-9-a (w p)
+                                                (z (pi0 i m))
+                                                (y (* (/ (1- h) (expt 2 rho))
+                                                      (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho)))))))
+                                                (x (* (/ (1- h) (expt 2 rho))
+                                                      (+ d (* (1- h) (expt 2 (- (* k rho))))))))))))
+
+(local-defthm sqrt-table-46
+  (implies (and (natp m)
+                (natp i)
+                (< i (expt 2 m))
+                (>= i (expt 2 (1- m))))
+           (and (rationalp (pi0 i m))
+                (< (pi0 i m) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable pi0)
+                  :use ((:instance *-strongly-monotonic (x (expt 2 (- 2 m))) (y i) (y+ (expt 2 m)))))))
+
+(local-defthm sqrt-table-47
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (not (zp k))
+                (integerp h)
+                (>= (1- h) 0)
+                (> h (- (expt 2 rho))))
+           (>= (* (/ (1- h) (expt 2 rho))
+                  (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho))))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-37
+                        sqrt-table-7
+                        (:instance *-weakly-monotonic (x (/ (1- h) (expt 2 rho)))
+                                                      (y 0)
+                                                      (y+ (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho)))))))))))
+
+(local-defthm sqrt-table-48
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (natp i)
+                (< i (expt 2 m))
+                (>= i (expt 2 (1- m)))
+                (integerp h)
+                (>= (1- h) 0)
+                (> h (- (expt 2 rho))))
+           (< (pi0 i m)
+              (* (/ (1- h) (expt 2 rho))
+                 (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-47
+                        sqrt-table-7
+                        sqrt-table-46))))
+
+(local-defthm sqrt-table-49
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (rationalp d)
+                (rationalp p)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (>= p (pi0 i m))
+                (< i (expt 2 m))
+                (>= i (expt 2 (1- m)))
+                (integerp h)
+                (> h (- (expt 2 rho)))
+                (>= (pi0 i m)
+                    (* (/ (1- h) (expt 2 rho))
+                       (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho))))))))
+          (>= p
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-48
+                        sqrt-table-45))))
+
+(local-defthm sqrt-table-50
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (>= i (expt 2 (1- m)))
+                (= h (lookup i j table)))
+          (>= p
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-49
+                        sqrt-table-2
+                        sqrt-table-6
+                        sqrt-table-4))))
+
+(local-defthm sqrt-table-51
+  (implies (and (natp m)
+                (natp n)
+                (not (zp k))
+                (natp rho)
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+          (>= p
+              (* (/ (1- h) (expt 2 rho))
+                 (+ d (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt-table-50
+                        sqrt-table-43))))
+
+(defthm lemma-3-4
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (not (zp k))
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+          (and (< h (expt 2 rho))
+               (> h (- (expt 2 rho)))
+               (< p
+                 (* (/ (1+ h) (expt 2 rho))
+                    (+ d (* (1+ h) (expt 2 (- (* k rho)))))))  
+               (>= p              
+                  (* (/ (1- h) (expt 2 rho))
+                     (+ d (* (1- h) (expt 2 (- (* k rho)))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lookup)
+                  :use (sqrt-table-32
+                        sqrt-table-51
+                        sqrt-table-2))))
+
+;;**********************************************************************************
+
+;; Assume that dmin < dmax and pmin < pmax.  Consider the closed rectangle
+;;   R = {(d,p) | dmin <= d <= dmax and pmin <= p <= pmax},
+;; the half-closed rectangle
+;;   R' = {(d,p) | dmin <= d < dmax and pmin <= p < pmax},
+;; and the quarter-closed rectangle
+;;   R" = {(d,p) | dmin < d < dmax and pmin <= p < pmax}.
+;; If there exists (d,p) in R such that p < h*d + b, then (d5,p5) is a point
+;; in R" with p5 < h*d5 + b:
+
+(defund d5 (dmin pmin dmax pmax h b)
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h))))
+    ;; (d1,p1) is in R' and p1 < h*d1 + b.
+    (if (> d1 dmin)
+        d1
+      (if (>= (+ (* h dmax) b) p1)
+          (/ (+ dmin dmax) 2)
+        (/ (+ (/ (- p1 b) h) dmin) 2)))))
+
+(defund p5 (dmin pmin dmax pmax h b)
+  (+ b (p1 dmin (- pmin b) dmax (- pmax b) h)))
+
+(local-defthm d5-p5-1
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h))))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (< p (+ (* h d) b)))
+             (and (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (< d1 dmax)
+                  (<= pmin p1)
+                  (< p1 pmax)
+                  (< p1 (+ (* h d1) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance d1-p1-lemma (p (- p b)) (pmin (- pmin b)) (pmax (- pmax b))))))
+
+(local-defthm d5-p5-2
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (d5 (d5 dmin pmin dmax pmax h b))
+        (p5 (p5 dmin pmin dmax pmax h b)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (< p (+ (* h d) b))
+                  (> d1 dmin))
+             (and (rationalp d5)
+                  (rationalp p5)
+                  (< dmin d5)
+                  (< d5 dmax)
+                  (<= pmin p5)
+                  (< p5 pmax)
+                  (< p5 (+ (* h d5) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d5-p5-1)
+                  :in-theory (enable d5 p5))))
+
+(local-defthm d5-p5-3
+  (implies (and (rationalp a1)
+                (rationalp a2)
+                (rationalp a3)
+                (<= a1 a2)
+                (< a1 a3))
+           (< a1 (/ (+ a2 a3) 2)))
+  :rule-classes ())
+
+(local-defthm d5-p5-4
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h)))
+        (d5 (d5 dmin pmin dmax pmax h b))
+        (p5 (p5 dmin pmin dmax pmax h b)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (< p (+ (* h d) b))
+                  (= d1 dmin)
+                  (>= (+ (* h dmax) b) p1))
+             (and (rationalp d5)
+                  (rationalp p5)
+                  (< dmin d5)
+                  (< d5 dmax)
+                  (<= pmin p5)
+                  (< p5 pmax)
+                  (< p5 (+ (* h d5) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d5-p5-1
+                        (:instance d5-p5-3 (a1 (p1 dmin (- pmin b) dmax (- pmax b) h))
+                                           (a2 (+ (* h dmax) b))
+                                           (a3 (+ (* h dmin) b))))
+                  :in-theory (enable d5 p5))))
+
+(local-defthm d5-p5-5
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h))))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (< p (+ (* h d) b))
+                  (= d1 dmin)
+                  (< (+ (* h dmax) b) p1))
+             (< h 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (d5-p5-1
+                        (:instance *-weakly-monotonic (x h) (y (d1 dmin (- pmin b) dmax (- pmax b) h)) (y+ dmax))))))
+
+(local-defthm d5-p5-6
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h))))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (< p (+ (* h d) b))
+                  (= d1 dmin)
+                  (< (+ (* h dmax) b) p1))
+             (< (/ (- p1 b) h) dmax)))
+  :rule-classes ()
+  :hints (("Goal" :use (d5-p5-1
+                        d5-p5-5
+                        (:instance *-strongly-monotonic-neg (x h) (y (/ (p1 dmin (- pmin b) dmax (- pmax b) h) h)) (y+ dmax))))))
+
+(local-defthm d5-p5-7
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h))))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (< p (+ (* h d) b))
+                  (= d1 dmin)
+                  (< (+ (* h dmax) b) p1))
+             (> (/ (- p1 b) h) dmin)))
+  :rule-classes ()
+  :hints (("Goal" :use (d5-p5-1
+                        d5-p5-5
+                        (:instance *-strongly-monotonic-neg (x h) (y+ (/ (p1 dmin (- pmin b) dmax (- pmax b) h) h)) (y dmin))))))
+
+(local-defthm d5-p5-8
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h)))
+        (d5 (d5 dmin pmin dmax pmax h b))
+        (p5 (p5 dmin pmin dmax pmax h b)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (< p (+ (* h d) b))
+                  (= d1 dmin)
+                  (< (+ (* h dmax) b) p1))
+             (and (rationalp d5)
+                  (rationalp p5)
+                  (< dmin d5)
+                  (< d5 dmax)
+                  (<= pmin p5)
+                  (< p5 pmax)
+                  (< p5 (+ (* h d5) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d5-p5-1
+                        d5-p5-7
+                        d5-p5-6)
+                  :in-theory (enable d5 p5))))
+
+(defthm d5-p5-lemma
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (rationalp b)
+                (< p (+ (* h d) b)))
+           (let ((d5 (d5 dmin pmin dmax pmax h b))
+                 (p5 (p5 dmin pmin dmax pmax h b)))
+             (and (rationalp d5)
+                  (rationalp p5)
+                  (< dmin d5)
+                  (< d5 dmax)
+                  (<= pmin p5)
+                  (< p5 pmax)
+                  (< p5 (+ (* h d5) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d5-p5-1
+                        d5-p5-2
+                        d5-p5-4
+                        d5-p5-8))))
+
+;;**********************************************************************************
+
+;; If there exists (d,p) in R such that p > h*d + b, then (d6,p6) is a point
+;; in R" with p6 > h*d6 + b:
+
+(defund d6 (dmin pmin dmax pmax h b)
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h))))
+    ;; (d2,p2) is in R' and p2 > h*d2 + b.
+    (if (> d2 dmin)
+        d2
+      (if (>= p2 (+ (* h dmax) b))
+          (/ (+ dmin dmax) 2)
+        (/ (+ (/ (- p2 b) h) dmin) 2)))))
+
+(defund p6 (dmin pmin dmax pmax h b)
+  (+ b (p2 dmin (- pmin b) dmax (- pmax b) h)))
+
+(local-defthm d6-p6-1
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h))))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (> p (+ (* h d) b)))
+             (and (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (< d2 dmax)
+                  (<= pmin p2)
+                  (< p2 pmax)
+                  (> p2 (+ (* h d2) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance d2-p2-lemma (p (- p b)) (pmin (- pmin b)) (pmax (- pmax b))))))
+
+(local-defthm d6-p6-2
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (d6 (d6 dmin pmin dmax pmax h b))
+        (p6 (p6 dmin pmin dmax pmax h b)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (> p (+ (* h d) b))
+                  (not (= d2 dmin)))
+             (and (rationalp d6)
+                  (rationalp p6)
+                  (< dmin d6)
+                  (< d6 dmax)
+                  (<= pmin p6)
+                  (< p6 pmax)
+                  (> p6 (+ (* h d6) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d6-p6-1)
+                  :in-theory (enable d6 p6))))
+
+(local-defthm d6-p6-3
+  (implies (and (rationalp a1)
+                (rationalp a2)
+                (rationalp a3)
+                (>= a1 a2)
+                (> a1 a3))
+           (> a1 (/ (+ a2 a3) 2)))
+  :rule-classes ())
+
+(local-defthm d6-p6-4
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h)))
+        (d6 (d6 dmin pmin dmax pmax h b))
+        (p6 (p6 dmin pmin dmax pmax h b)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (> p (+ (* h d) b))
+                  (= d2 dmin)
+                  (>= p2 (+ (* h dmax) b)))
+             (and (rationalp d6)
+                  (rationalp p6)
+                  (< dmin d6)
+                  (< d6 dmax)
+                  (<= pmin p6)
+                  (< p6 pmax)
+                  (> p6 (+ (* h d6) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d6-p6-1
+                        (:instance d6-p6-3 (a1 (p2 dmin (- pmin b) dmax (- pmax b) h))
+                                           (a2 (+ (* h dmax) b))
+                                           (a3 (+ (* h dmin) b))))
+                  :in-theory (enable d6 p6))))
+
+(local-defthm d6-p6-5
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h))))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (> p (+ (* h d) b))
+                  (= d2 dmin)
+                  (< p2 (+ (* h dmax) b)))
+             (> h 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (d6-p6-1
+                        (:instance *-weakly-monotonic-neg (x h) (y (d2 dmin (- pmin b) dmax (- pmax b) h)) (y+ dmax))))))
+
+(local-defthm d6-p6-6
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h))))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (> p (+ (* h d) b))
+                  (= d2 dmin)
+                  (< p2 (+ (* h dmax) b)))
+             (< (/ (- p2 b) h) dmax)))
+  :rule-classes ()
+  :hints (("Goal" :use (d6-p6-1
+                        d6-p6-5
+                        (:instance *-strongly-monotonic (x h) (y (/ (p2 dmin (- pmin b) dmax (- pmax b) h) h)) (y+ dmax))))))
+
+(local-defthm d6-p6-7
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h))))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (> p (+ (* h d) b))
+                  (= d2 dmin)
+                  (< p2 (+ (* h dmax) b)))
+             (> (/ (- p2 b) h) dmin)))
+  :rule-classes ()
+  :hints (("Goal" :use (d6-p6-1
+                        d6-p6-5
+                        (:instance *-strongly-monotonic (x h) (y+ (/ (p2 dmin (- pmin b) dmax (- pmax b) h) h)) (y dmin))))))
+
+(local-defthm d6-p6-8
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h)))
+        (d6 (d6 dmin pmin dmax pmax h b))
+        (p6 (p6 dmin pmin dmax pmax h b)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (rationalp d)
+                  (rationalp p)
+                  (< 0 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (<= dmin d)
+                  (<= d dmax)
+                  (<= pmin p)
+                  (<= p pmax)
+                  (rationalp h)
+                  (rationalp b)
+                  (> p (+ (* h d) b))
+                  (= d2 dmin)
+                  (< p2 (+ (* h dmax) b)))
+             (and (rationalp d6)
+                  (rationalp p6)
+                  (< dmin d6)
+                  (< d6 dmax)
+                  (<= pmin p6)
+                  (< p6 pmax)
+                  (> p6 (+ (* h d6) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d6-p6-1
+                        d6-p6-7
+                        d6-p6-6)
+                  :in-theory (enable d6 p6))))
+
+(defthm d6-p6-lemma
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (rationalp d)
+                (rationalp p)
+                (< 0 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (<= dmin d)
+                (<= d dmax)
+                (<= pmin p)
+                (<= p pmax)
+                (rationalp h)
+                (rationalp b)
+                (> p (+ (* h d) b)))
+           (let ((d6 (d6 dmin pmin dmax pmax h b))
+                 (p6 (p6 dmin pmin dmax pmax h b)))
+             (and (rationalp d6)
+                  (rationalp p6)
+                  (< dmin d6)
+                  (< d6 dmax)
+                  (<= pmin p6)
+                  (< p6 pmax)
+                  (> p6 (+ (* h d6) b)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d6-p6-2
+                        d6-p6-4
+                        d6-p6-8))))
+
+;;**********************************************************************************
+
+;; Assume h2 < h1 and h2 + b2 <= h1 + b1.  Then for all d > 1,
+;
+;;   (h1*d + b1) - (h2*d + b2) = (h1 - h2)*d + (b1 - b2)
+;;                             > (h1 - h2) + (b1 - b2)
+;;                             >= 0.
+;;
+;; Assume dmin >= 1.  If there exist (d1,p1) and (d2,p2) in R such that
+;; p1 < h1*d1 + b1 and p2 > h2*d2 + b2, then (d7,p7) is in R" and 
+;; h2*d7 + b2 < p7 < h1*d7 + b1:
+
+(defund d7 (dmin pmin dmax pmax h1 b1 h2 b2)
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2)))
+    (if (> p5 (+ (* h2 d5) b2))
+        d5
+      (if (< p6 (+ (* h1 d6) b1))
+          d6
+        (if (<= p5 (+ (* h2 d6) b2))
+            d6
+          (if (>= p5 (+ (* h1 d6) b1))
+              (/ (+ (/ (- p5 b1) h1) (/ (- p5 b2) h2)) 2)
+            d6))))))
+
+(defund p7 (dmin pmin dmax pmax h1 b1 h2 b2)
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2)))
+    (if (> p5 (+ (* h2 d5) b2))
+        p5
+      (if (< p6 (+ (* h1 d6) b1))
+          p6
+        (if (<= p5 (+ (* h2 d6) b2))
+            (/ (+ (* (+ h1 h2) d6) b1 b2) 2)
+          p5)))))
+
+;; We have p5 < h1*d5 + b1 and p6 > h2*d6 + b2.
+;; The claim is proved by the following case analysis:
+
+;; Case 1: p5 > h2*d5 + b2.
+;;   (d7,p7) = (d5,p5).
+;;   h2*d7 + b2 = h2*d5 + b2  < p5 = p7 < h1*d7 + b1.
+
+;; Case 2: p6 < h1*d6 + b1.
+;;   (d7,p7) = (d6,p6).
+;;   h2*d7 + b2 = h2*d6 + b2 < p6 = p7 < h1*d6 + b1.
+
+;; Case 3: p6 >= h1*d6 + b1, p5 <= h2*d6 + b2.
+;;   (d7,p7) = (d6,((h1+h2)*d6+b1+b1)/2).
+;;   Let y1 = h1*d6 + b1 and y2 = h2*d6 + b2.  Then p7 = (y1+y2)/2 and
+;;   h2*d7 + b2 = h2*d6 + b2 < h1*d6 + b1 = h1*d7 + b1.
+;;   Since p5 <= y2 < y1 <= p6, pmin < p5 < p7 < p6 < pmax.
+
+;; Case 4: p5 <= h2*d5 + b2, p5 > h2*d6 + b2, p5 >= h1*d6 + b1.
+;;   (d7,p7) = ((x1+x2)/2,p5), where x1 = (p5-b1)/h1 and x2 = (p5-b2)/h2.
+;;   Since h2*d6 + b2 < p5 <= h2*d5 + b2, h2*(d5 - d6) > 0.
+
+;;   Case 4a: d5 > d6.
+;;     h1 > h2 > 0.
+;;     Since h2*d6 + b2 < p5 <= h2*d5 + b2, d6 < (p5-b2)/h2 = x2 < d5.
+;;     Since p5 >= h1*d6 + b1, x1 = (p5-b1)/h1 >= d6.
+;;     Since h1*(x2 - x1) = h1*x2 - p5 + b1
+;;                        = h1*x2 - (h2*x2 + b2) + b1
+;;                        = (h1*x2 + b1) - (h2*x2 + b2)
+;;                        > 0,
+;;     x2 > x1.
+;;     Thus, dmin < d6 <= x1 < x2 < d5 < dmax and
+;;     (p5-b1)/h1 = x1 < d7 < x2 = (p5-b2)/h2, which implies
+;;     h2*d7 + b2 < p5 < h1*d7 + b1.
+
+;;   Case 4b: d5 < d6.
+;;     h2 < 0 and d5 <= (p5-b2)/h2 = x2 < d6.
+;;     Since h1*d5 + b1 > h2*d5 + b2 >= p5 >= h1*d6 + b1,
+;;     h1*(d6 - d5) < 0, which implies h1 < 0.
+;;     Since p5 >= h1*d6 + b1, x1 = (p5-b1)/h1 <= d6.
+;;     Since p5 <= h2*d5 + b2 < h1*d5 + b1, (p5-b1)/h1 > d5 > 1.
+;;     Since h2*(x1-x2) = h2*x1 - p5 + b2
+;;                      = h2*x1 - (h2*x1 + b2) + b1
+;;                      = (h2*x1 + b1) - (h2*x1 + b2)
+;;                      < 0,
+;;     x1 > x2.
+;;     Thus, dmin < d5 <= x2 < x1 <= d6 < dmax and
+;;     (p5-b2)/h2 = x2 < d7 < x1 = (p5-b1)/h1, which implies
+;;     h2*d7 + b2 < p5 < h1*d7 + b1.
+
+;;   Case 5: p5 > h2*d6 + b2, p5 < h1*d6 + b1.
+;;     (d7,p7) = (d6,p5).
+;;     h2*d7 + b2 = h2*d6 + b2 > p5 = p7 < h1*d7 + b1 = h1*d6 + b1.
+
+(local-defthm d7-p7-1
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (> p2 (+ (* h2 d2) b2)))
+             (and (rationalp d5)
+                  (rationalp p5)
+                  (< dmin d5)
+                  (< d5 dmax)
+                  (<= pmin p5)
+                  (< p5 pmax)
+                  (< p5 (+ (* h1 d5) b1))
+                  (rationalp d6)
+                  (rationalp p6)
+                  (< dmin d6)
+                  (< d6 dmax)
+                  (<= pmin p6)
+                  (< p6 pmax)
+                  (> p6 (+ (* h2 d6) b2)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance d5-p5-lemma (d d1) (p p1) (h h1) (b b1))
+                        (:instance d6-p6-lemma (d d2) (p p2) (h h2) (b b2))))))
+
+(local-defthm d7-p7-2
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2))
+        (p7 (p7 dmin pmin dmax pmax h1 b1 h2 b2)))
+  (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (> p2 (+ (* h2 d2) b2))
+                  (or (> p5 (+ (* h2 d5) b2))
+                      (< p6 (+ (* h1 d6) b1))))
+             (and (rationalp d7)
+                  (rationalp p7)
+                  (< dmin d7)
+                  (< d7 dmax)
+                  (<= pmin p7)
+                  (< p7 pmax)
+                  (< p7 (+ (* h1 d7) b1))
+                  (> p7 (+ (* h2 d7) b2)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1)
+                  :in-theory (enable d7 p7))))
+
+(local-defthm d7-p7-3
+  (implies (and (rationalp d)
+                (> d 1)
+                (rationalp h1)
+                (rationalp b1)
+                (rationalp h2)
+                (rationalp b2)
+                (< h2 h1)
+                (<= (+ h2 b2) (+ h1 b1)))
+           (< (+ (* h2 d) b2) (+ (* h1 d) b1)))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance *-strongly-monotonic (x (- h1 h2)) (y 1) (y+ d)))))
+
+(local-defthm d7-p7-4
+  (implies (and (rationalp x)
+                (rationalp y)
+                (< x y))
+           (and (< x (/ (+ x y) 2))
+                (> y (/ (+ x y) 2))))
+  :rule-classes ())
+
+(local-defthm d7-p7-5
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2))
+        (p7 (p7 dmin pmin dmax pmax h1 b1 h2 b2)))
+  (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>=  p6 (+ (* h1 d6) b1))
+                  (<= p5 (+ (* h2 d6) b2)))
+             (and (rationalp d7)
+                  (rationalp p7)
+                  (< dmin d7)
+                  (< d7 dmax)
+                  (<= pmin p7)
+                  (< p7 pmax)
+                  (< p7 (+ (* h1 d7) b1))
+                  (> p7 (+ (* h2 d7) b2)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        (:instance d7-p7-3 (d (d6 dmin pmin dmax pmax h2 b2)))
+                        (:instance d7-p7-4 (x (+ (* h2 (d6 dmin pmin dmax pmax h2 b2)) b2))
+                                           (y (+ (* h1 (d6 dmin pmin dmax pmax h2 b2)) b1))))
+                  :in-theory (enable d7 p7))))
+
+(local-defthm d7-p7-6
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+  (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1)))
+             (> (* h2 (- d5 d6)) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1))))
+
+(local-defthm d7-p7-7
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+  (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (> h2 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1 d7-p7-6))))
+
+(local-defthm d7-p7-8
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (< d6 (/ (- p5 b2) h2))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-7
+                        (:instance *-strongly-monotonic (x h2) 
+                                                        (y (d6 dmin pmin dmax pmax h2 b2)) 
+                                                        (y+ (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2)))))))
+
+(local-defthm d7-p7-9
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (>= d5 (/ (- p5 b2) h2))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-7
+                        (:instance *-weakly-monotonic (x h2) 
+                                                      (y+ (d5 dmin pmin dmax pmax h1 b1)) 
+                                                      (y (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2)))))))
+
+(local-defthm d7-p7-10
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (<= d6 (/ (- p5 b1) h1))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-7
+                        (:instance *-weakly-monotonic (x h1) 
+                                                      (y (d6 dmin pmin dmax pmax h2 b2)) 
+                                                      (y+ (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1)))))))
+
+(local-defthm d7-p7-11
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (> (* h1 (- (/ (- p5 b2) h2) (/ (- p5 b1) h1)))
+                0)))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-8
+                        (:instance d7-p7-3 (d (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2)))))))
+
+(local-defthm d7-p7-12
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (> (/ (- p5 b2) h2) (/ (- p5 b1) h1))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-7
+                        d7-p7-11
+                        (:instance *-strongly-monotonic (x h1) 
+                                                        (y+ (- (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2) 
+                                                               (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1)))
+                                                        (y 0))))))
+
+(local-defthm d7-p7-13
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (and (rationalp d7)
+                  (< d7 (/ (- p5 b2) h2))
+                  (> d7 (/ (- p5 b1) h1)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d7 p7)
+                  :use (d7-p7-1
+                        d7-p7-12
+                        (:instance d7-p7-4 (y (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2))
+                                           (x (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1)))))))
+
+(local-defthm d7-p7-14
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (< p5 (+ (* h1 d7) b1))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-13
+                        d7-p7-7
+                        (:instance *-strongly-monotonic (x h1) 
+                                                        (y (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1))
+                                                        (y+ (d7 dmin pmin dmax pmax h1 b1 h2 b2)))))))
+
+(local-defthm d7-p7-15
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (> p5 (+ (* h2 d7) b2))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-13
+                        d7-p7-7
+                        (:instance *-strongly-monotonic (x h2) 
+                                                        (y+ (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2))
+                                                        (y (d7 dmin pmin dmax pmax h1 b1 h2 b2)))))))
+
+(local-defthm d7-p7-16
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2))
+        (p7 (p7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (> d5 d6))
+             (and (rationalp d7)
+                  (rationalp p7)
+                  (< dmin d7)
+                  (< d7 dmax)
+                  (<= pmin p7)
+                  (< p7 pmax)
+                  (< p7 (+ (* h1 d7) b1))
+                  (> p7 (+ (* h2 d7) b2)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-8
+                        d7-p7-9
+                        d7-p7-10
+                        d7-p7-12
+                        d7-p7-13
+                        d7-p7-14
+                        d7-p7-15)
+                  :in-theory (enable p7))))
+
+(local-defthm d7-p7-17
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+  (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (< h2 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1 d7-p7-6))))
+
+(local-defthm d7-p7-18
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (> d6 (/ (- p5 b2) h2))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-17
+                        (:instance *-strongly-monotonic-neg (x h2) 
+                                                            (y+ (d6 dmin pmin dmax pmax h2 b2)) 
+                                                            (y (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2)))))))
+
+(local-defthm d7-p7-19
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (<= d5 (/ (- p5 b2) h2))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-17
+                        (:instance *-weakly-monotonic-neg (x h2) 
+                                                          (y (d5 dmin pmin dmax pmax h1 b1)) 
+                                                          (y+ (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2)))))))
+
+(local-defthm d7-p7-20
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (< h1 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        (:instance d7-p7-3 (d (d5 dmin pmin dmax pmax h1 b1)))
+                        (:instance *-weakly-monotonic (x h1) 
+                                                      (y 0)
+                                                      (y+ (- (d6 dmin pmin dmax pmax h2 b2) (d5 dmin pmin dmax pmax h1 b1))))))))
+
+(local-defthm d7-p7-21
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (>= d6 (/ (- p5 b1) h1))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-20
+                        (:instance *-weakly-monotonic-neg (x h1) 
+                                                          (y+ (d6 dmin pmin dmax pmax h2 b2)) 
+                                                          (y (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1)))))))
+
+(local-defthm d7-p7-22
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (< d5 (/ (- p5 b1) h1))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-20
+                        (:instance d7-p7-3 (d (d5 dmin pmin dmax pmax h1 b1)))
+                        (:instance *-strongly-monotonic-neg (x h1)
+                                                            (y (d5 dmin pmin dmax pmax h1 b1))
+                                                            (y+ (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1)))))))
+
+(local-defthm d7-p7-23
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (< (* h2 (- (/ (- p5 b1) h1) (/ (- p5 b2) h2)))
+                0)))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-22
+                        (:instance d7-p7-3 (d (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1)))))))
+
+(local-defthm d7-p7-24
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (< (/ (- p5 b2) h2) (/ (- p5 b1) h1))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-17
+                        d7-p7-23
+                        (:instance *-strongly-monotonic-neg (x h2) 
+                                                        (y+ (- (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1) 
+                                                               (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2)))
+                                                        (y 0))))))
+
+(local-defthm d7-p7-25
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (and (rationalp d7)
+                  (> d7 (/ (- p5 b2) h2))
+                  (< d7 (/ (- p5 b1) h1)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d7 p7)
+                  :use (d7-p7-1
+                        d7-p7-24
+                        (:instance d7-p7-4 (x (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2))
+                                           (y (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1)))))))
+
+(local-defthm d7-p7-26
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (< p5 (+ (* h1 d7) b1))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-25
+                        d7-p7-20
+                        (:instance *-strongly-monotonic-neg (x h1) 
+                                                            (y+ (/ (- (p5 dmin pmin dmax pmax h1 b1) b1) h1))
+                                                            (y (d7 dmin pmin dmax pmax h1 b1 h2 b2)))))))
+
+(local-defthm d7-p7-27
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (> p5 (+ (* h2 d7) b2))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-25
+                        d7-p7-20
+                        (:instance *-strongly-monotonic-neg (x h2) 
+                                                            (y (/ (- (p5 dmin pmin dmax pmax h1 b1) b2) h2))
+                                                            (y+ (d7 dmin pmin dmax pmax h1 b1 h2 b2)))))))
+
+(local-defthm d7-p7-28
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2))
+        (p7 (p7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1))
+                  (< d5 d6))
+             (and (rationalp d7)
+                  (rationalp p7)
+                  (< dmin d7)
+                  (< d7 dmax)
+                  (<= pmin p7)
+                  (< p7 pmax)
+                  (< p7 (+ (* h1 d7) b1))
+                  (> p7 (+ (* h2 d7) b2)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-19
+                        d7-p7-25
+                        d7-p7-21
+                        d7-p7-26
+                        d7-p7-27)
+                  :in-theory (enable p7))))
+
+(local-defthm d7-p7-29
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2))
+        (p7 (p7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (>= p5 (+ (* h1 d6) b1)))
+             (and (rationalp d7)
+                  (rationalp p7)
+                  (< dmin d7)
+                  (< d7 dmax)
+                  (<= pmin p7)
+                  (< p7 pmax)
+                  (< p7 (+ (* h1 d7) b1))
+                  (> p7 (+ (* h2 d7) b2)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-6
+                        d7-p7-16
+                        d7-p7-28))))
+
+(local-defthm d7-p7-30
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2))
+        (d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2))
+        (p7 (p7 dmin pmin dmax pmax h1 b1 h2 b2)))
+    (implies (and (rationalp dmin)
+                  (rationalp pmin)
+                  (rationalp dmax)
+                  (rationalp pmax)
+                  (<= 1 dmin)
+                  (< dmin dmax)
+                  (< pmin pmax)
+                  (rationalp d1)
+                  (rationalp p1)
+                  (<= dmin d1)
+                  (<= d1 dmax)
+                  (<= pmin p1)
+                  (<= p1 pmax)
+                  (rationalp h1)
+                  (rationalp b1)
+                  (rationalp h2)
+                  (rationalp b2)
+                  (< h2 h1)
+                  (<= (+ h2 b2) (+ h1 b1))
+                  (< p1 (+ (* h1 d1) b1))
+                  (rationalp d2)
+                  (rationalp p2)
+                  (<= dmin d2)
+                  (<= d2 dmax)
+                  (<= pmin p2)
+                  (<= p2 pmax)
+                  (> p2 (+ (* h2 d2) b2))
+                  (<= p5 (+ (* h2 d5) b2))
+                  (>= p6 (+ (* h1 d6) b1))
+                  (> p5 (+ (* h2 d6) b2))
+                  (< p5 (+ (* h1 d6) b1)))
+             (and (rationalp d7)
+                  (rationalp p7)
+                  (< dmin d7)
+                  (< d7 dmax)
+                  (<= pmin p7)
+                  (< p7 pmax)
+                  (< p7 (+ (* h1 d7) b1))
+                  (> p7 (+ (* h2 d7) b2)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1)
+                  :in-theory (enable d7 p7))))
+
+(defthm d7-p7-lemma
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp dmax)
+                (rationalp pmax)
+                (<= 1 dmin)
+                (< dmin dmax)
+                (< pmin pmax)
+                (rationalp h1)
+                (rationalp b1)
+                (rationalp h2)
+                (rationalp b2)
+                (< h2 h1)
+                (<= (+ h2 b2) (+ h1 b1))
+                (rationalp d1)
+                (rationalp p1)
+                (<= dmin d1)
+                (<= d1 dmax)
+                (<= pmin p1)
+                (<= p1 pmax)
+                (< p1 (+ (* h1 d1) b1))
+                (rationalp d2)
+                (rationalp p2)
+                (<= dmin d2)
+                (<= d2 dmax)
+                (<= pmin p2)
+                (<= p2 pmax)
+                (> p2 (+ (* h2 d2) b2)))
+            (let ((d7 (d7 dmin pmin dmax pmax h1 b1 h2 b2))
+                  (p7 (p7 dmin pmin dmax pmax h1 b1 h2 b2)))
+               (and (rationalp d7)
+                    (rationalp p7)
+                    (< dmin d7)
+                    (< d7 dmax)
+                    (<= pmin p7)
+                    (< p7 pmax)
+                    (< p7 (+ (* h1 d7) b1))
+                    (> p7 (+ (* h2 d7) b2)))))
+  :rule-classes ()
+  :hints (("Goal" :use (d7-p7-1
+                        d7-p7-2
+                        d7-p7-5
+                        d7-p7-29
+                        d7-p7-30))))
+
+;;**********************************************************************************
+
+;; Suppose that (admissible-for-iteration-p k rho m n table) = NIL.
+;; Let i = (i-sqrt k rho m n table), j = (j-sqrt k rho m n table),
+;; and h = (lookup i j table).
+;; Then 0 <= i < 2^m, 0 <= j < 2^n, and
+;; (check-sqrt-entry i j k rho m n h) = NIL.
+;; Let d = (d-sqrt k rho m n table) and p = (p-sqrt k rho m n table).
+;; Then (d,p) is in S_ij and |p - 2^((1-k)*rho)| <= d.
+;; If -2^rho < h < 2^rho, then either
+;;   p < ((h-1)/2^rho)*(d + (h-1)2^(-k*rho))
+;; or
+;;   p > ((h+1)/2^rho)*(d + (h+1)2^(-k*rho)).
+
+(defund i-sqrt-aux (i k rho m n table)
+  (if (zp i)
+      ()
+    (if (check-sqrt-row (1- i) (expt 2 n) k rho m n (nth (1- i) table))
+        (i-sqrt-aux (1- i) k rho m n table)
+      (1- i))))
+ 
+(defund i-sqrt (k rho m n table)
+  (i-sqrt-aux (expt 2 m) k rho m n table))
+
+(defund j-sqrt-aux (i j k rho m n row)
+  (if (zp j)
+      ()
+    (if (check-sqrt-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+        (j-sqrt-aux i (1- j) k rho m n row)
+      (1- j))))
+
+(defund j-sqrt (k rho m n table)
+  (let ((i (i-sqrt k rho m n table)))
+    (j-sqrt-aux i (expt 2 n) k rho m n (nth i table))))
+
+(defund d-sqrt (k rho m n table)
+  (let* ((i (i-sqrt k rho m n table))
+         (j (j-sqrt k rho m n table))
+         (h (lookup i j table)))
+    (if (or (not (integerp h))
+            (>= h (expt 2 rho))
+            (<= h (- (expt 2 rho))))
+        (d7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            1
+            (expt 2 (* (- 1 k) rho))
+            -1
+            (expt 2 (* (- 1 k) rho)))
+      (if (not (check-upper-bound h i j k rho m n))
+          (d7 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              1
+              (expt 2 (* (- 1 k) rho))
+              (/ (1+ h) (expt 2 rho))
+              (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+        (d7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            (/ (1- h) (expt 2 rho))
+            (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+            -1
+            (expt 2 (* (- 1 k) rho)))))))
+
+(defund p-sqrt (k rho m n table)
+  (let* ((i (i-sqrt k rho m n table))
+         (j (j-sqrt k rho m n table))
+         (h (lookup i j table)))
+    (if (or (not (integerp h))
+            (>= h (expt 2 rho))
+            (<= h (- (expt 2 rho))))
+        (p7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            1
+            (expt 2 (* (- 1 k) rho))
+            -1
+            (expt 2 (* (- 1 k) rho)))
+      (if (not (check-upper-bound h i j k rho m n))
+          (p7 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              1
+              (expt 2 (* (- 1 k) rho))
+              (/ (1+ h) (expt 2 rho))
+              (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+        (p7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            (/ (1- h) (expt 2 rho))
+            (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+            -1
+            (expt 2 (* (- 1 k) rho)))))))
+
+(local-defthm converse-33
+  (implies (and (natp i)
+                (not (check-sqrt-rows i k rho m n table)))
+           (let ((w (i-sqrt-aux i k rho m n table)))
+             (and (natp w)
+                  (< w i)
+                  (not (check-sqrt-row w (expt 2 n) k rho m n (nth w table))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable i-sqrt-aux check-sqrt-rows))))
+
+(local-defthm converse-34
+  (implies (and (natp m)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let ((i (i-sqrt k rho m n table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (not (check-sqrt-row i (expt 2 n) k rho m n (nth i table))))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-33 (i (expt 2 m)))
+                  :in-theory (enable i-sqrt admissible-for-iteration-p))))
+
+(local-defthm converse-35
+  (implies (and (natp j)
+                (not (check-sqrt-row i j k rho m n row)))
+           (let ((w (j-sqrt-aux i j k rho m n row)))
+             (and (natp w)
+                  (< w j)
+                  (not (check-sqrt-entry i w k rho m n (ifix (nth w row)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable j-sqrt-aux check-sqrt-row))))
+
+(local-defthm converse-36
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (sqrt-accessible-p i j k rho m n)
+                  (not (and (integerp h)
+                            (< (- (expt 2 rho)) h)
+                            (< h (expt 2 rho))
+                            (check-upper-bound h i j k rho m n)
+                            (check-lower-bound h i j k rho m n))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-34
+                        (:instance converse-35 (i (i-sqrt k rho m n table)) 
+                                               (j (expt 2 n)) 
+                                               (row (nth (i-sqrt k rho m n table) table))))
+                  :in-theory (enable lookup check-sqrt-entry j-sqrt))))
+
+(local-defthm converse-37
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-sqrt-entry i j k rho m n h)))
+           (and (< (- (expt 2 (* (- 1 k) rho)) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+                   (pi0 i m))
+                (< (pi0 i m)
+                   (+ (delta0 j n) (/ (expt 2 n)) (expt 2 (* (- 1 k) rho))))
+                (or (not (check-upper-bound h i j k rho m n))
+                    (not (check-lower-bound h i j k rho m n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry sqrt-accessible-p))))
+
+(local-defthm converse-38
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-upper-bound h i j k rho m n)))
+           (<= h (- (expt 2 rho) 2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-upper-bound))))
+
+(local-defthm converse-39
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (and (rationalp (delta0 j n))
+                (rationalp (pi0 i m))
+                (>= (delta0 j n) 1)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable delta0 pi0))))
+
+(local-defthm converse-40
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m))))
+                (not (check-upper-bound h i j k rho m n)))
+           (> (+ (pi0 i m) (expt 2 (- 3 m)))
+                 (* (/ (1+ h) (expt 2 rho))
+                    (+ (delta0 j n) (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-upper-bound))))
+
+(local-defthm converse-41
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-upper-bound h i j k rho m n)))
+           (< (/ (1+ h) (expt 2 rho)) 1))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-38
+                        (:instance *-strongly-monotonic (x (/ (expt 2 rho))) 
+                                                        (y (1+ h)) 
+                                                        (y+ (expt 2 rho)))))))
+
+(local-defthm converse-42
+  (implies (and (not (zp x))
+                (not (zp y)))
+           (not (zp (* x y))))
+  :rule-classes ())
+
+(local-defthm converse-43
+  (implies (and (integerp x)
+                (natp y)
+                (< x y)
+                (> x (- y)))
+           (< (* x x) (* y y)))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance converse-42 (x (+ y x)) (y (- y x))))))
+
+(local-defthm converse-44
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-upper-bound h i j k rho m n)))
+           (< (* (1+ h) (1+ h)) 
+              (expt 2 (* 2 rho))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-38
+                        (:instance converse-43 (x (1+ h)) (y (expt 2 rho)))))))
+
+(local-defthm converse-45
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (not (zp k))
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-upper-bound h i j k rho m n)))
+           (< (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho))))
+              (expt 2 (* (- 1 k) rho))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-44
+                        (:instance *-strongly-monotonic (x (expt 2 (- (* (1+ k) rho))))
+                                                        (y (* (1+ h) (1+ h)))
+                                                        (y+ (expt 2 (* 2 rho))))))))
+
+(local-defthm converse-46
+  (implies (and (rationalp h1)
+                (rationalp b1)
+                (rationalp h2)
+                (rationalp b2)
+                (< h2 h1)
+                (< b2 b1))
+           (< (+ h2 b2) (+ h1 b1)))
+  :rule-classes ())
+
+
+(local-defthm converse-47
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (not (zp k))
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-upper-bound h i j k rho m n)))
+           (< (+ (/ (1+ h) (expt 2 rho))
+                 (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+              (1+ (expt 2 (* (- 1 k) rho)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-45 
+                        converse-41
+                        (:instance converse-46 (h1 1)
+                                               (b1 (expt 2 (* (- 1 k) rho)))
+                                               (h2 (/ (1+ h) (expt 2 rho)))
+                                               (b2 (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho))))))))))
+
+
+(local-defthm converse-48
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (p (p-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (implies (and (integerp h)
+                           (< h (expt 2 rho))
+                           (> h (- (expt 2 rho)))
+                           (not (check-upper-bound h i j k rho m n))
+                           (or (< i (expt 2 (1- m)))
+                               (= i (1- (expt 2 m)))))
+                      (and (natp i)
+                           (< i (expt 2 m))
+                           (natp j)
+                           (< j (expt 2 n))
+                           (rationalp d)
+                           (rationalp p)
+                           (<= (delta0 j n) d)
+                           (< d (+ (delta0 j n) (expt 2 (- n))))
+                           (<= (pi0 i m) p)
+                           (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                           (< p (+ d (expt 2 (* (- 1 k) rho))))
+                           (> p (* (/ (1+ h) (expt 2 rho)) (+ d (* (1+ h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry d-sqrt p-sqrt)
+                  :use (converse-36
+                        (:instance converse-37 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-39 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table)))
+                        (:instance converse-40 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-41 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-47 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance d7-p7-lemma (dmin (delta0 (j-sqrt k rho m n table) n))
+                                               (dmax (+ (delta0 (j-sqrt k rho m n table) n) (expt 2 (- n))))
+                                               (pmin (pi0 (i-sqrt k rho m n table) m))
+                                               (pmax (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                               (d1 (+ (delta0 (j-sqrt k rho m n table) n) (/ (expt 2 n))))
+                                               (p1 (pi0 (i-sqrt k rho m n table) m))
+                                               (d2 (delta0 (j-sqrt k rho m n table) n))
+                                               (p2 (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                               (h1 1)
+                                               (b1 (expt 2 (* (- 1 k) rho)))
+                                               (h2 (/ (1+ (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (expt 2 rho)))
+                                               (b2 (* (1+ (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (1+ (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (expt 2 (- (* (1+ k) rho))))))))))
+
+(local-defthm converse-49
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (>= i (expt 2 (1- m)))
+                (not (= i (1- (expt 2 m))))
+                (not (check-upper-bound h i j k rho m n)))
+           (> (+ (pi0 i m) (expt 2 (- 3 m)))
+                 (* (/ (1+ h) (expt 2 rho))
+                    (+ (delta0 j n) (expt 2 (- n)) (* (1+ h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-upper-bound))))
+
+(local-defthm converse-50
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (p (p-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (implies (and (integerp h)
+                           (< h (expt 2 rho))
+                           (> h (- (expt 2 rho)))
+                           (not (check-upper-bound h i j k rho m n))
+                           (>= i (expt 2 (1- m)))
+                           (not (= i (1- (expt 2 m)))))
+                      (and (natp i)
+                           (< i (expt 2 m))
+                           (natp j)
+                           (< j (expt 2 n))
+                           (rationalp d)
+                           (rationalp p)
+                           (<= (delta0 j n) d)
+                           (< d (+ (delta0 j n) (expt 2 (- n))))
+                           (<= (pi0 i m) p)
+                           (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                           (< p (+ d (expt 2 (* (- 1 k) rho))))
+                           (> p (* (/ (1+ h) (expt 2 rho)) (+ d (* (1+ h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry d-sqrt p-sqrt)
+                  :use (converse-36
+                        (:instance converse-37 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-39 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table)))
+                        (:instance converse-49 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-41 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-47 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance d7-p7-lemma (dmin (delta0 (j-sqrt k rho m n table) n))
+                                               (dmax (+ (delta0 (j-sqrt k rho m n table) n) (expt 2 (- n))))
+                                               (pmin (pi0 (i-sqrt k rho m n table) m))
+                                               (pmax (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                               (d1 (+ (delta0 (j-sqrt k rho m n table) n) (/ (expt 2 n))))
+                                               (p1 (pi0 (i-sqrt k rho m n table) m))
+                                               (d2 (+ (delta0 (j-sqrt k rho m n table) n) (expt 2 (- n))))
+                                               (p2 (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                               (h1 1)
+                                               (b1 (expt 2 (* (- 1 k) rho)))
+                                               (h2 (/ (1+ (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (expt 2 rho)))
+                                               (b2 (* (1+ (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (1+ (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (expt 2 (- (* (1+ k) rho))))))))))
+
+(local-defthm converse-51
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (p (p-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (implies (and (integerp h)
+                           (< h (expt 2 rho))
+                           (> h (- (expt 2 rho)))
+                           (not (check-upper-bound h i j k rho m n)))
+                      (and (natp i)
+                           (< i (expt 2 m))
+                           (natp j)
+                           (< j (expt 2 n))
+                           (rationalp d)
+                           (rationalp p)
+                           (<= (delta0 j n) d)
+                           (< d (+ (delta0 j n) (expt 2 (- n))))
+                           (<= (pi0 i m) p)
+                           (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                           (< p (+ d (expt 2 (* (- 1 k) rho))))
+                           (> p (* (/ (1+ h) (expt 2 rho)) (+ d (* (1+ h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-50 converse-48))))
+
+(local-defthm converse-52
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-lower-bound h i j k rho m n)))
+           (>= h (- 2 (expt 2 rho))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-lower-bound))))
+
+(local-defthm converse-53
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-lower-bound h i j k rho m n)))
+           (> (/ (1- h) (expt 2 rho)) -1))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-52
+                        (:instance *-strongly-monotonic (x (/ (expt 2 rho))) 
+                                                        (y+ (1- h)) 
+                                                        (y (- (expt 2 rho))))))))
+
+(local-defthm converse-54
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (>= i (expt 2 (1- m)))
+                (not (check-lower-bound h i j k rho m n)))
+           (< (pi0 i m)
+              (* (/ (1- h) (expt 2 rho))
+                 (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-lower-bound))))
+
+(local-defthm converse-55
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (< i (expt 2 (1- m)))
+                (not (check-lower-bound h i j k rho m n)))
+           (< (pi0 i m)
+              (* (/ (1- h) (expt 2 rho))
+                 (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* k rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-lower-bound))))
+
+(local-defthm converse-56
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-lower-bound h i j k rho m n)))
+           (>= (/ (1- h) (expt 2 rho))
+               (- (expt 2 (- rho)) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-52
+                        (:instance *-weakly-monotonic (x (expt 2 rho)) (y+ (/ (1- h) (expt 2 rho))) (y (- (expt 2 (- rho)) 1)))))))
+
+(local-defthm converse-57
+  (implies (rationalp x)
+           (>= (* x x) 0))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance *-weakly-monotonic (y 0) (y+ x)))))
+
+(local-defthm converse-58
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-lower-bound h i j k rho m n)))
+           (>= (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-57 (x (1- h)))))))
+
+(local-defthm converse-59
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-lower-bound h i j k rho m n)))
+           (>= (expt 2 (- rho))
+               (expt 2 (* (- 1 k) rho))))
+  :rule-classes ())
+
+(local-defthm converse-60
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (rationalp w)
+                (>= x (1- z))
+                (>= y 0)
+                (>= z w))
+           (>= (+ x y) (1- w)))
+  :rule-classes ())
+
+(local-defthm converse-61
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho))
+                (not (check-lower-bound h i j k rho m n)))
+           (>= (+ (/ (1- h) (expt 2 rho))
+                  (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho)))))
+               (- (expt 2 (* (- 1 k) rho)) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-56 
+                        converse-58
+                        converse-59
+                        (:instance converse-60 (x (/ (1- h) (expt 2 rho)))
+                                               (y (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho)))))
+                                               (z (expt 2 (- rho)))
+                                               (w (expt 2 (* (- 1 k) rho))))))))
+
+(local-defthm converse-62
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (p (p-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (implies (and (integerp h)
+                           (< h (expt 2 rho))
+                           (> h (- (expt 2 rho)))
+                           (check-upper-bound h i j k rho m n)
+                           (not (check-lower-bound h i j k rho m n))
+                           (< i (expt 2 (1- m))))
+                      (and (natp i)
+                           (< i (expt 2 m))
+                           (natp j)
+                           (< j (expt 2 n))
+                           (rationalp d)
+                           (rationalp p)
+                           (<= (delta0 j n) d)
+                           (< d (+ (delta0 j n) (expt 2 (- n))))
+                           (<= (pi0 i m) p)
+                           (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                           (> p (- (expt 2 (* (- 1 k) rho)) d))
+                           (< p (* (/ (1- h) (expt 2 rho)) (+ d (* (1- h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry d-sqrt p-sqrt)
+                  :use (converse-36
+                        (:instance converse-37 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-39 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table)))
+                        (:instance converse-55 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-53 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-61 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance d7-p7-lemma (dmin (delta0 (j-sqrt k rho m n table) n))
+                                               (dmax (+ (delta0 (j-sqrt k rho m n table) n) (expt 2 (- n))))
+                                               (pmin (pi0 (i-sqrt k rho m n table) m))
+                                               (pmax (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                               (d1 (+ (delta0 (j-sqrt k rho m n table) n) (/ (expt 2 n))))
+                                               (p1 (pi0 (i-sqrt k rho m n table) m))
+                                               (d2 (+ (delta0 (j-sqrt k rho m n table) n) (/ (expt 2 n))))
+                                               (p2 (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                               (h2 -1)
+                                               (b2 (expt 2 (* (- 1 k) rho)))
+                                               (h1 (/ (1- (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (expt 2 rho)))
+                                               (b1 (* (1- (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (1- (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (expt 2 (- (* (1+ k) rho))))))))))
+
+(local-defthm converse-63
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (p (p-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (implies (and (integerp h)
+                           (< h (expt 2 rho))
+                           (> h (- (expt 2 rho)))
+                           (check-upper-bound h i j k rho m n)
+                           (not (check-lower-bound h i j k rho m n))
+                           (>= i (expt 2 (1- m))))
+                      (and (natp i)
+                           (< i (expt 2 m))
+                           (natp j)
+                           (< j (expt 2 n))
+                           (rationalp d)
+                           (rationalp p)
+                           (<= (delta0 j n) d)
+                           (< d (+ (delta0 j n) (expt 2 (- n))))
+                           (<= (pi0 i m) p)
+                           (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                           (> p (- (expt 2 (* (- 1 k) rho)) d))
+                           (< p (* (/ (1- h) (expt 2 rho)) (+ d (* (1- h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry d-sqrt p-sqrt)
+                  :use (converse-36
+                        (:instance converse-37 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-39 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table)))
+                        (:instance converse-54 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-53 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance converse-61 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))
+                        (:instance d7-p7-lemma (dmin (delta0 (j-sqrt k rho m n table) n))
+                                               (dmax (+ (delta0 (j-sqrt k rho m n table) n) (expt 2 (- n))))
+                                               (pmin (pi0 (i-sqrt k rho m n table) m))
+                                               (pmax (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                               (d1 (delta0 (j-sqrt k rho m n table) n))
+                                               (p1 (pi0 (i-sqrt k rho m n table) m))
+                                               (d2 (+ (delta0 (j-sqrt k rho m n table) n) (/ (expt 2 n))))
+                                               (p2 (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                               (h2 -1)
+                                               (b2 (expt 2 (* (- 1 k) rho)))
+                                               (h1 (/ (1- (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (expt 2 rho)))
+                                               (b1 (* (1- (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (1- (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)) (expt 2 (- (* (1+ k) rho))))))))))
+
+(local-defthm converse-64
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (p (p-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (implies (and (integerp h)
+                           (< h (expt 2 rho))
+                           (> h (- (expt 2 rho)))
+                           (check-upper-bound h i j k rho m n)
+                           (not (check-lower-bound h i j k rho m n)))
+                      (and (natp i)
+                           (< i (expt 2 m))
+                           (natp j)
+                           (< j (expt 2 n))
+                           (rationalp d)
+                           (rationalp p)
+                           (<= (delta0 j n) d)
+                           (< d (+ (delta0 j n) (expt 2 (- n))))
+                           (<= (pi0 i m) p)
+                           (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                           (> p (- (expt 2 (* (- 1 k) rho)) d))
+                           (< p (* (/ (1- h) (expt 2 rho)) (+ d (* (1- h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry d-sqrt p-sqrt)
+                  :use (converse-62 converse-63))))
+
+(local-defthm converse-65
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (rationalp d)
+                (<= (delta0 j n) d))
+           (< (* (/ (1- h) (expt 2 rho)) d) d))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance *-strongly-monotonic (x (/ d (expt 2 rho))) (y (1- h)) (y+ (expt 2 rho)))))) )
+
+(local-defthm converse-66
+  (implies (and (integerp x)
+                (not (zp y))
+                (<= x y)
+                (>= x (- y)))
+           (<= (* x x) (* y y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (x (- y x)) (y 0) (y+ (+ y x)))))))
+
+(local-defthm converse-67
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (rationalp d)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d))
+           (<= (* (1- h) (1- h))
+               (expt 2 (* 2 rho))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-66 (x (1- h)) (y (expt 2 rho)))))))
+
+(local-defthm converse-68
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (rationalp d)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (rationalp x)
+                (>= x 0))
+           (<= (* (1- h) (1- h) x)
+               (* (expt 2 (* 2 rho)) x)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-67
+                        (:instance *-weakly-monotonic (y (* (1- h) (1- h)))
+                                                      (y+ (expt 2 (* 2 rho))))))))
+
+(local-defthm converse-69
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (rationalp d)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d))
+           (<= (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+               (* (expt 2 (* 2 rho)) (expt 2 (- (* (1+ k) rho))))))
+  :rule-classes ()
+  :hints (("Goal" :do-not '(preprocess)
+                  :use (:instance converse-68 (x (expt 2 (- (* (1+ k) rho))))))))
+
+(local-defthm converse-70
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (rationalp d)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d))
+           (<= (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+               (* (expt 2 (* (- 1 k) rho)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-69))))
+
+(local-defthm converse-71
+  (implies (and (rationalp x1)
+                (rationalp y1)
+                (rationalp x2)
+                (rationalp y2)
+                (<= x1 x2)
+                (<= y1 y2))
+           (<= (+ x1 y1) (+ x2 y2)))
+  :rule-classes ())
+
+(local-defthm converse-72
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (rationalp d)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d))
+           (<= (* (/ (1- h) (expt 2 rho)) (+ d (* (1- h) (expt 2 (- (* k rho))))))
+               (+ d (expt 2 (* (- 1 k) rho)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-65 
+                        converse-70
+                        (:instance converse-71 (x1 (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho)))))
+                                               (x2 (* (expt 2 (* (- 1 k) rho))))
+                                               (y1 (* (/ (1- h) (expt 2 rho)) d))
+                                               (y2 d))))))
+
+(local-defthm converse-73
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (> k 1)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (p (p-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (implies (and (integerp h)
+                           (< h (expt 2 rho))
+                           (> h (- (expt 2 rho)))
+                           (check-upper-bound h i j k rho m n)
+                           (not (check-lower-bound h i j k rho m n)))
+                      (and (natp i)
+                           (< i (expt 2 m))
+                           (natp j)
+                           (< j (expt 2 n))
+                           (rationalp d)
+                           (rationalp p)
+                           (<= (delta0 j n) d)
+                           (< d (+ (delta0 j n) (expt 2 (- n))))
+                           (<= (pi0 i m) p)
+                           (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                           (< (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                           (< p (* (/ (1- h) (expt 2 rho)) (+ d (* (1- h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-64 
+                        (:instance converse-72 (i (i-sqrt k rho m n table)) 
+                                               (j (j-sqrt k rho m n table))
+                                               (d (d-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))))))
+
+
+(local-defthm converse-74
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho)))
+           (>= (/ (1+ h) (expt 2 rho))
+               (- (expt 2 (- rho)) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-52
+                        (:instance *-weakly-monotonic (x (expt 2 rho)) (y+ (/ (1+ h) (expt 2 rho))) (y (- (expt 2 (- rho)) 1)))))))
+
+(local-defthm converse-75
+  (implies (and (rationalp x)
+                (rationalp y)
+                (>= x 0)
+                (>= y 0))
+           (>= (* x y) 0))
+  :rule-classes ())
+
+(local-defthm converse-76
+  (implies (and (natp rho)
+                (natp k)
+                (integerp h))
+           (>= (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-57 (x (1+ h)))
+                        (:instance converse-75 (x (* (1+ h) (1+ h))) (y (expt 2 (- (* (1+ k) rho)))))))))
+
+(local-defthm converse-77
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho)))
+           (>= (expt 2 (- rho))
+               (expt 2 (* (- 1 k) rho))))
+  :rule-classes ())
+
+(local-defthm converse-78
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho)))
+           (>= (+ (/ (1+ h) (expt 2 rho))
+                  (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+               (- (expt 2 (* (- 1 k) rho)) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-74 
+                        converse-76
+                        converse-77
+                        (:instance converse-60 (x (/ (1+ h) (expt 2 rho)))
+                                               (y (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+                                               (z (expt 2 (- rho)))
+                                               (w (expt 2 (* (- 1 k) rho))))))))
+
+(local-defthm converse-79
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho)))
+           (> (/ (1+ h) (expt 2 rho))
+              -1))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-74))))
+
+(local-defthm converse-80
+  (implies (and (rationalp d)
+                (>= d 1)
+                (rationalp h1)
+                (rationalp b1)
+                (rationalp h2)
+                (rationalp b2)
+                (< h2 h1)
+                (<= (+ h2 b2) (+ h1 b1)))
+           (<= (+ (* h2 d) b2) (+ (* h1 d) b1)))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance *-weakly-monotonic (x (- h1 h2)) (y 1) (y+ d)))))
+
+(local-defthm converse-81
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (> k 1)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (rationalp d)
+                (>= d (delta0 j n))
+                (< h (expt 2 rho)))
+           (>= (+ (* (/ (1+ h) (expt 2 rho)) d)
+                  (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+               (- (expt 2 (* (- 1 k) rho)) d)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-79
+                        converse-39
+                        converse-78
+                        (:instance converse-80 (h1 (/ (1+ h) (expt 2 rho))) 
+                                               (b1 (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+                                               (h2 -1)
+                                               (b2 (expt 2 (* (- 1 k) rho))))))))
+
+(local-defthm converse-82
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (> k 1)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (p (p-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (implies (and (integerp h)
+                           (< h (expt 2 rho))
+                           (> h (- (expt 2 rho)))
+                           (not (check-upper-bound h i j k rho m n)))
+                      (and (natp i)
+                           (< i (expt 2 m))
+                           (natp j)
+                           (< j (expt 2 n))
+                           (rationalp d)
+                           (rationalp p)
+                           (<= (delta0 j n) d)
+                           (< d (+ (delta0 j n) (expt 2 (- n))))
+                           (<= (pi0 i m) p)
+                           (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                           (< (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                           (> p (* (/ (1+ h) (expt 2 rho)) (+ d (* (1+ h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-51
+                        (:instance converse-81 (i (i-sqrt k rho m n table))
+                                               (j (j-sqrt k rho m n table))
+                                               (d (d-sqrt k rho m n table))
+                                               (h (lookup (i-sqrt k rho m n table) (j-sqrt k rho m n table) table)))))))
+
+(local-defthm converse-83
+  (let* ((i (i-sqrt k rho m n table))
+         (j (j-sqrt k rho m n table))
+         (d (d-sqrt k rho m n table))
+         (p (p-sqrt k rho m n table))
+         (h (lookup i j table)))
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (natp k)
+                  (> k 1)
+                  (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (sqrt-accessible-p i j k rho m n)
+                  (not (and (integerp h)
+                            (< (- (expt 2 rho)) h)
+                            (< h (expt 2 rho)))))
+             (and (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (expt 2 (- n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (expt 2 (- 3 m))))
+                  (< (abs (- p (expt 2 (* (- 1 k) rho)))) d))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable d-sqrt p-sqrt sqrt-accessible-p)
+                  :use ((:instance converse-39 (i (i-sqrt k rho m n table))
+                                               (j (j-sqrt k rho m n table)))
+                        (:instance d7-p7-lemma 
+                                   (dmin (delta0 (j-sqrt k rho m n table) n))
+                                   (dmax (+ (delta0 (j-sqrt k rho m n table) n) (expt 2 (- n))))
+                                   (pmin (pi0 (i-sqrt k rho m n table) m))
+                                   (pmax (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                   (d1 (+ (delta0 (j-sqrt k rho m n table) n) (expt 2 (- n))))
+                                   (p1 (pi0 (i-sqrt k rho m n table) m))
+                                   (d2 (+ (delta0 (j-sqrt k rho m n table) n) (expt 2 (- n))))
+                                   (p2 (+ (pi0 (i-sqrt k rho m n table) m) (expt 2 (- 3 m))))
+                                   (b2 (expt 2 (* (- 1 k) rho)))
+                                   (b1 (expt 2 (* (- 1 k) rho)))
+                                   (h2 -1)
+                                   (h1 1))))))
+
+(defthm lemma-3-4-converse
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (> k 1)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table)) 
+                  (p (p-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (/ (expt 2 n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                  (< (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                  (or (<= h (- (expt 2 rho)))
+                      (>= h (expt 2 rho))
+                      (< p (* (/ (1- h) (expt 2 rho))
+                              (+ d (* (1- h) (expt 2 (- (* k rho)))))))
+                      (> p (* (/ (1+ h) (expt 2 rho))
+                              (+ d (* (1+ h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-83 converse-82 converse-73 converse-36))))
+
+;;**********************************************************************************
+
+(defund accessible-p (i j k rho m n)
+  (and (< (- (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n)) (expt 2 (- (* k rho)))))))
+
+(defthm div-accessible-accessible
+  (implies (and (integerp m)
+                (integerp n)
+                (integerp rho)
+                (integerp k)
+                (integerp i)
+                (integerp j)
+                (div-accessible-p i j m n))
+           (accessible-p i j k rho m n))
+  :hints (("Goal" :in-theory (enable div-accessible-p accessible-p))))
+
+(defund check-entry (i j k rho m n entry)
+  (or (not (accessible-p i j k rho m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (>= entry (lower i j rho m n))
+           (check-lower-bound entry i j (1+ k) rho m n))))
+
+(defund check-row (i j k rho m n row)
+  (if (zp j)
+      t
+    (and (check-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+         (check-row i (1- j) k rho m n row))))
+
+(defund check-rows (i k rho m n rows)
+  (if (zp i)
+      t
+    (and (check-row (1- i) (expt 2 n) k rho m n (nth (1- i) rows))
+         (check-rows (1- i) k rho m n rows))))
+
+(defund admissible-srt-table-p (k rho m n table)
+  (check-rows (expt 2 m) k rho m n table))
+  
+
+(local-defthm check-row-lemma
+  (implies (and (natp j)
+                (natp jj)
+                (< jj j)
+                (check-row i j k rho m n row))
+           (check-entry i jj k rho m n (ifix (nth jj row))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-row))))
+
+(local-defthm check-rows-lemma
+  (implies (and (natp i)
+                (natp ii)
+                (< ii i)
+                (check-rows i k rho m n rows))
+           (check-row ii (expt 2 n) k rho m n (nth ii rows)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-rows))))
+
+(local-defthm check-table-lemma
+  (implies (and (natp m)
+                (natp n)
+                (natp i)
+                (natp j)
+                (natp k)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (admissible-srt-table-p k rho m n table))
+           (check-entry i j k rho m n (lookup i j table)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lookup admissible-srt-table-p)
+                  :use ((:instance check-rows-lemma (rows table) (ii i) (i (expt 2 m)))
+                        (:instance check-row-lemma (row (nth i table)) (jj j) (j (expt 2 n)))))))
+
+(local-defthm lemma-3-6-18
+  (implies (and (integerp k)
+                (integerp k1)
+                (natp rho)
+                (>= (1- k1) k))
+           (<= (expt 2 (* (- 1 k1) rho))
+               (expt 2 (- (* k rho)))))
+  :rule-classes ())
+
+(local-defthm lemma-3-6-19
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z1)
+                (rationalp z2)
+                (< x (+ y z1))
+                (<= z1 z2))
+           (< x (+ y z2)))
+  :rule-classes ())
+
+(local-defthm lemma-3-6-20
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (natp k1)
+                (> k1 k)
+                (< (PI0 I M)
+                   (+ (EXPT 2 (- N))
+                      (DELTA0 J N)
+                      (EXPT 2 (* (- 1 K1) RHO)))))
+           (< (PI0 I M)
+              (+ (EXPT 2 (- N))
+                 (DELTA0 J N)
+                 (EXPT 2 (- (* K RHO))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-6-18
+                        (:instance lemma-3-6-19 (x (PI0 I M))
+                                                (y (+ (EXPT 2 (- N)) (DELTA0 J N)))
+                                                (z1 (EXPT 2 (+ RHO (- (* K1 RHO)))))
+                                                (z2 (EXPT 2 (- (* K RHO)))))))))
+
+(local-defthm lemma-3-6-21
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (natp k1)
+                (> k1 k)
+                (sqrt-accessible-p i j k1 rho m n))
+           (accessible-p i j k rho m n))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-6-20)
+                  :in-theory (enable sqrt-accessible-p accessible-p))))
+
+(defthm sqrt-accessible-accessible
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (bvecp i m)
+                (bvecp j n)
+                (natp k1)
+                (> k1 k)
+                (sqrt-accessible-p i j k1 rho m n))
+           (accessible-p i j k rho m n))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lemma-3-6-20 (h 8)))
+                  :in-theory (enable bvecp sqrt-accessible-p accessible-p))))
+
+(local-defthm lemma-3-6-22
+  (implies (and (integerp k)
+                (integerp k1)
+                (natp rho)
+                (> k1 k))
+           (>= (expt 2 (- (* (1+ k) rho)))
+               (expt 2 (- (* k1 rho)))))
+  :rule-classes ())
+
+(local-defthm lemma-3-6-23
+  (implies (and (integerp k)
+                (integerp k1)
+                (integerp h)
+                (natp rho)
+                (> k1 k))
+           (>= (* (1- h) (1- h) (/ (expt 2 rho)) (expt 2 (- (* (1+ k) rho))))
+               (* (1- h) (1- h) (/ (expt 2 rho)) (expt 2 (- (* k1 rho))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-6-22
+                        (:instance converse-57 (x (1- h)))
+                        (:instance *-weakly-monotonic (x (* (1- h) (1- h) (/ (expt 2 rho))))
+                                                      (y (expt 2 (- (* k1 rho))))
+                                                      (y+ (expt 2 (- (* (1+ k) rho)))))))))
+
+
+(local-defthm lemma-3-6-24
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (natp k1)
+                (> k1 k)
+                (< (pi0 i m)
+                   (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* k1 rho))))))))
+           (< (pi0 i m)
+              (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* (1+ k) rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-6-23
+                        (:instance lemma-3-6-19 (x (PI0 I M))
+                                                (y (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n)))))
+                                                (z1 (* (1- h) (1- h) (/ (expt 2 rho)) (expt 2 (- (* k1 rho)))))
+                                                (z2 (* (1- h) (1- h) (/ (expt 2 rho)) (expt 2 (- (* (1+ k) rho))))))))))
+
+(local-defthm lemma-3-6-25
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (natp k1)
+                (> k1 k)
+                (< (pi0 i m)
+                   (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (* (1- h) (expt 2 (- (* k1 rho))))))))
+           (< (pi0 i m)
+              (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (* (1- h) (expt 2 (- (* (1+ k) rho))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-6-23
+                        (:instance lemma-3-6-19 (x (PI0 I M))
+                                                (y (* (/ (1- h) (expt 2 rho)) (delta0 j n)))
+                                                (z1 (* (1- h) (1- h) (/ (expt 2 rho)) (expt 2 (- (* k1 rho)))))
+                                                (z2 (* (1- h) (1- h) (/ (expt 2 rho)) (expt 2 (- (* (1+ k) rho))))))))))
+
+(local-defthm lemma-3-6-26
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (natp k1)
+                (> k1 k)
+                (check-lower-bound h i j (1+ k) rho m n))
+           (check-lower-bound h i j k1 rho m n))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-6-24
+                        lemma-3-6-25)
+                  :in-theory (enable check-lower-bound))))
+
+(local-defthm lemma-3-6-27
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (>= h (lower i j rho m n))
+                (not (= h (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m)))))
+           (>= (1+ h)
+               (cg (* (expt 2 rho) 
+                      (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                         (delta0 j n))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39)
+                  :in-theory (enable lower))))
+
+(local-defthm lemma-3-6-28
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (>= h (lower i j rho m n))
+                (not (= h (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m)))))
+           (>= (1+ h)
+               (* (expt 2 rho) 
+                  (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                     (delta0 j n)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-6-27
+                        (:instance cg-def (x (* (expt 2 rho) (/ (+ (pi0 i m) (/ (expt 2 (- m 3)))) (delta0 j n)))))))))
+
+(local-defthm lemma-3-6-29
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (>= h (lower i j rho m n))
+                (not (= h (1- (expt 2 rho))))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m)))))
+           (>= (/ (* (1+ h) (delta0 j n)) (expt 2 rho))
+               (+ (pi0 i m) (/ (expt 2 (- m 3))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-6-28
+                        (:instance *-weakly-monotonic (x (/ (delta0 j n) (expt 2 rho)))
+                                                      (y+ (1+ h))
+                                                      (y (* (expt 2 rho) 
+                                                            (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                                               (delta0 j n)))))))))
+
+(local-defthm lemma-3-6-30
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (>= h (lower i j rho m n))
+                (not (= h (1- (expt 2 rho))))
+                (>= i (expt 2 (1- m)))
+                (not (= i (1- (expt 2 m)))))
+           (>= (1+ h)
+               (cg (* (expt 2 rho) 
+                      (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                         (+ (delta0 j n) (expt 2 (- n))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39)
+                  :in-theory (enable lower))))
+
+(local-defthm lemma-3-6-31
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (>= h (lower i j rho m n))
+                (not (= h (1- (expt 2 rho))))
+                (>= i (expt 2 (1- m)))
+                (not (= i (1- (expt 2 m)))))
+           (>= (1+ h)
+               (* (expt 2 rho) 
+                  (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                     (+ (delta0 j n) (expt 2 (- n)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-6-30
+                        (:instance cg-def (x (* (expt 2 rho) (/ (+ (pi0 i m) (/ (expt 2 (- m 3)))) (+ (delta0 j n) (expt 2 (- n)))))))))))
+
+(local-defthm lemma-3-6-32
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (>= h (lower i j rho m n))
+                (not (= h (1- (expt 2 rho))))
+                (>= i (expt 2 (1- m)))
+                (not (= i (1- (expt 2 m)))))
+           (>= (/ (* (1+ h) (+ (delta0 j n) (expt 2 (- n)))) (expt 2 rho))
+               (+ (pi0 i m) (/ (expt 2 (- m 3))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-6-31
+                        (:instance *-weakly-monotonic (x (/ (+ (delta0 j n) (expt 2 (- n))) (expt 2 rho)))
+                                                      (y+ (1+ h))
+                                                      (y (* (expt 2 rho) 
+                                                            (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                                                               (+ (delta0 j n) (expt 2 (- n)))))))))))
+
+(local-defthm lemma-3-6-33
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (< h (expt 2 rho))
+                (> h (- (expt 2 rho)))
+                (>= h (lower i j rho m n)))
+           (check-upper-bound h i j k rho m n))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-6-29
+                        lemma-3-6-32
+                        converse-76)
+                  :in-theory (enable check-upper-bound))))
+
+(local-defthm lemma-3-6-34
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp i)
+                (natp j)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (natp k1)
+                (> k1 k)
+                (check-entry i j k rho m n h))
+           (check-sqrt-entry i j k1 rho m n h))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry check-entry)
+                  :use ((:instance lemma-3-6-33 (k k1))
+                        lemma-3-6-21
+                        lemma-3-6-26))))
+
+(defthm lemma-3-6-a
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp k1)
+                (> k1 k)
+                (admissible-srt-table-p k rho m n table))
+           (admissible-for-iteration-p k1 rho m n table))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry check-div-entry check-entry)
+                  :use ((:instance check-table-lemma (i (i-sqrt k1 rho m n table))
+                                                     (j (j-sqrt k1 rho m n table)))
+                        (:instance converse-36 (k k1))
+                        (:instance lemma-3-6-34 (i (i-sqrt k1 rho m n table))
+                                                (j (j-sqrt k1 rho m n table))
+                                                (h (lookup (i-sqrt k1 rho m n table) (j-sqrt k1 rho m n table) table)))))))
+
+(defthm admissible-srt-table-p-2-2-6-2
+  (admissible-srt-table-p 2 2 6 2 (srt-table 2 6 2)))
+
+(defthm admissible-srt-table-p-2-3-7-4
+  (admissible-srt-table-p 2 3 7 4 (srt-table 3 7 4)))
+
+(defthm admissible-srt-table-p-2-3-8-3
+  (admissible-srt-table-p 2 3 8 3 (srt-table 3 8 3)))
+
+(defthm admissible-for-iteration-p-2-2-6-2
+  (implies (and (natp k)
+                (> k 2))
+           (admissible-for-iteration-p k 2 6 2 (srt-table 2 6 2)))
+  :hints (("Goal" :use (:instance lemma-3-6-a (table (srt-table 2 6 2)) (m 6) (n 2) (rho 2) (k 2) (k1 k)))))
+
+;;**********************************************************************************
+
+(local-defthm local-lemma
+  (implies (and (rationalp x)
+                (rationalp y1)
+                (rationalp y2)
+                (rationalp z)
+                (< x (+ y1 z))
+                (< y1 y2))
+           (< x (+ y2 z)))
+  :rule-classes ())
+
+(local-defthm rationalp-pi0
+  (implies (and (integerp i)
+                (integerp m))
+           (rationalp (pi0 i m)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable pi0))))
+
+(local-in-theory (disable i-bounds))
+
+(encapsulate (((rho%%) => *) ((m%%) => *) ((n%%) => *) ((k%%) => *) ((table%%) => *))
+
+(local (defun rho%% () 2))
+(local (defun m%% () 6))
+(local (defun n%% () 2))
+(local (defun k%% () 2))
+(local (defun table%% () (srt-table 2 6 2)))
+
+(defthmd rho%%-constraint
+  (not (zp (rho%%))))
+
+(defthmd m%%-constraint
+  (not (zp (m%%))))
+
+(defthmd n%%-constraint
+  (not (zp (n%%))))
+
+(defthmd k%%-constraint
+  (and (natp (k%%)) (> (k%%) 1)))
+
+(defthm table%%-constraint
+  (implies (and (natp k)
+                (> k (k%%)))
+           (admissible-for-iteration-p k (rho%%) (m%%) (n%%) (table%%)))
+  :hints (("Goal" :in-theory (disable srt-table (table%%) (srt-table)))))
+
+)
+
+(defthm natp-rho%%
+  (natp (rho%%))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :use rho%%-constraint)))
+
+(defthm natp-m%%
+  (natp (m%%))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :use m%%-constraint)))
+
+(defthm natp-n%%
+  (natp (n%%))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :use n%%-constraint)))
+
+(defthm natp-k%%
+  (natp (k%%))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :use k%%-constraint)))
+
+(encapsulate (((x%%) => *) ((p%% *) => *) ((q%% *) => *) ((h%% *) => *) ((i%% *) => *) ((j%% *) => *))
+
+(local (defun x%% () 1/2))
+
+(local (mutual-recursion
+
+(defun p%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      (x%%)
+    (- (* (expt 2 (rho%%)) (p%% (1- k)))
+       (* (h%% k) (+ (* 2 (q%% (1- k))) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))))
+
+(defun q%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      0
+    (+ (q%% (1- k)) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))
+
+(defun h%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 1)))
+  (lookup (i%% k) (j%% k) (table%%)))
+
+(defun i%% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (bits (fl (* (expt 2 (- (m%%) 2)) (p%% (1- k)))) (1- (m%%)) 0)))
+
+(defun j%% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (fl (* (expt 2 (n%%)) (1- (* 2 (q%% (1- k))))))))
+
+))
+
+(defthmd x%%-constraint
+  (and (rationalp (x%%))
+       (< 1/4 (x%%))
+       (< (x%%) 1)))
+
+(defthm p%%-def
+  (equal (p%% k)
+         (if (zp k)
+             (x%%)
+           (- (* (expt 2 (rho%%)) (p%% (1- k)))
+              (* (h%% k) (+ (* 2 (q%% (1- k))) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))))
+  :rule-classes (:definition))
+
+(defthm q%%-def
+  (equal (q%% k)
+         (if (zp k)
+             0
+           (+ (q%% (1- k)) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))
+  :rule-classes (:definition))
+
+(defthm integerp-h%%
+  (integerp (h%% k))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthmd h%%-def
+  (implies (and (natp k)
+                (> k (k%%)))
+           (equal (h%% k)
+                  (lookup (i%% k) (j%% k) (table%%))))
+  :rule-classes (:definition))
+
+(defun all-sqrt-accessible-p%% (k)
+  (if (or (zp k) (<= k (k%%)))
+      t
+    (and (sqrt-accessible-p (i%% k) (j%% k) k (rho%%) (m%%) (n%%))
+         (all-sqrt-accessible-p%% (1- k)))))
+
+(defthmd i%%-constraint
+  (implies (and (natp k)
+                (> k (k%%))
+                (rationalp (p%% (1- k)))
+                (< (abs (p%% (1- k))) 2)
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (bvecp (i%% k) (m%%))
+                (<= (pi0 (i%% k) (m%%))
+                    (p%% (1- k)))
+                (< (p%% (1- k))
+                   (+ (pi0 (i%% k) (m%%))
+                      (/ (expt 2 (- (m%%) 3)))))))
+  :hints (("Goal" :use (m%%-constraint 
+                        k%%-constraint 
+                        (:instance i-bounds (p (p%% (1- k))) (m (m%%)))
+                        (:instance local-lemma (x (P%% (+ -1 K)))
+                                               (y1 (EXPT 2 (+ 2 (- (M%%)))))
+                                               (y2 (EXPT 2 (+ 3 (- (M%%)))))
+                                               (z (pi0 (i%% k) (m%%))))))))
+
+(defthmd j%%-constraint
+  (implies (and (natp k)
+                (> k (k%%))
+                (rationalp (q%% (1- k)))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1))
+           (and (bvecp (j%% k) (n%%))
+                (<= (delta0 (j%% k) (n%%)) (* 2 (q%% (1- k))))
+                (< (* 2 (q%% (1- k))) (+ (delta0 (j%% k) (n%%)) (expt 2 (- (n%%)))))))
+  :hints (("Goal" :use (n%%-constraint (:instance j-bounds (d (* 2 (q%% (1- k)))) (n (n%%)))))))
+
+)
+
+(local-defthm rat-q%%
+  (rationalp (q%% k))
+  :hints (("Goal" :induct (natp-induct k)))
+  :rule-classes (:rewrite :type-prescription))
+
+(local-defthm rat-p%%
+  (rationalp (p%% k))
+  :hints (("Goal" :induct (natp-induct k)
+                  :in-theory (enable x%%-constraint)))
+  :rule-classes (:rewrite :type-prescription))
+
+(local-defthm rat-x%%
+  (rationalp (x%%))
+  :hints (("Goal" :in-theory (enable x%%-constraint)))
+  :rule-classes (:rewrite :type-prescription))
+
+(local-defthm int-rho%%
+  (integerp (rho%%))
+  :hints (("Goal" :use (rho%%-constraint)))
+  :rule-classes (:rewrite :type-prescription))
+
+(local-defthm theorem-2-5
+  (implies (and (not (zp (rho%%)))
+                (natp k)
+                (> k (k%%))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1)
+                (<= (- (* 2 (q%% (1- k))))
+                    (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%))))))
+                (< (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%)))))
+                   (* 2 (q%% (1- k)))))
+           (< (abs (p%% (1- k))) 2))
+  :hints (("Goal" :use (k%%-constraint
+                        (:functional-instance lemma-3-3-9 (rho$$ rho%%)
+                                                          (x$$ x%%)
+                                                          (h$$ h%%)
+                                                          (q$$ q%%)
+                                                          (p$$ p%%)))))
+  :rule-classes ())
+
+(local-defthm theorem-2-20
+  (implies (and (natp k)
+                (>= k (k%%))
+                (<= 1/2 (q%% k)))
+           (iff (and (<= (- (* 2 (q%% k)))
+                         (- (p%% k) (expt 2 (- (* k (rho%%))))))
+                     (< (- (p%% k) (expt 2 (- (* k (rho%%)))))
+                        (* 2 (q%% k))))
+                (and (< (x%%) (* (+ (q%% k) (expt 2 (- (* k (rho%%))))) 
+                                 (+ (q%% k) (expt 2 (- (* k (rho%%)))))))
+                     (>= (x%%) (* (- (q%% k) (expt 2 (- (* k (rho%%))))) 
+                                  (- (q%% k) (expt 2 (- (* k (rho%%))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint
+                        (:functional-instance lemma-3-2-a-b (rho$$ rho%%)
+                                                            (x$$ x%%)
+                                                            (h$$ h%%)
+                                                            (q$$ q%%)
+                                                            (p$$ p%%))))))
+
+(local-defthm theorem-2-6
+  (implies (and (not (zp (rho%%)))
+                (natp k)
+                (> k (k%%))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1)
+                (<= (- (* 2 (q%% (1- k))))
+                    (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%))))))
+                (< (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%)))))
+                   (* 2 (q%% (1- k))))
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (equal (h%% k)
+                       (lookup (i%% k) (j%% k) (table%%)))
+                (bvecp (i%% k) (m%%))
+                (<= (pi0 (i%% k) (m%%))
+                    (p%% (1- k)))
+                (< (p%% (1- k))
+                   (+ (pi0 (i%% k) (m%%))
+                      (/ (expt 2 (- (m%%) 3)))))
+                (bvecp (j%% k) (n%%))
+                (<= (delta0 (j%% k) (n%%)) (* 2 (q%% (1- k))))
+                (< (* 2 (q%% (1- k))) (+ (delta0 (j%% k) (n%%)) (expt 2 (- (n%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-5
+                        h%%-def
+                        i%%-constraint
+                        j%%-constraint))))
+
+(local-defthm theorem-2-7
+  (implies (and (not (zp (rho%%)))
+                (natp k)
+                (> k (k%%))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1)
+                (<= (- (* 2 (q%% (1- k))))
+                    (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%))))))
+                (< (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%)))))
+                   (* 2 (q%% (1- k))))
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (< (h%% k) (expt 2 (rho%%)))
+                (> (h%% k) (- (expt 2 (rho%%))))
+                (< (p%% (1- k))
+                   (* (/ (1+ (h%% k)) (expt 2 (rho%%)))
+                      (+ (* 2 (q%% (1- k))) (* (1+ (h%% k)) (expt 2 (- (* k (rho%%))))))))
+                (>= (p%% (1- k))             
+                    (* (/ (1- (h%% k)) (expt 2 (rho%%)))
+                       (+ (* 2 (q%% (1- k))) (* (1- (h%% k)) (expt 2 (- (* k (rho%%))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-6
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint
+                        table%%-constraint
+                        (:instance lemma-3-4 (m (m%%))
+                                             (n (n%%))
+                                             (rho (rho%%))
+                                             (table (table%%))
+                                             (p (p%% (1- k)))
+                                             (d (* 2 (q%% (1- k))))
+                                             (i (i%% k))
+                                             (j (j%% k))
+                                             (h (h%% k)))))))
+
+(local-defthm theorem-2-8
+  (implies (and (not (zp (rho%%)))
+                (natp k)
+                (> k (k%%))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1)
+                (<= (- (* 2 (q%% (1- k))))
+                    (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%))))))
+                (< (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%)))))
+                   (* 2 (q%% (1- k))))
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (<= (- (* 2 (q%% k)))
+                    (- (p%% k) (expt 2 (- (* k (rho%%))))))
+                (< (- (p%% k) (expt 2 (- (* k (rho%%)))))
+                   (* 2 (q%% k)))))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-7
+                        (:functional-instance lemma-3-2-b-c (rho$$ rho%%)
+                                                            (x$$ x%%)
+                                                            (h$$ h%%)
+                                                            (q$$ q%%)
+                                                            (p$$ p%%))))))
+
+(local-defthm theorem-2-9
+  (implies (and (natp k)
+                (> k (k%%))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1)
+                (<= (- (* 2 (q%% (1- k))))
+                    (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%))))))
+                (< (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%)))))
+                   (* 2 (q%% (1- k))))
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (< (x%%) (* (+ (q%% k) (expt 2 (- (* k (rho%%))))) 
+                            (+ (q%% k) (expt 2 (- (* k (rho%%)))))))
+                (>= (x%%) (* (- (q%% k) (expt 2 (- (* k (rho%%))))) 
+                             (- (q%% k) (expt 2 (- (* k (rho%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-8
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint
+                        (:functional-instance lemma-3-2-a-b (rho$$ rho%%)
+                                                            (x$$ x%%)
+                                                            (h$$ h%%)
+                                                            (q$$ q%%)
+                                                            (p$$ p%%))))))
+
+(local-defthm theorem-2-21
+  (implies (<= 1/2 (q%% (k%%)))
+           (iff (and (<= (- (* 2 (q%% (k%%))))
+                         (- (p%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))))
+                     (< (- (p%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))
+                        (* 2 (q%% (k%%)))))
+                (and (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                                 (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                     (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                                  (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k%%-constraint
+                        (:instance theorem-2-20 (k (k%%)))))))
+
+(local-defthm theorem-2-10
+  (implies (and (natp k)
+                (> k (k%%))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1)
+                (<= (- (* 2 (q%% (1- k))))
+                    (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%))))))
+                (< (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%)))))
+                   (* 2 (q%% (1- k))))
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (<= 1/2 (q%% k))
+                (< (q%% k) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-7
+                        theorem-2-9
+                        rho%%-constraint
+                        m%%-constraint
+                        n%%-constraint
+                        x%%-constraint
+                        k%%-constraint
+                        (:functional-instance lemma-3-3-b (rho$$ rho%%)
+                                                          (x$$ x%%)
+                                                          (h$$ h%%)
+                                                          (q$$ q%%)
+                                                          (p$$ p%%))))))
+
+(local-defthm theorem-2-11
+  (implies (and (natp k)
+                (> k (k%%))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1)
+                (<= (- (* 2 (q%% (1- k))))
+                    (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%))))))
+                (< (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%)))))
+                   (* 2 (q%% (1- k))))
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (<= 1/2 (q%% k))
+                (< (q%% k) 1)
+                (<= (- (* 2 (q%% k)))
+                    (- (p%% k) (expt 2 (- (* k (rho%%))))))
+                (< (- (p%% k) (expt 2 (- (* k (rho%%)))))
+                   (* 2 (q%% k)))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint
+                        theorem-2-10
+                        theorem-2-8))))
+
+(defthmd theorem-2-19
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (<= (abs (- (p%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))))
+                    (* 2 (q%% (k%%))))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1)
+                (<= (- (* 2 (q%% (1- k))))
+                    (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%))))))
+                (< (- (p%% (1- k)) (expt 2 (- (* (1- k) (rho%%)))))
+                   (* 2 (q%% (1- k))))
+                (all-sqrt-accessible-p%% (1- k))
+                (natp k)
+                (> k (k%%)))
+           (all-sqrt-accessible-p%% k))
+  :hints (("Goal" :expand ((all-sqrt-accessible-p%% k))
+                  :use (i%%-constraint
+                        j%%-constraint
+                        rho%%-constraint
+                        m%%-constraint
+                        n%%-constraint
+                        theorem-2-5
+                        (:instance sqrt-table-1 (i (i%% k)) (j (j%% k)) (rho (rho%%)) (m (m%%)) (n (n%%)) 
+                                                (p (p%% (1- k))) (d (* 2 (q%% (1- k)))))))))
+
+(local-defthm theorem-2-12
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (<= (- (* 2 (q%% (k%%))))
+                    (- (p%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))))
+                (< (- (p%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))
+                   (* 2 (q%% (k%%))))
+                (natp k)
+                (>= k (k%%)))
+           (and (<= 1/2 (q%% k))
+                (< (q%% k) 1)
+                (<= (- (* 2 (q%% k)))
+                    (- (p%% k) (expt 2 (- (* k (rho%%))))))
+                (< (- (p%% k) (expt 2 (- (* k (rho%%)))))
+                   (* 2 (q%% k)))
+                (all-sqrt-accessible-p%% k)))
+  :rule-classes ()
+  :hints (("Goal" :induct (natp-induct k))
+          ("Subgoal *1/2" :use (k%%-constraint
+                                theorem-2-19
+                                theorem-2-11)
+                          :cases ((= k (k%%))))
+          ("Subgoal *1/1" :use (k%%-constraint))))
+
+(defthm theorem-2-b
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (>= k (k%%)))
+           (< (abs (p%% k)) 2))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-12
+                        theorem-2-21
+                        k%%-constraint
+                        rho%%-constraint
+                        (:instance theorem-2-5 (k (1+ k)))))))
+
+(local-defthmd theorem-2-14
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (<= (- (* 2 (q%% (k%%))))
+                    (- (p%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))))
+                (< (- (p%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))
+                   (* 2 (q%% (k%%))))
+                (natp k)
+                (>= k (k%%)))
+           (equal (p%% k)
+                  (* (expt 2 (* k (rho%%)))
+                     (- (x%%) (* (q%% k) (q%% k))))))
+  :hints (("Goal" :use (k%%-constraint
+                        rho%%-constraint
+                        (:functional-instance lemma-3-1 (rho$$ rho%%)
+                                                        (x$$ x%%)
+                                                        (h$$ h%%)
+                                                        (q$$ q%%)
+                                                        (p$$ p%%))))))
+
+(defthm theorem-2-a
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                            (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (>= k (k%%)))
+           (and (< (x%%) (* (+ (q%% k) (expt 2 (- (* k (rho%%))))) 
+                            (+ (q%% k) (expt 2 (- (* k (rho%%)))))))
+                (>= (x%%) (* (- (q%% k) (expt 2 (- (* k (rho%%))))) 
+                             (- (q%% k) (expt 2 (- (* k (rho%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-12
+                        theorem-2-20
+                        theorem-2-21))))
+
+(defthm theorem-2-b
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (>= k (k%%)))
+           (< (abs (p%% k)) 2))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-12
+                        theorem-2-21
+                        k%%-constraint
+                        rho%%-constraint
+                        (:instance theorem-2-5 (k (1+ k)))))))
+
+(defthmd theorem-2-c
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                            (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (> k (k%%)))
+           (sqrt-accessible-p (i%% k) (j%% k) k (rho%%) (m%%) (n%%)))
+  :hints (("Goal" :in-theory (enable all-sqrt-accessible-p%%)
+                  :use (theorem-2-12
+                        theorem-2-21))))
+
+
+;;**********************************************************************************
+
+(local-defun pow2 (n)
+  (if (zp n)
+      0
+    (+ 3 (pow2 (fl (/ n 2))))))
+
+(local-defthm lemma-3-5-1
+  (implies (and (not (zp n))
+                (natp m)
+                (> m (fl (/ n 2))))
+           (> (* 8 m) n))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fl-def (x (/ n 2)))
+                        (:instance *-strongly-monotonic (x 8) (y (1- (/ n 2))) (y+ m))))))
+
+(local-defthm lemma-3-5-2
+  (implies (not (zp n))
+           (> (expt 2 (pow2 n)) n))
+  :rule-classes ()
+  :hints (("Subgoal *1/2" :use ((:instance lemma-3-5-1 (m (expt 2 (pow2 (fl (/ n 2))))))))))
+
+(local-defund k-witness (x)
+  (pow2 (cg (/ x))))
+
+(local-defthm lemma-3-5-3
+  (implies (and (rationalp x)
+                (> x 0))
+           (and (natp (k-witness x))
+                (> (expt 2 (k-witness x)) (/ x))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable k-witness)
+                  :use ((:instance lemma-3-5-2 (n (cg (/ x))))))))
+
+(local-defthm lemma-3-5-4
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> x 0)
+                (> y 0))
+           (iff (< x y) (< (/ y) (/ x))))
+  :rule-classes ())
+
+(local-defthm lemma-3-5-5
+  (implies (and (rationalp x)
+                (> x 0))
+           (< (expt 2 (- (k-witness x))) x))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-3
+                        (:instance lemma-3-5-4 (x (expt 2 (- (k-witness x)))) (y x))))))
+
+(local-defthm lemma-3-5-6
+  (implies (and (rationalp x)
+                (> x 0))
+           (natp (k-witness x)))
+  :rule-classes (:type-prescription :rewrite)
+  :hints (("Goal" :use (lemma-3-5-3
+                        (:instance lemma-3-5-4 (x (expt 2 (- (k-witness x)))) (y x))))))
+
+(local-defthm lemma-3-5-7
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp i)
+                (natp j)
+                (natp k)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (div-accessible-p i j m n))
+           (> (pi0 i m)
+              (+ (- (delta0 j n)) 
+                 (- (/ (expt 2 n))) 
+                 (- (/ (expt 2 (- m 3)))) 
+                 (expt 2 (- (k-witness (+ (pi0 i m) (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3))))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable div-accessible-p)
+                  :use (converse-39
+                        (:instance lemma-3-5-5 (x (+ (pi0 i m) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))))))))
+
+(local-defthm lemma-3-5-8
+  (implies (and (integerp a)
+                (integerp b)
+                (>= a b))
+           (<= (expt 2 (- a)) (expt 2 (- b))))
+  :rule-classes ())
+
+(local-defthm lemma-3-5-9
+  (implies (and (not (zp rho))
+                (natp k))
+           (<= k (* k rho)))
+  :rule-classes ())
+
+(local-defthm lemma-3-5-10
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp i)
+                (natp j)
+                (natp k)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (div-accessible-p i j m n)
+                (natp k)
+                (>= k (k-witness (+ (pi0 i m) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3))))))))
+           (>= (expt 2 (- (k-witness (+ (pi0 i m) (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))))
+               (expt 2 (- (* k rho)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-5-9
+                        (:instance lemma-3-5-8 (a (* k rho))
+                                               (b (k-witness (+ (pi0 i m) (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))))))))
+
+(local-defthm lemma-3-5-11
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp i)
+                (natp j)
+                (natp k)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (div-accessible-p i j m n)
+                (natp k)
+                (>= k (k-witness (+ (pi0 i m) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3))))))))
+           (>= (+ (- (delta0 j n)) 
+                  (- (/ (expt 2 n))) 
+                  (- (/ (expt 2 (- m 3)))) 
+                  (expt 2 (- (k-witness (+ (pi0 i m) (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3))))))))
+               (+ (- (delta0 j n)) 
+                  (- (/ (expt 2 n))) 
+                  (- (/ (expt 2 (- m 3)))) 
+                  (expt 2 (- (* k rho))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-5-10))))
+
+(local-defthm lemma-3-5-12
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (> x y)
+                (>= y z))
+           (> x z))
+  :rule-classes ())
+
+(local-defthm lemma-3-5-13
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp i)
+                (natp j)
+                (natp k)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (div-accessible-p i j m n)
+                (natp k)
+                (>= k (k-witness (+ (pi0 i m) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3))))))))
+           (> (pi0 i m)
+              (+ (- (delta0 j n)) 
+                 (- (/ (expt 2 n))) 
+                 (- (/ (expt 2 (- m 3)))) 
+                 (expt 2 (- (* k rho))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-5-7
+                        lemma-3-5-11
+                        (:instance lemma-3-5-12 (x (pi0 i m))
+                                                (y (+ (- (delta0 j n)) 
+                                                      (- (/ (expt 2 n))) 
+                                                      (- (/ (expt 2 (- m 3)))) 
+                                                      (expt 2 (- (k-witness (+ (pi0 i m) (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))))))
+                                                (z (+ (- (delta0 j n)) 
+                                                      (- (/ (expt 2 n))) 
+                                                      (- (/ (expt 2 (- m 3)))) 
+                                                      (expt 2 (- (* k rho))))))))))
+
+(local-defthm lemma-3-5-14
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp i)
+                (natp j)
+                (natp k)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (div-accessible-p i j m n)
+                (natp k)
+                (> k (k-witness (+ (pi0 i m) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3))))))))
+           (sqrt-accessible-p i j k rho m n))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance lemma-3-5-13 (k (1- k))))
+                  :in-theory (enable div-accessible-p sqrt-accessible-p))))
+
+(local-defthm lemma-3-5-15
+  (implies (and (natp i)
+                (natp j)
+                (< i (expt 2 (m%%)))
+                (< j (expt 2 (n%%)))
+                (div-accessible-p i j (m%%) (n%%))
+                (natp k)
+                (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3)))))))))
+           (let ((h (lookup i j (table%%))))
+             (and (< (- (expt 2 (rho%%))) h)
+                  (< h (expt 2 (rho%%)))
+                  (check-upper-bound h i j k (rho%%) (m%%) (n%%))
+                  (check-lower-bound h i j k (rho%%) (m%%) (n%%)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry)
+                  :use (table%%-constraint
+                        rho%%-constraint
+                        m%%-constraint
+                        n%%-constraint
+                        k%%-constraint
+                        (:instance lemma-3-5-14 (rho (rho%%)) (m (m%%)) (n (n%%)))
+                        (:instance check-sqrt-table-lemma (m (m%%)) (n (n%%)) (rho (rho%%)) (table (table%%)))))))
+
+(local-defthm lemma-3-5-16
+  (implies (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+           (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+                  (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+                  (h (lookup i j (table%%))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (div-accessible-p i j (m%%) (n%%))
+                  (not (and (< (- (expt 2 (rho%%))) h)
+                            (< h (expt 2 (rho%%)))
+                            (>= h (lower i j (rho%%) (m%%) (n%%)))
+                            (<= h (upper i j (rho%%) (m%%) (n%%))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint
+                        m%%-constraint
+                        n%%-constraint
+                        (:instance div-witness-lemma (m (m%%)) (n (n%%)) (rho (rho%%)) (table (table%%)))))))
+
+(local-defthm lemma-3-5-17
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (natp k)
+                  (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3)))))))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (< h (expt 2 (rho%%)))
+                  (check-upper-bound h i j k (rho%%) (m%%) (n%%))
+                  (check-lower-bound h i j k (rho%%) (m%%) (n%%))
+                  (not (and (>= h (lower i j (rho%%) (m%%) (n%%)))
+                            (<= h (upper i j (rho%%) (m%%) (n%%))))))))
+                            
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-16 
+                        (:instance lemma-3-5-15 (i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+                                                (j (j-witness (rho%%) (m%%) (n%%) (table%%))))))))
+
+(local-defthm lemma-3-5-18
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp i)
+                (natp j)
+                (natp k)
+                (< i (expt 2 m))
+                (< j (expt 2 n))
+                (integerp h)
+                (check-lower-bound h i j k rho m n)
+                (= h (- 1 (expt 2 rho))))
+           (<= h (upper i j rho m n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-lower-bound upper))))
+
+(local-defthm lemma-3-5-19
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (< h (expt 2 rho)))
+           (>= (* (1- h) (1- h) (expt 2 (- (* k rho))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance converse-57 (x (1- h)))))))
+
+(local-defthm lemma-3-5-20
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (> (expt 2 rho) k)
+                (> k (upper i j rho m n)))
+           (and (> k (- 1 (expt 2 rho)))
+                (if (>= i (expt 2 (1- m)))
+                    (> (1- k) 
+                       (fl (* (expt 2 rho) 
+                              (/ (pi0 i m)
+                                 (delta0 j n)))))
+                  (> (1- k)
+                     (fl (* (expt 2 rho) 
+                            (/ (pi0 i m)
+                               (+ (delta0 j n) (/ (expt 2 n))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39)
+                  :in-theory (enable upper))))
+
+(local-defthm lemma-3-5-21
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (> (expt 2 rho) k)
+                (> k (upper i j rho m n)))
+           (and (> k (- 1 (expt 2 rho)))
+                (if (>= i (expt 2 (1- m)))
+                    (> (1- k) 
+                       (* (expt 2 rho) 
+                          (/ (pi0 i m)
+                             (delta0 j n))))
+                  (> (1- k)
+                     (* (expt 2 rho) 
+                        (/ (pi0 i m)
+                           (+ (delta0 j n) (/ (expt 2 n)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-5-20
+                        (:instance fl-unique 
+                                   (x (* (expt 2 rho) 
+                                         (/ (pi0 i m)
+                                            (+ (delta0 j n) (/ (expt 2 n))))))
+                                   (n (1- k)))
+                        (:instance fl-unique 
+                                   (x (* (expt 2 rho) 
+                                         (/ (pi0 i m)
+                                            (+ (delta0 j n)))))
+                                   (n (1- k)))))))
+
+(local-defthm converse-8 
+  (implies (and (rationalp dmin)
+                (rationalp pmin)
+                (rationalp h)
+                (> h 0))
+           (iff (< (* pmin h) (* dmin h))
+                (< pmin dmin)))
+  :rule-classes ())
+
+(local-defthm lemma-3-5-22
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (> (1- k) 
+                   (* (expt 2 rho) 
+                      (/ (pi0 i m)
+                         (delta0 j n)))))
+           (> (* (/ (1- k) (expt 2 rho)) (delta0 j n))
+              (pi0 i m)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance converse-8
+                                   (dmin (1- k))
+                                   (h (/ (delta0 j n) (expt 2 rho)))
+                                   (pmin (* (expt 2 rho) 
+                                            (/ (pi0 i m)
+                                               (delta0 j n)))))))))
+
+(local-defthm lemma-3-5-23
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (> (1- k) 
+                   (* (expt 2 rho) 
+                      (/ (pi0 i m)
+                         (+ (delta0 j n) (expt 2 (- n)))))))
+           (> (* (/ (1- k) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n))))
+              (pi0 i m)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        (:instance converse-8
+                                   (dmin (1- k))
+                                   (h (/ (+ (delta0 j n) (expt 2 (- n))) (expt 2 rho)))
+                                   (pmin (* (expt 2 rho) 
+                                            (/ (pi0 i m)
+                                               (+ (delta0 j n) (expt 2 (- n)))))))))))
+
+(local-defthm lemma-3-5-24
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp k)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) k)
+                (> (expt 2 rho) k)
+                (> k (upper i j rho m n)))
+           (and (> k (- 1 (expt 2 rho))           )
+                (if (>= i (expt 2 (1- m)))
+                    (> (* (/ (1- k) (expt 2 rho)) (delta0 j n))
+                       (pi0 i m))
+                  (> (* (/ (1- k) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n))))
+                     (pi0 i m)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-21 lemma-3-5-22 lemma-3-5-23))))
+
+(local-defthm lemma-3-5-25
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (< x y)
+                (<= 0 z))
+           (< x (+ y z)))
+  :rule-classes ())
+
+(local-defthm lemma-3-5-26
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (> (expt 2 rho) h)
+                (> h (upper i j rho m n))
+                (>= i (expt 2 (1- m))))
+            (> (* (/ (1- h) (expt 2 rho)) (delta0 j n))
+               (pi0 i m)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lemma-3-5-24 (k h))))))
+
+(local-defthm lemma-3-5-27
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (> (expt 2 rho) h)
+                (> h (upper i j rho m n))
+                (>= i (expt 2 (1- m))))
+            (> (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (* (1- h) (expt 2 (- (* k rho))))))
+               (pi0 i m)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-5-19
+                        lemma-3-5-26
+                        (:instance lemma-3-5-25 (x (pi0 i m))
+                                               (y (* (/ (1- h) (expt 2 rho)) (delta0 j n)))
+                                               (z (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))))))))
+
+(local-defthm lemma-3-5-28
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (> (expt 2 rho) h)
+                (check-lower-bound h i j k rho m n)
+                (not (= h (- 1 (expt 2 rho))))
+                (>= i (expt 2 (1- m))))
+           (<= h (upper i j rho m n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-lower-bound)
+                  :use (converse-39
+                        lemma-3-5-27))))
+
+(local-defthm lemma-3-5-29
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (> (expt 2 rho) h)
+                (> h (upper i j rho m n))
+                (< i (expt 2 (1- m))))
+            (> (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n))))
+               (pi0 i m)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lemma-3-5-24 (k h))))))
+
+(local-defthm lemma-3-5-30
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (> (expt 2 rho) h)
+                (> h (upper i j rho m n))
+                (< i (expt 2 (1- m))))
+            (> (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* k rho))))))
+               (pi0 i m)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-5-29
+                        lemma-3-5-19
+                        (:instance lemma-3-5-25 (x (pi0 i m))
+                                               (y (* (/ (1- h) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n)))))
+                                               (z (* (1- h) (1- h) (expt 2 (- (* (+ 1 k) rho))))))))))
+
+(local-defthm lemma-3-5-31
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (natp k)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (> (expt 2 rho) h)
+                (check-lower-bound h i j k rho m n)
+                (not (= h (- 1 (expt 2 rho)))))
+           (<= h (upper i j rho m n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-lower-bound)
+                  :use (converse-39
+                        lemma-3-5-30
+                        lemma-3-5-28))))
+
+(local-defthm lemma-3-5-32
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (natp k)
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (< (- (expt 2 rho)) h)
+                (> (expt 2 rho) h)
+                (>= h (lower i j rho m n))
+                (check-lower-bound h i j k rho m n))
+           (<= h (upper i j rho m n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-lower-bound)
+                  :use (converse-39
+                        lemma-3-5-18
+                        lemma-3-5-31))))
+
+(local-defthm lemma-3-5-33
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (natp k)
+                  (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3)))))))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (check-upper-bound h i j k (rho%%) (m%%) (n%%))
+                  (< h (lower i j (rho%%) (m%%) (n%%))))))
+                            
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-17
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint
+                        (:instance lemma-3-5-32 (m (m%%)) (n (n%%)) (rho (rho%%)) (i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+                                                (j (j-witness (rho%%) (m%%) (n%%) (table%%))) 
+                                                (h (lookup (i-witness (rho%%) (m%%) (n%%) (table%%))(j-witness (rho%%) (m%%) (n%%) (table%%))(table%%))))))))
+
+(local-defthm lemma-3-5-3-a
+  (implies (and (rationalp x)
+                (> x 0)
+                (natp k)
+                (>= k (k-witness x)))
+           (> (expt 2 k) (/ x)))
+  :rule-classes ()
+  :hints (("Goal" :use lemma-3-5-3)))
+
+(local-defthm lemma-3-5-5-a
+  (implies (and (rationalp x)
+                (> x 0)
+                (natp k)
+                (>= k (k-witness x)))
+           (< (expt 2 (- k)) x))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-3-a
+                        (:instance lemma-3-5-4 (x (expt 2 (- k))) (y x))))))
+
+(local-defthm lemma-3-5-34
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (> x y)
+                (> z 0)
+                (natp k)
+                (> k (k-witness (/ (- x y) z))))
+           (> x (+ y (* z (expt 2 (- k))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lemma-3-5-5-a (x (/ (- x y) z)))
+                        (:instance *-strongly-monotonic (x z) (y (expt 2 (- k))) (y+ (/ (- x y) z)))))))
+
+(local-defthm lemma-3-5-35
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (or (< i (expt 2 (1- (m%%))))
+                    (= i (1- (expt 2 (m%%)))))
+                (check-upper-bound h i j k (rho%%) (m%%) (n%%))
+                (< h (lower i j (rho%%) (m%%) (n%%))))
+           (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+               (* (/ (1+ h) (expt 2 (rho%%)))
+                  (+ (delta0 j (n%%)) (* (1+ h) (expt 2 (- (* k (rho%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lower check-upper-bound)
+                  :use (converse-39
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint))))
+
+(local-defthm lemma-3-5-36
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0))
+           (>= (* x x y) 0))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-57))))
+
+(local-defthm lemma-3-5-37
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (integerp h)
+                (natp k)
+                (> (* k (rho%%)) (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ h (expt 2 (rho%%))) (delta0 j (n%%))))
+                                               (/ (* h h) (expt 2 (rho%%))))))
+                (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                    (* (/ h (expt 2 (rho%%)))
+                       (+ (delta0 j (n%%)) (* h (expt 2 (- (* k (rho%%)))))))))
+           (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+               (* (/ h (expt 2 (rho%%))) (delta0 j (n%%)))))
+           
+  :rule-classes ()
+  :hints (("Goal" :use (m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        (:instance converse-39 (m (m%%)) (n (n%%)) (rho (rho%%)))
+                        (:instance lemma-3-5-36 (x h) (y (/ (expt 2 (rho%%)))))
+                        (:instance lemma-3-5-34 (k (* k (rho%%)))
+                                                (x (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))))
+                                                (y (* (/ h (expt 2 (rho%%))) (delta0 j (n%%))))
+                                                (z (/ (* h h) (expt 2 (rho%%)))))))))
+
+(local-defthm lemma-3-5-38
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (integerp h)
+                (or (< i (expt 2 (1- (m%%))))
+                    (= i (1- (expt 2 (m%%)))))
+                (check-upper-bound h i j k (rho%%) (m%%) (n%%))
+                (< h (lower i j (rho%%) (m%%) (n%%)))
+                (natp k)
+                (> (* k (rho%%)) (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+                                               (/ (* (1+ h) (1+ h)) (expt 2 (rho%%)))))))
+           (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+               (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))))
+           
+  :rule-classes ()
+  :hints (("Goal" :use (m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        lemma-3-5-35
+                        (:instance lemma-3-5-37 (h (1+ h)))))))
+
+(local-defthm lemma-3-5-39
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (or (< i (expt 2 (1- (m%%))))
+                      (= i (1- (expt 2 (m%%)))))
+                  (natp k)
+                  (> (* k (rho%%)) (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+                                                 (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+                  (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3)))))))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (< h (lower i j (rho%%) (m%%) (n%%)))
+                  (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                      (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))))))
+                            
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-33
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint
+                        (:instance lemma-3-5-38 (i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+                                                (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+                                                (h (lookup (i-witness (rho%%) (m%%) (n%%) (table%%))
+                                                           (j-witness (rho%%) (m%%) (n%%) (table%%))
+                                                           (table%%))))))))
+
+(local-defthm lemma-3-5-40
+  (implies (natp k)
+           (<= k (* k (rho%%))))
+  :rule-classes ()
+  :hints (("Goal" :use rho%%-constraint)))
+
+(local-defthm lemma-3-5-41
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (or (< i (expt 2 (1- (m%%))))
+                      (= i (1- (expt 2 (m%%)))))
+                  (natp k)
+                  (> k (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+                                                 (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+                  (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3)))))))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (< h (lower i j (rho%%) (m%%) (n%%)))
+                  (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                      (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-39
+                        lemma-3-5-40
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint))))
+
+(local-defund foo (k i j h)
+  (and (natp k)
+       (> k (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+                          (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+       (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3))))))))))
+
+(local-defthm lemma-3-5-42
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (or (< i (expt 2 (1- (m%%))))
+                      (= i (1- (expt 2 (m%%)))))
+                  (foo k i j h))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (< h (lower i j (rho%%) (m%%) (n%%)))
+                  (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                      (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :expand ((:free (k i j h) (foo k i j h)))
+                  :in-theory (theory 'minimal-theory)
+                  :use (lemma-3-5-41))))
+
+(local-defthm lemma-3-5-43
+  (let ((k (1+ (max (max (k%%) 
+                         (k-witness (+ (pi0 i (m%%)) 
+                                       (delta0 j (n%%)) 
+                                       (/ (expt 2 (n%%))) 
+                                       (/ (expt 2 (- (m%%) 3))))))
+                    (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                                     (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+                                  (/ (* (1+ h) (1+ h)) (expt 2 (rho%%)))))))))
+    (and (natp k)
+         (> k (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+            (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+         (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint))))
+
+(local-defund bar (i j h)
+  (1+ (max (max (k%%) 
+                (k-witness (+ (pi0 i (m%%)) 
+                              (delta0 j (n%%)) 
+                              (/ (expt 2 (n%%))) 
+                              (/ (expt 2 (- (m%%) 3))))))
+           (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                            (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+                         (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))))
+
+(local-defthm lemma-3-5-44
+  (foo (bar i j h) i j h)
+  :hints (("Goal" :expand ((:free (k i j h) (foo k i j h)) (:free (i j h) (bar i j h)))
+                  :in-theory (theory 'minimal-theory)
+                  :use (lemma-3-5-43))))
+
+(local-defthm lemma-3-5-45
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (or (< i (expt 2 (1- (m%%))))
+                      (= i (1- (expt 2 (m%%))))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (< h (lower i j (rho%%) (m%%) (n%%)))
+                  (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                      (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lemma-3-5-42 
+                                   (k (bar (i-witness (rho%%) (m%%) (n%%) (table%%)) 
+                                           (j-witness (rho%%) (m%%) (n%%) (table%%)) 
+                                           (lookup (i-witness (rho%%) (m%%) (n%%) (table%%))
+                                                   (j-witness (rho%%) (m%%) (n%%) (table%%))
+                                                   (table%%)))))))))
+
+(local-defthm lemma-3-5-46
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m))))
+                (< h (lower i j rho m n)))
+           (< (1+ h) (/ (* (expt 2 rho) (+ (pi0 i m) (expt 2 (- 3 m)))) (delta0 j n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lower)
+                  :use (converse-39
+                        (:instance cg-def (x (/ (* (expt 2 rho) (+ (pi0 i m) (expt 2 (- 3 m)))) (delta0 j n))))))))
+
+(local-defthm lemma-3-5-47
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (or (< i (expt 2 (1- m)))
+                    (= i (1- (expt 2 m))))
+                (< h (lower i j rho m n)))
+           (< (* (/ (1+ h) (expt 2 rho)) (delta0 j n))
+              (+ (pi0 i m) (expt 2 (- 3 m)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-5-46
+                        (:instance *-strongly-monotonic (x (* (/ (expt 2 rho)) (delta0 j n)))
+                                                        (y (1+ h))
+                                                        (y+ (/ (* (expt 2 rho) (+ (pi0 i m) (expt 2 (- 3 m)))) (delta0 j n))))))))
+
+(local-defthm lemma-3-5-48
+  (let ((i (i-witness (rho%%) (m%%) (n%%) (table%%))))
+    (implies (or (< i (expt 2 (1- (m%%))))
+                 (= i (1- (expt 2 (m%%)))))
+             (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-45
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        (:instance lemma-3-5-47 (m (m%%)) (n (n%%)) (rho (rho%%)) 
+                                                (h (lookup (i-witness (rho%%) (m%%) (n%%) (table%%))
+                                                           (j-witness (rho%%) (m%%) (n%%) (table%%))
+                                                           (table%%)))
+                                                (i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+                                                (j (j-witness (rho%%) (m%%) (n%%) (table%%))))))))
+
+
+(local-defthm lemma-3-5-49
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (>= i (expt 2 (1- (m%%))))
+                (not (= i (1- (expt 2 (m%%)))))
+                (check-upper-bound h i j k (rho%%) (m%%) (n%%))
+                (< h (lower i j (rho%%) (m%%) (n%%))))
+           (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+               (* (/ (1+ h) (expt 2 (rho%%)))
+                  (+ (delta0 j (n%%)) (expt 2 (- (n%%))) (* (1+ h) (expt 2 (- (* k (rho%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lower check-upper-bound)
+                  :use (converse-39
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint))))
+
+(local-defthm lemma-3-5-50
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (integerp h)
+                (natp k)
+                (> (* k (rho%%)) (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ h (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                                               (/ (* h h) (expt 2 (rho%%))))))
+                (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                    (* (/ h (expt 2 (rho%%)))
+                       (+ (delta0 j (n%%)) (expt 2 (- (n%%))) (* h (expt 2 (- (* k (rho%%)))))))))
+           (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+               (* (/ h (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%)))))))
+           
+  :rule-classes ()
+  :hints (("Goal" :use (m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        (:instance converse-39 (m (m%%)) (n (n%%)) (rho (rho%%)))
+                        (:instance lemma-3-5-36 (x h) (y (/ (expt 2 (rho%%)))))
+                        (:instance lemma-3-5-34 (k (* k (rho%%)))
+                                                (x (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))))
+                                                (y (* (/ h (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                                                (z (/ (* h h) (expt 2 (rho%%)))))))))
+
+(local-defthm lemma-3-5-51
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (integerp h)
+                (>= i (expt 2 (1- (m%%))))
+                (not (= i (1- (expt 2 (m%%)))))
+                (check-upper-bound h i j k (rho%%) (m%%) (n%%))
+                (< h (lower i j (rho%%) (m%%) (n%%)))
+                (natp k)
+                (> (* k (rho%%)) (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                                               (/ (* (1+ h) (1+ h)) (expt 2 (rho%%)))))))
+           (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+               (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%)))))))
+           
+  :rule-classes ()
+  :hints (("Goal" :use (m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        lemma-3-5-49
+                        (:instance lemma-3-5-50 (h (1+ h)))))))
+
+(local-defthm lemma-3-5-52
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (>= i (expt 2 (1- (m%%))))
+                  (not (= i (1- (expt 2 (m%%)))))
+                  (natp k)
+                  (> (* k (rho%%)) (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                                                 (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+                  (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3)))))))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (< h (lower i j (rho%%) (m%%) (n%%)))
+                  (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                      (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%)))))))))
+                            
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-33
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint
+                        (:instance lemma-3-5-51 (i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+                                                (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+                                                (h (lookup (i-witness (rho%%) (m%%) (n%%) (table%%))
+                                                           (j-witness (rho%%) (m%%) (n%%) (table%%))
+                                                           (table%%))))))))
+
+(local-defthm lemma-3-5-53
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (>= i (expt 2 (1- (m%%))))
+                  (not (= i (1- (expt 2 (m%%)))))
+                  (natp k)
+                  (> k (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                                                 (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+                  (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3)))))))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (< h (lower i j (rho%%) (m%%) (n%%)))
+                  (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                      (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-52
+                        lemma-3-5-40
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint))))
+
+(local-defund foo1 (k i j h)
+  (and (natp k)
+       (> k (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                          (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+       (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3))))))))))
+
+(local-defthm lemma-3-5-54
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (>= i (expt 2 (1- (m%%))))
+                  (not (= i (1- (expt 2 (m%%)))))
+                  (foo1 k i j h))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (< h (lower i j (rho%%) (m%%) (n%%)))
+                  (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                      (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :expand ((:free (k i j h) (foo1 k i j h)))
+                  :in-theory (theory 'minimal-theory)
+                  :use (lemma-3-5-53))))
+
+(local-defthm lemma-3-5-55
+  (let ((k (1+ (max (max (k%%) 
+                         (k-witness (+ (pi0 i (m%%)) 
+                                       (delta0 j (n%%))
+                                       (/ (expt 2 (n%%))) 
+                                       (/ (expt 2 (- (m%%) 3))))))
+                    (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                                     (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                                  (/ (* (1+ h) (1+ h)) (expt 2 (rho%%)))))))))
+    (and (natp k)
+         (> k (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+            (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+         (> k (max (k%%) (k-witness (+ (pi0 i (m%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))) (/ (expt 2 (- (m%%) 3))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        k%%-constraint))))
+
+(local-defund bar1 (i j h)
+  (1+ (max (max (k%%) 
+                (k-witness (+ (pi0 i (m%%)) 
+                              (delta0 j (n%%))
+                              (/ (expt 2 (n%%))) 
+                              (/ (expt 2 (- (m%%) 3))))))
+           (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                            (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                         (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))))
+
+(local-defthm lemma-3-5-56
+  (foo1 (bar1 i j h) i j h)
+  :hints (("Goal" :expand ((:free (k i j h) (foo1 k i j h)) (:free (i j h) (bar1 i j h)))
+                  :in-theory (theory 'minimal-theory)
+                  :use (lemma-3-5-55))))
+
+(local-defthm lemma-3-5-57
+  (let* ((i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+         (j (j-witness (rho%%) (m%%) (n%%) (table%%)))
+         (h (lookup i j (table%%))))
+    (implies (and (not (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%)))
+                  (>= i (expt 2 (1- (m%%))))
+                  (not (= i (1- (expt 2 (m%%))))))
+             (and (natp i)
+                  (< i (expt 2 (m%%)))
+                  (natp j)
+                  (< j (expt 2 (n%%)))
+                  (< (- (expt 2 (rho%%))) h)
+                  (> (expt 2 (rho%%)) h)
+                  (< h (lower i j (rho%%) (m%%) (n%%)))
+                  (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                      (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lemma-3-5-54
+                                   (k (bar1 (i-witness (rho%%) (m%%) (n%%) (table%%)) 
+                                           (j-witness (rho%%) (m%%) (n%%) (table%%)) 
+                                           (lookup (i-witness (rho%%) (m%%) (n%%) (table%%))
+                                                   (j-witness (rho%%) (m%%) (n%%) (table%%))
+                                                   (table%%)))))))))
+
+(local-defthm lemma-3-5-58
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (>= i (expt 2 (1- m)))
+                (not (= i (1- (expt 2 m))))
+                (< h (lower i j rho m n)))
+           (< (1+ h) (/ (* (expt 2 rho) (+ (pi0 i m) (expt 2 (- 3 m)))) (+ (delta0 j n) (expt 2 (- n))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lower)
+                  :use (converse-39
+                        (:instance cg-def (x (/ (* (expt 2 rho) (+ (pi0 i m) (expt 2 (- 3 m)))) (+ (delta0 j n) (expt 2 (- n))))))))))
+
+(local-defthm lemma-3-5-59
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (integerp h)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (>= i (expt 2 (1- m)))
+                (not (= i (1- (expt 2 m))))
+                (< h (lower i j rho m n)))
+           (< (* (/ (1+ h) (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n))))
+              (+ (pi0 i m) (expt 2 (- 3 m)))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-5-58
+                        (:instance *-strongly-monotonic (x (* (/ (expt 2 rho)) (+ (delta0 j n) (expt 2 (- n)))))
+                                                        (y (1+ h))
+                                                        (y+ (/ (* (expt 2 rho) (+ (pi0 i m) (expt 2 (- 3 m)))) 
+                                                               (+ (delta0 j n) (expt 2 (- n))))))))))
+
+(defthm lemma-3-5
+  (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5-48
+                        lemma-3-5-57
+                        m%%-constraint
+                        n%%-constraint
+                        rho%%-constraint
+                        (:instance lemma-3-5-59 (m (m%%)) (n (n%%)) (rho (rho%%)) 
+                                                (h (lookup (i-witness (rho%%) (m%%) (n%%) (table%%))
+                                                           (j-witness (rho%%) (m%%) (n%%) (table%%))
+                                                           (table%%)))
+                                                (i (i-witness (rho%%) (m%%) (n%%) (table%%)))
+                                                (j (j-witness (rho%%) (m%%) (n%%) (table%%))))))))
+
+;;**********************************************************************************
+
+(encapsulate (((xtable%%) => *))
+
+(local (defund xtable-entry (i j)
+  (if (and (> (pi0 i (m%%))
+              (- (+ (delta0 j (n%%)) 
+                    (expt 2 (- (n%%))) 
+                    (expt 2 (- 3 (m%%))))))
+           (<= (pi0 i (m%%))
+               (- (expt 2 (- (* (k%%) (rho%%))))
+                  (+ (delta0 j (n%%))
+                     (expt 2 (- (n%%))) 
+                     (expt 2 (- 3 (m%%)))))))
+      (- 1 (expt 2 (rho%%)))
+    (lookup i j (table%%)))))
+
+(local (defun xtable-row (i j)
+  (declare (xargs :measure (nfix (- (expt 2 (n%%)) j))))
+  (if (and (natp j)
+           (< j (expt 2 (n%%))))
+      (cons (xtable-entry i j)
+            (xtable-row i (1+ j)))
+    ())))
+
+(local (defun xtable-rows (i)
+  (declare (xargs :measure (nfix (- (expt 2 (m%%)) i))))
+  (if (and (natp i)
+           (< i (expt 2 (m%%))))
+      (cons (xtable-row i 0)
+            (xtable-rows (1+ i)))
+    ())))
+
+(local (defund xtable%% ()
+  (xtable-rows 0)))
+
+(local (defun xtable-induct (j k)
+  (if (zp j)
+      k
+    (xtable-induct (1- j) (1+ k)))))
+
+(local (defthmd xtable-1
+  (implies (and (natp j)
+                (natp k)
+                (< (+ j k) (expt 2 (n%%))))
+           (equal (nth j (xtable-row i k))
+                  (xtable-entry i (+ j k))))
+  :hints (("Goal" :induct (xtable-induct j k))
+          ("Subgoal *1/2" :expand ((xtable-row i k)))
+          ("Subgoal *1/1" :expand ((xtable-row i k))))))
+
+(local (defthmd xtable-2
+  (implies (and (natp i)
+                (natp k)
+                (< (+ i k) (expt 2 (m%%))))
+           (equal (nth i (xtable-rows k))
+                  (xtable-row (+ i k) 0)))
+  :hints (("Goal" :induct (xtable-induct i k))
+          ("Subgoal *1/1" :expand ((xtable-rows k))))))
+
+(local (defthmd xtable-3
+  (implies (and (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (nth j (xtable-row i 0))
+                  (xtable-entry i j)))
+  :hints (("Goal" :use (:instance xtable-1 (k 0))))))
+
+(local (defthmd xtable-4
+  (implies (and (natp i)
+                (< i (expt 2 (m%%))))
+           (equal (nth i (xtable-rows 0))
+                  (xtable-row i 0)))
+  :hints (("Goal" :use (:instance xtable-2 (k 0))))))
+
+(local (defthm xtable-5
+  (integerp (xtable-entry i j))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable xtable-entry)))))
+
+(local (defthmd xtable-6
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (lookup i j (xtable%%))
+                  (xtable-entry i j)))
+  :hints (("Goal" :in-theory (enable lookup xtable%%)
+                  :use (xtable-4 xtable-3)))))
+
+(defthmd xtable-def
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (lookup i j (xtable%%))
+                  (if (and (> (pi0 i (m%%))
+                           (- (+ (delta0 j (n%%)) 
+                                 (expt 2 (- (n%%))) 
+                                 (expt 2 (- 3 (m%%))))))
+                           (<= (pi0 i (m%%))
+                               (- (expt 2 (- (* (k%%) (rho%%))))
+                                  (+ (delta0 j (n%%))
+                                     (expt 2 (- (n%%))) 
+                                     (expt 2 (- 3 (m%%)))))))
+                      (- 1 (expt 2 (rho%%)))
+                    (lookup i j (table%%)))))
+  :hints (("Goal" :in-theory (enable xtable-entry)
+                  :use (xtable-6))))
+
+)
+
+(local-defund i-srt-aux (i k rho m n table)
+  (if (zp i)
+      ()
+    (if (check-row (1- i) (expt 2 n) k rho m n (nth (1- i) table))
+        (i-srt-aux (1- i) k rho m n table)
+      (1- i))))
+
+(local-defund i-srt (k rho m n table)
+  (i-srt-aux (expt 2 m) k rho m n table))
+
+(local-defund j-srt-aux (i j k rho m n row)
+  (if (zp j)
+      ()
+    (if (check-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+        (j-srt-aux i (1- j) k rho m n row)
+      (1- j))))
+
+(local-defund j-srt (k rho m n table)
+  (let ((i (i-srt k rho m n table)))
+    (j-srt-aux i (expt 2 n) k rho m n (nth i table))))
+
+(local-defthm xtable-7
+  (implies (and (natp i)
+                (not (check-rows i k rho m n table)))
+           (let ((w (i-srt-aux i k rho m n table)))
+             (and (natp w)
+                  (< w i)
+                  (not (check-row w (expt 2 n) k rho m n (nth w table))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable i-srt-aux check-rows))))
+
+(local-defthm xtable-8
+  (implies (and (natp m)
+                (not (admissible-srt-table-p k rho m n table)))
+           (let ((i (i-srt k rho m n table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (not (check-row i (expt 2 n) k rho m n (nth i table))))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance xtable-7 (i (expt 2 m)))
+                  :in-theory (enable i-srt admissible-srt-table-p))))
+
+(local-defthm xtable-9
+  (implies (and (natp j)
+                (not (check-row i j k rho m n row)))
+           (let ((w (j-srt-aux i j k rho m n row)))
+             (and (natp w)
+                  (< w j)
+                  (not (check-entry i w k rho m n (ifix (nth w row)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable j-srt-aux check-row))))
+
+(local-defthm xtable-10
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (not (admissible-srt-table-p k rho m n table)))
+           (let* ((i (i-srt k rho m n table))
+                  (j (j-srt k rho m n table))
+                  (h (lookup i j table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (not (check-entry i j k rho m n h)))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-8
+                        (:instance xtable-9 (i (i-srt k rho m n table)) 
+                                            (j (expt 2 n)) 
+                                            (row (nth (i-srt k rho m n table) table))))
+                  :in-theory (enable lookup j-srt))))
+
+(local-defthm xtable-11
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (not (admissible-srt-table-p k rho m n table)))
+           (let* ((i (i-srt k rho m n table))
+                  (j (j-srt k rho m n table))
+                  (h (lookup i j table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (accessible-p i j k rho m n)
+                  (not (and (integerp h)
+                            (< (- (expt 2 rho)) h)
+                            (< h (expt 2 rho))
+                            (>= h (lower i j rho m n))
+                            (check-lower-bound h i j (1+ k) rho m n))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-10)
+                  :in-theory (enable check-entry))))
+
+(local-defthm xtable-12
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (= h (lookup i j (xtable%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (= h (- 1 (expt 2 (rho%%)))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-def)
+                  :in-theory (enable accessible-p))))
+
+(local-defthm xtable-13
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (<= (pi0 i (m%%)) (- (expt 2 (- 3 (m%%))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k%%-constraint rho%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))))))
+
+(local-defthm xtable-14
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (not (or (< i (expt 2 (1- (m%%))))
+                   (= i (1- (expt 2 (m%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-13 m%%-constraint)
+                  :in-theory (enable pi0))))
+
+(local-defthm xtable-15
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (< (lower i j (rho%%) (m%%) (n%%))
+             (* (expt 2 (rho%%)) 
+                (/ (+ (pi0 i (m%%)) (/ (expt 2 (- (m%%) 3))))
+                   (+ (delta0 j (n%%)) (/ (expt 2 (n%%))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-14 rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))
+                        (:instance cg-def (x (* (expt 2 (rho%%)) 
+                                                (/ (+ (pi0 i (m%%)) (/ (expt 2 (- (m%%) 3))))
+                                                   (+ (delta0 j (n%%)) (/ (expt 2 (n%%)))))))))
+                  :in-theory (enable lower))))
+
+(local-defthm xtable-16
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (<= (* (expt 2 (rho%%)) 
+                 (/ (+ (pi0 i (m%%)) (/ (expt 2 (- (m%%) 3))))
+                    (+ (delta0 j (n%%)) (/ (expt 2 (n%%))))))
+              (* (expt 2 (rho%%)) 
+                 (/ (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))))
+                    (+ (delta0 j (n%%)) (/ (expt 2 (n%%))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))
+                        (:instance *-weakly-monotonic (x (/ (expt 2 (rho%%)) (+ (delta0 j (n%%)) (/ (expt 2 (n%%))))))
+                                                      (y (+ (pi0 i (m%%)) (/ (expt 2 (- (m%%) 3)))))
+                                                      (y+ (- (expt 2 (- (* (k%%) (rho%%))))
+                                                             (+ (delta0 j (n%%))
+                                                                (expt 2 (- (n%%)))))))))))
+
+(local-defthm xtable-17
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (< (lower i j (rho%%) (m%%) (n%%))
+             (* (expt 2 (rho%%)) 
+                (/ (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))))
+                   (+ (delta0 j (n%%)) (/ (expt 2 (n%%))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (xtable-15 xtable-16 rho%%-constraint m%%-constraint n%%-constraint))))
+
+(local-defthm xtable-18
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+          (= (* (expt 2 (rho%%)) 
+                (/ (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))))
+                   (+ (delta0 j (n%%)) (/ (expt 2 (n%%))))))
+             (- (/ (expt 2 (* (- 1 (k%%)) (rho%%)))
+                   (+ (delta0 j (n%%)) (/ (expt 2 (n%%)))))
+                (expt 2 (rho%%)))))
+  :rule-classes ()
+  :hints (("Goal" :use (k%%-constraint rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))))))
+
+(local-defthm xtable-19
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+          (< (expt 2 (* (- 1 (k%%)) (rho%%)))
+             (+ (delta0 j (n%%)) (/ (expt 2 (n%%))))))
+  :rule-classes ()
+  :hints (("Goal" :use (k%%-constraint rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))))))
+
+(local-defthm xtable-20
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+          (< (/ (expt 2 (* (- 1 (k%%)) (rho%%)))
+                (+ (delta0 j (n%%)) (/ (expt 2 (n%%)))))
+             1))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-19 k%%-constraint rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))))))
+
+(local-defthm xtable-21
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (< (lower i j (rho%%) (m%%) (n%%))
+             (- (/ (expt 2 (* (- 1 (k%%)) (rho%%)))
+                   (+ (delta0 j (n%%)) (/ (expt 2 (n%%)))))
+                (expt 2 (rho%%)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (xtable-17 xtable-18 rho%%-constraint m%%-constraint n%%-constraint))))
+
+(local-defthm xtable-22
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (< (- (/ (expt 2 (* (- 1 (k%%)) (rho%%)))
+                   (+ (delta0 j (n%%)) (/ (expt 2 (n%%)))))
+                (expt 2 (rho%%)))
+             (- 1 (expt 2 (rho%%)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (xtable-20))))
+
+(local-defthm xtable-23
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (<= (pi0 i (m%%))
+                    (- (expt 2 (- (* (k%%) (rho%%))))
+                       (+ (delta0 j (n%%))
+                          (expt 2 (- (n%%)))
+                          (expt 2 (- 3 (m%%)))))))
+          (< (lower i j (rho%%) (m%%) (n%%))
+             (- 1 (expt 2 (rho%%)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (xtable-21 xtable-22 rho%%-constraint m%%-constraint n%%-constraint))))
+
+(local-defthm xtable-24
+  (let* ((i (i-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%)))
+         (j (j-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))))
+    (implies (<= (pi0 i (m%%))
+                 (- (expt 2 (- (* (k%%) (rho%%))))
+                    (+ (delta0 j (n%%))
+                       (expt 2 (- (n%%)))
+                       (expt 2 (- 3 (m%%))))))
+             (admissible-srt-table-p (k%%) (rho%%) (m%%) (n%%) (xtable%%))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint m%%-constraint n%%-constraint k%%-constraint
+                        (:instance xtable-12 (i (i-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))) 
+                                             (j (j-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%)))
+                                             (h (lookup (i-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))
+                                                        (j-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))
+                                                        (xtable%%))))
+                        (:instance xtable-23 (i (i-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))) 
+                                             (j (j-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))))
+                        (:instance xtable-11 (k (k%%)) (rho (rho%%)) (m (m%%)) (n (n%%)) (table (xtable%%))))
+                  :in-theory (enable check-lower-bound))))
+
+(local-defthm xtable-25
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (equal (lookup i j (xtable%%))
+                 (lookup i j (table%%))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable xtable-def))))
+
+(local-defthm xtable-26
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (check-sqrt-entry i j (1+ (k%%)) (rho%%) (m%%) (n%%) (lookup i j (xtable%%))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-25 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint
+                        (:instance check-sqrt-table-lemma (m (m%%)) (n (n%%)) (rho (rho%%)) (k (1+ (k%%))) (table (table%%)))))))
+
+(local-defthm xtable-27
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (and (< (- (expt 2(rho%%))) h)
+                 (< h (expt 2 (rho%%)))
+                 (check-upper-bound h i j (1+ (k%%)) (rho%%) (m%%) (n%%))
+                 (check-lower-bound h i j (1+ (k%%)) (rho%%) (m%%) (n%%)))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-26 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint)
+                  :in-theory (enable check-sqrt-entry sqrt-accessible-p accessible-p))))
+
+(local-defthm xtable-28
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (= h (1- (expt 2 (rho%%))))
+                     (check-entry i j (k%%) (rho%%) (m%%) (n%%) (lookup i j (xtable%%))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-27 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint)
+                  :in-theory (enable check-entry lower))))
+
+(local-defthm xtable-29
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (>= (pi0 i (m%%)) (delta0 j (n%%))))
+           (< i (expt 2 (1- (m%%)))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance *-strongly-monotonic (x (expt 2 (- 2 (m%%)))) (y i) (y+ (expt 2 (m%%))))
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%))))
+                  :in-theory (enable pi0))))
+
+(local-defthm xtable-30
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (>= (pi0 i (m%%)) (delta0 j (n%%)))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                         (+ (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))
+                            (* (1+ h) (1+ h) (expt 2 (- (* (+ 2 (k%%)) (rho%%))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-27 xtable-29 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint)
+                  :in-theory (enable check-upper-bound))))
+
+(local-defthm xtable-31
+  (implies (and (integerp h)
+                (rationalp x)
+                (>= x 0)
+                (<= (abs h) (expt 2 (rho%%))))
+            (<= (* h h x)
+               (* (expt 2 (* 2 (rho%%))) x)))
+  :rule-classes ()
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint k%%-constraint
+                        (:instance converse-66 (x h) (y (expt 2 (rho%%))))
+                        (:instance *-weakly-monotonic (y (* h h))
+                                                      (y+ (expt 2 (rho%%))))))))
+
+(local-defthm xtable-32
+  (implies (and (integerp h)
+                (<= (abs h) (expt 2 (rho%%))))
+            (<= (* h h (expt 2 (- (* (+ 2 (k%%)) (rho%%)))))
+               (expt 2 (- (* (k%%) (rho%%))))))
+  :rule-classes ()
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint k%%-constraint
+                        (:instance xtable-31 (x (expt 2 (- (* (+ 2 (k%%)) (rho%%))))))))))
+
+(local-defthm xtable-33
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (<= (* (1+ h) (1+ h) (expt 2 (- (* (+ 2 (k%%)) (rho%%)))))
+                (expt 2 (- (* (k%%) (rho%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-27 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint
+                        (:instance xtable-32 (h (1+ (lookup i j (xtable%%)))))))))
+
+(local-defthm xtable-34
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (<= (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))
+                         (* (- 1 (expt 2 (- (rho%%)))) (delta0 j (n%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))
+                        (:instance *-weakly-monotonic (x (/ (delta0 j (n%%)) (expt 2 (rho%%))))
+                                                      (y (1+ (lookup i j (xtable%%))))
+                                                      (y+ (1- (expt 2 (rho%%)))))))))
+
+(local-defthm xtable-35
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (>= (pi0 i (m%%)) (delta0 j (n%%)))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                         (+ (expt 2 (- (* (k%%) (rho%%))))
+                            (* (- 1 (expt 2 (- (rho%%)))) (delta0 j (n%%))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-30 xtable-33 xtable-34 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint)
+                  :in-theory (theory 'minimal-theory))))
+
+(local-defthm xtable-36
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (>= (pi0 i (m%%)) (delta0 j (n%%)))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                         (+ (delta0 j (n%%))
+                            (* (expt 2 (- (rho%%)))
+                               (- (expt 2 (* (- 1 (k%%)) (rho%%)))
+                                  (delta0 j (n%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-35 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint))))
+
+(local-defthm xtable-37
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+           (<= (expt 2 (* (- 1 (k%%)) (rho%%)))
+               (delta0 j (n%%))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint m%%-constraint n%%-constraint k%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))))))
+
+(local-defthm xtable-38
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+           (<= (* (expt 2 (- (rho%%)))
+                  (- (expt 2 (* (- 1 (k%%)) (rho%%)))
+                     (delta0 j (n%%))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-37 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint
+                        (:instance *-weakly-monotonic (x (expt 2 (- (rho%%))))
+                                                       (y (- (expt 2 (* (- 1 (k%%)) (rho%%))) (delta0 j (n%%))))
+                                                       (y+ 0))
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))))))
+
+(local-defthm xtable-39
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (>= (pi0 i (m%%)) (delta0 j (n%%)))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                         (delta0 j (n%%))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (xtable-36 xtable-38 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint))))
+
+(local-defthm xtable-40
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (< (pi0 i (m%%)) (delta0 j (n%%))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-39 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint))))
+
+(local-defthm xtable-41
+  (implies (and (integerp k)
+                (> k (k%%)))
+           (<= (expt 2 (* (- 1 k) (rho%%)))
+               (expt 2 (- (* (k%%) (rho%%))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-40 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint)
+                  :in-theory (enable accessible-p sqrt-accessible-p))))
+
+(local-defthm xtable-42
+  (implies (and (rationalp x1)
+                (rationalp x1)
+                (rationalp y)
+                (rationalp z)
+                (<= x1 x2)
+                (< (+ x2 y) z))
+           (< (+ x2 y) z))
+  :rule-classes ())
+
+(local-defthm xtable-43
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (integerp k)
+                (> k (k%%))
+                (< (+ (EXPT 2 (- (* (K%%) (RHO%%))))
+                      (- (+ (DELTA0 J (N%%))
+                            (EXPT 2 (- (N%%)))
+                            (EXPT 2 (+ 3 (- (M%%)))))))
+                   (PI0 I (M%%))))
+           (< (+ (EXPT 2 (* (+ 1 (- K)) (RHO%%)))
+                 (- (+ (DELTA0 J (N%%))
+                       (/ (EXPT 2 (N%%)))
+                       (/ (EXPT 2 (+ -3 (M%%)))))))
+              (PI0 I (M%%))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :use (xtable-41 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint
+                        (:instance xtable-42 (x1 (EXPT 2 (* (+ 1 (- K)) (RHO%%))))
+                                             (x2 (EXPT 2 (- (* (K%%) (RHO%%)))))
+                                             (y (- (+ (DELTA0 J (N%%))
+                                                      (EXPT 2 (- (N%%)))
+                                                      (EXPT 2 (+ 3 (- (M%%)))))))
+                                             (z (PI0 I (M%%))))
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))))
+          ("Subgoal 4" :in-theory (enable natp zp))
+          ("Subgoal 3" :in-theory (enable natp zp))
+          ("Subgoal 2" :in-theory (enable natp zp))
+          ("Subgoal 1" :in-theory (enable natp zp))))
+
+(local-defthm xtable-44
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (integerp k)
+                (> k (k%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (sqrt-accessible-p i j k (rho%%) (m%%) (n%%)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable accessible-p sqrt-accessible-p)
+                  :use (xtable-40 xtable-43 rho%%-constraint m%%-constraint n%%-constraint k%%-constraint
+                        (:instance converse-39 (rho (rho%%)) (m (m%%)) (n (n%%)))))))
+
+(local-defthm xtable-45
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (integerp k)
+                (> k (k%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (check-upper-bound h i j k (rho%%) (m%%) (n%%)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-sqrt-entry)
+                  :use (xtable-44
+                        xtable-25
+                        (:instance check-sqrt-table-lemma (rho (rho%%)) (m (m%%)) (n (n%%)) (table (table%%)))))))
+
+(local-defthm xtable-46
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (integerp k)
+                (> k (k%%))
+                (or (< i (expt 2 (1- (m%%))))
+                    (= i (1- (expt 2 (m%%)))))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (and (< h (1- (expt 2 (rho%%))))
+                          (> (* k (rho%%)) 
+                             (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%)))) (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+                                           (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+                          (< h (lower i j (rho%%) (m%%) (n%%))))
+                     (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                         (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-upper-bound)
+                  :use (xtable-45
+                        (:instance lemma-3-5-38 (h (lookup i j (xtable%%))))))))
+
+(local-defun kwit (i j)
+  (let ((h (lookup i j (xtable%%))))
+    (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                     (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%))))
+                  (/ (* (1+ h) (1+ h)) (expt 2 (rho%%)))))))
+
+(local-defund kmax (i j)
+  (1+ (max (k%%) (kwit i j))))
+
+(local-defthm xtable-47
+  (implies (and (natp a)
+                (natp b))
+           (let ((k (1+ (max a b))))
+             (and (integerp k)
+                  (> k a)
+                  (> (* k (rho%%)) b))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint
+                        (:instance *-weakly-monotonic (x (1+ (max a b))) (y 1) (y+ (rho%%)))))))
+
+(local-defthm xtable-48
+  (and (integerp (kmax i j))
+       (> (kmax i j) (k%%))
+       (> (* (kmax i j) (rho%%)) (kwit i j)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable kmax)
+                  :use ((:instance xtable-47 (a (k%%))
+                                             (b (kwit i j)))))))
+
+(local-defthm xtable-49
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (or (< i (expt 2 (1- (m%%))))
+                    (= i (1- (expt 2 (m%%)))))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (and (< h (1- (expt 2 (rho%%))))
+                          (< h (lower i j (rho%%) (m%%) (n%%))))
+                     (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                         (* (/ (1+ h) (expt 2 (rho%%))) (delta0 j (n%%)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :expand ((kwit i j))
+                  :use (xtable-48
+                        (:instance xtable-46 (k (kmax i j)))))))
+
+(local-defthm xtable-50
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (or (< i (expt 2 (1- (m%%))))
+                    (= i (1- (expt 2 (m%%)))))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (>= h (lower i j (rho%%) (m%%) (n%%))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-49 rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance lemma-3-5-47 (h (lookup i j (xtable%%))) (m (m%%)) (n (n%%)) (rho (rho%%)))))))
+
+(local-defthm xtable-51
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (integerp k)
+                (> k (k%%))
+                (>= i (expt 2 (1- (m%%))))
+                (not (= i (1- (expt 2 (m%%)))))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (and (< h (1- (expt 2 (rho%%))))
+                          (> (* k (rho%%)) 
+                             (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                                              (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                                           (/ (* (1+ h) (1+ h)) (expt 2 (rho%%))))))
+                          (< h (lower i j (rho%%) (m%%) (n%%))))
+                     (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                         (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable check-upper-bound)
+                  :use (xtable-45
+                        (:instance lemma-3-5-51 (h (lookup i j (xtable%%))))))))
+
+(local-defun kwit2 (i j)
+  (let ((h (lookup i j (xtable%%))))
+    (k-witness (/ (- (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                     (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%))))))
+                  (/ (* (1+ h) (1+ h)) (expt 2 (rho%%)))))))
+
+(local-defund kmax2 (i j)
+  (1+ (max (k%%) (kwit2 i j))))
+
+(local-defthm xtable-52
+  (and (integerp (kmax2 i j))
+       (> (kmax2 i j) (k%%))
+       (> (* (kmax2 i j) (rho%%)) (kwit2 i j)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable kmax2)
+                  :use ((:instance xtable-47 (a (k%%))
+                                             (b (kwit2 i j)))))))
+
+(local-defthm xtable-53
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (>= i (expt 2 (1- (m%%))))
+                (not (= i (1- (expt 2 (m%%)))))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (and (< h (1- (expt 2 (rho%%))))
+                          (< h (lower i j (rho%%) (m%%) (n%%))))
+                     (<= (+ (pi0 i (m%%)) (expt 2 (- 3 (m%%))))
+                         (* (/ (1+ h) (expt 2 (rho%%))) (+ (delta0 j (n%%)) (expt 2 (- (n%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (theory 'minimal-theory)
+                  :expand ((kwit2 i j))
+                  :use (xtable-52
+                        (:instance xtable-51 (k (kmax2 i j)))))))
+
+(local-defthm xtable-54
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (>= i (expt 2 (1- (m%%))))
+                (not (= i (1- (expt 2 (m%%)))))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (>= h (lower i j (rho%%) (m%%) (n%%))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-53 rho%%-constraint m%%-constraint n%%-constraint
+                        (:instance lemma-3-5-59 (h (lookup i j (xtable%%))) (m (m%%)) (n (n%%)) (rho (rho%%)))))))
+
+(local-defthm xtable-55
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (let ((h (lookup i j (xtable%%))))
+            (implies (< h (1- (expt 2 (rho%%))))
+                     (>= h (lower i j (rho%%) (m%%) (n%%))))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-54 xtable-50))))
+
+(local-defthm xtable-56
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%)))
+                (accessible-p i j (k%%) (rho%%) (m%%) (n%%))
+                (> (pi0 i (m%%))
+                   (- (expt 2 (- (* (k%%) (rho%%))))
+                      (+ (delta0 j (n%%))
+                         (expt 2 (- (n%%)))
+                         (expt 2 (- 3 (m%%)))))))
+          (>= (lookup i j (xtable%%))
+              (lower i j (rho%%) (m%%) (n%%))))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-55)
+                  :in-theory (enable lower))))
+
+(local-defthm xtable-57
+  (let* ((i (i-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%)))
+         (j (j-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))))
+    (implies (> (pi0 i (m%%))
+                (- (expt 2 (- (* (k%%) (rho%%))))
+                   (+ (delta0 j (n%%))
+                      (expt 2 (- (n%%)))
+                      (expt 2 (- 3 (m%%))))))
+             (admissible-srt-table-p (k%%) (rho%%) (m%%) (n%%) (xtable%%))))
+  :rule-classes ()
+  :hints (("Goal" :use (rho%%-constraint m%%-constraint n%%-constraint k%%-constraint
+                        (:instance xtable-56 (i (i-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))) 
+                                             (j (j-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))))
+                        (:instance xtable-23 (i (i-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))) 
+                                             (j (j-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))))
+                        (:instance xtable-27 (i (i-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))) 
+                                             (j (j-srt (k%%) (rho%%) (m%%) (n%%) (xtable%%))))
+                        (:instance xtable-11 (k (k%%)) (rho (rho%%)) (m (m%%)) (n (n%%)) (table (xtable%%))))
+                  :in-theory (enable check-lower-bound))))
+
+(defthm lemma-3-6-b
+  (admissible-srt-table-p (k%%) (rho%%) (m%%) (n%%) (xtable%%))
+  :rule-classes ()
+  :hints (("Goal" :use (xtable-24 xtable-57))))
+
+;;**********************************************************************************
+
+(defund check-exists-entry (i j k rho m n)
+  (or (not (accessible-p i j k rho m n))
+      (<= (lower i j rho m n) (- 1 (expt 2 rho)))
+      (check-lower-bound (lower i j rho m n) i j (1+ k) rho m n)))
+
+(defund check-exists-row (i j k rho m n)
+  (if (zp j)
+      t
+    (and (check-exists-entry i (1- j) k rho m n)
+         (check-exists-row i (1- j) k rho m n))))
+
+(defund check-exists-rows (i k rho m n)
+  (if (zp i)
+      t
+    (and (check-exists-row (1- i) (expt 2 n) k rho m n)
+         (check-exists-rows (1- i) k rho m n))))
+
+(defund exists-srt-table-p (k rho m n)
+  (check-exists-rows (expt 2 m) k rho m n))
+
+(defthm exists-srt-table-p-2-2-6-2
+  (exists-srt-table-p 2 2 6 2))
+
+(defthm exists-srt-table-p-2-3-7-4
+  (exists-srt-table-p 2 3 7 4))
+
+(defthm exists-srt-table-p-2-3-8-3
+  (exists-srt-table-p 2 3 8 3))
+
+(defthm not-exists-srt-table-p-100-2-5-2
+  (not (exists-srt-table-p 100 2 5 2)))
+
+(defthm not-exists-srt-table-p-100-3-6-4
+  (not (exists-srt-table-p 100 3 6 4)))
+
+(local-defthm lemma-3-7-1
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (and (integerp (lower i j rho m n))
+                (< (lower i j rho m n) (expt 2 rho))))
+  :hints (("Goal" :in-theory (enable lower)))
+  :rule-classes ())
+
+(local-defthm lemma-3-7-2
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (and (integerp (srt-entry i j rho m n))
+                (< (srt-entry i j rho m n) (expt 2 rho))
+                (> (srt-entry i j rho m n) (- (expt 2 rho)))))                
+  :hints (("Goal" :in-theory (enable srt-entry)
+                  :use lemma-3-7-1))
+  :rule-classes ())
+
+(local-defthm lemma-3-7-3
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (check-exists-entry i j k rho m n))
+           (check-entry i j k rho m n (srt-entry i j rho m n)))
+  :hints (("Goal" :in-theory (enable srt-entry check-exists-entry check-lower-bound check-entry)
+                  :use (lemma-3-7-1 lemma-3-7-2))))
+
+(local-defthm lemma-3-7-4
+  (implies (and (natp k)
+                (natp j)
+                (natp n)
+                (< (+ k j) (expt 2 n)))
+           (equal (nth j (srt-row i k rho m n))
+                  (srt-entry i (+ k j) rho m n)))
+  :hints (("Goal" :induct (srt-row-induct j k))
+          ("Subgoal *1/2" :expand ((SRT-ROW I K RHO M N)))
+          ("Subgoal *1/1" :expand ((SRT-ROW I K RHO M N)))))
+
+(local-defthm lemma-3-7-5
+  (implies (and (natp k)
+                (natp i)
+                (natp m)
+                (< (+ k i) (expt 2 m)))
+           (equal (nth i (srt-rows k rho m n))
+                  (srt-row (+ k i) 0 rho m n)))
+  :hints (("Goal" :induct (srt-row-induct i k))
+          ("Subgoal *1/2" :expand ((SRT-ROWS K RHO M N)))
+          ("Subgoal *1/1" :expand ((SRT-ROWS K RHO M N)))))
+
+(local-defthm lemma-3-7-6
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+           (equal (nth j (nth i (srt-table rho m n)))
+                  (srt-entry i j rho m n)))
+  :hints (("Goal" :in-theory (enable srt-table))))
+
+(local-defthm integerp-srt-entry
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (<= j (expt 2 n)))
+           (integerp (srt-entry i j rho m n)))
+  :hints (("Goal" :in-theory (enable lower srt-entry))))
+
+(local-defthm lemma-3-7-7
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (<= j (expt 2 n))
+                (check-exists-row i j k rho m n))
+           (check-row i j k rho m n (nth i (srt-table rho m n))))
+  :hints (("Goal" :in-theory (enable check-exists-row check-row))))
+
+(local-defthm lemma-3-7-8
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (<= i (expt 2 m))
+                (check-exists-rows i k rho m n))
+           (check-rows i k rho m n (srt-table rho m n)))
+  :hints (("Goal" :in-theory (enable check-exists-rows check-rows))))
+
+(defthm lemma-3-7-a
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (exists-srt-table-p k rho m n))
+           (admissible-srt-table-p k rho m n (srt-table rho m n)))
+  :hints (("Goal" :in-theory (enable exists-srt-table-p admissible-srt-table-p))))
+
+(defun f (h i j k rho m n)
+  (if (< i (expt 2 (1- m)))
+      (* (/ (1- h) (expt 2 rho))
+         (+ (delta0 j n) (expt 2 (- n)) (* (1- h) (expt 2 (- (* (1+ k) rho))))))
+    (* (/ (1- h) (expt 2 rho))
+       (+ (delta0 j n) (* (1- h) (expt 2 (- (* (1+ k) rho))))))))
+
+(local-defthm lemma-3-7-10
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h))
+           (>= (* (expt 2 rho) 
+                  (- (f (1+ h) i j k rho m n)
+                     (f h i j k rho m n)))
+               (+ (delta0 j n) (* (1- (* 2 h)) (expt 2 (- (* (1+ k) rho)))))))
+  :rule-classes ()
+  :hints (("Goal" :use converse-39)))
+
+(local-defthm lemma-3-7-11
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h))
+           (rationalp (f h i j k rho m n)))
+  :rule-classes (:type-prescription :rewrite)
+  :hints (("Goal" :use converse-39)))
+
+(local-defthm lemma-3-7-12
+  (implies (and (not (zp rho))
+                (not (zp k))
+                (integerp h)
+                (>= h (- 1 (expt 2 rho))))
+           (>= (1- (* 2 h))
+               (- 1 (expt 2 (1+ rho)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance *-weakly-monotonic (x 2)
+                                                      (y (- 1 (expt 2 rho)))
+                                                      (y+ h))))))
+
+(local-defthm lemma-3-7-13
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h)
+                (>= h (- 1 (expt 2 rho))))
+           (>= (* (1- (* 2 h)) (expt 2 (- (* (1+ k) rho))))
+               (* (- 1 (expt 2 (1+ rho))) (expt 2 (- (* (1+ k) rho))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-7-12
+                        (:instance *-weakly-monotonic (x (expt 2 (* (1+ k) rho)))
+                                                      (y (- 1 (expt 2 (1+ rho))))
+                                                      (y+ (1- (* 2 h))))))))
+
+(local-defthm lemma-3-7-14
+  (implies (and (rationalp x1)
+                (rationalp y1)
+                (rationalp x2)
+                (rationalp y2)
+                (>= x1 x2)
+                (>= y1 y2))
+           (>= (+ x1 y1) (+ x2 y2)))
+  :rule-classes ())
+
+(local-defthm lemma-3-7-15
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h)
+                (>= h (- 1 (expt 2 rho))))
+           (>= (+ (delta0 j n) (* (1- (* 2 h)) (expt 2 (- (* (1+ k) rho)))))
+               (+ 1 (* (- 1 (expt 2 (1+ rho))) (expt 2 (- (* (1+ k) rho)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-7-13
+                        (:instance lemma-3-7-14 (x1 (delta0 j n)) (x2 1)
+                                                (y1 (* (1- (* 2 h)) (expt 2 (- (* (1+ k) rho)))))
+                                                (y2 (* (- 1 (expt 2 (1+ rho))) (expt 2 (- (* (1+ k) rho))))))))))
+
+(local-defthm lemma-3-7-16
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h)
+                (>= h (- 1 (expt 2 rho))))
+           (>= (+ 1 (* (- 1 (expt 2 (1+ rho))) (expt 2 (- (* (1+ k) rho)))))
+               (- 1 (expt 2 (- 1 (* k rho))))))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39))))
+
+(local-defthm lemma-3-7-17
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (>= x y)
+                (>= y z))
+           (>= x z))
+  :rule-classes ())
+ 
+
+(local-defthm lemma-3-7-18
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h)
+                (>= h (- 1 (expt 2 rho))))
+           (>= (+ (delta0 j n) (* (1- (* 2 h)) (expt 2 (- (* (1+ k) rho)))))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-7-15
+                        lemma-3-7-16
+                        (:instance lemma-3-7-17 (y (+ 1 (* (- 1 (expt 2 (1+ rho))) (expt 2 (- (* (1+ k) rho))))))
+                                                (x (+ (delta0 j n) (* (1- (* 2 h)) (expt 2 (- (* (1+ k) rho))))))
+                                                (z (- 1 (expt 2 (- 1 (* k rho))))))))))
+
+(local-defthm lemma-3-7-19
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h)
+                (>= h (- 1 (expt 2 rho))))
+           (>= (* (expt 2 rho) 
+                  (- (f (1+ h) i j k rho m n)
+                     (f h i j k rho m n)))
+               0))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-7-10
+                        lemma-3-7-18))))
+
+(local-defthm lemma-3-7-20
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h)
+                (>= h (- 1 (expt 2 rho))))
+           (>= (f (1+ h) i j k rho m n)
+               (f h i j k rho m n)))
+  :rule-classes ()
+  :hints (("Goal" :use (converse-39
+                        lemma-3-7-19))))
+
+(in-theory (disable f))
+
+(local-defthm lemma-3-7-21
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (integerp h)
+                (>= h (- 1 (expt 2 rho)))
+                (natp hp))
+           (>= (f (+ h hp) i j k rho m n)
+               (f h i j k rho m n)))
+  :rule-classes ()
+  :hints (("Goal" :induct (natp-induct hp))
+          ("Subgoal *1/2" :use ((:instance lemma-3-7-20 (h (1- (+ h hp))))))))
+
+(local-defthm lemma-3-7-22
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (check-entry i j k rho m n h)
+                (not (= h (- 1 (expt 2 rho))))
+                (accessible-p i j k rho m n))
+           (and (>= (pi0 i m) (f h i j k rho m n))
+                (>= h (lower i j rho m n))
+                (< h (expt 2 rho))
+                (< (- (expt 2 rho)) h)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable upper check-lower-bound f check-entry))))
+
+(local-defthm lemma-3-7-23
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n)))
+          (integerp (lower i j rho m n)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable lower))))
+
+(local-defthm lemma-3-7-24
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (>= (lower i j rho m n) (- 1 (expt 2 rho)))
+                (integerp h)
+                (check-entry i j k rho m n h)
+                (not (= h (- 1 (expt 2 rho))))
+                (accessible-p i j k rho m n))
+           (and (>= (pi0 i m) (f (lower i  j rho m n) i j k rho m n))
+                (>= h (lower i j rho m n))
+                (< h (expt 2 rho))
+                (< (- (expt 2 rho)) h)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-7-22
+                        (:instance lemma-3-7-21 (h (lower i j rho m n)) (hp (- h (lower i j rho m n))))))))
+
+(local-defthm lemma-3-7-25
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (>= (lower i j rho m n) (- 1 (expt 2 rho)))
+                (integerp h)
+                (check-entry i j k rho m n h)
+                (not (= h (- 1 (expt 2 rho))))
+                (accessible-p i j k rho m n))
+           (and (check-lower-bound (lower i j rho m n) i j (1+ k) rho m n)
+                (>= h (lower i j rho m n))
+                (< h (expt 2 rho))
+                (< (- (expt 2 rho)) h)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable f check-lower-bound)
+                  :use (lemma-3-7-24
+                        (:instance lemma-3-7-21 (h (lower i j rho m n)) (hp (- h (lower i j rho m n))))))))
+
+(local-defthm lemma-3-7-26
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (check-entry i j k rho m n h)
+                (integerp h))
+           (check-exists-entry i j k rho m n))           
+  :hints (("Goal" :in-theory (enable check-exists-entry check-entry)
+                  :use (lemma-3-7-25))))
+
+(local-defthm lemma-3-7-27
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (<= j (expt 2 n))
+                (check-row i j k rho m n row))
+           (check-exists-row i j k rho m n))           
+  :hints (("Goal" :in-theory (enable check-exists-row check-row))))
+
+(local-defthm lemma-3-7-28
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (natp i)
+                (<= i (expt 2 m))
+                (check-rows i k rho m n rows))
+           (check-exists-rows i k rho m n))           
+  :hints (("Goal" :in-theory (enable check-exists-rows check-rows))))
+
+(defthm lemma-3-7-b
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (admissible-srt-table-p k rho m n table))
+           (exists-srt-table-p k rho m n))
+  :hints (("Goal" :in-theory (enable exists-srt-table-p admissible-srt-table-p))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta1/sqrt66.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta1/sqrt66.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta1/sqrt66.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta1/sqrt66.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1706 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+(local (include-book "../lib3/top"))
+
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defund inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+(defund minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defund common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+
+(include-book "../lib3/util")
+
+(local (include-book "arithmetic-5/top" :dir :system))
+
+
+
+(defund trunc-sqrt (x n)
+  (if (zp n)
+      0
+    (let* ((lower (trunc-sqrt x (1- n)))
+           (upper (+ lower (expt 2 (- n)))))
+      (if (<= (* upper upper) x)
+          upper
+        lower))))
+
+(defund sticky-sqrt (x n)
+  (let ((trunc (trunc-sqrt x (1- n))))
+    (if (< (* trunc trunc) x)
+        (+ trunc (expt 2 (- n)))
+      trunc)))
+
+(local-in-theory (enable trunc-sqrt sticky-sqrt))
+
+(defund sqrt66 (x)
+  (let ((e (1+ (fl (/ (expo x) 2)))))
+    (* (expt 2 e)
+       (sticky-sqrt (/ x (expt 2 (* 2 e))) 66))))
+
+(defthmd sqrt66-pos
+  (implies (and (rationalp x)
+                (> x 0))
+           (> (sqrt66 x) 0))
+  :hints (("Goal" :in-theory (enable sqrt66))))
+
+(defthmd sqrt66-shift
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n))
+           (equal (sqrt66 (* (expt 2 (* 2 n)) x))
+                  (* (expt 2 n) (sqrt66 x))))
+  :hints (("Goal" :use ((:instance expo-shift (n (* 2 n)))
+                        (:instance fl+int-rewrite (x (/ (expo x) 2))))
+                  :in-theory (e/d (sqrt66) (fl+int-rewrite sticky-sqrt)))))
+
+(local-defthm trunc-sqrt-bounds-1
+  (implies (and (rationalp x)
+                (<= 1/4 x))
+           (= (trunc-sqrt x 1) 1/2))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance trunc-sqrt (n 1)))))
+
+(local-defthm trunc-sqrt-bounds-2
+  (implies (and (rationalp x)
+                (not (zp n)))
+           (< (+ x (expt 2 (- n)))
+              (+ x (expt 2 (- 1 n)))))
+:rule-classes ())
+
+(local-defthm trunc-sqrt-bounds-3
+  (implies (and (rationalp x)
+                (rationalp y)
+                (< x y)
+                (<= y 1))
+           (<= x 1))
+:rule-classes ())
+
+(local-defthm trunc-sqrt-bounds-4
+  (implies (and (rationalp x)
+                (not (zp n))
+                (<= (+ (expt 2 (+ 1 (- n))) x) 1))
+           (<= (+ (expt 2 (- n)) x) 1))
+  :rule-classes ()
+  :hints (("Goal" :use (trunc-sqrt-bounds-2
+                        (:instance trunc-sqrt-bounds-3 (x (+ x (expt 2 (- n))))
+                                                       (y (+ x (expt 2 (- 1 n)))))))))
+
+(defthm trunc-sqrt-bounds
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n)))
+           (and (<= 1/2 (trunc-sqrt x n))
+                (<= (trunc-sqrt x n) (- 1 (expt 2 (- n))))))
+  :rule-classes ()
+  :hints (("Subgoal *1/2" :use (trunc-sqrt-bounds-1
+                                (:instance trunc-sqrt-bounds-4 (x (trunc-sqrt x (1- n))))))))
+                                
+
+(defthm expo-trunc-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n)))
+           (equal (expo (trunc-sqrt x n))
+                  -1))
+  :hints (("Goal" :use (trunc-sqrt-bounds
+                        (:instance expo-unique (x (trunc-sqrt x n)) (n -1))))))
+
+(local-defthm exactp-trunc-sqrt-1
+  (implies (integerp x)
+           (integerp (* 2 x)))
+  :rule-classes ())
+
+(local-defthm exactp-trunc-sqrt-2
+  (implies (and (rationalp x)
+                (natp n)
+                (integerp (* (expt 2 (+ -1 n)) x)))
+           (integerp (* (expt 2 n) x)))
+  :hints (("Goal" :use (:instance exactp-trunc-sqrt-1 (x (* (expt 2 (+ -1 n)) x))))))
+
+(local-defthm exactp-trunc-sqrt-3
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n)))
+           (integerp (* (trunc-sqrt x n) (expt 2 n))))
+  :rule-classes ())
+
+(defthm exactp-trunc-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n)))
+           (exactp (trunc-sqrt x n)
+                   n))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (exactp2) (trunc-sqrt))
+                  :use exactp-trunc-sqrt-3)))
+
+(local-defthmd trunc-trunc-sqrt-1
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n))
+                (> n 1))
+           (and (<= (trunc-sqrt x (1- n))
+                    (trunc-sqrt x n))
+                (< (trunc-sqrt x n)
+                   (+ (trunc-sqrt x (1- n))
+                      (expt 2 (- 1 n))))))
+  :hints (("Goal" :expand ((trunc-sqrt x n)))))
+
+
+(local-defthmd trunc-trunc-sqrt-2
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp n))
+                (> n 1))
+           (equal (trunc (trunc-sqrt x n) (+ -1 n))
+                  (trunc-sqrt x (1- n))))
+  :hints (("Goal" :in-theory (disable trunc-sqrt)
+                  :use (trunc-trunc-sqrt-1
+                        trunc-sqrt-bounds
+                        (:instance trunc-sqrt-bounds (n (1- n)))
+                        (:instance exactp-trunc-sqrt (n (1- n)))
+                        (:instance trunc-upper-pos (x (trunc-sqrt x n)) (n (1- n)))
+                        (:instance trunc-exactp-a (x (trunc-sqrt x n)) (n (1- n)))
+                        (:instance trunc-exactp-c (a (trunc-sqrt x (1- n))) (x (trunc-sqrt x n)) (n (1- n)))
+                        (:instance fp+2 (n (1- n)) (x (trunc-sqrt x (1- n))) (y (trunc (trunc-sqrt x n) (1- n))))))))  
+
+(local-defun natp-induct (n)
+  (if (zp n)
+      ()
+    (1+ (natp-induct (1- n)))))
+
+(local-defthmd trunc-trunc-sqrt-3
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp m))
+                (natp n)
+                (> n m))
+           (equal (trunc (trunc-sqrt x n) m)
+                  (trunc-sqrt x m)))
+  :hints (("Goal" :induct (natp-induct n))
+          ("Subgoal *1/2" :in-theory (disable trunc-sqrt)
+                         :use (trunc-trunc-sqrt-2
+                               (:instance trunc-trunc (x (trunc-sqrt x n)) (n (1- n)))))))
+
+(defthmd trunc-trunc-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (not (zp m))
+                (natp n)
+                (>= n m))
+           (equal (trunc (trunc-sqrt x n) m)
+                  (trunc-sqrt x m)))
+  :hints (("Goal" :in-theory (disable trunc-sqrt)
+                         :use (trunc-trunc-sqrt-3
+                               exactp-trunc-sqrt
+                               (:instance trunc-exactp-b (x (trunc-sqrt x n)))
+                               (:instance trunc-trunc (x (trunc-sqrt x n)) (n (1- n)))))))
+
+(defthm trunc-sqrt-square-bounds
+  (implies (and (not (zp n))
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))                
+           (and (<= (* (trunc-sqrt x n)
+                       (trunc-sqrt x n))
+                    x)
+                (< x
+                   (* (+ (trunc-sqrt x n) (expt 2 (- n)))
+                      (+ (trunc-sqrt x n) (expt 2 (- n)))))))
+  :rule-classes ())
+
+(local-defthm square-leq-1
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0))
+           (iff (> x 0) (> (* x y) 0)))
+  :rule-classes ())
+
+(defthm square-leq
+  (implies (and (rationalp x)
+                (rationalp y)
+                (>= x 0)
+                (>= y 0))
+           (iff (<= (* x x) (* y y))
+                (<= x y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance square-leq-1 (x (- x y)) (y (+ x y)))))))
+
+(local-defthm trunc-sqrt-unique-1
+  (implies (and (not (zp n))
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp a)
+                (exactp a n)
+                (>= a 1/2)
+                (<= (* a a) x)
+                (< x (* (+ a (expt 2 (- n))) (+ a (expt 2 (- n))))))
+           (= (expo a) -1))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expo-unique (x a) (n -1))
+                        (:instance square-leq (y a) (x 2))))))
+
+(defthm trunc-sqrt-unique
+  (implies (and (not (zp n))
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp a)
+                (exactp a n)
+                (>= a 1/2)
+                (<= (* a a) x)
+                (< x (* (+ a (expt 2 (- n))) (+ a (expt 2 (- n))))))
+           (= a (trunc-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (trunc-sqrt-unique-1
+                        trunc-sqrt-square-bounds
+                        exactp-trunc-sqrt
+                        trunc-sqrt-bounds
+                        (:instance square-leq (x (+ a (expt 2 (- n)))) (y (trunc-sqrt x n)))
+                        (:instance square-leq (x (+ (trunc-sqrt x n) (expt 2 (- n)))) (y a))
+                        (:instance fp+2 (x a) (y (trunc-sqrt x n)))
+                        (:instance fp+2 (y a) (x (trunc-sqrt x n)))))))
+
+(local-defthm sticky-sqrt-bounds-1
+  (implies (and (rationalp x)
+                (integerp a)
+                (integerp b)
+                (< b a)
+                (<= (+ (expt 2 a) x) 1))
+           (< (+ (expt 2 b) x) 1))
+  :rule-classes ())
+
+(defthm sticky-sqrt-bounds
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (natp n)
+                (>= n 2))
+           (and (<= 1/2 (sticky-sqrt x n))
+                (< (sticky-sqrt x n) 1)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-sqrt-bounds (n (1- n)))
+                        (:instance sticky-sqrt-bounds-1 (x (trunc-sqrt x (1- n)))
+                                                   (a (- 1 n))
+                                                   (b (- n)))))))
+
+(defthm expo-sticky-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (natp n)
+                (>= n 2))
+           (equal (expo (sticky-sqrt x n))
+                  -1))
+  :hints (("Goal" :use (sticky-sqrt-bounds
+                        (:instance expo-unique (x (sticky-sqrt x n)) (n -1))))))
+
+(local-defthm exactp-sticky-sqrt-1
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (natp n)
+                (>= n 2)
+                (integerp (* (sticky-sqrt x n) (expt 2 n))))
+           (exactp (sticky-sqrt x n) n))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (exactp2) (sticky-sqrt)))))
+
+(local-defthm exactp-sticky-sqrt-2
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (natp n)
+                (>= n 2))
+           (integerp (* (sticky-sqrt x n) (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2)
+                  :use ((:instance exactp-trunc-sqrt (n (1- n)))))))
+
+(defthmd exactp-sticky-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (natp n)
+                (>= n 2))
+           (exactp (sticky-sqrt x n) n))
+  :hints (("Goal" :use (exactp-sticky-sqrt-1 exactp-sticky-sqrt-2)
+                  :in-theory (disable sticky-sqrt))))
+
+(local-defthm sticky-sqrt-lower-1
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (= (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n ))) x))
+           (<= (* l l) (* (sticky-sqrt x n) (sticky-sqrt x n))))
+  :rule-classes ())
+
+(local-defthm sticky-sqrt-lower-4
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (= (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (* l l) (* (sticky-sqrt x n) (sticky-sqrt x n))))
+  :rule-classes ())
+
+(local-defthm sticky-sqrt-lower-5
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (= (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= l (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-4
+                        (:instance square-leq  (x l) (y (sticky-sqrt x n)))))))
+  
+(local-defthm sticky-sqrt-lower-6
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (= (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (sticky l n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-5
+                        (:instance exactp-trunc-sqrt (n (1- n)))
+                        (:instance exactp-<= (x (trunc-sqrt x (1- n))) (m (1- n)))
+                        (:instance sticky-monotone (x l) (y (sticky-sqrt x n)))
+                        (:instance sticky-exactp-b (x (sticky-sqrt x n)))))))
+
+(local-defthm sticky-sqrt-lower-7
+  (implies (and (rationalp x)
+                (rationalp y)
+                (>= x 0)
+                (>= y 0))
+           (>= (* x y) 0))
+  :rule-classes ())
+
+(local-defthm sticky-sqrt-lower-8
+  (implies (and (rationalp x)
+                (rationalp y)
+                (< (* x x) (* y y))
+                (>= y 0))
+           (< x y))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sticky-sqrt-lower-7 (x (- x y)) (y (+ x y)))))))
+
+(local-defthm sticky-sqrt-lower-9
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (< (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (< l (fp+ (trunc-sqrt x (1- n)) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-sqrt-square-bounds (n (1- n)))
+                        (:instance sticky-sqrt-lower-8 (x l) 
+                                                   (y (+ (trunc-sqrt x (1- n)) (expt 2 (- 1 n)))))))))
+
+(local-defthm sticky-sqrt-lower-10
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (< (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (trunc l (1- n))
+               (trunc-sqrt x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-9
+                        (:instance trunc-sqrt-bounds (n (1- n)))
+                        (:instance exactp-trunc-sqrt (n (1- n)))
+                        (:instance trunc-upper-pos (x l) (n (1- n)))
+                        (:instance trunc-exactp-a (x l) (n (1- n)))
+                        (:instance fp+2 (y (trunc l (1- n))) (x (trunc-sqrt x (1- n))) (n (1- n)))))))
+
+(local-defthm sticky-sqrt-lower-11
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (exactp l (1- n))
+                (< (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (sticky l n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky)
+                  :use (sticky-sqrt-lower-10
+                        (:instance trunc-exactp-b (x l) (n (1- n)))))))
+
+
+(local-defthm sticky-sqrt-lower-12
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (> l 0)
+                (<= (* l l) x)
+                (< (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (expo l) -1))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-10
+                        (:instance expo-monotone (x (trunc l (1- n))) (y (trunc-sqrt x (1- n))))))))
+
+(local-defthm sticky-sqrt-lower-13
+  (implies (and (integerp a)
+                (integerp b)
+                (<= a b))
+           (<= (expt 2 a) (expt 2 b)))
+  :rule-classes ())
+
+
+(local-defthm sticky-sqrt-lower-14
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (> l 0)
+                (<= (* l l) x)
+                (< (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (EXPT 2 (+ 1 (- N) (EXPO L)))
+               (EXPT 2 (- N))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-12
+                        (:instance sticky-sqrt-lower-13 (a (+ 1 (- N) (EXPO L))) (b (- N)))))))
+
+(local-defthm sticky-sqrt-lower-15
+  (implies (and (rationalp a)
+                (rationalp b)
+                (<= a b)
+                (rationalp c)
+                (rationalp d)
+                (<= c d))
+           (<= (+ a c) (+ b d)))
+  :rule-classes ())
+
+(local-defthm sticky-sqrt-lower-16
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (> l 0)
+                (<= (* l l) x)
+                (< (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (+ (TRUNC L (+ -1 N)) (EXPT 2 (+ 1 (- N) (EXPO L))))
+               (+ (TRUNC-SQRT x (1- N)) (EXPT 2 (- N)))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-10
+                        sticky-sqrt-lower-14
+                        (:instance sticky-sqrt-lower-15 (a (TRUNC L (+ -1 N)))
+                                                    (b (TRUNC-SQRT x (1- N)))
+                                                    (c (EXPT 2 (+ 1 (- N) (EXPO L))))
+                                                    (d (EXPT 2 (- N))))))))
+
+(local-defthm sticky-sqrt-lower-17
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (not (exactp l (1- n)))
+                (>= l 0)
+                (< (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (sticky l n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn sticky)
+                  :use (sticky-sqrt-lower-16))))
+
+(local-defthm sticky-sqrt-lower-18
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x)
+                (not (exactp l (1- n)))
+                (< l 0)
+                (< (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))) x))
+           (<= (sticky l n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-1
+                        (:instance sticky-negative (x l))))))
+
+(defthm sticky-sqrt-lower
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp l)
+                (<= (* l l) x))
+           (<= (sticky l n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-6
+                        sticky-sqrt-lower-11
+                        sticky-sqrt-lower-17
+                        sticky-sqrt-lower-18
+                        (:instance trunc-sqrt-square-bounds (n (1- n)))))))
+
+#|
+Proof: Let a = trunc-sqrt(n-2, x) and r = sticky-sqrt(x, n).
+Suppose a^2 = x.  Then r = a, l^2 <= x = a^2 = r^2, and l <= r.  
+By sticky-monotone, sticky-exactp-b, and exactp-trunc-sqrt,
+
+  sticky(l, n) <= sticky(r, n) = r.
+
+Thus, we may assume a^2 < x and r = a + 2^(1-n).  By trunc-sqrt-square-bounds, 
+l^2 <= x < (a + 2^(2-n))^2, and hence l < a + 2^(2-n) = fp+(a, n-1).  
+It follows from trunc-upper-pos, trunc-exactp-a, and fp+2 that 
+trunc(l, n-1) <= a.  Thus,
+
+  sticky(l, n) <= trunc(l, n-1) + 2^(1+expo(l)-n)
+               <= a + 2^(1-n)
+                = r.
+|#
+
+(local-defthm sticky-sqrt-upper-1
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))
+           (>= h (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance square-leq (x (sticky-sqrt x n)) (y h))))))
+
+(local-defthm sticky-sqrt-upper-2
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))
+           (>= (sticky h n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-upper-1
+                        (:instance exactp-trunc-sqrt (n (1- n)))
+                        (:instance exactp-<= (x (trunc-sqrt x (1- n))) (m (1- n)))
+                        (:instance sticky-monotone (x (sticky-sqrt x n)) (y h))
+                        (:instance sticky-exactp-b (x (sticky-sqrt x n)))))))
+
+(local-defthm sticky-sqrt-upper-3
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (>= h (sticky-sqrt x n))
+                (> x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))
+           (>= (sticky h n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-lower-1
+                        exactp-sticky-sqrt
+                        (:instance sticky-monotone (x (sticky-sqrt x n)) (y h))
+                        (:instance sticky-exactp-b (x (sticky-sqrt x n)))))))
+
+(local-defthm sticky-sqrt-upper-4
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (< h (sticky-sqrt x n))
+                (> x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))
+           (> h (trunc-sqrt x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-sqrt-square-bounds (n (- n 2)))
+                        (:instance square-leq (x (trunc-sqrt x (1- n))) (y h))))))
+
+(local-defthm sticky-sqrt-upper-5
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (< h (sticky-sqrt x n))
+                (> x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))
+           (>= (trunc h (1- n)) (trunc-sqrt x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-upper-4
+                        (:instance exactp-trunc-sqrt (n (1- n)))
+                        (:instance trunc-exactp-c (a (trunc-sqrt x (1- n))) (x h) (n (1- n)))))))
+
+(local-defthm sticky-sqrt-upper-6
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (< h (sticky-sqrt x n))
+                (> x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))
+           (not (exactp h (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-upper-4
+                        (:instance trunc-sqrt-bounds (n (1- n)))
+                        (:instance exactp-trunc-sqrt (n (1- n)))
+                        (:instance exactp-<= (x (trunc-sqrt x (1- n))) (m (1- n)))
+                        (:instance exactp-<= (x h) (m (1- n)))
+                        (:instance fp+2 (x (trunc-sqrt x (1- n))) (y h))))))
+
+(local-defthm sticky-sqrt-upper-7
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (< h (sticky-sqrt x n))
+                (> x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))
+           (equal (expo h) -1))
+  :hints (("Goal" :use (sticky-sqrt-upper-4
+                        sticky-sqrt-bounds
+                        (:instance trunc-sqrt-bounds (n (1- n)))
+                        (:instance expo-unique (x h) (n -1))))))
+
+(local-defthm sticky-sqrt-upper-8
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (< h (sticky-sqrt x n))
+                (> x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))
+           (>= (sticky h n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn sticky)
+                  :use (sticky-sqrt-upper-6
+                        sticky-sqrt-upper-5))))
+
+(defthm sticky-sqrt-upper
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x))
+           (>= (sticky h n)
+               (sticky-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sqrt-upper-2
+                        sticky-sqrt-upper-3
+                        sticky-sqrt-upper-8
+                        (:instance trunc-sqrt-square-bounds (n (1- n)))))))
+
+#|
+Proof: Let a = trunc-sqrt(x, n-1) and r = sticky-sqrt(x, n).
+We may assume that h < r; otherwise, by sticky-monotone, 
+sticky-exactp-b, and exactp-trunc-sqrt,
+
+  sticky(h, n) >= sticky(r, n) = r.
+
+If a^2 = x, then r = a, h^2 >= x = a^2 = r^2, and h >= r.  
+Thus, by trunc-sqrt-square-bounds, a^2 < x and r = a + 2^(1-n) = fp+(a, n).
+Since h^2 >= x > a^2, h > a.  It follows from trunc-exactp-c that 
+trunc(h, n-1) >= a.  By fp+2, h is not n-exact, and hence
+
+  sticky(h, n) = trunc(h, n-1) + 2^(1-n)
+              >= a + 2^(1-n)
+               = r.
+|#
+
+(in-theory (disable trunc-sqrt sticky-sqrt))
+
+(local-defthm sticky-sticky-sqrt-1
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= x (* (trunc-sqrt x (- n 2)) (trunc-sqrt x (- n 2)))))
+           (and (= (sticky-sqrt x n)
+                   (sticky-sqrt x (1- n)))
+                (= (sticky-sqrt x (1- n))
+                   (trunc-sqrt x (- n 2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable trunc-sqrt sticky-sqrt))))
+
+(local-defthm sticky-sticky-sqrt-2
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= x (* (trunc-sqrt x (- n 2)) (trunc-sqrt x (- n 2)))))
+           (= (sticky (sticky-sqrt x n) (1- n))
+              (sticky-sqrt x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-1
+                        (:instance exactp-sticky-sqrt (n (1- n)))
+                        (:instance sticky-exactp-b (x (sticky-sqrt x n)) (n (1- n)))))))
+
+(local-defthm sticky-sticky-sqrt-3
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n)))))
+           (and (= (sticky-sqrt x (1- n))
+                   (+ (trunc-sqrt x (- n 2)) (expt 2 (- 1 n))))
+                (= (trunc-sqrt x (1- n))
+                   (+ (trunc-sqrt x (- n 2)) (expt 2 (- 1 n))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable trunc-sqrt sticky-sqrt)
+                  :use ((:instance trunc-sqrt-square-bounds (n (- n 2)))
+                        (:instance trunc-sqrt-square-bounds (n (1- n)))))))
+
+(local-defthm sticky-sticky-sqrt-4
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))                
+           (= (sticky-sqrt x n)
+              (+ (trunc-sqrt x (- n 2)) (expt 2 (- 1 n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-sqrt)
+                  :use (sticky-sticky-sqrt-3))))
+
+
+(local-defthm sticky-sticky-sqrt-5
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n)))))                
+           (= (sticky (sticky-sqrt x n) (1- n))
+              (sticky-sqrt x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-3
+                        sticky-sticky-sqrt-4
+                        (:instance exactp-sticky-sqrt (n (1- n)))
+                        (:instance sticky-exactp-b (x (sticky-sqrt x n)) (n (1- n)))))))
+
+(local-defthm sticky-sticky-sqrt-6
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (sticky-sqrt x n)
+              (+ (trunc-sqrt x (- n 2)) (expt 2 (- 1 n)) (expt 2 (- n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-sqrt)
+                  :use (sticky-sticky-sqrt-3
+                        (:instance trunc-sqrt-square-bounds (n (1- n)))))))
+
+(local-defthmd sticky-sticky-sqrt-7
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (equal (sticky-sqrt x n)
+                  (+ (trunc-sqrt x (1- n)) (expt 2 (- n)))))
+  :hints (("Goal" :in-theory (enable sticky-sqrt)
+                  :use (sticky-sticky-sqrt-3
+                        (:instance trunc-sqrt-square-bounds (n (1- n)))))))
+
+(local-defthm sticky-sticky-sqrt-8
+  (implies (and (rationalp x)
+                (not (integerp x))
+                (integerp y))
+           (not (integerp (+ x y))))
+  :rule-classes ())
+
+(local-defthm sticky-sticky-sqrt-9
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (not (integerp (* (expt 2 (- n 1)) (sticky-sqrt x n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-sticky-sqrt-7 exactp2)
+                  :use ((:instance sticky-sticky-sqrt-8 (x (expt 2 (- 2 (* 2 n))))
+                                                   (y (* (expt 2 (- n 1)) (sticky-sqrt x (1- n)))))
+                        (:instance exactp-trunc-sqrt (n (1- n)))))))
+
+(local-defthm sticky-sticky-sqrt-10
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (not (exactp (sticky-sqrt x n) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2)
+                  :use (sticky-sticky-sqrt-9))))
+
+(local-defthm sticky-sticky-sqrt-11
+  (implies (integerp n)
+           (< (+ (expt 2 (- 1 n)) (expt 2 (- n)))
+              (expt 2 (- 2 n))))
+  :rule-classes ())
+
+(local-defthm sticky-sticky-sqrt-12
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (< (sticky-sqrt x n)
+              (fp+ (trunc-sqrt x (- n 2)) (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-sqrt)
+                  :use (sticky-sticky-sqrt-6
+                        sticky-sticky-sqrt-11
+                        (:instance trunc-sqrt-square-bounds (n (- n 2)))))))
+
+(local-defthm sticky-sticky-sqrt-13
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (>= (sticky-sqrt x n)
+               (trunc-sqrt x (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-6))))
+
+(local-defthm sticky-sticky-sqrt-14
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (>= (trunc (sticky-sqrt x n) (- n 2))
+               (trunc-sqrt x (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-13
+                        (:instance exactp-trunc-sqrt (n (- n 2)))
+                        (:instance trunc-exactp-c (a (trunc-sqrt x (- n 2))) (x (sticky-sqrt x n)) (n (- n 2)))))))
+
+(local-defthm sticky-sticky-sqrt-15
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (<= (trunc (sticky-sqrt x n) (- n 2))
+               (trunc-sqrt x (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-12
+                        sticky-sqrt-bounds
+                        (:instance exactp-trunc-sqrt (n (- n 2)))
+                        (:instance trunc-sqrt-bounds (n (- n 2)))
+                        (:instance trunc-upper-pos (x (sticky-sqrt x n)) (n (- n 2)))
+                        (:instance fp+2 (x (trunc-sqrt x (- n 2))) (y (trunc (sticky-sqrt x n) (- n 2))) (n (- n 2)))))))
+
+(local-defthm sticky-sticky-sqrt-16
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (trunc (sticky-sqrt x n) (- n 2))
+              (trunc-sqrt x (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-15
+                        sticky-sticky-sqrt-14))))
+
+(local-defthm sticky-sticky-sqrt-17
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (sticky (sticky-sqrt x n) (1- n))
+              (+ (trunc-sqrt x (- n 2)) (expt 2 (- 1 n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn sticky)
+                  :use (sticky-sticky-sqrt-10
+                        sticky-sticky-sqrt-16
+                        sticky-sqrt-bounds
+                        (:instance exactp-<= (x (sticky-sqrt x n)) (m (- n 2)) (n (1- n)))))))
+
+(local-defthm sticky-sticky-sqrt-18
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (< (* (trunc-sqrt x (- n 2)) (trunc-sqrt x (- n 2))) x))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable trunc-sqrt)
+                  :use ((:instance trunc-sqrt-square-bounds (n (1- n)))
+                        (:instance square-leq (x (trunc-sqrt x (- n 2))) (y (trunc-sqrt x (1- n))))))))
+
+(local-defthm sticky-sticky-sqrt-19
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (sticky-sqrt x (1- n))
+              (+ (trunc-sqrt x (- n 2)) (expt 2 (- 1 n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-sqrt)
+                  :use (sticky-sticky-sqrt-18))))
+
+(local-defthm sticky-sticky-sqrt-20
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n))))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (sticky (sticky-sqrt x n) (1- n))
+              (sticky-sqrt x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-17
+                        sticky-sticky-sqrt-19))))
+
+(local-defthm sticky-sticky-sqrt-21
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n)))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (sticky-sqrt x n)
+              (+ (trunc-sqrt x (- n 2)) (expt 2 (- n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-sqrt)
+                  :use (sticky-sticky-sqrt-3
+                        (:instance trunc-sqrt-square-bounds (n (1- n)))))))
+
+(local-defthm sticky-sticky-sqrt-22
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n)))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (< (sticky-sqrt x n)
+              (fp+ (trunc-sqrt x (- n 2)) (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-sqrt)
+                  :use (sticky-sticky-sqrt-21
+                        sticky-sticky-sqrt-11
+                        (:instance trunc-sqrt-square-bounds (n (- n 2)))))))
+
+(local-defthm sticky-sticky-sqrt-23
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n)))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (>= (sticky-sqrt x n)
+               (trunc-sqrt x (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-21))))
+
+(local-defthm sticky-sticky-sqrt-24
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n)))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (>= (trunc (sticky-sqrt x n) (- n 2))
+               (trunc-sqrt x (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-23
+                        (:instance exactp-trunc-sqrt (n (- n 2)))
+                        (:instance trunc-exactp-c (a (trunc-sqrt x (- n 2))) (x (sticky-sqrt x n)) (n (- n 2)))))))
+
+(local-defthm sticky-sticky-sqrt-25
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n)))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (<= (trunc (sticky-sqrt x n) (- n 2))
+               (trunc-sqrt x (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-22
+                        sticky-sqrt-bounds
+                        (:instance exactp-trunc-sqrt (n (- n 2)))
+                        (:instance trunc-sqrt-bounds (n (- n 2)))
+                        (:instance trunc-upper-pos (x (sticky-sqrt x n)) (n (- n 2)))
+                        (:instance fp+2 (x (trunc-sqrt x (- n 2))) (y (trunc (sticky-sqrt x n) (- n 2))) (n (- n 2)))))))
+
+(local-defthm sticky-sticky-sqrt-26
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n)))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (trunc (sticky-sqrt x n) (- n 2))
+              (trunc-sqrt x (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-25
+                        sticky-sticky-sqrt-24))))
+
+(local-defthm sticky-sticky-sqrt-27
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (= (trunc-sqrt x (- n 2)) (trunc-sqrt x (1- n)))
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (sticky (sticky-sqrt x n) (1- n))
+              (+ (trunc-sqrt x (- n 2)) (expt 2 (- 1 n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn sticky)
+                  :use (sticky-sticky-sqrt-10
+                        sticky-sticky-sqrt-26
+                        sticky-sqrt-bounds
+                        (:instance exactp-<= (x (sticky-sqrt x n)) (m (- n 2)) (n (1- n)))))))
+
+(local-defthm sticky-sticky-sqrt-28
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (not (= x (* (trunc-sqrt x (1- n)) (trunc-sqrt x (1- n))))))
+           (= (sticky (sticky-sqrt x n) (1- n))
+              (sticky-sqrt x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-20
+                        sticky-sticky-sqrt-27
+                        sticky-sticky-sqrt-19))))
+
+(local-defthm sticky-sticky-sqrt-29
+  (implies (and (natp n)
+                (>= n 3)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (= (sticky (sticky-sqrt x n) (1- n))
+              (sticky-sqrt x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt-2
+                        sticky-sticky-sqrt-5
+                        sticky-sticky-sqrt-28))))
+
+#|
+Proof: Let a1 = trunc-sqrt(x, n-2), r1 = sticky-sqrt(x, n-1), a2 = trunc-sqrt(x, n-1), and r2 = sticky-sqrt(x, n).
+expo(a1) = expo(r1) = expo(a2) = expo(r2) = 0.
+Show sticky(r2, n-1) = r1.  Note that 1 <= a1^2 <= a^2 <= x.
+
+Case 1: a1 = a2 and a2^2 = x.
+
+a1 = r1 = a2 = r2.  Since r2 is (n-1)-exact, sticky(r2, n-1) = r2 = r1.
+
+Case 2: a1 = a2 and a2^2 < x.
+
+r1 = a1 + 2^(2-n) is not (n-2)-exact, r2 = a2 + 2^(1-n) is not (n-1)-exact.
+sticky(r2, n-1) = trunc(r2, n-2) + 2^(2-n) = a1 + 2^(2-n) = r1.
+
+Case 3: a1 < a2 and a2^2 = x.
+
+r1 = a2 = r2 = a1 + 2^(2-n) is (n-1)-exact.
+sticky(r2, n-1) = r2 = r1.
+
+Case 4: a1 < a2 and a2^2 < x.
+
+r1 = a2 = a1 + 2^(2-n) and r2 = a2 + 2^(1-n) = a1 + 2^(2-n) + 2^(1-n).
+sticky(r2, n-1) = trunc(r2, n-2) + 2^(2-n) = a1 + 2^(2-n) = r1.
+|#
+
+(local-defthm sticky-sticky-sqrt-30
+  (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (> m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+          (= (sticky (sticky-sqrt x (1- m)) n)
+             (sticky (sticky-sqrt x m) n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance sticky-sticky-sqrt-29 (n m))
+                        (:instance sticky-sticky (x (sticky-sqrt x m)) (n (1- m)) (m n))))))
+
+(local-defun natp-induct (n)
+  (if (zp n)
+      ()
+    (1+ (natp-induct (1- n)))))
+
+(defthmd sticky-sticky-sqrt
+  (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (>= m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (equal (sticky (sticky-sqrt x m) n)
+                  (sticky-sqrt x n)))
+  :hints (("Goal" :induct (natp-induct m))
+          ("Subgoal *1/2" :use (sticky-sticky-sqrt-30
+                                exactp-sticky-sqrt
+                                (:instance sticky-exactp-b (x (sticky-sqrt x n)))))))
+
+(defthm rnd-sticky-sqrt
+  (implies (and (not (zp k))
+                (natp n)
+                (>= n (+ k 2))
+                (natp m)
+                (>= m n)
+                (common-rounding-mode-p mode)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (= (rnd (sticky-sqrt x m) mode k)
+              (rnd (sticky-sqrt x n) mode k)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-sticky-sqrt
+                        (:instance rnd-sticky (x (sticky-sqrt x m)) (m k))))))
+
+(local-defthm trunc-sticky-sqrt-1
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (and (<= (trunc-sqrt x n) (sticky-sqrt x (1+ n)))
+                (< (sticky-sqrt x (1+ n)) (fp+ (trunc-sqrt x n) n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-sqrt))))
+
+(local-defthm trunc-sticky-sqrt-2
+  (implies (and (natp n)
+                (>= n 2)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (= (trunc (sticky-sqrt x (1+ n)) n)
+              (trunc-sqrt x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (trunc-sqrt-bounds
+                        exactp-trunc-sqrt
+                        trunc-sticky-sqrt-1
+                        (:instance trunc-exactp-b (x (trunc-sqrt x n)))
+                        (:instance trunc-monotone (x (trunc-sqrt x n)) (y (sticky-sqrt x (1+ n))))
+                        (:instance sticky-sqrt-bounds (n (1+ n)))
+                        (:instance fp+2 (x (trunc-sqrt x n)) (y (trunc (sticky-sqrt x (1+ n)) n)))
+                        (:instance trunc-upper-pos (x (sticky-sqrt x (1+ n))))))))
+
+(defthmd trunc-sticky-sqrt
+  (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (> m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (equal (trunc (sticky-sqrt x m) n)
+                  (trunc-sqrt x n)))
+  :hints (("Goal" :use (trunc-sticky-sqrt-2
+                        (:instance sticky-sticky-sqrt (n (1+ n)))
+                        (:instance trunc-sticky (x (sticky-sqrt x m)) (n (1+ n)) (m n))))))
+
+(local-defthmd trunc-trunc-sticky-1
+   (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (>= m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1) 
+                (= (* (trunc-sqrt x n) (trunc-sqrt x n)) x))
+            (equal (trunc-sqrt x m)
+                   (trunc-sqrt x n)))
+  :hints (("Goal" :induct (natp-induct m))
+          ("Subgoal *1/2" :in-theory (enable trunc-sqrt))))
+
+(local-defthmd trunc-trunc-sticky-2
+   (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (> m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1) 
+                (= (* (trunc-sqrt x n) (trunc-sqrt x n)) x))
+            (equal (sticky-sqrt x m)
+                   (trunc-sqrt x n)))
+  :hints (("Goal" :use ((:instance trunc-trunc-sticky-1 (m (1- m))))
+                  :in-theory (enable sticky-sqrt))))
+
+(local-defthmd trunc-trunc-sticky-3
+   (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (>= m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+            (<= (trunc-sqrt x n)
+                (trunc-sqrt x m)))
+  :hints (("Goal" :induct (natp-induct m))
+          ("Subgoal *1/2" :in-theory (enable trunc-sqrt))))
+
+(local-defthmd trunc-trunc-sticky-4
+   (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (> m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)
+                (< (* (trunc-sqrt x n) (trunc-sqrt x n)) x))
+            (< (trunc-sqrt x n)
+               (sticky-sqrt x m)))
+  :hints (("Goal" :use (trunc-sqrt-bounds
+                        (:instance trunc-sqrt-bounds (n (1- m)))
+                        (:instance trunc-trunc-sticky-3 (m (1- m)))
+                        (:instance square-leq (x (trunc-sqrt x m)) (y (trunc-sqrt x n)))
+                        (:instance square-leq (x (trunc-sqrt x n)) (y (trunc-sqrt x m))))
+                  :in-theory (enable sticky-sqrt))))
+
+(defthm trunc-trunc-sticky
+   (implies (and (natp n)
+                (>= n 2)
+                (natp m)
+                (> m n)
+                (rationalp x)
+                (<= 1/4 x)
+                (< x 1)) 
+           (iff (= (* (trunc-sqrt x n) (trunc-sqrt x n)) x)
+                (= (sticky-sqrt x m) (trunc-sqrt x n))))
+  :rule-classes ()
+  :hints (("Goal" :use (trunc-trunc-sticky-2
+                        trunc-trunc-sticky-4
+                        trunc-sqrt-square-bounds))))
+
+(defthmd sqrt66-sticky-sqrt
+  (implies (and (rationalp x)
+                (<= 1/4 x)
+                (< x 1))
+           (equal (sqrt66 x)
+                  (sticky-sqrt x 66)))
+  :hints (("Goal" :in-theory (enable sqrt66)
+                  :use ((:instance expo-unique (n -1))
+                        (:instance expo-unique (n -2))))))
+
+(local-defthm sqrt66-lower-1
+  (implies (rationalp x)
+           (and (>= x (* 2 (fl (/ x 2))))
+                (<  x (+ 2 (* 2 (fl (/ x 2)))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fl-def (x (/ x 2)))))))
+
+(local-defthm sqrt66-lower-2
+  (implies (integerp x)
+           (or (= x (* 2 (fl (/ x 2))))
+               (= x (1+ (* 2 (fl (/ x 2)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt66-lower-1))))
+
+(local-defthm sqrt66-lower-3
+  (implies (and (rationalp x)
+                (> x 0))
+           (let* ((e (1+ (fl (/ (expo x) 2))))
+                  (x0 (/ x (expt 2 (* 2 e)))))
+             (or (= x0 (/ (sig x) 2))
+                 (= x0 (/ (sig x) 4)))))
+  :rule-classes ()
+  :hints (("Goal" :use (fp-abs
+                        (:instance sqrt66-lower-2 (x (expo x)))))))
+
+(defthm x0-bounds-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (or (= x0 (/ (sig x) 2))
+                    (= x0 (/ (sig x) 4))))
+           (and (>= x0 1/4)
+                (< x0 1)))
+  :rule-classes ()
+  :hints (("Goal" :use (sig-upper-bound
+                        sig-lower-bound))))  
+
+(defthm x0-bounds
+  (let* ((e (1+ (fl (/ (expo x) 2))))
+         (x0 (/ x (expt 2 (* 2 e)))))
+    (implies (and (rationalp x)
+                  (> x 0))
+             (and (>= x0 1/4)
+                  (< x0 1))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt66-lower-3
+                        (:instance x0-bounds-1 (x0 (/ x (expt 2 (* 2 (1+ (fl (/ (expo x) 2))))))))))))
+
+(local-defthm sqrt66-lower-4
+  (implies (and (rationalp x)
+                (> x 0))
+           (and (< (/ (sig x) 4) 1)
+                (<= 1/4 (/ (sig x) 4))
+                (< (/ (sig x) 2) 1)
+                (<= 1/4 (/ (sig x) 2))))
+  :rule-classes ()
+  :hints (("Goal" :use (sig-lower-bound
+                        sig-upper-bound))))
+
+(local-defthm sqrt66-lower-5
+  (implies (and (rationalp x)
+                (> x 0)
+                (or (= x0 (/ (sig x) 2))
+                    (= x0 (/ (sig x) 4))))
+           (and (<= 1/4 x0)
+                (< x0 1)))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt66-lower-4
+                        sig-upper-bound
+                        sig-lower-bound))))
+
+(local-defthm sqrt66-lower-6
+  (implies (and (rationalp x)
+                (> x 0))
+           (let* ((e (1+ (fl (/ (expo x) 2))))
+                  (x0 (/ x (expt 2 (* 2 e)))))
+             (and (<= 1/4 x0)
+                  (< x0 1))))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt66-lower-3
+                        (:instance sqrt66-lower-5 (x0 (/ x (expt 2 (* 2 (1+ (fl (/ (expo x) 2))))))))))))
+
+(local-defthm sqrt66-lower-7
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp l)
+                (<= (* l l) x))
+           (let* ((e (1+ (fl (/ (expo x) 2))))
+                  (x0 (/ x (expt 2 (* 2 e))))
+                  (l0 (/ l (expt 2 e))))
+             (<= (* l0 l0) x0)))
+  :rule-classes ())
+
+(local-defthm sqrt66-lower-8
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp l)
+                (<= (* l l) x))
+           (<= (sticky l 66) (sqrt66 x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sqrt66)
+                  :use (sqrt66-lower-6
+                        sqrt66-lower-7
+                        (:instance sticky-shift (x (/ l (expt 2 (1+ (fl (/ (expo x) 2))))))
+                                                (n 66)
+                                                (k (1+ (fl (/ (expo x) 2)))))
+                        (:instance sticky-sqrt-lower (l (/ l (expt 2 (1+ (fl (/ (expo x) 2))))))
+                                                 (x (/ x (expt 2 (* 2 (1+ (fl (/ (expo x) 2)))))))
+                                                 (n 66))))))
+
+(defthm sqrt66-lower
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp l)
+                (<= (* l l) x)
+                (common-rounding-mode-p mode)
+                (not (zp k))
+                (<= k 64))
+           (<= (rnd l mode k)
+               (rnd (sqrt66 x) mode k)))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt66-lower-8
+                        (:instance rnd-sticky (x l) (n 66) (m k))
+                        (:instance rnd-monotone (x (sticky l 66)) (y (sqrt66 x)) (n k))))))
+
+#|
+Proof: Let e = fl(expo(x)/2), x0 = x/2^(2*e), and l0 = l/2^e.
+Then 1 <= x0 < 4 and l0^2 = l^2/2^(2*e) <= x/2^(2*e) = x0.
+By sticky-shift and sticky-sqrt-lower, 
+
+  sticky(l, 66) = 2^e * sticky(l0, 66) 
+               <= 2^e * sticky-sqrt(x0, 66)
+                = sqrt66(x).
+
+By rnd-sticky and rnd-monotone,
+
+  rnd(l, mode, k) = rnd(sticky(l, 66), mode, k)
+                 <= rnd(sqrt66(x), mode, k)
+|#
+
+(local-defthm sqrt66-upper-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x))
+           (let* ((e (1+ (fl (/ (expo x) 2))))
+                  (x0 (/ x (expt 2 (* 2 e))))
+                  (h0 (/ h (expt 2 e))))
+             (>= (* h0 h0) x0)))
+  :rule-classes ())
+
+(local-defthm sqrt66-upper-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x))
+            (>= (sticky h 66) (sqrt66 x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sqrt66)
+                  :use (sqrt66-lower-6
+                        sqrt66-upper-1
+                        (:instance sticky-shift (x (/ h (expt 2 (1+ (fl (/ (expo x) 2)))))) 
+                                                (n 66) 
+                                                (k (1+ (fl (/ (expo x) 2)))))
+                        (:instance sticky-sqrt-upper (h (/ h (expt 2 (1+ (fl (/ (expo x) 2))))))
+                                                     (x (/ x (expt 2 (* 2 (1+ (fl (/ (expo x) 2)))))))
+                                                     (n 66))))))
+
+(defthm sqrt66-upper
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp h)
+                (>= h 0)
+                (>= (* h h) x)
+                (common-rounding-mode-p mode)
+                (not (zp k))
+                (<= k 64))
+           (>= (rnd h mode k)
+               (rnd (sqrt66 x) mode k)))
+  :rule-classes ()
+  :hints (("Goal" :use (sqrt66-upper-2
+                        (:instance rnd-sticky (x h) (n 66) (m k))
+                        (:instance rnd-monotone (y (sticky h 66)) (x (sqrt66 x)) (n k))))))
+
+(defthm rnd-sqrt66-sticky-sqrt
+  (implies (and (rationalp x)
+                (> x 0)
+                (common-rounding-mode-p mode)
+                (not (zp k))
+                (natp n)
+                (>= n (+ k 2))
+                (<= n 66))
+           (let* ((e (1+ (fl (/ (expo x) 2))))
+                  (x0 (/ x (expt 2 (* 2 e)))))
+             (= (* (expt 2 e) (rnd (sticky-sqrt x0 n) mode k))
+                (rnd (sqrt66 x) mode k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sqrt66)
+                  :use (sqrt66-lower-6
+                        (:instance rnd-sticky-sqrt (x (/ x (expt 2 (* 2 (1+ (fl (/ (expo x) 2)))))))
+                                                   (m 66))
+                        (:instance rnd-shift (k (1+ (fl (/ (expo x) 2)))) 
+                                                (x (sticky-sqrt (/ x (expt 2 (* 2 (1+ (fl (/ (expo x) 2)))))) 66))
+                                                (n k))))))
+
+#|
+Proof: By rnd-sticky-sqrt and rnd-shift,
+
+  2^e * rnd(sticky-sqrt(x0, n), mode, k) = 2^e * rnd(sticky-sqrt(x0, 66), mode, k)
+                                         = rnd(2^e*sticky-sqrt(x0, 66), mode, k)
+                                         = rnd(sqrt66(x), mode, k)
+|#
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta1/srt.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta1/srt.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta1/srt.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta1/srt.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,1697 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+(local (include-book "../lib3/top"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+
+(local (include-book "seed"))
+
+;;**********************************************************************************
+;; Formula for Division Partial Remainder
+;;**********************************************************************************
+(encapsulate (((rho$) => *) ((x$) => *) ((d$) => *) ((h$ *) => *))
+  (local (defun rho$ () 1))
+  (local (defun x$ () 0))
+  (local (defun d$ () 1))
+  (local (defun h$ (k) (declare (ignore k)) 0))
+  (defthm rho$-constraint
+    (integerp (rho$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm x$-constraint
+    (rationalp (x$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm d$-constraint
+    (and (rationalp (d$))
+         (> (d$) 0))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm integerp-h$ 
+    (implies (not (zp k))
+             (integerp (h$ k)))
+    :rule-classes (:rewrite :type-prescription)))
+
+(defund p$ (k) 
+  (if (zp k)
+      (x$)
+    (- (* (expt 2 (rho$)) (p$ (1- k)))
+       (* (h$ k) (d$)))))
+
+(defund q$ (k)
+  (if (zp k)
+      0
+    (+ (q$ (1- k))
+       (/ (h$ k) (expt 2 (* k (rho$)))))))
+
+(defthmd div-remainder-formula
+  (implies (natp k)
+           (equal (p$ k)
+                  (* (expt 2 (* k (rho$)))
+                     (- (x$) (* (q$ k) (d$))))))
+  :hints (("Goal" :use (lemma-2-1))))
+
+(defthm div-remainder-formula-corollary
+  (implies (and (natp k)
+                (<= (- (d$)) (p$ k))
+                (< (p$ k) (d$)))
+           (and (<= (- (/ (expt 2 (* k (rho$)))))
+                    (- (/ (x$) (d$)) (q$ k)))
+                (< (- (/ (x$) (d$)) (q$ k))
+                   (/ (expt 2 (* k (rho$))))))) 
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-2-1-corollary))))
+
+
+;;**********************************************************************************
+;; admissible-div-table-p
+;;**********************************************************************************
+
+(defund delta0 (j n)
+  (1+ (/ j (expt 2 n))))
+
+(defund pi0 (i m)
+  (if (< i (expt 2 (1- m)))
+      (/ i (expt 2 (- m 2)))
+    (- (/ i (expt 2 (- m 2)))
+       4)))
+
+(defund div-accessible-p (i j m n)
+  (and (< (- (- (delta0 j n)) (+ (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n))))))
+
+(defund lower (i j rho m n)
+  (min (1- (expt 2 rho))
+       (if (or (< i (expt 2 (1- m)))
+               (= i (1- (expt 2 m))))
+           (1- (cg (* (expt 2 rho) 
+                      (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                         (delta0 j n)))))
+         (1- (cg (* (expt 2 rho) 
+                    (/ (+ (pi0 i m) (/ (expt 2 (- m 3))))
+                       (+ (delta0 j n) (/ (expt 2 n))))))))))
+
+(defund upper (i j rho m n)
+  (max (- 1 (expt 2 rho)) 
+       (if (< i (expt 2 (1- m)))
+           (1+ (fl (* (expt 2 rho) 
+                      (/ (pi0 i m)
+                         (+ (delta0 j n) (/ (expt 2 n)))))))
+         (1+ (fl (* (expt 2 rho) 
+                    (/ (pi0 i m)
+                       (delta0 j n))))))))
+
+(defund lookup (i j table)
+  (ifix (nth j (nth i table))))
+
+(defund check-div-entry (i j rho m n entry)
+  (or (not (div-accessible-p i j m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (<= (lower i j rho m n)
+               entry)
+           (<= entry
+               (upper i j rho m n)))))
+
+(defund check-div-row (i j rho m n row)
+  (if (zp j)
+      t
+    (and (check-div-entry i (1- j) rho m n (ifix (nth (1- j) row)))
+         (check-div-row i (1- j) rho m n row))))
+
+(defund check-div-rows (i rho m n rows)
+  (if (zp i)
+      t
+    (and (check-div-row (1- i) (expt 2 n) rho m n (nth (1- i) rows))
+         (check-div-rows (1- i) rho m n rows))))
+
+(defund admissible-div-table-p (rho m n table)
+  (check-div-rows (expt 2 m) rho m n table))
+
+;;**********************************************************************************
+;; First we prove that the definition of admissibility ensures the desired property.
+;;**********************************************************************************
+
+(defthm admissible-div-table-criterion
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (admissible-div-table-p rho m n table)
+                (natp i)
+                (< i (expt 2 m))
+                (natp j)
+                (< j (expt 2 n))
+                (rationalp p)
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (rationalp d)
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (/ (expt 2 n))))
+                (<= (- d) p) 
+                (< p d)
+                (= k (lookup i j table)))
+           (and (< (- (expt 2 rho)) k)
+                (< k (expt 2 rho))
+                (<= (- d) (- (* (expt 2 rho) p) (* d k)))
+                (< (- (* (expt 2 rho) p) (* d k)) d)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-2-2))))
+
+
+;;**********************************************************************************
+;; Next we prove the converse of the above. This requires that we define witness
+;; functions that produce a violation of the desired property for a given table that
+;; fails to satisfy the definition.
+;;**********************************************************************************
+
+;; Assume that dmin < dmax and pmin < pmax.  Consider the closed rectangle
+;;   R = {(d,p) | dmin <= d <= dmax and pmin <= p <= pmax}
+;; and the halh-open rectangle
+;;   R' = {(d,p) | dmin <= d < dmax and pmin <= p < pmax}.
+;; If there exists (d,p) in R such that p < h*d, then (d1,p1) is a point
+;; in R' with p1 < h*d1:
+
+(defund d1 (dmin pmin dmax pmax h)
+  (declare (ignore pmax))
+  (if (< pmin (* h dmin))
+      dmin
+    (/ (+ (/ pmin h) dmax) 2)))
+
+(defund p1 (dmin pmin dmax pmax h)
+  (declare (ignore dmin dmax pmax h))
+  pmin)
+
+;; If there exists (d,p) in R such that p > h*d, then (d2,p2) is a point
+;; in R' with p1 > h*d1:
+
+(defund d2 (dmin pmin dmax pmax h)
+  (declare (ignore pmin))
+  (if (> pmax (* h dmin))
+      dmin
+    (/ (+ (/ pmax h) dmax) 2)))
+
+(defund p2 (dmin pmin dmax pmax h)
+  (let ((d2 (d2 dmin pmin dmax pmax h)))
+    (if (> pmin (* h d2))
+        pmin
+      (/ (+ (* h d2) pmax) 2))))
+
+;; If (d1,p1) and (d2,p2) are in points in R' such that p1 < h*d1 and
+;; p2 > h*d2, then (d3,p3) is in R' and p3 = h*d3:
+
+(defund d3 (d1 p1 d2 p2 h)
+  (if (= h 0)
+      d1
+    (if (<= p1 p2)
+        (if (<= p2 (* h d1))
+            (/ p2 h)
+          d1)
+      (if (<= p1 (* h d2))          
+          d2
+        (/ p1 h)))))
+
+(defund p3 (d1 p1 d2 p2 h)
+  (if (= h 0)
+      0
+    (if (<= p1 p2)
+        (if (<= p2 (* h d1))
+            p2
+          (* h d1))
+      (if (<= p1 (* h d2))
+          (* h d2)
+        p1))))
+
+;; Assume hmin < hmax.  If there exist (d1,p1) and (d2,p2) in R such 
+;; that p1 < hmax*d1 and p2 > hmin*d2, then (d4,p4) is in R' and 
+;; hmin*d4 < p4 < hmax*d4:
+
+(defund d4 (dmin pmin dmax pmax hmin hmax)
+  (let ((d1 (d1 dmin pmin dmax pmax hmax))
+        (p1 (p1 dmin pmin dmax pmax hmax)))
+    (if (> p1 (* hmin d1))
+        d1
+      (let ((d2 (d2 dmin pmin dmax pmax hmin))
+            (p2 (p2 dmin pmin dmax pmax hmin)))
+        (if (< p2 (* hmax d2))
+            d2
+          (d3 d1 p1 d2 p2 (/ (+ hmin hmax) 2)))))))
+
+(defund p4 (dmin pmin dmax pmax hmin hmax)
+  (let ((d1 (d1 dmin pmin dmax pmax hmax))
+        (p1 (p1 dmin pmin dmax pmax hmax)))
+    (if (> p1 (* hmin d1))
+        p1
+      (let ((d2 (d2 dmin pmin dmax pmax hmin))
+            (p2 (p2 dmin pmin dmax pmax hmin)))
+        (if (< p2 (* hmax d2))
+            p2
+          (p3 d1 p1 d2 p2 (/ (+ hmin hmax) 2)))))))
+
+;; Suppose that admissible-div-table-p rho m n table) = NIL.
+;; Let i = (i-witness rho m n table), j = (j-witness rho m n table),
+;; and entry = (nth j (nth i table)
+;; Then 0 <= i < 2^m, 0 <= j < 2^n, and
+;; (check-div-entry i j rho m n entry) = NIL.
+;; Let d = (d-witness rho m n table) and p = (p-witness rho m n table).
+;; If -2^rho < entry < 2^rho, then (d,p) is in S_ij, |p| <= d, and
+;;   |2^rho * p - entry * d| > d:
+
+(defund i-witness-aux (i rho m n table)
+  (if (zp i)
+      ()
+    (if (check-div-row (1- i) (expt 2 n) rho m n (nth (1- i) table))
+        (i-witness-aux (1- i) rho m n table)
+      (1- i))))
+ 
+(defund i-witness (rho m n table)
+  (i-witness-aux (expt 2 m) rho m n table))
+
+(defund j-witness-aux (i j rho m n row)
+  (if (zp j)
+      ()
+    (if (check-div-entry i (1- j) rho m n (ifix (nth (1- j) row)))
+        (j-witness-aux i (1- j) rho m n row)
+      (1- j))))
+
+(defund j-witness (rho m n table)
+  (let ((i (i-witness rho m n table)))
+    (j-witness-aux i (expt 2 n) rho m n (nth i table))))
+
+(defund d-witness (rho m n table)
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (entry (lookup i j table)))
+    (if (or (>= entry (expt 2 rho))
+            (<= entry (- (expt 2 rho))))
+        (d4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            1)
+      (if (< entry (lower i j rho m n))
+          (d4 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              (/ (1+ entry) (expt 2 rho))
+              1)
+        (d4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            (/ (1- entry) (expt 2 rho)))))))
+
+(defund p-witness (rho m n table)
+  (let* ((i (i-witness rho m n table))
+         (j (j-witness rho m n table))
+         (entry (lookup i j table)))
+    (if (or (>= entry (expt 2 rho))
+            (<= entry (- (expt 2 rho))))
+        (p4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            1)
+      (if (< entry (lower i j rho m n))
+          (p4 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              (/ (1+ entry) (expt 2 rho))
+              1)
+        (p4 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            -1
+            (/ (1- entry) (expt 2 rho)))))))
+
+(defthm admissible-div-table-criterion-converse
+    (implies (and (not (zp m))
+                  (not (zp n))
+                  (not (zp rho))
+                  (not (admissible-div-table-p rho m n table)))
+             (let* ((i (i-witness rho m n table))
+                    (j (j-witness rho m n table))
+                    (p (p-witness rho m n table))
+                    (d (d-witness rho m n table))
+                    (k (lookup i j table)))
+               (and (natp i)
+                    (< i (expt 2 m))
+                    (natp j)
+                    (< j (expt 2 n))
+                    (rationalp d)
+                    (rationalp p)
+                    (< (abs p) d)
+                    (<= (delta0 j n) d)
+                    (< d (+ (delta0 j n) (/ (expt 2 n))))
+                    (<= (pi0 i m) p)
+                    (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                    (or (<= k (- (expt 2 rho)))
+                        (>= k (expt 2 rho))
+                        (> (abs (- (* (expt 2 rho) p) (* d k))) d)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-2-2-converse))))
+
+;;**********************************************************************************
+;; Existence of SRT Table for Division
+;;**********************************************************************************
+
+(defund srt-entry (i j rho m n)
+  (max (- 1 (expt 2 rho)) 
+       (lower i j rho m n)))
+
+(defund srt-row (i j rho m n)
+  (declare (xargs :measure (nfix (- (expt 2 n) j))))
+  (if (and (natp j)
+           (natp n)
+           (< j (expt 2 n)))
+      (cons (srt-entry i j rho m n)
+            (srt-row i (1+ j) rho m n))
+    ()))
+
+(defund srt-rows (i rho m n)
+  (declare (xargs :measure (nfix (- (expt 2 m) i))))
+  (if (and (natp i)
+           (natp m)
+           (< i (expt 2 m)))
+      (cons (srt-row i 0 rho m n)
+            (srt-rows (1+ i) rho m n))
+    ()))
+
+(defund srt-table (rho m n)
+  (srt-rows 0 rho m n))
+
+(defthm admissible-div-table-p-2-5-2
+  (admissible-div-table-p 2 5 2 (srt-table 2 5 2))
+  :rule-classes ())
+
+(defthm admissible-div-table-p-3-7-3
+  (admissible-div-table-p 3 7 3 (srt-table 3 7 3))
+  :rule-classes ())
+
+(defund check-exists-div-entry (i j rho m n)
+  (or (not (div-accessible-p i j m n))
+      (<= (lower i j rho m n)
+          (upper i j rho m n))))
+
+(defund check-exists-div-row (i j rho m n)
+  (if (zp j)
+      t
+    (and (check-exists-div-entry i (1- j) rho m n)
+         (check-exists-div-row i (1- j) rho m n))))
+
+(defund check-exists-div-rows (i rho m n)
+  (if (zp i)
+      t
+    (and (check-exists-div-row (1- i) (expt 2 n) rho m n)
+         (check-exists-div-rows (1- i) rho m n))))
+
+(defund exists-div-table-p (rho m n)
+  (check-exists-div-rows (expt 2 m) rho m n))
+
+(defthm div-table-existence-a
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (exists-div-table-p rho m n))
+           (admissible-div-table-p rho m n (srt-table rho m n)))
+  :hints (("Goal" :use (lemma-2-3-a))))
+
+(defthm div-table-existence-b
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (admissible-div-table-p rho m n table))
+           (exists-div-table-p rho m n))
+  :hints (("Goal" :use (lemma-2-3-b))))
+
+;;**********************************************************************************
+;; Main Theorem on Division
+;;**********************************************************************************
+
+(encapsulate (((rho%) => *) ((m%) => *) ((n%) => *) ((table%) => *) ((d%) => *) ((x%) => *) ((j%) => *)
+              ((p% *) => *) ((h% *) => *) ((i% *) => *))
+
+(local (defun rho% () 2))
+(local (defun m% () 5))
+(local (defun n% () 2))
+(local (defun table% () (srt-table 2 5 2)))
+(local (defun d% () 1))
+(local (defun x% () 0))
+(local (defun j% () (fl (* (expt 2 (n%)) (1- (d%))))))
+
+(local (mutual-recursion
+
+(defun p% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      (x%)
+    (- (* (expt 2 (rho%)) (p% (1- k)))
+       (* (h% k) (d%)))))
+
+(defun h% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 1)))
+  (lookup (i% k) (j%) (table%)))
+
+(defun i% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (bits (fl (* (expt 2 (- (m%) 2)) (p% (1- k)))) (1- (m%)) 0)))
+))
+
+(defthmd rho%-constraint
+  (not (zp (rho%))))
+
+(defthmd m%-constraint
+  (not (zp (m%))))
+
+(defthmd n%-constraint
+  (not (zp (n%))))
+
+(defthmd table%-constraint
+  (admissible-div-table-p (rho%) (m%) (n%) (table%)))
+
+(defthmd d%-constraint
+  (and (rationalp (d%))
+       (<= 1 (d%))
+       (< (d%) 2)))
+
+(defthmd x%-constraint
+  (and (rationalp (x%))
+       (< (abs (x%)) (d%))))
+
+(defthmd p%-def
+  (equal (p% k)
+         (if (zp k)
+             (x%)
+           (- (* (expt 2 (rho%)) (p% (1- k)))
+              (* (h% k) (d%)))))
+  :rule-classes (:definition))
+
+(defthmd h%-def
+  (equal (h% k)
+         (lookup (i% k) (j%) (table%)))
+  :rule-classes (:definition))
+
+(defthmd i%-constraint
+  (implies (and (not (zp k))
+                (rationalp (p% (1- k)))
+                (< (abs (p% (1- k))) 2))
+           (and (bvecp (i% k) (m%))
+                (<= (pi0 (i% k) (m%))
+                    (p% (1- k)))
+                (< (p% (1- k))
+                   (+ (pi0 (i% k) (m%))
+                      (/ (expt 2 (- (m%) 3)))))))
+  :hints (("Goal" :use ((:instance i-bounds (p (p% (1- k))) (m (m%)))))))
+
+(defthmd j%-constraint
+  (and (bvecp (j%) (n%))
+       (<= (delta0 (j%) (n%)) (d%))
+       (< (d%) (+ (delta0 (j%) (n%)) (expt 2 (- (n%))))))
+  :hints (("Goal" :use ((:instance j-bounds (d (d%)) (n (n%)))))))
+
+)
+
+(defund q% (k)
+  (if (zp k)
+      0
+    (+ (q% (1- k))
+       (/ (h% k) (expt 2 (* k (rho%)))))))
+
+(defthm srt-div-theorem-a
+  (implies (natp k)
+           (and (<= (- (/ (expt 2 (* k (rho%)))))
+                    (- (/ (x%) (d%)) (q% k)))
+                (< (- (/ (x%) (d%)) (q% k))
+                   (/ (expt 2 (* k (rho%)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-1-a))))
+
+(defthm srt-div-theorem-b
+  (< (abs (p% k)) 2)
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-1-b))))
+
+(defthm srt-div-theorem-c
+  (implies (not (zp k))
+           (div-accessible-p (i% k) (j%) (m%) (n%)))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-1-c))))
+
+
+;;**********************************************************************************
+;; Formula for Square RooPArtial Remainder
+;;**********************************************************************************
+
+(encapsulate (((rho$$) => *) ((x$$) => *) ((h$$ *) => *))
+  (local (defun rho$$ () 1))
+  (local (defun x$$ () 0))
+  (local (defun h$$ (k) (declare (ignore k)) 0))
+  (defthm rho$$-constraint
+    (integerp (rho$$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm x$$-constraint
+    (rationalp (x$$))
+    :rule-classes (:rewrite :type-prescription))
+  (defthm integerp-h$$ 
+    (implies (not (zp k))
+             (integerp (h$$ k)))
+    :rule-classes (:rewrite :type-prescription)))
+
+(defund q$$ (k)
+  (if (zp k)
+      0
+    (+ (q$$ (1- k))
+       (/ (h$$ k) (expt 2 (* k (rho$$)))))))
+
+(defund p$$ (k) 
+  (if (zp k)
+      (x$$)
+    (- (* (expt 2 (rho$$)) (p$$ (1- k)))
+       (* (h$$ k) 
+          (+ (* 2 (q$$ (1- k))) 
+             (/ (h$$ k) (expt 2 (* k (rho$$)))))))))
+
+(defthmd sqrt-remainder-formula
+  (implies (natp k)
+           (equal (p$$ k)
+                  (* (expt 2 (* k (rho$$)))
+                     (- (x$$) (* (q$$ k) (q$$ k))))))
+  :hints (("Goal" :use (lemma-3-1))))
+
+;;**********************************************************************************
+;; Equivalemt Bounds on Partial Remainder
+;;**********************************************************************************
+
+(defthm equiv-bounds-a-b
+  (implies (not (zp k))
+           (iff (and (<= (* (- (q$$ k) (expt 2 (- (* k (rho$$))))) (- (q$$ k) (expt 2 (- (* k (rho$$))))))
+                         (x$$))
+                     (< (x$$)
+                        (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) (+ (q$$ k) (expt 2 (- (* k (rho$$))))))))
+                (and (<= (- (* 2 (q$$ k)))
+                         (- (p$$ k) (expt 2 (- (* k (rho$$))))))
+                     (< (- (p$$ k) (expt 2 (- (* k (rho$$)))))
+                        (* 2 (q$$ k))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-a-b))))
+
+(defthm equiv-bounds-b-c
+  (implies (not (zp k))
+           (iff (and (<= (- (* 2 (q$$ k)))
+                         (- (p$$ k) (expt 2 (- (* k (rho$$))))))
+                     (< (- (p$$ k) (expt 2 (- (* k (rho$$)))))
+                        (* 2 (q$$ k))))
+                (and (<= (* (expt 2 (- (rho$$)))
+                            (1- (h$$ k))
+                            (+ (* 2 (q$$ (1- k)))
+                               (* (1- (h$$ k)) (expt 2 (- (* k (rho$$)))))))
+                         (p$$ (1- k)))
+                     (< (p$$ (1- k))
+                        (* (expt 2 (- (rho$$)))
+                           (1+ (h$$ k))
+                           (+ (* 2 (q$$ (1- k)))
+                              (* (1+ (h$$ k)) (expt 2 (- (* k (rho$$)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-2-b-c))))
+
+
+;;**********************************************************************************
+;; Lemma 3.3
+;;**********************************************************************************
+
+(defthm sqrt-partial-remainder-bounds
+  (implies (and (not (zp (rho$$)))
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (<= (* (- (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))) (- (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))))
+                    (x$$))
+                (< (x$$)
+                   (* (+ (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))) (+ (q$$ (1- k)) (expt 2 (- (* (1- k) (rho$$))))))))
+           (< (abs (p$$ (1- k))) 2))
+  :rule-classes()
+  :hints (("Goal" :use lemma-3-3-a)))
+
+(defthm partial-root-bounds
+  (implies (and (not (zp (rho$$)))
+                (> (x$$) 1/4)
+                (natp k)
+                (> k 1)
+                (<= 1/2 (q$$ (1- k)))                
+                (< (q$$ (1- k)) 1)
+                (< (h$$ k) (expt 2 (rho$$)))
+                (> (h$$ k) (- (expt 2 (rho$$))))
+                (<= (x$$) (* (+ (q$$ k) (expt 2 (- (* k (rho$$))))) 
+                             (+ (q$$ k) (expt 2 (- (* k (rho$$))))))))
+           (and (<= 1/2 (q$$ k))
+                (< (q$$ k) 1)))
+  :rule-classes()
+  :hints (("Goal" :use (lemma-3-3-b))))
+
+
+;;**********************************************************************************
+;; admissible-for-iteration-p
+;;**********************************************************************************
+
+(defund sqrt-accessible-p (i j k rho m n)
+  (and (< (- (expt 2 (* (- 1 k) rho)) (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n)) (expt 2 (* (- 1 k) rho))))))
+
+(defund check-upper-bound (entry i j k rho m n)
+  (or (= entry (1- (expt 2 rho)))
+      (<= (+ (pi0 i m) (expt 2 (- 3 m)))
+          (if (or (< i (expt 2 (1- m)))
+                  (= i (1- (expt 2 m))))
+              (* (/ (1+ entry) (expt 2 rho))
+                 (+ (delta0 j n) (* (1+ entry) (expt 2 (- (* k rho))))))
+            (* (/ (1+ entry) (expt 2 rho))
+               (+ (delta0 j n) (expt 2 (- n)) (* (1+ entry) (expt 2 (- (* k rho))))))))))
+
+(defund check-lower-bound (entry i j k rho m n)
+  (or (= entry (- 1 (expt 2 rho)))
+      (>= (pi0 i m)
+          (if (< i (expt 2 (1- m)))
+              (* (/ (1- entry) (expt 2 rho))
+                 (+ (delta0 j n) (expt 2 (- n)) (* (1- entry) (expt 2 (- (* k rho))))))
+            (* (/ (1- entry) (expt 2 rho))
+               (+ (delta0 j n) (* (1- entry) (expt 2 (- (* k rho))))))))))
+
+(defund check-sqrt-entry (i j k rho m n entry)
+  (or (not (sqrt-accessible-p i j k rho m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (check-upper-bound entry i j k rho m n)
+           (check-lower-bound entry i j k rho m n))))
+
+(defund check-sqrt-row (i j k rho m n row)
+  (if (zp j)
+      t
+    (and (check-sqrt-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+         (check-sqrt-row i (1- j) k rho m n row))))
+
+(defund check-sqrt-rows (i k rho m n rows)
+  (if (zp i)
+      t
+    (and (check-sqrt-row (1- i) (expt 2 n) k rho m n (nth (1- i) rows))
+         (check-sqrt-rows (1- i) k rho m n rows))))
+
+(defund admissible-for-iteration-p (k rho m n table)
+  (check-sqrt-rows (expt 2 m) k rho m n table))
+
+;;**********************************************************************************
+;; First we prove that the definition of admissibility ensures the desired property.
+;;**********************************************************************************
+
+(defthm admissible-sqrt-table-criterion
+  (implies (and (natp m)
+                (natp n)
+                (natp rho)
+                (not (zp k))
+                (admissible-for-iteration-p k rho m n table)
+                (rationalp d)
+                (rationalp p)
+                (<= (- d) (- p (expt 2 (* (- 1 k) rho))))
+                (< (- p (expt 2 (* (- 1 k) rho))) d)
+                (natp j)
+                (< j (expt 2 n))
+                (<= (delta0 j n) d)
+                (< d (+ (delta0 j n) (expt 2 (- n))))
+                (natp i)
+                (< i (expt 2 m))
+                (<= (pi0 i m) p)
+                (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                (= h (lookup i j table)))
+          (and (< h (expt 2 rho))
+               (> h (- (expt 2 rho)))
+               (< p
+                 (* (/ (1+ h) (expt 2 rho))
+                    (+ d (* (1+ h) (expt 2 (- (* k rho)))))))  
+               (>= p              
+                  (* (/ (1- h) (expt 2 rho))
+                     (+ d (* (1- h) (expt 2 (- (* k rho)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-4))))
+
+;;**********************************************************************************
+;; Next we prove the converse of the above. This requires that we define witness
+;; functions that produce a violation of the desired property for a given table that
+;; fails to satisfy the definition for a given k.
+;;**********************************************************************************
+
+;; Assume that dmin < dmax and pmin < pmax.  Consider the closed rectangle
+;;   R = {(d,p) | dmin <= d <= dmax and pmin <= p <= pmax},
+;; the half-closed rectangle
+;;   R' = {(d,p) | dmin <= d < dmax and pmin <= p < pmax},
+;; and the quarter-closed rectangle
+;;   R" = {(d,p) | dmin < d < dmax and pmin <= p < pmax}.
+;; If there exists (d,p) in R such that p < h*d + b, then (d5,p5) is a point
+;; in R" with p5 < h*d5 + b:
+
+(defund d5 (dmin pmin dmax pmax h b)
+  (let ((d1 (d1 dmin (- pmin b) dmax (- pmax b) h))
+        (p1 (+ b (p1 dmin (- pmin b) dmax (- pmax b) h))))
+    ;; (d1,p1) is in R' and p1 < h*d1 + b.
+    (if (> d1 dmin)
+        d1
+      (if (>= (+ (* h dmax) b) p1)
+          (/ (+ dmin dmax) 2)
+        (/ (+ (/ (- p1 b) h) dmin) 2)))))
+
+(defund p5 (dmin pmin dmax pmax h b)
+  (+ b (p1 dmin (- pmin b) dmax (- pmax b) h)))
+
+;; If there exists (d,p) in R such that p > h*d + b, then (d6,p6) is a point
+;; in R" with p6 > h*d6 + b:
+
+(defund d6 (dmin pmin dmax pmax h b)
+  (let ((d2 (d2 dmin (- pmin b) dmax (- pmax b) h))
+        (p2 (+ b (p2 dmin (- pmin b) dmax (- pmax b) h))))
+    ;; (d2,p2) is in R' and p2 > h*d2 + b.
+    (if (> d2 dmin)
+        d2
+      (if (>= p2 (+ (* h dmax) b))
+          (/ (+ dmin dmax) 2)
+        (/ (+ (/ (- p2 b) h) dmin) 2)))))
+
+(defund p6 (dmin pmin dmax pmax h b)
+  (+ b (p2 dmin (- pmin b) dmax (- pmax b) h)))
+
+;; Assume h2 < h1 and h2 + b2 <= h1 + b1.  Then for all d > 1,
+;
+;;   (h1*d + b1) - (h2*d + b2) = (h1 - h2)*d + (b1 - b2)
+;;                             > (h1 - h2) + (b1 - b2)
+;;                             >= 0.
+;;
+;; Assume dmin >= 1.  If there exist (d1,p1) and (d2,p2) in R such that
+;; p1 < h1*d1 + b1 and p2 > h2*d2 + b2, then (d7,p7) is in R" and 
+;; h2*d7 + b2 < p7 < h1*d7 + b1:
+
+(defund d7 (dmin pmin dmax pmax h1 b1 h2 b2)
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2)))
+    (if (> p5 (+ (* h2 d5) b2))
+        d5
+      (if (< p6 (+ (* h1 d6) b1))
+          d6
+        (if (<= p5 (+ (* h2 d6) b2))
+            d6
+          (if (>= p5 (+ (* h1 d6) b1))
+              (/ (+ (/ (- p5 b1) h1) (/ (- p5 b2) h2)) 2)
+            d6))))))
+
+(defund p7 (dmin pmin dmax pmax h1 b1 h2 b2)
+  (let ((d5 (d5 dmin pmin dmax pmax h1 b1))
+        (p5 (p5 dmin pmin dmax pmax h1 b1))
+        (d6 (d6 dmin pmin dmax pmax h2 b2))
+        (p6 (p6 dmin pmin dmax pmax h2 b2)))
+    (if (> p5 (+ (* h2 d5) b2))
+        p5
+      (if (< p6 (+ (* h1 d6) b1))
+          p6
+        (if (<= p5 (+ (* h2 d6) b2))
+            (/ (+ (* (+ h1 h2) d6) b1 b2) 2)
+          p5)))))
+
+;; We have p5 < h1*d5 + b1 and p6 > h2*d6 + b2.
+;; The claim is proved by the following case analysis:
+
+;; Case 1: p5 > h2*d5 + b2.
+;;   (d7,p7) = (d5,p5).
+;;   h2*d7 + b2 = h2*d5 + b2  < p5 = p7 < h1*d7 + b1.
+
+;; Case 2: p6 < h1*d6 + b1.
+;;   (d7,p7) = (d6,p6).
+;;   h2*d7 + b2 = h2*d6 + b2 < p6 = p7 < h1*d6 + b1.
+
+;; Case 3: p6 >= h1*d6 + b1, p5 <= h2*d6 + b2.
+;;   (d7,p7) = (d6,((h1+h2)*d6+b1+b1)/2).
+;;   Let y1 = h1*d6 + b1 and y2 = h2*d6 + b2.  Then p7 = (y1+y2)/2 and
+;;   h2*d7 + b2 = h2*d6 + b2 < h1*d6 + b1 = h1*d7 + b1.
+;;   Since p5 <= y2 < y1 <= p6, pmin < p5 < p7 < p6 < pmax.
+
+;; Case 4: p5 <= h2*d5 + b2, p5 > h2*d6 + b2, p5 >= h1*d6 + b1.
+;;   (d7,p7) = ((x1+x2)/2,p5), where x1 = (p5-b1)/h1 and x2 = (p5-b2)/h2.
+;;   Since h2*d6 + b2 < p5 <= h2*d5 + b2, h2*(d5 - d6) > 0.
+
+;;   Case 4a: d5 > d6.
+;;     h1 > h2 > 0.
+;;     Since h2*d6 + b2 < p5 <= h2*d5 + b2, d6 < (p5-b2)/h2 = x2 < d5.
+;;     Since p5 >= h1*d6 + b1, x1 = (p5-b1)/h1 >= d6.
+;;     Since h1*(x2 - x1) = h1*x2 - p5 + b1
+;;                        = h1*x2 - (h2*x2 + b2) + b1
+;;                        = (h1*x2 + b1) - (h2*x2 + b2)
+;;                        > 0,
+;;     x2 > x1.
+;;     Thus, dmin < d6 <= x1 < x2 < d5 < dmax and
+;;     (p5-b1)/h1 = x1 < d7 < x2 = (p5-b2)/h2, which implies
+;;     h2*d7 + b2 < p5 < h1*d7 + b1.
+
+;;   Case 4b: d5 < d6.
+;;     h2 < 0 and d5 <= (p5-b2)/h2 = x2 < d6.
+;;     Since h1*d5 + b1 > h2*d5 + b2 >= p5 >= h1*d6 + b1,
+;;     h1*(d6 - d5) < 0, which implies h1 < 0.
+;;     Since p5 >= h1*d6 + b1, x1 = (p5-b1)/h1 <= d6.
+;;     Since p5 <= h2*d5 + b2 < h1*d5 + b1, (p5-b1)/h1 > d5 > 1.
+;;     Since h2*(x1-x2) = h2*x1 - p5 + b2
+;;                      = h2*x1 - (h2*x1 + b2) + b1
+;;                      = (h2*x1 + b1) - (h2*x1 + b2)
+;;                      < 0,
+;;     x1 > x2.
+;;     Thus, dmin < d5 <= x2 < x1 <= d6 < dmax and
+;;     (p5-b2)/h2 = x2 < d7 < x1 = (p5-b1)/h1, which implies
+;;     h2*d7 + b2 < p5 < h1*d7 + b1.
+
+;;   Case 5: p5 > h2*d6 + b2, p5 < h1*d6 + b1.
+;;     (d7,p7) = (d6,p5).
+;;     h2*d7 + b2 = h2*d6 + b2 > p5 = p7 < h1*d7 + b1 = h1*d6 + b1.
+
+
+;; Suppose that (admissible-for-iteration-p k rho m n table) = NIL.
+;; Let i = (i-sqrt k rho m n table), j = (j-sqrt k rho m n table),
+;; and h = (lookup i j table).
+;; Then 0 <= i < 2^m, 0 <= j < 2^n, and
+;; (check-sqrt-entry i j k rho m n h) = NIL.
+;; Let d = (d-sqrt k rho m n table) and p = (p-sqrt k rho m n table).
+;; Then (d,p) is in S_ij and |p - 2^((1-k)*rho)| < d.
+;; If -2^rho < h < 2^rho, then either
+;;   p < ((h-1)/2^rho)*(d + (h-1)2^(-k*rho))
+;; or
+;;   p > ((h+1)/2^rho)*(d + (h+1)2^(-k*rho)).
+
+(defund i-sqrt-aux (i k rho m n table)
+  (if (zp i)
+      ()
+    (if (check-sqrt-row (1- i) (expt 2 n) k rho m n (nth (1- i) table))
+        (i-sqrt-aux (1- i) k rho m n table)
+      (1- i))))
+ 
+(defund i-sqrt (k rho m n table)
+  (i-sqrt-aux (expt 2 m) k rho m n table))
+
+(defund j-sqrt-aux (i j k rho m n row)
+  (if (zp j)
+      ()
+    (if (check-sqrt-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+        (j-sqrt-aux i (1- j) k rho m n row)
+      (1- j))))
+
+(defund j-sqrt (k rho m n table)
+  (let ((i (i-sqrt k rho m n table)))
+    (j-sqrt-aux i (expt 2 n) k rho m n (nth i table))))
+
+(defund d-sqrt (k rho m n table)
+  (let* ((i (i-sqrt k rho m n table))
+         (j (j-sqrt k rho m n table))
+         (h (lookup i j table)))
+    (if (or (not (integerp h))
+            (>= h (expt 2 rho))
+            (<= h (- (expt 2 rho))))
+        (d7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            1
+            (expt 2 (* (- 1 k) rho))
+            -1
+            (expt 2 (* (- 1 k) rho)))
+      (if (not (check-upper-bound h i j k rho m n))
+          (d7 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              1
+              (expt 2 (* (- 1 k) rho))
+              (/ (1+ h) (expt 2 rho))
+              (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+        (d7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            (/ (1- h) (expt 2 rho))
+            (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+            -1
+            (expt 2 (* (- 1 k) rho)))))))
+
+(defund p-sqrt (k rho m n table)
+  (let* ((i (i-sqrt k rho m n table))
+         (j (j-sqrt k rho m n table))
+         (h (lookup i j table)))
+    (if (or (not (integerp h))
+            (>= h (expt 2 rho))
+            (<= h (- (expt 2 rho))))
+        (p7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            1
+            (expt 2 (* (- 1 k) rho))
+            -1
+            (expt 2 (* (- 1 k) rho)))
+      (if (not (check-upper-bound h i j k rho m n))
+          (p7 (delta0 j n) 
+              (pi0 i m) 
+              (+ (delta0 j n) (expt 2 (- n)))
+              (+ (pi0 i m) (expt 2 (- 3 m)))
+              1
+              (expt 2 (* (- 1 k) rho))
+              (/ (1+ h) (expt 2 rho))
+              (* (1+ h) (1+ h) (expt 2 (- (* (1+ k) rho)))))
+        (p7 (delta0 j n) 
+            (pi0 i m) 
+            (+ (delta0 j n) (expt 2 (- n)))
+            (+ (pi0 i m) (expt 2 (- 3 m)))
+            (/ (1- h) (expt 2 rho))
+            (* (1- h) (1- h) (expt 2 (- (* (1+ k) rho))))
+            -1
+            (expt 2 (* (- 1 k) rho)))))))
+
+(defthm admissible-sqrt-table-criterion-converse
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (> k 1)
+                (not (admissible-for-iteration-p k rho m n table)))
+           (let* ((i (i-sqrt k rho m n table))
+                  (j (j-sqrt k rho m n table)) 
+                  (p (p-sqrt k rho m n table))
+                  (d (d-sqrt k rho m n table))
+                  (h (lookup i j table)))
+             (and (natp i)
+                  (< i (expt 2 m))
+                  (natp j)
+                  (< j (expt 2 n))
+                  (rationalp d)
+                  (rationalp p)
+                  (<= (delta0 j n) d)
+                  (< d (+ (delta0 j n) (/ (expt 2 n))))
+                  (<= (pi0 i m) p)
+                  (< p (+ (pi0 i m) (/ (expt 2 (- m 3)))))
+                  (< (abs (- p (expt 2 (* (- 1 k) rho)))) d)
+                  (or (<= h (- (expt 2 rho)))
+                      (>= h (expt 2 rho))
+                      (< p (* (/ (1- h) (expt 2 rho))
+                              (+ d (* (1- h) (expt 2 (- (* k rho)))))))
+                      (> p (* (/ (1+ h) (expt 2 rho))
+                              (+ d (* (1+ h) (expt 2 (- (* k rho)))))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-4-converse))))
+
+
+;;**********************************************************************************
+;; Main Theorem on Square Root
+;;**********************************************************************************
+
+(defthm admissible-for-iteration-p-2-2-6-2
+  (implies (and (natp k)
+                (> k 2))
+           (admissible-for-iteration-p k 2 6 2 (srt-table 2 6 2))))
+
+(encapsulate (((rho%%) => *) ((m%%) => *) ((n%%) => *) ((k%%) => *) ((table%%) => *))
+
+(local (defun rho%% () 2))
+(local (defun m%% () 6))
+(local (defun n%% () 2))
+(local (defun k%% () 2))
+(local (defun table%% () (srt-table 2 6 2)))
+
+(defthmd rho%%-constraint
+  (not (zp (rho%%))))
+
+(defthmd m%%-constraint
+  (not (zp (m%%))))
+
+(defthmd n%%-constraint
+  (not (zp (n%%))))
+
+(defthmd k%%-constraint
+  (and (natp (k%%)) (> (k%%) 1)))
+
+(defthm table%%-constraint
+  (implies (and (natp k)
+                (> k (k%%)))
+           (admissible-for-iteration-p k (rho%%) (m%%) (n%%) (table%%)))
+  :hints (("Goal" :in-theory (disable srt-table (table%%) (srt-table)))))
+
+)
+
+(encapsulate (((x%%) => *) ((p%% *) => *) ((q%% *) => *) ((h%% *) => *) ((i%% *) => *) ((j%% *) => *))
+
+(local (defun x%% () 1/2))
+
+(local (mutual-recursion
+
+(defun p%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      (x%%)
+    (- (* (expt 2 (rho%%)) (p%% (1- k)))
+       (* (h%% k) (+ (* 2 (q%% (1- k))) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))))
+
+(defun q%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 2)))
+  (if (zp k)
+      0
+    (+ (q%% (1- k)) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))
+
+(defun h%% (k)
+  (declare (xargs :measure (+ (* 3 (nfix k)) 1)))
+  (lookup (i%% k) (j%% k) (table%%)))
+
+(defun i%% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (bits (fl (* (expt 2 (- (m%%) 2)) (p%% (1- k)))) (1- (m%%)) 0)))
+
+(defun j%% (k)
+  (declare (xargs :measure (* 3 (nfix k))))
+  (if (zp k)
+      ()
+    (fl (* (expt 2 (n%%)) (1- (* 2 (q%% (1- k))))))))
+
+))
+
+(defthmd x%%-constraint
+  (and (rationalp (x%%))
+       (< 1/4 (x%%))
+       (< (x%%) 1)))
+
+(defthm p%%-def
+  (equal (p%% k)
+         (if (zp k)
+             (x%%)
+           (- (* (expt 2 (rho%%)) (p%% (1- k)))
+              (* (h%% k) (+ (* 2 (q%% (1- k))) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))))
+  :rule-classes (:definition))
+
+(defthm q%%-def
+  (equal (q%% k)
+         (if (zp k)
+             0
+           (+ (q%% (1- k)) (* (expt 2 (- (* k (rho%%)))) (h%% k)))))
+  :rule-classes (:definition))
+
+(defthm integerp-h%%
+  (integerp (h%% k))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthmd h%%-def
+  (implies (and (natp k)
+                (> k (k%%)))
+           (equal (h%% k)
+                  (lookup (i%% k) (j%% k) (table%%))))
+  :rule-classes (:definition))
+
+(defun all-sqrt-accessible-p%% (k)
+  (if (or (zp k) (<= k (k%%)))
+      t
+    (and (sqrt-accessible-p (i%% k) (j%% k) k (rho%%) (m%%) (n%%))
+         (all-sqrt-accessible-p%% (1- k)))))
+
+(defthmd i%%-constraint
+  (implies (and (natp k)
+                (> k (k%%))
+                (rationalp (p%% (1- k)))
+                (< (abs (p%% (1- k))) 2)
+                (all-sqrt-accessible-p%% (1- k)))
+           (and (bvecp (i%% k) (m%%))
+                (<= (pi0 (i%% k) (m%%))
+                    (p%% (1- k)))
+                (< (p%% (1- k))
+                   (+ (pi0 (i%% k) (m%%))
+                      (/ (expt 2 (- (m%%) 3)))))))
+  :hints (("Goal" :use (m%%-constraint 
+                        k%%-constraint 
+                        (:instance i-bounds (p (p%% (1- k))) (m (m%%)))
+                        (:instance local-lemma (x (P%% (+ -1 K)))
+                                               (y1 (EXPT 2 (+ 2 (- (M%%)))))
+                                               (y2 (EXPT 2 (+ 3 (- (M%%)))))
+                                               (z (pi0 (i%% k) (m%%))))))))
+
+(defthmd j%%-constraint
+  (implies (and (natp k)
+                (> k (k%%))
+                (rationalp (q%% (1- k)))
+                (<= 1/2 (q%% (1- k)))
+                (< (q%% (1- k)) 1))
+           (and (bvecp (j%% k) (n%%))
+                (<= (delta0 (j%% k) (n%%)) (* 2 (q%% (1- k))))
+                (< (* 2 (q%% (1- k))) (+ (delta0 (j%% k) (n%%)) (expt 2 (- (n%%)))))))
+  :hints (("Goal" :use (n%%-constraint (:instance j-bounds (d (* 2 (q%% (1- k)))) (n (n%%)))))))
+
+)
+
+(defthm srt-sqrt-theorem-a
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                            (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (>= k (k%%)))
+           (and (< (x%%) (* (+ (q%% k) (expt 2 (- (* k (rho%%))))) 
+                            (+ (q%% k) (expt 2 (- (* k (rho%%)))))))
+                (>= (x%%) (* (- (q%% k) (expt 2 (- (* k (rho%%))))) 
+                             (- (q%% k) (expt 2 (- (* k (rho%%)))))))))
+  :rule-classes ()
+  :hints (("Goal" :use theorem-2-a)))
+
+(defthm srt-sqrt-theorem-b
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (>= k (k%%)))
+           (< (abs (p%% k)) 2))
+  :rule-classes ()
+  :hints (("Goal" :use (theorem-2-b))))
+
+(defthmd srt-sqrt-theorem-c
+  (implies (and (<= 1/2 (q%% (k%%)))
+                (< (q%% (k%%)) 1)
+                (< (x%%) (* (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                            (+ (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (>= (x%%) (* (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%))))) 
+                             (- (q%% (k%%)) (expt 2 (- (* (k%%) (rho%%)))))))
+                (natp k)
+                (> k (k%%)))
+           (sqrt-accessible-p (i%% k) (j%% k) k (rho%%) (m%%) (n%%)))
+  :hints (("Goal" :use (theorem-2-c))))
+
+
+;;**********************************************************************************
+;; An Admissible Square Root Table is Also an Admissible Division Table
+;;**********************************************************************************
+
+(defthm sqrt-table-is-div-table
+  (admissible-div-table-p (rho%%) (m%%) (n%%) (table%%))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-5))))
+
+;;**********************************************************************************
+;; Admissible SRT Tables
+;;**********************************************************************************
+
+(defund accessible-p (i j k rho m n)
+  (and (< (- (+ (delta0 j n) (/ (expt 2 n)) (/ (expt 2 (- m 3)))))
+          (pi0 i m))
+       (< (pi0 i m)
+          (+ (delta0 j n) (/ (expt 2 n)) (expt 2 (- (* k rho)))))))
+
+(defthm div-accessible-accessible
+  (implies (and (integerp m)
+                (integerp n)
+                (integerp rho)
+                (integerp k)
+                (integerp i)
+                (integerp j)
+                (div-accessible-p i j m n))
+           (accessible-p i j k rho m n)))
+
+(defthm sqrt-accessible-accessible
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (bvecp i m)
+                (bvecp j n)
+                (natp k1)
+                (> k1 k)
+                (sqrt-accessible-p i j k1 rho m n))
+           (accessible-p i j k rho m n))
+  :rule-classes ())
+
+(defund check-entry (i j k rho m n entry)
+  (or (not (accessible-p i j k rho m n))
+      (and (< (- (expt 2 rho)) entry)
+           (< entry (expt 2 rho))
+           (>= entry (lower i j rho m n))
+           (check-lower-bound entry i j (1+ k) rho m n))))
+
+(defund check-row (i j k rho m n row)
+  (if (zp j)
+      t
+    (and (check-entry i (1- j) k rho m n (ifix (nth (1- j) row)))
+         (check-row i (1- j) k rho m n row))))
+
+(defund check-rows (i k rho m n rows)
+  (if (zp i)
+      t
+    (and (check-row (1- i) (expt 2 n) k rho m n (nth (1- i) rows))
+         (check-rows (1- i) k rho m n rows))))
+
+(defund admissible-srt-table-p (k rho m n table)
+  (check-rows (expt 2 m) k rho m n table))
+  
+;;**********************************************************************************
+;; Equivalence of Admissibility Definitions
+;;**********************************************************************************
+
+(defthm admissibility-equivalence-a
+  (implies (and (not (zp m))
+                (not (zp n))
+                (not (zp rho))
+                (not (zp k))
+                (natp k1)
+                (> k1 k)
+                (admissible-srt-table-p k rho m n table))
+           (admissible-for-iteration-p k1 rho m n table))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-6-a))))
+
+(encapsulate (((xtable%%) => *))
+
+(local (defund xtable-entry (i j)
+  (if (and (> (pi0 i (m%%))
+              (- (+ (delta0 j (n%%)) 
+                    (expt 2 (- (n%%))) 
+                    (expt 2 (- 3 (m%%))))))
+           (<= (pi0 i (m%%))
+               (- (expt 2 (- (* (k%%) (rho%%))))
+                  (+ (delta0 j (n%%))
+                     (expt 2 (- (n%%))) 
+                     (expt 2 (- 3 (m%%)))))))
+      (- 1 (expt 2 (rho%%)))
+    (lookup i j (table%%)))))
+
+(local (defun xtable-row (i j)
+  (declare (xargs :measure (nfix (- (expt 2 (n%%)) j))))
+  (if (and (natp j)
+           (< j (expt 2 (n%%))))
+      (cons (xtable-entry i j)
+            (xtable-row i (1+ j)))
+    ())))
+
+(local (defun xtable-rows (i)
+  (declare (xargs :measure (nfix (- (expt 2 (m%%)) i))))
+  (if (and (natp i)
+           (< i (expt 2 (m%%))))
+      (cons (xtable-row i 0)
+            (xtable-rows (1+ i)))
+    ())))
+
+(local (defund xtable%% ()
+  (xtable-rows 0)))
+
+(local (defun xtable-induct (j k)
+  (if (zp j)
+      k
+    (xtable-induct (1- j) (1+ k)))))
+
+(local (defthmd xtable-1
+  (implies (and (natp j)
+                (natp k)
+                (< (+ j k) (expt 2 (n%%))))
+           (equal (nth j (xtable-row i k))
+                  (xtable-entry i (+ j k))))
+  :hints (("Goal" :induct (xtable-induct j k))
+          ("Subgoal *1/2" :expand ((xtable-row i k)))
+          ("Subgoal *1/1" :expand ((xtable-row i k))))))
+
+(local (defthmd xtable-2
+  (implies (and (natp i)
+                (natp k)
+                (< (+ i k) (expt 2 (m%%))))
+           (equal (nth i (xtable-rows k))
+                  (xtable-row (+ i k) 0)))
+  :hints (("Goal" :induct (xtable-induct i k))
+          ("Subgoal *1/1" :expand ((xtable-rows k))))))
+
+(local (defthmd xtable-3
+  (implies (and (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (nth j (xtable-row i 0))
+                  (xtable-entry i j)))
+  :hints (("Goal" :use (:instance xtable-1 (k 0))))))
+
+(local (defthmd xtable-4
+  (implies (and (natp i)
+                (< i (expt 2 (m%%))))
+           (equal (nth i (xtable-rows 0))
+                  (xtable-row i 0)))
+  :hints (("Goal" :use (:instance xtable-2 (k 0))))))
+
+(local (defthm xtable-5
+  (integerp (xtable-entry i j))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable xtable-entry)))))
+
+(local (defthmd xtable-6
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (lookup i j (xtable%%))
+                  (xtable-entry i j)))
+  :hints (("Goal" :in-theory (enable lookup xtable%%)
+                  :use (xtable-4 xtable-3)))))
+
+(defthmd xtable-def
+  (implies (and (natp i)
+                (< i (expt 2 (m%%)))
+                (natp j)
+                (< j (expt 2 (n%%))))
+           (equal (lookup i j (xtable%%))
+                  (if (and (> (pi0 i (m%%))
+                           (- (+ (delta0 j (n%%)) 
+                                 (expt 2 (- (n%%))) 
+                                 (expt 2 (- 3 (m%%))))))
+                           (<= (pi0 i (m%%))
+                               (- (expt 2 (- (* (k%%) (rho%%))))
+                                  (+ (delta0 j (n%%))
+                                     (expt 2 (- (n%%))) 
+                                     (expt 2 (- 3 (m%%)))))))
+                      (- 1 (expt 2 (rho%%)))
+                    (lookup i j (table%%)))))
+  :hints (("Goal" :in-theory (enable xtable-entry)
+                  :use (xtable-6))))
+
+)
+
+(defthm admissibility-equivalence-b
+  (admissible-srt-table-p (k%%) (rho%%) (m%%) (n%%) (xtable%%))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-3-6-b))))
+
+;; Examples:
+
+(defthm admissible-srt-table-p-2-2-6-2
+  (admissible-srt-table-p 2 2 6 2 (srt-table 2 6 2)))
+
+(defthm admissible-srt-table-p-2-3-7-4
+  (admissible-srt-table-p 2 3 7 4 (srt-table 3 7 4)))
+
+(defthm admissible-srt-table-p-2-3-8-3
+  (admissible-srt-table-p 2 3 8 3 (srt-table 3 8 3)))
+
+(defthm admissible-for-iteration-p-2-2-6-2
+  (implies (and (natp k)
+                (> k 2))
+           (admissible-for-iteration-p k 2 6 2 (srt-table 2 6 2))))
+
+
+;;**********************************************************************************
+;; Criterion for Existence of SRT Table
+;;**********************************************************************************
+
+(defund check-exists-entry (i j k rho m n)
+  (or (not (accessible-p i j k rho m n))
+      (<= (lower i j rho m n) (- 1 (expt 2 rho)))
+      (check-lower-bound (lower i j rho m n) i j (1+ k) rho m n)))
+
+(defund check-exists-row (i j k rho m n)
+  (if (zp j)
+      t
+    (and (check-exists-entry i (1- j) k rho m n)
+         (check-exists-row i (1- j) k rho m n))))
+
+(defund check-exists-rows (i k rho m n)
+  (if (zp i)
+      t
+    (and (check-exists-row (1- i) (expt 2 n) k rho m n)
+         (check-exists-rows (1- i) k rho m n))))
+
+(defund exists-srt-table-p (k rho m n)
+  (check-exists-rows (expt 2 m) k rho m n))
+
+(defthm exists-srt-table-p-2-2-6-2
+  (exists-srt-table-p 2 2 6 2))
+
+(defthm exists-srt-table-p-2-3-7-4
+  (exists-srt-table-p 2 3 7 4))
+
+(defthm exists-srt-table-p-2-3-8-3
+  (exists-srt-table-p 2 3 8 3))
+
+(defthm not-exists-srt-table-p-100-2-5-2
+  (not (exists-srt-table-p 100 2 5 2)))
+
+(defthm not-exists-srt-table-p-100-3-6-4
+  (not (exists-srt-table-p 100 3 6 4)))
+
+(defthm srt-table-existence-a
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (exists-srt-table-p k rho m n))
+           (admissible-srt-table-p k rho m n (srt-table rho m n)))
+  :hints (("Goal" :use (lemma-3-7-a))))
+
+(defthm srt-table-existence-b
+  (implies (and (not (zp rho))
+                (not (zp m))
+                (not (zp n))
+                (not (zp k))
+                (admissible-srt-table-p k rho m n table))
+           (exists-srt-table-p k rho m n))
+  :hints (("Goal" :use (lemma-3-7-b))))
+
+
+;;**********************************************************************************
+;; Seed Table Requirements
+;;**********************************************************************************
+
+(encapsulate (((rho**) => *) ((k**) => *) ((x**) => *) ((s**) => *))
+
+(local (defun k** () 1))
+
+(local (defun rho** () 2))
+
+(defthm k**-rho**-constraint
+  (and (not (zp (k**)))
+       (not (zp (rho**)))
+       (>= (* (k**) (rho**)) 2))
+  :rule-classes ())
+  
+(local (defun x** () 1/2))
+
+(defthm x**-constraint
+  (and (rationalp (x**))
+       (> (x**) 1/4)
+       (< (x**) 1))
+  :rule-classes ())
+
+(defun l** () (fl (* (expt 2 (* (k**) (rho**))) (x**))))
+
+(local (defun s** () 3))
+
+(defthm s**-constraint
+  (and (integerp (s**))
+       (<= (expt 2 (1- (* (k**) (rho**)))) (s**))
+       (< (s**) (expt 2 (* (k**) (rho**))))
+       (<= (* (expt 2 (- (* (k**) (rho**)))) (expt (1- (s**)) 2))
+           (l**))
+       (>= (* (expt 2 (- (* (k**) (rho**)))) (expt (1+ (s**)) 2))
+           (1+ (l**))))
+  :rule-classes ())
+
+(defun q0** () (* (expt 2 (- (* (k**) (rho**)))) (s**)))
+
+)
+
+(defthm seed-req-a
+  (and (<= 1/2 (q0**))
+       (< (q0**) 1)
+       (>= (x**) (expt (- (q0**) (expt 2 (- (* (k**) (rho**))))) 2))
+       (< (x**) (expt (+ (q0**) (expt 2 (- (* (k**) (rho**))))) 2)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-a))))
+
+(defun s1** ()
+  (if (or (= (mod (s**) 2) 1)
+          (>= (x**) (* (q0**) (q0**))))
+      (s**)
+    (1- (s**))))
+
+(defun q1** () (* (expt 2 (- (* (k**) (rho**)))) (s1**)))
+
+(defthm seed-req-b
+  (and (<= 1/2 (q1**))
+       (< (q1**) 1)
+       (>= (x**) (expt (- (q1**) (expt 2 (- (* (k**) (rho**))))) 2))
+       (< (x**) (expt (+ (q1**) (expt 2 (- (* (k**) (rho**))))) 2)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-b))))
+
+(encapsulate (((h** *) => *) ((q** *) => *))
+
+(local (defun h** (k) (declare (ignore k)) 0))
+
+(defthm h**-constraint
+  (implies (and (not (zp k))
+                (> k (k**)))
+           (and (integerp (h** k))
+                (< (abs (h** k)) (expt 2 (rho**)))))
+  :rule-classes ())
+
+(local (defun q** (k) 
+  (if (or (zp k)
+          (<= k (k**)))
+      (q1**)
+    (+ (q** (1- k))
+       (* (expt 2 (- (* k (rho**))))
+          (h** k))))))
+
+(defthm q**-constraint
+  (and (= (q** (k**)) (q1**))
+       (implies (and (not (zp k))
+                     (> k (k**)))
+                (= (q** k)
+                   (+ (q** (1- k))
+                      (* (expt 2 (- (* k (rho**))))
+                         (h** k))))))
+  :hints (("Goal" ;:in-theory (theory 'minimal-theory)
+                  :use (q** s**-constraint k**-rho**-constraint
+                        (:instance q** (k (k**))))))
+  :rule-classes ())
+
+)
+
+(defthm seed-req-c
+  (implies (and (not (zp k))
+                (>= k (k**))
+                (< (x**) (expt (+ (q** k) (expt 2 (- (* k (rho**))))) 2)))
+           (= (fl (* (expt 2 (1- (* (k**) (rho**)))) (q** k)))
+              (fl (* (expt 2 (1- (* (k**) (rho**)))) (q1**)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-1-c))))
+
+
+;;**********************************************************************************
+;; A Compliant Seed Table
+;;**********************************************************************************
+
+(defun cg-sqrt (x min max)
+  (declare (xargs :measure (nfix (- (1+ max) min))))  
+  (if (and (natp min)
+           (natp max)
+           (<= min max))
+      (if (>= (* min min) x)
+          min
+        (cg-sqrt x (1+ min) max))
+    0))
+
+(defun seed (l k rho)
+  (1- (cg-sqrt (* (expt 2 (* k rho)) (1+ l)) 
+               (if (= (* k rho) 1)
+                   1
+                 (expt 2 (- (* k rho) 2)))
+               (expt 2 (* k rho)))))
+
+(defthm cg-sqrt-lemma
+  (implies (and (rationalp x)
+                (not (zp min))
+                (not (zp max))
+                (<= (* min min) x)
+                (<= x (* max max)))
+           (let ((y (cg-sqrt x min max)))
+             (and (<= x (* y y))
+                  (< (* (1- y) (1- y)) x))))
+  :rule-classes ())
+
+(defthm seed-compliance
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp l)
+                (<= (expt 2 (- (* k rho) 2)) l)
+                (< l (expt 2 (* k rho))))
+           (and (integerp (seed l k rho))
+                (<= (expt 2 (1- (* k rho))) (seed l k rho))
+                (< (seed l k rho) (expt 2 (* k rho)))
+                (<= (* (expt 2 (- (* k rho))) (expt (1- (seed l k rho)) 2))
+                    l)
+                (>= (* (expt 2 (- (* k rho))) (expt (1+ (seed l k rho)) 2))
+                    (1+ l))))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-2))))
+
+
+;;**********************************************************************************
+;; Initial K Iterations
+;;**********************************************************************************
+
+(defund digit (i seed k rho )
+  (bits seed (1- (* (- (1+ k) i) rho)) (* (- k i) rho)))
+
+(defund root (i seed k rho)
+  (if (zp i)
+      0
+    (+ (root (1- i) seed k rho)
+       (* (expt 2 (- (* i rho)))
+          (digit i seed k rho)))))
+
+(defthm seed-digits
+  (implies (and (not (zp k))
+                (not (zp rho))
+                (natp seed)
+                (<= (expt 2 (- (* k rho) 2)) seed)
+                (< seed (expt 2 (* k rho))))
+           (= (root k seed k rho)
+              (* (expt 2 (- (* k rho))) seed)))
+  :rule-classes ()
+  :hints (("Goal" :use (lemma-4-3))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/Makefile acl2-6.3/books/rtl/rel9/support/lib3.delta2/Makefile
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/Makefile	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,6 @@
+include ../../../../Makefile-generic
+
+# BOOKS = basic bits-old bits float reps log logn logn2log simplify-model-helpers logn rom-helpers bvecp-raw-helpers simple-loop-helpers add mult round top
+# Dependencies:
+
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/add.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/add.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/add.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/add.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,795 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "arithmetic-5/top" :dir :system)
+(include-book "float")
+(local (include-book "../lib3/top"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+
+;;;**********************************************************************
+;;;                 Ripple-Carry-Adders and Compression Trees
+;;;**********************************************************************
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (logand u v) 1 (logxor u v) 1)))
+  :rule-classes ())
+
+(defthm add-2
+    (implies (and (natp x) (natp y))
+	     (equal (+ x y)
+		    (+ (logxor x y)
+		       (* 2 (logand x y)))))
+  :rule-classes ())
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (logior (logand u v) (logior (logand u w) (logand v w))) 1 
+                       (logxor u (logxor v w)) 1)))
+  :rule-classes ())
+
+(defthm add-3
+    (implies (and (natp x)
+		  (natp y)
+		  (natp z))
+	     (= (+ x y z)
+		(+ (logxor x (logxor y z))
+		   (* 2 (logior (logand x y)
+				(logior (logand x z)
+					(logand y z)))))))
+  :rule-classes ())
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (logior (logand (bitn x (1- k)) (bitn y (1- k)))
+	    (logior (logand (bitn x (1- k)) (rc-carry x y (1- k)))
+		    (logand (bitn y (1- k)) (rc-carry x y (1- k)))))))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (logxor (bitn x (1- k))
+		 (logxor (bitn y (1- k)) (rc-carry x y (1- k))))
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :rule-classes ())
+
+(local (defun nats (n) (if (zp n) () (cons (1- n) (nats (1- n))))))
+
+(local (defthm bvecp-member-1
+  (implies (and (natp x)
+                (natp n)
+                (< x n))
+           (member x (nats n)))
+  :rule-classes ()))
+
+(local (defthm bvecp-member
+  (implies (and (natp n)
+                (bvecp x n))
+           (member x (nats (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bvecp-member-1 (n (expt 2 n))))
+                  :in-theory (enable bvecp)))))
+
+(defthmd compress-bit-5-3
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1)
+                (bvecp x 1)
+                (bvecp c 1))
+           (equal (+ u v w x c)
+                  (let ((xor4 (logxor u (logxor v (logxor w x)))))
+                    (+ (logxor xor4 c)
+                       (* 2 (+ (logior (logand xor4 c) (logand (lognot xor4) x))
+                               (logior (logand u v) (logior (logand u w) (logand v w)))))))))
+  :hints (("Goal" :use ((:instance bvecp-member (x u) (n 1))
+                        (:instance bvecp-member (x v) (n 1))
+                        (:instance bvecp-member (x w) (n 1))
+                        (:instance bvecp-member (x x) (n 1))
+                        (:instance bvecp-member (x c) (n 1))))))
+
+(defun xor4 (u v w x)
+  (logxor u (logxor v (logxor w x))))
+
+(defun cout1 (u v w)
+  (logior (logand u v) (logior (logand u w) (logand v w))))
+
+(defun cout2 (u v w x cin)
+  (logior (logand (xor4 u v w x) cin)
+          (logand (lognot (xor4 u v w x)) x)))
+
+(defun sout (u v w x cin)
+  (logxor (xor4 u v w x) cin))
+
+(local (defun comp-4-2-induct (u v w x cin n)
+   (declare (xargs :guard (and (natp n) (bvecp u n) (bvecp v n) (bvecp w n) (bvecp x n) (bvecp cin n))))
+   (if (zp n)
+      t
+    (comp-4-2-induct (bits u (- n 2) 0)
+                     (bits v (- n 2) 0)
+                     (bits w (- n 2) 0)
+                     (bits x (- n 2) 0)
+                     (bits cin (- n 2) 0)
+                     (1- n)))))
+
+(local (defthmd logand-bitn-lognot-1
+  (implies (and (integerp n)
+                (integerp x)
+                (integerp y))                
+           (equal (logand (bitn (lognot x) n) (bitn y n))
+                  (logand (lognot (bitn x n)) (bitn y n))))
+  :hints (("Goal" :cases ((< n 0))
+                  :use ((:instance bits-lognot (i n) (j n))
+                        bitn-0-1
+                        (:instance bitn-0-1 (x y)))))))
+
+(local (defthmd logand-bitn-lognot-2
+  (implies (and (integerp n)
+                (integerp x)
+                (integerp y))
+           (equal (logand (bitn y n) (bitn (lognot x) n))
+                  (logand (bitn y n) (lognot (bitn x n)))))
+  :hints (("Goal" :cases ((< n 0))
+                  :use ((:instance bits-lognot (i n) (j n))
+                        bitn-0-1
+                        (:instance bitn-0-1 (x y)))))))
+
+(local (defthmd logand-bvecp-2
+  (implies (and (natp n)
+                (bvecp x (1+ n))
+                (integerp y))
+           (equal (logand x (bits y n 0))
+                  (logand x y)))
+  :hints (("Goal" :use ((:instance bits-logand (i n) (j 0)))))))
+
+(local (defthmd bits-lognot-bits
+  (implies (and (integerp x)
+                (natp i)
+                (natp j)
+                (natp k)
+                (natp l)
+                (<= l k)
+                (<= k (- i j)))
+           (equal (bits (lognot (bits x i j)) k l)
+                  (bits (lognot x) (+ k j) (+ l j))))
+  :hints (("Goal" :in-theory (enable bits-lognot)))))
+
+(local (defthmd logand-bits-lognot
+  (implies (and (integerp x)
+                (integerp n)
+                (bvecp y (1+ n)))
+           (equal (logand y (bits (lognot x) n 0))
+                  (logand y (lognot (bits x n 0)))))
+  :hints (("Goal" :use ((:instance logand-bvecp-2 (x y) (y (lognot (bits x n 0)))))
+                  :cases ((< n 0))
+                  :in-theory (enable bits-lognot-bits)))))
+
+(local (defthmd comp-4-2-1
+  (implies (and (bvecp x1 n)
+                (bvecp x2 n)
+                (bvecp x3 n)
+                (bvecp x4 n)
+                (bvecp x5 n)
+                (syntaxp (not (consp x1)))
+                (not (zp n)))
+           (equal (+ x1 x2 x3 x4 x5)
+                  (+ (* (expt 2 (1- n))
+                        (+ (bitn x1 (1- n))
+                           (bitn x2 (1- n))
+                           (bitn x3 (1- n))
+                           (bitn x4 (1- n))
+                           (bitn x5 (1- n))))
+                     (bits x1 (- n 2) 0)
+                     (bits x2 (- n 2) 0)
+                     (bits x3 (- n 2) 0)
+                     (bits x4 (- n 2) 0)
+                     (bits x5 (- n 2) 0))))
+  :hints (("Goal" :use ((:instance bitn-plus-bits (x x1) (n (1- n)) (m 0))
+                        (:instance bitn-plus-bits (x x2) (n (1- n)) (m 0))
+                        (:instance bitn-plus-bits (x x3) (n (1- n)) (m 0))
+                        (:instance bitn-plus-bits (x x4) (n (1- n)) (m 0))
+                        (:instance bitn-plus-bits (x x5) (n (1- n)) (m 0)))))))
+
+(local (defthmd comp-4-2-2
+  (implies (and (bvecp x1 n)
+                (bvecp x2 n)
+                (bvecp x3 n)
+                (bvecp x4 n)
+                (bvecp x5 n)
+                (rationalp y)
+                (syntaxp (not (consp x1)))
+                (syntaxp (not (consp x2)))
+                (syntaxp (not (consp x3)))
+                (syntaxp (not (consp x4)))
+                (syntaxp (not (consp x5)))
+                (not (zp n)))
+           (equal (+ (logxor x1 x2 x3 x4 x5) y)
+                  (+ (* (expt 2 (1- n)) (bitn (logxor x1 x2 x3 x4 x5) (1- n)))
+                     (bits (logxor x1 x2 x3 x4 x5) (- n 2) 0)
+                     y)))
+  :hints (("Goal" :use ((:instance bitn-plus-bits (x (logxor x1 x2 x3 x4 x5)) (n (1- n)) (m 0)))))))
+
+(local (defthmd comp-4-2-3
+  (implies (and (bvecp x n)
+               ; (syntaxp (not (consp x)))
+                (not (zp n)))
+           (equal (cat x n 0 1)
+                  (+ (* (expt 2 n) (bitn x (1- n)))
+                     (cat (bits x (- n 2) 0) (1- n) 0 1))))
+  :hints (("Goal" :in-theory (enable bits-cat bitn-cat)
+                  :use ((:instance bitn-plus-bits (x (cat x n 0 1)) (m 0)))))))
+
+;; Believe it or not, the proof of the following lemma depends on the alphabetical ordering
+;; of the variables:
+
+(local (defthm comp-4-2-4
+  (implies (and (natp n)
+                (bvecp u n)
+                (bvecp v n)
+                (bvecp w n)
+                (bvecp x n)
+                (bvecp zcin n))
+           (equal (+ u v w x zcin)
+                  (+ (sout u v w x zcin)
+                     (cat (cout1 u v w) n 0 1)
+                     (cat (cout2 u v w x zcin) n 0 1))))
+  :rule-classes ()
+  :hints (("Goal" :induct (comp-4-2-induct u v w x zcin n))
+          ("Subgoal *1/2" :in-theory (enable comp-4-2-2 comp-4-2-3 comp-4-2-1 logand-bitn-lognot-1 logand-bitn-lognot-2 
+                                      compress-bit-5-3 bits-logior bits-logxor bits-logand 
+                                      logand-bits-lognot bitn-logior bitn-logxor bitn-logand)))))
+
+(defthm compress-5-3
+  (implies (and (natp n)
+                (bvecp u n)
+                (bvecp v n)
+                (bvecp w n)
+                (bvecp x n)
+                (bvecp cin n))
+           (equal (+ u v w x cin)
+                  (+ (sout u v w x cin)
+                     (cat (cout1 u v w) n 0 1)
+                     (cat (cout2 u v w x cin) n 0 1))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance comp-4-2-4 (zcin cin))))))
+
+(local (defthmd comp-4-2-6
+  (implies (and (bvecp u n)
+                (bvecp v n)
+                (bvecp w n)
+                (natp n)
+                (syntaxp (atom n)))
+           (EQUAL (LOGIOR (LOGAND U V)
+                          (LOGAND U W)
+                          (LOGAND V W))
+                  (+ (LOGIOR (LOGAND (BITS U (+ -2 N) 0)
+                                     (BITS V (+ -2 N) 0))
+                             (LOGAND (BITS U (+ -2 N) 0)
+                                     (BITS W (+ -2 N) 0))
+                             (LOGAND (BITS V (+ -2 N) 0)
+                                     (BITS W (+ -2 N) 0)))
+                     (* (EXPT 2 (+ -1 N))
+                        (LOGIOR (LOGAND (BITN U (+ -1 N))
+                                        (BITN V (+ -1 N)))
+                                (LOGAND (BITN U (+ -1 N))
+                                        (BITN W (+ -1 N)))
+                                (LOGAND (BITN V (+ -1 N))
+                                        (BITN W (+ -1 N))))))))
+  :hints (("Goal" :in-theory (enable bits-logand bitn-logand bits-logior bitn-logior)
+                  :use ((:instance bitn-plus-bits (x (LOGIOR (LOGAND U V) (LOGAND U W) (LOGAND V W))) (n (1- n)) (m 0)))))))
+
+(defthmd compress-4-2
+  (implies (and (natp n)
+                (bvecp u n)
+                (bvecp v n)
+                (bvecp w n)
+                (bvecp x n)
+                (bvecp c0 1))
+           (let ((xor4 (logxor u (logxor v (logxor w x))))
+                 (c (cat (logior (logand u v) (logior (logand u w) (logand v w))) n c0 1)))
+             (equal (+ u v w x c0)
+                    (+ (logxor xor4 (bits c (1- n) 0))
+                       (* 2 (logior (logand xor4 (bits c (1- n) 0)) (logand (lognot xor4) x)))
+                       (* (expt 2 n) (bitn c n))))))
+  :hints (("Goal" :use ((:instance compress-5-3 (cin (bits (cat (cout1 u v w) n c0 1) (1- n) 0))))
+                  :in-theory (enable bits-logxor bitn-logxor bits-logand bitn-logand bits-logior bitn-logior bits-cat bitn-cat))
+          ("Subgoal 1.2'''" :in-theory (enable cat))
+          ("Subgoal 1.1''" :in-theory (enable bits-logxor bitn-logxor bits-logand bitn-logand bits-logior bitn-logior 
+                                       logand-bitn-lognot-1 logand-bitn-lognot-2 logand-bits-lognot bits-cat bitn-cat)
+                           :expand ((CAT (LOGIOR (LOGAND X (LOGNOT (LOGXOR U V W X)))
+                                                 (LOGAND (LOGXOR U V W X)
+                                                         (CAT (LOGIOR (LOGAND (BITS U (+ -2 N) 0)
+                                                                              (BITS V (+ -2 N) 0))
+                                                                      (LOGAND (BITS U (+ -2 N) 0)
+                                                                              (BITS W (+ -2 N) 0))
+                                                                      (LOGAND (BITS V (+ -2 N) 0)
+                                                                              (BITS W (+ -2 N) 0)))
+                                                              (+ -1 N)
+                                                              C0 1)))
+                                         N 0 1)))
+          ("Subgoal 1.1'''" :in-theory (enable cat))
+          ("Subgoal 1.1'4'" :in-theory (enable comp-4-2-6))))
+
+
+;;;**********************************************************************
+;;;                      Carry-Look-Ahead Adders
+;;;**********************************************************************
+
+(defun gen (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+(defun prop (x y i j)
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(defthmd gen-val
+  (implies (and (natp j) (>= i j))
+           (equal (gen x y i j)
+                  (if (>= (+ (bits x i j) (bits y i j))
+                          (expt 2 (1+ (- i j))))
+                      1
+                    0))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j) (bits y i j))
+			(1+ (- i j))))))
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0)))))
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (logior (bitn x i) (bitn y i))))
+  :rule-classes ())
+
+(defthmd prop-val
+  (implies (and (integerp i) (natp j) (>= i j))
+           (equal (prop x y i j)
+                  (if (= (+ (bits x i j) (bits y i j))
+                         (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthmd prop-as-logxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (logxor (bits x i j) (bits y i j))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0))))
+
+(defthm gen-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (gen x y i j)
+		    (logior (gen x y i (1+ k))
+			    (logand (prop x y i (1+ k))
+				    (gen x y k j)))))
+  :rule-classes ())
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :rule-classes ())
+
+(defthm prop-extend
+    (implies (and (integerp i)
+		  (integerp j)
+		  (integerp k)
+		  (> i k)
+		  (>= k j)
+		  (>= j 0))
+	     (equal (prop x y i j)
+		    (logand (prop x y i (1+ k))
+			    (prop x y k j))))
+  :rule-classes ())
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp i) 
+		  (natp j)
+		  (> j 0)
+		  (>= i j))
+           (equal (bits (+ (* (expt 2 j) x) y) i j)
+                  (bits (+ (bits (* (expt 2 j) x) i j)
+                           (bits y i j))
+                        (- i j) 0)))
+    :rule-classes ())
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j))))
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j)))))
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(defthm bits-sum-plus-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (bits x i j)
+			     (bits y i j)
+			     (logior (prop x y (1- j) 0) 
+				     (gen x y (1- j) 0) ))
+			  (- i j) 0)))
+  :rule-classes ())
+
+(defthmd logand-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand (bits x i j) (bits y i j)) 0))
+           (equal (gen x y i j) 0)))
+
+
+(defthm logand-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (logand x y) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :rule-classes ())
+
+(defthmd gen-plus
+  (implies (and (natp x)
+                (natp y)
+		(natp k)
+		(bvecp z (1+ k))
+		(= (logand z y) 0)
+		(= (gen x y k 0) 1))
+	   (equal (gen (+ x y) z k 0) 0)))
+
+(defthmd gen-extend-3
+    (implies (and (natp i)
+		  (natp j)
+		  (> i j)
+		  (natp x)
+		  (natp y)
+		  (bvecp z (1+ j))
+		  (= (logand y z) 0))		  
+	     (equal (gen (+ x y) z i 0)
+		    (logand (prop x y i (1+ j))
+			    (gen (+ x y) z j 0)))))
+
+
+;;;**********************************************************************
+;;;                  Leading One Prediction
+;;;**********************************************************************
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm lop-bnds
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ())
+
+(defthm lop-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (bits (lognot (* 2 b)) e 0))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
+
+(defun lamt (a b e)
+  (logxor a (bits (lognot b) e 0)))
+
+(defun lamg (a b e)
+  (logand a (bits (lognot b) e 0)))
+
+(defun lamz (a b e)
+  (bits (lognot (logior a (bits (lognot b) e 0))) e 0))
+
+(defun lam1 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam2 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamz a b e)) (- e 2) 0))))
+
+(defun lam3 (a b e)
+  (logand (bits (lamt a b e) e 2) 
+	  (logand (bits (lamz a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam4 (a b e)
+  (logand (bits (lognot (lamt a b e)) e 2)
+	  (logand (bits (lamg a b e) (1- e) 1)
+		  (bits (lognot (lamg a b e)) (- e 2) 0))))
+
+(defun lam0 (a b e)
+  (logior (lam1 a b e)
+	  (logior (lam2 a b e)
+		  (logior (lam3 a b e)
+			  (lam4 a b e)))))
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (bitn (lognot(lamt a b e)) 0)))
+
+(defthm lop-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    Trailing One Prediction
+;;;**********************************************************************
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lognot (logxor a b)) k 0) 0)))
+  :rule-classes ())
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (logxor (logxor a b) 
+                                       (cat (logior a b) n c 1))
+                               k 0) 
+                         0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/basic.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/basic.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/basic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/basic.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,447 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "../lib3/top"))
+
+;;;**********************************************************************
+;;;                       FLOOR and CEILING
+;;;**********************************************************************
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defthm fl-def
+  (and (integerp (fl x))    
+       (implies (case-split (rationalp x))
+	        (and (<= (fl x) x)
+		     (< x (1+ (fl x))))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (<= (fl x) x)
+                                        (< x (1+ (fl x))))))
+                 (:type-prescription :corollary
+                                     (integerp (fl x)))))
+
+(defthm fl-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (<= n x)
+		  (< x (1+ n)))
+	     (equal (fl x) n))
+  :rule-classes ())
+
+(defthm fl-integerp
+  (equal (equal (fl x) x)
+         (integerp x)))
+
+(defthm quot-bnd
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* y (fl (/ x y)))
+               x))
+  :rule-classes :linear)
+
+(defthm fl-monotone-linear
+    (implies (and (<= x y)
+		  (rationalp x)
+		  (rationalp y))
+	     (<= (fl x) (fl y)))
+  :rule-classes :linear)
+
+(defthm n<=fl-linear
+    (implies (and (<= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (<= n (fl x)))
+  :rule-classes :linear)
+
+(defthm fl+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (fl (+ x n)) (+ (fl x) n))))
+
+(defthm fl/int-rewrite
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (fl x) (/ n)))
+                  (fl (/ x n)))))
+
+(defthm fl/int-rewrite-alt
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x))
+           (equal (fl (* (/ n) (fl x)))
+                  (fl (/ x n)))))
+
+(defthmd fl-minus
+  (implies (rationalp x)
+           (equal (fl (* -1 x))
+                  (if (integerp x)
+                      (* -1 x)
+                    (1- (* -1 (fl x)))))))
+
+(defthm fl-m-n
+  (implies (and (< 0 n)
+                (integerp m)
+                (integerp n))
+           (= (fl (- (/ m n)))
+              (1- (- (fl (/ (1- m) n))))))
+  :rule-classes ())
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defthm cg-def
+  (and (integerp (cg x))
+       (implies (case-split (rationalp x))
+                (and (>= (cg x) x)
+                     (> (1+ x) (cg x)))))
+  :rule-classes ((:linear :corollary
+                          (implies (case-split (rationalp x))
+                                   (and (>= (cg x) x)
+                                        (> (1+ x) (cg x)))))
+                 (:type-prescription :corollary
+                                     (integerp (cg x)))))
+
+(defthm cg-unique
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (>= n x)
+		  (> (1+ x) n))
+	     (equal (cg x) n))
+  :rule-classes ())
+
+(defthm cg-integerp
+    (implies (rationalp x)
+	     (equal (equal (cg x) x)
+                    (integerp x))))
+
+(defthm cg-monotone-linear
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= x y))
+	     (<= (cg x) (cg y)))
+  :rule-classes :linear)
+
+(defthm n>=cg-linear
+    (implies (and (>= n x)
+		  (rationalp x)
+		  (integerp n))
+	     (>= n (cg x)))
+  :rule-classes :linear)
+
+(defthm cg+int-rewrite
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (equal (cg (+ x n)) (+ (cg x) n))))
+
+(defthm cg/int-rewrite
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (cg x) (/ n)))
+                  (cg (/ x n)))))
+
+(defthm cg/int-rewrite-alt
+  (implies (and (integerp n)
+                (> n 0)
+                (rationalp x))
+           (equal (cg (* (/ n) (cg x)))
+                  (cg (/ x n)))))
+
+(defthm fl-cg
+  (implies (rationalp x)
+           (equal (cg x)
+                  (if (integerp x)
+                      (fl x)
+                    (1+ (fl x)))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                         MOD
+;;;**********************************************************************
+(in-theory (disable mod))
+
+(defthm mod-def
+  (implies (case-split (acl2-numberp x))
+           (equal (mod x y)
+                  (- x (* y (fl (/ x y))))))
+  :rule-classes ())
+
+(defthm mod-0
+    (and (equal (mod 0 y)
+                0)
+         (equal (mod x 0)
+                (fix x))))
+
+(defthm rationalp-mod
+  (implies (rationalp x)
+           (rationalp (mod x y)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm integerp-mod
+  (implies (and (integerp m) (integerp n))
+           (integerp (mod m n)))
+  :rule-classes (:rewrite :type-prescription))
+
+
+(defthm natp-mod
+   (implies (and (natp m)
+                 (natp n))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm natp-mod-2
+   (implies (and (integerp m)
+                 (integerp n)
+                 (> n 0))
+            (natp (mod m n)))
+   :rule-classes ((:type-prescription :typed-term (mod m n))))
+
+
+(defthm mod-bnd-1
+  (implies (and (case-split (< 0 n))
+                (case-split (not (complex-rationalp m)))
+                (case-split (not (complex-rationalp n))))
+           (< (mod m n) n))
+  :rule-classes :linear)
+
+(defthm mod-by-1
+  (implies (integerp m)
+           (equal (mod m 1)
+                  0)))
+
+(defthm mod-bnd-2
+  (implies (and (<= 0 m)
+                (case-split (rationalp m)))
+           (<= (mod m n) m))
+  :rule-classes :linear)
+
+(defthm mod-does-nothing
+  (implies (and (< m n)
+                (<= 0 m)
+                (case-split (rationalp m)))
+           (equal (mod m n)
+                  m)))
+
+(defthm mod-0-fl
+  (implies (acl2-numberp m)
+           (iff (= (mod m n) 0)
+	        (= m (* (fl (/ m n)) n))))
+  :rule-classes ())
+
+(defthm mod-0-int
+  (implies (and (integerp m)
+                (integerp n)
+                (not (= n 0)))
+           (iff (= (mod m n) 0)
+                (integerp (/ m n))))
+  :rule-classes ())
+
+(defthm mod-mult-n
+  (equal (mod (* a n) n)
+         (* n (mod a 1))))
+
+(defthm mod-mult-n-alt
+  (equal (mod (* n a) n)
+         (* n (mod a 1))))
+
+(defthm mod-squeeze
+    (implies (and (= (mod m n) 0)
+		  (< m (* (1+ a) n))
+                  (< (* (1- a) n) m)
+                  (integerp a)
+		  (integerp m)
+		  (integerp n))
+	     (= m (* a n)))
+  :rule-classes ())
+
+(defthm mod-must-be-n
+    (implies (and (= (mod m n) 0)
+		  (< m (* 2 n))
+                  (< 0 m)
+		  (rationalp m)
+		  (rationalp n))
+	     (= m n))
+  :rule-classes ())
+
+(defthm mod-0-0
+  (implies (and (integerp p)
+                (rationalp m)
+                (rationalp n))
+           (iff (= (mod m (* n p)) 0)
+                (and (= (mod m n) 0)
+                     (= (mod (fl (/ m n)) p) 0))))
+  :rule-classes ())
+
+(defthm mod-equal-int
+  (implies (and (= (mod a n) (mod b n))
+                (rationalp a)
+                (rationalp b))
+           (integerp (/ (- a b) n)))
+  :rule-classes ())
+
+(defthm mod-equal-int-reverse
+  (implies (and (integerp (/ (- a b) n))
+                (rationalp a)
+                (rationalp b)
+                (rationalp n)
+                (< 0 n))
+           (= (mod a n) (mod b n)))
+  :rule-classes ())
+
+(defthm mod-force-equal
+  (implies (and (< (abs (- a b)) n)
+                (rationalp a)
+                (rationalp b)
+                (integerp n))
+          (iff (= (mod a n) (mod b n))
+               (= a b)))
+  :rule-classes ())
+
+(defthm mod-mult
+    (implies (and (integerp a)
+                  (rationalp m)
+		  (rationalp n))
+	     (equal (mod (+ m (* a n)) n)
+		    (mod m n))))
+
+(defthm mod-force
+  (implies (and (<= (* a n) m)
+                (< m (* (1+ a) n))
+                (integerp a)
+                (rationalp m)
+                (rationalp n))
+           (= (mod m n) (- m (* a n))))
+  :rule-classes ())
+
+(defthm mod-bnd-3
+  (implies (and (< m (+ (* a n) r))
+                (<= (* a n) m)
+                (integerp a)
+                (case-split (rationalp m))
+                (case-split (rationalp n)))
+           (< (mod m n) r))
+  :rule-classes :linear)
+
+(defthmd mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ a (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthmd mod-mod-sum
+    (implies (and (rationalp a)
+		  (rationalp b))
+	     (equal (mod (+ (mod a n) (mod b n)) n)
+		    (mod (+ a b) n))))
+
+(defthmd mod-diff
+  (implies (and (case-split (rationalp a))
+                (case-split (rationalp b)))
+           (equal (mod (- a (mod b n)) n)
+                  (mod (- a b) n))))
+
+(defthmd mod-of-mod
+  (implies (and (case-split (natp k))
+                (case-split (natp n)))
+           (equal (mod (mod x (* k n)) n)
+                  (mod x n))))
+
+(defthmd mod-of-mod-cor
+  (implies (and (<= b a)
+                (case-split (integerp b))
+                (case-split (integerp a)))
+           (equal (mod (mod x (expt 2 a)) (expt 2 b))
+                  (mod x (expt 2 b)))))
+
+(defthmd mod-prod
+  (implies (and (rationalp m)
+                (rationalp n)
+                (rationalp k))
+           (equal (mod (* k m) (* k n))
+                  (* k (mod m n)))))
+
+(defthm mod012
+  (implies (integerp m)
+           (or (equal (mod m 2) 0)
+               (equal (mod m 2) 1)))
+  :rule-classes ())
+
+(defthm mod-plus-mod-2
+  (implies (and (integerp a)
+                (integerp b))
+           (iff (= (mod (+ a b) 2) (mod a 2))
+                (= (mod b 2) 0)))
+  :rule-classes ())
+
+(defthm mod-mod-2-not-equal
+  (implies (acl2-numberp m)
+           (not (= (mod m 2) (mod (1+ m) 2))))
+  :rule-classes ())
+
+(defthm mod-2*m+1-rewrite
+  (implies (integerp m)
+           (equal (mod (1+ (* 2 m)) 2) 1)))
+
+(defthm mod-mod-times
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (> n 0))
+	     (= (mod (* (mod a n) b) n)
+		(mod (* a b) n)))
+  :rule-classes ())
+
+
+(defthm mod-times-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (* a c) n) (mod (* b c) n)))
+  :rule-classes ())
+
+
+(defthm mod-plus-mod
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp c)
+		  (not (zp n))
+		  (= (mod a n) (mod b n)))
+	     (= (mod (+ a c) n) (mod (+ b c) n)))
+  :rule-classes ())
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/bits-old.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/bits-old.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/bits-old.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/bits-old.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,2001 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "arithmetic-5/top" :dir :system)
+
+(include-book "basic")
+
+(local (encapsulate ()
+
+(local (include-book "../lib3/top"))
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defun nats (n) (if (zp n) () (cons (1- n) (nats (1- n)))))
+
+(local (defthm bvecp-member-1
+  (implies (and (natp x)
+                (natp n)
+                (< x n))
+           (member x (nats n)))
+  :rule-classes ()))
+
+(defthm bvecp-member
+  (implies (and (natp n)
+                (bvecp x n))
+           (member x (nats (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bvecp-member-1 (n (expt 2 n))))
+                  :in-theory (enable bvecp))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm bits-bounds
+    (implies (and (integerp i)
+		  (integerp j))
+	     (and (natp (bits x i j))
+		  (< (bits x i j) (expt 2 (1+ (- i j))))))
+  :rule-classes())
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum-new
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ (bits x k 0) y) i j)
+		  (bits (+ x y) i j)))
+  :hints (("Goal" :use (bits-bits-sum
+                        (:instance bits-bits-sum (x (bits x k 0)))
+                        (:instance bits-bits (x (+ x y)) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (+ (bits x k 0) y)) (j 0) (k i) (l j))))))
+
+(defthmd bits-bits-sum-alt
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (bits y k 0)) i j)
+		  (bits (+ x y) i j)))
+  :hints (("Goal" :use ((:instance bits-bits-sum (x y) (y x))
+                        (:instance bits-bits-sum (y x) (x (bits y k 0)))
+                        (:instance bits-bits (x (+ x y)) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (+ (bits y k 0) x)) (j 0) (k i) (l j))))))
+
+(defthmd bits-bits-diff-new
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (- (bits y k 0))) i j)
+		  (bits (- x y) i j)))
+  :hints (("Goal" :in-theory (disable bits-bits)
+                  :use ((:instance bits-bits-diff (i k))
+                        (:instance bits-bits (x (- x y)) (i k) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (- x (bits y k 0))) (i k) (j 0) (k i) (l j))))))
+
+(defthmd bits-bits-prod
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (* x (bits y k 0)) i j)
+		  (bits (* x y) i j)))
+  :hints (("Goal" :in-theory (disable bits-bits)
+                  :use ((:instance bits-bits-times (x y) (y x) (i k))
+                        (:instance bits-bits (x (* x y)) (i k) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (* x (bits y k 0))) (i k) (j 0) (k i) (l j))))))
+
+(defthm bits-diff-equal
+    (implies (and (natp n)
+		  (integerp x)
+		  (integerp y)
+		  (< (abs (- x y)) (expt 2 n)))
+	     (iff (= x y)
+		  (= (bits (- x y) (1- n) 0) 0)))
+  :rule-classes ())
+
+
+(defthm bits-fl-diff
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (bits-mod-2))))
+
+(defthm bits-neg-indices
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-reverse-indices
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthmd neg-bits-1-new
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (1- (expt 2 (1+ (- i j))))))
+  :hints (("Goal" :use (neg-bits-1))))
+
+(defthmd bits-minus-1-new
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (1- (expt 2 (1+ (- i j))))))
+  :hints (("Goal" :use (bits-minus-1))))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-diff-0
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y))))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bits-tail-gen
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthmd bits-shift-up-1-new
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :hints (("Goal" :use (bits-shift-up-1))))
+
+(defthmd bits-shift-up-2-new
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :hints (("Goal" :use (bits-shift-up-2))))
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthmd bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free variables
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1)))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0)))
+
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0)))
+
+(defthmd bitn-minus-1-new
+    (implies (natp i)
+	     (equal (bitn -1 i) 1))
+  :hints (("Goal" :use ((:instance bits-minus-1 (j i))))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bitn-shift-up
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n)))
+  :hints (("Goal" :use (bitn-shift))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthmd bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthm bitn-plus-bits-new
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m))))
+  :rule-classes ()
+  :hints (("Goal" :use (bitn-plus-bits))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+;; The next two lemmas allow one to prove equality of two bit vectors of width k by 
+;; proving each of these has the same value at bit i, for 0 <= i < k.
+
+(defun diff-bit (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (diff-bit x y (1- k)))))
+
+(local (defthm diff-bit-rewrite
+  (equal (diff-bit x y k)
+         (sumbits-badguy x y k))))
+
+(local (in-theory (disable diff-bit)))
+
+(defthmd diff-bit-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((i (diff-bit x y k)))
+             (and (natp i)
+                  (< i k))))
+  :hints (("Goal" :use (sumbits-badguy-bounds))))
+
+(defthmd diff-bit-equal
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (not (zp k))
+                (equal (bitn x (diff-bit x y k))
+                       (bitn y (diff-bit x y k))))
+           (equal (equal x y) t))
+  :hints (("Goal" :use (sumbits-badguy-is-correct))))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; We define a macro, Ca, THAT takes a list of a list X of alternating data values 
+;; and sizes.  CAT-SIZE returns the formal sum of the sizes.  X must contain at 
+;; least 1 data/size pair, but we do not need to specify this in the guard, and 
+;; leaving it out of the guard simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthmd cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+;; We introduce mbe for MULCAT not because we want particularly fast execution, 
+;; but because the existing logic definition does not satisfy the guard of cat, 
+;; which can't be changed because of the guard of bits.
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
+
+;;;**********************************************************************
+;;;		      Signed Integer Encodings
+;;;**********************************************************************
+
+(defun sgndintval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm sgndintval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (sgndintval w (bits x (1- w) 0))
+                x))
+    :rule-classes nil)
+
+(defun signextend (n m x)
+  (bits (sgndintval m x) (1- n) 0))
+
+(defthmd sgndintval-signextend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (sgndintval n (signextend n m x))
+		    (sgndintval m x))))
+
+))
+
+;; Non-local events:
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defun nats (n) (if (zp n) () (cons (1- n) (nats (1- n)))))
+
+(defthm bvecp-member
+  (implies (and (natp n)
+                (bvecp x n))
+           (member x (nats (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bvecp-member-1 (n (expt 2 n))))
+                  :in-theory (enable bvecp))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm bits-bounds
+    (implies (and (integerp i)
+		  (integerp j))
+	     (and (natp (bits x i j))
+		  (< (bits x i j) (expt 2 (1+ (- i j))))))
+  :rule-classes())
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ (bits x k 0) y) i j)
+		  (bits (+ x y) i j)))
+  :hints (("Goal" :use (bits-bits-sum-new)))) 
+
+(defthmd bits-bits-sum-alt
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (bits y k 0)) i j)
+		  (bits (+ x y) i j)))
+  :hints (("Goal" :use ((:instance bits-bits-sum (x y) (y x))
+                        (:instance bits-bits-sum (y x) (x (bits y k 0)))
+                        (:instance bits-bits (x (+ x y)) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (+ (bits y k 0) x)) (j 0) (k i) (l j))))))
+
+(defthmd bits-bits-diff
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (- (bits y k 0))) i j)
+		  (bits (- x y) i j)))
+  :hints (("Goal" :use (bits-bits-diff-new))))
+
+(defthmd bits-bits-prod
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (* x (bits y k 0)) i j)
+		  (bits (* x y) i j)))
+  :hints (("Goal" :in-theory (disable bits-bits)
+                  :use ((:instance bits-bits-times (x y) (y x) (i k))
+                        (:instance bits-bits (x (* x y)) (i k) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (* x (bits y k 0))) (i k) (j 0) (k i) (l j))))))
+
+(defthm bits-diff-equal
+    (implies (and (natp n)
+		  (integerp x)
+		  (integerp y)
+		  (< (abs (- x y)) (expt 2 n)))
+	     (iff (= x y)
+		  (= (bits (- x y) (1- n) 0) 0)))
+  :rule-classes ())
+
+
+(defthm bits-fl-diff
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (bits-mod-2))))
+
+(defthm bits-neg-indices
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-reverse-indices
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthmd neg-bits-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (1- (expt 2 (1+ (- i j))))))
+  :hints (("Goal" :use (neg-bits-1-new))))
+
+(defthmd bits-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (1- (expt 2 (1+ (- i j))))))
+  :hints (("Goal" :use (bits-minus-1-new))))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-diff-0
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y))))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bits-tail-gen
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthmd bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :hints (("Goal" :use (bits-shift-up-1-new))))
+
+(defthmd bits-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :hints (("Goal" :use (bits-shift-up-2-new))))
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthmd bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free variables
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1)))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0)))
+
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0)))
+
+(defthmd bitn-minus-1
+    (implies (natp i)
+	     (equal (bitn -1 i) 1))
+  :hints (("Goal" :use (bits-minus-1-new))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bitn-shift-up
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n)))
+  :hints (("Goal" :use (bitn-shift))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthmd bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthm bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m))))
+  :rule-classes ()
+  :hints (("Goal" :use (bitn-plus-bits-new))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+;; The next two lemmas allow one to prove equality of two bit vectors of width k by 
+;; proving each of these has the same value at bit i, for 0 <= i < k.
+
+(defun diff-bit (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (diff-bit x y (1- k)))))
+
+(defthmd diff-bit-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((i (diff-bit x y k)))
+             (and (natp i)
+                  (< i k))))
+  :hints (("Goal" :use (sumbits-badguy-bounds))))
+
+(defthmd diff-bit-equal
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (not (zp k))
+                (equal (bitn x (diff-bit x y k))
+                       (bitn y (diff-bit x y k))))
+           (equal (equal x y) t))
+  :hints (("Goal" :use (sumbits-badguy-is-correct))))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; We define a macro, Ca, THAT takes a list of a list X of alternating data values 
+;; and sizes.  CAT-SIZE returns the formal sum of the sizes.  X must contain at 
+;; least 1 data/size pair, but we do not need to specify this in the guard, and 
+;; leaving it out of the guard simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthmd cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+;; We introduce mbe for MULCAT not because we want particularly fast execution, 
+;; but because the existing logic definition does not satisfy the guard of cat, 
+;; which can't be changed because of the guard of bits.
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
+
+;;;**********************************************************************
+;;;		      Signed Integer Encodings
+;;;**********************************************************************
+
+(defun sgndintval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm sgndintval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (sgndintval w (bits x (1- w) 0))
+                x))
+    :rule-classes nil)
+
+(defun signextend (n m x)
+  (bits (sgndintval m x) (1- n) 0))
+
+(defthmd sgndintval-signextend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (sgndintval n (signextend n m x))
+		    (sgndintval m x))))
+
+;; the name of this function is just too long:
+
+(defun intval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm intval-rewrite
+  (equal (intval w x) (sgndintval w x)))
+
+(in-theory (disable intval))
+
+(defthm intval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (intval w (bits x (1- w) 0))
+                x))
+    :rule-classes ()
+    :hints (("Goal" :use sgndintval-bits)))
+
+(defun sign-extend (n m x)
+  (bits (intval m x) (1- n) 0))
+
+(defthm sign-extend-rewrite
+  (equal (sign-extend n m x) (signextend n m x)))
+
+(in-theory (disable sign-extend))
+
+(defthmd intval-sign-extend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (intval n (sign-extend n m x))
+		    (intval m x)))
+  :hints (("Goal" :use sgndintval-signextend)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/bits.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/bits.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/bits.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1948 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "arithmetic-5/top" :dir :system)
+
+(include-book "basic")
+
+(local (encapsulate ()
+
+(local (include-book "bits-old"))
+
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defun nats (n) (if (zp n) () (cons (1- n) (nats (1- n)))))
+
+(local (defthm bvecp-member-1
+  (implies (and (natp x)
+                (natp n)
+                (< x n))
+           (member x (nats n)))
+  :rule-classes ()))
+
+(defthm bvecp-member
+  (implies (and (natp n)
+                (bvecp x n))
+           (member x (nats (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bvecp-member-1 (n (expt 2 n))))
+                  :in-theory (enable bvecp))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm bits-bounds
+    (implies (and (integerp i)
+		  (integerp j))
+	     (and (natp (bits x i j))
+		  (< (bits x i j) (expt 2 (1+ (- i j))))))
+  :rule-classes())
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ (bits x k 0) y) i j)
+		  (bits (+ x y) i j)))
+  :hints (("Goal" :use (bits-bits-sum-new))))
+
+(defthmd bits-bits-sum-alt
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (bits y k 0)) i j)
+		  (bits (+ x y) i j)))
+  :hints (("Goal" :use ((:instance bits-bits-sum (x y) (y x))
+                        (:instance bits-bits-sum (y x) (x (bits y k 0)))
+                        (:instance bits-bits (x (+ x y)) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (+ (bits y k 0) x)) (j 0) (k i) (l j))))))
+
+(defthmd bits-bits-diff
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (- (bits y k 0))) i j)
+		  (bits (- x y) i j)))
+  :hints (("Goal" :use (bits-bits-diff-new))))
+
+(defthmd bits-bits-prod
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (* x (bits y k 0)) i j)
+		  (bits (* x y) i j)))
+  :hints (("Goal" :in-theory (disable bits-bits)
+                  :use ((:instance bits-bits-times (x y) (y x) (i k))
+                        (:instance bits-bits (x (* x y)) (i k) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (* x (bits y k 0))) (i k) (j 0) (k i) (l j))))))
+
+(defthm bits-diff-equal
+    (implies (and (natp n)
+		  (integerp x)
+		  (integerp y)
+		  (< (abs (- x y)) (expt 2 n)))
+	     (iff (= x y)
+		  (= (bits (- x y) (1- n) 0) 0)))
+  :rule-classes ())
+
+
+(defthm bits-fl-diff
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (bits-mod-2))))
+
+(defthm bits-neg-indices
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-reverse-indices
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthmd neg-bits-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (1- (expt 2 (1+ (- i j))))))
+  :hints (("Goal" :use (neg-bits-1-new))))
+
+(defthmd bits-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (1- (expt 2 (1+ (- i j)))))))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-diff-0
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y))))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bits-tail-gen
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthmd bits-shift-up-1-new
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :hints (("Goal" :use (bits-shift-up-1))))
+
+(defthmd bits-shift-up-2-new
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :hints (("Goal" :use (bits-shift-up-2))))
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthmd bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free variables
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1)))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0)))
+
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0)))
+
+(defthmd bitn-minus-1-new
+    (implies (natp i)
+	     (equal (bitn -1 i) 1))
+  :hints (("Goal" :use ((:instance bits-minus-1 (j i))))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bitn-shift-up
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n)))
+  :hints (("Goal" :use (bitn-shift))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthmd bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthm bitn-plus-bits-new
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m))))
+  :rule-classes ()
+  :hints (("Goal" :use (bitn-plus-bits))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+;; The next two lemmas allow one to prove equality of two bit vectors of width k by 
+;; proving each of these has the same value at bit i, for 0 <= i < k.
+
+(defun diff-bit (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (diff-bit x y (1- k)))))
+
+
+(defthmd diff-bit-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((i (diff-bit x y k)))
+             (and (natp i)
+                  (< i k)))))
+
+(defthmd diff-bit-equal
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (not (zp k))
+                (equal (bitn x (diff-bit x y k))
+                       (bitn y (diff-bit x y k))))
+           (equal (equal x y) t)))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; We define a macro, Ca, THAT takes a list of a list X of alternating data values 
+;; and sizes.  CAT-SIZE returns the formal sum of the sizes.  X must contain at 
+;; least 1 data/size pair, but we do not need to specify this in the guard, and 
+;; leaving it out of the guard simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthmd cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+;; We introduce mbe for MULCAT not because we want particularly fast execution, 
+;; but because the existing logic definition does not satisfy the guard of cat, 
+;; which can't be changed because of the guard of bits.
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
+
+;;;**********************************************************************
+;;;		      Signed Integer Encodings
+;;;**********************************************************************
+
+(defun intval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm intval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (intval w (bits x (1- w) 0))
+                x))
+    :rule-classes nil)
+
+(defun sign-extend (n m x)
+  (bits (intval m x) (1- n) 0))
+
+(defthmd intval-sign-extend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (intval n (sign-extend n m x))
+		    (intval m x))))
+
+))
+
+;; Non-local events:
+
+;;;**********************************************************************
+;;;				BVECP
+;;;**********************************************************************
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-forward
+  (implies (bvecp x k)
+	   (and (integerp x)
+		(<= 0 x)
+		(< x (expt 2 k))))
+  :rule-classes :forward-chaining)
+
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+		  (case-split (integerp m)))
+	     (bvecp x m)))
+
+(defthmd bvecp-shift-down
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (natp k))
+	     (bvecp (fl (/ x (expt 2 k))) (- n k))))
+
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+		  (natp k)
+		  (integerp n))
+	     (bvecp (* x (expt 2 k)) n)))
+
+(defthm bvecp-product
+    (implies (and (bvecp x m)
+		  (bvecp y n))
+	     (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defun nats (n) (if (zp n) () (cons (1- n) (nats (1- n)))))
+
+(defthm bvecp-member
+  (implies (and (natp n)
+                (bvecp x n))
+           (member x (nats (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bvecp-member-1 (n (expt 2 n))))
+                  :in-theory (enable bvecp))))
+
+(defthm bvecp-1-0
+  (implies (and (bvecp x 1)
+		(not (equal x 1)))
+	   (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-0-1
+  (implies (and (bvecp x 1)
+		(not (equal x 0)))
+	   (equal x 1))
+  :rule-classes :forward-chaining)
+
+
+;;;**********************************************************************
+;;;			    BITS
+;;;**********************************************************************
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+    (implies (and (<= (+ 1 i (- j)) k)
+		  (case-split (integerp k)))
+	     (bvecp (bits x i j) k)))
+
+;;Here is a variation of bits-bvecp that is less general but does not
+;;require an integerp hypothesis:
+
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+(defthm bits-bounds
+    (implies (and (integerp i)
+		  (integerp j))
+	     (and (natp (bits x i j))
+		  (< (bits x i j) (expt 2 (1+ (- i j))))))
+  :rule-classes())
+
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) 
+	      (mod y (expt 2 (1+ i))))
+	   (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+		(case-split (integerp i)))
+	   (equal (bits x i 0)
+		  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ (bits x k 0) y) i j)
+		  (bits (+ x y) i j)))
+  :hints (("Goal" :use (bits-bits-sum-new)))) 
+
+(defthmd bits-bits-sum-alt
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (bits y k 0)) i j)
+		  (bits (+ x y) i j)))
+  :hints (("Goal" :use ((:instance bits-bits-sum (x y) (y x))
+                        (:instance bits-bits-sum (y x) (x (bits y k 0)))
+                        (:instance bits-bits (x (+ x y)) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (+ (bits y k 0) x)) (j 0) (k i) (l j))))))
+
+(defthmd bits-bits-diff
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (+ x (- (bits y k 0))) i j)
+		  (bits (- x y) i j)))
+  :hints (("Goal" :use (bits-bits-diff-new))))
+
+(defthmd bits-bits-prod
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= j 0)
+                (>= k i))
+	   (equal (bits (* x (bits y k 0)) i j)
+		  (bits (* x y) i j)))
+  :hints (("Goal" :in-theory (disable bits-bits)
+                  :use ((:instance bits-bits-times (x y) (y x) (i k))
+                        (:instance bits-bits (x (* x y)) (i k) (j 0) (k i) (l j))
+                        (:instance bits-bits (x (* x (bits y k 0))) (i k) (j 0) (k i) (l j))))))
+
+(defthm bits-diff-equal
+    (implies (and (natp n)
+		  (integerp x)
+		  (integerp y)
+		  (< (abs (- x y)) (expt 2 n)))
+	     (iff (= x y)
+		  (= (bits (- x y) (1- n) 0) 0)))
+  :rule-classes ())
+
+
+(defthm bits-fl-diff
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (bits-mod-2))))
+
+(defthm bits-neg-indices
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthm bits-reverse-indices
+  (implies (< i j)
+	   (equal (bits x i j)
+		  0)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+(defthmd bvecp-bits-0
+  (implies (bvecp x j)
+	   (equal (bits x i j) 0)))
+
+(defthmd neg-bits-1
+    (implies (and (integerp x)
+		  (natp i)
+		  (natp j)
+		  (< x 0)
+		  (>= x (- (expt 2 j)))
+		  (>= i j))
+	     (equal (bits x i j) 
+                    (1- (expt 2 (1+ (- i j))))))
+  :hints (("Goal" :use (neg-bits-1-new))))
+
+(defthmd bits-minus-1
+    (implies (and (natp i)
+		  (natp j)
+		  (>= i j))
+	     (equal (bits -1 i j) 
+                    (1- (expt 2 (1+ (- i j)))))))
+
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+		(case-split (acl2-numberp i)))
+	   (equal (bits x i 0) x)))
+
+(defthm bits-diff-0
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y))))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bits-tail-gen
+    (implies (and (integerp x)
+		  (natp i)
+		  (< x (expt 2 i))
+		  (>= x (- (expt 2 (+ 1 i)))))
+	     (equal (bits x i 0)
+		    (if (>= x 0)
+			x
+		      (+ x (expt 2 (+ 1 i)))))))
+
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+		(integerp i)
+		(integerp j)
+		(integerp k))
+	   (equal (bits (fl (/ x (expt 2 k))) i j)
+		  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-2
+  (implies (and (integerp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
+
+(defthmd bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :hints (("Goal" :use (bits-shift-up-1-new))))
+
+(defthmd bits-shift-up-2
+  (implies (and (integerp x)
+		(natp k)
+		(integerp i))
+	   (equal (* (expt 2 k) (bits x i 0))
+		  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :hints (("Goal" :use (bits-shift-up-2-new))))
+
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k)
+		(<= k m)
+		(integerp y)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp k)))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits y (- n k) (- m k)))))
+
+(defthmd bits-plus-mult-2
+  (implies (and (< n k)
+		(integerp y)
+		(integerp k))
+	   (equal (bits (+ x (* y (expt 2 k))) n m)
+		  (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+(defthm bits-plus-bits
+    (implies (and (integerp m)
+		  (integerp p)
+		  (integerp n)
+		  (<= m p)
+		  (<= p n))
+	     (= (bits x n m)
+		(+ (bits x (1- p) m)
+		   (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp l)))
+	   (equal (bits (bits x i j) k l)
+		  (if (<= k (- i j))
+		      (bits x (+ k j) (+ l j))
+		    (bits x i (+ l j))))))
+
+;;bits-match can prove things like this:
+;;(thm (implies (equal 12 (bits x 15 6))
+;;		(equal 4 (bits x 8 6))))
+
+(defthmd bits-match
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free variables
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  t)))
+
+;;bits-dont-match can prove things like this:
+;;(thm (implies (equal 7 (bits x 8 6))
+;;		(not (equal 4 (bits x 15 6)))))
+
+(defthmd bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+			      (quotep j)
+			      (quotep k)))
+		(equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+		(syntaxp (and (quotep i2)
+			      (quotep j2)
+			      (quotep k2)))
+		(<= j2 j) (<= j i) (<= i i2)
+		(not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+		(<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+		(integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2))
+	   (equal (equal k (bits x i j))
+		  nil)))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+;;;**********************************************************************
+;;;				BITN
+;;;**********************************************************************
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bits-n-n-rewrite
+  (equal (bits x n n)
+	 (bitn x n)))
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+	   (equal (bitn x n)
+		  (mod (fl (/ x (expt 2 n))) 2))))
+
+;;A recursive formulation:
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+	   (equal (bitn x 0) (mod x 2))))
+
+(defthmd bitn-rec-pos
+    (implies (< 0 n)
+	     (equal (bitn x n)
+		    (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;;Use this to induce case-splitting:
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+	(equal (bitn x n) 1))
+  :rule-classes ())
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+		(case-split (integerp k)))
+	   (bvecp (bitn x n) k)))
+
+;;The following is a special case of bitn-bvecp.
+;;It is useful as a :forward-chaining rule in concert with bvecp-0-1 and
+;;bvecp-1-0.
+
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+(defthm bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defthm bitn-0
+  (equal (bitn 0 k) 0))
+
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x)))
+
+(defthm bitn-bitn-0
+    (equal (bitn (bitn x n) 0)
+	   (bitn x n)))
+
+(defthmd bitn-mod
+    (implies (and (< k n)
+		  (integerp n)
+		  (integerp k))
+	     (equal (bitn (mod x (expt 2 n)) k)
+		    (bitn x k))))
+
+(defthm bvecp-bitn-0
+    (implies (bvecp x n)
+	     (equal (bitn x n) 0)))
+
+(defthm neg-bitn-1
+    (implies (and (integerp x)
+                  (integerp n)
+                  (< x 0)
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x n) 1)))
+
+(defthm neg-bitn-0
+    (implies (and (integerp x)
+		  (natp n)
+		  (< x (- (expt 2 n)))
+		  (>= x (- (expt 2 (1+ n)))))
+	     (equal (bitn x n) 0)))
+
+
+(defthm neg-bitn-2
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp k)
+		  (< k n)
+		  (< x (- (expt 2 k) (expt 2 n)))
+		  (>= x (- (expt 2 n))))
+	     (equal (bitn x k) 0)))
+
+(defthmd bitn-minus-1
+    (implies (natp i)
+	     (equal (bitn -1 i) 1)))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+		  (natp n))
+	     (equal (bitn x n) 1)))
+
+(defthmd bvecp-bitn-2
+  (implies (and (bvecp x n)
+		(< k n)
+		(<= (- (expt 2 n) (expt 2 k)) x)
+		(integerp n)
+		(integerp k))
+	   (equal (bitn x k) 1))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bitn-shift-up
+  (implies (and (integerp n)
+		(integerp k))
+	   (equal (bitn (* x (expt 2 k)) (+ n k))
+		  (bitn x n)))
+  :hints (("Goal" :use (bitn-shift))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+		(integerp k))
+	   (equal (bitn (fl (/ x (expt 2 k))) i)
+		  (bitn x (+ i k)))))
+
+(defthmd bitn-bits
+  (implies (and (<= k (- i j))
+		(case-split (<= 0 k))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k)))
+	   (equal (bitn (bits x i j) k)
+		  (bitn x (+ j k)))))
+
+(defthm bitn-plus-bits
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (* (bitn x n) (expt 2 (- n m)))
+		   (bits x (1- n) m))))
+  :rule-classes ()
+  :hints (("Goal" :use (bitn-plus-bits-new))))
+
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+		  (integerp m)
+		  (integerp n))
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+    (implies (and (integerp x)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    (bits x (1- n) 0))))
+
+(defthmd sumbits-thm
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0))
+	     (equal (sumbits x n)
+		    x)))
+
+;; The next two lemmas allow one to prove equality of two bit vectors of width k by 
+;; proving each of these has the same value at bit i, for 0 <= i < k.
+
+(defun diff-bit (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (diff-bit x y (1- k)))))
+
+(defthmd diff-bit-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((i (diff-bit x y k)))
+             (and (natp i)
+                  (< i k))))
+  :hints (("Goal" :use (sumbits-badguy-bounds))))
+
+(defthmd diff-bit-equal
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (not (zp k))
+                (equal (bitn x (diff-bit x y k))
+                       (bitn y (diff-bit x y k))))
+           (equal (equal x y) t))
+  :hints (("Goal" :use (sumbits-badguy-is-correct))))
+
+(defthmd bitn-expt
+    (implies (case-split (integerp n))
+	     (equal (bitn (expt 2 n) n)
+		    1)))
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n)
+		  0)))
+
+(defthm bitn-plus-expt-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (not (equal (bitn (+ x (expt 2 n)) n)
+			 (bitn x n))))
+  :rule-classes ())
+
+(defthmd bitn-plus-mult
+    (implies (and (< n m) 
+		  (integerp m) 
+		  (integerp k))
+	     (equal (bitn (+ x (* k (expt 2 m))) n)
+		    (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+
+;;;**********************************************************************
+;;;			     CAT
+;;;**********************************************************************
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; We define a macro, Ca, THAT takes a list of a list X of alternating data values 
+;; and sizes.  CAT-SIZE returns the formal sum of the sizes.  X must contain at 
+;; least 1 data/size pair, but we do not need to specify this in the guard, and 
+;; leaving it out of the guard simplifies the guard proof.
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-cat)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+		(case-split (integerp k)))
+	   (bvecp (cat x m y n) k)))
+
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+	 (bits x (1- m) 0)))
+
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+	 (bits y (1- n) 0)))
+
+(defthmd cat-0
+  (implies (and (case-split (bvecp y n))
+		(case-split (integerp n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (cat 0 m y n) y)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p))
+		(case-split (<= 0 m))
+		(case-split (<= 0 n))
+		(case-split (<= 0 q))
+		(case-split (integerp m))
+		(case-split (integerp n))
+		(case-split (integerp p))
+		(case-split (integerp q)))
+	   (equal (cat (cat x m y n) p z q)
+		  (cat x m (cat y n z q) (+ n q)))))
+
+(defthmd cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep m)
+			      (quotep n)))
+		(case-split (bvecp y n))
+		(case-split (bvecp x m))
+		(case-split (< k (expt 2 (+ m n)))) ;not a problem hyp, since k, m and n are constants
+		(case-split (integerp k))
+		(case-split (<= 0 k))
+		(case-split (integerp m))
+		(case-split (<= 0 m))
+		(case-split (integerp n))
+		(case-split (<= 0 n)))
+	   (equal (equal k (cat x m y n))
+		  (and (equal y (bits k (1- n) 0))
+		       (equal x (bits k (+ -1 m n) n))))))
+
+(defthmd cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+		(case-split (bvecp y1 n))
+		(case-split (bvecp x2 m))
+		(case-split (bvecp y2 n))
+		(case-split (integerp n))
+		(case-split (<= 0 n))
+		(case-split (integerp m))
+		(case-split (<= 0 m)))
+	   (equal (equal (cat x1 m y1 n)
+			 (cat x2 m y2 n))
+		  (and (equal x1 x2)
+		       (equal y1 y2)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+		(equal n (+ 1 (- l) k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (<= l k))
+		(case-split (integerp i))
+		(case-split (integerp k))
+		(case-split (integerp l))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bits x k l) n)
+		  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (1+ k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+		  (case-split (integerp k))
+		  (case-split (integerp l))
+		  (case-split (integerp m)))
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (1+ k))
+		(case-split (<= (+ 1 (- j) i) m))
+		(case-split (<= j i))
+		(case-split (integerp i))
+		(case-split (integerp j))
+		(case-split (integerp k))
+		(case-split (integerp m)))
+	   (equal (cat (bits x i j) m (bitn x k) 1)
+		  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (1+ j))
+		(case-split (integerp i))
+		(case-split (integerp j)))
+	   (equal (cat (bitn x i) 1 (bitn x j) 1)
+		  (bits x i j))))
+
+(defthmd bits-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i))
+		(case-split (natp j)))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+					(- i n)
+				      (1- m)) 0)
+			    (1+ (- i n))
+			    (bits y (1- n) j)
+			    (- n j)))))))
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(syntaxp (quotep j))
+		(natp n)
+		(natp m)
+		(natp i)
+		(natp j))
+	   (equal (bits (cat x m y n) i j)
+		  (if (< i n)
+		      (bits y i j)
+		    (if (>= j n)
+			(bits x (if (< i (+ m n))
+				    (- i n)
+				  (1- m)) 
+			      (- j n))
+		      (cat (bits x (if (< i (+ m n))
+				       (- i n)
+				     (1- m)) 0)
+			   (1+ (- i n))
+			   (bits y (1- n) j)
+			   (- n j)))))))
+
+(defthmd bitn-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(case-split (natp i)))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+		(syntaxp (quotep m))
+		(syntaxp (quotep i))
+		(natp n)
+		(natp m)
+		(natp i))
+	   (equal (bitn (cat x m y n) i)
+		  (if (< i n)
+		      (bitn y i)
+		    (if (< i (+ m n))
+		      (bitn x (- i n))
+		    0)))))
+
+;; We introduce mbe for MULCAT not because we want particularly fast execution, 
+;; but because the existing logic definition does not satisfy the guard of cat, 
+;; which can't be changed because of the guard of bits.
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthmd mulcat-bits
+    (implies (and (integerp l)
+		  (integerp x))
+	     (equal (mulcat l n (bits x (1- l) 0))
+		    (mulcat l n x))))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+		(case-split (integerp p))
+		(case-split (natp l)))
+	   (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0))
+
+(defthm mulcat-n-1
+  (implies (case-split (<= 0 n))
+	   (equal (mulcat 1 n 1)
+		  (1- (expt 2 n)))))
+
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+		(case-split (bvecp x 1))
+		(case-split (natp m))
+		(case-split (integerp n)))
+	   (equal (bitn (mulcat 1 n x) m)
+		  x)))
+
+;;;**********************************************************************
+;;;		      Signed Integer Encodings
+;;;**********************************************************************
+
+(defun intval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defthm intval-bits
+    (implies (and (integerp x)
+		  (natp w)
+		  (< x (expt 2 (1- w)))
+		  (>= x (- (expt 2 (1- w)))))
+	     (= (intval w (bits x (1- w) 0))
+                x))
+    :rule-classes nil)
+
+(defun sign-extend (n m x)
+  (bits (intval m x) (1- n) 0))
+
+(defthmd intval-sign-extend
+    (implies (and (natp n)
+		  (natp m)
+		  (<= m n)
+		  (bvecp x m))
+	     (equal (intval n (sign-extend n m x))
+		    (intval m x))))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/bvecp-raw-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/bvecp-raw-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/bvecp-raw-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/bvecp-raw-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,800 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+;Contains bvecp lemmas about the RTL primitives.
+;Also contains type lemmas (non-negative integer, natp, etc.)
+
+(include-book "../lib3/rtl")
+(include-book "../lib3/rtlarr")
+
+(include-book "float")
+(local (include-book "../lib3/top"))
+(local (include-book "../lib3/bvecp-raw-helpers"))
+
+(set-inhibit-warnings "theory") 
+(local (in-theory nil))
+
+(set-match-free-default :all)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;; bits
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-bvecp
+   (implies (and (<= (+ 1 i (- j)) k)
+                 (case-split (integerp k))
+                 )
+            (bvecp (bits x i j) k)))
+
+
+;; setbits
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k)))
+
+
+;; setbitn
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k)))
+
+
+
+;; log<
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1))
+
+
+;; log<=
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1))
+
+
+
+;; log>
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1))
+
+
+
+;; log>=
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1))
+
+
+
+;; log=
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1))
+
+
+
+;; log<>
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1))
+
+
+
+;; logand1
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1))
+
+
+
+;; logior1
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1))
+
+
+
+;; logxor1
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1))
+
+
+
+;; lnot
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+;; bitn
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes ( :type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+;; shft
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k)))
+
+;; cat
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription cat-nonnegative-integer-type)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+
+;; logand
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n)))
+
+
+;; logior
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+
+;; mulcat
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mulcat-nonnegative-integer-type)))
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n)))
+|#
+
+;; encode
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k)))
+           (bvecp (encode x n) k)))
+
+
+;; decode
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+;BOZO dup?
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  )
+
+
+; land
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+;; lior
+
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+;; lxor
+
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+;; cat
+
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (CAT X m Y N))
+       (<= 0 (CAT X m Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x)))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x)))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
+
+
+; The two events following the next local include-book were added by Matt
+; K. June 2004: Some proofs require calls of expt to be evaluated, but some
+; calls are just too large (2^2^n for large n).  So we use the following hack,
+; which allows calls of 2^n for n<130 to be evaluated even when the
+; executable-counterpart of expt is disabled.  The use of 130 is somewhat
+; arbitrary, chosen in the hope that it suffices for relieving of hyps related
+; to widths of bit vectors
+
+
+(defun expt-exec (r i)
+  (declare (xargs :guard
+                  (and (acl2-numberp r)
+                       (integerp i)
+                       (not (and (eql r 0) (< i 0))))))
+  (mbe :logic (hide (expt r i)) ; hide may avoid potential loop
+       :exec (expt r i)))
+
+(defthm expt-2-evaluator
+  (implies (syntaxp (and (quotep n)
+                         (natp (cadr n))
+                         (< (cadr n) 130)
+                         ))
+           (equal (expt 2 n)
+                  (expt-exec 2 n))))
+
+
+;remove these?
+
+
+;;;;;;;;;;;;;;;;;;; We can probably eliminate the following if the translator
+;;;;;;;;;;;;;;;;;;; would always use 0 instead of nil when case/casex
+;;;;;;;;;;;;;;;;;;; statements have no default.
+
+;maybe leave this one?
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t)))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t)))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t)))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t)))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t)))
+|#
+
+#|
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+|#
+
+#|
+;drop?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j))
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/float.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/float.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/float.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,570 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "arithmetic-5/top" :dir :system)
+
+(local (include-book "../lib3/top"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defun nats (n) (if (zp n) () (cons (1- n) (nats (1- n)))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defun diff-bit (x y k)
+  (if (zp k)
+      0
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (diff-bit x y (1- k)))))
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+(defun sgndintval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defun signextend (n m x)
+  (bits (sgndintval m x) (1- n) 0))
+
+
+;;;**********************************************************************
+;;;                 Sign, Significand, and Exponent
+;;;**********************************************************************
+
+(defund sgn (x) 
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0) -1 +1)))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (:? x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+(defthmd expo-lower-bound
+    (implies (and (rationalp x)
+		  (not (equal x 0)))
+	     (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd expo-upper-bound
+    (implies (and (rationalp x))
+	     (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n))
+           (equal n (expo x)))
+  :rule-classes ())
+
+(defthm fp-rep
+    (implies (rationalp x)
+	     (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+
+(defthm fp-abs
+    (implies (rationalp x)
+	     (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :rule-classes ())
+
+(defthmd expo>=
+    (implies (and (<= (expt 2 n) x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= n (expo x)))
+  :rule-classes :linear)
+
+(defthmd expo<=
+    (implies (and (< x (* 2 (expt 2 n)))
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (expo x) n))
+  :rule-classes :linear)
+
+(defthm expo-2**n
+    (implies (integerp n)
+	     (equal (expo (expt 2 n))
+		    n)))
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y)))
+           (<= (expo x) (expo y)))
+  :rule-classes :linear)
+
+(defthmd bvecp-expo
+    (implies (case-split (natp x))
+	     (bvecp x (1+ (expo x)))))
+
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x))
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x))))))
+
+(defthmd sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear))
+
+(defthmd sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear))
+
+(defthmd sig-self
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (equal (sig x) x))
+  :hints (("Goal" :use (already-sig))))
+
+(defthm sig-sig
+    (equal (sig (sig x)) 
+	   (sig x)))
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ())
+
+(defthmd sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x))))
+
+(defthmd expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x)))
+
+(defthmd sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+(defthmd expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x)))))
+
+(defthmd sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x)))
+
+(defthmd sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y)))
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y)))))
+
+(defthmd expo-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (expo (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(+ (expo x) (expo y))
+		      (+ 1 (expo x) (expo y))))))
+
+(defthmd expo-prod-lower
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear)
+
+(defthmd sig-prod
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (equal (sig (* x y))
+		    (if (< (* (sig x) (sig y)) 2)
+			(* (sig x) (sig y))
+		      (* 1/2 (sig x) (sig y))))))
+
+
+;;;**********************************************************************
+;;;                          Exactness
+;;;**********************************************************************
+
+(defund exactp (x n)
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defthmd exactp2
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (exactp x n)
+		    (integerp (* x (expt 2 (- (1- n) (expo x))))))))
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n)))
+
+(defthm exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n)))
+
+(defthm exactp-abs
+  (equal (exactp (abs x) n)
+         (exactp x n))
+  :hints (("Goal" :use (exact-neg))))
+
+(defthmd exactp-shift
+  (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n))))
+
+(defthmd exactp-<=
+    (implies (and (exactp x m)
+                  (<= m n)
+                  (rationalp x)
+		  (integerp n)
+		  (integerp m))
+	     (exactp x n)))
+
+(defthmd exactp-2**n
+  (implies  (and (case-split (integerp m))
+                 (case-split (> m 0)))
+            (exactp (expt 2 n) m)))
+
+(defthm bvecp-exactp
+  (implies (bvecp x n)
+           (exactp x n)))
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ())
+
+(defthm exact-bits-1
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k))
+           (equal (integerp (/ x (expt 2 k)))
+		  (exactp x (- n k))))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-1)))
+
+(defthm exact-bits-2
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-2)))
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+		  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :use exact-bits_alt-3)))
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use exact-k+1_alt)))
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ())
+
+(defthm exactp-diff-cor
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (abs (- x y)) (abs x))
+		  (<= (abs (- x y)) (abs y)))
+	     (exactp (- x y) n))
+  :rule-classes ())
+
+(defund fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ())
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ())
+
+(defthm fp+expo
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+  		  (not (= (expo (fp+ x n)) (expo x))))
+	     (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm expo-diff-min
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ())
+
+(defund fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :rule-classes :type-prescription)
+
+(defthm exactp-fp-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :hints (("Goal" :use (fp-1))))
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x)))
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x)))
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/log.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/log.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,684 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "arithmetic-5/top" :dir :system)
+
+(local (include-book "../lib3/top"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+
+;;;**********************************************************************
+;;;                       LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+(in-theory (disable logand logior logxor))
+
+(defthmd logand-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logand i j)
+		    (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logand (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+
+(defthmd logior-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logior i j)
+		    (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+
+
+(defthmd logxor-def
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (logxor i j)
+		    (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+		       (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+
+(defthm logand-natp
+    (implies (and (natp i)
+		  (integerp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logand-natp-2
+    (implies (and (integerp i)
+		  (natp j))
+	     (natp (logand i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logand-bvecp
+    (implies (and (natp n)
+		  (bvecp x n)
+		  (integerp y))
+	     (bvecp (logand x y) n))
+    :hints (("Goal" :by logand-bvecp-g)))
+
+(defthm logior-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logior i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+(defthm logior-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n))
+	     (bvecp (logior x y) n)))
+
+(defthm logxor-natp
+    (implies (and (natp i)
+		  (natp j))
+	     (natp (logxor i j)))
+  :rule-classes (:type-prescription :rewrite))
+
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n))
+	     (bvecp (logxor x y) n)))
+
+(defun logop-2-induct-g (x y)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)))))
+  (if (and (integerp x) (integerp y))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1)))
+          t
+        (logop-2-induct-g (fl (/ x 2)) (fl (/ y 2))))
+    t))
+
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun logop-3-induct-g (x y z)
+  (declare (xargs :measure (+ (nfix (abs x)) (nfix (abs y)) (nfix (abs z)))))
+  (if (and (integerp x) (integerp y) (integerp z))
+      (if (and (or (equal x 0)
+                   (equal x -1))
+               (or (equal y 0)
+                   (equal y -1))
+               (or (equal z 0)
+                   (equal z -1)))
+	  t
+	(logop-3-induct-g (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defthmd logand-fl-2-rewrite
+    (implies (and (natp x)
+		  (natp y))
+	     (equal (fl (* 1/2 (logand x y)))
+		    (logand (fl (* 1/2 x)) (fl (* 1/2 y))))))
+
+(defthmd logior-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logior i j)))
+		    (logior (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthmd logxor-fl-2-rewrite
+    (implies (and (natp i)
+		  (natp j))
+	     (equal (fl (* 1/2 (logxor i j)))
+		    (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthm logior-not-0
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (logior x y) 0))
+	     (and (= x 0) (= y 0)))
+  :rule-classes ())
+
+(defthm logior-expt
+    (implies (and (natp n)
+		  (integerp x)
+		  (bvecp y n))
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-g)))
+
+(defthm logior-expt-2
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logior (* (expt 2 n) x)
+			(* (expt 2 n) y))
+		(* (expt 2 n) (logior x y))))
+  :rule-classes ()
+  :hints (("Goal" :by logior-expt-2-g)))
+
+
+(defthm logand-bnd
+    (implies (<= 0 x)
+	     (<= (logand x y) x))
+  :rule-classes :linear)
+
+(defthm logand-expt
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp n))
+	     (= (logand (* (expt 2 n) x) y)
+		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+  :rule-classes ()
+  :hints (("Goal" :by logand-expt-g)))
+
+(defthmd bitn-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logand x y) n)
+		    (logand (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logand)))
+
+
+(defthmd bits-logand
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logand x y) i j)
+		    (logand (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logand)))
+
+(defthmd logand-bvecp-2
+  (implies (and (natp n)
+                (bvecp x (1+ n))
+                (integerp y))
+           (equal (logand x (bits y n 0))
+                  (logand x y)))
+  :hints (("Goal" :use ((:instance bits-logand (i n) (j 0))))))
+
+(defthmd bitn-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n))
+	     (equal (bitn (logior x y) n)
+		    (logior (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logior)))
+
+
+(defthmd bits-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp i)
+		  (integerp j))
+	     (equal (bits (logior x y) i j)
+		    (logior (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logior)))
+
+
+(defthmd bitn-logxor
+    (implies (and (case-split (integerp x))
+		  (case-split (integerp y))
+		  (case-split (integerp n)))
+	     (equal (bitn (logxor x y) n)
+		    (logxor (bitn x n) (bitn y n))))
+    :hints (("Goal" :use bitn_alt-logxor)))
+
+(defthmd bits-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (bits (logxor x y) i j)
+                  (logxor (bits x i j) (bits y i j))))
+    :hints (("Goal" :use bits_alt-logxor)))
+
+(defthmd logand-expt-2
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logand x (expt 2 k))
+		    (* (expt 2 k) (bitn x k))))
+    :hints (("Goal" :use logand-expt-2-g)))
+
+(defthmd logior-expt-3
+    (implies (and (integerp x)
+		  (natp k))
+	     (equal (logior x (expt 2 k))
+		    (+ x
+		       (* (expt 2 k) 
+			  (- 1 (bitn x k))))))
+    :hints (("Goal" :use ((:instance logior-expt-3-g)))))
+
+(defthmd logand-expt-3
+    (implies (and (integerp x)
+		  (natp n)
+		  (natp k)
+		  (< k n))
+	     (equal (logand x (- (expt 2 n) (expt 2 k)))
+		    (* (expt 2 k) (bits x (1- n) k))))
+    :hints (("Goal" :use ((:instance logand-expt-3-g)))))
+
+(defthmd logand-expt-4
+    (implies (and (natp n)
+		  (natp k)
+		  (natp l)
+		  (< l k)
+		  (<= k n))
+	     (equal (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+		    (- (expt 2 n) (expt 2 k))))
+    :hints (("Goal" :use ((:instance logand-expt-4-g)))))
+
+(defthmd logand-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logand (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logand x y)))))
+
+(defthmd logxor-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logxor (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logxor x y)))))
+
+(defthmd logior-shift
+    (implies (and (integerp x)
+		  (integerp y)
+		  (natp k))
+	     (equal (logior (* (expt 2 k) x)
+			    (* (expt 2 k) y))
+		    (* (expt 2 k) (logior x y)))))
+
+(defthmd fl-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logand x y) (expt 2 k)))
+                  (logand (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logior x y) (expt 2 k)))
+                  (logior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+(defthmd fl-logxor
+  (implies (and (integerp x)
+                (integerp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (logxor x y) (expt 2 k)))
+                  (logxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k)))))))
+
+
+;;;**********************************************************************
+;;;                               LOGNOT
+;;;**********************************************************************
+
+(in-theory (disable lognot))
+
+(defthmd lognot-def
+    (implies (integerp x)
+	     (equal (lognot x)
+		    (1- (- x)))))
+
+(defthmd bitn-lognot
+    (implies (and (integerp x)
+		  (integerp n)
+		  (> n 0))
+	     (not (equal (bitn (lognot x) n)
+			 (bitn x n))))
+    :hints (("Goal" :use bitn_alt-lognot)))
+
+(defthmd logand-bitn-lognot-1
+  (implies (and (integerp n)
+                (integerp x)
+                (integerp y))                
+           (equal (logand (bitn (lognot x) n) (bitn y n))
+                  (logand (lognot (bitn x n)) (bitn y n))))
+  :hints (("Goal" :cases ((< n 0))
+                  :use ((:instance bits-lognot (i n) (j n))
+                        bitn-0-1
+                        (:instance bitn-0-1 (x y))))))
+
+(defthmd logand-bitn-lognot-alt
+  (implies (and (integerp n)
+                (integerp x)
+                (integerp y))
+           (equal (logand (bitn y n) (bitn (lognot x) n))
+                  (logand (bitn y n) (lognot (bitn x n)))))
+  :hints (("Goal" :cases ((< n 0))
+                  :use ((:instance bits-lognot (i n) (j n))
+                        bitn-0-1
+                        (:instance bitn-0-1 (x y))))))
+
+(defthmd bits-lognot
+    (implies (and (natp i)
+		  (natp j)
+		  (<= j i)
+		  (integerp x))
+	     (equal (bits (lognot x) i j)
+		    (- (1- (expt 2 (- (1+ i) j))) (bits x i j)))))
+
+(defthmd bits-lognot-bits
+  (implies (and (integerp x)
+                (natp i)
+                (natp j)
+                (natp k)
+                (natp l)
+                (<= l k)
+                (<= k (- i j)))
+           (equal (bits (lognot (bits x i j)) k l)
+                  (bits (lognot x) (+ k j) (+ l j))))
+  :hints (("Goal" :in-theory (enable bits-lognot))))
+
+(defthmd bits-lognot-bits-lognot
+  (implies (and (integerp x)
+                (natp i)
+                (natp j)
+                (natp k)
+                (natp l)
+                (<= l k)
+                (<= k (- i j)))
+           (equal (bits (lognot (bits (lognot x) i j)) k l)
+                  (bits x (+ k j) (+ l j))))
+  :hints (("Goal" :in-theory (enable bits-lognot-bits))))
+
+
+
+(defthmd logand-bits-lognot
+  (implies (and (integerp x)
+                (integerp n)
+                (bvecp y (1+ n)))
+           (equal (logand y (bits (lognot x) n 0))
+                  (logand y (lognot (bits x n 0)))))
+  :hints (("Goal" :use ((:instance logand-bvecp-2 (x y) (y (lognot (bits x n 0)))))
+                  :cases ((< n 0))
+                  :in-theory (enable bits-lognot-bits))))
+
+(defthmd lognot-shift
+  (implies (and (integerp x)
+                (natp k))
+           (equal (lognot (* (expt 2 k) x))
+		  (+ (* (expt 2 k) (lognot x))
+		     (1- (expt 2 k))))))
+
+(defthmd lognot-fl
+  (implies (and (integerp x)
+                (not (zp n)))
+           (equal (lognot (fl (/ x n)))
+                  (fl (/ (lognot x) n))))
+  :hints (("Goal" :use ((:instance fl-m-n (m (- x))))
+                  :in-theory (enable lognot))))                
+
+
+;;;**********************************************************************
+;;;                         Algebraic Properties
+;;;**********************************************************************
+
+(defthm lognot-lognot
+    (implies (case-split (integerp i))
+	     (equal (lognot (lognot i))
+		    i)))
+
+(defthm logand-x-0
+    (equal (logand x 0) 0))
+
+(defthm logand-0-y
+    (equal (logand 0 y) 0))
+
+(defthm logior-x-0
+    (implies (integerp x)
+	     (equal (logior x 0) x)))
+
+(defthm logior-0-y
+    (implies (integerp y)
+	     (equal (logior 0 y) y)))
+
+(defthm logxor-x-0
+    (implies (integerp x)
+	     (equal (logxor x 0) x)))
+
+(defthm logxor-0-y
+    (implies (integerp y)
+	     (equal (logxor 0 y) y)))
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logior-self
+    (implies (case-split (integerp i))
+	     (equal (logior i i) i)))
+
+(defthm logxor-self
+  (equal (logxor i i) 0))
+
+(defthm logand-x-m1
+    (implies (integerp x)
+	     (equal (logand x -1) x)))
+
+(defthm logand-m1-y
+    (implies (integerp y)
+	     (equal (logand -1 y) y)))
+
+(defthm logand-x-1
+    (implies (bvecp x 1)
+	     (equal (logand x 1) x)))
+
+(defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x)))
+
+(defthm logior-x-m1
+    (implies (integerp x)
+	     (equal (logior x -1) -1)))
+
+(defthm logior-m1-y
+    (implies (integerp y)
+	     (equal (logior -1 y) -1)))
+
+(defthm logior-1-x
+  (implies (bvecp x 1)
+           (equal (logior 1 x) 1)))
+
+(defthm logior-x-1
+  (implies (bvecp x 1)
+           (equal (logior x 1) 1)))
+
+
+(defthm logxor-m1
+    (implies (integerp x)
+	     (equal (logxor x -1)
+		    (lognot x))))
+
+(defthm logand-commutative
+    (equal (logand j i) (logand i j)))
+
+(defthm logior-commutative
+    (equal (logior j i) (logior i j)))
+
+(defthm logxor-commutative
+    (equal (logxor j i) (logxor i j)))
+
+(defthm logand-associative
+    (equal (logand (logand i j) k)
+           (logand i (logand j k))))
+
+(defthm logior-associative
+    (equal (logior (logior i j) k)
+	   (logior i (logior j k))))
+
+(defthm logxor-associative
+    (equal (logxor (logxor i j) k)
+	   (logxor i (logxor j k))))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+	 (logand i j k)))
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+	 (logior i j k)))
+
+(defthm logxor-commutative-2
+  (equal (logxor j i k)
+	 (logxor i j k)))
+
+(defthmd lognot-logxor
+    (and (equal (logxor (lognot i) j)
+                (lognot (logxor i j)))
+         (equal (logxor j (lognot i))
+                (lognot (logxor i j)))))
+
+(defthmd logior-logand
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z))))
+  :hints (("Goal" :by logior-logand-g)))
+
+(defthmd logand-logior
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand x (logior y z))
+	   (logior (logand x y) (logand x z))))
+  :hints (("Goal" :by logand-logior-g)))
+
+
+(defthmd logior-logand-2
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logand  (logior y z) x)
+	   (logior (logand y x) (logand z x)))))
+
+(defthmd log3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z))
+    (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+	   (logior (logand x y) (logand (logxor x y) z)))))
+
+(defthmd logxor-rewrite-2
+  (implies (and (integerp x)
+                (integerp y))
+           (equal (logxor x y)
+                  (logior (logand x (lognot y))
+                          (logand y (lognot x)))))
+  :hints (("Goal" :by logxor-rewrite-2-g)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/logn.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/logn.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/logn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/logn.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,855 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; (include-book "bits")
+(include-book "float")
+
+(local (include-book "../lib3/logn"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+
+;;;**********************************************************************
+;;;                     LNOT
+;;;**********************************************************************
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthmd lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+		(case-split (integerp k)))
+	   (bvecp (lnot x n) k)))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n))))))
+
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n)))
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n)))))))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n))))
+
+(defthm mod-lnot
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n))
+           (equal (mod (lnot x n) (expt 2 k))
+                  (lnot (mod x (expt 2 k)) k))))
+
+(defthmd bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j))))))
+
+(defthmd bitn-lnot
+  (implies (and (case-split (natp k))
+		(case-split (natp n)))
+	   (equal (bitn (lnot x n) k)
+		  (if (< k n)
+		      (lnot (bitn x k) 1)
+		    0))))
+
+(defthmd lnot-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot (cat x m y n) l)
+		  (cat (lnot x m) m (lnot y n) n))))
+
+
+;;;**********************************************************************
+;;;                LAND, LIOR, and LXOR
+;;;**********************************************************************
+
+(defund binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-land)))
+
+(defund binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lior)))
+
+(defund binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x))
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+(in-theory (disable (:type-prescription binary-lxor)))
+
+(defun lognop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (lognop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+(defun lognop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (lognop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+(defun lognop-3-induct (x y z)
+  (declare (xargs :measure (:? x y z)))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(lognop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defthm land-x-y-0
+    (equal (land x y 0) 0))
+
+(defthm lior-x-y-0
+    (equal (lior x y 0) 0))
+
+(defthm lxor-x-y-0
+    (equal (lxor x y 0) 0))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0) y n)
+         (land x y n)))
+
+(defthmd land-bits-2
+  (equal (land x (bits y (1- n) 0) n)
+         (land x y n)))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0) y n)
+         (lior x y n)))
+
+(defthmd lior-bits-2
+  (equal (lior x (bits y (1- n) 0) n)
+         (lior x y n)))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0) y n)
+         (lxor x y n)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x (bits y (1- n) 0) n)
+         (lxor x y n)))
+
+(defthm land-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (land x y n) k)))
+
+(defthm lior-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lior x y n) k)))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k) (case-split (integerp k)))
+	   (bvecp (lxor x y n) k)))
+
+(defthm land-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (land x y n) m)))
+
+(defthm lior-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lior x y n) m)))
+
+(defthm lxor-bvecp-2
+    (implies (and (bvecp x m)
+		  (bvecp y m))
+	     (bvecp (lxor x y n) m)))
+
+(defthmd land-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land x y m) (land x y n))))
+
+(defthmd lior-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (natp n)
+		  (natp m))
+	     (equal (lior x y m) (lior x y n))))
+
+(defthmd lxor-reduce
+  (implies (and (bvecp x n)
+		(bvecp y n)
+		(< n m)
+		(case-split (integerp m)))
+	   (equal (lxor x y m) (lxor x y n))))
+
+(defthmd land-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lior-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (bitn x 0) (bitn y 0) 1)))))
+
+(defthmd lxor-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (bitn x 0) (bitn y 0) 1)))))
+
+(defthm land-0
+  (equal (land 0 y n)
+	 0))
+
+(defthmd land-equal-0
+  (implies (and (bvecp i 1)
+		(bvecp j 1))
+	   (equal (equal 0 (land i j 1))
+		  (or (equal i 0)
+		      (equal j 0)))))
+
+(defthm lior-0
+  (implies (case-split (bvecp y n))
+	   (equal (lior 0 y n) y)))
+
+(defthmd lior-equal-0
+  (implies (and (case-split (bvecp x n))
+		(case-split (bvecp y n))
+		(case-split (integerp n)))
+	   (equal (equal 0 (lior x y n))
+		  (and (equal x 0)
+		       (equal y 0)))))
+
+(defthm lxor-0
+  (implies (case-split (bvecp y n))
+	   (equal (lxor 0 y n) y)))
+
+(defthm land-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land x y (- n k)))))
+  :rule-classes ())
+
+(defthm lxor-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor x y (- n k)))))
+  :rule-classes ())
+
+(defthm lior-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior x y (- n k)))))
+  :rule-classes ())
+
+(defthmd fl-land
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
+                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lior
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
+                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd fl-lxor
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
+                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n))))
+
+(defthmd mod-land
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land x y n) (expt 2 k))
+                  (land x y k))))
+
+(defthmd mod-lior
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior x y n) (expt 2 k))
+                  (lior x y k))))
+
+(defthmd mod-lxor
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor x y n) (expt 2 k))
+                  (lxor x y k))))
+
+(defthm bits-land
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (land x y n) i j)
+		  (land (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lior
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lior x y n) i j)
+		  (lior (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bits-lxor
+  (implies (and (case-split (<= 0 j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lxor x y n) i j)
+		  (lxor (bits x i j) 
+			(bits y i j) 
+			(+ (min n (1+ i)) (- j))))))
+
+(defthm bitn-land
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (land x y n) k)
+		  (if (< k n)
+		      (land (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lior
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lior x y n) k)
+		  (if (< k n)
+		      (lior (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthm bitn-lxor
+  (implies (and (case-split (<= 0 k))
+		(case-split (integerp n)))
+	   (equal (bitn (lxor x y n) k)
+		  (if (< k n)
+		      (lxor (bitn x k) 
+			    (bitn y k) 
+			    1)
+		    0))))
+
+(defthmd land-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (land x1 x2 m) m (land y1 y2 n) n))))
+
+(defthm land-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (land c (cat x2 m y2 n) l)
+		  (cat (land (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (land (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lior-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lior x1 x2 m) m (lior y1 y2 n) n))))
+
+(defthm lior-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lior c (cat x2 m y2 n) l)
+		  (cat (lior (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lior (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthmd lxor-cat
+  (implies (and (case-split (natp n))
+		(case-split (integerp m))
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
+		  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n))))
+
+(defthm lxor-cat-constant
+  (implies (and (case-split (integerp n))
+		(case-split (integerp m))
+		(syntaxp (quotep c))
+		(> n 0)
+		(> m 0)
+		(equal l (+ m n)))
+	   (equal (lxor c (cat x2 m y2 n) l)
+		  (cat (lxor (bits c (+ -1 m n) n) x2 m)
+		       m
+		       (lxor (bits c (1- n) 0) y2 n)
+		       n))))
+
+(defthm land-bnd
+    (implies (case-split (<= 0 x))
+	     (<= (land x y n) x))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior-bnd
+  (implies (case-split (bvecp x n))
+	   (<= x (lior x y n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm lxor-bnd
+  (<= (lxor x y n) (lior x y n))
+  :rule-classes (:rewrite :linear))
+
+(defthmd lior-plus
+  (implies (= (land x y n) 0)
+           (equal (lior x y n)
+                  (+ (bits x (1- n) 0)
+                     (bits y (1- n) 0)))))
+
+(defthmd land-with-shifted-arg
+  (implies (and (integerp x)
+		(rationalp y)
+		(integerp m)
+		(integerp n)
+		(<= 0 m))
+	   (equal (land (* (expt 2 m) x) y n)
+		  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m)))))))
+
+(defthm lior-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n))
+           (= (lior (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ())
+
+(defthmd land-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (land x (expt 2 k) n)
+		  (* (expt 2 k) (bitn x k)))))
+
+(defthm lior-expt
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n))
+	     (= (lior x (expt 2 k) n)
+		(+ (bits x (1- n) 0)
+		   (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ())
+
+(defthmd lxor-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor x (expt 2 k) n)
+		  (+ (bits x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn x k))))))))
+
+(defthm land-ones
+  (equal (land (1- (expt 2 n)) x n)
+	 (bits x (1- n) 0))
+  :rule-classes nil)
+
+(defthm land-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+		(equal k (1- (expt 2 n))))
+	   (equal (land k x n)
+		  (bits x (1- n) 0))))
+
+(defthm lior-ones
+  (implies (and (case-split (bvecp x n))
+		(case-split (natp n)))
+	   (equal (lior (1- (expt 2 n)) x n)
+		  (1- (expt 2 n))))
+  :rule-classes ())
+
+(defthm lior-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lior k x n)
+		  (1- (expt 2 n)))))
+
+(defthm lxor-ones
+  (implies (case-split (bvecp x n))
+	   (equal (lxor (1- (expt 2 n)) x n)
+		  (lnot x n)))
+  :rule-classes ())
+
+(defthm lxor-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+			      (quotep n)
+			      (equal (cadr k) (1- (expt 2 (cadr n))))))
+		(force (equal k (1- (expt 2 n))))
+		(case-split (bvecp x n)))
+	   (equal (lxor k x n)
+		  (lnot x n))))
+
+(defthm land-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (land x (- (expt 2 i) (expt 2 j)) n)
+		  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ())
+
+(defthmd lior-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j))))
+
+(defthmd lxor-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lxor x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i) (- n i)
+                       (lnot (bits x (1- i) j) (- i j)) (- i j)
+                       (bits x (1- j) 0) j))))
+
+(defthmd land-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k))))))
+
+
+;;;**********************************************************************
+;;;                Algebraic Properties
+;;;**********************************************************************
+
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+		(case-split (bvecp x n)))
+	   (equal (lnot (lnot x n) n)
+		  x)))
+
+(defthm land-commutative
+  (equal (land y x n)
+	 (land x y n)))
+
+(defthm lior-commutative
+  (equal (lior y x n)
+	 (lior x y n)))
+
+(defthm lxor-commutative
+  (equal (lxor y x n)
+	 (lxor x y n)))
+
+(defthm land-associative
+  (equal (land (land x y n) z n)
+	 (land x (land y z n) n)))
+
+(defthm lior-associative
+  (equal (lior (lior x y n) z n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-associative
+  (equal (lxor (lxor x y n) z n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-commutative-2
+  (equal (land y (land x z n) n)
+	 (land x (land y z n) n)))
+
+(defthm lior-commutative-2
+  (equal (lior y (lior x z n) n)
+	 (lior x (lior y z n) n)))
+
+(defthm lxor-commutative-2
+  (equal (lxor y (lxor x z n) n)
+	 (lxor x (lxor y z n) n)))
+
+(defthm land-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (land x (land y z n) n)
+		  (land (land x y n) z n))))
+
+(defthm lior-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lior x (lior y z n) n)
+		  (lior (lior x y n) z n))))
+
+(defthm lxor-combine-constants
+  (implies (syntaxp (and (quotep x) (quotep y) (quotep n)))
+	   (equal (lxor x (lxor y z n) n)
+		  (lxor (lxor x y n) z n))))
+
+(defthm land-self
+  (equal (land x x n)
+	 (bits x (1- n) 0)))
+
+(defthm lior-self
+  (implies (and (case-split (bvecp x n))
+		(case-split (integerp n)))
+	   (equal (lior x x n) x)))
+
+(defthm lxor-self
+  (implies (case-split (bvecp x n))
+	   (equal (lxor x x n) 0)))
+
+(defthmd lior-land-1
+  (equal (lior x (land y z n) n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd lior-land-2
+  (equal (lior (land y z n) x n)
+	 (land (lior x y n) (lior x z n) n)))
+
+(defthmd land-lior-1
+  (equal (land x (lior y z n) n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd land-lior-2
+  (equal (land (lior y z n) x n)
+	 (lior (land x y n) (land x z n) n)))
+
+(defthmd lior-land-lxor
+  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
+	 (lior (land x y n) (land (lxor x y n) z n) n)))
+
+(defthmd lxor-rewrite
+  (equal (lxor x y n)
+	 (lior (land x (lnot y n) n)
+	       (land y (lnot x n) n)
+	       n)))
+
+(defthmd lnot-lxor
+  (equal (lnot (lxor x y n) n)
+	 (lxor (lnot x n) y n)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/logn2log.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/logn2log.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/logn2log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/logn2log.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,93 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "log")
+(include-book "logn")
+
+(local (include-book "../lib3/logn2log"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+(defthm land-logand
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (land x y n)
+                  (logand x y))))
+
+(defthm lior-logior
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lior x y n)
+                  (logior x y))))
+
+
+(defthm lxor-logxor
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (equal (lxor x y n)
+                  (logxor x y))))
+
+(defthm logior-bvecp
+  (implies (and (bvecp x n) (bvecp y n))
+           (bvecp (logior x y) n)))
+           
+
+
+(defthm logand-bvecp
+  (implies (and (natp n) (bvecp x n) (integerp y))
+           (bvecp (logand x y) n)))
+
+(defthm logxor-bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n))
+           (bvecp (logxor x y) n)))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+
+;; (defthm lnot-lognot
+;;   (implies (and (integerp x)
+;;                 (natp n))
+;;            (equal (lnot x n)
+;;                   (bits (lognot x) (1- n) 0)))
+;;   :hints (("Goal" :use (lnot-lognot-1))))
+
+
+
+
+         
+
+             
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/masc.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/masc.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/masc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/masc.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,400 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+(INCLUDE-BOOK "misc/total-order" :dir :system)
+
+(encapsulate ()
+
+(local (INCLUDE-BOOK "../lib3/rtl"))
+(local (INCLUDE-BOOK "../lib3/rtlarr"))
+
+(defund fl (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+;;CAT (concatenation):
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+(defun cat-size (x)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
+;;Equality comparison:
+
+;Leaving this enabled caused a stack overflow in simple-loops when building one of our models.
+;However, we have very few lemmas about log=, so you may want to enable this for your proofs.
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;;Unsigned inequalities:
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<)))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log<=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<=)))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>)))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription))
+
+;;This rule is no better than log>=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log>=)))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log=-commutative
+       (equal (log= x y)
+              (log= y x))
+       :hints (("Goal" :in-theory (enable log=))))
+
+;;This rule is no better than log=-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log=)))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+	 (log<> y x)))
+
+;;This rule is no better than log<>-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription log<>)))
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;Basic properties of arrays:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r)))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;;We disable as and ag, assuming the rules proved in this book are 
+;;sufficient to manipulate any record terms that are encountered.
+
+(in-theory (disable as ag))
+
+)
+
+(encapsulate ()
+
+(local (INCLUDE-BOOK "bits"))
+(local (include-book "arithmetic-5/top" :dir :system))
+
+; We have decided to allow setbits to open up in terms of cat.  So, we leave it
+; enabled.
+
+(defun setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (integerp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defun setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (integerp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))))
+  (setbits x w n n y))
+
+)
+
+(defun intval (w x)
+  (if (= (bitn x (1- w)) 1)
+      (- x (expt 2 w))
+    x))
+
+(defun logior1 (x y)
+  (if (and (equal x 0) (equal y 0)) 0 1))
+
+(defun logand1 (x y)
+  (if (or (equal x 0) (equal y 0)) 0 1))
+
+(defun lognot1 (x)
+  (if (equal x 0) 1 0))
+
+(defun true () 1)
+
+(defun false () 0)
+
+(defmacro if1 (x y z) `(if (eql ,x 0) ,z ,y))    
+
+(defmacro in-function (fn term)
+  `(if ,term () (er hard ',fn "Assertion ~x0 failed" ',term)))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/mult.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/mult.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/mult.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/mult.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,486 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "add")
+
+(local (include-book "../lib3/top"))
+
+(set-inhibit-warnings "theory")
+(local (in-theory nil))
+
+	       
+;;;**********************************************************************
+;;;			Radix-4 Booth Encoding
+;;;**********************************************************************
+
+
+(defun theta (i y)
+  (+ (bitn y (1- (* 2 i))) 
+     (bitn y (* 2 i))
+     (* -2 (bitn y (1+ (* 2 i))))))
+
+
+(defun sum-theta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (theta (1- m) y))
+	(sum-theta (1- m) y))))
+
+
+
+(defthm sum-theta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 2 m))))
+	     (equal y (sum-theta m y)))
+  :rule-classes ())
+
+
+(defun bmux4 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (0  0)))
+
+(defun neg (x) (if (< x 0) 1 0))
+
+(encapsulate ((zeta (i) t))
+ (local (defun zeta (i) (declare (ignore i)) 0))
+ (defthm zeta-bnd 
+     (and (integerp (zeta i))
+	  (<= (zeta i) 2)
+	  (>= (zeta i) -2))))
+
+
+(defun pp4 (i x n)
+  (if (zerop i)
+      (cat 1 1
+	   (bitn (lognot (neg (zeta i))) 0) 1
+	   (bmux4 (zeta i) x n) n)
+    (cat 1 1
+	 (bitn (lognot (neg (zeta i))) 0) 1
+	 (bmux4 (zeta i) x n) n
+	 0 1
+	 (neg (zeta (1- i))) 1
+	 0 (* 2 (1- i)))))
+
+(defun sum-zeta (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 2 (1- m))) (zeta (1- m)))
+       (sum-zeta (1- m)))))   
+
+(defun sum-pp4 (x m n)
+  (if (zp m)
+      0
+    (+ (pp4 (1- m) x n)
+       (sum-pp4 x (1- m) n))))
+
+
+(defthm booth4-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4 x m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x (sum-zeta m))
+		   (- (* (expt 2 (* 2 (1- m))) (neg (zeta (1- m))))))))
+  :rule-classes ())
+
+(defun pp4-theta (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (theta i y))) 0) 1
+	    (bmux4 (theta i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (theta i y))) 0) 1
+	  (bmux4 (theta i y) x n) n
+	  0 1
+	  (neg (theta (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-theta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-theta (1- m) x y n)
+       (sum-pp4-theta x y (1- m) n))))
+
+
+(defthm booth4-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+		  (bvecp y (1- (* 2 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-theta x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Statically Encoded Multiplier Arrays
+;;;**********************************************************************
+
+
+
+(defun m-mu-chi (i mode)
+  (cond ((equal mode 'mu)  
+         (if (zp i)  1
+           (cons (cons 1  i) 1)))
+        ((equal mode 'chi)
+         (if (zp i)  0
+           (cons (cons 1  i) 0)))))
+             
+
+(mutual-recursion
+ (defun mu (i y)
+   (declare (xargs :measure (m-mu-chi i 'mu)))
+     (+ (bits y (1+ (* 2 i)) (* 2 i)) (chi i y)))
+ 
+ (defun chi (i y)
+   (declare (xargs :measure (m-mu-chi i 'chi)))
+   (if (zp i)
+       0
+     (if (>= (mu (1- i) y) 3)
+	 1
+       0))))
+
+
+(defun phi (i y)
+  (if (= (bits (mu i y) 1 0) 3)
+      -1
+    (bits (mu i y) 1 0)))
+
+(defthm phi-bnd
+    (member (phi i y) '(-1 0 1 2)))
+
+(defun sum-odd-powers-of-2 (m)
+  (if (zp m)
+      0
+    (+ (expt 2 (1- (* 2 m)))
+       (sum-odd-powers-of-2 (1- m)))))
+
+
+
+(defthm chi-m
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal (chi m y) 0))
+  :rule-classes())
+
+
+(defthm phi-m-1
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (>= (phi (1- m) y) 0))
+  :rule-classes())
+
+(defun sum-phi (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (phi (1- m) y))
+	(sum-phi (1- m) y))))
+
+
+(defthm sum-phi-lemma
+    (implies (and (natp m)
+		  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (equal y (sum-phi m y)))
+  :rule-classes ())
+
+(defun pp4-phi (i x y n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (phi i y))) 0) 1
+	    (bmux4 (phi i y) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (phi i y))) 0) 1
+	  (bmux4 (phi i y) x n) n
+	  0 1
+	  (neg (phi (1- i) y)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-phi (x y m n)
+  (if (zp m)
+      0
+    (+ (pp4-phi (1- m) x y n)
+       (sum-pp4-phi x y (1- m) n))))
+
+
+(defthm static-booth
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (1- n))
+                  (natp y)
+		  (<= y (sum-odd-powers-of-2 m)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-phi x y m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                Encoding Redundant Representations
+;;;**********************************************************************
+
+
+(defun gamma (i a b c)
+   (if (zp i)
+       (bitn c 0)
+     (logior (bitn  a (+ -1  (* 2 i)))
+ 	     (bitn  b (+ -1  (* 2 i))))))
+
+(defun delta (i a b c d)
+  (if (zp i)
+      (bitn d 0)
+    (logand (logior (logand (bitn a (+ -2 (* 2 i))) 
+			    (bitn b (+ -2 (* 2 i))))
+		    (logior (logand (bitn a (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))
+			    (logand (bitn b (+ -2 (* 2 i)))
+				    (gamma (1- i) a b c))))
+	    (lognot (logxor (bitn a (1- (* 2 i))) 
+			    (bitn b (1- (* 2 i))))))))
+
+(defun psi (i a b c d)
+  (if (not (natp i))
+      0
+    (+ (bits a (1+ (* 2 i)) (* 2 i))
+       (bits b (1+ (* 2 i)) (* 2 i))
+       (gamma i a b c)
+       (delta i a b c d)
+       (* -4 (+ (gamma (1+ i) a b c)
+                (delta (1+ i) a b c d))))))
+
+
+(defthm psi-m-1
+    (implies (and (natp m)
+                  (>= m 1)
+		  (bvecp a (- (* 2 m) 2))   
+		  (bvecp b (- (* 2 m) 2))  
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (and (equal (gamma m a b c) 0)
+		  (equal (delta m a b c d) 0)
+		  (>= (psi (1- m) a b c d) 0)))
+  :rule-classes ())
+
+
+(defun sum-psi (m a b c d)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 2 (1- m))) (psi (1- m) a b c d))
+	(sum-psi (1- m) a b c d))))
+
+
+(defthm sum-psi-lemma
+    (implies (and (natp m)
+                  (<= 1 M) ;; add
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1))
+	     (equal (+ a b c d) (sum-psi m a b c d)))
+  :rule-classes ())
+
+
+
+(defthmd psi-bnd
+  (and (integerp (psi i a b c d))
+       (<= (psi i a b c d) 2)
+       (>= (psi i a b c d) -2)))
+
+(defun pp4-psi (i x a b c d n)
+   (if (zerop i)
+       (cat 1 1
+	    (bitn (lognot (neg (psi i a b c d))) 0) 1
+	    (bmux4 (psi i a b c d) x n) n)
+     (cat 1 1
+	  (bitn (lognot (neg (psi i a b c d))) 0) 1
+	  (bmux4 (psi i a b c d) x n) n
+	  0 1
+	  (neg (psi (1- i) a b c d)) 1
+	  0 (* 2 (1- i)))))
+
+(defun sum-pp4-psi (x a b c d m n)
+  (if (zp m)
+      0
+    (+ (pp4-psi (1- m) x a b c d n)
+       (sum-pp4-psi x a b c d (1- m) n))))
+
+
+
+(defthm redundant-booth
+    (implies (and (natp m)
+                  (<= 1 m)
+                  (not (zp n))
+		  (bvecp x (1- n))
+		  (bvecp a (- (* 2 m) 2))
+		  (bvecp b (- (* 2 m) 2))
+		  (bvecp c 1)
+		  (bvecp d 1)
+		  (= y (+ a b c d)))
+	     (= (+ (expt 2 n)
+		   (sum-pp4-psi x a b c d m n))
+		(+ (expt 2 (+ n (* 2 m)))
+		   (* x y))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;			Radix-8 Booth Encoding
+;;;**********************************************************************
+
+
+
+(defun eta (i y)
+  (+ (bitn y (1- (* 3 i))) 
+     (bitn y (* 3 i))
+     (* 2 (bitn y (1+ (* 3 i))))
+     (* -4 (bitn y (+ 2 (* 3 i))))))
+
+
+(defun sum-eta (m y)
+   (if (zp m)
+       0
+     (+ (* (expt 2 (* 3 (1- m))) (eta (1- m) y))
+	(sum-eta (1- m) y))))
+
+
+(defthm sum-eta-lemma
+    (implies (and (not (zp m))
+		  (bvecp y (1- (* 3 m))))
+	     (equal y (sum-eta m y)))
+  :rule-classes ())
+
+
+
+;; (defun bmux8 (zeta x n)
+;;   (case zeta
+;;     (1  x)
+;;     (-1 (bits (lognot x) (1- n) 0))
+;;     (2  (* 2 x))
+;;     (-2 (bits (lognot (* 2 x)) (1- n) 0))
+;;     (3  (* 3 x))
+;;     (-3 (bits (lognot (* 3 x)) (1- n) 0))
+;;     (4  (* 4 x))
+;;     (-4 (bits (lognot (* 4 x)) (1- n) 0))
+;;     (0  0)))
+
+
+(defun bmux8 (zeta x n)
+  (case zeta
+    (1  x)
+    (-1 (bits (lognot x) (1- n) 0))
+    (2  (* 2 x))
+    (-2 (bits (lognot (* 2 x)) (1- n) 0))
+    (3  (* 3 x))
+    (-3 (bits (lognot (* 3 x)) (1- n) 0))
+    (4  (* 4 x))
+    (-4 (bits (lognot (* 4 x)) (1- n) 0))
+    (0  0)))
+
+(encapsulate ((xi (i) t))
+ (local (defun xi (i) (declare (ignore i)) 0))
+ (defthm xi-bnd 
+     (and (integerp (xi i))
+	  (<= (xi i) 4)
+	  (>= (xi i) -4))))
+
+
+
+(defun pp8 (i x n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (xi i))) 0) 1
+	   (bmux8 (xi i) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (xi i))) 0) 1
+	 (bmux8 (xi i) x n) n
+	 0 2
+	 (neg (xi (1- i))) 1
+	 0 (* 3 (1- i)))))
+
+
+(defun sum-xi (m)
+  (if (zp m)
+      0
+    (+ (* (expt 2 (* 3 (1- m))) (xi (1- m)))
+       (sum-xi (1- m)))))   
+
+(defun sum-pp8 (x m n)
+  (if (zp m)
+      0
+    (+ (pp8 (1- m) x n)
+       (sum-pp8 x (1- m) n))))
+
+
+(defthm booth8-thm
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2)))
+	     (= (+ (expt 2 n)
+		   (sum-pp8 x m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x (sum-xi m))
+		   (- (* (expt 2 (* 3 (1- m))) (neg (xi (1- m))))))))
+  :rule-classes ())
+
+(defun pp8-eta (i x y n)
+  (if (zerop i)
+      (cat 3 2
+	   (bitn (lognot (neg (eta i y))) 0) 1
+	   (bmux8 (eta i y) x n) n)
+    (cat 3 2
+	 (bitn (lognot (neg (eta i y))) 0) 1
+	 (bmux8 (eta i y) x n) n
+	 0 2
+	 (neg (eta (1- i) y)) 1
+	 0 (* 3 (1- i)))))
+
+(defun sum-pp8-eta (x y m n)
+  (if (zp m)
+      0
+    (+ (pp8-eta (1- m) x y n)
+       (sum-pp8-eta x y (1- m) n))))
+
+
+(defthm booth8-corollary
+    (implies (and (not (zp n))
+		  (not (zp m))
+		  (bvecp x (- n 2))
+		  (bvecp y (1- (* 3 m))))
+	     (= (+ (expt 2 n)
+		   (sum-pp8-eta x y m n))
+		(+ (expt 2 (+ n (* 3 m)))
+		   (* x y))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/reps.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/reps.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/reps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/reps.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,673 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "arithmetic-5/top" :dir :system)
+(include-book "float")
+(local (include-book "../lib3/top"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH EXPLICIT MSB
+;;;***************************************************************
+
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;BOZO add rewrite rule?
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q)))
+           (and (integerp (bias q))
+                (>= (bias q) 0)))
+  :rule-classes :type-prescription)
+
+;BOZO disable?
+(defun esgnf  (x p q) (bitn x (+ p q)))
+(defun eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defun esigf  (x p)   (bits x (1- p) 0))
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+(defthm eencodingp-not-zero
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (not (equal (edecode x p q) 0))))
+
+(defthm erepp-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (erepp (edecode x p q) p q)))
+
+
+(defthm eencodingp-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (eencodingp (eencode x p q) p q) ))
+
+(defthm edecode-eencode
+    (implies (and (erepp x p q)
+		  (integerp p)
+;		  (> p 0)
+		  (integerp q)
+	;	  (> q 0)
+                  )
+	     (equal (edecode (eencode x p q) p q)
+		    x)))
+
+(defthm eencode-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (>= p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (eencode (edecode x p q) p q)
+		    x)))
+
+(defthm expo-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (edecode x p q))
+		    (- (eexpof x p q) (bias q)))))
+
+(defthm sgn-edecode
+    (implies (and (eencodingp x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (edecode  x p q))
+		    (if (= (esgnf x p q) 0) 1 -1))))
+
+(defthm sig-edecode
+    (implies (and (eencodingp  x p q)
+		  (integerp p)
+		  (> p 0)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (edecode  x p q))
+		    (/ (esigf x p) (expt 2 (- p 1))))))
+
+(defund rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthmd rebias-lower
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :hints (("Goal" :use (rebias-down))))
+
+(defthmd rebias-higher
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (bitn (lognot x) (1- m)))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :hints (("Goal" :use (rebias-up))))
+
+
+;;;***************************************************************
+;;;          REPRESENTATIONS WITH IMPLICIT MSB
+;;;***************************************************************
+
+;;Bit vectors of length p+q, consisting of 1-bit sign field, q-bit 
+;;exponent field (bias = 2**(q-1)-1), and (p-1)-bit significand field, 
+;;where p > 1.
+
+;;Field extractors:
+
+(defun isgnf (x p q) (bitn x (1- (+ p q))))
+(defun iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defun isigf (x p) (bits x (- p 2) 0))
+
+
+;Representable numbers (normals and denormal):
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       ;number of bits available in the sig field = p - 1 - ( - bias - expo(x))
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x)))))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;Valid encodings:
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(defund iencodingp (x p q)
+  (or (nencodingp x p q)
+      (dencodingp x p q)))
+
+(defthm not-both-nrepp-and-drepp
+    (implies (irepp x p q)
+	     (iff (nrepp x p q) (not (drepp x p q))))
+  :rule-classes ())
+
+(defthm not-both-nencodingp-and-dencodingp
+    (implies (iencodingp x p q)
+	     (iff (nencodingp x p q) (not (dencodingp x p q))))
+  :rule-classes ())
+
+
+;;Encoding functions:
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(defund iencode (x p q)
+  (cond ((nrepp x p q)
+	 (nencode x p q))
+	((drepp x p q)
+	 (dencode x p q))))
+
+
+;;Decoding functions:
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+(defund idecode (x p q)
+  (cond ((nencodingp x p q)
+	 (ndecode x p q))
+	((dencodingp x p q)
+	 (ddecode x p q))))
+
+
+;;Field extraction:
+
+(defthm sgn-ndecode
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ndecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))  
+	     (equal (expo (ndecode x p q))
+		    (- (iexpof x p q) (bias q)))))
+
+(defthm sig-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ndecode x p q))
+		    (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))))
+
+(defthm sgn-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sgn (ddecode x p q))
+		    (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (expo (ddecode x p q))
+		    (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))
+
+(defthm sig-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (ddecode x p q))
+		    (sig (isigf x p)))))
+
+(defthm sgn-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (sgn (idecode x p q))
+	      (if (= (isgnf x p q) 0) 1 -1))))
+
+(defthm expo-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal
+	      (expo (idecode x p q))
+	      (cond ((nencodingp x p q)
+		     (- (iexpof x p q) (bias q)))         
+		    ((dencodingp x p q)
+		     (+ 2 (- p) (- (bias q)) (expo (isigf x p))))))))
+
+(defthm sig-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (sig (idecode x p q))
+		    (cond ((nencodingp x p q)
+			   (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
+			  ((dencodingp x p q)
+			   (sig (isigf x p)))))))
+
+;;Inversions:
+
+(defthm dencodingp-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (integerp q)
+		  (> q 0))
+	     (dencodingp (dencode x p q) p q)))
+
+(defthm iencodingp-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (iencodingp (iencode x p q) p q)))
+
+(defthm nrepp-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (nrepp (ndecode x p q) p q)))
+
+(defthm drepp-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (drepp (ddecode x p q) p q)))
+
+(defthm irepp-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (irepp (idecode x p q) p q)))
+
+(defthm nencodingp-nencode
+    (implies (and (nrepp x p q)
+                  (integerp p)
+                  (> p 1)
+                  (integerp q)
+                  (> q 0))
+             (nencodingp (nencode x p q) p q)))
+
+(defthm ndecode-nencode
+    (implies (and (nrepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ndecode (nencode x p q) p q)
+		    x)))
+
+(defthm ddecode-dencode
+    (implies (and (drepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (ddecode (dencode x p q) p q)
+		    x)))
+
+(defthm idecode-iencode
+    (implies (and (irepp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (idecode (iencode x p q) p q)
+		    x)))
+
+(defthm nencode-ndecode
+    (implies (and (nencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (nencode (ndecode x p q) p q)
+		    x)))
+
+(defthm dencode-ddecode
+    (implies (and (dencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (dencode (ddecode x p q) p q)
+		    x)))
+
+(defthm iencode-idecode
+    (implies (and (iencodingp x p q)
+		  (integerp p)
+		  (> p 1)
+		  (integerp q)
+		  (> q 0))
+	     (equal (iencode (idecode x p q) p q)
+		    x)))
+
+;; Smallest positive normal:
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+(defthmd positive-spn
+  (> (spn q) 0)
+  :rule-classes ( :linear))
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q)))
+
+(defthmd smallest-spn
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs x) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once)))
+
+;; Smallest positive denormal:
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q)))
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q)))) 
+
+(defthmd spd-mult
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (> r 0)
+		(rationalp r)
+		(= m (/ r (spd p q))))
+	   (iff (drepp r p q)
+		(and (natp m)
+		     (<= 1 m)
+		     (< m (expt 2 (1- p)))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/rom-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/rom-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/rom-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/rom-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,64 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(local (include-book "../../support/support/rom-helpers"))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+(local (in-theory (enable bvecp)))
+
+(defun natp (x)
+  (declare (xargs :guard t))
+  (and (integerp x)
+       (<= 0 x)))
+
+(defun check-array (name a dim1 dim2)
+  (if (zp dim1)
+      t
+    (and (bvecp (aref1 name a (1- dim1)) dim2)
+	 (check-array name a (1- dim1) dim2))))
+
+(defthm check-array-lemma-1
+    (implies (and (not (zp dim1))
+		  (check-array name a dim1 dim2)
+		  (natp i)
+		  (< i dim1))
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+(defthm check-array-lemma
+    (implies (and (bvecp i n)
+		  (not (zp (expt 2 n)))
+		  (check-array name a (expt 2 n) dim2))		  
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/round.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/round.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/round.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/round.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1681 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "arithmetic-5/top" :dir :system)
+(include-book "reps")
+(local (include-book "../lib3/top"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+(defund bitn (x n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp n))))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defund mulcat (l n x)
+  (declare (xargs :guard (and (integerp l) (< 0 l) (acl2-numberp n) (natp x))))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond ((eql n 1)
+                     (bits x (1- l) 0))
+                    ((and (integerp n) (> n 0))
+                     (cat (mulcat l (1- n) x)
+                          (* l (1- n))
+                          x
+                          l))
+                    (t 0))))
+
+
+;;;**********************************************************************
+;;;                         Truncation
+;;;**********************************************************************
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) 
+     (fl (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm trunc-to-0
+    (implies (and ;(rationalp x)
+		  (integerp n)
+		  (<= n 0))
+	     (equal (trunc x n) 0)))
+
+(defthmd sgn-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (sgn (trunc x n))
+		    (sgn x))))
+
+(defthm trunc-positive
+   (implies (and (< 0 x)
+                 (case-split (rationalp x))
+                 (case-split (integerp n))
+                 (case-split (< 0 n))
+                 )
+            (< 0 (trunc x n)))
+   :rule-classes (:rewrite :linear))
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+(defthm trunc-0
+  (equal (trunc 0 n) 0))
+
+(defthmd trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+(defthmd trunc-shift
+  (implies (integerp n)
+           (equal (trunc (* x (expt 2 k)) n)
+                  (* (trunc x n) (expt 2 k)))))
+
+(defthmd trunc-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+  :rule-classes :linear)
+
+(defthm expo-trunc
+    (implies (and (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (equal (expo (trunc x n))
+                    (expo x))))
+
+(defthmd trunc-lower-bound
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (abs (trunc x n)) (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd trunc-lower-2-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+                  (> N 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+(defthm trunc-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (trunc x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a))
+	     (<= a (trunc x n))))
+
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+(defthm trunc-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+(defthmd trunc-trunc
+    (implies (and (>= n m)
+                  (integerp n)
+		  (integerp m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m))))
+
+(defthm plus-trunc
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (trunc y k))
+		(trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits_alt-trunc)))))
+
+(defthm trunc-logand
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) ;(> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0))
+           (= (trunc x k)
+              (logand x (- (expt 2 m) (expt 2 (- n k))))))
+  :rule-classes ())
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m))))))
+  :hints (("Goal" :use ((:instance trunc-split_alt)))))
+
+
+;;;**********************************************************************
+;;;                    Rounding Away from Zero
+;;;**********************************************************************
+
+(defund away (x n)
+  (* (sgn x) 
+     (cg (* (expt 2 (1- n)) (sig x))) 
+     (expt 2 (- (1+ (expo x)) n))))
+
+(defthmd away-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (away x n)))
+  :rule-classes :type-prescription)
+
+(defthmd away-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (away x n)
+		    (* (sgn x) 
+		       (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthmd abs-away
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (equal (abs (away x n)) 
+		    (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+(defthm away-to-0
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n))
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+(defthmd sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x)))
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-0
+  (equal (away 0 n) 0))
+
+
+(defthmd away-minus
+  (= (away (* -1 x) n) (* -1 (away x n))))
+
+(defthmd away-shift
+    (implies (integerp n)
+	     (= (away (* x (expt 2 k)) n)
+		(* (away x n) (expt 2 k)))))
+
+(defthmd away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthmd away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+(defthmd away-upper-bound
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+(defthmd away-upper-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthmd away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthmd away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-expo-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (natp n))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthmd expo-away-lower-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+
+(defthmd expo-away-upper-bound
+    (implies (and (rationalp x)
+		  (natp n))
+	     (<= (expo (away x n)) (1+ (expo x))))
+  :rule-classes :linear)
+
+
+(defthmd expo-away
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (away x n))
+                    (expo x))))
+
+(defthmd away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+(defthmd away-monotone
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (<= x y))
+	     (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+
+(defthm away-midpoint
+    (implies (and (natp n)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+
+(defthmd away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (away y k))
+              (away (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm minus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (< y x)
+                (integerp k)
+                (> k 0)
+                (> (+ k (- (expo (- x y)) (expo y))) 0)
+                (= n (+ k (- (expo x) (expo y)))) ;; why we need "n"??
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (equal (- x (trunc y k))
+                  (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus-minus
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (not (= x 0))
+                  (not (= y 0))
+                  (not (= (+ x y) 0))
+                  (integerp k)
+                  (> k 0)
+                  (= k1 (+ k (- (expo x) (expo y))))
+                  (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+                  (exactp x k1)
+                  (> k2 0))
+             (equal (+ x (trunc y k))
+                    (if (= (sgn (+ x y)) (sgn y))
+                        (trunc (+ x y) k2)
+                      (away (+ x y) k2))))
+    :rule-classes ())
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                      Rounding to Nearest Even
+;;;**********************************************************************
+
+(defun re (x)
+  (- x (fl x)))
+
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+
+(defthm near-choice
+    (or (= (near x n) (trunc x n))
+	(= (near x n) (away x n)))
+  :rule-classes ())
+
+
+(defthmd sgn-near
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x))))
+
+(defthm near-positive
+    (implies (and (< 0 x)
+                  (< 0 n)
+                  (rationalp x)
+		  (integerp n))
+	     (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :rule-classes (:type-prescription :linear))
+
+(defthm near-0
+  (equal (near 0 n) 
+         0))
+
+(defthm near-exactp-a
+    (implies (< 0 n)
+	     (exactp (near x n) n)))
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd near-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n))))
+
+(defthmd near-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n))))
+
+(defthm expo-near
+    (implies (and (rationalp x)
+		  (> n 0)
+                  (integerp n)
+		  (not (= (abs (near x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near x n))
+                    (expo x)))
+  :rule-classes ())
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+(defthmd near-shift
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k)))))
+
+(defthmd near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+(defthm near1-a
+    (implies (and (< (abs (- x (trunc x n))) ;; note the abs
+                     (abs (- (away x n) x)))
+                  (rationalp x)
+		  (integerp n))
+	     (equal (near x n)
+                    (trunc x n)))
+  :rule-classes ())
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+(defthm near2
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+(defthm near-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  ;(<= 0 x) ;; not necessary
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (near y n))))
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ())
+
+(defthm near-boundary
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (< 0 x)
+		  (< x a)
+		  (< a y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp a (1+ n))
+		  (not (exactp a n)))
+	     (< (near x n) (near y n)))
+  :rule-classes ())
+
+(defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+
+(defthm near-plus
+  (implies (and (exactp x (1- (+ k (- (expo x) (expo y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                         Rounding to Nearest
+;;;**********************************************************************
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+(defthm near+-choice
+    (or (= (near+ x n) (trunc x n))
+	(= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) (* -1 (near+ x n))))
+
+(defthm near+-positive
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0
+  (equal (near+ 0 n) 0))
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n)))
+           (equal (equal (near+ x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthm near+-exactp-c
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (near+ x n))))
+
+(defthm near+-exactp-d
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near+ x n))))
+
+(defthm expo-near+
+    (implies (and (rationalp x)
+		  (natp n)
+		  (not (= (abs (near+ x n)) (expt 2 (1+ (expo x))))))
+	     (equal (expo (near+ x n))
+                    (expo x)))
+  :rule-classes ())
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ; (> n 0) ;; not necessary
+		  (< (abs (- x (trunc x n)))
+                     (abs (- (away x n) x)))) ;; note the abs
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+		  (integerp n)
+		  ;; (> n 0)
+		  (> (abs (- x (trunc x n)))
+                     (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+2
+    (implies (and  (exactp y n)
+                   (rationalp x)
+                   (rationalp y)
+		  (integerp n)
+		  (> n 0))
+
+	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+(defthm near+-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(< 0 x)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+
+(defthm near+-midpoint
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (equal (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near-power-a
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near+-plus
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+(defthm near+-trunc-cor
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n)
+                  (> n m)
+		  (> m 0))
+	     (= (near+ (trunc x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                          Sticky Rounding
+;;;**********************************************************************
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defthm sgn-sticky
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (sticky x n))
+		    (sgn x))))
+
+(defthmd sticky-positive
+    (implies (and (< 0 x)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (> (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthmd sticky-negative
+    (implies (and (< x 0)
+                  (rationalp x) 
+		  (integerp n)
+                  (> n 0))
+	     (< (sticky x n) 0))
+  :rule-classes :linear)
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0))
+
+(defthmd sticky-minus
+  (equal (sticky (* -1 x) n) (* -1 (sticky x n))))
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+(defthm sticky-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0))
+	     (exactp (sticky x n) n))
+  :rule-classes ())
+
+(defthm sticky-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (sticky x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthmd sticky-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (natp n))
+           (<= (sticky x n) (sticky y n)))
+  :rule-classes :linear)
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+(defthm trunc-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+(defthm away-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+(defthm near-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+(defthm near+-sticky
+    (implies (and (rationalp x)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+(defthm sticky-sticky
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ())
+
+(defthm sticky-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (not (= y 0))
+		  (not (= (+ x y) 0))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    IEEE Rounding
+;;;**********************************************************************
+
+(defund inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+(defthmd inf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (>= (inf x n) x))
+  :rule-classes :linear)
+
+(defund minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defthmd minf-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n)))
+	     (<= (minf x n) x))
+  :rule-classes :linear)
+
+(defund IEEE-mode-p (mode)
+  (member mode '(trunc inf minf near)))
+
+(defund common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defthmd ieee-mode-is-common-rounding
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode))
+  :hints (("Goal" :in-theory (enable common-rounding-mode-p))))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode))
+           (or (= (rnd x mode n) (trunc x n))
+	       (= (rnd x mode n) (away x n))))
+  :rule-classes ())
+
+(defthmd sgn-rnd
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (rnd x mode n))
+		    (sgn x))))
+(defthm rnd-0
+  (equal (rnd 0 mode n)
+         0))
+
+(defthm rnd-positive
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+(defthm rnd-negative
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription))
+
+; Unlike the above, we leave the following two as rewrite rules because we may
+; want to use the rewriter to relieve their hypotheses.
+
+(defthm rnd-non-pos
+    (implies (<= x 0)
+	     (<= (rnd x mode n) 0))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm rnd-non-neg
+    (implies (<= 0 x)
+	     (<= 0 (rnd x mode n)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m))))
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n))))
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n)))
+
+(defthm rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+		  (exactp x n))))
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n))))
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n))))
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+  :rule-classes ())
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0) ;; 
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ())
+
+(defthmd rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ())
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (INTEGERP N)
+                  (> N 0))
+	     (<= (rnd x mode n) (rnd y mode n))))
+
+(defthm rnd-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (common-rounding-mode-p mode)
+		  (integerp k))
+	     (= (rnd (* x (expt 2 k)) mode n)
+		(* (rnd x mode n) (expt 2 k))))
+  :rule-classes ())
+
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthmd rnd-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (rationalp x)
+                (integerp m) 
+		(> m 0)
+                (integerp n) 
+		(>= n (+ m 2)))
+           (equal (rnd (sticky x n) mode m)
+                  (rnd x mode m))))
+
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+(defthm rnd-const-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ())
+
+(defun roundup (x mode n)
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise ())))
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :rule-classes ()
+  :hints (("Goal" :use roundup_alt-thm)))
+  
+
+;;;**********************************************************************
+;;;                         Denormal Rounding 
+;;;**********************************************************************
+
+(defund drnd (x mode p q)
+  (rnd x mode (+ p (expo x) (- (expo (spn q))))))
+
+(defthmd drnd-minus
+  (equal (drnd (* -1 x) mode p q)
+         (* -1 (drnd x (flip mode) p q))))
+
+(defthm drnd-exactp-a
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd x mode p q) p q)
+               (= (drnd x mode p q) 0)
+               (= (drnd x mode p q) (* (sgn x) (spn q)))))
+  :rule-classes nil)
+
+(defthmd drnd-exactp-b
+  (implies (and (rationalp x)
+	        (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd x mode p q)
+                  x)))
+
+(defthmd drnd-exactp-c
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(>= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (>= a (drnd x mode p q))))
+
+(defthmd drnd-exactp-d
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+		(rationalp a)
+                (drepp a p q)
+		(<= a x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (<= a (drnd x mode p q))))
+
+(defthm drnd-trunc
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (abs (drnd x 'trunc p q))
+               (abs x))))
+
+(defthm drnd-away
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (abs (drnd x 'away p q))
+               (abs x))))
+
+(defthm drnd-minf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (<= (drnd x 'minf p q)
+               x)))
+
+(defthm drnd-inf
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (rationalp x)
+                (<= (abs x) (spn q)))
+           (>= (drnd x 'inf p q)
+               x)))
+
+(defthm drnd-diff
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd x mode p q))) (spd p q))))
+
+(defthm drnd-near-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near p q))))))
+
+(defthm drnd-near+-est
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp a p q))
+           (>= (abs (- x a)) (abs (- x (drnd x 'near+ p q))))))
+
+(defthm drnd-sticky
+    (implies (and (common-rounding-mode-p mode)
+		  (natp p)
+		  (> p 1)
+		  (natp q)
+		  (> q 0)
+		  (rationalp x)
+                  (<= (abs x) (spn q))
+		  (natp n)
+		  (>= n (+ p (expo x) (- (expo (spn q))) 2)))
+	     (equal (drnd (sticky x n) mode p q)
+		    (drnd x mode p q)))
+  :rule-classes ())
+
+(defthmd drnd-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn q))
+                (common-rounding-mode-p mode)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (drnd x mode p q)
+                  (- (rnd (+ x (* (sgn x) (spn q))) mode p)
+		     (* (sgn x) (spn q))))))
+
+(defthm drnd-tiny-equal
+    (implies (and (common-rounding-mode-p mode)
+                  (natp p)
+                  (> p 1) ;;
+                  (natp q)
+                  (> q 0)
+                  (rationalp x)
+                  (< 0 x)
+                  (< (abs x) (/ (spd p q) 2))
+                  (rationalp y)
+                  (< 0 y)
+                  (< (abs y) (/ (spd p q) 2)))
+             (equal (drnd x mode p q)
+                    (drnd y mode p q)))
+    :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/simple-loop-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,359 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+;(set-enforce-redundancy t)
+
+(include-book "../lib3/rtl")
+(include-book "../lib3/rtlarr")
+(include-book "log")
+(include-book "../../arithmetic/top")
+(local (include-book "../lib3/top"))
+(local (include-book "../lib3/simple-loop-helpers"))
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I)))
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+
+;; (defthm bitn-setbitn-setbitn
+;;   (implies (and (<  j w)
+;;                 (<= 0 j) 
+;;                 (integerp w)
+;;                 (integerp j))
+;;            (equal (bitn (setbitn x w j y)
+;;                         j)
+;;                   (bitn y 0))))
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;not in support/simple-loop-helpers since would be redefined here (which is illegal)
+
+;; (deftheory simple-loop-thy-0
+;;   (union-theories '(if1) (theory 'minimal-theory)))
+
+;; (deftheory simple-loop-thy-1
+;;   (union-theories
+;;    '(bitn-setbitn-not-equal
+;;      ag-diff-as
+;;      bits-31-0
+;;      natp)
+;;    (theory 'simple-loop-thy-0)))
+
+;(in-theory (enable setbits bitn-cat))
+
+(in-theory (enable setbits))
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/simplify-model-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,119 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "../lib3/rtl")
+(include-book "../lib3/arith")
+(include-book "float") ;; Hack: we just definition of bits 
+
+(local (include-book "../lib3/simplify-model-helpers"))
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k)))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1)))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p)))
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+; bvecp-if1 is analogous to the above, and is already included in rtl.lisp
+
+; Setbits can introduce a call of cat, which can introduce (bits (sig n) 2 0)
+; say, even though sig is a single bit.  So we add the following.
+
+(defthm cat-bitn-m-equal-cat-bitn-1
+  (implies (and (syntaxp (and (quote m)
+                              (natp (cadr m))
+                              (> (cadr m) 1)))
+                (natp m)
+                (> m 1))
+           (equal (cat (bitn x i) m y n)
+                  (cat (bitn x i) 1 y n))))
+
+;(in-theory (enable bvecp-monotone))
+;(in-theory (enable bvecp-bits-0))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/lib3.delta2/top.lisp acl2-6.3/books/rtl/rel9/support/lib3.delta2/top.lisp
--- acl2-6.2/books/rtl/rel9/support/lib3.delta2/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/lib3.delta2/top.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,44 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+(include-book "basic") ;basic arithmetic functions: floor, ceiling, and mod
+
+(include-book "bits") ;bit vectors
+
+(include-book "log") ;logical operations
+
+(include-book "float") ;floating-point numbers
+
+(include-book "reps") ;floating-point formats and representations
+
+(include-book "round") ;floating-point rounding
+
+(include-book "add") ;support for reasoning about integer addition
+
+(include-book "masc") ;SystemC
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/Makefile acl2-6.3/books/rtl/rel9/support/support/Makefile
--- acl2-6.2/books/rtl/rel9/support/support/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/Makefile	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,18 @@
+include ../../../../Makefile-generic
+
+# BOOKS = mod4 add3-proofs add3 all-ones ash bias-proofs bias bitn bitn-proofs						\
+#         bits bits-proofs bvecp-proofs bvecp bvecp-helpers bvecp-lemmas ocat						\
+#         lnot-proofs lnot decode-proofs decode encode fast-and ground-zero ireps log-proofs log land0-proofs land0		\
+# 	lextra-proofs lextra0 lextra cat-proofs cat cat-def									\
+#         lior0-proofs lior0 logand logand-proofs logeqv logior-proofs logior logior1-proofs logior1 lognot logorc1 logs	\
+#         logxor lop1-proofs lop1 lop2-proofs lop2 lop3-proofs lop3 lxor0-proofs lxor0 float sumbits merge model-helpers  \
+# 	badguys mulcat-proofs mulcat rewrite-theory rnd rom-helpers rtl rtlarr						\
+#         setbits-proofs setbits setbitn-proofs setbitn shft sgn simple-loop-helpers					\
+#         sticky-proofs sticky trunc-proofs trunc bits-trunc-proofs bits-trunc away-proofs away near-proofs		\
+# 	near near+-proofs near+ oddr-proofs oddr rnd util log-equal lop1 lop2 lop3 ereps-proofs ereps ireps		\
+# 	stick-proofs stick drnd-original merge2 fadd clocks openers package-defs simplify-model-helpers                          \
+# 	top1 land lior lxor guards \
+# 	fadd-extra fadd-extra0 float-extra round-extra top
+
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/support/README acl2-6.3/books/rtl/rel9/support/support/README
--- acl2-6.2/books/rtl/rel9/support/support/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/README	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,7 @@
+See the comments in top.lisp.
+See also ../../README
+
+Some of the books and lemmas which used to be in support/ have been moved to arithmetic/.
+
+This directory is still a mess (all our gross hacks are in support/), but we are gradually burying them in
+-proofs books.
diff -Nru acl2-6.2/books/rtl/rel9/support/support/add3-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/add3-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/add3-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/add3-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,444 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "merge")
+(local (include-book "bitn"))
+(local (include-book "bits"))
+(local (include-book "../../arithmetic/top"))
+;(local (include-book "../../arithmetic/mod"))
+
+(defun add3-measure (x y z)
+  (acl2-count (+ x y z)))
+
+(defthm add3-1
+    (implies (and (integerp x)
+		  (> x 0))
+	     (and (>= (fl (/ x 2)) 0)
+		  (< (fl (/ x 2)) x)))
+  :rule-classes ())
+
+(defthm recursion-by-add3-measure
+    (IMPLIES (AND (INTEGERP X)
+		  (<= 0 X)
+		  (INTEGERP Y)
+		  (<= 0 Y)
+		  (INTEGERP Z)
+		  (<= 0 Z)
+		  (NOT (AND (EQUAL X 0)
+			    (EQUAL Y 0)
+			    (EQUAL Z 0))))
+	     (e0-ord-< (ADD3-MEASURE (FL (* 1/2 x))
+				     (FL (* 1/2 y))
+				     (FL (* 1/2 z)))
+		       (ADD3-MEASURE X Y Z)))
+  :hints (("Goal" :use ((:instance add3-1)
+			(:instance add3-1 (x y))
+			(:instance add3-1 (x z))))))
+
+(in-theory (disable add3-measure))
+
+(include-book "ordinals/e0-ordinal" :dir :system)
+
+(set-well-founded-relation e0-ord-<)
+
+(defun add3-induct (x y z)
+  (declare (xargs :measure (add3-measure x y z)))
+  (if (and (integerp x) (>= x 0)
+	   (integerp y) (>= y 0)
+	   (integerp z) (>= z 0))
+      (if (and (= x 0) (= y 0) (= z 0))
+	  ()
+	(add3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    ()))
+
+(in-theory (disable logand logior logxor))
+
+(defthm add3-2
+    (implies (and (INTEGERP X)
+;		  (<= 0 X)
+		  (INTEGERP Y)
+;		  (<= 0 Y)
+		  (INTEGERP Z)
+	;	  (<= 0 Z)
+                  )
+	     (= (LOGXOR (FL (* X 1/2))
+			(LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
+		(fl (/ (logxor x (logxor y z)) 2))))
+  :rule-classes())
+
+(defthm add3-3
+    (implies (and (INTEGERP X)
+;		  (<= 0 X)
+		  (INTEGERP Y)
+	;	  (<= 0 Y)
+		  (INTEGERP Z)
+		;  (<= 0 Z)
+                  )
+	     (= (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
+			(LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
+				(LOGAND (FL (* Y 1/2)) (FL (* Z 1/2)))))
+		(fl (/ (logior (logand x y)
+			       (logior (logand x z) (logand y z)))
+		       2))))
+  :rule-classes())
+
+(defthm add3-4
+    (IMPLIES (AND (INTEGERP X)
+;		  (<= 0 X)
+		  (INTEGERP Y)
+;		  (<= 0 Y)
+		  (INTEGERP Z)
+;		  (<= 0 Z)
+;		  (NOT (AND (= X 0) (= Y 0) (= Z 0)))
+		  (IMPLIES (AND (INTEGERP (FL (* X 1/2)))
+;				(<= 0 (FL (* X 1/2)))
+				(INTEGERP (FL (* Y 1/2)))
+;				(<= 0 (FL (* Y 1/2)))
+				(INTEGERP (FL (* Z 1/2)))
+	;			(<= 0 (FL (* Z 1/2)))
+                                )
+			   (= (+ (FL (* X 1/2))
+				 (FL (* Y 1/2))
+				 (FL (* Z 1/2)))
+			      (+ (LOGXOR (FL (* X 1/2))
+					 (LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
+				 (* 2
+				    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
+					    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
+						    (LOGAND (FL (* Y 1/2))
+							    (FL (* Z 1/2))))))))))
+	     (= (+ (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)))
+		(+ (fl (/ (logxor x (logxor y z)) 2))
+		   (* 2 (fl (/ (logior (logand x y) (logior (logand x z) (logand y z))) 2))))))
+  :rule-classes ()
+  :hints (("Goal" :use (add3-2 add3-3))))
+
+(defthm add3-5
+    (IMPLIES (AND (INTEGERP X)
+;		  (<= 0 X)
+		  (INTEGERP Y)
+	;	  (<= 0 Y)
+		  (INTEGERP Z)
+;		  (<= 0 Z)
+                  )
+	     (= (fl (/ (+ (bitn x 0) (bitn y 0) (bitn z 0)) 2))
+		(bitn (logior (logand x y) (logior (logand x z) (logand y z))) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-logior)
+           :use ((:instance bitn-0-1 (n 0))
+			(:instance bitn-0-1 (n 0) (x y))
+			(:instance bitn-0-1 (n 0) (x z))
+			(:instance bitn-0-1 (n 0))
+                        ))))
+
+(defthm add3-6
+    (IMPLIES (AND (INTEGERP X)
+		;  (<= 0 X)
+		  (INTEGERP Y)
+;		  (<= 0 Y)
+		  (INTEGERP Z)
+;		  (<= 0 Z)
+                  )
+	     (= (bitn (+ x y z) 0)
+		(bitn (logxor x (logxor y z)) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bitn-logxor-0 (a x) (b (+ y z)))
+			(:instance bitn-logxor-0 (a y) (b z))
+			(:instance bitn-logxor (n 0) (y (+ y z)))
+			(:instance bitn-logxor (n 0) (y (logxor y z)))
+	;		(:instance logxor-nat (i y) (j z))
+                        ))))
+
+(defthm add3-7
+    (IMPLIES (AND (INTEGERP X)
+;		  (<= 0 X)
+		  (INTEGERP Y)
+;		  (<= 0 Y)
+		  (INTEGERP Z)
+	;	  (<= 0 Z)
+                  )
+	     (= (fl (/ (+ x y z) 2))
+		(fl (+ (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)) (/ (+ (bitn x 0) (bitn y 0) (bitn z 0)) 2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-def)
+		  :use ((:instance quot-mod (n 2) (m x))
+			(:instance quot-mod (n 2) (m y))
+			(:instance quot-mod (n 2) (m z))))))
+
+(defthm add3-8
+    (IMPLIES (AND (INTEGERP X)
+;		  (<= 0 X)
+		  (INTEGERP Y)
+	;	  (<= 0 Y)
+		  (INTEGERP Z)
+		;  (<= 0 Z)
+                  )
+	     (= (fl (/ (+ x y z) 2))
+		(+ (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))
+		   (fl (/ (+ (bitn x 0) (bitn y 0) (bitn z 0)) 2)))))
+  :rule-classes ()
+  :hints (("Goal" :use (add3-7
+			(:instance fl+int-rewrite
+				   (x (/ (+ (bitn x 0) (bitn y 0) (bitn z 0)) 2))
+				   (n (+ (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)))))))))
+
+(defthm add3-9
+    (IMPLIES (AND (INTEGERP X)
+;		  (<= 0 X)
+		  (INTEGERP Y)
+	;	  (<= 0 Y)
+		  (INTEGERP Z)
+		;  (<= 0 Z)
+;		  (NOT (AND (= X 0) (= Y 0) (= Z 0)))
+		  (IMPLIES (AND (INTEGERP (FL (* X 1/2)))
+			;	(<= 0 (FL (* X 1/2)))
+				(INTEGERP (FL (* Y 1/2)))
+				;(<= 0 (FL (* Y 1/2)))
+				(INTEGERP (FL (* Z 1/2)))
+;(<= 0 (FL (* Z 1/2)))
+                                )
+			   (= (+ (FL (* X 1/2))
+				 (FL (* Y 1/2))
+				 (FL (* Z 1/2)))
+			      (+ (LOGXOR (FL (* X 1/2))
+					 (LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
+				 (* 2
+				    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
+					    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
+						    (LOGAND (FL (* Y 1/2))
+							    (FL (* Z 1/2))))))))))
+	     (= (fl (/ (+ x y z) 2))
+		(+ (fl (/ (logxor x (logxor y z)) 2))
+		   (* 2 (fl (/ (logior (logand x y) (logior (logand x z) (logand y z))) 2)))
+		   (bitn (logior (logand x y) (logior (logand x z) (logand y z))) 0))))
+  :rule-classes ()
+  :hints (("Goal" :use (add3-4 add3-5 add3-8))))
+
+(defthm add3-10
+    (IMPLIES (AND (INTEGERP X)
+	;	  (<= 0 X)
+		  (INTEGERP Y)
+;		  (<= 0 Y)
+		  (INTEGERP Z)
+	;	  (<= 0 Z)
+;		  (NOT (AND (= X 0) (= Y 0) (= Z 0)))
+		  (IMPLIES (AND (INTEGERP (FL (* X 1/2)))
+;				(<= 0 (FL (* X 1/2)))
+				(INTEGERP (FL (* Y 1/2)))
+;				(<= 0 (FL (* Y 1/2)))
+				(INTEGERP (FL (* Z 1/2)))
+	;			(<= 0 (FL (* Z 1/2)))
+                                )
+			   (= (+ (FL (* X 1/2))
+				 (FL (* Y 1/2))
+				 (FL (* Z 1/2)))
+			      (+ (LOGXOR (FL (* X 1/2))
+					 (LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
+				 (* 2
+				    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
+					    (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
+						    (LOGAND (FL (* Y 1/2))
+							    (FL (* Z 1/2))))))))))
+	     (= (fl (/ (+ x y z) 2))
+		(+ (fl (/ (logxor x (logxor y z)) 2))
+		   (logior (logand x y) (logior (logand x z) (logand y z))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-def)
+		  :use (add3-9
+			(:instance quot-mod
+				   (m (logior (logand x y) (logior (logand x z) (logand y z))))
+				   (n 2))
+                                   ))))
+
+(defthm add3-11
+  (IMPLIES (AND (INTEGERP X)
+                (INTEGERP Y)
+                (INTEGERP Z)
+;                (NOT (AND (= X 0) (= Y 0) (= Z 0)))
+                (IMPLIES (AND (INTEGERP (FL (* X 1/2)))
+                              (INTEGERP (FL (* Y 1/2)))
+                              (INTEGERP (FL (* Z 1/2)))
+                              )
+                         (= (+ (FL (* X 1/2))
+                               (FL (* Y 1/2))
+                               (FL (* Z 1/2)))
+                            (+ (LOGXOR (FL (* X 1/2))
+                                       (LOGXOR (FL (* Y 1/2)) (FL (* Z 1/2))))
+                               (* 2
+                                  (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Y 1/2)))
+                                          (LOGIOR (LOGAND (FL (* X 1/2)) (FL (* Z 1/2)))
+                                                  (LOGAND (FL (* Y 1/2))
+                                                          (FL (* Z 1/2))))))))))
+           (= (+ X Y Z)
+              (+ (LOGXOR X (LOGXOR Y Z))
+                 (* 2
+                    (LOGIOR (LOGAND X Y)
+                            (LOGIOR (LOGAND X Z)
+                                    (LOGAND Y Z)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-def)
+           :use (add3-10
+                 add3-6
+                 (:instance quot-mod (n 2) (m (+ x y z)))
+;			(:instance logxor-nat (i x) (j (logxor y z)))
+;		(:instance logxor-nat (i y) (j z))
+                 (:instance quot-mod (n 2) (m (logxor x (logxor y z))))))))
+
+
+;begin Eric's additions
+(defun add3-measure-neg (x y z)
+  (acl2-count (+ (abs x) (abs y) (abs z))))
+
+(local (include-book "../../arithmetic/arith2"))
+
+(defthm fl-sum-non-neg
+  (implies (and (<= 0 x)
+                (<= 0 y)
+                (<= 0 z)
+                (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                )
+           (<= 0 
+           (+ (FL (* 1/2 X))
+              (FL (* 1/2 Y))
+              (FL (* 1/2 Z))))))
+
+#|
+(defthm add3-1-neg
+    (implies (and (integerp x)
+		  (< x 0))
+	     (and (<= (fl (/ x 2)) 0)
+		  (>= (fl (/ x 2)) x)))
+  :rule-classes ())
+|#
+
+;BOZO contains the seed of a nice rule?
+(defthm add3-1-neg-2
+    (implies (and (< x 0)
+                  (integerp x)
+		  )
+	     (and (<= (fl (* 1/2 x)) 0)
+		  (>= (fl (* 1/2 x)) x)))
+  :rule-classes :linear)
+
+
+
+;why so many cases?
+(defthm recursion-by-add3-measure-neg
+    (IMPLIES (AND (INTEGERP X)
+		  (INTEGERP Y)
+		  (INTEGERP Z)
+		  (not (and (or (EQUAL X 0) (EQUAL X -1))
+                            (or (EQUAL y 0) (EQUAL y -1))
+                            (or (EQUAL z 0) (EQUAL z -1))
+                       )))
+	     (e0-ord-< (ADD3-MEASURE-neg (FL (* 1/2 x))
+                                         (FL (* 1/2 y))
+                                         (FL (* 1/2 z)))
+		       (ADD3-MEASURE-neg X Y Z)))
+    :otf-flg t
+  :hints (("Goal" :in-theory (disable ;FL-STRONG-MONOTONE ;BOZO these disables are unfortunate..
+                                      ;FL-WEAK-MONOTONE
+;                                      FL-<=-Y
+                        ;              FL->-INTEGER ;for efficiency
+                         ;             fl-<-integer
+                                      ;fl-def-linear-part-1
+                                      )
+           
+           :use (;(:instance add3-1-neg) ;BOZO if these are put back, things get really slow..
+                 ;(:instance add3-1-neg (x y))
+                 ;(:instance add3-1-neg (x z))
+                 ))))
+
+(DEFUN ADD3-INDUCT-allow-negatives (X Y Z)
+  (DECLARE (XARGS   :hints (("Goal" :use recursion-by-add3-measure-neg
+                             ))
+                    :MEASURE (ADD3-MEASURE-neg X Y Z)))
+  (IF (AND (INTEGERP X)
+           (INTEGERP Y)
+           (INTEGERP Z)
+           )
+      (IF (and (or (EQUAL X 0) (EQUAL X -1))
+               (or (EQUAL y 0) (EQUAL y -1))
+               (or (EQUAL z 0) (EQUAL z -1))
+               )
+          NIL
+          (ADD3-INDUCT-allow-negatives
+           (FL (/ X 2))
+           (FL (/ Y 2))
+           (FL (/ Z 2))))
+      NIL)
+
+  )
+
+
+(defthm add-3-old
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z)
+                )
+           (equal (+ x y z)
+                  (+ (logxor x (logxor y z))
+                     (* 2 (logior (logand x y)
+                                  (logior (logand x z)
+                                          (logand y z)))))))
+  :rule-classes ()
+  :hints (("Goal" :induct (ADD3-INDUCT-allow-negatives x y z))
+	  ("Subgoal *1/2" :use (add3-11))))
+
+(include-book "land0")
+(include-book "lior0")
+(include-book "lxor0")
+
+(in-theory (enable bits-tail))
+
+(defthm add-3-original
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n)
+                (bvecp z n))
+           (equal (+ x y z)
+                  (+ (lxor0 x (lxor0 y z n) n)
+                     (* 2 (lior0 (land0 x y n)
+                                (lior0 (land0 x z n)
+                                      (land0 y z n)
+                                      n)
+                                n)))))
+  :rule-classes ()
+  :hints (("Goal" :use (add-3-old)
+           :in-theory (enable lxor0 lior0 land0 bvecp))))
+
+(defthm add-2-original
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n))
+           (equal (+ x y)
+                  (+ (lxor0 x y n)
+                     (* 2 (land0 x y n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use ((:instance add-3-original (z 0))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/add3.lisp acl2-6.3/books/rtl/rel9/support/support/add3.lisp
--- acl2-6.2/books/rtl/rel9/support/support/add3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/add3.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,67 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "merge") ;BOZO yuck
+(local (include-book "add3-proofs"))
+
+(defund add3-measure (x y z)
+  (acl2-count (+ x y z)))
+
+(defthm add3-1
+  (implies (and (integerp x)
+                (> x 0))
+           (and (>= (fl (/ x 2)) 0)
+                (< (fl (/ x 2)) x)))
+  :rule-classes ())
+
+(include-book "land0")
+(include-book "lior0")
+(include-book "lxor0")
+
+(in-theory (enable bits-tail)) ;BOZO
+
+(defthm add-3-original
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n)
+                (bvecp z n))
+           (equal (+ x y z)
+                  (+ (lxor0 x (lxor0 y z n) n)
+                     (* 2 (lior0 (land0 x y n)
+                                (lior0 (land0 x z n)
+                                      (land0 y z n)
+                                      n)
+                                n)))))
+  :rule-classes ())
+
+(defthm add-2-original
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n))
+           (equal (+ x y)
+                  (+ (lxor0 x y n)
+                     (* 2 (land0 x y n)))))
+  :rule-classes ())
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/all-ones.lisp acl2-6.3/books/rtl/rel9/support/support/all-ones.lisp
--- acl2-6.2/books/rtl/rel9/support/support/all-ones.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/all-ones.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,43 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(defthm all-ones-of-non-integer
+  (implies (not (integerp n))
+           (equal (all-ones n)
+                  0))
+  :hints (("Goal" :in-theory (enable all-ones))))
+
+(defthm all-ones-of-negative
+  (implies (< n 0)
+           (equal (all-ones n)
+                  0))
+  :hints (("Goal" :in-theory (enable all-ones))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/ash.lisp acl2-6.3/books/rtl/rel9/support/support/ash.lisp
--- acl2-6.2/books/rtl/rel9/support/support/ash.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/ash.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,84 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(include-book "ground-zero")
+(local (include-book "../../arithmetic/fl"))
+(local (include-book "../../arithmetic/expt"))
+(local (include-book "../../arithmetic/expo"))
+
+;change params on lemmas in this book to match those on ash?
+
+#|(defun ash (i c)
+(FLOOR (BINARY-* (IFIX I) (EXPT '2 C))
+       '1))
+|#
+
+;(thm (rationalp (ash x n))) goes through?
+
+;the (ash 1 x) form shows up in the function decode
+(defthm bvecp-ash-1
+  (implies (and (case-split (< x n))
+                (case-split (integerp n))
+                (case-split (integerp x))
+                )
+           (bvecp (ASH 1 x) n))
+  :hints (("Goal" :in-theory (enable ash bvecp floor))))
+
+;is this dumb?
+(defthmd ash-rewrite
+    (implies (integerp n)
+	     (equal (ash n i)
+		    (fl (* n (expt 2 i)))))
+    :hints (("Goal" :in-theory (enable ash))))
+
+(defthm ash-nonnegative
+  (implies (<= 0 i)
+           (<= 0 (ash i c)))
+  :hints (("Goal" :in-theory (enable ash))))
+
+(defthm ash-nonnegative-type
+  (implies (<= 0 i)
+           (and (rationalp (ash i c))
+                (<= 0 (ash i c))))
+  :rule-classes ( :type-prescription)
+  :hints (("Goal" :in-theory (enable ash))))
+
+(defthm ash-with-c-non-integer
+  (implies (not (integerp c))
+           (equal (ash i c)
+                  (ifix i)))
+  :hints (("Goal" :in-theory (enable ash))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/away-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/away-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/away-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/away-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1619 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+(in-package "ACL2")
+
+(local (include-book "trunc"))
+(local (include-book "../../arithmetic/top"))
+(local (include-book "float"))
+
+;; Necessary defuns
+
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund power2p-measure (x)
+  (declare (xargs :guard (and (rationalp x) (not (equal x 0)))))
+  (cond ((or (not (rationalp x))
+             (<= x 0)) 0)
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund power2p (x)
+  (declare (xargs :guard t
+                  :measure (power2p-measure x)
+                  :hints (("goal" :in-theory (enable power2p-measure)))))
+  (cond ((or (not (rationalp x))
+             (<= x 0))
+         nil)
+        ((< x 1) (power2p (* 2 x)))
+        ((<= 2 x) (power2p (* 1/2 x)))
+        ((equal x 1) t)
+        (t nil) ;got a number in the doubly-open interval (1,2)
+        ))
+
+
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+;; Start of new stuff
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+;generated automatically by ACL2 when we define away, but included here just to be safe
+;could disabled (:type-prescription away) for slight efficiency gain at the cost of making the output of :pe a
+;little deceptive
+(defthm away-rational-type-prescription
+  (rationalp (away x n))
+  :rule-classes :type-prescription)
+ 
+(defthm away-of-non-rationalp-is-0
+  (implies (not (rationalp x))
+           (equal (away x n)
+                  0))
+  :hints (("goal" :in-theory (enable away sig))))
+
+;make alt version? use negative-syntaxp?
+(defthm away-minus
+  (= (away (* -1 x) n)
+     (* -1 (away x n)))
+  :hints (("Goal" :in-theory (enable away))))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :in-theory (enable away cg)
+           :use (;(:instance sig-lower-bound)
+                 ))))
+
+(defthm away-positive-rational-type-prescription
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (and (< 0 (away x n))
+                (rationalp (away x n))))
+  :rule-classes :type-prescription)
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear)
+    :hints (("Goal" :in-theory (e/d (away) (sig-lower-bound SIG-LESS-THAN-1-MEANS-X-0))
+             :use ((:instance sig-lower-bound)))))
+
+(defthm away-negative-rational-type-prescription
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                )
+           (< (away x n) 0))
+  :rule-classes :type-prescription)
+
+(defthm away-0
+  (equal (away 0 n)
+         0)
+  :hints (("Goal" :in-theory (enable away))))
+
+(defthm away-non-negative-rational-type-prescription
+  (implies (<= 0 x)
+           (and (<= 0 (away x n))
+                (rationalp (away x n))))
+  :hints (("Goal" :cases ((or (not (rationalp x)) (equal x 0)))))
+  :rule-classes :type-prescription)
+
+(defthm away-non-positive-rational-type-prescription
+  (implies (<= x 0)
+           (and (<= (away x n) 0)
+                (rationalp (away x n))))
+  :hints (("Goal" :cases ((or (not (rationalp x)) (equal x 0)))))
+  :rule-classes :type-prescription)
+
+(defthm away-equal-0-rewrite
+  (implies (rationalp x)
+           (equal (equal (away x n) 0)
+                  (equal x 0)))
+  :hints (("Goal" :cases ((< x 0) (equal x 0) (< 0 x)))))
+
+(defthm sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+;keep this disabled, since it basically opens up AWAY
+(defthmd abs-away
+  (implies (and (rationalp x)
+                (integerp n))
+           (equal (abs (away x n))
+                  (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+  :hints (("Goal" :in-theory (enable away sig)))) ;why enable sig?
+
+;kind of gross...
+(defthm away-to-0-or-fewer-bits
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n))))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable away expt-split
+;                                     expt ;yuck
+                                     )
+                              '())
+           :use ((:instance cg-unique
+                            (x (* 1/2 (SIG X) (EXPT 2 N)))
+                            (n 1))
+;                 sig-upper-bound
+                 sig-lower-bound
+                 (:instance expt-weak-monotone
+                            (n n)
+                            (m 0))
+                 (:instance expt-strong-monotone
+                            (n 0)
+                            (m n))))))
+
+(defthm away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n))
+                  )
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (enable away sig
+                                     expt-split
+                                     expt-minus
+                                     )
+		  :use (away-to-0-or-fewer-bits
+                        (:instance cg-def-linear (x (* (expt 2 (1- n)) (sig x))))
+;			(:instance fp-abs)
+                        ))))
+(defthm away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n))
+                  )
+	     (>= (away x n) x))
+  :rule-classes :linear
+  :hints (("Goal" :use ((:instance away-lower-bound)))))
+
+;elim?
+
+(defthm expo-away-lower-bound
+  (implies (and (rationalp x)
+                (natp n))
+           (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear
+  :hints (("Goal"
+           :use ((:instance away-lower-bound)
+;                 (:instance away-0-0)
+                 (:instance expo-monotone (y (away x n)))))))
+
+
+;; (defthm expo-away-lower-bound
+;;   (implies (and (rationalp x)
+;;                 (integerp n)
+;;                 (> n 0))
+;;            (>= (expo (away x n)) (expo x)))
+;;   :rule-classes :linear
+;;   :hints (("Goal"
+;;            :use ((:instance away-lower-bound)
+;; ;                 (:instance away-0-0)
+;;                  (:instance expo-monotone (y (away x n)))))))
+
+(local
+   (defthm trunc-lower-1-2
+     (implies (and (rationalp u)
+                   (rationalp v)
+                   (rationalp r)
+                   (> r 0)
+                   (< u (1+ v)))
+              (< (* r u) (* r (1+ v))))
+     :rule-classes ()))
+
+;gross..
+(defthm trunc-lower-1-3
+    (implies (and (rationalp u)
+                  (rationalp v)
+                  (rationalp r)
+                  (> r 0)
+                  (< u (1+ v)))
+             (< (* r u) (+ r (* r v))))
+    :rule-classes ()
+    :hints (("goal" :in-theory (disable *-strongly-monotonic)
+             :use ((:instance trunc-lower-1-2)))))
+
+(defthm away-upper-1
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0))
+           (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (enable abs-away
+                                      expt-split
+                                      expt-minus
+                                      sig)
+           :use (;(:instance trunc-lower-1-1)
+                 (:instance fp-abs)
+                 (:instance trunc-lower-1-3
+                            (u (* (sig x) (expt 2 (1- n))))
+                            (v (fl (* (sig x) (expt 2 (1- n)))))
+                            (r (expt 2 (- (1+ (expo x)) n))))
+                 (:instance cg-def-linear (x (* (expt 2 (1- n)) (sig x))))))))
+
+(defthm away-upper-2
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (integerp n)
+                (> n 0))
+           (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (disable abs)
+           :use ((:instance away-upper-1)
+                 (:instance trunc-lower-2-1)))))
+
+(defthm away-upper-pos
+    (implies (and (> x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (away x n) (* x (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (disable abs-pos)
+		  :use ((:instance away-upper-2)
+;			(:instance away-positive)
+                        ))))
+
+(defthm away-upper-3
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance away-upper-1)
+;			(:instance away-0-0)
+			(:instance trunc-lower-2-1)))))
+
+(defthm away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear
+  :hints (("Goal" :use (;(:instance trunc-diff-1 (y (away x n)))
+;			(:instance away-negative)
+	;		(:instance away-positive)
+			;(:instance away-0-0)
+			(:instance away-lower-bound)
+			(:instance away-upper-1)
+                        ))))
+
+(defthm away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear
+  :hints (("Goal" :use ((:instance away-diff)
+;			(:instance away-pos)
+			(:instance away-lower-bound)))))
+
+
+(defthm away-diff-expo-1
+    (implies (and (rationalp x)
+		  (not (= x (away x n)))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance away-diff)
+			(:instance expo-lower-bound (x (- (away x n) x)))
+			(:instance expt-strong-monotone 
+				   (n (expo (- (away x n) x)))
+				   (m (- (1+ (expo x)) n)))))))
+;slow
+(defthmd away-rewrite
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0))
+           (equal (away x n)
+                  (* (sgn x) 
+                     (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+                     (expt 2 (- (1+ (expo x)) n)))))
+  :hints (("Goal" :in-theory (enable away sig expt-split))))
+
+
+(local
+ (defthm away-exactp-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (= x (* (sgn x) (* (expt 2 (- (1- n) (expo x))) (abs x)) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-split (r 2) (j (- (1- n) (expo x))) (i (- (1+ (expo x)) n))))))))
+
+(local
+ (defthm away-exactp-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp z)
+		  (not (= x 0))
+		  (not (= z 0)))
+	     (iff (= (* x y z) (* x (cg y) z))
+		  (integerp y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable cg-int cg-integerp)
+		  :use ((:instance cg-integerp (x y))
+			(:instance *cancell (x (cg y)) (z (* x z))))))))
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2 away-rewrite expt-split expt-minus)
+		  :use ((:instance away-exactp-1)
+;			(:instance away-exactp-6)
+			(:instance away-exactp-2
+				   (x (sgn x))
+				   (y (* (expt 2 (- (1- n) (expo x))) (abs x)))
+				   (z (expt 2 (- (1+ (expo x)) n))))))))
+
+(defthm away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance away-diff-expo-1)
+			(:instance away-exactp-b)))))
+(local
+ (defthm away-exactp-b-1    
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (integerp (* (* (sgn x) (cg y) (expt 2 (- (1- n) (expo x)))) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance integerp-x-y 
+				   (x (sgn x))
+				   (y (cg (* (expt 2 (- (1- n) (expo x))) (abs x)))))
+			(:instance expt-split (r 2) (j (- (1- n) (expo x))) (i (- (1+ (expo x)) n))))))))
+
+(local
+ (defthm away-exactp-b-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (integerp (* (away x n) (expt 2 (- (1- n) (expo x))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable away-rewrite)
+                              '( sgn))
+		  :use ((:instance away-exactp-b-1 (y (* (expt 2 (- (1- n) (expo x))) (abs x)))))))))
+
+(local
+ (defthm away-exactp-b-3
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (<= (* (expt 2 (1- n)) (sig x)) (expt 2 n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (expt-split) (SIG-UPPER-BOUND
+                                               ))
+		  :use ((:instance sig-upper-bound)
+			(:instance expt-split (r 2) (j (1- n)) (i 1)))))))
+(local
+ (defthm away-exactp-b-4
+    (implies (and (rationalp c)
+		  (integerp n)
+		  (integerp m)
+		  (<= c (expt 2 n)))
+	     (<= (* c (expt 2 (- m n))) (expt 2 m)))
+    :hints (("Goal" :in-theory (enable expt-split expt-minus)))
+  :rule-classes ()))
+
+(local
+ (defthm away-exactp-b-5
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable abs-away)
+                              '( abs))
+		  :use ((:instance away-exactp-b-3)
+			(:instance away-exactp-b-4 (c (cg (* (sig x) (expt 2 (1- n))))) (m (1+ (expo x))))
+			(:instance n>=cg-linear (n (expt 2 n)) (x (* (expt 2 (1- n)) (sig x)))))))))
+
+(local
+ (defthm away-exactp-b-6
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0)
+		  (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+	     (<= (expo (away x n)) (expo x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance away-exactp-b-5)
+			(:instance expo-lower-bound (x (away x n)))
+;			(:instance away-0-0)
+			(:instance expt-strong-monotone (n (expo (away x n))) (m (1+ (expo x)))))))))
+
+(local
+ (defthm away-exactp-b-7
+   (implies (and (rationalp x)
+                 (not (= x 0))
+                 (integerp n)
+                 (> n 0)
+                 (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+            (exactp (away x n) n))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (disable abs)
+            :use ((:instance away-exactp-b-2)
+                  (:instance away-exactp-b-6)
+;                  (:instance away-0-0)
+                  (:instance exactp->=-expo (x (away x n)) (e (expo x))))))))
+
+(local
+ (defthm away-exactp-b-9
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (integerp m)
+                 (> m 0)
+                 (= (abs x) (expt 2 n)))
+            (exactp x m))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable exactp2)
+            :use (;(:instance away-exactp-b-8)
+                  (:instance exactp-2**n))))))
+
+(local
+ (defthm away-exactp-b-10    
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (exactp (away x n) n))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance away-exactp-b-7)
+			(:instance away-exactp-b-9 (x (away x n)) (m n) (n (1+ (expo x))))
+                        )))))
+
+
+;gross.  keep disabled
+(defthmd away-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (away x n)
+                  (if (not (rationalp x))
+                      0
+                    (if (acl2-numberp n)
+                        (if (power2p (abs x))
+                            (sgn x)
+                        (* 2 (sgn x)))
+                      (* (sgn x) (expt 2 (+ 1 (expo x))))))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable away)))
+  )
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n)) ;can't drop this hyp
+	     (exactp (away x n) n))
+  :hints (("Goal" :in-theory (enable  away-with-n-not-an-integer)
+           :use ((:instance away-exactp-b-10)
+;			(:instance away-0-0)
+                        ))))
+
+(local
+ (defthm away-exactp-c-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x)
+		  (< a (away x n)))
+	     (>= (away x n) (+ x (expt 2 (- (1+ (expo x)) n)))))
+    :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :in-theory (disable EXPT-COMPARE)
+		  :use ((:instance away-exactp-b)
+			(:instance fp+2 (x a) (y (away x n)))
+			(:instance expo-monotone (y a))
+			(:instance expt-weak-monotone (n (- (1+ (expo x)) n)) (m (- (1+ (expo a)) n))))))))
+
+
+
+
+(local 
+ (defthm away-exactp-c-support
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (away x n)))
+  :hints (("Goal" :in-theory (disable)
+		  :use ((:instance away-exactp-c-1)
+			(:instance away-upper-1)
+			;(:instance away-positive)
+                        )))))
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n)))
+    :hints (("Goal" :cases ((equal x 0)
+                            (< 0 x)
+                            (< x 0))
+             :in-theory (e/d (away-minus) ()))
+            ("Subgoal 2" :use ((:instance away-exactp-c-support)))
+            ("Subgoal 1" :use ((:instance away-lower-bound)))))
+
+
+(encapsulate
+ ()
+ (local (defthm away-monotone-old
+   (implies (and (rationalp x)
+                 (rationalp y)
+                 (integerp n)
+                 (> x 0)
+                 (> n 0)
+                 (<= x y))
+            (<= (away x n) (away y n)))
+   :hints (("Goal" :in-theory (disable)
+            :use ((:instance away-exactp-b (x y))
+                  (:instance away-lower-pos (x y))
+                  (:instance away-exactp-c (a (away y n))))))))
+
+;trying disabled?
+ (defthmd away-monotone
+   (implies (and (rationalp x)
+                 (rationalp y)
+                 (integerp n)
+                 (<= x y))
+            (<= (away x n) (away y n)))
+   :hints (("Goal" :in-theory (disable away-upper-pos
+;                                      away-positive away-negative
+;away-to-0-or-fewer-bits
+                                       expo-monotone
+                                       away-monotone-old)
+            :cases ((> n 0)))
+           ("subgoal 2" 
+            :use ((:instance expt-weak-monotone
+                             (n (+ 1 (EXPO X) (* -1 N)))
+                             (m (+ 1 (EXPO y) (* -1 N))))
+;                 away-to-0-or-fewer-bits
+                  expo-monotone
+                  (:instance expo-monotone (x y) (y x))
+;                (:instance away-to-0-or-fewer-bits (x y))
+                  ))
+           ("subgoal 1" 
+            :use (away-monotone-old
+                  (:instance away-monotone-old (x (- y))
+                             (y (- x))))))
+   :rule-classes :linear)
+ )
+
+
+
+(defthm away-exactp-d
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance away-exactp-b-5)))))
+
+(defthmd away-pos-rewrite
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n))
+           (equal (away x n)
+                  (* (cg (* (expt 2 (- (1- n) (expo x))) x))
+                     (expt 2 (- (1+ (expo x)) n)))))
+  :hints (("goal" :in-theory (enable away sgn expt-split expt-minus)
+           :use fp-abs)))
+
+
+(local (defthm expo-away-support
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (integerp n)
+                (> n 0)
+                (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+           (equal (expo (away x n))
+                  (expo x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+           :use ((:instance away-exactp-b-6)
+                 (:instance expo-monotone (y (away x n)))
+                 (:instance away-lower-bound))))))
+
+(defthm expo-away
+  (implies (and (rationalp x)
+                (natp n)
+                (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+           (equal (expo (away x n))
+                  (expo x)))
+  :hints (("Goal" :cases ((equal x 0) (< x 0) (> x 0)))
+             ("Subgoal 2" :in-theory (enable sgn)
+              :use ((:instance expo-away-support)))
+             ("Subgoal 1" :in-theory (enable sgn)
+              :use ((:instance expo-away-support)))))
+
+
+
+(local
+ (defthm away-away-1
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (not (= (away x n) (expt 2 (1+ (expo x)))))
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (away (away x n) m)
+		(* (cg (* (expt 2 (- (1- m) (expo x)))
+			  (* (cg (* (expt 2 (- (1- n) (expo x))) x))
+			     (expt 2 (- (1+ (expo x)) n)))))
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (away-pos-rewrite expt-split expt-minus)
+                              ())
+		  :use (;(:instance away-positive)
+			(:instance expo-away))))))
+
+(local
+ (defthm away-away-2
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (not (= (away x n) (expt 2 (1+ (expo x)))))
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (away (away x n) m)
+		(* (cg (* (cg (* (expt 2 (- (1- n) (expo x))) x)) (expt 2 (- m n)))) 
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt-compare-equal)
+		  :use ((:instance away-away-1)
+			(:instance expt-split (r 2) (j (- (1- m) (expo x))) (i (- (1+
+                                                                        (expo
+                                                                         x))
+                                                                       n))))))))
+
+
+(local
+ (defthm away-away-3
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (not (= (away x n) (expt 2 (1+ (expo x)))))
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (away (away x n) m)
+		(* (cg (/ (cg (* (expt 2 (- (1- n) (expo x))) x)) (expt 2 (- n m)))) 
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split expt-minus)
+		  :use ((:instance away-away-2))))))
+
+(local
+ (defthm away-away-4
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (not (= (away x n) (expt 2 (1+ (expo x)))))
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (away (away x n) m)
+		(* (cg (/ (* (expt 2 (- (1- n) (expo x))) x) (expt 2 (- n m)))) 
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable cg/int-rewrite)
+		  :use ((:instance away-away-3)
+			(:instance cg/int-rewrite 
+				   (x (* (expt 2 (- (1- n) (expo x))) x))
+				   (n (expt 2 (- n m)))))))))
+
+(local
+ (defthm away-away-5
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (not (= (away x n) (expt 2 (1+ (expo x)))))
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (away (away x n) m)
+		(* (cg (* (expt 2 (- (1- m) (expo x))) x))
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (expt-split expt-minus) ())
+		  :use ((:instance away-away-4))))))
+
+(local
+ (defthm away-away-6
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (not (= (away x n) (expt 2 (1+ (expo x)))))
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable away-pos-rewrite)
+		  :use ((:instance away-away-5))))))
+
+(local
+ (defthm away-away-7
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (>= (away x m) (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance away-exactp-c (a (away x m)))
+			(:instance away-exactp-b (n m))
+			(:instance away-lower-pos (n m))
+			(:instance exactp-<= (x (away x m))))))))
+(local
+ (defthm away-away-8
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (>= (away x m) (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance away-away-7)
+;			(:instance away-0-0)
+	;		(:instance away-0-0 (n m))
+                        )))))
+
+(local
+ (defthm away-away-9
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (= (away x n) (expt 2 (1+ (expo x))))
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable away-pos-rewrite)
+		  :use ((:instance away-away-8)
+			(:instance exactp-2**n (n (1+ (expo x))))
+			(:instance away-exactp-a (x (expt 2 (1+ (expo x)))) (n m))
+			(:instance away-exactp-d (n m)))))))
+
+;handle the case where n<m?
+(defthm away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m)))
+  :hints (("Goal" :use ((:instance away-away-9)
+			(:instance away-away-6)))))
+
+(defthm away-shift
+  (implies (integerp n)
+           (= (away (* x (expt 2 k)) n)
+              (* (away x n) (expt 2 k))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable away
+                                      sig
+                                      expt-split
+                                      )
+                              '()))))
+
+(local
+ (defthm trunc-away-1
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (not (exactp x n)))
+            (> x (expt 2 (expo x))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance expo-lower-bound)
+                  (:instance exactp-2**n (n (expo x)) (m n)))))))
+
+
+(local
+(defthm trunc-away-2
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (>= (- x (expt 2 (- (expo x) n)))
+		 (expt 2 (expo x))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance trunc-away-1)
+			(:instance exactp-2**n (n (expo x)) (m (1+ n)))
+			(:instance fp+2 (x (expt 2 (expo x))) (n (1+ n)) (y x)))))))
+
+(local
+(defthm trunc-away-3
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (expo (- x (expt 2 (- (expo x) n))))
+		(expo x)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance trunc-away-2)
+			(:instance expo-unique (x (- x (expt 2 (- (expo x) n)))) (n (expo x)))
+			(:instance exactp-2**n (n (- (expo x) n)) (m n))
+;			(:instance expt-pos (x (- (expo x) n)))
+			(:instance expo-lower-bound)
+			(:instance expt-weak-monotone (n (- (expo x) n)) (m (expo x)))
+			(:instance expo-upper-bound))))))
+
+#|
+zz
+;yuck
+(local
+ (defthm hack-83
+   (implies (and (integerp n)
+                 (< 0 n))
+            (= (* 1/2 (expt 2 (+ n (* -1 (expo x)))))
+               (expt 2 (1- n (* -1 (expo x))))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance expt-split (r 2) (i (- n (expo x))) (j -1)))))))
+
+;yuck
+(local
+ (defthm hack-84
+   (implies (and (rationalp x)
+                 (rationalp a)
+                 (rationalp b)
+                 (= a b))
+            (= (* x a) (* x b)))
+   :rule-classes ()))
+
+;yuck
+(local
+ (defthm hack-85
+   (implies (and (integerp n)
+                 (< 0 n)
+                 (rationalp x))
+            (equal (* 1/2 x (expt 2 (+ n (* -1 (expo x)))))
+                   (* x (expt 2 (1- n (* -1 (expo x)))))))
+   :hints (("goal" :use ((:instance hack-83)
+                         (:instance hack-84 
+                                    (a (* 1/2 (expt 2 (+ n (* -1 (expo x))))))
+                                    (b (expt 2 (1- n (* -1 (expo x)))))))))))
+|#
+
+(local
+ (defthm trunc-away-4
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (not (exactp x n)))
+            (= (* x (expt 2 (- n (expo x))))
+               (1+ (* 2 (fl-half (* x (expt 2 (- n (expo x)))))))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable exactp2 expt-split)
+            :use ((:instance fl-half-lemma (x (* x (expt 2 (- n (expo x)))))))))))
+
+#|
+;yuck
+(local
+ (defthm hack-86
+   (implies (integerp k)
+            (= (- (/ (1+ (* 2 k)) 2) 1/2) k))
+   :rule-classes ()))
+|#
+
+(local
+ (defthm trunc-away-5
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (not (exactp x n)))
+            (= (* (- x (expt 2 (- (expo x) n)))
+                  (expt 2 (- (1- n) (expo x))))
+               (fl-half (* x (expt 2 (- n (expo x)))))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-compare-equal)
+            :use ((:instance trunc-away-4)
+;                         (:instance hack-86 (k (fl-half (* x (expt 2 (- n (expo x))))))) 
+                         (:instance expt-split (r 2) (i (- (expo x) n)) (j (- (1- n) (expo x))))
+                         (:instance expt-split (r 2) (i 1) (j (- (1- n) (expo x)))))))))
+
+(local
+ (defthm trunc-away-6
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (not (exactp x n)))
+            (integerp (* (- x (expt 2 (- (expo x) n)))
+                         (expt 2 (- (1- n) (expo x))))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance trunc-away-5))))))
+
+(local
+ (defthm trunc-away-7
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (not (exactp x n)))
+            (integerp (* (- x (expt 2 (- (expo x) n)))
+                         (expt 2 (- (1- n) (expo (- x (expt 2 (- (expo x) n)))))))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance trunc-away-6)
+                         (:instance trunc-away-3))))))
+
+(local
+ (defthm trunc-away-8
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (>= (- x (expt 2 (- (expo x) n))) 0)
+                 (not (exactp x n)))
+            (exactp (- x (expt 2 (- (expo x) n)))
+                    n))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable exactp2)
+            :use ((:instance trunc-away-7))))))
+
+(local
+ (defthm trunc-away-9
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (not (exactp x n)))
+            (exactp (- x (expt 2 (- (expo x) n)))
+                    n))
+   :rule-classes ()
+   :hints (("goal" :in-theory (e/d (expt-split) (expt-compare
+                                                 EXPO-COMPARISON-REWRITE-TO-BOUND
+                                                 EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                                 ))
+            :use ((:instance trunc-away-8)
+                  (:instance expo-lower-bound)
+                  (:instance expt-weak-monotone (n (- (expo x) n)) (m (expo x))))))))
+
+(local
+ (defthm trunc-away-10
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (not (exactp x n)))
+            (<= (- x (expt 2 (- (expo x) n)))
+                (trunc x n)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable; expt-pos
+                               trunc-exactp-c)
+            :use ((:instance trunc-away-9)
+                  (:instance expo-lower-bound)
+                  (:instance expt-weak-monotone (n (- (expo x) n)) (m (expo x)))
+;                  (:instance expt-pos (x (- (expo x) n)))
+                  (:instance trunc-exactp-c (a (- x (expt 2 (- (expo x) n))))))))))
+
+(local
+(defthm trunc-away-11
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n))
+		  (< (- x (expt 2 (- (expo x) n)))
+		     (trunc x n)))
+	     (<= x (trunc x n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable
+                              expt-compare
+                               EXPT-COMPARE-EQUAL
+                               EXPO-COMPARISON-REWRITE-TO-BOUND
+                              ;expt-pos
+;exactp2 
+                               )
+		  :use ((:instance trunc-away-8)
+			(:instance trunc-away-3)
+			(:instance expt-split (r 2) (i 1) (j (- n (expo x))))
+;			(:instance expt-pos (x (- (expo x) n)))
+			(:instance fp+2 (x (- x (expt 2 (- (expo x) n)))) (y (trunc x n)))
+			(:instance expo-lower-bound)
+			(:instance expt-strong-monotone (n (- (expo x) n)) (m (expo x)))
+			(:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))
+
+
+
+(defthm trunc-away-a
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable trunc-exactp-a)
+		  :use ((:instance trunc-away-10)
+			(:instance trunc-away-11)
+			(:instance trunc-upper-pos)
+			(:instance trunc-exactp-a)))))
+
+(local
+(defthm hack-87
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (= (expo (- x (expt 2 (- (expo x) n))))
+		     (expo x)))
+	     (equal (+ x (* -1 (expt 2 (+ (expo x) (* -1 n))))
+		       (expt 2
+			 (+ 1 (* -1 n)
+			    (expo (+ x
+				     (* -1 (expt 2 (+ (expo x) (* -1 n)))))))))
+		    (+ x (expt 2 (+ (expo x) (* -1 n))))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance expt-split (r 2) (i (- (expo x) n)) (j
+                                                                        1)))))))
+
+(local
+ (defthm hack-88
+   (implies (equal x y) (equal (exactp x n) (exactp y n)))
+   :rule-classes ()))
+
+(local
+ (defthm hack-89
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (= (expo (- x (expt 2 (- (expo x) n))))
+                    (expo x)))
+            (equal (exactp (+ x (* -1 (expt 2 (+ (expo x) (* -1 n))))
+                              (expt 2
+                                    (+ 1 (* -1 n)
+                                       (expo (+ x
+                                                (* -1 (expt 2 (+ (expo x) (* -1 n)))))))))
+                           n)
+                   (exactp (+ x (expt 2 (+ (expo x) (* -1 n)))) n)))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance hack-87)
+                         (:instance hack-88 
+                                    (x (+ x (* -1 (expt 2 (+ (expo x) (* -1 n))))
+                                          (expt 2
+                                                (+ 1 (* -1 n)
+                                                   (expo (+ x
+                                                            (* -1 (expt 2 (+ (expo x) (* -1 n))))))))))
+                                    (y (+ x (expt 2 (+ (expo x) (* -1 n)))))))))))
+
+;(local (in-theory (disable expo-monotone))) ;drop?
+
+;not about away...
+(local
+ (defthm trunc-away-12
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (not (exactp x n)))
+            (exactp (+ x (expt 2 (- (expo x) n)))
+                    n))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
+                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                       EXPT-COMPARE-EQUAL
+                                       EXPT-COMPARE)
+            :use ((:instance trunc-away-9)
+                  (:instance fp+1 (x (- x (expt 2 (- (expo x) n)))))
+                  (:instance expo-lower-bound)
+                  (:instance expt-strong-monotone (n (- (expo x) n)) (m (expo x)))
+                  (:instance expt-split (r 2) (i (- (expo x) n)) (j 1))
+                  (:instance hack-89)
+                  (:instance trunc-away-3))))))
+
+(local
+(defthm trunc-away-13
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (>= (+ x (expt 2 (- (expo x) n)))
+		 (away x n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                                      away-exactp-c)
+		  :use ((:instance trunc-away-12)
+			(:instance expo-lower-bound)
+			(:instance expt-weak-monotone (n (- (expo x) n)) (m (expo x)))
+;			(:instance expt-pos (x (- (expo x) n)))
+			(:instance away-exactp-c (a (+ x (expt 2 (- (expo x) n))))))))))
+
+(local
+(defthm trunc-away-14
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (> (away x n)
+		(- x (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance away-lower-pos)
+;			(:instance expt-pos (x (- (expo x) n)))
+                        )))))
+
+(local
+(defthm trunc-away-15
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (>= (away x n)
+		 (+ (- x (expt 2 (- (expo x) n)))
+		    (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable away-exactp-a EXPT-COMPARE EXPO-COMPARISON-REWRITE-TO-BOUND)
+		  :use ((:instance trunc-away-8)
+			(:instance trunc-away-3)
+			(:instance expo-lower-bound)
+			(:instance expt-strong-monotone (n (- (expo x) n)) (m (expo x)))
+			(:instance trunc-away-14)
+			(:instance away-exactp-a)
+			(:instance fp+2 (x (- x (expt 2 (- (expo x) n)))) (y (away x n))))))))
+
+ 
+(local
+ (defthm trunc-away-16
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (exactp x (1+ n))
+                 (not (exactp x n)))
+            (>= (away x n)
+                (+ x (expt 2 (- (expo x) n)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable expt-split) 
+            :use ((:instance trunc-away-15)
+                  )))))
+
+(defthm trunc-away-b
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance trunc-away-16)
+			(:instance trunc-away-13)))))
+
+
+
+
+
+(local (defthm away-imp-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (< (trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)
+		(+ x (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance trunc-upper-pos
+				   (x (+ x
+					 (expt 2 (- (1+ (expo x)) n))
+					 (- (expt 2 (- (1+ (expo x)) m))))))
+;			(:instance expt-pos (x (- (1+ (expo x)) m)))
+			(:instance expt-weak-monotone (n (- (1+ (expo x)) m)) (m (- (1+ (expo x)) n))))))))
+
+(local (in-theory (disable abs-pos)))
+
+(local (defthm away-imp-2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (+ x (expt 2 (- (1+ (expo x)) n)))
+		 (+ (away x n)
+		    (expt 2 (- (1+ (expo (away x n))) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable  expt-compare
+                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+                              :use ((:instance away-lower-pos)
+			(:instance expo-monotone (y (away x n)))
+			(:instance expt-weak-monotone
+				   (n (- (1+ (expo x)) n)) (m (- (1+ (expo (away x n))) n))))))))
+
+(local (defthm away-imp-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (< (trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)
+		(+ (away x n)
+		   (expt 2 (- (1+ (expo (away x n))) n)))))
+  :rule-classes ()
+  :hints (("goal" :use (away-imp-1 away-imp-2)))))
+
+(local 
+ (defthm away-imp-4
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (integerp m)
+                 (>= m n)
+                 (exactp x m))
+            (<= (trunc (+ x
+                          (expt 2 (- (1+ (expo x)) n))
+                          (- (expt 2 (- (1+ (expo x)) m))))
+                       n)
+                (away x n)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable away-exactp-a trunc-exactp-a away-positive) 
+            :use (away-imp-3
+                  (:instance fp+2
+                             (x (away x n))
+                             (y (trunc (+ x
+                                          (expt 2 (- (1+ (expo x)) n))
+                                          (- (expt 2 (- (1+ (expo x)) m))))
+                                       n)))
+                  (:instance away-positive)
+                  (:instance away-exactp-a)
+                  (:instance trunc-exactp-a
+                             (x (+ x
+                                   (expt 2 (- (1+ (expo x)) n))
+                                   (- (expt 2 (- (1+ (expo x)) m)))))))))))
+
+(local (defthm away-imp-5
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m)
+		  (exactp x n))
+	     (>= (trunc (+ x
+			   (expt 2 (- (1+ (expo x)) n))
+			   (- (expt 2 (- (1+ (expo x)) m))))
+			n)
+		 (away x n)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance trunc-monotone
+				   (y (+ x
+					 (expt 2 (- (1+ (expo x)) n))
+					 (- (expt 2 (- (1+ (expo x)) m))))))
+			(:instance expt-weak-monotone (n (- (1+ (expo x)) m)) (m (- (1+ (expo x)) n)))
+			(:instance trunc-exactp-a)
+			(:instance away-exactp-a))))))
+
+(local (defthm away-imp-6
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m)
+		  (not (exactp x n)))
+	     (>= x
+		 (+ (trunc x n)
+		    (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable trunc-exactp-a)
+           :use (trunc-exactp-a
+;			trunc-pos
+			trunc-upper-pos
+			trunc-exactp-b
+			(:instance exactp-<= (x (trunc x n)) (n m) (m n))
+			(:instance fp+2 (x (trunc x n)) (y x) (n m)))))))
+
+(local (defthm away-imp-7
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m)
+		  (not (exactp x n)))
+	     (>= (+ x
+		    (expt 2 (- (1+ (expo x)) n))
+		    (- (expt 2 (- (1+ (expo x)) m))))
+		 (+ (trunc x n)
+		    (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use (away-imp-6)))))
+
+(local (defthm away-imp-8
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (not (exactp x n)))
+	     (> (+ (trunc x n)
+		   (expt 2 (- (1+ (expo x)) n)))
+		x))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable trunc-exactp-c trunc-exactp-a)
+
+           :use ((:instance fp+1 (x (trunc x n)))
+			(:instance trunc-exactp-a)
+;			(:instance trunc-pos)
+;			(:instance expt-pos (x (- (1+ (expo x)) n)))
+			(:instance trunc-exactp-c 
+				   (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
+
+(local (defthm away-imp-9
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (not (exactp x n)))
+	     (>= (+ (trunc x n)
+		   (expt 2 (- (1+ (expo x)) n)))
+		(away x n)))
+  :rule-classes ()
+  :hints (("goal"  :in-theory (disable trunc-exactp-a away-exactp-c)
+           :use (away-imp-8
+			(:instance fp+1 (x (trunc x n)))
+			(:instance trunc-exactp-a)
+;			(:instance trunc-pos)
+			(:instance away-exactp-c 
+				   (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
+
+(local (defthm away-imp-10
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m)
+		  (not (exactp x n)))
+	     (>= (+ x
+		    (expt 2 (- (1+ (expo x)) n))
+		    (- (expt 2 (- (1+ (expo x)) m))))
+		 (away x n)))
+  :rule-classes ()
+  :hints (("goal" :use (away-imp-7 away-imp-9)))))
+
+(local (defthm away-imp-11
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m)
+		  (not (exactp x n)))
+	     (>= (trunc (+ x
+			   (expt 2 (- (1+ (expo x)) n))
+			   (- (expt 2 (- (1+ (expo x)) m))))
+			n)
+		 (away x n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable away-exactp-a trunc-exactp-c)
+           :use (away-imp-10
+			away-exactp-a
+			(:instance expt-weak-monotone (n (- (1+ (expo x)) m)) (m (- (1+ (expo x)) n)))
+			(:instance trunc-exactp-c
+				   (a (away x n))
+				   (x (+ x
+					 (expt 2 (- (1+ (expo x)) n))
+					 (- (expt 2 (- (1+ (expo x)) m)))))))))))
+
+(defthm away-imp
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (integerp m)
+		  (>= m n)
+		  (exactp x m))
+	     (= (away x n)
+		(trunc (+ x
+			  (expt 2 (- (1+ (expo x)) n))
+			  (- (expt 2 (- (1+ (expo x)) m))))
+		       n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable AWAY-EXACTP-C-support) ;consider disabling this globally...
+           :use (away-imp-11 away-imp-5 away-imp-4))))
+
+(defthm plus-away-2
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                )
+           (equal (+ x (away y k))
+                  (* (cg (* (+ x y) (expt 2 (- (1- k) (expo y)))))
+                     (expt 2 (- (1+ (expo y)) k)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (e/d (away-pos-rewrite exactp2)
+                                  (cg+int-rewrite ;int-fl-rules
+                                     ))
+           :use ((:instance cg+int-rewrite 
+                            (x (* y (expt 2 (- (1- k) (expo y)))))
+                            (n (* x (expt 2 (- (1- k) (expo y))))))))))
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                )
+           (= (+ x (away y k))
+              (away (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable away-pos-rewrite)
+           :use ((:instance plus-away-2)
+                 (:instance expo-monotone (y (+ x y)))))))
+
+;add to lib? alternate form of the above
+(defthm plus-away-alt
+  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp j)
+                )
+           (= (away (+ x y) j)
+              (+ x (away y (+ j (- (expo (+ x y))) (expo y))))))
+  :rule-classes ()
+  :hints (("goal" 
+           :use (:instance plus-away
+                           (k (+ j (- (expo (+ x y))) (expo y)))))))
+
+; isn't nice for y=0
+;corollaries like this for inf, minf, rnd?
+(defthm plus-away-corollary
+  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
+                (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (integerp n)
+                (exactp x n)
+                )
+           (= (away (+ x y) n)
+              (fp+ x n)))
+  :hints (("goal"  :in-theory (set-difference-theories
+                               (enable sgn
+                                       expt-split expt-minus)
+                               '(EXPT-COMPARE-EQUAL))
+           :use (  
+                 (:instance only-0-is-0-or-negative-exact) 
+                 (:instance away-exactp-b)
+                  expo-of-sum-of-disjoint 
+                 (:instance expo<=
+                            (x y)
+                            (n (+ (expo x) (* -1 n))))
+                 (:instance plus-away-alt
+                            (j n)))))
+  :otf-flg t)
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/away.lisp acl2-6.3/books/rtl/rel9/support/support/away.lisp
--- acl2-6.2/books/rtl/rel9/support/support/away.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/away.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,478 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+;there may be some cruft to be deleted from this file...
+
+;(include-book "trunc") ;BOZO drop
+(local (include-book "away-proofs"))
+
+;; Necessary defuns
+
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund power2p-measure (x)
+  (declare (xargs :guard (and (rationalp x) (not (equal x 0)))))
+  (cond ((or (not (rationalp x))
+             (<= x 0)) 0)
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund power2p (x)
+  (declare (xargs :guard t
+                  :measure (power2p-measure x)
+                  :hints (("goal" :in-theory (enable power2p-measure)))))
+  (cond ((or (not (rationalp x))
+             (<= x 0))
+         nil)
+        ((< x 1) (power2p (* 2 x)))
+        ((<= 2 x) (power2p (* 1/2 x)))
+        ((equal x 1) t)
+        (t nil) ;got a number in the doubly-open interval (1,2)
+        ))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+;; Start of new stuff
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+;generated automatically by ACL2 when we define away, but included here just to be safe
+;could disable (:type-prescription away) for slight efficiency gain at the cost of making the output of :pe a
+;little deceptive
+(defthm away-rational-type-prescription
+  (rationalp (away x n))
+  :rule-classes :type-prescription)
+ 
+(defthm away-of-non-rationalp-is-0
+  (implies (not (rationalp x))
+           (equal (away x n)
+                  0)))
+
+;make alt version? use negative-syntaxp?
+(defthm away-minus
+  (= (away (* -1 x) n)
+     (* -1 (away x n))))
+
+(defthm away-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (< 0 (away x n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm away-positive-rational-type-prescription
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                )
+           (and (< 0 (away x n))
+                (rationalp (away x n))))
+  :rule-classes :type-prescription)
+
+(defthm away-negative
+    (implies (and (< x 0)
+                  (case-split (rationalp x))
+                  )
+	     (< (away x n) 0))
+    :rule-classes (:rewrite :linear))
+
+(defthm away-negative-rational-type-prescription
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                )
+           (< (away x n) 0))
+  :rule-classes :type-prescription)
+
+(defthm away-0
+  (equal (away 0 n)
+         0))
+
+(defthm away-non-negative-rational-type-prescription
+  (implies (<= 0 x)
+           (and (<= 0 (away x n))
+                (rationalp (away x n))))
+  :rule-classes :type-prescription)
+
+(defthm away-non-positive-rational-type-prescription
+  (implies (<= x 0)
+           (and (<= (away x n) 0)
+                (rationalp (away x n))))
+  :rule-classes :type-prescription)
+
+(defthm away-equal-0-rewrite
+  (implies (rationalp x)
+           (equal (equal (away x n) 0)
+                  (equal x 0))))
+
+(defthm sgn-away
+  (equal (sgn (away x n))
+         (sgn x)))
+
+;keep this disabled, since it basically opens up AWAY
+(defthmd abs-away
+  (implies (and (rationalp x)
+                (integerp n))
+           (equal (abs (away x n))
+                  (* (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))))
+
+;kind of gross...
+(defthm away-to-0-or-fewer-bits
+  (implies (and (<= n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (away x n)
+                  (* (sgn x) (expt 2 (+ 1 (expo x) (- n)))))))
+
+(defthm away-lower-bound
+    (implies (and (case-split (rationalp x))
+		  (case-split (integerp n))
+                  )
+	     (>= (abs (away x n)) (abs x)))
+  :rule-classes :linear)
+
+(defthm away-lower-pos
+    (implies (and (>= x 0)
+                  (case-split (rationalp x))
+		  (case-split (integerp n))
+                  )
+	     (>= (away x n) x))
+  :rule-classes :linear)
+
+;elim?
+;; (defthm expo-away-lower-bound
+;;   (implies (and (rationalp x)
+;;                 (integerp n)
+;;                 (> n 0))
+;;            (>= (expo (away x n)) (expo x)))
+;;   :rule-classes :linear)
+
+(defthm expo-away-lower-bound
+  (implies (and (rationalp x)
+                (natp n))
+           (>= (expo (away x n)) (expo x)))
+  :rule-classes :linear)
+
+(defthm away-upper-1
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0))
+           (< (abs (away x n)) (+ (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+(defthm away-upper-2
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (integerp n)
+                (> n 0))
+           (< (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm away-upper-pos
+    (implies (and (> x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (away x n) (* x (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm away-upper-3
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (away x n)) (* (abs x) (+ 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm away-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- (away x n) x)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+(defthm away-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- (away x n) x) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes :linear)
+
+
+(defthm away-diff-expo-1
+    (implies (and (rationalp x)
+		  (not (= x (away x n)))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+;slow
+(defthmd away-rewrite
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0))
+           (equal (away x n)
+                  (* (sgn x) 
+                     (cg (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+                     (expt 2 (- (1+ (expo x)) n))))))
+
+(defthm away-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (away x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+(defthm away-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- (away x n) x)) (- (expo x) n)))
+  :rule-classes :linear)
+
+(defthm away-exactp-a
+    (implies (case-split (< 0 n))
+	     (exactp (away x n) n)))
+
+
+
+;trying disabled?
+(defthmd away-monotone
+  (implies (and (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (<= x y))
+           (<= (away x n) (away y n)))
+  :rule-classes :linear)
+
+(defthm away-exactp-d
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (away x n)) (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthmd away-pos-rewrite
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n))
+           (equal (away x n)
+                  (* (cg (* (expt 2 (- (1- n) (expo x))) x))
+                     (expt 2 (- (1+ (expo x)) n))))))
+
+(defthm expo-away
+  (implies (and (rationalp x)
+                (natp n)
+                (not (= (abs (away x n)) (expt 2 (1+ (expo x))))))
+           (equal (expo (away x n))
+                  (expo x))))
+
+
+;handle the case where n<m?
+(defthm away-away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (equal (away (away x n) m)
+		    (away x m))))
+
+(defthm away-shift
+  (implies (integerp n)
+           (= (away (* x (expt 2 k)) n)
+              (* (away x n) (expt 2 k)))))
+
+;BOZO move to trunc! ?
+(defthm trunc-away-a
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (- x (expt 2 (- (expo x) n)))
+		(trunc x n)))
+  :rule-classes ())
+
+;rename! doesn't mention trunc
+(defthm trunc-away-b
+  (implies (and (integerp n) (> n 0)
+                (rationalp x) (> x 0)
+                (exactp x (1+ n))
+                (not (exactp x n)))
+           (= (away x n)
+              (+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ())
+
+(defthmd away-exactp-c
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a))
+	     (>= a (away x n))))
+
+(defthm away-imp
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (integerp m)
+                (>= m n)
+                (exactp x m))
+           (= (away x n)
+              (trunc (+ x
+                        (expt 2 (- (1+ (expo x)) n))
+                        (- (expt 2 (- (1+ (expo x)) m))))
+                     n)))
+  :rule-classes ())
+
+(defthm plus-away-2
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                )
+           (equal (+ x (away y k))
+                  (* (cg (* (+ x y) (expt 2 (- (1- k) (expo y)))))
+                     (expt 2 (- (1+ (expo y)) k)))))
+  :rule-classes ())
+
+(defthm plus-away
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                )
+           (= (+ x (away y k))
+              (away (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+;add to lib? alternate form of the above
+(defthm plus-away-alt
+  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp j)
+                )
+           (= (away (+ x y) j)
+              (+ x (away y (+ j (- (expo (+ x y))) (expo y))))))
+  :rule-classes ())
+
+; isn't nice for y=0
+;prove corollaries like this for inf, minf, rnd?
+(defthm plus-away-corollary
+  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
+                (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (integerp n)
+                (exactp x n)
+                )
+           (= (away (+ x y) n)
+              (fp+ x n))))
+
+
+;gross.  keep disabled? don't put in user/ ?
+(defthmd away-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (away x n)
+                  (if (not (rationalp x))
+                      0
+                    (if (acl2-numberp n)
+                        (if (power2p (abs x))
+                            (sgn x)
+                        (* 2 (sgn x)))
+                      (* (sgn x) (expt 2 (+ 1 (expo x)))))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/badguys.lisp acl2-6.3/books/rtl/rel9/support/support/badguys.lisp
--- acl2-6.2/books/rtl/rel9/support/support/badguys.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/badguys.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,71 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This file introduces definable Skolem functions that can be used in order to
+; reduce theorems about all elements of a list to theorems about an arbitrary
+; elements of a list.  Matt Kaufmann first learned of this trick from Ken
+; Kunen.
+
+(in-package "ACL2")
+
+;;;**********************************************************************
+;;;                       SUMBITS
+;;;**********************************************************************
+
+(include-book "merge") ; for badguy and lemmas about it
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0 ; arbitrary
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(local
+ (defthm sumbits-badguy-is-correct-lemma
+   (implies (equal (bitn x (sumbits-badguy x y k))
+                   (bitn y (sumbits-badguy x y k)))
+            (equal (sumbits x k)
+                   (sumbits y k)))
+   :rule-classes nil))
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t))
+  :hints (("Goal"
+           :use sumbits-badguy-is-correct-lemma
+           :in-theory (enable sumbits-thm))))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bias-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/bias-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bias-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bias-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,96 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "../../arithmetic/expt"))
+(local (include-book "bvecp"))
+(local (include-book "../../arithmetic/integerp"))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+; bias of a q bit exponent field is 2^(q-1)-1 
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q))
+                )
+           (and (integerp (bias q))
+                (<= 0 (bias q))))
+  :hints (("Goal" :in-theory (enable bias)))
+  :rule-classes :TYPE-PRESCRIPTION
+  )
+
+(encapsulate
+ ()
+ (local (defthm bias-bvecp-aux
+          (implies (and (< 0 q)
+                        (integerp q))
+                   (BVECP (BIAS Q) (1- Q)))
+          :rule-classes nil
+          :hints (("Goal" :in-theory (set-difference-theories
+                                      (enable bias bvecp expt ;-split
+                                              )
+                                      '())))))
+
+ (defthm bias-bvecp
+   (implies (and (<= (1- q) q2)
+                 (case-split (< 0 q))
+                 (case-split (integerp q))
+                 (case-split (integerp q2))
+                 )
+            (BVECP (BIAS Q) q2))
+   :hints (("Goal" :in-theory (enable bvecp-longer)
+            :use bias-bvecp-aux)))
+ )
+
+(defthm bias-integerp-rewrite
+  (equal (integerp (bias q))
+         (or (and (acl2-numberp q) (not (integerp q)))
+             (<= 1 q)))
+  :hints (("Goal" :in-theory (enable bias))))
+
+;where's bias-integerp?
+(defthm bias-integerp
+  (implies (case-split (< 0 k))
+           (integerp (bias k)))
+  :hints (("Goal" :in-theory (enable bias))))
+
+(defthm bias-with-q-an-acl2-number-but-not-an-integer
+  (implies (and (not (integerp q))
+                (case-split (acl2-numberp q)))
+           (equal (bias q)
+                  0))
+  :hints (("Goal" :in-theory (enable bias))))
+
+(defthm bias-with-q-not-an-acl2-number
+  (implies (not (acl2-numberp q))
+           (equal (bias q)
+                  -1/2))
+  :hints (("Goal" :in-theory (enable bias))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bias.lisp acl2-6.3/books/rtl/rel9/support/support/bias.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bias.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bias.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,74 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "bias-proofs"))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+; bias of a q bit exponent field is 2^(q-1)-1 
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(defthm bias-non-negative-integerp-type-prescription
+  (implies (and (case-split (integerp q))
+                (case-split (< 0 q))
+                )
+           (and (integerp (bias q))
+                (<= 0 (bias q))))
+  :rule-classes :TYPE-PRESCRIPTION)
+
+;BOZO rename q2 to k?
+(defthm bias-bvecp
+   (implies (and (<= (1- q) q2)
+                 (case-split (< 0 q))
+                 (case-split (integerp q))
+                 (case-split (integerp q2))
+                 )
+            (bvecp (bias q) q2)))
+
+(defthm bias-integerp-rewrite
+  (equal (integerp (bias q))
+         (or (and (acl2-numberp q) (not (integerp q)))
+             (<= 1 q))))
+
+;where's bias-integerp?
+(defthm bias-integerp
+  (implies (case-split (< 0 k))
+           (integerp (bias k))))
+
+(defthm bias-with-q-an-acl2-number-but-not-an-integer
+  (implies (and (not (integerp q))
+                (case-split (acl2-numberp q)))
+           (equal (bias q)
+                  0)))
+
+(defthm bias-with-q-not-an-acl2-number
+  (implies (not (acl2-numberp q))
+           (equal (bias q)
+                  -1/2)))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bitn-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/bitn-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bitn-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bitn-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1241 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(local (include-book "../../arithmetic/top"))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+
+(include-book "../../arithmetic/negative-syntaxp")
+(include-book "../../arithmetic/power2p")
+
+(local (include-book "ground-zero"))
+
+(local (include-book "bits"))
+(local (include-book "bvecp")) ;to get bvecp-longer
+
+;(in-theory (disable expt-inverse))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :hints (("Goal" :in-theory (enable bitn)))
+  :rule-classes (:type-prescription))
+
+(defthm bitn-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (bitn x n)
+                  0))
+  :hints (("Goal" :in-theory (enable bitn))))
+
+
+(encapsulate
+ ()
+;gen
+ (local (defthm bitn-upper-bound-case-1
+          (implies (integerp n)
+                   (<= (bitn x n) 1))
+          :otf-flg t
+          :hints (("Goal" :use (:instance fl-def-linear-part-2 (x (* 1/2 X (/ (EXPT 2 N)))))
+                   :in-theory (set-difference-theories
+                               (enable mod bitn bits expt-split)
+                               '( fl-def-linear-part-2
+                                  a10
+;                          REARRANGE-ERIC-4
+;                                  REARRANGE-FRACTIONAL-COEFS-<
+                                  ))))
+          :rule-classes (:rewrite :linear)))
+;separate out the linear rule?
+
+ (local (defthm bitn-upper-bound-case-2
+          (implies (not (integerp n))
+                   (<= (bitn x n) 1))
+          :otf-flg t
+          :hints (("Goal" :cases ((integerp (+ n 1)))
+                   :in-theory (set-difference-theories
+                               (enable mod bitn bits expt-split)
+                               '(A10
+                                 fl-def-linear-part-2
+ ;                                REARRANGE-FRACTIONAL-COEFS-<
+                                 ))))
+          :rule-classes (:rewrite :linear)))
+
+
+
+ (defthm bitn-upper-bound
+   (<= (bitn x n) 1)
+   :hints (("Goal" :cases ((integerp n)))))
+ )
+
+(defthm bitn-upper-bound-linear
+  (<= (bitn x n) 1)
+  :rule-classes ((:LINEAR :TRIGGER-TERMS ((bitn x n)))))
+
+;!! was looping with expt-compare
+; look into this more
+(local (in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)))
+
+(encapsulate
+ ()
+;derive from bits-minus?
+ (local (defthm bitn-minus-case-1
+          (implies (and (rationalp x)
+                        (integerp n)
+                        (integerp (/ x (expt 2 (+ 1 n))))
+                        )
+                   (equal (bitn (* -1 x) n)
+                          (- (bitn x n))
+                          ))
+          :hints (("Goal" :in-theory (set-difference-theories
+                                      (enable bitn 
+                                              bits
+                                              mod-cancel
+                                              expt-minus  
+                                              expt-split)
+                                      '( ;expt-inverse 
+                                        ))))))
+
+
+ (local (defthm bitn-minus-case-2
+          (implies (and (rationalp x)
+                        (integerp n)
+                        (not (integerp (/ x (expt 2 n))))
+                        )
+                   (equal (bitn (* -1 x) n)
+                          (- 1 (bitn x n))
+                          ))
+          :hints (("Goal" :in-theory (set-difference-theories
+                                      (enable bitn
+                                              mod
+                                              mod-cancel
+                                              bits 
+                                              even-int-implies-int
+                                              expt-minus  
+                                              expt-split)
+                                      '( ;expt-inverse
+                                        ))))))
+
+
+ (local (defthm bitn-minus-case-3
+          (implies (and (rationalp x)
+                        (integerp n)
+                        (not (integerp (/ x (expt 2 (+ 1 n)))))
+                        (integerp (/ x (expt 2 n)))
+                        )
+                   (equal (bitn (* -1 x) n)
+                          (- 2 (bitn x n))
+                          ))
+          :hints (("Goal" :in-theory (set-difference-theories
+                                      (enable bitn
+                                              mod
+                                              mod-cancel
+                                              bits 
+                                              expt-minus  
+                                              expt-split)
+                                      '( ;expt-inverse
+                                        ))))))
+
+
+
+
+
+ (defthm bitn-minus
+   (implies (and (syntaxp (negative-syntaxp x))
+                 (case-split (rationalp x)) ;gen?
+                 (case-split (integerp n))
+                 )
+            (equal (bitn x n)
+                   (if (integerp (/ x (expt 2 (+ 1 n))))
+                       (- (bitn (- x) n))
+                     (if (integerp (/ x (expt 2 n)))
+                         (- 2 (bitn (- x) n))
+                       (- 1 (bitn (- x) n))))))))
+
+
+
+;(in-theory (disable  FL-EQUAL-0))
+
+;1 rewrite to odd?
+(defthm bitn-0-rewrite-to-even
+  (implies (integerp x)
+           (equal (equal (bitn x 0) 0)
+                  (integerp (* 1/2 x))))
+  :hints (("Goal" :in-theory (enable bitn bits  mod-by-2-rewrite-to-even)))
+  )
+
+
+;...
+
+
+;(in-theory (disable  bitn-sum-lowbits)) ;was causing loops
+
+
+;this one should remain last? <-- huh?
+(theory-invariant (incompatible (:rewrite bits-n-n-rewrite)
+                                (:definition bitn)
+                                )
+                  :key bitn-and-bits-n-n-shouldnt-alternate)
+
+(defthmd bits-n-n-rewrite
+  (equal (BITS X n n)
+         (bitn x n))
+  :hints (("Goal" :in-theory (enable bitn)))
+  )
+
+
+
+
+#|
+;should only fire if it really does simplify x, that is, if x really has bits to be dropped
+(defthm bitn-sum-simplify-first-term
+  (implies (and (>= (abs x) (expt 2 (+ n 1))) ;prevents loop
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (equal (bitn (+ x y) n)
+                  (bitn (+ (lowbits x n) y) n)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable 
+                               lowbits
+                               bitn bits)
+                              '()))))
+
+;should only fire if it really does simplify y, that is, if y really has bits to be dropped
+(defthm bitn-sum-simplify-second-term
+  (implies (and (>= (abs y) (expt 2 (+ n 1))) ;prevents loop
+                (rationalp x)
+                (rationalp y)
+                (integerp n))
+           (equal (bitn (+ x y) n)
+                  (bitn (+ x (lowbits y n)) n)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable lowbits
+                                      bitn bits)
+                              '()))))
+
+(defthm bitn-sum-simplify-third-term
+  (implies (and (>= (abs z) (expt 2 (+ n 1))) ;prevents loop
+                (rationalp x)
+                (rationalp y)
+                (rationalp z)
+                (integerp n))
+           (equal (bitn (+ x y z) n)
+                  (bitn (+ x y (lowbits z n)) n)))
+  :hints (("Goal" :in-theory (disable bitn-sum-simplify-first-term
+                                      bitn-sum-simplify-second-term)
+           :use (:instance bitn-sum-simplify-first-term (x z) (y (+ x y))))))
+
+
+
+|#
+
+
+(defthm bitn-upper-bound-2
+  (< (bitn x n) 2)
+  :hints (("Goal" :in-theory (disable  bitn-upper-bound)
+           :use  bitn-upper-bound)))
+
+(defthm bitn-0-1
+  (or (equal (bitn x n) 0)
+      (equal (bitn x n) 1))
+  :hints (("Goal" :in-theory (disable bitn)))
+  :rule-classes nil)
+
+
+;my strategey with the rules below is to rewrite prefer (not (equal (bitn x n) 0)) over (equal (bitn x n) 1)
+;this allows subsumption to ...
+
+;bad to have both?
+(defthm bitn-not-0-means-1
+  (equal (not (equal (bitn x n) 0))
+         (equal (bitn x n) 1))
+  :hints (("Goal" :use bitn-0-1)))
+
+(defthm bitn-not-1-means-0
+  (equal (not (equal (bitn x n) 1))
+         (equal (bitn x n) 0))
+  :hints (("Goal" :use bitn-0-1)))
+
+;these are bad rules?
+(in-theory (disable bitn-not-1-means-0 bitn-not-0-means-1))
+
+;add matt's forward chaining rules for dealing with single bits (maybe they should go in bvecp.lisp)
+
+
+(encapsulate 
+ ()
+ (local (defthm bitn-bitn-case-1
+          (implies (case-split (integerp n))
+                   (equal (bitn (bitn x n) 0)
+                          (bitn x n)))
+          :hints (("Goal"
+                   :in-theory (set-difference-theories
+                               (enable bitn bits)
+                               '())))))
+
+
+ (local (defthm bitn-bitn-case-2
+          (implies (not (integerp n))
+                   (equal (bitn (bitn x n) 0)
+                          (bitn x n)))
+          :hints (("Goal" :cases ((acl2-numberp n))
+                   :in-theory (set-difference-theories
+                               (enable bitn bits mod)
+                               '())))))
+
+ (defthm bitn-bitn
+   (equal (bitn (bitn x n) 0)
+          (bitn x n))))
+
+
+
+;bb
+(defthm bitn-known-not-0-replace-with-1
+  (implies (not (equal (bitn x n) 0)) ; backchain-limit?
+           (equal (bitn x n)
+                  1))
+  :rule-classes ((:rewrite :backchain-limit-lst (1)))
+  :hints (("Goal" :use (:instance bitn-0-1)))
+  )
+
+
+
+;needed?
+(defthm bitn->-0
+  (equal (< 0 (bitn x n))
+         (not (equal 0 (bitn x n)))))
+
+(defthm bitn-<-1
+  (equal (< (BITN X n) 1)
+         (equal (BITN X n) 0))
+  :hints (("Goal"
+           :use bitn-0-1)))
+
+;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
+(defthm bitn-not->-1
+  (implies (and (syntaxp (quotep k))
+                (<= 1 k))
+           (equal (< k (bitN x n))
+                  nil))
+  :hints (("Goal" :in-theory (disable bitn-upper-bound bitn-upper-bound-2)
+           :use bitn-upper-bound)))
+
+
+;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
+(defthm bitn-<=-1
+  (implies (and (syntaxp (quotep k))
+                (< 1 k))
+           (equal (< (bitN x n) k)
+                  t))
+    :hints (("Goal" :in-theory (disable  BITN-NOT->-1 bitn-upper-bound bitn-upper-bound-2)
+           :use bitn-upper-bound)))
+
+#|
+;cc
+(defthm bitn-shift-alt
+  (implies (and (syntaxp (should-have-a-2-factor-divided-out x))
+                (> n 0) ;restricts application 
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (bitn x n)
+                  (bitn (/ x 2) (- n 1))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bits bitn)
+                              '(bits-shift-alt
+                                ))
+           :use (:instance bits-shift-alt (i n) (j n)))))
+|#
+
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+           (equal (bitn x n)
+                  (mod (fl (/ x (expt 2 n)))
+                       2)))
+  :hints (("Goal" :in-theory (enable bits bitn expt-split))))
+
+
+
+(defun not-eric (x)
+  (if (equal x 0)
+      1
+    0))
+
+
+
+#|
+;this does most of the work (i.e., it gets the constant below 2^i+1
+(defthm bitn-sum-lowbits
+  (implies (and (syntaxp (and (quotep x) (>= (cadr x) (expt 2 (+ 1 (cadr n)))))) ;dropped negative case
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                )
+           (equal (bitn (+ x              y) n)
+                  (bitn (+ (lowbits x n) y) n)))
+  :hints (("Goal" :in-theory (enable bitn)
+           :use  (:instance bits-sum-lowbits (i n) (j n) ))))
+|#
+
+(defthm bitn-drop-crucial-bit-and-flip-result
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp n)) ;drop?
+                )
+           (and (equal (bitn (+ (expt 2 n) x) n)
+                       (not-eric (bitn x n)))
+                (equal (bitn (+ x (expt 2 n)) n)
+                       (not-eric (bitn x n)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bits bitn-def
+                                      expt-split
+                                      )
+                              '(
+                                MOD-PULL-INSIDE-FL-SHIFT-ALT-ALT-ALT-ALT
+                                floor-fl)))))
+
+(defthm bitn-drop-crucial-bit-and-flip-result-alt-gen
+  (implies (and (syntaxp (and (quotep j) 
+                              (< (cadr j) (expt 2 (+ 1 (cadr n)))) ;bitn-sum-lowbits does most of the work
+                              (>= (cadr j) (expt 2 (cadr n)))))
+                (rationalp j)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (bitn (+ j x) n)
+                  (not-eric (bitn (+ (- j (expt 2 n)) x) n))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (disable bitn-drop-crucial-bit-and-flip-result)
+           :use (:instance bitn-drop-crucial-bit-and-flip-result (x (+ j (- (expt 2 n)) x))))))
+
+;for negative constants j
+;might be slow if the negative constant has a large absolute value
+;make a negative version of bitn-sum-lowbits
+(defthm bitn-add-crucial-bit-and-flip-result
+  (implies (and (syntaxp (and (quotep j) 
+                              (quotep n)
+                              (< (cadr j) 0)))
+                (rationalp j)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (bitn (+ j x) n)
+                  (not-eric (bitn (+ (+ j (expt 2 n)) x) n))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (disable  bitn-drop-crucial-bit-and-flip-result)
+           :use (:instance bitn-drop-crucial-bit-and-flip-result (x (+ j  x))))))
+
+
+
+(defthm bitn-equal-to-silly-value
+  (implies (and (syntaxp (quotep k))
+                (not (or (equal 0 k) (equal 1 k)))
+                )
+           (equal (equal k (bitn x n))
+                  nil)))
+                         
+
+
+
+(defthm bitn-split-around-zero
+  (implies (and (<= (- (expt 2 n)) x)
+                (< x (expt 2 n))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (equal (bitn x n) 0)
+                  (<= 0 x)))
+  :otf-flg t
+  :hints (("Goal" :cases ((<= 0 x))
+           :in-theory (enable bitn bits expt-split  mod-force-chosen-a-neg)))
+  )
+
+
+;drop silly hyps like: (<= -128 (BITN FOO 24))
+(defthm bitn-drop-silly-bound
+  (implies (and (syntaxp (quotep k))
+                (<= k 0)
+                )
+  (equal (< (bitn x n) k)
+         nil)))
+
+(defthm bitn-drop-silly-bound-2
+  (implies (and (syntaxp (quotep k))
+                (< k 0)
+                )
+  (equal (< k (bitn x n))
+         t)))
+
+
+(defthm bitn-even-means-0
+  (equal (INTEGERP (* 1/2 (BITN x n)))
+         (equal (bitn x n) 0)))
+
+;new - export disabled?
+(defthm bitn-too-small
+  (implies (and (< x (expt 2 n))
+                (<= 0 x) ;case-split?
+                )
+           (equal (bitn x n)
+                  0))
+  :hints (("Goal" :cases ((rationalp x)) ;why needed?
+           :in-theory (enable bitn bits expt-split)))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil)))
+  )
+
+(defthm bitn-normal-form
+  (equal (equal (bitn x n) 1)
+         (not (equal (bitn x n) 0))))
+
+
+(defthm bitn-of-non-rational
+  (implies (not (rationalp x))
+           (equal (bitn x n)
+                  0))
+  :hints (("Goal" :in-theory (enable bitn)))
+)
+
+
+
+ 
+
+
+(encapsulate
+ ()
+ (local (defthm bitn-bvecp-simple
+   (bvecp (bitn x n) 1)
+   :hints (("Goal" :use bitn-0-1
+            :in-theory (set-difference-theories
+                        (enable bvecp)
+                        '()
+                        )))))
+
+ (defthm bitn-bvecp
+   (implies (and (<= 1 k)
+                 (case-split (integerp k)))
+            (bvecp (bitn x n) k))
+   :hints (("Goal" :use  bitn-bvecp-simple
+            :in-theory (disable bitn-bvecp-simple
+                              ))))
+ )
+
+(defthm bitn-times-fraction-integerp 
+  (implies (and (not (integerp k))
+                (case-split (acl2-numberp k))
+                )
+           (equal (INTEGERP (* k (BITN x n)))
+                  (equal (BITN x n) 0))))
+
+
+
+(defthm bitn-in-product-split-cases
+  (and (implies (case-split (acl2-numberp k))
+                (equal (* (bitn x n) k)
+                       (if (equal (bitn x n) 0)
+                           0
+                         k)))
+       (implies (case-split (acl2-numberp k))
+                (equal (* k (bitn x n))
+                       (if (equal (bitn x n) 0)
+                           0
+                         k)))))
+;(in-theory (disable bitn-in-product-split-cases))
+
+(defthm bitn-in-sum-split-cases
+  (and (implies (case-split (acl2-numberp k))
+                (equal (+ k (bitn x n))
+                       (if (equal (bitn x n) 0)
+                           k
+                         (+ k 1))))
+  
+       (implies (case-split (acl2-numberp k))
+                (equal (+ (bitn x n) k)
+                       (if (equal (bitn x n) 0)
+                           k
+                         (+ k 1))))))
+;(in-theory (disable bitn-in-sum-split-cases))
+
+#|
+(defthm bitn-shift-better
+  (implies (and (bind-free (can-take-out-numeric-power-of-2 x) (c))
+                (force (power2p c))
+                (case-split (integerp n))
+                )
+           (equal (bitn x n)
+                  (bitn (/ x c) (- n (expo c)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn)
+                              '(bits-shift-better)
+                              )
+           :use (:instance bits-shift-better (i n) (j n)))))
+
+|#
+
+(defthm bitn-0
+  (equal (bitn 0 k) 
+         0)
+  :hints (("goal" :in-theory (enable bitn))))
+
+;may cause case splits (maybe that's good?) 
+(defthm bitn-expt-gen
+  (implies (case-split (integerp i))
+           (equal (bitn (expt 2 i) n)
+                  (if (equal i n)
+                      1
+                    0)))
+  :hints (("Goal" :in-theory (enable bitn))))
+
+(defthmd bitn-expt
+  (implies (case-split (integerp n))
+           (equal (bitn (expt 2 n) n) 1)))
+
+;These are intended for the (perhaps weird) case when x in (bitn x n) is a constant but n is not a constant.
+;I actually had this term in a proof: (EQUAL (BITN 128 (BITS <signal-name> 8 6)) 0)
+
+(defthm bitn-of-expt-equal-0
+  (implies (and (syntaxp (quotep x))
+                (equal x (expt 2 (expo x))) ;means x is a power of 2
+                )
+           (equal (equal (bitn x n) 0)
+                  (not (equal n (expo x))))));note that (expo x) will be a constant since x is
+
+(defthm bitn-of-expt-equal-1
+  (implies (and (syntaxp (quotep x))
+                (equal x (expt 2 (expo x))) ;means x is a power of 2
+                )
+           (equal (equal (bitn x n) 1)
+                  (equal n (expo x))))) ;note that (expo x) will be a constant since x is
+
+#|
+(defthm bitn-of-expt-constant
+  (implies (and (syntaxp (quotep x))
+                (equal e (expo x)) ;having E means we don't have to evaluate (expo x) in the conclusion
+                (equal x (expt 2 e)) ;means x is a power of 2
+                )
+           (equal (bitn x n)
+                  (log= n e)))) ;note that e will be a constant
+
+|#
+
+;This is the rule Doc is allowing in lib/, since it doesn't cause as many case-splits are bitn-expt-gen?
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n) 0)))
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+        (equal (bitn x n) 1))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable bitn))))
+
+(defthmd bitn-shift-eric
+  (implies (and (integerp n)
+                (integerp k)
+                )
+           (equal (bitn (* x (expt 2 k)) n)
+                  (bitn x (+ n (- k)))))
+  :hints (("Goal" :in-theory (enable bitn))))
+
+;BOZO replace with bitn-shift-eric ??
+(defthmd bitn-shift
+  (implies (and (integerp n)
+                (integerp k)
+                )
+           (equal (bitn (* x (expt 2 k)) (+ n k))
+                  (bitn x n)))
+  :hints (("Goal" :in-theory (enable bitn))))
+
+;gen!
+;dammit, ACL2 unifies 0 with (* 2 x), so this rule can loop!
+(defthm bitn-shift-by-2
+  (implies (and (syntaxp (not (quotep x)))
+                (acl2-numberp n))
+           (equal (BITN (* 2 x) n)
+                  (bitn x (1- n))))
+  :hints (("Goal" :use (:instance bitn-shift-eric (k 1))))
+  )
+
+(defthmd bitn-plus-mult
+  (implies (and (< n m)
+                (integerp m)
+                (integerp k)
+                )
+           (equal (bitn (+ x (* k (expt 2 m))) n)
+                  (bitn x n)))
+  :hints (("Goal" :in-theory (enable bitn bits-plus-mult-2))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n)))
+    :hints (("Goal" :use ((:instance bitn-plus-mult
+                                     (x x)
+                                     (k (/ c (expt 2 (1+ n))))
+                                     (m (1+ n))
+                                     (n n)))
+             :in-theory (enable mod))))
+
+;we almost always want to leave this disabled!
+(defthmd bitn-plus-bits
+  (implies (and (<= m n)
+                (integerp m)
+                (integerp n)
+                )
+           (= (bits x n m)
+              (+ (* (bitn x n) (expt 2 (- n m)))
+                 (bits x (1- n) m))))
+  :hints (("goal" :in-theory (enable bitn)
+           :use ((:instance bits-plus-bits (n n) (p n) (m m)))
+           )))
+
+;we almost always want to leave this disabled!
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+                  (integerp m)
+		  (integerp n)
+		  )
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable bitn)
+           :use ((:instance bits-plus-bits (n n) (m m) (p (+ m 1)))))))
+
+;drop?
+(defthm bits-0-bitn-0
+  (implies (and (<= 0 n)
+                (integerp n)
+                )
+           (iff (= (bits x n 0) 0)
+                (and (= (bitn x n) 0)
+                     (= (bits x (1- n) 0) 0))))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance bitn-plus-bits (m 0)))))
+
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+                (integerp k))
+           (equal (bitn (fl (/ x (expt 2 k))) i)
+                  (bitn x (+ i k))))
+  :hints (("goal" :in-theory (e/d (bits-shift-down-1 bitn) (BITS-FL)))))
+
+(defthm bitn-shift-by-constant-power-of-2
+  (implies (and (syntaxp (quotep k))
+                (power2p k)
+                (case-split (integerp n))
+                )
+           (equal (bitn (* k x) n)
+                  (bitn x (- n (expo k)))))
+  :hints (("Goal" :use (:instance  bits-shift-by-constant-power-of-2 (i n) (j n))
+           :in-theory (enable bitn))))
+
+(defthmd bitn-shift-eric-2
+  (implies (and (integerp n)
+                (integerp k)
+                )
+           (equal (bitn (* (expt 2 k) x) n) ;BOZO rewrite the (+ n k) to match better
+                  (bitn x (+ n (- k)))))
+  :hints (("Goal" :in-theory (enable bitn))))
+
+
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+           (equal (bitn x 0)
+                  (mod x 2)))
+  :hints (("goal" :use ((:instance bitn-def (n 0))))))
+
+;rename?
+;is there a bits analog of this theorem?
+;move or copy to bitn?
+;change k to n
+;BOZO change formal k to n
+(defthmd bitn-rec-pos
+  (implies (< 0 n) ;n cannot be 0 or negative
+           (equal (bitn x n)
+                  (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t))))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable bitn-def expt-split)
+                              '( ; bitn-def
+                                fl/int-rewrite
+                                fl-shift-fl  
+                                mod-pull-inside-fl-shift-alt-alt-alt
+                                mod-pull-inside-fl-shift-alt-alt-alt-alt))
+           :use ((:instance fl/int-rewrite (x (/ x 2)) (n (expt 2 (1- n))))))))
+
+
+
+;generalize to bits-mod?
+(defthmd bitn-mod
+  (implies (and (< k n)
+                (integerp n)
+                (integerp k)
+                )
+           (equal (bitn (mod x (expt 2 n)) k)
+                  (bitn x k)))
+  :hints (("Goal"; :cases ((integerp n))
+           :in-theory (enable bitn bits))))
+
+;dup?
+(defthm BIT-EXPO-A
+  (implies (and (< x (expt 2 n))
+                (>= x 0)
+                (integerp n)
+                )
+           (equal (bitn x n) 0))
+  :rule-classes ())
+
+;special case of  bit-expo-c?
+(defthm BIT-EXPO-B
+  (implies (and (<= (expt 2 n) x)
+                (< x (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                ;(>= x 0)
+                ;(>= n 0)
+                )
+           (equal (bitn x n) 1))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split bitn-def)
+           :use ((:instance fl-unique (x (/ x (expt 2 n))) (n 1))))))
+
+(defthm bitn-plus-expt-1
+  (implies (and (rationalp x)
+                (integerp n)
+                )
+           (not (equal (bitn (+ x (expt 2 n)) n)
+                       (bitn x n))))
+  :rule-classes ()
+)
+
+
+;bozo. dup?
+;prove from bitn-plus-mult?
+(defthm bitn-plus-expt-2
+  (implies (and (< n m)
+                (integerp n)
+                (integerp m)
+                )
+           (equal (bitn (+ x (expt 2 m)) n)
+                  (bitn x n)))
+  :hints (("Goal" :in-theory (enable bitn))))
+
+;this is the most interesting case. perhaps add the other cases for k<0 and k>i-j
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+                (case-split (<= 0 k))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                )
+           (equal (bitn (bits x i j) k)
+                  (bitn x (+ j k))))
+  :hints (("Goal" :in-theory (e/d ( bitn) (BITS-FL)))))
+
+;The following trivial corollary of bitn-bits is worth keeping enabled.
+
+(defthm bitn-bits-constants
+  (implies (and (syntaxp (quotep i))
+                (syntaxp (quotep j))
+                (syntaxp (quotep k))
+                (<= k (- i j))
+                (<= 0 k)
+                (integerp i)
+                (integerp j)
+                (integerp k))
+           (equal (bitn (bits x i j) k)
+                  (bitn x (+ j k)))))
+
+
+(defthmd bit+*k-2
+  (implies (and (< x (expt 2 m))
+                (<= 0 x)
+                (rationalp x)
+                (<= m n)
+                (integerp k)
+                (case-split (integerp n))
+                (case-split (integerp m))
+                )
+           (equal (bitn (+ x (* k (expt 2 m))) n)
+                  (bitn k (- n m))))
+  :hints (("Goal" :in-theory (enable bitn bits+2**k-2))))
+
+(defthmd bitn-shift-3
+  (implies (and (bvecp x m)
+                (<= m n)
+                (integerp k)
+                (case-split (integerp n))
+                (case-split (integerp m))
+                )
+           (equal (bitn (+ x (* k (expt 2 m))) n)
+                  (bitn k (- n m))))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use (bit+*k-2))))
+
+
+;try
+
+(local
+ (defthm bit-expo-c-4
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (integerp k)
+                 (<= k n)
+                 (< x (expt 2 n))
+                 (<= (- (expt 2 n) (expt 2 k)) x))
+            (= (fl (/ x (expt 2 k)))
+               (1+ (* 2 (1- (expt 2 (1- (- n k))))))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (set-difference-theories
+                               (enable expt-split expt-minus )
+                               '())
+            :use ((:instance fl-unique (x (/ x (expt 2 k))) (n (1- (expt 2 (- n k))))))))))
+
+
+
+(local
+ (defthm bit-expo-c-6
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (integerp k)
+                 (< k n)
+                 (< x (expt 2 n))
+                 (<= (- (expt 2 n) (expt 2 k)) x))
+            (= (mod (fl (/ x (expt 2 k))) 2)
+               1))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable  expt-split
+                               )
+            :use ( ;(:instance bit-expo-c-5)
+                         (:instance bit-expo-c-4)
+                         (:instance mod-mult-eric (x 1) (y 2) (a (1- (expt 2 (1- (- n k))))))
+)))))
+
+;prove this from a more general result about bits??
+;BOZO bad name. doesn't mention expo !
+(defthm bit-expo-c
+    (implies (and (<= (- (expt 2 n) (expt 2 k)) x)
+                  (< x (expt 2 n))
+                  (< k n)
+                  (rationalp x);(integerp x) ;gen more!
+		  (integerp n)
+		  (integerp k)
+		  )
+	     (equal (bitn x k) 1))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance bitn-def (n k))
+			(:instance bit-expo-c-6)))))
+
+(defthmd bvecp-bitn-2
+    (implies (and (bvecp x n) ; bind free var n here
+                  (< k n)
+                  (<= (- (expt 2 n) (expt 2 k)) x)
+                  (integerp n)
+		  (integerp k)
+		  )
+	     (equal (bitn x k) 1))
+    :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use (bit-expo-c))))
+
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+
+#| old:
+(defun BITN (x n)
+  (if (logbitp n x) 1 0))
+|#
+
+(defthm bitn-natp
+  (natp (bitn x n)))
+
+;BOZO do we want these?
+(defthmd bitn-fw-1
+  (implies (not (equal (bitn x n) 0))
+           (equal (bitn x n) 1)
+           )
+  :rule-classes (:forward-chaining))
+
+(defthmd bitn-fw-2
+  (implies (not (equal (bitn x n) 1))
+           (equal (bitn x n) 0)
+           )
+  :rule-classes (:forward-chaining))
+
+(defthmd bvecp-bitn-0
+  (implies (bvecp x n)
+           (equal (bitn x n) 0))
+  :hints (("Goal" :in-theory (enable bitn bvecp-bits-0))))
+
+
+;make an alt version?
+(defthm bitn-bvecp-0
+  (implies (and (bvecp x n)
+                (<= 0 m)
+                )
+           (equal (bitn x (+ m n)) 0))
+  :hints (("Goal" :in-theory (disable bvecp-bitn-0)
+           :use ((:instance bvecp-bitn-0 (n (+ m n)))))))
+
+;k is a free var
+;do we need this, if we have bvecp-longer?
+(defthm bitn-bvecp-0-eric
+  (implies (and (bvecp x k)
+                (<= k n))
+           (equal (bitn x n) 0))
+  :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :in-theory (enable bvecp-bitn-0))))
+
+
+;sort of a "bitn-tail" like bits-tail?
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x))
+    :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+                  (natp n))
+	     (equal (bitn x n) 1))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use (bit-expo-b))))
+
+;handle the case where we don't go down to 0?
+(defthm bits-bitn
+  (implies (and (case-split (integerp i))
+                (case-split (<= 0 i))
+                )
+  (equal (bits (bitn x n) i 0)
+         (bitn x n)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn)
+                              '()))))
+
+(defthmd bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0))
+  :hints (("Goal" :in-theory (enable bitn bits-neg))))
+
+; Start proof of sum-bitn.
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthm sum-b-bounds
+  (implies (all-bits-p b k)
+           (and (<= 0 (sum-b b k))
+                (< (sum-b b k) (expt 2 k))))
+  :hints (("Goal" :expand ((expt 2 k))))
+  :rule-classes :linear)
+
+(defun sum-b-alt (b lower upper)
+  (if (or (zp upper) ; for termination
+          (equal upper lower))
+      0
+    (+ (* (expt 2 (1- upper)) (nth (1- upper) b))
+       (sum-b-alt b lower (1- upper)))))
+
+(defthmd sum-b-alt-split
+  (implies (and (<= lower k)
+                (< k upper)
+                (integerp upper)
+                (natp k))
+           (equal (sum-b-alt b lower upper)
+                  (+ (sum-b-alt b lower k)
+                     (* (expt 2 k) (nth k b))
+                     (sum-b-alt b (1+ k) upper)))))
+
+(defthm nth-nthcdr
+  (implies (and (natp i)
+                (natp j))
+           (equal (nth i (nthcdr j x))
+                  (nth (+ i j) x))))
+
+(defthm sum-b-alt-is-sum-b
+  (implies (and (natp lower)
+                (natp upper)
+                (all-bits-p b upper)
+                (<= lower upper))
+           (equal (sum-b-alt b lower upper)
+                  (* (expt 2 lower)
+                     (sum-b (nthcdr lower b) (- upper lower))))))
+
+(defthm all-bits-p-goes-down
+  (implies (and (all-bits-p b n)
+                (<= k n)
+                (natp n)
+                (natp k))
+           (all-bits-p b k)))
+
+(defthmd sum-b-split
+  (implies (and (< k upper)
+                (natp k)
+                (integerp upper)
+                (natp upper)
+                (all-bits-p b upper))
+           (equal (sum-b b upper)
+                  (+ (sum-b b k)
+                     (* (expt 2 k) (nth k b))
+                     (* (expt 2 (1+ k))
+                        (sum-b (nthcdr (1+ k) b) (1- (- upper k)))))))
+  :hints (("Goal" :use ((:instance sum-b-alt-split (lower 0))))))
+
+(defthm natp-sum-b
+  (implies (and (force (all-bits-p b k))
+                (force (natp k)))
+           (natp (sum-b b k)))
+  :rule-classes :type-prescription)
+
+(defthm all-bits-p-nthcdr-cdr
+  (implies (and (natp k)
+                (natp n)
+                (all-bits-p x n)
+                (< k n))
+           (all-bits-p (nthcdr k (cdr x)) (+ -1 n (* -1 k)))))
+
+(defthm sum-bitn-1-1
+  (implies (and (natp n)
+                (all-bits-p b n)
+                (natp k)
+                (< k n))
+           (equal (bitn (+ (sum-b b k)
+                           (* (expt 2 k) (nth k b))
+                           (* (expt 2 (1+ k))
+                              (sum-b (nthcdr (1+ k) b) (1- (- n k)))))
+                        k)
+                  (bitn (+ (sum-b b k)
+                           (* (expt 2 k) (nth k b)))
+                        k)))
+  :hints (("Goal"
+           :use ((:instance bitn-plus-mult
+                            (x (+ (sum-b b k)
+                                  (* (expt 2 k) (nth k b))))
+                            (k (sum-b (nthcdr (1+ k) b) (1- (- n k))))
+                            (m (1+ k))
+                            (n k)))))
+  :rule-classes nil)
+
+(defthm sum-bitn-1-2
+  (implies (and (natp n)
+                (all-bits-p b n)
+                (natp k)
+                (< k n))
+           (equal (bitn (+ (sum-b b k)
+                           (* (expt 2 k) (nth k b)))
+                        k)
+                  (nth k b)))
+  :rule-classes nil)
+
+(defthmd sum-bitn-1
+  (implies (and (natp n)
+                (all-bits-p b n)
+                (natp k)
+                (< k n))
+           (equal (bitn (+ (sum-b b k)
+                           (* (expt 2 k) (nth k b))
+                           (* (expt 2 (1+ k))
+                              (sum-b (nthcdr (1+ k) b) (1- (- n k)))))
+                        k)
+                  (nth k b)))
+  :hints (("Goal" :use (sum-bitn-1-1 sum-bitn-1-2))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b)))
+  :hints (("Goal" :use sum-bitn-1
+           :in-theory (enable sum-b-split))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bitn.lisp acl2-6.3/books/rtl/rel9/support/support/bitn.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bitn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bitn.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,707 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "ground-zero")
+(include-book "../../arithmetic/power2p")
+(include-book "../../arithmetic/negative-syntaxp")
+(local (include-book "bitn-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+;; Necessary defuns:
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;;
+;; Begin bitn stuff...
+;;
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defthm bitn-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (bitn x n)
+                  0)))
+
+(defthm bitn-of-non-rational
+  (implies (not (rationalp x))
+           (equal (bitn x n)
+                  0)))
+
+(defthm bitn-nonnegative-integer
+  (and (integerp (bitn x n))
+       (<= 0 (bitn x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bitn-nonnegative-integer and might be worse:
+(in-theory (disable (:type-prescription bitn)))
+
+(defthm bitn-natp
+  (natp (bitn x n)))
+
+(defthm bitn-upper-bound
+  (<= (bitn x n) 1))
+
+(defthm bitn-upper-bound-linear
+  (<= (bitn x n) 1)
+  :rule-classes ((:LINEAR :TRIGGER-TERMS ((bitn x n)))))
+
+;include separate cases?
+;BOZO one of the branches simplifies to 0 - see bits-minus
+(defthm bitn-minus
+  (implies (and (syntaxp (negative-syntaxp x))
+                (case-split (rationalp x)) ;gen?
+                (case-split (integerp n))
+                )
+           (equal (bitn x n)
+                  (if (integerp (/ x (expt 2 (+ 1 n))))
+                      (- (bitn (- x) n))
+                    (if (integerp (/ x (expt 2 n)))
+                        (- 2 (bitn (- x) n))
+                      (- 1 (bitn (- x) n)))))))
+;1 rewrite to odd?
+;trying disabled
+(defthmd bitn-0-rewrite-to-even
+  (implies (integerp x)
+           (equal (equal (bitn x 0) 0)
+                  (integerp (* 1/2 x)))))
+
+;we probably want this enanled in lib/ but not in support/
+(defthmd bits-n-n-rewrite
+  (equal (bits x n n)
+         (bitn x n)))
+
+(theory-invariant (incompatible (:rewrite bits-n-n-rewrite)
+                                (:definition bitn)
+                                )
+                  :key bitn-and-bits-n-n-can-loop)
+
+(defthm bitn-0-1
+  (or (equal (bitn x n) 0)
+      (equal (bitn x n) 1))
+  :rule-classes nil)
+
+
+;my strategy with the rules below is to prefer (not (equal (bitn x n) 0)) over (equal (bitn x n) 1)
+;this allows subsumption to ...
+;but maybe this is a bad idea!
+;BOZO if we have f-w chaining rule to handle this issue, perhaps drop these rules?
+
+;bad to have both?
+(defthm bitn-not-0-means-1
+  (equal (not (equal (bitn x n) 0))
+         (equal (bitn x n) 1)))
+
+(defthm bitn-not-1-means-0
+  (equal (not (equal (bitn x n) 1))
+         (equal (bitn x n) 0)))
+
+;these are bad rules?
+(in-theory (disable bitn-not-1-means-0 bitn-not-0-means-1))
+
+(defthm bitn-bitn
+  (equal (bitn (bitn x n) 0)
+         (bitn x n)))
+
+(defthm bitn-known-not-0-replace-with-1
+  (implies (not (equal (bitn x n) 0)) ; backchain-limit?
+           (equal (bitn x n)
+                  1))
+  :rule-classes ((:rewrite :backchain-limit-lst (1)))
+  )
+
+;needed?
+(defthm bitn->-0
+  (equal (< 0 (bitn x n))
+         (not (equal 0 (bitn x n)))))
+
+(defthm bitn-<-1
+  (equal (< (BITN X n) 1)
+         (equal (BITN X n) 0)))
+
+;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
+(defthm bitn-not->-1
+  (implies (and (syntaxp (quotep k))
+                (<= 1 k))
+           (equal (< k (bitn x n))
+                  nil)))
+
+;useful if bitn-upper-bound and bitn-upper-bound-2 are disabled
+(defthm bitn-<=-1
+  (implies (and (syntaxp (quotep k))
+                (< 1 k))
+           (equal (< (bitn x n) k)
+                  t)))
+
+(defthmd bitn-rec-0
+  (implies (integerp x)
+           (equal (bitn x 0)
+                  (mod x 2))))
+
+;rename?
+;is there a bits analog of this theorem?
+;BOZO change formal k to n
+(defthmd bitn-rec-pos
+  (implies (< 0 n) ;n cannot be 0 or negative
+           (equal (bitn x n)
+                  (bitn (fl (/ x 2)) (1- n))))
+  :rule-classes ((:definition :controller-alist ((bitn t t)))))
+
+;BOZO change k param to n
+(defthmd bitn-def
+  (implies (case-split (integerp n))
+           (equal (bitn x n)
+                  (mod (fl (/ x (expt 2 n)))
+                       2))))
+
+;make bit-not, bit-and, etc. ?
+;BOZO or remove this function?
+(defun not-eric (x)
+  (if (equal x 0)
+      1
+    0))
+
+(defthm bitn-drop-crucial-bit-and-flip-result
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp n)) ;drop?
+                )
+           (and (equal (bitn (+ (expt 2 n) x) n)
+                       (not-eric (bitn x n)))
+                (equal (bitn (+ x (expt 2 n)) n)
+                       (not-eric (bitn x n))))))
+
+;BOZO this looped!
+(defthmd bitn-drop-crucial-bit-and-flip-result-alt-gen
+  (implies (and (syntaxp (and (quotep j) 
+                              (< (cadr j) (expt 2 (+ 1 (cadr n)))) ;bitn-sum-lowbits does most of the work
+                              (>= (cadr j) (expt 2 (cadr n)))))
+                (rationalp j)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (bitn (+ j x) n)
+                  (not-eric (bitn (+ (- j (expt 2 n)) x) n)))))
+
+;for negative constants j
+;might be slow if the negative constant has a large absolute value
+;make a negative version of bitn-sum-lowbits
+(defthm bitn-add-crucial-bit-and-flip-result
+  (implies (and (syntaxp (and (quotep j) 
+                              (quotep n)
+                              (< (cadr j) 0)))
+                (rationalp j)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (bitn (+ j x) n)
+                  (not-eric (bitn (+ (+ j (expt 2 n)) x) n)))))
+
+(defthm bitn-equal-to-silly-value
+  (implies (and (syntaxp (quotep k))
+                (not (or (equal 0 k) (equal 1 k)))
+                )
+           (equal (equal k (bitn x n))
+                  nil)))
+                         
+(defthm bitn-split-around-zero
+  (implies (and (<= (- (expt 2 n)) x)
+                (< x (expt 2 n))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (equal (bitn x n) 0)
+                  (<= 0 x))))
+
+;drop silly hyps like: (<= -128 (bitn x 24))
+(defthm bitn-drop-silly-bound
+  (implies (and (syntaxp (quotep k))
+                (<= k 0)
+                )
+           (equal (< (bitn x n) k)
+                  nil)))
+
+(defthm bitn-drop-silly-bound-2
+  (implies (and (syntaxp (quotep k))
+                (< k 0)
+                )
+           (equal (< k (bitn x n))
+                  t)))
+
+;there are many other ways to say that something is even (include those?)
+(defthm bitn-even-means-0
+  (equal (integerp (* 1/2 (bitn x n)))
+         (equal (bitn x n) 0)))
+
+;new - export disabled?
+(defthm bitn-too-small
+  (implies (and (< x (expt 2 n))
+                (<= 0 x) ;case-split?
+                )
+           (equal (bitn x n)
+                  0))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil))))
+
+;not sure how to handle this.
+(defthmd bitn-normal-form
+  (equal (equal (bitn x n) 1)
+         (not (equal (bitn x n) 0))))
+
+(defthm bitn-bvecp
+  (implies (and (<= 1 k)
+                (case-split (integerp k)))
+           (bvecp (bitn x n) k)))
+
+(defthm bitn-times-fraction-integerp 
+  (implies (and (not (integerp k))
+                (case-split (acl2-numberp k))
+                )
+           (equal (INTEGERP (* k (BITN x n)))
+                  (equal (BITN x n) 0))))
+
+(defthm bitn-in-product-split-cases
+  (and (implies (case-split (acl2-numberp k))
+                (equal (* (bitn x n) k)
+                       (if (equal (bitn x n) 0)
+                           0
+                         k)))
+       (implies (case-split (acl2-numberp k))
+                (equal (* k (bitn x n))
+                       (if (equal (bitn x n) 0)
+                           0
+                         k)))))
+
+(defthm bitn-in-sum-split-cases
+  (and (implies (case-split (acl2-numberp k))
+                (equal (+ k (bitn x n))
+                       (if (equal (bitn x n) 0)
+                           k
+                         (+ k 1))))
+       (implies (case-split (acl2-numberp k))
+                (equal (+ (bitn x n) k)
+                       (if (equal (bitn x n) 0)
+                           k
+                         (+ k 1))))))
+
+;BOZO change params
+(defthm bitn-0
+  (equal (bitn 0 k)
+         0))
+
+(defthmd bitn-fw-1
+  (implies (not (equal (bitn x n) 0))
+           (equal (bitn x n) 1)
+           )
+  :rule-classes (:forward-chaining))
+
+(defthmd bitn-fw-2
+  (implies (not (equal (bitn x n) 1))
+           (equal (bitn x n) 0)
+           )
+  :rule-classes (:forward-chaining))
+
+;may cause case splits (maybe that's good?) 
+(defthm bitn-expt-gen
+  (implies (case-split (integerp i))
+           (equal (bitn (expt 2 i) n)
+                  (if (equal i n)
+                      1
+                    0))))
+
+;BOZO consider having only the rule above?
+(defthmd bitn-expt
+  (implies (case-split (integerp n))
+           (equal (bitn (expt 2 n) n) 1)))
+
+
+;These are intended for the (perhaps weird) case when x in (bitn x n) is a constant but n is not a constant.
+;I actually had this term in a proof: (EQUAL (BITN 128 (BITS <signal-name> 8 6)) 0)
+(defthm bitn-of-expt-equal-0
+  (implies (and (syntaxp (quotep x))
+                (equal x (expt 2 (expo x))) ;means x is a power of 2
+                )
+           (equal (equal (bitn x n) 0)
+                  (not (equal n (expo x))))));note that (expo x) will be a constant since x is
+
+(defthm bitn-of-expt-equal-1
+  (implies (and (syntaxp (quotep x))
+                (equal x (expt 2 (expo x))) ;means x is a power of 2
+                )
+           (equal (equal (bitn x n) 1)
+                  (equal n (expo x))))) ;note that (expo x) will be a constant since x is
+
+(defthmd bitn-expt-0
+  (implies (and (not (equal i n))
+		(case-split (integerp i)))
+	   (equal (bitn (expt 2 i) n) 0)))
+
+(defthm bitn-0-1
+    (or (equal (bitn x n) 0)
+        (equal (bitn x n) 1))
+  :rule-classes ())
+
+;BOZO enable?
+(defthmd bitn-shift-eric
+  (implies (and (integerp n)
+                (integerp k)
+                )
+           (equal (bitn (* x (expt 2 k)) n)
+                  (bitn x (+ n (- k))))))
+
+(defthmd bitn-shift-eric-2
+  (implies (and (integerp n)
+                (integerp k)
+                )
+           (equal (bitn (* (expt 2 k) x) n)
+                  (bitn x (+ n (- k))))))
+
+;BOZO replace with bitn-shift-eric ??
+(defthmd bitn-shift
+  (implies (and (integerp n)
+                (integerp k)
+                )
+           (equal (bitn (* x (expt 2 k)) (+ n k))  ;BOZO rewrite the (+ n k) to match better
+                  (bitn x n)))) 
+
+;dammit, ACL2 unifies 0 with (* 2 x), so this rule can loop!
+(defthm bitn-shift-by-2
+  (implies (and (syntaxp (not (quotep x)))
+                (acl2-numberp n))
+           (equal (BITN (* 2 x) n)
+                  (bitn x (1- n)))))
+
+(defthmd bitn-plus-mult
+  (implies (and (< n m)
+                (integerp m)
+                (integerp k)
+                )
+           (equal (bitn (+ x (* k (expt 2 m))) n)
+                  (bitn x n))))
+
+(defthmd bitn-plus-mult-rewrite
+    (implies (and (syntaxp (quotep c))
+		  (equal (mod c (expt 2 (1+ n))) 0))
+	     (equal (bitn (+ c x) n)
+		    (bitn x n))))
+
+;we almost always want to leave this disabled!
+(defthmd bitn-plus-bits
+  (implies (and (<= m n)
+                (integerp m)
+                (integerp n)
+                )
+           (= (bits x n m)
+              (+ (* (bitn x n) (expt 2 (- n m)))
+                 (bits x (1- n) m)))))
+
+;BOZO it's in r-c nil.  we almost always want to leave this disabled!
+(defthm bits-plus-bitn
+    (implies (and (<= m n)
+                  (integerp m)
+		  (integerp n)
+		  )
+	     (= (bits x n m)
+		(+ (bitn x m)
+		   (* 2 (bits x n (1+ m))))))
+  :rule-classes ())
+
+;drop?
+(defthm bits-0-bitn-0
+  (implies (and (<= 0 n)
+                (integerp n)
+                )
+           (iff (= (bits x n 0) 0)
+                (and (= (bitn x n) 0)
+                     (= (bits x (1- n) 0) 0))))
+  :rule-classes ())
+
+;Follows from bits-shift-down-1
+(defthmd bitn-shift-down
+  (implies (and (natp i)
+                (integerp k))
+           (equal (bitn (fl (/ x (expt 2 k))) i)
+                  (bitn x (+ i k)))))
+
+(defthm bitn-shift-by-constant-power-of-2
+  (implies (and (syntaxp (quotep k))
+                (power2p k)
+                (case-split (integerp n))
+                )
+           (equal (bitn (* k x) n)
+                  (bitn x (- n (expo k))))))
+
+
+
+;generalize to bits-mod?
+(defthmd bitn-mod
+  (implies (and (< k n)
+                (integerp n)
+                (integerp k)
+                )
+           (equal (bitn (mod x (expt 2 n)) k)
+                  (bitn x k))))
+
+;dup?
+(defthm BIT-EXPO-A
+  (implies (and (< x (expt 2 n))
+                (>= x 0)
+                (integerp n)
+                )
+           (equal (bitn x n) 0))
+  :rule-classes ())
+
+;special case of  bit-expo-c?
+(defthm BIT-EXPO-B
+  (implies (and (<= (expt 2 n) x)
+                (< x (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                ;(>= x 0)
+                ;(>= n 0)
+                )
+           (equal (bitn x n) 1))
+  :rule-classes ())
+
+;bozo. combine these next 2?
+
+;bozo. dup?
+(defthm bitn-plus-expt-1
+  (implies (and (rationalp x)
+                (integerp n)
+                )
+           (not (equal (bitn (+ x (expt 2 n)) n)
+                       (bitn x n))))
+  :rule-classes ()
+)
+
+
+;bozo. dup?
+;prove from bitn-plus-mult?
+(defthm bitn-plus-expt-2
+  (implies (and (< n m)
+                (integerp n)
+                (integerp m)
+                )
+           (equal (bitn (+ x (expt 2 m)) n)
+                  (bitn x n))))
+
+
+;this is the most interesting case. perhaps add the other cases for k<0 and k>i-j
+(defthm bitn-bits
+  (implies (and (<= k (- i j))
+                (case-split (<= 0 k))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                )
+           (equal (bitn (bits x i j) k)
+                  (bitn x (+ j k)))))
+
+;The following trivial corollary of bitn-bits is worth keeping enabled.
+
+(defthm bitn-bits-constants
+  (implies (and (syntaxp (quotep i))
+                (syntaxp (quotep j))
+                (syntaxp (quotep k))
+                (<= k (- i j))
+                (<= 0 k)
+                (integerp i)
+                (integerp j)
+                (integerp k))
+           (equal (bitn (bits x i j) k)
+                  (bitn x (+ j k)))))
+
+(defthmd bitn-shift-3
+  (implies (and (bvecp x m)
+                (<= m n)
+                (integerp k)
+                (case-split (integerp n))
+                (case-split (integerp m))
+                )
+           (equal (bitn (+ x (* k (expt 2 m))) n)
+                  (bitn k (- n m)))))
+
+;reconcile param names with bits version?
+;like  bitn-shift-3
+;rename!
+
+(defthmd bit+*k-2
+  (implies (and (< x (expt 2 m))
+                (<= 0 x)
+                (rationalp x)
+                (<= m n)
+                (integerp k)
+                (case-split (integerp n))
+                (case-split (integerp m))
+                )
+           (equal (bitn (+ x (* k (expt 2 m))) n)
+                  (bitn k (- n m)))))
+
+(defthm bit-expo-c
+    (implies (and (<= (- (expt 2 n) (expt 2 k)) x)
+                  (< x (expt 2 n))
+                  (< k n)
+                  (rationalp x);(integerp x) ;gen more!
+		  (integerp n)
+		  (integerp k)
+		  )
+	     (equal (bitn x k) 1))
+  :rule-classes ())
+
+;Follows from bit-expo-c
+;requires x to be an integer, unlike bit-expo-c.
+(defthmd bvecp-bitn-2
+    (implies (and (bvecp x n) ; bind free var n here
+                  (< k n)
+                  (<= (- (expt 2 n) (expt 2 k)) x)
+                  (integerp n)
+		  (integerp k)
+		  )
+	     (equal (bitn x k) 1))
+    :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use (bit-expo-c))))
+
+(defthm bitn-bvecp-forward
+  (bvecp (bitn x n) 1)
+  :rule-classes ((:forward-chaining :trigger-terms ((bitn x n)))))
+
+;could combine these next two?
+
+;BOZO enable?
+(defthmd bvecp-bitn-0
+  (implies (bvecp x n)
+           (equal (bitn x n) 0)))
+
+;make an alt version?
+;trying disabled..
+(defthmd bitn-bvecp-0
+  (implies (and (bvecp x n)
+                (<= 0 m)
+                )
+           (equal (bitn x (+ m n)) 0)))
+
+;k is a free var
+;do we need this, if we have bvecp-longer?
+(defthm bitn-bvecp-0-eric
+  (implies (and (bvecp x k)
+                (<= k n))
+           (equal (bitn x n) 0))
+  :rule-classes ((:rewrite :match-free :all)))
+
+;sort of a "bitn-tail" like bits-tail?
+(defthm bitn-bvecp-1
+  (implies (bvecp x 1)
+           (equal (bitn x 0) x)))
+
+;rename
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+                  (natp n))
+	     (equal (bitn x n) 1)))
+
+;handle the case where we don't go down to 0?
+(defthm bits-bitn
+  (implies (and (case-split (integerp i))
+                (case-split (<= 0 i))
+                )
+  (equal (bits (bitn x n) i 0)
+         (bitn x n))))
+
+(defthmd bitn-neg
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n) 0)))
+
+(defun all-bits-p (b k)
+  (if (zp k)
+      t
+    (and (or (= (nth (1- k) b) 0)
+	     (= (nth (1- k) b) 1))
+	 (all-bits-p b (1- k)))))
+
+(defun sum-b (b k)
+  (if (zp k)
+      0
+    (+ (* (expt 2 (1- k)) (nth (1- k) b))
+       (sum-b b (1- k)))))
+
+(defthmd sum-bitn
+  (implies (and (natp n)
+		(all-bits-p b n)
+	        (natp k)
+		(< k n))
+           (equal (bitn (sum-b b n) k)
+	          (nth k b))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bits-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/bits-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bits-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bits-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1835 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "ground-zero")
+(include-book "../../arithmetic/negative-syntaxp")
+(include-book "../../arithmetic/power2p")
+
+(local (include-book "../../arithmetic/top"))
+(local (include-book "bvecp"))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+
+;this book is still a mess
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+#|
+
+The new version of bits is like Russinoff's "bits" but uses mod instead of rem.
+The use of "mod" seems to allow nicer results to be proved.
+
+For example, bits now *always* returns a non-negative integer.  Many hyps of other lemmas require
+expressions to be non-negative integers, and with the old bits, this requires further checking of the
+arguments (at worst, checking all the way to the leaves of the expression tree each time).
+
+Add case-split to all hyps about i and j (indices to bits must be integers and j must be <= i or else weird
+stuff may happen (but we can easily handle these cases).
+
+|#
+
+;In proofs about RTL terms, i and j should always be natural number constants
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :hints (("Goal" :in-theory (enable bits)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription bits)))
+
+;dup with bits-0!
+(defthm bits-with-x-0
+  (equal (bits 0 i j)
+         0)
+  :hints (("Goal" :in-theory (enable bits))))
+
+(defthm bits-with-i-not-an-integer
+  (implies (not (integerp i))
+           (equal (bits x i j)
+                  0))
+  :hints (("Goal" :in-theory (enable bits))))
+
+(defthm bits-with-j-not-an-integer
+  (implies (not (integerp j))
+           (equal (bits x i j)
+                  0))
+  :hints (("Goal" :in-theory (enable bits))))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+           (equal (bits x i j)
+                  0))
+  :hints (("Goal" :in-theory (enable bits))))
+
+(defthm bits-upper-bound
+  (< (bits x i j) (expt 2 (+ 1 i (- j))))
+  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j))))
+  :hints (("Goal" :in-theory (enable bits 
+                                     expt-minus
+                                     expt-split))))
+
+;has the right pattern to rewrite stuff like this: (<= (EXPT 2 J) (BITS Y (+ -1 J) 0)) to nil
+(defthm bits-upper-bound-special
+  (< (BITS x (1- i) 0) (EXPT 2 i))
+  :hints (("Goal" :use (:instance bits-upper-bound (i (1- i)) (j 0))))
+  )
+
+;tigher bound
+(defthm bits-upper-bound-tighter
+  (implies (case-split (<= j i))
+           (<= (bits x i j) (1- (expt 2 (+ i 1 (- j))))))
+  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j))))
+  :hints (("Goal" :cases ((rationalp x) (not (acl2-numberp x)))
+           :in-theory (enable bits 
+                              expt-minus
+                              expt-split))))
+
+  
+;like  mod-upper-bound-3
+(defthm bits-upper-bound-2
+  (implies (and (<= (expt 2 (+ 1 i (- j))) z) ;backchain-limit?
+                ;(case-split (integerp i))
+                ;(case-split (integerp j))
+                )
+           (< (bits x i j) z)))
+
+
+
+#|
+;I have many theorems dealing with the simplification of bits of a sum
+
+(include-book
+ "lowbits")
+
+
+;taking sort of a long time (3-4 secs)
+(defthm bits-sum-lowbits
+  (implies (and (rationalp x)
+                (rationalp y)
+                (integerp i)
+                (integerp j))
+           (equal (bits (+ x             y) i j)
+                  (bits (+ (lowbits x i) y) i j)))
+  :hints (("Goal" :in-theory (enable ;mod-cancel
+                              bits
+                              lowbits))))
+(in-theory (disable bits-sum-lowbits))
+
+;special case of the above -- helps rewrite the constant to a unique (positive) value
+;make another rule to handle negative constants
+(defthm bits-sum-reduce-leading-constant
+  (implies (and (syntaxp (and (quotep x) (>= (cadr x) (expt 2 (+ (cadr i) 1)))))
+                (rationalp x)
+                (rationalp y)
+                (integerp i)
+                (integerp j))
+           (equal (bits (+ x             y) i j)
+                  (bits (+ (lowbits x i) y) i j)))
+  :hints (("Goal" :use bits-sum-lowbits )))
+
+(defun oldbits (x i j)
+  (fl (/ (rem x (expt 2 (1+ i))) (expt 2 j))))
+
+(in-theory (disable bits)) ;move up
+
+;(in-theory (disable INTEGER-HAS-DENOM-1-OTHER-WAY))
+
+(in-theory (disable rem))
+
+
+|#
+
+;a is a free var
+(defthm bits-force
+  (implies (and (<= (* a (expt 2 (+ i 1))) x)
+                (< x (* (1+ a) (expt 2 (+ i 1))))
+                (integerp x)
+                (integerp i)
+;                (<= 0 i)
+                (integerp a)
+                )
+           (equal (bits x i 0) (- x (* a (expt 2 (+ i 1))))))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (enable bits)
+           :use (:instance  mod-force-eric (y (expt 2 (+ i 1)))))))
+
+(defthm bits-force-with-a-chosen-neg
+  (implies (and (< x 0)
+                (<= (* -1 (expt 2 (+ i 1))) x)
+;                (<= 0 i)
+                (integerp x)
+                (integerp i)
+                )
+           (equal (bits x i 0) (- x (* -1 (expt 2 (+ i 1))))))
+  :hints (("Goal" 
+           :use (:instance bits-force (a -1)))))
+                                      
+;remove:?
+;(in-theory (disable bits-force))
+
+;expensive?
+;make a corollary?
+(defthm bits-shift
+  (implies (and ;(rationalp x)
+            (case-split (integerp n))
+            (case-split (integerp i))
+            (case-split (integerp j))
+            )
+           (and (equal (bits (* (expt 2 n) x) i j)
+                       (bits x (- i n) (- j n)))
+                (equal (bits (* x (expt 2 n)) i j)
+                       (bits x (- i n) (- j n)))))
+  :hints (("Goal" :cases ((and (acl2-numberp n) (not (rationalp n)))
+                          (and (rationalp n) (not (integerp n)))
+                          (integerp n))
+           :in-theory (e/d (expt-minus
+                              mod-cancel
+                              bits 
+                              expt-split
+                            
+                              )
+                           (  ;these are disabled to speed up he proof:
+                            INTEGERP-PROD-OF-3-FIRST-AND-LAST
+                              INTEGERP-PROD-OF-3-LAST-TWO
+                              a10
+                              a13)))))
+
+; Basically a restatement of bits-shift:
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :hints (("Goal" :use ((:instance bits-shift (n k)))))
+  :rule-classes ())
+
+#| original:
+(defthm bits-shift
+  (implies (and ;(rationalp x)
+            (case-split (integerp n))
+            (case-split (integerp i))
+            (case-split (integerp j))
+            )
+           (and (equal (bits (* (expt 2 n) x) i j)
+                       (bits x (- i n) (- j n)))
+                (equal (bits (* x (expt 2 n)) i j)
+                       (bits x (- i n) (- j n)))))
+  :hints (("Goal" :cases ((and (acl2-numberp n) (not (rationalp n)))
+                          (and (rationalp n) (not (integerp n)))
+                          (integerp n))
+           :in-theory (enable expt-minus
+                              mod-cancel
+                              bits 
+                              expt-split))))
+|#
+
+(local (in-theory (enable mod-cancel)))
+  
+;allows you to split bit vectors into two parts
+;free var n (where to split)
+;resembles doc's bits-plus-bits-1 and another rule in merge
+(defthm bits-plus-bits2
+  (implies (and ;(rationalp x)
+                (integerp i) 
+                (integerp j)
+                (integerp n)
+                (<= j n)
+                (<= n i)
+                )
+           (equal (bits x i j)
+                  (+ (* (bits x i n) (expt 2 (- n j)))
+                     (bits x (1- n) j))))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (enable bits mod expt-split expt-minus))))
+
+;a hint that worked for this before I made such nice rules is in junk.lisp under bits-plus-bits-hint
+
+;(in-theory (disable bits-plus-bits-1)) ;keep disabled
+
+
+#|
+;use mbitn?
+;could use even-odd phrasing?
+(defthm bits-down-to-1-case-split
+  (implies (and (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 1 i))
+           (equal (bits x i 1)
+                  (if (equal (bitn x 0) 0)
+                      (/ (bits x i 0) 2) ;use the fact that we know bit 0 is 0?
+                    (/ (1- (bits x i 0)) 2) ;use the fact that we know bit 0 is 1?
+                    )))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable bits mod bitn))))
+|#
+
+;this really has two separate cases
+;generalize with j not 0?
+(defthm bits-split-around-zero
+  (implies (and (>= x (- (expt 2 (+ i 1))))
+                (< x (expt 2 (+ i 1)))
+                (integerp x)
+                (case-split (integerp i))
+                (case-split (<= 0 i))
+                )
+           (equal (bits x i 0)
+                  (if (<= 0 x)
+                      x
+                    (+ x (expt 2 (+ i 1))))))
+ :hints (("Goal" :in-theory (enable bits)
+          :use ((:instance bits-force (a 0))
+                (:instance bits-force (a -1))))))
+
+
+;(local (in-theory (disable expt-inverse)))
+
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k))
+  :hints (("Goal" :in-theory (enable 
+                              bvecp))))
+
+
+
+(defthm bits-bvecp
+  (implies (and (<= (+ 1 i (- j)) k)
+                (case-split (integerp k))
+                )
+           (bvecp (bits x i j) k))
+  :hints (("Goal" :use ((:instance bits-bvecp-simple
+                                   (k (+ 1 i (* -1 j)))))
+           :in-theory (disable bits-bvecp-simple))))
+
+(in-theory (disable bits-bvecp-simple))
+
+;do we want this rule enabled?
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j)) ; note equal here to help with the fw chaining
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+
+;these may be made moot by my method of using lowbits with bits of a sum
+
+#|
+(defthm bits-sum-simplify-first-term
+  (implies (and (>= (abs x) (expt 2 (+ j 1))) ;prevents loop
+                (rationalp x)
+                (rationalp y)
+                (integerp j)
+                (<= 0 j)
+                )
+           (equal (bits (+ x y) j 0)
+                  (bits (+ (lowbits x j) y) j 0)))
+  :hints (("Goal" :in-theory (enable lowbits
+                                     bits))))
+
+(defthm bits-sum-simplify-second-term
+  (implies (and (>= (abs x) (expt 2 (+ j 1))) ;prevents loop
+                (rationalp x)
+                (rationalp y)
+                (integerp j)
+                (<= 0 j)
+                )
+           (equal (bits (+ y x) j 0)
+                  (bits (+ (lowbits x j) y) j 0)))
+  :hints (("Goal" :in-theory (enable lowbits
+                                     bits))))
+
+|#
+
+
+(local (in-theory (disable mod-cancel)))
+
+;better names: make the dropped term x, the others a,b,c,...
+;;; more bits thms like this!
+
+(defthm bits-sum-drop-irrelevant-term-2-of-2
+  (implies (integerp (/ y (expt 2 (+ 1 i))))
+           (equal (bits (+ x y) i j)
+                  (bits x i j)))
+  :hints (("Goal" :cases ((rationalp y) (not (acl2-numberp y)))
+           :in-theory (enable bits))))
+
+(defthm bits-sum-drop-irrelevant-term-1-of-2
+  (implies (integerp (/ y (expt 2 (+ 1 i))))
+           (equal (bits (+ y x) i j)
+                  (bits x i j)))
+  :hints (("Goal"  :cases ((rationalp y) (not (acl2-numberp y)))
+           :in-theory (enable bits))))
+
+(defthm bits-sum-drop-irrelevant-term-3-of-3
+  (implies (integerp (/ y (expt 2 (+ 1 i))))
+           (equal (bits (+ w x y) i j)
+                  (bits (+ w x) i j)))
+  :hints (("Goal" :in-theory (disable bits-sum-drop-irrelevant-term-1-of-2
+                                      bits-sum-drop-irrelevant-term-2-of-2)
+           :use (:instance bits-sum-drop-irrelevant-term-1-of-2 (x (+ w x))))))
+
+(defthm bits-sum-drop-irrelevant-term-2-of-3
+  (implies (integerp (/ y (expt 2 (+ 1 i))))
+           (equal (bits (+ w y x) i j)
+                  (bits (+ w x) i j)))
+  :hints (("Goal" :in-theory (disable bits-sum-drop-irrelevant-term-3-of-3
+                                      bits-sum-drop-irrelevant-term-1-of-2
+                                      bits-sum-drop-irrelevant-term-2-of-2)
+           :use (:instance bits-sum-drop-irrelevant-term-1-of-2 (x (+ w x))))))
+#|
+(defthm bits-sum-drop-irrelevant-term-1-of-3
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp w)
+
+                (integerp i)
+                (<= 0 i)
+                (integerp j)
+                (<= 0 j)
+
+                (integerp (/ y (expt 2 (+ 1 i))))
+                )
+           (equal (bits (+ y w x) i j)
+                  (bits (+ w x) i j)))
+  :hints (("Goal" :in-theory (disable bits-sum-drop-irrelevant-term-2-of-3
+                                      bits-sum-drop-irrelevant-term-3-of-3
+                                      bits-sum-drop-irrelevant-term-1-of-2
+                                      bits-sum-drop-irrelevant-term-2-of-2)
+           :use (:instance bits-sum-drop-irrelevant-term-1-of-2 (x (+ w x))))))
+|#
+
+
+#|
+
+This series of events deals with simplifying expressions like
+(equal (bits x 8 0) 
+       (+ (bits x 6 0) k))
+Intuitively, bits 6 down-to 0 appear on both sides of the sum and should be "cancelled".  
+The remaining bits will need to be "shifted" back into place.
+
+More rules are probably needed to make the theory complete.
+|#
+
+#|
+(defthm bits-cancel-lowbits-in-comparison
+  (implies (and (> i+ i)
+                (rationalp k)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                )
+           (equal (equal (+ k (bits x i j))
+                         (bits x i+ j))
+                  (equal (* (expt 2 (+ 1 i (- j))) 
+                            (BITS X I+ (+ 1 I))) 
+                         k)))
+  :hints (("Goal"          
+           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
+           :in-theory (enable expt-split)
+           )))
+
+(defthm bits-cancel-lowbits-in-comparison-alt-2
+  (implies (and (> i+ i)
+                (rationalp k)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                )
+           (equal (equal (+ (bits x i j) k)
+                         (bits x i+ j))
+                  (equal (* (expt 2 (+ 1 i (- j))) 
+                            (BITS X I+ (+ 1 I))) 
+                         k)))
+  :hints (("Goal"          
+           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
+           :in-theory (enable expt-split)
+           )))
+|#
+
+#|
+;todo: rephrase the conclusion of the above by moving the "constant" (* 2 (EXPT 2 I) (/ (EXPT 2 J))) to the other
+;side
+;a good idea since k is usually divisible by that quantity (with the rule above, we often end up with an
+equality in which each side should have a power of 2 divided out of it
+; not needed if we have good meta rules for cancelling factors from an inequality
+
+
+(defthm bits-cancel-lowbits-in-comparison-2
+  (implies (and (> i+ i)
+                (rationalp k)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+
+                )
+           (equal (equal (+ k (bits x i j))
+                         (bits x i+ j))
+                  (equal (*  
+                            (BITS X I+ (+ 1 I))) 
+                         (/ k (expt 2 (+ 1 i (- j)))))))
+  :hints (("Goal"          
+           :use (:instance bits-cancel-lowbits-in-comparison)
+           :in-theory (set-difference-theories
+                       (enable expt-split)
+                       '(bits-cancel-lowbits-in-comparison))
+           )))
+|#
+
+#|
+
+(defthm bits-cancel-lowbits-in-comparison-3
+  (implies (and (> i+ i)
+                (rationalp k)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                (rationalp y)
+                )
+           (equal (equal (+ (bits x i+ j) k)
+                         (+ y (bits x i j)))
+                  (equal (* (expt 2 (+ 1 i (- j )))
+                            (BITS X I+ (+ 1 I))) 
+                         (- y k))))
+  :hints (("Goal"          
+           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
+           :in-theory (set-difference-theories
+                       (enable expt-split)
+                       '(
+                         BITS-CANCEL-LOWBITS-IN-COMPARISON-ALT-2))
+           )))
+
+;better conclusion?
+(defthm bits-cancel-lowbits-in-comparison-no-constant
+  (implies (and (> i+ i)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                )
+           (equal (equal (bits x i j)
+                         (bits x i+ j))
+                  (equal (* 2 (EXPT 2 I)
+                           (/ (EXPT 2 J))
+                           (BITS X I+ (+ 1 I))) 
+                         0)))
+  :hints (("Goal"          
+           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
+           :in-theory (set-difference-theories
+                       (enable expt-split)
+                       '( BITS-CANCEL-LOWBITS-IN-COMPARISON-ALT-2
+                          ))
+           )))
+
+(defthm bits-cancel-lowbits-in-comparison-no-constant-2
+  (implies (and (> i+ i)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                )
+           (equal (equal (bits x i+ j)
+                         (bits x i j))
+                  (equal (* 2 (EXPT 2 I)
+                           (/ (EXPT 2 J))
+                           (BITS X I+ (+ 1 I))) 
+                         0)))
+  :hints (("Goal"          
+           :use (:instance bits-plus-bits-1 (n (+ i 1)) (i i+))
+           :in-theory (set-difference-theories
+                       (enable expt-split)
+                       '( BITS-CANCEL-LOWBITS-IN-COMPARISON-ALT-2
+))
+           )))
+
+;the theory above (cancelling bits in comparisons) is not complete
+;it should also deal with bitn
+;perhaps a bind-free rule would be a good idea here?
+
+|#
+
+
+;kind of yucky...
+(defthm bits-minus
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (<= j i))
+                (case-split (integerp j))
+                )
+           (equal (bits (* -1 x) i j)
+                  (if (integerp (* 1/2 x (/ (expt 2 i))))
+                      0
+                    (if (integerp (* x (/ (expt 2 j))))
+                        (+ (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))
+                      (+ -1 (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))))))
+  :hints (("goal" :in-theory (enable mod-mult-of-n
+                                     bits
+                                     expt-split)))
+  )
+
+
+
+
+
+;expensive?
+(defthm bits-minus-alt
+  (implies (and (syntaxp (negative-syntaxp x))
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (<= j i))
+                (case-split (integerp j))
+                )
+           (equal (bits x i j)
+                  (if (integerp (* 1/2 (- X) (/ (EXPT 2 I))))
+                    0
+                    (if (INTEGERP (* (- X) (/ (EXPT 2 J))))
+                        (+ (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j)))
+                      (+ -1 (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j)))))))
+  :hints (("Goal" :in-theory (disable bits-minus)
+           :use (:instance bits-minus (x (- x)))))
+  )
+
+
+
+
+#|
+(defthm bits-shift-alt
+  (implies (and (syntaxp (should-have-a-2-factor-divided-out x))
+                (> j 0) ;restricts application 
+                (rationalp x)
+;                (integerp n)
+                (integerp i)
+                (integerp j)
+                )
+           (equal (bits x i j)
+                  (bits (/ x 2) (- i 1) (- j 1))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bits)
+                              '(bits-shift))
+           :use (:instance bits-shift (x (/ x 2)) (n 1)))))
+
+|#
+
+
+;drops hyps like this: (<= (BITS x 30 24) 253)
+;Recall that <= gets rewritten to < during proofs
+(defthm bits-drop-silly-upper-bound
+  (implies (and (syntaxp (quotep k))
+                (>= k (1- (expt 2 (+ 1 i (- j)))))
+                (case-split (<= j i))
+;                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+;                (case-split (rationalp k))
+                )
+           (equal (< k (bits x i j))
+                  nil)))
+
+;rewrite things like (<= 4096 (BITS x 23 12)) to false
+;Recall that <= gets rewritten to < during proofs
+(defthm bits-drop-silly-lower-bound
+  (implies (and (syntaxp (quotep k))
+                (> k (1- (expt 2 (+ 1 i (- j)))))
+                (case-split (<= j i))
+;                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+;                (case-split (rationalp k))
+                )
+  (equal (< (bits x i j) k)
+         t)))
+
+;rewrite (< -64 (BITS <signal> 64 59)) to t
+(defthm bits-drop-silly-bound-3
+  (implies (and (syntaxp (quotep k))
+                (< k 0)
+                )
+  (equal (< k (bits x i j))
+         t)))
+
+(defthm bits-drop-silly-bound-4
+  (implies (and (syntaxp (quotep k))
+                (<= k 0)
+                )
+  (equal (< (bits x i j) k)
+         nil)))
+
+(defthm bits-<-1
+  (equal (< (bits x i j) 1)
+         (equal (bits x i j) 0)))
+
+;put bits-cancel- in the name?
+(defthm bits-at-least-zeros
+  (implies (and (syntaxp (quotep k))
+                (equal k (expt 2 (- j2 j)))
+                (<= j j2)
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp j2))
+                )
+  (equal (< (BITS x i j)
+             (* k (BITS x i j2)))
+         nil))
+  :hints (("Goal" :use (:instance bits-plus-bits2 (n j2)))))
+
+(defthm bits-upper-with-subrange
+  (implies (and (syntaxp (quotep k))
+                (<= j j2)
+                (equal k (expt 2 (- j2 j)))
+                (case-split (<= j2 i)) ;drop?
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp j2))
+                )
+           (< (BITS x i j) 
+              (BINARY-+ k (BINARY-* k (BITS x i j2)))))
+  :hints (("Goal" :use (:instance bits-plus-bits2 (j j) (n j2)))))
+
+(defthm bits-upper-with-subrange-alt
+  (implies (and (syntaxp (quotep k))
+                (<= j j2)
+                (equal k (expt 2 (- j2 j)))
+                (case-split (<= j2 i)) ;drop?
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp j2))
+                )
+           (equal (< (BINARY-+ k (BINARY-* k (BITS x i j2))) 
+                     (BITS x i j))
+                  nil))
+  :hints (("Goal" :use (:instance bits-plus-bits2 (j j) (n j2)))))
+
+
+;make another version for k negative?
+(defthm bits-equal-impossible-constant
+  (implies (and (syntaxp (quotep k))
+                (<= (expt 2 (+ 1 i (- j))) k)
+                )
+           (not (equal (bits x i j) k))))
+
+
+
+
+#|
+;degenerate case
+;rename?
+;expensive
+(defthm bits-sum-drop-irrelevant-term-1-of-1
+  (implies (and (rationalp x) ;(integerp x)
+
+                (integerp i)
+                (<= 0 i)
+                (integerp j)
+                (<= 0 j)
+
+                (integerp (/ x (expt 2 (+ 1 i))))
+                )
+           (equal (bits x i j)
+                  0))
+  :hints (("Goal" :in-theory (enable bits bits)))
+  :rule-classes ((:rewrite :backchain-limit-lst (nil nil nil nil nil 1)))
+)
+|#
+
+(defthm bits-with-x-not-rational
+  (implies (not (rationalp x))
+           (equal (bits x i j)
+                  0))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bits)
+                              '( ;REARRANGE-FRACTIONAL-COEFS-<
+                                )))))
+
+
+
+(defthm bits-compare-to-zero
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (not (< 0 (bits x i j)))
+                  (equal 0 (bits x i j)))))
+
+;expensive?
+
+(encapsulate
+ ()
+
+ (defthmd bits-ignore-negative-bits-of-integer-main-case
+   (implies (and (<= j 0)
+                 (integerp x) 
+                 (case-split (integerp j))
+                 (case-split (<= j i))
+                 )
+            (equal (bits x i j)
+                   (* (expt 2 (- j)) (bits x i 0))))
+   :hints (("Goal" :cases ((<= j i))
+            :in-theory (enable bits)))
+   )
+
+ (defthm bits-ignore-negative-bits-of-integer
+   (implies (and (and (syntaxp (not (and (quotep j) (equal 0 (cadr j)))))) ;prevents loops
+                 (<= j 0)
+                 (integerp x)
+                 (case-split (integerp j))
+                 )
+            (equal (bits x i j)
+                   (* (expt 2 (- j)) (bits x i 0))))
+   :hints (("Goal"; :cases ((<= j i))
+            :use bits-ignore-negative-bits-of-integer-main-case
+            :in-theory (enable)))
+   )
+ )
+
+
+;disable since it can be bad to leave "naked" signals?
+(defthmd bits-does-nothing-2
+  (implies (and (<= j 0) ;a bit strange (j will usually be zero?)
+                (bvecp x (+ i 1)) ;expand?
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits x i j)
+                  (* (expt 2 (- j)) x)))
+  :hints (("Goal" :cases ((<= j 0))
+           :in-theory (enable bits bvecp))))
+
+
+
+
+
+
+#|
+;(include-book "factor-out")
+
+(defthm bits-shift-better
+  (implies (and (bind-free (can-take-out-numeric-power-of-2 x) (c))
+                (force (power2p c))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits x i j)
+                  (bits (/ x c) (- i (expo c)) (- j (expo c)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable power2p)
+                              '(bits-shift))
+           :use  (:instance bits-shift 
+                           (x (/ x c))
+                           (n (expo c))
+                           ))))
+
+|#
+
+
+
+
+(defthm bits-does-nothing
+  (implies (and (bvecp x (1+ i))
+                (case-split (integerp i))
+;                (case-split (integerp j))
+                )
+           (equal (bits x i 0)
+                  x))
+  :hints (("Goal" :in-theory (enable bits-does-nothing-2)
+           :cases ((<= i -1))))
+  )
+
+(in-theory (disable bits-does-nothing))
+
+
+
+(defthm bits-with-bad-index-2
+  (IMPLIES (NOT (INTEGERP i))
+           (EQUAL (BITS x (1- i) 0)
+                  0))
+  :hints (("Goal" :in-theory (enable bits))))
+
+(local (defthm bvecp-bits-0-aux
+   (implies (and (case-split (natp i)) ;(natp i)
+                 (case-split (<= j i))
+                 (bvecp x j))
+            (equal (bits x i j) 0))
+   :hints (("Goal" :in-theory (enable bits bvecp)
+            :use (;(:instance mod-equal (m x) (n (expt 2 (1+ i))))
+                  (:instance expt-weak-monotone (n j) (m (1+ i))))))))
+
+(defthmd bvecp-bits-0
+   (implies (bvecp x j)
+            (equal (bits x i j) 0))
+   :hints (("Goal" :cases ((< i j))
+            :in-theory (set-difference-theories
+                        (enable natp)
+                        '( bvecp )))))
+
+;add case-split to hyps?
+(local
+ (defthm bits-drop-from-minus-original
+   (implies (and (<= y x)
+                 (bvecp x n)
+                 (bvecp y n)
+                 )
+            (equal (bits (+ x (* -1 y)) (1- n) 0)
+                   (+ x (* -1 y))
+                   ))
+   :hints (("Goal" :cases ((integerp n))
+            :in-theory (enable bvecp)))
+   ))
+
+;add case-split to hyps?
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y))))
+  :hints (("Goal" :use ((:instance bits-drop-from-minus-original
+                                   (n (1+ i))))
+           :in-theory (disable bits-drop-from-minus-original))))
+
+(defthm bits-tail
+   (implies (and (bvecp x (1+ i))
+                 (case-split (acl2-numberp i)))
+            (equal (bits x i 0)
+                   x))
+   :hints (("Goal" :in-theory (enable bvecp bits-does-nothing))))
+
+(defthm bits-tail-special
+   (implies (bvecp x i)
+            (equal (bits x (1- i) 0)
+                   x))
+   :hints (("Goal" :cases ((acl2-numberp i)))))
+
+
+#|
+
+comments from bits.lisp (these may duplicate comments in this book)
+
+;why have this?
+(defthm bits-shift-out-even
+  (implies (and (integerp x)
+                (evenp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x i j)
+                  (bits (/ x 2) (- i 1) (- j 1) )))
+  :hints (("Goal" :in-theory (enable expt-minus
+                                     bits 
+                                     mod-cancel 
+                                     expt-split-rewrite)))
+  )
+
+
+
+
+;could use even-odd phrasing?
+(defthm bits-down-to-1-case-split
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp i)
+                (>= i 1))
+           (equal (bits x i 1)
+                  (if (equal (bitn x 0) 0)
+                      (/ (bits x i 0) 2) ;use the fact that we know bit 0 is 0?
+                    (/ (1- (bits x i 0)) 2) ;use the fact that we know bit 0 is 1?
+                    ))))
+
+
+;would like these
+;x<2^n
+(defthm test2
+  (IMPLIES (AND (INTEGERP N) (<= 0 N) (rationalP X) (<= 0 x))
+         (EQUAL (FLOOR (* 1/2 x) 1)
+                (FLOOR (* 1/2 (FLOOR x 1))
+                       1)))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable floor))))
+
+  :otf-flg t
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable fl)
+                              '())))
+)
+
+
+(defthm test
+  (IMPLIES (AND (INTEGERP N) (<= 0 N) (INTEGERP X))
+         (EQUAL (FL (* 1/2 X (/ (EXPT 2 N))))
+                (FL (* 1/2 (FL (* X (/ (EXPT 2 N))))))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable fl)
+                              '()))))
+)
+
+
+;these may be made moot by my method of using lowbits with bits of a sum
+
+(defthm bits-sum-simplify-first-term
+  (implies (and (>= (abs x) (expt 2 (+ j 1))) ;prevents loop
+                (rationalp x)
+                (rationalp y)
+                (integerp j)
+                (<= 0 j)
+                )
+           (equal (bits (+ x y) j 0)
+                  (bits (+ (lowbits x j) y) j 0))))
+
+(defthm bits-sum-simplify-second-term
+  (implies (and (>= (abs x) (expt 2 (+ j 1))) ;prevents loop
+                (rationalp x)
+                (rationalp y)
+                (integerp j)
+                (<= 0 j)
+                )
+           (equal (bits (+ y x) j 0)
+                  (bits (+ (lowbits x j) y) j 0))))
+
+
+
+
+This series of events deals with simplifying expressions like
+(equal (bits x 8 0) 
+       (+ (bits x 6 0) k))
+Intuitively, bits 6 down-to 0 appear on both sides of the sum and should be "cancelled".  
+The remaining bits will need to be "shifted" back into place.
+
+More rules are probably needed to make the theory complete.
+
+
+(defthm bits-cancel-lowbits-in-comparison
+  (implies (and (> i+ i)
+                (rationalp k)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                )
+           (equal (equal (+ k (bits x i j))
+                         (bits x i+ j))
+                  (equal (* (expt 2 (+ 1 i (- j))) 
+                            (BITS X I+ (+ 1 I))) 
+                         k))))
+
+(defthm bits-cancel-lowbits-in-comparison-alt-2
+  (implies (and (> i+ i)
+                (rationalp k)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                )
+           (equal (equal (+ (bits x i j) k)
+                         (bits x i+ j))
+                  (equal (* (expt 2 (+ 1 i (- j))) 
+                            (BITS X I+ (+ 1 I))) 
+                         k))))
+
+
+
+;todo: rephrase the conclusion of the above by moving the "constant" (* 2 (EXPT 2 I) (/ (EXPT 2 J))) to the other
+;side
+;a good idea since k is usually divisible by that quantity (with the rule above, we often end up with an
+equality in which each side should have a power of 2 divided out of it
+; not needed if we have good meta rules for cancelling factors from an inequality
+
+
+(defthm bits-cancel-lowbits-in-comparison-2
+  (implies (and (> i+ i)
+                (rationalp k)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+
+                )
+           (equal (equal (+ k (bits x i j))
+                         (bits x i+ j))
+                  (equal (*  
+                            (BITS X I+ (+ 1 I))) 
+                         (/ k (expt 2 (+ 1 i (- j))))))))
+
+
+
+
+(defthm bits-cancel-lowbits-in-comparison-3
+  (implies (and (> i+ i)
+                (rationalp k)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                (rationalp y)
+                )
+           (equal (equal (+ (bits x i+ j) k)
+                         (+ y (bits x i j)))
+                  (equal (* (expt 2 (+ 1 i (- j )))
+                            (BITS X I+ (+ 1 I))) 
+                         (- y k)))))
+
+;better conclusion?
+(defthm bits-cancel-lowbits-in-comparison-no-constant
+  (implies (and (> i+ i)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                )
+           (equal (equal (bits x i j)
+                         (bits x i+ j))
+                  (equal (* 2 (EXPT 2 I)
+                           (/ (EXPT 2 J))
+                           (BITS X I+ (+ 1 I))) 
+                         0))))
+
+(defthm bits-cancel-lowbits-in-comparison-no-constant-2
+  (implies (and (> i+ i)
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                (<= j i)
+                (integerp i+)
+                )
+           (equal (equal (bits x i+ j)
+                         (bits x i j))
+                  (equal (* 2 (EXPT 2 I)
+                           (/ (EXPT 2 J))
+                           (BITS X I+ (+ 1 I))) 
+                         0))))
+;the theory above (cancelling bits in comparisons) is not complete
+;it should also deal with bitn
+;perhaps a meta rule would be a good idea here?
+
+
+(defthm bits-shift-alt
+  (implies (and (syntaxp (should-have-a-2-factor-divided-out x))
+                (> j 0) ;restricts application 
+                (rationalp x)
+                (integerp i)
+                (integerp j)
+                )
+           (equal (bits x i j)
+                  (bits (/ x 2) (- i 1) (- j 1)))))
+
+(defthm bits-turn-bound-into-equal
+  (implies (and (syntaxp (quotep k))
+                (equal k (+ -2 (expt 2 (+ 1 i (- j)))))
+                (case-split (<= j i))
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (rationalp k))
+                )
+           (equal (< k (bits x i j))
+                  (equal (bits x i j) (+ k 1))))
+  :hints (("Goal" :in-theory (disable  bits-upper-bound-tighter
+                                        bits-upper-bound
+                                         bits-upper-bound-2)
+           :use  bits-upper-bound-tighter))
+)
+
+
+
+
+
+
+
+;(in-theory (disable nbits-shift-out-even))
+
+
+;...
+
+
+;degenerate case
+;rename?
+;expensive
+(defthm bits-sum-drop-irrelevant-term-1-of-1
+  (implies (and (rationalp x) ;(integerp x)
+
+                (integerp i)
+                (<= 0 i)
+                (integerp j)
+                (<= 0 j)
+
+                (integerp (/ x (expt 2 (+ 1 i))))
+                )
+           (equal (bits x i j)
+                  0))
+  :hints (("Goal" :in-theory (enable bits bits)))
+  :rule-classes ((:rewrite :backchain-limit-lst (nil nil nil nil nil 1)))
+)
+
+
+(defthm bits-shift-better
+  (implies (and (bind-free (can-take-out-numeric-power-of-2 x) (c))
+                (force (power2p c))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits x i j)
+                  (bits (/ x c) (- i (expo c)) (- j (expo c))))))
+
+;high bits don't matter - add syntaxp hyp that one addend is a constant with high bits still present
+;huh?
+
+
+|#
+
+
+;It may be easier to reason about bits if we use this rule instead of expanding/enabling bits.
+(defthmd bits-alt-def
+  (equal (bits x i j)
+         (if (or (not (integerp i))
+                 (not (integerp j)))
+             0
+           (mod (fl (/ x (expt 2 j))) (expt 2 (+ 1 i (- j))))))
+  :hints (("Goal" :in-theory (enable bits))))
+
+
+
+
+
+
+(defthm bits-bvecp-simple-2
+  (bvecp (bits x (1- i) 0) i)
+  :hints (("Goal" :cases ((acl2-numberp i)))))
+
+
+;Follows from BITS-SUM-DROP-IRRELEVANT-TERM-2-OF-2.
+;change param names
+(defthmd bits-plus-mult-2
+   (implies (and (< n k)
+                 (integerp y)
+                 (integerp k)
+                 )
+            (equal (bits (+ x (* y (expt 2 k))) n m)
+                   (bits x n m)))
+   :hints (("Goal" :cases ((integerp n))))) ;why cases hint needed?
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m)))
+    :hints (("Goal" :use ((:instance bits-plus-mult-2
+                                     (x x)
+                                     (y (/ c (expt 2 (1+ n))))
+                                     (k (1+ n))
+                                     (n n)))
+             :in-theory (enable mod))))
+
+(defthm bits-plus-bits
+   (implies (and (integerp m)
+                 (integerp p)
+                 (integerp n)
+                 (<= m p)
+                 (<= p n))
+            (= (bits x n m)
+               (+ (bits x (1- p) m)
+                  (* (expt 2 (- p m)) (bits x n p)))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance bits-plus-bits2 (i n) (j m) (n p))))))
+
+(defthm bits-less-than-x
+  (implies (<= 0 x)
+	   (<= (bits x i 0) x))
+  :rule-classes (:rewrite :linear)
+  :hints (("goal" :in-theory (enable bits))))
+
+(defthm bits-less-than-x-gen
+  (implies (and (<= 0 x)
+                (case-split (<= 0 j))
+                (case-split (not (complex-rationalp x)))
+                )
+	   (<= (bits x i j) x))
+  :rule-classes (:rewrite :linear)
+  :hints (("goal" :in-theory (enable bits x-times-something>=1))))
+
+(defthm bits-bvecp-when-x-is	
+  (implies (and (bvecp x k)	
+                (case-split (<= 0 j))
+                )
+           (bvecp (bits x i j) k))
+  :hints (("Goal" :in-theory (enable  bvecp))))
+
+(defthmd bits-bits-1
+  (implies (and (<= k (- i j))
+                (case-split (<= 0 l))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (bits (bits x i j) k l)
+                  (bits x (+ k j) (+ l j))))
+  :hints (("Goal" :in-theory (enable bits expt-split))))
+
+(defthmd bits-bits-2
+  (implies (and (> k (- i j))
+                (case-split (<= 0 l))
+;                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (bits (bits x i j) k l)
+                  (bits x i (+ l j))))
+  :hints (("Goal" :in-theory (enable bits expt-split))))
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (bits (bits x i j) k l)
+                  (if (<= k (- i j))
+                      (bits x (+ k j) (+ l j))
+                    (bits x i (+ l j)))))
+:hints (("Goal" :in-theory (enable bits-bits-1 bits-bits-2))))
+
+
+;The following trivial corollary of bits-bits is worth keeping enabled.
+
+(defthm bits-bits-constants
+  (implies (and (syntaxp (quotep i))
+                (syntaxp (quotep j))
+                (syntaxp (quotep k))
+                (<= 0 l)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (integerp l))
+           (equal (bits (bits x i j) k l)
+                  (if (<= k (- i j))
+                      (bits x (+ k j) (+ l j))
+                    (bits x i (+ l j))))))
+
+
+(defthm bits-reduce
+  (implies (and (< x (expt 2 (+ 1 i)))
+                (case-split (integerp x))
+                (case-split (<= 0 x))
+                (case-split (integerp i))
+                )
+           (equal (bits x i 0) x)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 0))
+
+
+
+
+
+;could prove a version where we drop bits from both args?
+(defthm bits-sum-drop-bits-around-arg-2
+  (implies (and (<= i i+)
+                (integerp y)
+                (case-split (integerp i+))
+                )
+           (equal (bits (+ x (bits y i+ 0)) i j)
+                  (bits (+ x y) i j)))
+  :hints (("Goal" :in-theory (enable bits))))
+
+;Follows from BITS-SUM-DROP-BITS-AROUND-ARG-2.
+(defthm bits-sum-drop-bits-around-arg-1
+  (implies (and (<= i i+)
+                (integerp x)
+                (case-split (integerp i+))
+                )
+           (equal (bits (+ (bits x i+ 0) y) i j)
+                  (bits (+ x y) i j))))
+
+(defthm bits-sum-drop-bits-around-arg-2-special-case
+  (implies (integerp y) ;case-split?
+           (equal (bits (+ x (bits y i 0)) i j)
+                  (bits (+ x y) i j))))
+
+(defthm bits-sum-drop-bits-around-arg-1-special-case
+  (implies (integerp x) ;case-split?
+           (equal (bits (+ (bits x i 0) y) i j)
+                  (bits (+ x y) i j))))
+
+;rename
+;Follows from BVECP-SUM-OF-BVECPS.
+(defthm bits-sum-1
+  (equal (bits (+ (bits x (1- i) 0)
+                  (bits y (1- i) 0))
+               i ;actually, this could be anything >= i ??
+               0)
+         (+ (bits x (1- i) 0)
+            (bits y (1- i) 0)))
+  :hints (("Goal" :in-theory (enable bits-tail))))
+
+
+;export!! enable?
+;gen?
+(defthmd bits-of-non-integer-special
+  (implies (case-split (not (integerp i)))
+           (equal (BITS X (1- i) 0)
+                  0)))
+
+(local
+ (defthmd bits-fl-helper
+   (implies (and (<= 0 j)
+                 (<= -1 i)
+                 )
+            (equal (bits (fl x) i j)
+                   (bits x i j)))
+   :hints (("Goal" :in-theory (enable bits mod-fl-eric)))))
+
+(defthm bits-fl
+  (implies (<= 0 j)
+           (equal (bits (fl x) i j)
+                  (bits x i j)))
+  :hints (("Goal" :use  bits-fl-helper)))
+
+(defthmd bits-shift-down-eric
+  (implies (and (<= 0 j)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                )
+           (equal (bits (* x (/ (expt 2 k)))
+                        i
+                        j)
+                  (bits x (+ i k) (+ j k))))
+  :hints (("Goal" :in-theory (e/d (expt-minus) (bits-shift))
+           :use (:instance bits-shift (n (- k))))))
+
+(defthmd bits-shift-down-1
+    (implies (and (<= 0 j)
+                  (integerp i)
+		  (integerp j)
+                  (integerp k)
+                  )
+	     (equal (bits (fl (/ x (expt 2 k)))
+			  i
+			  j)
+		    (bits x (+ i k) (+ j k))))
+  :hints (("Goal" :in-theory (enable bits-fl bits-shift-down-eric))))
+
+(local
+ (defthm bits-fl-by-2-helper
+   (implies (and (integerp i)
+                 (<= 0 i) 
+                 )
+            (equal (fl (* 1/2 (bits x i 0))) ;gen 0 to j?
+                   (bits x i 1)))
+   :rule-classes ()
+   :hints (("Goal"  :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)
+            :use ((:instance bits-shift-down-1 (k 1) (i (1- i)) (j 0))
+                  (:instance bits-plus-bits (n i) (m 0) (p 1))
+                  (:instance fl-unique (x (/ (bits x i 0) 2)) (n (bits x i 1))))))))
+;rename?
+(defthmd bits-fl-by-2
+  (equal (fl (* 1/2 (bits x i 0)))
+         (bits x i 1))
+  :hints (("Goal" :use (:instance  bits-fl-by-2-helper))))
+
+(defthm mod-bits-by-2
+  (implies (and (integerp x)
+                (<= 0 i)
+                (integerp i)
+                )
+           (equal (mod (bits x i 0) 2)
+                  (mod x 2)))
+  :hints (("Goal" :in-theory (enable bits))))
+
+
+#|
+
+;BOZO challenge:
+
+(defthm bits-sum-drop-bits-around-arg-2-really-special-case
+  (implies (rationalp y)
+           (equal (bits (+ x (bits y i 0)) i 0)
+                  (bits (+ x y) i 0)))
+  :hints (("Goal" :in-theory (enable bits)))))
+
+(defthm bits-sum-drop-bits-around-arg-1-really-special-case
+  (implies (integerp x)
+           (equal (bits (+ (bits x i 0) y) i 0)
+                  (bits (+ x y) i 0))))
+
+|#
+
+
+(defthm bits-shift-by-constant-power-of-2
+  (implies (and (syntaxp (quotep k))
+                (power2p k)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits (* k x) i j)
+                  (bits x (- i (expo k)) (- j (expo k)))))
+  :hints (("Goal" :in-theory (enable power2p-rewrite))))
+
+
+(defthm bits-shift-second-with-more
+  (implies (and ;(rationalp x)
+            (case-split (integerp n))
+            (case-split (integerp i))
+            (case-split (integerp j))
+            )
+           (equal (bits (* x (expt 2 n) y) i j)
+                  (bits (* x y) (- i n) (- j n))))
+  :hints (("Goal" :in-theory (disable bits-shift)
+           :use (:instance bits-shift (x (* x y))))))
+
+(defthmd bits-times-2
+  (implies (and (acl2-numberp i)
+                (acl2-numberp j)
+                )
+           (equal (bits (* 2 x) i j)
+                  (bits x (1- i) (1- j))))
+  :hints (("Goal" :use ((:instance bits-shift (n 1))))))
+
+(defthmd bits+2**k-2
+  (implies (and (< x (expt 2 k))
+                (<= 0 x)
+                (rationalp x) ;(integerp x)
+                (<= k m)
+                (integerp y)
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp k))
+                )
+           (equal (bits (+ x (* y (expt 2 k))) n m)
+                  (bits y (- n k) (- m k))))
+  :hints (("goal" :in-theory (disable FL-EQUAL-0)
+           :use ((:instance bits-shift-down-1
+                            (x (+ x (* y (expt 2 k))))
+                            (i (- n k))
+                            (j (- m k)))
+                 (:instance fl-unique (x (/ (+ x (* y (expt 2 k))) (expt 2 k))) (n y))))))
+
+(defthm bits+2**k-2-alt
+  (implies (and (< x (expt 2 k))
+                (<= 0 x)
+                (rationalp x) ;(integerp x)
+                (<= k m)
+                (integerp y)
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp k))
+                )
+           (equal (bits (+ x (* (expt 2 k) y)) n m)
+                  (bits y (- n k) (- m k))))
+
+  :hints (("Goal" :in-theory (disable bits+2**k-2)
+           :use (:instance bits+2**k-2))))
+
+;basically the same as bits+2**k-2; drop one?
+;move
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k) ;actually, x need not be an integer...
+                (<= k m)
+                (integerp y)
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp k))
+                )
+           (equal (bits (+ x (* y (expt 2 k))) n m)
+                  (bits y (- n k) (- m k))))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use (bits+2**k-2))))
+
+(defthm bits-mod-0
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp m)
+                (>= m 0)
+                (integerp n)
+                (>= n 0))
+           (iff (= (mod x (expt 2 (+ m n 1))) 0)
+                (and (= (bits x (+ m n) n) 0)
+                     (= (mod x (expt 2 n)) 0))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (e/d (bits expt-split) (BITS-FL)) 
+           :use ((:instance mod-0-0 (m x) (n (expt 2 n)) (p (expt 2 (1+ m))))
+                 (:instance bits-shift-down-1 (k n) (i m) (j 0))))))
+
+;this is silly? just open up bits!
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) (mod y (expt 2 (1+ i))))
+           (= (bits x i j) (bits y i j)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits))))
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j)))
+    :hints (("Goal" :use ((:instance mod-bits-equal
+                                     (x (mod x (expt 2 n)))
+                                     (y x))))))
+
+;not needed?  just expand bits?
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+                (case-split (integerp i)) ;gen?
+                ;(case-split (<= 0 i))
+                )
+           (equal (bits x i 0)
+                  (mod x (expt 2 (1+ i)))))
+  :hints (("Goal" 
+           :cases ((rationalp i) (complex-rationalp i))
+           :in-theory (e/d (bits) ( EXPT-SPLIT)))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0)))
+  :hints (("Goal" :in-theory (enable bits mod-sum))))
+
+;reorder? make rewrite?
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+                (integerp k)
+                (<= 0 k)
+                (integerp i)
+                )
+           (equal (* (expt 2 k) (bits x i 0))
+                  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ()
+;:hints (("Goal" :cases ((equal 0 k))))
+  )
+
+
+;export!
+(defthm bits-expt
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                )
+           (equal (bits (expt 2 k) i j)
+                  (if (or (< i j)
+                          (< k j)
+                          (< i k))
+                      0
+                    (expt 2 (- k j))))
+           )
+  :hints (("Goal" :use (:instance bits-shift (x 1) (n k))))
+  )
+
+(defthm bits-natp
+  (natp (bits x i j)))
+
+
+(defthmd bits-shift-down-eric
+  (implies (and (<= 0 j)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                )
+           (equal (bits (* x (/ (expt 2 k)))
+                        i
+                        j)
+                  (bits x (+ i k) (+ j k))))
+  :hints (("Goal" :use (:instance bits-shift-down-1)))
+  )
+
+;gen the 0?
+(defthm mod-bits
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                (integerp j)
+                (integerp i))
+           (equal (mod (bits x i 0) (expt 2 j))
+                  (bits x (min i (1- j)) 0)))
+  :hints (("Goal" :in-theory (enable bits)))
+  )
+
+(defthm bits-expt-constant
+  (implies (and (syntaxp (and (quotep k) (power2p (cadr k))))
+                (force (power2p k))
+                (case-split (integerp k)) ;gen?
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits k i j)
+                  (if (or (< i j)
+                          (< (expo k) j)
+                          (< i (expo k)))
+                      0
+                    (expt 2 (- (expo k) j)))))
+  :hints (("Goal" :in-theory (enable power2p-rewrite))))
+
+#|
+
+(defthm bits-minus-better-helper-1
+  (implies (and (integerp x)
+                (integerp i))
+           (equal (equal 0 (bits x i 0))
+                  (integerp (* 1/2 x (/ (expt 2 i))))
+                  ))
+  :hints (("Goal" :in-theory (enable expt-split mod-equal-0)
+           :expand  (BITS X I 0)))
+  )
+
+(defthm bits-minus-better-helper-2
+  (implies (and (integerp x)
+                (integerp i))
+           (equal (equal 0 (bits x (1- j) 0))
+                  (integerp (* x (/ (expt 2 j))))
+                  ))
+  :hints (("Goal" :in-theory (enable expt-split mod-equal-0)
+           :expand   (bits x (1- j) 0)))
+  )
+
+;note that although the RHS looks slightly gross, 
+;gen the (integerp x) hyp!!
+(defthm bits-minus-better
+  (implies (and (case-split (integerp x)) ;gen!
+                (case-split (integerp i))
+                (case-split (<= j i)) ;drop?
+                (case-split (integerp j))
+                )
+           (equal (bits (* -1 x) i j)
+                  (if (equal 0 (bits x i 0))
+                      0
+                    (if (equal 0 (bits x (1- j) 0))
+                        (+ (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))
+                      (+ -1 (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))))))
+	:hints (("Goal" :use bits-minus
+	:in-theory (enable mod-does-nothing expt-split mod-cancel)))
+)
+
+|#
+
+
+;Unlike bits-tail, this allows j to be non-zero.
+;Note that the conclusion is (bits x ...), not just x.
+;i is a free variable
+;watch out for loops with this rule
+;BOZO export in lib/ or user/!
+(defthm bits-tighten
+  (implies (and (bvecp x i)
+                (<= i n) 
+                (case-split (integerp n))
+                )
+           (equal (bits x n j)
+                  (bits x (1- i) j)))
+  :rule-classes ((:rewrite :match-free :all))
+  :hints (("goal" :use (:instance expt-weak-monotone (n i) (m (+ 1 n)))
+           :in-theory (e/d (bits bvecp) (expt-compare)))))
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i)))))))
+  :hints (("Goal" :in-theory (enable bits mod))))
+
+(defthmd bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0))
+  :hints (("Goal" :in-theory (enable bits))))
+
+(defthmd bits-shift-down-2
+  (implies (and (natp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0)))
+  :hints (("Goal" :use ((:instance bits-plus-bits (n (+ i k)) (m 0) (p k)))
+           :in-theory (enable bits-shift-down-1))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bits-trunc-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/bits-trunc-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bits-trunc-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bits-trunc-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,138 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+(in-package "ACL2")
+
+(local (include-book "trunc"))
+(include-book "log")
+(include-book "float")
+(include-book "trunc")
+(local (include-book "bits"))
+(local (include-book "../../arithmetic/top"))
+(local (in-theory (enable expt-minus)))
+
+(defthm bits-trunc-2
+  (implies (and (= n (1+ (expo x)))
+;(rationalp x) ;(integerp x) 
+                (>= x 0)
+                ;(integerp n) 
+;                (>= n k)
+                (integerp k) 
+                (> k 0)
+                )
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable bits trunc-rewrite expt-split))))
+
+
+(local
+ (defthm bits-trunc-3
+   (implies (and (integerp x) 
+                 (> x 0)
+                 (integerp n) (> n k)
+                 (integerp k) (> k 0)
+                 (= (expo x) (1- n)))
+            (= (trunc x k)
+               (logand x (- (expt 2 n) (expt 2 (- n k))))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance bits-trunc-2)
+                         (:instance logand-slice (k (- n k)))))
+           )))
+
+(local
+ (defthm bits-trunc-4
+   (implies (and (integerp x) (> x 0)
+                 (integerp n) (> n k)
+                 (integerp k) (> k 0)
+                 (>= x (expt 2 (1- n)))
+                 (< x (expt 2 n)))
+            (= (trunc x k)
+               (logand x (- (expt 2 n) (expt 2 (- n k))))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance bits-trunc-3)
+                         (:instance expo-unique (n (1- n))))))))
+
+(local
+ (defthm bits-trunc-5
+   (implies (and (integerp x) (> x 0)
+                 (integerp m) (>= m n)
+                 (integerp n) (> n k)
+                 (integerp k) (> k 0)
+                 (>= x (expt 2 (1- n)))
+                 (< x (expt 2 n)))
+            (= (trunc x k)
+               (logand x (mod (- (expt 2 m) (expt 2 (- n k))) (expt 2 n)))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance bits-trunc-4)
+                         ;(:instance mod-2m-2n-k)
+                         )))))
+
+(include-book "land0")
+(include-book "merge")
+
+(defthm bits-trunc-original
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) (> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0)
+                )
+           (= (trunc x k)
+              (land0 x (- (expt 2 m) (expt 2 (- n k))) n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (e/d (bits-tail land0 expt-split) (expt-minus))
+		  :use ((:instance bits-trunc-5)))))
+
+#|
+(defthm bits-trunc-6
+  (implies (and (integerp x) (> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0)
+                (>= x (expt 2 (1- n)))
+                (< x (expt 2 n)))
+           (= (trunc x k)
+              (logand x (- (expt 2 m) (expt 2 (- n k))))))
+  :rule-classes ()
+  :hints (("goal" :use (;(:instance hack-82)
+                        (:instance bits-trunc-5)
+			(:instance expt-weak-monotone (n (- n k)))
+			(:instance and-dist-d (y (- (expt 2 m) (expt 2 (- n k)))))))))
+|#
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bits-trunc.lisp acl2-6.3/books/rtl/rel9/support/support/bits-trunc.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bits-trunc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bits-trunc.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,65 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+(in-package "ACL2")
+
+;BOZO include less...
+(include-book "log")
+(include-book "float")
+(include-book "trunc")
+(include-book "land0")
+(local (include-book "bits-trunc-proofs"))
+
+
+
+(defthm bits-trunc-2
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k) 
+                (> k 0)
+                )
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :rule-classes ())
+
+(defthm bits-trunc-original
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) (> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0)
+                )
+           (= (trunc x k)
+              (land0 x (- (expt 2 m) (expt 2 (- n k))) n)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bits.lisp acl2-6.3/books/rtl/rel9/support/support/bits.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bits.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,892 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+;; NOTE:: all proofs are now in bits-proofs.lisp  !!
+
+This book is still a mess.
+
+See the comments in bits-proofs (especially at the end) for more possible lemmas to add.
+
+bits now uses mod instead of rem; the use of "mod" seems to allow nicer results to be proved.
+
+bits now *always* returns a non-negative integer.  Many hyps of other lemmas require expressions to be
+non-negative integers, and with bits, this used to require further checking of the arguments (at worst,
+checking all the way to the leaves of each bits nest each time).
+
+todo:
+ add case-split to all hyps about i and j (indices to bits must be integers and j must be <= i or else weird
+stuff happens (but we can easily handle these cases).
+
+|#
+
+(local (include-book "bits-proofs")) 
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+
+(include-book "../../arithmetic/negative-syntaxp")
+(include-book "../../arithmetic/power2p")
+
+;; Necessary defuns:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defun bitvec (x n)
+  (if (bvecp x n) x 0))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+
+;In proofs about RTL terms, i and j are almost always constants
+
+(defthm bits-nonnegative-integerp-type
+  (and (<= 0 (bits x i j))
+       (integerp (bits x i j)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than bits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription bits)))
+
+(defthm bits-natp
+  (natp (bits x i j)))
+
+(defthm bits-with-x-0
+  (equal (bits 0 i j)
+         0))
+
+(defthm bits-with-x-not-rational
+  (implies (not (rationalp x))
+           (equal (bits x i j)
+                  0)))
+
+(defthm bits-with-i-not-an-integer
+  (implies (not (integerp i))
+           (equal (bits x i j)
+                  0)))
+
+(defthm bits-with-j-not-an-integer
+  (implies (not (integerp j))
+           (equal (bits x i j)
+                  0)))
+
+(defthm bits-with-indices-in-the-wrong-order
+  (implies (< i j)
+           (equal (bits x i j)
+                  0)))
+
+(defthm bits-upper-bound
+  (< (bits x i j) (expt 2 (+ 1 i (- j))))
+  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j)))))
+
+;tigher bound for the usual case
+(defthm bits-upper-bound-tighter
+  (implies (case-split (<= j i))
+           (<= (bits x i j) (1- (expt 2 (+ i 1 (- j))))))
+  :rule-classes (:rewrite (:linear :trigger-terms ((bits x i j)))))
+
+;this might help stupid hyps get rewritten away...
+;perhaps require that z be a constant?
+(defthm bits-upper-bound-2
+  (implies (<= (expt 2 (+ 1 i (- j))) z)
+           (< (bits x i j) z)))
+
+;a is a free var
+(defthm bits-force
+  (implies (and (<= (* a (expt 2 (+ i 1))) x)
+                (< x (* (1+ a) (expt 2 (+ i 1))))
+                (integerp x)
+                (integerp i)
+                (integerp a)
+                )
+           (equal (bits x i 0)
+                  (- x (* a (expt 2 (+ i 1))))))
+  :rule-classes nil
+  )
+
+;BOZO expensive? disable?
+(defthm bits-force-with-a-chosen-neg
+  (implies (and (< x 0) ;rarely the case?
+                (<= (* -1 (expt 2 (+ i 1))) x)
+                (integerp x)
+                (integerp i)
+                )
+           (equal (bits x i 0)
+                  (- x (* -1 (expt 2 (+ i 1)))))))
+
+;eventually, I'd like to add a bind-free rule to handle the bits-shift case?
+(defthm bits-shift
+  (implies (and (case-split (integerp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (equal (bits (* (expt 2 n) x) i j)
+                       (bits x (- i n) (- j n)))
+                (equal (bits (* x (expt 2 n)) i j)
+                       (bits x (- i n) (- j n))))))
+
+; Basically a restatement of bits-shift:
+(defthm bits-shift-up-1
+  (implies (and (integerp k)
+		(integerp i)
+		(integerp j))
+	   (equal (bits (* (expt 2 k) x) i j)
+		  (bits x (- i k) (- j k))))
+  :rule-classes ())
+
+(defthm bits-shift-second-with-more
+  (implies (and (case-split (integerp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits (* x (expt 2 n) y) i j)
+                  (bits (* x y) (- i n) (- j n)))))
+
+(defthm bits-shift-by-constant-power-of-2
+  (implies (and (syntaxp (quotep k))
+                (power2p k)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits (* k x) i j)
+                  (bits x (- i (expo k)) (- j (expo k))))))
+
+;don't need this if we have bits-shift-by-constant-power-of-2?
+(defthmd bits-times-2
+  (implies (and (acl2-numberp i)
+                (acl2-numberp j)
+                )
+           (equal (bits (* 2 x) i j)
+                  (bits x (1- i) (1- j)))))
+
+;allows you to split a bit vector into two parts
+;split x[i:j] into x[i:n] and x[n-1:j]
+;free var n (where to split)
+;BOZO get rid of the other in favor of this one?
+(defthm bits-plus-bits2
+  (implies (and ;(rationalp x)
+                (integerp i) 
+                (integerp j)
+                (integerp n)
+                (<= j n)
+                (<= n i))
+           (equal (bits x i j)
+                  (+ (* (bits x i n) (expt 2 (- n j)))
+                     (bits x (1- n) j))))
+  :rule-classes nil)
+
+(defthm bits-plus-bits
+  (implies (and (integerp m)
+                (integerp p)
+                (integerp n)
+                (<= m p)
+                (<= p n))
+           (= (bits x n m)
+              (+ (bits x (1- p) m)
+                 (* (expt 2 (- p m)) (bits x n p)))))
+  :rule-classes ())
+
+;this really has two separate cases
+;generalize with j not 0?
+;this rule often seems helpful, but I'm not sure exactly why
+(defthm bits-split-around-zero
+  (implies (and (>= x (- (expt 2 (+ i 1))))
+                (< x (expt 2 (+ i 1)))
+                (integerp x)
+                (case-split (integerp i))
+                (case-split (<= 0 i))
+                )
+           (equal (bits x i 0)
+                  (if (<= 0 x)
+                      x
+                    (+ x (expt 2 (+ i 1)))))))
+
+
+
+;this should fire after bits-bvecp, so we list it first
+;or should we rewrite (bvecp (bits x i j))? <-- huh? make the conslusion an equal??
+(defthm bits-bvecp-when-x-is	
+  (implies (and (bvecp x k)	;gen k to be something less that the k in the rhs?
+                (case-split (<= 0 j))
+                )
+           (bvecp (bits x i j) k)))
+
+#|
+I found a case where this failed to apply because I didn't know that j was an acl2-number:
+1x (:REWRITE BITS-BVECP) failed because :HYP 1 rewrote to (NOT (< J (IF (ACL2-NUMBERP J) J '0))).
+|#
+(defthm bits-bvecp
+  (implies (and (<= (+ 1 i (- j)) k)
+                (case-split (integerp k))
+                )
+           (bvecp (bits x i j) k)))
+
+;do we want this rule enabled?
+;this is sort of odd
+(defthm bits-bvecp-fw
+  (implies (equal n (- (1+ i) j)) ; note equal here to help with the fw chaining
+           (bvecp (bits x i j) n))
+  :rule-classes
+  ((:forward-chaining :trigger-terms ((bits x i j)))))
+
+;BOZO make this one a fw-chaining rule instead of the one above?
+(defthm bits-bvecp-simple
+  (implies (equal k (+ 1 i (* -1 j)))
+           (bvecp (bits x i j) k)))
+
+;included in case bits-bvecp has the problem described above...
+(defthm bits-bvecp-simple-2
+  (bvecp (bits x (1- i) 0) i))
+
+
+
+;I have many theorems dealing with the simplification of bits of a sum
+
+;better names: make the dropped term x, the others a,b,c,...
+;;; more bits thms like this!
+
+(defthm bits-sum-drop-irrelevant-term-2-of-2
+  (implies (integerp (/ y (expt 2 (+ 1 i))))
+           (equal (bits (+ x y) i j)
+                  (bits x i j))))
+
+(defthm bits-sum-drop-irrelevant-term-1-of-2
+  (implies (integerp (/ y (expt 2 (+ 1 i))))
+           (equal (bits (+ y x) i j)
+                  (bits x i j))))
+
+(defthm bits-sum-drop-irrelevant-term-3-of-3
+  (implies (integerp (/ y (expt 2 (+ 1 i))))
+           (equal (bits (+ w x y) i j)
+                  (bits (+ w x) i j))))
+
+(defthm bits-sum-drop-irrelevant-term-2-of-3
+  (implies (integerp (/ y (expt 2 (+ 1 i))))
+           (equal (bits (+ w y x) i j)
+                  (bits (+ w x) i j))))
+
+;kind of yucky
+(defthm bits-minus
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (<= j i)) ;drop?
+                (case-split (integerp j))
+                )
+           (equal (bits (* -1 x) i j)
+                  (if (integerp (* 1/2 x (/ (expt 2 i))))
+                      0
+                    (if (integerp (* x (/ (expt 2 j))))
+                        (+ (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j)))
+                      (+ -1 (* 2 (expt 2 i) (/ (expt 2 j))) (- (bits x i j))))))))
+
+;this one should be the one enabled?
+(defthmd bits-minus-alt
+  (implies (and (syntaxp (negative-syntaxp x))
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (<= j i))
+                (case-split (integerp j))
+                )
+           (equal (bits x i j)
+                  (if (integerp (* 1/2 (- X) (/ (EXPT 2 I))))
+                    0
+                    (if (INTEGERP (* (- X) (/ (EXPT 2 J))))
+                        (+ (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j)))
+                      (+ -1 (* 2 (EXPT 2 I) (/ (EXPT 2 J))) (- (bits (- x) i j))))))))
+
+;drops hyps like this: (<= (BITS x 30 24) 253)
+;Recall that <= gets rewritten to < during proofs
+(defthm bits-drop-silly-upper-bound
+  (implies (and (syntaxp (quotep k))
+                (>= k (1- (expt 2 (+ 1 i (- j)))))
+                (case-split (<= j i))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< k (bits x i j))
+                  nil)))
+
+;rewrite things like (<= 4096 (BITS x 23 12)) to false
+;Recall that <= gets rewritten to < during proofs
+(defthm bits-drop-silly-lower-bound
+  (implies (and (syntaxp (quotep k))
+                (> k (1- (expt 2 (+ 1 i (- j)))))
+                (case-split (<= j i))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+  (equal (< (bits x i j) k)
+         t)))
+
+;rewrite (< -64 (BITS <signal> 64 59)) to t
+(defthm bits-drop-silly-bound-3
+  (implies (and (syntaxp (quotep k))
+                (< k 0)
+                )
+           (equal (< k (bits x i j))
+                  t)))
+
+(defthm bits-drop-silly-bound-4
+  (implies (and (syntaxp (quotep k))
+                (<= k 0)
+                )
+           (equal (< (bits x i j) k)
+                  nil)))
+
+;This is the rule for which I wish I knew the "parity" of the term being rewritten...
+(defthm bits-<-1
+  (equal (< (bits x i j) 1)
+         (equal (bits x i j) 0)))
+
+;put bits-cancel- in the name?
+(defthm bits-at-least-zeros
+  (implies (and (syntaxp (quotep k))
+                (equal k (expt 2 (- j2 j)))
+                (<= j j2)
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp j2))
+                )
+           (equal (< (bits x i j)
+                     (* k (bits x i j2)))
+                  nil)))
+
+(defthm bits-upper-with-subrange
+  (implies (and (syntaxp (quotep k))
+                (<= j j2)
+                (equal k (expt 2 (- j2 j)))
+                (case-split (<= j2 i)) ;drop?
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp j2))
+                )
+           (< (BITS x i j) 
+              (BINARY-+ k (BINARY-* k (BITS x i j2))))))
+
+(defthm bits-upper-with-subrange-alt
+  (implies (and (syntaxp (quotep k))
+                (<= j j2)
+                (equal k (expt 2 (- j2 j)))
+                (case-split (<= j2 i)) ;drop?
+                (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp j2))
+                )
+           (equal (< (BINARY-+ k (BINARY-* k (BITS x i j2))) 
+                     (BITS x i j))
+                  nil)))
+
+;make another version for k negative? (t-p should handle?)
+(defthm bits-equal-impossible-constant
+  (implies (and (syntaxp (quotep k)) ;require that i and j be constants too?
+                (<= (expt 2 (+ 1 i (- j))) k)
+                )
+           (not (equal (bits x i j) k))))
+
+;will this fire?
+(defthm bits-compare-to-zero
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (not (< 0 (bits x i j)))
+                  (equal 0 (bits x i j)))))
+
+;expensive?
+;have we done enough to prevent loops?
+;should we make a version where we require j to be a constant and then disable this version?
+(defthm bits-ignore-negative-bits-of-integer
+   (implies (and (syntaxp (not (and (quotep j) (equal 0 (cadr j))))) ;prevents loops
+                 (<= j 0)
+                 (integerp x)
+                 (case-split (integerp j))
+                 )
+            (equal (bits x i j)
+                   (* (expt 2 (- j)) (bits x i 0)))))
+
+;disable since it can be bad to leave "naked" signals and we never want to see expt
+(defthmd bits-does-nothing-2
+  (implies (and (<= j 0) ;a bit strange (j will usually be zero?)
+                (bvecp x (+ i 1)) ;expand?
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits x i j)
+                  (* (expt 2 (- j)) x))))
+
+;has the right pattern to rewrite stuff like this: (<= (EXPT 2 J) (BITS Y (+ -1 J) 0)) to nil
+(defthm bits-upper-bound-special
+  (< (bits x (1- i) 0) (expt 2 i)))
+
+;like bits-reduce
+;was called bits-tail
+;BOZO choose a name for this...
+(defthmd bits-does-nothing
+  (implies (and (bvecp x (1+ i))
+                (case-split (integerp i))
+                )
+           (equal (bits x i 0)
+                  x)))
+
+(defthm bits-with-bad-index-2
+  (implies (not (integerp i))
+           (equal (bits x (1- i) 0)
+                  0)))
+
+;BOZO rename to begin with "bits-"
+(defthmd bvecp-bits-0
+   (implies (bvecp x j)
+            (equal (bits x i j) 0)))
+
+;to handle mod- correctly
+;make an alt version?
+(defthm bits-drop-from-minus
+  (implies (and (bvecp x (1+ i))
+                (bvecp y (1+ i))
+                (<= y x)
+		(case-split (acl2-numberp i)))
+	   (equal (bits (+ x (* -1 y)) i 0)
+		  (+ x (* -1 y)))))
+
+;backchain-limit?
+(defthm bits-tail
+   (implies (and (bvecp x (1+ i))
+                 (case-split (acl2-numberp i)))
+            (equal (bits x i 0)
+                   x)))
+
+(defthm bits-tail-special
+   (implies (bvecp x i)
+            (equal (bits x (1- i) 0)
+                   x)))
+
+(defthmd bits-alt-def
+  (equal (bits x i j)
+         (if (or (not (integerp i))
+                 (not (integerp j)))
+             0
+           (mod (fl (/ x (expt 2 j))) (expt 2 (+ 1 i (- j)))))))
+
+(defthmd bits-plus-mult-2
+   (implies (and (< n k)
+                 (integerp y)
+                 (integerp k)
+                 )
+            (equal (bits (+ x (* y (expt 2 k))) n m)
+                   (bits x n m))))
+
+(defthmd bits-plus-mult-2-rewrite
+   (implies (and (syntaxp (quotep c))
+                 (equal (mod c (expt 2 (1+ n))) 0))
+            (equal (bits (+ c x) n m)
+                   (bits x n m))))
+
+;can we replace 0 with any non-negative j?
+(defthm bits-less-than-x
+  (implies (<= 0 x)
+	   (<= (bits x i 0) x))
+  :rule-classes (:rewrite :linear))
+
+;should say <= instead of less-than
+(defthm bits-less-than-x-gen
+  (implies (and (<= 0 x) ;case-split?
+                (case-split (<= 0 j))
+                (case-split (not (complex-rationalp x)))
+                )
+	   (<= (bits x i j) x))
+  :rule-classes (:rewrite :linear))
+
+
+(defthmd bits-bits-1
+  (implies (and (<= k (- i j))
+                (case-split (<= 0 l))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (bits (bits x i j) k l)
+                  (bits x (+ k j) (+ l j)))))
+
+(defthmd bits-bits-2
+  (implies (and (> k (- i j))
+                (case-split (<= 0 l))
+;                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (bits (bits x i j) k l)
+                  (bits x i (+ l j)))))
+
+(defthm bits-bits
+  (implies (and (case-split (<= 0 l))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (bits (bits x i j) k l)
+                  (if (<= k (- i j))
+                      (bits x (+ k j) (+ l j))
+                    (bits x i (+ l j))))))
+
+
+;The following trivial corollary of bits-bits is worth keeping enabled.
+
+(defthm bits-bits-constants
+  (implies (and (syntaxp (quotep i))
+                (syntaxp (quotep j))
+                (syntaxp (quotep k))
+                (<= 0 l)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (integerp l))
+           (equal (bits (bits x i j) k l)
+                  (if (<= k (- i j))
+                      (bits x (+ k j) (+ l j))
+                    (bits x i (+ l j))))))
+
+(defthm bits-reduce
+  (implies (and (< x (expt 2 (+ 1 i)))
+                (case-split (integerp x))
+                (case-split (<= 0 x))
+                (case-split (integerp i))
+                )
+           (equal (bits x i 0)
+                  x)))
+
+(defthm bits-0
+  (equal (bits 0 i j) 
+         0))
+
+
+
+;could prove a version where we drop bits from both args?
+(defthm bits-sum-drop-bits-around-arg-2
+  (implies (and (<= i i+)
+                (integerp y)
+                (case-split (integerp i+))
+                )
+           (equal (bits (+ x (bits y i+ 0)) i j)
+                  (bits (+ x y) i j))))
+
+;Follows from BITS-SUM-DROP-BITS-AROUND-ARG-2.
+(defthm bits-sum-drop-bits-around-arg-1
+  (implies (and (<= i i+)
+                (integerp x)
+                (case-split (integerp i+))
+                )
+           (equal (bits (+ (bits x i+ 0) y) i j)
+                  (bits (+ x y) i j))))
+
+(defthm bits-sum-drop-bits-around-arg-2-special-case
+  (implies (integerp y)
+           (equal (bits (+ x (bits y i 0)) i j)
+                  (bits (+ x y) i j))))
+
+(defthm bits-sum-drop-bits-around-arg-1-special-case
+  (implies (integerp x)
+           (equal (bits (+ (bits x i 0) y) i j)
+                  (bits (+ x y) i j))))
+
+;rename
+;Follows from BVECP-SUM-OF-BVECPS.
+(defthm bits-sum-1
+  (equal (bits (+ (bits x (1- i) 0)
+                  (bits y (1- i) 0))
+               i ;actually, this could be anything >= i ??
+               0)
+         (+ (bits x (1- i) 0)
+            (bits y (1- i) 0))))
+
+
+;export!! enable?
+;gen?
+;BOZO rename!
+(defthmd bits-of-non-integer-special
+  (implies (case-split (not (integerp i)))
+           (equal (bits x (1- i) 0)
+                  0)))
+
+(defthm bits-fl
+  (implies (<= 0 j)
+           (equal (bits (fl x) i j)
+                  (bits x i j))))
+
+;just use bits-fl-eric and bits-shift!
+;BOZO drop the fl from the lhs, since it'll be rewritten away...
+(defthmd bits-shift-down-1
+  (implies (and (<= 0 j)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                )
+           (equal (bits (fl (/ x (expt 2 k)))
+                        i
+                        j)
+                  (bits x (+ i k) (+ j k)))))
+
+(defthmd bits-shift-down-eric
+  (implies (and (<= 0 j)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                )
+           (equal (bits (* x (/ (expt 2 k)))
+                        i
+                        j)
+                  (bits x (+ i k) (+ j k)))))
+
+; like  bits-plus-mult-1 - remove one of them?
+(defthmd bits+2**k-2
+  (implies (and (< x (expt 2 k))
+                (<= 0 x)
+                (rationalp x) ;(integerp x)
+                (<= k m)
+                (integerp y)
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp k))
+                )
+           (equal (bits (+ x (* y (expt 2 k))) n m)
+                  (bits y (- n k) (- m k)))))
+
+(defthm bits+2**k-2-alt
+  (implies (and (< x (expt 2 k))
+                (<= 0 x)
+                (rationalp x) ;(integerp x)
+                (<= k m)
+                (integerp y)
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp k))
+                )
+           (equal (bits (+ x (* (expt 2 k) y)) n m)
+                  (bits y (- n k) (- m k)))))
+
+(defthmd bits-fl-by-2
+  (equal (fl (* 1/2 (bits x i 0)))
+         (bits x i 1)))
+
+(defthm mod-bits-by-2
+  (implies (and (integerp x)
+                (<= 0 i)
+                (integerp i)
+                )
+           (equal (mod (bits x i 0) 2)
+                  (mod x 2))))
+
+;basically the same as bits+2**k-2; drop one?
+;move
+(defthmd bits-plus-mult-1
+  (implies (and (bvecp x k) ;actually, x need not be an integer...
+                (<= k m)
+                (integerp y)
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp k))
+                )
+           (equal (bits (+ x (* y (expt 2 k))) n m)
+                  (bits y (- n k) (- m k)))))
+
+(defthm bits-mod-0
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp m)
+                (>= m 0)
+                (integerp n)
+                (>= n 0))
+           (iff (= (mod x (expt 2 (+ m n 1))) 0)
+                (and (= (bits x (+ m n) n) 0)
+                     (= (mod x (expt 2 n)) 0))))
+  :rule-classes ())
+
+;this is silly? just open up bits!
+(defthm mod-bits-equal
+  (implies (= (mod x (expt 2 (1+ i))) (mod y (expt 2 (1+ i))))
+           (= (bits x i j) (bits y i j)))
+  :rule-classes ())
+
+(defthmd mod-bits-equal-cor
+    (implies (and (integerp x)
+		  (integerp n)
+		  (integerp i)
+		  (integerp j)
+		  (< i n))
+	     (equal (bits (mod x (expt 2 n)) i j)
+		    (bits x i j))))
+
+;not needed?  just expand bits?
+(defthmd bits-mod
+  (implies (and (case-split (integerp x))
+                (case-split (integerp i)) ;gen?
+;(case-split (<= 0 i))
+                )
+           (equal (bits x i 0)
+                  (mod x (expt 2 (1+ i))))))
+
+(defthmd bits-bits-sum
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i))
+	   (equal (bits (+ (bits x i 0) y) i 0)
+		  (bits (+ x y) i 0))))
+
+;reorder? make rewrite?
+(defthm bits-shift-up-2
+  (implies (and (integerp x)
+                (integerp k)
+                (<= 0 k)
+                (integerp i)
+                )
+           (equal (* (expt 2 k) (bits x i 0))
+                  (bits (* (expt 2 k) x) (+ i k) 0)))
+  :rule-classes ())
+
+;export!
+;more forms of this? (bits (/ (expt 2 k)) i j)
+;bits of a constant power of 2??
+;bits of a range of ones (i.e., a difference of powers of 2).
+;use power2p??
+(defthm bits-expt
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k)) ;BOZO gen?
+                )
+           (equal (bits (expt 2 k) i j)
+                  (if (or (< i j)
+                          (< k j)
+                          (< i k))
+                      0
+                    (expt 2 (- k j))))))
+
+(defthm bits-expt-constant
+  (implies (and (syntaxp (and (quotep k) (power2p (cadr k))))
+                (force (power2p k)) ;bozo do the computation only once
+                (case-split (integerp k)) ;gen?
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits k i j)
+                  (if (or (< i j)
+                          (< (expo k) j)
+                          (< i (expo k)))
+                      0
+                    (expt 2 (- (expo k) j))))))
+
+
+;BOZO add case-splits?
+(defthm mod-bits
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                (integerp j)
+                (integerp i))
+           (equal (mod (bits x i 0) (expt 2 j))
+                  (bits x (min i (1- j)) 0))))
+
+
+
+;Unlike bits-tail, this allows j to be non-zero.
+;Note that the conclusion is (bits x ...), not just x.
+;i is a free variable
+;watch out for loops with this rule
+(defthmd bits-tighten
+  (implies (and (bvecp x i)
+                (<= i n) 
+                (case-split (integerp n))
+                )
+           (equal (bits x n j)
+                  (bits x (1- i) j)))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd bits-mod-2
+  (implies (and (integerp x)
+                (integerp i)
+                (integerp j)
+                (>= i j))
+           (equal (bits x (1- i) j)
+                  (- (fl (/ x (expt 2 j)))
+                     (* (expt 2 (- i j))
+                        (fl (/ x (expt 2 i))))))))
+
+(defthmd bits-neg
+  (implies (and (< i 0)
+                (integerp x))
+           (equal (bits x i j) 0)))
+
+(defthmd bits-shift-down-2
+  (implies (and (natp x)
+		(natp i)
+		(natp k))
+	   (equal (fl (/ (bits x (+ i k) 0) (expt 2 k)))
+		  (bits (fl (/ x (expt 2 k))) i 0))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bvecp-helpers.lisp acl2-6.3/books/rtl/rel9/support/support/bvecp-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bvecp-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bvecp-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,273 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "rtl")
+(include-book "bvecp-lemmas") ;bvecp and type lemmas for the RTL primitives
+(local (include-book "../../arithmetic/top"))
+(local (include-book "bits"))
+
+;would like to remove some of this stuff
+
+;;;;;;;;;;;;;;;;;;; other helpful lemmas
+
+(defthm nonneg-+
+  (implies (and (<= 0 x)
+                (<= 0 y))
+           (<= 0 (+ x y))))
+
+(defthm integerp-+
+  (implies (and (integerp x)
+                (integerp y))
+           (integerp (+ x y))))
+
+#|
+;should be a forward-chaining rule?
+(defthm bvecp-implies-natp
+  (implies (bvecp x k)
+           (and (integerp x)
+                (>= x 0)))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+;free var
+;should be a forward-chaining rule?
+(defthm bvecp-implies-rationalp
+  (implies (bvecp x k)
+           (rationalp x))
+  :hints (("Goal" :in-theory (enable bvecp))))
+|#
+
+;why do we have this?
+(defthm unknown-upper-bound
+  (< (unknown key size n) (expt 2 size))
+  :hints
+  (("goal" :use bvecp-unknown
+    :in-theory (set-difference-theories
+                (enable bvecp)
+                '(bvecp-unknown))))
+  :rule-classes
+  (:rewrite (:linear :trigger-terms ((unknown key size n)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :use (:instance
+                        ag-maps-bv-arr-to-bvecp (a index) (r obj) (k size))
+           :in-theory (set-difference-theories
+                       (enable bvecp)
+                       '(ag-maps-bv-arr-to-bvecp)))))
+
+;(local (in-theory (enable floor-fl)))
+
+;These next two are for the bus unit bvecp lemmas:
+
+;could use (local (in-theory (enable expt-compare-with-double)))
+;remove?
+(defthm bits-does-nothing-hack
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (BITS (* 2 x) i 0)
+                  (* 2 x)))
+  :hints (("Goal" :use (:instance bits-tail (x (* 2 x)) (i i))
+           :in-theory (set-difference-theories
+                       (enable bvecp)
+                       '(bits-tail)))))
+
+;remove?
+(defthm bits-does-nothing-hack-2
+  (implies (and (< x (expt 2 i)) 
+                (integerp x)
+                (<= 0 x)
+                (integerp i)
+                (<= 0 i))
+           (equal (bits (+ 1 (* 2 x)) i 0)
+                  (+ 1 (* 2 x))))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '(bits-tail
+                                ))
+           :use (:instance bits-tail (x (+ 1 (* 2 x))) (i i)))))
+
+
+;is this one too expensive?
+(defthm bvecp-def
+  (implies (and (< x (expt 2 k))
+                (integerp x)
+                (<= 0 x)
+                )
+           (bvecp x k))
+  :hints (("Goal" :in-theory (enable bvecp)))
+  :rule-classes ((:rewrite :backchain-limit-lst (1 nil nil))))
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+(defthm bv-arrp-if1
+  (equal (bv-arrp (if1 x y z) n)
+         (if1 x (bv-arrp y n) (bv-arrp z n))))
+
+;remove these?
+
+
+#|
+(defthm bvecp-1-values
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal (equal x 1) t))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bvecp-2-values
+  (implies (and (bvecp x 2)
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 3) t))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bvecp-3-values
+  (implies (and (bvecp x 3)
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 7) t))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bvecp-4-values
+  (implies (and (bvecp x 4)
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 15) t))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bvecp-5-values
+  (implies (and (bvecp x 5)
+                (not (equal x 30))
+                (not (equal x 29))
+                (not (equal x 28))
+                (not (equal x 27))
+                (not (equal x 26))
+                (not (equal x 25))
+                (not (equal x 24))
+                (not (equal x 23))
+                (not (equal x 22))
+                (not (equal x 21))
+                (not (equal x 20))
+                (not (equal x 19))
+                (not (equal x 18))
+                (not (equal x 17))
+                (not (equal x 16))
+                (not (equal x 15))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 14))
+                (not (equal x 13))
+                (not (equal x 12))
+                (not (equal x 11))
+                (not (equal x 10))
+                (not (equal x 9))
+                (not (equal x 8))
+                (not (equal x 7))
+                (not (equal x 6))
+                (not (equal x 5))
+                (not (equal x 4))
+                (not (equal x 3))
+                (not (equal x 2))
+                (not (equal x 1))
+                (not (equal x 0)))
+           (equal (equal x 31) t))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+
+;can remove these two?
+(defthm natp-* 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (* x y))
+                (>= (* x y) 0))))
+
+(defthm natp-+ 
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (and (integerp (+ x y))
+                (>= (+ x y) 0))))
+
+
+;drop?
+(DEFTHM BITS-bvecp-FW
+  (IMPLIES (EQUAL N (- (1+ I) J))
+           (BVECP (BITS X I J) N))
+  :RULE-CLASSES
+  ((:FORWARD-CHAINING :TRIGGER-TERMS ((BITS X I J)))))
+|#
+
+
+;BOZO where all should this go?  make an if1 book!
+(defthmd if1-lnot
+  (implies (bvecp tst 1)
+	   (equal (if1 (lnot tst 1) x y)
+		  (if1 tst y x)))
+  :hints (("Goal" :in-theory (enable if1 bvecp))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bvecp-lemmas.lisp acl2-6.3/books/rtl/rel9/support/support/bvecp-lemmas.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bvecp-lemmas.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bvecp-lemmas.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,231 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;BOZO Everything in this book should be redundant...
+
+(set-match-free-default :all)
+
+;Contains bvecp lemmas about the RTL primitives.
+;Also contains type lemmas (non-negative integer, natp, etc.)
+
+(defun fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(local (include-book "../../arithmetic/expo"))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defun expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;should this be here?  should it be enabled?
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(local (include-book "bits"))
+(local (include-book "setbits"))
+(local (include-book "setbitn"))
+(local (include-book "encode"))
+(local (include-book "decode"))
+(local (include-book "logs"))
+(local (include-book "lnot"))
+(local (include-book "bitn"))
+(local (include-book "shft"))
+(local (include-book "cat"))
+(local (include-book "logand"))
+(local (include-book "merge")) ;would like to remove this
+(local (include-book "mulcat"))
+(local (include-book "land0"))
+(local (include-book "lior0"))
+(local (include-book "lxor0"))
+(local (include-book "cat"))
+
+(include-book "rtl")
+
+;; logand
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logand))))
+
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logand))))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+(defthm bvecp-logand-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logand x y) n))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+
+;; logior
+
+(defthm logior-integer-type-prescription
+  (integerp (logior i j))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logior i j))
+                (integerp (logior i j))))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logior i j))))
+
+(defthm bvecp-logior-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;; logxor
+;!!fix this to have lemmas like logand,logior above
+(defthm natp-logxor-alternate-2
+    (implies (and (integerp x) (<= 0 x)
+		  (integerp y) (<= 0 y))
+	     (and (integerp (logxor x y))
+		  (<= 0 (logxor x y))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm bvecp-logxor-alternate
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n)
+                (bvecp y n))
+           (bvecp (logxor x y) n)))
+
+;if1
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+
+;; mod-
+
+;finish this section (will have to change comp2-inv?)
+
+#|
+(defthm mod--nonnegative-integer-type
+  (and (integerp (mod- l n x))
+       (<= 0 (mod- l n x)))
+  :hints (("Goal" :in-theory (enable mod-)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than mod--nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription mod-)))
+|#
+
+#| mod- is now a macro!
+(defthm mod--bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (integerp n)
+                (>= n 0))
+           (bvecp (mod- x y n) n))
+  :hints (("Goal" :in-theory (enable bvecp mod- comp2-inv))))
+|#
+
+
+
+
+
+
+(DEFTHM UNKNOWN-upper-bound
+  (< (UNKNOWN KEY SIZE N) (expt 2 size))
+  :HINTS
+  (("Goal" :use bvecp-unknown
+    :IN-THEORY (set-difference-theories
+                (ENABLE BVECP)
+                '(bvecp-unknown))))
+  :RULE-CLASSES
+  (:REWRITE (:linear :trigger-terms ((UNKNOWN KEY SIZE N)))))
+
+(defthm bv-arrp-implies-nonnegative-integerp
+  (implies (bv-arrp obj size)
+           (and (INTEGERP (ag index obj))
+                (<= 0 (ag index obj))))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :use (:instance
+                        ag-maps-bv-arr-to-bvecp (a index) (r obj) (k size))
+           :in-theory (set-difference-theories
+                       (enable bvecp)
+                       '(ag-maps-bv-arr-to-bvecp))))
+  )
+
+
+
+
+
+
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bvecp-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/bvecp-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bvecp-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bvecp-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,273 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(local (include-book "../../arithmetic/top"))
+
+(local (in-theory (enable expt-minus)))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-with-n-not-a-positive-integer
+  (implies (or (not (integerp k))
+               (<= k 0))
+           (equal (bvecp x k)
+                  (equal 0 x)))
+  :hints (("Goal" :cases ((< x 1))
+           :in-theory (enable bvecp))))
+
+(defthm bvecp-0
+  (bvecp 0 k)
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+;drop?
+;just a special case of bvecp-with-n-not-a-positive-integer
+(defthm bvecp-0-thm
+  (equal (bvecp x 0)
+         (equal x 0))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(defthm bvecp-ones
+  (implies (case-split (<= 0 k))
+           (bvecp (1- (expt 2 k)) k))
+    :hints (("goal" :in-theory (enable bvecp))))
+
+(encapsulate
+ ()
+;k1 is a free var
+ (local (defthm bvecp-longer-aux
+          (implies (and (bvecp x k1)
+                        (<= k1 k2)
+                        (case-split (integerp k1))
+                        (case-split (integerp k2))
+                        )
+                   (bvecp x k2))
+          :rule-classes ((:rewrite :match-free :all))
+          :hints (("Goal" :use (:instance expt-compare (lhs (expt 2 k1)) (rhs (expt 2 k2)))
+                   :in-theory (set-difference-theories
+                               (enable bvecp)
+                               '(EXPT-COMPARE))
+                   ))))
+;k1 is a free var
+ (defthm bvecp-longer
+   (implies (and (bvecp x k1)
+                 (<= k1 k2)
+                 (case-split (integerp k2))
+                 )
+            (bvecp x k2))
+   :rule-classes ((:rewrite :match-free :all))
+   :hints (("Goal" :cases ((integerp k1)))))
+ )
+
+;expensive and so disabled
+;no free var
+(defthmd bvecp-one-longer
+  (implies (and (integerp k)
+                (bvecp x (- k 1)))
+           (bvecp x k))
+  :hints (("Goal" :in-theory (disable bvecp-longer)
+           :use ((:instance bvecp-longer (k2 k) (k1 (- k 1))))))
+  :rule-classes ((:rewrite :backchain-limit-lst (nil 2))))
+
+
+(defthm bvecp-of-non-integer
+  (implies (not (integerp x))
+           (not (bvecp x k)))
+    :hints (("Goal" :in-theory (enable bvecp))))
+
+;gen (replace n+1 with an arbitrary integer > n)?
+(defthm bvecp-expt-2-n
+  (implies (and (case-split (integerp n))
+                (case-split (<= 0 n))
+                )
+           (bvecp (expt 2 n) (+ 1 n)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bvecp expt-split)
+                              '(a15)))))
+
+(defthm bvecp-if ; see comment in bvecp.lisp
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+;better name?
+(defund mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k)
+  :hints (("Goal" :in-theory (enable mk-bvec))))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r))
+  :hints (("Goal" :in-theory (enable mk-bvec))))
+
+;BOZO make a version to shift by a constant!
+(defthm bvecp-shift
+  (implies (and (integerp x) ;note!
+		(<= 0 m)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		)
+	   (equal (bvecp (* x (expt 2 m)) n)
+		  (bvecp x (- n m))))
+  :hints (("Goal" :in-theory (enable bvecp expt-split))))
+
+(defthm bvecp-shift-alt
+  (implies (and (integerp x) ;note!
+		(<= 0 m)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		)
+	   (equal (bvecp (* (expt 2 m) x) n)
+		  (bvecp x (- n m))))
+  :hints (("Goal" :in-theory (enable bvecp expt-split))))
+
+;gen this!
+;BOZO will this unify (* 2 x) with 0??
+(defthm bvecp-shift-by-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops...
+                (integerp x)
+		(<= 0 m) ;gen?
+		(case-split (integerp m))
+		(case-split (integerp n))
+		)
+	   (equal (bvecp (* 2 x) n)
+		  (bvecp x (- n 1))))
+  :hints (("Goal" :in-theory (enable bvecp expt-split))))
+
+
+;gen?
+;in general, rewrite (bvecp k n) where k is a constant to a fact about n
+(defthm bvecp-1
+  (implies (and (<= 1 n)
+                (integerp n))
+           (bvecp 1 n))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+;n is a free variable
+;Disabled since may cause expensive backchaining.
+(defthmd natp-bvecp
+  (implies (bvecp x n)
+           (natp x))
+  :hints (("Goal" :in-theory (enable bvecp)))
+  :rule-classes ((:rewrite :match-free :once)))
+
+#|
+;kill this rule?
+;could just open bvecp instead of using this rule?
+(defthmd bvecp<=
+    (implies (and (natp n) ;gen?
+		  (bvecp x n))
+	     (<= x (1- (expt 2 n))))
+  :hints (("Goal" :in-theory (enable bvecp))))
+|#
+
+(defthmd bvecp-forward
+  (implies (bvecp x k)
+           (and (integerp x)
+                (<= 0 x)
+                (< x (expt 2 k)))) ;tigher-bound?
+  :hints (("Goal" :in-theory (enable bvecp)))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-product
+  (implies (and (bvecp x m)
+                (bvecp y n)
+                )
+           (bvecp (* x y) (+ m n)))
+  :rule-classes ()
+  :hints (("Goal" :cases ((and (integerp m) (equal 0 y) (integerp n))
+                          (and (integerp m) (equal 0 y) (not (integerp n)))
+                          (and (integerp m) (not (equal 0 y)) (integerp n))
+                          (and (integerp m) (not (equal 0 y)) (not (integerp n)))
+                          (and (not (integerp m))(equal 0 y) (integerp n))
+                          (and (not (integerp m)) (equal 0 y) (not (integerp n)))
+                          (and (not (integerp m)) (not (equal 0 y)) (integerp n))
+                          (and (not (integerp m)) (not (equal 0 y)) (not (integerp n)))
+                          )
+           :in-theory (enable bvecp natp expt-split))))
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1)))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+;make another for not-equal-0 implies equal-1?
+(defthm bvecp-1-0
+    (implies (and (bvecp x 1)
+		  (not (equal x 1)))
+	     (equal x 0))
+  :rule-classes :forward-chaining
+  :hints (("Goal" :use bvecp-1-rewrite)))
+
+
+(defthm bvecp+1
+    (implies (and (natp n)
+		  (bvecp x n))
+	     (bvecp x (+ 1 n)))
+  :hints (("Goal" :in-theory (enable bvecp expt-split))))
+
+;same as bvecp-longer.decide which param names to use.  j and k??
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+                  (case-split (integerp m))
+                  )		  
+	     (bvecp x m)))
+
+
+;This bounds the amount of carry out that we can have from the sum.
+(defthm bvecp-sum-of-bvecps
+  (implies (and (bvecp x (1- k))
+                (bvecp y (1- k))
+                (case-split (integerp k)))
+           (bvecp (+ x y) k))
+  :hints (("Goal" :in-theory (enable bvecp expt-split)))
+  )
+
+
+;add rule that (not (natp x)) implies (not (bvecp x k)) ??
+
+;exported in lib/
+(defthmd bvecp-0-1
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal x 1))
+  :rule-classes :forward-chaining)
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/bvecp.lisp acl2-6.3/books/rtl/rel9/support/support/bvecp.lisp
--- acl2-6.2/books/rtl/rel9/support/support/bvecp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/bvecp.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,215 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(local (include-book "bvecp-proofs"))
+
+;; New stuff:
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defthm bvecp-with-n-not-a-positive-integer
+  (implies (or (not (integerp k))
+               (<= k 0))
+           (equal (bvecp x k)
+                  (equal 0 x))))
+
+(defthm bvecp-0
+  (bvecp 0 k))
+
+;drop?
+;just a special case of bvecp-with-n-not-a-positive-integer
+(defthm bvecp-0-thm
+  (equal (bvecp x 0)
+         (equal x 0)))
+
+(defthm bvecp-ones
+  (implies (case-split (<= 0 k))
+           (bvecp (1- (expt 2 k)) k)))
+
+;k1 is a free var
+(defthm bvecp-longer
+   (implies (and (bvecp x k1)
+                 (<= k1 k2)
+                 (case-split (integerp k2))
+                 )
+            (bvecp x k2))
+   :rule-classes ((:rewrite :match-free :all)))
+
+;expensive and so disabled
+;no free var
+(defthmd bvecp-one-longer
+  (implies (and (integerp k)
+                (bvecp x (- k 1)))
+           (bvecp x k))
+  :rule-classes ((:rewrite :backchain-limit-lst (nil 2))))
+
+
+(defthm bvecp-of-non-integer
+  (implies (not (integerp x))
+           (not (bvecp x k))))
+
+;gen (replace n+1 with an arbitrary integer > n)?
+(defthm bvecp-expt-2-n
+  (implies (and (case-split (integerp n))
+                (case-split (<= 0 n))
+                )
+           (bvecp (expt 2 n) (+ 1 n))))
+
+;Can help in back-chaining (sometimes ACL2 will refuse to split an IF during backchaining). Imagine that ACL2
+;backchains to (bvecp (if test x y) k) and we know (bvecp x k) and (bvecp y k). ACL2 may fail to relieve the
+;hyp because it refuses to split into cases (due to some heuristics that limit the cost of backchaining). But
+;if this rule fires, both (bvecp x k) and (bvecp y k) can rewrite to T, and the hyp can be relieved.  (At
+;least, I think that's how this works.)
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
+
+
+; The following are analogous to mk-bvarr etc. in rtlarr.lisp.
+
+;better name?
+(defund mk-bvec (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bvecp r k) r 0))
+
+(defthm mk-bvec-is-bvecp
+  (bvecp (mk-bvec r k) k))
+
+(defthm mk-bvec-identity
+  (implies (bvecp r k)
+           (equal (mk-bvec r k) r)))
+
+;BOZO make a version to shift by a constant!
+(defthm bvecp-shift
+  (implies (and (integerp x) ;note!
+		(<= 0 m)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		)
+	   (equal (bvecp (* x (expt 2 m)) n)
+		  (bvecp x (- n m)))))
+
+(defthm bvecp-shift-alt
+  (implies (and (integerp x) ;note!
+		(<= 0 m)
+		(case-split (integerp m))
+		(case-split (integerp n))
+		)
+	   (equal (bvecp (* (expt 2 m) x) n)
+		  (bvecp x (- n m)))))
+
+;gen this!
+;BOZO will this unify (* 2 x) with 0??
+(defthm bvecp-shift-by-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops...
+                (integerp x)
+		(<= 0 m) ;gen?
+		(case-split (integerp m))
+		(case-split (integerp n))
+		)
+	   (equal (bvecp (* 2 x) n)
+		  (bvecp x (- n 1)))))
+
+
+;gen?
+;in general, rewrite (bvecp k n) where k is a constant to a fact about n
+(defthm bvecp-1
+  (implies (and (<= 1 n)
+                (integerp n))
+           (bvecp 1 n)))
+
+;n is a free variable
+;Disabled since may cause expensive backchaining.
+(defthmd natp-bvecp
+  (implies (bvecp x n)
+           (natp x))
+  :rule-classes ((:rewrite :match-free :once)))
+
+(defthmd bvecp-forward
+  (implies (bvecp x k)
+           (and (integerp x)
+                (<= 0 x)
+                (< x (expt 2 k)))) ;tigher-bound?
+  :rule-classes :forward-chaining)
+
+(defthm bvecp-product
+  (implies (and (bvecp x m)
+                (bvecp y n)
+                )
+           (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1))))
+
+;make another for not-equal-0 implies equal-1?
+(defthm bvecp-1-0
+    (implies (and (bvecp x 1)
+		  (not (equal x 1)))
+	     (equal x 0))
+  :rule-classes :forward-chaining)
+
+(defthm bvecp+1
+  (implies (and (natp n)
+                (bvecp x n))
+           (bvecp x (+ 1 n))))
+
+;same as bvecp-longer.decide which param names to use.  j and k??
+(defthmd bvecp-monotone
+    (implies (and (bvecp x n)
+		  (<= n m)
+                  (case-split (integerp m))
+                  )		  
+	     (bvecp x m)))
+
+
+;This bounds the amount of carry out that we can have from the sum.
+(defthm bvecp-sum-of-bvecps
+  (implies (and (bvecp x (1- k))
+                (bvecp y (1- k))
+                (case-split (integerp k)))
+           (bvecp (+ x y) k)))
+
+
+;add rule that (not (natp x)) implies (not (bvecp x k)) ??
+
+;exported in lib/
+(defthmd bvecp-0-1
+  (implies (and (bvecp x 1)
+                (not (equal x 0)))
+           (equal x 1))
+  :rule-classes :forward-chaining)
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/cat-def.lisp acl2-6.3/books/rtl/rel9/support/support/cat-def.lisp
--- acl2-6.2/books/rtl/rel9/support/support/cat-def.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/cat-def.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,112 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;don't include just this book unless you really mean it; this book contains no theorems about cat.  even the
+;type-prescription lemma generated about binary-cat in this book is poor.
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+#|
+;drop?
+(defund ocat (x y n)
+  (declare (xargs :guard t))
+  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
+|#
+
+; return 0 if m or n isn't a nat (change this bevahior?)
+(defund binary-cat (x m y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp m) (< 0 m)
+                              (integerp n) (< 0 n))
+                  :verify-guards nil))
+  (if (and (natp m) (natp n))
+      (+ (* (expt 2 n) (bits x (1- m) 0))
+         (bits y (1- n) 0))
+    0))
+
+;; The macro cat
+
+(defun formal-+ (x y)
+  ;;an auxiliary function that does not appear in translate-rtl output.
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(encapsulate
+ ()
+ (local ; for guard proof below
+  (defthm fold-constants-in-+
+    (implies (and (syntaxp (quotep x))
+                  (syntaxp (quotep y)))
+             (equal (+ x y z)
+                    (+ (+ x y) z)))))
+
+;;X is a list of alternating data values and sizes.  CAT-SIZE returns the
+;;formal sum of the sizes.  X must contain at least 1 data/size pair, but we do
+;;not need to specify this in the guard, and leaving it out of that guard
+;;simplifies the guard proof.
+
+ (defun cat-size (x)
+   ;;an auxiliary function that does not appear in translate-rtl output.
+   (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+   (if (endp (cddr x))
+       (cadr x)
+     (formal-+ (cadr x)
+               (cat-size (cddr x))))))
+
+;data and sizes alternate thus: (cat x xsize y ysize z zsize ...)  
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+;Allows things like (in-theory (disable cat)) to refer to binary-cat.
+(add-macro-alias cat binary-cat)
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/cat-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/cat-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/cat-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/cat-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1225 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+;(defund ocat (x y n)
+;  (declare (xargs :guard t))
+;  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(include-book "cat-def")
+(local (include-book "../../arithmetic/top")) ;try
+(local (include-book "bits"))
+(local (include-book "bvecp"))
+
+(local (in-theory (enable expt-minus)))
+
+#|
+Concatenate the M-bit value X onto the N-bit value Y.  X will occupy the high bits of the result.
+
+(cat x m y n) is well-defined only when the following predicate is true:
+
+(and (natp m)
+     (bvecp x m)
+     (natp n)
+     (bvecp y n))
+
+|#
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :hints (("Goal" :in-theory (enable cat)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+;disable?
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+                (case-split (integerp n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                )		  
+           (equal (cat 0 m y n) y))
+  :hints (("Goal" :in-theory (enable cat bits-tail))))
+
+;BOZO just use this one??
+(defthm cat-0-alt
+  (implies (and ;(case-split (bvecp y n))
+                (case-split (integerp n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                )		  
+           (equal (cat 0 m y n) (bits y (1- n) 0)))
+  :hints (("Goal" :in-theory (enable cat bits-tail))))
+
+;We can rely on bits-tail to complete the simplification down to x if desired.
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+         (bits x (1- m) 0))
+  :hints (("goal" :in-theory (enable cat))))
+
+(local (in-theory (enable bits-tail)))
+
+(defthm cat-with-n-0-alt
+ (implies (case-split (bvecp x m))
+           (equal (cat x m y 0)
+                  x)))
+
+;We can rely on bits-tail to complete the simplification down to y if desired.
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+         (bits y (1- n) 0))
+  :hints (("goal" :in-theory (enable cat))))
+
+(defthm cat-with-m-0-alt
+  (implies (case-split (bvecp y n))
+           (equal (cat x 0 y n)
+                  y)))
+
+;change this behavior??
+(defthm cat-with-n-not-a-natural
+  (implies (or (not (integerp n))
+               (< n 0))
+           (equal (cat x m y n)
+                  0))
+  :hints (("Goal" :in-theory (enable cat))))
+
+(defthm cat-with-m-not-a-natural
+  (implies (or (not (integerp m))
+               (< m 0))
+           (equal (cat x m y n)
+                  0))
+  :hints (("Goal" :in-theory (enable cat))))
+
+#|
+;used to transfer theorems about ocat to theorems about cat
+(defthmd cat-ocat
+    (equal (binary-cat x m y n)
+	   (if (or (not (integerp m))
+		   (< m 0)
+		   (not (integerp n))
+		   (< n 0)
+		   )
+	       0
+	     (ocat (bits x (1- m) 0)
+		   (bits y (1- n) 0)
+		   n)))
+  :hints (("Goal" :in-theory (enable ocat cat))))
+|#
+
+(local (defthm hack-10
+    (implies (and (integerp x)
+		  (integerp y)
+		  (< x y)
+                  )
+	     (<= x (1- y)))
+  :rule-classes ()))
+
+(defthm cat-bvecp-simple
+  (bvecp (cat x m y n) (+ m n))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bvecp cat expt-split)
+                              '(expt-compare EXPT-COMPARE-EQUAL ))
+		  :use ((:instance expt-split (i m) (j n) (r 2))
+			(:instance hack-10 (x (BITS X (1- M) 0)) (y (expt 2 m)))
+			(:instance expt-weak-monotone (m p))
+			(:instance expt-weak-monotone (m k) (n (+ m n)))))))
+
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k))
+  :hints (("Goal" :in-theory (disable cat-bvecp-simple)
+           :use cat-bvecp-simple)))
+
+#|
+
+these aren't right any more?
+
+(defthm cat-with-x-not-a-natural
+  (implies (or (not (integerp x))
+               (< x 0))
+           (equal (cat x m y n)
+                  0))
+  :hints (("Goal" :in-theory (enable cat))))
+
+(defthm cat-with-y-not-a-natural
+  (implies (or (not (integerp y))
+               (< y 0))
+           (equal (cat x y n)
+                  (* (nfix x) (expt 2 (nfix n)))))
+  :hints (("Goal" :in-theory (enable cat-ocat))))
+
+|#
+
+;move
+(defthm hack11
+ (implies (and (< x z)
+               (integerp x)
+               (integerp z)
+               (<= 0 y)
+               (< y 1))
+          (< (+ x y) z)))
+
+;move!
+(defthm expt-bound-hack
+ (implies (and (< y (expt 2 i))
+               (< x (expt 2 (- k i)))
+               (<= 0 x)
+               (<= 0 y)
+               (<= i k)
+               (integerp k)
+               (integerp i)
+               (integerp x)
+               (integerp y)
+               )
+          (< (+ y (* (expt 2 i) x)) (expt 2 k)))
+ :hints (("Goal" :in-theory (e/d ( expt-split expt-minus)
+                                 (LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE
+                                  LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE))
+          :use (:instance  mult-both-sides-of-<-by-positive (a (+ y (* x (expt 2 i)))) (b (expt 2 k))
+                           (c (/ (expt 2 i)))))) 
+ )
+
+
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p)) ;gen?
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 q))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p))
+                (case-split (integerp q))
+                )
+           (equal (cat (cat x m y n) p z q)
+                  (cat x m (cat y n z q) (+ n q))))
+  :hints (("Goal" :in-theory (enable cat))))
+
+;prove from something more general (cat-equal-split??)
+;BOZO move hyps to conclusion?
+(defthm cat-equal-0
+  (implies (and (case-split (bvecp x m))
+                (case-split (bvecp y n))
+                (case-split (natp n))
+                (case-split (natp m))
+                )
+           (equal (equal (cat x m y n) 0)
+                  (and (equal x 0)
+                       (equal y 0))))
+  :hints (("Goal" :in-theory (enable cat bits-tail bvecp)))
+  )
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p))
+                )
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+;allows r to be > n+p
+(defthm cat-combine-constants-gen
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep r)
+                              (quotep p)))
+                (case-split (<= (+ n p) r))
+                (case-split (bvecp y n))
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p))
+                (case-split (integerp r))
+                )
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y (+ r (- p))) (+ m r (- p)) z p)))
+  :hints (("goal" :in-theory (enable bits-tail)
+           :expand ((binary-cat y n z p)
+                           (binary-cat y (+ r (* -1 p)) z p)))))
+
+(defthm cat-constant-equal-constant-hack
+  (implies (and (syntaxp (and (quotep k1) (quotep k2)))
+                (case-split (bvecp x n))
+                (case-split (bvecp k1 m))
+                (case-split (rationalp k2))
+                (case-split (natp n))
+                (case-split (natp m))
+                )
+           (equal (equal (cat k1 m x n) k2)
+                  (equal x (- k2 (* (expt 2 n) k1)))))
+  :hints (("Goal" :in-theory (enable cat bvecp))))
+
+(defthm cat-upper-bound
+  (< (cat x m y n)
+     (expt 2 (+ m n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("goal"
+           :in-theory (set-difference-theories
+                       (enable cat)
+                       '()))))
+
+;perhaps the :linear rule cat-upper-bound is enough, but this may help stupid hyps be rewritten away
+(defthm cat-compare-to-constant-1
+  (implies (and (syntaxp (quotep k))
+                (<= (expt 2 (+ m n)) k))
+           (< (cat x m y n) k))
+  :hints (("goal" :in-theory (disable cat-upper-bound)
+           :use cat-upper-bound)))
+
+;provides a tighter bound
+(defthm cat-upper-bound-tight
+  (implies (and (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (<= (cat x m y n)
+               (1- (expt 2 (+ n m)))))
+  :hints (("goal" :use cat-upper-bound
+           :in-theory (set-difference-theories
+                       (enable)
+                       '(cat-upper-bound)))))
+
+
+(defthm cat-compare-to-constant-2
+  (implies (and (syntaxp (quotep k))
+                (<= (1- (expt 2 (+ m n))) k)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (not (< k (cat x m y n))))
+  :hints (("goal" :in-theory (disable cat-upper-bound)
+           :use cat-upper-bound)))
+
+;BOZO consider adding?
+;problem if we case-split something that turns out to be false?
+(defthm bits-with-i-not-an-integer-2
+  (implies (case-split (not (integerp i)))
+           (equal (bits x i j)
+                  0)))
+
+(defthm bits-with-j-not-an-integer-2
+  (implies (case-split (not (integerp j)))
+           (equal (bits x i j)
+                  0)))
+
+;also case-split that i>=j in any call to bits?
+
+
+;loops with bits-<-1
+;BOZO add theory invariant!
+;BOZO ask matt about parity..
+(defthmd bits-equal-0-to-bound
+  (equal (equal 0 (bits x i j))
+         (< (bits x i j) 1)))
+
+;we had a special case where j was 0, but I think this is better (it's certainly more general):
+;better name?
+;think about whether this can be proved without opening bits (including bits-plus-bits??)
+;prove bvecp-bits from this??
+;the regular bits-bvecp should fire first...
+(defthm bits-slice-zero-gen
+  (implies (and (case-split (<= 0 k))
+                (case-split (integerp k))
+                (case-split (integerp j))
+                )
+           (equal (bvecp (bits x i j) k)
+                  (equal 0 (bits x i (+ k j)))))
+  :otf-flg t
+  :hints (("Goal" :use (:instance bits-plus-bits (n i) (m j) (p (+ k j)))
+           :in-theory (e/d (bits-equal-0-to-bound bvecp expt-strong-monotone-linear) (bits-<-1)))))
+
+(encapsulate
+ ()
+
+ (local (defthm cat-bvecp-rewrite-case-1-a
+          (implies (and (<= n k) ;this case
+                        (< k (+ m n))
+                        (<= 0 n)
+                        (integerp k)
+                        (integerp n)
+                        )
+                   (implies (bvecp (cat x m y n) k)
+                            (bvecp (bits x (1- m) 0) (+ k (* -1 n))) ;the BITS call around x is weird but necessary
+                            ))
+          :rule-classes nil
+          :otf-flg t
+          :hints (("Goal" :in-theory (e/d (cat bvecp expt-split) ( expt-inverse  bits-slice-zero-gen))))))
+
+ (local (defthm cat-bvecp-rewrite-case-1-a-better
+          (implies (and (<= n k) ;this case
+                        (< k (+ m n))
+                        (<= 0 n)
+                        (integerp k)
+                        (integerp n)
+                        )
+                   (implies (bvecp (cat x m y n) k)
+                            (equal 0 (bits x (1- m) (+ k (* -1 n))))
+                            ))
+          :rule-classes nil
+          :otf-flg t
+          :hints (("Goal" :use  cat-bvecp-rewrite-case-1-a ))))
+
+;move!
+;this can help, especially when we aren't multiplying through by inverted factors
+ (defthm bits-upper-bound-new
+   (< (* (/ (expt 2 i)) (bits x (1- i) 0)) 1)
+   :hints (("Goal" :in-theory (disable expt-inverse)))
+   :rule-classes (:rewrite :linear)
+   )
+
+;make a lemma about bvecp of (+ (BITS Y (+ -1 N) 0) (* (EXPT 2 N) (BITS X (+ -1 M) 0))) ?
+ (local (defthm cat-bvecp-rewrite-case-1-b
+          (implies (and (<= n k) ;this case
+                        (< k (+ m n))
+                        (integerp k)
+                        )
+                   (implies (bvecp (bits x (1- m) 0) (- k n))
+                            (bvecp (cat x m y n) k))) ;the BITS call around x is weird but necessary?
+          :rule-classes nil
+          :hints (("Goal" :in-theory (e/d (cat bvecp expt-split
+                                               EXPT-minus
+                                               ) 
+                                          ( expt-inverse
+;these must be disabled, or  bits-upper-bound-new fails to do its job
+                                               LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE
+                                               LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE
+                                               ))))))
+
+
+
+ (local (defthm cat-bvecp-rewrite-case-1-b-better
+          (implies (and (<= n k) ;this case
+                        (< k (+ m n))
+                        (integerp k)
+                        )
+                   (implies (equal 0 (bits x (1- m) (+ k (* -1 n))))
+                            (bvecp (cat x m y n) k))) ;the BITS call around x is weird but necessary?
+          :rule-classes nil
+          :hints (("Goal":use  cat-bvecp-rewrite-case-1-b))))
+
+
+ (local (defthm cat-bvecp-rewrite-case-1
+          (implies (and (<= n k) ;this case
+                        (< k (+ m n))
+                        (case-split (<= 0 n))
+                        (case-split (integerp k))
+                        (case-split (integerp n))
+                        )
+                   (equal (bvecp (cat x m y n) k)
+                          (equal 0 (bits x (1- m) (+ k (* -1 n)))))) ;the BITS call around x is weird but necessary?
+          :hints (("Goal" :use ( cat-bvecp-rewrite-case-1-b-better  cat-bvecp-rewrite-case-1-a-better)))
+          ))
+
+
+
+
+
+ 
+ (local (defthm cat-bvecp-rewrite-case-2-a
+          (implies (and (< k n) ;this case
+                        (<= 0 k)
+                        (natp m) (natp n) (natp k)
+                        (integerp n)
+                        (integerp k)
+                        )
+                   (implies (bvecp (cat x m y n) k)
+                            (and (equal (bits x (1- m) 0) 0)
+                                 (bvecp (bits y (1- n) 0) k))))
+          :rule-classes nil
+          :otf-flg t
+          :hints (("Goal"
+                   :use (
+                         )
+                   :in-theory (e/d (cat bvecp bits-equal-0-to-bound expt-strong-monotone-linear) (bits-<-1
+                                                                                                  BITS-SLICE-ZERO-GEN
+                                                                                                  ))))))
+
+
+ (local (defthm cat-bvecp-rewrite-case-2-a-better
+          (implies (and (< k n) ;this case
+                        (<= 0 k)
+                        (<= 0 m)
+                        (integerp m)
+                        (integerp n)
+                        (integerp k)
+                        )
+                   (implies (bvecp (cat x m y n) k)
+                            (and (equal 0 (bits x (1- m) 0))
+                                 (equal 0 (bits y (1- n) k)))))
+          :rule-classes nil
+          :otf-flg t
+          :hints (("Goal"
+                   :use (cat-bvecp-rewrite-case-2-a)))))
+
+ (local (defthm cat-bvecp-rewrite-case-2-b
+          (implies (and (< k n) ;this case
+                        (<= 0 k)
+                        (integerp n)
+                        (integerp k)
+                        )
+                   (implies (and (equal (bits x (1- m) 0) 0)
+                                 (bvecp (bits y (1- n) 0) k))
+                            (bvecp (cat x m y n) k)))
+          :rule-classes nil
+          :otf-flg t
+          :hints (("Goal"
+                   :use (
+                         )
+                   :in-theory (e/d (cat
+                                    bits-equal-0-to-bound
+                                    expt-strong-monotone-linear
+                                    bvecp expt-split)
+                                   (;CANCEL-IN-PRODS-<-1-OF-2-WITH-1-OF-1
+                                    ;CANCEL-TIMES-<-ERIC-1-BETTER-ALT
+                                    bits-<-1
+                                    
+                                    expt-inverse
+                                    BITS-SLICE-ZERO-GEN))))))
+
+ (local (defthm cat-bvecp-rewrite-case-2-b-better
+          (implies (and (< k n) ;this case
+                        (<= 0 k)
+                        (integerp n)
+                        (integerp k)
+                        )
+                   (implies (and (equal (bits x (1- m) 0) 0)
+                                 (equal 0 (bits y (1- n) k)))
+                            (bvecp (cat x m y n) k)))
+          :rule-classes nil
+          :otf-flg t
+          :hints (("Goal"
+                   :use (cat-bvecp-rewrite-case-2-b)))))
+
+ (local (defthm cat-bvecp-rewrite-case-2
+          (implies (and (< k n) ;this case
+                        (<= 0 k)
+                        (<= 0 m)
+                        (integerp m)
+                        (integerp n)
+                        (integerp k)
+                        )
+                   (equal (bvecp (cat x m y n) k)
+                          (and (equal 0 (bits x (1- m) 0))
+                               (equal 0 (bits y (1- n) k)))))
+          :otf-flg t
+          :hints (("Goal"
+                   :use (cat-bvecp-rewrite-case-2-a-better
+                         cat-bvecp-rewrite-case-2-b-better
+                         )
+                   :in-theory (e/d () ())))))
+
+ (defthmd cat-bvecp-rewrite
+   (implies (and (case-split (<= 0 k))
+                 (case-split (<= 0 n))
+                 (case-split (<= 0 m))
+                 (case-split (integerp n)) 
+                 (case-split (integerp m)) 
+                 (case-split (integerp k)) 
+                 )
+            (equal (bvecp (cat x m y n) k)
+                   (if (<= (+ m n) k)
+                       t
+                     (if (<= n k)
+                         (equal 0 (bits x (1- m) (+ k (* -1 n))))                      
+                       (and (equal 0 (bits x (1- m) 0))
+                            (equal 0 (bits y (1- n) k))))))))
+
+ ) ;end the encapsulate
+
+(defthm cat-bvecp-rewrite-constants
+  (implies (and (syntaxp (and (quotep k) (quotep m) (quotep n)))
+                (case-split (<= 0 k))
+                (case-split (<= 0 n))
+                (case-split (<= 0 m))
+                (case-split (integerp n)) 
+                (case-split (integerp m)) 
+                (case-split (integerp k)) 
+                )
+           (equal (bvecp (cat x m y n) k)
+                  (if (<= (+ m n) k)
+                      t
+                    (if (<= n k)
+                        (equal 0 (bits x (1- m) (+ k (* -1 n))))                      
+                      (and (equal 0 (bits x (1- m) 0))
+                           (equal 0 (bits y (1- n) k)))))))
+  :hints (("Goal" :by cat-bvecp-rewrite)))
+
+
+#|
+Art's example:
+
+(thm (implies (and (natp i) (natp m) (natp n) (bvecp x i))
+              (bvecp (cat x m y n) (+ i n)))
+     )
+|#
+
+;k is a free variable.
+;There is no real analogue of this for y (that is, we can't change n to something smaller).
+(defthm cat-tighten-x
+  (implies (and (bvecp x k) ;k becomes bound here
+                (< k m) ;if k=m, this rule can loop
+                (case-split (<= 0 k))
+                (case-split (integerp k))
+                (case-split (integerp m))
+                )
+           (equal (cat x m y n)
+                  (cat x k y n)))
+  :hints (("Goal" :in-theory (enable cat))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(defthm cat-equal-y
+  (implies (and (bvecp y (+ m n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n)))
+           (equal (equal y (binary-cat x m y n))
+                  (equal (bits y (+ -1 m n) n)
+                         (bits x (1- m) 0))))
+  :hints (("Goal" :in-theory (enable cat a15)
+           :use (:instance bits-plus-bits (x y) (n  (+ -1 m n)) (m 0) (p n))))
+  )
+
+(defthm cat-equal-y-alt
+  (implies (and (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n)))
+           (equal (equal y (binary-cat x m y n))
+                  (if (bvecp y (+ m n))
+                      (equal (bits y (+ -1 m n) n)
+                             (bits x (1- m) 0))
+                    nil)))
+  :hints (("Goal" :in-theory (disable  cat-equal-y)
+           :use  cat-equal-y))
+)
+
+(defthm cat-equal-bits-of-y
+  (implies (and; (case-split (bvecp y n))
+;                (case-split (bvecp x m))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n)))
+           (equal (equal (bits y (1- n) 0) (binary-cat x m y n))
+                  (equal (bits x (1- m) 0) 0)))
+  :hints (("goal" :in-theory (enable binary-cat)))
+   )
+
+;requires y to be a bvecp of length n
+;drop this one?
+(defthm cat-equal-y-special
+  (implies (and (case-split (bvecp y n))
+                (case-split (integerp m))
+                (case-split (<= 0 m)) ;gen!
+                (case-split (integerp n))
+                (case-split (<= 0 n)))
+           (equal (equal y (binary-cat x m y n))
+                  (equal 0 (bits x (1- m) 0))))
+  :hints (("Goal" :use cat-equal-bits-of-y)) ;drop this hint
+  )
+
+;enable?
+;make into 2 separate lemmas (can drop the bits from x or from y)
+(defthmd cat-ignores-bits
+  (equal (cat (bits x (1- m) 0)
+              m (bits y (1- n) 0)
+              n)
+         (cat x m y n))
+  :hints (("goal" :in-theory (enable cat))))
+
+(defthmd bits-cat-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (bits y i j)))
+  :hints (("Goal" :in-theory (enable cat))))
+
+;move!
+
+
+(defthmd bits-cat-2-1
+  (implies (and (<= n j) ;case 2
+                (< i (+ m n))  ;case 2-1
+                (case-split (natp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (natp m))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (bits x (- i n) (- j n))))
+  :hints (("Goal" :in-theory (enable cat))))
+
+(defthmd bits-cat-2-2
+  (implies (and (<= n j)  ;case 2
+                (<= (+ m n) i)  ;case 2-1
+                (case-split (natp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (natp m))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (bits x (+ m -1) (- j n))))
+  :hints (("Goal" :in-theory (enable cat)))
+  )
+
+;note the IF in the conclusion
+(defthmd bits-cat-2
+  (implies (and (<= n j)  ;case 2
+                (case-split (natp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (natp m))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (bits x (if (< i (+ m n))
+                              (- i n)
+                            (1- m))
+                        (- j n))))
+  :hints (("Goal" :in-theory (enable cat)))
+  )
+
+
+;Note the IF in the conclusion
+(defthmd bits-cat-3
+  (implies (and (>= i n)
+                (< j n)
+                (case-split (natp n))
+                (case-split (natp m))
+                (case-split (natp i))
+                (case-split (natp j))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (cat (bits x (if (< i (+ m n))
+                                    (- i n)
+                                  (1- m))
+                              0)
+                        (+ 1 (- i n))
+                        (bits y (1- n) j)
+                        (- n j))))
+  :hints (("Goal" :use (:instance bits-plus-bits (x (cat x m y n)) (p n) (n i) (m j))
+           :in-theory (enable cat   bits-plus-mult-1))))
+
+;includes both bits-cat-1, bits-cat-2, and bits-cat-3
+;we expect the indices to be constants, so this won't cause case-splits
+;gen
+(defthm bits-cat
+  (implies (and (case-split (natp n))
+                (case-split (natp m))
+                (case-split (natp i))
+                (case-split (natp j)))
+           (equal (bits (cat x m y n) i j)
+                  (if (< i n)
+                      (bits y i j)
+                    (if (>= j n)
+                        (bits x (if (< i (+ m n))
+                                    (- i n)
+                                  (1- m)) 
+                              (- j n))
+                      (cat (bits x (if (< i (+ m n))
+                                        (- i n)
+                                      (1- m)) 0)
+                            (+ 1 (- i n))
+                            (bits y (1- n) j)
+                            (- n j))))))
+  :hints (("Goal" :in-theory (enable bits-cat-1
+                                     bits-cat-2
+                                     bits-cat-3))))
+
+;The following trivial corollary of bits-cat is worth keeping enabled.
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+                (syntaxp (quotep m))
+                (syntaxp (quotep i))
+                (syntaxp (quotep j))
+                (natp n)
+                (natp m)
+                (natp i)
+                (natp j))
+           (equal (bits (cat x m y n) i j)
+                  (if (< i n)
+                      (bits y i j)
+                    (if (>= j n)
+                        (bits x (if (< i (+ m n))
+                                    (- i n)
+                                  (1- m)) 
+                              (- j n))
+                      (cat (bits x (if (< i (+ m n))
+                                       (- i n)
+                                     (1- m)) 0)
+                           (+ 1 (- i n))
+                           (bits y (1- n) j)
+                           (- n j)))))))
+
+;bitn-cat should be all we need for simplifying (bitn (cat...))
+(defthmd bitn-cat-1
+  (implies (and (< i n)
+                (case-split (natp n))
+                (case-split (natp m))
+                (case-split (natp i))
+                )
+           (equal (bitn (cat x m y n) i)
+                  (bitn y i)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn bits-cat-1)
+                              '()))))
+
+;bitn-cat should be all we need for simplifying (bitn (cat...))
+(defthmd bitn-cat-2
+  (implies (and (>= i n)
+                (case-split (natp n))
+                (case-split (natp m))
+                (case-split (integerp i))
+                )
+           (equal (bitn (cat x m y n) i)
+                  (if (< i (+ m n))
+                      (bitn x (- i n))
+                    0)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn)
+                              '()))))
+
+;includes both bitn-cat-1 and bitn-cat-2
+(defthm bitn-cat
+  (implies (and (case-split (natp n))
+                (case-split (natp m))
+                (case-split (natp i)))
+           (equal (bitn (cat x m y n) i)
+                  (if (< i n)
+                      (bitn y i)
+                    (if (< i (+ m n))
+                      (bitn x (- i n))
+                    0))))
+  :hints (("Goal" :in-theory (enable bitn-cat-1
+                                     bitn-cat-2))))
+
+;The following trivial corollary of bitn-cat is worth keeping enabled.
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+                (syntaxp (quotep m))
+                (syntaxp (quotep i))
+                (natp n)
+                (natp m)
+                (natp i))
+           (equal (bitn (cat x m y n) i)
+                  (if (< i n)
+                      (bitn y i)
+                    (if (< i (+ m n))
+                      (bitn x (- i n))
+                    0)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+                (equal n (+ 1 (- l) k))
+                (case-split (<= (+ 1 (- j) i) m))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (integerp i))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                (case-split (integerp m))
+                )
+           (equal (cat (bits x i j) m (bits x k l) n)
+                  (bits x i l)))
+  :hints (("Goal" :in-theory (enable cat)
+           :use ((:instance bits-plus-bits (n i) (p j) (m l))))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (+ 1 k))
+		  (equal n (+ 1 (- l) k))
+                  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+                  (case-split (integerp k))
+                  (case-split (integerp l))
+                  (case-split (integerp m))
+		  )
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l)))
+    :hints (("Goal" :in-theory (enable bitn))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (+ 1 k))
+                (case-split (<= (+ 1 (- j) i) m))
+                (case-split (<= j i))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp m))
+                )
+           (equal (cat (bits x i j) m (bitn x k) 1)
+                  (bits x i k)))
+  :hints (("Goal" :in-theory (enable bitn))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (+ 1 j))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (cat (bitn x i) 1 (bitn x j) 1)
+                  (bits x i j)))
+  :hints (("Goal" :in-theory (enable bitn))))
+
+
+
+
+;may not want this enabled (but probably do want CAT-EQUAL-CONSTANT enabled)
+;the BITS calls around X and Y in the conclusion allow us to drop the hyps that X and Y are bvecps.
+(defthmd cat-split-equality
+  (implies (and (case-split (bvecp k (+ m n))) ;if not, K can't be equal to the CAT expression
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n))
+                )
+           (equal (equal k (cat x m y n))
+                  (and (equal (bits y (1- n) 0) (bits k (1- n) 0))
+                       (equal (bits x (1- m) 0) (bits k (+ -1 m n) n)))))
+  :hints (("Goal" :in-theory (enable cat-ignores-bits)
+           :use ((:instance cat-bits-bits (x  (cat x m y n)) (i (+ -1 m n)) (j n) (k (+ -1 n)) (l 0))))))
+
+
+
+;generalize this by dropping the bvecp-hyps and wrapping bits around x and y in the conclusion?
+;follows trivially from   cat-split-equality
+;prove a version of this without the bvecp hyps?
+(defthm cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep m)
+                              (quotep n)))
+                (case-split (bvecp y n))
+                (case-split (bvecp x m))
+                (case-split (< k (expt 2 (+ m n)))) ;drop!
+                (case-split (integerp k))
+                (case-split (<= 0 k))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n))
+                )
+           (equal (equal k (cat x m y n))
+                  (and (equal y (bits k (1- n) 0))
+                       (equal x (bits k (+ -1 m n) n)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable cat-split-equality))))
+
+;lacks the bvecp hyps.  do we want this or cat-equal-rewrite?
+(defthm cat-equal-rewrite-alt
+  (implies (and (case-split (natp n))
+                (case-split (natp m))
+                )
+           (equal (equal (cat x1 m y1 n)
+                         (cat x2 m y2 n))
+                  (and (equal (bits x1 (1- m) 0) (bits x2 (1- m) 0))
+                       (equal (bits y1 (1- n) 0) (bits y2 (1- n) 0)))))
+  :hints (("Goal" :in-theory (enable cat-split-equality))))
+
+;move hyps to conclusion?
+(defthm cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+                (case-split (bvecp y1 n))
+                (case-split (bvecp x2 m))
+                (case-split (bvecp y2 n))
+                (case-split (integerp n))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                )
+           (equal (equal (cat x1 m y1 n)
+                         (cat x2 m y2 n))
+                  (and (equal x1 x2)
+                       (equal y1 y2))))
+  :hints (("Goal" :in-theory (enable cat-split-equality))))
+
+(defthm cat-bits-bits-bits
+  (implies (and (<= k i)
+                (<= l k)
+                (<= j l)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (integerp l)
+                )
+           (equal (cat (bits x i (+ 1 k))
+                       (+ 2 i (- k))
+                       (cat (bits x k l)
+                            (+ 1 k (- l))
+                            (bits x (1- l) j)
+                            (+ l (- j)))
+                       (+ 1 (- j) k))
+                  (bits x i j)))
+  :rule-classes nil)
+
+#|
+bits-dont-match can prove things like this:
+(thm (IMPLIES (EQUAL 7 (BITS x 8 6))
+              (NOT (EQUAL 3 (BITS x 15 6)))))
+|#
+
+(defthm bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+                              (quotep j)
+                              (quotep k)))
+                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+                (syntaxp (and (quotep i2)
+                              (quotep j2)
+                              (quotep k2)))
+                (<= j2 j) (<= j i) (<= i i2)
+                (not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
+                )
+           (equal (equal k (bits x i j))
+                  nil))
+  :otf-flg t
+  :hints (("Goal" :in-theory ( set-difference-theories
+                               (enable)
+                              '( cat-bits-bits))
+           :use (:instance cat-bits-bits-bits 
+                           (i i2)
+                           (j j2)
+                           (k (+ i (- j2)))
+                           (l (+ j (- j2)))))))
+
+(defthm bits-match
+  (implies (and (syntaxp (and (quotep i)
+                              (quotep j)
+                              (quotep k)))
+                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+                (syntaxp (and (quotep i2)
+                              (quotep j2)
+                              (quotep k2)))
+                (<= j2 j) (<= j i) (<= i i2)
+                (equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
+                )
+           (equal (equal k (bits x i j))
+                  t))
+  :otf-flg t
+  :hints (("Goal" :in-theory ( set-difference-theories
+                               (enable)
+                              '( cat-bits-bits))
+           :use (:instance cat-bits-bits-bits 
+                           (i i2)
+                           (j j2)
+                           (k (+ i (- j2)))
+                           (l (+ j (- j2)))))))
+
+
+;make into a rewrite rule
+(defthm cat-with-slice-of-x-equal-x
+  (implies (and (bvecp x (+ m n))
+                (case-split (bvecp y n))
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (equal x (cat (bits x (+ -1 m n) n) m y n))
+                  (equal (bits x (1- n) 0) y))
+           )
+  :hints (("Goal" :in-theory (disable CAT-BITS-BITS
+                                      BITS-SPLIT-AROUND-ZERO)
+           :use (:instance cat-bits-bits (i (+ -1 m n)) (l 0) (j n) (k (+ -1 n))))))
+
+;cat-with-slice-of-x-equal-x won't match, so we use kk here
+;add a syntaxp hyp?
+(defthm cat-with-slice-of-x-equal-x-rewrite
+  (implies (and (equal kk (+ -1 m n))
+                (bvecp x (+ m n))
+                (case-split (bvecp y n))
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (equal x (cat (bits x kk n) m y n))
+                  (equal (bits x (1- n) 0) y))
+           )
+  :hints (("Goal" :in-theory (disable CAT-BITS-BITS
+                                      BITS-SPLIT-AROUND-ZERO)
+           :use (:instance cat-bits-bits (i (+ -1 m n)) (l 0) (j n) (k (+ -1 n))))))
+
+;If X and Y have identical bits in the range [i..j], then they also match on any subrange [k..l] of [i..j]
+(defthmd bits-equal-implies-subranges-equal-helper
+  (implies (and (equal (bits x i j) (bits y i j))
+                (<= j l)
+                (<= k i)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (equal (bits x k l) (bits y k l))
+                  t))
+  :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :in-theory (disable cat-bits-bits cat-equal-rewrite cat-equal-rewrite-alt)
+           :use ((:instance cat-equal-rewrite
+                            (x1 (BITS X K L))
+                            (y1 (BITS X (+ -1 L) J))
+                            (x2 (BITS Y K L))
+                            (y2 (BITS Y (+ -1 L) J))
+                            (m (+ 1 k (* -1 l)))
+                            (n (+ L (* -1 J))))
+                 (:instance cat-equal-rewrite
+                            (x1 (BITS X I (+ 1 K)))
+                            (y1 (CAT (BITS X K L)
+                                     (+ 1 k (* -1 l))
+                                     (BITS X (+ -1 L) J)
+                                     (+ L (* -1 J))))
+                            (x2 (BITS Y I (+ 1 K)))
+                            (y2 (CAT (BITS Y K L)
+                                      (+ 1 k (* -1 l))
+                                     (BITS Y (+ -1 L) J)
+                                     (+ L (* -1 J))))
+                            (m (+ 2 i (* -1 k)))
+                            (n (+ 1 K (* -1 J))))
+                 (:instance cat-bits-bits-bits (x x))
+                 (:instance cat-bits-bits-bits (x y)))
+           )))
+
+(defthm bits-equal-implies-subranges-equal
+  (implies (and (equal (bits x i j) (bits y i j))
+                (<= j l)
+                (<= k i)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (equal (bits x k l) (bits y k l))
+                  t))
+  :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :use ( bits-equal-implies-subranges-equal-helper)
+           )))
+
+
+#|
+
+(thm
+ (implies (and (integerp m) (integerp n) (<= 0 m) (<= 0 n) (bvecp x m)
+                (bvecp y n))
+          (equal (EQUAL (BINARY-CAT X M Y N) X)
+                 (or (equal y 0) (equal n 0))))
+ :hints (("Goal" :in-theory (enable binary-cat bvecp))))
+
+;keep disabled?
+(defthm cat-when-bits-of-x-are-0
+  (implies (and (EQUAL (BITS X (1- M) 0) 0)
+                (integerp m)
+                (<= 0 m))
+           (equal (cat x m y n)
+                  (bits y (+ -1 n) 0))))
+|# ; |
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/cat.lisp acl2-6.3/books/rtl/rel9/support/support/cat.lisp
--- acl2-6.2/books/rtl/rel9/support/support/cat.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/cat.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,805 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;; Necessary defuns
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(include-book "cat-def")
+
+; "Definition" used in the library for the purpose of documentation.
+(defthm cat-def
+  (implies (and (natp m) (natp n))
+           (equal (cat x m y n)
+                  (+ (* (expt 2 n) (bits x (1- m) 0))
+                     (bits y (1- n) 0))))
+  :hints (("Goal" :in-theory (enable cat)))
+  :rule-classes nil)
+
+(local (include-book "cat-proofs"))
+
+#|
+Concatenate the M-bit value X onto the N-bit value Y.  X will occupy the high bits of the result.
+
+(cat x m y n) is well-defined only when the following predicate is true:
+
+(and (natp m)
+     (bvecp x m)
+     (natp n)
+     (bvecp y n))
+
+|#
+
+;; New stuff
+
+(defthm cat-nonnegative-integer-type
+  (and (integerp (cat x m y n))
+       (<= 0 (cat x m y n)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than cat-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-cat)))
+
+;just a rewrite rule
+(defthm cat-natp
+  (natp (cat x m y n)))
+
+;bozo disable? drop bvecp hyp and wrap bits around conclusion??
+(defthm cat-0
+  (implies (and (case-split (bvecp y n))
+                (case-split (integerp n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                )		  
+           (equal (cat 0 m y n) y)))
+
+;BOZO just use this one??
+(defthm cat-0-alt
+  (implies (and ;(case-split (bvecp y n))
+                (case-split (integerp n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                )		  
+           (equal (cat 0 m y n) (bits y (1- n) 0))))
+
+;We can rely on bits-tail to complete the simplification down to x if desired.
+(defthm cat-with-n-0
+  (equal (binary-cat x m y 0)
+         (bits x (1- m) 0)))
+
+;bozo disable?
+(defthm cat-with-n-0-alt
+  (implies (case-split (bvecp x m))
+           (equal (cat x m y 0)
+                  x)))
+
+;We can rely on bits-tail to complete the simplification down to y if desired.
+(defthm cat-with-m-0
+  (equal (binary-cat x 0 y n)
+         (bits y (1- n) 0)))
+
+;bozo disable?
+(defthm cat-with-m-0-alt
+  (implies (case-split (bvecp y n))
+           (equal (cat x 0 y n)
+                  y)))
+
+;change this behavior?? no, it makes for a nice setbits bvecp lemma
+(defthm cat-with-n-not-a-natural
+  (implies (or (not (integerp n))
+               (< n 0))
+           (equal (cat x m y n)
+                  0)))
+
+(defthm cat-with-m-not-a-natural
+  (implies (or (not (integerp m))
+               (< m 0))
+           (equal (cat x m y n)
+                  0)))
+
+(defthm cat-bvecp-simple
+  (bvecp (cat x m y n) (+ m n)))
+
+(defthm cat-bvecp
+  (implies (and (<= (+ m n) k)
+                (case-split (integerp k)))
+           (bvecp (cat x m y n) k)))
+
+(defthm cat-associative
+  (implies (and (case-split (<= (+ m n) p)) ;gen?
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 q))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p))
+                (case-split (integerp q))
+                )
+           (equal (cat (cat x m y n) p z q)
+                  (cat x m (cat y n z q) (+ n q)))))
+
+;prove from something more general (cat-equal-split??)
+;BOZO move hyps to conclusion?
+(defthm cat-equal-0
+  (implies (and (case-split (bvecp x m))
+                (case-split (bvecp y n))
+                (case-split (natp n))
+                (case-split (natp m))
+                )
+           (equal (equal (cat x m y n) 0)
+                  (and (equal x 0)
+                       (equal y 0)))))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p))
+                )
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+;allows r to be > n+p
+;perhaps we only want this one, not cat-combine-constants ??
+(defthm cat-combine-constants-gen
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep r)
+                              (quotep p)))
+                (case-split (<= (+ n p) r)) ;other case?
+                (case-split (bvecp y n)) ;BOZO instead put bits in the conclusion?
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p))
+                (case-split (integerp r))
+                )
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y (+ r (- p))) (+ m r (- p)) z p))))
+
+(defthm cat-constant-equal-constant-hack
+  (implies (and (syntaxp (and (quotep k1) (quotep k2)))
+                (case-split (bvecp x n))
+                (case-split (bvecp k1 m))
+                (case-split (rationalp k2))
+                (case-split (natp n))
+                (case-split (natp m))
+                )
+           (equal (equal (cat k1 m x n) k2)
+                  (equal x (- k2 (* (expt 2 n) k1))))))
+
+(defthm cat-upper-bound
+  (< (cat x m y n)
+     (expt 2 (+ m n)))
+  :rule-classes (:rewrite :linear))
+
+;perhaps the :linear rule cat-upper-bound is enough, but this may help stupid hyps be rewritten away
+(defthm cat-compare-to-constant-1
+  (implies (and (syntaxp (quotep k))
+                (<= (expt 2 (+ m n)) k))
+           (< (cat x m y n) k)))
+
+;provides a tighter bound
+(defthm cat-upper-bound-tight
+  (implies (and (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (<= (cat x m y n)
+               (1- (expt 2 (+ n m))))))
+
+
+(defthm cat-compare-to-constant-2
+  (implies (and (syntaxp (quotep k))
+                (<= (1- (expt 2 (+ m n))) k)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (not (< k (cat x m y n)))))
+
+;BOZO consider adding?
+;problem if we case-split something that turns out to be false?
+(defthm bits-with-i-not-an-integer-2
+  (implies (case-split (not (integerp i)))
+           (equal (bits x i j)
+                  0)))
+
+(defthm bits-with-j-not-an-integer-2
+  (implies (case-split (not (integerp j)))
+           (equal (bits x i j)
+                  0)))
+
+;also case-split that i>=j in any call to bits?
+
+
+;loops with bits-<-1
+;BOZO add theory invariant!
+;BOZO ask matt about parity..
+(defthmd bits-equal-0-to-bound
+  (equal (equal 0 (bits x i j))
+         (< (bits x i j) 1)))
+
+;we had a special case where j was 0, but I think this is better (it's certainly more general):
+;better name?
+;think about whether this can be proved without opening bits (including bits-plus-bits??)
+;prove bvecp-bits from this??
+;the regular bits-bvecp should fire first...
+(defthm bits-slice-zero-gen
+  (implies (and (case-split (<= 0 k))
+                (case-split (integerp k))
+                (case-split (integerp j))
+                )
+           (equal (bvecp (bits x i j) k)
+                  (equal 0 (bits x i (+ k j))))))
+
+;move!
+;this can help, especially when we aren't multiplying through by inverted factors
+(defthm bits-upper-bound-new
+  (< (* (/ (expt 2 i)) (bits x (1- i) 0)) 1)
+  :rule-classes (:rewrite :linear)
+   )
+
+ (defthmd cat-bvecp-rewrite
+   (implies (and (case-split (<= 0 k))
+                 (case-split (<= 0 n))
+                 (case-split (<= 0 m))
+                 (case-split (integerp n)) 
+                 (case-split (integerp m)) 
+                 (case-split (integerp k)) 
+                 )
+            (equal (bvecp (cat x m y n) k)
+                   (if (<= (+ m n) k)
+                       t
+                     (if (<= n k)
+                         (equal 0 (bits x (1- m) (+ k (* -1 n))))                      
+                       (and (equal 0 (bits x (1- m) 0))
+                            (equal 0 (bits y (1- n) k))))))))
+
+(defthm cat-bvecp-rewrite-constants
+  (implies (and (syntaxp (and (quotep k) (quotep m) (quotep n)))
+                (case-split (<= 0 k))
+                (case-split (<= 0 n))
+                (case-split (<= 0 m))
+                (case-split (integerp n)) 
+                (case-split (integerp m)) 
+                (case-split (integerp k)) 
+                )
+           (equal (bvecp (cat x m y n) k)
+                  (if (<= (+ m n) k)
+                      t
+                    (if (<= n k)
+                        (equal 0 (bits x (1- m) (+ k (* -1 n))))                      
+                      (and (equal 0 (bits x (1- m) 0))
+                           (equal 0 (bits y (1- n) k))))))))
+
+;k is a free variable.
+;There is no real analogue of this for y (that is, we can't change n to something smaller).
+(defthm cat-tighten-x
+  (implies (and (bvecp x k) ;k becomes bound here
+                (< k m) ;if k=m, this rule can loop
+                (case-split (<= 0 k))
+                (case-split (integerp k))
+                (case-split (integerp m))
+                )
+           (equal (cat x m y n)
+                  (cat x k y n))))
+
+(defthm cat-equal-y
+  (implies (and (bvecp y (+ m n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n)))
+           (equal (equal y (binary-cat x m y n))
+                  (equal (bits y (+ -1 m n) n)
+                         (bits x (1- m) 0)))))
+
+(defthm cat-equal-y-alt
+  (implies (and (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n)))
+           (equal (equal y (binary-cat x m y n))
+                  (if (bvecp y (+ m n))
+                      (equal (bits y (+ -1 m n) n)
+                             (bits x (1- m) 0))
+                    nil))))
+
+(defthm cat-equal-bits-of-y
+  (implies (and; (case-split (bvecp y n))
+;                (case-split (bvecp x m))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n)))
+           (equal (equal (bits y (1- n) 0) (binary-cat x m y n))
+                  (equal (bits x (1- m) 0) 0))))
+
+;requires y to be a bvecp of length n
+;drop this one?
+(defthm cat-equal-y-special
+  (implies (and (case-split (bvecp y n))
+                (case-split (integerp m))
+                (case-split (<= 0 m)) ;gen!
+                (case-split (integerp n))
+                (case-split (<= 0 n)))
+           (equal (equal y (binary-cat x m y n))
+                  (equal 0 (bits x (1- m) 0)))))
+
+;enable?
+;make into 2 separate lemmas (can drop the bits from x or from y)
+(defthmd cat-ignores-bits
+  (equal (cat (bits x (1- m) 0)
+              m (bits y (1- n) 0)
+              n)
+         (cat x m y n)))
+
+(defthmd bits-cat-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (bits y i j))))
+
+(defthmd bits-cat-2-1
+  (implies (and (<= n j) ;case 2
+                (< i (+ m n))  ;case 2-1
+                (case-split (natp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (natp m))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (bits x (- i n) (- j n)))))
+
+(defthmd bits-cat-2-2
+  (implies (and (<= n j)  ;case 2
+                (<= (+ m n) i)  ;case 2-1
+                (case-split (natp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (natp m))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (bits x (+ m -1) (- j n)))))
+
+;note the IF in the conclusion
+(defthmd bits-cat-2
+  (implies (and (<= n j)  ;case 2
+                (case-split (natp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (natp m))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (bits x (if (< i (+ m n))
+                              (- i n)
+                            (1- m))
+                        (- j n)))))
+
+
+;Note the IF in the conclusion
+(defthmd bits-cat-3
+  (implies (and (>= i n)
+                (< j n)
+                (case-split (natp n))
+                (case-split (natp m))
+                (case-split (natp i))
+                (case-split (natp j))
+                )
+           (equal (bits (cat x m y n) i j)
+                  (cat (bits x (if (< i (+ m n))
+                                    (- i n)
+                                  (1- m))
+                              0)
+                        (+ 1 (- i n))
+                        (bits y (1- n) j)
+                        (- n j)))))
+
+;includes both bits-cat-1, bits-cat-2, and bits-cat-3
+;we expect the indices to be constants, so this won't cause case-splits
+;gen
+(defthm bits-cat
+  (implies (and (case-split (natp n))
+                (case-split (natp m))
+                (case-split (natp i))
+                (case-split (natp j)))
+           (equal (bits (cat x m y n) i j)
+                  (if (< i n)
+                      (bits y i j)
+                    (if (>= j n)
+                        (bits x (if (< i (+ m n))
+                                    (- i n)
+                                  (1- m)) 
+                              (- j n))
+                      (cat (bits x (if (< i (+ m n))
+                                        (- i n)
+                                      (1- m)) 0)
+                            (+ 1 (- i n))
+                            (bits y (1- n) j)
+                            (- n j)))))))
+
+;The following trivial corollary of bits-cat is worth keeping enabled.
+
+(defthm bits-cat-constants
+  (implies (and (syntaxp (quotep n))
+                (syntaxp (quotep m))
+                (syntaxp (quotep i))
+                (syntaxp (quotep j))
+                (natp n)
+                (natp m)
+                (natp i)
+                (natp j))
+           (equal (bits (cat x m y n) i j)
+                  (if (< i n)
+                      (bits y i j)
+                    (if (>= j n)
+                        (bits x (if (< i (+ m n))
+                                    (- i n)
+                                  (1- m)) 
+                              (- j n))
+                      (cat (bits x (if (< i (+ m n))
+                                       (- i n)
+                                     (1- m)) 0)
+                           (+ 1 (- i n))
+                           (bits y (1- n) j)
+                           (- n j)))))))
+
+;bitn-cat should be all we need for simplifying (bitn (cat...))
+(defthmd bitn-cat-1
+  (implies (and (< i n)
+                (case-split (natp n))
+                (case-split (natp m))
+                (case-split (natp i))
+                )
+           (equal (bitn (cat x m y n) i)
+                  (bitn y i))))
+
+;bitn-cat should be all we need for simplifying (bitn (cat...))
+(defthmd bitn-cat-2
+  (implies (and (>= i n)
+                (case-split (natp n))
+                (case-split (natp m))
+                (case-split (integerp i))
+                )
+           (equal (bitn (cat x m y n) i)
+                  (if (< i (+ m n))
+                      (bitn x (- i n))
+                    0))))
+
+;includes both bitn-cat-1 and bitn-cat-2
+(defthm bitn-cat
+  (implies (and (case-split (natp n))
+                (case-split (natp m))
+                (case-split (natp i)))
+           (equal (bitn (cat x m y n) i)
+                  (if (< i n)
+                      (bitn y i)
+                    (if (< i (+ m n))
+                      (bitn x (- i n))
+                    0)))))
+
+;The following trivial corollary of bitn-cat is worth keeping enabled.
+
+(defthm bitn-cat-constants
+  (implies (and (syntaxp (quotep n))
+                (syntaxp (quotep m))
+                (syntaxp (quotep i))
+                (natp n)
+                (natp m)
+                (natp i))
+           (equal (bitn (cat x m y n) i)
+                  (if (< i n)
+                      (bitn y i)
+                    (if (< i (+ m n))
+                      (bitn x (- i n))
+                    0)))))
+
+(defthm cat-bits-bits
+  (implies (and (equal j (1+ k))
+                (equal n (+ 1 (- l) k))
+                (case-split (<= (+ 1 (- j) i) m))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (integerp i))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                (case-split (integerp m))
+                )
+           (equal (cat (bits x i j) m (bits x k l) n)
+                  (bits x i l))))
+
+(defthm cat-bitn-bits
+    (implies (and (equal j (+ 1 k))
+		  (equal n (+ 1 (- l) k))
+                  (case-split (<= 1 m))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+                  (case-split (integerp k))
+                  (case-split (integerp l))
+                  (case-split (integerp m))
+		  )
+	     (equal (cat (bitn x j) m (bits x k l) n)
+		    (bits x j l))))
+
+(defthm cat-bits-bitn
+  (implies (and (equal j (+ 1 k))
+                (case-split (<= (+ 1 (- j) i) m))
+                (case-split (<= j i))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp m))
+                )
+           (equal (cat (bits x i j) m (bitn x k) 1)
+                  (bits x i k))))
+
+(defthm cat-bitn-bitn
+  (implies (and (equal i (+ 1 j))
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (cat (bitn x i) 1 (bitn x j) 1)
+                  (bits x i j))))
+
+
+;may not want this enabled (but probably do want CAT-EQUAL-CONSTANT enabled)
+;the BITS calls around X and Y in the conclusion allow us to drop the hyps that X and Y are bvecps.
+(defthmd cat-split-equality
+  (implies (and (case-split (bvecp k (+ m n))) ;if not, K can't be equal to the CAT expression
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n))
+                )
+           (equal (equal k (cat x m y n))
+                  (and (equal (bits y (1- n) 0) (bits k (1- n) 0))
+                       (equal (bits x (1- m) 0) (bits k (+ -1 m n) n))))))
+
+
+
+;generalize this by dropping the bvecp-hyps and wrapping bits around x and y in the conclusion?
+;follows trivially from   cat-split-equality
+;prove a version of this without the bvecp hyps?
+(defthm cat-equal-constant
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep m)
+                              (quotep n)))
+                (case-split (bvecp y n))
+                (case-split (bvecp x m))
+                (case-split (< k (expt 2 (+ m n)))) ;drop!
+                (case-split (integerp k))
+                (case-split (<= 0 k))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                (case-split (<= 0 n))
+                )
+           (equal (equal k (cat x m y n))
+                  (and (equal y (bits k (1- n) 0))
+                       (equal x (bits k (+ -1 m n) n))))))
+
+;lacks the bvecp hyps.  do we want this or cat-equal-rewrite?
+(defthm cat-equal-rewrite-alt
+  (implies (and (case-split (natp n))
+                (case-split (natp m))
+                )
+           (equal (equal (cat x1 m y1 n)
+                         (cat x2 m y2 n))
+                  (and (equal (bits x1 (1- m) 0) (bits x2 (1- m) 0))
+                       (equal (bits y1 (1- n) 0) (bits y2 (1- n) 0))))))
+
+;move hyps to conclusion?
+(defthm cat-equal-rewrite
+  (implies (and (case-split (bvecp x1 m))
+                (case-split (bvecp y1 n))
+                (case-split (bvecp x2 m))
+                (case-split (bvecp y2 n))
+                (case-split (integerp n))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (<= 0 m))
+                )
+           (equal (equal (cat x1 m y1 n)
+                         (cat x2 m y2 n))
+                  (and (equal x1 x2)
+                       (equal y1 y2)))))
+
+(defthm cat-bits-bits-bits
+  (implies (and (<= k i)
+                (<= l k)
+                (<= j l)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (integerp l)
+                )
+           (equal (cat (bits x i (+ 1 k))
+                       (+ 2 i (- k))
+                       (cat (bits x k l)
+                            (+ 1 k (- l))
+                            (bits x (1- l) j)
+                            (+ l (- j)))
+                       (+ 1 (- j) k))
+                  (bits x i j)))
+  :rule-classes nil)
+
+#|
+bits-dont-match can prove things like this:
+(thm (IMPLIES (EQUAL 7 (BITS x 8 6))
+              (NOT (EQUAL 3 (BITS x 15 6)))))
+|#
+
+(defthm bits-dont-match 
+  (implies (and (syntaxp (and (quotep i)
+                              (quotep j)
+                              (quotep k)))
+                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+                (syntaxp (and (quotep i2)
+                              (quotep j2)
+                              (quotep k2)))
+                (<= j2 j) (<= j i) (<= i i2)
+                (not (equal k (bits k2 (+ i (- j2)) (+ (- j2) j))))
+                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
+                )
+           (equal (equal k (bits x i j))
+                  nil)))
+
+; improve somehow?
+(defthm bits-match
+  (implies (and (syntaxp (and (quotep i)
+                              (quotep j)
+                              (quotep k)))
+                (equal (bits x i2 j2) k2) ;i2, j2, and k2 are free vars
+                (syntaxp (and (quotep i2)
+                              (quotep j2)
+                              (quotep k2)))
+                (<= j2 j) (<= j i) (<= i i2)
+                (equal k (bits k2 (+ i (- j2)) (+ (- j2) j)))
+                (<= 0 i) (<= 0 j) (<= 0 k) (<= 0 i2) (<= 0 j2) (<= 0 k2)
+                (integerp i) (integerp j)  (integerp k) (integerp i2) (integerp j2) (integerp k2)
+                )
+           (equal (equal k (bits x i j))
+                  t)))
+
+
+;make into a rewrite rule
+(defthm cat-with-slice-of-x-equal-x
+  (implies (and (bvecp x (+ m n))
+                (case-split (bvecp y n))
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (equal x (cat (bits x (+ -1 m n) n) m y n))
+                  (equal (bits x (1- n) 0) y))
+           ))
+
+;cat-with-slice-of-x-equal-x won't match, so we use kk here
+;add a syntaxp hyp?
+(defthm cat-with-slice-of-x-equal-x-rewrite
+  (implies (and (equal kk (+ -1 m n))
+                (bvecp x (+ m n))
+                (case-split (bvecp y n))
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (equal x (cat (bits x kk n) m y n))
+                  (equal (bits x (1- n) 0) y))
+           ))
+
+;If X and Y have identical bits in the range [i..j], then they also match on any subrange [k..l] of [i..j]
+(defthmd bits-equal-implies-subranges-equal-helper
+  (implies (and (equal (bits x i j) (bits y i j))
+                (<= j l)
+                (<= k i)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (equal (bits x k l) (bits y k l))
+                  t))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthm bits-equal-implies-subranges-equal
+  (implies (and (equal (bits x i j) (bits y i j))
+                (<= j l)
+                (<= k i)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (equal (bits x k l) (bits y k l))
+                  t))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthmd cat-bits-1
+    (equal (cat (bits x (1- m) 0) m y n)
+	   (cat x m y n)))
+
+(defthmd cat-bits-2
+    (equal (cat x m (bits y (1- n) 0) n)
+	   (cat x m y n)))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/clocks.lisp acl2-6.3/books/rtl/rel9/support/support/clocks.lisp
--- acl2-6.2/books/rtl/rel9/support/support/clocks.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/clocks.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,202 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Most or all of this was originally written by Eric Smith while an intern at AMD.
+
+(in-package "ACL2")
+
+(include-book "mod4")
+(local (include-book "../../arithmetic/even-odd2"))
+
+; The analysis of clocks uses some new functions.
+; 
+; First, even and odd are not the same as evenp and oddp.  For one thing, even
+; and odd are defined recursively, and I've proved a bunch of nice rules about
+; them which we probably want to use and which may not be proved about evenp and
+; oddp (and which may be nicer than what is proveable about evenp and oddp).  One
+; nice property of even and odd is that each implies integerp.  (By contrast,
+; evenp returns t for non-numbers like nil or '(a b).)  So rules which would
+; naturally have both the hyp (integerp n) and the hyp (evenp n) now can just
+; have (even n).
+; 
+; Second, I also define a function, MOD4. I didn't want to use MOD itself in the
+; clocking logic because reasoning about clocks needs to be fast and predictable.
+; (I can imagine that we'll have rules about MOD, especially when doing FP
+; proofs, which will just get in the way of our reasoning about clocks. We might
+; even open up MOD on occasion.)  So, in order to get complete control over the
+; rules which fire when we reason about clocks, I introduced MOD4, which we
+; expect never to have to open after proving a nice set of rules about it.
+; 
+; Also, theorems about MOD4 may be nicer than their analogs for MOD.  For
+; example, MOD4 is always equal to 0, 1, 2, or 3, but (mod #c(0 1) 4) = #c(0 1),
+; which isn't even rational.
+
+(defund pedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 0)
+       (equal y 1)))
+
+(defund nedge (x y)
+  (declare (xargs :guard (and (member x '(0 1)) (member y '(0 1)))))
+  (and (equal x 1)
+       (equal y 0)))
+
+(defmacro posedge (clk)
+  `(and (not (zp n))
+        (pedge (,clk (1- n)) (,clk n))))
+
+(defmacro negedge (clk)
+  `(and (not (zp n))
+        (nedge (,clk (1- n)) (,clk n))))
+
+(defthm pedge-known-false-1
+  (not (pedge x 0))
+  :hints (("Goal" :in-theory (enable pedge))))
+
+(defthm pedge-known-false-2
+  (not (pedge 1 y))
+  :hints (("Goal" :in-theory (enable pedge))))
+
+(defthm nedge-known-false-1
+  (not (nedge x 1))
+  :hints (("Goal" :in-theory (enable nedge))))
+
+(defthm nedge-known-false-2
+  (not (nedge 0 y))
+  :hints (("Goal" :in-theory (enable nedge))))
+
+
+; The call (defperiodic NAME TYPE) creates 1) a defun which defines NAME to be
+; a periodic signal of the specified TYPE and 2) a bvecp lemma for that defun
+; (all periodics have width 1).
+
+; We intend the user to smash certain periodic inputs to his top level module
+; and replace their translations with calls to defperiodic.
+
+; Currently we support the following types of periodic signals:
+
+#|
+
+'fast-clock : 
+
+ _   _   _   _   _   _   _
+| |_| |_| |_| |_| |_| |_| |_|
+
+
+'slow-clock-one-quantum-wide
+
+ _       _       _       _
+| |_____| |_____| |_____| |__
+
+
+'slow-clock-one-quantum-wide-shifted :
+
+     _       _       _       _
+____| |_____| |_____| |_____| |__
+
+
+'slow-clock-two-quanta-wide :
+
+ ___     ___     ___     ___     
+|   |___|   |___|   |___|   |___|
+
+
+'slow-clock-two-quanta-wide-shifted :
+
+     ___     ___     ___     
+|___|   |___|   |___|   |___|
+
+'always-1 :
+
+  ___________________________
+..
+
+
+|#
+
+; As the need arises, we can easily change defperiodic to add support for more
+; types of signal.
+
+; BTW, currently, the definitions generated by defperiodic return unknown
+; values (calls to reset) at time 0 (and whenever N is not a natp).  Perhaps
+; this is too conservative, and perhaps defining the value at time 0 would
+; allow nicer rewrite rules to be proved.
+
+(defconst *defperiodic-types*
+
+; Keep this in sync with the corresponding definition in the compiler.
+
+  '(fast-clock
+    slow-clock-one-quantum-wide
+    slow-clock-one-quantum-wide-shifted
+    slow-clock-two-quanta-wide
+    slow-clock-two-quanta-wide-shifted
+    always-1))
+
+(defmacro defperiodic (name type)
+  (declare (xargs :guard (member-eq type *defperiodic-types*)))
+  (list*
+   'encapsulate
+   nil
+   (case type
+     (fast-clock
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (even n) 1 0))))
+     (slow-clock-one-quantum-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 0 (mod4 n)) 1 0))))
+     (slow-clock-one-quantum-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (equal 2 (mod4 n)) 1 0))))
+     (slow-clock-two-quanta-wide
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 0 (mod4 n))
+                   (equal 1 (mod4 n)))
+               1
+             0))))
+     (slow-clock-two-quanta-wide-shifted
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           (if (or (equal 2 (mod4 n))
+                   (equal 3 (mod4 n)))
+               1
+             0))))
+     (always-1
+      `(defund ,name (n)
+         (if (zp n)
+             (reset (quote ,name) 1)
+           1)))
+     (otherwise (er hard 'defperiodic
+                    "Bad type, ~x0, for defperiodic."
+                    type)))
+   `((defbvecp ,name (n) 1 :hints (("Goal" :in-theory (enable ,name)))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/decode-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/decode-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/decode-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/decode-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,73 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(include-book "ground-zero")
+
+#|(defun decode (x n)
+  (if (< x n) (ash 1 x) 0))
+(in-theory (disable decode))
+|#
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(local (include-book "../../arithmetic/fl"))
+(local (include-book "ash"))
+(local (include-book "bvecp"))
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable decode))))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-natp
+  (natp (decode x n)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k))
+  :hints (("Goal" :in-theory (enable decode))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/decode.lisp acl2-6.3/books/rtl/rel9/support/support/decode.lisp
--- acl2-6.2/books/rtl/rel9/support/support/decode.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/decode.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,66 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "ground-zero")
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(local (include-book "decode-proofs"))
+
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defthm decode-nonnegative-integer-type
+  (and (integerp (decode x n))
+       (<= 0 (decode x n)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than decode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription decode)))
+
+(defthm decode-natp
+  (natp (decode x n)))
+
+(defthm decode-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k))
+                )
+           (bvecp (decode x n) k)))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/drnd-original.lisp acl2-6.3/books/rtl/rel9/support/support/drnd-original.lisp
--- acl2-6.2/books/rtl/rel9/support/support/drnd-original.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/drnd-original.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,2358 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "merge"))
+(include-book "ireps") ;make local?
+(local (include-book "rnd"))
+(local (include-book "bias"))
+(local (include-book "sgn"))
+(local (include-book "bits"))
+(local (include-book "trunc"))
+(local (include-book "away"))
+(local (include-book "near"))
+(local (include-book "near+"))
+(local (include-book "sticky"))
+(local (include-book "../../arithmetic/top"))
+
+(local (in-theory (enable evenp))) ;yuck
+(local (in-theory (disable EXPT-2-TYPE-LINEAR))) ;yuck!
+
+;; Necessary functions:
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defund inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+(defund minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n)) ;added by eric in august, 2001
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defund IEEE-MODE-P (mode)
+  (member mode '(trunc inf minf near)))
+
+(defund common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+; bias of a q bit exponent field is 2^(q-1)-1 
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+
+
+;;
+;; New stuff:
+;;
+;; ------------------------------------------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+;-------------------------------------------------------------------------
+
+(defund drnd-original (x mode n k)
+  (- (rnd (+ x (* (sgn x) (expt 2 (- 2 (expt 2 (1- k)))))) mode n)
+     (* (sgn x) (expt 2 (- 2 (expt 2 (1- k)))))))
+
+(defthmd drnd-original-minus
+  (equal (drnd-original (* -1 x) mode n k)
+         (* -1 (drnd-original x (flip mode) n k)))
+  :hints (("Goal" :in-theory
+           (enable drnd-original)
+           :use ((:instance rnd-minus
+                            (x (+ x (* (sgn x) (expt 2 (- 2 (expt 2 (1- k))))))))))))
+
+(defthm drnd-original-0
+  (equal (drnd-original 0 mode n k) 
+         0)
+  :hints (("Goal" :in-theory (enable drnd-original))))
+
+
+(local (defthm drnd-original-sticky-pos
+    (implies (and (common-rounding-mode-p mode)
+		  (natp n)
+		  (> n 0)
+		  (natp m)
+		  (> m 1)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (> x 0)
+		  (<= (expo x) (- 1 (expt 2 (1- k))))
+		  (<= (expo x) (- m (+ n (expt 2 (1- k))))))
+	     (equal (drnd-original (sticky x m) mode n k)
+		    (drnd-original x mode n k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn drnd-original rnd-sticky)
+		  :use (expo-upper-bound
+			expo-lower-bound
+			(:instance sticky-pos (n m))
+			(:instance sticky-plus-original
+				   (x (expt 2 (- 2 (expt 2 (1- k)))))
+				   (y x)
+				   (k m)
+				   (k1 (- (+ m 2) (+ (expt 2 (1- k)) (expo x))))
+				   (k2 (- (+ m 2) (+ (expt 2 (1- k)) (expo x)))))
+			(:instance exactp-2**n 
+				   (n (- 2 (expt 2 (1- k))))
+				   (m (- (+ m 1) (+ (expt 2 (1- k)) (expo x))))))))))
+
+(defthm drnd-original-sticky
+  (implies (and (common-rounding-mode-p mode)
+                (natp n)
+                (> n 0)
+                (natp m)
+                (> m 1)
+                (natp k)
+                (> k 0)
+                (rationalp x)
+                (<= (expo x) (- 1 (expt 2 (1- k))))
+                (<= (expo x) (- m (+ n (expt 2 (1- k))))))
+           (equal (drnd-original (sticky x m) mode n k)
+                  (drnd-original x mode n k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable drnd-original-minus)
+           :use (drnd-original-sticky-pos
+                 (:instance drnd-original-sticky-pos (mode (flip mode)) (x (- x)))
+                 ))))
+
+(local (defthm drnd-original-bnd-1
+    (implies (and (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (>= x (expt 2 (- 2 (expt 2 (1- k)))))
+		  (< x (+ (expt 2 (- 2 (expt 2 (1- k)))) 
+			  (expt 2 (- 3 (+ n (expt 2 (1- k))))))))
+	     (equal (trunc x n)
+		    (expt 2 (- 2 (expt 2 (1- k))))))
+  :hints (("Goal" :in-theory (disable trunc-exactp-a trunc-exactp-c)
+		  :use (trunc-exactp-a
+			trunc-upper-pos
+			(:instance expt-split (r 2) (j (- 1 n)) (i (- 2 (expt 2 (1- k)))))
+			(:instance trunc-exactp-c (a (expt 2 (- 2 (expt 2 (1- k))))))
+			(:instance exactp-2**n (n (- 2 (expt 2 (1- k)))) (m n))
+			(:instance fp+2
+				   (y (trunc x n))
+				   (x (expt 2 (- 2 (expt 2 (1- k)))))))))))
+
+
+
+(local (defthm drnd-original-bnd-2
+    (implies (and (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (>= x 0)
+		  (< x (expt 2 (- 3 (+ n (expt 2 (1- k)))))))
+	     (equal (drnd-original x 'trunc n k)
+		    0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn rnd drnd-original)
+           :use trunc-0))))
+
+
+
+(local (defthm drnd-original-bnd-3
+    (implies (and (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (> x (expt 2 (- 2 (expt 2 (1- k)))))
+		  (<= x (+ (expt 2 (- 2 (expt 2 (1- k)))) 
+			   (expt 2 (- 3 (+ n (expt 2 (1- k))))))))
+	     (equal (away x n)
+		    (+ (expt 2 (- 2 (expt 2 (1- k)))) 
+		       (expt 2 (- 3 (+ n (expt 2 (1- k))))))))
+  :hints (("Goal" :in-theory (disable away-exactp-a away-exactp-c)
+		  :use (away-exactp-a
+			away-lower-pos
+			(:instance expt-split (r 2) (j (- 1 n)) (i (- 2 (expt 2 (1- k)))))
+			(:instance away-exactp-c
+				   (a (+ (expt 2 (- 2 (expt 2 (1- k))))
+					 (expt 2 (- 3 (+ n (expt 2 (1- k))))))))
+			(:instance exactp-2**n (n (- 2 (expt 2 (1- k)))) (m n))
+			(:instance fp+1
+				   (x (expt 2 (- 2 (expt 2 (1- k))))))
+			(:instance fp+2
+				   (y (away x n))
+				   (x (expt 2 (- 2 (expt 2 (1- k)))))))))))
+
+(local (defthm drnd-original-bnd-4
+    (implies (and (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (> x 0)
+		  (<= x (expt 2 (- 3 (+ n (expt 2 (1- k)))))))
+	     (equal (drnd-original x 'inf n k)
+		    (expt 2 (- 3 (+ n (expt 2 (1- k)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn rnd drnd-original inf)))))
+
+(local (defthm drnd-original-bnd-5
+    (implies (and (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (> x (expt 2 (- 2 (expt 2 (1- k)))))
+		  (< x (+ (expt 2 (- 2 (expt 2 (1- k))))
+			  (expt 2 (- 3 (+ n (expt 2 (1- k)))))))
+		  (< x (+ (expt 2 (- 2 (expt 2 (1- k))))
+			  (expt 2 (- 2 (+ n (expt 2 (1- k))))))))
+	     (equal (near x n)
+		    (expt 2 (- 2 (expt 2 (1- k))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split)
+           :use (near1-a)))))
+
+(local (defthm drnd-original-bnd-6
+    (implies (and (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (> x (expt 2 (- 2 (expt 2 (1- k)))))
+		  (< x (+ (expt 2 (- 2 (expt 2 (1- k))))
+			  (expt 2 (- 2 (+ n (expt 2 (1- k))))))))
+	     (equal (near x n)
+		    (expt 2 (- 2 (expt 2 (1- k))))))
+  :hints (("Goal" :in-theory (disable expt-compare)
+           :use (drnd-original-bnd-5
+			(:instance expt-weak-monotone
+				   (n (- 2 (+ n (expt 2 (1- k)))))
+				   (m (- 3 (+ n (expt 2 (1- k)))))))))))
+
+(local (defthm drnd-original-bnd-7
+    (implies (and (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (> x 0)
+		  (< x (expt 2 (- 2 (+ n (expt 2 (1- k)))))))
+	     (equal (drnd-original x 'near n k)
+		    0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn rnd drnd-original)))))
+
+(local (defthm drnd-original-bnd-8
+    (implies (and (ieee-mode-p m)
+		  (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (> x 0)
+		  (< x (expt 2 (- 2 (+ n (expt 2 (1- k)))))))
+	     (equal (drnd-original x m n k)
+		    (if (eql m 'inf)
+			(expt 2 (- 3 (+ n (expt 2 (1- k)))))
+		      0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (ieee-mode-p sgn rnd drnd-original minf inf) (expt-compare))
+		  :use (drnd-original-bnd-2
+			drnd-original-bnd-4
+			drnd-original-bnd-7
+			(:instance expt-weak-monotone
+				   (n (- 2 (+ n (expt 2 (1- k)))))
+				   (m (- 3 (+ n (expt 2 (1- k)))))))))))
+
+(local (defthm drnd-original-bnd-9
+    (implies (and (ieee-mode-p m)
+		  (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (> x 0)
+		  (< x (expt 2 (- 2 (+ n (expt 2 (1- k))))))
+		  (rationalp y)
+		  (> y 0)
+		  (< y (expt 2 (- 2 (+ n (expt 2 (1- k)))))))
+	     (equal (drnd-original x m n k)
+		    (drnd-original y m n k)))
+  :rule-classes ()
+  :hints (("Goal" :use (drnd-original-bnd-8
+			(:instance drnd-original-bnd-8 (x y)))))))
+
+(defthm drnd-original-tiny-equal
+    (implies (and (ieee-mode-p m)
+		  (natp n)
+		  (> n 0)
+		  (natp k)
+		  (> k 0)
+		  (rationalp x)
+		  (< (abs x) (expt 2 (- 2 (+ n (expt 2 (1- k))))))
+		  (rationalp y)
+		  (< (abs y) (expt 2 (- 2 (+ n (expt 2 (1- k))))))
+		  (equal (sgn x) (sgn y)))
+	     (equal (drnd-original x m n k)
+		    (drnd-original y m n k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sgn  DRND-ORIGINAL-minus)
+		  :use ((:instance drnd-original-bnd-9 (m (if (< x 0) (flip m) m)) (x (abs x)) (y (abs y)))))))
+
+
+
+;beginning of Eric's drnd-original lemmas.  Throughout, n is the number of significand bits
+;(counting the implicit leading zero), and k is the number of exponent bits.
+
+;it doesn't make sense for n to be 0 (no bits of significand).  Since n counts the
+;implicit 0, n=1 is also questionable.
+
+;It doesn't make sense for k to be 0 (no bits of exponent).  Having k=1 is also
+;questionable, since that would allow only 2 possible exponent values, both
+;reserved (one reserved for denormals).
+
+(defund spn (q)
+  (expt 2 (- 1 (bias q))))
+
+(defund spd (p q)
+     (expt 2 (+ 2 (- (bias q)) (- p))))
+
+
+(defthm expo-spn
+  (implies (and (case-split (acl2-numberp k))
+                (case-split (< 0 k)))
+           (equal (expo (spn k))
+                  (+ 1 (* -1 (bias k)))))
+  :hints (("Goal" :in-theory (enable  spn))))
+
+(defthm expo-spd
+  (implies (and (case-split (acl2-numberp k))
+                (case-split (integerp n))
+                (case-split (< 0 k)))
+           (equal (expo (spd n k))
+                  (+ 2 (- (bias k)) (- n))))
+  :hints (("Goal" :in-theory (enable spd))))
+
+(defthm spn-positive-rational-type
+  (and (rationalp (spn k))
+       (> (spn k) 0))
+  :rule-classes (:type-prescription ))
+
+(defthm positive-spn
+  (> (spn q) 0)
+  :rule-classes (:linear))
+
+
+
+(local (defthm nrepp-spn-support
+  (implies (and (integerp n)
+                (> n 0)
+                (integerp k)
+                (> k 1))
+           (nrepp (spn k) n k))
+  :hints (("goal" :in-theory (enable nrepp SPN)
+           :use ((:instance exactp-2**n
+                            (n (+ 1 (* -1 (bias k))))
+                            (m n))
+                 (:instance expt-strong-monotone
+                            (n 1)
+                            (m k)))))))
+
+(defthmd nrepp-spn
+  (implies (and (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (nrepp (spn q) p q))
+  :hints (("Goal" :by nrepp-spn-support)))
+
+
+(local (defthm smallest-spn-support
+  (implies (and (nrepp x n k) ;n is a free var
+                (integerp n)
+                (> n 0)
+                (integerp k)
+                (> k 1)
+                )
+           (>= (abs x) (spn k)))
+  :rule-classes ((:rewrite :match-free :once))
+  :hints (("goal" :in-theory (enable nrepp; bias
+                                     SPN
+                                     )
+           :use (fp-abs
+                 sig-lower-bound
+                 (:instance expt-weak-monotone
+                            (n (- 1 (bias k)))
+                            (m (expo x))))))))
+
+
+(defthmd smallest-spn
+  (implies (and (nrepp r p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 1))
+           (>= (abs r) (spn q)))
+  :rule-classes
+  ((:rewrite :match-free :once))
+  :hints (("Goal" :by smallest-spn-support)))
+
+
+;uses bias to avoid having to open bias in proofs below
+(defthmd drnd-original-def
+  (equal (drnd-original x mode n k)
+         (- (rnd (+ x
+                    (* (sgn x)
+                       (expt 2 (- 1 (bias k)))))
+                 mode n)
+            (* (sgn x)
+               (expt 2 (- 1 (bias k))))))
+  :hints (("goal" :in-theory (enable drnd-original bias))))
+
+(defthmd drnd-original-spn
+  (implies (and (common-rounding-mode-p mode)
+                (integerp n)
+                (> n 0)
+                (integerp k)
+                (> k 0))
+           (equal (drnd-original (spn k) mode n k)
+                  (rnd (spn k) 
+                       mode
+                       (+ n
+                          (- (expo (spn k)))
+                          (+ 1 (* -1 (BIAS K)))))))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable drnd-original-def ;sgn
+                                      SPN
+;      expt-split
+;     expt-minus
+                                      )
+                              '(a15 
+                                EXPT-COMPARE-EQUAL))
+           :use ((:instance rnd-exactp-b (x (expt 2 (+ 2 (* -1 (bias k))))))
+                 (:instance rnd-exactp-b (x (expt 2 (+ 1 (* -1 (bias k))))))
+                 (:instance a15
+                            (i 2)
+                            (j1 (+ 1 (- (bias k))))
+                            (j2 1))
+                 ))))
+
+(local (defthmd drnd-original-rewrite-1
+         (implies (and (rationalp x)
+                       (<= 0 x)
+                       (< x (spn k))
+                       (common-rounding-mode-p mode)
+                       (integerp n)
+                       (> n 1)
+                       (integerp k)
+                       (> k 0))
+                  (equal (drnd-original x mode n k)
+                         (rnd x 
+                              mode
+                              (+ n (- (expo (spn k))) (expo x)))))
+         :hints (("goal" :in-theory (set-difference-theories
+                                     (enable drnd-original-def sgn ;common-rounding-mode-p ;ieee-mode-p 
+                                             expt ;expt-split ;why?
+                                             ;bias
+                                             SPN
+                                             )
+                                     '(                                       ;SPN
+                                       common-rounding-mode-p
+                                       expo-x+2**k))
+                  :use ((:instance plus-rnd
+                                   (y x)
+                                   (x (spn k))
+                                   (k (+ n (expo x) (- (expo
+                                                        (spn k))))))
+                        (:instance expo-x+2**k
+                                   (k (+ 1 (* -1 (bias k)))))
+                        (:instance expo<=
+                                   (n (* -1 (bias k)))))))
+         :otf-flg t))
+
+(local 
+ (defthmd drnd-original-rewrite-pos
+  (implies (and (rationalp x)
+                (<= 0 x)
+                (<= x (spn k))
+                (common-rounding-mode-p mode)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (equal (drnd-original x mode n k)
+                  (rnd x 
+                       mode
+                       (+ n (- (expo (spn k))) (expo x)))))
+  :hints (("goal" :in-theory (disable spn COMMON-ROUNDING-MODE-P)
+           :use (drnd-original-rewrite-1 drnd-original-spn )))))
+
+(local
+ (defthmd drnd-original-rewrite-neg
+   (implies (and (rationalp x)
+                 (<= (- (spn k)) x)
+                 (<= x 0)
+                 (common-rounding-mode-p mode)
+                 (integerp n)
+                 (> n 1)
+                 (integerp k)
+                 (> k 0))
+            (equal (drnd-original x mode n k)
+                   (rnd x 
+                        mode
+                        (+ n (- (expo (spn k))) (expo x)))))
+   :hints (("goal" :in-theory (enable drnd-original-rewrite-pos )
+            :use ((:instance drnd-original-minus (mode (flip mode)))
+                  (:instance 
+                   rnd-minus (x (- x)) (mode mode)
+                   (n (+ -1 n (expo x) (bias k)))))))))
+
+;why enable so much?
+(defthmd drnd-original-rewrite
+  (implies (and (rationalp x)
+                (<= (abs x) (spn k))
+                (common-rounding-mode-p mode)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (equal (drnd-original x mode n k)
+                  (rnd x 
+                       mode
+                       (+ n 
+                          (- (expo (spn k))) 
+                          (expo x)))))
+  :hints (("Goal" :in-theory (enable drnd-original-rewrite-pos drnd-original-rewrite-neg))))
+
+(defthm drepp-range
+  (implies (and (drepp x n k)
+                (integerp n)
+                (>= n 0)
+                (integerp k)
+                (> k 0)
+                )
+           (<= (abs x)
+               (spn k)))
+  :hints (("Goal" :in-theory (enable bias drepp SPN)
+           :use ((:instance expo>= (x (- x))
+                        (n (+ 1 (- (bias k)))))
+                 (:instance expo>= (n (+ 1 (- (bias k)))))))))
+
+(defthmd drepp-def
+  (equal (drepp x p q)
+         (and (rationalp x)
+              (not (= x 0))
+              (<= (- 2 p) (+ (expo x) (bias q)))
+              (<= (+ (expo x) (bias q)) 0)
+              (exactp x (+ -1 p (bias q) (expo x)))))
+  :hints (("Goal" :in-theory (enable drepp bias))))
+
+(defthm drnd-original-of-drepp-is-NOP
+  (implies (and (drepp x n k)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (equal (drnd-original x mode n k)
+                  x))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable drepp-def
+                                      )
+                              '( SPN))
+           :use (drnd-original-rewrite
+                 drepp-range
+                 (:instance rnd-exactp-b
+                            (n (+ n 
+                                  (- (expo (spn k))) 
+                                  (expo x))))))))
+;move up?
+(defthm spn-1-exact
+  (implies (and (case-split (integerp k))
+                (case-split (> k 0)))
+           (exactp (spn k) 1))
+  :hints (("Goal" :in-theory (enable spn))))
+
+(defthm spd-1-exact
+  (implies (and (case-split (integerp k))
+                (case-split (integerp n))
+                (case-split (> k 0)))
+           (exactp (spd n k) 1))
+  :hints (("Goal" :in-theory (enable spd)))
+  )
+
+;(in-theory (enable drnd-original-spn))
+
+(defthm drnd-original-spn-is-spn
+  (implies (and (common-rounding-mode-p mode)
+                (integerp n)
+                (>= n 1)
+                (integerp k)
+                (> k 0))
+           (= (drnd-original (spn k) mode n k)
+              (spn k))
+           )
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable IEEE-MODE-P)
+                              '( spn-1-exact
+                                 SPN
+                                      drnd-original-spn
+                                      ))
+           :use ( drnd-original-spn
+                  (:instance exactp-<= (m 1)
+                             (x (spn k)))
+                  (:instance spn-1-exact)
+                  (:instance rnd-exactp-b 
+                             (x (spn k))
+;                             (m mode)
+                             (n n))))))
+
+;can be expensive..
+(defthmd drnd-original-spn-is-spn-general
+  (implies (and (= (abs x) (spn k))
+                (common-rounding-mode-p mode)
+                (integerp n)
+                (>= n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                )
+           (= (drnd-original x mode n k)
+              x)
+           )
+  :hints (("Goal" :in-theory (disable spn drnd-original-rewrite drnd-original-spn)
+           :use (:instance drnd-original-minus (mode (flip mode))))))
+
+;(in-theory (disable drnd-original-spn))
+
+;(in-theory (enable drnd-original-rewrite)) ;BOZO yuck!
+
+(defthm drnd-original-trunc-never-goes-away-from-zero
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k)))
+           (<= (abs (drnd-original x 'trunc n k))
+               (abs x)))
+  :hints (("Goal" :in-theory (enable rnd drnd-original-rewrite)
+           :use (:instance trunc-upper-bound
+                           (n (+ -1 N (EXPO X) (bias k)))))))
+
+(defthm drnd-original-away-never-goes-toward-zero
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k)))
+           (>= (abs (drnd-original x 'away n k))
+               (abs x)))
+  :hints (("Goal" :in-theory (enable rnd drnd-original-rewrite)
+           :use (:instance away-lower-bound
+                (n (+ -1 N (EXPO X) (bias k)))))))
+
+(defthm drnd-original-inf-never-goes-down
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k)))
+           (>= (drnd-original x 'inf n k)
+               x))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd drnd-original-rewrite)
+                              '(expo-2**n abs-pos)))))
+
+(defthm drnd-original-minf-never-goes-up
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k)))
+           (<= (drnd-original x 'minf n k)
+               x))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd drnd-original-rewrite)
+                              '(expo-2**n abs-pos)))))
+
+;t-p?
+(defthm fl-not-0
+  (implies (and (rationalp x)
+                (>= x 1))
+           (not (= (fl x)
+                   0))))
+;t-p?
+(defthm cg-not-0
+  (implies (and (rationalp x)
+                (> x 0))
+           (not (= (cg x)
+                   0))))
+
+(defthm drnd-original-trunc-skips-no-denormals
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (drepp a n k)
+                (<= (abs a) (abs x))
+                )
+           (<= (abs a)
+               (abs (drnd-original x 'trunc n k))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd drepp-def drnd-original-rewrite
+                                      )
+                              '(trunc-exactp-c-eric
+                                 EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                  EXPO-COMPARISON-REWRITE-TO-BOUND
+                                spn))
+           :use (
+                 (:instance exactp-<=
+                            (x a)
+                            (m (+ -1 N (EXPO A) (bias k)))
+                            (n (+ -1 N (EXPO x) (bias k))))
+                 (:instance trunc-exactp-c-eric (n (+ -1 N (EXPO X) (bias k))))
+                 (:instance expo-monotone (x a) (y x))))))
+
+
+(defthm drnd-original-trunc-skips-no-rep-numbers
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 1)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (irepp a n k)
+                (<= (abs a) (abs x))
+                )
+           (<= (abs a)
+               (abs (drnd-original x 'trunc n k))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable irepp DRND-ORIGINAL-SPN-IS-SPN-GENERAL )
+                              '(drnd-original-trunc-skips-no-denormals
+
+                                  DRND-ORIGINAL-SPN-IS-SPN
+                                smallest-spn-support
+                                spn drnd-original-rewrite))
+           :use (drnd-original-trunc-skips-no-denormals
+                 (:instance smallest-spn-support (x a))))
+          ("goal'" 
+           :cases ((and (nrepp a n k) (< (abs x) (spn k)))
+                   (and (drepp a n k) (< (abs x) (spn k)))))))
+
+(local (defthm positive-spd-support
+  (implies (and (integerp n)
+                (> k 1)
+                (integerp k)
+                (> k 0))
+           (> (spd n k) 0))))
+
+(defthm positive-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (> q 0))
+           (> (spd p q) 0))
+  :rule-classes :linear)
+
+
+(local (defthm drepp-spd-support
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (drepp (spd n k) n k))
+  :hints (("goal" :in-theory (enable drepp-DEF ;bias
+                                     )))))
+
+
+(defthmd drepp-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (spd p q) p q))
+  :hints (("Goal" :by drepp-spd-support)))
+
+
+(local (defthm smallest-spd-support
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (drepp x n k))
+           (>= (abs x) (spd n k)))
+  :hints (("goal" :in-theory (enable drepp SPD)
+           :use (sig-lower-bound 
+                 fp-abs
+                 (:instance expt-weak-monotone
+                            (n (+ 2 (* -1 n) (* -1 (bias k))))
+                            (m (expo x))))))))
+
+
+(defthmd smallest-spd
+  (implies (and (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0)
+                (drepp r p q))
+           (>= (abs r) (spd p q)))
+  :hints (("Goal" :by smallest-spd-support)))
+
+
+
+;BOZO.  if we try to scatter exponents here, we don't gather the constants...
+(defthm drnd-original-trunc-of-low-range
+  (implies (and (rationalp x)
+                (< (abs x) (abs (spd n k)))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (drnd-original x 'trunc n k)
+              0))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable drnd-original-rewrite rnd sgn 
+                                      SPD
+                                      SPN
+                                      bias ;drop?
+;                                      EXPT-COMPARE-EQUAL
+;expt-split expt-minus
+                                      )
+                              '(a15 ;spn
+;spd
+                                EXPT-COMPARE-EQUAL
+                                EXPT-COMPARE
+                                ))
+           :use ((:instance expt-strong-monotone 
+                            (n (expo (spd n k)))
+                            (m (expo (spn k))))
+                 (:instance trunc-to-0-or-fewer-bits
+                            (n (+ -1 N (EXPO X) (bias k))))
+                 (:instance a15 (i 2) (j1 1) (j2 (+ 1 (* -1 N)
+                                                    (* -1 (bias k)))))
+                 (:instance expo<= (n (+ 1 (* -1 N)
+                                         (* -1 (bias k)))))
+                 (:instance expo<= (x (- x))
+                            (n (+ 1 (* -1 N)
+                                  (* -1 (bias k)))))))))
+
+(defthm drnd-original-away-of-low-range
+  (implies (and (rationalp x)
+                (< (abs x) (abs (spd n k)))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (drnd-original x 'away n k)
+              (* (sgn x) (spd n k))))
+  :hints (("Goal"  :in-theory (set-difference-theories
+                               (enable drnd-original-rewrite rnd sgn bias 
+                                       spn
+                                       spd)
+                               '(a15 ;
+                                                                 EXPT-COMPARE-EQUAL
+                                EXPT-COMPARE
+                                     ))
+           :use ((:instance expt-strong-monotone 
+                            (n (expo (spd n k)))
+                            (m (expo (spn k))))
+;                 (:instance away-to-0-or-fewer-bits
+ ;                           (n (+ -2 N (EXPO X) (EXPT 2 (+ -1 K)))))
+                 (:instance a15 (i 2) (j1 1) (j2 (+ 2 (* -1 N)
+                                                    (* -1 (EXPT 2 (+ -1 K))))))
+                 (:instance expo<= (n (+ 2 (* -1 N)
+                                         (* -1 (EXPT 2 (+ -1 K))))))
+                 (:instance expo<= (x (- x))
+                            (n (+ 2 (* -1 N)
+                                  (* -1 (EXPT 2 (+ -1 K))))))))))
+
+
+(defthm spd-<-spn
+  (implies (and (integerp n)
+                (> n 1)
+                (> k 0)
+                (integerp k))
+  (< (spd n k)
+     (spn k)))
+;  :rule-classes :linear
+  :hints (("Goal" :in-theory (enable spd
+                                     spn)
+           :use (:instance expt-strong-monotone 
+                                  (n (+ 2 (* -1 N) (* -1 (bias k))))
+                                  (m (+ 1          (* -1 (bias k))))))))
+
+#|
+(defthm abs-spd-<-abs-spn
+  (implies (and (integerp n)
+                (> n 1)
+                (> k 0)
+                (integerp k))
+  (< (abs (spd n k))
+     (abs (spn k))))
+ ; :rule-classes :linear
+  :hints (("Goal" :in-theory (disable spd spn))))
+|#
+
+;move or drop?
+(defthm abs-prod
+  (implies (and (rationalp x)
+                (rationalp y))
+           (= (abs (* x y))
+              (* (abs x) (abs y))))
+  :hints (("Goal" :in-theory (enable sgn))))
+
+(defthm drnd-original-of-low-range
+  (implies (and (rationalp x)
+                (< (abs x) (abs (spd n k)))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (or (= (drnd-original x mode n k) 0)
+               (= (abs (drnd-original x mode n k)) (spd n k))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd inf minf near near+ ieee-mode-p common-rounding-mode-p sgn drnd-original-rewrite
+                                      )
+                              '(spd
+                                spn 
+                                abs
+                                abs-away
+                                drnd-original-away-of-low-range
+                                drnd-original-trunc-of-low-range
+                                spd-<-spn
+;                                drnd-original-rewrite
+                                rearrange-negative-coefs-equal))
+           :use (;drnd-original-rewrite
+                 spd-<-spn
+                 drnd-original-away-of-low-range drnd-original-trunc-of-low-range)))
+  :rule-classes nil)
+
+(defthm drnd-original-spd-is-spd
+  (implies (and (common-rounding-mode-p mode)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (drnd-original (spd n k) mode n k)
+              (spd n k))
+           )
+  :hints (("Goal" :in-theory (disable spd))))
+
+(defthm drepp-minus
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (drepp (* -1 x) n k) (drepp x n k)))
+  :hints (("Goal" :in-theory (enable drepp))))
+
+;can be expensive
+(defthmd drnd-original-spd-is-spd-general
+  (implies (and (= (abs x) (spd n k))
+                (common-rounding-mode-p mode)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                )
+           (= (drnd-original x mode n k)
+              x)
+           )
+  :hints (("Goal" :in-theory (disable spd drnd-original-rewrite
+                                      DRND-ORIGINAL-OF-DREPP-IS-NOP
+                                      drepp-spd-support)
+           :use ((:instance drepp-spd-support)
+                 (:instance DRND-ORIGINAL-OF-DREPP-IS-NOP (x (- x)))
+                 (:instance DRND-ORIGINAL-OF-DREPP-IS-NOP )))))
+
+
+
+(defund largest-positive-denormal (n k)
+  (- (spn k)
+     (spd n k)))
+
+
+(defthm positive-lpd
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (> (largest-positive-denormal n k) 0))
+  :hints (("goal" :in-theory (enable drepp bias; SPN
+;                                     spd
+                                     largest-positive-denormal)
+           :use 
+           (:instance expt-strong-monotone 
+                      (n (+ 2 (* -1 n) (* -1 (bias k))))
+                      (m (+ 1 (* -1 (bias k)))))))
+  :rule-classes (:rewrite :linear))
+
+(defthm expo-2**k-x
+  (implies (and (integerp k)
+                (rationalp x)
+                (> x 0)
+                (<= x (expt 2 (- k 1))))
+           (equal (expo (+ (expt 2 k) (* -1 x)))
+                  (- k 1)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '())
+           :use (
+                 (:instance expo-unique (x (- (expt 2 k) x)) (n (- k 1)))
+                 )))
+  :otf-flg t)
+
+(defthm expo-lpd
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (expo (largest-positive-denormal n k))
+              (1- (expo (spn k)))))  
+  :hints (("Goal" :in-theory (enable largest-positive-denormal
+                                     SPN
+                                     spd))))
+
+;move
+(defthm exactp-diff-of-powers-of-2
+  (implies (and (integerp m)
+                (integerp n)
+                (> m n) ; remove?
+                )
+           (exactp (+ (expt 2 m) (* -1 (expt 2 n)))
+                   (- m n)))
+  :hints (("Goal" :in-theory (disable  expo-2**k-x)
+           :use ((:instance expt-strong-monotone (n m) (m n))
+                 (:instance exactp2 (x (- (expt 2 m) (expt 2 n)))
+                               (n (- m n)))
+                 (:instance  expo-2**k-x (k m)
+                             (x (EXPT 2 N)))))))
+
+
+(defthm exactness-of-lpd
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (exactp (largest-positive-denormal n k)
+                   (1- n)))
+  :hints (("Goal" :in-theory (e/d (largest-positive-denormal
+                                   SPN
+                                   spd) ( exactp-diff-of-powers-of-2))
+           :use (:instance
+                        exactp-diff-of-powers-of-2
+                        (m (expo (spn k)))
+                        (n (expo (spd n k)))))))
+
+(defthm drepp-lpd
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (drepp (largest-positive-denormal n k) n k))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable drepp-def)
+                              '(expo-lpd exactness-of-lpd))
+           :use ( (:instance expo-lpd)
+                  (:instance exactness-of-lpd)
+                  (:instance expt-strong-monotone 
+                             (n (+ 3 (* -1 n) (* -1 (EXPT 2 (1- k)))))
+                             (m (+ 2 (* -1 (EXPT 2 (1- k))))))))))
+
+;BOZO move these
+;nice rules to have in lib?
+(defthmd expo<=-2
+  (implies (and (<= (expo x) (- n 1))
+                (rationalp x)
+                (> x 0) ;gen?
+                (integerp n)
+                )
+           (<= x (expt 2 n)))
+  :hints (("Goal" :in-theory (disable EXPT-COMPARE)
+           :use (expo-upper-bound
+                 (:instance expt-weak-monotone-linear (m n) (n (+ 1 (expo x)))))))
+  :rule-classes (:rewrite :linear))
+
+;shouldn't be a linear rule?
+(defthmd expo>=-2
+  (implies (and (>= (expo x) n)
+                (rationalp x)
+                (> x 0) ;gen?
+                (integerp n)
+                )
+           (>= x (expt 2 n)))
+  :hints (("Goal" :in-theory (disable EXPT-COMPARE)
+           :use (expo-lower-bound
+                 (:instance expt-weak-monotone-linear (m (expo x))))))
+  :rule-classes (:rewrite :linear))
+
+
+;are these 2 duplicated elsewhere?
+;shouldn't be a linear rule?
+(defthmd expo>
+  (implies (and (> x (expt 2 (+ 1 n)))
+                (rationalp x)
+                (integerp n)
+                )
+           (> (expo x) n))
+  :rule-classes :linear
+  :otf-flg t
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '( EXPT-COMPARE))
+           :use (expo-upper-bound
+                 expo>=))))
+
+(defthmd expo<
+  (implies (and (< x (expt 2 n))
+                (> x 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (< (expo x) n))
+  :rule-classes :linear
+  :hints (("goal" :use (expo-lower-bound
+			(:instance expt-split (r 2) (i 1) (j n))
+			(:instance expt-weak-monotone (n (1+ n)) (m (expo x)))))))
+
+(defthm largest-lpd
+  (implies (and (drepp x n k)
+                (> x 0) ;drop?
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                )
+           (<= x (largest-positive-denormal n k)))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable drepp-def largest-positive-denormal
+                                      SPN
+                                      spd)
+                              '(expo<=-2))
+           :use ((:instance expo<=-2 (n (+ 1 (* -1 (bias k)))))
+                 (:instance fp+2
+                            (y (EXPT 2 (+ 1 (* -1 (bias k)))))
+                            (n (+ -1 n (EXPO X) (bias k)))
+                            )))))
+
+;why? :
+(local (in-theory (disable expo-monotone)))
+(local (in-theory (disable expt-weak-monotone-linear)))
+
+;rephrase using bias?
+(defthm drepp-drnd-original-exactness
+  (implies (and (rationalp x)
+                (< (spd n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p m))
+           (exactp (drnd-original x m n k) (+ -2 n (expt 2 (- k 1)) (expo (drnd-original x m n k)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bias
+                                      drnd-original-rewrite
+                                      spn
+                                      spd
+                                      ) ;drop?
+                              '(expo>))
+           :use ((:instance expo-rnd (mode m) (n (+ -1 N (EXPO X)
+                                                    (bias k))))
+                 (:instance expo> (n (+ 1 (- n ) (- (bias k)))))))))
+
+
+(defthm drepp-drnd-original-expo-1
+  (implies (and (rationalp x)
+                (< (spd n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p m))
+           (<= (- 2 n) (+ (expo (drnd-original x m n k)) (bias k))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable spn
+                                      drnd-original-rewrite
+                                      spd)
+                              '(expo>=))
+           :use ((:instance expo-rnd (mode m) (n (+ -1 N (EXPO X)
+                                                    (bias k))))
+                 (:instance expo>= (n (+ 2 (- n) (- (bias k)))))))))
+
+(local 
+ (defthm hack3
+   (implies (and (equal (expo x) (- 1 (expt 2 (1- k))))
+                 (rationalp x)
+                 (integerp n)
+                 (< 1 n)
+                 (integerp k)
+                 (< 0 k))
+            (> (+ (expt 2 (+ 1 (expo x)))
+                  (expt 2
+                        (+ 3 (* -1 n)
+                           (* -1 (expt 2 (1- k))))))
+               (expt 2 (+ 2 (* -1 (expt 2 (1- k)))))))
+   :rule-classes nil 
+   :hints (("Goal" :in-theory (disable   REARRANGE-NEGATIVE-COEFS-EQUAL)))))
+
+
+(defthm drepp-drnd-original-expo-2
+  (implies (and (rationalp x)
+                (< (spd n k) x)
+                (< x (largest-positive-denormal n k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p m))
+           (<= (+ (expo (drnd-original x m n k)) (bias k)) 0))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable ;expt-split
+                               bias ;drop
+                               largest-positive-denormal
+                               spn
+                               spd
+                               drnd-original-rewrite
+                               )
+                              '(expo>= expo>=-2 ; expo-2**k-x
+                                       rnd-exactp-c ; expt-compare
+                                       exactp-diff-of-powers-of-2
+                                       ))
+           :use ((:instance expo-rnd (mode m)
+                            (n (+ -1 n (expo x) (bias k))))
+                 (:instance expo< (n (+ 2 (- n ) (- (bias k)))))
+                 (:instance expo< (n (+ 1 (* -1 (bias k)))))
+                 (:instance expo>= (n (+ 2 (- n ) (- (bias k)))))
+                 (:instance exactp-diff-of-powers-of-2
+                            (m (+ 1 (* -1 (bias k))))
+                            (n (+ 2 (* -1 n)
+                                  (* -1 (bias k)))))
+                 (:instance rnd-exactp-c (a (largest-positive-denormal n k))
+                            (mode m)
+                            (n (1- n)))
+                 hack3 ;hack3-bias
+
+                 ))
+          )
+  :otf-flg t
+  )
+
+
+#|
+(defthm drepp-drnd-original-expo-2
+  (implies (and (rationalp x)
+                (< (spd n k) x)
+                (< x (largest-positive-denormal n k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p m))
+           (<= (+ (expo (drnd-original x m n k)) (bias k)) 0))
+  :hints (("goal" :cases (< x 0)
+           :in-theory (set-difference-theories
+                              (enable ;expt-split
+;                               bias ;drop
+                               expt-split
+                               drnd-original-rewrite
+                               )
+                              '(expo>= expo>=-2 ; expo-2**k-x
+                                       rnd-exactp-c ; expt-compare
+                                       exactp-diff-of-powers-of-2
+                                       ))
+           )
+          )
+  :otf-flg t
+  )
+
+
+|#
+
+
+(defthm drepp-drnd-original-not-0
+  (implies (and (rationalp x)
+                (< (spd n k) x)
+                (< x (largest-positive-denormal n k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p m))
+           (not (equal (drnd-original x m n k) 0)))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable rnd inf minf near near+
+                                      drnd-original-rewrite
+                                      common-rounding-mode-p ieee-mode-p
+                                      spd
+                                      spn
+                                      LARGEST-POSITIVE-DENORMAL
+;                                      bias
+                                      )
+                              '(drepp-spd drnd-original-trunc-skips-no-denormals))
+           :use ((:instance drepp-spd-support)
+                 (:instance drnd-original-trunc-skips-no-denormals
+                             (a (expt 2
+                                      (+ 2 (* -1 n) (* -1 (bias k))))))))))
+
+
+(defthm drepp-drnd-original-mid-range-1
+  (implies (and (rationalp x)
+                (< (spd n k) x)
+                (< x (largest-positive-denormal n k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p m))
+           (drepp (drnd-original x m n k) n k))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable drepp bias
+                                      spd
+                                      spn
+                                      LARGEST-POSITIVE-DENORMAL)
+                              '(drnd-original-rewrite
+                                drepp-drnd-original-expo-2  drepp-drnd-original-expo-1))
+           :use ( drepp-drnd-original-expo-2  drepp-drnd-original-expo-1))))
+
+(defthm drepp-drnd-original-mid-range
+  (implies (and (rationalp x)
+                (< (spd n k) (abs x))
+                (< (abs x) (largest-positive-denormal n k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p m))
+           (drepp (drnd-original x m n k) n k))
+  :hints (("goal" :in-theory (e/d (drnd-original-minus)
+                                  ( drnd-original-rewrite DREPP-DRND-ORIGINAL-MID-RANGE-1 flip  DREPP-DEF
+                                      SPN SPD))
+           :use (drepp-drnd-original-mid-range-1
+                 (:instance drepp-drnd-original-mid-range-1 (m (flip m)) (x (- x)))))))
+
+(defthm expo-of-high-range-1
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (> x 0))
+  :hints (("goal" :in-theory (disable largest-positive-denormal positive-lpd)
+           :use (:instance positive-lpd))))
+
+(defthm expo-of-high-range-2-2
+  (implies (and
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (<= (* 2
+                   (expt 2
+                         (+ 3 (* -1 n)
+                            (* -1 (expt 2 (1- k))))))
+               (expt 2 (+ 2 (* -1 (expt 2 (1- k)))))))
+  :hints (("goal" :in-theory (disable expo>=-2)
+           :use ((:instance a15 (i 2) (j1 1) (j2 (+ 3 (* -1 n) (* -1 (expt 2 (1- k))))))
+                 (:instance expt-weak-monotone (n (+ 4 (* -1 n)
+                         (* -1 (expt 2 (1- k)))))
+           
+                       (m (+ 2 (* -1 (expt 2 (1- k))))))))))
+#|
+;BOZO kill move
+(defthm expo-shift-3-alt
+    (implies (and (rationalp (* x y))
+		  (not (= (* x y) 0))
+		  (integerp n))
+	     (= (expo (* y (expt 2 n) x)) 
+		(+ n (expo (* x y)))))
+  :hints (("Goal" :use (:instance sig-expo-shift (x (* x y ))))))
+|#
+
+;finish trying to keep bias disabled in proofs below here
+(defthm expo-of-high-range-2-1
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (<= (expt 2 (- (expo (spn k)) 1)) 
+               (largest-positive-denormal n k)))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable expt-split
+                                      expo-shift-2
+                                      bias
+                                      LARGEST-POSITIVE-DENORMAL
+                                      spn
+                                      spd
+                                      )
+                              '()))))
+
+(defthm expo-of-high-range-2
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (< (expt 2 (- (expo (spn k)) 1)) x))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable largest-positive-denormal
+                                      )
+                              '( expo>=-2
+                                      expo-of-high-range-2-1
+                                      spn
+                                      ))
+           :use  expo-of-high-range-2-1)))   
+
+
+(defthm expo-of-high-range
+    (implies (and (rationalp x)
+                  (< (largest-positive-denormal n k) x)
+                  (< x (spn k))
+                  (integerp n)
+                  (> n 1)
+                  (integerp k)
+                  (> k 0))
+             (= (expo x)
+                (- (expo (spn k)) 1)))
+    :hints (("goal" :in-theory (e/d (spn
+                                     spd)
+                                    (
+                                 expo-of-high-range-2
+                                positive-lpd))
+             :use ( expo-of-high-range-2
+                    (:instance positive-lpd)
+                   (:instance expo-unique (n (- (expo (spn k)) 1)))))))
+
+(defthm drnd-original-trunc-of-high-range-3
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (equal (fp+ (largest-positive-denormal n k) (- n 1))
+                  (spn k)))
+  :hints (("Goal" :in-theory (enable expo>=-2 largest-positive-denormal spn
+                                     SPD))))
+                       
+(defthm drnd-original-trunc-of-high-range-1
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (>= (drnd-original x 'trunc n k)
+               (largest-positive-denormal n k)))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable rnd drnd-original-rewrite)
+                              '(drnd-original-trunc-skips-no-denormals 
+                                spn
+                                largest-positive-denormal
+                                rnd-exactp-d
+                                ))
+           :use ((:instance drnd-original-trunc-skips-no-denormals 
+                            (a (largest-positive-denormal n k))
+                            )))))
+
+(defthm drnd-original-trunc-of-high-range-2
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (<= (drnd-original x 'trunc n k)
+               (largest-positive-denormal n k)))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable rnd drnd-original-rewrite)
+                              '(
+                                spn
+                                largest-positive-denormal
+                                rnd-exactp-d
+                                ;; expo-of-high-range
+                                ))
+           :use ((:instance fp+2 
+                            (y (trunc x (+ n 
+                                                (- (expo (spn k))) 
+                                                (expo x))))
+                            (x (largest-positive-denormal n k))
+                            (n (- n 1)))))))
+
+(defthm drnd-original-trunc-of-high-range-pos
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (drnd-original x 'trunc n k)
+               (largest-positive-denormal n k)))
+  :hints (("goal" :in-theory (disable spn
+                                      drnd-original-rewrite
+                                      largest-positive-denormal
+                                      drnd-original-trunc-of-high-range-2
+                                      drnd-original-trunc-of-high-range-1
+                                      )
+           :use (drnd-original-trunc-of-high-range-2 drnd-original-trunc-of-high-range-1))))
+
+
+(defthm drnd-original-trunc-of-high-range
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) (abs x))
+                (< (abs x) (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (drnd-original x 'trunc n k)
+               (* (sgn x) (largest-positive-denormal n k))))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable sgn drnd-original-minus)
+                              '(spn
+                                drnd-original-rewrite
+                                largest-positive-denormal
+                                drnd-original-trunc-of-high-range-pos))
+           :use (drnd-original-trunc-of-high-range-pos
+                 (:instance drnd-original-trunc-of-high-range-pos (x (- x)))))))
+
+(defthm drnd-original-away-of-high-range-1
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (<= (drnd-original x 'away n k)
+               (spn k)))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable rnd drnd-original-rewrite)
+                              '(spn-1-exact
+                                spn
+                                largest-positive-denormal
+                                rnd-exactp-d))
+           :use ( spn-1-exact
+                  (:instance exactp-<= (x (spn k)) (m 1) (n (- n 1)))
+                  (:instance away-exactp-c (a (spn k))
+                             (n (+ n 
+                                   (- (expo (spn k))) 
+                                   (expo x))))))))
+
+(defthm drnd-original-away-of-high-range-2
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (>= (drnd-original x 'away n k)
+               (spn k)))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable rnd drnd-original-rewrite)
+                              '(spn
+                                largest-positive-denormal
+                                rnd-exactp-d))
+           :use ((:instance exactp-<= (x (spn k)) (m 1) (n
+                                                                              (- n 1)))
+                 (:instance fp+2 
+                            (y (away x (+ n 
+                                          (- (expo (spn k))) 
+                                          (expo x))))
+                            (x (largest-positive-denormal n k))
+                            (n (- n 1)))))))
+
+(defthm drnd-original-away-of-high-range-pos
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) x)
+                (< x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (drnd-original x 'away n k)
+               (spn k)))
+  :hints (("goal" :in-theory (disable 
+                              drnd-original-rewrite
+                              spn
+                              largest-positive-denormal
+                               DRND-ORIGINAL-AWAY-OF-HIGH-RANGE-1
+                                DRND-ORIGINAL-AWAY-OF-HIGH-RANGE-2)
+           :use (drnd-original-away-of-high-range-2 drnd-original-away-of-high-range-1))))
+
+
+(defthm drnd-original-away-of-high-range
+  (implies (and (rationalp x)
+                (< (largest-positive-denormal n k) (abs x))
+                (< (abs x) (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0))
+           (= (drnd-original x 'away n k)
+               (* (sgn x) (spn k))))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable sgn drnd-original-minus)
+                              '(spn
+                                drnd-original-rewrite
+                                largest-positive-denormal
+                                drnd-original-away-of-high-range-pos))
+           :use (drnd-original-away-of-high-range-pos
+                 (:instance drnd-original-away-of-high-range-pos (x (- x)))
+                 ))))
+
+(defthm drnd-original-choice
+  (implies (common-rounding-mode-p mode)
+           (or (equal (drnd-original x mode n k) (drnd-original x 'away n k))
+               (equal (drnd-original x mode n k) (drnd-original x 'trunc n k))))
+  :hints (("Goal" :use (:instance rnd-choice (x (+ X
+                        (* (SGN X)
+                           (EXPT 2 (+ 2 (* -1 (EXPT 2 (1- K)))))))))
+           :in-theory (set-difference-theories
+                       (enable drnd-original)
+                       '(re evenp))))
+  :rule-classes nil)
+
+
+(defthm drnd-original-of-high-range
+  (implies (and (< (largest-positive-denormal n k) (abs x))
+                (< (abs x) (spn k))
+                (rationalp x)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (or (= (drnd-original x mode n k) (* (sgn x) (largest-positive-denormal n k)))
+               (= (drnd-original x mode n k) (* (sgn x) (spn k)))))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable rnd inf minf near ieee-mode-p common-rounding-mode-p sgn)
+                              '(spd
+                                drnd-original-rewrite
+                                spn 
+                                abs-away
+                                common-rounding-mode-p
+                                rearrange-negative-coefs-equal))
+           :use (drnd-original-choice)))
+  :rule-classes nil) 
+
+;add?
+;gen?
+(defthm drnd-original-non-neg
+  (implies (and (<= 0 x)
+                (rationalp x)
+                (<= x (spn k)) ;drop?
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (<= 0 (drnd-original x mode n k)))
+  :hints (("Goal" :in-theory (enable drnd-original-rewrite)))
+  :rule-classes (:rewrite :type-prescription))
+
+;add?
+;gen?
+(defthm drnd-original-non-pos
+  (implies (and (<= x 0)
+                (rationalp x)
+                (<= (abs x) (spn k)) ;drop?
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (<= (drnd-original x mode n k) 0))
+  :hints (("Goal" :in-theory (enable drnd-original-rewrite)))
+  :rule-classes (:rewrite :type-prescription))
+
+;bad name?
+(defthm drnd-original-type-pos
+  (implies (and (rationalp x)
+                (<= 0 x)
+                (<= x (spn k)) ;drop?
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd-original x mode n k) n k)
+               (= (drnd-original x mode n k) 0)
+               (= (drnd-original x mode n k) (spn k))))
+           :otf-flg t
+           :hints (("goal" :in-theory (set-difference-theories
+                              (enable sgn DRND-ORIGINAL-SPN-IS-SPN-GENERAL)
+                              '(drnd-original-rewrite 
+                                drepp-drnd-original-mid-range
+                                drnd-original-spd-is-spd-general
+                                spd
+                                largest-positive-denormal
+                                spn
+                                drepp-drnd-original-mid-range-1
+                                drepp-spd-support
+                                ))
+           :use (drnd-original-of-high-range
+                 drnd-original-of-low-range
+                 (:instance  DREPP-MINUS (x  (DRND-ORIGINAL X MODE N K)))
+                 (:instance  drepp-spd-support)
+                 (:instance drepp-drnd-original-mid-range (m mode)))))
+  :rule-classes nil)
+
+;bad name?
+(defthm drnd-original-type
+  (implies (and (rationalp x)
+                (<= (abs x) (spn k)) ;drop?
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (or (drepp (drnd-original x mode n k) n k)
+               (= (drnd-original x mode n k) 0)
+               (= (drnd-original x mode n k) (* (sgn x) (spn k)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable sgn drnd-original-minus)
+                              '(drnd-original-rewrite
+;                                DRND-ORIGINAL-SPD-IS-SPD-GENERAL ; for efficiency
+                                spn))
+           :use (drnd-original-type-pos
+                 (:instance drnd-original-type-pos (mode (flip mode)) (x (- x))))))
+  :rule-classes nil)
+
+
+;drop?
+;(in-theory (disable SPN))
+
+
+
+;better proof?
+(defthm drnd-original-diff
+  (implies (and (rationalp x)
+                (<= (ABS X) (SPN K))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (drnd-original x mode n k))) (spd n k)))
+  :hints (("Goal'" 
+           :cases ((> (+ n 
+                         (- (expo (spn k))) 
+                         (expo x)) 0)))
+          ("goal" :in-theory (set-difference-theories
+                              (enable rnd 
+                                      drnd-original-rewrite
+                                      SPD
+                                      ;bias
+                                     ; SPN
+                                      common-rounding-mode-p
+                                      inf minf near near+ sgn)
+                              '( ;BIAS
+                                ;sgn
+                                SPN
+                                ;spd
+                                re evenp EXPO<=-2 EXPO>=-2 expt-compare
+                                rnd-diff))
+           :use ((:instance rnd-diff (n (+ N (EXPO X)
+                                           (* -1 (EXPO (SPN
+                                                        K))))))
+                 (:instance expo-upper-bound (x (- x)))
+                 (:instance expo-upper-bound)
+                 (:instance expt-weak-monotone (n (+ 1 (expo x)))
+                            (M (+ 2 (* -1 N)
+                                  (* -1 (bias k)))))))))
+
+
+(defthm drepp-rationalp
+  (implies (drepp x n k)
+           (rationalp x))
+  :rule-classes :forward-chaining
+  :hints (("Goal" :in-theory (enable drepp))))
+
+;just an intermediate step in the proofs
+(defund next-denormal-2 (x n k)
+  (fp+ x (+ -1 n (expo x) (bias k))))
+
+(defund next-denormal (x n k)
+  (+ x (spd n k))) 
+
+(defthmd denormals-same
+  (equal (next-denormal-2 x n k) 
+         (next-denormal x n k))
+  :hints (("Goal" :in-theory (enable next-denormal next-denormal-2 
+                                     SPD)))
+  )
+
+;move
+(defthmd fp+-expo
+  (implies (and (rationalp x)
+                (< 0 x)
+                (< x y)
+                (rationalp y)
+                (exactp x n)
+                (integerp n)
+                (> n 0)
+                (< y (fp+ x n)))
+           (= (expo y)
+              (expo x)))
+  :hints (("Goal" :use ((:instance expo-unique (x y) (n (expo x)))
+           (:instance fp+1-1)))))
+
+;remove x>=0 hyp?
+(defthm denormal-spacing-1
+  (implies (and (integerp n)
+                (integerp k)
+                (> k 0)
+                (> n 1)
+                (drepp x n k)
+                (drepp x+ n k)
+                (>= x 0)
+                (> x+ x))
+           (>= x+ (next-denormal-2 x n k)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable drepp bias NEXT-DENORMAL-2)
+                              '(fp+ fp+-expo))
+           :use ((:instance fp+-expo (y x+)
+                            (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
+                 (:instance fp+2 
+                            (y x+)
+                            (n (+ -1 n (expo x) (bias k))))))))
+
+(defthm denormal-spacing
+  (implies (and (integerp n)
+                (integerp k)
+                (> k 0)
+                (> n 1)
+                (drepp x n k)
+                (drepp x+ n k)
+                (>= x 0)
+                (> x+ x))
+           (>= x+ (next-denormal x n k)))
+  :hints (("Goal" :in-theory (disable denormal-spacing-1)
+           :use (denormal-spacing-1
+                 (:instance denormals-same)))))
+
+(defthm drnd-original-away-skips-no-denormals-pos
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= 0 x)
+                (<= x (spn k))
+                (drepp a n k)
+                (>= a x)
+                )
+           (>= a (drnd-original x 'away n k)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable sgn spn
+                                      SPD
+                                      LARGEST-POSITIVE-DENORMAL
+                                      NEXT-DENORMAL)
+                              '(drnd-original-diff
+                                drnd-original-rewrite
+                                largest-lpd
+                                denormal-spacing
+                                
+;                                DRND-ORIGINAL-SPD-IS-SPD-GENERAL ;these two for efficiency
+ ;                               DRND-ORIGINAL-SPN-IS-SPN-GENERAL ;
+                                 ))
+           :use ((:instance largest-lpd (x a))
+                 (:instance drnd-original-diff (mode 'away))
+                 (:instance drnd-original-type (mode 'away))
+                 (:instance denormal-spacing
+                            (x a)
+                            (x+ (drnd-original x 'away n k)))))))
+
+; all 4 :use hints seem necessary
+(defthm drnd-original-away-skips-no-denormals
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (drepp a n k)
+                (>= (abs a) (abs x))
+                )
+           (>= (abs a) (abs (drnd-original x 'away n k))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable sgn drnd-original-minus)
+                              '(drnd-original-diff
+                                DRND-ORIGINAL-AWAY-OF-HIGH-RANGE
+                                DRND-ORIGINAL-AWAY-OF-HIGH-RANGE-POS
+                                DRND-ORIGINAL-AWAY-OF-LOW-RANGE
+                                DREPP-DRND-ORIGINAL-MID-RANGE
+                                drnd-original-non-pos
+                                drnd-original-rewrite
+                                spn
+                                DRND-ORIGINAL-AWAY-SKIPS-NO-DENORMALS-pos
+;                                DRND-ORIGINAL-SPD-IS-SPD-GENERAL ;these two for efficiency
+ ;                               DRND-ORIGINAL-SPN-IS-SPN-GENERAL
+                                ))
+                                
+           :use ((:instance drnd-original-non-pos (mode 'away))
+                 (:instance drnd-original-away-skips-no-denormals-pos)
+                 (:instance drnd-original-away-skips-no-denormals-pos (a (- a)) (x (- x)))
+                 (:instance drnd-original-away-skips-no-denormals-pos (x (- x)))
+                 (:instance drnd-original-away-skips-no-denormals-pos (a (- a)))))))
+  
+;BOZO
+;(in-theory (disable SPN BIAS DREPP))
+
+(defthm drnd-original-inf-skips-no-denormals
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (drepp a n k)
+                (>= a x))
+           (>= a (drnd-original x 'inf n k)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd ;drepp 
+                                      inf
+                                      drnd-original-rewrite)
+                              '(;drnd-original-rewrite
+                                drnd-original-away-skips-no-denormals
+                                 drnd-original-trunc-skips-no-denormals))
+          :use ((:instance drnd-original-away-skips-no-denormals)
+                (:instance drnd-original-trunc-skips-no-denormals (x (- x)))))))
+
+(defthm drnd-original-minf-skips-no-denormals
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= (abs x) (spn k))
+                (drepp a n k)
+                (<= a x))
+           (<= a (drnd-original x 'minf n k)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd ;drepp 
+                                      drnd-original-rewrite
+                                      minf)
+                              '(
+                                drnd-original-away-skips-no-denormals
+                                 drnd-original-trunc-skips-no-denormals))
+          :use ((:instance drnd-original-away-skips-no-denormals (x (- x)))
+                (:instance drnd-original-trunc-skips-no-denormals)))))
+
+
+
+(local 
+ (defthm hack1
+   (implies (and (< n 0)
+                 (>= x 0)
+                 (rationalp x)
+                 (integerp n)
+                 )
+            (>= (EXPT 2 (+ (EXPO X) (* -1 N)))
+                X))
+   :hints (("Goal" :use (:instance expo<=-2 (n (+ (EXPO X) (* -1 N))))))))
+
+;BOZO this hack shouldn't be needed
+(local 
+ (defthm hack2
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (< n 0)
+                 (>= x 0))
+            (>= (EXPT 2 (+ 1 (EXPO X) (* -1 N)))
+                (* 2 X)))
+   :hints (("Goal" :in-theory (set-difference-theories
+                               (enable expt-split)
+                               '( hack1 expo<=-2))
+            :use (hack1
+                  (:instance a15 (i 2) (j1 1) (j2 (+ (EXPO X) (* -1 N)))))))))
+
+;BOZO in trying to improve this I enabled sig, which caused a loop
+;try
+(local
+ (defthm near1-b-negative-n
+   (implies (and (rationalp x)
+                 (>= x 0)
+                 (integerp n)
+                 (<= n 0)
+                 (> (- x (trunc x n)) (- (away x n) x)))
+            (= (near x n) (away x n)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (set-difference-theories
+                               (enable sgn near expt-split re)
+                               '(                                     ;FL-EQUAL-0
+                                 EXPT-COMPARE
+                                 FL-EQUAL-0
+                                 hack2 EXPO-BOUND-ERIC
+                                 expo>=-2 expo<=-2
+                                 ;; MattK: The following disable is needed by
+                                 ;; v2-8-alpha-12-30-03 (and somewhat before,
+                                 ;; but not in June 03).  I haven't
+                                 ;; investigated why exactly, but from the
+                                 ;; transcript it seems that the new use of
+                                 ;; linear arithmetic for type-set is the
+                                 ;; culprit.  I don't have any reason to
+                                 ;; believe that this exposes a problem with
+                                 ;; that new use; I'm happy to assume that it's
+                                 ;; just an artifact of this particular proof
+                                 ;; approach, at least for now.
+                                 expt-2-positive-rational-type
+                                 ))
+            :use (expo-upper-bound
+                  hack2
+                  (:instance expt-strong-monotone (m (+ (EXPO X) (* -1 N))) (n (EXPO X)))
+                  (:instance expt-weak-monotone (n n) (m 0))
+                  (:instance expt-weak-monotone (n n) (m -1))
+                  (:instance fl-unique (x (* 1/2 (SIG X) (EXPT 2 N)))
+                             (n 0))
+                  )))))
+
+
+;BOZO could replace the version in near.lisp 
+(defthm near1-b-eric
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> (- x (trunc x n)) (- (away x n) x)))
+	     (= (near x n) (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near away trunc)
+		  :use (near1-b
+                        near1-b-negative-n))))
+
+
+
+(defthm drnd-original-near-2-1
+  (implies (and (rationalp x)
+                (<= x (spn k))
+                (rationalp a)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (> x 0)
+                (drepp a n k)
+                (= (drnd-original x 'near n k) (drnd-original x 'trunc n k)))
+           (>= (abs (- x a)) (abs (- x (drnd-original x 'trunc n k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd bias drnd-original-rewrite)
+                              '(  away-exactp-c 
+				      near trunc-exactp-c
+                                      drnd-original-away-skips-no-denormals
+                                      drnd-original-trunc-skips-no-denormals
+                                      ))
+           :use ((:instance near1-b-eric (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
+                 (:instance away-lower-pos (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
+                 (:instance trunc-upper-pos (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
+                 (:instance drnd-original-away-skips-no-denormals )
+                 (:instance drnd-original-trunc-skips-no-denormals)))))
+
+(defthm drnd-original-near-2-2
+  (implies (and (rationalp x)
+                (<= x (spn k))
+                (rationalp a)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (> x 0)
+                (drepp a n k)
+                (= (drnd-original x 'near n k) (drnd-original x 'away n k)))
+           (>= (abs (- x a)) (abs (- x (drnd-original x 'away n k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd bias drnd-original-rewrite)
+                              '( drnd-original-away-skips-no-denormals
+                                 drnd-original-trunc-skips-no-denormals
+                                 away-exactp-c 
+                                 trunc-exactp-c
+                                 ))
+           :use ((:instance near1-a (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
+                 (:instance away-lower-pos (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
+                 (:instance trunc-upper-pos (n (+ -2 N (EXPO X) (EXPT 2 (1- K)))))
+                 (:instance drnd-original-away-skips-no-denormals )
+                 (:instance drnd-original-trunc-skips-no-denormals)))))
+
+(defthm drnd-original-near-choice
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (<= (abs x) (spn k)))
+           (or (= (drnd-original x 'near n k) (drnd-original x 'trunc n k))
+               (= (drnd-original x 'near n k) (drnd-original x 'away n k))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd near drnd-original-rewrite)
+                              '(re evenp))))
+  :rule-classes ())
+
+;BOZO
+;(in-theory (disable SPD))
+
+(defthm no-denormal-is-closer-than-what-drnd-original-near-returns-pos
+  (implies (and (rationalp x)
+                (>= x 0)
+                (<= x (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (drepp a n k))
+           (>= (abs (- x a)) (abs (- x (drnd-original x 'near n k)))))
+  :hints (("Goal" :in-theory (disable
+
+                              drnd-original-rewrite
+                              drnd-original-non-neg
+                              DRND-ORIGINAL-AWAY-SKIPS-NO-DENORMALS-POS)
+           :use ((:instance drnd-original-near-2-1)
+                 (:instance drnd-original-near-2-2)
+                 (:instance drnd-original-near-choice)))))
+
+(defthm no-denormal-is-closer-than-what-drnd-original-near-returns-neg
+  (implies (and (rationalp x)
+                (<= x 0)
+                (<= (abs x) (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (drepp a n k))
+           (>= (abs (- x a)) (abs (- x (drnd-original x 'near n k)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable drnd-original-minus)
+                              '(drnd-original-rewrite
+                                drnd-original-non-pos
+                                drnd-original-non-neg
+                                spn
+                                no-denormal-is-closer-than-what-drnd-original-near-returns-pos
+                                DRND-ORIGINAL-AWAY-SKIPS-NO-DENORMALS-POS))
+           :use ((:instance no-denormal-is-closer-than-what-drnd-original-near-returns-pos
+                            (x (- x)) (a (- a)))))))
+
+
+(defthm no-denormal-is-closer-than-what-drnd-original-near-returns
+  (implies (and (rationalp x)
+                (<= (abs x) (spn k))
+                (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (drepp a n k))
+           (>= (abs (- x a)) (abs (- x (drnd-original x 'near n k)))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable)
+                              '(drnd-original-rewrite
+                                drnd-original-non-pos
+                                drnd-original-non-neg
+                                spn
+                                DRND-ORIGINAL-AWAY-SKIPS-NO-DENORMALS-POS
+                                no-denormal-is-closer-than-what-drnd-original-near-returns-pos
+                                no-denormal-is-closer-than-what-drnd-original-near-returns-neg))
+           :use (no-denormal-is-closer-than-what-drnd-original-near-returns-pos
+                 no-denormal-is-closer-than-what-drnd-original-near-returns-neg))))
+
+;could speed up the above with a :cases hint instead of :use hints?
+
+
+
+
+#|
+;remove these?
+(defthm drnd-original-trunc-never-goes-up-for-pos-args
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= 0 x)
+                (<= x (spn k)))
+           (<= (drnd-original x 'trunc n k)
+               x))
+  :hints (("Goal" :in-theory (enable rnd)
+           :use (:instance trunc-upper-bound
+                                  (n (+ -2 N (EXPO X) (EXPT 2 (1- K))))))))
+
+
+(defthm drnd-original-away-never-goes-down-for-pos-args
+  (implies (and (integerp n)
+                (> n 1)
+                (integerp k)
+                (> k 0)
+                (rationalp x)
+                (<= 0 x)
+                (<= x (spn k)))
+           (>= (drnd-original x 'away n k)
+               x))
+  :hints (("Goal" :in-theory (enable rnd)
+           :use (:instance away-lower-bound
+                                  (n (+ -2 N (EXPO X) (EXPT 2 (1- K))))))))
+|#
+
+;why?
+(in-theory (disable expo< expo>))
+
+
+
+
+ 
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/encode.lisp acl2-6.3/books/rtl/rel9/support/support/encode.lisp
--- acl2-6.2/books/rtl/rel9/support/support/encode.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/encode.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,157 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(local (include-book "../../arithmetic/top"))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+(local (include-book "ground-zero"))
+(local (include-book "bvecp"))
+(local (include-book "ash"))
+(local (include-book "float"))
+
+(defund encode (x n)
+  (declare (xargs :guard (and (acl2-numberp x)
+                              (integerp n)
+                              (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+(defthm encode-nonnegative-integer-type
+  (and (integerp (encode x n))
+       (<= 0 (encode x n)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable encode))))
+
+;this rule is no better than encode-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription encode)))
+
+(defthm encode-natp
+  (natp (encode x n)))
+
+(defthm encode-bvecp-helper
+  (implies (and (case-split (integerp n))
+                (case-split (<= 0 n))
+                )
+           (bvecp (encode x n) (+ 1 (expo n)))) ;The +1 is necessary
+  :hints (("Subgoal *1/5" :use (:instance EXPT-WEAK-MONOTONE
+                                          (n (+ 1 (EXPO (1- N)))) 
+                                          (m (+ 1 (EXPO N))))
+           :in-theory (set-difference-theories
+                       (enable encode bvecp power2p ash-rewrite)
+                       '(
+                         expt-compare
+                         )))
+          ("Goal"
+           :in-theory (set-difference-theories
+                       (enable encode bvecp power2p ash-rewrite)
+                       '(
+                         expt-compare
+                         )))
+          ))
+
+(defthm encode-bvecp-old
+  (implies (and (<= (+ 1 (expo n)) k)
+                (case-split (integerp k))
+                )
+           (BVECP (ENCODE x n) k))
+  :hints (("Goal" :in-theory (disable encode-bvecp-helper)
+           :expand (ENCODE X N)
+           :use  (encode-bvecp-helper))))
+
+(defthmd expo-expt-reduction
+  (implies (and (integerp k)
+                (rationalp n)
+                (< 0 n)
+                (< n (expt 2 k)))
+           (<= (+ 1 (expo n)) k))
+  :hints (("Goal" :use ((:instance expo-comparison-rewrite-to-bound-2
+                                   (k (1- k))
+                                   (x n)))
+           :in-theory (disable expo-comparison-rewrite-to-bound-2))))
+
+(local
+ (defthmd encode-non-positive-integer
+   (implies (not (and (integerp n)
+                      (< 0 n)))
+            (equal (encode x n) 0))
+   :hints (("Goal" :expand ((encode x n))))))
+
+(defthm encode-bvecp
+  (implies (and (< n (expt 2 k))
+                (case-split (integerp k)))
+           (bvecp (encode x n) k))
+  :hints (("Goal" :in-theory (enable expo-expt-reduction encode-non-positive-integer)
+           :cases ((and (integerp n) (< 0 n))))))
+
+; may not need this now
+(defthm encode-reduce-n
+  (implies (and (integerp n)
+                (<= 0 n)
+                (bvecp x n))
+           (equal (encode x n)
+                  (encode x (1- n))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable encode bvecp power2p ash-rewrite )
+                              '(
+                                expt-compare
+                                )))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/ereps-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/ereps-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/ereps-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/ereps-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,723 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; Eric Smith, David Russinoff, with contributions and suggestions by Matt Kaufmann
+; AMD, June 2001 
+;this file was previously called repsproofs.lisp
+;perhaps the more hierarchical defns (e.g., erepp2) should be exported
+
+(include-book "rtl")
+(include-book "float") ;to get the defns...
+
+; bias of a q bit exponent field is 2^(q-1)-1 
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+(local (include-book "bias"))
+(local (include-book "merge"))
+(local (include-book "cat"))
+(local (include-book "bvecp"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "../../arithmetic/top")) ;try
+(include-book "mulcat")
+
+(local (in-theory (enable bits-tail)))
+(local (in-theory (disable sgn))) ;move up?
+(local (in-theory (enable expt-split expt-minus)))
+
+;;Encoding of floating-point numbers with explicit leading one:
+;;bit vectors of length p+q+1, consisting of 1-bit sign field, 
+;;q-bit exponent field (bias = 2**(q-1)-1), and p-bit significand field.
+
+(defund esgnf  (x p q) (bitn x (+ p q)))
+(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defund esigf  (x p)   (bits x (1- p) 0))
+
+;;;**********************************************************************
+;;;                       REPRESENTABLE NUMBERS
+;;;**********************************************************************
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+
+;;;**********************************************************************
+;;;                      VALID ENCODINGS
+;;;**********************************************************************
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+; sig, expo, and sgn are defined in float.lisp
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+;BOZO move.  handle this better
+(defthm cancel-hack
+  (implies (and (not (equal 0 y))
+                (rationalp x)
+                (rationalp y)
+                (rationalp w)
+                (rationalp z))
+                (equal (EQUAL 0 (+ (* X y) (* w y z)))
+                       (EQUAL 0 (+ x (* w z)))))
+  :hints (("Goal" :in-theory (disable CANCEL_TIMES-EQUAL-CORRECT)
+           :use (:instance  mult-both-sides-of-equal (c y) (a 0) (b (+ x (* w z)))))))
+                       
+(defthm edecode-eencode
+  (implies (and (erepp x p q)
+                (integerp p)
+;                (>= p 0)
+                (integerp q)
+;                (>= q 0) ;gen!
+                )
+           (equal (edecode (eencode x p q) p q)
+                  x))
+  :hints (("Goal" :in-theory (enable only-0-is-0-or-negative-exact
+                                     edecode eencode erepp esgnf eexpof esigf sgn bits-minus-alt))))
+
+(defthm eencode-edecode
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (>= p 0)
+                (integerp q)
+                (> q 0)
+                )
+           (equal (eencode (edecode x p q) p q)
+                  x))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable bvecp-forward
+                                     bitn-negative-bit-of-integer
+                                     edecode eencode esigf eexpof eencodingp esgnf sgn cat-split-equality))))
+
+(defthm erepp-edecode
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (erepp (edecode x p q) p q))
+  :hints (("Goal" :in-theory (enable erepp edecode eencodingp esigf eexpof esgnf))))
+
+(defthm eencodingp-eencode
+  (implies (and (erepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (eencodingp (eencode x p q) p q) )
+  :hints (("Goal" :in-theory (e/d (eencodingp eencode erepp sgn bitn-shift-eric) ()))))
+
+(defthm expo-edecode
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))  
+           (equal (expo (edecode x p q))
+                  (- (eexpof x p q) (bias q))
+                  ))
+  :hints (("Goal" :in-theory (enable edecode eexpof esigf esgnf eencodingp))))
+
+(defthm sig-edecode
+  (implies (and (eencodingp  x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (equal (sig (edecode x p q))
+                  (/ (esigf x p) (expt 2 (- p 1)))))
+  :hints (("Goal" :in-theory (enable sig esigf eexpof edecode esgnf eencodingp))))
+
+(defthm sgn-edecode
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (equal (sgn (edecode  x p q))
+                  (if (= (esgnf x p q) 0) 1 -1)))
+  :hints (("Goal" :in-theory (enable sgn edecode esgnf esigf eencodingp))))
+
+(defthm eencodingp-not-zero
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (not (equal (edecode x p q) 0)))
+  :hints (("Goal" :in-theory (enable eencodingp edecode esigf esgnf))))
+
+
+;Rebiasing proofs:
+
+(defund rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n)))
+    :hints (("goal" :in-theory (e/d ( expt-split rebias-expo bvecp natp bias
+                                                  ) (expt-compare))
+		  :use (:instance expt-weak-monotone (n m) (m n)))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m)))
+    :hints (("goal" :in-theory (enable rebias-expo bvecp natp bias))))
+
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n))
+  :hints (("goal" :in-theory (e/d ( ;expt
+                                   expt-split
+                                     rebias-expo bvecp bias)
+                                  (expt-compare))
+		  :use (:instance expt-weak-monotone (n m) (m n)))))
+
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m))
+  :hints (("goal" :in-theory (enable ;expt 
+                              expt-split
+                                     rebias-expo bvecp bias))))
+(local (defthm rebias-lemma-1
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 1))
+	     (< (bits x (- n 2) 0) (expt 2 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bitn-plus-bits (n (1- n)) (m 0)))))))
+
+(local (defthm rebias-lemma-3
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 1))
+	     (bvecp (bits x (- n 2) 0) (1- m)))
+  :rule-classes ()
+  :hints (("Goal" :use (rebias-lemma-1
+;			rebias-lemma-2
+                        )
+		  :in-theory (e/d (bvecp) (BITS-SLICE-ZERO-GEN))))))
+
+(local (defthm rebias-lemma-4
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 1))
+	     (equal (bits x (- n 2) 0)
+		    (bits x (- m 2) 0)))
+    :rule-classes nil
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable natp)
+                              '(bits-bits
+                                ))
+		  :use (rebias-lemma-3
+			(:instance bits-bits (i (- n 2)) (j 0) (k (- m 2)) (l 0)))))))
+
+(local (defthm rebias-lemma-5
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 1))
+	     (equal x (+ (expt 2 (1- n)) (bits x (- m 2) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories (enable natp) '())
+		  :use (rebias-lemma-4
+			(:instance bitn-plus-bits (n (1- n)) (m 0)))))))
+
+(local (defthm rebias-lemma-6
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 1))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n)) 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable rebias-expo bias cat)
+		  :use (rebias-lemma-5)))))
+
+(local (defthm rebias-lemma-7
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (equal (bits x (+ -2 n) 0)
+		    x))
+    :rule-classes nil
+    :hints (("Goal" :use ((:instance bitn-plus-bits (n (1- n)) (m 0)))))))
+
+(local (defthm rebias-lemma-8
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (equal (bits x (+ -2 n) 0)
+		    (+ (* (expt 2 (1- m))
+			  (bits x (- n 2) (1- m)))
+		       (bits x (- m 2) 0))))
+    :rule-classes nil
+    :hints (("Goal" :use ((:instance bits-plus-bits (n (+ -2 n)) (p (1- m)) (m 0)))))))
+
+(local (defthm rebias-lemma-9
+    (implies (and ;(natp n)
+		  (natp m)
+		  ;(> n m)
+		  (> m 1)
+		  ;(bvecp x n)
+                  )
+	     (and (integerp (bits x (- m 2) 0))
+		  (< (bits x (- m 2) 0)
+		     (expt 2 (1- m)))))
+  :hints (("Goal" :use ((:instance bits-bvecp (i (- m 2)) (j 0) (k (1- m))))
+		  :in-theory (union-theories (disable bits-bvecp) '(bvecp natp))))))
+
+(local (defthm rebias-lemma-10
+    (implies (and (integerp x)
+		  (integerp y)
+		  (< x y))
+	     (<= x (1- y)))
+  :rule-classes ()))
+
+(local (defthm rebias-lemma-11
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n))
+	     (INTEGERP (EXPT 2 (+ -2 M))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable natp)))))
+
+
+(local (defthm rebias-lemma-12
+    (implies (and; (natp n)
+		  (natp m)
+		 ; (> n m)
+		  (> m 1)
+		  ;(bvecp x n)
+                  )
+	     (<= (bits x (- m 2) 0)
+		 (1- (expt 2 (1- m)))))
+  :hints (("Goal" :in-theory (union-theories (disable rebias-lemma-9 expt) '(natp))
+		  :use (rebias-lemma-9
+			rebias-lemma-11
+			(:instance rebias-lemma-10 (x (bits x (- m 2) 0)) (y (expt 2 (1- m)))))))))
+
+(local (defthm rebias-lemma-13
+              (implies (and (natp n)
+                            (natp m)
+                            (> n m)
+                            (> m 1)
+                            (bvecp x n)
+                            (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+                            (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+                            (= (bitn x (1- n)) 0))
+                       (<= (bits x (+ -2 n) 0)
+                           (+ (* (expt 2 (1- m))
+                                 (bits x (- n 2) (1- m)))
+                              (1- (expt 2 (- m 1))))))
+              :rule-classes ()
+              :hints (("Goal" :in-theory (disable rebias-lemma-12)
+                       :use (rebias-lemma-8
+                             rebias-lemma-12)))))
+
+(local (defthm rebias-lemma-14
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (or (> (bits x (- n 2) (1- m))
+		    (- (expt 2 (- n m)) 2))
+		 (<= (bits x (- n 2) 0)
+		     (+ (* (- (expt 2 (- n m)) 2)
+			   (expt 2 (1- m)))
+			(1- (expt 2 (1- m)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (rebias-lemma-13)))))
+
+(local (defthm rebias-lemma-15
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (or (> (bits x (- n 2) (1- m))
+		    (- (expt 2 (- n m)) 2))
+		 (<= (bits x (- n 2) 0)
+		     (+ (- (expt 2 (- n 1))
+			   (* 2 (expt 2 (1- m))))
+			(1- (expt 2 (1- m)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (rebias-lemma-14
+			(:instance expt-split (r 2) (i (- n m)) (j (1- m))))))))
+
+(local (defthm rebias-lemma-16
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (or (> (bits x (- n 2) (1- m))
+		    (- (expt 2 (- n m)) 2))
+		 (< (bits x (- n 2) 0)
+		    (- (expt 2 (1- n)) (expt 2 (1- m))))))
+  :rule-classes ()
+  :hints (("goal" :use (rebias-lemma-15)))))
+
+(local (defthm rebias-lemma-17
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (equal (< x 
+		     (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (< (bits x (+ -2 n) 0)
+		     (- (expt 2 (1- n))
+			(expt 2 (1- m))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable ;rebias-lemma-7
+                              )
+           :use (rebias-lemma-7)))))
+
+(local (defthm rebias-lemma-18
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (> (bits x (- n 2) (1- m))
+		(- (expt 2 (- n m)) 2)))
+  :rule-classes ()
+  :hints (("Goal" :use (rebias-lemma-16
+			rebias-lemma-17)))))
+
+(local (defthm rebias-lemma-19
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (and ;(integerp (bits x (- n 2) (1- m)))
+		  (< (bits x (- n 2) (1- m)) (expt 2 (- n m)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bvecp
+                                   ) ( bits-bvecp
+                                       BITS-SLICE-ZERO-GEN
+                                       ))
+		  :use ((:instance bits-bvecp (i (- n 2)) (j (1- m)) (k (- n m))))))))
+
+(local (defthm rebias-lemma-20
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1))
+	     (integerp (expt 2 (- n m))))
+  :rule-classes ()))
+
+(local (defthm rebias-lemma-21
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (= (bits x (- n 2) (1- m))
+		(1- (expt 2 (- n m)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bvecp)
+                              '(;natp
+                                expt-2-integerp
+                                ;; Matt K.: ACL2 v2-8-alpha-12-30-03 needs two
+                                ;; more rules to be disabled, as follows.  I
+                                ;; haven't investigated why, but given the rule
+                                ;; expt-2-integerp disabled just above, a
+                                ;; reasonable explanation is that ACL2 simply
+                                ;; does a better job now of using the rules
+                                ;; below (to rewrite a hypothesis to T that is,
+                                ;; in fact, needed).
+                                EXPT-2-POSITIVE-INTEGER-TYPE ; new
+                                A14 ; new
+                                EXPT-QUOTIENT-INTEGERP-ALT
+                                EXPT2-INTEGER
+                                EXPT-SPLIT
+                                POWER2-INTEGER
+                                BVECP-TIGHTEN
+                                LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE
+                                ))
+		  :use (rebias-lemma-18
+			rebias-lemma-20
+			rebias-lemma-19)))))
+
+(local (defthm rebias-lemma-22
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (= x
+		(+ (* (1- (expt 2 (- n m)))
+		      (expt 2 (1- m)))
+		   (bits x (- m 2) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable ;rebias-lemma-7
+                              )
+           :use (rebias-lemma-21
+			rebias-lemma-7
+			(:instance bits-plus-bits (n (+ -2 n)) (p (1- m)) (m 0)))))))
+
+(local (defthm rebias-lemma-23
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (= x
+		(+ (- (expt 2 (1- m)))
+		   (expt 2 (1- n))
+		   (bits x (- m 2) 0))))
+  :rule-classes ()
+  :hints (("Goal" :use (rebias-lemma-22
+			(:instance expt-split (r 2) (i (- n m)) (j (1- m))))))))
+
+(local (defthm rebias-lemma-24
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m))))
+		  (= (bitn x (1- n)) 0))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n)) 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable rebias-expo bias cat)
+		  :use (rebias-lemma-23)))))
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use (rebias-lemma-6
+			rebias-lemma-24
+			(:instance bitn-0-1 (n (1- n)))))))
+
+
+(local (defthm rebias-up-1
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m)
+		  (= (bitn x (1- m)) 1))
+	     (equal (cat (cat 1 1 0 (- n m)) (+ 1 (- n m))
+                          (bits x (- m 2) 0)
+                          (1- m))
+		    (+ (expt 2 (1- n))
+		       (bits x (- m 2) 0))))
+    :rule-classes ()
+    :hints (("Goal" :in-theory (enable cat)
+             :use ((:instance expt-split (r 2) (i (- n m)) (j (1- m))))))))
+
+(local (defthm rebias-up-2
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m)
+		  (= (bitn x (1- m)) 1))
+	     (equal (cat (cat 1 1 0 (- n m)) (+ 1 (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))
+		    (rebias-expo x m n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable rebias-expo bias)
+		  :use (rebias-up-1
+			(:instance bitn-plus-bits (n (1- m)) (m 0)))))))
+
+;BOZO move
+(defthmd bits-of-minus-1
+  (implies (and (integerp i)
+                (integerp j)
+                (<= j i)
+                (<= 0 j)
+                )
+           (equal (bits -1 i j)
+                  (1- (expt 2 (+ 1 i (- j))))))
+  :hints (("Goal" :in-theory (enable bits))))
+
+(local (defthm rebias-up-3
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m)
+		  (= (bitn x (1- m)) 0))
+	     (equal (cat (cat 0 1 (1- (expt 2 (- n m))) (- n m)) (+ 1 (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))
+		    (rebias-expo x m n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (rebias-expo cat bias) (expt-compare)) ;BOZO investigate loopA
+		  :use ((:instance bits-of-minus-1 (j 0) (i (+ -1 N (* -1 M))))
+                        (:instance bitn-plus-bits (n (1- m)) (m 0))
+			(:instance expt-split (r 2) (i (- n m)) (j (1- m))))))))
+
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable bvecp-tighten ;expo-shift-eric
+                                      EXPT-SPLIT
+                                      BITS-BVECP-WHEN-X-IS
+                                      BITS-SLICE-ZERO-GEN
+                                      BITN-KNOWN-NOT-0-REPLACE-WITH-1)
+		  :use (rebias-up-2
+			rebias-up-3
+			(:instance bitn-0-1 (n (1- m)))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/ereps.lisp acl2-6.3/books/rtl/rel9/support/support/ereps.lisp
--- acl2-6.2/books/rtl/rel9/support/support/ereps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/ereps.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,258 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; Eric Smith, David Russinoff, with contributions and suggestions by Matt Kaufmann
+; AMD, June 2001 
+;this file was previously called repsproofs.lisp
+
+(include-book "rtl")
+(include-book "float") ;to get the defns...
+
+(local (include-book "ereps-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+; bias of a q bit exponent field is 2^(q-1)-1 
+(defund bias (q) (- (expt 2 (- q 1)) 1) )
+
+;;Encoding of floating-point numbers with explicit leading one:
+;;bit vectors of length p+q+1, consisting of 1-bit sign field, 
+;;q-bit exponent field (bias = 2**(q-1)-1), and p-bit significand field.
+
+(defund esgnf  (x p q) (bitn x (+ p q)))
+(defund eexpof (x p q) (bits x (1- (+ p q)) p)) 
+(defund esigf  (x p)   (bits x (1- p) 0))
+
+;;;**********************************************************************
+;;;                       REPRESENTABLE NUMBERS
+;;;**********************************************************************
+
+(defund erepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (bvecp (+ (expo x) (bias q)) q)
+       (exactp x p)))
+
+
+;;;**********************************************************************
+;;;                      VALID ENCODINGS
+;;;**********************************************************************
+
+(defund eencodingp (x p q)
+  (and (bvecp x (+ p q 1))
+       (= (bitn x (- p 1)) 1)))
+
+
+;;;**********************************************************************
+;;;                       EENCODE
+;;;**********************************************************************
+
+
+
+; sig, expo, and sgn are defined in float.lisp
+
+
+;bozo disable!
+(defund eencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+	    (+ (expo x) (bias q))
+	    q)
+       (1+ q)
+       (* (sig x) (expt 2 (- p 1)))
+       p) )
+
+
+
+
+;;;**********************************************************************
+;;;                       EDECODE
+;;;**********************************************************************
+
+
+(defund edecode (x p q)
+  (* (if (= (esgnf x p q) 0) 1 -1)
+     (esigf x p)
+     (expt 2 (+ 1 (- p) (eexpof x p q) (- (bias q))))))
+
+
+
+;;;**********************************************************************
+;;;                      Encoding and Decoding are Inverses
+;;;**********************************************************************
+
+(defthm erepp-edecode
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (erepp (edecode x p q) p q)))
+
+
+(defthm eencodingp-eencode
+  (implies (and (erepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (eencodingp (eencode x p q) p q) ))
+
+(defthm edecode-eencode
+  (implies (and (erepp x p q)
+                (integerp p)
+;                (> p 0)
+                (integerp q)
+ ;               (> q 0)
+                )
+           (equal (edecode (eencode x p q) p q)
+                  x )))
+
+(defthm eencode-edecode
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (>= p 0)
+                (integerp q)
+                (> q 0))
+           (equal (eencode (edecode x p q) p q)
+                  x )))
+
+(defthm expo-edecode
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))  
+           (equal (expo (edecode x p q))
+                  (- (eexpof x p q) (bias q))
+                  )))
+
+(defthm sgn-edecode
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (equal (sgn (edecode  x p q))
+                  (if (= (esgnf x p q) 0) 1 -1))))
+
+(defthm sig-edecode
+  (implies (and (eencodingp  x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (equal (sig (edecode  x p q))
+                  (/ (esigf x p) (expt 2 (- p 1))))))
+
+(defthm eencodingp-not-zero
+  (implies (and (eencodingp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (not (equal (edecode x p q) 0))))
+
+(defund rebias-expo (expo old new)
+  (+ expo (- (bias new) (bias old))))
+
+;;I actually needed all four of the following lemmas, although I would have thought
+;;that the two bvecp lemmas would be enough.
+
+(defthm natp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (natp (rebias-expo x m n)))
+    :hints (("goal" :in-theory (e/d ( expt-split rebias-expo bvecp natp bias
+                                                  ) (expt-compare))
+		  :use (:instance expt-weak-monotone (n m) (m n)))))
+
+(defthm natp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (natp (rebias-expo x n m)))
+    :hints (("goal" :in-theory (enable rebias-expo bvecp natp bias))))
+
+(defthm bvecp-rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x m))
+	     (bvecp (rebias-expo x m n) n)))
+
+(defthm bvecp-rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (< 0 m)
+		  (<= m n)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (bvecp (rebias-expo x n m) m)))
+
+(defthm rebias-up
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x m))
+	     (equal (rebias-expo x m n)
+		    (cat (cat (bitn x (1- m))
+			      1
+			      (mulcat 1 (- n m) (lnot (bitn x (1- m)) 1))
+			      (- n m))
+			 (1+ (- n m))
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
+(defthm rebias-down
+    (implies (and (natp n)
+		  (natp m)
+		  (> n m)
+		  (> m 1)
+		  (bvecp x n)
+		  (< x (+ (expt 2 (1- n)) (expt 2 (1- m))))
+		  (>= x (- (expt 2 (1- n)) (expt 2 (1- m)))))
+	     (equal (rebias-expo x n m)
+		    (cat (bitn x (1- n))
+			 1
+			 (bits x (- m 2) 0)
+			 (1- m))))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/fadd-extra.lisp acl2-6.3/books/rtl/rel9/support/support/fadd-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/support/fadd-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/fadd-extra.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,504 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; The original version of this book, before changing land/lior/lxor, is
+; fadd-extra0.lisp.
+
+(in-package "ACL2")
+
+(include-book "fadd-extra0")
+(include-book "land")
+(include-book "lior")
+(include-book "lxor")
+
+(local (in-theory (enable land-is-land0)))
+(local (in-theory (enable lior-is-lior0)))
+(local (in-theory (enable lxor-is-lxor0)))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0)
+               y
+               n)
+         (lior x y n))
+  :hints (("Goal" :use lior0-bits-1)))
+
+(defthmd lior-bits-2
+  (equal (lior x
+               (bits y (1- n) 0)
+               n)
+         (lior x y n))
+  :hints (("Goal" :use lior0-bits-2)))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0)
+               y
+               n)
+         (land x y n))
+  :hints (("Goal" :use land0-bits-1)))
+
+(defthmd land-bits-2
+  (equal (land x
+               (bits y (1- n) 0)
+               n)
+         (land x y n))
+  :hints (("Goal" :use land0-bits-2)))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0)
+               y
+               n)
+         (lxor x y n))
+  :hints (("Goal" :use lxor0-bits-1)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x
+               (bits y (1- n) 0)
+               n)
+         (lxor x y n))
+  :hints (("Goal" :use lxor0-bits-2)))
+
+(defthmd lior-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j)))
+  :hints (("Goal" :use lior0-slice)))
+
+(defthm land-base
+  (equal (land x y 1)
+         (if (and (equal (bitn x 0) 1)
+                  (equal (bitn y 0) 1))
+             1
+           0))
+  :hints (("Goal" :use land0-base))
+  :rule-classes nil)
+
+(defthm lior-base
+  (equal (lior x y 1)
+         (if (or (equal (bitn x 0) 1)
+                 (equal (bitn y 0) 1))
+             1
+           0))
+  :hints (("Goal" :use lior0-base))
+  :rule-classes nil)
+
+(defthm lxor-base
+  (equal (lxor x y 1)
+         (if (iff (equal (bitn x 0) 1)
+                  (equal (bitn y 0) 1))
+             0
+           1))
+  :hints (("Goal" :use lxor0-base))
+  :rule-classes nil)
+
+(defthmd prop-as-lxor
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (if (equal (lxor (bits x i j) (bits y i j) (1+ (- i j)))
+                             (1- (expt 2 (1+ (- i j)))))
+                      1
+                    0)))
+  :hints (("Goal" :use prop-as-lxor0
+           :in-theory (enable log=))))
+
+; new for rel5/:
+
+(defthm half-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1))
+           (equal (+ u v)
+                  (cat (land u v 1) 1 (lxor u v 1) 1)))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :cases ((and (equal u 0) (equal v 0))
+                   (and (equal u 0) (equal v 1))
+                   (and (equal u 1) (equal v 0)))))
+  :rule-classes ())
+
+(defthm full-adder
+  (implies (and (bvecp u 1)
+                (bvecp v 1)
+                (bvecp w 1))
+           (equal (+ u v w)
+                  (cat (lior (land u v 1) (lior (land u w 1) (land v w 1) 1) 1) 1 
+                       (lxor u (lxor v w 1) 1) 1)))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :cases ((and (equal u 0) (equal v 0) (equal w 0))
+                   (and (equal u 0) (equal v 0) (equal w 1))
+                   (and (equal u 0) (equal v 1) (equal w 0))
+                   (and (equal u 0) (equal v 1) (equal w 1))
+                   (and (equal u 1) (equal v 0) (equal w 0))
+                   (and (equal u 1) (equal v 0) (equal w 1))
+                   (and (equal u 1) (equal v 1) (equal w 0)))))
+  :rule-classes ())
+
+(defun rc-carry (x y k)
+  (if (zp k)
+      0
+    (lior (land (bitn x (1- k)) (bitn y (1- k)) 1)
+	  (lior (land (bitn x (1- k)) (rc-carry x y (1- k)) 1)
+		(land (bitn y (1- k)) (rc-carry x y (1- k)) 1)
+		1)
+	  1)))
+
+(defun rc-sum (x y k)
+  (if (zp k)
+      0
+    (cat (lxor (bitn x (1- k))
+	       (lxor (bitn y (1- k)) (rc-carry x y (1- k)) 1)
+	       1)
+	 1
+	 (rc-sum x y (1- k))
+	 (1- k))))
+
+; Start proof of ripple-carry.
+
+(local-defun ripple-carry-prop (x y n)
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n))))
+
+(local (include-book "top1"))
+
+(local (in-theory (disable land-is-land0)))
+(local (in-theory (disable lior-is-lior0)))
+(local (in-theory (disable lxor-is-lxor0)))
+
+(defthm bvecp-rc-carry
+  (bvecp (rc-carry x y k) 1))
+
+(defthm bvecp-rc-sum
+  (bvecp (rc-sum x y k) k))
+
+(local-defthm ripple-carry-prop-base
+  (implies (zp n)
+           (ripple-carry-prop x y n)))
+
+; Speed things up a lot in main-1 (at least), as found by
+; accumulated-persistence.
+(local (in-theory (disable bits-tail
+                           bvecp-tighten
+                           bitn-too-small
+                           bits-upper-bound
+                           bits-less-than-x-gen
+                           bits-less-than-x)))
+
+(local-defthm main-1
+  (implies (and (natp k)
+                (natp x)
+                (natp y)
+                (equal (+ (bits x (+ -1 k) 0)
+                          (bits y (+ -1 k) 0))
+                       (cat (rc-carry x y k)
+                            1
+                            (rc-sum x y k)
+                            k)))
+           (equal (+ (bits x k 0)
+                     (bits y k 0))
+                  (+ (* (expt 2 k)
+                        (+ (bitn x k) (bitn y k)))
+                     (+ (bits x (1- k) 0)
+                        (bits y (1- k) 0)))))
+  :hints (("Goal" :use ((:instance bitn-plus-bits
+                                   (x x)
+                                   (n k)
+                                   (m 0))
+                        (:instance bitn-plus-bits
+                                   (x y)
+                                   (n k)
+                                   (m 0)))))
+  :rule-classes nil)
+
+(local-defthm main-2
+  (implies (and (natp k)
+                (natp x)
+                (natp y)
+                (equal (+ (bits x (+ -1 k) 0)
+                          (bits y (+ -1 k) 0))
+                       (cat (rc-carry x y k)
+                            1
+                            (rc-sum x y k)
+                            k)))
+           (equal (+ (bits x k 0)
+                     (bits y k 0))
+                  (+ (* (expt 2 k)
+                        (+ (bitn x k) (bitn y k)))
+                     (cat (rc-carry x y k)
+                          1
+                          (rc-sum x y k)
+                          k))))
+  :hints (("Goal" :use main-1
+           :in-theory (theory 'minimal-theory)))
+  :rule-classes nil)
+
+(local-defthm main-3-1
+  (implies (and (natp k)
+                (natp x)
+                (natp y))
+           (equal (cat (rc-carry x y k)
+                       1
+                       (rc-sum x y k)
+                       k)
+                  (+ (* (expt 2 k)
+                        (rc-carry x y k))
+                     (rc-sum x y k))))
+  :hints (("Goal" :expand ((cat (rc-carry x y k)
+                                1
+                                (rc-sum x y k)
+                                k))))
+  :rule-classes nil)
+
+(local-defthm main-3
+  (implies (and (natp k)
+                (natp x)
+                (natp y)
+                (equal (+ (bits x (+ -1 k) 0)
+                          (bits y (+ -1 k) 0))
+                       (cat (rc-carry x y k)
+                            1
+                            (rc-sum x y k)
+                            k)))
+           (equal (+ (bits x k 0)
+                     (bits y k 0))
+                  (+ (* (expt 2 k)
+                        (+ (bitn x k)
+                           (bitn y k)
+                           (rc-carry x y k)))
+                     (rc-sum x y k))))
+  :hints (("Goal" :use (main-2 main-3-1)
+           :in-theory (disable rc-sum rc-carry cat)))
+  :rule-classes nil)
+
+(local
+ (encapsulate
+  ()
+
+  (local-defthm main-4-1
+    (implies (and (natp k)
+                  (natp x)
+                  (natp y)
+                  (equal (+ (bits x (+ -1 k) 0)
+                            (bits y (+ -1 k) 0))
+                         (cat (rc-carry x y k)
+                              1
+                              (rc-sum x y k)
+                              k)))
+             (equal (+ (bits x k 0)
+                       (bits y k 0))
+                    (+ (* (expt 2 k)
+                          (let ((u (bitn x k))
+                                (v (bitn y k))
+                                (w (rc-carry x y k)))
+                            (cat (lior (land u v 1)
+                                       (lior (land u w 1) (land v w 1) 1)
+                                       1)
+                                 1 
+                                 (lxor u (lxor v w 1) 1)
+                                 1)))
+                       (rc-sum x y k))))
+    :hints (("Goal" :use (main-3
+                          (:instance full-adder
+                                     (u (bitn x k))
+                                     (v (bitn y k))
+                                     (w (rc-carry x y k))))
+             :in-theory (disable rc-sum rc-carry cat)))
+    :rule-classes nil)
+
+  (local-defthm main-4-2
+    (implies (and (natp k)
+                  (natp x)
+                  (natp y))
+             (equal (cat (rc-carry x y (1+ k))
+                         1 
+                         (bitn (rc-sum x y (1+ k)) k)
+                         1)
+                    (let ((u (bitn x k))
+                          (v (bitn y k))
+                          (w (rc-carry x y k)))
+                      (cat (lior (land u v 1)
+                                 (lior (land u w 1) (land v w 1) 1)
+                                 1)
+                           1 
+                           (lxor u (lxor v w 1) 1)
+                           1)))))
+
+  (defthm main-4
+    (implies (and (natp k)
+                  (natp x)
+                  (natp y)
+                  (equal (+ (bits x (+ -1 k) 0)
+                            (bits y (+ -1 k) 0))
+                         (cat (rc-carry x y k)
+                              1
+                              (rc-sum x y k)
+                              k)))
+             (equal (+ (bits x k 0)
+                       (bits y k 0))
+                    (+ (* (expt 2 k)
+                          (cat (rc-carry x y (1+ k))
+                               1 
+                               (bitn (rc-sum x y (1+ k)) k)
+                               1))
+                       (rc-sum x y k))))
+    :instructions (:promote
+                   (:dv 2 1 2 0)
+                   (:rewrite main-4-2)
+                   :top
+                   (:use main-4-1)
+                   :split)
+    :rule-classes nil)))
+
+(local-defthm main-5
+  (implies (and (natp k)
+                (natp x)
+                (natp y)
+                (equal (+ (bits x (+ -1 k) 0)
+                          (bits y (+ -1 k) 0))
+                       (cat (rc-carry x y k)
+                            1
+                            (rc-sum x y k)
+                            k)))
+           (equal (+ (bits x k 0)
+                     (bits y k 0))
+                  (+ (* (expt 2 (1+ k))
+                        (rc-carry x y (1+ k)))
+                     (* (expt 2 k)
+                        (bitn (rc-sum x y (1+ k)) k))
+                     (rc-sum x y k))))
+  :hints (("Goal" :use main-4
+           :expand ((cat (rc-carry x y (1+ k))
+                         1 
+                         (bitn (rc-sum x y (1+ k)) k)
+                         1))
+           :in-theory (e/d (bits-tail) (rc-sum rc-carry))))
+  :rule-classes nil)
+
+(local
+ (encapsulate
+  ()
+
+  (local-defthm main-6-1-1
+    (implies (and (natp k)
+                  (natp x)
+                  (natp y))
+             (equal (bits (rc-sum x y (1+ k)) (1- k) 0)
+                    (rc-sum x y k)))
+    :hints (("Goal" 
+             :expand ((rc-sum x y (1+ k)))
+             :in-theory (e/d (cat) (rc-sum)))))
+
+  (local-defthm main-6-1
+    (implies (and (natp k)
+                  (natp x)
+                  (natp y))
+             (equal (rc-sum x y (1+ k))
+                    (+ (* (expt 2 k)
+                          (bitn (rc-sum x y (1+ k)) k))
+                       (rc-sum x y k))))
+    :hints (("Goal" :use ((:instance bitn-plus-bits
+                                     (x (rc-sum x y (1+ k)))
+                                     (n k)
+                                     (m 0)))
+             :expand ((rc-sum x y 0))
+             :in-theory (e/d (bits-tail) (rc-sum rc-carry))))
+    :rule-classes nil)
+
+  (defthm main-6
+    (implies (and (natp k)
+                  (natp x)
+                  (natp y)
+                  (equal (+ (bits x (+ -1 k) 0)
+                            (bits y (+ -1 k) 0))
+                         (cat (rc-carry x y k)
+                              1
+                              (rc-sum x y k)
+                              k)))
+             (equal (+ (bits x k 0)
+                       (bits y k 0))
+                    (+ (* (expt 2 (1+ k))
+                          (rc-carry x y (1+ k)))
+                       (rc-sum x y (1+ k)))))
+    :hints (("Goal" :use (main-5 main-6-1)
+             :in-theory (disable rc-sum rc-carry)))
+    :rule-classes nil)))
+
+(local-defthm main
+  (implies (and (natp k)
+                (natp x)
+                (natp y)
+                (equal (+ (bits x (+ -1 k) 0)
+                          (bits y (+ -1 k) 0))
+                       (cat (rc-carry x y k)
+                            1
+                            (rc-sum x y k)
+                            k)))
+           (equal (+ (bits x k 0)
+                     (bits y k 0))
+                  (cat (rc-carry x y (1+ k))
+                       1
+                       (rc-sum x y (1+ k))
+                       (1+ k))))
+  :hints (("Goal" :use main-6
+           :expand ((cat (rc-carry x y (1+ k))
+                         1
+                         (rc-sum x y (1+ k))
+                         (1+ k)))
+           :in-theory (e/d (bits-tail) (rc-sum rc-carry))))
+  :rule-classes nil)
+
+(local-defthm ripple-carry-prop-induction-step
+  (implies (and (not (zp n))
+                (ripple-carry-prop x y (1- n)))
+           (ripple-carry-prop x y n))
+  :hints (("Goal" :use ((:instance main (k (1- n))))
+           :in-theory (disable rc-sum rc-carry cat))))
+
+(local-defthm ripple-carry-prop-proved
+  (ripple-carry-prop x y n)
+  :hints (("Goal" :induct (rc-sum x y n)
+           :in-theory (disable ripple-carry-prop))))
+
+(defthm ripple-carry
+  (implies (and (natp x)
+                (natp y)
+                (natp n))
+           (equal (+ (bits x (1- n) 0) (bits y (1- n) 0))
+                  (cat (rc-carry x y n) 1 (rc-sum x y n) n)))
+  :hints (("Goal" :use ripple-carry-prop-proved
+           :in-theory (union-theories '(ripple-carry-prop)
+                                      (theory 'ground-zero))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/support/fadd-extra0.lisp acl2-6.3/books/rtl/rel9/support/support/fadd-extra0.lisp
--- acl2-6.2/books/rtl/rel9/support/support/fadd-extra0.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/fadd-extra0.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,618 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This book, but with land0/lior0/lxor0 replaced by land/lior/lxor, was the
+; original state of fadd-extra.lisp.
+
+(in-package "ACL2")
+
+; This book illustrates how to extend the library.
+
+; Typically, one first does the proof after including ../lib/top/.  (For this
+; particular file we happened to include ../lib/ books bits, arith, and util.)
+; But in order to prove them in this support/ directory, we instead locally
+; include a book top1 and put ourselves in a theory, lib-top1.  The resulting
+; environment is the same (or at least very close to the same) as the
+; environment after including ../lib/top -- or more precisely, a snapshot of
+; lib/top at the time top1 was created.  The present book is locally included
+; in ../lib/fadd.lisp.
+
+; Some day there might be a need for top2 and theory lib-top2, which will
+; include the state of lib/top after the inclusion of the present book
+; (fadd-extra.lisp) and any other *-extra.lisp books in this support/
+; directory.  But that should be a long time off.
+
+; A reasonable book name in this directory could be
+; <lib-book-name>-extra.lisp.
+
+; Be sure to modify the Makefile and top.lisp accordingly.  You can do this by
+; searching in those files for fadd-extra and making the analogous mods.
+
+(include-book "rtl")  ; needed for some definitions
+(include-book "fadd") ; needed for some definitions
+
+; Now put ourselves in what amounts to the environment of ../lib/top, as
+; explained above.
+(local (include-book "top1"))
+(local (in-theory (theory 'lib-top1)))
+
+; Proof of bits-sum-swallow:
+
+; Proof:  Since y < 2^(k+1), y[i:k+1] = 0.  
+; 
+; Since x[k] = 0, x[k:0] = x[k-1:0] < 2^k.
+; 
+; Hence, 
+; 
+;   x[k:0] + y[k:0] < 2^k + 2^k = 2^(k+1) 
+; 
+; and 
+; 
+;   (x[k:0] + y[k:0])[k+1] = 0.
+; 
+; By BITS-SUM-ORIGINAL,
+; 
+;   (x+y)[i:k+1] = (x[i:k+1] + y[i:k+1] + (x[k:0] + y[k:0])[k+1])[i-k-1:0]
+;                = (x[i:k+1])[i-k-1:0]
+;                = x[i:k+1] {by BITS-BITS}.
+; 
+; By BITS-BITS,
+; 
+;   (x+y)[i:j] = (x+y)[i:k+1][i-k-1:j-k-1] 
+;              = x[i:k+1][i-k-1:j-k-1] 
+;              = x[i:j].
+
+(local-defthm bits<expt
+  (implies (and (natp x)
+                (integerp i)
+                (natp j)
+                (<= j i)
+                (equal n (1+ (- i j))))
+           (< (bits x i j)
+              (expt 2 n)))
+  :hints (("Goal" :use ((:instance bits-bvecp
+                                   (k n)))
+           :in-theory (e/d (bvecp) (bits-bvecp bits-bvecp-simple))))
+  :rule-classes :linear)
+
+(local-defthm bits-sum-swallow-1-1-1-1
+  (implies (and (natp x)
+                (natp k)
+                (= (bitn x k) 0))
+           (< (bits x k 0)
+              (expt 2 k)))
+  :hints (("Goal" :use ((:instance bitn-plus-bits (n k) (m 0))
+                        (:theorem (or (zp k) (< 0 k))))))
+  :rule-classes :linear)
+
+(local-defthm bits-sum-swallow-1-1-1-2
+  (implies (and (natp y)
+                (natp k)
+                (<= y (expt 2 k)))
+           (equal (bits y k 0) y))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :expand ((expt 2 (1+ k))))))
+
+(local-defthm bits-sum-swallow-1-1-1
+  (implies (and (natp x)
+                (natp y)
+                (natp k)
+                (= (bitn x k) 0)
+                (<= y (expt 2 k)))
+           (< (+ (bits x k 0) (bits y k 0))
+              (expt 2 (1+ k))))
+  :hints (("Goal" :expand ((expt 2 (1+ k)))))
+  :rule-classes nil)
+
+(local-defthm bits-sum-swallow-1-1
+  (implies (and (natp x)
+                (natp y)
+                (natp k)
+                (= (bitn x k) 0)
+                (<= y (expt 2 k)))
+           (equal (bitn (+ (bits x k 0) (bits y k 0))
+                        (1+ k))
+                  0))
+  :hints (("Goal" :in-theory (enable bvecp) ; for bvecp-bitn-0
+           :use bits-sum-swallow-1-1-1))
+  :rule-classes nil)
+
+(local-defthm bits-sum-swallow-1-2
+  (implies (and (natp y)
+                (natp k)
+                (>= i k)
+                (<= y (expt 2 k)))
+           (equal (bits y i (1+ k))
+                  0))
+  :hints (("Goal" :in-theory (enable bvecp-bits-0 bvecp)
+           :expand ((expt 2 (1+ k))))))
+
+(local-defthm bits-sum-swallow-1
+  (implies (and (natp x)
+                (natp y)
+                (natp k)
+                (>= i k)
+                (= (bitn x k) 0)
+                (<= y (expt 2 k)))
+            (equal (bits (+ x y) i (1+ k))
+                   (bits x i (1+ k))))
+  :hints (("Goal" :use ((:instance bits-sum-original (j (1+ k)))
+                        bits-sum-swallow-1-1))))
+
+(defthmd bits-sum-swallow
+  (implies (and (equal (bitn x k) 0)
+                (natp x)
+                (natp y)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (>= i j)
+                (> j k)
+                (>= k 0)
+                (<= y (expt 2 k)))
+           (equal (bits (+ x y) i j)
+                  (bits x i j)))
+  :hints (("Goal"
+           ;; We deliberately leave bits-bits enabled because we need another
+           ;; instance of it too.
+           :use ((:instance bits-bits
+                            (x (+ x y))
+                            (i i)
+                            (j (1+ k))
+                            (k (1- (- i k)))
+                            (l (1- (- j k))))))))
+
+(defthmd bits-sum-of-bits
+  (implies (and (integerp x)
+                (integerp y)
+                (natp i))
+           (equal (bits (+ x (bits y i 0)) i 0)
+                  (bits (+ x y) i 0)))
+  :hints (("Goal" :use ((:instance bits-sum-original
+                                   (x x)
+                                   (y (bits y i 0))
+                                   (i i)
+                                   (j 0))
+                        (:instance bits-sum-original
+                                   (x x)
+                                   (y y)
+                                   (i i)
+                                   (j 0))))))
+
+(defthm bits-sum-3-original
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z)
+                (integerp i)
+                (integerp j))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (bitn (+ (bits x (1- j) 0) (bits y (1- j) 0))
+                                 j)
+                           (bitn (+ (bits (+ x y) (1- j) 0) (bits z (1- j) 0))
+                                 j))
+                        (- i j) 0)))
+  :hints (("Goal" :use ((:instance bits-sum-original
+                                   (x x)
+                                   (y y)
+                                   (i (1- j))
+                                   (j 0))
+                        (:instance bits-sum-original
+                                   (x x)
+                                   (y y)
+                                   (i i)
+                                   (j j))
+                        (:instance bits-sum-original
+                                   (x (+ x y))
+                                   (y z)
+                                   (i i)
+                                   (j j))
+                        (:instance bits-sum-of-bits
+                                   (x (+ (bits z i j)
+                                         (bitn (+ (bits z (1- j) 0)
+                                                  (bits (+ x y) (1- j) 0))
+                                               j)))
+                                   (y (+ (bits x i j)
+                                         (bits y i j)
+                                         (bitn (+ (bits x (1- j) 0)
+                                                  (bits y (1- j) 0))
+                                               j)))
+                                   (i (+ i (* -1 j)))))))
+  :rule-classes ())
+
+(local-defthm bits-sum-3-with-gen-normal-case
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z)
+                (integerp i)
+                (integerp j)
+                (< 0 j))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :hints (("Goal" :use bits-sum-3-original
+           :in-theory (enable gen-val-cor1)))
+  :rule-classes ())
+
+(local-defthm bits-sum-3-with-gen-numberp-not-integerp-i
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z)
+                (integerp j)
+                (acl2-numberp i)
+                (not (integerp i)))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :hints (("Goal" :use (bits-sum-3-original bits-sum-3-with-gen-normal-case)
+           :in-theory (enable bits-with-i-not-an-integer
+                              bits-with-j-not-an-integer)))
+  :rule-classes ())
+
+(local-defthm bits-sum-3-with-gen-not-numberp-i-positive-j
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z)
+                (integerp j)
+                (> j 0)
+                (not (acl2-numberp i)))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :hints (("Goal" :use (bits-sum-3-original bits-sum-3-with-gen-normal-case)
+           :in-theory (enable bits-with-i-not-an-integer
+                              bits-with-j-not-an-integer)))
+  :rule-classes ())
+
+(local-defthm bits-sum-3-with-gen-not-numberp-i-not-positive-j
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp z)
+                (integerp j)
+                (<= j 0)
+                (not (acl2-numberp i)))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :hints (("Goal" :use (bits-sum-3-original bits-sum-3-with-gen-normal-case)
+           :in-theory (enable bits-with-i-not-an-integer
+                              bits-with-j-not-an-integer)))
+  :rule-classes ())
+
+(defthm bits-sum-3
+  (implies (and (integerp x) (integerp y) (integerp z))
+           (equal (bits (+ x y z) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bits z i j)
+                           (gen x y (1- j) 0)
+                           (gen (+ x y) z (1- j) 0))
+                        (- i j) 0)))
+  :hints (("Goal" :use (bits-sum-3-original bits-sum-3-with-gen-normal-case
+                                   bits-sum-3-with-gen-numberp-not-integerp-i
+                                   bits-sum-3-with-gen-not-numberp-i-positive-j
+                                   bits-sum-3-with-gen-not-numberp-i-not-positive-j)
+           :in-theory (enable bits-with-j-not-an-integer)))
+  :rule-classes ())
+
+; Proof of lior0-slice:
+
+; Note that (2^i - 2^j) = 2^j(2^(i-j)-1) = {2^(i-j)-1,j'b0}
+
+; x[n-1:0] | (2^i - 2^j) =
+; {x[n-1:i], x[i-1:j], x[j-1:0]} | {(n-i)'b0, 2^(i-j), j'b0} =
+; [by LIOR0-CAT, LIOR0-0, and LIOR0-ONES]
+; {{x[n-1:i], 2^(i-j)-1, x[j-1:0]}.
+
+(local-defthm lior0-slice-1
+  (implies (and (<= j i)
+                (<= i n)
+                (integerp n)
+                (integerp i)
+                (integerp j)
+                (<= 0 j))
+           (equal (cat (bits x (1- n) i) (- n i)
+                       (bits x (1- i) j) (- i j)
+                       (bits x (1- j) 0) j)
+                  (bits x (1- n) 0)))
+  :hints (("Goal" :use ((:instance cat-bits-bits
+                                   (x (bits x (1- i) 0))
+                                   (i (1- i))
+                                   (j j)
+                                   (k (1- j))
+                                   (l 0)
+                                   (m (- i j))
+                                   (n j))
+                        (:instance cat-bits-bits
+                                   (x x)
+                                   (i (1- n))
+                                   (j i)
+                                   (k (1- i))
+                                   (l 0)
+                                   (m (- n i))
+                                   (n i)))))
+  :rule-classes nil)
+
+(local-defthm bvecp-power-of-2-minus-1
+  (implies (and (integerp k)
+                (equal k k2)
+                (< 0 k))
+           (bvecp (1- (expt 2 k))
+                  k2))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+(local-defthm bvecp-power-of-2-minus-1-alt
+  (implies (and (natp k)
+                (equal k2 (1+ k)))
+           (bvecp (1- (* 2 (expt 2 k)))
+                  k2))
+  :hints (("Goal" :in-theory (enable bvecp expt))))
+
+(local-defthm lior0-slice-2
+  (implies (and (<= j i)
+                (<= i n)
+                (integerp n)
+                (integerp i)
+                (integerp j)
+                (<= 0 j))
+           (equal (cat 0                     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       0                     j)
+                  (- (expt 2 i) (expt 2 j))))
+  ;; The following hint is very weird!!  It can't be on Goal or Goal'.  The
+  ;; idea came from a proof-checker proof.  I should investigate....
+  :hints (("Goal''" :in-theory (enable cat expt)))
+  :rule-classes nil)
+
+(local
+ (defthmd lior0-slice-3-1
+   (implies (and (<= j i)
+                 (integerp i)
+                 (integerp j)
+                 (<= 0 j)
+                 (equal k (1- (expt 2 (- i j))))
+                 (equal diff (- i j)))
+            (equal (lior0 k
+                         (bits x (1- i) j)
+                         diff)
+                   (1- (expt 2 (- i j)))))
+   :hints (("Goal" :use ((:instance lior0-ones
+                                    (x (bits x (1- i) j))
+                                    (n (- i j))))))))
+
+(local-defthm lior0-slice-3
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior0 (cat (bits x (1- n) i) (- n i)
+                             (bits x (1- i) j) (- i j)
+                             (bits x (1- j) 0) j)
+                        (cat 0                     (- n i)
+                             (1- (expt 2 (- i j))) (- i j)
+                             0                     j)
+                        n)
+                  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j)))
+  :hints (("Goal" :in-theory (e/d (lior0-cat lior0-slice-3-1)
+                                  (cat-bits-bits cat-0))
+           :cases ((and (equal j i) (equal j 0) (equal i n))
+                   (and (equal j i) (not (equal j 0)) (equal i n))
+                   (and (not (equal j i)) (equal j 0) (equal i n))
+                   (and (equal j i) (equal j 0) (not (equal i n)))
+                   (and (equal j i) (not (equal j 0)) (not (equal i n)))
+                   (and (not (equal j i)) (equal j 0) (not (equal i n)))
+                   (and (not (equal j i)) (not (equal j 0)) (not (equal i n))))))
+  :rule-classes nil)
+
+(local-defthm lior0-slice-almost
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior0 (bits x (1- n) 0)
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j)))
+  :hints (("Goal" :use (lior0-slice-1 lior0-slice-2 lior0-slice-3)
+           :in-theory (theory 'ground-zero)))
+  :rule-classes nil)
+
+(defthmd lior0-slice
+  (implies (and (<= j i)
+		(<= i n)
+		(integerp n)
+		(integerp i)
+		(integerp j)
+		(<= 0 j))
+	   (equal (lior0 x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+		  (cat (bits x (1- n) i)     (- n i)
+                       (1- (expt 2 (- i j))) (- i j)
+                       (bits x (1- j) 0)     j)))
+  :hints (("Goal" :use (lior0-slice-almost)
+           :in-theory (enable lior0-bits-1))))
+
+(local (in-theory (theory 'lib-top1)))
+
+(local-defthm lxor0-1-not-2
+  (equal (equal 2 (lxor0 i j 1))
+         nil)
+  :hints (("Goal" :expand ((lxor0 i j 1))
+           :use ((:instance acl2::bvecp-1-rewrite
+                            (acl2::x (bitn i 0)))
+                 (:instance acl2::bvecp-1-rewrite
+                            (acl2::x (bitn j 0)))))))
+
+(local
+ (encapsulate
+  ()
+
+  (local-defthm bitn-of-1-less-than-power-of-2-lemma-1
+    (implies (natp j)
+             (equal (bitn (1- (expt 2 (1+ j))) j)
+                    1))
+    :hints (("Goal" :in-theory (enable acl2::bvecp-bitn-1 bvecp)
+             :expand ((expt 2 (+ 1 j))))))
+
+  (defthm bitn-of-1-less-than-power-of-2
+    (implies (and (integerp i)
+                  (natp j)
+                  (< j i))
+             (equal (bitn (1- (expt 2 i)) j)
+                    1))
+    :hints (("Goal" :use ((:instance acl2::bitn-plus-mult
+                                     (acl2::x (1- (expt 2 (1+ j))))
+                                     (acl2::k (1- (expt 2 (- i (1+ j)))))
+                                     (acl2::m (1+ j))
+                                     (acl2::n j))))))))
+                                   
+(local-defun prop-as-lxor0-thm (i j x y)
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (log= (lxor0 (bits x i j) (bits y i j) (1+ (- i j)))
+                        (1- (expt 2 (1+ (- i j))))))))
+
+(local-defthm prop-as-lxor0-thm-proved-1
+  (implies (not (and (natp i) (natp j) (<= j i)))
+           (prop-as-lxor0-thm i j x y)))
+
+(local-defthm prop-as-lxor0-thm-proved-3-1
+  (implies (and (integerp i)
+                (<= 0 i)
+                (integerp j)
+                (<= 0 j)
+                (<= j i)
+                (equal (bitn x i) (bitn y i))
+                (integerp x)
+                (<= 0 x)
+                (integerp y)
+                (<= 0 y))
+           (not (equal (bitn (+ -1 (expt 2 (+ 1 i (* -1 j)))) (- i j))
+                       (bitn (lxor0 (bits x i j)
+                                   (bits y i j)
+                                   (+ 1 i (* -1 j)))
+                             (- i j)))))
+  :rule-classes nil)
+
+(local-defthm prop-as-lxor0-thm-proved-3
+  (implies (and (and (natp i) (natp j) (<= j i))
+                (= (bitn x i) (bitn y i)))
+           (prop-as-lxor0-thm i j x y))
+  :hints (("Goal" :use prop-as-lxor0-thm-proved-3-1
+           :in-theory (e/d (log=)
+                           (bitn-of-1-less-than-power-of-2)))))
+
+(local (in-theory (enable bvecp-0)))
+
+(local-defthm prop-as-lxor0-thm-proved-2
+  (implies (and (and (natp i) (natp j) (<= j i))
+                (not (= (bitn x i) (bitn y i)))
+                (prop-as-lxor0-thm (+ -1 i) j x y))
+           (prop-as-lxor0-thm i j x y))
+  :hints (("Goal" :in-theory (enable log=)
+           :expand ((expt 2 (+ 1 i (* -1 j))))
+           :use ((:instance acl2::bitn-plus-bits (acl2::m 0)
+                            (n (- i j))
+                            (acl2::x (lxor0 (bits x i j)
+                                           (bits y i j)
+                                           (+ 1 i (* -1 j)))))
+                 (:instance acl2::bvecp-1-rewrite
+                            (acl2::x (bitn x i)))
+                 (:instance acl2::bvecp-1-rewrite
+                            (acl2::x (bitn y i)))
+                 (:instance acl2::bvecp-1-rewrite
+                            (acl2::x (bitn x 0)))
+                 (:instance acl2::bvecp-1-rewrite
+                            (acl2::x (bitn y 0)))))))
+
+(local-defthm prop-as-lxor0-thm-proved
+  (prop-as-lxor0-thm i j x y)
+  :hints (("Goal" :induct (prop x y i j)
+           :in-theory (disable prop-as-lxor0-thm)))
+  :rule-classes nil)
+
+(defthmd prop-as-lxor0
+  (implies (and (natp i)
+                (natp j)
+                (<= j i)
+                (natp x)
+                (natp y))
+           (equal (prop x y i j)
+                  (log= (lxor0 (bits x i j) (bits y i j) (1+ (- i j)))
+                        (1- (expt 2 (1+ (- i j)))))))
+  :hints (("Goal" :use prop-as-lxor0-thm-proved)))
+
+; Added for rel5: bitn-neg
+
+(local-defthm bitn-neg-1
+  (implies (natp x)
+           (equal (bitn x -1) 0))
+  :hints (("Goal" :use ((:instance bits-times-2 (x x) (i 0) (j 0))
+                        (:instance bitn-rec-0 (x (* 2 x))))
+           :in-theory (e/d (bitn) (bits-n-n-rewrite)))))
+
+(local-defun bitn-neg-induction (x n)
+  (if (zp n)
+      (+ x n)
+    (bitn-neg-induction (* 2 x) (1- n))))
+
+(defthm bitn-neg-alt
+  (implies (and (natp x)
+                (integerp k)
+                (< 0 k))
+           (equal (bitn x (* -1 k)) 0))
+  :hints (("Goal" :induct (bitn-neg-induction x k))
+          ("Subgoal *1/2.1"
+           :use ((:instance bits-times-2 (x x) (i (- 1 k)) (j (- 1 k)))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/fadd.lisp acl2-6.3/books/rtl/rel9/support/support/fadd.lisp
--- acl2-6.2/books/rtl/rel9/support/support/fadd.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/fadd.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1228 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "stick"))
+(local (include-book "lop3"))
+(local (include-book "add3"))
+(local (include-book "bitn"))
+(local (include-book "bits"))
+(local (include-book "../../arithmetic/top"))
+
+(include-book "rtl") ; need definition of, at least, bitn
+(include-book "float")
+
+;;;**********************************************************************
+;;;                     GENERATE AND PROPAGATE
+;;;**********************************************************************
+
+;;Once the lemmas below are in place, the lemmas BITS-SUM-ORIGINAL, 
+;;BITS-SUM-SPECIAL-CASE, and BITS-SUM-PLUS-1-ORIGINAL of book "bits" should be
+;;deleted.
+
+(defun gen (x y i j)
+; generates a carry
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  (bitn x i)
+	(gen x y (1- i) j))
+    0))
+
+(defun prop (x y i j)
+; propagates a carry-in from below
+  (declare (xargs :measure (nfix (1+ i))))
+  (if (and (natp i) (natp j) (>= i j))
+      (if (= (bitn x i) (bitn y i))
+	  0
+	(prop x y (1- i) j))
+    1))
+
+(local (in-theory (enable bits-n-n-rewrite)))
+
+(encapsulate
+ ()
+
+ (local
+  (defthm gen-val-lemma-1
+    (implies (not (equal (bitn x i) (bitn y i)))
+             (equal (< (+ (bits x i j) (bits y i j))
+                       (expt 2 (+ 1 i (* -1 j))))
+                    (< (+ (bits x (1- i) j)
+                          (bits y (1- i) j))
+                       (expt 2 (+ i (* -1 j))))))
+    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
+             :use ((:instance bitn-plus-bits
+                              (x x)
+                              (n i)
+                              (m j))
+                   (:instance bitn-plus-bits
+                              (x y)
+                              (n i)
+                              (m j)))))))
+
+ (local
+  (defthm gen-val-lemma-2
+    (implies (and (equal (bitn x i) 0)
+                  (equal (bitn y i) 0))
+             (< (+ (bits x i j) (bits y i j))
+                (expt 2 (+ 1 i (* -1 j)))))
+    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
+             :use ((:instance bitn-plus-bits
+                              (x x)
+                              (n i)
+                              (m j))
+                   (:instance bitn-plus-bits
+                              (x y)
+                              (n i)
+                              (m j)))))))
+
+ (local
+  (defthm gen-val-lemma-3
+    (implies (and (integerp j)
+                  (<= j i)
+                  (equal (bitn x i) 1)
+                  (equal (bitn y i) 1))
+             (>= (+ (bits x i j) (bits y i j))
+                 (expt 2 (+ 1 i (* -1 j)))))
+    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
+             :use ((:instance bitn-plus-bits
+                              (x x)
+                              (n i)
+                              (m j))
+                   (:instance bitn-plus-bits
+                              (x y)
+                              (n i)
+                              (m j)))))))
+
+ (defthmd gen-val
+   (implies (and (natp j) (>= i j))
+            (equal (gen x y i j)
+                   (if (>= (+ (bits x i j) (bits y i j))
+                           (expt 2 (1+ (- i j))))
+                       1
+                     0)))))
+
+(encapsulate
+ ()
+
+ (local
+  (defthm prop-val-lemma-1
+    (implies (and (integerp j)
+                  (<= j i)
+                  (not (equal (bitn x i) (bitn y i))))
+             (equal (equal (+ 1 (bits x i j) (bits y i j))
+                           (expt 2 (+ 1 i (* -1 j))))
+                    (equal (+ 1 (bits x (1- i) j)
+                              (bits y (1- i) j))
+                           (expt 2 (+ i (* -1 j))))))
+    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
+             :use ((:instance bitn-plus-bits
+                              (x x)
+                              (n i)
+                              (m j))
+                   (:instance bitn-plus-bits
+                              (x y)
+                              (n i)
+                              (m j)))))))
+
+ (local
+  (defthm prop-val-lemma-2
+    (implies (and (integerp i)
+                  (integerp j)
+                  (<= j i)
+                  (equal (bitn x i) (bitn y i)))
+             (not (equal (+ 1 (bits x i j) (bits y i j))
+                         (expt 2 (+ 1 i (* -1 j))))))
+    :hints (("Goal" :expand ((expt 2 (+ 1 i (* -1 j))))
+             :use ((:instance bitn-plus-bits
+                              (x x)
+                              (n i)
+                              (m j))
+                   (:instance bitn-plus-bits
+                              (x y)
+                              (n i)
+                              (m j)))))))
+
+ (defthmd prop-val
+   (implies (and (integerp i) (natp j) (>= i j))
+            (equal (prop x y i j)
+                   (if (= (+ (bits x i j) (bits y i j))
+                          (1- (expt 2 (1+ (- i j)))))
+                       1
+                     0)))))
+
+(local
+ (defthmd bits-split-rewrite
+   (implies (and (natp i)
+                 (natp j)
+                 (natp k)
+                 (< j k)
+                 (<= k i))
+            (equal (bits x i j)
+                   (+ (* (expt 2 (- k j))
+                         (bits x i k))
+                      (bits x (1- k) j))))
+   :hints (("Goal"
+            :in-theory (e/d (cat) (cat-bits-bits))
+            :use ((:instance cat-bits-bits
+                             (x x)
+                             (i i)
+                             (j k)
+                             (k (1- k))
+                             (l j)
+                             (m (1+ (- i j)))
+                             (n (+ (- j) k))))))))
+
+(local
+ (defthm gen-extend-1
+   (implies (and (natp j)
+                 (integerp k)
+                 (> i k)
+                 (>= k j)
+                 (equal (gen x y i (1+ k)) 1))
+            (equal (gen x y i j)
+                   (lior0 (gen x y i (1+ k))
+                         (land0 (prop x y i (1+ k))
+                               (gen x y k j)
+                               1)
+                         1)))
+   :rule-classes ()))
+
+(local
+ (defthm gen-extend-2
+   (implies (and (> i k)
+                 (>= k j)
+                 (equal (gen x y i (1+ k)) 0)
+                 (equal (prop x y i (1+ k)) 0))
+            (equal (gen x y i j)
+                   (lior0 (gen x y i (1+ k))
+                         (land0 (prop x y i (1+ k))
+                               (gen x y k j)
+                               1)
+                         1)))
+   :rule-classes ()))
+
+(local
+ (defthmd hack-2
+   (implies (and (integerp i)
+                 (integerp j)
+                 (integerp k)
+                 (> i k)
+                 (> k j))
+            (equal (expt 2 (+ i (* -1 j)))
+                   (* (expt 2 (+ i (* -1 k)))
+                      (expt 2 (+ k (* -1 j))))))))
+
+(local
+ (defthm expt-open-+1
+   (implies (force (natp n))
+            (equal (expt 2 (1+ n))
+                   (* 2 (expt 2 n))))))
+
+(local
+ (defthm gen-extend-3-k=j
+   (implies (and (integerp i)
+                 (> i j)
+                 (equal (gen x y i (1+ j)) 0)
+                 (equal (prop x y i (1+ j)) 1))
+            (equal (gen x y i j)
+                   (lior0 (gen x y i (1+ j))
+                         (land0 (prop x y i (1+ j))
+                               (gen x y j j)
+                               1)
+                         1)))
+   :hints (("Goal" :in-theory (enable bits-split-rewrite hack-2 gen-val prop-val)
+            :restrict ((bits-split-rewrite ((x x) (i i) (j j) (k (1+ j)))
+                                           ((x y) (i i) (j j) (k (1+ j)))))))
+   :rule-classes ()))
+
+(local
+ (defthm gen-extend-3-k>j
+   (implies (and (integerp i)
+                 (integerp k)
+                 (> i k)
+                 (> k j)
+                 (equal (gen x y i (1+ k)) 0)
+                 (equal (prop x y i (1+ k)) 1))
+            (equal (gen x y i j)
+                   (lior0 (gen x y i (1+ k))
+                         (land0 (prop x y i (1+ k))
+                               (gen x y k j)
+                               1)
+                         1)))
+   :hints (("Goal" :in-theory (enable bits-split-rewrite hack-2 gen-val prop-val)
+            :restrict ((bits-split-rewrite ((x x) (i i) (j j) (k (1+ k)))
+                                           ((x y) (i i) (j j) (k (1+ k)))))))
+   :rule-classes ()))
+
+(local
+ (defthm gen-extend-3
+   (implies (and (integerp i)
+                 (integerp k)
+                 (> i k)
+                 (>= k j)
+                 (equal (gen x y i (1+ k)) 0)
+                 (equal (prop x y i (1+ k)) 1))
+            (equal (gen x y i j)
+                   (lior0 (gen x y i (1+ k))
+                         (land0 (prop x y i (1+ k))
+                               (gen x y k j)
+                               1)
+                         1)))
+   :hints (("Goal" :use (gen-extend-3-k>j gen-extend-3-k=j)))
+   :rule-classes ()))
+
+(local
+ (defthm gen-is-0-or-1
+   (implies (not (equal (gen x y i k) 0))
+            (equal (gen x y i k) 1))
+   :hints (("Goal" :in-theory (enable gen-val)))
+   :rule-classes ((:forward-chaining :trigger-terms ((gen x y i k))))))
+
+(local
+ (defthm prop-is-0-or-1
+   (implies (not (equal (prop x y i k) 0))
+            (equal (prop x y i k) 1))
+   :hints (("Goal" :in-theory (enable prop-val)))
+   :rule-classes ((:forward-chaining :trigger-terms ((prop x y i k))))))
+
+(defthmd gen-extend-original
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp k)
+                (> i k)
+                (>= k j)
+                (>= j 0))
+           (equal (lior0 (gen x y i (1+ k))
+                        (land0 (gen x y k j)
+                              (prop x y i (1+ k))
+                              1)
+                        1)
+                  (gen x y i j)))
+  :hints (("Goal" :use (gen-extend-1 gen-extend-2 gen-extend-3))))
+
+(local
+ (defthmd bitn-1-iff-at-least-2^n
+   (implies (and (integerp n)
+                 (bvecp x (1+ n)))
+            (equal (bitn x n)
+                   (if (< x (expt 2 n))
+                       0
+                     1)))
+   :hints (("Goal" :in-theory (enable bvecp)
+            :use ((:instance bitn-plus-bits
+                             (x x)
+                             (n n)
+                             (m 0)))))))
+
+(local
+ (defthm bvecp-+
+   (implies (and (not (zp k))
+                 (equal n (1- k))
+                 (bvecp x n)
+                 (bvecp y n))
+            (bvecp (+ x y) k))
+   :hints (("Goal" :in-theory (enable bvecp)
+            :expand ((expt 2 k))))))
+
+(local
+ (defthm bvecp-+-1
+   (implies (and (not (zp k))
+                 (equal n (1- k))
+                 (bvecp x n)
+                 (bvecp y n))
+            (bvecp (+ 1 x y) k))
+   :hints (("Goal" :in-theory (enable bvecp)
+            :expand ((expt 2 k))))))
+
+(local
+ (defthmd integerp-expt-2-forced
+   (implies (and (force (integerp n))
+                 (force (<= 0 n)))
+            (and (integerp (expt 2 n))
+                 (< 0 (expt 2 n))))
+   :rule-classes :type-prescription))
+
+(defthm gen-extend-cor
+  (implies (and (natp x)
+                (natp y)
+                (natp i)
+                (natp j)
+                (natp k)
+                (> i k)
+                (>= k j))
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i (1+ k))
+                           (bits y i (1+ k))
+                           (gen x y k j))
+                        (- i k))))
+  :hints (("Goal" :use gen-extend-original
+           :in-theory (enable integerp-expt-2-forced bitn-1-iff-at-least-2^n
+                              gen-val prop-val)))
+  :rule-classes ())
+
+(local
+ (defthm prop-extend-1
+   (implies (and (integerp j)
+                 (integerp k)
+                 (> i k)
+                 (>= k j)
+                 (equal (prop x y i j) 0))
+            (equal (prop x y i j)
+                   (land0 (prop x y i (1+ k))
+                         (prop x y k j)
+                         1)))
+   :rule-classes nil))
+
+(local
+ (defthm prop-extend-2
+   (implies (and (integerp i)
+                 (integerp j)
+                 (> i k)
+                 (>= k j)
+                 (>= j 0)
+                 (equal (prop x y i j) 1))
+            (equal (prop x y i j)
+                   (land0 (prop x y i (1+ k))
+                         (prop x y k j)
+                         1)))
+   :rule-classes nil))
+
+(defthm prop-extend-original
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp k)
+                (> i k)
+                (>= k j)
+                (>= j 0))
+           (equal (prop x y i j)
+                  (land0 (prop x y i (1+ k))
+                        (prop x y k j)
+                        1)))
+  :hints (("Goal" :use (prop-extend-1 prop-extend-2)))
+  :rule-classes ())
+
+(defthm gen-special-case-original
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (lior0 (bitn x i) (bitn y i) 1)))
+  :hints (("Goal" :in-theory (enable gen-val)
+           :use ((:instance bitn-plus-bits (x x) (n i) (m j))
+                 (:instance bitn-plus-bits (x y) (n i) (m j)))))
+  :rule-classes ())
+
+(defthm land0-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (land0 (bits x i j) (bits y i j) (1+ (- i j))) 0))
+           (equal (gen x y i j) 0))
+  :hints (("Goal" :in-theory (enable gen-val)
+           :use ((:instance add-2-original
+                            (x (bits x i j))
+                            (y (bits y i j))
+                            (n (1+ (- i j))))))))
+
+(defthmd gen-val-cor1
+  (implies (natp j)
+           (equal (gen x y i j)
+                  (bitn (+ (bits x i j)
+                           (bits y i j))
+                        (1+ (- i j)))))
+  :hints (("Goal" :in-theory (enable bitn-1-iff-at-least-2^n gen-val))))
+
+(defthm bits-sum-original ; from merge.lisp
+  (implies (and (integerp x)
+                (integerp y)
+                )
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bitn (+ (bits x (1- j) 0)
+                                    (bits y (1- j) 0))
+                                 j))
+                        (- i j)
+                        0)))
+  :rule-classes ())
+
+(local
+ (defthm bits-sum-with-gen-normal-case
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp j)
+                 (< 0 j))
+            (equal (bits (+ x y) i j)
+                   (bits (+ (bits x i j)
+                            (bits y i j)
+                            (gen x y (1- j) 0))
+                         (- i j) 0)))
+   :hints (("Goal" :use bits-sum-original
+            :in-theory (e/d (gen-val-cor1)
+                            ;; the disables below are optional but they speed up
+                            ;; the proof by orders of magnitude
+                            (bits-upper-bound
+                             bits-less-than-x-gen
+                             bits-less-than-x
+                             bits-reduce-exactp
+                             bits-sum-drop-irrelevant-term-2-of-2
+                             bits-tail
+                             bits-upper-bound-tighter
+                             bits-sum-drop-irrelevant-term-1-of-2
+                             bits-split-around-zero))))
+   :rule-classes ()))
+
+(defthm bits-sum
+  (implies (and (integerp x) (integerp y))
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (gen x y (1- j) 0))
+                        (- i j) 0)))
+  :hints (("Goal" :use (bits-sum-original bits-sum-with-gen-normal-case)))
+  :rule-classes ())
+
+(local
+ (defthm bits-sum-special-case ; from merge.lisp
+   (implies (and (= (bits (+ x y) (1- j) 0) 0)
+                 (integerp x)
+                 (integerp y)
+                 (>= j 0)
+                 )
+            (equal (bits (+ x y) i j)
+                   (bits (+ (bits x i j)
+                            (bits y i j) 
+                            (logior (bitn x (1- j)) (bitn y (1- j))))
+                         (- i j) 0)))
+   :rule-classes ()))
+
+; Start proof of land-gen-0-cor.
+
+(local
+ (defthm binary-land0-is-preserved-by-slice
+   (implies (and (equal (binary-land0 x y n) 0)
+                 (< i n)
+                 (integerp n)
+                 (<= 0 j)
+                 (equal k (1+ (- i j))))
+            (equal (binary-land0 (bits x i j)
+                                (bits y i j)
+                                k)
+                   0))
+   :hints (("Goal" :use bits-land0
+            :in-theory (disable bits-land0)))))
+
+(local
+ (defthm land0-0-implies-gen-0
+   (implies (and (equal (land0 x y n) 0)
+                 (> n j)
+                 (integerp n))
+            (equal (gen x y j 0)
+                   0))))
+
+(local
+ (defthm bvecp-+-bits
+   (implies (and (equal (land0 x y n) 0)
+                 (> n i)
+                 (integerp n)
+                 (integerp i)
+                 (>= i j)
+                 (integerp j)
+                 (>= j 0)
+                 (equal k (1+ (- i j))))
+            (bvecp (+ (bits x i j) (bits y i j))
+                   k))
+   :hints (("Goal" :use ((:instance add-2-original
+                                    (x (bits x i j))
+                                    (y (bits y i j))
+                                    (n (1+ (- i j)))))))))
+
+(defthm land-gen-0-cor-original
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n i)
+                (>= i j)
+                (>= j 0)
+                (= (land0 x y n) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :hints (("Goal" :use (bits-sum)))
+  :rule-classes ())
+
+(defthm bvecp-1-gen
+  (bvecp (gen x y i j) 1)
+  :hints (("Goal" :in-theory (enable bvecp)))
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((gen x y i j)))))
+
+(defthm bvecp-1-prop
+  (bvecp (prop x y i j) 1)
+  :hints (("Goal" :in-theory (enable bvecp)))
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((prop x y i j)))))
+
+(local
+ (defthmd lior0-prop-gen-val-cor1
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp j)
+                 (< 0 j))
+            (equal (lior0 (prop x y (1- j) 0)
+                         (gen x y (1- j) 0)
+                         1)
+                   (bitn (+ 1
+                            (bits x (1- j) 0)
+                            (bits y (1- j) 0))
+                         j)))
+   :hints (("Goal" :in-theory (enable prop-val gen-val bitn-1-iff-at-least-2^n
+                                      bvecp-1-gen)))))
+
+(defthm bits-sum-plus-1-original
+  (implies (and (integerp x)
+                (integerp y)
+                (natp i)
+                (natp j)
+                (>= i j)
+                (>= j 0))
+           (equal (bits (+ 1 x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bitn (+ 1
+                                    (bits x (1- j) 0)
+                                    (bits y (1- j) 0))
+                                 j))
+                        (- i j) 0)))
+  :rule-classes ())
+
+(local
+ (defthm bits-sum-plus-1-with-prop-gen-normal
+   (implies (and (integerp x)
+                 (integerp y)
+                 (integerp i)
+                 (integerp j)
+                 (>= i j)
+                 (> j 0))
+            (equal (bits (+ 1 x y) i j)
+                   (bits (+ (bits x i j)
+                            (bits y i j)
+                            (lior0 (prop x y (1- j) 0) 
+                                  (gen x y (1- j) 0) 
+                                  1))
+                         (- i j) 0)))
+   :hints (("Goal" :use bits-sum-plus-1-original
+            :in-theory (e/d (lior0-prop-gen-val-cor1)
+                            ;; the disables below are optional but they speed up
+                            ;; the proof by orders of magnitude
+                            (bits-upper-bound
+                             bits-less-than-x-gen
+                             bits-less-than-x
+                             bits-reduce-exactp
+                             bits-sum-drop-irrelevant-term-2-of-2
+                             bits-tail
+                             bits-upper-bound-tighter
+                             bits-sum-drop-irrelevant-term-1-of-2
+                             bits-split-around-zero))))
+   :rule-classes ()))
+
+(defthm bits-sum-plus-1-with-prop-gen-original
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0))
+           (equal (bits (+ 1 x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (lior0 (prop x y (1- j) 0) 
+                                 (gen x y (1- j) 0) 
+                                 1))
+                        (- i j) 0)))
+  :hints (("Goal" :use (bits-sum-plus-1-original bits-sum-plus-1-with-prop-gen-normal)
+           :in-theory (e/d (lior0-prop-gen-val-cor1)
+                           ;; the disables below are optional but they speed up
+                           ;; the proof by orders of magnitude
+                           (bits-upper-bound
+                            bits-less-than-x-gen
+                            bits-less-than-x
+                            bits-reduce-exactp
+                            bits-sum-drop-irrelevant-term-2-of-2
+                            bits-tail
+                            bits-upper-bound-tighter
+                            bits-sum-drop-irrelevant-term-1-of-2
+                            bits-split-around-zero))))
+  :rule-classes ())
+
+;;;**********************************************************************
+;;;                     THREE-INPUT ADDITION
+;;;**********************************************************************
+
+(defthm add-3-original
+    (implies (and (not (zp n))
+		  (bvecp x n)
+		  (bvecp y n)
+		  (bvecp z n))
+	     (equal (+ x y z)
+		    (+ (lxor0 x (lxor0 y z n) n)
+		       (* 2 (lior0 (land0 x y n)
+				  (lior0 (land0 x z n)
+					(land0 y z n)
+					n)
+				  n)))))
+  :rule-classes ())
+
+(defthm add-2-original
+    (implies (and (not (zp n))
+		  (bvecp x n)
+		  (bvecp y n))
+	     (equal (+ x y)
+		    (+ (lxor0 x y n)
+		       (* 2 (land0 x y n)))))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                    TRAILING ONE PREDICTION
+;;;**********************************************************************
+
+(defthm top-thm-1-original
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lnot (lxor0 a b n) n) k 0) 0)))
+  :rule-classes ())
+
+(defund sigm-0 (a b c n)
+  (if (= c 0)
+      (lnot (lxor0 a b n) n)
+    (lxor0 a b n)))
+
+(defund kap-0 (a b c n)
+  (if (= c 0)
+      (* 2 (lior0 a b n))
+    (* 2 (land0 a b n))))
+
+(defund tau-0 (a b c n)
+  (lnot (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (1+ n)) (1+ n)))
+
+(defthm bvecp-sigm-0
+  (bvecp (sigm-0 a b c n) n)
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm-0 a b c n)))))
+
+(defthm bvecp-kap-0
+  (implies (and (integerp n) (<= 0 n))
+           (bvecp (kap-0 a b c n) (1+ n)))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap-0 a b c n)))))
+
+(defthm bvecp-tau-0
+  (bvecp (tau-0 a b c n) (1+ n))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau-0 a b c n)))))
+
+(local (include-book "lextra0")) ; for lnot-lxor0
+
+(defthm top-thm-2-old
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+		  (equal (bits (tau-0 a b c n) k 0) 0)))
+  :rule-classes ())
+
+(encapsulate ()
+
+(local
+ (defthm top-thm-2-0
+   (implies (and (natp n)
+                 (integerp a)
+                 (integerp b)
+                 (natp k)
+                 (< k n))
+            (equal (equal (bits (+ a b) k 0) 0)
+                   (equal (bits (lxor0 (lxor0 a b n) 
+                                      (cat (lior0 a b n) n 0 1)
+                                      (1+ n)) 
+                                k 0) 
+                          0)))
+   :hints (("Goal"
+            :expand ((:free (x y) (cat x n y 1)))
+            :use
+            ((:instance top-thm-2-old (c 0))
+             (:instance lnot-lxor0
+                        (x (lnot (binary-lxor0 (bits a k 0)
+                                              (bits b k 0)
+                                              (+ 1 k))
+                                 (+ 1 k)))
+                        (y (* 2
+                              (binary-lior0 (bits a (1- k) 0)
+                                           (bits b (1- k) 0)
+                                           k)))
+                        (n (+ 1 k))))
+            :in-theory (e/d (tau-0 kap-0 sigm-0 bitn-negative-bit-of-integer)
+                            (bitn-known-not-0-replace-with-1))))
+   :rule-classes ()))
+
+#|
+Proof of top-thm-2-1 from top-thm-2-0:
+
+Case 1: (bitn a 0) = (bitn b 0).  Then (bitn (+ a b 1) 0) = 1 by
+top-thm-1, so (bits (+ a b 1) k 0) != 0, by bits-plus-bitn.  We can also use
+bits-plus-bitn so that it suffices to show that bit 0 of the outermost lxor0
+call is 1, which is clear.
+
+Case 2: Without loss of generality, (bitn a 0) = 0 and (bitn b 0) = 1.  We want
+to apply top-thm-2-0 with a replaced by a+1.  Thus it suffices to prove:
+
+(lxor0 (lxor0 a b n)
+      (cat (lior0 a b n) n 1 1)
+      (1+ n))
+=
+(lxor0 (lxor0 (1+ a) b n) 
+      (cat (lior0 (1+ a) b n) n 0 1)
+      (1+ n))
+
+The key observation is that for all integers i, (bitn (1+ a) i) = (bitn a i)
+if i is positive, and (bitn (1+ a) 0) = 1.  {This follows from the fact that
+(bits (1+ a) m 0) = (cat (bits a m 1) m 1 1).}  By lemma
+sumbits-badguy-is-correct, it suffices to prove that the nth bit of each of the
+two sides above is the same for an arbitrary natp n.  We have rules for bitn of
+lxor0, cat, and lior0 that should make this proof pretty automatic.
+
+|# ; |
+
+(local
+ (defthm top-thm-2-1-1-1
+   (implies (and (natp n)
+                 (integerp a)
+                 (integerp b)
+                 (natp k)
+                 (< k n)
+                 (equal (bitn a 0) (bitn b 0)))
+            (not (equal (bits (+ a b 1) k 0) 0)))
+   :hints (("Goal" :use ((:instance bits-plus-bitn
+                                    (x (+ a b 1))
+                                    (n k)
+                                    (m 0))
+                         (:instance top-thm-1-original
+                                    (k 0)))))
+   :rule-classes ()))
+
+(local (in-theory (disable bitn-known-not-0-replace-with-1)))
+
+(local
+ (defthm top-thm-2-1-1-2-1
+   (implies (and (natp n)
+                 (integerp a)
+                 (integerp b)
+                 (natp k)
+                 (< k n)
+                 (equal (bitn a 0) (bitn b 0)))
+            (not (equal (bitn (bits (lxor0 (lxor0 a b n)
+                                          (cat (lior0 a b n) n 1 1)
+                                          (1+ n)) 
+                                    k 0)
+                              0)
+                        0)))
+   :hints (("Goal" :use ((:instance bits-plus-bitn
+                                    (x a)
+                                    (n k)
+                                    (m 0))
+                         (:instance bits-plus-bitn
+                                    (x b)
+                                    (n k)
+                                    (m 0))
+                         (:instance bvecp-1-rewrite
+                                    (x (bitn a 0)))
+                         (:instance bvecp-1-rewrite
+                                    (x (bitn b 0))))))
+   :rule-classes ()))
+
+(local
+ (defthm top-thm-2-1-1-2
+   (implies (and (natp n)
+                 (integerp a)
+                 (integerp b)
+                 (natp k)
+                 (< k n)
+                 (equal (bitn a 0) (bitn b 0)))
+            (not (equal (bits (lxor0 (lxor0 a b n)
+                                    (cat (lior0 a b n) n 1 1)
+                                    (1+ n)) 
+                              k 0)
+                        0)))
+   :hints (("Goal" :use top-thm-2-1-1-2-1))
+   :rule-classes nil))
+
+(local
+ (defthm top-thm-2-1-1
+   (implies (and (natp n)
+                 (integerp a)
+                 (integerp b)
+                 (natp k)
+                 (< k n)
+                 (equal (bitn a 0) (bitn b 0)))
+            (equal (equal (bits (+ a b 1) k 0) 0)
+                   (equal (bits (lxor0 (lxor0 a b n)
+                                      (cat (lior0 a b n) n 1 1)
+                                      (1+ n)) 
+                                k 0) 
+                          0)))
+   :hints (("Goal" :use (top-thm-2-1-1-1 top-thm-2-1-1-2)))
+   :rule-classes ()))
+
+; Start proof of top-thm-2-1-2-1.
+
+(local
+ (encapsulate
+  ()
+
+  (local
+   (defthm top-thm-2-1-2-2-1-1-1-1
+     (implies (and (natp m)
+                   (< 0 m)
+                   (integerp a)
+                   (equal (bitn a 0) 0))
+              (equal (land0 1 a m)
+                     0))
+     :hints (("Goal" :use ((:instance land0-slice (x a) (i 1) (j 0) (n m)))))))
+
+  (local
+   (defthm top-thm-2-1-2-2-1-1-1
+     (implies (and (natp m)
+                   (<= 0 m)
+                   (integerp a)
+                   (equal (bitn a 0) 0))
+              (equal (bits (1+ a) m 0)
+                     (cat (bits a m 1) m 1 1)))
+     :hints (("Goal" :use ((:instance land-gen-0-cor-original
+                                      (x a)
+                                      (y 1)
+                                      (n (1+ m))
+                                      (i m)
+                                      (j 0))
+                           (:instance bits-plus-bitn
+                                      (x a)
+                                      (n m)
+                                      (m 0)))
+              :expand ((cat (bits a m 1) m 1 1))))))
+
+  (defthm top-thm-2-1-2-2-1-1
+    (implies (and (natp m)
+                  (<= 0 m)
+                  (integerp a)
+                  (equal (bitn a 0) 0))
+             (equal (bitn (bits (1+ a) m 0) m)
+                    (bitn (cat (bits a m 1) m 1 1) m)))
+    :rule-classes nil)))
+
+(local
+ (defthm top-thm-2-1-2-2-1
+   (implies (and (natp m)
+                 (integerp a)
+                 (equal (bitn a 0) 0))
+            (equal (bitn (1+ a) m)
+                   (if (equal m 0)
+                       1
+                     (bitn a m))))
+   :hints (("Goal" :use top-thm-2-1-2-2-1-1))))
+
+(local
+ (defthmd lxor0-lnot-1
+   (equal (lxor0 (lnot x n) y n)
+          (lnot (lxor0 x y n) n))
+   :hints (("Goal" :in-theory (enable lnot-lxor0)))))
+
+(local
+ (defthmd lxor0-lnot-2
+   (equal (lxor0 y (lnot x n) n)
+          (lnot (lxor0 x y n) n))
+   :hints (("Goal" :in-theory (enable lnot-lxor0)))))
+
+(local
+ (defthm top-thm-2-1-2-2
+   (implies (and (natp n)
+                 (integerp a)
+                 (integerp b)
+                 (natp k)
+                 (< k n)
+                 (equal (bitn a 0) 0)
+                 (equal (bitn b 0) 1))
+            (equal (lxor0 (lxor0 a b n)
+                         (cat (lior0 a b n) n 1 1)
+                         (1+ n))
+                   (lxor0 (lxor0 (1+ a) b n)
+                         (cat (lior0 (1+ a) b n) n 0 1)
+                         (1+ n))))
+   :hints (("Goal" :use ((:instance sumbits-badguy-is-correct
+                                    (x (lxor0 (lxor0 a b n)
+                                             (cat (lior0 a b n) n 1 1)
+                                             (1+ n)))
+                                    (y (lxor0 (lxor0 (1+ a) b n) 
+                                             (cat (lior0 (1+ a) b n) n 0 1)
+                                             (1+ n)))
+                                    (k (1+ n))))
+            :in-theory (enable lxor0-lnot-1 lxor0-lnot-2)))
+   :rule-classes ()))
+
+(local
+ (defthm top-thm-2-1-2
+   (implies (and (natp n)
+                 (integerp a)
+                 (integerp b)
+                 (natp k)
+                 (< k n)
+                 (equal (bitn a 0) 0)
+                 (equal (bitn b 0) 1))
+            (equal (equal (bits (+ a b 1) k 0) 0)
+                   (equal (bits (lxor0 (lxor0 a b n)
+                                      (cat (lior0 a b n) n 1 1)
+                                      (1+ n)) 
+                                k 0) 
+                          0)))
+   :hints (("Goal" :use (top-thm-2-1-2-2
+                         (:instance top-thm-2-0
+                                    (a (1+ a))))))
+   :rule-classes ()))
+
+(local
+ (defthm top-thm-2-1
+   (implies (and (natp n)
+                 (integerp a)
+                 (integerp b)
+                 (natp k)
+                 (< k n))
+            (equal (equal (bits (+ a b 1) k 0) 0)
+                   (equal (bits (lxor0 (lxor0 a b n)
+                                      (cat (lior0 a b n) n 1 1)
+                                      (1+ n)) 
+                                k 0) 
+                          0)))
+   :hints (("Goal" :use (top-thm-2-1-1
+                         top-thm-2-1-2
+                         (:Instance top-thm-2-1-2 (a b) (b a)))
+            ;; for efficiency only:
+            :in-theory (disable;;bits-cat
+                        bits-lxor0 ; important
+                        ;;bvecp-tighten
+                        bits-tail ; pretty impt
+                        power2-integer ; a little impt
+                        bits-sum-drop-irrelevant-term-2-of-2 ; barely impt
+                        ;;bits-reduce-exactp
+                        ;;expo-unique-eric-2
+                        ;;bits-split-around-zero
+                        )))
+   :rule-classes ()))
+
+(defthm top-thm-2-original
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (lxor0 (lxor0 a b n) 
+                                     (cat (lior0 a b n) n c 1)
+                                     (1+ n)) 
+                               k 0) 
+                         0)))
+  :hints (("Goal" :use (top-thm-2-0 top-thm-2-1)
+           :in-theory (theory 'ground-zero)))
+  :rule-classes nil)
+
+)
+
+(local
+ (defthm top-thm-3-lemma
+   (implies (and (integerp a) (integerp b) (integerp n))
+            (equal (land0 (bits a (1- n) 0)
+                         (bits b (1- n) 0)
+                         n)
+                   (land0 a b n)))
+   :hints (("Goal" :use ((:instance land0-ignores-bits
+                                    (x a) (y (bits b (1- n) 0)) (n n))
+                         (:instance land0-ignores-bits
+                                    (x b) (y a) (n n)))))
+   :rule-classes nil))
+
+(defthm top-thm-3-original
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lnot (lxor0 (lxor0 a b n) 
+				           (cat (land0 a b n) n 0 1)
+					   (1+ n))
+				     (1+ n))
+			       k 0) 
+			 0)))
+  :hints (("Goal" :use (top-thm-3-lemma (:instance top-thm-2-old (c 1)))
+           :expand ((cat (land0 a b n) n 0 1))
+           :in-theory (enable tau-0 kap-0 sigm-0)))
+  :rule-classes ())
+
+
+;;;**********************************************************************
+;;;                  LEADING ONE PREDICTION
+;;;**********************************************************************
+
+;add in some more theorems about the functions defined below?
+
+(defthm lop-thm-1-original
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (lior0 (* 2 (mod a (expt 2 e)))
+			   (lnot (* 2 b) (1+ e))
+			   (1+ e))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
+
+(defun lamt-0 (a b e)
+  (lxor0 a (lnot b (1+ e)) (1+ e)))
+
+(defun lamg-0 (a b e)
+  (land0 a (lnot b (1+ e)) (1+ e)))
+
+(defun lamz-0 (a b e)
+  (lnot (lior0 a (lnot b (1+ e)) (1+ e)) (1+ e)))
+
+(defun lam1-0 (a b e)
+  (land0 (bits (lamt-0 a b e) e 2) 
+	(land0 (bits (lamg-0 a b e) (1- e) 1)
+	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam2-0 (a b e)
+  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
+	(land0 (bits (lamz-0 a b e) (1- e) 1)
+	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam3-0 (a b e)
+  (land0 (bits (lamt-0 a b e) e 2) 
+	(land0 (bits (lamz-0 a b e) (1- e) 1)
+	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam4-0 (a b e)
+  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
+	(land0 (bits (lamg-0 a b e) (1- e) 1)
+	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam0-0 (a b e)
+  (lior0 (lam1-0 a b e)
+	(lior0 (lam2-0 a b e)
+	      (lior0 (lam3-0 a b e)
+		    (lam4-0 a b e)
+		    (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lamb-0 (a b e)
+  (+ (* 2 (lam0-0 a b e))
+     (lnot (bitn (lamt-0 a b e) 0) 1)))
+
+(defthm lop-thm-2-original
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb-0 a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb-0 a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb-0 a b e)))))))
+  :rule-classes ())
+
+; new for rel5:
+
+(defthmd gen-val-cor2
+  (implies (and (natp x)
+                (natp y)
+		(natp i))
+           (equal (+ (bits x i 0) (bits y i 0))
+		  (+ (* (expt 2 (1+ i)) (gen x y i 0))
+		     (bits (+ x y) i 0))))
+  :hints (("Goal" :use ((:instance bitn-plus-bits
+                                   (x (+ (bits x i 0) (bits y i 0)))
+                                   (n (1+ i))
+                                   (m 0))
+                        (:instance gen-val-cor1
+                                   (j 0))))))
+
+(defthm bits-sum-cor-lemma
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0))
+           (equal (bits (+ (bits x i j)
+                           (bits y i j))
+                        (- i j) 0)
+                  (+ (bits x i j)
+                     (bits y i j))))
+  :hints (("Goal" :use ((:instance bitn-plus-bits
+                                   (x (+ (bits x i j) (bits y i j)))
+                                   (n (1+ (- i j)))
+                                   (m 0))
+                        gen-val-cor1)))
+  :rule-classes nil)
+
+(defthmd bits-sum-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (>= i j)
+                (>= j 0)
+                (= (gen x y i j) 0)
+                (= (gen x y (1- j) 0) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :hints (("Goal" :use (bits-sum bits-sum-cor-lemma))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/fast-and.lisp acl2-6.3/books/rtl/rel9/support/support/fast-and.lisp
--- acl2-6.2/books/rtl/rel9/support/support/fast-and.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/fast-and.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,50 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defun split-list (lst lo hi)
+  (cond ((endp lst) 
+         (mv lo hi))
+        ((endp (cdr lst)) 
+         (mv (cons (car lst) lo) hi))
+        (t
+         (split-list (cddr lst)
+                     (cons (car lst) lo)
+                     (cons (cadr lst) hi)))))
+
+(defun fast-and-fn (conjuncts)
+  (declare (xargs :mode :program))
+  (cond ((endp conjuncts) ''t)
+        ((endp (cdr conjuncts)) (car conjuncts))
+        (t
+         (mv-let (hi lo)
+             (split-list conjuncts () ())
+           (list 'if
+                 (fast-and-fn hi)
+                 (fast-and-fn lo)
+                 'nil)))))
+
+(defmacro fast-and (&rest conjuncts)
+  (fast-and-fn conjuncts))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/float-extra.lisp acl2-6.3/books/rtl/rel9/support/support/float-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/support/float-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/float-extra.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,617 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; This book was originally certified (in a different directory, not support/)
+; starting with:
+
+; (include-book "rtl/rel4/lib/top" :dir :system)
+
+; Then that form was replaced by the forms below starting with (include-book
+; "sticky"), up through the form (local (in-theory (theory 'lib-top1))).  See
+; the comments at the top of fadd-extra.lisp for further explanation of how to
+; extend the library.
+
+; But first, we need the following before including rtl books -- otherwise we
+; get a conflict of the rtl books with the arithmetic library.
+
+(local
+ (encapsulate
+  ()
+
+  (local (include-book "arithmetic/inequalities" :dir :system))
+  (set-enforce-redundancy t)
+
+  (defmacro fc (x) x)
+
+  (defthm expt-is-increasing-for-base>1
+    (implies (and (< 1 r)
+                  (< i j)
+                  (fc (real/rationalp r))
+                  (fc (integerp i))
+                  (fc (integerp j)))
+             (< (expt r i) (expt r j)))
+    :rule-classes (:rewrite :linear))
+
+  (in-theory (disable (:rewrite expt-is-increasing-for-base>1)))))
+
+(include-book "sticky") ; needed for some definitions
+(include-book "util")   ; needed for definition of local-defthm
+
+; Now put ourselves in what amounts to the environment of ../lib/top, as
+; explained above.
+(local (include-book "top1"))
+(local (in-theory (theory 'lib-top1)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; fp- definition and lemmas
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; "Transcription" by Matt Kaufmann into ACL2 of hand proofs supplied by David
+; Russinoff (shown below). August 2005.
+
+(defun fp- (x n)
+  (if (= x (expt 2 (expo x)))
+      (- x (expt 2 (- (expo x) n)))
+    (- x (expt 2 (- (1+ (expo x)) n)))))
+
+; Lemma 1.  If x>0, x n-exact, and y = fp-(x,n), then y is n-exact and fp+(y,n)
+; = x.
+
+; Proof.  Let e = expo(x).
+
+; Case 1 [fp--lemma-1-1]: x = 2^e.
+
+; y = x - 2^(e-n) by definition of fp-.
+
+; 2^e > y = x - 2^(e-n) >= 2^e - 2^(e-1) = 2^(e-1);
+; so [fp--lemma-1-1-1] expo(y) = e-1 by expo-unique.
+
+; By exactp2, y is n-exact if y*2^(n-1-expo(y)) is an integer.  But we have:
+; y*2^(n-1-expo(y)) = y*2^(n-e) = (x-2^(e-n))*2^(n-e) = (2^e-2^(e-n))*2^(n-e) =
+; 2^n-1, which is an integer.
+
+; fp+(y,n) = y + 2^(expo(y)+1-n) = y + 2^(e-n) = x.
+
+; Case 2 [fp--lemma-1-2]: x != 2^e.
+
+; [fp--lemma-1-2-1-1-1] By fp+2, x >= fp+(2^e,n) = 2^e + 2^(e+1-n) by expo-2**n.
+
+; By definition of fp-, y = x - 2^(e+1-n) >= 2^e by the step just above.
+
+; So [fp--lemma-1-2-1-1] 2^e <= y; and, y < x <= 2^(e+1) by expo-upper-bound.
+; Therefore by expo-unique, expo(y) = e.
+
+; By exactp2, y is n-exact if y*2^(n-1-expo(y)) is an integer.  But we have:
+; y*2^(n-1-expo(y)) = y*2^(n-1-e) = (x-2^(e+1-n))*2^(n-1-e) =
+; x*2^(n-1-e) - 1, whicn is an integer by exactp2 because x is n-exact.
+
+; Finally, fp+(y,n) = y + 2^(expo(y)+1-n) = y + 2^(e+1-n) = x.
+
+(local-defthm expt-hack
+    (implies (and (integerp n)
+                  (> n 0))
+             (<= (expt 2 (* -1 n)) 1/2))
+    :hints (("Goal" :use ((:instance expt-is-increasing-for-base>1
+                                     (r 2)
+                                     (i (* -1 n))
+                                     (j -1)))))
+    :rule-classes :linear)
+
+; We deliberately export useful type-prescription rule fp--non-negative.
+(encapsulate
+ ()
+
+ (set-non-linearp t)
+
+; Expt-hack is used in the proof of the following.
+
+ (defthm fp--non-negative
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0)
+                 (> x 0))
+            (and (rationalp (fp- x n))
+                 (< 0 (fp- x n))))
+   :hints (("Goal" :in-theory (e/d (expt-split fp-) (a15))
+            :use expo-lower-bound))
+   :rule-classes :type-prescription))
+
+(local
+ (encapsulate
+  ()
+
+  (set-non-linearp t)
+
+  (local-defthm fp--lemma-1-1-1-1-1
+    (implies (and (integerp n)
+                  (< 0 n)
+                  (equal x (expt 2 (expo x))))
+             (<= (+ (expt 2 (+ -1 (expo x)))
+                    (expt 2 (+ (expo x) (* -1 n))))
+                 x))
+    :hints (("Goal" :in-theory (e/d (expt-split fp-) (a15)))))
+
+  (defthm fp--lemma-1-1-1-1
+    (implies (and (rationalp x)
+                  (> x 0)
+                  (integerp n)
+                  (> n 0)
+                  (exactp x n)
+                  (equal y (fp- x n))
+                  (equal e (expo x))
+                  (equal x (expt 2 e)))
+             (>= y (expt 2 (- e 1))))
+    :rule-classes nil)))
+
+(local-defthm fp--lemma-1-1-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (equal y (fp- x n))
+                (equal e (expo x))
+                (equal x (expt 2 e)))
+           (equal (expo y) (- e 1)))
+  :hints (("Goal" :use (fp--lemma-1-1-1-1
+                        (:instance expo-unique
+                                   (x y)
+                                   (n (- e 1))))))
+  :rule-classes nil)
+
+(local-defthm fp--lemma-1-1-2-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (equal y (fp- x n))
+                (equal e (expo x))
+                (equal x (expt 2 e)))
+           (equal (* y (expt 2 (- (- n 1) (expo y))))
+                  (1- (expt 2 n))))
+   :hints (("Goal" :use fp--lemma-1-1-1))
+  :rule-classes nil)
+
+(local-defthm fp--lemma-1-1-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (equal y (fp- x n))
+                (equal e (expo x))
+                (equal x (expt 2 e)))
+           (exactp y n))
+  :hints (("Goal" :use (fp--lemma-1-1-2-1
+                        (:instance exactp2 (x y) (n n)))))
+  :rule-classes nil)
+
+(local-defthm fp--lemma-1-1-3
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (equal y (fp- x n))
+                (equal e (expo x))
+                (equal x (expt 2 e)))
+           (equal (fp+ y n) x))
+  :hints (("Goal" :use fp--lemma-1-1-1))
+  :rule-classes nil)
+
+(local-defthm fp--lemma-1-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (equal y (fp- x n))
+                (equal e (expo x))
+                (equal x (expt 2 e)))
+           (and (exactp y n)
+                (equal (fp+ y n) x)))
+  :hints (("Goal" :use (fp--lemma-1-1-2
+                        fp--lemma-1-1-3)))
+  :rule-classes nil)
+
+(local
+ (encapsulate
+  ()
+
+  (local-defthm fp--lemma-1-2-1-1-1
+    (implies (and (rationalp x)
+                  (> x 0)
+                  (integerp n)
+                  (> n 0)
+                  (exactp x n)
+                  (equal e (expo x))
+                  (not (equal x (expt 2 e))))
+             (>= x (+ (expt 2 e)
+                      (expt 2 (+ 1 e (- n))))))
+    :hints (("Goal" :use ((:instance fp+2
+                                     (n n)
+                                     (y x)
+                                     (x (expt 2 e)))
+                          (:instance expo-lower-bound
+                                     (x x)))
+             :in-theory (enable exactp-2**n)))
+    :rule-classes nil)
+
+  (defthm fp--lemma-1-2-1-1
+    (implies (and (rationalp x)
+                  (> x 0)
+                  (integerp n)
+                  (> n 0)
+                  (exactp x n)
+                  (equal y (fp- x n))
+                  (equal e (expo x))
+                  (not (equal x (expt 2 e))))
+             (equal (expo y) e))
+    :hints (("Goal" :use (fp--lemma-1-2-1-1-1
+                          (:instance expo-upper-bound (x x))
+                          (:instance expo-unique (x y) (n e)))))
+    :rule-classes nil)))
+
+(local-defthm fp--lemma-1-2-1-2
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (exactp x n)
+                 (equal y (fp- x n))
+                 (equal e (expo x))
+                 (not (equal x (expt 2 e))))
+            (equal (* y (expt 2 (- (1- n) e)))
+                   (1- (* x (expt 2 (- (- n 1) e))))))
+   :rule-classes nil)
+
+(local-defthm fp--lemma-1-2-1
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (exactp x n)
+                 (equal y (fp- x n))
+                 (equal e (expo x))
+                 (not (equal x (expt 2 e))))
+            (exactp y n))
+   :hints (("Goal" :use (fp--lemma-1-2-1-1
+                         fp--lemma-1-2-1-2
+                         (:instance exactp2 (x x) (n n))
+                         (:instance exactp2 (x y) (n n)))))
+   :rule-classes nil)
+
+(local-defthm fp--lemma-1-2-2
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (exactp x n)
+                 (equal y (fp- x n))
+                 (equal e (expo x))
+                 (not (equal x (expt 2 e))))
+            (equal (fp+ y n) x))
+   :hints (("Goal" :use (fp--lemma-1-2-1-1)))
+   :rule-classes nil)
+
+(local-defthm fp--lemma-1-2
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (exactp x n)
+                 (equal y (fp- x n))
+                 (equal e (expo x))
+                 (not (equal x (expt 2 e))))
+            (and (exactp y n)
+                 (equal (fp+ y n) x)))
+   :hints (("Goal" :use (fp--lemma-1-2-1 fp--lemma-1-2-2)))
+   :rule-classes nil)
+
+(local-defthm fp--lemma-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (equal y (fp- x n)))
+           (and (exactp y n)
+                (equal (fp+ y n) x)))
+  :rule-classes nil
+  :hints (("Goal" :use ((:instance fp--lemma-1-1 (e (expo x)))
+                        (:instance fp--lemma-1-2 (e (expo x)))))))
+
+(local-defthm fp-2-lemma
+  (implies (and (integerp n)
+                (> n 0))
+           (not (equal (fp- (fp+ 0 n) n) 0)))
+  :hints (("Goal" :use ((:instance expt-weak-monotone
+                                   (n (+ 1 (* -2 n)))
+                                   (m (+ 1 (* -1 n))))
+                        (:instance expt-weak-monotone
+                                   (m (+ 1 (* -2 n)))
+                                   (n (+ 1 (* -1 n)))))))
+                                   
+  :rule-classes ())
+
+(defthm fp-2
+  (implies (and (rationalp x)
+                (rationalp y)
+                (> y 0)
+                (> x y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (<= y (fp- x n)))
+  :hints (("Goal" :use ((:instance fp+2
+                                   (x (fp- x n))
+                                   (y y))
+                        (:instance fp--lemma-1
+                                   (x x)
+                                   (y (fp- x n)))
+                        fp-2-lemma)
+           :in-theory (disable fp- fp+)))
+  :rule-classes ())
+
+(defthm fp-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (exactp (fp- x n) n))
+  :hints (("Goal" :use ((:instance fp--lemma-1
+                                   (x x)
+                                   (y (fp- x n))))))
+  :rule-classes ())
+
+(defthm fp+-
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp+ (fp- x n) n)
+                  x))
+  :hints (("Goal" :use ((:instance fp--lemma-1
+                                   (y (fp- x n)))))))
+
+; Lemma 2.  If x>0, x is n-exact, and y = fp+(x,n), then fp-(y,n) = x.
+
+; Proof.  Let e = expo(x).  Then y = x + 2^(e+1-n).
+
+; Case 1 [fp--lemma-2-1]: y < 2^(e+1).
+
+; Then [fp--lemma-2-1-1] expo(y) = e by expo-unique.
+
+; Since y != 2^e, fp-(y,n) = y - 2^(e+1-n) = x.
+
+; Case 2 [fp--lemma-2-2]: y >= 2^(e+1).
+
+; By fp+2, since 2^(e+1) is n-exact by exactp-2**n, then 2^(e+1) >= y
+; [fp--lemma-2-2-1].  So y = 2^(e+1), and the result follows by definition of fp-.
+
+(local-defthm fp--lemma-2-1-1
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (equal y (fp+ x n))
+                (equal e (expo x))
+                (< y (expt 2 (1+ e))))
+           (equal (expo y) e))
+  :hints (("Goal" :use ((:instance expo-lower-bound (x x))
+                        (:instance expo-unique (x y) (n e)))))
+  :rule-classes nil)
+
+(local-defthm fp--lemma-2-1
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (exactp x n)
+                 (equal y (fp+ x n))
+                 (equal e (expo x))
+                 (< y (expt 2 (1+ e))))
+            (equal (fp- y n) x))
+   :hints (("Goal" :use (fp--lemma-2-1-1 expo-lower-bound)))
+   :rule-classes nil)
+
+(local-defthm fp--lemma-2-2-1
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (exactp x n)
+                 (equal y (fp+ x n))
+                 (equal e (expo x))
+                 (>= y (expt 2 (1+ e))))
+            (>= (expt 2 (1+ e)) y))
+   :hints (("Goal" :use ((:instance fp+2 (x x) (y (expt 2 (1+ e))))
+                         expo-upper-bound)
+            :in-theory (enable exactp-2**n)))
+   :rule-classes nil)
+
+(local-defthm fp--lemma-2-2
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (exactp x n)
+                 (equal y (fp+ x n))
+                 (equal e (expo x))
+                 (>= y (expt 2 (1+ e))))
+            (equal (fp- y n) x))
+   :hints (("Goal" :use (fp--lemma-2-2-1)))
+   :rule-classes nil)
+
+(local-defthm fp--lemma-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (equal y (fp+ x n)))
+           (equal (fp- y n) x))
+  :hints (("Goal" :use ((:instance fp--lemma-2-1 (e (expo x)))
+                        (:instance fp--lemma-2-2 (e (expo x))))))
+  :rule-classes nil)
+
+(defthm fp-+
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n))
+           (equal (fp- (fp+ x n) n)
+                  x))
+  :hints (("Goal" :use ((:instance fp--lemma-2
+                                   (y (fp+ x n)))))))
+
+; Start proof of expo-prod.
+
+(local-defthm expo-prod-1
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (rationalp y)
+                (not (= y 0)))
+           (equal (* x y)
+                  (* (sgn x)
+                     (sgn y)
+                     (sig x)
+                     (sig y)
+                     (expt 2 (+ (expo x) (expo y))))))
+  :hints (("Goal" :use ((:instance fp-rep (x x))
+                        (:instance fp-rep (x y)))
+           :in-theory (e/d (expt-split) (a15))))
+  :rule-classes nil)
+
+(local-defthm expo-prod-2
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (rationalp y)
+                (not (= y 0))
+                (< (* (sig x) (sig y)) 2))
+           (equal (expo (* x y))
+                  (+ (expo x) (expo y))))
+  :hints (("Goal" :use (expo-prod-1
+                        (:instance fp-rep-unique
+                                   (x (* x y))
+                                   (m (* (sig x) (sig y)))
+                                   (e (+ (expo x) (expo y))))
+                        (:instance sig-lower-bound
+                                   (x x))
+                        (:instance sig-lower-bound
+                                   (x y)))
+           :in-theory (enable sgn)))
+  :rule-classes nil)
+
+(local-defthm expo-prod-3-1
+  (implies (and (rationalp x)
+                (rationalp y)
+                (not (equal x 0))
+                (not (equal y 0))
+                (not (< (* (sig x) (sig y)) 2)))
+           (and (< (* 1/2 (sig x) (sig y))
+                   2)
+                (>= (* 1/2 (sig x) (sig y))
+                    1)))
+  :hints (("Goal" :use ((:instance sig-upper-bound
+                                   (x x))
+                        (:instance sig-upper-bound
+                                   (x y))
+                        (:instance sig-lower-bound
+                                   (x x))
+                        (:instance sig-lower-bound
+                                   (x y)))))
+  :rule-classes nil)
+
+(local
+ (encapsulate
+  ()
+
+  (local-defthm hack
+    (implies (and (syntaxp (quotep k))
+                  (integerp k))
+             (equal (expt 2 (+ k (expo x) (expo y)))
+                    (* (expt 2 k)
+                       (expt 2 (+ (expo x) (expo y))))))
+    :hints (("Goal" :in-theory (e/d (expt-split) (a15)))))
+
+  (defthm expo-prod-3
+    (implies (and (rationalp x)
+                  (not (= x 0))
+                  (rationalp y)
+                  (not (= y 0))
+                  (not (< (* (sig x) (sig y)) 2)))
+             (equal (expo (* x y))
+                    (+ 1 (expo x) (expo y))))
+    :hints (("Goal" :use (expo-prod-1
+                          expo-prod-3-1
+                          (:instance fp-rep-unique
+                                     (x (* x y))
+                                     (m (* 1/2 (sig x) (sig y)))
+                                     (e (+ 1 (expo x) (expo y)))))
+             :in-theory (e/d (sgn) (expt a15))))
+    :rule-classes nil)))
+
+(defthmd expo-prod
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (rationalp y)
+                (not (= y 0)))
+           (equal (expo (* x y))
+                  (if (< (* (sig x) (sig y)) 2)
+                      (+ (expo x) (expo y))
+                    (+ 1 (expo x) (expo y)))))
+  :hints (("Goal" :use (expo-prod-2 expo-prod-3))))
+
+(defthmd sig-prod
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (rationalp y)
+                (not (= y 0)))
+           (equal (sig (* x y))
+                  (if (< (* (sig x) (sig y)) 2)
+                      (* (sig x) (sig y))
+                    (* 1/2 (sig x) (sig y)))))
+  :hints (("Goal" :in-theory (e/d (expt-split sig expo-prod) (a15)))))
+
+; This is essentially just fp+1-2, but it happens to be convenient just to tack
+; it on here.
+(defthm fp+expo
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (not (= (expo (fp+ x n)) (expo x))))
+           (equal (fp+ x n) (expt 2 (1+ (expo x)))))
+  :hints (("Goal" :use fp+1-2))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/support/float.lisp acl2-6.3/books/rtl/rel9/support/support/float.lisp
--- acl2-6.2/books/rtl/rel9/support/support/float.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/float.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,2035 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+;todo: disable expt in this file (and everywhere)
+;disable abs, sgn
+
+;move some of this stuff to books in arithmetic/
+
+(in-package "ACL2")
+
+(local (include-book "../../arithmetic/top"))
+(include-book "../../arithmetic/negative-syntaxp")
+(include-book "../../arithmetic/basic") ;BOZO! make this local
+(include-book "../../arithmetic/power2p")
+(local (include-book "../../arithmetic/fl"))
+(local (include-book "../../arithmetic/cg"))
+
+(local (in-theory (enable expt-minus)))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+;fp rep
+
+(defthm fp-rep
+  (implies (rationalp x)
+           (equal x (* (sgn x) (sig x) (expt 2 (expo x)))))
+  :hints (("Goal" :in-theory (enable sig)))
+  :rule-classes ())
+
+(defthm fp-abs
+  (implies (rationalp x)
+           (equal (abs x) (* (sig x) (expt 2 (expo x)))))
+  :hints (("Goal" :use fp-rep))
+  :rule-classes ())
+
+
+
+
+;expo
+
+
+(defthm expo-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= (expt 2 (expo x)) (abs x)))
+  :rule-classes :linear)
+
+(defthm expo-lower-pos
+  (implies (and (< 0 x)
+                (rationalp x)
+                )
+           (<= (expt 2 (expo x)) x))
+  :rule-classes :linear)
+
+(defthm expo-of-not-rationalp
+  (implies (not (rationalp x))
+           (equal (expo x) 0)))
+
+;make a vesion whose max term is consistent with split exponents?                
+(defthm expo-upper-bound
+  (implies (rationalp x)
+           (< (abs x) (expt 2 (1+ (expo x)))))
+  :rule-classes :linear
+)
+
+(defthm expo-upper-pos
+  (implies (rationalp x)
+           (< x (expt 2 (1+ (expo x)))))
+  :rule-classes :linear)
+
+;be careful: if you enable expo, the x<0 case of expo can loop with expo-minus
+;BOZO add theory-invariant
+(defthm expo-minus
+  (equal (expo (* -1 x))
+         (expo x)))
+
+(local
+ (defthm expo-unique-2
+   (implies (and (rationalp x)
+                 (not (equal x 0))
+                 (integerp n)
+                 (> n (expo x)))
+            (> (expt 2 n) (abs x)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (disable abs)
+            :use ( ;(:instance expo-upper-bound)
+                  (:instance expt-weak-monotone (n (1+ (expo x))) (m n)))))))
+
+(local
+ (defthm expo-unique-1
+   (implies (and (rationalp x)
+                 (not (equal x 0))
+                 (integerp n)
+                 (< n (expo x)))
+            (<= (expt 2 (1+ n)) (abs x)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (disable abs)
+            :use ((:instance expt-weak-monotone (n (1+ n)) (m (expo x))))))))
+
+
+
+(defthm expo-unique
+  (implies (and (<= (expt 2 n) (abs x))
+                (< (abs x) (expt 2 (1+ n)))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal n (expo x)))
+  :hints (("Goal" :in-theory (disable abs)
+           :use ((:instance expo-unique-1)
+                 (:instance expo-unique-2))))
+  :rule-classes ())
+
+
+(defthmd expo-monotone
+  (implies (and (<= (abs x) (abs y))
+                (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (rationalp y))
+                )
+           (<= (expo x) (expo y)))
+  :rule-classes :linear
+  :hints (("Goal"
+           :use (;(:instance expo-lower-bound)
+                 (:instance expo-unique-2 (n (expo x)) (x y))))))
+
+
+(defthm expo-2**n
+  (implies (integerp n)
+           (equal (expo (expt 2 n))
+                  n))
+  :hints (("Goal" :use ((:instance expo-unique (x (expt 2 n)))
+			(:instance expt-strong-monotone (m (1+ n)))))))
+
+
+;sig
+
+;BOZO looped with sig-minus??
+(defthmd sig-minus
+  (equal (sig (* -1 x))
+         (sig x))
+  :hints (("Goal" :in-theory (enable sig) 
+           :cases ((rationalp x)))))
+
+(defthm sig-minus-gen
+  (implies (syntaxp (negative-syntaxp x))
+           (equal (sig x)
+                  (sig (* -1 x))))
+  :hints (("Goal" :in-theory (enable sig-minus))))
+
+(defthm sig-lower-bound
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (<= 1 (sig x)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :in-theory  (disable abs)
+           :use ((:instance fp-abs)))))
+
+(defthm sig-of-not-rationalp
+  (implies (not (rationalp x))
+           (equal (sig x)
+                  0))
+  :hints (("Goal" :in-theory (enable sig))))
+
+(defthm sig-rationalp-type-prescription
+  (rationalp (sig x))
+  :rule-classes (:type-prescription))
+
+(defthm sig-positive-type-prescription
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0))))
+           (< 0 (sig x)))
+  :hints (("Goal" :in-theory (enable sig)))
+  :rule-classes (:type-prescription))
+
+(defthm sig-non-negative-type-prescription
+  (<= 0 (sig x))
+  :rule-classes (:type-prescription))
+
+;rephrase
+(defthm x-0-iff-sig-x-0
+  (implies (rationalp x)
+           (equal (equal (sig x) 0)
+                  (equal x 0))))
+
+;would like to reduce the number of hints here...
+(defthm sig-upper-bound
+  (< (sig x) 2)
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use (:instance expo-upper-bound)
+           :in-theory (e/d (sig expt-split) (expo-bound-eric)))))
+
+
+
+
+
+
+;sgn
+
+;Do we plan to enable sgn in our proofs?
+
+(defthm sgn-minus
+  (equal (sgn (* -1 x))
+         (* -1 (sgn x)))
+  :hints (("Goal" :cases ((rationalp x)))))
+
+(defthm sgn+1
+  (implies (and (< 0 x)
+                (rationalp x)
+                )
+           (equal (sgn x) 
+                  1))
+  :rule-classes ())
+
+(defthm sgn-1
+  (implies (and (< x 0)
+                (rationalp x))
+           (equal (sgn x) 
+                  -1))
+  :rule-classes ())
+
+;gen to multiplying by anything positive?
+(defthm sgn-shift
+  (equal (sgn (* x (expt 2 k)))
+         (sgn x)))
+
+(defthm sgn-sig
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0))))
+           (equal (sgn (sig x))
+                  1))
+  :hints (("Goal" :in-theory (enable sgn sig))))
+
+(defthm sgn-prod
+  (implies (and (case-split (rationalp x))
+                (case-split (rationalp y))
+                )
+           (equal (sgn (* x y))
+                  (* (sgn x) (sgn y))))
+  :hints (("Goal" :in-theory (enable sgn))))
+
+(defthm sgn-sgn
+  (equal (sgn (sgn x))
+         (sgn x))
+  :hints (("Goal" :in-theory (enable sgn))))
+
+(defthm sgn-expt
+  (equal (sgn (expt 2 x))
+         1)
+  :hints (("Goal" :in-theory (enable sgn))))
+
+(defthm sgn-equal-0
+  (equal (equal (sgn x) 0)
+         (or (equal x 0)
+             (not (rationalp x))))
+  :hints (("goal" :in-theory (enable sgn))))
+
+(defthm sig-equal-0
+  (equal (equal (sig x) 0)
+         (or (equal x 0)
+             (not (rationalp x))))
+  :hints (("goal" :in-theory (enable sig))))
+
+(defthm sig-*-sgn
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                )
+           (equal (sig (* (sgn x) y))
+                  (sig y)))
+  :hints (("Goal" :in-theory (enable sig sgn))))
+
+(defthm sig-of-non-rational
+  (implies (not (rationalp x))
+           (equal (sig x)
+                  0))
+  :hints (("Goal" :in-theory (enable sig))))
+
+(defthm sgn-of-non-rational
+  (implies (not (rationalp x))
+           (equal (sgn x)
+                  0))
+  :hints (("Goal" :in-theory (enable sgn))))
+
+(defthm expo-*-sgn
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                )
+           (equal (expo (* (sgn x) y))
+                  (expo y)))
+      :hints (("goal" :in-theory (enable sgn))))
+
+(defthm fp-unique-1
+    (implies (and (rationalp m)
+		  (integerp e)
+		  (<= 1 m)
+		  (< 0 e))
+	     (<= 2 (* m (expt 2 e))))
+    :hints (("Goal" :in-theory (enable expt))) ;yuck
+             :rule-classes ())
+
+(defthm fp-unique-2
+  (implies (and (rationalp m)
+                (integerp e)
+                (< m 2)
+                (< e 0))
+           (< (* m (expt 2 e)) 1))
+  :hints (("Goal" :in-theory (enable expt))) ;yuck
+  :rule-classes ())
+
+(defthm fp-unique-3
+    (implies (and (rationalp m)
+		  (integerp e)
+		  (<= 1 m)
+		  (< m 2)
+		  (<= 1 (* m (expt 2 e)))
+		  (< (* m (expt 2 e)) 2))
+	     (equal e 0))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fp-unique-1)
+			(:instance fp-unique-2)))))
+
+
+
+(defthm =*
+  (implies (and (rationalp x1)
+                (rationalp x2)
+                (rationalp y)
+                (not (equal y 0))
+                (equal x1 x2))
+           (equal (* x1 y) (* x2 y)))
+  :rule-classes ())
+
+(defthm fp-unique-4
+    (implies (and (rationalp m1)
+		  (integerp e1)
+		  (rationalp m2)
+		  (integerp e2)
+		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
+	     (= (* m1 (expt 2 (- e1 e2))) m2))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (expt-split
+                                   ) ())
+           :use (;(:instance expt- (a e1) (b e2))
+                 (:instance =* (x1 (* m1 (expt 2 e1))) (x2 (* m2 (expt 2 e2))) (y (expt 2 (- e2))))))))
+
+(defthm fp-unique-5
+    (implies (and (rationalp m1)
+		  (integerp e1)
+		  (rationalp m2)
+		  (integerp e2)
+		  (<= 1 m1)
+		  (< m1 2)
+		  (<= 1 m2)
+		  (< m2 2)
+		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
+	     (= e1 e2))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fp-unique-3 (m m1) (e (- e1 e2)))
+			(:instance fp-unique-4)))))
+
+(defthm *cancell
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp z)
+		  (not (= z 0))
+		  (= (* x z) (* y z)))
+	     (= x y))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance =* (x1 (* x z)) (x2 (* y z)) (y (/ z)))))))
+
+(defthm fp-unique-6
+    (implies (and (rationalp m1)
+		  (integerp e1)
+		  (rationalp m2)
+		  (integerp e2)
+		  (<= 1 m1)
+		  (< m1 2)
+		  (<= 1 m2)
+		  (< m2 2)
+		  (= (* m1 (expt 2 e1)) (* m2 (expt 2 e2))))
+	     (= m1 m2))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fp-unique-5)
+			(:instance cancel-equal-* (r m1) (s m2) (a (expt 2 e1)))))))
+
+(defthm fp-rep-unique
+    (implies (and (rationalp x)
+		  (rationalp m)
+		  (<= 1 m)
+		  (< m 2)
+		  (integerp e)
+		  (= (abs x) (* m (expt 2 e))))
+	     (and (= m (sig x))
+		  (= e (expo x))))
+  :rule-classes ()
+  :hints (("Goal"
+           :use ((:instance fp-rep)
+                 (:instance sig-lower-bound)
+                 (:instance sig-upper-bound)
+                 (:instance fp-unique-5 (m1 m) (m2 (sig x)) (e1 e) (e2 (expo x)))
+                 (:instance fp-unique-6 (m1 m) (m2 (sig x)) (e1 e) (e2 (expo x)))))))
+
+;drop this?
+(defthm sig-expo-shift
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (integerp n))
+           (and (= (sig (* (expt 2 n) x)) (sig x))
+                (= (expo (* (expt 2 n) x)) (+ n (expo x)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sig)
+           :use ((:instance sgn+1)
+                 (:instance fp-rep)
+
+                 (:instance sig-lower-bound)
+                 (:instance sig-upper-bound)
+                 (:instance fp-rep-unique (x (* (expt 2 n) x)) (m (sig x)) (e (+ n (expo x))))))))
+
+
+(defthm expo-shift
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (integerp n))
+           (equal (expo (* (expt 2 n) x)) 
+                  (+ n (expo x))))
+  :hints (("Goal" :use (sig-expo-shift))))
+
+(defthm expo-shift-2
+  (implies (and (case-split (rationalp x))
+                (case-split (not (equal x 0)))
+                (case-split (integerp n)))
+           (equal (expo (* x (expt 2 n))) 
+                  (+ n (expo x))))
+  :hints (("Goal" :in-theory (disable expo-shift) 
+           :use expo-shift)))
+
+;(in-theory (disable expo-shift-2)) ; can cause loops if enabled?
+
+(defthm sig-shift
+  (equal (sig (* (expt 2 n) x)) 
+         (sig x))
+  :hints (("Goal" :in-theory (set-difference-theories (enable sig expt)
+                                                      '( expo-shift-2))
+           :use (sig-expo-shift))))
+
+(defthm sig-shift-2
+  (equal (sig (* x (expt 2 n))) 
+         (sig x))
+  :hints (("Goal" :in-theory (disable sig-shift)
+           :use (sig-shift))))
+
+(defthm sig-shift-by-constant-power-of-2
+  (implies (and (syntaxp (and (quotep k)))
+                (power2p k)
+                )
+           (equal (sig (* k x))
+                  (sig x)))
+  :hints (("Goal" :in-theory (enable power2p-rewrite))))
+
+(defthm sig-shift-by-power-of-2
+  (implies (and (syntaxp (power2-syntaxp k))
+                (force (power2p k))
+                )
+           (equal (sig (* k x))
+                  (sig x)))
+  :hints (("Goal" :in-theory (enable power2p-rewrite))))
+
+(defthm sig-shift-by-power-of-2-2
+  (implies (and (syntaxp (power2-syntaxp k))
+                (force (power2p k))
+                )
+           (equal (sig (* x k))
+                  (sig x)))
+  :hints (("Goal" :in-theory (enable power2p-rewrite))))
+
+
+
+;(in-theory (disable sig-shift-2)) ;can cause loops if enabled?
+
+
+(defthm sig-sig
+  (equal (sig (sig x)) 
+         (sig x))
+  :hints (("Goal" :in-theory (enable sig))))
+
+
+#|
+(defthm expt-non-neg
+    (implies (integerp n)
+	     (not (< (expt 2 n) 0))))
+|#
+
+;move?
+(defthm expo-prod-lower
+  (implies (and (rationalp x)
+                (not (= x 0))
+                (rationalp y)
+                (not (= y 0)))
+           (<= (+ (expo x) (expo y)) (expo (* x y))))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (enable a15)
+           :use ((:instance *-doubly-monotonic 
+                            (x (expt 2 (expo x)))
+                            (y (abs x))
+                            (a (expt 2 (expo y)))
+                            (b (abs y)))
+                 (:instance expo-lower-bound)
+                 (:instance expo-lower-bound (x y))
+                 (:instance expo-unique-2 (x (* x y)) (n (+ (expo x) (expo y))))))))
+
+(defthm *-doubly-strongly-monotonic
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp a)
+                (rationalp b)
+                (< 0 x)
+                (< 0 y)
+                (< 0 a)
+                (< 0 b)
+                (< x y)
+                (< a b))
+           (< (* x a) (* y b)))
+  :rule-classes ())
+
+(defthm expo-prod-upper
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (>= (+ (expo x) (expo y) 1) (expo (* x y))))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (enable a15)
+		  :use ((:instance *-doubly-strongly-monotonic
+				   (x (abs x))
+				   (y (expt 2 (1+ (expo x))))
+				   (a (abs y))
+				   (b (expt 2 (1+ (expo y)))))
+			(:instance expo-upper-bound)
+			(:instance expo-upper-bound (x y))
+			(:instance expo-unique-1 (x (* x y)) (n (+ (expo x) (expo y) 1)))))))
+
+
+
+;exactp
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defthm exactp-0
+  (exactp 0 n)
+  :hints (("Goal" :in-theory (enable exactp))))
+
+(defthm exactp-sig
+  (equal (exactp (sig x) n)
+         (exactp x n))
+  :hints (("Goal" :in-theory (enable exactp))))
+
+(defthmd exactp-minus
+  (equal (exactp (* -1 x) n)
+         (exactp x n))
+  :hints (("Goal" :in-theory (enable exactp))))
+
+(defthm exactp-minus-gen
+  (implies (syntaxp (negative-syntaxp x))
+           (equal (exactp x n)
+                  (exactp (* -1 x) n)))
+  :hints (("Goal" :in-theory (enable exactp-minus))))
+
+#| kill
+;make negative-syntaxp version
+;add? ;three summand version?
+(defthm exactp-minus-dist
+  (equal (exactp (+ (* -1 x) (* -1 y)) n)
+         (exactp (+ x y) n))
+  :hints (("Goal" :in-theory (disable exactp-minus)
+          :use (:instance exactp-minus (x (* -1 (+ x y)))))))
+|#
+
+
+;similar to other hacks?
+(defthmd between-0-and-1-means-not-integerp
+  (implies (and (< 0 x)
+                (< x 1))
+           (not (integerp x))))
+
+(defthm sig-prod-linear
+  (implies (and (<= 0 y)
+                (rationalp x)
+                (rationalp y))
+           (<= (* (sig x) y) (* 2 y)))
+  :rule-classes (:linear)
+  )
+
+;rephrase?
+(defthmd only-0-is-0-or-negative-exact
+  (implies (and (<= n 0)
+                (integerp n)
+                (case-split (rationalp x))
+                (case-split (not (= x 0))))
+           (not (exactp x n)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable exactp expt-split ;expt
+                                      )
+                              '( fl-equal-0 ;why was this needed?
+                                    ))
+           :use (:instance between-0-and-1-means-not-integerp (x (* (SIG X) (EXPT 2 (+ -1 N))))))))
+
+#|
+;gross?
+;just enable sig?
+(defthm exactp-lemma
+  (implies (and (rationalp x)
+                (integerp n))
+           (equal (* (sig x) (expt 2 (1- n)))
+                  (* (abs x) (expt 2 (- (1- n) (expo x))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sig))))
+
+|#
+
+
+
+
+;not needed?
+;bad name?
+;reorder and call exactp-abs and make rewrite
+;more rules to drop abs?
+(defthm exact-neg
+  (equal (exactp x n)
+         (exactp (abs x) n))
+  :hints (("Goal" :in-theory (enable exactp)))
+  :rule-classes ())
+
+;make this a definition rule?
+(defthmd exactp2
+  (implies (and (rationalp x)
+                (integerp n))
+           (equal (exactp x n)
+                  (integerp (* x (expt 2 (- (1- n) (expo x)))))))
+  :hints (("Goal" :in-theory (e/d (exactp sig expt-split) ()))))
+
+
+#| kill
+;could this be a rewrite rule?
+(defthm exactp-shift
+  (implies (and (rationalp x)
+                (integerp m)
+                (integerp n)
+                (exactp x m))
+           (exactp (* (expt 2 n) x) m))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable exactp2)
+                              '( sgn))
+           :cases ((= x 0)))))
+|#
+
+;consider enabling?
+;reorder product in lhs?
+(defthmd exactp-shift
+    (implies (and (rationalp x)
+                (integerp k)
+                (integerp n))
+           (equal (exactp (* (expt 2 k) x) n)
+                  (exactp x n)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable exactp2 a15)
+                              '( sgn))
+           :cases ((= x 0)))))
+
+(defthmd exactp-shift-2
+  (implies (and (rationalp x)
+                (integerp m)
+                (integerp n)
+                )
+           (equal (exactp (* x (expt 2 n)) m)
+                  (exactp x m)))
+  :hints (("Goal" :use  ((:instance exactp-shift (k n) (n m))))))
+
+(defthm exactp-shift-by-constant-power-of-2
+  (implies (and (syntaxp (and (quotep k)))
+                (power2p k)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (exactp (* k x) n)
+                  (exactp x n)))
+  :hints (("Goal" :in-theory (enable exactp-shift-2 power2p-rewrite))))
+
+(defthm exactp-shift-by-power-of-2
+  (implies (and (syntaxp (power2-syntaxp k))
+                (force (power2p k))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (exactp (* k x) n)
+                  (exactp x n)))
+  :hints (("Goal" :in-theory (enable  exactp-shift-2 power2p-rewrite))))
+
+(defthm exactp-shift-by-power-of-2-2
+  (implies (and (syntaxp (power2-syntaxp k))
+                (force (power2p k))
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (exactp (* x k) n)
+                  (exactp x n)))
+  :hints (("Goal" :in-theory (enable  exactp-shift-2 power2p-rewrite))))
+
+
+
+(defthm exactp-prod-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (integerp m))
+	     (= (expt 2 (+ m n -1 (- (expo (* x y)))))
+		(* (expt 2 (- (1- m) (expo x)))
+		   (expt 2 (- (1- n) (expo y)))
+		   (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y))))))))
+  :rule-classes ())
+
+(defthm exactp-prod-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (rationalp y)
+		  (not (= y 0)))
+	     (integerp (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y)))))))
+  :rule-classes ()
+  :hints (("Goal" 
+		  :use ((:instance expo-prod-upper)))))
+
+(defthm integerp-x-y-z
+    (implies (and (integerp x) (integerp y) (integerp z))
+	     (integerp (* x y z)))
+  :rule-classes ())
+
+(defthm exactp-prod
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp n)
+		  (exactp x m)
+		  (exactp y n))
+	     (exactp (* x y) (+ m n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2 expt-split)
+		  :use ((:instance exactp-prod-1)
+			(:instance exactp-prod-2)
+			(:instance integerp-x-y-z 
+				   (x (* x (expt 2 (- (1- m) (expo x)))))
+				   (y (* y (expt 2 (- (1- n) (expo y)))))
+				   (z (expt 2 (+ (expo x) (expo y) 1 (- (expo (* x y)))))))))))
+
+(defthm exactp-x2-1
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (= (* 2 (expt 2 n) (expt 2 n))
+		(expt 2 (+ n n 1))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-split (r 2) (i m) (j n))
+			(:instance expt-split (r 2) (i (* 2 n)) (j 1))))))
+
+(defthm exactp-x2-2
+    (implies (and (rationalp x)
+		  (rationalp y))
+	     (= (* 2 (* x y) (* x y))
+		(* (* x x) (* 2 y y))))
+  :rule-classes ())
+
+(defthm exactp-x2-3
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (= (* 2 (* x (expt 2 n)) (* x (expt 2 n)))
+		(* (* x x) (expt 2 (+ n n 1)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance exactp-x2-1)
+			(:instance exactp-x2-2 (y (expt 2 n)))))))
+
+(defthm exactp-x2-4
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp e))
+	     (= (* 2 (* x (expt 2 (- (1- n) e))) (* x (expt 2 (- (1- n) e))))
+		(* (* x x) (expt 2 (- (1- (* 2 n)) (* 2 e))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance exactp-x2-3 (n (- (1- n) e)))))))
+
+(defthm exactp-x2-5
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp e)
+		  (integerp e2))
+	     (= (* 2 (* x (expt 2 (- (1- n) e))) (* x (expt 2 (- (1- n) e))))
+		(* (* (* x x) (expt 2 (- (1- (* 2 n)) e2)))
+		   (expt 2 (- e2 (* 2 e))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance exactp-x2-4)
+			(:instance expt-split (r 2) (i (- (1- (* 2 n)) e2)) (j (- e2 (* 2 e))))))))
+
+(defthm integerp-x-y
+    (implies (and (integerp x)
+		  (integerp y))
+	     (integerp (* x y)))
+  :rule-classes ())
+
+(defthm exactp-x2-6
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (integerp (* 2 (* x (expt 2 (- (1- n) (expo x)))) (* x (expt 2 (- (1- n) (expo x)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (expt-split exactp2 expt-with-product-exponent) ())
+		  :use ((:instance expo-prod-lower (y x))
+			(:instance integerp-x-y 
+				   (x (* (* x x) (expt 2 (- (1- (* 2 n)) (expo (* x x))))))
+				   (y (expt 2 (- (expo (* x x)) (* 2 (expo x))))))
+			(:instance exactp-x2-5 (e (expo x)) (e2 (expo (* x x))))))))
+
+(defthm exactp-x2-not-zero
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2 expt-split)
+		  :use ((:instance exactp-x2-6)
+			(:instance x-2xx (x (* x (expt 2 (- (1- n) (expo x))))))))))
+
+;what's the role of k here?
+(defthm exactp-x2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (exactp (* x x) (* 2 n)))
+	     (exactp x n))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance exactp-x2-not-zero)))))
+
+(defthmd exactp-<=
+  (implies (and (exactp x m)
+                (<= m n)
+                (rationalp x)
+                (integerp n)
+                (integerp m)
+                )
+           (exactp x n))
+  :hints (("Goal" :in-theory (enable exactp2 expt-split)
+           :use (;(:instance expt-split (r 2) (i (- (1- m) (expo x))) (j (- n m)))
+                 (:instance integerp-x-y 
+                            (x (* x (expt 2 (- (1- m) (expo x))))) 
+                            (y (expt 2 (- n m))))))))
+
+
+(defthm exactp-<=-expo
+  (implies (and (rationalp x)
+                (integerp n)
+                (integerp e)
+                (<= e (expo x))
+                (exactp x n))
+           (integerp (* x (expt 2 (- (1- n) e)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2 expt-split)
+           :use ( ;(:instance expt-split (r 2) (i (- (1- n) (expo x))) (j (- (expo x) e)))
+                 (:instance integerp-x-y 
+                            (x (* x (expt 2 (- (1- n) (expo x))))) 
+                            (y (expt 2 (- (expo x) e))))))))
+
+(defthm exactp->=-expo
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp e)
+		  (>= e (expo x))
+		  (integerp (* x (expt 2 (- (1- n) e)))))
+	     (exactp x n))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2 expt-split)
+           :use ((:instance expt-split (r 2) (i (- (1- n) e)) (j (- e (expo x))))
+			(:instance integerp-x-y 
+				   (x (* x (expt 2 (- (1- n) e))))
+				   (y (expt 2 (- e (expo x)))))))))
+
+(defthm exactp-diff
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (integerp n)
+		  (> n 0)
+		  (> n k)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (+ k (expo (- x y))) (expo x))
+		  (<= (+ k (expo (- x y))) (expo y)))
+	     (exactp (- x y) (- n k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2)
+		  :use ((:instance exactp-<=-expo (e (+ k (expo (- x y)))))
+			(:instance exactp-<=-expo (e (+ k (expo (- x y)))) (x y))))))
+
+(defthm exactp-diff-0
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (<= (expo (- x y)) (expo x))
+		  (<= (expo (- x y)) (expo y)))
+	     (exactp (- x y) n))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance exactp-diff (k 0))))))
+
+;bad name?
+(defthm exactp-diff-cor
+  (implies (and (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n)
+                (<= (abs (- x y)) (abs x))
+                (<= (abs (- x y)) (abs y)))
+           (exactp (- x y) n))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance exactp-diff-0)
+                        (:instance expo-monotone (x (- x y)) (y x))
+                        (:instance expo-monotone (x (- x y)))))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defthm fp+-positive
+  (implies (<= 0 x)
+           (< 0 (fp+ x n)))
+  :rule-classes :type-prescription)
+
+(defthm fp+2-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (integerp (* (- y x) (expt 2 (- (1- n) (expo x))))))
+    :otf-flg t
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (exactp2 expt-split)())
+           :use ((:instance expo-monotone)
+                 (:instance exactp-<=-expo (x y) (e (expo x)))))))
+
+
+(defthm fp+2-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (integerp (* (- y x) (expt 2 (- (1- n) (expo x))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2)
+           :use ((:instance expo-monotone)
+                 (:instance exactp-<=-expo (x y) (e (expo x)))))))
+
+(defthm int>0
+  (implies (and (integerp n)
+                (> n 0))
+           (>= n 1))
+  :rule-classes ())
+
+(defthm fp+2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y x)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= y (fp+ x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split)
+		  :use (;(:instance expt-split (r 2) (i (- (1- n) (expo x))) (j (- (1+ (expo x)) n)))
+			(:instance fp+2-1)
+			(:instance int>0 (n (* (- y x) (expt 2 (- (1- n) (expo x))))))))))
+
+
+
+(defthm fp+1-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (<= (fp+ x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("Goal"  :in-theory (enable exactp2)
+		  :use ((:instance fp+2 (y (expt 2 (1+ (expo x)))))
+			(:instance expo-upper-bound)))))
+
+(defthm x<fp+
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (fp+ x n) x))
+  :rule-classes ())
+
+;export in lib/?
+(defthm ratl-fp+
+  (implies (rationalp x)
+           (rationalp (fp+ x n)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm expo-sig
+  (equal (expo (sig x))
+         0)
+  :hints (("Goal" :in-theory (enable sig))))
+
+(defthm fp+1-2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (or (= (fp+ x n) (expt 2 (1+ (expo x))))
+		 (= (expo (fp+ x n)) (expo x))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable fp+)
+		  :use ((:instance fp+1-1)
+			(:instance x<fp+)
+			(:instance expo-lower-bound)
+			(:instance expo-unique (x (fp+ x n)) (n (expo x)))))))
+
+(defthm fp+1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n))
+	     (exactp (fp+ x n) n))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2)
+		  :use ((:instance fp+1-2)))))
+
+(defthm expo-diff-min-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (> y x))
+	     (>= (expo (- y x)) (- (1+ (expo x)) n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)
+		  :use ((:instance fp+2)
+			(:instance expo-monotone (y (- y x)) (x (expt 2 (- (1+ (expo x)) n))))))))
+
+(defthm expo-diff-min-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (> y x))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                       EXPO-COMPARISON-REWRITE-TO-BOUND)
+		  :use ((:instance expo-diff-min-1)			
+			(:instance expo-monotone)))))
+
+
+(defthm expo-diff-min-pos
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expo-minus  EXPO-COMPARISON-REWRITE-TO-BOUND
+                                      EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+		  :use ((:instance expo-diff-min-2)
+			(:instance expo-diff-min-2 (x y) (y x))
+			(:instance expo-minus (x (- y x)))))))
+
+(defthm expo-diff-min-neg
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< x 0)
+		  (< y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n)
+		  (not (= y x)))
+	     (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expo-diff-min-pos
+                                   (x (- y))
+                                   (y (- x)))
+                        (:instance expo-minus (x x))
+                        (:instance expo-minus (x y))
+                        (:instance expo-minus (x (- (- (- x) (- y))))))
+           :in-theory (disable expo-comparison-rewrite-to-bound
+                               expo-comparison-rewrite-to-bound-2))))
+
+(defthm expo-diff-min-mixed
+  (implies (and (rationalp x)
+                (rationalp y)
+                (<= x 0)
+                (<= 0 y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n))
+           (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ()
+  :hints (("Goal"
+           :use ((:instance expo-monotone
+                            (x y)
+                            (y (- y x))))
+           :in-theory (disable expo-comparison-rewrite-to-bound
+                               expo-comparison-rewrite-to-bound-2))))
+
+(local (defthm expo-diff
+         (equal (expo (+ x (* -1 y)))
+                (expo (+ y (* -1 x))))
+         :hints (("Goal" :use ((:instance expo-minus (x (+ x (* -1 y)))))))))
+
+(defthm expo-diff-min
+  (implies (and (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0)
+                (exactp x n)
+                (exactp y n)
+                (not (= y x)))
+           (>= (expo (- y x)) (- (1+ (min (expo x) (expo y))) n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
+                                      EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+           :use ((:instance expo-diff-min-pos)
+                 (:instance expo-diff-min-neg)
+                 (:instance expo-diff-min-mixed)
+                 (:instance expo-diff-min-mixed (x y) (y x))))))
+
+(local (in-theory (disable expo-diff)))
+
+;make into a rewrite (rewrite to a claim about m?)
+;change param names to i and n?
+(defthmd exactp-2**n
+  (implies (and ;(case-split (integerp n)) ;drop?
+                (case-split (integerp m))
+                (case-split (> m 0))
+                )
+           (exactp (expt 2 n) m))
+  :hints (("Goal" :in-theory (enable exactp2)))
+  )
+
+;change param names to i and n?
+;gen to any power of 2 (e.g., (* 2 (expt n) (/ (expt m)))
+(defthm exactp-2**n-rewrite
+  (implies (case-split (integerp m)) ;move to conclusion?
+           (equal (exactp (expt 2 n) m)
+                  (< 0 m)))
+  :hints (("Goal" :in-theory (enable exactp2)))
+  )
+
+
+(defthmd expo-upper-2
+    (implies (and (< (abs x) (expt 2 n)) ;i don't like abs here
+                  (< 0 x)
+                  (rationalp x)
+		  (integerp n)
+		  )
+	     (< (expo x) n))
+  :rule-classes :linear
+  :hints (("Goal"
+		  :use ((:instance expo-lower-bound)
+			(:instance expt-strong-monotone (n (expo x)) (m n))))))
+
+
+#|
+(defthm xy2-1
+    (implies (and (rationalp z)
+		  (<= (abs (- 1 z)) 1/2))
+	     (and (<= -1 (expo z))
+		  (<= (expo z) 0)))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance expo-monotone (x 1/2) (y z))
+			(:instance expo-monotone (x z) (y 3/2))))))
+
+(defthm xy2-2
+    (implies (and (rationalp z)
+		  (<= (abs (- 1 z)) 1/2))
+	     (<= (abs (expo z)) 1))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance xy2-1)))))
+|#
+
+;move?
+(defthm abs+2
+    (implies (and (rationalp x1)
+		  (rationalp x2))
+	     (<= (abs (+ x1 x2)) (+ (abs x1) (abs x2))))
+  :rule-classes ())
+
+;move
+(defthm abs+3
+  (implies (and (rationalp x1)
+                (rationalp x2)
+                (rationalp x3))
+           (<= (abs (+ x1 x2 x3)) (+ (abs x1) (abs x2) (abs x3))))
+  :rule-classes ())
+
+#|
+(defthm xy2-3
+  (implies (and (rationalp x)
+                (rationalp y)
+                (<= (abs (- 1 (* x y y))) 1/2))
+           (and (not (= x 0)) (not (= y 0))))
+  :rule-classes ()
+  :hints (("Goal"
+           :use ((:instance xy2-1)))))
+
+
+(defthm xy2-4
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (<= (abs (- (* 2 (expo y)) (expo (* y y)))) 1))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance xy2-3)
+			(:instance expo-prod-lower (x y))
+			(:instance expo-prod-upper (x y))))))
+
+(defthm xy2-5
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (<= (abs (- (+ (expo (* y y)) (expo x)) (expo (* x y y)))) 1))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance xy2-3)
+			(:instance expo-prod-lower (y (* y y)))
+			(:instance expo-prod-upper (y (* y y)))))))
+
+(defthm xy2-6
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (<= (abs (+ (* 2 (expo y)) (expo x))) 3))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance xy2-2 (z (* x y y)))
+			(:instance xy2-4)
+			(:instance xy2-5)
+			(:instance abs+3 
+				   (x1 (- (* 2 (expo y)) (expo (* y y))))
+				   (x2 (expo (* x y y)))
+				   (x3 (- (+ (expo (* y y)) (expo x)) (expo (* x y y)))))))))
+|#
+
+;move
+(defthm abs-2
+    (implies (and (rationalp x1)
+		  (rationalp x2))
+	     (<= (abs (- x1 x2)) (+ (abs x1) (abs x2))))
+  :rule-classes ())
+
+#|
+(defthm xy2-7
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (<= (abs (* 2 (expo y))) (+ 3 (abs (expo x)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance xy2-6)
+			(:instance abs-2
+				   (x1 (+ (* 2 (expo y)) (expo x)))
+				   (x2 (expo x)))))))
+
+(defthm xy2-a
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (< (abs (expo y)) (+ (/ (abs (expo x)) 2) 2)))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance xy2-7)))))
+
+(defthm xy2-8
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp xp)
+		  (not (= xp 0))
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (<= (abs (* 2 (- (expo (* xp y)) (+ (expo xp) (expo y)))))
+		 2))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance xy2-3)
+			(:instance expo-prod-lower (x xp))
+			(:instance expo-prod-upper (x xp))))))
+
+(defthm hack4
+    (implies (and (rationalp a)
+		  (rationalp b)
+		  (rationalp c))
+	     (= (+ (* 2 a)
+		   (* 2 b)
+		   (* -2 a)
+		   (* -2 b)
+		   (* 2 c))
+		(* 2 c)))
+  :rule-classes ())
+
+(defthm xy2-9
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp xp)
+		  (= (expo xp) (expo x))
+		  (not (= xp 0))
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (<= (abs (* 2 (expo (* xp y))))
+		 (+ 5 (abs (expo x)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance abs+3
+				   (x1 (* 2 (- (expo (* xp y)) (+ (expo xp) (expo y)))))
+				   (x2 (+ (* 2 (expo y)) (expo xp)))
+				   (x3 (expo xp)))
+			(:instance hack4 (a (expo x)) (b (expo y)) (c (expo (* xp y))))
+			(:instance xy2-8)
+			(:instance xy2-6)))))
+
+(defthm xy2-10
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp xp)
+		  (= (expo xp) (expo x))
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (<= (abs (* 2 (expo (* xp y))))
+		 (+ 5 (abs (expo x)))))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance xy2-9)))))
+
+;who uses this or any of the xy2-... lemmas??
+(defthm xy2-b
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp xp)
+		  (= (expo xp) (expo x))
+		  (<= (abs (- 1 (* x y y))) 1/2))
+	     (< (abs (expo (* xp y))) (+ (/ (abs (expo x)) 2) 3)))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance xy2-10)))))
+
+|#
+
+(defthm expo-diff-abs-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x y)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (>= (expo (- y x))
+		 (- (expo y) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                      EXPO-COMPARISON-REWRITE-TO-BOUND)
+		  :use ((:instance expo-diff-min)
+			(:instance expo-monotone (x y) (y x))))))
+
+(defthm expo-diff-abs-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x y)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (expo (- y x))
+		 (expo x)))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance expo-monotone (x (- y x)) (y x))))))
+
+(defthm expo-diff-abs-3
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (- (expo y) (1- n)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+    :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
+                                        EXPO-COMPARISON-REWRITE-TO-BOUND-2)))
+  :rule-classes ())
+
+(defthm expo-diff-abs-4
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 0))
+	     (<= (abs (expo x))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+    :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
+                                        EXPO-COMPARISON-REWRITE-TO-BOUND-2)))
+    :rule-classes ())
+
+;move?
+(defthmd abs-squeeze
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp z)
+		  (rationalp m)
+		  (<= x y)
+		  (<= y z)
+		  (<= (abs x) m)
+		  (<= (abs z) m))
+	     (<= (abs y) m))
+  :rule-classes :linear)
+
+;move?
+(defthm rationalp-abs
+  (implies (case-split (rationalp x))
+           (rationalp (abs x)))
+  :rule-classes (:rewrite :type-prescription))
+
+;yuck
+(local (in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                           EXPO-COMPARISON-REWRITE-TO-BOUND)))
+
+(defthm expo-diff-abs-5
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x y)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- y x)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance abs-squeeze
+				   (m (+ (max (abs (expo x)) (abs (expo y))) (1- n)))
+				   (x (- (expo y) (1- n)))
+				   (y (expo (- y x)))
+				   (z (expo x)))
+			(:instance expo-diff-abs-1)
+			(:instance expo-diff-abs-2)
+			(:instance expo-diff-abs-3)
+			(:instance expo-diff-abs-4)))))
+
+
+(defthm expo-diff-abs-6
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (not (= x y))
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs expo-minus)
+		  :use ((:instance expo-diff-abs-5)
+			(:instance expo-diff-abs-5 (x y) (y x))
+			(:instance expo-minus (x (- x y)))))))
+
+
+
+(defthm expo-diff-abs
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" ;:in-theory (disable abs)
+		  :use ((:instance expo-diff-abs-6)
+			))))
+
+(defthm expo-diff-abs-neg-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (>= x y)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (expo (+ x y))
+		 (+ (expo x) (1- n))))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use (;(:instance expo-2x-upper)		 
+			(:instance expo-monotone (x (+ x y)) (y (* 2 x)))))))
+
+(defthm expo-diff-abs-neg-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (>= x y)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (expo x) (expo (+ x y))))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance expo-monotone (y (+ x y)))))))
+
+;move or remove?
+(defthm abs-pos
+    (implies (<= 0 x)
+	     (equal (abs x) x)))
+
+(defthm expo-diff-abs-neg-3
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (>= x y)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (+ x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance expo-diff-abs-neg-1)
+			(:instance expo-diff-abs-neg-2)
+			(:instance abs-squeeze
+				   (m (+ (max (abs (expo x)) (abs (expo y))) (1- n)))
+				   (x (expo x))
+				   (y (expo (+ y x)))
+				   (z (+ (expo x) (1- n))))
+			(:instance abs+2 (x1 (expo x)) (x2 (1- n)))))))
+
+(defthm expo-diff-abs-neg-4
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (+ x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable abs)
+		  :use ((:instance expo-diff-abs-neg-3)
+			(:instance expo-diff-abs-neg-3 (x y) (y x))))))
+
+(defthm expo-diff-abs-neg-5
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (< y 0)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable exactp2)
+                              '( abs expo-minus))
+		  :use ((:instance expo-diff-abs-neg-4 (y (- y)))
+			(:instance expo-minus (x y))))))
+
+(defthm expo-diff-abs-neg-6
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory  (set-difference-theories
+                              (enable exactp2)
+                              '( abs expo-minus))
+		  :use ((:instance expo-diff-abs-neg-4 (x (- x)))
+			(:instance expo-minus (x (- x y)))
+			(:instance expo-minus)))))
+
+(defthm expo-diff-abs-neg-neg
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< x 0)
+		  (< y 0)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable exactp2)
+                              '( abs max expo-minus))
+		  :use ((:instance expo-diff-abs (x (- x)) (y (- y)))
+			(:instance expo-minus)
+			(:instance expo-minus (x (- x y)))
+			(:instance expo-minus (x y))))))
+
+(defthm expo-diff-abs-zero-y
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (= y 0)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ())
+
+(defthm expo-diff-abs-zero-x
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (= x 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expo-minus)
+		  :use ((:instance expo-minus (x y))))))
+
+(defthm expo-diff-abs-neg-x
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< x 0)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable max abs)
+		  :use ((:instance expo-diff-abs-zero-y)
+			(:instance expo-diff-abs-neg-6)
+			(:instance expo-diff-abs-neg-neg)))))
+
+(defthm expo-diff-abs-pos-x
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (integerp n)
+		  (> n 1)
+		  (exactp x n)
+		  (exactp y n))
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable max abs)
+		  :use ((:instance expo-diff-abs-zero-y)
+			(:instance expo-diff-abs)
+			(:instance expo-diff-abs-neg-5)))))
+
+(defthm expo-diff-abs-any
+    (implies (and (exactp x n)
+		  (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (> n 1)
+		  )
+	     (<= (abs (expo (- x y)))
+		 (+ (max (abs (expo x)) (abs (expo y))) (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable max abs)
+		  :use ((:instance expo-diff-abs-zero-x)
+			(:instance expo-diff-abs-neg-x)
+			(:instance expo-diff-abs-pos-x)))))
+;move?
+;try as a rewrite rule (perhaps with a backchain limit?)
+;why disabled?
+(defthm expo>=
+  (implies (and (<= (expt 2 n) x)
+                (rationalp x)
+                (integerp n)
+                )
+           (<= n (expo x)))
+  :otf-flg t
+  :rule-classes :linear
+  :hints (("goal" :use ((:instance expo-monotone (x (expt 2 n)) (y x))))))
+
+;move?
+;try as a rewrite rule (perhaps with a backchain limit?)
+;why disabled?
+(defthmd expo<=
+  (implies (and (< x (* 2 (expt 2 n)))
+                (< 0 x)
+                (rationalp x)
+                (integerp n)
+                )
+           (<= (expo x) n))
+  :rule-classes :linear
+  :hints (("goal" :use (expo-lower-bound
+			(:instance expt-split (r 2) (i 1) (j n))
+			(:instance expt-weak-monotone (n (1+ n)) (m (expo x)))))))
+
+(defthm sig-does-nothing
+  (implies (and (< x 2)
+                (<= 1 x)
+                (rationalp x)
+                )
+           (equal (sig x)
+                  x))
+  :hints (("Goal" :use ((:instance fp-rep-unique
+                                   (x x)
+                                   (m x)
+                                   (e (expo x))))
+           :in-theory (enable sig))))
+
+
+;proved in expo
+(defthm expo-x+2**k
+    (implies (and (< (expo x) k)
+                  (<= 0 x)
+                  (case-split (integerp k))
+		  (case-split (rationalp x))
+		  )
+	     (equal (expo (+ x (expt 2 k)))
+		    k)))
+
+
+;remove? or move elsewhere?
+#|
+bad name
+(defthm only-1-has-integerp-sig
+  (implies (and 
+            (rationalp x)
+            (not (equal x 0))
+            (integerp (sig x)))
+           (= (sig x) 1))
+  :hints (("Goal" :in-theory (disable sig-upper-bound)
+           :use (sig-upper-bound sig-lower-bound)))
+)
+|#
+
+
+;dup?
+(defthm exactp-shift-rewrite
+  (implies (and (rationalp x)
+                (integerp n)
+                (integerp k))
+           (and (equal (exactp (* (expt 2 k) x) n)
+                       (exactp x n))
+                (equal (exactp (* x (expt 2 k)) n)
+                       (exactp x n))))
+  :hints (("Goal" :use exactp-shift)))
+
+(defthm exactp-one-plus-expo
+  (implies (case-split (rationalp x)) ;gen?
+           (equal (exactp x (+ 1 (expo x)))
+                  (integerp x)))
+  :hints (("Goal" :in-theory (enable exactp)
+           :use ((:instance fp-rep)))))
+
+(defthmd sgn*
+    (implies (and (rationalp x) (rationalp y))
+	     (= (sgn (* x y)) (* (sgn x) (sgn y)))))
+
+(defthm already-sig
+  (implies (and (rationalp x)
+                (<= 1 x)
+                (< x 2))
+           (= (sig x) x)))
+
+(defthm sig-shift-4-alt
+  (implies (and (rationalp a)
+                (integerp n)
+                (case-split (not (equal a 0)))
+                )
+           (equal (sig (* a (EXPT 2 n)))
+                  (sig a)))
+  :HINTS (("Goal" :USE (:instance SIG-EXPO-SHIFT (x a)))))
+
+;add to lib?
+;can save you from having to :use fp-rep
+(defthmd fp-rep-cancel-expo
+  (implies (rationalp x)
+           (equal (* x (expt 2 (- (expo x))))
+                  (* (sgn x) (sig x))))
+  :hints (("Goal" :in-theory (enable sig
+                                     )
+           :use (fp-rep))))
+
+;do we need this?
+(defthmd fp-rep-cancel-sig
+  (equal (/ x (sig x))
+         (* (sgn x) (expt 2 (expo x))))
+  :hints (("Goal" :use (fp-rep))))
+
+;useful?
+; could be made more general?
+(defthm sig-x+2**k-non-neg
+  (implies (and (< x (expt 2 k))
+                (integerp k)
+                (rationalp x)
+                (<= 0 x)
+                )
+           (equal (sig (+ (expt 2 k) x))
+                  (+ 1 (/ x (expt 2 k)))))
+  :hints (("Goal" :in-theory (e/d () ( sig-does-nothing sig-shift))
+           :use ((:instance sig-shift
+                            (x (+ 1 (/ x (expt 2 k))))
+                            (n k))
+                 (:instance sig-does-nothing
+                            (x (+ 1 (/ x (expt 2 k)))))))))
+
+;rename?
+;what's the role of n here?
+;this does not mention trunc!
+;conceptually, x and y don't overlap
+(defthm expo-of-sum-of-disjoint
+  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
+                (exactp x n)
+                (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp n)
+                )
+           (equal (expo (+ x y))
+                  (expo x)
+                  ))
+  :hints (("Goal"  :in-theory (set-difference-theories
+                               (enable exactp sgn
+                                       expt-split expt-minus
+                                       sig
+                                       )
+                               '(expo-x+a*2**k
+                                 EXPT-COMPARE-EQUAL
+                                 EXPO-COMPARISON-REWRITE-TO-BOUND
+  ;                               EXPO-SHIFT-4-ALT-2
+                                 ))
+           :use (;(:instance expt-split (r 2) (i 1) (j (+ (EXPO X) (* -1 N))))
+                 (:instance expo<= (x y) (n (+ (EXPO X) (* -1 N))))
+                 ;(:instance fp-rep-cancel-expo)
+                 (:instance
+                  expo-x+a*2**k
+                  (x y)
+                  (k (+ (expo x) (- n) 1))
+                  (a (/ x (expt 2 (+ (expo x) (- n) 1)))))
+                 ))
+          )
+  :rule-classes nil
+  )
+
+
+
+
+(defthm exactp-with-n-not-integer
+  (implies (not (integerp n))
+           (equal (exactp x n)
+                  (or (equal 0 x)
+                      (not (rationalp x))
+                      (and (acl2-numberp n)
+                           (power2p (abs x))))))
+  :hints (("Goal" :in-theory (enable exactp sig expt-minus expt-split))))
+
+;BOZO could say power2p in conclusion?
+(defthm sig-x-1-means-power-of-2
+  (implies (and (rationalp x)
+;                (> x 0) ;gen?
+                )
+           (equal (equal (sig x) 1)
+                  (equal (expt 2 (expo x)) (abs x))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable sig expt-minus)
+                              '(expt-inverse))
+                              
+           :use ())))
+
+(defthm sig-less-than-1-means-x-0
+  (equal (< (sig x) 1)
+	 (or (equal 0 x)
+             (not (rationalp x)))))
+
+(defthm sig-integer-rewrite
+  (equal (integerp (sig x))
+         (or (not (rationalp x))
+             (equal 0 x)
+             (equal 1 (sig x))))
+  :hints (("goal" :in-theory (disable sig-x-1-means-power-of-2)))
+  )
+
+(defthm cg-sig
+  (equal (cg (sig x))
+         (if (or (not (rationalp x)) (equal 0 x))
+             0
+           (if (power2p (abs x))
+               1
+             2)))
+  :hints (("goal" :in-theory (enable cg power2p-rewrite)))
+  )
+
+(defthm sig-times-half-not-integer
+  (equal (integerp (* 1/2 (sig x)))
+         (or (equal 0 x)
+             (not (rationalp x))))
+  :hints (("goal" :in-theory (enable sig))))
+
+(defthm cg-half-sig
+  (equal (cg (* 1/2 (sig x)))
+         (if (or (not (rationalp x)) (equal 0 x))
+             0
+           1))
+  :hints (("goal" :in-theory (enable cg))))
+
+; Added for rel5:
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/ground-zero.lisp acl2-6.3/books/rtl/rel9/support/support/ground-zero.lisp
--- acl2-6.2/books/rtl/rel9/support/support/ground-zero.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/ground-zero.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,29 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+;includes changes to the default theory (mostly disabling built-in functions)
+
+(include-book "../../arithmetic/ground-zero")
+(include-book "util")
diff -Nru acl2-6.2/books/rtl/rel9/support/support/guards.lisp acl2-6.3/books/rtl/rel9/support/support/guards.lisp
--- acl2-6.2/books/rtl/rel9/support/support/guards.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/guards.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,128 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; Proof of bits-guard:
+
+; (logand (ash x (- j)) (1- (ash 1 (1+ (- i j)))))
+; =
+; (logand (fl (/ x (expt 2 j))) (1- (expt 2 (1+ (- i j)))))
+; = {logand-slice}
+; (bits (fl (/ x (expt 2 j))) (- i j) 0)
+; = {bits-shift-down-1}
+; (bits x i j)
+
+(include-book "rtl")
+(local (include-book "top1"))
+(local (in-theory (theory 'lib-top1)))
+
+(local-defthmd bits-guard
+  (implies (and (natp x)
+                (natp i)
+                (natp j)
+                (<= j i))
+           (equal (bits x i j)
+                  (logand (ash x (- j)) (1- (ash 1 (1+ (- i j)))))))
+  :hints (("Goal" :in-theory (enable bits-shift-down-1 floor-fl expt-minus)
+           :use ((:instance logand-slice
+                            (x (ash x (- j)))
+                            (n (1+ (- i j)))
+                            (k 0))))))
+
+(verify-guards bits
+               :hints (("Goal" :use bits-guard
+                        :in-theory (enable bits fl-mod-zero))))
+
+; Proof of bitn-guard:
+
+; (bitn x i)
+; = {def. of bitn}
+; (bits x i i)
+; = {previous thm.}
+; (logand (ash x (- i)) (1- (ash 1 (1+ (- i i)))))
+; =
+; (logand (ash x (- i)) 1)
+; = {logand-with-1}
+; (if (evenp (ash x (- i))) 0 1)
+
+(local-defthmd bitn-guard
+  (implies (and (natp x)
+                (natp n))
+           (equal (bitn x n)
+                  (if (evenp (ash x (- n))) 0 1)))
+  :hints (("Goal" :in-theory (e/d (bitn logand-with-1 logand-commutative
+                                        bits-guard)
+                                  (bits-n-n-rewrite)))))
+
+(verify-guards bitn
+               :hints (("Goal" :use bitn-guard
+                        :in-theory (e/d (bitn) (bits-n-n-rewrite)))))
+
+(verify-guards lnot)
+
+(verify-guards binary-cat)
+
+(local-defthm mulcat-guard-proof-hack
+  (implies (and (< 0 l)
+                (integerp l)
+                (not (equal n 1)))
+           (not (equal l (* l n))))
+  :hints (("Goal" :use ((:instance collect-constants-with-division
+                                   (x n)
+                                   (c1 l)
+                                   (c2 l))))))
+
+(verify-guards mulcat)
+
+(verify-guards setbits)
+
+(verify-guards setbitn)
+
+(verify-guards binary-land0)
+
+(verify-guards binary-lior0)
+
+(verify-guards binary-lxor0)
+
+(include-book "land")
+
+(verify-guards binary-land
+               :hints (("Goal" :use land-is-land0
+                        :in-theory (enable binary-land0)
+                        :expand ((binary-land x y n)))))
+
+(include-book "lior")
+
+(verify-guards binary-lior
+               :hints (("Goal" :use lior-is-lior0
+                        :in-theory (enable binary-lior0)
+                        :expand ((binary-lior x y n)))))
+
+(include-book "lxor")
+
+(verify-guards binary-lxor
+               :hints (("Goal" :use lxor-is-lxor0
+                        :in-theory (enable binary-lxor0)
+                        :expand ((binary-lxor x y n)))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/ireps.lisp acl2-6.3/books/rtl/rel9/support/support/ireps.lisp
--- acl2-6.2/books/rtl/rel9/support/support/ireps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/ireps.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,984 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; eric smith, david russinoff, with suggestions by matt kaufmann
+; amd, june 2001 
+
+;this file was previously called irepsproofs.lisp
+
+;note: the proofs in this file are messy.  i haven't taken much time to clean
+;them up by eliminating hacks or increasing elegance. -eric
+
+;todo: add t-p for isigf, etc.
+
+(include-book "rtl") ;BOZO remove!
+(include-book "bias")
+(include-book "float") ;for the defns
+(local (include-book "merge"))
+(local (include-book "cat"))
+(local (include-book "bvecp"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "../../arithmetic/top"))
+
+(local (in-theory (enable bvecp-forward)))
+
+;;encoding of floating-point numbers with implicit msb
+;;bit vectors of length p+q, consisting of 1-bit sign field, 
+;;q-bit exponent field (bias = 2**(q-1)-1), and (p-1)-bit 
+;;significand field:
+;; p must be > 1
+
+
+
+;;;**********************************************************************
+;;;                       field extractors
+;;;**********************************************************************
+
+(defund isgnf  (x p q) (bitn x (1- (+ p q))))
+(defund iexpof (x p q) (bits x (- (+ p q) 2) (1- p)))
+(defund isigf  (x p)   (bits x (- p 2) 0))
+
+
+;;;**********************************************************************
+;;;                       representable numbers
+;;;**********************************************************************
+
+(defund nrepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (< 0 (+ (expo x) (bias q)))
+       (< (+ (expo x) (bias q)) (- (expt 2 q) 1))
+       (exactp x p)))
+
+(defund drepp (x p q)
+  (and (rationalp x)
+       (not (= x 0))
+       (<= (- 2 p) (+ (expo x) (bias q)))
+       (<= (+ (expo x) (bias q)) 0)
+       (exactp x (+ -2 p (expt 2 (- q 1)) (expo x))))) ;use bias here?
+;bits available in the sig field = p-1-(-bias-expo(x))
+
+(defund irepp (x p q)
+  (or (nrepp x p q)
+      (drepp x p q)))
+
+
+;;;**********************************************************************
+;;;                      valid encodings
+;;;**********************************************************************
+
+(defund nencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (< 0 (iexpof x p q))
+       (< (iexpof x p q) (- (expt 2 q) 1))))
+
+(defund dencodingp (x p q)
+  (and (bvecp x (+ p q))
+       (= (iexpof x p q) 0)
+       (not (= (isigf x p) 0))))
+
+(defund iencodingp (x p q)
+  (or (nencodingp x p q)
+      (dencodingp x p q)))
+
+
+;;;**********************************************************************
+;;;                       encode
+;;;**********************************************************************
+
+; sig, expo, and sgn are defined in float.lisp
+
+(defund dencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            0
+            q)
+       (1+ q)
+       (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+       (- p 1)))
+
+(defund nencode (x p q)
+  (cat (cat (if (= (sgn x) 1) 0 1)
+	    1
+            (+ (expo x) (bias q))
+            q)
+       (1+ q)
+       (* (- (sig x) 1) (expt 2 (- p 1)))
+       (- p 1)))
+
+(defund iencode (x p q)
+  (cond ((nrepp x p q)
+	 (nencode x p q))
+	((drepp x p q)
+	 (dencode x p q))))
+
+;;;**********************************************************************
+;;;                       decode
+;;;**********************************************************************
+
+(defund ndecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (+ (expt 2 (- (iexpof x p q) (bias q)))
+        (* (isigf x p)
+           (expt 2 (+ 1 (iexpof x p q) (- (bias q)) (- p)))))))
+
+
+(defund ddecode (x p q)
+  (* (if (= (isgnf x p q) 0) 1 -1)
+     (isigf x p)
+     (expt 2 (+ 2 (- (bias q)) (- p)))))
+
+
+(defund idecode (x p q)
+  (cond ((nencodingp x p q)
+	 (ndecode x p q))
+	((dencodingp x p q)
+	 (ddecode x p q))))
+
+;;;**********************************************************************
+;;;                       theorems
+;;;**********************************************************************
+
+(defthm nencodingp-means-not-dencodingp
+  (implies (nencodingp x p q)
+	   (not (dencodingp x p q)))
+  :rule-classes ((:rewrite :backchain-limit-lst (0)))
+  :hints (("goal" :in-theory (enable iencodingp nencodingp dencodingp))))
+
+(defthm dencodingp-means-not-nencodingp
+  (implies (dencodingp x p q)
+	   (not (nencodingp x p q)))
+  :rule-classes ((:rewrite :backchain-limit-lst (0)))
+  :hints (("goal" :in-theory (enable iencodingp nencodingp dencodingp))))
+
+(defthm not-both-nencodingp-and-dencodingp
+  (implies (iencodingp x p q)
+	   (iff (nencodingp x p q) (not (dencodingp x p q))))
+  :hints (("Goal" :in-theory (enable iencodingp)))
+  :rule-classes ())
+
+
+
+; the field extractors return bit-vectors.
+
+
+;some of the rules below may be bad because they are put into both the
+; forward-chaining and type-prescription rule classes, causing them
+; not to always work. 
+
+;!! rc
+(defthm bvecp-isigf-forward-3
+  (implies (case-split (integerp p))
+           (bvecp (isigf x p) (- p 1)))
+  :hints (("goal" :in-theory (enable isigf)))
+  :rule-classes (:rewrite
+                 (:forward-chaining :trigger-terms ((isigf x p)))
+                 ))
+
+(defthm iexpof-bvecp
+  (implies (case-split (integerp q))
+           (bvecp (iexpof x p q) q))
+  :hints (("goal" :in-theory (enable iexpof))))
+
+(defthm isgnf-bvecp
+  (bvecp (isgnf x p q) 1)
+  :hints (("goal" :in-theory (enable isgnf))))
+
+;forward-chaining-rules for encoding types
+
+(defthm nencodingp-forward-to-iencodingp
+  (implies (nencodingp x p q)
+           (iencodingp x p q) )
+  :hints (("goal" :in-theory (enable iencodingp nencodingp)))
+  :rule-classes (:rewrite :forward-chaining)
+  )
+
+(defthm dencodingp-forward-to-iencodingp
+  (implies (dencodingp x p q)
+           (iencodingp x p q) )
+  :hints (("goal" :in-theory (enable iencodingp dencodingp)))
+  :rule-classes (:rewrite :forward-chaining)
+  )
+
+;needed? t-p?
+(defthm not-zero-ddecode
+  (implies (and (dencodingp x p q)
+                (integerp p)
+                (< 1 p)
+                (integerp q)
+                (< 0 q))
+           (not (equal (ddecode x p q) 0)))
+  :hints (("goal" :in-theory (enable ddecode dencodingp))))
+
+(defthm not-zero-ndecode
+  (implies (and ;(nencodingp x p q)
+                (rationalp x)
+                (>= x 0)
+                (integerp p)
+                (< 1 p)
+                (integerp q)
+                (< 0 q))
+           (not (equal (ndecode x p q) 0)))
+  :hints (("goal" :in-theory (enable ndecode nencodingp))))
+
+;move
+;BOZO make a negative-syntaxp version
+;or just enable sgn?
+(defthm sgn-minus-dist
+  (implies (and (acl2-numberp x)
+                (acl2-numberp y))
+           (equal (sgn (+ (* -1 x) (* -1 y)))
+                  (* -1 (sgn (+ x y)))))
+  :hints (("Goal" :in-theory (disable sgn-minus)
+          :use (:instance sgn-minus (x (* -1 (+ x y)))))))
+
+(defthm expo-ndecode
+  (implies (and (nencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))  
+           (equal (expo (ndecode x p q))
+                  (- (iexpof x p q) (bias q))))
+  :hints (("goal" :in-theory (e/d (ndecode nencodingp 
+                                           expt-split
+                                           expt-minus
+                                           isigf
+                                           )
+                                  ()))))
+
+(defthm sgn-ndecode
+  (implies (and ; (nencodingp x p q)
+            (rationalp x)
+            (>= x 0)
+            (integerp p)
+            (> p 1)
+            (integerp q)
+            (> q 0))
+           (equal (sgn (ndecode x p q))
+                  (if (= (isgnf x p q) 0) 1 -1)))
+  :hints (("goal" :in-theory (enable ndecode sgn))))
+
+;remove from :rewrite?
+(defthm nencodingp-forward-to-positive-integerp
+  (implies (nencodingp x p q)
+           (and (integerp x)
+                (<= 0 x)))
+  :hints (("Goal" :in-theory (enable nencodingp)))
+  :rule-classes (:forward-chaining))
+
+(defthm dencodingp-forward-to-positive-integerp
+  (implies (dencodingp x p q)
+           (and (integerp x)
+                (<= 0 x)))
+  :hints (("Goal" :in-theory (enable dencodingp)))
+  :rule-classes (:forward-chaining))
+
+;BOZO do we even need this?
+(defthmd ndecode-rewrite
+  (implies (and (rationalp x)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (= (ndecode x p q)
+              (* (if (= (isgnf x p q) 0) 1 -1)
+                 (* (expt 2 (- (iexpof x p q) (bias q)))
+                    (+ 1 (* (isigf x p)
+                            (expt 2 (+ 1 (- p)))))))))
+  :hints (("Goal" :in-theory (enable ndecode))))
+
+(defthm isigf-upper-bound-linear
+  (implies (case-split (integerp p))
+           (< (isigf x p) (expt 2 (- p 1) )))
+  :rule-classes (:rewrite :linear))
+
+(defthm sig-ndecode
+  (implies (and (nencodingp x p q) ;gen?
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (sig (ndecode x p q))
+                  (+ 1 (/ (isigf x p) (expt 2 (- p 1))))
+                  ))
+  :otf-flg t
+  :hints (("goal" :use (:instance expo-unique (x (+ 1
+                                                    (* 2 (/ (EXPT 2 P))
+                                                       (BITS X (+ -2 P) 0))))
+                                  (n 0))
+           :in-theory (set-difference-theories
+                       (enable ndecode
+                               expt-split
+                               expt-minus
+                               isigf iexpof ; isgnf
+                               sig
+;                                       nencodingp
+                               )
+                       '( EXPO-UNIQUE-ERIC-2)))))
+
+;instead, just open up sgn?
+(defthm sgn-ddecode
+  (implies (and (dencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (sgn (ddecode x p q))
+                  (if (= (isgnf x p q) 0) 1 -1)))
+  :hints (("Goal" :in-theory (e/d (ddecode dencodingp sgn) ()))))
+
+(defthm sig-ddecode
+  (implies (and (dencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (sig (ddecode x p q))
+                  (sig (isigf x p))))
+  :hints (("Goal" :in-theory (e/d ( ddecode sgn ) ()))))
+
+(defthm expo-ddecode
+  (implies (and (dencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (expo (ddecode x p q))
+                  (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))
+  :hints (("Goal" :in-theory (enable ddecode dencodingp ))))
+
+(defthm sgn-idecode
+  (implies (and (iencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (sgn (idecode x p q))
+                  (if (= (isgnf x p q) 0) 1 -1)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable idecode iencodingp ISGNF NDECODE)
+                              '()))))
+
+(defthm sig-idecode
+  (implies (and (iencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (sig (idecode x p q))
+                  (cond ((nencodingp x p q)
+                         (+ 1 (/ (isigf x p) (expt 2 (- p 1)))))
+                        ((dencodingp x p q)
+                         (sig (isigf x p))))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable idecode iencodingp)
+                              '()))))
+
+(defthm expo-idecode
+  (implies (and (iencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (expo (idecode x p q))
+                  (cond ((nencodingp x p q)
+                         (- (iexpof x p q) (bias q)))         
+                        ((dencodingp x p q)
+                         (+ 2 (- p) (- (bias q)) (expo (isigf x p)))))))         
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable idecode iencodingp)
+                              '()))))
+
+
+;move?
+(defthm expo-bvecp-upper-bound
+  (implies (and (bvecp x n)
+                (integerp n)
+                (< 0 n))
+           (< (expo x) n))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use ((:instance expo<= ( n (- n 1))))))
+  :rule-classes (:rewrite (:linear :match-free :all)))
+
+(local (in-theory (disable bvecp-exactp))) ;why? efficiency?
+
+;nice lemma?
+(local
+ (defthm drepp-decode-1
+  (IMPLIES (AND (DENCODINGP X P Q)
+                (INTEGERP P)
+                (< 1 P)
+                (INTEGERP Q)
+                (< 0 Q))
+           (EXACTP (DDECODE X P Q)
+                   (+ (* -1 (BIAS Q))
+                      (EXPT 2 (1- Q))
+                      (EXPO (ISIGF X P)))))
+  :hints (("Goal" :in-theory (enable ddecode dencodingp bias)))))     
+
+(defthm drepp-ddecode
+  (implies (and (dencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (drepp (ddecode x p q) p q))
+  :hints (("Goal" :use drepp-decode-1
+           :in-theory (set-difference-theories
+                       (enable drepp)
+                       '(drepp-decode-1)))))
+
+;BOZO yuck. better expo-shift rules would help here..
+(defthm nrepp-ndecode-hack
+  (implies (and (nencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (exactp (ndecode x p q) p))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable nrepp nencodingp ndecode exactp
+                                      a15
+                                      ndecode-rewrite
+;expt-split
+                                      )
+                              '(a9 distributivity
+                                   )))
+          (and stable-under-simplificationp ;yuck?
+               '(:in-theory (enable a9 distributivity a15)))))
+
+
+#|
+
+(defthm nrepp-ndecode-hack
+  (implies (and (nencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (exactp (ndecode x p q) p))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable nrepp nencodingp ndecode exactp
+                                      a15
+                                      ndecode-rewrite
+                                      expt-split
+                                      expt-minus
+                                      sig
+                                      isigf
+                                      isgnf
+                                      iexpof
+                                      )
+                              '(;a9 distributivity
+                                a15
+                                   )))
+          (and stable-under-simplificationp ;yuck?
+               '(:in-theory (enable a9 distributivity a15)))))
+|#
+
+
+
+
+(defthm nrepp-ndecode
+  (implies (and (nencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (nrepp (ndecode x p q) p q))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable nrepp nencodingp)
+                              '()))))
+
+(defthm irepp-idecode
+  (implies (and (iencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (irepp (idecode x p q) p q))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable idecode irepp iencodingp)
+                              '()))))
+
+
+(local
+ (defthm nencodingp-nencode-2-1
+   (IMPLIES (AND (RATIONALP X)
+                 (NOT (EQUAL X 0))
+                 (EXACTP X P)
+                 (INTEGERP P)
+                 (<= 1 P)
+                 )
+            (integerp (+ (* -1 (EXPT 2 (1- P)))
+                         (* (SIG X) (EXPT 2 (1- P))))
+                      ))
+   :hints (("Goal" :in-theory (enable exactp)
+            :use ( sig-lower-bound)))))
+
+(local 
+ (defthm nencodingp-nencode-2
+   (IMPLIES (AND (NREPP X P Q)
+                 (INTEGERP P)
+                 (< 1 P)
+                 (INTEGERP Q)
+                 (< 0 Q))
+            (<= 0 (NENCODE X P Q)))
+ :hints (("Goal"  :in-theory (enable nencode nrepp)))))
+
+(local
+ (defthm nencodingp-nencode-3
+   (IMPLIES (AND (NREPP X P Q)
+                 (INTEGERP P)
+                 (< 1 P)
+                 (INTEGERP Q)
+                 (< 0 Q))
+            (< (NENCODE X P Q) (EXPT 2 (+ P Q))))
+   :hints (("Goal" :in-theory (enable nencode)))))
+
+
+(local
+ (defthm nencodingp-nencode-4
+   (IMPLIES (AND (NREPP X P Q)
+                 (INTEGERP P)
+                 (< 1 P)
+                 (INTEGERP Q)
+                 (< 0 Q))
+            (< 0 (IEXPOF (NENCODE X P Q) P Q)))
+   :hints (("Goal"  :in-theory (e/d ( nencode 
+                                      iexpof 
+                                      bvecp
+                                      nrepp
+                                      bits-tail) (sig-lower-bound sig-upper-bound))
+            :use (sig-upper-bound sig-lower-bound)))))
+
+
+(local
+ (defthm nencodingp-nencode-5
+   (IMPLIES (AND (NREPP X P Q)
+                 (INTEGERP P)
+                 (< 1 P)
+                 (INTEGERP Q)
+                 (< 0 Q))
+            (< (IEXPOF (NENCODE X P Q) P Q)
+               (1- (EXPT 2 Q))))
+   :hints (("Goal"  :in-theory (e/d (nrepp nencode iexpof bvecp
+                                       bits-tail) (sig-lower-bound sig-upper-bound))
+            :use (sig-upper-bound sig-lower-bound)))))
+
+(defthm nencodingp-nencode
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (nencodingp (nencode x p q) p q) )
+  :hints (("Goal" :in-theory (enable nencodingp bvecp)))
+  :OTF-FLG T)
+
+(local
+ (defthm dencodingp-dencode-hack-3
+   (implies (and (drepp x p q)
+                 (integerp p)
+                 (> p 1)
+                 (integerp q)
+                 (> q 0))
+            (equal (* (SIG X)
+                      (EXPT 2 (+ -3 P (EXPO X) (EXPT 2 (1- Q)))))
+                   (* (abs x) (EXPT 2 (+ -3 P (EXPT 2 (1- Q)))))))
+   :hints (("Goal" :in-theory (set-difference-theories
+                               (enable drepp sgn)
+                               '(fp-rep-collapse abs))
+            :use fp-abs))
+   :rule-classes nil))
+
+
+(local (in-theory (disable expt-compare))) ;yuck
+
+(local 
+ (defthmd dencodingp-dencode-hack-4
+   (implies (and (drepp x p q)
+                 (integerp p)
+                 (> p 1)
+                 (integerp q)
+                 (> q 0))
+            (bvecp (* (SIG X)
+                      (EXPT 2 (+ -3 P (EXPO X) (EXPT 2 (1- Q)))))
+                   (- p 1)))
+           
+   :hints (("Goal" :in-theory (set-difference-theories (enable dencodingp drepp dencode
+                                                               iexpof isigf bias exactp
+                                                               expt-split
+                                                               bvecp)
+                                                       '(abs EXPT-COMPARE sig-upper-bound))
+            :use (dencodingp-dencode-hack-3
+                  sig-upper-bound 
+                  (:instance expt-weak-monotone
+                             (n (+ -3 P (EXPO X) (EXPT 2 (1- Q))))
+                             (m (- p 2))))))))
+
+(defthm dencodingp-dencode
+  (implies (and (drepp x p q)
+                (integerp p)
+;                (> p 1)
+                (integerp q)
+                (> q 0)
+                )
+           (dencodingp (dencode x p q) p q) )
+  :hints (("Goal" :in-theory (e/d (exactp 
+                                     dencodingp 
+                                     drepp 
+                                     dencode
+                                     iexpof 
+                                     isigf 
+                                     bias
+                                     bits-tail
+                                     
+                                     bvecp
+                                     bvecp-bits-0
+                                     )
+                                  (sig-upper-bound
+                                   BITS-SHIFT
+                                   BITS-SPLIT-AROUND-ZERO))
+           :use (sig-upper-bound 
+                 sig-lower-bound 
+                 dencodingp-dencode-hack-4
+                 (:instance expt-strong-monotone
+                            (n (- p 1))
+                            (m (+ p q)))
+                 (:instance expt-strong-monotone
+                            (n (- p 1))
+                            (m (+ p q -1)))))))
+
+(defthm drepp-forward-to-rationalp
+  (implies (drepp x p q)
+           (rationalp x))
+  :hints (("Goal" :in-theory (enable drepp)))
+  :rule-classes ((:forward-chaining :trigger-terms ((drepp x p q)))))
+
+(defthm drepp-zero-false
+  (not (drepp 0 p q))
+  :hints (("Goal" :in-theory (enable drepp))))
+
+(defthm iencodingp-iencode
+  (implies (and (irepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (iencodingp (iencode x p q) p q) )
+  :hints (("Goal" :in-theory (enable iencodingp irepp iencode))))
+
+;prove a thm about bvecp of sig-1?
+(defthm isigf-nencode-0
+  (implies (and (rationalp x)
+                (not (equal x 0))
+                (exactp x p)
+                (integerp p)
+                (< 1 p)
+                )
+           (bvecp (+ (* -1 (expt 2 (1- p)))
+                     (* (sig x) (expt 2 (1- p))))
+                  (- p 1)))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable bvecp)
+                              '(nencodingp-nencode-2-1 
+                                sig-upper-bound))
+           :use (sig-lower-bound sig-upper-bound nencodingp-nencode-2-1)))
+  :rule-classes nil)
+
+(defthm isgnf-nencode
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (isgnf (nencode x p q) p q)
+                  (if (equal (sgn x) 1) 0 1)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable isgnf nencode nrepp bvecp)
+                              '(nencodingp-nencode-2-1 
+                                bitn-bvecp-0 
+                                sig-upper-bound
+                                                        ))
+           :use (nencodingp-nencode-2-1
+                 sig-lower-bound
+                 sig-upper-bound
+                 (:instance bitn-bvecp-0 (m 0)
+                            (x (+ (BIAS Q) (EXPO X)))
+                            (n q))))))
+
+(defthm isgnf-dencode
+  (implies (and (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (isgnf (dencode x p q) p q)
+                  (if (= (sgn x) 1) 0 1)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable isgnf dencode drepp bvecp bias)
+                              '(nencodingp-nencode-2-1 bitn-bvecp-0))
+           :use (dencodingp-dencode-hack-4 
+                 (:instance expt-strong-monotone
+                            (n (- p 1))
+                            (m (+ p q -1)))
+                 (:instance bitn-bvecp-0 
+                            (m q)
+                            (x (* (SIG X)
+                                  (EXPT 2 (+ -3 P (EXPO X) (EXPT 2 (1- Q))))))
+                            (n (- p 1)))))))
+
+(defthm isgnf-iencode
+  (implies (and (irepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (isgnf (iencode x p q) p q)
+                  (if (equal (sgn x) 1) 0 1)))
+  
+  :hints (("Goal" :in-theory (enable irepp iencode))))
+  
+(defthm isigf-nencode-1
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (bvecp (+ (* -2 (EXPT 2 (+ -2 P)))
+                     (* 2 (SIG X) (EXPT 2 (+ -2 P)))) (- p 1)   ))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable isigf nencode nrepp bvecp expt-split)
+                              '())
+           :use isigf-nencode-0))
+  :rule-classes nil)
+
+(defthm isigf-nencode
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (isigf (nencode x p q) p)
+                  (* (- (sig x) 1) (expt 2 (- p 1)))))
+  :hints (("Goal" :in-theory (e/d (isigf nencode nrepp expt-split bvecp bias bits-tail)
+                                  (bits-shift
+                                   BITS-SUM-DROP-IRRELEVANT-TERM-1-OF-2
+                                   BITS-SHIFT-BY-CONSTANT-POWER-OF-2))
+           :use (isigf-nencode-1
+                 ))))
+
+(defthm isigf-dencode
+  (implies (and (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (isigf (dencode x p q) p)
+                  (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))))
+  
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable isigf dencode drepp bias bits-tail lead-bit-0)
+                              '(BITS-SHIFT))
+           :use dencodingp-dencode-hack-4)))
+
+(defthm iexpof-nencode
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (iexpof (nencode x p q) p q)
+                  (+ (expo x) (bias q))))
+  :hints (("Goal" :in-theory (enable iexpof nencode nrepp bvecp
+                                     bits-tail)  
+           :use (isigf-nencode-1))))
+
+(defthm iexpof-dencode
+  (implies (and (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (iexpof (dencode x p q) p q)
+                  0))
+  :otf-flg t
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable iexpof dencode drepp bias
+                                      bvecp-bits-0
+                                      )
+                              '())
+           :use (dencodingp-dencode-hack-4))))
+
+(defthm ndecode-nencode
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (ndecode (nencode x p q) p q)
+                  x))
+  :hints (("Goal" :in-theory (enable nrepp ndecode sgn expt-split expt-minus))))
+
+(defthm ddecode-dencode
+  (implies (and (drepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (ddecode (dencode x p q) p q)
+                  x))
+  :hints (("Goal" :in-theory (enable drepp ddecode sgn expt-split expt-minus))))
+
+(defthm not-both-nrepp-and-drepp
+  (implies (irepp x p q)
+	   (iff (nrepp x p q)
+		(not (drepp x p q))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable irepp nrepp drepp))))
+
+(defthm idecode-iencode
+  (implies (and (irepp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal
+            (idecode (iencode x p q) p q)
+            x))
+  :hints (("Goal" :in-theory (enable irepp idecode iencode idecode)
+		  :use (dencodingp-dencode
+			not-both-nrepp-and-drepp))))
+
+(defthm nencode-ndecode
+  (implies (and (nencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (nencode (ndecode x p q) p q)
+                  x))
+  :hints (("Goal" :in-theory (set-difference-theories
+			      (enable nencodingp nencode iexpof isigf isgnf sgn
+				      cat lead-bit-0
+				      expt-split
+				      bits-reduce ;why?
+				      )
+; Modification by Matt K. for v2-9, due to the change to rewrite-clause that
+; avoids using forward-chaining facts derived from a literal that has been
+; rewritten: use sgn-ndecode explicitly (see :use hint below) and hence disable
+; it here.
+
+			      '(sgn-ndecode))
+           :use (sgn-ndecode
+                 (:instance bits-plus-bits
+                            (m 0)
+                            (p (- p 1))
+                            (n (+ -2 p q)))
+                 (:instance bitn-plus-bits
+                            (n (+ p q -1))
+                            (m 0))
+                 (:instance bitn-0-1 (x x) (n (+ -1 p q)))))))
+
+(defthm dencode-ddecode
+  (implies (and (dencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (dencode (ddecode x p q) p q)
+                  x))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable dencodingp dencode iexpof isigf isgnf sgn
+                                      cat lead-bit-0 expt-split expt-minus)
+                              '())
+           :use ((:instance bits-plus-bits
+                            (m 0)
+                            (p (- p 1))
+                            (n (+ -2 p q)))
+                 (:instance fp-rep (x (BITS X (+ -2 P) 0)))
+                 (:instance bitn-plus-bits
+                            (n (+ p q -1))
+                            (m 0))
+                 (:instance bitn-0-1 (x x) (n (+ -1 p q)))
+                 ))))
+
+(defthm iencode-idecode
+  (implies (and (iencodingp x p q)
+                (integerp p)
+                (> p 1)
+                (integerp q)
+                (> q 0))
+           (equal (iencode (idecode x p q) p q)
+                  x))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable irepp idecode iencode idecode IENCODINGP)
+                              '())
+		  :use (
+			(:instance not-both-nrepp-and-drepp (x (ddecode x p q)))))))
+
+(defthm nrepp-bvecp-sig
+  (implies (and (natp p)
+                (> p 0)
+                (nrepp x p q))
+           (bvecp (* (1- (sig x)) (expt 2 (1- p)))
+                  (1- p)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (nrepp exactp bvecp) ()))))
+
+; Matt K., after v4-2:
+; Commenting out the following rule, which rewrites a term to itself!
+#||
+(defthm nencode-nencode
+  (implies (and (nrepp x p q)
+                (integerp p)
+                (> p 0)
+                (integerp q)
+                (> q 0))
+           (equal (nencode x p q) (nencode x p q)))
+  :hints (("Goal" :use (nrepp-bvecp-sig)
+		  :in-theory (enable nencode nencode bits-tail nrepp bvecp))))
+||#
+
+(defthm drepp-bvecp-sig
+    (implies (and (integerp p)
+		  (natp q)
+		  (> q 0)
+		  (drepp x p q))
+	     (bvecp (* (sig x) (expt 2 (+ -2 p (expo x) (bias q))))
+		    (1- p)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bias drepp exactp bvecp expt-split) (sig-upper-bound
+                                                                        ))
+		  :use (;sig-lower-bound
+			sig-upper-bound
+			(:instance expt-weak-monotone (n (+ -3 P (EXPO X) (EXPT 2 (+ -1 Q)))) (m (- p 2)))))))
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/land.lisp acl2-6.3/books/rtl/rel9/support/support/land.lisp
--- acl2-6.2/books/rtl/rel9/support/support/land.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/land.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,628 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Port land0 theorems to land.  The original definition of land (in rel4) was
+; that of land0 in the current release.  So the port is to keep all the lemmas
+; about land0 and then use equality of land0 with land to port them to land.
+
+(in-package "ACL2")
+
+(include-book "land0")
+(local (include-book "top1")) ; for land0-bits-1 and land0-bits-2
+
+(defun binary-land (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (and (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-land (mod x 2) (mod y 2) 1))))
+       :exec ; (land0 x y n)
+       (logand (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro land (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land x y n) -- the base case
+         `(binary-land ,@x))
+        (t         
+         `(binary-land ,(car x)
+                       (land ,@(cdr x))
+                       ,(car (last x))))))
+
+; We attempt to derive all land results from corresponding land0 results.
+
+(encapsulate
+ ()
+
+ (local
+  (defun p0 (x y n)
+    (equal (land x y n)
+           (land0 x y n))))
+
+ (local
+  (defthm p0-holds-inductive-step
+    (implies (and (not (zp n))
+                  (not (equal n 1))
+                  (p0 (fl (* x 1/2))
+                      (fl (* y 1/2))
+                      (+ -1 n))
+                  (p0 (mod x 2) (mod y 2) 1))
+             (p0 x y n))
+    :hints (("Goal" :use (land0-def binary-land)))))
+
+ (local
+  (defthm p0-holds-base-1
+    (p0 x y 1)
+    :hints (("Goal" :in-theory (enable bitn)
+             :expand ((binary-land0 x y 1))))))
+
+ (local
+  (defthm p0-holds-base-0
+    (implies (zp n)
+             (p0 x y n))
+    :hints (("Goal" :expand ((binary-land0 x y n))))))
+
+ (local
+  (defthm p0-holds
+    (p0 x y n)
+    :hints (("Goal" :induct (land x y n)
+             :in-theory (disable p0)))
+    :rule-classes nil))
+
+ (defthmd land-is-land0
+   (equal (land x y n)
+          (land0 x y n))
+   :hints (("Goal" :use p0-holds))))
+
+(local (in-theory (e/d (land-is-land0) (binary-land))))
+
+;Allows things like (in-theory (disable land)) to refer to binary-land.
+(add-macro-alias land binary-land)
+
+(defthm land-nonnegative-integer-type
+  (and (integerp (land x y n))
+       (<= 0 (land x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land) is no better than land-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land-natp
+  (natp (land x y n)))
+
+;BOZO split into 2 rules?
+(defthm land-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (land x y n)
+                  0)))
+
+(defthmd land-bvecp-simple
+  (bvecp (land x y n) n)
+  :hints (("Goal" :use land0-bvecp-simple)))
+
+(defthm land-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land x y n) k)))
+
+
+;;
+;; Rules to normalize land terms (recall that LAND is a macro for BINARY-LAND):
+;;
+
+;This guarantees that the n parameters to nested LAND calls match.
+;Note the MIN in the conclusion.
+;BOZO do we expect MIN to be enabled?  Maybe we should use IF instead for this and other rules?
+(defthm land-nest-tighten
+  (implies (and (syntaxp (not (equal m n)))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (land x (land y z m) n)
+                  (land x (land y z (min m n)) (min m n)))))
+
+; allow the n's to differ on this?
+(defthm land-associative
+  (equal (land (land x y n) z n)
+         (land x (land y z n) n)))
+
+(defthm land-commutative
+  (equal (land y x n)
+         (land x y n)))
+
+; allow the n's to differ on this?
+(defthm land-commutative-2
+  (equal (land y (land x z n) n)
+         (land x (land y z n) n)))
+
+; allow the n's to differ on this?
+(defthm land-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (land x (land y z n) n)
+                  (land (land x y n) z n))))
+
+(defthm land-0
+  (equal (land 0 y n)
+         0))
+
+;nicer than the analogous rule for logand? is it really?
+;BOZO gen the second 1 in the lhs?
+(defthm land-1
+  (equal (land 1 y 1)
+         (bitn y 0)))
+
+(defthm land-self
+  (equal (land x x n)
+         (bits x (1- n) 0)))
+
+;perhaps use only the main rule, bits-land?
+(defthmd bits-land-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (land x y n) i j)
+                  (land (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j)))))
+  :hints (("Goal" :use bits-land0-1)))
+
+;perhaps use only the main rule, bits-land?
+(defthmd bits-land-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (land x y n) i j)
+                  (land (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j)))))
+  :hints (("Goal" :use bits-land0-2)))
+
+;Notice the call to MIN in the conclusion.
+(defthm bits-land
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (land x y n) i j)
+                  (land (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j))))))
+
+(defthmd bitn-land-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land x y n) m)
+                  (land (bitn x m) 
+                        (bitn y m) 
+                        1))))
+(defthmd bitn-land-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land x y n) m)
+                  0)))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-land
+  (implies (and (case-split (<= 0 k))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land x y n) k)
+                  (if (< k n)
+                      (land (bitn x k)
+                            (bitn y k) 
+                            1)
+                    0))))
+
+;BOZO see land-equal-0
+;drop bvecp hyps and put bitn in conclusion?
+(defthm land-of-single-bits-equal-0
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 0 (land x y 1))
+                  (or (equal x 0)
+                      (equal y 0)))))
+
+(defthm land-of-single-bits-equal-1
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 1 (land x y 1))
+                  (and (equal x 1)
+                       (equal y 1)))))
+
+(defthm land-ones
+  (equal (land (1- (expt 2 n)) x n)
+         (bits x (1- n) 0))
+  :hints (("Goal" :use land0-ones))
+  :rule-classes ())
+
+;land-with-all-ones will rewrite (land x n) [note there's only one value being ANDed], because (land x n)
+;expands to (BINARY-LAND X (ALL-ONES N) N) - now moot???
+;BOZO drop bvecp hyp and move to conclusion?
+(defthm land-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (land (all-ones n) x n)
+                  x)))
+
+(defthmd land-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+                (equal k (1- (expt 2 n))) ;this computes on constants...
+                )
+           (equal (land k x n)
+                  (bits x (1- n) 0)))
+  :hints (("Goal" :use land0-ones-rewrite)))
+
+(defthm land-def-original
+  (implies (and (integerp x)
+                (integerp y)
+                (> n 0)
+                (integerp n)
+                )
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (mod x 2) (mod y 2) 1))))
+  :hints (("Goal" :use land0-def))
+  :rule-classes ())
+
+(defthmd land-mod-2
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (> n 0))
+           (equal (mod (land x y n) 2)
+                  (land (mod x 2) (mod y 2) 1)))
+  :hints (("Goal" :use land0-mod-2)))
+
+;BOZO RHS isn't simplified...
+(defthmd land-fl-2
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (> n 0))
+           (equal (fl (/ (land x y n) 2))
+                  (land (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+  :hints (("Goal" :use land0-fl-2)))
+
+;BOZO rename to land-with-n-0
+;what if n is negative? or not an integer?
+(defthm land-x-y-0
+  (equal (land x y 0) 0))
+
+;actually, maybe only either x or y must be a bvecp of length n
+;n is a free var
+(defthm land-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land x y m)
+                    (land x y n))))
+
+;deceptive name; this only works for single bits!
+(defthm land-equal-0
+  (implies (and (bvecp i 1)
+                (bvecp j 1))
+           (equal (equal 0 (land i j 1))
+                  (or (equal i 0)
+                      (equal j 0)))))
+
+;make alt version?
+(defthm land-bnd
+  (implies (case-split (<= 0 x))
+           (<= (land x y n) x))
+  :rule-classes (:rewrite :linear))
+
+;enable? make an alt version??
+(defthmd land-ignores-bits
+  (equal (land (bits x (1- n) 0) y n)
+         (land x y n))
+  :hints (("Goal" :use land0-ignores-bits)))
+
+(defthmd land-with-shifted-arg
+  (implies (and (integerp x) ;gen?
+                (rationalp y)
+                (integerp m)
+                (integerp n)
+                (<= 0 m)
+                )
+           (equal (land (* (expt 2 m) x) y n)
+                  (* (expt 2 m) (land x (bits y (1- n) m) (+ n (- m))))))
+  :hints (("Goal" :use land0-with-shifted-arg)))
+
+(defthm land-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (land (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (land x y (- n k)))))
+  :hints (("Goal" :use land0-shift))
+  :rule-classes nil)
+
+(defthmd land-expt
+  (implies (and (natp n)
+                (natp k)
+                (< k n))
+           (equal (land x (expt 2 k) n)
+                  (* (expt 2 k) (bitn x k))))
+  :hints (("Goal" :use land0-expt)))
+
+(defthm land-slice
+  (implies (and (<= j i) ;drop? or not?
+                (<= i n)
+                (integerp n)
+                (integerp i)
+                (integerp j)
+                (<= 0 j)
+                )
+           (equal (land x (- (expt 2 i) (expt 2 j)) n)
+                  (* (expt 2 j) (bits x (1- i) j))))
+  :hints (("Goal" :use land0-slice))
+  :rule-classes ())
+
+(defthmd land-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land (- (expt 2 n) (1+ (expt 2 l)))
+                        (- (expt 2 n) (expt 2 k))
+                        n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k)))))
+  :hints (("Goal" :use land0-slices)))
+
+(defthm land-upper-bound
+  (implies (and (integerp n)
+                (<= 0 n))
+           (< (land x y n) (expt 2 n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm land-upper-bound-tight
+  (implies (and (integerp n)
+                (<= 0 n))
+           (<= (land x y n) (1- (expt 2 n)))))
+
+(defthm land-fl-1
+  (equal (land (fl x) y n)
+         (land x y n)))
+
+(defthm land-fl-2-eric ;BOZO name conflicted...
+  (equal (land x (fl y) n)
+         (land x y n)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Added in move to rel5 (should perhaps be in a -proofs file):
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defthm land-bvecp-2
+  (implies (and (bvecp x m)
+                (bvecp y m))
+           (bvecp (land x y n) m))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+; Start proof of fl-land.
+
+(local
+ (defun fl-land-induction (k n)
+   (if (zp k)
+       n
+     (fl-land-induction (1- k) (1+ n)))))
+
+
+(local
+ (defthmd fl-land-induction-step-1
+   (implies (not (zp k))
+            (equal (land (fl (* x (/ (expt 2 k))))
+                         (fl (* y (/ (expt 2 k))))
+                         n)
+                   (land (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
+                         (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
+                         n)))
+   :hints (("Goal" :in-theory (disable land-fl-1
+                                       land-fl-2-eric
+                                       land-is-land0
+                                       fl/int-rewrite)
+            :expand ((expt 2 k))
+            :use ((:instance fl/int-rewrite
+                             (x (* x (/ (expt 2 (1- k)))))
+                             (n 2))
+                  (:instance fl/int-rewrite
+                             (x (* y (/ (expt 2 (1- k)))))
+                             (n 2)))))))
+
+(local
+ (defthmd fl-land-induction-step-2
+   (equal (land (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
+                (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
+                n)
+          (fl (/ (land (fl (* x (/ (expt 2 (1- k)))))
+                       (fl (* y (/ (expt 2 (1- k)))))
+                       (1+ n))
+                 2)))
+   :hints (("Goal" :in-theory (disable land-fl-1
+                                       land-fl-2-eric
+                                       land-is-land0
+                                       fl/int-rewrite)
+            :expand ((land (fl (* x (/ (expt 2 (1- k)))))
+                           (fl (* y (/ (expt 2 (1- k)))))
+                           (1+ n)))))))
+
+(local
+ (defthmd fl-land-induction-step-3
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (land x y (+ k n))))
+                        (land (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (/ (land (fl (* x (/ (expt 2 (1- k)))))
+                                (fl (* y (/ (expt 2 (1- k)))))
+                                (1+ n))
+                          2))
+                   (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
+                                 (land x y (+ k n))))
+                          2))))))
+
+(local
+ (defthmd fl-land-induction-step-4
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (land x y (+ k n))))
+                        (land (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
+                                 (land x y (+ k n))))
+                          2))
+                   (fl (* (/ (expt 2 k))
+                          (land x y (+ k n))))))
+   :hints (("Goal" :expand ((expt 2 k))))))
+
+(local
+ (defthm fl-land-induction-step
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (land x y (+ k n))))
+                        (land (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (* (/ (expt 2 k))
+                          (land x y (+ k n))))
+                   (land (fl (* x (/ (expt 2 k))))
+                         (fl (* y (/ (expt 2 k))))
+                         n)))
+   :hints (("Goal" :use (fl-land-induction-step-1
+                         fl-land-induction-step-2
+                         fl-land-induction-step-3
+                         fl-land-induction-step-4)))))
+
+(defthmd fl-land
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (land x y (+ n k)) (expt 2 k)))
+                  (land (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :induct (fl-land-induction k n)
+           :in-theory (disable land-is-land0 land-fl-1 land-fl-2-eric))))
+
+
+(defthmd land-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (land x y n)
+                  (+ (* 2 (land (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land (bitn x 0) (bitn y 0) 1))))
+  :hints (("Goal" :in-theory (enable bitn-rec-0)
+           :use land-def-original)))
+
+; Proof of mod-land as derived from bits-land:
+
+; (land x y k)))
+; = {by land-bvecp and bits-tail}
+; (bits (land x y k) (1- k) 0)
+; = {by (:instance bits-land (x x) (y y) (n k) (i (1- k)) (j 0))}
+; (land (bits x (1- k) 0) (bits y (1- k) 0) k)
+; = {by (:instance bits-land (x x) (y y) (n n) (i (1- k)) (j 0))}
+; (bits (land x y n) (1- k) 0)
+; = {by hypothesis}
+; (bits (land x y n) (min (1- n) (1- k)) 0)
+; = {by (:instance mod-bits (x (land x y n)) (i (1- n)) (j k))}
+; (mod (bits (land x y n) (1- n) 0) (expt 2 k))
+; = {by land-bvecp}
+; (mod (land x y n) (expt 2 k))
+
+(defthmd mod-land
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (land x y n) (expt 2 k))
+                  (land x y k)))
+  :hints (("Goal"
+           :use
+           ((:instance bits-land (x x) (y y) (n k) (i (1- k)) (j 0))
+            (:instance mod-bits (x (land x y n)) (i (1- n)) (j k))))))
+
+(defthmd land-bits-1
+  (equal (land (bits x (1- n) 0)
+               y
+               n)
+         (land x y n))
+  :hints (("Goal" :use land0-bits-1)))
+
+(defthmd land-bits-2
+  (equal (land x
+               (bits y (1- n) 0)
+               n)
+         (land x y n))
+  :hints (("Goal" :use land0-bits-2)))
+
+(defthm land-base
+  (equal (land x y 1)
+         (if (and (equal (bitn x 0) 1)
+                  (equal (bitn y 0) 1))
+             1
+           0))
+  :hints (("Goal" :use land0-base))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/land0-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/land0-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/land0-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/land0-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,877 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+This book is about LAND0, a nice version of LOGAND.  LAND0 takes an extra size parameter, N, and always returns
+a bit vector of length N.
+
+Todo:
+add versions of logand-expt-2 and logand-expt-4
+prove (elsewhere) lemmas mixing land0 with other functions
+what should land0 of non-ints be?
+
+think about removing bits from defn of land0? why???
+|#
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(local (include-book "bvecp"))
+(local (include-book "all-ones"))
+(local (include-book "log"))
+(local (include-book "merge")) ;drop?
+(local (include-book "bvecp"))
+(local (include-book "logand"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "../../arithmetic/top"))
+
+;We expect n to be a positive integer, and x and y to be bit vectors of length n.
+(defund binary-land0 (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logand (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defmacro land0 (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land0 x y n) -- the base case
+         `(binary-land0 ,@x))
+        (t         
+         `(binary-land0 ,(car x)
+                       (land0 ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land0)) to refer to binary-land0.
+(add-macro-alias land0 binary-land0)
+
+(defthm land0-nonnegative-integer-type
+  (and (integerp (land0 x y n))
+       (<= 0 (land0 x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land0) is no better than land0-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land0)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land0-natp
+  (natp (land0 x y n)))
+
+(defthm land0-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (land0 x y n)
+                  0))
+  :hints (("Goal" :cases ((acl2-numberp n))
+           :in-theory (enable land0)))
+  )
+
+(defthmd land0-bvecp-simple
+  (bvecp (land0 x y n) n)
+  :hints (("Goal" :cases ((natp n))
+           :in-theory (enable land0))))
+
+(defthm land0-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land0 x y n) k))
+  :hints (("Goal" :in-theory (disable land0-bvecp-simple)
+           :use land0-bvecp-simple)))
+
+
+;;
+;; Rules to normalize land0 terms (recall that LAND0 is a macro for BINARY-LAND0):
+;;
+
+;; allow sizes to differ on these?
+
+(defthm land0-associative
+  (equal (land0 (land0 x y n) z n)
+         (land0 x (land0 y z n) n))
+  :hints (("Goal" :cases ((natp n))
+           :in-theory (enable land0 bits-tail))))
+
+#|
+;move
+(defthm logand-tighten-helper
+  (implies (bvecp x m)
+           (equal (logand x y)
+                  (logand (bits x (1- m) 0) y))))
+
+(defthm land0-tighten-1
+  (implies (and (< m n)
+                (integerp m)
+                (integerp n))
+           (equal (land0 (land0 x y m) z n)
+                  (land0 (land0 x y m) z m)))
+  :hints (("Goal" :in-theory (enable bits-tail)
+           :expand ((BINARY-LAND0 Z (BINARY-LAND0 X Y M) N)))))
+
+
+(defthm land0-associative-gen
+  (implies (and (integerp m)
+                (integerp n)
+                (<= 0 m)
+                (<= 0 n)
+                (<= m n)
+;                (bvecp x m)
+;                (bvecp z n)
+                )
+  (equal (land0 (land0 x y m) z n)
+         (land0 x (land0 y z m) m)))
+  :hints (("Goal" :cases ((natp n))
+           :in-theory (enable land0 bits-tail))))
+  |#       
+
+(defthm land0-commutative
+  (equal (land0 y x n)
+         (land0 x y n))
+  :hints (("Goal" :in-theory (enable land0))))
+
+;gen (must the n's match)?
+(defthm land0-commutative-2
+  (equal (land0 y (land0 x z n) n)
+         (land0 x (land0 y z n) n))
+  :hints (("Goal"  :cases ((natp n))
+           :in-theory (enable land0 bits-tail))))
+
+(defthm land0-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (land0 x (land0 y z n) n)
+                  (land0 (land0 x y n) z n))))
+
+
+(defthm land0-0
+  (equal (land0 0 y n)
+         0)
+  :hints (("Goal" :in-theory (enable land0))))
+
+;nicer than the analogous rule for logand?
+;would like to let the 1 be any n?
+(defthm land0-1
+  (equal (land0 1 y 1)
+         (bitn y 0))
+  :hints (("Goal" :in-theory (enable land0 bitn))))
+
+(defthm land0-self
+  (equal (land0 x x n)
+         (bits x (1- n) 0))
+  :hints (("Goal" :in-theory (enable land0 bits-tail))))
+
+(defthmd bits-land0-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (land0 x y n) i j)
+                  (land0 (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable land0 bits-logand))))
+
+
+(defthmd bits-land0-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (land0 x y n) i j)
+                  (land0 (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable land0 bits-logand))))
+
+;notice the call to MIN in the conclusion
+(defthm bits-land0
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (land0 x y n) i j)
+                  (land0 (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j)))))
+  :hints (("Goal" :in-theory (enable bits-land0-1 bits-land0-2))))
+
+(defthmd bitn-land0-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land0 x y n) m)
+                  (land0 (bitn x m) 
+                        (bitn y m) 
+                        1)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn)
+                              '(BITS-N-N-REWRITE)))))
+(defthmd bitn-land0-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land0 x y n) m)
+                  0))
+  :hints (("Goal" :in-theory (enable bvecp-bitn-0))))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-land0
+  (implies (and (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land0 x y n) m)
+                  (if (< m n)
+                      (land0 (bitn x m) 
+                            (bitn y m) 
+                            1)
+                    0)))
+  :hints (("Goal" :in-theory (enable bitn-land0-1 bitn-land0-2))))
+
+;BOZO see land0-equal-0
+;drop bvecp hyps and out bitn in conclusion?
+(defthm land0-of-single-bits-equal-0
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 0 (land0 x y 1))
+                  (or (equal x 0)
+                      (equal y 0))))
+  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+(defthm land0-of-single-bits-equal-1
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 1 (land0 x y 1))
+                  (and (equal x 1)
+                       (equal y 1))))
+  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+
+
+;in general, rewrite (bvecp k n) where k is a constant to a fact about n
+
+;BOZO allow the n's to differ?
+(defthm land0-ones
+  (equal (land0 (1- (expt 2 n)) x n)
+         (bits x (1- n) 0))
+  :rule-classes ()
+  :hints (("goal" :cases ((natp n))
+           :in-theory (enable land0 bits-tail logand-ones bvecp)
+           )))
+
+#| old:
+(defthm land0-ones
+  (implies (case-split (bvecp x n))
+           (equal (land0 (1- (expt 2 n)) x n)
+                  x))
+  :rule-classes ()
+  :hints (("goal" :cases ((natp n))
+           :in-theory (enable land0 bits-tail logand-ones bvecp)
+           )))
+|#
+
+;land0-with-all-ones will rewrite (land0 x n) [note there's only one value being ANDed], because (land0 x n)
+;expands to (BINARY-LAND0 X (ALL-ONES N) N) - now moot???
+(defthm land0-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (land0 (all-ones n) x n)
+                  x))
+  :hints (("goal" :use land0-ones
+           :in-theory (enable all-ones))))
+
+#| old
+(defthm land0-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep n)
+                              (equal (cadr k) (1- (expt 2 (cadr n))))))
+                (force (equal k (1- (expt 2 n))))
+                (case-split (bvecp x n)))
+           (equal (land0 k x n)
+                  x))
+  :hints (("Goal" :use land0-ones)))
+|#
+
+(defthmd land0-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+                (equal k (1- (expt 2 n))) ;this computes on constants...
+                )
+           (equal (land0 k x n)
+                  (bits x (1- n) 0)))
+  :hints (("Goal" :use (:instance land0-ones))))
+
+
+(local (in-theory (disable mod-by-2-rewrite-to-even mod-mult-of-n mod-equal-0 )))
+
+(encapsulate
+ ()
+
+ (local
+  (defthm land0-def-integerp
+    (implies (and (integerp x)
+                  (integerp y)
+                  (> n 0)
+                  (integerp n))
+             (equal (land0 x y n)
+                    (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (land0 (mod x 2) (mod y 2) 1))))
+    :rule-classes ()
+    :hints (("Goal" :in-theory (e/d (land0 bits-fl-by-2) ())
+             :use ((:instance logand-rewrite (x (bits x (1- n) 0)) (y (bits y (1- n) 0)))
+                   (:instance mod012 (m x))
+                   (:instance mod012 (m y)))))))
+
+; Now we want to eliminate the (integerp x) and (integerp y) hypotheses from
+; land0-def-integerp.  First suppose x is not rational.
+
+ (local
+  (defthm land0-is-0-if-not-rational
+    (implies (not (rationalp x))
+             (and (equal (land0 x y n) 0)
+                  (equal (land0 y x n) 0)))
+    :hints (("Goal" :expand ((land0 x y n)
+                             (land0 y x n))))))
+
+ (local
+  (defthm fl-1/2-is-0-if-not-rational
+    (implies (not (rationalp x))
+             (equal (fl (* 1/2 x)) 0))
+    :hints (("Goal" :cases ((acl2-numberp x))))))
+
+ (local
+  (defthm mod-2-if-not-rational
+    (implies (not (rationalp x))
+             (equal (mod x 2)
+                    (fix x)))
+    :hints (("Goal" :expand ((mod x 2))))))
+
+ (local
+  (defthm land0-def-not-rational
+    (implies (and (or (not (rationalp x))
+                      (not (rationalp y)))
+                  (> n 0)
+                  (integerp n))
+             (equal (land0 x y n)
+                    (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (land0 (mod x 2) (mod y 2) 1))))
+    :rule-classes nil))
+
+ (local
+  (defthm land0-fl-1
+    (equal (land0 (fl x) y n)
+           (land0 x y n))
+    :hints (("Goal" :expand ((land0 y (fl x) n)
+                             (land0 x y n))))))
+
+ (local
+  (defthm land0-fl-2
+    (equal (land0 y (fl x) n)
+           (land0 y x n))
+    :hints (("Goal" :expand ((land0 y (fl x) n)
+                             (land0 x y n))))))
+
+ (local
+  (defthm land0-def-rational-hack
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (>= n 0)
+                  (integerp n))
+             (equal (land0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
+                    (land0 (* 1/2 x) (* 1/2 y) n)))
+    :hints (("Goal" :expand ((land0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
+                             (land0 (* 1/2 x) (* 1/2 y) n))))))
+
+ (local
+  (defthm land0-def-rational
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (> n 0)
+                  (integerp n))
+             (equal (land0 x y n)
+                    (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (land0 (mod x 2) (mod y 2) 1))))
+    :rule-classes ()
+    :hints (("Goal"
+             :use ((:instance land0-def-integerp (x (fl x)) (y (fl y))))
+             :in-theory (e/d (mod-fl-eric) (fl-mod))))))
+
+ (defthm land0-def
+   (implies (and (> n 0)
+                 (integerp n))
+            (equal (land0 x y n)
+                   (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                      (land0 (mod x 2) (mod y 2) 1))))
+   :rule-classes ()
+   :hints (("Goal" :use (land0-def-not-rational land0-def-rational)))))
+
+(defthm land0-mod-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (mod (land0 x y n) 2)
+		    (land0 (mod x 2) (mod y 2) 1)))
+  :hints (("Goal" :use (land0-def
+			(:instance mod012 (m x))
+			(:instance mod012 (m y))
+			(:instance quot-mod (m (land0 x y n)) (n 2))))))
+
+(defthm land0-fl-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (fl (/ (land0 x y n) 2))
+		    (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+  :hints (("Goal" :use (land0-def
+			(:instance mod012 (m x))
+			(:instance mod012 (m y))
+			(:instance quot-mod (m (land0 x y n)) (n 2))))))
+
+(in-theory (disable land0-mod-2 land0-fl-2))
+
+;BOZO rename to land0-with-n-0
+;what if n is negative? or not an integer?
+(defthm land0-x-y-0
+    (equal (land0 x y 0) 0)
+  :hints (("Goal" :in-theory (enable land0))))
+
+;actually, maybe only either x or y must be a bvecp of length n
+;n is a free var
+(defthm land0-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land0 x y m)
+                    (land0 x y n)))
+  :hints (("Goal" :in-theory (enable land0))))
+
+;BOZO move to logand?
+(local
+ (defthm logand-of-single-bits-equal-0
+   (implies (and (bvecp i 1)
+                 (bvecp j 1))
+            (equal (equal 0 (logand i j))
+                   (or (equal i 0)
+                       (equal j 0))))
+   :hints (("Goal" :in-theory (enable bvecp-1-rewrite)))))
+
+;deceptive name; this only works for single bits!
+(defthm land0-equal-0
+  (implies (and (bvecp i 1)
+                (bvecp j 1))
+           (equal (equal 0 (land0 i j 1))
+                  (or (equal i 0)
+                      (equal j 0)))))
+
+;make alt version?
+(defthm land0-bnd
+  (implies (case-split (<= 0 x))
+           (<= (land0 x y n) x))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :in-theory (enable land0))))
+
+#|
+;move?
+;BOZO yuck! logand is in the conclusion!
+;BOZO different from lior0-shift (only 1 arg is shifted).  consider renaming?
+;BOZO drop fl from conclusion?
+;could tighten n to m first, then drop the irrelevant term?
+(defthm land0-shift
+  (implies (and (not (zp n))
+                (natp m)
+                (<= m n)
+                (bvecp y m)
+                (bvecp x (- n m)))
+           (= (land0 (* (expt 2 m) x) y n)
+              (* (expt 2 m) (logand x (fl (/ y (expt 2 m)))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logand-expt (n m)))
+           :in-theory (enable bvecp-forward bvecp-shift-up bits-tail land0))))
+
+;try
+(defthm land0-shift-2
+  (implies (and (not (zp n))
+                (natp m)
+                (<= m n)
+                (bvecp y m)
+                (bvecp x (- n m)))
+           (= (land0 (* (expt 2 m) x) y n)
+              0))
+  :rule-classes ()
+  :hints (("Goal" :use (land0-shift (:instance fl-unique (x (* Y (/ (EXPT 2 M)))) (n 0)))
+           :in-theory (e/d  (bvecp) ( FL-EQUAL-0)))))
+|#
+
+(local
+ (defthmd land0-with-shifted-arg-helper
+  (implies (and (bvecp x (- n m)) ;dropped below
+                (rationalp y)
+                (integerp m)
+                (integerp n)
+                (<= 0 m)
+                )
+           (equal (land0 (* (expt 2 m) x) y n)
+                  (* (expt 2 m) (land0 x (bits y (1- n) m) (+ n (- m))))))
+  :hints (("Goal" :use ((:instance logand-expt (n m) (y (fl (MOD Y (EXPT 2 N))))))
+           :in-theory (enable land0 bits bvecp)))))
+
+;enable? make an alt version??
+(defthmd land0-ignores-bits
+  (equal (land0 (bits x (1- n) 0) y n)
+         (land0 x y n))
+  :hints (("Goal" :in-theory (enable land0))))
+
+(defthmd land0-with-shifted-arg
+  (implies (and (integerp x) ;gen?
+                (rationalp y)
+                (integerp m)
+                (integerp n)
+                (<= 0 m)
+                )
+           (equal (land0 (* (expt 2 m) x) y n)
+                  (* (expt 2 m) (land0 x (bits y (1- n) m) (+ n (- m))))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable expt-split expt-minus bvecp)
+           :use ((:instance land0-ignores-bits (y (BITS Y (+ -1 N) M)) (n (+ N (* -1 M))))
+                 (:instance land0-ignores-bits (x (* X (EXPT 2 M))))
+                 (:instance land0-with-shifted-arg-helper (x (bits x (+ -1 n (- m)) 0)))))))
+
+(defthmd land0-shift
+  (implies (and (integerp x)
+                (integerp y) ; actually (rationalp y) works
+                (natp k))
+           (= (land0 (* (expt 2 k) x)
+                     (* (expt 2 k) y)
+                     n)
+              (* (expt 2 k) (land0 x y (- n k)))))
+  :hints (("Goal" :use ((:instance land0-with-shifted-arg
+                                   (m k)
+                                   (x x)
+                                   (y (* (expt 2 k) y))
+                                   (n n))
+                        (:instance land0-ignores-bits (x y)
+                                   (y x)
+                                   (n (- n k)))))))
+
+
+#|
+;try
+(defthm land0-shift-4
+  (implies (and (not (zp n))
+                (natp m)
+                (<= m n)
+                (integerp y)
+                (<= 0 y)
+                ;(bvecp y m)
+;                (bvecp x (- n m))
+                )
+           (= (land0 (* (expt 2 m) x) y n)
+              (* (expt 2 m)
+                 (land0 (bits x (+ -1 n (- m)) 0)
+                       (bits y (1- n) m)
+                       (+ n (- m))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logand-expt (n m) (x (bits x (+ -1 n (- m)) 0))
+                                   (y (MOD Y (EXPT 2 N)))))
+           :in-theory (e/d ( land0 bits bvecp expt-split expt-minus mod-prod)
+                           (mod-does-nothing)))))
+|#
+
+(defthmd land0-expt
+  (implies (and (natp n)
+                (natp k)
+                (< k n))
+           (equal (land0 x (expt 2 k) n)
+                  (* (expt 2 k) (bitn x k))))
+  :hints (("Goal" :use ((:instance logand-expt-2 (x (bits x (1- n) 0)))
+			(:instance expt-strong-monotone (n k) (m n)))
+           :in-theory (enable bvecp land0))))
+
+(defthm land0-slice
+  (implies (and (<= j i) ;drop?
+                (<= i n)
+                (integerp n)
+                (integerp i)
+                (integerp j)
+                (<= 0 j)
+                )
+           (equal (land0 x (- (expt 2 i) (expt 2 j)) n)
+                  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logand-slice (x (bits x (1- n) 0)) (n i) (k j))
+                        )
+           :in-theory (enable expt-strong-monotone-linear 
+                              expt-weak-monotone-linear 
+                              land0))))
+; Start proof of land-slices.
+
+(local
+ (defthm land0-slices-1
+   (implies (and (natp n)
+                 (natp l)
+                 (natp k)
+                 (<= l k)
+                 (< k n))
+            (equal (land0 (- (expt 2 n) (1+ (expt 2 l)))
+                          (- (expt 2 n) (expt 2 k))
+                          n)
+                   (* (expt 2 k)
+                      (bits (- (expt 2 n) (1+ (expt 2 l))) (1- n) k))))
+   :hints (("Goal" :use ((:instance land0-slice
+                                    (x (- (expt 2 n) (1+ (expt 2 l))))
+                                    (i n)
+                                    (j k)
+                                    (n n)))))
+   :rule-classes nil))
+
+(local
+ (defthmd land0-slices-2
+   (implies (and (natp n)
+                 (natp l)
+                 (natp k)
+                 (<= l k)
+                 (< k n))
+            (equal (* (expt 2 k)
+                      (bits (- (expt 2 n) (1+ (expt 2 l))) (1- n) k))
+                   (* (expt 2 k)
+                      (fl (/ (- (expt 2 n) (1+ (expt 2 l))) (expt 2 k))))))
+   :instructions (:promote (:dv 1)
+                           (:dv 2)
+                           :x :top (:dv 1 2 1 2 0)
+                           (:rewrite mod-does-nothing)
+                           :top :prove :prove
+                           (:use (:instance expt-strong-monotone (n l)
+                                            (m n)))
+                           (:in-theory (disable expt-compare power2p-expt2-i))
+                           :bash)))
+
+(local
+ (defthmd land0-slices-3
+   (implies (and (natp n)
+                 (natp l)
+                 (natp k)
+                 (<= l k)
+                 (< k n))
+            (equal (* (expt 2 k)
+                      (fl (/ (- (expt 2 n) (1+ (expt 2 l))) (expt 2 k))))
+                   (* (expt 2 k)
+                      (+ (expt 2 (- n k))
+                         (fl (/ (- (1+ (expt 2 l))) (expt 2 k)))))))
+   :hints (("Goal" :use ((:instance fl+int-rewrite
+                                    (x (/ (1+ (expt 2 l)) (expt 2 k)))
+                                    (n (/ (expt 2 n) (expt 2 k)))))))))
+
+(local (include-book "../../arithmetic/fl-hacks"))
+
+(local
+ (defthmd land0-slices-4
+   (implies (and (natp n)
+                 (natp l)
+                 (natp k)
+                 (<= l k)
+                 (< k n))
+            (equal (* (expt 2 k)
+                      (+ (expt 2 (- n k))
+                         (fl (/ (- (1+ (expt 2 l))) (expt 2 k)))))
+                   (* (expt 2 k)
+                      (+ (expt 2 (- n k))
+                         (- (fl (/ (expt 2 l) (expt 2 k))))
+                         -1))))
+   :hints (("Goal" :use ((:instance fl-m-n
+                                    (m (1+ (expt 2 l)))
+                                    (n (expt 2 k))))))))
+
+(local
+ (defthmd land0-slices-5
+   (implies (and (natp n)
+                 (natp l)
+                 (natp k)
+                 (<= l k)
+                 (< k n))
+            (equal (* (expt 2 k)
+                      (+ (expt 2 (- n k))
+                         (- (fl (/ (expt 2 l) (expt 2 k))))
+                         -1))
+                   (- (expt 2 n)
+                      (* (expt 2 k)
+                         (1+ (fl (/ (expt 2 l) (expt 2 k))))))))))
+
+(defthmd land0-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land0 (- (expt 2 n) (1+ (expt 2 l)))
+                         (- (expt 2 n) (expt 2 k))
+                         n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k)))))
+  :instructions ((:use land0-slices-1
+                       land0-slices-2 land0-slices-3
+                       land0-slices-4 land0-slices-5)
+                 :promote (:dv 1)
+                 := (:drop 1)
+                 := (:drop 1)
+                 := (:drop 1)
+                 := (:drop 1)
+                 := (:drop 1)
+                 :top :prove))
+
+(defthm land0-upper-bound
+  (implies (and (integerp n)
+                (<= 0 n))
+           (< (land0 x y n) (expt 2 n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :in-theory (enable land0))))
+
+(defthm land0-upper-bound-tight
+  (implies (and (integerp n)
+                (<= 0 n))
+           (<= (land0 x y n) (1- (expt 2 n)))))
+
+(defthm land0-nest-tighten
+  (implies (and (syntaxp (not (equal m n)))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (land0 x (land0 y z m) n)
+                  (land0 x (land0 y z (min m n)) (min m n))))
+  :hints (("Goal" :use (:instance and-dist-d
+                                  (x (logand (BITS Y (1- M) 0)
+                                             (BITS Z (1- M) 0)))
+                                  (n m)
+                                  (y  (BITS X (1- N) 0)))
+           :in-theory (enable land0))))
+
+(defthm land0-fl-1
+  (equal (land0 (fl x) y n)
+         (land0 x y n))
+  :hints (("Goal" :in-theory (enable land0))))
+
+(defthm land0-fl-2-eric
+  (equal (land0 x (fl y) n)
+         (land0 x y n))
+  :hints (("Goal" :in-theory (enable land0))))
+
+(defthmd land0-bits-1
+  (equal (land0 (bits x (1- n) 0)
+               y
+               n)
+         (land0 x y n))
+  :hints (("Goal" :in-theory (e/d (land0) (logior land0-commutative)))))
+
+(defthmd land0-bits-2
+  (equal (land0 x
+               (bits y (1- n) 0)
+               n)
+         (land0 x y n))
+  :hints (("Goal" :in-theory (e/d (land0) (logior land0-commutative)))))
+
+(local
+ (defthm land0-base-lemma
+   (implies (and (bvecp x 1) (bvecp y 1))
+            (equal (land0 x y 1)
+                   (if (and (equal (bitn x 0) 1)
+                            (equal (bitn y 0) 1))
+                       1
+                     0)))
+   :rule-classes nil))
+
+(defthm land0-base
+  (equal (land0 x y 1)
+         (if (and (equal (bitn x 0) 1)
+                  (equal (bitn y 0) 1))
+             1
+           0))
+  :hints (("Goal" :use ((:instance land0-base-lemma
+                                   (x (bits x 0 0))
+                                   (y (bits y 0 0)))
+                        (:instance land0-bits-1
+                                   (x x)
+                                   (y (bits y 0 0))
+                                   (n 1))
+                        (:instance land0-bits-2 (n 1)))))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/land0.lisp acl2-6.3/books/rtl/rel9/support/support/land0.lisp
--- acl2-6.2/books/rtl/rel9/support/support/land0.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/land0.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,443 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+This book is about LAND0, a nice version of LOGAND.  LAND0 takes an extra size parameter, N, and always returns
+a bit vector of length N.
+
+Todo:
+add versions of logand-expt-2 and logand-expt-4
+prove (elsewhere) lemmas mixing land0 with other functions
+
+|#
+
+;;Necessary defuns:
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(local (include-book "land0-proofs"))
+
+;; New stuff
+
+;We expect n to be a positive integer, and x and y to be bit vectors of length n.
+(defund binary-land0 (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logand (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defmacro land0 (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land0 x y n) -- the base case
+         `(binary-land0 ,@x))
+        (t         
+         `(binary-land0 ,(car x)
+                       (land0 ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land0)) to refer to binary-land0.
+(add-macro-alias land0 binary-land0)
+
+(defthm land0-nonnegative-integer-type
+  (and (integerp (land0 x y n))
+       (<= 0 (land0 x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription land0) is no better than land0-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-land0)))
+
+;drop this if we plan to keep natp enabled?
+(defthm land0-natp
+  (natp (land0 x y n)))
+
+;BOZO split into 2 rules?
+(defthm land0-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (land0 x y n)
+                  0)))
+
+(defthmd land0-bvecp-simple
+  (bvecp (land0 x y n) n))
+
+(defthm land0-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (land0 x y n) k)))
+
+
+;;
+;; Rules to normalize land0 terms (recall that LAND0 is a macro for BINARY-LAND0):
+;;
+
+;This guarantees that the n parameters to nested LAND0 calls match.
+;Note the MIN in the conclusion.
+;BOZO do we expect MIN to be enabled?  Maybe we should use IF instead for this and other rules?
+(defthm land0-nest-tighten
+  (implies (and (syntaxp (not (equal m n)))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (land0 x (land0 y z m) n)
+                  (land0 x (land0 y z (min m n)) (min m n)))))
+
+; allow the n's to differ on this?
+(defthm land0-associative
+  (equal (land0 (land0 x y n) z n)
+         (land0 x (land0 y z n) n)))
+
+(defthm land0-commutative
+  (equal (land0 y x n)
+         (land0 x y n)))
+
+; allow the n's to differ on this?
+(defthm land0-commutative-2
+  (equal (land0 y (land0 x z n) n)
+         (land0 x (land0 y z n) n)))
+
+; allow the n's to differ on this?
+(defthm land0-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (land0 x (land0 y z n) n)
+                  (land0 (land0 x y n) z n))))
+
+(defthm land0-0
+  (equal (land0 0 y n)
+         0))
+
+;nicer than the analogous rule for logand? is it really?
+;BOZO gen the second 1 in the lhs?
+(defthm land0-1
+  (equal (land0 1 y 1)
+         (bitn y 0)))
+
+(defthm land0-self
+  (equal (land0 x x n)
+         (bits x (1- n) 0)))
+
+;perhaps use only the main rule, bits-land0?
+(defthmd bits-land0-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (land0 x y n) i j)
+                  (land0 (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j))))))
+
+;perhaps use only the main rule, bits-land0?
+(defthmd bits-land0-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (land0 x y n) i j)
+                  (land0 (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j))))))
+
+;Notice the call to MIN in the conclusion.
+(defthm bits-land0
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (land0 x y n) i j)
+                  (land0 (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j))))))
+
+(defthmd bitn-land0-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land0 x y n) m)
+                  (land0 (bitn x m) 
+                        (bitn y m) 
+                        1))))
+(defthmd bitn-land0-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land0 x y n) m)
+                  0)))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-land0
+  (implies (and (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (land0 x y n) m)
+                  (if (< m n)
+                      (land0 (bitn x m) 
+                            (bitn y m) 
+                            1)
+                    0))))
+
+;BOZO see land0-equal-0
+;drop bvecp hyps and put bitn in conclusion?
+(defthm land0-of-single-bits-equal-0
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 0 (land0 x y 1))
+                  (or (equal x 0)
+                      (equal y 0)))))
+
+(defthm land0-of-single-bits-equal-1
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 1 (land0 x y 1))
+                  (and (equal x 1)
+                       (equal y 1)))))
+
+(defthm land0-ones
+  (equal (land0 (1- (expt 2 n)) x n)
+         (bits x (1- n) 0))
+  :rule-classes ())
+
+;land0-with-all-ones will rewrite (land0 x n) [note there's only one value being ANDed], because (land0 x n)
+;expands to (BINARY-LAND0 X (ALL-ONES N) N) - now moot???
+;BOZO drop bvecp hyp and move to conclusion?
+(defthm land0-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (land0 (all-ones n) x n)
+                  x)))
+
+(defthmd land0-ones-rewrite
+  (implies (and (syntaxp (and (quotep k) (quotep n)))
+                (equal k (1- (expt 2 n))) ;this computes on constants...
+                )
+           (equal (land0 k x n)
+                  (bits x (1- n) 0))))
+
+(defthm land0-def
+  (implies (and (> n 0)
+                (integerp n))
+           (equal (land0 x y n)
+                  (+ (* 2 (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (land0 (mod x 2) (mod y 2) 1))))
+  :rule-classes ())
+
+(defthmd land0-mod-2
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (> n 0))
+           (equal (mod (land0 x y n) 2)
+                  (land0 (mod x 2) (mod y 2) 1))))
+
+;BOZO RHS isn't simplified...
+(defthmd land0-fl-2
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (> n 0))
+           (equal (fl (/ (land0 x y n) 2))
+                  (land0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
+
+;BOZO rename to land0-with-n-0
+;what if n is negative? or not an integer?
+(defthm land0-x-y-0
+  (equal (land0 x y 0) 0))
+
+;actually, maybe only either x or y must be a bvecp of length n
+;n is a free var
+(defthm land0-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (natp n)
+		  (natp m)
+		  (< n m))
+	     (equal (land0 x y m)
+                    (land0 x y n))))
+
+;deceptive name; this only works for single bits!
+(defthm land0-equal-0
+  (implies (and (bvecp i 1)
+                (bvecp j 1))
+           (equal (equal 0 (land0 i j 1))
+                  (or (equal i 0)
+                      (equal j 0)))))
+
+;make alt version?
+(defthm land0-bnd
+  (implies (case-split (<= 0 x))
+           (<= (land0 x y n) x))
+  :rule-classes (:rewrite :linear))
+
+;enable? make an alt version??
+(defthmd land0-ignores-bits
+  (equal (land0 (bits x (1- n) 0) y n)
+         (land0 x y n)))
+
+(defthmd land0-with-shifted-arg
+  (implies (and (integerp x) ;gen?
+                (rationalp y)
+                (integerp m)
+                (integerp n)
+                (<= 0 m)
+                )
+           (equal (land0 (* (expt 2 m) x) y n)
+                  (* (expt 2 m) (land0 x (bits y (1- n) m) (+ n (- m)))))))
+
+(defthmd land0-shift
+  (implies (and (integerp x)
+                (integerp y) ; actually (rationalp y) works
+                (natp k))
+           (= (land0 (* (expt 2 k) x)
+                     (* (expt 2 k) y)
+                     n)
+              (* (expt 2 k) (land0 x y (- n k))))))
+
+(defthmd land0-expt
+  (implies (and (natp n)
+                (natp k)
+                (< k n))
+           (equal (land0 x (expt 2 k) n)
+                  (* (expt 2 k) (bitn x k)))))
+
+(defthm land0-slice
+  (implies (and (<= j i) ;drop? or not?
+                (<= i n)
+                (integerp n)
+                (integerp i)
+                (integerp j)
+                (<= 0 j)
+                )
+           (equal (land0 x (- (expt 2 i) (expt 2 j)) n)
+                  (* (expt 2 j) (bits x (1- i) j))))
+  :rule-classes ())
+
+(defthmd land0-slices
+  (implies (and (natp n)
+                (natp l)
+                (natp k)
+                (<= l k)
+                (< k n))
+           (equal (land0 (- (expt 2 n) (1+ (expt 2 l)))
+                         (- (expt 2 n) (expt 2 k))
+                         n)
+                  (if (= l k)
+                      (- (expt 2 n) (expt 2 (1+ k)))
+                    (- (expt 2 n) (expt 2 k))))))
+
+(defthm land0-upper-bound
+  (implies (and (integerp n)
+                (<= 0 n))
+           (< (land0 x y n) (expt 2 n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm land0-upper-bound-tight
+  (implies (and (integerp n)
+                (<= 0 n))
+           (<= (land0 x y n) (1- (expt 2 n)))))
+
+(defthm land0-fl-1
+  (equal (land0 (fl x) y n)
+         (land0 x y n)))
+
+(defthm land0-fl-2-eric ;BOZO name conflicted...
+  (equal (land0 x (fl y) n)
+         (land0 x y n)))
+
+(defthmd land0-bits-1
+  (equal (land0 (bits x (1- n) 0)
+               y
+               n)
+         (land0 x y n)))
+
+(defthmd land0-bits-2
+  (equal (land0 x
+               (bits y (1- n) 0)
+               n)
+         (land0 x y n)))
+
+(defthm land0-base
+  (equal (land0 x y 1)
+         (if (and (equal (bitn x 0) 1)
+                  (equal (bitn y 0) 1))
+             1
+           0))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lextra-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/lextra-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lextra-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lextra-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,224 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "land0")
+(include-book "lior0")
+(include-book "lxor0")
+(local (include-book "../../arithmetic/top"))
+(local (include-book "logand"))
+(local (include-book "logior"))
+(local (include-book "logxor"))
+(local (include-book "merge"))
+(local (include-book "bvecp"))
+(local (include-book "bits"))
+
+(defthmd lior0-land0-1
+  (equal (lior0 x (land0 y z n) n)
+         (land0 (lior0 x y n) (lior0 x z n) n))
+  :hints (("Goal" :use ((:instance logior-logand 
+				   (x (bits x (1- n) 0)) 
+				   (y (bits y (1- n) 0))
+				   (z (bits z (1- n) 0))))
+           :in-theory (enable lior0 land0))))
+
+(defthmd lior0-land0-2
+  (equal (lior0 (land0 y z n) x n)
+         (land0 (lior0 x y n) (lior0 x z n) n))
+  :hints (("Goal" :use ((:instance logior-logand 
+				   (x (bits x (1- n) 0)) 
+				   (y (bits y (1- n) 0))
+				   (z (bits z (1- n) 0))))
+           :in-theory (enable lior0 land0))))
+
+(defthmd land0-lior0-1
+  (equal (land0 x (lior0 y z n) n)
+         (lior0 (land0 x y n) (land0 x z n) n))
+  :hints (("Goal" :use ((:instance logand-logior 
+				   (x (bits x (1- n) 0)) 
+				   (y (bits y (1- n) 0))
+				   (z (bits z (1- n) 0))))
+           :in-theory (enable lior0 land0))))
+
+(defthmd land0-lior0-2
+  (equal (land0 (lior0 y z n) x n)
+         (lior0 (land0 x y n) (land0 x z n) n))
+  :hints (("Goal" :use ((:instance logand-logior 
+				   (x (bits x (1- n) 0)) 
+				   (y (bits y (1- n) 0))
+				   (z (bits z (1- n) 0))))
+           :in-theory (enable lior0 land0))))
+
+(defthmd lior0-land0-lxor0
+  (equal (lior0 (land0 x y n) (lior0 (land0 x z n) (land0 y z n) n) n)
+         (lior0 (land0 x y n) (land0 (lxor0 x y n) z n) n))
+  :hints (("Goal" :use ((:instance log3
+				   (x (bits x (1- n) 0)) 
+				   (y (bits y (1- n) 0))
+				   (z (bits z (1- n) 0))))
+           :in-theory (enable lior0 land0 lxor0))))
+
+(defthmd lxor0-rewrite
+  (equal (lxor0 x y n)
+         (lior0 (land0 x (lnot y n) n)
+               (land0 y (lnot x n) n)
+               n))
+  :hints (("Goal" :use ((:instance logxor-rewrite-2
+				   (x (bits x (1- n) 0)) 
+				   (y (bits y (1- n) 0))))
+           :in-theory (enable lior0 land0 lxor0))))
+
+(defthmd lnot-lxor0
+  (equal (lnot (lxor0 x y n) n)
+         (lxor0 (lnot x n) y n))
+  :hints (("Goal" :use ((:instance lnot-logxor
+				   (x (bits x (1- n) 0)) 
+				   (y (bits y (1- n) 0))))
+           :in-theory (enable lxor0))))
+
+;move
+(defthm bits-of-1-plus-double
+  (implies (and (integerp x)
+                (<= 0 i)
+                )
+           (equal (bits (+ 1 (* 2 x)) i 1)
+                  (bits x (1- i) 0)))
+  :hints (("goal" :in-theory (enable bits expt-split mod-prod mod-sum-cases)
+           ))
+  )
+
+;move
+;useful for inductions involvling lnot?
+(defthm lnot-shift-plus-1
+  (implies (and (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n))
+                )
+           (equal (lnot (+ 1 (* 2 x)) n)
+                  (* 2 (lnot x (1- n)))))
+  :hints (("Goal" :use (:instance bits-plus-bits (x (+ 1 (* 2 X))) (n  (1- N)) (m 0) (p 1))
+           :in-theory (enable lnot expt-split))))
+
+;move?
+;do we want this sort of theorem about lognot and logand too?
+; Matt K.:  The original proof fails using v2-8-alpha-12-30-03.  I don't know
+; why, but I do notice that the induction heuristics are getting in the way,
+; because the problem goal (the one with the hint below) goes through in the
+; proof-checker.  So we use the proof-checker proof.
+
+#|
+(local
+ (defthm lnot-lior0-aux
+  (implies (and (integerp x) ;gen?
+                (integerp y) ;gen?
+                )
+           (equal (lnot (lior0 x y n) n)
+                  (land0 (lnot x n) (lnot y n) n)))
+  :hints (("subgoal *1/2" :use (lior0-def
+                                (:instance land0-def (x  (LNOT X N)) (y (LNOT Y N)))
+                                (:instance mod012 (m x))
+                                (:instance mod012 (m y))
+                                (:instance lnot-fl-original (k 1))
+                                (:instance lnot-fl-original (x y) (k 1))
+                                )
+           )
+          ("Goal" :in-theory (enable lnot-shift-2)
+           :do-not '(generalize)
+           :induct ( op-dist-induct x y n)))))
+|#
+
+(local
+ (DEFTHM LNOT-LIOR0-AUX
+   (IMPLIES (AND (INTEGERP X) (INTEGERP Y))
+            (EQUAL (LNOT (LIOR0 X Y N) N)
+                   (LAND0 (LNOT X N) (LNOT Y N) N)))
+   :INSTRUCTIONS
+   ((:IN-THEORY (ENABLE LNOT-SHIFT-2))
+    (:INDUCT (OP-DIST-INDUCT X Y N))
+    :PROVE
+    (:PROVE :HINTS
+            (("Goal" :USE
+              (LIOR0-DEF (:INSTANCE LAND0-DEF (X (LNOT X N))
+                                   (Y (LNOT Y N)))
+                        (:INSTANCE MOD012 (M X))
+                        (:INSTANCE MOD012 (M Y))
+                        (:INSTANCE LNOT-FL-ORIGINAL (K 1))
+                        (:INSTANCE LNOT-FL-ORIGINAL (X Y) (K 1))))))
+    :PROVE)))
+
+(defthm lnot-lior0
+  (equal (lnot (lior0 x y n) n)
+         (land0 (lnot x n) (lnot y n) n))
+  :hints (("goal" :in-theory (disable lnot-lior0-aux)
+           :use (:instance lnot-lior0-aux (x (fl x)) (y (fl y)))))
+  )
+
+; See comment above about v2-8-alpha-12-30-03.  A similar situation applies
+; just below.
+#|
+(local
+ (defthm lnot-land0-aux
+   (implies (and (integerp x) ;gen?
+                 (integerp y) ;gen?
+                 )
+            (equal (lnot (land0 x y n) n)
+                   (lior0 (lnot x n) (lnot y n) n)))
+   :hints (("subgoal *1/2" :use (land0-def
+                                 (:instance lior0-def (x  (LNOT X N)) (y (LNOT Y N)))
+                                 (:instance mod012 (m x))
+                                 (:instance mod012 (m y))
+                                 (:instance lnot-fl-original (k 1))
+                                 (:instance lnot-fl-original (x y) (k 1))
+                                 )
+            )
+           ("Goal" :in-theory (enable lnot-shift)
+            :do-not '(generalize)
+            :induct ( op-dist-induct x y n)))))
+|#
+
+(DEFTHM LNOT-LAND0-AUX
+        (IMPLIES (AND (INTEGERP X) (INTEGERP Y))
+                 (EQUAL (LNOT (LAND0 X Y N) N)
+                        (LIOR0 (LNOT X N) (LNOT Y N) N)))
+        :INSTRUCTIONS
+        ((:IN-THEORY (ENABLE LNOT-SHIFT-2))
+         (:INDUCT (OP-DIST-INDUCT X Y N))
+         :PROVE
+         (:PROVE :HINTS
+                 (("Goal" :USE
+                          (LAND0-DEF (:INSTANCE LIOR0-DEF (X (LNOT X N))
+                                               (Y (LNOT Y N)))
+                                    (:INSTANCE MOD012 (M X))
+                                    (:INSTANCE MOD012 (M Y))
+                                    (:INSTANCE LNOT-FL-ORIGINAL (K 1))
+                                    (:INSTANCE LNOT-FL-ORIGINAL (X Y) (K 1))))))
+         :PROVE))
+
+(defthm lnot-land0
+  (equal (lnot (land0 x y n) n)
+         (lior0 (lnot x n) (lnot y n) n))
+  :hints (("Goal" :in-theory (disable LNOT-LAND0-aux)
+           :use (:instance lnot-land0-aux (x (fl x)) (y (fl y)))))
+  )
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lextra.lisp acl2-6.3/books/rtl/rel9/support/support/lextra.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lextra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lextra.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1203 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "land")
+(include-book "lior")
+(include-book "lxor")
+(include-book "cat")
+(local (include-book "lextra0"))
+(local (include-book "land0"))
+(local (include-book "lior0"))
+(local (include-book "lxor0"))
+(local (include-book "merge2"))
+
+(local (in-theory (current-theory 'lextra0-start)))
+(local (in-theory (e/d (land-is-land0 lior-is-lior0 lxor-is-lxor0)
+                       (binary-land binary-lior binary-lxor))))
+
+;theorems mixing two or more of the new logical operators.
+
+;BOZO really the -1 and -2 names below should be switched?
+
+(defthmd lior-land-1
+  (equal (lior x (land y z n) n)
+         (land (lior x y n) (lior x z n) n))
+  :hints (("Goal" :in-theory (enable lior0-land0-1))))
+
+(defthmd lior-land-2
+  (equal (lior (land y z n) x n)
+         (land (lior x y n) (lior x z n) n))
+  :hints (("Goal" :in-theory (enable lior0-land0-2))))
+
+(defthmd land-lior-1
+  (equal (land x (lior y z n) n)
+         (lior (land x y n) (land x z n) n))
+  :hints (("Goal" :in-theory (enable land0-lior0-1))))
+
+(defthmd land-lior-2
+  (equal (land (lior y z n) x n)
+         (lior (land x y n) (land x z n) n))
+  :hints (("Goal" :in-theory (enable land0-lior0-2))))
+
+(defthmd lior-land-lxor
+  (equal (lior (land x y n) (lior (land x z n) (land y z n) n) n)
+         (lior (land x y n) (land (lxor x y n) z n) n))
+  :hints (("Goal" :in-theory (enable lior0-land0-lxor0))))
+
+(defthmd lxor-rewrite
+  (equal (lxor x y n)
+         (lior (land x (lnot y n) n)
+               (land y (lnot x n) n)
+               n))
+  :hints (("Goal" :in-theory (enable lxor0-rewrite))))
+
+(defthmd lnot-lxor
+  (equal (lnot (lxor x y n) n)
+         (lxor (lnot x n) y n))
+  :hints (("Goal" :in-theory (enable lnot-lxor0))))
+
+;consider enabling?
+(defthmd lnot-lior
+  (equal (lnot (lior x y n) n)
+         (land (lnot x n) (lnot y n) n))
+  :hints (("Goal" :in-theory (enable lnot-lior0))))
+
+;consider enabling?
+(defthmd lnot-land
+  (equal (lnot (land x y n) n)
+         (lior (lnot x n) (lnot y n) n))
+  :hints (("Goal" :in-theory (enable lnot-land0))))
+
+; Added for rel5.  (Much of this really "should" go in lextra-proofs.lisp, but
+; it was developed here before that realization, and moving it doesn't seem
+; worth the trouble.)
+
+(defthmd land-cat
+  (implies (and (case-split (natp n))
+                (case-split (integerp m))
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (land (cat x1 m y1 n) (cat x2 m y2 n) l)
+                  (cat (land x1 x2 m) m (land y1 y2 n) n)))
+  :hints (("Goal" :in-theory (enable land0-cat))))
+
+(defthm land-cat-constant
+  (implies (and (case-split (integerp n))
+                (case-split (integerp m))
+                (syntaxp (quotep c))
+                (> n 0)
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (land c (cat x2 m y2 n) l)
+                  (cat (land (bits c (+ -1 m n) n) x2 m)
+                       m
+                       (land (bits c (1- n) 0) y2 n)
+                       n)))
+  :hints (("Goal" :use land0-cat-constant)))
+
+(defthmd lior-cat
+  (implies (and (case-split (natp n))
+                (case-split (integerp m))
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (lior (cat x1 m y1 n) (cat x2 m y2 n) l)
+                  (cat (lior x1 x2 m) m (lior y1 y2 n) n)))
+  :hints (("Goal" :in-theory (enable lior0-cat))))
+
+(defthm lior-cat-constant
+  (implies (and (case-split (integerp n))
+                (case-split (integerp m))
+                (syntaxp (quotep c))
+                (> n 0)
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (lior c (cat x2 m y2 n) l)
+                  (cat (lior (bits c (+ -1 m n) n) x2 m)
+                       m
+                       (lior (bits c (1- n) 0) y2 n)
+                       n)))
+  :hints (("Goal" :use lior0-cat-constant)))
+
+(defthmd lxor-cat
+  (implies (and (case-split (natp n))
+                (case-split (integerp m))
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (lxor (cat x1 m y1 n) (cat x2 m y2 n) l)
+                  (cat (lxor x1 x2 m) m (lxor y1 y2 n) n)))
+  :hints (("Goal" :in-theory (enable lxor0-cat))))
+
+(defthm lxor-cat-constant
+  (implies (and (case-split (integerp n))
+                (case-split (integerp m))
+                (syntaxp (quotep c))
+                (> n 0)
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (lxor c (cat x2 m y2 n) l)
+                  (cat (lxor (bits c (+ -1 m n) n) x2 m)
+                       m
+                       (lxor (bits c (1- n) 0) y2 n)
+                       n)))
+  :hints (("Goal" :use lxor0-cat-constant)))
+
+(defthm lxor-bnd
+  (<= (lxor x y n) (lior x y n))
+  :hints (("Goal"
+           :in-theory
+           (e/d (lxor lior)
+                (lxor-is-lxor0 lior-is-lior0))))
+  :rule-classes (:rewrite :linear))
+
+; Start proof of lxor-slice.
+
+(local (include-book "../../arithmetic/top"))
+
+(local (in-theory (enable a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a12 a13 a14 a15
+                          bits-lnot bits-bits
+                          bits-with-indices-in-the-wrong-order
+                          lnot-bvecp-simple lnot-bvecp
+                          bits-0)))
+
+(local
+ (defthmd lxor-slice-1-1
+   (implies (and (<= j i)
+                 (<= i n)
+                 (integerp n)
+                 (integerp i)
+                 (integerp j)
+                 (<= 0 j))
+            (equal (bits x (1- n) 0)
+                   (cat (bits x (1- n) i) (- n i)
+                        (bits x (1- i) j) (- i j)
+                        (bits x (1- j) 0) j)))
+   :hints (("Goal" :use ((:instance bits-plus-bits
+                                    (n (1- n))
+                                    (m 0)
+                                    (p i))
+                         (:instance bits-plus-bits
+                                    (n (1- i))
+                                    (m 0)
+                                    (p j)))))))
+
+(local
+ (encapsulate
+  ()
+
+  (local
+   (defthm lxor-slice-1-2-1
+     (implies (and (<= 0 j)
+                   (<= j i)
+                   (<= i n)
+                   (integerp n)
+                   (integerp i)
+                   (integerp j))
+              (equal (bits (- (expt 2 i) (expt 2 j))
+                           (+ -1 n)
+                           0)
+                     (- (expt 2 i) (expt 2 j))))
+     :hints (("Goal" :use ((:instance expt-weak-monotone (n i) (m n))
+                           (:instance expt-weak-monotone (n j) (m i)))
+              :in-theory (e/d (bits-reduce) (expt-compare))))
+     :rule-classes nil))
+
+  (local
+   (defthm lxor-slice-1-2-2
+     (implies (and (<= 0 i)
+                   (<= i n)
+                   (integerp n)
+                   (integerp i))
+              (equal (bits (+ -1 (expt 2 i))
+                           (+ -1 n)
+                           0)
+                     (+ -1 (expt 2 i))))
+     :hints (("Goal" :use ((:instance lxor-slice-1-2-1 (j 0)))))))
+
+  (defthm lxor-slice-1-2-3 ; used in final lxor-slice proof
+    (implies (and (<= 0 j)
+                  (<= j i)
+                  (<= i n)
+                  (integerp n)
+                  (integerp i)
+                  (integerp j))
+             (equal (bits (+ (expt 2 i) (* -1 (expt 2 j)))
+                          (+ -1 n)
+                          0)
+                    (+ (expt 2 i) (* -1 (expt 2 j)))))
+    :hints (("Goal" :use ((:instance lxor-slice-1-2-1 (j j))))))
+
+  (defthm lxor-slice-1-2
+    (implies (and (<= j i)
+                  (<= i n)
+                  (integerp n)
+                  (integerp i)
+                  (integerp j)
+                  (<= 0 j))
+             (equal (bits (- (expt 2 i) (expt 2 j)) (1- n) 0)
+                    (cat 0 (- n i)
+                         (1- (expt 2 (- i j))) (- i j)
+                         0 j)))
+    :hints (("Goal" :in-theory (enable cat))))))
+
+(local
+ (defthm lxor-slice-1
+   (implies (and (<= j i)
+                 (<= i n)
+                 (integerp n)
+                 (integerp i)
+                 (integerp j)
+                 (<= 0 j))
+            (equal (lxor (cat (bits x (1- n) i) (- n i)
+                              (bits x (1- i) j) (- i j)
+                              (bits x (1- j) 0) j)
+                         (cat 0 (- n i)
+                              (1- (expt 2 (- i j))) (- i j)
+                              0 j)
+                         n)
+                   (lxor (bits x (1- n) 0)
+                         (bits (- (expt 2 i) (expt 2 j)) (1- n) 0)
+                         n)))
+   :hints (("Goal" :use (lxor-slice-1-1 lxor-slice-1-2)))
+   :rule-classes nil))
+
+(local
+ (defthm lxor-slice-2
+   (implies (and (< j i)
+                 (< i n)
+                 (integerp n)
+                 (integerp i)
+                 (integerp j)
+                 (<= 0 j))
+            (equal (lxor (cat (bits x (1- n) i) (- n i)
+                              (bits x (1- i) j) (- i j)
+                              (bits x (1- j) 0) j)
+                         (cat 0 (- n i)
+                              (1- (expt 2 (- i j))) (- i j)
+                              0 j)
+                         n)
+                   (cat (bits x (1- n) i) (- n i)
+                        (lnot (bits x (1- i) j) (- i j)) (- i j)
+                        (bits x (1- j) 0) j)))
+   :hints (("Goal" :in-theory (e/d (lxor0-cat)
+                                   (cat-0 cat-0-alt cat-bits-bits))
+            :use ((:instance lxor0-ones
+                             (x (bits x (+ -1 i) j))
+                             (n (+ i (* -1 j)))))))
+   :rule-classes nil))
+
+(local
+ (defthm lxor-slice-3 ; i=j case
+   (implies (and (<= i n)
+                 (<= 0 i)
+                 (integerp n)
+                 (integerp i))
+            (equal (lxor (bits x (1- n) 0)
+                         0
+                         n)
+                   (cat (bits x (1- n) i) (- n i)
+                        (lnot (bits x (1- i) i) 0) 0
+                        (bits x (1- i) 0) i)))
+   :hints (("Goal" :in-theory (enable cat)))
+   :rule-classes nil))
+
+(local
+ (encapsulate
+  ()
+
+  (local
+   (defthm hack-1
+     (implies (natp n)
+              (equal (bits (+ -1 (* 2 (expt 2 n)))
+                           n
+                           0)
+                     (+ -1 (* 2 (expt 2 n)))))
+     :hints (("Goal" :in-theory (enable bits-reduce)))))
+
+  (local
+   (defthm hack-2
+     (implies (and (< j n)
+                   (integerp n)
+                   (integerp j)
+                   (< 0 j))
+              (equal (bits (+ -1 (expt 2 (+ n (* -1 j))))
+                           (+ -1 n (* -1 j))
+                           0)
+                     (+ -1 (expt 2 (+ n (* -1 j))))))
+     :hints (("Goal"
+              :use ((:instance bits-reduce
+                               (x (+ -1 (expt 2 (+ n (* -1 j)))))
+                               (i (+ -1 n (* -1 j)))))))))
+
+  (defthm lxor-slice-2-i=n
+    (implies (and (< j n)
+                  (integerp n)
+                  (integerp j)
+                  (<= 0 j))
+             (equal (lxor (cat (bits x (1- n) n) 0
+                               (bits x (1- n) j) (- n j)
+                               (bits x (1- j) 0) j)
+                          (cat 0 0
+                               (1- (expt 2 (- n j))) (- n j)
+                               0 j)
+                          n)
+                    (cat (bits x (1- n) n) 0
+                         (lnot (bits x (1- n) j) (- n j)) (- n j)
+                         (bits x (1- j) 0) j)))
+    :hints (("Goal" :in-theory (e/d (lxor0-cat)
+                                    (cat-0 cat-0-alt cat-bits-bits))
+             :use ((:instance lxor0-ones
+                              (x (bits x (+ -1 n) j))
+                              (n (+ n (* -1 j)))))))
+    :rule-classes nil)))
+
+(defthmd lxor-slice
+  (implies (and (<= j i)
+                (<= i n)
+                (integerp n)
+                (integerp i)
+                (integerp j)
+                (<= 0 j))
+           (equal (lxor x
+                        (- (expt 2 i) (expt 2 j))
+                        n)
+                  (cat (bits x (1- n) i) (- n i)
+                       (lnot (bits x (1- i) j) (- i j)) (- i j)
+                       (bits x (1- j) 0) j)))
+  :hints (("Goal" :use (lxor-slice-1 lxor-slice-2 lxor-slice-2-i=n)
+           :in-theory (e/d (lxor-bits-1) (expt)))))
+
+; Start proof of lxor-expt, using lxor-slice, which is in this file because it
+; is a corollary of lxor-slice.
+
+(local
+ (defthm lxor-expt-1-1
+   (implies (and (natp n)
+                 (natp k)
+                 (< k n))
+            (equal (lxor x (expt 2 k) n)
+                   (cat (bits x (1- n) (1+ k)) (1- (- n k))
+                        (lnot (bits x k k) 1) 1
+                        (bits x (1- k) 0) k)))
+   :hints (("Goal" :use ((:instance lxor-slice
+                                    (i (1+ k))
+                                    (j k)))))
+   :rule-classes nil))
+
+(local
+ (defthm lxor-expt-1-2
+   (implies (and (natp n)
+                 (natp k)
+                 (< k n))
+            (equal (cat (bits x (1- n) (1+ k)) (1- (- n k))
+                        (lnot (bits x k k) 1) 1
+                        (bits x (1- k) 0) k)
+                   (+ (* (expt 2 (1+ k)) (bits x (1- n) (1+ k)))
+                      (cat (lnot (bits x k k) 1) 1
+                           (bits x (1- k) 0) k))))
+   :hints (("Goal" :use ((:instance binary-cat
+                                    (x (bits x (1- n) (1+ k)))
+                                    (m (1- (- n k)))
+                                    (y (cat (lnot (bits x k k) 1) 1
+                                            (bits x (1- k) 0) k))
+                                    (n (+ 1 k))))))
+   :rule-classes nil))
+
+(local
+ (defthm lxor-expt-1-3
+   (implies (and (natp n)
+                 (natp k)
+                 (< k n))
+            (equal (cat (lnot (bits x k k) 1) 1
+                        (bits x (1- k) 0) k)
+                   (+ (* (expt 2 k) (lnot (bits x k k) 1))
+                      (bits x (1- k) 0))))
+   :hints (("Goal" :use ((:instance binary-cat
+                                    (x (lnot (bits x k k) 1))
+                                    (m 1)
+                                    (y (bits x (1- k) 0))
+                                    (n k)))))
+   :rule-classes nil))
+
+(local
+ (defthmd lxor-expt-1
+   (implies (and (natp n)
+                 (natp k)
+                 (< k n))
+            (equal (lxor x (expt 2 k) n)
+                   (+ (* (expt 2 (1+ k)) (bits x (1- n) (1+ k)))
+                      (* (expt 2 k) (lnot (bits x k k) 1))
+                      (bits x (1- k) 0))))
+   :hints (("Goal" :use (lxor-expt-1-1 lxor-expt-1-2 lxor-expt-1-3)))))
+
+(local
+ (defthmd lxor-expt-2
+   (implies (and (natp n)
+                 (natp k)
+                 (< k n))
+            (equal (bits x (1- n) 0)
+                   (+ (* (expt 2 (1+ k))
+                         (bits x (1- n) (1+ k)))
+                      (* (expt 2 k) (bitn x k))
+                      (bits x (1- k) 0))))
+   :hints (("Goal" :use ((:instance bits-plus-bits
+                                    (n (1- n))
+                                    (m 0)
+                                    (p (1+ k)))
+                         (:instance bitn-plus-bits ; could just enable
+                                    (n k)
+                                    (m 0)))))))
+
+(defthmd lxor-expt
+  (implies (and (natp n)
+		(natp k)
+		(< k n))
+	   (equal (lxor x (expt 2 k) n)
+		  (+ (bits x (1- n) 0)
+                     (* (expt 2 k) (- 1 (* 2 (bitn x k)))))))
+  :hints (("Goal" :in-theory (union-theories '(lxor-expt-1 lxor-expt-2)
+                                             (current-theory 'ground-zero)))
+          ("Goal''" :in-theory (enable lnot bitn))))
+
+(include-book "bits-trunc")
+
+; adapted from bits-trunc.lisp:
+
+;; (defthm bits-trunc
+;;   (implies (and (>= x (expt 2 (1- n)))
+;;                 (< x (expt 2 n))
+;;                 (integerp x) (> x 0)
+;;                 (integerp m) (>= m n)
+;;                 (integerp n) (> n k)
+;;                 (integerp k) (> k 0)
+;;                 )
+;;            (= (trunc x k)
+;;               (land x (- (expt 2 m) (expt 2 (- n k))) n)))
+;;   :hints (("Goal" :use bits-trunc-original))
+;;   :rule-classes ())
+
+(defthm trunc-land
+  (implies (and (>= x (expt 2 (1- n)))
+                (< x (expt 2 n))
+                (integerp x) (> x 0)
+                (integerp m) (>= m n)
+                (integerp n) (> n k)
+                (integerp k) (> k 0)
+                )
+           (= (trunc x k)
+              (land x (- (expt 2 m) (expt 2 (- n k))) n)))
+  :hints (("Goal" :use bits-trunc-original))
+  :rule-classes ())
+
+(defthm bits-trunc
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp k)
+                (> k 0))
+           (= (trunc x k)
+              (* (expt 2 (- n k))
+                 (bits x (1- n) (- n k)))))
+  :hints (("Goal" :use ((:instance bits-trunc-2))))
+  :rule-classes ())
+
+; adapted from fadd.lisp:
+
+(include-book "fadd")
+
+(defthm gen-extend
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp k)
+                (> i k)
+                (>= k j)
+                (>= j 0))
+           (equal (gen x y i j)
+                  (lior (gen x y i (1+ k))
+                        (land (prop x y i (1+ k))
+                              (gen x y k j)
+                              1)
+                        1)))
+  :hints (("Goal" :use gen-extend-original))
+  :rule-classes nil)
+
+(defthm prop-extend
+  (implies (and (integerp i)
+                (integerp j)
+                (integerp k)
+                (> i k)
+                (>= k j)
+                (>= j 0))
+           (equal (prop x y i j)
+                  (land (prop x y i (1+ k))
+                        (prop x y k j)
+                        1)))
+  :hints (("Goal" :use prop-extend-original))
+  :rule-classes ())
+
+(defthm gen-special-case
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (bitn (+ (bits x i j) (bits y i j)) (- i j)) 0))
+           (equal (gen x y i j)
+                  (lior (bitn x i) (bitn y i) 1)))
+  :hints (("Goal" :use gen-special-case-original))
+  :rule-classes ())
+
+(defthm land-gen-0
+  (implies (and (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0)
+                (= (land (bits x i j) (bits y i j) (1+ (- i j))) 0))
+           (equal (gen x y i j) 0))
+  :hints (("Goal" :use land0-gen-0)))
+
+(defthm bits-sum-plus-1
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp i)
+                (integerp j)
+                (>= i j)
+                (>= j 0))
+           (equal (bits (+ 1 x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (lior (prop x y (1- j) 0) 
+                                 (gen x y (1- j) 0) 
+                                 1))
+                        (- i j) 0)))
+  :hints (("Goal" :use bits-sum-plus-1-with-prop-gen-original))
+  :rule-classes ())
+
+(defthm add-3
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n)
+                (bvecp z n))
+           (equal (+ x y z)
+                  (+ (lxor x (lxor y z n) n)
+                     (* 2 (lior (land x y n)
+                                (lior (land x z n)
+                                      (land y z n)
+                                      n)
+                                n)))))
+  :hints (("Goal" :use add-3-original))
+  :rule-classes ())
+
+(defthm add-2
+  (implies (and (not (zp n))
+                (bvecp x n)
+                (bvecp y n))
+           (equal (+ x y)
+                  (+ (lxor x y n)
+                     (* 2 (land x y n)))))
+  :hints (("Goal" :use add-2-original))
+  :rule-classes ())
+
+(defthm top-thm-1
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a)
+                (integerp b))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lnot (lxor a b n) n) k 0) 0)))
+  :hints (("Goal" :use top-thm-1-original))
+  :rule-classes ())
+
+(defund sigm (a b c n)
+  (if (= c 0)
+      (lnot (lxor a b n) n)
+    (lxor a b n)))
+
+(local-defthm sigm-is-sigm-0
+  (equal (sigm a b c n)
+         (sigm-0 a b c n))
+  :hints (("Goal" :in-theory (enable sigm-0 sigm))))
+
+(defund kap (a b c n)
+  (if (= c 0)
+      (* 2 (lior a b n))
+    (* 2 (land a b n))))
+
+(local-defthm kap-is-kap-0
+  (equal (kap a b c n)
+         (kap-0 a b c n))
+  :hints (("Goal" :in-theory (enable kap-0 kap))))
+
+(defund tau (a b c n)
+  (lnot (lxor0 (sigm a b c n) (kap a b c n) (1+ n)) (1+ n)))
+
+(local-defthm tau-is-tau-0
+  (equal (tau a b c n)
+         (tau-0 a b c n))
+  :hints (("Goal" :in-theory (enable tau-0 tau))))
+
+(defthm bvecp-sigm
+  (bvecp (sigm a b c n) n)
+  :hints (("Goal" :use bvecp-sigm-0 :in-theory (disable bvecp-sigm-0)))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm a b c n)))))
+
+(defthm bvecp-kap
+  (implies (and (integerp n) (<= 0 n))
+           (bvecp (kap a b c n) (1+ n)))
+  :hints (("Goal" :use bvecp-kap-0 :in-theory (disable bvecp-kap-0)))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap a b c n)))))
+
+(defthm bvecp-tau
+  (bvecp (tau a b c n) (1+ n))
+  :hints (("Goal" :use bvecp-tau-0 :in-theory (disable bvecp-tau-0)))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau a b c n)))))
+
+(defthm top-thm-2
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (lxor (lxor a b n) 
+                                     (cat (lior a b n) n c 1)
+                                     (1+ n)) 
+                               k 0) 
+                         0)))
+  :hints (("Goal" :use top-thm-2-original))
+  :rule-classes nil)
+
+(defthm top-thm-3
+  (implies (and (natp n)
+                (integerp a)
+                (integerp b)
+                (natp k)
+                (< k n))
+           (equal (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lnot (lxor (lxor a b n) 
+				           (cat (land a b n) n 0 1)
+					   (1+ n))
+				     (1+ n))
+			       k 0) 
+			 0)))
+  :hints (("Goal" :use top-thm-3-original))
+  :rule-classes ())
+
+(defthm lop-thm-1
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (= e (expo a))
+                (< (expo b) e)
+                (= lambda
+                   (lior (* 2 (mod a (expt 2 e)))
+                         (lnot (* 2 b) (1+ e))
+                         (1+ e))))
+           (or (= (expo (- a b)) (expo lambda))
+               (= (expo (- a b)) (1- (expo lambda)))))
+  :hints (("Goal" :use lop-thm-1-original))
+  :rule-classes ())
+
+(defun lamt (a b e)
+  (lxor a (lnot b (1+ e)) (1+ e)))
+
+(defun lamg (a b e)
+  (land a (lnot b (1+ e)) (1+ e)))
+
+(defun lamz (a b e)
+  (lnot (lior a (lnot b (1+ e)) (1+ e)) (1+ e)))
+
+(defun lam1 (a b e)
+  (land (bits (lamt a b e) e 2) 
+	(land (bits (lamg a b e) (1- e) 1)
+	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam2 (a b e)
+  (land (lnot (bits (lamt a b e) e 2) (1- e))
+	(land (bits (lamz a b e) (1- e) 1)
+	      (lnot (bits (lamz a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam3 (a b e)
+  (land (bits (lamt a b e) e 2) 
+	(land (bits (lamz a b e) (1- e) 1)
+	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam4 (a b e)
+  (land (lnot (bits (lamt a b e) e 2) (1- e))
+	(land (bits (lamg a b e) (1- e) 1)
+	      (lnot (bits (lamg a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam0 (a b e)
+  (lior (lam1 a b e)
+	(lior (lam2 a b e)
+	      (lior (lam3 a b e)
+		    (lam4 a b e)
+		    (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lamb (a b e)
+  (+ (* 2 (lam0 a b e))
+     (lnot (bitn (lamt a b e) 0) 1)))
+
+(defthm lop-thm-2
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1))
+           (and (not (= (lamb a b e) 0))
+                (or (= (expo (- a b)) (expo (lamb a b e)))
+                    (= (expo (- a b)) (1- (expo (lamb a b e)))))))
+  :hints (("Goal" :use lop-thm-2-original))
+  :rule-classes ())
+
+(defthm land-gen-0-cor
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n i)
+                (>= i j)
+                (>= j 0)
+                (= (land x y n) 0))
+           (equal (bits (+ x y) i j)
+                  (+ (bits x i j) (bits y i j))))
+  :hints (("Goal" :use land-gen-0-cor-original))
+  :rule-classes ())
+
+; Start proof of lior-plus from add-2.
+
+(local (in-theory (e/d (binary-land binary-lior binary-lxor)
+                       (land-is-land0 lior-is-lior0 lxor-is-lxor0))))
+
+(local-defthm lxor-is-lior
+  (implies (equal (land x y n) 0)
+           (equal (lxor x y n)
+                  (lior x y n))))
+
+(defthmd lior-plus
+  (implies (= (land x y n) 0)
+           (equal (lior x y n)
+                  (+ (bits x (1- n) 0)
+                     (bits y (1- n) 0))))
+  :hints (("Goal" :use ((:instance add-2
+                                   (x (bits x (1- n) 0))
+                                   (y (bits y (1- n) 0))))
+           :in-theory (enable lior-bits-1 lior-bits-2
+                              land-bits-1 land-bits-2))))
+
+; Start proof of gen-plus:
+
+(encapsulate
+ ()
+
+ (local-defthm gen-plus-1-1
+   (implies (and (natp x)
+                 (natp y)
+                 (natp k)
+                 (bvecp z (1+ k))
+                 (= (land z y (1+ k)) 0)
+                 (= (gen x y k 0) 1))
+            (equal (+ (bits x k 0) (bits y k 0))
+                   (+ (expt 2 (1+ k))
+                      (bits (+ x y) k 0))))
+   :hints (("Goal" :use ((:instance gen-val-cor2 (i k)))))
+   :rule-classes nil)
+
+ (local-defthm gen-plus-1-2
+   (implies (and (natp x)
+                 (natp y)
+                 (natp k)
+                 (bvecp z (1+ k))
+                 (= (land z y (1+ k)) 0))
+            (equal (+ (bits y k 0) (bits z k 0))
+                   (bits (+ y z) k 0)))
+   :hints (("Goal" :use ((:instance land-gen-0-cor
+                                    (x y) (y z) (i k) (j 0) (n (1+ k))))
+            :in-theory (enable bvecp)))
+   :rule-classes nil)
+
+ (local-defthm gen-plus-1-3
+   (< (bits x i j)
+      (expt 2 (1+ (- i j))))
+   :hints (("Goal"
+            :use ((:instance bits-upper-bound-2 (z (expt 2 (1+ (- i j))))))))
+   :rule-classes nil)
+                                   
+ (local-defthm gen-plus-1
+   (implies (and (natp x)
+                 (natp y)
+                 (natp k)
+                 (bvecp z (1+ k))
+                 (= (land z y (1+ k)) 0)
+                 (= (gen x y k 0) 1))
+            (< (+ (bits (+ x y) k 0)
+                  (bits z k 0))
+               (expt 2 (1+ k))))
+   :hints (("Goal" :use (gen-plus-1-1
+                         gen-plus-1-2
+                         (:instance gen-plus-1-3 (x x) (i k) (j 0))
+                         (:instance gen-plus-1-3 (x (+ y z)) (i k) (j 0)))
+            :in-theory (disable land)))
+   :rule-classes nil)
+
+ (defthmd gen-plus
+   (implies (and (natp x)
+                 (natp y)
+                 (natp k)
+                 (bvecp z (1+ k))
+                 (= (land z y (1+ k)) 0)
+                 (= (gen x y k 0) 1))
+            (equal (gen (+ x y) z k 0) 0))
+   :hints (("Goal" :use gen-plus-1
+            :in-theory (enable gen-val)))))
+
+; Start proof of gen-extend-3.
+
+(local (in-theory (enable bvecp-bits-0))) ; needed for gen-extend-3-a and more
+
+(local-defthm gen-extend-3-a-1
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                (= (land y z (1+ j)) 0))
+           (equal (gen (+ x y) z i (+ 1 j))
+                  0))
+  :rule-classes nil)
+
+(defthmd gen-extend-3-a
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                (= (land y z (1+ j)) 0))		  
+           (equal (gen (+ x y) z i 0)
+                  (land (prop (+ x y) z i (1+ j))
+                        (gen (+ x y) z j 0)			  
+                        1)))
+  :hints (("Goal" :use ((:instance gen-extend
+                                   (x (+ x y))
+                                   (y z)
+                                   (i i)
+                                   (j 0)
+                                   (k j))
+                        gen-extend-3-a-1))))
+
+(local-defthm bitn-0-1-rewrite
+  (implies (not (equal (bitn x n) 0))
+           (equal (bitn x n) 1))
+  :hints (("Goal" :use bitn-0-1)))
+
+(local-defthm gen-is-0-or-1
+  (implies (and (natp x)
+                (natp y)
+                (not (equal (gen x y i j) 1)))
+           (equal (gen x y i j) 0))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-1-1-1
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                 (= (land y z (1+ j)) 0)
+                (equal (gen (+ x y) z j 0) 1))
+           (equal (gen x y j 0) 0))
+  :hints (("Goal" :use ((:instance gen-plus (k j))
+                        (:instance gen-is-0-or-1
+                                   (i j) (j 0)))))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-1-1
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                (= (land y z (1+ j)) 0)
+                (equal (gen (+ x y) z j 0) 1))		  
+           (equal (bits (+ x y) i (1+ j))
+                  (bits (+ (bits x i (1+ j))
+                           (bits y i (1+ j)))
+                        (- i (1+ j))
+                        0)))
+  :hints (("Goal" :use ((:instance bits-sum (j (1+ j)))
+                        gen-extend-3-b-1-1-1)))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-1
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                (equal (gen (+ x y) z j 0) 1)
+                (= (land y z (1+ j)) 0))		  
+           (iff (equal (prop (+ x y) z i (1+ j))
+                       1)
+                (equal (bits (+ (bits x i (1+ j))
+                                (bits y i (1+ j)))
+                             (- i (1+ j))
+                             0)
+                       (1- (expt 2 (- i j))))))
+  :hints (("Goal" :use (gen-extend-3-b-1-1
+                        (:instance prop-val
+                                   (x (+ x y))
+                                   (y z)
+                                   (i i)
+                                   (j (1+ j))))))
+  :rule-classes nil)
+
+(local-defthm prop-is-0-or-1
+  (implies (not (equal (prop x y i j) 1))
+           (equal (prop x y i j) 0))
+  :rule-classes nil)
+
+; Most or all of the following are needed for gen-extend-3-b-2-1-2, and this is
+; a good idea anyhow.
+(local (in-theory (e/d (bits-nonnegative-integerp-type)
+                       (bits-slice-zero-gen))))
+
+(local-defthm gen-extend-3-b-2-1-1-1
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y))
+           (equal (+ (bits x i (1+ j))
+                     (bits y i (1+ j)))
+                  (bits (+ (bits x i (1+ j))
+                           (bits y i (1+ j)))
+                        (- i j)
+                        0)))
+  :hints (("Goal" :use ((:instance bits-bvecp
+                                   (x x) (i i) (j (1+ j)) (k (- i j)))
+                        (:instance bits-bvecp
+                                   (x y) (i i) (j (1+ j)) (k (- i j)))
+                        (:instance bits-tail
+                                   (x (+ (bits x i (+ 1 j))
+                                         (bits y i (+ 1 j))))
+                                   (i (+ i (* -1 j)))))
+           :expand ((expt 2 (+ 1 i (* -1 j))))
+           :in-theory (enable bvecp)))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-2-1-1-2
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y))
+           (equal (bits (+ (bits x i (1+ j))
+                           (bits y i (1+ j)))
+                        (- i j)
+                        0)
+                  (+ (* (expt 2 (- i j))
+                        (bitn (+ (bits x i (1+ j))
+                                 (bits y i (1+ j)))
+                              (- i j)))
+                     (bits (+ (bits x i (1+ j))
+                              (bits y i (1+ j)))
+                           (1- (- i j))
+                           0))))
+  :hints (("Goal" :use ((:instance bitn-plus-bits
+                                   (x (+ (bits x i (1+ j))
+                                         (bits y i (1+ j))))
+                                   (n (- i j))
+                                   (m 0)))))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-2-1-1
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (equal (bits (+ (bits x i (1+ j))
+                                (bits y i (1+ j)))
+                             (- i (1+ j))
+                             0)
+                       (1- (expt 2 (- i j)))))
+           (equal (+ (bits x i (1+ j))
+                     (bits y i (1+ j)))
+                  (+ (* (expt 2 (- i j))
+                        (bitn (+ (bits x i (1+ j))
+                                 (bits y i (1+ j)))
+                              (- i j)))
+                     (1- (expt 2 (- i j))))))
+  :hints (("Goal" :use (gen-extend-3-b-2-1-1-1 gen-extend-3-b-2-1-1-2)))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-2-1-2
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y))
+           (< (+ (bits x i (1+ j))
+                 (bits y i (1+ j)))
+              (1- (+ (expt 2 (- i j))
+                     (expt 2 (- i j))))))
+  :hints (("Goal" :use ((:instance bits-bvecp
+                                   (x x) (i i) (j (1+ j)) (k (- i j)))
+                        (:instance bits-bvecp
+                                   (x y) (i i) (j (1+ j)) (k (- i j)))
+                        (:instance expt-2-positive-integer-type
+                                   (i (+ i (* -1 j)))))
+           :in-theory (e/d (bvecp) (a14 power2-integer expt2-integer))))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-2-1
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (equal (bits (+ (bits x i (1+ j))
+                                (bits y i (1+ j)))
+                             (- i (1+ j))
+                             0)
+                       (1- (expt 2 (- i j)))))
+           (equal (+ (bits x i (1+ j))
+                     (bits y i (1+ j)))
+                  (1- (expt 2 (- i j)))))
+  :hints (("Goal" :use (gen-extend-3-b-2-1-1 gen-extend-3-b-2-1-2)))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-2-2-1
+  (implies (and (natp i)
+                (natp j)
+                (> i j))
+           (equal (bits (1- (expt 2 (- i j)))
+                        (- i (1+ j))
+                        0)
+                  (1- (expt 2 (- i j)))))
+  :hints (("Goal" :in-theory (enable bvecp bits-does-nothing (expo))))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-2-2
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (equal (+ (bits x i (1+ j))
+                          (bits y i (1+ j)))
+                       (1- (expt 2 (- i j)))))
+           (equal (bits (+ (bits x i (1+ j))
+                           (bits y i (1+ j)))
+                        (- i (1+ j))
+                        0)
+                  (1- (expt 2 (- i j)))))
+  :hints (("Goal" :use gen-extend-3-b-2-2-1))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b-2
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y))
+           (iff (equal (bits (+ (bits x i (1+ j))
+                                (bits y i (1+ j)))
+                             (- i (1+ j))
+                             0)
+                       (1- (expt 2 (- i j))))
+                (equal (+ (bits x i (1+ j))
+                          (bits y i (1+ j)))
+                       (1- (expt 2 (- i j))))))
+  :hints (("Goal" :use (gen-extend-3-b-2-1 gen-extend-3-b-2-2)))
+  :rule-classes nil)
+
+(local-defthm gen-extend-3-b
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                (= (land y z (1+ j)) 0)
+                (equal (gen (+ x y) z j 0) 1))
+           (equal (prop (+ x y) z i (1+ j))
+                  (prop x y i (1+ j))))
+  :hints (("Goal" :use (gen-extend-3-b-1
+                        (:instance prop-val (j (1+ j)))
+                        gen-extend-3-b-2
+                        (:instance prop-is-0-or-1
+                                   (x (+ x y))
+                                   (y z)
+                                   (i i)
+                                   (j (1+ j)))
+                        (:instance prop-is-0-or-1
+                                   (x x)
+                                   (y y)
+                                   (i i)
+                                   (j (1+ j))))
+           :in-theory (enable bits-reduce)
+           ))
+  :rule-classes nil)
+
+(defthmd gen-extend-3
+  (implies (and (natp i)
+                (natp j)
+                (> i j)
+                (natp x)
+                (natp y)
+                (bvecp z (1+ j))
+                (= (land y z (1+ j)) 0))		  
+           (equal (gen (+ x y) z i 0)
+                  (land (prop x y i (1+ j))
+                        (gen (+ x y) z j 0)			  
+                        1)))
+  :hints (("Goal" :use (gen-extend-3-a
+                        gen-extend-3-b
+                        (:instance gen-is-0-or-1
+                                   (x (+ x y))
+                                   (y z)
+                                   (i j)
+                                   (j 0)))
+           :in-theory (enable bvecp) ; need (natp z)
+           )))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lextra0.lisp acl2-6.3/books/rtl/rel9/support/support/lextra0.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lextra0.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lextra0.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,78 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "land0")
+(include-book "lior0")
+(include-book "lxor0")
+(local (include-book "lextra-proofs"))
+
+;theorems mixing two or more of the new logical operators.
+
+;BOZO really the -1 and -2 names below should be switched?
+
+(deflabel lextra0-start)
+
+(defthm lior0-land0-1
+  (equal (lior0 x (land0 y z n) n)
+         (land0 (lior0 x y n) (lior0 x z n) n)))
+
+(defthm lior0-land0-2
+  (equal (lior0 (land0 y z n) x n)
+         (land0 (lior0 x y n) (lior0 x z n) n)))
+
+(defthm land0-lior0-1
+  (equal (land0 x (lior0 y z n) n)
+         (lior0 (land0 x y n) (land0 x z n) n)))
+
+(defthm land0-lior0-2
+  (equal (land0 (lior0 y z n) x n)
+         (lior0 (land0 x y n) (land0 x z n) n)))
+
+(defthm lior0-land0-lxor0
+  (equal (lior0 (land0 x y n) (lior0 (land0 x z n) (land0 y z n) n) n)
+         (lior0 (land0 x y n) (land0 (lxor0 x y n) z n) n)))
+
+(defthm lxor0-rewrite
+  (equal (lxor0 x y n)
+         (lior0 (land0 x (lnot y n) n)
+               (land0 y (lnot x n) n)
+               n)))
+
+(defthm lnot-lxor0
+  (equal (lnot (lxor0 x y n) n)
+         (lxor0 (lnot x n) y n)))
+
+(defthm lnot-lior0
+  (equal (lnot (lior0 x y n) n)
+         (land0 (lnot x n) (lnot y n) n)))
+
+(defthm lnot-land0
+  (equal (lnot (land0 x y n) n)
+         (lior0 (lnot x n) (lnot y n) n)))
+
+(deflabel lextra0-end)
+
+(in-theory (current-theory 'lextra0-start))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lior.lisp acl2-6.3/books/rtl/rel9/support/support/lior.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lior.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lior.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,590 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Port lior0 theorems to lior.  The original definition of lior (in rel4) was
+; that of lior0 in the current release.  So the port is to keep all the lemmas
+; about lior0 and then use equality of lior0 with lior to port them to lior.
+
+(in-package "ACL2")
+
+(include-book "lior0")
+(local (include-book "top1"))
+
+(defun binary-lior (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (or (equal (bitn x 0) 1)
+                      (equal (bitn y 0) 1))
+                  1
+                0))
+             (t (+ (* 2 (binary-lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lior (mod x 2) (mod y 2) 1))))
+       :exec ; (lior0 x y n)
+       (logior (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lior (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior x y n) -- the base case
+         `(binary-lior ,@x))
+        (t         
+         `(binary-lior ,(car x)
+                       (lior ,@(cdr x))
+                       ,(car (last x))))))
+
+
+(encapsulate
+ ()
+
+ (local
+  (defun p0 (x y n)
+    (equal (lior x y n)
+           (lior0 x y n))))
+
+ (local
+  (defthm p0-holds-inductive-step
+    (implies (and (not (zp n))
+                  (not (equal n 1))
+                  (p0 (fl (* x 1/2))
+                      (fl (* y 1/2))
+                      (+ -1 n))
+                  (p0 (mod x 2) (mod y 2) 1))
+             (p0 x y n))
+    :hints (("Goal" :use (lior0-def binary-lior)))))
+
+ (local
+  (defthm p0-holds-base-1
+    (p0 x y 1)
+    :hints (("Goal" :in-theory (enable bitn)
+             :expand ((binary-lior0 x y 1))))))
+
+ (local
+  (defthm p0-holds-base-0
+    (implies (zp n)
+             (p0 x y n))
+    :hints (("Goal" :expand ((binary-lior0 x y n))))))
+
+ (local
+  (defthm p0-holds
+    (p0 x y n)
+    :hints (("Goal" :induct (lior x y n)
+             :in-theory (disable p0)))
+    :rule-classes nil))
+
+ (defthmd lior-is-lior0
+   (equal (lior x y n)
+          (lior0 x y n))
+   :hints (("Goal" :use p0-holds))))
+
+(local (in-theory (e/d (lior-is-lior0))))
+
+(add-macro-alias lior binary-lior)
+
+(defthm lior-nonnegative-integer-type
+  (and (integerp (lior x y n))
+       (<= 0 (lior x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior) is no better than lior-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior-natp
+  (natp (lior x y n)))
+
+(defthm lior-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (lior x y n)
+                  0)))
+
+(defthmd lior-bvecp-simple
+  (bvecp (lior x y n) n))
+
+(defthm lior-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior x y n) k)))
+
+
+;;
+;; Rules to normalize lior terms (recall that LIOR is a macro for BINARY-LIOR):
+;;
+
+;; allow sizes to differ on these?
+
+(defthm lior-associative
+  (equal (lior (lior x y n) z n)
+         (lior x (lior y z n) n)))
+
+(defthm lior-commutative
+  (equal (lior y x n)
+         (lior x y n)))
+
+(defthm lior-commutative-2
+  (equal (lior y (lior x z n) n)
+         (lior x (lior y z n) n)))
+
+(defthm lior-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (lior x (lior y z n) n)
+                  (lior (lior x y n) z n))))
+
+(defthm lior-0
+  (implies (case-split (bvecp y n))
+           (equal (lior 0 y n)
+                  y)))
+
+;nicer than the analogous rule for logior?
+(defthm lior-1
+  (implies (case-split (bvecp y 1))
+           (equal (lior 1 y 1)
+                  1)))
+
+(defthm lior-self
+  (implies (and (case-split (bvecp x n))
+                (case-split (integerp n)))
+           (equal (lior x x n)
+                  x)))
+
+(defthmd bits-lior-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lior x y n) i j)
+                  (lior (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j))))))
+
+(defthmd bits-lior-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lior x y n) i j)
+                  (lior (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j))))))
+
+;notice the call to MIN in the conclusion
+(defthm bits-lior
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (lior x y n) i j)
+                  (lior (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j))))))
+
+(defthmd bitn-lior-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior x y n) m)
+                  (lior (bitn x m) 
+                        (bitn y m) 
+                        1))))
+
+(defthmd bitn-lior-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior x y n) m)
+                  0)))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-lior
+  (implies (and (case-split (<= 0 k))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior x y n) k)
+                  (if (< k n)
+                      (lior (bitn x k) 
+                            (bitn y k) 
+                            1)
+                    0))))
+
+;or could wrap bits around conclusion?
+(defthm lior-equal-0
+  (implies (and (case-split (bvecp x n))
+                (case-split (bvecp y n))
+                (case-split (integerp n))
+                )
+           (equal (equal 0 (lior x y n))
+                  (and (equal x 0)
+                       (equal y 0)))))
+
+(defthm lior-of-single-bits-equal-0
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 0 (lior x y 1))
+                  (and (equal x 0)
+                       (equal y 0)))))
+
+(defthm lior-of-single-bits-equal-1
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 1 (lior x y 1))
+                  (or (equal x 1)
+                      (equal y 1)))))
+
+(defthm lior-ones
+  (implies (and (case-split (bvecp x n))
+                (case-split (natp n)) ;gen
+                )
+           (equal (lior (1- (expt 2 n)) x n)
+                  (1- (expt 2 n))))
+  :hints (("Goal" :use lior0-ones))
+  :rule-classes ())
+
+;lior-with-all-ones will rewrite (lior x n) [note there's only one value being ANDed], because (lior x n)
+;expands to (BINARY-LIOR X (ALL-ONES N) N) - now moot???
+(defthm lior-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (lior (all-ones n) x n)
+                  (all-ones n))))
+
+(defthm lior-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep n)
+                              (equal (cadr k) (1- (expt 2 (cadr n))))))
+                (force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+                (case-split (bvecp x n)))
+           (equal (lior k x n)
+                  (1- (expt 2 n))))
+  :hints (("Goal" :use lior-ones)))
+
+(defthm lior-def-original
+  (implies (and (< 0 n)
+                (integerp n))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (mod x 2) (mod y 2) 1))))
+  :hints (("Goal" :use lior0-def))
+  :rule-classes ())
+
+(defthm lior-mod-2
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (> n 0))
+           (equal (mod (lior x y n) 2)
+                  (lior (mod x 2) (mod y 2) 1)))
+  :hints (("Goal" :use lior0-mod-2)))
+
+(defthm lior-fl-2
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (> n 0))
+           (equal (fl (/ (lior x y n) 2))
+                  (lior (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+  :hints (("Goal" :use lior0-fl-2)))
+
+(in-theory (disable lior-mod-2 lior-fl-2))
+
+;BOZO rename
+(defthm lior-x-y-0
+  (equal (lior x y 0) 0))
+
+(defthm lior-reduce
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (< n m)
+                (natp n) ;gen?
+                (natp m)
+                )
+           (equal (lior x y m) (lior x y n))))
+
+;whoa! this is a *lower* bound !
+;make alt version?
+(defthm lior-bnd
+  (implies (case-split (bvecp x n))
+           (<= x (lior x y n)))
+  :rule-classes (:rewrite :linear))
+
+;get rid of the bvecp hyps (do that for many lemmas like this one)
+(defthm lior-with-shifted-arg
+  (implies (and (bvecp y m)
+                (bvecp x (- n m))
+                (<= m n)
+                (natp m)
+                (integerp n)
+                )
+           (= (lior (* (expt 2 m) x) y n)
+              (+ (* (expt 2 m) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :use lior0-with-shifted-arg)))
+
+(defthm lior-shift-original
+  (implies (and (bvecp x (- n m))
+                (bvecp y (- n m))
+                (integerp n) ;(not (zp n))
+                (natp m)
+                (<= m n)
+                )
+           (= (lior (* (expt 2 m) x)
+                    (* (expt 2 m) y)
+                    n)
+              (* (expt 2 m) (lior x y (- n m)))))
+  :rule-classes ()
+  :hints (("Goal" :use lior0-shift)))
+
+(defthm lior-expt
+  (implies (and (natp n)
+                (natp k)
+                (< k n))
+           (= (lior x (expt 2 k) n)
+              (+ (bits x (1- n) 0)
+                 (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ()
+  :hints (("Goal" :use lior0-expt)))
+
+;interesting.  not the same as lior-bvecp (here, m can be smaller than n)
+;rename !!
+(defthm lior-bvecp-2
+  (implies (and (bvecp x m)
+                (bvecp y m)
+                )
+           (bvecp (lior x y n) m)))
+
+(defthm lior-upper-bound
+  (< (lior x y n) (expt 2 n))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior-upper-bound-tight
+  (implies (<= 0 n)
+           (<= (lior x y n) (1- (expt 2 n))))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior-fl-1
+  (equal (lior (fl x) y n)
+         (lior x y n)))
+
+(defthm lior-fl-2-eric
+  (equal (lior x (fl y) n)
+         (lior x y n)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Added in move to rel5 (should perhaps be in a -proofs file):
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Start proof of fl-lior (copied from proof of fl-land).
+
+(local
+ (defun fl-lior-induction (k n)
+   (if (zp k)
+       n
+     (fl-lior-induction (1- k) (1+ n)))))
+
+
+(local
+ (defthmd fl-lior-induction-step-1
+   (implies (not (zp k))
+            (equal (lior (fl (* x (/ (expt 2 k))))
+                         (fl (* y (/ (expt 2 k))))
+                         n)
+                   (lior (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
+                         (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
+                         n)))
+   :hints (("Goal" :in-theory (disable lior-fl-1
+                                       lior-fl-2-eric
+                                       lior-is-lior0
+                                       fl/int-rewrite)
+            :expand ((expt 2 k))
+            :use ((:instance fl/int-rewrite
+                             (x (* x (/ (expt 2 (1- k)))))
+                             (n 2))
+                  (:instance fl/int-rewrite
+                             (x (* y (/ (expt 2 (1- k)))))
+                             (n 2)))))))
+
+(local
+ (defthmd fl-lior-induction-step-2
+   (equal (lior (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
+                (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
+                n)
+          (fl (/ (lior (fl (* x (/ (expt 2 (1- k)))))
+                       (fl (* y (/ (expt 2 (1- k)))))
+                       (1+ n))
+                 2)))
+   :hints (("Goal" :in-theory (disable lior-fl-1
+                                       lior-fl-2-eric
+                                       lior-is-lior0
+                                       fl/int-rewrite)
+            :expand ((lior (fl (* x (/ (expt 2 (1- k)))))
+                           (fl (* y (/ (expt 2 (1- k)))))
+                           (1+ n)))))))
+
+(local
+ (defthmd fl-lior-induction-step-3
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (lior x y (+ k n))))
+                        (lior (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (/ (lior (fl (* x (/ (expt 2 (1- k)))))
+                                (fl (* y (/ (expt 2 (1- k)))))
+                                (1+ n))
+                          2))
+                   (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
+                                 (lior x y (+ k n))))
+                          2))))))
+
+(local
+ (defthmd fl-lior-induction-step-4
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (lior x y (+ k n))))
+                        (lior (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
+                                 (lior x y (+ k n))))
+                          2))
+                   (fl (* (/ (expt 2 k))
+                          (lior x y (+ k n))))))
+   :hints (("Goal" :expand ((expt 2 k))))))
+
+(local
+ (defthm fl-lior-induction-step
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (lior x y (+ k n))))
+                        (lior (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (* (/ (expt 2 k))
+                          (lior x y (+ k n))))
+                   (lior (fl (* x (/ (expt 2 k))))
+                         (fl (* y (/ (expt 2 k))))
+                         n)))
+   :hints (("Goal" :use (fl-lior-induction-step-1
+                         fl-lior-induction-step-2
+                         fl-lior-induction-step-3
+                         fl-lior-induction-step-4)))))
+
+(defthmd fl-lior
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lior x y (+ n k)) (expt 2 k)))
+                  (lior (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :induct (fl-lior-induction k n)
+           :in-theory (disable lior-is-lior0 lior-fl-1 lior-fl-2-eric))))
+
+(defthmd lior-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lior x y n)
+                  (+ (* 2 (lior (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lior (bitn x 0) (bitn y 0) 1))))
+  :hints (("Goal" :in-theory (enable bitn-rec-0)
+           :use lior-def-original)))
+
+(local
+ (defun lior-shift-induction (n k)
+   (if (zp k)
+       (+ k n)
+     (lior-shift-induction (1- n) (1- k)))))
+
+(defthm lior-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lior (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lior x y (- n k)))))
+  :hints (("Goal" :induct (lior-shift-induction n k)
+           :expand ((expt 2 k))
+           :in-theory (e/d (bitn-negative-bit-of-integer)
+                           (lior-is-lior0))))
+  :rule-classes ())
+
+; See land.lisp for analogous lemma and a hand proof of it.
+(defthmd mod-lior
+  (implies (and (integerp n)
+                (<= k n))
+           (equal (mod (lior x y n) (expt 2 k))
+                  (lior x y k)))
+  :hints (("Goal"
+           :use
+           ((:instance bits-lior (x x) (y y) (n k) (i (1- k)) (j 0))
+            (:instance mod-bits (x (lior x y n)) (i (1- n)) (j k))))))
+
+(defthmd lior-bits-1
+  (equal (lior (bits x (1- n) 0)
+               y
+               n)
+         (lior x y n))
+  :hints (("Goal" :use lior0-bits-1)))
+
+(defthmd lior-bits-2
+  (equal (lior x
+               (bits y (1- n) 0)
+               n)
+         (lior x y n))
+  :hints (("Goal" :use lior0-bits-2)))
+
+(defthm lior-base
+  (equal (lior x y 1)
+         (if (or (equal (bitn x 0) 1)
+                 (equal (bitn y 0) 1))
+             1
+           0))
+  :hints (("Goal" :use lior0-base))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lior0-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/lior0-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lior0-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lior0-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,640 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+This book is about LIOR0, a nice version of LOGIOR.  LIOR0 takes an extra size parameter, N, and always returns
+a bit vector of length N.
+
+Todo:
+add versions like logand-expt-2 and logand-expt-4
+prove (elsewhere) lemmas mixing lior0 with other functions
+what should lior0 of non-ints be?
+|#
+
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(local (include-book "all-ones"))
+(local (include-book "merge"))
+(local (include-book "bvecp"))
+(local (include-book "logior"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "../../arithmetic/top"))
+
+(defund binary-lior0 (x y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logior (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defmacro lior0 (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior0 x y n) -- the base case
+         `(binary-lior0 ,@x))
+        (t         
+         `(binary-lior0 ,(car x)
+                       (lior0 ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior0)) to refer to binary-lior0.
+(add-macro-alias lior0 binary-lior0)
+
+(defthm lior0-nonnegative-integer-type
+  (and (integerp (lior0 x y n))
+       (<= 0 (lior0 x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior0) is no better than lior0-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior0)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior0-natp
+  (natp (lior0 x y n)))
+
+(defthm lior0-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (lior0 x y n)
+                  0))
+  :hints (("Goal" :cases ((acl2-numberp n))
+           :in-theory (enable lior0)))
+  )
+
+(defthmd lior0-bvecp-simple
+  (bvecp (lior0 x y n) n)
+  :hints (("Goal" :cases ((natp n))
+           :in-theory (enable lior0))))
+
+(defthm lior0-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior0 x y n) k))
+  :hints (("Goal" :in-theory (disable lior0-bvecp-simple)
+           :use lior0-bvecp-simple)))
+
+
+;;
+;; Rules to normalize lior0 terms (recall that LIOR0 is a macro for BINARY-LIOR0):
+;;
+
+;; allow sizes to differ on these?
+
+(defthm lior0-associative
+  (equal (lior0 (lior0 x y n) z n)
+         (lior0 x (lior0 y z n) n))
+  :hints (("Goal" :cases ((natp n))
+           :in-theory (enable lior0 bits-tail))))
+
+(defthm lior0-commutative
+  (equal (lior0 y x n)
+         (lior0 x y n))
+  :hints (("Goal" :in-theory (enable lior0))))
+
+(defthm lior0-commutative-2
+  (equal (lior0 y (lior0 x z n) n)
+         (lior0 x (lior0 y z n) n))
+  :hints (("Goal"  :cases ((natp n))
+           :in-theory (enable lior0 bits-tail))))
+
+(defthm lior0-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (lior0 x (lior0 y z n) n)
+                  (lior0 (lior0 x y n) z n))))
+
+(defthm lior0-0
+  (implies (case-split (bvecp y n))
+           (equal (lior0 0 y n)
+                  y))
+  :hints (("Goal" :in-theory (enable lior0 bits-tail))))
+
+;nicer than the analogous rule for logior?
+(defthm lior0-1
+  (implies (case-split (bvecp y 1))
+           (equal (lior0 1 y 1)
+                  1))
+  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+(defthm lior0-self
+  (implies (and (case-split (bvecp x n))
+                (case-split (integerp n)))
+           (equal (lior0 x x n)
+                  x))
+  :hints (("Goal" :in-theory (enable lior0 bits-tail))))
+
+
+(defthmd bits-lior0-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lior0 x y n) i j)
+                  (lior0 (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable lior0 bits-logand))))
+
+
+(defthmd bits-lior0-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lior0 x y n) i j)
+                  (lior0 (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable lior0 bits-logand))))
+
+;notice the call to MIN in the conclusion
+(defthm bits-lior0
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (lior0 x y n) i j)
+                  (lior0 (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j)))))
+  :hints (("Goal" :in-theory (enable bits-lior0-1 bits-lior0-2))))
+
+(defthmd bitn-lior0-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior0 x y n) m)
+                  (lior0 (bitn x m) 
+                        (bitn y m) 
+                        1)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn)
+                              '(BITS-N-N-REWRITE)))))
+(defthmd bitn-lior0-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior0 x y n) m)
+                  0))
+  :hints (("Goal" :in-theory (enable BVECP-BITN-0))))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-lior0
+  (implies (and (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior0 x y n) m)
+                  (if (< m n)
+                      (lior0 (bitn x m) 
+                            (bitn y m) 
+                            1)
+                    0)))
+  :hints (("Goal" :in-theory (enable bitn-lior0-1 bitn-lior0-2))))
+
+
+
+;or could wrap bits around conclusion?
+(defthm lior0-equal-0
+  (implies (and (case-split (bvecp x n))
+                (case-split (bvecp y n))
+                (case-split (integerp n))
+                )
+           (equal (equal 0 (lior0 x y n))
+                  (and (equal x 0)
+                       (equal y 0))))
+  :hints (("Goal" :in-theory (enable lior0 bits-tail))))
+
+(defthm lior0-of-single-bits-equal-0
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 0 (lior0 x y 1))
+                  (and (equal x 0)
+                       (equal y 0))))
+  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+(defthm lior0-of-single-bits-equal-1
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 1 (lior0 x y 1))
+                  (or (equal x 1)
+                      (equal y 1))))
+  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+(defthm lior0-ones
+  (implies (and (case-split (bvecp x n))
+                (case-split (natp n)) ;gen
+                )
+           (equal (lior0 (1- (expt 2 n)) x n)
+                  (1- (expt 2 n))))
+  :rule-classes ()
+  :hints
+  (("goal"  :use logior-ones
+    :in-theory (enable lior0 bits-tail)
+    )))
+
+;lior0-with-all-ones will rewrite (lior0 x n) [note there's only one value being ANDed], because (lior0 x n)
+;expands to (BINARY-LIOR0 X (ALL-ONES N) N) - now moot???
+(defthm lior0-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (lior0 (all-ones n) x n)
+                  (all-ones n)))
+  :hints
+  (("goal" :use lior0-ones
+    :in-theory (enable all-ones))))
+
+(defthm lior0-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep n)
+                              (equal (cadr k) (1- (expt 2 (cadr n))))))
+                (force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+                (case-split (bvecp x n)))
+           (equal (lior0 k x n)
+                  (1- (expt 2 n))))
+  :hints (("Goal"
+           :use lior0-ones)))
+
+(local (in-theory (disable MOD-BY-2-REWRITE-TO-EVEN MOD-MULT-OF-N MOD-EQUAL-0 )))
+
+(encapsulate
+ ()
+
+ (local
+  (defthm lior0-def-integerp
+    (implies (and (integerp x)
+                  (integerp y)
+                  (> n 0)
+                  (integerp n))
+             (equal (lior0 x y n)
+                    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (lior0 (mod x 2) (mod y 2) 1))))
+    :rule-classes ()
+    :hints (("Goal" :in-theory (e/d (lior0 bits-fl-by-2)
+                                    ())
+             :use ((:instance logior-def (i (bits x (1- n) 0)) (j (bits y (1- n) 0)))
+                   (:instance mod012 (m x))
+                   (:instance mod012 (m y)))))))
+
+; Now we want to eliminate the (integerp x) and (integerp y) hypotheses from
+; lior0-def-integerp.  First suppose x is not rational.
+
+ (local
+  (defthm lior0-is-0-if-not-rational-1
+    (implies (not (rationalp x))
+             (equal (lior0 x y n)
+                    (lior0 0 y n)))
+    :hints (("Goal" :expand ((lior0 x y n)
+                             (lior0 0 y n))))))
+
+ (local
+  (defthm lior0-is-0-if-not-rational-2
+    (implies (not (rationalp y))
+             (equal (lior0 x y n)
+                    (lior0 x 0 n)))
+    :hints (("Goal" :expand ((lior0 x y n)
+                             (lior0 0 x n))))))
+
+ (local
+  (defthm fl-1/2-is-0-if-not-rational
+    (implies (not (rationalp x))
+             (equal (fl (* 1/2 x)) 0))
+    :hints (("Goal" :cases ((acl2-numberp x))))))
+
+ (local
+  (defthm mod-2-if-not-rational
+    (implies (not (rationalp x))
+             (equal (mod x 2)
+                    (fix x)))
+    :hints (("Goal" :expand ((mod x 2))))))
+
+ (local
+  (defthm lior0-fl-1
+    (equal (lior0 (fl x) y n)
+           (lior0 x y n))
+    :hints (("Goal" :expand ((lior0 y (fl x) n)
+                             (lior0 x y n))))))
+
+ (local
+  (defthm lior0-fl-2
+    (equal (lior0 y (fl x) n)
+           (lior0 y x n))
+    :hints (("Goal" :expand ((lior0 y (fl x) n)
+                             (lior0 x y n))))))
+
+ (local
+  (defthm lior0-def-rational-hack
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (>= n 0)
+                  (integerp n))
+             (equal (lior0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
+                    (lior0 (* 1/2 x) (* 1/2 y) n)))
+    :hints (("Goal" :expand ((lior0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
+                             (lior0 (* 1/2 x) (* 1/2 y) n))))))
+
+ (local
+  (defthm lior0-def-rational
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (> n 0)
+                  (integerp n))
+             (equal (lior0 x y n)
+                    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (lior0 (mod x 2) (mod y 2) 1))))
+    :rule-classes ()
+    :hints (("Goal"
+             :use ((:instance lior0-def-integerp (x (fl x)) (y (fl y))))
+             :in-theory (e/d (mod-fl-eric) (fl-mod))))))
+
+ (local
+  (defthm lior0-def-not-rational-1
+    (implies (and (not (rationalp x))
+                  (rationalp y)
+                  (> n 0)
+                  (integerp n))
+             (equal (lior0 x y n)
+                    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (lior0 (mod x 2) (mod y 2) 1))))
+    :hints (("Goal" :use ((:instance lior0-def-rational
+                                     (x 0)))))
+    :rule-classes nil))
+
+ (local
+  (defthm lior0-def-not-rational-2
+    (implies (and (rationalp x)
+                  (not (rationalp y))
+                  (> n 0)
+                  (integerp n))
+             (equal (lior0 x y n)
+                    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (lior0 (mod x 2) (mod y 2) 1))))
+    :hints (("Goal" :use ((:instance lior0-def-rational
+                                     (y 0)))))
+    :rule-classes nil))
+
+ (defthm lior0-def
+   (implies (and (> n 0)
+                 (integerp n))
+            (equal (lior0 x y n)
+                   (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                      (lior0 (mod x 2) (mod y 2) 1))))
+   :rule-classes ()
+   :hints (("Goal" :use (lior0-def-not-rational-1
+                         lior0-def-not-rational-2
+                         lior0-def-rational)))))
+
+
+(defthm lior0-mod-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (mod (lior0 x y n) 2)
+		    (lior0 (mod x 2) (mod y 2) 1)))
+  :hints (("Goal" :use (lior0-def
+			(:instance mod012 (m x))
+			(:instance mod012 (m y))
+			(:instance quot-mod (m (lior0 x y n)) (n 2))))))
+
+(defthm lior0-fl-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (fl (/ (lior0 x y n) 2))
+		    (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+  :hints (("Goal" :use (lior0-def
+			(:instance mod012 (m x))
+			(:instance mod012 (m y))
+			(:instance quot-mod (m (lior0 x y n)) (n 2))))))
+
+(in-theory (disable lior0-mod-2 lior0-fl-2))
+
+(defthm lior0-x-y-0
+    (equal (lior0 x y 0) 0)
+  :hints (("Goal" :in-theory (enable lior0))))
+
+(defthm lior0-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+                  (natp n)
+		  (natp m)
+		  )
+	     (equal (lior0 x y m) (lior0 x y n)))
+  :hints (("Goal" :in-theory (enable lior0))))
+
+;whoa! this is a *lower* bound !
+;make alt version?
+(defthm lior0-bnd
+  (implies (case-split (bvecp x n))
+           (<= x (lior0 x y n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :use ((:instance logior-bnd
+                                   (x (bits x (1- n) 0)) 
+				   (y (bits y (1- n) 0))))
+           :in-theory (enable bits-tail lior0))))
+
+;get rid of the bvecp hyps (do that for many lemmas like this one)
+(defthm lior0-with-shifted-arg
+    (implies (and (bvecp y m)
+		  (bvecp x (- n m))
+                  (<= m n)
+		  (natp m)
+                  (integerp n)
+                  )
+	     (= (lior0 (* (expt 2 m) x) y n)
+		(+ (* (expt 2 m) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logior-expt (n m)))
+		  :in-theory (enable bvecp-forward bvecp-longer bvecp-shift-up bits-tail lior0))))
+
+(defthm lior0-shift
+    (implies (and (bvecp x (- n m))
+		  (bvecp y (- n m))
+                  (integerp n) ;(not (zp n))
+		  (natp m)
+		  (<= m n)
+                  )
+	     (= (lior0 (* (expt 2 m) x)
+		      (* (expt 2 m) y)
+		      n)
+		(* (expt 2 m) (lior0 x y (- n m)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logior-expt-2 (n m)))
+		  :in-theory (enable bvecp-forward bvecp-longer bvecp-shift-up bits-tail lior0))))
+
+(defthm lior0-expt-original
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (bvecp x n))
+	     (= (lior0 x (expt 2 k) n)
+		(+ x (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ()
+  :hints (("Goal" :use (logior-expt-3
+			(:instance expt-strong-monotone (n k) (m n)))
+		  :in-theory (enable bvecp lior0))))
+
+;interesting.  not the same as lior0-bvecp (here, m can be smaller than n)
+;rename !!
+(defthm lior0-bvecp-2
+  (implies (and (bvecp x m)
+                (bvecp y m)
+                )
+           (bvecp (lior0 x y n) m))
+  :hints (("Goal" :in-theory (enable lior0))))
+
+(defthm lior0-upper-bound
+  (< (lior0 x y n) (expt 2 n))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :in-theory (enable lior0))))
+
+(defthm lior0-upper-bound-tight
+  (implies (<= 0 n)
+           (<= (lior0 x y n) (1- (expt 2 n))))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior0-fl-1
+  (equal (lior0 (fl x) y n)
+         (lior0 x y n))
+  :hints (("Goal" :in-theory (enable lior0))))
+
+(defthm lior0-fl-2-eric ;BOZO name conflicted...
+  (equal (lior0 x (fl y) n)
+         (lior0 x y n))
+  :hints (("Goal" :in-theory (enable lior0))))
+
+(defthmd lior0-bits-1
+  (equal (lior0 (bits x (1- n) 0)
+               y
+               n)
+         (lior0 x y n))
+  :hints (("Goal" :in-theory (e/d (lior0) (logior lior0-commutative)))))
+
+(defthmd lior0-bits-2
+  (equal (lior0 x
+               (bits y (1- n) 0)
+               n)
+         (lior0 x y n))
+  :hints (("Goal" :in-theory (e/d (lior0) (logior lior0-commutative)))))
+
+(local
+ (defthm lior0-base-lemma
+   (implies (and (bvecp x 1) (bvecp y 1))
+            (equal (lior0 x y 1)
+                   (if (or (equal (bitn x 0) 1)
+                           (equal (bitn y 0) 1))
+                       1
+                     0)))
+   :rule-classes nil))
+
+(defthm lior0-base
+  (equal (lior0 x y 1)
+         (if (or (equal (bitn x 0) 1)
+                 (equal (bitn y 0) 1))
+             1
+           0))
+  :hints (("Goal" :use ((:instance lior0-base-lemma
+                                   (x (bits x 0 0))
+                                   (y (bits y 0 0)))
+                        (:instance lior0-bits-1
+                                   (x x)
+                                   (y (bits y 0 0))
+                                   (n 1))
+                        (:instance lior0-bits-2 (n 1)))))
+  :rule-classes nil)
+
+(defthm lior0-expt
+  (implies (and (natp n)
+                (natp k)
+                (< k n))
+           (= (lior0 x (expt 2 k) n)
+              (+ (bits x (1- n) 0)
+                 (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lior0-expt-original
+                                   (x (bits x (1- n) 0))))
+           :in-theory (enable lior0-bits-1 lior0-bits-2))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lior0.lisp acl2-6.3/books/rtl/rel9/support/support/lior0.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lior0.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lior0.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,427 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+This book is about LIOR0, a nice version of LOGIOR.  LIOR0 takes an extra size parameter, N, and always returns
+a bit vector of length N.
+
+Todo:
+add versions like logand-expt-2 and logand-expt-4 <-- huh?
+prove (elsewhere) lemmas mixing lior0 with other functions
+|#
+
+;; Necessary defuns:
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(local (include-book "lior0-proofs"))
+
+;; Start of new stuff:
+
+(defund binary-lior0 (x y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logior (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defmacro lior0 (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior0 x y n) -- the base case
+         `(binary-lior0 ,@x))
+        (t         
+         `(binary-lior0 ,(car x)
+                       (lior0 ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lior0)) to refer to binary-lior0.
+(add-macro-alias lior0 binary-lior0)
+
+(defthm lior0-nonnegative-integer-type
+  (and (integerp (lior0 x y n))
+       (<= 0 (lior0 x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lior0) is no better than lior0-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lior0)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lior0-natp
+  (natp (lior0 x y n)))
+
+(defthm lior0-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (lior0 x y n)
+                  0)))
+
+(defthmd lior0-bvecp-simple
+  (bvecp (lior0 x y n) n))
+
+(defthm lior0-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lior0 x y n) k)))
+
+
+;;
+;; Rules to normalize lior0 terms (recall that LIOR0 is a macro for BINARY-LIOR0):
+;;
+
+;; allow sizes to differ on these?
+
+(defthm lior0-associative
+  (equal (lior0 (lior0 x y n) z n)
+         (lior0 x (lior0 y z n) n)))
+
+(defthm lior0-commutative
+  (equal (lior0 y x n)
+         (lior0 x y n)))
+
+(defthm lior0-commutative-2
+  (equal (lior0 y (lior0 x z n) n)
+         (lior0 x (lior0 y z n) n)))
+
+(defthm lior0-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (lior0 x (lior0 y z n) n)
+                  (lior0 (lior0 x y n) z n))))
+
+(defthm lior0-0
+  (implies (case-split (bvecp y n))
+           (equal (lior0 0 y n)
+                  y)))
+
+;nicer than the analogous rule for logior?
+(defthm lior0-1
+  (implies (case-split (bvecp y 1))
+           (equal (lior0 1 y 1)
+                  1)))
+
+(defthm lior0-self
+  (implies (and (case-split (bvecp x n))
+                (case-split (integerp n)))
+           (equal (lior0 x x n)
+                  x)))
+
+(defthmd bits-lior0-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lior0 x y n) i j)
+                  (lior0 (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j))))))
+
+(defthmd bits-lior0-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lior0 x y n) i j)
+                  (lior0 (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j))))))
+
+;notice the call to MIN in the conclusion
+(defthm bits-lior0
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (lior0 x y n) i j)
+                  (lior0 (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j))))))
+
+(defthmd bitn-lior0-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior0 x y n) m)
+                  (lior0 (bitn x m) 
+                        (bitn y m) 
+                        1))))
+
+(defthmd bitn-lior0-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior0 x y n) m)
+                  0)))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-lior0
+  (implies (and (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lior0 x y n) m)
+                  (if (< m n)
+                      (lior0 (bitn x m) 
+                            (bitn y m) 
+                            1)
+                    0))))
+
+;or could wrap bits around conclusion?
+(defthm lior0-equal-0
+  (implies (and (case-split (bvecp x n))
+                (case-split (bvecp y n))
+                (case-split (integerp n))
+                )
+           (equal (equal 0 (lior0 x y n))
+                  (and (equal x 0)
+                       (equal y 0)))))
+
+(defthm lior0-of-single-bits-equal-0
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 0 (lior0 x y 1))
+                  (and (equal x 0)
+                       (equal y 0)))))
+
+(defthm lior0-of-single-bits-equal-1
+  (implies (and (case-split (bvecp x 1))
+                (case-split (bvecp y 1))
+                )
+           (equal (equal 1 (lior0 x y 1))
+                  (or (equal x 1)
+                      (equal y 1)))))
+
+(defthm lior0-ones
+  (implies (and (case-split (bvecp x n))
+                (case-split (natp n)) ;gen
+                )
+           (equal (lior0 (1- (expt 2 n)) x n)
+                  (1- (expt 2 n))))
+  :rule-classes ())
+
+;lior0-with-all-ones will rewrite (lior0 x n) [note there's only one value being ANDed], because (lior0 x n)
+;expands to (BINARY-LIOR0 X (ALL-ONES N) N) - now moot???
+(defthm lior0-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (lior0 (all-ones n) x n)
+                  (all-ones n))))
+
+(defthm lior0-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep n)
+                              (equal (cadr k) (1- (expt 2 (cadr n))))))
+                (force (equal k (1- (expt 2 n))))
+		(case-split (natp n))
+                (case-split (bvecp x n)))
+           (equal (lior0 k x n)
+                  (1- (expt 2 n)))))
+
+(defthm lior0-def
+    (implies (and (< 0 n)
+		  (integerp n))
+	     (equal (lior0 x y n)
+		    (+ (* 2 (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+		       (lior0 (mod x 2) (mod y 2) 1))))
+  :rule-classes ())
+
+(defthm lior0-mod-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (mod (lior0 x y n) 2)
+		    (lior0 (mod x 2) (mod y 2) 1))))
+
+(defthm lior0-fl-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (fl (/ (lior0 x y n) 2))
+		    (lior0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
+
+(in-theory (disable lior0-mod-2 lior0-fl-2))
+
+;BOZO rename
+(defthm lior0-x-y-0
+  (equal (lior0 x y 0) 0))
+
+(defthm lior0-reduce
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (< n m)
+                (natp n) ;gen?
+                (natp m)
+                )
+           (equal (lior0 x y m) (lior0 x y n))))
+
+;whoa! this is a *lower* bound !
+;make alt version?
+(defthm lior0-bnd
+  (implies (case-split (bvecp x n))
+           (<= x (lior0 x y n)))
+  :rule-classes (:rewrite :linear))
+
+;get rid of the bvecp hyps (do that for many lemmas like this one)
+(defthm lior0-with-shifted-arg
+    (implies (and (bvecp y m)
+		  (bvecp x (- n m))
+                  (<= m n)
+		  (natp m)
+                  (integerp n)
+                  )
+	     (= (lior0 (* (expt 2 m) x) y n)
+		(+ (* (expt 2 m) x) y)))
+  :rule-classes ())
+
+(defthm lior0-shift
+    (implies (and (bvecp x (- n m))
+		  (bvecp y (- n m))
+                  (integerp n) ;(not (zp n))
+		  (natp m)
+		  (<= m n)
+                  )
+	     (= (lior0 (* (expt 2 m) x)
+		      (* (expt 2 m) y)
+		      n)
+		(* (expt 2 m) (lior0 x y (- n m)))))
+  :rule-classes ())
+
+(defthm lior0-expt-original
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (bvecp x n))
+	     (= (lior0 x (expt 2 k) n)
+		(+ x (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ())
+
+(defthm lior0-expt
+  (implies (and (natp n)
+                (natp k)
+                (< k n))
+           (= (lior0 x (expt 2 k) n)
+              (+ (bits x (1- n) 0)
+                 (* (expt 2 k) (- 1 (bitn x k))))))
+  :rule-classes ())
+
+;interesting.  not the same as lior0-bvecp (here, m can be smaller than n)
+;rename !!
+(defthm lior0-bvecp-2
+  (implies (and (bvecp x m)
+                (bvecp y m)
+                )
+           (bvecp (lior0 x y n) m)))
+
+(defthm lior0-upper-bound
+  (< (lior0 x y n) (expt 2 n))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior0-upper-bound-tight
+  (implies (<= 0 n)
+           (<= (lior0 x y n) (1- (expt 2 n))))
+  :rule-classes (:rewrite :linear))
+
+(defthm lior0-fl-1
+  (equal (lior0 (fl x) y n)
+         (lior0 x y n)))
+
+(defthm lior0-fl-2-eric
+  (equal (lior0 x (fl y) n)
+         (lior0 x y n)))
+
+(defthmd lior0-bits-1
+  (equal (lior0 (bits x (1- n) 0)
+               y
+               n)
+         (lior0 x y n)))
+
+(defthmd lior0-bits-2
+  (equal (lior0 x
+               (bits y (1- n) 0)
+               n)
+         (lior0 x y n)))
+
+(defthm lior0-base
+  (equal (lior0 x y 1)
+         (if (or (equal (bitn x 0) 1)
+                 (equal (bitn y 0) 1))
+             1
+           0))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lnot-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/lnot-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lnot-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lnot-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,800 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defun bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(local (include-book "bits"))
+(local (include-book "bitn"))
+;(local (include-book "../../arithmetic/top"))
+(local (include-book "../../arithmetic/expt"))
+(local (include-book "../../arithmetic/mod"))
+(local (include-book "../../arithmetic/mod"))
+(local (include-book "../../arithmetic/arith"))
+(local (include-book "../../arithmetic/arith2"))
+(local (include-book "../../arithmetic/integerp"))
+(local (include-book "bvecp"))
+
+(local (in-theory (enable expt-minus)))
+
+#|
+(defun LNOT (x n)
+  (1- (- (expt 2 n) x)))
+|#
+
+;used to be called COMP1
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+;note that this isn't a rewrite rule b/c we believe it will never need to be
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :hints (("Goal" :in-theory (enable lnot)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-natp
+  (natp (lnot x n)))
+
+(defthm lnot-upper-bound
+  (< (lnot x n) (expt 2 n))
+  :hints (("Goal" :in-theory (enable lnot)))
+  :rule-classes (:rewrite :linear)
+  )
+
+;why is bvecp enabled here?
+
+(defthm lnot-bvecp-simple
+  (bvecp (lnot x n) n)
+  :hints (("Goal" :in-theory (enable bvecp lnot))))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k))
+  :hints (("Goal" :in-theory (disable lnot-bvecp-simple)
+           :use lnot-bvecp-simple)))
+
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+                (case-split (bvecp x n))
+                )
+           (equal (lnot (lnot x n) n)
+                  x))
+  :hints (("Goal" :in-theory (enable lnot bvecp bits-does-nothing))))
+
+;reorient this rule?
+(defthmd lnot-times-2
+   (implies (and (case-split (natp x))
+                 (case-split (natp n))
+                 )
+            (equal (+ 1 (* 2 (lnot x n)))
+                   (lnot (* 2 x) (1+ n))))
+   :hints (("Goal" :in-theory (enable lnot expt-split)
+            :use (:instance bits-shift (n 1) (i n) (j 0)))))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0)
+  :hints (("Goal" :in-theory (enable lnot)))
+  )
+
+
+(encapsulate
+ ()
+
+ (local
+  (defthm fl-lnot-1
+    (implies (and (integerp n) (>= n k)
+                  (integerp k)
+                  (>= k 0) ;drop? and propagate..
+                  (integerp x) (>= x 0)
+                  (< x (expt 2 n))
+                  )
+             (equal (/ (lnot x n) (expt 2 k))
+                    (+ (expt 2 (- n k))
+                       (/ (- -1 x) (expt 2 k)))))
+    :rule-classes ()
+    :hints (("Goal" :in-theory (set-difference-theories
+                                (enable lnot expt-split)
+                                '( ;a10
+                                   ))
+             ))))
+
+;this looks fragile
+ (local (defthm fl=
+          (implies (equal x y)
+                   (equal (fl x) (fl y)))
+          :rule-classes ()))
+
+ (local (defthm fl-lnot-2
+          (implies (and (integerp n) (>= n k)
+                        (integerp k) (>= k 0)
+                        (integerp x) (>= x 0) (< x (expt 2 n)))
+                   (equal (fl (/ (lnot x n) (expt 2 k)))
+                          (fl (+ (expt 2 (- n k))
+                                 (/ (- -1 x) (expt 2 k))))))
+          :rule-classes ()
+          :hints (("Goal" :in-theory (disable ;a10
+                                      )
+                   :use ((:instance fl-lnot-1)
+                         (:instance fl= 
+                                    (x (/ (lnot x n) (expt 2 k))) 
+                                    (y (+ (expt 2 (- n k))
+                                          (/ (- -1 x) (expt 2 k))))))))))
+
+ (local (include-book "../../arithmetic/fl"))
+
+ (local (defthm fl-lnot-3
+          (implies (and (integerp n) (>= n k)
+                        (integerp k) (>= k 0)
+                        (integerp x) (>= x 0) (< x (expt 2 n)))
+                   (equal (fl (/ (lnot x n) (expt 2 k)))
+                          (+ (expt 2 (- n k))
+                             (fl (/ (- -1 x) (expt 2 k))))))
+          :rule-classes ()
+          :hints (("Goal" :in-theory (enable lnot)
+                   :use ((:instance fl-lnot-2)
+                         )))))
+
+;gen?
+;make a by-2 version?
+;change param name?
+;make a better rewrite rule
+ (defthmd lnot-fl-aux
+   (implies (and (<= k n)
+                 (bvecp x n)
+                 (<= 0 k)
+                 (integerp n) 
+                 (integerp k)
+                 )
+            (equal (fl (* (/ (expt 2 k)) (lnot x n)))
+                   (lnot (fl (/ x (expt 2 k))) (- n k))))
+   :hints (("Goal" :in-theory (set-difference-theories
+                               (enable lnot bvecp)
+                               '(bits-fl ;a10
+                                 ;fl-minus-gen
+                                 ))
+            :use ((:instance fl-lnot-3)
+                  (:instance fl-m+1 (m x) (n (expt 2 k)))
+                  ))))
+
+ )
+
+;disable?
+(defthm lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+(defthmd lnot-ignores-bits-2
+  (implies (and (integerp i)
+                (<= (1- n) i))
+           (equal (lnot (bits x i 0) n)
+                  (lnot x n)))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+;disable?
+(defthm lnot-fl-eric
+  (equal (lnot (fl x) n)
+         (lnot x n))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+;is this okay? dropped the fl...
+(local (defthmd lnot-fl-eric-helper
+   (implies (and (<= k n)
+                 ;(bvecp x n)
+                 (<= 0 k)
+                 (integerp n) 
+                 (integerp k)
+                 )
+            (equal (fl (* (/ (expt 2 k)) (lnot x n)))
+                   (lnot (/ (bits x (1- n) 0) (expt 2 k)) (- n k))))
+   :hints (("Goal" :in-theory (disable lnot-fl-aux)
+            :use ((:instance lnot-fl-aux (x (bits x (1- n) 0 ))))))
+   ))
+
+
+;BOZO move!
+(DEFTHM BITS-SHIFT-inv
+  (IMPLIES (AND (CASE-SPLIT (INTEGERP N))
+                (CASE-SPLIT (INTEGERP I))
+                (CASE-SPLIT (INTEGERP J)))
+           (EQUAL (BITS (* (/ (EXPT 2 N)) X) I J)
+                  (BITS X (+ I N) (+ J N))))
+  :hints (("Goal" :in-theory (disable bits-shift)
+           :use (:instance bits-shift (n (- n))))))
+
+
+;why did I have to open up bits??
+;perhaps export this?
+(local (defthmd lnot-fl-eric-helper-2
+   (implies (and (<= k n)
+                 (<= 0 k)
+                 (integerp n) 
+                 (integerp k)
+                 )
+            (equal (lnot (/ (bits x (1- n) 0) (expt 2 k)) (- n k))
+                   (lnot (/ x (expt 2 k)) (- n k))))
+   :hints (("Goal" :in-theory (e/d ( lnot) (
+                                            LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)) ;BOZO
+            :use ((:instance bits-shift (n (- k)) (i (+ -1 N (* -1 K))) (j 0))
+
+                  )))))
+
+;lacks the bvecp hyp
+(defthmd lnot-fl-original
+   (implies (and (<= k n)
+                 (<= 0 k)
+                 (integerp n) 
+                 (integerp k)
+                 )
+            (equal (fl (* (/ (expt 2 k)) (lnot x n)))
+                   (lnot (fl (/ x (expt 2 k))) (- n k))))
+   :hints (("Goal" :use  lnot-fl-eric-helper-2
+            :in-theory (enable  lnot-fl-eric-helper  lnot-fl-eric-helper-2))))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n)))
+  :Hints (("Goal" :use ((:instance lnot-fl-original
+                                   (x x)
+                                   (k k)
+                                   (n (+ n k)))))))
+
+
+
+
+(encapsulate
+ ()
+
+ (local
+  (defthm mod-lnot-1
+    (implies (and (integerp x)
+                  (>= x 0)
+                  (integerp n)
+                  (>= n 0) ;BOZO try dropping
+                  (integerp m)
+                  (>= m n)
+                  (< x (expt 2 m))
+                  (< x (expt 2 n)) ;new
+                  )
+             (equal (lnot x m)
+                    (+ (lnot x n) (* (expt 2 n) (1- (expt 2 (- m n)))))))
+    :rule-classes ()
+    :hints (("goal"  :in-theory (enable lnot expt-split) 
+             ))))
+
+
+ (local
+  (defthm mod-lnot-2-thm
+    (implies (and (integerp x)
+                  (>= x 0)
+                  (integerp n)
+                  (>= n 0)
+                  (integerp m)
+                  (>= m n)
+                  (< x (expt 2 m))
+                  (< x (expt 2 n)) ;new
+                  )
+             (equal (mod (lnot x m) (expt 2 n))
+                    (mod (+ (lnot x n) (* (expt 2 n) (1- (expt 2 (- m n))))) (expt 2 n))))
+    :rule-classes ()
+    :hints (("goal" :use (mod-lnot-1)))))
+
+ (local
+  (defthm mod-lnot-3
+    (implies (and (integerp x)
+                  (>= x 0)
+                  (integerp n)
+                  (>= n 0)
+                  (integerp m)
+                  (>= m n)
+                  (< x (expt 2 m))
+                  )
+             (equal (mod (lnot x m) (expt 2 n))
+                    (mod (lnot (mod x (expt 2 n)) m) (expt 2 n))))
+    :otf-flg t
+    :rule-classes ()
+    :hints (("goal" :in-theory (enable lnot ; bits
+                                       )
+             :use ((:instance mod-difference-elim-second (x1 (1- (expt 2 m))) (x2 x) (y (expt 2 n)))
+                   (:instance expt-weak-monotone)
+;                 (:instance lnot-bnds (n m))
+;                              (:instance mod+-thm (m (lnot x n)) (n (expt 2 n)) (a (1- (expt 2 (- m n)))))
+                              
+                   )))))
+
+ (local
+  (defthm mod-lnot-4
+    (implies (and (integerp x)
+                  (>= x 0)
+                  (integerp n)
+                  (>= n 0)
+                  (integerp m)
+                  (>= m n)
+                  (< x (expt 2 n))
+                  )
+             (equal (mod (lnot x m) (expt 2 n))
+                    (mod (lnot x n) (expt 2 n))))
+    :rule-classes ()
+    :hints (("goal"
+             :use (mod-lnot-2-thm
+                   (:instance expt-weak-monotone)
+;			(:instance lnot-bnds (n m))
+                   (:instance mod-mult-eric (x (lnot x n)) (y (expt 2 n)) (a (1- (expt 2 (- m n)))))
+                   )))))
+
+ (local
+  (defthm mod-lnot-5
+    (implies (and (integerp x)
+                  (>= x 0)
+                  (integerp n)
+                  (>= n 0)
+                  (integerp m)
+                  (>= m n)
+                  (< x (expt 2 m)))
+             (equal (mod (lnot x m) (expt 2 n))
+                    (mod (lnot (mod x (expt 2 n)) n) (expt 2 n))))
+    :rule-classes ()
+    :hints (("goal" :use (mod-lnot-3
+                          (:instance mod-lnot-4 (x (mod x (expt 2 n))))
+;                                     (:instance mod-bnd-1 (m x) (n (expt 2 n)))
+;                                     (:instance mod>=0 (m x) (n (expt 2 n)))
+                          )))))
+
+;gen
+;add case-splits
+;write in terms of bvecp?
+ (defthm mod-lnot-aux
+   (implies (and (< x (expt 2 m)) ;drop!
+                 (<= n m)
+                 (integerp x)
+                 (<= 0 x)
+                 (integerp n)
+                 (<= 0 n) ;gen
+                 (integerp m)
+                 )
+            (equal (mod (lnot x m) (expt 2 n))
+                   (lnot (mod x (expt 2 n)) n)))
+   :hints (("goal" :in-theory (enable lnot)
+            :use (mod-lnot-5
+;(:instance mod-equal (m (lnot (mod x (expt 2 n)) n)) (n (expt 2 n)))
+;(:instance mod-bnd-1 (m x) (n (expt 2 n)))
+;                  (:instance mod>=0 (m x) (n (expt 2 n)))
+                  ))))
+ )
+
+
+
+
+(local (include-book "../../arithmetic/top"))
+
+
+;BOZO move this!
+(defthm bits-ignores-mod-special
+  (equal (bits (mod x (expt 2 m)) (1- m) 0)
+         (bits x (1- m) 0)
+         )
+  :hints (("goal" :in-theory (enable bits)))
+  )
+
+;BOZO move this!
+(defthm bits-ignores-mod
+  (implies (and (<= m n)
+                (case-split (integerp n))
+                ;(integerp m)
+                )
+           (equal (bits (mod x (expt 2 n)) (1- m) 0)
+                  (bits x (1- m) 0)
+                  ))
+  :hints (("goal" :in-theory (enable bits)))
+  )
+
+(defthm lnot-ignores-mod-special
+  (equal (lnot (mod x (expt 2 m)) m)
+         (lnot x m))
+  :hints (("Goal" :in-theory (enable lnot)))
+  )
+
+(defthm lnot-ignores-mod
+  (implies (and (<= m n)
+                (case-split (integerp n)))
+           (equal (lnot (mod x (expt 2 n)) m)
+                  (lnot x m)))
+  :hints (("Goal" :in-theory (enable lnot)))
+  )
+
+;consider enabling?
+(defthmd mod-lnot-aux2
+   (implies (and (<= n m)
+                 (integerp x) ;will be dropped below
+                 (integerp n)
+                 (<= 0 n) ;gen
+                 (integerp m)
+                 )
+            (equal (mod (lnot x m) (expt 2 n))
+                   (lnot (mod x (expt 2 n)) n))) ;note the lack of m in the conclusion
+   :hints (("Goal" :in-theory (disable MOD-LNOT-aux)
+            :use (:instance mod-lnot-aux (x (mod x (expt 2 m)))))))
+
+;no (integerp x) hyp
+(defthmd mod-lnot
+   (implies (and (<= k n) ;handle the other case?
+                 (natp k)
+                 (integerp n)
+                 )
+            (equal (mod (lnot x n) (expt 2 k))
+                   (lnot (mod x (expt 2 k)) k))) ;note the lack of n in the conclusion
+   :hints (("Goal" :use (:instance mod-lnot-aux2 (x (fl x)) (n k) (m n))
+            :in-theory (disable mod-lnot-aux2 ))))
+
+(defthm mod-lnot-by-2
+  (implies (and (< 0 n)
+                (integerp x) ;gen?
+                (integerp n)
+                )
+           (equal (mod (lnot x n) 2)
+                  (lnot (mod x 2) 1)))
+  :hints (("Goal" :in-theory (disable lnot-ignores-mod
+                                      LNOT-IGNORES-MOD-SPECIAL
+                                      mod-lnot)
+           :use ((:instance lnot-ignores-mod (n 1) (m n))
+                 (:instance mod-lnot (n n) (k 1))))))
+
+(local (defthmd bits-lnot-aux
+  (implies (and (< i m)
+                (case-split (bvecp x m)) ;dropped below..
+                (case-split (integerp m))
+                (case-split (integerp i))
+                (case-split (natp j)) ;gen?
+                )
+           (equal (bits (lnot x m) i j)
+                  (lnot (bits x i j) (1+ (- i j)))))
+  :hints (("Goal" :cases ((>= i j))
+           :in-theory (e/d (bits bvecp lnot-fl-original) ( LNOT-IGNORES-MOD  MOD-LNOT  LNOT-IGNORES-MOD-SPECIAL))))))
+
+
+
+;gen?
+;BOZO formal m should be n
+(local
+ (defthm bits-lnot-original
+   (implies (and (< i m)
+                 (case-split (natp j))
+                 (case-split (integerp m))
+                 (case-split (integerp i))
+                 )
+            (equal (bits (lnot x m) i j)
+                   (lnot (bits x i j) (1+ (- i j)))))
+   :hints (("Goal" :use (:instance bits-lnot-aux (x (bits x (1- m) 0)))
+            :in-theory (e/d (bvecp) ())))))
+
+#|
+(defthm bits-lnot-2
+  (implies (and (< i m)
+                (case-split (integerp m))
+                (case-split (integerp i))
+                (case-split (natp j)) ;gen?
+                (not (bvecp x m)) ;note!
+                (integerp x)
+                )
+           (equal (bits (lnot x m) i j)
+                  (lnot (bits x i j) (1+ (- i j)))))
+  :hints (("Goal" :cases ((>= i j))
+           :in-theory (enable bvecp lnot))))
+
+
+
+|#
+
+;gen?
+(defthm bitn-lnot
+  (implies (and (case-split (natp k))
+                (case-split (natp n))
+                ;(case-split (bvecp x k))
+                )
+           (equal (bitn (lnot x n) k)
+                  (if (< k n)
+                      (lnot (bitn x k) 1)
+                    0)))
+  :hints (("Goal" :in-theory (enable bitn BVECP-BITS-0
+                                     ))))
+
+;drop?
+(defthm bitn-lnot-not-equal
+  (implies (and (< k n)
+                (integerp n)
+                (<= 0 n)
+                (integerp k)
+                (<= 0 k)
+                )
+           (not (= (bitn (lnot x n) k)
+                   (bitn x k))))
+  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1) ;why needed?
+; :in-theory (enable bvecp)
+           :use (:instance bitn-0-1 (n k))
+           ))
+  :rule-classes ())
+
+;could generalize these a lot (when lnot equals a constant, take the lnot of both sides)
+;drop bvecp hyp by wrapping bits around conclusion?
+(defthm lnot-bvecp-equal-0
+  (implies (case-split (bvecp x 1))
+           (equal (equal (lnot x 1) 0)
+                  (not (equal x 0))))
+  :hints (("goal" :in-theory (enable lnot bvecp))))
+
+(defthm lnot-bvecp-equal-1
+  (implies (case-split (bvecp x 1))
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0)))
+  :hints (("goal" :in-theory (enable lnot bvecp))))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n)))))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n))
+                )
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n))))))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+
+
+
+
+#| BOZO get this to work and use in stick-proofs instead of bitn-lnot-not-equal?
+
+;gen!
+(defthm lnot-x-not-equal-x
+  (implies (and (natp n) (natp x))
+           (not (equal (lnot x n) x)))
+  :hints (("Goal" :in-theory (enable lnot)))
+)
+
+|#
+
+
+(defthm lnot-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (lnot x n)
+                  0))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+(defthm lnot-with-n-not-positive
+  (implies (<= n 0)
+           (equal (lnot x n)
+                  0))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+; Start proof of bits-lnot-aux-2 (for bits-lnot).
+
+(local
+ (defthm hack 
+   (implies (and (integerp n) (integerp i) (<= n i))
+            (< (expt 2 n) (expt 2 (1+ i))))
+   :rule-classes nil))
+
+(local
+  (defthm bits-lnot-aux-2-1-1-1
+    (implies (and (not (< i n))
+                  (rationalp x)
+                  (case-split (integerp n))
+                  (case-split (integerp i)))
+             (equal (mod (lnot x n) (expt 2 (+ 1 i)))
+                    (lnot x n)))
+    :hints (("Goal"
+             :use (lnot-upper-bound hack)
+             :in-theory (e/d () (lnot-upper-bound
+                                 expt-compare
+                                 expo-expt2
+                                 power2p-expt2-i))))))
+
+(local
+  (defthm bits-lnot-aux-2-1-1
+    (implies (and (not (< i n))
+                  (rationalp x)
+                  (case-split (natp j))
+                  (case-split (integerp n))
+                  (case-split (integerp i)))
+             (equal (bits (lnot x n) i j)
+                    (fl (/ (lnot x n)
+                           (expt 2 j)))))
+    :hints (("Goal"
+             :in-theory (e/d (bits) ())))))
+
+(local
+ (defthm hack-2
+   (implies (and (< n j)
+                 (integerp j))
+            (< (lnot x n) (expt 2 j)))
+   :hints (("Goal" :in-theory (enable lnot)))))
+
+(local
+  (defthm bits-lnot-aux-2-1-2
+    (implies (and (not (< i n))
+                  (rationalp x)
+                  (case-split (natp j))
+                  (case-split (integerp n))
+                  (case-split (integerp i)))
+             (equal (fl (/ (lnot x n)
+                           (expt 2 j)))
+                    (lnot (fl (/ x (expt 2 j))) (- n j))))
+    :hints (("Goal" :use ((:instance lnot-fl
+                                     (k j)
+                                     (n (- n j))))))))
+
+(local
+  (defthm bits-lnot-aux-2-1-3
+    (implies (and (not (< i n))
+                  (rationalp x)
+                  (case-split (natp j))
+                  (case-split (integerp n))
+                  (case-split (integerp i)))
+             (equal (bits (fl (/ x (expt 2 j))) (1- (- n j)) 0)
+                    (bits x (1- n) j)))
+    :hints (("Goal" :use ((:instance bits-shift-down-1
+                                     (x x)
+                                     (k j)
+                                     (i (- (1- n) j))
+                                     (j 0)))))))
+
+(local
+ (defthm bits-lnot-aux-2-1
+   (implies (and (not (< i n))
+                 (rationalp x)
+                 (case-split (natp j))
+                 (case-split (integerp n))
+                 (case-split (integerp i)))
+            (equal (bits (lnot x n) i j)
+                   (lnot (bits x (1- n) j)
+                         (- n j))))
+   :hints (("Goal"
+            :use (bits-lnot-aux-2-1-1
+                  bits-lnot-aux-2-1-2
+                  bits-lnot-aux-2-1-3)))
+   :rule-classes nil))
+
+(local
+ (defthm bits-lnot-aux-2-2
+   (implies (and (not (< i n))
+                 (not (<= j i))
+                 (rationalp x)
+                 (case-split (natp j))
+                 (case-split (integerp n))
+                 (case-split (integerp i)))
+            (equal (bits (lnot x n) i j)
+                   (lnot (bits x (1- n) j)
+                         (- n j))))
+   :hints (("Goal"
+            :in-theory (e/d (bits) ())))
+   :rule-classes nil))
+
+(local
+ (defthm lnot-of-irrational
+   (implies (not (rationalp x))
+            (equal (lnot x n) (lnot 0 n)))
+   :hints (("Goal" :in-theory (enable lnot)))))
+
+(local
+ (defthm bits-lnot-aux-2-3
+   (implies (and (not (rationalp x))
+                 (not (< i n))
+                 (case-split (natp j))
+                 (case-split (integerp n))
+                 (case-split (integerp i)))
+            (equal (bits (lnot x n) i j)
+                   (lnot (bits x (1- n) j)
+                         (- n j))))
+   :hints (("Goal" :use ((:instance bits-lnot-aux-2-1
+                                    (x 0))
+                         (:instance bits-lnot-aux-2-2
+                                    (x 0)))))
+   :rule-classes nil))
+
+(local
+ (defthm bits-lnot-aux-2
+   (implies (and (not (< i n))
+                 (case-split (natp j))
+                 (case-split (integerp n))
+                 (case-split (integerp i)))
+            (equal (bits (lnot x n) i j)
+                   (lnot (bits x (1- n) j)
+                         (- n j))))
+   :hints (("Goal" :use (bits-lnot-aux-2-1
+                         bits-lnot-aux-2-2
+                         bits-lnot-aux-2-3)))
+   :rule-classes nil))
+
+(defthmd bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j)))))
+  :hints (("Goal" :use ((:instance bits-lnot-aux (m n) (x (bits x (1- n) 0)))
+                        bits-lnot-aux-2)
+           :in-theory (e/d (bvecp) ()))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lnot.lisp acl2-6.3/books/rtl/rel9/support/support/lnot.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lnot.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lnot.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,270 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defun bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(local (include-book "lnot-proofs"))
+
+#| old definition:
+(defun LNOT (x n)
+  (1- (- (expt 2 n) x)))
+|#
+
+;used to be called COMP1
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+;note that this isn't a rewrite rule b/c we believe it will never need to be
+;BOZO make it one anyway?
+(defthm lnot-nonnegative-integer-type
+  (and (integerp (lnot x n))
+       (<= 0 (lnot x n)))
+  :rule-classes ((:type-prescription :typed-term (lnot x n))))
+
+;lnot-nonnegative-integer-type is strictly better, and we don't need both
+(in-theory (disable (:type-prescription lnot))) 
+
+(defthm lnot-natp
+  (natp (lnot x n)))
+
+(defthm lnot-upper-bound
+  (< (lnot x n) (expt 2 n))
+  :rule-classes (:rewrite :linear)
+  )
+
+;why is bvecp enabled here?
+
+(defthm lnot-bvecp-simple
+  (bvecp (lnot x n) n))
+
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+;perhaps conclude with bits of x and drop the bvecp hyp?
+(defthm lnot-lnot
+  (implies (and (case-split (natp n))
+                (case-split (bvecp x n))
+                )
+           (equal (lnot (lnot x n) n)
+                  x)))
+
+;reorient this rule?
+(defthmd lnot-times-2
+   (implies (and (case-split (natp x))
+                 (case-split (natp n))
+                 )
+            (equal (+ 1 (* 2 (lnot x n)))
+                   (lnot (* 2 x) (1+ n)))))
+
+(defthm lnot-x-0
+  (equal (lnot x 0) 0))
+
+;gen?
+;make a by-2 version?
+;change param name?
+;make a better rewrite rule
+;RHS isn't simplified!
+(defthmd lnot-fl-original
+  (implies (and (<= k n)
+                ;(bvecp x n)
+                (<= 0 k)
+                (integerp n) 
+                (integerp k)
+                )
+           (equal (fl (* (/ (expt 2 k)) (lnot x n)))
+                  (lnot (fl (/ x (expt 2 k))) (- n k)))))
+
+(defthmd lnot-fl
+  (implies (and (natp n)
+                (natp k))
+           (equal (fl (* (/ (expt 2 k)) (lnot x (+ n k))))
+                  (lnot (fl (/ x (expt 2 k))) n))))
+
+;gen
+;add case-splits
+(defthmd mod-lnot
+  (implies (and (<= k n)
+                (natp k)
+                (integerp n)
+                )
+           (equal (mod (lnot x n) (expt 2 k))
+                  (lnot (mod x (expt 2 k)) k))))
+
+(defthm mod-lnot-by-2
+  (implies (and (< 0 n)
+                (integerp x) ;gen?
+                (integerp n)
+                )
+           (equal (mod (lnot x n) 2)
+                  (lnot (mod x 2) 1))))
+
+;disable?
+(defthm lnot-bits-1
+  (equal (lnot (bits x (1- n) 0) n)
+         (lnot x n)))
+
+(defthmd lnot-ignores-bits-2
+  (implies (and (integerp i)
+                (<= (1- n) i))
+           (equal (lnot (bits x i 0) n)
+                  (lnot x n))))
+
+(defthm bits-lnot
+  (implies (and (case-split (natp j))
+		(case-split (integerp n))
+		(case-split (integerp i)))
+	   (equal (bits (lnot x n) i j)
+                  (if (< i n)
+                      (lnot (bits x i j)
+                            (1+ (- i j)))
+                    (lnot (bits x (1- n) j)
+                          (- n j))))))
+
+;gen?
+(defthm bitn-lnot
+  (implies (and (case-split (natp k))
+                (case-split (natp n))
+                )
+           (equal (bitn (lnot x n) k)
+                  (if (< k n)
+                      (lnot (bitn x k) 1)
+                    0))))
+
+;do we still need this, given bitn-lnot?
+(defthm bitn-lnot-not-equal
+  (implies (and (< k n)
+                (integerp n)
+                (<= 0 n)
+                (integerp k)
+                (<= 0 k)
+                )
+           (not (= (bitn (lnot x n) k)
+                   (bitn x k))))
+  :rule-classes ())
+
+;could generalize these a lot (when lnot equals a constant, take the lnot of both sides)
+;drop bvecp hyp by wrapping bits around conclusion?
+(defthm lnot-bvecp-equal-0
+  (implies (case-split (bvecp x 1))
+           (equal (equal (lnot x 1) 0)
+                  (not (equal x 0)))))
+
+(defthm lnot-bvecp-equal-1
+  (implies (case-split (bvecp x 1))
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0))))
+
+;consider enabling?
+(defthmd lnot-ignores-mod-special
+  (equal (lnot (mod x (expt 2 m)) m)
+         (lnot x m)))
+
+;consider enabling?
+(defthmd lnot-ignores-mod
+  (implies (and (<= m n)
+                (case-split (integerp n)))
+           (equal (lnot (mod x (expt 2 n)) m)
+                  (lnot x m))))
+
+(defthmd lnot-shift
+  (implies (and (case-split (integerp x))
+                (case-split (natp n))
+                (natp k))
+           (equal (lnot (* (expt 2 k) x) n)
+                  (if (<= k n)
+                      (+ (* (expt 2 k) (lnot x (- n k)))
+                         (1- (expt 2 k)))
+                    (1- (expt 2 n)))))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+;consider enabling?
+(defthmd lnot-shift-2
+  (implies (and (syntaxp (not (quotep x))) ;prevents loops
+                (case-split (integerp x))
+                (case-split (< 0 n))
+                (case-split (integerp n))
+                )
+           (equal (lnot (* 2 x) n)
+                  (+ 1 (* 2 (lnot x (1- n))))))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+;disable?
+;BOZO rename the other lnot-fl.  this one should be called lnot-fl.
+(defthm lnot-fl-eric
+  (equal (lnot (fl x) n)
+         (lnot x n)))
+
+(defthm lnot-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (lnot x n)
+                  0)))
+
+(defthm lnot-with-n-not-positive
+  (implies (<= n 0)
+           (equal (lnot x n)
+                  0)))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/log-equal.lisp acl2-6.3/books/rtl/rel9/support/support/log-equal.lisp
--- acl2-6.2/books/rtl/rel9/support/support/log-equal.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/log-equal.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,36 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;Did we say we'd keep log= enabled?  Will this cause lots of splitting on ifs?
+
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+;or did we say we'd keep log= disabled?
+(defthm log=-same
+  (equal (log= x x) 1)
+  :hints (("Goal" :in-theory (enable log=))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/log-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/log-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/log-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/log-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1306 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;**************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+(in-package "ACL2")
+
+;BOZO make log-proofs.lisp
+
+(include-book "ground-zero")
+
+(local (include-book "../../arithmetic/top"))
+(local (include-book "lognot"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "lnot"))
+(local (include-book "logior"))
+(local (include-book "logand"))
+(local (include-book "logxor"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+
+
+;rename! mod-lognot-by-2
+(defthm mod-logior-9
+  (implies (integerp i)
+           (iff (= (mod (lognot i) 2) 0)
+                (not (= (mod i 2) 0))))
+  :hints (("Goal" :in-theory (enable mod-by-2)
+           )))
+
+
+
+(defthm mod-logior-10
+  (implies (and (integerp i)
+                (integerp j))
+           (iff (and (= (mod i 2) 0) (= (mod j 2) 0))
+                (= (mod (logior i j) 2) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use mod-logior-by-2
+           :in-theory (set-difference-theories
+                       (enable mod-by-2)
+                       '(logior)))))
+;move
+(local
+ (defun log-induct-3 (x y z)
+   (if (and (integerp x) (>= x 0)
+            (integerp y) (>= y 0)
+            (integerp z) (>= z 0))
+       (if (or (= x 0) (= y 0) (= z 0))
+           ()
+         (log-induct-3 (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+     ())))
+
+
+
+(local
+ (defthm logior-logand-1
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp z) (>= z 0))
+            (equal (logior (mod x 2)
+                           (logand  (mod y 2) (mod z 2)))
+                   (logand (logior (mod x 2) (mod y 2))
+                           (logior (mod x 2) (mod z 2)))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance mod012 (m x))
+                         (:instance mod012 (m y))
+                         (:instance mod012 (m z)))))))
+
+(local (defthm logior-logand-2
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0))
+            (equal (logand (logior (mod x 2) (mod y 2)) (mod x 2))
+                   (mod x 2)))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance mod012 (m x))
+                         (:instance mod012 (m y)))))))
+
+;nice lemma?
+(local
+ (defthm logior-logand-3
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0))
+            (= (logand (logior x y) x)
+               x))
+   :rule-classes ()
+   :hints (("Goal" :induct (log-induct x y))
+           ("Subgoal *1/2" :use ((:instance logior-logand-2)
+                                 (:instance fl-mod-equal
+                                            
+                                            (y (logand (logior x y) x))))))))
+;BOZO export!
+;gen?
+(defthm logior-logand
+  (implies (and (integerp x)
+                (<= 0 x)
+                (integerp y)
+                (<= 0 y)
+                (integerp z)
+                (<= 0 z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z))))
+  :rule-classes ()
+  :hints (("Goal" :induct (log-induct-3 x y z))
+	  ("Subgoal *1/2" :use ((:instance logior-logand-1)
+                                (:instance fl-mod-equal
+                                           (x (logior x (logand y z)))
+                                           (y (logand (logior x y) (logior x z))))))
+	  ("Subgoal *1/1" :use ((:instance logior-logand-3)
+				(:instance logior-logand-3 (y z))))))
+
+;BOZO export!
+(defthm logior-logand-alt
+  (implies (and (integerp x)
+                (<= 0 x)
+                (integerp y)
+                (<= 0 y)
+                (integerp z)
+                (<= 0 z))
+           (equal (logior (logand y z) x)
+                  (logand (logior x y) (logior x z))))
+  :hints (("Goal" :use ( logior-logand)))
+  :rule-classes ())
+
+
+
+(local
+ (defthm logand-logior-1
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp z) (>= z 0))
+            (equal (logand (mod x 2)
+                           (logior  (mod y 2) (mod z 2)))
+                   (logior (logand (mod x 2) (mod y 2))
+                           (logand (mod x 2) (mod z 2)))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance mod012 (m x))
+                         (:instance mod012 (m y))
+                         (:instance mod012 (m z)))))))
+
+(defthm LOGAND-LOGIOR
+  (implies (and (integerp x) (<= 0 x)
+                (integerp y) (<= 0 y)
+                (integerp z) (<= 0 z))
+           (equal (logand x (logior y z))
+                  (logior (logand x y) (logand x z))))
+  :rule-classes ()
+  :hints (("Goal" :induct (log-induct-3 x y z))
+	  ("Subgoal *1/2" :use ((:instance logand-logior-1)
+                                (:instance fl-mod-equal
+                                           (x (logand x (logior y z)))
+                                           (y (logior (logand x y) (logand x z))))))))
+(defthm logand-logior-alt
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp z) (>= z 0))
+           (equal (logand (logior y z) x)
+                  (logior (logand y x) (logand z x))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance logand-logior)))))
+
+
+
+;I should be able to prove mod-logand without appealing to logior!
+;Rather, I should try to prove mod-logior from mod-logand.
+
+;not about logand!
+(local
+ (defthm mod-logand-1
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0))
+            (= x (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
+                         (mod x (expt 2 n)))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance quot-mod (m x) (n (expt 2 n)))
+                         (:instance or-dist-b (x (fl (/ x (expt 2 n)))) (y (mod x (expt 2 n)))) ;yuck!
+                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+                         )))))
+
+(local
+ (defthm mod-logand-2
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (>= n 0))
+            (= (logand x y)
+               (logior (logand (* (expt 2 n) (fl (/ x (expt 2 n))))
+                               y)
+                       (logand (mod x (expt 2 n))
+                               y))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance mod-logand-1)
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+                         (:instance logand-logior 
+                                    (x y)
+                                    (y (* (expt 2 n) (fl (/ x (expt 2 n)))))
+                                    (z (mod x (expt 2 n))))
+                         )))))
+
+(local
+ (defthm mod-logand-3
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0))
+	     (= (logand x y)
+		(logior (* (expt 2 n) 
+			   (logand (fl (/ x (expt 2 n)))
+				   (fl (/ y (expt 2 n)))))
+			(logand (mod x (expt 2 n))
+				y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-logand-2)
+			(:instance and-dist-b (x (fl (/ x (expt 2 n))))))))))
+
+(local
+ (defthm mod-logand-4
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (>= n 0))
+            (= (logand x y)
+               (+ (* (expt 2 n) 
+                     (logand (fl (/ x (expt 2 n)))
+                             (fl (/ y (expt 2 n)))))
+                  (logand (mod x (expt 2 n))
+                          y))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance mod-logand-3)
+                         (:instance or-dist-b
+                                    (x (logand (fl (/ x (expt 2 n)))
+                                               (fl (/ y (expt 2 n)))))
+                                    (y (logand (mod x (expt 2 n))
+                                               y)))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))			
+                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
+                         (:instance logand-bnd (x (mod x (expt 2 n))))
+                         )))))
+
+(defthm mod-logand-aux
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp n) (>= n 0))
+           (= (mod (logand x y) (expt 2 n))
+              (logand (mod x (expt 2 n)) y)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance mod-logand-4)
+			(:instance mod-mult-eric
+				   (x (logand (mod x (expt 2 n)) y)) 
+				   (y (expt 2 n))
+				   (a (logand (fl (/ x (expt 2 n))) (fl (/ y (expt 2 n))))))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))			
+			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
+			(:instance logand-bnd (x (mod x (expt 2 n))))
+			(:instance mod-does-nothing (m (logand (mod x (expt 2 n)) y)) (n (expt 2 n)))))))
+
+;generalize (mod y (expt 2 n)) to anything < 2^n?
+(defthm and-dist-d
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0)
+		  (< x (expt 2 n)))
+	     (= (logand x y)
+		(logand x (mod y (expt 2 n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance mod-logand-aux (x y) (y x))
+;			(:instance and-dist-a)
+			(:instance mod-does-nothing (m (logand x y)) (n (expt 2 n)))))))
+
+;compare to mod-logand-aux
+;looks like we can wrap the mod around x or y or both (same for bits of logand?)
+(defthm mod-logand
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp n) (>= n 0))
+           (equal (mod (logand x y) (expt 2 n))
+                  (logand (mod x (expt 2 n)) (mod y (expt 2 n)))))
+  :hints (("goal" :use (mod-logand-aux
+			(:instance and-dist-d (x (mod x (expt 2 n))))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+			(:instance mod-bnd-1 (m x) (n (expt 2 n)))))))
+
+(encapsulate
+ ()
+
+ (local (defthm bits-logand-1
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (bits (logand x y) i 0)
+                           (logand (+ (* (expt 2 j) (bits x i j))
+                                      (bits x (1- j) 0))
+                                   (+ (* (expt 2 j) (bits y i j))
+                                      (bits y (1- j) 0)))))
+               :rule-classes ()
+               :hints (("Goal" :in-theory (enable bits
+                                                  )
+                        :use ((:instance mod-logand (n (1+ i)))
+                              (:instance expt-split (r 2) (i 1) (j i))
+                              (:instance bits-plus-bits (n i) (p j) (m 0))
+                              (:instance bits-plus-bits (x y) (n i) (p j) (m 0)))))))
+
+ (local (defthm bits-logand-2
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (bits (logand x y) i 0)
+                           (logand (logior (* (expt 2 j) (bits x i j))
+                                           (bits x (1- j) 0))
+                                   (logior (* (expt 2 j) (bits y i j))
+                                           (bits y (1- j) 0)))))
+               :rule-classes ()
+               :hints (("Goal" :use (bits-logand-1
+                     ;                       (:instance bits< (i (1- j)) (j 0))
+                     ;                      (:instance bits< (x y) (i (1- j)) (j 0))
+                                     (:instance or-dist-b (x (bits x i j)) (n j) (y (bits x (1- j) 0)))
+                                     (:instance or-dist-b (x (bits y i j)) (n j) (y (bits y (1- j) 0))))))))
+
+ (local (defthm bits-logand-3
+               (implies (and (integerp a) (>= a 0)
+                             (integerp b) (>= b 0)
+                             (integerp c) (>= c 0)
+                             (integerp d) (>= d 0))
+                        (= (logand (logior a b) (logior c d))
+                           (logior (logior (logand a c) (logand c b))
+                                   (logior (logand b d) (logand a d)))))
+               :rule-classes ()
+               :hints (("Goal" :use ((:instance logand-logior (x (logior a b)) (y c) (z d))
+                                     (:instance logand-logior-alt (y a) (z b) (x c))
+                                     (:instance logand-logior-alt (y a) (z b) (x d))
+
+                     ;			(:instance bit-basic-d (x (logand a d)) (y (logand b d)))
+                                     )))))
+
+ (local (defthm bits-logand-4
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (bits (logand x y) i 0)
+                           (logior (logior (logand (* (expt 2 j) (bits x i j))
+                                                   (* (expt 2 j) (bits y i j)))
+                                           (logand (* (expt 2 j) (bits y i j))
+                                                   (bits x (1- j) 0)))					
+                                   (logior (logand (bits x (1- j) 0)
+                                                   (bits y (1- j) 0))
+                                           (logand (* (expt 2 j) (bits x i j))
+                                                   (bits y (1- j) 0))))))
+				
+               :rule-classes ()
+               :hints (("Goal" :use (bits-logand-2
+                     ;                 (:instance expt-pos (x j))
+                                     (:instance bits-logand-3
+                                                (a (* (expt 2 j) (bits x i j)))
+                                                (b (bits x (1- j) 0))
+                                                (c (* (expt 2 j) (bits y i j)))
+                                                (d (bits y (1- j) 0))))))))
+
+ (local (defthm bits-logand-5
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (logand (* (expt 2 j) (bits x i j))
+                                   (* (expt 2 j) (bits y i j)))
+                           (* (expt 2 j) (logand (bits x i j) (bits y i j)))))				
+               :rule-classes ()
+               :hints (("Goal" :use (
+                     ;                 (:instance expt-pos (x j))
+                                     (:instance and-dist-b (n j) (x (bits x i j)) (y (* (expt 2 j) (bits y i j)))))))))
+
+
+
+ (local (defthm bits-logand-7
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (logand (* (expt 2 j) (bits x i j))
+                                   (bits y (1- j) 0))
+                           0))
+               :rule-classes ()
+               :hints (("Goal" :in-theory (enable logand)
+                        :use (
+;                              bits-logand-6
+                              (:instance fl-unique (x (/ (bits y (1- j) 0) (expt 2 j))) (n 0))
+                     ;                 (:instance expt-pos (x j))
+                     ;                (:instance expt-pos (x (- 1 j)))
+                     ;                 (:instance bits< (x y) (i (1- j)) (j 0))
+                     ;                 (:instance bit-basic-a (x (bits x i j)))
+                              (:instance and-dist-b (n j) (x (bits x i j)) (y (bits y (1- j) 0))))))))
+
+ (local (defthm bits-logand-8
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (bits (logand x y) i 0)
+                           (logior (logior (* (expt 2 j) (logand (bits x i j) (bits y i j)))
+                                           0)
+                                   (logior (logand (bits x (1- j) 0)
+                                                   (bits y (1- j) 0))
+                                           0))))				
+               :rule-classes ()
+               :hints (("Goal" :use (bits-logand-4
+                                     bits-logand-5
+                                     bits-logand-7
+                                     (:instance bits-logand-7 (x y) (y x)))))))
+
+ (local (defthm bits-logand-9
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (bits (logand x y) i 0)
+                           (logior (* (expt 2 j) (logand (bits x i j) (bits y i j)))
+                                   (logand (bits x (1- j) 0)
+                                           (bits y (1- j) 0)))))
+               :rule-classes ()
+               :hints (("Goal" :use (bits-logand-8
+                     ;			(:instance bit-basic-b (x (* (expt 2 j) (logand (bits x i j) (bits y i j)))))
+                     ;			(:instance bit-basic-b (x (logand (bits x (1- j) 0) (bits y (1- j) 0))))
+                                     )))))
+
+ (local (defthm bits-logand-10
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (bits (logand x y) i 0)
+                           (logior (* (expt 2 j) (logand (bits x i j) (bits y i j)))
+                                   (bits (logand x y) (1- j) 0))))
+               :rule-classes ()
+               :hints (("Goal" :in-theory (enable 
+                                           bits
+                                           )
+                        :use (bits-logand-9
+                              (:instance mod-logand (n j)))))))
+
+ (local (defthm bits-logand-11
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (bits (logand x y) i 0)
+                           (+ (* (expt 2 j) (logand (bits x i j) (bits y i j)))
+                              (bits (logand x y) (1- j) 0))))
+               :rule-classes ()
+               :hints (("Goal" :use (bits-logand-10
+
+                     ;                 (:instance bits< (x (logand x y)) (i (1- j)) (j 0))
+                                     ;yuck!
+                                     (:instance or-dist-b
+                                                (x (logand (bits x i j) (bits y i j)))
+                                                (y (bits (logand x y) (1- j) 0))
+                                                (n j)))))))
+
+ (local (defthm bits-logand-12
+               (implies (and (integerp x) (>= x 0)
+                             (integerp y) (>= y 0)
+                             (integerp i) (>= i j)
+                             (integerp j) (> j 0))
+                        (= (bits (logand x y) i 0)
+                           (+ (* (expt 2 j) (bits (logand x y) i j))
+                              (bits (logand x y) (1- j) 0))))
+               :rule-classes ()
+               :hints (("Goal" :use (
+                                     (:instance bits-plus-bits (x (logand x y)) (n i) (p j) (m 0)))))))
+
+ (defthm bits-logand
+   (implies (and     ;(<= i j)
+             (case-split (natp x)) ;drop?
+             (case-split (natp y)) ;drop?
+             (case-split (natp i))
+             (case-split (natp j))
+             )
+            (equal (bits (logand x y) i j)
+                   (logand (bits x i j) (bits y i j))))
+   :hints (("Goal" :in-theory (set-difference-theories
+                               (enable bits)
+                               '(CANCEL_TIMES-EQUAL-CORRECT))
+            :use (bits-logand-11
+                  bits-logand-12
+                  (:instance cancel-equal-*
+                             (a (expt 2 j))
+                             (r (logand (bits x i j) (bits y i j)))
+                             (s (bits (logand x y) i j)))
+
+                  (:instance mod-logand (n (1+ i)))
+                  ))))
+ )
+
+
+
+;prove from bits-logand?
+(defthm bitn-logand
+  (implies (and (integerp x) ; (>= x 0)
+                (integerp y) ; (>= y 0)
+                (integerp n) (>= n 0)
+                )
+           (equal (bitn (logand x y) n)
+                  (logand (bitn x n) (bitn y n))))
+  :hints (("goal" :induct (op-dist-induct x y n))
+	  ("subgoal *1/1" :use ( ;(:instance mod)
+				(:instance bitn-rec-0)
+				(:instance bitn-rec-0 (x y))
+				(:instance bitn-rec-0 (x (logand x y)))))
+	  ("subgoal *1/2" :use ((:instance bitn-rec-pos (n n))
+				(:instance bitn-rec-pos (n n) (x y))
+				(:instance bitn-rec-pos (n n) (x (logand x y)))
+;				(:instance logand-fl)
+                                ))))
+
+(local (defthm bits-logior-1
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp i) (>= i j)
+		  (integerp j) (> j 0))
+	     (= (bits (logior x y) i 0)
+		(logior (+ (* (expt 2 j) (bits x i j))
+			   (bits x (1- j) 0))
+			(+ (* (expt 2 j) (bits y i j))
+			   (bits y (1- j) 0)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits
+                                     )
+		  :use ((:instance mod-logior (n (1+ i)))
+			(:instance expt-split (r 2) (i 1) (j i))
+			(:instance bits-plus-bits (n i) (p j) (m 0))
+			(:instance bits-plus-bits (x y) (n i) (p j) (m 0)))))))
+
+(local (defthm bits-logior-2
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp i) (>= i j)
+		  (integerp j) (> j 0))
+	     (= (bits (logior x y) i 0)
+		(logior (logior (* (expt 2 j) (bits x i j))
+				(bits x (1- j) 0))
+			(logior (* (expt 2 j) (bits y i j))
+				(bits y (1- j) 0)))))
+  :rule-classes ()
+  :hints (("Goal"
+           :use (bits-logior-1
+;                 (:instance bits< (i (1- j)) (j 0))
+;                 (:instance bits< (x y) (i (1- j)) (j 0))
+                 (:instance or-dist-b (x (bits x i j)) (n j) (y (bits x (1- j) 0)))
+                 (:instance or-dist-b (x (bits y i j)) (n j) (y (bits y (1- j) 0))))))))
+
+(local (defthm bits-logior-4
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp i) (>= i j)
+		  (integerp j) (> j 0))
+	     (= (bits (logior x y) i 0)
+		(logior (logior (* (expt 2 j) (bits x i j))
+				(* (expt 2 j) (bits y i j)))
+			(logior (bits x (1- j) 0)
+				(bits y (1- j) 0)))))
+  :rule-classes ()
+  :hints (("Goal"
+           :use (bits-logior-2
+;                 (:instance expt-pos (x j))
+)))))
+
+(local (defthm bits-logior-5
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp i) (>= i j)
+		  (integerp j) (> j 0))
+	     (= (bits (logior x y) i 0)
+		(logior (* (expt 2 j) (logior (bits x i j) (bits y i j)))
+			(bits (logior x y) (1- j) 0))))
+    :otf-flg t
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits mod-logior 
+                                     )
+           :use (bits-logior-4
+                 (:instance or-dist-c (n j) (x (bits x i j)) (y (bits y i j))))))))
+
+(local (defthm bits-logior-6
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp i) (>= i j)
+		  (integerp j) (> j 0))
+	     (= (bits (logior x y) i 0)
+		(+ (* (expt 2 j) (logior (bits x i j) (bits y i j)))
+		   (bits (logior x y) (1- j) 0))))
+  :rule-classes ()
+  :hints (("Goal"
+           :use (bits-logior-5
+;                 (:instance bits< (x (logior x y)) (i (1- j)) (j 0))
+                 (:instance or-dist-b
+                            (x (logior (bits x i j) (bits y i j)))
+                            (y (bits (logior x y) (1- j) 0))
+                            (n j)))))))
+
+(local (defthm bits-logior-7
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp i) (>= i j)
+		  (integerp j) (> j 0))
+	     (= (bits (logior x y) i 0)
+		(+ (* (expt 2 j) (bits (logior x y) i j))
+		   (bits (logior x y) (1- j) 0))))
+  :rule-classes ()
+  :hints (("Goal" :use (
+			(:instance bits-plus-bits (x (logior x y)) (n i) (p j) (m 0)))))))
+
+(defthm bits-logior
+    (implies (and ;(>= i j)
+                  (case-split (natp x))
+                  (case-split (natp y))
+                  (case-split (natp i))
+                  (case-split (natp j))
+                  )
+	     (equal (bits (logior x y) i j)
+		    (logior (bits x i j) (bits y i j))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bits ;natp
+                                     )
+                              '(;COLLECT-CONSTANTS-IN-<-OF-SUMS
+;                                a4 a9
+                                CANCEL_TIMES-EQUAL-CORRECT ;unfortunate
+                                CANCEL-COMMON-FACTORS-IN-EQUAL ;unfortunate
+                                ;INTEGER-TIGHTEN-BOUND
+                                ))
+		  :use (bits-logior-6
+			bits-logior-7
+			(:instance cancel-equal-*
+				   (a (expt 2 j))
+				   (r (logior (bits x i j) (bits y i j)))
+				   (s (bits (logior x y) i j)))
+			(:instance mod-logior (n (1+ i)))
+;			(:instance expt-pos (x j))
+                        ))))
+
+;someday prove from bits-logior (will have to generalize bits-logior?)?
+(defthm bitn-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n)
+                  (>= n 0))
+	     (equal (bitn (logior x y) n)
+                    (logior (bitn x n) (bitn y n))))
+  :hints (("goal" :induct (op-dist-induct x y n))
+	  ("subgoal *1/1" :use (;(:instance logior-mod)
+				(:instance bitn-rec-0)
+				(:instance bitn-rec-0 (x y))
+				(:instance bitn-rec-0 (x (logior x y)))))
+	  ("subgoal *1/2" :use ((:instance bitn-rec-pos (n n))
+				(:instance bitn-rec-pos (n n) (x y))
+				(:instance bitn-rec-pos (n n) (x (logior x y)))
+				;(:instance logior-fl)
+                                ))))
+
+(defthm and-bits-a
+    (implies (and (integerp x) (>= x 0)
+		  (integerp k) (>= k 0))
+	     (= (logand x (expt 2 k))
+		(* (expt 2 k) (bitn x k))))
+  :rule-classes ()
+  :hints (("goal"  :in-theory (enable expt)
+           :induct (or-dist-induct x k))
+	  ("subgoal *1/1" :use ((:instance logand-def (i x) (j 1))
+				(:instance mod012 (m x))
+				(:instance bitn-rec-0)))
+	  ("subgoal *1/2" :use ((:instance logand-def (i x) (j (expt 2 k)))
+				(:instance mod-2*i (i (expt 2 (1- k))))
+				(:instance fl-int (x (expt 2 (1- k))))
+				(:instance bitn-rec-pos (n k))))))
+
+(defthm and-bits-b
+  (implies (and (integerp x) (>= x 0)
+                (integerp k) (>= k 0))
+           (= (logior x (expt 2 k))
+              (+ x
+                 (* (expt 2 k) 
+                    (- 1 (bitn x k))))))
+  :rule-classes ()
+  :hints (("goal"  :in-theory (enable expt) :induct (or-dist-induct x k))
+	  ("subgoal *1/1" :use ((:instance logior-def (i x) (j 1))
+				(:instance mod012 (m x))
+				(:instance quot-mod (m x) (n 2))
+				(:instance bitn-rec-0)))
+	  ("subgoal *1/2" :use ((:instance logior-def (i x) (j (expt 2 k)))
+				(:instance mod-2*i (i (expt 2 (1- k))))
+				(:instance quot-mod (m x) (n 2))
+				(:instance fl-int (x (expt 2 (1- k))))
+				(:instance bitn-rec-pos (n k))))))
+
+;move?
+(local
+ (defthm fl-2**n-1/2
+    (implies (and (integerp n) (> n 0))
+	     (= (fl (/ (1- (expt 2 n)) 2))
+		(1- (expt 2 (1- n)))))
+    :hints (("Goal" :in-theory (enable expt)))
+  :rule-classes ()))
+
+;move?
+(local
+ (defthm mod-2**n-1/2
+   (implies (and (integerp n) (> n 0))
+            (= (mod (1- (expt 2 n)) 2)
+               1))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable expt) 
+            :use ((:instance mod-2*i+1 (i (1- (expt 2 (1- n)))))
+                  (:instance mod012 (m (1- (expt 2 n)))))))))
+
+(local
+ (defthm logand-slice-<-0
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (> n 0)
+                 (< x (expt 2 n)))
+            (= (logand x (- (expt 2 n) 1))
+               (bits x (1- n) 0)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable logand-ones)
+            :use (;(:instance logand-slice-<-0-1)
+                  (:instance mod-does-nothing (m x) (n (expt 2 n))))))))
+
+(local
+ (defthm logand-slice-<-pos-1
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0)
+                 (< x (expt 2 n))
+                 (integerp k) (> k 0)
+                 (< k n))
+            (= (logand x (- (expt 2 n) (expt 2 k)))
+               (* 2 (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k)))))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable expt) 
+            :use ((:instance logand-def (i x) (j (- (expt 2 n) (expt 2 k))))
+                  (:instance expt-weak-monotone (n k) (m n))
+                  (:instance mod-2*i (i (- (expt 2 (1- n)) (expt 2 (1- k))))))))))
+
+(local
+(defthm logand-slice-<-pos-2
+    (implies (and (integerp x) (>= x 0)
+		  (integerp n) (>= n 0)
+		  (< x (expt 2 n))
+		  (integerp k) (> k 0)
+		  (< k n)
+		  (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
+		     (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
+	     (= (logand x (- (expt 2 n) (expt 2 k)))
+		(* (expt 2 k) (bits (fl (/ x 2)) (- n 2) (1- k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt)
+           :use ((:instance logand-slice-<-pos-1))))))
+
+(local
+ (defthm logand-slice-<-pos-3
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0)
+                 (< x (expt 2 n))
+                 (integerp k) (> k 0)
+                 (< k n)
+                 (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
+                    (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
+            (= (logand x (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (fl (/ (mod (fl (/ x 2)) (expt 2 (1- n))) (expt 2 (1- k)))))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (e/d ( bits) (bits-fl)) ;BOZO why?
+            :use ((:instance logand-slice-<-pos-2))))))
+
+;Looping rules in this lemma led to a discussion on the acl2-help list about looping rules (due to subterms
+;not be simplified).
+(local
+ (defthm logand-slice-<-pos-4
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0)
+                 (< x (expt 2 n)))
+            (= (mod (fl (* 1/2 x)) (expt 2 (1- n)))
+               (fl (* 1/2 x))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance mod-does-nothing (m (fl (/ x 2))) (n (expt 2 (1- n))))
+                         (:instance fl-def-linear (x (/ x 2))))
+            :in-theory (set-difference-theories
+                        (enable expt)
+                        '( ;mod-equal
+                          mod-does-nothing
+                           mod-upper-bound-2
+                           mod-upper-bound-linear
+                           mod-non-negative-linear
+                           mod-bnd-1
+;                           mod-bnd-2
+                           mod-bnd-3
+                           ))))))
+
+(local
+ (defthm logand-slice-<-pos-5
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0)
+                 (< x (expt 2 n))
+                 (integerp k) (> k 0)
+                 (< k n)
+                 (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
+                    (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
+            (= (logand x (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (fl (/ (fl (/ x 2)) (expt 2 (1- k)))))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance logand-slice-<-pos-3)
+                         (:instance logand-slice-<-pos-4))))))
+
+(local
+ (defthm logand-slice-<-pos-6
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0)
+                 (< x (expt 2 n))
+                 (integerp k) (> k 0)
+                 (< k n)
+                 (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
+                    (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
+            (= (logand x (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (fl (/ x (expt 2 k))))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable expt)
+            :use ((:instance logand-slice-<-pos-5)
+                  (:instance fl/int-rewrite (x (/ x 2)) (n (expt 2 (1- k)))))))))
+
+(local
+(defthm logand-slice-<-pos-7
+    (implies (and (integerp x) (>= x 0)
+		  (integerp n) (>= n 0)
+		  (< x (expt 2 n))
+		  (integerp k) (> k 0)
+		  (< k n))
+	     (= (fl (/ x (expt 2 k)))
+		(bits x (1- n) k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits)
+           :use ((:instance mod-does-nothing (m x) (n (expt 2 n))))))))
+
+(local
+(defthm logand-slice-<-pos
+    (implies (and (integerp x) (>= x 0)
+		  (integerp n) (>= n 0)
+		  (< x (expt 2 n))
+		  (integerp k) (> k 0)
+		  (< k n)
+		  (= (logand (fl (/ x 2)) (- (expt 2 (1- n)) (expt 2 (1- k))))
+		     (* (expt 2 (1- k)) (bits (fl (/ x 2)) (- n 2) (1- k)))))
+	     (= (logand x (- (expt 2 n) (expt 2 k)))
+		(* (expt 2 k) (bits x (1- n) k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance logand-slice-<-pos-6)
+			(:instance logand-slice-<-pos-7))))))
+
+;move?
+(local
+ (defun and-bits-induct (x n k)
+   (if (and (integerp k) (>= k 0))
+       (if (= k 0)
+           (list x n k)
+         (and-bits-induct (fl (/ x 2)) (1- n) (1- k)))
+     ())))
+
+(local
+ (defthm logand-slice-<
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0)
+                 (< x (expt 2 n))
+                 (integerp k) (>= k 0)
+                 (< k n))
+            (= (logand x (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (bits x (1- n) k))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable expt)
+            :induct (and-bits-induct x n k))
+           ("Subgoal *1/1" :use ((:instance logand-slice-<-0)))
+           ("Subgoal *1/2" :use ((:instance logand-slice-<-pos))))))
+
+(local
+ (defthm logand-slice-1
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (< k n))
+            (= (logand x (- (expt 2 n) (expt 2 k)))
+               (logand (mod x (expt 2 n)) (- (expt 2 n) (expt 2 k)))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance and-dist-d (x (- (expt 2 n) (expt 2 k))) (y x))
+                         (:instance expt-weak-monotone (n k) (m n))
+                         )))))
+
+(local
+ (defthm logand-slice-2
+   (implies (and (integerp x) (>= x 0)
+                 (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (< k n))
+            (= (logand x (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (bits (mod x (expt 2 n)) (1- n) k))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance logand-slice-1)
+                         (:instance logand-slice-< (x (mod x (expt 2 n))))
+                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+                         )))))
+
+(defthm logand-slice
+  (implies (and (integerp x) (>= x 0)
+                (integerp n) (>= n 0)
+                (integerp k) (>= k 0)
+                (< k n))
+           (= (logand x (- (expt 2 n) (expt 2 k)))
+              (* (expt 2 k) (bits x (1- n) k))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable bits) ;yuck?
+           :use ((:instance logand-slice-2)))))
+
+
+
+;move these to logxor.lisp?
+(encapsulate
+ ()
+ (local (defthm logxor-rewrite-1
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
+                              (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))
+                      (logior (logand (fl (/ x 2)) (fl (/ (lnot y n) 2)))
+                              (logand (fl (/ y 2)) (fl (/ (lnot x n) 2))))))
+          :rule-classes ()
+          :hints (("Goal" :in-theory (e/d (bvecp) ( lnot))
+                   :use ((:instance lnot-fl-original (k 1))
+                         (:instance lnot-fl-original (k 1) (x y)))))))
+
+ (local (defthm logxor-rewrite-2
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (logior (logand (fl (/ x 2)) (fl (/ (lnot y n) 2)))
+                              (logand (fl (/ y 2)) (fl (/ (lnot x n) 2))))
+                      (logior (fl (/ (logand x (lnot y n)) 2))
+                              (fl (/ (logand y (lnot x n)) 2)))))
+          :rule-classes ()
+          :hints (("Goal" :in-theory (disable ;logand-fl-rewrite
+                                      lnot)
+                   :use ( ;(:instance logand-fl (y (lnot y n)))
+;(:instance logand-fl (x y) (y (lnot x n)))
+                         )))))
+
+ (local (defthm logxor-rewrite-3
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
+                              (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))
+                      (logior (fl (/ (logand x (lnot y n)) 2))
+                              (fl (/ (logand y (lnot x n)) 2)))))
+          :rule-classes ()
+          :hints (("Goal" :use ((:instance logxor-rewrite-1)
+                                (:instance logxor-rewrite-2))))))
+
+ (local (defthm logxor-rewrite-4
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (logior (fl (/ (logand x (lnot y n)) 2))
+                              (fl (/ (logand y (lnot x n)) 2)))
+                      (fl (/ (logior (logand x (lnot y n))
+                                     (logand y (lnot x n)))
+                             2))))
+          :rule-classes ()
+          :hints (("Goal" :use ( ;(:instance logior-fl 
+;                        (i (logand x (lnot y n)))
+;                       (j (logand y (lnot x n))))
+                                )))))
+
+ (local (defthm logxor-rewrite-5
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
+                              (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))
+                      (fl (/ (logior (logand x (lnot y n))
+                                     (logand y (lnot x n)))
+                             2))))
+          :rule-classes ()
+          :hints (("Goal" :use ((:instance logxor-rewrite-3)
+                                (:instance logxor-rewrite-4))))))
+
+ (local (defthm logxor-rewrite-6
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n))
+                        (= (logxor (fl (/ x 2)) (fl (/ y 2)))
+                           (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
+                                   (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))))
+                   (= (fl (/ (logxor x y) 2))
+                      (fl (/ (logior (logand x (lnot y n))
+                                     (logand y (lnot x n)))
+                             2))))
+          :rule-classes ()
+          :hints (("Goal" :use ((:instance logxor-rewrite-5)
+                                (:instance fl-logxor-by-2 (i x) (j y)))))))
+
+
+
+ (local (defthm logxor-rewrite-8
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (mod (logxor x y) 2)
+                      (logior (logand (mod x 2) (lnot (mod y 2) 1))
+                              (logand (mod y 2) (lnot (mod x 2) 1)))))
+          :rule-classes ()
+          :hints (("Goal" ;:in-theory (disable logxor)
+                   :use ( ;(:instance logxor-mod (i x) (j y))
+                         (:instance mod012 (m x))
+                         (:instance mod012 (m y)))))))
+
+ (local (defthm logxor-rewrite-9
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (mod (logxor x y) 2)
+                      (logior (logand (mod x 2) (mod (lnot y n) 2))
+                              (logand (mod y 2) (mod (lnot x n) 2)))))
+          :rule-classes ()
+          :hints (("Goal" :in-theory (disable lnot logxor)
+                   :use ((:instance logxor-rewrite-8)
+                         )))))
+
+ (local (defthm logxor-rewrite-10
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (mod (logxor x y) 2)
+                      (logior (mod (logand x (lnot y n)) 2)
+                              (mod (logand y (lnot x n)) 2))))
+          :rule-classes ()
+          :hints (("Goal" ;:in-theory (disable logxor)
+                   :use ((:instance logxor-rewrite-9)
+                         )))))
+
+ (local (defthm logxor-rewrite-11
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n)))
+                   (= (mod (logxor x y) 2)
+                      (mod (logior (logand x (lnot y n))
+                                   (logand y (lnot x n)))
+                           2)))
+          :rule-classes ()
+          :hints (("Goal" ;:in-theory (disable logxor)
+                   :use ((:instance logxor-rewrite-10))))))
+
+ (local (defthm logxor-rewrite-12
+          (implies (and (integerp n) (> n 1)
+                        (integerp x) (>= x 0) (< x (expt 2 n))
+                        (integerp y) (>= y 0) (< y (expt 2 n))
+                        (= (logxor (fl (/ x 2)) (fl (/ y 2)))
+                           (logior (logand (fl (/ x 2)) (lnot (fl (/ y 2)) (1- n)))
+                                   (logand (fl (/ y 2)) (lnot (fl (/ x 2)) (1- n))))))
+                   (= (logxor x y)
+                      (logior (logand x (lnot y n))
+                              (logand y (lnot x n)))))
+          :rule-classes ()
+          :hints (("Goal" ;:in-theory (disable logxor)
+                   :use ((:instance logxor-rewrite-6)
+                         (:instance logxor-rewrite-11)
+                         (:instance quot-mod
+                                    (m (logxor x y))
+                                    (n 2))
+;			(:instance logxor-nat (i x) (j y))
+                         (:instance quot-mod
+                                    (m (logior (logand x (lnot y n))
+                                               (logand y (lnot x n))))
+                                    (n 2)))))))
+
+
+;move?
+ (local
+  (defun logxor-induct (x y n)
+    (if (and (integerp n) (>= n 1))
+        (if (= n 1)
+            (list x y)
+          (logxor-induct (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+      ())))
+
+ (local (defthm x01
+          (implies (and (integerp x)
+                        (>= x 0)
+                        (< x 2))
+                   (or (= x 0) (= x 1)))
+          :rule-classes ()))
+
+;move to logxor.lisp?
+;it seems gross that this series uses lnot...
+ (defthmd LOGXOR-REWRITE
+   (implies (and (< x (expt 2 n))
+                 (< y (expt 2 n))
+                 (integerp n) (>= n 1) ;gen?
+                 (integerp x) (>= x 0)
+                 (integerp y) (>= y 0))
+            (= (logxor x y)
+               (logior (logand x (lnot y n))
+                       (logand y (lnot x n)))))
+   :hints (("Goal" :in-theory (disable lnot logxor)
+            :induct (logxor-induct x y n))
+           ("Subgoal *1/2" :in-theory (set-difference-theories
+                                       (enable expt-split)
+                                       '(a15))
+            :use (logxor-rewrite-12))
+           ("Subgoal *1/1" :in-theory (enable lnot)
+            :use ((:instance x01)
+                  (:instance x01 (x y))
+                  (:instance lnot-fl-original (x 0) (k 1))))))
+ )
+
+;n is a free var
+(defthmd logxor-rewrite-2
+    ;; ! Do we really want to get rid of logxor?
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n)
+		  (not (= n 0)))
+	     (equal (logxor x y)
+		    (logior (logand x (lnot y n))
+			    (logand y (lnot x n)))))
+    :rule-classes ((:rewrite :match-free :all))
+    :hints (("Goal" :in-theory (enable bvecp)
+             :use (logxor-rewrite))))
+
+
+(defthm bitn-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp n))
+                (case-split (>= n 0))
+                )
+           (equal (bitn (logxor x y) n)
+                  (logxor (bitn x n) (bitn y n))))
+  :hints (("Goal" :induct (op-dist-induct x y n))
+	  ("Subgoal *1/1" :use ( ;(:instance logxor-mod (i x) (j y))
+				(:instance bitn-rec-0)
+				(:instance bitn-rec-0 (x y))
+				(:instance bitn-rec-0 (x (logxor x y)))))
+	  ("Subgoal *1/2" :use ((:instance bitn-rec-pos (n n))
+				(:instance bitn-rec-pos (n n) (x y))
+				(:instance bitn-rec-pos (n n) (x (logxor x y)))
+                                ))))
+
+
+
+
+
+(encapsulate
+ ()
+
+ (local (defthm bits-logxor-1
+               (implies (and (integerp x) (>= x 0) (< x (expt 2 n))
+                             (integerp y) (>= y 0) (< y (expt 2 n))
+                             (integerp n) (>= n i)
+                             (integerp i) (>= i j)
+                             (integerp j) (>= j 0)
+                             )
+                        (= (bits (logxor x y) i j)
+                           (logior (logand (bits x i j) (bits (lnot y n) i j))
+                                   (logand (bits y i j) (bits (lnot x n) i j)))))
+               :rule-classes ()
+               :hints (("Goal" :in-theory (disable lnot-bvecp lnot bvecp)
+                        :use (logxor-rewrite
+                              lnot-bvecp
+                              (:instance lnot-bvecp (x y))
+                              (:instance bits-logior (x (logand x (lnot y n))) (y (logand y (lnot x n))))
+
+                              (:instance bits-logand (y (lnot y n)))
+                              (:instance bits-logand (x y) (y (lnot x n))))))))
+
+ (local (defthm bits-logxor-2
+               (implies (and (integerp x) (>= x 0) (< x (expt 2 n))
+                             (integerp y) (>= y 0) (< y (expt 2 n))
+                             (integerp n) (> n i)
+                             (integerp i) (>= i j)
+                             (integerp j) (>= j 0))
+                        (= (bits (logxor x y) i j)
+                           (logior (logand (bits x i j) (lnot (bits y i j) (1+ (- i j))))
+                                   (logand (bits y i j) (lnot (bits x i j) (1+ (- i j)))))))
+               :rule-classes ()
+               :hints (("Goal" :in-theory (set-difference-theories
+                                           (enable bvecp)
+                                           '(lnot-bvecp lnot))
+                        :use (bits-logxor-1
+                              (:instance bits-lnot (n n))
+                              (:instance bits-lnot (x y) (n n)))))))
+
+
+ (local (defthm bits-logxor-aux
+          (implies (and (bvecp x n) ; Free variable n is bound here
+                        (bvecp y n)
+                        (natp n)
+                        (natp i)
+                        (natp j)
+                        (> n i)
+                        (>= i j))
+                   (equal (bits (logxor x y) i j)
+                          (logxor (bits x i j) (bits y i j))))
+          :rule-classes nil
+          :hints (("Goal" :in-theory (e/d (bvecp) ( lnot-bvecp lnot))
+                   :use (bits-logxor-2
+                         (:instance logxor-rewrite (x (bits x i j)) (y (bits y i j)) (n (1+ (- i j))))
+;                         (:instance bits<)
+ ;                        (:instance bits< (x y))
+                         )))))
+
+;a nice fact?  make into a better lemma?
+ (local (defthm hack1
+               (implies (natp x)
+                        (> (expt 2 x) x))
+
+               :rule-classes ()))
+
+ (defthm bits-logxor
+   (implies (and (case-split (natp x))
+                 (case-split (natp y))
+                 (case-split (natp i))
+                 (case-split (natp j))
+                 ;(>= i j)
+                 )
+            (equal (bits (logxor x y) i j)
+                   (logxor (bits x i j) (bits y i j))))
+   :hints (("Goal" :in-theory (set-difference-theories
+                               (enable bvecp natp expt-split)
+                               '())
+            :use ((:instance hack1 (x (+ i x y)))
+                  (:instance bits-logxor-aux (n (+ i x y)))))))
+ )
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/log.lisp acl2-6.3/books/rtl/rel9/support/support/log.lisp
--- acl2-6.2/books/rtl/rel9/support/support/log.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/log.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,281 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;**************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+(in-package "ACL2")
+
+;This book includes theorems mixing the logical operators (logand, etc.) with bits and bitn.
+
+(include-book "ground-zero")
+
+(local (include-book "log-proofs"))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(include-book "lnot")
+(include-book "logand")
+(include-book "logior")
+(include-book "logxor")
+
+;move!
+;rename! mod-lognot-by-2
+(defthm mod-logior-9
+  (implies (integerp i)
+           (iff (= (mod (lognot i) 2) 0)
+                (not (= (mod i 2) 0)))))
+
+;move!
+(defthm mod-logior-10
+  (implies (and (integerp i)
+                (integerp j))
+           (iff (and (= (mod i 2) 0) (= (mod j 2) 0))
+                (= (mod (logior i j) 2) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use mod-logior-by-2
+           :in-theory (set-difference-theories
+                       (enable mod-by-2)
+                       '(logior)))))
+
+;BOZO export!
+;gen?
+(defthm logior-logand
+  (implies (and (integerp x)
+                (<= 0 x)
+                (integerp y)
+                (<= 0 y)
+                (integerp z)
+                (<= 0 z))
+           (equal (logior x (logand y z))
+                  (logand (logior x y) (logior x z))))
+  :rule-classes ())
+
+;BOZO export!
+(defthm logior-logand-alt
+  (implies (and (integerp x)
+                (<= 0 x)
+                (integerp y)
+                (<= 0 y)
+                (integerp z)
+                (<= 0 z))
+           (equal (logior (logand y z) x)
+                  (logand (logior x y) (logior x z))))
+  :rule-classes ())
+
+(defthm logand-logior
+  (implies (and (integerp x) (<= 0 x)
+                (integerp y) (<= 0 y)
+                (integerp z) (<= 0 z))
+           (equal (logand x (logior y z))
+                  (logior (logand x y) (logand x z))))
+  :rule-classes ())
+
+(defthm logand-logior-alt
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp z) (>= z 0))
+           (equal (logand (logior y z) x)
+                  (logior (logand y x) (logand z x))))
+  :rule-classes ())
+
+(defthm mod-logand-aux
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp n) (>= n 0))
+           (= (mod (logand x y) (expt 2 n))
+              (logand (mod x (expt 2 n)) y)))
+  :rule-classes ())
+
+;generalize (mod y (expt 2 n)) to anything < 2^n?
+(defthm and-dist-d
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0)
+		  (< x (expt 2 n)))
+	     (= (logand x y)
+		(logand x (mod y (expt 2 n)))))
+  :rule-classes ())
+
+;compare to mod-logand-aux
+;we can wrap the mod around x or y or both (same for bits of logand?)
+(defthm mod-logand
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp n) (>= n 0))
+           (equal (mod (logand x y) (expt 2 n))
+                  (logand (mod x (expt 2 n)) (mod y (expt 2 n))))))
+
+;prove that we can wrap the bits around either arg in the conclusion or both...
+;will have to shift if we don't wrap bits??
+(defthm bits-logand
+   (implies (and     ;(<= i j)
+             (case-split (natp x)) ;drop?
+             (case-split (natp y)) ;drop?
+             (case-split (natp i))
+             (case-split (natp j))
+             )
+            (equal (bits (logand x y) i j)
+                   (logand (bits x i j) (bits y i j)))))
+
+(defthm bitn-logand
+  (implies (and (integerp x) ; (>= x 0)
+                (integerp y) ; (>= y 0)
+                (integerp n) (>= n 0)
+                )
+           (equal (bitn (logand x y) n)
+                  (logand (bitn x n) (bitn y n)))))
+
+(defthm bits-logior
+    (implies (and ;(>= i j)
+                  (case-split (natp x))
+                  (case-split (natp y))
+                  (case-split (natp i))
+                  (case-split (natp j))
+                  )
+	     (equal (bits (logior x y) i j)
+		    (logior (bits x i j) (bits y i j)))))
+
+;someday prove from bits-logior (will have to generalize bits-logior?)?
+(defthm bitn-logior
+    (implies (and (integerp x)
+		  (integerp y)
+		  (integerp n)
+                  (>= n 0))
+	     (equal (bitn (logior x y) n)
+                    (logior (bitn x n) (bitn y n)))))
+
+;give better name, perhaps "logand-with-power2" ?
+(defthm and-bits-a
+    (implies (and (integerp x) (>= x 0)
+		  (integerp k) (>= k 0))
+	     (= (logand x (expt 2 k))
+		(* (expt 2 k) (bitn x k))))
+  :rule-classes ())
+
+(defthm and-bits-b
+  (implies (and (integerp x) (>= x 0)
+                (integerp k) (>= k 0))
+           (= (logior x (expt 2 k))
+              (+ x
+                 (* (expt 2 k) 
+                    (- 1 (bitn x k))))))
+  :rule-classes ())
+
+(defthm logand-slice
+  (implies (and (integerp x) (>= x 0)
+                (integerp n) (>= n 0)
+                (integerp k) (>= k 0)
+                (< k n))
+           (= (logand x (- (expt 2 n) (expt 2 k)))
+              (* (expt 2 k) (bits x (1- n) k))))
+  :rule-classes ())
+
+;move to logxor.lisp?
+(defthmd logxor-rewrite
+   (implies (and (< x (expt 2 n))
+                 (< y (expt 2 n))
+                 (integerp n) (>= n 1) ;gen?
+                 (integerp x) (>= x 0)
+                 (integerp y) (>= y 0))
+            (= (logxor x y)
+               (logior (logand x (lnot y n))
+                       (logand y (lnot x n))))))
+
+;n is a free var
+(defthmd logxor-rewrite-2
+    ;; ! Do we really want to get rid of logxor?
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n)
+		  (not (= n 0)))
+	     (equal (logxor x y)
+		    (logior (logand x (lnot y n))
+			    (logand y (lnot x n)))))
+    :rule-classes ((:rewrite :match-free :all)))
+
+(defthm bitn-logxor
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                (case-split (integerp n))
+                (case-split (>= n 0))
+                )
+           (equal (bitn (logxor x y) n)
+                  (logxor (bitn x n) (bitn y n)))))
+
+
+
+(defthm bits-logxor
+  (implies (and (case-split (natp x))
+                (case-split (natp y))
+                (case-split (natp i))
+                (case-split (natp j))
+;(>= i j)
+                )
+           (equal (bits (logxor x y) i j)
+                  (logxor (bits x i j) (bits y i j))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bvecp natp expt-split)
+                              '())
+           :use ((:instance hack1 (x (+ i x y)))
+                 (:instance bits-logxor-aux (n (+ i x y)))))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logand-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/logand-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logand-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logand-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,671 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;make some of these local?
+(include-book "ground-zero")
+(include-book "../../arithmetic/fl")
+(include-book "../../arithmetic/induct")
+(local (include-book "lognot"))
+(local (include-book "../../arithmetic/top"))
+
+;(in-theory (disable binary-logand))
+
+(defthm logand-with-zero
+  (equal (logand 0 j) 0)
+  :hints (("Goal" :in-theory (enable logand))))
+
+(defthm logand-with-non-integer-arg
+  (implies (or (not (integerp i))
+               (not (integerp j)))
+           (equal (logand i j)
+                  0))
+  :hints (("Goal" :in-theory (enable logand))))
+
+
+
+;Normalize logand terms
+
+
+(defthm logand-commutative
+  (equal (logand j i)
+         (logand i j))
+  :hints (("Goal" :in-theory (enable logand))))
+
+(encapsulate
+ ()
+ (local (defthm logand-associative-helper
+          (implies (and (case-split (integerp i))
+                        (case-split (integerp j))
+                        (case-split (integerp k))
+                        )
+                   (equal (logand (logand i j) k)
+                          (logand i (logand j k))))
+          :hints (("Goal" :in-theory (enable logand evenp)
+                   :induct (logand-three-args-induct i j k)))))
+
+ (defthm logand-associative
+   (equal (logand (logand i j) k)
+          (logand i (logand j k)))))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+         (logand i j k))
+  :hints (("Goal" :in-theory (disable LOGAND-ASSOCIATIVE
+                                      logand-commutative)
+           :use (LOGAND-ASSOCIATIVE
+                 logand-commutative
+                 (:instance LOGAND-ASSOCIATIVE (j i) (i j))))))
+
+(defthm logand-combine-constants
+  (implies (syntaxp (and (quotep i)
+                         (quotep j)))
+           (equal (logand i j k)
+                  (logand (logand i j) k))))
+
+ 
+(defthm logand-with-minus-one
+   (implies (case-split (integerp i))
+            (equal (logand -1 i) i))
+  :hints (("Goal" :in-theory (enable logand))))
+
+;Didn't make this a rewrite rule to avoid backchaining on (integerp (logand i j)) -- should never happen, but
+;just in case.
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logand))))
+
+(defthm logand-negative-integer-type-prescription
+  (implies (and (< i 0)
+                (< j 0)
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (and (< (logand i j) 0)
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logand))))
+
+; rewrites (<= 0 (logand i j)) and (< (logand i j) 0)
+;could this perhaps not fire (say, during backchaining) because of case-splitting of the conclusion, causing
+;us to wish we had a simple rule that the rhs implies the lhs?
+;BOZO consider combining with logand-non-negative
+(defthm logand-negative-rewrite
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (< (logand i j) 0)
+                  (and (< i 0)
+                       (< j 0))))
+  :hints (("Goal" :in-theory (enable logand))))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+;This one is a loner.
+;There's no nice logand-positive rule.  Nor is there a clear rewrite for (< 0 (logand i j))
+;For logand to be positive, the arguments must have bits that overlap, and there's no way to state this.
+(defthm logand-non-positive-integer-type-prescription
+    (implies (and (<= i 0)
+                  (<= j 0))
+	     (and (<= (logand i j) 0)
+		  (integerp (logand i j))))
+  :hints (("Goal" :in-theory (enable logand)))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-positive-rewrite
+    (implies (and (<= i 0)
+                  (<= j 0))
+	     (<= (logand i j) 0))
+  :hints (("Goal" :in-theory (enable logand))))
+
+#| do we want this?
+(defthm logand-negative
+  (implies (and (< i 0)
+                (< j 0)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (integerp (logand i j))
+                (< (logand i j) 0)))
+  :hints (("Goal" :in-theory (enable logand)))
+  :rule-classes (:rewrite (:type-prescription)))
+|#
+
+;think about logand when the args differ in sign
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i))
+    :hints (("Goal" :in-theory (enable logand evenp))))
+
+(defthm logand-equal-minus-one
+  (equal (equal (logand i j) -1)
+         (and (equal i -1) (equal j -1)))
+  :hints (("goal" :in-theory (enable logand evenp))))
+
+(defthm logand-even
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (integerp (* 1/2 (logand i j)))
+                  (or (integerp (* 1/2 i))
+                      (integerp (* 1/2 j)))))
+  :hints (("goal" :in-theory (enable logand evenp))))
+
+(local (in-theory (enable evenp)))
+
+(defthm logand-0-when-one-arg-is-odd
+   (implies (and (not (integerp (* 1/2 j)))
+                 (case-split (integerp j))
+                 (case-split (integerp i))
+                 )
+            (and (equal (equal (logand i j) 0)
+                        (and (integerp (* 1/2 i))
+                             (equal (logand (fl (* 1/2 i)) (fl (* 1/2 j))) 0)))
+                 (equal (equal (logand j i) 0)
+                        (and (integerp (* 1/2 i))
+                             (equal (logand (fl (* 1/2 i)) (fl (* 1/2 j))) 0)))))
+   :hints (("goal" :in-theory (enable logand))))
+
+(defthm logand-simp-1
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (LOGAND (+ 1 (* 2 i))
+                          (+ 1 (* 2 j)))
+                  (+ 1 (* 2 (logand i j)))))
+  :hints (("Goal" :in-theory (enable logand))))
+
+(defthm logand-less-than-minus-one
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< (logand i j) -1)
+                  (or (and (<= i -1) (< j -1))
+                      (and (<= j -1) (< i -1))))))
+
+;simplify the conclusion?
+(defthm logand-negative-5
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< -1 (logand i j))
+                  (and (or (< -1 i)
+                           (< -1 j)
+                           (and (<= -1 j)
+                                (<= -1 i))
+                           )
+                       (or (not (equal i -1))
+                           (not (equal j -1))))))
+  :hints (("Goal" :cases ((equal j -1) (equal i -1))
+           :in-theory (enable logand))))
+
+
+
+;add to this
+;linear?
+;another rule for j?
+(defthm logand-upper-bound-1
+  (implies (<= 0 i)
+           (<= (logand i j) i))
+  :hints (("Goal" :in-theory (enable logand)
+           :induct ( LOG-INDUCT i j))))
+
+
+;phrase in terms of low bit being 0 or 1?
+;try disabled...
+(defthm LOGAND-with-1
+  (implies (case-split (integerp i))
+           (and (equal (logand 1 i)
+                       (if (evenp i)
+                           0
+                         1))
+                ))
+  :hints (("Goal" :in-theory (enable logand))))
+
+;move
+(defthm mod-x-2-rewrite
+  (implies (case-split (integerp x))
+           (equal (mod x 2)
+                  (if (INTEGERP (* 1/2 X))
+                      0
+                    1)))
+  :hints (("Goal" :in-theory (enable mod))))
+
+(defthmd logand-def
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (logand i j)
+              (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+                 (logand (mod i 2) (mod j 2)))))
+  :rule-classes  ((:definition :controller-alist ((binary-logand t t))))
+  :hints (("goal" :in-theory (enable logand))))
+
+(defthm fl-logand-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (fl (* 1/2 (logand i j)))
+                  (logand (fl (* 1/2 i)) (fl (* 1/2 j)))))
+  :hints (("goal" :in-theory (disable logand fl)
+           :use ((:instance logand-def)))))
+
+(defthm floor-logand-by-2
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (floor (logand i j) 2)
+                    (logand (floor i 2) (floor j 2)))))
+
+
+(defthm mod-logand-by-2
+  (equal (mod (logand i j) 2)
+         (logand (mod i 2) (mod j 2)))
+  :hints (("Goal" :in-theory (enable logand mod))))
+
+(defthm logand-i-lognot-i
+  (implies (case-split (integerp i))
+           (equal (LOGAND i (LOGNOT i))
+                  0))
+  :hints (("Goal" :in-theory (enable logand)
+           :induct (LOG-INDUCT i (LOGNOT i)))))
+
+
+
+(defthm logand-special-value
+  (implies (case-split (integerp j))
+           (EQUAL (equal (LOGAND 1 j) j)
+                  (or (equal j 0) (equal j 1))))
+  :hints (("Goal" :in-theory (enable logand)))
+)
+
+(defun or-dist-induct (y n)
+  (if (and (integerp n) (>= n 0))
+      (if (= n 0)
+	  y
+	(or-dist-induct (fl (/ y 2)) (1- n)))
+    ()))
+
+
+(encapsulate 
+ ()
+ (local (defthm logand-2**n-1-aux
+  (implies (and (< i (expt 2 n))
+                (integerp n) ;drop this one
+                (<= 0 i)
+                (case-split (integerp i))
+                )
+           (equal (logand i (+ -1 (expt 2 n)))
+                  i))
+  :hints (("Goal" :in-theory (enable logand expt)
+           :induct (or-dist-induct i n)))))
+
+ (defthmd logand-ones
+  (implies (and (< i (expt 2 n)) ;bozo drop and wrap bits around i? (will have to put that proof elsewhere?)
+                (<= 0 i)
+                (case-split (integerp i))
+                )
+           (equal (logand i (+ -1 (expt 2 n)))
+                  i))
+   :hints (("Goal" :cases ((integerp n)))))
+)
+
+
+(encapsulate 
+ ()
+ (local
+  (defthm and-dist-b-1
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (> n 0))
+	     (= (logand (* (expt 2 n) x) y)
+		(* 2 (logand (* (expt 2 (1- n)) x)
+			     (fl (/ y 2))))))
+    :rule-classes ()
+    :hints (("Goal" :in-theory (set-difference-theories (enable expt-split)
+                                                        '())
+             :use ((:instance logand-def (j y) (i (* (expt 2 n) x)))
+;			(:instance rem-2*i (i (* (expt 2 (1- n)) x)))
+                   )))))
+
+ (local
+  (defthm and-dist-b-2
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (> n 0)
+		  (= (logand (* (expt 2 (1- n)) x) (fl (/ y 2))) 
+		     (* (expt 2 (1- n)) (logand x (fl (/ (fl (/ y 2)) (expt 2 (1- n))))))))
+	     (= (logand (* (expt 2 n) x) y)
+		(* 2 
+		   (* (expt 2 (1- n))
+		      (logand x
+			      (fl (/ (fl (/ y 2)) (expt 2 (1- n)))))))))
+    :rule-classes ()
+    :hints (("Goal" :use ((:instance and-dist-b-1))))))
+
+ (local
+  (defthm and-dist-b-3
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (> n 0)
+		  (= (logand (* (expt 2 (1- n)) x) (fl (/ y 2))) 
+		     (* (expt 2 (1- n)) (logand x (fl (/ (fl (/ y 2)) (expt 2 (1- n))))))))
+	     (= (logand (* (expt 2 n) x) y)
+		(* 2 
+		   (* (expt 2 (1- n))
+		      (logand x
+			      (fl (/ y (expt 2 n))))))))
+    :rule-classes ()
+    :hints (("Goal"  :in-theory (set-difference-theories (enable expt-split)
+                                                         '())
+             :use ((:instance and-dist-b-2)
+                   (:instance fl/int-rewrite (x (/ y 2)) (n (expt 2 (1- n)))))))))
+
+ (defthm AND-DIST-B
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (>= n 0))
+            (= (logand (* (expt 2 n) x) y)
+               (* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+   :rule-classes ()
+   :hints (("Goal" :induct (or-dist-induct y n))
+           ("Subgoal *1/2" :use ((:instance and-dist-b-3))))))
+
+
+
+#|
+
+(local
+(defthm and-dist-c-1
+    (implies (and (integerp x) (>= x 0)
+		  (integerp n) (>= n 0))
+	     (= x (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
+			  (mod x (expt 2 n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-fl-2 (x x) (y (expt 2 n)))
+			(:instance or-dist-b (x (fl (/ x (expt 2 n)))) (y (mod x (expt 2 n))))
+			(:instance mod<n (m x) (n (expt 2 n)))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+                        )))))
+
+(local
+(defthm and-dist-c-2
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0))
+	     (= (logand x y)
+		(logior (logand (* (expt 2 n) (fl (/ x (expt 2 n))))
+				y)
+			(logand (mod x (expt 2 n))
+				y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance and-dist-c-1)
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+			(:instance bit-basic-h 
+				   (x y)
+				   (y (* (expt 2 n) (fl (/ x (expt 2 n)))))
+				   (z (mod x (expt 2 n))))
+			(:instance bit-basic-c (x (* (expt 2 n) (fl (/ x (expt 2 n))))))
+			(:instance bit-basic-c (x (mod x (expt 2 n))))
+			(:instance bit-basic-c
+				   (x (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
+					      (mod x (expt 2 n))))))))))
+
+(local
+ (defthm and-dist-c-3
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0))
+	     (= (logand x y)
+		(logior (* (expt 2 n) 
+			   (logand (fl (/ x (expt 2 n)))
+				   (fl (/ y (expt 2 n)))))
+			(logand (mod x (expt 2 n))
+				y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance and-dist-c-2)
+			(:instance and-dist-b (x (fl (/ x (expt 2 n))))))))))
+
+(local
+(defthm and-dist-c-4
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0))
+	     (= (logand x y)
+		(+ (* (expt 2 n) 
+		      (logand (fl (/ x (expt 2 n)))
+			      (fl (/ y (expt 2 n)))))
+		   (logand (mod x (expt 2 n))
+			   y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance and-dist-c-3)
+			(:instance or-dist-b
+				   (x (logand (fl (/ x (expt 2 n)))
+					      (fl (/ y (expt 2 n)))))
+				   (y (logand (mod x (expt 2 n))
+					      y)))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))			
+			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
+			(:instance and-dist-a (x (mod x (expt 2 n)))))))))
+
+(defthm AND-DIST-C
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0))
+	     (= (mod (logand x y) (expt 2 n))
+		(logand (mod x (expt 2 n)) y)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance and-dist-c-4)
+;			(:instance mod+-thm 
+	;			   (m (logand (mod x (expt 2 n)) y)) 
+		;		   (n (expt 2 n))
+			;	   (a (logand (fl (/ x (expt 2 n))) (fl (/ y (expt 2 n))))))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))			
+			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
+			(:instance and-dist-a (x (mod x (expt 2 n))))
+			(:instance mod-does-nothing (m (logand (mod x (expt 2 n)) y))
+                                   (n (expt 2 n)))))))
+
+
+(defthm logand-def
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (logand i j)
+                  (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+                     (logand (mod i 2) (mod j 2)))))
+  :rule-classes nil :hints
+  (("goal" :in-theory (enable logand))))
+
+(defun op-dist-induct-2 (i j n)
+  (if (and (integerp n) (>= n 0))
+      (if  (= n 0)
+	  (list i j)
+	(op-dist-induct (floor i 2) (floor j 2) (1- n)))
+    ()))
+
+(DEFTHM LOGAND-DEF-hack
+  (IMPLIES (AND (syntaxp (equal i 'x))
+                (CASE-SPLIT (INTEGERP I))
+                (CASE-SPLIT (INTEGERP J)))
+           (EQUAL (LOGAND I J)
+                  (+ (* 2
+                        (LOGAND (FL (* 1/2 I)) (FL (* 1/2 J))))
+                     (LOGAND (MOD I 2) (MOD J 2)))))
+
+)
+
+
+(DEFTHM LOGAND-DEF-hack-2
+  (IMPLIES (AND (syntaxp (equal i 'y))
+                (CASE-SPLIT (INTEGERP I))
+                (CASE-SPLIT (INTEGERP J)))
+           (EQUAL (LOGAND I J)
+                  (+ (* 2
+                        (LOGAND (FL (* 1/2 I)) (FL (* 1/2 J))))
+                     (LOGAND (MOD I 2) (MOD J 2)))))
+
+)
+
+
+(defthm AND-DIST-C
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0)
+;                  (< x (expt 2 n))
+)
+	     (= (mod (logand x y) (expt 2 n))
+		(logand (mod x (expt 2 n)) y)))
+  :rule-classes ()
+  :hints (
+          ("goal" :in-theory (enable logand-def expt-split)
+           :induct (op-dist-induct x y n))))
+
+  :hints (("Goal" :use ((:instance and-dist-c-4)
+;			(:instance mod+-thm 
+	;			   (m (logand (mod x (expt 2 n)) y)) 
+		;		   (n (expt 2 n))
+			;	   (a (logand (fl (/ x (expt 2 n))) (fl (/ y (expt 2 n))))))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))			
+			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
+			(:instance and-dist-a (x (mod x (expt 2 n))))
+			(:instance mod-does-nothing (m (logand (mod x (expt 2 n)) y))
+                                   (n (expt 2 n)))))))
+
+
+;(local (include-book "bitn"))
+
+
+;change name and param names eventually
+(defthm AND-BITS-A
+  (implies (and (integerp x); (>= x 0)
+                (integerp k); (>= k 0)
+                )
+           (equal (logand x (expt 2 k))
+                  (* (expt 2 k) (bitn x k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories (enable expt-split bitn bits logand)
+                                                      '())
+           :induct (or-dist-induct x k))))
+
+(defthm LOGAND-def
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (logand i j)
+                  (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+                     (logand (mod i 2) (mod j 2)))))
+  :hints (("Goal" :in-theory (enable logand))))
+|#
+
+(defthm logand-0 
+  (equal (logand 0 j) 0)
+  :hints (("goal" :in-theory (enable logand)))
+  )
+
+(defthm logand-even-2
+  (implies (and (integerp i)
+                (integerp j))
+           (equal (or (= (mod i 2) 0)
+                      (= (mod j 2) 0))
+                  (= (mod (logand i j) 2) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable mod-by-2))))
+
+
+
+#|
+
+
+;BOZO try!
+
+(defun op-dist-induct-special (i j n)
+  (if (and (integerp n) (>= n 0))
+      (if  (= n 0)
+	  (list i j)
+	(op-dist-induct-special (fl (/ i 2)) j n))
+    ()))
+
+(defun induct-fun (i)
+  (if (zp i)
+      nil
+    (induct-fun (fl (/ i 2)))))
+
+(defun op-dist-induct-negative (i j n)
+  (if (and (integerp n) (<= n 0))
+      (if (= n 0)
+	  (list i j)
+	(op-dist-induct-negative (fl (/ i 2)) (fl (/ j 2)) (1+ n)))
+    ()))
+  
+(defthm mod-logand-aux
+    (implies (and (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0))
+	     (= (mod (logand x y) (expt 2 n))
+		(logand (mod x (expt 2 n)) y)))
+    :otf-flg t
+  :rule-classes ()
+  :hints (("Goal" :do-not-induct t 
+           :do-not '(generalize)
+           :induct ( op-dist-induct x y n)
+           :expand (LOGAND Y (MOD X (EXPT 2 N)))
+           :in-theory (e/d (logand zip expt-split) (evenp)))))
+  )
+
+
+|#
+
+(defthm integer-tighten-bound
+  (implies (integerp x)
+           (equal (< -1 x)
+                  (<= 0 x))))
+
+;BOZO dup?
+(defthmd logand-rewrite
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                )
+           (equal (logand x y)
+                  (+ (* 2 (logand (fl (/ x 2)) (fl (/ y 2))))
+                     (logand (mod x 2) (mod y 2)))))
+  :hints (("Goal" :in-theory (enable LOGAND-DEF)))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+
+(defthm logand-bnd
+   (implies (<= 0 x)
+            (<= (logand x y) x))
+   :rule-classes :linear
+   )
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logand))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logand.lisp acl2-6.3/books/rtl/rel9/support/support/logand.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logand.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logand.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,383 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+This book includes lemmas about LOGAND.  Note that LOGAND is a macro which expands to nested calls to
+BINARY-LOGAND. Both LOGAND and BINARY-LOGAND are built into ACL2.
+
+This book contains only results; all the proofs are done in the book logand-proofs.
+
+Todo:
+ use set-invisible-fns-alist - or find a better way?
+ rules for logand x with lognot x anywhere in there?
+ should logand-with-0 be both sides? what about logand-with-minus-one
+ how order rules for efficiency? perhaps make a separate documentation book?
+ any other log lemmas?
+ are the 4 enough for assoc comm functions? 
+
+|#
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "ground-zero")
+(local (include-book "logand-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;;
+;; Rules to normalize logand terms (recall that LOGAND is a macro for BINARY-LOGAND):
+;;
+
+(defthm logand-associative
+  (equal (logand (logand i j) k)
+         (logand i (logand j k))))
+
+(defthm logand-commutative
+  (equal (logand j i)
+         (logand i j)))
+
+(defthm logand-commutative-2
+  (equal (logand j i k)
+         (logand i j k)))
+
+(defthm logand-combine-constants
+  (implies (syntaxp (and (quotep i)
+                         (quotep j)))
+           (equal (logand i j k)
+                  (logand (logand i j) k))))
+
+
+;;
+;; LOGAND with special values
+;;
+
+(defthm logand-with-non-integer-arg
+  (implies (or (not (integerp i))
+               (not (integerp j)))
+           (equal (logand i j)
+                  0)))
+
+;0 should always be brought to the front of logand
+;should we have a rule with the second arg being 0?
+(defthm logand-with-zero
+  (equal (logand 0 j) 0))
+
+;-1 should always be brought to the front of logand
+;should we have both cases or not?
+(defthm logand-with-minus-one
+  (implies (case-split (integerp i))
+           (equal (logand -1 i) i)))
+
+
+
+;;
+;; Type facts
+;;
+
+;this goes through:
+;(thm (integerp (logand i j)))
+
+
+(defthm logand-integer-type-prescription
+  (integerp (logand i j))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logand))))
+
+
+
+;These three go together.
+
+;logand is negative iff either arg is negative
+
+;Didn't make this a rewrite rule to avoid backchaining on (integerp (logand i j)) -- should never happen, but
+;just in case.
+(defthm logand-non-negative-integer-type-prescription
+  (implies (or (<= 0 i)
+               (<= 0 j))
+           (and (<= 0 (logand i j))
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-negative-integer-type-prescription
+  (implies (and (< i 0)
+                (< j 0)
+                (case-split (integerp i))
+                (case-split (integerp j)))
+           (and (< (logand i j) 0)
+                (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+; rewrites (<= 0 (logand i j)) and (< (logand i j) 0)
+;could this perhaps not fire (say, during backchaining) because of case-splitting of the conclusion, causing
+;us to wish we had a simple rule that natp args imply logand is natp?
+;maybe don't want this one?
+(defthm logand-negative-rewrite
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (< (logand i j) 0)
+                  (and (< i 0)
+                       (< j 0)))))
+
+(defthm logand-non-negative
+  (implies (or (<= 0 x)
+               (<= 0 y)
+               )
+           (<= 0 (logand x y))))
+
+;There's no nice logand-positive rule.  Nor is there a clear rewrite for (< 0 (logand i j))
+;For logand to be positive, the arguments must have bits that overlap, and there's no way to state this.
+(defthm logand-non-positive-integer-type-prescription
+    (implies (and (<= i 0)
+                  (<= j 0))
+	     (and (<= (logand i j) 0)
+		  (integerp (logand i j))))
+  :rule-classes (:type-prescription))
+
+(defthm logand-non-positive-rewrite
+    (implies (and (<= i 0)
+                  (<= j 0))
+	     (<= (logand i j) 0)))
+
+#| do we want this?
+(defthm logand-negative
+  (implies (and (< i 0)
+                (< j 0)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (integerp (logand i j))
+                (< (logand i j) 0)))
+  :hints (("Goal" :in-theory (enable logand)))
+  :rule-classes (:rewrite (:type-prescription)))
+|#
+
+
+
+; If logand is less than -1, then both i and j are <= -1, and at least one of them is strictly < -1. 
+(defthm logand-less-than-minus-one
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< (logand i j) -1)
+                  (or (and (<= i -1) (< j -1))
+                      (and (<= j -1) (< i -1))))))
+
+;BOZO move!
+;perhaps put on a backchain limit?
+(defthm integer-tighten-bound
+  (implies (integerp x)
+           (equal (< -1 x)
+                  (<= 0 x))))
+#|
+;rewrite < -1 to <= 0?
+;simplify the conclusion?
+(defthm logand-negative-5
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< -1 (logand i j))
+                  (not (and (< i 0)
+                            (< j 0))))))
+
+:hints (("Goal" :cases ((equal j -1) (equal i -1))
+         :in-theory (enable logand))))
+
+|#
+
+
+
+(defthm logand-self
+  (implies (case-split (integerp i))
+           (equal (logand i i) i)))
+
+(defthm logand-equal-minus-one
+  (equal (EQUAL (LOGAND i j) -1)
+         (and (equal i -1)
+              (equal j -1))))
+
+(defthm logand-even
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (INTEGERP (* 1/2 (logand i j)))
+                  (or (INTEGERP (* 1/2 i))
+                      (INTEGERP (* 1/2 j))))))
+
+;weird?
+(defthm logand-0-when-one-arg-is-odd
+  (implies (and (not (integerp (* 1/2 j)))
+                (case-split (integerp j))
+                (case-split (integerp i))
+                )
+           (and (equal (equal (logand i j) 0)
+                       (and (integerp (* 1/2 i))
+                            (equal (logand (fl (* 1/2 i)) (fl (* 1/2 j))) 0)))
+                (equal (equal (logand j i) 0)
+                       (and (integerp (* 1/2 i))
+                            (equal (logand (fl (* 1/2 i)) (fl (* 1/2 j))) 0))))))
+
+(defthm logand-simp-1
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (LOGAND (+ 1 (* 2 i))
+                          (+ 1 (* 2 j)))
+                  (+ 1 (* 2 (logand i j))))))
+
+;add to this
+;make linear?
+(defthm logand-upper-bound-1
+  (implies (<= 0 i)
+           (<= (logand i j) i)))
+
+
+;BOZO same as  logand-upper-bound-1
+(defthm logand-bnd
+   (implies (<= 0 x)
+            (<= (logand x y) x))
+   :rule-classes :linear
+   )
+
+
+;trying disabled...
+(defthmd logand-with-1
+  (implies (case-split (integerp i))
+           (equal (logand 1 i)
+                  (if (evenp i)
+                      0
+                    1))))
+
+;trying disabled...
+;rename
+;BOZO make a nice rule for logand with 1?
+(defthmd logand-special-value
+  (implies (case-split (integerp j))
+           (equal (equal (logand 1 j) j)
+                  (or (equal j 0) (equal j 1)))))
+
+(defthmd logand-def
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (logand i j)
+              (+ (* 2 (logand (fl (* 1/2 i)) (fl (* 1/2 j))))
+                 (logand (mod i 2) (mod j 2)))))
+  :rule-classes  ((:definition :controller-alist ((binary-logand t t)))))
+
+
+(defthm fl-logand-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (fl (* 1/2 (logand i j)))
+                  (logand (fl (* 1/2 i)) (fl (* 1/2 j))))))
+
+(defthm floor-logand-by-2
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (floor (logand i j) 2)
+                    (logand (floor i 2) (floor j 2)))))
+
+(defthm mod-logand-by-2
+  (equal (mod (logand i j) 2)
+         (logand (mod i 2) (mod j 2))))
+
+;allow them to occur in other orders (perhaps with intervening terms)?
+;think about this
+;make a version for logior
+(defthm logand-i-lognot-i
+  (implies (case-split (integerp i))
+           (equal (LOGAND i (LOGNOT i))
+                  0)))
+
+
+
+
+
+
+;make a nice recognizer?
+;handle negative case?
+;rename?
+(defthmd logand-ones
+  (implies (and (< i (expt 2 n)) ;drop and wrap bits around i?
+                (<= 0 i)
+                (case-split (integerp i))
+                )
+           (equal (logand i (1- (expt 2 n)))
+                  i)))
+
+#|
+
+;change name and param names eventually
+(defthm AND-BITS-A
+  (implies (and (integerp x); (>= x 0)
+                (integerp k); (>= k 0)
+                )
+           (equal (logand x (expt 2 k))
+                  (* (expt 2 k) (bitn x k))))
+  :rule-classes ())
+
+|#
+
+(defthm AND-DIST-B
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (>= n 0))
+            (= (logand (* (expt 2 n) x) y)
+               (* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+   :rule-classes ())
+
+
+;BOZO also have logand-with-zero
+(defthm logand-0 
+  (equal (logand 0 j) 0))
+
+
+(defthmd logand-rewrite
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                )
+           (equal (logand x y)
+                  (+ (* 2 (logand (fl (/ x 2)) (fl (/ y 2))))
+                     (logand (mod x 2) (mod y 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logand t t)))))
+
+(defthm logand-even-2
+  (implies (and (integerp i)
+                (integerp j))
+           (equal (or (= (mod i 2) 0)
+                      (= (mod j 2) 0))
+                  (= (mod (logand i j) 2) 0)))
+  :rule-classes ())
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logeqv.lisp acl2-6.3/books/rtl/rel9/support/support/logeqv.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logeqv.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logeqv.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,145 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "ground-zero")
+(local (include-book "../../arithmetic/top"))
+(local (include-book "logior"))
+(local (include-book "logand"))
+(local (include-book "logorc1"))
+(local (include-book "lognot"))
+
+
+(local (in-theory (enable logorc1))) ;remove
+
+;type?
+
+(defthm logeqv-bound
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (<= (logeqv i j) -1))
+  :hints (("goal" :in-theory (enable logeqv logior))))
+
+(defthm logeqv-with-zero
+  (equal (logeqv 0 i)
+         (lognot i))
+  :hints (("goal" :in-theory (enable lognot logeqv)))
+  )
+
+(defthm logeqv-commutative
+  (equal (logeqv i j)
+         (logeqv j i))
+  :hints (("goal" :in-theory (enable lognot logeqv)))
+  )
+
+(defthm logeqv-with-minus-1
+  (implies (case-split (integerp i))
+           (equal (logeqv -1 i)
+                  i))
+  :hints (("goal" :in-theory (enable logeqv))))
+
+(defthm logeqv-even
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (integerp (* 1/2 (logeqv i j)))
+                  (or (and (not (integerp (* 1/2 i)))
+                           (integerp (* 1/2 j)))
+                      (and (integerp (* 1/2 i))
+                           (not (integerp (* 1/2 j)))))))
+  :hints (("goal" :in-theory (enable logeqv))))
+
+
+(defthm logeqv-with-non-integer-arg
+  (implies (not (integerp i))
+           (and (equal (binary-logeqv i j)
+                       (lognot j))
+                (equal (binary-logeqv j i)
+                       (lognot j))))
+  :hints (("goal" :in-theory (enable binary-logeqv))))
+
+(defthm logeqv-self
+  (equal (logeqv x x) -1)
+  :hints (("goal" :in-theory (enable logeqv))))
+
+(defthm floor-logeqv-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (floor (logeqv i j) 2)
+                  (logeqv (floor i 2) (floor j 2))))
+  :hints (("goal" :in-theory (enable logeqv))))
+
+(defthm fl-logeqv-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (fl (* 1/2 (logeqv i j)))
+                  (logeqv (fl (* 1/2 i)) (fl (* 1/2 j)))))
+  :hints (("goal" :in-theory (enable logeqv))))
+
+;i'm not sure which way this rule should go but note that both parts of this rule rewrite to the same rhs
+(defthm lognot-logeqv
+  (and (equal (logeqv (lognot i) j)
+              (lognot (logeqv i j)))
+       (equal (logeqv j (lognot i))
+              (lognot (logeqv i j))))
+  :hints (("goal" :in-theory (enable logeqv logand logior logorc1 
+                                     evenp ;BOZO prove evenp-lognot and drop this
+                                     )
+           :induct (log-induct-allows-negatives i j))))
+
+
+
+#|
+
+
+(local(defthm logeqv-mod-1
+    (implies (and (integerp i) (>= i 0)
+		  (integerp j) (>= j 0))
+	     (iff (= (mod (logeqv i j) 2) 0)
+		  (or (= (mod (logorc1 i j) 2) 0)
+		      (= (mod (logorc1 j i) 2) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logorc1 logand)
+		  :use ((:instance logand-even (i (logorc1 i j)) (j (logorc1 j i))))))))
+
+(local(defthm logeqv-mod
+    (implies (and (integerp i) (>= i 0)
+		  (integerp j) (>= j 0))
+	     (iff (= (mod (logeqv i j) 2) 0)
+		  (not (= (logxor (mod i 2) (mod j 2))
+			  0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logorc1 logeqv)
+		  :use ((:instance logeqv-mod-1)
+			(:instance logorc1-mod)
+			(:instance logorc1-mod (i j) (j i))
+			(:instance mod012 (x i))
+			(:instance mod012 (x j)))))))
+|#
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logior-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/logior-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logior-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logior-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,735 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(include-book "ground-zero")
+
+;the order of these matters (lognot should come late)
+(local (include-book "logand"))
+(local (include-book "lognot"))
+(local (include-book "../../arithmetic/top")) ;try
+
+(local (in-theory (enable evenp)))
+
+;split?
+(defthm logior-with-non-integer-arg
+  (implies (not (integerp i))
+           (and (equal (logior i j)
+                       (ifix j))
+                (equal (logior j i)
+                       (ifix j))))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-0
+  (implies (case-split (integerp j))
+           (equal (logior 0 j)
+                  j))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-commutative
+  (equal (logior j i)
+         (logior i j))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-associative
+  (equal (logior (logior i j) k)
+         (logior i (logior j k)))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+         (logior i j k))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-combine-constants
+  (implies (syntaxp (and (quotep i)
+                         (quotep j)))
+           (equal (logior i j k)
+                  (logior (logior i j) k))))
+
+(defthm logior-with-an-arg-of-minus-one
+  (implies (case-split (integerp i))
+           (equal (logior -1 i) -1))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-non-negative-integerp-type
+  (and (implies (and (<= 0 i)
+                     (<= 0 j))
+                (and (integerp (logior i j))
+                     (<= 0 (logior i j)))))
+  :rule-classes ( :type-prescription)
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-non-negative
+  (and (implies (and (<= 0 i)
+                     (<= 0 j))
+                (<= 0 (logior i j)))))
+
+(defthm logior-equal-0
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (equal (logior i j) 0)
+                  (and (equal i 0) (equal j 0))))
+  :hints (("goal" :in-theory (enable logior))))
+
+(defthm logior-even
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (integerp (* 1/2 (logior i j)))
+                  (and (integerp (* 1/2 i))
+                       (integerp (* 1/2 j)))))
+  :hints (("goal" :in-theory (enable logior))))
+
+(defthm logior-negative-1
+  (implies (and (< i 0)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (integerp (logior i j))
+                (< (logior i j) 0)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-negative-2
+  (implies (and (< j 0)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (integerp (logior i j))
+                (< (logior i j) 0)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-negative-3
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< (logior i j) 0)
+                  (or (< i 0)
+                      (< j 0))))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-non-positive
+  (implies (and (<= i 0)
+                (<= j 0)
+                )
+           (<= (logior i j) 0))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-self
+  (implies (case-split (integerp i))
+           (equal (logior i i) i))
+    :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-simp-1
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (logior (* 2 i) (* 2 j))
+                  (* 2 (logior i j))))
+  :hints (("Goal" :in-theory (enable logior))))
+
+
+
+
+(defthm logior-positive
+  (implies (and (< 0 i)
+                (< 0 j)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (integerp (logior i j))
+                (< 0 (logior i j))))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-positive-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (< 0 (logior i j))
+                  (and (<= 0 i)
+                       (<= 0 j)
+                       (or (< 0 i)
+                           (< 0 j)))))
+  :hints (("Goal" :in-theory (enable logior))))
+  
+
+(defthm logior-negative-5
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< -1 (logior i j))
+                  (AND (< -1 I) (< -1 J))
+                  ))
+  :hints (("Goal" :cases ((equal j -1) (equal i -1))
+           :in-theory (enable logior))))
+
+(defthm logior-i-lognot-i
+  (implies (case-split (integerp i))
+           (equal (logior i (lognot i))
+                  -1))
+  :hints (("goal" :in-theory (enable logior)
+           :induct (log-induct i (lognot i)))))
+
+;move? odd...
+(defthm fl-expression-rewrites-to-last-bit
+  (implies (integerp i)
+           (equal (+ I (* -2 (FL (* 1/2 I))))
+                  (if (evenp i)
+                      0
+                    1))))
+
+(defthm fl-logior-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (fl (* 1/2 (logior i j)))
+                  (logior (fl (/ i 2)) (fl (/ j 2)))))
+  :hints (("goal" :in-theory (enable logior))))
+
+
+(defthm floor-logior-by-2
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (floor (logior i j) 2)
+                    (logior (floor i 2) (floor j 2)))))
+
+(defthm mod-logior-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (mod (logior i j) 2)
+                  (logior (mod i 2) (mod j 2))))
+  :hints (("goal" :in-theory (enable mod-by-2))))
+
+(defthmd logior-def
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (logior i j)
+                  (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+                     (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t))))
+  :hints (("goal"; :in-theory (enable  mod)
+           :use ((:instance mod-fl-2 (x (logior i j)) (y 2)))
+;           :use ((:instance mod (x i) (y j)))
+           )))
+
+
+
+
+
+
+(local (include-book "bvecp")) ;;try
+
+
+(local (defun ls-induct (k x)
+   (if (zp k)
+       x
+     (ls-induct (1- k) (fl (/ x 2))))))
+
+(local (defthm logior-ones-3-1
+     (implies (and (integerp k) (> k 0))
+              (= (fl (/ (1- (expt 2 k)) 2))
+                 (1- (expt 2 (1- k)))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (set-difference-theories
+                               (enable expt)
+                               '())
+           :use ((:instance fl-unique (x (/ (1- (expt 2 k)) 2)) (n (1- (expt 2 (1- k))))))))))
+
+(local (defthm logior-ones-3-2
+              (implies (and (integerp k) (> k 0))
+                       (= (mod (1- (expt 2 k)) 2) 1))
+              :rule-classes ()
+              :hints (("Goal" :in-theory (e/d (expt) (mod-2*i))
+                       :use ((:instance mod012 (m (1- (expt 2 k))))
+                             (:instance mod-mod-2-not-equal (m (1- (expt 2 k))))
+                             (:instance mod-2*i (i (expt 2 (1- k))))
+                             )))))
+
+(local (defthm logior-ones-3
+    (implies (and (integerp k) (>= k 0)
+		  (integerp x) (>= x 0) (< x (expt 2 k)))
+	     (= (logior (1- (expt 2 k)) x)
+		(1- (expt 2 k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt mod-mult-of-n)
+           :induct (ls-induct k x))
+	  ("Subgoal *1/2" :use (logior-ones-3-1
+				logior-ones-3-2
+				(:instance mod012 (m x))
+				(:instance quot-mod (m x) (n 2))
+				(:instance quot-mod (m (logior (1- (expt 2 k)) x)) (n 2))
+;				(:instance natp-logior (i (1- (expt 2 k))) (j x))
+				(:instance fl-def-linear (x (/ x 2)))
+;				(:instance logior-fl-2 (i (1- (expt 2 k))) (j x))
+	;			(:instance logior-mod-2 (i (1- (expt 2 k))) (j x))
+                                )))))
+
+;make into a better form for rewriting?
+;gen to make conclusion the cat of the high bits of x (none if x is a bvecp) with a vector of ones?
+(defthm logior-ones
+    (implies (and (natp n) ;gen?
+		  (bvecp x n))
+	     (equal (logior x (1- (expt 2 n)))
+		    (1- (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable  bvecp)
+           :use ((:instance logior-ones-3 (k n))))))
+
+;rename
+(defthm logior-1-x
+    (implies (bvecp x 1)
+	     (equal (logior 1 x) 1))
+  :hints (("Goal" :use ((:instance logior-ones (n 1))))))
+
+
+(local (defthm or-dist-a-helper
+  (implies (and (< i (expt 2 n))
+                (< j (expt 2 n))
+                (integerp i)
+                (>= i 0)
+                )
+           (< (logior i j) (expt 2 n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable ;expt ;yuck
+                              expt-split
+                              )
+           :induct (op-dist-induct i j n))
+	  ("Subgoal *1/2" :use ((:instance logior-def)
+				(:instance mod012 (m i))
+				(:instance mod012 (m j))))
+          ("Subgoal *1/3" :use ((:instance logior-def)
+                                (:instance mod012 (m i))
+				(:instance mod012 (m j))
+                                )))))
+
+;n is a free var
+;rename
+;consider :linear?
+(defthm or-dist-a
+  (implies (and (< i (expt 2 n))
+                (< j (expt 2 n))
+                )
+           (< (logior i j) (expt 2 n)))
+  :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :use ( or-dist-a-helper))))
+
+(defthm logior-bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+
+
+
+;gen?
+;whoa.  this is a lower bound
+;unfortunate to have to disable those rules..
+(defthm logior-bnd
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (<= x (logior x y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d () (LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE
+                                      FL-<-INTEGER
+                                      FL->-INTEGER
+                                      FL-LOGIOR-BY-2
+                                      FL-OF-EVEN/2)
+                                  )
+           :induct (log-induct x y))
+	  ("Subgoal *1/2" :use ((:instance logior-def (i x) (j y))
+				(:instance quot-mod (m x) (n 2))
+				(:instance mod012 (m x))
+				(:instance mod012 (m y))
+                                ))))
+
+
+
+(local
+;gen
+ (defthm or-dist-b-1
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0)
+                 (< y (expt 2 n)))
+            (= (logior (* (expt 2 n) x) y)
+               (+ (* 2 (logior (fl (* (expt 2 (1- n)) x))
+                               (fl (/ y 2))))
+                  (logior (mod (* (expt 2 n) x) 2)
+                          (mod y 2)))))
+   :rule-classes ()
+   :hints (("Goal"  :in-theory (enable expt-split)
+            :use ((:instance logior-def (i (* (expt 2 n) x)) (j y)))))))
+
+(local
+ (defthm or-dist-b-2
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0)
+                 (< y (expt 2 n)))
+            (= (logior (* (expt 2 n) x) y)
+               (+ (* 2 (logior (* (expt 2 (1- n)) x)
+                               (fl (/ y 2))))
+                  (mod y 2))))
+   :rule-classes ()
+   :hints (("Goal"  :in-theory (enable expt) ;yuck
+            :use ((:instance or-dist-b-1)
+                  (:instance fl-int (x (* (expt 2 (1- n)) x)))
+                  (:instance mod-2*i (i (* (expt 2 (1- n)) x))))))))
+
+(local
+ (defthm or-dist-b-3
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0)
+                 (< y (expt 2 n))
+                 (= (logior (* (expt 2 (1- n)) x)
+                            (fl (/ y 2)))
+                    (+ (* (expt 2 (1- n)) x)
+                       (fl (/ y 2)))))
+            (= (logior (* (expt 2 n) x) y)
+               (+ (* (expt 2 n) x)
+                  (* 2	(fl (/ y 2)))
+                  (mod y 2))))
+   :rule-classes ()
+   :hints (("Goal"  :in-theory (enable expt-split)
+            :use ((:instance or-dist-b-2))))))
+
+(local
+ (defthm or-dist-b-4
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0)
+                 (< y (expt 2 n))
+                 (= (logior (* (expt 2 (1- n)) x)
+                            (fl (/ y 2)))
+                    (+ (* (expt 2 (1- n)) x)
+                       (fl (/ y 2)))))
+            (= (logior (* (expt 2 n) x) y)
+               (+ (* (expt 2 n) x) y)))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance or-dist-b-3)
+                         (:instance quot-mod (m y) (n 2)))))))
+
+;generalize to or of disjoint ranges?
+(defthm OR-DIST-B
+    (implies (and (< y (expt 2 n))
+                  (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0)
+		  )
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ()
+  :hints (("Goal"  :in-theory (enable expt)
+           :induct (or-dist-induct y n))
+	  ("Subgoal *1/2" :use ((:instance or-dist-b-4)))))
+
+
+
+(local
+ (defthm or-dist-c-1
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0))
+            (= (logior (* (expt 2 n) x)
+                       (* (expt 2 n) y))
+               (+ (* 2 (logior (* (expt 2 (1- n)) x)
+                               (* (expt 2 (1- n)) y)))
+                  (logior (mod (* (expt 2 n) x) 2)
+                          (mod (* (expt 2 n) y) 2)))))
+   :rule-classes ()
+   :hints (("Goal"  :in-theory (enable expt)
+            :use ((:instance logior-def (i (* (expt 2 n) x)) (j (* (expt 2 n) y))))))))
+
+(local
+ (defthm or-dist-c-2
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0))
+            (= (logior (* (expt 2 n) x)
+                       (* (expt 2 n) y))
+               (* 2 (logior (* (expt 2 (1- n)) x)
+                            (* (expt 2 (1- n)) y)))))
+   :rule-classes ()
+   :hints (("Goal"  :in-theory (enable expt)
+            :use ((:instance or-dist-c-1)
+                  (:instance mod-2*i (i (* (expt 2 (1- n)) x)))
+                  (:instance mod-2*i (i (* (expt 2 (1- n)) y))))))))
+
+(local
+ (defthm or-dist-c-3
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0)
+                 (= (logior (* (expt 2 (1- n)) x)
+                            (* (expt 2 (1- n)) y))
+                    (* (expt 2 (1- n)) (logior x y))))			     
+            (= (logior (* (expt 2 n) x)
+                       (* (expt 2 n) y))
+               (* (expt 2 n)
+                  (logior x y))))
+   :rule-classes ()
+   :hints (("Goal"  :in-theory (enable expt)
+            :use ((:instance or-dist-c-2))))))
+
+;BOZO rename!
+(defthm or-dist-c
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp n) (>= n 0))
+           (= (logior (* (expt 2 n) x)
+                      (* (expt 2 n) y))
+              (* (expt 2 n) (logior x y))))
+  :rule-classes ()
+  :hints (("Goal" :induct (induct-nat n))
+	  ("Subgoal *1/1" :use ((:instance or-dist-c-3)))))
+
+
+
+(local
+ (defthm mod-logior-1
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0))
+            (= (logior x y)
+               (logior (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
+                               (mod x (expt 2 n)))
+                       (logior (* (expt 2 n) (fl (/ y (expt 2 n))))
+                               (mod y (expt 2 n))))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance quot-mod (m x) (n (expt 2 n)))
+                         (:instance quot-mod (m y) (n (expt 2 n)))
+                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
+                         (:instance mod-bnd-1 (m y) (n (expt 2 n)))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+;		(:instance mod>=0 (m y) (n (expt 2 n)))
+                         (:instance or-dist-b (x (fl (/ x (expt 2 n)))) (y (mod x (expt 2 n))))
+                         (:instance or-dist-b (x (fl (/ y (expt 2 n)))) (y (mod y (expt 2 n)))))))))
+
+(local
+ (defthm mod-logior-3
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0))
+            (= (logior x y)
+               (logior (logior (* (expt 2 n) (fl (/ x (expt 2 n))))
+                               (* (expt 2 n) (fl (/ y (expt 2 n)))))
+                       (logior (mod x (expt 2 n))
+                               (mod y (expt 2 n))))))
+   :rule-classes ()
+   :hints (("Goal" :use ( ;(:instance mod>=0 (m x) (n (expt 2 n)))
+;(:instance mod>=0 (m y) (n (expt 2 n)))
+                         (:instance mod-logior-1)
+                         )))))
+
+
+(local
+ (defthm mod-logior-4
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0))
+            (= (logior x y)
+               (+ (* (expt 2 n)
+                     (logior (fl (/ x (expt 2 n)))
+                             (fl (/ y (expt 2 n)))))
+                  (logior (mod x (expt 2 n))
+                          (mod y (expt 2 n))))))
+   :rule-classes ()
+   :hints (("Goal"
+            :use ((:instance mod-logior-3)
+                         (:instance or-dist-c (x (fl (/ x (expt 2 n)))) (y (fl (/ y (expt 2 n)))))
+                         (:instance or-dist-b
+                                    (x (logior (fl (/ x (expt 2 n)))
+                                               (fl (/ y (expt 2 n)))))
+                                    (y (logior (mod x (expt 2 n))
+                                               (mod y (expt 2 n)))))
+                         (:instance mod-bnd-1 (m x) (n (expt 2 n)))
+                         (:instance mod-bnd-1 (m y) (n (expt 2 n)))
+;                         (:instance or-dist-a (x (mod x (expt 2 n))) (y (mod y (expt 2 n))))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+;		(:instance mod>=0 (m y) (n (expt 2 n)))
+                         )))))
+
+(local
+ (defthm mod-logior-5-not-by-2
+   (implies (and (integerp x) (>= x 0)
+                 (integerp y) (>= y 0)
+                 (integerp n) (> n 0))
+            (= (mod (logior x y) (expt 2 n))
+               (mod (logior (mod x (expt 2 n)) (mod y (expt 2 n)))
+                    (expt 2 n))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance mod-logior-4)
+                         (:instance mod-mult-eric
+                                    (x (logior (mod x (expt 2 n)) (mod y (expt 2 n))))
+                                    (y (expt 2 n))
+                                    (a (logior (fl (/ x (expt 2 n)))
+                                               (fl (/ y (expt 2 n))))))
+                         (:instance n<=fl-linear (x (/ x (expt 2 n))) (n 0))
+                         (:instance n<=fl-linear (x (/ y (expt 2 n))) (n 0))
+;			(:instance logior-nat (i (fl (/ x (expt 2 n)))) (j (fl (/ y (expt 2 n)))))
+;		(:instance logior-nat (i (mod x (expt 2 n))) (j (mod y (expt 2 n))))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+;		(:instance mod>=0 (m y) (n (expt 2 n)))
+                         )))))
+
+(defthmd mod-logior
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp n) (>= n 0)
+                )
+           (equal (mod (logior x y) (expt 2 n))
+                  (logior (mod x (expt 2 n)) (mod y (expt 2 n)))))
+  :hints (("Goal" :use ((:instance mod-logior-5-not-by-2)
+			(:instance mod-does-nothing
+				   (m (logior (mod x (expt 2 n)) (mod y (expt 2 n))))
+				   (n (expt 2 n)))
+;/			(:instance mod>=0 (m x) (n (expt 2 n)))
+	;		(:instance mod>=0 (m y) (n (expt 2 n)))
+;			(:instance logior-nat (i (mod x (expt 2 n))) (j (mod y (expt 2 n))))
+			(:instance mod-bnd-1 (m x) (n (expt 2 n)))
+			(:instance mod-bnd-1 (m y) (n (expt 2 n)))
+;			(:instance or-dist-a (x (mod x (expt 2 n))) (y (mod y (expt 2 n))))
+                        ))))
+
+
+#|
+
+
+(defthmd logior-simp-1-alt
+  (implies (and (syntaxp (and (should-have-a-2-factor-multiplied-in i)
+                              (should-have-a-2-factor-multiplied-in j)))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (* 2 (logior i j))
+                  (logior (* 2 i) (* 2 j))))
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-negative-6
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< (logior i j) -1)
+                  (AND (< -1 I) (< -1 J))
+                  ))
+  :hints (("Goal" :cases ((equal j -1) (equal i -1))
+           :in-theory (enable logior))))
+
+;weird
+;trying disabled
+(defthmd logior-ones-when-one-arg-is-even
+  (implies (and (integerp (* 1/2 j))
+                (case-split (integerp j))
+                (case-split (integerp i))
+                )
+           (and (equal (equal (logior i j) -1)
+                       (and (not (integerp (* 1/2 i)))
+                            (equal (logior (fl (/ i 2)) (fl (/ j 2))) -1)))
+                (equal (equal (logior j i) -1)
+                       (and (not (integerp (* 1/2 i)))
+                            (equal (logior (fl (/ i 2)) (fl (/ j 2))) -1)))))
+  :hints (("Goal" :in-theory (e/d (logior) (fl-int))))
+  )
+
+
+;move!
+;disable?
+;more general version loops
+(defthm tighten-integer-bound
+  (implies (integerp x)
+           (equal (< x 1)
+                  (<= x 0))))
+
+;move!
+;disable?
+(defthm integer-<-fraction-expt-case
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (< X (EXPT 2 N))
+                  (<= X 0)))
+  :hints (("Goal" :in-theory (disable  EXPT-COMPARE)
+           :use (:instance  EXPT-COMPARE
+                            (lhs (expt 2 0))
+                            (rhs (expt 2 n))))))
+
+(local (include-book
+        "../arithmetic/expt"))
+
+(local (defun logior-+-hint (x i)
+  (if (= (nfix i) 0)
+      x
+    (logior-+-hint (floor x 2) (1- i)))))
+
+;follows from  OR-DIST-B?
+(defthm logior-+
+  (implies (and (integerp i)
+                (<= 0 i)
+                (integerp x)
+                (<= 0 x)
+                (< x (expt 2 i)))
+           (equal (logior (expt 2 i) x)
+                  (+ (expt 2 i) x)))
+  :hints (("Goal" :induct (logior-+-hint x i)
+                  :in-theory
+                   (set-difference-theories
+                       (enable logior logand lognot
+                               functional-commutativity-of-minus-*-right
+                               functional-commutativity-of-minus-*-left)
+                       '(a2 a5))))
+  :rule-classes nil)
+
+|#
+
+
+(defthm logior-non-negative-integerp
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (integerp (logior i j))
+                (<= 0 (logior i j))))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable logior))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logior.lisp acl2-6.3/books/rtl/rel9/support/support/logior.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logior.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logior.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,312 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(include-book "ground-zero")
+
+(local (include-book "logior-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+;split?
+(defthm logior-with-non-integer-arg
+  (implies (not (integerp i))
+           (and (equal (logior i j)
+                       (ifix j))
+                (equal (logior j i)
+                       (ifix j)))))
+
+(defthm logior-0
+  (implies (case-split (integerp j))
+           (equal (logior 0 j)
+                  j)))
+
+(defthm logior-commutative
+  (equal (logior j i)
+         (logior i j)))
+
+(defthm logior-associative
+  (equal (logior (logior i j) k)
+         (logior i (logior j k))))
+
+(defthm logior-commutative-2
+  (equal (logior j i k)
+         (logior i j k)))
+
+(defthm logior-combine-constants
+  (implies (syntaxp (and (quotep i)
+                         (quotep j)))
+           (equal (logior i j k)
+                  (logior (logior i j) k))))
+
+(defthm logior-with-an-arg-of-minus-one
+  (implies (case-split (integerp i))
+           (equal (logior -1 i) -1)))
+
+;BOZO dup!
+;figure this out
+(defthm logior-non-negative-integerp
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (integerp (logior i j))
+                (<= 0 (logior i j))))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable logior))))
+
+(defthm logior-non-negative-integerp-type
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (integerp (logior i j))
+                (<= 0 (logior i j))))
+  :rule-classes ( :type-prescription))
+
+(defthm logior-non-negative
+  (and (implies (and (<= 0 i)
+                     (<= 0 j))
+                (<= 0 (logior i j)))))
+
+(defthm logior-equal-0
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (equal (logior i j) 0)
+                  (and (equal i 0) (equal j 0)))))
+
+(defthm logior-even
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (integerp (* 1/2 (logior i j)))
+                  (and (integerp (* 1/2 i))
+                       (integerp (* 1/2 j))))))
+
+(defthm logior-negative-1
+  (implies (and (< i 0)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (integerp (logior i j))
+                (< (logior i j) 0)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm logior-negative-2
+  (implies (and (< j 0)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (integerp (logior i j))
+                (< (logior i j) 0)))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm logior-negative-3
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< (logior i j) 0)
+                  (or (< i 0)
+                      (< j 0)))))
+
+(defthm logior-non-positive
+  (implies (and (<= i 0)
+                (<= j 0)
+                )
+           (<= (logior i j) 0)))
+
+(defthm logior-self
+  (implies (case-split (integerp i))
+           (equal (logior i i) i)))
+
+;bad name?
+(defthm logior-simp-1
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (logior (* 2 i) (* 2 j))
+                  (* 2 (logior i j)))))
+
+(defthm logior-positive
+  (implies (and (< 0 i)
+                (< 0 j)
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (and (integerp (logior i j))
+                (< 0 (logior i j))))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm logior-positive-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (< 0 (logior i j))
+                  (and (<= 0 i)
+                       (<= 0 j)
+                       (or (< 0 i)
+                           (< 0 j))))))
+
+(defthm logior-negative-5
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (< -1 (logior i j))
+                  (AND (< -1 I) (< -1 J))
+                  )))
+
+(defthm logior-i-lognot-i
+  (implies (case-split (integerp i))
+           (equal (logior i (lognot i))
+                  -1)))
+
+;move? odd...
+(defthm fl-expression-rewrites-to-last-bit
+  (implies (integerp i)
+           (equal (+ I (* -2 (FL (* 1/2 I))))
+                  (if (evenp i)
+                      0
+                    1))))
+
+(defthm fl-logior-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (fl (* 1/2 (logior i j)))
+                  (logior (fl (/ i 2)) (fl (/ j 2))))))
+
+(defthm floor-logior-by-2
+    (implies (and (case-split (integerp i))
+		  (case-split (integerp j)))
+	     (equal (floor (logior i j) 2)
+                    (logior (floor i 2) (floor j 2)))))
+
+(defthm mod-logior-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (mod (logior i j) 2)
+                  (logior (mod i 2) (mod j 2)))))
+
+(defthmd logior-def
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (logior i j)
+                  (+ (* 2 (logior (fl (* 1/2 i)) (fl (* 1/2 j))))
+                     (logior (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logior t t)))))
+
+
+
+;make into a better form for rewriting?
+;gen to make conclusion the cat of the high bits of x (none if x is a bvecp) with a vector of ones?
+;BOZO reverse hyp order
+;see  lshiftamt-low-4
+(defthm logior-ones
+    (implies (and (natp n) ;gen?
+		  (bvecp x n))
+	     (equal (logior x (1- (expt 2 n)))
+		    (1- (expt 2 n))))
+  :rule-classes ())
+
+;rename
+(defthm logior-1-x
+  (implies (bvecp x 1)
+           (equal (logior 1 x) 1)))
+
+
+
+
+;n is a free var
+;BOZO rename
+;consider :linear?
+(defthm or-dist-a
+  (implies (and (< i (expt 2 n))
+                (< j (expt 2 n))
+                )
+           (< (logior i j) (expt 2 n)))
+  :rule-classes ((:rewrite :match-free :all)))
+
+(defthm logior-bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+;gen?
+;whoa.  this is a lower bound
+;unfortunate to have to disable those rules..
+(defthm logior-bnd
+  (implies (and (integerp x)
+                (>= x 0)
+                (integerp y)
+                (>= y 0))
+           (<= x (logior x y)))
+  :rule-classes ())
+
+
+;generalize to or of disjoint ranges?
+(defthm OR-DIST-B
+    (implies (and (< y (expt 2 n))
+                  (integerp x) (>= x 0)
+		  (integerp y) (>= y 0)
+		  (integerp n) (>= n 0)
+		  )
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ())
+
+;BOZO rename!
+;consider making rewrite?
+(defthm or-dist-c
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp n) (>= n 0))
+           (= (logior (* (expt 2 n) x)
+                      (* (expt 2 n) y))
+              (* (expt 2 n) (logior x y))))
+  :rule-classes ())
+
+(defthmd mod-logior
+  (implies (and (integerp x) (>= x 0)
+                (integerp y) (>= y 0)
+                (integerp n) (>= n 0)
+                )
+           (equal (mod (logior x y) (expt 2 n))
+                  (logior (mod x (expt 2 n)) (mod y (expt 2 n))))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logior1-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/logior1-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logior1-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logior1-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,45 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defthm logior1-logior1
+  (equal (logior1 (logior1 x))
+         (logior1 x))
+  :hints (("Goal" :in-theory (enable logior1))))
+
+(defthm logior1-equal-0
+  (equal (equal (logior1 x) 0)
+         (equal x 0))
+  :hints (("goal" :in-theory (enable logior1))))
+
+(defthm logior1-equal-1
+  (equal (equal (logior1 x)
+                1)
+         (not (equal x 0)))
+  :hints (("goal" :in-theory (enable logior1))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logior1.lisp acl2-6.3/books/rtl/rel9/support/support/logior1.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logior1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logior1.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,46 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;Perhaps we want to keep LOGIOR1 enabled, but if not here are some rules about it...  More are in logs.lisp
+;(more those here?).
+
+(local (include-book "logior1-proofs"))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defthm logior1-logior1
+  (equal (logior1 (logior1 x))
+         (logior1 x)))
+
+(defthm logior1-equal-0
+  (equal (equal (logior1 x) 0)
+         (equal x 0)))
+
+(defthm logior1-equal-1
+  (equal (equal (logior1 x) 1)
+         (not (equal x 0))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lognot.lisp acl2-6.3/books/rtl/rel9/support/support/lognot.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lognot.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lognot.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,149 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "ground-zero")
+(local (include-book "../../arithmetic/top"))
+
+(defthm lognot-of-non-integer
+  (implies (not (integerp i))
+           (equal (lognot i)
+                  -1))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-lognot
+  (implies (case-split (integerp i))
+           (equal (lognot (lognot i))
+                  i))
+  :hints (("Goal" :in-theory (enable lognot))))
+                  
+(defthm lognot-integerp
+  (integerp (lognot i))
+    :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-equal-minus-one
+  (implies (case-split (integerp i))
+           (equal (EQUAL (LOGNOT i) -1)
+                  (equal i 0)))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-equal-0
+  (implies (case-split (integerp i))
+           (equal (EQUAL (LOGNOT i) 0)
+                  (equal i -1)))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-<-0
+  (implies (case-split (integerp i))
+           (equal (< (lognot i) 0)
+                  (<= 0 i)))
+    :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot->-0
+  (implies (case-split (integerp i))
+           (equal (< 0 (lognot i))
+                  (< i -1)))
+    :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-even
+  (implies (case-split (integerp i))
+           (equal (integerp (* 1/2 (lognot i)))
+                  (not (integerp (* 1/2 i)))))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-of-double
+  (implies (case-split (integerp i))
+           (EQUAL (LOGNOT (* 2 i))
+                  (+ 1 (* 2 (LOGNOT i)))))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-of-double-minus-1
+  (implies (case-split (integerp i))
+           (EQUAL (LOGNOT (1- (* 2 i)))
+                  (* 2 (LOGNOT (1- i)))))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-simp
+  (implies (case-split (integerp i))
+           (equal (LOGNOT (+ 1 (* 2 i)))
+                  (* 2 (LOGNOT i))))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-bound-1
+  (implies (case-split (integerp i))
+           (equal (< (LOGNOT I) -1)
+                  (< 0 i)))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-bound-2
+  (implies (case-split (integerp i))
+           (equal (< -1 (LOGNOT I))
+                  (< i 0)))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-bound-gen
+  (implies (and (case-split (integerp i))
+                (case-split (rationalp k)))
+           (equal (< (LOGNOT I) k)
+                  (< (1- (- k)) i)))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm lognot-bound-gen-2
+  (implies (and (case-split (integerp i))
+                (case-split (rationalp k)))
+           (equal (< k (LOGNOT I))
+                  (< i (1- (- k)))))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+
+;from ihs
+(defthm cancel-equal-lognot
+  (equal (equal (lognot i) (lognot j))
+         (equal (ifix i) (ifix j)))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+
+
+(defthm fl-lognot
+  (implies (case-split (integerp i))
+           (= (fl (* 1/2 (lognot i)))
+              (lognot (fl (* 1/2 i)))))
+  :hints (("Goal" :in-theory (enable lognot))))
+
+(defthm floor-lognot
+  (implies (case-split (integerp i))
+           (equal (floor (lognot i) 2)
+                  (lognot (floor i 2)))))
+
+(defthm mod-lognot-by-2
+  (implies (case-split (integerp i))
+           (equal (mod (lognot i) 2)
+                  (+ 2 (lognot (mod i 2)))))
+  :hints (("Goal" :in-theory (enable lognot mod-mult-of-n mod-by-2-rewrite-to-even)))
+  )
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logorc1.lisp acl2-6.3/books/rtl/rel9/support/support/logorc1.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logorc1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logorc1.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,93 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(include-book "ground-zero")
+(local (include-book "logior"))
+(local (include-book "../../arithmetic/fl"))
+(local (include-book "lognot"))
+
+(defthm floor-logorc1-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (floor (logorc1 i j) 2)
+                  (logorc1 (floor i 2) (floor j 2))))
+  :hints (("Goal" :in-theory (enable logorc1))))
+
+(defthm fl-logorc1-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (fl (* 1/2 (logorc1 i j)))
+                  (logorc1 (fl (* 1/2 i)) (fl (* 1/2 j)))))
+  :hints (("Goal" :in-theory (enable logorc1))))
+
+#| not true
+(defthm mod-LOGORC1
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (mod (logorc1 i j) 2)
+                  (logorc1 (mod i 2) (mod j 2))))
+  :hints (("Goal" :in-theory (enable logorc1))))
+|#
+
+#|
+
+(local
+(defthm logorc1-mod-1
+    (implies (and (integerp i) (integerp j))
+	     (iff (= (mod (logorc1 i j) 2) 0)
+		  (and (= (mod (lognot i) 2) 0)
+		       (= (mod j 2) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior lognot)
+		  :use ((:instance mod-logior-10 (i (lognot i))))))))
+
+(local(defthm logorc1-mod
+    (implies (and (integerp i) (>= i 0)
+		  (integerp j))
+	     (iff (= (mod (logorc1 i j) 2) 0)
+		  (and (= (mod i 2) 1)
+		       (= (mod j 2) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior lognot)
+		  :use ((:instance mod-logior-9)
+			(:instance logorc1-mod-1)
+			(:instance mod012 (x i)))))))
+|#
+
+(defthm logorc1-type
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (< (logorc1 i j) 0))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("Goal" :in-theory (enable logorc1 lognot))))
+  
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logs.lisp acl2-6.3/books/rtl/rel9/support/support/logs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,311 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+;what is this file??
+
+
+;; 2. equality comparison
+
+(defun log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defun log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;; 3. unsigned inequalities
+
+(defun log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defun log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defun log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defun log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;; 4. signed inequalities
+
+;; The following function is not generated by translate-rtl, it is only needed
+;; for the definitions of comp2<, comp2<=, etc.
+(defun comp2 (x n)
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defun comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defun comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defun comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defun comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;; 5. unary logical operations
+
+;make separate books for these? logior1 has one?
+(defun logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defun logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defun logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+
+
+;should rtl.lisp disable these fns?
+
+
+;; log<
+
+(defthm log<-bvecp
+  (bvecp (log< x y) 1)
+  :hints (("Goal" :in-theory (enable log<))))
+
+(defthm log<-nonnegative-integer-type
+  (and (integerp (log< x y))
+       (<= 0 (log< x y)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable log<))))
+
+;this rule is no better than log<-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<)))
+
+;just a rewrite rule
+(defthm log<-natp
+  (natp (log< x y)))
+
+
+
+;; log<=
+
+(defthm log<=-bvecp
+  (bvecp (log<= x y) 1)
+  :hints (("Goal" :in-theory (enable log<=))))
+
+(defthm log<=-nonnegative-integer-type
+  (and (integerp (log<= x y))
+       (<= 0 (log<= x y)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable log<=))))
+
+;this rule is no better than log<=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<=)))
+
+;just a rewrite rule
+(defthm log<=-natp
+  (natp (log<= x y)))
+
+
+;; log>
+
+(defthm log>-bvecp
+  (bvecp (log> x y) 1)
+  :hints (("Goal" :in-theory (enable log>))))
+
+(defthm log>-nonnegative-integer-type
+  (and (integerp (log> x y))
+       (<= 0 (log> x y)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable log>))))
+
+;this rule is no better than log>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>)))
+
+;just a rewrite rule
+(defthm log>-natp
+  (natp (log> x y)))
+
+
+
+
+;; log>=
+
+(defthm log>=-bvecp
+  (bvecp (log>= x y) 1)
+  :hints (("Goal" :in-theory (enable log>=))))
+
+(defthm log>=-nonnegative-integer-type
+  (and (integerp (log>= x y))
+       (<= 0 (log>= x y)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable log>=))))
+
+;this rule is no better than log>=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log>=)))
+
+;just a rewrite rule
+(defthm log>=-natp
+  (natp (log>= x y)))
+
+
+;; log=
+
+(defthm log=-bvecp
+  (bvecp (log= x y) 1)
+  :hints (("Goal" :in-theory (enable log=))))
+
+(defthm log=-nonnegative-integer-type
+  (and (integerp (log= x y))
+       (<= 0 (log= x y)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable log=))))
+
+(defthm log=-commutative
+  (equal (log= x y)
+         (log= y x)))
+
+;this rule is no better than log=-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log=)))
+
+;just a rewrite rule
+(defthm log=-natp
+  (natp (log= x y)))
+
+
+;; log<>
+
+(defthm log<>-bvecp
+  (bvecp (log<> x y) 1)
+  :hints (("Goal" :in-theory (enable log<>))))
+
+(defthm log<>-nonnegative-integer-type
+  (and (integerp (log<> x y))
+       (<= 0 (log<> x y)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable log<>))))
+
+;this rule is no better than log<>-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription log<>)))
+
+;just a rewrite rule
+(defthm log<>-natp
+  (natp (log<> x y)))
+
+(defthm log<>-commutative
+  (equal (log<> x y)
+         (log<> y x)))
+
+
+;; logand1
+
+(defthm logand1-bvecp
+  (bvecp (logand1 x y) 1)
+  :hints (("Goal" :in-theory (enable logand1))))
+
+(defthm logand1-nonnegative-integer-type
+  (and (integerp (logand1 x y))
+       (<= 0 (logand1 x y)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logand1))))
+
+;this rule is no better than logand1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logand1)))
+
+;just a rewrite rule
+(defthm logand1-natp
+  (natp (logand1 x y)))
+
+
+;; logior1 
+(defthm logior1-bvecp
+  (bvecp (logior1 x) 1)
+  :hints (("Goal" :in-theory (enable logior1))))
+
+(defthm logior1-nonnegative-integer-type
+  (and (integerp (logior1 x))
+       (<= 0 (logior1 x)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logior1))))
+
+;this rule is no better than logior1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logior1)))
+
+;just a rewrite rule
+(defthm logior1-natp
+  (natp (logior1 x)))
+
+
+;; logxor1
+
+(defthm logxor1-bvecp
+  (bvecp (logxor1 x) 1)
+  :hints (("Goal" :in-theory (enable logxor1))))
+
+(defthm logxor1-nonnegative-integer-type
+  (and (integerp (logxor1 x))
+       (<= 0 (logxor1 x)))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logxor1))))
+
+;this rule is no better than logxor1-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription logxor1)))
+
+;just a rewrite rule
+(defthm logxor1-natp
+  (natp (logxor1 x)))
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/logxor.lisp acl2-6.3/books/rtl/rel9/support/support/logxor.lisp
--- acl2-6.2/books/rtl/rel9/support/support/logxor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/logxor.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,232 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(include-book "ground-zero")
+(local (include-book "logeqv"))
+(local (include-book "logorc1"))
+(local (include-book "lognot"))
+(local (include-book "../../arithmetic/top"))
+
+(defthm logxor-integerp-type
+  (integerp (logxor i j))
+  :rule-classes :type-prescription)
+
+(defthm logxor-0
+  (implies (case-split (integerp i))
+           (equal (logxor 0 i)
+                  i))
+  :hints (("goal" :in-theory (enable logxor))))
+
+(defthm logxor-non-negative-integer-type-prescription
+  (implies (and (<= 0 i)
+                (<= 0 j))
+           (and (<= 0 (logxor i j))
+                (integerp (logxor i j))))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable logxor))))
+
+(defthm logxor-non-negative
+  (implies (and (<= 0 i)
+                (<= 0 j)
+                )
+           (<= 0 (logxor i j)))
+  :rule-classes (:rewrite :type-prescription)
+  :hints (("goal" :in-theory (enable logxor))))
+
+(defthm logxor-even
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (integerp (* 1/2 (logxor i j)))
+                  (or (and (integerp (* 1/2 i))
+                           (integerp (* 1/2 j)))
+                      (and (not (integerp (* 1/2 j)))
+                           (not (integerp (* 1/2 i)))))))
+  :hints (("goal" :in-theory (enable logxor))))
+
+
+(defthm logxor-commutative
+  (equal (logxor j i)
+         (logxor i j))
+  :hints (("goal" :in-theory (enable logxor))))
+
+(defthm logxor-with-non-integer-arg
+  (implies (not (integerp i))
+           (and (equal (logxor i j)
+                       (ifix j))
+                (equal (logxor j i)
+                       (ifix j))))
+  :hints (("goal" :in-theory (enable logxor))))
+
+;do we really want to go to lognot?
+(defthm logxor-with-an-arg-of-minus-one
+  (implies (case-split (integerp i))
+           (equal (logxor -1 i)
+                  (lognot i)))
+  :hints (("goal" :in-theory (enable logxor))))
+
+(defthmd floor-logxor-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j)))
+           (equal (floor (logxor i j) 2)
+                  (logxor (floor i 2) (floor j 2))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable logxor)
+                              '(lognot logeqv floor)))))
+
+(defthm fl-logxor-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (fl (* 1/2 (logxor i j)))
+                  (logxor (fl (* 1/2 i)) (fl (* 1/2 j)))))
+  :hints (("goal" :in-theory (enable logxor))))
+
+(defthm mod-logxor-by-2
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (mod (logxor i j) 2)
+                  (logxor (mod i 2) (mod j 2))))
+  :hints (("Goal" :in-theory (enable mod-by-2))))
+
+
+
+(defthmd logxor-def
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (logxor i j)
+                  (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+                     (logxor (mod i 2) (mod j 2)))))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t))))
+  :hints (("goal" :use (:instance fl-mod-equal 
+                                  (x (logxor i j))
+                                  (y (+ (* 2 (logxor (fl (* 1/2 i)) (fl (* 1/2 j))))
+                     (logxor (mod i 2) (mod j 2)))))
+           :in-theory (enable mod-by-2))))
+
+;i'm not sure which way this rule should go but note that both parts of this rule rewrite to the same rhs
+(defthm lognot-logxor
+  (and (equal (logxor (lognot i) j)
+              (lognot (logxor i j)))
+       (equal (logxor j (lognot i))
+              (lognot (logxor i j))))
+  :hints (("goal" :in-theory (enable logxor ))))
+
+(defthm logxor-associative
+  (equal (logxor (logxor i j) k)
+         (logxor i (logxor j k)))
+  :hints (("subgoal *1/2" :use ( ;(:instance logxor-assoc-1)
+                                (:instance fl-mod-equal
+                                           (x (logxor (logxor i j) k))
+                                           (y (logxor i (logxor j k))))))
+          ("goal" :in-theory (enable logxor-def mod-by-2)
+           :induct ( logand-three-args-induct i j k))
+          ))
+
+(defthm logxor-commutative-2
+  (equal (logxor j i k)
+         (logxor i j k))
+  :hints (("Goal" :in-theory (disable LOGXOR-ASSOCIATIVE
+                                      logxor-commutative)
+           :use (LOGXOR-ASSOCIATIVE
+                 logxor-commutative
+                 (:instance LOGXOR-ASSOCIATIVE (j i) (i j))))))
+ 
+(defthm logxor-combine-constants
+  (implies (syntaxp (and (quotep i)
+                         (quotep j)))
+           (equal (logxor i j k)
+                  (logxor (logxor i j) k))))
+
+(defthm logxor-self
+  (equal (logxor i i) 0)
+  :hints (("goal" :in-theory (enable logxor))))
+
+(defthmd logxor-def-rewrite
+  (implies (and (case-split (integerp x))
+                (case-split (integerp y))
+                )
+           (equal (logxor x y)
+                  (+ (* 2 (logxor (fl (/ x 2)) (fl (/ y 2))))
+                     (logxor (mod x 2) (mod y 2)))))
+  :hints (("Goal" :in-theory (enable logxor-def)))
+  :rule-classes ((:definition :controller-alist ((binary-logxor t t)))))
+
+;gen?
+(defthm logxor-upper-bound-tight
+  (implies (and (< i (expt 2 n))
+                (< j (expt 2 n))
+                (integerp i) (>= i 0)
+                (integerp j) (>= j 0)
+                (integerp n) (>= n 0)
+                )
+           (<= (logxor i j) (1- (expt 2 n))))
+  :hints (("Goal" :induct (op-dist-induct i j n))
+	  ("Subgoal *1/2" :in-theory (set-difference-theories
+                                      (enable expt-split
+                                              )
+                                      '(a15))
+           :use ((:instance logxor-def)
+                 (:instance mod012 (m i))
+                 (:instance mod012 (m j))))))
+
+;change var names
+(defthm logxor-upper-bound
+  (implies (and (< i (expt 2 n))
+                (< j (expt 2 n))
+                (integerp i) (>= i 0)
+                (integerp j) (>= j 0)
+                (integerp n) (>= n 0)
+                )
+           (< (logxor i j) (expt 2 n)))
+  :hints (("Goal" :in-theory (disable logxor-upper-bound-tight)
+           :use (:instance  logxor-upper-bound-tight))))
+
+(defthm logxor-bvecp
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n) ;gen?
+		  )
+	     (bvecp (logxor x y) n))
+  :hints (("Goal" :in-theory (enable bvecp))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lop1-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/lop1-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lop1-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lop1-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1145 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "merge")
+(local (include-book "bitn"))
+(local (include-book "bits"))
+(local (include-book "../../arithmetic/top"))
+
+(local
+ (defund C (k a b)
+   (- (bitn a k) (bitn b k))))
+
+; Here is the original version of lop.  Our current definition uses let to
+; avoid calling function c, but we want to preserve existing proofs.
+(local
+ (defund LOP0 (a b d k)
+   (if (and (integerp k) (>= k 0))
+       (if (= k 0)
+           0
+         (if (= d 0)
+             (lop0 a b (c (1- k) a b) (1- k))
+           (if (= d (- (c (1- k) a b)))
+               (lop0 a b (- (c (1- k) a b)) (1- k))
+             k)))
+     0)))
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(local (defthmd lop0-is-lop
+         (equal (lop0 a b d k)
+                (lop  a b d k))
+         :hints (("Goal" :in-theory (enable c lop0 lop)))))
+
+(local (defun lop0-induct (a b d k)
+  (if (and (integerp k) (>= k 0))
+      (if (= k 0)
+	  0
+	(and (lop0-induct a b (c (1- k) a b) (1- k))
+	     (lop0-induct a b (- (c (1- k) a b)) (1- k))))
+    d)))
+
+(local (defthm c-lemma
+    (implies (< b a)
+	     (equal (c k b a) (- (c k a b))))
+    :hints (("Goal" :in-theory (enable c)))))
+
+(local (defthm lop0-d
+    (implies (and (integerp a)
+		  (integerp b)
+		  (< b a)
+		  (integerp d)
+		  (integerp k)
+		  (>= k 0))
+	     (= (lop0 a b d k)
+		(lop0 b a (- d) k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop0)
+		  :induct (lop0-induct a b d k)))))
+
+
+(local (defthm mod-c
+    (implies (and (integerp x)
+		  (>= x 0)
+		  (integerp y)
+		  (>= y 0)
+		  (integerp j)
+		  (>= j 0)
+		  (integerp k)
+		  (> k j))
+	     (equal (c j (mod x (expt 2 k)) (mod y (expt 2 k)))
+		    (c j x y)))
+    :hints (("Goal" :in-theory (enable c bitn-mod)))))
+
+(local (defthm mod-c-2
+    (implies (and (integerp x)
+		  (>= x 0)
+		  (integerp y)
+		  (>= y 0)
+		  (integerp j)
+		  (>= j 0)
+		  (integerp k)
+		  (> k j))
+	     (equal (c j (mod x (* 2 (expt 2 (1- k)))) (mod y (* 2 (expt 2 (1- k)))))
+		    (c j x y)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '( mod-c)
+                              )
+		  :use (mod-c)))))
+
+(local-defthm LOP0-MOD
+    (implies (and (integerp a)
+		  (>= a 0)
+		  (integerp b)
+		  (>= b 0)
+		  (integerp d)
+		  (integerp j)
+		  (>= j 0)
+		  (integerp k)
+		  (>= k j))
+	     (= (lop0 a b d j)
+		(lop0 (mod a (expt 2 k)) (mod b (expt 2 k)) d j)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop0)
+		  :induct (lop0-induct a b d j))
+	  ("Subgoal *1/2" :expand ((lop0 a b d j)
+				   (LOP0 (MOD A (* 2 (EXPT 2 (1- K))))
+					(MOD B (* 2 (EXPT 2 (1- K))))
+					d
+					j)))))
+
+(defthm LOP-MOD
+    (implies (and (integerp a)
+		  (>= a 0)
+		  (integerp b)
+		  (>= b 0)
+		  (integerp d)
+		  (integerp j)
+		  (>= j 0)
+		  (integerp k)
+		  (>= k j))
+	     (= (lop a b d j)
+		(lop (mod a (expt 2 k)) (mod b (expt 2 k)) d j)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop0-is-lop)
+           :use lop0-mod)))
+
+(local (defun lop0-1-induct (n a b)
+  (if (and (integerp n) (>= n 0))
+      (if (> n 1)
+	  (if (= (c (1- n) a b) 0)
+	      (lop0-1-induct (1- n) (mod a (expt 2 (1- n))) (mod b (expt 2 (1- n))))
+	    (if (= (c (- n 2) a b) -1)
+		(lop0-1-induct (1- n) (- a (expt 2 (- n 2))) (- b (expt 2 (- n 2))))
+	      t))
+	t)
+    t)))
+
+(local (defthm lop0-1-1
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (>= a 0)
+		  (>= b 0)
+		  (>= n 0)
+		  (<= n 1)
+		  (< b a)
+		  (< a (expt 2 n))
+		  (< b (expt 2 n)))
+	     (= n 1))
+  :rule-classes ()))
+
+(local (defthm lop0-1-2
+    (implies (and (integerp a)
+		  (integerp b)
+		  (>= a 0)
+		  (>= b 0)
+		  (< b a)
+		  (< a 2)
+		  (< b 2))
+	     (and (= a 1) (= b 0)))
+  :rule-classes ()))
+
+(local (defthm lop0-1-3
+    (= (lop0 1 0 0 1) (expo 1))
+  :rule-classes ()))
+
+(local (defthm lop0-1-4
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (<= N 1))
+	     (IMPLIES (AND (INTEGERP A)
+			   (INTEGERP B)
+			   (INTEGERP N)
+			   (<= 0 A)
+			   (<= 0 B)
+			   (<= 0 N)
+			   (< B A)
+			   (< A (EXPT 2 N))
+			   (< B (EXPT 2 N)))
+		      (OR (= (LOP0 A B 0 N) (EXPO (+ A (- B))))
+			  (= (LOP0 A B 0 N)
+			     (+ 1 (EXPO (+ A (- B))))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop0-1-1 lop0-1-2 lop0-1-3)))))
+
+(local (defthm lop0-1-5
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (1- N) A B) 0))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (and (= (bitn a (1- n)) 1)
+		  (= (bitn b (1- n)) 0)
+		  (= (c (1- n) a b) 1)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable c)
+           :use ((:instance bitn-0-1 (x a) (n (1- n)))
+			(:instance bitn-0-1 (x b) (n (1- n)))
+			(:instance bit-expo-a (x b) (n (1- n)))
+			(:instance bit-expo-b (x a) (n (1- n))))))))
+
+(local (defthm lop0-1-6
+         (IMPLIES (AND (INTEGERP N)
+                       (< 1 N)
+                       (NOT (= (C (1- N) A B) 0))
+                       (NOT (= (C (+ -2 N) A B) -1))
+                       (INTEGERP A)
+                       (INTEGERP B)
+                       (INTEGERP N)
+                       (<= 0 A)
+                       (<= 0 B)
+                       (<= 0 N)
+                       (< B A)
+                       (< A (EXPT 2 N))
+                       (< B (EXPT 2 N)))
+                  (= (LOP0 A B 0 N) 
+                     (1- n)))
+         :rule-classes ()
+         :hints (("Goal"  :expand ((LOP0 A B 1 (1- N)))
+                  :in-theory (enable expt-split
+                                      lop0)
+		  :use (lop0-1-5)))))
+
+(local (defthm lop0-1-7
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (1- N) A B) 0))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (and (>= a (expt 2 (1- n)))
+		  (< b (expt 2 (1- n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop0-1-5)
+			(:instance bit-expo-a (x a) (n (1- n)))
+			(:instance bit-expo-b (x b) (n (1- n))))))))
+
+(local (defthm lop0-1-8
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (1- N) A B) 0))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< b (expt 2 (- n 2)))
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (> (- a b) (expt 2 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt)
+           :use ((:instance lop0-1-7)
+                 (:instance expt-split (r 2) (i (- 2 n)) (j 1)))))))
+
+(local (in-theory (disable c-lemma)))
+
+(local (defthm lop0-1-9
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (NOT (= (C (+ -2 N) A B) -1))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (>= b (expt 2 (- n 2)))
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (bitn a (- n 2)) 1))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable c)
+		  :use (lop0-1-7
+			(:instance bitn-0-1 (x a) (n (- n 2)))
+			(:instance bitn-0-1 (x b) (n (- n 2)))
+			(:instance bit-expo-b (x b) (n (- n 2))))))))
+
+(local (defthm lop0-1-10
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (NOT (= (C (+ -2 N) A B) -1))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (>= b (expt 2 (- n 2)))
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (bitn (- a (expt 2 (1- n))) (- n 2))
+		1))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-9
+			lop0-1-7
+			(:instance  bitn-plus-expt-2 (x (- a (expt 2 (1- n)))) (m (1- n)) (n (- n 2))))))))
+
+(local (defthm lop0-1-11
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (NOT (= (C (+ -2 N) A B) -1))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (>= b (expt 2 (- n 2)))
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (>= (- a b) (expt 2 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-10
+			lop0-1-7
+			(:instance bit-expo-a (x (- a (expt 2 (1- n)))) (n (- n 2))))))))
+
+(local (defthm lop0-1-12
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (NOT (= (C (+ -2 N) A B) -1))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (>= (- a b) (expt 2 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-11
+			lop0-1-8)))))
+
+(local (defthm lop0-1-13
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (NOT (= (C (+ -2 N) A B) -1))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (>= (expo (- a b)) (- n 2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-12
+			(:instance expo>= (x (- a b)) (n (- n 2))))))))
+
+(local (defthm lop0-1-14
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (NOT (= (C (+ -2 N) A B) -1))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (<= (expo (- a b)) (- n 1)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt)
+           :use ((:instance expo-monotone (x (- a b)) (y a))
+			(:instance expo<= (x a) (n (- n 1))))))))
+
+(local (defthm lop0-1-15
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (NOT (= (C (+ -2 N) A B) -1))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (OR (= (LOP0 A B 0 N) (EXPO (+ A (- B))))
+		 (= (LOP0 A B 0 N)
+		    (+ 1 (EXPO (+ A (- B)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                      EXPO-COMPARISON-REWRITE-TO-BOUND
+                                     )
+           :use (lop0-1-14 lop0-1-13 lop0-1-6)))))
+
+(local (defthm lop0-1-16
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (and (= (bitn b (- n 2)) 1)
+		  (= (bitn a (- n 2)) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable c)
+           :use ((:instance bitn-0-1 (x a) (n (- n 2)))
+			(:instance bitn-0-1 (x b) (n (- n 2))))))))
+
+(local (defthm lop0-1-17
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (>= b (expt 2 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-16
+			(:instance bit-expo-a (x b) (n (- n 2))))))))
+
+(local (defthm lop0-1-18
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (< a (- (expt 2 n) (expt 2 (- n 2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (bvecp) ( expt))
+		  :use (lop0-1-16
+;			(:instance bit-expo-c (x a) (k (- n 2)))
+                        (:instance bvecp-bitn-2 (x a) (k (- n 2)))
+                        )))))
+
+
+(local (defthm lop0-1-19
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (< a (+ (expt 2 (- n 1)) (expt 2 (- n 2)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split)
+		  :use (lop0-1-18)))))
+
+
+(local (defthm lop0-1-20
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (IMPLIES (AND (INTEGERP (+ A (- (EXPT 2 (+ -2 N)))))
+				(INTEGERP (+ B (- (EXPT 2 (+ -2 N)))))
+				(INTEGERP (+ -1 N))
+				(<= 0 (+ A (- (EXPT 2 (+ -2 N)))))
+				(<= 0 (+ B (- (EXPT 2 (+ -2 N)))))
+				(<= 0 (+ -1 N))
+				(< (+ B (- (EXPT 2 (+ -2 N))))
+				   (+ A (- (EXPT 2 (+ -2 N)))))
+				(< (+ A (- (EXPT 2 (+ -2 N))))
+				   (EXPT 2 (+ -1 N)))
+				(< (+ B (- (EXPT 2 (+ -2 N))))
+				   (EXPT 2 (+ -1 N))))
+			   (OR (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
+				       (+ B (- (EXPT 2 (+ -2 N))))
+				       0 (+ -1 N))
+				  (EXPO (+ (+ A (- (EXPT 2 (+ -2 N))))
+					   (- (+ B (- (EXPT 2 (+ -2 N))))))))
+			       (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
+				       (+ B (- (EXPT 2 (+ -2 N))))
+				       0 (+ -1 N))
+				  (+ 1
+				     (EXPO (+ (+ A (- (EXPT 2 (+ -2 N))))
+					      (- (+ B (- (EXPT 2 (+ -2 N)))))))))))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (OR (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
+			 (+ B (- (EXPT 2 (+ -2 N))))
+			 0 
+			 (+ -1 N))
+		    (EXPO (+ A (- B))))
+		 (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
+			 (+ B (- (EXPT 2 (+ -2 N))))
+			 0 
+			 (+ -1 N))
+		    (+ 1 (EXPO (+ A (- B)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-7 
+			lop0-1-17
+			lop0-1-19
+			(:instance expt-split (r 2) (i (- n 1)) (j 1))
+			(:instance expt-split (r 2) (i (- n 2)) (j 1)))))))
+
+(local (defthm lop0-1-21
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 a b 0 n)
+		(lop0 a b 1 (- n 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop0)
+		  :use (lop0-1-5)))))
+
+(local (defthm lop0-1-22
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 a b 0 n)
+		(lop0 a b 1 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :expand (LOP0 A B 1 (+ -1 N))
+		  :use (lop0-1-5 lop0-1-21)))))
+
+(local (defthm lop0-1-23
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 (mod a (expt 2 (- n 2)))
+		     (mod b (expt 2 (- n 2)))
+		     1
+		     (- n 2))
+		(lop0 a b 1 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use ((:instance lop0-mod (d 1) (j (- n 2)) (k (- n 2))))))))
+
+(local (defthm lop0-1-24
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 (mod (- a (expt 2 (- n 2)))
+			  (expt 2 (- n 2)))
+		     (mod (- b (expt 2 (- n 2)))
+			  (expt 2 (- n 2)))
+		     1
+		     (- n 2))
+		(lop0 (- a (expt 2 (- n 2)))
+		     (- b (expt 2 (- n 2)))
+		     1 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-17
+			(:instance lop0-mod
+				   (a (- a (expt 2 (- n 2))))
+				   (b (- b (expt 2 (- n 2))))
+				   (d 1) 
+				   (j (- n 2))
+				   (k (- n 2))))))))
+
+(local (defthm lop0-1-25
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 (mod (- a (expt 2 (- n 2)))
+			  (expt 2 (- n 2)))
+		     (mod (- b (expt 2 (- n 2)))
+			  (expt 2 (- n 2)))
+		     1
+		     (- n 2))
+		(lop0 (mod a
+			  (expt 2 (- n 2)))
+		     (mod b
+			  (expt 2 (- n 2)))
+		     1
+		     (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-17
+;			(:instance mod+-thm (m (- a (expt 2 (- n 2)))) (a 1) (n (expt 2 (- n 2))))
+	;		(:instance mod+-thm (m (- b (expt 2 (- n 2)))) (a 1) (n (expt 2 (- n 2))))
+                             )))))
+
+(local (defthm lop0-1-26
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 a b 0 n)
+		(lop0 (- a (expt 2 (- n 2)))
+		     (- b (expt 2 (- n 2)))
+		     1 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-22 lop0-1-23 lop0-1-24 lop0-1-25)))))
+
+(local (defthm lop0-1-27
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (bitn (- b (expt 2 (- n 2))) (- n 2))
+		0))
+  :rule-classes ()
+  :hints (("Goal" :use (lop0-1-7
+			lop0-1-17
+
+			(:instance bit-expo-a (x (- b (expt 2 (- n 2)))) (n (- n 2))))
+		  :in-theory (enable expt-split)))))
+
+(local (defthm lop0-1-28
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (bitn (- a (expt 2 (- n 2))) (- n 2))
+		1))
+  :rule-classes ()
+  :hints (("Goal" :use (lop0-1-7
+			lop0-1-19
+;			(:instance expt-split (r 2) (i (- n 2)) (j 1))
+			(:instance bit-expo-b (x (- a (expt 2 (- n 2)))) (n (- n 2))))
+		  :in-theory (enable expt-split)))))
+
+(local (defthm lop0-1-29
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 (- a (expt 2 (- n 2)))
+		     (- b (expt 2 (- n 2)))
+		     0 (- n 1))
+		(lop0 (- a (expt 2 (- n 2)))
+		     (- b (expt 2 (- n 2)))
+		     1 (- n 2))))
+  :rule-classes ()
+  :hints (("Goal" :expand (LOP0 (+ A (* -1 (EXPT 2 (+ -2 N))))
+			       (+ B (* -1 (EXPT 2 (+ -2 N))))
+			       0 (+ -1 N))
+		  :use (lop0-1-27 lop0-1-28)
+		  :in-theory (enable c)))))
+
+(local (defthm lop0-1-30
+    (IMPLIES (AND (INTEGERP N)
+		  (< 1 N)
+                  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 a b 0 n)
+		(lop0 (- a (expt 2 (- n 2)))
+		     (- b (expt 2 (- n 2)))
+		     0 (- n 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-26 lop0-1-29)))))
+
+(local (defthm lop0-1-31
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (NOT (= (C (+ -1 N) A B) 0))
+		  (= (C (+ -2 N) A B) -1)
+		  (IMPLIES (AND (INTEGERP (+ A (- (EXPT 2 (+ -2 N)))))
+				(INTEGERP (+ B (- (EXPT 2 (+ -2 N)))))
+				(INTEGERP (+ -1 N))
+				(<= 0 (+ A (- (EXPT 2 (+ -2 N)))))
+				(<= 0 (+ B (- (EXPT 2 (+ -2 N)))))
+				(<= 0 (+ -1 N))
+				(< (+ B (- (EXPT 2 (+ -2 N))))
+				   (+ A (- (EXPT 2 (+ -2 N)))))
+				(< (+ A (- (EXPT 2 (+ -2 N))))
+				   (EXPT 2 (+ -1 N)))
+				(< (+ B (- (EXPT 2 (+ -2 N))))
+				   (EXPT 2 (+ -1 N))))
+			   (OR (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
+				       (+ B (- (EXPT 2 (+ -2 N))))
+				       0 (+ -1 N))
+				  (EXPO (+ (+ A (- (EXPT 2 (+ -2 N))))
+					   (- (+ B (- (EXPT 2 (+ -2 N))))))))
+			       (= (LOP0 (+ A (- (EXPT 2 (+ -2 N))))
+				       (+ B (- (EXPT 2 (+ -2 N))))
+				       0 (+ -1 N))
+				  (+ 1
+				     (EXPO (+ (+ A (- (EXPT 2 (+ -2 N))))
+					      (- (+ B (- (EXPT 2 (+ -2 N)))))))))))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (OR (= (LOP0 A B 0 N) (EXPO (+ A (- B))))
+		 (= (LOP0 A B 0 N)
+		    (+ 1 (EXPO (+ A (- B)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-20 lop0-1-30)))))
+
+(local (defthm lop0-1-32
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (= (bitn a (- n 1)) 0)
+		  (= (bitn b (- n 1)) 0)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (- a b)
+		(- (mod a (expt 2 (- n 1)))
+		   (mod b (expt 2 (- n 1))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-does-nothing (m a) (n (expt 2 (- n 1))))
+			(:instance mod-does-nothing (m b) (n (expt 2 (- n 1))))
+			(:instance bit-expo-b (x a) (n (- n 1)))
+			(:instance bit-expo-b (x b) (n (- n 1))))))))
+
+(local (defthm lop0-1-33
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (= (bitn a (- n 1)) 1)
+		  (INTEGERP A)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 N)
+		  (< A (EXPT 2 N)))
+	     (= (mod a (expt 2 (- n 1)))
+		(- a (expt 2 (- n 1)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split)
+           :use ((:instance mod-does-nothing (m (- a (expt 2 (- n 1)))) (n (expt 2 (- n 1))))
+		;	(:instance expt-split (r 2) (i (- n 1)) (j 1))
+			(:instance bit-expo-a (x a) (n (- n 1)))
+;			(:instance mod+-thm (m (- a (expt 2 (- n 1)))) (a 1) (n (expt 2 (- n 1))))
+                        )))))
+
+(local (defthm lop0-1-34
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (= (bitn a (- n 1)) 1)
+		  (= (bitn b (- n 1)) 1)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (- a b)
+		(- (mod a (expt 2 (- n 1)))
+		   (mod b (expt 2 (- n 1))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop0-1-33)
+			(:instance lop0-1-33 (a b)))))))
+
+(local (defthm lop0-1-35
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (= (C (+ -1 N) A B) 0)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (- a b)
+		(- (mod a (expt 2 (- n 1)))
+		   (mod b (expt 2 (- n 1))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable c)
+		  :use (lop0-1-34
+			lop0-1-32
+			(:instance bitn-0-1 (x a) (n (- n 1)))
+			(:instance bitn-0-1 (x b) (n (- n 1))))))))
+
+
+
+(local (defthm lop0-1-36
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (= (C (+ -1 N) A B) 0)
+		  (IMPLIES (AND (INTEGERP (MOD A (EXPT 2 (+ -1 N))))
+				(INTEGERP (MOD B (EXPT 2 (+ -1 N))))
+				(INTEGERP (+ -1 N))
+				(<= 0 (MOD A (EXPT 2 (+ -1 N))))
+				(<= 0 (MOD B (EXPT 2 (+ -1 N))))
+				(<= 0 (+ -1 N))
+				(< (MOD B (EXPT 2 (+ -1 N)))
+				   (MOD A (EXPT 2 (+ -1 N))))
+				(< (MOD A (EXPT 2 (+ -1 N)))
+				   (EXPT 2 (+ -1 N)))
+				(< (MOD B (EXPT 2 (+ -1 N)))
+				   (EXPT 2 (+ -1 N))))
+			   (OR (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
+				       (MOD B (EXPT 2 (+ -1 N)))
+				       0 (+ -1 N))
+				  (EXPO (+ (MOD A (EXPT 2 (+ -1 N)))
+					   (- (MOD B (EXPT 2 (+ -1 N)))))))
+			       (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
+				       (MOD B (EXPT 2 (+ -1 N)))
+				       0 (+ -1 N))
+				  (+ 1
+				     (EXPO (+ (MOD A (EXPT 2 (+ -1 N)))
+					      (- (MOD B (EXPT 2 (+ -1 N))))))))))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (OR (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
+			 (MOD B (EXPT 2 (+ -1 N)))
+			 0 (+ -1 N))
+		    (EXPO (+ A (- B))))
+		 (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
+			 (MOD B (EXPT 2 (+ -1 N)))
+			 0 (+ -1 N))
+		    (+ 1 (EXPO (+ A (- B)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-35
+;			(:instance mod>=0 (m a) (n (expt 2 (- n 1))))
+	;		(:instance mod>=0 (m b) (n (expt 2 (- n 1))))
+			(:instance mod-bnd-1 (m a) (n (expt 2 (- n 1))))
+			(:instance mod-bnd-1 (m b) (n (expt 2 (- n 1))))
+                        )))))
+
+(local (defthm lop0-1-37
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (= (C (+ -1 N) A B) 0)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (= (lop0 a b 0 n)
+		(LOP0 (MOD A (EXPT 2 (+ -1 N)))
+		     (MOD B (EXPT 2 (+ -1 N)))
+		     0 (+ -1 N))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop0)
+		  :use ((:instance lop0-mod (d 0) (j (- n 1)) (k (- n 1))))))))
+
+(local (defthm lop0-1-38
+    (IMPLIES (AND (AND (INTEGERP N) (<= 0 N))
+		  (< 1 N)
+		  (= (C (+ -1 N) A B) 0)
+		  (IMPLIES (AND (INTEGERP (MOD A (EXPT 2 (+ -1 N))))
+				(INTEGERP (MOD B (EXPT 2 (+ -1 N))))
+				(INTEGERP (+ -1 N))
+				(<= 0 (MOD A (EXPT 2 (+ -1 N))))
+				(<= 0 (MOD B (EXPT 2 (+ -1 N))))
+				(<= 0 (+ -1 N))
+				(< (MOD B (EXPT 2 (+ -1 N)))
+				   (MOD A (EXPT 2 (+ -1 N))))
+				(< (MOD A (EXPT 2 (+ -1 N)))
+				   (EXPT 2 (+ -1 N)))
+				(< (MOD B (EXPT 2 (+ -1 N)))
+				   (EXPT 2 (+ -1 N))))
+			   (OR (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
+				       (MOD B (EXPT 2 (+ -1 N)))
+				       0 (+ -1 N))
+				  (EXPO (+ (MOD A (EXPT 2 (+ -1 N)))
+					   (- (MOD B (EXPT 2 (+ -1 N)))))))
+			       (= (LOP0 (MOD A (EXPT 2 (+ -1 N)))
+				       (MOD B (EXPT 2 (+ -1 N)))
+				       0 (+ -1 N))
+				  (+ 1
+				     (EXPO (+ (MOD A (EXPT 2 (+ -1 N)))
+					      (- (MOD B (EXPT 2 (+ -1 N))))))))))
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP N)
+		  (<= 0 A)
+		  (<= 0 B)
+		  (<= 0 N)
+		  (< B A)
+		  (< A (EXPT 2 N))
+		  (< B (EXPT 2 N)))
+	     (OR (= (LOP0 A B 0 N) (EXPO (+ A (- B))))
+		 (= (LOP0 A B 0 N)
+		    (+ 1 (EXPO (+ A (- B)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expt)
+		  :use (lop0-1-36 lop0-1-37)))))
+
+(local (defthm lop0-1-39
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (>= a 0)
+		  (>= b 0)
+		  (>= n 0)
+		  (< b a)
+		  (< a (expt 2 n))
+		  (< b (expt 2 n)))
+	     (or (= (lop0 a b 0 n) (expo (- a b)))
+		 (= (lop0 a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable c)
+		  :induct (lop0-1-induct n a b))
+	  ("Subgoal *1/4" :use (lop0-1-4))
+	  ("Subgoal *1/3" :use (lop0-1-15))
+	  ("Subgoal *1/2" :use (lop0-1-31))
+	  ("Subgoal *1/1" :use (lop0-1-38)))))
+
+
+(local-defthm LOP0-BNDS
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (>= a 0)
+		  (>= b 0)
+		  (>= n 0)
+		  (not (= a b))
+		  (< a (expt 2 n))
+		  (< b (expt 2 n)))
+	     (or (= (lop0 a b 0 n) (expo (- a b)))
+		 (= (lop0 a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable c lop0 expo-minus)
+		  :use (lop0-1-39
+			(:instance expo-minus (x (- a b)))
+			(:instance lop0-1-39 (a b) (b a))
+			(:instance lop0-d (a b) (b a) (d 0) (k n))))))
+
+(defthm LOP-BNDS
+    (implies (and (integerp a)
+		  (integerp b)
+		  (integerp n)
+		  (>= a 0)
+		  (>= b 0)
+		  (>= n 0)
+		  (not (= a b))
+		  (< a (expt 2 n))
+		  (< b (expt 2 n)))
+	     (or (= (lop a b 0 n) (expo (- a b)))
+		 (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop0-is-lop)
+           :use lop0-bnds)))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lop1.lisp acl2-6.3/books/rtl/rel9/support/support/lop1.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lop1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lop1.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,69 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "lop1-proofs"))
+(include-book "merge") ;BOZO drop
+
+(defund lop (a b d k)
+  (let ((c (- (bitn a (1- k)) (bitn b (1- k)))))
+    (if (and (integerp k) (>= k 0))
+	(if (= k 0)
+	    0
+	  (if (= d 0)
+	      (lop a b c (1- k))
+	    (if (= d (- c))
+		(lop a b (- c) (1- k))
+	      k)))
+      0)))
+
+(defthm LOP-MOD
+  (implies (and (integerp a)
+                (>= a 0)
+                (integerp b)
+                (>= b 0)
+                (integerp d)
+                (integerp j)
+                (>= j 0)
+                (integerp k)
+                (>= k j))
+           (= (lop a b d j)
+              (lop (mod a (expt 2 k)) (mod b (expt 2 k)) d j)))
+  :rule-classes ())
+
+(defthm LOP-BNDS
+  (implies (and (integerp a)
+                (integerp b)
+                (integerp n)
+                (>= a 0)
+                (>= b 0)
+                (>= n 0)
+                (not (= a b))
+                (< a (expt 2 n))
+                (< b (expt 2 n)))
+           (or (= (lop a b 0 n) (expo (- a b)))
+               (= (lop a b 0 n) (1+ (expo (- a b))))))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lop2-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/lop2-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lop2-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lop2-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,695 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "lop1")
+(include-book "lior0")
+(local (include-book "../../arithmetic/top"))
+(local (include-book "bitn"))
+(local (include-book "bits"))
+
+(local (defun lop2-induct (n a b)
+  (if (and (integerp n) (>= n 0))
+      (if (> n 0)
+	  (lop2-induct (1- n) a (mod b (expt 2 (1- n))))
+	a)
+    b)))
+
+(local (defthm lop2-1
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (= (bitn a (1- k)) 0)
+		  (= (bitn b (1- k)) 1)
+		  (IMPLIES (AND (INTEGERP A)
+				(<= 0 A)
+				(INTEGERP (MOD B (EXPT 2 (+ -1 K))))
+				(<= 0 (MOD B (EXPT 2 (+ -1 K))))
+				(INTEGERP (+ -1 K))
+				(<= 0 (+ -1 K))
+				(< A (EXPT 2 (+ -1 K)))
+				(< (MOD B (EXPT 2 (+ -1 K)))
+				   (EXPT 2 (+ -1 K))))
+			   (= (LOP A (MOD B (EXPT 2 (+ -1 K)))
+				   1 (+ -1 K))
+			      (EXPO (LOGIOR (* 2 A)
+					    (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
+						   (+ 1 -1 K))))))
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (LOP A 
+		     (MOD B (EXPT 2 (+ -1 K)))
+		     1 (1- K))
+		(EXPO (LOGIOR (* 2 A)
+			      (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
+				     k)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-bnd-1 (m b) (n (expt 2 (1- k))))
+;			(:instance mod>=0 (m b) (n (expt 2 (1- k))))
+			(:instance bit-expo-b (x a) (n (1- k))))))))
+
+(local (defthm lop2-2
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (= (bitn a (1- k)) 0)
+		  (= (bitn b (1- k)) 1)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (LOP A b 1 k)
+		(lop a b 1 (1- k))))
+    :hints (("Goal" :in-theory (enable lop)))
+  :rule-classes ()))
+
+(local (defthm lop2-3
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (= (bitn a (1- k)) 0)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K)))
+	     (= (mod a (expt 2 (1- k)))
+		a))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance mod-does-nothing (m a) (n (expt 2 (1- k))))
+;			(:instance expt-pos (x (1- k)))
+			(:instance bit-expo-b (x a) (n (- k 1))))))))
+
+(local (defthm lop2-4
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (= (bitn a (1- k)) 0)
+		  (= (bitn b (1- k)) 1)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (LOP A b 1 k)
+		(lop a (mod b (expt 2 (1- k))) 1 (1- k))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop2-3
+			lop2-2
+			(:instance lop-mod (d 1) (j (1- k)) (k (1- k))))))))
+
+(local (defthm lop2-5
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (= (bitn a (1- k)) 0)
+		  (= (bitn b (1- k)) 1)
+		  (IMPLIES (AND (INTEGERP A)
+				(<= 0 A)
+				(INTEGERP (MOD B (EXPT 2 (+ -1 K))))
+				(<= 0 (MOD B (EXPT 2 (+ -1 K))))
+				(INTEGERP (+ -1 K))
+				(<= 0 (+ -1 K))
+				(< A (EXPT 2 (+ -1 K)))
+				(< (MOD B (EXPT 2 (+ -1 K)))
+				   (EXPT 2 (+ -1 K))))
+			   (= (LOP A (MOD B (EXPT 2 (+ -1 K)))
+				   1 (+ -1 K))
+			      (EXPO (LOGIOR (* 2 A)
+					    (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
+						   (+ 1 -1 K))))))
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (LOP A b 1 k)
+		(EXPO (LOGIOR (* 2 A)
+			      (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
+				     k)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop2-1 lop2-4)))))
+
+(local (defthm lop2-6
+    (IMPLIES (AND (INTEGERP k)
+		  (< 0 k)
+		  (= (bitn b (- k 1)) 1)
+		  (INTEGERP b)
+		  (INTEGERP k)
+		  (<= 0 b)
+		  (< b (EXPT 2 k)))
+	     (= (mod b (expt 2 (- k 1)))
+		(- b (expt 2 (- k 1)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split)
+           :use ((:instance mod-does-nothing (m (- b (expt 2 (- k 1)))) (n (expt 2 (- k 1))))
+;			(:instance expt-pos (x (- k 1)))
+			(:instance expt-split (r 2) (i (- k 1)) (j 1))
+			(:instance bit-expo-a (x b) (n (- k 1)))
+;			(:instance mod+-thm (m (- b (expt 2 (- k 1)))) (a 1) (n (expt 2 (- k 1))))
+                        )))))
+
+(local (defthm lop2-7
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (= (bitn a (1- k)) 0)
+		  (= (bitn b (1- k)) 1)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (lnot (* 2 (mod b (expt 2 (1- k))))
+		       k)
+		(lnot (* 2 b) (1+ k))))		
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable lnot expt bits-reduce)
+                              '())
+           :use (lop2-6)))))
+
+(local (defthm lop2-8
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (= (bitn a (1- k)) 0)
+		  (= (bitn b (1- k)) 1)
+		  (IMPLIES (AND (INTEGERP A)
+				(<= 0 A)
+				(INTEGERP (MOD B (EXPT 2 (+ -1 K))))
+				(<= 0 (MOD B (EXPT 2 (+ -1 K))))
+				(INTEGERP (+ -1 K))
+				(<= 0 (+ -1 K))
+				(< A (EXPT 2 (+ -1 K)))
+				(< (MOD B (EXPT 2 (+ -1 K)))
+				   (EXPT 2 (+ -1 K))))
+			   (= (LOP A (MOD B (EXPT 2 (+ -1 K)))
+				   1 (+ -1 K))
+			      (EXPO (LOGIOR (* 2 A)
+					    (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
+						   (+ 1 -1 K))))))
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (LOP A b 1 k)
+		(EXPO (LOGIOR (* 2 A)
+			      (LNOT (* 2 b) (1+ k))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable lnot lop)
+		  :use (lop2-5 lop2-7)))))
+
+(local (defthm lop2-9
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (not (and (= (bitn a (1- k)) 0)
+			    (= (bitn b (1- k)) 1)))
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (LOP A b 1 k) k))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop)
+           :use ((:instance bitn-0-1 (x a) (n (1- k)))
+                 (:instance bitn-0-1 (x b) (n (1- k))))))))
+
+(local (defthm lop2-10
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (< (* 2 a) (expt 2 (1+ k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt)
+                              '(a15))
+                              :use ((:instance *-strongly-monotonic (x 2) (y a) (y+ (expt 2 k))))))))
+
+(local (defthm lop2-11
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (< (LNOT (* 2 b) (1+ k))
+		(expt 2 (1+ k))))
+    :hints (("Goal"  :in-theory (set-difference-theories
+                              (enable expt lnot)
+                              '(a15))))
+  :rule-classes ()))
+
+(local (defthm lop2-12
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (< (logior (* 2 a)
+			(LNOT (* 2 b) (1+ k)))
+		(expt 2 (1+ k))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop2-10
+			lop2-11
+;			(:instance or-dist-a
+	;			   (x (* 2 a))
+		;		   (y (lnot (* 2 b) (1+ k)))
+			;	   (n (1+ k)))
+                        )))))
+
+(local (defthm lop2-13
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (<= (expo (logior (* 2 a)
+			       (LNOT (* 2 b) (1+ k))))
+		 k))
+  :rule-classes ()
+  :hints (("Goal" :use (lop2-12
+			(:instance expo<= (x (logior (* 2 a) (LNOT (* 2 b) (1+ k)))) (n k)))))))
+
+(local (include-book "logior")) ;remove if log includes logior
+
+(local (defthm lop2-14
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (= (bitn a (1- k)) 1)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (bitn (logior (* 2 a) (LNOT (* 2 b) (1+ k)))
+		      k)
+		1))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
+		  :use ((:instance bitn-shift (x a) (k 1) (n (1- k)))
+			(:instance bitn-0-1 (x (LNOT (* 2 b) (1+ k))) (n k)))))))
+
+(local (defthm lop2-15
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (= (bitn b (1- k)) 0)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (bitn (logior (* 2 a) (LNOT (* 2 b) (1+ k)))
+		      k)
+		1))
+  :rule-classes ()
+  :hints (("Goal"  :in-theory (set-difference-theories
+                              (enable bits-reduce)
+                              '(a15  BITN-KNOWN-NOT-0-REPLACE-WITH-1))
+		  :use ((:instance bitn-shift (x b) (k 1) (n (1- k)))
+			(:instance bitn-0-1 (x (LNOT (* 2 b) (1+ k))) (n k))
+			(:instance bitn-0-1 (x (* 2 a)) (n k))
+			(:instance bitn-lnot-not-equal
+				   (x (* 2 b))
+				   (n (1+ k))))))))
+
+(local (defthm lop2-16
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (not (and (= (bitn a (1- k)) 0)
+			    (= (bitn b (1- k)) 1)))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (bitn (logior (* 2 a) (LNOT (* 2 b) (1+ k)))
+		      k)
+		1))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior)
+		  :use (lop2-14
+			lop2-15
+			(:instance bitn-0-1 (x a) (n (1- k)))
+			(:instance bitn-0-1 (x b) (n (1- k))))))))
+
+(local (defthm lop2-17
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (not (and (= (bitn a (1- k)) 0)
+			    (= (bitn b (1- k)) 1)))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (>= (logior (* 2 a) (LNOT (* 2 b) (1+ k)))
+		 (expt 2 k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior)
+		  :use (lop2-16
+			(:instance bit-expo-a (x (logior (* 2 a) (LNOT (* 2 b) (1+ k)))) (n k)))))))
+
+(local (defthm lop2-18
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (not (and (= (bitn a (1- k)) 0)
+			    (= (bitn b (1- k)) 1)))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (>= (expo (logior (* 2 a) (LNOT (* 2 b) (1+ k))))
+		 k))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior)
+		  :use (lop2-17
+			(:instance expo>= (x (logior (* 2 a) (LNOT (* 2 b) (1+ k)))) (n k)))))))
+
+(local (defthm lop2-19
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (not (and (= (bitn a (1- k)) 0)
+			    (= (bitn b (1- k)) 1)))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (expo (logior (* 2 a) (LNOT (* 2 b) (1+ k))))
+		k))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior)
+		  :use (lop2-13 lop2-18)))))
+
+(local (defthm lop2-20
+    (IMPLIES (AND (INTEGERP K)
+		  (< 0 K)
+		  (IMPLIES (AND (INTEGERP A)
+				(<= 0 A)
+				(INTEGERP (MOD B (EXPT 2 (+ -1 K))))
+				(<= 0 (MOD B (EXPT 2 (+ -1 K))))
+				(INTEGERP (+ -1 K))
+				(<= 0 (+ -1 K))
+				(< A (EXPT 2 (+ -1 K)))
+				(< (MOD B (EXPT 2 (+ -1 K)))
+				   (EXPT 2 (+ -1 K))))
+			   (= (LOP A (MOD B (EXPT 2 (+ -1 K)))
+				   1 (+ -1 K))
+			      (EXPO (LOGIOR (* 2 A)
+					    (LNOT (* 2 (MOD B (EXPT 2 (+ -1 K))))
+						   (+ 1 -1 K))))))
+		  (INTEGERP A)
+		  (<= 0 A)
+		  (INTEGERP B)
+		  (<= 0 B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< A (EXPT 2 K))
+		  (< B (EXPT 2 K)))
+	     (= (LOP A b 1 k)
+		(EXPO (LOGIOR (* 2 A)
+			      (LNOT (* 2 b) (1+ k))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable lnot logior lop)
+		  :use (lop2-8 lop2-19 lop2-9)))))
+
+(local (defthm lop2-21
+    (implies (and (integerp a)
+		  (>= a 0)
+		  (integerp b)
+		  (>= b 0)
+		  (integerp k)
+		  (>= k 0)
+		  (< a (expt 2 k))
+		  (< b (expt 2 k)))
+	     (= (lop a b 1 k)
+		(expo (logior (* 2 a) (lnot (* 2 b) (1+ k))))))
+  :rule-classes ()
+  :hints (("Goal" :induct (lop2-induct k a b))
+	  ("Subgoal *1/1" :use (lop2-20)))))
+
+(local (defthm lop2-22
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e))
+	     (= (bitn a e) 1))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expo-upper-bound (x a))
+			(:instance expo-monotone (x 1) (y a))
+			(:instance expo-lower-bound (x a))
+			(:instance bit-expo-b (x a) (n e)))))))
+
+;move?
+(local (defthm lop2-23
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e))
+	     (= (bitn b e) 0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
+                                      EXPO-BOUND-ERIC
+                                      expt-compare
+                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+           :use ((:instance expo-upper-bound (x b))
+			(:instance expo-monotone (x 1) (y a))
+			(:instance expt-weak-monotone (n (1+ (expo b))) (m e))
+			(:instance bit-expo-a (x b) (n e)))))))
+
+(local (defthm lop2-24
+         (implies (and (integerp a)
+                       (> a 0)
+                       (integerp b)
+                       (> b 0)
+                       (= e (expo a))
+                       (< (expo b) e))
+                  (= (lop a b 0 (1+ e))
+                     (lop a b 1 e)))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (enable lop)
+                  :use (lop2-22 
+			lop2-23
+			(:instance expo-monotone (x 1) (y a)))))))
+
+(local (defthm lop2-25
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (lnot (* 2 b) (1+ e)))))
+	     (= (lop (mod a (expt 2 e)) b 1 e)
+		(expo lambda)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
+                                      EXPO-BOUND-ERIC
+                                      expt-compare
+                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+           :use ((:instance lop2-21 (a (mod a (expt 2 e))) (k e))
+			(:instance expo-upper-bound (x b))
+			(:instance expo-monotone (x 1) (y a))
+			(:instance expt-weak-monotone (n (1+ (expo b))) (m e))
+;			(:instance mod>=0 (m a) (n (expt 2 e)))
+			(:instance mod-bnd-1 (m a) (n (expt 2 e))))))) )
+
+(local (defthm lop2-26
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (lnot (* 2 b) (1+ e)))))
+	     (= (lop (mod a (expt 2 e)) b 1 e)
+		(lop a b 1 e)))
+  :rule-classes ()
+  :hints (("Goal"  :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
+                                      EXPO-BOUND-ERIC
+                                      expt-compare
+                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+           :use ((:instance lop-mod (d 1) (j e) (k e))
+			(:instance mod-does-nothing (m b) (n (expt 2 e)))
+			(:instance expo-upper-bound (x b))
+			(:instance expo-monotone (x 1) (y a))
+			(:instance expt-weak-monotone (n (1+ (expo b))) (m e)))))))
+
+(local (defthm lop2-27
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (lnot (* 2 b) (1+ e)))))
+	     (= (lop a b 0 (1+ e))
+		(expo lambda)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior lop)
+		  :use (lop2-24 lop2-25 lop2-26)))))
+
+(defthm olop-thm-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (logior (* 2 (mod a (expt 2 e)))
+			     (lnot (* 2 b) (1+ e)))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior lop)
+		  :use (lop2-27
+			(:instance expo-upper-bound (x b))
+			(:instance expo-monotone (x 1) (y a))
+			(:instance expt-weak-monotone (n (1+ (expo b))) (m e))
+			(:instance expo-upper-bound (x a))
+			(:instance lop-bnds (n (1+ e)))))))
+
+
+
+(local (defthm hack-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e))
+	     (bvecp (* 2 (mod a (expt 2 e)))
+		    (1+ e)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lior0 bvecp bits-tail)
+		  :expand ((EXPT 2 (+ 1 (EXPO A))))
+		  :use ((:instance mod-bnd-1 (m a) (n (expt 2 e)))
+			(:instance expo-monotone (x 1) (y a))))))			)
+
+(local (defthm hack-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e))
+	     (bvecp (lnot (* 2 b) (1+ e))
+		    (1+ e)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (union-theories (disable bits-bvecp) '(lnot bvecp))
+		  :use ((:instance expo-monotone (x 1) (y a))
+			(:instance bits-bvecp (x (* 2 b)) (i e) (j 0) (k (1+ e)))
+			(:instance expo-upper-bound (x b)))))))
+
+(defthm lop-thm-1-original
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (< (expo b) e)
+		  (= lambda
+		     (lior0 (* 2 (mod a (expt 2 e)))
+			   (lnot (* 2 b) (1+ e))
+			   (1+ e))))
+	     (or (= (expo (- a b)) (expo lambda))
+		 (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lior0 bits-tail)
+		  :use (olop-thm-1
+			hack-1
+			hack-2))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lop2.lisp acl2-6.3/books/rtl/rel9/support/support/lop2.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lop2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lop2.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,44 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "lop1") ;BOZO
+(include-book "lior0");BOZO
+(local (include-book "lop2-proofs"))
+
+(defthm lop-thm-1-original
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (= e (expo a))
+                (< (expo b) e)
+                (= lambda
+                   (lior0 (* 2 (mod a (expt 2 e)))
+                         (lnot (* 2 b) (1+ e))
+                         (1+ e))))
+           (or (= (expo (- a b)) (expo lambda))
+               (= (expo (- a b)) (1- (expo lambda)))))
+  :rule-classes ())
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lop3-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/lop3-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lop3-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lop3-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,2600 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "lop2")
+(local (include-book "../../arithmetic/top"))
+(local (include-book "bitn"))
+(local (include-book "bits"))
+
+(local
+ (defund C (k a b)
+   (- (bitn a k) (bitn b k))))
+
+(defund OLAMT (a b e)
+  (logxor a (lnot b (1+ e))))
+
+(defund OLAMG (a b e)
+  (logand a (lnot b (1+ e))))
+
+(defund OLAMZ (a b e)
+  (lnot (logior a (lnot b (1+ e))) (1+ e)))
+
+(defund OLAM1 (a b e)
+  (logand (bits (olamt a b e) e 2) 
+	  (logand (bits (olamg a b e) (1- e) 1)
+		  (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
+
+(defund OLAM2 (a b e)
+  (logand (lnot (bits (olamt a b e) e 2) (1- e))
+	  (logand (bits (olamz a b e) (1- e) 1)
+		  (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
+
+(defund OLAM3 (a b e)
+  (logand (bits (olamt a b e) e 2) 
+	  (logand (bits (olamz a b e) (1- e) 1)
+		  (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
+
+(defund OLAM4 (a b e)
+  (logand (lnot (bits (olamt a b e) e 2) (1- e))
+	  (logand (bits (olamg a b e) (1- e) 1)
+		  (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
+
+(defund OLAM0 (a b e)
+  (logior (olam1 a b e)
+	  (logior (olam2 a b e)
+		  (logior (olam3 a b e)
+			  (olam4 a b e)))))
+
+(defund OLAMB (a b e)
+  (+ (* 2 (olam0 a b e))
+     (lnot (bitn (olamt a b e) 0) 1)))
+
+(local (defthm bitn-olamt
+    (implies (and (integerp a)
+		  (>= a 0) ;(> a 0)
+		  (integerp b)
+		  (>= b 0) ;(> b 0)
+;		  (not (= a b))
+;		  (= e (expo a))
+		  (= e (expo b))
+;		  (> e 0)
+		  (integerp k)
+		  (>= k 0)
+		  (<= k e)
+                  )
+	     (iff (= (bitn (olamt a b e) k) 1)
+		  (= (c k a b) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable c olamt)
+		  :use ((:instance bitn-lnot-not-equal (x b) (n (1+ e)))
+			(:instance bitn-0-1 (x a) (n k))
+			(:instance bitn-0-1 (x b) (n k))
+			(:instance bitn-0-1 (x (lnot b (1+ e))) (n k))
+			(:instance expo-upper-bound (x b))
+			(:instance bitn-logxor (x a) (y (lnot b (1+ e))) (n k)))))))
+
+(defthm OLAMT-NAT
+  (implies (and (integerp a)
+                (>= a 0) ;(> a 0)
+;                (integerp b)
+ ;               (> b 0)
+  ;              (not (= a b))
+   ;             (= e (expo a))
+    ;            (= e (expo b))
+     ;           (> e 0)
+                )
+           (and (integerp (olamt a b e))
+                (>= (olamt a b e) 0)))
+;  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olamt)
+           )))
+
+(local (defthm bitn-olamg
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 0)
+		  (integerp k)
+		  (>= k 0)
+		  (<= k e))
+	     (iff (= (bitn (olamg a b e) k) 1)
+		  (= (c k a b) 1)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d ( c olamg) (EXPO-BOUND-ERIC
+                                              EXPO-COMPARISON-REWRITE-TO-BOUND
+                                              EXPO-COMPARISON-REWRITE-TO-BOUND-2))
+		  :use ((:instance bitn-lnot-not-equal (x b) (n (1+ e)))
+			(:instance bitn-0-1 (x a) (n k))
+			(:instance bitn-0-1 (x b) (n k))
+			(:instance bitn-0-1 (x (lnot b (1+ e))) (n k))
+			(:instance expo-upper-bound (x b)))))))
+
+(defthm OLAMG-NAT
+    (implies (and (integerp a)
+		  (> a 0)
+                  )
+	     (and (integerp (olamg a b e))
+		  (>= (olamg a b e) 0)))
+;  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olamg))))
+
+(local (defthm bitn-olamz-1
+         (implies (and (integerp a)
+                       (> a 0)
+                       (integerp b)
+                       (> b 0)
+                       (not (= a b))
+                       (= e (expo a))
+                       (= e (expo b))
+                       (> e 0)
+                       (integerp k)
+                       (>= k 0)
+                       (<= k e))
+                  (iff (= (bitn (logior a (lnot b (1+ e))) k) 0)
+                       (= (c k a b) -1)))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (e/d (c) (EXPO-BOUND-ERIC
+                                              EXPO-COMPARISON-REWRITE-TO-BOUND
+                                              EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                              BITN-KNOWN-NOT-0-REPLACE-WITH-1))
+		  :use ((:instance bitn-lnot-not-equal (x b) (n (1+ e)))
+			(:instance bitn-0-1 (x a) (n k))
+			(:instance bitn-0-1 (x b) (n k))
+			(:instance bitn-0-1 (x (lnot b (1+ e))) (n k))
+			(:instance expo-upper-bound (x b)))))))
+
+(local (defthm bitn-olamz
+         (implies (and (integerp a)
+                       (> a 0)
+                       (integerp b)
+                       (> b 0)
+                       (not (= a b))
+                       (= e (expo a))
+                       (= e (expo b))
+                       (> e 0)
+                       (integerp k)
+                       (>= k 0)
+                       (<= k e))
+                  (iff (= (bitn (olamz a b e) k) 1)
+                       (= (c k a b) -1)))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (set-difference-theories
+                                     (enable  olamz
+                                              bits-reduce)
+                                     '(BITN-KNOWN-NOT-0-REPLACE-WITH-1
+                                       EXPO-BOUND-ERIC
+                                       EXPO-COMPARISON-REWRITE-TO-BOUND
+                                       EXPO-COMPARISON-REWRITE-TO-BOUND-2))
+		  :use (bitn-olamz-1
+			(:instance bitn-lnot-not-equal (x (logior a (lnot b (1+ e)))) (n (1+ e)))
+
+			(:instance bitn-0-1 (x (olamz a b e)) (n k))
+			(:instance bitn-0-1 (x (logior a (lnot b (1+ e)))) (n k))
+			(:instance expo-upper-bound (x b))
+                    ;			(:instance or-dist-a (x a) (y (lnot b (1+ e))) (n (1+ e)))
+			(:instance expo-upper-bound (x a)))))))
+
+(defthm OLAMZ-NAT
+    (implies (and (integerp a)
+		  (> a 0)
+;		  (integerp b)
+	;	  (> b 0)
+		;  (not (= a b))
+		 ; (= e (expo a))
+		 ; (= e (expo b))
+		  ;(> e 0)
+                  )
+	     (and (integerp (olamz a b e))
+		  (>= (olamz a b e) 0))))
+
+(local (defthm bitn-olam1-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (>= k 0))
+	     (equal (bitn (olam1 a b e) k)
+		    (logand (bitn (bits (olamt a b e) e 2) k)
+			    (logand (bitn (bits (olamg a b e) (1- e) 1) k)
+				    (bitn (lnot (bits (olamz a b e) (- e 2) 0) (1- e)) k)))))
+  :hints (("Goal" :in-theory (enable olam1)))))
+
+(local (defthm bitn-olam1-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (>= k 0))
+	     (iff (= (bitn (olam1 a b e) k) 1)
+		  (and (= (bitn (bits (olamt a b e) e 2) k) 1)
+		       (= (bitn (bits (olamg a b e) (1- e) 1) k) 1)
+		       (= (bitn (lnot (bits (olamz a b e) (- e 2) 0) (1- e)) k) 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable bits olam1 logand)
+		  :use ((:instance bitn-0-1 (x (bits (olamt a b e) e 2)) (n k))
+			(:instance bitn-0-1 (x (bits (olamg a b e) (1- e) 1)) (n k))
+			(:instance bitn-0-1 (x (lnot (bits (olamz a b e) (- e 2) 0) (1- e))) (n k)))))))
+
+(local (in-theory (disable bitn-olam1-1)))
+
+(local (defthm bitn-olam1-3
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam1 a b e) k) 1)
+		  (and (= (bitn (bits (olamt a b e) e 2) k) 1)
+		       (= (bitn (bits (olamg a b e) (1- e) 1) k) 1)
+		       (= (bitn (bits (olamz a b e) (- e 2) 0) k) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olam1 bits lnot logand)
+		  :use (;olamz-nat
+			bitn-olam1-2
+;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
+			(:instance bitn-0-1 (x (lnot (bits (olamz a b e) (- e 2) 0) (1- e))) (n k))
+			(:instance bitn-lnot-not-equal (x (bits (olamz a b e) (- e 2) 0)) (n (1- e)))
+			(:instance bitn-0-1 (x (bits (olamz a b e) (- e 2) 0)) (n k)))))))
+
+(local (defthm bitn-olam1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam1 a b e) k) 1)
+		  (and (= (bitn (olamt a b e) (+ 2 k)) 1)
+		       (= (bitn (olamg a b e) (+ 1 k)) 1)
+		       (= (bitn (olamz a b e) k) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olam1 bits logand)
+		  :use (;olamz-nat
+			;olamt-nat
+			;olamg-nat
+			bitn-olam1-3
+;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
+			(:instance bitn-0-1 (x (olamz a b e)) (n k))
+;			(:instance bitn-bits (x (olamt a b e)) (i e) (j 2))
+;			(:instance bitn-bits (x (olamg a b e)) (i (- e 1)) (j 1))
+	;		(:instance bitn-bits (x (olamz a b e)) (i (- e 2)) (j 0))
+                        )))))
+
+(defthm OLAM1-NAT
+    (implies (and (integerp a)
+		  (> a 0)
+		 ; (integerp b)
+		  ;(> b 0)
+	;	  (not (= a b))
+		;  (= e (expo a))
+		 ; (= e (expo b))
+		 ; (> e 1)
+		 ; (integerp k)
+		 ; (<= k (- e 2))
+		 ; (>= k 0)
+                  )
+	     (and (integerp (olam1 a b e))
+		  (>= (olam1 a b e) 0)))
+;  :rule-classes ()
+  :hints (("Goal" :in-theory (disable bits logand)
+		  :use (;olamz-nat
+			;olamt-nat
+			;olamg-nat
+;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
+                        ))))
+
+(local (defthm bitn-olam3-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (>= k 0))
+	     (equal (bitn (olam3 a b e) k)
+		    (logand (bitn (bits (olamt a b e) e 2) k)
+			    (logand (bitn (bits (olamz a b e) (1- e) 1) k)
+				    (bitn (lnot (bits (olamg a b e) (- e 2) 0) (1- e)) k)))))
+  :hints (("Goal" :in-theory (enable olam3)))))
+
+(local (defthm bitn-olam3-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (>= k 0))
+	     (iff (= (bitn (olam3 a b e) k) 1)
+		  (and (= (bitn (bits (olamt a b e) e 2) k) 1)
+		       (= (bitn (bits (olamz a b e) (1- e) 1) k) 1)
+		       (= (bitn (lnot (bits (olamg a b e) (- e 2) 0) (1- e)) k) 1))))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable bits olam3 logand)
+		  :use ((:instance bitn-0-1 (x (bits (olamt a b e) e 2)) (n k))
+			(:instance bitn-0-1 (x (bits (olamz a b e) (1- e) 1)) (n k))
+			(:instance bitn-0-1 (x (lnot (bits (olamg a b e) (- e 2) 0) (1- e))) (n k)))))))
+
+(local (in-theory (disable bitn-olam3-1)))
+
+(local (defthm bitn-olam3-3
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam3 a b e) k) 1)
+		  (and (= (bitn (bits (olamt a b e) e 2) k) 1)
+		       (= (bitn (bits (olamz a b e) (1- e) 1) k) 1)
+		       (= (bitn (bits (olamg a b e) (- e 2) 0) k) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olam3 bits lnot logand)
+		  :use (;olamg-nat
+			bitn-olam3-2
+;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
+			(:instance bitn-0-1 (x (lnot (bits (olamg a b e) (- e 2) 0) (1- e))) (n k))
+			(:instance bitn-lnot-not-equal (x (bits (olamg a b e) (- e 2) 0)) (n (1- e)))
+			(:instance bitn-0-1 (x (bits (olamg a b e) (- e 2) 0)) (n k)))))))
+
+(local (defthm bitn-olam3
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam3 a b e) k) 1)
+		  (and (= (bitn (olamt a b e) (+ 2 k)) 1)
+		       (= (bitn (olamz a b e) (+ 1 k)) 1)
+		       (= (bitn (olamg a b e) k) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olam3 bits logand)
+		  :use (;olamg-nat
+			;olamt-nat
+			;olamz-nat
+			bitn-olam3-3
+;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
+			(:instance bitn-0-1 (x (olamg a b e)) (n k))
+;			(:instance bitn-bits (x (olamt a b e)) (i e) (j 2))
+	;		(:instance bitn-bits (x (olamz a b e)) (i (- e 1)) (j 1))
+		;	(:instance bitn-bits (x (olamg a b e)) (i (- e 2)) (j 0))
+                        )))))
+
+(defthm OLAM3-NAT
+    (implies (and (integerp a)
+		  (> a 0)
+;		  (integerp b)
+	;	  (> b 0)
+;		  (not (= a b))
+	;	  (= e (expo a))
+		;  (= e (expo b))
+		 ; (> e 1)
+		 ; (integerp k)
+		 ; (<= k (- e 2))
+		 ; (>= k 0)
+                  )
+	     (and (integerp (olam3 a b e))
+		  (>= (olam3 a b e) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable bits logand)
+		  :use (;olamg-nat
+			;olamt-nat
+			;olamz-nat
+;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
+                        ))))
+
+(local (defthm bitn-olam2-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (>= k 0))
+	     (equal (bitn (olam2 a b e) k)
+		    (logand (bitn (lnot (bits (olamt a b e) e 2) (1- e)) k)
+			    (logand (bitn (bits (olamz a b e) (1- e) 1) k)
+				    (bitn (lnot (bits (olamz a b e) (- e 2) 0) (1- e)) k)))))
+  :hints (("Goal" :in-theory (enable olam2)))))
+
+(local (defthm bitn-olam2-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (>= k 0))
+	     (iff (= (bitn (olam2 a b e) k) 1)
+		  (and (= (bitn (lnot (bits (olamt a b e) e 2) (1- e)) k) 1)
+		       (= (bitn (bits (olamz a b e) (1- e) 1) k) 1)
+		       (= (bitn (lnot (bits (olamz a b e) (- e 2) 0) (1- e)) k) 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable bits olam2 logand)
+		  :use ((:instance bitn-0-1 (x (lnot (bits (olamt a b e) e 2) (1- e))) (n k))
+			(:instance bitn-0-1 (x (bits (olamz a b e) (1- e) 1)) (n k))
+			(:instance bitn-0-1 (x (lnot (bits (olamz a b e) (- e 2) 0) (1- e))) (n k)))))))
+
+(local (in-theory (disable bitn-olam2-1)))
+
+(local (defthm bitn-olam2-3
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam2 a b e) k) 1)
+		  (and (= (bitn (bits (olamt a b e) e 2) k) 0)
+		       (= (bitn (bits (olamz a b e) (1- e) 1) k) 1)
+		       (= (bitn (bits (olamz a b e) (- e 2) 0) k) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olam2 bits lnot logand)
+		  :use (;olamz-nat
+			;olamt-nat
+			bitn-olam2-2
+;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
+			(:instance bitn-0-1 (x (lnot (bits (olamt a b e) e 2) (1- e))) (n k))
+			(:instance bitn-lnot-not-equal (x (bits (olamt a b e) e 2)) (n (1- e)))
+			(:instance bitn-0-1 (x (bits (olamt a b e) e 2)) (n k))
+;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
+			(:instance bitn-0-1 (x (lnot (bits (olamz a b e) (- e 2) 0) (1- e))) (n k))
+			(:instance bitn-lnot-not-equal (x (bits (olamz a b e) (- e 2) 0)) (n (1- e)))
+			(:instance bitn-0-1 (x (bits (olamz a b e) (- e 2) 0)) (n k)))))))
+
+(local (defthm bitn-olam2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam2 a b e) k) 1)
+		  (and (= (bitn (olamt a b e) (+ 2 k)) 0)
+		       (= (bitn (olamz a b e) (+ 1 k)) 1)
+		       (= (bitn (olamz a b e) k) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olam2 bits logand)
+		  :use (;olamz-nat
+			;olamt-nat
+			bitn-olam2-3
+;			(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
+			(:instance bitn-0-1 (x (olamz a b e)) (n k))
+;			(:instance bitn-bits (x (olamt a b e)) (i e) (j 2))
+	;		(:instance bitn-bits (x (olamz a b e)) (i (- e 1)) (j 1))
+		;	(:instance bitn-bits (x (olamz a b e)) (i (- e 2)) (j 0))
+                        )))))
+
+(defthm OLAM2-NAT
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+;		  (> b 0)
+	;	  (not (= a b))
+		;  (= e (expo a))
+		 ; (= e (expo b))
+;		  (> e 1)
+	;	  (integerp k)
+		;  (<= k (- e 2))
+		 ; (>= k 0)
+                  )
+	     (and (integerp (olam2 a b e))
+		  (>= (olam2 a b e) 0)))
+;  :rule-classes ()
+  :hints (("Goal" :in-theory (disable bits logand)
+		  :use (;olamz-nat
+			;olamt-nat
+;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
+	;		(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
+))))
+
+(local (defthm bitn-olam4-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (>= k 0))
+	     (equal (bitn (olam4 a b e) k)
+		    (logand (bitn (lnot (bits (olamt a b e) e 2) (1- e)) k)
+			    (logand (bitn (bits (olamg a b e) (1- e) 1) k)
+				    (bitn (lnot (bits (olamg a b e) (- e 2) 0) (1- e)) k)))))
+  :hints (("Goal" :in-theory (enable olam4)))))
+
+(local (defthm bitn-olam4-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (>= k 0))
+	     (iff (= (bitn (olam4 a b e) k) 1)
+		  (and (= (bitn (lnot (bits (olamt a b e) e 2) (1- e)) k) 1)
+		       (= (bitn (bits (olamg a b e) (1- e) 1) k) 1)
+		       (= (bitn (lnot (bits (olamg a b e) (- e 2) 0) (1- e)) k) 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable bits olam4 logand)
+		  :use ((:instance bitn-0-1 (x (lnot (bits (olamt a b e) e 2) (1- e))) (n k))
+			(:instance bitn-0-1 (x (bits (olamg a b e) (1- e) 1)) (n k))
+			(:instance bitn-0-1 (x (lnot (bits (olamg a b e) (- e 2) 0) (1- e))) (n k)))))))
+
+(local (in-theory (disable bitn-olam4-1)))
+
+(local (defthm bitn-olam4-3
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam4 a b e) k) 1)
+		  (and (= (bitn (bits (olamt a b e) e 2) k) 0)
+		       (= (bitn (bits (olamg a b e) (1- e) 1) k) 1)
+		       (= (bitn (bits (olamg a b e) (- e 2) 0) k) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olam4 bits lnot logand)
+		  :use (;olamg-nat
+			;olamt-nat
+			bitn-olam4-2
+;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
+			(:instance bitn-0-1 (x (lnot (bits (olamt a b e) e 2) (1- e))) (n k))
+			(:instance bitn-lnot-not-equal (x (bits (olamt a b e) e 2)) (n (1- e)))
+			(:instance bitn-0-1 (x (bits (olamt a b e) e 2)) (n k))
+;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
+			(:instance bitn-0-1 (x (lnot (bits (olamg a b e) (- e 2) 0) (1- e))) (n k))
+			(:instance bitn-lnot-not-equal (x (bits (olamg a b e) (- e 2) 0)) (n (1- e)))
+			(:instance bitn-0-1 (x (bits (olamg a b e) (- e 2) 0)) (n k)))))))
+
+(local (defthm bitn-olam4
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam4 a b e) k) 1)
+		  (and (= (bitn (olamt a b e) (+ 2 k)) 0)
+		       (= (bitn (olamg a b e) (+ 1 k)) 1)
+		       (= (bitn (olamg a b e) k) 0))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olam4 bits logand)
+		  :use (;olamg-nat
+			;olamt-nat
+			bitn-olam4-3
+;			(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
+			(:instance bitn-0-1 (x (olamg a b e)) (n k))
+;			(:instance bitn-bits (x (olamt a b e)) (i e) (j 2))
+	;		(:instance bitn-bits (x (olamg a b e)) (i (- e 1)) (j 1))
+		;	(:instance bitn-bits (x (olamg a b e)) (i (- e 2)) (j 0))
+                        )))))
+
+(defthm OLAM4-NAT
+    (implies (and (integerp a)
+		  (> a 0)
+                  )
+	     (and (integerp (olam4 a b e))
+		  (>= (olam4 a b e) 0)))
+;  :rule-classes ()
+)
+
+(local (defthm bitn-olam0-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (equal (bitn (olam0 a b e) k) 
+		    (logior (bitn (olam1 a b e) k)
+			    (logior (bitn (olam2 a b e) k)
+				    (logior (bitn (olam3 a b e) k)
+					    (bitn (olam4 a b e) k))))))
+  :hints (("Goal" :in-theory (enable olam0)))))
+
+(local (defthm bitn-olam0-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam0 a b e) k) 1)
+		  (or (= (bitn (olam1 a b e) k) 1)
+		      (= (bitn (olam2 a b e) k) 1)
+		      (= (bitn (olam3 a b e) k) 1)
+		      (= (bitn (olam4 a b e) k) 1))))
+  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
+		  :use (;olam1-nat
+			;olam2-nat
+			;olam3-nat
+			;olam4-nat
+			(:instance bitn-0-1 (x (olam1 a b e)) (n k))
+			(:instance bitn-0-1 (x (olam2 a b e)) (n k))
+			(:instance bitn-0-1 (x (olam3 a b e)) (n k))
+			(:instance bitn-0-1 (x (olam4 a b e)) (n k)))))))
+
+(local (in-theory (disable bitn-olam0-1)))
+
+(local (defthm bitn-olam0-3
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam0 a b e) k) 1)
+		  (or (and (= (bitn (olamt a b e) (+ 2 k)) 1)
+			   (= (bitn (olamg a b e) (+ 1 k)) 1)
+			   (= (bitn (olamz a b e) k) 0))
+		      (and (= (bitn (olamt a b e) (+ 2 k)) 0)
+			   (= (bitn (olamz a b e) (+ 1 k)) 1)
+			   (= (bitn (olamz a b e) k) 0))
+		      (and (= (bitn (olamt a b e) (+ 2 k)) 1)
+			   (= (bitn (olamz a b e) (+ 1 k)) 1)
+			   (= (bitn (olamg a b e) k) 0))
+		      (and (= (bitn (olamt a b e) (+ 2 k)) 0)
+			   (= (bitn (olamg a b e) (+ 1 k)) 1)
+			   (= (bitn (olamg a b e) k) 0)))))
+  :hints (("Goal" :in-theory (disable olam0)
+		  :use (bitn-olam0-2 bitn-olam1 bitn-olam2 bitn-olam3 bitn-olam4)))))
+
+(local (defthm bitn-olam0-4
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam0 a b e) k) 1)
+		  (or (and (= (bitn (olamt a b e) (+ 2 k)) 1)
+			   (= (bitn (olamg a b e) (+ 1 k)) 1)
+			   (not (= (bitn (olamz a b e) k) 1)))
+		      (and (not (= (bitn (olamt a b e) (+ 2 k)) 1))
+			   (= (bitn (olamz a b e) (+ 1 k)) 1)
+			   (not (= (bitn (olamz a b e) k) 1)))
+		      (and (= (bitn (olamt a b e) (+ 2 k)) 1)
+			   (= (bitn (olamz a b e) (+ 1 k)) 1)
+			   (not (= (bitn (olamg a b e) k) 1)))
+		      (and (not (= (bitn (olamt a b e) (+ 2 k)) 1))
+			   (= (bitn (olamg a b e) (+ 1 k)) 1)
+			   (not (= (bitn (olamg a b e) k) 1))))))
+  :hints (("Goal" :in-theory (disable olam0)
+		  :use (bitn-olam0-3
+			(:instance bitn-0-1 (x (olamz a b e)) (n k))
+			(:instance bitn-0-1 (x (olamg a b e)) (n k))
+			(:instance bitn-0-1 (x (olamt a b e)) (n (+ 2 k))))))))
+
+(local (defthm c-0-1
+         (or (= (c k a b) 0)
+             (= (c k a b) 1)
+             (= (c k a b) -1))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (enable c)
+                  :use ((:instance bitn-0-1 (x a) (n k))
+			(:instance bitn-0-1 (x b) (n k)))))))
+
+(local (defthm bitn-olam0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (iff (= (bitn (olam0 a b e) k) 1)
+		  (and (not (= (c (1+ k) a b) 0))
+		       (not (= (c (1+ k) a b)
+			       (if (= (c (+ 2 k) a b) 0)
+				   (- (c k a b))
+				 (c k a b)))))))
+  :hints (("Goal" :in-theory (disable c olam0
+                                      EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                      EXPO-COMPARISON-REWRITE-TO-BOUND)
+		  :use (bitn-olam0-4
+			bitn-olamg
+			bitn-olamz
+			c-0-1
+			(:instance c-0-1 (k (+ 1 k)))
+			(:instance c-0-1 (k (+ 2 k)))
+			(:instance bitn-olamt (k (+ 2 k)))
+			(:instance bitn-olamz (k (1+ k)))
+			(:instance bitn-olamg (k (1+ k))))))))
+
+(defthm OLAM0-NAT
+    (implies (and (integerp a)
+		  (> a 0)
+                  )
+	     (and (integerp (olam0 a b e))
+		  (>= (olam0 a b e) 0)))
+;  :rule-classes ()
+  :hints (("Goal" :in-theory (disable logior))))
+
+(defthm OLAMB-NAT
+    (implies (and (integerp a)
+		  (> a 0)
+;		  (integerp b)
+	;	  (> b 0)
+		;  (not (= a b))
+		 ; (= e (expo a))
+		 ; (= e (expo b))
+		 ; (> e 1)
+                  )
+	     (and (integerp (olamb a b e))
+		  (>= (olamb a b e) 0)))
+;  :rule-classes ()
+  :hints (("Goal" :use (;olam0-nat
+			(:instance bitn-0-1 (x (olamt a b e)) (n 0))))))
+
+(local (defthm bitn-olamb-1
+         (implies (and (integerp a)
+                       (> a 0)
+                       (integerp b)
+                       (> b 0)
+                       (not (= a b))
+                       (= e (expo a))
+                       (= e (expo b))
+                       (> e 1))
+                  (= (fl (/ (olamb a b e) 2))
+                     (olam0 a b e)))
+         :hints (("Goal" :in-theory (enable olamb)
+                  :use ( ;olam0-nat
+			(:instance fl-unique (x (/ (olamb a b e) 2)) (n (olam0 a b e)))
+			(:instance bitn-0-1 (x (olamt a b e)) (n 0)))))))
+
+
+(local (defthm bitn-olamb-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp n)
+		  (> n 0))
+	     (= (bitn (olamb a b e) n)
+		(bitn (olam0 a b e) (1- n))))
+  :hints (("Goal" :use (;olamb-nat
+			bitn-olamb-1
+			(:instance bitn-rec-pos (x (olamb a b e)) (n n)))))))
+
+(local (defthm bitn-olamb
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp n)
+		  (<= n (- e 1))
+		  (> n 0))
+	     (iff (= (bitn (olamb a b e) n) 1)
+		  (and (not (= (c n a b) 0))
+		       (not (= (c n a b)
+			       (if (= (c (+ n 1) a b) 0)
+				   (- (c (1- n) a b))
+				 (c (1- n) a b)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND
+                                      EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+		  :use (;bitn-olamb-2
+			(:instance bitn-olam0 (k (1- n))))))))
+
+
+(local (defthm lop3-1
+    (implies (and (integerp a)
+		  (>= a 0)
+		  (integerp b)
+		  (>= b 0)
+		  (integerp n)
+		  (> n 0)
+		  (= (mod a (expt 2 n)) (mod b (expt 2 n)))
+		  (= (bitn a n) (bitn b n)))
+	     (= (mod a (expt 2 (1+ n)))
+		(mod b (expt 2 (1+ n)))))
+  :rule-classes ()
+  :hints (("Goal" :use (mod-n+1
+			(:instance mod-n+1 (a b)))))))
+
+(local (defthm lop3-2
+    (implies (and (integerp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0)
+		  (= (bitn x n) 1))
+	     (= (expo (mod x (expt 2 (1+ n))))
+		n))
+  :rule-classes ()
+  :hints (("Goal" :use (;(:instance mod>=0 (m x) (n (expt 2 (1+ n))))
+			(:instance mod-bnd-1 (m x) (n (expt 2 (1+ n))))
+			(:instance expo-unique (x (mod x (expt 2 (1+ n)))))
+			(:instance bitn-mod (n (1+ n)) (k n))
+			(:instance bit-expo-a (x (mod x (expt 2 (1+ n))))))))))
+
+(local (defthm lop3-3
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (= (c n a b) 0)
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (MOD (OLAMB A B E) (EXPT 2 N)) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 N)))
+			    (lop a b (c (1- n) a b) (1- n)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (e/d ( lop c) (EXPO-COMPARISON-REWRITE-TO-BOUND-2))
+                  :use (lop3-1)))))
+
+(local (defthm lop3-4
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (= (c n a b) 0)
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (bitn (olamb a b e) n) 0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+           :use (bitn-olamb
+			(:instance bitn-0-1 (x (olamb a b e))))))))
+
+(local (defthm lop3-5
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (= (c n a b) 0)
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (mod (olamb a b e) (expt 2 (1+ n)))
+		(mod (olamb a b e) (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-4
+			;olamb-nat
+			(:instance mod-n+1 (a (olamb a b e))))))))
+
+(local (defthm lop3-6
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (= (c n a b) 0)
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (lop a b (c n a b) n)
+		(lop a b (c (1- n) a b) (1- n))))
+    :hints (("Goal" :in-theory (enable lop c)))
+  :rule-classes ()))
+
+(local (defthm lop3-7
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (= (c n a b) 0)
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
+			    (IF (OR (= (C N A B) 0)
+				    (= (C (+ 1 N) A B) 0))
+				(LOP A B (C N A B) N)
+				(LOP A B (- (C N A B)) N)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (disable lop)
+			 :use (lop3-3 lop3-5 lop3-6)))))
+
+(local (defthm lop3-8
+    (implies (and (integerp a)
+		  (>= a 0)
+		  (integerp b)
+		  (>= b 0)
+		  (integerp n)
+		  (>= n 0)
+		  (= (mod a (expt 2 (1+ n))) (mod b (expt 2 (1+ n)))))
+	     (= (bitn a n) (bitn b n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bitn-mod (x a) (n (1+ n)) (k n))
+			(:instance bitn-mod (x b) (n (1+ n)) (k n)))))))
+
+(local (defthm lop3-8-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (integerp n)
+		  (> n 0)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (not (= (mod (olamb a b e) (expt 2 n)) 0)))
+	     (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable olamb)
+		  :use (;olamb-nat
+			(:instance mod-does-nothing (m 0) (n (expt 2 n)))
+			(:instance mod-of-mod-cor (x (olamb a b e)) (a (1+ n)) (b n)))))))
+
+(local (defthm lop3-9
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (= (c (1+ n) a b) 0)
+			 (= (c (1- n) a b) (- (c n a b)))
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 N)))
+			    (lop a b (- (c (1- n) a b)) (1- n)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (e/d ( lop c) (EXPO-COMPARISON-REWRITE-TO-BOUND-2))
+                  :use (lop3-8-1
+			       (:instance lop3-8 (n (1- n))))))))
+
+(local (defthm lop3-10
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (= (c (1+ n) a b) 0)
+		  (= (c (1- n) a b) (- (c n a b)))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (bitn (olamb a b e) n) 0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+           :use (bitn-olamb
+			(:instance bitn-0-1 (x (olamb a b e))))))))
+
+(local (defthm lop3-11
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (= (c (1+ n) a b) 0)
+		  (= (c (1- n) a b) (- (c n a b)))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (mod (olamb a b e) (expt 2 (1+ n)))
+		(mod (olamb a b e) (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-10
+			;olamb-nat
+			(:instance mod-n+1 (a (olamb a b e))))))))
+
+(local (defthm lop3-12
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (= (c (1+ n) a b) 0)
+		  (= (c (1- n) a b) (- (c n a b)))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (lop a b (- (c (1- n) a b)) n)
+		(lop a b (- (c (1- n) a b)) (1- n))))
+    :hints (("Goal" :in-theory (enable lop c)))
+  :rule-classes ()))
+
+(local (defthm lop3-13
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (= (c (1+ n) a b) 0)
+		  (= (c (1- n) a b) (- (c n a b)))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (INTEGERP N)
+		  (<= 0 N))
+	     (EQUAL (LOP A B (* -1 (C (+ -1 N) A B)) (+ -1 N))
+		    (LOP A B (C N A B) N)))
+    :hints (("Goal" :in-theory (enable lop c)))))
+
+(local (defthm lop3-14
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (= (c (1+ n) a b) 0)
+			 (= (c (1- n) a b) (- (c n a b)))
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
+			    (IF (OR (= (C N A B) 0)
+				    (= (C (+ 1 N) A B) 0))
+				(LOP A B (C N A B) N)
+				(LOP A B (- (C N A B)) N)))))
+	 :rule-classes ()
+	 :hints (("Goal" :use (lop3-9 lop3-11 lop3-12)))))
+
+(local (defthm lop3-15
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (= (c (1+ n) a b) 0)
+		  (not (= (c (1- n) a b) (- (c n a b))))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (bitn (olamb a b e) n) 1))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+           :use (bitn-olamb)))))
+
+(local (defthm lop3-16
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (= (c (1+ n) a b) 0)
+		  (not (= (c (1- n) a b) (- (c n a b))))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+		  (= (expo (mod (olamb a b e) (expt 2 (1+ n)))) n)))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-15
+			;olamb-nat
+			(:instance lop3-2 (x (olamb a b e))))))))
+
+(local (defthm lop3-17
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (= (c (1+ n) a b) 0)
+		  (not (= (c (1- n) a b) (- (c n a b))))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (lop a b (c n a b) n) n))
+    :hints (("Goal" :in-theory (enable lop c)))
+  :rule-classes ()))
+
+(local (defthm lop3-18
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (= (c (1+ n) a b) 0)
+			 (not (= (c (1- n) a b) (- (c n a b))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
+			    (IF (OR (= (C N A B) 0)
+				    (= (C (+ 1 N) A B) 0))
+				(LOP A B (C N A B) N)
+				(LOP A B (- (C N A B)) N)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (disable lop c)
+			 :use (lop3-16 lop3-17)))))
+
+(local (defthm lop3-19
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (= (c (1+ n) a b) 0)
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
+			    (IF (OR (= (C N A B) 0)
+				    (= (C (+ 1 N) A B) 0))
+				(LOP A B (C N A B) N)
+				(LOP A B (- (C N A B)) N)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (disable lop c)
+			 :use (lop3-14 lop3-18)))))
+
+(local (defthm lop3-20
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (not (= (c (1+ n) a b) 0))
+			 (= (c (1- n) a b) (c n a b))
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 N)))
+			    (lop a b (- (c (1- n) a b)) (1- n)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (e/d ( lop c) (EXPO-COMPARISON-REWRITE-TO-BOUND-2))
+                  :use (lop3-8-1
+			       (:instance lop3-8 (n (1- n))))))))
+
+(local (in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND-2))) ;yuck
+
+(local (defthm lop3-21
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (not (= (c (1+ n) a b) 0))
+		  (= (c (1- n) a b) (c n a b))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (bitn (olamb a b e) n) 0))
+  :rule-classes ()
+  :hints (("Goal" :use (bitn-olamb
+			(:instance bitn-0-1 (x (olamb a b e))))))))
+
+(local (defthm lop3-22
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (not (= (c (1+ n) a b) 0))
+		  (= (c (1- n) a b) (c n a b))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (mod (olamb a b e) (expt 2 (1+ n)))
+		(mod (olamb a b e) (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-21
+			;olamb-nat
+			(:instance mod-n+1 (a (olamb a b e))))))))
+
+(local (defthm lop3-23
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (not (= (c (1+ n) a b) 0))
+		  (= (c (1- n) a b) (c n a b))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (lop a b (- (c (1- n) a b)) n)
+		(lop a b (- (c (1- n) a b)) (1- n))))
+    :hints (("Goal" :in-theory (enable lop c)))
+  :rule-classes ()))
+
+(local (defthm lop3-24
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (not (= (c (1+ n) a b) 0))
+		  (= (c (1- n) a b) (c n a b))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (INTEGERP N)
+		  (<= 0 N))
+	     (EQUAL (LOP A B (* -1 (C (+ -1 N) A B)) (+ -1 N))
+		    (LOP A B (- (C N A B)) N)))
+    :hints (("Goal" :in-theory (enable lop c)))))
+
+(local (defthm lop3-25
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (not (= (c (1+ n) a b) 0))
+			 (= (c (1- n) a b) (c n a b))
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
+			    (IF (OR (= (C N A B) 0)
+				    (= (C (+ 1 N) A B) 0))
+				(LOP A B (C N A B) N)
+				(LOP A B (- (C N A B)) N)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (disable lop c)
+			 :use (lop3-20 lop3-22 lop3-23)))))
+
+(local (defthm lop3-26
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (not (= (c (1+ n) a b) 0))
+		  (not (= (c (1- n) a b) (c n a b)))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (bitn (olamb a b e) n) 1))
+  :rule-classes ()
+  :hints (("Goal" :use (bitn-olamb)))))
+
+(local (defthm lop3-27
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (not (= (c (1+ n) a b) 0))
+			 (not (= (c (1- n) a b) (c n a b)))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (expo (mod (olamb a b e) (expt 2 (1+ n)))) n)))
+	 :rule-classes ()
+	 :hints (("Goal" :use (lop3-26
+			       ;olamb-nat
+			       (:instance lop3-2 (x (olamb a b e))))))))
+
+(local (defthm lop3-28
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (not (= (c n a b) 0))
+		  (not (= (c (1+ n) a b) 0))
+		  (not (= (c (1- n) a b) (c n a b)))
+		  (INTEGERP A)
+		  (< 0 A)
+		  (INTEGERP B)
+		  (< 0 B)
+		  (= E (EXPO A))
+		  (= E (EXPO B))
+		  (< 0 E)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (< N E)
+		  (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+			  (MOD B (EXPT 2 (+ 1 N))))))
+	     (= (lop a b (- (c n a b)) n) n))
+    :hints (("Goal" :in-theory (enable lop c)))
+    :rule-classes ()))
+
+(local (defthm lop3-29
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (not (= (c (1+ n) a b) 0))
+			 (not (= (c (1- n) a b) (c n a b)))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
+			    (IF (OR (= (C N A B) 0)
+				    (= (C (+ 1 N) A B) 0))
+				(LOP A B (C N A B) N)
+				(LOP A B (- (C N A B)) N)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (disable lop c)
+			 :use (lop3-27 lop3-28)))))
+
+(local (defthm lop3-30
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (not (= (c n a b) 0))
+			 (not (= (c (1+ n) a b) 0))
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
+			    (IF (OR (= (C N A B) 0)
+				    (= (C (+ 1 N) A B) 0))
+				(LOP A B (C N A B) N)
+				(LOP A B (- (C N A B)) N)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (disable lop c)
+			 :use (lop3-25 lop3-29)))))
+
+(local (defthm lop3-31
+	   (IMPLIES (AND (INTEGERP N)
+			 (< 0 N)
+			 (IMPLIES (AND (INTEGERP A)
+				       (< 0 A)
+				       (INTEGERP B)
+				       (< 0 B)
+				       (= E (EXPO A))
+				       (= E (EXPO B))
+				       (< 0 E)
+				       (INTEGERP (+ -1 N))
+				       (<= 0 (+ -1 N))
+				       (< (+ -1 N) E)
+				       (NOT (= (MOD A (EXPT 2 (+ 1 -1 N)))
+					       (MOD B (EXPT 2 (+ 1 -1 N))))))
+				  (and (not (= (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))) 0))
+				       (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 -1 N))))
+					  (IF (OR (= (C (+ -1 N) A B) 0)
+						  (= (C (+ 1 -1 N) A B) 0))
+					      (LOP A B (C (+ -1 N) A B) (+ -1 N))
+					      (LOP A B (- (C (+ -1 N) A B))
+						   (+ -1 N))))))
+			 (INTEGERP A)
+			 (< 0 A)
+			 (INTEGERP B)
+			 (< 0 B)
+			 (= E (EXPO A))
+			 (= E (EXPO B))
+			 (< 0 E)
+			 (INTEGERP N)
+			 (<= 0 N)
+			 (< N E)
+			 (NOT (= (MOD A (EXPT 2 (+ 1 N)))
+				 (MOD B (EXPT 2 (+ 1 N))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (EXPO (MOD (OLAMB A B E) (EXPT 2 (+ 1 N))))
+			    (IF (OR (= (C N A B) 0)
+				    (= (C (+ 1 N) A B) 0))
+				(LOP A B (C N A B) N)
+				(LOP A B (- (C N A B)) N)))))
+	 :rule-classes ()
+	 :hints (("Goal" :use (lop3-30 lop3-19
+                                       lop3-7)))))
+
+(local (defthm lop3-32
+    (implies (and (integerp x)
+		  (> x 0)
+		  (= (expo x) 1))
+	     (or (= x 2) (= x 3)))
+  :rule-classes ()
+  :hints (("Goal" :use (expo-upper-bound expo-lower-bound)))))
+
+
+
+(local (defthm lop3-33
+	   (implies (and (integerp a)
+			 (> a 0)
+			 (integerp b)
+			 (> b 0)
+			 (= e (expo a))
+			 (= e (expo b))
+			 (> e 0)
+			 (not (= (mod a 2) (mod b 2))))
+		    (equal (expo (mod (olamb a b e) 2)) 0))
+	 :hints (("Goal" :use (;olamb-natural
+			       (:instance mod012 (m (olamb a b e))))))))
+
+(local (in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)))
+
+(local (defthm lop3-33-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+	          (not (= (bitn a 0) (bitn b 0))))
+	     (= (bitn a 0) (bitn (lnot b (1+ e)) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expo-upper-bound (x b))
+			(:instance bitn-lnot-not-equal (x b) (n (1+ e)) (k 0))
+			(:instance bitn-0-1 (x a) (n 0))
+			(:instance bitn-0-1 (x b) (n 0))
+			(:instance bitn-0-1 (x (lnot b (1+ e))) (n 0)))))))
+
+(local (defthm lop3-33-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+	          (not (= (mod a 2) (mod b 2))))
+	     (= (bitn a 0) (bitn (lnot b (1+ e)) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-33-1
+			(:instance bitn-def (x a) (n 0))
+			(:instance bitn-def (x b) (n 0)))))))
+
+(local (defthm lop3-33-3
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+	          (not (= (mod a 2) (mod b 2))))
+	     (= (bitn (olamt a b e) 0) 0))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olamt)
+		  :use (lop3-33-2
+			(:instance expo-upper-bound (x b))
+			(:instance bitn-logxor (x a) (y (lnot b (1+ e))) (n 0))
+			(:instance bitn-0-1 (x a) (n 0)))))))
+
+(local (defthm lop3-33-4
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+	          (not (= (mod a 2) (mod b 2))))
+	     (not (= (mod (olamb a b e) 2) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olamb)
+		  :use (lop3-33-3
+;			olam0-nat
+;			(:instance mod+-thm (m 1) (n 2) (a (olam0 a b e)))
+                             )))))
+
+(local (defthm lop3-34
+	   (implies (and (integerp a)
+			 (> a 0)
+			 (integerp b)
+			 (> b 0)
+			 (= e (expo a))
+			 (= e (expo b))
+			 (> e 1)
+			 (integerp n)
+			 (>= n 0)
+			 (< n e)
+			 (not (= (mod a (expt 2 (1+ n)))
+				 (mod b (expt 2 (1+ n))))))
+		    (and (not (= (mod (olamb a b e) (expt 2 (1+ n))) 0))
+			 (= (expo (mod (olamb a b e) (expt 2 (1+ n))))
+			    (if (or (= (c n a b) 0)
+				    (= (c (1+ n) a b) 0))
+				(lop a b (c n a b) n)
+			      (lop a b (- (c n a b)) n)))))
+	 :rule-classes ()
+	 :hints (("Goal" :in-theory (e/d (lop) (olamb))
+			 :induct (natp-induct n))
+		 ("Subgoal *1/2"; :in-theory (disable lop c)
+				 :use (lop3-31))
+		 ("Subgoal *1/1" :use lop3-33-4))))
+
+(defthm OLAM1-BND
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (< (olam1 a b e) (expt 2 (- e 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olam1)
+		  :use (;olamz-nat
+			;olamt-nat
+			;olamg-nat
+;			(:instance lnot-bnds (x (bits (olamz a b e) (- e 2) 0)) (n (1- e)))
+;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
+	;		(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
+			(:instance logand-bnd
+				   (x (bits (olamt a b e) e 2))
+				   (y (logand (bits (olamg a b e) (1- e) 1)
+					      (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))))))
+
+(defthm OLAM3-BND
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (< (olam3 a b e) (expt 2 (- e 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olam3)
+		  :use (;olamg-nat
+			;olamt-nat
+			;olamz-nat
+;			(:instance lnot-bnds (x (bits (olamg a b e) (- e 2) 0)) (n (1- e)))
+;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
+	;		(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
+			(:instance logand-bnd ;and-dist-a
+				   (x (bits (olamt a b e) e 2))
+				   (y (logand (bits (olamz a b e) (1- e) 1)
+					      (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
+))))
+
+(defthm OLAM2-BND
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (< (olam2 a b e) (expt 2 (- e 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olam2)
+		  :use (;olamz-nat
+			;olamt-nat
+;			(:instance lnot-bnds (x (bits (olamt a b e) e 2)) (n (1- e)))
+	;		(:instance lnot-bnds (x (bits (olamz a b e) (- e 2) 0)) (n (1- e)))
+;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
+	;		(:instance bits< (x (olamz a b e)) (i (- e 2)) (j 0))
+			(:instance logand-bnd 
+				   (x (lnot (bits (olamt a b e) e 2) (1- e)))
+				   (y (logand (bits (olamz a b e) (1- e) 1)
+					      (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
+))))
+
+(defthm OLAM4-BND
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (integerp k)
+		  (<= k (- e 2))
+		  (>= k 0))
+	     (< (olam4 a b e) (expt 2 (- e 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olam4)
+		  :use (;olamg-nat
+			;olamt-nat
+;			(:instance lnot-bnds (x (bits (olamt a b e) e 2)) (n (1- e)))
+	;		(:instance lnot-bnds (x (bits (olamg a b e) (- e 2) 0)) (n (1- e)))
+;			(:instance bits< (x (olamt a b e)) (i e) (j 2))
+	;		(:instance bits< (x (olamg a b e)) (i (- e 2)) (j 0))
+			(:instance logand-bnd
+				   (x (lnot (bits (olamt a b e) e 2) (1- e)))
+				   (y (logand (bits (olamg a b e) (1- e) 1)
+					      (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
+))))
+
+(local (in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)))
+
+(local (defthm olam0-bnd-1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (integerp (logior (olam3 a b e) (olam4 a b e)))
+		  (>= (logior (olam3 a b e) (olam4 a b e))
+		      0)
+		  (< (logior (olam3 a b e) (olam4 a b e))
+		     (expt 2 (- e 1)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable)
+		  :use ((:instance olam3-bnd (k 0))
+			(:instance olam4-bnd (k 0))
+;			(:instance olam3-nat)
+	;		(:instance olam4-nat)
+;			(:instance or-dist-a (n (- e 1)) (x (olam3 a b e)) (y (olam4 a b e)))
+)))))
+
+(local (defthm olam0-bnd-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (integerp (logior (olam2 a b e)
+				    (logior (olam3 a b e)
+					    (olam4 a b e))))
+		  (>= (logior (olam2 a b e)
+			      (logior (olam3 a b e)
+				      (olam4 a b e)))
+		      0)
+		  (< (logior (olam2 a b e)
+			     (logior (olam3 a b e)
+				     (olam4 a b e)))
+		     (expt 2 (- e 1)))))
+  :rule-classes ()
+  :hints (("Goal" :use (olam0-bnd-1
+			(:instance olam2-bnd (k 0))
+;			(:instance olam2-nat)
+;			(:instance or-dist-a
+	;			   (n (- e 1))
+		;		   (x (olam2 a b e))
+			;	   (y (logior (olam3 a b e) (olam4 a b e))))
+                        )))))
+
+(defthm OLAM0-BND
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (< (olam0 a b e) (expt 2 (- e 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olam0)
+		  :use (olam0-bnd-2
+			;(:instance olam1-nat)
+			(:instance olam1-bnd (k 0))
+;			(:instance or-dist-a
+	;			   (n (- e 1))
+		;		   (x (olam1 a b e))
+			;	   (y (logior (olam2 a b e)
+				;	      (logior (olam3 a b e)
+					;	      (olam4 a b e)))))
+                        ))))
+
+(defthm OLAMB-BND
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (< (olamb a b e) (expt 2 e)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable olamb expt ;yuck!
+                                     )
+           :use (olam0-bnd
+			;olam0-nat
+			(:instance bitn-0-1 (x (olamt a b e)) (n 0))))))
+
+(local (defthm olamb-mod
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (= (mod (olamb a b e) (expt 2 e))
+		(olamb a b e)))
+  :rule-classes ()
+  :hints (("Goal" :use (olamb-bnd
+			;olamb-nat
+			(:instance mod-does-nothing (m (olamb a b e)) (n (expt 2 e))))))))
+
+(local (defthm lop3-35
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (= (c e a b) 0)
+		  (not (= (mod a (expt 2 e))
+			  (mod b (expt 2 e)))))
+	     (and (not (= (mod (olamb a b e) (expt 2 e)) 0))
+		  (= (expo (mod (olamb a b e) (expt 2 e)))
+		     (lop a b (c (- e 1) a b) (- e 1)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance lop3-34 (n (- e 1))))))))
+
+(local (defthm lop3-36
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (= (c e a b) 0)
+		  (not (= (mod a (expt 2 e))
+			  (mod b (expt 2 e)))))
+	     (and (not (= (olamb a b e) 0))
+		  (= (expo (olamb a b e))
+		     (lop a b (c (- e 1) a b) (- e 1)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-35 olamb-mod)))))
+
+(local (defthm lop3-37
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1)
+		  (not (= (mod a (expt 2 e))
+			  (mod b (expt 2 e)))))
+	     (and (not (= (olamb a b e) 0))
+		  (= (expo (olamb a b e))
+		     (lop a b (c (- e 1) a b) (- e 1)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop c)
+           :use (lop3-36
+			(:instance expo-upper-bound (x a))
+			(:instance expo-upper-bound (x b))
+			(:instance expo-lower-bound (x a))
+			(:instance expo-lower-bound (x b))
+			(:instance bit-expo-b (x a) (n e))
+			(:instance bit-expo-b (x b) (n e)))))))
+
+(local (defthm lop3-38
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (olamb a b e) 0))
+		  (= (expo (olamb a b e))
+		     (lop a b (c (- e 1) a b) (- e 1)))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-37
+			(:instance expo-upper-bound (x a))
+			(:instance expo-upper-bound (x b))
+			(:instance expo-lower-bound (x a))
+			(:instance expo-lower-bound (x b))
+			(:instance bit-expo-b (x a) (n e))
+			(:instance bit-expo-b (x b) (n e))
+			(:instance mod-does-nothing (m a) (n (expt 2 (1+ e))))
+			(:instance mod-does-nothing (m b) (n (expt 2 (1+ e))))
+			(:instance lop3-1 (n e)))))))
+
+(local (defthm lop3-39
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (= (lop a b 0 (1+ e))
+		(lop a b (c (- e 1) a b) (- e 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lop c)
+           :use ((:instance expo-upper-bound (x a))
+			(:instance expo-upper-bound (x b))
+			(:instance expo-lower-bound (x a))
+			(:instance expo-lower-bound (x b))
+			(:instance bit-expo-b (x a) (n e))
+			(:instance bit-expo-b (x b) (n e)))))))
+
+(local (defthm lop3-40
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (= (expo (olamb a b e))
+		(lop a b 0 (1+ e))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-38 lop3-39)))))
+
+(defthm olop-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (olamb a b e) 0))
+		  (or (= (expo (- a b)) (expo (olamb a b e)))
+		      (= (expo (- a b)) (1- (expo (olamb a b e)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (lop3-40
+			lop3-38
+			(:instance lop-bnds (n (1+ e)))
+			(:instance expo-upper-bound (x a))
+			(:instance expo-upper-bound (x b))))))
+
+
+
+
+
+
+
+(include-book "land0")
+(include-book "lior0")
+(include-book "lxor0")
+
+(defun lamt-0 (a b e)
+  (lxor0 a (lnot b (1+ e)) (1+ e)))
+
+(defun lamg-0 (a b e)
+  (land0 a (lnot b (1+ e)) (1+ e)))
+
+(defun lamz-0 (a b e)
+  (lnot (lior0 a (lnot b (1+ e)) (1+ e)) (1+ e)))
+
+(defun lam1-0 (a b e)
+  (land0 (bits (lamt-0 a b e) e 2) 
+	(land0 (bits (lamg-0 a b e) (1- e) 1)
+	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam2-0 (a b e)
+  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
+	(land0 (bits (lamz-0 a b e) (1- e) 1)
+	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam3-0 (a b e)
+  (land0 (bits (lamt-0 a b e) e 2) 
+	(land0 (bits (lamz-0 a b e) (1- e) 1)
+	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam4-0 (a b e)
+  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
+	(land0 (bits (lamg-0 a b e) (1- e) 1)
+	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam0-0 (a b e)
+  (lior0 (lam1-0 a b e)
+	(lior0 (lam2-0 a b e)
+	      (lior0 (lam3-0 a b e)
+		    (lam4-0 a b e)
+		    (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lamb-0 (a b e)
+  (+ (* 2 (lam0-0 a b e))
+     (lnot (bitn (lamt-0 a b e) 0) 1)))
+
+(in-theory (enable bits-tail bvecp-expo))
+
+(local
+(defthm bvecp-lamt-0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (bvecp (lamt-0 a b e) (+ 1 e))))
+)
+
+(local
+(defthm lamt-0-olamt
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lamt-0 a b e) (olamt a b e)))
+  :hints (("Goal" :in-theory (enable olamt land0 lior0 lxor0))))
+)
+
+(local
+(defthm bvecp-lamg-0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (bvecp (lamg-0 a b e) (+ 1 e))))
+)
+
+(local
+(defthm lamg-0-olamg
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lamg-0 a b e) (olamg a b e)))
+  :hints (("Goal" :in-theory (enable olamg land0 lior0 lxor0))))
+)
+
+(local
+(defthm bvecp-lamz-0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (bvecp (lamz-0 a b e) (+ 1 e))))
+)
+
+(local
+(defthm lamz-0-olamz
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lamz-0 a b e) (olamz a b e)))
+  :hints (("Goal" :in-theory (enable olamz land0 lior0 lxor0))))
+)
+
+(local
+(defthm bvecp-lam1-0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (bvecp (lam1-0 a b e) (+ -1 e))))
+)
+
+(local
+(defthm lam1-0-olam1
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lam1-0 a b e) (olam1 a b e)))
+  :hints (("Goal" :in-theory (enable olam1 land0 lior0 lxor0)
+		  :use (bvecp-lamt-0 bvecp-lamz-0 bvecp-lamg-0))))
+)
+
+(local
+(defthm bvecp-lam2-0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (bvecp (lam2-0 a b e) (+ -1 e))))
+)
+
+(local
+(defthm lam2-0-olam2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lam2-0 a b e) (olam2 a b e)))
+  :hints (("Goal" :in-theory (enable olam2 land0 lior0 lxor0))))
+)
+
+(local
+(defthm bvecp-lam3-0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (bvecp (lam3-0 a b e) (+ -1 e))))
+)
+
+(local
+(defthm lam3-0-olam3
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lam3-0 a b e) (olam3 a b e)))
+  :hints (("Goal" :in-theory (enable olam3 land0 lior0 lxor0))))
+)
+
+(local
+(defthm bvecp-lam4-0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (bvecp (lam4-0 a b e) (+ -1 e))))
+)
+
+(local
+(defthm lam4-0-olam4
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lam4-0 a b e) (olam4 a b e)))
+  :hints (("Goal" :in-theory (enable olam4 land0 lior0 lxor0))))
+)
+
+(local
+(defthm bvecp-lam0-0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (bvecp (lam0-0 a b e) (+ -1 e))))
+)
+
+(local
+(defthm lam0-0-olam0
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lam0-0 a b e) (olam0 a b e)))
+  :hints (("Goal" :in-theory (enable olam0 land0 lior0 lxor0)
+		  :use (bvecp-lam1-0 bvecp-lam2-0 bvecp-lam3-0 bvecp-lam4-0))))
+)
+
+(local
+(defthm lamb-0-olamb
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (equal (lamb-0 a b e) (olamb a b e)))
+  :hints (("Goal" :in-theory (enable olamb))))
+)
+
+(defthm lop-thm-2-original
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb-0 a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb-0 a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb-0 a b e)))))))
+  :rule-classes ()
+  :hints (("Goal" :use olop-thm-2)))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lop3.lisp acl2-6.3/books/rtl/rel9/support/support/lop3.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lop3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lop3.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,300 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "lop2") ;BOZO yuck!
+(local (include-book "lop3-proofs"))
+
+(defund OLAMT (a b e)
+  (logxor a (lnot b (1+ e))))
+
+(defund OLAMG (a b e)
+  (logand a (lnot b (1+ e))))
+
+(defund OLAMZ (a b e)
+  (lnot (logior a (lnot b (1+ e))) (1+ e)))
+
+(defund OLAM1 (a b e)
+  (logand (bits (olamt a b e) e 2) 
+	  (logand (bits (olamg a b e) (1- e) 1)
+		  (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
+
+(defund OLAM2 (a b e)
+  (logand (lnot (bits (olamt a b e) e 2) (1- e))
+	  (logand (bits (olamz a b e) (1- e) 1)
+		  (lnot (bits (olamz a b e) (- e 2) 0) (1- e)))))
+
+(defund OLAM3 (a b e)
+  (logand (bits (olamt a b e) e 2) 
+	  (logand (bits (olamz a b e) (1- e) 1)
+		  (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
+
+(defund OLAM4 (a b e)
+  (logand (lnot (bits (olamt a b e) e 2) (1- e))
+	  (logand (bits (olamg a b e) (1- e) 1)
+		  (lnot (bits (olamg a b e) (- e 2) 0) (1- e)))))
+
+(defund OLAM0 (a b e)
+  (logior (olam1 a b e)
+	  (logior (olam2 a b e)
+		  (logior (olam3 a b e)
+			  (olam4 a b e)))))
+
+(defund OLAMB (a b e)
+  (+ (* 2 (olam0 a b e))
+     (lnot (bitn (olamt a b e) 0) 1)))
+
+(defthm OLAMT-NAT
+  (implies (and (integerp a)
+                (>= a 0)
+                )
+           (and (integerp (olamt a b e))
+                (>= (olamt a b e) 0))))
+
+(defthm OLAMG-NAT
+  (implies (and (integerp a)
+                (> a 0)
+                )
+           (and (integerp (olamg a b e))
+                (>= (olamg a b e) 0))))
+
+(defthm OLAMZ-NAT
+  (implies (and (integerp a)
+                (> a 0)
+                )
+           (and (integerp (olamz a b e))
+                (>= (olamz a b e) 0))))
+
+(defthm OLAM1-NAT
+  (implies (and (integerp a)
+                (> a 0)
+                )
+           (and (integerp (olam1 a b e))
+                (>= (olam1 a b e) 0))))
+
+(defthm OLAM3-NAT
+  (implies (and (integerp a)
+                (> a 0)
+                )
+           (and (integerp (olam3 a b e))
+                (>= (olam3 a b e) 0)))
+  :rule-classes ())
+
+(defthm OLAM2-NAT
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                )
+           (and (integerp (olam2 a b e))
+                (>= (olam2 a b e) 0))))
+
+(defthm OLAM4-NAT
+  (implies (and (integerp a)
+                (> a 0)
+                )
+           (and (integerp (olam4 a b e))
+                (>= (olam4 a b e) 0))))
+
+(defthm OLAM0-NAT
+  (implies (and (integerp a)
+                (> a 0)
+                )
+           (and (integerp (olam0 a b e))
+                (>= (olam0 a b e) 0))))
+
+(defthm OLAMB-NAT
+  (implies (and (integerp a)
+                (> a 0)
+                )
+           (and (integerp (olamb a b e))
+                (>= (olamb a b e) 0))))
+
+(defthm OLAM1-BND
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1)
+                (integerp k)
+                (<= k (- e 2))
+                (>= k 0))
+           (< (olam1 a b e) (expt 2 (- e 1))))
+  :rule-classes ())
+
+(defthm OLAM3-BND
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1)
+                (integerp k)
+                (<= k (- e 2))
+                (>= k 0))
+           (< (olam3 a b e) (expt 2 (- e 1))))
+  :rule-classes ())
+
+(defthm OLAM2-BND
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1)
+                (integerp k)
+                (<= k (- e 2))
+                (>= k 0))
+           (< (olam2 a b e) (expt 2 (- e 1))))
+  :rule-classes ())
+
+(defthm OLAM4-BND
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1)
+                (integerp k)
+                (<= k (- e 2))
+                (>= k 0))
+           (< (olam4 a b e) (expt 2 (- e 1))))
+  :rule-classes ())
+
+(defthm OLAM0-BND
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1))
+           (< (olam0 a b e) (expt 2 (- e 1))))
+  :rule-classes ())
+
+(defthm OLAMB-BND
+  (implies (and (integerp a)
+                (> a 0)
+                (integerp b)
+                (> b 0)
+                (not (= a b))
+                (= e (expo a))
+                (= e (expo b))
+                (> e 1))
+           (< (olamb a b e) (expt 2 e)))
+  :rule-classes ())
+
+(defthm olop-thm-2
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (olamb a b e) 0))
+		  (or (= (expo (- a b)) (expo (olamb a b e)))
+		      (= (expo (- a b)) (1- (expo (olamb a b e)))))))
+  :rule-classes ())
+
+(include-book "land0")
+(include-book "lior0")
+(include-book "lxor0")
+
+(defun lamt-0 (a b e)
+  (lxor0 a (lnot b (1+ e)) (1+ e)))
+
+(defun lamg-0 (a b e)
+  (land0 a (lnot b (1+ e)) (1+ e)))
+
+(defun lamz-0 (a b e)
+  (lnot (lior0 a (lnot b (1+ e)) (1+ e)) (1+ e)))
+
+(defun lam1-0 (a b e)
+  (land0 (bits (lamt-0 a b e) e 2) 
+	(land0 (bits (lamg-0 a b e) (1- e) 1)
+	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam2-0 (a b e)
+  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
+	(land0 (bits (lamz-0 a b e) (1- e) 1)
+	      (lnot (bits (lamz-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam3-0 (a b e)
+  (land0 (bits (lamt-0 a b e) e 2) 
+	(land0 (bits (lamz-0 a b e) (1- e) 1)
+	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam4-0 (a b e)
+  (land0 (lnot (bits (lamt-0 a b e) e 2) (1- e))
+	(land0 (bits (lamg-0 a b e) (1- e) 1)
+	      (lnot (bits (lamg-0 a b e) (- e 2) 0) (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lam0-0 (a b e)
+  (lior0 (lam1-0 a b e)
+	(lior0 (lam2-0 a b e)
+	      (lior0 (lam3-0 a b e)
+		    (lam4-0 a b e)
+		    (1- e))
+	      (1- e))
+	(1- e)))
+
+(defun lamb-0 (a b e)
+  (+ (* 2 (lam0-0 a b e))
+     (lnot (bitn (lamt-0 a b e) 0) 1)))
+
+(in-theory (enable bits-tail bvecp-expo)) ;BOZO yuck!
+
+(defthm lop-thm-2-original
+    (implies (and (integerp a)
+		  (> a 0)
+		  (integerp b)
+		  (> b 0)
+		  (not (= a b))
+		  (= e (expo a))
+		  (= e (expo b))
+		  (> e 1))
+	     (and (not (= (lamb-0 a b e) 0))
+		  (or (= (expo (- a b)) (expo (lamb-0 a b e)))
+		      (= (expo (- a b)) (1- (expo (lamb-0 a b e)))))))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lxor.lisp acl2-6.3/books/rtl/rel9/support/support/lxor.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lxor.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lxor.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,535 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Port lxor0 theorems to lxor.  The original definition of lxor (in rel4) was
+; that of lxor0 in the current release.  So the port is to keep all the lemmas
+; about lxor0 and then use equality of lxor0 with lxor to port them to lxor.
+
+(in-package "ACL2")
+
+(include-book "lxor0")
+(local (include-book "top1")) ; for lxor0-bits-1 and lxor0-bits-2
+
+(defun binary-lxor (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :measure (nfix n)
+                  :verify-guards nil))
+  (mbe :logic
+       (cond ((zp n)
+              0)
+             ((equal n 1)
+              (if (iff (equal (bitn x 0) 1)
+                       (equal (bitn y 0) 1))
+                  0
+                1))
+             (t (+ (* 2 (binary-lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                   (binary-lxor (mod x 2) (mod y 2) 1))))
+       :exec ; (lxor0 x y n)
+       (logxor (bits x (1- n) 0)
+               (bits y (1- n) 0))))
+
+(defmacro lxor (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lxor x y n) -- the base case
+         `(binary-lxor ,@x))
+        (t         
+         `(binary-lxor ,(car x)
+                       (lxor ,@(cdr x))
+                       ,(car (last x))))))
+
+; We attempt to derive all lxor results from corresponding lxor0 results.
+
+(encapsulate
+ ()
+
+ (local
+  (defun p0 (x y n)
+    (equal (lxor x y n)
+           (lxor0 x y n))))
+
+ (local
+  (defthm p0-holds-inductive-step
+    (implies (and (not (zp n))
+                  (not (equal n 1))
+                  (p0 (fl (* x 1/2))
+                      (fl (* y 1/2))
+                      (+ -1 n))
+                  (p0 (mod x 2) (mod y 2) 1))
+             (p0 x y n))
+    :hints (("Goal" :use (lxor0-def binary-lxor)))))
+
+ (local
+  (defthm p0-holds-base-1
+    (p0 x y 1)
+    :hints (("Goal" :in-theory (enable bitn)
+             :expand ((binary-lxor0 x y 1))))))
+
+ (local
+  (defthm p0-holds-base-0
+    (implies (zp n)
+             (p0 x y n))
+    :hints (("Goal" :expand ((binary-lxor0 x y n))))))
+
+ (local
+  (defthm p0-holds
+    (p0 x y n)
+    :hints (("Goal" :induct (lxor x y n)
+             :in-theory (disable p0)))
+    :rule-classes nil))
+
+ (defthmd lxor-is-lxor0
+   (equal (lxor x y n)
+          (lxor0 x y n))
+   :hints (("Goal" :use p0-holds))))
+
+(local (in-theory (e/d (lxor-is-lxor0) (binary-lxor))))
+
+;Allows things like (in-theory (disable lxor)) to refer to binary-lxor.
+(add-macro-alias lxor binary-lxor)
+
+(defthm lxor-nonnegative-integer-type
+  (and (integerp (lxor x y n))
+       (<= 0 (lxor x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor) is no better than lxor-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor-natp
+  (natp (lxor x y n)))
+
+(defthm lxor-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (lxor x y n)
+                  0)))
+
+(defthmd lxor-bvecp-simple
+  (bvecp (lxor x y n) n))
+
+(defthm lxor-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor x y n) k)))
+
+
+;;
+;; Rules to normalize lxor terms (recall that LXOR is a macro for BINARY-LXOR):
+;;
+
+;; allow sizes to differ on these?
+
+(defthm lxor-associative
+  (equal (lxor (lxor x y n) z n)
+         (lxor x (lxor y z n) n)))
+
+(defthm lxor-commutative
+  (equal (lxor y x n)
+         (lxor x y n)))
+
+(defthm lxor-commutative-2
+  (equal (lxor y (lxor x z n) n)
+         (lxor x (lxor y z n) n)))
+
+(defthm lxor-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (lxor x (lxor y z n) n)
+                  (lxor (lxor x y n) z n))))
+
+(defthm lxor-0
+  (implies (case-split (bvecp y n))
+           (equal (lxor 0 y n)
+                  y)))
+
+;nicer than the analogous rule for logand?
+(defthm lxor-1
+  (implies (case-split (bvecp y 1))
+           (equal (lxor 1 y 1)
+                  (lnot y 1))))
+
+(defthm lxor-self
+  (implies (case-split (bvecp x n))
+           (equal (lxor x x n)
+                  0)))
+
+
+(defthmd bits-lxor-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lxor x y n) i j)
+                  (lxor (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j))))))
+
+(defthmd bits-lxor-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lxor x y n) i j)
+                  (lxor (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j))))))
+
+;notice the call to MIN in the conclusion
+(defthm bits-lxor
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (lxor x y n) i j)
+                  (lxor (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j))))))
+
+(defthmd bitn-lxor-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor x y n) m)
+                  (lxor (bitn x m) 
+                        (bitn y m) 
+                        1))))
+(defthmd bitn-lxor-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor x y n) m)
+                  0)))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-lxor
+  (implies (and (case-split (<= 0 k))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor x y n) k)
+                  (if (< k n)
+                      (lxor (bitn x k) 
+                            (bitn y k) 
+                            1)
+                    0))))
+
+
+(defthm lxor-ones
+  (implies (case-split (bvecp x n))
+           (equal (lxor (1- (expt 2 n)) x n)
+                  (lnot x n)))
+  :rule-classes ()
+  :hints (("Goal" :use lxor0-ones)))
+
+;lxor-with-all-ones will rewrite (lxor x n) [note there's only one value being ANDed], because (lxor x n)
+;expands to (BINARY-LXOR X (ALL-ONES N) N) - now moot???
+(defthm lxor-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (lxor (all-ones n) x n)
+                  (lnot x n))))
+
+(defthm lxor-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep n)
+                              (equal (cadr k) (1- (expt 2 (cadr n))))))
+                (force (equal k (1- (expt 2 n))))
+                (case-split (bvecp x n)))
+           (equal (lxor k x n)
+                  (lnot x n)))
+  :hints (("Goal" :use lxor0-ones-rewrite)))
+
+(defthm lxor-def-original
+  (implies (and (< 0 n)
+                (integerp n))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (mod x 2) (mod y 2) 1))))
+  :rule-classes ()
+  :hints (("Goal" :use lxor0-def)))
+
+(defthm lxor-mod-2
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (> n 0))
+           (equal (mod (lxor x y n) 2)
+                  (lxor (mod x 2) (mod y 2) 1)))
+  :hints (("Goal" :use lxor0-mod-2)))
+
+(defthm lxor-fl-2
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (> n 0))
+           (equal (fl (/ (lxor x y n) 2))
+                  (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+  :hints (("Goal" :use lxor0-fl-2)))
+
+(in-theory (disable lxor-mod-2 lxor-fl-2))
+
+(defthm bitn-lxor-0
+  (implies (and (integerp x)
+                (integerp y)
+                (not (zp n))
+                )
+           (= (bitn (lxor x y n) 0)
+              (bitn (+ x y) 0)))		
+  :rule-classes ()
+  :hints (("Goal" :use bitn-lxor0-0)))
+
+;BOZO rename
+(defthm lxor-x-y-0
+  (equal (lxor x y 0) 0))
+
+
+;N is a free variable
+(defthm lxor-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (case-split (integerp m))
+		  )
+	     (equal (lxor x y m) 
+                    (lxor x y n))))
+
+(defthm lxor-upper-bound
+  (implies (and (integerp n)
+                (<= 0 n))
+           (< (lxor x y n) (expt 2 n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm lxor-upper-bound-tight
+  (implies (and (integerp n)
+                (<= 0 n))
+           (<= (lxor x y n) (1- (expt 2 n)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Added in move to rel5 (should perhaps be in a -proofs file):
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defthm lxor-bvecp-2
+  (implies (and (bvecp x m)
+                (bvecp y m))
+           (bvecp (lxor x y n) m))
+  :hints (("Goal" :use ((:instance lxor-reduce
+                                   (n m)
+                                   (m n))))))
+
+; Start proof of fl-lxor (copied from proof of fl-land with very small changes).
+
+(local
+ (defun fl-lxor-induction (k n)
+   (if (zp k)
+       n
+     (fl-lxor-induction (1- k) (1+ n)))))
+
+
+(local
+ (defthmd fl-lxor-induction-step-1
+   (implies (not (zp k))
+            (equal (lxor (fl (* x (/ (expt 2 k))))
+                         (fl (* y (/ (expt 2 k))))
+                         n)
+                   (lxor (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
+                         (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
+                         n)))
+   :hints (("Goal" :in-theory (disable lxor-is-lxor0
+                                       fl/int-rewrite)
+            :expand ((expt 2 k))
+            :use ((:instance fl/int-rewrite
+                             (x (* x (/ (expt 2 (1- k)))))
+                             (n 2))
+                  (:instance fl/int-rewrite
+                             (x (* y (/ (expt 2 (1- k)))))
+                             (n 2)))))))
+
+(local
+ (defthmd fl-lxor-induction-step-2
+   (equal (lxor (fl (/ (fl (* x (/ (expt 2 (1- k))))) 2))
+                (fl (/ (fl (* y (/ (expt 2 (1- k))))) 2))
+                n)
+          (fl (/ (lxor (fl (* x (/ (expt 2 (1- k)))))
+                       (fl (* y (/ (expt 2 (1- k)))))
+                       (1+ n))
+                 2)))
+   :hints (("Goal" :in-theory (disable lxor-is-lxor0
+                                       fl/int-rewrite)
+            :expand ((lxor (fl (* x (/ (expt 2 (1- k)))))
+                           (fl (* y (/ (expt 2 (1- k)))))
+                           (1+ n)))))))
+
+(local
+ (defthmd fl-lxor-induction-step-3
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (lxor x y (+ k n))))
+                        (lxor (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (/ (lxor (fl (* x (/ (expt 2 (1- k)))))
+                                (fl (* y (/ (expt 2 (1- k)))))
+                                (1+ n))
+                          2))
+                   (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
+                                 (lxor x y (+ k n))))
+                          2))))))
+
+(local
+ (defthmd fl-lxor-induction-step-4
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (lxor x y (+ k n))))
+                        (lxor (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (/ (fl (* (/ (expt 2 (+ -1 k)))
+                                 (lxor x y (+ k n))))
+                          2))
+                   (fl (* (/ (expt 2 k))
+                          (lxor x y (+ k n))))))
+   :hints (("Goal" :expand ((expt 2 k))))))
+
+(local
+ (defthm fl-lxor-induction-step
+   (implies (and (not (zp k))
+                 (equal (fl (* (/ (expt 2 (+ -1 k)))
+                               (lxor x y (+ k n))))
+                        (lxor (fl (* x (/ (expt 2 (+ -1 k)))))
+                              (fl (* y (/ (expt 2 (+ -1 k)))))
+                              (+ 1 n)))
+                 (natp x)
+                 (natp y)
+                 (natp n))
+            (equal (fl (* (/ (expt 2 k))
+                          (lxor x y (+ k n))))
+                   (lxor (fl (* x (/ (expt 2 k))))
+                         (fl (* y (/ (expt 2 k))))
+                         n)))
+   :hints (("Goal" :use (fl-lxor-induction-step-1
+                         fl-lxor-induction-step-2
+                         fl-lxor-induction-step-3
+                         fl-lxor-induction-step-4)))))
+
+(defthmd fl-lxor
+  (implies (and (natp x)
+                (natp y)
+                (natp n)
+                (natp k))
+           (equal (fl (/ (lxor x y (+ n k)) (expt 2 k)))
+                  (lxor (fl (/ x (expt 2 k))) (fl (/ y (expt 2 k))) n)))
+  :hints (("Goal" :induct (fl-lxor-induction k n)
+           :in-theory (disable lxor-is-lxor0))))
+
+(defthm lxor-fl-1
+  (equal (lxor (fl x) y n)
+         (lxor x y n))
+  :hints (("Goal" :in-theory (enable lxor lxor0))))
+
+(defthm lxor-fl-2-eric
+  (equal (lxor x (fl y) n)
+         (lxor x y n))
+  :hints (("Goal" :in-theory (enable lxor lxor0))))
+
+(defthmd lxor-def
+  (implies (and (integerp x)
+                (integerp y)
+                (integerp n)
+                (> n 0))
+           (equal (lxor x y n)
+                  (+ (* 2 (lxor (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                     (lxor (bitn x 0) (bitn y 0) 1))))
+  :hints (("Goal" :in-theory (enable bitn-rec-0)
+           :use lxor-def-original)))
+
+(local
+ (defun lxor-shift-induction (n k)
+   (if (zp k)
+       (+ k n)
+     (lxor-shift-induction (1- n) (1- k)))))
+
+(defthm lxor-shift
+  (implies (and (integerp x)
+                (integerp y)
+                (natp k))
+           (= (lxor (* (expt 2 k) x)
+                    (* (expt 2 k) y)
+                    n)
+              (* (expt 2 k) (lxor x y (- n k)))))
+  :hints (("Goal" :induct (lxor-shift-induction n k)
+           :expand ((expt 2 k)
+                    (lxor (* 2 x (expt 2 (+ -1 k)))
+                          (* 2 y (expt 2 (+ -1 k)))
+                          n))
+           :in-theory (e/d (bitn-negative-bit-of-integer)
+                           (lxor-is-lxor0))))
+  :rule-classes ())
+
+; See land.lisp for analogous lemma and a hand proof of it.
+(defthmd mod-lxor
+  (implies (and (integerp n)
+                (integerp k)
+                (<= k n))
+           (equal (mod (lxor x y n) (expt 2 k))
+                  (lxor x y k)))
+  :hints (("Goal"
+           :use
+           ((:instance bits-lxor (x x) (y y) (n k) (i (1- k)) (j 0))
+            (:instance mod-bits (x (lxor x y n)) (i (1- n)) (j k))))))
+
+(defthmd lxor-bits-1
+  (equal (lxor (bits x (1- n) 0)
+               y
+               n)
+         (lxor x y n))
+  :hints (("Goal" :use lxor0-bits-1)))
+
+(defthmd lxor-bits-2
+  (equal (lxor x
+               (bits y (1- n) 0)
+               n)
+         (lxor x y n))
+  :hints (("Goal" :use lxor0-bits-2)))
+
+(defthm lxor-base
+  (equal (lxor x y 1)
+         (if (iff (equal (bitn x 0) 1)
+                  (equal (bitn y 0) 1))
+             0
+           1))
+  :hints (("Goal" :use lxor0-base))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lxor0-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/lxor0-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lxor0-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lxor0-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,551 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+This book is about LXOR0, a nice version of LOGXOR.  LXOR0 takes an extra size parameter, N, and always returns
+a bit vector of length N.
+
+todo: ;add analogs of the thms in land0.lisp past bitn-land0
+
+|#
+
+;add macro alias
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(local (include-book "all-ones"))
+(local (include-book "merge"))
+(local (include-book "bvecp"))
+(local (include-book "logand"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "../../arithmetic/top"))
+
+
+(defund binary-lxor0 (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logxor (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defmacro lxor0 (&rest x)
+  (declare (xargs :guard (consp x)))
+  (cond ((endp (cdddr x)) ;(lxor0 x y n) -- the base case
+         `(binary-lxor0 ,@x))
+        (t         
+         `(binary-lxor0 ,(car x)
+                       (lxor0 ,@(cdr x))
+                       ,(car (last x))))))
+
+
+;Allows things like (in-theory (disable lxor0)) to refer to binary-lxor0.
+(add-macro-alias lxor0 binary-lxor0)
+
+
+(defthm lxor0-nonnegative-integer-type
+  (and (integerp (lxor0 x y n))
+       (<= 0 (lxor0 x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor0) is no better than lxor0-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor0)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor0-natp
+  (natp (lxor0 x y n)))
+
+(defthm lxor0-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (lxor0 x y n)
+                  0))
+  :hints (("Goal" :cases ((acl2-numberp n))
+           :in-theory (enable lxor0)))
+  )
+
+(defthmd lxor0-bvecp-simple
+  (bvecp (lxor0 x y n) n)
+  :hints (("Goal" :cases ((natp n))
+           :in-theory (enable lxor0))))
+
+(defthm lxor0-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor0 x y n) k))
+  :hints (("Goal" :in-theory (disable lxor0-bvecp-simple)
+           :use lxor0-bvecp-simple)))
+
+
+;;
+;; Rules to normalize lxor0 terms (recall that LXOR0 is a macro for BINARY-LXOR0):
+;;
+
+;; allow sizes to differ on these?
+
+(defthm lxor0-associative
+  (equal (lxor0 (lxor0 x y n) z n)
+         (lxor0 x (lxor0 y z n) n))
+  :hints (("Goal" :cases ((natp n))
+           :in-theory (enable lxor0 bits-tail))))
+
+(defthm lxor0-commutative
+  (equal (lxor0 y x n)
+         (lxor0 x y n))
+  :hints (("Goal" :in-theory (enable lxor0))))
+
+(defthm lxor0-commutative-2
+  (equal (lxor0 y (lxor0 x z n) n)
+         (lxor0 x (lxor0 y z n) n))
+  :hints (("Goal"  :cases ((natp n))
+           :in-theory (enable lxor0 bits-tail))))
+
+(defthm lxor0-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (lxor0 x (lxor0 y z n) n)
+                  (lxor0 (lxor0 x y n) z n))))
+
+(defthm lxor0-0
+  (implies (case-split (bvecp y n))
+           (equal (lxor0 0 y n)
+                  y))
+  :hints (("Goal" :in-theory (enable lxor0 bits-tail))))
+
+;nicer than the analogous rule for logand?
+(defthm lxor0-1
+  (implies (case-split (bvecp y 1))
+           (equal (lxor0 1 y 1)
+                  (lnot y 1)))
+  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+(defthm lxor0-self
+  (implies (case-split (bvecp x n))
+           (equal (lxor0 x x n)
+                  0))
+  :hints (("Goal" :in-theory (enable lxor0 bits-tail))))
+
+
+(defthmd bits-lxor0-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lxor0 x y n) i j)
+                  (lxor0 (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable lxor0 bits-logand))))
+
+
+(defthmd bits-lxor0-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lxor0 x y n) i j)
+                  (lxor0 (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable lxor0 bits-logand))))
+
+;notice the call to MIN in the conclusion
+(defthm bits-lxor0
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (lxor0 x y n) i j)
+                  (lxor0 (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j)))))
+  :hints (("Goal" :in-theory (enable bits-lxor0-1 bits-lxor0-2))))
+
+(defthmd bitn-lxor0-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor0 x y n) m)
+                  (lxor0 (bitn x m) 
+                        (bitn y m) 
+                        1)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn)
+                              '(BITS-N-N-REWRITE)))))
+(defthmd bitn-lxor0-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor0 x y n) m)
+                  0))
+  :hints (("Goal" :in-theory (enable BVECP-BITN-0))))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-lxor0
+  (implies (and (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor0 x y n) m)
+                  (if (< m n)
+                      (lxor0 (bitn x m) 
+                            (bitn y m) 
+                            1)
+                    0)))
+  :hints (("Goal" :in-theory (enable bitn-lxor0-1 bitn-lxor0-2))))
+
+
+(defthm lxor0-ones
+  (implies (case-split (bvecp x n))
+           (equal (lxor0 (1- (expt 2 n)) x n)
+                  (lnot x n)))
+  :rule-classes ()
+  :hints
+  (("subgoal 1" :use logxor-ones)
+   ("goal" :cases ((natp n))
+    :in-theory (enable lxor0 bits-tail)
+    )))
+
+;lxor0-with-all-ones will rewrite (lxor0 x n) [note there's only one value being ANDed], because (lxor0 x n)
+;expands to (BINARY-LXOR0 X (ALL-ONES N) N) - now moot???
+(defthm lxor0-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (lxor0 (all-ones n) x n)
+                  (lnot x n)))
+  :hints
+  (("goal" :use lxor0-ones
+    :in-theory (enable all-ones))))
+
+(defthm lxor0-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep n)
+                              (equal (cadr k) (1- (expt 2 (cadr n))))))
+                (force (equal k (1- (expt 2 n))))
+                (case-split (bvecp x n)))
+           (equal (lxor0 k x n)
+                  (lnot x n)))
+  :hints (("Goal" :use lxor0-ones)))
+
+(local (in-theory (disable mod-by-2-rewrite-to-even mod-mult-of-n mod-equal-0)))
+
+(encapsulate
+ ()
+
+ (local
+  (defthm lxor0-def-integerp
+    (implies (and (integerp x)
+                  (integerp y)
+                  (> n 0)
+                  (integerp n))
+             (equal (lxor0 x y n)
+                    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (lxor0 (mod x 2) (mod y 2) 1))))
+    :rule-classes ()
+    :hints (("Goal" :in-theory (e/d (lxor0 bits-fl-by-2) ())
+             :use ((:instance logxor-def (i (bits x (1- n) 0)) (j (bits y (1- n) 0)))
+                   (:instance mod012 (m x))
+                   (:instance mod012 (m y)))))))
+
+; Now we want to eliminate the (integerp x) and (integerp y) hypotheses from
+; lxor0-def-integerp.  First suppose x is not rational.
+
+ (local
+  (defthm lxor0-is-0-if-not-rational-1
+    (implies (not (rationalp x))
+             (equal (lxor0 x y n)
+                    (lxor0 0 y n)))
+    :hints (("Goal" :expand ((lxor0 x y n)
+                             (lxor0 0 y n))))))
+
+ (local
+  (defthm lxor0-is-0-if-not-rational-2
+    (implies (not (rationalp y))
+             (equal (lxor0 x y n)
+                    (lxor0 x 0 n)))
+    :hints (("Goal" :expand ((lxor0 x y n)
+                             (lxor0 0 x n))))))
+
+ (local
+  (defthm fl-1/2-is-0-if-not-rational
+    (implies (not (rationalp x))
+             (equal (fl (* 1/2 x)) 0))
+    :hints (("Goal" :cases ((acl2-numberp x))))))
+
+ (local
+  (defthm mod-2-if-not-rational
+    (implies (not (rationalp x))
+             (equal (mod x 2)
+                    (fix x)))
+    :hints (("Goal" :expand ((mod x 2))))))
+
+ (local
+  (defthm lxor0-fl-1
+    (equal (lxor0 (fl x) y n)
+           (lxor0 x y n))
+    :hints (("Goal" :expand ((lxor0 y (fl x) n)
+                             (lxor0 x y n))))))
+
+ (local
+  (defthm lxor0-fl-2
+    (equal (lxor0 y (fl x) n)
+           (lxor0 y x n))
+    :hints (("Goal" :expand ((lxor0 y (fl x) n)
+                             (lxor0 x y n))))))
+
+ (local
+  (defthm lxor0-def-rational-hack
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (>= n 0)
+                  (integerp n))
+             (equal (lxor0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
+                    (lxor0 (* 1/2 x) (* 1/2 y) n)))
+    :hints (("Goal" :expand ((lxor0 (* 1/2 (fl x)) (* 1/2 (fl y)) n)
+                             (lxor0 (* 1/2 x) (* 1/2 y) n))))))
+
+ (local
+  (defthm lxor0-def-rational
+    (implies (and (rationalp x)
+                  (rationalp y)
+                  (> n 0)
+                  (integerp n))
+             (equal (lxor0 x y n)
+                    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (lxor0 (mod x 2) (mod y 2) 1))))
+    :rule-classes ()
+    :hints (("Goal"
+             :use ((:instance lxor0-def-integerp (x (fl x)) (y (fl y))))
+             :in-theory (e/d (mod-fl-eric) (fl-mod))))))
+
+ (local
+  (defthm lxor0-def-not-rational-1
+    (implies (and (not (rationalp x))
+                  (rationalp y)
+                  (> n 0)
+                  (integerp n))
+             (equal (lxor0 x y n)
+                    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (lxor0 (mod x 2) (mod y 2) 1))))
+    :hints (("Goal" :use ((:instance lxor0-def-rational
+                                     (x 0)))))
+    :rule-classes nil))
+
+ (local
+  (defthm lxor0-def-not-rational-2
+    (implies (and (rationalp x)
+                  (not (rationalp y))
+                  (> n 0)
+                  (integerp n))
+             (equal (lxor0 x y n)
+                    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                       (lxor0 (mod x 2) (mod y 2) 1))))
+    :hints (("Goal" :use ((:instance lxor0-def-rational
+                                     (y 0)))))
+    :rule-classes nil))
+
+ (defthm lxor0-def
+   (implies (and (> n 0)
+                 (integerp n))
+            (equal (lxor0 x y n)
+                   (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+                      (lxor0 (mod x 2) (mod y 2) 1))))
+   :rule-classes ()
+   :hints (("Goal" :use (lxor0-def-not-rational-1
+                         lxor0-def-not-rational-2
+                         lxor0-def-rational)))))
+
+(defthm lxor0-mod-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (mod (lxor0 x y n) 2)
+		    (lxor0 (mod x 2) (mod y 2) 1)))
+  :hints (("Goal" :use (lxor0-def
+			(:instance mod012 (m x))
+			(:instance mod012 (m y))
+			(:instance quot-mod (m (lxor0 x y n)) (n 2))))))
+
+(defthm lxor0-fl-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (fl (/ (lxor0 x y n) 2))
+		    (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+  :hints (("Goal" :use (lxor0-def
+			(:instance mod012 (m x))
+			(:instance mod012 (m y))
+			(:instance quot-mod (m (lxor0 x y n)) (n 2))))))
+
+(in-theory (disable lxor0-mod-2 lxor0-fl-2))
+
+(defthm bitn-lxor0-0
+    (implies (and (integerp x)
+                  (integerp y)
+		  (not (zp n))
+                  )
+	     (= (bitn (lxor0 x y n) 0)
+		(bitn (+ x y) 0)))		
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bitn-logxor-0 (a (bits x (1- n) 0)) (b (bits y (1- n) 0)))
+			(:instance mod-mod-sum (n (expt 2 n)) (a x) (b y))
+			(:instance mod-of-mod-cor (a n) (b 1) (x (+ x y)))
+			(:instance mod-of-mod-cor (a n) (b 1) (x (+ (mod x (expt 2 n)) (mod y (expt 2 n))))))
+		  :in-theory (enable lxor0 bitn-rec-0 bits-mod bitn-bits))))
+
+(defthm lxor0-x-y-0
+  (equal (lxor0 x y 0) 0)
+  :hints (("Goal" :in-theory (enable lxor0))))
+
+
+;N is a free variable
+(defthm lxor0-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (case-split (integerp m))
+		  )
+	     (equal (lxor0 x y m) 
+                    (lxor0 x y n)))
+  :hints (("Goal" :in-theory (enable lxor0))))
+
+
+;move
+(defthm lxor0-upper-bound
+  (implies (and (integerp n)
+                (<= 0 n))
+           (< (lxor0 x y n) (expt 2 n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("Goal" :in-theory (enable lxor0))))
+
+;move
+(defthm lxor0-upper-bound-tight
+  (implies (and (integerp n)
+                (<= 0 n))
+           (<= (lxor0 x y n) (1- (expt 2 n)))))
+
+(defthmd lxor0-bits-1
+  (equal (lxor0 (bits x (1- n) 0)
+               y
+               n)
+         (lxor0 x y n))
+  :hints (("Goal" :in-theory (e/d (lxor0) (logior lxor0-commutative)))))
+
+(defthmd lxor0-bits-2
+  (equal (lxor0 x
+               (bits y (1- n) 0)
+               n)
+         (lxor0 x y n))
+  :hints (("Goal" :in-theory (e/d (lxor0) (logior lxor0-commutative)))))
+
+(local
+ (defthm lxor0-base-lemma
+   (implies (and (bvecp x 1) (bvecp y 1))
+            (equal (lxor0 x y 1)
+                   (if (iff (equal (bitn x 0) 1)
+                            (equal (bitn y 0) 1))
+                       0
+                     1)))
+   :rule-classes nil))
+
+(defthm lxor0-base
+  (equal (lxor0 x y 1)
+         (if (iff (equal (bitn x 0) 1)
+                  (equal (bitn y 0) 1))
+             0
+           1))
+  :hints (("Goal" :use ((:instance lxor0-base-lemma
+                                   (x (bits x 0 0))
+                                   (y (bits y 0 0)))
+                        (:instance lxor0-bits-1
+                                   (x x)
+                                   (y (bits y 0 0))
+                                   (n 1))
+                        (:instance lxor0-bits-2 (n 1)))))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/lxor0.lisp acl2-6.3/books/rtl/rel9/support/support/lxor0.lisp
--- acl2-6.2/books/rtl/rel9/support/support/lxor0.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/lxor0.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,348 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+This book is about LXOR0, a nice version of LOGXOR.  LXOR0 takes an extra size parameter, N, and always returns
+a bit vector of length N.
+
+todo: ;add analogues of the thms in land0.lisp past bitn-land0
+
+|#
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+(local (include-book "lxor0-proofs"))
+
+(defund binary-lxor0 (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logxor (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defmacro lxor0 (&rest x)
+  (declare (xargs :guard (consp x)))
+  (cond ((endp (cdddr x)) ;(lxor0 x y n) -- the base case
+         `(binary-lxor0 ,@x))
+        (t         
+         `(binary-lxor0 ,(car x)
+                       (lxor0 ,@(cdr x))
+                       ,(car (last x))))))
+
+
+;Allows things like (in-theory (disable lxor0)) to refer to binary-lxor0.
+(add-macro-alias lxor0 binary-lxor0)
+
+(defthm lxor0-nonnegative-integer-type
+  (and (integerp (lxor0 x y n))
+       (<= 0 (lxor0 x y n)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription lxor0) is no better than lxor0-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription binary-lxor0)))
+
+;drop this if we plan to keep natp enabled?
+(defthm lxor0-natp
+  (natp (lxor0 x y n)))
+
+(defthm lxor0-with-n-not-a-natp
+  (implies (not (natp n))
+           (equal (lxor0 x y n)
+                  0)))
+
+(defthmd lxor0-bvecp-simple
+  (bvecp (lxor0 x y n) n))
+
+(defthm lxor0-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lxor0 x y n) k)))
+
+
+;;
+;; Rules to normalize lxor0 terms (recall that LXOR0 is a macro for BINARY-LXOR0):
+;;
+
+;; allow sizes to differ on these?
+
+(defthm lxor0-associative
+  (equal (lxor0 (lxor0 x y n) z n)
+         (lxor0 x (lxor0 y z n) n)))
+
+(defthm lxor0-commutative
+  (equal (lxor0 y x n)
+         (lxor0 x y n)))
+
+(defthm lxor0-commutative-2
+  (equal (lxor0 y (lxor0 x z n) n)
+         (lxor0 x (lxor0 y z n) n)))
+
+(defthm lxor0-combine-constants
+  (implies (syntaxp (and (quotep x)
+                         (quotep y)
+                         (quotep n)))
+           (equal (lxor0 x (lxor0 y z n) n)
+                  (lxor0 (lxor0 x y n) z n))))
+
+(defthm lxor0-0
+  (implies (case-split (bvecp y n))
+           (equal (lxor0 0 y n)
+                  y)))
+
+;nicer than the analogous rule for logand?
+(defthm lxor0-1
+  (implies (case-split (bvecp y 1))
+           (equal (lxor0 1 y 1)
+                  (lnot y 1))))
+
+(defthm lxor0-self
+  (implies (case-split (bvecp x n))
+           (equal (lxor0 x x n)
+                  0)))
+
+
+(defthmd bits-lxor0-1
+  (implies (and (< i n)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lxor0 x y n) i j)
+                  (lxor0 (bits x i j) 
+                        (bits y i j) 
+                        (+ 1 i (- j))))))
+
+(defthmd bits-lxor0-2
+  (implies (and (<= n i)
+                (case-split (<= 0 j))
+                (case-split (integerp n))
+                )
+           (equal (bits (lxor0 x y n) i j)
+                  (lxor0 (bits x i j) 
+                        (bits y i j) 
+                        (+ n (- j))))))
+
+;notice the call to MIN in the conclusion
+(defthm bits-lxor0
+  (implies (and (case-split (<= 0 j))
+                (case-split (integerp n))
+                (case-split (integerp i))
+                )
+           (equal (bits (lxor0 x y n) i j)
+                  (lxor0 (bits x i j) 
+                        (bits y i j) 
+                        (+ (min n (+ 1 i)) (- j))))))
+
+(defthmd bitn-lxor0-1
+  (implies (and (< m n)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor0 x y n) m)
+                  (lxor0 (bitn x m) 
+                        (bitn y m) 
+                        1))))
+(defthmd bitn-lxor0-2
+  (implies (and (<= n m)
+                (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor0 x y n) m)
+                  0)))
+
+;notice the IF in the conclusion
+;we expect this to cause case splits only rarely, since m and n will usually be constants
+(defthm bitn-lxor0
+  (implies (and (case-split (<= 0 m))
+                (case-split (integerp n))
+                )
+           (equal (bitn (lxor0 x y n) m)
+                  (if (< m n)
+                      (lxor0 (bitn x m) 
+                            (bitn y m) 
+                            1)
+                    0))))
+
+
+(defthm lxor0-ones
+  (implies (case-split (bvecp x n))
+           (equal (lxor0 (1- (expt 2 n)) x n)
+                  (lnot x n)))
+  :rule-classes ())
+
+;lxor0-with-all-ones will rewrite (lxor0 x n) [note there's only one value being ANDed], because (lxor0 x n)
+;expands to (BINARY-LXOR0 X (ALL-ONES N) N) - now moot???
+(defthm lxor0-with-all-ones
+  (implies (case-split (bvecp x n))
+           (equal (lxor0 (all-ones n) x n)
+                  (lnot x n))))
+
+(defthm lxor0-ones-rewrite
+  (implies (and (syntaxp (and (quotep k)
+                              (quotep n)
+                              (equal (cadr k) (1- (expt 2 (cadr n))))))
+                (force (equal k (1- (expt 2 n))))
+                (case-split (bvecp x n)))
+           (equal (lxor0 k x n)
+                  (lnot x n))))
+
+(defthm lxor0-def
+    (implies (and (< 0 n)
+                  (integerp n))
+	     (equal (lxor0 x y n)
+		    (+ (* 2 (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))
+		       (lxor0 (mod x 2) (mod y 2) 1))))
+  :rule-classes ())
+
+(defthm lxor0-mod-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (mod (lxor0 x y n) 2)
+		    (lxor0 (mod x 2) (mod y 2) 1))))
+
+(defthm lxor0-fl-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (> n 0))
+	     (equal (fl (/ (lxor0 x y n) 2))
+		    (lxor0 (fl (/ x 2)) (fl (/ y 2)) (1- n)))))
+
+(in-theory (disable lxor0-mod-2 lxor0-fl-2))
+
+(defthm bitn-lxor0-0
+    (implies (and (integerp x)
+                  (integerp y)
+		  (not (zp n))
+                  )
+	     (= (bitn (lxor0 x y n) 0)
+		(bitn (+ x y) 0)))		
+  :rule-classes ())
+
+;BOZO rename
+(defthm lxor0-x-y-0
+  (equal (lxor0 x y 0) 0))
+
+
+;N is a free variable
+(defthm lxor0-reduce
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+		  (< n m)
+		  (case-split (integerp m))
+		  )
+	     (equal (lxor0 x y m) 
+                    (lxor0 x y n))))
+
+(defthm lxor0-upper-bound
+  (implies (and (integerp n)
+                (<= 0 n))
+           (< (lxor0 x y n) (expt 2 n)))
+  :rule-classes (:rewrite :linear))
+
+(defthm lxor0-upper-bound-tight
+  (implies (and (integerp n)
+                (<= 0 n))
+           (<= (lxor0 x y n) (1- (expt 2 n)))))
+
+(defthmd lxor0-bits-1
+  (equal (lxor0 (bits x (1- n) 0)
+               y
+               n)
+         (lxor0 x y n)))
+
+(defthmd lxor0-bits-2
+  (equal (lxor0 x
+               (bits y (1- n) 0)
+               n)
+         (lxor0 x y n)))
+
+(defthm lxor0-base
+  (equal (lxor0 x y 1)
+         (if (iff (equal (bitn x 0) 1)
+                  (equal (bitn y 0) 1))
+             0
+           1))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/merge.lisp acl2-6.3/books/rtl/rel9/support/support/merge.lisp
--- acl2-6.2/books/rtl/rel9/support/support/merge.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/merge.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,2296 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+;This book is intended to include lemmas mixing two or types of functions.  
+
+History of this file:
+David Russinoff created the original version of this file.  In
+9/99, Matt Kaufmann modified some of the lemmas with an eye toward
+increasing the automation provided by this book.  In the process,
+some previous stylistic conventions fell by the wayside, such as
+disabling :rewrite rules immediate after their statements.
+In 7/2001, Eric Smith moved many of the lemmas into basic.lisp
+and other books in the floating point library
+In 6/2002-7/2002, Eric Smith made more changes to this book, incorporating some
+lemmas from merge4.lisp, add.lisp, etc.
+
+todo:
+
+this book does a lot of including other books locally in encapsulates.  it'd be nice if books like
+arithmetic/expt could be included in this book without breakign stuff
+
+See also merge2.lisp.
+
+|#
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(include-book "ground-zero")
+(include-book "log")
+(include-book "float")  ;can't drop this, since exactp is used below...
+
+(local (include-book "../../arithmetic/top")) 
+
+(local (include-book "bvecp"))
+(local (include-book "bitn"))
+(local (include-book "lnot")) ;make non-local?
+(local (include-book "bits")) ;try making non-local?
+(local (include-book "logior")) 
+(local (include-book "logand")) 
+(local (include-book "logxor")) 
+(local (include-book "ocat")) 
+
+(local (in-theory (enable expt-minus)))
+(local (in-theory (enable expt-split)))
+
+(defthm bits-tail
+  (implies (and (bvecp x (1+ i))
+                (case-split (acl2-numberp i)))
+           (equal (bits x i 0)
+                  x)))
+
+(local (in-theory (enable bitn-mod))) ;BOZO why?
+
+;proved in logior
+(defthm logior-bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n))
+           (bvecp (logior x y) n)))
+
+
+(encapsulate
+ ()
+ (local (defthm mod-n+1-1
+          (implies (and (rationalp a);(integerp a)
+;                        (>= a 0)
+                        (integerp n)
+                        (>= n 0))
+                   (< (/ (mod a (expt 2 (1+ n))) (expt 2 n))
+                      2))
+          :rule-classes ()
+          :hints (("goal" :in-theory (set-difference-theories
+                                      (enable expt-split)
+                                      '( *-weakly-monotonic))
+                   :use ((:instance mod-bnd-1 (m a) (n (expt 2  (1+ n))))
+                         (:instance *-weakly-monotonic 
+                                    (x (expt 2 n)) 
+                                    (y 2)
+                                    (y+ (/ (mod a (expt 2 (1+ n))) (expt 2 n)))))))))
+
+ (local (defthm mod-n+1-2
+          (implies (and (rationalp a) ;(integerp a)
+                        ;(>= a 0)
+                        (integerp n)
+                        (>= n 0))
+                   (< (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))
+                      2))
+          :rule-classes ()
+          :hints (("goal" :use (mod-n+1-1)))))
+
+ (local (defthm mod-n+1-3
+          (implies (and (rationalp a); (integerp a)
+                        ;(>= a 0)
+                        (integerp n)
+                        (>= n 0))
+                   (<= 0 (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))))
+          :rule-classes ()
+          :hints (("goal" :use ( ;(:instance mod>=0 (m a) (n (expt 2 (1+ n))))
+                                )))))
+
+ (local (defthm mod-n+1-4
+          (implies (and  (rationalp a) ;(integerp a)
+;                        (>= a 0)
+                        (integerp n)
+                        (>= n 0))
+                   (or (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n))) 0)
+                       (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n))) 1)))
+          :rule-classes ()
+          :hints (("goal" :in-theory (disable EXPT-COMPARE expt-split)
+                   :use (mod-n+1-2
+                                mod-n+1-3)))))
+
+ (local (defthm mod-n+1-5
+          (implies (and (rationalp a) ;(integerp a)
+  ;                      (>= a 0)
+                        (integerp n)
+                        (>= n 0))
+                   (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))
+                      (mod (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n))) 2)))
+          :rule-classes ()
+          :hints (("goal" :use (mod-n+1-4)))))
+
+ (local (defthm mod-n+1-6
+          (implies (and (rationalp a) ;(integerp a)
+   ;                     (>= a 0)
+                        (integerp n)
+                        (>= n 0))
+                   (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))
+                      (bitn (mod a (expt 2 (1+ n))) n)))
+          :rule-classes ()
+          :hints (("goal" :use (mod-n+1-5
+                     ;			(:instance mod>=0 (m a) (n (expt 2 (1+ n))))
+                                (:instance bitn-def (x (mod a (expt 2 (1+ n)))) (n n)))))))
+
+ (local (defthm mod-n+1-7
+          (implies (and (rationalp a) ;(integerp a)
+    ;                    (>= a 0)
+                        (integerp n)
+                        (>= n 0))
+                   (= (fl (/ (mod a (expt 2 (1+ n))) (expt 2 n)))
+                      (bitn a n)))
+          :rule-classes ()
+          :hints (("goal" :in-theory (disable bitn-mod)
+                   :use (mod-n+1-6
+                         (:instance bitn-mod (x a) (n (1+ n)) (k n))
+                         )))))
+
+;export?  generalize?
+ (local (defthm mod-n+1-8
+          (implies (and (rationalp a) ;(integerp a)
+     ;                   (>= a 0)
+                        (integerp n)
+                        (> n 0))
+                   (= (mod (mod a (expt 2 (1+ n))) (expt 2 n))
+                      (mod a (expt 2 n))))
+          :rule-classes ()
+          :hints (("goal" :use ((:instance mod-of-mod-cor (x a) (a (1+ n)) (b n)))))))
+
+;like bitn-plus-bits
+;bad name?
+;should this be exported?
+ (defthm mod-n+1
+   (implies (and (rationalp a) ;(integerp a)
+      ;           (>= a 0)
+                 (integerp n)
+                 (>= n 0)
+                 )
+            (= (mod a (expt 2 (1+ n)))
+               (+ (* (bitn a n) (expt 2 n))
+                  (mod a (expt 2 n)))))
+   :rule-classes ()
+   :hints (("goal" :use (mod-n+1-8
+                         mod-n+1-7
+                     ;			(:instance mod>=0 (m a) (n (expt 2 (1+ n))))
+                         (:instance quot-mod (m (mod a (expt 2 (1+ n)))) (n (expt 2 n)))))))
+
+ )
+
+;prove from bits-mod-0?
+(defthm mod-n-n+1
+    (implies (and (rationalp a)
+		  (integerp n)
+		  (>= n 0) 
+                  )
+	     (iff (= (mod a (expt 2 (1+ n))) 0)
+		  (and (= (mod a (expt 2 n)) 0)
+		       (= (bitn a n) 0))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance mod-n+1)
+;			(:instance mod>=0 (m a) (n (expt 2 n)))
+			(:instance bitn-0-1 (x a))))))
+
+;prove without so many enables?
+(defthm bitn-logxor-0
+  (implies (and (integerp a)
+                (integerp b)
+                )
+           (equal (bitn (+ a b) 0)
+                  (bitn (logxor a b) 0)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable 
+                              bits bitn
+                              mod-by-2
+                              integerp-sum-of-odds-over-2
+                              ))))
+
+;rename; is about fl...
+;export?
+;this is basically fl of sig
+;move to somewhere in arithmetic/ ?
+(defthmd mod-expo-1
+  (implies (and (< 0 x)
+                (rationalp x)
+                )
+           (equal (fl (/ x (expt 2 (expo x))))
+                  1))
+  :hints (("goal" :use ((:instance fl-unique (x (/ x (expt 2 (expo x)))) (n 1))))))
+
+;move to somewhere in arithmetic/ ?
+(defthmd mod-expo
+  (implies (and (< 0 x)
+                (rationalp x)
+                )
+           (equal (mod x (expt 2 (expo x)))
+                  (- x (expt 2 (expo x)))))
+  :hints (("goal" :in-theory (enable mod  mod-expo-1))))
+
+(encapsulate
+ ()
+ (local (defthm mod-logxor-1
+               (implies (and (integerp n) (>= n 1)
+                             (integerp m) (>= m n)
+                             (integerp x) (>= x 0) (< x (expt 2 m))
+                             (integerp y) (>= y 0) (< y (expt 2 m)))
+                        (= (mod (logxor x y) (expt 2 n))
+                           (logior (mod (logand x (lnot y m)) (expt 2 n))
+                                   (mod (logand y (lnot x m)) (expt 2 n)))))
+               :rule-classes ()
+               :hints (("goal" :use ((:instance logxor-rewrite (n m))
+                                     (:instance mod-logior 
+                                                (x (logand x (lnot y m)))
+                                                (y (logand y (lnot x m)))))))))
+
+
+ (local (defthm mod-logxor-2
+               (implies (and (integerp n) (>= n 1)
+                             (integerp m) (>= m n)
+                             (integerp x) (>= x 0) (< x (expt 2 m))
+                             (integerp y) (>= y 0) (< y (expt 2 m)))
+                        (= (mod (logxor x y) (expt 2 n))
+                           (logior (logand (mod x (expt 2 n))
+                                           (mod (lnot y m) (expt 2 n)))
+                                   (logand (mod y (expt 2 n))
+                                           (mod (lnot x m) (expt 2 n))))))
+               :rule-classes ()
+               :hints (("goal" :use (mod-logxor-1
+                                     (:instance mod-logand (y (lnot y m)))
+                                     (:instance mod-logand (x y) (y (lnot x m))))))))
+
+ (local (defthm mod-logxor-3
+               (implies (and (integerp n) (>= n 1)
+                             (integerp m) (>= m n)
+                             (integerp x) (>= x 0) (< x (expt 2 m))
+                             (integerp y) (>= y 0) (< y (expt 2 m)))
+                        (= (mod (logxor x y) (expt 2 n))
+                           (logior (logand (mod x (expt 2 n))
+                                           (lnot (mod y (expt 2 n)) n))
+                                   (logand (mod y (expt 2 n))
+                                           (lnot (mod x (expt 2 n)) n)))))
+               :rule-classes ()
+               :hints (("goal" :in-theory (disable lnot)
+                        :use (mod-logxor-2
+                              (:instance mod-lnot (x x) (k n) (n m))
+                              (:instance mod-lnot (x y) (k n) (n m)))))))
+
+ (local (defthm mod-logxor-4
+               (implies (and (integerp n) (>= n 1)
+                             (integerp m) (>= m n)
+                             (integerp x) (>= x 0) (< x (expt 2 m))
+                             (integerp y) (>= y 0) (< y (expt 2 m)))
+                        (= (mod (logxor x y) (expt 2 n))
+                           (logxor (mod x (expt 2 n))
+                                   (mod y (expt 2 n)))))
+               :rule-classes ()
+               :hints (("goal" :in-theory (disable lnot)
+                        :use (mod-logxor-3
+                              (:instance logxor-rewrite (x (mod x (expt 2 n))) (y (mod y (expt 2 n))))
+;			(:instance mod>=0 (m x) (n (expt 2 n)))
+;		(:instance mod>=0 (m y) (n (expt 2 n)))
+                              (:instance mod-bnd-1 (m x) (n (expt 2 n)))
+                              (:instance mod-bnd-1 (m y) (n (expt 2 n))))))))
+
+
+
+ (defthmd mod-logxor
+   (implies (and (integerp n) (<= 0 n)
+                 (integerp x) (<= 0 x)
+                 (integerp y) (<= 0 y))
+            (equal (mod (logxor x y) (expt 2 n))
+                   (logxor (mod x (expt 2 n))
+                           (mod y (expt 2 n)))))
+   :hints (("goal" :in-theory (disable  expo-comparison-rewrite-to-bound
+                                        expo-comparison-rewrite-to-bound-2)
+            :use ((:instance mod-logxor-4 (m (max n (max (1+ (expo x)) (1+ (expo y))))))
+                  (:instance expo>= (n (max n (max (1+ (expo x)) (1+ (expo y))))))
+                  (:instance expo>= (n (max n (max (1+ (expo x)) (1+ (expo y))))) (x y)))))))
+
+(defthm exact-bits-1 
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+                  (exactp x (- n k))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance exactp2 (n (- n k)))))))
+
+;strange rule?
+(defthm exact-bits-2 ; exact-bits-a-c
+  (implies (and (equal (expo x) (1- n))
+                (rationalp x)
+                (<= 0 x) ;or put abs in conclusion?
+                (integerp k)
+                )
+           (equal (integerp (/ x (expt 2 k)))
+                  (equal (bits x (1- n) k)
+                         (/ x (expt 2 k)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable bits)
+           :use ((:instance fl-int (x (/ x (expt 2 k))))
+                 (:instance mod-does-nothing (m x) (n (expt 2 n)))
+                 (:instance expo-upper-bound)))))
+
+#|
+;BOZO move?
+;proved in mod-expt...
+(defthm mod-integerp-when-y-is-power-of-2
+  (implies (integerp x)
+           (integerp (mod x (expt 2 i))))
+  :rule-classes (:rewrite :type-prescription))
+|#
+
+(defthm exact-bits-3
+  (implies (integerp x)
+           (equal (integerp (/ x (expt 2 k)))
+                  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable bits)
+           :use ((:instance quot-mod (m x) (n (expt 2 k)))))))
+
+(defthm exact-bits-b-d
+  (implies (and (equal (expo x) (1- n))
+                (integerp x)
+                (integerp k)
+                )
+           (equal (exactp x (- n k))
+                  (equal (bits x (1- k) 0)
+                         0)))
+  :rule-classes ()
+  :hints (("goal" :use (exact-bits-3 exact-bits-1))))
+
+
+(encapsulate
+ ()
+ (local (defthm bvecp-exactp-aux
+          (implies (and (case-split (natp n))
+                        (bvecp x n))
+                   (exactp x n))
+          :hints (("Goal" :in-theory (set-difference-theories
+                                      (enable expt-split zip bvecp natp)
+                                      '())
+                   :use ((:instance exact-bits-1 (n (1+ (expo x))) (k 0))
+                         (:instance expo<= (n (1- n)))
+                         (:instance expo>= (n 0))
+                         (:instance exactp-<= (m (1+ (expo x)))))))))
+ (defthm bvecp-exactp
+   (implies (bvecp x n)
+            (exactp x n))
+
+   ))
+
+
+
+
+
+#| kill this comment if all certifies..
+
+;could combine these next two?
+
+;BOZO move to bitn?
+;BOZO enable!
+(defthmd bvecp-bitn-0
+  (implies (bvecp x n)
+           (equal (bitn x n) 0))
+  :hints (("Goal" :in-theory (enable bitn bvecp-bits-0))))
+
+
+;BOZO move to bitn?
+;make an alt version?
+(defthm bitn-bvecp-0
+  (implies (and (bvecp x n)
+                (<= 0 m)
+                )
+           (equal (bitn x (+ m n)) 0))
+  :hints (("Goal" :in-theory (disable bvecp-bitn-0)
+           :use ((:instance bvecp-bitn-0 (n (+ m n)))))))
+
+;move to bitn?
+;k is a free var
+;do we need this, if we have bvecp-longer?
+(defthm bitn-bvecp-0-eric
+  (implies (and (bvecp x k)
+                (<= k n))
+           (equal (bitn x n) 0))
+  :rule-classes ((:rewrite :match-free :all))
+  :hints (("Goal" :in-theory (enable bvecp-bitn-0))))
+
+|#
+
+
+;proved in bvecp.lisp...
+(defthm bvecp-product
+  (implies (and (bvecp x m)
+                (bvecp y n)
+                )
+           (bvecp (* x y) (+ m n)))
+  :rule-classes ())
+
+;proved in bvecp.lisp...
+(defthmd bvecp-1-rewrite
+  (equal (bvecp x 1)
+	 (or (equal x 0) (equal x 1)))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+;proved in bvecp.lisp...
+(defthm bvecp-1-0
+    (implies (and (bvecp x 1)
+		  (not (equal x 1)))
+	     (equal x 0))
+  :rule-classes :forward-chaining)
+
+#| kill if all certs
+;sort of a "bitn-tail" like bits-tail?
+(defthm bitn-bvecp-1
+    (implies (bvecp x 1)
+	     (equal (bitn x 0) x))
+    :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+
+
+;rename
+(defthmd bvecp-bitn-1
+    (implies (and (bvecp x (1+ n))
+		  (<= (expt 2 n) x)
+                  (natp n))
+	     (equal (bitn x n) 1))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use (bit-expo-b))))
+
+|#
+
+;add bitn-ash?
+
+(defthm bitn-decode
+  (implies (and (case-split (integerp x))
+                (case-split (<= 0 x))
+                (case-split (< x n))
+                )
+           (equal (bitn (decode x n) n2)
+                  (if (equal x n2)
+                      1
+                    0)))
+  :hints (("Goal" :in-theory (enable floor-fl decode ash)))
+  )
+
+
+
+
+
+
+
+;;;**********************************************************************
+;;;                         BITS
+;;;**********************************************************************
+
+
+
+#|
+(local
+ (defthm logand-expt-4-1
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (bits (- (1- (expt 2 n)) (expt 2 l)) (1- n) k))))
+   :rule-classes ()
+   :hints (("goal"  :in-theory (disable expt-compare)
+            :use ((:instance logand-slice (x (- (1- (expt 2 n)) (expt 2 l))))
+                  (:instance expt-strong-monotone (n l) (m n)))))))
+|#
+
+(local
+ (defthm logand-expt-4-2
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (fl (/ (mod (- (1- (expt 2 n)) (expt 2 l)) (expt 2 n)) (expt 2 k))))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (e/d (bits
+                                    ) ( EXPT-EXCEEDS-2 ;bozo why needed?
+                                    expt-compare
+                                    ))
+            :use ((:instance logand-slice (x (- (1- (expt 2 n)) (expt 2 l))))
+                  (:instance expt-strong-monotone (n l) (m n))
+                  )))))
+
+(local
+ (defthm logand-expt-4-3
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (mod (- (1- (expt 2 n)) (expt 2 l)) (expt 2 n))
+               (- (1- (expt 2 n)) (expt 2 l))))
+   :rule-classes ()
+   :hints (("goal"   :in-theory (disable expt-compare)
+            :use ((:instance expt-strong-monotone (n l) (m n))
+;			(:instance expt-pos (x l))
+                  (:instance mod-does-nothing (m (- (1- (expt 2 n)) (expt 2 l)))
+                             (n (expt 2 n))))))))
+
+(local
+ (defthm logand-expt-4-4
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (fl (/ (mod (- (1- (expt 2 n)) (expt 2 l)) (expt 2 n))
+                      (expt 2 k)))
+               (fl (/ (- (1- (expt 2 n)) (expt 2 l))
+                      (expt 2 k)))))		       
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable mod-does-nothing)
+            :use (logand-expt-4-3
+)))))
+
+(local
+ (defthm logand-expt-4-5
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (fl (/ (- (1- (expt 2 n)) (expt 2 l)) (expt 2 k))))))
+   :rule-classes ()
+   :hints (("goal" :hands-off (expt mod fl)
+            :use ((:instance logand-expt-4-2)
+                  (:instance logand-expt-4-4))))))
+
+(local
+ (defthm logand-expt-4-6
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (fl (/ (- (1- (expt 2 n)) (expt 2 l)) (expt 2 k)))
+               (fl (- (expt 2 (- n k)) (/ (1+ (expt 2 l)) (expt 2 k))))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance expt-split (r 2) (i (- n k)) (j k)))))))
+
+(local
+ (defthm logand-expt-4-8
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (fl (- (expt 2 (- n k)) (/ (1+ (expt 2 l)) (expt 2 k))))
+               (- (expt 2 (- n k)) 1)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-2-integerp
+                                       )
+            :use (logand-expt-4-6
+;                  logand-expt-4-7
+                  (:instance expt-2-integerp (i (- n k)))
+                  (:instance fl-unique 
+                             (x (- (expt 2 (- n k)) (/ (1+ (expt 2 l)) (expt 2 k))))
+                             (n (- (expt 2 (- n k)) 1))))))))
+
+(local
+ (defthm logand-expt-4-9
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (fl (/ (- (1- (expt 2 n)) (expt 2 l)) (expt 2 k)))
+               (- (expt 2 (- n k)) 1)))
+   :rule-classes ()
+   :hints (("goal" :use (logand-expt-4-8
+                         logand-expt-4-6)))))
+
+(local
+ (defthm logand-expt-4-10
+   (implies (and (integerp n) (>= n 0)
+                 (integerp k) (>= k 0)
+                 (integerp l) (>= l 0) (< l k)
+                 (< k n))
+            (= (logand (- (1- (expt 2 n)) (expt 2 l)) (- (expt 2 n) (expt 2 k)))
+               (* (expt 2 k) (- (expt 2 (- n k)) 1))))
+   :rule-classes ()
+   :hints (("goal" :hands-off (expt mod fl)
+            :use ((:instance logand-expt-4-5)
+                  (:instance logand-expt-4-9))))))
+
+;BOZO is this used anywhere?
+;move?
+;rename! 
+(defthm logand-expt-4
+  (implies (and (integerp n) (>= n 0)
+                (integerp k) (>= k 0)
+                (integerp l) (>= l 0) (< l k)
+                (<= k n))
+           (= (logand (- (1- (expt 2 n)) (expt 2 l))
+                      (- (expt 2 n) (expt 2 k)))
+              (- (expt 2 n) (expt 2 k))))
+  :rule-classes ()
+  :hints (("goal" :hands-off (expt mod fl)
+           :use ((:instance logand-expt-4-10)
+                 (:instance expt-split (r 2) (i (- n k)) (j k))))))
+
+
+;;;**********************************************************************
+;;;                       LOGAND, LOGIOR, and LOGXOR
+;;;**********************************************************************
+
+;move a bunch of these:
+
+;proved in log.lisp
+(defthmd logxor-rewrite-2
+    ;; ! Do we really want to get rid of logxor?
+    (implies (and (bvecp x n)
+		  (bvecp y n)
+                  (natp n)
+		  (not (= n 0)))
+	     (equal (logxor x y)
+		    (logior (logand x (lnot y n))
+			    (logand y (lnot x n)))))
+    :rule-classes ((:rewrite :match-free :all)))
+
+;move!
+(defthm logior-expt
+    (implies (and (natp n)
+		  (natp x)
+		  (bvecp y n))
+	     (= (logior (* (expt 2 n) x) y)
+		(+ (* (expt 2 n) x) y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use (or-dist-b))))
+
+;move!
+(defthm logior-expt-2
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n))
+	     (= (logior (* (expt 2 n) x)
+			(* (expt 2 n) y))
+		(* (expt 2 n) (logior x y))))
+  :rule-classes ()
+  :hints (("Goal" :use (or-dist-c))))
+
+;move?
+(defthm logand-bvecp
+    (implies (and (natp n)
+		  (bvecp x n)
+		  (natp y))
+	     (bvecp (logand x y) n))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use ( logand-bnd))))
+
+;name doesn't match land0-expt
+(defthm logand-expt
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n))
+	     (= (logand (* (expt 2 n) x) y)
+		(* (expt 2 n) (logand x (fl (/ y (expt 2 n)))))))
+  :rule-classes ()
+  :hints (("Goal" :use (and-dist-b))))
+
+(defthm mod-logand-expt
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n))
+	     (= (mod (logand x y) (expt 2 n))
+		(logand (mod x (expt 2 n)) y)))
+  :rule-classes ()
+  :hints (("Goal" :use (mod-logand-aux))))
+
+(defthm logand-mod-expt
+    (implies (and (natp x)
+		  (natp y)
+		  (natp n)
+		  (< x (expt 2 n)))
+	     (= (logand x y)
+		(logand x (mod y (expt 2 n)))))
+  :rule-classes ()
+  :hints (("Goal" :use (and-dist-d))))
+
+#|
+;proved in logxor...
+(defthm logxor-bvecp
+  (implies (and (bvecp x n)
+                (bvecp y n)
+                (natp n) ;gen?
+                )
+           (bvecp (logxor x y) n)))
+|#
+
+(defthm logand-expt-2
+    (implies (and (natp x)
+		  (natp k))
+	     (= (logand x (expt 2 k))
+		(* (expt 2 k) (bitn x k))))
+  :rule-classes ()
+  :hints (("Goal" :use (and-bits-a))))
+
+(defthm logior-expt-3
+    (implies (and (natp x)
+		  (natp k))
+	     (= (logior x (expt 2 k))
+		(+ x
+		   (* (expt 2 k) 
+		      (- 1 (bitn x k))))))
+  :rule-classes ()
+  :hints (("Goal" :use (and-bits-b))))
+
+;;;**********************************************************************
+;;;                            LNOT
+;;;**********************************************************************
+
+#|
+test of having this commented out:
+
+;proved in lnot.lisp
+(defthm lnot-x-0
+  (equal (lnot x 0) 0)
+  :hints (("Goal" :in-theory (enable lnot))))
+
+;proved in lnot.lisp
+(defthm lnot-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (lnot x n) k)))
+
+;proved in lnot.litp
+(defthm bitn-lnot-not-equal
+  (implies (and (< k n)
+                (integerp n)
+                (<= 0 n)
+                (integerp k)
+                (<= 0 k)
+                )
+           (not (= (bitn (lnot x n) k)
+                   (bitn x k))))
+  :hints (("Goal"; :in-theory (enable bvecp)
+           :use (:instance bitn-0-1 (n k))
+           ))
+  :rule-classes ())
+|#
+
+
+
+;;**********************************************************************
+;;                        NEW STUFF
+;;**********************************************************************
+
+(defun ls-induct (k x)
+  (if (zp k)
+      x
+    (ls-induct (1- k) (fl (/ x 2)))))
+
+(local (defthm lshiftamt-low-3-1
+    (implies (and (integerp k) (> k 0))
+	     (= (fl (/ (1- (expt 2 k)) 2))
+		(1- (expt 2 (1- k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '())
+           :use ((:instance fl-unique
+                                   (x (/ (1- (expt 2 k)) 2))
+                                   (n (1- (expt 2 (1- k))))))))))
+
+(local (defthm lshiftamt-low-3-2
+    (implies (and (integerp k) (> k 0))
+	     (= (mod (1- (expt 2 k)) 2) 1))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable expt-split)
+                              '())
+           :use ((:instance mod012 (m (1- (expt 2 k))))
+			(:instance mod-mod-2-not-equal (m (1- (expt 2 k))))
+			(:instance mod-2*i (i (expt 2 (1- k)))))))))
+
+
+
+(local (defthm lshiftamt-low-3
+    (implies (and (integerp k) (>= k 0)
+		  (integerp x) (>= x 0) (< x (expt 2 k)))
+	     (= (logior (1- (expt 2 k)) x)
+		(1- (expt 2 k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d ( expt-split mod-mult-of-n) ( logior-even))
+           :induct (ls-induct k x))
+	  ("Subgoal *1/2" :use (lshiftamt-low-3-1
+				lshiftamt-low-3-2
+				(:instance mod012 (m x))
+				(:instance quot-mod (m x) (n 2))
+				(:instance quot-mod (m (logior (1- (expt 2 k)) x)) (n 2))
+				(:instance fl-def-linear (x (/ x 2)))
+                                )))))
+;where used?
+;this is sort of like logior-ones?
+;BOZO kill or move this?
+(local (defthm lshiftamt-low-4
+              (implies (and (integerp k) (>= k 0)
+                            (integerp x) (> x 0)
+                            (= (expo x) k))
+                       (= (logior x (1- (expt 2 k)))
+                          (1- (expt 2 (1+ k)))))
+              :rule-classes ()
+              :hints (("Goal" :in-theory (e/d( expt-split) (EXPO-COMPARISON-REWRITE-TO-BOUND 
+                                                            expo-bound-eric
+                                                            MOVE-NEGATIVE-CONSTANT-1
+                                                            EXPO-COMPARISON-REWRITE-TO-BOUND-2))
+                       :use (expo-upper-bound
+                             expo-lower-bound
+;			(:instance expt-pos (x k))
+;			(:instance bit-basic-d (x (- x (expt 2 k))) (y (1- (expt 2 k))))
+                             (:instance or-dist-b (n k) (x 1) (y (- x (expt 2 k))))
+;			(:instance bit-basic-f (x (expt 2 k)) (y (- x (expt 2 k))) (z (1- (expt 2 k))))
+                             (:instance lshiftamt-low-3 (x (- x (expt 2 k))))
+                             (:instance or-dist-b (n k) (x 1) (y (1- (expt 2 k)))))))))
+
+
+;;
+;; ocat
+;;
+
+
+#|old definition
+(defun OCAT (x y n)
+  (+ (* (expt 2 n) x) y))
+|#
+
+;now always returns a nat
+(defund ocat (x y n)
+  (declare (xargs :guard t))
+  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
+
+
+(defthm ocat-nonnegative-integer-type
+  (and (integerp (OCAT X Y N))
+       (<= 0 (OCAT X Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than ocat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription ocat)))
+
+;just a rewrite rule
+(defthm ocat-natp
+  (natp (ocat x y n)))
+
+;proved in ocat.lisp
+(defthm ocat-bvecp
+  (implies (and (>= k n) ;handle other case?
+                (bvecp x (- k n))
+                (case-split (natp n))
+                (case-split (natp k))
+                (case-split (bvecp y n))
+                )
+           (bvecp (ocat x y n) k)))
+
+;add ocat-bvecp-rewrite!
+
+;this has caused problems in the past (size information is lost)?
+;proved in ocat.lisp
+(defthm ocat-0-rewrite
+    (implies (and (case-split (integerp x))
+		  (case-split (<= 0 x)))
+	     (equal (ocat 0 x n) x)))
+
+;proved in ocat.lisp
+(defthm ocat-associative
+  (implies (and (case-split (<= 0 m)) ;new now that ocat fixes its args
+                (case-split (<= 0 n)) ;new now that ocat fixes its args
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (ocat (ocat x y m) z n)
+                  (ocat x (ocat y z n) (+ m n)))))
+
+;;bits-ocat
+;this stuff should be moved to cat? or ocat?
+(defthm bits-ocat-1
+  (implies (and (< i n)
+                (case-split (natp y))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (natp n))
+                )
+           (equal (bits (ocat x y n) i j)
+                  (bits y i j)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable ocat)
+                              '(;expt-2-integerp
+                                ))
+           :use (;(:instance mod-bits (x (ocat x y n))) ;try
+;                 (:instance expt-2-integerp (i (- n (1+ i)))) ;elim?
+;                 (:instance mod-mult-eric (y (expt 2 (1+ i))) (x y) (a (* x (expt 2 (- n (1+ i))))))
+                 ))))
+
+(defthm bits-ocat-2
+  (implies (and (>= j n)
+                (case-split (natp x))
+                (case-split (bvecp y n))
+                (case-split (natp n))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits (ocat x y n) i j)
+                  (bits x (- i n) (- j n))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable ocat bvecp)
+                              '(CANCEL_PLUS-EQUAL-CORRECT
+                                CANCEL_PLUS-LESSP-CORRECT))
+           :use ((:instance fl-unique (x (/ (ocat x y n) (expt 2 n))) (n x))
+                 (:instance bits-shift-down-1 (i (- i n)) (j (- j n)) (x (ocat x y n)) (k n))
+                 ))))
+
+
+
+(defthm bits-ocat-3
+  (implies (and (>= i n)
+                (< j n)
+                (case-split (bvecp y n))
+                (case-split (natp x))
+                (case-split (natp n))
+                (case-split (natp i))
+                (case-split (natp j))
+                )
+           (equal (bits (ocat x y n) i j)
+                  (ocat (bits x (- i n) 0)
+                       (bits y (1- n) j)
+                       (- n j))))
+  :hints (("Goal" :in-theory (enable ocat bvecp-forward  bits-plus-mult-1)
+           :use ((:instance bits-plus-bits (x (ocat x y n)) (p n) (n i) (m j)))
+           )))
+
+;includes both bits-ocat-1, bits-ocat-2, and bits-ocat-3
+;we expect the indices to be constants, so this won't cause case-splits
+(defthm bits-ocat
+  (implies (and (case-split (bvecp y n))
+                (case-split (natp x))
+                (case-split (natp n))
+                (case-split (natp i))
+                (case-split (natp j))
+                )
+           (equal (bits (ocat x y n) i j)
+                  (if (< i n)
+                      (bits y i j)
+                    (if (>= j n)
+                        (bits x (- i n) (- j n))
+                      (ocat (bits x (- i n) 0)
+                           (bits y (1- n) j)
+                           (- n j))))))
+  :hints (("Goal" :in-theory (enable bvecp)))
+  )
+
+;bits-ocat should be all we need for simplifying (bits (ocat...))
+(in-theory (disable bits-ocat-1 bits-ocat-2 bits-ocat-3))
+
+;; bitn-ocat
+
+(defthm bitn-ocat-1
+  (implies (and (< i n)
+                (case-split (natp n))
+                (case-split (integerp i))
+                (case-split (natp x))
+                (case-split (natp y))
+                )
+           (equal (bitn (ocat x y n) i)
+                  (bitn y i)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn bits-ocat-1)
+                              '()))))
+
+(defthm bitn-ocat-2
+  (implies (and (>= i n)
+                (case-split (bvecp y n))
+                (case-split (natp x))
+                (case-split (natp n))
+                (case-split (integerp i))
+                )
+           (equal (bitn (ocat x y n) i)
+                  (bitn x (- i n))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn)
+                              '()))))
+
+;includes both bitn-ocat-1 and bitn-ocat-2
+(defthm bitn-ocat
+  (implies (and (case-split (bvecp y n))
+                (case-split (natp x))
+                (case-split (natp n))
+                (case-split (integerp i))
+                )
+           (equal (bitn (ocat x y n) i)
+                  (if (< i n)
+                      (bitn y i)
+                    (bitn x (- i n)))))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+;bitn-ocat should be all we need for simplifying (bitn (ocat...))
+(in-theory (disable bitn-ocat-1 bitn-ocat-2))
+
+
+; The following rule allows us to relieve (integerp x) hypotheses when
+; a rule applies to show (natp x).
+;This rule can be very expensive.  We don't want to backchain to natp if all we need is integerp!
+;Our plan is to enable natp in RTL proofs, so we disable this.
+;move
+(defthmd natp-integerp
+  (implies (natp x)
+           (integerp x)))
+
+;proved in bitn...
+(defthm bitn-bitn-0
+  (equal (bitn (bitn x n) 0)
+         (bitn x n)))
+
+(include-book "sumbits") ; used in lemmas about cat, below (search for sumbits)
+
+;BOZO proved in logior...
+(defthm logior-ones
+  (implies (and (natp n)
+                (bvecp x n))
+           (equal (logior x (1- (expt 2 n)))
+                  (1- (expt 2 n))))
+  :rule-classes ())
+
+(defthm logxor-ones
+  (implies (and (natp n)
+                (bvecp x n) ;drop this hyp?
+                )
+           (equal (logxor x (1- (expt 2 n)))
+                  (lnot x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable lnot bvecp)
+                              '(lnot-bvecp))
+           :use (lnot-bvecp
+                 (:instance logxor-rewrite-2 (y (1- (expt 2 n))))
+                 (:instance logand-ones (i (lnot x n)))))))
+
+
+
+
+;(in-theory (disable bitn-bvecp-0)) ;why?
+
+(defun logop-3-induct (x y z)
+  (declare (xargs :measure (+ (nfix x) (nfix y) (nfix z))))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(logop-3-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+(defun log3a (x y z)
+  (logior (logand x y) (logior (logand x z) (logand y z))))
+
+(defun log3b (x y z)
+  (logior (logand x y) (logand (logxor x y) z)))
+
+(local (in-theory (disable mod-equal-0 mod-by-2-rewrite-to-even)))
+
+(local (defthm log3-1
+    (implies (and (natp x) (natp y) (natp z)
+		  (equal (log3a (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)))
+			 (log3b (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2)))))
+	     (equal (log3a x y z)
+		    (log3b x y z)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable)
+		  :use ((:instance mod012 (m x))
+			(:instance mod012 (m y))
+			(:instance mod012 (m z))
+			(:instance quot-mod (m (log3a x y z)) (n 2))
+			(:instance quot-mod (m (log3b x y z)) (n 2)))))))
+
+(defun logop-induct (x y z)
+  (declare (xargs :measure (+ (nfix x) (nfix y) (nfix z))))
+  (if (and (natp x) (natp y) (natp z))
+      (if (and (zp x) (zp y) (zp z))
+	  t
+	(logop-induct (fl (/ x 2)) (fl (/ y 2)) (fl (/ z 2))))
+    t))
+
+;make a logtop book and put this in it?
+;or move this to log.lisp?
+(defthm log3
+    (implies (and (natp x) (natp y) (natp z))
+	     (equal (logior (logand x y) (logior (logand x z) (logand y z)))
+		    (logior (logand x y) (logand (logxor x y) z))))
+  :rule-classes ()
+  :hints (("Goal" :induct (logop-induct x y z))
+	  ("Subgoal *1/2" :use (log3-1))))
+
+
+
+
+(defthm exact-k+1
+    (implies (and (natp n)
+		  (natp x)
+		  (= (expo x) (1- n))
+		  (natp k)
+		  (< k (1- n))
+		  (exactp x (- n k)))
+	     (iff (exactp x (1- (- n k)))
+		  (= (bitn x k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (exact-bits-b-d
+			(:instance exact-bits-b-d (k (1+ k)))
+			(:instance bits-0-bitn-0 (n k))))))
+
+;from bits.  included so i can disable it
+(defthmd bits-reduce
+  (implies (and (< x (expt 2 (+ 1 i)))
+                (case-split (integerp x))
+                (case-split (<= 0 x))
+                (case-split (integerp i))
+                )
+           (equal (bits x i 0)
+                  x)))
+
+(in-theory (disable bits-tail)) ;yuck?
+
+
+;===
+
+;!! drop??
+;or move to lnot?
+(defthmd lnot-fl-rewrite
+  (implies (and (not (zp n))
+                (bvecp x n))
+           (equal (fl (* 1/2 (lnot x n)))
+                  (lnot (fl (* 1/2 x)) (1- n))))
+  :hints (("Goal" :use ((:instance lnot-fl-original (k 1))))))
+
+;(in-theory (enable logxor-bvecp)) ;why ever disabled?
+
+
+(local (defthm lnot-logxor-1
+    (implies (and (not (zp n))
+		  (bvecp x n)
+		  (bvecp y n)
+		  (equal (lnot (logxor (fl (/ x 2)) (fl (/ y 2))) (1- n))
+			 (logxor (lnot (fl (/ x 2)) (1- n)) (fl (/ y 2)))))
+	     (equal (lnot (logxor x y) n)
+		    (logxor (lnot x n) y)))
+  :rule-classes ()
+  :otf-flg t
+  :hints (("Goal" :in-theory (e/d ( ;lnot-mod-by-2-alt ;drop?
+                                     lnot-bvecp
+				     lnot-fl-rewrite
+                                     mod-lnot-by-2)
+                                  ( LNOT-FL-eric))
+		  :use ((:instance mod012 (m x))
+			(:instance mod012 (m y))
+			(:instance quot-mod (m (lnot (logxor x y) n)) (n 2))
+			(:instance quot-mod (m (logxor (lnot x n) y)) (n 2)))))))
+
+(defun logop2-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop2-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+;move up?
+(defthm bvecp-fl
+    (implies (and (not (zp n))
+		  (bvecp x n))
+	     (bvecp (fl (* 1/2 x)) (1- n)))
+  :hints (("Goal" :in-theory (enable bvecp expt-split))))
+
+
+
+(defthmd lnot-logxor
+  (implies (and (natp n)
+                (bvecp x n)
+                (bvecp y n))
+           (equal (lnot (logxor x y) n)
+                  (logxor (lnot x n) y)))
+  :hints (("Goal" :induct (logop2-induct x y n))
+	  ("Subgoal *1/2" :use (lnot-logxor-1))))
+
+;may be very expensive if we backchain from rationalp to integerp
+;move
+(defthmd integerp-rationalp
+  (implies (integerp x)
+           (rationalp x)))
+
+;move
+(defun logop-2-induct (x y)
+  (if (or (zp x) (zp y))
+      ()
+    (logop-2-induct (fl (/ x 2)) (fl (/ y 2)))))
+
+;move
+(defun logop-2-n-induct (x y n)
+  (if (zp n)
+      (cons x y)
+    (logop-2-n-induct (fl (/ x 2)) (fl (/ y 2)) (1- n))))
+
+;move to log?
+;not exported anywhere?
+;BOZO put bitn in conclusion and gen hyp..
+(defthm logand-1-x
+    (implies (bvecp x 1)
+	     (equal (logand 1 x) x))
+  :hints (("Goal" :in-theory (enable bvecp-1-rewrite))))
+
+(defthm ocat-bits-bits
+  (implies (and (equal j (1+ k))
+                (equal n (+ 1 (- l) k))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (integerp i))
+                (case-split (integerp k))
+                (case-split (integerp l))
+                )
+           (equal (ocat (bits x i j) (bits x k l) n)
+                  (bits x i l)))
+  :hints (("Goal" :in-theory (enable ocat)
+           :use ((:instance bits-plus-bits (n i) (p j) (m l))))))
+
+(defthm ocat-bitn-bits
+    (implies (and (equal j (+ 1 k))
+		  (equal n (+ 1 (- l) k))
+		  (case-split (<= l k))
+		  (case-split (integerp j))
+                  (case-split (integerp k))
+                  (case-split (integerp l))
+		  )
+	     (equal (ocat (bitn x j) (bits x k l) n)
+		    (bits x j l)))
+    :hints (("Goal" :in-theory (set-difference-theories
+                                (enable bitn)
+                                '()))))
+
+(defthm ocat-bits-bitn
+  (implies (and (equal j (+ 1 k))
+                (case-split (<= j i))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                )
+           (equal (ocat (bits x i j) (bitn x k) 1)
+                  (bits x i k)))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn)
+                              '()))))
+
+;perhaps just use bvecp-expo-rewrite?
+(defthm bvecp-expo
+  (implies (case-split (natp x))
+           (bvecp x (+ 1 (expo x))))
+  :hints (("Goal" :in-theory (enable bvecp)
+           :use (expo-upper-bound))))
+
+(defthm bvecp-expo-rewrite
+  (equal (bvecp x (+ 1 (expo x)))
+         (natp x)) ;rephrase to remove natp?
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+
+
+
+;if leading bit is zero, can drop it
+;move to bits?
+;make this better? make more like this?
+(defthmd lead-bit-0
+  (implies (and (equal (bitn x n) 0)
+                (bvecp x (+ 1 n))
+                (rationalp n)
+                )
+           (equal (bits x (- n 1) 0)
+                  x))
+  :hints (("goal" :in-theory (enable bits-tail)
+           :use ((:instance bitn-plus-bits
+                                   (x x)
+                                   (m 0)
+                                   (n n) )))))
+
+;Splits (bits x i j) into three pieces, where (bits x k l) is the middle piece.
+;Not a rewrite rule since it does the same thing as ocat-bits-bits firing twice.
+(defthm ocat-bits-bits-bits
+  (implies (and (<= k i)
+                (<= l k)
+                (<= j l)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (integerp l)
+                )
+           (equal (ocat (bits x i (+ 1 k))
+                        (ocat (bits x k l)
+                              (bits x (1- l) j)
+                              (+ l (- j)))
+                        (+ 1 (- j) k))
+                  (bits x i j)))
+  :rule-classes nil)
+
+
+
+;make about cat and add to lib/
+(defthm logior1-ocat
+  (implies (and (case-split (bvecp y n))
+                (case-split (natp x)))
+           (equal (logior1 (ocat x y n))
+                  (logior (logior1 x)
+                          (logior1 y))))
+  :hints (("Goal" :in-theory (enable logior1 bvecp))))
+
+;move to bitn?
+(defthm bitn-bits-gen
+  (implies (and (case-split (<= 0 k))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                )
+           (equal (bitn (bits x i j) k)
+                  (if (<= k (- i j))
+                      (bitn x (+ j k))
+                    0)))
+  :hints (("Goal" :in-theory (enable bitn-bits BVECP-BITN-0))))
+
+(defthmd bvecp-shift-down
+  (implies (and (bvecp x n)
+                (natp n)
+                (natp k))
+           (bvecp (fl (/ x (expt 2 k))) (- n k)))
+  :hints (("Goal" :in-theory (enable bvecp expt-split))))
+
+;like bvecp-shift?  prove from that?
+(defthmd bvecp-shift-up
+    (implies (and (bvecp x (- n k))
+                  ;(<= k n)
+                  (natp k)
+                  (integerp n) ;(natp n)
+		  )
+	     (bvecp (* x (expt 2 k)) n))
+  :hints (("Goal" :in-theory (enable bvecp))))
+
+;export!! enable?
+;gen?
+(defthmd expt2-of-non-integer-special
+  (implies (case-split (not (integerp i)))
+           (equal (expt 2 (+ 1 i))
+                  (if (acl2-numberp i)
+                      1
+                    2))))
+
+(local
+ (defthm bits-sum-2
+    (implies (and (integerp i)
+                  (integerp j)
+		  (>= i j)
+		  (>= j 0)
+                  )
+	     (equal (+ (bits x i 0)
+		       (bits y i 0))
+		    (+ (* (expt 2 j)
+			  (+ (bits x i j)
+			     (bits y i j)
+			     (bitn (+ (bits x (1- j) 0)
+				      (bits y (1- j) 0))
+				   j)))
+		       (bits (+ (bits x (1- j) 0)
+				(bits y (1- j) 0))
+			     (1- j)
+			     0))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-plus-bits (n i) (p j) (m 0))
+			(:instance bits-plus-bits (x y) (n i) (p j) (m 0))
+			(:instance bitn-plus-bits (x (+ (bits x (1- j) 0) (bits y (1- j) 0))) (n j) (m 0)))))))
+
+
+
+(defthm bits-sum-helper
+  (implies (and (integerp x) ;logically necessary
+                (integerp y) ;logically necessary
+                (integerp i)
+                )
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bitn (+ (bits x (1- j) 0)
+                                    (bits y (1- j) 0))
+                                 j))
+                        (- i j) 0)))
+  :rule-classes nil
+  :hints (("Goal" :use (bits-sum-2 
+;			bits-sum-6
+			(:instance bits-plus-mult-1
+				   (x (bits (+ (bits x (1- j) 0)
+					       (bits y (1- j) 0))
+					    (1- j)
+					    0))
+				   (y (+ (bits x i j)
+					 (bits y i j)
+					 (bitn (+ (bits x (1- j) 0)
+						  (bits y (1- j) 0))
+					       j)))
+				   (k j)
+				   (n i)
+				   (m j))))))
+
+
+;The hyps are logically necessary because the conclusion chops off those bits of x and y which are past the
+;binary point.  (So the theorem is only true for integers, which have no such bits).
+(defthm bits-sum-original
+  (implies (and (integerp x)
+                (integerp y)
+                )
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (bitn (+ (bits x (1- j) 0)
+                                    (bits y (1- j) 0))
+                                 j))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("subgoal 3" :use bits-sum-helper)
+          ("Goal" :cases ((and (integerp i) (integerp j))
+                          (and (integerp i) (not (integerp j)))
+                          (and (not (integerp i)) (integerp j)))
+           :in-theory (e/d () (BITN-IN-SUM-SPLIT-CASES)))))
+
+
+#|
+;helpful or not?
+(defthm bitn-sum
+  (implies (and (integerp x) ;logically necessary
+                (integerp y) ;logically necessary
+                )
+           (equal (bitn (+ x y) n)
+                  (bitn (+ (bitn x n)
+                           (bitn y n)
+                           (bitn (+ (bits x (1- n) 0)
+                                    (bits y (1- n) 0))
+                                 n))
+                        0)))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance bits-sum-original (i n) (j n))
+           :in-theory (e/d (bitn) ()))))
+
+(defthm bitn-of-integer-with-n-negative
+  (implies (and (< n 0)
+                (integerp x))
+           (equal (bitn x n)
+                  0))
+  :hints (("Goal" :in-theory (e/d (bitn) ()))))
+
+;generalize?
+if we know that (bits x i j) = a constant, then we know what any sub-vector of (bits x i j) equals
+(defthm bits-0-implies-subrange-0
+  (implies (and (equal 0 (bits x i+ j)) ;j+ is a free var
+                (< i i+)
+                (integerp j+)
+                (integerp i)
+                )
+           (equal (bits x i j)
+                  0))
+  :hints (("Goal" :use ((:instance bits-plus-bits (x x)
+                                   (n i+)
+                                   (m j)
+                                   (p (+ 1 i)))))))
+
+                  
+
+(defthm bits-sum-special-case-helper
+  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
+                (natp i) (natp j) (natp x) (natp y))
+           (equal (bitn (+ (bits x (1- j) 0)
+                           (bits y (1- j) 0))
+                        j)
+                  (logior (bitn x (1- j)) (bitn y (1- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1 BITS-SUM-1 BITS-SPLIT-AROUND-ZERO)
+           :use ((:instance bits-plus-bits (x (+ (BITS X (+ -1 J) 0)
+                                                 (BITS Y (+ -1 J) 0)))
+                            (n j)
+                            (m 0)
+                            (p (+ -1 j)))
+                 (:instance bits-sum-4 (i (+ -1 j)) (j 0))))))
+
+(:instance bitn-plus-bits (x (+ (BITS X (+ -1 J) 0)
+                                                 (BITS Y (+ -1 J) 0)))
+                            (n (+ -1 j))
+                            (m 0))
+
+(defthm bits-sum-special-case-helper
+  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
+                (natp i) (natp j) (natp x) (natp y))
+           (equal (bitn (+ (bits x (1- j) 0)
+                           (bits y (1- j) 0))
+                        j)
+                  (logior (bitn x (1- j)) (bitn y (1- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
+           :use ((:instance  bitn-sum (n (+ -1 j))) 
+))))
+                 )))
+
+
+
+(defthm bits-sum-special-case-helper
+  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
+                (natp i) (natp j) (natp x) (natp y))
+           (equal (bitn (+ (bits x (1- j) 0)
+                           (bits y (1- j) 0))
+                        j)
+                  (logior (bitn x (1- j)) (bitn y (1- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (e/d () ()))))
+           :use (
+
+                 ))))
+
+
+
+
+
+(defthm bits-sum-special-case-helper
+  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
+                (natp i) (natp j) (natp x) (natp y))
+           (equal (bitn (+ (bits x (1- j) 0)
+                           (bits y (1- j) 0))
+                        j)
+                  (logior (bitn x (1- j)) (bitn y (1- j)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
+           :use ((:instance bitn-0-1 (x x) (n (+ -1 j)))
+                 (:instance bitn-0-1 (x y) (n (+ -1 j)))
+                 (:instance bitn-sum (n (+ -1 j)))
+                 (:instance bitn-plus-bits (x x)
+                                   (n (+ -1 j)) (m 0))
+                 (:instance bitn-plus-bits (x y)
+                                   (n (+ -1 j)) (m 0))
+                 ))))
+
+
+
+(defthm bits-sum-special-case-helper
+  (implies (and (equal 0 (bits (+ x y) (1- j) 0))
+                (natp i) (natp j) (natp x) (natp y))
+           (equal (bitn (+ (bits x (1- j) 0)
+                           (bits y (1- j) 0))
+                        j)
+                  (logior (bitn x (1- j)) (bitn y (1- j)))))
+  :otf-flg t
+  :hints (("Goal" :use ((:instance bitn-plus-bits (x (+ (bits x (1- j) 0)
+                                                        (bits y (1- j) 0)))
+                                   (n j) (m 0))
+                        (:instance bitn-plus-bits (x x)
+                                   (n (+ -1 j)) (m 0))
+                        (:instance bitn-plus-bits (x y)
+                                   (n (+ -1 j)) (m 0))
+                        (:instance bitn-plus-bits (x (+ x y))
+                                   (n (+ -1 j)) (m 0))
+                        ))))
+
+
+                        (:instance bitn-plus-bits (x (+ (bits x (1- j) 0)
+                                                        (bits y (1- j) 0)))
+                                   (n j) (m 0))
+
+)
+
+
+
+
+ )      
+
+
+                 
+                        
+
+(defthm bits-sum-special-case
+    (implies (and (= (bits (+ x y) (1- j) 0) 0)
+                  (natp x)
+		  (natp y)
+		  (natp i)
+		  (natp j)
+		  (>= i j)
+		  (> j 0)
+		  )
+	     (equal (bits (+ x y) i j)
+		    (bits (+ (bits x i j) (bits y i j) (logior (bitn x (1- j)) (bitn y (1- j))))
+			  (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable BITN-IN-SUM-SPLIT-CASES
+                                      BITN-KNOWN-NOT-0-REPLACE-WITH-1)
+           :use (bits-sum-original
+                 bits-sum-special-case-helper)))) 
+
+
+(defthm bits-of-negative-integer
+  (implies (and (integerp x)
+                (< 0 x)) ;gen
+           (equal (bits (- x) i j)
+                  zz)))
+
+
+;BOZO.  This looped!
+(in-theory (disable BITN-DROP-CRUCIAL-BIT-AND-FLIP-RESULT-ALT-GEN))
+
+
+
+;gen to any bits of any constant?
+(defthm bits-of-constant-integer-down-to-0
+  (implies (and (integerp x)
+                (<= 0 x)
+                (<= (expo x) i))
+           (equal (bits x i 0)
+                  (bits x (expo x) 0)))
+  :hints (("Goal" :in-theory (enable bits-tail)))
+  )
+
+(defthm bits-1
+  (implies (case-split (integerp i))
+           (equal (bits 1 i 0)
+                  (if (<= 0 i)
+                      1
+                    0))))
+
+
+
+rewrite:
+
+(defthm bits-less-than-x-rewrite
+  (implies (and (natp i)
+                (natp j)
+                (natp x)
+                (< 0 x)
+                (<= j i)
+                )
+           (equal (< (bits x i j) x)
+                  (if (< 0 j)
+                      t
+                    (if (<= i (expo x))
+                        nil
+                      t)))))
+
+
+(defthm bits-x-equal-x
+  (implies (and (natp i)
+                (natp j)
+                (natp x)
+                (< 0 x)
+                (<= j i)
+                )
+           (implies (equal (bits x i j) x)
+                    (and (equal j 0)
+                         (<= (expo x) i))))
+  :rule-classes nil
+  :hints (("goal" :in-theory (enable bits)))
+  )
+
+(defthm bits-1-gen
+  (implies (and (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (<= 0 j))
+                )
+           (equal (bits 1 i j)
+                  (if (< 1 j)
+                      0
+                    (if (<= 0 i)
+                        1
+                      0))))
+  :hints (("Goal"; :in-theory (enable bits)
+           :cases ((equal 0 j))))
+  )
+
+
+
+(defthm bits-with-indices-in-the-wrong-order-2
+  (implies (case-split (< i j))
+           (equal (bits x i j)
+                  0)))
+
+;;This should be in lib/ ???:
+;prove from bits-sum-original ?
+(defthm bits-sum-plus-1-original
+    (implies (and (integerp x)
+                  (integerp y)
+		  (natp i)
+		  (natp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (bits x i j)
+			     (bits y i j)
+			     (bitn (+ 1
+				      (bits x (1- j) 0)
+				      (bits y (1- j) 0))
+				   j))
+			  (- i j) 0)))
+    :otf-flg t
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-sum-original (x (+ x y)) (y 1))
+                        (:instance bits-sum-original))
+))
+)
+
+  |#
+
+
+
+
+
+
+
+;sort of a special case of another thm?
+(local (defthm sticky-21-1
+              (implies (and (= (bits (+ x y) (1- k) 0) 0)
+                            (integerp x)
+                            (integerp y)
+                            )
+                       (= (bits (+ (bits x (1- k) 0)
+                                   (bits y (1- k) 0))
+                                (1- k) 0)
+                          0))
+              :rule-classes ()
+              :hints (("Goal" ;:in-theory (enable bits-mod)
+                       :use ( ;(:instance mod-mod-sum (a x) (b y) (n (expt 2 k)))
+                             )))))
+
+;Either there is a carry or there isn't.
+(local (defthm sticky-21-6
+    (implies (and (= (bits (+ x y) (1- k) 0) 0)
+                  (integerp x)
+		  (integerp y)
+;		  (natp k)
+		  ;(> k 0)
+		  )
+	     (member (+ (bits x (1- k) 0)
+			(bits y (1- k) 0))
+		     (list (expt 2 k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits fl-equal-rewrite)
+		  :use (;sticky-21-5
+			sticky-21-1
+			(:instance quot-mod
+				   (m (+ (bits x (1- k) 0)
+					 (bits y (1- k) 0)))
+				   (n (expt 2 k))))))))
+
+(local (defthm sticky-21-7
+              (implies (and (integerp x)
+                            (integerp y)
+      ;                            (integerp k)
+      ;                            (natp k)
+      ;(>= k 2)
+                            (= (bits (+ x y) (1- k) 0) 0)
+                            (= (bitn x (1- k)) 0)
+                            (= (bitn y (1- k)) 0))
+                       (equal (+ (bits x (1- k) 0)
+                                 (bits y (1- k) 0))
+                              0))
+              :rule-classes ()
+              :hints (("Goal" :in-theory (enable   bits-of-non-integer-special)
+                       :use (sticky-21-6
+                             (:instance bitn-plus-bits (n (1- k)) (m 0))
+                             (:instance bitn-plus-bits (x y) (n (1- k)) (m 0)))))))
+
+
+
+(local (defthm sticky-21-8-2
+    (implies (and (integerp x)
+		  (integerp y)
+		  (>= k 1)
+		  (= (bits (+ x y) (1- k) 0) 0)
+		  (or (= (bitn x (1- k)) 1)
+		      (= (bitn y (1- k)) 1)))
+	     (equal (+ (bits x (1- k) 0)
+		       (bits y (1- k) 0))
+		    (expt 2 k)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-21-6
+;			hack-8
+;			hack-9
+			(:instance bitn-plus-bits (n (1- k)) (m 0))
+			(:instance bitn-plus-bits (x y) (n (1- k)) (m 0)))))))
+
+
+;similar to another lemma
+(local (defthm bitn+0
+    (implies (and (integerp x)
+		  (integerp y)
+                  )
+	     (= (bitn (+ x y) 0)
+		(bitn (+ (bitn x 0) (bitn y 0)) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-rec-0)
+		  :use ((:instance mod-sum (a (bitn x 0)) (b y) (n 2))
+			(:instance mod-sum (a y) (b x) (n 2)))))))
+
+(local (defthm sticky-21-8-1
+    (implies (and (integerp x)
+		  (integerp y)
+		  (= (bits (+ x y) 0 0) 0)
+		  (or (= (bitn x 0) 1)
+		      (= (bitn y 0) 1)))
+	     (equal (+ (bits x 0 0)
+		       (bits y 0 0))
+		    2))
+    :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-n-n-rewrite ;yuck?
+                                     )
+		  :use (bitn+0
+			(:instance bitn-0-1 (n 0))
+			(:instance bitn-0-1 (x y) (n 0)))))))
+
+;move
+(defthmd bitn-of-non-integer-special
+  (implies (case-split (not (integerp i)))
+           (equal (bitn x i)
+                  0)))
+
+;move
+;BOZO try enabled
+(defthmd bitn-negative-bit-of-integer
+  (implies (and (integerp x)
+                (case-split (< i 0)))
+           (equal (bitn x i)
+                  0))
+  :hints (("Goal" :in-theory (e/d (bitn) ()))))
+
+(local (defthm sticky-21-8
+              (implies (and (integerp x)
+                            (integerp y)
+                            (= (bits (+ x y) (1- k) 0) 0)
+                            (or (= (bitn x (1- k)) 1)
+                                (= (bitn y (1- k)) 1)))
+                       (equal (+ (bits x (1- k) 0)
+                                 (bits y (1- k) 0))
+                              (expt 2 k)))
+              :rule-classes ()
+              :hints (("Goal" :in-theory (enable bitn-of-non-integer-special
+                                                 bitn-negative-bit-of-integer)
+                       :use (sticky-21-8-2
+                             sticky-21-8-1)))))
+
+(local (defthm sticky-21-9
+    (implies (and (integerp x)
+		  (integerp y)
+;		  (natp k)
+;		  (>= k 1)
+		  (= (bits (+ x y) (1- k) 0) 0))
+	     (equal (+ (bits x (1- k) 0)
+		       (bits y (1- k) 0))
+		    (* (expt 2 k)
+		       (logior (bitn y (1- k))
+			       (bitn x (1- k))))))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-21-7
+			sticky-21-8
+			(:instance bitn-0-1 (n (1- k)))
+			(:instance bitn-0-1 (x y) (n (1- k))))))))
+
+(local (defthm sticky-21-10
+    (implies (and (integerp x)
+		  (integerp y)
+                  (integerp k)
+;		  (natp k)
+;		  (>= k 1)
+;		  (natp n)
+		  (>= n k)
+		  (= (bits (+ x y) (1- k) 0) 0))
+	     (equal (* (expt 2 k) (bits (+ x y) n k))
+		    (bits (+ (bits x n 0) (bits y n 0))
+			  n 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable mod-sum bits)
+		  :use ((:instance bits-plus-bits (x (+ x y)) (n n) (p k) (m 0))
+			;(:instance mod-mod-sum (a x) (b y) (n (expt 2 k)))
+                        )))))
+
+(local (defthm sticky-21-11
+              (implies (and (integerp x)
+                            (integerp y)
+;                            (natp k)
+;                            (> k 0)
+;                            (natp n)
+                            (>= n k)
+                            (= (bits (+ x y) (1- k) 0) 0))
+                       (equal (* (expt 2 k) (bits (+ x y) n k))
+                              (bits (* (expt 2 k)
+                                       (+ (bits x n k) (bits y n k) (logior (bitn x (1- k)) (bitn y (1- k)))))
+                                    n 0)))
+              :rule-classes ()
+              :hints (("Goal" ; :in-theory (enable expt)
+                       :use (sticky-21-10
+                             sticky-21-9
+                             (:instance bits-plus-bits (n n) (p k) (m 0))
+                             (:instance bits-plus-bits (x y) (n n) (p k) (m 0)))))))
+
+;export??? rename!
+(local (defthm sticky-21
+    (implies (and (integerp x)
+		  (integerp y)
+;		  (natp k)
+		  (> k 0)
+;		  (natp n)
+		  (>= n k)
+		  (= (bits (+ x y) (1- k) 0) 0))
+	     (equal (bits (+ x y) n k)
+		    (bits (+ (bits x n k) (bits y n k) (logior (bitn x (1- k)) (bitn y (1- k))))
+			  (- n k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-of-non-integer-special)
+           :use (sticky-21-11
+			(:instance bits-shift-up-2
+				   (x (+ (bits x n k) (bits y n k) (logior (bitn x (1- k)) (bitn y (1- k)))))
+				   (i (- n k))))))))
+
+;Used to be among the sticky lemmas.
+;prove from bits-sum-original?
+;BOZO gen!
+(defthm bits-sum-special-case
+  (implies (and (= (bits (+ x y) (1- j) 0) 0)
+                (integerp x)
+                (integerp y)
+                (>= j 0) ;gen?
+                )
+           (equal (bits (+ x y) i j)
+                  (bits (+ (bits x i j)
+                           (bits y i j)
+                           (logior (bitn x (1- j))
+                                   (bitn y (1- j))))
+                        (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-negative-bit-of-integer)
+           :use ((:instance sticky-21 (n i) (k j))))))
+
+
+
+
+(local (defthm bits-sum-1-1
+    (implies (and; (natp x)
+;		  (natp y)
+;		  (natp j)
+                  (integerp j)
+		  (>= j 0)
+                  )
+	     (equal (BITS (+ 1
+			     (BITS X (+ -1 J) 0)
+			     (BITS Y (+ -1 J) 0))
+			  J 0)
+		    (+ 1
+		       (BITS X (+ -1 J) 0)
+		       (BITS Y (+ -1 J) 0))))
+  :hints (("Goal" :in-theory (union-theories (disable bits-bvecp) '(natp expt-split bvecp))
+		  :use ((:instance bits-bvecp (i (1- j)) (j 0) (k j))
+			(:instance bits-bvecp (x y) (i (1- j)) (j 0) (k j))
+			(:instance bits-tail (x (+ 1 (BITS X (+ -1 J) 0) (BITS Y (+ -1 J) 0))) (i j)))))))
+
+(local (defthm bits-sum-1-2
+    (implies (and; (natp x)
+;		  (natp y)
+		  (natp i)
+		  (natp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (+ 1
+		       (bits x i 0)
+		       (bits y i 0))
+		    (+ (* (expt 2 j)
+			  (+ (bits x i j)
+			     (bits y i j)
+			     (bitn (+ 1
+				      (bits x (1- j) 0)
+				      (bits y (1- j) 0))
+				   j)))
+		       (bits (+ 1
+				(bits x (1- j) 0)
+				(bits y (1- j) 0))
+			     (1- j)
+			     0))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance bits-plus-bits (n i) (p j) (m 0))
+			(:instance bits-plus-bits (x y) (n i) (p j) (m 0))
+			(:instance bitn-plus-bits (x (+ 1 (bits x (1- j) 0) (bits y (1- j) 0))) (n j) (m 0)))))))
+
+(local (defthm bits-sum-1-3
+    (implies (and; (natp x)
+		 ; (natp y)
+              (integerp x)
+              (integerp y)
+		  (natp i)
+		  (natp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (mod (+ 1
+			    (bits x i 0)
+			    (bits y i 0))
+			 (expt 2 (1+ i)))
+		    (mod (+ 1 x y)
+			 (expt 2 (1+ i)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (union-theories (disable expt) '(bits-mod))
+		  :use ((:instance mod-sum (a (1+ (bits x i 0))) (b y) (n (expt 2 (1+ i))))
+			(:instance mod-sum (a (1+ y)) (b x) (n (expt 2 (1+ i)))))))))
+
+(local (defthm bits-sum-1-4
+    (implies (and (integerp x)
+                  (integerp y)
+		  (natp i)
+		  (natp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ 1
+			     (bits x i 0)
+			     (bits y i 0))
+			  i j)))
+  :rule-classes ()
+  :hints (("Goal" :use (bits-sum-1-3
+			(:instance mod-bits-equal (x (+ 1 x y)) (y (+ 1 (bits x i 0) (bits y i 0)))))))))
+
+(local (defthm bits-sum-1-5
+    (implies (and (integerp x)
+                  (integerp y)
+		  (natp i)
+		  (natp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (* (expt 2 j)
+				(+ (bits x i j)
+				   (bits y i j)
+				   (bitn (+ 1
+					    (bits x (1- j) 0)
+					    (bits y (1- j) 0))
+					 j)))
+			     (bits (+ 1
+				      (bits x (1- j) 0)
+				      (bits y (1- j) 0))
+				   (1- j)
+				   0))
+			  i j)))
+  :rule-classes ()
+  :hints (("Goal" :use (bits-sum-1-4 bits-sum-1-2)))))
+
+(local (defthm bits-sum-1-6
+    (implies (and (integerp x)
+                  (integerp y)
+		  (natp i)
+		  (natp j)
+		  (>= i j)
+		  (>= j 0))
+	     (< (bits (+ 1
+			 (bits x (1- j) 0)
+			 (bits y (1- j) 0))
+		      (1- j)
+		      0)
+		(expt 2 j)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-mod)
+		  :use ((:instance mod-bnd-1 (m (+ 1 (bits x (1- j) 0) (bits y (1- j) 0))) (n (expt 2 j))))))))
+
+;;This should be in lib/ ???:
+;prove from bits-sum-original ?
+#|
+When we add two bit vectors of length n, we only need to look at 1 bit of carry.  
+
+When we add three bitvectors of length n, we need to consider 2 bits of carry.  However, when one of those
+three bit vectors is 1, we need only consider 1 bit of carry.
+
+|#
+(defthm bits-sum-plus-1-original
+    (implies (and (integerp x)
+                  (integerp y)
+		  (natp i)
+		  (natp j)
+		  (>= i j)
+		  (>= j 0))
+	     (equal (bits (+ 1 x y) i j)
+		    (bits (+ (bits x i j)
+			     (bits y i j)
+			     (bitn (+ 1
+				      (bits x (1- j) 0)
+				      (bits y (1- j) 0))
+				   j))
+			  (- i j) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (bits-sum-1-5 
+			bits-sum-1-6
+			(:instance bits-plus-mult-1
+				   (x (bits (+ 1
+					       (bits x (1- j) 0)
+					       (bits y (1- j) 0))
+					    (1- j)
+					    0))
+				   (y (+ (bits x i j)
+					 (bits y i j)
+					 (bitn (+ 1
+						  (bits x (1- j) 0)
+						  (bits y (1- j) 0))
+					       j)))
+				   (k j)
+				   (n i)
+				   (m j))))))
+
+
+
+
+;generalize to remove bits from the LHS?
+(defthm expo-bits-when-top-bit-is-1
+  (implies (and (equal 1 (bitn x i))
+                (case-split (<= j i))
+                (case-split (integerp j))
+		)
+	   (equal (expo (bits x i j))
+                  (+ i (- j))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (disable EQUAL-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE)
+           :use ((:instance expo-unique (x (bits x i j)) (n (+ i (- j))))
+                 (:instance bitn-plus-bits (n i) (m j))))))
+
+;generalize to remove bits from the LHS?
+(defthm sig-bits-when-top-bit-is-1
+  (implies (and (equal 1 (bitn x i))
+                (case-split (<= j i))
+                (case-split (integerp j))
+		)
+	   (equal (sig (bits x i j))
+                  (/ (bits x i j) (expt 2  (+ i (- j))))))
+  :hints (("Goal" :in-theory (enable sig))))
+
+
+;hack for now:
+;I could do this much better (if we know that (bits x i j) equals a constant, we know what any subrange equals.
+(defthm bits-0-means-top-bit-0
+  (implies (and (equal 0 (bits x i j))
+                (<= j i)
+                (integerp j)
+                )
+           (equal (bitn x i)
+                  0))
+  :hints (("Goal" :use (:instance bitn-plus-bits (n i) (m j)))))
+
+;BOZO This can be kind of expensive. Add back-chain-limit?
+(defthm bvecp-tighten
+  (implies (and (equal (bitn x (1- n)) 0)
+                (natp n))
+           (equal (bvecp x n)
+                  (bvecp x (1- n))))
+  :hints (("Goal" :use (:instance bitn-plus-bits (n (1- n)) (m 0))
+           :in-theory (e/d (bvecp)
+                           (BITS-SPLIT-AROUND-ZERO
+                            ;BITS-REDUCE-EXACTP
+                            )))))
+
+;add a bits-0-0-of-sig rule?  
+(defthm bitn-0-of-sig
+  (implies (and (rationalp x)
+                (not (equal x 0)))
+           (equal (bitn (sig x) 0)
+                  1))
+  :hints (("Goal" :in-theory (e/d ( bitn bits) ()))))
+
+
+;BOZO add
+;disable?
+(defthm bits-reduce-exactp
+  (implies (and (equal i (expo x))
+                (exactp x (+ 1 i (- j)))
+                (integerp j)
+                (rationalp x)
+                (<= 0 x) ;drop?
+                )
+           (equal (bits x i j)
+                  (/ x (expt 2 j))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable exactp sig)
+           :use ((:instance exact-bits-2 (n (+ 1 i)) (k j))
+                 ;(:instance exact-bits-2 (x (- x)) (n (+ 1 i)) (k j))
+                 ))))
+                        
+
+(defthm fp-rep-collapse
+  (implies (rationalp x)
+           (equal (* (sig x) (expt 2 (expo x)))
+                  (abs x)))
+  :hints (("goal" :in-theory (enable sig)))
+  )
+
+
+#|
+
+;move to somewhere else in library?
+(defthm bitn-1
+  (implies (and (equal (bitn x k) 1)
+                (integerp x)
+                (<= 0 x)
+                )
+           (>= x (expt 2 k)))
+  :hints (("Goal"
+           :use ((:instance bvecp-bitn-0 (x x) (n k)))
+           :in-theory (enable bvecp))) 
+  :rule-classes nil
+  )
+
+
+
+|#
+
+;BOZO, handle this right
+
+(defmacro mod- (x y n)
+  `(bits (- ,x ,y) (1- ,n) 0))
+
+;This won't fire, since mod- is a macro?
+(defthm mod--bvecp
+  (bvecp (mod- x y n) n))
+
+(include-book "cat")
+
+(defthm lnot-cat
+  (implies (and (case-split (natp n))
+		(case-split (natp m))
+		(equal l (+ m n)))
+	   (equal (lnot (cat x m y n) l)
+		  (cat (lnot x m) m (lnot y n) n)))
+  :hints (("Goal" :use (:instance cat-upper-bound)
+           :in-theory (e/d (lnot cat expt-split bits-reduce)
+                           (cat-upper-bound)))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/merge2.lisp acl2-6.3/books/rtl/rel9/support/support/merge2.lisp
--- acl2-6.2/books/rtl/rel9/support/support/merge2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/merge2.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,231 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; This book includes theorems we would like to put in merge, but cannot because
+; that would introduce circular dependences.  For example, below we include the
+; land0 book, but land0 includes land0-proofs which includes merge.  (Perhaps
+; land0-proofs does not need to include merge, but we take the easy path here.)
+
+; Finally, lemmas relating lior0 and cat.  The first of these use sumbits.
+
+(include-book "merge")
+
+(include-book "lior0")
+
+(local
+ (defthmd lior0-cat-1
+   (implies (and (case-split (integerp n))
+                 (case-split (integerp m))
+                 (>= n 0)
+                 (>= m 0)
+                 (equal l (+ m n))
+                 (integerp k)
+                 (<= 0 k)
+                 (< k l))
+            (equal (bitn (lior0 (cat x1 m y1 n) (cat x2 m y2 n) l) k)
+                   (bitn (cat (lior0 x1 x2 m) m (lior0 y1 y2 n) n) k)))
+   :hints (("Goal" :in-theory (enable bitn-cat)))))
+
+(defthmd lior0-cat
+  (implies (and (case-split (natp n))
+                (case-split (integerp m))
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (lior0 (cat x1 m y1 n) (cat x2 m y2 n) l)
+                  (cat (lior0 x1 x2 m) m (lior0 y1 y2 n) n)))
+  :hints (("Goal"
+           :in-theory (e/d (sumbits-badguy-is-correct
+                            sumbits-badguy-bounds
+                            lior0-cat-1)
+                           (bitn-lior0))
+           :restrict ((sumbits-badguy-is-correct ((k (+ m n))))))))
+
+(local
+ (defthm lior0-bits-1-alt
+   (implies (and (case-split (integerp n))
+                 (case-split (integerp i))
+                 (>= (1+ i) n))
+            (equal (lior0 (bits x i 0) y n)
+                   (lior0 x y n)))
+   :hints (("Goal" :in-theory (e/d (lior0) (lior0-commutative))))))
+
+(defthm lior0-cat-constant
+  (implies (and (case-split (integerp n))
+                (case-split (integerp m))
+                (syntaxp (quotep c))
+                (> n 0)
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (lior0 c (cat x2 m y2 n) l)
+                  (cat (lior0 (bits c (+ -1 m n) n) x2 m)
+                       m
+                       (lior0 (bits c (1- n) 0) y2 n)
+                       n)))
+  :hints (("Goal" :use (:instance lior0-cat (x2 x2) (y2 y2) (m m) (n n)
+                                  (x1 (bits c (+ -1 m n) n))
+                                  (y1 (bits c (1- n) 0))
+                                  (l (+ m n))))))
+
+; Copy the above events but modify for land.
+
+(include-book "land0")
+
+(local
+ (defthmd land0-cat-1
+   (implies (and (case-split (integerp n))
+                 (case-split (integerp m))
+                 (>= n 0)
+                 (>= m 0)
+                 (equal l (+ m n))
+                 (integerp k)
+                 (<= 0 k)
+                 (< k l))
+            (equal (bitn (land0 (cat x1 m y1 n) (cat x2 m y2 n) l) k)
+                   (bitn (cat (land0 x1 x2 m) m (land0 y1 y2 n) n) k)))
+   :hints (("Goal" :in-theory (enable bitn-cat)))))
+
+(defthmd land0-cat
+  (implies (and (case-split (natp n))
+                (case-split (integerp m))
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (land0 (cat x1 m y1 n) (cat x2 m y2 n) l)
+                  (cat (land0 x1 x2 m) m (land0 y1 y2 n) n)))
+  :hints (("Goal"
+           :in-theory (e/d (sumbits-badguy-is-correct
+                            sumbits-badguy-bounds
+                            land0-cat-1)
+                           (bitn-land0))
+           :restrict ((sumbits-badguy-is-correct ((k (+ m n))))))))
+
+(local
+ (defthm land0-bits-1-alt
+   (implies (and (case-split (integerp n))
+                 (case-split (integerp i))
+                 (>= (1+ i) n))
+            (equal (land0 (bits x i 0) y n)
+                   (land0 x y n)))
+   :hints (("Goal" :in-theory (e/d (land0) (land0-commutative))))))
+
+(defthm land0-cat-constant
+  (implies (and (case-split (integerp n))
+                (case-split (integerp m))
+                (syntaxp (quotep c))
+                (> n 0)
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (land0 c (cat x2 m y2 n) l)
+                  (cat (land0 (bits c (+ -1 m n) n) x2 m)
+                       m
+                       (land0 (bits c (1- n) 0) y2 n)
+                       n)))
+  :hints (("Goal" :use (:instance land0-cat (x2 x2) (y2 y2) (m m) (n n)
+                                  (x1 (bits c (+ -1 m n) n))
+                                  (y1 (bits c (1- n) 0))
+                                  (l (+ m n))))))
+
+; Copy the above events but modify for lxor.
+
+(include-book "lxor0")
+
+(local
+ (defthmd lxor0-cat-1
+   (implies (and (case-split (integerp n))
+                 (case-split (integerp m))
+                 (>= n 0)
+                 (>= m 0)
+                 (equal l (+ m n))
+                 (integerp k)
+                 (<= 0 k)
+                 (< k l))
+            (equal (bitn (lxor0 (cat x1 m y1 n) (cat x2 m y2 n) l) k)
+                   (bitn (cat (lxor0 x1 x2 m) m (lxor0 y1 y2 n) n) k)))
+   :hints (("Goal" :in-theory (enable bitn-cat)))))
+
+(defthmd lxor0-cat
+  (implies (and (case-split (natp n))
+                (case-split (integerp m))
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (lxor0 (cat x1 m y1 n) (cat x2 m y2 n) l)
+                  (cat (lxor0 x1 x2 m) m (lxor0 y1 y2 n) n)))
+  :hints (("Goal"
+           :in-theory (e/d (sumbits-badguy-is-correct
+                            sumbits-badguy-bounds
+                            lxor0-cat-1)
+                           (bitn-lxor0))
+           :restrict ((sumbits-badguy-is-correct ((k (+ m n))))))))
+
+(local
+ (defthm lxor0-bits-1-alt
+   (implies (and (case-split (integerp n))
+                 (case-split (integerp i))
+                 (>= (1+ i) n))
+            (equal (lxor0 (bits x i 0) y n)
+                   (lxor0 x y n)))
+   :hints (("Goal" :in-theory (e/d (lxor0) (lxor0-commutative))))))
+
+(defthm lxor0-cat-constant
+  (implies (and (case-split (integerp n))
+                (case-split (integerp m))
+                (syntaxp (quotep c))
+                (> n 0)
+                (> m 0)
+                (equal l (+ m n)))
+           (equal (lxor0 c (cat x2 m y2 n) l)
+                  (cat (lxor0 (bits c (+ -1 m n) n) x2 m)
+                       m
+                       (lxor0 (bits c (1- n) 0) y2 n)
+                       n)))
+  :hints (("Goal" :use (:instance lxor0-cat (x2 x2) (y2 y2) (m m) (n n)
+                                  (x1 (bits c (+ -1 m n) n))
+                                  (y1 (bits c (1- n) 0))
+                                  (l (+ m n))))))
+
+;;;;;;;;;;;
+
+(include-book "logs")
+
+(local (include-book "bvecp"))
+
+(defthmd log=-cat-constant
+  (implies (and (syntaxp (quotep k))
+                (case-split (bvecp k (+ m n)))
+                (case-split (bvecp x m))
+                (case-split (bvecp y n))
+                (case-split (integerp n))
+                (case-split (<= 0 n))
+                (case-split (integerp m))
+                (case-split (<= 0 m)))
+           (equal (log= k (cat x m y n))
+                  (land0 (log= x (bits k (+ -1 m n) n))
+                        (log= y (bits k (1- n) 0))
+                        1)))
+  :hints (("Goal" :use (:instance cat-equal-rewrite (x2 x) (y2 y) (n n) (m m)
+                                  (x1 (bits k (+ -1 m n) n))
+                                  (y1 (bits k (1- n) 0)))
+           :in-theory (enable log=))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/mod4.lisp acl2-6.3/books/rtl/rel9/support/support/mod4.lisp
--- acl2-6.2/books/rtl/rel9/support/support/mod4.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/mod4.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,159 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;perhaps this book should be in arithmetic/
+
+
+
+;just a helper function
+(defund even-aux (x)
+  (if (zp x)
+      t
+    (if (eql 1 x)
+        nil
+      (even-aux (+ -2 x)))))
+
+;A recursive recognizer for even integers.
+;Note that EVEN is not the same as the built in function EVENP
+(defund even (x)
+  (if (not (integerp x))
+      nil
+    (if (< x 0)
+        (even-aux (- x))
+      (even-aux x))))
+
+;A recognizer for odd integers.
+(defund odd (x)
+  (and (integerp x)
+       (not (even x))))
+
+(local (include-book "../../arithmetic/top"))
+
+;or maybe we do want mod4 to agree with (mod n 4) on weird values??
+;no, we want a nice t-p rule?
+(defund mod4 (n)
+  (if (not (integerp n))
+      0
+    (mod n 4)))
+
+
+
+(defthm mod4-values
+  (or (equal 0 (mod4 n))
+      (equal 1 (mod4 n))
+      (equal 2 (mod4 n))
+      (equal 3 (mod4 n)))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (e/d (mod4))))
+  )
+
+(defthm mod4-type-prescription
+  (and (integerp (mod4 n))
+       (<= 0 (mod4 n)))
+  :hints (("Goal" :use mod4-values))
+  :rule-classes ((:type-prescription :typed-term (mod4 n))))
+
+;The syntaxp hyps prevent looping.
+(defthm mod4-sum-move-safe
+  (implies (and (syntaxp (and (quotep k1)
+                              (quotep k2)))
+                (case-split (<= 0 k1))
+                (case-split (< k1 4))
+                (rationalp n)
+                (rationalp k1)
+                (integerp n)
+                (integerp k1)
+                (integerp k2)
+                )
+           (equal (equal k1 (mod4 (+ k2 n)))
+                  (equal (mod4 (+ k1 (- k2))) (mod4 n))))
+  :hints (("Goal" :in-theory (enable mod4)
+           :use (:instance mod-sum-move (x n) (y 4)))))
+
+;orient the other way?
+(defthmd even-to-mod
+  (implies (integerp n)
+           (equal (even n)
+                  (equal 0 (mod n 2))))
+  :hints (("Goal" :in-theory (enable even-is-evenp evenp mod-by-2-rewrite-to-even)))
+  )
+
+
+;should these next 4 be rewrite rules?
+;do we need to forward from facts about even/odd to facts about mod?
+(defthm mod4-is-0-fw-to-even
+  (implies (and (equal 0 (mod4 n))
+                (case-split (integerp n))
+                )
+           (even n))
+  :rule-classes (:forward-chaining)
+  :hints (("Goal" :in-theory (e/d (mod4 even-to-mod mod-equal-0) (integerp-prod))
+           :use (:instance integerp-prod (x (* 1/4 N)) (y 2)))))
+
+;We forward-chain to (not (even n)) instead of to (odd n) because we intend to keep ODD enabled.
+(defthm mod4-is-1-fw-to-not-even
+  (implies (and (equal 1 (mod4 n))
+                (case-split (integerp n))
+                )
+           (not (even n)))
+  :rule-classes (:forward-chaining)
+  :hints (("Goal" :in-theory (e/d (odd) (MOD4-IS-0-FW-TO-EVEN))
+           :use (:instance  mod4-is-0-fw-to-even (n (+ -1 n))))))
+
+(defthm mod4-is-2-fw-to-even
+  (implies (and (equal 2 (mod4 n))
+                (case-split (integerp n))
+                )
+           (even n))
+  :rule-classes (:forward-chaining)
+  :hints (("Goal" :in-theory (e/d (odd) (MOD4-IS-0-FW-TO-EVEN))
+           :use (:instance  mod4-is-0-fw-to-even (n (+ -2 n))))))
+
+;We forward-chain to (not (even n)) instead of to (odd n) because we intend to keep ODD enabled.
+(defthm mod4-is-3-fw-to-not-even
+  (implies (and (equal 3 (mod4 n))
+                (case-split (integerp n))
+                )
+           (not (even n)))
+  :rule-classes (:forward-chaining)
+  :hints (("Goal" :in-theory (e/d (odd) (MOD4-IS-0-FW-TO-EVEN))
+           :use (:instance  mod4-is-0-fw-to-even (n (+ -3 n))))))
+
+
+
+
+#|
+;gen -4 to any multiple of 4?
+;gen to normalize the constant -4??
+(defthmd mod4-reduce-by-4
+  (implies (case-split (integerp n))
+           (equal (mod4 (+ -4 n))
+                  (mod4 n)))
+  :hints (("goal" :cases ((= n 1) (= n 2))
+           :in-theory (enable  mod4  mod4-neg-reduce-by-4  mod4-pos-reduce-by-4)))
+  )
+|#
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/model-helpers.lisp acl2-6.3/books/rtl/rel9/support/support/model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/support/model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/model-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,42 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;I believe this theorem is used to admit model.lisp when it contains -aux functions
+
+(include-book "rtl")
+
+(local (include-book "bits"))
+
+(defthmd bits-reduce
+  (implies (and (< x (expt 2 (+ 1 i)))
+                (case-split (integerp x))
+                (case-split (<= 0 x))
+                (case-split (integerp i))
+                )
+           (equal (bits x i 0) x)))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/mulcat-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/mulcat-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/mulcat-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/mulcat-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,209 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+
+(local (include-book "../../arithmetic/top"))
+(local (include-book "bvecp"))
+(include-book "cat-def")
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "cat"))
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))
+                  :verify-guards nil))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond
+               ((eql n 1)
+                (bits x (1- l) 0))
+               ((and (integerp n) (> n 0))
+                (cat (mulcat l (1- n) x)
+                     (* l (1- n))
+                     x
+                     l))
+               (t 0))))
+
+;(defthm rationalp-mulcat
+;  (and (rationalp (mulcat l n x))
+;       (<= 0 (mulcat l n x)))
+;  :rule-classes :type-prescription)
+
+;(verify-guards mulcat)
+
+(local (in-theory (disable a15)))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :hints (("Goal" :in-theory (enable mulcat)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0)))
+  :hints (("Goal" :in-theory (enable mulcat bits-tail)
+		  :expand ((mulcat l 1 x)))))
+
+(defthm mulcat-bvecp-simple
+  (implies (and (= p (* l n))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p))
+  :hints (("Goal" :in-theory (enable mulcat)))
+  :rule-classes ())
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p))
+  :hints (("Goal" :in-theory (disable bvecp-longer)
+           :use ((:instance mulcat-bvecp-simple (p (* l n)))
+                 (:instance bvecp-longer (x (mulcat l n x)) (k2 p) (k1 (* l n)))))))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 0)
+  :hints (("Goal" :in-theory (enable mulcat))))
+
+(defthm mulcat-0-two
+  (equal (mulcat l 0 x) 0)
+  :hints (("Goal" :in-theory (enable mulcat))))
+
+(defthm bvecp-mulcat-1
+    (implies (natp n)
+	     (bvecp (mulcat 1 n 1) n))
+  :rule-classes ())
+
+
+
+(local (defthm mulcat-n-1-1
+    (implies (and (natp n)
+		  (> n 0))
+	     (equal (mulcat 1 n 1)
+		    (1+ (* 2 (mulcat 1 (1- n) 1)))))
+    :hints (("Goal" :in-theory (enable mulcat cat bits-tail)))))
+
+(defthm mulcat-n-1
+    (implies (case-split (<= 0 n))
+	     (equal (mulcat 1 n 1)
+		    (1- (expt 2 n))))
+  :hints (("Goal" :in-theory (enable mulcat expt-split))))
+
+(defun mulcat-induct (n n2)
+  (IF (AND (INTEGERP N) (> N 0) (INTEGERP N2) (> N2 0))
+      (mulcat-induct (1- n) (1- n2))
+      0))
+
+(local (include-book "merge"))  ;yuck
+
+;BOZO prove a bits-mulcat? could be used to prove-bitn-mulcat
+
+;BOZO generalize to bits of mulcat when x is larger than 1?
+;not general (note the 1 for the l parameter)
+;and to when (<= n m)
+;add to lib/ ?
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+                (case-split (bvecp x 1))
+                (case-split (natp m))
+                (case-split (integerp n)) ;(case-split (natp n))
+                )
+           (equal (bitn (mulcat 1 n x) m)
+                  x))
+  :hints (("Goal" :induct (mulcat-induct n m)
+		  :do-not '(generalize)
+		  :expand ((mulcat 1 n x))
+		  :in-theory (enable mulcat))))
+
+(defthm bitn-mulcat-2
+  (implies (and (<= (* l n) n2)
+                (natp n)
+                (natp l)
+                (natp n2)
+                (case-split (bvecp x l))
+                )
+           (equal (bitn (mulcat l n x) n2)
+                  0))
+  :hints (("Goal" :use ((:instance bvecp-bitn-0 (x (mulcat l n x)) (n n2))))))
+
+(defthmd mulcat-bits
+  (implies (and (integerp l)
+                (integerp x))
+           (equal (mulcat l n (bits x (1- l) 0))
+                  (mulcat l n x)))
+  :hints (("Goal" :in-theory (enable mulcat))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/mulcat.lisp acl2-6.3/books/rtl/rel9/support/support/mulcat.lisp
--- acl2-6.2/books/rtl/rel9/support/support/mulcat.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/mulcat.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,170 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(include-book "cat-def")
+(local (include-book "mulcat-proofs"))
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))
+                  :verify-guards nil))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond
+               ((eql n 1)
+                (bits x (1- l) 0))
+               ((and (integerp n) (> n 0))
+                (cat (mulcat l (1- n) x)
+                     (* l (1- n))
+                     x
+                     l))
+               (t 0))))
+
+(defthm mulcat-nonnegative-integer-type
+  (and (integerp (mulcat l n x))
+       (<= 0 (mulcat l n x)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than mulcat-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription mulcat)))
+
+(defthm mulcat-1
+    (implies (natp l)
+	     (equal (mulcat l 1 x) 
+		    (bits x (1- l) 0))))
+
+(defthm mulcat-bvecp-simple
+  (implies (and (= p (* l n))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p))
+  :rule-classes ())
+
+(defthm mulcat-bvecp
+  (implies (and (>= p (* l n))
+                (case-split (integerp p))
+                (case-split (natp l)))
+           (bvecp (mulcat l n x) p)))
+
+(defthm mulcat-0
+  (equal (mulcat l n 0) 
+         0))
+
+(defthm mulcat-0-two
+  (equal (mulcat l 0 x) 
+         0))
+
+(defthm bvecp-mulcat-1
+    (implies (natp n)
+	     (bvecp (mulcat 1 n 1) n))
+  :rule-classes ())
+
+(defthm mulcat-n-1
+    (implies (case-split (<= 0 n))
+	     (equal (mulcat 1 n 1)
+		    (1- (expt 2 n)))))
+
+(defun mulcat-induct (n n2)
+  (if (and (integerp n) (> n 0) (integerp n2) (> n2 0))
+      (mulcat-induct (1- n) (1- n2))
+      0))
+
+;BOZO prove a bits-mulcat? could be used to prove-bitn-mulcat
+
+;BOZO generalize to bits of mulcat when x is larger than 1?
+;not general (note the 1 for the l parameter)
+;and to when (<= n m)
+;add to lib/ ?
+(defthm bitn-mulcat-1
+  (implies (and (< m n)
+                (case-split (bvecp x 1))
+                (case-split (natp m))
+                (case-split (integerp n)) ;(case-split (natp n))
+                )
+           (equal (bitn (mulcat 1 n x) m)
+                  x)))
+
+(defthm bitn-mulcat-2
+  (implies (and (<= (* l n) n2)
+                (natp n)
+                (natp l)
+                (natp n2)
+                (case-split (bvecp x l))
+                )
+           (equal (bitn (mulcat l n x) n2)
+                  0)))
+
+(defthmd mulcat-bits
+  (implies (and (integerp l)
+                (integerp x))
+           (equal (mulcat l n (bits x (1- l) 0))
+                  (mulcat l n x))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/near+-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/near+-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/near+-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/near+-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,2224 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "trunc"))
+(local (include-book "away"))
+(local (include-book "float"))
+;BOZO include all of arithmetic?
+;(local (include-book "../../arithmetic/top"))
+(local (include-book "../../arithmetic/predicate"))
+(local (include-book "../../arithmetic/cg"))
+
+;; Necessary functions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+
+;;
+;; New stuff:
+;;
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+(local
+ (defthm near+trunc-1
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (< (re (* (expt 2 (1- n)) (sig x))) 1/2))
+            (< (+ x (expt 2 (- (expo x) n)))
+               (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable sgn trunc near+ re)
+            :use (fp-rep
+                  (:instance expt-split (r 2) (i (1- n)) (j (- (1+ (expo x)) n)))
+                  (:instance expt-split (r 2) (i -1) (j (- (1+ (expo x)) n)))
+                  (:instance *-strongly-monotonic
+                             (x (expt 2 (- (1+ (expo x)) n)))
+                             (y (re (* (expt 2 (1- n)) (sig x))))
+                             (y+ 1/2)))))))
+
+(local
+ (defthm near+trunc-2
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (< (re (* (expt 2 (1- n)) (sig x))) 1/2))
+            (< (trunc (+ x (expt 2 (- (expo x) n))) n)
+               (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (disable re)
+            :use (near+trunc-1
+                  (:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
+;			(:instance expt-pos (x (- (expo x) n)))
+                  )))))
+
+(local
+(defthm near+trunc-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (< (re (* (expt 2 (1- n)) (sig x))) 1/2))
+	     (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable re)
+		  :use (near+trunc-2
+			(:instance fp+2 (x (trunc x n)) (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))
+
+(local
+(defthm near+trunc-4
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable re)
+		  :use ((:instance trunc-monotone (y (+ x (expt 2 (- (expo x) n)))))
+;			(:instance expt-pos (x (- (expo x) n)))
+                        )))))
+
+(local
+ (defthm near+trunc-5
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (< (re (* (expt 2 (1- n)) (sig x))) 1/2))
+            (= (near+ x n)
+               (trunc (+ x (expt 2 (- (expo x) n))) n)))		
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable trunc-rewrite near+)
+            :use (near+trunc-3
+                  near+trunc-4)))))
+
+(local
+ (defthm near+trunc-6
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (>= (re (* (expt 2 (1- n)) (sig x))) 1/2))
+            (>= (+ x (expt 2 (- (expo x) n)))
+                (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable sgn trunc near+ re)
+            :use (fp-rep
+                  (:instance expt-split (r 2) (i (1- n)) (j (- (1+ (expo x)) n)))
+                  (:instance expt-split (r 2) (i -1) (j (- (1+ (expo x)) n)))
+                  (:instance *-weakly-monotonic
+                             (x (expt 2 (- (1+ (expo x)) n)))
+                             (y+ (re (* (expt 2 (1- n)) (sig x))))
+                             (y 1/2)))))))
+
+(local
+(defthm near+trunc-7
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))
+		 (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable trunc-exactp-c re)
+		  :use ((:instance fp+1 (x (trunc x n)))
+;			(:instance expt-pos (x (- (1+ (expo x)) n)))
+			(:instance trunc-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
+			(:instance away-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
+
+(local
+(defthm near+trunc-8
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (>= (re (* (expt 2 (1- n)) (sig x))) 1/2))
+	     (>= (+ x (expt 2 (- (expo x) n)))
+		 (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (near+trunc-7 near+trunc-6)))))
+
+(local
+(defthm near+trunc-9
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (>= (re (* (expt 2 (1- n)) (sig x))) 1/2))
+	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		 (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable trunc-exactp-c re)
+		  :use (near+trunc-8
+			(:instance trunc-exactp-c (x (+ x (expt 2 (- (expo x) n)))) (a (away x n))))))))
+
+(local
+(defthm near+trunc-10
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(fp+ (away x n) n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable trunc-exactp-c re)
+		  :use (expo-away
+;			(:instance expt-pos (x (- (expo x) n)))
+			(:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo (away x n))) n))))))))
+
+(local
+(defthm near+trunc-11
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		 (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable trunc-exactp-c re)
+		  :use (near+trunc-10
+			(:instance fp+2 (x (away x n)) (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))
+
+(local
+ (defthm near+trunc-12
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 0)
+                 (>= (re (* (expt 2 (1- n)) (sig x))) 1/2))
+            (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+               (near+ x n)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable  near+)
+            :use (near+trunc-11 near+trunc-9)))))
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ()
+  :hints (("Goal" :use (near+trunc-12 near+trunc-5))))
+
+;why disabled?
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) 
+     (* -1 (near+ x n)))
+  :hints (("goal" :in-theory (enable near+)
+           :use (trunc-minus
+                 away-minus
+                 sig-minus))))
+
+;why disabled?
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k))))
+  :hints (("goal" :in-theory (enable near+)
+		  :use (trunc-shift
+			away-shift
+			(:instance sig-expo-shift (n k))))))
+
+(local
+ (defthm sgn-near+-1
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0))
+            (= (trunc x n)
+               (* (sgn x) (trunc (abs x) n))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable trunc sig)
+            :use (sig-minus expo-minus)))))
+
+(local
+ (defthm sgn-near+-2-local
+   (implies (and (rationalp x)
+                 (integerp n)
+                 (> n 0))
+            (= (away x n)
+               (* (sgn x) (away (abs x) n))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable away sig)
+            :use (sig-minus expo-minus)))))
+
+;bad name!
+;; (encapsulate ()
+
+(defthm sgn-near+-2 ;; Thu Oct 12 17:39:46 2006
+     (implies (and (rationalp x)
+                   (integerp n)
+                   (> n 0))
+              (= (near+ x n)
+                 (* (sgn x) (near+ (abs x) n))))
+     :rule-classes ()
+     :hints (("goal" :in-theory (set-difference-theories
+                                 (enable near+)
+                                 '(sgn-away abs-pos  sig))
+              :use (sgn-near+-2-local sgn-near+-1 sig-minus away-minus))))
+
+(defthm near+-0
+  (equal (near+ 0 n) 0)
+  :hints (("Goal" :in-theory (enable near+)
+           :use trunc-0)))
+
+(defthm near+-1-1
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n)
+                (> n 0))
+           (= (- x (trunc x n))
+              (* (expt 2 (- (1+ (expo x)) n)) (re (* (expt 2 (1- n)) (sig x))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable re a15)
+           :use ((:instance trunc)
+                 (:instance fp-rep)))))
+
+(defthm near+-1-2
+  (implies (and (rationalp c)
+                (rationalp f)
+                (rationalp p)
+                (= c (+ 1 f)))
+           (= (* c p) (+ p (* f p))))
+  :rule-classes ())
+
+(defthm near+-1-3
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n)
+                (> n 0)
+                (not (integerp (* (expt 2 (1- n)) (sig x)))))
+           (= (- (away x n) x)
+              (* (expt 2 (- (1+ (expo x)) n)) (- 1 (re (* (expt 2 (1- n)) (sig x)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable re a15)
+           :use ((:instance away)
+                 (:instance fl-cg (x (* (expt 2 (1- n)) (sig x))))
+                 (:instance fp-rep)
+                 (:instance near+-1-2 
+                            (c (cg (* (expt 2 (1- n)) (sig x))))
+                            (f (fl (* (expt 2 (1- n)) (sig x))))
+                            (p (expt 2 (- (1+ (expo x)) n))))))))
+
+(defthm near+-1-4
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n)
+                (> n 0)
+                (integerp (* (expt 2 (1- n)) (sig x))))
+           (= (trunc x n) x))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable a15)
+           :use ((:instance trunc)
+                 (:instance fl-int (x (* (expt 2 (1- n)) (sig x))))
+                 (:instance fp-rep)))))
+
+(defthm near+-1-5
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n)
+                (> n 0)
+                (integerp (* (expt 2 (1- n)) (sig x))))
+           (= (away x n) x))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable a15)
+           :use ((:instance away)
+                 (:instance cg-int (x (* (expt 2 (1- n)) (sig x))))
+                 (:instance fp-rep)))))
+;drop?
+(defthm near+-1-6
+  (implies (and (rationalp p)
+                (> p 0)
+                (rationalp f)
+                (< (* p f) (* p (- 1 f))))
+           (< f 1/2))
+  :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE
+                                      )))
+  :rule-classes ())
+
+(defthm near+-1-7
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n)
+                (> n 0)
+                (not (integerp (* (expt 2 (1- n)) (sig x))))
+                (< (- x (trunc x n)) (- (away x n) x)))
+           (= (near+ x n) (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance near+-1-1)
+			(:instance near+-1-3)
+			(:instance near+-1-6 
+				   (p (expt 2 (- (1+ (expo x)) n))) 
+				   (f (re (* (expt 2 (1- n)) (sig x)))))
+			(:instance near+)))))
+;drop?
+(defthm near+-1-8
+  (implies (and (rationalp p)
+                (> p 0)
+                (rationalp f)
+                (> (* p f) (* p (- 1 f))))
+           (> f 1/2))
+  :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE
+                                      )))
+  :rule-classes ())
+
+(defthm near+-1-9
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0)
+		  (not (integerp (* (expt 2 (1- n)) (sig x))))
+		  (> (- x (trunc x n)) (- (away x n) x)))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance near+-1-1)
+			(:instance near+-1-3)
+			(:instance near+-1-8 
+				   (p (expt 2 (- (1+ (expo x)) n))) 
+				   (f (re (* (expt 2 (1- n)) (sig x)))))
+			(:instance near+)))))
+
+
+
+
+;; (defthm near+1-a
+;;     (implies (and (rationalp x)
+;; 		  (>= x 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (< (- x (trunc x n)) (- (away x n) x)))
+;; 	     (= (near+ x n) (trunc x n)))
+;;   :rule-classes ()
+;;   :hints (("Goal" :use ((:instance near+-1-7)
+;; 			(:instance near+-1-4)
+;; 			(:instance near+-1-5)))))
+
+;; (i-am-here) ;; Fri Oct 13 10:27:49 2006. Hanbing 
+
+(encapsulate () 
+
+     (local (defthm near+1-a-support
+              (implies (and (rationalp x)
+                            (>= x 0)
+                            (integerp n)
+                            (> n 0)
+                            (< (- x (trunc x n)) (- (away x n) x)))
+                       (= (near+ x n) (trunc x n)))
+              :rule-classes ()
+              :hints (("Goal" :use ((:instance near+-1-7)
+                                    (:instance near+-1-4)
+                                    (:instance near+-1-5))))))
+
+    (defthm near+1-a-1
+      (implies (and (rationalp x)
+                    (integerp n)
+                    (> n 0)
+                    (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+               (= (near+ x n) (trunc x n)))
+      :hints (("Goal" :cases ((not (equal x 0)))
+               :in-theory (enable trunc-minus near+-minus trunc-upper-pos
+                                  natp
+                                  away-lower-pos
+                                  away-minus))
+              ("Subgoal 1" :cases ((not (> x 0))))
+              ("Subgoal 1.2" :use ((:instance near+1-a-support)))
+              ("Subgoal 1.1" :use ((:instance near+1-a-support
+                                              (x (* -1 x)))
+                                   (:instance trunc-upper-pos
+                                              (x (* -1 x)))
+                                   (:instance away-lower-pos
+                                              (x (* -1 x)))
+                                   (:instance trunc-exactp-b)
+                                   (:instance away-exactp-b))))
+      :rule-classes ()))
+
+
+(encapsulate ()
+             (local 
+              (defthm near+1-b-support
+                (implies (and (rationalp x)
+                              (>= x 0)
+                              (integerp n)
+                              (> n 0)
+                              (> (- x (trunc x n)) (- (away x n) x)))
+                         (= (near+ x n) (away x n)))
+                :rule-classes ()
+                :hints (("Goal" :use ((:instance near+-1-9)
+                                      (:instance near+-1-4)
+                                      (:instance near+-1-5))))))
+
+
+     (defthm near+1-b-1
+       (implies (and (rationalp x)
+                     (integerp n)
+                     (> n 0)
+                     (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+                (= (near+ x n) (away x n)))
+       :hints (("Goal" :cases ((not (equal x 0)))
+                :in-theory (enable trunc-minus near+-minus trunc-upper-pos
+                                   away-lower-pos
+                                   away-minus))
+               ("Subgoal 1" :cases ((not (> x 0))))
+               ("Subgoal 1.2" :use ((:instance near+1-b-support)))
+               ("Subgoal 1.1" :use ((:instance near+1-b-support
+                                               (x (* -1 x)))
+                                    (:instance trunc-upper-pos
+                                               (x (* -1 x)))
+                                    (:instance away-lower-pos
+                                               (x (* -1 x)))
+                                    (:instance trunc-exactp-b)
+                                    (:instance away-exactp-b))))
+       :rule-classes ()))
+
+
+
+(encapsulate ()
+  (local   
+   (encapsulate ()
+                (local (include-book "../../arithmetic/fl"))
+                (local          
+                 (defthm fl-1/2-sig-x-is-zero-lemma
+                   (implies (and (rationalp x)
+                                 (rationalp y)
+                                 (< 0 y)
+                                 (<= y 1/2))
+                            (equal (fl (* (sig x) y))
+                                   0))
+                   :hints (("Goal" :in-theory (disable sig-lower-bound
+                                                       sig-upper-bound)
+                            :use ((:instance sig-upper-bound)
+                                  (:instance sig-lower-bound))))))
+
+   
+                (local 
+                 (defthm fl-1/2-sig-x-is-zero-lemma-2
+                   (implies (and (rationalp x)
+                                 (rationalp y)
+                                 (not (equal x 0))
+                                 (< 0 y)
+                                 (<= y 1/2))
+                            (equal (fl (* -1 (sig x) y))
+                                   -1))
+                   :hints (("Goal" :in-theory (enable sig fl-minus)
+                            :use ((:instance fl-1/2-sig-x-is-zero-lemma))))))
+
+
+                (local 
+                 (defthm expt-merge
+                   (implies (and (rationalp x)
+                                 (integerp n))
+                            (equal (* (expt 2 (expo x))
+                                      (EXPT 2 (+ -1 N))
+                                      (EXPT 2 (* -1 (EXPO X))))
+                                   (expt 2 (+ -1 n))))
+                   :hints (("Goal" :in-theory (enable a15)))))
+
+                (local (defthm expt-fact-1
+                         (implies (and (integerp n)
+                                       (<= n 0))
+                                  (<= (* 2 (EXPT 2 (+ -1 N))) 1))
+                         :hints (("Goal" :use ((:instance expt-weak-monotone-linear
+                                                          (n (+ -1 n))
+                                                          (m -1)))))
+                         :rule-classes :linear))
+
+                (local
+                 (defthm fl-is-zero-if-n-less-than-minus-1
+                   (implies (and (rationalp x)
+                                 (> x 0)
+                                 (integerp n)
+                                 (<= n 0))
+                            (equal (FL (* -1 X (EXPT 2 (+ -1 N))
+                                          (EXPT 2 (* -1 (EXPO X)))))
+                                   -1))
+                   :hints (("Goal" :in-theory (e/d (expo-shift sgn)
+                                                   (fl-1/2-sig-x-is-zero-lemma-2))
+                            :use ((:instance fp-rep (x x))
+                                  (:instance fl-1/2-sig-x-is-zero-lemma-2
+                                             (y (expt 2 (+ -1 n)))))))))
+
+
+                (local 
+                 (defthm fl-is-zero-if-n-less-than-zero
+                   (implies (and (rationalp x)
+                                 (> x 0)
+                                 (integerp n)
+                                 (<= n 0))
+                            (equal (FL (* X (EXPT 2 (+ -1 N))
+                                          (EXPT 2 (* -1 (EXPO X)))))
+                                   0))
+                   :hints (("Goal" :in-theory (e/d (expo-shift sgn)
+                                                   (fl-1/2-sig-x-is-zero-lemma))
+                            :use ((:instance fp-rep (x x))
+                                  (:instance fl-1/2-sig-x-is-zero-lemma
+                                             (y (expt 2 (+ -1 n)))))))))
+
+
+                (local (defthm expt-fact-2
+                         (implies (and (integerp n)
+                                       (< n 0))
+                                  (<= (* 4 (EXPT 2 (+ -1 N))) 1))
+                         :hints (("Goal" :use ((:instance expt-weak-monotone-linear
+                                                          (n (+ -1 n))
+                                                          (m -2)))))
+                         :rule-classes :linear))
+
+                (local 
+                 (defthm arith-hack
+                   (implies (and (< sig-x 2)
+                                 (> y 0)
+                                 (<= (* 4 y) 1)
+                                 (rationalp y))
+                            (< (* 2 sig-x y)
+                               (* 1)))))
+
+
+
+                (local 
+                 (defthm less-than-1-if-n-is-negative
+                   (implies (and (rationalp x)
+                                 (> x 0)
+                                 (integerp n)
+                                 (< n 0))
+                            (< (* 2 X (EXPT 2 (+ -1 N))
+                                  (EXPT 2 (* -1 (EXPO X))))
+                               1))
+                   :hints (("Goal" :in-theory (e/d (expo-shift  sgn) ())
+                            :use ((:instance fp-rep (x x))
+                                  (:instance sig-upper-bound)
+                                  (:instance arith-hack
+                                             (sig-x (sig x))
+                                             (y (expt 2 (+ -1 n)))))))
+                   :rule-classes :linear))
+
+                (local 
+                 (encapsulate () 
+                              (local 
+                               (defthm local-expt-expand
+                                 (implies (rationalp x)
+                                          (equal (EXPT 2 (+ 1 (EXPO X)))
+                                                 (* 2 (expt 2 (expo x)))))
+                                 :hints (("Goal" :use ((:instance a15 (i 2) (j1 1) (j2 (expo x))))))))
+              
+                              (defthm x-lower-bound
+                                (implies (and (rationalp x)
+                                              (> x 0))
+                                         (>= (* 2 X) (EXPT 2 (+ 1 (EXPO X)))))
+                                :hints (("Goal" :use ((:instance expo-lower-bound))))
+                                :rule-classes :linear)))
+
+        (defthm fl-is-zero-if-n-less-than-minus-1
+          (implies (and (rationalp x)
+                        (> x 0)
+                        (integerp n)
+                        (<= n 0))
+                   (equal (FL (* -1 X (EXPT 2 (+ -1 N))
+                                 (EXPT 2 (* -1 (EXPO X)))))
+                          -1)))
+
+
+        (defthm fl-is-zero-if-n-less-than-zero
+          (implies (and (rationalp x)
+                        (> x 0)
+                        (integerp n)
+                        (<= n 0))
+                   (equal (FL (* X (EXPT 2 (+ -1 N))
+                                 (EXPT 2 (* -1 (EXPO X)))))
+                          0)))
+
+        (defthm less-than-1-if-n-is-negative
+          (implies (and (rationalp x)
+                        (> x 0)
+                        (integerp n)
+                        (< n 0))
+                   (< (* 2 X (EXPT 2 (+ -1 N))
+                         (EXPT 2 (* -1 (EXPO X))))
+                      1))
+          :rule-classes :linear)
+
+        (defthm x-lower-bound
+          (implies (and (rationalp x)
+                        (> x 0))
+                   (>= (* 2 X) (EXPT 2 (+ 1 (EXPO X)))))
+          :rule-classes :linear)))
+
+   (local
+    (defthm near+1-a-2-2
+      (implies (and (rationalp x)
+                    (> x 0)
+                    (integerp n)
+                    (<= n 0)
+                    (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+               (= (near+ x n) (trunc x n)))
+      :hints (("Goal" :in-theory (enable near+ sgn cg away trunc sig re)
+               :cases ((equal n 0))))
+      :rule-classes ()))
+
+
+
+   (local (defthm x-upper-bound-1
+            (implies (and (rationalp x)
+                          (> x 0)
+                          (integerp n)
+                          (< n 0))
+                     (> (EXPT 2 (+ 1 (EXPO X) (* -1 N))) X))
+            :rule-classes :linear
+            :hints (("Goal" :in-theory (enable expo-upper-bound)
+                     :use ((:instance expt-strong-monotone-linear
+                                      (n (+ 1 (expo x)))
+                                      (m (+ 1 (expo x) (* -1 n)))))))))
+
+
+   (local (defthm x-upper-bound-2
+            (implies (and (rationalp x)
+                          (> x 0)
+                          (integerp n)
+                          (< n 0))
+                     (>= (EXPT 2 (+ 1 (EXPO X) (* -1 N))) (* 2 X)))
+            :rule-classes :linear
+            :hints (("Goal" :in-theory (enable expo-upper-bound)
+                     :use ((:instance expt-weak-monotone-linear
+                                      (n (+ 2 (expo x)))
+                                      (m (+ 1 (expo x) (* -1 n))))
+                           (:instance a15 (i 2)
+                                      (j1 1) (j2 (+ 1 (expo x)))))))))
+
+
+   (local (defthm x-upper-bound-3
+            (implies (and (rationalp x)
+                          (> x 0))
+                     (> (EXPT 2 (+ 1 (EXPO X))) x))
+            :rule-classes :linear
+            :hints (("Goal" :in-theory (enable expo-upper-bound)))))
+
+
+
+
+
+
+;      (defthm fl-is-zero-if-n-less-than-zero
+;        (implies (and (rationalp x)
+;                      (> x 0)
+;                      (integerp n)
+;                      (<= n 0))
+;                 (equal (FL (* X (EXPT 2 (+ -1 N))
+;                               (EXPT 2 (* -1 (EXPO X)))))
+;                        0)))
+
+
+
+   (local (defthm x-upper-bound-4
+            (implies (and (rationalp x)
+                          (> x 0))
+                     (<= 1 (* X (EXPT 2 (* -1 (EXPO X))))))
+            :rule-classes :linear
+            :hints (("Goal" :use ((:instance fp-rep))
+                     :in-theory (enable sgn a15 sig-lower-bound
+                                        expo-shift)))))
+
+
+
+
+   (local
+    (defthm fl-is-zero-if-n-less-than-zero-2
+      (implies (and (rationalp x)
+                    (> x 0))
+               (equal (FL (* 1/2 X 
+                             (EXPT 2 (* -1 (EXPO X)))))
+                      0))
+      :hints (("Goal" :use ((:instance fl-is-zero-if-n-less-than-zero
+                                       (n 0)))
+               :in-theory (disable fl-is-zero-if-n-less-than-zero)))))
+   
+
+   (local
+    (defthm near+1-b-2-2
+      (implies (and (rationalp x)
+                    (> x 0)
+                    (integerp n)
+                    (<= n 0)
+                    (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+               (= (near+ x n) (away x n)))
+      :hints (("Goal" :in-theory (enable away-lower-pos trunc-upper-pos
+                                         near+ sgn cg away trunc sig re)
+               :cases ((equal n 0))))
+      :rule-classes ()))
+
+
+
+   (defthm near+1-a-2
+     (implies (and (rationalp x)
+                   (integerp n)
+                   (<= n 0)
+                   (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+              (= (near+ x n) (trunc x n)))
+     :hints (("Goal" :cases ((not (equal x 0)))
+              :in-theory (enable  trunc-minus near+-minus trunc-upper-pos
+                                  away-lower-pos
+                                  away-minus))
+             ("Subgoal 1" :cases ((not (> x 0))))
+             ("Subgoal 1.2" :use ((:instance near+1-a-2-2)))
+             ("Subgoal 1.1" :use ((:instance near+1-a-2-2
+                                             (x (* -1 x))))))
+     :rule-classes ())
+
+   (defthm near+1-b-2
+     (implies (and (rationalp x)
+                   (integerp n)
+                   (<= n 0)
+                   (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+              (= (near+ x n) (away x n)))
+     :hints (("Goal" :cases ((not (equal x 0)))
+              :in-theory (enable  trunc-minus near+-minus trunc-upper-pos
+                                  away-lower-pos
+                                  away-minus))
+             ("Subgoal 1" :cases ((not (> x 0))))
+             ("Subgoal 1.2" :use ((:instance near+1-b-2-2)))
+             ("Subgoal 1.1" :use ((:instance near+1-b-2-2
+                                             (x (* -1 x))))))
+     :rule-classes ()))
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+	     (= (near+ x n) (trunc x n)))
+    :hints (("Goal" :cases ((not (> n 0))))
+            ("Subgoal 2" :use ((:instance near+1-a-1)))
+            ("Subgoal 1" :use ((:instance near+1-a-2))))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+    :hints (("Goal" :cases ((not (> n 0))))
+            ("Subgoal 2" :use ((:instance near+1-b-1)))
+            ("Subgoal 1" :use ((:instance near+1-b-2))))
+  :rule-classes ())
+
+
+;; Fri Oct 13 11:28:46 2006
+
+
+
+
+
+(defthm near+2-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp y n)
+		  (= (near+ x n) (trunc x n)))
+	     (>= (abs (- x y)) (- x (trunc x n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable away-exactp-c 
+				      near+ trunc-exactp-c)
+		  :use ((:instance near+1-b)
+			(:instance away-lower-pos)
+			(:instance trunc-upper-pos)
+			(:instance trunc-exactp-c (a y))
+			(:instance away-exactp-c (a y))))))
+
+(defthm near+2-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp y n)
+		  (= (near+ x n) (away x n)))
+	     (>= (abs (- x y)) (- (away x n) x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable away-exactp-c 
+				      trunc-exactp-c)
+		  :use ((:instance near+1-a)
+			(:instance away-lower-pos)
+			(:instance trunc-upper-pos)
+			(:instance trunc-exactp-c (a y))
+			(:instance away-exactp-c (a y))))))
+
+(defthm near+-choice
+  (or (= (near+ x n) (trunc x n))
+      (= (near+ x n) (away x n)))
+  :hints (("Goal" :in-theory (enable near+)))
+  :rule-classes ())
+
+
+
+
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n))
+  :hints (("Goal" :in-theory (disable near+ trunc-exactp-a away-exactp-a)
+		  :use ((:instance near+-choice)
+			(:instance trunc-exactp-a)
+			(:instance away-exactp-a)))))
+
+
+
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x)))
+    :hints (("Goal" :use (near+-choice
+                          sgn-trunc
+                          sgn-away))))
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (near+-choice
+			trunc-exactp-b
+			away-exactp-b))))
+
+;; (i-am-here) ;; Thu Oct 12 17:46:48 2006
+;; (i-am-here) ;; Fri Oct 13 11:34:24 2006
+
+(encapsulate () 
+      (local (include-book "../../arithmetic/fl"))
+      (local (include-book "../../arithmetic/integerp"))
+      (local 
+      (defthm near+-exactp-c-support
+        (implies (and (rationalp x)
+                      (> x 0)
+                      (integerp n)
+                      (> n 0)
+                      (rationalp a)
+                      (exactp a n)
+                      (>= a x))
+                 (>= a (near+ x n)))
+        :hints (("Goal" :use (near+-choice
+                              away-exactp-c
+                              trunc-upper-pos)))))
+
+
+     
+     (local 
+      (defthm near+-exactp-d-support
+        (implies (and (rationalp x)
+                      (> x 0)
+                      (integerp n)
+                      (> n 0)
+                      (rationalp a)
+                      (exactp a n)
+                      (<= a x))
+                 (<= a (near+ x n)))
+        :hints (("Goal" :use (near+-choice
+                              away-lower-pos
+                              trunc-exactp-c)))))
+
+
+     (local 
+      (defthm re-minus-if-not-integerp
+        (implies (and (rationalp x)
+                      (case-split (not (integerp x))))
+                 (equal (re (* -1 x))
+                        (- 1 (re x))))
+        :hints (("Goal" :in-theory (enable re fl-minus)))))
+
+
+     (local 
+      (defthm re-minus-if-integerp
+        (implies (integerp x)
+                 (equal (re x)
+                        0))
+        :hints (("Goal" :in-theory (enable re fl-minus)))))
+
+
+     (local 
+      (defthm trunc-upper-bound-specific
+        (implies (and (>= X A)
+                      (<= x 0)
+                      (integerp n)
+                      (> n 0)
+                      (rationalp x)
+                      (rationalp a))
+                 (<= A (trunc X N)))
+        :hints (("Goal" :in-theory (e/d (away-minus trunc-minus)
+                                        (trunc-goes-down-rewrite))
+                 :use ((:instance trunc-upper-pos
+                                  (x (* -1 x))))))))
+
+
+     (local 
+      (defthm away-upper-bound-specific
+        (implies (and    (<= X A)
+                         (<= x 0)
+                         (integerp n)
+                         (> n 0)
+                         (rationalp x)
+                         (rationalp a))
+                 (<= (AWAY X N) A))
+        :hints (("Goal" :in-theory (enable away-minus)
+                 :use ((:instance away-lower-pos
+                                  (x (* -1 x))))))))
+
+     (defthm near+-exactp-c
+       (implies (and (rationalp x)
+                     (integerp n)
+                     (> n 0)
+                     (rationalp a)
+                     (exactp a n)
+                     (>= a x))
+                (>= a (near+ x n)))
+       :hints (("Goal" :cases ((not (equal x 0))))
+               ("Subgoal 2" :in-theory (enable near+))
+               ("Subgoal 1" :cases ((not (> x 0))))
+               ("Subgoal 1.2" :use ((:instance near+-exactp-c-support)))
+               ("Subgoal 1.1" :use ((:instance near+-exactp-d-support
+                                               (x (* -1 x)) (a (* -1 a))))
+                :in-theory (e/d (near+ trunc-minus away-minus fl-minus 
+                                       sig-minus) ()))))
+     
+     (defthm near+-exactp-d
+       (implies (and (rationalp x)
+                     (integerp n)
+                     (> n 0)
+                     (rationalp a)
+                     (exactp a n)
+                     (<= a x))
+                (<= a (near+ x n)))
+       :hints (("Goal" :cases ((not (equal x 0))))
+               ("Subgoal 2" :in-theory (enable near+))
+               ("Subgoal 1" :cases ((not (> x 0))))
+               ("Subgoal 1.2" :use ((:instance near+-exactp-d-support)))
+               ("Subgoal 1.1" :use ((:instance near+-exactp-c-support
+                                               (x (* -1 x)) (a (* -1 a))))
+                :in-theory (e/d (near+ trunc-minus away-minus fl-minus 
+                                       sig-minus) ())))))
+
+            
+
+
+
+
+(encapsulate ()
+;;    (local 
+;;     (defthm near+2-support
+;;       (implies (and (rationalp x)
+;;                     (rationalp y)
+;;                     (> x 0)
+;;                     (> y 0)
+;;                     (integerp n)
+;;                     (> n 0)
+;;                     (exactp y n))
+;;                (>= (abs (- x y)) (abs (- x (near+ x n)))))
+;;       :rule-classes ()
+;;       :hints (("Goal" :in-theory (disable near+)
+;;                :use ((:instance near+2-1)
+;;                      (:instance near+2-2)
+;;                      (:instance near+-choice)
+;;                      (:instance away-lower-pos)
+;;                      (:instance trunc-upper-pos))))))
+
+   (local 
+    (defthm equal-diff-trunc-away-1
+      (implies (and (exactp y n)
+                    (rationalp x)
+                    (> x 0)
+                    (case-split (<= x y))
+                    (rationalp y)
+                    (equal (abs (- x (trunc x n))) (abs (- (away x n)
+                                                           x)))
+                    (integerp n)
+                    (> n 0))
+               (>= (abs (- x y)) (abs (- x (near+ x n)))))
+      :hints (("Goal" :use ((:instance trunc-upper-pos)
+                            (:instance near+-choice)
+                            (:instance away-lower-pos)
+                            (:instance away-exactp-c
+                                       (a y)))))))
+
+
+   (local 
+    (defthm equal-diff-trunc-away-2
+      (implies (and (exactp y n)
+                    (rationalp x)
+                    (> x 0)
+                    (case-split (<= y x))
+                    (rationalp y)
+                    (equal (abs (- x (trunc x n))) (abs (- (away x n)
+                                                           x)))
+                    (integerp n)
+                    (> n 0))
+               (>= (abs (- x y)) (abs (- x (near+ x n)))))
+      :hints (("Goal" :in-theory (disable NEAR+-EXACTP-D)
+               :use ((:instance near+-choice)
+                     (:instance trunc-upper-pos)
+                     (:instance away-lower-pos)
+                     (:instance trunc-exactp-c
+                                (a y)))))))
+
+
+
+   (local
+    (defthm near2+-lemma
+      (implies (and (exactp y n)
+                    (rationalp x)
+                    (> x 0)
+                    (rationalp y)
+                    (case-split (not (equal (abs (- x (trunc x n))) (abs (- (away x n)
+                                                                            x)))))
+                    (integerp n)
+                    (> n 0))
+               (>= (abs (- x y)) (abs (- x (near+ x n)))))
+      :hints (("Goal" :cases ((not (> (abs (- x (trunc x n))) (abs (- (away x n)
+                                                                      x)))))
+               :in-theory (disable near+-exactp-d))
+              ("Subgoal 2" :cases ((not (< x y))))
+              ("Subgoal 2.2" :use  ((:instance near+1-b)
+                                    (:instance trunc-upper-pos)
+                                    (:instance away-lower-pos)
+                                    (:instance away-exactp-c
+                                               (a y))))
+              ("Subgoal 2.1" :use  ((:instance near+1-b)
+                                    (:instance trunc-upper-pos)
+                                    (:instance away-lower-pos)
+                                    (:instance trunc-exactp-c
+                                               (a y))))
+              ("Subgoal 1" :cases ((not (< x y))))
+              ("Subgoal 1.2" :use  ((:instance near+1-a)
+                                    (:instance trunc-upper-pos)
+                                    (:instance away-lower-pos)
+                                    (:instance away-exactp-c
+                                               (a y))))
+              ("Subgoal 1.1" :use  ((:instance near+1-a)
+                                    (:instance trunc-upper-pos)
+                                    (:instance away-lower-pos)
+                                    (:instance trunc-exactp-c
+                                               (a y)))))))
+
+
+    (local 
+     (defthm near2+-lemma-futher
+       (implies (and (exactp y n)
+                     (rationalp x)
+                     (> x 0)
+                     (rationalp y)
+                     (integerp n)
+                     (> n 0))
+                (>= (abs (- x y)) (abs (- x (near+ x n)))))
+       :hints (("Goal" :cases ((equal (abs (- x (trunc x n))) (abs (- (away x n)
+                                                                      x)))))
+               ("Subgoal 2" :use ((:instance near2+-lemma)))
+               ("Subgoal 1" :cases ((not (< x y))))
+               ("Subgoal 1.2" :use ((:instance equal-diff-trunc-away-1)))
+               ("Subgoal 1.1" :use ((:instance equal-diff-trunc-away-2))))))
+
+
+
+    (defthm near+2
+      (implies (and (exactp y n)
+                    (rationalp x)
+                    (rationalp y)
+                    (integerp n)
+                    (> n 0))
+               (>= (abs (- x y)) (abs (- x (near+ x n)))))
+      :hints (("Goal" :cases ((not (> x 0)))
+               :in-theory (enable near+-minus trunc-minus away-minus
+                                  exactp-minus))
+              ("Subgoal 2" :use ((:instance near2+-lemma-futher)))
+              ("Subgoal 1" :use ((:instance near2+-lemma-futher
+                                            (x (* -1 x))
+                                            (y (* -1 y))))))
+      :rule-classes ())
+    )
+   
+
+
+
+
+
+(defthm near+-pos
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (disable near+)
+           :use ((:instance near+-choice)))))
+
+
+(defthm near+-neg
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear
+  :hints (("Goal" :in-theory (disable near+)
+		  :use ((:instance near+-choice)
+	))))
+
+
+
+
+(encapsulate ()
+
+  (local 
+  (defthmd near+-monotone-support
+    (implies (and (<= x y)
+                  (rationalp x)
+                  (rationalp y)
+                  (< 0 x)
+                  (integerp n)
+                  (> n 0))
+             (<= (near+ x n) (near+ y n)))
+    :hints (("Goal" :in-theory (disable near+ trunc-exactp-a away-exactp-a)
+             :use ((:instance near+-pos)
+                   (:instance near+-pos (x y))
+                   (:instance near+2 (y (near+ y n)))
+                   (:instance near+2 (x y) (y (near+ x n))))))))
+
+
+  (local 
+    (defthm fl-1/2-sig-x-is-zero-specific
+      (implies (rationalp x)
+               (equal (fl (* 1/2 (sig x)))
+                      0))
+      :hints (("Goal" :use ((:instance sig-upper-bound)
+                            (:instance sig-lower-bound))))))
+
+
+   (local 
+    (defthm near+-monotone-lemma1
+      (implies (and (<= x y)
+                    (rationalp x)
+                    (rationalp y))
+               (<= (near+ x 0) (near+ y 0)))
+      :hints (("Goal" :in-theory (e/d (near+ sgn away-minus re)
+                                      (sig-lower-bound
+                                       LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE
+                                       ))
+               :cases ((not (equal x 0))))
+              ("Subgoal 2" :use ((:instance away-negative
+                                            (x (* -1 y)) (n 0))))
+              ("Subgoal 1" :cases ((not (> x 0))))
+              ("Subgoal 1.2" :use ((:instance sig-lower-bound (x y))
+                                   (:instance expt-weak-monotone-linear
+                                              (n (+ 1 (expo x)))
+                                              (m (+ 1 (expo y))))
+                                   (:instance expo-monotone)))
+              ("Subgoal 1.1" :cases ((not (> y 0)))
+               :in-theory (e/d (away near+ sgn cg re)
+                               (sig-lower-bound
+                                LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-RIGHT-HAND-SIDE)))
+              ("Subgoal 1.1.1" 
+               :use ((:instance expt-weak-monotone-linear
+                                (n (+ 1 (expo y)))
+                                (m (+ 1 (expo x))))
+                     (:instance expo-monotone
+                                (x y) (y x))
+                     (:instance sig-lower-bound))))))
+            
+
+ (defthm near+-monotone
+   (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(integerp n)
+                (natp n))
+           (<= (near+ x n) (near+ y n)))
+  :hints (("Goal" :cases ((not (equal n 0)))
+           :in-theory (enable near+-minus))
+          ("Subgoal 2" :use ((:instance near+-monotone-lemma1)))
+          ("Subgoal 1" :cases ((not (equal x 0))))
+          ("Subgoal 1.2" :use ((:instance near+-neg
+                                          (x (* -1 y)))))
+          ("Subgoal 1.1" :cases ((not (> x 0))))
+          ("Subgoal 1.1.2" :use ((:instance
+                                  near+-monotone-support)))
+          ("Subgoal 1.1.1" :use ((:instance near+-monotone-support
+                                            (x (* -1 y))
+                                            (y (* -1 x)))))))
+          
+)
+
+
+
+(defund near+-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near+ x n) (near+ y n)) 2)
+    (expt 2 (expo y))))
+
+(local 
+ (defthm near+-near+-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (expo x) (expo y))))
+	     (and (<= x (near+-witness x y n))
+		  (<= (near+-witness x y n) y)
+		  (exactp (near+-witness x y n) (1+ n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable near+-witness)
+		  :use ((:instance exactp-2**n (n (expo y)) (m (1+ n)))
+			(:instance expo-upper-bound)
+			(:instance expo-monotone)
+			(:instance expt-weak-monotone (n (1+ (expo x))) (m (expo y)))
+			(:instance expo-lower-bound (x y)))))))
+
+(local
+ (defthm near+-near+-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near+ x n) (near+ y n))
+		  (= (expo x) (expo y)))
+	     (and (<= x (near+-witness x y n))
+		  (<= (near+-witness x y n) y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable near+-witness)
+		  :use ((:instance near+2 (y (near+ y n)))
+			(:instance near+2 (x y) (y (near+ x n)))
+			(:instance near+-pos)
+			(:instance near+-pos (x y)))))))
+
+(local
+ (defthm near+-near+-3
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near+ x n) (near+ y n)))
+		  (= (expo x) (expo y)))
+	     (and (<= x (near+-witness x y n))
+		  (<= (near+-witness x y n) y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near+-monotone)
+		  :use ((:instance near+-near+-2)
+			(:instance near+-monotone))))))
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance near+-choice)
+			(:instance trunc-upper-pos)
+			(:instance away-lower-pos)))))
+
+(defthm near+>=trunc
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (>= (near+ x n) (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance near+-choice)
+			(:instance trunc-upper-pos)
+			(:instance away-lower-pos)))))
+(local
+ (defthm near+-near+-4
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near+ x n) (near+ y n))
+		  (= (expo x) (expo y)))
+	     (<= (expo (near+-witness x y n)) (expo y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (near+-witness) ( abs-away away-lower-pos))
+		  :use ((:instance near+<=away (x y))
+			(:instance away-exactp-d (x y))
+			(:instance near+-pos)
+;			(:instance away-pos (x y))
+			(:instance expo-upper-2 (x (near+-witness x y n)) (n (1+ (expo y)))))))))
+
+
+
+
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (equal (equal (near+ x n) 0)
+                  (equal x 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable near+))))
+
+(local
+ (defthm near+-near+-5
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near+ x n) (near+ y n))
+		  (= (expo x) (expo y)))
+	     (integerp (* (near+ x n) (expt 2 (- (1- n) (expo y))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near+ expo-trunc abs-trunc abs-away)
+		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near+ x n)))
+			(:instance expo-monotone (x (trunc x n)) (y (near+ x n)))
+			(:instance near+-0-0)
+;			(:instance trunc-pos)
+			(:instance near+-pos)
+			(:instance expo-trunc)
+;			(:instance trunc-0-0)
+			(:instance near+>=trunc))))))
+
+(local
+ (defthm near+-near+-6
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near+ x n) (near+ y n))
+		  (= (expo x) (expo y)))
+	     (integerp (* (near+ y n) (expt 2 (- (1- n) (expo y))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near+ expo-trunc abs-trunc abs-away)
+		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near+ y n)))
+			(:instance expo-monotone (x (trunc x n)) (y (near+ y n)))
+			(:instance near+-0-0)
+			(:instance near+-monotone)
+;			(:instance trunc-pos)
+			(:instance near+-pos)
+			(:instance expo-trunc)
+;			(:instance trunc-0-0)
+			(:instance near+>=trunc))))))
+
+(local
+ (defthm near+-near+-7
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k))
+	     (= (+ (* x (expt 2 (1- k)))
+		   (* y (expt 2 (1- k))))
+		(* (/ (+ x y) 2) (expt 2 k))))
+    :hints (("Goal" :in-theory (enable expt)))
+  :rule-classes ()))
+
+(local
+ (defthm near+-near+-8
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+	          (integerp (* x (expt 2 (1- k))))
+	          (integerp (* y (expt 2 (1- k)))))
+	     (integerp (* (/ (+ x y) 2) (expt 2 k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance near+-near+-7))))))
+
+(local
+ (defthm near+-near+-9
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near+ x n) (near+ y n))
+		  (= (expo x) (expo y)))
+	     (exactp (near+-witness x y n) (1+ n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable near+-witness)
+           :use ((:instance near+-near+-5)
+			(:instance near+-near+-6)
+			(:instance near+-near+-4)
+			(:instance near+-near+-8 (x (near+ x n)) (y (near+ y n)) (k (- n (expo y))))
+			(:instance exactp->=-expo (n (1+ n)) (e (expo y)) (x (near+-witness x y n))))))))
+
+(defthm near+-near+-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near+ x n) (near+ y n))))
+	     (and (<= x (near+-witness x y n))
+		  (<= (near+-witness x y n) y)
+		  (exactp (near+-witness x y n) (1+ n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near+ near+-monotone)
+		  :use ((:instance near+-near+-2)
+			(:instance near+-near+-1)
+			(:instance near+-near+-9)
+			(:instance near+-monotone)))))
+
+(local
+ (defthm near+-near+-10
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< x y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (= (near+ y k) (near+ x k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near+ near+-monotone)
+		  :use ((:instance near+-near+-lemma (n k))
+			(:instance exactp-<= (x (near+-witness x y k)) (m (1+ k)) (n (1+ n)))
+			(:instance fp+2 (x a) (y (near+-witness x y k)) (n (1+ n))))))))
+
+(defthm near+-near+
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near+ y k) (near+ x k)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance near+-near+-10)
+			(:instance near+-monotone (n k) (x y) (y x))))))
+
+(local
+(defthm near+-a-a-1
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (> (near+ x n) a))
+	     (>= (near+ x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance fp+2 (x a) (y (near+ x n)))
+			;(:instance exactp-near+)
+                        )))))
+
+(local
+(defthm near+-a-a-2
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (rationalp d) (> d 0)
+		  (integerp n) (> n 0)
+		  (<= (near+ x n) a)
+		  (> x (+ a d)))
+	     (> (abs (- (near+ x n) x))
+		(abs (- (+ a d d)
+			x))))
+  :rule-classes ()))
+
+(local
+(defthm near+-a-a-3
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (<= (near+ x n) a)
+		  (> x (+ a (expt 2 (- (expo a) n)))))
+	     (> (abs (- (near+ x n) x))
+		(abs (- (+ a 
+			   (expt 2 (- (expo a) n))
+			   (expt 2 (- (expo a) n)))
+			x))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near+-a-a-2 (d (expt 2 (- (expo a) n))))
+;			(:instance expt-pos (x (- (expo a) n)))
+                        )))))
+
+(local
+(defthm near+-a-a-4
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (<= (near+ x n) a)
+		  (> x (+ a (expt 2 (- (expo a) n)))))
+	     (> (abs (- (near+ x n) x))
+		(abs (- (+ a (expt 2 (- (1+ (expo a)) n)))
+			x))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-a-a-3)
+			(:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))
+
+(defthm near+-a-a
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (> x (+ a (expt 2 (- (expo a) n)))))
+	     (>= (near+ x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near+2 (y (+ a (expt 2 (- (1+ (expo a)) n)))))
+			(:instance near+-a-a-4)
+			(:instance near+-a-a-1)
+			(:instance fp+1 (x a))
+;			(:instance expt-pos (x (- (1+ (expo a)) n)))
+                        ))))
+
+(local
+(defthm near+-a-b-1
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (rationalp d) (> d 0)
+		  (integerp n) (> n 0)
+		  (>= (near+ x n) (+ a d d))
+		  (< x (+ a d)))
+	     (> (abs (- (near+ x n) x))
+		(abs (- a x))))
+  :rule-classes ()))
+
+(local
+(defthm near+-a-b-2
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (>= (near+ x n) 
+		      (+ a
+			 (expt 2 (- (expo a) n))
+			 (expt 2 (- (expo a) n))))
+		  (< x (+ a (expt 2 (- (expo a) n)))))
+	     (> (abs (- (near+ x n) x))
+		(abs (- a x))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near+-a-b-1 (d (expt 2 (- (expo a) n))))
+;			(:instance expt-pos (x (- (expo a) n)))
+                        )))))
+
+(local
+(defthm near+-a-b-3
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (>= (near+ x n) 
+		      (+ a (expt 2 (- (1+ (expo a)) n))))
+		  (< x (+ a (expt 2 (- (expo a) n)))))
+	     (> (abs (- (near+ x n) x))
+		(abs (- a x))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-a-b-2)
+			(:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))
+
+(defthm near+-a-b
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x (+ a (expt 2 (- (expo a) n)))))
+	     (<= (near+ x n) a))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+2 (y a))
+			(:instance near+-a-b-3)
+			(:instance near+-a-a-1)))))
+
+(local
+(defthm near+-a-c-1
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (>= x a))
+	     (>= (near+ x n) a))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-monotone (x a) (y x))
+			(:instance near+-choice (x a))
+			(:instance trunc-exactp-b (x a))
+			(:instance away-exactp-b (x a)))))))
+
+(local
+(defthm near+-a-c-2
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a))
+	     (>= a 
+		 (+ (expt 2 (expo x))
+		    (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance expo-lower-bound)
+			(:instance fp+2 (x (expt 2 (expo x))) (y a))
+			(:instance exactp-2**n (n (expo x)) (m n)))))))
+
+(local
+(defthm near+-a-c-3
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (> x (- a (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance expt-weak-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))
+
+(local
+(defthm near+-a-c-4
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (= (expo (- a (expt 2 (- (1+ (expo x)) n))))
+		(expo x)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near+-a-c-2)
+			(:instance near+-a-c-3)
+;			(:instance expt-pos (x (expo x)))
+			(:instance expo-upper-bound)
+			(:instance expo-unique
+				   (x (- a (expt 2 (- (1+ (expo x)) n))))
+				   (n (expo x))))))))
+
+(local
+(defthm near+-a-c-5
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (integerp (* (- a (expt 2 (- (1+ (expo x)) n)))
+			  (expt 2 (- (1- n) (expo x))))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance expt-split (r 2) (i (- (1+ (expo x)) n)) (j (- (1- n) (expo x))))
+			(:instance exactp-<=-expo (x a) (e (expo x)))
+			(:instance near+-a-c-3)
+			(:instance expo-monotone (x (- a (expt 2 (- (1+ (expo x)) n)))) (y a))
+			(:instance expo-monotone (y a)))))))
+
+(local
+(defthm near+-a-c-6
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (exactp (- a (expt 2 (- (1+ (expo x)) n)))
+		     n))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable; expt ;expt-pos
+                              )
+		  :use ((:instance exactp2 (x (- a (expt 2 (- (1+ (expo x)) n)))))
+			(:instance near+-a-c-5)
+			(:instance near+-a-c-2)
+;			(:instance expt-pos (x (expo x)))
+			(:instance near+-a-c-4))))))
+
+(local
+(defthm near+-a-c-7
+    (implies (and (rationalp x)
+		  (rationalp a)
+		  (rationalp e)
+		  (> x (- a e)))
+	     (> x (+ (- a (* 2 e))
+		     e)))
+  :rule-classes ()))
+
+(local
+(defthm near+-a-c-8
+    (implies (and (rationalp x)
+		  (rationalp a)
+		  (integerp n)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (> x (+ (- a (expt 2 (- (1+ (expo x)) n)))
+		     (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance expt-split (r 2) (i 1) (j (- (expo x) n)))
+			(:instance near+-a-c-7 (e (expt 2 (- (expo x) n)))))))))
+
+(local
+(defthm near+-a-c-9
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (> (- a (expt 2 (- (1+ (expo x)) n)))
+		0))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near+-a-c-2)
+;			(:instance expt-pos (x (expo x)))
+                        )))))
+
+(defthm near+-a-c
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (>= (near+ x n) a))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-a-a (a (- a (expt 2 (- (1+ (expo x)) n)))))
+			(:instance near+-a-c-8)
+			(:instance near+-a-c-6)
+			(:instance near+-a-c-4)
+			(:instance near+-a-c-9)))))
+
+(local
+ (defthm near+-exact-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
+	       (and (< f 1) (< 0 f))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable re)
+           :use ((:instance fl-def-linear (x (* (expt 2 (1- n)) (sig x))))
+			(:instance exactp))))))
+
+(local
+ (defthm near+-exact-2
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (exactp x (1+ n)))
+	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
+	       (integerp (* 2 f))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable re expt)
+           :use ((:instance exactp (n (1+ n))))))))
+
+(local
+ (defthm near+-exact-3
+    (implies (and (integerp 2f)
+		  (< 0 2f)
+		  (< 2f 2))
+	     (= 2f 1))
+  :rule-classes ()))
+
+(local
+ (defthm near+-exact-4
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n)))
+	     (= (re (* (expt 2 (1- n)) (sig x)))
+		1/2))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-exact-1)
+			(:instance near+-exact-2)
+			(:instance near+-exact-3 (2f (* 2 (re (* (expt 2 (1- n)) (sig x)))))))))))
+
+(local
+ (defthm near+-exact-10
+     (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n)))
+	     (= (near+ x n)
+		(* (cg (* (expt 2 (1- n)) (sig x)))
+		   (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+)
+			(:instance near+-exact-4)
+			(:instance away))))))
+
+(local
+ (defthm near+-exact-11
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n)))
+	     (= (near+ x n)
+		(* (1+ (fl (* (expt 2 (1- n)) (sig x))))
+		   (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable near+ re)
+           :use ((:instance near+-exact-10)
+                 (:instance near+-exact-1)
+                 (:instance fl-cg (x (* (expt 2 (1- n)) (sig x)))))))))
+
+(local
+ (defthm near+-exact-12
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n)))
+	     (= (* (expt 2 (- (- n 2) (expo x)))
+		   (* (1+ (fl (* (expt 2 (1- n)) (sig x))))
+		      (expt 2 (- (1+ (expo x)) n))))
+		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
+		   2)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable a15)
+           :use ((:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (expt 2 (- (1+ (expo x)) n)))))))))
+
+(local
+ (defthm near+-exact-13
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n)))
+	     (= (* (expt 2 (- (- n 2) (expo x)))
+		   (near+ x n))
+		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
+		   2)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-exact-11)
+			(:instance near+-exact-12))))))
+
+(local
+(defthm near+-est-1
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (> (abs (- x (near+ x n)))
+		     (expt 2 (- (expo x) n))))
+	     (< (trunc x n)
+		(- x (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+2 (y (trunc x n)))
+			(:instance trunc-exactp-a)
+;			(:instance trunc-pos)
+			(:instance trunc-upper-pos))))))
+
+(local
+(defthm near+-est-2
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (> (abs (- x (near+ x n)))
+		     (expt 2 (- (expo x) n))))
+	     (> (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable near+-exactp-c)
+           :use ((:instance near+2 (y (away x n)))
+			(:instance away-exactp-a)
+;			(:instance away-pos)
+			(:instance away-lower-pos))))))
+
+(local
+(defthm near+-est-3
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (> (abs (- x (near+ x n)))
+		     (expt 2 (- (expo x) n))))
+	     (> (away x n)
+		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable a15)
+		  :use ((:instance near+-est-1)
+			(:instance expt-split (r 2) (i (- (expo x) n)) (j 1))
+			(:instance near+-est-2))))))
+
+(local
+(defthm near+-est-4
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (> (abs (- x (near+ x n)))
+		     (expt 2 (- (expo x) n))))
+	     (> x
+		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-est-3)
+			(:instance fp+1 (x (trunc x n)))
+			(:instance trunc-exactp-a)
+;			(:instance trunc-pos)
+			(:instance expo-trunc)
+			(:instance away-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
+
+
+
+(encapsulate () 
+  (local 
+   (defthm near+-est-support
+     (implies (and (integerp n) (> n 0)
+                   (rationalp x) (> x 0))
+              (<= (abs (- x (near+ x n)))
+                  (expt 2 (- (expo x) n))))
+     :rule-classes ()
+     :hints (("goal" :use ((:instance near+-est-4)
+                           (:instance trunc-lower-1))))))
+
+  (defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+    :hints (("Goal" :cases ((not (> x 0)))
+             :in-theory (enable near+-minus expo-minus))
+            ("Subgoal 2" :use ((:instance near+-est-support)))
+            ("Subgoal 1" :use ((:instance near+-est-support
+                                          (x (* -1 x))))))
+    :rule-classes ()))
+
+
+
+(local
+(defthm near+-power-b-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		 (expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance exactp-2**n (n (1+ (expo x))) (m n))
+;			(:instance expt-pos (x (- (expo x) n)))
+			(:instance trunc-exactp-c 
+				   (x (+ x (expt 2 (- (expo x) n))))
+				   (a (expt 2 (1+ (expo x))))))))))
+
+(local
+(defthm near+-power-b-2
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x))))
+		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+			  (expt 2 (1+ (expo x))))))
+	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-power-b-1))))))
+
+(local
+(defthm near+-power-b-3
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x))))
+		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+			  (expt 2 (1+ (expo x))))))
+	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		 (+ (expt 2 (1+ (expo x)))
+		    (expt 2 (- (+ 2 (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near+-power-b-2)
+			(:instance exactp-2**n (n (1+ (expo x))) (m n))
+			(:instance trunc-exactp-a (x (+ x (expt 2 (- (expo x) n)))))
+;			(:instance expt-pos (x (1+ (expo x))))
+			(:instance expo-2**n (n (1+ (expo x))))
+			(:instance fp+2 
+				   (x (expt 2 (1+ (expo x))))
+				   (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))
+
+(local
+(defthm near+-power-b-4
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x))))
+		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+			  (expt 2 (1+ (expo x))))))
+	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-power-b-3)
+			(:instance expo-upper-bound)
+			(:instance expt-weak-monotone (n (- (expo x) n)) (m (- (+ 2 (expo x)) n))))))))
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use (near+trunc
+			(:instance near+-power-b-4)
+			(:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
+;			(:instance expt-pos (x (- (expo x) n)))
+                        ))))
+
+
+(local (include-book "../../arithmetic/top"))
+
+; The next two lemmas are copied from near-proofs.lisp.
+
+(defthm plus-near-1
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                )
+           (= (re (* (expt 2 (1- k)) (sig y)))
+              (re (* (expt 2 (1- (+ k (- (expo (+ x y)) (expo y)))))
+                     (sig (+ x y))))))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (enable re sig exactp expt-split expt-minus))))
+
+(defthm plus-near-2
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y)))))
+           (iff (evenp (fl (* (expt 2 (1- k)) (sig y))))
+                (evenp (fl (* (expt 2
+                                    (1- (+ k (- (expo (+ x y)) (expo y)))))
+                              (sig (+ x y)))))))
+  :otf-flg t
+  :rule-classes nil 
+  :hints (("Goal" :in-theory (e/d (expt-split
+                                   expt-minus
+                                   exactp sig ; EXPT-SPLIT-leading-constant
+                                   evenp ;this is sort of cheating...
+                                   ) ())
+           :use ((:instance exactp2 (n (+ k (expo x) (- (expo y)))))
+                 (:instance exactp-<=
+                            (m (+ -1 k (expo x) (- (expo y))))
+                            (n (+ k (expo x) (- (expo y)))))))))
+
+(defthm plus-near+
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y)))))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                     (+ k (- (expo (+ x y)) (expo y))))))
+  :hints (("Goal" :in-theory (enable near+)
+           :use (plus-trunc plus-away plus-near-1 plus-near-2
+                            (:instance exactp-<=
+                                       (m (+ -1 k (expo x) (* -1 (expo y))))
+                                       (n (+ k (expo x) (* -1 (expo y))))))))
+  :rule-classes nil)
diff -Nru acl2-6.2/books/rtl/rel9/support/support/near+.lisp acl2-6.3/books/rtl/rel9/support/support/near+.lisp
--- acl2-6.2/books/rtl/rel9/support/support/near+.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/near+.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,467 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "near+-proofs"))
+
+;; Necessary functions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+
+;;
+;; New stuff:
+;;
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+(defthm near+trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (= (near+ x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) n)))		
+  :rule-classes ())
+
+;why disabled?
+(defthmd near+-minus
+  (= (near+ (* -1 x) n) 
+     (* -1 (near+ x n))))
+
+;why disabled?
+(defthmd near+-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near+ (* x (expt 2 k)) n)
+		(* (near+ x n) (expt 2 k)))))
+
+
+;bad name!
+(defthm sgn-near+-2
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0))
+           (= (near+ x n)
+              (* (sgn x) (near+ (abs x) n))))
+  :rule-classes ())
+
+(defthm sgn-near+
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near+ x n))
+		    (sgn x))))
+
+(defthm near+-0
+  (equal (near+ 0 n)
+         0))
+
+;delete?
+(defthm near+-1-1
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n)
+                (> n 0))
+           (= (- x (trunc x n))
+              (* (expt 2 (- (1+ (expo x)) n)) (re (* (expt 2 (1- n)) (sig x))))))
+  :rule-classes ())
+
+;delete?
+(defthm near+-1-3
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n)
+                (> n 0)
+                (not (integerp (* (expt 2 (1- n)) (sig x)))))
+           (= (- (away x n) x)
+              (* (expt 2 (- (1+ (expo x)) n)) (- 1 (re (* (expt 2 (1- n)) (sig x)))))))
+  :rule-classes ())
+
+
+
+
+(defthm near+1-a
+    (implies (and (rationalp x)
+                  (integerp n)
+		  (< (abs (- x (trunc x n))) (abs (- (away x n) x))))
+	     (= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+1-b
+    (implies (and (rationalp x)
+                  (integerp n)
+ 		  (> (abs (- x (trunc x n))) (abs (- (away x n) x))))
+	     (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+;;
+;; note we have a proof for when "n <= 0". Fri Oct 13 10:58:24 2006
+;;
+
+
+(defthm near+2-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp y n)
+		  (= (near+ x n) (trunc x n)))
+	     (>= (abs (- x y)) (- x (trunc x n))))
+  :rule-classes ())
+
+(defthm near+2-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp y n)
+		  (= (near+ x n) (away x n)))
+	     (>= (abs (- x y)) (- (away x n) x)))
+  :rule-classes ())
+
+(defthm near+-choice
+  (or (= (near+ x n) (trunc x n))
+      (= (near+ x n) (away x n)))
+  :rule-classes ())
+
+;; (defthm near+2
+;;     (implies (and (rationalp x)
+;; 		  (rationalp y)
+;; 		  (> x 0)
+;; 		  (> y 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (exactp y n))
+;; 	     (>= (abs (- x y)) (abs (- x (near+ x n)))))
+;;   :rule-classes ())
+
+(defthm near+2
+  (implies (and (exactp y n)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (>= (abs (- x y)) (abs (- x (near+ x n)))))
+  :rule-classes ())
+
+
+
+(defthm near+-exactp-a
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (exactp (near+ x n) n)))
+
+(defthm sgn-near+-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+              (= (near+ x n)
+                 (* (sgn x) (near+ (abs x) n))))
+     :rule-classes ())
+
+
+(defthm near+-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near+ x n))
+		  (exactp x n)))
+  :rule-classes ())
+
+
+
+;; (defthm near+-exactp-c
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (>= a x))
+;; 	     (>= a (near+ x n))))
+
+;; (defthm near+-exactp-d
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (<= a x))
+;; 	     (<= a (near+ x n))))
+
+(defthm near+-exactp-c
+       (implies (and (rationalp x)
+                     (integerp n)
+                     (> n 0)
+                     (rationalp a)
+                     (exactp a n)
+                     (>= a x))
+                (>= a (near+ x n))))
+     
+(defthm near+-exactp-d
+       (implies (and (rationalp x)
+                     (integerp n)
+                     (> n 0)
+                     (rationalp a)
+                     (exactp a n)
+                     (<= a x))
+                (<= a (near+ x n))))
+
+
+(defthm near+-pos
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (> (near+ x n) 0))
+  :rule-classes :linear)
+
+;; (defthm near+-monotone
+;;   (implies (and (<= x y)
+;;                 (rationalp x)
+;;                 (rationalp y)
+;;                 (< 0 x)
+;;                 (integerp n)
+;;                 (> n 0))
+;;            (<= (near+ x n) (near+ y n)))
+;;   :hints (("Goal" :in-theory (disable near+ trunc-exactp-a away-exactp-a)
+;;            :use ((:instance near+-pos)
+;;                  (:instance near+-pos (x y))
+;;                  (:instance near+2 (y (near+ y n)))
+;;                  (:instance near+2 (x y) (y (near+ x n)))))))
+
+
+(defthm near+-monotone
+   (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                ;(integerp n)
+                (natp n))
+           (<= (near+ x n) (near+ y n))))
+ 
+
+
+(defund near+-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near+ x n) (near+ y n)) 2)
+    (expt 2 (expo y))))
+
+(defthm near+<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near+ x n) (away x n)))
+  :rule-classes ())
+
+(defthm near+>=trunc
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp n)
+                (> n 0))
+           (>= (near+ x n) (trunc x n)))
+  :rule-classes ())
+
+
+(defthm near+-neg
+    (implies (and (< x 0)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (near+ x n) 0))
+  :rule-classes :linear)
+
+(defthm near+-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (equal (equal (near+ x n) 0)
+                  (equal x 0)))
+  :rule-classes ())
+
+(defthm near+-near+-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near+ x n) (near+ y n))))
+	     (and (<= x (near+-witness x y n))
+		  (<= (near+-witness x y n) y)
+		  (exactp (near+-witness x y n) (1+ n))))
+  :rule-classes ())
+
+(defthm near+-near+
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near+ y k) (near+ x k)))
+  :rule-classes ())
+
+(defthm near+-a-a
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (> x (+ a (expt 2 (- (expo a) n)))))
+	     (>= (near+ x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
+  :rule-classes ())
+
+
+
+(defthm near+-a-b
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x (+ a (expt 2 (- (expo a) n)))))
+	     (<= (near+ x n) a))
+  :rule-classes ())
+
+(defthm near+-a-c
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (>= (near+ x n) a))
+  :rule-classes ())
+
+
+
+(defthm near+-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near+ x n)))
+		 (expt 2 (- (expo x) n))))
+    :rule-classes ())
+
+
+(defthm near+-power
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near+ x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+
+(defthm plus-near+
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y)))))
+           (= (+ x (near+ y k))
+              (near+ (+ x y)
+                     (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes nil)
+
+;BOZO clean cruft from this book
diff -Nru acl2-6.2/books/rtl/rel9/support/support/near-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/near-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/near-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/near-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,2662 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+(in-package "ACL2")
+
+(local (include-book "../../arithmetic/top"))
+(local (include-book "float"))
+(local (include-book "away"))
+(local (include-book "trunc"))
+
+;; Necessary functions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+
+;;
+;; New stuff:
+;;
+
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defthm near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n)))
+  :hints (("goal" :in-theory (enable near sig-minus))))
+
+(defthm near-of-non-rationalp-is-0
+  (implies (not (rationalp x))
+           (equal (near x n)
+                  0))
+  :hints (("goal" :in-theory (enable near sig))))
+
+(defthm near-choice
+  (or (= (near x n) (trunc x n))
+      (= (near x n) (away x n)))
+  :hints (("Goal" :in-theory (enable near)))
+  :rule-classes ())
+
+;BOZO better r-c on these? :rewrite?
+(defthm near-pos
+  (implies (and (< 0 x)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+                )
+           (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear)
+  :hints (("Goal" :use ((:instance near-choice)))))
+
+(defthm near-neg
+    (implies (and (< x 0)
+		  (< 0 n)
+                  (rationalp x)
+		  (integerp n)
+		  )
+	     (< (near x n) 0))
+  :rule-classes (:type-prescription :linear)
+  :hints (("Goal" :use ((:instance near-choice)))))
+
+(defthm near-rational-type-prescription
+  (rationalp (near x n))
+  :rule-classes (:rewrite :type-prescription))
+
+(defthm near-non-negative-rational-type-prescription
+  (implies (<= 0 x)
+           (and (<= 0 (near x n))
+                (rationalp (near x n))))
+  :hints (("Goal" :use ((:instance near-choice))))
+  :rule-classes :type-prescription)
+
+(defthm near-non-positive-rational-type-prescription
+  (implies (<= x 0)
+           (and (<= (near x n) 0)
+                (rationalp (near x n))))
+  :hints (("Goal" :use ((:instance near-choice))))
+  :rule-classes :type-prescription)
+
+
+(local (defthm near1-1
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  ;(> n 0)
+                  )
+	     (= (- x (trunc x n))
+		(* (expt 2 (- (1+ (expo x)) n)) (re (* (expt 2 (1- n)) (sig x))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable re a15)
+		  :use ((:instance trunc)
+			(:instance fp-rep))))))
+
+(local (defthm near1-3
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+;		  (> n 0)
+		  (not (integerp (* (expt 2 (1- n)) (sig x))))
+                  )
+	     (= (- (away x n) x)
+		(* (expt 2 (- (1+ (expo x)) n)) (- 1 (re (* (expt 2 (1- n)) (sig x)))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable re a15)
+		  :use ((:instance away)
+			(:instance fl-cg (x (* (expt 2 (1- n)) (sig x))))
+			(:instance fp-rep)
+		)))))
+
+
+(local (defthm near1-6
+    (implies (and (rationalp p)
+		  (> p 0)
+		  (rationalp f)
+		  (< (* p f) (* p (- 1 f))))
+	     (< f 1/2))
+;    :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE)))
+    :rule-classes ()))
+
+(local (defthm near1-7
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0)
+		  (not (integerp (* (expt 2 (1- n)) (sig x)))) ;easy to drop, since trunc, away, and near all
+                    ;= x
+		  (< (- x (trunc x n)) (- (away x n) x)))
+	     (= (near x n) (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance near1-1)
+			(:instance near1-3)
+			(:instance near1-6 
+				   (p (expt 2 (- (1+ (expo x)) n))) 
+				   (f (re (* (expt 2 (1- n)) (sig x)))))
+			(:instance near))))))
+
+(local (defthm near1-8
+    (implies (and (rationalp p)
+		  (> p 0)
+		  (rationalp f)
+		  (> (* p f) (* p (- 1 f))))
+	     (> f 1/2))
+    :hints (("Goal" :in-theory (disable LESS-THAN-MULTIPLY-THROUGH-BY-inverted-factor-FROM-LEFT-HAND-SIDE)))
+    :rule-classes ()))
+
+(local (defthm near1-9
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0)
+		  (not (integerp (* (expt 2 (1- n)) (sig x))))
+		  (> (- x (trunc x n)) (- (away x n) x)))
+	     (= (near x n) (away x n)))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance near1-1)
+			(:instance near1-3)
+			(:instance near1-8 
+				   (p (expt 2 (- (1+ (expo x)) n))) 
+				   (f (re (* (expt 2 (1- n)) (sig x)))))
+			(:instance near))))))
+
+
+(defthm near1-a-helper
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0)
+		  (< (- x (trunc x n)) (- (away x n) x)))
+	     (= (near x n) (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp)
+		  :use ((:instance near1-7)
+                        trunc-exactp-b
+                        away-exactp-b
+			;(:instance near1-4)
+			;(:instance near1-5)
+                        ))))
+
+;disable re?
+;use  near1-7? no, this is the "negative n case"
+(defthm near1-a-negative-n
+  (implies (and (rationalp x)
+                (>= x 0)
+                (integerp n)
+                (<= n 0)
+                (< (- x (trunc x n)) (- (away x n) x)))
+           (= (near x n) (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable sgn
+                                      re
+;                                      sig
+                                      near; expo>=-2
+                                      expt-split)
+                              '(;integerp-prod
+                                expt-compare
+                                a15
+                                ;expo>=-2
+                                ))
+           :use ((:instance expt-weak-monotone (n n) (m 0))
+                 (:instance expt-weak-monotone (n n) (m -1))
+                 sig-upper-bound
+                 (:instance fl-unique (x (* 1/2 (SIG X) (EXPT 2 N))) (n 0))))))
+
+
+(local 
+ (defthm near1-a-support
+   (implies (and (< (- x (trunc x n)) (- (away x n) x))
+                 (rationalp x)
+                 (>= x 0)
+                 (integerp n)
+; (> n 0)
+                 )
+            (equal (near x n)
+                   (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near trunc away)
+           :use (near1-a-helper near1-a-negative-n)))))
+
+;; (i-am-here)
+;; Thu Oct 12 14:41:22 2006
+
+(local 
+  (defthm trunc-abs-reduce
+    (implies (and (< x 0)
+                  (integerp n)
+                  (rationalp x))
+             (equal (abs (+ x (* -1 (trunc x n))))
+                    (- (trunc x n) x)))
+    :hints (("Goal" :in-theory (enable trunc-minus)
+             :use ((:instance trunc-upper-pos
+                              (x (* -1 x))))))))
+
+
+(local 
+  (defthm trunc-abs-reduce-2
+    (implies (and (>= x 0)
+                  (integerp n)
+                  (rationalp x))
+             (equal (abs (+ x (* -1 (trunc x n))))
+                    (- x (trunc x n))))
+    :hints (("Goal" :in-theory (enable trunc-minus)
+             :use ((:instance trunc-upper-pos))))))
+
+
+
+  
+(local 
+  (defthm away-abs-reduce
+    (implies (and (< x 0)
+                  (integerp n)
+                  (rationalp x))
+             (equal (abs (+ (away x n) (* -1 x)))
+                    (+ x (* -1 (away x n)))))
+    :hints (("Goal" :in-theory (enable away-minus)
+             :use ((:instance away-lower-pos
+                              (x (* -1 x))))))))
+
+
+(local 
+  (defthm away-abs-reduce-2
+    (implies (and (>= x 0)
+                  (integerp n)
+                  (rationalp x))
+             (equal (abs (+ (away x n) (* -1 x)))
+                    (+ (away x n) (* -1 x))))
+    :hints (("Goal" :in-theory (enable away-minus)
+             :use ((:instance away-lower-pos))))))
+
+
+
+(defthm near1-a
+         (implies (and (< (abs (- x (trunc x n)))
+                          (abs (- (away x n) x)))
+                       (rationalp x)
+     		  (integerp n))
+     	     (equal (near x n)
+                         (trunc x n)))
+         :hints (("Goal" :cases ((< x 0))
+                  :in-theory (enable trunc-minus away-minus abs near-minus))
+                 ("Subgoal 2" :use ((:instance near1-a-support)
+                                    (:instance away-lower-pos)))
+                 ("Subgoal 1" :use ((:instance near1-a-support
+                                               (x (* -1 x)))
+                                    (:instance away-lower-pos
+                                               (x (* -1 x))))))
+       :rule-classes ())
+
+
+
+(local 
+ (defthm near1-b-support
+    (implies (and (> (- x (trunc x n)) (- (away x n) x))
+                  (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0)
+		  )
+	     (equal (near x n)
+                    (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp)
+		  :use ((:instance near1-9)
+                        trunc-exactp-b
+                        away-exactp-b)))))
+
+
+(local 
+ (defthm near1-b-lemma ;; the interesting case.
+   (implies (and (> (abs (- x (trunc x n))) (abs (- (away x n) x)))
+                 (rationalp x)
+                 (> n 0)
+                 (integerp n))
+            (equal (near x n)
+                   (away x n)))
+   :hints (("Goal" :cases ((< x 0))
+            :in-theory (enable trunc-minus away-minus abs near-minus))
+           ("Subgoal 2" :use ((:instance near1-b-support)
+                              (:instance trunc-upper-pos)))
+           ("Subgoal 1" :use ((:instance near1-b-support
+                                         (x (* -1 x)))
+                              (:instance trunc-upper-pos
+                                         (x (* -1 x))))))))
+
+ 
+
+(encapsulate () 
+         (local 
+          (encapsulate ()
+                       (local 
+                        (defthm fl-1/2-sig-x-is-zero-lemma
+                          (implies (and (rationalp x)
+                                        (rationalp y)
+                                        (< 0 y)
+                                        (<= y 1/2))
+                                   (equal (fl (* (sig x) y))
+                                          0))
+                          :hints (("Goal" :in-theory (disable sig-upper-bound
+                                                              sig-lower-bound)
+                                   :use ((:instance sig-upper-bound)
+                                         (:instance sig-lower-bound))))))
+
+                       (defthm near1-b-1-2-1
+                         (implies (rationalp x)
+                                  (equal (fl (* 1/2 (sig x)))
+                                         0))
+                         :hints (("Goal" :use ((:instance fl-1/2-sig-x-is-zero-lemma
+                                                          (y 1/2))))))
+           
+
+                       (defthm near1-b-1-2-2
+                         (implies (rationalp x)
+                                  (equal (EXPT 2 (+ 1 (EXPO X)))
+                                         (* 2 (EXPT 2 (expo x)))))
+                         :hints (("Goal" :use ((:instance a15 (i 2) (j1 1) (j2 (expo x)))))))))
+
+         (local 
+          (encapsulate ()
+                       (local 
+                        (defthm local-expt-2-expand
+                          (implies (rationalp x)
+                                   (equal (EXPT 2 (+ 1 (EXPO X)))
+                                          (* 2 (EXPT 2 (expo x)))))
+                          :hints (("Goal" :use ((:instance a15 (i 2) (j1 1) (j2 (expo x))))))))
+
+    
+                       (defthm integer-n-less-than-expt
+                         (implies (and (integerp n)
+                                       (rationalp x)
+                                       (< 0 x)
+                                       (<= n 0)
+                                       (not (equal n 0)))
+                                  (< x (EXPT 2 (+ 1 (EXPO X) (* -1 N)))))
+                         :hints (("Goal" :in-theory (disable expo-upper-bound
+                                                             expt-compare
+                                                             EXPO-BOUND-ERIC
+                                                             EXPO-COMPARISON-REWRITE-TO-BOUND-2
+                                                             expt-strong-monotone-linear)
+                                  :use ((:instance expo-upper-bound)
+                                        (:instance expt-strong-monotone-linear
+                                                   (n (+ 1 (expo x)))
+                                                   (m (+ 1 (expo x) (* -1 n)))))))
+                         :rule-classes :linear)))
+
+
+         (local 
+          (encapsulate ()
+                       (local 
+                        (defthm local-expt-2-expand-2
+                          (implies (rationalp x)
+                                   (equal (EXPT 2 (+ 2 (EXPO X)))
+                                          (* 4 (EXPT 2 (expo x)))))
+                          :hints (("Goal" :use ((:instance a15 (i 2) (j1 2) (j2 (expo x))))))))
+
+
+
+                       (defthm integer-n-less-than-expt-2
+                         (implies (and (integerp n)
+                                       (rationalp x)
+                                       (< 0 x)
+                                       (<= n 0)
+                                       (not (equal n 0)))
+                                  (<= (* 2 x) (EXPT 2 (+ 1 (EXPO X) (* -1 N)))))
+                         :hints (("Goal" :in-theory (disable expo-comparison-rewrite-to-bound-2
+                                                             EXPO-COMPARISON-REWRITE-TO-BOUND                                        
+                                                             expo-bound-eric
+                                                             EXPT-COMPARE
+                                                             expo-upper-bound)
+                                  :use ((:instance expo-upper-bound)
+                                        (:instance expt-weak-monotone-linear
+                                                   (n (+ 2 (expo x)))
+                                                   (m (+ 1 (expo x) (* -1 n))))))))))
+         
+
+         (defthm near1-b
+           (implies (and (> (abs (- x (trunc x n))) (abs (- (away x n) x)))
+                         (rationalp x)
+                         (integerp n))
+                    (equal (near x n)
+                           (away x n)))
+           :hints (("Goal" :cases ((not (> n 0)))
+                    :in-theory (enable expt-strong-monotone-linear))
+                   ("Subgoal 2" :use ((:instance near1-b-lemma)))
+                   ("Subgoal 1" :in-theory (enable near away expo-minus re cg sgn)
+                    :cases ((not (equal n 0))))
+                   ("Subgoal 1.1" :cases ((not (< 0 x))))
+                   ("Subgoal 1.1.2" 
+                    :in-theory (e/d (near away expo-minus re cg sgn)
+                                    (expt-compare
+                                     expo-bound-eric
+                                     EXPO-COMPARISON-REWRITE-TO-BOUND-2)))
+                   ("Subgoal 1.1.1" :use ((:instance expo-upper-bound)
+                                          (:instance expo-lower-bound)
+                                          (:instance integer-n-less-than-expt
+                                                     (x (* -1 x)))
+                                          (:instance integer-n-less-than-expt-2
+                                                     (x (* -1 x))))))
+                   :rule-classes ()))
+             
+;; (i-am-here)
+
+;; (defthm near1-b
+;;   (implies (and (> (abs (- x (trunc x n))) (abs (- (away x n) x)))
+;;                 (rationalp x)
+;;                 (integerp n))
+;;            (equal (near x n)
+;;                   (away x n)))
+;;   :hints (("Goal" :cases ((not (> n 0)))
+;;            :in-theory (enable expt-strong-monotone-linear))
+;;           ("Subgoal 2" :use ((:instance near1-b-support)))
+;;           ("Subgoal 1" :case ((not (equal n 0))))))
+
+
+
+
+(defthm near2-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (>= x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp y n)
+		  (= (near x n) (trunc x n)))
+	     (>= (abs (- x y)) (- x (trunc x n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable away-exactp-c 
+				      near trunc-exactp-c)
+		  :use ((:instance near1-b)
+			(:instance away-lower-bound)
+			(:instance trunc-upper-bound)
+			(:instance trunc-exactp-c (a y))
+			(:instance away-exactp-c (a y))))))
+
+(defthm near2-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp y n)
+		  (= (near x n) (away x n)))
+	     (>= (abs (- x y)) (- (away x n) x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable away-exactp-c 
+				      trunc-exactp-c)
+		  :use ((:instance near1-a)
+			(:instance away-lower-pos)
+			(:instance trunc-upper-pos)
+			(:instance trunc-exactp-c (a y))
+			(:instance away-exactp-c (a y))))))
+
+
+
+(defthm near2-original
+    (implies (and (exactp y n)
+                  (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  )
+	     (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near)
+		  :use ((:instance near2-1)
+			(:instance near2-2)
+			(:instance near-choice)
+			(:instance away-lower-pos)
+			(:instance trunc-upper-pos)))))
+
+
+
+
+(encapsulate () 
+
+     (local 
+     (defthm equal-diff-trunc-away-1
+       (implies (and (exactp y n)
+                     (rationalp x)
+                     (> x 0)
+                     (case-split (<= x y))
+                     (rationalp y)
+                     (equal (abs (- x (trunc x n))) (abs (- (away x n)
+                                                            x)))
+                     (integerp n)
+                     (> n 0))
+     	     (>= (abs (- x y)) (abs (- x (near x n)))))
+       :hints (("Goal" :use ((:instance trunc-upper-pos)
+                             (:instance near-choice)
+                             (:instance away-lower-pos)
+                             (:instance away-exactp-c
+                                        (a y)))))))
+
+
+     (local 
+     (defthm equal-diff-trunc-away-2
+       (implies (and (exactp y n)
+                     (rationalp x)
+                     (> x 0)
+                     (case-split (<= y x))
+                     (rationalp y)
+                     (equal (abs (- x (trunc x n))) (abs (- (away x n)
+                                                            x)))
+                     (integerp n)
+                     (> n 0))
+     	     (>= (abs (- x y)) (abs (- x (near x n)))))
+       :hints (("Goal" :use ((:instance near-choice)
+                             (:instance trunc-upper-pos)
+                             (:instance away-lower-pos)
+                             (:instance trunc-exactp-c
+                                        (a y)))))))
+
+
+
+     (local
+     (defthm near2-lemma
+         (implies (and (exactp y n)
+                       (rationalp x)
+                       (> x 0)
+     		  (rationalp y)
+                       (case-split (not (equal (abs (- x (trunc x n))) (abs (- (away x n)
+                                                                               x)))))
+     		  (integerp n)
+     		  (> n 0))
+     	     (>= (abs (- x y)) (abs (- x (near x n)))))
+         :hints (("Goal" :cases ((not (> (abs (- x (trunc x n))) (abs (- (away x n)
+                                                                         x))))))
+                 ("Subgoal 2" :cases ((not (< x y))))
+                 ("Subgoal 2.2" :use  ((:instance near1-b)
+                                       (:instance trunc-upper-pos)
+                                       (:instance away-lower-pos)
+                                       (:instance away-exactp-c
+                                                  (a y))))
+                 ("Subgoal 2.1" :use  ((:instance near1-b)
+                                       (:instance trunc-upper-pos)
+                                       (:instance away-lower-pos)
+                                       (:instance trunc-exactp-c
+                                                  (a y))))
+                 ("Subgoal 1" :cases ((not (< x y))))
+                 ("Subgoal 1.2" :use  ((:instance near1-a)
+                                       (:instance trunc-upper-pos)
+                                       (:instance away-lower-pos)
+                                       (:instance away-exactp-c
+                                                  (a y))))
+                 ("Subgoal 1.1" :use  ((:instance near1-a)
+                                       (:instance trunc-upper-pos)
+                                       (:instance away-lower-pos)
+                                       (:instance trunc-exactp-c
+                                                  (a y)))))))
+
+
+     ;; (loca
+     ;; (defthm exactp-equal-trunc-equal
+     ;;   (implies (and (exactp x n)
+     ;;                 (integerp n)
+     ;;                 (rationalp x))
+     ;;            (equal (trunc x n) x))
+     ;;   :hints (("Goal" :in-theory (enable exactp trunc)
+     ;;            :use ((:instance fp-rep)
+     ;;                  (:instance a15
+     ;;                             (i 2)
+     ;;                             (j1 (+ -1 N))
+     ;;                             (j2 (+ 1 (EXPO X) (* -1 N))))))))
+
+
+
+
+     ;; (defthm exactp-equal-away-equal
+     ;;   (implies (and (exactp x n)
+     ;;                 (integerp n)
+     ;;                 (rationalp x))
+     ;;            (equal (away x n) x))
+     ;;   :hints (("Goal" :in-theory (enable cg exactp away)
+     ;;            :use ((:instance fp-rep)
+     ;;                  (:instance a15
+     ;;                             (i 2)
+     ;;                             (j1 (+ -1 N))
+     ;;                             (j2 (+ 1 (EXPO X) (* -1 N))))))))
+
+
+     (local 
+     (defthm near2-lemma-futher
+         (implies (and (exactp y n)
+                       (rationalp x)
+                       (> x 0)
+     		  (rationalp y)
+     		  (integerp n)
+     		  (> n 0))
+     	     (>= (abs (- x y)) (abs (- x (near x n)))))
+         :hints (("Goal" :cases ((equal (abs (- x (trunc x n))) (abs (- (away x n)
+                                                                               x)))))
+                 ("Subgoal 2" :use ((:instance near2-lemma)))
+                 ("Subgoal 1" :cases ((not (< x y))))
+                 ("Subgoal 1.2" :use ((:instance equal-diff-trunc-away-1)))
+                 ("Subgoal 1.1" :use ((:instance equal-diff-trunc-away-2))))))
+
+
+
+     (defthm near2
+         (implies (and (exactp y n)
+                       (rationalp x)
+     		  (rationalp y)
+     		  (integerp n)
+     		  (> n 0))
+     	     (>= (abs (- x y)) (abs (- x (near x n)))))
+         :rule-classes ()
+         :hints (("Goal" :cases ((not (> x 0)))
+                  :in-theory (enable near-minus trunc-minus away-minus
+                                     exactp-minus))
+                 ("Subgoal 2" :use ((:instance near2-lemma-futher)))
+                 ("Subgoal 1" :use ((:instance near2-lemma-futher
+                                               (x (* -1 x))
+                                               (y (* -1 y))))))))
+
+;;; Thu Oct 12 16:29:11 2006. replaced with Hanbing's version
+
+
+
+(defthm near-exactp-a
+  (implies (< 0 n) ;can't drop?
+           (exactp (near x n) n))
+  :hints (("Goal" :in-theory (disable near trunc-exactp-a away-exactp-a)
+           :use ((:instance near-choice)
+                 (:instance trunc-exactp-a)
+                 (:instance away-exactp-a)))))
+
+(defthm sgn-near-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (equal (sgn (near x n))
+		    (sgn x)))
+  :hints (("Goal" :use (near-choice
+			sgn-trunc
+			sgn-away))))
+
+(defthm near-exactp-b
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 0))
+	     (iff (= x (near x n))
+		  (exactp x n)))
+  :rule-classes ()
+  :hints (("Goal" :use (near-choice
+			trunc-exactp-b
+			away-exactp-b))))
+
+
+
+(local 
+ (defthm near-exactp-c-support
+    (implies (and (exactp a n)
+		  (>= a x)
+                  (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  )
+	     (>= a (near x n)))
+  :hints (("Goal" :use (near-choice
+			away-exactp-c
+			trunc-upper-pos)))))
+
+(local 
+ (defthm near-exactp-d-support
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (near x n)))
+  :hints (("Goal" :use (near-choice
+			away-lower-pos
+			trunc-exactp-c)))))
+
+
+(local 
+  (defthmd near-minus
+    (equal (near (* -1 x) n)
+           (* -1 (near x n)))))
+
+(defthmd near-exactp-c
+  (implies (and (exactp a n)
+                (>= a x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (rationalp a)
+                )
+           (>= a (near x n)))
+  :hints (("Goal" :cases ((< x 0))
+           :in-theory (enable near-minus))
+          ("Subgoal 2" :use ((:instance near-exactp-c-support)))
+          ("Subgoal 1" :use ((:instance near-exactp-d-support
+                                        (x (* -1 x))
+                                        (a (* -1 a)))))))
+              
+
+;; (i-am-here)
+
+(defthmd near-exactp-d
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (rationalp a)
+                (exactp a n)
+                (<= a x))
+           (<= a (near x n)))
+  :hints (("Goal" :cases ((<= x 0))
+           :in-theory (enable near-minus))
+          ("Subgoal 2" :use ((:instance near-exactp-d-support)))
+          ("Subgoal 1" :use ((:instance near-exactp-c-support
+                                        (x (* -1 x))
+                                        (a (* -1 a)))))))
+
+
+
+
+;BOZO gen!
+(local 
+ (defthm near-monotone-support
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (< 0 x)
+                (integerp n)
+                (> n 0))
+           (<= (near x n) (near y n)))
+  :hints (("Goal" :in-theory (disable near trunc-exactp-a away-exactp-a)
+           :use ((:instance near-pos)
+                 (:instance near-pos (x y))
+                 (:instance near2 (y (near y n)))
+                 (:instance near2 (x y) (y (near x n))))))))
+
+
+;(i-am-here) ;; Thu Oct 12 17:14:03 2006
+
+
+
+(defthm near-positive
+   (implies (and (< 0 x)
+                 (< 0 n)
+                 (rationalp x)
+		  (integerp n))
+            (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear))
+
+(defthmd near-negative
+  (implies (and (< x 0)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+		)
+           (< (near x n) 0))
+  :hints (("Goal" :in-theory (enable near-neg)))
+  :rule-classes (:type-prescription :linear))
+
+
+(defthm near-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (<= (near x n) (near y n)))
+  :hints (("Goal" :in-theory (enable near-minus)
+           :cases ((not (equal x 0))))
+          ("Subgoal 2" :use ((:instance near-negative
+                                          (x (* -1 y)))))
+          ("Subgoal 1" :cases ((not (> x 0))))
+          ("Subgoal 1.2" :use ((:instance
+                                near-monotone-support)))
+          ("Subgoal 1.1" :cases ((not (> y 0))))
+          ("Subgoal 1.1.2" :use ((:instance near-positive (x y))
+                                 (:instance near-positive (x (* -1 x)))))
+          ("Subgoal 1.1.1" :use ((:instance near-monotone-support
+                                            (x (* -1 y))
+                                            (y (* -1 x)))
+                                 (:instance near-positive (x (* -1 x)))))))
+
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+(local 
+ (defthm near-near-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (expo x) (expo y))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable near-witness)
+		  :use ((:instance exactp-2**n (n (expo y)) (m (1+ n)))
+			(:instance expo-upper-bound)
+			(:instance expo-monotone)
+			(:instance expt-weak-monotone (n (1+ (expo x))) (m (expo y)))
+			(:instance expo-lower-bound (x y)))))))
+
+(local
+ (defthm near-near-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near x n) (near y n))
+		  (= (expo x) (expo y)))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable near-witness)
+		  :use ((:instance near2 (y (near y n)))
+			(:instance near2 (x y) (y (near x n)))
+			(:instance near-pos)
+			(:instance near-pos (x y)))))))
+
+(local
+ (defthm near-near-3
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n)))
+		  (= (expo x) (expo y)))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near near-monotone
+                                      near-monotone-support near-witness)
+		  :use ((:instance near-near-2)
+			(:instance near-monotone-support))))))
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near)
+		  :use ((:instance near-choice)
+			(:instance trunc-upper-pos)
+			(:instance away-lower-pos)))))
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near)
+		  :use ((:instance near-choice)
+			(:instance trunc-upper-pos)
+			(:instance away-lower-pos)))))
+(local
+ (defthm near-near-4
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near x n) (near y n))
+		  (= (expo x) (expo y)))
+	     (<= (expo (near-witness x y n)) (expo y)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable near-witness)
+                              '( abs-away  away-lower-pos))
+		  :use ((:instance near<=away (x y))
+			(:instance away-exactp-d (x y))
+			(:instance near-pos)
+;			(:instance away-pos (x y))
+			(:instance expo-upper-2 (x (near-witness x y n)) (n (1+ (expo y)))))))))
+
+
+
+(defthm near-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (equal (equal (near x n) 0)
+		  (equal x 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable near))))
+
+(local
+ (defthm near-near-5
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near x n) (near y n))
+		  (= (expo x) (expo y)))
+	     (integerp (* (near x n) (expt 2 (- (1- n) (expo y))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expo-trunc EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near x n)))
+			(:instance expo-monotone (x (trunc x n)) (y (near x n)))
+;			(:instance trunc-pos)
+			(:instance near-pos)
+			(:instance expo-trunc)
+			(:instance near>=trunc))))))
+
+(local
+ (defthm near-near-6
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near x n) (near y n))
+		  (= (expo x) (expo y)))
+	     (integerp (* (near y n) (expt 2 (- (1- n) (expo y))))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expo-trunc  EXPO-COMPARISON-REWRITE-TO-BOUND-2)
+		  :use ((:instance exactp-<=-expo (e (expo y)) (x (near y n)))
+			(:instance expo-monotone (x (trunc x n)) (y (near y n)))
+			(:instance near-monotone)
+;			(:instance trunc-pos)
+			(:instance near-pos)
+			(:instance expo-trunc)
+			(:instance near>=trunc))))))
+
+;gross?
+(local
+ (defthm near-near-7
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k))
+	     (= (+ (* x (expt 2 (1- k)))
+		   (* y (expt 2 (1- k))))
+		(* (/ (+ x y) 2) (expt 2 k))))
+    :hints (("Goal" :in-theory (enable expt))) ;yuck
+  :rule-classes ()))
+
+(local
+ (defthm near-near-8
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+	          (integerp (* x (expt 2 (1- k))))
+	          (integerp (* y (expt 2 (1- k)))))
+	     (integerp (* (/ (+ x y) 2) (expt 2 k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance near-near-7))))))
+
+(local
+ (defthm near-near-9
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (< (near x n) (near y n))
+		  (= (expo x) (expo y)))
+	     (exactp (near-witness x y n) (1+ n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable near-witness)
+           :use ((:instance near-near-5)
+			(:instance near-near-6)
+			(:instance near-near-4)
+			(:instance near-near-8 (x (near x n)) (y (near y n)) (k (- n (expo y))))
+			(:instance exactp->=-expo (n (1+ n)) (e (expo y)) (x (near-witness x y n))))))))
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near near-monotone-support 
+                                      near-monotone)
+		  :use ((:instance near-near-2)
+			(:instance near-near-1)
+			(:instance near-near-9)
+			(:instance near-monotone)))))
+
+(local
+ (defthm near-near-10
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< x y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (= (near y k) (near x k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable near near-monotone)
+		  :use ((:instance near-near-lemma (n k))
+			(:instance exactp-<= (x (near-witness x y k)) (m (1+ k)) (n (1+ n)))
+			(:instance fp+2 (x a) (y (near-witness x y k)) (n (1+ n))))))))
+
+;bad name?
+(defthm near-near
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp a)
+		  (integerp n)
+		  (integerp k)
+		  (> k 0)
+		  (>= n k)		  
+		  (< 0 a)
+		  (< a x)
+		  (< 0 y)
+		  (< y (fp+ a (1+ n)))
+		  (exactp a (1+ n)))
+	     (<= (near y k) (near x k)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance near-near-10)
+			(:instance near-monotone (n k) (x y) (y x))))))
+
+
+;why disabled?
+(defthmd near-shift
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (integerp k))
+	     (= (near (* x (expt 2 k)) n)
+		(* (near x n) (expt 2 k))))
+  :hints (("goal" :in-theory (enable near)
+		  :use (trunc-shift
+			away-shift
+			(:instance sig-expo-shift (n k))))))
+
+
+(local
+ (defthm near-a-a-1
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (exactp a n)
+                 (> (near x n) a))
+            (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance fp+2 (x a) (y (near x n)))
+)))))
+
+(local
+ (defthm near-a-a-2
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (rationalp d) (> d 0)
+                 (integerp n) (> n 0)
+                 (<= (near x n) a)
+                 (> x (+ a d)))
+            (> (abs (- (near x n) x))
+               (abs (- (+ a d d)
+                       x))))
+   :rule-classes ()))
+
+(local
+ (defthm near-a-a-3
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (<= (near x n) a)
+                 (> x (+ a (expt 2 (- (expo a) n)))))
+            (> (abs (- (near x n) x))
+               (abs (- (+ a 
+                          (expt 2 (- (expo a) n))
+                          (expt 2 (- (expo a) n)))
+                       x))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;expt-pos
+                               )
+            :use ((:instance near-a-a-2 (d (expt 2 (- (expo a) n))))
+;			(:instance expt-pos (x (- (expo a) n)))
+                  )))))
+
+(local
+ (defthm near-a-a-4
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (<= (near x n) a)
+                 (> x (+ a (expt 2 (- (expo a) n)))))
+            (> (abs (- (near x n) x))
+               (abs (- (+ a (expt 2 (- (1+ (expo a)) n)))
+                       x))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-compare-equal)
+            :use ((:instance near-a-a-3)
+                         (:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))
+
+(defthm near-a-a
+  (implies (and (rationalp x) (> x 0)
+                (rationalp a) (> a 0)
+                (integerp n) (> n 0)
+                (exactp a n)
+                (> x (+ a (expt 2 (- (expo a) n)))))
+           (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+           :use ((:instance near2 (y (+ a (expt 2 (- (1+ (expo a)) n)))))
+                 (:instance near-a-a-4)
+                 (:instance near-a-a-1)
+                 (:instance fp+1 (x a))
+;			(:instance expt-pos (x (- (1+ (expo a)) n)))
+                 ))))
+
+(local
+ (defthm near-a-b-1
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (rationalp d) (> d 0)
+                 (integerp n) (> n 0)
+                 (>= (near x n) (+ a d d))
+                 (< x (+ a d)))
+            (> (abs (- (near x n) x))
+               (abs (- a x))))
+   :rule-classes ()))
+
+(local
+ (defthm near-a-b-2
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (>= (near x n) 
+                     (+ a
+                        (expt 2 (- (expo a) n))
+                        (expt 2 (- (expo a) n))))
+                 (< x (+ a (expt 2 (- (expo a) n)))))
+            (> (abs (- (near x n) x))
+               (abs (- a x))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;expt-pos
+                               )
+            :use ((:instance near-a-b-1 (d (expt 2 (- (expo a) n))))
+;			(:instance expt-pos (x (- (expo a) n)))
+                  )))))
+
+(local
+ (defthm near-a-b-3
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (>= (near x n) 
+                     (+ a (expt 2 (- (1+ (expo a)) n))))
+                 (< x (+ a (expt 2 (- (expo a) n)))))
+            (> (abs (- (near x n) x))
+               (abs (- a x))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-compare-equal)
+            :use ((:instance near-a-b-2)
+                  (:instance expt-split (r 2) (i (- (expo a) n)) (j 1)))))))
+
+(defthm near-a-b
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x (+ a (expt 2 (- (expo a) n)))))
+	     (<= (near x n) a))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near2 (y a))
+			(:instance near-a-b-3)
+			(:instance near-a-a-1)))))
+
+(local
+ (defthm near-a-c-1
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (exactp a n)
+                 (>= x a))
+            (>= (near x n) a))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance near-monotone (x a) (y x))
+                         (:instance near-choice (x a))
+                         (:instance trunc-exactp-b (x a))
+                         (:instance away-exactp-b (x a)))))))
+
+(local
+ (defthm near-a-c-2
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a))
+	     (>= a 
+		 (+ (expt 2 (expo x))
+		    (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance expo-lower-bound)
+			(:instance fp+2 (x (expt 2 (expo x))) (y a))
+			(:instance exactp-2**n (n (expo x)) (m n)))))))
+
+(local
+ (defthm near-a-c-3
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (> x (- a (expt 2 (- (expo x) n)))))
+            (> x (- a (expt 2 (- (1+ (expo x)) n)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-compare)
+            :use ((:instance expt-weak-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))
+
+(local
+ (defthm near-a-c-4
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (exactp a n)
+                 (< x a)
+                 (> x (- a (expt 2 (- (expo x) n)))))
+            (= (expo (- a (expt 2 (- (1+ (expo x)) n))))
+               (expo x)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;expt-pos
+                               )
+            :use ((:instance near-a-c-2)
+                  (:instance near-a-c-3)
+;			(:instance expt-pos (x (expo x)))
+                  (:instance expo-upper-bound)
+                  (:instance expo-unique
+                             (x (- a (expt 2 (- (1+ (expo x)) n))))
+                             (n (expo x))))))))
+
+(local
+(defthm near-a-c-5
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (integerp (* (- a (expt 2 (- (1+ (expo x)) n)))
+			  (expt 2 (- (1- n) (expo x))))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance expt-split (r 2) (i (- (1+ (expo x)) n)) (j (- (1- n) (expo x))))
+			(:instance exactp-<=-expo (x a) (e (expo x)))
+			(:instance near-a-c-3)
+			(:instance expo-monotone (x (- a (expt 2 (- (1+ (expo x)) n)))) (y a))
+			(:instance expo-monotone (y a)))))))
+
+(local
+(defthm near-a-c-6
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (exactp (- a (expt 2 (- (1+ (expo x)) n)))
+		     n))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance exactp2 (x (- a (expt 2 (- (1+ (expo x)) n)))))
+			(:instance near-a-c-5)
+			(:instance near-a-c-2)
+;			(:instance expt-pos (x (expo x)))
+			(:instance near-a-c-4))))))
+
+(local
+(defthm near-a-c-7
+    (implies (and (rationalp x)
+		  (rationalp a)
+		  (rationalp e)
+		  (> x (- a e)))
+	     (> x (+ (- a (* 2 e))
+		     e)))
+  :rule-classes ()))
+
+(local
+ (defthm near-a-c-8
+   (implies (and (rationalp x)
+                 (rationalp a)
+                 (integerp n)
+                 (> x (- a (expt 2 (- (expo x) n)))))
+            (> x (+ (- a (expt 2 (- (1+ (expo x)) n)))
+                    (expt 2 (- (expo x) n)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-compare-equal)
+            :use ((:instance expt-split (r 2) (i 1) (j (- (expo x) n)))
+                  (:instance near-a-c-7 (e (expt 2 (- (expo x) n)))))))))
+
+(local
+ (defthm near-a-c-9
+   (implies (and (rationalp x) (> x 0)
+                 (rationalp a) (> a 0)
+                 (integerp n) (> n 0)
+                 (exactp a n)
+                 (< x a)
+                 (> x (- a (expt 2 (- (expo x) n)))))
+            (> (- a (expt 2 (- (1+ (expo x)) n)))
+               0))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;expt-pos
+                               )
+            :use ((:instance near-a-c-2)
+;			(:instance expt-pos (x (expo x)))
+                  )))))
+
+(defthm near-a-c
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (>= (near x n) a))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-a-a (a (- a (expt 2 (- (1+ (expo x)) n)))))
+			(:instance near-a-c-8)
+			(:instance near-a-c-6)
+			(:instance near-a-c-4)
+			(:instance near-a-c-9)))))
+
+
+
+
+(local
+ (defthm near-exact-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
+	       (and (< f 1) (< 0 f))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable re)
+           :use ((:instance fl-def-linear (x (* (expt 2 (1- n)) (sig x))))
+			(:instance exactp))))))
+
+(local
+ (defthm near-exact-2
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (exactp x (1+ n)))
+	     (let ((f (re (* (expt 2 (1- n)) (sig x)))))
+	       (integerp (* 2 f))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable expt re)
+           :use ((:instance exactp (n (1+ n))))))))
+
+(local
+ (defthm near-exact-3
+    (implies (and (integerp 2f)
+		  (< 0 2f)
+		  (< 2f 2))
+	     (= 2f 1))
+  :rule-classes ()))
+
+(local
+ (defthm near-exact-4
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n)))
+	     (= (re (* (expt 2 (1- n)) (sig x)))
+		1/2))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-exact-1)
+			(:instance near-exact-2)
+			(:instance near-exact-3 (2f (* 2 (re (* (expt 2 (1- n)) (sig x)))))))))))
+
+(local
+ (defthm near-exact-5
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
+	     (= (near x n)
+		(* (fl (* (expt 2 (1- n)) (sig x)))
+		   (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near)
+			(:instance near-exact-4)
+			(:instance trunc))))))
+
+(local
+ (defthm near-exact-6
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
+	     (= (* (expt 2 (- (- n 2) (expo x)))
+		   (near x n))
+		(/ (fl (* (expt 2 (1- n)) (sig x)))
+		   2)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable a15)
+           :use ((:instance near-exact-5)
+			(:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (expt 2 (- (1+ (expo x)) n)))))))))
+
+(local
+ (defthm near-exact-7
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
+	     (integerp (* (expt 2 (- (- n 2) (expo x)))
+			  (near x n))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-exact-6)
+			(:instance evenp (x (fl (* (expt 2 (1- n)) (sig x))))))))))
+
+(local
+ (defthm near-exact-8
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
+	     (= (expo (near x n)) (expo x)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-exact-4)
+			(:instance near)
+			(:instance expo-trunc))))))
+
+(local
+ (defthm near-exact-9
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (evenp (fl (* (expt 2 (1- n)) (sig x)))))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-exact-7)
+			(:instance near-exact-8)
+			(:instance near-pos)
+			(:instance exactp2 (x (near x n)) (n (1- n))))))))
+
+(local
+ (defthm near-exact-10
+     (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
+	     (= (near x n)
+		(* (cg (* (expt 2 (1- n)) (sig x)))
+		   (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near)
+			(:instance near-exact-4)
+			(:instance away))))))
+
+(local
+ (defthm near-exact-11
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
+	     (= (near x n)
+		(* (1+ (fl (* (expt 2 (1- n)) (sig x))))
+		   (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable re)
+           :use ((:instance near-exact-10)
+			(:instance near-exact-1)
+			(:instance fl-cg (x (* (expt 2 (1- n)) (sig x)))))))))
+
+(local
+ (defthm near-exact-12
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
+	     (= (* (expt 2 (- (- n 2) (expo x)))
+		   (* (1+ (fl (* (expt 2 (1- n)) (sig x))))
+		      (expt 2 (- (1+ (expo x)) n))))
+		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
+		   2)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable a15)
+           :use ((:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (expt 2 (- (1+ (expo x)) n)))))))))
+
+(local
+ (defthm near-exact-13
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
+	     (= (* (expt 2 (- (- n 2) (expo x)))
+		   (near x n))
+		(/ (1+ (fl (* (expt 2 (1- n)) (sig x))))
+		   2)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-exact-11)
+			(:instance near-exact-12))))))
+
+(local
+ (defthm near-exact-14
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
+	     (integerp (* (expt 2 (- (- n 2) (expo x)))
+			  (near x n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable a9; rearrange-fractional-coefs-equal
+                                      distributivity)
+		  :use ((:instance near-exact-13)
+			(:instance evenp (x (fl (* (expt 2 (1- n)) (sig x)))))
+			(:instance x-or-x/2 (x (fl (* (expt 2 (1- n)) (sig x))))))))))
+
+(local
+ (defthm near-exact-15
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (not (= (near x n) (expt 2 (1+ (expo x)))))
+		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
+	     (= (expo (near x n)) (expo x)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-exact-4)
+			(:instance near)
+			(:instance away)
+;			(:instance away-pos)
+			(:instance expo-away))))))
+
+(local
+ (defthm near-exact-16
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (not (= (near x n) (expt 2 (1+ (expo x)))))
+		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-exact-14)
+			(:instance near-exact-15)
+			(:instance near-pos)
+			(:instance exactp2 (x (near x n)) (n (1- n))))))))
+
+(local
+ (defthm near-exact-17
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (exactp x n))
+		  (exactp x (1+ n))
+		  (not (evenp (fl (* (expt 2 (1- n)) (sig x))))))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-exact-16)
+			(:instance exactp-2**n (n (1+ (expo x))) (m (1- n))))))))
+
+
+(encapsulate ()
+        (local 
+         (defthm near-exact-support
+         (implies (and (rationalp x) (> x 0)
+                       (integerp n) (> n 1)
+                       (exactp x (1+ n))
+                       (not (exactp x n)))
+                  (exactp (near x n) (1- n)))
+         :rule-classes ()
+         :hints (("goal" :use ((:instance near-exact-17)
+               		(:instance near-exact-9))))))
+
+ (defthm near-exact
+    (implies (and (rationalp x)
+		  (integerp n) 
+		  (> n 1)
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (exactp (near x n) (1- n)))
+    :hints (("Goal" :cases ((not (equal x 0)))
+             :in-theory (enable near-minus))
+            ("Subgoal 2" :in-theory (enable exactp))
+            ("Subgoal 1" :cases  ((not (> x 0))))
+            ("Subgoal 1.2" :use near-exact-support)
+            ("Subgoal 1.1" :use ((:instance near-exact-support
+                                            (x (* -1 x))))))
+  :rule-classes ()))
+
+
+
+(local
+ (defthm near-est-1
+   (implies (and (integerp n) (> n 0)
+                 (rationalp x) (> x 0)
+                 (> (abs (- x (near x n)))
+                    (expt 2 (- (expo x) n))))
+            (< (trunc x n)
+               (- x (expt 2 (- (expo x) n)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable TRUNC-EXACTP-A REARRANGE-NEGATIVE-COEFS-<)
+            :use ((:instance near2 (y (trunc x n)))
+                  (:instance trunc-exactp-a)
+;			(:instance trunc-pos)
+                  (:instance trunc-upper-pos))))))
+
+;; (i-am-here) ;; Thu Oct 12 16:34:52 2006
+
+(local
+ (defthm near-est-2
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (> (abs (- x (near x n)))
+		     (expt 2 (- (expo x) n))))
+	     (> (away x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable away-exactp-a
+                                      near-exactp-c-support)
+           :use ((:instance near2-original (y (away x n)))
+                 (:instance away-exactp-a)
+                 ;(:instance away-pos)
+                 (:instance away-lower-pos))))))
+
+(local
+ (defthm near-est-3
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (> (abs (- x (near x n)))
+		     (expt 2 (- (expo x) n))))
+	     (> (away x n)
+		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable a15 expt-compare-equal)
+		  :use ((:instance near-est-1)
+			(:instance expt-split (r 2) (i (- (expo x) n)) (j 1))
+			(:instance near-est-2))))))
+
+(local
+ (defthm near-est-4
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0)
+		  (> (abs (- x (near x n)))
+		     (expt 2 (- (expo x) n))))
+	     (> x
+		(+ (trunc x n) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-est-3)
+			(:instance fp+1 (x (trunc x n)))
+			(:instance trunc-exactp-a)
+;			(:instance trunc-pos)
+			(:instance expo-trunc)
+			(:instance away-exactp-c (a (+ (trunc x n) (expt 2 (- (1+ (expo x)) n))))))))))
+
+(local 
+ (defthm near-est-support
+    (implies (and (integerp n) (> n 0)
+		  (rationalp x) (> x 0))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-est-4)
+			(:instance trunc-lower-1)
+;			(:instance trunc-pos)
+                        )))))
+
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+    :hints (("Goal" :cases ((not (> x 0)))
+             :in-theory (enable near-minus))
+            ("Subgoal 2" :use ((:instance near-est-support)))
+            ("Subgoal 1" :use ((:instance near-est-support
+                                          (x (* -1 x))))))
+  :rule-classes ())
+
+
+
+
+
+(local
+ (defthm near-power-a-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (= (near x n)
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (near x n)) (expo x)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near)
+			(:instance away)
+;			(:instance away-pos)
+			(:instance expo-trunc)
+			(:instance expo-away))))))
+
+(local
+ (defthm near-power-a-2
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 0)
+                 (not (= (near x n)
+                         (expt 2 (1+ (expo x))))))
+            (< (near x n) (expt 2 (1+ (expo x)))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance near-power-a-1)
+                         (:instance expo-upper-bound (x (near x n)))
+                         (:instance near-pos))))))
+
+(local
+ (defthm near-power-a-3
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 0)
+                 (not (= (near x n)
+                         (expt 2 (1+ (expo x))))))
+            (<= (+ (near x n) (expt 2 (- (1+ (expo x)) n)))
+                (expt 2 (1+ (expo x)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable EXACTP-2**N-REWRITE EXACTP-2**N)
+            :use ((:instance near-power-a-2)
+                 (:instance near-power-a-1)
+;                 (:instance exactp-near)
+                 (:instance fp+2 (x (near x n)) (y (expt 2 (1+ (expo x)))))
+                 (:instance exactp-2**n (n (1+ (expo x))) (m n))
+                 (:instance near-pos))))))
+
+(local
+ (defthm near-power-a-4
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 0)
+                 (not (= (near x n)
+                         (expt 2 (1+ (expo x))))))
+            (<= (+ (- x (expt 2 (- (expo x) n)))
+                   (expt 2 (- (1+ (expo x)) n)))
+                (expt 2 (1+ (expo x)))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance near-power-a-3)
+                         (:instance near-est))))))
+
+(local
+ (defthm near-power-a-5
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 0)
+                 (not (= (near x n)
+                         (expt 2 (1+ (expo x))))))
+            (<= (+ x (expt 2 (- (expo x) n)))
+                (expt 2 (1+ (expo x)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-compare-equal)
+            :use ((:instance near-power-a-4)
+                  (:instance expt-split (r 2) (i (- (expo x) n)) (j 1)))))))
+
+(local
+ (defthm near-power-a-6
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (= (near x n)
+			  (expt 2 (1+ (expo x)))))
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (+ x (expt 2 (- (expo x) n)))
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-power-a-5))))))
+
+(local
+ (defthm near-power-a-7
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (= (near x n)
+			  (expt 2 (1+ (expo x)))))
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= x 
+		(- (expt 2 (1+ (expo x)))
+		   (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-power-a-6))))))
+
+(local
+ (defthm near-power-a-8
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (= (near x n)
+			  (expt 2 (1+ (expo x)))))
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (integerp (* (- (expt 2 (1+ (expo x)))
+			     (expt 2 (- (expo x) n)))
+			  (expt 2 (- n (expo x))))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-power-a-7)
+			(:instance expt-split (r 2) (i (- n (expo x))) (j (1+ (expo x))))
+			(:instance expt-split (r 2) (i (- n (expo x))) (j (- (expo x) n))))))))
+
+(local
+ (defthm hack-90
+    (implies (and (= x y)
+		  (integerp (* y e)))
+	     (integerp (* x e)))
+  :rule-classes ()))
+
+(local
+ (defthm near-power-a-9
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (= (near x n)
+			  (expt 2 (1+ (expo x)))))
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (integerp (* x (expt 2 (- n (expo x))))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-power-a-7)
+			(:instance hack-90 
+				   (y (- (expt 2 (1+ (expo x))) (expt 2 (- (expo x) n))))
+				   (e (expt 2 (- n (expo x)))))
+			(:instance near-power-a-8))))))
+
+(local
+ (defthm near-power-a-10
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (= (near x n)
+			  (expt 2 (1+ (expo x)))))
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (exactp x (1+ n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable exactp2)
+		  :use ((:instance near-power-a-9))))))
+
+(local
+ (defthm near-power-a-11
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (= (near x n)
+			  (expt 2 (1+ (expo x)))))
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (not (exactp x n)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-power-a-6)
+			(:instance expo-upper-bound)
+			(:instance fp+2 (y (expt 2 (1+ (expo x)))))
+			(:instance exactp-2**n (n (1+ (expo x))) (m n))
+			(:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n))))))))
+
+(local
+ (defthm near-power-a-12
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (= (near x n)
+			  (expt 2 (1+ (expo x)))))
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (exactp (near x n) (1- n)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-power-a-10)
+			(:instance near-power-a-11)
+			(:instance near-exact))))))
+
+(local
+ (defthm near-power-a-13
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (not (= (near x n)
+                         (expt 2 (1+ (expo x)))))
+                 (>= (+ x (expt 2 (- (expo x) n)))
+                     (expt 2 (1+ (expo x)))))
+            (<= (+ (near x n) (expt 2 (- (+ (expo x) 2) n)))
+                (expt 2 (1+ (expo x)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable exactp-2**n exactp-2**n-rewrite)
+            :use ((:instance near-power-a-12)
+                  (:instance near-power-a-2)
+                  (:instance near-pos)
+                  (:instance fp+2 (x (near x n)) (n (1- n)) (y (expt 2 (1+ (expo x)))))
+                  (:instance exactp-2**n (n (1+ (expo x))) (m (1- n)))
+                  (:instance near-power-a-1))))))
+
+(local
+ (defthm near-power-a-14
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (not (= (near x n)
+                         (expt 2 (1+ (expo x)))))
+                 (>= (+ x (expt 2 (- (expo x) n)))
+                     (expt 2 (1+ (expo x)))))
+            (>= (+ (near x n) (expt 2 (- (+ (expo x) 1) n)))
+                (expt 2 (1+ (expo x)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable expt-split)
+            :use ((:instance near-est))))))
+
+(defthm near-power-a
+  (implies (and (rationalp x) (> x 0)
+                (integerp n) (> n 1)
+                (>= (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x)))))
+           (= (near x n)
+              (expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable expt-compare)
+           :use ((:instance near-power-a-13)
+                 (:instance near-power-a-14)
+                 (:instance expt-strong-monotone
+                            (n (- (+ (expo x) 1) n))
+                            (m (- (+ (expo x) 2) n)))))))
+
+(local
+(defthm near-power-b-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		 (expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance exactp-2**n (n (1+ (expo x))) (m n))
+;			(:instance expt-pos (x (- (expo x) n)))
+			(:instance trunc-exactp-c 
+				   (x (+ x (expt 2 (- (expo x) n))))
+				   (a (expt 2 (1+ (expo x))))))))))
+
+(local
+(defthm near-power-b-2
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x))))
+		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+			  (expt 2 (1+ (expo x))))))
+	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-power-b-1))))))
+
+(local
+(defthm near-power-b-3
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x))))
+		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+			  (expt 2 (1+ (expo x))))))
+	     (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		 (+ (expt 2 (1+ (expo x)))
+		    (expt 2 (- (+ 2 (expo x)) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near-power-b-2)
+			(:instance exactp-2**n (n (1+ (expo x))) (m n))
+			(:instance trunc-exactp-a (x (+ x (expt 2 (- (expo x) n)))))
+;			(:instance expt-pos (x (1+ (expo x))))
+			(:instance expo-2**n (n (1+ (expo x))))
+			(:instance fp+2 
+				   (x (expt 2 (1+ (expo x))))
+				   (y (trunc (+ x (expt 2 (- (expo x) n))) n))))))))
+
+(local
+(defthm near-power-b-4
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x))))
+		  (not (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+			  (expt 2 (1+ (expo x))))))
+	     (> (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable expt-compare)
+           :use ((:instance near-power-b-3)
+			(:instance expo-upper-bound)
+			(:instance expt-weak-monotone (n (- (expo x) n)) (m (- (+ 2 (expo x)) n))))))))
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near-power-b-4)
+			(:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
+;			(:instance expt-pos (x (- (expo x) n)))
+                        ))))
+
+(local
+ (defthm near-trunc-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near-power-a)
+			(:instance near-power-b)
+			(:instance exactp-2**n (n (1+ (expo x))) (m (1- n)))
+			(:instance trunc-trunc (x (+ x (expt 2 (- (expo x) n)))) (m (1- n)))
+			(:instance trunc-exactp-b
+				   (x (trunc (+ x (expt 2 (- (expo x) n))) n))
+				   (n (1- n)))
+;			(:instance expt-pos (x (- (expo x) n)))
+                        )))))
+
+(local
+ (defthm near-trunc-2
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x)))))
+            (= (expo (near x n))
+               (expo x)))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance near-power-a-1)
+                         (:instance near-est))))))
+
+(local
+ (defthm near-trunc-3
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x)))))
+            (= (expo (+ x (expt 2 (- (expo x) n))))
+               (expo x)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;expt-pos
+                               )
+            :use ((:instance expo-unique (x (+ x (expt 2 (- (expo x) n)))) (n (expo x)))
+                  (:instance expo-lower-bound)
+;			(:instance expt-pos (x (- (expo x) n)))
+                  )))))
+
+(local
+ (defthm near-trunc-4
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (exactp x n))
+            (>= (trunc (+ x (expt 2 (- (expo x) n))) n)
+                x))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;expt-pos
+                               )
+            :use ((:instance trunc-exactp-c
+                             (x (+ x (expt 2 (- (expo x) n))))
+                             (a x))
+;			(:instance expt-pos (x (- (expo x) n)))
+                  )))))
+
+(local
+ (defthm near-trunc-5
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (exactp x n))
+            (<(trunc (+ x (expt 2 (- (expo x) n))) n)
+              (fp+ x n)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-compare
+                                       )
+            :use ((:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
+                  (:instance expt-strong-monotone (n (- (expo x) n)) (m (- (1+ (expo x)) n)))
+;			(:instance expt-pos (x (- (expo x) n)))
+                  )))))
+
+(local
+(defthm near-trunc-6
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (< (+ x (expt 2 (- (expo x) n)))
+		     (expt 2 (1+ (expo x))))
+		  (exactp x n))
+	     (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		 x))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near-trunc-5)
+			(:instance fp+2 (y (trunc (+ x (expt 2 (- (expo x) n))) n)))
+			(:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n)))))
+;			(:instance expt-pos (x (- (expo x) n)))
+                        )))))
+
+(local
+(defthm near-trunc-7
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (< (+ x (expt 2 (- (expo x) n)))
+		     (expt 2 (1+ (expo x))))
+		  (exactp x n))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		x))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-trunc-4)
+			(:instance near-trunc-6))))))
+
+(defthm near-exactp
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (exactp x n))
+	     (equal (near x n) x))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-choice)
+			(:instance trunc-exactp-b)
+			(:instance away-exactp-b)))))
+			
+(local
+ (defthm near-trunc-case-1
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (exactp x n))
+            (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+               (near x n)))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance near-trunc-7)
+                         (:instance near-exactp)
+                         (:instance trunc-exactp-b (x (+ x (expt 2 (- (expo x) n))))))))))
+
+(local
+ (defthm near-trunc-8
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (= (near x n)
+                    (- x (expt 2 (- (expo x) n)))))
+            (exactp x (1+ n)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;exactp-near
+                                       NEAR-EXACTP-D
+                                       NEAR-EXACTP-D-SUPPORT
+                                       )
+            :use ((:instance near-trunc-2)
+                  (:instance near-pos)
+;	(:instance exactp-near)
+                  (:instance fp+1 (x (near x n)) (n (1+ n)))
+                  (:instance exactp-<= (x (near x n)) (m n) (n (1+ n))))))))
+
+(local
+ (defthm near-trunc-9
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (not (exactp x (1+ n))))
+            (> (near x n)
+               (- x (expt 2 (- (expo x) n)))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance near-trunc-8)
+                         (:instance near-est))))))
+
+(local
+ (defthm near-trunc-10
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1))
+            (<= (near x n)
+                (trunc (+ x (expt 2 (- (expo x) n))) n)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;exactp-near
+                                       )
+            :use (;(:instance exactp-near)
+                  (:instance trunc-exactp-c (x (+ x (expt 2 (- (expo x) n)))) (a (near x n)))
+                  (:instance near-est))))))
+
+(local
+ (defthm near-trunc-11
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (not (exactp x (1+ n))))
+            (< (trunc (+ x (expt 2 (- (expo x) n))) n)
+               (+ (near x n)
+                  (expt 2 (- (expo x) n))
+                  (expt 2 (- (expo x) n)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;expt-pos
+                               )
+            :use ((:instance near-trunc-9)
+                  (:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))))
+;			(:instance expt-pos (x (- (expo x) n)))
+                  )))))
+
+(local
+ (defthm near-trunc-12
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (not (exactp x (1+ n))))
+            (< (trunc (+ x (expt 2 (- (expo x) n))) n)
+               (+ (near x n)
+                  (expt 2 (- (1+ (expo x)) n)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable expt-compare-equal)
+            :use ((:instance near-trunc-11)
+                         (:instance expt-split (r 2) (i (- (expo x) n)) (j 1)))))))
+
+(local
+ (defthm near-trunc-13
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (not (exactp x (1+ n))))
+            (<= (trunc (+ x (expt 2 (- (expo x) n))) n)
+                (near x n)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;exactp-near
+                                       trunc-exactp-a ;expt-pos
+                                       NEAR-EXACTP-D-SUPPORT
+                                       )
+            :use ((:instance near-trunc-12)
+                  (:instance fp+2
+                             (x (near x n))
+                             (y (trunc (+ x (expt 2 (- (expo x) n))) n)))
+                  (:instance near-trunc-2)
+;			(:instance expt-pos (x (- (expo x) n)))
+;                  (:instance exactp-near)
+                  (:instance near-pos)
+                  (:instance trunc-exactp-a (x (+ x (expt 2 (- (expo x) n))))))))))
+
+(local
+ (defthm near-trunc-case-2
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (not (exactp x (1+ n))))
+            (= (near x n)
+               (trunc (+ x (expt 2 (- (expo x) n))) n)))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance near-trunc-10)
+                         (:instance near-trunc-13))))))
+
+(local
+ (defthm near-trunc-14
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (< (+ x (expt 2 (- (expo x) n)))
+		     (expt 2 (1+ (expo x))))
+		  (exactp x (1+ n))
+		  (not (exactp x n))
+		  (> (near x n) x))
+	     (= (near x n)
+		(+ x (expt 2 (- (expo x) n)))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-est)
+;			(:instance exactp-near)
+			(:instance exactp-<= (x (near x n)) (m n) (n (1+ n)))
+			(:instance fp+2 (n (1+ n)) (y (near x n))))))))
+
+(local
+ (defthm near-trunc-15
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (< (+ x (expt 2 (- (expo x) n)))
+		     (expt 2 (1+ (expo x))))
+		  (exactp x (1+ n))
+		  (not (exactp x n))
+		  (> (near x n) x))
+	     (= (near x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-trunc-14)
+			(:instance near-exact)
+			(:instance trunc-exactp-b (x (near x n)) (n (1- n))))))))
+
+(local
+ (defthm near-trunc-16
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (< (+ x (expt 2 (- (expo x) n)))
+		     (expt 2 (1+ (expo x))))
+		  (exactp x (1+ n))
+		  (not (exactp x n))
+		  (< (near x n) x))
+	     (<= (near x n)
+		 (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable ;expt-pos
+                              )
+		  :use ((:instance near-exact)
+;			(:instance expt-pos (x (- (expo x) n)))
+			(:instance trunc-exactp-c
+				   (x (+ x (expt 2 (- (expo x) n))))
+				   (n (1- n))
+				   (a (near x n))))))))
+
+(local
+ (defthm near-trunc-17
+   (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (< (+ x (expt 2 (- (expo x) n)))
+		     (expt 2 (1+ (expo x))))
+		  (exactp x (1+ n))
+		  (not (exactp x n))
+		  (< (near x n) x))
+	     (>= (+ (near x n)
+		    (expt 2 (- (1+ (expo x)) n)))
+		 (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable expt-split)
+                              
+		  :use ((:instance trunc-upper-pos (x (+ x (expt 2 (- (expo x) n)))) (n (1- n)))
+			(:instance near-est))))))
+
+(local
+ (defthm near-trunc-18
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (> (+ (near x n)
+		   (expt 2 (- (+ 2 (expo x)) n)))
+		(+ (near x n)
+		   (expt 2 (- (1+ (expo x)) n)))))		 
+  :rule-classes ()
+  :hints (("goal" :use ((:instance expt-strong-monotone 
+				   (n (- (1+ (expo x)) n)) 
+				   (m (- (+ 2 (expo x)) n))))))))
+
+(local
+ (defthm near-trunc-19
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (exactp x (1+ n))
+                 (not (exactp x n))
+                 (< (near x n) x))
+            (> (+ (near x n)
+                  (expt 2 (- (+ 2 (expo x)) n)))
+               (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable  expt-compare)
+            :use ((:instance near-trunc-17)
+                  (:instance near-trunc-18))))))
+
+(local
+ (defthm near-trunc-20
+   (implies (and (rationalp x) (> x 0)
+                 (integerp n) (> n 1)
+                 (< (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x))))
+                 (exactp x (1+ n))
+                 (not (exactp x n))
+                 (< (near x n) x))
+            (>= (near x n)
+                (trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (disable ;expt-pos 
+                               near-exactp-d-support
+                               )
+            :use ((:instance near-exact)
+;			(:instance expt-pos (x (- (expo x) n)))
+                  (:instance trunc-exactp-a (x (+ x (expt 2 (- (expo x) n)))) (n (1- n)))
+                  (:instance fp+2 
+                             (x (near x n)) 
+                             (y (trunc (+ x (expt 2 (- (expo x) n))) (1- n)))
+                             (n (1- n)))
+                  (:instance near-pos)
+                  (:instance near-trunc-19)
+                  (:instance near-trunc-2))))))
+
+(local
+(defthm near-trunc-21
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (< (+ x (expt 2 (- (expo x) n)))
+		     (expt 2 (1+ (expo x))))
+		  (exactp x (1+ n))
+		  (not (exactp x n))
+		  (< (near x n) x))
+	     (= (near x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-trunc-16)
+			(:instance near-trunc-20))))))
+
+(local
+ (defthm near-trunc-case-3
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (< (+ x (expt 2 (- (expo x) n)))
+		     (expt 2 (1+ (expo x))))
+		  (exactp x (1+ n))
+		  (not (exactp x n)))
+	     (= (near x n)
+		(trunc (+ x (expt 2 (- (expo x) n))) (1- n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable near-exactp-a)
+		  :use ((:instance near-trunc-21)
+			(:instance near-exactp-a)
+			(:instance near-trunc-15))))))
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-trunc-1)
+			(:instance near-trunc-case-1)
+			(:instance near-trunc-case-2)
+			(:instance near-trunc-case-3)))))
+
+(defthm near-0
+  (equal (near 0 n)
+         0)
+  :hints (("Goal" :in-theory (enable near))))
+
+
+;; ;BOZO yuck?
+;; (defthm sgn-near
+;;   (implies (and (rationalp x)
+;;                 (integerp n)
+;;                 (> n 0))
+;;            (= (near x n)
+;;               (* (sgn x) (near (abs x) n))))
+;;   :rule-classes ()
+;;   :hints (("goal" :in-theory (enable abs))))
+
+
+
+
+(defthm plus-near-1
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                )
+           (= (re (* (expt 2 (1- k)) (sig y)))
+              (re (* (expt 2 (1- (+ k (- (expo (+ x y)) (expo y)))))
+                     (sig (+ x y))))))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (enable re sig exactp expt-split expt-minus))))
+
+(defthm plus-near-2
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y)))))
+           (iff (evenp (fl (* (expt 2 (1- k)) (sig y))))
+                (evenp (fl (* (expt 2
+                                    (1- (+ k (- (expo (+ x y)) (expo y)))))
+                              (sig (+ x y)))))))
+  :otf-flg t
+  :rule-classes nil 
+  :hints (("Goal" :in-theory (e/d (expt-split
+                                   expt-minus
+                                   exactp sig ; EXPT-SPLIT-leading-constant
+                                   evenp ;this is sort of cheating...
+                                   ) ())
+           :use ((:instance exactp2 (n (+ k (expo x) (- (expo y)))))
+                 (:instance exactp-<=
+                            (m (+ -1 k (expo x) (- (expo y))))
+                            (n (+ k (expo x) (- (expo y)))))))))
+
+(defthm plus-near
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y)))))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (enable near)
+           :use (plus-trunc plus-away plus-near-1 plus-near-2
+                            (:instance exactp-<=
+                                       (m (+ -1 k (expo x) (* -1 (expo y))))
+                                       (n (+ k (expo x) (* -1 (expo y)))))))))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/near.lisp acl2-6.3/books/rtl/rel9/support/support/near.lisp
--- acl2-6.2/books/rtl/rel9/support/support/near.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/near.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,529 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+(local (include-book "near-proofs"))
+
+;; Necessary functions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+;;
+;; New stuff:
+;;
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defthm near-minus
+  (equal (near (* -1 x) n)
+         (* -1 (near x n))))
+
+(defthm near-of-non-rationalp-is-0
+  (implies (not (rationalp x))
+           (equal (near x n)
+                  0))
+  :hints (("goal" :in-theory (enable near sig))))
+
+(defthm near-0
+  (equal (near 0 n)
+         0))
+
+(defthm near-rational-type-prescription
+  (rationalp (near x n))
+  :rule-classes (:rewrite :type-prescription))
+
+
+(defthm near-non-negative-rational-type-prescription
+  (implies (<= 0 x)
+           (and (<= 0 (near x n))
+                (rationalp (near x n))))
+  :rule-classes :type-prescription)
+
+(defthm near-non-positive-rational-type-prescription
+  (implies (<= x 0)
+           (and (<= (near x n) 0)
+                (rationalp (near x n))))
+  :rule-classes :type-prescription)
+
+(defthm near-pos
+  (implies (and (< 0 x)
+                (< 0 n)
+                (rationalp x)
+                (integerp n)
+                )
+           (< 0 (near x n)))
+  :rule-classes (:type-prescription :linear)
+  :hints (("Goal" :use ((:instance near-choice)))))
+
+(defthm near-neg
+    (implies (and (< x 0)
+		  (< 0 n)
+                  (rationalp x)
+		  (integerp n)
+		  )
+	     (< (near x n) 0))
+  :rule-classes (:type-prescription :linear)
+  :hints (("Goal" :use ((:instance near-choice)))))
+
+
+
+;; (defthm near1-a-support
+;;   (implies (and (< (- x (trunc x n)) (- (away x n) x))
+;;                 (rationalp x)
+;;                 (>= x 0)
+;;                 (integerp n)
+;;                 )
+;;            (equal (near x n)
+;;                   (trunc x n)))
+;;   :rule-classes ())
+
+(defthm near1-a
+  (implies (and (< (abs (- x (trunc x n)))
+                   (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (trunc x n)))
+  :rule-classes ())
+
+
+;; (defthm near1-b
+;;   (implies (and (> (- x (trunc x n)) (- (away x n) x))
+;;                 (rationalp x)
+;;                 (>= x 0)
+;;                 (integerp n)
+;;                 (> n 0)
+;;                 )
+;;            (equal (near x n) 
+;;                   (away x n)))
+;;   :rule-classes ())
+
+(defthm near1-b
+  (implies (and (> (abs (- x (trunc x n))) (abs (- (away x n) x)))
+                (rationalp x)
+                (integerp n))
+           (equal (near x n)
+                  (away x n)))
+  :rule-classes ())
+
+(defthm near2-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (>= x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp y n)
+		  (= (near x n) (trunc x n)))
+	     (>= (abs (- x y)) (- x (trunc x n))))
+  :rule-classes ())
+
+(defthm near2-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (> x 0)
+		  (> y 0)
+		  (integerp n)
+		  (> n 0)
+		  (exactp y n)
+		  (= (near x n) (away x n)))
+	     (>= (abs (- x y)) (- (away x n) x)))
+  :rule-classes ())
+
+(defthm near-choice
+  (or (= (near x n) (trunc x n))
+      (= (near x n) (away x n)))
+  :rule-classes ())
+
+;; (defthm near2
+;;   (implies (and (exactp y n)
+;;                 (rationalp x)
+;;                 (rationalp y)
+;;                 (> x 0)
+;;                 (> y 0)
+;;                 (integerp n)
+;;                 (> n 0)
+;;                 )
+;;            (>= (abs (- x y)) (abs (- x (near x n)))))
+;;   :rule-classes ())
+
+(defthm near2
+  (implies (and (exactp y n)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (>= (abs (- x y)) (abs (- x (near x n)))))
+  :rule-classes ())
+
+(defthm near-exactp-a
+  (implies (< 0 n)
+           (exactp (near x n) n)))
+
+(defthm sgn-near-2
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0))
+           (equal (sgn (near x n))
+                  (sgn x))))
+
+(defthm near-exactp-b
+  (implies (and (rationalp x)
+                (integerp n) 
+                (> n 0))
+           (iff (= x (near x n))
+                (exactp x n)))
+  :rule-classes ())
+
+
+(defthmd near-exactp-c
+      (implies (and (exactp a n)
+  		  (>= a x)
+                    (rationalp x)
+  		  (integerp n)
+  		  (> n 0)
+  		  (rationalp a)
+  		  )
+  	     (>= a (near x n))))
+ 
+;; (defthmd near-exactp-c-support
+;;   (implies (and (exactp a n)
+;;                 (>= a x)
+;;                 (rationalp x)
+;;                 (> x 0)
+;;                 (integerp n)
+;;                 (> n 0)
+;;                 (rationalp a)
+;;                 )
+;;            (>= a (near x n))))
+
+;; (defthm near-exactp-d-support
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (<= a x))
+;; 	     (<= a (near x n))))
+ 
+(defthmd near-exactp-d
+      (implies (and (rationalp x)
+  		  (integerp n)
+  		  (> n 0)
+  		  (rationalp a)
+  		  (exactp a n)
+  		  (<= a x))
+  	     (<= a (near x n))))
+ 
+
+(defthm near-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (<= (near x n) (near y n))))
+
+
+(defund near-witness (x y n)
+  (if (= (expo x) (expo y))
+      (/ (+ (near x n) (near y n)) 2)
+    (expt 2 (expo y))))
+
+(defthm near<=away
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (<= (near x n) (away x n)))
+  :rule-classes ())
+
+(defthm near>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (near x n) (trunc x n)))
+  :rule-classes ())
+
+
+
+(defthm near-0-0
+  (implies (and (case-split (< 0 n))
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (equal (equal (near x n) 0)
+		  (equal x 0)))
+  :rule-classes ())
+
+(defthm near-near-lemma
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< x y)
+		  (integerp n)
+		  (> n 0)
+		  (not (= (near x n) (near y n))))
+	     (and (<= x (near-witness x y n))
+		  (<= (near-witness x y n) y)
+		  (exactp (near-witness x y n) (1+ n))))
+  :rule-classes ())
+
+;bad name?
+(defthm near-near
+  (implies (and (rationalp x)
+                (rationalp y)
+                (rationalp a)
+                (integerp n)
+                (integerp k)
+                (> k 0)
+                (>= n k)		  
+                (< 0 a)
+                (< a x)
+                (< 0 y)
+                (< y (fp+ a (1+ n)))
+                (exactp a (1+ n)))
+           (<= (near y k) (near x k)))
+  :rule-classes ())
+
+;BOZO why disabled?
+(defthmd near-shift
+  (implies (and (rationalp x)
+                (integerp n)
+                (integerp k))
+           (= (near (* x (expt 2 k)) n)
+              (* (near x n) (expt 2 k)))))
+
+(defthm near-a-a
+  (implies (and (rationalp x) (> x 0)
+                (rationalp a) (> a 0)
+                (integerp n) (> n 0)
+                (exactp a n)
+                (> x (+ a (expt 2 (- (expo a) n)))))
+           (>= (near x n) (+ a (expt 2 (- (1+ (expo a)) n)))))
+  :rule-classes ())
+
+(defthm near-a-b
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x (+ a (expt 2 (- (expo a) n)))))
+	     (<= (near x n) a))
+  :rule-classes ())
+
+(defthm near-a-c
+    (implies (and (rationalp x) (> x 0)
+		  (rationalp a) (> a 0)
+		  (integerp n) (> n 0)
+		  (exactp a n)
+		  (< x a)
+		  (> x (- a (expt 2 (- (expo x) n)))))
+	     (>= (near x n) a))
+  :rule-classes ())
+
+;bad name?
+
+(defthm near-exact
+  (implies (and (rationalp x)
+                (integerp n) 
+                (> n 1)
+                (exactp x (1+ n))
+                (not (exactp x n)))
+           (exactp (near x n) (1- n)))
+  :rule-classes ())
+
+(defthm near-est
+    (implies (and (integerp n) 
+		  (> n 0)
+		  (rationalp x))
+	     (<= (abs (- x (near x n)))
+		 (expt 2 (- (expo x) n))))
+  :rule-classes ())
+
+
+(defthm near-power-a
+  (implies (and (rationalp x) (> x 0)
+                (integerp n) (> n 1)
+                (>= (+ x (expt 2 (- (expo x) n)))
+                    (expt 2 (1+ (expo x)))))
+           (= (near x n)
+              (expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+(defthm near-power-b
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (>= (+ x (expt 2 (- (expo x) n)))
+		      (expt 2 (1+ (expo x)))))
+	     (= (trunc (+ x (expt 2 (- (expo x) n))) n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ())
+
+;bad name?
+(defthm near-exactp
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (exactp x n))
+	     (equal (near x n) x))
+  :rule-classes ())
+
+(defthm near-trunc
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (near x n)
+		(if (and (exactp x (1+ n)) (not (exactp x n)))
+		    (trunc (+ x (expt 2 (- (expo x) n))) (1- n))
+		  (trunc (+ x (expt 2 (- (expo x) n))) n))))
+  :rule-classes ())
+
+;; ;BOZO yuck? bad name!
+;; (defthm sgn-near
+;;   (implies (and (rationalp x)
+;;                 (integerp n)
+;;                 (> n 0))
+;;            (= (near x n)
+;;               (* (sgn x) (near (abs x) n))))
+;;   :rule-classes ())
+
+
+
+(defthm plus-near-1
+  (implies (and (exactp x (+ k (- (expo x) (expo y))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                )
+           (= (re (* (expt 2 (1- k)) (sig y)))
+              (re (* (expt 2 (1- (+ k (- (expo (+ x y)) (expo y)))))
+                     (sig (+ x y))))))
+  :rule-classes nil)
+
+(defthm plus-near-2
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y)))))
+           (iff (evenp (fl (* (expt 2 (1- k)) (sig y))))
+                (evenp (fl (* (expt 2
+                                    (1- (+ k (- (expo (+ x y)) (expo y)))))
+                              (sig (+ x y)))))))
+
+  :rule-classes nil)
+
+(defthm plus-near
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y)))))
+           (= (+ x (near y k))
+              (near (+ x y)
+                    (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes nil)
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/ocat.lisp acl2-6.3/books/rtl/rel9/support/support/ocat.lisp
--- acl2-6.2/books/rtl/rel9/support/support/ocat.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/ocat.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,394 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(local (include-book "../../arithmetic/expt"))
+(local (include-book "../../arithmetic/expo"))
+(local (include-book "../../arithmetic/arith2"))
+(local (include-book "../../arithmetic/fp2"))
+(local (include-book "../../arithmetic/integerp"))                
+
+(local (in-theory (enable expt-minus)))
+
+(defund ocat (x y n)
+  (declare (xargs :guard t))
+  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
+
+
+(defthm ocat-nonnegative-integer-type
+  (and (integerp (OCAT X Y N))
+       (<= 0 (OCAT X Y N)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than ocat-nonnegative-integer-type and might be worse
+(in-theory (disable (:type-prescription ocat)))
+
+;just a rewrite rule
+(defthm ocat-natp
+  (natp (ocat x y n)))
+
+;became less general when we made ocat nfix its args
+(defthm ocat-0
+    (implies (and (case-split (<= 0 y))
+                  (case-split (integerp y)))		  
+	     (equal (ocat 0 y n) y))
+    :hints (("Goal" :in-theory (enable ocat))))
+
+;became less general when we made ocat nfix its args
+(defthm ocat-x-0-0
+  (implies (and (case-split (<= 0 x))
+                (case-split (integerp x)))
+           (equal (ocat x 0 0)
+                  x))
+  :hints (("Goal" :in-theory (enable ocat))))
+
+
+#|
+;old form:
+(defthm ocat-upper-bound
+  (implies (and (integerp x)
+                (bvecp y n) ;expensive?
+                (integerp n))
+           (< (ocat x y n)
+              (+ (* (expt 2 n) x) (expt 2 n))))
+  :hints (("Goal" :in-theory (enable ocat bvecp)))
+  :rule-classes (:rewrite (:linear :trigger-terms ((ocat x y n))))
+  )
+
+|#
+
+;this can be really expensive
+;old form:
+(defthm ocat-upper-bound
+  (implies (and (< y (expt 2 n))
+                (<= 0 x)
+                (integerp x)
+                (<= 0 y)
+                (integerp n)
+                (<= 0 n)
+                )
+           (< (ocat x y n)
+              (+ (* (expt 2 n) x) (expt 2 n))))
+  :hints (("Goal" :in-theory (enable ocat )))
+  :rule-classes (:rewrite (:linear :trigger-terms ((ocat x y n))))
+  )
+
+
+
+
+
+
+(encapsulate
+ ()
+ (local (defthm ocat-bvecp-rewrite-fw
+          (implies (and (integerp n)
+                        (<= 0 n)
+                        (integerp k)
+                        (<= 0 k)
+                        (integerp x)
+                        (<= 0 x)
+                        (>= k n) ;drop?
+                        (force (bvecp y n))
+                        )
+                   (implies (bvecp (ocat x y n) k)
+                            (bvecp x (- k n))))
+          :rule-classes nil
+          :hints (("goal" :in-theory (enable bvecp expt-split ocat)))
+          ))
+
+ (local (defthm hack-hack
+          (implies (and (integerp x)
+                        (integerp y)
+                        (integerp m)
+                        (<= 0 m)
+                        (integerp n)
+                        (<= 0 n)
+                        (< x (expt 2 m))
+                        (< y (expt 2 n))
+                        )
+                   (< (+ (/ y (expt 2 n)) x)
+                      (expt 2 m)))
+          :hints (("goal" :in-theory (set-difference-theories
+                                      (enable expt-split)
+                                      '())))))
+
+ (local (defthm hack-ocat
+          (implies (and (integerp x)
+                        (integerp y)
+                        (integerp m)
+                        (<= 0 m)
+                        (integerp n)
+                        (<= 0 n)
+
+                        (< x (expt 2 m))
+                        (< y (expt 2 n))
+                        )
+                   (< (+ y (* x (expt 2 n)))
+                      (expt 2 (+ m n))))
+          :hints (("goal" :in-theory (set-difference-theories
+                                      (enable expt-split)
+                                      '( hack-hack))
+                   :use (hack-hack
+                         (:instance  mult-both-sides-of-<-by-positive (a (+ x (* y (/ (expt 2 n)))))
+                                     (b (expt 2 m))
+                                     (c (expt 2 n))))))))
+
+ (local (in-theory (enable bvecp)))
+           
+ (local (defthm ocat-bvecp-rewrite-bk
+          (implies (and (integerp n)
+                        (<= 0 n)
+                        (integerp k)
+                        (<= 0 k)
+                        (integerp x)
+                        (<= 0 x)
+                        (>= k n) ;drop?
+                        (force (bvecp y n))
+                        )
+                   (implies
+                    (bvecp x (- k n))
+                    (bvecp (ocat x y n) k)))
+          :rule-classes nil
+          :hints (("goal" :in-theory (set-difference-theories
+                                      (enable ocat)
+                                      '(hack-ocat))
+                   :use (:instance hack-ocat (n n) (m (- k n)))))))
+
+ (defthm ocat-bvecp-rewrite
+   (implies (and (>= k n) ;handle the other case?
+                 (case-split (integerp x))
+                 (case-split (<= 0 x))
+                 (case-split (bvecp y n))
+                 (case-split (natp n))
+                 (case-split (natp k))
+                 )
+            (equal (bvecp (ocat x y n) k)
+                   (bvecp x (- k n))))
+   :hints (("goal" 
+            :use (ocat-bvecp-rewrite-fw ocat-bvecp-rewrite-bk))
+           ))
+
+ (local (defthm hack-4
+          (implies (and (integerp x)
+                        (<= 0 x)
+                        (not (equal x 0)))
+                   (>= x 1))))
+
+;expensive? handle this better somehow?
+ (local (defthm hack-3
+          (implies (and (integerp x)
+                        (<= 0 x)
+                        (not (equal x 0))
+                        (rationalp a)
+                        (<= 0 a)
+                        )
+                   (>= (* x a) a))
+          :rule-classes :linear
+          :hints (("goal" :in-theory (disable
+                                      hack-4
+;                                      cancel-in-prods-<
+ ;                                     cancel-times-<-eric-1
+                                      )
+                   :use (hack-4
+                         (:instance mult-both-sides-of-<-by-positive
+                                    (b a) (a (* a x)) (c (/ a))))))))
+
+
+;better names?
+ (defthm ocat-bvecp-other-case
+   (implies (and (< p n)
+                 (integerp n)
+                 (<= 0 n)
+                 (integerp p)
+                 (<= 0 p)
+                 (integerp x)
+                 (<= 0 x)
+                 (integerp y)
+                 (<= 0 y)
+                 )
+            (equal (bvecp (ocat x y n) p)
+                   (and (bvecp y p)
+                        (equal 0 x)))
+            )
+   :hints (("goal" :in-theory (set-difference-theories
+                               (enable power2p ocat)
+                               '(expt-compare
+                                 ))
+            :use (:instance expt-compare (lhs (expt 2 p)) (rhs (expt 2 n)))))
+   :otf-flg t
+   )
+ )
+
+
+#|
+;make more general
+;also make ncat ver
+(defthm highbits-ocat
+  (implies (and (integerp x)
+                (<= 0 x)
+                (force (bvecp y n))
+                (integerp n)
+                (<= 0 n)
+                )
+           (equal (highbits (OCAT x y n) n)
+                  x))
+  :hints (("Goal" :in-theory (enable expt-split
+                                     ocat 
+                                     highbits))))
+|#
+
+(local (defthm hack-10
+    (implies (and (integerp x)
+		  (integerp y)
+		  (< x y))
+	     (<= x (1- y)))
+  :rule-classes ()))
+
+(local (defthm ocat-bvecp-simple
+    (implies (and (natp n)
+		  (natp k)
+		  (bvecp x m)
+		  (natp m)
+		  (bvecp y n)
+		  (>= k (+ m n)))
+	     (bvecp (ocat x y n) k))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable natp bvecp ocat)
+                              '(expt-compare EXPT-COMPARE-EQUAL))
+		  :use ((:instance expt-split (i m) (j n) (r 2))
+			(:instance hack-10 (y (expt 2 m)))
+			(:instance expt-weak-monotone (m p))
+			(:instance expt-weak-monotone (m k) (n (+ m n))))))))
+
+(defthm ocat-bvecp
+    (implies (and (>= k n) ;handle other case?
+                  (bvecp x (- k n))
+                  (case-split (natp n))
+		  (case-split (natp k))
+		  (case-split (bvecp y n))
+                  )
+	     (bvecp (ocat x y n) k))
+  :hints (("Goal" :in-theory (enable natp bvecp)
+		  :use ((:instance ocat-bvecp-simple (m (- k n)))))))
+
+(defthm ocat-0-rewrite
+    (implies (and (case-split (integerp x))
+		  (case-split (<= 0 x)))
+	     (equal (ocat 0 x n) x))
+    :hints (("Goal" :in-theory (enable ocat))))
+
+(defthm ocat-with-x-not-a-natural
+  (implies (or (not (integerp x))
+               (< x 0))
+           (equal (ocat x y n)
+                  (nfix y)))
+  :hints (("Goal" :in-theory (enable ocat))))
+
+(defthm ocat-with-y-not-a-natural
+  (implies (or (not (integerp y))
+               (< y 0))
+           (equal (ocat x y n)
+                  (* (nfix x) (expt 2 (nfix n)))))
+  :hints (("Goal" :in-theory (enable ocat))))
+
+(defthm ocat-with-n-not-a-natural
+  (implies (or (not (integerp n))
+               (< n 0))
+           (equal (ocat x y n)
+                  (+ (nfix x) (nfix y))))
+  :hints (("Goal" :in-theory (enable ocat))))
+
+
+
+;might be able to generalize this more
+;this look like it will fire as often as we'd like
+(defthm ocat-upper-bound-2
+  (implies (and (< x (expt 2 k)) ; k is a free var. huh?
+                (case-split (< y (expt 2 n)))
+                (case-split (integerp k))
+                (case-split (<= 0 k))
+                (case-split (integerp n))
+                (case-split (<= 0 n))
+                )
+           (< (ocat x y n)
+              (expt 2 (+ n k))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bvecp expt-split)
+                              '(OCAT-BVECP-REWRITE OCAT-BVECP ))
+           :use ((:instance <-TRANSITIVE (a y) (b (expt 2 n)) (c (* (EXPT 2 K) (EXPT 2 N))))
+                 (:instance ocat-bvecp (k (+ n k)))))))
+
+(defthm ocat-associative
+  (implies (and (case-split (<= 0 m)) ;new now that ocat fixes its args
+                (case-split (<= 0 n)) ;new now that ocat fixes its args
+                (case-split (integerp m))
+                (case-split (integerp n))
+                )
+           (equal (ocat (ocat x y m) z n)
+                  (ocat x (ocat y z n) (+ m n))))
+  :hints (("Goal" :in-theory (enable ocat))))
+
+(defthm ocat-equal-0
+  (implies  (and (case-split (<= 0 x))
+                 (case-split (<= 0 y))
+                 (case-split (integerp x))
+                 (case-split (integerp y))
+                 )
+            (equal (equal (ocat x y n) 0)
+                   (and (equal x 0)
+                        (equal y 0))))
+  :hints (("Goal" :in-theory (enable ocat)))
+  )
+
+(defthm ocat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep y)
+                              (quotep n)
+                              (quotep m)))
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= m n))
+                (case-split (integerp m))
+                (case-split (integerp n)))
+           (equal (ocat x (ocat y z m) n)
+                  (ocat (ocat x y (- n m)) z m)))
+  :otf-flg t
+  :hints
+  (("goal" :in-theory (enable ocat))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/oddr-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/oddr-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/oddr-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/oddr-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,682 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+;(include-book "near")
+(local (include-book "../../arithmetic/top"))
+(local (include-book "float"))
+(local (include-book "trunc"))
+(local (include-book "away"))
+(local (include-book "near"))
+
+;; Necessary functions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+;;
+;; New stuff:
+;;
+
+(defund oddr (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x)))))
+    (if (evenp z)
+	(* (sgn x) (1+ z) (expt 2 (- (1+ (expo x)) n)))
+      (* (sgn x) z (expt 2 (- (1+ (expo x)) n))))))
+
+(defthm oddr-pos
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0))
+           (< 0 (oddr x n)))
+  :rule-classes ()
+  :otf-flg t
+  :hints (("Goal" :in-theory (e/d (oddr) ( SIG-LESS-THAN-1-MEANS-X-0 sig-lower-bound))
+           :use ((:instance sig-lower-bound)))))
+
+(defthm oddr>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (oddr x n) (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable oddr)
+		  :use ((:instance trunc)
+                        ))))
+
+;BOZO just opens up ODDR when x is positive
+;leave disabled!
+(defthmd oddr-rewrite
+    (implies (and (< 0 x) ;note this hyp
+                  (rationalp x)
+		  (integerp n)
+		  (< 0 n))
+	     (equal (oddr x n)
+		    (let ((z (fl (* (expt 2 (- (1- n) (expo x))) x))))
+		      (if (evenp z)
+			  (* (1+ z) (expt 2 (- (1+ (expo x)) n)))
+			(* z (expt 2 (- (1+ (expo x)) n)))))))
+  :hints (("Goal" :in-theory (enable sig sgn oddr expt-split))))
+
+(local 
+ (defthm hack2
+    (implies (and (integerp n)
+		  (rationalp x))
+	     (= (fl (* 1/2 x (expt 2 n)))
+		(fl (* x (expt 2 (1- n))))))
+    :hints (("Goal" :in-theory (enable expt)))
+  :rule-classes ()))
+
+(local
+ (defthm oddr-other-1
+    (implies (and (rationalp x)
+		 (> x 0)
+		 (integerp n)
+		 (> n 1))
+	     (= (trunc x (1- n))
+		(* (fl (/ (* (expt 2 (- (1- n) (expo x))) x) 2))
+		   (expt 2 (- (+ 2 (expo x)) n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable trunc-pos-rewrite)		  
+		  :use ((:instance hack2 (n (- (1- n) (expo x)))))))))
+
+(local
+ (defthm oddr-other-2
+    (implies (and (rationalp x)
+		 (> x 0)
+		 (integerp n)
+		 (> n 1))
+	     (= (trunc x (1- n))
+		(* (fl (/ (fl (* (expt 2 (- (1- n) (expo x))) x)) 2))
+		   (expt 2 (- (+ 2 (expo x)) n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable fl/int-rewrite)
+		  :use ((:instance oddr-other-1)
+			(:instance fl/int-rewrite (x (* (expt 2 (- (1- n) (expo x))) x)) (n 2)))))))
+
+;move!
+(defthm fl/2
+  (implies (integerp z)
+           (= (fl (/ z 2))
+              (if (evenp z)
+                  (/ z 2)
+                (/ (1- z) 2))))
+  :hints (("Goal" :in-theory (enable evenp)))
+  :rule-classes ())
+
+(local
+ (defthm oddr-other-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n) 
+		  (> n 1)
+		  (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
+		  (evenp z))
+	     (= (trunc x (1- n))
+		(* z (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fl/2)
+			(:instance expt-split (r 2) (j (- (1+ (expo x)) n)) (i 1))
+			(:instance oddr-other-2))))))
+
+(local
+ (defthm oddr-other-4
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n) 
+		  (> n 1)
+		  (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
+		  (not (evenp z)))
+	     (= (* (fl (/ (fl (* (expt 2 (- (1- n) (expo x))) x)) 2))
+		   (expt 2 (- (+ 2 (expo x)) n)))
+		(* (fl (/ z 2)) (expt 2 (- (+ 2 (expo x)) n)))))
+  :rule-classes ()))
+
+(local
+ (defthm oddr-other-5
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n) 
+		  (> n 1)
+		  (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
+		  (not (evenp z)))
+	     (= (trunc x (1- n))
+		(* (fl (/ z 2)) (expt 2 (- (+ 2 (expo x)) n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance oddr-other-2)
+			(:instance oddr-other-4))))))
+
+(local 
+ (defthm hack3
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp z)
+		  (equal x y))
+	     (= (* x z) (* y z)))
+  :rule-classes ()))
+
+(local
+ (defthm oddr-other-6
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 1)
+		  (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
+		  (not (evenp z)))
+	     (= (trunc x (1- n))
+		(* (/ (1- z) 2) (expt 2 (- (+ 2 (expo x)) n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fl/2)
+			(:instance oddr-other-5)
+			(:instance hack3
+				   (x (/ (1- z) 2))
+				   (y (fl (/ z 2)))
+				   (z (expt 2 (- (+ 2 (expo x)) n)))))))))
+
+(local
+ (defthm oddr-other-7
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp n)
+                 (> n 1)
+                 (= z (fl (* (expt 2 (- (1- n) (expo x))) x)))
+                 (not (evenp z)))
+            (= (trunc x (1- n))
+               (* (1- z) (expt 2 (- (1+ (expo x)) n)))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (enable expt-split)
+            :use ((:instance oddr-other-6)
+                  (:instance expt-split (r 2) (j (- (1+ (expo x)) n)) (i 1)))))))
+
+(defthm oddr-other
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n) 
+		  (> n 1))
+	     (= (oddr x n)
+		(+ (trunc x (1- n))
+		   (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance oddr-other-3 (z (fl (* (expt 2 (- (1- n) (expo x))) x))))
+			(:instance oddr-other-7 (z (fl (* (expt 2 (- (1- n) (expo x))) x))))
+			(:instance oddr-rewrite)))))
+
+(local
+ (defthm expo-oddr-1
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 0))
+	     (< (trunc x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d () ( expo-trunc abs-trunc))
+		  :use ((:instance expo-trunc)
+;			(:instance trunc-pos)
+			(:instance expo-upper-bound (x (trunc x n))))))))
+
+(local
+ (defthm expo-oddr-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (< (oddr x n) (expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (expt-split) ( expo-trunc abs-trunc))
+		  :use ((:instance expo-oddr-1 (n (1- n)))
+			(:instance oddr-other)
+			(:instance exactp-2**n (m (1- n)) (n (1+ (expo x))))
+			(:instance expo-trunc (n (1- n)))
+			(:instance expt-strong-monotone (n (- (1+ (expo x)) n)) (m (- (1+ (expo x)) (1- n))))
+;			(:instance trunc-pos (n (1- n)))
+			(:instance fp+2 (n (1- n)) (x (trunc x (1- n))) (y (expt 2 (1+ (expo x))))))))))
+
+(local
+ (defthm expo-oddr-3
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (<= (expo (oddr x n)) (expo x)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expo-oddr-2)
+			(:instance oddr-pos)
+			(:instance expo-upper-2 (x (oddr x n)) (n (1+ (expo x)))))))))
+
+(defthm expo-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (equal (expo (oddr x n)) (expo x)))
+  :hints (("Goal" :in-theory (e/d ( expt-split ) (EXPO-COMPARISON-REWRITE-TO-BOUND
+                                                  EXPO-COMPARISON-REWRITE-TO-BOUND-2))
+		  :use ((:instance expo-oddr-3)
+			(:instance oddr-other)
+;			(:instance expt-pos (x (- (1+ (expo x)) n)))
+			(:instance expo-monotone (y (oddr x n)) (x (trunc x (1- n))))
+			(:instance oddr-pos)
+;			(:instance trunc-pos (n (1- n)))
+                        ))))
+
+(local
+ (defthm exactp-oddr-1
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (= (* (+ (trunc x (1- n))
+		      (expt 2 (- (1+ (expo x)) n)))
+		   (expt 2 (- (1- n) (expo x))))
+		(1+ (* (trunc x (1- n)) (expt 2 (- (1- n) (expo x)))))))
+	     :rule-classes ()
+  :hints (("Goal" :in-theory (disable ;expt-pos
+                                      abs-trunc)
+		  :use ((:instance expt-split (r 2) (j (- (1- n) (expo x))) (i (- (1+ (expo x)) n))))))))
+
+(local
+ (defthm exactp-oddr-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (= (* (oddr x n) (expt 2 (- (1- n) (expo x))))
+		(1+ (* (trunc x (1- n)) (expt 2 (- (1- n) (expo x)))))))
+	     :rule-classes ()
+  :hints (("Goal" :in-theory (disable ;expt-pos
+                                      abs-trunc)
+		  :use ((:instance oddr-other)
+			(:instance exactp-oddr-1))))))
+
+(local
+ (defthm exactp-oddr-3
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (= (expt 2 (- (1- n) (expo x)))
+		(* 2 (expt 2 (- (- n 2) (expo x))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance expt-split (r 2) (j (- (- n 2) (expo x))) (i 1)))))))
+
+(local
+ (defthm exactp-oddr-4
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n))
+	     (= (* y 2 (expt 2 (- (- n 2) (expo x))))
+		(* 2 y (expt 2 (- (- n 2) (expo x))))))
+  :rule-classes ()))
+
+(local
+ (defthm exactp-oddr-5
+    (implies (and (rationalp x)
+		  (integerp n))
+	     (= (* (trunc x (1- n)) (expt 2 (- (1- n) (expo x))))
+		(* 2 (trunc x (1- n)) (expt 2 (- (- n 2) (expo x))))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance exactp-oddr-3)
+			(:instance exactp-oddr-4 (y (trunc x (1- n)))))))))
+
+(local
+ (defthm exactp-oddr-6
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (= (* (oddr x n) (expt 2 (- (1- n) (expo x))))
+		(1+ (* 2 (* (trunc x (1- n)) (expt 2 (- (- n 2) (expo x))))))))
+	     :rule-classes ()
+  :hints (("Goal" :in-theory (disable ;expt-pos
+                                      abs-trunc)
+		  :use ((:instance exactp-oddr-2)
+			(:instance exactp-oddr-5))))))
+
+(defthm exactp-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (exactp (oddr x n) n))
+	     :rule-classes ()
+  :hints (("Goal" :in-theory (disable ;expt-pos
+                                      abs-trunc)
+		  :use ((:instance exactp-oddr-6)
+			(:instance exactp2 (x (oddr x n)))
+			(:instance exactp2 (x (trunc x (1- n))) (n (1- n)))))))
+(local
+ (defthm not-exactp-oddr-1
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (= (* (+ (trunc x (1- n)) (expt 2 (- (1+ (expo x)) n)))
+		   (expt 2 (- (- n 2) (expo x))))
+		(+ (* (trunc x (1- n)) (expt 2 (- (- n 2) (expo x)))) 1/2)))
+	     :rule-classes ()
+	     :hints (("Goal" :use ((:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (- (1+ (expo x)) n))))))))
+
+(local
+ (defthm not-exactp-oddr-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (= (* (oddr x n)
+		   (expt 2 (- (- n 2) (expo x))))
+		(+ (* (trunc x (1- n)) (expt 2 (- (- n 2) (expo x)))) 1/2)))
+	     :rule-classes ()
+  :hints (("Goal" :use ((:instance oddr-other)
+			(:instance not-exactp-oddr-1))))))
+
+(defthm not-exactp-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (not (exactp (oddr x n) (1- n))))
+	     :rule-classes ()
+  :hints (("Goal" :in-theory (disable ;expt-pos
+                              EQUAL-MULTIPLY-THROUGH-BY-inverted-factor-FROM-RIGHT-HAND-SIDE
+                                      abs-trunc)
+		  :use ((:instance not-exactp-oddr-2)
+			(:instance exactp2 (x (oddr x n)) (n (1- n)))
+			(:instance exactp2 (x (trunc x (1- n))) (n (1- n)))))))
+
+(local
+ (defthm trunc-oddr-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 1))
+	     (= (trunc (oddr x n) (1- n))
+		(* (fl (* (expt 2 (- (- n 2) (expo x))) 
+			  (+ (* (fl (* (expt 2 (- (- n 2) (expo x)))
+				       x))
+				(expt 2 (- (+ (expo x) 2) n)))
+			     (expt 2 (- (1+ (expo x)) n)))))
+		   (expt 2 (- (+ (expo x) 2) n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable trunc-pos-rewrite)
+		  :use ((:instance oddr-other)
+			(:instance oddr-pos))))))
+
+(local
+ (defthm trunc-oddr-2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 1))
+	     (= (trunc (oddr x n) (1- n))
+		(* (fl (+ (fl (* (expt 2 (- (- n 2) (expo x)))
+				 x))
+			  1/2))
+		   (expt 2 (- (+ (expo x) 2) n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable a15)
+           :use ((:instance trunc-oddr-1)
+			(:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (- (+ (expo x) 2) n)))
+			(:instance expt-split (r 2) (i (- (- n 2) (expo x))) (j (- (+ (expo x) 1) n))))))))
+
+(local
+ (defthm trunc-oddr-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 1))
+	     (= (trunc (oddr x n) (1- n))
+		(* (fl (* (expt 2 (- (- n 2) (expo x)))
+			  x))
+		   (expt 2 (- (+ (expo x) 2) n)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-oddr-2))))))
+
+(local
+ (defthm trunc-oddr-4
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 1))
+	     (= (trunc (oddr x n) (1- n))
+		(trunc x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable trunc-pos-rewrite)
+		  :use ((:instance trunc-oddr-3))))))
+
+(defthm trunc-oddr
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (> n m))
+	     (= (trunc (oddr x n) m)
+		(trunc x m)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable trunc-trunc)
+           :use ((:instance trunc-oddr-4)
+			(:instance oddr-pos)
+			(:instance trunc-trunc (n (1- n)))
+			(:instance trunc-trunc (n (1- n)) (x (oddr x n)))
+                        ))))
+
+(defun kp (k x y)
+  (+ k (- (expo (+ x y)) (expo y))))
+
+(defthm oddr-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (> x 0)
+		  (> y 0)
+		  (> k 1)
+		  (> (+ (1- k) (- (expo x) (expo y))) 0)
+		  (exactp x (+ (1- k) (- (expo x) (expo y)))))
+	     (= (+ x (oddr y k))
+		(oddr (+ x y) (kp k x y))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance oddr-other (n k) (x y))
+			(:instance expo-monotone (x y) (y (+ x y)))
+			(:instance plus-trunc (k (1- k)))
+			(:instance oddr-other (x (+ x y)) (n (kp k x y)))))))
+
+(defthm trunc-trunc-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (trunc x k) (trunc (oddr y m) k)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-oddr (x y) (m k) (n m))
+			(:instance trunc-monotone (x y) (y x) (n k))))))
+
+(local
+ (defthm away-away-oddr-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (> (away x k) (trunc y (1- m))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance away-lower-pos (n k))
+			(:instance trunc-upper-pos (x y) (n (1- m))))))))
+
+(local
+ (defthm away-away-oddr-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (away x k) (+ (trunc y (1- m)) (expt 2 (- (+ (expo y) 2) m)))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance away-away-oddr-1)
+			(:instance fp+2 (x (trunc y (1- m))) (y (away x k)) (n (1- m)))
+			(:instance expo-trunc (x y) (n (1- m)))
+			(:instance trunc-exactp-a (x y) (n (1- m)))
+			(:instance away-exactp-a (n k))
+;			(:instance trunc-pos (x y) (n (1- m)))
+			(:instance exactp-<= (x (away x k)) (m k) (n (1- m))))))))
+
+(local
+ (defthm away-away-oddr-3
+   (implies (and (rationalp x)
+                 (rationalp y)
+                 (integerp m)
+                 (integerp k)
+                 (> x y)
+                 (> y 0)
+                 (> k 0)
+                 (>= (- m 2) k))
+            (> (away x k) (oddr y m)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (disable EXPT-COMPARE)
+            :use ((:instance away-away-oddr-2)
+                  (:instance oddr-other (x y) (n m))
+                  (:instance expt-strong-monotone (n (- (1+ (expo y)) m)) (m (- (+ (expo y) 2) m))))))))
+
+(defthm away-away-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (away x k) (away (oddr y m) k)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance away-away-oddr-3)
+			(:instance oddr-pos (x y) (n m))
+			(:instance away-exactp-c (a (away x k)) (x (oddr y m)) (n k))
+			(:instance away-exactp-a (n k))))))
+
+(defthm near-near-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (near x k) (near (oddr y m) k)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-exactp-a (n (1- m)) (x y))
+			(:instance oddr-pos (x y) (n m))
+;			(:instance trunc-pos (x y) (n (1- m)))
+			(:instance trunc-upper-pos (x y) (n (1- m)))
+			(:instance expo-trunc (x y) (n (1- m)))
+			(:instance oddr-other (x y) (n m))
+			(:instance expt-strong-monotone 
+				   (n (- (1+ (expo y)) m)) 
+				   (m (- (+ 2 (expo y)) m)))
+			(:instance near-near
+				   (n (- m 2))
+				   (a (trunc y (1- m)))
+				   (y (oddr y m)))))))
\ No newline at end of file
diff -Nru acl2-6.2/books/rtl/rel9/support/support/oddr.lisp acl2-6.3/books/rtl/rel9/support/support/oddr.lisp
--- acl2-6.2/books/rtl/rel9/support/support/oddr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/oddr.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,251 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+(local (include-book "oddr-proofs"))
+
+;; Necessary functions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+;;
+;; New stuff:
+;;
+
+(defund oddr (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x)))))
+    (if (evenp z)
+	(* (sgn x) (1+ z) (expt 2 (- (1+ (expo x)) n)))
+      (* (sgn x) z (expt 2 (- (1+ (expo x)) n))))))
+
+(defthm oddr-pos
+    (implies (and (< 0 x)
+                  (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< 0 (oddr x n)))
+  :rule-classes ())
+
+(defthm oddr>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (oddr x n) (trunc x n)))
+  :rule-classes ())
+
+;BOZO just opens up ODDR when x is positive
+;leave disabled!
+(defthmd oddr-rewrite
+    (implies (and (< 0 x) ;note this hyp
+                  (rationalp x)
+		  (integerp n)
+		  (< 0 n))
+	     (equal (oddr x n)
+		    (let ((z (fl (* (expt 2 (- (1- n) (expo x))) x))))
+		      (if (evenp z)
+			  (* (1+ z) (expt 2 (- (1+ (expo x)) n)))
+			(* z (expt 2 (- (1+ (expo x)) n))))))))
+
+;move!
+(defthm fl/2
+  (implies (integerp z)
+           (= (fl (/ z 2))
+              (if (evenp z)
+                  (/ z 2)
+                (/ (1- z) 2))))
+  :rule-classes ())
+
+(defthm oddr-other
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n) 
+		  (> n 1))
+	     (= (oddr x n)
+		(+ (trunc x (1- n))
+		   (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes ())
+
+(defthm expo-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (equal (expo (oddr x n)) (expo x))))
+
+(defthm exactp-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (exactp (oddr x n) n))
+	     :rule-classes ())
+
+
+(defthm not-exactp-oddr
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> x 0)
+		  (> n 1))
+	     (not (exactp (oddr x n) (1- n))))
+	     :rule-classes ())
+
+(defthm trunc-oddr
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (> n m))
+	     (= (trunc (oddr x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+;disable?
+(defun kp (k x y)
+  (+ k (- (expo (+ x y)) (expo y))))
+
+(defthm oddr-plus
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (> x 0)
+		  (> y 0)
+		  (> k 1)
+		  (> (+ (1- k) (- (expo x) (expo y))) 0)
+		  (exactp x (+ (1- k) (- (expo x) (expo y)))))
+	     (= (+ x (oddr y k))
+		(oddr (+ x y) (kp k x y))))
+  :rule-classes ())
+
+(defthm trunc-trunc-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (trunc x k) (trunc (oddr y m) k)))
+  :rule-classes ())
+
+(defthm away-away-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (away x k) (away (oddr y m) k)))
+  :rule-classes ())
+
+(defthm near-near-oddr
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp m)
+		  (integerp k)
+		  (> x y)
+		  (> y 0)
+		  (> k 0)
+		  (>= (- m 2) k))
+	     (>= (near x k) (near (oddr y m) k)))
+  :rule-classes ())
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/openers.lisp acl2-6.3/books/rtl/rel9/support/support/openers.lisp
--- acl2-6.2/books/rtl/rel9/support/support/openers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/openers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,70 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(program)
+
+; In this file, an event-control (evctl) data structure is either (posedge
+; clk), (negedge clk), or (even n).
+
+(defun negate-event-control (evctl)
+  (if (equal evctl '(even n))
+      (list 'not evctl)
+    (let* ((edge0 (car evctl))
+           (clk (cadr evctl))
+           (edge (case edge0
+                   (posedge 'pedge)
+                   (negedge 'nedge)
+                   (otherwise
+                    (er hard 'gen-model-preamble-common
+                        "Unable to handle edge specifier ~x0."
+                        edge0)))))
+      `(not (,edge (,clk (1- n)) (,clk n))))))
+
+(defun negate-event-control-list (x)
+  (declare (xargs :guard (true-listp x)))
+  (if (endp x)
+      nil
+    (cons (negate-event-control (car x))
+          (negate-event-control-list (cdr x)))))
+
+(defmacro def$open (name type &rest evctl-lst)
+  (if (eq type :skipped)
+      `(value-triple '(def$open ,name :skipped))
+    (let ((evctl-lst (if (eq type :input)
+                         (assert$ (null evctl-lst)
+                                  '((even n)))
+                       evctl-lst)))
+      `(defthm ,(intern-in-package-of-symbol
+                 (concatenate 'string (symbol-name name) "$OPEN")
+                 name)
+         (implies (and (integerp n)
+                       (< 0 n)
+                       ,@(negate-event-control-list evctl-lst))
+                  (equal (,name n)
+                         (,name (1- n))))
+         :hints (("Goal"
+                  :expand ((,name n)
+                           ,@(and (eq type :wire) `((,name (1- n)))))))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/package-defs.lisp acl2-6.3/books/rtl/rel9/support/support/package-defs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/package-defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/package-defs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,78 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;Miscellaneous symbols that are not in *acl2-exports*:
+
+(defmacro other-acl2-symbols ()
+  ''(local-defun local-defthm local-in-theory
+                 n ; clock argument
+                 defbvecp ; macro written out by compiler
+                 defclock ; macro written out by compiler
+                 defperiodic
+                 fast-clock  ;BOZO, is importing these into the packages, the right way to handle this?
+                 slow-clock-one-quantum-wide
+                 slow-clock-one-quantum-wide-shifted
+                 slow-clock-two-quanta-wide
+                 slow-clock-two-quanta-wide-shifted
+                 always-1
+                 posedge negedge edge ; for defclock macro, which we used to use
+                 pedge nedge ;for defperiodic macro
+                 $path ; path argument of signal functions
+                 sub1-induction ; for bvecp lemma hints
+                 ))
+
+;;Symbols that occur in the RTL translation.  Formerly the symbol UNKNOWN was excluded from this
+;;list so that the corresponding symbol in the "*" package could be assigned a different function
+;;definition; but the first argument of unknown can be in any package desired.
+
+(defmacro rtl-symbols ()
+  ''(log= log<> log< log<= log> log>= lnot logand1 logior1 logxor1 shft lshft
+          rshft cat mulcat bitn bits setbits setbitn mod+ mod* mod- bind
+          case-select if1 cond1 reset reset2 land lior lxor lcat n! arr0 natp1
+          as ag mk-bvarr mk-bvec ag2 as2
+          abs trunc near minf inf sticky sig expo bitvec ; appeared May 2004 (from rpl_main.cc)
+          expt ; appeared May 2004 (seems to come from r2s)
+          prop gen
+          unknown unknown2))
+
+;;Functions that are defined in the FP library:
+
+(defmacro fp-symbols ()
+  ''(natp fl cg fl-half bvecp bv-arrp sumbits sigm kap tau lamt lamg lamz lam1 lam2 lam3 lam4 lam0 lamb
+          expo sgn sig 
+          exactp fp+ bias esgnf eexpof esigf erepp eencodingp eencode edecode ndecode rebias-expo isgnf iexpof isigf 
+          nrepp drepp irepp nencodingp dencodingp iencodingp nencode dencode iencode ddecode idecode trunc away re 
+          near near-witness near+ sticky oddr kp inf minf ieee-mode-p rnd flip
+          rnd-const drnd drnd-original))
+
+;;ACL2 symbols that are imported by all packages:
+
+(defmacro shared-symbols ()
+  '(union-eq *acl2-exports*
+    (union-eq *common-lisp-symbols-from-main-lisp-package*
+     (union-eq (other-acl2-symbols)
+      (union-eq (fp-symbols)
+       (rtl-symbols))))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/rewrite-theory.lisp acl2-6.3/books/rtl/rel9/support/support/rewrite-theory.lisp
--- acl2-6.2/books/rtl/rel9/support/support/rewrite-theory.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/rewrite-theory.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,52 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; This little utility, rewrite-theory, was written by Matt Kaufmann.
+
+(in-package "ACL2")
+
+(program)
+
+(defun collect-rewrites (runes ans)
+  (cond
+   ((endp runes) (reverse ans))
+   ((eq (caar runes) :rewrite)
+    (collect-rewrites (cdr runes) (cons (car runes) ans)))
+   (t
+    (collect-rewrites (cdr runes) ans))))
+
+(defun rewrite-theory-fn (from to wrld)
+; Returns all rewrite rules introduced after FROM, up to and including TO.
+  (let ((diff (set-difference-theories-fn
+               (universal-theory-fn to wrld)
+               (universal-theory-fn from wrld)
+               t ;; Tue Oct 31 09:22:52 2006. Hanbing. changed to accomodate
+                 ;; the changes in ACL2 3.0.1
+               wrld)))
+    (collect-rewrites diff nil)))
+
+(defmacro rewrite-theory (from &optional (to ':here))
+  ; Returns all rewrite rules introduced after FROM up to and including TO.
+  (list 'rewrite-theory-fn from to 'world))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/rnd.lisp acl2-6.3/books/rtl/rel9/support/support/rnd.lisp
--- acl2-6.2/books/rtl/rel9/support/support/rnd.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/rnd.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1249 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;February, 1998
+;;;***************************************************************
+
+;put all the new defuns in this book together at the t
+
+(in-package "ACL2")
+
+(local (include-book "float"))
+(local (include-book "trunc"))
+(local (include-book "away"))
+(local (include-book "near"))
+(local (include-book "near+"))
+(local (include-book "sticky"))
+(local (include-book "bitn")) ; for roundup
+(local (include-book "land0")) ; for roundup
+(local (include-book "lior0")) ; for roundup
+
+;; Necessary functions:
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+;;
+;; New stuff:
+;;
+
+;Typically, we may plan to have inf and minf enabled, but we have a few lemmas about them anyway..
+
+(defund inf (x n)
+  (if (>= x 0)
+      (away x n)
+    (trunc x n)))
+
+(defund minf (x n)
+  (if (>= x 0)
+      (trunc x n)
+    (away x n)))
+
+(defund IEEE-MODE-P (mode)
+  (member mode '(trunc inf minf near)))
+
+(defund common-rounding-mode-p (mode)
+  (or (IEEE-mode-p mode) (equal mode 'away) (equal mode 'near+)))
+
+(defund rnd (x mode n)
+  (case mode
+    (away (away x n))
+    (near+ (near+ x n))
+    (trunc (trunc x n))
+    (inf (inf x n))
+    (minf (minf x n))
+    (near (near x n))
+    (otherwise 0)))
+
+(defund flip (m)
+  (case m
+    (inf 'minf)
+    (minf 'inf)
+    (t m)))
+
+;rounding constant..
+(defun rnd-const (e mode n)
+  (case mode
+    ((near near+) (expt 2 (- e n)))
+    ((inf away) (1- (expt 2 (1+ (- e n)))))
+    (otherwise 0)))
+
+(defthmd inf-minus
+  (equal (inf (* -1 x) n)
+         (* -1 (minf x n)))
+  :hints (("Goal" :in-theory (enable inf minf))))
+
+(defthmd minf-minus
+  (equal (minf (* -1 x) n)
+         (* -1 (inf x n)))
+  :hints (("Goal" :in-theory (enable inf minf))))
+
+(defthm inf-shift
+  (implies (and (rationalp x)
+                (integerp n)
+                (integerp k))
+           (= (inf (* x (expt 2 k)) n)
+              (* (inf x n) (expt 2 k))))
+  :hints (("Goal" :in-theory (enable inf)
+           )))
+
+(defthm minf-shift
+  (implies (and (rationalp x)
+                (integerp n)
+                (integerp k))
+           (= (minf (* x (expt 2 k)) n)
+              (* (minf x n) (expt 2 k))))
+  :hints (("Goal"  :in-theory (enable minf))))
+
+(defthm ieee-mode-p-implies-common-rounding-mode-p
+  (implies (IEEE-mode-p mode)
+           (common-rounding-mode-p mode))
+  :hints (("Goal" :in-theory (enable common-rounding-mode-p)))
+  :rule-classes (:rewrite; :forward-chaining
+                 ))
+
+(defthm rationalp-rnd
+  (rationalp (rnd x mode n))
+  :hints (("Goal" :in-theory (enable rnd)))
+  :rule-classes (:type-prescription))
+
+(defthmd rnd-minus
+  (equal (rnd (* -1 x) mode n)
+         (* -1 (rnd x (flip mode) n)))
+  :hints (("Goal" :in-theory (enable rnd flip  minf-minus inf-minus near+-minus))))
+
+(local (defthm rnd-const-thm-1
+         (implies (and (integerp n)
+                       (> n 1)
+                       (integerp x)
+                       (> x 0)
+                       (>= (expo x) n))
+                  (= (near x n)
+                     (if (and (exactp x (1+ n))
+                              (not (exactp x n)))
+                         (trunc (+ x (rnd-const (expo x) 'near n)) (1- n))
+                       (trunc (+ x (rnd-const (expo x) 'near n)) n))))
+         :rule-classes ()
+         :hints (("Goal"
+                  :use ((:instance near-trunc))))))
+
+(local (defthm rnd-const-thm-2
+    (implies (and (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (away x n)
+		(trunc (+ x (rnd-const (expo x) 'inf n)) n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2)
+		  :use ((:instance away-imp (m (1+ (expo x)))))))))
+
+(local (defthm rnd-const-thm-3
+    (implies (and (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (near+ x n)
+		(trunc (+ x (rnd-const (expo x) 'near+ n)) n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable exactp2)
+		  :use ((:instance near+trunc))))))
+
+(defthm RND-CONST-THM
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+		(if (and (eql mode 'near)
+			 (exactp x (1+ n))
+			 (not (exactp x n)))
+		    (trunc (+ x (rnd-const (expo x) mode n)) (1- n))
+		  (trunc (+ x (rnd-const (expo x) mode n)) n))))
+  :rule-classes ()
+  :hints (("Goal"  :in-theory (enable inf minf rnd common-rounding-mode-p ieee-mode-p)
+           :use (rnd-const-thm-1 rnd-const-thm-2 rnd-const-thm-3))))
+
+(defun roundup (x mode n)
+; Returns T when we should add an ulp after truncating x to n digits.
+  (case mode
+    (near+ (= (bitn x (- (expo x) n)) 1))
+    (near (and (= (bitn x (- (expo x) n)) 1)
+               (or (not (exactp x (1+ n)))
+                   (= (bitn x (- (1+ (expo x)) n)) 1))))
+    ((inf away) (not (exactp x n)))
+    (otherwise nil)))
+
+(local
+ (defthm exactp-preserved-up ; could perhaps manage with exactp-<= instead
+   (implies (and (integerp n)
+                 (< 0 n)
+                 (exactp x n))
+            (exactp x (1+ n)))
+   :hints (("Goal" :in-theory (enable exactp)
+            :expand ((expt 2 n))))))
+
+(local (include-book "merge"))
+
+;; (i-am-here) ;; Thu Oct 12 11:57:41 2006
+
+(local
+ (defthm roundup-thm-1
+   (implies (and (common-rounding-mode-p mode)
+                 (not (eq mode 'near))
+                 (not (eq mode 'near+))
+                 (integerp n)
+                 (> n 1)
+                 (integerp x)
+                 (> x 0)
+                 (>= (expo x) n))
+            (= (rnd x mode n)
+               (if (roundup x mode n)
+                   (fp+ (trunc x n) n)
+                 (trunc x n))))
+   :hints (("Goal"  :in-theory (enable inf minf rnd common-rounding-mode-p
+                                       ieee-mode-p)
+            :use (trunc-away trunc-exactp-b away-exactp-b)))))
+
+(local (include-book "bits-trunc"))
+
+(local
+ (defthm roundup-thm-2-1-1-1
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                        0))
+            (equal (trunc x n)
+                   (trunc x (1- n))))
+   :hints (("Goal" :use ((:instance bits-trunc-2 (k n)
+                                    (n (1+ (expo x))))
+                         (:instance bits-trunc-2 (k (1- n))
+                                    (n (1+ (expo x))))
+                         (:instance bits-plus-bitn (n (expo x))
+                                    (m (+ 1 (expo x) (* -1 n)))))
+            :expand ((expt 2 (+ 2 (expo x) (* -1 n))))))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-1-1
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                        0))
+            (exactp (trunc x n) (1- n)))
+   :hints (("Goal" :use roundup-thm-2-1-1-1))))
+
+(local
+ (defthm roundup-thm-2-1-2
+   (implies (and (not (exactp x n))
+                 (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (exactp x (+ 1 n)))
+            (equal (+ x (expt 2 (+ (expo x) (* -1 n))))
+                   (+ (trunc x n)
+                      (expt 2 (1+ (+ (expo x) (* -1 n)))))))
+   :hints (("Goal" :use trunc-away-a
+            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-1
+   (implies (and (not (exactp x n))
+                 (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (exactp x (+ 1 n))
+                 (not (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                             1)))
+            (equal (trunc (+ x (expt 2 (+ (expo x) (* -1 n))))
+                          (1- n))
+                   (trunc x n)))
+   :hints (("Goal" :in-theory (enable plus-trunc-corollary
+                                      expt-strong-monotone)
+            :use roundup-thm-2-1-2))))
+
+(local
+ (defthm roundup-thm-2-2
+   (implies (and (not (exactp x n))
+                 (exactp x (+ 1 n))
+                 (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x)))
+            (equal (bitn x (+ (expo x) (* -1 n)))
+                   1))
+   :hints (("Goal" :use ((:instance exact-k+1
+                                    (n (1+ (expo x)))
+                                    (k (+ (expo x) (* -1 n)))))))))
+
+(local
+ (encapsulate
+  ()
+
+  (local
+   (defthm roundup-thm-2-3-1-1-1
+     (implies (and (not (exactp x n))
+                   (exactp x (+ 1 n))
+                   (integerp n)
+                   (< 1 n)
+                   (integerp x)
+                   (< 0 x)
+                   (<= n (expo x))
+                   (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                          1))
+              (equal (bits x (expo x)
+                           (+ 1 (expo x) (* -1 n)))
+                     (+ 1
+                        (* 2
+                           (bits x (expo x)
+                                 (+ 2 (expo x) (* -1 n)))))))
+     :hints (("Goal" :use ((:instance bits-plus-bitn (n (expo x))
+                                      (m (+ 1 (expo x) (* -1 n)))))))))
+
+  (defthm roundup-thm-2-3-1-1
+    (implies (and (not (exactp x n))
+                  (exactp x (+ 1 n))
+                  (integerp n)
+                  (< 1 n)
+                  (integerp x)
+                  (< 0 x)
+                  (<= n (expo x))
+                  (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                         1))
+             (equal x
+                    (+ (trunc x (1- n))
+                       (expt 2 (+ (expo x) (* -1 n)))
+                       (expt 2 (+ 1 (expo x) (* -1 n))))))
+    :hints (("Goal"
+             :use ((:instance bits-trunc-2 (n (1+ (expo x)))
+                              (k (1+ n)))
+                   (:instance bits-plus-bitn (n (expo x))
+                              (m (+ (expo x) (* -1 n))))
+                   (:instance bits-plus-bitn (n (expo x))
+                              (m (+ 1 (expo x) (* -1 n))))
+                   (:instance bits-trunc-2 (n (1+ (expo x)))
+                              (k (1- n))))
+             :expand
+             ((expt 2 (+ 2 (expo x) (* -1 n)))))
+            ;; BOZO!! We can't put the following as part of Goal's :expand hint.
+            ("Subgoal 4" :expand ((expt 2 (+ 1 (expo x) (* -1 n)))))
+            ("Subgoal 1" :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
+    :rule-classes nil)))
+
+(local
+ (defthm roundup-thm-2-3-1-2
+   (implies (and (not (exactp x n))
+                 (exactp x (+ 1 n))
+                 (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                        1))
+            (equal (+ x (expt 2 (+ (expo x) (* -1 n))))
+                   (+ (trunc x (1- n))
+                      (expt 2 (+ 2 (expo x) (* -1 n))))))
+   :hints (("Goal" :use roundup-thm-2-3-1-1
+            :expand ((expt 2 (+ 2 (expo x) (* -1 n)))))
+           ("Subgoal 1" ; !! BOZO: avoid infinite by using separate subgoal hint
+            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-3-1
+   (implies (and (not (exactp x n))
+                 (exactp x (+ 1 n))
+                 (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                        1))
+            (exactp (+ x (expt 2 (+ (expo x) (* -1 n))))
+                    (1- n)))
+   :hints (("Goal" :use (roundup-thm-2-3-1-1
+                         roundup-thm-2-3-1-2
+                         (:instance fp+1
+                                    (x (trunc x (1- n)))
+                                    (n (1- n))))))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-3-2
+   (implies (and (not (exactp x n))
+                 (exactp x (+ 1 n))
+                 (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                        1))
+            (equal (+ (trunc x n)
+                      (expt 2 (+ 1 (expo x) (* -1 n))))
+                   (+ x (expt 2 (+ (expo x) (* -1 n))))))
+   :hints (("Goal" :use trunc-away-a
+            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-3
+   (implies (and (not (exactp x n))
+                 (exactp x (+ 1 n))
+                 (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ 1 (expo x) (* -1 n)))
+                        1))
+            (equal (trunc (+ x (expt 2 (+ (expo x) (* -1 n))))
+                          (1- n))
+                   (+ (trunc x n)
+                      (expt 2 (+ 1 (expo x) (* -1 n))))))
+   :hints (("Goal" :use (roundup-thm-2-3-1
+                         roundup-thm-2-3-2
+                         (:instance trunc-exactp-b
+                                    (x (+ x (expt 2 (+ (expo x) (* -1 n)))))
+                                    (n (1- n))))))))
+
+; We need a special case of the following lemma for roundup-thm-2-4, so let's
+; prove a nice version to include in the library.
+
+(defthmd trunc-split
+  (implies (and (= n (1+ (expo x)))
+                (>= x 0)
+                (integerp m)
+                (> m k)
+                (integerp k)
+                (> k 0))
+           (equal (trunc x m)
+                  (+ (trunc x k)
+                     (* (expt 2 (- n m))
+                        (bits x (1- (- n k)) (- n m))))))
+  :hints (("Goal" :use ((:instance expt-split (r 2)
+                                   (i (+ m (* -1 k)))
+                                   (j (+ 1 (expo x) (* -1 m))))
+                        bits-trunc-2
+                        (:instance bits-trunc-2 (k m)
+                                   (n (1+ (expo x))))
+                        (:instance bits-plus-bits (n (expo x))
+                                   (m (- (1+ (expo x)) m))
+                                   (p (- (1+ (expo x)) k)))))))
+
+(defund trunc-rem (x n)
+  (- x (trunc x n)))
+
+(defthm trunc-rem-small
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x)
+                (<= 0 x))
+           (< (trunc-rem x n)
+              (expt 2 (+ 1 (expo x) (* -1 n)))))
+  :hints (("Goal" :use (trunc-diff-pos trunc-rem)))
+  :rule-classes :linear)
+
+(defthm trunc-rem-nonnegative
+  (implies (and (integerp n)
+                (<= 0 n)
+                (rationalp x)
+                (<= 0 x))
+           (and (rationalp (trunc-rem x n))
+                (<= 0 (trunc-rem x n))))
+  :hints (("Goal" :use (trunc-lower-pos trunc-rem)))
+  :rule-classes :type-prescription)
+
+; First, break x into the high n bits, the next bit, and the rest.
+
+(local
+ (defthm roundup-thm-2-4-1
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ (expo x) (* -1 n)))
+                        1))
+            (equal x
+                   (+ (trunc x n)
+                      (expt 2 (- (expo x) n))
+                      (trunc-rem x (1+ n)))))
+   :hints (("Goal" :use ((:instance trunc-split
+                                    (n (1+ (expo x)))
+                                    (m (1+ n))
+                                    (k n)))
+            :in-theory (enable trunc-rem bitn)))
+   :rule-classes nil))
+
+; Next, trivially introduce fp+.  A key fact is that (exactp (fp+ (trunc x n)
+; n) n), by fp+1 and trunc-exact-b.  We need that fact in order to apply
+; plus-trunc-corollary.
+
+(local
+ (defthm roundup-thm-2-4-2
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ (expo x) (* -1 n)))
+                        1))
+            (equal (+ x (expt 2 (+ (expo x) (* -1 n))))
+                   (+ (fp+ (trunc x n) n)
+                      (trunc-rem x (1+ n)))))
+   :hints (("Goal" :use (roundup-thm-2-4-1)
+            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
+   :rule-classes nil))
+
+(local
+ (defthm expt-2-+-constant
+   (implies (and (syntaxp (quotep k))
+                 (integerp n)
+                 (<= 0 n)
+                 (integerp k)
+                 (<= 0 k))
+            (equal (expt 2 (+ k n))
+                   (* 2 (expt 2 (+ (1- k) n)))))
+   :hints (("Goal" :expand ((expt 2 (+ k n)))))))
+
+; Note: fp+-positive was first discovered at about this point.
+
+(local
+ (defthm roundup-thm-2-4-3
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ (expo x) (* -1 n)))
+                        1))
+            (equal (trunc (+ (fp+ (trunc x n) n)
+                             (trunc-rem x (1+ n)))
+                          n)
+                   (fp+ (trunc x n) n)))
+   :hints (("Goal" :use ((:instance fp+1 (x (trunc x n)))
+                         (:instance plus-trunc-corollary
+                                    (x (fp+ (trunc x n) n))
+                                    (y (trunc-rem x (1+ n))))
+                         (:instance trunc-rem-small (n (1+ n)))
+                         (:instance fp+1-2 (x (trunc x n))))
+            :in-theory (disable fp+ plus-trunc-corollary)))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-4
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ (expo x) (* -1 n)))
+                        1))
+            (equal (trunc (+ x (expt 2 (+ (expo x) (* -1 n))))
+                          n)
+                   (+ (trunc x n)
+                      (expt 2 (+ 1 (expo x) (* -1 n))))))
+   :hints (("Goal" :use (roundup-thm-2-4-2 roundup-thm-2-4-3)))))
+
+(local
+ (defthm roundup-thm-2-5-1
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ (expo x) (* -1 n)))
+                        0))
+            (equal x
+                   (+ (trunc x n)
+                      (trunc-rem x (1+ n)))))
+   :hints (("Goal" :use ((:instance trunc-split
+                                    (n (1+ (expo x)))
+                                    (m (1+ n))
+                                    (k n)))
+            :in-theory (enable trunc-rem bitn)))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-5-2
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (equal (bitn x (+ (expo x) (* -1 n)))
+                        0))
+            (equal (+ x (expt 2 (+ (expo x) (* -1 n))))
+                   (+ (trunc x n)
+                      (expt 2 (+ (expo x) (* -1 n)))
+                      (trunc-rem x (1+ n)))))
+   :hints (("Goal" :use (roundup-thm-2-5-1)
+            :expand ((expt 2 (+ 1 (expo x) (* -1 n))))))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-5-3
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x)))
+            (< (+ (expt 2 (+ (expo x) (* -1 n)))
+                  (trunc-rem x (1+ n)))
+               (expt 2 (+ 1 (expo x) (* -1 n)))))
+   :hints (("Goal" :expand ((expt 2 (+ 1 (expo x) (* -1 n))))
+            :use ((:instance trunc-rem-small (n (1+ n))))))
+   :rule-classes nil))
+
+(local
+ (defthm roundup-thm-2-5
+   (implies (and (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x))
+                 (not (equal (bitn x (+ (expo x) (* -1 n)))
+                             1)))
+            (equal (trunc (+ x (expt 2 (+ (expo x) (* -1 n))))
+                          n)
+                   (trunc x n)))
+   :hints (("Goal" :use ((:instance plus-trunc-corollary
+                                    (x (trunc x n))
+                                    (y (+ (trunc-rem x (+ 1 n))
+                                          (expt 2 (+ (expo x) (* -1 n))))))
+                         roundup-thm-2-5-2
+                         roundup-thm-2-5-3)
+            :in-theory (disable fp+ plus-trunc-corollary)))))
+
+(local
+ (defthm roundup-thm-2-6
+   (implies (and (exactp x n)
+                 (integerp n)
+                 (< 1 n)
+                 (integerp x)
+                 (< 0 x)
+                 (<= n (expo x)))
+            (equal (bitn x (+ (expo x) (* -1 n)))
+                   0))
+   :hints (("Goal" :use ((:instance exact-bits-1
+                                    (n (1+ (expo x)))
+                                    (k (- (1+ (expo x)) n)))
+                         (:instance exact-bits-3
+                                    (k (- (1+ (expo x)) n))))))))
+
+(local
+ (defthm roundup-thm-2
+   (implies (and (eq mode 'near)
+                 (integerp n)
+                 (> n 1)
+                 (integerp x)
+                 (> x 0)
+                 (>= (expo x) n))
+            (= (rnd x mode n)
+               (if (roundup x mode n)
+                   (fp+ (trunc x n) n)
+                 (trunc x n))))
+   :hints (("Goal"  :in-theory (enable rnd)
+            :use (near-exactp-a rnd-const-thm-1)))
+   :rule-classes ()))
+
+(local
+ (defthm roundup-thm-3
+   (implies (and (eq mode 'near+)
+                 (integerp n)
+                 (> n 1)
+                 (integerp x)
+                 (> x 0)
+                 (>= (expo x) n))
+            (= (rnd x mode n)
+               (if (roundup x mode n)
+                   (fp+ (trunc x n) n)
+                 (trunc x n))))
+   :hints (("Goal"  :in-theory (enable rnd)
+            :use near+trunc))
+   :rule-classes ()))
+
+(defthm roundup-thm
+    (implies (and (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 1)
+		  (integerp x)
+		  (> x 0)
+		  (>= (expo x) n))
+	     (= (rnd x mode n)
+                (if (roundup x mode n)
+                    (fp+ (trunc x n) n)
+                  (trunc x n))))
+  :hints (("Goal"  :in-theory (enable common-rounding-mode-p)
+           :use (roundup-thm-1
+                 roundup-thm-2
+                 roundup-thm-3)))
+  :rule-classes ())
+
+
+(encapsulate () 
+   (local 
+    (defthmd rnd-sticky-support
+      (implies (and (> n (1+ k))
+                    (common-rounding-mode-p mode)
+                    (rationalp x) (> x 0)
+                    (integerp k) (> k 0)
+                    (integerp n) )
+               (equal (rnd (sticky x n) mode k)
+                      (rnd x mode k)))
+      :hints (("Goal" :in-theory (enable rnd minf inf)
+               :use (sticky-pos
+                     (:instance trunc-sticky (m k))
+                     (:instance away-sticky (m k))
+                     (:instance near-sticky (m k))
+                     (:instance near+-sticky (m k)))))))
+
+   (defthmd rnd-sticky
+     (implies (and (common-rounding-mode-p mode)
+                   (rationalp x)
+                   (integerp m) 
+                   (> m 0)
+                   (integerp n) 
+                   (>= n (+ m 2)))
+              (equal (rnd (sticky x n) mode m)
+                     (rnd x mode m)))
+     :hints (("Goal" :cases ((not (equal x 0)))
+              :in-theory (enable rnd-minus flip rnd sticky-minus))
+             ("Subgoal 1" :cases ((not (> x 0))))
+             ("Subgoal 1.2" 
+              :use ((:instance rnd-sticky-support
+                               (k m))))
+             ("Subgoal 1.1" 
+              :use ((:instance rnd-sticky-support
+                               (k m)
+                               (mode (flip mode))
+                               (x (* -1 x))))))))
+
+
+
+(defthm rnd-shift
+  (implies (and (rationalp x)
+                (integerp n)
+                (common-rounding-mode-p mode)
+                (integerp k))
+           (= (rnd (* x (expt 2 k)) mode n)
+              (* (rnd x mode n) (expt 2 k))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable rnd IEEE-MODE-P
+                                     common-rounding-mode-p)
+           :use (trunc-shift
+                 away-shift
+                 near-shift
+                 near+-shift
+                 inf-shift
+                 minf-shift
+                 ))))
+;elim <-- why?
+;; (i-am-here)
+
+(defthm expo-rnd
+    (implies (and (rationalp x)
+		  ;; (not (= x 0))
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode)
+		  (not (= (abs (rnd x mode n))
+			  (expt 2 (1+ (expo x))))))
+	     (= (expo (rnd x mode n))
+		(expo x)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable common-rounding-mode-p
+                                     ieee-mode-p near near+ rnd minf inf)
+		  :use (expo-trunc expo-away))))
+
+;better rule-classes?
+(defthm rnd-pos
+  (implies (and (< 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (> (rnd x mode n) 0))
+  :rule-classes (:type-prescription)
+  :hints (("goal" :in-theory (enable common-rounding-mode-p ieee-mode-p near rnd inf minf)
+           :use ())))
+
+(defthm rnd-0
+  (equal (rnd 0 mode n) 
+         0)
+  :hints (("Goal" :in-theory (enable rnd common-rounding-mode-p ieee-mode-p inf minf)
+           :use (trunc-0 away-0))))
+
+;better rule-classes?
+(defthm rnd-neg
+  (implies (and (< x 0)
+                (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (rnd x mode n) 0))
+  :rule-classes (:type-prescription)
+  :hints (("Goal" :in-theory (enable rnd common-rounding-mode-p ieee-mode-p inf minf)
+           :use (
+                 near-neg))))
+
+;would like to not open minf, inf here?
+(defthm rnd-non-pos
+  (implies (<= x 0)
+           (<= (rnd x mode n) 0))
+  :hints (("goal" :in-theory (enable rnd near+ inf minf)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+;would like to not open minf, inf here?
+;add to lib?
+(defthm rnd-non-neg
+  (implies (<= 0 x)
+           (<= 0 (rnd x mode n)))
+  :hints (("goal" :in-theory (enable rnd near+ inf minf)))
+  :rule-classes (:rewrite :type-prescription :linear))
+
+(defthm sgn-rnd
+  (implies (and; (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n)
+                (> n 0)
+                )
+           (equal (sgn (rnd x mode n))
+                  (sgn x)))
+  :hints (("Goal" :in-theory (enable ieee-mode-p common-rounding-mode-p rnd near+ inf minf) 
+           :use (sgn-trunc
+                 sgn-away
+                 sgn-near-2))))
+
+;enable?
+(defthmd rnd-exactp-b
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n) 
+                (> n 0))
+           (equal (equal x (rnd x mode n))
+                  (exactp x n)))
+  :hints (("Goal" :in-theory (enable ieee-mode-p common-rounding-mode-p rnd near+ minf inf)
+           :use (near-exactp-b
+                 trunc-exactp-b
+                 away-exactp-b))))
+
+(defthm rnd-exactp-a
+    (implies (< 0 n)
+	     (exactp (rnd x mode n) n))
+  :hints (("Goal" :in-theory (enable rnd near+ minf inf))))
+
+
+;; (i-am-here)
+
+(defthmd rnd-exactp-c
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (>= a x))
+	     (>= a (rnd x mode n)))
+    :hints (("Goal" :in-theory (enable trunc-minus inf minf 
+                                       common-rounding-mode-p
+                                       ieee-mode-p flip rnd)
+             :use ((:instance trunc-exactp-c
+                              (x (* -1 x)) (a (* -1 a)))
+                   (:instance away-exactp-c)
+                   (:instance near-exactp-c)
+                   (:instance near+-exactp-c)))))
+
+
+(defthmd rnd-exactp-d
+    (implies (and (rationalp x)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0)
+		  (rationalp a)
+		  (exactp a n)
+		  (<= a x))
+	     (<= a (rnd x mode n)))
+    :hints (("Goal" :in-theory (enable away-minus inf minf
+                                       common-rounding-mode-p
+                                       ieee-mode-p flip rnd)
+             :use ((:instance trunc-exactp-c)
+                   (:instance away-exactp-c
+                              (x (* -1 x)) (a (* -1 a)))
+                   (:instance near-exactp-d)
+                   (:instance near+-exactp-d)))))
+
+
+;; (defthm rnd-exactp-d
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (common-rounding-mode-p mode)
+;; 		  (integerp n)
+;; 		  (> n 0)
+;; 		  (rationalp a)
+;; 		  (exactp a n)
+;; 		  (<= a x))
+;; 	     (<= a (rnd x mode n)))
+;;   :hints (("Goal" :in-theory (enable ieee-mode-p common-rounding-mode-p rnd minf inf)
+;; 		  :use (near-exactp-c
+;; 			trunc-exactp-c
+;; 			away-lower-pos))))
+
+
+;; (defthm rnd<=away
+;;     (implies (and (rationalp x)
+;; 		  (> x 0)
+;; 		  (common-rounding-mode-p mode)
+;; 		  (integerp n)
+;; 		  (> n 0))
+;; 	     (<= (rnd x mode n) (away x n)))
+;;   :rule-classes ()
+;;   :hints (("Goal" :in-theory (enable ieee-mode-p rnd minf inf)
+;; 		  :use (trunc-upper-pos
+;; 			away-lower-pos
+;; 			near-choice))))
+
+
+
+(defthm rnd<=away
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (common-rounding-mode-p mode)
+		  (natp n))
+	     (<= (rnd x mode n) (away x n)))
+    :hints (("Goal" :in-theory (enable ieee-mode-p
+                                       near near+
+                                       common-rounding-mode-p
+                                       inf minf
+                                       trunc-upper-pos
+                                       away-lower-pos
+                                       flip rnd)))
+  :rule-classes ())
+
+
+(defthm rnd>=trunc
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (common-rounding-mode-p mode)
+		  (integerp n)
+		  (> n 0))
+	     (>= (rnd x mode n) (trunc x n)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable ieee-mode-p common-rounding-mode-p rnd minf inf)
+		  :use (trunc-upper-pos
+			away-lower-pos
+			near-choice))))
+
+
+
+(defthmd rnd-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+		  (rationalp y)
+		  (common-rounding-mode-p mode)
+                  (integerp n)
+                  (> n 0))
+	     (<= (rnd x mode n) (rnd y mode n)))
+    :hints (("Goal" :in-theory (enable ieee-mode-p
+                                       common-rounding-mode-p
+                                trunc-positive
+                                trunc-negative
+                                away-positive
+                                away-negative
+                                away-monotone
+                                inf minf
+                                trunc-monotone
+                                near-monotone
+                                near+-monotone
+                                flip rnd)
+             :use ((:instance away-monotone)))))
+
+
+
+(defthm exactp-rnd
+  (implies (and (rationalp x)
+                (common-rounding-mode-p mode)
+                (integerp n)
+                (> n 0))
+           (exactp (rnd x mode n) n))
+  :hints (("Goal" :in-theory (enable ieee-mode-p common-rounding-mode-p rnd inf minf))))
+
+(defthm rnd-choice
+  (implies (common-rounding-mode-p mode)
+           (or (equal (rnd x mode n) (rnd x 'away n))
+               (equal (rnd x mode n) (rnd x 'trunc n))))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable rnd near+ inf minf near common-rounding-mode-p ieee-mode-p)
+                              '(re evenp))))
+  :rule-classes nil)
+
+(defthm ieee-mode-p-flip
+    (implies (ieee-mode-p m)
+	     (ieee-mode-p (flip m)))
+    :hints (("Goal" :in-theory (enable ieee-mode-p flip))))
+
+(defthm common-rounding-mode-p-flip
+    (implies (common-rounding-mode-p m)
+	     (common-rounding-mode-p (flip m)))
+    :hints (("Goal" :in-theory (enable ieee-mode-p flip))))
+
+
+(defthm expo-rnd-bnd
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+		  (common-rounding-mode-p mode))
+	     (>= (expo (rnd x mode n))
+		 (expo x)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable expo-minus)
+           :use (expo-rnd
+			(:instance expo-minus (x (rnd x mode n)))))))
+
+(defthm plus-inf
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (inf y k))
+		(inf (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable inf)
+           :use plus-away)))
+
+(defthm plus-minf
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (rationalp y)
+		  (>= y 0)
+		  (integerp k)
+		  (exactp x (+ k (- (expo x) (expo y)))))
+	     (= (+ x (minf y k))
+		(minf (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable minf)
+           :use plus-trunc)))
+
+;make alt form too?
+; add to lib?
+(defthm plus-rnd
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ -1 k (- (expo x) (expo y))))
+                (common-rounding-mode-p mode))
+           (= (+ x (rnd y mode k))
+              (rnd (+ x y)
+                   mode
+                   (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes nil
+  :hints (("Goal" :in-theory (enable rnd ieee-mode-p COMMON-ROUNDING-MODE-P) 
+           :use (plus-near
+                 plus-near+
+                 plus-away
+                 plus-trunc 
+                 plus-minf 
+                 plus-inf
+                 (:instance exactp-<= (m (+ -1 k (- (expo x) (expo y))))
+                            (n (+  k (- (expo x) (expo y)))))))))
+
+(defthm rnd-rarely-zero
+  (implies (and (rationalp x)
+                (integerp k)
+                (case-split (< 0 k))
+                (case-split (common-rounding-mode-p mode)))
+           (equal (equal (rnd x mode k) 0)
+                  (equal x 0)
+           ))
+  :hints (("Goal" :in-theory (enable rnd near+ minf inf near COMMON-ROUNDING-MODE-P ieee-mode-p))))
+
+;add to lib?
+(defthm flip-flip
+  (equal (flip (flip mode))
+         mode)
+  :hints (("Goal" :in-theory (enable flip))))
+
+;add to lib?
+(defthm inf-lower-bound
+  (implies (and (rationalp x)
+                (integerp n))
+           (>= (inf x n) x))
+  :hints (("Goal" :in-theory (enable inf)
+           :use trunc-upper-bound))
+  :rule-classes (:rewrite :linear))
+
+;add to lib?
+(defthm minf-upper-bound
+  (implies (and (rationalp x)
+                (integerp n))
+           (<= (minf x n) x))
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable minf)
+                              '(abs-away))
+           :use away-lower-bound))
+  :rule-classes (:rewrite :linear))
+
+
+;add to lib?
+(defthm rnd-diff
+  (implies (and (rationalp x)
+                (integerp n)
+                (> n 0)
+                (common-rounding-mode-p mode))
+           (< (abs (- x (rnd x mode n))) (expt 2 (- (1+ (expo x)) n))))
+  :hints (("Goal" :in-theory (enable rnd near near+ inf minf ieee-mode-p common-rounding-mode-p)
+           :use (trunc-diff away-diff))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/rom-helpers.lisp acl2-6.3/books/rtl/rel9/support/support/rom-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/support/rom-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/rom-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,62 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+(local (in-theory (enable bvecp)))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defun check-array (name a dim1 dim2)
+  (if (zp dim1)
+      t
+    (and (bvecp (aref1 name a (1- dim1)) dim2)
+	 (check-array name a (1- dim1) dim2))))
+
+(defthm check-array-lemma-1
+    (implies (and (not (zp dim1))
+		  (check-array name a dim1 dim2)
+		  (natp i)
+		  (< i dim1))
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ())
+
+(defthm check-array-lemma
+    (implies (and (bvecp i n)
+		  (not (zp (expt 2 n)))
+		  (check-array name a (expt 2 n) dim2))		  
+	     (bvecp (aref1 name a i) dim2))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance check-array-lemma-1 (dim1 (expt 2 n)))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/round-extra.lisp acl2-6.3/books/rtl/rel9/support/support/round-extra.lisp
--- acl2-6.2/books/rtl/rel9/support/support/round-extra.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/round-extra.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,352 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+; This book was originally certified (in some directory, probably not support/)
+; starting with:
+
+; (include-book "rtl/rel4/lib/top" :dir :system)
+
+; Then that form was replaced by the forms below, up through the form (local
+; (in-theory (theory 'lib-top1))).  See the comments at the top of
+; fadd-extra.lisp for further explanation of how to extend the library.
+
+(include-book "sticky") ; needed for some definitions
+(include-book "util")   ; needed for definition of local-defthm
+
+; Now put ourselves in what amounts to the environment of ../lib/top, as
+; explained above.
+(local (include-book "top1"))
+(local (in-theory (theory 'lib-top1)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; sticky-monotone
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; Here is David Russinoff's proof outline for sticky-monotone.
+
+; Proof:
+; 
+; By sticky-pos, sticky-0, and sticky-minus, we may assume x > 0.
+; 
+; By expo-sticky, we nay assume expo(x) = expo(y).
+; 
+; By trunc-monotone and the definition of sticky, we nay assume that
+; y is (n-1)-exact and x is not (n-1)-exact.
+; 
+; By fp+2, since y > x > trunc(x,n-1), 
+; 
+;   sticky(y,n) = y 
+;              >= fp+(trunc(x,n-1),n-1)
+;               = trunc(x,n-1) + 2^(expo(trunc(x,n-1)) + 1 - (n-1))
+;               > trunc(x,n-1) + 2^(expo(trunc(x,n-1)) + 1 - n)
+;               = trunc(x,n-1) + 2^(expo(x) + 1 - n)
+;               = sticky(x,n).
+
+; [end of proof outline for sticky-monotone]
+
+(local-defthm main-1
+  (implies (and (<= x y)
+                (< 0 x)
+                (equal (expo x) (expo y))
+                (exactp y (1- n))
+                (not (exactp x (1- n)))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 1))
+           (>= y (fp+ (trunc x (1- n)) (1- n))))
+  :hints (("Goal" :use ((:instance fp+2
+                                   (y y)
+                                   (x (trunc x (1- n)))
+                                   (n (1- n))))
+           :in-theory (enable trunc-upper-pos)))
+  :rule-classes nil)
+
+(local-defthm main-2
+  (implies (and (<= x y)
+                (< 0 x)
+                (equal (expo x) (expo y))
+                (exactp y (1- n))
+                (not (exactp x (1- n)))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 1))
+           (> (fp+ (trunc x (1- n)) (1- n))
+              (+ (trunc x (1- n))
+                 (expt 2 (+ (expo (trunc x (1- n)))
+                            1
+                            (- n))))))
+  :hints (("Goal" :use ((:instance expt-strong-monotone
+                                   (n (+ 1 (expo x) (* -1 n)))
+                                   (m (+ 2 (expo x) (* -1 n)))))))
+  :rule-classes nil)
+
+(local-defthm main
+  (implies (and (<= x y)
+                (< 0 x)
+                (equal (expo x) (expo y))
+                (exactp y (1- n))
+                (not (exactp x (1- n)))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 1))
+           (>= y (sticky x n)))
+  :hints (("Goal" :use (main-1 main-2)
+           :in-theory (enable sgn)
+           :expand ((sticky x n))))
+  :rule-classes nil)
+
+(local-defthm sticky-monotone-pos-main-1
+  (implies (and (<= x y)
+                (< 0 x)
+                (equal (expo x) (expo y))
+                (exactp y (1- n))
+                (not (exactp x (1- n)))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 1))
+           (<= (sticky x n) (sticky y n)))
+  :hints (("Goal" :use main
+           :expand ((sticky y n))))
+  :rule-classes nil)
+
+(local-defthm sticky-monotone-pos-main-2
+  (implies (and (<= x y)
+                (< 0 x)
+                (equal (expo x) (expo y))
+                (not (exactp y (1- n)))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 1))
+           (<= (sticky x n) (sticky y n)))
+  :hints (("Goal" :in-theory (enable sticky sgn)
+           :use ((:instance trunc-monotone (n (1- n)))
+                 (:instance trunc-exactp-b (x x) (n (1- n))))))
+  :rule-classes nil)
+
+(local-defthm sticky-monotone-pos-main-3
+  (implies (and (<= x y)
+                (< 0 x)
+                (equal (expo x) (expo y))
+                (exactp x (1- n))
+                (exactp y (1- n))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 1))
+           (<= (sticky x n) (sticky y n)))
+  :hints (("Goal" :in-theory (enable sticky)))
+  :rule-classes nil)
+
+(defthm sticky-monotone-pos-main-n=1
+  (implies (and (<= x y)
+                (< 0 x)
+                (equal (expo x) (expo y))
+                (rationalp x)
+                (rationalp y))
+           (<= (sticky x 1) (sticky y 1)))
+  :hints (("Goal" :expand ((sticky x 1) (sticky y 1))
+           :in-theory (enable sgn)))
+  :rule-classes nil)
+
+(local-defthm sticky-monotone-pos-main
+  (implies (and (<= x y)
+                (< 0 x)
+                (equal (expo x) (expo y))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (<= (sticky x n) (sticky y n)))
+  :hints (("Goal" :use (sticky-monotone-pos-main-1
+                        sticky-monotone-pos-main-2
+                        sticky-monotone-pos-main-3
+                        sticky-monotone-pos-main-n=1)
+           :in-theory (enable sgn)))
+  :rule-classes nil)
+
+(local-defthm sticky-monotone-pos-main-alt-1
+  (implies (and (<= x y)
+                (< 0 x)
+                (< (expo x) (expo y))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (< (expo (sticky x n)) (expo (sticky y n))))
+  :hints (("Goal" :use ((:instance expo-sticky (x x))
+                        (:instance expo-sticky (x y)))))
+  :rule-classes nil)
+
+(local-defthm sticky-monotone-pos-main-alt
+  (implies (and (<= x y)
+                (< 0 x)
+                (< (expo x) (expo y))
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (<= (sticky x n) (sticky y n)))
+  :hints (("Goal" :use (sticky-monotone-pos-main-alt-1
+                        (:instance expo-monotone
+                                   (x (sticky y n))
+                                   (y (sticky x n))))
+
+           :in-theory (enable sticky-pos)))
+  :rule-classes nil)
+
+(local-defthm sticky-monotone-pos
+  (implies (and (<= x y)
+                (< 0 x)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (<= (sticky x n) (sticky y n)))
+  :hints (("Goal" :use (sticky-monotone-pos-main
+                        sticky-monotone-pos-main-alt
+                        expo-monotone)))
+  :rule-classes nil)
+
+(local-defthm sticky-monotone-neg
+  (implies (and (<= x y)
+                (< y 0)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                (> n 0))
+           (<= (sticky x n) (sticky y n)))
+  :hints (("Goal" :use ((:instance sticky-monotone-pos
+                                   (x (- y))
+                                   (y (- x))))
+           :in-theory (enable sticky-minus)))
+  :rule-classes nil)
+
+(local-defthm sticky-nonneg-type-prescription
+  (implies (and (<= 0 x)
+                (rationalp x)
+                (integerp n)
+                (> n 0))
+           (and (rationalp (sticky x n))
+                (>= (sticky x n) 0)))
+  :hints (("Goal" :in-theory (enable sticky-pos)
+           :use ((:theorem (implies (and (<= 0 x)
+                                         (rationalp x))
+                                    (or (equal x 0)
+                                        (< 0 x)))))))
+  :rule-classes :type-prescription)
+
+(local-defthm sticky-nonpos-type-prescription
+  (implies (and (<= x 0)
+                (rationalp x)
+                (integerp n)
+                (> n 0))
+           (and (rationalp (sticky x n))
+                (<= (sticky x n) 0)))
+  :hints (("Goal" :use ((:instance sticky-nonneg-type-prescription
+                                   (x (- x))))
+           :in-theory (enable sticky-minus)))
+  :rule-classes :type-prescription)
+
+;;(i-am-here) ;; Fri Oct 13 12:30:27 2006
+
+(encapsulate () 
+    (local 
+       (defthmd sticky-monotone-support
+         (implies (and (<= x y)
+                       (rationalp x)
+                       (rationalp y)
+                       (integerp n)
+                       (> n 0))
+                  (<= (sticky x n) (sticky y n)))
+         :hints (("Goal" :use (sticky-monotone-pos
+                               sticky-monotone-neg)))
+         :rule-classes :linear))
+
+    (encapsulate () 
+       (local (include-book "trunc"))
+       (defthm trunc-to-0
+         (implies (and (integerp n)
+                       (<= n 0))
+                  (equal (trunc x n) 0))
+         :hints (("Goal" :by trunc-to-0-or-fewer-bits))))
+
+    (local 
+      (defthm |1/2-sig-x-not-integerp-lemma|
+        (implies (and (rationalp x)
+                      (not (equal x 0))
+                      (rationalp y)
+                      (< 0 y)
+                      (<= y 1/2))
+                 (not (integerp (* (sig x) y))))
+        :hints (("Goal" :use ((:instance sig-upper-bound)
+                              (:instance sig-lower-bound))))))
+
+
+    (local 
+     (defthm exactp-minus-fact
+       (implies (and (integerp n)
+                     (rationalp x)
+                     (not (equal x 0))
+                     (<= n 0))
+                (not (exactp x n)))
+       :hints (("Goal" :in-theory (enable exactp)
+                :use ((:instance sig-upper-bound)
+                      (:instance sig-lower-bound)
+                      (:instance |1/2-sig-x-not-integerp-lemma|
+                                 (y (expt 2 (+ -1 n))))
+                      (:instance expt-weak-monotone-linear
+                                 (n (+ -1 n))
+                                 (m -1)))))))
+
+  (defthmd sticky-monotone
+    (implies (and (<= x y)
+                  (rationalp x)
+                  (rationalp y)
+                  (natp n))
+             (<= (sticky x n) (sticky y n)))
+    :hints (("Goal" :cases ((not (equal n 0)))
+             :in-theory (enable sticky sgn))
+            ("Subgoal 2" :cases ((not (equal y 0))))
+            ("Subgoal 2.1" :use ((:instance expo-monotone
+                                            (y x)
+                                            (x y))
+                                 (:instance expo-monotone
+                                            (x x)
+                                            (y y))
+                                 (:instance expt-weak-monotone-linear
+                                            (n (+ 1 (expo y)))
+                                            (m (+ 1 (expo x))))
+                                 (:instance expt-weak-monotone-linear
+                                            (n (+ 1 (expo x)))
+                                            (m (+ 1 (expo y))))))
+            ("Subgoal 1" :use ((:instance sticky-monotone-support))))
+    :rule-classes :linear))
+  
diff -Nru acl2-6.2/books/rtl/rel9/support/support/rtl.lisp acl2-6.3/books/rtl/rel9/support/support/rtl.lisp
--- acl2-6.2/books/rtl/rel9/support/support/rtl.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/rtl.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,618 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+#|
+
+The file deals with the RTL primitives, as well as natp, bvecp, unknown, unknown2, reset, and reset2.
+
+Keep this file roughly in sync with Rob's version of rtl.lisp, currently:
+/u/acl2/translator/linux27/lisp/model2-c/rtl.lisp
+
+Most of the functions introduced are disabled.
+
+!! add god type-prescription rules!
+
+|#
+
+(include-book "ground-zero")
+(include-book "rtlarr") ;includes the defn of bvecp
+(include-book "cat-def")
+
+;;Definitions of the ACL2 functions that are used in the
+;;formalization of the RTL semantics
+
+;leave enabled
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+
+;; 1. bit-vector constants
+
+(defmacro n! (i n)
+  (declare (ignore n)
+           (xargs :guard (and (natp i)
+                              (natp n)
+                              (bvecp i n))))
+  i)
+
+;; 2. equality comparison
+
+(defund log= (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 1 0))
+
+(defund log<> (x y)
+  (declare (xargs :guard t))
+  (if (equal x y) 0 1))
+
+
+;; 3. unsigned inequalities
+
+(defund log< (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (< x y) 1 0))
+
+(defund log<= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (<= x y) 1 0))
+
+(defund log> (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (> x y) 1 0))
+
+(defund log>= (x y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y))))
+  (if (>= x y) 1 0))
+
+
+;; 4. signed inequalities
+
+;; The following function is not generated by translate-rtl, it is only needed
+;; for the definitions of comp2<, comp2<=, etc.
+(defund comp2 (x n)
+  (declare (xargs :guard (and (rationalp x) (integerp n))))
+  (if (< x (expt 2 (1- n)))
+      x
+    (- (- (expt 2 n) x))))
+
+(defund comp2< (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))
+                  :guard-hints (("goal" :in-theory (enable COMP2)))))
+  (log< (comp2 x n) (comp2 y n)))
+
+(defund comp2<= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))
+                  :guard-hints (("goal" :in-theory (enable COMP2)))))
+  (log<= (comp2 x n) (comp2 y n)))
+
+(defund comp2> (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))
+                  :guard-hints (("goal" :in-theory (enable COMP2)))))
+  (log> (comp2 x n) (comp2 y n)))
+
+(defund comp2>= (x y n)
+  (declare (xargs :guard (and (rationalp x) (rationalp y) (integerp n))
+                  :guard-hints (("goal" :in-theory (enable COMP2)))))
+  (log>= (comp2 x n) (comp2 y n)))
+
+ 
+;; 5. unary logical operations
+
+(defund logand1 (x n)
+  (declare (xargs :guard (integerp n)))
+  (log= x (1- (expt 2 n))))
+
+(defund logior1 (x)
+  (declare (xargs :guard t))
+  (if (equal x 0) 0 1))
+
+(defund logxor1 (src)
+  (declare (xargs :guard (integerp src)))
+  (if (oddp (logcount src)) 1 0))
+
+
+;; 6. bit-vector shifting operations
+
+;; The following function will not be seen in the output from translate-rtl, it
+;; is only provided here to define shft.
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+#|
+(defun shft (x s l)
+  (mod (fl (* (expt 2 s) x)) (expt 2 l)))
+|#
+
+;; The following function will not be seen in the output from translate-rtl, it
+;; is only provided here to define lshft and rshft.
+(defund shft (x s l)
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defmacro lshft (x s l)
+  `(shft ,x ,s ,l))
+
+(defmacro rshft (x s l)
+  `(shft ,x (- ,s) ,l))
+
+
+;; 7. concatenation operations
+
+;drop? and add cat?
+(defund ocat (x y n)
+  (declare (xargs :guard t))
+  (+ (* (expt 2 (nfix n)) (nfix x)) (nfix y)))
+
+#|
+(defund omulcat (l n x)
+  (declare (xargs :guard t))
+  (if (and (integerp n) (> n 0))
+      (ocat (omulcat l (1- n) x)
+	   x
+	   l)
+    0))
+|#
+
+(defund mulcat (l n x)
+
+; We introduce mbe not because we want particularly fast execution, but because
+; the existing logic definition does not satisfy the guard of cat, which can't
+; be changed because of the guard of bits.
+
+  (declare (xargs :guard (and (integerp l)
+                              (< 0 l)
+                              (acl2-numberp n)
+                              (natp x))
+                  :verify-guards nil))
+  (mbe :logic (if (and (integerp n) (> n 0))
+                  (cat (mulcat l (1- n) x)
+                       (* l (1- n))
+                       x
+                       l)
+                0)
+       :exec  (cond
+               ((eql n 1)
+                (bits x (1- l) 0))
+               ((and (integerp n) (> n 0))
+                (cat (mulcat l (1- n) x)
+                     (* l (1- n))
+                     x
+                     l))
+               (t 0))))
+
+
+;; 8. bit-vector access and update
+
+#| old versions:
+(defun bits (x i j)
+  (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+
+(defun bits (x i j)
+  (if (or (not (integerp i))
+          (not (integerp j)))
+      0
+  (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j)))))
+
+(defund bits (x i j)
+  (declare (xargs :guard (rationalp x)))
+  (if (or (not (integerp i))
+          (not (integerp j)))
+      0
+    (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j)))))
+
+(defun bitn (x n)
+  (if (logbitp n x) 1 0))
+
+(defund bitn (x n)
+    (declare (xargs :guard (rationalp x)))
+  (bits x n n))
+
+|#
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (natp x)
+                              (natp i)
+                              (natp j))
+                  :verify-guards nil))
+  (mbe :logic (if (or (not (integerp i))
+                      (not (integerp j)))
+                  0
+                (fl (/ (mod x (expt 2 (1+ i))) (expt 2 j))))
+       :exec  (if (< i j)
+                  0
+                (logand (ash x (- j)) (1- (ash 1 (1+ (- i j))))))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+;setbits has a new parameter, w, indicating the size of the expression returned
+;Note: when j is 0, there is not lower part of x, but we have cat-with-n-0 to handle this case. 
+(defund setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))
+                  :verify-guards nil))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defund setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))
+                  :verify-guards nil))
+  (setbits x w n n y))
+
+
+;; 9. bitwise operations
+
+;; logand, logior, logxor are predefined ACL2 functions
+
+#| old version
+(defun lnot (x n)
+  (1- (- (expt 2 n) x)))
+|#
+
+(defund lnot (x n)
+  (declare (xargs :guard (and (natp x)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (if (natp n)
+      (+ -1 (expt 2 n) (- (bits x (1- n) 0)))
+    0))
+
+
+;; 10. array access and update
+
+;; aref1, aref2, aset1, aset2 are predefined ACL2 functions
+
+;; actually, we now generate ag and as, which are defined in rtlarr.lisp
+;; in the rtl library.
+
+
+
+
+;; 11. arithmetic operations
+
+(defmacro mod+ (x y n)
+  `(bits (+ ,x ,y) (1- ,n) 0))
+
+(defmacro mod* (x y n)
+  `(bits (* ,x ,y) (1- ,n) 0))
+
+#|
+Note: We recently changed mod-.  This definition is a little weird, since it may rely on the value of (bits x
+i j) when x is negative.  However, bits behaves properly in this case.  In fact, Eric proved this theorem
+about the old defintion of mod-:
+
+(thm
+ (implies (and (bvecp x n)
+	       (bvecp y n)
+	       (natp n)
+	       )
+	  (equal (mod- x y n)
+		 (bits (- x y) (1- n) 0)))
+	:hints (("Goal" :in-theory (enable  mod- comp2-inv bits bvecp)))
+)
+
+We believe that mod- is only well-defined when x and y are bvecps of length n, so the change shouldn't affect
+any behavior we care about.
+
+Typically when we see (mod- x y n), we will know (<= y x); in such cases, the rule BITS-DROP-FROM-MINUS can
+get rid of the bits call.
+|#
+
+(defmacro mod- (x y n)
+  `(bits (- ,x ,y) (1- ,n) 0))
+
+
+#| Old definition of mod- :
+
+;; the following function is not generated in the translate-rtl output. It is
+;; only needed to define 'mod-
+(defund comp2-inv (x n)
+  (declare (xargs :guard (and (rationalp x)
+                              (integerp n))))
+  (if (< x 0)
+      (+ x (expt 2 n))
+    x))
+
+(defund mod- (x y n)
+  (declare (xargs :guard (and (rationalp x)
+                              (rationalp y)
+                              (integerp n))))
+  (comp2-inv (- x y) n))
+|#
+
+
+;; NOTE -- the following definition of decode is "flawed". We still need to add
+;; assumptions to "allow" this definition to be used.
+
+(defund decode (x n)
+  (declare (xargs :guard (rationalp n)))
+  (if (and (natp x) (< x n)) 
+      (ash 1 x) 
+    0))
+
+(defund encode (x n)
+    (declare (xargs :guard (and (acl2-numberp x)
+                                (integerp n)
+                                (<= 0 n))))
+  (if (zp n) 
+      0
+    (if (= x (ash 1 n))
+        n
+      (encode x (1- n)))))
+
+;; floor, rem are predefined ACL2 functions
+
+
+;; 12. evaluation control operators
+
+(defmacro bind (v x y)
+  `(let ((,v ,x)) ,y))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+(defthm if1-0
+  (equal (if1 0 y z)
+         z))
+
+(defthm if1-non-0
+  (implies (not (equal x 0))
+           (equal (if1 x y z)
+                  y)))
+
+(defthm if1-x-x
+  (equal (if1 tst x x)
+         x))
+
+(defthm bvecp-if1
+  (equal (bvecp (if1 x y z) n)
+         (if1 x (bvecp y n) (bvecp z n))))
+
+(defun cond1-macro (clauses)
+  ;; Based on cond-macro.
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (if (consp clauses)
+      (if (and (eq (car (car clauses)) t)
+               (eq (cdr clauses) nil))
+          (if (cdr (car clauses))
+              (car (cdr (car clauses)))
+            (car (car clauses)))
+        (list 'if1 (car (car clauses))
+              (if (cdr (car clauses))
+                  (car (cdr (car clauses)))
+                (car (car clauses)))
+              (cond1-macro (cdr clauses))))
+    0))
+
+(defmacro cond1 (&rest clauses)
+  (declare (xargs :guard (cond-clausesp clauses)))
+  (cond1-macro clauses))
+
+
+;; 13. extra operators
+
+(defun natp1 (x)
+  (declare (xargs :guard t))
+  (if (and (integerp x)
+           (<= 0 x))
+      1
+    0))
+
+
+;land0
+
+
+(defund binary-land0 (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logand (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defmacro land0 (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(land0 x y n) -- the base case
+         `(binary-land0 ,@x))
+        (t         
+         `(binary-land0 ,(car x)
+                       (land0 ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable land0)) to refer to binary-land0.
+(add-macro-alias land0 binary-land0)
+
+;;lior0
+
+(defund all-ones (n)
+  (declare (xargs :guard (and (integerp n) (<= 0 n))))
+  (if (zp n)
+      0 ;degenerate case
+    (1- (expt 2 n))))
+
+
+(defund binary-lior0 (x y n)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logior (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defmacro lior0 (&rest x)
+  (declare (xargs :guard (and (consp x)
+                              (consp (cdr x))
+                              (consp (cddr x)))))
+  (cond ((endp (cdddr x)) ;(lior0 x y n) -- the base case
+         `(binary-lior0 ,@x))
+        (t         
+         `(binary-lior0 ,(car x)
+                       (lior0 ,@(cdr x))
+                       ,(car (last x))))))
+
+
+;Allows things like (in-theory (disable lior0)) to refer to binary-lior0.
+(add-macro-alias lior0 binary-lior0)
+
+;;lxor0
+
+(defund binary-lxor0 (x y n)
+  (declare (xargs :guard (and (natp x) 
+                              (natp y)
+                              (integerp n)
+                              (< 0 n))
+                  :verify-guards nil))
+  (logxor (bits x (1- n) 0)
+          (bits y (1- n) 0)))
+
+(defmacro lxor0 (&rest x)
+  (declare (xargs :guard (consp x)))
+  (cond ((endp (cdddr x)) ;(lxor0 x y n) -- the base case
+         `(binary-lxor0 ,@x))
+        (t         
+         `(binary-lxor0 ,(car x)
+                       (lxor0 ,@(cdr x))
+                       ,(car (last x))))))
+
+;Allows things like (in-theory (disable lxor0)) to refer to binary-lxor0.
+(add-macro-alias lxor0 binary-lxor0)
+
+
+
+
+;;4 functions that occur in the translated RTL, representing bit vectors of
+;;determined length but undetermined value:
+
+(encapsulate 
+ ((reset (key size) t))
+ (local (defun reset (key size) (declare (ignore key size)) 0))
+ (defthm bvecp-reset (bvecp (reset key size) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite 
+    (:forward-chaining :trigger-terms ((reset key size)))	
+    (:type-prescription :corollary
+                        (and (integerp (reset key size)) 
+                             (>= (reset key size) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((unknown (key size n) t))
+ (local (defun unknown (key size n) (declare (ignore key size n)) 0))
+ (defthm bvecp-unknown (bvecp (unknown key size n) size)
+   :hints (("Goal" :in-theory (enable bvecp expt)))
+   :rule-classes 
+   (:rewrite
+    (:forward-chaining :trigger-terms ((unknown key size n)))
+    (:type-prescription :corollary
+                        (and (integerp (unknown key size n))
+                             (>= (unknown key size n) 0))
+                        :hints
+                        (("Goal" :in-theory '(implies bvecp)))))))
+
+(encapsulate 
+ ((reset2 (key size) t))
+ (local (defun reset2 (key size) (declare (ignore key size)) nil))
+ 
+;do we need rule-classes on this thm?
+ (defthm bv-arrp-reset2
+   (bv-arrp (reset2 key size) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))
+   ))
+
+(encapsulate 
+ ((unknown2 (key size n) t))
+ (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
+ 
+;do we need rule-classes on this thm?
+ (defthm bv-arrp-unknown2
+   (bv-arrp (unknown2 key size n) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))
+   ))
+
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/rtlarr.lisp acl2-6.3/books/rtl/rel9/support/support/rtlarr.lisp
--- acl2-6.2/books/rtl/rel9/support/support/rtlarr.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/rtlarr.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,498 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+; Rob Sumners
+
+(in-package "ACL2")
+
+#|
+
+We define properties of a generic record accessor function and updater function
+we will use for RTL arrays.  The basic functions are (ag a r) and (as a v r)
+where a is an array index, v is a value, r is an "array" or record, and 
+(ag a r) returns the value set to index a in array r, and (as a v r) returns 
+a new array with index a set to value v in array r.
+
+The following main lemmas are "exported" about record (ag)et and (as)et:
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+
+We also include some auxiliary lemmas which have proven useful.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r))
+  :hints (("Goal" 
+           :in-theory (disable rcd->acl2-of-record-non-nil)
+           :use (:instance rcd->acl2-of-record-non-nil
+                           (r (as-aux a v (acl2->rcd r)))))))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+
+We also include some "type" lemmas for accesses and updates of rtl arrays.
+
+(defthm as-maps-bv-arr-to-bv-arr
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as a v r) k)))
+
+(defthm ag-maps-bv-arr-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag a r) k)))
+
+
+Note we also define as2 and ag2 for 2-dimensional arrays but these simply
+macro-expand into appropriate as and ag calls.
+
+We normalize the array structures (which allows the 'equal-ity based rewrite
+rules) as alists where the keys (cars) are ordered using the total-order added
+to ACL2 and defined in the included book. We define a set of "-aux" functions
+which assume well-formed records -- defined by rcdp -- and then prove the
+desired properties using hypothesis assuming well-formed records.
+
+We then remove these well-formed record hypothesis by defining an invertible
+mapping (acl2->rcd) taking any ACL2 object and returning a well-formed
+record. We then prove the desired properties using the proper translations of
+the -aux functions to the acl2 objects, and subsequently remove the
+well-formed record hypothesis.
+
+|#
+
+(include-book "misc/total-order" :dir :system)
+
+;; BEGIN records definitions.
+
+(defmacro default-get-valu () 0)
+
+(defun rcdp (x)
+  (declare (xargs :guard t))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (rcdp (cdr x))
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(defthm rcdp-implies-alistp
+  (implies (rcdp x) (alistp x)))
+
+(defmacro ifrp-tag ()
+  ''unlikely-to-ever-occur-in-an-executable-counterpart)
+
+(defun ifrp (x) ;; ill-formed rcdp 
+  (declare (xargs :guard t))
+  (or (not (rcdp x))
+      (and (consp x)
+           (null (cdr x))
+           (consp (car x))
+           (equal (cdar x) (ifrp-tag))
+           (ifrp (caar x)))))
+
+(defun acl2->rcd (x)  ;; function mapping acl2 objects to well-formed records.
+  (declare (xargs :guard t))
+  (if (ifrp x) (list (cons x (ifrp-tag))) x))
+
+(defun rcd->acl2 (r)  ;; inverse of acl2->rcd.
+  (declare (xargs :guard (rcdp r)))
+  (if (ifrp r) (caar r) r))
+
+(defun ag-aux (a r) ;; record g(et) when r is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (default-get-valu))
+        ((equal a (caar r))
+         (cdar r))
+        (t
+         (ag-aux a (cdr r)))))
+
+(defun ag (a x) ;; the generic record g(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (ag-aux a (acl2->rcd x)))
+
+(defun acons-if (a v r)
+  (declare (xargs :guard (rcdp r)))
+  (if (equal v (default-get-valu)) r (acons a v r)))
+
+(defun as-aux (a v r) ;; record s(et) when x is a well-formed record.
+  (declare (xargs :guard (rcdp r)))
+  (cond ((or (endp r)
+             (<< a (caar r)))
+         (acons-if a v r))
+        ((equal a (caar r))
+         (acons-if a v (cdr r)))
+        (t 
+         (cons (car r) (as-aux a v (cdr r))))))
+
+;; we need the following theorems in order to get the guard for s to verify.
+
+(local
+(defthm as-aux-is-bounded
+  (implies (and (rcdp r)
+                (as-aux a v r)
+                (<< e a)
+                (<< e (caar r)))
+           (<< e (caar (as-aux a v r))))))
+
+(local
+(defthm as-aux-preserves-rcdp
+  (implies (rcdp r)
+           (rcdp (as-aux a v r)))))
+
+(defun as (a v x) ;; the generic record s(et) which works on any ACL2 object.
+  (declare (xargs :guard t))
+  (rcd->acl2 (as-aux a v (acl2->rcd x))))
+
+
+;;;; basic property of records ;;;;
+
+(local
+(defthm rcdp-implies-true-listp
+  (implies (rcdp x)
+           (true-listp x))
+  :rule-classes (:forward-chaining
+                 :rewrite)))
+
+
+;;;; initial properties of s-aux and g-aux ;;;;
+
+(local
+(defthm ag-aux-same-as-aux
+  (implies (rcdp r)
+           (equal (ag-aux a (as-aux a v r))
+                  v))))
+
+(local
+(defthm ag-aux-diff-as-aux
+  (implies (and (rcdp r)
+                (not (equal a b)))
+           (equal (ag-aux a (as-aux b v r))
+                  (ag-aux a r)))))
+
+(local
+(defthm as-aux-same-ag-aux
+  (implies (rcdp r)
+           (equal (as-aux a (ag-aux a r) r) 
+                  r))))
+
+(local
+(defthm as-aux-same-as-aux
+  (implies (rcdp r)
+           (equal (as-aux a y (as-aux a x r))
+                  (as-aux a y r)))))
+
+(local
+(defthm as-aux-diff-as-aux
+  (implies (and (rcdp r)
+                (not (equal a b)))
+           (equal (as-aux b y (as-aux a x r))
+                  (as-aux a x (as-aux b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as))))))
+
+(local
+(defthm as-aux-non-nil-cannot-be-nil
+  (implies (and (not (equal v (default-get-valu)))
+                (rcdp r))
+           (as-aux a v r))))
+
+(local
+(defthm ag-aux-is-nil-for-<<
+  (implies (and (rcdp r)
+                (<< a (caar r)))
+           (equal (ag-aux a r)
+                  (default-get-valu)))))
+
+
+;;;; properties of acl2->rcd and rcd->acl2 ;;;;
+
+(local
+(defthm acl2->rcd-rcd->acl2-of-rcdp
+  (implies (rcdp x)
+           (equal (acl2->rcd (rcd->acl2 x))
+                  x))))
+
+(local
+(defthm acl2->rcd-returns-rcdp
+  (rcdp (acl2->rcd x))))
+
+(local
+(defthm acl2->rcd-preserves-equality
+  (iff (equal (acl2->rcd x) (acl2->rcd y))
+       (equal x y))))
+
+(local
+(defthm rcd->acl2-acl2->rcd-inverse
+  (equal (rcd->acl2 (acl2->rcd x)) x)))
+
+(local
+(defthm rcd->acl2-of-record-non-nil
+  (implies (and r (rcdp r))
+           (rcd->acl2 r))))
+
+(in-theory (disable acl2->rcd rcd->acl2))
+
+
+;;;; final (exported) properties of record g(et) and s(et) ;;;;
+
+;; NOTE that these theorems basically follow from the "equivalent" properties
+;; for s-aux and g-aux with rcdp hypothesis, and the lemmas about the acl2->rcd
+;; and its inverse rcd->acl2. If the user wanted to add to the following set of
+;; exported theorems, they should add the corresponding lemma about s-aux and
+;; g-aux using rcdp hypothesis and then add the theorem here about the generic
+;; s(et) and g(et) they wish to export from the book.
+
+(defthm ag-same-as
+  (equal (ag a (as a v r)) 
+         v))
+
+(defthm ag-diff-as
+  (implies (not (equal a b))
+           (equal (ag a (as b v r))
+                  (ag a r))))
+
+;;;; NOTE: The following can be used instead of the above rules to force ACL2
+;;;; to do a case-split. We disable this rule by default since it can lead to
+;;;; an expensive case explosion, but in many cases, this rule may be more
+;;;; effective than two rules above and should be enabled.
+
+(defthm ag-of-as-redux
+  (equal (ag a (as b v r))
+         (if (equal a b) v (ag a r))))
+
+(in-theory (disable ag-of-as-redux))
+
+(defthm as-same-ag
+  (equal (as a (ag a r) r) 
+         r))
+
+(defthm as-same-as
+  (equal (as a y (as a x r))
+         (as a y r)))
+
+(defthm as-diff-as
+  (implies (not (equal a b))
+           (equal (as b y (as a x r))
+                  (as a x (as b y r))))
+  :rule-classes ((:rewrite :loop-stopper ((b a as)))))
+
+;; the following theorems are less relevant but have been useful in dealing
+;; with a default record of NIL.
+
+(defthm ag-of-nil-is-default
+  (equal (ag a nil) (default-get-valu)))
+
+(defthm as-non-default-cannot-be-nil
+  (implies (not (equal v (default-get-valu)))
+           (as a v r))
+  :hints (("Goal" 
+           :in-theory (disable rcd->acl2-of-record-non-nil)
+           :use (:instance rcd->acl2-of-record-non-nil
+                           (r (as-aux a v (acl2->rcd r)))))))
+
+(defthm non-nil-if-ag-not-default
+  (implies (not (equal (ag a r) 
+                       (default-get-valu)))
+           r)
+  :rule-classes :forward-chaining)
+
+;; OK, we add here some properties for typing the records and the values which
+;; are stored in the records. This "typing" is pretty generic, but we choose the
+;; "bvecp" types for record values because it suits AMD's RTL modeling needs.
+
+(defun bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defun bv-arrp (x k)
+  (declare (xargs :guard (integerp k)))
+  (or (null x)
+      (and (consp x)
+           (consp (car x))
+           (bv-arrp (cdr x) k)
+           (not (equal (cdar x) 
+                       (default-get-valu)))
+           (bvecp (cdar x) k)
+           (or (null (cdr x))
+               (<< (caar x) (caadr x))))))
+
+(local
+(defthm bvecp-of-default-get-valu-is-true
+  (bvecp (default-get-valu) k)))
+
+(local
+(defthm bvecp-of-ifrp-tag-is-false
+  (not (bvecp (ifrp-tag) k))))
+
+(in-theory (disable bvecp))
+
+(local
+(defthm bv-arrp-implies-rcdp
+  (implies (bv-arrp r k)
+           (rcdp r))))
+
+(local
+(defthm as-aux-maps-bv-rcd-to-bv-rcd
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as-aux a v r) k))))
+
+(local
+(defthm ag-aux-maps-bv-rcd-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag-aux a r) k))))
+
+(local
+(defthm bv-arrp-implies-not-ifrp
+  (implies (bv-arrp x k)
+           (not (ifrp x)))))
+
+(local
+(defthm bv-arrp-acl2->rcd-transfers
+  (implies (bv-arrp x k)
+           (bv-arrp (acl2->rcd x) k))
+  :hints (("Goal" :in-theory (enable acl2->rcd)))))
+
+(local
+(defthm bv-arrp-rcd->acl2-transfers
+  (implies (bv-arrp r k)
+           (bv-arrp (rcd->acl2 r) k))
+  :hints (("Goal" :in-theory (enable rcd->acl2)))))
+
+(defthm as-maps-bv-arr-to-bv-arr
+  (implies (and (bv-arrp r k)
+                (bvecp v k))
+           (bv-arrp (as a v r) k)))
+
+(defthm ag-maps-bv-arr-to-bvecp
+  (implies (bv-arrp r k)
+           (bvecp (ag a r) k)))
+
+(defun mk-bvarr (r k)
+  (declare (xargs :guard (integerp k)))
+  (if (bv-arrp r k) r ()))
+
+(defthm mk-bvarr-is-bv-arrp
+  (bv-arrp (mk-bvarr r k) k))
+
+(defthm mk-bvarr-identity
+  (implies (bv-arrp r k)
+           (equal (mk-bvarr r k) r)))
+
+(in-theory (disable bv-arrp mk-bvarr))
+
+;; finally we define some "2D" array accessors.
+
+(defmacro ag2 (a b r)
+  `(ag (cons ,a ,b) ,r))
+
+(defmacro as2 (a b v r)
+  `(as (cons ,a ,b) ,v ,r))
+
+
+;; We disable s and g, assuming the rules proven in this book are sufficient to
+;; manipulate record terms which are encountered.
+
+(in-theory (disable as ag))
+
+; Begin events added March 2005 when it was discovered that they are in
+; ../lib/rtlarr.lisp but not in this file.
+
+(defun positive-integer-listp (l)
+  (declare (xargs :guard t))
+  (cond ((atom l)
+         (equal l nil))
+        (t (and (integerp (car l))
+                (< 0 (car l))
+                (positive-integer-listp (cdr l))))))
+
+(defmacro arr0 (&rest dims)
+  (declare (ignore dims)
+           (xargs :guard (positive-integer-listp dims)))
+  nil)
+
+;;Functions representing bit vectors of determined length but undetermined value:
+
+(encapsulate 
+ ((reset2 (key size) t))
+ (local (defun reset2 (key size) (declare (ignore key size)) nil))
+ (defthm bv-arrp-reset2
+   (bv-arrp (reset2 key size) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))
+   ))
+
+(encapsulate 
+ ((unknown2 (key size n) t))
+ (local (defun unknown2 (key size n) (declare (ignore key size n)) nil))
+ (defthm bv-arrp-unknown2
+   (bv-arrp (unknown2 key size n) size)
+   :hints
+   (("goal" :in-theory (enable bv-arrp)))
+   ))
+
+(defun if1 (x y z)
+  (declare (xargs :guard (integerp x)))
+  (if (eql x 0) z y))
+
+;BOZO where in lib/ should this go?
+(defthm bv-arrp-if1
+  (equal (bv-arrp (if1 x y z) n)
+         (if1 x (bv-arrp y n) (bv-arrp z n))))
+
+; End events added March 2005 when it was discovered that they are in
+; ../lib/rtlarr.lisp but not in this file.
diff -Nru acl2-6.2/books/rtl/rel9/support/support/setbitn-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/setbitn-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/setbitn-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/setbitn-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,234 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "cat-def")
+
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))
+                  :verify-guards nil))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(local (include-book "setbits"))
+(local (include-book "../../arithmetic/top"))
+(local (include-book "bits"))
+(local (include-book "cat"))
+
+(defund setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))
+                  :verify-guards nil))
+  (setbits x w n n y))
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :hints (("Goal" :in-theory (enable setbitn)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-natp
+  (natp (setbitn x w n y)))
+
+;add setbitn-bvecp-simple?
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k))
+  :hints (("goal" :in-theory (enable setbitn))))
+
+(defthm setbitn-rewrite
+  (implies (syntaxp (quotep n))
+           (equal (setbitn x w n y)
+                  (setbits x w n n y)))
+  :hints (("Goal" :in-theory (enable setbitn))))
+
+;gen?
+(defthm bitn-setbitn
+  (implies (and (case-split (bvecp y 1))
+                (case-split (< 0 w))
+                (case-split (< n w))
+                (case-split (< k w))
+                (case-split (<= 0 k))
+                (case-split (integerp w))
+                (case-split (integerp n))
+                (<= 0 n)
+                (case-split (integerp k))
+                )
+           (equal (bitn (setbitn x w n y) k)
+                  (if (equal n k)
+                      y
+                    (bitn x k))))
+  :hints (("Goal" :cases ((< n k) (= n k))
+           :in-theory (enable setbitn bitn bits-does-nothing)))
+  )
+
+
+
+(defthm setbitn-setbitn
+  (implies (and (case-split (<= 0 n))
+                (case-split (< n w))
+                (case-split (integerp w))
+                (case-split (integerp n))
+                )
+           (equal (setbitn (setbitn x w n y) w n y2)
+                  (setbitn x w n y2)))
+  :hints (("Goal"
+           :in-theory (enable setbits setbitn natp)))
+  )
+
+(defthm setbitn-does-nothing
+  (implies (and (case-split (<= 0 n))
+                (case-split (< n w))
+                (case-split (integerp w))
+                (case-split (integerp n))
+                )
+           (equal (setbitn x w n (bitn x n))
+                  (bits x (1- w) 0))
+           )
+  :hints (("Goal" :cases ((< (+ -1 W) (+ 1 N)))
+           :in-theory (enable bitn setbits setbitn natp)))
+  )
+
+#|
+;bad name?
+(defthm setbitn-commutativity
+  (implies (and (< n n2);(not (equal n n2))
+                (case-split (<= 0 n))
+                (case-split (<= 0 n2))
+                (case-split (< n w))
+                (case-split (< n2 w))
+                (case-split (integerp w))
+                (case-split (integerp n))
+                (case-split (integerp n2))
+                (case-split (bvecp y 1))
+                (case-split (bvecp y2 1))
+                (case-split (bvecp x w)) ;drop!
+)
+           (equal (setbitn (setbitn x w n y) w n2 y2)
+                  (setbitn (setbitn x w n2 y2) w n y)
+))
+  :rule-classes ((:rewrite :loop-stopper ((n n2 s))))
+  :hints (("Goal"
+           :in-theory (enable setbitn setbits-rewrite setbits-rewrite-when-j-is-0)))
+  )
+
+
+(defthm setbitn-commutativity
+  (implies (and (< n n2);(not (equal n n2))
+                (case-split (<= 0 n))
+                (case-split (<= 0 n2))
+                (case-split (< n w))
+                (case-split (< n2 w))
+                (case-split (integerp w))
+                (case-split (integerp n))
+                (case-split (integerp n2))
+                (case-split (bvecp y 1))
+                (case-split (bvecp y2 1))
+                (case-split (bvecp x w)) ;drop!
+)
+           (equal (setbitn (setbitn x w n y) w n2 y2)
+                  (setbitn (setbitn x w n2 y2) w n y)
+))
+  :rule-classes ((:rewrite :loop-stopper ((n n2 s))))
+  :hints (("Goal"
+           :in-theory (set-difference-theories
+                       (enable setbitn setbits-rewrite setbits-rewrite-when-j-is-0 
+ ;                              bits-bits-1
+  ;                             bits-bits-2
+                               bits-ocat-1
+                               bits-ocat-2
+                               bits-ocat-3
+;                               natp
+                              )
+                       '(bits-bits bits-ocat)
+                       ))
+          ))
+
+prove bits-setbitn?
+
+|#
diff -Nru acl2-6.2/books/rtl/rel9/support/support/setbitn.lisp acl2-6.3/books/rtl/rel9/support/support/setbitn.lisp
--- acl2-6.2/books/rtl/rel9/support/support/setbitn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/setbitn.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,155 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "cat-def")
+(local (include-book "setbitn-proofs"))
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+(defund setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))
+                  :verify-guards nil))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defund setbitn (x w n y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp n)
+                              (<= 0 n)
+                              (integerp w)
+                              (< n w))
+                  :verify-guards nil))
+  (setbits x w n n y))
+
+(defthm setbitn-nonnegative-integer-type
+  (and (integerp (setbitn x w n y))
+       (<= 0 (setbitn x w n y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbitn)))
+
+(defthm setbitn-natp
+  (natp (setbitn x w n y)))
+
+;add setbitn-bvecp-simple?
+
+(defthm setbitn-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k)))
+           (bvecp (setbitn x w n y) k)))
+
+(defthm setbitn-rewrite
+  (implies (syntaxp (quotep n))
+           (equal (setbitn x w n y)
+                  (setbits x w n n y))))
+
+;gen?
+(defthm bitn-setbitn
+  (implies (and (case-split (bvecp y 1))
+                (case-split (< 0 w))
+                (case-split (< n w))
+                (case-split (< k w))
+                (case-split (<= 0 k))
+                (case-split (integerp w))
+                (case-split (integerp n))
+                (<= 0 n)
+                (case-split (integerp k))
+                )
+           (equal (bitn (setbitn x w n y) k)
+                  (if (equal n k)
+                      y
+                    (bitn x k)))))
+
+(defthm setbitn-setbitn
+  (implies (and (case-split (<= 0 n))
+                (case-split (< n w))
+                (case-split (integerp w))
+                (case-split (integerp n))
+                )
+           (equal (setbitn (setbitn x w n y) w n y2)
+                  (setbitn x w n y2))))
+
+(defthm setbitn-does-nothing
+  (implies (and (case-split (<= 0 n))
+                (case-split (< n w))
+                (case-split (integerp w))
+                (case-split (integerp n))
+                )
+           (equal (setbitn x w n (bitn x n))
+                  (bits x (1- w) 0))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/setbits-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/setbits-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/setbits-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/setbits-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,466 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(include-book "cat-def")
+(local (include-book "../../arithmetic/top"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "bvecp"))
+(local (include-book "cat"))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+#|
+
+Currently we expect to leave setbits enabled so that it rewrites to cat, but there are some lemmas below which
+might be useful if we choose to keep setbits disabled...
+
+is this comment still valid? :
+;it may happen that setbitn is called with an index which is a signal rather than a constant.
+;in that case, we probably don't want it to expand to setbits. 
+;thus, we always expect the indices in setbits calls to be constants
+
+
+;Set bits I down to J of the W-bit value X to Y.
+
+(setbits x w i j y) is only well-defined when the following predicate is true:
+
+(and (natp w)
+     (bvecp x w)
+     (integerp i)
+     (integerp j)
+     (<= 0 j)
+     (<= j i)
+     (< i w)
+     (bvecp y (+ 1 i (- j))))
+
+|#
+
+#| old:
+(defund setbits (x w i j y)
+  (declare (xargs :guard (and (rationalp x) (rationalp y)
+                              (acl2-numberp i) (acl2-numberp j) (acl2-numberp w))))
+  (if (not (natp w))
+      0
+    (cat (bits x (1- w) (+ 1 i))
+         (+ -1 w (- i))
+         (cat (bits y (+ i (- j)) 0)
+              (+ 1 i (- j))
+              (bits x (1- j) 0)
+              j)
+         (+ 1 i))))
+|#
+
+;Note: when j is 0, there is not lower part of x, but we have cat-with-n-0 to handle this case. 
+(defund setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))
+                  :verify-guards nil))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+
+
+#| old defn
+(defun setbits (x i j y)
+  (ocat (ocat (ash x (- (1+ i)))
+	    y
+	    (1+ (- i j)))
+       (bits x (1- j) 0)
+       j))
+|#
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :hints (("Goal" :in-theory (enable setbits)))
+  :rule-classes (:type-prescription)
+  )
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-natp
+  (natp (setbits x w i j y)))
+
+;BOZO r-c?
+(defthm setbits-upper-bound
+  (< (setbits x w i j y) (expt 2 w))
+  :hints (("Goal" :in-theory (enable setbits cat-upper-bound))))
+
+(defthm setbits-bvecp-simple
+  (bvecp (setbits x w i j y) w)
+  :hints (("goal" :in-theory (enable bvecp))))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k)
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k))
+  :hints (("goal" :use setbits-bvecp-simple
+           :in-theory (disable setbits-bvecp-simple))))
+
+(defthm setbits-does-nothing
+  (implies (and (case-split (< i w))
+                (case-split (<= j i))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (<= 0 j))
+                )
+           (equal (setbits x w i j (bits x i j))
+                  (bits x (1- w) 0)))
+  :hints (("Goal" :in-theory (enable setbits))))
+
+
+#| old, prove the two match for bvecps
+(defun oldsetbits (x i j y)
+  (ocat (ocat (ash x (- (1+ i)))
+	    y
+	    (1+ (- i j)))
+       (bits x (1- j) 0)
+       j))
+
+;we had this before
+(defthm oldsetbits-rewrite-1
+    (implies (and (bvecp x n)
+		  (natp n)
+		  (> n 0)
+		  (natp i)
+		  (natp j)
+		  (<= j i)
+		  (bvecp y (1+ (- i j))))
+	     (equal (oldsetbits x i j y)
+		    (ocat (ocat (bits x (1- n) (1+ i))
+			      y
+			      (1+ (- i j)))
+			 (bits x (1- j) 0)
+			 j))))
+
+(defthm setbits-match
+  (implies (and (bvecp x n)
+                (natp n)
+                (> n 0)
+                (natp w)
+                (<= n w)
+                (bvecp y (1+ (- i j)))
+                (natp i)
+                (natp j)
+                (<= j i))
+           (equal (oldsetbits x i j y)
+                  (setbits x w i j y)))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable setbits oldsetbits bits-does-nothing
+                                     natp))))
+
+|#
+
+;taking bits from the lower third
+;slow proof with may cases!
+(defthm bits-setbits-1
+  (implies (and (< k j)
+                (case-split (<= 0 w))
+                (case-split (< i w))
+                (case-split (<= 0 l))
+                (case-split (<= j i)) ;drop?
+                (case-split (integerp w))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (bits x k l)))
+  :hints (("Goal" :in-theory (enable setbits))))
+
+;taking bits from the middle third
+;slow proof with may cases!
+(defthm bits-setbits-2
+  (implies (and (<= k i)
+                (<= j l)
+                (case-split (integerp i))
+                (case-split (<= 0 j))
+                (case-split (integerp j))
+                (case-split (acl2-numberp k));		  (case-split (integerp k))
+                (case-split (acl2-numberp l)) ;	  (case-split (integerp l))
+                (case-split (integerp w))
+                (case-split (<= 0 w))
+                (case-split (< i w))
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (bits y (- k j) (- l j))))
+  :hints (("Goal" :in-theory (enable setbits natp))))
+
+;taking bits from the upper third
+(defthm bits-setbits-3
+  (implies (and (< i l)
+                (case-split (< i w))
+                (case-split (< k w)) ;handle this?
+                (case-split (<= j i))
+                (case-split (<= 0 l))
+                (case-split (<= 0 j))
+                (case-split (<= 0 w))
+                (case-split (integerp l))
+                (case-split (integerp w))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (bits x k l)))
+  :hints (("Goal" :in-theory (enable setbits natp))))
+
+
+(defthm setbits-with-0-width
+  (equal (setbits x 0 i j y)
+         0)
+  :hints (("Goal" :cases ((integerp j))
+           :in-theory (enable setbits))))
+
+;add case-splits?
+;why can't i prove this from bits-setbits?
+(defthm bitn-setbits-1
+  (implies (and (< k j) ;case 1
+                (< i w)
+                (<= 0 i)
+                (<= 0 j) 
+                (<= 0 k)
+                (<= j i)
+                (integerp k)
+                (integerp w)
+                (integerp i)
+                (integerp j)
+                )
+           (equal (bitn (setbits x w i j y) k)
+                  (bitn x k)))
+  :hints (("Goal" :in-theory (enable setbits)))
+  )
+
+(defthm bitn-setbits-2
+  (implies (and(<= k i) ;;case-2
+               (<= j k) ;;case-2
+               (<= 0 i)
+               (<= 0 j) 
+               (< i w)
+               (integerp k)
+               (integerp w)
+               (integerp i)
+               (integerp j)
+               )
+           (equal (bitn (setbits x w i j y) k)
+                  (bitn y (- k j))))
+  :hints (("Goal" :in-theory (enable setbits)))
+  )
+
+(defthm bitn-setbits-3
+  (implies (and (< i k) ;;case-3
+                (< k w) ;;case-3
+;                (< i w)
+                (<= 0 i)
+                (<= 0 j) 
+                (<= j i)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (integerp w))
+           (equal (bitn (setbits x w i j y) k)
+                  (bitn x k)))
+  :hints (("Goal" :in-theory (enable setbits)))
+  )
+
+
+;taking a slice of each of the lower two thirds.
+(defthm bits-setbits-4
+  (implies (and (<= k i) ;;case-4
+                (<= j k) ;;case-4
+                (< l j) ;;case-4
+                (< i w)
+                (<= 0 j)
+                (<= 0 l)
+                (integerp i)
+                (integerp j)
+                (integerp w) 
+                (acl2-numberp l) ;(integerp l)
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (cat (bits y (- k j) 0)
+                       (+ 1 k (- j))
+                       (bits x (1- j) l)
+                       (- j l))))
+  :hints (("Goal" :in-theory (enable setbits))))
+
+;taking a slice of each of the upper two thirds.
+(defthm bits-setbits-5
+    (implies (and (< i k)  ;case-5
+		  (<= l i) ;case-5
+		  (<= j l) ;case-5
+                  (< k w)  ;case-5 ;BOZO drop stuff like this?
+                  (<= 0 j)
+                  (integerp i)
+                  (integerp j)
+                  (integerp w)
+                  (acl2-numberp l) ;(integerp l)
+                  )
+	     (equal (bits (setbits x w i j y) k l)
+		    (cat (bits x k (1+ i))
+                         (+ k (- i))
+			 (bits y (- i j) (- l j))
+			 (1+ (- i l)))))
+    :hints (("Goal" :in-theory (enable setbits))))
+
+;taking a slice of each of the thirds.
+;make one huge bits-setbits lemma?
+(defthm bits-setbits-6
+  (implies (and (< i k) ;;case-6
+                (< l j) ;;case-6
+                (<= j i)
+                (< k w)
+                (<= 0 l)
+                (integerp i)
+                (integerp j)
+                (acl2-numberp l) ; (integerp l)
+                (integerp w)
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (cat (bits x k (1+ i))
+                       (+ k (- i))
+                       (cat (bits y (+ i (- j)) 0)
+                            (1+ (- i j))
+                            (bits x (1- j) l)
+                            (- j l))
+                       (+ 1 i (- l)))))
+  :hints (("Goal" :in-theory (enable setbits))))
+
+;prove that if (not (natp w)) setbits = 0 .
+
+;combining these adjacent ranges [i..j][k..l]
+(defthm setbits-combine
+  (implies (and (equal j (+ k 1))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (natp w))
+                (case-split (natp i))
+                (case-split (natp j))
+                (case-split (natp k))
+                (case-split (natp l))
+                )
+  (equal (setbits (setbits x w k l y1) w i j y2)
+         (setbits x w i l (cat y2
+                                (+ 1 i (- j))
+                                y1
+                                (+ 1 k (- l))
+                                ))))
+  :hints (("goal" :in-theory (enable setbits))))
+
+(defthm setbits-combine-2
+  (implies (and (equal j (+ k 1))
+                (case-split (< i w))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (natp w))
+                (case-split (natp i))
+                (case-split (natp j))
+                (case-split (natp k))
+                (case-split (natp l))
+                )
+  (equal (setbits (setbits x w i j y2) w k l y1)
+         (setbits x w i l (cat y2
+                                (+ 1 i (- j))
+                                y1
+                                (+ 1 k (- l))
+                                ))))
+  :hints (("goal" :in-theory (enable setbits))))
+
+(defthm setbits-combine-3
+  (implies (and (equal j (+ k 1))
+                (case-split (< i w))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (natp w))
+                (case-split (natp i))
+                (case-split (natp j))
+                (case-split (natp k))
+                (case-split (natp l)))
+           (equal (setbits (setbits x w i j y2) w k l y1)
+                  (setbits x w i l
+                           (cat y2 (+ 1 i (- j))
+                                 y1 (+ 1 k (- l)))))))
+
+
+(defthm setbits-all
+  (implies (and (equal i (1- w))
+                (case-split (bvecp y w))
+                )
+  (equal (setbits x w i 0 y)
+         y))
+  :hints (("goal" :in-theory (enable setbits))))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/setbits.lisp acl2-6.3/books/rtl/rel9/support/support/setbits.lisp
--- acl2-6.2/books/rtl/rel9/support/support/setbits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/setbits.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,373 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(include-book "cat-def")
+(local (include-book "setbits-proofs"))
+
+(defund bitn (x n)
+  (declare (xargs :guard (and (natp x)
+                              (natp n))
+                  :verify-guards nil))
+  (mbe :logic (bits x n n)
+       :exec  (if (evenp (ash x (- n))) 0 1)))
+
+#|
+
+Currently we expect to leave setbits enabled so that it rewrites to cat, but there are some lemmas below which
+might be useful if we choose to keep setbits disabled...
+
+is this comment still valid? :
+;it may happen that setbitn is called with an index which is a signal rather than a constant.
+;in that case, we probably don't want it to expand to setbits. 
+;thus, we always expect the indices in setbits calls to be constants
+
+
+;Set bits I down to J of the W-bit value X to Y.
+
+(setbits x w i j y) is only well-defined when the following predicate is true:
+
+(and (natp w)
+     (bvecp x w)
+     (integerp i)
+     (integerp j)
+     (<= 0 j)
+     (<= j i)
+     (< i w)
+     (bvecp y (+ 1 i (- j))))
+
+|#
+
+;Note: when j is 0, there is no lower part of x, but we have cat-with-n-0 to handle this case. 
+(defund setbits (x w i j y)
+  (declare (xargs :guard (and (natp x)
+                              (natp y)
+                              (integerp i)
+                              (integerp j)
+                              (<= 0 j)
+                              (<= j i)
+                              (integerp w)
+                              (< i w))
+                  :verify-guards nil))
+  (mbe :logic (cat (bits x (1- w) (1+ i))
+                   (+ -1 w (- i))
+                   (cat (bits y (+ i (- j)) 0)
+                        (+ 1 i (- j))
+                        (bits x (1- j) 0)
+                        j)
+                   (1+ i))
+       :exec  (cond ((int= j 0)
+                     (cond ((int= (1+ i) w)
+                            (bits y (+ i (- j)) 0))
+                           (t
+                            (cat (bits x (1- w) (1+ i))
+                                 (+ -1 w (- i))
+                                 (bits y (+ i (- j)) 0)
+                                 (1+ i)))))
+                    ((int= (1+ i) w)
+                     (cat (bits y (+ i (- j)) 0)
+                          (+ 1 i (- j))
+                          (bits x (1- j) 0)
+                          j))
+                    (t
+                     (cat (bits x (1- w) (1+ i))
+                          (+ -1 w (- i))
+                          (cat (bits y (+ i (- j)) 0)
+                               (+ 1 i (- j))
+                               (bits x (1- j) 0)
+                               j)
+                          (1+ i))))))
+
+(defthm setbits-nonnegative-integer-type
+  (and (integerp (setbits x w i j y))
+       (<= 0 (setbits x w i j y)))
+  :rule-classes (:type-prescription))
+
+;this rule is no better than setbits-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription setbits)))
+
+(defthm setbits-natp
+  (natp (setbits x w i j y)))
+
+;BOZO r-c?
+;tighten?
+(defthm setbits-upper-bound
+  (< (setbits x w i j y) (expt 2 w)))
+
+(defthm setbits-bvecp-simple
+  (bvecp (setbits x w i j y) w))
+
+(defthm setbits-bvecp
+  (implies (and (<= w k) ;gen?
+                (case-split (integerp k))
+                )
+           (bvecp (setbits x w i j y) k)))
+
+(defthm setbits-does-nothing
+  (implies (and (case-split (< i w))
+                (case-split (<= j i))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (<= 0 j))
+                )
+           (equal (setbits x w i j (bits x i j))
+                  (bits x (1- w) 0))))
+
+;taking bits from the lower third
+(defthm bits-setbits-1
+  (implies (and (< k j)
+                (case-split (<= 0 w))
+                (case-split (< i w))
+                (case-split (<= 0 l))
+                (case-split (<= j i)) ;drop?
+                (case-split (integerp w))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (bits x k l)))
+  :hints (("Goal" :in-theory (enable setbits))))
+
+;taking bits from the middle third
+;gen?
+(defthm bits-setbits-2
+  (implies (and (<= k i)
+                (<= j l)
+                (case-split (integerp i))
+                (case-split (<= 0 j))
+                (case-split (integerp j))
+                (case-split (acl2-numberp k));		  (case-split (integerp k))
+                (case-split (acl2-numberp l)) ;	  (case-split (integerp l))
+                (case-split (integerp w))
+                (case-split (<= 0 w))
+                (case-split (< i w))
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (bits y (- k j) (- l j))))
+  :hints (("Goal" :in-theory (enable setbits natp))))
+
+;taking bits from the upper third
+(defthm bits-setbits-3
+  (implies (and (< i l)
+                (case-split (< i w))
+                (case-split (< k w)) ;handle this?
+                (case-split (<= j i))
+                (case-split (<= 0 l))
+                (case-split (<= 0 j))
+                (case-split (<= 0 w))
+                (case-split (integerp l))
+                (case-split (integerp w))
+                (case-split (integerp i))
+                (case-split (integerp j))
+                (case-split (integerp k))
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (bits x k l)))
+  :hints (("Goal" :in-theory (enable setbits natp))))
+
+(defthm setbits-with-w-0
+  (equal (setbits x 0 i j y)
+         0))
+
+;add case-splits to the bitn-setbits rules?
+;why can't i prove this from bits-setbits?
+(defthm bitn-setbits-1
+  (implies (and (< k j) ;case 1
+                (< i w)
+                (<= 0 i)
+                (<= 0 j) 
+                (<= 0 k)
+                (<= j i)
+                (integerp k)
+                (integerp w)
+                (integerp i)
+                (integerp j)
+                )
+           (equal (bitn (setbits x w i j y) k)
+                  (bitn x k))))
+
+(defthm bitn-setbits-2
+  (implies (and(<= k i) ;;case-2
+               (<= j k) ;;case-2
+               (<= 0 i)
+               (<= 0 j) 
+               (< i w)
+               (integerp k)
+               (integerp w)
+               (integerp i)
+               (integerp j)
+               )
+           (equal (bitn (setbits x w i j y) k)
+                  (bitn y (- k j)))))
+
+(defthm bitn-setbits-3
+  (implies (and (< i k) ;;case-3
+                (< k w) ;;case-3
+;                (< i w)
+                (<= 0 i)
+                (<= 0 j) 
+                (<= j i)
+                (integerp i)
+                (integerp j)
+                (integerp k)
+                (integerp w))
+           (equal (bitn (setbits x w i j y) k)
+                  (bitn x k))))
+
+;taking a slice of each of the lower two thirds.
+(defthm bits-setbits-4
+  (implies (and (<= k i) ;;case-4
+                (<= j k) ;;case-4
+                (< l j) ;;case-4
+                (< i w)
+                (<= 0 j)
+                (<= 0 l)
+                (integerp i)
+                (integerp j)
+                (integerp w) 
+                (acl2-numberp l) ;(integerp l)
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (cat (bits y (- k j) 0)
+                       (+ 1 k (- j))
+                       (bits x (1- j) l)
+                       (- j l))))
+  :hints (("Goal" :in-theory (enable setbits))))
+
+;taking a slice of each of the upper two thirds.
+(defthm bits-setbits-5
+    (implies (and (< i k)  ;case-5
+		  (<= l i) ;case-5
+		  (<= j l) ;case-5
+                  (< k w)  ;case-5 ;BOZO drop stuff like this?
+                  (<= 0 j)
+                  (integerp i)
+                  (integerp j)
+                  (integerp w)
+                  (acl2-numberp l) ;(integerp l)
+                  )
+	     (equal (bits (setbits x w i j y) k l)
+		    (cat (bits x k (1+ i))
+                         (+ k (- i))
+			 (bits y (- i j) (- l j))
+			 (1+ (- i l))))))
+
+;taking a slice of each of the thirds.
+;make one huge bits-setbits lemma?
+(defthm bits-setbits-6
+  (implies (and (< i k) ;;case-6
+                (< l j) ;;case-6
+                (<= j i)
+                (< k w)
+                (<= 0 l)
+                (integerp i)
+                (integerp j)
+                (acl2-numberp l) ; (integerp l)
+                (integerp w)
+                )
+           (equal (bits (setbits x w i j y) k l)
+                  (cat (bits x k (1+ i))
+                       (+ k (- i))
+                       (cat (bits y (+ i (- j)) 0)
+                            (1+ (- i j))
+                            (bits x (1- j) l)
+                            (- j l))
+                       (+ 1 i (- l))))))
+
+;prove that if (not (natp w)) setbits = 0 .
+
+;are our setbits-combine rules sufficient to cover all of the cases?
+
+;combining these adjacent ranges [i..j][k..l]
+(defthm setbits-combine
+  (implies (and (equal j (+ k 1))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (natp w))
+                (case-split (natp i))
+                (case-split (natp j))
+                (case-split (natp k))
+                (case-split (natp l))
+                )
+  (equal (setbits (setbits x w k l y1) w i j y2)
+         (setbits x w i l (cat y2
+                                (+ 1 i (- j))
+                                y1
+                                (+ 1 k (- l))
+                                )))))
+
+(defthm setbits-combine-2
+  (implies (and (equal j (+ k 1))
+                (case-split (< i w))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (natp w))
+                (case-split (natp i))
+                (case-split (natp j))
+                (case-split (natp k))
+                (case-split (natp l))
+                )
+  (equal (setbits (setbits x w i j y2) w k l y1)
+         (setbits x w i l (cat y2
+                                (+ 1 i (- j))
+                                y1
+                                (+ 1 k (- l))
+                                )))))
+
+(defthm setbits-combine-3
+  (implies (and (equal j (+ k 1))
+                (case-split (< i w))
+                (case-split (<= j i))
+                (case-split (<= l k))
+                (case-split (natp w))
+                (case-split (natp i))
+                (case-split (natp j))
+                (case-split (natp k))
+                (case-split (natp l)))
+           (equal (setbits (setbits x w i j y2) w k l y1)
+                  (setbits x w i l
+                           (cat y2 (+ 1 i (- j))
+                                 y1 (+ 1 k (- l)))))))
+
+
+(defthm setbits-all
+  (implies (and (equal i (1- w))
+                (case-split (bvecp y w))
+                )
+  (equal (setbits x w i 0 y)
+         y)))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/sgn.lisp acl2-6.3/books/rtl/rel9/support/support/sgn.lisp
--- acl2-6.2/books/rtl/rel9/support/support/sgn.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/sgn.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,37 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local (include-book "float"))
+
+
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0 (if (< x 0) -1 1)))
+
+(defthm sgn-of-not-rationalp
+  (implies (not (rationalp x))
+           (equal (sgn x) 0)))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/shft.lisp acl2-6.3/books/rtl/rel9/support/support/shft.lisp
--- acl2-6.2/books/rtl/rel9/support/support/shft.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/shft.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,75 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(local ; ACL2 primitive
+ (defun natp (x)
+   (declare (xargs :guard t))
+   (and (integerp x)
+        (<= 0 x))))
+
+(defund bvecp (x k)
+  (declare (xargs :guard (integerp k)))
+  (and (integerp x)
+       (<= 0 x)
+       (< x (expt 2 k))))
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+
+(local (include-book "../../arithmetic/top"))
+
+(defund shft (x s l)
+  (declare (xargs :guard (and (integerp s) (rationalp x))))
+  (mod (fl (* (expt 2 s) x)) (expt 2 (nfix l))))
+
+(defthm shft-nonnegative-integer-type
+  (and (integerp (shft x s l))
+       (<= 0 (shft x s l)))
+  :rule-classes (:type-prescription))
+
+;(:type-prescription shft) is no better than shft-nonnegative-integer-type and might be worse:
+(in-theory (disable (:type-prescription shft)))
+
+(defthm shft-natp
+  (natp (shft x s n)))
+
+(defthm shft-bvecp-simple
+  (bvecp (shft x s n) n)
+  :hints (("Goal" :in-theory (enable bvecp shft))))
+
+(local (include-book "bvecp"))
+
+(defthm shft-bvecp
+  (implies (and (<= n k)
+                (case-split (integerp k)))
+           (bvecp (shft x s n) k))
+  :hints (("Goal" :in-theory (disable shft-bvecp-simple)
+           :use shft-bvecp-simple)))
+
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/simple-loop-helpers.lisp acl2-6.3/books/rtl/rel9/support/support/simple-loop-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/support/simple-loop-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/simple-loop-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,362 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(IN-PACKAGE "ACL2")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Helpers from support:
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(include-book "rtl")
+
+(local (include-book "merge"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "setbitn"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Other helpful stuff;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(DEFCONST *EXPT-2-32*
+  (EXPT 2 32))
+
+(DEFTHM BITS-31-0
+  (IMPLIES (AND (NATP I)
+                (< I *EXPT-2-32*))
+           (EQUAL (BITS I 31 0)
+                  I))
+  :HINTS (("Goal" 
+           :IN-THEORY (ENABLE bits-reduce))))
+
+(DEFTHM BVECP-BITN
+  (BVECP (BITN Y I) 1))
+
+(DEFTHM BITN-SETBITN-NOT-EQUAL
+
+; This holds without needing (CASE-SPLIT (BVECP Y 1)).
+
+  (IMPLIES (AND (NOT (EQUAL N K))
+                (CASE-SPLIT (< 0 W))
+                (CASE-SPLIT (< N W))
+                (CASE-SPLIT (< K W))
+                (CASE-SPLIT (<= 0 K))
+                (CASE-SPLIT (INTEGERP W))
+                (CASE-SPLIT (INTEGERP N))
+                (<= 0 N)
+                (CASE-SPLIT (INTEGERP K)))
+           (EQUAL (BITN (SETBITN X W N Y) K)
+                  (BITN X K)))
+  :HINTS (("GOAL" :IN-THEORY (E/D (SETBITN SETBITS)
+                                  (BITN-SETBITN BITS-N-N-REWRITE))
+           :USE ((:INSTANCE BITN-SETBITN
+                            (Y (BITS Y 0 0)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_0$ADJ (Y+ I) T)
+  ($$LOOP_0$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_0$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_0$HIGH
+   (AND (INTEGERP ($$LOOP_0$HIGH))
+        (<= 0 ($$LOOP_0$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_0$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_0$HIGH))
+                 (<= J ($$LOOP_0$HIGH)))
+            (EQUAL (BITN ($$LOOP_0$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_0$ADJ-$$LOOP_0$ADJ ; $$LOOP_0-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_0$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_0$HIGH))
+                 (<= I J))
+            (EQUAL (BITN ($$LOOP_0$ADJ ($$LOOP_0$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_0$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_0$ADJ)))))
+
+(DEFUN $$LOOP_0 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_0$HIGH)) I))
+                  :HINTS
+                  (("Goal" :IN-THEORY
+                    (ENABLE LOG< LOG<= LOGAND NATP1)))))
+  (IF (AND (NATP I) (<= I ($$LOOP_0$HIGH)))
+      ($$LOOP_0 ($$LOOP_0$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_0
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_0$HIGH))
+                (<= J ($$LOOP_0$HIGH)))
+           (EQUAL (BITN ($$LOOP_0 Y+ I) J)
+                  (IF (<= I J)
+                      (BITN ($$LOOP_0$ADJ Y+ J) J)
+                      (BITN Y+ J)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, non-arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_1$ADJ (Y+ I) T)
+  ($$LOOP_1$LOW () T)
+  ($$LOOP_1$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_1$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_1$LOW
+   (AND (INTEGERP ($$LOOP_1$LOW))
+        (<= 0 ($$LOOP_1$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_1$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_1$LOW))
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH)))
+            (EQUAL (BITN ($$LOOP_1$ADJ Y+ I) J)
+                   (BITN Y+ J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ))))
+
+ (DEFTHM BITN-$$LOOP_1$ADJ-$$LOOP_1$ADJ ; $$LOOP_1-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_1$low))
+                 (NATP J)
+                 (>= J ($$LOOP_1$LOW))
+                 (< I ($$LOOP_1$HIGH))
+                 (< J ($$LOOP_1$HIGH))
+                 (<= J I))
+            (EQUAL (BITN ($$LOOP_1$ADJ ($$LOOP_1$ADJ Y+ I)
+                                       J)
+                         J)
+                   (BITN ($$LOOP_1$ADJ Y+ J) J)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_1$ADJ)))))
+
+(DEFUN $$LOOP_1 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))
+                  :HINTS
+                  (("Goal" :IN-THEORY
+                    (ENABLE LOG< LOG<= LOGAND NATP1)))))
+  (IF (AND (NATP I) (>= I ($$LOOP_1$LOW)))
+      ($$LOOP_1 ($$LOOP_1$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM BITN-$$LOOP_1
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_1$LOW))
+                (>= J ($$LOOP_1$LOW))
+                (< I ($$LOOP_1$HIGH))
+                (< J ($$LOOP_1$HIGH)))
+           (EQUAL (BITN ($$LOOP_1 Y+ I) J)
+                  (IF (>= I J)
+                      (BITN ($$LOOP_1$ADJ Y+ J) J)
+                      (BITN Y+ J))))
+  :HINTS (("Goal" :EXPAND (($$LOOP_1 Y+ 0)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting up, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_2$ADJ (Y+ I) T)
+  ($$LOOP_2$HIGH () T))
+
+ (LOCAL
+  (DEFUN $$LOOP_2$HIGH () 3))
+
+ (DEFTHM NATP-$$LOOP_2$HIGH
+   (AND (INTEGERP ($$LOOP_2$HIGH))
+        (<= 0 ($$LOOP_2$HIGH)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_2$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-PASS-THROUGH
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (<= I ($$LOOP_2$HIGH))
+                 (<= J ($$LOOP_2$HIGH)))
+            (EQUAL (AG J ($$LOOP_2$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ))))
+
+ (DEFTHM AG-$$LOOP_2$ADJ-$$LOOP_2$ADJ ; $$LOOP_2-ADJ-ABSORB-UNDER
+   (IMPLIES (AND (NATP I)
+                 (<= I ($$LOOP_2$HIGH))
+                 (NATP J)
+                 (<= J ($$LOOP_2$HIGH))
+                 (<= I J))
+            (EQUAL (AG J ($$LOOP_2$ADJ ($$LOOP_2$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_2$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_2$ADJ)))))
+
+(DEFUN $$LOOP_2 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (- (1+ ($$LOOP_2$HIGH)) I))
+                  :HINTS
+                  (("Goal" :IN-THEORY
+                    (ENABLE LOG< LOG<= LOGAND NATP1)))))
+  (IF (AND (NATP I) (<= I ($$LOOP_2$HIGH)))
+      ($$LOOP_2 ($$LOOP_2$ADJ Y+ I)
+                (+ I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_2
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (<= I ($$LOOP_2$HIGH))
+                (<= J ($$LOOP_2$HIGH)))
+           (EQUAL (AG J ($$LOOP_2 Y+ I))
+                  (IF (<= I J)
+                      (AG J ($$LOOP_2$ADJ Y+ J))
+                      (AG J Y+)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Generic theory for counting down, arrays
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(ENCAPSULATE
+ (($$LOOP_3$ADJ (Y+ I) T)
+  ($$LOOP_3$LOW () T)
+  ($$LOOP_3$HIGH () t))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$LOW () 2))
+
+ (LOCAL
+  (DEFUN $$LOOP_3$HIGH () 4))
+
+ (DEFTHM NATP-$$LOOP_3$LOW
+   (AND (INTEGERP ($$LOOP_3$LOW))
+        (<= 0 ($$LOOP_3$LOW)))
+   :RULE-CLASSES :TYPE-PRESCRIPTION)
+
+ (LOCAL
+  (DEFUN $$LOOP_3$ADJ (Y+ I)
+    (DECLARE (IGNORE I))
+    Y+))
+
+ (DEFTHM AG-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (NATP J)
+                 (NOT (EQUAL I J))
+                 (>= I ($$LOOP_3$LOW))
+                 (>= J ($$LOOP_3$LOW))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH)))
+            (EQUAL (AG J ($$LOOP_3$ADJ Y+ I))
+                   (AG J Y+)))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ))))
+
+ (DEFTHM AG-$$LOOP_3$ADJ-$$LOOP_3$ADJ
+   (IMPLIES (AND (NATP I)
+                 (>= I ($$LOOP_3$low))
+                 (NATP J)
+                 (>= J ($$LOOP_3$low))
+                 (< I ($$LOOP_3$HIGH))
+                 (< J ($$LOOP_3$HIGH))
+                 (<= J I))
+            (EQUAL (AG J ($$LOOP_3$ADJ ($$LOOP_3$ADJ Y+ I)
+                                       J))
+                   (AG J ($$LOOP_3$ADJ Y+ J))))
+   :HINTS (("Goal" :IN-THEORY (ENABLE $$LOOP_3$ADJ)))))
+
+(DEFUN $$LOOP_3 (Y+ I)
+  (DECLARE (XARGS :MEASURE (NFIX (1+ I))
+                  :HINTS
+                  (("Goal" :IN-THEORY
+                    (ENABLE LOG< LOG<= LOGAND NATP1)))))
+  (IF (AND (NATP I) (>= I ($$LOOP_3$LOW)))
+      ($$LOOP_3 ($$LOOP_3$ADJ Y+ I)
+                (- I 1))
+      Y+))
+
+(DEFTHM AG-$$LOOP_3
+  (IMPLIES (AND (NATP I)
+                (NATP J)
+                (>= I ($$LOOP_3$LOW))
+                (>= J ($$LOOP_3$LOW))
+                (< I ($$LOOP_3$HIGH))
+                (< J ($$LOOP_3$HIGH)))
+           (EQUAL (AG J ($$LOOP_3 Y+ I))
+                  (IF (>= I J)
+                      (AG J ($$LOOP_3$ADJ Y+ J))
+                      (AG J Y+))))
+  :HINTS (("Goal" :EXPAND (($$LOOP_3 Y+ 0)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellany
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#| can't be uncommented since is redefined in lib/simple-loop-helpers.lisp
+(deftheory simple-loop-thy-1
+  (UNION-THEORIES
+   '(BITN-SETBITN-NOT-EQUAL
+     AG-DIFF-AS
+     BITS-31-0
+     NATP)
+   (THEORY 'MINIMAL-THEORY)))
+|#
+
+(in-theory (enable setbits))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/simplify-model-helpers.lisp acl2-6.3/books/rtl/rel9/support/support/simplify-model-helpers.lisp
--- acl2-6.2/books/rtl/rel9/support/support/simplify-model-helpers.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/simplify-model-helpers.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,107 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "rtl")
+(local (include-book "bits"))
+
+(local (in-theory (enable lnot bvecp log=)))
+
+(defthm equal-log=-0
+  (equal (equal (log= k x)
+                0)
+         (not (equal k x))))
+
+(defthm equal-log=-1 ; possibly not needed
+  (equal (equal (log= k x)
+                1)
+         (equal k x)))
+
+(defthm equal-lnot-0
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 0)
+                  (equal x 1))))
+
+(defthm equal-lnot-1 ; possibly not needed
+  (implies (bvecp x 1)
+           (equal (equal (lnot x 1) 1)
+                  (equal x 0)))
+  :hints (("Goal" :in-theory (enable lnot))))
+
+(defthm bits-if
+  (equal (bits (if x y z) i j)
+         (if x (bits y i j) (bits z i j))))
+
+(defthm bitn-if
+  (equal (bitn (if x y z) i)
+         (if x (bitn y i) (bitn z i))))
+
+(defthm bits-if1
+  (equal (bits (if1 x y z) i j)
+         (if1 x (bits y i j) (bits z i j)))
+  :hints (("Goal" :in-theory (enable if1))))
+
+(defthm bitn-if1
+  (equal (bitn (if1 x y z) i)
+         (if1 x (bitn y i) (bitn z i)))
+  :hints (("Goal" :in-theory (enable if1))))
+
+(defthm log=-0-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 0 k)
+                  (lnot k 1)))
+  :hints (("Goal" :in-theory (enable log=))))
+
+(defthm log=-1-rewrite
+  (implies (bvecp k 1)
+           (equal (log= 1 k)
+                  k))
+  :hints (("Goal" :in-theory (enable log=))))
+
+(defthm log<>-is-lnot-log=
+  (equal (log<> x y) (lnot (log= x y) 1))
+  :hints (("Goal" :in-theory (enable log<>))))
+
+(local (include-book "cat"))
+
+(defthm cat-combine-constants
+  (implies (and (syntaxp (and (quotep x)
+                              (quotep m)
+                              (quotep y)
+                              (quotep n)))
+                (equal (+ n p) r)
+                (case-split (<= 0 m))
+                (case-split (<= 0 n))
+                (case-split (<= 0 p))
+                (case-split (integerp m))
+                (case-split (integerp n))
+                (case-split (integerp p))
+                )
+           (equal (cat x m (cat y n z p) r)
+                  (cat (cat x m y n) (+ m n) z p))))
+
+(defthm bvecp-if
+  (equal (bvecp (if test x y) k)
+         (if test (bvecp x k) (bvecp y k))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/stick-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/stick-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/stick-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/stick-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1545 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "merge") ;try removing?
+(include-book "land0")
+(include-book "lior0")
+(include-book "lxor0")
+
+(local (include-book "../../arithmetic/top"))
+(local (include-book "bvecp"))
+(local (include-book "bits"))
+(local (include-book "bitn"))
+(local (include-book "lnot"))
+
+
+(local (in-theory (disable fl-def-linear; mod-equal
+                           )))
+
+;(local (in-theory (enable expt-inverse))) ;BOZO
+
+(defund sigm-0 (a b c n)
+  (if (= c 0)
+      (lnot (lxor0 a b n) n)
+    (lxor0 a b n)))
+
+(defund KAP-0 (a b c n)
+  (if (= c 0)
+      (* 2 (lior0 a b n))
+    (* 2 (land0 a b n))))
+
+;why n+1 instead of n twice below?
+(defund TAU-0 (a b c n)
+  (lnot (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (1+ n)) (1+ n)))
+
+(defthm bvecp-sigm-0
+  (bvecp (sigm-0 a b c n) n)
+  :hints (("Goal" :in-theory (enable sigm-0)))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm-0 a b c n)))))
+
+(defthm bvecp-kap-0
+    (implies (and (integerp n)
+                  (<= 0 n)
+                  )
+	     (bvecp (kap-0 a b c n) (1+ n)))
+  :hints (("Goal" :in-theory (enable kap-0)))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap-0 a b c n)))))
+
+(defthm bvecp-tau-0
+  (bvecp (tau-0 a b c n) (1+ n))
+  :hints (("Goal" :in-theory (enable tau-0)))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau-0 a b c n)))))
+
+
+(defthm SIGM-0-BNDS
+  (implies (and (integerp n)
+                (>= n 0)
+                )
+           (and (integerp (sigm-0 a b c n))
+                (>= (sigm-0 a b c n) 0)
+                (< (sigm-0 a b c n) (expt 2 n))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sigm-0))))
+
+
+(defthm KAP-0-BNDS
+  (implies (and (integerp n)
+                (>= n 0)
+                )
+           (and (integerp (kap-0 a b c n))
+                (>= (kap-0 a b c n) 0)
+                (< (kap-0 a b c n) (expt 2 (1+ n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable kap-0 expt-split ))))
+
+(defthm TAU-0-BNDS
+    (implies (and (integerp n)
+		  (>= n 0)
+                  )
+	     (and (integerp (tau-0 a b c n))
+		  (>= (tau-0 a b c n) 0)
+		  (< (tau-0 a b c n) (expt 2 (1+ n)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable tau-0))))
+
+
+
+(local (defthm top-1
+         (implies (and (integerp n)
+                       (>= n 0)
+                       (integerp k)
+                       (>= k 0)
+                       (<= k n)
+;(or (equal c 0) (equal c 1))
+                       )
+                  (not (equal (bitn (tau-0 a b c n) k)
+                              (bitn (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (+ 1 n)) k))))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (enable tau-0)
+		  :use (sigm-0-bnds
+			kap-0-bnds
+			(:instance bitn-lnot-not-equal (x (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (+ 1 n))) (n (1+ n)))
+;			(:instance logxor<2**n (x (osigm a b c n)) (y (okap a b c)) (n (1+ n)))
+;			(:instance logxor-nat (i (osigm a b c n)) (j (okap a b c)))
+                        )))))
+
+(local (in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)))
+
+(local (defthm top-2
+         (implies (and (integerp n)
+                       (>= n 0)
+
+                       (integerp k)
+                       (>= k 0)
+                       (<= k n)
+                       )
+                  (iff (equal (bitn (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (+ 1 n)) k)
+                              (bitn (sigm-0 a b c n) k))
+                       (equal (bitn (kap-0 a b c n) k)
+                              0)))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (disable BITN-KNOWN-NOT-0-REPLACE-WITH-1)
+		  :use (sigm-0-bnds
+			kap-0-bnds
+			(:instance bitn-0-1 (x (sigm-0 a b c n)) (n k))
+			(:instance bitn-0-1 (x (kap-0 a b c n)) (n k))
+;			(:instance bitn-logxor (x (osigm a b c n)) (y (okap a b c)) (n k))
+                        )))))
+
+(local (defthm top-3
+         (implies (and (integerp n)
+                       (>= n 0)
+                       (integerp k)
+                       (>= k 0)
+                       (<= k n)
+                       )
+                  (iff (equal (bitn (tau-0 a b c n) k)
+                              (bitn (sigm-0 a b c n) k))
+                       (equal (bitn (kap-0 a b c n) k)
+                              1)))
+         :rule-classes ()
+         :hints (("Goal" ; :in-theory (disable)
+		  :use (top-1
+			top-2
+			(:instance bitn-0-1 (x (sigm-0 a b c n)) (n k))
+			(:instance bitn-0-1 (x (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (+ 1 n))) (n k))
+			(:instance bitn-0-1 (x (kap-0 a b c n)) (n k))
+			(:instance bitn-0-1 (x (tau-0 a b c n)) (n k)))))))
+
+(local (defthm top-4
+         (equal (bitn (kap-0 a b c n) 0)
+                0)
+         :rule-classes ()
+         :hints (("Goal" :in-theory (enable kap-0)
+                  :use ((:instance bitn-plus-mult (x 0) (k (lior0 a b n)) (m 1) (n 0))
+                        (:instance bitn-plus-mult (x 0) (k (land0 a b n)) (m 1) (n 0))
+                        )))))
+
+(local (defthm top-5
+         (implies (and (integerp n)
+                       (>= n 0)
+                       )		  
+                  (not (equal (bitn (tau-0 a b c n) 0)
+                              (bitn (sigm-0 a b c n) 0))))
+         :rule-classes ()
+         :hints (("Goal" ; :in-theory (disable lnot tau-0 sigm-0 kap-0)
+		  :use (top-4
+			(:instance top-3 (k 0)))))))
+(local (defthm top-7
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (INTEGERP A)
+		  (INTEGERP B)
+                  )
+	     (IFF (equal (bitn (+ A B) 0) 0)
+		  (equal (bitn (TAU-0 A B 0 N) 0) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (sigm-0) ())
+		  :use ( (:instance bitn-lxor0-0 (x a) (y b))
+			(:instance top-5 (c 0))
+;			(:instance logxor-nat (i a) (j b))
+;			(:instance logxor<2**n (x a) (y b))
+			(:instance bitn-lnot-not-equal (k 0) (x (logxor a b n)))
+			(:instance bitn-0-1 (x (tau-0 a b 0 n)) (n 0))
+			(:instance bitn-0-1 (x (sigm-0 a b 0 n)) (n 0))
+			(:instance bitn-0-1 (x (lxor0 a b n)) (n 0)))))))
+
+(local (defthm top-8
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (INTEGERP A)
+		  (INTEGERP B)
+                  )
+	     (IFF (equal (mod (+ A B) 2) 0)
+		  (equal (mod (TAU-0 A B 0 N) 2) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn-def)
+                              '())
+		  :use (top-7
+			(:instance tau-0-bnds (c 0)))))))
+
+(local
+ (defthm top-9
+   (implies (and (integerp a)
+                 (integerp b)
+                 (integerp n)
+                 (<= 1 n)
+                 )
+            (not (equal (bitn (+ a b 1) 0)
+                        (bitn (lxor0 a b n) 0))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance bitn-0-1 (x a) (n 0))
+                         (:instance bitn-0-1 (x b) (n 0))
+                         
+                         (:instance bitn-logxor-0)
+                         (:instance bitn-logxor-0 (a (+ 1 a)))
+                         (:instance bitn-logxor-0 (b 1))
+                         (:instance mod-mod-2-not-equal (m (+ a b))))))))
+
+
+(local (defthm top-10
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (INTEGERP A)
+		  
+		  (INTEGERP B)
+		  )
+	     (IFF (equal (bitn (+ A B 1) 0) 0)
+		  (equal (bitn (TAU-0 A B 1 N) 0) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-negative-bit-of-integer sigm-0 kap-0)
+		  :use (top-9
+			(:instance top-5 (c 1))
+;			(:instance logxor-nat (i a) (j b))
+;			(:instance logxor<2**n (x a) (y b))
+			(:instance bitn-0-1 (x (tau-0 a b 1 n)) (n 0))
+			(:instance bitn-0-1 (x (sigm-0 a b 1 n)) (n 0))
+			(:instance bitn-0-1 (x (+ a b 1)) (n 0)))))))
+
+(local (defthm top-11
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (INTEGERP A)
+
+		  (INTEGERP B)
+)
+	     (IFF (equal (mod (+ A B 1) 2) 0)
+		  (equal (mod (TAU-0 A B 1 N) 2) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (set-difference-theories
+                              (enable bitn-def)
+                              '())
+		  :use (top-10
+			(:instance tau-0-bnds (c 1)))))))
+
+(local (defthm top-12
+    (IMPLIES (AND (INTEGERP N)
+		  (< 0 N)
+		  (INTEGERP A)
+
+		  (INTEGERP B)
+
+		  (OR (equal C 0) (equal C 1)))
+	     (IFF (equal (MOD (+ A B C) 2) 0)
+		  (equal (MOD (TAU-0 A B C N) 2) 0)))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable tau-0)
+		  :use (top-11 top-8)))))
+
+(local (defthm top-13
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (IMPLIES (AND (INTEGERP N)
+				(<= 0 N)
+				(INTEGERP A)
+				(INTEGERP B)
+				(INTEGERP (+ -1 K))
+				(<= 0 (+ -1 K))
+				(< (+ -1 K) N)
+				(OR (equal C 0) (equal C 1)))
+			   (IFF (equal (MOD (+ A B C) (EXPT 2 k))  0)
+				(equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)))
+		  (not (and (equal (MOD (+ A B C) (EXPT 2 k))  0)
+			    (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)))
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (OR (equal C 0) (equal C 1)))
+	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 (+ 1 K)))
+		     0)))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable tau-0)
+		  :use (tau-0-bnds
+			(:instance mod-n-n+1 (a (tau-0 a b c n)) (n k))
+			(:instance mod-n-n+1 (a (+ a b c)) (n k)))))))
+
+(local (defthm top-14
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+		  (equal (bitn (+ a b c) k) (bitn (tau-0 a b c n) k))
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+
+		  (INTEGERP B)
+
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (OR (equal C 0) (equal C 1)))
+	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 (+ 1 K)))
+		     0)))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable tau-0)
+		  :use (tau-0-bnds
+			(:instance mod-n-n+1 (a (tau-0 a b c n)) (n k))
+			(:instance mod-n-n+1 (a (+ a b c)) (n k)))))))
+
+;move?
+(local (defthm top-15
+         (implies (and ;(integerp a)
+                       ;(>= a 0)
+                       (integerp k)
+                       (>= k 0))
+                  (equal (fl (/ a (expt 2 k)))
+                         (+ (* 2 (fl (/ a (expt 2 (1+ k)))))
+                            (bitn a k))))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (e/d ( bitn-def expt) (fl/int-rewrite))
+		  :use ((:instance quot-mod (m (fl (/ a (expt 2 k)))) (n 2))
+			(:instance fl/int-rewrite (x (/ a (expt 2 k))) (n 2))
+                        )))))
+
+;move?
+(local (defthm top-16-1
+    (implies (and ;(integerp a)
+		  ;(>= a 0)
+		  (integerp k)
+		  (>= k 0))
+	     (equal (/ a (expt 2 k))
+		    (/ (+ (* (expt 2 k) (fl (/ a (expt 2 k))))
+			  (mod a (expt 2 k)))
+		       (expt 2 k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance quot-mod (m a) (n (expt 2 k)))
+			)))))
+
+;move?
+(local (defthm top-16-2
+    (implies (and ;(integerp a)
+		  ;(>= a 0)
+		  (integerp k)
+		  (>= k 0))
+	     (equal (/ a (expt 2 k))
+		    (+ (/ (* (expt 2 k) (fl (/ a (expt 2 k)))) (expt 2 k))
+		       (/ (mod a (expt 2 k)) (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :use (top-16-1)))))
+
+;move?
+(local (defthm top-16
+    (implies (and ;(integerp a)
+		  ;(>= a 0)
+		  (integerp k)
+		  (>= k 0))
+	     (equal (/ a (expt 2 k))
+		    (+ (fl (/ a (expt 2 k)))
+		       (/ (mod a (expt 2 k)) (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable a15)
+           :use (top-16-2)))))
+
+;move?
+(local (defthm top-17
+    (implies (and ;(integerp a)
+		  ;(>= a 0)
+		  (integerp k)
+		  (>= k 0))
+	     (equal (/ a (expt 2 k))
+		(+ (* 2 (fl (/ a (expt 2 (1+ k)))))
+		   (bitn a k)
+		   (/ (mod a (expt 2 k)) (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :use (top-15
+			top-16
+)))))
+
+(local
+ (defthm top-18
+   (IMPLIES (AND (INTEGERP K) 
+                 (< 0 K)
+                 (equal (MOD (+ A B C) (EXPT 2 k))  0)
+                 (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+                 (INTEGERP N)
+                 (<= 0 N)
+                 (INTEGERP A)
+;		  (<= 0 A)
+;	  (< A (EXPT 2 N))
+                 (INTEGERP B)
+;  (<= 0 B)
+; (< B (EXPT 2 N))
+                 (INTEGERP K)
+                 (<= 0 K)
+                 (< K N)
+;(OR (equal C 0) (equal C 1))
+                 )
+            (equal (/ (+ a b c) (expt 2 k))
+                   (+ (bitn a k)
+                      (bitn b k)
+                      (* 2 (fl (/ a (expt 2 (1+ k)))))
+                      (* 2 (fl (/ b (expt 2 (1+ k)))))
+                      (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+                         (expt 2 k)))))
+   :rule-classes ()
+   :hints (("Goal" :use ((:instance top-17)
+                         (:instance top-17 (a b)))))))
+
+(local
+ (defthm top-19
+   (IMPLIES (AND (INTEGERP K) 
+                 (< 0 K)
+                 (equal (MOD (+ A B C) (EXPT 2 k))  0)
+                 (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+                 (INTEGERP N)
+                 (<= 0 N)
+                 (INTEGERP A)
+;                 (<= 0 A)
+ ;                (< A (EXPT 2 N))
+                 (INTEGERP B)
+  ;               (<= 0 B)
+   ;              (< B (EXPT 2 N))
+                 (INTEGERP K)
+                 (<= 0 K)
+                 (< K N)
+                 (rationalp c);                 (OR (equal C 0) (equal C 1))
+                 )
+            (equal (fl (/ (+ a b c) (expt 2 k)))
+               (+ (bitn a k)
+                  (bitn b k)
+                  (* 2 (fl (/ a (expt 2 (1+ k)))))
+                  (* 2 (fl (/ b (expt 2 (1+ k)))))
+                  (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+                         (expt 2 k))))))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (e/d (expt-inverse
+                                    ;expt-split
+                                    ;expt-minus
+                                    ) ( fl+int-rewrite expo-shift-general))
+            :use ((:instance top-18)
+                  (:instance fl+int-rewrite
+                             (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+                                   (expt 2 k)))
+                             (n (+ (bitn a k)
+                                   (bitn b k)
+                                   (* 2 (fl (/ a (expt 2 (1+ k)))))
+                                   (* 2 (fl (/ b (expt 2 (1+ k)))))))))))))
+;slow!
+;drop?
+(local (defthm top-20
+    (IMPLIES (AND (INTEGERP K) 
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP K)
+		  (<= 0 K)
+                  )
+	     (equal (mod (+ (bitn a k)
+			(bitn b k)
+			(* 2 (fl (/ a (expt 2 (1+ k)))))
+			(* 2 (fl (/ b (expt 2 (1+ k)))))
+			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+			       (expt 2 k))))
+		     2)
+		(mod (+ (bitn a k)
+			(bitn b k)
+			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+			       (expt 2 k))))
+		     2)))
+    :hints (("Goal" :in-theory (disable MOD-DOES-NOTHING ;the disables are just for efficiency
+                                        FL-DEF-LINEAR-PART-2
+                                        FL-DEF-LINEAR-PART-1
+                                        ;MOD-EQUAL
+                                        MOD-QUOTIENT-INTEGERP
+                                        MOD-BND-1)))
+    :rule-classes ()))
+
+(local (defthm top-21
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (rationalp c) ;(OR (equal C 0) (equal C 1))
+                  )
+	     (equal (mod (fl (/ (+ a b c) (expt 2 k))) 2)
+		(mod (+ (bitn a k)
+			(bitn b k)
+			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+			       (expt 2 k))))
+		     2)))
+  :rule-classes ()
+  :hints (("Goal" :hands-off (mod bitn fl expt)
+		  :use (top-19 top-20)))))
+
+;move?
+(local (defthm top-23
+    (implies (and; (integerp a)
+;		  (integerp b)
+		  (integerp k)
+;		  (>= a 0)
+	;	  (>= b 0)
+		  (>= k 0)
+                  (integerp n)
+                  (<= 0 n)
+                  (< k n)
+                  )
+	     (equal (bitn (lxor0 a b n) k)
+		(mod (+ (bitn a k) (bitn b k)) 2)))
+  :rule-classes ()
+  :hints (("Goal" :use (;(:instance bitn-logxor (x a) (y b) (n k))
+			(:instance bitn-0-1 (x a) (n k))
+			(:instance bitn-0-1 (x b) (n k)))))))
+
+(local (defthm top-22
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (rationalp c) ;(OR (equal C 0) (equal C 1))
+                  )
+	     (equal (bitn (+ a b c) k)
+		(mod (+ (bitn a k)
+			(bitn b k)
+			(fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+			       (expt 2 k))))
+		     2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-def)
+		  :use (top-21)))))
+
+
+
+(local (defthm top-24
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (rationalp c) ;(OR (equal C 0) (equal C 1))
+                  )
+	     (iff (equal (bitn (+ a b c) k)
+		     (mod (+ (bitn a k) (bitn b k)) 2))
+		  (equal (mod (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+				 (expt 2 k)))
+			  2)
+		     0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable INTEGERP-PROD ;some of the disables are for efficiency
+                                      BITN-UPPER-BOUND-LINEAR
+                                      BITN-IN-SUM-SPLIT-CASES
+                                      ;BITN-NONNEGATIVE-INTEGER-TYPE
+                                      BITN-<=-1
+                                      MOD-QUOTIENT-INTEGERP
+                                      FL-DEF-LINEAR-PART-1
+                                      FL-DEF-LINEAR-PART-2
+                                      ;MOD-EQUAL
+                                      FL-NON-NEGATIVE-LINEAR
+                                      NONNEG-+-TYPE
+                                      )
+           :use (top-22)))))
+
+(local (defthm top-25
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+;		  (<= 0 A)
+	;	  (< A (EXPT 2 N))
+		  (INTEGERP B)
+		;  (<= 0 B)
+		 ; (< B (EXPT 2 N))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (rationalp c);(OR (equal C 0) (equal C 1))
+                  )
+	     (iff (equal (bitn (+ a b c) k)
+		     (bitn (lxor0 a b n) k))
+		  (equal (mod (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+				 (expt 2 k)))
+			  2)
+		     0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (;expt-inverse
+                                   expt-minus
+                                   expt-split
+                                   ) (;expo-shift-general
+                                      ))
+           :use (top-24 top-23)))))
+
+(local (defthm top-26
+    (implies (and (integerp a)
+		  (integerp b) 
+		  (integerp k)
+		  (>= k 0)
+		  (or (equal c 0) (equal c 1)))
+	     (< (+ (mod a (expt 2 k))
+		   (mod b (expt 2 k))
+		   c)
+		(expt 2 (1+ k))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable  expt-split)
+           :use ()))))
+
+(local (defthm top-27
+    (implies (and (integerp a)
+;		  (>= a 0)
+		  (integerp b) 
+	;	  (>= b 0)
+		  (integerp k)
+		  (>= k 0)
+		  (or (equal c 0) (equal c 1)))
+	     (< (/ (+ (mod a (expt 2 k))
+		      (mod b (expt 2 k))
+		      c)
+		   (expt 2 k))
+		2))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable  a15)
+           :use (top-26
+			(:instance *-strongly-monotonic
+				   (x (expt 2 (- k)))
+				   (y (+ (mod a (expt 2 k))
+					 (mod b (expt 2 k))
+					 c))
+				   (y+ (expt 2 (1+ k)))))))))
+
+(local (defthm top-28
+    (implies (and (integerp a)
+;		  (>= a 0)
+		  (integerp b) 
+	;	  (>= b 0)
+		  (integerp k)
+		  (>= k 0)
+		  (or (equal c 0) (equal c 1)))
+	     (< (fl (/ (+ (mod a (expt 2 k))
+			  (mod b (expt 2 k))
+			  c)
+		       (expt 2 k)))
+		2))
+  :rule-classes ()
+  :hints (("Goal" :use (top-27
+			(:instance fl-def-linear (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k)))))))))
+
+(local (defthm top-29
+    (implies (and (integerp a)
+;		  (>= a 0)
+		  (integerp b) 
+	;	  (>= b 0)
+		  (integerp k)
+		  (>= k 0)
+		  (or (equal c 0) (equal c 1)))
+	     (>= (fl (/ (+ (mod a (expt 2 k))
+			   (mod b (expt 2 k))
+			   c)
+			(expt 2 k)))
+		 0))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance n<=fl-linear
+				   (n 0) 
+				   (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k))))
+;			(:instance mod>=0 (m a) (n (expt 2 k)))
+	;		(:instance mod>=0 (m b) (n (expt 2 k)))
+                        )))))
+
+(local (defthm top-30
+    (implies (and (integerp a)
+;		  (>= a 0)
+		  (integerp b) 
+	;	  (>= b 0)
+		  (integerp k)
+		  (>= k 0)
+		  (or (equal c 0) (equal c 1))
+                  )
+	     (equal (mod (fl (/ (+ (mod a (expt 2 k))
+			       (mod b (expt 2 k))
+			       c)
+			    (expt 2 k)))
+		     2)
+		(fl (/ (+ (mod a (expt 2 k))
+			  (mod b (expt 2 k))
+			  c)
+		       (expt 2 k)))))
+  :rule-classes ()
+  :hints (("Goal" :use (top-28
+			top-29
+			(:instance mod-does-nothing
+				   (m (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k))))
+				   (n 2)))))))
+
+(local (defthm top-31
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+;		  (<= 0 A)
+		  ;(< A (EXPT 2 N))
+		  (INTEGERP B)
+	;	  (<= 0 B)
+		  ;(< B (EXPT 2 N))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (OR (equal C 0) (equal C 1))
+                  )
+	     (iff (equal (bitn (+ a b c) k)
+		     (bitn (lxor0 a b n) k))
+		  (equal (fl (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+			    (expt 2 k)))
+		     0)))
+  :rule-classes ()
+  :hints (("Goal"  :in-theory (e/d (;expt-inverse
+                                    )
+                                   ;; MattK: The following disable is needed by
+                                   ;; v2-8-alpha-12-30-03.  I didn't
+                                   ;; investigate why.
+                                   (FL-INTEGER-TYPE)) 
+           :use (top-25 top-30)))))
+
+(local (defthm top-32
+    (implies (and (rationalp x)
+		  (>= (fl x) 0))
+	     (iff (equal (fl x) 0) (< x 1)))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance fl-unique (n 0))
+			(:instance fl-def-linear))))))
+
+(local (defthm top-33
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+;		  (<= 0 A)
+	;	  (< A (EXPT 2 N))
+		  (INTEGERP B)
+		;  (<= 0 B)
+		 ; (< B (EXPT 2 N))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (OR (equal C 0) (equal C 1)))
+	     (iff (equal (bitn (+ a b c) k)
+		     (bitn (lxor0 a b n) k))
+		  (< (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+			(expt 2 k))
+		     1)))
+  :rule-classes ()
+  :hints (("Goal" :use (top-31 
+			top-29
+			(:instance top-32 (x (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c) (expt 2 k)))))))))
+
+(local (defthm top-34
+         (IMPLIES (AND (INTEGERP K) 
+                       (< 0 K)
+                       (equal (MOD (+ A B C) (EXPT 2 k))  0)
+                       (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+                       (INTEGERP N)
+                       (<= 0 N)
+                       (INTEGERP A)
+;	  (<= 0 A)
+;		  (< A (EXPT 2 N))
+                       (INTEGERP B)
+;  (<= 0 B)
+; (< B (EXPT 2 N))
+                       (INTEGERP K)
+                       (<= 0 K)
+                       (< K N)
+                       (OR (equal C 0) (equal C 1)))
+                  (iff (equal (bitn (+ a b c) k)
+                              (bitn (lxor0 a b n) k))
+                       (< (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+                          (expt 2 k))))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (enable a15)
+                  :use (top-33
+			(:instance *-strongly-monotonic
+				   (x (expt 2 (- k)))
+				   (y (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c))
+				   (y+ (expt 2 k)))
+			(:instance *-strongly-monotonic
+				   (x (expt 2 k))
+				   (y (/ (+ (mod a (expt 2 k)) (mod b (expt 2 k)) c)
+					 (expt 2 k)))
+				   (y+ 1)))))))
+
+(local (defthm top-35
+         (implies (and (integerp n)
+                       (>= n 0)
+                       (integerp a)
+;		  (>= a 0)
+;	  (< a (expt 2 n))
+                       (integerp b)
+;  (>= b 0)
+; (< b (expt 2 n))
+                       (integerp k)
+                       (> k 0)
+                       (<= k n))
+                  (iff (equal (bitn (kap-0 a b 0 n) k) 0)
+                       (and (equal (bitn a (1- k)) 0)
+                            (equal (bitn b (1- k)) 0))))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (enable kap-0)
+                  :use ((:instance bitn-shift (k 1) (n (1- k)) (x (logior a b)))
+			(:instance bitn-0-1 (x a) (n (1- k)))
+			(:instance bitn-0-1 (x b) (n (1- k)))
+;			(:instance bit-dist-b (x a) (y b) (n (1- k)))
+                        )))))
+
+(local (defthm top-36
+         (implies (and (rationalp a) ;(integerp a)
+;(>= a 0)
+                       (integerp k)
+                       (> k 0))
+                  (iff (equal (bitn a (1- k)) 0)
+                       (< (mod a (expt 2 k)) (expt 2 (1- k)))))
+         :rule-classes ()
+         :hints (("Goal" :in-theory (enable bitn-mod)
+                  :use ( ;(:instance bitn-mod (x a) (n k) (k (1- k)))
+;			(:instance mod>=0 (m a) (n (expt 2 k)))
+			(:instance mod-bnd-1 (m a) (n (expt 2 k)))
+			(:instance bit-expo-a (x (mod a (expt 2 k))) (n (1- k)))
+			(:instance bit-expo-b (x (mod a (expt 2 k))) (n (1- k))))))))
+
+(local (defthm top-37
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp a)
+;		  (>= a 0)
+	;	  (< a (expt 2 n))
+		  (integerp b)
+		;  (>= b 0)
+		 ; (< b (expt 2 n))
+		  (integerp k)
+		  (> k 0)
+		  (<= k n)
+		  (equal (bitn (kap-0 a b 0 n) k) 0))
+	     (< (+ (mod a (expt 2 k))
+		   (mod b (expt 2 k)))
+		(expt 2 k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split)
+           :use (top-35
+                 top-36
+                 (:instance top-36 (a b)))))))
+
+(local (defthm top-38
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp a)
+;		  (>= a 0)
+	;	  (< a (expt 2 n))
+		  (integerp b)
+		;  (>= b 0)
+		 ; (< b (expt 2 n))
+		  (integerp k)
+		  (> k 0)
+		  (<= k n)
+		  (not (equal (bitn (kap-0 a b 0 n) k) 0)))
+	     (>= (+ (mod a (expt 2 k))
+		    (mod b (expt 2 k)))
+		 (expt 2 (1- k))))
+  :rule-classes ()
+  :hints (("Goal" :use (top-35
+			top-36
+			(:instance top-36 (a b))
+;			(:instance mod>=0 (m a) (n (expt 2 k)))
+	;		(:instance mod>=0 (m b) (n (expt 2 k)))
+                        )))))
+
+(local (defthm top-39
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp a)
+;		  (>= a 0)
+		  (equal (mod (+ a b) (expt 2 k)) 0)
+	;	  (< a (expt 2 n))
+		  (integerp b)
+		;  (>= b 0)
+		 ; (< b (expt 2 n))
+		  (integerp k)
+		  (> k 0)
+		  (<= k n)
+		  (not (equal (bitn (kap-0 a b 0 n) k) 0)))
+	     (>= (+ (mod a (expt 2 k))
+		    (mod b (expt 2 k)))
+		 (expt 2 k)))
+  :rule-classes ()
+  :hints (("Goal" :use (top-38
+			(:instance mod-sum (n (expt 2 k)))
+;			(:instance mod>=0 (m a) (n (expt 2 k)))
+	;		(:instance mod>=0 (m b) (n (expt 2 k)))
+			(:instance mod-sum (a (mod b (expt 2 k))) (b a) (n (expt 2 k)))
+			(:instance mod-does-nothing (m (+ (mod a (expt 2 k)) (mod b (expt 2 k))))
+                                   (n (expt 2 k))))))))
+
+(local (defthm top-40
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp a)
+;		  (>= a 0)
+		  (equal (mod (+ a b) (expt 2 k)) 0)
+	;	  (< a (expt 2 n))
+		  (integerp b)
+		;  (>= b 0)
+		 ; (< b (expt 2 n))
+		  (integerp k)
+		  (> k 0)
+		  (<= k n))
+	     (iff (equal (bitn (kap-0 a b 0 n) k) 0)
+		  (< (+ (mod a (expt 2 k))
+			(mod b (expt 2 k)))
+		     (expt 2 k))))
+  :rule-classes ()
+  :hints (("Goal" :use (top-39 top-37)))))
+
+(local (defthm top-41
+         (IMPLIES (AND (INTEGERP K) 
+                       (< 0 K)
+                       (equal (MOD (+ A B) (EXPT 2 k))  0)
+                       (equal (MOD (TAU-0 A B 0 N) (EXPT 2 k)) 0)
+                       (INTEGERP N)
+                       (<= 0 N)
+                       (INTEGERP A)
+;		  (<= 0 A)
+;	  (< A (EXPT 2 N))
+                       (INTEGERP B)
+; (<= 0 B)
+;  (< B (EXPT 2 N))
+                       (INTEGERP K)
+                       (<= 0 K)
+                       (< K N))
+                  (iff (equal (bitn (+ a b) k)
+                              (bitn (lxor0 a b n) k))
+                       (equal (bitn (kap-0 a b 0 n) k)
+                              0)))
+         :rule-classes ()
+         :hints (("Goal" :use ((:instance top-34 (c 0)) top-40)))))
+
+(local (defthm top-42
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B 0 N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+		  (INTEGERP B)
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N))
+	     (equal (bitn (+ a b) k) (bitn (tau-0 a b 0 n) k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (sigm-0) ())
+		  :use (top-41
+			(:instance top-3 (c 0))
+			(:instance bitn-0-1 (x (kap-0 a b 0 n)) (n k))
+			(:instance bitn-0-1 (x (lxor0 a b n)) (n k))
+			(:instance bitn-0-1 (x (sigm-0 a b 0 n)) (n k))
+			(:instance bitn-0-1 (x (tau-0 a b 0 n)) (n k))
+			(:instance bitn-0-1 (x (+ a b)) (n k))
+			(:instance bitn-lnot-not-equal (x (lxor0 a b n)))
+;			(:instance logxor<2**n (x a) (y b))
+;			(:instance logxor-nat (i a) (j b))
+                        )))))
+
+(local
+ (defthm top-43
+   (IMPLIES (AND (INTEGERP K) 
+                 (< 0 K)
+                 (equal (MOD (+ A B 1) (EXPT 2 k))  0)
+                 (equal (MOD (TAU-0 A B 1 N) (EXPT 2 k)) 0)
+                 (INTEGERP N)
+                 (<= 0 N)
+                 (INTEGERP A)
+;		  (<= 0 A)
+;	  (< A (EXPT 2 N))
+                 (INTEGERP B)
+;  (<= 0 B)
+; (< B (EXPT 2 N))
+                 (INTEGERP K)
+                 (<= 0 K)
+                 (< K N))
+            (equal (+ (mod a (expt 2 k))
+                      (mod b (expt 2 k))
+                      1)
+                   (expt 2 k)))
+   :rule-classes ()
+   :hints (("Goal" :in-theory (disable MOD-SUMS-CANCEL-1)
+            :use ((:instance top-26 (c 1))
+                  (:instance mod-must-be-n
+                             (m (+ (mod a (expt 2 k)) (mod b (expt 2 k)) 1))
+                             (n (expt 2 k)))
+;			(:instance mod>=0 (n (expt 2 k)) (m a))
+;		(:instance mod>=0 (n (expt 2 k)) (m b))
+                  (:instance mod-sum (n (expt 2 k)) (a (+ (mod a (expt 2 k)) 1)))
+                  (:instance mod-sum (n (expt 2 k)) (a (+ b 1)) (b a)))))))
+
+(local
+ (defthm top-44
+   (IMPLIES (AND (INTEGERP K) 
+                 (< 0 K)
+                 (equal (MOD (+ A B 1) (EXPT 2 k))  0)
+                 (equal (MOD (TAU-0 A B 1 N) (EXPT 2 k)) 0)
+                 (INTEGERP N)
+                 (<= 0 N)
+                 (INTEGERP A)
+                 (INTEGERP B)
+                 (INTEGERP K)
+                 (<= 0 K)
+                 (< K N))
+            (not (equal (bitn (+ a b 1) k)
+                        (bitn (lxor0 a b n) k))))
+   :rule-classes ()
+   :hints (("Goal"; :in-theory (disable tau-0)
+            :use (top-43
+                  (:instance top-34 (c 1)))))))
+
+(local (defthm top-45
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp a)
+;		  (>= a 0)
+	;	  (< a (expt 2 n))
+		  (integerp b)
+		;  (>= b 0)
+		 ; (< b (expt 2 n))
+		  (integerp k)
+		  (> k 0)
+		  (<= k n))
+	     (iff (equal (bitn (kap-0 a b 1 n) k) 1)
+		  (and (equal (bitn a (1- k)) 1)
+		       (equal (bitn b (1- k)) 1))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable kap-0)
+           :use ((:instance bitn-shift (k 1) (n (1- k)) (x (land0 a b n)))
+			(:instance bitn-0-1 (x a) (n (1- k)))
+			(:instance bitn-0-1 (x b) (n (1- k)))
+                        )))))
+
+(local (defthm top-46
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp a)
+;		  (>= a 0)
+	;	  (< a (expt 2 n))
+		  (integerp b)
+		;  (>= b 0)
+		 ; (< b (expt 2 n))
+		  (integerp k)
+		  (> k 0)
+		  (<= k n)
+		  (equal (bitn (kap-0 a b 1 n) k) 1))
+	     (>= (+ (mod a (expt 2 k))
+		    (mod b (expt 2 k)))
+		 (expt 2 k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable expt-split)
+           :use (top-45
+			top-36
+			(:instance top-36 (a b)))))))
+
+(local (defthm top-47
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B 1) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B 1 N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+;		  (<= 0 A)
+	;	  (< A (EXPT 2 N))
+		  (INTEGERP B)
+		;  (<= 0 B)
+		 ; (< B (EXPT 2 N))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N))
+	     (equal (bitn (kap-0 a b 1 n) k) 0))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable tau-0)
+		  :use (top-46
+			top-43
+			(:instance bitn-0-1 (x (kap-0 a b 1 n)) (n k)))))))
+
+(local (defthm top-48
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B 1) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B 1 N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+;		  (<= 0 A)
+	;	  (< A (EXPT 2 N))
+		  (INTEGERP B)
+		;  (<= 0 B)
+		 ; (< B (EXPT 2 N))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N))
+	     (equal (bitn (+ a b 1) k) (bitn (tau-0 a b 1 n) k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d ( sigm-0) ())
+		  :use (top-47
+			top-44
+			(:instance top-3 (c 1))
+			(:instance bitn-0-1 (x (lxor0 a b n)) (n k))
+			(:instance bitn-0-1 (x (sigm-0 a b 1 n)) (n k))
+			(:instance bitn-0-1 (x (tau-0 a b 1 n)) (n k))
+			(:instance bitn-0-1 (x (+ a b 1)) (n k)))))))
+
+(local (defthm top-49
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (equal (MOD (+ A B C) (EXPT 2 k))  0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+;		  (<= 0 A)
+	;	  (< A (EXPT 2 N))
+		  (INTEGERP B)
+		;  (<= 0 B)
+		 ; (< B (EXPT 2 N))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (OR (equal C 0) (equal C 1)))
+	     (equal (bitn (+ a b c) k) (bitn (tau-0 a b c n) k)))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable tau-0)
+		  :use (top-48 top-42)))))
+
+(local (defthm top-50
+    (IMPLIES (AND (INTEGERP K) 
+		  (< 0 K)
+		  (IMPLIES (AND (INTEGERP N)
+				(<= 0 N)
+				(INTEGERP A)
+			;	(<= 0 A)
+				;(< A (EXPT 2 N))
+				(INTEGERP B)
+				;(<= 0 B)
+				;(< B (EXPT 2 N))
+				(INTEGERP (+ -1 K))
+				(<= 0 (+ -1 K))
+				(< (+ -1 K) N)
+				(OR (equal C 0) (equal C 1)))
+			   (IFF (equal (MOD (+ A B C) (EXPT 2 k))  0)
+				(equal (MOD (TAU-0 A B C N) (EXPT 2 k)) 0)))
+		  (INTEGERP N)
+		  (<= 0 N)
+		  (INTEGERP A)
+;		  (<= 0 A)
+	;	  (< A (EXPT 2 N))
+		  (INTEGERP B)
+		;  (<= 0 B)
+		 ; (< B (EXPT 2 N))
+		  (INTEGERP K)
+		  (<= 0 K)
+		  (< K N)
+		  (OR (equal C 0) (equal C 1)))
+	     (IFF (equal (MOD (+ A B C) (EXPT 2 (+ 1 K))) 0)
+		  (equal (MOD (TAU-0 A B C N) (EXPT 2 (+ 1 K)))
+		     0)))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable tau-0)
+		  :use (top-13 top-14 top-49)))))
+
+;local?
+(defthm STICK-LEMMA
+    (implies (and (integerp n)
+		  (>= n 0)
+		  (integerp a)
+;		  (>= a 0)
+	;	  (< a (expt 2 n))
+		  (integerp b)
+		;  (>= b 0)
+		 ; (< b (expt 2 n))
+		  (integerp k)
+		  (>= k 0)
+		  (< k n)
+		  (or (equal c 0) (equal c 1)))
+	     (iff (equal (mod (+ a b c) (expt 2 (1+ k))) 0)
+		  (equal (mod (tau-0 a b c n) (expt 2 (1+ k))) 0)))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable tau-0)
+		  :induct (natp-induct k))
+	  ("Subgoal *1/2"; :in-theory (disable tau-0)
+			  :use (top-50))
+	  ("Subgoal *1/1" :use (top-12))))
+
+
+(defthm top-thm-2-old
+  (implies (and (natp n)
+                (integerp a) ;		  (bvecp a n)
+                (integerp b) ;(bvecp b n)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+                  (equal (bits (tau-0 a b c n) k 0) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (stick-lemma
+                 (:instance bits-mod (x (+ a b c)) (i k))
+                 (:instance bits-mod (x (tau-0 a b c n)) (i k))))))
+
+
+;BOZO prove a bits thm to make this go through
+(local (defthm stick-lemma-3-1
+    (implies (and (integerp a);(natp a)
+		  (integerp b);(natp b)
+                  (integerp k)
+;		  (natp k)
+                  )
+	     (equal (bits (+ a b 1) k 0)
+		    (bits (+ (bits a k 0)
+			     (bits b k 0)
+			     1)
+			  k 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (:instance bits-sum-plus-1-original (x a) (y b) (i k) (j 0)) ;weird hint
+           ))))
+
+(local (defthm stick-lemma-3-2
+    (implies (and (natp n)
+		  (natp k)
+		  (natp j)
+		  (< k n)
+		  (<= j k)
+		  (integerp a) ;(bvecp a n)
+		  (integerp b) ;(bvecp b n)
+                  )
+	     (equal (bits (lnot (lxor0 a b n) n) k j)
+		    (lnot (lxor0 (bits a k j) (bits b k j) (1+ (- k j))) (1+ (- k j)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-lnot bits-logxor natp bvecp-forward)))))
+
+;drop?
+(local (defthm stick-lemma-3-3
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (integerp a);(bvecp a n)
+		  (integerp b) ;(bvecp b n)
+                  )
+	     (equal (bitn (lnot (lxor0 a b n) n) k)
+		    (lnot (lxor0 (bitn a k) (bitn b k) 1) 1)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-n-n-rewrite lnot-bvecp)
+		  :use ((:instance stick-lemma-3-2 (j k)))))))
+
+(local (defthm stick-lemma-3-4
+    (implies (and (natp n)
+		  (> n 0)
+		  (integerp a);(bvecp a n)
+		  (integerp b) ;(bvecp b n)
+                  )
+	     (equal (bits (+ a b 1) 0 0)
+		    (bits (lnot (lxor0 a b n) n) 0 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-n-n-rewrite lnot-bvecp bvecp-forward)
+		  :use ((:instance stick-lemma-3-1 (k 0))
+			(:instance stick-lemma-3-2 (k 0) (j 0))
+			(:instance bitn-0-1 (x a) (n 0))
+			(:instance bitn-0-1 (x b) (n 0)))))))
+
+(local (defthm stick-lemma-3-5
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b) ;(bvecp b n)
+		  (iff (equal (bits (+ a b 1) (1- k) 0)
+			      0)
+		       (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			      0))
+		  (not (equal (bits (+ a b 1) (1- k) 0) 0)))
+	     (iff (equal (bits (+ a b 1) k 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) k 0)
+			 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable lnot-bvecp bits-n-n-rewrite)
+		  :use ((:instance bitn-plus-bits
+				   (x (lnot (lxor0 a b n) n))
+				   (n k)
+				   (m 0))
+			(:instance bitn-plus-bits
+				   (x (+ a b 1))
+				   (n k)
+				   (m 0))
+			(:instance bits-0-bitn-0
+				   (x (lnot (lxor0 a b n) n))
+				   (n k))
+			(:instance bits-0-bitn-0
+				   (x (+ a b 0))
+				   (n k)))))))
+
+
+(local (defthm stick-lemma-3-7
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b) ;(bvecp b n)
+		  (equal (bits (+ a b 1) (1- k) 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			 0))
+	     (equal (+ (bits a (1- k) 0) (bits b (1- k) 0) 1)
+		(expt 2 k)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-mod bvecp-forward)
+		  :use (;stick-lemma-3-6
+			(:instance stick-lemma-3-1 (k (1- k)))
+			(:instance mod-must-be-n
+				   (m (+ (bits a (1- k) 0) (bits b (1- k) 0) 1))
+				   (n (expt 2 k))))))))
+
+(local (defthm stick-lemma-3-8
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b);(bvecp b n)
+		  (equal (bits (+ a b 1) (1- k) 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			 0)
+                  )
+	     (equal (bits (+ a b 1) k 0)
+		(bits (* (expt 2 k) (+ (bitn a k) (bitn b k) 1)) k 0)))
+  :rule-classes ()
+  :otf-flg t
+  :hints (("Goal" :in-theory (e/d (bits-tail bits-n-n-rewrite ) (BITS-SHIFT-BY-CONSTANT-POWER-OF-2)) ;BOZO remove disable
+           :use ((:instance bitn-plus-bits (x (+ 1 A B)) (n k) (m 0))
+                 (:instance bitn-0-1 (x a) (n k))
+                 (:instance bitn-0-1 (x b) (n k))
+                 (:instance bitn-0-1 (x (+ 1 A B)) (n k))
+                 (:instance bits-sum-plus-1-original (x a) (y b) (i k) (j k))
+                 stick-lemma-3-7
+                 )))))
+
+(local (defthm stick-lemma-3-9
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b);(bvecp b n)
+		  (equal (bits (+ a b 1) (1- k) 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			 0))
+	     (equal (bits (+ a b 1) k 0)
+		(* (expt 2 k) 
+		   (bits (+ (bitn a k) (bitn b k) 1) 0 0))))
+  :rule-classes ()
+  :hints (("Goal" :use (stick-lemma-3-8
+			(:instance bits-shift-up-2 (x (+ (bitn a k) (bitn b k) 1)) (i 0)))))))
+
+(local (defthm stick-lemma-3-10
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b);(bvecp b n)
+		  (equal (bits (+ a b 1) (1- k) 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			 0))
+	     (iff (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (+ (bitn a k) (bitn b k) 1) 0 0) 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (stick-lemma-3-9)))))
+
+(local (defthm stick-lemma-3-11
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b) ;(bvecp b n)
+		  (equal (bits (+ a b 1) (1- k) 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			 0))
+	     (iff (equal (bits (+ a b 1) k 0) 0)
+		  (equal (lnot (lxor0 (bits a k k) (bits b k k) 1) 1) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-n-n-rewrite)
+		  :use (stick-lemma-3-10
+			(:instance bitn-0-1 (x a) (n k))
+			(:instance bitn-0-1 (x b) (n k)))))))
+
+(local (defthm stick-lemma-3-12
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b) ;(bvecp b n)
+		  (equal (bits (+ a b 1) (1- k) 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			 0))
+	     (iff (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lnot (lxor0 a b n) n) k k) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bits-lnot lnot-logxor bitn-lnot ;BOZO these should be enabled?
+                                     bits-logxor lnot-bvecp bitn-logxor)
+		  :use (stick-lemma-3-11)))))
+
+(local (defthm stick-lemma-3-13
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b);(bvecp b n)
+		  (equal (bits (+ a b 1) (1- k) 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			 0))
+	     (iff (equal (bits (+ a b 1) k 0) 0)
+		  (equal (bits (lnot (lxor0 a b n) n) k 0) 0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-logxor bitn-lnot bits-n-n-rewrite bits-lnot
+                                     bits-logxor lnot-bvecp)
+		  :use (stick-lemma-3-12
+			(:instance bits-0-bitn-0
+				   (x (lnot (lxor0 a b n) n))
+				   (n k)))))))
+
+(local (defthm stick-lemma-3-14
+    (implies (and (natp n)
+		  (natp k)
+		  (< k n)
+		  (< 0 k)
+		  (integerp a);(bvecp a n)
+		  (integerp b) ;(bvecp b n)
+		  (iff (equal (bits (+ a b 1) (1- k) 0)
+			      0)
+		       (equal (bits (lnot (lxor0 a b n) n) (1- k) 0)
+			      0)))
+	     (iff (equal (bits (+ a b 1) k 0)
+			 0)
+		  (equal (bits (lnot (lxor0 a b n) n) k 0)
+			 0)))
+  :rule-classes ()
+  :hints (("Goal" :use (stick-lemma-3-5
+			stick-lemma-3-13)))))
+
+(defthm top-thm-1-original
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a) ;(bvecp a n)
+                (integerp b) ;(bvecp b n)
+                )
+           (equal (equal (bits (+ a b 1) k 0)
+                         0)
+                  (equal (bits (lnot (lxor0 a b n) n) k 0)
+                         0)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable bitn-logxor)
+           :induct (natp-induct k))
+	  ("Subgoal *1/2" :use stick-lemma-3-14)
+	  ("Subgoal *1/1" :use stick-lemma-3-4)))
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/stick.lisp acl2-6.3/books/rtl/rel9/support/support/stick.lisp
--- acl2-6.2/books/rtl/rel9/support/support/stick.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/stick.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,83 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "rtl")
+(local (include-book "stick-proofs"))
+
+(set-inhibit-warnings "theory") ; avoid warning in the next event
+(local (in-theory nil))
+;(set-inhibit-warnings) ; restore theory warnings (optional)
+
+
+(defthm top-thm-1-original
+  (implies (and (natp n)
+                (natp k)
+                (< k n)
+                (integerp a) ;(bvecp a n)
+                (integerp b) ;(bvecp b n)
+                )
+           (equal (equal (bits (+ a b 1) k 0)
+                         0)
+		  (equal (bits (lnot (lxor0 a b n) n) k 0)
+                         0)))
+  :rule-classes ())
+
+(defund sigm-0 (a b c n)
+  (if (= c 0)
+      (lnot (lxor0 a b n) n)
+    (lxor0 a b n)))
+
+(defund kap-0 (a b c n)
+  (if (= c 0)
+      (* 2 (lior0 a b n))
+    (* 2 (land0 a b n))))
+
+(defund tau-0 (a b c n)
+  (lnot (lxor0 (sigm-0 a b c n) (kap-0 a b c n) (1+ n)) (1+ n)))
+
+(defthm bvecp-sigm-0
+  (bvecp (sigm-0 a b c n) n)
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((sigm-0 a b c n)))))
+
+(defthm bvecp-kap-0
+  (implies (and (integerp n) (<= 0 n))
+           (bvecp (kap-0 a b c n) (1+ n)))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((kap-0 a b c n)))))
+
+(defthm bvecp-tau-0
+  (bvecp (tau-0 a b c n) (1+ n))
+  :rule-classes (:rewrite (:forward-chaining :trigger-terms ((tau-0 a b c n)))))
+
+(defthm top-thm-2-old
+  (implies (and (natp n)
+                (integerp a) ;(bvecp a n)
+                (integerp b) ;(bvecp b n)
+                (natp k)
+                (< k n)
+                (or (equal c 0) (equal c 1)))
+           (equal (equal (bits (+ a b c) k 0) 0)
+		  (equal (bits (tau-0 a b c n) k 0) 0)))
+  :rule-classes ())
diff -Nru acl2-6.2/books/rtl/rel9/support/support/sticky-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/sticky-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/sticky-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/sticky-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1221 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;an acl2 library of floating point arithmetic
+;;;david m. russinoff
+;;;advanced micro devices, inc.
+;;;february, 1998
+;;;***************************************************************
+
+(in-package "ACL2")
+
+(local (include-book "../../arithmetic/arith"))
+(local (include-book "float"))
+(local (include-book "trunc"))
+(local (include-book "away"))
+(local (include-book "near"))
+(local (include-book "near+"))
+
+;; Necessary functions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+;;
+;; New stuff:
+;;
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defthm sticky-1
+  (implies (rationalp x)
+           (equal (sticky x 1)
+                  (* (sgn x) (expt 2 (expo x)))))
+  :hints (("goal" :in-theory (enable sticky)
+           :use ((:instance only-0-is-0-or-negative-exact (n 0))
+                        (:instance trunc-to-0-or-fewer-bits (n 0))))))
+
+;more rule-classes?
+(defthm sticky-pos
+    (implies (and (< 0 x) (rationalp x)
+		  (integerp n) (> n 0))
+	     (< 0 (sticky x n)))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (enable sticky)
+		  :use ((:instance trunc-to-0-or-fewer-bits (n 0))
+                        ))))
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky a15)
+		  :use (;(:instance expt-pos (x k))
+			(:instance sig-expo-shift (n k))
+			(:instance expt-split (r 2) (i k) (j (expo x)))
+			(:instance trunc-shift (n  (1- n)))
+			(:instance exactp-shift (n (1- n)) (k k))
+			(:instance exactp-shift (n (1- n)) (k (- k)) (x (* x (expt 2 k))))))))
+
+;BOZO why isn't a5 firing here? if i comment out the (integerp n) hyp but leave the rational hyp?
+(defthm sticky-minus
+  (equal (sticky (* -1 x) n)
+         (* -1 (sticky x n)))
+  :hints (("goal" :in-theory (e/d (sgn sticky) (TRUNC-NEGATIVE-RATIONAL-TYPE-PRESCRIPTION ;prevents bad-ass problem
+                                                )))))
+
+;; Fri Oct 13 13:35:15 2006
+;; (i-am-here)
+
+(encapsulate () 
+  (local 
+   (defthm sticky-exactp-support
+     (implies (and (rationalp x) (>= x 0)
+                   (integerp n) (> n 0)
+                   )
+              (exactp (sticky x n) n))
+     :rule-classes ()
+     :hints (("goal" :in-theory (set-difference-theories
+                                 (enable sticky exactp-<= exactp-2**n)
+                                 '( trunc-exactp-a
+                                    ))
+              :use ((:instance fp+1 (x (trunc x (1- n))))
+                    (:instance trunc-exactp-a (n  (1- n)))
+                    (:instance expo-trunc (n (1- n)))
+                    )
+              )
+             )))
+
+  (defthm sticky-exactp
+    (implies (and (rationalp x) ;; (>= x 0)
+                  (integerp n) (> n 0)
+                  )
+              (exactp (sticky x n) n))
+     :rule-classes ()
+     :hints (("Goal" :cases ((not (>= x 0))))
+             ("Subgoal 2" :by sticky-exactp-support)
+             ("Subgoal 1" :in-theory (enable sticky exactp-minus)
+              :use ((:instance sticky-exactp-support
+                               (x (* -1 x))))))))
+              
+
+
+(encapsulate () 
+
+  (local 
+   (defthm sticky-exactp-n-1-support
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (iff (exactp (sticky x n) (1- n))
+		  (exactp x (1- n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable sticky)
+                              '( trunc-exactp-a))
+		  :use ((:instance trunc-exactp-a (n  (1- n)))
+			(:instance expo-trunc (n (1- n)))
+			(:instance expt-strong-monotone 
+				   (n (1+ (- (expo x) n)))
+				   (m (+ 2 (- (expo x) n))))
+;			(:instance trunc-pos (n (1- n)))
+;			(:instance expt-pos (x (1+ (- (expo x) n))))
+			(:instance fp+2
+				   (y (sticky x n))
+				   (n (1- n))
+				   (x (trunc x (1- n))))
+                        )))))
+
+  (defthm sticky-exactp-n-1
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 1))
+	     (iff (exactp (sticky x n) (1- n))
+		  (exactp x (1- n))))
+  :rule-classes ()
+  :hints (("Goal" :cases ((not (> x 0))))
+          ("Subgoal 2" :by sticky-exactp-n-1-support)
+          ("Subgoal 1" :in-theory (enable sticky exactp-minus)
+           :use ((:instance sticky-exactp-n-1-support
+                            (x (* -1 x))))))))
+
+  
+
+(local (defthm expo-sticky-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (<= (expt 2 (expo x))
+		 (sticky x n)))
+  :rule-classes ()
+  :hints (("goal" 
+           :in-theory (enable sticky)
+           :use ((:instance expo-trunc (n (1- n)))
+			(:instance expo-lower-bound (x (trunc x (1- n))))
+;			(:instance trunc-pos (n (1- n)))
+			(:instance trunc-upper-pos (n (1- n)))
+;			(:instance expt-pos (x (1+ (- (expo x) n))))
+                        )))))
+
+(local (defthm expo-sticky-2
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (<= (+ (trunc x (1- n))
+		    (expt 2 (+ 2 (- (expo x) n))))
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable trunc-exactp-a abs-trunc)
+		  :use ((:instance trunc-exactp-a (n  (1- n)))
+			(:instance expo-trunc (n (1- n)))
+			(:instance exactp-2**n (n (1+ (expo x))) (m (1- n)))
+			(:instance expo-upper-bound (x (trunc x (1- n))))
+			(:instance expo-upper-bound)
+;			(:instance trunc-pos (n (1- n)))
+;			(:instance expt-pos (x (1+ (- (expo x) n))))
+			(:instance fp+2
+				   (y (expt 2 (1+ (expo x))))
+				   (n (1- n))
+				   (x (trunc x (1- n)))))))))
+
+(local (defthm expo-sticky-3
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (< (sticky x n)
+		(expt 2 (1+ (expo x)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable sticky)
+                              '(trunc-exactp-a))
+		  :use ((:instance expo-sticky-2)
+			(:instance expo-upper-bound)
+			(:instance expt-strong-monotone 
+				   (n (1+ (- (expo x) n)))
+				   (m (+ 2 (- (expo x) n)))))))))
+
+(local (defthm expo-sticky-4
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ()
+  :hints (("goal" :use (expo-sticky-1
+			expo-sticky-3
+			sticky-pos
+			(:instance expo-unique (x (sticky x n)) (n (expo x))))))))
+
+
+(encapsulate () 
+  (local 
+   (defthm expo-sticky-support
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ()
+  :hints (("goal" :use (expo-sticky-4
+			expo-upper-bound
+			expo-lower-bound
+			(:instance trunc-to-0-or-fewer-bits (n 0))
+                        (:instance expo-unique (x (expt 2 (expo x))) (n (expo
+                                                                         x))))))))
+
+
+   (defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ()  
+  :hints (("Goal" :cases ((not (> x 0))))
+          ("Subgoal 2" :by expo-sticky-support)
+          ("Subgoal 1" :in-theory (enable sticky expo-minus)
+           :use ((:instance expo-sticky-support
+                            (x (* -1 x))))))))
+
+
+
+(local (defthm trunc-sticky-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (trunc (sticky x n) (1- n))
+		(trunc x (1- n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky)
+           :use (sticky-exactp
+			expo-sticky
+			sticky-exactp-n-1
+			sticky-pos
+;			(:instance trunc-trunc (n (1- n)) (m (1- n)))
+			(:instance trunc-away-a (x (sticky x n)) (n (1- n))))))))
+
+(encapsulate () 
+   (local   
+    (defthm trunc-sticky-support
+      (implies (and (rationalp x) (> x 0)
+                    (integerp m) (> m 0)
+                    (integerp n) (> n m))
+               (= (trunc (sticky x n) m)
+                  (trunc x m)))
+      :rule-classes ()
+      :hints (("goal" :in-theory (disable sticky trunc-trunc)
+               :use (trunc-sticky-1
+                     sticky-pos
+                     (:instance trunc-trunc (n (1- n)))
+                     (:instance trunc-trunc (n (1- n)) (x (sticky x n)))
+                     )))))
+
+  (defthm trunc-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+                  (integerp m) (> m 0)
+                  (integerp n) (> n m))
+             (= (trunc (sticky x n) m)
+                (trunc x m)))
+    :rule-classes ()
+    :hints (("Goal" :cases ((not (> x 0))))
+            ("Subgoal 2" :by trunc-sticky-support)
+            ("Subgoal 1" :in-theory (enable sticky)
+             :use ((:instance trunc-sticky-support
+                              (x (* -1 x))))))))
+
+
+
+(local (defthm away-sticky-1
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (exactp x (1- n))))
+	     (= (away (sticky x n) (1- n))
+		(+ (trunc x (1- n))
+		   (expt 2 (+ (expo x) 2 (- n))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky)
+           :use (sticky-exactp
+			expo-sticky
+			sticky-exactp-n-1
+			sticky-pos
+			(:instance expt-split (r 2) (i (1+ (- (expo x) n))) (j 1))
+			(:instance trunc-away-b (x (sticky x n)) (n (1- n))))))))
+
+(local (defthm away-sticky-2
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (exactp x (1- n))))
+	     (<= (+ (trunc x (1- n))
+		    (expt 2 (+ (expo x) 2 (- n))))
+		 (away x (1- n))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance fp+2 (x (trunc x (1- n))) (n (1- n)) (y (away x (1- n))))
+			(:instance away-exactp-a (n (1- n)))
+			(:instance trunc-exactp-a (n (1- n)))
+			(:instance trunc-exactp-b (n (1- n)))
+;			(:instance trunc-pos (n (1- n)))
+			(:instance trunc-upper-pos (n (1- n)))
+			(:instance away-lower-pos (n (1- n))))))))
+
+(local (defthm away-sticky-3
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1)
+		  (not (exactp x (1- n))))
+	     (>= (+ (trunc x (1- n))
+		    (expt 2 (+ (expo x) 2 (- n))))
+		 (away x (1- n))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance fp+1 (x (trunc x (1- n))) (n (1- n)))
+			(:instance trunc-exactp-a (n (1- n)))
+;			(:instance trunc-pos (n (1- n)))
+			(:instance trunc-diff-pos (n (1- n)))
+			(:instance away-exactp-c 
+				   (n (1- n)) 
+				   (a (+ (trunc x (1- n))
+					 (expt 2 (+ (expo x) 2 (- n)))))))))))
+
+(local (defthm away-sticky-4
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 1))
+	     (= (away (sticky x n) (1- n))
+		(away x (1- n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky)
+           :use (away-sticky-1
+			away-sticky-2
+			away-sticky-3)))))
+
+(encapsulate ()
+   (local              
+    (defthm away-sticky-support
+    (implies (and (rationalp x) (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable sticky)
+		  :use (away-sticky-4
+			sticky-pos
+			(:instance away-away (n (1- n)))
+			(:instance away-away (n (1- n)) (x (sticky x n))))))))
+   
+  (defthm away-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ()
+  :hints (("Goal" :cases ((not (> x 0))))
+          ("Subgoal 2" :by away-sticky-support)
+          ("Subgoal 1" :in-theory (enable sticky)
+           :use ((:instance away-sticky-support
+                            (x (* -1 x))))))))
+
+
+(local (defthm near-sticky-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (<= x y)
+		  (integerp m)
+		  (> m 0)
+		  (= (trunc x (1+ m)) (trunc y (1+ m)))
+		  (not (= (near x m) (near y m))))
+	     (= x (near-witness x y m)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-near-lemma (n m))
+			(:instance trunc-upper-pos (n (1+ m)))
+			(:instance trunc-exactp-c (x y) (n (1+ m)) (a (near-witness x y m))))))))
+
+(local (defthm near-sticky-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (<= x y)
+		  (integerp m)
+		  (> m 0)
+		  (= (away x (1+ m)) (away y (1+ m)))
+		  (not (= (near x m) (near y m))))
+	     (= y (near-witness x y m)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable away-exactp-c)
+		  :use ((:instance near-near-lemma (n m))
+			(:instance away-lower-pos (x y) (n (1+ m)))
+			(:instance away-exactp-c (n (1+ m)) (a (near-witness x y m))))))))
+
+(local (defthm near-sticky-3
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< 0 y)
+		  (integerp m)
+		  (> m 0)
+		  (= (trunc x (1+ m)) (trunc y (1+ m)))
+		  (= (away x (1+ m)) (away y (1+ m))))
+	     (= (near x m) (near y m)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near-sticky-1 (x y) (y x))
+			(:instance near-sticky-2 (x y) (y x))
+			(:instance near-sticky-1)
+			(:instance near-sticky-2))))))
+
+
+(encapsulate () 
+  (local 
+   (defthm near-sticky-support
+    (implies (and (rationalp x) (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable sticky)
+		  :use ((:instance near-sticky-3 (y (sticky x n)))
+			(:instance trunc-sticky (m (1+ m)))
+			(:instance away-sticky (m (1+ m)))
+			sticky-pos)))))
+
+  
+   (defthm near-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ()
+  :hints (("Goal" :cases ((not (> x 0))))
+          ("Subgoal 2" :by near-sticky-support)
+          ("Subgoal 1" :in-theory (enable sticky near-minus)
+           :use ((:instance near-sticky-support
+                            (x (* -1 x))))))))
+
+
+
+(local (defthm near+-sticky-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (<= x y)
+		  (integerp m)
+		  (> m 0)
+		  (= (trunc x (1+ m)) (trunc y (1+ m)))
+		  (not (= (near+ x m) (near+ y m))))
+	     (= x (near+-witness x y m)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-near+-lemma (n m))
+			(:instance trunc-upper-pos (n (1+ m)))
+			(:instance trunc-exactp-c (x y) (n (1+ m)) (a (near+-witness x y m))))))))
+
+(local (defthm near+-sticky-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (<= x y)
+		  (integerp m)
+		  (> m 0)
+		  (= (away x (1+ m)) (away y (1+ m)))
+		  (not (= (near+ x m) (near+ y m))))
+	     (= y (near+-witness x y m)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable away-exactp-c)
+		  :use ((:instance near+-near+-lemma (n m))
+			(:instance away-lower-pos (x y) (n (1+ m)))
+			(:instance away-exactp-c (n (1+ m)) (a (near+-witness x y m))))))))
+
+(local (defthm near+-sticky-3
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (< 0 x)
+		  (< 0 y)
+		  (integerp m)
+		  (> m 0)
+		  (= (trunc x (1+ m)) (trunc y (1+ m)))
+		  (= (away x (1+ m)) (away y (1+ m))))
+	     (= (near+ x m) (near+ y m)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance near+-sticky-1 (x y) (y x))
+			(:instance near+-sticky-2 (x y) (y x))
+			(:instance near+-sticky-1)
+			(:instance near+-sticky-2))))))
+
+
+(encapsulate () 
+  (local 
+   (defthm near+-sticky-support
+    (implies (and (rationalp x) (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable sticky)
+		  :use ((:instance near+-sticky-3 (y (sticky x n)))
+			(:instance trunc-sticky (m (1+ m)))
+			(:instance away-sticky (m (1+ m)))
+			sticky-pos)))))
+
+
+  
+   (defthm near+-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ()
+  :hints (("Goal" :cases ((not (> x 0))))
+          ("Subgoal 2" :by near+-sticky-support)
+          ("Subgoal 1" :in-theory (enable sticky near+-minus)
+           :use ((:instance near+-sticky-support
+                            (x (* -1 x))))))))
+
+
+
+(local (defthm minus-trunc-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (> k 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (* (- (* x (expt 2 (- (1- k) (expo y))))
+			  (fl (* y (expt 2 (- (1- k) (expo y))))))
+		       (expt 2 (- (1+ (expo y)) k)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable trunc-rewrite)
+           :use ((:instance expt-split (r 2) (i (- (1- k) (expo y))) (j (- (1+ (expo y)) k))))))))
+
+(local (defthm minus-trunc-2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (> k 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (* (- (fl (* (- y x) (expt 2 (- (1- k) (expo y))))))
+		       (expt 2 (- (1+ (expo y)) k)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable fl+int-rewrite expo trunc-rewrite)
+		  :use ((:instance minus-trunc-1)
+			exactp2
+			(:instance fl+int-rewrite 
+				   (x (* y (expt 2 (- (1- k) (expo y)))))
+				   (n (- (* x (expt 2 (- (1- k) (expo y))))))))))))
+
+(local (defthm minus-trunc-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (> k 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (* (cg (* (- x y) (expt 2 (- (1- k) (expo y)))))
+		       (expt 2 (- (1+ (expo y)) k)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable cg)
+		  :use ((:instance minus-trunc-2))))))
+
+(defthm minus-trunc-4
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< y x)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable away-rewrite)
+           :use ((:instance minus-trunc-3)))))
+
+(defthm minus-trunc-5
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable trunc-rewrite)
+                              '( expo-minus))
+           :use ((:instance minus-trunc-2)
+                 (:instance expo-minus (x (- x y)))))))
+
+(local (defthm sticky-plus-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (iff (exactp y (1- k))
+		  (exactp (+ x y) (1- k2))))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance exactp2 (n (1- k1)))
+			(:instance exactp2 (x y) (n (1- k)))
+			(:instance exactp2 (x (+ x y)) (n (1- k2))))))))
+
+(local (defthm sticky-plus-2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (exactp y (1- k))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky)
+           :use ((:instance sticky-plus-1))))))
+
+(local (defthm sticky-plus-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (not (exactp y (1- k)))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky)
+           :use (sticky-plus-1
+			(:instance plus-trunc (k (1- k))))))))
+
+
+(defthm sticky-plus-original
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ()
+  :hints (("goal" :use (sticky-plus-2 sticky-plus-3))))
+
+
+
+
+
+
+
+
+(local (defthm hack1
+    (implies (and (integerp x)
+		  (integerp y))
+	     (integerp (- x y)))
+  :rule-classes ()))
+
+(local (defthm shack2
+    (implies (and (rationalp x) (rationalp y))
+	     (equal (+ x (* -1 (+ x (* -1 y))))
+		    y))
+  :rule-classes ()))
+
+(local (defthm shack3
+    (implies (and (integerp x)
+		  (rationalp y)
+		  (integerp (- x y)))
+	     (integerp y))
+  :rule-classes ()
+  :hints (("goal" :use (shack2 (:instance hack1 (y (- x y))))))))
+
+(local (defthm minus-sticky-1
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (iff (exactp y (1- k))
+		  (exactp (- x y) (1- k2))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable exactp2)
+		  :use ((:instance expo-minus (x y))
+			(:instance shack3
+				   (x (* x (expt 2 (+ -2 k (* -1 (expo (* -1 y)))))))
+				   (y (* y (expt 2 (+ -2 k (* -1 (expo (* -1 y)))))))))))))
+
+(local (defthm minus-sticky-2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (exactp y (1- k))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (- x (sticky y k))
+		(sticky (- x y) k2)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky)
+           :use ((:instance minus-sticky-1))))))
+
+(local (defthm minus-sticky-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (not (exactp y (1- k)))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (- x (sticky y k))
+		(- (sticky (- y x) k2))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable exactp2 sticky trunc-rewrite a15)
+                              '(expo-minus))
+		  :use ((:instance minus-sticky-1)
+			(:instance expo-minus (x (- x y)))
+			(:instance minus-trunc-5 (n (+ k (- (expo x) (expo y)))) (k (1- k))))))))
+
+(local (defthm minus-sticky-4
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< y x)
+		  (not (exactp y (1- k)))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (- x (sticky y k))
+		(- (away (- x y) (1- k2))
+		   (expt 2 (1+ (- (expo (- x y)) k2))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky)
+           :use ((:instance minus-sticky-1)
+			(:instance minus-trunc-4 (n (+ -1 k (- (expo x) (expo y)))) (k (1- k))))))))
+
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ()
+  :hints (("goal" :use ((:instance away-sticky-2 (n (1+ n)))
+			(:instance away-sticky-3 (n (1+ n)))))))
+
+(local (defthm minus-sticky-5
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< y x)
+		  (not (exactp y (1- k)))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (- x (sticky y k))
+		(sticky (- x y) k2)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable sticky)
+           :use ((:instance minus-sticky-4)
+			(:instance minus-sticky-1)
+			(:instance trunc-away (x (- x y)) (n (1- k2)))
+			(:instance expt-split (r 2) (i (1+ (- (expo (- x y)) k2))) (j 1)))))))
+
+
+
+
+(local (defthm minus-sticky-6
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (not (= y x))
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (- x (sticky y k))
+		(sticky (- x y) k2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable sticky sticky-minus)
+		  :use ((:instance minus-sticky-2)
+			(:instance minus-sticky-3)
+			(:instance sticky-minus (x (- x y)) (n k2))
+			(:instance minus-sticky-5))))))
+
+(defthm sticky-0
+  (equal (sticky 0 n) 0)
+  :hints (("Goal" :in-theory (enable sticky trunc))))
+
+(local (defthm minus-sticky-7
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k2 1)
+		  (exactp x (1- k)))
+	     (= (- x (sticky x k))
+		(sticky 0 k2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky)
+          :use ((:instance sticky-0 (n k2)))))))
+
+(defthm minus-sticky
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (- x (sticky y k))
+		(sticky (- x y) k2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable sticky)
+		  :use ((:instance minus-sticky-7)
+			(:instance minus-sticky-6)))))
+
+(local (defthm sticky-lemma-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (< y 0)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable sticky)
+		  :use ((:instance minus-sticky (y (- y)))
+			(:instance expo-minus (x y))
+			(:instance sticky-minus (x y) (n k)))))))
+
+(local (defthm sticky-lemma-2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (= y 0)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky)
+           :use ((:instance sticky-0 (n k)))))))
+
+
+(defthm STICKY-LEMMA
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ()
+  :hints (("Goal" :use (sticky-plus-original sticky-lemma-1 sticky-lemma-2 
+                                    (:instance
+                                     trunc-0
+                                     (n (+ -1 K (* -1 (EXPO Y)))))))))
+
+
+;from add3
+(local 
+ (defthm sticky-sticky-1
+   (implies (and (rationalp x)
+;                 (> x 0)
+                 (integerp m)
+                 (> m 1)
+                 (integerp n)
+                 (>= n m)
+                 (exactp x (1- n)))
+            (= (sticky (sticky x n) m)
+               (sticky x m)))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance sticky))))))
+
+(local 
+ (defthm sticky-sticky-2
+   (implies (and (rationalp x)
+;                 (> x 0)
+                 (integerp m)
+                 (> m 1)
+                 (integerp n)
+                 (>= n m)
+                 (not (exactp x (1- n))))
+            (not (exactp x (1- m))))
+   :rule-classes ()
+   :hints (("goal" :use ((:instance exactp-<= (m (1- m)) (n (1- n))))))))
+
+(local
+ (defthm sticky-sticky-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m)
+		  (not (exactp x (1- n))))
+	     (not (exactp (sticky x n) (1- m))))
+  :rule-classes ()
+  :hints (("goal" :use (sticky-exactp-n-1
+			(:instance exactp-<= (x (sticky x n)) (m (1- m)) (n (1- n))))))))
+
+(local
+ (defthm sticky-sticky-4
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp m)
+                 (> m 1)
+                 (integerp n)
+                 (>= n m)
+                 (not (exactp x (1- n))))
+            (= (sticky (sticky x n) m)
+               (+ (trunc (sticky x n) (1- m))
+                  (expt 2 (1+ (- (expo x) m))))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable sgn)
+            :use (expo-sticky
+                  sticky-pos
+                  sticky-sticky-3
+                  (:instance sticky (x (sticky x n)) (n m)))))))
+
+(local
+ (defthm sticky-sticky-5
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp m)
+                 (> m 1)
+                 (integerp n)
+                 (>= n m)
+                 (not (exactp x (1- n))))
+            (= (sticky (sticky x n) m)
+               (+ (trunc x (1- m))
+                  (expt 2 (1+ (- (expo x) m))))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable sgn)
+            :use (sticky-sticky-4
+                  (:instance trunc-sticky (m (1- m))))))))
+
+(local
+ (defthm sticky-sticky-6
+   (implies (and (rationalp x)
+                 (> x 0)
+                 (integerp m)
+                 (> m 1)
+                 (integerp n)
+                 (>= n m)
+                 (not (exactp x (1- n))))
+            (= (sticky (sticky x n) m)
+               (sticky x m)))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable sgn)
+            :use (sticky-sticky-5
+                  sticky-sticky-2
+                  (:instance trunc-0 (n (+ -1 m)))
+                  (:instance sticky (n m)))))))
+
+(local
+ (defthm sticky-sticky-old
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp m)
+		  (> m 1)
+		  (integerp n)
+		  (>= n m))
+	     (= (sticky (sticky x n) m)
+		(sticky x m)))
+  :rule-classes ()
+  :hints (("goal" :use (sticky-sticky-6
+			sticky-sticky-1)))))
+
+(defthm sticky-sticky
+  (implies (and (rationalp x)
+                (integerp m)
+                (> m 1)
+                (integerp n)
+                (>= n m))
+           (= (sticky (sticky x n) m)
+              (sticky x m)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable sticky)
+           :use ((:instance sticky-sticky-old)
+                 (:instance sticky-sticky-old (x (- x)))))))
+
+(local (defthm sticky-exactp-m-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-minus)
+                  :use (sticky-exactp-n-1
+			sticky
+			(:instance exactp-<= (n (1- n)))
+			(:instance exactp-<= (n (1- n)) (x (sticky x n))))))))
+
+;;One for the library:
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable sticky-minus)
+                  :use (sticky-exactp-m-1
+                        (:instance sticky-exactp-m-1 (x (- x)))
+;                        (:instance exactp- (n m))
+ ;                       (:instance exactp- (x (- x)) (n m))
+  ;                      (:instance exactp- (x (sticky x n)) (n m))
+   ;                     (:instance exactp- (x (- (sticky x n))) (n m))
+                        ))))
+
+          
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/sticky.lisp acl2-6.3/books/rtl/rel9/support/support/sticky.lisp
--- acl2-6.2/books/rtl/rel9/support/support/sticky.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/sticky.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,322 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;;***************************************************************
+;;;an acl2 library of floating point arithmetic
+;;;david m. russinoff
+;;;advanced micro devices, inc.
+;;;february, 1998
+;;;***************************************************************
+
+(local (include-book "sticky-proofs"))
+
+;; Necessary functions:
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defund cg (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (- (fl (- x))))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+(defun fp+ (x n)
+  (+ x (expt 2 (- (1+ (expo x)) n))))
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund away (x n)
+  (* (sgn x) (cg (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+(defund re (x)
+  (- x (fl x)))
+
+(defund near (x n)
+  (let ((z (fl (* (expt 2 (1- n)) (sig x))))
+	(f (re (* (expt 2 (1- n)) (sig x)))))
+    (if (< f 1/2)
+	(trunc x n)
+      (if (> f 1/2)
+	  (away x n)
+	(if (evenp z)
+	    (trunc x n)
+	  (away x n))))))
+
+(defund near+ (x n)
+  (if (< (re (* (expt 2 (1- n)) (sig x)))
+	 1/2)
+      (trunc x n)
+    (away x n)))
+
+
+;;
+;; New stuff:
+;;
+
+
+(defund sticky (x n)
+  (cond ((exactp x (1- n)) x)
+	(t (+ (trunc x (1- n))
+              (* (sgn x) (expt 2 (1+ (- (expo x) n))))))))
+
+(defthm sticky-1
+  (implies (rationalp x)
+           (equal (sticky x 1)
+                  (* (sgn x) (expt 2 (expo x))))))
+
+;more rule-classes?
+(defthm sticky-pos
+    (implies (and (< 0 x)
+                  (rationalp x)
+		  (integerp n) (> n 0))
+	     (< 0 (sticky x n)))
+  :rule-classes :linear)
+
+(defthm sticky-shift
+    (implies (and (rationalp x)
+		  (integerp n) (> n 0)
+		  (integerp k))
+	     (= (sticky (* (expt 2 k) x) n)
+		(* (expt 2 k) (sticky x n))))		
+  :rule-classes ())
+
+(defthm sticky-minus
+  (equal (sticky (* -1 x) n)
+         (* -1 (sticky x n))))
+
+;gen?
+(defthm sticky-exactp
+  (implies (and (rationalp x) ;; (>= x 0)
+                (integerp n) (> n 0)
+                )
+           (exactp (sticky x n) n))
+  :rule-classes ())
+
+(defthm sticky-exactp-n-1
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 1))
+	     (iff (exactp (sticky x n) (1- n))
+		  (exactp x (1- n))))
+  :rule-classes ())
+
+(defthm expo-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp n) (> n 0))
+	     (= (expo (sticky x n))
+		(expo x)))
+  :rule-classes ())
+
+(defthm trunc-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (trunc (sticky x n) m)
+		(trunc x m)))
+  :rule-classes ())
+
+(defthm away-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n m))
+	     (= (away (sticky x n) m)
+		(away x m)))
+  :rule-classes ())
+
+(defthm near-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near (sticky x n) m)
+		(near x m)))
+  :rule-classes ())
+
+(defthm near+-sticky
+    (implies (and (rationalp x) ;; (> x 0)
+		  (integerp m) (> m 0)
+		  (integerp n) (> n (1+ m)))
+	     (= (near+ (sticky x n) m)
+		(near+ x m)))
+  :rule-classes ())
+
+;make local?
+(defthm minus-trunc-4
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< y x)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (away (- x y) (+ k (- (expo (- x y)) (expo y))))))
+  :rule-classes ())
+
+;make local?
+(defthm minus-trunc-5
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (< x y)
+		  (integerp k)
+		  (> k 0)
+		  (> (+ k (- (expo (- x y)) (expo y))) 0)
+		  (= n (+ k (- (expo x) (expo y))))
+		  (exactp x n))
+	     (equal (- x (trunc y k))
+		    (- (trunc (- y x) (+ k (- (expo (- x y)) (expo y)))))))
+  :rule-classes ())
+
+
+(defthm sticky-plus-original ;; Fri Oct 13 14:39:49 2006
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (+ x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (+ x (sticky y k))
+		(sticky (+ x y) k2)))
+  :rule-classes ())
+
+
+
+;BOZO move?
+(defthm trunc-away
+    (implies (and (rationalp x) (> x 0)
+		  (integerp n) (> n 0)
+		  (not (exactp x n)))
+	     (= (away x n)
+		(+ (trunc x n)
+		   (expt 2 (+ (expo x) 1 (- n))))))		
+  :rule-classes ())
+
+(defthm sticky-0
+  (equal (sticky 0 n) 
+         0))
+
+(defthm minus-sticky
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp k)
+		  (= k1 (+ k (- (expo x) (expo y))))
+		  (= k2 (+ k (- (expo (- x y)) (expo y))))
+		  (> k 1)
+		  (> k1 1)
+		  (> k2 1)
+		  (exactp x (1- k1)))
+	     (= (- x (sticky y k))
+		(sticky (- x y) k2)))
+  :rule-classes ())
+
+(defthm sticky-lemma
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (integerp k)
+                (= k1 (+ k (- (expo x) (expo y))))
+                (= k2 (+ k (- (expo (+ x y)) (expo y))))
+                (> k 1)
+                (> k1 1)
+                (> k2 1)
+                (exactp x (1- k1)))
+           (= (+ x (sticky y k))
+              (sticky (+ x y) k2)))
+  :rule-classes ())
+
+(defthm sticky-sticky
+  (implies (and (rationalp x)
+                (integerp m)
+                (> m 1)
+                (integerp n)
+                (>= n m))
+           (= (sticky (sticky x n) m)
+              (sticky x m)))
+  :rule-classes ())
+
+(defthm sticky-exactp-m
+    (implies (and (rationalp x)
+		  (integerp m)
+		  (integerp n) 
+		  (> n m)
+		  (> m 0))
+	     (iff (exactp (sticky x n) m)
+		  (exactp x m)))
+  :rule-classes ())
+
+          
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/sumbits.lisp acl2-6.3/books/rtl/rel9/support/support/sumbits.lisp
--- acl2-6.2/books/rtl/rel9/support/support/sumbits.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/sumbits.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,87 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "bitn")
+(include-book "bits")
+
+(defun sumbits (x n)
+  (if (zp n)
+      0
+    (+ (* (expt 2 (1- n)) (bitn x (1- n)))
+       (sumbits x (1- n)))))
+
+(defthmd sumbits-bits
+  (implies (and (natp x)
+                (natp n)
+                (> n 0))
+           (equal (sumbits x n)
+                  (bits x (1- n) 0)))
+  :hints (("Goal" :in-theory (enable bits-n-n-rewrite) ;yuck?
+           :induct (sumbits x n))
+          ("Subgoal *1/2" :use ((:instance bitn-plus-bits (n (1- n)) (m 0))))))
+
+(defthmd sumbits-thm
+     (implies (and (bvecp x n)
+                   (natp n)
+                   (> n 0))
+              (equal (sumbits x n)
+                     x))
+   :hints (("Goal" :in-theory (enable sumbits-bits bvecp))))
+
+(defun sumbits-badguy (x y k)
+  (if (zp k)
+      0 ; arbitrary
+    (if (not (equal (bitn x (1- k)) (bitn y (1- k))))
+        (1- k)
+      (sumbits-badguy x y (1- k)))))
+
+(local
+ (defthm sumbits-badguy-is-correct-lemma
+   (implies (equal (bitn x (sumbits-badguy x y k))
+                   (bitn y (sumbits-badguy x y k)))
+            (equal (sumbits x k)
+                   (sumbits y k)))
+   :rule-classes nil))
+
+(defthmd sumbits-badguy-is-correct
+  (implies (and (bvecp x k)
+                (bvecp y k)
+                (equal (bitn x (sumbits-badguy x y k))
+                       (bitn y (sumbits-badguy x y k)))
+                (integerp k)
+                (< 0 k))
+           (equal (equal x y) t))
+  :hints (("Goal"
+           :use sumbits-badguy-is-correct-lemma
+           :in-theory (enable sumbits-thm))))
+
+(defthmd sumbits-badguy-bounds
+  (implies (and (integerp k)
+                (< 0 k))
+           (let ((badguy (sumbits-badguy x y k)))
+             (and (integerp badguy)
+                  (<= 0 badguy)
+                  (< badguy k)))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/top.lisp acl2-6.3/books/rtl/rel9/support/support/top.lisp
--- acl2-6.2/books/rtl/rel9/support/support/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/top.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,41 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(include-book "top1")
+
+(include-book "lextra")
+
+(include-book "fadd-extra")
+
+(include-book "float-extra")
+
+(include-book "round-extra")
+
+(include-book "guards")
+
+; Could probably be part of top1, but was handled later.
+(include-book "badguys")
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/top1.lisp acl2-6.3/books/rtl/rel9/support/support/top1.lisp
--- acl2-6.2/books/rtl/rel9/support/support/top1.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/top1.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1010 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+;;;***************************************************************
+;;;An ACL2 Library of Floating Point Arithmetic
+
+;;;David M. Russinoff
+;;;Advanced Micro Devices, Inc.
+;;;June, 2001
+;;;***************************************************************
+
+(in-package "ACL2")
+
+;the comments represent Eric's best guess as to how to summarize each book
+
+(include-book "util") ;includes the local-defthm macro, etc.
+(include-book "ground-zero") ;disables a bunch of functions, includes util
+(include-book "rewrite-theory") ; a little utility, which we don't use much...
+
+(include-book "rtl") ;definitions of the RTL primitives
+(include-book "rtlarr") ;RTL arrays
+(include-book "bvecp-lemmas") ;bvecp lemmas for all(?) of the RTL primitives  (what's the point of this book,
+  ;given that we have lib/bvecp-raw-helpers?)
+
+(include-book "bits")
+(include-book "bitn")
+
+(include-book "ocat")    ;soon to be removed, since I don't think we use ocat
+(include-book "cat-def") ;the definition of cat (since it's a bit complicated).
+(include-book "cat")
+(include-book "bvecp")
+(include-book "ash")
+(include-book "decode")
+(include-book "encode")
+(include-book "mulcat")
+(include-book "shft")
+(include-book "all-ones")
+(include-book "merge2")  ;includes merge
+                         ;a mix of lemmas.  eric is sorting these out into appropriate books
+                         ;but some lemmas really do mix several functions
+(include-book "logior1")
+(include-book "setbits")
+(include-book "setbitn")
+
+(include-book "float") ;theorems about floating point numbers (factorization into sgn, sig, and expo;
+;exactness)
+;Eric might want to sort these out into books call sig.lisp, exactp,list, etc.
+
+;floating-point representations:
+(include-book "bias") ;Exponent bias for floating point representations.
+(include-book "ereps") ;Floating point representations with explicit leading 1 in the mantissa.
+(include-book "ireps") ;Floating point representations with implicit leading 1 in the mantissa.
+
+;built-in logical operators:
+(include-book "logeqv")
+(include-book "logorc1")
+(include-book "lognot")
+(include-book "logand")
+(include-book "logior")
+(include-book "logxor")
+
+(include-book "log") ;theorems mixing logical operators with bits and bitn, etc.  some junk in here to sort
+  ;out?
+  ;figure out the difference between this and merge?
+
+;new logical operators:
+(include-book "lnot")
+(include-book "land0")
+(include-book "lior0")
+(include-book "lxor0")
+(include-book "lextra0")
+
+(include-book "logs") ;other "logical" operators, especially type (bvecp/natp) lemmas
+
+;floating-point rounding:
+(include-book "trunc") ;the trunc rounding-mode
+(include-book "away") ;the away rounding-mode
+(include-book "near") ;the near rounding-mode
+(include-book "near+") ;the near+ rounding-mode
+(include-book "oddr") ;the odd rounding-mode
+(include-book "sticky") ;sticky rounding
+(include-book "rnd") ;rnd (our top level rounding function), and the inf and minf rounding modes
+(include-book "drnd-original") ;rounding of denormal numbers
+
+(include-book "bits-trunc") ;theorems about how we implement trunc rounding...
+
+;theorems about circuits for addition
+(include-book "add3") ;theorems about how we implement addition of (2 or) 3 bit vectors using land0, lior0, and lxor0
+(include-book "lop1") ;leading-one prediction
+(include-book "lop2") ;leading-one prediction
+(include-book "lop3") ;leading-one prediction
+(include-book "stick") ;Some special-purpose lemmas by Russinoff, probably about sticky bit computation
+
+;helpers
+(include-book "bvecp-helpers")
+(include-book "model-helpers") ; do we use this?
+(include-book "rom-helpers")
+(include-book "simple-loop-helpers")
+;BOZO consider moving lib/simplify-model-helpers to support/ of (better yet), move all the helpers books to lib/
+
+(include-book "clocks")
+(include-book "openers")
+(include-book "package-defs")
+(include-book "simplify-model-helpers")
+
+(include-book "../../arithmetic/top")
+(include-book "../../arithmetic/fp")
+
+(include-book "fadd")
+
+; The following form evaluates to (prints out) the list of runes shown below,
+; in the environment created by starting up ACL2 and then executing
+; (include-book "../lib/top") when ../lib/top was built on top of
+; ../support/top1.
+
+#|
+; Here is the correct result, which however is more verbose than necessary.
+(let ((world (w state)))
+  (union-theories
+   ;; non-built-in rules
+   (set-difference-theories (current-theory :here)
+                            (universal-theory 'ground-zero))
+   ;; built-in rules
+   (intersection-theories (current-theory :here)
+                          (universal-theory 'ground-zero))))
+
+But note that:
+(let* ((world (w state))
+       (cgz (current-theory 'ground-zero))
+       (ugz (universal-theory 'ground-zero))
+       (here (current-theory :here)))
+  (equal (intersection-theories here ugz)
+         (union-theories (set-difference-theories
+                          cgz
+                          (set-difference-theories cgz here))
+                         (intersection-theories (set-difference-theories ugz
+                                                                         cgz)
+                                                here))))
+
+And the following are small:
+
+(let* ((world (w state))
+       (cgz (current-theory 'ground-zero))
+       (here (current-theory :here)))
+  (set-difference-theories cgz here))
+
+(let* ((world (w state))
+       (cgz (current-theory 'ground-zero))
+       (ugz (universal-theory 'ground-zero))
+       (here (current-theory :here)))
+  (intersection-theories (set-difference-theories ugz cgz)
+                         here))
+
+So the correct result is, alteratively:
+
+(let* ((world (w state))
+       (cgz (current-theory 'ground-zero))
+       (ugz (universal-theory 'ground-zero))
+       (here (current-theory :here))
+       (small1 (set-difference-theories cgz here))
+       (small2 (intersection-theories (set-difference-theories ugz cgz)
+                                      here)))
+  (union-theories
+   ;; non-built-in rules
+   (set-difference-theories (current-theory :here)
+                            (universal-theory 'ground-zero))
+   ;; built-in rules
+   (union-theories (set-difference-theories cgz small1)
+                   small2)))
+
+|# ; |
+
+; After Version_4.2, changes to defpkg eliminated the creation of rewrite rules
+; for hidden defpkgs, e.g., (:REWRITE U-PACKAGE).  We tried replacing the next
+; two forms below with more flexible forms (at least, in
+; rtl/rel4/support/top.lisp) that are more likely to survive version changes,
+; including the one just mentioned; but the theorem bits-guard failed in
+; rtl/rel4/support/guards.cert.  So we just comment out the offending rules in
+; the first deftheory below.
+
+(deftheory lib-top1-non-built-ins
+
+;(let ((world (w state)))
+;  (set-difference-theories (current-theory :here) (universal-theory 'ground-zero)))
+
+  '(
+;    (:REWRITE U-PACKAGE)
+;    (:REWRITE ACL2-ASG-PACKAGE)
+;    (:REWRITE ACL2-AGP-PACKAGE)
+;    (:REWRITE ACL2-CRG-PACKAGE)
+    (:EXECUTABLE-COUNTERPART FL)
+    (:TYPE-PRESCRIPTION FL)
+    (:EXECUTABLE-COUNTERPART BITS)
+    (:EXECUTABLE-COUNTERPART BITN)
+    (:EXECUTABLE-COUNTERPART BINARY-CAT)
+    (:DEFINITION FORMAL-+)
+    (:EXECUTABLE-COUNTERPART FORMAL-+)
+    (:TYPE-PRESCRIPTION FORMAL-+)
+    (:DEFINITION CAT-SIZE)
+    (:EXECUTABLE-COUNTERPART CAT-SIZE)
+    (:TYPE-PRESCRIPTION CAT-SIZE)
+    (:INDUCTION CAT-SIZE)
+    (:EXECUTABLE-COUNTERPART MULCAT)
+    (:EXECUTABLE-COUNTERPART LNOT)
+    (:EXECUTABLE-COUNTERPART BINARY-LAND0)
+    (:EXECUTABLE-COUNTERPART BINARY-LIOR0)
+    (:EXECUTABLE-COUNTERPART BINARY-LXOR0)
+    (:DEFINITION SETBITS)
+    (:EXECUTABLE-COUNTERPART SETBITS)
+    (:TYPE-PRESCRIPTION SETBITS)
+    (:EXECUTABLE-COUNTERPART SETBITN)
+    (:EXECUTABLE-COUNTERPART LOG=)
+    (:EXECUTABLE-COUNTERPART LOG<>)
+    (:EXECUTABLE-COUNTERPART LOG<)
+    (:EXECUTABLE-COUNTERPART LOG<=)
+    (:EXECUTABLE-COUNTERPART LOG>)
+    (:EXECUTABLE-COUNTERPART LOG>=)
+    (:EXECUTABLE-COUNTERPART COMP2)
+    (:TYPE-PRESCRIPTION COMP2)
+    (:EXECUTABLE-COUNTERPART COMP2<)
+    (:TYPE-PRESCRIPTION COMP2<)
+    (:EXECUTABLE-COUNTERPART COMP2<=)
+    (:TYPE-PRESCRIPTION COMP2<=)
+    (:EXECUTABLE-COUNTERPART COMP2>)
+    (:TYPE-PRESCRIPTION COMP2>)
+    (:EXECUTABLE-COUNTERPART COMP2>=)
+    (:TYPE-PRESCRIPTION COMP2>=)
+    (:EXECUTABLE-COUNTERPART LOGAND1)
+    (:TYPE-PRESCRIPTION LOGAND1)
+    (:EXECUTABLE-COUNTERPART LOGIOR1)
+    (:TYPE-PRESCRIPTION LOGIOR1)
+    (:EXECUTABLE-COUNTERPART LOGXOR1)
+    (:TYPE-PRESCRIPTION LOGXOR1)
+    (:EXECUTABLE-COUNTERPART SHFT)
+    (:EXECUTABLE-COUNTERPART DECODE)
+    (:EXECUTABLE-COUNTERPART ENCODE)
+    (:EXECUTABLE-COUNTERPART IF1)
+    (:TYPE-PRESCRIPTION IF1)
+    (:REWRITE IF1-0)
+    (:REWRITE IF1-NON-0)
+    (:REWRITE IF1-X-X)
+    (:DEFINITION COND1-MACRO)
+    (:EXECUTABLE-COUNTERPART COND1-MACRO)
+    (:TYPE-PRESCRIPTION COND1-MACRO)
+    (:INDUCTION COND1-MACRO)
+    (:EXECUTABLE-COUNTERPART NATP1)
+    (:TYPE-PRESCRIPTION NATP1)
+    (:EXECUTABLE-COUNTERPART BVECP)
+    (:TYPE-PRESCRIPTION BVECP)
+    (:REWRITE BVECP-IF1)
+    (:EXECUTABLE-COUNTERPART MK-BVEC)
+    (:TYPE-PRESCRIPTION MK-BVEC)
+    (:REWRITE MK-BVEC-IS-BVECP)
+    (:REWRITE MK-BVEC-IDENTITY)
+    (:REWRITE BVECP-RESET)
+    (:FORWARD-CHAINING BVECP-RESET)
+    (:TYPE-PRESCRIPTION BVECP-RESET)
+    (:REWRITE BVECP-UNKNOWN)
+    (:FORWARD-CHAINING BVECP-UNKNOWN)
+    (:TYPE-PRESCRIPTION BVECP-UNKNOWN)
+    (:EXECUTABLE-COUNTERPART <<)
+    (:TYPE-PRESCRIPTION <<)
+    (:REWRITE <<-IRREFLEXIVE)
+    (:REWRITE <<-TRANSITIVE)
+    (:REWRITE <<-ASYMMETRIC)
+    (:REWRITE <<-TRICHOTOMY)
+    (:REWRITE <<-IMPLIES-LEXORDER)
+    (:DEFINITION RCDP)
+    (:EXECUTABLE-COUNTERPART RCDP)
+    (:TYPE-PRESCRIPTION RCDP)
+    (:INDUCTION RCDP)
+    (:REWRITE RCDP-IMPLIES-ALISTP)
+    (:DEFINITION IFRP)
+    (:EXECUTABLE-COUNTERPART IFRP)
+    (:TYPE-PRESCRIPTION IFRP)
+    (:INDUCTION IFRP)
+    (:DEFINITION ACL2->RCD)
+    (:EXECUTABLE-COUNTERPART ACL2->RCD)
+    (:TYPE-PRESCRIPTION ACL2->RCD)
+    (:DEFINITION RCD->ACL2)
+    (:EXECUTABLE-COUNTERPART RCD->ACL2)
+    (:TYPE-PRESCRIPTION RCD->ACL2)
+    (:DEFINITION AG-AUX)
+    (:EXECUTABLE-COUNTERPART AG-AUX)
+    (:TYPE-PRESCRIPTION AG-AUX)
+    (:INDUCTION AG-AUX)
+    (:EXECUTABLE-COUNTERPART AG)
+    (:TYPE-PRESCRIPTION AG)
+    (:DEFINITION ACONS-IF)
+    (:EXECUTABLE-COUNTERPART ACONS-IF)
+    (:TYPE-PRESCRIPTION ACONS-IF)
+    (:DEFINITION AS-AUX)
+    (:EXECUTABLE-COUNTERPART AS-AUX)
+    (:TYPE-PRESCRIPTION AS-AUX)
+    (:INDUCTION AS-AUX)
+    (:EXECUTABLE-COUNTERPART AS)
+    (:TYPE-PRESCRIPTION AS)
+    (:REWRITE AG-SAME-AS)
+    (:REWRITE AG-DIFF-AS)
+    (:REWRITE AS-SAME-AG)
+    (:REWRITE AS-SAME-AS)
+    (:REWRITE AS-DIFF-AS)
+    (:REWRITE AG-OF-NIL-IS-DEFAULT)
+    (:REWRITE AS-NON-DEFAULT-CANNOT-BE-NIL)
+    (:FORWARD-CHAINING NON-NIL-IF-AG-NOT-DEFAULT)
+    (:EXECUTABLE-COUNTERPART BV-ARRP)
+    (:TYPE-PRESCRIPTION BV-ARRP)
+    (:REWRITE AS-MAPS-BV-ARR-TO-BV-ARR)
+    (:REWRITE AG-MAPS-BV-ARR-TO-BVECP)
+    (:EXECUTABLE-COUNTERPART MK-BVARR)
+    (:TYPE-PRESCRIPTION MK-BVARR)
+    (:REWRITE MK-BVARR-IS-BV-ARRP)
+    (:REWRITE MK-BVARR-IDENTITY)
+    (:DEFINITION POSITIVE-INTEGER-LISTP)
+    (:EXECUTABLE-COUNTERPART POSITIVE-INTEGER-LISTP)
+    (:TYPE-PRESCRIPTION POSITIVE-INTEGER-LISTP)
+    (:INDUCTION POSITIVE-INTEGER-LISTP)
+    (:REWRITE BV-ARRP-RESET2)
+    (:REWRITE BV-ARRP-UNKNOWN2)
+    (:REWRITE BV-ARRP-IF1)
+    (:EXECUTABLE-COUNTERPART CG)
+    (:TYPE-PRESCRIPTION CG)
+    (:TYPE-PRESCRIPTION FL-INTEGER-TYPE)
+    (:TYPE-PRESCRIPTION CG-INTEGER-TYPE)
+    (:REWRITE FL-INTEGERP)
+    (:REWRITE CG-INTEGERP)
+    (:LINEAR FL-DEF-LINEAR)
+    (:LINEAR CG-DEF-LINEAR)
+    (:LINEAR FL-MONOTONE-LINEAR)
+    (:LINEAR CG-MONOTONE-LINEAR)
+    (:LINEAR N<=FL-LINEAR)
+    (:LINEAR N>=CG-LINEAR)
+    (:REWRITE FL+INT-REWRITE)
+    (:REWRITE CG+INT-REWRITE)
+    (:REWRITE FL/INT-REWRITE)
+    (:REWRITE FL/INT-REWRITE-ALT)
+    (:REWRITE CG/INT-REWRITE)
+    (:REWRITE CG/INT-REWRITE-ALT)
+    (:REWRITE EXPT-2-POSITIVE-RATIONAL-TYPE)
+    (:TYPE-PRESCRIPTION EXPT-2-POSITIVE-RATIONAL-TYPE)
+    (:TYPE-PRESCRIPTION EXPT-2-POSITIVE-INTEGER-TYPE)
+    (:LINEAR EXPT-2-TYPE-LINEAR)
+    (:REWRITE ASH-REWRITE)
+    (:REWRITE MOD-0)
+    (:REWRITE RATIONALP-MOD)
+    (:TYPE-PRESCRIPTION RATIONALP-MOD)
+    (:REWRITE INTEGERP-MOD)
+    (:TYPE-PRESCRIPTION INTEGERP-MOD)
+    (:TYPE-PRESCRIPTION NATP-MOD)
+    (:LINEAR MOD-BND-1)
+    (:LINEAR MOD-BND-2)
+    (:REWRITE MOD-MULT)
+    (:REWRITE MOD-DIFF)
+    (:REWRITE MOD-DOES-NOTHING)
+    (:REWRITE MOD-BY-1)
+    (:REWRITE MOD-OF-MOD)
+    (:REWRITE MOD-PROD)
+    (:LINEAR MOD-BND-3)
+    (:LINEAR QUOT-BND)
+    (:REWRITE MOD-MULT-2)
+    (:LINEAR NK>=K-LINEAR)
+    (:REWRITE MOD-MULT-2-GEN)
+    (:REWRITE MOD-MULT-2-ALT-GEN)
+    (:REWRITE MOD-2*M+1-REWRITE)
+    (:EXECUTABLE-COUNTERPART FL-HALF)
+    (:TYPE-PRESCRIPTION FL-HALF)
+    (:FORWARD-CHAINING BVECP-FORWARD)
+    (:FORWARD-CHAINING BVECP-1-0)
+    (:FORWARD-CHAINING BVECP-0-1)
+    (:DEFINITION BITVEC)
+    (:EXECUTABLE-COUNTERPART BITVEC)
+    (:TYPE-PRESCRIPTION BITVEC)
+    (:TYPE-PRESCRIPTION BITN-NONNEGATIVE-INTEGER)
+    (:REWRITE BITN-BVECP)
+    (:FORWARD-CHAINING BITN-BVECP-FORWARD)
+    (:REWRITE BITN-BVECP-1)
+    (:REWRITE BITN-BITN-0)
+    (:REWRITE BITN-0)
+    (:REWRITE BVECP-BITN-0)
+    (:TYPE-PRESCRIPTION BITS-NONNEGATIVE-INTEGERP-TYPE)
+    (:REWRITE BITS-0)
+    (:REWRITE BITS-WITH-INDICES-IN-THE-WRONG-ORDER)
+    (:REWRITE BITS-N-N-REWRITE)
+    (:REWRITE BITS-TAIL)
+    (:REWRITE BITS-BVECP)
+    (:REWRITE BITS-BVECP-SIMPLE)
+    (:REWRITE BITS-BVECP-SIMPLE-2)
+    (:DEFINITION SUMBITS)
+    (:EXECUTABLE-COUNTERPART SUMBITS)
+    (:TYPE-PRESCRIPTION SUMBITS)
+    (:INDUCTION SUMBITS)
+    (:REWRITE BITN-BITS)
+    (:REWRITE BITS-BITS)
+    (:REWRITE BITS-PLUS-MULT-2)
+    (:REWRITE BITS-DROP-FROM-MINUS)
+    (:TYPE-PRESCRIPTION CAT-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE CAT-BVECP)
+    (:REWRITE CAT-ASSOCIATIVE)
+    (:REWRITE CAT-0)
+    (:REWRITE CAT-WITH-N-0)
+    (:REWRITE CAT-WITH-M-0)
+    (:REWRITE BITN-CAT-CONSTANTS)
+    (:REWRITE BITS-CAT-CONSTANTS)
+    (:REWRITE CAT-BITS-BITS)
+    (:REWRITE CAT-BITN-BITS)
+    (:REWRITE CAT-BITS-BITN)
+    (:REWRITE CAT-BITN-BITN)
+    (:TYPE-PRESCRIPTION MULCAT-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE MULCAT-BVECP)
+    (:REWRITE MULCAT-1)
+    (:REWRITE MULCAT-0)
+    (:REWRITE MULCAT-N-1)
+    (:REWRITE BITN-MULCAT-1)
+    (:REWRITE SETBITN-REWRITE)
+    (:TYPE-PRESCRIPTION SETBITN-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE SETBITN-BVECP)
+    (:REWRITE BITN-SETBITN)
+    (:TYPE-PRESCRIPTION SHFT-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE SHFT-BVECP)
+    (:TYPE-PRESCRIPTION LNOT-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LNOT-BVECP)
+    (:REWRITE LNOT-LNOT)
+    (:TYPE-PRESCRIPTION LAND0-NONNEGATIVE-INTEGER-TYPE)
+    (:TYPE-PRESCRIPTION LIOR0-NONNEGATIVE-INTEGER-TYPE)
+    (:TYPE-PRESCRIPTION LXOR0-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LAND0-BVECP)
+    (:REWRITE LIOR0-BVECP)
+    (:REWRITE LXOR0-BVECP)
+    (:REWRITE LAND0-X-Y-0)
+    (:REWRITE LIOR0-X-Y-0)
+    (:REWRITE LXOR0-X-Y-0)
+    (:DEFINITION LOGOP-2-INDUCT)
+    (:EXECUTABLE-COUNTERPART LOGOP-2-INDUCT)
+    (:TYPE-PRESCRIPTION LOGOP-2-INDUCT)
+    (:INDUCTION LOGOP-2-INDUCT)
+    (:DEFINITION LOGOP-2-N-INDUCT)
+    (:EXECUTABLE-COUNTERPART LOGOP-2-N-INDUCT)
+    (:TYPE-PRESCRIPTION LOGOP-2-N-INDUCT)
+    (:INDUCTION LOGOP-2-N-INDUCT)
+    (:DEFINITION LOGOP-3-INDUCT)
+    (:EXECUTABLE-COUNTERPART LOGOP-3-INDUCT)
+    (:TYPE-PRESCRIPTION LOGOP-3-INDUCT)
+    (:INDUCTION LOGOP-3-INDUCT)
+    (:REWRITE LAND0-COMMUTATIVE)
+    (:REWRITE LIOR0-COMMUTATIVE)
+    (:REWRITE LXOR0-COMMUTATIVE)
+    (:REWRITE LAND0-ASSOCIATIVE)
+    (:REWRITE LIOR0-ASSOCIATIVE)
+    (:REWRITE LXOR0-ASSOCIATIVE)
+    (:REWRITE LAND0-COMMUTATIVE-2)
+    (:REWRITE LIOR0-COMMUTATIVE-2)
+    (:REWRITE LXOR0-COMMUTATIVE-2)
+    (:REWRITE LAND0-COMBINE-CONSTANTS)
+    (:REWRITE LIOR0-COMBINE-CONSTANTS)
+    (:REWRITE LXOR0-COMBINE-CONSTANTS)
+    (:REWRITE LAND0-SELF)
+    (:REWRITE LIOR0-SELF)
+    (:REWRITE LXOR0-SELF)
+    (:REWRITE LAND0-0)
+    (:REWRITE LIOR0-0)
+    (:REWRITE LXOR0-0)
+    (:REWRITE LAND0-ONES-REWRITE)
+    (:REWRITE LIOR0-ONES-REWRITE)
+    (:REWRITE LXOR0-ONES-REWRITE)
+    (:REWRITE BITS-LAND0)
+    (:REWRITE BITN-LAND0)
+    (:REWRITE BITS-LIOR0)
+    (:REWRITE BITN-LIOR0)
+    (:REWRITE BITS-LXOR0)
+    (:REWRITE BITN-LXOR0)
+    (:REWRITE LAND0-BND)
+    (:LINEAR LAND0-BND)
+    (:REWRITE LIOR0-BND)
+    (:LINEAR LIOR0-BND)
+    (:REWRITE LIOR0-BVECP-2)
+    (:REWRITE LIOR0-CAT-CONSTANT)
+    (:TYPE-PRESCRIPTION LOGAND1-NONNEGATIVE-INTEGER-TYPE)
+    (:TYPE-PRESCRIPTION LOGIOR1-NONNEGATIVE-INTEGER-TYPE)
+    (:TYPE-PRESCRIPTION LOGXOR1-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LOGAND1-BVECP)
+    (:REWRITE LOGIOR1-BVECP)
+    (:REWRITE LOGXOR1-BVECP)
+    (:REWRITE LOG<-BVECP)
+    (:TYPE-PRESCRIPTION LOG<-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LOG<=-BVECP)
+    (:TYPE-PRESCRIPTION LOG<=-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LOG>-BVECP)
+    (:TYPE-PRESCRIPTION LOG>-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LOG>=-BVECP)
+    (:TYPE-PRESCRIPTION LOG>=-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LOG=-BVECP)
+    (:TYPE-PRESCRIPTION LOG=-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LOG=-COMMUTATIVE)
+    (:REWRITE LOG<>-BVECP)
+    (:TYPE-PRESCRIPTION LOG<>-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE LOG<>-COMMUTATIVE)
+    (:REWRITE LOG=-CAT-CONSTANT)
+    (:REWRITE ENCODE-BVECP)
+    (:TYPE-PRESCRIPTION ENCODE-NONNEGATIVE-INTEGER-TYPE)
+    (:TYPE-PRESCRIPTION DECODE-NONNEGATIVE-INTEGER-TYPE)
+    (:REWRITE DECODE-BVECP)
+    (:EXECUTABLE-COUNTERPART EXPO)
+    (:TYPE-PRESCRIPTION EXPO)
+    (:EXECUTABLE-COUNTERPART SGN)
+    (:TYPE-PRESCRIPTION SGN)
+    (:EXECUTABLE-COUNTERPART SIG)
+    (:TYPE-PRESCRIPTION SIG)
+    (:REWRITE EXPO-2**N)
+    (:REWRITE ALREADY-SIG)
+    (:REWRITE SIG-SIG)
+    (:EXECUTABLE-COUNTERPART EXACTP)
+    (:TYPE-PRESCRIPTION EXACTP)
+    (:REWRITE EXACTP-MINUS)
+    (:REWRITE BVECP-EXACTP)
+    (:REWRITE EXACTP-SIG)
+    (:DEFINITION FP+)
+    (:EXECUTABLE-COUNTERPART FP+)
+    (:TYPE-PRESCRIPTION FP+)
+    (:TYPE-PRESCRIPTION FP+-POSITIVE)
+    (:EXECUTABLE-COUNTERPART BIAS)
+    (:TYPE-PRESCRIPTION BIAS)
+    (:TYPE-PRESCRIPTION BIAS-NON-NEGATIVE-INTEGERP-TYPE-PRESCRIPTION)
+    (:DEFINITION ESGNF)
+    (:EXECUTABLE-COUNTERPART ESGNF)
+    (:TYPE-PRESCRIPTION ESGNF)
+    (:DEFINITION EEXPOF)
+    (:EXECUTABLE-COUNTERPART EEXPOF)
+    (:TYPE-PRESCRIPTION EEXPOF)
+    (:DEFINITION ESIGF)
+    (:EXECUTABLE-COUNTERPART ESIGF)
+    (:TYPE-PRESCRIPTION ESIGF)
+    (:EXECUTABLE-COUNTERPART EREPP)
+    (:TYPE-PRESCRIPTION EREPP)
+    (:EXECUTABLE-COUNTERPART EENCODINGP)
+    (:TYPE-PRESCRIPTION EENCODINGP)
+    (:EXECUTABLE-COUNTERPART EENCODE)
+    (:TYPE-PRESCRIPTION EENCODE)
+    (:EXECUTABLE-COUNTERPART EDECODE)
+    (:TYPE-PRESCRIPTION EDECODE)
+    (:REWRITE EENCODINGP-NOT-ZERO)
+    (:REWRITE EREPP-EDECODE)
+    (:REWRITE EENCODINGP-EENCODE)
+    (:REWRITE EDECODE-EENCODE)
+    (:REWRITE EENCODE-EDECODE)
+    (:REWRITE EXPO-EDECODE)
+    (:REWRITE SGN-EDECODE)
+    (:REWRITE SIG-EDECODE)
+    (:DEFINITION REBIAS-EXPO)
+    (:EXECUTABLE-COUNTERPART REBIAS-EXPO)
+    (:TYPE-PRESCRIPTION REBIAS-EXPO)
+    (:REWRITE NATP-REBIAS-UP)
+    (:REWRITE NATP-REBIAS-DOWN)
+    (:REWRITE BVECP-REBIAS-UP)
+    (:REWRITE BVECP-REBIAS-DOWN)
+    (:DEFINITION ISGNF)
+    (:EXECUTABLE-COUNTERPART ISGNF)
+    (:TYPE-PRESCRIPTION ISGNF)
+    (:DEFINITION IEXPOF)
+    (:EXECUTABLE-COUNTERPART IEXPOF)
+    (:TYPE-PRESCRIPTION IEXPOF)
+    (:DEFINITION ISIGF)
+    (:EXECUTABLE-COUNTERPART ISIGF)
+    (:TYPE-PRESCRIPTION ISIGF)
+    (:EXECUTABLE-COUNTERPART NREPP)
+    (:TYPE-PRESCRIPTION NREPP)
+    (:EXECUTABLE-COUNTERPART DREPP)
+    (:TYPE-PRESCRIPTION DREPP)
+    (:EXECUTABLE-COUNTERPART IREPP)
+    (:TYPE-PRESCRIPTION IREPP)
+    (:EXECUTABLE-COUNTERPART NENCODINGP)
+    (:TYPE-PRESCRIPTION NENCODINGP)
+    (:EXECUTABLE-COUNTERPART DENCODINGP)
+    (:TYPE-PRESCRIPTION DENCODINGP)
+    (:EXECUTABLE-COUNTERPART IENCODINGP)
+    (:TYPE-PRESCRIPTION IENCODINGP)
+    (:EXECUTABLE-COUNTERPART NENCODE)
+    (:TYPE-PRESCRIPTION NENCODE)
+    (:EXECUTABLE-COUNTERPART DENCODE)
+    (:TYPE-PRESCRIPTION DENCODE)
+    (:EXECUTABLE-COUNTERPART IENCODE)
+    (:TYPE-PRESCRIPTION IENCODE)
+    (:EXECUTABLE-COUNTERPART NDECODE)
+    (:TYPE-PRESCRIPTION NDECODE)
+    (:EXECUTABLE-COUNTERPART DDECODE)
+    (:TYPE-PRESCRIPTION DDECODE)
+    (:EXECUTABLE-COUNTERPART IDECODE)
+    (:TYPE-PRESCRIPTION IDECODE)
+    (:REWRITE SGN-NDECODE)
+    (:REWRITE EXPO-NDECODE)
+    (:REWRITE SIG-NDECODE)
+    (:REWRITE SGN-DDECODE)
+    (:REWRITE EXPO-DDECODE)
+    (:REWRITE SIG-DDECODE)
+    (:REWRITE SGN-IDECODE)
+    (:REWRITE EXPO-IDECODE)
+    (:REWRITE SIG-IDECODE)
+    (:REWRITE DENCODINGP-DENCODE)
+    (:REWRITE IENCODINGP-IENCODE)
+    (:REWRITE NREPP-NDECODE)
+    (:REWRITE DREPP-DDECODE)
+    (:REWRITE IREPP-IDECODE)
+    (:REWRITE NENCODINGP-NENCODE)
+    (:REWRITE NDECODE-NENCODE)
+    (:REWRITE DDECODE-DENCODE)
+    (:REWRITE IDECODE-IENCODE)
+    (:REWRITE NENCODE-NDECODE)
+    (:REWRITE DENCODE-DDECODE)
+    (:REWRITE IENCODE-IDECODE)
+    (:EXECUTABLE-COUNTERPART TRUNC)
+    (:TYPE-PRESCRIPTION TRUNC)
+    (:REWRITE TRUNC-POSITIVE)
+    (:LINEAR TRUNC-POSITIVE)
+    (:REWRITE TRUNC-NEGATIVE)
+    (:LINEAR TRUNC-NEGATIVE)
+    (:REWRITE TRUNC-0)
+    (:REWRITE TRUNC-EXACTP-A)
+    (:REWRITE EXPO-TRUNC)
+    (:EXECUTABLE-COUNTERPART AWAY)
+    (:TYPE-PRESCRIPTION AWAY)
+    (:REWRITE AWAY-POSITIVE)
+    (:LINEAR AWAY-POSITIVE)
+    (:REWRITE AWAY-NEGATIVE)
+    (:LINEAR AWAY-NEGATIVE)
+    (:REWRITE AWAY-0)
+    (:REWRITE AWAY-EXACTP-A)
+    (:DEFINITION RE)
+    (:EXECUTABLE-COUNTERPART RE)
+    (:TYPE-PRESCRIPTION RE)
+    (:EXECUTABLE-COUNTERPART NEAR)
+    (:TYPE-PRESCRIPTION NEAR)
+    (:TYPE-PRESCRIPTION NEAR-POS)
+    (:LINEAR NEAR-POS)
+    (:REWRITE NEAR-0)
+    (:REWRITE NEAR-EXACTP-A)
+    (:REWRITE NEAR-MONOTONE)
+    (:EXECUTABLE-COUNTERPART NEAR-WITNESS)
+    (:TYPE-PRESCRIPTION NEAR-WITNESS)
+    (:EXECUTABLE-COUNTERPART NEAR+)
+    (:TYPE-PRESCRIPTION NEAR+)
+    (:REWRITE SGN-NEAR+)
+    (:LINEAR NEAR+-POS)
+    (:LINEAR NEAR+-NEG)
+    (:REWRITE NEAR+-0)
+    (:REWRITE NEAR+-MONOTONE)
+    (:REWRITE NEAR+-EXACTP-A)
+    (:REWRITE NEAR+-EXACTP-C)
+    (:REWRITE NEAR+-EXACTP-D)
+    (:EXECUTABLE-COUNTERPART STICKY)
+    (:TYPE-PRESCRIPTION STICKY)
+    (:REWRITE STICKY-1)
+    (:REWRITE STICKY-0)
+    (:EXECUTABLE-COUNTERPART ODDR)
+    (:TYPE-PRESCRIPTION ODDR)
+    (:REWRITE EXPO-ODDR)
+    (:DEFINITION KP)
+    (:EXECUTABLE-COUNTERPART KP)
+    (:TYPE-PRESCRIPTION KP)
+    (:DEFINITION INF)
+    (:EXECUTABLE-COUNTERPART INF)
+    (:TYPE-PRESCRIPTION INF)
+    (:DEFINITION MINF)
+    (:EXECUTABLE-COUNTERPART MINF)
+    (:TYPE-PRESCRIPTION MINF)
+    (:EXECUTABLE-COUNTERPART IEEE-MODE-P)
+    (:TYPE-PRESCRIPTION IEEE-MODE-P)
+    (:DEFINITION COMMON-ROUNDING-MODE-P)
+    (:EXECUTABLE-COUNTERPART COMMON-ROUNDING-MODE-P)
+    (:TYPE-PRESCRIPTION COMMON-ROUNDING-MODE-P)
+    (:EXECUTABLE-COUNTERPART RND)
+    (:TYPE-PRESCRIPTION RND)
+    (:TYPE-PRESCRIPTION RATIONALP-RND)
+    (:REWRITE RND-NON-POS)
+    (:TYPE-PRESCRIPTION RND-NON-POS)
+    (:LINEAR RND-NON-POS)
+    (:REWRITE RND-NON-NEG)
+    (:TYPE-PRESCRIPTION RND-NON-NEG)
+    (:LINEAR RND-NON-NEG)
+    (:TYPE-PRESCRIPTION RND-POS)
+    (:TYPE-PRESCRIPTION RND-NEG)
+    (:REWRITE RND-0)
+    (:EXECUTABLE-COUNTERPART FLIP)
+    (:TYPE-PRESCRIPTION FLIP)
+    (:REWRITE IEEE-MODE-P-FLIP)
+    (:REWRITE COMMON-ROUNDING-MODE-P-FLIP)
+    (:REWRITE RND-EXACTP-A)
+    (:REWRITE RND-EXACTP-B)
+    (:REWRITE EXACTP-RND)
+    (:DEFINITION RND-CONST)
+    (:EXECUTABLE-COUNTERPART RND-CONST)
+    (:TYPE-PRESCRIPTION RND-CONST)
+    (:DEFINITION ROUNDUP)
+    (:EXECUTABLE-COUNTERPART ROUNDUP)
+    (:TYPE-PRESCRIPTION ROUNDUP)
+    (:EXECUTABLE-COUNTERPART DRND-ORIGINAL)
+    (:TYPE-PRESCRIPTION DRND-ORIGINAL)
+    (:REWRITE DRND-ORIGINAL-0)
+    (:EXECUTABLE-COUNTERPART SPN)
+    (:TYPE-PRESCRIPTION SPN)
+    (:LINEAR POSITIVE-SPN)
+    (:REWRITE NREPP-SPN)
+    (:REWRITE SMALLEST-SPN)
+    (:EXECUTABLE-COUNTERPART SPD)
+    (:TYPE-PRESCRIPTION SPD)
+    (:LINEAR  POSITIVE-SPD)
+    (:REWRITE DREPP-SPD)
+    (:REWRITE SMALLEST-SPD)
+    (:REWRITE DRND-ORIGINAL-OF-DREPP-IS-NOP)
+    (:REWRITE DRND-ORIGINAL-SPN-IS-SPN-GENERAL)
+    (:REWRITE DRND-ORIGINAL-TRUNC-NEVER-GOES-AWAY-FROM-ZERO)
+    (:REWRITE DRND-ORIGINAL-AWAY-NEVER-GOES-TOWARD-ZERO)
+    (:REWRITE DRND-ORIGINAL-INF-NEVER-GOES-DOWN)
+    (:REWRITE DRND-ORIGINAL-MINF-NEVER-GOES-UP)
+    (:REWRITE DRND-ORIGINAL-TRUNC-SKIPS-NO-DENORMALS)
+    (:REWRITE DRND-ORIGINAL-AWAY-SKIPS-NO-DENORMALS)
+    (:REWRITE DRND-ORIGINAL-INF-SKIPS-NO-DENORMALS)
+    (:REWRITE DRND-ORIGINAL-MINF-SKIPS-NO-DENORMALS)
+    (:REWRITE DRND-ORIGINAL-DIFF)
+    (:EXECUTABLE-COUNTERPART NEXT-DENORMAL)
+    (:TYPE-PRESCRIPTION NEXT-DENORMAL)
+    (:REWRITE DENORMAL-SPACING)
+    (:REWRITE NO-DENORMAL-IS-CLOSER-THAN-WHAT-DRND-ORIGINAL-NEAR-RETURNS)
+    (:DEFINITION GEN)
+    (:EXECUTABLE-COUNTERPART GEN)
+    (:TYPE-PRESCRIPTION GEN)
+    (:INDUCTION GEN)
+    (:DEFINITION PROP)
+    (:EXECUTABLE-COUNTERPART PROP)
+    (:TYPE-PRESCRIPTION PROP)
+    (:INDUCTION PROP)
+    (:REWRITE LAND0-GEN-0)
+    (:REWRITE BVECP-1-GEN)
+    (:FORWARD-CHAINING BVECP-1-GEN)
+    (:REWRITE BVECP-1-PROP)
+    (:FORWARD-CHAINING BVECP-1-PROP)
+    (:DEFINITION LAMT-0)
+    (:EXECUTABLE-COUNTERPART LAMT-0)
+    (:TYPE-PRESCRIPTION LAMT-0)
+    (:DEFINITION LAMG-0)
+    (:EXECUTABLE-COUNTERPART LAMG-0)
+    (:TYPE-PRESCRIPTION LAMG-0)
+    (:DEFINITION LAMZ-0)
+    (:EXECUTABLE-COUNTERPART LAMZ-0)
+    (:TYPE-PRESCRIPTION LAMZ-0)
+    (:DEFINITION LAM1-0)
+    (:EXECUTABLE-COUNTERPART LAM1-0)
+    (:TYPE-PRESCRIPTION LAM1-0)
+    (:DEFINITION LAM2-0)
+    (:EXECUTABLE-COUNTERPART LAM2-0)
+    (:TYPE-PRESCRIPTION LAM2-0)
+    (:DEFINITION LAM3-0)
+    (:EXECUTABLE-COUNTERPART LAM3-0)
+    (:TYPE-PRESCRIPTION LAM3-0)
+    (:DEFINITION LAM4-0)
+    (:EXECUTABLE-COUNTERPART LAM4-0)
+    (:TYPE-PRESCRIPTION LAM4-0)
+    (:DEFINITION LAM0-0)
+    (:EXECUTABLE-COUNTERPART LAM0-0)
+    (:TYPE-PRESCRIPTION LAM0-0)
+    (:DEFINITION LAMB-0)
+    (:EXECUTABLE-COUNTERPART LAMB-0)
+    (:TYPE-PRESCRIPTION LAMB-0)
+    (:REWRITE A1)
+    (:REWRITE A2)
+    (:REWRITE A3)
+    (:REWRITE A4)
+    (:REWRITE A5)
+    (:REWRITE A6)
+    (:REWRITE A7)
+    (:REWRITE A8)
+    (:REWRITE A9)
+    (:REWRITE A10)
+    (:LINEAR A12)
+    (:LINEAR A13)
+    (:TYPE-PRESCRIPTION A14 . 1)
+    (:TYPE-PRESCRIPTION A14 . 2)
+    (:REWRITE A15)
+    (:REWRITE A16)
+    (:FORWARD-CHAINING /-WEAKLY-MONOTONIC)
+    (:LINEAR /-WEAKLY-MONOTONIC)
+    (:FORWARD-CHAINING /-STRONGLY-MONOTONIC)
+    (:LINEAR /-STRONGLY-MONOTONIC)
+    (:FORWARD-CHAINING *-WEAKLY-MONOTONIC . 1)
+    (:LINEAR *-WEAKLY-MONOTONIC . 1)
+    (:FORWARD-CHAINING *-WEAKLY-MONOTONIC . 2)
+    (:LINEAR *-WEAKLY-MONOTONIC . 2)
+    (:FORWARD-CHAINING *-STRONGLY-MONOTONIC . 1)
+    (:LINEAR *-STRONGLY-MONOTONIC . 1)
+    (:FORWARD-CHAINING *-STRONGLY-MONOTONIC . 2)
+    (:LINEAR *-STRONGLY-MONOTONIC . 2)
+    (:FORWARD-CHAINING *-WEAKLY-MONOTONIC-NEGATIVE-MULTIPLIER
+                       . 1)
+    (:LINEAR *-WEAKLY-MONOTONIC-NEGATIVE-MULTIPLIER
+             . 1)
+    (:FORWARD-CHAINING *-WEAKLY-MONOTONIC-NEGATIVE-MULTIPLIER
+                       . 2)
+    (:LINEAR *-WEAKLY-MONOTONIC-NEGATIVE-MULTIPLIER
+             . 2)
+    (:FORWARD-CHAINING *-STRONGLY-MONOTONIC-NEGATIVE-MULTIPLIER
+                       . 1)
+    (:LINEAR *-STRONGLY-MONOTONIC-NEGATIVE-MULTIPLIER
+             . 1)
+    (:FORWARD-CHAINING *-STRONGLY-MONOTONIC-NEGATIVE-MULTIPLIER
+                       . 2)
+    (:LINEAR *-STRONGLY-MONOTONIC-NEGATIVE-MULTIPLIER
+             . 2)
+    (:FORWARD-CHAINING FL-WEAKLY-MONOTONIC . 1)
+    (:LINEAR FL-WEAKLY-MONOTONIC . 1)
+    (:FORWARD-CHAINING FL-WEAKLY-MONOTONIC . 2)
+    (:LINEAR FL-WEAKLY-MONOTONIC . 2)
+    (:REWRITE REARRANGE-NEGATIVE-COEFS-<)
+    (:REWRITE REARRANGE-NEGATIVE-COEFS-EQUAL)
+    (:REWRITE REARRANGE-FRACTIONAL-COEFS-<)
+    (:REWRITE REARRANGE-FRACTIONAL-COEFS-EQUAL)
+    (:EXECUTABLE-COUNTERPART POINT-RIGHT-MEASURE)
+    (:TYPE-PRESCRIPTION POINT-RIGHT-MEASURE)
+    (:EXECUTABLE-COUNTERPART POINT-LEFT-MEASURE)
+    (:TYPE-PRESCRIPTION POINT-LEFT-MEASURE)
+    (:DEFINITION FIRSTN)
+    (:EXECUTABLE-COUNTERPART FIRSTN)
+    (:TYPE-PRESCRIPTION FIRSTN)
+    (:INDUCTION FIRSTN)
+    (:DEFINITION DROPN)
+    (:EXECUTABLE-COUNTERPART DROPN)
+    (:TYPE-PRESCRIPTION DROPN)
+    (:INDUCTION DROPN)
+    (:DEFINITION WCMP)
+    (:EXECUTABLE-COUNTERPART WCMP)
+    (:TYPE-PRESCRIPTION WCMP)
+    (:DEFINITION OCMP-AUX)
+    (:EXECUTABLE-COUNTERPART OCMP-AUX)
+    (:TYPE-PRESCRIPTION OCMP-AUX)
+    (:INDUCTION OCMP-AUX)
+    (:DEFINITION OCMP)
+    (:EXECUTABLE-COUNTERPART OCMP)
+    (:TYPE-PRESCRIPTION OCMP)
+    (:DEFINITION OMEGA-TERM)
+    (:EXECUTABLE-COUNTERPART OMEGA-TERM)
+    (:TYPE-PRESCRIPTION OMEGA-TERM)
+    (:DEFINITION OMEGA)
+    (:EXECUTABLE-COUNTERPART OMEGA)
+    (:TYPE-PRESCRIPTION OMEGA)
+    (:DEFINITION O-MAX)
+    (:EXECUTABLE-COUNTERPART O-MAX)
+    (:TYPE-PRESCRIPTION O-MAX)
+    (:DEFINITION LIMITPART)
+    (:EXECUTABLE-COUNTERPART LIMITPART)
+    (:TYPE-PRESCRIPTION LIMITPART)
+    (:INDUCTION LIMITPART)
+    (:DEFINITION NATPART)
+    (:EXECUTABLE-COUNTERPART NATPART)
+    (:TYPE-PRESCRIPTION NATPART)
+    (:INDUCTION NATPART)
+    (:DEFINITION LIMITP)
+    (:EXECUTABLE-COUNTERPART LIMITP)
+    (:TYPE-PRESCRIPTION LIMITP)
+    (:DEFINITION OLEN)
+    (:EXECUTABLE-COUNTERPART OLEN)
+    (:TYPE-PRESCRIPTION OLEN)
+    (:INDUCTION OLEN)
+    (:DEFINITION O-LAST-EXPT)
+    (:EXECUTABLE-COUNTERPART O-LAST-EXPT)
+    (:TYPE-PRESCRIPTION O-LAST-EXPT)
+    (:INDUCTION O-LAST-EXPT)
+    (:DEFINITION OB+)
+    (:EXECUTABLE-COUNTERPART OB+)
+    (:TYPE-PRESCRIPTION OB+)
+    (:INDUCTION OB+)
+    (:DEFINITION O-)
+    (:EXECUTABLE-COUNTERPART O-)
+    (:TYPE-PRESCRIPTION O-)
+    (:INDUCTION O-)
+    (:DEFINITION COUNT1)
+    (:EXECUTABLE-COUNTERPART COUNT1)
+    (:TYPE-PRESCRIPTION COUNT1)
+    (:INDUCTION COUNT1)
+    (:DEFINITION COUNT2)
+    (:EXECUTABLE-COUNTERPART COUNT2)
+    (:TYPE-PRESCRIPTION COUNT2)
+    (:DEFINITION PADD)
+    (:EXECUTABLE-COUNTERPART PADD)
+    (:TYPE-PRESCRIPTION PADD)
+    (:INDUCTION PADD)
+    (:DEFINITION PMULT)
+    (:EXECUTABLE-COUNTERPART PMULT)
+    (:TYPE-PRESCRIPTION PMULT)
+    (:INDUCTION PMULT)
+    (:DEFINITION OB*)
+    (:EXECUTABLE-COUNTERPART OB*)
+    (:TYPE-PRESCRIPTION OB*)
+    (:INDUCTION OB*)
+    (:DEFINITION O^1)
+    (:EXECUTABLE-COUNTERPART O^1)
+    (:TYPE-PRESCRIPTION O^1)
+    (:INDUCTION O^1)
+    (:DEFINITION O^2)
+    (:EXECUTABLE-COUNTERPART O^2)
+    (:TYPE-PRESCRIPTION O^2)
+    (:DEFINITION O^3H)
+    (:EXECUTABLE-COUNTERPART O^3H)
+    (:TYPE-PRESCRIPTION O^3H)
+    (:INDUCTION O^3H)
+    (:DEFINITION O^3)
+    (:EXECUTABLE-COUNTERPART O^3)
+    (:TYPE-PRESCRIPTION O^3)
+    (:DEFINITION O^4)
+    (:EXECUTABLE-COUNTERPART O^4)
+    (:TYPE-PRESCRIPTION O^4)
+    (:DEFINITION OB^)
+    (:EXECUTABLE-COUNTERPART OB^)
+    (:TYPE-PRESCRIPTION OB^)
+    (:INDUCTION OB^)
+    (:DEFINITION E0-ORD-<)
+    (:EXECUTABLE-COUNTERPART E0-ORD-<)
+    (:TYPE-PRESCRIPTION E0-ORD-<)
+    (:INDUCTION E0-ORD-<)
+    (:DEFINITION E0-ORDINALP)
+    (:EXECUTABLE-COUNTERPART E0-ORDINALP)
+    (:TYPE-PRESCRIPTION E0-ORDINALP)
+    (:INDUCTION E0-ORDINALP)
+    (:DEFINITION COPYN)
+    (:EXECUTABLE-COUNTERPART COPYN)
+    (:TYPE-PRESCRIPTION COPYN)
+    (:INDUCTION COPYN)
+    (:EXECUTABLE-COUNTERPART CTOA)
+    (:TYPE-PRESCRIPTION CTOA)
+    (:REWRITE CTOA-<-EQUIV)
+    (:FORWARD-CHAINING |oc.x  <=>  oa(ctoa.x)|)
+    (:REWRITE |oc.x  <=>  oa(ctoa.x)|)
+    (:EXECUTABLE-COUNTERPART ATOC)
+    (:TYPE-PRESCRIPTION ATOC)
+    (:REWRITE |oa.x  <=>  oc(atoc.x)|)
+    (:REWRITE ATOC-<-EQUIV)
+    (:WELL-FOUNDED-RELATION E0-ORDINAL-WELL-FOUNDED-CNF)
+    (:REWRITE RECURSION-BY-POINT-RIGHT)
+    (:REWRITE RECURSION-BY-POINT-LEFT)
+    (:DEFINITION SUB1-INDUCTION)
+    (:EXECUTABLE-COUNTERPART SUB1-INDUCTION)
+    (:TYPE-PRESCRIPTION SUB1-INDUCTION)
+    (:INDUCTION SUB1-INDUCTION)
+    (:DEFINITION SPLIT-LIST)
+    (:EXECUTABLE-COUNTERPART SPLIT-LIST)
+    (:TYPE-PRESCRIPTION SPLIT-LIST)
+    (:INDUCTION SPLIT-LIST)))
+
+(deftheory lib-top1-built-ins-helper-1
+
+; (let* ((world (w state))
+;        (cgz (current-theory 'ground-zero))
+;        (here (current-theory :here)))
+;   (set-difference-theories cgz here)))
+
+  '((:DEFINITION FLOOR)
+    (:REWRITE INVERSE-OF-*)
+    (:DEFINITION TRUNCATE)
+    (:DEFINITION MOD)
+    (:DEFINITION REM)
+    (:DEFINITION LOGNOT)
+    (:DEFINITION EXPT)
+    (:INDUCTION EXPT)
+    (:DEFINITION ASH)
+    (:DEFINITION AREF1)
+    (:DEFINITION ASET1)
+    (:DEFINITION AREF2)
+    (:DEFINITION ASET2)
+    (:DEFINITION BINARY-LOGAND)
+    (:INDUCTION BINARY-LOGAND)
+    (:DEFINITION BINARY-LOGIOR)
+    (:DEFINITION LOGORC1)
+    (:DEFINITION BINARY-LOGEQV)
+    (:DEFINITION BINARY-LOGXOR)))
+
+(deftheory lib-top1-built-ins-helper-2
+
+; (let* ((world (w state))
+;        (cgz (current-theory 'ground-zero))
+;        (ugz (universal-theory 'ground-zero))
+;        (here (current-theory :here)))
+;   (intersection-theories (set-difference-theories ugz cgz)
+;                          here))
+
+  nil)
+
+(deftheory lib-top1
+  (union-theories
+   (theory 'lib-top1-non-built-ins)
+   (union-theories (set-difference-theories
+                    (current-theory 'ground-zero)
+                    (theory 'lib-top1-built-ins-helper-1))
+                   (theory 'lib-top1-built-ins-helper-2))))
diff -Nru acl2-6.2/books/rtl/rel9/support/support/trunc-proofs.lisp acl2-6.3/books/rtl/rel9/support/support/trunc-proofs.lisp
--- acl2-6.2/books/rtl/rel9/support/support/trunc-proofs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/trunc-proofs.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,1378 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;;***************************************************************
+;;;an acl2 library of floating point arithmetic
+
+;;;david m. russinoff
+;;;advanced micro devices, inc.
+;;;february, 1998
+;;;***************************************************************
+
+;make local some of the events in this book
+
+(include-book "ground-zero")
+(local (include-book "float"))
+(local (include-book "../../arithmetic/top"))
+
+;;Necessary defuns
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+;;
+;; New stuff:
+;;
+
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+;generated automatically by ACL2 when we define trunc, but included here just to be safe
+;could have disabled (:type-prescription trunc) for slight efficiency gain at the cost of making the output of :pe a
+;little deceptive
+(defthm trunc-rational-type-prescription
+  (rationalp (trunc x n))
+  :rule-classes :type-prescription)
+
+(defthm trunc-of-non-rationalp-is-0
+  (implies (not (rationalp x))
+           (equal (trunc x n)
+                  0))
+  :hints (("goal" :in-theory (enable trunc sig))))
+
+#| would be nice:
+(defthm trunc-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (trunc x n)
+                  ...)))
+|#
+
+
+
+(defthm trunc-to-0-or-fewer-bits
+  (implies (and (<= n 0)
+                (integerp n)
+                )
+           (equal (trunc x n)
+                  0))
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable trunc expt-split)
+                              '())
+           :use ((:instance fl-unique
+                            (x (* 1/2 (sig x) (expt 2 n)))
+                            (n 0))
+                 (:instance expt-weak-monotone
+                            (n n)
+                            (m 0))))))
+
+;make alt version? use negative-syntaxp?
+(defthm trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n)))
+  :hints (("Goal" :in-theory (enable trunc))))
+
+
+;change what trunc does with n not a positive int?
+(defthm trunc-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n))
+                )
+           (< 0 (trunc x n)))
+  :rule-classes (:rewrite :linear)
+  :hints (("goal" :in-theory (e/d ( trunc expt-split) (SIG-LESS-THAN-1-MEANS-X-0 SIG-LOWER-BOUND))
+           :use ((:instance sig-lower-bound)))))
+
+
+;I think this rule has caused the "bad-ass" problem regarding the (case-split (< 0 n)) hyp.
+;BOZO should this include rationalp, to have a more type-like conclusion?
+(defthm trunc-positive-rational-type-prescription
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< 0 (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear)
+  :hints (("goal" :in-theory (e/d ( trunc expt-split) ( SIG-LESS-THAN-1-MEANS-X-0  SIG-LOWER-BOUND))
+           :use ((:instance sig-lower-bound)))))
+
+;BOZO should this include rationalp, to have a more type-like conclusion?
+(defthm trunc-negative-rational-type-prescription
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n))
+                )
+           (< (trunc x n) 0))
+  :rule-classes :type-prescription)
+
+(defthm trunc-0 
+  (equal (trunc 0 n) 
+         0)
+  :hints (("goal" :in-theory (enable trunc))))
+
+;trying the case-split
+(defthm trunc-of-non-rationalp-is-0-alt
+  (implies (case-split (not (rationalp x)))
+           (equal (trunc x n)
+                  0)))
+
+
+(defthm trunc-non-negative-rational-type-prescription
+  (implies (and (<= 0 x)
+                (case-split (integerp n))
+                )
+           (and (<= 0 (trunc x n))
+                (rationalp (trunc x n))))
+  :hints (("Goal" :cases ((equal x 0) (and (not (equal x 0)) (<= n 0)))))
+  :rule-classes :type-prescription)
+
+(defthm trunc-non-positive-rational-type-prescription
+  (implies (and (<= x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+;                (case-split (< 0 n))
+                )
+           (and (<= (trunc x n) 0)
+                (rationalp (trunc x n))))
+  :hints (("Goal" :cases ((equal x 0) (and (not (equal x 0)) (<= n 0)))))
+  :rule-classes :type-prescription)
+
+;make an away version?
+(defthm trunc-non-negative-linear
+  (implies (and (<= 0 x)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (<= 0 (trunc x n)))
+  :rule-classes :linear)
+
+;make an away version?
+(defthm trunc-non-positive-linear
+  (implies (and (<= x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (<= (trunc x n) 0))
+  :rule-classes :linear)
+
+(defthm sgn-trunc
+  (implies (and (< 0 n)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (sgn (trunc x n))
+                  (sgn x)))
+  :hints (("goal" :cases ((equal x 0) (< x 0)))))
+
+
+;why not just open up trunc and sgn?
+;keep this disabled, since it basically opens up TRUNC
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+  :hints (("goal" :in-theory (enable trunc)
+           )))
+
+(defthm trunc-upper-bound
+  (implies (and (rationalp x)
+                (integerp n))
+           (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (e/d (abs-trunc) 
+                                  ( ;CANCEL-IN-PRODS-<-3-OF-3-WITH-2-OF-2
+                                   EXPT-COMPARE-EQUAL ;BOZO why?
+                                   CANCEL-COMMON-FACTORS-IN-<
+                                   ))
+           :use (trunc-to-0-or-fewer-bits
+                 (:instance *-weakly-monotonic
+                            (x (expt 2 (- (1+ (expo x)) n)))
+                            (y (fl (* (sig x) (expt 2 (1- n)))))
+                            (y+ (* (sig x) (expt 2 (1- n)))))
+                 (:instance fp-abs)
+                 (:instance expt-split (r 2) (i (1- n)) (j (- (1+ (expo x)) n)))
+                 ))))
+
+
+
+
+;BOZO bad name. should be trunc-equal-0
+(defthm trunc-equal-0-rewrite
+  (implies (and (> n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (equal (trunc x n) 0)
+                  (equal x 0)))
+  :hints (("Goal" :cases ((< x 0) (equal x 0) (< 0 x))
+           )))
+
+(defthm trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+    :rule-classes :linear
+    :hints (("goal" :in-theory (disable abs-trunc trunc)
+             :use ((:instance trunc-upper-bound)
+                   ))))
+
+#| BOZO prove this and use below
+
+(defthm fl-unique-rewrite
+    (implies (and (<= n x)
+		  (< x (1+ n))
+                  (rationalp x)
+		  (integerp n)
+		  )
+	     (equal (fl x)
+                    n)))
+
+(defthm fl-unique-rewrite-2
+    (implies (and (< x n)
+                  (<= (1- n) x)
+                  (rationalp x)
+		  (integerp n)
+		  )
+	     (equal (fl x)
+                    (1- n))))
+
+;gen to negative x?
+(defthm expo-fl
+  (implies (<= 0 x)
+           (equal (expo (fl x))
+                  (if (<= 1 (abs x))	
+                      (expo x)	
+                    0)
+                  ))
+  :otf-flg t
+  :hints (("Goal" :in-theory (enable expo-equality-reduce-to-bounds
+;expt-split
+                                     ) ;BOZO consider enabling this gloablly?
+;(or make a version for constants, same for expo-comparison...)
+           :use (:instance expo-unique (x (fl x)) (n 0)))))
+
+
+(defthm expo-trunc
+   (implies (and (< 0 n)
+                 (rationalp x)
+                 (integerp n)
+                 )
+            (equal (expo (trunc x n))
+                   (expo x)))
+   :hints (("goal" :in-theory (e/d ( trunc sig)
+                                   (LESS-THAN-MULTIPLY-THROUGH-BY-INVERTED-FACTOR-FROM-LEFT-HAND-SIDE)))))
+
+
+|#
+
+(encapsulate
+ ()
+;BOZO this seems dumb, given expo-trunc
+ (local (defthm expo-trunc-upper-bound
+          (implies (and (< 0 n)
+                        (rationalp x)
+                        (integerp n)
+                        )
+                   (<= (expo (trunc x n)) (expo x)))
+          :rule-classes nil
+          :hints (("goal" 
+                   :use ((:instance trunc-upper-bound)
+
+                         (:instance expo-monotone (x (trunc x n)) (y x)))))))
+
+ (local (defthm expo-trunc-lower-bound
+          (implies (and (rationalp x)
+                        (not (= x 0))
+                        (integerp n)
+                        (> n 0))
+                   (>= (abs (trunc x n)) (expt 2 (expo x))))
+          :rule-classes nil
+          :hints (("goal" :in-theory (e/d (abs-trunc) ( expt-compare-equal))
+                   :use ((:instance sig-lower-bound)
+                         (:instance *-weakly-monotonic
+                                    (y (expt 2 (1- n)))
+                                    (y+ (fl (* (sig x) (expt 2 (1- n)))))
+                                    (x (expt 2 (- (1+ (expo x)) n))))
+                         (:instance expt-split (r 2) (i (1- n)) (j (- (1+ (expo x)) n)))
+                         (:instance fl-monotone-linear (x (expt 2 (1- n))) (y (* (expt 2 (1- n)) (sig x)))))))))
+
+ (defthm expo-trunc
+   (implies (and (< 0 n)
+                 (rationalp x)
+                 (integerp n)
+                 )
+            (equal (expo (trunc x n))
+                   (expo x)))
+   :hints (("goal" :in-theory (disable abs-trunc)
+            :use ((:instance expo-trunc-lower-bound)
+                  (:instance expo-trunc-upper-bound)
+                  (:instance expo-upper-bound (x (trunc x n)))
+                  (:instance expt-strong-monotone (n (expo x)) (m (1+ (expo (trunc x n)))))))))
+ )
+
+(local
+   (defthm trunc-lower-1-2
+     (implies (and (rationalp u)
+                   (rationalp v)
+                   (rationalp r)
+                   (> r 0)
+                   (< u (1+ v)))
+              (< (* r u) (* r (1+ v))))
+     :rule-classes ()))
+
+(defthm trunc-lower-1-3
+    (implies (and (rationalp u)
+                  (rationalp v)
+                  (rationalp r)
+                  (> r 0)
+                  (< u (1+ v)))
+             (< (* r u) (+ r (* r v))))
+    :rule-classes ()
+    :hints (("goal" :in-theory (disable *-strongly-monotonic)
+             :use ((:instance trunc-lower-1-2)))))
+
+(defthm trunc-lower-1
+  (implies (and (rationalp x)
+                (integerp n))
+           (> (abs (trunc x n))
+              (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable expt-split expt-minus abs-trunc)
+                              '())
+           :use ((:instance fp-abs)
+                 (:instance trunc-lower-1-3
+                            (u (* (sig x) (expt 2 (1- n))))
+                            (v (fl (* (sig x) (expt 2 (1- n)))))
+                            (r (expt 2 (- (1+ (expo x)) n))))))))
+
+
+(defthm trunc-lower-2-1
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expt 2 (- (1+ (expo x)) n)) (* (abs x) (expt 2 (- 1 n)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable abs EXPT-COMPARE-EQUAL)
+		  :use ((:instance expo-lower-bound)
+			(:instance expt-split (r 2) (i (expo x)) (j (- 1 n)))))))
+
+(defthm trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (disable abs)
+		  :use ((:instance trunc-lower-1)
+			(:instance trunc-lower-2-1)))))
+
+(defthm trunc-lower-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (disable abs-trunc abs-pos)
+		  :use ((:instance trunc-lower-2)))))
+
+(defthm trunc-lower-3
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (disable abs)
+		  :use ((:instance trunc-lower-1)
+			(:instance trunc-lower-2-1)))))
+(local
+ (defthm trunc-lower-4-1
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (trunc x n)) (- (abs x) (* (abs x) (expt 2 (- 1 n))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable abs-trunc)
+		  :use ((:instance trunc-lower-3))))))
+
+(local
+ (defthm trunc-lower-4-2
+    (implies (and (rationalp x)
+		  (< x 0)
+		  (integerp n)
+		  (> n 0))
+	     (>= (trunc x n) x))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable abs-trunc)
+		  :use ((:instance trunc-upper-bound))))))
+
+(defthm trunc-lower-4
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (trunc x n) (- x (* (abs x) (expt 2 (- 1 n))))))
+  :rule-classes :linear
+  :hints (("goal" :in-theory (disable abs-trunc)
+		  :use ((:instance trunc-lower-4-1)
+			(:instance trunc-lower-4-2)
+;			(:instance trunc-pos)
+	;		(:instance trunc-neg)
+                        ))))
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable abs-trunc)
+		  :use (;(:instance trunc-diff-1 (y (trunc x n)))  ;drop?
+;			(:instance trunc-neg)
+	;		(:instance trunc-pos)
+			(:instance trunc-upper-bound)
+			(:instance trunc-lower-1)))))
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable abs-trunc)
+		  :use ((:instance trunc-diff)
+		;	(:instance trunc-pos)
+			(:instance trunc-upper-bound)))))
+
+
+(defthm trunc-diff-expo-1
+    (implies (and (rationalp x)
+		  (not (= x (trunc x n)))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable abs abs-trunc)
+		  :use ((:instance trunc-diff)
+			(:instance expo-lower-bound (x (- x (trunc x n))))
+			(:instance expt-strong-monotone 
+				   (n (expo (- x (trunc x n))))
+				   (m (- (1+ (expo x)) n)))))))
+;just gets rid of sig...
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0) ;gen?  this isn't in pos-rewrite!
+                  )
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n)))))
+    :hints (("Goal" :in-theory (enable trunc sig expt-split))))
+
+;yuck?
+(local
+ (defthm trunc-exactp-2
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (rationalp z)
+		  (not (= x 0))
+		  (not (= z 0)))
+	     (iff (= (* x y z) (* x (fl y) z))
+		  (integerp y)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable fl-int fl-integerp fl)
+		  :use ((:instance fl-integerp (x y))
+			(:instance *cancell (x (fl y)) (z (* x z))))))))
+
+(defthm trunc-exactp-b
+  (implies (and (rationalp x)
+                (integerp n) 
+                (> n 0))
+           (iff (= x (trunc x n))
+                (exactp x n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable expt-split expt-minus trunc-rewrite exactp2)
+                              '( REARRANGE-NEGATIVE-COEFS-EQUAL
+                                 FL->-INTEGER
+                                 FL-<-INTEGER
+                                 FL-LESS-THAN-ZERO
+                                 fl-strong-monotone
+                                 ))
+           :use ((:instance trunc-exactp-2
+                            (x (sgn x))
+                            (y (* (expt 2 (- (1- n) (expo x))) (abs x)))
+                            (z (expt 2 (- (1+ (expo x)) n))))
+                 ))))
+
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable abs abs-trunc)
+		  :use ((:instance trunc-diff-expo-1)
+			(:instance trunc-exactp-b)))))
+(local
+ (defthm trunc-exactp-a-2
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0)
+                  )
+	     (integerp (* (trunc x n) (expt 2 (- (1- n) (expo x))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable trunc-rewrite)
+		  :use ()))))
+
+(defthm trunc-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (trunc x n)
+                  (if (acl2-numberp n)
+                      (sgn x)
+                    0)))
+  :hints (("Goal" :in-theory (enable trunc))))
+
+(local (defthm trunc-exactp-a-helper
+    (implies (and; (rationalp x)
+		  (integerp n) ;drop?
+                  )
+	     (exactp (trunc x n) n))
+  :hints (("goal" :in-theory (e/d (exactp2 expt-split) ())
+		  :use ( 
+                         (:instance trunc-exactp-a-2)
+                        (:instance trunc-to-0-or-fewer-bits)
+                        )))))
+
+;improve by concluding (exactp (trunc x n) m+) if m+ >= m ??
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n)
+  :hints (("goal" :in-theory (e/d () (trunc-exactp-a-helper))
+           :use (trunc-exactp-a-helper))))
+
+
+(defthm trunc-exactp-c
+    (implies (and (exactp a n)
+		  (<= a x)
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a)
+		  )
+	     (<= a (trunc x n)))
+  :hints (("goal" :in-theory (disable abs-trunc trunc-exactp-a)
+		  :use ((:instance trunc-exactp-a)
+			(:instance trunc-exactp-b)
+			(:instance fp+2 (x (trunc x n)) (y a))
+			(:instance trunc-lower-1)
+                        (:instance trunc-upper-bound)
+;			(:instance trunc-pos)
+                        (:instance only-0-is-0-or-negative-exact (x a))
+;
+;                        trunc-non-neg
+                        ))))
+
+(local
+ (defthm trunc-monotone-old
+    (implies (and (rationalp x)
+		  (rationalp y)
+		  (integerp n)
+		  (>= x 0)
+		  (> n 0)
+		  (<= x y))
+	     (<= (trunc x n) (trunc y n)))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable abs-trunc
+                                      trunc-exactp-a trunc-exactp-c)
+		  :use ((:instance trunc-exactp-a)
+			(:instance trunc-upper-pos)
+			(:instance trunc-exactp-c (x y) (a (trunc x n))))))))
+
+;bad :linear rule; has a free var
+;disable, or not?
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                )
+           (<= (trunc x n) (trunc y n)))
+  :hints (("Goal" :in-theory (disable trunc-upper-pos)
+           :use (trunc-monotone-old 
+                 (:instance trunc-monotone-old (x (- y))
+                            (y (- x))))))
+  :rule-classes :linear)
+
+(defthmd trunc-pos-rewrite
+  (implies (and (>= x 0)
+                (rationalp x)
+                (integerp n))
+           (equal (trunc x n)
+                  (* (fl (* (expt 2 (- (1- n) (expo x))) x))
+                     (expt 2 (- (1+ (expo x)) n)))))
+  :hints (("goal" :in-theory (enable trunc sgn a15)
+           :use fp-abs)))
+
+(local
+ (defthm trunc-trunc-1
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (trunc (trunc x n) m)
+		(* (fl (* (expt 2 (- (1- m) (expo x)))
+			  (* (fl (* (expt 2 (- (1- n) (expo x))) x))
+			     (expt 2 (- (1+ (expo x)) n)))))
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable trunc-pos-rewrite)
+                              '( expo-trunc))
+		  :use (;(:instance trunc-pos)
+			(:instance expo-trunc)
+			(:instance expo-trunc (x (trunc x n)) (n m)))))))
+
+(local
+ (defthm trunc-trunc-2
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (trunc (trunc x n) m)
+		(* (fl (* (fl (* (expt 2 (- (1- n) (expo x))) x)) (expt 2 (- m n)))) 
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable EXPT-COMPARE-EQUAL)
+		  :use ((:instance trunc-trunc-1)
+			(:instance expt-split (r 2) (j (- (1- m) (expo x))) (i (- (1+ (expo x)) n))))))))
+
+(local
+ (defthm trunc-trunc-3
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (trunc (trunc x n) m)
+		(* (fl (/ (fl (* (expt 2 (- (1- n) (expo x))) x)) (expt 2 (- n m)))) 
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable expt-split expt-minus)
+		  :use ((:instance trunc-trunc-2))))))
+
+(local
+ (defthm trunc-trunc-4
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (> m 0)
+		  (>= n m))
+	     (= (trunc (trunc x n) m)
+		(* (fl (/ (* (expt 2 (- (1- n) (expo x))) x) (expt 2 (- n m)))) 
+		   (expt 2 (- (1+ (expo x)) m)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable fl/int-rewrite )
+           :use (
+                        (:instance trunc-trunc-3)
+			(:instance fl/int-rewrite 
+				   (x (* (expt 2 (- (1- n) (expo x))) x))
+				   (n (expt 2 (- n m)))))))))
+
+(local
+ (defthm trunc-trunc-5
+   (implies (and (rationalp x)
+                 (>= x 0)
+                 (integerp n)
+                 (integerp m)
+                 (> m 0)
+                 (>= n m))
+            (= (trunc (trunc x n) m)
+               (* (fl (* (expt 2 (- (1- m) (expo x))) x))
+                  (expt 2 (- (1+ (expo x)) m)))))
+   :rule-classes ()
+   :hints (("goal" :in-theory (enable expt-split expt-minus)
+            :use ((:instance trunc-trunc-4))))))
+
+(local
+ (defthm trunc-trunc-old
+    (implies (and ;(rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (integerp m)
+		  (>= n m))
+	     (equal (trunc (trunc x n) m)
+		    (trunc x m)))
+  :rule-classes ()
+  :hints (("goal" :use ((:instance trunc-trunc-5)
+                        (:instance TRUNC-POS-REWRITE (n m))
+                        )))))
+
+
+(defthm trunc-trunc
+  (implies (and (>= n m) ;what about other case?
+                (integerp n)
+                (integerp m)
+                )
+           (equal (trunc (trunc x n) m)
+                  (trunc x m)))
+  :hints (("goal" :use (trunc-trunc-old
+                        (:instance trunc-trunc-old (x (- x)))))))
+
+(local
+ (defthm plus-trunc-2
+  (implies (and (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (> y 0)
+                (integerp k)
+                (> k 0)
+                (= n (+ k (- (expo x) (expo y))))
+                (exactp x n))
+           (equal (+ x (trunc y k))
+                  (* (fl (* (+ x y) (expt 2 (- (1- k) (expo y)))))
+                     (expt 2 (- (1+ (expo y)) k)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable exactp2 trunc-pos-rewrite a15)
+                              '( fl+int-rewrite))
+           :use ((:instance fl+int-rewrite 
+                            (x (* y (expt 2 (- (1- k) (expo y)))))
+                            (n (* x (expt 2 (- (1- k) (expo y)))))))))))
+
+(defthm plus-trunc
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (= (+ x (trunc y k))
+              (trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (enable exactp2 trunc-pos-rewrite a15)
+           :use ((:instance plus-trunc-2)
+                 (:instance expo-monotone (y (+ x y)))))))
+
+(defthm trunc-plus-1
+    (implies (and (rationalp y)
+		  (> y 0)
+		  (integerp e)
+		  (< y (expt 2 e)))
+	     (< (expo y) e))
+  :rule-classes ()
+  :hints (("goal" :in-theory (disable expo)
+		  :use ((:instance expo-lower-bound (x y))
+			(:instance expt-strong-monotone (n (expo y)) (m e))))))
+
+(defthm trunc-plus-2
+  (implies (and (rationalp y)
+                (> y 0)
+                (integerp e)
+                (< y (expt 2 e)))
+           (< (+ (expt 2 e) y) (expt 2 (1+ e))))
+  :hints (("Goal" :in-theory (enable expt-split)))
+  :rule-classes ())
+
+#|
+;proved elsewhere?
+(defthm trunc-plus-3
+    (implies (and (rationalp y)
+		  (> y 0)
+		  (integerp e)
+		  (< y (expt 2 e)))
+	     (= (expo (+ (expt 2 e) y)) e))
+  :rule-classes ()
+  :hints (("goal"
+		  :use ((:instance expo-lower-bound (x (+ (expt 2 e) y)))
+			(:instance expo-upper-bound (x (+ (expt 2 e) y)))
+			(:instance trunc-plus-2)
+			(:instance expt-strong-monotone (n (expo (+ (expt 2 e) y))) (m (1+ e)))
+			(:instance expt-strong-monotone (n e) (m (1+ (expo (+ (expt 2 e) y)))))))))
+|#
+
+;a nice lemma?
+(defthm trunc-plus-4
+    (implies (and (rationalp y)
+		  (> y 0)
+		  (integerp e)
+		  (< y (expt 2 e))
+		  (integerp m)
+		  (> m 0)
+		  (integerp k)
+		  (> k 0)
+		  (<= m (1+ k)))
+	     (= (+ (expt 2 e) (trunc y k))
+		(trunc (+ (expt 2 e) y) (- (+ k e) (expo y)))))
+  :rule-classes ()
+  :hints (("goal" :in-theory (e/d (a15) (EXPO-COMPARISON-REWRITE-TO-BOUND))
+		  :use (
+                        (:instance trunc-plus-1)
+;			(:instance trunc-plus-3)
+			(:instance plus-trunc (x (expt 2 e)) )))))
+
+(defthm trunc-plus
+    (implies (and (rationalp y)
+		  (> y 0)
+		  (integerp e)
+		  (< y (expt 2 e))
+		  (integerp m)
+		  (> m 0)
+		  (integerp k)
+		  (> k 0)
+		  (<= m (1+ k)))
+	     (= (trunc (+ (expt 2 e) (trunc y k)) m)
+		(trunc (+ (expt 2 e) y) m)))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable EXPO-COMPARISON-REWRITE-TO-BOUND)
+		  :use ((:instance trunc-plus-4)
+			(:instance trunc-plus-1)
+;			(:instance trunc-trunc (x (+ (expt 2 e) y)) (n (- (+ k e) (expo y))))
+                        ))))
+
+(defthm trunc-n+k-1
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (= e (- (1+ (expo x)) n))
+		  (= y (- x (trunc x n))))
+	     (< y (expt 2 e)))
+  :rule-classes ()
+  :hints (("Goal"
+		  :use ((:instance trunc-diff-pos)))))
+
+(defthm trunc-n+k-2
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (not (= x (trunc x n)))
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (trunc (+ (expt 2 e) y) (1+ k))
+		(trunc (+ (expt 2 e) z) (1+ k))))
+  :rule-classes ()
+  :hints (("Goal"; :in-theory (disable expo)
+		  :use ((:instance trunc-n+k-1)
+			(:instance trunc-upper-pos)
+			(:instance trunc-plus (k n) (m (1+ k)))))))
+
+(defthm trunc-n+k-3
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (and (equal (trunc x n) (* (fl (* x (expt 2 (- e)))) (expt 2 e)))
+		  (equal (trunc x (+ n k)) (* (fl (* x (expt 2 (- k e)))) (expt 2 (- e k))))))
+    :hints (("Goal" :in-theory (enable trunc-pos-rewrite)))
+  :rule-classes ())
+
+(defthm trunc-n+k-4
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(* (- (fl (* x (expt 2 (- k e))))
+		      (* (expt 2 k) (fl (* x (expt 2 (- e))))))
+		   (expt 2 (- e k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable trunc-pos-rewrite a15))))
+
+(defthm trunc-n+k-5
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(* (fl (- (* x (expt 2 (- k e)))
+			  (* (expt 2 k) (fl (* x (expt 2 (- e)))))))
+		   (expt 2 (- e k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable   fl+int-rewrite)
+		  :use ((:instance trunc-n+k-4)
+			(:instance fl+int-rewrite 
+				   (x (* x (expt 2 (- k e)))) 
+				   (n (* (expt 2 k) (fl (* x (expt 2 (- e)))))))))))
+
+(defthm trunc-n+k-6
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(* (fl (* y (expt 2 (- k e))))
+		   (expt 2 (- e k)))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable trunc-pos-rewrite a15)
+		  :use ((:instance trunc-n+k-5)))))
+
+(defthm trunc-n+k-7
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(- (* (+ (expt 2 k) (fl (* y (expt 2 (- k e)))))
+		      (expt 2 (- e k)))
+		   (expt 2 e))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (enable a15 )
+		  :use ((:instance trunc-n+k-6)))))
+
+(defthm trunc-n+k-8
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(- (* (fl (+ (expt 2 k) (* y (expt 2 (- k e)))))
+		      (expt 2 (- e k)))
+		   (expt 2 e))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (disable  fl+int-rewrite)
+		  :use ((:instance trunc-n+k-7)
+			(:instance fl+int-rewrite (x (* y (expt 2 (- k e)))) (n (expt 2 k)))))))
+
+(defthm trunc-n+k-9
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(- (* (fl (* (expt 2 (- k e)) (+ y (expt 2 e))))
+		      (expt 2 (- e k)))
+		   (expt 2 e))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-n+k-8)
+			(:instance expt-split (r 2) (j e) (i (- k e)))))))
+
+(defthm trunc-n+k-10
+    (implies (and (rationalp y)
+		  (integerp e)
+		  (<= 0 y))
+	     (< 0 (+ y (expt 2 e))))
+  :rule-classes ())
+
+(defthm trunc-n+k-11
+    (implies (and (integerp k)
+		  (> k 0)
+		  (rationalp y)
+		  (> y 0)
+		  (integerp e)
+		  (= (expo (+ (expt 2 e) y)) e))
+	     (= (* (fl (* (expt 2 (- k e)) (+ y (expt 2 e))))
+		   (expt 2 (- e k)))
+		(trunc (+ (expt 2 e) y) (1+ k))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-n+k-10)
+			(:instance trunc-pos-rewrite (x (+ y (expt 2 e))) (n (1+ k)))))))
+
+(defthm trunc-n+k-12
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (not (= x (trunc x n)))
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(- (trunc (+ (expt 2 e) y) (1+ k))
+		   (expt 2 e))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-n+k-9)
+			(:instance trunc-n+k-1)
+			(:instance trunc-n+k-11)
+                        (:instance EXPO-X+2**K (x y) (k e))
+;			(:instance trunc-plus-3)
+			(:instance trunc-diff-pos)
+			(:instance trunc-upper-pos)))))
+
+(defthm trunc-n+k-13
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (not (= x (trunc x n)))
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+		  (= y (- x (trunc x n))))
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(- (* (sig (trunc (+ (expt 2 e) y) (1+ k))) (expt 2 e))
+		   (expt 2 e))))
+  :rule-classes ()
+  :hints (("Goal" :in-theory (e/d (sig a15) 
+                                  ())
+		  :use ((:instance trunc-n+k-12)
+			(:instance trunc-n+k-1)
+			(:instance trunc-n+k-11)
+                        (:instance EXPO-X+2**K (x y) (k e))
+;			(:instance trunc-plus-3)
+			(:instance trunc-diff-pos)
+			;(:instance trunc-pos)
+			(:instance trunc-upper-pos)))))
+
+(defthm trunc-n+k-14
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (not (= x (trunc x n)))
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+;		  (= y (- x (trunc x n))) ;removed by eric, had to mention y in
+;the hints
+                  )
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
+		   (expt 2 e))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-n+k-2 (y (- x (trunc x n))))
+			(:instance trunc-n+k-13 (y (- x (trunc x n))))))))
+
+(defthm trunc-n+k
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp k)
+		  (> k 0)
+		  (integerp n)
+		  (>= n k)
+		  (not (exactp x n))  		  ;;this isn't really needed, but it won't hurt me.
+		  (= e (- (1+ (expo x)) n))
+		  (= z (trunc (- x (trunc x n)) n))
+;		  (= y (- x (trunc x n))) ;removed
+                  )
+	     (= (- (trunc x (+ n k)) (trunc x n))
+		(* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
+		   (expt 2 e))))
+  :rule-classes ()
+  :hints (("Goal" :use ((:instance trunc-n+k-14)
+			(:instance trunc-exactp-b)))))
+
+
+ (defthm trunc-shift
+   (implies (integerp n)
+            (equal (trunc (* x (expt 2 k)) n)
+                   (* (trunc x n) (expt 2 k))))
+   :hints (("Goal" :cases ((integerp k))
+            :in-theory (set-difference-theories
+                        (enable sig trunc expt-split)
+                        '()))))
+
+;bad t-p rule? make rewrite too?
+(defthm trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription
+  :hints (("goal" :in-theory (set-difference-theories
+                              (enable trunc)
+                              '(EXPT-2-INTEGERP
+                                expt-2-positive-integer-type))
+           :use ((:instance expt-2-positive-integer-type (i (- (1+ (expo x)) n)))))))
+
+;prove a them about trunc of a power of 2?
+
+
+;add to lib?  (alternate form of plus-trunc)
+(defthm plus-trunc-alt
+  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp j)
+                )
+           (= (trunc (+ x y) j)
+              (+ x (trunc y (+ j (- (expo (+ x y))) (expo y))))))
+  :rule-classes ()
+  :hints (("goal" 
+           :use (:instance plus-trunc
+                           (k (+ j (- (expo (+ x y))) (expo y)))))))
+
+;add to lib?
+(defthm plus-trunc-corollary
+  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
+                (exactp x n)
+                (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp n)
+                )
+           (= (trunc (+ x y) n)
+              x))
+  :hints (("Goal"  :in-theory (e/d
+                               (expt-split expt-minus)
+                               ( TRUNC-TO-0-OR-FEWER-BITS
+                                 EXPO-COMPARISON-REWRITE-TO-BOUND
+                                 EXPT-COMPARE-EQUAL))
+           :use ((:instance only-0-is-0-or-negative-exact) 
+                             (:instance trunc-exactp-b)
+                              expo-of-sum-of-disjoint 
+                             (:instance expo<=
+                                        (x y)
+                                        (n (+ (EXPO X) (* -1 N))))
+                             (:instance trunc-to-0-or-fewer-bits (x y)
+                                        (n (+ N (EXPO Y) (* -1 (EXPO (+ X Y))))))
+                             (:instance plus-trunc-alt
+                                        (j n))))))
+
+(defthm trunc-exactp-c-eric
+    (implies (and (exactp a n)
+                  (<= (abs a) (abs x))
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a)
+		  )
+	     (<= (abs a) (abs (trunc x n))))
+  :hints (("goal" :in-theory (disable abs-trunc trunc-rewrite trunc-exactp-a)
+		  :use (trunc-exactp-c
+                        trunc-upper-bound
+;                        (:instance trunc-rarely-zero (k n))
+                        (:instance trunc-exactp-c (x (- x)) (a a))
+                        (:instance trunc-exactp-c (x x) (a (- a)))
+                        (:instance trunc-exactp-c (x (- x)) (a (- a))))))
+  :otf-flg t)
+
+(defthm trunc-goes-down-rewrite
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n))
+                )
+           (equal (< (trunc x n) x)
+                  (and (< 0 x)
+                       (not (exactp x n)))))
+  :otf-flg t
+  :hints (("Goal" :use (trunc-upper-bound
+                        trunc-exactp-b))))
+
+(defthm trunc-goes-up-rewrite
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n))
+                )
+           (equal (< x (trunc x n))
+                  (and (< x 0)
+                       (not (exactp x n)))))
+  :otf-flg t
+  :hints (("Goal" :in-theory (disable trunc-goes-down-rewrite)
+           :use ((:instance trunc-upper-bound (x (- x)))
+                 trunc-exactp-b))))
+
+
+
+
+;; (encapsulate () 
+ 
+;;   (local 
+;;    (defthm trunc-minus-specific
+;;      (equal (TRUNC (+ (* -1 X) (* -1 Y)) n)
+;;             (* -1 (trunc (+ x y) n)))
+;;      :hints (("Goal" :use ((:instance  trunc-minus
+;;                                        (x (+ (* -1 x)
+;;                                              (* -1 y)))))))))
+                   
+;;   (local 
+;;    (defthm expo-minus-specific
+;;      (equal (EXPO (+ (* -1 X) (* -1 Y)))
+;;             (expo (+ x y)))
+;;      :hints (("Goal" :use ((:instance  expo-minus
+;;                                        (x (+ (* -1 x)
+;;                                              (* -1 y)))))))))
+
+;;   (local 
+;;    (defthm away-minus-specific
+;;      (equal (away (+ (* -1 X) (* -1 Y)) n)
+;;             (* -1 (away (+ x y) n)))
+;;      :hints (("Goal" :use ((:instance  away-minus
+;;                                        (x (+ (* -1 x)
+;;                                              (* -1 y)))))))))
+
+
+;;   (local 
+;;    (defthm trunc-plus-minus-lemmma
+;;      (implies (and (rationalp x)
+;;                    (rationalp y)
+;;                    (> x 0)
+;;                    (not (= y 0))
+;;                    (not (= (+ x y) 0))
+;;                    (integerp k)
+;;                    (> k 0)
+;;                    (= k1 (+ k (- (expo x) (expo y))))
+;;                    (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+;;                    (exactp x k1)
+;;                    (> k2 0))
+;;               (equal (+ x (trunc y k))
+;;                      (if (= (sgn (+ x y)) (sgn y))
+;;                          (trunc (+ x y) k2)
+;;                        (away (+ x y) k2))))
+;;      :hints (("Goal" :cases ((< y 0))
+;;               :in-theory (enable sgn trunc-minus away-minus expo-minus))
+;;              ("Subgoal 2" :use ((:instance plus-trunc)))
+;;              ("Subgoal 1" :cases ((< (* -1 y) x)))
+;;              ("Subgoal 1.2" :use ((:instance minus-trunc-1
+;;                                              (y (* -1 y))
+;;                                              (n k1))))
+;;              ("Subgoal 1.1" :use ((:instance minus-trunc-2
+;;                                              (y (* -1 y))
+;;                                              (n k1)))))))
+
+;;   (defthm trunc-plus-minus
+;;     (implies (and (rationalp x)
+;;                   (rationalp y)
+;;                   (not (= x 0))
+;;                   (not (= y 0))
+;;                   (not (= (+ x y) 0))
+;;                   (integerp k)
+;;                   (> k 0)
+;;                   (= k1 (+ k (- (expo x) (expo y))))
+;;                   (= k2 (+ k (expo (+ x y)) (* -1 (expo y))))
+;;                   (exactp x k1)
+;;                   (> k2 0))
+;;              (equal (+ x (trunc y k))
+;;                     (if (= (sgn (+ x y)) (sgn y))
+;;                         (trunc (+ x y) k2)
+;;                       (away (+ x y) k2))))
+;;     :hints (("Goal" :cases ((not (< 0 x)))
+;;              :in-theory (enable sgn trunc-minus away-minus expo-minus))
+;;             ("Subgoal 2" :use ((:instance trunc-plus-minus-lemmma)))
+;;             ("Subgoal 1" :use ((:instance trunc-plus-minus-lemmma
+;;                                           (x (* -1 x))
+;;                                           (y (* -1 y)))))))
+
+;; )
diff -Nru acl2-6.2/books/rtl/rel9/support/support/trunc.lisp acl2-6.3/books/rtl/rel9/support/support/trunc.lisp
--- acl2-6.2/books/rtl/rel9/support/support/trunc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/trunc.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,502 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;;***************************************************************
+;;;an acl2 library of floating point arithmetic
+
+;;;david m. russinoff
+;;;advanced micro devices, inc.
+;;;february, 1998
+;;;***************************************************************
+
+;some of the things in this book may be cruft which can be deleted...
+
+(include-book "ground-zero")
+(local (include-book "trunc-proofs"))
+
+;;Necessary defuns
+
+(defund fl (x)
+  (declare (xargs :guard (real/rationalp x)))
+  (floor x 1))
+
+(defun expo-measure (x)
+;  (declare (xargs :guard (and (real/rationalp x) (not (equal x 0)))))
+  (cond ((not (rationalp x)) 0)
+	((< x 0) '(2 . 0))
+	((< x 1) (cons 1 (fl (/ x))))
+	(t (fl x))))
+
+(defund expo (x)
+  (declare (xargs :guard t
+                  :measure (expo-measure x)))
+  (cond ((or (not (rationalp x)) (equal x 0)) 0)
+	((< x 0) (expo (- x)))
+	((< x 1) (1- (expo (* 2 x))))
+	((< x 2) 0)
+	(t (1+ (expo (/ x 2))))))
+
+;could redefine to divide by the power of 2 (instead of making it a negative power of 2)...
+(defund sig (x)
+  (declare (xargs :guard t))
+  (if (rationalp x)
+      (if (< x 0)
+          (- (* x (expt 2 (- (expo x)))))
+        (* x (expt 2 (- (expo x)))))
+    0))
+
+;make defund?
+(defun sgn (x)
+  (declare (xargs :guard t))
+  (if (or (not (rationalp x)) (equal x 0))
+      0
+    (if (< x 0)
+        -1
+      1)))
+
+(defund exactp (x n)
+;  (declare (xargs :guard (and (real/rationalp x) (integerp n))))
+  (integerp (* (sig x) (expt 2 (1- n)))))
+
+
+;;
+;; New stuff:
+;;
+
+(defund trunc (x n)
+  (declare (xargs :guard (integerp n)))
+  (* (sgn x) (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n))))
+
+;generated automatically by ACL2 when we define trunc, but included here just to be safe could have disabled
+;(:type-prescription trunc) for slight efficiency gain at the cost of making the output of :pe a little
+;deceptive
+(defthm trunc-rational-type-prescription
+  (rationalp (trunc x n))
+  :rule-classes :type-prescription)
+
+(defthm trunc-of-non-rationalp-is-0
+  (implies (not (rationalp x))
+           (equal (trunc x n)
+                  0)))
+
+(defthm trunc-to-0-or-fewer-bits
+  (implies (and (<= n 0)
+                (integerp n)
+                )
+           (equal (trunc x n)
+                  0)))
+
+;make alt version? use negative-syntaxp?
+(defthm trunc-minus
+  (equal (trunc (* -1 x) n)
+         (* -1 (trunc x n))))
+
+;change what trunc does with n not a positive int?
+(defthm trunc-positive
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n))
+                )
+           (< 0 (trunc x n)))
+  :rule-classes (:rewrite :linear))
+
+;I think this rule has caused the "bad-ass" problem regarding the (case-split (< 0 n)) hyp.
+;BOZO should this include rationalp, to have a more type-like conclusion?
+(defthm trunc-positive-rational-type-prescription
+  (implies (and (< 0 x)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< 0 (trunc x n)))
+  :rule-classes :type-prescription)
+
+(defthm trunc-negative
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n)))
+           (< (trunc x n) 0))
+  :rule-classes (:rewrite :linear))
+
+;BOZO should this include rationalp, to have a more type-like conclusion?
+(defthm trunc-negative-rational-type-prescription
+  (implies (and (< x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n))
+                )
+           (< (trunc x n) 0))
+  :rule-classes :type-prescription)
+
+(defthm trunc-0 
+  (equal (trunc 0 n) 
+         0))
+
+;trying the case-split
+(defthm trunc-of-non-rationalp-is-0-alt
+  (implies (case-split (not (rationalp x)))
+           (equal (trunc x n)
+                  0)))
+
+(defthm trunc-non-negative-rational-type-prescription
+  (implies (and (<= 0 x)
+                (case-split (integerp n))
+                )
+           (and (<= 0 (trunc x n))
+                (rationalp (trunc x n))))
+  :rule-classes :type-prescription)
+
+(defthm trunc-non-positive-rational-type-prescription
+  (implies (and (<= x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (and (<= (trunc x n) 0)
+                (rationalp (trunc x n))))
+  :rule-classes :type-prescription)
+
+;make an away version?
+(defthm trunc-non-negative-linear
+  (implies (and (<= 0 x)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (<= 0 (trunc x n)))
+  :rule-classes :linear)
+
+;make an away version?
+(defthm trunc-non-positive-linear
+  (implies (and (<= x 0)
+                (case-split (rationalp x))
+                (case-split (integerp n))
+                )
+           (<= (trunc x n) 0))
+  :rule-classes :linear)
+
+(defthm sgn-trunc
+  (implies (and (< 0 n)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (sgn (trunc x n))
+                  (sgn x))))
+
+
+;why not just open up trunc and sgn?
+;keep this disabled, since it basically opens up TRUNC
+(defthmd abs-trunc
+  (equal (abs (trunc x n))
+         (* (fl (* (expt 2 (1- n)) (sig x))) (expt 2 (- (1+ (expo x)) n)))))
+
+(defthm trunc-upper-bound
+  (implies (and (rationalp x)
+                (integerp n))
+           (<= (abs (trunc x n)) (abs x)))
+  :rule-classes :linear)
+
+;BOZO bad name. should be trunc-equal-0
+(defthm trunc-equal-0-rewrite
+  (implies (and (> n 0)
+                (rationalp x)
+                (integerp n)
+                )
+           (equal (equal (trunc x n) 0)
+                  (equal x 0))))
+
+(defthm trunc-upper-pos
+    (implies (and (<= 0 x)
+                  (rationalp x)
+		  (integerp n))
+	     (<= (trunc x n) x))
+    :rule-classes :linear)
+
+(defthm expo-trunc
+   (implies (and (< 0 n)
+                 (rationalp x)
+                 (integerp n)
+                 )
+            (equal (expo (trunc x n))
+                   (expo x))))
+
+;which of these do we want to export?
+(defthm trunc-lower-1
+  (implies (and (rationalp x)
+                (integerp n))
+           (> (abs (trunc x n))
+              (- (abs x) (expt 2 (- (1+ (expo x)) n)))))
+  :rule-classes :linear)
+
+(defthm trunc-lower-2-1
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expt 2 (- (1+ (expo x)) n)) (* (abs x) (expt 2 (- 1 n)))))
+  :rule-classes ())
+
+(defthm trunc-lower-2
+    (implies (and (rationalp x)
+		  (not (= x 0))
+		  (integerp n)
+		  (> n 0))
+	     (> (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm trunc-lower-pos
+    (implies (and (rationalp x)
+		  (> x 0)
+		  (integerp n)
+		  (> n 0))
+	     (> (trunc x n) (* x (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm trunc-lower-3
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (abs (trunc x n)) (* (abs x) (- 1 (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm trunc-lower-4
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (>= (trunc x n) (- x (* (abs x) (expt 2 (- 1 n))))))
+  :rule-classes :linear)
+
+(defthm trunc-diff
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0))
+	     (< (abs (- x (trunc x n))) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-pos
+    (implies (and (rationalp x)
+		  (>= x 0)
+		  (integerp n)
+		  (> n 0))
+	     (< (- x (trunc x n)) (expt 2 (- (1+ (expo x)) n))))
+  :rule-classes ())
+
+(defthm trunc-diff-expo-1
+    (implies (and (rationalp x)
+		  (not (= x (trunc x n)))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+;just gets rid of sig...
+(defthmd trunc-rewrite
+    (implies (and (rationalp x)
+		  (integerp n)
+		  (> n 0) ;gen?  this isn't in pos-rewrite!
+                  )
+	     (equal (trunc x n)
+		    (* (sgn x) 
+		       (fl (* (expt 2 (- (1- n) (expo x))) (abs x))) 
+		       (expt 2 (- (1+ (expo x)) n))))))
+
+(defthm trunc-exactp-b
+  (implies (and (rationalp x)
+                (integerp n) 
+                (> n 0))
+           (iff (= x (trunc x n))
+                (exactp x n)))
+  :rule-classes ())
+
+(defthm trunc-diff-expo
+    (implies (and (rationalp x)
+		  (not (exactp x n))
+		  (integerp n)
+		  (> n 0))
+	     (<= (expo (- x (trunc x n))) (- (expo x) n)))
+  :rule-classes ())
+
+;improve by concluding (exactp (trunc x n) m+) if m+ >= m ??
+(defthm trunc-exactp-a
+  (exactp (trunc x n) n))
+
+(defthmd trunc-exactp-c
+  (implies (and (exactp a n)
+                (<= a x)
+                (rationalp x)
+                (integerp n)
+                (rationalp a)
+                )
+           (<= a (trunc x n))))
+
+(defthm trunc-exactp-c-eric
+    (implies (and (exactp a n)
+                  (<= (abs a) (abs x))
+                  (rationalp x)
+		  (integerp n)
+		  (rationalp a)
+		  )
+	     (<= (abs a) (abs (trunc x n)))))
+
+;bad :linear rule; has a free var
+;disable, or not?
+(defthmd trunc-monotone
+  (implies (and (<= x y)
+                (rationalp x)
+                (rationalp y)
+                (integerp n)
+                )
+           (<= (trunc x n) (trunc y n)))
+  :rule-classes :linear)
+
+(defthmd trunc-pos-rewrite
+  (implies (and (>= x 0)
+                (rationalp x)
+                (integerp n))
+           (equal (trunc x n)
+                  (* (fl (* (expt 2 (- (1- n) (expo x))) x))
+                     (expt 2 (- (1+ (expo x)) n))))))
+
+(defthm trunc-trunc
+  (implies (and (>= n m) ;what about other case?
+                (integerp n)
+                (integerp m)
+                )
+           (equal (trunc (trunc x n) m)
+                  (trunc x m))))
+
+(defthm plus-trunc
+  (implies (and (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp k)
+                (exactp x (+ k (- (expo x) (expo y)))))
+           (= (+ x (trunc y k))
+              (trunc (+ x y) (+ k (- (expo (+ x y)) (expo y))))))
+  :rule-classes ())
+
+(defthm trunc-plus
+    (implies (and (rationalp y)
+		  (> y 0)
+		  (integerp e)
+		  (< y (expt 2 e))
+		  (integerp m)
+		  (> m 0)
+		  (integerp k)
+		  (> k 0)
+		  (<= m (1+ k)))
+	     (= (trunc (+ (expt 2 e) (trunc y k)) m)
+		(trunc (+ (expt 2 e) y) m)))
+  :rule-classes ())
+
+;what's the purpose of this one?
+(defthm trunc-n+k
+  (implies (and (rationalp x)
+                (> x 0)
+                (integerp k)
+                (> k 0)
+                (integerp n)
+                (>= n k)
+                (not (exactp x n)) ;;this isn't really needed, but it won't hurt me.
+                (= e (- (1+ (expo x)) n))
+                (= z (trunc (- x (trunc x n)) n))
+;		  (= y (- x (trunc x n))) ;removed
+                )
+           (= (- (trunc x (+ n k)) (trunc x n))
+              (* (1- (sig (trunc (+ (expt 2 e) z) (1+ k))))
+                 (expt 2 e))))
+  :rule-classes ())
+
+ (defthm trunc-shift
+   (implies (integerp n)
+            (equal (trunc (* x (expt 2 k)) n)
+                   (* (trunc x n) (expt 2 k)))))
+
+;bad t-p rule? make rewrite too?
+(defthm trunc-integer-type-prescription
+  (implies (and (>= (expo x) n)
+                (case-split (integerp n))
+                )
+           (integerp (trunc x n)))
+  :rule-classes :type-prescription)
+
+;prove a them about trunc of a power of 2?
+
+
+;add to lib?  (alternate form of plus-trunc)
+(defthm plus-trunc-alt
+  (implies (and (exactp x (+ j (expo x) (- (expo (+ x y)))))
+                (rationalp x)
+                (>= x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp j)
+                )
+           (= (trunc (+ x y) j)
+              (+ x (trunc y (+ j (- (expo (+ x y))) (expo y))))))
+  :rule-classes ())
+
+;add to lib?
+(defthm plus-trunc-corollary
+  (implies (and (< y (expt 2 (- (1+ (expo x)) n)))
+                (exactp x n)
+                (rationalp x)
+                (> x 0)
+                (rationalp y)
+                (>= y 0)
+                (integerp n)
+                )
+           (= (trunc (+ x y) n)
+              x)))
+
+(defthm trunc-with-n-not-an-integer
+  (implies (not (integerp n))
+           (equal (trunc x n)
+                  (if (acl2-numberp n)
+                      (sgn x)
+                    0))))
+
+;do we want these enabled?
+
+(defthm trunc-goes-down-rewrite
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n))
+                )
+           (equal (< (trunc x n) x)
+                  (and (< 0 x)
+                       (not (exactp x n))))))
+
+(defthm trunc-goes-up-rewrite
+  (implies (and (case-split (rationalp x))
+                (case-split (integerp n))
+                (case-split (< 0 n))
+                )
+           (equal (< x (trunc x n))
+                  (and (< x 0)
+                       (not (exactp x n))))))
+
+
diff -Nru acl2-6.2/books/rtl/rel9/support/support/util.lisp acl2-6.3/books/rtl/rel9/support/support/util.lisp
--- acl2-6.2/books/rtl/rel9/support/support/util.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/support/util.lisp	2013-09-30 17:53:25.000000000 +0000
@@ -0,0 +1,147 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+;;These macros facilitate localization of events:
+
+(defmacro local-defun (&rest body)
+  (list 'local (cons 'defun body)))
+
+(defmacro local-defund (&rest body)
+  (list 'local (cons 'defund body)))
+
+(defmacro local-defthm (&rest body)
+  (list 'local (cons 'defthm body)))
+
+(defmacro local-defthmd (&rest body)
+  (list 'local (cons 'defthmd body)))
+
+(defmacro local-in-theory (&rest body)
+  (cons 'local
+	(cons (cons 'in-theory (append body 'nil))
+	      'nil)))
+
+(defmacro defbvecp (name formals width &key thm-name hyp hints)
+  (let* ((thm-name
+          (or thm-name
+              (intern-in-package-of-symbol
+               (concatenate 'string
+                            (if (consp width)
+                                "BV-ARRP$"
+                              "BVECP$")
+                            (symbol-name name))
+               name)))
+         (x (cons name formals))
+         (typed-term (if (consp width)
+                         (list 'ag 'index x)
+                       x))
+         (bvecp-concl (if (consp width)
+                          (list 'bv-arrp x (car (last width)))
+                        (list 'bvecp x width)))
+         (concl (list 'and
+                      (list 'integerp typed-term)
+                      (list '<= 0 typed-term))))
+    (list* 'defthm thm-name
+           (if hyp
+               (list 'implies hyp bvecp-concl)
+             bvecp-concl)
+           :rule-classes
+           (list
+            :rewrite
+            (list :forward-chaining :trigger-terms (list x))
+            (list :type-prescription
+                  :corollary
+                  (if hyp
+                      (list 'implies hyp concl)
+                    concl)
+                  :typed-term typed-term
+                  ;; hints for the corollary 
+                  :hints
+                  (if (consp width)
+                      '(("Goal"
+                         :in-theory
+                         '(implies bvecp
+                                   bv-arrp-implies-nonnegative-integerp)))
+                    '(("Goal"
+                       :in-theory
+                       '(implies bvecp))))))
+           (if hints (list :hints hints) nil))))
+
+(defun sub1-induction (n)
+      (if (zp n)
+          n
+        (sub1-induction (1- n))))
+
+; These will be the functions to disable in acl2 proofs about signal bodies.
+; We use this in the compiler.
+;BOZO This doesn't include cons, which can now appear in signals defs.  I think that's okay, right?  think
+;about this and remove the BOZO
+(defconst *rtl-operators-after-macro-expansion*
+  '(log= log<> 
+    log< log<= log> log>= 
+    comp2< comp2<= comp2> comp2>=
+    land lior lxor lnot
+    logand1 logior1 logxor1
+    shft
+    cat mulcat
+    bits bitn setbits setbitn 
+    ag as
+    * + ; from macroexpansion of mod* or mod+
+    ;mod- ;now a macro!
+    floor rem decode encode
+    ;; bind ; handled specially in fixup-term
+    ;; if1 ;  a macro, so we don't disable it
+    ;; quote, n!, arr0 ; handled specially in fixup-term
+    natp1 ; doesn't matter, only occurs in for-loop defuns (must be enabled in those proofs anyway)
+    mk-bvarr mk-bvec
+    ))
+
+; Macro fast-and puts conjunctions in a tree form, which can avoid stack
+; overflows by ACL2's translate functions.
+
+(defun split-list (lst lo hi)
+  (cond ((endp lst) 
+         (mv lo hi))
+        ((endp (cdr lst)) 
+         (mv (cons (car lst) lo) hi))
+        (t
+         (split-list (cddr lst)
+                     (cons (car lst) lo)
+                     (cons (cadr lst) hi)))))
+
+(defun fast-and-fn (conjuncts)
+  (declare (xargs :mode :program))
+  (cond ((endp conjuncts) ''t)
+        ((endp (cdr conjuncts)) (car conjuncts))
+        (t
+         (mv-let (hi lo)
+             (split-list conjuncts () ())
+           (list 'if
+                 (fast-and-fn hi)
+                 (fast-and-fn lo)
+                 'nil)))))
+
+(defmacro fast-and (&rest conjuncts)
+  (fast-and-fn conjuncts))
diff -Nru acl2-6.2/books/rtl/rel9/support/top/Makefile acl2-6.3/books/rtl/rel9/support/top/Makefile
--- acl2-6.2/books/rtl/rel9/support/top/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/top/Makefile	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,5 @@
+include ../../../../Makefile-generic
+
+# BOOKS = top
+# Dependencies:
+-include Makefile-deps
diff -Nru acl2-6.2/books/rtl/rel9/support/top/top.lisp acl2-6.3/books/rtl/rel9/support/top/top.lisp
--- acl2-6.2/books/rtl/rel9/support/top/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/rtl/rel9/support/top/top.lisp	2013-09-30 17:53:24.000000000 +0000
@@ -0,0 +1,90 @@
+; RTL - A Formal Theory of Register-Transfer Logic and Computer Arithmetic 
+; Copyright (C) 1995-2013 Advanced Mirco Devices, Inc. 
+;
+; Contact:
+;   David Russinoff
+;   1106 W 9th St., Austin, TX 78703
+;   http://www.russsinoff.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+; PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; see the file "gpl.txt" in this directory.  If not, write to the
+; Free Software Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA
+; 02110-1335, USA.
+;
+; Author: David M. Russinoff (david@russinoff.com)
+
+(in-package "ACL2")
+
+(set-enforce-redundancy t)
+
+; Optionally, one may wish to consider:
+; (include-book "../../../misc/rtl-untranslate")
+; to inhibit expansion of macros in proof output.
+
+; We deliberately exclude any *-helpers.lisp books that may appear here.
+
+(include-book "../lib3/rtl") ;semantics of the basic RTL primitives
+
+(include-book "../lib3/rtlarr") ;semantics RTL array primitives
+
+(include-book "../lib3.delta2/basic") ;properties of basic arithmetic functions: floor, ceiling, 
+;                       exponential, and remainder;;  Wed Feb  4 16:40:37 2009
+
+(include-book "../lib3.delta2/bits") ;bit vectors ;; Tue Feb 24 09:33:20 2009
+
+
+(include-book "../lib3.delta2/log") ;logical operations ;; Tue Feb 24 09:33:47 2009
+
+(include-book "../lib3.delta2/float") ;floating-point numbers
+
+(include-book "../lib3.delta2/reps") ;floating-point formats and representations
+
+(include-book "../lib3.delta2/round") ;floating-point rounding
+
+(include-book "../lib3.delta2/add") ;support for reasoning about floating-point addition
+;                      (leading one prediction and sticky bit computation)
+
+; Users may prefer to replace the (include-book "arith") below with:
+; (include-book "../arithmetic/top")
+
+(include-book "../lib3.delta2/mult")  ; integerp multiplier
+
+; (include-book "../lib3/arith") ;general arithmetic package
+
+;
+; let go Thu Feb 19 09:43:32 2009
+
+(include-book "../lib3/util") ;misc helpful stuff including a few macros
+
+
+(include-book "../lib3.delta2/bvecp-raw-helpers")  
+;; ; better bvecp-raw-helpers.lisp, Fri Jun 29 10:13:32 2007
+
+(include-book "../lib3.delta2/simple-loop-helpers")  
+
+(include-book "../lib3.delta2/rom-helpers")  
+
+
+(include-book "../lib3/bvecp-helpers")
+
+(include-book "../lib3.delta2/logn")
+
+(include-book "../lib3.delta2/simplify-model-helpers")
+
+
+(include-book "../lib3.delta2/logn2log")
+
+
+(include-book "../lib3.delta1/srt")
+
+(include-book "../lib3.delta1/sqrt66")
+
diff -Nru acl2-6.2/books/security/util/byte-operations.lisp acl2-6.3/books/security/util/byte-operations.lisp
--- acl2-6.2/books/security/util/byte-operations.lisp	2013-06-06 17:11:48.000000000 +0000
+++ acl2-6.3/books/security/util/byte-operations.lisp	2013-09-30 17:53:15.000000000 +0000
@@ -78,11 +78,20 @@
 ; Verifies if the input is a bit (0 or 1)
 ;
 
-(defun bitp(e)
-  (if (consp e)
-      nil
-      (or (equal e 0)
-          (equal e 1))))
+; Deleted by Matt K. on 6/10/2013 because bitp is defined in
+; ihs/basic-definitions.lisp, which is now included under centaur/gl/gl.lisp,
+; and both the latter book and this one are included in ../des/des.lisp
+; (defun bitp(e)
+;   (if (consp e)
+;       nil
+;       (or (equal e 0)
+;           (equal e 1))))
+; So here is the definition from ihs/basic-definitions.lisp:
+(defun-inline bitp (b)
+; Doc string omitted here.
+  (declare (xargs :guard t))
+  (or (eql b 0)
+      (eql b 1)))
 
 ;
 ; Computes the logical XOR of two single bits
diff -Nru acl2-6.2/books/std/alists/alist-defuns.lisp acl2-6.3/books/std/alists/alist-defuns.lisp
--- acl2-6.2/books/std/alists/alist-defuns.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/alist-defuns.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -48,15 +48,15 @@
         (t
          (cons (cdar x) (alist-vals (cdr x))))))
 
-(defund hons-rassoc-equal (val map)
+(defund hons-rassoc-equal (val alist)
   (declare (xargs :guard t))
-  (cond ((atom map)
+  (cond ((atom alist)
          nil)
-        ((and (consp (car map))
-              (equal val (cdar map)))
-         (car map))
+        ((and (consp (car alist))
+              (equal val (cdar alist)))
+         (car alist))
         (t
-         (hons-rassoc-equal val (cdr map)))))
+         (hons-rassoc-equal val (cdr alist)))))
 
 (defund alists-agree (keys al1 al2)
   "Do AL1 and AL2 agree on the value of every KEY in KEYS?"
diff -Nru acl2-6.2/books/std/alists/alist-equiv.lisp acl2-6.3/books/std/alists/alist-equiv.lisp
--- acl2-6.2/books/std/alists/alist-equiv.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/alist-equiv.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -26,9 +26,11 @@
 (local (include-book "../lists/sets"))
 
 (defsection alists-agree
+  :parents (std/alists)
+  :short "@(call alists-agree) determines if the alists @('al1') and @('al2')
+agree on the value of every key in @('keys')."
 
   (defund alists-agree (keys al1 al2)
-    "Do AL1 and AL2 agree on the value of every KEY in KEYS?"
     (declare (xargs :guard t))
     (or (atom keys)
         (and (equal (hons-get (car keys) al1)
@@ -83,11 +85,14 @@
 
 
 (defsection sub-alistp
+  :parents (std/alists)
+  :short "@(call sub-alistp) determines whether every @('key') bound in the
+alist @('a') is also bound to the same value in the alist @('b')."
 
   (defund sub-alistp (a b)
-    "Is every key bound in A also bound to the same value in B?"
     (declare (xargs :guard t))
-    (mbe :logic (alists-agree (alist-keys a) a b)
+    (mbe :logic
+         (alists-agree (alist-keys a) a b)
          :exec
          (with-fast-alist a
            (with-fast-alist b
@@ -140,11 +145,20 @@
                              (a y) (b z)))))))
 
 
-
 (defsection alist-equiv
+  :parents (std/alists)
+  :short "@(call alist-equiv) determines whether the alists @('a') and @('b')
+are equivalent up to @(see hons-assoc-equal), i.e., whether they bind the same
+value to every key."
+
+  :long "<p>This is a fundamental equivalence relation for alists.  It allows
+you to consider the equivalence of alists regardless of the order of their
+elements, the presence of shadowed elements, etc.</p>
+
+<p>Note that @(see list-equiv) is a @(see refinement) of @(see
+alist-equiv).</p>"
 
   (defund alist-equiv (a b)
-    "Do A and B agree on the values of every key?"
     (declare (xargs :guard t))
     (mbe :logic (and (sub-alistp a b)
                      (sub-alistp b a))
@@ -177,16 +191,71 @@
       (implies (alist-equiv x y)
                (alists-agree keys x y))))
 
+
+  (defsection alist-equiv-refines-list-equiv
+
+    (local (defthm l0
+             (equal (alists-agree keys (list-fix al1) al2)
+                    (alists-agree keys al1 al2))
+             :hints(("Goal" :in-theory (enable alists-agree)))))
+
+    (local (defthm l1
+             (equal (alists-agree keys al1 (list-fix al2))
+                    (alists-agree keys al1 al2))
+             :hints(("Goal" :in-theory (enable alists-agree)))))
+
+    (local (defthm l2
+             (equal (sub-alistp (list-fix x) y)
+                    (sub-alistp x y))
+             :hints(("Goal" :in-theory (enable sub-alistp)))))
+
+    (local (defthm l3
+             (equal (sub-alistp x (list-fix y))
+                    (sub-alistp x y))
+             :hints(("Goal" :in-theory (enable sub-alistp)))))
+
+    (local (defcong list-equiv equal (sub-alistp x y) 1
+             ;; This seems nice but can just be local, because above we showed
+             ;; that sub-alistp has an alist-equiv congruence here, which
+             ;; combines with the refinement relation we show below.
+             :hints(("Goal"
+                     :in-theory (e/d (list-equiv) (l2))
+                     :use ((:instance l2 (x x))
+                           (:instance l2 (x x-equiv)))))))
+
+    (local (defcong list-equiv equal (sub-alistp x y) 2
+             ;; Similarly this seems nice but is redundant after we get the
+             ;; refinement proved.
+             :hints(("Goal"
+                     :in-theory (e/d (list-equiv) (l3))
+                     :use ((:instance l3 (y y))
+                           (:instance l3 (y y-equiv)))))))
+
+    (defrefinement list-equiv alist-equiv
+      :hints(("Goal" :in-theory (enable alist-equiv))))))
+
+
+(defsection basic-alist-equiv-congruences
+  :parents (alist-equiv)
+  :short "Some @(see congruence) rules about @(see alist-equiv) for basic alist
+functions."
+
   (defcong alist-equiv equal (hons-assoc-equal x a) 2
     :hints (("goal"
+             :in-theory (enable alist-equiv alists-agree)
              :use ((:instance alist-equiv-means-all-keys-agree
                               (keys (list x)) (x a) (y a-equiv)))))))
 
 
 (defsection alist-equiv-bad-guy
+  :parents (alist-equiv)
+  :short "@(call alist-equiv-bad-guy) finds some key, if one exists, that
+differs between the alists @('al1') and @('al2')."
+
+  :long "<p>This is generally useful for doing pick-a-point style reasoning
+about alist equivalence.</p>"
 
   (defchoose alist-equiv-bad-guy (bg) (al1 al2)
-    ;; Find some key, if one exists, that differs between alists AL1 and AL2.
     (not (equal (hons-assoc-equal bg al1)
                 (hons-assoc-equal bg al2))))
 
@@ -250,122 +319,76 @@
                                     (alist-equiv))))))
 
 
-(defcong alist-equiv equal (alists-agree keys a b) 2
-  :hints (("goal" :in-theory (enable alists-agree))))
+(defsection more-congruences
+  :extension basic-alist-equiv-congruences
 
-(defcong alist-equiv equal (alists-agree keys a b) 3
-  :hints (("goal" :in-theory (enable alists-agree))))
+  (defcong alist-equiv equal (alists-agree keys a b) 2
+    :hints (("goal" :in-theory (enable alists-agree))))
 
+  (defcong alist-equiv equal (alists-agree keys a b) 3
+    :hints (("goal" :in-theory (enable alists-agree))))
 
-; Note that there is no similar equivalence for alist-vals, because shadowed
-; values play a role in alist-vals but not in alist-equiv.  For instance, here
-; is an example where equivalent alists have different alist-vals:
-
-#||
- (set-slow-alist-action nil)
- (let ((x '((a . 1) (a . 5)))
-       (y '((a . 1))))
-   (implies (alist-equiv x y)
-            (set-equiv (alist-vals x)
-                       (alist-vals y))))
-||#
-
-(defcong alist-equiv equal (sub-alistp x y) 1
-  :hints(("Goal"
-          :in-theory (enable alist-equiv sub-alistp-trans)
-          :cases ((sub-alistp x y)))))
-
-(defcong alist-equiv equal (sub-alistp x y) 2
-  :hints(("Goal"
-          :in-theory (enable alist-equiv sub-alistp-trans)
-          :cases ((sub-alistp x y)))))
 
-(defsection alist-equiv-refines-list-equiv
+  (defcong alist-equiv equal (sub-alistp x y) 1
+    :hints(("Goal"
+            :in-theory (enable alist-equiv sub-alistp-trans)
+            :cases ((sub-alistp x y)))))
 
-  (local (defthm l0
-           (equal (alists-agree keys (list-fix al1) al2)
-                  (alists-agree keys al1 al2))
-           :hints(("Goal" :in-theory (enable alists-agree)))))
-
-  (local (defthm l1
-           (equal (alists-agree keys al1 (list-fix al2))
-                  (alists-agree keys al1 al2))
-           :hints(("Goal" :in-theory (enable alists-agree)))))
-
-  (local (defthm l2
-           (equal (sub-alistp (list-fix x) y)
-                  (sub-alistp x y))
-           :hints(("Goal" :in-theory (enable sub-alistp)))))
-
-  (local (defthm l3
-           (equal (sub-alistp x (list-fix y))
-                  (sub-alistp x y))
-           :hints(("Goal" :in-theory (enable sub-alistp)))))
-
-  (local (defcong list-equiv equal (sub-alistp x y) 1
-           ;; This seems nice but can just be local, because above we showed
-           ;; that sub-alistp has an alist-equiv congruence here, which
-           ;; combines with the refinement relation we show below.
-           :hints(("Goal"
-                   :in-theory (e/d (list-equiv) (l2))
-                   :use ((:instance l2 (x x))
-                         (:instance l2 (x x-equiv)))))))
-
-  (local (defcong list-equiv equal (sub-alistp x y) 2
-           ;; Similarly this seems nice but is redundant after we get the
-           ;; refinement proved.
-           :hints(("Goal"
-                   :in-theory (e/d (list-equiv) (l3))
-                   :use ((:instance l3 (y y))
-                         (:instance l3 (y y-equiv)))))))
-
-  (defrefinement list-equiv alist-equiv
-    :hints(("Goal" :in-theory (enable alist-equiv)))))
-
-
-#||
-
-;; With the refinement in place, ACL2 will now complain if we try to submit any
-;; of these, because they're implied by the above stronger congruences about
-;; alist-equiv.
-
- (defcong list-equiv equal (alists-agree keys x y) 2)
- (defcong list-equiv equal (alists-agree keys x y) 3)
- (defcong list-equiv equal (sub-alistp x y) 1)
- (defcong list-equiv equal (sub-alistp x y) 2)
-
-||#
-
-(defsection alist-keys-set-equivalence
-
-  (local (defthm l1
-           (implies (and (subsetp keys (alist-keys x))
-                         (alist-equiv x y))
-                    (subsetp keys (alist-keys y)))
-           :hints(("Goal" :induct (len keys)))))
-
-  (local (defthm l2
-           (implies (alist-equiv x y)
-                    (subsetp (alist-keys x) (alist-keys y)))
-           :hints(("Goal"
-                   :in-theory (disable l1)
-                   :use ((:instance l1 (keys (alist-keys x))))))))
-
-  (defcong alist-equiv set-equiv (alist-keys x) 1
-    :hints(("Goal" :in-theory (enable set-equiv)))))
-
-
-(defcong alist-equiv alist-equiv (cons a b) 2
-  :hints (("goal" :in-theory (enable alist-equiv-when-agree-on-bad-guy))))
-
-(defcong alist-equiv alist-equiv (append a b) 1
-  :hints(("Goal" :in-theory (enable alist-equiv-when-agree-on-bad-guy))))
-
-(defcong alist-equiv alist-equiv (append a b) 2
-  :hints(("Goal" :in-theory (enable alist-equiv-when-agree-on-bad-guy))))
-
-(defthm alist-equiv-append-atom
-  (implies (atom b)
-           (alist-equiv (append a b) a))
-  :hints(("Goal" :in-theory (enable alist-equiv-iff-agree-on-bad-guy)))
-  :rule-classes ((:rewrite :backchain-limit-lst 0)))
+  (defcong alist-equiv equal (sub-alistp x y) 2
+    :hints(("Goal"
+            :in-theory (enable alist-equiv sub-alistp-trans)
+            :cases ((sub-alistp x y)))))
+
+  #||
+
+;; With the refinement in place, ACL2 will now complain if we try to submit any ;
+;; of these, because they're implied by the above stronger congruences about ;
+;; alist-equiv. ;
+
+  (defcong list-equiv equal (alists-agree keys x y) 2)
+  (defcong list-equiv equal (alists-agree keys x y) 3)
+  (defcong list-equiv equal (sub-alistp x y) 1)
+  (defcong list-equiv equal (sub-alistp x y) 2)
+
+  ||#
+
+  (defsection alist-keys-set-equivalence
+
+    (local (defthm l1
+             (implies (and (subsetp keys (alist-keys x))
+                           (alist-equiv x y))
+                      (subsetp keys (alist-keys y)))
+             :hints(("Goal" :induct (len keys)))))
+
+    (local (defthm l2
+             (implies (alist-equiv x y)
+                      (subsetp (alist-keys x) (alist-keys y)))
+             :hints(("Goal"
+                     :in-theory (disable l1)
+                     :use ((:instance l1 (keys (alist-keys x))))))))
+
+    (defcong alist-equiv set-equiv (alist-keys x) 1
+      :hints(("Goal" :in-theory (enable set-equiv)))))
+
+; Note that there is no similar set-equivalence for alist-vals, because
+; shadowed values play a role in alist-vals but not in alist-equiv.  For
+; instance, here is an example where equivalent alists have different
+; alist-vals:
+
+  #||
+  (set-slow-alist-action nil)
+  (let ((x '((a . 1) (a . 5)))
+  (y '((a . 1))))
+  (implies (alist-equiv x y)
+  (set-equiv (alist-vals x)
+  (alist-vals y))))
+  ||#
+
+  (defcong alist-equiv alist-equiv (cons a b) 2
+    :hints (("goal" :in-theory (enable alist-equiv-when-agree-on-bad-guy))))
+
+  (defcong alist-equiv alist-equiv (append a b) 1
+    :hints(("Goal" :in-theory (enable alist-equiv-when-agree-on-bad-guy))))
+
+  (defcong alist-equiv alist-equiv (append a b) 2
+    :hints(("Goal" :in-theory (enable alist-equiv-when-agree-on-bad-guy)))))
diff -Nru acl2-6.2/books/std/alists/alist-keys.lisp acl2-6.3/books/std/alists/alist-keys.lisp
--- acl2-6.2/books/std/alists/alist-keys.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/alist-keys.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -23,104 +23,134 @@
 (include-book "std/lists/list-defuns" :dir :system)
 (local (include-book "std/lists/sets" :dir :system))
 
-(defund alist-keys (x)
-  (declare (xargs :guard t))
-  (cond ((atom x)
-         nil)
-        ((atom (car x))
-         (alist-keys (cdr x)))
-        (t
-         (cons (caar x) (alist-keys (cdr x))))))
-
-(local (in-theory (enable alist-keys)))
-
-(defthm alist-keys-when-atom
-  (implies (atom x)
-           (equal (alist-keys x)
-                  nil)))
-
-(defthm alist-keys-of-cons
-  (equal (alist-keys (cons a x))
-         (if (atom a)
-             (alist-keys x)
-           (cons (car a) (alist-keys x)))))
-
-(encapsulate
-  ()
-  (local (defthmd l0
-           (equal (alist-keys (list-fix x))
-                  (alist-keys x))))
-
-  (defcong list-equiv equal (alist-keys x) 1
-    :hints(("Goal"
-            :use ((:instance l0 (x x))
-                  (:instance l0 (x acl2::x-equiv)))))))
-
-(encapsulate
-  ()
-  (local (defthm l0
-           (implies (member (cons a b) x)
-                    (member a (alist-keys x)))))
-
-  (local (defthm l1
-           (implies (and (subsetp x y)
-                         (member a (alist-keys x)))
-                    (member a (alist-keys y)))))
-
-  (local (defthm l2
-           (implies (subsetp x y)
-                    (subsetp (alist-keys x)
-                             (alist-keys y)))))
-
-  (defcong set-equiv set-equiv (alist-keys x) 1
-    :hints(("Goal" :in-theory (enable set-equiv)))))
-
-
-(defthm true-listp-of-alist-keys
-  (true-listp (alist-keys x))
-  :rule-classes :type-prescription)
-
-(defthm alist-keys-of-hons-acons
-  (equal (alist-keys (hons-acons key val x))
-         (cons key (alist-keys x))))
-
-(defthm alist-keys-of-pairlis$
-  (equal (alist-keys (pairlis$ keys vals))
-         (list-fix keys)))
-
-
-
-(defthm alist-keys-member-hons-assoc-equal
-  (iff (member-equal x (alist-keys a))
-       (hons-assoc-equal x a))
-  :hints(("Goal" :in-theory (enable hons-assoc-equal))))
-
-(defthmd hons-assoc-equal-iff-member-alist-keys
-  (iff (hons-assoc-equal x a)
-       (member-equal x (alist-keys a)))
-  :hints (("goal" :in-theory (enable alist-keys-member-hons-assoc-equal))))
-
-(theory-invariant (incompatible (:rewrite alist-keys-member-hons-assoc-equal)
-                                (:rewrite hons-assoc-equal-iff-member-alist-keys)))
-
-(defthmd hons-assoc-equal-when-not-member-alist-keys
-  ;; BOZO any reason to have this one?
-  (implies (not (member-equal x (alist-keys a)))
-           (equal (hons-assoc-equal x a)
-                  nil))
-  :hints (("goal" :in-theory (enable alist-keys-member-hons-assoc-equal))))
-
-
-(defthm alist-keys-of-append
-  (equal (alist-keys (append x y))
-         (append (alist-keys x)
-                 (alist-keys y))))
-
-(defthm alist-keys-of-rev
-  (equal (alist-keys (rev x))
-         (rev (alist-keys x))))
-
-(defthm alist-keys-of-revappend
-  (equal (alist-keys (revappend x y))
-         (revappend (alist-keys x)
-                    (alist-keys y))))
+(defsection alist-keys
+  :parents (std/alists strip-cars)
+  :short "@(call alist-keys) collects all keys bound in an alist."
+
+  :long "<p>This is a \"modern\" equivalent of @(see strip-cars), which
+properly respects the non-alist convention; see @(see std/alists) for
+discussion of this convention.</p>
+
+<p>Note that the list of keys returned by @('alist-keys') may contain
+duplicates.  This happens whenever the input alist contains \"shadowed\"
+bindings, as in @('((a . 1) (a . 2))').</p>
+
+<h4>Note about Normal Forms</h4>
+
+<p>A key is a among the @('alist-keys') of an alist exactly when @(see
+hons-assoc-equal) is non-nil.  We generally prefer @('hons-assoc-equal') as the
+normal form, so the following rule is <b>enabled by default:</b>:</p>
+
+@(thm alist-keys-member-hons-assoc-equal)
+
+<p>However, sometimes the @('member')-based normal form works better when you
+want to tie into powerful set-reasoning strategies.  To support this, the
+following rule is available but is <b>disabled by default</b>:</p>
+
+@(thm hons-assoc-equal-iff-member-alist-keys)
+
+<p>Obviously these two rules loop, so a @(see theory-invariant) insists that
+you choose one or the other.  For greater compatibility between books, please
+do not non-@(see local)ly switch the normal form.</p>"
+
+  (defund alist-keys (x)
+    (declare (xargs :guard t))
+    (cond ((atom x)
+           nil)
+          ((atom (car x))
+           (alist-keys (cdr x)))
+          (t
+           (cons (caar x) (alist-keys (cdr x))))))
+
+  (local (in-theory (enable alist-keys)))
+
+  (defthm alist-keys-when-atom
+    (implies (atom x)
+             (equal (alist-keys x)
+                    nil)))
+
+  (defthm alist-keys-of-cons
+    (equal (alist-keys (cons a x))
+           (if (atom a)
+               (alist-keys x)
+             (cons (car a) (alist-keys x)))))
+
+  (encapsulate
+    ()
+    (local (defthmd l0
+             (equal (alist-keys (list-fix x))
+                    (alist-keys x))))
+
+    (defcong list-equiv equal (alist-keys x) 1
+      :hints(("Goal"
+              :use ((:instance l0 (x x))
+                    (:instance l0 (x acl2::x-equiv)))))))
+
+  (encapsulate
+    ()
+    (local (defthm l0
+             (implies (member (cons a b) x)
+                      (member a (alist-keys x)))))
+
+    (local (defthm l1
+             (implies (and (subsetp x y)
+                           (member a (alist-keys x)))
+                      (member a (alist-keys y)))))
+
+    (local (defthm l2
+             (implies (subsetp x y)
+                      (subsetp (alist-keys x)
+                               (alist-keys y)))))
+
+    (defcong set-equiv set-equiv (alist-keys x) 1
+      :hints(("Goal" :in-theory (enable set-equiv)))))
+
+
+  (defthm true-listp-of-alist-keys
+    (true-listp (alist-keys x))
+    :rule-classes :type-prescription)
+
+  (defthm alist-keys-of-hons-acons
+    ;; Silly, but just in case someone disables hons-acons
+    (equal (alist-keys (hons-acons key val x))
+           (cons key (alist-keys x))))
+
+  (defthm alist-keys-of-pairlis$
+    (equal (alist-keys (pairlis$ keys vals))
+           (list-fix keys)))
+
+  (defthm alist-keys-member-hons-assoc-equal
+    (iff (member-equal x (alist-keys a))
+         (hons-assoc-equal x a))
+    :hints(("Goal" :in-theory (enable hons-assoc-equal))))
+
+  (defthmd hons-assoc-equal-iff-member-alist-keys
+    (iff (hons-assoc-equal x a)
+         (member-equal x (alist-keys a)))
+    :hints (("goal" :in-theory (enable alist-keys-member-hons-assoc-equal))))
+
+  (theory-invariant (incompatible (:rewrite alist-keys-member-hons-assoc-equal)
+                                  (:rewrite hons-assoc-equal-iff-member-alist-keys)))
+
+
+  (defthmd hons-assoc-equal-when-not-member-alist-keys
+    ;; BOZO any reason to have this one?  It's disabled at least, so BOZO check
+    ;; if it's ever used and just delete it, if not.
+    (implies (not (member-equal x (alist-keys a)))
+             (equal (hons-assoc-equal x a)
+                    nil))
+    :hints (("goal" :in-theory (enable alist-keys-member-hons-assoc-equal))))
+
+  (defthm alist-keys-of-append
+    (equal (alist-keys (append x y))
+           (append (alist-keys x)
+                   (alist-keys y))))
+
+  (defthm alist-keys-of-rev
+    (equal (alist-keys (rev x))
+           (rev (alist-keys x))))
+
+  (defthm alist-keys-of-revappend
+    (equal (alist-keys (revappend x y))
+           (revappend (alist-keys x)
+                      (alist-keys y)))))
diff -Nru acl2-6.2/books/std/alists/alist-vals.lisp acl2-6.3/books/std/alists/alist-vals.lisp
--- acl2-6.2/books/std/alists/alist-vals.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/alist-vals.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -23,91 +23,102 @@
 (include-book "alist-keys")
 (local (include-book "std/lists/sets" :dir :system))
 
-(defund alist-vals (x)
-  (declare (xargs :guard t))
-  (cond ((atom x)
-         nil)
-        ((atom (car x))
-         (alist-vals (cdr x)))
-        (t
-         (cons (cdar x) (alist-vals (cdr x))))))
-
-(local (in-theory (enable alist-vals)))
-
-(defthm alist-vals-when-atom
-  (implies (atom x)
-           (equal (alist-vals x)
-                  nil)))
-
-(defthm alist-vals-of-cons
-  (equal (alist-vals (cons a x))
-         (if (consp a)
-             (cons (cdr a) (alist-vals x))
-           (alist-vals x))))
-
-(encapsulate
-  ()
-  (local (defthmd l0
-           (equal (alist-vals (list-fix x))
-                  (alist-vals x))))
-
-  (defcong list-equiv equal (alist-vals x) 1
-    :hints(("Goal"
-            :use ((:instance l0 (x x))
-                  (:instance l0 (x acl2::x-equiv)))))))
-
-(encapsulate
-  ()
-  (local (defthm l0
-           (implies (member (cons a b) x)
-                    (member b (alist-vals x)))))
-
-  (local (defthm l1
-           (implies (and (subsetp x y)
-                         (member a (alist-vals x)))
-                    (member a (alist-vals y)))))
-
-  (local (defthm l2
-           (implies (subsetp x y)
-                    (subsetp (alist-vals x)
-                             (alist-vals y)))))
-
-  (defcong set-equiv set-equiv (alist-vals x) 1
-    :hints(("Goal" :in-theory (enable set-equiv)))))
-
-(defthm true-listp-of-alist-vals
-  (true-listp (alist-vals x))
-  :rule-classes :type-prescription)
-
-(defthm alist-vals-of-hons-acons
-  (equal (alist-vals (hons-acons key val x))
-         (cons val (alist-vals x))))
-
-(defthm alist-vals-of-pairlis$
-  (implies (equal (len keys) (len vals))
-           (equal (alist-vals (pairlis$ keys vals))
-                  (list-fix vals))))
-
-(defthm len-of-alist-vals
-  (equal (len (alist-vals x))
-         (len (alist-keys x)))
-  :hints(("Goal" :in-theory (enable alist-keys alist-vals))))
-
-(defthm alist-vals-of-append
-  (equal (alist-vals (append x y))
-         (append (alist-vals x)
-                 (alist-vals y))))
-
-(defthm alist-vals-of-rev
-  (equal (alist-vals (rev x))
-         (rev (alist-vals x))))
-
-(defthm alist-vals-of-revappend
-  (equal (alist-vals (revappend x y))
-         (revappend (alist-vals x)
-                    (alist-vals y))))
-
-(defthm member-equal-of-cdr-when-hons-assoc-equal
-  (implies (hons-assoc-equal key map)
-           (member-equal (cdr (hons-assoc-equal key map))
-                         (alist-vals map))))
\ No newline at end of file
+(defsection alist-vals
+  :parents (std/alists strip-cdrs)
+  :short "@(call alist-vals) collects all values bound in an alist."
+
+  :long "<p>This is a \"modern\" equivalent of @(see strip-cdrs), which
+properly respects the non-alist convention; see @(see std/alists) for
+discussion of this convention.</p>
+
+<p>Note that the list of values returned by @('alist-vals') may include
+\"shadowed\" bindings, as in @('((a . 1) (a . 2))').</p>"
+
+  (defund alist-vals (x)
+    (declare (xargs :guard t))
+    (cond ((atom x)
+           nil)
+          ((atom (car x))
+           (alist-vals (cdr x)))
+          (t
+           (cons (cdar x) (alist-vals (cdr x))))))
+
+  (local (in-theory (enable alist-vals)))
+
+  (defthm alist-vals-when-atom
+    (implies (atom x)
+             (equal (alist-vals x)
+                    nil)))
+
+  (defthm alist-vals-of-cons
+    (equal (alist-vals (cons a x))
+           (if (consp a)
+               (cons (cdr a) (alist-vals x))
+             (alist-vals x))))
+
+  (encapsulate
+    ()
+    (local (defthmd l0
+             (equal (alist-vals (list-fix x))
+                    (alist-vals x))))
+
+    (defcong list-equiv equal (alist-vals x) 1
+      :hints(("Goal"
+              :use ((:instance l0 (x x))
+                    (:instance l0 (x acl2::x-equiv)))))))
+
+  (encapsulate
+    ()
+    (local (defthm l0
+             (implies (member (cons a b) x)
+                      (member b (alist-vals x)))))
+
+    (local (defthm l1
+             (implies (and (subsetp x y)
+                           (member a (alist-vals x)))
+                      (member a (alist-vals y)))))
+
+    (local (defthm l2
+             (implies (subsetp x y)
+                      (subsetp (alist-vals x)
+                               (alist-vals y)))))
+
+    (defcong set-equiv set-equiv (alist-vals x) 1
+      :hints(("Goal" :in-theory (enable set-equiv)))))
+
+  (defthm true-listp-of-alist-vals
+    (true-listp (alist-vals x))
+    :rule-classes :type-prescription)
+
+  (defthm alist-vals-of-hons-acons
+    (equal (alist-vals (hons-acons key val x))
+           (cons val (alist-vals x))))
+
+  (defthm alist-vals-of-pairlis$
+    (implies (equal (len keys) (len vals))
+             (equal (alist-vals (pairlis$ keys vals))
+                    (list-fix vals))))
+
+  (defthm len-of-alist-vals
+    (equal (len (alist-vals x))
+           (len (alist-keys x)))
+    :hints(("Goal" :in-theory (enable alist-keys alist-vals))))
+
+  (defthm alist-vals-of-append
+    (equal (alist-vals (append x y))
+           (append (alist-vals x)
+                   (alist-vals y))))
+
+  (defthm alist-vals-of-rev
+    (equal (alist-vals (rev x))
+           (rev (alist-vals x))))
+
+  (defthm alist-vals-of-revappend
+    (equal (alist-vals (revappend x y))
+           (revappend (alist-vals x)
+                      (alist-vals y))))
+
+  (defthm member-equal-of-cdr-when-hons-assoc-equal
+    (implies (hons-assoc-equal key map)
+             (member-equal (cdr (hons-assoc-equal key map))
+                           (alist-vals map)))))
diff -Nru acl2-6.2/books/std/alists/alistp.lisp acl2-6.3/books/std/alists/alistp.lisp
--- acl2-6.2/books/std/alists/alistp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/alistp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -25,77 +25,85 @@
 (local (include-book "../lists/rev"))
 (local (include-book "../lists/take"))
 (local (include-book "../lists/repeat"))
-
 (local (in-theory (enable alistp)))
 
-(defthm alistp-when-atom
-  (implies (atom x)
-           (equal (alistp x)
-                  (not x))))
-
-(defthm alistp-of-cons
-  (equal (alistp (cons a x))
-         (and (consp a)
-              (alistp x))))
-
-(defthm true-listp-when-alistp
-  (implies (alistp x)
-           (true-listp x))
-  :rule-classes :compound-recognizer)
-
-(defthm alistp-of-append
-  (equal (alistp (append x y))
-         (and (alistp (list-fix x))
-              (alistp y))))
-
-(defthm alistp-of-revappend
-  (equal (alistp (revappend x y))
-         (and (alistp (list-fix x))
-              (alistp y))))
-
-(defthm alistp-of-rev
-  (equal (alistp (rev x))
-         (alistp (list-fix x)))
-  :hints(("Goal" :induct (len x))))
-
-(defthm alistp-of-reverse
-  (equal (alistp (reverse x))
-         (and (not (stringp x))
-              (alistp (list-fix x))))
-  :hints(("Goal" :induct (len x))))
-
-(defthm alistp-of-cdr
-  (implies (alistp x)
-           (alistp (cdr x))))
-
-(defthm consp-of-car-when-alistp
-  (implies (alistp x)
-           (equal (consp (car x))
-                  (if x t nil))))
-
-(defthm alistp-of-member
-  (implies (alistp x)
-           (alistp (member a x))))
-
-(defthm alistp-of-repeat
-  (equal (alistp (repeat x n))
-         (or (zp n)
-             (consp x)))
-  :hints(("Goal" :in-theory (enable repeat))))
-
-(defthm alistp-of-take
-  (implies (alistp x)
-           (equal (alistp (take n x))
-                  (<= (nfix n) (len x))))
-  :hints(("Goal" :in-theory (enable take-redefinition))))
-
-(defthm alistp-of-nthcdr
-  (implies (alistp x)
-           (alistp (nthcdr n x))))
-
-(defthm alistp-of-delete-assoc-equal
-  (implies (alistp x)
-           (alistp (delete-assoc-equal key x))))
+(defsection std/alists/alistp
+  :parents (std/alists alistp)
+  :short "Lemmas about @(see alistp) available in the @(see std/alists)
+library."
+
+  :long "<p>Note that \"modern\" alist functions do not have @('alistp') guards
+and that theorems about them typically do not need any @('alistp') hypotheses.
+Accordingly, you may not really need to reason about @('alistp') at all.</p>"
+
+  (defthm alistp-when-atom
+    (implies (atom x)
+             (equal (alistp x)
+                    (not x))))
+
+  (defthm alistp-of-cons
+    (equal (alistp (cons a x))
+           (and (consp a)
+                (alistp x))))
+
+  (defthm true-listp-when-alistp
+    (implies (alistp x)
+             (true-listp x))
+    :rule-classes :compound-recognizer)
+
+  (defthm alistp-of-append
+    (equal (alistp (append x y))
+           (and (alistp (list-fix x))
+                (alistp y))))
+
+  (defthm alistp-of-revappend
+    (equal (alistp (revappend x y))
+           (and (alistp (list-fix x))
+                (alistp y))))
+
+  (defthm alistp-of-rev
+    (equal (alistp (rev x))
+           (alistp (list-fix x)))
+    :hints(("Goal" :induct (len x))))
+
+  (defthm alistp-of-reverse
+    (equal (alistp (reverse x))
+           (and (not (stringp x))
+                (alistp (list-fix x))))
+    :hints(("Goal" :induct (len x))))
+
+  (defthm alistp-of-cdr
+    (implies (alistp x)
+             (alistp (cdr x))))
+
+  (defthm consp-of-car-when-alistp
+    (implies (alistp x)
+             (equal (consp (car x))
+                    (if x t nil))))
+
+  (defthm alistp-of-member
+    (implies (alistp x)
+             (alistp (member a x))))
+
+  (defthm alistp-of-repeat
+    (equal (alistp (repeat x n))
+           (or (zp n)
+               (consp x)))
+    :hints(("Goal" :in-theory (enable repeat))))
+
+  (defthm alistp-of-take
+    (implies (alistp x)
+             (equal (alistp (take n x))
+                    (<= (nfix n) (len x))))
+    :hints(("Goal" :in-theory (enable take-redefinition))))
+
+  (defthm alistp-of-nthcdr
+    (implies (alistp x)
+             (alistp (nthcdr n x))))
+
+  (defthm alistp-of-delete-assoc-equal
+    (implies (alistp x)
+             (alistp (delete-assoc-equal key x))))
 
-(defthm alistp-of-pairlis$
-  (alistp (pairlis$ x y)))
+  (defthm alistp-of-pairlis$
+    (alistp (pairlis$ x y))))
diff -Nru acl2-6.2/books/std/alists/fal-extract-vals.lisp acl2-6.3/books/std/alists/fal-extract-vals.lisp
--- acl2-6.2/books/std/alists/fal-extract-vals.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/fal-extract-vals.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -25,79 +25,93 @@
 (local (include-book "../lists/rev"))
 (local (include-book "../lists/equiv"))
 
-; FAL-EXTRACT-VALS: this is like FAL-EXTRACT except for two things
-;  (1) it just returns the values, instead of a sub-alist
-;  (2) it doesn't skip unbound keys
-
-(defund fal-extract-vals1 (keys al)
-  "Assumes AL is fast"
-  (declare (xargs :guard t))
-  (if (atom keys)
-      nil
-    (cons (cdr (hons-get (car keys) al))
-          (fal-extract-vals1 (cdr keys) al))))
-
-(defund fal-extract-vals (keys al)
-  "Makes AL fast if necessary"
-  (declare (xargs :guard t :verify-guards nil))
-  (mbe :logic
-       (if (atom keys)
-           nil
-         (cons (cdr (hons-get (car keys) al))
-               (fal-extract-vals (cdr keys) al)))
-       :exec
-       (with-fast-alist al
-         (fal-extract-vals1 keys al))))
-
-(local (in-theory (enable fal-extract-vals)))
-
-(defthm fal-extract-vals1-removal
-  (equal (fal-extract-vals1 keys al)
-         (fal-extract-vals keys al))
-  :hints(("Goal" :in-theory (enable fal-extract-vals1))))
-
-(verify-guards fal-extract-vals)
-
-(defthm fal-extract-vals-when-atom
-  (implies (atom keys)
-           (equal (fal-extract-vals keys al)
-                  nil)))
-
-(defthm fal-extract-vals-of-cons
-  (equal (fal-extract-vals (cons a keys) al)
-         (cons (cdr (hons-get a al))
-               (fal-extract-vals keys al))))
-
-(defthm fal-extract-vals-of-list-fix
-  (equal (fal-extract-vals (list-fix keys) al)
-         (fal-extract-vals keys al)))
-
-(defcong list-equiv equal (fal-extract-vals keys al) 1
-  :hints(("Goal"
-          :in-theory (e/d (list-equiv)
-                          (fal-extract-vals-of-list-fix))
-          :use ((:instance fal-extract-vals-of-list-fix (keys keys))
-                (:instance fal-extract-vals-of-list-fix (keys keys-equiv))))))
-
-(defcong alist-equiv equal (fal-extract-vals keys al) 2)
-
-(defthm fal-extract-vals-of-append
-  (equal (fal-extract-vals (append x y) al)
-         (append (fal-extract-vals x al)
-                 (fal-extract-vals y al))))
-
-(defthm fal-extract-vals-of-rev
-  (equal (fal-extract-vals (rev x) al)
-         (rev (fal-extract-vals x al))))
-
-(defthm fal-extract-vals-of-revappend
-  (equal (fal-extract-vals (revappend x y) al)
-         (revappend (fal-extract-vals x al)
-                    (fal-extract-vals y al))))
-
-;; BOZO should probably add something like:
-;; (defcong set-equiv set-equiv (fal-extract-vals keys al) 1)
-
-(defthm len-of-fal-extract-vals
-  (equal (len (fal-extract-vals x al))
-         (len x)))
+
+(defsection fal-extract-vals
+  :parents (std/alists)
+  :short "@(call fal-extract) extracts the values associated with the given
+@('keys') in the alist @('al').  For unbound keys, we arbitrarily assign the
+value @('nil')."
+
+  :long "<p>This is similar to @(see fal-extract) except that we only return
+the values instead of a sub-alist, and we don't skip unbound keys.</p>
+
+<p>This is a \"modern\" alist function that respects the non-alist convention;
+see @(see std/alists) for discussion of this convention.</p>
+
+<p>This function is optimized for @(see fast-alists).  Ordinary alists will be
+temporarily made fast.</p>"
+
+  (defund fal-extract-vals1 (keys al)
+    "Assumes AL is fast"
+    (declare (xargs :guard t))
+    (if (atom keys)
+        nil
+      (cons (cdr (hons-get (car keys) al))
+            (fal-extract-vals1 (cdr keys) al))))
+
+  (defund fal-extract-vals (keys al)
+    "Makes AL fast if necessary"
+    (declare (xargs :guard t :verify-guards nil))
+    (mbe :logic
+         (if (atom keys)
+             nil
+           (cons (cdr (hons-get (car keys) al))
+                 (fal-extract-vals (cdr keys) al)))
+         :exec
+         (with-fast-alist al
+           (fal-extract-vals1 keys al))))
+
+  (local (in-theory (enable fal-extract-vals)))
+
+  (defthm fal-extract-vals1-removal
+    (equal (fal-extract-vals1 keys al)
+           (fal-extract-vals keys al))
+    :hints(("Goal" :in-theory (enable fal-extract-vals1))))
+
+  (verify-guards fal-extract-vals)
+
+  (defthm fal-extract-vals-when-atom
+    (implies (atom keys)
+             (equal (fal-extract-vals keys al)
+                    nil)))
+
+  (defthm fal-extract-vals-of-cons
+    (equal (fal-extract-vals (cons a keys) al)
+           (cons (cdr (hons-get a al))
+                 (fal-extract-vals keys al))))
+
+  (defthm fal-extract-vals-of-list-fix
+    (equal (fal-extract-vals (list-fix keys) al)
+           (fal-extract-vals keys al)))
+
+  (defcong list-equiv equal (fal-extract-vals keys al) 1
+    :hints(("Goal"
+            :in-theory (e/d (list-equiv)
+                            (fal-extract-vals-of-list-fix))
+            :use ((:instance fal-extract-vals-of-list-fix (keys keys))
+                  (:instance fal-extract-vals-of-list-fix (keys keys-equiv))))))
+
+  (defcong alist-equiv equal (fal-extract-vals keys al) 2)
+
+  (defthm fal-extract-vals-of-append
+    (equal (fal-extract-vals (append x y) al)
+           (append (fal-extract-vals x al)
+                   (fal-extract-vals y al))))
+
+  (defthm fal-extract-vals-of-rev
+    (equal (fal-extract-vals (rev x) al)
+           (rev (fal-extract-vals x al))))
+
+  (defthm fal-extract-vals-of-revappend
+    (equal (fal-extract-vals (revappend x y) al)
+           (revappend (fal-extract-vals x al)
+                      (fal-extract-vals y al))))
+
+  ;; BOZO should probably add something like:
+  ;; (defcong set-equiv set-equiv (fal-extract-vals keys al) 1)
+
+  (defthm len-of-fal-extract-vals
+    (equal (len (fal-extract-vals x al))
+           (len x))))
+
+
diff -Nru acl2-6.2/books/std/alists/fal-extract.lisp acl2-6.3/books/std/alists/fal-extract.lisp
--- acl2-6.2/books/std/alists/fal-extract.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/fal-extract.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -28,100 +28,109 @@
 (local (include-book "../lists/equiv"))
 
 
-; FAL-EXTRACT: given a list of variables and an alist, produces an alist
-; containing bindings for that list of variables.  Any variable not present in
-; the alist is skipped.
-
-(defund fal-extract1 (keys al)
-  "Assumes AL is fast"
-  (declare (xargs :guard t))
-  (b* (((when (atom keys))
-        nil)
-       (look (hons-get (car keys) al))
-       ((when look)
-        (cons look (fal-extract1 (cdr keys) al))))
-    (fal-extract1 (cdr keys) al)))
-
-(defund fal-extract (keys al)
-  "Makes AL fast if necessary"
-  (declare (xargs :guard t :verify-guards nil))
-  (mbe :logic
-       (b* (((when (atom keys))
-             nil)
-            (look (hons-get (car keys) al))
-            ((when look)
-             (cons look (fal-extract (cdr keys) al))))
-         (fal-extract (cdr keys) al))
-       :exec
-       (with-fast-alist al
-         (fal-extract1 keys al))))
-
-(local (in-theory (enable fal-extract)))
-
-(defthm fal-extract1-removal
-  (equal (fal-extract1 keys al)
-         (fal-extract keys al))
-  :hints(("Goal" :in-theory (enable fal-extract1))))
-
-(verify-guards fal-extract)
-
-(defthm fal-extract-when-atom
-  (implies (atom keys)
-           (equal (fal-extract keys al)
-                  nil)))
-
-(defthm fal-extract-of-cons
-  (equal (fal-extract (cons a keys) al)
-         (if (hons-get a al)
-             (cons (hons-get a al)
-                   (fal-extract keys al))
-           (fal-extract keys al))))
-
-(defthm alistp-of-fal-extract
-  (alistp (fal-extract keys al)))
-
-(defthm fal-extract-of-list-fix-keys
-  (equal (fal-extract (list-fix keys) al)
-         (fal-extract keys al)))
-
-(defcong list-equiv equal (fal-extract keys al) 1
-  :hints(("Goal"
-          :in-theory (e/d (list-equiv)
-                          (fal-extract-of-list-fix-keys))
-          :use ((:instance fal-extract-of-list-fix-keys (keys keys))
-                (:instance fal-extract-of-list-fix-keys (keys keys-equiv))))))
-
-(defcong alist-equiv equal (fal-extract keys al) 2
-  :hints(("Goal" :induct t)))
-
-(defthm fal-extract-of-append
-  (equal (fal-extract (append x y) al)
-         (append (fal-extract x al)
-                 (fal-extract y al))))
-
-(defthm fal-extract-of-rev
-  (equal (fal-extract (rev x) al)
-         (rev (fal-extract x al))))
-
-(defthm fal-extract-of-revappend
-  (equal (fal-extract (revappend x y) al)
-         (revappend (fal-extract x al)
-                    (fal-extract y al))))
-
-(defthm len-of-fal-extract
-  (<= (len (fal-extract x al))
-      (len x))
-  :rule-classes ((:rewrite) (:linear)))
-
-
-
-(defthm hons-assoc-equal-fal-extract
-  (equal (hons-assoc-equal x (fal-extract keys al))
-         (and (member-equal x keys)
-              (hons-assoc-equal x al)))
-  :hints(("Goal" :induct (fal-extract keys al))))
-
-;; BOZO eventually add this... proven in centaur/misc/fast-alists, but uses
-;; set-reasoning:
-;;
-;;  (defcong set-equiv alist-equiv (fal-extract keys al) 1)
+(defsection fal-extract
+  :parents (std/alists)
+  :short "@(call fal-extract) extracts a \"subset\" of the alist @('al') by
+binding every key in @('keys') to its value in @('al'), skipping any unbound
+keys."
+
+  :long "<p>This is a \"modern\" alist function that respects the non-alist
+convention; see @(see std/alists) for discussion of this convention.</p>
+
+<p>This function is optimized for @(see fast-alists).  Ordinary alists will be
+temporarily made fast.</p>"
+
+  (defund fal-extract1 (keys al)
+    "Assumes AL is fast"
+    (declare (xargs :guard t))
+    (b* (((when (atom keys))
+          nil)
+         (look (hons-get (car keys) al))
+         ((when look)
+          (cons look (fal-extract1 (cdr keys) al))))
+      (fal-extract1 (cdr keys) al)))
+
+  (defund fal-extract (keys al)
+    "Makes AL fast if necessary"
+    (declare (xargs :guard t :verify-guards nil))
+    (mbe :logic
+         (b* (((when (atom keys))
+               nil)
+              (look (hons-get (car keys) al))
+              ((when look)
+               (cons look (fal-extract (cdr keys) al))))
+           (fal-extract (cdr keys) al))
+         :exec
+         (with-fast-alist al
+           (fal-extract1 keys al))))
+
+  (local (in-theory (enable fal-extract)))
+
+  (defthm fal-extract1-removal
+    (equal (fal-extract1 keys al)
+           (fal-extract keys al))
+    :hints(("Goal" :in-theory (enable fal-extract1))))
+
+  (verify-guards fal-extract)
+
+  (defthm fal-extract-when-atom
+    (implies (atom keys)
+             (equal (fal-extract keys al)
+                    nil)))
+
+  (defthm fal-extract-of-cons
+    (equal (fal-extract (cons a keys) al)
+           (if (hons-get a al)
+               (cons (hons-get a al)
+                     (fal-extract keys al))
+             (fal-extract keys al))))
+
+  (defthm alistp-of-fal-extract
+    (alistp (fal-extract keys al)))
+
+  (defthm fal-extract-of-list-fix-keys
+    (equal (fal-extract (list-fix keys) al)
+           (fal-extract keys al)))
+
+  (defcong list-equiv equal (fal-extract keys al) 1
+    :hints(("Goal"
+            :in-theory (e/d (list-equiv)
+                            (fal-extract-of-list-fix-keys))
+            :use ((:instance fal-extract-of-list-fix-keys (keys keys))
+                  (:instance fal-extract-of-list-fix-keys (keys keys-equiv))))))
+
+  (defcong alist-equiv equal (fal-extract keys al) 2
+    :hints(("Goal" :induct t)))
+
+  (defthm fal-extract-of-append
+    (equal (fal-extract (append x y) al)
+           (append (fal-extract x al)
+                   (fal-extract y al))))
+
+  (defthm fal-extract-of-rev
+    (equal (fal-extract (rev x) al)
+           (rev (fal-extract x al))))
+
+  (defthm fal-extract-of-revappend
+    (equal (fal-extract (revappend x y) al)
+           (revappend (fal-extract x al)
+                      (fal-extract y al))))
+
+  (defthm len-of-fal-extract
+    (<= (len (fal-extract x al))
+        (len x))
+    :rule-classes ((:rewrite) (:linear)))
+
+  (defthm hons-assoc-equal-fal-extract
+    (equal (hons-assoc-equal x (fal-extract keys al))
+           (and (member-equal x keys)
+                (hons-assoc-equal x al)))
+    :hints(("Goal" :induct (fal-extract keys al))))
+
+  ;; BOZO eventually add this... proven in centaur/misc/fast-alists, but uses
+  ;; set-reasoning:
+  ;;
+  ;;  (defcong set-equiv alist-equiv (fal-extract keys al) 1)
+
+
+  )
\ No newline at end of file
diff -Nru acl2-6.2/books/std/alists/hons-assoc-equal.lisp acl2-6.3/books/std/alists/hons-assoc-equal.lisp
--- acl2-6.2/books/std/alists/hons-assoc-equal.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/hons-assoc-equal.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -24,65 +24,92 @@
 (local (include-book "../lists/list-fix"))
 (local (in-theory (enable hons-assoc-equal)))
 
-(defthm hons-assoc-equal-when-atom
-  (implies (atom alist)
-           (equal (hons-assoc-equal a alist)
-                  nil)))
-
-(defthm hons-assoc-equal-of-cons
-  (equal (hons-assoc-equal key (cons entry map))
-         (if (and (consp entry)
-                  (equal key (car entry)))
-             entry
-           (hons-assoc-equal key map))))
-
-(encapsulate
-  ()
-  (local (defthmd l0
-           (equal (hons-assoc-equal key (list-fix alist))
-                  (hons-assoc-equal key alist))))
-
-  (defcong list-equiv equal (hons-assoc-equal key alist) 2
-    :hints(("Goal"
-            :in-theory (enable list-equiv)
-            :use ((:instance l0 (alist alist))
-                  (:instance l0 (alist alist-equiv)))))))
-
-(defthm hons-assoc-equal-of-hons-acons
-  (equal (hons-assoc-equal key (hons-acons key2 val map))
-         (if (equal key key2)
-             (cons key val)
-           (hons-assoc-equal key map))))
-
-(defthm consp-of-hons-assoc-equal
-  (equal (consp (hons-assoc-equal x alist))
-         (if (hons-assoc-equal x alist)
-             t
-           nil)))
-
-(defthm car-hons-assoc-equal
-  (implies (hons-assoc-equal k a)
-           (equal (car (hons-assoc-equal k a))
-                  k)))
-
-(defthm car-hons-assoc-equal-split
-  (equal (car (hons-assoc-equal key alist))
-         (if (hons-assoc-equal key alist)
-             key
-           nil)))
-
-(defthm hons-assoc-equal-append
-  (equal (hons-assoc-equal x (append a b))
-         (or (hons-assoc-equal x a)
-             (hons-assoc-equal x b))))
-
-(defthm hons-assoc-equal-of-hons-shrink-alist
-  (equal (hons-assoc-equal a (hons-shrink-alist x y))
-         (or (hons-assoc-equal a y)
-             (hons-assoc-equal a x))))
-
-(defthm cons-key-cdr-hons-assoc-equal
-  (implies (hons-assoc-equal k a)
-           (equal (cons k (cdr (hons-assoc-equal k a)))
-                  (hons-assoc-equal k a))))
+(defsection std/alists/hons-assoc-equal
+  :parents (std/alists hons-assoc-equal hons-get)
+  :short "Lemmas about @(see hons-assoc-equal) available in the @(see
+std/alists) library."
+
+  :long "<p><b>NOTE:</b> It is a good idea to be very clear on the relationship
+between @('hons-get') and @('hons-assoc-equal'):</p>
+
+<ul>
+
+<li>To get hash table speeds out of @(see fast-alists) during execution, you
+must write your functions in terms of @(see hons-get) instead of
+@('hons-assoc-equal')!  But,</li>
+
+<li>You should never write theorems about @('hons-get')!  It just rewrites into
+@('hons-assoc-equal').  We always reason in terms of @('hons-assoc-equal'),
+which is useful, e.g., to avoid spurious @(see slow-alist-warning)s during
+proofs.</li>
+
+</ul>
+
+<p>@('hons-assoc-equal') is the \"modern\" alternative to @(see assoc), and
+properly respect the non-alist convention; see @(see std/alists) for discussion
+of this convention.</p>"
+
+  (defthm hons-assoc-equal-when-atom
+    (implies (atom alist)
+             (equal (hons-assoc-equal a alist)
+                    nil)))
+
+  (defthm hons-assoc-equal-of-cons
+    (equal (hons-assoc-equal key (cons entry map))
+           (if (and (consp entry)
+                    (equal key (car entry)))
+               entry
+             (hons-assoc-equal key map))))
+
+  (encapsulate
+    ()
+    (local (defthmd l0
+             (equal (hons-assoc-equal key (list-fix alist))
+                    (hons-assoc-equal key alist))))
+
+    (defcong list-equiv equal (hons-assoc-equal key alist) 2
+      :hints(("Goal"
+              :in-theory (enable list-equiv)
+              :use ((:instance l0 (alist alist))
+                    (:instance l0 (alist alist-equiv)))))))
+
+  (defthm hons-assoc-equal-of-hons-acons
+    (equal (hons-assoc-equal key (hons-acons key2 val map))
+           (if (equal key key2)
+               (cons key val)
+             (hons-assoc-equal key map))))
+
+  (defthm consp-of-hons-assoc-equal
+    (equal (consp (hons-assoc-equal x alist))
+           (if (hons-assoc-equal x alist)
+               t
+             nil)))
+
+  (defthm car-hons-assoc-equal
+    (implies (hons-assoc-equal k a)
+             (equal (car (hons-assoc-equal k a))
+                    k)))
+
+  (defthm car-hons-assoc-equal-split
+    (equal (car (hons-assoc-equal key alist))
+           (if (hons-assoc-equal key alist)
+               key
+             nil)))
+
+  (defthm hons-assoc-equal-append
+    (equal (hons-assoc-equal x (append a b))
+           (or (hons-assoc-equal x a)
+               (hons-assoc-equal x b))))
+
+
+
+  (defthm hons-assoc-equal-of-hons-shrink-alist
+    (equal (hons-assoc-equal a (hons-shrink-alist x y))
+           (or (hons-assoc-equal a y)
+               (hons-assoc-equal a x))))
+
+  (defthm cons-key-cdr-hons-assoc-equal
+    (implies (hons-assoc-equal k a)
+             (equal (cons k (cdr (hons-assoc-equal k a)))
+                    (hons-assoc-equal k a)))))
 
diff -Nru acl2-6.2/books/std/alists/hons-rassoc-equal.lisp acl2-6.3/books/std/alists/hons-rassoc-equal.lisp
--- acl2-6.2/books/std/alists/hons-rassoc-equal.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/hons-rassoc-equal.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -25,95 +25,104 @@
 (include-book "alist-vals")
 (local (include-book "../lists/list-fix"))
 
-(defund hons-rassoc-equal (val map)
-  (declare (xargs :guard t))
-  (cond ((atom map)
-         nil)
-        ((and (consp (car map))
-              (equal val (cdar map)))
-         (car map))
-        (t
-         (hons-rassoc-equal val (cdr map)))))
-
-(local (in-theory (enable hons-rassoc-equal)))
-
-(defthm hons-rassoc-equal-when-atom
-  (implies (atom map)
-           (equal (hons-rassoc-equal val map)
-                  nil)))
-
-(defthm hons-rassoc-equal-of-hons-acons
-  (equal (hons-rassoc-equal a (cons (cons key b) map))
-         (if (equal a b)
-             (cons key b)
-           (hons-rassoc-equal a map))))
-
-(defthm hons-rassoc-equal-type
-  (or (not (hons-rassoc-equal val map))
-      (consp (hons-rassoc-equal val map)))
-  :rule-classes :type-prescription)
-
-(encapsulate
-  ()
-  (local (defthmd l0
-           (equal (hons-rassoc-equal key (list-fix alist))
-                  (hons-rassoc-equal key alist))))
-
-  (defcong list-equiv equal (hons-rassoc-equal key alist) 2
-    :hints(("Goal"
-            :in-theory (enable list-equiv)
-            :use ((:instance l0 (alist alist))
-                  (:instance l0 (alist alist-equiv)))))))
-
-(defthm consp-of-hons-rassoc-equal
-  (equal (consp (hons-rassoc-equal val map))
-         (if (hons-rassoc-equal val map)
-             t
-           nil)))
-
-(defthm cdr-of-hons-rassoc-equal
-  (equal (cdr (hons-rassoc-equal val map))
-         (if (hons-rassoc-equal val map)
-             val
-           nil)))
-
-(defthm member-equal-of-alist-vals-under-iff
-  (iff (member-equal val (alist-vals map))
-       (hons-rassoc-equal val map))
-  :hints(("Goal" :in-theory (enable hons-rassoc-equal
-                                    alist-vals))))
-
-(defthm hons-assoc-equal-of-car-when-hons-rassoc-equal
-  (implies (hons-rassoc-equal val map)
-           (hons-assoc-equal (car (hons-rassoc-equal val map)) map))
-  :hints(("Goal" :in-theory (enable hons-assoc-equal
-                                    hons-rassoc-equal))))
-
-(defthm hons-assoc-equal-of-car-when-hons-rassoc-equal-and-no-duplicates
-  (implies (and (no-duplicatesp-equal (alist-keys map))
-                (hons-rassoc-equal val map))
-           (equal (hons-assoc-equal (car (hons-rassoc-equal val map)) map)
-                  (hons-rassoc-equal val map)))
-  :hints(("Goal" :in-theory (enable hons-assoc-equal
-                                    hons-rassoc-equal))))
-
-(defthm member-equal-of-car-when-hons-rassoc-equal
-  (implies (hons-rassoc-equal val map)
-           (member-equal (car (hons-rassoc-equal val map))
-                         (alist-keys map))))
-
-(defthm hons-rassoc-equal-of-cdr-when-hons-assoc-equal
-  (implies (hons-assoc-equal key map)
-           (hons-rassoc-equal (cdr (hons-assoc-equal key map)) map))
-  :hints(("Goal" :in-theory (enable hons-assoc-equal
-                                    hons-rassoc-equal))))
-
-(defthm hons-rassoc-equal-of-cdr-when-hons-assoc-equal-and-no-duplicates
-  (implies (and (no-duplicatesp-equal (alist-vals map))
-                (hons-assoc-equal key map))
-           (equal (hons-rassoc-equal (cdr (hons-assoc-equal key map)) map)
-                  (hons-assoc-equal key map)))
-  :hints(("Goal" :in-theory (enable hons-assoc-equal
-                                    hons-rassoc-equal))))
+(defsection hons-rassoc-equal
+  :parents (std/alists)
+  :short "@(call hons-rassoc-equal) returns the first pair found in the alist
+@('alist') whose value is @('val'), if one exists, or @('nil') otherwise."
+
+  :long "<p>This is a \"modern\" equivalent of @(see rassoc), which properly
+respects the non-alist convention; see @(see std/alists) for discussion of this
+convention.</p>"
+
+  (defund hons-rassoc-equal (val alist)
+    (declare (xargs :guard t))
+    (cond ((atom alist)
+           nil)
+          ((and (consp (car alist))
+                (equal val (cdar alist)))
+           (car alist))
+          (t
+           (hons-rassoc-equal val (cdr alist)))))
+
+  (local (in-theory (enable hons-rassoc-equal)))
+
+  (defthm hons-rassoc-equal-when-atom
+    (implies (atom alist)
+             (equal (hons-rassoc-equal val alist)
+                    nil)))
+
+  (defthm hons-rassoc-equal-of-hons-acons
+    (equal (hons-rassoc-equal a (cons (cons key b) alist))
+           (if (equal a b)
+               (cons key b)
+             (hons-rassoc-equal a alist))))
+
+  (defthm hons-rassoc-equal-type
+    (or (not (hons-rassoc-equal val alist))
+        (consp (hons-rassoc-equal val alist)))
+    :rule-classes :type-prescription)
+
+  (encapsulate
+    ()
+    (local (defthmd l0
+             (equal (hons-rassoc-equal key (list-fix alist))
+                    (hons-rassoc-equal key alist))))
+
+    (defcong list-equiv equal (hons-rassoc-equal key alist) 2
+      :hints(("Goal"
+              :in-theory (enable list-equiv)
+              :use ((:instance l0 (alist alist))
+                    (:instance l0 (alist alist-equiv)))))))
+
+  (defthm consp-of-hons-rassoc-equal
+    (equal (consp (hons-rassoc-equal val alist))
+           (if (hons-rassoc-equal val alist)
+               t
+             nil)))
+
+  (defthm cdr-of-hons-rassoc-equal
+    (equal (cdr (hons-rassoc-equal val alist))
+           (if (hons-rassoc-equal val alist)
+               val
+             nil)))
+
+  (defthm member-equal-of-alist-vals-under-iff
+    (iff (member-equal val (alist-vals alist))
+         (hons-rassoc-equal val alist))
+    :hints(("Goal" :in-theory (enable hons-rassoc-equal
+                                      alist-vals))))
+
+  (defthm hons-assoc-equal-of-car-when-hons-rassoc-equal
+    (implies (hons-rassoc-equal val alist)
+             (hons-assoc-equal (car (hons-rassoc-equal val alist)) alist))
+    :hints(("Goal" :in-theory (enable hons-assoc-equal
+                                      hons-rassoc-equal))))
+
+  (defthm hons-assoc-equal-of-car-when-hons-rassoc-equal-and-no-duplicates
+    (implies (and (no-duplicatesp-equal (alist-keys alist))
+                  (hons-rassoc-equal val alist))
+             (equal (hons-assoc-equal (car (hons-rassoc-equal val alist)) alist)
+                    (hons-rassoc-equal val alist)))
+    :hints(("Goal" :in-theory (enable hons-assoc-equal
+                                      hons-rassoc-equal))))
+
+  (defthm member-equal-of-car-when-hons-rassoc-equal
+    (implies (hons-rassoc-equal val alist)
+             (member-equal (car (hons-rassoc-equal val alist))
+                           (alist-keys alist))))
+
+  (defthm hons-rassoc-equal-of-cdr-when-hons-assoc-equal
+    (implies (hons-assoc-equal key alist)
+             (hons-rassoc-equal (cdr (hons-assoc-equal key alist)) alist))
+    :hints(("Goal" :in-theory (enable hons-assoc-equal
+                                      hons-rassoc-equal))))
+
+  (defthm hons-rassoc-equal-of-cdr-when-hons-assoc-equal-and-no-duplicates
+    (implies (and (no-duplicatesp-equal (alist-vals alist))
+                  (hons-assoc-equal key alist))
+             (equal (hons-rassoc-equal (cdr (hons-assoc-equal key alist)) alist)
+                    (hons-assoc-equal key alist)))
+    :hints(("Goal" :in-theory (enable hons-assoc-equal
+                                      hons-rassoc-equal)))))
 
 
diff -Nru acl2-6.2/books/std/alists/pairlis.lisp acl2-6.3/books/std/alists/pairlis.lisp
--- acl2-6.2/books/std/alists/pairlis.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/pairlis.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -27,47 +27,58 @@
 (local (include-book "../lists/equiv"))
 (local (in-theory (enable pairlis$)))
 
-(encapsulate
-  ()
-  ;; Some redundant things from alistp, strip-cars, strip-cdrs.
-
-  (set-enforce-redundancy t) ;; Implicitly local
-
-  (defthm alistp-of-pairlis$
-    (alistp (pairlis$ x y)))
-
-  (defthm strip-cars-of-pairlis$
-    (equal (strip-cars (pairlis$ x y))
-           (list-fix x)))
-
-  (defthm strip-cdrs-of-pairlis$
-    (equal (strip-cdrs (pairlis$ x y))
-           (if (<= (len x) (len y))
-               (take (len x) y)
-             (append y (repeat nil (- (len x) (len y))))))))
-
-(defthm pairlis$-when-atom
-  (implies (atom x)
-           (equal (pairlis$ x y)
-                  nil)))
-
-(defthm pairlis$-of-cons
-  (equal (pairlis$ (cons a x) y)
-         (cons (cons a (car y))
-               (pairlis$ x (cdr y)))))
-
-(defthm len-of-pairlis$
-  (equal (len (pairlis$ x y))
-         (len x)))
-
-(defthm pairlis$-of-list-fix-left
-  (equal (pairlis$ (list-fix x) y)
-         (pairlis$ x y)))
-
-(defthm pairlis$-of-list-fix-right
-  (equal (pairlis$ x (list-fix y))
-         (pairlis$ x y)))
+(defsection std/alists/pairlis$
+  :parents (std/alists pairlis$)
+  :short "Lemmas about @(see pairlis$) available in the @(see std/alists)
+library."
+
+  :long "<p>@('(pairlis$ x y)') is a perfectly reasonable way to create a
+proper, @('nil')-terminated @(see alistp) which can be used with either
+\"traditional\" or \"modern\" alist functions.</p>"
+
+  (defthm pairlis$-when-atom
+    (implies (atom x)
+             (equal (pairlis$ x y)
+                    nil)))
+
+  (defthm pairlis$-of-cons
+    (equal (pairlis$ (cons a x) y)
+           (cons (cons a (car y))
+                 (pairlis$ x (cdr y)))))
+
+  (defthm len-of-pairlis$
+    (equal (len (pairlis$ x y))
+           (len x)))
+
+  (encapsulate
+    ()
+    ;; Some redundant things from alistp, strip-cars, strip-cdrs.
+    (set-enforce-redundancy t) ;; Implicitly local
+
+    (defthm alistp-of-pairlis$
+      (alistp (pairlis$ x y)))
+
+    (defthm strip-cars-of-pairlis$
+      (equal (strip-cars (pairlis$ x y))
+             (list-fix x)))
+
+    (defthm strip-cdrs-of-pairlis$
+      (equal (strip-cdrs (pairlis$ x y))
+             (if (<= (len x) (len y))
+                 (take (len x) y)
+               (append y (repeat nil (- (len x) (len y))))))))
+
+
+  (defthm pairlis$-of-list-fix-left
+    (equal (pairlis$ (list-fix x) y)
+           (pairlis$ x y)))
+
+  (defthm pairlis$-of-list-fix-right
+    (equal (pairlis$ x (list-fix y))
+           (pairlis$ x y)))
+
+  (defcong list-equiv equal (pairlis$ x y) 1)
+  (defcong list-equiv equal (pairlis$ x y) 2))
+
 
-(defcong list-equiv equal (pairlis$ x y) 1)
-(defcong list-equiv equal (pairlis$ x y) 2)
 
diff -Nru acl2-6.2/books/std/alists/strip-cars.lisp acl2-6.3/books/std/alists/strip-cars.lisp
--- acl2-6.2/books/std/alists/strip-cars.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/strip-cars.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -28,109 +28,121 @@
 
 (local (in-theory (enable strip-cars)))
 
-(defthm strip-cars-when-atom
-  (implies (atom x)
-           (equal (strip-cars x)
-                  nil)))
-
-(defthm strip-cars-of-cons
-  (equal (strip-cars (cons a x))
-         (cons (car a)
-               (strip-cars x))))
-
-(defthm len-of-strip-cars
-   (equal (len (strip-cars x))
-          (len x)))
+(defsection std/alists/strip-cars
+  :parents (std/alists strip-cars)
+  :short "Lemmas about @(see strip-cars) available in the @(see std/alists)
+library."
+
+  :long "<p>Note that @('strip-cars') is a \"traditional\" alist function: it
+has an @(see alistp) guard and fails to respect the non-alist convention.  We
+generally prefer to work with @(see alist-keys) instead.</p>
+
+<p>Even so, we provide many lemmas for working with @('strip-cars'), in case
+for some reason that's what you want to do.</p>"
+
+  (defthm strip-cars-when-atom
+    (implies (atom x)
+             (equal (strip-cars x)
+                    nil)))
+
+  (defthm strip-cars-of-cons
+    (equal (strip-cars (cons a x))
+           (cons (car a)
+                 (strip-cars x))))
+
+  (defthm len-of-strip-cars
+    (equal (len (strip-cars x))
+           (len x)))
+
+  (defthm consp-of-strip-cars
+    (equal (consp (strip-cars x))
+           (consp x)))
+
+  (defthm car-of-strip-cars
+    (equal (car (strip-cars x))
+           (car (car x))))
+
+  (defthm cdr-of-strip-cars
+    (equal (cdr (strip-cars x))
+           (strip-cars (cdr x))))
 
-(defthm consp-of-strip-cars
-  (equal (consp (strip-cars x))
+  (defthm strip-cars-under-iff
+    (iff (strip-cars x)
          (consp x)))
 
-(defthm car-of-strip-cars
-  (equal (car (strip-cars x))
-         (car (car x))))
-
-(defthm cdr-of-strip-cars
-  (equal (cdr (strip-cars x))
-         (strip-cars (cdr x))))
-
-(defthm strip-cars-under-iff
-  (iff (strip-cars x)
-       (consp x)))
-
-(defthm strip-cars-of-list-fix
-  (equal (strip-cars (list-fix x))
-         (strip-cars x))
-  :hints(("Goal" :in-theory (enable list-fix))))
-
-(defcong list-equiv equal (strip-cars x) 1
-  :hints(("Goal"
-          :in-theory (e/d (list-equiv)
-                          (strip-cars-of-list-fix))
-          :use ((:instance strip-cars-of-list-fix (x x))
-                (:instance strip-cars-of-list-fix (x x-equiv))))))
-
-(encapsulate
-  ()
-  (local (defthm l1
-           (implies (and (member-equal a x)
-                         (not (consp a)))
-                    (member-equal nil (strip-cars x)))))
-
-  (local (defthm l2
-           (implies (member-equal (cons a b) x)
-                    (member-equal a (strip-cars x)))))
-
-  (local (defthm l3
-           (implies (and (subsetp x y)
-                         (member a x))
-                    (member (car a) (strip-cars y)))
-           :hints(("Goal" :induct (len x)))))
-
-  (local (defthm l4
-           (implies (subsetp x y)
-                    (subsetp (strip-cars x) (strip-cars y)))
-           :hints(("Goal" :induct (len x)))))
-
-  (defcong set-equiv set-equiv (strip-cars x) 1
-    :hints(("Goal" :in-theory (enable set-equiv)))))
-
-(defthm strip-cars-of-append
-  (equal (strip-cars (append x y))
-         (append (strip-cars x)
-                 (strip-cars y))))
-
-(defthm strip-cars-of-rev
-  (equal (strip-cars (rev x))
-         (rev (strip-cars x))))
-
-(defthm strip-cars-of-revappend
-  (equal (strip-cars (revappend x y))
-         (revappend (strip-cars x)
-                    (strip-cars y))))
-
-(defthm strip-cars-of-repeat
-  (equal (strip-cars (repeat x n))
-         (repeat (car x) n))
-  :hints(("Goal" :in-theory (enable repeat))))
-
-(defthm strip-cars-of-take
-  (equal (strip-cars (take n x))
-         (take n (strip-cars x))))
-
-(defthm strip-cars-of-nthcdr
-  (equal (strip-cars (nthcdr n x))
-         (nthcdr n (strip-cars x))))
-
-(defthm strip-cars-of-last
-  (equal (strip-cars (last x))
-         (last (strip-cars x))))
-
-(defthm strip-cars-of-butlast
-  (equal (strip-cars (butlast x n))
-         (butlast (strip-cars x) n)))
-
-(defthm strip-cars-of-pairlis$
-  (equal (strip-cars (pairlis$ x y))
-         (list-fix x)))
+  (defthm strip-cars-of-list-fix
+    (equal (strip-cars (list-fix x))
+           (strip-cars x))
+    :hints(("Goal" :in-theory (enable list-fix))))
+
+  (defcong list-equiv equal (strip-cars x) 1
+    :hints(("Goal"
+            :in-theory (e/d (list-equiv)
+                            (strip-cars-of-list-fix))
+            :use ((:instance strip-cars-of-list-fix (x x))
+                  (:instance strip-cars-of-list-fix (x x-equiv))))))
+
+  (encapsulate
+    ()
+    (local (defthm l1
+             (implies (and (member-equal a x)
+                           (not (consp a)))
+                      (member-equal nil (strip-cars x)))))
+
+    (local (defthm l2
+             (implies (member-equal (cons a b) x)
+                      (member-equal a (strip-cars x)))))
+
+    (local (defthm l3
+             (implies (and (subsetp x y)
+                           (member a x))
+                      (member (car a) (strip-cars y)))
+             :hints(("Goal" :induct (len x)))))
+
+    (local (defthm l4
+             (implies (subsetp x y)
+                      (subsetp (strip-cars x) (strip-cars y)))
+             :hints(("Goal" :induct (len x)))))
+
+    (defcong set-equiv set-equiv (strip-cars x) 1
+      :hints(("Goal" :in-theory (enable set-equiv)))))
+
+  (defthm strip-cars-of-append
+    (equal (strip-cars (append x y))
+           (append (strip-cars x)
+                   (strip-cars y))))
+
+  (defthm strip-cars-of-rev
+    (equal (strip-cars (rev x))
+           (rev (strip-cars x))))
+
+  (defthm strip-cars-of-revappend
+    (equal (strip-cars (revappend x y))
+           (revappend (strip-cars x)
+                      (strip-cars y))))
+
+  (defthm strip-cars-of-repeat
+    (equal (strip-cars (repeat x n))
+           (repeat (car x) n))
+    :hints(("Goal" :in-theory (enable repeat))))
+
+  (defthm strip-cars-of-take
+    (equal (strip-cars (take n x))
+           (take n (strip-cars x))))
+
+  (defthm strip-cars-of-nthcdr
+    (equal (strip-cars (nthcdr n x))
+           (nthcdr n (strip-cars x))))
+
+  (defthm strip-cars-of-last
+    (equal (strip-cars (last x))
+           (last (strip-cars x))))
+
+  (defthm strip-cars-of-butlast
+    (equal (strip-cars (butlast x n))
+           (butlast (strip-cars x) n)))
+
+  (defthm strip-cars-of-pairlis$
+    (equal (strip-cars (pairlis$ x y))
+           (list-fix x))))
 
diff -Nru acl2-6.2/books/std/alists/strip-cdrs.lisp acl2-6.3/books/std/alists/strip-cdrs.lisp
--- acl2-6.2/books/std/alists/strip-cdrs.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/strip-cdrs.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -28,114 +28,126 @@
 (local (include-book "arithmetic/top" :dir :system))
 (local (in-theory (enable strip-cdrs)))
 
-(defthm strip-cdrs-when-atom
-  (implies (atom x)
-           (equal (strip-cdrs x)
-                  nil)))
-
-(defthm strip-cdrs-of-cons
-  (equal (strip-cdrs (cons a x))
-         (cons (cdr a)
-               (strip-cdrs x))))
-
-(defthm len-of-strip-cdrs
-   (equal (len (strip-cdrs x))
-          (len x)))
+(defsection std/alists/strip-cdrs
+  :parents (std/alists strip-cdrs)
+  :short "Lemmas about @(see strip-cdrs) available in the @(see std/alists)
+library."
+
+  :long "<p>Note that @('strip-cdrs') is a \"traditional\" alist function: it
+has an @(see alistp) guard and fails to respect the non-alist convention.  We
+generally prefer to work with @(see alist-vals) instead.</p>
+
+<p>Even so, we provide many lemmas for working with @('strip-cdrs'), in case
+for some reason that's what you want to do.</p>"
+
+  (defthm strip-cdrs-when-atom
+    (implies (atom x)
+             (equal (strip-cdrs x)
+                    nil)))
+
+  (defthm strip-cdrs-of-cons
+    (equal (strip-cdrs (cons a x))
+           (cons (cdr a)
+                 (strip-cdrs x))))
+
+  (defthm len-of-strip-cdrs
+    (equal (len (strip-cdrs x))
+           (len x)))
+
+  (defthm consp-of-strip-cdrs
+    (equal (consp (strip-cdrs x))
+           (consp x)))
+
+  (defthm car-of-strip-cdrs
+    (equal (car (strip-cdrs x))
+           (cdr (car x))))
+
+  (defthm cdr-of-strip-cdrs
+    (equal (cdr (strip-cdrs x))
+           (strip-cdrs (cdr x))))
 
-(defthm consp-of-strip-cdrs
-  (equal (consp (strip-cdrs x))
+  (defthm strip-cdrs-under-iff
+    (iff (strip-cdrs x)
          (consp x)))
 
-(defthm car-of-strip-cdrs
-  (equal (car (strip-cdrs x))
-         (cdr (car x))))
-
-(defthm cdr-of-strip-cdrs
-  (equal (cdr (strip-cdrs x))
-         (strip-cdrs (cdr x))))
-
-(defthm strip-cdrs-under-iff
-  (iff (strip-cdrs x)
-       (consp x)))
-
-(defthm strip-cdrs-of-list-fix
-  (equal (strip-cdrs (list-fix x))
-         (strip-cdrs x))
-  :hints(("Goal" :in-theory (enable list-fix))))
-
-(defcong list-equiv equal (strip-cdrs x) 1
-  :hints(("Goal"
-          :in-theory (e/d (list-equiv)
-                          (strip-cdrs-of-list-fix))
-          :use ((:instance strip-cdrs-of-list-fix (x x))
-                (:instance strip-cdrs-of-list-fix (x x-equiv))))))
-
-(encapsulate
-  ()
-  (local (defthm l1
-           (implies (and (member-equal a x)
-                         (not (consp a)))
-                    (member-equal nil (strip-cdrs x)))))
-
-  (local (defthm l2
-           (implies (member-equal (cons a b) x)
-                    (member-equal b (strip-cdrs x)))))
-
-  (local (defthm l3
-           (implies (and (subsetp x y)
-                         (member a x))
-                    (member (cdr a) (strip-cdrs y)))
-           :hints(("Goal" :induct (len x)))))
-
-  (local (defthm l4
-           (implies (subsetp x y)
-                    (subsetp (strip-cdrs x) (strip-cdrs y)))
-           :hints(("Goal" :induct (len x)))))
-
-  (defcong set-equiv set-equiv (strip-cdrs x) 1
-    :hints(("Goal" :in-theory (enable set-equiv)))))
-
-(defthm strip-cdrs-of-append
-  (equal (strip-cdrs (append x y))
-         (append (strip-cdrs x)
-                 (strip-cdrs y))))
-
-(defthm strip-cdrs-of-rev
-  (equal (strip-cdrs (rev x))
-         (rev (strip-cdrs x))))
-
-(defthm strip-cdrs-of-revappend
-  (equal (strip-cdrs (revappend x y))
-         (revappend (strip-cdrs x)
-                    (strip-cdrs y))))
-
-(defthm strip-cdrs-of-repeat
-  (equal (strip-cdrs (repeat x n))
-         (repeat (cdr x) n))
-  :hints(("Goal" :in-theory (enable repeat))))
-
-(defthm strip-cdrs-of-take
-  (equal (strip-cdrs (take n x))
-         (take n (strip-cdrs x))))
-
-(defthm strip-cdrs-of-nthcdr
-  (equal (strip-cdrs (nthcdr n x))
-         (nthcdr n (strip-cdrs x))))
-
-(defthm strip-cdrs-of-last
-  (equal (strip-cdrs (last x))
-         (last (strip-cdrs x))))
-
-(defthm strip-cdrs-of-butlast
-  (equal (strip-cdrs (butlast x n))
-         (butlast (strip-cdrs x) n)))
-
-(defthm strip-cdrs-of-pairlis$
-  (equal (strip-cdrs (pairlis$ x y))
-         (if (<= (len x) (len y))
-             (take (len x) y)
-           (append y (repeat nil (- (len x) (len y))))))
-  :hints(("Goal"
-          :induct (pairlis$ x y)
-          :in-theory (enable repeat))))
+  (defthm strip-cdrs-of-list-fix
+    (equal (strip-cdrs (list-fix x))
+           (strip-cdrs x))
+    :hints(("Goal" :in-theory (enable list-fix))))
+
+  (defcong list-equiv equal (strip-cdrs x) 1
+    :hints(("Goal"
+            :in-theory (e/d (list-equiv)
+                            (strip-cdrs-of-list-fix))
+            :use ((:instance strip-cdrs-of-list-fix (x x))
+                  (:instance strip-cdrs-of-list-fix (x x-equiv))))))
+
+  (encapsulate
+    ()
+    (local (defthm l1
+             (implies (and (member-equal a x)
+                           (not (consp a)))
+                      (member-equal nil (strip-cdrs x)))))
+
+    (local (defthm l2
+             (implies (member-equal (cons a b) x)
+                      (member-equal b (strip-cdrs x)))))
+
+    (local (defthm l3
+             (implies (and (subsetp x y)
+                           (member a x))
+                      (member (cdr a) (strip-cdrs y)))
+             :hints(("Goal" :induct (len x)))))
+
+    (local (defthm l4
+             (implies (subsetp x y)
+                      (subsetp (strip-cdrs x) (strip-cdrs y)))
+             :hints(("Goal" :induct (len x)))))
+
+    (defcong set-equiv set-equiv (strip-cdrs x) 1
+      :hints(("Goal" :in-theory (enable set-equiv)))))
+
+  (defthm strip-cdrs-of-append
+    (equal (strip-cdrs (append x y))
+           (append (strip-cdrs x)
+                   (strip-cdrs y))))
+
+  (defthm strip-cdrs-of-rev
+    (equal (strip-cdrs (rev x))
+           (rev (strip-cdrs x))))
+
+  (defthm strip-cdrs-of-revappend
+    (equal (strip-cdrs (revappend x y))
+           (revappend (strip-cdrs x)
+                      (strip-cdrs y))))
+
+  (defthm strip-cdrs-of-repeat
+    (equal (strip-cdrs (repeat x n))
+           (repeat (cdr x) n))
+    :hints(("Goal" :in-theory (enable repeat))))
+
+  (defthm strip-cdrs-of-take
+    (equal (strip-cdrs (take n x))
+           (take n (strip-cdrs x))))
+
+  (defthm strip-cdrs-of-nthcdr
+    (equal (strip-cdrs (nthcdr n x))
+           (nthcdr n (strip-cdrs x))))
+
+  (defthm strip-cdrs-of-last
+    (equal (strip-cdrs (last x))
+           (last (strip-cdrs x))))
+
+  (defthm strip-cdrs-of-butlast
+    (equal (strip-cdrs (butlast x n))
+           (butlast (strip-cdrs x) n)))
+
+  (defthm strip-cdrs-of-pairlis$
+    (equal (strip-cdrs (pairlis$ x y))
+           (if (<= (len x) (len y))
+               (take (len x) y)
+             (append y (repeat nil (- (len x) (len y))))))
+    :hints(("Goal"
+            :induct (pairlis$ x y)
+            :in-theory (enable repeat)))))
 
diff -Nru acl2-6.2/books/std/alists/top.lisp acl2-6.3/books/std/alists/top.lisp
--- acl2-6.2/books/std/alists/top.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/alists/top.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -28,7 +28,6 @@
 
 (include-book "../lists/top")
 
-(include-book "alist-defuns")
 (include-book "alistp")
 (include-book "alist-keys")
 (include-book "alist-vals")
@@ -42,6 +41,7 @@
 (include-book "strip-cdrs")
 (include-book "pairlis")
 
+(include-book "alist-defuns")
 
 (in-theory (disable alistp
                     hons-assoc-equal
@@ -51,3 +51,121 @@
                     ))
 
 
+(defsection std/alists
+  :parents (std)
+  :short "A library for reasoning about association list (alist) operations
+like @(see alist-keys), @(see alist-vals), @(see hons-get), etc."
+
+  :long "<h3>Introduction</h3>
+
+<p>An association list is a fundamental data structure that
+associates (\"binds\") some @('keys') to @('value')s.  In other programming
+languages, alists may go by names like <i>dictionaries</i>, <i>maps</i>,
+<i>hashes</i>, <i>associative arrays</i>, and the like.</p>
+
+<p>The @('std/alists') library provides functions and lemmas about:</p>
+
+<ul>
+
+<li><b>\"traditional\" alist operations</b> like @(see alistp), @(see assoc),
+and @(see strip-cars), which have long been built into ACL2.</li>
+
+<li><b>\"modern\" alist operations</b> like @(see hons-assoc-equal), @(see
+alist-keys), @(see make-fal), etc., which have better compatibility with the
+@(see fast-alists) of ACL2(h).</li>
+
+</ul>
+
+<p>In the \"traditional\" view, an alist is something recognized by @(see
+alistp)&mdash;a @(see true-listp) of conses.  This @('alistp') recognizer
+serves as a @(see guard) for functions like @(see assoc), @(see rassoc), @(see
+strip-cars), and so forth.</p>
+
+<p>In contrast, in the \"modern\" view, the @(see final-cdr) of an alist is not
+expected to be @('nil'); instead it may be any atom.  (This can be used, e.g.,
+to name @(see fast-alists) and to govern the sizes of their initial hash
+tables; see @(see hons-acons) for details.)  Any traditional @(see alistp) is
+still perfectly valid under this modern view, but these new kinds of alists,
+with their weird final cdrs, are incompatible with traditional alist functions
+like @(see assoc).</p>
+
+
+<h3>The Non-Alist Convention</h3>
+
+<p>Going further, in the modern view, we do not even expect that the elements
+of an alist must necessarily be conses.  Instead, a modern alist function
+simply skips past any atoms in its input.  We call this the <b>non-alist
+convention</b>.</p>
+
+<p>Following the non-alist convention means that functions like @(see
+alist-keys) and @(see hons-assoc-equal) avoid needing any guard, which is
+occasionally convenient.  More importantly, it means that when reasoning about
+modern alist functions, we typically do not need any @(see alistp) style
+hypotheses.  For instance, here is a typical, beautiful, hypothesis-free
+theorem about @(see hons-assoc-equal):</p>
+
+@({
+    (equal (hons-assoc-equal key (append x y))
+           (or (hons-assoc-equal key x)
+               (hons-assoc-equal key y)))
+})
+
+<p>By comparison, the analogous theorem for the traditional @(see assoc)
+function requires a hypothesis like @('(alistp a)') or @('(not (equal key
+nil))').  Without such a hypothesis, we run into \"degenerate\" cases due to
+taking the @(see car)s of arbitrary @(see atom)s.  For instance,</p>
+
+@({
+    let key = nil
+    let x = (nil 1 2)
+    let y = (a b c)
+
+    then (assoc key x) --> nil
+         (assoc key y) --> a
+
+    (assoc nil (append x y))              --> nil   }
+                                                    } different!
+    (or (assoc key x)   -->  (or nil a)   --> a     }
+        (assoc key y))
+})
+
+<p>This weird behavior for @('(assoc nil x)') leads to complications for many
+theorems about traditional alist operations.  Following the non-alist
+convention allows modern alist operations to avoid this problem.</p>
+
+
+<h3>Loading the Library</h3>
+
+<p>The recommended way to load the library, especially for beginning to
+intermediate ACL2 users, is to simply include the top book, e.g.,</p>
+
+@({ (include-book \"std/alists/top\" :dir :system) })
+
+<p>This book loads quickly (typically in under a second), gives you everything
+we have to offer, and sets up a \"recommended\" theory.</p>
+
+<box><p>Note: Loading the @('std/alists/top') book will also result in loading
+the @(see std/lists) library.  See the documentation for @('std/lists') for
+important notes about its @(see equivalence) relations, the functions it will
+@(see disable), etc.</p></box>
+
+
+<h3>Things to Note</h3>
+
+<p>When you include the @('top') book, several basic, built-in ACL2 alist
+functions like @(see alistp), @(see strip-cars), @(see assoc), and so forth
+will be @(see disable)d.  As a result, ACL2 will sometimes not automatically
+try to induct as it did before.  You may find that you need to give explicit
+@(':induct') @(see hints), or explicitly re-@(see enable) these basic functions
+during certain theorems. (On the flip side, you may also find that you are
+spending less time trying to prove theorems using incorrect induction
+schemes.)</p>
+
+<p>A very useful @(see equivalence) relation when working with association
+lists is <b>@(see alist-equiv)</b>, which says whether alists agree on the
+value of every key.  Many alist operations respect this equivalence relation.
+It is generally a good idea to define appropriate @('alist-equiv') @(see
+congruence) rules for new alist-processing functions.</p>")
+
+
+
diff -Nru acl2-6.2/books/std/io/base.lisp acl2-6.3/books/std/io/base.lisp
--- acl2-6.2/books/std/io/base.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/base.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,4 +1,5 @@
 ; Standard IO Library
+; base.lisp
 ; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
@@ -18,11 +19,17 @@
 ;
 ; Original author: Sol Swords <sswords@centtech.com>
 ; Documented by Jared Davis <jared@centtech.com>
-; Moved by David Rager <ragerdl@gmail.com> on 1/10/13.
+; Moved into std by David Rager <ragerdl@gmail.com>
 
 (in-package "ACL2")
 (include-book "xdoc/top" :dir :system)
 (include-book "system/f-put-global" :dir :system)
+(include-book "std/lists/list-defuns" :dir :system)
+(include-book "file-measure")
+(local (include-book "std/lists/append" :dir :system))
+(local (include-book "std/lists/revappend" :dir :system))
+(local (include-book "std/lists/rev" :dir :system))
+(local (include-book "str/coerce" :dir :system))
 
 (defsection bytep
 
@@ -65,21 +72,23 @@
 
 (local (table evisc-table (list 'quote *INITIAL-GLOBAL-TABLE*) "*INITIAL-GLOBAL-TABLE*"))
 
-(defthm assoc-equal-of-add-pair
-    (equal (assoc-equal k1 (add-pair k2 v a))
-           (if (equal k1 k2)
-               (cons k2 v)
-             (assoc-equal k1 a))))
+;; [Jared] Removed because this is now built into ACL2
+;; (defthm assoc-equal-of-add-pair
+;;     (equal (assoc-equal k1 (add-pair k2 v a))
+;;            (if (equal k1 k2)
+;;                (cons k2 v)
+;;              (assoc-equal k1 a))))
 
 (defthm open-channel-listp-of-add-pair
   (implies (and (open-channel1 v)
                 (open-channel-listp x))
            (open-channel-listp (add-pair k v x))))
 
-(defthm ordered-symbol-alistp-of-add-pair
-  (implies (and (symbolp k)
-                (ordered-symbol-alistp x))
-           (ordered-symbol-alistp (add-pair k v x))))
+;; [Jared] Removed because this is now built into ACL2
+;; (defthm ordered-symbol-alistp-of-add-pair
+;;   (implies (and (symbolp k)
+;;                 (ordered-symbol-alistp x))
+;;            (ordered-symbol-alistp (add-pair k v x))))
 
 (defthm open-channels-p-of-add-pair
   (implies (and (symbolp k)
@@ -103,32 +112,13 @@
   :hints(("Goal" :in-theory (enable readable-files-p))))
 
 (defxdoc *file-types*
-  :parents (io)
+  :parents (std/io)
   :short "Different ways to open files for reading and writing."
 
   :long "<p>See @(see io) for general discussion of file types.</p>
 
 @(def *file-types*)")
 
-(defxdoc logical-story-of-io
-  :parents (io)
-  :short "How file reading operations are modeled in the ACL2 logic."
-
-  :long "<p>ACL2's file input operations are available in @(':logic') mode (see
-@(see defun-mode)).  This is somewhat tricky to justify in the logic, since,
-e.g., the contents of a file is external to ACL2, can be changed over time, and
-so on.</p>
-
-<p>Practically speaking, most users don't need to pay any attention to the
-details of this story.  Instead, see the book @('io/base'), which develops
-the basic theorems that are necessary to reason about the io primitives.</p>
-
-<p>If, for some reason, you do want to understand the logical story, you might
-start with this paper:</p>
-
-<p>Jared Davis.  <a
-href='http://www.ccs.neu.edu/home/pete/acl206/papers/davisb.pdf'>Reasoning
-about ACL2 File Input</a>.  ACL2 Workshop 2006.</p>")
 
 
 
@@ -139,9 +129,9 @@
 ;
 ; -----------------------------------------------------------------------------
 
-(defsection open-input-channel
-  :parents (io)
-  :short "Open a file for reading."
+(defsection std/io/open-input-channel
+  :parents (std/io open-input-channel)
+  :short "Open an file for reading."
 
   :long "<p><b>Signature:</b> @(call open-input-channel) returns @('(mv channel
 state)')</p>
@@ -208,157 +198,8 @@
               (mv-nth 1 (open-input-channel fname type state))))
     :hints(("Goal" :in-theory (enable state-p1))))
 
-  ;; We now show that the channel returned by OPEN-INPUT-CHANNEL is never
-  ;;
-  ;;   - ACL2-INPUT-CHANNEL::STANDARD-CHARACTER-INPUT-0, or
-  ;;   - ACL2-INPUT-CHANNEL::STANDARD-OBJECT-INPUT-0.
-  ;;
-  ;; These facts are needed to verify the guards on CLOSE-INPUT-CHANNEL after
-  ;; you open an input channel.
-
-  (local (include-book "std/misc/explode-nonnegative-integer" :dir :system))
-  (local (include-book "std/misc/intern-in-package-of-symbol" :dir :system))
-  (local (include-book "std/lists/coerce" :dir :system))
-
-  (local (defthm lemma-0
-           (implies (and (base10-digit-char-listp y1)
-                         (base10-digit-char-listp y2)
-                         (not (base10-digit-charp x)))
-                    (equal (equal (cons x y1)
-                                  (cons x y2))
-                           (equal y1 y2)))))
-
-  (local (defthm lemma-1
-           (implies (and (base10-digit-char-listp y1)
-                         (base10-digit-char-listp y2)
-                         (not (base10-digit-charp x)))
-                    (not (equal (cons a (cons x y1))
-                                (cons x y2))))))
-
-  (local (defthm lemma-2
-           (implies (and (base10-digit-char-listp y1)
-                         (base10-digit-char-listp y2)
-                         (not (base10-digit-charp x))
-                         (equal (append a (cons x y1))
-                                (cons x y2)))
-                    (not (consp a)))
-           :hints(("Goal" :induct (append a (cons x y1))
-                   :do-not '(generalize)))))
-
-  (local (defthm lemma-3
-           (implies (and (base10-digit-char-listp y1)
-                         (base10-digit-char-listp y2)
-                         (not (base10-digit-charp x)))
-                    (equal (equal (append a (cons x y1))
-                                  (cons x y2))
-                           (and (not (consp a))
-                                (equal y1 y2))))
-           :hints(("Goal"
-                   :in-theory (disable lemma-2)
-                   :use (:instance lemma-2 (a a) (x x) (y1 y1) (y2 y2))))))
-
-  (local (defun cdr-cdr-induction (a1 a2)
-           (if (and (consp a1)
-                    (consp a2))
-               (cdr-cdr-induction (cdr a1) (cdr a2))
-             (list a1 a2))))
-
-  (local (defthm lemma-4
-           (implies (and (base10-digit-char-listp y1)
-                         (base10-digit-char-listp y2)
-                         (not (base10-digit-charp x))
-                         (true-listp a1)
-                         (true-listp a2))
-                    (equal (equal (append a1 (cons x y1))
-                                  (append a2 (cons x y2)))
-                           (and (equal y1 y2)
-                                (equal a1 a2))))
-           :hints(("Goal" :induct (cdr-cdr-induction a1 a2)))))
-
-  (local (defthm lemma-5
-           (implies (and (base10-digit-char-listp y1)
-                         (base10-digit-char-listp y2)
-                         (true-listp x1)
-                         (true-listp x2))
-                    (equal (equal (append x1 (cons #\- y1))
-                                  (append x2 (cons #\- y2)))
-                           (and (equal x1 x2)
-                                (equal y1 y2))))))
-
-  (local (defthm lemma-6
-           (implies (and (true-listp x)
-                         (natp clock))
-                    (equal (equal (append x (cons #\- (explode-atom clock 10)))
-                                  (append x (cons #\- (explode-atom 0 10))))
-                           (equal clock 0)))))
-
-  (local (defthm main-lemma
-           (implies (and (natp clock)
-                         (character-listp x))
-                    (equal (equal (make-input-channel filename clock)
-                                  (intern-in-package-of-symbol
-                                   (coerce (append x (cons #\- (explode-atom 0 10)))
-                                           'string)
-                                   'ACL2-INPUT-CHANNEL::A-RANDOM-SYMBOL-FOR-INTERN))
-                           (and (equal (coerce filename 'list) x)
-                                (equal clock 0))))
-           :hints(("Goal" :in-theory (disable (explode-atom))))))
-
-  (local (defthm coerce-reduction
-           (implies (and (syntaxp (quotep list))
-                         (character-listp list)
-                         (stringp x))
-                    (equal (equal (coerce x 'list) list)
-                           (equal x (coerce list 'string))))))
-
-  (local (defthm make-input-channel-standard-character-input-0
-           (implies (and (stringp filename)
-                         (natp clock))
-                    (equal (equal (make-input-channel filename clock)
-                                  'ACL2-INPUT-CHANNEL::STANDARD-CHARACTER-INPUT-0)
-                           (and (equal filename "STANDARD-CHARACTER-INPUT")
-                                (equal clock 0))))
-           :hints(("Goal"
-                   :in-theory (disable main-lemma)
-                   :use ((:instance main-lemma
-                                    (clock clock)
-                                    (filename filename)
-                                    (x (coerce "STANDARD-CHARACTER-INPUT" 'list))))))))
-
-  (local (defthm make-input-channel-standard-object-input-0
-           (implies (and (stringp filename)
-                         (natp clock))
-                    (equal (equal (make-input-channel filename clock)
-                                  'ACL2-INPUT-CHANNEL::STANDARD-OBJECT-INPUT-0)
-                           (and (equal filename "STANDARD-OBJECT-INPUT")
-                                (equal clock 0))))
-           :hints(("Goal"
-                   :in-theory (disable main-lemma)
-                   :use ((:instance main-lemma
-                                    (clock clock)
-                                    (filename filename)
-                                    (x (coerce "STANDARD-OBJECT-INPUT" 'list))))))))
-
 
-  (local (defthm open-input-channel-channel-elim
-           (implies (and (mv-nth 0 (open-input-channel filename type state))
-                         (state-p1 state))
-                    (equal (mv-nth 0 (open-input-channel filename type state))
-                           (make-input-channel filename (1+ (file-clock state)))))))
-
-  (defthm open-input-channel-not-standard-object-input
-    (implies (and (stringp filename)
-                  (state-p1 state))
-             (not (equal (mv-nth 0 (open-input-channel filename type state))
-                         'ACL2-INPUT-CHANNEL::STANDARD-OBJECT-INPUT-0)))
-    :hints(("Goal" :in-theory (disable make-input-channel))))
-
-  (defthm open-input-channel-not-standard-character-input
-    (implies (and (stringp filename)
-                  (state-p1 state))
-             (not (equal (mv-nth 0 (open-input-channel filename type state))
-                         'ACL2-INPUT-CHANNEL::STANDARD-CHARACTER-INPUT-0)))
-    :hints(("Goal" :in-theory (disable make-input-channel)))))
+  )
 
 
 ;; helper theorems for reading
@@ -385,8 +226,8 @@
 
 
 
-(defsection close-input-channel
-  :parents (io)
+(defsection std/io/close-input-channel
+  :parents (std/io close-input-channel)
   :short "Close an input channel."
 
   :long "<p><b>Signature</b>: @(call close-input-channel) returns
@@ -441,8 +282,8 @@
                                        open-input-channel-p1
                                        open-input-channel)))))
 
-(defsection read-char$
-  :parents (io)
+(defsection std/io/read-char$
+  :parents (std/io read-char$)
   :short "Read one character from an open @(':character') stream."
 
   :long "<p>NOTE: We generally prefer to avoid @(see read-char$).  It is easy
@@ -566,8 +407,8 @@
                                   (or (characterp (mv-nth 0 (read-char$ channel state)))
                                       (null (mv-nth 0 (read-char$ channel state)))))))))
 
-(defsection peek-char$
-  :parents (io)
+(defsection std/io/peek-char$
+  :parents (std/io peek-char$)
   :short "Inspect the next character that will be read from an open
 @(':character') input stream."
 
@@ -600,8 +441,8 @@
   (in-theory (disable peek-char$)))
 
 
-(defsection read-byte$
-  :parents (io)
+(defsection std/io/read-byte$
+  :parents (std/io read-byte$)
   :short "Read one byte from an open @(':byte') stream."
 
   :long "<p><b>Signature:</b> @(call read-byte$) returns @('(mv byte/nil
@@ -716,8 +557,8 @@
     :hints(("Goal" :in-theory (disable open-input-channel-p1)))))
 
 
-(defsection read-object
-  :parents (io)
+(defsection std/io/read-object
+  :parents (std/io read-object)
   :short "Read one object from an open @(':object') stream."
 
   :long "<p><b>Signature:</b> @(call read-object) returns @('(mv eofp obj
@@ -825,7 +666,7 @@
           :hints(("Goal" :in-theory (enable nth update-nth)))))
 
  (defsection char
-   :extension read-char$
+   :extension std/io/read-char$
    (defthm state-preserved-by-read-char$-when-eof
      (implies (and (not (mv-nth 0 (read-char$ channel state)))
                    (state-p1 state)
@@ -835,7 +676,7 @@
      :hints(("Goal" :in-theory (e/d (read-char$ state-p1))))))
 
  (defsection byte
-   :extension read-byte$
+   :extension std/io/read-byte$
    (defthm state-preserved-by-read-byte$-when-eof
      (implies (and (not (mv-nth 0 (read-byte$ channel state)))
                    (state-p1 state)
@@ -845,7 +686,7 @@
      :hints(("Goal" :in-theory (e/d (read-byte$ state-p1))))))
 
  (defsection object
-   :extension read-object$
+   :extension std/io/read-object$
    (defthm state-preserved-by-read-object-when-eof
      (implies (and (mv-nth 0 (read-object channel state))
                    (state-p1 state)
@@ -862,8 +703,8 @@
 ;
 ; -----------------------------------------------------------------------------
 
-(defsection open-output-channel
-  :parents (io)
+(defsection std/io/open-output-channel
+  :parents (std/io open-output-channel)
   :short "Open a file for writing."
 
   :long "<p><b>Signature:</b> @(call open-output-channel) returns @('(mv
@@ -955,8 +796,8 @@
 
 
 
-(defsection close-output-channel
-  :parents (io)
+(defsection std/io/close-output-channel
+  :parents (std/io close-output-channel)
   :short "Close an output channel."
 
   :long "<p><b>Signature</b>: @(call close-output-channel) returns
@@ -1027,35 +868,31 @@
                 (equal (cadar x) :object))
            (open-channel1 (list* (car x) y (cdr x)))))
 
+(defthm typed-io-listp-of-append
+  (equal (typed-io-listp (append x y) type)
+         (and (typed-io-listp (list-fix x) type)
+              (typed-io-listp y type))))
+
+(defthm typed-io-listp-of-rev
+  (equal (typed-io-listp (rev x) type)
+         (typed-io-listp (list-fix x) type))
+  :hints(("Goal" :in-theory (enable rev))))
+
 (defthm open-channel1-of-revappend-charlist
   (implies (and (open-channel1 x)
                 (equal (cadar x) :character)
                 (character-listp y))
-           (open-channel1 (cons (car x) (revappend y (cdr x)))))
-  :otf-flg t)
-
-;; matches unicode/explode-nonnegative-integer.lisp
-(defthm character-listp-of-explode-nonnegative-integer
-  (equal (character-listp (explode-nonnegative-integer n base acc))
-         (character-listp acc))
-  :hints(("Goal" :in-theory (disable floor mod digit-to-char))))
-
-;; does NOT match unicode/explode-atom.lisp (so we renamed this theorem).
-;; unicode version includes print-base-p hyp.
-(defthm character-listp-explode-atom
-  (character-listp (explode-atom x base)))
-
-; Added by Matt K. for princ$ change 12/7/2012.
-(defthm character-listp-explode-atom+
-  (character-listp (explode-atom+ x base radix)))
+           (open-channel1 (cons (car x) (append (rev y) (cdr x))))))
 
 
+(defsection std/io/princ$
+  :parents (std/io princ$)
+  :short "Print an atom to a @(':character') output stream."
+  :long "<p>ACL2 has nice documentation for @(see princ$).  The @(see std/io)
+library adds the following lemmas:</p>"
 
-;; I-AM-HERE
-(defsection princ$
-  :parents (io)
-  ;; BOZO ACL2's documentation for princ$ is nice, it'd be good to have a better
-  ;; integration between it and XDOC.
+  (local (include-book "str/explode-nonnegative-integer" :dir :system))
+  (local (include-book "str/explode-atom" :dir :system))
 
   (defthm state-p1-of-princ$
     (implies (and (state-p1 state)
@@ -1067,13 +904,33 @@
   (defthm open-output-channel-p1-of-princ$
     (implies (and (state-p1 state)
                   (open-output-channel-p1 channel :character state))
-             (open-output-channel-p1 channel :character (princ$ x channel state)))))
+             (open-output-channel-p1 channel :character
+                                     (princ$ x channel state)))))
+
 
+(defsection std/io/write-byte$
+  :parents (std/io write-byte$)
+  :short "Write one byte to an open @(':byte') output stream."
+  :long "<p><b>Signature:</b> @(call write-byte$) returns @('state').</p>
 
-(defsection write-byte$
-  :parents (io)
+<ul>
+
+<li>@('byte') must be a natural number with @('byte < 256').</li>
+
+<li>@('channel') is a symbol that must refer to an open @(':byte') input
+channel; see @(see open-input-channel).</li>
+
+<li>@('state') is the ACL2 @(see state).</li>
+
+</ul>
+
+<p>This is a @(see logic)-mode function, but its logical definition is tricky;
+see @(see logical-story-of-io).  The main logical consequence is the updating
+of state.</p>
+
+<p>Under the hood, we write a byte to the Lisp output stream that is associated
+with @('channel').</p>"
 
-  ;; Write-byte$
   (defthm state-p1-of-write-byte$
     (implies (and (state-p1 state)
                   (symbolp channel)
@@ -1086,13 +943,15 @@
   (defthm open-output-channel-p1-of-write-byte$
     (implies (and (state-p1 state)
                   (open-output-channel-p1 channel :byte state))
-             (open-output-channel-p1 channel :byte (write-byte$ byte channel state)))))
+             (open-output-channel-p1 channel :byte
+                                     (write-byte$ byte channel state)))))
 
 
-(defsection print-object$
-  :parents (io)
+(defsection std/io/print-object$
+  :parents (std/io print-object$)
+  :short "Print a Lisp object to an @(':object') output stream."
+  :long "<p>BOZO document me.</p>"
 
-  ;; print-object$
   (defthm state-p1-of-print-object$
     (implies (and (state-p1 state)
                   (symbolp channel)
@@ -1103,16 +962,21 @@
   (defthm open-output-channel-p1-of-print-object$
     (implies (and (state-p1 state)
                   (open-output-channel-p1 channel :object state))
-             (open-output-channel-p1 channel :object (print-object$ x channel state)))))
+             (open-output-channel-p1 channel
+                                     :object (print-object$ x channel state)))))
+
+
 
 
+(defsection open-channels-distinct-from-standard-io
+  :parents (open-input-channel open-output-channel)
+  :short "Technical lemmas to show that opening input/output channels does not
+produce a symbol like @('ACL2-OUTPUT-CHANNEL::STANDARD-CHARACTER-OUTPUT-0'),
+for the guards of @(see close-input-channel) and @(see close-output-channel)."
+
+;; This is true because symbol created ends in "-" and then the new file clock,
+;; which is at least 1.  Blech!
 
-;; Close-output-channel's guard requires that the channel is not the symbol:
-;; ACL2-OUTPUT-CHANNEL::STANDARD-CHARACTER-OUTPUT-0.
-;; So we need to prove that this symbol is never returned from
-;; open-output-channel.  This is true because symbol created ends in "-" and
-;; then the new file clock, which is at least 1.  Blech!
-(encapsulate nil
   (local (in-theory (disable floor mod print-base-p)))
   (local (include-book "ihs/quotient-remainder-lemmas" :dir :system))
 
@@ -1163,7 +1027,7 @@
            :hints(("Goal" ; :in-theory (enable mod)
                    :expand ((:free (base) (explode-nonnegative-integer x base ans)))
                    :use ((:instance explode-nonnegative-integer-length-incr-strict
-                          (n (* (/ base) x)) (ans (cons #\0 ans))))
+                                    (n (* (/ base) x)) (ans (cons #\0 ans))))
                    :do-not-induct t))
            :otf-flg t))
 
@@ -1173,7 +1037,7 @@
                     (charlist-suffixp (cdr x) suff)))))
 
   (local (defun symb-ends-in-dash-zero (x)
-           (charlist-suffixp (coerce (symbol-name x) 'list)
+           (charlist-suffixp (explode (symbol-name x))
                              '(#\- #\0))))
 
   (local (defthm suffixp-dash-zero-implies-member-dash
@@ -1250,92 +1114,6 @@
     :hints(("Goal" :in-theory (disable make-input-channel)))))
 
 
-(defsection file-measure
-  :parents (io)
-  :short "A measure for admitting functions that read from files."
-
-  :long "<p><b>Signature:</b> @(call file-measure) returns a natural
-number.</p>
-
-<ul>
-
-<li>@('channel') may be any symbol but is typically an open input channel.</li>
-
-<li>@('state-state') is typically the ACL2 @(see state).</li>
-
-</ul>
-
-<p>This is a @(see logic)-mode function, but its logical definition is tricky;
-see @(see logical-story-of-io).  The basic gist is that it returns how many
-objects are left in the channel and hence how many functions can still be
-read.</p>
-
-<p>This function is only meant to be used to admit functions, and cannot be
-executed on the real ACL2 @(see state).</p>
-
-<p>History.  Jared wrote an initial version of this function for the Unicode
-books.  Sol then extended it with a hack that allows us to prove it decreasing
-without assuming state-p1 in the object case.  (Really it's just a workaround
-for the fact that read-object checks @('(cdr entry)') as a substitute for
-@('(consp (cdr entry))') to find whether there are objects remaining.</p>"
-
-  (defun file-measure (channel state-state)
-    (declare (xargs :guard (and (symbolp channel)
-                                (state-p1 state-state))))
-    (+ (len (cddr (assoc-equal channel (open-input-channels state-state))))
-       (if (consp (cddr (assoc-equal channel (open-input-channels state-state))))
-           (if (cdr (last (cddr (assoc-equal channel (open-input-channels
-                                                      state-state))))) 1 0)
-         (if (cddr (assoc-equal channel (open-input-channels state-state))) 1 0))))
-
-  (defthm file-measure-of-read-byte$-weak
-    (<= (file-measure channel (mv-nth 1 (read-byte$ channel state)))
-        (file-measure channel state))
-    :rule-classes (:rewrite :linear))
-
-  (defthm file-measure-of-read-byte$-strong
-    (implies (mv-nth 0 (read-byte$ channel state))
-             (< (file-measure channel (mv-nth 1 (read-byte$ channel state)))
-                (file-measure channel state)))
-    :rule-classes (:rewrite :linear))
-
-  (defthm file-measure-of-read-byte$-rw
-    (implies (mv-nth 0 (read-byte$ channel state))
-             (equal (file-measure channel (mv-nth 1 (read-byte$ channel state)))
-                    (+ -1 (file-measure channel state)))))
-
-  (defthm file-measure-of-read-char$-weak
-    (<= (file-measure channel (mv-nth 1 (read-char$ channel state)))
-        (file-measure channel state))
-    :rule-classes (:rewrite :linear))
-
-  (defthm file-measure-of-read-char$-strong
-    (implies (mv-nth 0 (read-char$ channel state))
-             (< (file-measure channel (mv-nth 1 (read-char$ channel state)))
-                (file-measure channel state)))
-    :rule-classes (:rewrite :linear))
-
-  (defthm file-measure-of-read-char$-rw
-    (implies (mv-nth 0 (read-char$ channel state))
-             (equal (file-measure channel (mv-nth 1 (read-char$ channel state)))
-                    (1- (file-measure channel state)))))
-
-  (defthm file-measure-of-read-object-weak
-    (<= (file-measure channel (mv-nth 2 (read-object channel state)))
-        (file-measure channel state))
-    :rule-classes (:rewrite :linear))
-
-  (defthm file-measure-of-read-object-strong
-    (implies (not (mv-nth 0 (read-object channel state)))
-             (< (file-measure channel (mv-nth 2 (read-object channel state)))
-                (file-measure channel state)))
-    :rule-classes (:rewrite :linear))
-
-  (defthm file-measure-of-read-object-rw
-    (implies (not (mv-nth 0 (read-object channel state)))
-             (equal (file-measure channel (mv-nth 2 (read-object channel state)))
-                    (1- (file-measure channel state))))))
-
 
 (in-theory (disable state-p1
                     open-input-channel-p1
diff -Nru acl2-6.2/books/std/io/cert.acl2 acl2-6.3/books/std/io/cert.acl2
--- acl2-6.2/books/std/io/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/io/cert.acl2	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,22 @@
+; Standard IO Library
+; cert.acl2
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+(in-package "ACL2")
+(include-book "str/portcullis" :dir :system)
+
diff -Nru acl2-6.2/books/std/io/close-input-channel.lisp acl2-6.3/books/std/io/close-input-channel.lisp
--- acl2-6.2/books/std/io/close-input-channel.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/close-input-channel.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; cert_param: (reloc_stub)
-(include-book "base")
diff -Nru acl2-6.2/books/std/io/combine.lisp acl2-6.3/books/std/io/combine.lisp
--- acl2-6.2/books/std/io/combine.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/combine.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,26 +1,21 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
+; Standard IO Library
+; combine.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (in-package "ACL2")
-(include-book "xdoc/top" :dir :system)
-(include-book "sign-byte")
-(include-book "tools/bstar" :dir :system)
-(local (include-book "unsigned-byte-listp"))
-(local (include-book "signed-byte-listp"))
+(include-book "centaur/bitops/sign-extend" :dir :system)
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "centaur/bitops/signed-byte-p" :dir :system))
 (set-verify-guards-eagerness 2)
 
 
@@ -51,6 +46,7 @@
              (unsigned-byte-p 16 (combine16u a1 a0)))))
 
 
+
 (defsection combine16s
   :parents (combine-functions)
   :short "@(call combine16s) merges unsigned bytes, producing the 16-bit signed
@@ -59,12 +55,13 @@
   (defund-inline combine16s (a1 a0)
     (declare (type (unsigned-byte 8) a1 a0))
     (mbe :logic
-         (logior (ash (sign-byte (nfix a1)) 8)
+         (logior (ash (sign-extend 8 (nfix a1)) 8)
                  (nfix a0))
          :exec
          (the (signed-byte 16)
            (logior (the (signed-byte 16)
-                     (ash (the (signed-byte 8) (sign-byte a1))
+                     (ash (the (signed-byte 8)
+                            (sign-extend 8 a1))
                           8))
                    a0))))
 
@@ -76,6 +73,7 @@
              (signed-byte-p 16 (combine16s a1 a0)))))
 
 
+
 (defsection combine32u
   :parents (combine-functions)
   :short "@(call combine32u) merges unsigned bytes, producing the 32-bit
@@ -123,7 +121,7 @@
   (defund-inline combine32s (a3 a2 a1 a0)
     (declare (type (unsigned-byte 8) a3 a2 a1 a0))
     (mbe :logic
-         (logior (ash (sign-byte (nfix a3)) 24)
+         (logior (ash (sign-extend 8 (nfix a3)) 24)
                  (ash (nfix a2) 16)
                  (ash (nfix a1) 8)
                  (nfix a0))
@@ -131,7 +129,7 @@
          ;; Ugly series of LOGIORs because CCL won't optimize multi-arg LOGIORs
          ;; into fixnum computations...
          (b* ((a3  (the (signed-byte 32)
-                     (ash (the (signed-byte 8) (sign-byte a3))
+                     (ash (the (signed-byte 8) (sign-extend 8 a3))
                           24)))
               (a2  (the (unsigned-byte 24) (ash a2 16)))
               (a1  (the (unsigned-byte 16) (ash a1 8)))
@@ -227,7 +225,7 @@
   (defund-inline combine64s (a7 a6 a5 a4 a3 a2 a1 a0)
     (declare (type (unsigned-byte 8) a7 a6 a5 a4 a3 a2 a1 a0))
     (mbe :logic
-         (logior (ash (sign-byte (nfix a7)) 56)
+         (logior (ash (sign-extend 8 (nfix a7)) 56)
                  (ash (nfix a6) 48)
                  (ash (nfix a5) 40)
                  (ash (nfix a4) 32)
@@ -264,7 +262,7 @@
                              (the (unsigned-byte 56) ans))))
               ;; Can't really do better here... :(
               (a7 (the (signed-byte 64)
-                    (ash (the (signed-byte 8) (sign-byte a7))
+                    (ash (the (signed-byte 8) (sign-extend 8 a7))
                          56))))
            (the (signed-byte 64)
              (logior (the (signed-byte 64) a7)
diff -Nru acl2-6.2/books/std/io/file-measure.lisp acl2-6.3/books/std/io/file-measure.lisp
--- acl2-6.2/books/std/io/file-measure.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/io/file-measure.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,103 @@
+; Standard IO Library
+; file-measure.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; History.  Jared wrote an initial version of this function for the Unicode
+; books.  Sol then extended it with a hack that allows us to prove it
+; decreasing without assuming state-p1 in the object case.  (Really it's just a
+; workaround for the fact that read-object checks (cdr entry) as a substitute
+; for (consp (cdr entry)) to find whether there are objects remaining.
+
+(in-package "ACL2")
+(include-book "xdoc/top" :dir :system)
+(local (include-book "system/f-put-global" :dir :system))
+
+(defsection file-measure
+  :parents (std/io)
+  :short "A measure for admitting functions that read from files."
+
+  :long "<p><b>Signature:</b> @(call file-measure) returns a natural
+number.</p>
+
+<ul>
+
+<li>@('channel') may be any symbol but is typically an open input channel.</li>
+
+<li>@('state-state') is typically the ACL2 @(see state).</li>
+
+</ul>
+
+<p>This is a @(see logic)-mode function, but its logical definition is tricky;
+see @(see logical-story-of-io).  The basic gist is that it returns how many
+objects are left in the channel and hence how many functions can still be
+read.</p>
+
+<p>This function is only meant to be used to admit functions, and cannot be
+executed on the real ACL2 @(see state).</p>"
+
+  (defun file-measure (channel state-state)
+    (declare (xargs :guard (and (symbolp channel)
+                                (state-p1 state-state))))
+    (+ (len (cddr (assoc-equal channel (open-input-channels state-state))))
+       (if (consp (cddr (assoc-equal channel (open-input-channels state-state))))
+           (if (cdr (last (cddr (assoc-equal channel (open-input-channels
+                                                      state-state))))) 1 0)
+         (if (cddr (assoc-equal channel (open-input-channels state-state))) 1 0))))
+
+  (defthm file-measure-of-read-byte$-weak
+    (<= (file-measure channel (mv-nth 1 (read-byte$ channel state)))
+        (file-measure channel state))
+    :rule-classes (:rewrite :linear))
+
+  (defthm file-measure-of-read-byte$-strong
+    (implies (mv-nth 0 (read-byte$ channel state))
+             (< (file-measure channel (mv-nth 1 (read-byte$ channel state)))
+                (file-measure channel state)))
+    :rule-classes (:rewrite :linear))
+
+  (defthm file-measure-of-read-byte$-rw
+    (implies (mv-nth 0 (read-byte$ channel state))
+             (equal (file-measure channel (mv-nth 1 (read-byte$ channel state)))
+                    (+ -1 (file-measure channel state)))))
+
+  (defthm file-measure-of-read-char$-weak
+    (<= (file-measure channel (mv-nth 1 (read-char$ channel state)))
+        (file-measure channel state))
+    :rule-classes (:rewrite :linear))
+
+  (defthm file-measure-of-read-char$-strong
+    (implies (mv-nth 0 (read-char$ channel state))
+             (< (file-measure channel (mv-nth 1 (read-char$ channel state)))
+                (file-measure channel state)))
+    :rule-classes (:rewrite :linear))
+
+  (defthm file-measure-of-read-char$-rw
+    (implies (mv-nth 0 (read-char$ channel state))
+             (equal (file-measure channel (mv-nth 1 (read-char$ channel state)))
+                    (1- (file-measure channel state)))))
+
+  (defthm file-measure-of-read-object-weak
+    (<= (file-measure channel (mv-nth 2 (read-object channel state)))
+        (file-measure channel state))
+    :rule-classes (:rewrite :linear))
+
+  (defthm file-measure-of-read-object-strong
+    (implies (not (mv-nth 0 (read-object channel state)))
+             (< (file-measure channel (mv-nth 2 (read-object channel state)))
+                (file-measure channel state)))
+    :rule-classes (:rewrite :linear))
+
+  (defthm file-measure-of-read-object-rw
+    (implies (not (mv-nth 0 (read-object channel state)))
+             (equal (file-measure channel (mv-nth 2 (read-object channel state)))
+                    (1- (file-measure channel state))))))
diff -Nru acl2-6.2/books/std/io/nthcdr-bytes.lisp acl2-6.3/books/std/io/nthcdr-bytes.lisp
--- acl2-6.2/books/std/io/nthcdr-bytes.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/nthcdr-bytes.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,110 +1,122 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
+; Standard IO Library
+; nthcdr-bytes.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (in-package "ACL2")
+(include-book "file-measure")
 (include-book "read-file-bytes")
+(local (include-book "base"))
 (local (include-book "tools/mv-nth" :dir :system))
 (set-state-ok t)
 
-(defund nthcdr-bytes (n channel state)
-  (declare (xargs :guard (and (natp n)
-                              (state-p state)
-                              (symbolp channel)
-                              (open-input-channel-p channel :byte state))))
-  (if (zp n)
-      state
-    (mv-let (byte state)
-            (read-byte$ channel state)
-            (declare (ignore byte))
-            (nthcdr-bytes (+ n -1) channel state))))
-
-(defthm state-p1-of-nthcdr-bytes
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (state-p1 (nthcdr-bytes n channel state)))
-  :hints(("Goal" :in-theory (enable nthcdr-bytes))))
-
-(defthm open-input-channel-p1-of-nthcdr-bytes
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (open-input-channel-p1 channel :byte (nthcdr-bytes n channel state)))
-  :hints(("Goal" :in-theory (enable nthcdr-bytes))))
-
-(defthm read-byte$-all-of-nthcdr-bytes
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (equal (mv-nth 0 (read-byte$-all channel (nthcdr-bytes n channel state)))
-                  (nthcdr n (mv-nth 0 (read-byte$-all channel state)))))
-  :hints(("Goal"
-          :in-theory (enable nthcdr-bytes nthcdr read-byte$-all)
-          :induct (nthcdr-bytes n channel state))))
-
-(defthm nthcdr-bytes-1
-  (equal (nthcdr-bytes 1 channel state)
-         (mv-nth 1 (read-byte$ channel state)))
-  :hints(("Goal"
-          :in-theory (enable nthcdr-bytes)
-          :expand ((nthcdr-bytes 1 channel state)))))
-
-(defthm nthcdr-bytes-2
-  (equal (nthcdr-bytes 2 channel state)
-         (mv-nth 1 (read-byte$ channel
-                               (mv-nth 1 (read-byte$ channel state)))))
-  :hints(("Goal" :in-theory (enable nthcdr-bytes))))
-
-(defthm nthcdr-bytes-3
-  (equal (nthcdr-bytes 3 channel state)
-         (mv-nth 1 (read-byte$
-                    channel
-                    (mv-nth 1 (read-byte$
-                               channel
-                               (mv-nth 1 (read-byte$ channel state)))))))
-  :hints(("Goal" :in-theory (enable nthcdr-bytes))))
-
-(defthm nthcdr-bytes-4
-  (equal (nthcdr-bytes 4 channel state)
-         (mv-nth 1 (read-byte$
-                    channel
-                    (mv-nth 1 (read-byte$
-                               channel
-                               (mv-nth 1 (read-byte$
-                                          channel
-                                          (mv-nth 1 (read-byte$ channel state)))))))))
-  :hints(("Goal" :in-theory (enable nthcdr-bytes))))
-
-(defthm nthcdr-bytes-measure-weak
-  (implies (and (force (state-p1 state))
-                (force (open-input-channel-p1 channel :byte state))
-                (force (symbolp channel)))
-           (<= (file-measure channel (nthcdr-bytes n channel state))
-               (file-measure channel state)))
-  :rule-classes (:rewrite :linear)
-  :hints(("Goal" :in-theory (enable nthcdr-bytes))))
-
-(defthm nthcdr-bytes-measure-strong
-  (implies (and (mv-nth 0 (read-byte$ channel state))
-                (not (zp n))
-                (force (state-p1 state))
-                (force (open-input-channel-p1 channel :byte state))
-                (force (symbolp channel)))
-           (< (file-measure channel (nthcdr-bytes n channel state))
-              (file-measure channel state)))
-  :rule-classes (:rewrite :linear)
-  :hints(("Goal" :in-theory (enable nthcdr-bytes))))
+(defsection nthcdr-bytes
+  :parents (std/io)
+  :short "Skip past some number of bytes in an open file."
+  :long "<p>@(call nthcdr-bytes) is like @(see nthcdr) for an @(':byte') input
+channel.  That is, it just reads @('n') bytes and ignores them, returning the
+updated state.</p>
+
+<p>This is notably useful as a way to express the post-state after @(see
+take-bytes).</p>"
+
+  (defund nthcdr-bytes (n channel state)
+    (declare (xargs :guard (and (natp n)
+                                (state-p state)
+                                (symbolp channel)
+                                (open-input-channel-p channel :byte state))))
+    (b* (((when (zp n))
+          state)
+         ((mv ?byte state)
+          (read-byte$ channel state)))
+      (nthcdr-bytes (- n 1) channel state)))
+
+  (local (in-theory (enable nthcdr-bytes)))
+
+  (defthm state-p1-of-nthcdr-bytes
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (state-p1 (nthcdr-bytes n channel state)))
+    :hints(("Goal" :in-theory (enable nthcdr-bytes))))
+
+  (defthm open-input-channel-p1-of-nthcdr-bytes
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (open-input-channel-p1 channel :byte (nthcdr-bytes n channel state)))
+    :hints(("Goal" :in-theory (enable nthcdr-bytes))))
+
+  (defthm read-byte$-all-of-nthcdr-bytes
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (equal (mv-nth 0 (read-byte$-all channel (nthcdr-bytes n channel state)))
+                    (nthcdr n (mv-nth 0 (read-byte$-all channel state)))))
+    :hints(("Goal"
+            :in-theory (enable nthcdr-bytes nthcdr read-byte$-all)
+            :induct (nthcdr-bytes n channel state))))
+
+  ;; BOZO these are really hideous!
+
+  (defthm nthcdr-bytes-1
+    (equal (nthcdr-bytes 1 channel state)
+           (mv-nth 1 (read-byte$ channel state)))
+    :hints(("Goal"
+            :in-theory (enable nthcdr-bytes)
+            :expand ((nthcdr-bytes 1 channel state)))))
+
+  (defthm nthcdr-bytes-2
+    (equal (nthcdr-bytes 2 channel state)
+           (mv-nth 1 (read-byte$ channel
+                                 (mv-nth 1 (read-byte$ channel state)))))
+    :hints(("Goal" :in-theory (enable nthcdr-bytes))))
+
+  (defthm nthcdr-bytes-3
+    (equal (nthcdr-bytes 3 channel state)
+           (mv-nth 1 (read-byte$
+                      channel
+                      (mv-nth 1 (read-byte$
+                                 channel
+                                 (mv-nth 1 (read-byte$ channel state)))))))
+    :hints(("Goal" :in-theory (enable nthcdr-bytes))))
+
+  (defthm nthcdr-bytes-4
+    (equal (nthcdr-bytes 4 channel state)
+           (mv-nth 1 (read-byte$
+                      channel
+                      (mv-nth 1 (read-byte$
+                                 channel
+                                 (mv-nth 1 (read-byte$
+                                            channel
+                                            (mv-nth 1 (read-byte$ channel state)))))))))
+    :hints(("Goal" :in-theory (enable nthcdr-bytes))))
+
+  (defthm nthcdr-bytes-measure-weak
+    (implies (and (force (state-p1 state))
+                  (force (open-input-channel-p1 channel :byte state))
+                  (force (symbolp channel)))
+             (<= (file-measure channel (nthcdr-bytes n channel state))
+                 (file-measure channel state)))
+    :rule-classes (:rewrite :linear)
+    :hints(("Goal" :in-theory (enable nthcdr-bytes))))
+
+  (defthm nthcdr-bytes-measure-strong
+    (implies (and (mv-nth 0 (read-byte$ channel state))
+                  (not (zp n))
+                  (force (state-p1 state))
+                  (force (open-input-channel-p1 channel :byte state))
+                  (force (symbolp channel)))
+             (< (file-measure channel (nthcdr-bytes n channel state))
+                (file-measure channel state)))
+    :rule-classes (:rewrite :linear)
+    :hints(("Goal" :in-theory (enable nthcdr-bytes)))))
diff -Nru acl2-6.2/books/std/io/open-input-channel.lisp acl2-6.3/books/std/io/open-input-channel.lisp
--- acl2-6.2/books/std/io/open-input-channel.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/open-input-channel.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; cert_param: (reloc_stub)
-(include-book "base")
diff -Nru acl2-6.2/books/std/io/open-input-channels.lisp acl2-6.3/books/std/io/open-input-channels.lisp
--- acl2-6.2/books/std/io/open-input-channels.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/open-input-channels.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,193 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-; The open input channels table is the logical fiction that supports our
-; ability to read from files.  When a file is opened, it is added to this
-; table.  When it is read from, we consult this table to find its contents and
-; update the table to consume one object of input.  When it is closed, this
-; table must be updated to handle the closure.  The table itself is just an
-; object that satisfies open-channels-p, and it is easy to show that calling
-; open-input-channels on a state returns an object of this form.
-
-(defthm open-input-channels-ok
-  (implies (state-p1 state)
-           (open-channels-p (open-input-channels state))))
-
-(defthm ordered-symbol-alistp-of-open-input-channels
-  (implies (state-p1 state)
-           (ordered-symbol-alistp (open-input-channels state))))
-
-
-
-; We typically update this table by using the function add-pair.  We will find
-; several lemmas about this function to be useful.  First, we give a very nice
-; little rewrite rule that shows that add-pair does indeed act as we would
-; expect with respect to assoc-equal.  (Note that we canonicalize all uses of
-; assoc-eq and assoc to their assoc-equal form, so this will cover those cases
-; as well after rewriting.)
-
-(defthm add-pair-assoc-equal
-  (equal (assoc-equal key1 (add-pair key2 val alist))
-         (if (equal key1 key2)
-             (cons key2 val)
-           (assoc-equal key1 alist))))
-
-
-
-; In order to prove that an update to our open channels list preserves the
-; basic open-channels-p property, we will need to show that such updates
-; satisfy both ordered-symbol-alistp and open-channel-listp.  We introduce the
-; lemmas below towards this purpose.
-
-(defthm add-pair-ordered-symbol-alistp
-  (implies (ordered-symbol-alistp list)
-           (equal (ordered-symbol-alistp (add-pair key val list))
-                  (symbolp key))))
-
-(defthm delete-assoc-eq-ordered-symbol-alistp
-  (implies (ordered-symbol-alistp list)
-           (ordered-symbol-alistp (delete-assoc-eq key list))))
-
-(defthm add-pair-open-channel-listp
-  (implies (open-channel-listp list)
-           (equal (open-channel-listp (add-pair key val list))
-                  (open-channel1 val))))
-
-(defthm delete-assoc-eq-open-channel-listp
-  (implies (open-channel-listp list)
-           (open-channel-listp (delete-assoc-eq key list))))
-
-(defthm add-pair-open-channels-p
-  (implies (open-channels-p list)
-           (equal (open-channels-p (add-pair key val list))
-                  (and (symbolp key)
-                       (open-channel1 val)))))
-
-(defthm delete-assoc-eq-open-channels-p
-  (implies (open-channels-p list)
-           (open-channels-p (delete-assoc-eq key list))))
-
-
-
-; If we grab something out of the open channels list, what can we say about it?
-; Well, by looking at the definition of open-channel-listp, the most obvious
-; thing to do is to prove that it is an open-channel1, and then to prove
-; properties about such objects instead of having to reason about assoc'ing
-; into an open channel list all the time.  Towards this end, we will show that
-; if we find a channel in an open-channels-p list, it is an open-channel1, and
-; if we have an open-channel1, we know that its contents are a typed list of
-; the correct type.
-
-(defthm open-channels-assoc
-  (implies (and (open-channels-p x)
-                (assoc-equal channel x))
-           (open-channel1 (cdr (assoc-equal channel x)))))
-
-(defthm open-channel1-contents-type
-  (implies (open-channel1 x)
-           (typed-io-listp (cdr x) (cadar x))))
-
-
-
-; Now, here is a lemma that we'll use to show that our reading operations
-; preserve open-channel1.  The form (cons (car x) (cddr x)) below is a basic
-; operation which preserves the header of an open channel's contents, while
-; eliminating the first element of its contents.  Here we show that this usage
-; preserves open-channel1.
-
-(defthm open-channel1-advance
-  (implies (open-channel1 x)
-           (open-channel1 (cons (car x) (cddr x)))))
-
-
-
-; All of our reading operations require that we have an open input channel of
-; the right type, i.e., that (open-input-channel-p1 channel type state) is true
-; of our state.  What can we conclude given that this holds for some state?
-; First off, we know that looking up the channel in the open-input-channels
-; list will be successful.  Secondly, we know that the type of the channel
-; returned will be the same as type in our call to open-input-channel-p1.
-
-; [Removed by Matt K. to handle changes to member, assoc, etc. after ACL2 4.2.]
-; (local (defthm assoc-eq-is-assoc-equal
-;          (equal (assoc-eq a x)
-;                 (assoc-equal a x))))
-
-(defthm assoc-open-input-channels-exists
-  (implies (open-input-channel-p1 channel type state)
-           (assoc-equal channel (open-input-channels state))))
-
-(defthm assoc-open-input-channels-type
-  (implies (open-input-channel-p1 channel type state)
-           (equal (cadadr (assoc-equal channel (open-input-channels state)))
-                  type)))
-
-
-
-; We can go further and say that given an open input channel and a state,
-; the contents of the channel are a typed io list of the correct type.
-
-(defthm assoc-open-input-channels-contents
-  (implies (and (state-p1 state)
-                (open-input-channel-p1 channel type state))
-           (typed-io-listp (cddr (assoc-equal channel (open-input-channels state)))
-                           type))
-  :hints(("Goal" :use (:instance open-input-channels-ok))))
-
-
-
-; We're now ready for a really ugly but important lemma.  This is the core
-; operation that read-byte$, read-char$, and read-object use in order to
-; "consume" an object from their input streams.  We show that when they do
-; this, they still have an open-channels-p.
-
-(defthm add-pair-open-channels
-  (implies (and (state-p1 state)
-                (open-input-channel-p1 channel type state)
-                (symbolp channel))
-           (open-channels-p
-            (add-pair channel
-                      (cons (cadr (assoc-equal channel
-                                               (open-input-channels state)))
-                            (cdddr (assoc-equal channel
-                                                (open-input-channels state))))
-                      (open-input-channels state))))
-  :hints(("Goal" :in-theory (disable open-input-channels
-                                     open-channels-p))))
-
-
-
-
-
-(defthm equal-of-update-open-input-channels-with-state
-  (implies (state-p1 state)
-           (equal (equal (update-open-input-channels x state) state)
-                  (equal x (open-input-channels state))))
-  :hints(("Goal" :in-theory (enable update-open-input-channels
-                                    open-input-channels
-                                    state-p1))))
-
-(defthm equal-of-add-pair-with-channels
-  (implies (ordered-symbol-alistp channels)
-           (equal (equal (add-pair channel x channels) channels)
-                  (equal (assoc-equal channel channels)
-                         (cons channel x))))
-  :hints(("Goal"
-          :in-theory (enable ordered-symbol-alistp add-pair)
-          :induct (add-pair channel x channels))))
diff -Nru acl2-6.2/books/std/io/peek-char.lisp acl2-6.3/books/std/io/peek-char.lisp
--- acl2-6.2/books/std/io/peek-char.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/peek-char.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; cert_param: (reloc_stub)
-(include-book "base")
diff -Nru acl2-6.2/books/std/io/read-byte.lisp acl2-6.3/books/std/io/read-byte.lisp
--- acl2-6.2/books/std/io/read-byte.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-byte.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; cert_param: (reloc_stub)
-(include-book "base")
diff -Nru acl2-6.2/books/std/io/read-char.lisp acl2-6.3/books/std/io/read-char.lisp
--- acl2-6.2/books/std/io/read-char.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-char.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; cert_param: (reloc_stub)
-(include-book "base")
diff -Nru acl2-6.2/books/std/io/read-file-bytes.lisp acl2-6.3/books/std/io/read-file-bytes.lisp
--- acl2-6.2/books/std/io/read-file-bytes.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-file-bytes.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,172 +1,187 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
+; Standard IO Library
+; read-file-bytes.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (in-package "ACL2")
-(include-book "base")
-(include-book "unsigned-byte-listp")
-;; (local (include-book "open-input-channel"))
-;; (local (include-book "close-input-channel"))
-;; (local (include-book "read-byte"))
+(include-book "file-measure")
+(include-book "std/lists/list-defuns" :dir :system)
+(include-book "std/typed-lists/unsigned-byte-listp" :dir :system)
+(local (include-book "base"))
+(local (include-book "std/lists/rev" :dir :system))
+(local (include-book "std/lists/append" :dir :system))
+(local (include-book "std/lists/revappend" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
 (set-state-ok t)
 
-(defun tr-read-byte$-all (channel state acc)
-  (declare (xargs :guard (and (state-p state)
-                              (symbolp channel)
-                              (open-input-channel-p channel :byte state)
-                              (true-listp acc))
-                  :measure (file-measure channel state)))
-  (if (mbt (state-p state))
-      (mv-let (byte state)
-              (read-byte$ channel state)
-              (if (eq byte nil)
-                  (mv (reverse acc) state)
-                (tr-read-byte$-all channel state (cons byte acc))))
-    (mv nil state)))
-
-(defun read-byte$-all (channel state)
-  (declare (xargs :guard (and (state-p state)
-                              (symbolp channel)
-                              (open-input-channel-p channel :byte state))
-                  :measure (file-measure channel state)
-                  :verify-guards nil))
-  (mbe
-   :logic (if (state-p state)
-              (mv-let (byte state)
-                      (read-byte$ channel state)
-                      (if (null byte)
-                          (mv nil state)
-                        (mv-let (rest state)
-                                (read-byte$-all channel state)
-                                (mv (cons byte rest) state))))
-            (mv nil state))
-   :exec (tr-read-byte$-all channel state nil)))
-
-(defun read-file-bytes (filename state)
-  (declare (xargs :guard (and (state-p state)
-                              (stringp filename))
-                  :verify-guards nil))
-  (mv-let (channel state)
-          (open-input-channel filename :byte state)
-          (if channel
-              (mv-let (data state)
-                      (read-byte$-all channel state)
-                      (let ((state (close-input-channel channel state)))
-                        (mv data state)))
-            (mv (concatenate 'string "Error opening file " filename)
-                state))))
-
-
-(encapsulate
- ()
- (local (defthm lemma-decompose-impl
-          (equal (tr-read-byte$-all channel state acc)
-                 (list (mv-nth 0 (tr-read-byte$-all channel state acc))
-                       (mv-nth 1 (tr-read-byte$-all channel state acc))))
-          :rule-classes nil))
-
- (local (defthm lemma-decompose-spec
-          (equal (read-byte$-all channel state)
-                 (list (mv-nth 0 (read-byte$-all channel state))
-                       (mv-nth 1 (read-byte$-all channel state))))
-          :rule-classes nil))
-
- (local (defthm lemma-data-equiv
-          (implies (and (state-p1 state)
-                        (symbolp channel)
-                        (open-input-channel-p1 channel :byte state)
-                        (true-listp acc))
-                   (equal (mv-nth 0 (tr-read-byte$-all channel state acc))
-                          (revappend acc (mv-nth 0 (read-byte$-all channel state)))))))
-
- (local (defthm lemma-state-equiv
-          (equal (mv-nth 1 (tr-read-byte$-all channel state acc))
-                 (mv-nth 1 (read-byte$-all channel state)))))
-
- (local (defthm lemma-equiv
-          (implies (and (state-p1 state)
-                        (symbolp channel)
-                        (open-input-channel-p1 channel :byte state))
-                   (equal (tr-read-byte$-all channel state nil)
-                          (read-byte$-all channel state)))
-          :hints(("Goal" :in-theory (disable tr-read-byte$-all read-byte$-all)
-                  :use ((:instance lemma-decompose-impl (acc nil))
-                        (:instance lemma-decompose-spec)
-                        (:instance lemma-data-equiv (acc nil)))))))
-
-(verify-guards read-byte$-all))
-
-(defthm state-p1-of-read-byte$-all
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (state-p1 (mv-nth 1 (read-byte$-all channel state)))))
-
-(defthm open-input-channel-p1-of-read-byte$-all
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (open-input-channel-p1 channel :byte
-                                  (mv-nth 1 (read-byte$-all channel state)))))
-
-(defthm integer-listp-of-read-byte$-all
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (integer-listp (mv-nth 0 (read-byte$-all channel state)))))
-
-(defthm unsigned-byte-listp-of-read-byte$-all
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (unsigned-byte-listp 8 (mv-nth 0 (read-byte$-all channel state))))
-  :hints(("Goal" :in-theory (enable read-byte$-all))))
-
-(defthm true-listp-of-read-byte$-all
-  (true-listp (mv-nth 0 (read-byte$-all channel state)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints(("Goal" :in-theory (enable read-byte$-all))))
-
-(verify-guards read-file-bytes)
-
-(defthm state-p1-of-read-file-bytes
-  (implies (and (force (state-p1 state))
-                (force (stringp filename)))
-           (state-p1 (mv-nth 1 (read-file-bytes filename state)))))
-
-(defthm integer-listp-of-read-file-bytes
-  (implies (and (not (stringp (mv-nth 0 (read-file-bytes filename state))))
-                (force (state-p1 state))
-                (force (stringp filename)))
-           (integer-listp (mv-nth 0 (read-file-bytes filename state)))))
-
-(defthm unsigned-byte-listp-of-read-file-bytes
-  (implies (and (not (stringp (mv-nth 0 (read-file-bytes filename state))))
-                (force (state-p1 state))
-                (force (stringp filename)))
-           (unsigned-byte-listp 8 (mv-nth 0 (read-file-bytes filename state))))
-  :hints(("Goal" :in-theory (enable read-file-bytes))))
-
-(defthm true-listp-of-read-file-bytes
-  (implies (and (not (stringp (mv-nth 0 (read-file-bytes filename state))))
-                (force (state-p1 state))
-                (force (stringp filename)))
-           (true-listp (mv-nth 0 (read-file-bytes filename state))))
-  :hints(("Goal" :in-theory (enable read-file-bytes))))
 
-(in-theory (disable tr-read-byte$-all read-byte$-all read-file-bytes))
+(defsection read-byte$-all
+  :parents (read-file-bytes)
+  :short "@(call read-byte$-all) reads all remaining bytes from a file."
+
+  :long "<p>This is the main loop inside @(see read-file-bytes).  It reads
+everything in the file, but doesn't handle opening or closing the file.</p>"
+
+  (defund tr-read-byte$-all (channel state acc)
+    (declare (xargs :guard (and (state-p state)
+                                (symbolp channel)
+                                (open-input-channel-p channel :byte state))
+                    :measure (file-measure channel state)))
+    (b* (((unless (mbt (state-p state)))
+          (mv acc state))
+         ((mv byte state) (read-byte$ channel state))
+         ((unless byte)
+          (mv acc state))
+         (acc (cons (mbe :logic (if (unsigned-byte-p 8 byte)
+                                    byte
+                                  0)
+                         :exec byte)
+                    acc)))
+      (tr-read-byte$-all channel state acc)))
+
+  (defund read-byte$-all (channel state)
+    (declare (xargs :guard (and (state-p state)
+                                (symbolp channel)
+                                (open-input-channel-p channel :byte state))
+                    :measure (file-measure channel state)
+                    :verify-guards nil))
+    (mbe :logic
+         (b* (((unless (state-p state))
+               (mv nil state))
+              ((mv byte state) (read-byte$ channel state))
+              ((unless byte)
+               (mv nil state))
+              ((mv rest state) (read-byte$-all channel state))
+              (byte (if (unsigned-byte-p 8 byte) byte 0)))
+           (mv (cons byte rest) state))
+         :exec
+         (b* (((mv contents state)
+               (tr-read-byte$-all channel state nil)))
+           (mv (reverse contents) state))))
+
+  (local (in-theory (enable tr-read-byte$-all
+                            read-byte$-all)))
+
+  (local (defthm lemma-decompose-impl
+           (equal (tr-read-byte$-all channel state acc)
+                  (list (mv-nth 0 (tr-read-byte$-all channel state acc))
+                        (mv-nth 1 (tr-read-byte$-all channel state acc))))
+           :rule-classes nil))
+
+  (local (defthm lemma-decompose-spec
+           (equal (read-byte$-all channel state)
+                  (list (mv-nth 0 (read-byte$-all channel state))
+                        (mv-nth 1 (read-byte$-all channel state))))
+           :rule-classes nil))
+
+  (local (defthm lemma-data-equiv
+           (equal (mv-nth 0 (tr-read-byte$-all channel state acc))
+                  (revappend (mv-nth 0 (read-byte$-all channel state)) acc))))
+
+  (local (defthm lemma-state-equiv
+           (equal (mv-nth 1 (tr-read-byte$-all channel state acc))
+                  (mv-nth 1 (read-byte$-all channel state)))))
+
+  (defthm tr-read-byte$-all-removal
+    (equal (tr-read-byte$-all channel state nil)
+           (mv (rev (mv-nth 0 (read-byte$-all channel state)))
+               (mv-nth 1 (read-byte$-all channel state))))
+    :hints(("Goal" :in-theory (disable tr-read-byte$-all read-byte$-all)
+            :use ((:instance lemma-decompose-impl (acc nil))
+                  (:instance lemma-decompose-spec)
+                  (:instance lemma-data-equiv (acc nil))))))
+
+  (defthm true-listp-of-read-byte$-all
+    (true-listp (mv-nth 0 (read-byte$-all channel state)))
+    :rule-classes :type-prescription)
+
+  (verify-guards read-byte$-all)
+
+  (defthm state-p1-of-read-byte$-all
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (state-p1 (mv-nth 1 (read-byte$-all channel state)))))
+
+  (defthm open-input-channel-p1-of-read-byte$-all
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (open-input-channel-p1 channel :byte
+                                    (mv-nth 1 (read-byte$-all channel state)))))
+
+  (defthm integer-listp-of-read-byte$-all
+    (integer-listp (mv-nth 0 (read-byte$-all channel state))))
+
+  (defthm nat-listp-of-read-byte$-all
+    (nat-listp (mv-nth 0 (read-byte$-all channel state))))
+
+  (defthm unsigned-byte-listp-of-read-byte$-all
+    (unsigned-byte-listp 8 (mv-nth 0 (read-byte$-all channel state)))))
+
+
+
+
+
+
+(defsection read-file-bytes
+  :parents (std/io)
+  :short "Read an entire file into a list of (unsigned) bytes."
+
+  :long "<p><b>Signature:</b> @(call read-file-bytes) returns @('(mv contents
+state)').</p>
+
+<p>On success, @('contents') is a list of bytes, 0-255, which captures the
+contents of the file.</p>
+
+<p>On failure, e.g., perhaps @('filename') does not exist, @('contents') will
+be a @(see stringp) saying that we failed to open the file.</p>"
+
+  (defund read-file-bytes (filename state)
+    "Returns (MV ERRMSG/BYTES STATE)"
+    (declare (xargs :guard (and (state-p state)
+                                (stringp filename))))
+    (b* ((filename (mbe :logic (if (stringp filename) filename "")
+                        :exec filename))
+         ((mv channel state)
+          (open-input-channel filename :byte state))
+         ((unless channel)
+          (mv (concatenate 'string "Error opening file " filename)
+              state))
+         ((mv data state)
+          (read-byte$-all channel state))
+         (state (close-input-channel channel state)))
+      (mv data state)))
+
+  (local (in-theory (enable read-file-bytes)))
+
+  (defthm state-p1-of-read-file-bytes
+    (implies (force (state-p1 state))
+             (state-p1 (mv-nth 1 (read-file-bytes filename state)))))
+
+  (defthm integer-listp-of-read-file-bytes
+    (equal (integer-listp (mv-nth 0 (read-file-bytes filename state)))
+           (not (stringp (mv-nth 0 (read-file-bytes filename state))))))
+
+  (defthm nat-listp-of-read-file-bytes
+    (equal (nat-listp (mv-nth 0 (read-file-bytes filename state)))
+           (not (stringp (mv-nth 0 (read-file-bytes filename state))))))
+
+  (defthm unsigned-byte-listp-of-read-file-bytes
+    (equal (unsigned-byte-listp 8 (mv-nth 0 (read-file-bytes filename state)))
+           (not (stringp (mv-nth 0 (read-file-bytes filename state))))))
+
+  (defthm type-of-read-file-bytes
+    (or (true-listp (mv-nth 0 (read-file-bytes filename state)))
+        (stringp (mv-nth 0 (read-file-bytes filename state))))
+    :rule-classes :type-prescription))
 
diff -Nru acl2-6.2/books/std/io/read-file-characters-no-error.acl2 acl2-6.3/books/std/io/read-file-characters-no-error.acl2
--- acl2-6.2/books/std/io/read-file-characters-no-error.acl2	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-file-characters-no-error.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-(in-package "ACL2")
-; cert-flags: ? t :ttags (:cutil-optimize)
-(certify-book "read-file-characters-no-error" ? t :ttags (:cutil-optimize))
\ No newline at end of file
diff -Nru acl2-6.2/books/std/io/read-file-characters-no-error.lisp acl2-6.3/books/std/io/read-file-characters-no-error.lisp
--- acl2-6.2/books/std/io/read-file-characters-no-error.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-file-characters-no-error.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -8,51 +8,25 @@
 ; whatever that means).
 
 (in-package "ACL2")
-
 (include-book "read-file-characters")
 (local (include-book "tools/mv-nth" :dir :system))
 
-; The below definitions are basically an expansion of the below commented
-; define.  We could use this form if we didn't need to abstain from depending
-; on cutil.
-
-;; (define read-file-characters-no-error ((filename stringp)
-;;                                        (state state-p))
-;;   :returns (mv (characters character-listp :hyp :fguard)
-;;                (state state-p :hyp :fguard))
-;;   (mv-let (data state)
-;;     (read-file-characters filename state)
-;;     (mv (if (stringp data)
-;;             (prog2$ (er hard? 'read-file-characters-no-error
-;;                         data)
-;;                     nil)
-;;           data)
-;;         state)))
-
-(defun read-file-characters-no-error (filename state)
+(defund read-file-characters-no-error (filename state)
   (declare (xargs :guard (and (stringp filename)
                               (state-p state))))
   (declare (xargs :stobjs (state)))
-  (let
-      ((__function__ 'read-file-characters-no-error))
-    (declare (ignorable __function__))
-    (mv-let (data state)
-      (read-file-characters filename state)
-      (mv (if (stringp data)
-              (prog2$ (er hard? 'read-file-characters-no-error
-                          data)
-                      nil)
-            data)
-          state))))
+  (b* (((mv data state)
+        (read-file-characters filename state))
+       ((when (stringp data))
+        (mv (er hard? 'read-file-characters-no-error data) state)))
+    (mv data state)))
+
+(local (in-theory (enable read-file-characters-no-error)))
 
-(defthm read-file-characters-no-error-preserves-state
+(defthm state-p1-of-read-file-characters-no-error
   (implies (and (force (state-p1 state))
                 (force (stringp filename)))
            (state-p1 (mv-nth 1 (read-file-characters-no-error filename state)))))
 
 (defthm read-file-characters-no-error-returns-character-list
-  (implies (and (force (state-p1 state))
-                (force (stringp filename)))
-           (character-listp (mv-nth 0 (read-file-characters-no-error filename state)))))
-
-(in-theory (disable read-file-characters-no-error))
+  (character-listp (mv-nth 0 (read-file-characters-no-error filename state))))
diff -Nru acl2-6.2/books/std/io/read-file-characters.lisp acl2-6.3/books/std/io/read-file-characters.lisp
--- acl2-6.2/books/std/io/read-file-characters.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-file-characters.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,195 +1,201 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
+; Standard IO Library
+; read-file-characters.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (in-package "ACL2")
-(set-state-ok t)
-
-(include-book "base")
-;; (local (include-book "open-input-channel"))
-;; (local (include-book "read-char"))
-;; (local (include-book "close-input-channel"))
+(include-book "file-measure")
+(include-book "std/lists/list-defuns" :dir :system)
+(include-book "str/char-fix" :dir :system)
+(local (include-book "base"))
+(local (include-book "std/lists/rev" :dir :system))
+(local (include-book "std/lists/append" :dir :system))
 (local (include-book "std/lists/revappend" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
+(set-state-ok t)
 
-(defun tr-read-char$-all (channel state acc)
-  (declare (xargs :guard (and (state-p state)
-                              (symbolp channel)
-                              (open-input-channel-p channel :character state)
-                              (true-listp acc))
-                  :measure (file-measure channel state)))
-  (if (mbt (state-p state))
-      (mv-let (char state)
-              (read-char$ channel state)
-              (if (eq char nil)
-                  (mv acc state)
-                (tr-read-char$-all channel state (cons char acc))))
-    (mv nil state)))
-
-(defun read-char$-all (channel state)
-  (declare (xargs :guard (and (state-p state)
-                              (symbolp channel)
-                              (open-input-channel-p channel :character state))
-                  :measure (file-measure channel state)
-                  :verify-guards nil))
-  (mbe :logic (if (state-p state)
-                  (mv-let (char state)
-                          (read-char$ channel state)
-                          (if (null char)
-                              (mv nil state)
-                            (mv-let (rest state)
-                                    (read-char$-all channel state)
-                                    (mv (cons char rest) state))))
-                (mv nil state))
-       :exec (mv-let (data state)
-                     (tr-read-char$-all channel state nil)
-                     (mv (reverse data) state))))
-
-(defun read-file-characters (filename state)
-  "Read the entire file and return its contents as a list of characters."
-  (declare (xargs :guard (and (state-p state)
-                              (stringp filename))
-                  :verify-guards nil))
-  (mv-let (channel state)
-          (open-input-channel filename :character state)
-          (if channel
-              (mv-let (data state)
-                      (read-char$-all channel state)
-                      (let ((state (close-input-channel channel state)))
-                        (mv data state)))
-            (mv (concatenate 'string "Error opening file " filename)
-                state))))
-
-(defun read-file-characters-rev (filename state)
-  "Read the entire file and return its contents as a list of characters in
-   reverse order.  This is faster than read-file-characters because it does
-   not need to reverse the accumulator."
-  (declare (xargs :guard (and (state-p state)
-                              (stringp filename))
-                  :verify-guards nil))
-  (mv-let (channel state)
-          (open-input-channel filename :character state)
-          (if channel
-              (mv-let (data state)
-                      (tr-read-char$-all channel state nil)
-                      (let ((state (close-input-channel channel state)))
-                        (mv data state)))
-            (mv (concatenate 'string "Error opening file " filename)
-                state))))
-
-(local (defthm lemma-decompose-impl
-         (equal (tr-read-char$-all channel state acc)
-                (list (mv-nth 0 (tr-read-char$-all channel state acc))
-                      (mv-nth 1 (tr-read-char$-all channel state acc))))
-         :rule-classes nil))
-
-(local (defthm lemma-decompose-spec
-         (equal (read-char$-all channel state)
-                (list (mv-nth 0 (read-char$-all channel state))
-                      (mv-nth 1 (read-char$-all channel state))))
-         :rule-classes nil))
-
-(local (defthm lemma-data-equiv
-         (implies (and (state-p1 state)
-                       (symbolp channel)
-                       (open-input-channel-p1 channel :character state)
-                       (true-listp acc))
-                  (equal (mv-nth 0 (tr-read-char$-all channel state acc))
-                         (revappend (mv-nth 0 (read-char$-all channel state)) acc)))))
-
-(local (defthm lemma-state-equiv
-         (equal (mv-nth 1 (tr-read-char$-all channel state acc))
-                (mv-nth 1 (read-char$-all channel state)))))
-
-(local (defthm lemma-true-listp-impl
-         (implies (true-listp acc)
-                  (true-listp (mv-nth 0 (tr-read-char$-all channel state acc))))
-         :rule-classes :type-prescription))
-
-(local (defthm lemma-true-listp-spec
-         (true-listp (mv-nth 0 (read-char$-all channel state)))
-         :rule-classes :type-prescription))
-
-(local (defthm lemma-equiv
-         (implies (and (state-p1 state)
-                       (symbolp channel)
-                       (open-input-channel-p1 channel :character state))
-                  (equal (tr-read-char$-all channel state nil)
-                         (mv (reverse (mv-nth 0 (read-char$-all channel state)))
-                             (mv-nth 1 (read-char$-all channel state)))))
-         :hints(("Goal" :in-theory (disable tr-read-char$-all read-char$-all)
-                 :use ((:instance lemma-decompose-impl (acc nil))
-                       (:instance lemma-decompose-spec)
-                       (:instance lemma-data-equiv (acc nil)))))))
-
-(encapsulate
- ()
- (local (include-book "std/lists/rev" :dir :system))
- (verify-guards read-char$-all))
-
-
-(defthm read-file-characters-rev-redefinition
-  (implies (and (force (stringp filename))
-                (force (state-p1 state)))
-           (equal (read-file-characters-rev filename state)
-                  (mv-let (data state)
-                          (read-file-characters filename state)
-                          (if (stringp data)
-                              (mv data state)
-                            (mv (reverse data) state))))))
-
-
-(defthm read-char$-all-preserves-state
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :character state)))
-           (state-p1 (mv-nth 1 (read-char$-all channel state)))))
-
-(defthm read-char$-all-preserves-open-input-channel-p1
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :character state)))
-           (open-input-channel-p1 channel :character
-                                  (mv-nth 1 (read-char$-all channel state)))))
-
-(defthm read-char$-all-character-listp
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :character state)))
-           (character-listp (mv-nth 0 (read-char$-all channel state)))))
-
-(verify-guards read-file-characters)
-
-(verify-guards read-file-characters-rev)
-
-
-(defthm read-file-characters-preserves-state
-  (implies (and (force (state-p1 state))
-                (force (stringp filename)))
-           (state-p1 (mv-nth 1 (read-file-characters filename state)))))
-
-(defthm read-file-characters-error-or-character-list
-  (implies (and (not (stringp (mv-nth 0 (read-file-characters filename state))))
-                (force (state-p1 state))
-                (force (stringp filename)))
-           (character-listp (mv-nth 0 (read-file-characters filename state)))))
-
-
-(in-theory (disable tr-read-char$-all
-                    read-char$-all
-                    read-file-characters
-                    read-file-characters-rev))
+(defsection read-char$-all
+  :parents (read-file-characters)
+  :short "@(call read-char$-all) reads all remaining characters from a file."
+
+  :long "<p>This is the main loop inside @(see read-file-characters).  It reads
+everything in the file, but doesn't handle opening or closing the file.</p>"
+
+  (defund tr-read-char$-all (channel state acc)
+    (declare (xargs :guard (and (state-p state)
+                                (symbolp channel)
+                                (open-input-channel-p channel :character state))
+                    :measure (file-measure channel state)))
+    (b* (((unless (mbt (state-p state)))
+          (mv acc state))
+         ((mv char state) (read-char$ channel state))
+         ((unless char)
+          (mv acc state))
+         (acc (cons (mbe :logic (str::char-fix char) :exec char) acc)))
+      (tr-read-char$-all channel state acc)))
+
+  (defund read-char$-all (channel state)
+    (declare (xargs :guard (and (state-p state)
+                                (symbolp channel)
+                                (open-input-channel-p channel :character state))
+                    :measure (file-measure channel state)
+                    :verify-guards nil))
+    (mbe :logic
+         (b* (((unless (state-p state))
+               (mv nil state))
+              ((mv char state) (read-char$ channel state))
+              ((unless char)
+               (mv nil state))
+              ((mv rest state) (read-char$-all channel state)))
+           (mv (cons (str::char-fix char) rest) state))
+         :exec
+         (b* (((mv contents state)
+               (tr-read-char$-all channel state nil)))
+           (mv (reverse contents) state))))
+
+  (local (in-theory (enable tr-read-char$-all
+                            read-char$-all)))
+
+  (local (defthm lemma-decompose-impl
+           (equal (tr-read-char$-all channel state acc)
+                  (list (mv-nth 0 (tr-read-char$-all channel state acc))
+                        (mv-nth 1 (tr-read-char$-all channel state acc))))
+           :rule-classes nil))
+
+  (local (defthm lemma-decompose-spec
+           (equal (read-char$-all channel state)
+                  (list (mv-nth 0 (read-char$-all channel state))
+                        (mv-nth 1 (read-char$-all channel state))))
+           :rule-classes nil))
+
+  (local (defthm lemma-data-equiv
+           (equal (mv-nth 0 (tr-read-char$-all channel state acc))
+                  (revappend (mv-nth 0 (read-char$-all channel state)) acc))))
+
+  (local (defthm lemma-state-equiv
+           (equal (mv-nth 1 (tr-read-char$-all channel state acc))
+                  (mv-nth 1 (read-char$-all channel state)))))
+
+  (defthm true-listp-of-read-char$-all
+    (true-listp (mv-nth 0 (read-char$-all channel state)))
+    :rule-classes :type-prescription)
+
+  (defthm tr-read-char$-all-removal
+    (equal (tr-read-char$-all channel state nil)
+           (mv (rev (mv-nth 0 (read-char$-all channel state)))
+               (mv-nth 1 (read-char$-all channel state))))
+    :hints(("Goal" :in-theory (disable tr-read-char$-all read-char$-all)
+            :use ((:instance lemma-decompose-impl (acc nil))
+                  (:instance lemma-decompose-spec)
+                  (:instance lemma-data-equiv (acc nil))))))
+
+  (verify-guards read-char$-all)
+
+  (defthm state-p1-of-read-char$-all
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :character state)))
+             (state-p1 (mv-nth 1 (read-char$-all channel state)))))
+
+  (defthm open-input-channel-p1-of-read-char$-all
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :character state)))
+             (open-input-channel-p1 channel
+                                    :character
+                                    (mv-nth 1 (read-char$-all channel state)))))
+
+  (defthm character-listp-of-read-char$-all
+    (character-listp (mv-nth 0 (read-char$-all channel state)))))
+
+
+
+(defsection read-file-characters
+  :parents (std/io)
+  :short "Read an entire file into a @(see character-listp)."
+
+  :long "<p><b>Signature:</b> @(call read-file-characters) returns @('(mv contents state)').</p>
+
+<p>On success, @('contents') is a @(see character-listp) that contains all of
+the characters in the file.</p>
+
+<p>On failure, e.g., perhaps @('filename') does not exist, @('contents') will
+be a @(see stringp) saying that we failed to open the file.</p>"
+
+  (defund read-file-characters (filename state)
+    "Returns (MV ERRMSG/CHARS STATE)"
+    (declare (xargs :guard (and (state-p state)
+                                (stringp filename))))
+    (b* ((filename (mbe :logic (if (stringp filename) filename "")
+                        :exec filename))
+         ((mv channel state)
+          (open-input-channel filename :character state))
+         ((unless channel)
+          (mv (concatenate 'string "Error opening file " filename) state))
+         ((mv contents state)
+          (read-char$-all channel state))
+         (state (close-input-channel channel state)))
+      (mv contents state)))
+
+  (local (in-theory (enable read-file-characters)))
+
+  (defthm state-p1-of-read-file-characters
+    (implies (force (state-p1 state))
+             (state-p1 (mv-nth 1 (read-file-characters filename state)))))
+
+  (defthm character-listp-of-read-file-characters
+    (let ((contents (mv-nth 0 (read-file-characters filename state))))
+      (equal (character-listp contents)
+             (not (stringp contents)))))
+
+  (defthm type-of-read-file-characters
+    (or (true-listp (mv-nth 0 (read-file-characters filename state)))
+        (stringp (mv-nth 0 (read-file-characters filename state))))
+    :rule-classes :type-prescription))
+
+
+(defsection read-file-characters-rev
+  :parents (std/io)
+  :short "Read an entire file into a @(see character-listp), but in reverse
+order!"
+
+  :long "<p>This goofy function is just like @(see read-file-characters) except
+that the characters are returned in reverse.</p>
+
+<p>This is faster than read-file-characters because we avoid the cost of
+reversing the accumulator, and thus require half as many conses.</p>
+
+<p>Note: that we just leave this function enabled.  Logically it's just the
+reverse of @(see read-file-characters).</p>"
+
+  (local (in-theory (enable read-file-characters)))
+
+  (defun read-file-characters-rev (filename state)
+    (declare (xargs :guard (and (state-p state)
+                                (stringp filename))))
+    (mbe :logic
+         (b* (((mv contents state)
+               (read-file-characters filename state)))
+           (if (stringp contents)
+               ;; Error reading file
+               (mv contents state)
+             (mv (rev contents) state)))
+         :exec
+         (b* (((mv channel state)
+               (open-input-channel filename :character state))
+              ((unless channel)
+               (mv (concatenate 'string "Error opening file " filename) state))
+              ((mv contents state)
+               (tr-read-char$-all channel state nil))
+              (state (close-input-channel channel state)))
+           (mv contents state)))))
 
diff -Nru acl2-6.2/books/std/io/read-file-lines.lisp acl2-6.3/books/std/io/read-file-lines.lisp
--- acl2-6.2/books/std/io/read-file-lines.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-file-lines.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,121 +1,130 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
+; Standard IO Library
+; read-file-lines.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (in-package "ACL2")
-(include-book "base")
-;; (local (include-book "open-input-channel"))
-;; (local (include-book "read-byte"))
-;; (local (include-book "close-input-channel"))
+(include-book "file-measure")
+(include-book "std/lists/list-defuns" :dir :system)
+(include-book "str/cat" :dir :system)
+(local (include-book "base"))
 (local (include-book "std/lists/revappend" :dir :system))
+(local (include-book "std/lists/append" :dir :system))
 (local (include-book "std/lists/rev" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
-(include-book "tools/bstar" :dir :system)
 (set-state-ok t)
 
-; BOZO this currently just looks for newlines.  It should probably be extended
-; to also handle carriage return stuff or whatever is used on Windows, if that
-; sort of thing hasn't been addressed in some other way.
-
-(defund read-file-lines-aux (line lines channel state)
-  ;; Line is a character list, the current line in reverse order
-  ;; Lines are a string list, the previously read lines in reverse order
-  ;; Channel is the BYTE channel we're reading from.
-  (declare (xargs :guard (and (character-listp line)
-                              (string-listp lines)
-                              (symbolp channel)
-                              (open-input-channel-p channel :byte state))
-                  :stobjs state
-                  :measure (file-measure channel state)))
-  (b* (((unless (mbt (state-p state)))
-        (mv nil state))
-       ((mv byte state)
-        (read-byte$ channel state))
-       ((unless byte)
-        (let ((lines (cons (reverse (coerce line 'string)) lines)))
-          (mv lines state)))
-       (char (code-char byte))
-       (line (cons char line)))
-      (if (eql char #\Newline)
-          (let ((lines (cons (reverse (coerce line 'string)) lines)))
-            (read-file-lines-aux nil lines channel state))
-        (read-file-lines-aux line lines channel state))))
-
-(defthm state-p1-of-read-file-lines-aux
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (state-p1 (mv-nth 1 (read-file-lines-aux line lines channel state))))
-  :hints(("Goal" :in-theory (enable read-file-lines-aux))))
-
-(defthm open-input-channel-p1-of-read-file-lines-aux
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (open-input-channel-p1 channel :byte
-                                  (mv-nth 1 (read-file-lines-aux line lines channel state))))
-  :hints(("Goal" :in-theory (enable read-file-lines-aux))))
-
-(defthm string-listp-of-read-file-lines-aux
-  (implies (and (force (character-listp line))
-                (force (string-listp lines))
-                (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (string-listp (mv-nth 0 (read-file-lines-aux line lines channel state))))
-  :hints(("Goal" :in-theory (enable read-file-lines-aux))))
-
-(defthm true-listp-of-read-file-lines-aux
-  (implies (true-listp lines)
-           (true-listp (mv-nth 0 (read-file-lines-aux line lines channel state))))
-  :rule-classes :type-prescription
-  :hints(("Goal" :in-theory (enable read-file-lines-aux))))
-
-
-
-
-(defund read-file-lines (filename state)
-  "Returns (MV ERRMSG/LINES STATE)"
-  (declare (xargs :guard (stringp filename)
-                  :stobjs state
-                  :guard-debug t))
-  (b* (((mv channel state)
-        (open-input-channel filename :byte state))
-       ((unless channel)
-        (mv (concatenate 'string "Error opening file " filename)
-            state))
-       ((mv data state)
-        (read-file-lines-aux nil nil channel state))
-       (state
-        (close-input-channel channel state)))
+
+(defsection read-file-lines-aux
+  :parents (read-file-lines)
+  :short "Tail recursive implementation of @(see read-file-lines)."
+  :long "<p>@(call read-file-lines-aux) returns @('(mv lines state)')</p>
+<ul>
+<li>@('line') is a character list, the current line in reverse order</li>
+<li>@('lines') are a string list, the previously read lines in reverse order</li>
+<li>@('channel') is the @(':byte') channel we're reading from</li>
+</ul>"
+
+  (defund read-file-lines-aux (line lines channel state)
+    (declare (xargs :guard (and (character-listp line)
+                                (string-listp lines)
+                                (symbolp channel)
+                                (open-input-channel-p channel :byte state))
+                    :stobjs state
+                    :measure (file-measure channel state)))
+    (b* (((unless (mbt (state-p state)))
+          (mv lines state))
+         ((mv byte state)
+          (read-byte$ channel state))
+         ((unless byte)
+          (let ((lines (cons (str::rchars-to-string line) lines)))
+            (mv lines state)))
+         ((the character char) (code-char (the (unsigned-byte 8) byte)))
+         (line (cons char line))
+         ((when (eql char #\Newline))
+          (let ((lines (cons (str::rchars-to-string line) lines)))
+            (read-file-lines-aux nil lines channel state))))
+      (read-file-lines-aux line lines channel state)))
+
+  (local (in-theory (enable read-file-lines-aux)))
+
+  (defthm state-p1-of-read-file-lines-aux
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (b* (((mv ?lines state)
+                   (read-file-lines-aux line lines channel state)))
+               (state-p1 state))))
+
+  (defthm open-input-channel-p1-of-read-file-lines-aux
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (b* (((mv ?lines state)
+                   (read-file-lines-aux line lines channel state)))
+               (open-input-channel-p1 channel :byte state))))
+
+  (defthm string-listp-of-read-file-lines-aux
+    (implies (force (string-listp lines))
+             (string-listp
+              (mv-nth 0 (read-file-lines-aux line lines channel state)))))
+
+  (defthm true-listp-of-read-file-lines-aux
+    (equal (true-listp (mv-nth 0 (read-file-lines-aux line lines channel state)))
+           (true-listp lines))))
+
+
+
+(defsection read-file-lines
+  :parents (std/io)
+  :short "Read an entire file into a list of lines (strings)."
+  :long "<p><b>Signature:</b> @(call read-file-lines) returns @('(mv contents state)').</p>
+
+<p>On success, @('contents') is a @(see string-listp) that contains each line
+of the file.</p>
+
+<p>On failure, e.g., perhaps @('filename') does not exist, @('contents') will
+be a @(see stringp) saying that we failed to open the file.</p>
+
+<p><b>BOZO</b> This currently just looks for individual newline characters,
+i.e., @('#\\Newline'), sometimes called @('\\n').  It might be desirable to
+change how it works to somehow support @('\\r\\n') or whatever other
+carriage-return stuff people use on platforms like Windows.</p>"
+
+  (defund read-file-lines (filename state)
+    "Returns (MV ERRMSG/LINES STATE)"
+    (declare (xargs :guard (stringp filename)
+                    :stobjs state))
+    (b* ((filename (mbe :logic (if (stringp filename) filename "")
+                        :exec filename))
+         ((mv channel state)
+          (open-input-channel filename :byte state))
+         ((unless channel)
+          (mv (concatenate 'string "Error opening file " filename) state))
+         ((mv data state)
+          (read-file-lines-aux nil nil channel state))
+         (state (close-input-channel channel state)))
       (mv (reverse data) state)))
 
-(defthm state-p1-of-read-file-lines
-  (implies (and (force (stringp filename))
-                (force (state-p1 state)))
-           (state-p1 (mv-nth 1 (read-file-lines filename state))))
-  :hints(("Goal" :in-theory (enable read-file-lines))))
-
-(local (defthm crock
-         (implies (string-listp x)
-                  (string-listp (rev x)))))
-
-(defthm string-listp-of-read-file-lines
-  (implies (and (force (stringp filename))
-                (force (state-p state))
-                (not (stringp (mv-nth 0 (read-file-lines filename state)))))
-           (string-listp (mv-nth 0 (read-file-lines filename state))))
-  :hints(("Goal" :in-theory (enable read-file-lines))))
+  (local (in-theory (enable read-file-lines)))
+
+  (defthm state-p1-of-read-file-lines
+    (implies (force (state-p1 state))
+             (state-p1 (mv-nth 1 (read-file-lines filename state)))))
+
+  (local (defthm crock
+           (implies (string-listp x)
+                    (string-listp (rev x)))))
+
+  (defthm string-listp-of-read-file-lines
+    (equal (string-listp (mv-nth 0 (read-file-lines filename state)))
+           (not (stringp (mv-nth 0 (read-file-lines filename state)))))))
diff -Nru acl2-6.2/books/std/io/read-file-objects.lisp acl2-6.3/books/std/io/read-file-objects.lisp
--- acl2-6.2/books/std/io/read-file-objects.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-file-objects.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,147 +1,159 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
+; Standard IO Library
+; read-file-objects.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (in-package "ACL2")
-(include-book "base")
-;; (local (include-book "open-input-channel"))
-;; (local (include-book "close-input-channel"))
-;; (local (include-book "read-object"))
+(include-book "file-measure")
+(include-book "std/lists/list-defuns" :dir :system)
+(local (include-book "base"))
+(local (include-book "std/lists/rev" :dir :system))
+(local (include-book "std/lists/append" :dir :system))
+(local (include-book "std/lists/revappend" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
 (set-state-ok t)
 
-(defun tr-read-object-all (channel state acc)
-  (declare (xargs :guard (and (state-p state)
-                              (symbolp channel)
-                              (open-input-channel-p channel :object state)
-                              (true-listp acc))
-                  :measure (file-measure channel state)))
-  (if (mbt (state-p state))
-      (mv-let (eofp obj state)
-              (read-object channel state)
-              (if eofp
-                  (mv (reverse acc) state)
-                (tr-read-object-all channel state (cons obj acc))))
-    (mv nil state)))
-
-(defun read-object-all (channel state)
-  (declare (xargs :guard (and (state-p state)
-                              (symbolp channel)
-                              (open-input-channel-p channel :object state))
-                  :measure (file-measure channel state)
-                  :verify-guards nil))
-  (mbe
-   :logic (if (state-p state)
-              (mv-let (eofp obj state)
-                      (read-object channel state)
-                      (if eofp
-                          (mv nil state)
-                        (mv-let (rest state)
-                                (read-object-all channel state)
-                                (mv (cons obj rest) state))))
-            (mv nil state))
-   :exec (tr-read-object-all channel state nil)))
-
-(defun read-file-objects (filename state)
-  (declare (xargs :guard (and (state-p state)
-                              (stringp filename))
-                  :verify-guards nil))
-  (mv-let (channel state)
-          (open-input-channel filename :object state)
-          (if channel
-              (mv-let (data state)
-                      (read-object-all channel state)
-                      (let ((state (close-input-channel channel state)))
-                        (mv data state)))
-            (mv (concatenate 'string "Error opening file " filename)
-                state))))
-
-
-(encapsulate
- ()
- (local (defthm lemma-decompose-impl
-          (equal (tr-read-object-all channel state acc)
-                 (list (mv-nth 0 (tr-read-object-all channel state acc))
-                       (mv-nth 1 (tr-read-object-all channel state acc))))
-          :rule-classes nil))
-
- (local (defthm lemma-decompose-spec
-          (equal (read-object-all channel state)
-                 (list (mv-nth 0 (read-object-all channel state))
-                       (mv-nth 1 (read-object-all channel state))))
-          :rule-classes nil))
-
- (local (defthm lemma-data-equiv
-          (implies (and (state-p1 state)
-                        (symbolp channel)
-                        (open-input-channel-p1 channel :object state)
-                        (true-listp acc))
-                   (equal (mv-nth 0 (tr-read-object-all channel state acc))
-                          (revappend acc (mv-nth 0 (read-object-all channel state)))))))
-
- (local (defthm lemma-state-equiv
-          (equal (mv-nth 1 (tr-read-object-all channel state acc))
-                 (mv-nth 1 (read-object-all channel state)))))
-
- (local (defthm lemma-equiv
-          (implies (and (state-p1 state)
-                        (symbolp channel)
-                        (open-input-channel-p1 channel :object state))
-                   (equal (tr-read-object-all channel state nil)
-                          (read-object-all channel state)))
-          :hints(("Goal" :in-theory (disable tr-read-object-all read-object-all)
-                  :use ((:instance lemma-decompose-impl (acc nil))
-                        (:instance lemma-decompose-spec)
-                        (:instance lemma-data-equiv (acc nil)))))))
-
- (verify-guards read-object-all))
-
-(defthm state-p1-of-read-object-all
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :object state)))
-           (state-p1 (mv-nth 1 (read-object-all channel state)))))
-
-(defthm open-input-channel-p1-of-read-object-all
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :object state)))
-           (open-input-channel-p1 channel :object
-                                  (mv-nth 1 (read-object-all channel state)))))
-
-(defthm true-listp-of-read-object-all
-  (true-listp (mv-nth 0 (read-object-all channel state)))
-  :rule-classes (:rewrite :type-prescription)
-  :hints(("Goal" :in-theory (enable read-object-all))))
-
-(verify-guards read-file-objects)
-
-(defthm state-p1-of-read-file-objects
-  (implies (and (force (state-p1 state))
-                (force (stringp filename)))
-           (state-p1 (mv-nth 1 (read-file-objects filename state)))))
-
-(defthm true-listp-of-read-file-objects
-  (implies (and (not (stringp (mv-nth 0 (read-file-objects filename state))))
-                (force (state-p1 state))
-                (force (stringp filename)))
-           (true-listp (mv-nth 0 (read-file-objects filename state))))
-  :hints(("Goal" :in-theory (enable read-file-objects))))
-
-(in-theory (disable tr-read-object-all
-                    read-object-all
-                    read-file-objects))
+
+(defsection read-object-all
+  :parents (read-file-objects)
+  :short "@(call read-object-all) reads all remaining objects from a file."
+
+  :long "<p>This is the main loop inside @(see read-file-objects).  It reads
+everything in the file, but doesn't handle opening or closing the file.</p>"
+
+  (defund tr-read-object-all (channel state acc)
+    (declare (xargs :guard (and (state-p state)
+                                (symbolp channel)
+                                (open-input-channel-p channel :object state))
+                    :measure (file-measure channel state)))
+    (b* (((unless (mbt (state-p state)))
+          (mv acc state))
+         ((mv eofp obj state) (read-object channel state))
+         ((when eofp)
+          (mv acc state)))
+      (tr-read-object-all channel state (cons obj acc))))
+
+  (defund read-object-all (channel state)
+    (declare (xargs :guard (and (state-p state)
+                                (symbolp channel)
+                                (open-input-channel-p channel :object state))
+                    :measure (file-measure channel state)
+                    :verify-guards nil))
+    (mbe :logic (b* (((unless (state-p state))
+                      (mv nil state))
+                     ((mv eofp obj state) (read-object channel state))
+                     ((when eofp)
+                      (mv nil state))
+                     ((mv rest state)
+                      (read-object-all channel state)))
+                  (mv (cons obj rest) state))
+         :exec (b* (((mv acc state)
+                     (tr-read-object-all channel state nil)))
+                 (mv (reverse acc) state))))
+
+  (local (in-theory (enable tr-read-object-all read-object-all)))
+
+  (local (defthm lemma-decompose-impl
+           (equal (tr-read-object-all channel state acc)
+                  (list (mv-nth 0 (tr-read-object-all channel state acc))
+                        (mv-nth 1 (tr-read-object-all channel state acc))))
+           :rule-classes nil))
+
+  (local (defthm lemma-decompose-spec
+           (equal (read-object-all channel state)
+                  (list (mv-nth 0 (read-object-all channel state))
+                        (mv-nth 1 (read-object-all channel state))))
+           :rule-classes nil))
+
+  (local (defthm lemma-data-equiv
+           (equal (mv-nth 0 (tr-read-object-all channel state acc))
+                  (revappend (mv-nth 0 (read-object-all channel state)) acc))))
+
+  (local (defthm lemma-state-equiv
+           (equal (mv-nth 1 (tr-read-object-all channel state acc))
+                  (mv-nth 1 (read-object-all channel state)))))
+
+  (defthm tr-read-object-all-removal
+    (equal (tr-read-object-all channel state nil)
+           (mv (rev (mv-nth 0 (read-object-all channel state)))
+               (mv-nth 1 (read-object-all channel state))))
+    :hints(("Goal" :in-theory (disable tr-read-object-all read-object-all)
+            :use ((:instance lemma-decompose-impl (acc nil))
+                  (:instance lemma-decompose-spec)
+                  (:instance lemma-data-equiv (acc nil))))))
+
+  (defthm true-listp-of-read-object-all
+    (true-listp (mv-nth 0 (read-object-all channel state)))
+    :rule-classes :type-prescription)
+
+  (verify-guards read-object-all)
+
+  (defthm state-p1-of-read-object-all
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :object state)))
+             (state-p1 (mv-nth 1 (read-object-all channel state)))))
+
+  (defthm open-input-channel-p1-of-read-object-all
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :object state)))
+             (open-input-channel-p1 channel :object
+                                    (mv-nth 1 (read-object-all channel state))))))
+
+
+
+
+
+(defsection read-file-objects
+  :parents (std/io)
+  :short "Read an entire file into a list of ACL2 objects."
+
+  :long "<p><b>Signature:</b> @(call read-file-objects) returns @('(mv contents state)').</p>
+
+<p>On success, @('contents') is a @(see true-listp) of ACL2 objects that have
+were found in the file, obtained by repeatedly calling @(see read-object).</p>
+
+<p>On failure, e.g., perhaps @('filename') does not exist, @('contents') will
+be a @(see stringp) saying that we failed to open the file.</p>"
+
+  (defund read-file-objects (filename state)
+    "Returns (MV ERRMSG/OBJECTS STATE)"
+    (declare (xargs :guard (and (state-p state)
+                                (stringp filename))))
+    (b* ((filename (mbe :logic (if (stringp filename) filename "")
+                        :exec filename))
+         ((mv channel state)
+          (open-input-channel filename :object state))
+         ((unless channel)
+          (mv (concatenate 'string "Error opening file " filename)
+              state))
+         ((mv data state)
+          (read-object-all channel state))
+         (state (close-input-channel channel state)))
+      (mv data state)))
+
+  (local (in-theory (enable read-file-objects)))
+
+  (defthm state-p1-of-read-file-objects
+    (implies (force (state-p1 state))
+             (state-p1 (mv-nth 1 (read-file-objects filename state)))))
+
+  (defthm true-listp-of-read-file-objects
+    (equal (true-listp (mv-nth 0 (read-file-objects filename state)))
+           (not (stringp (mv-nth 0 (read-file-objects filename state))))))
+
+  (defthm type-of-read-file-objects
+    (or (stringp (mv-nth 0 (read-file-objects filename state)))
+        (true-listp (mv-nth 0 (read-file-objects filename state))))
+    :rule-classes :type-prescription))
 
diff -Nru acl2-6.2/books/std/io/read-ints.lisp acl2-6.3/books/std/io/read-ints.lisp
--- acl2-6.2/books/std/io/read-ints.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-ints.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,28 +1,23 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
+; Standard IO Library
+; read-ints.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (in-package "ACL2")
 (include-book "base")
-(include-book "sign-byte")
 (include-book "combine")
-(local (include-book "unsigned-byte-listp"))
-(local (include-book "signed-byte-listp"))
 (local (include-book "tools/mv-nth" :dir :system))
-(local (include-book "arithmetic-3/bind-free/top" :dir :system))
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "centaur/bitops/signed-byte-p" :dir :system))
 (set-verify-guards-eagerness 2)
 (set-state-ok t)
 
@@ -64,7 +59,7 @@
     (b* (((mv byte state) (read-byte$ channel state))
          ((unless byte)
           (mv nil state)))
-      (mv (sign-byte byte) state)))
+      (mv (sign-extend 8 byte) state)))
 
   (local (in-theory (enable read-8s)))
 
@@ -886,7 +881,7 @@
 
 
 (defsection read-bytes$
-  :parents (io)
+  :parents (std/io)
   :short "Flexible macro for reading and combining 1, 2, 4, or 8 bytes from an
 open @(':byte') input stream into a single value."
 
@@ -895,7 +890,7 @@
      (read-bytes$ channel
                   [:bytes bytes]    ;; default: 1
                   [:signed signed]  ;; default: nil
-                  [:end end]        ;; default: big
+                  [:end end]        ;; default: :big
                   )
        -->
      (mv value state)
@@ -907,13 +902,13 @@
 
 <li>If you provide @('signed'), it must be either t or nil.</li>
 
-<li>If you provide @('end'), it must be either big or little. (For the 1-byte
-readers, :end does not matter.)</li>
+<li>If you provide @('end'), it must be either @(':big') or @(':little'). (For
+the 1-byte readers, @('end') does not matter.)</li>
 
 </ul>
 
-<p>This is a macro that expands into the appropriate function from the table
-below.</p>
+<p>@('Read-byte$') is a macro that expands into the appropriate function from
+the table below.</p>
 
 @({
      Name         Bytes Read    Value Range        Endian-ness
@@ -941,16 +936,16 @@
   (defmacro read-bytes$ (channel &key
                                  (bytes '1)
                                  (signed 'nil)
-                                 (end 'big))
+                                 (end ':big))
     (declare (xargs :guard (and (symbolp channel)
                                 (booleanp signed)
                                 (or (equal bytes 1)
                                     (equal bytes 2)
                                     (equal bytes 4))
-                                (or (equal end 'little)
-                                    (equal end 'big)))))
+                                (or (equal end :little)
+                                    (equal end :big)))))
     (case end
-      ('big (if signed
+      (:big (if signed
                 (case bytes
                   (1 `(read-8s ,channel state))
                   (2 `(read-16sbe ,channel state))
@@ -963,7 +958,7 @@
                 (4 `(read-32ube ,channel state))
                 (8 `(read-64ube ,channel state))
                 (t (er hard 'read-bytes$ "Bad case in read-bytes$.")))))
-      ('little (if signed
+      (:little (if signed
                    (case bytes
                      (1 `(read-8s ,channel state))
                      (2 `(read-16sle ,channel state))
@@ -1185,7 +1180,7 @@
 
 
 (defsection read-bytes$-n
-  :parents (io)
+  :parents (std/io)
   :short "Flexible macro for reading whole lists of @('n') 1-, 2-, 4-, or
 8-byte values from an open @(':byte') input stream."
 
@@ -1195,7 +1190,7 @@
      (read-bytes$-n n channel
                     [:bytes bytes]     ;; default: 1
                     [:signed signed]   ;; default: nil
-                    [:end end]         ;; default: big
+                    [:end end]         ;; default: :big
                     )
 })
 
@@ -1211,16 +1206,16 @@
 member is an appropriate integer for this combination of signedness and
 size.</p>"
 
-  (defmacro read-bytes$-n (n channel &key (bytes '1) (signed 'nil) (end 'big))
+  (defmacro read-bytes$-n (n channel &key (bytes '1) (signed 'nil) (end ':big))
     (declare (xargs :guard (and (symbolp channel)
                                 (booleanp signed)
                                 (or (equal bytes 1)
                                     (equal bytes 2)
                                     (equal bytes 4))
-                                (or (equal end 'little)
-                                    (equal end 'big)))))
+                                (or (equal end :little)
+                                    (equal end :big)))))
     (case end
-      ('big (if signed
+      (:big (if signed
                 (case bytes
                   (1 `(read-8s-n ,n ,channel state))
                   (2 `(read-16sbe-n ,n ,channel state))
@@ -1233,7 +1228,7 @@
                 (4 `(read-32ube-n ,n ,channel state))
                 (8 `(read-64ube-n ,n ,channel state))
                 (t (er hard 'read-bytes$-n "Bad case in read-bytes$-n.")))))
-      ('little (if signed
+      (:little (if signed
                    (case bytes
                      (1 `(read-8s-n ,n ,channel state))
                      (2 `(read-16sle-n ,n ,channel state))
diff -Nru acl2-6.2/books/std/io/read-object.lisp acl2-6.3/books/std/io/read-object.lisp
--- acl2-6.2/books/std/io/read-object.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/read-object.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,54 +1,4 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
 (in-package "ACL2")
 
+; cert_param: (reloc_stub)
 (include-book "base")
-
-;; (local (include-book "update-state"))
-;; (local (include-book "open-input-channels"))
-
-;; ; [Removed by Matt K. to handle changes to member, assoc, etc. after ACL2 4.2.]
-;; ; (local (defthm assoc-eq-is-assoc-equal
-;; ;          (equal (assoc-eq a x)
-;; ;                 (assoc-equal a x))))
-
-;; (defthm read-object-state
-;;   (implies (and (force (state-p1 state))
-;;                 (force (open-input-channel-p1 channel :object state))
-;;                 (force (symbolp channel)))
-;;            (state-p1 (mv-nth 2 (read-object channel state))))
-;;   :hints(("Goal" :in-theory (disable statep-functions)
-;;           :use ((:instance state-p1
-;;                            (x state))
-;;                 (:instance state-p1
-;;                            (x (mv-nth 2 (read-object channel state))))))))
-
-;; (defthm read-object-open-input-channel-p1
-;;   (implies (and (force (state-p1 state))
-;;                 (force (open-input-channel-p1 channel :object state))
-;;                 (force (symbolp channel)))
-;;            (open-input-channel-p1 channel
-;;                                   :object
-;;                                   (mv-nth 2 (read-object channel state))))
-;;   :hints(("Goal" :in-theory (disable statep-functions)
-;;           :use ((:instance state-p1
-;;                            (x state))
-;;                 (:instance state-p1
-;;                            (x (mv-nth 2 (read-object channel state))))))))
-
-;; (in-theory (disable state-p1 open-input-channel-p1 read-object))
diff -Nru acl2-6.2/books/std/io/sign-byte.lisp acl2-6.3/books/std/io/sign-byte.lisp
--- acl2-6.2/books/std/io/sign-byte.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/sign-byte.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,87 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-(set-verify-guards-eagerness 2)
-
-;; BOZO rework to use bitops/sign-extend.lisp stuff
-(defund-inline sign-byte (x)
-  (declare (type (unsigned-byte 8) x))
-  (mbe :logic
-       (let ((x (nfix x)))
-         (if (< x 128)
-             x
-           (- x 256)))
-       :exec
-       (if (< x 128)
-           x
-         (- x 256))))
-
-(local (in-theory (enable sign-byte)))
-
-(defthm sign-byte-type
-  (integerp (sign-byte x))
-  :rule-classes :type-prescription)
-
-(local (defun logbitp-equiv (i x y)
-  (declare (xargs :guard (and (natp i)
-                              (integerp x)
-                              (integerp y))))
-  (and (equal (logbitp i x) (logbitp i y))
-       (or (zp i)
-           (logbitp-equiv (1- i) x y)))))
-
-(local (defthm logbitp-equiv-lemma
-  (implies (and (logbitp-equiv n x y)
-                (syntaxp (not (equal x y)))
-                (integerp n)
-                (<= 0 n)
-                (integerp i)
-                (<= 0 i)
-                (<= i n))
-           (equal (logbitp i y)
-                  (logbitp i x)))
-  :hints(("Goal" :in-theory (disable logbitp)))))
-
-(local (defun test-sign-byte (i)
-  (declare (type (unsigned-byte 8) i))
-  (and (logbitp-equiv 7 i (sign-byte i))
-       (or (zp i)
-           (test-sign-byte (1- i))))))
-
-(local (defthm test-sign-byte-lemma
-  (implies (and (test-sign-byte n)
-                (integerp n) (<= 0 n)
-                (integerp i) (<= 0 i) (<= i n)
-                (integerp k) (<= 0 k) (< k 8))
-           (equal (logbitp k (sign-byte i))
-                  (logbitp k i)))
-  :hints(("Goal" :in-theory (disable logbitp)))))
-
-(defthm sign-byte-bit-correct
-  (implies (and (unsigned-byte-p 8 i)
-                (integerp k)
-                (<= 0 k)
-                (< k 8))
-           (equal (logbitp k (sign-byte i))
-                  (logbitp k i)))
-  :hints(("Goal" :use (:instance test-sign-byte-lemma (n 255)))))
-
-(defthm sign-byte-range-correct
-  (implies (unsigned-byte-p 8 i)
-           (signed-byte-p 8 (sign-byte i))))
-
diff -Nru acl2-6.2/books/std/io/signed-byte-listp.lisp acl2-6.3/books/std/io/signed-byte-listp.lisp
--- acl2-6.2/books/std/io/signed-byte-listp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/signed-byte-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,137 +1,4 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
 (in-package "ACL2")
-(set-verify-guards-eagerness 2)
-
-(in-theory (disable signed-byte-p))
-
-(defund signed-byte-listp (n x)
-  (if (atom x)
-      (null x)
-    (and (signed-byte-p n (car x))
-         (signed-byte-listp n (cdr x)))))
-
-(defthm signed-byte-listp-when-not-consp
-  (implies (not (consp x))
-           (equal (signed-byte-listp n x)
-                  (not x)))
-  :hints(("Goal" :in-theory (enable signed-byte-listp))))
-
-(defthm signed-byte-listp-of-cons
-  (equal (signed-byte-listp n (cons a x))
-         (and (signed-byte-p n a)
-              (signed-byte-listp n x)))
-  :hints(("Goal" :in-theory (enable signed-byte-listp))))
-
-(defthm true-listp-when-signed-byte-listp
-  (implies (signed-byte-listp bytes x)
-           (true-listp x))
-  :hints(("Goal" :induct (len x))))
-
-(encapsulate
- ()
- (local (include-book "ihs/logops-lemmas" :dir :system))
-
- (local (in-theory (disable binary-logior
-                            binary-logand
-                            lognot)))
-
- (local (in-theory (enable signed-byte-p-logops)))
-
- (defthm signed-byte-p-logand
-   (implies (and (signed-byte-p size x)
-                 (signed-byte-p size y))
-            (signed-byte-p size (logand x y))))
-
- (defthm signed-byte-p-logior
-   (implies (and (signed-byte-p size x)
-                 (signed-byte-p size y))
-            (signed-byte-p size (logior x y))))
-
- (defthm signed-byte-p-lognot
-   (implies (signed-byte-p size x)
-            (signed-byte-p size (lognot x))))
- )
-
-
-(defthm decrement-positive-signed-byte
-  (implies (and (signed-byte-p n x)
-                (< 0 x))
-           (signed-byte-p n (1- x)))
-  :hints(("Goal" :in-theory (enable signed-byte-p))))
-
-(encapsulate
- ()
-
- (local (include-book "arithmetic-3/bind-free/top" :dir :system))
-
- (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
-
- (local (set-default-hints
-         '((nonlinearp-default-hint stable-under-simplificationp
-                                    hist pspv))))
-
- (local (include-book "unsigned-byte-listp"))
-
- (defthm signed-byte-promote
-   (implies (and (signed-byte-p size1 x)
-                 (integerp size2)
-                 (<= size1 size2))
-            (signed-byte-p size2 x))
-   :hints(("Goal" :in-theory (enable signed-byte-p))))
-
- ; Added by Robert Krug 6/15/07 due to changes in non-linear arithmetic:
- (local (prefer-positive-exponents))
-
- (defthm signed-byte-p-of-ash
-   (implies (and (force (integerp x))
-                 (force (integerp shift))
-                 (force (integerp size))
-                 (<= 0 size)
-                 (<= 0 shift)
-                 (< shift size))
-            (equal (signed-byte-p size (ash x shift))
-                   (signed-byte-p (- size shift) x)))
-   :hints(("Goal" :in-theory (enable signed-byte-p ash))))
-
- (defthm ash-sbyte-positive
-   (implies (and (force (integerp x))
-                 (force (integerp shift))
-                 (force (integerp size))
-                 (<= 0 x)
-                 (<= 1 size)
-                 (< shift (1- size)))
-            (equal (signed-byte-p size (ash x shift))
-                   (signed-byte-p (- size shift) x)))
-   :hints(("Goal" :in-theory (e/d (signed-to-unsigned-promote)
-                                  (ash)))))
-
- (defthm signed-byte-p-resolver
-   (implies (and (integerp n)
-                 (<= 1 n)
-                 (integerp x)
-                 (<= (- (expt 2 (1- n))) x)
-                 (< x (expt 2 (1- n))))
-            (signed-byte-p n x))
-   :hints(("Goal" :in-theory (enable signed-byte-p))))
-
- )
 
-(in-theory (disable ash))
-(in-theory (disable binary-logior))
-(in-theory (disable binary-logand))
+; cert_param: (reloc_stub)
+(include-book "std/typed-lists/signed-byte-listp" :dir :system)
diff -Nru acl2-6.2/books/std/io/take-bytes.lisp acl2-6.3/books/std/io/take-bytes.lisp
--- acl2-6.2/books/std/io/take-bytes.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/take-bytes.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,66 +1,73 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
+; Standard IO Library
+; take-bytes.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (in-package "ACL2")
 (include-book "read-file-bytes")
 (include-book "nthcdr-bytes")
+(local (include-book "base"))
+(local (include-book "arithmetic/top" :dir :system))
+(local (include-book "tools/mv-nth" :dir :system))
 (set-state-ok t)
 
-(defund take-bytes (n channel state)
-  (declare (xargs :guard (and (natp n)
-                              (state-p state)
-                              (symbolp channel)
-                              (open-input-channel-p channel :byte state))))
-  (if (zp n)
-      (mv nil state)
-    (mv-let (a state)
-            (read-byte$ channel state)
-            (mv-let (x state)
-                    (take-bytes (1- n) channel state)
-                    (mv (cons a x) state)))))
-
-(defthm state-p1-of-take-bytes
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (state-p1 (mv-nth 1 (take-bytes n channel state))))
-  :hints(("Goal" :in-theory (enable take-bytes))))
-
-(defthm open-input-channel-p1-of-take-bytes
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (open-input-channel-p1 channel :byte (mv-nth 1 (take-bytes n channel state))))
-  :hints(("Goal" :in-theory (enable take-bytes))))
-
-(defthm car-of-take-bytes
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (equal (mv-nth 0 (take-bytes n channel state))
-                  (take n (mv-nth 0 (read-byte$-all channel state)))))
-  :hints(("Goal"
-          :in-theory (enable take-redefinition take-bytes read-byte$-all)
-          :induct (take-bytes n channel state))))
-
-(defthm mv-nth1-of-take-bytes$
-  (implies (and (force (state-p1 state))
-                (force (symbolp channel))
-                (force (open-input-channel-p1 channel :byte state)))
-           (equal (mv-nth 1 (take-bytes n channel state))
-                  (nthcdr-bytes n channel state)))
-  :hints(("Goal" :in-theory (enable take-bytes nthcdr-bytes))))
\ No newline at end of file
+(defsection take-bytes
+  :parents (std/io)
+  :short "Read the first @('n') bytes from an open file."
+  :long "<p>@(call take-bytes) is like @(see take) for an @(':byte') input
+channel.  That is, it just reads @('n') bytes and returns them as a list,
+and also returns the updated state.</p>"
+
+  (defund take-bytes (n channel state)
+    (declare (xargs :guard (and (natp n)
+                                (state-p state)
+                                (symbolp channel)
+                                (open-input-channel-p channel :byte state))))
+    (b* (((when (zp n))
+          (mv nil state))
+         ((mv a state)
+          (read-byte$ channel state))
+         ((mv x state)
+          (take-bytes (1- n) channel state)))
+      (mv (cons a x) state)))
+
+  (local (in-theory (enable take-bytes nthcdr-bytes)))
+
+  (defthm state-p1-of-take-bytes
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (state-p1 (mv-nth 1 (take-bytes n channel state)))))
+
+  (defthm open-input-channel-p1-of-take-bytes
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (open-input-channel-p1 channel :byte
+                                    (mv-nth 1 (take-bytes n channel state)))))
+
+  (defthm mv-nth0-of-take-bytes
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (equal (mv-nth 0 (take-bytes n channel state))
+                    (take n (mv-nth 0 (read-byte$-all channel state)))))
+    :hints(("Goal"
+            :in-theory (enable take-redefinition read-byte$-all repeat)
+            :induct (take-bytes n channel state))))
+
+  (defthm mv-nth1-of-take-bytes$
+    (implies (and (force (state-p1 state))
+                  (force (symbolp channel))
+                  (force (open-input-channel-p1 channel :byte state)))
+             (equal (mv-nth 1 (take-bytes n channel state))
+                    (nthcdr-bytes n channel state)))))
diff -Nru acl2-6.2/books/std/io/top.lisp acl2-6.3/books/std/io/top.lisp
--- acl2-6.2/books/std/io/top.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/top.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,6 +1,6 @@
 ; Standard IO Library
 ; Portions are Copyright (C) 2008-2013 Centaur Technology
-; Portions are Copyright (C) 2004-2006 by Jared Davis
+; Portions are Copyright (C) 2004-2013 by Jared Davis
 ; See individual books for details
 ;
 ; This program is free software; you can redistribute it and/or modify it under
@@ -15,23 +15,75 @@
 
 (in-package "ACL2")
 (include-book "base")
-; (include-book "close-input-channel") ; stubbed out
 (include-book "combine")
 (include-book "nthcdr-bytes")
-; (include-book "open-input-channel")  ; stubbed out
-; (include-book "open-input-channels") ; unnecessary, I think
-; (include-book "peek-char") ; stubbed out
-; (include-book "read-byte") ; stubbed out
-; (include-book "read-char") ; stubbed out
 (include-book "read-file-bytes")
 ; (include-book "read-file-characters-no-error") ; omitted due to weird license stuff
-(include-book "read-file-characters") 
+(include-book "read-file-characters")
 (include-book "read-file-lines")
 (include-book "read-file-objects")
 (include-book "read-ints")
-; (include-book "read-object") ; stubbed out
-(include-book "sign-byte")
-(include-book "signed-byte-listp")
 (include-book "take-bytes")
-(include-book "unsigned-byte-listp")
 
+
+(defxdoc std/io
+  :parents (std io interfacing-tools)
+  :short "A library for reasoning about file input/output operations."
+
+  :long "<h3>Introduction</h3>
+
+<p>The @('std/io') library provides:</p>
+
+<ul>
+
+<li>Basic lemmas about low-level, built-in ACL2 @(see io) operations like @(see
+open-input-channel), @(see read-byte$), @(see close-output-channel), and so
+on.  (These are especially useful for guard proofs about IO functions.)</li>
+
+<li>A @(see file-measure) for proving the termination of functions that read
+from files.</li>
+
+<li>Extended low-level file input operations such as @(see read-bytes$), which
+lets you efficiently read 16-, 32-, and 64-bits from a file at once.</li>
+
+<li>High-level operations for reading whole files, such as @(see
+read-file-bytes), @(see read-file-characters), and @(see
+read-file-objects).</li>
+
+</ul>
+
+<p>Some basic information about low-level i/o facilities in ACL2 can be found
+in @(see io), and for some  and also @(see logical-story-of-io).</p>
+
+<h3>Loading the Library</h3>
+
+<p>If you just want to load the whole IO library, you can include the @('top')
+book, e.g.,</p>
+
+@({ (include-book \"std/io/top\" :dir :system) })
+
+<p>But this may be more than you need.  The library is split up into sensible
+books that can generally be loaded individually.</p>")
+
+
+
+(defxdoc logical-story-of-io
+  :parents (std/io)
+  :short "How file reading operations are modeled in the ACL2 logic."
+
+  :long "<p>ACL2's @(see io) operations are available in @(':logic') mode (see
+@(see defun-mode)).  This is somewhat tricky to justify in the logic, since,
+e.g., the contents of a file is external to ACL2, can be changed over time, and
+so on.</p>
+
+<p>Practically speaking, most users don't need to pay any attention to the
+details of this story.  Instead, they can just include the @(see std/io)
+library, which develops the basic theorems that are necessary to reason about
+the io primitives.</p>
+
+<p>But if for some reason, you do want to understand the logical story, you
+might start with this paper:</p>
+
+<p>Jared Davis.  <a
+href='http://www.ccs.neu.edu/home/pete/acl206/papers/davisb.pdf'>Reasoning
+about ACL2 File Input</a>.  ACL2 Workshop 2006.</p>")
diff -Nru acl2-6.2/books/std/io/unsigned-byte-listp.lisp acl2-6.3/books/std/io/unsigned-byte-listp.lisp
--- acl2-6.2/books/std/io/unsigned-byte-listp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/io/unsigned-byte-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,215 +1,4 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
 (in-package "ACL2")
-(set-verify-guards-eagerness 2)
-
-(include-book "std/lists/take" :dir :system)
-(include-book "arithmetic/nat-listp" :dir :system)
-(local (include-book "std/lists/repeat" :dir :system))
-
-(in-theory (disable unsigned-byte-p))
-
-(defund unsigned-byte-listp (n x)
-  (if (atom x)
-      (null x)
-    (and (unsigned-byte-p n (car x))
-         (unsigned-byte-listp n (cdr x)))))
-
-(defthm unsigned-byte-listp-when-not-consp
-  (implies (not (consp x))
-           (equal (unsigned-byte-listp n x)
-                  (not x)))
-  :hints(("Goal" :in-theory (enable unsigned-byte-listp))))
-
-(defthm unsigned-byte-listp-of-cons
-  (equal (unsigned-byte-listp n (cons a x))
-         (and (unsigned-byte-p n a)
-              (unsigned-byte-listp n x)))
-  :hints(("Goal" :in-theory (enable unsigned-byte-listp))))
-
-(defthm unsigned-byte-p-of-car-when-unsigned-byte-listp
-  (implies (unsigned-byte-listp bytes x)
-           (equal (unsigned-byte-p bytes (car x))
-                  (consp x)))
-  :rule-classes (:rewrite :forward-chaining))
-
-(defthm nat-listp-when-unsigned-byte-listp
-  (implies (unsigned-byte-listp bytes x)
-           (nat-listp x))
-  :hints(("Goal" :induct (len x))))
-
-(defthm true-listp-when-unsigned-byte-listp
-  (implies (unsigned-byte-listp bytes x)
-           (true-listp x))
-  :hints(("Goal" :induct (len x))))
-
-(encapsulate
- ()
-
- (local (include-book "ihs/logops-lemmas" :dir :system))
-
- (local (in-theory (disable binary-logior
-                            binary-logand
-                            lognot
-                            unsigned-byte-p)))
-
- (local (in-theory (enable signed-byte-p-logops)))
-
- (defthm unsigned-byte-p-logand
-   (implies (and (or (unsigned-byte-p size i)
-                     (unsigned-byte-p size j))
-                 (force (integerp i))
-                 (force (integerp j)))
-            (unsigned-byte-p size (logand i j))))
-
- (defthm unsigned-byte-p-logior
-   (implies (and (force (integerp i))
-                 (force (integerp j)))
-            (equal (unsigned-byte-p size (logior i j))
-                   (and (unsigned-byte-p size i)
-                        (unsigned-byte-p size j))))))
-
-
-(defthm decrement-positive-unsigned-byte
-  (implies (and (unsigned-byte-p n x)
-                (< 0 x))
-           (unsigned-byte-p n (1- x)))
-  :hints(("Goal" :in-theory (enable unsigned-byte-p))))
-
-
-(encapsulate
- ()
-
- (local (include-book "arithmetic-3/bind-free/top" :dir :system))
- (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
-
- (local (set-default-hints
-         '((nonlinearp-default-hint stable-under-simplificationp
-                                    hist pspv))))
-
- (local (defthm signed-byte-promote
-          (implies (and (signed-byte-p size1 x)
-                        (integerp size2)
-                        (<= size1 size2))
-                   (signed-byte-p size2 x))))
-
- (defthm unsigned-byte-promote
-   (implies (and (unsigned-byte-p size1 x)
-                 (integerp size2)
-                 (<= size1 size2))
-            (unsigned-byte-p size2 x))
-   :hints(("Goal" :in-theory (enable unsigned-byte-p))))
-
- (local (defthm lemma
-          (implies (unsigned-byte-p a x)
-                   (signed-byte-p (+ 1 a) x))
-          :hints(("Goal" :in-theory (enable unsigned-byte-p)))))
-
- (defthm unsigned-to-signed-promote
-   (implies (and (unsigned-byte-p size1 x)
-                 (integerp size2)
-                 (< size1 size2))
-            (signed-byte-p size2 x))
-   :hints(("Goal"
-           :in-theory (enable unsigned-byte-p)
-           :use ((:instance lemma
-                            (a size1))
-                 (:instance signed-byte-promote
-                            (size1 (+ 1 size1)))))))
-
-  (defthm unsigned-byte-p-of-ash
-    (implies (and (force (integerp x))
-                  (force (integerp shift))
-                  (force (integerp size))
-                  (<= 0 size)
-                  (< shift size))
-             (equal (unsigned-byte-p size (ash x shift))
-                    (unsigned-byte-p (- size shift) x)))
-    :hints(("Goal" :in-theory (enable unsigned-byte-p))))
-
-  (defthmd signed-to-unsigned-promote
-    (implies (and (force (integerp n))
-                  (force (integerp x))
-                  (<= 0 x))
-             (equal (signed-byte-p n x)
-                    (unsigned-byte-p (1- n) x)))
-    :hints(("Goal" :in-theory (enable unsigned-byte-p))))
-
-  (defthm ash-positive
-    (implies (and (integerp x)
-                  (integerp n)
-                  (<= 0 x))
-             (<= 0 (ash x n)))
-    :rule-classes ((:rewrite) (:linear)))
-
-  (defthm unsigned-byte-p-resolver
-    (implies (and (integerp n) (<= 0 n)
-                  (integerp x) (<= 0 x)
-                  (< x (expt 2 n)))
-             (unsigned-byte-p n x))
-    :hints(("Goal" :in-theory (enable unsigned-byte-p))))
-
-  )
-
-
-(in-theory (disable ash))
-(in-theory (disable binary-logior))
-(in-theory (disable binary-logand))
-
-
-(defthm unsigned-byte-listp-of-append
-  (equal (unsigned-byte-listp bytes (append x y))
-         (and (unsigned-byte-listp bytes (list-fix x))
-              (unsigned-byte-listp bytes y)))
-  :hints(("Goal" :induct (len x))))
-
-(defthm unsigned-byte-listp-of-list-fix-when-unsigned-byte-listp
-  (implies (unsigned-byte-listp bytes x)
-           (unsigned-byte-listp bytes (list-fix x))))
-
-(local (defthm unsigned-byte-listp-of-repeat
-         (equal (unsigned-byte-listp bytes (repeat x n))
-                (or (zp n)
-                    (unsigned-byte-p bytes x)))
-         :hints(("Goal" :in-theory (enable repeat)))))
-
-(local (defthm lemma-for-arithmetic
-         (implies (not (zp n))
-                  (equal (not (< 1 n))
-                         (equal 1 n)))))
-
-(defthm unsigned-byte-listp-of-take
-  (implies (unsigned-byte-listp bytes x)
-           (equal (unsigned-byte-listp bytes (take n x))
-                  (or (zp n)
-                      (<= n (len x))))))
-
-(defthm unsigned-byte-listp-of-take-past-length
-  (implies (and (natp k)
-                (< (len x) k))
-           (not (unsigned-byte-listp bytes (take k x)))))
-
-(defthm unsigned-byte-listp-of-nthcdr
-  (implies (unsigned-byte-listp bytes x)
-           (unsigned-byte-listp bytes (nthcdr n x))))
-
-(defthm unsigned-byte-listp-when-take-and-nthcdr
-  (implies (and (unsigned-byte-listp bytes (take n x))
-                (unsigned-byte-listp bytes (nthcdr n x)))
-           (unsigned-byte-listp bytes x)))
 
+; cert_param: (reloc_stub)
+(include-book "std/typed-lists/unsigned-byte-listp" :dir :system)
diff -Nru acl2-6.2/books/std/ks/Makefile acl2-6.3/books/std/ks/Makefile
--- acl2-6.2/books/std/ks/Makefile	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/ks/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-include ../../Makefile-generic
--include Makefile-deps
diff -Nru acl2-6.2/books/std/ks/base10-digit-charp.lisp acl2-6.3/books/std/ks/base10-digit-charp.lisp
--- acl2-6.2/books/std/ks/base10-digit-charp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/ks/base10-digit-charp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; The following line marks this book as a relocation stub:
-;; cert_param: (reloc_stub)
-
-(include-book "std/misc/base10-digit-charp" :dir :system)
diff -Nru acl2-6.2/books/std/ks/explode-atom.lisp acl2-6.3/books/std/ks/explode-atom.lisp
--- acl2-6.2/books/std/ks/explode-atom.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/ks/explode-atom.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; The following line marks this book as a relocation stub:
-;; cert_param: (reloc_stub)
-
-(include-book "std/misc/explode-atom" :dir :system)
diff -Nru acl2-6.2/books/std/ks/explode-nonnegative-integer.lisp acl2-6.3/books/std/ks/explode-nonnegative-integer.lisp
--- acl2-6.2/books/std/ks/explode-nonnegative-integer.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/ks/explode-nonnegative-integer.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; The following line marks this book as a relocation stub:
-;; cert_param: (reloc_stub)
-
-(include-book "std/misc/explode-nonnegative-integer" :dir :system)
diff -Nru acl2-6.2/books/std/ks/intern-in-package-of-symbol.lisp acl2-6.3/books/std/ks/intern-in-package-of-symbol.lisp
--- acl2-6.2/books/std/ks/intern-in-package-of-symbol.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/ks/intern-in-package-of-symbol.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; The following line marks this book as a relocation stub:
-;; cert_param: (reloc_stub)
-
-(include-book "std/misc/intern-in-package-of-symbol" :dir :system)
diff -Nru acl2-6.2/books/std/ks/string-append.lisp acl2-6.3/books/std/ks/string-append.lisp
--- acl2-6.2/books/std/ks/string-append.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/ks/string-append.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; The following line marks this book as a relocation stub:
-;; cert_param: (reloc_stub)
-
-(include-book "std/misc/string-append" :dir :system)
diff -Nru acl2-6.2/books/std/ks/two-nats-measure.lisp acl2-6.3/books/std/ks/two-nats-measure.lisp
--- acl2-6.2/books/std/ks/two-nats-measure.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/ks/two-nats-measure.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-;; The following line marks this book as a relocation stub:
-;; cert_param: (reloc_stub)
-
-(include-book "std/misc/two-nats-measure" :dir :system)
diff -Nru acl2-6.2/books/std/lists/acl2-count.lisp acl2-6.3/books/std/lists/acl2-count.lisp
--- acl2-6.2/books/std/lists/acl2-count.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/acl2-count.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,37 @@
+; acl2-count of lists
+;
+; These theorems are proved so often that I don't think there's any sense
+; copyrighting them.
+
+; Not sure if it's best to put theorems about acl2-count of other list-related
+; stuff here or in the books for the various list functions, e.g., there's some
+; stuff about acl2-count of nthcdr in the nthcdr book.  For now here are some
+; lemmas about car and cdr that are all over the place.
+
+; It looks like there aren't any exact name clashes -- some overlap in
+; centaur/vl/util/arithmetic, but in the VL package.
+
+(in-package "ACL2")
+
+(defthm acl2-count-of-car
+  (and (implies (consp x)
+                (< (acl2-count (car x))
+                   (acl2-count x)))
+       (<= (acl2-count (car x))
+           (acl2-count x)))
+  :hints(("Goal" :in-theory (enable acl2-count)))
+  :rule-classes :linear)
+
+(defthm acl2-count-of-cdr
+  (and (implies (consp x)
+                (< (acl2-count (cdr x))
+                   (acl2-count x)))
+       (<= (acl2-count (cdr x))
+           (acl2-count x)))
+  :hints(("Goal" :in-theory (enable acl2-count)))
+  :rule-classes :linear)
+
+(defthm acl2-count-of-consp-positive
+  (implies (consp x)
+           (< 0 (acl2-count x)))
+  :rule-classes (:type-prescription :linear))
diff -Nru acl2-6.2/books/std/lists/append.lisp acl2-6.3/books/std/lists/append.lisp
--- acl2-6.2/books/std/lists/append.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/append.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -43,6 +43,9 @@
            (true-listp y)))
 
   (defthm consp-of-append
+    ;; Note that data-structures/list-defthms has a similar rule, except that
+    ;; it adds two type-prescription corollaries.  I found these corollaries to
+    ;; be expensive, so I don't bother with them.
     (equal (consp (append x y))
            (or (consp x)
                (consp y))))
@@ -92,6 +95,9 @@
     (equal (append x nil)
            (list-fix x)))
 
+  ;; Disable this built-in ACL2 rule since append-of-nil is stronger.
+  (in-theory (disable append-to-nil))
+
   (defthm car-of-append
     (equal (car (append x y))
            (if (consp x)
diff -Nru acl2-6.2/books/std/lists/butlast.lisp acl2-6.3/books/std/lists/butlast.lisp
--- acl2-6.2/books/std/lists/butlast.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/butlast.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,43 @@
+; Butlast lemmas
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;
+; butlast.lisp
+
+(in-package "ACL2")
+(local (include-book "take"))
+(local (include-book "arithmetic/top" :dir :system))
+
+(defthm butlast-redefinition
+  (equal (butlast x n)
+         (if (>= (nfix n) (len x))
+             nil
+           (cons (car x)
+                 (butlast (cdr x) n))))
+  :rule-classes ((:definition :clique (butlast)
+                  :controller-alist ((butlast t t)))))
+
+(defun butlast-induction (x n)
+  (if (>= (nfix n) (len x))
+      nil
+    (cons (car x)
+          (butlast-induction (cdr x) n))))
+
+(defthm use-butlast-induction
+  t
+  :rule-classes ((:induction
+                  :pattern (butlast x n)
+                  :scheme (butlast-induction x n))))
+
+  
+
+
diff -Nru acl2-6.2/books/std/lists/coerce.lisp acl2-6.3/books/std/lists/coerce.lisp
--- acl2-6.2/books/std/lists/coerce.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/coerce.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,123 +1,4 @@
-; Coerce lemmas
-; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-;
-; coerce.lisp
-; This file was originally part of the Unicode library.
-
 (in-package "ACL2")
 
-; I think it's probably best to non-locally include this, since it can be
-; introduced into goals due to rules like coerce-inverse-1-better.
-(include-book "make-character-list")
-
-(defsection chars
-  :parents (std/lists coerce)
-  :short "@(call chars) is just shorthand for @('(coerce x 'list)')."
-  :long "<p>This macro is useful for shortening up code and theorems about
-strings.</p> @(def chars)"
-
-  (defmacro chars (x)
-    (list 'coerce x ''list)))
-
-
-(defsection std/lists/coerce
-  :parents (std/lists coerce)
-  :short "Lemmas about @(see coerce) available in the @(see std/lists)
-library."
-
-  (local (defthm coerce-string-lemma
-           (implies (and (character-listp x)
-                         (character-listp y)
-                         (not (equal x y)))
-                    (not (equal (coerce x 'string)
-                                (coerce y 'string))))
-           :hints(("Goal" :use ((:instance coerce-inverse-1 (x x))
-                                (:instance coerce-inverse-1 (x y)))))))
-
-  (defthm equal-of-coerce-strings
-    (implies (and (character-listp x)
-                  (character-listp y))
-             (equal (equal (coerce x 'string)
-                           (coerce y 'string))
-                    (equal x y))))
-
-  (local (defthm coerce-list-lemma
-           (implies (and (stringp x)
-                         (stringp y)
-                         (not (equal x y)))
-                    (not (equal (coerce x 'list)
-                                (coerce y 'list))))
-           :hints(("Goal" :use ((:instance coerce-inverse-2 (x x))
-                                (:instance coerce-inverse-2 (x y)))))))
-
-  (defthm equal-of-coerce-lists
-    (implies (and (stringp x)
-                  (stringp y))
-             (equal (equal (coerce x 'list)
-                           (coerce y 'list))
-                    (equal x y))))
-
-  (defthm character-listp-of-coerce-list
-    (character-listp (coerce x 'list)))
-
-  (defthm coerce-list-under-iff
-    (implies (stringp string)
-             (iff (coerce string 'list)
-                  (not (equal "" string))))
-    :hints(("Goal"
-            :in-theory (disable acl2::equal-of-coerce-lists)
-            :use ((:instance acl2::equal-of-coerce-lists
-                             (acl2::x string)
-                             (acl2::y ""))))))
-
-  (defthm length-of-coerce
-    ;; Wow, coerce is sort of awful in that (coerce "foo" 'string) returns ""
-    ;; and (coerce '(1 2 3) 'list) returns nil.  This leads to a weird length
-    ;; theorem.  We normally just leave length enabled, so this rule won't have
-    ;; many uses.
-    (equal (length (coerce x y))
-           (cond ((equal y 'list)
-                  (if (stringp x)
-                      (length x)
-                    0))
-                 (t
-                  (if (stringp x)
-                      0
-                    (len x)))))
-    :hints(("Goal"
-            :use ((:instance completion-of-coerce
-                             (x x)
-                             (y y))))))
-
-  (defthm len-of-coerce-to-string
-    (equal (len (coerce x 'string))
-           0))
-
-  (defthm coerce-inverse-1-better
-    (equal (coerce (coerce x 'string) 'list)
-           (if (stringp x)
-               nil
-             (make-character-list x)))
-    :hints(("Goal"
-            :use ((:instance acl2::completion-of-coerce
-                             (acl2::x x)
-                             (acl2::y 'string))))))
-
-  (defthm coerce-inverse-2-better
-    (equal (coerce (coerce x 'list) 'string)
-           (if (stringp x)
-               x
-             "")))
-
-  (in-theory (disable coerce-inverse-1 coerce-inverse-2)))
-
+;; cert_param: (reloc_stub)
+(include-book "../../str/coerce")
\ No newline at end of file
diff -Nru acl2-6.2/books/std/lists/duplicity.lisp acl2-6.3/books/std/lists/duplicity.lisp
--- acl2-6.2/books/std/lists/duplicity.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/duplicity.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -25,32 +25,31 @@
 (include-book "flatten")
 
 (defsection duplicity
-  :parents (std/lists defsort count no-duplicatesp)
+  :parents (std/lists count no-duplicatesp)
   :short "@(call duplicity) counts how many times the element @('a') occurs
 within the list @('x')."
 
-  :long "<p>This function is similar to ACL2's built-in @(see count) function
-but is more limited:</p>
+  :long "<p>This function is much nicer to reason about than ACL2's built-in
+@(see count) function because it is much more limited:</p>
 
 <ul>
 
-<li>@('count') can either scan for occurrences of a character in a string or an
-element in a list, and can only search within some particular sub-range,
-whereas</li>
+<li>@('count') can operate on either strings or lists; @('duplicity') only
+works on lists.</li>
 
-<li>@('duplicity') only works on lists and always searches the entire
-list.</li>
+<li>@('count') can consider only some particular sub-range of its input;
+@('duplicity') always considers the whole list.</li>
 
 </ul>
 
-<p>In practice, these limitations make @('duplicity') a much nicer function to
-work with and reason about.</p>
+<p>Reasoning about duplicity is useful when trying to show two lists are
+permutations of one another (sometimes called multiset- or bag-equivalence).  A
+classic exercise for new ACL2 users is to prove that a permutation function is
+symmetric.  Hint: a duplicity-based argument may compare quite favorably to
+induction on the definition of permutation.</p>
 
-<p>Reasoning about duplicity is very useful when trying to show that two lists
-are permutations of one another (sometimes called multiset- or
-bag-equivalence).  A classic exercise for new ACL2 users is to prove that a
-permutation function is symmetric.  Hint: a duplicity-based argument may
-compare quite favorably to induction on the definition of permutation.</p>"
+<p>This function can also be useful when trying to establish @(see
+no-duplicatesp), e.g., see @(see no-duplicatesp-equal-same-by-duplicity).</p>"
 
   (defund duplicity-exec (a x n)
     (declare (xargs :guard (natp n)))
diff -Nru acl2-6.2/books/std/lists/equiv.lisp acl2-6.3/books/std/lists/equiv.lisp
--- acl2-6.2/books/std/lists/equiv.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/equiv.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -89,8 +89,10 @@
              (list-equiv x y))
     :rule-classes :forward-chaining)
 
-  (defthm append-nil-under-list-equiv
-    (list-equiv (append x nil) x)))
+  (defthm append-atom-under-list-equiv
+    (implies (atom y)
+             (list-equiv (append x y)
+                         x))))
 
 
 (local (in-theory (enable list-equiv)))
@@ -124,7 +126,7 @@
   (defcong list-equiv iff        (member k x)  2 :hints(("Goal" :induct (cdr-cdr-ind x x-equiv))))
   (defcong list-equiv equal      (subsetp x y) 1 :hints(("Goal" :induct (cdr-cdr-ind x x-equiv))))
   (defcong list-equiv equal      (subsetp x y) 2 :hints(("Goal" :induct (cdr-cdr-ind x x-equiv))))
-  (defcong list-equiv equal      (remove k x)  2 :hints (("Goal" :induct (cdr-cdr-ind x x-equiv))))
+  (defcong list-equiv equal      (remove a x)  2 :hints (("Goal" :induct (cdr-cdr-ind x x-equiv))))
   (defcong list-equiv equal      (resize-list lst n default) 1)
 
   (defcong list-equiv equal (revappend x y) 1
@@ -136,6 +138,9 @@
   (defcong list-equiv equal (butlast lst n) 1
     :hints(("Goal" :induct (cdr-cdr-ind lst lst-equiv))))
 
+  (defcong list-equiv list-equiv (last x) 1
+    :hints(("Goal" :induct (cdr-cdr-ind x x-equiv))))
+
   (defcong list-equiv list-equiv (make-list-ac n val ac) 3)
 
   (defcong list-equiv equal (take n x) 2
diff -Nru acl2-6.2/books/std/lists/index-of.lisp acl2-6.3/books/std/lists/index-of.lisp
--- acl2-6.2/books/std/lists/index-of.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/index-of.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,136 @@
+; Index-of -- like "position" but sane(ish)
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>
+
+
+(in-package "ACL2")
+
+(include-book "xdoc/top" :dir :system)
+(local (include-book "arithmetic/top-with-meta" :dir :system))
+
+(defsection index-of
+  :parents (std/lists search)
+  :short "@(call index-of) returns the index of the first occurrence of element
+@('k') in list @('x') if it exists, @('NIL') otherwise."
+
+  :long "Like the Common Lisp function @('position') but only operates on lists
+and is not (logically) tail-recursive."
+
+
+
+  ;; BOZO this isn't the standard way to do equality variants but perhaps it's
+  ;; about as good.  In any case, index-of doesn't have a guard and should be
+  ;; pretty fast because it chooses which aux function to call based just on
+  ;; the type of the element.  The one case we lose is if we're looking for a
+  ;; badly-typed element in a well-typed list, e.g. a cons structure in a list
+  ;; of integers, in which case we'll run the equal version where we could have
+  ;; done the eql version.
+  (defun index-of-aux (k x acc)
+    (declare (type (integer 0 *) acc))
+    (cond ((atom x) nil)
+          ((equal k (car x)) (mbe :logic (ifix acc) :exec acc))
+          (t (index-of-aux k (cdr x) (+ 1 (mbe :logic (ifix acc) :exec
+                                               acc))))))
+
+  (defun index-of-aux-eq (k x acc)
+    (declare (type (integer 0 *) acc)
+             (type symbol k))
+    (cond ((atom x) nil)
+          ((eq k (car x)) (mbe :logic (ifix acc) :exec acc))
+          (t (index-of-aux k (cdr x) (+ 1 (mbe :logic (ifix acc) :exec
+                                               acc))))))
+
+  (defun index-of-aux-eql (k x acc)
+    (declare (type (integer 0 *) acc)
+             (xargs :guard (eqlablep k)))
+    (cond ((atom x) nil)
+          ((eql k (car x)) (mbe :logic (ifix acc) :exec acc))
+          (t (index-of-aux k (cdr x) (+ 1 (mbe :logic (ifix acc) :exec acc))))))
+
+  (defthm index-of-aux-eq-normalize
+    (equal (index-of-aux-eq k x acc)
+           (index-of-aux k x acc)))
+
+  (defthm index-of-aux-eql-normalize
+    (equal (index-of-aux-eql k x acc)
+           (index-of-aux k x acc)))
+
+  (defund index-of (k x)
+    (declare (xargs :guard t
+                    :verify-guards nil))
+    (mbe :logic (cond ((atom x) nil)
+                      ((equal k (car x)) 0)
+                      (t (let ((res (index-of k (cdr x))))
+                           (and res (+ 1 res)))))
+         :exec (cond ((symbolp k) (index-of-aux-eq k x 0))
+                     ((eqlablep k) (index-of-aux-eql k x 0))
+                     (t (index-of-aux k x 0)))))
+
+  (local (in-theory (enable index-of)))
+
+  (defthm index-of-aux-removal
+    (equal (index-of-aux k x acc)
+           (let ((res (index-of k x)))
+             (and res (+ res (ifix acc))))))
+
+  (verify-guards index-of)
+
+  (defthm position-equal-ac-is-index-of-aux
+    (implies (integerp acc)
+             (equal (position-equal-ac k x acc)
+                    (index-of-aux k x acc))))
+
+  (defthm index-of-iff-member
+    (iff (index-of k x)
+         (member k x)))
+
+  (defthm nth-of-index-when-member
+    (implies (member k x)
+             (equal (nth (index-of k x) x)
+                    k)))
+
+  (defthm index-of-<-len
+    (implies (member k x)
+             (< (index-of k x) (len x)))
+    :rule-classes :linear)
+
+  (defthm index-of-append-first
+    (implies (index-of k x)
+             (equal (index-of k (append x y))
+                    (index-of k x))))
+
+  (defthm index-of-append-second
+    (implies (and (not (index-of k x))
+                  (index-of k y))
+             (equal (index-of k (append x y))
+                    (+ (len x) (index-of k y)))))
+
+  (defthm index-of-append-neither
+    (implies (and (not (index-of k x))
+                  (not (index-of k y)))
+             (not (index-of k (append x y)))))
+
+  (defthmd index-of-append-split
+    (equal (index-of k (append x y))
+           (or (index-of k x)
+               (and (index-of k y)
+                    (+ (len x) (index-of k y)))))))
+                
+
+  
diff -Nru acl2-6.2/books/std/lists/intersection.lisp acl2-6.3/books/std/lists/intersection.lisp
--- acl2-6.2/books/std/lists/intersection.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/intersection.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,67 @@
+; Intersection$ Lemmas
+; Copyright (C) 2013 Kookamara LLC
+;
+; Contact:
+;   Kookamara LLC
+;   11410 Windermere Meadows
+;   Austin, TX 78759
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@kookamara.com>
+
+(in-package "ACL2")
+(include-book "sets")
+
+(in-theory (disable intersection$))
+(local (in-theory (enable intersection$)))
+
+(defthm intersection$-when-atom-left
+  (implies (atom x)
+           (equal (intersection$ x y)
+                  nil)))
+
+(defthm intersection$-when-atom-right
+  (implies (atom y)
+           (equal (intersection$ x y)
+                  nil)))
+
+(defthm intersection$-of-cons-left
+  (equal (intersection$ (cons a x) y)
+         (if (member a y)
+             (cons a (intersection$ x y))
+           (intersection$ x y))))
+
+(defthm intersection$-of-cons-right-under-set-equiv
+  (set-equiv (intersection$ x (cons a y))
+             (if (member a x)
+                 (cons a (intersection$ x y))
+               (intersection$ x y)))
+  :hints(("Goal" :in-theory (enable set-equiv))))
+
+(defthm len-of-intersection$-upper-bound
+  ;; There is no analogous rule for -right, because, e.g., X could have multiple
+  ;; copies of some member in Y, and if so we end up reproducing them.  Consider
+  ;; for instance (intersection$ '(a a a) '(a)) ==> '(a a a).
+  (<= (len (intersection$ x y))
+      (len x))
+  :rule-classes ((:rewrite) (:linear)))
+
+(defthm consp-of-intersection$
+  (equal (consp (intersection$ x y))
+         (intersectp x y))
+  :hints(("Goal" :in-theory (enable intersectp))))
+
+(defthm intersection$-under-iff
+  (iff (intersection$ x y)
+       (intersectp x y))
+  :hints(("Goal" :in-theory (enable intersectp))))
+
diff -Nru acl2-6.2/books/std/lists/last.lisp acl2-6.3/books/std/lists/last.lisp
--- acl2-6.2/books/std/lists/last.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/last.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,106 @@
+; Last Lemmas
+; Copyright (C) 2013 Kookamara LLC
+;
+; Contact:
+;   Kookamara LLC
+;   11410 Windermere Meadows
+;   Austin, TX 78759
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@kookamara.com>
+
+(in-package "ACL2")
+(include-book "xdoc/top" :dir :system)
+(include-book "list-defuns")
+(local (include-book "list-fix"))
+(local (include-book "append"))
+(local (include-book "rev"))
+
+(defsection std/lists/last
+  :parents (std/lists last)
+  :short "Lemmas about @(see last) available in the @(see std/lists) library."
+
+  (defthm last-when-atom
+    (implies (atom x)
+             (equal (last x)
+                    x)))
+
+  (defthm last-when-atom-of-cdr
+    (implies (atom (cdr x))
+             (equal (last x)
+                    x)))
+
+  (defthm last-of-cons
+    (equal (last (cons a x))
+           (if (consp x)
+               (last x)
+             (cons a x))))
+
+  (defthm consp-of-last
+    (equal (consp (last l))
+           (consp l)))
+
+  (defthm true-listp-of-last
+    (equal (true-listp (last l))
+           (true-listp l)))
+
+  (defthm last-of-list-fix
+    (equal (last (list-fix x))
+           (list-fix (last x))))
+
+  (defthm len-of-last 
+    (equal (len (last l))
+           (if (consp l)
+               1
+             0)))
+
+  (defthm upper-bound-of-len-of-last
+    (< (len (last x)) 2)
+    :rule-classes :linear)
+
+  (defthm member-of-car-of-last
+    (iff (member (car (last x)) x)
+         (if (consp x)
+             t
+           nil)))
+  
+  (defsection subsetp-of-last
+
+    (local (defthm l0
+             (implies (subsetp-equal a x)
+                      (subsetp-equal a (cons b x)))))
+
+    (defthm subsetp-of-last
+      ;; possibly good for forward chaining?
+      (subsetp (last x) x)))
+
+  (defthm last-of-append
+    (equal (last (append x y))
+           (if (consp y)
+               (last y)
+             (append (last x) y))))
+
+  (defthm last-of-rev
+    (equal (last (rev x))
+           (if (consp x)
+               (list (car x))
+             nil)))
+
+  (defthm last-of-revappend
+    (equal (last (revappend x y))
+           (cond ((consp y)
+                  (last y))
+                 ((consp x)
+                  (cons (car x) y))
+                 (t
+                  y)))))
+
diff -Nru acl2-6.2/books/std/lists/list-defuns.lisp acl2-6.3/books/std/lists/list-defuns.lisp
--- acl2-6.2/books/std/lists/list-defuns.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/list-defuns.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -23,7 +23,10 @@
 ; extended with additional definitions, e.g., from Centaur libraries.
 
 (in-package "ACL2")
+(include-book "tools/bstar" :dir :system)
+(include-book "tools/rulesets" :dir :system)
 (local (include-book "append"))
+(local (include-book "duplicity"))
 (local (include-book "list-fix"))
 (local (include-book "flatten"))
 (local (include-book "final-cdr"))
@@ -32,6 +35,7 @@
 (local (include-book "repeat"))
 (local (include-book "revappend"))
 (local (include-book "nthcdr"))
+(local (include-book "rcons"))
 (local (include-book "rev"))
 (local (include-book "equiv"))
 (local (include-book "sets"))
@@ -183,4 +187,23 @@
         (t
          (let ((pos-in-cdr (listpos x (cdr y))))
            (and pos-in-cdr
-                (+ 1 pos-in-cdr))))))
\ No newline at end of file
+                (+ 1 pos-in-cdr))))))
+
+(defund duplicity-exec (a x n)
+  (declare (xargs :guard (natp n)))
+  (if (atom x)
+      n
+    (duplicity-exec a (cdr x)
+                    (if (equal (car x) a)
+                        (+ 1 n)
+                      n))))
+
+(defund duplicity (a x)
+  (declare (xargs :guard t))
+  (mbe :logic (cond ((atom x)
+                     0)
+                    ((equal (car x) a)
+                     (+ 1 (duplicity a (cdr x))))
+                    (t
+                     (duplicity a (cdr x))))
+       :exec (duplicity-exec a x 0)))
diff -Nru acl2-6.2/books/std/lists/make-character-list.lisp acl2-6.3/books/std/lists/make-character-list.lisp
--- acl2-6.2/books/std/lists/make-character-list.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/make-character-list.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,64 +1,4 @@
-; Make-character-list lemmas
-; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-;
-; make-character-list.lisp
-; This file was originally part of the Unicode library.
-
 (in-package "ACL2")
-(include-book "xdoc/top" :dir :system)
-
-(in-theory (disable make-character-list))
-
-(defsection std/lists/make-character-list
-  :parents (std/lists make-character-list)
-  :short "Lemmas about @(see make-character-list) available in the @(see
-std/lists) library."
-
-  :long "<p>This function is normally not anything you would ever want to use.
-It is notable mainly for the role it plays in the completion axiom for @(see
-coerce).</p>"
-
-  (local (in-theory (enable make-character-list)))
-
-  (defthm make-character-list-when-atom
-    (implies (atom x)
-             (equal (make-character-list x)
-                    nil)))
-
-  ;; BOZO I want to add a make-character-list of cons rule, but I want to write
-  ;; it in terms of char-fix.  But char-fix is defined in str/eqv.lisp, so I
-  ;; can't do this because then there'd be a circular dependency between
-  ;; unicode/ and str/.  BLAH.  GG ACL2 Make.
-
-  (defthm make-character-list-when-character-listp
-    (implies (character-listp x)
-             (equal (make-character-list x)
-                    x)))
-
-  (defthm character-listp-of-make-character-list
-    (character-listp (make-character-list x)))
-
-  (defthm len-of-make-character-list
-    (equal (len (make-character-list x))
-           (len x)))
-
-  (defthm make-character-list-of-append
-    (equal (make-character-list (append x y))
-           (append (make-character-list x)
-                   (make-character-list y))))
-
-  (defthm make-character-list-of-revappend
-    (equal (make-character-list (revappend x y))
-           (revappend (make-character-list x)
-                      (make-character-list y)))))
 
+;; cert_param: (reloc_stub)
+(include-book "../../str/make-character-list")
\ No newline at end of file
diff -Nru acl2-6.2/books/std/lists/no-duplicatesp.lisp acl2-6.3/books/std/lists/no-duplicatesp.lisp
--- acl2-6.2/books/std/lists/no-duplicatesp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/no-duplicatesp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -166,10 +166,8 @@
 because it has no element whose @(see duplicity) is over 1."
 
   :long "<p>This is often a good way to prove @(see no-duplicatesp).  This is a
-basic pick-a-point style theorem that you can (manually) functionally
-instantiate.</p>
-
-@(def duplicity-constraint)"
+basic pick-a-point style theorem that you can (manually) <see topic='@(url
+functional-instantiation-example)'>functionally instantiate</see>.</p>"
 
   (encapsulate
     (((duplicity-hyp) => *)
diff -Nru acl2-6.2/books/std/lists/nth.lisp acl2-6.3/books/std/lists/nth.lisp
--- acl2-6.2/books/std/lists/nth.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/nth.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,222 @@
+; Nth Lemmas
+; Copyright (C) 2011-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "list-defuns")
+(local (include-book "rev"))
+(local (include-book "revappend"))
+(local (include-book "append"))
+(local (include-book "len"))
+(local (include-book "take"))
+(local (include-book "arithmetic/top" :dir :system))
+
+(defthm nth-when-atom
+  (implies (atom x)
+           (equal (nth n x)
+                  nil)))
+
+(defthm nth-when-zp
+  (implies (zp n)
+           (equal (nth n x)
+                  (car x))))
+
+(defthm nth-of-nil
+  (equal (nth n nil)
+         nil))
+
+(defthm nth-of-list-fix
+  (equal (nth n (list-fix x))
+         (nth n x)))
+
+(defthm nth-of-nfix
+  (equal (nth (nfix n) x)
+         (nth n x)))
+
+(defthm member-of-nth
+  (implies (< (nfix n) (len x))
+           (member (nth n x) x)))
+
+(defthmd nth-when-too-large
+  ;; Matt Kaufmann reported that this lemma got expensive in one of his books,
+  ;; so we now disable it by default and instead leave enabled a -cheap rule
+  ;; with a backchain limit.
+  (implies (<= (len x) (nfix n))
+           (equal (nth n x)
+                  nil)))
+
+(defthm nth-when-too-large-cheap
+  (implies (<= (len x) (nfix n))
+           (equal (nth n x)
+                  nil))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm nth-of-append
+  (equal (nth n (append x y))
+         (if (< (nfix n) (len x))
+             (nth n x)
+           (nth (- n (len x)) y))))
+
+(defthm nth-of-revappend
+  (equal (nth n (revappend x y))
+         (if (< (nfix n) (len x))
+             (nth (- (len x) (+ 1 (nfix n))) x)
+           (nth (- n (len x)) y))))
+
+(defthm nth-of-rev
+  (equal (nth n (rev x))
+         (if (< (nfix n) (len x))
+             (nth (- (len x) (+ 1 (nfix n))) x)
+           nil)))
+
+(defthm nth-of-reverse
+  (equal (nth n (reverse x))
+         (if (< (nfix n) (len x))
+             (nth (- (len x) (+ 1 (nfix n))) x)
+           nil)))
+
+(defthm nth-of-take
+  (equal (nth i (take n l))
+         (if (< (nfix i) (min (nfix n) (len l)))
+             (nth i l)
+           nil)))
+
+(defthm nth-of-make-list-ac
+  (equal (nth n (make-list-ac m val acc))
+         (if (< (nfix n) (nfix m))
+             val
+           (nth (- n (nfix m)) acc))))
+
+(encapsulate
+ ()
+ (local (defun my-induct (n m)
+          (if (zp m)
+              (list n m)
+            (my-induct (- n 1) (- m 1)))))
+
+ (defthm nth-of-repeat
+   (equal (nth n (repeat a m))
+          (if (< (nfix n) (nfix m))
+              a
+            nil))
+   :hints(("Goal"
+           :induct (my-induct n m)
+           :in-theory (enable repeat)))))
+
+(defthm nth-of-nthcdr
+  (equal (nth n (nthcdr m x))
+         (nth (+ (nfix n) (nfix m)) x)))
+
+(defthm nth-of-last
+  (equal (nth n (last x))
+         (if (zp n)
+             (car (last x))
+           nil)))
+
+(defthm nth-of-butlast
+  (equal (nth n (butlast x m))
+         (if (< (nfix n) (- (len x) (nfix m)))
+             (nth n x)
+           nil)))
+
+;; No rule about update-nth, because nth-update-nth is an ACL2 builtin.
+
+
+(encapsulate
+ (((equal-by-nths-hyp) => *)
+  ((equal-by-nths-lhs) => *)
+  ((equal-by-nths-rhs) => *))
+ (local (defun equal-by-nths-hyp () nil))
+ (local (defun equal-by-nths-lhs () nil))
+ (local (defun equal-by-nths-rhs () nil))
+ (defthmd equal-by-nths-constraint
+   (implies (and (equal-by-nths-hyp)
+                 (natp n)
+                 (< n (len (equal-by-nths-lhs))))
+            (equal (nth n (equal-by-nths-lhs))
+                   (nth n (equal-by-nths-rhs))))))
+
+(local (defun nth-badguy (x y)
+         (cond ((or (not (consp x))
+                    (not (consp y)))
+                0)
+               ((equal (car x) (car y))
+                (+ 1 (nth-badguy (cdr x) (cdr y))))
+               (t
+                0))))
+
+(local (defthm nth-badguy-bounded
+         (<= (nth-badguy x y) (len x))
+         :rule-classes :linear))
+
+(local (defthm nth-badguy-is-bad
+         (implies (and (equal (len x) (len y))
+                       (not (equal (nth-badguy x y) (len x))))
+                  (not (equal (nth (nth-badguy x y) x)
+                              (nth (nth-badguy x y) y))))))
+
+(local (defthm nth-badguy-is-equality
+         (implies (and (equal (len x) (len y))
+                       (true-listp x)
+                       (true-listp y))
+                  (equal (equal (nth-badguy x y) (len x))
+                         (equal x y)))))
+
+(local (in-theory (disable nth-badguy-is-equality
+                           nth-badguy-is-bad
+                           nth-badguy)))
+
+(defthm equal-by-nths
+  (implies (and (equal-by-nths-hyp)
+                (true-listp (equal-by-nths-lhs))
+                (true-listp (equal-by-nths-rhs)))
+           (equal (equal (equal-by-nths-lhs) (equal-by-nths-rhs))
+                  (equal (len (equal-by-nths-lhs)) (len (equal-by-nths-rhs)))))
+  :hints(("Goal"
+          :use ((:instance nth-badguy-is-equality
+                           (x (equal-by-nths-lhs))
+                           (y (equal-by-nths-rhs)))
+                (:instance nth-badguy-is-bad
+                           (x (equal-by-nths-lhs))
+                           (y (equal-by-nths-rhs)))
+                (:instance equal-by-nths-constraint
+                           (n (nth-badguy (equal-by-nths-lhs) (equal-by-nths-rhs))))))))
+
+
+;; Computed hint.  For now we'll assume that we're trying to prove an equality
+;; which is the conclusion of the goal, and that the rest of the goal is hyps
+;; that we might need.
+(defun equal-by-nths-hint-fn (clause)
+  (declare (xargs :mode :program))
+  (b* ((lit (car (last clause)))
+       ((unless (and (consp lit)
+                     (eq (car lit) 'equal)))
+        nil)
+       (hyps (dumb-negate-lit-lst (butlast clause 1)))
+       ((list x y) (cdr lit)))
+    `(:use ((:functional-instance
+             equal-by-nths
+             (equal-by-nths-lhs (lambda () ,x))
+             (equal-by-nths-rhs (lambda () ,y))
+             (equal-by-nths-hyp (lambda () (and . ,hyps))))))))
+
+(defmacro equal-by-nths-hint ()
+  '(equal-by-nths-hint-fn clause))
+
+
diff -Nru acl2-6.2/books/std/lists/nthcdr.lisp acl2-6.3/books/std/lists/nthcdr.lisp
--- acl2-6.2/books/std/lists/nthcdr.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/nthcdr.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -194,8 +194,10 @@
   :parents (std/lists nthcdr)
   :short "@(see rest-n) is identical to @(see nthcdr), but its guard does not
 require @('(true-listp x)')."
-  :long "<p>Note: we leave this function enabled and always reason about @(see
-nthcdr) instead.</p>"
+
+  :long "<p><b>Reasoning Note.</b> We leave @('rest-n') enabled, so it will
+just get rewritten into @('nthcdr').  You should typically never write a
+theorem about @('rest-n'): write theorems about @('nthcdr') instead.</p>"
 
   (defun rest-n (n x)
     (declare (xargs :guard (natp n)))
diff -Nru acl2-6.2/books/std/lists/rcons.lisp acl2-6.3/books/std/lists/rcons.lisp
--- acl2-6.2/books/std/lists/rcons.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/rcons.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,86 @@
+; Reverse Cons
+; Copyright (C) 2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>
+;                   Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+(include-book "equiv")
+(include-book "rev")
+
+(defun binary-append-without-guard (x y)
+  (declare (xargs :guard t))
+  (mbe :logic
+       (append x y)
+       :exec
+       (if (consp x)
+           (cons (car x)
+                 (binary-append-without-guard (cdr x) y))
+         y)))
+
+(defmacro append-without-guard (x y &rest rst)
+  (xxxjoin 'binary-append-without-guard (list* x y rst)))
+
+
+(defsection rcons
+  :parents (std/lists)
+  :short "Cons onto the back of a list."
+  :long "<p>@(call rcons) is like @(see cons), except that instead of putting
+@('a') onto front of the list @('x'), it puts it at the end.  To borrow ML
+notation, we compute @('x@[a]') instead of @('a::x').  This is obviously quite
+inefficient: we have to copy the whole list just to add one element!</p>"
+
+  (defund rcons (a x)
+    (declare (xargs :guard t))
+    (append-without-guard x (list a)))
+
+  (in-theory (disable (:type-prescription rcons)))
+  (local (in-theory (enable rcons)))
+
+  (defthm type-of-rcons
+    (and (consp (rcons a x))
+         (true-listp (rcons a x)))
+    :rule-classes :type-prescription)
+
+  (defthm rcons-of-list-fix
+    (equal (rcons a (list-fix x))
+           (rcons a x)))
+
+  (defcong list-equiv equal (rcons a x) 2)
+
+  (defthm len-of-rcons
+    (equal (len (rcons a x))
+           (+ 1 (len x))))
+
+  (defthm rev-of-rcons
+    (equal (rev (rcons a x))
+           (cons a (rev x))))
+
+  (defthm append-of-rcons
+    (equal (append (rcons a x) y)
+           (append x (cons a y))))
+
+  (defthm rcons-of-append
+    (equal (rcons a (append x y))
+           (append x (rcons a y))))
+
+  (defthm revappend-of-rcons
+    (equal (revappend (rcons a x) y)
+           (cons a (revappend x y)))))
+
+
diff -Nru acl2-6.2/books/std/lists/remove.lisp acl2-6.3/books/std/lists/remove.lisp
--- acl2-6.2/books/std/lists/remove.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/remove.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,140 @@
+; Lemmas about remove
+; Copyright (C) 2013 Kookamara LLC
+;
+; Contact:
+;   Kookamara LLC
+;   11410 Windermere Meadows
+;   Austin, TX 78759
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "xdoc/top" :dir :system)
+(include-book "list-defuns")
+(local (include-book "duplicity"))
+(local (include-book "append"))
+(local (include-book "sets"))
+
+(defsection std/lists/remove
+  :parents (std/lists remove)
+  :short "Lemmas about @(see remove) available in the @(see std/lists)
+library."
+
+  (defthm remove-when-atom
+    (implies (atom x)
+             (equal (remove a x)
+                    nil)))
+
+  (defthm remove-of-cons
+    (equal (remove a (cons b x))
+           (if (equal a b)
+               (remove a x)
+             (cons b (remove a x)))))
+
+  (defthm consp-of-remove
+    ;; BOZO consider all-equalp or similar instead?
+    (equal (consp (remove a x))
+           (not (subsetp x (list a)))))
+
+  (defthm remove-under-iff
+    (iff (remove a x)
+         (not (subsetp x (list a)))))
+
+  (defthm remove-when-non-member
+    (implies (not (member a x))
+             (equal (remove a x)
+                    (list-fix x))))
+
+  (defthm upper-bound-of-len-of-remove-weak
+    (<= (len (remove a x))
+        (len x))
+    :rule-classes ((:rewrite) (:linear)))
+
+  (defthm upper-bound-of-len-of-remove-strong
+    (implies (member a x)
+             (< (len (remove a x))
+                (len x)))
+    :rule-classes :linear)
+
+  (defthm len-of-remove-exact
+    ;; May not always be desirable, but leave it enabled by default; if someone
+    ;; disables this, they will still have at least the basic upper bound
+    ;; theorems above.
+    (equal (len (remove a x))
+           (- (len x) (duplicity a x))))
+
+  (defthm remove-is-commutative
+    (equal (remove b (remove a x))
+           (remove a (remove b x))))
+
+  (defthm remove-is-idempotent
+    (equal (remove a (remove a x))
+           (remove a x)))
+
+  (defthm duplicity-of-remove
+    (equal (duplicity a (remove b x))
+           (if (equal a b)
+               0
+             (duplicity a x))))
+
+  ;; Note: proved elsewhere in std:
+
+  ;; (defcong list-equiv equal (remove a x) 2)
+  ;; (defcong set-equiv set-equiv (remove a x) 2)
+  
+  ;; (defthm member-of-remove
+  ;;   (iff (member a (remove b x))
+  ;;        (and (member a x)
+  ;;             (not (equal a b)))))
+
+  ;; (defthm subsetp-of-remove1
+  ;;   (equal (subsetp x (remove a y))
+  ;;          (and (subsetp x y)
+  ;;               (not (member a x)))))
+
+  ;; (defthm subsetp-of-remove2
+  ;;   (implies (subsetp x y)
+  ;;            (subsetp (remove a x) y))))
+
+  (defthm remove-of-append
+    (equal (remove a (append x y))
+           (append (remove a x)
+                   (remove a y))))
+
+  (defthm remove-of-revappend
+    (equal (remove a (revappend x y))
+           (revappend (remove a x)
+                      (remove a y))))
+
+  (defthm remove-of-rev
+    (equal (remove a (rev x))
+           (rev (remove a x))))
+
+  (defthm remove-of-union-equal
+    (equal (remove a (union-equal x y))
+           (union-equal (remove a x)
+                        (remove a y))))
+
+  (defthm remove-of-intersection-equal
+    (equal (remove a (intersection-equal x y))
+           (intersection-equal (remove a x)
+                               (remove a y))))
+
+  (defthm remove-of-set-difference-equal
+    (equal (remove a (set-difference-equal x y))
+           (set-difference-equal (remove a x) y))))
+
+
+
+
+
diff -Nru acl2-6.2/books/std/lists/repeat.lisp acl2-6.3/books/std/lists/repeat.lisp
--- acl2-6.2/books/std/lists/repeat.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/repeat.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -22,8 +22,8 @@
 
 (defsection repeat
   :parents (std/lists make-list)
-  :short "@(call repeat) creates a list of @('x')es with length @('n'); it
-is a simpler alternative to @(see make-list)."
+  :short "@(call repeat) creates a list of @('x')es with length @('n'); it is a
+simpler alternative to @(see make-list)."
 
   (defund repeat (x n)
     (declare (xargs :guard (natp n)
@@ -118,34 +118,6 @@
       :hints(("Goal" :induct (dec-dec-induct k n)))))
 
 
-
-  (encapsulate
-    ()
-    (local (include-book "append"))
-
-    (local (defun silly-repeat (x n acc)
-             (if (zp n)
-                 acc
-               (cons x (silly-repeat x (- n 1) acc)))))
-
-    (local (defthm lemma1
-             (equal (make-list-ac n x acc)
-                    (silly-repeat x n acc))))
-
-    (local (defthm lemma2
-             (equal (silly-repeat x n acc)
-                    (append (repeat x n) acc))))
-
-    (defthmd make-list-ac->repeat
-      ;; BOZO we should probably just enable this.
-      (equal (make-list-ac n x acc)
-             (append (repeat x n)
-                     acc)))
-
-    (verify-guards repeat
-      :hints(("Goal" :in-theory (enable make-list-ac->repeat)))))
-
-
   (defthm append-of-repeat-to-cons-of-same
     (equal (append (repeat a n) (cons a x))
            (cons a (append (repeat a n) x))))
@@ -184,3 +156,67 @@
   (defthm rev-of-repeat
     (equal (rev (repeat a n))
            (repeat a n))))
+
+
+(local (in-theory (enable repeat)))
+
+
+(defsection make-list-ac-removal
+  :parents (repeat make-list)
+  :short "Rewrite rule that eliminates @('make-list-ac') (and hence @(see
+make-list)) in favor of @(see repeat)." 
+ 
+  (local (defun silly-repeat (x n acc)
+           (if (zp n)
+               acc
+             (cons x (silly-repeat x (- n 1) acc)))))
+
+  (local (defthm lemma1
+           (equal (make-list-ac n x acc)
+                  (silly-repeat x n acc))))
+
+  (local (defthm lemma2
+           (equal (silly-repeat x n acc)
+                  (append (repeat x n) acc))))
+
+  (defthm make-list-ac-removal
+    (equal (make-list-ac n x acc)
+           (append (repeat x n)
+                   acc))))
+
+(verify-guards repeat)
+
+
+(defsection take-of-take-split
+  :parents (std/lists/take)
+  :short "Aggressive case splitting rule to reduce @('(take a (take b x))')."
+  :long "@(def take-of-take-split)
+
+<p>This rule may sometimes cause too much case splitting.  If you disable it,
+nests of @('take') can still be reduced when ACL2 can determine the
+relationship between @('a') and @('b'), using the following related rules:</p>
+
+@(def take-of-take-same)
+@(def take-more-of-take-fewer)
+@(def take-fewer-of-take-more)"
+
+  :autodoc nil
+
+  (local (defun my-induct (a b x)
+           (if (or (zp a)
+                   (zp b))
+               (list a b x)
+             (my-induct (- a 1) (- b 1) (cdr x)))))
+
+  (defthm take-more-of-take-fewer
+    (implies (< (nfix b) (nfix a))
+             (equal (take a (take b x))
+                    (append (take b x) (repeat nil (- (nfix a) (nfix b))))))
+    :hints(("Goal" :induct (my-induct a b x))))
+
+  (defthm take-of-take-split
+    ;; This has a very aggressive case split.  
+    (equal (take a (take b x))
+           (if (<= (nfix a) (nfix b))
+               (take a x)
+             (append (take b x) (repeat nil (- (nfix a) (nfix b))))))))
diff -Nru acl2-6.2/books/std/lists/resize-list.lisp acl2-6.3/books/std/lists/resize-list.lisp
--- acl2-6.2/books/std/lists/resize-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/resize-list.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,80 @@
+; Resize List Lemmas
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Sol Swords <sswords@centtech.com>
+;                   Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "list-defuns")
+(local (include-book "len"))
+(local (include-book "list-fix"))
+(local (include-book "repeat"))
+(local (include-book "nth"))
+(local (include-book "arithmetic/top" :dir :system))
+
+(defthm resize-list-when-zp
+  (implies (zp n)
+           (equal (resize-list lst n default-value)
+                  nil)))
+
+(defthm resize-list-of-nfix
+  (equal (resize-list lst (nfix n) default-value)
+         (resize-list lst n default-value)))
+
+(defthm resize-list-when-atom
+  (implies (atom lst)
+           (equal (resize-list lst n default-value)
+                  (repeat default-value n)))
+  :hints(("Goal" :in-theory (enable repeat))))
+
+(local (defun my-induct (n m lst)
+         (if (zp n)
+             (list lst)
+           (if (zp m)
+               nil
+             (my-induct (- n 1) (- m 1)
+                        (if (atom lst)
+                            lst
+                          (cdr lst)))))))
+
+(defthm nth-of-resize-list
+  (equal (nth n (resize-list lst m default-value))
+         (let ((n (nfix n))
+               (m (nfix m)))
+           (and (< n m)
+                (if (< n (len lst))
+                    (nth n lst)
+                  default-value))))
+  :hints(("Goal"
+          :expand (resize-list lst m default-value)
+          :induct (my-induct n m lst))))
+
+(defthm len-of-resize-list
+  (equal (len (resize-list lst n default))
+         (nfix n)))
+
+(defthm resize-list-of-len-free
+  (implies (equal (nfix n) (len lst))
+           (equal (resize-list lst n default-value)
+                  (list-fix lst))))
+
+(defthm equal-of-resize-list-and-self
+  (equal (equal (resize-list lst n default-value) lst)
+         (and (true-listp lst)
+              (equal (len lst) (nfix n)))))
+
diff -Nru acl2-6.2/books/std/lists/rev.lisp acl2-6.3/books/std/lists/rev.lisp
--- acl2-6.2/books/std/lists/rev.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/rev.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -15,10 +15,9 @@
 ; This file was originally part of the Unicode library.
 
 (in-package "ACL2")
-(include-book "revappend")
-(include-book "reverse")
-(include-book "append")
-(local (include-book "make-character-list"))
+(include-book "list-fix")
+(local (include-book "revappend"))
+(local (include-book "append"))
 
 (defun revappend-without-guard (x y)
   (declare (xargs :guard t))
@@ -32,6 +31,20 @@
   :parents (std/lists reverse)
   :short "Logically simple alternative to @(see reverse) for lists."
 
+  :long "<p>This function is nicer to reason about than ACL2's built-in @(see
+reverse) function because it is more limited:</p>
+
+<ul>
+<li>@('reverse') can operate on strings or lists, whereas @('rev') can only
+    operate on lists.</li>
+
+<li>@('reverse') has a tail-recursive definition, which makes it generally
+    more difficult to induct over than the non tail-recursive @('rev').</li>
+</ul>
+
+<p>Despite its simple @(see append)-based logical definition, @('rev') should
+perform quite well thanks to @(see mbe).</p>"
+
   (defund rev (x)
     (declare (xargs :verify-guards nil
                     :guard t))
@@ -96,13 +109,6 @@
     (equal (rev (append x y))
            (append (rev y) (rev x))))
 
-  (defthm character-listp-of-rev
-    ;; BOZO what is this doing here?
-    (equal (character-listp (rev x))
-           (character-listp (list-fix x)))
-    :hints(("Goal" :induct (len x))))
-
-
   (encapsulate
     ()
     (local (defun cdr-cdr-induction (x y)
@@ -130,14 +136,20 @@
              (equal (list-fix x) (list-fix y)))
       :hints(("Goal" :induct (cdr-cdr-induction x y)))))
 
-
-
-  (defthm make-character-list-of-rev
-    ;; blah, probably belongs in make-character-list.lisp instead, but put it
-    ;; here to avoid circular dependency problems
-    (equal (make-character-list (rev x))
-           (rev (make-character-list x)))
-    :hints(("Goal" :in-theory (enable make-character-list)))))
-
+  (encapsulate
+    ()
+    (local (defthm make-character-list-of-append
+             ;; Reprove this to avoid including make-character-list
+             (equal (make-character-list (append x y))
+                    (append (make-character-list x)
+                            (make-character-list y)))))
+
+    (defthm make-character-list-of-rev
+      ;; This arguably doesn't belong here, but maybe it makes more sense here
+      ;; than in str/make-character-list, since this way we don't have to include
+      ;; rev just to get lemmas about make-character-list.
+      (equal (make-character-list (rev x))
+             (rev (make-character-list x)))
+      :hints(("Goal" :in-theory (enable make-character-list))))))
 
 
diff -Nru acl2-6.2/books/std/lists/revappend.lisp acl2-6.3/books/std/lists/revappend.lisp
--- acl2-6.2/books/std/lists/revappend.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/revappend.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -54,11 +54,9 @@
 
   (defthm nth-of-revappend
     (equal (nth n (revappend x y))
-           (if (<= (len x) (nfix n))
-               (nth (- (nfix n) (len x))
-                    y)
-             (nth (+ (1- (len x)) (- (nfix n)))
-                  x))))
+           (if (< (nfix n) (len x))
+               (nth (- (len x) (+ 1 (nfix n))) x)
+             (nth (- n (len x)) y))))
 
   (defthm equal-when-revappend-same
     (equal (equal (revappend x y1)
diff -Nru acl2-6.2/books/std/lists/reverse.lisp acl2-6.3/books/std/lists/reverse.lisp
--- acl2-6.2/books/std/lists/reverse.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/reverse.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -15,9 +15,9 @@
 ; This file was originally part of the Unicode library.
 
 (in-package "ACL2")
-(include-book "xdoc/top" :dir :system)
+(include-book "list-fix")
 (local (include-book "revappend"))
-(local (include-book "coerce"))
+(local (include-book "str/coerce" :dir :system))
 
 (defsection std/lists/reverse
   :parents (std/lists reverse)
@@ -43,15 +43,83 @@
     (equal (true-listp (reverse x))
            (not (stringp x))))
 
-  (defthm equal-of-reverses-when-strings
-    (implies (and (stringp x)
-                  (stringp y))
-             (equal (equal (reverse x) (reverse y))
-                    (equal x y))))
-
-  (defthm equal-of-reverses-when-lists
-    (implies (and (true-listp x)
-                  (true-listp y))
-             (equal (equal (reverse x) (reverse y))
-                    (equal x y)))))
+  ;; ACL2's built-in type-prescription rule is weaker than it should be:
+  ;;
+  ;; (OR (CONSP (REVERSE X))
+  ;;     (EQUAL (REVERSE X) NIL)
+  ;;     (STRINGP (REVERSE X)))
+  ;;
+  ;; So let's install a better one...
+
+  (in-theory (disable (:type-prescription reverse)))
+
+  (defthm reverse-type
+    (or (stringp (reverse x))
+        (true-listp (reverse x)))
+    :rule-classes :type-prescription)
+
+  (local (defthm len-zero
+           (equal (equal 0 (len x))
+                  (atom x))))
+
+  (local
+   (defsection revappend-lemma
+
+     (local (defun ind (a b x y)
+              (if (or (atom a)
+                      (atom b))
+                  (list a b x y)
+                (ind (cdr a) (cdr b)
+                     (cons (car a) x)
+                     (cons (car b) y)))))
+
+     (local (defthm l0
+              (implies (and (equal (len a) (len b))
+                            (equal (len x) (len y)))
+                       (equal (equal (revappend a x)
+                                     (revappend b y))
+                              (and (equal (list-fix a) (list-fix b))
+                                   (equal x y))))
+              :hints(("Goal" :induct (ind a b x y)))))
+
+     (local (defthm l1
+              (implies (and (not (equal (len a) (len b)))
+                            (equal (len x) (len y)))
+                       (equal (equal (revappend a x)
+                                     (revappend b y))
+                              nil))
+              :hints(("Goal"
+                      :in-theory (disable len-of-revappend)
+                      :use ((:instance len-of-revappend (x a) (y x))
+                            (:instance len-of-revappend (x b) (y y)))))))
+
+     (local (defthm l2
+              (implies (not (equal (len a) (len b)))
+                       (not (equal (list-fix a) (list-fix b))))
+              :hints(("Goal"
+                      :in-theory (disable len-of-list-fix)
+                      :use ((:instance len-of-list-fix (x a))
+                            (:instance len-of-list-fix (x b)))))))
+
+     (defthm revappend-lemma
+       (implies (equal (len x) (len y))
+                (equal (equal (revappend a x)
+                              (revappend b y))
+                       (and (equal (list-fix a) (list-fix b))
+                            (equal x y))))
+       :hints(("Goal"
+               :in-theory (disable l0 l1)
+               :use ((:instance l0)
+                     (:instance l1)))))))
+
+  (defthm equal-of-reverses
+    ;; And this is why we should never use "reverse."
+    (equal (equal (reverse x) (reverse y))
+           (if (or (stringp x) (stringp y))
+               (and (stringp x)
+                    (stringp y)
+                    (equal x y))
+             (equal (list-fix x) (list-fix y))))
+    :hints(("Goal" :cases ((stringp x)
+                           (stringp y))))))
 
diff -Nru acl2-6.2/books/std/lists/sets.lisp acl2-6.3/books/std/lists/sets.lisp
--- acl2-6.2/books/std/lists/sets.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/sets.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -23,6 +23,7 @@
 (include-book "equiv")
 (include-book "mfc-utils")
 (include-book "rev")
+(include-book "rcons")
 (include-book "flatten")
 
 (local (defthm equal-of-booleans-to-iff
@@ -132,7 +133,7 @@
                (subsetp x y)
              nil)))
 
-  (defthmd subsetp-member
+  (defthm subsetp-member
     (implies (and (member a x)
                   (subsetp x y))
              (member a y))
@@ -229,7 +230,7 @@
              (subsetp x z))
     :hints(("Goal" :in-theory (enable subsetp-member))))
 
-  (defthmd subsetp-trans2
+  (defthm subsetp-trans2
     (implies (and (subsetp y z)
                   (subsetp x y))
              (subsetp x z))
@@ -571,7 +572,7 @@
   (implies (subsetp x y)
            (subsetp (remove a x) y)))
 
-(defcong set-equiv set-equiv (remove k a) 2
+(defcong set-equiv set-equiv (remove a x) 2
   :hints(("Goal" :in-theory (enable set-equiv))))
 
 (defthm rev-under-set-equiv
@@ -607,3 +608,9 @@
   (defcong set-equiv set-equiv (flatten x) 1
     :hints(("Goal" :in-theory (enable set-equiv)))))
 
+
+(defthm rcons-under-set-equiv
+  (set-equiv (rcons a x)
+             (cons a x))
+  :hints(("Goal" :in-theory (enable rcons))))
+
diff -Nru acl2-6.2/books/std/lists/sublistp.lisp acl2-6.3/books/std/lists/sublistp.lisp
--- acl2-6.2/books/std/lists/sublistp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/sublistp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -94,12 +94,12 @@
 
 
 (defsection listpos
-  :parents (std/lists)
+  :parents (std/lists position)
   :short "@(call listpos) returns the starting position of the first occurrence
 of the sublist @('x') within the list @('y'), or @('NIL') if there is no such
 occurrence."
 
-  :long "<p>This is strongly related to @(see sublistp).</p>"
+  :long "<p>See also @(see sublistp), which is closely related.</p>"
 
   (defund listpos (x y)
     (declare (xargs :guard t))
diff -Nru acl2-6.2/books/std/lists/take.lisp acl2-6.3/books/std/lists/take.lisp
--- acl2-6.2/books/std/lists/take.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/take.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -144,12 +144,16 @@
     (implies (<= (nfix n) (len x))
              (subsetp (take n x) x)))
 
-  (defthm take-of-take
-    (implies (< (nfix a) (nfix b))
+  (defthm take-fewer-of-take-more
+    ;; Note: see also repeat.lisp for related cases and a stronger rule that
+    ;; case-splits.
+    (implies (<= (nfix a) (nfix b))
              (equal (take a (take b x))
                     (take a x))))
 
   (defthm take-of-take-same
+    ;; Note: see also repeat.lisp for related cases and a stronger rule that
+    ;; case-splits.
     (equal (take a (take a x))
            (take a x))))
 
@@ -159,6 +163,10 @@
   :short "@(call first-n) is logically identical to @('(take n x)'), but its
 guard does not require @('(true-listp x)')."
 
+  :long "<p><b>Reasoning Note.</b> We leave @('first-n') enabled, so it will
+just get rewritten into @('take').  You should typically never write a theorem
+about @('first-n'): write theorems about @('take') instead.</p>"
+
   (local (defun repeat (x n)
            (if (zp n)
                nil
diff -Nru acl2-6.2/books/std/lists/top.lisp acl2-6.3/books/std/lists/top.lisp
--- acl2-6.2/books/std/lists/top.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/lists/top.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -27,19 +27,23 @@
 ; theory alone.
 
 (include-book "append")
-(include-book "coerce")
 (include-book "duplicity")
 (include-book "equiv")
 (include-book "final-cdr")
 (include-book "flatten")
+(include-book "intersection")
+(include-book "index-of")
+(include-book "last")
 (include-book "len")
 (include-book "list-fix")
-(include-book "make-character-list")
 (include-book "mfc-utils")
 (include-book "no-duplicatesp")
+(include-book "nth")
 (include-book "nthcdr")
 (include-book "prefixp")
+(include-book "remove")
 (include-book "repeat")
+(include-book "resize-list")
 (include-book "revappend")
 (include-book "reverse")
 (include-book "rev")
@@ -47,8 +51,13 @@
 (include-book "sublistp")
 (include-book "subseq")
 (include-book "take")
+(include-book "true-listp")
 (include-book "list-defuns")
 
+; BOZO it might be best to move these disables into the corresponding
+; books, to make things more consistent when you load the individual
+; books versus the whole library.
+
 (in-theory (disable ;; I often use len as a way to induct, so I only disable
                     ;; its definition.
                     (:definition len)
@@ -60,37 +69,57 @@
                     take-redefinition
                     nthcdr
                     subseq-list
+                    resize-list
+                    last
+                    butlast
+                    remove
+                    ;; It seems like disabling these is hard to do in general, so
+                    ;; I'll leave nth and update-nth enabled.
+                    ;; nth
+                    ;; update-nth
+                    member
                     subsetp
                     intersectp
-                    ;; BOZO eventually disable member and other functions
+                    union-equal
+                    set-difference-equal
+                    intersection-equal
                     ))
 
 
 (defsection std/lists
   :parents (std)
-  :short "A library for reasoning about basic list operations like @('append'),
-@('len'), @('member'), @('take'), etc."
+  :short "A library for reasoning about basic list operations like @(see
+append), @(see len), @(see member), @(see take), etc."
+
+  :long "<h3>Introduction</h3>
+
+<p>The @('std/lists') library provides lemmas that are useful when reasoning
+about the basic list functions that are built into ACL2, and also defines some
+additional functions like @(see list-fix), @(see rev), @(see set-equiv), and so
+on.</p>
+
+<p>The @('std/lists') library is based largely on books that were previously
+part of the @('unicode') library, but also incorporates ideas from earlier
+books such as @('data-structures/list-defthms') and
+@('data-structures/number-list-defthms') and also from @('coi/lists').</p>
 
-  :long "<p>The @('std/lists') library provides lemmas that are useful when
-reasoning about the basic list functions that are built into ACL2, and also
-defines many additional functions like @(see list-fix), @(see rev), @(see
-set-equiv), and so on.</p>
+
+<h3>Loading the Library</h3>
 
 <p>The recommended way to load the library, especially for beginning to
-intermediate users, is to simply include the @('top') book, e.g.,</p>
+intermediate ACL2 users, is to simply include the @('top') book, e.g.,</p>
 
 @({ (include-book \"std/lists/top\" :dir :system) })
 
-<p>The top book loads quickly (typically under a second), gives you everything
-we have to offer, and sets up a \"recommended\" theory.  This theory differs
-from the default ACL2 theory in some notable ways, e.g., it @(see disable)s
-some basic, built-in ACL2 list functions like @('append') and @('len').</p>
+<p>This book loads quickly (typically in under a second), gives you everything
+we have to offer, and sets up a \"recommended\" theory.  See below for some
+general comments about this theory.</p>
 
-<p>Even for advanced users, we recommend using the @('top') book if possible.
+<p>For advanced users, we recommend using the @('top') book if possible.
 However, in case you find this book to be too heavy or too incompatible with
-your existing developments, the library is arranged in a \"buffet\" style that
-is meant to allow you to load as little or as much as you like.  A useful
-starting point is</p>
+your existing developments, the library is mostly arranged in a \"buffet\"
+style that is meant to allow you to load as little or as much as you like.  A
+particularly useful book is</p>
 
 @({ (include-book \"std/lists/list-defuns\" :dir :system) })
 
@@ -107,12 +136,43 @@
 })
 
 <p>The best way to see what books are available is to just run @('ls') in the
-@('std/lists') directory.  In most cases, these individual books are meant to
-be reasonably unobtrusive, e.g., loading the @('append') book will not disable
-@(see append).</p>")
-
-
-(defsection std
-  :short "Some \"standard\" libraries for ACL2.")
+@('std/lists') directory.  Unlike the top book, most individual books are meant
+to be reasonably unobtrusive, e.g., loading the @('append') book will not
+disable @(see append).</p>
+
+
+<h3>Things to Note</h3>
+
+<p>When you include the @('top') book, note that many basic, built-in ACL2 list
+functions like @('append') and @('len') will be @(see disable)d.  As a result,
+ACL2 will sometimes not automatically try to induct as it did before.  You may
+find that you need to give explicit @(':induct') @(see hints), or explicitly
+re-@(see enable) these basic functions during certain theorems.  (On the flip
+side, you may also find that you are spending less time trying to prove
+theorems using incorrect induction schemes.)</p>
+
+<p>The library introduces a couple of useful @(see equivalence) relations,
+namely:</p>
+
+<dl>
+<dt>@(see list-equiv)</dt>
+<dd>Equivalences of lists based on @(see list-fix).</dd>
+<dd>Respected in some way by most list-processing functions.</dd>
+</dl>
+
+<dl>
+<dt>@(see set-equiv)</dt>
+<dd>Equivalence of lists up to @(see member)ship, but ignoring order and @(see
+duplicity).</dd>
+<dd>@('list-equiv') is a @(see refinement) of @('set-equiv').</dd>
+<dd>Respected in a strong way by most \"lists as sets\" functions, e.g., @(see
+subsetp), @(see union$), etc.</dd>
+<dd>Preserved by many other ordinary list functions like @(see append), @(see
+rev), etc.</dd>
+</dl>
+
+<p>These rules allow for some very powerful equivalence-based reasoning.  When
+introducing new list-processing functions, it is generally a good idea to
+define the appropriate @(see congruence) rules for these relations.</p>")
 
 
diff -Nru acl2-6.2/books/std/lists/true-listp.lisp acl2-6.3/books/std/lists/true-listp.lisp
--- acl2-6.2/books/std/lists/true-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/lists/true-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,52 @@
+; True-Listp Lemmas
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "std/lists/list-defuns" :dir :system)
+(in-theory (disable true-listp))
+
+(defsection std/lists/true-listp
+  :parents (std/lists true-listp)
+  :short "Lemmas about @(see true-listp) available in the @(see std/lists)
+library."
+
+  :long "<p>Note: the list of lemmas below is quite incomplete.  For instance,
+the @(see true-listp) rule about @(see append) will be found in the
+documentation for @(see std/lists/append), instead of here.</p>"
+
+  (local (in-theory (enable true-listp)))
+
+  (defthm true-listp-when-atom
+    (implies (atom x)
+             (equal (true-listp x)
+                    (not x))))
+
+  (defthm true-listp-of-cons
+    (equal (true-listp (cons a x))
+           (true-listp x)))
+
+  (defthm consp-under-iff-when-true-listp
+    ;; BOZO even with the backchain limit, this rule can get too expensive.
+    (implies (true-listp x)
+             (iff (consp x)
+                  x))
+    :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+
diff -Nru acl2-6.2/books/std/misc/base10-digit-charp.lisp acl2-6.3/books/std/misc/base10-digit-charp.lisp
--- acl2-6.2/books/std/misc/base10-digit-charp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/misc/base10-digit-charp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,80 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-(defund base10-digit-charp (x)
-  (declare (xargs :guard t))
-  (if (member x '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
-      t
-    nil))
-
-(defthm characterp-when-base10-digit-charp
-  (implies (base10-digit-charp x)
-           (characterp x))
-  :hints(("Goal" :in-theory (enable base10-digit-charp))))
-
-
-(defund base10-digit-char-listp (x)
-  (declare (xargs :guard t))
-  (if (consp x)
-      (and (base10-digit-charp (car x))
-           (base10-digit-char-listp (cdr x)))
-    (eq x nil)))
-
-(defthm base10-digit-char-listp-when-not-consp
-  (implies (not (consp x))
-           (equal (base10-digit-char-listp x)
-                  (not x)))
-  :hints(("Goal" :in-theory (enable base10-digit-char-listp))))
-
-(defthm base10-digit-char-listp-of-cons
-  (equal (base10-digit-char-listp (cons a x))
-         (and (base10-digit-charp a)
-              (base10-digit-char-listp x)))
-  :hints(("Goal" :in-theory (enable base10-digit-char-listp))))
-
-(defthm character-listp-when-base10-digit-char-listp
-  (implies (base10-digit-char-listp x)
-           (character-listp x))
-  :hints(("Goal" :induct (len x))))
-
-(defthm base10-digit-char-listp-of-revappend
-  (implies (and (base10-digit-char-listp x)
-                (base10-digit-char-listp acc))
-           (base10-digit-char-listp (revappend x acc))))
-
-
-
-(in-theory (disable digit-to-char))
-
-(defthm base10-digit-charp-of-digit-to-char
-  (implies (and (natp n)
-                (< n 10))
-           (base10-digit-charp (digit-to-char n)))
-  :hints(("Goal" :in-theory (enable digit-to-char
-                                    base10-digit-charp))))
-
-(defthm equal-of-digit-to-chars
-  (implies (and (natp i) (< i 16)
-                (natp j) (< j 16))
-           (equal (equal (digit-to-char i)
-                         (digit-to-char j))
-                  (equal i j)))
-  :hints(("Goal" :in-theory (enable digit-to-char))))
-
-
diff -Nru acl2-6.2/books/std/misc/explode-atom.lisp acl2-6.3/books/std/misc/explode-atom.lisp
--- acl2-6.2/books/std/misc/explode-atom.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/misc/explode-atom.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,60 +1,3 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
 (in-package "ACL2")
-(include-book "base10-digit-charp")
-(local (include-book "std/lists/append" :dir :system))
-(local (include-book "explode-nonnegative-integer"))
-
-(defthm true-listp-of-explode-atom
-  (true-listp (explode-atom x base))
-  :rule-classes :type-prescription)
-
-(defthm consp-of-explode-atom-when-integerp
-  (implies (integerp n)
-           (consp (explode-atom n base)))
-  :rule-classes :type-prescription)
-
-(defthm equal-of-explode-atoms-when-natps
-  (implies (and (natp n)
-                (natp m)
-                (force (print-base-p base)))
-           (equal (equal (explode-atom n base)
-                         (explode-atom m base))
-                  (equal n m))))
-
-(defthm nonzeroness-of-explode-atom-when-not-zp
-  (implies (and (not (zp n))
-                (force (print-base-p base)))
-           (not (equal (explode-atom n base) '(#\0)))))
-
-(defthm base10-digit-char-listp-of-explode-atom
-  (implies (natp n)
-           (base10-digit-char-listp (explode-atom n 10))))
-
-(defthm character-listp-of-explode-atom
-  (implies (force (print-base-p base))
-           (character-listp (explode-atom x base)))
-  :rule-classes ((:rewrite)
-                 (:rewrite :corollary (character-listp (explode-atom x 2)))
-                 (:rewrite :corollary (character-listp (explode-atom x 8)))
-                 (:rewrite :corollary (character-listp (explode-atom x 10)))
-                 (:rewrite :corollary (character-listp (explode-atom x 16))))
-  :hints(("Goal" :in-theory (disable explode-nonnegative-integer))))
-
-
-
+; cert_param: (reloc_stub)
+(include-book "str/explode-atom" :dir :system)
diff -Nru acl2-6.2/books/std/misc/explode-nonnegative-integer.lisp acl2-6.3/books/std/misc/explode-nonnegative-integer.lisp
--- acl2-6.2/books/std/misc/explode-nonnegative-integer.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/misc/explode-nonnegative-integer.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,312 +1,3 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
 (in-package "ACL2")
-
-(local (include-book "ihs/quotient-remainder-lemmas" :dir :system))
-(local (include-book "std/lists/revappend" :dir :system))
-(include-book "base10-digit-charp")
-
-
-;; These were disabled here when this book was using arithmetic-3 rather than ihs.
-;; (local (deftheory slow-arith-rules
-;;          '(not-integerp-1b
-;;            not-integerp-2b
-;;            not-integerp-3b
-;;            not-integerp-4b
-;;            not-integerp-1a
-;;            not-integerp-2a
-;;            not-integerp-3a
-;;            not-integerp-4a
-;;            floor-zero
-;;            floor-negative
-;;            floor-positive
-;;            floor-nonpositive-1
-;;            floor-nonpositive-2
-;;            floor-nonnegative-1
-;;            floor-nonnegative-2
-;;            mod-zero
-;;            mod-positive
-;;            mod-negative
-;;            mod-nonnegative
-;;            mod-nonpositive
-;;            rationalp-mod)))
-
-;; (local (in-theory (disable slow-arith-rules)))
-
-;; Explode-nonnegative-integer is a particularly nasty function to try to
-;; reason about because it is tail recursive and has a very nasty base case.
-;; Instead of reasoning about it directly, we will split it up into the
-;; following, simpler definition.
-
-(local (in-theory (disable floor mod)))
-
-(local (defun simpler-explode-nonnegative-integer (n base ans)
-         (declare (xargs :guard (and (integerp n)
-                                     (<= 0 n)
-                                     (print-base-p base))))
-         (if (or (zp n)
-                 (not (print-base-p base)))
-             ans
-           (simpler-explode-nonnegative-integer
-            (floor n base)
-            base
-            (cons (digit-to-char (mod n base)) ans)))))
-
-
-;; We can now redefine explode-nonnegative-integer to be a simple nonrecursive
-;; function that uses our simpler-explode-nonnegative-integer as its core, but
-;; wraps it in a simple "or" statement.  We will then disable the previous
-;; definition of explode-nonnegative-integer, so that only our new definition
-;; will be used.
-
-(local (defthm explode-nonnegative-integer-redefinition
-         (equal (explode-nonnegative-integer n base ans)
-                (or (simpler-explode-nonnegative-integer n base ans)
-                    '(#\0)))
-         :rule-classes ((:definition :install-body nil))))
-
-(local (in-theory (disable (:definition explode-nonnegative-integer))))
-
-
-
-;; Sadly, even simpler-explode-nonnegative-integer is hard to reason about as
-;; it is tail recursive.  So, we will introduce a non tail-recursive function
-;; in its place that does almost the same thing.  We'll call this the "basic
-;; explode-nonnegative-integer core", or the basic-eni-core for short.
-
-(local (defun basic-eni-core (n base)
-         (declare (xargs :guard (and (natp n)
-                                     (print-base-p base))))
-         (if (or (zp n)
-                 (not (print-base-p base)))
-             nil
-           (cons (digit-to-char (mod n base))
-                 (basic-eni-core (floor n base) base)))))
-
-(local (defun basic-eni-induction (n m base)
-         (declare (xargs :guard (and (natp n)
-                                     (natp m)
-                                     (print-base-p base))))
-         (if (zp n)
-             nil
-           (if (zp m)
-               nil
-             (if (not (print-base-p base))
-                 nil
-               (basic-eni-induction (floor n base) (floor m base) base))))))
-
-(local (defthm basic-eni-core-under-iff
-         (iff (basic-eni-core n base)
-              (and (not (zp n))
-                   (print-base-p base)))))
-
-(local (defthm consp-of-basic-eni-core
-         (equal (consp (basic-eni-core n base))
-                (and (not (zp n))
-                     (if (print-base-p base)
-                         t
-                       nil)))
-         :hints(("Goal" :expand (basic-eni-core n base)))))
-
-(local (defthm equal-of-basic-eni-cores
-         (implies (force (print-base-p base))
-                  (equal (equal (basic-eni-core n base)
-                                (basic-eni-core m base))
-                         (equal (nfix n)
-                                (nfix m))))
-         :hints(("Goal"
-                 :in-theory (disable basic-eni-core)
-                 :induct (basic-eni-induction n m base)
-                 :expand ((:free (base) (basic-eni-core n base))
-                          (:free (base) (basic-eni-core m base)))
-                 :do-not '(generalize fertilize)))))
-
-(local (defthm equal-of-basic-eni-core-with-list-zero
-         (not (equal (basic-eni-core n base) '(#\0)))
-         :hints(("Goal" :in-theory (enable digit-to-char)))))
-
-(local (defthm basic/simpler-equivalence
-         (equal (simpler-explode-nonnegative-integer n base acc)
-                (revappend (basic-eni-core n base) acc))))
-
-(local (defthm equal-of-simpler-explode-nonnegative-integers
-         (implies (force (print-base-p base))
-                  (equal (equal (simpler-explode-nonnegative-integer n base acc)
-                                (simpler-explode-nonnegative-integer m base acc))
-                         (equal (nfix n) (nfix m))))))
-
-(local (defthm simpler-eni-when-nonzero
-         (implies (and (not (zp n))
-                       (print-base-p base))
-                  (simpler-explode-nonnegative-integer n base acc))))
-
-(local (defthm simpler-eni-degenerate-lemma
-         (equal (equal (simpler-explode-nonnegative-integer n base acc) '(#\0))
-                (and (equal acc '(#\0))
-                     (or (zp n)
-                         (not (print-base-p base)))))
-         :hints(("Goal"
-                 :induct (simpler-explode-nonnegative-integer n base acc)
-                 :expand ((:free (base) (basic-eni-core n base)))
-                 :in-theory (e/d (digit-to-char)
-                                 (basic-eni-core))))))
-
-(local (defthm not-of-simpler-explode-nonnegative-integer
-         (equal (not (simpler-explode-nonnegative-integer n base acc))
-                (and (equal acc nil)
-                     (or (zp n)
-                         (not (print-base-p base)))))))
-
-(local (defthm true-listp-of-simpler-explode-nonnegative-integer
-         (equal (true-listp (simpler-explode-nonnegative-integer n base acc))
-                (true-listp acc))))
-
-(local (defthm equal-of-explode-nonnegative-integers-lemma
-         (implies (and (integerp n) (<= 0 n)
-                       (integerp m) (<= 0 m)
-                       (not (equal n m))
-                       (not (simpler-explode-nonnegative-integer n base acc))
-                       (force (print-base-p base)))
-                  (simpler-explode-nonnegative-integer m base acc))))
-
-(defthm equal-of-explode-nonnegative-integers
-  (implies (and (natp n)
-                (natp m)
-                (force (print-base-p base)))
-           (equal (equal (explode-nonnegative-integer n base acc)
-                         (explode-nonnegative-integer m base acc))
-                  (equal n m)))
-  :hints(("Goal" :in-theory (disable simpler-explode-nonnegative-integer
-                                     basic/simpler-equivalence))))
-
-(defthm true-listp-of-explode-nonnegative-integer
-  (equal (true-listp (explode-nonnegative-integer n base acc))
-         (true-listp acc)))
-
-(defthm true-listp-of-explode-nonnegative-integer-type
-  (implies (true-listp acc)
-           (true-listp (explode-nonnegative-integer n base acc)))
-  :rule-classes :type-prescription)
-
-(defthm character-listp-of-explode-nonnegative-integer
-  (equal (character-listp (explode-nonnegative-integer n base acc))
-         (character-listp acc)))
-
-(local (defthm base10-digit-char-listp-of-basic-eni-core
-         (base10-digit-char-listp (basic-eni-core n 10))
-         :hints(("Goal" :in-theory (enable base10-digit-char-listp)))))
-
-(local (defthm base10-digit-char-listp-of-simpler-eni
-         (implies (base10-digit-char-listp acc)
-                  (base10-digit-char-listp
-                   (simpler-explode-nonnegative-integer n 10 acc)))))
-
-(defthm base10-digit-char-listp-of-explode-nonnegative-integer
-  (implies (base10-digit-char-listp acc)
-           (base10-digit-char-listp (explode-nonnegative-integer n 10 acc))))
-
-
-(encapsulate
-  ()
-  (local (defthm lemma
-           (equal (equal (revappend x acc) '(#\0))
-                  (or (and (equal acc nil)
-                           (consp x)
-                           (equal (car x) #\0)
-                           (atom (cdr x)))
-                      (and (equal acc '(#\0))
-                           (atom x))))))
-
-  (local (defthm lemma2
-           (implies (and (not (zp n))
-                         (print-base-p base))
-                    (consp (basic-eni-core n base)))))
-
-
-  (defthm nonzeroness-of-explode-nonnegative-integer-when-nonzero
-    (implies (and (not (zp n))
-                  (force (print-base-p base)))
-             (not (equal (explode-nonnegative-integer n base nil)
-                         '(#\0))))
-    :hints(("Goal"
-            :in-theory (e/d (digit-to-char)
-                            (basic-eni-core))
-            :expand ((:free (base) (basic-eni-core n base)))))))
-
-
-
-(defund base10-digit-char-to-nat (x)
-  (declare (xargs :guard (base10-digit-charp x)))
-  (case x
-    (#\0 0)
-    (#\1 1)
-    (#\2 2)
-    (#\3 3)
-    (#\4 4)
-    (#\5 5)
-    (#\6 6)
-    (#\7 7)
-    (#\8 8)
-    (otherwise 9)))
-
-(defthm base10-digit-char-to-nat-of-digit-to-char
-  (implies (and (force (natp n))
-                (force (<= 0 n))
-                (force (<= n 9)))
-           (equal (base10-digit-char-to-nat (digit-to-char n))
-                  n))
-  :hints(("Goal" :in-theory (enable base10-digit-char-to-nat
-                                    digit-to-char))))
-
-(defthm digit-to-char-of-base10-digit-char-to-nat
-  (implies (force (base10-digit-charp x))
-           (equal (digit-to-char (base10-digit-char-to-nat x))
-                  x))
-  :hints(("Goal" :in-theory (enable base10-digit-charp
-                                    base10-digit-char-to-nat
-                                    digit-to-char))))
-
-(defund basic-unexplode-core (x)
-  (declare (xargs :guard (base10-digit-char-listp x)))
-  (if (consp x)
-      (+ (base10-digit-char-to-nat (car x))
-         (* 10 (basic-unexplode-core (cdr x))))
-    0))
-
-(local (defthm basic-unexplode-core-of-basic-eni-core
-         (implies (force (natp n))
-                  (equal (basic-unexplode-core (basic-eni-core n 10))
-                         n))
-         :hints(("Goal" :in-theory (enable basic-eni-core
-                                           basic-unexplode-core)))))
-
-(defund unexplode-nonnegative-integer (x)
-  (declare (xargs :guard (base10-digit-char-listp x)))
-  (basic-unexplode-core (revappend x nil)))
-
-(encapsulate
- ()
- (local (include-book "std/lists/rev" :dir :system))
-
- (defthm unexplode-nonnegative-integer-of-explode-nonnegative-integer
-   (implies (force (natp n))
-            (equal (unexplode-nonnegative-integer (explode-nonnegative-integer n 10 nil))
-                   n))
-   :hints(("Goal" :in-theory (e/d (unexplode-nonnegative-integer)
-                                  (basic-eni-core))))))
-
+; cert_param: (reloc_stub)
+(include-book "str/explode-nonnegative-integer" :dir :system)
diff -Nru acl2-6.2/books/std/misc/string-append.lisp acl2-6.3/books/std/misc/string-append.lisp
--- acl2-6.2/books/std/misc/string-append.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/misc/string-append.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-;; Processing Unicode Files with ACL2
-;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
-;;
-;; This program is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the Free
-;; Software Foundation; either version 2 of the License, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along with
-;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-;; Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(in-package "ACL2")
-
-(local (include-book "std/lists/append" :dir :system))
-(local (include-book "std/lists/coerce" :dir :system))
-
-(defthm equal-of-string-appends-one
-  (implies (and (stringp x)
-                (stringp y1)
-                (stringp y2))
-           (equal (equal (string-append x y1)
-                         (string-append x y2))
-                  (equal y1 y2))))
-
-(defthm equal-of-string-appends-two
-  (implies (and (stringp x1)
-                (stringp x2)
-                (stringp y))
-           (equal (equal (string-append x1 y)
-                         (string-append x2 y))
-                  (equal x1 x2))))
diff -Nru acl2-6.2/books/std/misc/top.lisp acl2-6.3/books/std/misc/top.lisp
--- acl2-6.2/books/std/misc/top.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/misc/top.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -14,9 +14,5 @@
 ; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
 
 (in-package "ACL2")
-(include-book "base10-digit-charp")
-(include-book "explode-atom")
-(include-book "explode-nonnegative-integer")
 (include-book "intern-in-package-of-symbol")
-(include-book "string-append")
 (include-book "two-nats-measure")
diff -Nru acl2-6.2/books/std/misc/two-nats-measure.lisp acl2-6.3/books/std/misc/two-nats-measure.lisp
--- acl2-6.2/books/std/misc/two-nats-measure.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/misc/two-nats-measure.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -21,7 +21,7 @@
 (include-book "xdoc/top" :dir :system)
 
 (defsection two-nats-measure
-  :parents (misc)
+  :parents (ordinals)
   :short "One of the simplest non-natural ordinal measures imaginable"
   :long "Two-nats-measure provides one of the simplest non-natural ordinal
    measures imaginable.  It is useful if one has a one count that is decreasing
diff -Nru acl2-6.2/books/std/osets/acl2-customization.lsp acl2-6.3/books/std/osets/acl2-customization.lsp
--- acl2-6.2/books/std/osets/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/acl2-customization.lsp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,20 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#!ACL2
+(in-package "ACL2")
+
+(ld "~/acl2-customization.lsp" :ld-missing-input-ok t)
+(ld "sets.defpkg")
+(include-book "portcullis")
+(in-package "SETS")
diff -Nru acl2-6.2/books/std/osets/cardinality.lisp acl2-6.3/books/std/osets/cardinality.lisp
--- acl2-6.2/books/std/osets/cardinality.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/cardinality.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,141 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "SETS")
+(include-book "delete")
+(set-verify-guards-eagerness 2)
+
+(defsection cardinality
+  :parents (osets)
+  :short "@(call cardinality) computes the number of elements in @('X')."
+
+  :long "<p>This is like @(see length), but respects the non-set convention and
+always returns 0 for ill-formed sets.</p>"
+
+  (defun cardinality (X)
+    (declare (xargs :guard (setp X)
+                    :verify-guards nil))
+    (mbe :logic (if (empty X)
+                    0
+                  (1+ (cardinality (tail X))))
+         :exec  (length (the list X))))
+
+  (verify-guards cardinality
+    ;; Normally we would never want to enable the primitives theory.  However,
+    ;; here we need to show that cardinality is equal to length, and for this
+    ;; we need to be able to reason about tail and empty.  Think of this as a
+    ;; tiny extension of "fast.lisp"
+    :hints(("Goal" :in-theory (enable (:ruleset primitive-rules)))))
+
+  (defthm cardinality-type
+    (and (integerp (cardinality X))
+         (<= 0 (cardinality X)))
+    :rule-classes :type-prescription)
+
+  (defthm cardinality-zero-empty
+    (equal (equal (cardinality x) 0)
+           (empty x)))
+
+  (defthm cardinality-sfix-cancel
+    (equal (cardinality (sfix X)) (cardinality X)))
+
+  (encapsulate ()
+
+    (local (defthm cardinality-insert-empty
+             (implies (empty X)
+                      (equal (cardinality (insert a X)) 1))
+             :hints(("Goal" :use (:instance cardinality (x (insert a nil)))))))
+
+    (defthm insert-cardinality
+      (equal (cardinality (insert a X))
+             (if (in a X)
+                 (cardinality X)
+               (1+ (cardinality X))))))
+
+  (defthm delete-cardinality
+    (equal (cardinality (delete a X))
+           (if (in a X)
+               (1- (cardinality X))
+             (cardinality X))))
+
+; Now that we have the delete function, we can prove an interesting
+; theorem, namely that if (subset X Y) and |X| = |Y|, then X = Y.  In
+; order to do this, we need to induct by deleting elements from both
+; X and Y.  This is a little ugly, but along the way we will show the
+; nice theorem, subset-cardinality.
+
+  (local (defun double-delete-induction (X Y)
+           (declare (xargs :guard (and (setp X) (setp Y))))
+           (if (or (empty X) (empty Y))
+               (list X Y)
+             (double-delete-induction (delete (head X) X)
+                                      (delete (head X) Y)))))
+
+  (local (defthmd subset-double-delete
+           (implies (subset X Y)
+                    (subset (delete a X) (delete a Y)))
+           :hints(("Goal" :in-theory (disable delete-nonmember-cancel
+                                              in-tail-or-head)))))
+
+  (encapsulate
+    ()
+    (local (defthm subset-cardinality-lemma
+             (implies (and (not (or (empty x) (empty y)))
+                           (implies (subset (delete (head x) x)
+                                            (delete (head x) y))
+                                    (<= (cardinality (delete (head x) x))
+                                        (cardinality (delete (head x) y)))))
+                      (implies (subset x y)
+                               (<= (cardinality x) (cardinality y))))
+             :hints(("goal" :use ((:instance subset-double-delete
+                                             (a (head x))
+                                             (x x)
+                                             (y y)))))))
+
+    (defthm subset-cardinality
+      (implies (subset X Y)
+               (<= (cardinality X) (cardinality Y)))
+      :hints(("Goal" :induct (double-delete-induction X Y)))
+      :rule-classes (:rewrite :linear)))
+
+  (defthmd equal-cardinality-subset-is-equality
+    (implies (and (setp X)
+                  (setp Y)
+                  (subset X Y)
+                  (equal (cardinality X) (cardinality Y)))
+             (equal (equal X Y) t))
+    :hints(("Goal" :induct (double-delete-induction X Y))
+           ("Subgoal *1/2"
+            :use ((:instance subset-double-delete
+                             (a (head X))
+                             (X X)
+                             (Y Y))
+                  (:instance (:theorem
+                              (implies (equal X Y)
+                                       (equal (insert a X) (insert a Y))))
+                             (a (head X))
+                             (X (tail X))
+                             (Y (delete (head X) Y)))))))
+
+  (defthm proper-subset-cardinality
+    (implies (and (subset X Y)
+                  (not (subset Y X)))
+             (< (cardinality X) (cardinality Y)))
+    :rule-classes (:rewrite :linear)
+    :hints(("Goal"
+            :in-theory (disable pick-a-point-subset-strategy)
+            :use ((:instance equal-cardinality-subset-is-equality
+                             (X (sfix x))
+                             (Y (sfix y))))))))
+
+
diff -Nru acl2-6.2/books/std/osets/cert.acl2 acl2-6.3/books/std/osets/cert.acl2
--- acl2-6.2/books/std/osets/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/cert.acl2	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,15 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(include-book "xdoc/portcullis" :dir :system)
+(include-book "portcullis")
diff -Nru acl2-6.2/books/std/osets/computed-hints.lisp acl2-6.3/books/std/osets/computed-hints.lisp
--- acl2-6.2/books/std/osets/computed-hints.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/computed-hints.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,405 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; computed-hints.lisp
+;
+; We provide support for the development of "pick a point" style proofs through
+; computed hints.
+
+
+(in-package "COMPUTED-HINTS")
+
+; Introduction
+;
+; Suppose we have some predicate, P, of any number of arguments.  A natural
+; operation is to extend this predicate to every element of a list, set, or
+; other collection.  In other words, we would like to know if every element in
+; the set, list, tree, or whatever has the property when applied to arguments.
+;
+; For example, we might have the predicate:
+;
+;  (defun integer-lessp (a b)
+;    (and (integerp a)
+;         (< a b)))
+;
+; We could now extend this concept to an entire list, to ask if every element
+; in the list was an integer that is less than b.  The function might be
+; written as:
+;
+;  (defun list-integer-lessp (a-list b)
+;    (declare (xargs :guard (true-listp a-list)))
+;    (or (endp a-list)
+;        (and (integer-lessp (car a-list) b)
+;             (list-integer-lessp (cdr a-list) b))))
+;
+; Similarly, we might want to map the function across sets or other types of
+; collections.
+;
+; Take an abstract mathematical view for a moment.  Given some predicate P,
+; what we would really like to do is be able to express the idea that given
+; some collection x, every element of x satisfies P.  In other words, we want
+; to define:
+;
+;  (collection-P x [args]) = forall a in x, (P x [args])
+;
+; And indeed, it would be nice to be working with this very abstract
+; mathematical definition, for which we will not need to make inductive
+; arguments.  Unfortunately, because all variables in ACL2's rewrite rules are
+; implicitly universally quantified, we cannot express the above as a rewrite
+; rule.
+;
+; However, through the use of constrained function symbols and functional
+; instantiation, we can effectively accomplish the above reduction when it
+; suits our purposes.  And, the process can be automated through the use of
+; computed hints.  Overall, this is not as nice as working with a pure rewrite
+; rule, and in fact has some unfortunate limitations.  However, it does turn
+; out to be very broadly applicable and invaluable for reasoning about set
+; theoretic concepts, where concepts such as "subset" are really nothing more
+; than the extension of the predicate "in" across a set.
+;
+; Moreover, the reduction that we set out to achieve will reduce (collection-P
+; x [args]) to the following implication:
+;
+;   (implies (in a x)
+;            (P a [args]))
+;
+; I call this a "pick a point" reduction, because it is similar to and takes
+; its inspiration from the well known set theoretic technique of picking an
+; arbitrary element (or point) in one set, then showing it is also a member of
+; another set.
+
+
+
+; Preliminaries
+;
+; We will make minor use of the rewriting system developed in instance.lisp.
+; We also enter program mode, because we are not interested in reasoning about
+; these functions.
+
+(include-book "instance")
+(program)
+
+
+; Tagging
+;
+; Suppose that we have (collection-P x a0 a1 ... an) to a simpler argument.  We
+; begin by defining a synonym for collection-P, e.g.,
+;
+; (defun collection-P-tag (x a0 a1 ... an)
+;   (collection-P x a0 a1 ... an))
+;
+; Now we instruct the theorem prover to rewrite instances of conclusion into
+; conclusion-tag, as long as we are not backchaining and as long as conclusion
+; occurs as the goal.  For example,
+;
+; (defthm tagging-theorem
+;   (implies
+;     (and (syntaxp (rewriting-goal-lit mfc state))
+;          (syntaxp (rewriting-conc-lit `(collection-P ,x ,a0 ... ,an)
+;                                       mfc state)))
+;            (equal (collection-P x a0 ... an)
+;                   (collection-P-tag x a0 ... an))))
+;
+; This theorem is trivial to prove, since collection-P-tag is merely a synonym
+; for collection-P.  After the theorem is proven, collection-P-tag should be
+; disabled.
+
+(defun rewriting-goal-lit (mfc state)
+  (declare (xargs :stobjs state)
+	   (ignore state))
+  (null (mfc-ancestors mfc)))
+
+(defun rewriting-conc-lit (term mfc state)
+  (declare (xargs :stobjs state)
+	   (ignore state))
+  (let ((clause (mfc-clause mfc)))
+    (member-equal term (last clause))))
+
+
+
+
+; Computing a Hint
+;
+; Now, what we are going to do next is create a computed hint that will look
+; for instances of a trigger, and if it sees one, we will try to provide a
+; functional instantiation hint.  This takes some work.  Our computed hint
+; function is called as ACL2 is working to simplify terms, and it is allowed to
+; examine the current clause.  The current clause will be a a disjunction of
+; literals.  For example,
+;
+;   (a ^ b ^ ...) => P  is  (~a v ~b v ... v P)
+;   (a v b v ...) => P  is  subgoal1: (~a v P), sg2: (~b v P), ...
+;
+; Our first step is to see if our computed hint should even be applied to this
+; clause.  We only allow the hint to be applied if the current clause is stable
+; under simplification, i.e., if other attempts to prove it have failed.  At
+; that point, we check the clause to see if our trigger occurs as a term within
+; it.  If so, the tagging theorem has applied and thinks we should try to use
+; our computed hint!
+;
+; We check for the existence of our trigger using the following function,
+; (harvest-trigger clause trigger-fn), which extracts all the terms from clause
+; whose function symbol is trigger-fn, and returns them as a list.
+;
+; Now, our intention is to functionally instantiate the theorem in question.
+; To do this, we need to provide values for the hypotheses and arguments a0
+; ... an.
+;
+; In order to recover the hypotheses, we first remove from the clause all of
+; our trigger terms.  We then negate each of the remaining literals as they
+; occur in the clause.  And, if there are more than one of them, we are going
+; to AND their negations together.  This is done by the functions
+; others-to-negated-list, and others-to-hyps.
+;
+; For example, if we originally had the conjecture (a ^ b ^ ...) => P Then this
+; became the clause: (~a v ~b v ... v P), which is represented by the list
+; ((not a) (not b) ... P).  Suppose that P was our trigger term.  We remove P
+; from the clause, yielding ((not a) (not b) ...), and then we negate all of
+; these literals, creating the list (a b ...).  We now and these together,
+; creating the the term (and a b ...), which was our original hypotheses!
+
+(defun harvest-trigger (clause trigger-fn)
+  (if (endp clause)
+      nil
+    (if (eq (caar clause) trigger-fn)
+        (cons (car clause) (harvest-trigger (cdr clause) trigger-fn))
+      (harvest-trigger (cdr clause) trigger-fn))))
+
+(defun others-to-negated-list (others)
+  (if (endp others)
+      nil
+    (if (equal (caar others) 'not)  ; don't create ugly double not's
+        (cons (second (car others))
+              (others-to-negated-list (cdr others)))
+      (cons (list 'not (car others))
+            (others-to-negated-list (cdr others))))))
+
+(defun others-to-hyps (others)
+  (if (endp others)
+      t
+    (let ((negated (others-to-negated-list others)))
+      (if (endp (cdr negated))  ; don't wrap single literals in and's
+          (car negated)
+        (cons 'and (others-to-negated-list others))))))
+
+
+
+; Absolute Restrictions:
+;
+; Collection predicate must have a first argument which is the collection to
+; traverse!!
+;
+; Need to be able to create hint for predicate as well.
+
+
+
+; Building Hints
+;
+; Our ultimate goal now is to be able to create functional instantiation hints
+; for each trigger which was found.  In other words, we now have a set of
+; triggers which look like the following:
+;
+;  ((collection-P-tag col1 [extra-args1])
+;   (collection-P-tag col2 [extra-args2])
+;    ...)
+;
+; We want to instantiate generic theorems of the form:
+;
+;   (defthm generic-theorem
+;     (implies (hyps)
+;              (collection-P-tag (collection) [extra-args])))
+;
+; Where we have the following generic constraint:
+;
+;   (implies (hyps)
+;            (implies (in a (collection))
+;                     (predicate a)))
+;
+; So, the functional instantiation hints we want to create will look like the
+; following:
+;
+;  (:functional-instance generic-theorem
+;    (hyps         (lambda ()  [substitution for hyps]))
+;    (collection   (lambda ()  [substitution for collection]))
+;    (predicate    (lambda (x) [substitution for predicate]))
+;    (collection-P (lambda (x) [substitution for collection-P])))
+;
+; Lets consider how we can build these substitutions for some trigger =
+; (collection-P-tag col1 [extra-args1]).  Some of this is easy:
+;
+;   The substitution for hyps is actually built using the process described
+;   above, e.g., they are extracted from the clause and eventually restored to
+;   normal using others-to-hyps, so I will not spend any time on them.
+;
+;   The collection is simply (second trigger), since we require that the
+;   collection predicate has the collection as its first argument.
+;
+;   The substitution for collection-P is also fairly easy.  Since we require
+;   that the collection function's first argument is the collection under
+;   examination, we simply need to write (lambda (?x) (actual-collection-P ?x
+;   [extra-args])), where the extra arguments are taken from the trigger we are
+;   looking at.
+;
+;   This leaves us with predicate.  The substitution for predicate is
+;   difficult, because we want to support very flexible predicates involving
+;   many arguments and various weird terms.  To do this, we will allow the user
+;   to provide a rewrite rule that says how to handle the predicate.
+;
+;   In other words, given the trigger (trigger-term col a0 a1 a2 ... an) we
+;   will create the following "base predicate" to rewrite:
+;
+;     (predicate ?x a0 a1 a2 ... an)
+;
+;   Where "predicate" is literally the name of the generic predicate.  The user
+;   can then provide a substitution such as:
+;
+;     (predicate ?x ?y) -> (not (integer-lessp ?x ?y))
+;
+;   And this will transform the above into the desired result.
+
+
+(defun build-hint (trigger                ; list, the actual trigger to use
+		   generic-theorem        ; symbol, the name of generic-theorem
+		   generic-hyps           ; symbol, the name of (hyps)
+		   generic-collection     ; symbol, the name of (collection)
+		   generic-predicate      ; symbol, the name of predicate
+		   generic-collection-P   ; symbol, the name of collection-P
+		   collection-P-sub       ; symbol, name of actual collection-P
+		   hyps-sub               ; the computed substitution for hyps
+		   predicate-rewrite)     ; rewrite rule for predicate
+  (let* ((base-pred (cons generic-predicate (cons '?x (cddr trigger))))
+	 (pred-sub  (instance-rewrite base-pred predicate-rewrite)))
+    `(:functional-instance
+      ,generic-theorem
+      (,generic-hyps
+       (lambda () ,hyps-sub))
+      (,generic-collection
+       (lambda () ,(second trigger)))
+      (,generic-collection-P
+       (lambda (?x) ,(cons collection-P-sub (cons '?x (cddr trigger)))))
+      (,generic-predicate
+       (lambda (?x) ,pred-sub)))))
+
+(defun build-hints (triggers
+		    generic-theorem
+		    generic-hyps
+		    generic-collection
+		    generic-predicate
+		    generic-collection-P
+		    collection-P-sub
+		    hyps-sub
+		    predicate-rewrite)
+  (if (endp triggers)
+      nil
+    (cons (build-hint (car triggers)
+		      generic-theorem
+		      generic-hyps
+		      generic-collection
+		      generic-predicate
+		      generic-collection-P
+		      collection-P-sub
+		      hyps-sub
+		      predicate-rewrite)
+	  (build-hints (cdr triggers)
+		       generic-theorem
+		       generic-hyps
+		       generic-collection
+		       generic-predicate
+		       generic-collection-P
+		       collection-P-sub
+		       hyps-sub
+		       predicate-rewrite))))
+
+
+(defconst *message*
+ "~|~%We suspect this conjecture sould be proven by functional ~
+  instantiation of ~x0.  This suspicion is caused by ~x2, so ~
+  if this is not what you want to do, then you should disable ~
+  ~x2.  Accordingly, we suggest the following hint: ~
+  ~%~%~x1~%")
+
+
+
+; Of course, some of those hints can be computed.  Here we write a function to
+; actually provide these hints and install the computed hint function.
+
+(defun automate-instantiation-fn (new-hint-name
+				  generic-theorem
+				  generic-hyps
+				  generic-collection
+				  generic-predicate
+				  generic-collection-P
+				  collection-P-sub
+				  predicate-rewrite
+				  trigger-symbol
+				  tagging-theorem)
+  `(encapsulate ()
+
+     (defun ,new-hint-name (id clause world stable)
+       (declare (xargs :mode :program)
+	        (ignore world))
+       (if (not stable)
+	   nil
+	 (let ((triggers (harvest-trigger clause ,trigger-symbol)))
+	   (if (not triggers)
+	       nil
+	     (let* ((others   (set-difference-equal clause triggers))
+		    (hyps     (others-to-hyps others))
+		    (phrase   (string-for-tilde-@-clause-id-phrase id))
+		    (fi-hints (build-hints triggers
+					   ,generic-theorem
+					   ,generic-hyps
+					   ,generic-collection
+					   ,generic-predicate
+					   ,generic-collection-P
+					   ,collection-P-sub
+					   hyps
+					   ,predicate-rewrite))
+		    (hints    (list :use fi-hints
+				    :expand triggers)))
+	       (prog2$ (cw *message*
+			   ,generic-theorem
+			   (list phrase hints)
+			   ,tagging-theorem)
+		       hints))))))
+
+     (add-default-hints!
+      '((,new-hint-name id clause world stable-under-simplificationp)))
+
+     ))
+
+
+
+
+(defmacro automate-instantiation (&key new-hint-name
+				       generic-theorem
+                                       generic-hyps
+				       generic-collection
+				       generic-predicate
+				       generic-collection-predicate
+				       actual-collection-predicate
+				       predicate-rewrite
+				       actual-trigger
+				       tagging-theorem)
+  (automate-instantiation-fn new-hint-name
+			     (list 'quote generic-theorem)
+			     (list 'quote generic-hyps)
+			     (list 'quote generic-collection)
+			     (list 'quote generic-predicate)
+			     (list 'quote generic-collection-predicate)
+			     (list 'quote actual-collection-predicate)
+			     (list 'quote predicate-rewrite)
+			     (list 'quote actual-trigger)
+			     (list 'quote tagging-theorem)))
+
diff -Nru acl2-6.2/books/std/osets/delete.lisp acl2-6.3/books/std/osets/delete.lisp
--- acl2-6.2/books/std/osets/delete.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/delete.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,86 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "SETS")
+(include-book "membership")
+(set-verify-guards-eagerness 2)
+
+
+(defsection delete
+  :parents (osets)
+  :short "@(call delete) removes the element @('a') from the set @('X')."
+
+  :long "<p>If @('a') is not a member of @('X'), then the result is just @('X')
+itself.</p>
+
+<p>Efficiency note.  Delete is @('O(n)').  It is very inefficient to call it
+repeatedly.  Instead, consider removing multiple elements with @(see
+difference) or @(see intersect).</p>
+
+<p>The theorem @('delete-in') is the essential correctness property for
+@('delete').</p>"
+
+  (defun delete (a X)
+    (declare (xargs :guard (setp X)
+                    :verify-guards nil))
+    (mbe :logic
+         (cond ((empty X) nil)
+               ((equal a (head X)) (tail X))
+               (t (insert (head X) (delete a (tail X)))))
+         :exec
+         (cond ((endp X) nil)
+               ((equal a (car X)) (cdr X))
+               (t (insert (car X) (delete a (cdr X)))))))
+
+  (defthm delete-set
+    (setp (delete a X)))
+
+  (verify-guards delete
+    :hints(("Goal" :in-theory (enable (:ruleset primitive-rules)))))
+
+  (defthm delete-preserves-empty
+    (implies (empty X)
+             (empty (delete a X))))
+
+  (defthm delete-in
+    (equal (in a (delete b X))
+           (and (in a X)
+                (not (equal a b)))))
+
+  (defthm delete-sfix-cancel
+    (equal (delete a (sfix X))
+           (delete a X)))
+
+  (defthm delete-nonmember-cancel
+    (implies (not (in a X))
+             (equal (delete a X) (sfix X))))
+
+  (defthm delete-delete
+    (equal (delete a (delete b X))
+           (delete b (delete a X)))
+    :rule-classes ((:rewrite :loop-stopper ((a b)))))
+
+  (defthm repeated-delete
+    (equal (delete a (delete a X))
+           (delete a X)))
+
+  (defthm delete-insert-cancel
+    (equal (delete a (insert a X))
+           (delete a X)))
+
+  (defthm insert-delete-cancel
+    (equal (insert a (delete a X))
+           (insert a X)))
+
+  (defthm subset-delete
+    (subset (delete a X) X)))
\ No newline at end of file
diff -Nru acl2-6.2/books/std/osets/difference.lisp acl2-6.3/books/std/osets/difference.lisp
--- acl2-6.2/books/std/osets/difference.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/difference.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,219 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "SETS")
+(include-book "membership")
+(set-verify-guards-eagerness 2)
+
+
+; Fast Difference
+;
+; As before, we want to show that difference always creates a set and that the
+; produced set has the expected membership properties.  Also as before, these
+; proofs are ugly.
+
+; PATCH (0.91): David Rager noticed that as of v0.9, fast-difference was not
+; tail recursive, and submitted an updated version.  The original
+; fast-difference has been renamed to fast-difference-old, and the new
+; fast-difference replaces it.
+
+(defun fast-difference-old (X Y)
+  (declare (xargs :measure (fast-measure X Y)
+                  :guard (and (setp X) (setp Y))
+                  :verify-guards nil))
+  (cond ((endp X) nil)
+        ((endp Y) X)
+        ((equal (car X) (car Y))
+         (fast-difference-old (cdr X) (cdr Y)))
+        ((mbe :logic (<< (car X) (car Y))
+              :exec (fast-lexorder (car X) (car Y)))
+         (cons (car X) (fast-difference-old (cdr X) Y)))
+        (t
+         (fast-difference-old X (cdr Y)))))
+
+(verify-guards fast-difference-old
+  :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+(local
+ (encapsulate ()
+
+   (local (defthm l0
+            (implies (and (consp (fast-difference-old x y))
+                          (or (atom x) (<< a (car x)))
+                          (setp x))
+                     (<< a (car (fast-difference-old x y))))
+            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
+
+   (defthm fast-difference-old-set
+     (implies (and (setp X) (setp Y))
+              (setp (fast-difference-old X Y)))
+     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+   (local (defthm l1
+            (implies (and (member a x)
+                          (not (member a y))
+                          (setp x)
+                          (setp y))
+                     (member a (fast-difference-old x y)))
+            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
+
+   (local (defthm l2
+            (implies (and (member a (fast-difference-old x y))
+                          (setp x)
+                          (setp y))
+                     (and (member a x)
+                          (not (member a y))))
+            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
+
+   (local (defthm member-of-fast-difference-old
+            (implies (and (setp x)
+                          (setp y))
+                     (iff (member a (fast-difference-old x y))
+                          (and (member a x)
+                               (not (member a y)))))))
+
+   (defthm fast-difference-old-membership
+     (implies (and (setp X) (setp Y))
+              (equal (in a (fast-difference-old X Y))
+                     (and (in a X)
+                          (not (in a Y)))))
+     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))))
+
+
+(defun fast-difference (X Y acc)
+  (declare (xargs :measure (fast-measure X Y)
+                  :guard (and (setp X)
+                              (setp Y)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (cond ((endp X) (revappend acc nil))
+        ((endp Y) (revappend acc X))
+        ((equal (car X) (car Y))
+         (fast-difference (cdr X) (cdr Y) acc))
+        ((mbe :logic (<< (car X) (car Y))
+              :exec (fast-lexorder (car X) (car Y)))
+         (fast-difference (cdr X) Y (cons (car X) acc)))
+        (t
+         (fast-difference X (cdr Y) acc))))
+
+(verify-guards fast-difference
+  :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+(encapsulate
+  ()
+  (local (defthm lemma
+           (implies (true-listp acc)
+                    (equal (fast-difference x y acc)
+                           (revappend acc (fast-difference-old x y))))))
+
+  (local (defthm lemma2
+           (equal (fast-difference x y nil)
+                  (fast-difference-old x y))))
+
+  (defthm fast-difference-set
+    (implies (and (force (setp X))
+                  (force (setp Y)))
+             (setp (fast-difference X Y nil))))
+
+  (defthm fast-difference-membership
+    (implies (and (setp X) (setp Y))
+             (equal (in a (fast-difference X Y nil))
+                    (and (in a X)
+                         (not (in a Y))))))
+
+  (in-theory (disable fast-difference
+                      fast-difference-set
+                      fast-difference-membership)))
+
+
+
+(defsection difference
+  :parents (osets)
+  :short "@(call difference) removes all members of @('Y') from @('X')."
+
+  :long "<p>The logical definition is very simple, and the essential
+correctness property is given by @('difference-in').</p>
+
+<p>The execution uses a better, O(n) algorithm to remove the elements by
+exploiting the set order.</p>"
+
+  (defun difference (X Y)
+    (declare (xargs :guard (and (setp X) (setp Y))
+                    :verify-guards nil))
+    (mbe :logic (cond ((empty X) (sfix X))
+                      ((in (head X) Y) (difference (tail X) Y))
+                      (t (insert (head X) (difference (tail X) Y))))
+         :exec (fast-difference X Y nil)))
+
+  (defthm difference-set
+    (setp (difference X Y)))
+
+  (defthm difference-sfix-X
+    (equal (difference (sfix X) Y) (difference X Y)))
+
+  (defthm difference-sfix-Y
+    (equal (difference X (sfix Y)) (difference X Y)))
+
+  (defthm difference-empty-X
+    (implies (empty X)
+             (equal (difference X Y) (sfix X))))
+
+  (defthm difference-empty-Y
+    (implies (empty Y)
+             (equal (difference X Y) (sfix X))))
+
+  (encapsulate ()
+
+    (local (defthm difference-in-X
+             (implies (in a (difference X Y))
+                      (in a X))))
+
+    (local (defthm difference-in-Y
+             (implies (in a (difference X Y))
+                      (not (in a Y)))))
+
+    (defthm difference-in
+      (equal (in a (difference X Y))
+             (and (in a X)
+                  (not (in a Y))))))
+
+  (encapsulate
+    ()
+    ;; bozo shouldn't really need this
+    (local (defthm l0
+             (implies (and (setp y) (setp x) (empty x))
+                      (not (fast-difference x y nil)))
+             :hints(("Goal" :in-theory (enable fast-difference
+                                               (:ruleset low-level-rules))))))
+
+    (verify-guards difference
+      :hints(("Goal" :in-theory (enable fast-difference-set
+                                        fast-difference-membership)))))
+
+  (defthm difference-subset-X
+    (subset (difference X Y) X))
+
+  (defthm subset-difference
+    (equal (empty (difference X Y))
+           (subset X Y)))
+
+  (defthm difference-insert-X
+    (equal (difference (insert a X) Y)
+           (if (in a Y)
+               (difference X Y)
+             (insert a (difference X Y)))))
+
+  (defthm difference-preserves-subset
+    (implies (subset X Y)
+             (subset (difference X Z)
+                     (difference Y Z)))))
\ No newline at end of file
diff -Nru acl2-6.2/books/std/osets/instance.lisp acl2-6.3/books/std/osets/instance.lisp
--- acl2-6.2/books/std/osets/instance.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/instance.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,644 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; instance.lisp
+;
+; This is a system for dynamically instantiating ACL2 "theories" (which are
+; represented as constants) to create new, concrete "theories".
+
+; BOZO this whole file is probably subsumed by something better, in the
+; make-event era.
+
+(in-package "INSTANCE")
+
+
+; Everything in this file is in program mode.  We do not intend to reason about
+; these functions -- instead, we intend to use these functions to create new
+; functions, which the user will reason about.
+
+(program)
+
+
+; Introduction
+;
+;
+; The following work has been motivated by my work with quantification over
+; sets.  When I started on this file, I had roughly 2000 lines of complicted
+; macros in order to be able to instantiate generic and concrete theories for
+; this work, and it was just becoming unmanageable.  My hope was that rewriting
+; the definitions and theorems into concrete forms would provide a more concise
+; way of instantiating the theory, and make it easier to keep everything
+; consistent.
+;
+; Originally, I wanted to extract the definitions for generic functions from
+; ACL2's state (well, actually from the current world).  But, to do so becomes
+; very complicated, because of the restrictions on macros that they cannot take
+; state as a parameter.  So, the best that I could ever accomplish that way
+; would be to display a list of events, which a user could copy into a file.
+; But, that is wholly unsatisfying, because it would mean that the resulting
+; theories could never be "automagically" updated when new theorems are added
+; to the generic theory.
+;
+; So, instead of doing things that way, I now simply store events in constants.
+; These constants can then be rewritten to create new but related theories.
+;
+; A first step towards this is to introduce a simple rewriter.  Originally I
+; had based my rewriter on the built in one-way-unify function in ACL2, but it
+; operates only on pseudo-terms, and pseudo-terms cannot contain atoms other
+; than symbols.  This gave me serious trouble when trying to rewrite theorems
+; involving constants, e.g., to say that something was an integerp and greater
+; than zero.  So, instead of using one-way-unify, I introduce a simple
+; unification algorithm which has been adapted from Warren Hunt's work.
+
+; The system treats all symbols beginning with a ? as variables, and all other
+; atoms as literals.
+
+(defun instance-variablep (x)
+  (and (symbolp x)
+       (equal (car (explode-atom x 10)) #\?)))
+
+
+
+; We return two values: a boolean flag which indicates if we are successful in
+; finding a match, and a list of substitutions of the form (variable . value).
+; This is all be fairly standard stuff.
+;
+; For example:
+;
+;    (instance-unify-term '(predicate ?x) '(predicate (car a)) nil)
+;    ==>
+;    (t ((?x . (car a))))
+
+(mutual-recursion
+
+  (defun instance-unify-term (pattern term sublist)
+    (if (atom pattern)
+	(if (instance-variablep pattern)
+	    (let ((value (assoc pattern sublist)))
+	      (if (consp value)
+		  (if (equal term (cdr value))
+		      (mv t sublist)
+		    (mv nil nil))
+		(mv t (acons pattern term sublist))))
+	  (if (equal term pattern)
+	      (mv t sublist)
+	    (mv nil nil)))
+      (if (or (atom term)
+	      (not (eq (car term) (car pattern))))
+	  (mv nil nil)
+	(if (or (eq (car term) 'quote)
+		(eq (car pattern) 'quote))
+	    (if (equal term pattern)
+		(mv t sublist)
+	      (mv nil nil))
+	  (instance-unify-list (cdr pattern) (cdr term) sublist)))))
+
+  (defun instance-unify-list (pattern-list term-list sublist)
+    (if (or (atom term-list)
+	    (atom pattern-list))
+	(if (and (atom term-list)
+		 (atom pattern-list))
+	    (mv t sublist)
+	  (mv nil nil))
+      (mv-let (successp new-sublist)
+	      (instance-unify-term (car pattern-list)
+				   (car term-list)
+				   sublist)
+	      (if successp
+		  (instance-unify-list (cdr pattern-list)
+				       (cdr term-list)
+				       new-sublist)
+		(mv nil nil)))))
+)
+
+
+; After a list of substitutions has been generated, we typically want to apply
+; them to a term.  We recur over the list of substitutions, simply calling
+; subst to do our work throughout a term.
+;
+; For example:
+;
+;   (instance-substitute '((?x . (car a))) '(not (predicate ?x)))
+;   ==>
+;   (not (predicate (car a)))
+
+(defun instance-substitute (sublist term)
+  (if (endp sublist)
+      term
+    (let* ((old (car (car sublist)))
+           (new (cdr (car sublist)))
+	   (result (subst new old term)))
+      (instance-substitute (cdr sublist) result))))
+
+
+
+; We now introduce our actual rewriter.  We take three arguments: pat is the
+; pattern to look for throughout the term, e.g., (predicate ?x), repl is the
+; replacement to use, e.g., (not (predicate ?x)), and term is the term to match
+; the pattern against in order to get the substitutions.
+;
+; For Example:
+;
+;   (instance-rewrite1 '(predicate ?x)
+;                      '(not (predicate ?x))
+;                      '(if (predicate (car x)) t nil))
+;   =>
+;   (if (not (predicate (car x))) t nil)
+
+(mutual-recursion
+
+  (defun instance-rewrite1 (pat repl term)
+    (mv-let (successful sublist)
+            (instance-unify-term pat term nil)
+	    (if successful
+		(instance-substitute sublist repl)
+	      (if (atom term)
+		  term
+		(cons (instance-rewrite1 pat repl (car term))
+		      (instance-rewrite-lst1 pat repl (cdr term)))))))
+
+  (defun instance-rewrite-lst1 (pat repl lst)
+    (if (endp lst)
+        nil
+      (cons (instance-rewrite1 pat repl (car lst))
+            (instance-rewrite-lst1 pat repl (cdr lst)))))
+)
+
+
+
+; Finally, given that we can apply a rewrite a term with a single replacement,
+; we go ahead and extend this notion to multiple replacements.  In other words,
+; we walk through a list of substitutions, sequentially rewriting the term
+; using each substitution.
+
+(defun instance-rewrite (term subs)
+  (if (endp subs)
+      term
+    (let ((first-sub (car subs)))
+      (instance-rewrite (instance-rewrite1 (first first-sub)
+					   (second first-sub)
+					   term)
+			(cdr subs)))))
+
+
+
+
+; Instantiating Defuns
+;
+;
+; Theories consist mainly of definitions and theorems.  Given generic theorems,
+; we will want to rewrite them so that they perform different functions.  For
+; example, a generic "all" function might need to be rewritten so that its
+; calls to (predicate x) are replaced with calls to (not (predicate x)) for all
+; x.
+;
+; To begin, we instantiate the function's declarations (e.g., comment strings,
+; xargs, ignores, and so forth).  We simply duplicate comment strings, but for
+; declare forms we allow rewriting to occur.
+
+(defun instance-decls (decls subs)
+  (if (endp decls)
+      nil
+    (if (pseudo-termp (car decls))
+	(cons (instance-rewrite (car decls) subs)
+	      (instance-decls (cdr decls) subs))
+      (cons (car decls)
+	    (instance-decls (cdr decls) subs)))))
+
+
+; For the defun itself, we retain the same defun symbol (e.g., defun or
+; defund), but we change the name and args of the function by first creating
+; the list '(oldname oldarg1 oldarg2 ...) then applying our substitutions to
+; the new function.
+;
+; As a trivial example,
+;  (instance-defun '(defun f (x) (+ x 1)) '(((f x) (g x))))
+;    =>
+;  (defun g (x) (+ x 1))
+
+(defun instance-defun (defun subs)
+  (let* ((defun-symbol  (first defun))
+ 	 (defun-name    (second defun))
+	 (defun-args    (third defun))
+         (defun-decls   (butlast (cdddr defun) 1))
+	 (defun-body    (car (last defun)))
+	 (name/args     (cons defun-name defun-args))
+	 (new-body      (instance-rewrite defun-body subs))
+	 (new-name/args (instance-rewrite name/args subs))
+	 (new-decls     (instance-decls defun-decls subs))
+	 (new-name      (car new-name/args))
+	 (new-args      (cdr new-name/args)))
+    `(,defun-symbol
+       ,new-name ,new-args
+       ,@new-decls
+       ,new-body)))
+
+; We also provide a convenience function that allows you to instance a list of
+; defuns.
+
+(defun instance-defuns (defun-list subs)
+  (if (endp defun-list)
+      nil
+    (cons (instance-defun (car defun-list) subs)
+	  (instance-defuns (cdr defun-list) subs))))
+
+
+
+; Renaming theorems
+
+(defun defthm-names (event-list)
+  (if (endp event-list)
+      nil
+    (let* ((first-event (car event-list))
+	   (event-type  (first first-event)))
+      (cond ((or (eq event-type 'defthm)
+		 (eq event-type 'defthmd))
+	     (cons (second first-event)
+		   (defthm-names (cdr event-list))))
+	    ((eq event-type 'encapsulate)
+	     (append (defthm-names (cddr first-event))
+		     (defthm-names (cdr event-list))))
+	    (t (defthm-names (cdr event-list)))))))
+
+(defun create-new-names (name-list suffix)
+  (if (endp name-list)
+      nil
+    (acons (car name-list)
+	   (intern-in-package-of-symbol (string-append (symbol-name (car name-list))
+						       (symbol-name suffix))
+					suffix)
+	   (create-new-names (cdr name-list) suffix))))
+
+(defun rename-defthms (event-list suffix)
+  (sublis (create-new-names (defthm-names event-list) suffix)
+	  event-list))
+
+
+
+; Instantiating Theorems
+;
+;
+; To instantiate defthms, we will want to be able to provide functional
+; instantiations of the generic theory.  This is much more complicated than
+; instancing definitions, and involves:
+;
+;   a) determining what functional substitutions to make
+;   b) determining the theory in which to conduct the proofs
+;   c) handling rule classes and other optional components
+;   d) generating the actual defthm event
+;
+; My idea is essentially that if a substitution list can be used for
+; functionally instantiating theorems, then it can also be used for creating
+; the new theorem.
+;
+; (a) Determining what functional substitutions to make.
+;
+; I pass in a list of substitutions of the following form.
+;
+;   (((predicate ?x)  (not (in ?x y)))
+;    ((all ?x)        (all-not-in ?x y))
+;    ((exists ?x)     (exists-not-in ?x y)))
+;
+; From this list we can generate the functional instantiation hints.  So, for
+; example, we simply convert ((predicate ?x) (not (in ?x y))) into the
+; substitution:
+;
+;   (predicate (lambda (?x) (not (in ?x y))))
+;
+; This is easy to do with the following functions:
+
+(defun sub-to-lambda (sub)
+  (let ((term (first sub))
+	(repl (second sub)))
+    (let ((function-symbol (car term))
+	  (lambda-args (cdr term)))
+      `(,function-symbol (lambda ,lambda-args ,repl)))))
+
+(defun subs-to-lambdas (subs)
+  (if (endp subs)
+      nil
+    (cons (sub-to-lambda (car subs))
+	  (subs-to-lambdas (cdr subs)))))
+
+
+; (b) Determining the theory in which to conduct the proofs.
+;
+; When we prove the functional instantiation constraints, ideally we should
+; work in an environment where the only definitions that are enabled are the
+; definitions used in the functional instantiation hints.
+;
+; Well, the definitions we need are (almost) simply all of the function symbols
+; in the right-hand side of the substitution list.  In other words, for the
+; above substitutions, I would want to have the definitions of not, in,
+; all-not-in, and exists-not-in available.
+;
+; Now, the problem with this approach is, what if those symbols don't have
+; definitions?  This can occur if, for example, we are using a constrained
+; function in the substitution list.  This is actually useful, e.g., for
+; substituting (predicate ?x) -> (not (predicate ?x)).
+;
+; My solution is a stupid hack.  We simply pass in the names of the generic
+; functions for which we do not want to generate definitions along with the
+; substitutinos.
+;
+; To begin, the following function will extract all function symbols that occur
+; within a term.
+
+(mutual-recursion
+
+  (defun term-functions (term)
+    (if (atom term)
+        nil
+      (cons (car term)
+	    (term-list-functions (cdr term)))))
+
+  (defun term-list-functions (list)
+    (if (endp list)
+	nil
+      (append (term-functions (car list))
+	      (term-list-functions (cdr list)))))
+)
+
+; Next, I wrote the following function, which walks over the substitution list
+; and extracts the function symbols from each right hand side, using
+; term-functions.  The net result is the list of all functions that were used
+; in replacements.
+
+(defun subs-repl-functions (subs)
+  (if (endp subs)
+      nil
+    (let* ((sub1 (car subs))
+	   (repl (second sub1)))
+      (append (term-functions repl)
+	      (subs-repl-functions (cdr subs))))))
+
+; Given the above, we could then convert the list of function symbols into a
+; list of (:definition f)'s with the following function.
+
+(defun function-list-to-definitions (funcs)
+  (if (endp funcs)
+      nil
+    (cons `(:definition ,(car funcs))
+	  (function-list-to-definitions (cdr funcs)))))
+
+; And finally, here is a function that does "all of the work", calling
+; function-list-to-definitions for all of the functions found in the
+; substitution list, minus all of the generic functions that we don't want to
+; generate :definition hints for.
+
+(defun subs-to-defs (subs generics)
+  (let* ((all-fns (subs-repl-functions subs))
+	 (real-fns (set-difference-eq all-fns generics)))
+    (function-list-to-definitions real-fns)))
+
+
+; (c) Handling rule classes and other optional components.
+;
+; We are interested in several parts of a defthm.  In addition to the
+; conjecture itself, we need to consider the rule-classes used by the theorem,
+; and the other optional attributes such as the :hints, :doc, :otf-flg, etc.
+; We parse these attributes into a five-tuple of pairs of the form (present
+; . value), where present is a boolean that says whether or not the flag has
+; been seen, value is its value, and the order of the elements is rule-classes,
+; instructions, hints, otf-flg, and finally doc.  We parse these options with
+; the following code:
+
+(defconst *default-parse-values*
+  '((nil . nil) (nil . nil) (nil . nil) (nil . nil) (nil . nil)))
+
+(defun parse-defthm-option (option return-value)
+  (cond ((equal (first option) :rule-classes)
+         (update-nth 0 (list t (second option)) return-value))
+	((equal (first option) :instructions)
+	 (update-nth 1 (list t (second option)) return-value))
+	((equal (first option) :hints)
+	 (update-nth 2 (list t (second option)) return-value))
+	((equal (first option) :otf-flg)
+	 (update-nth 3 (list t (second option)) return-value))
+	((equal (first option) :doc)
+	 (update-nth 4 (list t (second option)) return-value))
+	(t (er hard "Unknown flag in defthm options ~x0." (first option)))))
+
+(defun parse-defthm-options (options return-value)
+  (if (endp options)
+      return-value
+    (parse-defthm-options (cddr options)
+			  (parse-defthm-option options return-value))))
+
+
+; (d) Generating the actual defthm event.
+;
+; When we are ready to instance a defthm event, we combine the above work with
+; a few new things.  First of all, we need the original theorem event, a new
+; name to use, the substitutions to use, and the list of generic function
+; symbols in use so that we do not create (:definition f) entries for them.
+;
+; We begin by making our substitutions in the body of the theorem.  We then
+; parse the optional components of the defthm, but we only are interested in
+; the rule-classes.  (Hints, instructions, and otf-flg will not be needed,
+; because we will be proving this via functional instantiation.  Doc we ignore
+; for no good reason.)  We construct a new theorem that has our new name and
+; body, replicating the rule classes if necessary.  We also provide a
+; functional instantiation hint of the generic theorem's name, along with a
+; list of lambda substitutions to make.
+
+(defun instance-defthm (event new-name subs generics extra-defs)
+  (let* ((defthm-symbol (first event))
+	 (defthm-name   (second event))
+	 (defthm-body   (third event))
+	 (new-body      (instance-rewrite defthm-body subs))
+	 (options       (parse-defthm-options (cdddr event)
+					      *default-parse-values*))
+	 (rc-opt        (first options)))
+    `(,defthm-symbol ,new-name
+       ,new-body
+       :hints(("Goal"
+	       :use (:functional-instance ,defthm-name
+					  ,@(subs-to-lambdas subs))
+	       :in-theory (union-theories (theory 'minimal-theory)
+			   (union-theories ',extra-defs
+					   ',(subs-to-defs subs generics)))))
+       ,@(if (car rc-opt) `(:rule-classes ,(cdr rc-opt)) nil))))
+
+
+
+; Instantiating Encapsulates
+;
+;
+; There are two reasons that I typically use encapsulation.  The first is as a
+; purely structural/organizational purpose, where I am trying to prove some
+; theorem is true, but I need some lemmas to do so.  In this case I use an
+; (encapsulate nil ...) and wrap my lemmas in local forms.  The other reason is
+; to actually go ahead and introduce constrained functions.
+;
+; Two strategies will be necessary for handling these situations.  In
+; particular, if we are in an encapsulate which has no constrained function
+; symbols, we will want to skip all local events and only add the non-local
+; events (using functional instantiation to create the theorems).  On the other
+; hand, for the case when we are introducing constrained functions, we will
+; want to introduce new constrained functions based on the encapsulate.
+;
+; So, encapsulates are handled separately based on whether or not any functions
+; are constrained.
+;
+; Within an (encapsulate nil ...), local events will be skipped and defthm
+; events will be proven using the functional instantiation of their generic
+; counterparts.
+;
+; Within an (encapsulate (...) ...), local events will not be skipped but will
+; instead be reintroduced with new names.  Further, defthm events will be
+; copied using new names and will not be proven using functional instantiation.
+;
+; The only "extra" thing we really need for handling encapsulates is a system
+; to make the substitutions within the signatures.  We do that here by simple
+; rewriting.  Note that we do not allow the number of return values to change.
+; I don't really think of this as a major limitation, since almost always my
+; constrained functions return a single value.  If you have an example of where
+; this would be useful, it would be interesting to see it.
+
+(defun instance-signature (signature subs)
+  (let ((name (first signature))
+	(rest (rest signature)))
+    (cons (instance-rewrite subs name) rest)))
+
+(defun instance-signatures (signatures subs)
+  (if (endp signatures)
+      nil
+    (cons (instance-signature (car signatures) subs)
+	  (instance-signatures (cdr signatures) subs))))
+
+; Because encapsulates can contain many events within them, it is natural to
+; make them mutually recursive with the main event list handler, which we are
+; now ready to introduce.
+
+
+
+
+
+; Instantiating Entire Theories
+;
+;
+; We are now ready to introduce the functions which will walk through a theory
+; and call the appropriate instancing functions on each of the forms we
+; encounter.  To support encapsulation, our functions here are all mutually
+; recursive.
+;
+; The arguments that we pass around are the following:
+;
+;   - The event or event list to instantiate
+;
+;   - The global list of substitutions used to derive the instance
+;
+;   - A suffix which will be appended to generate new names
+;
+;   - A list of generic functions which have no definitions
+;
+;   - A mode, which is either 'constrained to indicate that the nearest
+;     encapsulate event has constrained functions, or is nil to indicate that
+;     the nearest encapsulate is merely a structural wrapper for local lemmas.
+;
+; Finally, we overload our behavior based on suffix, so that if no suffix is
+; given, we simply replicate the generic theory instead of instantiating a
+; concrete instance of it.
+
+
+(mutual-recursion
+
+  (defun instance-event (event subs suffix generics mode extra-defs)
+    (if (null suffix)
+	event
+      (cond ((or (eq (car event) 'defun)
+		 (eq (car event) 'defund))
+	     (instance-defun event subs))
+	    ((or (eq (car event) 'defthm)
+		 (eq (car event) 'defthmd))
+	     (let* ((name (second event))
+		    (new-name (intern-in-package-of-symbol
+			       (string-upcase
+				(concatenate 'string
+					     (symbol-name name)
+					     (symbol-name suffix)))
+			       suffix)))
+	       (instance-defthm event new-name subs generics extra-defs)))
+	    ((equal (car event) 'local)
+	     (if (eq mode 'constrained)
+		 (instance-event (second event) subs suffix generics mode extra-defs)
+	       nil))
+	    ((equal (car event) 'encapsulate)
+	     (instance-encapsulate event subs suffix generics mode extra-defs))
+	    (t (er hard "Don't know how to handle ~x0" (car event))))))
+
+  (defun instance-event-list (events subs suffix generics mode extra-defs)
+    (if (endp events)
+	nil
+      (let ((first (instance-event (car events) subs suffix generics mode extra-defs))
+	    (rest  (instance-event-list (cdr events) subs suffix generics mode extra-defs)))
+	(if first
+	    (cons first rest)
+	  rest))))
+
+  (defun instance-encapsulate (event subs suffix generics mode extra-defs)
+    (declare (ignore mode))
+    (let* ((signatures (second event))
+	   (new-sigs   (if signatures
+			   (instance-signatures subs signatures)
+			 nil))
+	   (new-events (instance-event-list (cddr event) subs suffix generics
+					    (if signatures
+						'constrained
+					      nil)
+					    extra-defs)))
+      `(encapsulate ,new-sigs ,@new-events)))
+
+)
+
+
+; To be able to actually introduce the events, we need to emit a macro that can
+; be used to actually perform substitutions.
+
+(defmacro instance (theory)
+  (let ((macro-name (intern-in-package-of-symbol
+		     (string-upcase (concatenate 'string
+						 "instance-" (string theory)))
+		     theory)))
+    `(defmacro ,macro-name (&key subs suffix generics extra-defs)
+       (list* 'encapsulate
+	      nil
+	      (instance-event-list ,theory subs suffix generics nil extra-defs)))))
+
+
+
+
+; Some thoughts
+;
+; A fundamental issue seems to be that a function and its arguments are not
+; always used in a consistent manner.  For example, say we want to rewrite (all
+; ?x) to (all-foo ?x y) and we want to rewrite (predicate ?x) to (not (foo ?x
+; y)).  How can we accurately say just what it is that we want to rewrite in
+; each case?
+;
+; Right now our substitutions are based on
+;  ( (predicate ?x)  (not (foo ?x y)) )
+;  ( (all ?x)        (all-foo ?x y) )
+;
+; We can easily pick out and say "all" is replaced by "all-foo", but if we try
+; to just use the car of the term as its symbol replacement, then "predicate"
+; would be "not".
+;
+; OK, so we could do some kind of preprocessing step where we fill in argument
+; guards.  The "generics" list right now is a big huge hack that allows us to
+; ignore the fact that :predicate doens't have a definition.  Really the issue
+; that this is trying to solve is to tell us how to build our :in-theory event.
+; Right now the :in-theory event is just a hack that we don't really
+; understand.
diff -Nru acl2-6.2/books/std/osets/intersect.lisp acl2-6.3/books/std/osets/intersect.lisp
--- acl2-6.2/books/std/osets/intersect.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/intersect.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,311 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "SETS")
+(include-book "membership")
+(set-verify-guards-eagerness 2)
+
+
+
+; Fast Intersect
+;
+; Again we are only interested in showing that fast-intersect creates sets and
+; has the expected membership property.
+
+(defun fast-intersectp (X Y)
+  (declare (xargs :guard (and (setp X)
+                              (setp Y))
+                  :measure (fast-measure X Y)
+                  :verify-guards nil))
+  (cond ((endp X) nil)
+        ((endp Y) nil)
+        ((equal (car X) (car Y))
+         t)
+        ((mbe :logic (<< (car X) (car y))
+              :exec (fast-lexorder (car X) (car Y)))
+         (fast-intersectp (cdr X) Y))
+        (t
+         (fast-intersectp X (cdr Y)))))
+
+(verify-guards fast-intersectp
+  :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+
+;; PATCH (0.91): David Rager noticed that as of v0.9, fast-intersect was not
+;; tail recursive, and submitted an updated version.  The original
+;; fast-intersect has been renamed to fast-intersect-old, and the new
+;; fast-intersect replaces it.
+
+(local
+ (encapsulate
+   ()
+
+   (defun fast-intersect-old (X Y)
+     (declare (xargs :measure (fast-measure X Y)
+                     :guard (and (setp X) (setp Y))
+                     :verify-guards nil))
+     (cond ((endp X) nil)
+           ((endp Y) nil)
+           ((equal (car X) (car Y))
+            (cons (car X) (fast-intersect-old (cdr X) (cdr Y))))
+           ((mbe :logic (<< (car X) (car Y))
+                 :exec (fast-lexorder (car X) (car Y)))
+            (fast-intersect-old (cdr X) Y))
+           (t
+            (fast-intersect-old X (cdr Y)))))
+
+   (verify-guards fast-intersect-old
+     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+   (local (defthm l0
+            (implies (and (consp (fast-intersect-old x y))
+                          (or (atom x) (<< a (car x)))
+                          (or (atom y) (<< a (car y)))
+                          (setp x)
+                          (setp y))
+                     (<< a (car (fast-intersect-old x y))))
+            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
+
+   (defthm setp-of-fast-intersect-old
+     (implies (and (setp x)
+                   (setp y))
+              (setp (fast-intersect-old x y)))
+     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+   (local (defthm l1
+            (implies (and (member a x)
+                          (member a y)
+                          (setp x)
+                          (setp y))
+                     (member a (fast-intersect-old x y)))
+            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
+
+   (local (defthm l2
+            (implies (member a (fast-intersect-old x y))
+                     (and (member a x)
+                          (member a y)))
+            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
+
+   (local (defthm member-of-fast-intersect-old
+            (implies (and (setp x)
+                          (setp y))
+                     (iff (member a (fast-intersect-old x y))
+                          (and (member a x)
+                               (member a y))))))
+
+   (defthm in-fast-intersect-old
+     (implies (and (setp x)
+                   (setp y))
+              (equal (in a (fast-intersect-old x y))
+                     (and (in a x)
+                          (in a y))))
+     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+
+
+   (local (defthm l4
+            (equal (fast-intersectp X Y)
+                   (consp (fast-intersect-old X Y)))
+            :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
+
+   (defthm fast-intersectp-correct-lemma
+     (implies (and (setp X)
+                   (setp Y))
+              (equal (fast-intersectp X Y)
+                     (not (empty (fast-intersect-old X Y)))))
+     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))))
+
+
+(defun fast-intersect (X Y acc)
+  (declare (xargs :measure (fast-measure X Y)
+                  :guard (and (setp X)
+                              (setp Y)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (cond ((endp X) (revappend acc nil))
+        ((endp Y) (revappend acc nil))
+        ((equal (car X) (car Y))
+         (fast-intersect (cdr X) (cdr Y) (cons (car X) acc)))
+        ((mbe :logic (<< (car X) (car Y))
+              :exec (fast-lexorder (car X) (car Y)))
+         (fast-intersect (cdr X) Y acc))
+        (t
+         (fast-intersect X (cdr Y) acc))))
+
+(verify-guards fast-intersect
+  :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+(encapsulate
+  ()
+  (local (defthm lemma
+           (implies (true-listp acc)
+                    (equal (fast-intersect x y acc)
+                           (revappend acc (fast-intersect-old x y))))))
+
+  (local (defthm lemma2
+           (equal (fast-intersect x y nil)
+                  (fast-intersect-old x y))))
+
+  (defthm fast-intersect-set
+    (implies (and (force (setp X))
+                  (force (setp Y)))
+             (setp (fast-intersect X Y nil))))
+
+  (defthm fast-intersect-membership
+    (implies (and (setp X) (setp Y))
+             (equal (in a (fast-intersect X Y nil))
+                    (and (in a X) (in a Y)))))
+
+  (defthm fast-intersectp-correct
+    (implies (and (setp X) (setp Y))
+             (equal (fast-intersectp X Y)
+                    (not (empty (fast-intersect X Y nil))))))
+
+  (in-theory (disable fast-intersect
+                      fast-intersect-set
+                      fast-intersect-membership
+                      fast-intersectp
+                      fast-intersectp-correct)))
+
+
+
+(defsection intersect
+  :parents (osets)
+  :short "@(call intersect) constructs the intersection of @('X') and @('Y')."
+
+  :long "<p>The logical definition is very simple, and the essential
+correctness property is given by @('intersect-in').</p>
+
+<p>The execution uses a better, O(n) algorithm to intersect the sets by
+exploiting the set order.</p>
+
+<p>See also @(see intersectp), which doesn't construct a new set but just tells
+you whether the sets have any overlap.  It's potentially faster if you don't
+care about constructing the set, because it doesn't have to do any
+consing.</p>"
+
+  (defun intersect (X Y)
+    (declare (xargs :guard (and (setp X) (setp Y))
+                    :verify-guards nil))
+    (mbe :logic (cond ((empty X) (sfix X))
+                      ((in (head X) Y)
+                       (insert (head X) (intersect (tail X) Y)))
+                      (t (intersect (tail X) Y)))
+         :exec (fast-intersect X Y nil)))
+
+  (defthm intersect-set
+    (setp (intersect X Y)))
+
+  (defthm intersect-sfix-cancel-X
+    (equal (intersect (sfix X) Y) (intersect X Y)))
+
+  (defthm intersect-sfix-cancel-Y
+    (equal (intersect X (sfix Y)) (intersect X Y)))
+
+  (defthm intersect-empty-X
+    (implies (empty X) (empty (intersect X Y))))
+
+  (defthm intersect-empty-Y
+    (implies (empty Y) (empty (intersect X Y))))
+
+  (encapsulate ()
+
+    (local (defthm intersect-in-Y
+             (implies (not (in a Y))
+                      (not (in a (intersect X Y))))))
+
+    (local (defthm intersect-in-X
+             (implies (not (in a X))
+                      (not (in a (intersect X Y))))))
+
+    (defthm intersect-in
+      (equal (in a (intersect X Y))
+             (and (in a Y) (in a X)))))
+
+  (defthm intersect-symmetric
+    (equal (intersect X Y) (intersect Y X))
+    :rule-classes ((:rewrite :loop-stopper ((X Y)))))
+
+  (defthm intersect-subset-X
+    (subset (intersect X Y) X))
+
+  (defthm intersect-subset-Y
+    (subset (intersect X Y) Y))
+
+  (defthm intersect-insert-X
+    (implies (not (in a Y))
+             (equal (intersect (insert a X) Y)
+                    (intersect X Y))))
+
+  (defthm intersect-insert-Y
+    (implies (not (in a X))
+             (equal (intersect X (insert a Y))
+                    (intersect X Y))))
+
+
+  (defthm intersect-with-subset-left
+    (implies (subset X Y)
+             (equal (intersect X Y)
+                    (sfix X)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm intersect-with-subset-right
+    (implies (subset X Y)
+             (equal (intersect Y X)
+                    (sfix X)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm intersect-self
+    (equal (intersect X X) (sfix X)))
+
+  (defthm intersect-associative
+    (equal (intersect (intersect X Y) Z)
+           (intersect X (intersect Y Z))))
+
+  (defthm intersect-commutative
+    (equal (intersect X (intersect Y Z))
+           (intersect Y (intersect X Z)))
+    :rule-classes ((:rewrite :loop-stopper ((X Y)))))
+
+  (defthm intersect-outer-cancel
+    (equal (intersect X (intersect X Z))
+           (intersect X Z))))
+
+
+(local (defthm fast-intersect-correct
+         (implies (and (setp X)
+                       (setp Y))
+                  (equal (fast-intersect X Y nil)
+                         (intersect X Y)))
+         :hints(("Goal" :in-theory (enable fast-intersect-set
+                                           fast-intersect-membership)))))
+
+(verify-guards intersect)
+
+
+(defsection intersectp
+  :parents (osets)
+  :short "@(call intersectp) checks whether @('X') and @('Y') have any common
+members."
+
+  :long "<p>Logically we just check whether the @(see intersect) of @('X') and
+@('Y') is @(see empty).</p>
+
+<p>In the execution, we use a faster function that checks for any common
+members and doesn't build any new sets.</p>"
+
+  (defun intersectp (X Y)
+    (declare (xargs :guard (and (setp X) (setp Y))
+                    :guard-hints(("Goal" :in-theory (enable fast-intersectp-correct)))))
+    (mbe :logic (not (empty (intersect X Y)))
+         :exec (fast-intersectp X Y))))
diff -Nru acl2-6.2/books/std/osets/map-tests.lisp acl2-6.3/books/std/osets/map-tests.lisp
--- acl2-6.2/books/std/osets/map-tests.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/map-tests.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,85 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; map-tests.lisp
+;
+; This book should not normally be included; it only exists to make sure that
+; the map macro is working.
+
+(in-package "ACL2")
+(include-book "map")
+(include-book "misc/assert" :dir :system)
+(set-verify-guards-eagerness 2)
+
+
+
+(SETS::map-function (integerp x))
+
+(assert! (equal (SETS::map<integerp> '(1 2 3)) '(t)))
+
+(assert! (equal (SETS::map-list<integerp> '(1 a 2 b))
+                '(t nil t nil)))
+
+
+(defun square (x)
+  (declare (xargs :guard t))
+  (* (rfix x) (rfix x)))
+
+(SETS::map-function (square x))
+
+(assert! (equal (SETS::map<square> '(1 2 3)) '(1 4 9)))
+(assert! (equal (SETS::map<square> '(a b c)) '(0)))
+
+
+; Make sure packages in-package works
+
+(SETS::map-function (square x)
+                    :in-package-of instance::foo)
+
+
+; Multi-input test
+
+(defun square-then-add (input offset)
+  (declare (xargs :guard t))
+  (+ (* (rfix input) (rfix input))
+     (rfix offset)))
+
+
+(SETS::map-function (square-then-add input offset)
+                    :in-package-of computed-hints::foo)
+
+(assert! (equal (COMPUTED-HINTS::map<square-then-add> '(1 2 3) 5)
+                '(6 9 14)))
+
+
+
+
+(defun plus (x y)
+  (declare (xargs :guard (and (integerp x) (rationalp y))))
+  (+ x y))
+
+(sets::quantify-predicate (integerp x)
+                          :in-package-of defthm)
+
+(sets::map-function (plus arg1 arg2)
+                    :in-package-of defthm
+                    :set-guard ((all<integerp> ?set))        ; set's name must be ?set
+                    :list-guard ((all-list<integerp> ?list)) ; list's name must be ?list
+                    :element-guard ((integerp a))            ; element's name must be a
+                    :arg-guard ((rationalp arg2)))           ; extra arg names specified above
+
+(assert! (equal (MAP<plus> '(1 2 3) 1) '(2 3 4)))
+
+
+
diff -Nru acl2-6.2/books/std/osets/map.lisp acl2-6.3/books/std/osets/map.lisp
--- acl2-6.2/books/std/osets/map.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/map.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,439 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; map.lisp
+;
+; This is an optional extension of the sets library, and is not included by
+; default when you run (include-book "sets").
+;
+; We introduce a macro map-function, which is somewhat like the higher-order
+; function "map" in other functional languages.  Given a particular
+; transformation function, this macro produces:
+;
+;      map<function>
+;      map-list<function>
+;
+; In addition to introducing these functions, a large rewriting strategy is
+; developed for reasoning about the new mapping functions.
+;
+;
+; Introductory Examples.
+;
+; Here are some simple examples.  These transformation functions have only a
+; single argument, and are guarded to operate on any inputs.
+;
+;     (SETS::map-function (integerp x))
+;       - (SETS::map<integerp> '(1 2 3)) = (t)
+;       - (SETS::map-list<integerp> '(1 a 2 b)) = (t nil t nil)
+;
+;     (defun square (x)
+;       (declare (xargs :guard t))
+;       (* (rfix x) (rfix x)))
+;
+;     (SETS::map-function (square x))
+;       - (SETS::map<square> '(1 2 3)) = (1 4 9)
+;       - (SETS::map<square> '(a b c)) = (0)
+;
+; Note that you can't use macros, e.g., real/rationalp cannot be used since it
+; is not a function.
+;
+;
+; Controlling Packages.
+;
+; As you can see, the new map<f> functions are added to the SETS package by
+; default.  If you would like them to be in a new place, you can use the
+; :in-package-of argument to map-function.  For example, since defthm is in the
+; ACL2 package, we can run:
+;
+;     (SETS::map-function (square x)
+;       :in-package-of defthm)
+;
+; And map<square> will be created in the ACL2 package instead of the sets
+; package.
+;
+;
+; Multi-Argument Transformation Functions.
+;
+; You can also introduce transformations with multiple arguments.  As an
+; example, we introduce the function square-then-add, which first squares its
+; input and then adds some offset to it.
+;
+;     (defun square-then-add (input offset)
+;       (declare (xargs :guard t))
+;       (+ (* (rfix input) (rfix input))
+;          (rfix offset)))
+;
+;     (SETS::map-function (square-then-add input offset)
+;        :in-package-of defthm)
+;
+;     (map<square-then-add> '(1 2 3) 5) => (6 9 14)
+;
+;
+; Supporting Guards.
+;
+; We can support transformation functions that require guards by sending extra
+; arguments to the map-function macro.  As an example, we consider what it
+; would require to write a mapping function for the function below.
+;
+;   (defun plus (x y)
+;     (declare (xargs :guard (and (integerp x) (rationalp y))))
+;     (+ x y))
+;
+;   (quantify-predicate (integerp x))   ; see quantify.lisp for explanation
+;
+;   (map-function (plus arg1 arg2)
+;     :set-guard ((all<integerp> ?set))        ; set's name must be ?set
+;     :list-guard ((all-list<integerp> ?list)) ; list's name must be ?list
+;     :element-guard ((integerp a))            ; element's name must be a
+;     :arg-guard ((rationalp arg2)))           ; extra arg names specified above
+;
+;
+; These examples can be found and run in map-tests.lisp.
+
+(in-package "SETS")
+(include-book "quantify")
+(set-verify-guards-eagerness 2)
+
+
+; BOZO ugly extra theorems we probably shouldn't need
+
+(defthm map-subset-helper
+  (implies (in (head X) Y)
+	   (equal (subset (tail X) Y)
+		  (subset X Y)))
+  :hints(("Goal" :expand (subset X Y))))
+
+(defthm map-subset-helper-2
+  (implies (not (in (head X) Y))
+           (equal (subset X Y)
+                  (empty X))))
+
+
+; We will map an arbitrary transformation function across the set.  We don't
+; assume anything about transform.
+
+(encapsulate
+  (((transform *) => *))
+  (local (defun transform (x) x)))
+
+
+; Now we introduce our mapping functions.  We allow the transform to be mapped
+; across a list or a set.  Under the hood, we use MBE to ensure that we first
+; transform every element of the set, and then mergesort the results.  This
+; gives O(n) + O(n log n) performance intead of the O(n^2) required for
+; repeated insertion.  We introduce these functions as a constant, so we can
+; rewrite it later to actually create maps.
+
+(defconst *map-functions* '(
+
+  (defun map-list (x)
+    (declare (xargs :guard (true-listp x)))
+    (if (endp x)
+	nil
+      (cons (transform (car X))
+	    (map-list (cdr X)))))
+
+  (defun map (X)
+    (declare (xargs :guard (setp X)))
+    (declare (xargs :verify-guards nil))
+    (mbe :logic (if (empty X)
+		    nil
+		  (insert (transform (head X))
+			  (map (tail X))))
+	 :exec (mergesort (map-list X))))
+
+; A crucial component of our reasoning is the notion of the inverse of the
+; transform.  We define the relation (inversep a b), which is true if and only
+; if a is an inverse of b under transform -- that is, (inversep a b) is true
+; when (transform a) = b.
+
+  (defun inversep (a b)
+    (declare (xargs :guard t))
+    (equal (transform a) b))))
+
+(INSTANCE::instance *map-functions*)
+(instance-*map-functions*)
+
+
+; We now quantify over the predicate inversep, allowing us to talk
+; about the existence of inverses in sets.
+
+(quantify-predicate (inversep a b))
+
+
+
+; Again we begin introducing theorems as a constant, so that we can
+; instantiate concrete theories of mapping by rewriting.
+
+(defconst *map-theorems* '(
+
+  (defthm map-setp
+    (setp (map X)))
+
+  (defthm map-sfix
+    (equal (map (sfix X))
+	   (map X)))
+
+
+; The ordered sets library works really well when you can provide a
+; concise statement about membership for your new functions.  Here, we
+; use the idea of inverses in order to explain what it means to be a
+; member in a map.  Basically, (in a (map X)) is exactly equal to
+; (exists<inversep> X a), i.e., if there is an inverse of a in x.  We
+; then manually apply our "exists elimination" to make this theorem a
+; little more direct.
+
+  (defthm map-in
+    (equal (in a (map X))
+	   (not (all<not-inversep> X a))))
+
+
+; With this notion of membership in play, we can now use the
+; properties of all<not-inversep> in order to prove many interesting
+; theorems about mappings through standard membership arguments.
+
+  (defthm map-subset
+    (implies (subset X Y)
+	     (subset (map X) (map Y))))
+
+  (defthm map-insert
+    (equal (map (insert a X))
+	   (insert (transform a) (map X))))
+
+  (defthm map-delete
+    (subset (delete (transform a) (map X))
+	    (map (delete a X))))
+
+  (defthm map-union
+    (equal (map (union X Y))
+	   (union (map X) (map Y))))
+
+  (defthm map-intersect
+    (subset (map (intersect X Y))
+	    (intersect (map X) (map Y))))
+
+  (defthm map-difference
+    (subset (difference (map X) (map Y))
+	    (map (difference X Y))))
+
+  (defthm map-cardinality
+    (<= (cardinality (map X))
+	(cardinality X))
+    :rule-classes :linear)
+
+
+
+; We now provide some theorems about mapping over lists.  These are
+; somewhat nice in and of themselves, but also allow us to prove our
+; mbe equivalence so that our mapping operations are more efficient.
+; To begin, we prove the characteristic list membership theorem for
+; mapping over lists.
+
+  (defthm member-of-map-list
+    (iff (member a (map-list X))
+         (exists-list<inversep> X a)))
+
+  (defthm map-mergesort
+    (equal (map (mergesort X))
+	   (mergesort (map-list X))))
+
+
+
+; And finally we prove this theorem, which will be useful for
+; verifying the guards of map.
+
+  (defthm map-mbe-equivalence
+    (implies (setp X)
+	     (equal (mergesort (map-list X))
+		    (map X))))
+
+
+; We finish up our theory with some more, basic theorems about
+; mapping over lists.
+
+  (defthm map-list-cons
+    (equal (map-list (cons a x))
+	   (cons (transform a)
+		 (map-list x))))
+
+  (defthm map-list-append
+    (equal (map-list (append x y))
+	   (append (map-list x)
+		   (map-list y))))
+
+  (defthm map-list-nth
+    (implies (and (integerp n)
+		  (<= 0 n)
+		  (< n (len x)))
+	     (equal (nth n (map-list x))
+		    (transform (nth n x)))))
+
+  (defthm map-list-revappend
+    (equal (map-list (revappend x acc))
+	   (revappend (map-list x)
+		      (map-list acc))))
+
+  (defthm map-list-reverse
+    (equal (map-list (reverse x))
+	   (reverse (map-list x))))
+
+))
+
+(INSTANCE::instance *map-theorems*)
+(instance-*map-theorems*)
+
+(verify-guards map)
+
+
+
+; This is a nice generic theory, but to be useful, we will need to be
+; able to instantiate concrete theories based on it.  We do this with
+; the following function, for which we introduce a corresponding
+; macro.
+
+(defun map-function-fn (function in-package
+				 set-guard
+				 list-guard
+				 element-guard
+				 arg-guard)
+
+  (declare (xargs :mode :program))
+
+  (let* ((name          (car function))
+	 (extra-args    (cddr function))
+	 (wrap          (app "<" (app (symbol-name name) ">")))
+
+	 ;; First we build up all the symbols that we will use.
+
+	 (map<f>                   (mksym (app "map" wrap) in-package))
+	 (map-list<f>              (mksym (app "map-list" wrap) in-package))
+	 (inversep                 (app "inversep" wrap))
+	 (ipw                      (app "<" (app inversep ">")))
+	 (not-ipw                  (app "<not-" (app inversep ">")))
+	 (inversep<f>              (mksym inversep in-package))
+
+	 (all<inversep<f>>     (mksym (app "all" ipw) in-package))
+	 (exists<inversep<f>>  (mksym (app "exists" ipw) in-package))
+	 (find<inversep<f>>    (mksym (app "find" ipw) in-package))
+	 (filter<inversep<f>>  (mksym (app "filter" ipw) in-package))
+	 (all-list<inversep<f>>     (mksym (app "all-list" ipw) in-package))
+	 (exists-list<inversep<f>>  (mksym (app "exists-list" ipw) in-package))
+	 (find-list<inversep<f>>    (mksym (app "find-list" ipw) in-package))
+	 (filter-list<inversep<f>>  (mksym (app "filter-list" ipw) in-package))
+
+	 (all<not-inversep<f>>     (mksym (app "all" not-ipw) in-package))
+	 (exists<not-inversep<f>>  (mksym (app "exists" not-ipw) in-package))
+	 (find<not-inversep<f>>    (mksym (app "find" not-ipw) in-package))
+	 (filter<not-inversep<f>>  (mksym (app "filter" not-ipw) in-package))
+	 (all-list<not-inversep<f>>     (mksym (app "all-list" not-ipw) in-package))
+	 (exists-list<not-inversep<f>>  (mksym (app "exists-list" not-ipw) in-package))
+	 (find-list<not-inversep<f>>    (mksym (app "find-list" not-ipw) in-package))
+	 (filter-list<not-inversep<f>>  (mksym (app "filter-list" not-ipw) in-package))
+
+
+	 (subs `(((transform ?x) (,name ?x ,@extra-args))
+		 ((map ?x) (,map<f> ?x ,@extra-args))
+		 ((map-list ?x) (,map-list<f> ?x ,@extra-args))
+		 ((inversep ?a ?b) (,inversep<f> ?a ?b ,@extra-args))
+
+		 ((all<inversep> ?a ?b)    (,all<inversep<f>> ?a ?b ,@extra-args))
+		 ((exists<inversep> ?a ?b) (,exists<inversep<f>> ?a ?b ,@extra-args))
+		 ((find<inversep> ?a ?b)   (,find<inversep<f>> ?a ?b ,@extra-args))
+		 ((filter<inversep> ?a ?b) (,filter<inversep<f>> ?a ?b ,@extra-args))
+
+		 ((all-list<inversep> ?a ?b)    (,all-list<inversep<f>> ?a ?b ,@extra-args))
+		 ((exists-list<inversep> ?a ?b) (,exists-list<inversep<f>> ?a ?b ,@extra-args))
+		 ((find-list<inversep> ?a ?b)   (,find-list<inversep<f>> ?a ?b ,@extra-args))
+		 ((filter-list<inversep> ?a ?b) (,filter-list<inversep<f>> ?a ?b ,@extra-args))
+
+		 ((all<not-inversep> ?a ?b)    (,all<not-inversep<f>> ?a ?b ,@extra-args))
+		 ((exists<not-inversep> ?a ?b) (,exists<not-inversep<f>> ?a ?b ,@extra-args))
+		 ((find<not-inversep> ?a ?b)   (,find<not-inversep<f>> ?a ?b ,@extra-args))
+		 ((filter<not-inversep> ?a ?b) (,filter<not-inversep<f>> ?a ?b ,@extra-args))
+
+		 ((all-list<not-inversep> ?a ?b)    (,all-list<not-inversep<f>> ?a ?b ,@extra-args))
+		 ((exists-list<not-inversep> ?a ?b) (,exists-list<not-inversep<f>> ?a ?b ,@extra-args))
+		 ((find-list<not-inversep> ?a ?b)   (,find-list<not-inversep<f>> ?a ?b ,@extra-args))
+		 ((filter-list<not-inversep> ?a ?b) (,filter-list<not-inversep<f>> ?a ?b ,@extra-args))
+	 ))
+
+	 (theory<f>         (mksym (app "map-theory" wrap) in-package))
+	 (suffix            (mksym wrap in-package))
+	 (thm-names         (INSTANCE::defthm-names *map-theorems*))
+	 (thm-name-map      (INSTANCE::create-new-names thm-names suffix))
+	 (theory<f>-defthms (sublis thm-name-map thm-names))
+	 )
+
+  `(encapsulate ()
+
+		(instance-*map-functions*
+		 :subs ,(list* `((declare (xargs :guard (setp ?set)))
+				 (declare (xargs :guard (and (setp ?set)
+							     ,@set-guard
+							     ,@arg-guard))))
+			       `((declare (xargs :guard (true-listp ?list)))
+				 (declare (xargs :guard (and (true-listp ?list)
+							     ,@list-guard
+							     ,@arg-guard))))
+			       `((declare (xargs :guard t))
+				 (declare (xargs :guard (and ,@element-guard
+							     ,@arg-guard))))
+			       subs)
+		 :suffix ,name)
+
+		(quantify-predicate (,inversep<f> a b ,@extra-args)
+		 :in-package-of ,in-package
+		 :set-guard ,set-guard
+		 :list-guard ,list-guard
+		 :arg-guard ,arg-guard)
+
+		(instance-*map-theorems*
+		 :subs ,subs
+		 :suffix ,(mksym wrap in-package))
+
+		(verify-guards ,map<f>)
+
+		(deftheory ,theory<f>
+		  (union-theories
+		   (theory ',(mksym (app "theory" ipw) in-package))
+		   '(,map<f> ,map-list<f> ,inversep<f>
+	             ,@theory<f>-defthms)))
+
+		)))
+
+
+(defmacro map-function (function &key in-package-of
+				      set-guard
+				      list-guard
+				      element-guard
+				      arg-guard)
+  (map-function-fn function
+		   (if in-package-of in-package-of 'in)
+		   (standardize-to-package "?SET" '?set set-guard)
+		   (standardize-to-package "?LIST" '?list list-guard)
+		   (standardize-to-package "A" 'a element-guard)
+		   arg-guard
+		   ))
+
+
+(deftheory generic-map-theory
+  (union-theories (theory 'theory<inversep>)
+		  `(,@(INSTANCE::defthm-names *map-theorems*)
+		      map
+		      map-list
+		      inversep)))
+
+(in-theory (disable generic-map-theory))
+
+
diff -Nru acl2-6.2/books/std/osets/membership.lisp acl2-6.3/books/std/osets/membership.lisp
--- acl2-6.2/books/std/osets/membership.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/membership.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,882 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; membership.lisp
+;
+; This file introduces the notions of set membership and subset.  We also go
+; into an abstract argument which will form the basis for quantification, and
+; especially for pick-a-point and double containment proofs.
+;
+; At the end of this file, we will disable all of the theorems that pertain to
+; the order of elements, providing an entirely membership-based reasoning
+; environment for the outer level.
+
+(in-package "SETS")
+(include-book "primitives")
+(include-book "computed-hints")
+(set-verify-guards-eagerness 2)
+
+
+(defsection in
+  :parents (osets)
+  :short "@(call in) determines if @('a') is a member of the set @('X')."
+
+  :long "<p>The logical definition of @('in') makes no mention of the set
+order, except implicitly by the use of the set @(see primitives) like @(see
+head) and @(see tail).</p>
+
+<p>The :exec version just inlines the set primitives and does one level of loop
+unrolling.  On CCL, it seems to run about 2.6x faster on the following
+loop:</p>
+
+@({
+ ;; 4.703 sec logic, 1.811 sec exec
+ (let ((big-set (loop for i from 1 to 100000 collect i)))
+   (gc$)
+   (time (loop for i fixnum from 1 to 30000 do (sets::in i big-set))))
+})
+
+<p>There are other ways we could optimize @('in').  Since the set is ordered,
+we could try to use the set order @(see <<) to stop early when we ran into an
+element that is larger than the one we are looking for.  For instance, when
+looking for 1 in the set '(2 3 4), we know that since @('1 << 2') that @('1')
+cannot be a member of this set.</p>
+
+<p>The simplest way to do this is to use @('<<') at every element.  But set
+order comparisons can be very expensive, especially when sets contain large
+cons structures.  So while it is easy to contrive situations where exploiting
+the order would be advantageous, like</p>
+
+@({
+ (in 1 '(2 3 4 .... 100000))
+})
+
+<p>where we could return instantly, there are also times where it would be
+slower.  For instance, on</p>
+
+@({
+ (in 100001 '(1 2 3 4 ... 100000))
+})
+
+<p>we would incur the extra cost of 100,000 calls to @('<<').</p>
+
+<p>For this reason, we do not currently implement any short-circuiting.  The
+reasoning is:</p>
+
+<ul>
+
+<li>it is not clear which would be faster in all cases,</li>
+
+<li>it is not clear what the typical usage behavior of @('in') is, so even if
+we wanted to benchmark alternate implementations, it may be hard to come up
+with the right benchmarking suite</li>
+
+<li>both solutions are O(n) anyway, and @('in') isn't a function that should
+probably be used in any kind of loop so its performance shouldn't be especially
+critical to anything</li>
+
+<li>the current method is arguably no less efficient than an unordered
+implementation.</li>
+
+</ul>
+
+<p>Future note.  In principle membership in an ordered list might be done in
+@('O(log_2 n)').  We are considering using a <i>galloping</i> membership check
+in the future to obtain something along these lines.</p>"
+
+  (defun in (a X)
+    (declare (xargs :guard (setp X)
+                    :verify-guards nil))
+    (mbe :logic
+         (and (not (empty X))
+              (or (equal a (head X))
+                  (in a (tail X))))
+         :exec
+         (and x
+              (or (equal a (car x))
+                  (and (cdr x)
+                       (or (equal a (cadr x))
+                           (in a (cddr x))))))))
+
+  (verify-guards in
+    :hints(("Goal" :in-theory (enable (:ruleset primitive-rules)))))
+
+  (defthm in-type
+    (or (equal (in a X) t)
+        (equal (in a X) nil))
+    :rule-classes :type-prescription)
+
+  (encapsulate ()
+
+    (local (defthm head-not-whole
+             (implies (not (empty X))
+                      (not (equal (head X) X)))
+             :hints(("Goal" :in-theory (enable (:ruleset primitive-rules))))))
+
+    (local (defthm lemma
+             (implies (> (acl2-count x) (acl2-count y))
+                      (not (in x y)))))
+
+    (defthm not-in-self
+      (not (in x x))))
+
+  (defthm in-sfix-cancel
+    (equal (in a (sfix X))
+           (in a X)))
+
+  (defthm never-in-empty
+    (implies (empty X)
+             (not (in a X))))
+
+  (defthm in-set
+    (implies (in a X)
+             (setp X)))
+
+  (defthm in-tail
+    (implies (in a (tail X))
+             (in a X)))
+
+  (defthm in-tail-or-head
+    (implies (and (in a X)
+                  (not (in a (tail X))))
+             (equal (head X) a)))
+
+  (defthm in-head
+    ;; BOZO seems redundant with never-in-empty
+    (equal (in (head X) X)
+           (not (empty X)))))
+
+
+; We now begin to move away from set order.
+
+(defsection head-unique
+  :extension head
+
+  (local (defthm lemma
+	   (implies (and (not (empty X))
+			 (not (equal a (head X)))
+			 (not (<< a (head (tail X))))
+			 (<< a (head X)))
+		    (not (in a X)))
+	   :hints(("Goal"
+		   :in-theory (enable (:ruleset order-rules))
+		   :cases ((empty (tail X)))))))
+
+  (defthm head-minimal
+    (implies (<< a (head X))
+	     (not (in a X)))
+    :hints(("Goal"
+	    :in-theory (enable (:ruleset order-rules)))))
+
+  (defthm head-minimal-2
+    (implies (in a X)
+	     (not (<< a (head X)))))
+
+  (add-to-ruleset order-rules '(head-minimal head-minimal-2))
+
+
+  (local (defthm lemma2
+	   (implies (empty (tail X))
+		    (not (in (head X) (tail X))))))
+
+  (local (defthm lemma3
+	   (implies (not (empty (tail X)))
+		    (not (in (head X) (tail X))))
+	   :hints(("Goal" :in-theory (enable (:ruleset order-rules))))))
+
+  ;; This is an interesting theorem, which gives us a concept of uniqueness
+  ;; without using the set order to state it!
+
+  (defthm head-unique
+    (not (in (head X) (tail X)))
+    :hints(("Goal"
+	    :use ((:instance lemma2)
+		  (:instance lemma3))))))
+
+
+
+(defsection in-insert
+  :extension insert
+
+  (defthm insert-identity
+    (implies (in a X)
+             (equal (insert a X) X))
+    :hints(("Goal"
+            :in-theory (enable head-tail-same
+                               (:ruleset order-rules)))))
+
+  (defthm in-insert
+    (equal (in a (insert b X))
+           (or (in a X)
+               (equal a b)))
+    :hints(("Goal"
+            :in-theory (enable (:ruleset order-rules))
+            :induct (insert b X)))))
+
+
+
+(defsection weak-insert-induction
+  :parents (insert)
+  :short "Inducting over insert without exposing the set order."
+
+  :long "<p>When we want to insert an element into an ordered set, the set
+order obviously has to be involved so that we can decide where to put the new
+element.  Accordingly, the set order plays a role in the induction scheme that
+we get from @(see insert)'s definition.  This makes insert somewhat different
+than other set operations (membership, union, cardinality, etc.) that just use
+a simple @(see tail)-based induction, where the set order is already hidden by
+@('tail').</p>
+
+<p>When we are proving theorems about sets, we generally want to avoid thinking
+about the set order, but we sometimes need to induct over @('insert').  So,
+here we introduce a new induction scheme that allows us to induct over insert
+but hides the set order.  We disable the ordinary induction scheme that insert
+uses, and set up an induction hint so that @('weak-insert-induction') will
+automatically be used instead.</p>"
+
+  (defthm weak-insert-induction-helper-1
+    (implies (and (not (in a X))
+                  (not (equal (head (insert a X)) a)))
+             (equal (head (insert a X))
+                    (head X)))
+    :hints(("Goal" :in-theory (enable (:ruleset order-rules)))))
+
+  (defthm weak-insert-induction-helper-2
+    (implies (and (not (in a X))
+                  (not (equal (head (insert a X)) a)))
+             (equal (tail (insert a X))
+                    (insert a (tail X))))
+    :hints(("Goal" :in-theory (enable (:ruleset order-rules)))))
+
+  (defthm weak-insert-induction-helper-3
+    (implies (and (not (in a X))
+                  (equal (head (insert a X)) a))
+             (equal (tail (insert a X))
+                    (sfix X)))
+    :hints(("Goal" :in-theory (enable (:ruleset order-rules)))))
+
+  (defun weak-insert-induction (a X)
+    (declare (xargs :guard (setp X)))
+    (cond ((empty X) nil)
+          ((in a X) nil)
+          ((equal (head (insert a X)) a) nil)
+          (t (list (weak-insert-induction a (tail X))))))
+
+  (in-theory (disable (:induction insert)))
+
+  (defthm use-weak-insert-induction t
+    :rule-classes ((:induction
+                    :pattern (insert a X)
+                    :scheme (weak-insert-induction a X)))))
+
+
+
+(defsection subset
+  :parents (osets)
+  :short "@(call subset) determines if @('X') is a subset of @('Y')."
+
+  :long "<p>We use a logically simple definition, but using MBE we exploit the
+set order to implement a tail-recursive, linear subset check.</p>
+
+<p>The :exec version of fast-subset just inlines the set primitives and tweaks
+the way the order check is done.  It is about 3x faster than the :logic version
+of fast-subset on the following loop:</p>
+
+@({
+ ;; 3.83 sec logic, 1.24 seconds exec
+ (let ((x (loop for i from 1 to 1000 collect i)))
+   (gc$)
+   (time$ (loop for i fixnum from 1 to 100000 do (sets::subset x x))))
+})
+
+<p>In the future we may investigate developing a faster subset check based on
+galloping.</p>"
+
+  (defun fast-subset (X Y)
+    (declare (xargs :guard (and (setp X) (setp Y))
+                    :guard-hints(("Goal" :in-theory (enable (:ruleset primitive-rules) <<)))))
+    (mbe :logic
+         (cond ((empty X) t)
+               ((empty Y) nil)
+               ((<< (head X) (head Y)) nil)
+               ((equal (head X) (head Y)) (fast-subset (tail X) (tail Y)))
+               (t (fast-subset X (tail Y))))
+         :exec
+         (cond ((null X) t)
+               ((null Y) nil)
+               ((fast-lexorder (car X) (car Y))
+                (and (equal (car X) (car Y))
+                     (fast-subset (cdr X) (cdr Y))))
+               (t
+                (fast-subset X (cdr Y))))))
+
+  (defun subset (X Y)
+    (declare (xargs :guard (and (setp X) (setp Y))
+                    :verify-guards nil))
+    (mbe :logic
+         (if (empty X)
+                    t
+                  (and (in (head X) Y)
+                       (subset (tail X) Y)))
+         :exec (fast-subset X Y)))
+
+  (defthm subset-type
+    (or (equal (subset X Y) t)
+        (equal (subset X Y) nil))
+    :rule-classes :type-prescription)
+
+  (encapsulate ()
+
+    (local (defthmd lemma
+             (implies (not (in (head Y) X))
+                      (equal (subset X Y)
+                             (subset X (tail Y))))))
+
+    (local (defthm case-1
+             (implies (and (not (empty X))
+                           (not (empty Y))
+                           (not (<< (head X) (head Y)))
+                           (not (equal (head X) (head Y)))
+                           (implies (and (setp X) (setp (tail Y)))
+                                    (equal (fast-subset X (tail Y))
+                                           (subset X (tail Y)))))
+                      (implies (and (setp X) (setp Y))
+                               (equal (fast-subset X Y)
+                                      (subset X Y))))
+             :hints(("Goal" :in-theory (enable (:ruleset order-rules))
+                     :use (:instance lemma)))))
+
+    (local (defthm case-2
+             (implies (and (not (empty x))
+                           (not (empty y))
+                           (not (<< (head x) (head y)))
+                           (equal (head x) (head y))
+                           (implies (and (setp (tail x)) (setp (tail y)))
+                                    (equal (fast-subset (tail x) (tail y))
+                                           (subset (tail x) (tail y)))))
+                      (implies (and (setp x) (setp y))
+                               (equal (fast-subset x y)
+                                      (subset x y))))
+             :hints(("Goal" :in-theory (enable (:ruleset order-rules))
+                     :use (:instance lemma (X (tail X)))))))
+
+    (local (defthm fast-subset-equivalence
+             (implies (and (setp X) (setp Y))
+                      (equal (fast-subset X Y)
+                             (subset X Y)))
+             :hints(("Goal" :in-theory (enable (:ruleset order-rules))
+                     :induct (fast-subset X Y)))))
+
+    (verify-guards subset)))
+
+
+
+(defsection all-by-membership
+  :parents (osets)
+  :short "A way to quantify over sets."
+
+  :long "<p>@('all-by-membership') is a generic theorem that can be used to
+prove that a property holds of a set by showing that a related property holds
+of the set elements.</p>
+
+<p>The most important role of @('all-by-membership') is to allow for
+pick-a-point proofs of @(see subset).  That is, it allows us to show that
+@('(subset X Y)') holds by showing that every element of X satisfies @('(in a
+Y)').</p>
+
+<p>More generally, we could show that a set satisfies a predicate like
+@('integer-setp') because each of its elements satisfies @('integerp').</p>
+
+
+<h3>Pick-a-Point Proofs in ACL2</h3>
+
+<p>We begin by explaining how pick-a-point proofs of subset can be carried out.
+In traditional mathematics, @(see subset) is defined using quantification over
+members, e.g., as follows:</p>
+
+@({
+  (equal (subset X Y)
+         (forall a (implies (in a X) (in a Y))))
+})
+
+<p>This definition is very useful for <b>pick-a-point</b> proofs that some set
+@('X') is a subset of @('Y').  Such a proof begins by picking an arbitrary
+point @('a') that is a member of @('X').  Then, if we can show that @('a') must
+be a member of @('Y'), we have established @('(subset X Y)').</p>
+
+<p>These kinds of arguments are extremely useful, and we would like to be able
+to carry them out in ACL2 about osets.  But since ACL2 does not have explicit
+quantifiers, we cannot even write a theorem like this:</p>
+
+@({
+ (implies (forall a (implies (in a X) (in a Y)))
+          (subset X Y))
+})
+
+<p>But consider the contrapositive of this theorem:</p>
+
+@({
+ (implies (not (subset X Y))
+          (exists a (and (in a X) (not (in a Y)))))
+})
+
+<p>We <i>can</i> prove something like this, by writing an explicit function to
+search for an element of @('X') that is not an element of @('Y').  That is, we
+can prove:</p>
+
+@({
+ (implies (not (subset X Y))
+          (let ((a (find-witness X Y)))
+            (and (in a X)
+                 (not (in a Y)))))
+})
+
+<p>Once we prove the above, we still need to be able to \"reduce\" a proof of
+@('(subset X Y)') to a proof of @('(implies (in a X) (in a Y))').  While we
+can't do this with a direct rewrite rule, we can sort of fake it using
+functional instantiation.  As groundwork:</p>
+
+<ul>
+
+<li>Using @(see encapsulate), we introduce functions @('sub') and @('super')
+with the constraint that @({
+ (implies (in a (sub))
+          (in a (super)))
+})</li>
+
+<li>Using this constraint, we prove the generic theorem:
+@({
+ (subset (sub) (super))
+})</li>
+
+</ul>
+
+<p>Then, when we want to prove @('(subset X Y)') for some particular @('X') and
+@('Y'), we can functionally instantiate the generic theorem with</p>
+
+@({
+   sub   <-- (lambda () X)
+   super <-- (lambda () Y)
+})
+
+<p>And this allows us to prove @('(subset X Y)') as long as we can relieve the
+constraint, i.e., @('(implies (in a X) (in a Y))').</p>
+
+
+<h3>Generalizing Pick-a-Point Proofs</h3>
+
+<p>In earlier versions of the osets library, we used an explicit argument to
+reduce subset proofs to pick-a-point style membership arguments.  But we later
+generalized the approach to arbitrary predicates instead.</p>
+
+<p>First, notice that if you let the predicate @('(P a)') be defined as @('(in
+a Y)'), then @('(subset X Y)') is just</p>
+
+@({
+ (forall a, (implies (in a X) (P a)))
+})
+
+<p>Our generalization basically lets you reduce a proof of @('(P-setp X)') to a
+proof of @('(implies (in a X) (P a))'), for an arbitrary predicate @('P').
+This can be used to prove subset by just chooisng @('P') as described above,
+but it can also be used for many other ideas by just changing the meaning of
+@('P').  For instance, if @('P') is @(see integerp), then we can show that
+@('X') is an @('integer-setp') or similar.</p>
+
+<p>The mechanism is just an adaptation of that described in the previous
+section.</p>
+
+<ul>
+
+<li>We begin by introducing a completely arbitrary @('predicate').</li>
+
+<li>Based on @('predicate'), we introduce a new function, @('all'), which
+checks to see if every member in a set satisfies @('predicate').</li>
+
+<li>We set up an encapsulate which allows us to assume that some hypotheses are
+true and that any member of some set satisfies @('predicate').</li>
+
+</ul>
+
+<p>Finally, we prove @('all-by-membership'), which shows that under these
+assumptions, the set satisfies @('all').  This theorem can be functionally
+instantiated to reduce a proof of @('(all X)') to a proof of</p>
+
+@({
+  (implies (in a X) (P a))
+})"
+
+  (encapsulate
+    (((predicate *) => *))
+    (local (defun predicate (x) x)))
+
+  (defun all (set-for-all-reduction)
+    (declare (xargs :guard (setp set-for-all-reduction)))
+    (if (empty set-for-all-reduction)
+        t
+      (and (predicate (head set-for-all-reduction))
+           (all (tail set-for-all-reduction)))))
+
+  (encapsulate
+    (((all-hyps) => *)
+     ((all-set) => *))
+
+    (local (defun all-hyps () nil))
+    (local (defun all-set () nil))
+
+    (defthmd membership-constraint
+      (implies (all-hyps)
+               (implies (in arbitrary-element (all-set))
+                        (predicate arbitrary-element)))))
+
+  (local (defun find-not (X)
+           (declare (xargs :guard (setp X)))
+           (cond ((empty X) nil)
+                 ((not (predicate (head X))) (head X))
+                 (t (find-not (tail X))))))
+
+  (local (defthm lemma-find-not-is-a-witness
+           (implies (not (all x))
+                    (and (in (find-not x) x)
+                         (not (predicate (find-not x)))))))
+
+  (defthmd all-by-membership
+    (implies (all-hyps)
+             (all (all-set)))
+    :hints(("Goal"
+            :use (:instance membership-constraint
+                            (arbitrary-element (find-not (all-set))))))))
+
+
+
+(defsection pick-a-point-subset-strategy
+  :parents (osets)
+  :short "Automatic pick-a-point proofs of @(see subset)."
+
+  :long "<p>The rewrite rule @('pick-a-point-subset-strategy') tries to
+automatically reduce proof goals such as:</p>
+
+@({
+ (implies hyps
+          (subset X Y))
+})
+
+<p>To proofs of:</p>
+
+@({
+ (implies (and hyps (in a X))
+          (in a Y))
+})
+
+<p>The mechanism for doing this is somewhat elaborate: the rewrite rule
+replaces the @('(subset X Y)') with @('(subset-trigger X Y)').  This trigger is
+recognized by a computed hint, which then suggest proving the theorem via
+functional instantiation of @(see all-by-membership).</p>
+
+<p>The pick-a-point method is often a good way to prove subset relations.  On
+the other hand, this rule is very heavy-handed, and you may need to disable it
+if you do not want to use the pick-a-point method to solve your goal.</p>"
+
+  (defun subset-trigger (X Y)
+    (declare (xargs :guard (and (setp X) (setp Y))))
+    (subset X Y))
+
+  (defthm pick-a-point-subset-strategy
+    (implies (and (syntaxp (rewriting-goal-lit mfc state))
+                  (syntaxp (rewriting-conc-lit `(subset ,X ,Y) mfc state)))
+             (equal (subset X Y)
+                    (subset-trigger X Y))))
+
+  (in-theory (disable subset-trigger))
+
+  ;; BOZO replace all this stuff with witness-cp?
+  (COMPUTED-HINTS::automate-instantiation
+   :new-hint-name pick-a-point-subset-hint
+   :generic-theorem all-by-membership
+   :generic-predicate predicate
+   :generic-hyps all-hyps
+   :generic-collection all-set
+   :generic-collection-predicate all
+   :actual-collection-predicate subset
+   :actual-trigger subset-trigger
+   :predicate-rewrite (((predicate ?x ?y) (in ?x ?y)))
+   :tagging-theorem pick-a-point-subset-strategy))
+
+
+
+
+(defsection subset-theorems
+  :extension subset
+
+  (defthm subset-sfix-cancel-X
+    (equal (subset (sfix X) Y)
+           (subset X Y)))
+
+  (defthm subset-sfix-cancel-Y
+    (equal (subset X (sfix Y))
+           (subset X Y)))
+
+  (defthm empty-subset
+    (implies (empty X)
+             (subset X Y)))
+
+  (defthm empty-subset-2
+    (implies (empty Y)
+             (equal (subset X Y)
+                    (empty X))))
+
+  (defthm subset-in
+    (and (implies (and (subset X Y)
+                       (in a X))
+                  (in a Y))
+         (implies (and (in a X)
+                       (subset X Y))
+                  (in a Y))))
+
+  (defthm subset-in-2
+    (and (implies (and (subset X Y)
+                       (not (in a Y)))
+                  (not (in a X)))
+         (implies (and (not (in a Y))
+                       (subset X Y))
+                  (not (in a X)))))
+
+  (encapsulate
+    ()
+    (local (defthm l0
+             (equal (subset (insert a nil) Y)
+                    (in a Y))
+             :hints(("Goal" :in-theory (enable (:ruleset primitive-rules))))))
+
+    (defthm subset-insert-X
+      (equal (subset (insert a X) Y)
+             (and (subset X Y)
+                  (in a Y)))
+      :hints(("Goal" :induct (insert a X)))))
+
+  (defthm subset-reflexive
+    (subset X X))
+
+  (defthm subset-transitive
+    (and (implies (and (subset X Y)
+                       (subset Y Z))
+                  (subset X Z))
+         (implies (and (subset Y Z)
+                       (subset X Y))
+                  (subset X Z))))
+
+  (defthm subset-membership-tail
+    (implies (and (subset X Y)
+                  (in a (tail X)))
+             (in a (tail Y)))
+    :hints(("Goal" :in-theory (enable (:ruleset order-rules)))))
+
+  (defthm subset-membership-tail-2
+    (implies (and (subset X Y)
+                  (not (in a (tail Y))))
+             (not (in a (tail X))))
+    :hints(("Goal" :in-theory (disable subset-membership-tail)
+            :use (:instance subset-membership-tail))))
+
+  (defthm subset-insert
+    (subset X (insert a X)))
+
+  (defthm subset-tail
+    (subset (tail X) X)
+    :rule-classes ((:rewrite)
+                   (:forward-chaining :trigger-terms ((tail x))))))
+
+
+
+
+(defsection double-containment
+  :parents (osets)
+  :short "A strategy for proving sets are equal because they are subsets
+of one another."
+
+  :long "<p>Double containment can be a good way to prove that two sets are
+equal to one another.</p>
+
+<p>Unfortunately, because this rule targets @('equal') it can get quite
+expensive.  You may sometimes wish to disable it to speed up your proofs, as
+directed by @(see accumulated-persistence).</p>"
+
+; The general argument is the following:
+;
+; Suppose that we have two sets which are subsets of one another, i.e. (subset
+; X Y) and (subset Y X) are true.  First, we will show that (head X) = (head
+; Y).  Next we will show that (in a (tail X)) implies that (in a (tail Y)).
+; This fact is then used for a sub- set by membership argument to show that
+; (tail X) = (tail Y).  Now, (head X) = (head Y) and (tail X) = (tail Y) can be
+; used together to show that X = Y (see primitives.lisp, head-tail-same) so we
+; are done.
+
+; Here are the details.  First we show that the heads are the same:
+
+  (local (defthmd double-containment-lemma-head
+	   (implies (and (subset X Y)
+			 (subset Y X))
+		    (equal (head X) (head Y)))
+	   :hints(("Goal" :in-theory (enable (:ruleset order-rules))))))
+
+
+; Next we show that (tail X) is a subset of (tail Y), using a subset by
+; membership argument:
+
+  (local (defthmd in-tail-expand
+	   (equal (in a (tail X))
+		  (and (in a X)
+		       (not (equal a (head X)))))))
+
+  (local (defthmd double-containment-lemma-in-tail
+	   (implies (and (subset X Y)
+			 (subset Y X))
+		    (implies (in a (tail X))   ; could be "equal" instead,
+			     (in a (tail Y)))) ; but that makes loops.
+	   :hints(("Goal"
+		   :in-theory (enable (:ruleset order-rules))
+		   :use ((:instance in-tail-expand (a a) (X X))
+			 (:instance in-tail-expand (a a) (X Y)))))))
+
+  (local (defthmd double-containment-lemma-tail
+	   (implies (and (subset X Y)
+			 (subset Y X))
+		    (subset (tail X) (tail Y)))
+	   :hints(("Goal" :in-theory (enable double-containment-lemma-in-tail)))))
+
+; Finally, we are ready to show that double containment is equality.  To do
+; this, we need to induct in such a way that we consider the tails of X and Y.
+; Then, we will use our fact that about the tails being subsets of one another
+; in the inductive case.
+
+  (local (defun double-tail-induction (X Y)
+	   (declare (xargs :guard (and (setp X) (setp Y))))
+	   (if (or (empty X) (empty Y))
+	       (list X Y)
+	     (double-tail-induction (tail X) (tail Y)))))
+
+  (local (defthm double-containment-is-equality-lemma
+	   (IMPLIES (AND (NOT (OR (EMPTY X) (EMPTY Y)))
+			 (IMPLIES (AND (SUBSET (TAIL X) (TAIL Y))
+				       (SUBSET (TAIL Y) (TAIL X)))
+				  (EQUAL (EQUAL (TAIL X) (TAIL Y)) T))
+			 (SETP X)
+			 (SETP Y)
+			 (SUBSET X Y)
+			 (SUBSET Y X))
+		    (EQUAL (EQUAL X Y) T))
+	   :hints(("Goal"
+                   :in-theory (enable head-tail-same)
+		   :use ((:instance double-containment-lemma-tail
+				    (X X) (Y Y))
+			 (:instance double-containment-lemma-tail
+				    (X Y) (Y X))
+			 (:instance double-containment-lemma-head
+				    (X X) (Y Y)))))))
+
+  (local (defthmd double-containment-is-equality
+	   (implies (and (setp X)
+			 (setp Y)
+			 (subset X Y)
+			 (subset Y X))
+		    (equal (equal X Y) t))
+	   :hints(("Goal"
+                   :in-theory (enable head-tail-same)
+                   :induct (double-tail-induction X Y)))))
+
+  (defthm double-containment
+    ;; I added backchain limits to this because targetting equal is so expensive.
+    ;; Even so it is possibly very expensive.
+    (implies (and (setp X)
+		  (setp Y))
+	     (equal (equal X Y)
+		    (and (subset X Y)
+			 (subset Y X))))
+    :rule-classes ((:rewrite :backchain-limit-lst 1))
+    :hints(("Goal" :use (:instance double-containment-is-equality)))))
+
+
+; We are now done with the membership level.  We disable all of the order based
+; reasoning that we introduced here.
+
+(in-theory (disable head-minimal head-minimal-2))
+
+
+
+
+
+
+;; [Jared] I moved a few things here from what used to be fast.lisp, so they can
+;; be shared across the new union/intersection/difference files
+
+; I've tried various approaches to exposing the set order.  My current strategy
+; is to open all primitives, convert IN to MEMBER, and convert SUBSET to
+; SUBSETP (list subset).  BOZO discuss the other, lifting approach.
+
+(encapsulate
+  ()
+  (local (in-theory (enable (:ruleset primitive-rules)
+                            (:ruleset order-rules))))
+
+  (defthm setp-of-cons
+    (equal (setp (cons a X))
+           (and (setp X)
+                (or (<< a (head X))
+                    (empty X)))))
+
+  (defthm in-to-member
+    (implies (setp X)
+             (equal (in a X)
+                    (if (member a x)
+                        t
+                      nil))))
+
+  (defthm not-member-when-smaller
+    (implies (and (<< a (car x))
+                  (setp x))
+             (not (member a x))))
+
+  (defthm subset-to-subsetp
+    (implies (and (setp x)
+                  (setp y))
+             (equal (subset x y)
+                    (subsetp x y))))
+
+  (defthm lexorder-<<-equiv
+    ;; This lets us optimize << into just lexorder when we've already
+    ;; checked equality.
+    (implies (not (equal a b))
+             (equal (equal (<< a b) (lexorder a b))
+                    t))
+    :hints(("Goal" :in-theory (enable <<)))))
+
+(def-ruleset low-level-rules
+  '(setp-of-cons
+    in-to-member
+    not-member-when-smaller
+    subset-to-subsetp
+    lexorder-<<-equiv
+    (:ruleset primitive-rules)
+    (:ruleset order-rules)))
+
+(in-theory (disable (:ruleset low-level-rules)))
+
+
+
+; These fast versions recur on one or both of their arguments, but not always
+; the same argument.  Hence, we need to introduce a more flexible measure to
+; prove that they terminate.  Fortunately, this is still relatively simple:
+
+(defun fast-measure (X Y)
+  (+ (acl2-count X) (acl2-count Y)))
diff -Nru acl2-6.2/books/std/osets/outer.lisp acl2-6.3/books/std/osets/outer.lisp
--- acl2-6.2/books/std/osets/outer.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/outer.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,130 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; outer.lisp
+;
+; Theorems relating the more complicated set operations (union, intersect,
+; etc.)  to one another.
+
+(in-package "SETS")
+(include-book "delete")
+(include-book "union")
+(include-book "intersect")
+(include-book "difference")
+(include-book "cardinality")
+(set-verify-guards-eagerness 2)
+
+
+(defthm union-delete-X
+    (equal (union (delete a X) Y)
+           (if (in a Y)
+               (union X Y)
+             (delete a (union X Y)))))
+
+(defthm union-delete-Y
+    (equal (union X (delete a Y))
+           (if (in a X)
+               (union X Y)
+             (delete a (union X Y)))))
+
+
+(defthm intersect-delete-X
+  (equal (intersect (delete a X) Y)
+         (delete a (intersect X Y))))
+
+(defthm intersect-delete-Y
+  (equal (intersect X (delete a Y))
+         (delete a (intersect X Y))))
+
+(defthm union-over-intersect
+  (equal (union X (intersect Y Z))
+         (intersect (union X Y) (union X Z))))
+
+(defthm intersect-over-union
+  (equal (intersect X (union Y Z))
+         (union (intersect X Y) (intersect X Z))))
+
+
+(defthm difference-over-union
+  (equal (difference X (union Y Z))
+         (intersect (difference X Y) (difference X Z))))
+
+(defthm difference-over-intersect
+  (equal (difference X (intersect Y Z))
+         (union (difference X Y) (difference X Z))))
+
+(defthm difference-delete-X
+  (equal (difference (delete a X) Y)
+         (delete a (difference X Y))))
+
+(defthm difference-delete-Y
+  (equal (difference X (delete a Y))
+         (if (in a X)
+             (insert a (difference X Y))
+           (difference X Y))))
+
+(defthm difference-insert-Y
+  (equal (difference X (insert a Y))
+         (delete a (difference X Y))))
+
+
+(defthm intersect-cardinality-X
+  (<= (cardinality (intersect X Y))
+      (cardinality X))
+  :rule-classes (:rewrite :linear))
+
+(defthm intersect-cardinality-Y
+  (<= (cardinality (intersect X Y))
+      (cardinality Y))
+  :rule-classes (:rewrite :linear))
+
+
+; There are also some interesting properties about cardinality which are more
+; precise.
+
+(defthm expand-cardinality-of-union
+  ;; This is pretty questionable -- it used to also be a :linear rule, but that was
+  ;; really expensive.
+  (equal (cardinality (union X Y))
+         (- (+ (cardinality X) (cardinality Y))
+            (cardinality (intersect X Y)))))
+
+(defthm expand-cardinality-of-difference
+  ;; Also questionable, also used to be :linear
+  (equal (cardinality (difference X Y))
+         (- (cardinality X)
+            (cardinality (intersect X Y)))))
+
+;; We used to have this rule, but it was silly -- (intersect X Y) can just rewrite to
+;; (SFIX X) when X is a subset of Y.
+;; (defthm intersect-cardinality-subset
+;;     (implies (subset X Y)
+;;              (equal (cardinality (intersect X Y))
+;;                     (cardinality X))))
+
+(defthmd intersect-cardinality-non-subset
+  (implies (not (subset x y))
+           (< (cardinality (intersect x y))
+              (cardinality x)))
+  :rule-classes (:rewrite :linear))
+
+(defthmd intersect-cardinality-subset-2
+  (equal (equal (cardinality (intersect X Y))
+                (cardinality X))
+         (subset X Y)))
+
+(defthmd intersect-cardinality-non-subset-2
+  (equal (< (cardinality (intersect x y))
+            (cardinality x))
+         (not (subset x y))))
diff -Nru acl2-6.2/books/std/osets/package.lsp acl2-6.3/books/std/osets/package.lsp
--- acl2-6.2/books/std/osets/package.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/package.lsp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,87 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "ACL2")
+
+(defpkg "INSTANCE"
+  (union-eq *acl2-exports*
+            *common-lisp-symbols-from-main-lisp-package*))
+
+
+(defpkg "COMPUTED-HINTS"
+  (union-eq '(mfc-ancestors
+	      mfc-clause
+	      string-for-tilde-@-clause-id-phrase
+	      INSTANCE::instance-rewrite)
+            *acl2-exports*
+            *common-lisp-symbols-from-main-lisp-package*))
+
+(defpkg "SETS"
+  (set-difference-equal
+   (union-eq '(defsection
+               defxdoc
+               definline
+               definlined
+               lexorder
+               lnfix
+               <<
+               <<-irreflexive
+               <<-transitive
+               <<-asymmetric
+               <<-trichotomy
+               <<-implies-lexorder
+               fast-<<
+               fast-lexorder
+               COMPUTED-HINTS::rewriting-goal-lit
+               COMPUTED-HINTS::rewriting-conc-lit
+               def-ruleset
+               def-ruleset!
+               add-to-ruleset
+               ;; To make Sets::Osets print as just Osets in the XDOC index
+               osets
+               ;; For similar nice-documentation reasons
+               std)
+             *acl2-exports*
+             *common-lisp-symbols-from-main-lisp-package*)
+
+; [Changed by Matt K. to handle changes to member, assoc, etc. after ACL2 4.2
+;  (intersectp was added to *acl2-exports*).]
+
+   '(union delete find map intersectp
+           enable disable e/d)))
+
+#!SETS
+(defconst *sets-exports*
+  ;; This just contains the user-level set functions, and a couple of theroems
+  ;; that frequently need to be enabled/disabled.
+  '(<<
+    setp
+    empty
+    sfix
+    head
+    tail
+    insert
+    in
+    subset
+    delete
+    union
+    intersect
+    ;; intersectp -- we leave this out because of the existing ACL2 function
+    ;; called intersectp.
+    difference
+    cardinality
+    mergesort
+    ;; A couple of theorems that frequently need to be enabled/disabled.
+    double-containment
+    pick-a-point-subset-strategy
+    ))
diff -Nru acl2-6.2/books/std/osets/portcullis.acl2 acl2-6.3/books/std/osets/portcullis.acl2
--- acl2-6.2/books/std/osets/portcullis.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/portcullis.acl2	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,16 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "ACL2")
+(ld "package.lsp")
+
diff -Nru acl2-6.2/books/std/osets/portcullis.lisp acl2-6.3/books/std/osets/portcullis.lisp
--- acl2-6.2/books/std/osets/portcullis.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/portcullis.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,27 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "SETS")
+
+; These allow SETS:: versions of enable, disable, and e/d to use rulesets
+; natively.
+
+(defmacro enable (&rest args)
+  `(acl2::enable* . ,args))
+
+(defmacro disable (&rest args)
+  `(acl2::disable* . ,args))
+
+(defmacro e/d (&rest args)
+  `(acl2::e/d* . ,args))
+
diff -Nru acl2-6.2/books/std/osets/primitives.lisp acl2-6.3/books/std/osets/primitives.lisp
--- acl2-6.2/books/std/osets/primitives.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/primitives.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,543 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; primitives.lisp - setp, sfix, head, tail, etc.
+
+(in-package "SETS")
+(include-book "misc/total-order" :dir :system)
+(include-book "tools/rulesets" :dir :system)
+(include-book "xdoc/top" :dir :system)
+(set-verify-guards-eagerness 2)
+
+
+(defxdoc primitives
+  :parents (osets)
+  :short "Replacements for @('car'), @('cdr'), etc., that respect the
+<i>non-set convention</i>."
+
+  :long "<p>Since the osets library uses ordered lists as the underlying
+representation of sets, at some point we have to use <b>list
+primitives</b> (car, cdr, endp, cons) to operate on sets.  A problem with using
+these functions directly is that they do not follow the non-set convention.</p>
+
+<p>The <b>non-set convention</b> is: set operations should treat improper
+sets (i.e., non-@('nil') atoms and lists that have duplicated or mis-ordered
+elements) as the empty set.  We adopt this convention throughout the library.
+It allows most of our rewrite rules to have no @(see setp) hypotheses.</p>
+
+<p>The primitive list functions do follow the non-set convention.  For
+instance:</p>
+
+<ul>
+ <li>@('(car '(1 1 1)) = 1'),            but @('(car nil) = nil')</li>
+ <li>@('(cdr '(1 1 1)) = (1 1)'),        but @('(cdr nil) = nil')</li>
+ <li>@('(cons 1 '(1 1 1)) = (1 1 1 1)'), but @('(cons 1 nil) = (1)')</li>
+ <li>@('(endp '(1 1 1)) = nil'),         but @('(endp nil) = t')</li>
+</ul>
+
+<p>These behaviors make it harder to reason about set operations that are
+written directly in terms of the list primitives.  When we try to do so, we
+usually have to do lots of work to consider all the cases about whether the
+inputs are ordered, etc.</p>
+
+<p>To solve lots of these problems, we introduce new <b>set primitives</b> that
+are mostly like the list primitives, except that they follow the non-set
+convention.  These primitives are:</p>
+
+<ul>
+ <li>@('(head X)') - the first element of a set, nil for non/empty sets</li>
+ <li>@('(tail X)') - all rest of the set, nil for non/empty sets</li>
+ <li>@('(insert a X)') - ordered insert of @('a') into @('X')</li>
+ <li>@('(empty X)') - recognizer for non/empty sets.</li>
+</ul>
+
+<p>The general idea is that set operations should be written in terms of these
+set primitives instead of the list primitives, and the definitions of the set
+primitives should be kept disabled to avoid having to reason about the low
+level structure of sets.</p>")
+
+
+(defsection setp
+  :parents (primitives)
+  :short "@(call setp) recognizes well-formed ordered sets."
+
+  :long "<p>A proper ordered set is a @(see true-listp) whose elements are
+fully ordered under @(see <<).  Note that this implicitly means that sets have
+no duplicate elements.</p>
+
+<p>Testing @('setp') is necessarily somewhat slow: we have to check that the
+elements are in order.  Its cost is linear in the size of @('n').</p>"
+
+  (defun setp (X)
+    (declare (xargs :guard t :verify-guards nil))
+    (if (atom X)
+        (null X)
+      (or (null (cdr X))
+          (and (consp (cdr X))
+               (fast-<< (car X) (cadr X))
+               (setp (cdr X))))))
+
+  (verify-guards setp
+    :hints(("Goal" :in-theory (enable <<))))
+
+  (defthm setp-type
+    (or (equal (setp X) t)
+        (equal (setp X) nil))
+    :rule-classes :type-prescription)
+
+  (defthm sets-are-true-lists
+    (implies (setp X)
+             (true-listp X))
+    :rule-classes ((:rewrite) (:compound-recognizer))))
+
+
+
+(defsection empty
+  :parents (primitives)
+  :short "@(call empty) recognizes empty sets."
+
+  :long "<p>This function is like @(see endp) for lists, but it respects the
+non-set convention and always returns true for ill-formed sets.</p>"
+
+  (defun empty (X)
+    (declare (xargs :guard (setp X)))
+    (mbe :logic (or (null X)
+                    (not (setp X)))
+         :exec  (null X)))
+
+  (defthm empty-type
+    (or (equal (empty X) t)
+        (equal (empty X) nil))
+    :rule-classes :type-prescription)
+
+  (defthm nonempty-means-set
+    (implies (not (empty X))
+             (setp X))))
+
+(defthm empty-set-unique
+  ;; BOZO probably expensive.  We don't export this from sets.lisp, and we keep
+  ;; it out of the docs above.
+  (implies (and (setp X)
+                (setp Y)
+                (empty X)
+                (empty Y))
+           (equal (equal X Y)
+                  t)))
+
+
+
+(defsection sfix
+  :parents (primitives)
+  :short "@(call sfix) is a fixing function for sets."
+
+  :long "<p>We return any proper @(see setp) unchanged, but coerce any
+non-@(see setp) into the empty set.</p>
+
+<p>This does for sets what functions like @(see nfix) or @(see rfix) do for
+numbers.  It is often useful to use @('sfix') in the base case of a set
+operation to ensure that an ordered set is always produced.</p>"
+
+  (defun sfix (X)
+    (declare (xargs :guard (setp X)))
+    (mbe :logic (if (empty X) nil X)
+         :exec  X))
+
+  (defthm sfix-produces-set
+    (setp (sfix X)))
+
+  (defthm sfix-set-identity
+    (implies (setp X)
+             (equal (sfix X)
+                    X)))
+
+  ;; I historically did this instead of sfix-when-empty, but now I think just
+  ;; rewriting it to NIL is a lot nicer.
+  ;;
+  ;; (defthm sfix-empty-same
+  ;;   (implies (and (empty X)
+  ;;                 (empty Y))
+  ;;            (equal (equal (sfix X) (sfix Y))
+  ;;                   t)))
+
+  (defthm sfix-when-empty
+    (implies (empty X)
+             (equal (sfix X)
+                    nil))))
+
+
+(defthm empty-sfix-cancel
+  (equal (empty (sfix X))
+         (empty X)))
+
+(xdoc::xdoc-extend empty "@(def empty-sfix-cancel)")
+
+
+
+(defsection head
+  :parents (primitives)
+  :short "@(call head) returns the smallest element in a set."
+
+  :long "<p>This is like @(see car), but respects the non-set convention and
+always returns @('nil') for ill-formed sets.</p>"
+
+  (defun head (X)
+    (declare (xargs :guard (and (setp X)
+                                (not (empty X)))))
+    (mbe :logic (car (sfix X))
+         :exec  (car X)))
+
+  (defthm head-count
+    (implies (not (empty X))
+             (< (acl2-count (head X)) (acl2-count X)))
+    :rule-classes ((:rewrite) (:linear)))
+
+  (defthm head-count-built-in
+    ;; BOZO probably should remove this
+    (implies (not (empty X))
+             (o< (acl2-count (head X)) (acl2-count X)))
+    :rule-classes :built-in-clause)
+
+  ;; I historically did this instead of head-when-empty, but now I think just
+  ;; rewriting it to NIL is a lot nicer.
+  ;;
+  ;; (defthm head-empty-same
+  ;;   (implies (and (empty X)
+  ;;                 (empty Y))
+  ;;            (equal (equal (head X) (head Y))
+  ;;                   t)))
+
+  (defthm head-when-empty
+    (implies (empty X)
+             (equal (head X)
+                    nil)))
+
+  (defthm head-sfix-cancel
+    (equal (head (sfix X))
+           (head X))))
+
+
+
+(defsection tail
+  :parents (primitives)
+  :short "@(call tail) returns the remainder of a set after removing its @(see
+head)."
+
+  :long "<p>This is like @(see cdr), but respects the non-set convention and
+always returns @('nil') for ill-formed sets.</p>"
+
+  (defun tail (X)
+    (declare (xargs :guard (and (setp X)
+                                (not (empty X)))))
+    (mbe :logic (cdr (sfix X))
+         :exec  (cdr X)))
+
+  (defthm tail-count
+    (implies (not (empty X))
+             (< (acl2-count (tail X)) (acl2-count X)))
+    :rule-classes ((:rewrite) (:linear)))
+
+  (defthm tail-count-built-in
+    ;; BOZO probably should remove this
+    (implies (not (empty X))
+             (o< (acl2-count (tail X)) (acl2-count X)))
+    :rule-classes :built-in-clause)
+
+  (defthm tail-produces-set
+    (setp (tail X)))
+
+  ;; I historically did this instead of tail-when-empty, but now I think just
+  ;; rewriting it to NIL is a lot nicer.
+  ;;
+  ;; (defthm tail-empty-same
+  ;;   (implies (and (empty X)
+  ;;                 (empty Y))
+  ;;            (equal (equal (tail X) (tail Y))
+  ;;                   t)))
+
+  ;; This was also subsumed by tail-when-empty:
+  ;;
+  ;; (defthm tail-preserves-empty
+  ;;   (implies (empty X)
+  ;;            (empty (tail X))))
+
+  (defthm tail-when-empty
+    (implies (empty X)
+             (equal (tail X)
+                    nil)))
+
+  (defthm tail-sfix-cancel
+    (equal (tail (sfix X))
+           (tail X))))
+
+
+(defthmd head-tail-same
+  ;; BOZO probably expensive
+  (implies (and (equal (head X) (head Y))
+                (equal (tail X) (tail Y))
+                (not (empty X))
+                (not (empty Y)))
+           (equal (equal X Y)
+                  t)))
+
+(defsection insert
+  :parents (primitives)
+  :short "@(call insert) adds the element @('a') to the set @('X')."
+
+  :long "<p>This is the fundamental set constructor.  It is similar to @(see
+cons) for lists, but of course performs an ordered insertion.  It respects the
+non-set convention and treats any ill-formed input as the empty set.</p>
+
+<p>Efficiency note.  Insert is @('O(n)').  It is very inefficient to call it
+repeatedly.  Instead, consider building sets with @(see mergesort) or out of
+other sets using @(see union).</p>
+
+<p>The :exec version just inlines the set primitives and does one level of loop
+unrolling.  On CCL, it runs about 1.65x faster than the :logic version on the
+following loop:</p>
+
+@({
+ ;; 1.92 seconds :logic, 1.16 seconds :exec
+ (let ((acc nil))
+  (gc$)
+  (time$ (loop for i fixnum from 1 to 10000 do
+               (setq acc (sets::insert i acc)))))
+})"
+
+  (local (in-theory (disable nonempty-means-set
+                             empty-set-unique
+                             head-when-empty
+                             tail-when-empty
+                             sfix-when-empty
+                             default-car
+                             default-cdr
+                             )))
+
+  (defun insert (a X)
+    (declare (xargs :guard (setp X)
+                    :verify-guards nil))
+    (mbe :logic
+         (cond ((empty X) (list a))
+               ((equal (head X) a) X)
+               ((<< a (head X)) (cons a X))
+               (t (cons (head X) (insert a (tail X)))))
+         :exec
+         (cond ((null X) (cons a nil))
+               ((equal (car X) a) X)
+               ((fast-lexorder a (car X)) (cons a X))
+               ((null (cdr X)) (cons (car X) (cons a nil)))
+               ((equal (cadr x) a) X)
+               ((fast-lexorder a (cadr X)) (cons (car X) (cons a (cdr X))))
+               (t (cons (car X) (cons (cadr X) (insert a (cddr X))))))))
+
+  (verify-guards insert
+    :hints(("Goal" :in-theory (e/d (<<)
+                                   (<<-trichotomy
+                                    <<-implies-lexorder)))))
+
+  (defthm insert-produces-set
+    (setp (insert a X)))
+
+  (defthm insert-sfix-cancel
+    (equal (insert a (sfix X))
+           (insert a X)))
+
+  (defthm insert-never-empty
+    (not (empty (insert a X))))
+
+  ;; I historically did this instead of insert-when-empty, but now I think that
+  ;; canonicalizing bad inserts into (insert a NIL) seems nicer.
+  ;;
+  ;; (defthm insert-empty-same
+  ;;   (implies (and (empty X)
+  ;;                 (empty Y))
+  ;;            (equal (equal (insert a X) (insert a Y))
+  ;;                   t)))
+
+  ;; The following also became unnecessary after switching to (insert a NIL).
+  ;;
+  ;; (defthm head-insert-empty
+  ;;   (implies (empty X)
+  ;;            (equal (head (insert a X)) a)))
+  ;;
+  ;; (defthm tail-insert-empty
+  ;;   (implies (empty X)
+  ;;  	      (empty (tail (insert a X)))))
+
+  (defthm insert-when-empty
+    (implies (and (syntaxp (not (equal X ''nil)))
+                  (empty X))
+             (equal (insert a X)
+                    (insert a nil))))
+
+  ;; These special cases can come up after insert-when-empty applies, so it's
+  ;; nice to have rules to target them.
+
+  (defthm head-of-insert-a-nil
+    (equal (head (insert a nil))
+           a))
+
+  (defthm tail-of-insert-a-nil
+    (equal (tail (insert a nil))
+           nil))
+
+  ;; Historic Note: We used to require that nil was "greater than" everything else
+  ;; in our order.  This had the advantage that the following theorems could have
+  ;; a combined case for (empty X) and (<< a (head X)).  Starting in Version 0.9,
+  ;; we remove this restriction in order to be more flexible about our order.
+
+  (defthm head-insert
+    (equal (head (insert a X))
+           (cond ((empty X) a)
+                 ((<< a (head X)) a)
+                 (t (head X)))))
+
+  (defthm tail-insert
+    (equal (tail (insert a X))
+           (cond ((empty X) (sfix X))
+                 ((<< a (head X)) (sfix X))
+                 ((equal a (head X)) (tail X))
+                 (t (insert a (tail X))))))
+
+  (encapsulate
+    ()
+    (local (defthm l0
+             (IMPLIES (AND (NOT (<< ACL2::Y ACL2::X))
+                           (NOT (EQUAL ACL2::X ACL2::Y)))
+                      (<< ACL2::X ACL2::Y))
+             :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+    (local (defthm l1
+             (IMPLIES (<< x y)
+                      (not (<< y x)))
+             :rule-classes ((:rewrite :backchain-limit-lst 0))))
+
+    (local (in-theory (disable sfix-set-identity
+                               insert-when-empty
+                               (:definition insert)
+                               <<-trichotomy
+                               <<-asymmetric)))
+
+    (local (defthm l2
+             (implies (and (<< b (car x))
+                           (setp x))
+                      (equal (cons b (insert (car x) x))
+                             (insert b (insert (car x) x))))
+             :rule-classes ((:rewrite :backchain-limit-lst 0))
+             :hints(("Goal" :expand ((:free (x) (insert b x)))))))
+
+    (local (defthm l3
+             (implies (and (<< b (car l))
+                           (not (equal b a))
+                           (not (<< a b)))
+                      (<< b (car (insert a l))))
+             :rule-classes ((:rewrite :backchain-limit-lst 0))
+             :hints(("goal" :expand (insert a l)))))
+
+    (local (in-theory (disable head-insert
+                               tail-insert)))
+
+    (defthm repeated-insert
+      (equal (insert a (insert a X))
+             (insert a X))
+      :hints(("Goal"
+              :induct t
+              :expand ((insert a nil)
+                       (insert a x)
+                       (insert (car x) x)
+                       (:free (k1 k2) (insert a (cons k1 k2)))))))
+
+    (defthm insert-insert
+      (equal (insert a (insert b X))
+             (insert b (insert a X)))
+      :rule-classes ((:rewrite :loop-stopper ((a b))))
+      :hints(("Goal"
+              :induct t
+              :expand ((insert a x)
+                       (insert b x)
+                       (:free (k1) (insert k1 nil))
+                       (:free (k1 k2 k3) (insert k1 (cons k2 k3))))))))
+
+  (defthm insert-head
+    (implies (not (empty X))
+             (equal (insert (head X) X)
+                    X)))
+
+  (defthm insert-head-tail
+    (implies (not (empty X))
+             (equal (insert (head X) (tail X))
+                    X)))
+
+
+
+  ;; Insert can be reasoned about in terms of induction, but its inductive case
+  ;; contains a call to "cons", and we cannot let that escape into the wild.
+  ;; Instead, we write a theorem to rephrase this cons into an insert.
+
+  (defthm insert-induction-case
+    (implies (and (not (<< a (head X)))
+                  (not (equal a (head X)))
+                  (not (empty X)))
+             (equal (insert (head X) (insert a (tail X)))
+                    (insert a X)))))
+
+
+
+;; The last thing we really need to do is reason about element order.  The
+;; following theorems are crucial for proofs in the membership level, which
+;; must stricly use induction and arguments about the set elements' order for
+;; proofs.  Since we are disabling all of the functions at the end of this
+;; book, these are the only facts which membership.lisp will be able to use.
+
+(defthm head-tail-order
+  (implies (not (empty (tail X)))
+           (<< (head X) (head (tail X)))))
+
+(defthm head-tail-order-contrapositive
+  (implies (not (<< (head X) (head (tail X))))
+           (empty (tail X))))
+
+(defthm head-not-head-tail
+  (implies (not (empty (tail X)))
+           (not (equal (head X) (head (tail X))))))
+
+
+
+; And that concludes the theorems we need about the primitive set functions.
+; Now we are interested in setting up theories and in disabling most of the
+; potentially bad issues that might arise.
+;
+; You should never need to use primitive-theory unless you are using non-set
+; functions, e.g. cons, to build sets.
+;
+; The primitive order theory is intended to be disabled for typical reasoning,
+; but is needed for some theorems in the membership level.
+
+(def-ruleset primitive-rules
+  '(setp empty head tail sfix insert))
+
+(def-ruleset order-rules
+  '(<<-irreflexive
+    <<-transitive
+    <<-asymmetric
+    <<-trichotomy
+    <<-implies-lexorder
+    (:induction insert)
+    insert-induction-case
+    head-insert
+    tail-insert
+    head-tail-order
+    head-tail-order-contrapositive))
+
+(in-theory (disable (:ruleset primitive-rules)
+                    (:ruleset order-rules)))
diff -Nru acl2-6.2/books/std/osets/quantify.lisp acl2-6.3/books/std/osets/quantify.lisp
--- acl2-6.2/books/std/osets/quantify.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/quantify.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,947 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; quantify.lisp
+;
+; This is an optional extension of the sets library, and is not included by
+; default when you run (include-book "top").
+;
+;
+; Constructive Quantification over Sets and Lists.
+;
+; We create the macro, quantify-predicate, which introduces the following
+; functions for any arbitrary predicate.
+;
+;     all<predicate>           all<not-predicate>
+;     exists<predicate>        exists<not-predicate>
+;     find<predicate>          find<not-predicate>
+;     filter<predicate>        filter<not-predicate>
+;
+;     all-list<predicate>      all-list<not-predicate>
+;     exists-list<predicate>   exists-list<not-predicate>
+;     find-list<predicate>     find-list<not-predicate>
+;     filter-list<predicate>   filter-list<not-predicate>
+;
+; In addition to introducing these functions, an entire rewriting strategy is
+; introduced for reasoning about these functions with respect to sets and
+; lists.
+;
+;
+; Introductory Examples.
+;
+; Here are some of the most simple examples.  All of these predicates have only
+; a single argument, and their guard is "t".
+;
+;     (SETS::quantify-predicate (integerp x))
+;     (SETS::quantify-predicate (symbolp x))
+;     (SETS::quantify-predicate (rationalp x))
+;     (SETS::quantify-predicate (natp x))
+;
+; Notice that you cannot use macros here.  For example, the following is an
+; error: (quantify-predicate (real/rationalp x)).  Once you have done the
+; above, you can now run these functions, e.g.,
+;
+;     (SETS::all<integerp> '(1 2 3)) = t
+;     (SETS::all<not-integerp> '(a b c)) = t
+;     (SETS::find<symbolp> '(1 2 3 a b c)) = a
+;
+;
+; Controlling Packages.
+;
+; As you can see, all of these functions are introduced in the SETS package by
+; default.  If you'd like them to be in a different place instead, you can
+; specify the :in-package-of argument and provide a symbol from some other
+; package.  For example, since defthm is in the ACL2 package, we might write:
+;
+;     (SETS::quantify-predicate (eqlablep x)
+;       :in-package-of defthm)
+;
+; And then the functions all<integerp>, all<not-integerp>, and so forth will be
+; in the ACL2 package instead of the LISTS package.
+;
+;
+; Multi-Argument Predicates.
+;
+; You can also quantify over predicates with many arguments.  As an example, we
+; introduce the function lessp as follows:
+;
+;     (defun lessp (a b)
+;       (declare (xargs :guard t))
+;       (< (rfix a) (rfix b)))
+;
+;     (quantify-predicate (lessp a b))
+;
+; We could now ask, is every element in a set less than some maximum value?
+; For example:
+;
+;     (all<lessp> '(1 2 3) 6) = t
+;     (all<lessp> '(1 2 3) 2) = nil
+;
+;
+; Supporting Guards.
+;
+; If efficiency is important, our predicate may have guards and we may want to
+; put guards on the introduced functions.  For example, we might write
+; fast-lessp below:
+;
+;     (defun fast-lessp (a b)
+;       (declare (xargs :guard (and (rationalp a)
+;                                   (rationalp b))))
+;       (< a b))
+;
+; Now we need to supply an extra :guard argument so that the guards of
+; all<fast-lessp>, exists<fast-lessp>, and so forth can be verified.
+;
+; When writing this guard, the list which all-list<fast-lessp> and so forth are
+; iterating over will be called ?list, and the set that all<fast-lessp> and so
+; forth are iterating over will be called ?set.  The other arguments will all
+; be named with whatever names you gave them when you ran quantify-predicate.
+; For example, below we name fast-lessp's second argument "max", so it will be
+; named "max" in our guards as well.
+;
+; Here's an example:
+;
+;     (in-package "ACL2")
+;
+;     (SETS::quantify-predicate (rationalp x)
+;       :in-package-of defthm)
+;
+;     (SETS::quantify-predicate (fast-lessp x max)
+;       :set-guard  ((all<rationalp> ?set))
+;       :list-guard ((all-list<rationalp> ?list))
+;       :arg-guard  ((rationalp max))
+;       :in-package-of defthm)
+;
+;
+;
+; Disabling the theory.
+;
+; Calling quantify-predicate will result in a lot of theorems being introduced.
+; You can disable all of these theorems by using the deftheory event
+; theory<predicate>.  For example,
+;
+;     (in-theory (disable theory<integerp>))
+;     (in-theory (disable theory<fast-lessp>))
+;
+; And so forth.
+
+(in-package "SETS")
+(include-book "top")
+(set-verify-guards-eagerness 2)
+
+
+
+; We introduce our theory as a constant so that we can derive new instances of
+; it for concrete predicates
+
+(defconst *positive-functions* '(
+
+; We introduce "list versions" of the functions so that we can reason through
+; mergesorts.
+
+  (defun all-list (x)
+    (declare (xargs :guard (true-listp x)))
+    (if (endp x)
+	t
+      (and (predicate (car x))
+	   (all-list (cdr x)))))
+
+  (defun exists-list (x)
+    (declare (xargs :guard (true-listp x)))
+    (cond ((endp x) nil)
+	  ((predicate (car x)) t)
+	  (t (exists-list (cdr x)))))
+
+  (defun find-list (x)
+    (declare (xargs :guard (true-listp x)))
+    (cond ((endp x) nil)
+	  ((predicate (car x)) (car x))
+	  (t (find-list (cdr x)))))
+
+  (defun filter-list (x)
+    (declare (xargs :guard (true-listp x)))
+    (cond ((endp x) nil)
+	  ((predicate (car x))
+	   (cons (car x) (filter-list (cdr x))))
+	  (t (filter-list (cdr x)))))
+
+
+; We also introduce "set versions" of the functions, so that we can reason
+; about sets.
+
+  (defun all (set-for-all-reduction)
+    (declare (xargs :guard (setp set-for-all-reduction)))
+    (if (empty set-for-all-reduction)
+	t
+      (and (predicate (head set-for-all-reduction))
+	   (all (tail set-for-all-reduction)))))
+
+  (defun exists (X)
+    (declare (xargs :guard (setp X)))
+    (cond ((empty X) nil)
+	  ((predicate (head X)) t)
+	  (t (exists (tail X)))))
+
+  (defun find (X)
+    (declare (xargs :guard (setp X)))
+    (cond ((empty X) nil)
+	  ((predicate (head X)) (head X))
+	  (t (find (tail X)))))
+
+  (defun filter (X)
+    (declare (xargs :guard (setp X)))
+    (declare (xargs :verify-guards nil))
+    (cond ((empty X) (sfix X))
+	  ((predicate (head X))
+	   (insert (head X) (filter (tail X))))
+	  (t (filter (tail X)))))
+
+  ))
+
+; We then create "negative" versions of the above functions by performing a set
+; of substitutions on the constants.
+
+(defconst *negative-functions*
+  (INSTANCE::instance-defuns *positive-functions*
+     '(((predicate ?x)   (not (predicate ?x)))
+       ((all ?x)         (all<not> ?x))
+       ((exists ?x)      (exists<not> ?x))
+       ((find ?x)        (find<not> ?x))
+       ((filter ?x)      (filter<not> ?x))
+       ((all-list ?x)    (all-list<not> ?x))
+       ((exists-list ?x) (exists-list<not> ?x))
+       ((find-list ?x)   (find-list<not> ?x))
+       ((filter-list ?x) (filter-list<not> ?x)))))
+
+
+; And then we smash together the positive and negative functions to create a
+; single function list which can be instantiated later.
+
+(defconst *functions*
+  (append *positive-functions* *negative-functions*))
+
+
+; Now we create the instance-*functions* macro which will allow us to actually
+; derive an instance of all of the functions
+
+(INSTANCE::instance *functions*)
+
+
+; And we call the macro with no arguments, to introduce a verbatim copy of the
+; theory.  In other words, we introduce the generic theory itself here.
+
+(instance-*functions*)
+
+
+(defconst *positive-theorems* '(
+
+; List Theory Reasoning
+;
+; We begin with several theorems about the "list versions" of the above
+; functions.
+
+  (defthm all-list-type
+    (or (equal (all-list x) t)
+	(equal (all-list x) nil))
+    :rule-classes :type-prescription)
+
+  (defthm all-list-cdr
+    (implies (all-list x)
+	     (all-list (cdr x))))
+
+  (defthm all-list-endp
+    (implies (endp x)
+	     (all-list x)))
+
+  (defthm all-list-member
+    (implies (and (all-list x)
+		  (member a x))
+	     (predicate a)))
+
+  (defthm all-list-in-2
+    (implies (and (all-list x)
+		  (not (predicate a)))
+	     (not (member a x))))
+
+  (defthm all-list-cons
+    (equal (all-list (cons a x))
+	   (and (predicate a)
+		(all-list x))))
+
+  (defthm all-list-append
+    (equal (all-list (append x y))
+	   (and (all-list x)
+		(all-list y))))
+
+  (defthm all-list-nth
+    (implies (and (all-list x)
+		  (<= 0 n)
+		  (< n (len x)))
+	     (predicate (nth n x))))
+
+  (encapsulate nil
+
+    (local (defthm lemma1
+	     (implies (and (all-list acc)
+			   (all-list x))
+		      (all-list (revappend x acc)))))
+
+    (local (defthm lemma2
+	     (implies (not (all-list acc))
+		      (not (all-list (revappend x acc))))))
+
+    (local (defthm lemma3
+	     (implies (and (all-list acc)
+			   (not (all-list x)))
+		      (not (all-list (revappend x acc))))))
+
+    (defthm all-list-revappend
+      (equal (all-list (revappend x acc))
+	     (and (all-list x)
+		  (all-list acc))))
+  )
+
+  (defthm all-list-reverse
+    (equal (all-list (reverse x))
+	   (all-list x)))
+
+  (defthm exists-list-elimination
+    (equal (exists-list x)
+	   (not (all-list<not> x))))
+
+  (defthm filter-list-true-list
+    (true-listp (filter-list x))
+    :rule-classes :type-prescription)
+
+  (defthm filter-list-membership
+    (iff (member a (filter-list x))
+         (and (predicate a)
+              (member a x))))
+
+  (defthm filter-list-all-list
+    (all-list (filter-list x)))
+
+
+
+
+
+
+; Set Theory Reasoning
+;
+; Of course, really we are more interested in reasoning about sets than lists.
+; We write several theorems about our set functions.
+
+  (defthm all-type
+    (or (equal (all X) t)
+	(equal (all X) nil))
+    :rule-classes :type-prescription)
+
+  (defthm all-sfix
+    (equal (all (sfix X))
+	   (all X)))
+
+  ;; TODO: extend to forward chaining.
+
+  (defthm all-tail
+    (implies (all X)
+	     (all (tail X))))
+
+  (defthm all-empty
+    (implies (empty X)
+	     (all X)))
+
+  (defthm all-in
+    (implies (and (all X)
+		  (in a X))
+	     (predicate a)))
+
+  (defthm all-in-2
+    (implies (and (all X)
+		  (not (predicate a)))
+	     (not (in a X))))
+
+  (defthm all-insert
+    (equal (all (insert a X))
+	   (and (predicate a)
+		(all X)))
+    :hints(("Goal" :induct (insert a X))))
+
+  (defthm all-delete
+    (implies (all X)
+	     (all (delete a X))))
+
+  (defthm all-delete-2
+    (implies (predicate a)
+	     (equal (all (delete a X))
+		    (all X))))
+
+  (defthm all-union
+    (equal (all (union X Y))
+	   (and (all X)
+		(all Y))))
+
+  (defthm all-intersect-X
+    (implies (all X)
+	     (all (intersect X Y))))
+
+  (defthm all-intersect-Y
+    (implies (all X)
+	     (all (intersect Y X))))
+
+  (defthm all-difference
+    (implies (all X)
+	     (all (difference X Y))))
+
+  (defthm all-difference-2
+    (implies (all Y)
+	     (equal (all (difference X Y))
+		    (all X))))
+
+
+  (defthm exists-elimination
+    (equal (exists X)
+	   (not (all<not> X))))
+
+
+  (defthm find-sfix
+    (equal (find (sfix X))
+	   (find X)))
+
+  (defthm find-witness
+    (implies (not (all X))
+	     (and (in (find<not> X) X)
+		  (not (predicate (find<not> X)))))
+    :rule-classes :forward-chaining)
+
+
+  (defthm filter-set
+    (setp (filter X)))
+
+  (defthm filter-sfix
+    (equal (filter (sfix X))
+	   (filter X)))
+
+  (defthm filter-in
+    (equal (in a (filter X))
+	   (and (predicate a)
+		(in a X)))
+    :hints(("Goal" :induct (filter X))))
+
+  (defthm filter-subset
+    (subset (filter X) X))
+
+  (defthm filter-all
+    (all (filter X)))
+
+  (defthm filter-all-2
+    (implies (all X)
+	     (equal (filter X) (sfix X)))
+    :hints(("Goal" :in-theory (disable double-containment))))
+
+
+
+
+; In order to reason past a mergesort, we need to provide some theorems that
+; tie together our list and set theories.  We begin this here.
+
+  (defthm all-mergesort
+    (equal (all (mergesort X))
+	   (all-list X)))
+
+  (defthm all-list-applied-to-set
+    (implies (setp X)
+	     (equal (all-list X)
+		    (all X)))
+    :hints(("Goal" :in-theory (enable setp empty sfix head tail))))
+
+))
+
+
+
+; Notice that the positive functions and the negative functions are symmetric.
+; We now invert the above theorem to create the corresponding theorems for the
+; negative functions.
+
+(defconst *negative-theorems*
+  (INSTANCE::instance-rewrite *positive-theorems*
+
+    ;; we first replace calls to "positive" functions with calls to temporary
+    ;; symbols, which simply acts as placeholders.
+
+   '(((predicate ?x)   (predicate-temp ?x))
+     ((all ?x)         (all-temp ?x))
+     ((exists ?x)      (exists-temp ?x))
+     ((find ?x)        (find-temp ?x))
+     ((filter ?x)      (filter-temp ?x))
+     ((all-list ?x)    (all-list-temp ?x))
+     ((exists-list ?x) (exists-list-temp ?x))
+     ((find-list ?x)   (find-list-temp ?x))
+     ((filter-list ?x) (filter-list-temp ?x))
+
+     ;; now we replace calls to "negative" functions with calls to positive
+     ;; functions.
+
+     ((not (predicate ?x))  (predicate ?x))
+     ((all<not> ?x)         (all ?x))
+     ((exists<not> ?x)      (exists ?x))
+     ((find<not> ?x)        (find ?x))
+     ((filter<not> ?x)      (filter ?x))
+     ((all-list<not> ?x)    (all-list ?x))
+     ((exists-list<not> ?x) (exists-list ?x))
+     ((find-list<not> ?x)   (find-list ?x))
+     ((filter-list<not> ?x) (filter-list ?x))
+
+     ;; and finally we replace our temporary placeholder symbols with calls to
+     ;; the actual negative functions.
+
+     ((predicate-temp ?x)   (not (predicate ?x)))
+     ((all-temp ?x)         (all<not> ?x))
+     ((exists-temp ?x)      (exists<not> ?x))
+     ((find-temp ?x)        (find<not> ?x))
+     ((filter-temp ?x)      (filter<not> ?x))
+     ((all-list-temp ?x)    (all-list<not> ?x))
+     ((exists-list-temp ?x) (exists-list<not> ?x))
+     ((find-list-temp ?x)   (find-list<not> ?x))
+     ((filter-list-temp ?x) (filter-list<not> ?x))
+)))
+
+
+; We now smash together the positive and negative theorems to form a single,
+; complete theory.  Note that we have to rename all of the defthms in
+; *negative-theorems* so that their names will not collide with the theorems in
+; *theorems*.
+
+(defconst *theorems*
+  (append *positive-theorems*
+	  (INSTANCE::rename-defthms *negative-theorems* '-not)))
+
+
+; As with the functions, we create a new macro which will allow us to derive
+; new instances of our theorems.
+
+(INSTANCE::instance *theorems*)
+
+
+; And as before, we call the resulting macro with no arguments, which gives us
+; a verbatim copy of the positive and negative theorems.
+
+(instance-*theorems*)
+
+
+
+
+
+
+
+; We already have an all-by-membership theorem set up for sets.  But, we would
+; like to have a corresponding theorem to use with lists.  We create that here.
+
+(encapsulate
+  (((all-list-hyps) => *)
+   ((all-list-list) => *))
+
+  (local (defun all-list-hyps () nil))
+  (local (defun all-list-list () nil))
+
+  (defthmd list-membership-constraint
+    (implies (all-list-hyps)
+             (implies (member arbitrary-element (all-list-list))
+                      (predicate arbitrary-element)))))
+
+(encapsulate ()
+
+  (local (defthm witness-lemma
+	   (implies (not (all-list x))
+		    (and (member (find-list<not> x) x)
+			 (not (predicate (find-list<not> x)))))))
+
+  (defthmd all-list-by-membership
+    (implies (all-list-hyps)
+	     (all-list (all-list-list)))
+    :hints(("Goal"
+	    :use (:instance list-membership-constraint
+		  (arbitrary-element (find-list<not> (all-list-list)))))))
+)
+
+
+
+(defconst *final-theorems* '(
+
+  (defthm cardinality-filter
+    (equal (cardinality X)
+	   (+ (cardinality (filter X))
+	      (cardinality (filter<not> X))))
+    :rule-classes :linear)
+
+  (defthm all-subset
+    (implies (and (all Y)
+		  (subset X Y))
+	     (all X))
+    :hints(("Goal"
+	    :use (:functional-instance all-by-membership
+		  (all-hyps (lambda () (and (all Y)
+					    (subset X Y))))
+		  (all-set  (lambda () X))))))
+
+  (defthm all-subset-not
+    (implies (and (all<not> Y)
+		  (subset X Y))
+	     (all<not> X))
+    :hints(("Goal"
+	    :use (:functional-instance all-by-membership
+		  (all-hyps  (lambda () (and (all<not> Y)
+				 	     (subset X Y))))
+		  (all-set   (lambda () X))
+		  (predicate (lambda (x) (not (predicate x))))
+		  (all       (lambda (x) (all<not> x)))))))
+
+))
+
+(INSTANCE::instance *final-theorems*)
+(instance-*final-theorems*)
+
+(verify-guards filter)
+(verify-guards filter<not>)
+
+
+
+
+; -------------------------------------------------------------------
+;
+;                   Instancing Concrete Theories
+;
+; -------------------------------------------------------------------
+
+; Each concrete theory we instantiate will require the introduction of 16 new
+; functions and a wealth of theorems.  We don't want to overburden the user
+; with having to instantiate all of these and give them names, so we adopt a
+; naming convention where the predicate's name is used to generate the names of
+; the new functions.  Of course, we still have to generate the new names.
+
+(defun mksym (name sym)
+  (declare (xargs :mode :program))
+  (intern-in-package-of-symbol (string-upcase name) sym))
+
+(defun app (x y)
+  (declare (xargs :mode :program))
+  (string-append x y))
+
+(defun ?ify (args)
+  (declare (xargs :mode :program))
+  (if (endp args)
+      nil
+    (cons (mksym (app "?" (symbol-name (car args)))
+		 (car args))
+	  (?ify (cdr args)))))
+
+(defun standardize-to-package (symbol-name replacement term)
+  (declare (xargs :mode :program))
+  (if (atom term)
+      (if (and (symbolp term)
+	       (equal (symbol-name term) symbol-name))
+	  replacement
+	term)
+    (cons (standardize-to-package symbol-name replacement (car term))
+	  (standardize-to-package symbol-name replacement (cdr term)))))
+
+
+(defun quantify-simple-predicate (predicate in-package
+			          set-guard list-guard arg-guard)
+  (declare (xargs :guard (symbolp in-package)
+		  :mode :program))
+  (let* ((name          (car predicate))
+	 (args          (cons '?x (cddr predicate)))
+	 (wrap          (app "<" (app (symbol-name name) ">")))
+	 (not-wrap      (app "<" (app "not-" (app (symbol-name name) ">"))))
+
+	 ;; First we build up all the symbols that we will use.
+
+	 (all<p>             (mksym (app "all" wrap) in-package))
+	 (exists<p>          (mksym (app "exists" wrap) in-package))
+	 (find<p>            (mksym (app "find" wrap) in-package))
+	 (filter<p>          (mksym (app "filter" wrap) in-package))
+	 (all<not-p>         (mksym (app "all" not-wrap) in-package))
+	 (exists<not-p>      (mksym (app "exists" not-wrap) in-package))
+	 (find<not-p>        (mksym (app "find" not-wrap) in-package))
+	 (filter<not-p>      (mksym (app "filter" not-wrap) in-package))
+	 (all-list<p>        (mksym (app "all-list" wrap) in-package))
+	 (exists-list<p>     (mksym (app "exists-list" wrap) in-package))
+	 (find-list<p>       (mksym (app "find-list" wrap) in-package))
+	 (filter-list<p>     (mksym (app "filter-list" wrap) in-package))
+	 (all-list<not-p>    (mksym (app "all-list" not-wrap) in-package))
+	 (exists-list<not-p> (mksym (app "exists-list" not-wrap) in-package))
+	 (find-list<not-p>   (mksym (app "find-list" not-wrap) in-package))
+	 (filter-list<not-p> (mksym (app "filter-list" not-wrap) in-package))
+
+	 ;; And we create a substitution list, to instantiate the generic
+	 ;; theory/functions with their new, concrete values.
+
+	 (subs `(((predicate ?x)        (,name ,@args))
+		 ((all ?x)              (,all<p> ,@args))
+		 ((exists ?x)           (,exists<p> ,@args))
+		 ((find ?x)             (,find<p> ,@args))
+		 ((filter ?x)           (,filter<p> ,@args))
+		 ((all<not> ?x)         (,all<not-p> ,@args))
+		 ((exists<not> ?x)      (,exists<not-p> ,@args))
+		 ((find<not> ?x)        (,find<not-p> ,@args))
+		 ((filter<not> ?x)      (,filter<not-p> ,@args))
+		 ((all-list ?x)         (,all-list<p> ,@args))
+		 ((exists-list ?x)      (,exists-list<p> ,@args))
+		 ((find-list ?x)        (,find-list<p> ,@args))
+		 ((filter-list ?x)      (,filter-list<p> ,@args))
+		 ((all-list<not> ?x)    (,all-list<not-p> ,@args))
+		 ((exists-list<not> ?x) (,exists-list<not-p> ,@args))
+		 ((find-list<not> ?x)   (,find-list<not-p> ,@args))
+		 ((filter-list<not> ?x) (,filter-list<not-p> ,@args))))
+
+	 ;; We use this hack to support alternate guards.  We basically use our
+	 ;; rewriter to inject the extra guards into the function's existing
+	 ;; guards.
+
+	 (fn-subs
+	  (list* `((declare (xargs :guard (true-listp ?list)))
+		   (declare (xargs :guard (and (true-listp ?list)
+					       ,@list-guard
+					       ,@arg-guard))))
+		 `((declare (xargs :guard (setp ?set)))
+		   (declare (xargs :guard (and (setp ?set)
+					       ,@set-guard
+					       ,@arg-guard))))
+		 subs))
+
+
+	 ;; And we make some symbols for use in automating the
+	 ;; all-by-membership strategy with computed hints.
+
+	 (all-trigger<p>           (mksym (app "all-trigger" wrap) in-package))
+	 (all-trigger<not-p>       (mksym (app "all-trigger" not-wrap) in-package))
+	 (all-strategy<p>          (mksym (app "all-strategy" wrap) in-package))
+	 (all-strategy<not-p>      (mksym (app "all-strategy" not-wrap) in-package))
+	 (all-list-trigger<p>      (mksym (app "all-list-trigger" wrap) in-package))
+	 (all-list-trigger<not-p>  (mksym (app "all-list-trigger" not-wrap) in-package))
+	 (all-list-strategy<p>     (mksym (app "all-list-strategy" wrap) in-package))
+	 (all-list-strategy<not-p> (mksym (app "all-list-strategy" not-wrap) in-package))
+
+	 ;; We finally make a deftheory event with the following name, which
+	 ;; holds all of these theorems:
+
+	 (theory<p>         (mksym (app "theory" wrap) in-package))
+	 (suffix            (mksym wrap in-package))
+	 (thm-names         (append (INSTANCE::defthm-names *theorems*)
+				    (INSTANCE::defthm-names *final-theorems*)))
+	 (thm-name-map      (INSTANCE::create-new-names thm-names suffix))
+	 (theory<p>-defthms (sublis thm-name-map thm-names))
+
+	 )
+
+    `(encapsulate ()
+
+	;; It's now quite easy to instantiate all of our functions.
+
+	(instance-*functions*
+	 :subs ,fn-subs
+	 :suffix ,name)
+
+	;; And similarly we can instantiate all of the theorems.
+
+	(instance-*theorems*
+	 :subs ,subs
+	 :suffix ,(mksym wrap in-package))
+	 ;:extra-defs (empty))
+
+
+	;; Automating the computed hints is a pain in the ass.  We
+	;; first need triggers as aliases for all<p>, all<not-p>, etc.
+
+	(defund ,all-trigger<p> (,@args)
+          (declare (xargs :verify-guards nil))
+	  (,all<p> ,@args))
+
+	(defund ,all-trigger<not-p> (,@args)
+          (declare (xargs :verify-guards nil))
+	  (,all<not-p> ,@args))
+
+	(defund ,all-list-trigger<p> (,@args)
+	  (declare (xargs :verify-guards nil))
+	  (,all-list<p> ,@args))
+
+	(defund ,all-list-trigger<not-p> (,@args)
+	  (declare (xargs :verify-guards nil))
+	  (,all-list<not-p> ,@args))
+
+
+	;; Now we need "tagging theorems" that instruct the rewriter
+	;; to tag the appropriate terms.
+
+	(defthm ,all-strategy<p>
+	  (implies (and (syntaxp (rewriting-goal-lit mfc state))
+			(syntaxp (rewriting-conc-lit (list ',all<p> ,@args)
+				  mfc state)))
+		   (equal (,all<p> ,@args)
+			  (,all-trigger<p> ,@args)))
+	  :hints(("Goal"
+		  :in-theory (union-theories
+			      (theory 'minimal-theory)
+			      '((:definition ,all-trigger<p>))))))
+
+	(defthm ,all-strategy<not-p>
+	  (implies (and (syntaxp (rewriting-goal-lit mfc state))
+			(syntaxp (rewriting-conc-lit (list ',all<not-p> ,@args)
+				  mfc state)))
+		   (equal (,all<not-p> ,@args)
+			  (,all-trigger<not-p> ,@args)))
+	  :hints(("Goal"
+		  :in-theory (union-theories
+			      (theory 'minimal-theory)
+			      '((:definition ,all-trigger<not-p>))))))
+
+	(defthm ,all-list-strategy<p>
+	  (implies (and (syntaxp (rewriting-goal-lit mfc state))
+			(syntaxp (rewriting-conc-lit (list ',all-list<p> ,@args)
+				  mfc state)))
+		   (equal (,all-list<p> ,@args)
+			  (,all-list-trigger<p> ,@args)))
+	  :hints(("Goal"
+		  :in-theory (union-theories
+			      (theory 'minimal-theory)
+			      '((:definition ,all-list-trigger<p>))))))
+
+	(defthm ,all-list-strategy<not-p>
+	  (implies (and (syntaxp (rewriting-goal-lit mfc state))
+			(syntaxp (rewriting-conc-lit (list ',all-list<not-p> ,@args)
+				  mfc state)))
+		   (equal (,all-list<not-p> ,@args)
+			  (,all-list-trigger<not-p> ,@args)))
+	  :hints(("Goal"
+		  :in-theory (union-theories
+			      (theory 'minimal-theory)
+			      '((:definition ,all-list-trigger<not-p>))))))
+
+
+	;; And then we call upon our computed hints routines to generate a
+	;; computed hint for us to use, and add it to the default hints.
+
+	(COMPUTED-HINTS::automate-instantiation
+	  :new-hint-name ,(mksym (app "all-by-membership-hint" wrap) in-package)
+	  :generic-theorem all-by-membership
+	  :generic-predicate predicate
+	  :generic-hyps all-hyps
+	  :generic-collection all-set
+	  :generic-collection-predicate all
+	  :actual-collection-predicate ,all<p>
+	  :actual-trigger ,all-trigger<p>
+	  :predicate-rewrite (((predicate ,@(?ify args))
+			       (,name ,@(?ify args))))
+	  :tagging-theorem ,all-strategy<p>
+	)
+
+	(COMPUTED-HINTS::automate-instantiation
+	  :new-hint-name ,(mksym (app "all-by-membership-hint" not-wrap) in-package)
+	  :generic-theorem all-by-membership
+	  :generic-predicate predicate
+	  :generic-hyps all-hyps
+	  :generic-collection all-set
+	  :generic-collection-predicate all
+	  :actual-collection-predicate ,all<not-p>
+	  :actual-trigger ,all-trigger<not-p>
+	  :predicate-rewrite (((predicate ,@(?ify args))
+			       (not (,name ,@(?ify args)))))
+	  :tagging-theorem ,all-strategy<not-p>
+	)
+
+	(COMPUTED-HINTS::automate-instantiation
+	  :new-hint-name ,(mksym (app "all-list-by-membership-hint" wrap) in-package)
+	  :generic-theorem all-list-by-membership
+	  :generic-predicate predicate
+	  :generic-hyps all-list-hyps
+	  :generic-collection all-list-list
+	  :generic-collection-predicate all-list
+	  :actual-collection-predicate ,all-list<p>
+	  :actual-trigger ,all-list-trigger<p>
+	  :predicate-rewrite (((predicate ,@(?ify args))
+			       (,name ,@(?ify args))))
+	  :tagging-theorem ,all-list-strategy<p>
+	)
+
+	(COMPUTED-HINTS::automate-instantiation
+	  :new-hint-name ,(mksym (app "all-list-by-membership-hint" not-wrap) in-package)
+	  :generic-theorem all-list-by-membership
+	  :generic-predicate predicate
+	  :generic-hyps all-list-hyps
+	  :generic-collection all-list-list
+	  :generic-collection-predicate all-list
+	  :actual-collection-predicate ,all-list<not-p>
+	  :actual-trigger ,all-list-trigger<not-p>
+	  :predicate-rewrite (((predicate ,@(?ify args))
+			       (not (,name ,@(?ify args)))))
+	  :tagging-theorem ,all-list-strategy<not-p>
+	)
+
+
+	(instance-*final-theorems*
+	 :subs ,subs
+	 :suffix ,(mksym wrap in-package))
+	 ;:extra-defs (empty))
+
+
+	(verify-guards ,filter<p>)
+	(verify-guards ,filter<not-p>)
+
+	;; In the end, we want to create a deftheory event so that you can
+	;; easily turn off the reasoning about these functions when you don't
+	;; need it.  We do that with the following event:
+
+	(deftheory ,theory<p> '(,@theory<p>-defthms
+				,all<p>              ,all-list<p>
+				,exists<p>           ,exists-list<p>
+				,find<p>             ,find-list<p>
+				,filter<p>           ,filter-list<p>
+				,all<not-p>          ,all-list<not-p>
+				,exists<not-p>       ,exists-list<not-p>
+				,find<not-p>         ,find-list<not-p>
+				,filter<not-p>       ,filter-list<not-p>
+				,all-trigger<p>      ,all-list-trigger<p>
+				,all-trigger<not-p>  ,all-list-trigger<not-p>
+				,all-strategy<p>     ,all-list-strategy<p>
+				,all-strategy<not-p> ,all-list-strategy<not-p>
+				))
+	)))
+
+
+(defmacro quantify-predicate (predicate
+			      &key in-package-of
+			           set-guard list-guard arg-guard)
+  (quantify-simple-predicate predicate
+			     (if in-package-of in-package-of 'in)
+			     (standardize-to-package "?SET" '?set set-guard)
+			     (standardize-to-package "?LIST" '?list list-guard)
+			     arg-guard))
+
+
+
+; We don't want to keep all these generic theorems around, because many of them
+; are rewrite rules with targets that are actual functions.  For example, if a
+; rule concludes with (in a X), we don't want to start backchaining on it if
+; its hypothese include generic rules.
+
+(deftheory generic-quantification-theory
+  `(,@(INSTANCE::defthm-names *theorems*)
+    ,@(INSTANCE::defthm-names *final-theorems*)
+    all exists find filter
+    all-list exists-list find-list filter-list
+    all<not> exists<not> find<not> filter<not>
+    all-list<not> exists-list<not> find-list<not> filter-list<not>))
+
+(in-theory (disable generic-quantification-theory))
+
diff -Nru acl2-6.2/books/std/osets/sort.lisp acl2-6.3/books/std/osets/sort.lisp
--- acl2-6.2/books/std/osets/sort.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/sort.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,283 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; sort.lisp -- a mergesort for constructing sets
+
+(in-package "SETS")
+(include-book "union")
+(local (include-book "std/lists/append" :dir :system))
+(local (include-book "std/lists/rev" :dir :system))
+(local (include-book "tools/mv-nth" :dir :system))
+(set-verify-guards-eagerness 2)
+
+(local (defthm member-of-append
+         (iff (member a (append x y))
+              (or (member a x)
+                  (member a y)))))
+
+(local (defthm member-of-list-fix
+         (iff (member a (acl2::list-fix x))
+              (member a x))))
+
+(local (defthm member-of-rev
+         (iff (member a (acl2::rev x))
+              (member a x))))
+
+(local (defthm append-assoc
+         (equal (append (append x y) z)
+                (append x (append y z)))))
+
+(defsection halve-list
+  :parents (mergesort)
+  :short "How we split the list for mergesort."
+
+  :long "<p>Originally I used the following function to split the list.</p>
+
+@({
+  (defun split-list-old (x)
+    (declare (xargs :guard (true-listp x)))
+    (cond ((endp x) (mv nil nil))
+          ((endp (cdr x)) (mv (list (car x)) nil))
+          (t (mv-let (part1 part2)
+                     (split-list-old (cddr x))
+                     (mv (cons (car x) part1)
+                         (cons (cadr x) part2)))))))
+})
+
+<p>But David Rager noted that this was not tail recursive, and accordingly it
+ran into trouble on large data sets.  Accordingly, in Version 0.91, I rewrote
+this to be tail recursive:</p>
+
+@({
+ (defun split-list (x acc acc2)
+   (declare (xargs :guard (true-listp x)))
+   (cond ((endp x)
+          (mv acc acc2))
+         ((endp (cdr x))
+          (mv (cons (car x) acc) acc2))
+         (t (split-list (cddr x)
+                        (cons (car x) acc)
+                        (cons (cadr x) acc2)))))
+})
+
+<p>Since then, I wrote the @('defsort/defsort') library, which uses some tricks
+to provide a faster mergesort.  One key optimization is to take the first and
+second halves of the list, rather than splitting the list in terms of evens and
+odds.  This allows you to split the list with half as much consing.</p>
+
+<p>Defsort's approach uses a lot of arithmetic optimization.  I later wrote a
+mergesort for Milawa, where arithmetic is expensive.  Here, I implemented
+split-list by walking down \"one cdr\" and \"two cdrs\" at a time.  I now use
+this same strategy in osets.</p>
+
+<p>BOZO this strategy is still stupidly re-consing up half the list, when
+really we could avoid that by just being a bit smarter, like in defsort.</p>"
+
+  (defund halve-list-aux (mid x acc)
+    (declare (xargs :guard (<= (len x) (len mid))))
+
+; We split the list by walking down it in a funny way; see halve-list.
+; Initially, mid and x both point to the front of the list.  We walk down x
+; taking two steps for every one step we take for mid; hence mid stays at the
+; middle of the list.  As we traverse mid, we puts its members into acc, and
+; when x runs out we return both acc and the rest of mid.  This effectively
+; lets us split the list in two (1) without doing any arithmetic, which can be
+; expensive since we can't use fixnum declarations, and (2) while consing only
+; (1/2)n times, where n is the length of the list.  This splitting function
+; performs well, handily beating the old osets split-list implementation on a
+; large list of symbols which we used to test it.
+
+    (if (or (atom x)
+            (atom (cdr x)))
+        (mv acc mid)
+      (halve-list-aux (cdr mid)
+                      (cdr (cdr x))
+                      (cons (car mid) acc))))
+
+  (defund halve-list (x)
+    (declare (xargs :guard t))
+    (halve-list-aux x x nil))
+
+  (local (in-theory (enable halve-list-aux)))
+
+  (local (defthm halve-list-aux-when-not-consp
+           (implies (not (consp x))
+                    (equal (halve-list-aux mid x acc)
+                           (list acc mid)))))
+
+  (local (defthm halve-list-aux-when-not-consp-of-cdr
+           (implies (not (consp (cdr x)))
+                    (equal (halve-list-aux mid x acc)
+                           (list acc mid)))))
+
+  (local (defthm halve-list-aux-len-1
+           (implies (and (<= (len x) (len mid))
+                         (consp x)
+                         (consp (cdr x)))
+                    (< (len (mv-nth 0 (halve-list-aux mid x acc)))
+                       (+ (len mid) (len acc))))
+           :rule-classes ((:rewrite) (:linear))))
+
+  (local (defthm halve-list-aux-len-2
+           (implies (and (<= (len x) (len mid))
+                         (consp x)
+                         (consp (cdr x)))
+                    (< (len (mv-nth 1 (halve-list-aux mid x acc)))
+                       (len mid)))
+           :rule-classes ((:rewrite) (:linear))))
+
+  (local (defthm halve-list-aux-append-property
+           (implies (<= (len x) (len mid))
+                    (equal (append (acl2::rev (mv-nth 0 (halve-list-aux mid x acc)))
+                                   (mv-nth 1 (halve-list-aux mid x acc)))
+                           (append (acl2::rev acc)
+                                   mid)))
+           :hints(("Goal" :do-not '(generalize fertilize)))))
+
+  (local (defthm halve-list-correct
+           (equal (append (acl2::rev (mv-nth 0 (halve-list x)))
+                          (mv-nth 1 (halve-list x)))
+                  x)
+           :hints(("Goal" :in-theory (enable halve-list)))))
+
+  (defthm halve-list-len-1
+    (implies (and (consp x)
+                  (consp (cdr x)))
+             (< (len (mv-nth 0 (halve-list x)))
+                (len x)))
+    :hints(("Goal"
+            :in-theory (e/d (halve-list)
+                            (halve-list-aux-len-1))
+            :use ((:instance halve-list-aux-len-1
+                             (mid x) (x x) (acc nil))))))
+
+  (defthm halve-list-len-2
+    (implies (and (consp x)
+                  (consp (cdr x)))
+             (< (len (mv-nth 1 (halve-list x)))
+                (len x)))
+    :hints(("Goal" :in-theory (enable halve-list))))
+
+  (defthm halve-list-membership-property
+    (iff (member a x)
+         (or (member a (mv-nth 0 (halve-list x)))
+             (member a (mv-nth 1 (halve-list x)))))
+    :rule-classes nil
+    :hints(("Goal"
+            :do-not-induct t
+            :in-theory (disable member-of-append)
+            :use ((:instance member-of-append
+                             (x (acl2::rev (mv-nth 0 (halve-list x))))
+                             (y (mv-nth 1 (halve-list x)))))))))
+
+
+(defsection mergesort-exec
+  :parents (mergesort)
+  :short "The implementation of mergesort."
+
+  (defun mergesort-exec (x)
+    (declare (xargs :guard t
+                    :measure (len x)
+                    :hints(("Goal"
+                            :use ((:instance halve-list-len-1)
+                                  (:instance halve-list-len-2))))
+                    :verify-guards nil))
+    (cond ((atom x) nil)
+          ((atom (cdr x))
+           (mbe :logic (insert (car x) nil)
+                :exec (list (car x))))
+          (t (mv-let (part1 part2)
+               (halve-list x)
+               (fast-union (mergesort-exec part1)
+                           (mergesort-exec part2)
+                           nil)))))
+
+  (local (in-theory (enable fast-union-set
+                            fast-union-membership)))
+
+  (defthm mergesort-exec-set
+    (setp (mergesort-exec x)))
+
+  (local (defthm mergesort-membership-2
+           (implies (member a x)
+                    (in a (mergesort-exec x)))
+           :hints(("Subgoal *1/3" :use (:instance halve-list-membership-property)))))
+
+  (local (defthm mergesort-membership-1
+           (implies (in a (mergesort-exec x))
+                    (member a x))
+           :hints(("Subgoal *1/6" :use (:instance halve-list-membership-property))
+                  ("Subgoal *1/5" :use (:instance halve-list-membership-property))
+                  ("Subgoal *1/4" :use (:instance halve-list-membership-property)))))
+
+  (defthm mergesort-exec-membership
+    (iff (in a (mergesort-exec x))
+         (member a x)))
+
+  (verify-guards mergesort-exec
+    :hints(("Goal" :in-theory (e/d ((:ruleset primitive-rules))
+                                   (mv-nth))))))
+
+
+(defsection mergesort
+  :parents (osets)
+  :short "@(call mergesort) converts the list @('X') into an ordered set."
+
+  :long "<p>Logically, @('(mergesort x)') is exactly the same as repeated
+insertion, so it is fairly easy to reason about.  But in the execution,
+mergesort is implemented with a reasonably efficient sort with O(n log n)
+performance instead of O(n^2) like repeated insertion.</p>
+
+<p>Our implementation is probably not blisteringly fast.  Folklore says we
+should switch to using a bubblesort when we get down to some threshold, say 40
+elements.  I'm not going to bother with any of that.  If you find that the
+mergesort's performance is inadequate, which is unlikely, you can work on
+making it faster.</p>
+
+<p>There are a few points of interest.  If you look at the actual sort code,
+@(see mergesort-exec), you will see that it is actually using the set library's
+own @(see union) function to perform the union.  This is pretty slick because
+union is linear complexity, and yet is easy to reason about since we have
+already got a lot of theory in place about it.</p>
+
+<p>In any case, our strategy for proving the equality of this mergesort with a
+simple insertion sort is the exact same trick we use everywhere else in the
+sets library.  We begin by showing that both produce sets, and then show that
+membership in either is true exactly when an element is @(see member-equal) in
+the original list.</p>"
+
+  (defun mergesort (x)
+    (declare (xargs :guard t
+                    :verify-guards nil))
+    (mbe :logic (if (endp x)
+                    nil
+                  (insert (car x)
+                          (mergesort (cdr x))))
+         :exec (mergesort-exec x)))
+
+  (defthm mergesort-set
+    (setp (mergesort x)))
+
+  (defthm in-mergesort
+    (equal (in a (mergesort x))
+           (if (member a x)
+               t
+             nil)))
+
+  (verify-guards mergesort)
+
+  (defthm mergesort-set-identity
+    (implies (setp X)
+             (equal (mergesort X) X))
+    :hints(("Goal" :in-theory (enable (:ruleset primitive-rules))))))
diff -Nru acl2-6.2/books/std/osets/top.lisp acl2-6.3/books/std/osets/top.lisp
--- acl2-6.2/books/std/osets/top.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/top.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,1155 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+
+; top.lisp
+;
+; This is the top level file, which you should include to use the ordered set
+; theory library.  Note that it does NOT include:
+;
+;   - The quantification extension for quantifying predicates over sets (i.e.,
+;     for defining "typed" sets); see quantify.lisp instead, or
+;
+;   - The map extension for mapping/projecting a function across a set; see
+;     map.lisp instead.
+;
+; The definitions in this file are redundant from the local include books.
+; This approach has several advantages.
+;
+;  - it gives a better event order than simply including the books one by one
+;
+;  - this file is also faster to include than all of the local books below, and
+;    allows the "ugliness" of auxilliary lemmas to be hidden away
+;
+;  - it makes clear that these theorems are public, and entirely prevents the
+;    use of "internal" lemmas and theorems.
+
+(in-package "SETS")
+(set-verify-guards-eagerness 2)
+
+; We now directly use the total order from misc/total-order.
+(include-book "misc/total-order" :dir :system)
+(include-book "tools/rulesets" :dir :system)
+(include-book "std/lists/list-defuns" :dir :system)
+
+; We need some program-mode definitions which are used in order to automate the
+; pick-a-point strategies.
+(include-book "computed-hints")
+
+(local
+ ;; xdoc hack part 1: throw away all current xdoc
+ (table xdoc::xdoc 'xdoc::doc nil))
+
+(local (include-book "primitives"))
+(local (include-book "membership"))
+(local (include-book "outer"))
+(local (include-book "sort"))
+(local (include-book "under-set-equiv"))
+
+(make-event
+ ;; xdoc hack part 2: take all the docs we got from the local includes and
+ ;; stick them onto the proper doc
+ (let ((slurped-docs (xdoc::get-xdoc-table (w state))))
+   (acl2::value `(table xdoc::xdoc 'xdoc::doc
+                        (append ',slurped-docs (xdoc::get-xdoc-table acl2::world))))))
+
+(defxdoc osets
+  :parents (std)
+  :short "ACL2 Ordered Sets Library."
+
+  :long "<p>This is a finite set theory implementation for ACL2 based on fully
+ordered lists.  Some nice features of this approach are that set equality is
+just @(see equal), and set operations like @(see union), @(see intersect), and
+so forth have O(n) implementations.</p>
+
+<p>Osets mostly hides the fact that sets are represented as ordered lists.  You
+should not have to reason about the set order unless you are trying to exploit
+it to make some function faster.  Instead, we generally try to reason about
+sets with a membership-based approach, via @(see in) and @(see subset).</p>
+
+<p>The library offers some automation for pick-a-point style reasoning, see for
+instance @(see all-by-membership), @(see pick-a-point-subset-strategy), and
+@(see double-containment).</p>
+
+<p>You can load the library with:</p>
+@({
+ (include-book \"finite-set-theory/osets/sets\" :dir :system)
+})
+
+<p>Besides this @(see xdoc::xdoc) documentation, you may be interested in the
+2004 ACL2 workshop paper, <a
+href='http://www.cs.utexas.edu/users/jared/publications/2004-acl2-osets/set-theory.pdf'>Finite
+Set Theory based on Fully Ordered Lists</a>, and see also the <a
+href='http://www.cs.utexas.edu/users/jared/osets/Slides/2004-02-seminar-slides.pdf'>slides</a>
+from the accompanying talk.</p>")
+
+; We begin with the definitions of the set theory functions and a few trivial
+; type prescriptions.
+
+(defund setp (X)
+  (declare (xargs :guard t))
+  (if (atom X)
+      (null X)
+    (or (null (cdr X))
+        (and (consp (cdr X))
+             (fast-<< (car X) (cadr X))
+             (setp (cdr X))))))
+
+(defthm setp-type
+  (or (equal (setp X) t)
+      (equal (setp X) nil))
+  :rule-classes :type-prescription)
+
+(defund empty (X)
+  (declare (xargs :guard (setp X)))
+  (mbe :logic (or (null X)
+                  (not (setp X)))
+       :exec  (null X)))
+
+(defthm empty-type
+  (or (equal (empty X) t)
+      (equal (empty X) nil))
+  :rule-classes :type-prescription)
+
+(defund sfix (X)
+  (declare (xargs :guard (setp X)))
+  (mbe :logic (if (empty X) nil X)
+       :exec  X))
+
+(defund head (X)
+  (declare (xargs :guard (and (setp X)
+                              (not (empty X)))))
+  (mbe :logic (car (sfix X))
+       :exec  (car X)))
+
+(defund tail (X)
+  (declare (xargs :guard (and (setp X)
+                              (not (empty X)))))
+  (mbe :logic (cdr (sfix X))
+       :exec  (cdr X)))
+
+(defund insert (a X)
+  (declare (xargs :guard (setp X)))
+  (mbe :logic (cond ((empty X) (list a))
+                    ((equal (head X) a) X)
+                    ((<< a (head X)) (cons a X))
+                    (t (cons (head X) (insert a (tail X)))))
+       :exec
+       (cond ((null X) (cons a nil))
+             ((equal (car X) a) X)
+             ((fast-lexorder a (car X)) (cons a X))
+             ((null (cdr X)) (cons (car X) (cons a nil)))
+             ((equal (cadr x) a) X)
+             ((fast-lexorder a (cadr X)) (cons (car X) (cons a (cdr X))))
+             (t (cons (car X) (cons (cadr X) (insert a (cddr X))))))))
+
+(defun in (a X)
+  (declare (xargs :guard (setp X)))
+  (mbe :logic
+       (and (not (empty X))
+            (or (equal a (head X))
+                (in a (tail X))))
+       :exec
+       (and x
+            (or (equal a (car x))
+                (and (cdr x)
+                     (or (equal a (cadr x))
+                         (in a (cddr x))))))))
+
+(defthm in-type
+  (or (equal (in a X) t)
+      (equal (in a X) nil))
+  :rule-classes :type-prescription)
+
+(defund fast-subset (X Y)
+  (declare (xargs :guard (and (setp X) (setp Y))))
+  (mbe :logic
+       (cond ((empty X) t)
+             ((empty Y) nil)
+             ((<< (head X) (head Y)) nil)
+             ((equal (head X) (head Y)) (fast-subset (tail X) (tail Y)))
+             (t (fast-subset X (tail Y))))
+       :exec
+       (cond ((null X) t)
+             ((null Y) nil)
+             ((fast-lexorder (car X) (car Y))
+              (and (equal (car X) (car Y))
+                   (fast-subset (cdr X) (cdr Y))))
+             (t
+              (fast-subset X (cdr Y))))))
+
+(defun subset (X Y)
+  (declare (xargs :guard (and (setp X) (setp Y))))
+  (mbe :logic (if (empty X)
+		  t
+		(and (in (head X) Y)
+		     (subset (tail X) Y)))
+       :exec (fast-subset X Y)))
+
+(defthm subset-type
+  (or (equal (subset X Y) t)
+      (equal (subset X Y) nil))
+  :rule-classes :type-prescription)
+
+(defund fast-measure (X Y)
+  (+ (acl2-count X) (acl2-count Y)))
+
+(defun fast-union (x y acc)
+  (declare (xargs :measure (fast-measure X Y)
+                  :guard (and (setp x)
+                              (setp y)
+                              (true-listp acc))))
+  (cond ((endp x) (revappend acc y))
+        ((endp y) (revappend acc x))
+        ((equal (car x) (car y))
+         (fast-union (cdr x) (cdr y) (cons (car x) acc)))
+        ((mbe :logic (<< (car x) (car y))
+              :exec (fast-lexorder (car x) (car y)))
+         (fast-union (cdr x) y (cons (car x) acc)))
+        (t
+         (fast-union x (cdr y) (cons (car y) acc)))))
+
+(defun fast-intersect (X Y acc)
+  (declare (xargs :measure (fast-measure X Y)
+                  :guard (and (setp X)
+                              (setp Y)
+                              (true-listp acc))))
+  (cond ((endp X) (revappend acc nil))
+        ((endp Y) (revappend acc nil))
+        ((equal (car X) (car Y))
+         (fast-intersect (cdr X) (cdr Y) (cons (car X) acc)))
+        ((mbe :logic (<< (car X) (car Y))
+              :exec (fast-lexorder (car X) (car Y)))
+         (fast-intersect (cdr X) Y acc))
+        (t
+         (fast-intersect X (cdr Y) acc))))
+
+(defun fast-intersectp (X Y)
+  (declare (xargs :guard (and (setp X)
+                              (setp Y))
+                  :measure (fast-measure X Y)))
+  (cond ((endp X) nil)
+        ((endp Y) nil)
+        ((equal (car X) (car Y))
+         t)
+        ((mbe :logic (<< (car X) (car y))
+              :exec (fast-lexorder (car X) (car Y)))
+         (fast-intersectp (cdr X) Y))
+        (t
+         (fast-intersectp X (cdr Y)))))
+
+(defun fast-difference (X Y acc)
+  (declare (xargs :measure (fast-measure X Y)
+                  :guard (and (setp X)
+                              (setp Y)
+                              (true-listp acc))))
+  (cond ((endp X) (revappend acc nil))
+        ((endp Y) (revappend acc X))
+        ((equal (car X) (car Y))
+         (fast-difference (cdr X) (cdr Y) acc))
+        ((mbe :logic (<< (car X) (car Y))
+              :exec (fast-lexorder (car X) (car Y)))
+         (fast-difference (cdr X) Y (cons (car X) acc)))
+        (t
+         (fast-difference X (cdr Y) acc))))
+
+(defun delete (a X)
+  (declare (xargs :guard (setp X)))
+  (mbe :logic
+       (cond ((empty X) nil)
+             ((equal a (head X)) (tail X))
+             (t (insert (head X) (delete a (tail X)))))
+       :exec
+       (cond ((endp X) nil)
+             ((equal a (car X)) (cdr X))
+             (t (insert (car X) (delete a (cdr X)))))))
+
+(defun union (X Y)
+  (declare (xargs :guard (and (setp X) (setp Y))))
+  (mbe :logic (if (empty X)
+                  (sfix Y)
+                (insert (head X) (union (tail X) Y)))
+       :exec  (fast-union X Y nil)))
+
+(defun intersect (X Y)
+  (declare (xargs :guard (and (setp X) (setp Y))))
+  (mbe :logic (cond ((empty X) (sfix X))
+                    ((in (head X) Y)
+                     (insert (head X) (intersect (tail X) Y)))
+                    (t (intersect (tail X) Y)))
+       :exec (fast-intersect X Y nil)))
+
+(defun intersectp (X Y)
+  (declare (xargs :guard (and (setp X) (setp Y))))
+  (mbe :logic (not (empty (intersect X Y)))
+       :exec (fast-intersectp X Y)))
+
+(defun difference (X Y)
+  (declare (xargs :guard (and (setp X) (setp Y))))
+  (mbe :logic (cond ((empty X) (sfix X))
+                    ((in (head X) Y) (difference (tail X) Y))
+                    (t (insert (head X) (difference (tail X) Y))))
+       :exec (fast-difference X Y nil)))
+
+(defun cardinality (X)
+  (declare (xargs :guard (setp X)))
+  (mbe :logic (if (empty X)
+                  0
+                (1+ (cardinality (tail X))))
+       :exec  (length (the list X))))
+
+(defund halve-list-aux (mid x acc)
+  (declare (xargs :guard (<= (len x) (len mid))))
+  (if (or (atom x)
+          (atom (cdr x)))
+      (mv acc mid)
+    (halve-list-aux (cdr mid)
+                    (cdr (cdr x))
+                    (cons (car mid) acc))))
+
+(defund halve-list (x)
+  (declare (xargs :guard t))
+  (halve-list-aux x x nil))
+
+(defun mergesort-exec (x)
+  (declare (xargs :guard t
+                  :measure (len x)))
+  (cond ((atom x) nil)
+        ((atom (cdr x))
+         (mbe :logic (insert (car x) nil)
+              :exec (list (car x))))
+        (t (mv-let (part1 part2)
+                   (halve-list x)
+                   (fast-union (mergesort-exec part1)
+                               (mergesort-exec part2)
+                               nil)))))
+
+(defun mergesort (x)
+  (declare (xargs :guard t))
+  (mbe :logic (if (endp x)
+		  nil
+		(insert (car x)
+			(mergesort (cdr x))))
+       :exec (mergesort-exec x)))
+
+
+
+; "High Powered" Strategies
+;
+;   We put these at the beginning of the file so that they are tried
+;   as a last resort when simple methods have failed.
+
+(encapsulate
+ (((predicate *) => *))
+  (local (defun predicate (x) x)))
+
+(defun all (set-for-all-reduction)
+  (declare (xargs :guard (setp set-for-all-reduction)))
+  (if (empty set-for-all-reduction)
+      t
+    (and (predicate (head set-for-all-reduction))
+	 (all (tail set-for-all-reduction)))))
+
+(encapsulate
+ (((all-hyps) => *)
+  ((all-set) => *))
+
+ (local (defun all-hyps () nil))
+ (local (defun all-set () nil))
+
+ (defthmd membership-constraint
+   (implies (all-hyps)
+	    (implies (in arbitrary-element (all-set))
+		     (predicate arbitrary-element)))))
+
+(defthmd all-by-membership
+  (implies (all-hyps)
+	   (all (all-set))))
+
+(defund subset-trigger (X Y)
+  (declare (xargs :guard (and (setp X) (setp Y))))
+  (subset X Y))
+
+(defthm pick-a-point-subset-strategy
+  (implies (and (syntaxp (rewriting-goal-lit mfc state))
+		(syntaxp (rewriting-conc-lit `(subset ,X ,Y) mfc state)))
+	   (equal (subset X Y)
+		  (subset-trigger X Y))))
+
+(COMPUTED-HINTS::automate-instantiation
+  :new-hint-name pick-a-point-subset-hint
+  :generic-theorem all-by-membership
+  :generic-predicate predicate
+  :generic-hyps all-hyps
+  :generic-collection all-set
+  :generic-collection-predicate all
+  :actual-collection-predicate subset
+  :actual-trigger subset-trigger
+  :predicate-rewrite (((predicate ?x ?y) (in ?x ?y)))
+  :tagging-theorem pick-a-point-subset-strategy)
+
+(defthm double-containment
+  (implies (and (setp X)
+                (setp Y))
+           (equal (equal X Y)
+                  (and (subset X Y)
+                       (subset Y X))))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+
+
+; -------------------------------------------------------------------
+; Primitive Level Theorems
+
+(defthm sets-are-true-lists
+  (implies (setp X)
+	   (true-listp X))
+  :rule-classes ((:rewrite) (:compound-recognizer)))
+
+(defthm tail-count
+  (implies (not (empty X))
+           (< (acl2-count (tail X)) (acl2-count X)))
+  :rule-classes ((:rewrite) (:linear)))
+
+(defthm head-count
+  (implies (not (empty X))
+           (< (acl2-count (head X)) (acl2-count X)))
+  :rule-classes ((:rewrite) (:linear)))
+
+(defthm tail-count-built-in
+  (implies (not (empty X))
+           (o< (acl2-count (tail X)) (acl2-count X)))
+  :rule-classes :built-in-clause)
+
+(defthm head-count-built-in
+  (implies (not (empty X))
+           (o< (acl2-count (head X)) (acl2-count X)))
+  :rule-classes :built-in-clause)
+
+(defthm insert-insert
+  (equal (insert a (insert b X))
+         (insert b (insert a X)))
+  :rule-classes ((:rewrite :loop-stopper ((a b)))))
+
+(defthm sfix-produces-set
+  (setp (sfix X)))
+
+(defthm tail-produces-set
+  (setp (tail X)))
+
+(defthm insert-produces-set
+  (setp (insert a X)))
+
+(defthm insert-never-empty
+  (not (empty (insert a X))))
+
+(defthm nonempty-means-set
+  (implies (not (empty X))
+           (setp X)))
+
+(defthm sfix-set-identity
+  (implies (setp X)
+           (equal (sfix X)
+                  X)))
+
+(defthm empty-sfix-cancel
+  (equal (empty (sfix X))
+         (empty X)))
+
+(defthm head-sfix-cancel
+  (equal (head (sfix X))
+         (head X)))
+
+(defthm tail-sfix-cancel
+  (equal (tail (sfix X))
+         (tail X)))
+
+(defthm insert-head
+  (implies (not (empty X))
+           (equal (insert (head X) X)
+                  X)))
+
+(defthm insert-head-tail
+  (implies (not (empty X))
+           (equal (insert (head X) (tail X))
+                  X)))
+
+(defthm repeated-insert
+  (equal (insert a (insert a X))
+         (insert a X)))
+
+(defthm insert-sfix-cancel
+  (equal (insert a (sfix X))
+         (insert a X)))
+
+(defthm head-when-empty
+  (implies (empty X)
+           (equal (head X)
+                  nil)))
+
+(defthm tail-when-empty
+  (implies (empty X)
+           (equal (tail X)
+                  nil)))
+
+(defthm insert-when-empty
+  (implies (and (syntaxp (not (equal X ''nil)))
+                (empty X))
+           (equal (insert a X)
+                  (insert a nil))))
+
+(defthm head-of-insert-a-nil
+  (equal (head (insert a nil))
+         a))
+
+(defthm tail-of-insert-a-nil
+  (equal (tail (insert a nil))
+         nil))
+
+(defthm sfix-when-empty
+  (implies (empty X)
+           (equal (sfix X)
+                  nil)))
+
+
+; -------------------------------------------------------------------
+; Membership Level Theorems
+
+(defthm subset-membership-tail
+  (implies (and (subset X Y)
+                (in a (tail X)))
+           (in a (tail Y))))
+
+(defthm subset-membership-tail-2
+  (implies (and (subset X Y)
+                (not (in a (tail Y))))
+           (not (in a (tail X)))))
+
+(defthm not-in-self
+  (not (in x x)))
+
+(defthm in-sfix-cancel
+  (equal (in a (sfix X))
+         (in a X)))
+
+(defthm never-in-empty
+  (implies (empty X)
+           (not (in a X))))
+
+(defthm in-set
+  (implies (in a X)
+           (setp X)))
+
+(defthm in-tail
+  (implies (in a (tail X))
+           (in a X)))
+
+(defthm in-tail-or-head
+  (implies (and (in a X)
+                (not (in a (tail X))))
+           (equal (head X)
+                  a)))
+
+(defthm in-head
+  (equal (in (head X) X)
+         (not (empty X))))
+
+(defthm head-unique
+  (not (in (head X) (tail X))))
+
+(defthm insert-identity
+  (implies (in a X)
+           (equal (insert a X)
+                  X)))
+
+(defthm in-insert
+  (equal (in a (insert b X))
+         (or (in a X)
+             (equal a b))))
+
+(defthm subset-transitive
+  (and (implies (and (subset X Y)
+                     (subset Y Z))
+                (subset X Z))
+       (implies (and (subset Y Z)
+                     (subset X Y))
+                (subset X Z))))
+
+(defthm subset-insert-X
+  (equal (subset (insert a X) Y)
+         (and (subset X Y)
+              (in a Y))))
+
+(defthm subset-sfix-cancel-X
+  (equal (subset (sfix X) Y)
+         (subset X Y)))
+
+(defthm subset-sfix-cancel-Y
+  (equal (subset X (sfix Y))
+         (subset X Y)))
+
+(defthm subset-in
+  (and (implies (and (subset X Y)
+                     (in a X))
+                (in a Y))
+       (implies (and (in a X)
+                     (subset X Y))
+                (in a Y))))
+
+(defthm subset-in-2
+  (and (implies (and (subset X Y)
+                     (not (in a Y)))
+                (not (in a X)))
+       (implies (and (not (in a Y))
+                     (subset X Y))
+                (not (in a X)))))
+
+(defthm empty-subset
+  (implies (empty X)
+           (subset X Y)))
+
+(defthm empty-subset-2
+  (implies (empty Y)
+	   (equal (subset X Y)
+                  (empty X))))
+
+(defthm subset-reflexive
+  (subset X X))
+
+(defthm subset-insert
+  (subset X (insert a X)))
+
+(defthm subset-tail
+  (subset (tail X) X)
+  :rule-classes ((:rewrite)
+		 (:forward-chaining :trigger-terms ((tail x)))))
+
+
+
+; -------------------------------------------------------------------
+; Weakly Inducting over Insertions
+
+(defthm weak-insert-induction-helper-1
+  (implies (and (not (in a X))
+                (not (equal (head (insert a X)) a)))
+           (equal (head (insert a X)) (head X))))
+
+(defthm weak-insert-induction-helper-2
+  (implies (and (not (in a X))
+                (not (equal (head (insert a X)) a)))
+           (equal (tail (insert a X)) (insert a (tail X)))))
+
+(defthm weak-insert-induction-helper-3
+  (implies (and (not (in a X))
+                (equal (head (insert a X)) a))
+           (equal (tail (insert a X)) (sfix X))))
+
+(defun weak-insert-induction (a X)
+  (declare (xargs :guard (setp X)))
+  (cond ((empty X) nil)
+        ((in a X) nil)
+        ((equal (head (insert a X)) a) nil)
+        (t (list (weak-insert-induction a (tail X))))))
+
+(defthm use-weak-insert-induction t
+  :rule-classes ((:induction
+                  :pattern (insert a X)
+                  :scheme (weak-insert-induction a X))))
+
+
+
+
+; -------------------------------------------------------------------
+; Outer Level Theorems
+
+(defthm delete-delete
+  (equal (delete a (delete b X))
+         (delete b (delete a X)))
+  :rule-classes ((:rewrite :loop-stopper ((a b)))))
+
+(defthm delete-set
+  (setp (delete a X)))
+
+(defthm delete-preserves-empty
+  (implies (empty X)
+           (empty (delete a X))))
+
+(defthm delete-in
+  (equal (in a (delete b X))
+         (and (in a X)
+              (not (equal a b)))))
+
+(defthm delete-sfix-cancel
+  (equal (delete a (sfix X))
+         (delete a X)))
+
+(defthm delete-nonmember-cancel
+  (implies (not (in a X))
+           (equal (delete a X) (sfix X))))
+
+(defthm repeated-delete
+  (equal (delete a (delete a X))
+         (delete a X)))
+
+(defthm delete-insert-cancel
+  (equal (delete a (insert a X))
+         (delete a X)))
+
+(defthm insert-delete-cancel
+  (equal (insert a (delete a X))
+         (insert a X)))
+
+(defthm subset-delete
+  (subset (delete a X) X))
+
+
+
+(defthm union-symmetric
+  (equal (union X Y) (union Y X))
+  :rule-classes ((:rewrite :loop-stopper ((X Y)))))
+
+(defthm union-commutative
+  (equal (union X (union Y Z))
+         (union Y (union X Z)))
+  :rule-classes ((:rewrite :loop-stopper ((X Y)))))
+
+(defthm union-insert-X
+  (equal (union (insert a X) Y)
+         (insert a (union X Y))))
+
+(defthm union-insert-Y
+  (equal (union X (insert a Y))
+         (insert a (union X Y))))
+
+(defthm union-delete-X
+  (equal (union (delete a X) Y)
+         (if (in a Y)
+             (union X Y)
+           (delete a (union X Y)))))
+
+(defthm union-delete-Y
+  (equal (union X (delete a Y))
+         (if (in a X)
+             (union X Y)
+           (delete a (union X Y)))))
+
+(defthm union-set
+  (setp (union X Y)))
+
+(defthm union-sfix-cancel-X
+  (equal (union (sfix X) Y) (union X Y)))
+
+(defthm union-sfix-cancel-Y
+  (equal (union X (sfix Y)) (union X Y)))
+
+(defthm union-empty-X
+  (implies (empty X)
+           (equal (union X Y) (sfix Y))))
+
+(defthm union-empty-Y
+  (implies (empty Y)
+           (equal (union X Y) (sfix X))))
+
+(defthm union-empty
+  (equal (empty (union X Y))
+         (and (empty X) (empty Y))))
+
+(defthm union-in
+  (equal (in a (union X Y))
+         (or (in a X) (in a Y))))
+
+(defthm union-subset-X
+  (subset X (union X Y)))
+
+(defthm union-subset-Y
+  (subset Y (union X Y)))
+
+(defthm union-with-subset-left
+  (implies (subset X Y)
+           (equal (union X Y)
+                  (sfix Y)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm union-with-subset-right
+  (implies (subset X Y)
+           (equal (union Y X)
+                  (sfix Y)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm union-self
+  (equal (union X X) (sfix X)))
+
+(defthm union-associative
+  (equal (union (union X Y) Z)
+         (union X (union Y Z))))
+
+(defthm union-outer-cancel
+  (equal (union X (union X Z))
+         (union X Z)))
+
+
+
+(defthm intersect-symmetric
+  (equal (intersect X Y) (intersect Y X))
+  :rule-classes ((:rewrite :loop-stopper ((X Y)))))
+
+(defthm intersect-insert-X
+  (implies (not (in a Y))
+           (equal (intersect (insert a X) Y)
+                  (intersect X Y))))
+
+(defthm intersect-insert-Y
+  (implies (not (in a X))
+           (equal (intersect X (insert a Y))
+                  (intersect X Y))))
+
+(defthm intersect-delete-X
+  (equal (intersect (delete a X) Y)
+         (delete a (intersect X Y))))
+
+(defthm intersect-delete-Y
+  (equal (intersect X (delete a Y))
+         (delete a (intersect X Y))))
+
+(defthm intersect-set
+  (setp (intersect X Y)))
+
+(defthm intersect-sfix-cancel-X
+  (equal (intersect (sfix X) Y) (intersect X Y)))
+
+(defthm intersect-sfix-cancel-Y
+  (equal (intersect X (sfix Y)) (intersect X Y)))
+
+(defthm intersect-empty-X
+  (implies (empty X) (empty (intersect X Y))))
+
+(defthm intersect-empty-Y
+  (implies (empty Y) (empty (intersect X Y))))
+
+(defthm intersect-in
+  (equal (in a (intersect X Y))
+         (and (in a Y) (in a X))))
+
+(defthm intersect-subset-X
+  (subset (intersect X Y) X))
+
+(defthm intersect-subset-Y
+  (subset (intersect X Y) Y))
+
+(defthm intersect-with-subset-left
+  (implies (subset X Y)
+           (equal (intersect X Y)
+                  (sfix X)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm intersect-with-subset-right
+  (implies (subset X Y)
+           (equal (intersect Y X)
+                  (sfix X)))
+  :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+(defthm intersect-self
+  (equal (intersect X X) (sfix X)))
+
+(defthm intersect-associative
+  (equal (intersect (intersect X Y) Z)
+         (intersect X (intersect Y Z))))
+
+(defthmd union-over-intersect
+  (equal (union X (intersect Y Z))
+         (intersect (union X Y) (union X Z))))
+
+(defthm intersect-over-union
+  (equal (intersect X (union Y Z))
+         (union (intersect X Y) (intersect X Z))))
+
+(defthm intersect-commutative
+  (equal (intersect X (intersect Y Z))
+         (intersect Y (intersect X Z)))
+  :rule-classes ((:rewrite :loop-stopper ((X Y)))))
+
+(defthm intersect-outer-cancel
+  (equal (intersect X (intersect X Z))
+         (intersect X Z)))
+
+
+
+(defthm difference-set
+  (setp (difference X Y)))
+
+(defthm difference-sfix-X
+  (equal (difference (sfix X) Y) (difference X Y)))
+
+(defthm difference-sfix-Y
+  (equal (difference X (sfix Y)) (difference X Y)))
+
+(defthm difference-empty-X
+  (implies (empty X)
+           (equal (difference X Y) (sfix X))))
+
+(defthm difference-empty-Y
+  (implies (empty Y)
+           (equal (difference X Y) (sfix X))))
+
+(defthm difference-in
+  (equal (in a (difference X Y))
+         (and (in a X)
+              (not (in a Y)))))
+
+(defthm difference-subset-X
+  (subset (difference X Y) X))
+
+(defthm subset-difference
+  (equal (empty (difference X Y))
+         (subset X Y)))
+
+(defthm difference-over-union
+  (equal (difference X (union Y Z))
+         (intersect (difference X Y) (difference X Z))))
+
+(defthm difference-over-intersect
+  (equal (difference X (intersect Y Z))
+         (union (difference X Y) (difference X Z))))
+
+(defthm difference-insert-X
+  (equal (difference (insert a X) Y)
+         (if (in a Y)
+             (difference X Y)
+           (insert a (difference X Y)))))
+
+(defthm difference-insert-Y
+  (equal (difference X (insert a Y))
+         (delete a (difference X Y))))
+
+(defthm difference-delete-X
+  (equal (difference (delete a X) Y)
+         (delete a (difference X Y))))
+
+(defthm difference-delete-Y
+  (equal (difference X (delete a Y))
+         (if (in a X)
+             (insert a (difference X Y))
+           (difference X Y))))
+
+(defthm difference-preserves-subset
+  (implies (subset X Y)
+	   (subset (difference X Z)
+		   (difference Y Z))))
+
+
+(defthm cardinality-type
+  (and (integerp (cardinality X))
+       (<= 0 (cardinality X)))
+  :rule-classes :type-prescription)
+
+(defthm cardinality-zero-empty
+  (equal (equal (cardinality x) 0)
+	 (empty x)))
+
+(defthm cardinality-sfix-cancel
+  (equal (cardinality (sfix X))
+         (cardinality X)))
+
+(defthm insert-cardinality
+  (equal (cardinality (insert a X))
+         (if (in a X)
+             (cardinality X)
+           (1+ (cardinality X)))))
+
+(defthm delete-cardinality
+  (equal (cardinality (delete a X))
+         (if (in a X)
+             (1- (cardinality X))
+           (cardinality X))))
+
+(defthm subset-cardinality
+  (implies (subset X Y)
+           (<= (cardinality X) (cardinality Y)))
+  :rule-classes (:rewrite :linear))
+
+(defthm proper-subset-cardinality
+  (implies (and (subset X Y)
+                (not (subset Y X)))
+           (< (cardinality X) (cardinality Y)))
+  :rule-classes (:rewrite :linear))
+
+(defthmd equal-cardinality-subset-is-equality
+  (implies (and (setp X)
+                (setp Y)
+                (subset X Y)
+                (equal (cardinality X) (cardinality Y)))
+           (equal (equal X Y) t)))
+
+(defthm intersect-cardinality-X
+  (<= (cardinality (intersect X Y))
+      (cardinality X))
+  :rule-classes (:rewrite :linear))
+
+(defthm intersect-cardinality-Y
+  (<= (cardinality (intersect X Y))
+      (cardinality Y))
+  :rule-classes (:rewrite :linear))
+
+(defthm expand-cardinality-of-union
+  (equal (cardinality (union X Y))
+         (- (+ (cardinality X) (cardinality Y))
+            (cardinality (intersect X Y)))))
+
+(defthm expand-cardinality-of-difference
+  (equal (cardinality (difference X Y))
+         (- (cardinality X)
+            (cardinality (intersect X Y)))))
+
+(defthm intersect-cardinality-non-subset
+  (implies (not (subset x y))
+           (< (cardinality (intersect x y))
+              (cardinality x)))
+  :rule-classes (:rewrite :linear))
+
+(defthm intersect-cardinality-subset-2
+  (equal (equal (cardinality (intersect X Y)) (cardinality X))
+	 (subset X Y)))
+
+(defthm intersect-cardinality-non-subset-2
+  (equal (< (cardinality (intersect x y)) (cardinality x))
+	 (not (subset x y))))
+
+
+
+; -------------------------------------------------------------------
+; Mergesort Theorems
+
+(defthm mergesort-set
+  (setp (mergesort x)))
+
+(defthm in-mergesort
+  (equal (in a (mergesort x))
+         (if (member a x)
+             t
+           nil)))
+
+(defthm mergesort-set-identity
+  (implies (setp X)
+	   (equal (mergesort X) X)))
+
+
+
+; -------------------------------------------------------------------
+; Rulesets for low level reasoning, generally not needed
+
+(defthmd insert-induction-case
+  (implies (and (not (<< a (head X)))
+                (not (equal a (head X)))
+                (not (empty X)))
+           (equal (insert (head X) (insert a (tail X)))
+                  (insert a X))))
+
+(defthmd head-insert
+  (equal (head (insert a X))
+	 (cond ((empty X) a)
+	       ((<< a (head X)) a)
+	       (t (head X)))))
+
+(defthmd tail-insert
+  (equal (tail (insert a X))
+	 (cond ((empty X) (sfix X))
+	       ((<< a (head X)) (sfix X))
+               ((equal a (head X)) (tail X))
+               (t (insert a (tail X))))))
+
+(defthmd head-tail-order
+  (implies (not (empty (tail X)))
+           (<< (head X) (head (tail X)))))
+
+(defthmd head-tail-order-contrapositive
+  (implies (not (<< (head X) (head (tail X))))
+           (empty (tail X))))
+
+(defthmd head-minimal
+  (implies (<< a (head X))
+           (not (in a X))))
+
+(defthmd head-minimal-2
+  (implies (in a X)
+           (not (<< a (head X)))))
+
+(defthmd setp-of-cons
+  (equal (setp (cons a X))
+         (and (setp X)
+              (or (<< a (head X))
+                  (empty X)))))
+
+(defthmd in-to-member
+  (implies (setp X)
+           (equal (in a X)
+                  (if (member a x)
+                      t
+                    nil))))
+
+(defthmd not-member-when-smaller
+  (implies (and (<< a (car x))
+                (setp x))
+           (not (member a x))))
+
+(defthmd subset-to-subsetp
+  (implies (and (setp x)
+                (setp y))
+           (equal (subset x y)
+                  (subsetp x y))))
+
+(defthmd lexorder-<<-equiv
+  (implies (not (equal a b))
+           (equal (equal (<< a b) (lexorder a b))
+                  t)))
+
+(make-event
+ (let* ((primitive-rules (acl2::get-ruleset 'primitive-rules (w state)))
+        (order-rules     (acl2::get-ruleset 'order-rules (w state)))
+        (low-level-rules (acl2::get-ruleset 'low-level-rules (w state))))
+   (acl2::value `(progn
+                   (def-ruleset! primitive-rules ',primitive-rules)
+                   (def-ruleset! order-rules ',order-rules)
+                   (def-ruleset! low-level-rules ',low-level-rules)))))
+
+
+
+
+; -------------------------------------------------------------------
+; Relation to acl2::set-equiv, for lightweight use of sets
+
+(defthm insert-under-set-equiv
+  (acl2::set-equiv (insert a x)
+                   (cons a (sfix x))))
+
+(defthm delete-under-set-equiv
+  (acl2::set-equiv (delete a x)
+                   (remove-equal a (sfix x))))
+
+(defthm union-under-set-equiv
+  (acl2::set-equiv (union x y)
+                   (append (sfix x) (sfix y))))
+
+(defthm intersect-under-set-equiv
+  (acl2::set-equiv (intersect x y)
+                   (intersection-equal (sfix x) (sfix y))))
+
+(defthm difference-under-set-equiv
+  (acl2::set-equiv (difference x y)
+                   (set-difference-equal (sfix x) (sfix y))))
+
+(defthm mergesort-under-set-equiv
+  (acl2::set-equiv (mergesort x)
+                   x))
+
+(defcong acl2::set-equiv equal (mergesort x) 1
+  :event-name set-equiv-implies-equal-mergesort-1)
diff -Nru acl2-6.2/books/std/osets/under-set-equiv.lisp acl2-6.3/books/std/osets/under-set-equiv.lisp
--- acl2-6.2/books/std/osets/under-set-equiv.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/under-set-equiv.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,161 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "SETS")
+(include-book "outer")
+(include-book "sort")
+(include-book "std/lists/sets" :dir :system)
+
+(defun all-list (x)
+  (declare (xargs :guard (true-listp x)))
+  (if (endp x)
+      t
+    (and (predicate (car x))
+         (all-list (cdr x)))))
+
+(encapsulate
+  (((all-list-hyps) => *)
+   ((all-list-list) => *))
+
+  (local (defun all-list-hyps () nil))
+  (local (defun all-list-list () nil))
+
+  (defthmd list-membership-constraint
+    (implies (all-list-hyps)
+             (implies (member arbitrary-element (all-list-list))
+                      (predicate arbitrary-element)))))
+
+(encapsulate
+  ()
+  (local (defun all-list-badguy (x)
+           (if (consp x)
+               (if (predicate (car x))
+                   (all-list-badguy (cdr x))
+                 (list (car x)))
+             nil)))
+
+  (local (defthmd all-list-badguy-membership-property
+           (implies (all-list-badguy x)
+                    (and (member-equal (car (all-list-badguy x)) x)
+                         (not (predicate (car (all-list-badguy x))))))
+           :hints(("Goal" :induct (all-list-badguy x)))))
+
+  (local (defthm all-list-badguy-under-iff
+           (iff (all-list-badguy x)
+                (not (all-list x)))
+           :hints(("Goal" :in-theory (enable all-list)))))
+
+  (defthmd all-list-by-membership
+    (implies (all-list-hyps)
+             (all-list (all-list-list)))
+    :hints(("Goal"
+            :in-theory (enable list-membership-constraint)
+            :use ((:instance all-list-badguy-membership-property
+                             (x (all-list-list))))))))
+
+(defund subsetp-equal-trigger (x y)
+  (declare (xargs :guard (and (true-listp x)
+                              (true-listp y))))
+  (subsetp-equal x y))
+
+(defthm pick-a-point-subsetp-equal-strategy
+  (implies (and (syntaxp (rewriting-goal-lit mfc state))
+                (syntaxp (rewriting-conc-lit `(subsetp-equal ,x ,y) mfc state)))
+           (equal (subsetp-equal x y)
+                  (subsetp-equal-trigger x y)))
+  :hints(("Goal" :in-theory (enable subsetp-equal-trigger))))
+
+(COMPUTED-HINTS::automate-instantiation
+ :new-hint-name pick-a-point-subsetp-equal-hint
+ :generic-theorem all-list-by-membership
+ :generic-predicate predicate
+ :generic-hyps all-list-hyps
+ :generic-collection all-list-list
+ :generic-collection-predicate all-list
+ :actual-collection-predicate subsetp-equal
+ :actual-trigger subsetp-equal-trigger
+ :predicate-rewrite (((predicate ?x ?y) (member-equal ?x ?y)))
+ :tagging-theorem pick-a-point-subsetp-equal-strategy)
+
+
+
+;; BOZO talk to sol about whether these should become defwitness nonsense
+
+(local (defthm promote-member-to-in
+         (implies (setp x)
+                  (iff (member a x)
+                       (in a x)))
+         :hints(("Goal" :in-theory (enable in-to-member)))))
+
+(local (in-theory (enable acl2::set-equiv)))
+
+(defthm insert-under-set-equiv
+  (acl2::set-equiv (insert a x)
+                   (cons a (sfix x)))
+  :hints(("Goal" :do-not-induct t)))
+
+(defthm delete-under-set-equiv
+  (acl2::set-equiv (delete a x)
+                   (remove-equal a (sfix x))))
+
+(encapsulate
+  ()
+  (local (defthm l0
+           (subsetp (union x y)
+                    (append (sfix x) (sfix y)))))
+
+  (local (defthm l1
+           (subsetp (append (sfix x) (sfix y))
+                    (union x y))))
+
+  (defthm union-under-set-equiv
+    (acl2::set-equiv (union x y)
+                     (append (sfix x) (sfix y)))
+    :hints(("Goal" :do-not-induct t))))
+
+
+(defthm intersect-under-set-equiv
+  (acl2::set-equiv (intersect x y)
+                   (intersection-equal (sfix x) (sfix y)))
+  :hints(("Goal" :do-not-induct t)))
+
+(defthm difference-under-set-equiv
+  (acl2::set-equiv (difference x y)
+                   (set-difference-equal (sfix x) (sfix y)))
+  :hints(("Goal" :do-not-induct t)))
+
+(defthm mergesort-under-set-equiv
+  (acl2::set-equiv (mergesort x)
+                   x)
+  :hints(("Goal" :do-not-induct t)))
+
+(encapsulate
+  ()
+  (local (defthm l0
+           (implies (acl2::set-equiv x y)
+                    (subsetp (mergesort x) (mergesort y)))))
+
+  (local (defthm l1
+           (implies (and (subsetp x y)
+                         (member a x))
+                    (member a y))))
+
+  (defcong acl2::set-equiv equal (mergesort x) 1
+    :event-name set-equiv-implies-equal-mergesort-1
+    :hints(("Goal"
+            :do-not-induct t
+            :do-not '(generalize fertilize)
+            :in-theory (enable acl2::set-equiv)))))
+
+
+
diff -Nru acl2-6.2/books/std/osets/union.lisp acl2-6.3/books/std/osets/union.lisp
--- acl2-6.2/books/std/osets/union.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/osets/union.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,208 @@
+; Fully Ordered Finite Sets
+; Copyright (C) 2003-2012 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public Lic-
+; ense along with this program; if not, write to the Free Soft- ware
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "SETS")
+(include-book "membership")
+(set-verify-guards-eagerness 2)
+
+
+; Fast Union
+;
+; We want to show that fast union always produces a set, and has the expected
+; membership property.
+
+
+; PATCH (0.91): David Rager noticed that as of v0.9, fast-union was not tail
+; recursive, and submitted an updated version.  The original fast-union has
+; been renamed to fast-union-old, and the new fast-union replaces it.
+
+(local
+ (encapsulate ()
+
+   (defun fast-union-old (X Y)
+     (declare (xargs :measure (fast-measure X Y)
+                     :guard (and (setp X) (setp Y))
+                     :verify-guards nil))
+     (cond ((endp X) Y)
+           ((endp Y) X)
+           ((equal (car X) (car Y))
+            (cons (car X) (fast-union-old (cdr X) (cdr Y))))
+           ((fast-<< (car X) (car Y))
+            (cons (car X) (fast-union-old (cdr X) Y)))
+           (t
+            (cons (car Y) (fast-union-old X (cdr Y))))))
+
+   (defthm fast-union-old-set
+     (implies (and (setp X) (setp Y))
+              (setp (fast-union-old X Y)))
+     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))
+
+   (defthm member-of-fast-union-old
+     (iff (member a (fast-union-old x y))
+          (or (member a x)
+              (member a y))))
+
+   (defthm fast-union-old-membership
+     (implies (and (setp X) (setp Y))
+              (equal (in a (fast-union-old X Y))
+                     (or (in a X) (in a Y))))
+     :hints(("Goal"
+             :do-not '(generalize fertilize)
+             :in-theory (enable (:ruleset low-level-rules)))))
+
+   (verify-guards fast-union-old
+     :hints(("Goal" :in-theory (enable (:ruleset low-level-rules)))))))
+
+
+(defun fast-union (x y acc)
+  (declare (xargs :measure (fast-measure X Y)
+                  :guard (and (setp x)
+                              (setp y)
+                              (true-listp acc))
+                  :verify-guards nil))
+  (cond ((endp x) (revappend acc y))
+        ((endp y) (revappend acc x))
+        ((equal (car x) (car y))
+         (fast-union (cdr x) (cdr y) (cons (car x) acc)))
+        ((mbe :logic (<< (car x) (car y))
+              :exec (fast-lexorder (car x) (car y)))
+         (fast-union (cdr x) y (cons (car x) acc)))
+        (t
+         (fast-union x (cdr y) (cons (car y) acc)))))
+
+(verify-guards fast-union
+  :hints(("Goal"
+          :do-not '(generalize fertilize)
+          :in-theory (enable (:ruleset low-level-rules)))))
+
+(encapsulate
+  ()
+  (local (defthm lemma
+           (equal (fast-union x y acc)
+                  (revappend acc (fast-union-old x y)))
+           :hints(("Goal" :in-theory (enable (:ruleset low-level-rules))))))
+
+  (local (defthm lemma2
+           (equal (fast-union x y nil)
+                  (fast-union-old x y))))
+
+  (defthm fast-union-set
+    (implies (and (force (setp X))
+                  (force (setp Y)))
+             (setp (fast-union X Y nil))))
+
+  (defthm fast-union-membership
+    (implies (and (setp X) (setp Y))
+             (equal (in a (fast-union X Y nil))
+                    (or (in a X) (in a Y)))))
+
+  (in-theory (disable fast-union
+                      fast-union-set
+                      fast-union-membership)))
+
+
+
+
+(defsection union
+  :parents (osets)
+  :short "@(call union) constructs the union of @('X') and @('Y')."
+
+  :long "<p>The logical definition is very simple, and the essential
+correctness property is given by @('union-in').</p>
+
+<p>The execution uses a better, O(n) algorithm to merge the sets by exploiting
+the set order.</p>"
+
+  (defun union (X Y)
+    (declare (xargs :guard (and (setp X) (setp Y))
+                    :verify-guards nil))
+    (mbe :logic (if (empty X)
+                    (sfix Y)
+                  (insert (head X) (union (tail X) Y)))
+         :exec  (fast-union X Y nil)))
+
+  (defthm union-set
+    (setp (union X Y)))
+
+  (defthm union-sfix-cancel-X
+    (equal (union (sfix X) Y) (union X Y)))
+
+  (defthm union-sfix-cancel-Y
+    (equal (union X (sfix Y)) (union X Y)))
+
+  (defthm union-empty-X
+    (implies (empty X)
+             (equal (union X Y) (sfix Y))))
+
+  (defthm union-empty-Y
+    (implies (empty Y)
+             (equal (union X Y) (sfix X))))
+
+  (defthm union-empty
+    (equal (empty (union X Y))
+           (and (empty X) (empty Y))))
+
+  (defthm union-in
+    (equal (in a (union X Y))
+           (or (in a X) (in a Y))))
+
+  (verify-guards union
+    :hints(("Goal" :in-theory (enable fast-union-set
+                                      fast-union-membership))))
+
+
+  (defthm union-symmetric
+    (equal (union X Y) (union Y X))
+    :rule-classes ((:rewrite :loop-stopper ((X Y)))))
+
+  (defthm union-subset-X
+    (subset X (union X Y)))
+
+  (defthm union-subset-Y
+    (subset Y (union X Y)))
+
+  (defthm union-insert-X
+    (equal (union (insert a X) Y)
+           (insert a (union X Y))))
+
+  (defthm union-insert-Y
+    (equal (union X (insert a Y))
+           (insert a (union X Y))))
+
+  (defthm union-with-subset-left
+    (implies (subset X Y)
+             (equal (union X Y)
+                    (sfix Y)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm union-with-subset-right
+    (implies (subset X Y)
+             (equal (union Y X)
+                    (sfix Y)))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm union-self
+    (equal (union X X) (sfix X)))
+
+  (defthm union-associative
+    (equal (union (union X Y) Z)
+           (union X (union Y Z))))
+
+  (defthm union-commutative
+    (equal (union X (union Y Z))
+           (union Y (union X Z)))
+    :rule-classes ((:rewrite :loop-stopper ((X Y)))))
+
+  (defthm union-outer-cancel
+    (equal (union X (union X Z))
+           (union X Z))))
\ No newline at end of file
diff -Nru acl2-6.2/books/std/top.lisp acl2-6.3/books/std/top.lisp
--- acl2-6.2/books/std/top.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/top.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,6 +1,7 @@
 ; Standard Library
 ; Portions are Copyright (C) 2008-2013 Centaur Technology
-; Portions are Copyright (C) 2004-2006 by Jared Davis
+; Portions are Copyright (C) 2004-2013 Jared Davis
+; Portions are Copyright (C) 2013 Kookamara LLC
 ; See individual books for details.
 ;
 ; Contact:
@@ -27,3 +28,29 @@
 (include-book "io/top")
 (include-book "strings/top")
 (include-book "misc/top")
+(include-book "osets/top")
+
+(defsection std
+  :short "Standard libraries for ACL2."
+
+  :long "<p>The @('std') library is meant to become <i>ACL2, Batteries
+Included</i>.  Its features a wide variety of books that work well together to
+provide a well-thought-out, documented, coherent reasoning strategy.</p>
+
+<p>@('Std') is currently under active development.  You are welcome to use it,
+but please be aware that things may change out from under you.</p>
+
+<p>So far, @('std') itself includes libraries about
+   <see topic='@(url std/lists)'>lists</see>,
+   <see topic='@(url osets)'>sets</see>,
+   <see topic='@(url std/alists)'>alists</see>,
+   <see topic='@(url std/typed-lists)'>typed-lists</see>, and
+   <see topic='@(url std/io)'>input/output</see>.
+Each of these libraries provides many lemmas for reasoning about built-in
+ACL2 functions, and also many additional functions.</p>
+
+<p>The @('Std') books also play well with libraries like @(see str), and @(see
+cutil).  We are working to further integrate these libraries, and may soon
+incorporate some of them into @(see std), itself.</p>")
+
+
diff -Nru acl2-6.2/books/std/typed-lists/atom-listp.lisp acl2-6.3/books/std/typed-lists/atom-listp.lisp
--- acl2-6.2/books/std/typed-lists/atom-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/atom-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,83 @@
+; Standard Typed Lists Library
+; Copyright (C) 2008-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(include-book "cutil/deflist" :dir :system)
+
+(defsection std/typed-lists/atom-listp
+  :parents (std/typed-lists atom-listp)
+  :short "Lemmas about @(see atom-listp) available in the @(see
+std/typed-lists) library."
+  :long "<p>Most of these are generated automatically with @(see
+cutil::deflist).</p>"
+
+  (cutil::deflist atom-listp (x)
+    (atom x)
+    :true-listp t
+    :elementp-of-nil t
+    :already-definedp t
+    ;; Set :parents to nil to avoid overwriting the built-in ACL2 documentation
+    :parents nil)
+
+  ;; These rules are no good because they target ATOM instead of CONSP:
+  (in-theory (disable ATOM-WHEN-MEMBER-EQUAL-OF-ATOM-LISTP
+                      ATOM-OF-CAR-WHEN-ATOM-LISTP))
+
+  (defthmd consp-when-member-equal-of-atom-listp
+    ;; The free variable matching may make this reasonably cheap for some uses,
+    ;; but I think it's likely to cause performance problems, so I'll leave it
+    ;; disabled by default.
+    (implies (and (member-equal a x)
+                  (atom-listp x))
+             (equal (consp a)
+                    nil))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)
+                   (:rewrite
+                    :corollary (implies (and (atom-listp x)
+                                             (member-equal a x))
+                                        (equal (consp a)
+                                               nil))
+                    :backchain-limit-lst 1)))
+
+  (defthm consp-of-car-when-atom-listp
+    (implies (atom-listp (double-rewrite x))
+             (equal (consp (car x))
+                    nil))
+    ;; I have seen this be expensive, e.g., in centaur/vl/parse-nets,
+    ;; so severely limit it.
+    :rule-classes ((:rewrite :backchain-limit-lst 0)))
+
+  (defthm atom-listp-of-remove-equal
+    ;; BOZO probably add to deflist
+    (implies (atom-listp x)
+             (atom-listp (remove-equal a x))))
+
+  (defthm atom-listp-of-make-list-ac
+    (equal (atom-listp (make-list-ac n x ac))
+           (and (atom-listp ac)
+                (or (atom x)
+                    (zp n)))))
+
+  (defthm atom-listp-of-rev
+    ;; BOZO consider adding to deflist
+    (equal (atom-listp (rev x))
+           (atom-listp (list-fix x)))
+    :hints(("Goal" :induct (len x)))))
+
diff -Nru acl2-6.2/books/std/typed-lists/character-listp.lisp acl2-6.3/books/std/typed-lists/character-listp.lisp
--- acl2-6.2/books/std/typed-lists/character-listp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/character-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,4 +1,4 @@
-; Built-In Typed Lists
+; Standard Typed Lists Library
 ; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
@@ -21,30 +21,52 @@
 (in-package "ACL2")
 (include-book "cutil/deflist" :dir :system)
 
-(cutil::deflist character-listp (x)
-  (characterp x)
-  :true-listp t
-  :elementp-of-nil nil
-  :already-definedp t)
-
-(defthm true-listp-when-character-listp-rewrite
-  ;; The deflist gives us a compound-recognizer, but in this case having a
-  ;; rewrite rule seems worth it.
-  (implies (character-listp x)
-           (true-listp x))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-(defthm character-listp-of-remove-equal
-  ;; BOZO probably add to deflist
-  (implies (character-listp x)
-           (character-listp (remove-equal a x))))
-
-(defthm character-listp-of-make-list-ac
-  (equal (character-listp (make-list-ac n x ac))
-         (and (character-listp ac)
-              (or (characterp x)
-                  (zp n)))))
-
-(defthm eqlable-listp-when-character-listp
-  (implies (character-listp x)
-           (eqlable-listp x)))
+; We disable CHARACTER-LISTP itself, and also the following ACL2 built-in
+; rules, since the DEFLIST adds stronger ones.
+(in-theory (disable character-listp
+                    character-listp-append
+                    character-listp-revappend))
+
+(defsection std/typed-lists/character-listp
+  :parents (std/typed-lists character-listp)
+  :short "Lemmas about @(see character-listp) available in the @(see
+std/typed-lists) library."
+  :long "<p>Most of these are generated automatically with @(see
+cutil::deflist).</p>"
+
+  (cutil::deflist character-listp (x)
+    (characterp x)
+    :true-listp t
+    :elementp-of-nil nil
+    :already-definedp t
+    ;; Set :parents to nil to avoid overwriting the built-in ACL2 documentation
+    :parents nil)
+
+  (defthm true-listp-when-character-listp-rewrite
+    ;; The deflist gives us a compound-recognizer, but in this case having a
+    ;; rewrite rule seems worth it.
+    (implies (character-listp x)
+             (true-listp x))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm character-listp-of-remove-equal
+    ;; BOZO probably add to deflist
+    (implies (character-listp x)
+             (character-listp (remove-equal a x))))
+
+  (defthm character-listp-of-make-list-ac
+    (equal (character-listp (make-list-ac n x ac))
+           (and (character-listp ac)
+                (or (characterp x)
+                    (zp n)))))
+
+  (defthm eqlable-listp-when-character-listp
+    (implies (character-listp x)
+             (eqlable-listp x)))
+
+  (defthm character-listp-of-rev
+    ;; BOZO consider adding to deflist
+    (equal (character-listp (rev x))
+           (character-listp (list-fix x)))
+    :hints(("Goal" :induct (len x)))))
+
diff -Nru acl2-6.2/books/std/typed-lists/nat-listp.lisp acl2-6.3/books/std/typed-lists/nat-listp.lisp
--- acl2-6.2/books/std/typed-lists/nat-listp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/nat-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,4 +1,4 @@
-; Built-In Typed Lists
+; Standard Typed Lists Library
 ; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
@@ -22,44 +22,62 @@
 (include-book "arithmetic/nat-listp" :dir :system)
 (include-book "cutil/deflist" :dir :system)
 
-(in-theory (disable nat-listp-of-append-weak))
+(in-theory (disable nat-listp
+                    nat-listp-of-append-weak))
 
-(cutil::deflist nat-listp (x)
-  (natp x)
-  :true-listp t
-  :elementp-of-nil nil
-  :already-definedp t)
-
-(defthm integerp-of-car-when-nat-listp
-  ;; Gross, but maybe useful when natp is enabled?
-  (implies (nat-listp x)
-           (equal (integerp (car x))
-                  (consp x))))
-
-(defthm lower-bound-of-car-when-nat-listp
-  (implies (nat-listp x)
-           (<= 0 (car x)))
-  :rule-classes ((:rewrite) (:linear))
-  :hints(("Goal" :induct (len x))))
-
-(defthm true-listp-when-nat-listp-rewrite
-  ;; The deflist gives us a compound-recognizer, but in this case having a
-  ;; rewrite rule seems worth it.
-  (implies (nat-listp x)
-           (true-listp x))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-(defthm nat-listp-of-remove-equal
-  ;; BOZO probably add to deflist
-  (implies (nat-listp x)
-           (nat-listp (remove-equal a x))))
-
-(defthm nat-listp-of-make-list-ac
-  (equal (nat-listp (make-list-ac n x ac))
-         (and (nat-listp ac)
-              (or (natp x)
-                  (zp n)))))
-
-(defthm eqlable-listp-when-nat-listp
-  (implies (nat-listp x)
-           (eqlable-listp x)))
+(defsection std/typed-lists/nat-listp
+  :parents (nat-listp)
+  :short "Lemmas about @(see nat-listp) available in the @(see std/typed-lists)
+library."
+
+  :long "<p>Most of these are generated automatically with @(see
+cutil::deflist).</p>
+
+<p>BOZO some additional lemmas are found in @('arithmetic/nat-listp').</p>"
+
+  (cutil::deflist nat-listp (x)
+    (natp x)
+    :true-listp t
+    :elementp-of-nil nil
+    :already-definedp t
+    ;; Set :parents to nil to avoid overwriting the built-in ACL2 documentation
+    :parents nil)
+
+  (defthm integerp-of-car-when-nat-listp
+    ;; Gross, but maybe useful when natp is enabled?
+    (implies (nat-listp x)
+             (equal (integerp (car x))
+                    (consp x))))
+
+  (defthm lower-bound-of-car-when-nat-listp
+    (implies (nat-listp x)
+             (<= 0 (car x)))
+    :rule-classes ((:rewrite) (:linear))
+    :hints(("Goal" :induct (len x))))
+
+  ;; This rewrite is fine, but the arithmetic/nat-listp book now has both
+  ;; a rewrite and a compound recognizer, so there's no reason to include this.
+  ;; (defthm true-listp-when-nat-listp-rewrite
+  ;;   ;; The deflist gives us a compound-recognizer, but in this case having a
+  ;;   ;; rewrite rule seems worth it.
+  ;;   (implies (nat-listp x)
+  ;;            (true-listp x))
+  ;;   :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm nat-listp-of-remove-equal
+    ;; BOZO probably add to deflist
+    (implies (nat-listp x)
+             (nat-listp (remove-equal a x))))
+
+  (defthm nat-listp-of-make-list-ac
+    ;; BOZO probably silly given REPEAT as the normal form...
+    (equal (nat-listp (make-list-ac n x ac))
+           (and (nat-listp ac)
+                (or (natp x)
+                    (zp n)))))
+
+  (defthm eqlable-listp-when-nat-listp
+    ;; Useful for the guards of MEMBER on nat-listp's.
+    ;; BOZO should this just be a TAU rule?
+    (implies (nat-listp x)
+             (eqlable-listp x))))
diff -Nru acl2-6.2/books/std/typed-lists/portcullis.acl2 acl2-6.3/books/std/typed-lists/portcullis.acl2
--- acl2-6.2/books/std/typed-lists/portcullis.acl2	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/portcullis.acl2	2013-09-30 17:52:14.000000000 +0000
@@ -18,5 +18,5 @@
 ;
 ; Original author: Jared Davis <jared@centtech.com>
 
-(ld "cutil/package.lsp" :dir :system)
+(include-book "cutil/portcullis" :dir :system)
 (certify-book "portcullis" ? t)
diff -Nru acl2-6.2/books/std/typed-lists/portcullis.lisp acl2-6.3/books/std/typed-lists/portcullis.lisp
--- acl2-6.2/books/std/typed-lists/portcullis.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/portcullis.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,4 +1,4 @@
-; Built-In Typed Lists
+; Standard Typed Lists Library
 ; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
diff -Nru acl2-6.2/books/std/typed-lists/signed-byte-listp.lisp acl2-6.3/books/std/typed-lists/signed-byte-listp.lisp
--- acl2-6.2/books/std/typed-lists/signed-byte-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/signed-byte-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,48 @@
+; Standard Typed Lists Library
+; signed-byte-listp.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "ACL2")
+(set-verify-guards-eagerness 2)
+(include-book "xdoc/top" :dir :system)
+
+(local (in-theory (disable signed-byte-p)))
+
+(defsection signed-byte-listp
+  :parents (std/typed-lists signed-byte-p)
+  :short "Recognizer for lists of @(see signed-byte-p)'s."
+  :long "<p>BOZO consider switching this book to use deflist.</p>"
+
+  (defund signed-byte-listp (n x)
+    (if (atom x)
+        (null x)
+      (and (signed-byte-p n (car x))
+           (signed-byte-listp n (cdr x)))))
+
+  (defthm signed-byte-listp-when-atom
+    (implies (atom x)
+             (equal (signed-byte-listp n x)
+                    (not x)))
+    :hints(("Goal" :in-theory (enable signed-byte-listp))))
+
+  (defthm signed-byte-listp-of-cons
+    (equal (signed-byte-listp n (cons a x))
+           (and (signed-byte-p n a)
+                (signed-byte-listp n x)))
+    :hints(("Goal" :in-theory (enable signed-byte-listp))))
+
+  (defthm true-listp-when-signed-byte-listp
+    (implies (signed-byte-listp bytes x)
+             (true-listp x))
+    :hints(("Goal" :induct (len x)))))
+
diff -Nru acl2-6.2/books/std/typed-lists/string-listp.lisp acl2-6.3/books/std/typed-lists/string-listp.lisp
--- acl2-6.2/books/std/typed-lists/string-listp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/string-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,4 +1,4 @@
-; Built-In Typed Lists
+; Standard Typed Lists Library
 ; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
@@ -21,21 +21,32 @@
 (in-package "ACL2")
 (include-book "cutil/deflist" :dir :system)
 
-(cutil::deflist string-listp (x)
-  (stringp x)
-  :true-listp t
-  :elementp-of-nil nil
-  :already-definedp t)
-
-(defthm true-listp-when-string-listp-rewrite
-  ;; The deflist gives us a compound-recognizer, but in this case having a
-  ;; rewrite rule seems worth it.
-  (implies (string-listp x)
-           (true-listp x))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-(defthm string-listp-of-remove-equal
-  ;; BOZO probably add to deflist
-  (implies (string-listp x)
-           (string-listp (remove-equal a x))))
+(in-theory (disable string-listp))
+
+(defsection std/typed-lists/string-listp
+  :parents (std/typed-lists string-listp)
+  :short "Lemmas about @(see string-listp) available in the @(see
+std/typed-lists) library."
+  :long "<p>Most of these are generated automatically with @(see
+cutil::deflist).</p>"
+
+  (cutil::deflist string-listp (x)
+    (stringp x)
+    :true-listp t
+    :elementp-of-nil nil
+    :already-definedp t
+    ;; Set :parents to nil to avoid overwriting the built-in ACL2 documentation
+    :parents nil)
+
+  (defthm true-listp-when-string-listp-rewrite
+    ;; The deflist gives us a compound-recognizer, but in this case having a
+    ;; rewrite rule seems worth it.
+    (implies (string-listp x)
+             (true-listp x))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm string-listp-of-remove-equal
+    ;; BOZO probably add to deflist
+    (implies (string-listp x)
+             (string-listp (remove-equal a x)))))
 
diff -Nru acl2-6.2/books/std/typed-lists/symbol-listp.lisp acl2-6.3/books/std/typed-lists/symbol-listp.lisp
--- acl2-6.2/books/std/typed-lists/symbol-listp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/symbol-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,4 +1,4 @@
-; Built-In Typed Lists
+; Standard Typed Lists Library
 ; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
@@ -21,30 +21,43 @@
 (in-package "ACL2")
 (include-book "cutil/deflist" :dir :system)
 
-(cutil::deflist symbol-listp (x)
-  (symbolp x)
-  :true-listp t
-  :elementp-of-nil t
-  :already-definedp t)
-
-(defthm true-listp-when-symbol-listp-rewrite
-  ;; The deflist gives us a compound-recognizer, but in this case having a
-  ;; rewrite rule seems worth it.
-  (implies (symbol-listp x)
-           (true-listp x))
-  :rule-classes ((:rewrite :backchain-limit-lst 1)))
-
-(defthm symbol-listp-of-remove-equal
-  ;; BOZO probably add to deflist
-  (implies (symbol-listp x)
-           (symbol-listp (remove-equal a x))))
-
-(defthm symbol-listp-of-make-list-ac
-  (equal (symbol-listp (make-list-ac n x ac))
-         (and (symbol-listp ac)
-              (or (symbolp x)
-                  (zp n)))))
-
-(defthm eqlable-listp-when-symbol-listp
-  (implies (symbol-listp x)
-           (eqlable-listp x)))
\ No newline at end of file
+(in-theory (disable symbol-listp))
+
+(defsection std/typed-lists/symbol-listp
+  :parents (std/typed-lists symbol-listp)
+  :short "Lemmas about @(see symbol-listp) available in the @(see
+std/typed-lists) library."
+  :long "<p>Most of these are generated automatically with @(see
+cutil::deflist).</p>"
+
+  (cutil::deflist symbol-listp (x)
+    (symbolp x)
+    :true-listp t
+    :elementp-of-nil t
+    :already-definedp t
+    ;; Set :parents to nil to avoid overwriting the built-in ACL2 documentation
+    :parents nil)
+
+  (defthm true-listp-when-symbol-listp-rewrite
+    ;; The deflist gives us a compound-recognizer, but in this case having a
+    ;; rewrite rule seems worth it.
+    (implies (symbol-listp x)
+             (true-listp x))
+    :rule-classes ((:rewrite :backchain-limit-lst 1)))
+
+  (defthm symbol-listp-of-remove-equal
+    ;; BOZO probably add to deflist
+    (implies (symbol-listp x)
+             (symbol-listp (remove-equal a x))))
+
+  (defthm symbol-listp-of-make-list-ac
+    ;; BOZO probably silly with REPEAT as the normal form
+    (equal (symbol-listp (make-list-ac n x ac))
+           (and (symbol-listp ac)
+                (or (symbolp x)
+                    (zp n)))))
+
+  (defthm eqlable-listp-when-symbol-listp
+    ;; Useful for, e.g., MEMBER-EQ guards 
+    (implies (symbol-listp x)
+             (eqlable-listp x))))
diff -Nru acl2-6.2/books/std/typed-lists/top.lisp acl2-6.3/books/std/typed-lists/top.lisp
--- acl2-6.2/books/std/typed-lists/top.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/top.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -1,4 +1,4 @@
-; Built-In Typed Lists
+; Standard Typed Lists Library
 ; Copyright (C) 2008-2013 Centaur Technology
 ;
 ; Contact:
@@ -20,21 +20,40 @@
 
 (in-package "ACL2")
 
-; This is Jared's preferred way to load the built-in typed-lists library and
-; get a decent theory.  If you want to keep functions like STRING-LISTP and
-; SYMBOL-LISTP enabled, you can include the individual books, which mostly try
-; to leave the default theory alone.
-
+(include-book "atom-listp")
 (include-book "character-listp")
 (include-book "nat-listp")
 (include-book "string-listp")
 (include-book "symbol-listp")
-(include-book "true-listp")
+(include-book "signed-byte-listp")
+(include-book "unsigned-byte-listp")
+
+(defsection std/typed-lists
+  :parents (std)
+  :short "A library about the built-in typed lists, like @(see
+character-listp), @(see nat-listp), string-listp), etc."
+
+  :long "<p>The @('std/typed-lists') library provides basic lemmas about
+built-in ACL2 functions.</p>
+
+<p>If you want to load everything in the library, you can just include the
+@('top') book, e.g.,</p>
+
+@({ (include-book \"std/typed-lists/top\" :dir :system) })
+
+<p>Alternately, it is perfectly reasonable to just include the individual books
+that deal with the typed lists you are interested in.  For instance,</p>
+
+@({
+    (include-book \"std/typed-lists/character-listp\" :dir :system)
+    (include-book \"std/typed-lists/symbol-listp\" :dir :system)
+    ;; and so on.
+})
 
-(in-theory (disable character-listp
-                    nat-listp
-                    string-listp
-                    symbol-listp
-                    true-listp))
+<p>Most of the typed-lists library is generated automatically by @(see
+cutil::deflist).  You may find this macro useful for introducing your own,
+custom typed lists.</p>
 
+<p>BOZO this library is not very complete.  We should probably add books
+about the other kinds of typed-list recognizers.</p>")
 
diff -Nru acl2-6.2/books/std/typed-lists/true-listp.lisp acl2-6.3/books/std/typed-lists/true-listp.lisp
--- acl2-6.2/books/std/typed-lists/true-listp.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/true-listp.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-; Built-In Typed Lists
-; Copyright (C) 2008-2013 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "ACL2")
-
-(defthm true-listp-when-atom
-  (implies (atom x)
-           (equal (true-listp x)
-                  (not x))))
-
-(defthm true-listp-of-cons
-  (equal (true-listp (cons a x))
-         (true-listp x)))
-
-(defthm consp-under-iff-when-true-listp
-  (implies (true-listp x)
-           (iff (consp x)
-                x))
-  :rule-classes ((:rewrite :backchain-limit-lst 0)))
-
diff -Nru acl2-6.2/books/std/typed-lists/unsigned-byte-listp.lisp acl2-6.3/books/std/typed-lists/unsigned-byte-listp.lisp
--- acl2-6.2/books/std/typed-lists/unsigned-byte-listp.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/std/typed-lists/unsigned-byte-listp.lisp	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,100 @@
+; Standard Typed Lists Library
+; unsigned-byte-listp.lisp -- originally part of the Unicode library
+; Copyright (C) 2005-2013 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "ACL2")
+(set-verify-guards-eagerness 2)
+(include-book "std/lists/repeat" :dir :system)
+(include-book "std/lists/take" :dir :system)
+(include-book "arithmetic/nat-listp" :dir :system)
+
+
+(defsection unsigned-byte-listp
+  :parents (std/typed-lists unsigned-byte-p)
+  :short "Recognizer for lists of @(see unsigned-byte-p)'s."
+  :long "<p>BOZO consider switching this book to use deflist.</p>"
+
+  (local (in-theory (disable unsigned-byte-p)))
+
+  (defund unsigned-byte-listp (n x)
+    (if (atom x)
+        (null x)
+      (and (unsigned-byte-p n (car x))
+           (unsigned-byte-listp n (cdr x)))))
+
+  (defthm unsigned-byte-listp-when-not-consp
+    (implies (not (consp x))
+             (equal (unsigned-byte-listp n x)
+                    (not x)))
+    :hints(("Goal" :in-theory (enable unsigned-byte-listp))))
+
+  (defthm unsigned-byte-listp-of-cons
+    (equal (unsigned-byte-listp n (cons a x))
+           (and (unsigned-byte-p n a)
+                (unsigned-byte-listp n x)))
+    :hints(("Goal" :in-theory (enable unsigned-byte-listp))))
+
+  (defthm unsigned-byte-p-of-car-when-unsigned-byte-listp
+    (implies (unsigned-byte-listp bytes x)
+             (equal (unsigned-byte-p bytes (car x))
+                    (consp x)))
+    :rule-classes (:rewrite :forward-chaining))
+
+  (defthm nat-listp-when-unsigned-byte-listp
+    (implies (unsigned-byte-listp bytes x)
+             (nat-listp x))
+    :hints(("Goal" :induct (len x))))
+
+  (defthm true-listp-when-unsigned-byte-listp
+    (implies (unsigned-byte-listp bytes x)
+             (true-listp x))
+    :hints(("Goal" :induct (len x))))
+
+  (defthm unsigned-byte-listp-of-append
+    (equal (unsigned-byte-listp bytes (append x y))
+           (and (unsigned-byte-listp bytes (list-fix x))
+                (unsigned-byte-listp bytes y)))
+    :hints(("Goal" :induct (len x))))
+
+  (defthm unsigned-byte-listp-of-list-fix-when-unsigned-byte-listp
+    (implies (unsigned-byte-listp bytes x)
+             (unsigned-byte-listp bytes (list-fix x))))
+
+  (defthm unsigned-byte-listp-of-repeat
+    (equal (unsigned-byte-listp bytes (repeat x n))
+           (or (zp n)
+               (unsigned-byte-p bytes x)))
+    :hints(("Goal" :in-theory (enable repeat))))
+
+  (defthm unsigned-byte-listp-of-take
+    (implies (unsigned-byte-listp bytes x)
+             (equal (unsigned-byte-listp bytes (take n x))
+                    (or (zp n)
+                        (<= n (len x))))))
+
+  (defthm unsigned-byte-listp-of-take-past-length
+    (implies (and (natp k)
+                  (< (len x) k))
+             (not (unsigned-byte-listp bytes (take k x)))))
+
+  (defthm unsigned-byte-listp-of-nthcdr
+    (implies (unsigned-byte-listp bytes x)
+             (unsigned-byte-listp bytes (nthcdr n x))))
+
+  (defthm unsigned-byte-listp-when-take-and-nthcdr
+    (implies (and (unsigned-byte-listp bytes (take n x))
+                  (unsigned-byte-listp bytes (nthcdr n x)))
+             (unsigned-byte-listp bytes x))))
+
+
+
diff -Nru acl2-6.2/books/str/abbrevs.lisp acl2-6.3/books/str/abbrevs.lisp
--- acl2-6.2/books/str/abbrevs.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/abbrevs.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -139,7 +139,7 @@
 (add-macro-alias strprefixp STR::strprefixp)
 
 (defmacro strsuffixp (x y) `(STR::strsuffixp ,x ,y))
-(add-macro-alias strprefixp STR::strsuffixp)
+(add-macro-alias strsuffixp STR::strsuffixp)
 
 (defmacro substrp (x y) `(STR::substrp ,x ,y))
 (add-macro-alias substrp STR::substrp)
diff -Nru acl2-6.2/books/str/acl2-customization.lsp acl2-6.3/books/str/acl2-customization.lsp
--- acl2-6.2/books/str/acl2-customization.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/acl2-customization.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
diff -Nru acl2-6.2/books/str/arithmetic.lisp acl2-6.3/books/str/arithmetic.lisp
--- acl2-6.2/books/str/arithmetic.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/arithmetic.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -19,13 +19,13 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "ACL2")
+(include-book "coerce")
 (include-book "arithmetic/top" :dir :system)
 (include-book "std/lists/take" :dir :system)
 (include-book "std/lists/len" :dir :system)
 (include-book "std/lists/nthcdr" :dir :system)
 (include-book "std/lists/append" :dir :system)
 (include-book "std/lists/repeat" :dir :system)
-(in-theory (enable acl2::make-list-ac->repeat))
 
 
 ;; BOZO fundamental lemmas that should probably be part of other libraries.
@@ -36,11 +36,6 @@
 (defthm eqlablep-when-characterp
   (implies (characterp x) (eqlablep x)))
 
-;; moved to std/lists/len
-;; (defthm len-zero
-;;   (equal (equal 0 (len x))
-;;          (not (consp x))))
-
 (defthm nth-of-len
   (equal (nth (len x) x)
          nil))
@@ -51,29 +46,6 @@
                   nil))
   :hints(("Goal" :in-theory (enable nth))))
 
-(defthm character-listp-of-repeat
-  (implies (characterp x)
-           (character-listp (acl2::repeat x n)))
-  :hints(("Goal" :in-theory (enable acl2::repeat))))
-
-;; moved to std/lists/append
-;; (defthm len-of-append
-;;   (equal (len (append x y))
-;;          (+ (len x)
-;;             (len y))))
-
-;; moved to std/lists/repeat
-;; (defthm consp-of-repeat
-;;   (equal (consp (acl2::repeat x n))
-;;          (not (zp n)))
-;;   :hints(("Goal" :in-theory (enable acl2::repeat))))
-
-;; moved to std/lists/append
-;; (defthm car-of-append
-;;   (equal (car (append x y))
-;;          (if (consp x)
-;;              (car x)
-;;            (car y))))
 
 (defthm car-of-repeat
   (equal (car (acl2::repeat x n))
@@ -82,38 +54,23 @@
            x))
   :hints(("Goal" :in-theory (enable acl2::repeat))))
 
-;; moved to std/lists/repeat
-;; (defthm append-of-repeat-to-cons-of-same
-;;   (equal (append (acl2::repeat a n) (cons a x))
-;;          (cons a (append (acl2::repeat a n) x)))
-;;   :hints(("Goal" :in-theory (enable acl2::repeat))))
-
-
 (defthm len-of-nonempty-string-is-positive
   (implies (and (stringp x)
                 (not (equal x "")))
-           (< 0 (len (coerce x 'list))))
-  :hints(("Goal"
-          :in-theory (disable coerce-inverse-2)
-          :use ((:instance coerce-inverse-2)))))
-
-;; moved to std/lists/take
-;; (defthm take-of-len
-;;   (equal (take (len x) x)
-;;          (list-fix x))
-;;   :hints(("Goal" :in-theory (enable take-redefinition))))
-
-;; moved to std/lists/take
-;; (defthm take-of-zero
-;;   (equal (take 0 x)
-;;          nil)
-;;   :hints(("Goal" :in-theory (enable take-redefinition))))
+           (< 0 (len (explode x))))
+  :rule-classes ((:rewrite) (:linear)))
+
+(defthm length-zero-when-stringp
+  (implies (stringp x)
+           (equal (equal 0 (length x))
+                  (equal x ""))))
+
+(defthm length-zero-when-stringp-alt
+  (implies (stringp x)
+           (equal (equal 0 (len (explode x)))
+                  (equal x ""))))
+
 
-(defthm character-listp-of-take
-  (implies (character-listp x)
-           (equal (character-listp (take n x))
-                  (<= (nfix n) (len x))))
-  :hints(("Goal" :in-theory (enable take-redefinition))))
 
 (defthm subsetp-equal-of-cons-right
   (implies (subsetp-equal x y)
@@ -123,103 +80,6 @@
   (subsetp-equal x x))
 
 
-;; Lemmas for working with character codes.
-
-(defthm equal-of-char-code-and-char-code
-  (implies (and (characterp x)
-                (characterp y))
-           (equal (equal (char-code x) (char-code y))
-                  (equal x y)))
-  :hints(("Goal" :use acl2::equal-char-code)))
-
-(defthm equal-of-char-code-and-constant
-  (implies (syntaxp (quotep c))
-           (equal (equal (char-code x) c)
-                  (if (characterp x)
-                      (and (natp c)
-                           (<= c 255)
-                           (equal x (code-char c)))
-                    (equal c 0)))))
-
-(defthm code-char-when-not-natp
-  (implies (not (natp x))
-           (equal (code-char x)
-                  (code-char 0)))
-  :hints(("Goal" :use ((:instance acl2::completion-of-code-char)))))
-
-(defthm equal-of-char-code-of-plus
-  (implies (and (syntaxp (quotep a))
-                (syntaxp (quotep const))
-                (characterp a)
-                (natp y)
-                (natp const)
-                (<= (+ const y) 255))
-           (equal (equal a (code-char (+ const y)))
-                  (equal y (- (char-code a) const)))))
-
-(encapsulate
- ()
- (local (defund exhaustive-test1 (x y)
-          (and (equal (equal (code-char x) (code-char y))
-                      (equal x y))
-               (or (zp y)
-                   (exhaustive-test1 x (- y 1))))))
-
- (local (defund exhaustive-test2 (x y)
-          (and (exhaustive-test1 x y)
-               (or (zp x)
-                   (exhaustive-test2 (- x 1) y)))))
-
- (local (defthm lemma1
-          (implies (and (exhaustive-test1 x y)
-                        (natp x)
-                        (natp y)
-                        (natp m)
-                        (<= m y)
-                        (<= x 255)
-                        (<= y 255))
-                   (equal (equal (code-char x) (code-char m))
-                          (equal x m)))
-          :hints(("Goal" :in-theory (enable exhaustive-test1)))))
-
- (local (defthm lemma2
-          (implies (and (exhaustive-test2 x y)
-                        (natp x)
-                        (natp y)
-                        (<= x 255)
-                        (<= y 255)
-                        (natp n)
-                        (natp m)
-                        (<= n x)
-                        (<= m y))
-                   (equal (equal (code-char n) (code-char m))
-                          (equal n m)))
-          :hints(("Goal"
-                  :in-theory (enable exhaustive-test2)
-                  :induct (exhaustive-test2 x y))
-                 ("Subgoal *1/1"
-                  :in-theory (disable lemma1)
-                  :use ((:instance lemma1
-                                   (x 0)
-                                   (m m)
-                                   (y y)))))))
-
- (defthm equal-of-code-chars
-   (implies (and (natp n)
-                 (natp m)
-                 (<= n 255)
-                 (<= m 255))
-            (equal (equal (code-char n) (code-char m))
-                   (equal n m)))
-   :hints(("Goal"
-           :in-theory (disable lemma2)
-           :use ((:instance lemma2
-                            (x 255)
-                            (y 255)
-                            (n n)
-                            (m m)))))))
-
-
 (encapsulate
   ()
   (local (defthm l1
@@ -257,10 +117,9 @@
                   0)
                  (t
                   (char-code a))))
-    :hints(("Goal" :in-theory (disable code-char-char-code-is-identity)))))
-
-
-
+    :hints(("Goal" :in-theory (e/d ()
+                                   (code-char-char-code-is-identity
+                                    str::equal-of-char-codes))))))
 
 
 (defthm characterp-of-car-when-character-listp
@@ -272,10 +131,18 @@
   (implies (character-listp x)
            (character-listp (cdr x))))
 
-(defthm equal-of-empty-string-rewrite
-  (implies (stringp x)
-           (equal (equal x "")
-                  (equal 0 (length x))))
-  :hints(("Goal"
-          :in-theory (disable len-of-nonempty-string-is-positive)
-          :use ((:instance len-of-nonempty-string-is-positive)))))
+(defthm character-listp-of-repeat
+  (implies (characterp x)
+           (character-listp (acl2::repeat x n)))
+  :hints(("Goal" :in-theory (enable acl2::repeat))))
+
+(defthm character-listp-of-take
+  (implies (character-listp x)
+           (equal (character-listp (take n x))
+                  (<= (nfix n) (len x))))
+  :hints(("Goal" :in-theory (enable take-redefinition))))
+
+(defthm character-listp-of-rev
+  (equal (character-listp (rev x))
+         (character-listp (list-fix x)))
+  :hints(("Goal" :induct (len x))))
diff -Nru acl2-6.2/books/str/base64.lisp acl2-6.3/books/str/base64.lisp
--- acl2-6.2/books/str/base64.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/base64.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -140,7 +140,7 @@
 
          (defthm characterp-of-char
            (equal (characterp (char s n))
-                  (< (nfix n) (len (coerce s 'list)))))))
+                  (< (nfix n) (len (explode s)))))))
 
 (local (defsection unsigned-byte-p-lemmas
 
@@ -327,7 +327,7 @@
              (equal (b64-value-from-code (char-code (b64-char-from-value value)))
                     value))
     :hints(("Goal" :in-theory (e/d (b64-char-from-value unsigned-byte-p)
-                                   (acl2::equal-of-char-code-and-constant))))))
+                                   (equal-of-char-code-and-constant))))))
 
 
 
@@ -948,7 +948,7 @@
                   (force (equal xl (length x)))
                   (force (< n xl)))
              (equal (b64-encode-last-group-str x n xl)
-                    (b64-encode-last-group (nthcdr n (coerce x 'list)))))
+                    (b64-encode-last-group (nthcdr n (explode x)))))
     :hints(("Goal"
             :in-theory (e/d (b64-encode-last-group char)
                             (nthcdr nth))
@@ -986,14 +986,14 @@
                          (equal xl (length x))
                          (<= n xl))
                     (equal (b64-encode-str-impl x n xl acc)
-                           (b64-encode-list-impl (nthcdr n (coerce x 'list)) acc)))
+                           (b64-encode-list-impl (nthcdr n (explode x)) acc)))
            :hints(("Goal"
                    :induct (b64-encode-str-impl x n xl acc)
                    :in-theory (e/d (b64-encode-list-impl
                                     char)
                                    (b64-encode-list-impl-removal))
                    :expand ((b64-encode-str-impl x n xl acc)
-                            (b64-encode-list-impl (nthcdr n (coerce x 'list)) acc))
+                            (b64-encode-list-impl (nthcdr n (explode x)) acc))
                    :do-not '(generalize fertilize)
                    :do-not-induct t))))
   (defthm b64-encode-str-impl-removal
@@ -1002,7 +1002,7 @@
                   (equal xl (length x))
                   (<= n xl))
              (equal (b64-encode-str-impl x n xl acc)
-                    (revappend (base64-encode-list (nthcdr n (coerce x 'list)))
+                    (revappend (base64-encode-list (nthcdr n (explode x)))
                                acc)))
     :hints(("Goal" :in-theory (disable b64-encode-str-impl)))))
 
@@ -1012,7 +1012,7 @@
   :parents (base64)
   :short "Base64 encode a string."
   (declare (type string x))
-  (mbe :logic (coerce (base64-encode-list (coerce x 'list)) 'string)
+  (mbe :logic (implode (base64-encode-list (explode x)))
        :exec (rchars-to-string (b64-encode-str-impl x 0 (length x) nil))))
 
 (define base64-revappend-encode
@@ -1070,13 +1070,13 @@
                          (equal xl (length x))
                          (<= n xl))
                     (equal (b64-decode-str-impl x n xl acc)
-                           (b64-decode-list-impl (nthcdr n (coerce x 'list)) acc)))
+                           (b64-decode-list-impl (nthcdr n (explode x)) acc)))
            :hints(("Goal"
                    :induct (b64-decode-str-impl x n xl acc)
                    :in-theory (e/d (b64-decode-list-impl char)
                                    (b64-decode-list-impl-removal))
                    :expand ((b64-decode-str-impl x n xl acc)
-                            (b64-decode-list-impl (nthcdr n (coerce x 'list)) acc))
+                            (b64-decode-list-impl (nthcdr n (explode x)) acc))
                    :do-not '(generalize fertilize)
                    :do-not-induct t))))
   (defthm b64-decode-str-impl-removal
@@ -1085,7 +1085,7 @@
                   (equal xl (length x))
                   (<= n xl))
              (equal (b64-decode-str-impl x n xl acc)
-                    (let ((chars (nthcdr n (coerce x 'list))))
+                    (let ((chars (nthcdr n (explode x))))
                       (mv (mv-nth 0 (base64-decode-list chars))
                           (revappend (mv-nth 1 (base64-decode-list chars))
                                      acc)))))
@@ -1110,8 +1110,8 @@
   (declare (type string x))
   (mbe :logic
        (b* (((mv okp chars)
-             (base64-decode-list (coerce x 'list))))
-         (mv okp (coerce chars 'string)))
+             (base64-decode-list (explode x))))
+         (mv okp (implode chars)))
        :exec
        (b* (((mv okp rchars)
              (b64-decode-str-impl x 0 (length x) nil)))
diff -Nru acl2-6.2/books/str/case-conversion.lisp acl2-6.3/books/str/case-conversion.lisp
--- acl2-6.2/books/str/case-conversion.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/case-conversion.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -21,17 +21,13 @@
 ;
 ; Original author: Sol Swords <sswords@centtech.com>
 ;
-; Updated by Jared Davis <jared@centtech.com> to add documentation and improve
-; efficiency in some cases.
+; Updated by Jared Davis <jared@centtech.com> to add documentation, improve
+; efficiency in some cases, and integrate into congruences.
 
 (in-package "STR")
-(include-book "char-case")
+(include-book "ieqv")
 (include-book "cat")
 (local (include-book "arithmetic"))
-(local (include-book "std/lists/rev" :dir :system))
-(local (include-book "std/lists/coerce" :dir :system))
-(local (include-book "std/lists/take" :dir :system))
-(local (include-book "std/lists/nthcdr" :dir :system))
 (local (include-book "subseq"))
 
 (local (defthm append-singleton-crock
@@ -39,7 +35,7 @@
                 (append a (cons x y)))))
 
 (defsection upcase-charlist
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert every character in a list to upper case."
 
   :long "<p>@(call upcase-charlist) maps @(see upcase-char) across a character
@@ -89,11 +85,34 @@
                             upcase-charlist-aux
                             charlist-has-some-down-alpha-p)))
 
+  (defthm upcase-charlist-when-atom
+    (implies (atom x)
+             (equal (upcase-charlist x)
+                    nil)))
+
+  (defthm upcase-charlist-of-cons
+    (equal (upcase-charlist (cons a x))
+           (cons (upcase-char a)
+                 (upcase-charlist x))))
+
+  (defcong icharlisteqv equal (upcase-charlist x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv))))
+
   (defthm character-listp-upcase-charlist
     (character-listp (upcase-charlist x)))
 
-  (defcong charlisteqv equal (upcase-charlist x) 1
-    :hints(("Goal" :in-theory (enable charlisteqv))))
+  (defthm consp-of-upcase-charlist
+    (equal (consp (upcase-charlist x))
+           (consp x)))
+
+  (defthm upcase-charlist-under-iff
+    (iff (upcase-charlist x)
+         (consp x))
+    :hints(("Goal" :in-theory (enable upcase-charlist))))
+
+  (defthm len-of-upcase-charlist
+    (equal (len (upcase-charlist x))
+           (len x)))
 
   (defthm upcase-charlist-aux-is-upcase-charlist
     (equal (upcase-charlist-aux x acc)
@@ -108,20 +127,14 @@
 
   (verify-guards upcase-charlist)
 
-  (defthm len-of-upcase-charlist
-    (equal (len (upcase-charlist x))
-           (len x)))
-
   (defthm string-upcase1-is-upcase-charlist
     (equal (acl2::string-upcase1 x)
            (upcase-charlist (double-rewrite x)))))
 
 
 
-
-
 (defsection downcase-charlist
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert every character in a list to lower case."
 
   :long "<p>@(call downcase-charlist) maps @(see downcase-char) across a
@@ -171,11 +184,34 @@
                             downcase-charlist-aux
                             charlist-has-some-up-alpha-p)))
 
+  (defthm downcase-charlist-when-atom
+    (implies (atom x)
+             (equal (downcase-charlist x)
+                    nil)))
+
+  (defthm downcase-charlist-of-cons
+    (equal (downcase-charlist (cons a x))
+           (cons (downcase-char a)
+                 (downcase-charlist x))))
+
+  (defcong icharlisteqv equal (downcase-charlist x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv))))
+
   (defthm character-listp-downcase-charlist
     (character-listp (downcase-charlist x)))
 
-  (defcong charlisteqv equal (downcase-charlist x) 1
-    :hints(("Goal" :in-theory (enable charlisteqv))))
+  (defthm consp-of-downcase-charlist
+    (equal (consp (downcase-charlist x))
+           (consp x)))
+
+  (defthm downcase-charlist-under-iff
+    (iff (downcase-charlist x)
+         (consp x))
+    :hints(("Goal" :in-theory (enable downcase-charlist))))
+
+  (defthm len-of-downcase-charlist
+    (equal (len (downcase-charlist x))
+           (len x)))
 
   (defthm downcase-charlist-aux-is-downcase-charlist
     (equal (downcase-charlist-aux x acc)
@@ -189,10 +225,6 @@
 
   (verify-guards downcase-charlist)
 
-  (defthm len-of-downcase-charlist
-    (equal (len (downcase-charlist x))
-           (len x)))
-
   (defthm string-downcase1-redef
     (equal (acl2::string-downcase1 x)
            (downcase-charlist (double-rewrite x)))))
@@ -201,7 +233,7 @@
 
 
 (defsection upcase-string
-  :parents (case-conversion acl2::string-upcase)
+  :parents (cases acl2::string-upcase)
   :short "Convert a string to upper case."
 
   :long "<p>@(call upcase-string) converts a string to upper case, effectively
@@ -252,8 +284,6 @@
       (or (down-alpha-p (char x n))
           (string-has-some-down-alpha-p x (+ 1 (lnfix n)) xl))))
 
-
-
   (defund upcase-string-aux (x n xl acc)
     (declare (type string x)
              (type integer n)
@@ -274,7 +304,7 @@
   (defund upcase-string (x)
     (declare (type string x)
              (xargs :verify-guards nil))
-    (mbe :logic (coerce (upcase-charlist (coerce x 'list)) 'string)
+    (mbe :logic (implode (upcase-charlist (explode x)))
          :exec
          (let ((xl (length x)))
            (if (not (string-has-some-down-alpha-p x 0 xl))
@@ -283,6 +313,8 @@
              (rchars-to-string
               (upcase-string-aux x 0 xl nil))))))
 
+  (local (in-theory (enable upcase-string)))
+
   (defthm string-has-some-down-alpha-p-redef
     (implies (and (stringp x)
                   (natp n)
@@ -290,7 +322,7 @@
                   (= xl (length x))
                   (<= n xl))
              (equal (string-has-some-down-alpha-p x n xl)
-                    (charlist-has-some-down-alpha-p (nthcdr n (coerce x 'list)))))
+                    (charlist-has-some-down-alpha-p (nthcdr n (explode x)))))
     :hints(("Goal" :in-theory (enable string-has-some-down-alpha-p
                                       charlist-has-some-down-alpha-p))))
 
@@ -301,32 +333,35 @@
                   (= xl (length x))
                   (<= n xl))
              (equal (upcase-string-aux x n xl acc)
-                    (revappend (upcase-charlist (nthcdr n (coerce x 'list)))
+                    (revappend (upcase-charlist (nthcdr n (explode x)))
                                acc)))
     :hints(("Goal" :in-theory (enable upcase-string-aux
                                       upcase-charlist))))
 
   (verify-guards upcase-string)
 
+  (defcong istreqv equal (upcase-string x) 1)
+
   (defthm len-of-upcase-string
-    (equal (len (coerce (upcase-string x) 'list))
-           (len (coerce x 'list)))
-    :hints(("Goal" :in-theory (enable upcase-string))))
+    (equal (len (explode (upcase-string x)))
+           (len (explode x))))
 
   (defthm length-of-upcase-string
     (equal (length (upcase-string x))
-           (length (coerce x 'list))))
+           (len (explode x))))
+
+  (defthm equal-of-empty-string-with-upcase-string
+    (equal (equal ""  (upcase-string x))
+           (atom (explode x))))
 
   (defthm string-upcase-is-upcase-string
     (equal (acl2::string-upcase x)
-           (upcase-string x))
-    :hints(("Goal" :in-theory (enable upcase-string)))))
-
+           (upcase-string (double-rewrite x)))))
 
 
 
 (defsection downcase-string
-  :parents (case-conversion acl2::string-downcase)
+  :parents (cases acl2::string-downcase)
   :short "Convert a string to lower case."
 
   :long "<p>@(call downcase-string) converts a string to lower case,
@@ -377,7 +412,7 @@
   (defund downcase-string (x)
     (declare (type string x)
              (xargs :verify-guards nil))
-    (mbe :logic (coerce (downcase-charlist (coerce x 'list)) 'string)
+    (mbe :logic (implode (downcase-charlist (explode x)))
          :exec
          (let ((xl (length x)))
            (if (not (string-has-some-up-alpha-p x 0 xl))
@@ -385,6 +420,8 @@
                x
              (rchars-to-string (downcase-string-aux x 0 xl nil))))))
 
+  (local (in-theory (enable downcase-string)))
+
   (defthm string-has-some-up-alpha-p-redef
     (implies (and (stringp x)
                   (natp n)
@@ -392,7 +429,7 @@
                   (= xl (length x))
                   (<= n xl))
              (equal (string-has-some-up-alpha-p x n xl)
-                    (charlist-has-some-up-alpha-p (nthcdr n (coerce x 'list)))))
+                    (charlist-has-some-up-alpha-p (nthcdr n (explode x)))))
     :hints(("Goal" :in-theory (enable string-has-some-up-alpha-p
                                       charlist-has-some-up-alpha-p))))
 
@@ -403,31 +440,35 @@
                   (= xl (length x))
                   (<= n xl))
              (equal (downcase-string-aux x n xl acc)
-                    (revappend (downcase-charlist (nthcdr n (coerce x 'list)))
+                    (revappend (downcase-charlist (nthcdr n (explode x)))
                                acc)))
     :hints(("Goal" :in-theory (enable downcase-string-aux
                                       downcase-charlist))))
 
   (verify-guards downcase-string)
 
+  (defcong istreqv equal (downcase-string x) 1)
+
   (defthm len-of-downcase-string
-    (equal (len (coerce (downcase-string x) 'list))
-           (len (coerce x 'list)))
-    :hints(("Goal" :in-theory (enable downcase-string))))
+    (equal (len (explode (downcase-string x)))
+           (len (explode x))))
 
   (defthm length-of-downcase-string
     (equal (length (downcase-string x))
-           (len (coerce x 'list))))
+           (len (explode x))))
+
+  (defthm equal-of-empty-string-with-downcase-string
+    (equal (equal ""  (downcase-string x))
+           (atom (explode x))))
 
   (defthm string-downcase-is-downcase-string
     (equal (acl2::string-downcase x)
-           (downcase-string x))
-    :hints(("Goal" :in-theory (enable downcase-string)))))
+           (downcase-string (double-rewrite x)))))
 
 
 
 (defsection upcase-string-list
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert every string in a list to upper case."
 
   (defund upcase-string-list-aux (x acc)
@@ -464,7 +505,7 @@
 
 
 (defsection downcase-string-list
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert every string in a list to lower case."
 
   (defund downcase-string-list-aux (x acc)
@@ -501,7 +542,7 @@
 
 
 (defsection upcase-first-charlist
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert the first character of a character list to upper case."
 
   (defund upcase-first-charlist (x)
@@ -509,7 +550,8 @@
     (mbe :logic
          (if (atom x)
              nil
-           (cons (upcase-char (car x)) (cdr x)))
+           (cons (upcase-char (car x))
+                 (make-character-list (cdr x))))
          :exec
          (cond ((atom x)
                 nil)
@@ -520,6 +562,9 @@
 
   (local (in-theory (enable upcase-first-charlist)))
 
+  (defcong charlisteqv  equal        (upcase-first-charlist x) 1)
+  (defcong icharlisteqv icharlisteqv (upcase-first-charlist x) 1)
+
   (defthm upcase-first-charlist-when-atom
     (implies (atom x)
              (equal (upcase-first-charlist x)
@@ -531,12 +576,21 @@
 
   (defthm len-of-upcase-first-charlist
     (equal (len (upcase-first-charlist x))
-           (len x))))
+           (len x)))
+
+  (defthm consp-of-upcase-first-charlist
+    (equal (consp (upcase-first-charlist x))
+           (consp x)))
+
+  (defthm upcase-first-charlist-under-iff
+    (iff (upcase-first-charlist x)
+         (consp x))))
+
 
 
 
 (defsection upcase-first
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert the first character of a string to upper case."
 
   :long "<p>@(call upcase-first) returns a copy of the string @('x') except
@@ -550,7 +604,7 @@
     (declare (type string x)
              (xargs :verify-guards nil))
     (mbe :logic
-         (coerce (upcase-first-charlist (coerce x 'list)) 'string)
+         (implode (upcase-first-charlist (explode x)))
          :exec
          (if (eql (length x) 0)
              x
@@ -568,13 +622,15 @@
 
   (defthm stringp-of-upcase-first
     (stringp (upcase-first x))
-    :rule-classes :type-prescription))
+    :rule-classes :type-prescription)
 
+  (defcong streqv equal (upcase-first x) 1)
+  (defcong istreqv istreqv (upcase-first x) 1))
 
 
 
 (defsection downcase-first-charlist
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert the first character of a character list to downper case."
 
   (defund downcase-first-charlist (x)
@@ -582,7 +638,8 @@
     (mbe :logic
          (if (atom x)
              nil
-           (cons (downcase-char (car x)) (cdr x)))
+           (cons (downcase-char (car x))
+                 (make-character-list (cdr x))))
          :exec
          (cond ((atom x)
                 nil)
@@ -593,6 +650,9 @@
 
   (local (in-theory (enable downcase-first-charlist)))
 
+  (defcong charlisteqv  equal        (downcase-first-charlist x) 1)
+  (defcong icharlisteqv icharlisteqv (downcase-first-charlist x) 1)
+
   (defthm downcase-first-charlist-when-atom
     (implies (atom x)
              (equal (downcase-first-charlist x)
@@ -604,11 +664,20 @@
 
   (defthm len-of-downcase-first-charlist
     (equal (len (downcase-first-charlist x))
-           (len x))))
+           (len x)))
+
+  (defthm consp-of-downcase-first-charlist
+    (equal (consp (downcase-first-charlist x))
+           (consp x)))
+
+  (defthm downcase-first-charlist-under-iff
+    (iff (downcase-first-charlist x)
+         (consp x))))
+
 
 
 (defsection downcase-first
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert the first character of a string to downper case."
 
   :long "<p>@(call downcase-first) returns a copy of the string @('x') except
@@ -622,7 +691,7 @@
     (declare (type string x)
              (xargs :verify-guards nil))
     (mbe :logic
-         (coerce (downcase-first-charlist (coerce x 'list)) 'string)
+         (implode (downcase-first-charlist (explode x)))
          :exec
          (if (eql (length x) 0)
              x
@@ -640,5 +709,9 @@
 
   (defthm stringp-of-downcase-first
     (stringp (downcase-first x))
-    :rule-classes :type-prescription))
+    :rule-classes :type-prescription)
+
+  (defcong streqv equal (downcase-first x) 1)
+  (defcong istreqv istreqv (downcase-first x) 1))
+
 
diff -Nru acl2-6.2/books/str/cat.lisp acl2-6.3/books/str/cat.lisp
--- acl2-6.2/books/str/cat.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/cat.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -19,14 +19,11 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "STR")
-(include-book "xdoc/top" :dir :system)
-(include-book "misc/definline" :dir :system)
+(include-book "ieqv")
 (include-book "tools/bstar" :dir :system)
 (include-book "std/lists/list-defuns" :dir :system)
 (local (include-book "arithmetic"))
-(local (include-book "std/lists/take" :dir :system))
 (local (include-book "std/lists/equiv" :dir :system))
-(local (include-book "std/lists/rev" :dir :system))
 
 (defsection cat
   :parents (concatenation)
@@ -35,14 +32,7 @@
   :long "<p>@('(str::cat x y z ...)') is like @('(concatenate 'string x y z
 ...)'), but is less to type.</p>
 
-<p>Warning: concatenating strings is fundamentally slow.  This is because
-Common Lisp strings are just arrays of characters, but there is not really any
-mechanism that allows you to efficiently splice arrays together.  In other
-words, any kind of string concatenation minimally requires creating a
-completely new array and copying all of the input characters into it.</p>
-
-<p>This makes it especially slow to repeatedly use @('cat') to build up a
-string.  If that's your goal, you might instead consider using the approach
+<p>  If that's your goal, you might instead consider using the approach
 outlined in @(see revappend-chars).</p>
 
 <p>In some Lisps, using @('(concatenate 'string ...)') to join strings can be
@@ -71,8 +61,7 @@
     ;; We don't inline this because you might want to develop books without
     ;; fast-cat (for fewer ttags), but then include fast-cat later for more
     ;; performance.
-    (declare (xargs :guard (and (stringp str1)
-                                (stringp str2))))
+    (declare (type string str1 str2))
     (string-append str1 str2))
 
   (defun fast-string-append-lst (x)
@@ -109,8 +98,7 @@
   :long "<p>@(call append-chars) takes the characters from the string @('x')
 and appends them onto @('y').</p>
 
-<p>Its logical definition is nothing more than @('(append (coerce x 'list)
-y)').</p>
+<p>Its logical definition is nothing more than @('(append (explode x) y)').</p>
 
 <p>In the execution, we traverse the string @('x') using @(see char) to avoid
 the overhead of @(see coerce)-ing it into a character list before performing
@@ -142,7 +130,7 @@
                   (natp n)
                   (< n (length x)))
              (equal (append-chars-aux x n y)
-                    (append (take (+ 1 n) (coerce x 'list)) y)))
+                    (append (take (+ 1 n) (explode x)) y)))
     :hints(("Goal"
             :in-theory (enable append-chars-aux)
             :induct (append-chars-aux x n y))))
@@ -154,12 +142,12 @@
                          (natp n)
                          (< n (length x)))
                     (equal (append-chars-aux x n y)
-                           (append (take (+ 1 n) (coerce x 'list)) y)))
+                           (append (take (+ 1 n) (explode x)) y)))
            :hints(("Goal" :use ((:instance append-chars-aux-correct))))))
 
   (definlined append-chars (x y)
     (declare (type string x))
-    (mbe :logic (append (coerce x 'list) y)
+    (mbe :logic (append (explode x) y)
          :exec (b* (((the (integer 0 *) xl) (length x))
                     ((when (eql xl 0))
                      y)
@@ -172,7 +160,13 @@
     (equal (character-listp (append-chars x y))
            (character-listp y)))
 
-  (defcong list-equiv list-equiv (append-chars x y) 2))
+  (defcong streqv equal (append-chars x y) 1)
+  (defcong istreqv icharlisteqv (append-chars x y) 1)
+  (defcong list-equiv list-equiv (append-chars x y) 2)
+  (defcong charlisteqv charlisteqv (append-chars x y) 2)
+  (defcong icharlisteqv icharlisteqv (append-chars x y) 2))
+
+
 
 
 (defsection revappend-chars
@@ -182,8 +176,7 @@
   :long "<p>@(call revappend-chars) takes the characters from the string
 @('x'), reverses them, and appends the result onto @('y').</p>
 
-<p>Its logical definition is nothing more than @('(revappend (coerce x 'list)
-y)').</p>
+<p>Its logical definition is nothing more than @('(revappend (explode x) y)').</p>
 
 <p>In the execution, we traverse the string @('x') using @(see char) to avoid
 the overhead of @(see coerce)-ing it into a character list before performing
@@ -199,7 +192,7 @@
         (acc (str::revappend-chars \"Hello, \" acc))
         (acc (str::revappend-chars \"World!\" acc))
         (acc ...))
-    (reverse (coerce acc 'string)))
+    (reverse (implode acc)))
 })
 
 <p>Is essentially the same as:</p>
@@ -227,7 +220,8 @@
              :exec (eql n xl))
         y
       (revappend-chars-aux x
-                           (the (integer 0 *) (+ 1 (lnfix n)))
+                           (the (integer 0 *)
+                             (+ 1 (the (integer 0 *) (lnfix n))))
                            xl
                            (cons (char x n) y))))
 
@@ -238,7 +232,7 @@
                   (<= n xl)
                   (equal xl (length x)))
              (equal (revappend-chars-aux x n xl y)
-                    (revappend (nthcdr n (coerce x 'list)) y)))
+                    (revappend (nthcdr n (explode x)) y)))
     :hints(("Goal"
             :in-theory (e/d (revappend-chars-aux)
                             (acl2::revappend-removal))
@@ -247,7 +241,7 @@
   (definlined revappend-chars (x y)
     (declare (xargs :guard (stringp x))
              (type string x))
-    (mbe :logic (revappend (coerce x 'list) y)
+    (mbe :logic (revappend (explode x) y)
          :exec (revappend-chars-aux x 0 (length x) y)))
 
   (local (in-theory (enable revappend-chars)))
@@ -256,7 +250,11 @@
     (equal (character-listp (revappend-chars x y))
            (character-listp y)))
 
-  (defcong list-equiv list-equiv (revappend-chars x y) 2))
+  (defcong streqv equal (revappend-chars x y) 1)
+  (defcong istreqv icharlisteqv (revappend-chars x y) 1)
+  (defcong list-equiv list-equiv (revappend-chars x y) 2)
+  (defcong charlisteqv charlisteqv (revappend-chars x y) 2)
+  (defcong icharlisteqv icharlisteqv (revappend-chars x y) 2))
 
 
 
@@ -335,6 +333,8 @@
     (equal (len (prefix-strings prefix x))
            (len x)))
 
+  (defcong streqv equal (prefix-strings prefix x) 1)
+
   (local (defthmd l0
            (equal (prefix-strings prefix (list-fix x))
                   (prefix-strings prefix x))))
@@ -463,5 +463,9 @@
   (defcong list-equiv equal (join x separator) 1
     :hints(("Goal" :in-theory (enable list-equiv)
             :use ((:instance l0 (x x))
-                  (:instance l0 (x acl2::x-equiv)))))))
+                  (:instance l0 (x acl2::x-equiv))))))
+
+  (defcong streqv equal (join x separator) 2)
+  (defcong istreqv istreqv (join x separator) 2))
+
 
diff -Nru acl2-6.2/books/str/cert.acl2 acl2-6.3/books/str/cert.acl2
--- acl2-6.2/books/str/cert.acl2	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/cert.acl2	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -18,5 +18,7 @@
 ;
 ; Original author: Jared Davis <jared@centtech.com>
 
+(include-book "cutil/portcullis" :dir :system)
 (include-book "portcullis")
+
 ; cert-flags: ? t :ttags :all
\ No newline at end of file
diff -Nru acl2-6.2/books/str/char-case.lisp acl2-6.3/books/str/char-case.lisp
--- acl2-6.2/books/str/char-case.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/char-case.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -36,7 +36,7 @@
 
 
 (defsection up-alpha-p
-  :parents (case-conversion acl2::upper-case-p)
+  :parents (cases acl2::upper-case-p)
   :short "Determine if a character is an upper-case letter (A-Z)."
 
   :long "<p>@(call up-alpha-p) determines if @('x') is an upper-case alphabetic
@@ -111,12 +111,15 @@
 
   (defthm upper-case-p-is-up-alpha-p
     (equal (acl2::upper-case-p x)
-           (up-alpha-p (double-rewrite x)))))
+           (up-alpha-p (double-rewrite x))))
+
+  ;; No longer necessary since we'll rewrite upper-case-p away
+  (in-theory (disable acl2::upper-case-p-char-upcase)))
 
 
 
 (defsection down-alpha-p
-  :parents (case-conversion acl2::lower-case-p)
+  :parents (cases acl2::lower-case-p)
   :short "Determine if a character is a lower-case letter (a-z)."
 
   :long "<p>@(call down-alpha-p) determines if @('x') is an lower-case
@@ -191,12 +194,21 @@
 
   (defthm lower-case-p-is-down-alpha-p
     (equal (acl2::lower-case-p x)
-           (down-alpha-p (double-rewrite x)))))
+           (down-alpha-p (double-rewrite x))))
+
+  ;; No longer necessary since we'll rewrite lower-case-p away
+  (in-theory (disable acl2::lower-case-p-char-downcase))
+
+  (defthm down-alpha-p-when-up-alpha-p
+    (implies (up-alpha-p x)
+             (not (down-alpha-p x)))
+    :hints(("Goal" :in-theory (enable up-alpha-p
+                                      down-alpha-p)))))
 
 
 
 (defsection upcase-char
-  :parents (case-conversion acl2::char-upcase)
+  :parents (cases acl2::char-upcase)
   :short "Convert a character to upper-case."
 
   :long "<p>@(call upcase-char) converts lower-case characters into their
@@ -224,6 +236,10 @@
                     (char-fix x)))
     :hints(("Goal" :in-theory (enable down-alpha-p))))
 
+  (defthm upcase-char-of-upcase-char
+    (equal (upcase-char (upcase-char x))
+           (upcase-char x)))
+
   ;; Rewrite ACL2's char-upcase to upcase-char.  It seems simplest to just do
   ;; the proof by exhaustive testing.
 
@@ -293,8 +309,9 @@
 
 
 
+
 (defsection downcase-char
-  :parents (case-conversion acl2::char-downcase)
+  :parents (cases acl2::char-downcase)
   :short "Convert a character to lower-case."
 
   :long "<p>@(call downcase-char) converts upper-case characters into their
@@ -323,6 +340,22 @@
                     (char-fix x)))
     :hints(("Goal" :in-theory (enable up-alpha-p))))
 
+  (defthm downcase-char-of-downcase-char
+    (equal (downcase-char (downcase-char x))
+           (downcase-char x)))
+
+  (defthm downcase-char-of-upcase-char
+    (equal (downcase-char (upcase-char x))
+           (downcase-char x))
+    :hints(("Goal" :in-theory (enable upcase-char
+                                      char-fix))))
+
+  (defthm upcase-char-of-downcase-char
+    (equal (upcase-char (downcase-char x))
+           (upcase-char x))
+    :hints(("Goal" :in-theory (enable upcase-char
+                                      char-fix))))
+
   ;; Rewrite ACL2's char-downcase to downcase-char.  It seems simplest to just do
   ;; the proof by exhaustive testing.
 
@@ -388,17 +421,17 @@
 
   (defthm char-downcase-is-downcase-char
     (equal (acl2::char-downcase x)
-           (downcase-char x))))
+           (downcase-char (double-rewrite x)))))
 
 
 
 (defsection upcase-char-str
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert a character into an upper-case one-element string."
   :long "<p>@(call upcase-char-str) is logically equal to:</p>
 
 @({
- (coerce (list (upcase-char c)) 'string)
+ (implode (list (upcase-char c)))
 })
 
 <p>But we store these strings in a table so that they don't have to be
@@ -409,7 +442,7 @@
     (declare (xargs :guard (and (natp n)
                                 (<= n 255))
                     :ruler-extenders :all))
-    (cons (cons n (coerce (list (upcase-char (code-char n))) 'string))
+    (cons (cons n (implode (list (upcase-char (code-char n)))))
           (if (zp n)
               nil
             (make-upcase-first-strtbl (- n 1)))))
@@ -425,7 +458,7 @@
   (local (defun test (n)
            (declare (xargs :ruler-extenders :all))
            (and (equal (aref1 '*upcase-first-strtbl* *upcase-first-strtbl* n)
-                       (coerce (list (upcase-char (code-char n))) 'string))
+                       (implode (list (upcase-char (code-char n)))))
                 (if (zp n)
                     t
                   (test (- n 1))))))
@@ -437,30 +470,30 @@
                          (<= n 255)
                          (test n))
                     (equal (aref1 '*upcase-first-strtbl* *upcase-first-strtbl* i)
-                           (coerce (list (upcase-char (code-char i))) 'string)))
+                           (implode (list (upcase-char (code-char i))))))
            :hints(("Goal" :induct (test n)))))
 
   (local (defthm l1
            (implies (and (natp i)
                          (<= i 255))
                     (equal (aref1 '*upcase-first-strtbl* *upcase-first-strtbl* i)
-                           (coerce (list (upcase-char (code-char i))) 'string)))
+                           (implode (list (upcase-char (code-char i))))))
            :hints(("Goal" :use ((:instance l0 (n 255)))))))
 
   (definline upcase-char-str (c)
     (declare (type character c))
-    (mbe :logic (coerce (list (upcase-char c)) 'string)
+    (mbe :logic (implode (list (upcase-char c)))
          :exec (aref1 '*upcase-first-strtbl* *upcase-first-strtbl* (char-code c)))))
 
 
 
 (defsection downcase-char-str
-  :parents (case-conversion)
+  :parents (cases)
   :short "Convert a character into a lower-case one-element string."
   :long "<p>@(call downcase-char-str) is logically equal to:</p>
 
 @({
- (coerce (list (downcase-char c)) 'string)
+ (implode (downcase-char c))
 })
 
 <p>But we store these strings in a table so that they don't have to be
@@ -471,7 +504,7 @@
      (declare (xargs :guard (and (natp n)
                                  (<= n 255))
                      :ruler-extenders :all))
-    (cons (cons n (coerce (list (downcase-char (code-char n))) 'string))
+    (cons (cons n (implode (list (downcase-char (code-char n)))))
           (if (zp n)
               nil
             (make-downcase-first-strtbl (- n 1)))))
@@ -487,7 +520,7 @@
   (local (defun test (n)
            (declare (xargs :ruler-extenders :all))
            (and (equal (aref1 '*downcase-first-strtbl* *downcase-first-strtbl* n)
-                       (coerce (list (downcase-char (code-char n))) 'string))
+                       (implode (list (downcase-char (code-char n)))))
                 (if (zp n)
                     t
                   (test (- n 1))))))
@@ -499,18 +532,18 @@
                          (<= n 255)
                          (test n))
                     (equal (aref1 '*downcase-first-strtbl* *downcase-first-strtbl* i)
-                           (coerce (list (downcase-char (code-char i))) 'string)))
+                           (implode (list (downcase-char (code-char i))))))
            :hints(("Goal" :induct (test n)))))
 
   (local (defthm l1
            (implies (and (natp i)
                          (<= i 255))
                     (equal (aref1 '*downcase-first-strtbl* *downcase-first-strtbl* i)
-                           (coerce (list (downcase-char (code-char i))) 'string)))
+                           (implode (list (downcase-char (code-char i))))))
            :hints(("Goal" :use ((:instance l0 (n 255)))))))
 
   (definline downcase-char-str (c)
     (declare (type character c))
-    (mbe :logic (coerce (list (downcase-char c)) 'string)
+    (mbe :logic (implode (list (downcase-char c)))
          :exec (aref1 '*downcase-first-strtbl* *downcase-first-strtbl* (char-code c)))))
 
diff -Nru acl2-6.2/books/str/char-fix.lisp acl2-6.3/books/str/char-fix.lisp
--- acl2-6.2/books/str/char-fix.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/str/char-fix.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,137 @@
+; ACL2 String Library
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "STR")
+(include-book "xdoc/top" :dir :system)
+(include-book "misc/definline" :dir :system)
+
+(defsection code-char-lemmas
+  :parents (code-char)
+  :short "Lemmas about @(see code-char) from the @(see str) library."
+
+  (defthm default-code-char
+    (implies (or (zp x)
+                 (not (< x 256)))
+             (equal (code-char x)
+                    (code-char 0)))
+    :hints(("Goal" :use ((:instance completion-of-code-char)))))
+
+  (local (defthm l0
+           (implies (not (or (zp x)
+                             (not (< x 256))))
+                    (not (equal (code-char x)
+                                (code-char 0))))
+           :hints(("Goal" :use ((:instance char-code-code-char-is-identity (n x)))))))
+
+  (local (defthm l1
+           (equal (equal (code-char x)
+                         (code-char 0))
+                  (or (zp x)
+                      (not (< x 256))))))
+
+  (local (defthm l2
+           (implies (and (natp n)
+                         (natp m)
+                         (< n 256)
+                         (< m 256))
+                    (equal (equal (code-char n) (code-char m))
+                           (equal n m)))
+           :hints(("Goal"
+                   :in-theory (disable char-code-code-char-is-identity)
+                   :use ((:instance char-code-code-char-is-identity (n n))
+                         (:instance char-code-code-char-is-identity (n m)))))))
+
+  (defthm equal-of-code-char-and-code-char
+    (equal (equal (code-char x) (code-char y))
+           (let ((zero-x (or (zp x) (>= x 256)))
+                 (zero-y (or (zp y) (>= y 256))))
+             (if zero-x
+                 zero-y
+               (equal x y))))
+    :hints(("Goal"
+            :in-theory (disable l2)
+            :use ((:instance l2 (n x) (m y))))))
+
+  (defthm equal-of-code-code-and-constant
+    (implies (syntaxp (quotep c))
+             (equal (equal (code-char x) c)
+                    (and (characterp c)
+                         (if (equal c (code-char 0))
+                             (or (zp x)
+                                 (not (< x 256)))
+                           (equal x (char-code c))))))
+    :hints(("goal" :use ((:instance completion-of-code-char))))))
+
+
+(defsection char-fix
+  :parents (equivalences)
+  :short "Coerce to a character."
+
+  :long "<p>@(call char-fix) is the identity on @(see acl2::characters), and
+returns the NUL character (i.e., the character whose code is 0) for any
+non-character.</p>
+
+<p>This is similar to other fixing functions like @(see fix) and @(see nfix).
+See also @(see chareqv).</p>"
+
+  (definlined char-fix (x)
+    (declare (xargs :guard t))
+    (if (characterp x)
+        x
+      (code-char 0)))
+
+  (local (in-theory (enable char-fix)))
+
+  (defthm char-fix-default
+    (implies (not (characterp x))
+             (equal (char-fix x)
+                    (code-char 0))))
+
+  (defthm char-fix-when-characterp
+    (implies (characterp x)
+             (equal (char-fix x)
+                    x))))
+
+
+(defsection char-code-lemmas
+  :parents (char-code)
+  :short "Lemmas about @(see char-code) from the @(see str) library."
+
+  (defthm equal-of-char-code-and-constant
+    (implies (syntaxp (quotep c))
+             (equal (equal (char-code x) c)
+                    (if (characterp x)
+                        (and (natp c)
+                             (<= c 255)
+                             (equal x (code-char c)))
+                      (equal c 0)))))
+
+  (local (defthm l0
+           (implies (and (characterp x)
+                         (characterp y))
+                    (equal (equal (char-code x) (char-code y))
+                           (equal x y)))
+           :hints(("Goal" :use acl2::equal-char-code))))
+
+  (defthm equal-of-char-codes
+    (equal (equal (char-code x) (char-code y))
+           (equal (char-fix x)
+                  (char-fix y)))
+    :hints(("Goal" :in-theory (enable char-fix)))))
diff -Nru acl2-6.2/books/str/coerce.lisp acl2-6.3/books/str/coerce.lisp
--- acl2-6.2/books/str/coerce.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/str/coerce.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,294 @@
+; ACL2 String Library
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+;
+; Additional copyright notice for coerce.lisp:
+;
+; This file is adapted from the Unicode library, Copyright (C) 2005-2013 by
+; Jared Davis, which was also released under the GPL.
+
+(in-package "STR")
+(include-book "make-character-list")
+
+
+(defsection str/coerce
+  :parents (coercion coerce)
+  :short "Lemmas about @(see coerce) available in the @(see str) library."
+
+  :long "<p>We typically do not want to ever reason about coerce.  Instead, we
+rewrite it away into @(see explode) or @(see implode).</p>"
+
+  (local (defthm coerce-string-lemma
+           (implies (and (character-listp x)
+                         (character-listp y)
+                         (not (equal x y)))
+                    (not (equal (coerce x 'string)
+                                (coerce y 'string))))
+           :hints(("Goal" :use ((:instance coerce-inverse-1 (x x))
+                                (:instance coerce-inverse-1 (x y)))))))
+
+  (defthm equal-of-coerce-strings
+    (implies (and (character-listp x)
+                  (character-listp y))
+             (equal (equal (coerce x 'string)
+                           (coerce y 'string))
+                    (equal x y))))
+
+  (local (defthm coerce-list-lemma
+           (implies (and (stringp x)
+                         (stringp y)
+                         (not (equal x y)))
+                    (not (equal (coerce x 'list)
+                                (coerce y 'list))))
+           :hints(("Goal" :use ((:instance coerce-inverse-2 (x x))
+                                (:instance coerce-inverse-2 (x y)))))))
+
+  (defthm equal-of-coerce-lists
+    (implies (and (stringp x)
+                  (stringp y))
+             (equal (equal (coerce x 'list)
+                           (coerce y 'list))
+                    (equal x y))))
+
+  ;; Redundant with built-in ACL2 rule character-listp-coerce
+  ;; (defthm character-listp-of-coerce-list
+  ;;   (character-listp (coerce x 'list)))
+
+  (defthm coerce-list-under-iff
+    (iff (coerce string 'list)
+         (and (stringp string)
+              (not (equal "" string))))
+    :hints(("Goal"
+            :in-theory (disable equal-of-coerce-lists)
+            :use ((:instance equal-of-coerce-lists
+                             (x string)
+                             (y ""))))))
+
+
+  (defthm length-of-coerce
+    ;; Wow, coerce is sort of awful in that (coerce "foo" 'string) returns ""
+    ;; and (coerce '(1 2 3) 'list) returns nil.  This leads to a weird length
+    ;; theorem.  We normally just leave length enabled, so this rule won't have
+    ;; many uses.
+    (equal (length (coerce x y))
+           (cond ((equal y 'list)
+                  (if (stringp x)
+                      (length x)
+                    0))
+                 (t
+                  (if (stringp x)
+                      0
+                    (len x)))))
+    :hints(("Goal"
+            :use ((:instance completion-of-coerce
+                             (x x)
+                             (y y))))))
+
+  (defthm len-of-coerce-to-string
+    (equal (len (coerce x 'string))
+           0))
+
+  (defthm coerce-inverse-1-better
+    (equal (coerce (coerce x 'string) 'list)
+           (if (stringp x)
+               nil
+             (make-character-list x)))
+    :hints(("Goal"
+            :use ((:instance acl2::completion-of-coerce
+                             (acl2::x x)
+                             (acl2::y 'string))))))
+
+  (defthm coerce-inverse-2-better
+    (equal (coerce (coerce x 'list) 'string)
+           (if (stringp x)
+               x
+             "")))
+
+  (in-theory (disable coerce-inverse-1 coerce-inverse-2))
+
+  (defthm coerce-to-list-of-make-character-list
+    (equal (coerce (make-character-list x) 'string)
+           (coerce x 'string))
+    :hints(("Goal"
+            :use ((:instance acl2::completion-of-coerce
+                             (acl2::x x)
+                             (acl2::y 'string)))))))
+
+
+
+(defsection explode
+  :parents (coercion coerce)
+  :short "Convert a string to a character list."
+
+  :long "<p>@(call explode) is logically nothing more than @('(coerce x
+'list)').</p>
+
+<p>Even though @(see coerce) is built into ACL2, we prefer to use @('explode') as
+our normal form.  We rewrite all uses of @('(coerce x 'list)') into
+@('(str::explode x')') with the following rule:</p>
+
+@(def coerce-to-list-removal)
+
+<p>The basic rationale for this is that @('coerce')'s extra @(''list') argument
+means we can't write, e.g., congruence relations about @('(coerce x 'list)'),
+whereas this is no problem for @('(explode x)').</p>
+
+<p>We do the same thing for @('(coerce x 'string)') &mdash; see @(see
+implode).</p>
+
+<p><b>BOZO</b> consider using misc/fast-coerce here.</p>"
+
+  (definlined explode (x)
+    (declare (type string x))
+    (coerce x 'list))
+
+  (in-theory (disable (:t explode)))
+  (local (in-theory (enable explode)))
+
+  (defthm true-listp-of-explode
+    (true-listp (explode x))
+    :rule-classes :type-prescription)
+
+  (defthm character-listp-of-explode
+    (character-listp (explode x)))
+
+  (defthm explode-when-not-stringp
+    (implies (not (stringp x))
+             (equal (explode x)
+                    nil)))
+
+  (defthm equal-of-explodes
+    (implies (and (stringp x)
+                  (stringp y))
+             (equal (equal (explode x)
+                           (explode y))
+                    (equal x y))))
+
+  (defthm explode-under-iff
+    (iff (explode string)
+         (and (stringp string)
+              (not (equal "" string)))))
+
+  (local (defthm l0
+           (implies (true-listp x)
+                    (iff (consp x)
+                         x))))
+
+  (defthm consp-of-explode
+    (equal (consp (explode string))
+           (and (stringp string)
+                (not (equal "" string)))))
+
+  (defthm coerce-to-list-removal
+    (equal (coerce x 'list)
+           (explode x)))
+
+  (local (in-theory (disable acl2::explode)))
+
+  (theory-invariant (incompatible (:definition acl2::explode$inline)
+                                  (:rewrite coerce-to-list-removal))))
+
+
+
+(defsection implode
+  :parents (coercion coerce)
+  :short "Convert a character list into a string."
+
+  :long "<p>@(call implode) is logically nothing more than @('(coerce x
+'string)').</p>
+
+<p>Even though @(see coerce) is built into ACL2, we prefer to use @('implode')
+as our normal form.  We rewrite all uses of @('(coerce x 'string)') into
+@('(str::implode x')') with the following rule:</p>
+
+@(def coerce-to-string-removal)
+
+<p>The basic rationale for this is that @('coerce')'s extra @(''string')
+argument means we can't write, e.g., congruence relations about @('(coerce x
+'string)'), whereas this is no problem for @('(implode x)').</p>
+
+<p>We do the same thing for @('(coerce x 'list)') &mdash; see @(see
+explode).</p>"
+
+  (definlined implode (x)
+    (declare (xargs :guard (character-listp x)))
+    (coerce x 'string))
+
+  (in-theory (disable (:t implode)))
+  (local (in-theory (enable implode)))
+
+  (defthm stringp-of-implode
+    (stringp (implode x))
+    :rule-classes :type-prescription)
+
+  (defthm equal-of-implodes
+    (implies (and (character-listp x)
+                  (character-listp y))
+             (equal (equal (implode x)
+                           (implode y))
+                    (equal x y))))
+
+  (defthm implode-of-make-character-list
+    (equal (implode (make-character-list x))
+           (implode x)))
+
+  (local (defthm l0
+           (equal (equal (len x) 0)
+                  (atom x))))
+
+  (defthm equal-of-implode-with-empty-string
+    (equal (equal "" (implode x))
+           (atom x))
+    :hints(("Goal"
+            :in-theory (disable length-of-coerce)
+            :use ((:instance length-of-coerce
+                             (x x)
+                             (y 'string))))))
+
+  (defthm coerce-to-string-removal
+    (equal (coerce x 'string)
+           (implode x)))
+
+  (local (in-theory (disable acl2::implode$inline)))
+
+  (theory-invariant (incompatible (:definition acl2::implode$inline)
+                                  (:rewrite coerce-to-string-removal))))
+
+
+
+(defsection implode-explode-inversion
+  :parents (implode explode)
+  :short "Inversion theorems for @(see implode) and @(see explode)."
+
+  (local (in-theory (e/d (implode explode)
+                         (coerce-to-string-removal
+                          coerce-to-list-removal))))
+
+  (defthm explode-of-implode
+    (equal (explode (implode x))
+           (if (stringp x)
+               nil
+             (make-character-list x))))
+
+  (defthm implode-of-explode
+    (equal (implode (explode x))
+           (if (stringp x)
+               x
+             ""))))
+
diff -Nru acl2-6.2/books/str/defs.lisp acl2-6.3/books/str/defs.lisp
--- acl2-6.2/books/str/defs.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/str/defs.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,313 @@
+; ACL2 String Library
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "STR")
+(include-book "xdoc/top" :dir :system)
+(include-book "tools/bstar" :dir :system)
+(include-book "std/lists/list-defuns" :dir :system)
+(local (include-book "top"))
+(local (include-book "cutil/defredundant" :dir :system))
+
+(make-event
+ (cutil::defredundant-fn
+  '(
+    ;; coerce.lisp
+    acl2::explode$inline
+    explode
+    acl2::implode$inline
+    implode
+    ;; Including this type-prescription rule improves the type-prescriptions of
+    ;; some subsequent functions such as upcase-string.
+    stringp-of-implode
+
+    ;; char-fix.lisp
+    char-fix$inline
+    char-fix
+   
+    ;; eqv.lisp
+    chareqv$inline
+    chareqv
+    chareqv-is-an-equivalence
+    charlisteqv
+    charlisteqv-is-an-equivalence
+    str-fix$inline
+    str-fix
+    streqv$inline
+    streqv
+    streqv-is-an-equivalence
+
+    ;; cat.lisp
+    fast-string-append
+    fast-string-append-lst
+    fast-concatenate
+    cat
+    append-chars-aux
+    append-chars$inline
+    append-chars
+    revappend-chars-aux
+    revappend-chars$inline
+    revappend-chars
+    prefix-strings
+    rchars-to-string
+    join-aux
+    join
+   
+    ;; char-case.lisp
+    little-a
+    little-z
+    big-a
+    big-z
+    case-delta
+    up-alpha-p$inline
+    up-alpha-p
+    down-alpha-p$inline
+    down-alpha-p
+    upcase-char$inline
+    upcase-char
+    downcase-char$inline
+    downcase-char
+    make-upcase-first-strtbl
+    *upcase-first-strtbl*
+    upcase-char-str$inline
+    upcase-char-str
+    make-downcase-first-strtbl
+    *downcase-first-strtbl*
+    downcase-char-str$inline
+    downcase-char-str
+
+    ;; case-conversion.lisp
+    charlist-has-some-down-alpha-p
+    upcase-charlist-aux
+    upcase-charlist
+    charlist-has-some-up-alpha-p
+    downcase-charlist-aux
+    downcase-charlist
+    string-has-some-down-alpha-p
+    upcase-string-aux
+    upcase-string
+    string-has-some-up-alpha-p
+    downcase-string-aux
+    downcase-string
+    upcase-string-list-aux
+    upcase-string-list
+    downcase-string-list-aux
+    downcase-string-list
+    upcase-first-charlist
+    upcase-first
+    downcase-first-charlist
+    downcase-first
+
+    ;; ieqv.lisp
+    ichareqv$inline
+    ichareqv
+    ichareqv-is-an-equivalence
+    icharlisteqv
+    icharlisteqv-is-an-equivalence
+    istreqv-aux
+    istreqv$inline
+    istreqv
+    istreqv-is-an-equivalence
+
+    ;; digitp.lisp
+    digitp$inline
+    digitp
+    nonzero-digitp$inline
+    nonzero-digitp
+    digit-val$inline
+    digit-val
+    digit-listp
+    digit-list-value
+    skip-leading-digits
+    take-leading-digits
+    digit-string-p-aux
+    digit-string-p$inline
+    digit-string-p
+
+    ;; firstn-chars.lisp
+    firstn-chars-aux
+    firstn-chars
+    append-firstn-chars
+
+    ;; html-encode.lisp
+    html-space
+    html-newline
+    html-less
+    html-greater
+    html-amp
+    html-quote
+    repeated-revappend
+    distance-to-tab$inline
+    distance-to-tab
+    html-encode-chars-aux
+    html-encode-string-aux
+    html-encode-string
+
+    ;; iless.lisp
+    ichar<$inline
+    ichar<
+    icharlist<
+    istr<-aux
+    istr<$inline
+    istr<
+
+    ;; iprefixp.lisp
+    iprefixp
+
+    ;; istrprefixp.lisp
+    istrprefixp-impl
+    istrprefixp$inline
+    istrprefixp
+
+    ;; istrpos.lisp
+    istrpos-impl
+    istrpos$inline
+    istrpos
+
+    ;; isubstrp.lisp
+    isubstrp$inline
+    isubstrp
+    collect-strs-with-isubstr
+    collect-syms-with-isubstr
+    ;; isort.lisp
+    acl2::mergesort-fixnum-threshold
+    istr-list-p
+    istr-merge-tr
+    istr-mergesort-fixnum
+    istr-mergesort-integers
+    istr-sort
+    istrsort
+
+    ;; natstr
+    basic-natchars
+    natchars-aux
+    natchars$inline
+    natchars
+    natstr$inline
+    natstr
+    natstr-list
+    revappend-natchars-aux
+    revappend-natchars$inline
+    revappend-natchars
+
+    ;; pad.lisp
+    rpadchars
+    rpadstr
+    lpadchars
+    lpadstr
+    trim-aux
+    trim-bag
+    trim
+
+    ;; prefix-lines.lisp
+    prefix-lines-aux
+    prefix-lines
+    
+    ;; strline.lisp
+    charpos-aux
+    go-to-line
+    strline
+    strlines
+
+    ;; strnatless.lisp
+    parse-nat-from-charlist
+    parse-nat-from-string
+    charlistnat<
+    strnat<-aux
+    strnat<$inline
+    strnat<
+
+    ;; strprefixp.lisp
+    strprefixp-impl
+    strprefixp$inline
+    strprefixp
+
+    ;; strpos.lisp
+    strpos-fast
+    strpos$inline
+    strpos
+
+    ;; strrpos.lisp
+    strrpos-fast
+    strrpos$inline
+    strrpos
+
+    ;; strsplit.lisp
+    split-list-1
+    split-list*
+    character-list-listp
+    coerce-list-to-strings
+    strsplit
+
+    ;; strsubst.lisp
+    strsubst-aux
+    strsubst
+    strsubst-list
+
+    ;; strtok.lisp
+    strtok-aux
+    strtok$inline
+    strtok
+
+    ;; strval.lisp
+    octal-digitp$inline
+    octal-digitp
+    octal-digit-listp
+    parse-octal-from-charlist
+    octal-digit-list-value$inline
+    octal-digit-list-value
+    hex-digitp$inline
+    hex-digitp
+    hex-digit-listp
+    hex-digit-val$inline
+    hex-digit-val
+    parse-hex-from-charlist
+    hex-digit-list-value$inline
+    hex-digit-list-value
+    bit-digitp$inline
+    bit-digitp
+    bit-digit-listp
+    bitstring-p
+    parse-bits-from-charlist
+    bit-digit-list-value$inline
+    bit-digit-list-value
+    strval
+    strval8
+    strval16
+    strval2
+    
+    ;; substrp
+    substrp$inline
+    substrp
+
+    ;; strsuffixp
+    strsuffixp$inline
+    strsuffixp
+
+    ;; symbols.lisp
+    symbol-list-names
+    intern-list-fn
+    intern-list
+    
+    )
+  state))
+
+
+
+
diff -Nru acl2-6.2/books/str/digitp.lisp acl2-6.3/books/str/digitp.lisp
--- acl2-6.2/books/str/digitp.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/digitp.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -19,7 +19,7 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "STR")
-(include-book "eqv")
+(include-book "ieqv")
 (include-book "std/lists/list-fix" :dir :system)
 (local (include-book "std/lists/rev" :dir :system))
 (local (include-book "arithmetic"))
@@ -62,7 +62,15 @@
 
   (local (in-theory (enable digitp)))
 
-  (defcong chareqv equal (digitp x) 1))
+  (defcong ichareqv equal (digitp x) 1
+    :hints(("Goal" :in-theory (enable ichareqv
+                                      downcase-char
+                                      char-fix))))
+
+  (defthm characterp-when-digitp
+    (implies (str::digitp char)
+             (characterp char))
+    :rule-classes :compound-recognizer))
 
 
 
@@ -85,7 +93,10 @@
 
   (local (in-theory (enable nonzero-digitp)))
 
-  (defcong chareqv equal (nonzero-digitp x) 1)
+  (defcong ichareqv equal (nonzero-digitp x) 1
+    :hints(("Goal" :in-theory (enable ichareqv
+                                      downcase-char
+                                      char-fix))))
 
   (defthm digitp-when-nonzero-digitp
     (implies (nonzero-digitp x)
@@ -117,7 +128,10 @@
 
   (local (in-theory (enable digitp digit-val char-fix)))
 
-  (defcong chareqv equal (digit-val x) 1)
+  (defcong ichareqv equal (digit-val x) 1
+    :hints(("Goal" :in-theory (enable ichareqv
+                                      downcase-char
+                                      char-fix))))
 
   (defthm natp-of-digit-val
     (and (integerp (digit-val x))
@@ -167,8 +181,8 @@
            (and (digitp a)
                 (digit-listp x))))
 
-  (defcong charlisteqv equal (digit-listp x) 1
-    :hints(("Goal" :in-theory (enable charlisteqv))))
+  (defcong icharlisteqv equal (digit-listp x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv))))
 
   (defthm digit-listp-of-list-fix
     (equal (digit-listp (list-fix x))
@@ -184,6 +198,10 @@
            (and (digit-listp x)
                 (digit-listp y))))
 
+  (defthm digit-listp-of-rev
+    (equal (digit-listp (rev x))
+           (digit-listp x)))
+
   (defthm digit-listp-of-nthcdr
     (implies (digit-listp x)
              (digit-listp (nthcdr n x)))))
@@ -234,8 +252,8 @@
 
   (local (in-theory (enable digit-list-value)))
 
-  (defcong charlisteqv equal (digit-list-value x) 1
-    :hints(("Goal" :in-theory (enable charlisteqv))))
+  (defcong icharlisteqv equal (digit-list-value x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv))))
 
   (defthm natp-of-digit-list-value
     (natp (digit-list-value x))
@@ -284,6 +302,9 @@
   (defcong charlisteqv charlisteqv (skip-leading-digits x) 1
     :hints(("Goal" :in-theory (enable charlisteqv))))
 
+  (defcong icharlisteqv icharlisteqv (skip-leading-digits x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv))))
+
   (defthm len-of-skip-leading-digits
     (implies (digitp (car x))
              (< (len (skip-leading-digits x))
@@ -307,11 +328,12 @@
 
   (local (in-theory (enable take-leading-digits)))
 
-  (defcong charlisteqv equal (take-leading-digits x) 1
-    :hints(("Goal" :in-theory (enable charlisteqv
+  (defcong icharlisteqv equal (take-leading-digits x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv
                                       ;; Gross, but gets us equal.
+                                      ichareqv
+                                      downcase-char
                                       digitp
-                                      chareqv
                                       char-fix))))
 
   (defthm character-listp-of-take-leading-digits
@@ -356,7 +378,7 @@
                   (natp n)
                   (equal xl (length x)))
              (equal (digit-string-p-aux x n xl)
-                    (digit-listp (nthcdr n (coerce x 'list)))))
+                    (digit-listp (nthcdr n (explode x)))))
     :hints(("Goal" :in-theory (enable digit-string-p-aux
                                       digit-listp))))
 
@@ -375,7 +397,8 @@
 ;   (time$ (loop for i fixnum from 1 to 10000000 do
 ;                (str::digit-listp (coerce x 'list)))))
 
-    (mbe :logic (digit-listp (coerce x 'list))
-         :exec (digit-string-p-aux x 0 (length x)))))
+    (mbe :logic (digit-listp (explode x))
+         :exec (digit-string-p-aux x 0 (length x))))
 
+  (defcong istreqv equal (digit-string-p x) 1))
 
diff -Nru acl2-6.2/books/str/eqv.lisp acl2-6.3/books/str/eqv.lisp
--- acl2-6.2/books/str/eqv.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/eqv.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -19,49 +19,13 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "STR")
-(include-book "xdoc/top" :dir :system)
-(include-book "std/lists/list-defuns" :dir :system)
-(include-book "std/lists/list-fix" :dir :system)
-(include-book "misc/definline" :dir :system)
+(include-book "coerce")
+(include-book "std/lists/equiv" :dir :system)
+(include-book "std/lists/rev" :dir :system)
 (local (include-book "arithmetic"))
 
 (in-theory (disable char<))
 
-(defsection char-fix
-  :parents (equivalences)
-  :short "Coerce to a character."
-
-  :long "<p>@(call char-fix) is the identity on @(see acl2::characters), and
-returns the NUL character (i.e., the character whose code is 0) for any
-non-character.</p>
-
-<p>This is similar to other fixing functions like @(see fix) and @(see nfix).
-See also @(see chareqv).</p>"
-
-  (definlined char-fix (x)
-    (declare (xargs :guard t))
-    (if (characterp x)
-        x
-      (code-char 0)))
-
-  (local (in-theory (enable char-fix)))
-
-  (defthm char-fix-default
-    (implies (not (characterp x))
-             (equal (char-fix x)
-                    (code-char 0))))
-
-  (defthm char-fix-when-characterp
-    (implies (characterp x)
-             (equal (char-fix x)
-                    x)))
-
-  (defthm equal-of-char-codes
-    (equal (equal (char-code x) (char-code y))
-           (equal (char-fix x)
-                  (char-fix y)))))
-
-
 (defsection chareqv
   :parents (equivalences)
   :short "Case-sensitive character equivalence test."
@@ -123,7 +87,6 @@
     :rule-classes ((:rewrite :loop-stopper ((x y))))))
 
 
-
 (defsection charlisteqv
   :parents (equivalences)
   :short "Case-sensitive character-list equivalence test."
@@ -156,13 +119,47 @@
   (defcong charlisteqv equal       (len x)      1)
   (defcong charlisteqv charlisteqv (list-fix x) 1)
   (defcong charlisteqv chareqv     (nth n x)    2)
+  (defcong charlisteqv charlisteqv (take n x)   2)
   (defcong charlisteqv charlisteqv (nthcdr n x) 2)
   (defcong charlisteqv charlisteqv (append x y) 1)
   (defcong charlisteqv charlisteqv (append x y) 2)
-  (defcong charlisteqv charlisteqv (acl2::rev x) 1)
+  (defcong charlisteqv charlisteqv (rev x)      1)
   (defcong charlisteqv charlisteqv (revappend x y) 2)
   (defcong charlisteqv charlisteqv (revappend x y) 1)
 
+  (encapsulate
+    ()
+    (local (defun my-induct (x y)
+             (if (atom x)
+                 (list x y)
+               (my-induct (cdr x) (cdr y)))))
+
+    (defcong charlisteqv equal (make-character-list x) 1
+      :hints(("Goal"
+              :in-theory (enable chareqv)
+              :induct (my-induct x x-equiv)))))
+
+  (encapsulate
+    ()
+    (local (defun my-induct (x y)
+             (if (atom x)
+                 (list x y)
+               (my-induct (cdr x) (cdr y)))))
+
+    (local (defthm crock
+             (equal (charlisteqv x y)
+                    (equal (make-character-list x)
+                           (make-character-list y)))
+             :hints(("Goal"
+                     :in-theory (enable chareqv)
+                     :induct (my-induct x y)))))
+
+    (defcong charlisteqv equal (implode x) 1
+      :hints(("Goal"
+              :in-theory (disable implode-of-make-character-list)
+              :use ((:instance implode-of-make-character-list (x x))
+                    (:instance implode-of-make-character-list (x x-equiv)))))))
+
   (defthm charlisteqv-when-not-consp-left
     (implies (not (consp x))
              (equal (charlisteqv x y)
@@ -189,3 +186,61 @@
     (implies (not (equal (len x) (len y)))
              (not (charlisteqv x y)))))
 
+
+
+(defsection str-fix
+  :parents (equivalences)
+  :short "Coerce to a string."
+  :long "<p>@(call str-fix) is the identity on @(see acl2::stringp)s, or
+returns the empty string, @('\"\"'), for any non-string.</p>
+
+<p>This is similar to other fixing functions like @(see fix) and @(see nfix).
+See also @(see streqv).</p>"
+
+  (definlined str-fix (x)
+    (declare (xargs :guard t))
+    (if (stringp x)
+        x
+      ""))
+
+  (local (in-theory (enable str-fix)))
+
+  (defthm str-fix-default
+    (implies (not (stringp x))
+             (equal (str-fix x)
+                    "")))
+
+  (defthm str-fix-when-stringp
+    (implies (stringp x)
+             (equal (str-fix x)
+                    x))))
+
+
+
+(defsection streqv
+  :parents (equivalences)
+  :short "Case-sensitive string equivalence test."
+
+  :long "<p>@(call streqv) determines if @('x') and @('y') are equivalent when
+interpreted as strings.  That is, non-strings are first coerced to be the empty
+string (via @(see str-fix)), then we see if these coerced arguments are
+equal.</p>
+
+<p>See also @(see istreqv) for a case-insensitive alternative.</p>"
+
+  (definlined streqv (x y)
+    (declare (xargs :guard t))
+    (equal (str-fix x) (str-fix y)))
+
+  (local (in-theory (enable streqv str-fix)))
+
+  (defequiv streqv)
+
+  (defthm streqv-of-str-fix
+    (streqv (str-fix x) x))
+
+  (defcong streqv equal (char x n) 1)
+  (defcong streqv equal (explode x) 1)
+  (defcong streqv equal (string-append x y) 1)
+  (defcong streqv equal (string-append x y) 2))
+
diff -Nru acl2-6.2/books/str/explode-atom.lisp acl2-6.3/books/str/explode-atom.lisp
--- acl2-6.2/books/str/explode-atom.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/str/explode-atom.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,56 @@
+;; Processing Unicode Files with ACL2
+;; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
+;;
+;; This program is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by the Free
+;; Software Foundation; either version 2 of the License, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+;; more details.
+;;
+;; You should have received a copy of the GNU General Public License along with
+;; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+;; Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "ACL2")
+(include-book "digitp")
+(local (include-book "std/lists/append" :dir :system))
+(local (include-book "explode-nonnegative-integer"))
+
+(defthm true-listp-of-explode-atom
+  (true-listp (explode-atom x base))
+  :rule-classes :type-prescription)
+
+(defthm consp-of-explode-atom-when-integerp
+  (implies (integerp n)
+           (consp (explode-atom n base)))
+  :rule-classes :type-prescription)
+
+(defthm equal-of-explode-atoms-when-natps
+  (implies (and (natp n)
+                (natp m)
+                (force (print-base-p base)))
+           (equal (equal (explode-atom n base)
+                         (explode-atom m base))
+                  (equal n m))))
+
+(defthm nonzeroness-of-explode-atom-when-not-zp
+  (implies (and (not (zp n))
+                (force (print-base-p base)))
+           (not (equal (explode-atom n base) '(#\0)))))
+
+(defthm digit-listp-of-explode-atom
+  (implies (natp n)
+           (str::digit-listp (explode-atom n 10))))
+
+(defthm character-listp-of-explode-atom
+  (character-listp (explode-atom x base))
+  :hints(("Goal" :in-theory (disable explode-nonnegative-integer))))
+
+; Copied from std/io/base.lisp, wherein it was added by Matt K. for princ$
+; change 12/7/2012.
+(defthm character-listp-explode-atom+
+  (character-listp (explode-atom+ x base radix)))
diff -Nru acl2-6.2/books/str/explode-nonnegative-integer.lisp acl2-6.3/books/str/explode-nonnegative-integer.lisp
--- acl2-6.2/books/str/explode-nonnegative-integer.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/str/explode-nonnegative-integer.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,304 @@
+; Processing Unicode Files with ACL2
+; Copyright (C) 2005-2006 by Jared Davis <jared@cs.utexas.edu>
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.
+;
+; This program is distributed in the hope that it will be useful but WITHOUT
+; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+; details.
+;
+; You should have received a copy of the GNU General Public License along with
+; this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+; Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package "ACL2")
+(include-book "digitp")
+(local (include-book "ihs/quotient-remainder-lemmas" :dir :system))
+(local (include-book "std/lists/revappend" :dir :system))
+(local (include-book "std/lists/append" :dir :system))
+
+; Explode-nonnegative-integer is a particularly nasty function to try to reason
+; about because it is tail recursive and has a very nasty base case.  Instead
+; of reasoning about it directly, we will split it up into the following,
+; simpler definition.
+
+(local (in-theory (disable floor mod)))
+
+(local (defun simpler-explode-nonnegative-integer (n base ans)
+         (declare (xargs :guard (and (integerp n)
+                                     (<= 0 n)
+                                     (print-base-p base))))
+         (if (or (zp n)
+                 (not (print-base-p base)))
+             ans
+           (simpler-explode-nonnegative-integer
+            (floor n base)
+            base
+            (cons (digit-to-char (mod n base)) ans)))))
+
+
+; We can now redefine explode-nonnegative-integer to be a simple nonrecursive
+; function that uses our simpler-explode-nonnegative-integer as its core, but
+; wraps it in a simple "or" statement.  We will then disable the previous
+; definition of explode-nonnegative-integer, so that only our new definition
+; will be used.
+
+(local (defthm explode-nonnegative-integer-redefinition
+         (equal (explode-nonnegative-integer n base ans)
+                (or (simpler-explode-nonnegative-integer n base ans)
+                    '(#\0)))
+         :rule-classes ((:definition :install-body nil))))
+
+(local (in-theory (disable (:definition explode-nonnegative-integer))))
+
+
+
+; Sadly, even simpler-explode-nonnegative-integer is hard to reason about as it
+; is tail recursive.  So, we will introduce a non tail-recursive function in
+; its place that does almost the same thing.  We'll call this the "basic
+; explode-nonnegative-integer core", or the basic-eni-core for short.
+
+(local (defun basic-eni-core (n base)
+         (declare (xargs :guard (and (natp n)
+                                     (print-base-p base))))
+         (if (or (zp n)
+                 (not (print-base-p base)))
+             nil
+           (cons (digit-to-char (mod n base))
+                 (basic-eni-core (floor n base) base)))))
+
+(local (defun basic-eni-induction (n m base)
+         (declare (xargs :guard (and (natp n)
+                                     (natp m)
+                                     (print-base-p base))))
+         (cond ((zp n)
+                nil)
+               ((zp m)
+                nil)
+               ((not (print-base-p base))
+                nil)
+               (t
+                (basic-eni-induction (floor n base) (floor m base) base)))))
+
+(local (defthm basic-eni-core-under-iff
+         (iff (basic-eni-core n base)
+              (and (not (zp n))
+                   (print-base-p base)))))
+
+(local (defthm consp-of-basic-eni-core
+         (equal (consp (basic-eni-core n base))
+                (and (not (zp n))
+                     (if (print-base-p base)
+                         t
+                       nil)))
+         :hints(("Goal" :expand (basic-eni-core n base)))))
+
+(local (defthm equal-of-basic-eni-cores
+         (implies (force (print-base-p base))
+                  (equal (equal (basic-eni-core n base)
+                                (basic-eni-core m base))
+                         (equal (nfix n)
+                                (nfix m))))
+         :hints(("Goal"
+                 :in-theory (disable basic-eni-core)
+                 :induct (basic-eni-induction n m base)
+                 :expand ((:free (base) (basic-eni-core n base))
+                          (:free (base) (basic-eni-core m base)))
+                 :do-not '(generalize fertilize)))))
+
+(local (defthm equal-of-basic-eni-core-with-list-zero
+         (not (equal (basic-eni-core n base) '(#\0)))
+         :hints(("Goal" :in-theory (enable digit-to-char)))))
+
+(local (defthm basic/simpler-equivalence
+         (equal (simpler-explode-nonnegative-integer n base acc)
+                (revappend (basic-eni-core n base) acc))))
+
+(local (defthm equal-of-simpler-explode-nonnegative-integers
+         (implies (force (print-base-p base))                         
+                  (equal (equal (simpler-explode-nonnegative-integer n base acc)
+                                (simpler-explode-nonnegative-integer m base acc))
+                         (equal (nfix n) (nfix m))))))
+
+(local (defthm simpler-eni-when-nonzero
+         (implies (and (not (zp n))
+                       (print-base-p base))
+                  (simpler-explode-nonnegative-integer n base acc))))
+
+(local (defthm simpler-eni-degenerate-lemma
+         (equal (equal (simpler-explode-nonnegative-integer n base acc) '(#\0))
+                (and (equal acc '(#\0))
+                     (or (zp n)
+                         (not (print-base-p base)))))
+         :hints(("Goal"
+                 :induct (simpler-explode-nonnegative-integer n base acc)
+                 :expand ((:free (base) (basic-eni-core n base)))
+                 :in-theory (e/d (digit-to-char)
+                                 (basic-eni-core))))))
+
+(local (defthm not-of-simpler-explode-nonnegative-integer
+         (equal (not (simpler-explode-nonnegative-integer n base acc))
+                (and (equal acc nil)
+                     (or (zp n)
+                         (not (print-base-p base)))))))
+
+(local (defthm true-listp-of-simpler-explode-nonnegative-integer
+         (equal (true-listp (simpler-explode-nonnegative-integer n base acc))
+                (true-listp acc))))
+
+(local (defthm equal-of-explode-nonnegative-integers-lemma
+         (implies (and (natp n)
+                       (natp m)
+                       (not (equal n m))
+                       (not (simpler-explode-nonnegative-integer n base acc))
+                       (force (print-base-p base)))
+                  (simpler-explode-nonnegative-integer m base acc))))
+
+(defthm equal-of-explode-nonnegative-integers
+  (implies (and (natp n)
+                (natp m)
+                (force (print-base-p base)))
+           (equal (equal (explode-nonnegative-integer n base acc)
+                         (explode-nonnegative-integer m base acc))
+                  (equal n m)))
+  :hints(("Goal" :in-theory (disable simpler-explode-nonnegative-integer
+                                     basic/simpler-equivalence))))
+
+(defthm true-listp-of-explode-nonnegative-integer
+  (equal (true-listp (explode-nonnegative-integer n base acc))
+         (true-listp acc)))
+
+(defthm true-listp-of-explode-nonnegative-integer-type
+  (implies (true-listp acc)
+           (true-listp (explode-nonnegative-integer n base acc)))
+  :rule-classes :type-prescription)
+
+(defthm character-listp-of-explode-nonnegative-integer
+  (equal (character-listp (explode-nonnegative-integer n base acc))
+         (character-listp acc)))
+
+(local (defthm digit-listp-of-basic-eni-core
+         (str::digit-listp (basic-eni-core n 10))))
+
+(local (defthm digit-listp-of-simpler-eni
+         (implies (str::digit-listp acc)
+                  (str::digit-listp (simpler-explode-nonnegative-integer n 10 acc)))))
+
+(defthm digit-listp-of-explode-nonnegative-integer
+  (implies (str::digit-listp acc)
+           (str::digit-listp (explode-nonnegative-integer n 10 acc))))
+
+
+(encapsulate
+ ()
+ (local (in-theory (disable revappend-removal)))
+
+ (local (defthm lemma
+          (equal (equal (revappend x acc) '(#\0))
+                 (or (and (equal acc nil)
+                          (consp x)
+                          (equal (car x) #\0)
+                          (atom (cdr x)))
+                     (and (equal acc '(#\0))
+                          (atom x))))))
+
+ (local (defthm lemma2
+          (implies (and (not (zp n))
+                        (print-base-p base))
+                   (consp (basic-eni-core n base)))))
+
+ (defthm nonzeroness-of-explode-nonnegative-integer-when-nonzero
+   (implies (and (not (zp n))
+                 (force (print-base-p base)))
+            (not (equal (explode-nonnegative-integer n base nil)
+                        '(#\0))))
+   :hints(("Goal"
+           :in-theory (e/d (digit-to-char)
+                           (basic-eni-core))
+           :expand ((:free (base) (basic-eni-core n base)))))))
+
+
+
+(defthm digit-val-of-digit-to-char
+  (implies (and (force (natp n))
+                (force (<= 0 n))
+                (force (<= n 9)))
+           (equal (str::digit-val (digit-to-char n))
+                  n))
+  :hints(("Goal" :in-theory (enable str::digit-val
+                                    digit-to-char))))
+
+
+(defsection digit-to-char-of-digit-val
+
+ (local (defun test (n)
+          (declare (xargs :ruler-extenders :all))
+          (and (let ((char (code-char n)))
+                 (or (not (str::digitp char))
+                     (equal (digit-to-char (str::digit-val char))
+                            char)))
+               (if (zp n)
+                   t
+                 (test (- n 1))))))
+
+ (local (defthm l0
+          (implies (and (test n)
+                        (natp i)
+                        (natp n)
+                        (<= i n))
+                   (let ((char (code-char i)))
+                     (implies (str::digitp char)
+                              (equal (digit-to-char (str::digit-val char))
+                                     char))))))
+
+ (local (defthm l1
+          (implies (and (natp i)
+                        (<= i 255))
+                   (let ((char (code-char i)))
+                     (implies (str::digitp char)
+                              (equal (digit-to-char (str::digit-val char))
+                                     char))))
+          :hints(("Goal" :use ((:instance l0 (n 255)))))))
+
+ (defthm digit-to-char-of-digit-val
+   (implies (str::digitp char)
+            (equal (digit-to-char (str::digit-val char))
+                   char))
+   :hints(("Goal" :use ((:instance l1 (i (char-code char))))))))
+
+            
+(defund basic-unexplode-core (x)
+  (declare (xargs :guard (and (character-listp x)
+                              (str::digit-listp x))))
+  (if (consp x)
+      (+ (str::digit-val (car x))
+         (* 10 (basic-unexplode-core (cdr x))))
+    0))
+
+(local (defthm basic-unexplode-core-of-basic-eni-core
+         (implies (force (natp n))
+                  (equal (basic-unexplode-core (basic-eni-core n 10))
+                         n))
+         :hints(("Goal" :in-theory (enable basic-eni-core
+                                           basic-unexplode-core)))))
+
+(defund unexplode-nonnegative-integer (x)
+  (declare (xargs :guard (and (character-listp x)
+                              (str::digit-listp x))))
+  (basic-unexplode-core (revappend x nil)))
+
+(encapsulate
+ ()
+ (local (include-book "std/lists/rev" :dir :system))
+
+ (defthm unexplode-nonnegative-integer-of-explode-nonnegative-integer
+   (implies (force (natp n))
+            (equal (unexplode-nonnegative-integer (explode-nonnegative-integer n 10 nil))
+                   n))
+   :hints(("Goal" :in-theory (e/d (unexplode-nonnegative-integer)
+                                  (basic-eni-core))))))
+
diff -Nru acl2-6.2/books/str/fast-cat.acl2 acl2-6.3/books/str/fast-cat.acl2
--- acl2-6.2/books/str/fast-cat.acl2	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/fast-cat.acl2	2013-09-30 17:52:16.000000000 +0000
@@ -1,3 +1,23 @@
+; ACL2 String Library
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
 (ld "cert.acl2")
 ; cert-flags: ? t :ttags :all
 (certify-book "fast-cat" ? t :ttags :all)
\ No newline at end of file
diff -Nru acl2-6.2/books/str/fast-cat.lisp acl2-6.3/books/str/fast-cat.lisp
--- acl2-6.2/books/str/fast-cat.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/fast-cat.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
diff -Nru acl2-6.2/books/str/firstn-chars.lisp acl2-6.3/books/str/firstn-chars.lisp
--- acl2-6.2/books/str/firstn-chars.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/firstn-chars.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -19,7 +19,7 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "STR")
-(include-book "eqv")
+(include-book "ieqv")
 (local (include-book "arithmetic"))
 (local (include-book "std/lists/take" :dir :system))
 (local (include-book "std/lists/equiv" :dir :system))
@@ -31,7 +31,7 @@
 
   :long "<p>@(call firstn-chars) is logically equal to:</p>
 
-@({ (take (min n (length x)) (coerce x 'list)) })
+@({ (take (min n (length x)) (explode x)) })
 
 <p>But it is implemented more efficiently, via @(see char).</p>"
 
@@ -40,25 +40,28 @@
                                 (natp n)
                                 (< n (length x))))
              (type string x)
-             (type integer n))
+             (type (integer 0 *) n))
     (if (zp n)
         (cons (char x 0) acc)
       (firstn-chars-aux x
-                        (- n 1)
+                        (the (integer 0 *) (- n 1))
                         (cons (char x n) acc))))
 
   (defund firstn-chars (n x)
     (declare (xargs :guard (and (stringp x)
                                 (natp n))
                     :verify-guards nil)
-             (type string x))
+             (type string x)
+             (type (integer 0 *) n))
     (mbe :logic
-         (take (min n (length x)) (coerce x 'list))
+         (take (min (nfix n) (len (explode x))) (explode x))
          :exec
          (let ((n (min n (length x))))
            (if (zp n)
                nil
-             (firstn-chars-aux x (- n 1) nil)))))
+             (firstn-chars-aux x
+                               (the (integer 0 *) (- n 1))
+                               nil)))))
 
   (local (in-theory (enable firstn-chars-aux
                             firstn-chars)))
@@ -74,9 +77,10 @@
   (verify-guards firstn-chars)
 
   (defthm character-listp-of-firstn-chars
-    (implies (force (stringp x))
-             (character-listp (firstn-chars n x)))))
+    (character-listp (firstn-chars n x)))
 
+  (defcong streqv equal (firstn-chars n x) 2)
+  (defcong istreqv icharlisteqv (firstn-chars n x) 2))
 
 
 (defsection append-firstn-chars
@@ -99,11 +103,29 @@
     :hints(("Goal" :in-theory (enable firstn-chars))))
 
   (defthm character-listp-of-append-firstn-chars
-    (implies (and (force (stringp x))
-                  (force (character-listp y)))
-             (character-listp (append-firstn-chars n x y))))
+    (equal (character-listp (append-firstn-chars n x y))
+           (character-listp y)))
 
-  (defcong list-equiv list-equiv (append-firstn-chars n x y) 3))
+  (defcong streqv  equal        (append-firstn-chars n x y) 2)
+  (defcong istreqv icharlisteqv (append-firstn-chars n x y) 2
+    :hints(("Goal" :in-theory (disable istreqv))))
+
+  (defcong list-equiv list-equiv (append-firstn-chars n x y) 3)
+  (defcong charlisteqv charlisteqv (append-firstn-chars n x y) 3)
+  (defcong icharlisteqv icharlisteqv (append-firstn-chars n x y) 3))
+
+(defthm consp-of-firstn-chars
+  ;; May be expensive, leaving enabled for now
+  (equal (consp (firstn-chars n x))
+         (and (posp n)
+              (consp (explode x))))
+  :hints (("Goal" :in-theory (enable firstn-chars length))))
+
+(defthm consp-of-firstn-chars-of-1
+  ;; Improved version of a lemma added by David Rager
+  (equal (consp (firstn-chars 1 x))
+         (consp (explode x)))
+  :hints (("Goal" :in-theory (enable firstn-chars length))))
 
 
 #||
diff -Nru acl2-6.2/books/str/hexify.lisp acl2-6.3/books/str/hexify.lisp
--- acl2-6.2/books/str/hexify.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/hexify.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -19,8 +19,9 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "STR")
+(include-book "coerce")
 (include-book "tools/bstar" :dir :system)
-(local (include-book "std/misc/explode-atom" :dir :system))
+(local (include-book "explode-atom"))
 (local (include-book "arithmetic"))
 
 (defund insert-underscores (x)
@@ -57,11 +58,15 @@
   ;;
   ;; Typical usage is (cw "foo: ~x0~%" (str::hexify foo))
   (declare (xargs :guard t))
-  (cond ((natp x)
-         (b* ((chars (explode-atom x 16)) ;; looks like BEEF...
-              (nice-chars (list* #\# #\u #\x (first chars)
-                                 (insert-underscores (nthcdr 1 chars)))))
-           (coerce nice-chars 'string)))
+  (cond ((integerp x)
+         (b* ((xsign (< x 0))
+              (xabs (abs x))
+              (chars (explode-atom xabs 16)) ;; looks like BEEF...
+              (nice-chars (list* #\# #\u #\x 
+                                 (append (and xsign '(#\-))
+                                         (cons (first chars)
+                                               (insert-underscores (nthcdr 1 chars)))))))
+           (implode nice-chars)))
         ((symbolp x)
          (symbol-name x))
         ((stringp x)
diff -Nru acl2-6.2/books/str/html-encode.lisp acl2-6.3/books/str/html-encode.lisp
--- acl2-6.2/books/str/html-encode.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/html-encode.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
diff -Nru acl2-6.2/books/str/ieqv.lisp acl2-6.3/books/str/ieqv.lisp
--- acl2-6.2/books/str/ieqv.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/ieqv.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -25,7 +25,7 @@
 (local (include-book "arithmetic"))
 
 (defsection ichareqv
-  :parents (equivalences)
+  :parents (equivalences cases)
   :short "Case-insensitive character equivalence test."
   :long "<p>@(call ichareqv) determines if @('x') and @('y') are equivalent
 when interpreted as characters without regard to case.  For instance,
@@ -44,12 +44,45 @@
 
   (defequiv ichareqv)
 
-  (defrefinement chareqv ichareqv))
+  (defrefinement chareqv ichareqv)
+
+  (encapsulate
+    ()
+    (local (defthmd l1
+             (implies (equal (upcase-char x)
+                             (upcase-char y))
+                      (equal (downcase-char x)
+                             (downcase-char y)))
+             :hints(("Goal"
+                     :in-theory (disable downcase-char-of-upcase-char)
+                     :use ((:instance downcase-char-of-upcase-char (x x))
+                           (:instance downcase-char-of-upcase-char (x y)))))))
+
+    (local (defthmd l2
+             (implies (equal (downcase-char x)
+                             (downcase-char y))
+                      (equal (upcase-char x)
+                             (upcase-char y)))
+             :hints(("Goal"
+                     :in-theory (disable upcase-char-of-downcase-char)
+                     :use ((:instance upcase-char-of-downcase-char (x x))
+                           (:instance upcase-char-of-downcase-char (x y)))))))
+
+    (defthm equal-of-upcase-char-and-upcase-char
+      (equal (equal (upcase-char x) (upcase-char y))
+             (ichareqv x y))
+      :hints(("Goal" :use ((:instance l1)
+                           (:instance l2))))))
+
+  (defcong ichareqv equal (downcase-char x) 1)
+  (defcong ichareqv equal (upcase-char x) 1)
+  (defcong ichareqv equal (upcase-char-str x) 1)
+  (defcong ichareqv equal (downcase-char-str x) 1))
 
 
 
 (defsection icharlisteqv
-  :parents (equivalences)
+  :parents (equivalences cases)
   :short "Case-insensitive character-list equivalence test."
 
   :long "<p>@(call icharlisteqv) determines if @('x') and @('y') are
@@ -84,11 +117,15 @@
   (defcong icharlisteqv icharlisteqv (list-fix x) 1)
   (defcong icharlisteqv ichareqv     (nth n x)    2)
   (defcong icharlisteqv icharlisteqv (nthcdr n x) 2)
+  (defcong icharlisteqv icharlisteqv (take n x)   2)
   (defcong icharlisteqv icharlisteqv (append x y) 1)
   (defcong icharlisteqv icharlisteqv (append x y) 2)
-  (defcong icharlisteqv icharlisteqv (acl2::rev x) 1)
+  (defcong icharlisteqv icharlisteqv (rev x) 1)
   (defcong icharlisteqv icharlisteqv (revappend x y) 2)
   (defcong icharlisteqv icharlisteqv (revappend x y) 1)
+  (defcong icharlisteqv icharlisteqv (make-character-list x) 1)
+
+
 
   (defthm icharlisteqv-when-not-consp-left
     (implies (not (consp x))
@@ -119,7 +156,7 @@
 
 
 (defsection istreqv
-  :parents (equivalences)
+  :parents (equivalences cases)
   :short "Case-insensitive string equivalence test."
 
   :long "<p>@(call istreqv) determines if @('x') and @('y') are
@@ -129,7 +166,7 @@
 <p>Logically this is identical to</p>
 
 @({
- (icharlisteqv (coerce x 'list) (coerce y 'list))
+ (icharlisteqv (explode x) (explode y))
 })
 
 <p>But we use a more efficient implementation which avoids coercing the
@@ -169,7 +206,7 @@
              (type string y)
              (xargs :verify-guards nil))
     (mbe :logic
-         (icharlisteqv (coerce x 'list) (coerce y 'list))
+         (icharlisteqv (explode x) (explode y))
          :exec
          (b* (((the (integer 0 *) xl) (length x))
               ((the (integer 0 *) yl) (length y)))
@@ -196,10 +233,20 @@
                   (= l (length x))
                   (= l (length y)))
              (equal (istreqv-aux x y n l)
-                    (icharlisteqv (nthcdr n (coerce x 'list))
-                                  (nthcdr n (coerce y 'list)))))
+                    (icharlisteqv (nthcdr n (explode x))
+                                  (nthcdr n (explode y)))))
     :hints(("Goal"
             :in-theory (enable istreqv-aux)
             :induct (istreqv-aux x y n l))))
 
-  (verify-guards istreqv$inline))
+  (verify-guards istreqv$inline)
+
+  (defequiv istreqv)
+  (defrefinement streqv istreqv)
+
+  (defcong istreqv ichareqv (char x n) 1)
+  (defcong istreqv icharlisteqv (explode x) 1)
+  (defcong istreqv istreqv (string-append x y) 1)
+  (defcong istreqv istreqv (string-append x y) 2))
+
+
diff -Nru acl2-6.2/books/str/iless.lisp acl2-6.3/books/str/iless.lisp
--- acl2-6.2/books/str/iless.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/iless.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -208,14 +208,14 @@
 <p>Logically, this is identical to:</p>
 
 @({
-  (icharlist< (coerce x 'list) (coerce y 'list))
+  (icharlist< (explode x) (explode y))
 })
 
 <p>But we use a more efficient implementation which avoids coercing the strings
 into lists.</p>
 
 <p>NOTE: for reasoning, we leave this function enabled and prefer to work with
-@(see icharlist<) of the coerces as our normal form.</p>"
+@(see icharlist<) of the explodes as our normal form.</p>"
 
   (defund istr<-aux (x y n xl yl)
     (declare (type string x)
@@ -279,7 +279,7 @@
              (type string y)
              (xargs :verify-guards nil))
     (mbe :logic
-         (icharlist< (coerce x 'list) (coerce y 'list))
+         (icharlist< (explode x) (explode y))
 
          :exec
          (istr<-aux (the string x)
@@ -313,5 +313,8 @@
                                 (nthcdr n (coerce y 'list)))))
     :hints(("Goal" :in-theory (enable istr<-aux icharlist<))))
 
-  (verify-guards istr<$inline))
+  (verify-guards istr<$inline)
+
+  (defcong istreqv equal (istr< x y) 1)
+  (defcong istreqv equal (istr< x y) 2))
 
diff -Nru acl2-6.2/books/str/iprefixp.lisp acl2-6.3/books/str/iprefixp.lisp
--- acl2-6.2/books/str/iprefixp.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/iprefixp.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
diff -Nru acl2-6.2/books/str/isort.lisp acl2-6.3/books/str/isort.lisp
--- acl2-6.2/books/str/isort.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/isort.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -21,7 +21,7 @@
 (in-package "STR")
 (include-book "iless")
 (include-book "defsort/defsort" :dir :system)
-;(include-book "std/lists/list-defunslist-fix" :dir :system)
+(local (include-book "std/typed-lists/string-listp" :dir :system))
 
 (ACL2::defsort
  :comparablep stringp
@@ -33,11 +33,6 @@
          (string-listp (list-fix x)))
   :hints(("Goal" :in-theory (enable istr-list-p))))
 
-(defthm string-listp-of-list-fix
-  ;; BOZO misplaced
-  (implies (string-listp x)
-           (string-listp (list-fix x))))
-
 (defthm string-listp-of-istr-sort
   (implies (force (string-listp x))
            (string-listp (istr-sort x)))
diff -Nru acl2-6.2/books/str/istrpos.lisp acl2-6.3/books/str/istrpos.lisp
--- acl2-6.2/books/str/istrpos.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/istrpos.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -41,11 +41,8 @@
 theorems @('iprefixp-of-istrpos') and @('completeness-of-istrpos').</p>"
 
   (defund istrpos-impl (x y n xl yl)
-    (declare (type string x)
-             (type string y)
-             (type integer n)
-             (type integer xl)
-             (type integer yl)
+    (declare (type string x y)
+             (type (integer 0 *) n xl yl)
              (xargs :guard (and (stringp x)
                                 (stringp y)
                                 (natp xl)
@@ -55,14 +52,14 @@
                                 (= xl (length x))
                                 (= yl (length y)))
                     :measure (nfix (- (nfix yl) (nfix n)))))
-    (cond ((mbe :logic (iprefixp (coerce x 'list)
-                                 (nthcdr n (coerce y 'list)))
+    (cond ((mbe :logic (iprefixp (explode x)
+                                 (nthcdr n (explode y)))
                 :exec (istrprefixp-impl (the string x)
                                         (the string y)
-                                        (the integer 0)
-                                        (the integer n)
-                                        (the integer xl)
-                                        (the integer yl)))
+                                        (the (integer 0 *) 0)
+                                        (the (integer 0 *) n)
+                                        (the (integer 0 *) xl)
+                                        (the (integer 0 *) yl)))
            (lnfix n))
           ((mbe :logic (zp (- (nfix yl) (nfix n)))
                 :exec (int= n yl))
@@ -70,18 +67,22 @@
           (t
            (istrpos-impl (the string x)
                          (the string y)
-                         (+ 1 (lnfix n))
-                         (the integer xl)
-                         (the integer yl)))))
+                         (the (integer 0 *) (+ 1 (the (integer 0 *) (lnfix n))))
+                         (the (integer 0 *) xl)
+                         (the (integer 0 *) yl)))))
 
   (definlined istrpos (x y)
-    (declare (type string x)
-             (type string y))
-    (istrpos-impl (the string x)
-                  (the string y)
-                  (the integer 0)
-                  (the integer (length (the string x)))
-                  (the integer (length (the string y)))))
+    (declare (type string x y))
+    (let* ((xl (mbe :logic (len (explode x))
+                    :exec (length (the string x))))
+           (yl (mbe :logic (len (explode y))
+                    :exec (length (the string y)))))
+      (declare (type (integer 0 *) xl yl))
+      (istrpos-impl (the string x)
+                    (the string y)
+                    (the (integer 0 *) 0)
+                    xl
+                    yl)))
 
   (local (in-theory (enable istrpos istrpos-impl)))
 
@@ -94,33 +95,29 @@
   (encapsulate
     ()
     (local (defthm lemma
-             (implies (and (stringp x)
-                           (stringp y)
+             (implies (and (istrpos-impl x y n xl yl)
                            (natp xl)
                            (natp yl)
                            (natp n)
-                           (<= n (length y))
-                           (= xl (length x))
-                           (= yl (length y))
-                           (istrpos-impl x y n xl yl))
-                      (iprefixp (coerce x 'list)
+                           (<= n (len (explode y)))
+                           (= xl (len (explode x)))
+                           (= yl (len (explode y))))
+                      (iprefixp (explode x)
                                 (nthcdr (istrpos-impl x y n xl yl)
-                                        (coerce y 'list))))
+                                        (explode y))))
              :hints(("Goal" :induct (istrpos-impl x y n xl yl)))))
 
     (defthm iprefixp-of-istrpos
-      (implies (and (istrpos x y)
-                    (force (stringp x))
-                    (force (stringp y)))
-               (iprefixp (coerce x 'list)
-                         (nthcdr (istrpos x y) (coerce y 'list))))))
+      (implies (istrpos x y)
+               (iprefixp (explode x)
+                         (nthcdr (istrpos x y) (explode y))))))
 
   (encapsulate
     ()
     (local (defun my-induction (x y n m xl yl)
              (declare (xargs :measure (nfix (- (nfix yl) (nfix n)))))
-             (cond ((iprefixp (coerce x 'list)
-                              (nthcdr n (coerce y 'list)))
+             (cond ((iprefixp (explode x)
+                              (nthcdr n (explode y)))
                     nil)
                    ((zp (- (nfix yl) (nfix n)))
                     (list x y n m xl yl))
@@ -129,22 +126,20 @@
                                   (+ (nfix n) 1)
                                   (if (= (nfix n) (nfix m))
                                       (+ (nfix m) 1)
-                                    m)
+                                    (nfix m))
                                   xl yl)))))
 
     (local (defthm lemma
-             (implies (and (stringp x)
-                           (stringp y)
+             (implies (and (iprefixp (explode x)
+                                     (nthcdr m (explode y)))
                            (natp xl)
                            (natp yl)
                            (natp n)
                            (natp m)
-                           (<= n m)
-                           (<= n (length y))
-                           (= xl (length x))
-                           (= yl (length y))
-                           (iprefixp (coerce x 'list)
-                                     (nthcdr m (coerce y 'list))))
+                           (<= n (nfix m))
+                           (<= n (len (explode y)))
+                           (= xl (len (explode x)))
+                           (= yl (len (explode y))))
                       (and (natp (istrpos-impl x y n xl yl))
                            (<= (istrpos-impl x y n xl yl) m)))
              :hints(("Goal"
@@ -152,11 +147,17 @@
                      :do-not '(generalize fertilize)))))
 
     (defthm completeness-of-istrpos
-      (implies (and (iprefixp (coerce x 'list)
-                              (nthcdr m (coerce y 'list)))
-                    (force (natp m))
-                    (force (stringp x))
-                    (force (stringp y)))
+      (implies (and (iprefixp (explode x)
+                              (nthcdr m (explode y)))
+                    (force (natp m)))
                (and (natp (istrpos x y))
-                    (<= (istrpos x y) m))))))
+                    (<= (istrpos x y) m)))))
+
+  (defcong istreqv equal (istrpos-impl x y n xl yl) 1)
+  (defcong istreqv equal (istrpos-impl x y n xl yl) 2)
+
+  (local (in-theory (disable istreqv)))
+
+  (defcong istreqv equal (istrpos x y) 1)
+  (defcong istreqv equal (istrpos x y) 2))
 
diff -Nru acl2-6.2/books/str/istrprefixp.lisp acl2-6.3/books/str/istrprefixp.lisp
--- acl2-6.2/books/str/istrprefixp.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/istrprefixp.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -21,7 +21,7 @@
 (in-package "STR")
 (include-book "ieqv")
 (include-book "iprefixp")
-(include-book "std/lists/nthcdr" :dir :system)
+(local (include-book "std/lists/nthcdr" :dir :system))
 (local (include-book "arithmetic"))
 
 (local (defthm iprefixp-lemma-1
@@ -52,7 +52,7 @@
 
 <p>Logically, this is identical to</p>
 @({
-  (iprefixp (coerce x 'list) (coerce y 'list))
+  (iprefixp (explode x) (explode y))
 })
 
 <p>But we use a more efficient implementation which avoids coercing the strings
@@ -96,8 +96,8 @@
     (declare (type string x)
              (type string y)
              (xargs :verify-guards nil))
-    (mbe :logic (iprefixp (coerce x 'list)
-                          (coerce y 'list))
+    (mbe :logic (iprefixp (explode x)
+                          (explode y))
          :exec (istrprefixp-impl (the string x)
                                  (the string y)
                                  (the integer 0)
@@ -119,5 +119,9 @@
                               (nthcdr yn (coerce y 'list)))))
     :hints(("Goal" :in-theory (enable istrprefixp-impl))))
 
-  (verify-guards istrprefixp$inline))
+  (verify-guards istrprefixp$inline)
+
+  (defcong istreqv equal (istrprefixp x y) 1)
+  (defcong istreqv equal (istrprefixp x y) 2))
+
 
diff -Nru acl2-6.2/books/str/isubstrp.lisp acl2-6.3/books/str/isubstrp.lisp
--- acl2-6.2/books/str/isubstrp.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/isubstrp.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -34,8 +34,7 @@
 matched substring.</p>"
 
   (definlined isubstrp (x y)
-    (declare (type string x)
-             (type string y))
+    (declare (type string x y))
     (if (istrpos x y)
         t
       nil))
@@ -43,22 +42,23 @@
   (local (in-theory (enable isubstrp)))
 
   (defthm iprefixp-when-isubstrp
-    (implies (and (isubstrp x y)
-                  (force (stringp x))
-                  (force (stringp y)))
-             (iprefixp (coerce x 'list)
-                       (nthcdr (istrpos x y) (coerce y 'list)))))
+    (implies (isubstrp x y)
+             (iprefixp (explode x)
+                       (nthcdr (istrpos x y) (explode y)))))
 
   (defthm completeness-of-isubstrp
-    (implies (and (iprefixp (coerce x 'list)
-                            (nthcdr m (coerce y 'list)))
-                  (force (natp m))
-                  (force (stringp x))
-                  (force (stringp y)))
+    (implies (and (iprefixp (explode x)
+                            (nthcdr m (explode y)))
+                  (force (natp m)))
              (isubstrp x y))
     :hints(("Goal"
             :in-theory (disable completeness-of-istrpos)
-            :use ((:instance completeness-of-istrpos))))))
+            :use ((:instance completeness-of-istrpos)))))
+
+  (local (in-theory (disable istreqv)))
+
+  (defcong istreqv equal (isubstrp x y) 1)
+  (defcong istreqv equal (isubstrp x y) 2))
 
 
 
@@ -85,6 +85,9 @@
 
   (local (in-theory (enable collect-strs-with-isubstr)))
 
+  (defcong istreqv equal (collect-strs-with-isubstr a x) 1
+    :hints(("Goal" :in-theory (disable istreqv))))
+
   (defthm collect-strs-with-isubstr-when-atom
     (implies (atom x)
              (equal (collect-strs-with-isubstr a x)
@@ -134,6 +137,9 @@
 
   (local (in-theory (enable collect-syms-with-isubstr)))
 
+  (defcong istreqv equal (collect-syms-with-isubstr a x) 1
+    :hints(("Goal" :in-theory (disable istreqv))))
+
   (defthm collect-syms-with-isubstr-when-atom
     (implies (atom x)
              (equal (collect-syms-with-isubstr a x)
diff -Nru acl2-6.2/books/str/make-character-list.lisp acl2-6.3/books/str/make-character-list.lisp
--- acl2-6.2/books/str/make-character-list.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/str/make-character-list.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,81 @@
+; ACL2 String Library
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+;
+; Additional copyright notice for make-character-list.lisp:
+;
+; This file is adapted from the Unicode library, Copyright (C) 2005-2013 by
+; Jared Davis, which was also released under the GPL.
+
+(in-package "STR")
+(include-book "char-fix")
+(local (include-book "std/lists/append" :dir :system))
+
+(in-theory (disable make-character-list))
+
+(defsection str/make-character-list
+  :parents (coercion make-character-list)
+  :short "Lemmas about @(see make-character-list) in the @(see str) library."
+
+  :long "<p>This function is normally not anything you would ever want to use.
+It is notable mainly for the role it plays in the completion axiom for @(see
+coerce).</p>"
+
+  (local (in-theory (enable make-character-list)))
+
+  (defthm make-character-list-when-atom
+    (implies (atom x)
+             (equal (make-character-list x)
+                    nil)))
+
+  (defthm make-character-list-of-cons
+    (equal (make-character-list (cons a x))
+           (cons (char-fix a)
+                 (make-character-list x))))
+
+  (defthm consp-of-make-character-list
+    (equal (consp (make-character-list x))
+           (consp x)))
+
+  (defthm make-character-list-under-iff
+    (iff (make-character-list x)
+         (consp x)))
+
+  (defthm len-of-make-character-list
+    (equal (len (make-character-list x))
+           (len x)))
+
+  (defthm make-character-list-when-character-listp
+    (implies (character-listp x)
+             (equal (make-character-list x)
+                    x)))
+
+  (defthm character-listp-of-make-character-list
+    (character-listp (make-character-list x)))
+
+  (defthm make-character-list-of-append
+    (equal (make-character-list (append x y))
+           (append (make-character-list x)
+                   (make-character-list y))))
+
+  (defthm make-character-list-of-revappend
+    (equal (make-character-list (revappend x y))
+           (revappend (make-character-list x)
+                      (make-character-list y)))))
+
diff -Nru acl2-6.2/books/str/match/acl2-customization.lsp acl2-6.3/books/str/match/acl2-customization.lsp
--- acl2-6.2/books/str/match/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/str/match/acl2-customization.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,23 @@
+; ACL2 String Library
+; Copyright (C) 2009-2010 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2")
+(ld "../acl2-customization.lsp")
+(in-package "STR")
\ No newline at end of file
diff -Nru acl2-6.2/books/str/match/cert.acl2 acl2-6.3/books/str/match/cert.acl2
--- acl2-6.2/books/str/match/cert.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/str/match/cert.acl2	2013-09-30 17:52:16.000000000 +0000
@@ -0,0 +1,22 @@
+; ACL2 String Library
+; Copyright (C) 2009-2010 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(include-book "../portcullis")
+; cert-flags: ? t :ttags :all
\ No newline at end of file
diff -Nru acl2-6.2/books/str/natstr.lisp acl2-6.3/books/str/natstr.lisp
--- acl2-6.2/books/str/natstr.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/natstr.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -20,18 +20,8 @@
 
 (in-package "STR")
 (include-book "digitp")
-(include-book "arithmetic/nat-listp" :dir :system)
-(local (include-book "std/lists/revappend" :dir :system))
+(local (include-book "arithmetic"))
 (local (include-book "arithmetic-3/floor-mod/floor-mod" :dir :system))
-(local (include-book "std/lists/rev" :dir :system))
-(local (include-book "std/lists/coerce" :dir :system))
-
-
-(local (defthm digit-listp-of-rev
-         (implies (digit-listp x)
-                  (digit-listp (acl2::rev x)))
-         :hints(("Goal" :in-theory (enable acl2::rev)))))
-
 
 (defsection basic-natchars
   :parents (natchars)
@@ -92,14 +82,13 @@
 
 
 
-
 (defsection natchars
   :parents (numbers)
   :short "Convert a natural number into a list of characters."
   :long "<p>For instance, @('(natchars 123)') is @('(#\\1 #\\2 #\\3)').</p>"
 
   (local (defthm digit-list-value-of-rev-of-basic-natchars
-           (equal (digit-list-value (acl2::rev (basic-natchars n)))
+           (equal (digit-list-value (rev (basic-natchars n)))
                   (nfix n))
            :hints(("Goal"
                    :induct (basic-natchars n)
@@ -150,11 +139,11 @@
   (encapsulate
     ()
     (local (defthm lemma1
-             (equal (equal (acl2::rev x) (list y))
+             (equal (equal (rev x) (list y))
                     (and (consp x)
                          (not (consp (cdr x)))
                          (equal (car x) y)))
-             :hints(("Goal" :in-theory (enable acl2::rev)))))
+             :hints(("Goal" :in-theory (enable rev)))))
 
     (local (defthmd lemma2
              (not (equal (basic-natchars n) '(#\0)))
@@ -184,7 +173,7 @@
   (definlined natstr (n)
     (declare (type integer n)
              (xargs :guard (natp n)))
-    (coerce (natchars n) 'string))
+    (implode (natchars n)))
 
   (local (in-theory (enable natstr)))
 
@@ -193,14 +182,14 @@
     :rule-classes :type-prescription)
 
   (defthm digit-listp-of-natstr
-    (digit-listp (coerce (natstr n) 'list)))
+    (digit-listp (explode (natstr n))))
 
   (defthm natstr-one-to-one
     (equal (equal (natstr n) (natstr m))
            (equal (nfix n) (nfix m))))
 
   (defthm digit-list-value-of-natstr
-    (equal (digit-list-value (coerce (natstr n) 'list))
+    (equal (digit-list-value (explode (natstr n)))
            (nfix n)))
 
   (defthm natstr-nonempty
@@ -213,7 +202,7 @@
   :short "Convert a list of natural numbers into a list of strings."
 
   (defund natstr-list (x)
-    (declare (xargs :guard (acl2::nat-listp x)))
+    (declare (xargs :guard (nat-listp x)))
     (if (atom x)
         nil
       (cons (natstr (car x))
diff -Nru acl2-6.2/books/str/package.lsp acl2-6.3/books/str/package.lsp
--- acl2-6.2/books/str/package.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/package.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -18,16 +18,17 @@
 ;
 ; Original author: Jared Davis <jared@centtech.com>
 
-(ld "xdoc/package.lsp" :dir :system)
+(in-package "ACL2")
 
 (defpkg "STR"
   (set-difference-eq
    (union-eq *acl2-exports*
              *common-lisp-symbols-from-main-lisp-package*
              '(quit exit simpler-take list-fix list-equiv rev
-                    prefixp str b* assert!
-                    listpos sublistp
-                    a b c d e f g h i j k l m n o p q r s t u v w x y z)
+                    prefixp str b* assert! repeat
+                    listpos sublistp implode explode
+                    a b c d e f g h i j k l m n o p q r s t u v w x y z
+                    top)
              '(defxdoc defsection lnfix definlined definline
                 define defaggregate unsigned-byte-p signed-byte-p))
 
diff -Nru acl2-6.2/books/str/pad.lisp acl2-6.3/books/str/pad.lisp
--- acl2-6.2/books/str/pad.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/pad.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -17,9 +17,12 @@
 ; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
 ;
 ; Original author: Jared Davis <jared@centtech.com>
+; Additional author: David Rager <ragerdl@cs.utexas.edu>
 
 (in-package "STR")
 (include-book "cat")
+(include-book "ieqv")
+(local (include-book "std/lists/repeat" :dir :system))
 (local (include-book "std/lists/take" :dir :system))
 (local (include-book "arithmetic"))
 
@@ -36,7 +39,7 @@
 
 @({
   (rpadchars '(#\\f #\\o #\\o) 5)
-     --&gt;
+     -->
   '(#\\f #\\o #\\o #\\Space #\\Space)
 })
 
@@ -49,28 +52,30 @@
 
   (defund rpadchars (x len)
     (declare (xargs :guard (and (character-listp x)
-                                (natp len))
-                    :guard-hints (("Goal" :in-theory (enable acl2::repeat))))
+                                (natp len)))
              (type integer len))
     (mbe :logic
-         (append x (make-list (nfix (- (nfix len) (len x)))
-                              :initial-element #\Space))
+         (append (make-character-list x)
+                 (repeat #\Space (nfix (- (nfix len) (len x)))))
          :exec
          (let* ((x-len (length (the list x)))
                 (diff  (- len x-len)))
            (if (> diff 0)
-               (append x (make-list diff :initial-element #\Space))
+               (append x (repeat #\Space diff))
              x))))
 
   (local (in-theory (enable rpadchars)))
 
   (defthm character-listp-of-rpadchars
-    (implies (force (character-listp x))
-             (character-listp (rpadchars x len))))
+    (character-listp (rpadchars x len)))
 
   (defthm len-of-rpadchars
     (equal (len (rpadchars x len))
-           (max (len x) (nfix len)))))
+           (max (len x) (nfix len))))
+
+  (defcong charlisteqv  equal        (rpadchars x len) 1)
+  (defcong icharlisteqv icharlisteqv (rpadchars x len) 1))
+
 
 
 (defsection rpadstr
@@ -82,7 +87,7 @@
 
 @({
   (rpadchars \"foo\" 5)
-     --&gt;
+     -->
   \"foo  \"
 })
 
@@ -97,22 +102,20 @@
 
   (defund rpadstr (x len)
     (declare (xargs :guard (and (stringp x)
-                                (natp len))
-                    :guard-debug t)
+                                (natp len)))
              (type string x)
              (type integer len))
     (mbe :logic
-         (coerce (rpadchars (coerce x 'list) len) 'string)
+         (implode (rpadchars (explode x) len))
          :exec
          (let* ((x-len (length (the string x)))
                 (diff  (- len x-len)))
            (if (> diff 0)
-               (let ((spaces (make-list diff :initial-element #\Space)))
-                 (coerce (mbe :logic (append-chars x spaces)
-                              :exec (if (zp x-len)
-                                        spaces
-                                      (append-chars-aux x (- x-len 1) spaces)))
-                         'string))
+               (let ((spaces (repeat #\Space diff)))
+                 (implode (mbe :logic (append-chars x spaces)
+                               :exec (if (zp x-len)
+                                         spaces
+                                       (append-chars-aux x (- x-len 1) spaces)))))
              x))))
 
   (local (in-theory (enable rpadstr)))
@@ -121,11 +124,15 @@
     (stringp (rpadstr x len))
     :rule-classes :type-prescription)
 
-  (defthm len-of-coerce-of-rpadstr
+  (defthm len-of-explode-of-rpadstr
     (implies (force (stringp x))
-             (equal (len (coerce (rpadstr x len) 'list))
+             (equal (len (explode (rpadstr x len)))
                     (max (length x)
-                         (nfix len))))))
+                         (nfix len)))))
+
+  (defcong streqv  equal   (rpadstr x len) 1)
+  (defcong istreqv istreqv (rpadstr x len) 1))
+
 
 
 (defsection lpadchars
@@ -137,7 +144,7 @@
 
 @({
   (lpadchars '(#\\f #\\o #\\o) 5)
-     --&gt;
+     -->
   '(#\\Space #\\Space #\\f #\\o #\\o)
 })
 
@@ -153,9 +160,8 @@
                                 (natp len)))
              (type integer len))
     (mbe :logic
-         (append (make-list (nfix (- (nfix len) (len x)))
-                            :initial-element #\Space)
-                 x)
+         (append (repeat #\Space (nfix (- (nfix len) (len x))))
+                 (make-character-list x))
          :exec
          (let* ((x-len (length x))
                 (diff  (- len x-len)))
@@ -166,12 +172,14 @@
   (local (in-theory (enable lpadchars)))
 
   (defthm character-listp-of-lpadchars
-    (implies (force (character-listp x))
-             (character-listp (lpadchars x len))))
+    (character-listp (lpadchars x len)))
 
   (defthm len-of-lpadchars
     (equal (len (lpadchars x len))
-           (max (len x) (nfix len)))))
+           (max (len x) (nfix len))))
+
+  (defcong charlisteqv  equal        (lpadchars x len) 1)
+  (defcong icharlisteqv icharlisteqv (lpadchars x len) 1))
 
 
 (defsection lpadstr
@@ -183,7 +191,7 @@
 
 @({
   (lpadstr \"foo\" 5)
-     --&gt;
+     -->
   \"  foo\"
 })
 
@@ -202,12 +210,12 @@
              (type string x)
              (type integer len))
     (mbe :logic
-         (coerce (lpadchars (coerce x 'list) len) 'string)
+         (implode (lpadchars (explode x) len))
          :exec
          (let* ((x-len (length x))
                 (diff  (- len x-len)))
            (if (< 0 diff)
-               (coerce (make-list-ac diff #\Space (coerce x 'list)) 'string)
+               (implode (make-list-ac diff #\Space (explode x)))
              x))))
 
   (local (in-theory (enable lpadstr)))
@@ -216,34 +224,33 @@
     (stringp (lpadstr x len))
     :rule-classes :type-prescription)
 
-  (defthm len-of-coerce-of-lpadstr
+  (defthm len-of-explode-of-lpadstr
     (implies (force (stringp x))
-             (equal (len (coerce (lpadstr x len) 'list))
+             (equal (len (explode (lpadstr x len)))
                     (max (length x)
-                         (nfix len))))))
+                         (nfix len)))))
 
+  (defcong streqv  equal   (lpadstr x len) 1)
+  (defcong istreqv istreqv (lpadstr x len) 1))
 
-(defsection trim
+
+
+(defsection trim-bag
   :parents (pad-trim)
-  :short "Remove whitespace from the front and end of a string."
+  :short "Remove particular characters from the front and end of a string."
 
-  :long "<p>@(call trim) removes whitespace characters from the front and end
-of the string @('x').</p>
+  :long "<p>@(call trim-bag) removes the characters in @('bag') from the
+front and end of the string @('x').</p>
 
 <p>BOZO eventually make this efficient.</p>"
 
-  (defund trim-aux (x)
-    (declare (xargs :guard (character-listp x)))
+  (defund trim-aux (x bag)
+    (declare (xargs :guard (and (character-listp x)
+                                (character-listp bag))))
     ;; Remove all whitespace characters from the front of a list.
     (if (consp x)
-        (if (or (eql (car x) #\Space)
-                (eql (car x) #\Tab)
-                (eql (car x) #\Newline)
-                (eql (car x) #\Page)
-                (eql (car x) (code-char 13)) ;; Carriage Return
-                (eql (car x) (code-char 11)) ;; Vertical Tab
-                )
-            (trim-aux (cdr x))
+        (if (acl2::member (car x) bag) ; :test eql is default
+            (trim-aux (cdr x) bag)
           x)
       nil))
 
@@ -251,20 +258,45 @@
 
   (defthm character-listp-of-trim-aux
     (implies (force (character-listp x))
-             (character-listp (trim-aux x))))
+             (character-listp (trim-aux x bag))))
 
   (local (defthm true-listp-when-character-listp
            (implies (character-listp x)
                     (true-listp x))))
 
+  (defund trim-bag (x bag)
+    (declare (xargs :guard (and (stringp x)
+                                (character-listp bag))))
+    (let* ((chars (explode x))
+           (chars (trim-aux chars bag)) ;; eat spaces at the front
+           (chars (reverse chars))      ;; flip so we can get to the back
+           (chars (trim-aux chars bag)) ;; eat spaces at the back
+           (chars (reverse chars)))     ;; flip again so it's back to normal
+      (implode chars)))
+
+  (local (in-theory (enable trim-bag)))
+
+  (defthm stringp-of-trim-bag
+    (stringp (trim-bag x bag))
+    :rule-classes :type-prescription))
+
+(defsection trim
+  :parents (pad-trim)
+  :short "Remove whitespace characters from the front and end of a string."
+
+  :long "<p>@(call trim) removes whitespace characters from the
+front and end of the string @('x').</p>"
+
+
   (defund trim (x)
     (declare (xargs :guard (stringp x)))
-    (let* ((chars (coerce x 'list))
-           (chars (trim-aux chars)) ;; eat spaces at the front
-           (chars (reverse chars))  ;; flip so we can get to the back
-           (chars (trim-aux chars)) ;; eat spaces at the back
-           (chars (reverse chars))) ;; flip again so it's back to normal
-      (coerce chars 'string)))
+    (let* ((bag (list #\Space
+                      #\Tab
+                      #\Newline
+                      #\Page
+                      (code-char 13)    ;; Carriage Return
+                      (code-char 11)))) ;; Vertical Tab
+      (trim-bag x bag)))
 
   (local (in-theory (enable trim)))
 
diff -Nru acl2-6.2/books/str/portcullis.acl2 acl2-6.3/books/str/portcullis.acl2
--- acl2-6.2/books/str/portcullis.acl2	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/portcullis.acl2	2013-09-30 17:52:16.000000000 +0000
@@ -1,3 +1,23 @@
+; ACL2 String Library
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
 (in-package "ACL2")
 (ld "package.lsp")
 ; cert-flags: ? t :ttags :all
diff -Nru acl2-6.2/books/str/portcullis.lisp acl2-6.3/books/str/portcullis.lisp
--- acl2-6.2/books/str/portcullis.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/portcullis.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
diff -Nru acl2-6.2/books/str/prefix-lines.lisp acl2-6.3/books/str/prefix-lines.lisp
--- acl2-6.2/books/str/prefix-lines.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/prefix-lines.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
diff -Nru acl2-6.2/books/str/stringify.lisp acl2-6.3/books/str/stringify.lisp
--- acl2-6.2/books/str/stringify.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/stringify.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -20,16 +20,16 @@
 ; Original author: Sol Swords <sswords@centtech.com>
 
 (in-package "STR")
-
+(include-book "cat")
 (include-book "natstr")
 
 (defun stringify-integer (x)
   (declare (Xargs :guard (integerp x)))
-  (if (and (integerp x) (< x 0))
-      (concatenate 'string "-" (natstr (- x)))
+  (if (and (mbt (integerp x))
+           (< x 0))
+      (cat "-" (natstr (- x)))
     (natstr x)))
 
-
 (encapsulate
   nil
   (local (defthm natchars-of-non-natp
@@ -43,26 +43,8 @@
     :hints(("Goal" :in-theory (enable natstr)))))
 
 
-
-(local (defthmd switch-coerce-list
-         (implies (and (character-listp x) (stringp y))
-                  (equal (equal x (coerce y 'list))
-                         (equal (coerce x 'string) y)))))
-
-(local (defthmd switch-coerce-string
-         (implies (and (character-listp y) (stringp x))
-                  (equal (equal x (coerce y 'string))
-                         (equal (coerce x 'list) y)))))
-
-(local (defthm equal-coerce-list
-         (implies (and (stringp y) (stringp x))
-                  (equal (Equal (coerce x 'list) (coerce y 'list))
-                         (equal x y)))
-         :hints(("Goal" :in-theory (enable switch-coerce-list)))))
-
 (encapsulate
   nil
-
   (local (defthm not-member-minus-char-digit-listp
            (implies (digit-listp x)
                     (not (member-equal #\- x)))))
@@ -76,27 +58,26 @@
                          (characterp a)
                          (character-listp b)
                          (stringp c))
-                    (and (equal (Equal (coerce (cons a b) 'string) c)
-                                (equal (cons a b) (coerce c 'list)))
-                         (equal (Equal c (coerce (cons a b) 'string))
-                                (equal (cons a b) (coerce c 'list)))))))
-
-  (local (in-theory (disable switch-coerce-string)))
+                    (and (equal (Equal (implode (cons a b)) c)
+                                (equal (cons a b) (explode c)))
+                         (equal (Equal c (implode (cons a b)))
+                                (equal (cons a b) (explode c)))))))
 
   (defthm stringify-integer-one-to-one
     (equal (equal (stringify-integer x)
                   (stringify-integer y))
            (equal (ifix x) (ifix y)))
     :hints (("goal" :use ((:instance not-member-minus-char-digit-listp
-                           (x (coerce (natstr x) 'list)))
+                                     (x (coerce (natstr x) 'list)))
                           (:instance not-member-minus-char-digit-listp
-                           (x (coerce (natstr y) 'list)))
+                                     (x (coerce (natstr y) 'list)))
                           (:instance natstr-one-to-one
-                           (n x) (m 0))
+                                     (n x) (m 0))
                           (:instance natstr-one-to-one
-                           (n y) (m 0)))
+                                     (n y) (m 0)))
              :in-theory (disable not-member-minus-char-digit-listp)))))
 
+
 (defthm stringify-integer-of-non-integer
   (implies (not (integerp x))
            (equal (stringify-integer x) "0"))
@@ -108,27 +89,28 @@
                     (not (member-equal #\/ x)))))
 
   (defthm not-member-/-stringify-integer
-    (not (member-equal #\/ (coerce (stringify-integer i) 'list))))
+    (not (member-equal #\/ (explode (stringify-integer i)))))
 
   (defthm not-member-/-natstr
-    (not (member-equal #\/ (coerce (natstr i) 'list)))))
+    (not (member-equal #\/ (explode (natstr i))))))
 
 (in-theory (disable stringify-integer))
 
 (defun stringify-rational (x)
   (declare (xargs :guard (rationalp x)))
-  (if (or (integerp x) (mbe :logic (not (rationalp x)) :exec nil))
+  (if (or (integerp x)
+          (mbe :logic (not (rationalp x))
+               :exec nil))
       (stringify-integer x)
-    (concatenate 'string (stringify-integer (numerator x))
-                 "/" (natstr (denominator x)))))
-
+    (cat (stringify-integer (numerator x))
+         "/"
+         (natstr (denominator x)))))
 
 (local (defthm member-equal-append
          (iff (member-equal k (append a b))
               (or (member-equal k a)
                   (member-equal k b)))))
 
-
 (local (defun cdr-both-equal (a b)
          (if (or (atom a) (atom b))
              nil
@@ -154,15 +136,14 @@
 
 (encapsulate
   nil
-  
   (local (defthm switch-coerce-append-string
            (implies (and (character-listp a)
                          (character-listp b)
                          (stringp c))
-                    (and (equal (Equal (coerce (append a b) 'string) c)
-                                (equal (append a b) (coerce c 'list)))
-                         (equal (Equal c (coerce (append a b) 'string))
-                                (equal (append a b) (coerce c 'list)))))))
+                    (and (equal (Equal (implode (append a b)) c)
+                                (equal (append a b) (explode c)))
+                         (equal (Equal c (implode (append a b)))
+                                (equal (append a b) (explode c)))))))
 
   (local (defthm not-equal-if-not-members-append-cons
            (implies (not (member-equal a c))
@@ -195,14 +176,14 @@
                     (not (member-equal #\# x)))))
 
   (defthm not-member-sharp-natstr
-    (not (member-equal #\# (coerce (natstr i) 'list))))
+    (not (member-equal #\# (explode (natstr i)))))
 
   (defthm not-member-sharp-stringify-integer
-    (not (member-equal #\# (coerce (stringify-integer i) 'list)))
+    (not (member-equal #\# (explode (stringify-integer i))))
     :hints(("Goal" :in-theory (enable stringify-integer))))
 
   (defthm not-member-sharp-stringify-rational
-    (not (member-equal #\# (coerce (stringify-rational r) 'list)))))
+    (not (member-equal #\# (explode (stringify-rational r))))))
 
 (encapsulate nil
   (local (defthm not-member-space-char-digit-listp
@@ -210,28 +191,28 @@
                     (not (member-equal #\Space x)))))
 
   (defthm not-member-space-natstr
-    (not (member-equal #\Space (coerce (natstr i) 'list))))
+    (not (member-equal #\Space (explode (natstr i)))))
 
   (defthm not-member-space-stringify-integer
-    (not (member-equal #\Space (coerce (stringify-integer i) 'list)))
+    (not (member-equal #\Space (explode (stringify-integer i))))
     :hints(("Goal" :in-theory (enable stringify-integer))))
 
   (defthm not-member-space-stringify-rational
-    (not (member-equal #\Space (coerce (stringify-rational r) 'list)))))
+    (not (member-equal #\Space (explode (stringify-rational r))))))
 
 (in-theory (disable stringify-rational))
 
 (defun stringify-number (x)
   (declare (xargs :guard (acl2-numberp x)))
-  (if (or (rationalp x) (mbe :logic (not (acl2-numberp x)) :exec nil))
+  (if (or (rationalp x)
+          (mbe :logic (not (acl2-numberp x))
+               :exec nil))
       (stringify-rational x)
-    (concatenate 'string
-                 "#C(" (stringify-rational (realpart x))
-                 " " (stringify-rational (imagpart x)) ")")))
+    (cat "#C(" (stringify-rational (realpart x))
+         " " (stringify-rational (imagpart x)) ")")))
 
 (encapsulate
   nil
-  
   (local (defthm switch-coerce-list*-append-string
            (implies (and (character-listp a)
                          (character-listp b)
@@ -239,10 +220,10 @@
                          (characterp f)
                          (characterp g)
                          (stringp c))
-                    (and (equal (Equal (coerce (list* e f g (append a b)) 'string) c)
-                                (equal (list* e f g (append a b)) (coerce c 'list)))
-                         (equal (Equal c (coerce (list* e f g (append a b)) 'string))
-                                (equal (list* e f g (append a b)) (coerce c 'list)))))))
+                    (and (equal (Equal (implode (list* e f g (append a b))) c)
+                                (equal (list* e f g (append a b)) (explode c)))
+                         (equal (Equal c (implode (list* e f g (append a b))))
+                                (equal (list* e f g (append a b)) (explode c)))))))
 
   (local (defthmd not-equal-by-len
            (implies (not (equal (len x) (len y)))
@@ -288,27 +269,15 @@
              :in-theory (disable not-member-space-stringify-rational
                                  realpart-imagpart-elim)))))
 
-(defun upper-casep (x)
-  (declare (type character x))
-  (mbe :logic (let ((code (char-code (char-fix x))))
-                   (and (<= (char-code #\A) code)
-                        (<= code (char-code #\Z))))
-       :exec (let ((code (the (unsigned-byte 8)
-                              (char-code (the character x)))))
-                  (declare (type (unsigned-byte 8) code))
-                  (and (<= (the (unsigned-byte 8) 65)
-                           (the (unsigned-byte 8) code))
-                       (<= (the (unsigned-byte 8) code)
-                           (the (unsigned-byte 8) 90))))))
 
 (defun upper-case-or-digit-listp (x)
   (declare (xargs :guard (character-listp x)))
   (if (atom x)
       t
-    (and (or (upper-casep (car X)) (digitp (car x)))
+    (and (or (up-alpha-p (car X)) (digitp (car x)))
          (upper-case-or-digit-listp (cdr x)))))
 
-(in-theory (disable upper-case-or-digit-listp upper-casep))
+(in-theory (disable upper-case-or-digit-listp up-alpha-p))
 
 (local (defthm characterp-car-of-character-listp
          (implies (and (character-listp x)
@@ -330,9 +299,9 @@
 ;; to be either upper-case or digits.
 (defun escape-free-symnamep (x)
   (declare (xargs :guard (stringp x)))
-  (let ((lst (coerce x 'list)))
+  (let ((lst (explode x)))
     (and (consp lst) ;; not the empty string
-         (upper-casep (car lst))
+         (up-alpha-p (car lst))
          (upper-case-or-digit-listp (cdr lst)))))
 
 (local (defthm assoc-append
@@ -350,33 +319,33 @@
 (defun stringify-symbol (x)
   (declare (type symbol x))
   (let ((name (symbol-name x))
-        (pkg (symbol-package-name x)))
+        (pkg  (symbol-package-name x)))
     (mbe :logic
          (if (symbolp x)
              (let ((pkg-string
                     (if (equal pkg "ACL2")
                         ""
                       (if (escape-free-symnamep pkg)
-                          (concatenate 'string pkg "::")
-                        (concatenate 'string "|" pkg "|::"))))
+                          (cat pkg "::")
+                        (cat "|" pkg "|::"))))
                    (name-string
                     (if (escape-free-symnamep name)
                         name
-                      (concatenate 'string "|" name "|"))))
-               (concatenate 'string pkg-string name-string))
+                      (cat "|" name "|"))))
+               (cat pkg-string name-string))
            "COMMON-LISP::NIL")
          :exec
          (if (equal pkg "ACL2")
              (if (escape-free-symnamep name)
                  name
-               (concatenate 'string "|" name "|"))
+               (cat "|" name "|"))
            (if (escape-free-symnamep pkg)
                (if (escape-free-symnamep name)
-                   (concatenate 'string pkg "::" name)
-                 (concatenate 'string pkg "::|" name "|"))
+                   (cat pkg "::" name)
+                 (cat pkg "::|" name "|"))
              (if (escape-free-symnamep name)
-                 (concatenate 'string "|" pkg "|::" name)
-               (concatenate 'string "|" pkg "|::|" name "|")))))))
+                 (cat "|" pkg "|::" name)
+               (cat "|" pkg "|::|" name "|")))))))
 
 (in-theory (disable escape-free-symnamep))
 
@@ -394,14 +363,11 @@
 ;;                `(:use ((:instance symbol-equality
 ;;                         (acl2::s1 ,(cadar (last clause))) (acl2::s2 nil)))))))
 
-
-       
 (defun stringify-atom (x)
-  (declare (Xargs :guard (not (consp x))))
-  (cond ((symbolp x) (stringify-symbol x))
-        ((stringp x) (concatenate 'string "\"" x "\""))
+  ;; BOZO escaping of strings, proper escaping of characters, ...
+  (declare (xargs :guard (atom x)))
+  (cond ((symbolp x)      (stringify-symbol x))
+        ((stringp x)      (cat "\"" x "\""))
         ((acl2-numberp x) (stringify-number x))
-        ((characterp x)
-         (concatenate 'string "#\\" (coerce (list x) 'string)))
-        (t "##**BAD-ATOM**##")))
-         
+        ((characterp x)   (cat "#\\" (implode (list x))))
+        (t                "##**BAD-ATOM**##")))
diff -Nru acl2-6.2/books/str/strline.lisp acl2-6.3/books/str/strline.lisp
--- acl2-6.2/books/str/strline.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strline.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -19,7 +19,7 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "STR")
-(include-book "xdoc/top" :dir :system)
+(include-book "coerce")
 (local (include-book "misc/assert" :dir :system))
 (local (include-book "arithmetic"))
 
@@ -55,11 +55,10 @@
                                 (natp n)
                                 (natp xl)
                                 (<= n xl)
-                                (= xl (length x)))
-                    :measure (nfix (- (nfix xl) (nfix n)))))
+                                (= xl (length x)))))
     (mbe :logic
          (position-ac char
-                      (nthcdr n (coerce x 'list))
+                      (nthcdr n (explode x))
                       (nfix n))
          :exec
          (cond ((mbe :logic (zp (- (nfix xl) (nfix n)))
diff -Nru acl2-6.2/books/str/strnatless.lisp acl2-6.3/books/str/strnatless.lisp
--- acl2-6.2/books/str/strnatless.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strnatless.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -21,7 +21,6 @@
 (in-package "STR")
 (include-book "digitp")
 (include-book "tools/mv-nth" :dir :system)
-(include-book "tools/bstar" :dir :system)
 (local (include-book "arithmetic"))
 
 
@@ -218,10 +217,7 @@
 
   (defund parse-nat-from-string (x val len n xl)
     (declare (type string x)
-             (type integer val)
-             (type integer len)
-             (type integer n)
-             (type integer xl)
+             (type (integer 0 *) val len n xl)
              (xargs :guard (and (stringp x)
                                 (natp val)
                                 (natp len)
@@ -248,21 +244,25 @@
                 (mv val len))
                (t
                 (let ((code (the (unsigned-byte 8)
-                              (char-code (the character (char (the string x)
-                                                              (the integer n)))))))
+                              (char-code (the character
+                                           (char (the string x)
+                                                 (the (integer 0 *) n)))))))
                   (declare (type (unsigned-byte 8) code))
-                  (if (and (<= (the (unsigned-byte 8) 48) (the (unsigned-byte 8) code))
-                           (<= (the (unsigned-byte 8) code) (the (unsigned-byte 8) 57)))
+                  (if (and (<= (the (unsigned-byte 8) 48)
+                               (the (unsigned-byte 8) code))
+                           (<= (the (unsigned-byte 8) code)
+                               (the (unsigned-byte 8) 57)))
                       (let ((digit-val (the (unsigned-byte 8)
                                          (- (the (unsigned-byte 8) code)
                                             (the (unsigned-byte 8) 48)))))
                         (parse-nat-from-string
                          (the string x)
-                         (the integer (+ (the (unsigned-byte 8) digit-val)
-                                         (the integer (* 10 (the integer val)))))
-                         (the integer (+ 1 (the integer len)))
-                         (the integer (+ 1 (the integer n)))
-                         (the integer xl)))
+                         (the (integer 0 *)
+                           (+ (the (unsigned-byte 8) digit-val)
+                              (the (integer 0 *) (* 10 (the (integer 0 *) val)))))
+                         (the (integer 0 *) (+ 1 (the (integer 0 *) len)))
+                         (the (integer 0 *) (+ 1 (the (integer 0 *) n)))
+                         (the (integer 0 *) xl)))
                     (mv val len)))))))
 
   (local (in-theory (enable parse-nat-from-string)))
@@ -293,14 +293,13 @@
             :induct (parse-nat-from-string x val len n xl))))
 
   (defthm val-of-parse-nat-from-string
-    (implies (and (stringp x)
-                  (natp val)
+    (implies (and (natp val)
                   (natp len)
                   (natp n)
-                  (equal xl (length x))
+                  (equal xl (len (explode x)))
                   (<= n xl))
              (equal (mv-nth 0 (parse-nat-from-string x val len n xl))
-                    (mv-nth 0 (parse-nat-from-charlist (nthcdr n (coerce x 'list)) val len))))
+                    (mv-nth 0 (parse-nat-from-charlist (nthcdr n (explode x)) val len))))
     :hints(("Goal"
             :induct (parse-nat-from-string x val len n xl)
             :in-theory (e/d (parse-nat-from-charlist)
@@ -308,14 +307,13 @@
             :do-not '(generalize fertilize))))
 
   (defthm len-of-parse-nat-from-string
-    (implies (and (stringp x)
-                  (natp val)
+    (implies (and (natp val)
                   (natp len)
                   (natp n)
-                  (equal xl (length x))
+                  (equal xl (len (explode x)))
                   (<= n xl))
              (equal (mv-nth 1 (parse-nat-from-string x val len n xl))
-                    (mv-nth 1 (parse-nat-from-charlist (nthcdr n (coerce x 'list)) val len))))
+                    (mv-nth 1 (parse-nat-from-charlist (nthcdr n (explode x)) val len))))
     :hints(("Goal"
             :induct (parse-nat-from-string x val len n xl)
             :in-theory (e/d (parse-nat-from-charlist)
@@ -642,8 +640,6 @@
                              expt
                              default-car
                              default-cdr
-                             default-coerce-1
-                             default-coerce-2
                              (:rewrite PROGRESS-OF-PARSE-NAT-FROM-STRING)
                              )))
 
@@ -788,7 +784,6 @@
                                default-char-code
                                char<-antisymmetric
                                char<-trichotomy-strong
-                               default-coerce-2 default-coerce-1
                                default-<-1 default-<-2
                                default-+-1 default-+-2
                                acl2::open-small-nthcdr
@@ -797,10 +792,8 @@
                                ACL2::|x < y  =>  0 < -x+y|
                                nthcdr len nth not
                                strnat<-aux
-;                               char-code-linear
                                acl2::natp-fc-1
                                acl2::natp-fc-2
-                               (:FORWARD-CHAINING CHARACTER-LISTP-COERCE)
                                (:FORWARD-CHAINING EQLABLE-LISTP-FORWARD-TO-ATOM-LISTP)
                                (:FORWARD-CHAINING CHARACTER-LISTP-FORWARD-TO-EQLABLE-LISTP)
                                (:FORWARD-CHAINING ATOM-LISTP-FORWARD-TO-TRUE-LISTP)
@@ -828,12 +821,12 @@
                   (<= xn xl)
                   (<= yn yl))
              (equal (strnat<-aux x y xn yn xl yl)
-                    (charlistnat< (nthcdr xn (coerce x 'list))
-                                  (nthcdr yn (coerce y 'list)))))
+                    (charlistnat< (nthcdr xn (explode x))
+                                  (nthcdr yn (explode y)))))
     :hints(("Goal"
             :induct (strnat<-aux x y xn yn xl yl)
-            :expand ((charlistnat< (nthcdr xn (coerce x 'list))
-                                   (nthcdr yn (coerce y 'list)))
+            :expand ((charlistnat< (nthcdr xn (explode x))
+                                   (nthcdr yn (explode y)))
                      (:free (xl yl) (strnat<-aux x y xn yn xl yl)))
             :in-theory (e/d (charlistnat<
                              commutativity-of-+
@@ -863,12 +856,9 @@
 pretty fast.</p>"
 
   (definlined strnat< (x y)
-    (declare (type string x)
-             (type string y))
+    (declare (type string x y))
     (mbe :logic
-         (charlistnat< (coerce x 'list)
-                       (coerce y 'list))
-
+         (charlistnat< (explode x) (explode y))
          :exec
          (strnat<-aux (the string x)
                       (the string y)
@@ -879,6 +869,9 @@
 
   (local (in-theory (enable strnat<)))
 
+  (defcong streqv equal (strnat< x y) 1)
+  (defcong streqv equal (strnat< x y) 2)
+
   (defthm strnat<-irreflexive
     (not (strnat< x x)))
 
@@ -896,61 +889,3 @@
                   (strnat< x y))
              (strnat< x z))))
 
-
-
-#||
-
-;; Using STP.
-
-(include-book ;; fool dependency scanner
- "top")
-
-(defn symnat< (sym1 sym2)
-  (STR::strnat< (safe-symbol-name sym1)
-                (safe-symbol-name sym2)))
-
-(defthm symnat<-transitive
-  (implies (and (symnat< x y)
-                (symnat< y z))
-           (symnat< x z)))
-
-(defsort :compare< symnat<
-         :prefix symnat<)
-
-:q
-
-(defparameter *prefixes* (list "foo" "bar" "baz" "a" "b" "c"))
-
-(defparameter *test-strings*
-  (let ((plen (length *prefixes*)))
-    (loop for i from 1 to 10000 collect
-          (concatenate 'string
-                       (nth (mod i plen) *prefixes*)
-                       "-"
-                       (coerce (explode-atom i 10) 'string)
-                       "-suff"))))
-
-(defparameter *test-syms*
-  (loop for str in *test-strings* collect (intern str "ACL2")))
-
-(plev-max)
-(take 30 *test-syms*)
-
-(equal (symnat<-sort *test-syms*)
-       (symsort *test-syms*))
-
-;; 3.308 seconds, 198,769,472 bytes allocated
-(progn
-  (ccl::gc)
-  (time (loop for i fixnum from 1 to 100 do
-              (symnat<-sort *test-syms*)))
-  nil)
-
-;; 85.062 seconds, 11,405,636,416 bytes allocated
-(progn
-  (ccl::gc)
-  (time (loop for i fixnum from 1 to 100 do
-              (symsort *test-syms*)))
-  nil)
-
-||#
diff -Nru acl2-6.2/books/str/strpos.lisp acl2-6.3/books/str/strpos.lisp
--- acl2-6.2/books/str/strpos.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strpos.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -43,8 +43,8 @@
                                 (= xl (length x))
                                 (= yl (length y)))
                     :measure (nfix (- (nfix yl) (nfix n)))))
-    (cond ((mbe :logic (prefixp (coerce x 'list)
-                                (nthcdr n (coerce y 'list)))
+    (cond ((mbe :logic (prefixp (explode x)
+                                (nthcdr n (explode y)))
                 :exec (strprefixp-impl (the string x)
                                        (the string y)
                                        (the integer 0)
@@ -77,8 +77,8 @@
                   (force (equal xl (length x)))
                   (force (equal yl (length y))))
              (equal (strpos-fast x y n xl yl)
-                    (let ((idx (listpos (coerce x 'list)
-                                        (nthcdr n (coerce y 'list)))))
+                    (let ((idx (listpos (explode x)
+                                        (nthcdr n (explode y)))))
                       (and idx
                            (+ n idx)))))
     :hints(("Goal"
@@ -106,16 +106,17 @@
 string.  That is, @('(strpos \"\" x)') is 0 for all @('x').</p>"
 
   (definline strpos (x y)
-    (declare (type string x)
-             (type string y))
+    (declare (type string x y))
     (mbe :logic
-         (listpos (coerce x 'list)
-                  (coerce y 'list))
+         (listpos (explode x)
+                  (explode y))
          :exec
          (strpos-fast (the string x)
                       (the string y)
                       (the integer 0)
                       (the integer (length (the string x)))
-                      (the integer (length (the string y)))))))
+                      (the integer (length (the string y))))))
 
+  (defcong streqv equal (strpos x y) 1)
+  (defcong streqv equal (strpos x y) 2))
 
diff -Nru acl2-6.2/books/str/strprefixp.lisp acl2-6.3/books/str/strprefixp.lisp
--- acl2-6.2/books/str/strprefixp.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strprefixp.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -19,10 +19,9 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (in-package "STR")
-(include-book "misc/definline" :dir :system)
-(include-book "xdoc/top" :dir :system)
+(include-book "eqv")
 (include-book "std/lists/prefixp" :dir :system)
-(include-book "std/lists/nthcdr" :dir :system)
+(local (include-book "std/lists/nthcdr" :dir :system))
 (local (include-book "arithmetic"))
 
 (local (defthm prefixp-lemma-1
@@ -100,8 +99,8 @@
                   (force (<= xn xl))
                   (force (<= yn yl)))
              (equal (strprefixp-impl x y xn yn xl yl)
-                    (prefixp (nthcdr xn (coerce x 'list))
-                             (nthcdr yn (coerce y 'list)))))))
+                    (prefixp (nthcdr xn (explode x))
+                             (nthcdr yn (explode y)))))))
 
 (defsection strprefixp
   :parents (substrings)
@@ -113,7 +112,7 @@
 <p>Logically, this is identical to</p>
 
 @({
- (prefixp (coerce x 'list) (coerce y 'list))
+ (prefixp (explode x) (explode y))
 })
 
 <p>But we use a more efficient implementation which avoids coercing the strings
@@ -122,11 +121,14 @@
   (definline strprefixp (x y)
     (declare (type string x)
              (type string y))
-    (mbe :logic (prefixp (coerce x 'list)
-                         (coerce y 'list))
+    (mbe :logic (prefixp (explode x)
+                         (explode y))
          :exec (strprefixp-impl (the string x)
                                 (the string y)
                                 (the integer 0)
                                 (the integer 0)
                                 (the integer (length (the string x)))
-                                (the integer (length (the string y)))))))
+                                (the integer (length (the string y))))))
+
+  (defcong streqv equal (strprefixp x y) 1)
+  (defcong streqv equal (strprefixp x y) 2))
diff -Nru acl2-6.2/books/str/strrpos.lisp acl2-6.3/books/str/strrpos.lisp
--- acl2-6.2/books/str/strrpos.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strrpos.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -22,16 +22,16 @@
 (include-book "strprefixp")
 (local (include-book "arithmetic"))
 
+; BOZO should probably rewrite this to have a nice listrpos function sort of
+; thing.
+
 (defsection strrpos-fast
   :parents (strrpos)
   :short "Fast implementation of @(see strrpos)."
 
   (defund strrpos-fast (x y n xl yl)
-    (declare (type string x)
-             (type string y)
-             (type integer n)
-             (type integer xl)
-             (type integer yl)
+    (declare (type string x y)
+             (type (integer 0 *) n xl yl)
              (xargs :guard (and (stringp x)
                                 (stringp y)
                                 (natp xl)
@@ -42,23 +42,23 @@
                                 (= yl (length y)))
                     :measure (nfix n)))
     ;; N goes from YL to 0.
-    (cond ((mbe :logic (prefixp (coerce x 'list)
-                                (nthcdr n (coerce y 'list)))
+    (cond ((mbe :logic (prefixp (explode x)
+                                (nthcdr n (explode y)))
                 :exec (strprefixp-impl (the string x)
                                        (the string y)
                                        (the integer 0)
-                                       (the integer n)
-                                       (the integer xl)
-                                       (the integer yl)))
+                                       (the (integer 0 *) n)
+                                       (the (integer 0 *) xl)
+                                       (the (integer 0 *) yl)))
            (lnfix n))
           ((zp n)
            nil)
           (t
            (strrpos-fast (the string x)
                          (the string y)
-                         (+ -1 (lnfix n))
-                         (the integer xl)
-                         (the integer yl)))))
+                         (the (integer 0 *) (+ -1 (lnfix n)))
+                         (the (integer 0 *) xl)
+                         (the (integer 0 *) yl)))))
 
   (local (in-theory (enable strrpos-fast)))
 
@@ -74,7 +74,7 @@
     :rule-classes :linear)
 
   (defthm strrpos-fast-when-empty
-    (implies (and (not (consp (coerce x 'list)))
+    (implies (and (not (consp (explode x)))
                   (equal xl (length x))
                   (equal yl (length y))
                   (natp n))
@@ -100,15 +100,14 @@
 @('x').</p>"
 
   (definlined strrpos (x y)
-    (declare (type string x)
-             (type string y))
+    (declare (type string x y))
     (let ((yl (length (the string y))))
-      (declare (type integer yl))
+      (declare (type (integer 0 *) yl))
       (strrpos-fast (the string x)
                     (the string y)
-                    yl
-                    (the integer (length (the string x)))
-                    yl)))
+                    (the (integer 0 *) yl)
+                    (the (integer 0 *) (length (the string x)))
+                    (the (integer 0 *) yl))))
 
   (local (in-theory (enable strrpos strrpos-fast)))
 
@@ -130,24 +129,24 @@
                            (= xl (length x))
                            (= yl (length y))
                            (strrpos-fast x y n xl yl))
-                      (prefixp (coerce x 'list)
+                      (prefixp (explode x)
                                (nthcdr (strrpos-fast x y n xl yl)
-                                       (coerce y 'list))))
+                                       (explode y))))
              :hints(("Goal" :induct (strrpos-fast x y n xl yl)))))
 
     (defthm prefixp-of-strrpos
       (implies (and (strrpos x y)
                     (force (stringp x))
                     (force (stringp y)))
-               (prefixp (coerce x 'list)
-                        (nthcdr (strrpos x y) (coerce y 'list))))))
+               (prefixp (explode x)
+                        (nthcdr (strrpos x y) (explode y))))))
 
   (encapsulate
     ()
     (local (defun my-induction (x y n m xl yl)
              (declare (xargs :measure (nfix n)))
-             (cond ((prefixp (coerce x 'list)
-                             (nthcdr n (coerce y 'list)))
+             (cond ((prefixp (explode x)
+                             (nthcdr n (explode y)))
                     nil)
                    ((zp n)
                     (list x y n m xl yl))
@@ -170,8 +169,8 @@
                            (<= n (length y))
                            (= xl (length x))
                            (= yl (length y))
-                           (prefixp (coerce x 'list)
-                                    (nthcdr m (coerce y 'list))))
+                           (prefixp (explode x)
+                                    (nthcdr m (explode y))))
                       (and (natp (strrpos-fast x y n xl yl))
                            (>= (strrpos-fast x y n xl yl) m)))
              :hints(("Goal"
@@ -179,8 +178,8 @@
                      :do-not '(generalize fertilize)))))
 
     (defthm completeness-of-strrpos
-      (implies (and (prefixp (coerce x 'list)
-                             (nthcdr m (coerce y 'list)))
+      (implies (and (prefixp (explode x)
+                             (nthcdr m (explode y)))
                     (<= m (len y))
                     (force (natp m))
                     (force (stringp x))
@@ -193,7 +192,7 @@
     (implies (and (force (stringp x))
                   (force (stringp y)))
              (<= (strrpos x y)
-                 (len (coerce y 'list))))
+                 (len (explode y))))
     :rule-classes ((:rewrite) (:linear)))
 
   (encapsulate
@@ -217,7 +216,7 @@
                     (force (stringp x))
                     (force (stringp y)))
                (< (strrpos x y)
-                  (len (coerce y 'list))))
+                  (len (explode y))))
       :rule-classes ((:rewrite) (:linear)))))
 
 
diff -Nru acl2-6.2/books/str/strsplit.lisp acl2-6.3/books/str/strsplit.lisp
--- acl2-6.2/books/str/strsplit.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strsplit.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
diff -Nru acl2-6.2/books/str/strsubst.lisp acl2-6.3/books/str/strsubst.lisp
--- acl2-6.2/books/str/strsubst.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strsubst.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -30,12 +30,8 @@
   :short "Fast implementation of @(see strsubst)."
 
   (defund strsubst-aux (old new x n xl oldl acc)
-    (declare (type string old)
-             (type string new)
-             (type string x)
-             (type integer n)
-             (type integer xl)
-             (type integer oldl)
+    (declare (type string old new x)
+             (type (integer 0 *) n xl oldl)
              (xargs :guard (and (stringp old)
                                 (stringp new)
                                 (stringp x)
@@ -55,11 +51,17 @@
 
           ((strprefixp-impl old x 0 n oldl xl)
            (let ((acc (revappend-chars new acc)))
-             (strsubst-aux old new x (+ oldl (lnfix n)) xl oldl acc)))
+             (strsubst-aux old new x
+                           (the (integer 0 *)
+                             (+ oldl (the (integer 0 *) (lnfix n))))
+                           xl oldl acc)))
 
           (t
            (let ((acc (cons (char x n) acc)))
-             (strsubst-aux old new x (+ 1 (lnfix n)) xl oldl acc)))))
+             (strsubst-aux old new x
+                           (the (integer 0 *)
+                             (+ 1 (the (integer 0 *) (lnfix n))))
+                           xl oldl acc)))))
 
   (local (in-theory (enable strsubst-aux)))
 
@@ -87,11 +89,11 @@
 <p>Examples:</p>
 @({
  (strsubst \"World\" \"Star\" \"Hello, World!\")
-   --&gt;
+   -->
  \"Hello, Star!\"
 
  (strsubst \"oo\" \"aa\" \"xoooyoo\")
-   --&gt;
+   -->
  \"xaaoyaa\"
 })
 
@@ -105,11 +107,10 @@
     (declare (xargs :guard (and (stringp old)
                                 (stringp new)
                                 (stringp x))))
-    (let ((oldl (length old)))
+    (let ((oldl (mbe :logic (len (explode old))
+                     :exec (length old))))
       (if (zp oldl)
-          (mbe :logic (if (stringp x)
-                          x
-                        "")
+          (mbe :logic (str-fix x)
                :exec x)
         (rchars-to-string (strsubst-aux old new x 0 (length x) oldl nil)))))
 
@@ -127,7 +128,6 @@
 
 
 
-
 (defsection strsubst-list
   :parents (substitution)
   :short "Carry out a @(see strsubst) replacement throughout a list of strings."
@@ -141,7 +141,7 @@
  (strsubst-list \"Sun\"
                 \"Moon\"
                 '(\"Sun Roof\" \"Hello Sun\" \"Sunny Sunshades\"))
-   --&gt;
+   -->
  (\"Moon Roof\" \"Hello Moon\" \"Moonny Moonshades\")
 })"
 
diff -Nru acl2-6.2/books/str/strtok.lisp acl2-6.3/books/str/strtok.lisp
--- acl2-6.2/books/str/strtok.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strtok.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -20,6 +20,7 @@
 
 (in-package "STR")
 (include-book "cat")
+(include-book "eqv")
 (local (include-book "misc/assert" :dir :system))
 (local (include-book "arithmetic"))
 (local (include-book "std/lists/revappend" :dir :system))
@@ -35,8 +36,7 @@
     ;; curr is the current word we're accumulating in reverse order
     ;; acc is the string list of previously found words
     (declare (type string x)
-             (type integer n)
-             (type integer xl)
+             (type (integer 0 *) n xl)
              (xargs :guard (and (stringp x)
                                 (natp xl)
                                 (natp n)
@@ -54,7 +54,7 @@
       (let* ((char1  (char x n))
              (matchp (member char1 delimiters)))
         (strtok-aux (the string x)
-                    (+ 1 (lnfix n))
+                    (the (integer 0 *) (+ 1 (lnfix n)))
                     (the integer xl)
                     delimiters
                     (if matchp nil (cons char1 curr))
@@ -70,14 +70,11 @@
     :hints(("Goal" :induct (strtok-aux x n xl delimiters curr acc))))
 
   (defthm string-listp-of-strtok-aux
-    (implies (and (stringp x)
-                  (natp xl)
-                  (natp n)
-                  (= xl (length x))
-                  (<= n xl)
-                  (string-listp acc))
+    (implies (string-listp acc)
              (string-listp (strtok-aux x n xl delimiters curr acc)))
-    :hints(("Goal" :induct (strtok-aux x n xl delimiters curr acc)))))
+    :hints(("Goal" :induct (strtok-aux x n xl delimiters curr acc))))
+
+  (defcong streqv equal (strtok-aux x n xl delimiters curr acc) 1))
 
 
 
@@ -93,7 +90,7 @@
 
 @({
  (strtok \"foo bar, baz!\" (list #\\Space #\\, #\\!))
-   --&gt;
+   -->
  (\"foo\" \"bar\" \"baz\")
 })
 
@@ -103,22 +100,25 @@
   (definlined strtok (x delimiters)
     (declare (xargs :guard (and (stringp x)
                                 (character-listp delimiters))))
-    (reverse (strtok-aux x 0 (length x) delimiters nil nil)))
+    ;; Two tricks.
+    ;;  - Use REV for better type-prescription
+    ;;  - Use LEN of EXPLODE for better congruence
+    (let ((rtokens (strtok-aux x 0 (mbe :logic (len (explode x))
+                                        :exec (length x))
+                               delimiters nil nil)))
+      (mbe :logic (rev rtokens)
+           :exec (reverse rtokens))))
 
   (local (in-theory (enable strtok)))
 
-  (defthm true-listp-of-strtok
-    (true-listp (strtok x delimiters))
-    :rule-classes :type-prescription)
-
   (local (defthm lemma
            (implies (string-listp x)
                     (string-listp (acl2::rev x)))))
 
-
   (defthm string-listp-of-strtok
-    (implies (force (stringp x))
-             (string-listp (strtok x delimiters))))
+    (string-listp (strtok x delimiters)))
+
+  (defcong streqv equal (strtok x delimiters) 1)
 
   (local
    (acl2::assert!
@@ -126,7 +126,7 @@
 baz,
  heyo,
     beyo"
-                (list #\Space #\, #\Newline))
+                   (list #\Space #\, #\Newline))
            (list "foo" "bar" "baz" "heyo" "beyo")))))
 
 
diff -Nru acl2-6.2/books/str/strval.lisp acl2-6.3/books/str/strval.lisp
--- acl2-6.2/books/str/strval.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/strval.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -20,7 +20,6 @@
 
 (in-package "STR")
 (include-book "strnatless")
-(include-book "misc/definline" :dir :system)
 (local (include-book "arithmetic"))
 (local (include-book "misc/assert" :dir :system))
 
@@ -39,10 +38,18 @@
       (and (<= (char-code #\0) code)
            (<= code (char-code #\7)))))
 
+  (local (in-theory (enable octal-digitp)))
+
+  (defcong ichareqv equal (octal-digitp x) 1
+    :hints(("Goal" :in-theory (enable octal-digitp
+                                      ichareqv
+                                      downcase-char
+                                      char-fix))))
+
   (defthm digitp-when-octal-digitp
     (implies (octal-digitp x)
              (digitp x))
-    :hints(("Goal" :in-theory (enable octal-digitp digitp)))))
+    :hints(("Goal" :in-theory (enable digitp)))))
 
 
 (defsection octal-digit-listp
@@ -56,10 +63,16 @@
       (and (octal-digitp (car x))
            (octal-digit-listp (cdr x)))))
 
+  (local (in-theory (enable octal-digit-listp)))
+
   (defthm digit-listp-when-octal-digit-listp
     (implies (octal-digit-listp x)
              (digit-listp x))
-    :hints(("Goal" :in-theory (enable digit-listp octal-digit-listp)))))
+    :hints(("Goal" :in-theory (enable digit-listp))))
+
+  (defcong icharlisteqv equal (octal-digit-listp x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv)))))
+
 
 
 (defsection parse-octal-from-charlist
@@ -69,8 +82,7 @@
 digits and returns their octal value.</p>"
 
   (defund parse-octal-from-charlist (x val len)
-    (declare (type integer val)
-             (type integer len)
+    (declare (type (integer 0 *) val len)
              (xargs :guard (and (character-listp x)
                                 (natp val)
                                 (natp len))))
@@ -84,11 +96,12 @@
           (t
            (mv (lnfix val) (lnfix len) x))))
 
+  (local (in-theory (enable parse-octal-from-charlist)))
+
   (defthm natp-of-parse-octal-from-charlist
     (implies (natp val)
              (natp (mv-nth 0 (parse-octal-from-charlist x val len))))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable parse-octal-from-charlist)))))
+    :rule-classes :type-prescription))
 
 
 (defsection octal-digit-list-value
@@ -107,10 +120,21 @@
           (parse-octal-from-charlist x 0 0)))
       val))
 
+  (local (in-theory (enable octal-digit-list-value)))
+
   (defthm natp-of-octal-digit-list-value
     (natp (octal-digit-list-value x))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable octal-digit-list-value))))
+    :rule-classes :type-prescription)
+
+  (local (defthmd l0
+           (implies (icharlisteqv x x-equiv)
+                    (equal (mv-nth 0 (parse-octal-from-charlist x val len))
+                           (mv-nth 0 (parse-octal-from-charlist x-equiv val len))))
+           :hints(("Goal" :in-theory (enable parse-octal-from-charlist
+                                             icharlisteqv)))))
+
+  (defcong icharlisteqv equal (octal-digit-list-value x) 1
+    :hints(("Goal" :use ((:instance l0 (val 0) (len 0))))))
 
   (local (assert! (and (equal (octal-digit-list-value (coerce "0" 'list)) #o0)
                        (equal (octal-digit-list-value (coerce "6" 'list)) #o6)
@@ -134,7 +158,16 @@
           (and (<= (char-code #\a) code)
                (<= code (char-code #\f)))
           (and (<= (char-code #\A) code)
-               (<= code (char-code #\F)))))))
+               (<= code (char-code #\F))))))
+
+  (local (in-theory (enable hex-digitp)))
+
+  (defcong ichareqv equal (hex-digitp x) 1
+    :hints(("Goal" :in-theory (enable hex-digitp
+                                      ichareqv
+                                      downcase-char
+                                      char-fix)))))
+
 
 (defsection hex-digit-listp
   :parents (numbers)
@@ -145,7 +178,13 @@
     (if (atom x)
         t
       (and (hex-digitp (car x))
-           (hex-digit-listp (cdr x))))))
+           (hex-digit-listp (cdr x)))))
+
+  (local (in-theory (enable hex-digit-listp)))
+
+  (defcong icharlisteqv equal (hex-digit-listp x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv)))))
+
 
 (defsection hex-digit-val
   :parents (numbers)
@@ -166,10 +205,16 @@
               ((<= (char-code #\A) code) (- code (- (char-code #\A) 10)))
               (t                         (- code (char-code #\0)))))))
 
+  (local (in-theory (enable hex-digit-val hex-digitp)))
+
   (defthm natp-of-hex-digit-val
     (natp (hex-digit-val x))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable hex-digitp hex-digit-val))))
+    :rule-classes :type-prescription)
+
+  (defcong ichareqv equal (hex-digit-val x) 1
+    :hints(("Goal" :in-theory (enable ichareqv
+                                      downcase-char
+                                      char-fix))))
 
   (local (assert! (and (equal (hex-digit-val #\A) #xA)
                        (equal (hex-digit-val #\B) #xB)
@@ -201,8 +246,7 @@
 hex digits and returns their hexadecimal value.</p>"
 
   (defund parse-hex-from-charlist (x val len)
-    (declare (type integer val)
-             (type integer len)
+    (declare (type (integer 0 *) val len)
              (xargs :guard (and (character-listp x)
                                 (natp val)
                                 (natp len))))
@@ -210,17 +254,22 @@
            (mv (lnfix val) (lnfix len) nil))
           ((hex-digitp (car x))
            (let ((digit-val (hex-digit-val (car x))))
-             (parse-hex-from-charlist (cdr x)
-                                      (+ digit-val (* 16 (lnfix val)))
-                                      (+ 1 (lnfix len)))))
+             (parse-hex-from-charlist
+              (cdr x)
+              (the (integer 0 *) (+ (the (integer 0 *) digit-val)
+                                    (the (integer 0 *)
+                                      (* 16 (the (integer 0 *) (lnfix val))))))
+              (the (integer 0 *) (+ 1 (the (integer 0 *) (lnfix len)))))))
           (t
            (mv (lnfix val) (lnfix len) x))))
 
+  (local (in-theory (enable parse-hex-from-charlist)))
+
   (defthm natp-of-parse-hex-from-charlist
     (implies (natp val)
              (natp (mv-nth 0 (parse-hex-from-charlist x val len))))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable parse-hex-from-charlist)))))
+    :rule-classes :type-prescription))
+
 
 (defsection hex-digit-list-value
   :parents (numbers)
@@ -238,10 +287,21 @@
           (parse-hex-from-charlist x 0 0)))
       val))
 
+  (local (in-theory (enable hex-digit-list-value)))
+
   (defthm natp-of-hex-digit-list-value
     (natp (hex-digit-list-value x))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable hex-digit-list-value))))
+    :rule-classes :type-prescription)
+
+  (local (defthmd l0
+           (implies (icharlisteqv x x-equiv)
+                    (equal (mv-nth 0 (parse-hex-from-charlist x val len))
+                           (mv-nth 0 (parse-hex-from-charlist x-equiv val len))))
+           :hints(("Goal" :in-theory (enable parse-hex-from-charlist
+                                             icharlisteqv)))))
+
+  (defcong icharlisteqv equal (hex-digit-list-value x) 1
+    :hints(("Goal" :use ((:instance l0 (val 0) (len 0))))))
 
   (local (assert! (and (equal (hex-digit-list-value (coerce "0" 'list)) #x0)
                        (equal (hex-digit-list-value (coerce "6" 'list)) #x6)
@@ -257,7 +317,15 @@
   (definlined bit-digitp (x)
     (declare (xargs :guard t))
     (or (eql x #\0)
-        (eql x #\1))))
+        (eql x #\1)))
+
+  (local (in-theory (enable bit-digitp)))
+
+  (defcong ichareqv equal (bit-digitp x) 1
+    :hints(("Goal" :in-theory (enable ichareqv
+                                      downcase-char
+                                      char-fix)))))
+
 
 (defsection bit-digit-listp
   :parents (numbers)
@@ -268,7 +336,14 @@
     (if (atom x)
         t
       (and (bit-digitp (car x))
-           (bit-digit-listp (cdr x))))))
+           (bit-digit-listp (cdr x)))))
+
+  (local (in-theory (enable bit-digit-listp)))
+
+  (defcong icharlisteqv equal (bit-digit-listp x) 1
+    :hints(("Goal" :in-theory (enable icharlisteqv)))))
+
+
 
 (defsection bitstring-p
   :parents (numbers)
@@ -277,8 +352,12 @@
   (defund bitstring-p (x)
     (declare (xargs :guard t))
     ;; BOZO make a faster version of this
+    ;; BOZO requiring stringp is bad for congruences
     (and (stringp x)
-         (bit-digit-listp (coerce x 'list)))))
+         (bit-digit-listp (explode x))))
+
+  (local (in-theory (enable bitstring-p))))
+
 
 (defsection parse-bits-from-charlist
   :parents (numbers)
@@ -287,8 +366,7 @@
 digits (#\\0 and #\\1) and returns their binary value.</p>"
 
   (defund parse-bits-from-charlist (x val len)
-    (declare (type integer val)
-             (type integer len)
+    (declare (type (integer 0 *) val len)
              (xargs :guard (and (character-listp x)
                                 (natp val)
                                 (natp len))))
@@ -297,21 +375,27 @@
           ((eql (car x) #\0)
            (parse-bits-from-charlist
             (cdr x)
-            (mbe :logic (* 2 (nfix val)) :exec (ash val 1))
-            (+ 1 (lnfix len))))
+            (mbe :logic (* 2 (nfix val))
+                 :exec (the (integer 0 *) (ash val 1)))
+            (the (integer 0 *) (+ 1 (the (integer 0 *) (lnfix len))))))
           ((eql (car x) #\1)
            (parse-bits-from-charlist
             (cdr x)
-            (+ 1 (mbe :logic (* 2 (nfix val)) :exec (ash val 1)))
-            (+ 1 (lnfix len))))
+            (the (integer 0 *)
+              (+ 1
+                 (mbe :logic (* 2 (nfix val))
+                      :exec (the (integer 0 *) (ash val 1)))))
+            (the (integer 0 *) (+ 1 (the (integer 0 *) (lnfix len))))))
           (t
            (mv (lnfix val) (lnfix len) x))))
 
+  (local (in-theory (enable parse-bits-from-charlist)))
+
   (defthm natp-of-parse-bits-from-charlist
     (implies (natp val)
              (natp (mv-nth 0 (parse-bits-from-charlist x val len))))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable parse-bits-from-charlist)))))
+    :rule-classes :type-prescription))
+
 
 (defsection bit-digit-list-value
   :parents (numbers)
@@ -329,10 +413,24 @@
           (parse-bits-from-charlist x 0 0)))
       val))
 
+  (local (in-theory (enable bit-digit-list-value)))
+
   (defthm natp-of-bit-digit-list-value
     (natp (bit-digit-list-value x))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable bit-digit-list-value))))
+    :rule-classes :type-prescription)
+
+  (local (defthmd l0
+           (implies (icharlisteqv x x-equiv)
+                    (equal (mv-nth 0 (parse-bits-from-charlist x val len))
+                           (mv-nth 0 (parse-bits-from-charlist x-equiv val len))))
+           :hints(("Goal" :in-theory (enable parse-bits-from-charlist
+                                             icharlisteqv
+                                             ichareqv
+                                             downcase-char
+                                             char-fix)))))
+
+  (defcong icharlisteqv equal (bit-digit-list-value x) 1
+    :hints(("Goal" :use ((:instance l0 (val 0) (len 0))))))
 
   (local (assert! (and (equal (bit-digit-list-value (coerce "0" 'list)) #b0)
                        (equal (bit-digit-list-value (coerce "1" 'list)) #b1)
@@ -354,20 +452,27 @@
 number.  For example, @('(strval \"35\")') is 35.  If the string has any
 non-decimal digit characters or is empty, we return @('nil').</p>"
 
-  (definlined strval (x)
+  (defund strval (x)
     (declare (type string x))
-    (b* ((xl (length x))
-         ((mv val len)
+    (b* (((the (integer 0 *) xl)
+          (mbe :logic (len (explode x))
+               :exec (length x)))
+         ((mv (the (integer 0 *) val)
+              (the (integer 0 *) len))
           (str::parse-nat-from-string x 0 0 0 xl)))
       (and (< 0 len)
            (int= len xl)
            val)))
 
+  (local (in-theory (enable strval)))
+
   (defthm type-of-strval
     (or (natp (strval x))
         (not (strval x)))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable strval)))))
+    :rule-classes :type-prescription)
+
+  (defcong istreqv equal (strval x) 1))
+
 
 (defsection strval8
   :parents (numbers)
@@ -376,18 +481,22 @@
 decimal numbers.  For example, @('(strval8 \"10\")') is 8.  If the string is
 empty or has any non-octal digit characters, we return @('nil').</p>"
 
-  (definlined strval8 (x)
+  (defund strval8 (x)
     (declare (type string x))
-    (let ((chars (coerce x 'list)))
+    (let ((chars (explode x)))
       (and (consp chars)
            (octal-digit-listp chars)
            (octal-digit-list-value chars))))
 
+  (local (in-theory (enable strval8)))
+
   (defthm type-of-strval8
     (or (natp (strval8 x))
         (not (strval8 x)))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable strval8)))))
+    :rule-classes :type-prescription)
+
+  (defcong istreqv equal (strval8 x) 1))
+
 
 (defsection strval16
   :parents (numbers)
@@ -396,18 +505,22 @@
 of decimal numbers.  For example, @('(strval16 \"10\")') is 16.  If the string
 is empty or has any non-hex digit characters, we return @('nil').</p>"
 
-  (definlined strval16 (x)
+  (defund strval16 (x)
     (declare (type string x))
-    (let ((chars (coerce x 'list)))
+    (let ((chars (explode x)))
       (and (consp chars)
            (hex-digit-listp chars)
            (hex-digit-list-value chars))))
 
+  (local (in-theory (enable strval16)))
+
   (defthm type-of-strval16
     (or (natp (strval16 x))
         (not (strval16 x)))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable strval16)))))
+    :rule-classes :type-prescription)
+
+  (defcong istreqv equal (strval16 x) 1))
+
 
 (defsection strval2
   :parents (numbers)
@@ -416,18 +529,22 @@
 decimal numbers.  For example, @('(strval16 \"10\")') is 2.  If the string is
 empty or has any non-binary digit characters, we return @('nil').</p>"
 
-  (definlined strval2 (x)
+  (defund strval2 (x)
     (declare (type string x))
-    (let ((chars (coerce x 'list)))
+    (let ((chars (explode x)))
       (and (consp chars)
            (bit-digit-listp chars)
            (bit-digit-list-value chars))))
 
+  (local (in-theory (enable strval2)))
+
   (defthm type-of-strval2
     (or (natp (strval2 x))
         (not (strval2 x)))
-    :rule-classes :type-prescription
-    :hints(("Goal" :in-theory (enable strval2)))))
+    :rule-classes :type-prescription)
+
+  (defcong istreqv equal (strval2 x) 1))
+
 
 
 (local (assert! (equal (strval "") nil)))
diff -Nru acl2-6.2/books/str/subseq.lisp acl2-6.3/books/str/subseq.lisp
--- acl2-6.2/books/str/subseq.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/subseq.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -25,7 +25,7 @@
 (local (include-book "arithmetic"))
 (local (include-book "std/lists/take" :dir :system))
 (local (include-book "std/lists/nthcdr" :dir :system))
-(local (include-book "std/lists/coerce" :dir :system))
+(local (include-book "coerce"))
 
 ;; NOTE: These get globally disabled by including this book!  This is probably
 ;; how things ought to be.
diff -Nru acl2-6.2/books/str/substrp.lisp acl2-6.3/books/str/substrp.lisp
--- acl2-6.2/books/str/substrp.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/substrp.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -33,10 +33,12 @@
 or @(see strrpos) for alternatives that say where a match occurs.</p>"
 
   (definline substrp (x y)
-    (declare (type string x)
-             (type string y))
-    (mbe :logic (sublistp (coerce x 'list)
-                          (coerce y 'list))
+    (declare (type string x y))
+    (mbe :logic (sublistp (explode x) (explode y))
          :exec (if (strpos x y)
                    t
-                 nil))))
+                 nil)))
+
+  (defcong streqv equal (substrp x y) 1)
+  (defcong streqv equal (substrp x y) 2))
+
diff -Nru acl2-6.2/books/str/suffixp.lisp acl2-6.3/books/str/suffixp.lisp
--- acl2-6.2/books/str/suffixp.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/suffixp.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -20,8 +20,9 @@
 
 (in-package "STR")
 (include-book "strprefixp")
+(local (include-book "std/lists/nthcdr" :dir :system))
 (local (include-book "misc/assert" :dir :system))
-
+(local (include-book "arithmetic/top" :dir :system))
 (local (in-theory (disable acl2::prefixp-when-equal-lengths)))
 
 (local (defthm crock
@@ -32,13 +33,6 @@
                          (equal x y)))
          :hints(("Goal" :in-theory (enable prefixp)))))
 
-(local (defthm len-of-nthcdr
-         (implies (and (natp n)
-                       (<= n (len x)))
-                  (equal (len (nthcdr n x))
-                         (- (len x) n)))
-         :hints(("Goal" :in-theory (enable nthcdr)))))
-
 (defsection strsuffixp
   :parents (substrings)
   :short "Case-sensitive string suffix test."
@@ -49,8 +43,8 @@
 <p>Logically, we ask whether @('|x| < |y|'), and whether</p>
 
 @({
-  (equal (nthcdr (- |y| |x|) (coerce x 'list))
-         (coerce y 'list)
+  (equal (nthcdr (- |y| |x|) (explode x))
+         (explode y))
 })
 
 <p>But we use a more efficient implementation that avoids coercing the strings
@@ -61,15 +55,21 @@
 That is, @('(strsuffixp \"\" x)') is always true.</p>"
 
   (definlined strsuffixp (x y)
-    (declare (xargs :guard (and (stringp x)
-                                (stringp y))))
-    (let* ((xlen (length x))
-           (ylen (length y)))
-      (and (<= xlen ylen)
-           (mbe :logic
-                (equal (nthcdr (- ylen xlen) (coerce y 'list))
-                       (coerce x 'list))
-                :exec
+    (declare (type string x y))
+    (mbe :logic
+         (let* ((xchars (explode x))
+                (ychars (explode y))
+                ;; note that using, e.g., (len (explode x)) instead of (length
+                ;; x)) gives better congruence behavior
+                (xlen   (len xchars))
+                (ylen   (len ychars)))
+           (and (<= xlen ylen)
+                (equal (nthcdr (- ylen xlen) (explode y))
+                       (explode x))))
+         :exec
+         (let* ((xlen (length x))
+                (ylen (length y)))
+           (and (<= xlen ylen)
                 (strprefixp-impl x y 0 (- ylen xlen) xlen ylen)))))
 
   (local (in-theory (enable strsuffixp)))
@@ -95,4 +95,9 @@
      (assert! (strsuffixp "oo" "foo"))
      (assert! (not (strsuffixp "ooo" "foo")))
      (assert! (not (strsuffixp "fo" "foo")))
-     (assert! (strsuffixp "foo" "foo")))))
+     (assert! (strsuffixp "foo" "foo"))))
+
+  (defcong streqv equal (strsuffixp x y) 1)
+  (defcong streqv equal (strsuffixp x y) 2))
+
+
diff -Nru acl2-6.2/books/str/symbols.lisp acl2-6.3/books/str/symbols.lisp
--- acl2-6.2/books/str/symbols.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/symbols.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -23,6 +23,7 @@
 (include-book "std/lists/list-defuns" :dir :system)
 (local (include-book "std/lists/equiv" :dir :system))
 (local (include-book "std/lists/rev" :dir :system))
+(local (include-book "std/lists/append" :dir :system))
 
 
 (defsection symbol-list-names
diff -Nru acl2-6.2/books/str/timetest.lsp acl2-6.3/books/str/timetest.lsp
--- acl2-6.2/books/str/timetest.lsp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/timetest.lsp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
diff -Nru acl2-6.2/books/str/top.lisp acl2-6.3/books/str/top.lisp
--- acl2-6.2/books/str/top.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/str/top.lisp	2013-09-30 17:52:16.000000000 +0000
@@ -1,5 +1,5 @@
 ; ACL2 String Library
-; Copyright (C) 2009-2010 Centaur Technology
+; Copyright (C) 2009-2013 Centaur Technology
 ;
 ; Contact:
 ;   Centaur Technology Formal Verification Group
@@ -74,7 +74,7 @@
 <h3>Copyright Information</h3>
 
 <p>ACL2 String Library<br/>
-Copyright (C) 2009-2011
+Copyright (C) 2009-2013
 <a href=\"http://www.centtech.com\">Centaur Technology</a>.</p>
 
 <p>Contact:</p>
@@ -103,11 +103,44 @@
 
 (defsection equivalences
   :parents (str)
-  :short "Basic equivalence relations.")
+  :short "Basic equivalence relations."
+
+  :long "<p>The string library provides the various @(see acl2::equivalence)
+relations about characters, character lists, and strings.  We end up with the
+following @(see acl2::refinement) hierarchy:</p>
+
+@({
+                      equal
+          ______________|________________
+         |              |                |
+       chareqv         list-equiv       streqv
+         |              |                |
+       ichareqv        charlisteqv      istreqv
+                        |
+                       icharlisteqv
+})")
 
 (defsection concatenation
   :parents (str)
-  :short "Functions for concatenating strings and character lists.")
+  :short "Functions for joining strings together.
+
+<p><b><color rgb='#ff0000'>Efficiency Warning</color></b>.  Concatenating
+strings in ACL2 is fundamentally slow.  Why?  In Common Lisp, strings are just
+arrays of characters, and there is not any mechanism for efficiently splicing
+together arrays.  Any kind of string concatenation, then, minimally requires
+creating a completely new array and copying all of the input characters into
+it.  This makes it especially slow to repeatedly use, e.g., @(see cat) to build
+up a string.</p>
+
+<p>To build strings more efficiently, a good general strategy is to build up a
+reverse-order character list, and then convert it into a string at the end.
+See for instance the functions @(see revappend-chars) and @(see
+rchars-to-string), which make this rather easy to do.</p>")
+
+(defsection coercion
+  :parents (str)
+  :short "Functions for converting between strings, symbols, character lists,
+and so on.")
 
 (defsection ordering
   :parents (str)
@@ -123,10 +156,10 @@
   :long "<p>See also @(see ordering) for some functions that can sort strings
 in alphanumeric ways.</p>")
 
-(defsection case-conversion
+(defsection cases
   :parents (str)
-  :short "Functions for recognizing upper- and lower-case characters,
-converting between cases, etc.")
+  :short "Functions for recognizing and translating between upper- and
+lower-case.")
 
 (defsection symbols
   :parents (str)
@@ -135,3 +168,18 @@
 (defsection substitution
   :parents (str)
   :short "Functions for doing string replacement.")
+
+(defsection lines
+  :parents (str)
+  :short "Functions for operating on the lines of a string."
+
+  :long "<p>Note that these functions generally work with Unix-style newline
+characters, i.e., @('\\n') instead of something like @('\\r\\n').  Depending on
+your application, this may or may not be appropriate.</p>
+
+<p>One option for treating a string as lines is to just use, e.g., @(see
+strtok) to literally split it into a list of lines.  The functions here are
+generally meant to be more efficient, e.g., @(see prefix-lines) can add a
+prefix to every line without constructing an temporary string list or doing any
+intermediate string concatenation.</p>")
+
diff -Nru acl2-6.2/books/system/compare-out-files.lisp acl2-6.3/books/system/compare-out-files.lisp
--- acl2-6.2/books/system/compare-out-files.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/compare-out-files.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,6 +1,8 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by J Strother Moore, February, 2013
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; A Utility for Comparing the .out Files Produced during Book Certification
-; J Strother Moore
-; February, 2013
 
 ; To recertify:
 ; (certify-book "compare-out-files")
diff -Nru acl2-6.2/books/system/convert-normalized-term-to-pairs.lisp acl2-6.3/books/system/convert-normalized-term-to-pairs.lisp
--- acl2-6.2/books/system/convert-normalized-term-to-pairs.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/convert-normalized-term-to-pairs.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,16 +1,6 @@
-; This program is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation; either version 2 of the License, or
-; (at your option) any later version.
-
-; This program is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this program; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by J Moore, April, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
 ; Written by:  J Moore
 ; email:       moore@cs.utexas.edu
@@ -18,8 +8,6 @@
 ; University of Texas at Austin
 ; Austin, TX 78701 U.S.A.
 
-; April, 2012
-
 (in-package "ACL2")
 
 (tau-status :system nil)
diff -Nru acl2-6.2/books/system/f-put-global.lisp acl2-6.3/books/system/f-put-global.lisp
--- acl2-6.2/books/system/f-put-global.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/f-put-global.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -70,7 +70,11 @@
            (state-p1 (put-global key val state)))
   :hints(("Goal" :in-theory (enable state-p1 state-p1-good-worldp))))
 
-(defthm assoc-equal-add-pair
+;; [Jared]: disabling the built-in ACL2 rule about assoc of add-pair because it
+;; has unnecessary hyps.
+(in-theory (disable assoc-add-pair))
+
+(defthm assoc-add-pair-better
   (equal (assoc-equal k1 (add-pair k2 v al))
          (if (equal k1 k2)
              (cons k2 v)
diff -Nru acl2-6.2/books/system/io.lisp acl2-6.3/books/system/io.lisp
--- acl2-6.2/books/system/io.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/io.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-(in-package "ACL2")
-
-(make-event
- (prog2$
-  (cw "Note from books/system/io.lisp, this book is deprecated.  Use ~
-       books/io/base.lisp instead")
-  '(value-triple :invisible))
- :check-expansion t)
-
-;; cert_param: (reloc_stub)
-(include-book "std/io/base" :dir :system)
diff -Nru acl2-6.2/books/system/origin.lisp acl2-6.3/books/system/origin.lisp
--- acl2-6.2/books/system/origin.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/origin.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -18,6 +18,8 @@
 ;
 ; Original authors: Jared Davis <jared@kookamara.com>
 
+; Modified by Matt Kaufmann 8/28/2013 to avoid command world errors.
+
 (in-package "ACL2")
 (include-book "xdoc/top" :dir :system)
 (set-state-ok t)
@@ -30,11 +32,9 @@
 @({
   (include-book \"system/origin\" :dir :system)
 
-  ;; certain built-in commands don't have a command number
-  (origin 'consp)    --> (value (:built-in nil))
-
-  ;; other built-in ACL2 commands have command numbers
-  (origin 'car-cons) --> (value (:built-in -936))
+  ;; built-in names get a return value of :built-in
+  (origin 'consp)    --> (value :built-in)
+  (origin 'car-cons) --> (value :built-in)
 
   ;; include-book path is reported for events included from other books
   (origin 'xdoc::save) --> (value (\"/home/jared/acl2/books/system/origin.lisp\"
@@ -46,46 +46,31 @@
 
   ;; some definitions are from the current session, e.g.:
   (defun f (x) x)
-  (origin 'f)     --> (value 3)
+  (origin 'f)     --> (value :TOP-LEVEL)
 
-})")
+  ;; bad names
+  (mv-let (er val state)               ;; ((:er (\"Not a logical name: ~x0\"
+          (origin 'not-defined-thing)  ;;        (#\0 . NOT-DEFINED-THING))
+   (mv (list :er er :val val)          ;;   :val nil)
+       state))                         ;;  <state>)
 
+})")
 
-(defun origin-fn1 (wrld ev-wrld cmd-wrld)
-  ;; Styled after PE-FN1.  I have no idea what I'm doing.
-  (cond
-   ((equal (access-event-tuple-form (cddar ev-wrld))
-           (access-command-tuple-form (cddar cmd-wrld)))
-    ;; This handles two kinds of things:
-    ;;  (1) built-in things with a defining event, and
-    ;;  (2) things from the current session (not an include-book)
-    ;; :pe-fn1 would do a print-ldd of a make-command-ldd here, which, if you work out
-    ;; the cases, seems to be just doing this:
-    (absolute-to-relative-command-number
-     (access-command-tuple-number (cddar cmd-wrld))
-     wrld))
-   (t
-    (let ((book-path (global-val 'include-book-path ev-wrld)))
-      (cond (book-path
-             (reverse book-path))
-            (t
-             :session?))))))
-
-(defun origin-fn (logical-name ctx state)
-  ;; Styled after PE-FN.  I have no idea what I'm doing.
-  (let ((wrld (w state)))
+(defun origin-fn (logical-name state)
+  (let* ((wrld (w state)))
     (cond
-     ((and (symbolp logical-name)
-           (not (eq logical-name :here))
-           (zp (getprop logical-name 'absolute-event-number nil 'current-acl2-world wrld)))
-      ;; Things that are built into ACL2 without a defining event
-      (value (list :built-in nil)))
+     ((acl2-system-namep logical-name wrld)
+      (value :built-in))
      (t
-      (er-let*
-       ((ev-wrld  (er-decode-logical-name logical-name wrld ctx state))
-        (cmd-wrld (superior-command-world ev-wrld wrld ctx state)))
-       (value (origin-fn1 wrld ev-wrld cmd-wrld)))))))
+      (let ((ev-wrld (decode-logical-name logical-name wrld)))
+        (cond (ev-wrld
+               (value (let ((book-path (global-val 'include-book-path ev-wrld)))
+                        (cond (book-path
+                               (reverse book-path))
+                              (t
+                               :top-level)))))
+              (t (mv (msg "Not logical name: ~x0." logical-name) nil state))))))))
 
 (defmacro origin (logical-name)
-  `(origin-fn ,logical-name 'origin state))
+  `(origin-fn ,logical-name state))
 
diff -Nru acl2-6.2/books/system/pcert/acl2x-pcert-test-1.acl2 acl2-6.3/books/system/pcert/acl2x-pcert-test-1.acl2
--- acl2-6.2/books/system/pcert/acl2x-pcert-test-1.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/acl2x-pcert-test-1.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 ; cert-flags: ? t :acl2x t
 ; cert_param: (acl2x)
diff -Nru acl2-6.2/books/system/pcert/acl2x-pcert-test-1.lisp acl2-6.3/books/system/pcert/acl2x-pcert-test-1.lisp
--- acl2-6.2/books/system/pcert/acl2x-pcert-test-1.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/acl2x-pcert-test-1.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (make-event '(defun f (x) x))
diff -Nru acl2-6.2/books/system/pcert/cert.acl2 acl2-6.3/books/system/pcert/cert.acl2
--- acl2-6.2/books/system/pcert/cert.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/cert.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (DEFUN P1 (X) X)
 (DEFUN P2 (X) X)
 (DEFUN P3 (X) X)
diff -Nru acl2-6.2/books/system/pcert/mid.acl2 acl2-6.3/books/system/pcert/mid.acl2
--- acl2-6.2/books/system/pcert/mid.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/mid.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; We have commented out the following just to add a little spice,
 ; since (p)certification of sub and top will load cert.acl2.
 ; (load "cert.acl2")
diff -Nru acl2-6.2/books/system/pcert/mid.lisp acl2-6.3/books/system/pcert/mid.lisp
--- acl2-6.2/books/system/pcert/mid.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/mid.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (include-book "sub")
diff -Nru acl2-6.2/books/system/pcert/pkg-test.acl2 acl2-6.3/books/system/pcert/pkg-test.acl2
--- acl2-6.2/books/system/pcert/pkg-test.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/pkg-test.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 (defpkg "FOO" nil)
 (defpkg "BAR" '(foo::a))
diff -Nru acl2-6.2/books/system/pcert/pkg-test.lisp acl2-6.3/books/system/pcert/pkg-test.lisp
--- acl2-6.2/books/system/pcert/pkg-test.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/pkg-test.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (defun bar::f (x) x)
diff -Nru acl2-6.2/books/system/pcert/top.acl2 acl2-6.3/books/system/pcert/top.acl2
--- acl2-6.2/books/system/pcert/top.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/top.acl2	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; We need to specify :skip-proofs-okp t because of the skip-proofs in
 ; mid.lisp.
 
diff -Nru acl2-6.2/books/system/pcert/top.lisp acl2-6.3/books/system/pcert/top.lisp
--- acl2-6.2/books/system/pcert/top.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pcert/top.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 (progn (make-event '(make-event '(defun r1 (x) x)))
diff -Nru acl2-6.2/books/system/pseudo-good-worldp.lisp acl2-6.3/books/system/pseudo-good-worldp.lisp
--- acl2-6.2/books/system/pseudo-good-worldp.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/system/pseudo-good-worldp.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann and J Strother Moore
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 (in-package "ACL2")
 
 ; -----------------------------------------------------------------
diff -Nru acl2-6.2/books/system/random.lisp acl2-6.3/books/system/random.lisp
--- acl2-6.2/books/system/random.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/system/random.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -0,0 +1,94 @@
+; Random$ function
+; Copyright (C) 2012 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original authors: Jared Davis <jared@centtech.com>
+;                   Sol Swords <sswords@centtech.com>
+
+(in-package "ACL2")
+(include-book "xdoc/top" :dir :system)
+(include-book "tools/bstar" :dir :system)
+(local (include-book "tools/mv-nth" :dir :system))
+(set-state-ok t)
+
+(defsection random$-lemmas
+  :parents (random$)
+  :short "Lemmas about random$ available in the system/random book."
+
+  (local (in-theory (enable random$)))
+
+  (defthm natp-random$-better
+    (natp (mv-nth 0 (random$ limit state)))
+    :rule-classes :type-prescription)
+
+  (defthm random$-linear-better
+    (and (<= 0 (mv-nth 0 (random$ n state)))
+         (implies (posp n)
+                  (< (mv-nth 0 (random$ n state)) n)))
+    :hints(("Goal"
+            :in-theory (enable mv-nth)
+            :use ((:instance acl2::random$-linear (acl2::n n))))))
+
+  (defthm state-p1-of-random
+    (implies (force (state-p1 state))
+             (state-p1 (mv-nth 1 (random$ limit state))))
+    :hints(("Goal" :in-theory (enable random$ read-acl2-oracle)))))
+
+
+(defsection random-list-aux
+  :parents (random$)
+  :short "Add random numbers onto an accumulator."
+
+  (defund random-list-aux (n limit acc state)
+    (declare (xargs :guard (and (natp n)
+                                (posp limit))))
+    (if (zp n)
+        (mv acc state)
+      (b* (((mv x1 state) (random$ limit state)))
+        (random-list-aux (- n 1) limit (cons x1 acc) state))))
+
+  (local (in-theory (enable random-list-aux)))
+
+  (defthm nat-listp-of-random-list-aux
+    (equal (nat-listp (mv-nth 0 (random-list-aux n limit acc state)))
+           (nat-listp acc)))
+
+  (defthm state-p1-of-random-list-aux
+    (implies (force (state-p1 state))
+             (state-p1 (mv-nth 1 (random-list-aux n limit acc state))))))
+
+
+(defsection random-list
+  :parents (random$)
+  :short "Generate a list of random numbers in [0, limit)."
+
+  (defund random-list (n limit state)
+    (declare (xargs :guard (and (natp n)
+                                (posp limit))))
+    (random-list-aux n limit nil state))
+
+  (local (in-theory (enable random-list)))
+
+  (defthm nat-listp-of-random-list
+    (nat-listp (mv-nth 0 (random-list n limit state))))
+
+  (defthm state-p1-of-random-list
+    (implies (force (state-p1 state))
+             (state-p1 (mv-nth 1 (random-list n limit state))))))
+
+
+
diff -Nru acl2-6.2/books/tau/bounders/elementary-bounders.lisp acl2-6.3/books/tau/bounders/elementary-bounders.lisp
--- acl2-6.2/books/tau/bounders/elementary-bounders.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/tau/bounders/elementary-bounders.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -1,3 +1,7 @@
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore, December, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; (certify-book "elementary-bounders")
 
 ; Tau Interval Functions for Basic Arithmetic
@@ -184,6 +188,17 @@
 
 (in-package "ACL2")
 
+; The following was added 9/30/2013 by Matt K. to avoid storage "exhausted"
+; error for GCL 2.6.8 on a Mac.  In future ACL2 releases we will not need this
+; fix if, as we expect, gag-mode is automatically turned off when prover output
+; is inhibited.
+(local (make-event
+        (pprogn (cond ((member-eq 'prove
+                                  (f-get-global 'inhibit-output-lst state))
+                       (set-gag-mode nil))
+                      (t state))
+                (value '(value-triple nil)))))
+
 (local (include-book "arithmetic-5/top" :dir :system))
 
 (local (SET-DEFAULT-HINTS
diff -Nru acl2-6.2/books/tau/bounders/find-maximal-1d.lisp acl2-6.3/books/tau/bounders/find-maximal-1d.lisp
--- acl2-6.2/books/tau/bounders/find-maximal-1d.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/tau/bounders/find-maximal-1d.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -1,7 +1,8 @@
-; Toy: Finding the Maximal Value of a Function over an Integer Interval
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore, December 19, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; J Strother Moore
-; December 19, 2012
+; Toy: Finding the Maximal Value of a Function over an Integer Interval
 
 ; To recertify:
 ; (certify-book "find-maximal-1d")
diff -Nru acl2-6.2/books/tau/bounders/find-maximal-2d.lisp acl2-6.3/books/tau/bounders/find-maximal-2d.lisp
--- acl2-6.2/books/tau/bounders/find-maximal-2d.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/tau/bounders/find-maximal-2d.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -1,7 +1,8 @@
-; Toy: Finding the Maximal Value of a Function over a Pair of Integer Intervals
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore, December 20, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; J Strother Moore
-; December 20, 2012
+; Toy: Finding the Maximal Value of a Function over a Pair of Integer Intervals
 
 ; To recertify:
 ; (certify-book "find-maximal-2d")
diff -Nru acl2-6.2/books/tau/bounders/find-minimal-1d.lisp acl2-6.3/books/tau/bounders/find-minimal-1d.lisp
--- acl2-6.2/books/tau/bounders/find-minimal-1d.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/tau/bounders/find-minimal-1d.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -1,7 +1,8 @@
-; Toy: Finding the Minimal Value of a Function over an Integer Interval
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore, December 19, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; J Strother Moore
-; December 19, 2012
+; Toy: Finding the Minimal Value of a Function over an Integer Interval
 
 ; To recertify:
 ; (certify-book "find-minimal-1d")
diff -Nru acl2-6.2/books/tau/bounders/find-minimal-2d.lisp acl2-6.3/books/tau/bounders/find-minimal-2d.lisp
--- acl2-6.2/books/tau/bounders/find-minimal-2d.lisp	2013-06-06 17:12:01.000000000 +0000
+++ acl2-6.3/books/tau/bounders/find-minimal-2d.lisp	2013-09-30 17:53:30.000000000 +0000
@@ -1,7 +1,8 @@
-; Toy: Finding the Minimal Value of a Function over a Pair of Integer Intervals
+; Copyright (C) 2013, ForrestHunt, Inc.
+; Written by J Strother Moore, December 20, 2012
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
 
-; J Strother Moore
-; December 20, 2012
+; Toy: Finding the Minimal Value of a Function over a Pair of Integer Intervals
 
 ; To recertify:
 ; (certify-book "find-minimal-2d")
diff -Nru acl2-6.2/books/tools/defconsts.lisp acl2-6.3/books/tools/defconsts.lisp
--- acl2-6.2/books/tools/defconsts.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/tools/defconsts.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -287,6 +287,7 @@
        (event    (if cmds
                      `(list 'progn ,@cmds)
                    ''(value-triple :empty-defconsts)))
+       (event    `(list 'with-output :off '(event) ,event))
 
        ;; If there are any stobjs, we need to return
        ;;    (mv nil '(progn (defconst ...)) state ... stobjs ...)
@@ -447,3 +448,5 @@
      :rule-classes nil)
    (defthm f2 (equal *oops2* '|(DEFCONSTS (*OOPS2* ...) ...)|)
      :rule-classes nil)))
+
+
diff -Nru acl2-6.2/books/tools/flag.lisp acl2-6.3/books/tools/flag.lisp
--- acl2-6.2/books/tools/flag.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/tools/flag.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -477,15 +477,15 @@
      nil)))
 
 
-(defun make-flag-body-aux (fn-name formals alist full-alist world)
+(defun make-flag-body-aux (flag-var fn-name formals alist full-alist world)
   (if (consp alist)
       (let* ((orig-body (get-body (caar alist) world))
              (new-body (mangle-body orig-body fn-name full-alist formals world)))
         (cond ((consp (cdr alist))
-               (cons `(,(cdar alist) ,new-body)
-                     (make-flag-body-aux fn-name formals (cdr alist) full-alist world)))
+               (cons `((equal ,flag-var ',(cdar alist)) ,new-body)
+                     (make-flag-body-aux flag-var fn-name formals (cdr alist) full-alist world)))
               (t
-               (list `(otherwise ,new-body)))))
+               (list `(t ,new-body)))))
     (er hard 'make-flag-body-aux "Never get here.")))
 
 (defun make-flag-body (fn-name flag-var alist hints ruler-extenders world)
@@ -501,9 +501,9 @@
                                                       world)
                      :mode :logic)
               (ignorable . ,formals))
-     (case ,flag-var
+     (cond
        .
-       ,(make-flag-body-aux fn-name formals alist alist world)))))
+       ,(make-flag-body-aux flag-var fn-name formals alist alist world)))))
 
 (defun extract-keyword-from-args (kwd args)
   (if (consp args)
@@ -582,11 +582,13 @@
                                (set-difference-eq possibilities
                                                   (acl2::strip-cadrs inequivs))))
                          (and (eql (len not-ruled-out) 1)
-                              (list 'quote (car not-ruled-out)))))))
+                              (list 'quote (car not-ruled-out))))))
+          (first (extract-keyword-from-args :first cases))
+          (cases (throw-away-keyword-parts cases)))
       (and flagval
            (let ((hints (cdr (assoc (cadr flagval) cases))))
              `(:computed-hint-replacement
-               ,(translate-subgoal-to-computed-hints hints)
+               (,@first . ,(translate-subgoal-to-computed-hints hints))
                :clause-processor (flag-is-cp clause ,flagval)))))))
 
 (defmacro flag-hint-cases (flagname &rest cases)
@@ -613,7 +615,7 @@
 
 
 
-(defun pair-up-cases-with-thmparts (alist thmparts skip-ok)
+(defun pair-up-cases-with-thmparts (flag-var alist thmparts skip-ok)
   ;; Each thmpart is an thing like
   ;; _either_ (flag <thm-body> :name ... :rule-classes ... :doc ...)
   ;;;    (for backwards compatibility)
@@ -632,9 +634,9 @@
                             (t ;; (flag body ...)
                              (cadr lookup)))))
             (if (consp (cdr alist))
-                (cons `(,flag ,body)
-                      (pair-up-cases-with-thmparts (cdr alist) thmparts skip-ok))
-              (list `(otherwise ,body))))))
+                (cons `((equal ,flag-var ',flag) ,body)
+                      (pair-up-cases-with-thmparts flag-var (cdr alist) thmparts skip-ok))
+              (list `(t ,body))))))
     (er hard 'pair-up-cases-with-thmparts
         "Never get here.")))
 
@@ -734,25 +736,27 @@
                   (car flag-fncall))))
          (instructions (extract-keyword-from-args :instructions args))
          (user-hints (extract-keyword-from-args :hints args))
+         (no-induction-hint (extract-keyword-from-args :no-induction-hint args))
          (skip-ok (extract-keyword-from-args :skip-others args))
          (hints (and (not instructions)
                      (append
-                      (if (and (consp (car user-hints))
-                               (stringp (caar user-hints))
-                               (equal (string-upcase (caar user-hints))
-                                      "GOAL"))
-                          ;; First hint is for goal.
-                          (if (extract-keyword-from-args :induct (car user-hints))
-                              ;; Explicit induct hint is provided; do not override.
-                              user-hints
-                            ;; Provide our induct hint in addition to the hints
-                            ;; provided in goal.
-                            (cons `("Goal" :induct ,flag-fncall
-                                    . ,(cdar user-hints))
-                                  (cdr user-hints)))
-                        ;; No goal hint; cons our induction hint onto the rest.
-                        (cons `("Goal" :induct ,flag-fncall)
-                              user-hints))
+                      (cond (no-induction-hint user-hints)
+                            ((and (consp (car user-hints))
+                                  (stringp (caar user-hints))
+                                  (equal (string-upcase (caar user-hints))
+                                         "GOAL"))
+                             ;; First hint is for goal.
+                             (if (extract-keyword-from-args :induct (car user-hints))
+                                 ;; Explicit induct hint is provided; do not override.
+                                 user-hints
+                               ;; Provide our induct hint in addition to the hints
+                               ;; provided in goal.
+                               (cons `("Goal" :induct ,flag-fncall
+                                       . ,(cdar user-hints))
+                                     (cdr user-hints))))
+                            ;; No goal hint; cons our induction hint onto the rest.
+                            (t (cons `("Goal" :induct ,flag-fncall)
+                                     user-hints)))
                       (list
                        `(flag-hint-cases
                          ,flag-var
@@ -762,8 +766,8 @@
        (encapsulate
         ()
         (local (defthm ,name
-                 (case ,flag-var . ,(pair-up-cases-with-thmparts
-                                     alist thmparts skip-ok))
+                 (cond . ,(pair-up-cases-with-thmparts
+                           flag-var alist thmparts skip-ok))
                  :rule-classes nil
                  :hints ,hints
                  :instructions ,instructions
@@ -789,6 +793,17 @@
     nil))
 
 
+(defun equiv-theorem-cases (flag-fn formals alist world)
+  (if (consp alist)
+      (let* ((fn   (caar alist))
+             (flag (cdar alist))
+             (fn-formals (get-formals fn world)))
+        (cons `(equal (,flag-fn ',flag . ,formals)
+                      (,fn . ,fn-formals))
+              (equiv-theorem-cases flag-fn formals (cdr alist) world)))
+    nil))
+
+
 
 ; LEGACY HINT.  We found cases where EXPAND-CALLS-COMPUTED-HINT was too
 ; aggressive and expanded 'inner' terms that shouldn't have been expanded.
@@ -848,8 +863,19 @@
     (cons `(table flag-fns ',(caar alist) ',entry)
           (flag-table-events (cdr alist) entry))))
 
+(defun apply-formals-subst (formals subst)
+  (if (atom formals)
+      nil
+    (let ((look (assoc (car formals) subst)))
+      (if look
+          (cons (cdr look) (apply-formals-subst (cdr formals) subst))
+        (cons (car formals) (apply-formals-subst (cdr formals) subst))))))
+  
+
 (defun make-flag-fn (flag-fn-name clique-member-name flag-var flag-mapping hints
-                                  defthm-macro-name local ruler-extenders world)
+                                  defthm-macro-name
+                                  formals-subst
+                                  local ruler-extenders world)
   (let* ((flag-var (or flag-var
                        (intern-in-package-of-symbol "FLAG" flag-fn-name)))
          (alist (or flag-mapping
@@ -871,36 +897,40 @@
       (,(if local 'local 'id)
        ,(make-flag-body flag-fn-name flag-var alist hints ruler-extenders world))
       ,(make-defthm-macro defthm-macro-name alist flag-var
-                          `(,flag-fn-name ,flag-var . ,formals))
+                          `(,flag-fn-name ,flag-var
+                                          . ,(apply-formals-subst formals formals-subst)))
 
       (,(if local 'local 'id)
        (with-output
         :off (prove event) ;; hides induction scheme, too
         (encapsulate nil
           (logic)
+          (local (defthm flag-equiv-lemma
+                   (equal (,flag-fn-name ,flag-var . ,formals)
+                          (case ,flag-var
+                            ,@(make-cases-for-equiv alist world)))
+                   :hints (("Goal"
+                            :induct
+                            (,flag-fn-name ,flag-var . ,formals)
+                            :in-theory
+                            (set-difference-theories
+                             (union-theories (theory 'minimal-theory)
+                                             '((:induction ,flag-fn-name)
+                                               (:rewrite expand-all-hides)))
+                             '(;; Jared found mv-nth to be slowing down a couple of flag
+                               ;; function admissions.  Take it out of the minimal theory.
+                               (:definition mv-nth)
+                               ;; Jared found a case where "linear" forced some goals
+                               ;; from an equality, which were unprovable.  So, turn
+                               ;; off forcing.
+                               (:executable-counterpart force))))
+                           (flag-expand-computed-hint stable-under-simplificationp
+                                                      ACL2::clause
+                                                      ',(cons flag-fn-name
+                                                              (strip-cars
+                                                               alist))))))
           (defthm ,equiv-thm-name
-            (equal (,flag-fn-name ,flag-var . ,formals)
-                   (case ,flag-var
-                     ,@(make-cases-for-equiv alist world)))
-            :hints (("Goal"
-                     :induct
-                     (,flag-fn-name ,flag-var . ,formals)
-                     :in-theory
-                     (set-difference-theories
-                      (union-theories (theory 'minimal-theory)
-                                      '((:induction ,flag-fn-name)
-                                        (:rewrite expand-all-hides)))
-                      '(;; Jared found mv-nth to be slowing down a couple of flag
-                        ;; function admissions.  Take it out of the minimal theory.
-                        (:definition mv-nth)
-                        ;; Jared found a case where "linear" forced some goals
-                        ;; from an equality, which were unprovable.  So, turn
-                        ;; off forcing.
-                        (:executable-counterpart force))))
-                    (flag-expand-computed-hint stable-under-simplificationp
-                                               ACL2::clause
-                                               ',(cons flag-fn-name
-                                                       (strip-cars alist))))))))
+            (and . ,(equiv-theorem-cases flag-fn-name formals alist world))))))
 
       (progn . ,(flag-table-events alist `(,flag-fn-name
                                            ,alist
@@ -913,6 +943,7 @@
                      &key
                      flag-var
                      flag-mapping
+                     formals-subst
                      hints
                      defthm-macro-name
                      local
@@ -923,6 +954,7 @@
                              ',flag-mapping
                              ',hints
                              ',defthm-macro-name
+                             ',formals-subst
                              ',local
                              ',ruler-extenders
                              (w state))))
diff -Nru acl2-6.2/books/tools/include-raw.lisp acl2-6.3/books/tools/include-raw.lisp
--- acl2-6.2/books/tools/include-raw.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/tools/include-raw.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -28,10 +28,10 @@
 
   :long "<p>Sometimes you want to include raw Lisp code in an ACL2 book to
 achieve better performance or do fancy things like connect to external
-programs.  With @(see trust-tags), you can do this.  Unfortunately, the
-built-in mechanisms (@(see progn!) and @(see set-raw-mode)) have some
-portability problems related to compilation, file paths, read tables, non-ACL2
-objects, and so on; see below for some examples.</p>
+programs.  With <see topic='@(url defttag)'>trust tags</see>, you can do this.
+Unfortunately, the built-in mechanisms (@(see progn!) and @(see set-raw-mode))
+have some portability problems related to compilation, file paths, read tables,
+non-ACL2 objects, and so on; see below for some examples.</p>
 
 <h3>Using Include-Raw</h3>
 
@@ -195,7 +195,12 @@
                (compiled-fname (compile-file-pathname fname)))
           (cond
            ((not (member :cltl2 *features*)) ; #-cltl2
-            (load-compiled compiled-fname))
+            (cond ((probe-file compiled-fname)
+                   (load-compiled compiled-fname))
+                  (t (format t "Compiled file ~a does not exist; loading uncompiled ~a~%"
+                             (namestring compiled-fname)
+                             fname)
+                     (raw-load-uncompiled name error-on-fail on-fail state))))
            (t ; #+cltl2
             (handler-case
              (load-compiled compiled-fname)
diff -Nru acl2-6.2/books/tools/lint.lisp acl2-6.3/books/tools/lint.lisp
--- acl2-6.2/books/tools/lint.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/tools/lint.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -107,6 +107,20 @@
   (filter-non-rewrite-rules
    (find-rules-of-runes (rules-of-class :rewrite :here) world)))
 
+(defun filter-disabled-rules (x ens state)
+  (cond ((atom x) 
+         nil)
+        ((active-runep (rewrite-rule->rune (car x)))
+         (cons (car x) (filter-disabled-rules (cdr x) ens state)))
+        (t
+         (filter-disabled-rules (cdr x) ens state))))
+
+(defun get-enabled-rewrite-rules (state)
+  (let* ((world (w state))
+         (ens   (ens state))
+         (rules (get-all-rewrite-rules world)))
+    (filter-disabled-rules rules ens state)))
+
 
 
 ;; Looking for compatible, redundant rules
@@ -185,7 +199,7 @@
                       (t
                        concl)))
        (name (second rule.rune))
-       ((mv er origin state) (origin-fn name 'summarize-rule state))
+       ((mv er origin state) (origin-fn name state))
        (origin (if er
                    (prog2$ (cw "Error in summarize-rule: ~x0" er)
                            :error)
@@ -212,7 +226,7 @@
 
 (defun lint-fn (state)
   (summarize-redundancies
-   (find-redundancies-top (get-all-rewrite-rules (w state)))
+   (find-redundancies-top (get-enabled-rewrite-rules state))
    state))
 
 (defmacro lint ()
diff -Nru acl2-6.2/books/tools/templates.lisp acl2-6.3/books/tools/templates.lisp
--- acl2-6.2/books/tools/templates.lisp	2013-06-06 17:11:03.000000000 +0000
+++ acl2-6.3/books/tools/templates.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -25,7 +25,7 @@
 (include-book "xdoc/top" :dir :system)
 
 (defxdoc template-subst
-  :parents (event-generation)
+  :parents (macro-libraries)
   :short "Process a template to generate some events"
   :long "
 <p>Template-subst is a function for manipulating templates that
@@ -45,7 +45,7 @@
              (defthm _treefn_-preserves-acl2-count
                (equal (acl2-count (_treefn_ x _other-args_))
                       (acl2-count x)))))))
-@})
+})
 Now to instantiate this template we might do
 @({
  (template-subst *maptree-template*
@@ -56,7 +56,7 @@
                                (_leaffn_ . +))
                  :str-alist '((\"_TREEFN_\" . \"ADD-TO-LEAVES\"))
                  :pkg-sym 'acl2::asdf)
-@})
+})
  </p>
 
 <p>The process has two main steps.</p>
@@ -186,7 +186,9 @@
        ((mv str pkg?) (tmpl-str-sublis alist str1)))
     (if (equal str1 str) sym
       (intern-in-package-of-symbol
-       str (or pkg? pkg-sym)))))
+       str (if (keywordp sym)
+               sym
+             (or pkg? pkg-sym))))))
 
 
 (mutual-recursion
diff -Nru acl2-6.2/books/translators/l3-to-acl2/LICENSE acl2-6.3/books/translators/l3-to-acl2/LICENSE
--- acl2-6.2/books/translators/l3-to-acl2/LICENSE	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/LICENSE	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,38 @@
+Author:
+Matt Kaufmann
+
+This license file applies to all files in this directory tree with the
+exception of those supplied by Anthony Fox, as described in the README
+files.
+
+.....
+
+Copyright (c) 2013, Regents of the University of Texas
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+o Redistributions of source code must retain the above copyright
+  notice, this list of conditions and the following disclaimer.
+
+o Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+
+o Neither the name of the University of Texas, Austin nor the names of
+  its contributors may be used to endorse or promote products derived
+  from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff -Nru acl2-6.2/books/translators/l3-to-acl2/Makefile acl2-6.3/books/translators/l3-to-acl2/Makefile
--- acl2-6.2/books/translators/l3-to-acl2/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/Makefile	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,23 @@
+# Note that ACL2 and ACL2_SYSTEM_BOOKS should be defined, e.g.:
+# bash
+# ACL2_DIR=/Users/kaufmann/acl2/v6-2/acl2-sources
+# export ACL2=${ACL2_DIR}/saved_acl2
+# export ACL2_SYSTEM_BOOKS=${ACL2_DIR}/books
+
+# Example, when running from this directory:
+# make ACL2=acl2ch ACL2_SYSTEM_BOOKS=/projects/acl2/devel/books
+
+# WARNING: Do not run with -j (unless it's -j 1)!  Otherwise you may
+# get errors.
+
+ACL2_DIR ?= $(shell cd ../../.. ; pwd)
+export ACL2 ?= $(ACL2_DIR)/saved_acl2
+export ACL2_SYSTEM_BOOKS ?= $(ACL2_DIR)/books
+
+# There were issues with examples/thacker when testing in late
+# September 2013 on Windows, so for now we remove that directory.  If
+# you want it included at your local installation, simply uncomment
+# the next line and comment out the one immediately below it.
+# DIRS = translator examples/thacker
+DIRS = translator
+include $(ACL2_SYSTEM_BOOKS)/Makefile-subdirs
diff -Nru acl2-6.2/books/translators/l3-to-acl2/README acl2-6.3/books/translators/l3-to-acl2/README
--- acl2-6.2/books/translators/l3-to-acl2/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/README	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,165 @@
+Table of contents.
+
+I.   ORGANIZATION
+II.  HOW TO RUN THINGS USING make
+III. HOW TO DO THE TRANSLATION MANUALLY
+IV.  STATUS AND POSSIBLE FUTURE DIRECTIONS
+
+============================================================
+I.   ORGANIZATION
+============================================================
+
+Subdirectories (each with a README):
+
+examples/       examples (only one worked as of this writing)
+misc/           miscellaneous stuff
+translator/     the translator and supporting library
+
+Files in the current directory:
+
+LICENSE         license/copyright/authorship file
+Makefile        top-level makefile
+README          this README
+notes.txt       some technical notes
+
+============================================================
+II.  HOW TO RUN THINGS USING make
+============================================================
+
+# Optional (edit as appropriate):
+bash
+ACL2_DIR=/Users/kaufmann/acl2/v6-2/acl2-sources
+export ACL2=${ACL2_DIR}/saved_acl2
+export ACL2_SYSTEM_BOOKS=${ACL2_DIR}/books
+
+# Connect to the directory of this README.
+
+# First build the translator.
+cd translator
+make clean
+make
+
+# Now do the translation, certification of books, a check that running
+# the model gives expected result, and timing runs.  Output should
+# help explain all that.
+cd -
+cd examples/thacker
+# Ignore "egrep" warnings on the following (sorry).
+make clean
+# The following should go quickly except for the one step,
+# tiny-manual.cert, which might take a couple of minutes.
+# WARNING: Do not use -j !
+make
+
+============================================================
+III. HOW TO DO THE TRANSLATION MANUALLY
+============================================================
+
+First, prepare the translator as described above, basically:
+
+  cd translator ; make
+
+Then, connect to the examples/thacker/ directory.
+
+Now start up ACL2 and run the following commands.  The :str-to-sym
+argument is a renaming argument: normally a string from the input file
+(tiny-acl2.txt) is translated to a symbol by uppercasing the string
+after changing each "'" to "-", with the exception of "t" and "nil"
+(see *initial-bindings* in translator/l3-to-acl2.lisp), but the
+:str-to-sym alist overrides that default behavior, mapping strings
+directly to symbols as specified.  This is useful for preventing name
+clashes (see notes.txt for more about that).
+
+(include-book "../../translator/l3-to-acl2")
+(l3-to-acl2 "tiny-acl2.txt" ; input file
+            "tiny.lisp"     ; output file
+            :str-to-sym
+            '(("PC" . pctr) ("alu" . alu_var) ("function"
+            . function0)))
+
+The optional keyword argument :logic is nil by default, which results
+in most of the output file being in ACL2's :program mode -- so
+functions can be run, but not reasoned about.  However, :logic can
+also be :logic-only or t.  We use :logic-only to generate the file
+tiny-logic.lisp:
+
+(l3-to-acl2 "tiny-acl2.txt"   ; input file
+            "tiny-logic.lisp" ; output file
+            :logic :logic-only
+            :str-to-sym
+            '(("PC" . pctr) ("alu" . alu_var) ("function"
+            . function0)))
+
+============================================================
+IV.  STATUS AND POSSIBLE FUTURE DIRECTIONS
+============================================================
+
+The translator seems to work fine for examples/thacker/.  But NOTE
+that if you use make, then -j n for n>1 is not supported.
+
+However, the translator produces numerous errors when attempting to
+run on examples/x86-64/ or examples/mips/.  Mostly this is just a
+matter of translating more of the L3 language.  There is one hard Lisp
+error that has occurred for examples/x86-64/, which perhaps should be
+fixed first -- errors should be clean, and produced deliberately by
+the translator rather than by accident in raw Lisp.
+
+**NOTE**: See especially examples/mips/README for notes on how to
+modify the translator to be able to handle the MIPS example.
+
+Thus, the translator suffers from incompleteness and possible bugs.
+It could also use more complete documentation (especially, Lisp
+comments), but I think I'll be able to make sense of what's there
+now if I return to it, since there is a running example.  Probably
+translator/l3.lisp could be made a bit prettier.
+
+But another possible future direction is to include proof support for
+generating a certifiable book whose functions are guard-verified.
+There is a manually-writee book examples/thacker/tiny-manual.lisp that
+can be included in the same session with examples/thacker/tiny.lisp,
+so we know that their definitions agree.  But tiny-manual.lisp has all
+functions guard-verified, albeit with manually produced defthm events
+to serve as lemmas.  With some thought it might be possible to do a
+clean job of reflecting the L3 type system in ACL2 in a manner that
+avoids the need to create such lemmas manually, perhaps by generating
+lemmas that help the tau system.
+
+That's an interesting research idea, but it's not clear how important
+it is.  Now guard verification does give added confidence in the
+translation.  (I think I caught some mistakes this way, when guard
+proofs failed.)  But perhaps most of the benefit is already there from
+the manually completed Thacker example.  Another benefit typically
+given is faster execution.  But :program mode evaluation is just as
+fast, so the only way faster execution could be useful is during
+proofs.  But our preliminary tests show little benefit for guard
+verification when running our models.  For example, timing runs show
+the following results (these numbers are for 10,000 runs, which thus
+includes 10,000 initialization and 350,000 instructions), and the
+differences are rather in the noise.
+
+Program mode (using tiny.lisp):
+; 0.48 seconds realtime, 0.46 seconds runtime
+
+Logic mode, not guard-verified (using tiny-logic.lisp):
+; 0.49 seconds realtime, 0.47 seconds runtime
+
+Logic mode, guard-verified (using tiny-manual.lisp):
+; 0.48 seconds realtime, 0.45 seconds runtime
+
+In each case, the corresponding time for 10,000 initializations and no
+instructions was:
+
+; 0.17 seconds realtime, 0.17 seconds runtime
+
+When we subtract that from 0.48 seconds of realtime, we get 0.31
+seconds for 350,000 instructions, which yields about 1.1M ips.
+
+But Warren Hunt has said that the paging-free x86 model at UT runs at
+about 5M ips.  So we can probably speed up our L3 evaluation.  The
+timing results (from "make") show more than 100M bytes generated for
+our tests, which probably represents a lot of garbage.  I'd guess that
+this comes from decoding instruction words into tupled (cons) data
+structures.  Probably we can devise a scheme that avoids this consing
+and provides significant speed-up.
+
+============================================================
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/README acl2-6.3/books/translators/l3-to-acl2/examples/README
--- acl2-6.2/books/translators/l3-to-acl2/examples/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/README	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,6 @@
+See thacker/README for discussion of an example that runs successfully
+through the translation process.
+
+Directories mips/ and x86-64/ contain examples from Anthony Fox that
+can not yet be run through the translator from L3 to ACL2.  See in
+particular mips/README.
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/mips/README acl2-6.3/books/translators/l3-to-acl2/examples/mips/README
--- acl2-6.2/books/translators/l3-to-acl2/examples/mips/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/mips/README	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,73 @@
+To attempt to run the translator in this directory (but there will be
+errors):
+
+(include-book "../../translator/l3-to-acl2")
+(l3-to-acl2 "mips-acl2.txt" ; input file
+            "mips.lisp"     ; output file
+            :str-to-sym
+            '(("LOAD" . is_load)
+              ("STORE" . is_store)
+              ("INSTRUCTION" . is_instruction)
+              ("DATA" . is_data)
+              ("gpr" . gpregs))
+            )
+
+Here are a number of translator issues exposed by attempts to run the
+translator as above.
+
+I'm a bit stuck here in ../../translator/l3-to-acl2.lisp (but see
+below):
+
+(defun l3-get-type-mop (mop expr ctx bindings)
+; Keep in sync with l3-trans-map.
+; !! Need to support fst and snd.
+
+I think it's time to redo things so that tuples are mapped to conses
+rather than true lists, i.e., so that PTY is always the type of conses
+of its FST and SND.  This might not be difficult, but it would involve
+going through ../../translator/l3-to-acl2.lisp and
+../../translator/l3.lisp and making appropriate changes.
+
+Regarding records, indicated by REC: Currently we assume that there is
+only one record, which represents the processor state.  I've left some
+comments in l3-to-acl2.lisp (marked with !!) for where we'll need to
+make changes when allowing other records, as in the MIPS example.
+Those comments kind of assume that we handle state records differently
+from how we handle other records.  But a different way to go is to
+handle them all the same, without stobjs, and see how badly we lose in
+performance.  For array fields, then, we might instead use alists or
+even ACL2 records (normed alists), where we omit default values
+(typically 0, but maybe 7 [reserved instruction number] in the case of
+instructions) from the alist.  At any rate, fields that correspond to
+excessively large arrays -- say with dimension greater than a limit
+specified by the user in the call of l3-to-acl2 (and certainly smaller
+than 64) -- would need to be translated to alists instead of arrays,
+even for the state record.
+
+Note regarding special handling for patterns: we expect to handle
+these for records like we handle calls of CONSTRUCT functions.
+
+We might simplify some code, as suggested by Anthony Fox, by storing
+ctx in bindings so that ctx needn't be passed explicitly.
+
+Consider this sort of thing:
+               (BOP MDFY
+                    (CLOSE (TP (SQBKT NVAR "i" (AVAR BTY)))
+                           (ITB (SQBKT ((EQ NVAR "i" (LN 31))
+                           ....
+Anthony and I discussed it, and we expect to be able simply to update
+each bit of the indicated starting bit vector.
+
+Handle ITB in general: easy to translate to COND, where the final
+argument is the T branch at the end.
+
+Support anonymous variables, (AVAR ...), in formals.  We can probably
+use generated names together with IGNORE declarations.
+
+(LX typ) is ARB of type typ.
+
+Regarding (SE (FTY 65)) -- sign-extend, which is like a cast, but
+conditionally on the sign bit may extend with ones.
+
+(LS "MFLO") is a literal string.
+
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/mips/mips-acl2.txt acl2-6.3/books/translators/l3-to-acl2/examples/mips/mips-acl2.txt
--- acl2-6.2/books/translators/l3-to-acl2/examples/mips/mips-acl2.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/mips/mips-acl2.txt	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,8039 @@
+(val _ = Record
+  ("StatusRegister"
+    (sqbkt ("'rst" (FTy 23)) ("BEV" bTy) ("ERL" bTy) ("EXL" bTy)
+           ("IE" bTy) ("IM0" bTy) ("IM1" bTy) ("KSU" (FTy 2)) ("RE" bTy))))
+
+
+(val _ = Record ("ConfigRegister" (sqbkt ("'rst" (FTy 31)) ("BE" bTy))))
+
+
+(val _ = Record
+  ("CauseRegister" (sqbkt ("'rst" (FTy 27)) ("ExcCode" (FTy 5)))))
+
+
+(val _ = Record
+  ("CP0"
+    (sqbkt ("Cause" CTy"CauseRegister") ("Config" CTy"ConfigRegister")
+           ("Count" F32) ("EPC" F64) ("ErrorEPC" F64)
+           ("Status" CTy"StatusRegister"))))
+
+
+(val _ = Construct
+  (sqbkt ("HLStatus"
+           (sqbkt ("HLarith" []) ("HLok" []) ("HLmthi" []) ("HLmtlo" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("IorD" (sqbkt ("INSTRUCTION" []) ("DATA" [])))))
+
+
+(val _ = Construct (sqbkt ("LorS" (sqbkt ("LOAD" []) ("STORE" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("ExceptionType"
+           (sqbkt ("AdEL" []) ("AdES" []) ("Sys" []) ("Bp" []) ("RI" [])
+                  ("Ov" []) ("Tr" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("Branch"
+           (sqbkt ("BEQ" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("BEQL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("BGEZ" (sqbkt (PTy (FTy 5) F16)))
+                  ("BGEZAL" (sqbkt (PTy (FTy 5) F16)))
+                  ("BGEZALL" (sqbkt (PTy (FTy 5) F16)))
+                  ("BGEZL" (sqbkt (PTy (FTy 5) F16)))
+                  ("BGTZ" (sqbkt (PTy (FTy 5) F16)))
+                  ("BGTZL" (sqbkt (PTy (FTy 5) F16)))
+                  ("BLEZ" (sqbkt (PTy (FTy 5) F16)))
+                  ("BLEZL" (sqbkt (PTy (FTy 5) F16)))
+                  ("BLTZ" (sqbkt (PTy (FTy 5) F16)))
+                  ("BLTZAL" (sqbkt (PTy (FTy 5) F16)))
+                  ("BLTZALL" (sqbkt (PTy (FTy 5) F16)))
+                  ("BLTZL" (sqbkt (PTy (FTy 5) F16)))
+                  ("BNE" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("BNEL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("J" (sqbkt (FTy 26))) ("JAL" (sqbkt (FTy 26)))
+                  ("JALR" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("JR" (sqbkt (FTy 5)))))))
+
+
+(val _ = Construct
+  (sqbkt ("CP"
+           (sqbkt ("DMFC0" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                  ("DMTC0" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                  ("MFC0" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                  ("MTC0" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))))))
+
+
+(val _ = Construct
+  (sqbkt ("Store"
+           (sqbkt ("SB" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SC" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SCD" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SD" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SDL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SDR" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SH" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SW" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SWL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SWR" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))))))
+
+
+(val _ = Construct
+  (sqbkt ("Load"
+           (sqbkt ("LB" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LBU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LD" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LDL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LDR" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LH" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LHU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LLD" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LW" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LWL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LWR" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LWU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))))))
+
+
+(val _ = Construct
+  (sqbkt ("Trap"
+           (sqbkt ("TEQ" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("TEQI" (sqbkt (PTy (FTy 5) F16)))
+                  ("TGE" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("TGEI" (sqbkt (PTy (FTy 5) F16)))
+                  ("TGEIU" (sqbkt (PTy (FTy 5) F16)))
+                  ("TGEU" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("TLT" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("TLTI" (sqbkt (PTy (FTy 5) F16)))
+                  ("TLTIU" (sqbkt (PTy (FTy 5) F16)))
+                  ("TLTU" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("TNE" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("TNEI" (sqbkt (PTy (FTy 5) F16)))))))
+
+
+(val _ = Construct
+  (sqbkt ("Shift"
+           (sqbkt ("DSLL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSLL32" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSLLV" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSRA" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSRA32" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSRAV" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSRL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSRL32" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSRLV" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SLL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SLLV" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SRA" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SRAV" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SRL" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SRLV" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))))))
+
+
+(val _ = Construct
+  (sqbkt ("MultDiv"
+           (sqbkt ("DDIV" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("DDIVU" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("DIV" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("DIVU" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("DMULT" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("DMULTU" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("MFHI" (sqbkt (FTy 5))) ("MFLO" (sqbkt (FTy 5)))
+                  ("MTHI" (sqbkt (FTy 5))) ("MTLO" (sqbkt (FTy 5)))
+                  ("MULT" (sqbkt (PTy (FTy 5) (FTy 5))))
+                  ("MULTU" (sqbkt (PTy (FTy 5) (FTy 5))))))))
+
+
+(val _ = Construct
+  (sqbkt ("ArithR"
+           (sqbkt ("ADD" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("ADDU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("AND" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DADD" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DADDU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSUB" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("DSUBU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("NOR" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("OR" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SLT" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SLTU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SUB" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("SUBU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                  ("XOR" (sqbkt (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))))))
+
+
+(val _ = Construct
+  (sqbkt ("ArithI"
+           (sqbkt ("ADDI" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("ADDIU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("ANDI" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("DADDI" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("DADDIU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("LUI" (sqbkt (PTy (FTy 5) F16)))
+                  ("ORI" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SLTI" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("SLTIU" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))
+                  ("XORI" (sqbkt (PTy (FTy 5) (PTy (FTy 5) F16))))))))
+
+
+(val _ = Construct
+  (sqbkt ("instruction"
+           (sqbkt ("ArithI" (sqbkt CTy"ArithI"))
+                  ("ArithR" (sqbkt CTy"ArithR")) ("BREAK" [])
+                  ("Branch" (sqbkt CTy"Branch")) ("CP" (sqbkt CTy"CP"))
+                  ("ERET" []) ("Load" (sqbkt CTy"Load"))
+                  ("MultDiv" (sqbkt CTy"MultDiv"))
+                  ("ReservedInstruction" []) ("SYNC" (sqbkt (FTy 5)))
+                  ("SYSCALL" []) ("Shift" (sqbkt CTy"Shift"))
+                  ("Store" (sqbkt CTy"Store")) ("Trap" (sqbkt CTy"Trap"))))))
+
+
+(val _ = Construct
+  (sqbkt ("exception"
+           (sqbkt ("NoException" []) ("UNPREDICTABLE" (sqbkt sTy))))))
+
+
+(val _ = Record
+  ("state"
+    (sqbkt ("BranchStatus" (OTy F64)) ("CP0" CTy"CP0") ("HI" F64)
+           ("HLStatus" CTy"HLStatus") ("LLbit" (OTy bTy)) ("LO" F64)
+           ("MEM" (ATy F64 F8)) ("PC" F64) ("exception" CTy"exception")
+           ("gpr" (ATy (FTy 5) F64)))))
+
+
+(Def "raise'exception" (Var "e" CTy"exception")
+  (Close qVar"state"
+    (TP
+      (sqbkt (LX VTy"a")
+             (ITE
+               (EQ (Dest "exception" CTy"exception" qVar"state")
+                 (Const "NoException" CTy"exception"))
+               (Rupd "exception"
+                 (TP (sqbkt qVar"state" (Var "e" CTy"exception"))))
+               qVar"state")))))
+
+
+(Def "reg'StatusRegister" (Var "x" CTy"StatusRegister")
+  (CS (Var "x" CTy"StatusRegister")
+    (sqbkt ((Rec CTy"StatusRegister"
+               (sqbkt (Var "'rst" (FTy 23)) bVar"BEV" bVar"ERL" bVar"EXL"
+                      bVar"IE" bVar"IM0" bVar"IM1" (Var "KSU" (FTy 2))
+                      bVar"RE"))
+             (Bop Mdfy
+               (Close (TP (sqbkt nVar"i" (AVar bTy)))
+                 (ITB
+                   (sqbkt ((EQ nVar"i" (LN 31))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 4)))
+                          ((EQ nVar"i" (LN 30))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 3)))
+                          ((EQ nVar"i" (LN 29))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 2)))
+                          ((EQ nVar"i" (LN 28))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 1)))
+                          ((EQ nVar"i" (LN 27))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 0)))
+                          ((EQ nVar"i" (LN 26)) bVar"RE")
+                          ((EQ nVar"i" (LN 25))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 7)))
+                          ((EQ nVar"i" (LN 24))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 6)))
+                          ((EQ nVar"i" (LN 23))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 5)))
+                          ((EQ nVar"i" (LN 22)) bVar"BEV")
+                          ((EQ nVar"i" (LN 21))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 19)))
+                          ((EQ nVar"i" (LN 20))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 18)))
+                          ((EQ nVar"i" (LN 19))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 17)))
+                          ((EQ nVar"i" (LN 18))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 16)))
+                          ((EQ nVar"i" (LN 17))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 15)))
+                          ((EQ nVar"i" (LN 16))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 14)))
+                          ((EQ nVar"i" (LN 15))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 13)))
+                          ((EQ nVar"i" (LN 14))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 12)))
+                          ((EQ nVar"i" (LN 13))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 11)))
+                          ((EQ nVar"i" (LN 12))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 10)))
+                          ((EQ nVar"i" (LN 11))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 9)))
+                          ((EQ nVar"i" (LN 10))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 8)))
+                          ((EQ nVar"i" (LN 9)) bVar"IM1")
+                          ((EQ nVar"i" (LN 8)) bVar"IM0")
+                          ((EQ nVar"i" (LN 7))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 22)))
+                          ((EQ nVar"i" (LN 6))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 21)))
+                          ((EQ nVar"i" (LN 5))
+                            (Bop Bit (Var "'rst" (FTy 23)) (LN 20)))
+                          ((EQ nVar"i" (LN 4))
+                            (Bop Bit (Var "KSU" (FTy 2)) (LN 1)))
+                          ((EQ nVar"i" (LN 3))
+                            (Bop Bit (Var "KSU" (FTy 2)) (LN 0)))
+                          ((EQ nVar"i" (LN 2)) bVar"ERL")
+                          ((EQ nVar"i" (LN 1)) bVar"EXL")) bVar"IE"))
+               (LW 0 32))))))
+
+
+(Def "rec'StatusRegister" (Var "x" F32)
+  (Rec CTy"StatusRegister"
+    (sqbkt CC(sqbkt (EX (Var "x" F32) (LN 7) (LN 5) (FTy 3))
+                    (EX (Var "x" F32) (LN 21) (LN 10) (FTy 12))
+                    (EX (Var "x" F32) (LN 25) (LN 23) (FTy 3))
+                    (EX (Var "x" F32) (LN 31) (LN 27) (FTy 5)))
+           (Bop Bit (Var "x" F32) (LN 22)) (Bop Bit (Var "x" F32) (LN 2))
+           (Bop Bit (Var "x" F32) (LN 1)) (Bop Bit (Var "x" F32) (LN 0))
+           (Bop Bit (Var "x" F32) (LN 8)) (Bop Bit (Var "x" F32) (LN 9))
+           (EX (Var "x" F32) (LN 4) (LN 3) (FTy 2))
+           (Bop Bit (Var "x" F32) (LN 26)))))
+
+
+(Def "write'rec'StatusRegister"
+  (TP (sqbkt (AVar F32) (Var "x" CTy"StatusRegister")))
+  (Call "reg'StatusRegister" F32 (Var "x" CTy"StatusRegister")))
+
+
+(Def "write'reg'StatusRegister"
+  (TP (sqbkt (AVar CTy"StatusRegister") (Var "x" F32)))
+  (Call "rec'StatusRegister" CTy"StatusRegister" (Var "x" F32)))
+
+
+(Def "reg'ConfigRegister" (Var "x" CTy"ConfigRegister")
+  (CS (Var "x" CTy"ConfigRegister")
+    (sqbkt ((Rec CTy"ConfigRegister"
+               (sqbkt (Var "'rst" (FTy 31)) bVar"BE"))
+             (Bop Mdfy
+               (Close (TP (sqbkt nVar"i" (AVar bTy)))
+                 (ITB
+                   (sqbkt ((EQ nVar"i" (LN 31))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 15)))
+                          ((EQ nVar"i" (LN 30))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 14)))
+                          ((EQ nVar"i" (LN 29))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 13)))
+                          ((EQ nVar"i" (LN 28))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 12)))
+                          ((EQ nVar"i" (LN 27))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 11)))
+                          ((EQ nVar"i" (LN 26))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 10)))
+                          ((EQ nVar"i" (LN 25))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 9)))
+                          ((EQ nVar"i" (LN 24))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 8)))
+                          ((EQ nVar"i" (LN 23))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 7)))
+                          ((EQ nVar"i" (LN 22))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 6)))
+                          ((EQ nVar"i" (LN 21))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 5)))
+                          ((EQ nVar"i" (LN 20))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 4)))
+                          ((EQ nVar"i" (LN 19))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 3)))
+                          ((EQ nVar"i" (LN 18))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 2)))
+                          ((EQ nVar"i" (LN 17))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 1)))
+                          ((EQ nVar"i" (LN 16))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 0)))
+                          ((EQ nVar"i" (LN 15)) bVar"BE")
+                          ((EQ nVar"i" (LN 14))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 30)))
+                          ((EQ nVar"i" (LN 13))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 29)))
+                          ((EQ nVar"i" (LN 12))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 28)))
+                          ((EQ nVar"i" (LN 11))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 27)))
+                          ((EQ nVar"i" (LN 10))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 26)))
+                          ((EQ nVar"i" (LN 9))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 25)))
+                          ((EQ nVar"i" (LN 8))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 24)))
+                          ((EQ nVar"i" (LN 7))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 23)))
+                          ((EQ nVar"i" (LN 6))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 22)))
+                          ((EQ nVar"i" (LN 5))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 21)))
+                          ((EQ nVar"i" (LN 4))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 20)))
+                          ((EQ nVar"i" (LN 3))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 19)))
+                          ((EQ nVar"i" (LN 2))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 18)))
+                          ((EQ nVar"i" (LN 1))
+                            (Bop Bit (Var "'rst" (FTy 31)) (LN 17))))
+                   (Bop Bit (Var "'rst" (FTy 31)) (LN 16)))) (LW 0 32))))))
+
+
+(Def "rec'ConfigRegister" (Var "x" F32)
+  (Rec CTy"ConfigRegister"
+    (sqbkt CC(sqbkt (EX (Var "x" F32) (LN 14) (LN 0) (FTy 15))
+                    (EX (Var "x" F32) (LN 31) (LN 16) F16))
+           (Bop Bit (Var "x" F32) (LN 15)))))
+
+
+(Def "write'rec'ConfigRegister"
+  (TP (sqbkt (AVar F32) (Var "x" CTy"ConfigRegister")))
+  (Call "reg'ConfigRegister" F32 (Var "x" CTy"ConfigRegister")))
+
+
+(Def "write'reg'ConfigRegister"
+  (TP (sqbkt (AVar CTy"ConfigRegister") (Var "x" F32)))
+  (Call "rec'ConfigRegister" CTy"ConfigRegister" (Var "x" F32)))
+
+
+(Def "reg'CauseRegister" (Var "x" CTy"CauseRegister")
+  (CS (Var "x" CTy"CauseRegister")
+    (sqbkt ((Rec CTy"CauseRegister"
+               (sqbkt (Var "'rst" (FTy 27)) (Var "ExcCode" (FTy 5))))
+             (Bop Mdfy
+               (Close (TP (sqbkt nVar"i" (AVar bTy)))
+                 (ITB
+                   (sqbkt ((EQ nVar"i" (LN 31))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 24)))
+                          ((EQ nVar"i" (LN 30))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 23)))
+                          ((EQ nVar"i" (LN 29))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 22)))
+                          ((EQ nVar"i" (LN 28))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 21)))
+                          ((EQ nVar"i" (LN 27))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 20)))
+                          ((EQ nVar"i" (LN 26))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 19)))
+                          ((EQ nVar"i" (LN 25))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 18)))
+                          ((EQ nVar"i" (LN 24))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 17)))
+                          ((EQ nVar"i" (LN 23))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 16)))
+                          ((EQ nVar"i" (LN 22))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 15)))
+                          ((EQ nVar"i" (LN 21))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 14)))
+                          ((EQ nVar"i" (LN 20))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 13)))
+                          ((EQ nVar"i" (LN 19))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 12)))
+                          ((EQ nVar"i" (LN 18))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 11)))
+                          ((EQ nVar"i" (LN 17))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 10)))
+                          ((EQ nVar"i" (LN 16))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 9)))
+                          ((EQ nVar"i" (LN 15))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 8)))
+                          ((EQ nVar"i" (LN 14))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 7)))
+                          ((EQ nVar"i" (LN 13))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 6)))
+                          ((EQ nVar"i" (LN 12))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 5)))
+                          ((EQ nVar"i" (LN 11))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 4)))
+                          ((EQ nVar"i" (LN 10))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 3)))
+                          ((EQ nVar"i" (LN 9))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 2)))
+                          ((EQ nVar"i" (LN 8))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 1)))
+                          ((EQ nVar"i" (LN 7))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 0)))
+                          ((EQ nVar"i" (LN 6))
+                            (Bop Bit (Var "ExcCode" (FTy 5)) (LN 4)))
+                          ((EQ nVar"i" (LN 5))
+                            (Bop Bit (Var "ExcCode" (FTy 5)) (LN 3)))
+                          ((EQ nVar"i" (LN 4))
+                            (Bop Bit (Var "ExcCode" (FTy 5)) (LN 2)))
+                          ((EQ nVar"i" (LN 3))
+                            (Bop Bit (Var "ExcCode" (FTy 5)) (LN 1)))
+                          ((EQ nVar"i" (LN 2))
+                            (Bop Bit (Var "ExcCode" (FTy 5)) (LN 0)))
+                          ((EQ nVar"i" (LN 1))
+                            (Bop Bit (Var "'rst" (FTy 27)) (LN 26))))
+                   (Bop Bit (Var "'rst" (FTy 27)) (LN 25)))) (LW 0 32))))))
+
+
+(Def "rec'CauseRegister" (Var "x" F32)
+  (Rec CTy"CauseRegister"
+    (sqbkt CC(sqbkt (EX (Var "x" F32) (LN 1) (LN 0) (FTy 2))
+                    (EX (Var "x" F32) (LN 31) (LN 7) (FTy 25)))
+           (EX (Var "x" F32) (LN 6) (LN 2) (FTy 5)))))
+
+
+(Def "write'rec'CauseRegister"
+  (TP (sqbkt (AVar F32) (Var "x" CTy"CauseRegister")))
+  (Call "reg'CauseRegister" F32 (Var "x" CTy"CauseRegister")))
+
+
+(Def "write'reg'CauseRegister"
+  (TP (sqbkt (AVar CTy"CauseRegister") (Var "x" F32)))
+  (Call "rec'CauseRegister" CTy"CauseRegister" (Var "x" F32)))
+
+
+(Def "write'GPR" (TP (sqbkt (Var "value" F64) (Var "n" (FTy 5))))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE (Mop Not (EQ (Var "n" (FTy 5)) (LW 0 5)))
+               (Rupd "gpr"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Fupd (Dest "gpr" (ATy (FTy 5) F64) qVar"state")
+                            (Var "n" (FTy 5)) (Var "value" F64)))))
+               qVar"state")))))
+
+
+(Def "GPR" (Var "n" (FTy 5))
+  (Close qVar"state"
+    (TP
+      (sqbkt (ITE (EQ (Var "n" (FTy 5)) (LW 0 5)) (LW 0 64)
+               (Apply (Dest "gpr" (ATy (FTy 5) F64) qVar"state")
+                 (Var "n" (FTy 5)))) qVar"state"))))
+
+
+(Def "write'CPR"
+  (TP
+    (sqbkt (Var "value" F64) nVar"n" (Var "reg" (FTy 5))
+           (Var "sel" (FTy 3))))
+  (Close qVar"state"
+    (CS (TP (sqbkt nVar"n" (Var "reg" (FTy 5)) (Var "sel" (FTy 3))))
+      (sqbkt ((TP (sqbkt LN 0 (LW 9 5) (LW 0 3)))
+               (TP
+                 (sqbkt LU
+                        (Rupd "CP0"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Rupd "Count"
+                                     (TP
+                                       (sqbkt (Dest "CP0" CTy"CP0"
+                                                qVar"state")
+                                              (EX (Var "value" F64)
+                                                (LN 31) (LN 0) F32))))))))))
+             ((TP (sqbkt LN 0 (LW 12 5) (LW 0 3)))
+               (Let (Var "v" CTy"CP0") (Dest "CP0" CTy"CP0" qVar"state")
+                 (TP
+                   (sqbkt LU
+                          (Rupd "CP0"
+                            (TP
+                              (sqbkt qVar"state"
+                                     (Rupd "Status"
+                                       (TP
+                                         (sqbkt (Var "v" CTy"CP0")
+                                                (Call
+                                                  "write'reg'StatusRegister"
+                                                  CTy"StatusRegister"
+                                                  (TP
+                                                    (sqbkt (Dest "Status"
+                                                             CTy"StatusRegister"
+                                                             (Var "v"
+                                                               CTy"CP0"))
+                                                           (EX
+                                                             (Var "value"
+                                                               F64)
+                                                             (LN 31)
+                                                             (LN 0) F32))))))))))))))
+             ((TP (sqbkt LN 0 (LW 13 5) (LW 0 3)))
+               (Let (Var "v" CTy"CP0") (Dest "CP0" CTy"CP0" qVar"state")
+                 (TP
+                   (sqbkt LU
+                          (Rupd "CP0"
+                            (TP
+                              (sqbkt qVar"state"
+                                     (Rupd "Cause"
+                                       (TP
+                                         (sqbkt (Var "v" CTy"CP0")
+                                                (Call
+                                                  "write'reg'CauseRegister"
+                                                  CTy"CauseRegister"
+                                                  (TP
+                                                    (sqbkt (Dest "Cause"
+                                                             CTy"CauseRegister"
+                                                             (Var "v"
+                                                               CTy"CP0"))
+                                                           (EX
+                                                             (Var "value"
+                                                               F64)
+                                                             (LN 31)
+                                                             (LN 0) F32))))))))))))))
+             ((TP (sqbkt LN 0 (LW 14 5) (LW 0 3)))
+               (TP
+                 (sqbkt LU
+                        (Rupd "CP0"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Rupd "EPC"
+                                     (TP
+                                       (sqbkt (Dest "CP0" CTy"CP0"
+                                                qVar"state")
+                                              (Var "value" F64))))))))))
+             ((TP (sqbkt LN 0 (LW 16 5) (LW 0 3)))
+               (Let (Var "v" CTy"CP0") (Dest "CP0" CTy"CP0" qVar"state")
+                 (TP
+                   (sqbkt LU
+                          (Rupd "CP0"
+                            (TP
+                              (sqbkt qVar"state"
+                                     (Rupd "Config"
+                                       (TP
+                                         (sqbkt (Var "v" CTy"CP0")
+                                                (Call
+                                                  "write'reg'ConfigRegister"
+                                                  CTy"ConfigRegister"
+                                                  (TP
+                                                    (sqbkt (Dest "Config"
+                                                             CTy"ConfigRegister"
+                                                             (Var "v"
+                                                               CTy"CP0"))
+                                                           (EX
+                                                             (Var "value"
+                                                               F64)
+                                                             (LN 31)
+                                                             (LN 0) F32))))))))))))))
+             ((TP (sqbkt LN 0 (LW 30 5) (LW 0 3)))
+               (TP
+                 (sqbkt LU
+                        (Rupd "CP0"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Rupd "ErrorEPC"
+                                     (TP
+                                       (sqbkt (Dest "CP0" CTy"CP0"
+                                                qVar"state")
+                                              (Var "value" F64))))))))))
+             ((AVar (PTy nTy (PTy (FTy 5) (FTy 3))))
+               (TP (sqbkt LU qVar"state")))))))
+
+
+(Def "CPR" (TP (sqbkt nVar"n" (Var "reg" (FTy 5)) (Var "sel" (FTy 3))))
+  (Close qVar"state"
+    (CS (TP (sqbkt nVar"n" (Var "reg" (FTy 5)) (Var "sel" (FTy 3))))
+      (sqbkt ((TP (sqbkt LN 0 (LW 9 5) (LW 0 3)))
+               (TP
+                 (sqbkt (Mop (Cast F64)
+                          (Dest "Count" F32
+                            (Dest "CP0" CTy"CP0" qVar"state")))
+                        qVar"state")))
+             ((TP (sqbkt LN 0 (LW 12 5) (LW 0 3)))
+               (TP
+                 (sqbkt (Mop (Cast F64)
+                          (Call "reg'StatusRegister" F32
+                            (Dest "Status" CTy"StatusRegister"
+                              (Dest "CP0" CTy"CP0" qVar"state"))))
+                        qVar"state")))
+             ((TP (sqbkt LN 0 (LW 13 5) (LW 0 3)))
+               (TP
+                 (sqbkt (Mop (Cast F64)
+                          (Call "reg'CauseRegister" F32
+                            (Dest "Cause" CTy"CauseRegister"
+                              (Dest "CP0" CTy"CP0" qVar"state"))))
+                        qVar"state")))
+             ((TP (sqbkt LN 0 (LW 14 5) (LW 0 3)))
+               (TP
+                 (sqbkt (Dest "EPC" F64 (Dest "CP0" CTy"CP0" qVar"state"))
+                        qVar"state")))
+             ((TP (sqbkt LN 0 (LW 16 5) (LW 0 3)))
+               (TP
+                 (sqbkt (Mop (Cast F64)
+                          (Call "reg'ConfigRegister" F32
+                            (Dest "Config" CTy"ConfigRegister"
+                              (Dest "CP0" CTy"CP0" qVar"state"))))
+                        qVar"state")))
+             ((TP (sqbkt LN 0 (LW 30 5) (LW 0 3)))
+               (TP
+                 (sqbkt (Dest "ErrorEPC" F64
+                          (Dest "CP0" CTy"CP0" qVar"state")) qVar"state")))
+             ((AVar (PTy nTy (PTy (FTy 5) (FTy 3))))
+               (TP (sqbkt (LX F64) qVar"state")))))))
+
+
+(Def0 "BYTE" (LW 0 3))
+
+
+(Def0 "HALFWORD" (LW 1 3))
+
+
+(Def0 "WORD" (LW 3 3))
+
+
+(Def0 "DOUBLEWORD" (LW 7 3))
+
+
+(Def0 "PSIZE" (LN 64))
+
+
+(Def "UserMode" qVar"state"
+  (TP
+    (sqbkt (Bop And
+             (Bop And
+               (EQ
+                 (Dest "KSU" (FTy 2)
+                   (Dest "Status" CTy"StatusRegister"
+                     (Dest "CP0" CTy"CP0" qVar"state"))) (LW 2 2))
+               (Mop Not
+                 (Dest "EXL" bTy
+                   (Dest "Status" CTy"StatusRegister"
+                     (Dest "CP0" CTy"CP0" qVar"state")))))
+             (Mop Not
+               (Dest "ERL" bTy
+                 (Dest "Status" CTy"StatusRegister"
+                   (Dest "CP0" CTy"CP0" qVar"state"))))) qVar"state")))
+
+
+(Def "BigEndianMem" qVar"state"
+  (TP
+    (sqbkt (Dest "BE" bTy
+             (Dest "Config" CTy"ConfigRegister"
+               (Dest "CP0" CTy"CP0" qVar"state"))) qVar"state")))
+
+
+(Def "ReverseEndian" qVar"state"
+  (TP
+    (sqbkt (Mop (Cast F1)
+             (Bop And
+               (Dest "RE" bTy
+                 (Dest "Status" CTy"StatusRegister"
+                   (Dest "CP0" CTy"CP0" qVar"state")))
+               (Mop Fst
+                 (Apply (Const "UserMode" (ATy qTy (PTy bTy qTy)))
+                   qVar"state")))) qVar"state")))
+
+
+(Def "BigEndianCPU" qVar"state"
+  (TP
+    (sqbkt (Bop BXor
+             (Mop (Cast F1)
+               (Mop Fst
+                 (Apply (Const "BigEndianMem" (ATy qTy (PTy bTy qTy)))
+                   qVar"state")))
+             (Mop Fst
+               (Apply (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                 qVar"state"))) qVar"state")))
+
+
+(Def "AddressTranslation"
+  (TP
+    (sqbkt (Var "vAddr" F64) (Var "IorD" CTy"IorD") (Var "LorS" CTy"LorS")))
+  (TP (sqbkt (Var "vAddr" F64) (LX (FTy 3)))))
+
+
+(Def "LoadMemory"
+  (TP
+    (sqbkt (Var "CCA" (FTy 3)) (Var "AccessLength" (FTy 3))
+           (Var "pAddr" F64) (Var "vAddr" F64) (Var "IorD" CTy"IorD")))
+  (Close qVar"state"
+    (Let (Var "a" F64) (Bop BAnd (Var "pAddr" F64) (Mop BNot (LW 7 64)))
+      (TP
+        (sqbkt (ITE
+                 (EQ
+                   (Mop Fst
+                     (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                       qVar"state")) (LW 1 1))
+                 (CC(sqbkt (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Var "a" F64))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 1 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 2 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 3 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 4 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 5 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 6 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 7 64)))))
+                 (CC(sqbkt (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 7 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 6 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 5 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 4 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 3 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 2 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 1 64)))
+                           (Apply (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Var "a" F64))))) qVar"state")))))
+
+
+(Def "StoreMemory"
+  (TP
+    (sqbkt (Var "CCA" (FTy 3)) (Var "AccessLength" (FTy 3))
+           (Var "MemElem" F64) (Var "pAddr" F64) (Var "vAddr" F64)
+           (Var "IorD" CTy"IorD")))
+  (Close qVar"state"
+    (Let (Var "a" F64) (Bop BAnd (Var "pAddr" F64) (Mop BNot (LW 7 64)))
+      (Let (Var "l" (FTy 3)) (EX (Var "vAddr" F64) (LN 2) (LN 0) (FTy 3))
+        (Let (Var "h" (FTy 3))
+          (Bop Add (Var "l" (FTy 3)) (Var "AccessLength" (FTy 3)))
+          (ITE
+            (EQ
+              (Mop Fst
+                (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                  qVar"state")) (LW 1 1))
+            (Let qVar"s"
+              (ITE (EQ (Var "l" (FTy 3)) (LW 0 3))
+                (Rupd "MEM"
+                  (TP
+                    (sqbkt qVar"state"
+                           (Fupd (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Var "a" F64)
+                             (EX (Var "MemElem" F64) (LN 63) (LN 56) F8)))))
+                qVar"state")
+              (Let qVar"s"
+                (ITE
+                  (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 1 3))
+                    (Bop Ule (LW 1 3) (Var "h" (FTy 3))))
+                  (Rupd "MEM"
+                    (TP
+                      (sqbkt qVar"s"
+                             (Fupd (Dest "MEM" (ATy F64 F8) qVar"s")
+                               (Bop Add (Var "a" F64) (LW 1 64))
+                               (EX (Var "MemElem" F64) (LN 55) (LN 48) F8)))))
+                  qVar"s")
+                (Let qVar"s"
+                  (ITE
+                    (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 2 3))
+                      (Bop Ule (LW 2 3) (Var "h" (FTy 3))))
+                    (Rupd "MEM"
+                      (TP
+                        (sqbkt qVar"s"
+                               (Fupd (Dest "MEM" (ATy F64 F8) qVar"s")
+                                 (Bop Add (Var "a" F64) (LW 2 64))
+                                 (EX (Var "MemElem" F64) (LN 47) (LN 40)
+                                   F8))))) qVar"s")
+                  (Let qVar"s"
+                    (ITE
+                      (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 3 3))
+                        (Bop Ule (LW 3 3) (Var "h" (FTy 3))))
+                      (Rupd "MEM"
+                        (TP
+                          (sqbkt qVar"s"
+                                 (Fupd (Dest "MEM" (ATy F64 F8) qVar"s")
+                                   (Bop Add (Var "a" F64) (LW 3 64))
+                                   (EX (Var "MemElem" F64) (LN 39) (LN 32)
+                                     F8))))) qVar"s")
+                    (Let qVar"s"
+                      (ITE
+                        (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 4 3))
+                          (Bop Ule (LW 4 3) (Var "h" (FTy 3))))
+                        (Rupd "MEM"
+                          (TP
+                            (sqbkt qVar"s"
+                                   (Fupd (Dest "MEM" (ATy F64 F8) qVar"s")
+                                     (Bop Add (Var "a" F64) (LW 4 64))
+                                     (EX (Var "MemElem" F64) (LN 31)
+                                       (LN 24) F8))))) qVar"s")
+                      (Let qVar"s"
+                        (ITE
+                          (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 5 3))
+                            (Bop Ule (LW 5 3) (Var "h" (FTy 3))))
+                          (Rupd "MEM"
+                            (TP
+                              (sqbkt qVar"s"
+                                     (Fupd
+                                       (Dest "MEM" (ATy F64 F8) qVar"s")
+                                       (Bop Add (Var "a" F64) (LW 5 64))
+                                       (EX (Var "MemElem" F64) (LN 23)
+                                         (LN 16) F8))))) qVar"s")
+                        (Let qVar"s"
+                          (ITE
+                            (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 6 3))
+                              (Bop Ule (LW 6 3) (Var "h" (FTy 3))))
+                            (Rupd "MEM"
+                              (TP
+                                (sqbkt qVar"s"
+                                       (Fupd
+                                         (Dest "MEM" (ATy F64 F8) qVar"s")
+                                         (Bop Add (Var "a" F64) (LW 6 64))
+                                         (EX (Var "MemElem" F64) (LN 15)
+                                           (LN 8) F8))))) qVar"s")
+                          (TP
+                            (sqbkt LU
+                                   (ITE
+                                     (Bop And
+                                       (Bop Ule (Var "l" (FTy 3))
+                                         (LW 7 3))
+                                       (Bop Ule (LW 7 3)
+                                         (Var "h" (FTy 3))))
+                                     (Rupd "MEM"
+                                       (TP
+                                         (sqbkt qVar"s"
+                                                (Fupd
+                                                  (Dest "MEM" (ATy F64 F8)
+                                                    qVar"s")
+                                                  (Bop Add (Var "a" F64)
+                                                    (LW 7 64))
+                                                  (EX (Var "MemElem" F64)
+                                                    (LN 7) (LN 0) F8)))))
+                                     qVar"s"))))))))))
+            (Let qVar"s"
+              (ITE
+                (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 7 3))
+                  (Bop Ule (LW 7 3) (Var "h" (FTy 3))))
+                (Rupd "MEM"
+                  (TP
+                    (sqbkt qVar"state"
+                           (Fupd (Dest "MEM" (ATy F64 F8) qVar"state")
+                             (Bop Add (Var "a" F64) (LW 7 64))
+                             (EX (Var "MemElem" F64) (LN 63) (LN 56) F8)))))
+                qVar"state")
+              (Let qVar"s"
+                (ITE
+                  (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 6 3))
+                    (Bop Ule (LW 6 3) (Var "h" (FTy 3))))
+                  (Rupd "MEM"
+                    (TP
+                      (sqbkt qVar"s"
+                             (Fupd (Dest "MEM" (ATy F64 F8) qVar"s")
+                               (Bop Add (Var "a" F64) (LW 6 64))
+                               (EX (Var "MemElem" F64) (LN 55) (LN 48) F8)))))
+                  qVar"s")
+                (Let qVar"s"
+                  (ITE
+                    (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 5 3))
+                      (Bop Ule (LW 5 3) (Var "h" (FTy 3))))
+                    (Rupd "MEM"
+                      (TP
+                        (sqbkt qVar"s"
+                               (Fupd (Dest "MEM" (ATy F64 F8) qVar"s")
+                                 (Bop Add (Var "a" F64) (LW 5 64))
+                                 (EX (Var "MemElem" F64) (LN 47) (LN 40)
+                                   F8))))) qVar"s")
+                  (Let qVar"s"
+                    (ITE
+                      (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 4 3))
+                        (Bop Ule (LW 4 3) (Var "h" (FTy 3))))
+                      (Rupd "MEM"
+                        (TP
+                          (sqbkt qVar"s"
+                                 (Fupd (Dest "MEM" (ATy F64 F8) qVar"s")
+                                   (Bop Add (Var "a" F64) (LW 4 64))
+                                   (EX (Var "MemElem" F64) (LN 39) (LN 32)
+                                     F8))))) qVar"s")
+                    (Let qVar"s"
+                      (ITE
+                        (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 3 3))
+                          (Bop Ule (LW 3 3) (Var "h" (FTy 3))))
+                        (Rupd "MEM"
+                          (TP
+                            (sqbkt qVar"s"
+                                   (Fupd (Dest "MEM" (ATy F64 F8) qVar"s")
+                                     (Bop Add (Var "a" F64) (LW 3 64))
+                                     (EX (Var "MemElem" F64) (LN 31)
+                                       (LN 24) F8))))) qVar"s")
+                      (Let qVar"s"
+                        (ITE
+                          (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 2 3))
+                            (Bop Ule (LW 2 3) (Var "h" (FTy 3))))
+                          (Rupd "MEM"
+                            (TP
+                              (sqbkt qVar"s"
+                                     (Fupd
+                                       (Dest "MEM" (ATy F64 F8) qVar"s")
+                                       (Bop Add (Var "a" F64) (LW 2 64))
+                                       (EX (Var "MemElem" F64) (LN 23)
+                                         (LN 16) F8))))) qVar"s")
+                        (Let qVar"s"
+                          (ITE
+                            (Bop And (Bop Ule (Var "l" (FTy 3)) (LW 1 3))
+                              (Bop Ule (LW 1 3) (Var "h" (FTy 3))))
+                            (Rupd "MEM"
+                              (TP
+                                (sqbkt qVar"s"
+                                       (Fupd
+                                         (Dest "MEM" (ATy F64 F8) qVar"s")
+                                         (Bop Add (Var "a" F64) (LW 1 64))
+                                         (EX (Var "MemElem" F64) (LN 15)
+                                           (LN 8) F8))))) qVar"s")
+                          (TP
+                            (sqbkt LU
+                                   (ITE (EQ (Var "l" (FTy 3)) (LW 0 3))
+                                     (Rupd "MEM"
+                                       (TP
+                                         (sqbkt qVar"s"
+                                                (Fupd
+                                                  (Dest "MEM" (ATy F64 F8)
+                                                    qVar"s") (Var "a" F64)
+                                                  (EX (Var "MemElem" F64)
+                                                    (LN 7) (LN 0) F8)))))
+                                     qVar"s"))))))))))))))))
+
+
+(Def "ExceptionCode" (Var "ExceptionType" CTy"ExceptionType")
+  (CS (Var "ExceptionType" CTy"ExceptionType")
+    (sqbkt ((LC "AdEL" CTy"ExceptionType") (LW 4 5))
+           ((LC "AdES" CTy"ExceptionType") (LW 5 5))
+           ((LC "Sys" CTy"ExceptionType") (LW 8 5))
+           ((LC "Bp" CTy"ExceptionType") (LW 9 5))
+           ((LC "RI" CTy"ExceptionType") (LW 10 5))
+           ((LC "Ov" CTy"ExceptionType") (LW 12 5))
+           ((LC "Tr" CTy"ExceptionType") (LW 13 5)))))
+
+
+(Def "SignalException" (Var "ExceptionType" CTy"ExceptionType")
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Mop Not
+          (Dest "EXL" bTy
+            (Dest "Status" CTy"StatusRegister"
+              (Dest "CP0" CTy"CP0" qVar"state"))))
+        (Rupd "CP0"
+          (TP
+            (sqbkt qVar"state"
+                   (Rupd "EPC"
+                     (TP
+                       (sqbkt (Dest "CP0" CTy"CP0" qVar"state")
+                              (Dest "PC" F64 qVar"state")))))))
+        qVar"state")
+      (Let (Var "v" CTy"CP0") (Dest "CP0" CTy"CP0" qVar"s")
+        (Let qVar"s"
+          (Rupd "CP0"
+            (TP
+              (sqbkt qVar"s"
+                     (Rupd "Cause"
+                       (TP
+                         (sqbkt (Var "v" CTy"CP0")
+                                (Rupd "ExcCode"
+                                  (TP
+                                    (sqbkt (Dest "Cause"
+                                             CTy"CauseRegister"
+                                             (Var "v" CTy"CP0"))
+                                           (Call "ExceptionCode" (FTy 5)
+                                             (Var "ExceptionType"
+                                               CTy"ExceptionType")))))))))))
+          (Let (Var "v" CTy"CP0") (Dest "CP0" CTy"CP0" qVar"s")
+            (Let qVar"s"
+              (Rupd "CP0"
+                (TP
+                  (sqbkt qVar"s"
+                         (Rupd "Status"
+                           (TP
+                             (sqbkt (Var "v" CTy"CP0")
+                                    (Rupd "EXL"
+                                      (TP
+                                        (sqbkt (Dest "Status"
+                                                 CTy"StatusRegister"
+                                                 (Var "v" CTy"CP0")) LT)))))))))
+              (Let (Var "v" F64)
+                (ITE
+                  (Dest "BEV" bTy
+                    (Dest "Status" CTy"StatusRegister"
+                      (Dest "CP0" CTy"CP0" qVar"s")))
+                  (LW 18446744072631616000 64)
+                  (LW 18446744071562067968 64))
+                (TP
+                  (sqbkt LU
+                         (Rupd "PC"
+                           (TP
+                             (sqbkt qVar"s"
+                                    CC(sqbkt (EX (Var "v" F64) (LN 63)
+                                               (LN 30) (FTy 34))
+                                             (Bop Add
+                                               (EX (Var "v" F64) (LN 29)
+                                                 (LN 0) (FTy 30))
+                                               (LW 384 30))))))))))))))))
+
+
+(Def "NotWordValue" (Var "value" F64)
+  (Let (Var "top" F32) (EX (Var "value" F64) (LN 63) (LN 32) F32)
+    (ITE (Bop Bit (Var "value" F64) (LN 31))
+      (Mop Not (EQ (Var "top" F32) (LW 4294967295 32)))
+      (Mop Not (EQ (Var "top" F32) (LW 0 32))))))
+
+
+(Def "dfn'ADDI"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Call "NotWordValue" bTy
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state")))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"ADDI: NotWordValue"))) qVar"state")) qVar"state")
+      (Let (Var "v" (FTy 33))
+        (Bop Add
+          (EX
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"s")) (LN 32) (LN 0) (FTy 33))
+          (Mop (SE (FTy 33)) (Var "immediate" F16)))
+        (ITE
+          (Mop Not
+            (EQ (Bop Bit (Var "v" (FTy 33)) (LN 32))
+              (Bop Bit (Var "v" (FTy 33)) (LN 31))))
+          (Apply
+            (Call "SignalException" (ATy qTy (PTy uTy qTy))
+              (LC "Ov" CTy"ExceptionType")) qVar"s")
+          (Apply
+            (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+              (TP
+                (sqbkt (Mop (SE F64)
+                         (EX (Var "v" (FTy 33)) (LN 31) (LN 0) F32))
+                       (Var "rt" (FTy 5))))) qVar"s"))))))
+
+
+(Def "dfn'ADDIU"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Call "NotWordValue" bTy
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state")))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"ADDIU: NotWordValue"))) qVar"state")) qVar"state")
+      (Apply
+        (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+          (TP
+            (sqbkt (Mop (SE F64)
+                     (Bop Add
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rs" (FTy 5))) qVar"s")) (LN 31)
+                         (LN 0) F32) (Mop (SE F32) (Var "immediate" F16))))
+                   (Var "rt" (FTy 5))))) qVar"s"))))
+
+
+(Def "dfn'DADDI"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Let (Var "v" (FTy 65))
+      (Bop Add
+        (Mop (SE (FTy 65))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state"))) (Mop (SE (FTy 65)) (Var "immediate" F16)))
+      (ITE
+        (Mop Not
+          (EQ (Bop Bit (Var "v" (FTy 65)) (LN 64))
+            (Bop Bit (Var "v" (FTy 65)) (LN 63))))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "Ov" CTy"ExceptionType")) qVar"state")
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (EX (Var "v" (FTy 65)) (LN 63) (LN 0) F64)
+                     (Var "rt" (FTy 5))))) qVar"state")))))
+
+
+(Def "dfn'DADDIU"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Add
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop (SE F64) (Var "immediate" F16)))
+                 (Var "rt" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'SLTI"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop (Cast F64)
+                   (Bop Lt
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rs" (FTy 5))) qVar"state"))
+                     (Mop (SE F64) (Var "immediate" F16))))
+                 (Var "rt" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'SLTIU"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop (Cast F64)
+                   (Bop Ult
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rs" (FTy 5))) qVar"state"))
+                     (Mop (SE F64) (Var "immediate" F16))))
+                 (Var "rt" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'ANDI"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop BAnd
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop (Cast F64) (Var "immediate" F16)))
+                 (Var "rt" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'ORI"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop BOr
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop (Cast F64) (Var "immediate" F16)))
+                 (Var "rt" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'XORI"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop BXor
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop (Cast F64) (Var "immediate" F16)))
+                 (Var "rt" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'LUI" (TP (sqbkt (Var "rt" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop (SE F64)
+                   (CC(sqbkt (Var "immediate" F16) (LW 0 16))))
+                 (Var "rt" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'ADD"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Bop Or
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"state")))
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                qVar"state"))))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"ADD: NotWordValue"))) qVar"state")) qVar"state")
+      (Let (Var "v" (FTy 33))
+        (Bop Add
+          (EX
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"s")) (LN 32) (LN 0) (FTy 33))
+          (EX
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                qVar"s")) (LN 32) (LN 0) (FTy 33)))
+        (ITE
+          (Mop Not
+            (EQ (Bop Bit (Var "v" (FTy 33)) (LN 32))
+              (Bop Bit (Var "v" (FTy 33)) (LN 31))))
+          (Apply
+            (Call "SignalException" (ATy qTy (PTy uTy qTy))
+              (LC "Ov" CTy"ExceptionType")) qVar"s")
+          (Apply
+            (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+              (TP
+                (sqbkt (Mop (SE F64)
+                         (EX (Var "v" (FTy 33)) (LN 31) (LN 0) F32))
+                       (Var "rd" (FTy 5))))) qVar"s"))))))
+
+
+(Def "dfn'ADDU"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Bop Or
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"state")))
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                qVar"state"))))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"ADDU: NotWordValue"))) qVar"state")) qVar"state")
+      (Apply
+        (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+          (TP
+            (sqbkt (Mop (SE F64)
+                     (Bop Add
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rs" (FTy 5))) qVar"s")) (LN 31)
+                         (LN 0) F32)
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rt" (FTy 5))) qVar"s")) (LN 31)
+                         (LN 0) F32))) (Var "rd" (FTy 5))))) qVar"s"))))
+
+
+(Def "dfn'SUB"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Bop Or
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"state")))
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                qVar"state"))))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"SUB: NotWordValue"))) qVar"state")) qVar"state")
+      (Let (Var "v" (FTy 33))
+        (Bop Sub
+          (EX
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"s")) (LN 32) (LN 0) (FTy 33))
+          (EX
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                qVar"s")) (LN 32) (LN 0) (FTy 33)))
+        (ITE
+          (Mop Not
+            (EQ (Bop Bit (Var "v" (FTy 33)) (LN 32))
+              (Bop Bit (Var "v" (FTy 33)) (LN 31))))
+          (Apply
+            (Call "SignalException" (ATy qTy (PTy uTy qTy))
+              (LC "Ov" CTy"ExceptionType")) qVar"s")
+          (Apply
+            (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+              (TP
+                (sqbkt (Mop (SE F64)
+                         (EX (Var "v" (FTy 33)) (LN 31) (LN 0) F32))
+                       (Var "rd" (FTy 5))))) qVar"s"))))))
+
+
+(Def "dfn'SUBU"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Bop Or
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"state")))
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                qVar"state"))))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"SUBU: NotWordValue"))) qVar"state")) qVar"state")
+      (Apply
+        (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+          (TP
+            (sqbkt (Mop (SE F64)
+                     (Bop Sub
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rs" (FTy 5))) qVar"s")) (LN 32)
+                         (LN 0) (FTy 33))
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rt" (FTy 5))) qVar"s")) (LN 32)
+                         (LN 0) (FTy 33)))) (Var "rd" (FTy 5))))) qVar"s"))))
+
+
+(Def "dfn'DADD"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Let (Var "v" (FTy 65))
+      (Bop Add
+        (Mop (SE (FTy 65))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state")))
+        (Mop (SE (FTy 65))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state"))))
+      (ITE
+        (Mop Not
+          (EQ (Bop Bit (Var "v" (FTy 65)) (LN 64))
+            (Bop Bit (Var "v" (FTy 65)) (LN 63))))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "Ov" CTy"ExceptionType")) qVar"state")
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (EX (Var "v" (FTy 65)) (LN 63) (LN 0) F64)
+                     (Var "rd" (FTy 5))))) qVar"state")))))
+
+
+(Def "dfn'DADDU"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Add
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state")))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'DSUB"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Let (Var "v" (FTy 65))
+      (Bop Sub
+        (Mop (SE (FTy 65))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state")))
+        (Mop (SE (FTy 65))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state"))))
+      (ITE
+        (Mop Not
+          (EQ (Bop Bit (Var "v" (FTy 65)) (LN 64))
+            (Bop Bit (Var "v" (FTy 65)) (LN 63))))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "Ov" CTy"ExceptionType")) qVar"state")
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (EX (Var "v" (FTy 65)) (LN 63) (LN 0) F64)
+                     (Var "rd" (FTy 5))))) qVar"state")))))
+
+
+(Def "dfn'DSUBU"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Sub
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state")))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'SLT"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop (Cast F64)
+                   (Bop Lt
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rs" (FTy 5))) qVar"state"))
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rt" (FTy 5))) qVar"state"))))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'SLTU"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop (Cast F64)
+                   (Bop Ult
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rs" (FTy 5))) qVar"state"))
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rt" (FTy 5))) qVar"state"))))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'AND"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop BAnd
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state")))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'OR"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop BOr
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state")))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'XOR"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop BXor
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state")))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'NOR"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop BNot
+                   (Bop BOr
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rs" (FTy 5))) qVar"state"))
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rt" (FTy 5))) qVar"state"))))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'MULT" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Bop Or
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"state")))
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                qVar"state"))))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"MULT: NotWordValue"))) qVar"state")) qVar"state")
+      (Let (Var "v" F64)
+        (Bop Mul
+          (Mop (SE F64)
+            (EX
+              (Mop Fst
+                (Apply
+                  (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                  qVar"s")) (LN 31) (LN 0) F32))
+          (Mop (SE F64)
+            (EX
+              (Mop Fst
+                (Apply
+                  (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                  qVar"s")) (LN 31) (LN 0) F32)))
+        (TP
+          (sqbkt LU
+                 (Rupd "HLStatus"
+                   (TP
+                     (sqbkt (Rupd "HI"
+                              (TP
+                                (sqbkt (Rupd "LO"
+                                         (TP
+                                           (sqbkt qVar"s"
+                                                  (Mop (SE F64)
+                                                    (EX (Var "v" F64)
+                                                      (LN 31) (LN 0) F32)))))
+                                       (Mop (SE F64)
+                                         (EX (Var "v" F64) (LN 63) (LN 32)
+                                           F32)))))
+                            (LC "HLarith" CTy"HLStatus"))))))))))
+
+
+(Def "dfn'MULTU" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Bop Or
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                qVar"state")))
+          (Call "NotWordValue" bTy
+            (Mop Fst
+              (Apply
+                (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                qVar"state"))))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"MULTU: NotWordValue"))) qVar"state")) qVar"state")
+      (Let (Var "v" F64)
+        (Bop Mul
+          (Mop (Cast F64)
+            (EX
+              (Mop Fst
+                (Apply
+                  (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                  qVar"s")) (LN 31) (LN 0) F32))
+          (Mop (Cast F64)
+            (EX
+              (Mop Fst
+                (Apply
+                  (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                  qVar"s")) (LN 31) (LN 0) F32)))
+        (TP
+          (sqbkt LU
+                 (Rupd "HLStatus"
+                   (TP
+                     (sqbkt (Rupd "HI"
+                              (TP
+                                (sqbkt (Rupd "LO"
+                                         (TP
+                                           (sqbkt qVar"s"
+                                                  (Mop (SE F64)
+                                                    (EX (Var "v" F64)
+                                                      (LN 31) (LN 0) F32)))))
+                                       (Mop (SE F64)
+                                         (EX (Var "v" F64) (LN 63) (LN 32)
+                                           F32)))))
+                            (LC "HLarith" CTy"HLStatus"))))))))))
+
+
+(Def "dfn'DMULT" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (Let (Var "v" (FTy 128))
+      (Bop Mul
+        (Mop (SE (FTy 128))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state")))
+        (Mop (SE (FTy 128))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state"))))
+      (TP
+        (sqbkt LU
+               (Rupd "HLStatus"
+                 (TP
+                   (sqbkt (Rupd "HI"
+                            (TP
+                              (sqbkt (Rupd "LO"
+                                       (TP
+                                         (sqbkt qVar"state"
+                                                (EX (Var "v" (FTy 128))
+                                                  (LN 63) (LN 0) F64))))
+                                     (EX (Var "v" (FTy 128)) (LN 127)
+                                       (LN 64) F64))))
+                          (LC "HLarith" CTy"HLStatus")))))))))
+
+
+(Def "dfn'DMULTU" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (Let (Var "v" (FTy 128))
+      (Bop Mul
+        (Mop (Cast (FTy 128))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state")))
+        (Mop (Cast (FTy 128))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state"))))
+      (TP
+        (sqbkt LU
+               (Rupd "HLStatus"
+                 (TP
+                   (sqbkt (Rupd "HI"
+                            (TP
+                              (sqbkt (Rupd "LO"
+                                       (TP
+                                         (sqbkt qVar"state"
+                                                (EX (Var "v" (FTy 128))
+                                                  (LN 63) (LN 0) F64))))
+                                     (EX (Var "v" (FTy 128)) (LN 127)
+                                       (LN 64) F64))))
+                          (LC "HLarith" CTy"HLStatus")))))))))
+
+
+(Def "dfn'DIV" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (EQ
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state")) (LW 0 64))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"DIV: divide by zero"))) qVar"state")) qVar"state")
+      (Let qVar"s"
+        (ITE
+          (Bop Or
+            (Call "NotWordValue" bTy
+              (Mop Fst
+                (Apply
+                  (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                  qVar"s")))
+            (Call "NotWordValue" bTy
+              (Mop Fst
+                (Apply
+                  (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                  qVar"s"))))
+          (Mop Snd
+            (Apply
+              (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                (Call "UNPREDICTABLE" CTy"exception"
+                  (LS"DIV: NotWordValue"))) qVar"s")) qVar"s")
+        (Let qVar"s"
+          (Rupd "LO"
+            (TP
+              (sqbkt qVar"s"
+                     (Mop (SE F64)
+                       (Bop Quot
+                         (EX
+                           (Mop Fst
+                             (Apply
+                               (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                 (Var "rs" (FTy 5))) qVar"s")) (LN 31)
+                           (LN 0) F32)
+                         (EX
+                           (Mop Fst
+                             (Apply
+                               (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                 (Var "rt" (FTy 5))) qVar"s")) (LN 31)
+                           (LN 0) F32))))))
+          (TP
+            (sqbkt LU
+                   (Rupd "HLStatus"
+                     (TP
+                       (sqbkt (Rupd "HI"
+                                (TP
+                                  (sqbkt qVar"s"
+                                         (Mop (SE F64)
+                                           (Bop Rem
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rs" (FTy 5)))
+                                                   qVar"s")) (LN 31)
+                                               (LN 0) F32)
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"s")) (LN 31)
+                                               (LN 0) F32))))))
+                              (LC "HLarith" CTy"HLStatus")))))))))))
+
+
+(Def "dfn'DIVU" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (EQ
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state")) (LW 0 64))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"DIVU: divide by zero"))) qVar"state")) qVar"state")
+      (Let qVar"s"
+        (ITE
+          (Bop Or
+            (Call "NotWordValue" bTy
+              (Mop Fst
+                (Apply
+                  (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+                  qVar"s")))
+            (Call "NotWordValue" bTy
+              (Mop Fst
+                (Apply
+                  (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+                  qVar"s"))))
+          (Mop Snd
+            (Apply
+              (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                (Call "UNPREDICTABLE" CTy"exception"
+                  (LS"DIVU: NotWordValue"))) qVar"s")) qVar"s")
+        (TP
+          (sqbkt LU
+                 (Rupd "HLStatus"
+                   (TP
+                     (sqbkt (Rupd "HI"
+                              (TP
+                                (sqbkt (Rupd "LO"
+                                         (TP
+                                           (sqbkt qVar"s"
+                                                  (Mop (SE F64)
+                                                    (Bop Div
+                                                      (EX
+                                                        (Mop Fst
+                                                          (Apply
+                                                            (Call "GPR"
+                                                              (ATy qTy
+                                                                (PTy F64
+                                                                  qTy))
+                                                              (Var "rs"
+                                                                (FTy 5)))
+                                                            qVar"s"))
+                                                        (LN 31) (LN 0)
+                                                        F32)
+                                                      (EX
+                                                        (Mop Fst
+                                                          (Apply
+                                                            (Call "GPR"
+                                                              (ATy qTy
+                                                                (PTy F64
+                                                                  qTy))
+                                                              (Var "rt"
+                                                                (FTy 5)))
+                                                            qVar"s"))
+                                                        (LN 31) (LN 0)
+                                                        F32))))))
+                                       (Mop (SE F64)
+                                         (Bop Mod
+                                           (EX
+                                             (Mop Fst
+                                               (Apply
+                                                 (Call "GPR"
+                                                   (ATy qTy (PTy F64 qTy))
+                                                   (Var "rs" (FTy 5)))
+                                                 qVar"s")) (LN 31) (LN 0)
+                                             F32)
+                                           (EX
+                                             (Mop Fst
+                                               (Apply
+                                                 (Call "GPR"
+                                                   (ATy qTy (PTy F64 qTy))
+                                                   (Var "rt" (FTy 5)))
+                                                 qVar"s")) (LN 31) (LN 0)
+                                             F32))))))
+                            (LC "HLarith" CTy"HLStatus"))))))))))
+
+
+(Def "dfn'DDIV" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (EQ
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state")) (LW 0 64))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"DDIV: divide by zero"))) qVar"state")) qVar"state")
+      (Let qVar"s"
+        (Rupd "LO"
+          (TP
+            (sqbkt qVar"s"
+                   (Bop Quot
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rs" (FTy 5))) qVar"s"))
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rt" (FTy 5))) qVar"s"))))))
+        (TP
+          (sqbkt LU
+                 (Rupd "HLStatus"
+                   (TP
+                     (sqbkt (Rupd "HI"
+                              (TP
+                                (sqbkt qVar"s"
+                                       (Bop Rem
+                                         (Mop Fst
+                                           (Apply
+                                             (Call "GPR"
+                                               (ATy qTy (PTy F64 qTy))
+                                               (Var "rs" (FTy 5)))
+                                             qVar"s"))
+                                         (Mop Fst
+                                           (Apply
+                                             (Call "GPR"
+                                               (ATy qTy (PTy F64 qTy))
+                                               (Var "rt" (FTy 5)))
+                                             qVar"s"))))))
+                            (LC "HLarith" CTy"HLStatus"))))))))))
+
+
+(Def "dfn'DDIVU" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (EQ
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state")) (LW 0 64))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"DDIVU: divide by zero"))) qVar"state")) qVar"state")
+      (Let qVar"s"
+        (Rupd "LO"
+          (TP
+            (sqbkt qVar"s"
+                   (Bop Div
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rs" (FTy 5))) qVar"s"))
+                     (Mop Fst
+                       (Apply
+                         (Call "GPR" (ATy qTy (PTy F64 qTy))
+                           (Var "rt" (FTy 5))) qVar"s"))))))
+        (TP
+          (sqbkt LU
+                 (Rupd "HLStatus"
+                   (TP
+                     (sqbkt (Rupd "HI"
+                              (TP
+                                (sqbkt qVar"s"
+                                       (Bop Mod
+                                         (Mop Fst
+                                           (Apply
+                                             (Call "GPR"
+                                               (ATy qTy (PTy F64 qTy))
+                                               (Var "rs" (FTy 5)))
+                                             qVar"s"))
+                                         (Mop Fst
+                                           (Apply
+                                             (Call "GPR"
+                                               (ATy qTy (PTy F64 qTy))
+                                               (Var "rt" (FTy 5)))
+                                             qVar"s"))))))
+                            (LC "HLarith" CTy"HLStatus"))))))))))
+
+
+(Def "dfn'MFHI" (Var "rd" (FTy 5))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (EQ (Dest "HLStatus" CTy"HLStatus" qVar"state")
+          (LC "HLmtlo" CTy"HLStatus"))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception" (LS"MFHI")))
+            qVar"state")) qVar"state")
+      (Let qVar"s"
+        (ITE
+          (EQ (Dest "HLStatus" CTy"HLStatus" qVar"s")
+            (LC "HLarith" CTy"HLStatus"))
+          (Rupd "HLStatus" (TP (sqbkt qVar"s" (LC "HLok" CTy"HLStatus"))))
+          qVar"s")
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP (sqbkt (Dest "HI" F64 qVar"s") (Var "rd" (FTy 5)))))
+          qVar"s")))))
+
+
+(Def "dfn'MFLO" (Var "rd" (FTy 5))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (EQ (Dest "HLStatus" CTy"HLStatus" qVar"state")
+          (LC "HLmthi" CTy"HLStatus"))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception" (LS"MFLO")))
+            qVar"state")) qVar"state")
+      (Let qVar"s"
+        (ITE
+          (EQ (Dest "HLStatus" CTy"HLStatus" qVar"s")
+            (LC "HLarith" CTy"HLStatus"))
+          (Rupd "HLStatus" (TP (sqbkt qVar"s" (LC "HLok" CTy"HLStatus"))))
+          qVar"s")
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP (sqbkt (Dest "LO" F64 qVar"s") (Var "rd" (FTy 5)))))
+          qVar"s")))))
+
+
+(Def "dfn'MTHI" (Var "rd" (FTy 5))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITB
+        (sqbkt ((EQ (Dest "HLStatus" CTy"HLStatus" qVar"state")
+                   (LC "HLarith" CTy"HLStatus"))
+                 (Rupd "HLStatus"
+                   (TP (sqbkt qVar"state" (LC "HLmthi" CTy"HLStatus")))))
+               ((EQ (Dest "HLStatus" CTy"HLStatus" qVar"state")
+                   (LC "HLmtlo" CTy"HLStatus"))
+                 (Rupd "HLStatus"
+                   (TP (sqbkt qVar"state" (LC "HLok" CTy"HLStatus"))))))
+        qVar"state")
+      (TP
+        (sqbkt LU
+               (Rupd "HI"
+                 (TP
+                   (sqbkt qVar"s"
+                          (Mop Fst
+                            (Apply
+                              (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                (Var "rd" (FTy 5))) qVar"s"))))))))))
+
+
+(Def "dfn'MTLO" (Var "rd" (FTy 5))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITB
+        (sqbkt ((EQ (Dest "HLStatus" CTy"HLStatus" qVar"state")
+                   (LC "HLarith" CTy"HLStatus"))
+                 (Rupd "HLStatus"
+                   (TP (sqbkt qVar"state" (LC "HLmtlo" CTy"HLStatus")))))
+               ((EQ (Dest "HLStatus" CTy"HLStatus" qVar"state")
+                   (LC "HLmthi" CTy"HLStatus"))
+                 (Rupd "HLStatus"
+                   (TP (sqbkt qVar"state" (LC "HLok" CTy"HLStatus"))))))
+        qVar"state")
+      (TP
+        (sqbkt LU
+               (Rupd "LO"
+                 (TP
+                   (sqbkt qVar"s"
+                          (Mop Fst
+                            (Apply
+                              (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                (Var "rd" (FTy 5))) qVar"s"))))))))))
+
+
+(Def "dfn'SLL"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop (SE F64)
+                   (Bop Lsl
+                     (EX
+                       (Mop Fst
+                         (Apply
+                           (Call "GPR" (ATy qTy (PTy F64 qTy))
+                             (Var "rt" (FTy 5))) qVar"state")) (LN 31)
+                       (LN 0) F32) (Mop (Cast nTy) (Var "sa" (FTy 5)))))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'SRL"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Call "NotWordValue" bTy
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state")))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"SRL: NotWordValue"))) qVar"state")) qVar"state")
+      (Apply
+        (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+          (TP
+            (sqbkt (Mop (SE F64)
+                     (Bop Lsr
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rt" (FTy 5))) qVar"s")) (LN 31)
+                         (LN 0) F32) (Mop (Cast nTy) (Var "sa" (FTy 5)))))
+                   (Var "rd" (FTy 5))))) qVar"s"))))
+
+
+(Def "dfn'SRA"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Call "NotWordValue" bTy
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state")))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"SRA: NotWordValue"))) qVar"state")) qVar"state")
+      (Apply
+        (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+          (TP
+            (sqbkt (Mop (SE F64)
+                     (Bop Asr
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rt" (FTy 5))) qVar"s")) (LN 31)
+                         (LN 0) F32) (Mop (Cast nTy) (Var "sa" (FTy 5)))))
+                   (Var "rd" (FTy 5))))) qVar"s"))))
+
+
+(Def "dfn'SLLV"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop (SE F64)
+                   (Bop Lsl
+                     (EX
+                       (Mop Fst
+                         (Apply
+                           (Call "GPR" (ATy qTy (PTy F64 qTy))
+                             (Var "rt" (FTy 5))) qVar"state")) (LN 31)
+                       (LN 0) F32)
+                     (Mop (Cast nTy)
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rs" (FTy 5))) qVar"state")) (LN 4)
+                         (LN 0) (FTy 5))))) (Var "rd" (FTy 5)))))
+      qVar"state")))
+
+
+(Def "dfn'SRLV"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Call "NotWordValue" bTy
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state")))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"SRLV: NotWordValue"))) qVar"state")) qVar"state")
+      (Apply
+        (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+          (TP
+            (sqbkt (Mop (SE F64)
+                     (Bop Lsr
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rt" (FTy 5))) qVar"s")) (LN 31)
+                         (LN 0) F32)
+                       (Mop (Cast nTy)
+                         (EX
+                           (Mop Fst
+                             (Apply
+                               (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                 (Var "rs" (FTy 5))) qVar"s")) (LN 4)
+                           (LN 0) (FTy 5))))) (Var "rd" (FTy 5)))))
+        qVar"s"))))
+
+
+(Def "dfn'SRAV"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE
+        (Call "NotWordValue" bTy
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state")))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "UNPREDICTABLE" CTy"exception"
+                (LS"SRAV: NotWordValue"))) qVar"state")) qVar"state")
+      (Apply
+        (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+          (TP
+            (sqbkt (Mop (SE F64)
+                     (Bop Asr
+                       (EX
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rt" (FTy 5))) qVar"s")) (LN 31)
+                         (LN 0) F32)
+                       (Mop (Cast nTy)
+                         (EX
+                           (Mop Fst
+                             (Apply
+                               (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                 (Var "rs" (FTy 5))) qVar"s")) (LN 4)
+                           (LN 0) (FTy 5))))) (Var "rd" (FTy 5)))))
+        qVar"s"))))
+
+
+(Def "dfn'DSLL"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Lsl
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Mop (Cast nTy) (Var "sa" (FTy 5)))) (Var "rd" (FTy 5)))))
+      qVar"state")))
+
+
+(Def "dfn'DSRL"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Lsr
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Mop (Cast nTy) (Var "sa" (FTy 5)))) (Var "rd" (FTy 5)))))
+      qVar"state")))
+
+
+(Def "dfn'DSRA"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Asr
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Mop (Cast nTy) (Var "sa" (FTy 5)))) (Var "rd" (FTy 5)))))
+      qVar"state")))
+
+
+(Def "dfn'DSLLV"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Lsl
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Mop (Cast nTy)
+                     (EX
+                       (Mop Fst
+                         (Apply
+                           (Call "GPR" (ATy qTy (PTy F64 qTy))
+                             (Var "rs" (FTy 5))) qVar"state")) (LN 5)
+                       (LN 0) (FTy 6)))) (Var "rd" (FTy 5)))))
+      qVar"state")))
+
+
+(Def "dfn'DSRLV"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Lsr
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Mop (Cast nTy)
+                     (EX
+                       (Mop Fst
+                         (Apply
+                           (Call "GPR" (ATy qTy (PTy F64 qTy))
+                             (Var "rs" (FTy 5))) qVar"state")) (LN 5)
+                       (LN 0) (FTy 6)))) (Var "rd" (FTy 5)))))
+      qVar"state")))
+
+
+(Def "dfn'DSRAV"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Asr
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Mop (Cast nTy)
+                     (EX
+                       (Mop Fst
+                         (Apply
+                           (Call "GPR" (ATy qTy (PTy F64 qTy))
+                             (Var "rs" (FTy 5))) qVar"state")) (LN 5)
+                       (LN 0) (FTy 6)))) (Var "rd" (FTy 5)))))
+      qVar"state")))
+
+
+(Def "dfn'DSLL32"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Lsl
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Bop Add (Mop (Cast nTy) (Var "sa" (FTy 5))) (LN 32)))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'DSRL32"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Lsr
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Bop Add (Mop (Cast nTy) (Var "sa" (FTy 5))) (LN 32)))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'DSRA32"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sa" (FTy 5))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Bop Asr
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))
+                   (Bop Add (Mop (Cast nTy) (Var "sa" (FTy 5))) (LN 32)))
+                 (Var "rd" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'TGE" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (ITE
+      (Bop Ge
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state"))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+            qVar"state")))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TGEU" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (ITE
+      (Bop Uge
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state"))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+            qVar"state")))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TLT" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (ITE
+      (Bop Lt
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state"))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+            qVar"state")))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TLTU" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (ITE
+      (Bop Ult
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state"))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+            qVar"state")))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TEQ" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (ITE
+      (EQ
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state"))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+            qVar"state")))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TNE" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5))))
+  (Close qVar"state"
+    (ITE
+      (Mop Not
+        (EQ
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state"))
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rt" (FTy 5)))
+              qVar"state"))))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TGEI" (TP (sqbkt (Var "rs" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (ITE
+      (Bop Ge
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state")) (Mop (SE F64) (Var "immediate" F16)))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TGEIU" (TP (sqbkt (Var "rs" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (ITE
+      (Bop Uge
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state")) (Mop (SE F64) (Var "immediate" F16)))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TLTI" (TP (sqbkt (Var "rs" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (ITE
+      (Bop Lt
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state")) (Mop (SE F64) (Var "immediate" F16)))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TLTIU" (TP (sqbkt (Var "rs" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (ITE
+      (Bop Ult
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state")) (Mop (SE F64) (Var "immediate" F16)))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TEQI" (TP (sqbkt (Var "rs" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (ITE
+      (EQ
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+            qVar"state")) (Mop (SE F64) (Var "immediate" F16)))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "dfn'TNEI" (TP (sqbkt (Var "rs" (FTy 5)) (Var "immediate" F16)))
+  (Close qVar"state"
+    (ITE
+      (Mop Not
+        (EQ
+          (Mop Fst
+            (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "rs" (FTy 5)))
+              qVar"state")) (Mop (SE F64) (Var "immediate" F16))))
+      (Apply
+        (Call "SignalException" (ATy qTy (PTy uTy qTy))
+          (LC "Tr" CTy"ExceptionType")) qVar"state")
+      (TP (sqbkt LU qVar"state")))))
+
+
+(Def "loadByte"
+  (TP
+    (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)
+           bVar"unsigned"))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "LOAD" CTy"LorS"))))
+        (Let (Var "v0" (FTy 3))
+          (Bop BXor (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+            (Bop Rep
+              (Mop Fst
+                (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                  qVar"state")) (LN 3)))
+          (Let (Var "membyte" F8)
+            (EX
+              (Mop Fst
+                (Apply
+                  (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                    (TP
+                      (sqbkt (Var "CCA" (FTy 3)) (Const "BYTE" (FTy 3))
+                             CC(sqbkt (EX (Var "pAddr" F64)
+                                        (Bop Sub (Const "PSIZE" nTy)
+                                          (LN 1)) (LN 3) (FTy 61))
+                                      (Bop BXor
+                                        (EX (Var "pAddr" F64) (LN 2)
+                                          (LN 0) (FTy 3))
+                                        (Bop Rep
+                                          (Mop Fst
+                                            (Apply
+                                              (Const "ReverseEndian"
+                                                (ATy qTy (PTy F1 qTy)))
+                                              qVar"state")) (LN 3))))
+                             (Var "v" F64) (LC "DATA" CTy"IorD"))))
+                  qVar"state"))
+              (Bop Add (LN 7)
+                (Bop Mul (LN 8) (Mop (Cast nTy) (Var "v0" (FTy 3)))))
+              (Bop Mul (LN 8) (Mop (Cast nTy) (Var "v0" (FTy 3)))) F8)
+            (Apply
+              (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                (TP
+                  (sqbkt (ITE bVar"unsigned"
+                           (Mop (Cast F64) (Var "membyte" F8))
+                           (Mop (SE F64) (Var "membyte" F8)))
+                         (Var "rt" (FTy 5))))) qVar"state")))))))
+
+
+(Def "loadHalf"
+  (TP
+    (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)
+           bVar"unsigned"))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (ITE (Bop Bit (Var "v" F64) (LN 0))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "AdEL" CTy"ExceptionType")) qVar"state")
+        (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+          (Call "AddressTranslation" (PTy F64 (FTy 3))
+            (TP
+              (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                     (LC "LOAD" CTy"LorS"))))
+          (Let (Var "v0" (FTy 3))
+            (Bop BXor (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+              (CC(sqbkt (Bop Rep
+                          (Mop Fst
+                            (Apply
+                              (Const "BigEndianCPU"
+                                (ATy qTy (PTy F1 qTy))) qVar"state"))
+                          (LN 2)) (LW 0 1))))
+            (Let (Var "memhalf" F16)
+              (EX
+                (Mop Fst
+                  (Apply
+                    (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                      (TP
+                        (sqbkt (Var "CCA" (FTy 3))
+                               (Const "HALFWORD" (FTy 3))
+                               CC(sqbkt (EX (Var "pAddr" F64)
+                                          (Bop Sub (Const "PSIZE" nTy)
+                                            (LN 1)) (LN 3) (FTy 61))
+                                        (Bop BXor
+                                          (EX (Var "pAddr" F64) (LN 2)
+                                            (LN 0) (FTy 3))
+                                          (CC(sqbkt (Bop Rep
+                                                      (Mop Fst
+                                                        (Apply
+                                                          (Const
+                                                            "ReverseEndian"
+                                                            (ATy qTy
+                                                              (PTy F1 qTy)))
+                                                          qVar"state"))
+                                                      (LN 2)) (LW 0 1)))))
+                               (Var "v" F64) (LC "DATA" CTy"IorD"))))
+                    qVar"state"))
+                (Bop Add (LN 15)
+                  (Bop Mul (LN 8) (Mop (Cast nTy) (Var "v0" (FTy 3)))))
+                (Bop Mul (LN 8) (Mop (Cast nTy) (Var "v0" (FTy 3)))) F16)
+              (Apply
+                (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                  (TP
+                    (sqbkt (ITE bVar"unsigned"
+                             (Mop (Cast F64) (Var "memhalf" F16))
+                             (Mop (SE F64) (Var "memhalf" F16)))
+                           (Var "rt" (FTy 5))))) qVar"state"))))))))
+
+
+(Def "loadWord"
+  (TP
+    (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)
+           bVar"unsigned"))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (ITE
+        (Mop Not (EQ (EX (Var "v" F64) (LN 1) (LN 0) (FTy 2)) (LW 0 2)))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "AdEL" CTy"ExceptionType")) qVar"state")
+        (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+          (Call "AddressTranslation" (PTy F64 (FTy 3))
+            (TP
+              (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                     (LC "LOAD" CTy"LorS"))))
+          (Let (Var "v0" (FTy 3))
+            (Bop BXor (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+              (CC(sqbkt (Mop Fst
+                          (Apply
+                            (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LW 0 2))))
+            (Let (Var "memword" F32)
+              (EX
+                (Mop Fst
+                  (Apply
+                    (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                      (TP
+                        (sqbkt (Var "CCA" (FTy 3)) (Const "WORD" (FTy 3))
+                               CC(sqbkt (EX (Var "pAddr" F64)
+                                          (Bop Sub (Const "PSIZE" nTy)
+                                            (LN 1)) (LN 3) (FTy 61))
+                                        (Bop BXor
+                                          (EX (Var "pAddr" F64) (LN 2)
+                                            (LN 0) (FTy 3))
+                                          (CC(sqbkt (Mop Fst
+                                                      (Apply
+                                                        (Const
+                                                          "ReverseEndian"
+                                                          (ATy qTy
+                                                            (PTy F1 qTy)))
+                                                        qVar"state"))
+                                                    (LW 0 2)))))
+                               (Var "v" F64) (LC "DATA" CTy"IorD"))))
+                    qVar"state"))
+                (Bop Add (LN 31)
+                  (Bop Mul (LN 8) (Mop (Cast nTy) (Var "v0" (FTy 3)))))
+                (Bop Mul (LN 8) (Mop (Cast nTy) (Var "v0" (FTy 3)))) F32)
+              (Apply
+                (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                  (TP
+                    (sqbkt (ITE bVar"unsigned"
+                             (Mop (Cast F64) (Var "memword" F32))
+                             (Mop (SE F64) (Var "memword" F32)))
+                           (Var "rt" (FTy 5))))) qVar"state"))))))))
+
+
+(Def "loadDoubleword"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (ITE
+        (Mop Not (EQ (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3)) (LW 0 3)))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "AdEL" CTy"ExceptionType")) qVar"state")
+        (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+          (Call "AddressTranslation" (PTy F64 (FTy 3))
+            (TP
+              (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                     (LC "LOAD" CTy"LorS"))))
+          (Apply
+            (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+              (TP
+                (sqbkt (Mop Fst
+                         (Apply
+                           (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                             (TP
+                               (sqbkt (Var "CCA" (FTy 3))
+                                      (Const "DOUBLEWORD" (FTy 3))
+                                      (Var "pAddr" F64) (Var "v" F64)
+                                      (LC "DATA" CTy"IorD"))))
+                           qVar"state")) (Var "rt" (FTy 5)))))
+            qVar"state"))))))
+
+
+(Def "dfn'LB"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "loadByte" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16) LF))) qVar"state")))
+
+
+(Def "dfn'LBU"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "loadByte" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16) LT))) qVar"state")))
+
+
+(Def "dfn'LH"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "loadHalf" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16) LF))) qVar"state")))
+
+
+(Def "dfn'LHU"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "loadHalf" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16) LT))) qVar"state")))
+
+
+(Def "dfn'LW"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "loadWord" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16) LF))) qVar"state")))
+
+
+(Def "dfn'LWU"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "loadWord" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16) LT))) qVar"state")))
+
+
+(Def "dfn'LL"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (Rupd "LLbit"
+               (TP
+                 (sqbkt (Mop Snd
+                          (Apply
+                            (Call "loadWord" (ATy qTy (PTy uTy qTy))
+                              (TP
+                                (sqbkt (Var "base" (FTy 5))
+                                       (Var "rt" (FTy 5))
+                                       (Var "offset" F16) LF)))
+                            qVar"state")) (Mop Some LT))))))))
+
+
+(Def "dfn'LD"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "loadDoubleword" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16)))) qVar"state")))
+
+
+(Def "dfn'LLD"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (Rupd "LLbit"
+               (TP
+                 (sqbkt (Mop Snd
+                          (Apply
+                            (Call "loadDoubleword" (ATy qTy (PTy uTy qTy))
+                              (TP
+                                (sqbkt (Var "base" (FTy 5))
+                                       (Var "rt" (FTy 5))
+                                       (Var "offset" F16)))) qVar"state"))
+                        (Mop Some LT))))))))
+
+
+(Def "dfn'LWL"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "LOAD" CTy"LorS"))))
+        (Let (Var "v0" F64)
+          (CC(sqbkt (EX (Var "pAddr" F64)
+                      (Bop Sub (Const "PSIZE" nTy) (LN 1)) (LN 3)
+                      (FTy 61))
+                    (Bop BXor (EX (Var "pAddr" F64) (LN 2) (LN 0) (FTy 3))
+                      (Bop Rep
+                        (Mop Fst
+                          (Apply
+                            (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LN 3)))))
+          (Let (Var "v1" (FTy 2))
+            (Bop BXor (EX (Var "v" F64) (LN 1) (LN 0) (FTy 2))
+              (Bop Rep
+                (Mop Fst
+                  (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                    qVar"state")) (LN 2)))
+            (Let (Var "v2" F64)
+              (Mop Fst
+                (Apply
+                  (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                    (TP
+                      (sqbkt (Var "CCA" (FTy 3))
+                             CC(sqbkt (LW 0 1) (Var "v1" (FTy 2)))
+                             (ITE
+                               (Mop Fst
+                                 (Apply
+                                   (Const "BigEndianMem"
+                                     (ATy qTy (PTy bTy qTy))) qVar"state"))
+                               (Var "v0" F64)
+                               (Bop BAnd (Var "v0" F64)
+                                 (Mop BNot (LW 7 64)))) (Var "v" F64)
+                             (LC "DATA" CTy"IorD")))) qVar"state"))
+              (Let (TP (sqbkt (Var "v" F32) qVar"s"))
+                (CS
+                  (TP
+                    (sqbkt (Bop BXor (EX (Var "v" F64) (LN 2) (LN 2) F1)
+                             (Mop Fst
+                               (Apply
+                                 (Const "BigEndianCPU"
+                                   (ATy qTy (PTy F1 qTy))) qVar"state")))
+                           (Var "v1" (FTy 2))))
+                  (sqbkt ((TP (sqbkt (LW 0 1) (LW 0 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 7)
+                                               (LN 0) F8)
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 23)
+                                               (LN 0) (FTy 24)))
+                                    qVar"state")))
+                         ((TP (sqbkt (LW 0 1) (LW 1 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 15)
+                                               (LN 0) F16)
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 15)
+                                               (LN 0) F16)) qVar"state")))
+                         ((TP (sqbkt (LW 0 1) (LW 2 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 23)
+                                               (LN 0) (FTy 24))
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 7)
+                                               (LN 0) F8)) qVar"state")))
+                         ((TP (sqbkt (LW 0 1) (LW 3 2)))
+                           (TP
+                             (sqbkt (EX (Var "v2" F64) (LN 31) (LN 0) F32)
+                                    qVar"state")))
+                         ((TP (sqbkt (LW 1 1) (LW 0 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 39)
+                                               (LN 32) F8)
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 23)
+                                               (LN 0) (FTy 24)))
+                                    qVar"state")))
+                         ((TP (sqbkt (LW 1 1) (LW 1 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 47)
+                                               (LN 32) F16)
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 15)
+                                               (LN 0) F16)) qVar"state")))
+                         ((TP (sqbkt (LW 1 1) (LW 2 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 55)
+                                               (LN 32) (FTy 24))
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 7)
+                                               (LN 0) F8)) qVar"state")))
+                         ((TP (sqbkt (LW 1 1) (LW 3 2)))
+                           (TP
+                             (sqbkt (EX (Var "v2" F64) (LN 63) (LN 32)
+                                      F32) qVar"state")))))
+                (Apply
+                  (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                    (TP
+                      (sqbkt (Mop (SE F64) (Var "v" F32))
+                             (Var "rt" (FTy 5))))) qVar"s")))))))))
+
+
+(Def "dfn'LWR"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "LOAD" CTy"LorS"))))
+        (Let (Var "v0" F64)
+          (CC(sqbkt (EX (Var "pAddr" F64)
+                      (Bop Sub (Const "PSIZE" nTy) (LN 1)) (LN 3)
+                      (FTy 61))
+                    (Bop BXor (EX (Var "pAddr" F64) (LN 2) (LN 0) (FTy 3))
+                      (Bop Rep
+                        (Mop Fst
+                          (Apply
+                            (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LN 3)))))
+          (Let (Var "v1" (FTy 2))
+            (Bop BXor (EX (Var "v" F64) (LN 1) (LN 0) (FTy 2))
+              (Bop Rep
+                (Mop Fst
+                  (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                    qVar"state")) (LN 2)))
+            (Let (Var "v2" F64)
+              (Mop Fst
+                (Apply
+                  (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                    (TP
+                      (sqbkt (Var "CCA" (FTy 3))
+                             (Bop Sub (Const "WORD" (FTy 3))
+                               (CC(sqbkt (LW 0 1) (Var "v1" (FTy 2)))))
+                             (ITE
+                               (Mop Fst
+                                 (Apply
+                                   (Const "BigEndianMem"
+                                     (ATy qTy (PTy bTy qTy))) qVar"state"))
+                               (Var "v0" F64)
+                               (Bop BAnd (Var "v0" F64)
+                                 (Mop BNot (LW 7 64)))) (Var "v" F64)
+                             (LC "DATA" CTy"IorD")))) qVar"state"))
+              (Let (TP (sqbkt (Var "v" F32) qVar"s"))
+                (CS
+                  (TP
+                    (sqbkt (Bop BXor (EX (Var "v" F64) (LN 2) (LN 2) F1)
+                             (Mop Fst
+                               (Apply
+                                 (Const "BigEndianCPU"
+                                   (ATy qTy (PTy F1 qTy))) qVar"state")))
+                           (Var "v1" (FTy 2))))
+                  (sqbkt ((TP (sqbkt (LW 0 1) (LW 0 2)))
+                           (TP
+                             (sqbkt (EX (Var "v2" F64) (LN 31) (LN 0) F32)
+                                    qVar"state")))
+                         ((TP (sqbkt (LW 0 1) (LW 1 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 31)
+                                               (LN 24) F8)
+                                             (EX (Var "v2" F64) (LN 31)
+                                               (LN 8) (FTy 24)))
+                                    qVar"state")))
+                         ((TP (sqbkt (LW 0 1) (LW 2 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 31)
+                                               (LN 16) F16)
+                                             (EX (Var "v2" F64) (LN 31)
+                                               (LN 16) F16)) qVar"state")))
+                         ((TP (sqbkt (LW 0 1) (LW 3 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 31)
+                                               (LN 8) (FTy 24))
+                                             (EX (Var "v2" F64) (LN 31)
+                                               (LN 24) F8)) qVar"state")))
+                         ((TP (sqbkt (LW 1 1) (LW 0 2)))
+                           (TP
+                             (sqbkt (EX (Var "v2" F64) (LN 63) (LN 32)
+                                      F32) qVar"state")))
+                         ((TP (sqbkt (LW 1 1) (LW 1 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 31)
+                                               (LN 24) F8)
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 40) (FTy 24)))
+                                    qVar"state")))
+                         ((TP (sqbkt (LW 1 1) (LW 2 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 31)
+                                               (LN 16) F16)
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 48) F16)) qVar"state")))
+                         ((TP (sqbkt (LW 1 1) (LW 3 2)))
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 31)
+                                               (LN 8) (FTy 24))
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 56) F8)) qVar"state")))))
+                (Apply
+                  (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                    (TP
+                      (sqbkt (Mop (SE F64) (Var "v" F32))
+                             (Var "rt" (FTy 5))))) qVar"s")))))))))
+
+
+(Def "dfn'LDL"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "LOAD" CTy"LorS"))))
+        (Let (Var "v0" F64)
+          (CC(sqbkt (EX (Var "pAddr" F64)
+                      (Bop Sub (Const "PSIZE" nTy) (LN 1)) (LN 3)
+                      (FTy 61))
+                    (Bop BXor (EX (Var "pAddr" F64) (LN 2) (LN 0) (FTy 3))
+                      (Bop Rep
+                        (Mop Fst
+                          (Apply
+                            (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LN 3)))))
+          (Let (Var "v1" (FTy 3))
+            (Bop BXor (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+              (Bop Rep
+                (Mop Fst
+                  (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                    qVar"state")) (LN 3)))
+            (Let (Var "v2" F64)
+              (Mop Fst
+                (Apply
+                  (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                    (TP
+                      (sqbkt (Var "CCA" (FTy 3)) (Var "v1" (FTy 3))
+                             (ITE
+                               (Mop Fst
+                                 (Apply
+                                   (Const "BigEndianMem"
+                                     (ATy qTy (PTy bTy qTy))) qVar"state"))
+                               (Var "v0" F64)
+                               (Bop BAnd (Var "v0" F64)
+                                 (Mop BNot (LW 7 64)))) (Var "v" F64)
+                             (LC "DATA" CTy"IorD")))) qVar"state"))
+              (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+                (CS (Var "v1" (FTy 3))
+                  (sqbkt ((LW 0 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 7)
+                                               (LN 0) F8)
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 55)
+                                               (LN 0) (FTy 56)))
+                                    qVar"state")))
+                         ((LW 1 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 15)
+                                               (LN 0) F16)
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 47)
+                                               (LN 0) (FTy 48)))
+                                    qVar"state")))
+                         ((LW 2 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 23)
+                                               (LN 0) (FTy 24))
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 39)
+                                               (LN 0) (FTy 40)))
+                                    qVar"state")))
+                         ((LW 3 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 31)
+                                               (LN 0) F32)
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 31)
+                                               (LN 0) F32)) qVar"state")))
+                         ((LW 4 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 39)
+                                               (LN 0) (FTy 40))
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 23)
+                                               (LN 0) (FTy 24)))
+                                    qVar"state")))
+                         ((LW 5 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 47)
+                                               (LN 0) (FTy 48))
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 15)
+                                               (LN 0) F16)) qVar"state")))
+                         ((LW 6 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX (Var "v2" F64) (LN 55)
+                                               (LN 0) (FTy 56))
+                                             (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 7)
+                                               (LN 0) F8)) qVar"state")))
+                         ((LW 7 3)
+                           (TP
+                             (sqbkt (EX (Var "v2" F64) (LN 63) (LN 0) F64)
+                                    qVar"state")))))
+                (Apply
+                  (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                    (TP (sqbkt (Var "v" F64) (Var "rt" (FTy 5)))))
+                  qVar"s")))))))))
+
+
+(Def "dfn'LDR"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "LOAD" CTy"LorS"))))
+        (Let (Var "v0" F64)
+          (CC(sqbkt (EX (Var "pAddr" F64)
+                      (Bop Sub (Const "PSIZE" nTy) (LN 1)) (LN 3)
+                      (FTy 61))
+                    (Bop BXor (EX (Var "pAddr" F64) (LN 2) (LN 0) (FTy 3))
+                      (Bop Rep
+                        (Mop Fst
+                          (Apply
+                            (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LN 3)))))
+          (Let (Var "v1" (FTy 3))
+            (Bop BXor (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+              (Bop Rep
+                (Mop Fst
+                  (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                    qVar"state")) (LN 3)))
+            (Let (Var "v2" F64)
+              (Mop Fst
+                (Apply
+                  (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                    (TP
+                      (sqbkt (Var "CCA" (FTy 3))
+                             (Bop Sub (Const "DOUBLEWORD" (FTy 3))
+                               (Var "v1" (FTy 3)))
+                             (ITE
+                               (Mop Fst
+                                 (Apply
+                                   (Const "BigEndianMem"
+                                     (ATy qTy (PTy bTy qTy))) qVar"state"))
+                               (Var "v0" F64)
+                               (Bop BAnd (Var "v0" F64)
+                                 (Mop BNot (LW 7 64)))) (Var "v" F64)
+                             (LC "DATA" CTy"IorD")))) qVar"state"))
+              (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+                (CS (Var "v1" (FTy 3))
+                  (sqbkt ((LW 0 3)
+                           (TP
+                             (sqbkt (EX (Var "v2" F64) (LN 63) (LN 0) F64)
+                                    qVar"state")))
+                         ((LW 1 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 63)
+                                               (LN 56) F8)
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 8) (FTy 56)))
+                                    qVar"state")))
+                         ((LW 2 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 63)
+                                               (LN 48) F16)
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 16) (FTy 48)))
+                                    qVar"state")))
+                         ((LW 3 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 63)
+                                               (LN 40) (FTy 24))
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 24) (FTy 40)))
+                                    qVar"state")))
+                         ((LW 4 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 63)
+                                               (LN 32) F32)
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 32) F32)) qVar"state")))
+                         ((LW 5 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 63)
+                                               (LN 24) (FTy 40))
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 40) (FTy 24)))
+                                    qVar"state")))
+                         ((LW 6 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 63)
+                                               (LN 16) (FTy 48))
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 48) F16)) qVar"state")))
+                         ((LW 7 3)
+                           (TP
+                             (sqbkt CC(sqbkt (EX
+                                               (Mop Fst
+                                                 (Apply
+                                                   (Call "GPR"
+                                                     (ATy qTy
+                                                       (PTy F64 qTy))
+                                                     (Var "rt" (FTy 5)))
+                                                   qVar"state")) (LN 63)
+                                               (LN 8) (FTy 56))
+                                             (EX (Var "v2" F64) (LN 63)
+                                               (LN 56) F8)) qVar"state")))))
+                (Apply
+                  (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                    (TP (sqbkt (Var "v" F64) (Var "rt" (FTy 5)))))
+                  qVar"s")))))))))
+
+
+(Def "dfn'SB"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "STORE" CTy"LorS"))))
+        (Apply
+          (Call "StoreMemory" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Var "CCA" (FTy 3)) (Const "BYTE" (FTy 3))
+                     (Bop Lsl
+                       (Mop Fst
+                         (Apply
+                           (Call "GPR" (ATy qTy (PTy F64 qTy))
+                             (Var "rt" (FTy 5))) qVar"state"))
+                       (Bop Mul (LN 8)
+                         (Mop (Cast nTy)
+                           (Bop BXor
+                             (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+                             (Bop Rep
+                               (Mop Fst
+                                 (Apply
+                                   (Const "BigEndianCPU"
+                                     (ATy qTy (PTy F1 qTy))) qVar"state"))
+                               (LN 3))))))
+                     CC(sqbkt (EX (Var "pAddr" F64)
+                                (Bop Sub (Const "PSIZE" nTy) (LN 1))
+                                (LN 3) (FTy 61))
+                              (Bop BXor
+                                (EX (Var "pAddr" F64) (LN 2) (LN 0)
+                                  (FTy 3))
+                                (Bop Rep
+                                  (Mop Fst
+                                    (Apply
+                                      (Const "ReverseEndian"
+                                        (ATy qTy (PTy F1 qTy)))
+                                      qVar"state")) (LN 3))))
+                     (Var "v" F64) (LC "DATA" CTy"IorD")))) qVar"state")))))
+
+
+(Def "dfn'SH"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (ITE (Bop Bit (Var "v" F64) (LN 0))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "AdES" CTy"ExceptionType")) qVar"state")
+        (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+          (Call "AddressTranslation" (PTy F64 (FTy 3))
+            (TP
+              (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                     (LC "STORE" CTy"LorS"))))
+          (Apply
+            (Call "StoreMemory" (ATy qTy (PTy uTy qTy))
+              (TP
+                (sqbkt (Var "CCA" (FTy 3)) (Const "HALFWORD" (FTy 3))
+                       (Bop Lsl
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rt" (FTy 5))) qVar"state"))
+                         (Bop Mul (LN 8)
+                           (Mop (Cast nTy)
+                             (Bop BXor
+                               (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+                               (CC(sqbkt (Bop Rep
+                                           (Mop Fst
+                                             (Apply
+                                               (Const "BigEndianCPU"
+                                                 (ATy qTy (PTy F1 qTy)))
+                                               qVar"state")) (LN 2))
+                                         (LW 0 1)))))))
+                       CC(sqbkt (EX (Var "pAddr" F64)
+                                  (Bop Sub (Const "PSIZE" nTy) (LN 1))
+                                  (LN 3) (FTy 61))
+                                (Bop BXor
+                                  (EX (Var "pAddr" F64) (LN 2) (LN 0)
+                                    (FTy 3))
+                                  (CC(sqbkt (Bop Rep
+                                              (Mop Fst
+                                                (Apply
+                                                  (Const "ReverseEndian"
+                                                    (ATy qTy (PTy F1 qTy)))
+                                                  qVar"state")) (LN 2))
+                                            (LW 0 1))))) (Var "v" F64)
+                       (LC "DATA" CTy"IorD")))) qVar"state"))))))
+
+
+(Def "storeWord"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (ITE
+        (Mop Not (EQ (EX (Var "v" F64) (LN 1) (LN 0) (FTy 2)) (LW 0 2)))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "AdES" CTy"ExceptionType")) qVar"state")
+        (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+          (Call "AddressTranslation" (PTy F64 (FTy 3))
+            (TP
+              (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                     (LC "STORE" CTy"LorS"))))
+          (Apply
+            (Call "StoreMemory" (ATy qTy (PTy uTy qTy))
+              (TP
+                (sqbkt (Var "CCA" (FTy 3)) (Const "WORD" (FTy 3))
+                       (Bop Lsl
+                         (Mop Fst
+                           (Apply
+                             (Call "GPR" (ATy qTy (PTy F64 qTy))
+                               (Var "rt" (FTy 5))) qVar"state"))
+                         (Bop Mul (LN 8)
+                           (Mop (Cast nTy)
+                             (Bop BXor
+                               (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+                               (CC(sqbkt (Mop Fst
+                                           (Apply
+                                             (Const "BigEndianCPU"
+                                               (ATy qTy (PTy F1 qTy)))
+                                             qVar"state")) (LW 0 2)))))))
+                       CC(sqbkt (EX (Var "pAddr" F64)
+                                  (Bop Sub (Const "PSIZE" nTy) (LN 1))
+                                  (LN 3) (FTy 61))
+                                (Bop BXor
+                                  (EX (Var "pAddr" F64) (LN 2) (LN 0)
+                                    (FTy 3))
+                                  (CC(sqbkt (Mop Fst
+                                              (Apply
+                                                (Const "ReverseEndian"
+                                                  (ATy qTy (PTy F1 qTy)))
+                                                qVar"state")) (LW 0 2)))))
+                       (Var "v" F64) (LC "DATA" CTy"IorD")))) qVar"state"))))))
+
+
+(Def "storeDoubleword"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (ITE
+        (Mop Not (EQ (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3)) (LW 0 3)))
+        (Apply
+          (Call "SignalException" (ATy qTy (PTy uTy qTy))
+            (LC "AdES" CTy"ExceptionType")) qVar"state")
+        (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+          (Call "AddressTranslation" (PTy F64 (FTy 3))
+            (TP
+              (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                     (LC "STORE" CTy"LorS"))))
+          (Apply
+            (Call "StoreMemory" (ATy qTy (PTy uTy qTy))
+              (TP
+                (sqbkt (Var "CCA" (FTy 3)) (Const "DOUBLEWORD" (FTy 3))
+                       (Mop Fst
+                         (Apply
+                           (Call "GPR" (ATy qTy (PTy F64 qTy))
+                             (Var "rt" (FTy 5))) qVar"state"))
+                       (Var "pAddr" F64) (Var "v" F64)
+                       (LC "DATA" CTy"IorD")))) qVar"state"))))))
+
+
+(Def "dfn'SW"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "storeWord" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16)))) qVar"state")))
+
+
+(Def "dfn'SD"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Apply
+      (Call "storeDoubleword" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                 (Var "offset" F16)))) qVar"state")))
+
+
+(Def "dfn'SC"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (CS (Dest "LLbit" (OTy bTy) qVar"state")
+      (sqbkt ((LO bTy)
+               (Apply
+                 (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                   (Call "UNPREDICTABLE" CTy"exception"
+                     (LS"SC: LLbit not set"))) qVar"state"))
+             ((Mop Some LF)
+               (Apply
+                 (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                   (TP (sqbkt (LW 0 64) (Var "rt" (FTy 5))))) qVar"state"))
+             ((Mop Some LT)
+               (Apply
+                 (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                   (TP (sqbkt (LW 1 64) (Var "rt" (FTy 5)))))
+                 (Mop Snd
+                   (Apply
+                     (Call "storeWord" (ATy qTy (PTy uTy qTy))
+                       (TP
+                         (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                                (Var "offset" F16)))) qVar"state"))))))))
+
+
+(Def "dfn'SCD"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (CS (Dest "LLbit" (OTy bTy) qVar"state")
+      (sqbkt ((LO bTy)
+               (Apply
+                 (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                   (Call "UNPREDICTABLE" CTy"exception"
+                     (LS"SCD: LLbit not set"))) qVar"state"))
+             ((Mop Some LF)
+               (Apply
+                 (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                   (TP (sqbkt (LW 0 64) (Var "rt" (FTy 5))))) qVar"state"))
+             ((Mop Some LT)
+               (Apply
+                 (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                   (TP (sqbkt (LW 1 64) (Var "rt" (FTy 5)))))
+                 (Mop Snd
+                   (Apply
+                     (Call "storeDoubleword" (ATy qTy (PTy uTy qTy))
+                       (TP
+                         (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5))
+                                (Var "offset" F16)))) qVar"state"))))))))
+
+
+(Def "dfn'SWL"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "STORE" CTy"LorS"))))
+        (Let (Var "v0" F64)
+          (CC(sqbkt (EX (Var "pAddr" F64)
+                      (Bop Sub (Const "PSIZE" nTy) (LN 1)) (LN 3)
+                      (FTy 61))
+                    (Bop BXor (EX (Var "pAddr" F64) (LN 2) (LN 0) (FTy 3))
+                      (Bop Rep
+                        (Mop Fst
+                          (Apply
+                            (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LN 3)))))
+          (Let (Var "v1" (FTy 2))
+            (Bop BXor (EX (Var "v" F64) (LN 1) (LN 0) (FTy 2))
+              (Bop Rep
+                (Mop Fst
+                  (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                    qVar"state")) (LN 2)))
+            (Let (TP (sqbkt (Var "v2" F64) qVar"s0"))
+              (CS (Var "v1" (FTy 2))
+                (sqbkt ((LW 0 2)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 31) (LN 24)
+                                      F8)) qVar"state")))
+                       ((LW 1 2)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 31) (LN 16)
+                                      F16)) qVar"state")))
+                       ((LW 2 2)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 31) (LN 8)
+                                      (FTy 24))) qVar"state")))
+                       ((LW 3 2)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 31) (LN 0)
+                                      F32)) qVar"state")))))
+              (Apply
+                (Call "StoreMemory" (ATy qTy (PTy uTy qTy))
+                  (TP
+                    (sqbkt (Var "CCA" (FTy 3))
+                           (Mop (Cast (FTy 3)) (Var "v1" (FTy 2)))
+                           (ITE
+                             (EQ
+                               (Bop BXor
+                                 (EX (Var "v" F64) (LN 2) (LN 2) F1)
+                                 (Mop Fst
+                                   (Apply
+                                     (Const "BigEndianCPU"
+                                       (ATy qTy (PTy F1 qTy)))
+                                     qVar"state"))) (LW 1 1))
+                             (Bop Lsl (Var "v2" F64) (LN 32))
+                             (Var "v2" F64))
+                           (ITE
+                             (Mop Fst
+                               (Apply
+                                 (Const "BigEndianMem"
+                                   (ATy qTy (PTy bTy qTy))) qVar"state"))
+                             (Var "v0" F64)
+                             (Bop BAnd (Var "v0" F64)
+                               (Mop BNot (LW 3 64)))) (Var "v" F64)
+                           (LC "DATA" CTy"IorD")))) qVar"s0"))))))))
+
+
+(Def "dfn'SWR"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "STORE" CTy"LorS"))))
+        (Let (Var "v0" F64)
+          (CC(sqbkt (EX (Var "pAddr" F64)
+                      (Bop Sub (Const "PSIZE" nTy) (LN 1)) (LN 3)
+                      (FTy 61))
+                    (Bop BXor (EX (Var "pAddr" F64) (LN 2) (LN 0) (FTy 3))
+                      (Bop Rep
+                        (Mop Fst
+                          (Apply
+                            (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LN 3)))))
+          (Let (Var "v1" (FTy 2))
+            (Bop BXor (EX (Var "v" F64) (LN 1) (LN 0) (FTy 2))
+              (Bop Rep
+                (Mop Fst
+                  (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                    qVar"state")) (LN 2)))
+            (Let (TP (sqbkt (Var "v2" F64) qVar"s0"))
+              (CS
+                (TP
+                  (sqbkt (Bop BXor (EX (Var "v" F64) (LN 2) (LN 2) F1)
+                           (Mop Fst
+                             (Apply
+                               (Const "BigEndianCPU"
+                                 (ATy qTy (PTy F1 qTy))) qVar"state")))
+                         (Var "v1" (FTy 2))))
+                (sqbkt ((TP (sqbkt (LW 0 1) (LW 0 2)))
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 31) (LN 0)
+                                      F32)) qVar"state")))
+                       ((TP (sqbkt (LW 0 1) (LW 1 2)))
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 23) (LN 0)
+                                        (FTy 24))) (LN 8)) qVar"state")))
+                       ((TP (sqbkt (LW 0 1) (LW 2 2)))
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 15) (LN 0)
+                                        F16)) (LN 16)) qVar"state")))
+                       ((TP (sqbkt (LW 0 1) (LW 3 2)))
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 7) (LN 0)
+                                        F8)) (LN 24)) qVar"state")))
+                       ((TP (sqbkt (LW 1 1) (LW 0 2)))
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 31) (LN 0)
+                                        F32)) (LN 32)) qVar"state")))
+                       ((TP (sqbkt (LW 1 1) (LW 1 2)))
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 23) (LN 0)
+                                        (FTy 24))) (LN 40)) qVar"state")))
+                       ((TP (sqbkt (LW 1 1) (LW 2 2)))
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 15) (LN 0)
+                                        F16)) (LN 48)) qVar"state")))
+                       ((TP (sqbkt (LW 1 1) (LW 3 2)))
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 7) (LN 0)
+                                        F8)) (LN 56)) qVar"state")))))
+              (Apply
+                (Call "StoreMemory" (ATy qTy (PTy uTy qTy))
+                  (TP
+                    (sqbkt (Var "CCA" (FTy 3))
+                           (Bop Sub (Const "WORD" (FTy 3))
+                             (Mop (Cast (FTy 3)) (Var "v1" (FTy 2))))
+                           (Var "v2" F64)
+                           (ITE
+                             (Mop Fst
+                               (Apply
+                                 (Const "BigEndianMem"
+                                   (ATy qTy (PTy bTy qTy))) qVar"state"))
+                             (Var "v0" F64)
+                             (Bop BAnd (Var "v0" F64)
+                               (Mop BNot (LW 3 64)))) (Var "v" F64)
+                           (LC "DATA" CTy"IorD")))) qVar"s0"))))))))
+
+
+(Def "dfn'SDL"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "STORE" CTy"LorS"))))
+        (Let (Var "v0" F64)
+          (CC(sqbkt (EX (Var "pAddr" F64)
+                      (Bop Sub (Const "PSIZE" nTy) (LN 1)) (LN 3)
+                      (FTy 61))
+                    (Bop BXor (EX (Var "pAddr" F64) (LN 2) (LN 0) (FTy 3))
+                      (Bop Rep
+                        (Mop Fst
+                          (Apply
+                            (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LN 3)))))
+          (Let (Var "v1" (FTy 3))
+            (Bop BXor (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+              (Bop Rep
+                (Mop Fst
+                  (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                    qVar"state")) (LN 3)))
+            (Let (TP (sqbkt (Var "v2" F64) qVar"s0"))
+              (CS (Var "v1" (FTy 3))
+                (sqbkt ((LW 0 3)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 63) (LN 56)
+                                      F8)) qVar"state")))
+                       ((LW 1 3)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 63) (LN 48)
+                                      F16)) qVar"state")))
+                       ((LW 2 3)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 63) (LN 40)
+                                      (FTy 24))) qVar"state")))
+                       ((LW 3 3)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 63) (LN 32)
+                                      F32)) qVar"state")))
+                       ((LW 4 3)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 63) (LN 24)
+                                      (FTy 40))) qVar"state")))
+                       ((LW 5 3)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 63) (LN 16)
+                                      (FTy 48))) qVar"state")))
+                       ((LW 6 3)
+                         (TP
+                           (sqbkt (Mop (Cast F64)
+                                    (EX
+                                      (Mop Fst
+                                        (Apply
+                                          (Call "GPR"
+                                            (ATy qTy (PTy F64 qTy))
+                                            (Var "rt" (FTy 5)))
+                                          qVar"state")) (LN 63) (LN 8)
+                                      (FTy 56))) qVar"state")))
+                       ((LW 7 3)
+                         (TP
+                           (sqbkt (Mop Fst
+                                    (Apply
+                                      (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                        (Var "rt" (FTy 5))) qVar"state"))
+                                  qVar"state")))))
+              (Apply
+                (Call "StoreMemory" (ATy qTy (PTy uTy qTy))
+                  (TP
+                    (sqbkt (Var "CCA" (FTy 3)) (Var "v1" (FTy 3))
+                           (Var "v2" F64)
+                           (ITE
+                             (Mop Fst
+                               (Apply
+                                 (Const "BigEndianMem"
+                                   (ATy qTy (PTy bTy qTy))) qVar"state"))
+                             (Var "v0" F64)
+                             (Bop BAnd (Var "v0" F64)
+                               (Mop BNot (LW 7 64)))) (Var "v" F64)
+                           (LC "DATA" CTy"IorD")))) qVar"s0"))))))))
+
+
+(Def "dfn'SDR"
+  (TP (sqbkt (Var "base" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Add (Mop (SE F64) (Var "offset" F16))
+        (Mop Fst
+          (Apply (Call "GPR" (ATy qTy (PTy F64 qTy)) (Var "base" (FTy 5)))
+            qVar"state")))
+      (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+        (Call "AddressTranslation" (PTy F64 (FTy 3))
+          (TP
+            (sqbkt (Var "v" F64) (LC "DATA" CTy"IorD")
+                   (LC "STORE" CTy"LorS"))))
+        (Let (Var "v0" F64)
+          (CC(sqbkt (EX (Var "pAddr" F64)
+                      (Bop Sub (Const "PSIZE" nTy) (LN 1)) (LN 3)
+                      (FTy 61))
+                    (Bop BXor (EX (Var "pAddr" F64) (LN 2) (LN 0) (FTy 3))
+                      (Bop Rep
+                        (Mop Fst
+                          (Apply
+                            (Const "ReverseEndian" (ATy qTy (PTy F1 qTy)))
+                            qVar"state")) (LN 3)))))
+          (Let (Var "v1" (FTy 3))
+            (Bop BXor (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+              (Bop Rep
+                (Mop Fst
+                  (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                    qVar"state")) (LN 3)))
+            (Let (TP (sqbkt (Var "v2" F64) qVar"s0"))
+              (CS (Var "v1" (FTy 3))
+                (sqbkt ((LW 0 3)
+                         (TP
+                           (sqbkt (Mop Fst
+                                    (Apply
+                                      (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                        (Var "rt" (FTy 5))) qVar"state"))
+                                  qVar"state")))
+                       ((LW 1 3)
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 63) (LN 8)
+                                        (FTy 56))) (LN 8)) qVar"state")))
+                       ((LW 2 3)
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 63) (LN 16)
+                                        (FTy 48))) (LN 16)) qVar"state")))
+                       ((LW 3 3)
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 63) (LN 24)
+                                        (FTy 40))) (LN 24)) qVar"state")))
+                       ((LW 4 3)
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 63) (LN 32)
+                                        F32)) (LN 32)) qVar"state")))
+                       ((LW 5 3)
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 63) (LN 40)
+                                        (FTy 24))) (LN 40)) qVar"state")))
+                       ((LW 6 3)
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 63) (LN 48)
+                                        F16)) (LN 48)) qVar"state")))
+                       ((LW 7 3)
+                         (TP
+                           (sqbkt (Bop Lsl
+                                    (Mop (Cast F64)
+                                      (EX
+                                        (Mop Fst
+                                          (Apply
+                                            (Call "GPR"
+                                              (ATy qTy (PTy F64 qTy))
+                                              (Var "rt" (FTy 5)))
+                                            qVar"state")) (LN 63) (LN 56)
+                                        F8)) (LN 56)) qVar"state")))))
+              (Apply
+                (Call "StoreMemory" (ATy qTy (PTy uTy qTy))
+                  (TP
+                    (sqbkt (Var "CCA" (FTy 3))
+                           (Bop Sub (Const "DOUBLEWORD" (FTy 3))
+                             (Var "v1" (FTy 3))) (Var "v2" F64)
+                           (ITE
+                             (Mop Fst
+                               (Apply
+                                 (Const "BigEndianMem"
+                                   (ATy qTy (PTy bTy qTy))) qVar"state"))
+                             (Var "v0" F64)
+                             (Bop BAnd (Var "v0" F64)
+                               (Mop BNot (LW 7 64)))) (Var "v" F64)
+                           (LC "DATA" CTy"IorD")))) qVar"s0"))))))))
+
+
+(Def "dfn'SYNC" (Var "stype" (FTy 5)) LU)
+
+
+(Def "dfn'BREAK" qVar"state"
+  (Apply
+    (Call "SignalException" (ATy qTy (PTy uTy qTy))
+      (LC "Bp" CTy"ExceptionType")) qVar"state"))
+
+
+(Def "dfn'SYSCALL" qVar"state"
+  (Apply
+    (Call "SignalException" (ATy qTy (PTy uTy qTy))
+      (LC "Sys" CTy"ExceptionType")) qVar"state"))
+
+
+(Def "dfn'ERET" qVar"state"
+  (TP
+    (sqbkt LU
+           (Rupd "LLbit"
+             (TP
+               (sqbkt (ITE
+                        (Dest "ERL" bTy
+                          (Dest "Status" CTy"StatusRegister"
+                            (Dest "CP0" CTy"CP0" qVar"state")))
+                        (Let qVar"s"
+                          (Rupd "PC"
+                            (TP
+                              (sqbkt qVar"state"
+                                     (Dest "ErrorEPC" F64
+                                       (Dest "CP0" CTy"CP0" qVar"state")))))
+                          (Let (Var "v" CTy"CP0")
+                            (Dest "CP0" CTy"CP0" qVar"s")
+                            (Rupd "CP0"
+                              (TP
+                                (sqbkt qVar"s"
+                                       (Rupd "Status"
+                                         (TP
+                                           (sqbkt (Var "v" CTy"CP0")
+                                                  (Rupd "ERL"
+                                                    (TP
+                                                      (sqbkt (Dest
+                                                               "Status"
+                                                               CTy"StatusRegister"
+                                                               (Var "v"
+                                                                 CTy"CP0"))
+                                                             LF)))))))))))
+                        (Let qVar"s"
+                          (Rupd "PC"
+                            (TP
+                              (sqbkt qVar"state"
+                                     (Dest "EPC" F64
+                                       (Dest "CP0" CTy"CP0" qVar"state")))))
+                          (Let (Var "v" CTy"CP0")
+                            (Dest "CP0" CTy"CP0" qVar"s")
+                            (Rupd "CP0"
+                              (TP
+                                (sqbkt qVar"s"
+                                       (Rupd "Status"
+                                         (TP
+                                           (sqbkt (Var "v" CTy"CP0")
+                                                  (Rupd "EXL"
+                                                    (TP
+                                                      (sqbkt (Dest
+                                                               "Status"
+                                                               CTy"StatusRegister"
+                                                               (Var "v"
+                                                                 CTy"CP0"))
+                                                             LF))))))))))))
+                      (Mop Some LF)))))))
+
+
+(Def "dfn'MTC0"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sel" (FTy 3))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'CPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rt" (FTy 5))) qVar"state")) LN 0
+                 (Var "rd" (FTy 5)) (Var "sel" (FTy 3))))) qVar"state")))
+
+
+(Def "dfn'DMTC0"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sel" (FTy 3))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'CPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rt" (FTy 5))) qVar"state")) LN 0
+                 (Var "rd" (FTy 5)) (Var "sel" (FTy 3))))) qVar"state")))
+
+
+(Def "dfn'MFC0"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sel" (FTy 3))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop (SE F64)
+                   (EX
+                     (Mop Fst
+                       (Apply
+                         (Call "CPR" (ATy qTy (PTy F64 qTy))
+                           (TP
+                             (sqbkt LN 0 (Var "rd" (FTy 5))
+                                    (Var "sel" (FTy 3))))) qVar"state"))
+                     (LN 32) (LN 0) (FTy 33))) (Var "rt" (FTy 5)))))
+      qVar"state")))
+
+
+(Def "dfn'DMFC0"
+  (TP (sqbkt (Var "rt" (FTy 5)) (Var "rd" (FTy 5)) (Var "sel" (FTy 3))))
+  (Close qVar"state"
+    (Apply
+      (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop Fst
+                   (Apply
+                     (Call "CPR" (ATy qTy (PTy F64 qTy))
+                       (TP
+                         (sqbkt LN 0 (Var "rd" (FTy 5))
+                                (Var "sel" (FTy 3))))) qVar"state"))
+                 (Var "rt" (FTy 5))))) qVar"state")))
+
+
+(Def "dfn'J" (Var "instr_index" (FTy 26))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (Rupd "BranchStatus"
+               (TP
+                 (sqbkt qVar"state"
+                        (Mop Some
+                          (CC(sqbkt (EX (Dest "PC" F64 qVar"state")
+                                      (LN 63) (LN 28) (FTy 36))
+                                    (Var "instr_index" (FTy 26)) (LW 0 2)))))))))))
+
+
+(Def "dfn'JAL" (Var "instr_index" (FTy 26))
+  (Close qVar"state"
+    (Let qVar"s"
+      (Mop Snd
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Bop Add (Dest "PC" F64 qVar"state") (LW 8 64))
+                     (LW 31 5)))) qVar"state"))
+      (TP
+        (sqbkt LU
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"s"
+                          (Mop Some
+                            (CC(sqbkt (EX (Dest "PC" F64 qVar"s") (LN 63)
+                                        (LN 28) (FTy 36))
+                                      (Var "instr_index" (FTy 26))
+                                      (LW 0 2))))))))))))
+
+
+(Def "dfn'JR" (Var "rs" (FTy 5))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (Rupd "BranchStatus"
+               (TP
+                 (sqbkt qVar"state"
+                        (Mop Some
+                          (Mop Fst
+                            (Apply
+                              (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                (Var "rs" (FTy 5))) qVar"state"))))))))))
+
+
+(Def "dfn'JALR" (TP (sqbkt (Var "rs" (FTy 5)) (Var "rd" (FTy 5))))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (Rupd "BranchStatus"
+               (TP
+                 (sqbkt (Mop Snd
+                          (Apply
+                            (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+                              (TP
+                                (sqbkt (Bop Add
+                                         (Dest "PC" F64 qVar"state")
+                                         (LW 8 64)) (Var "rd" (FTy 5)))))
+                            qVar"state"))
+                        (Mop Some
+                          (Mop Fst
+                            (Apply
+                              (Call "GPR" (ATy qTy (PTy F64 qTy))
+                                (Var "rs" (FTy 5))) qVar"state"))))))))))
+
+
+(Def "dfn'BEQ"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (EQ
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state"))
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rt" (FTy 5))) qVar"state")))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2))))))) qVar"state")))))
+
+
+(Def "dfn'BNE"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Mop Not
+                 (EQ
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2))))))) qVar"state")))))
+
+
+(Def "dfn'BLEZ" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Bop Le
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2))))))) qVar"state")))))
+
+
+(Def "dfn'BGTZ" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Bop Gt
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2))))))) qVar"state")))))
+
+
+(Def "dfn'BLTZ" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Bop Lt
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2))))))) qVar"state")))))
+
+
+(Def "dfn'BGEZ" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Bop Ge
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2))))))) qVar"state")))))
+
+
+(Def "dfn'BLTZAL" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let qVar"s"
+      (Mop Snd
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Bop Add (Dest "PC" F64 qVar"state") (LW 8 64))
+                     (LW 31 5)))) qVar"state"))
+      (TP
+        (sqbkt LU
+               (ITE
+                 (Bop Lt
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+                 (Rupd "BranchStatus"
+                   (TP
+                     (sqbkt qVar"s"
+                            (Mop Some
+                              (Bop Add (Dest "PC" F64 qVar"s")
+                                (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                  (LN 2))))))) qVar"s"))))))
+
+
+(Def "dfn'BGEZAL" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let qVar"s"
+      (Mop Snd
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Bop Add (Dest "PC" F64 qVar"state") (LW 8 64))
+                     (LW 31 5)))) qVar"state"))
+      (TP
+        (sqbkt LU
+               (ITE
+                 (Bop Ge
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+                 (Rupd "BranchStatus"
+                   (TP
+                     (sqbkt qVar"s"
+                            (Mop Some
+                              (Bop Add (Dest "PC" F64 qVar"s")
+                                (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                  (LN 2))))))) qVar"s"))))))
+
+
+(Def "dfn'BEQL"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (EQ
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state"))
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rt" (FTy 5))) qVar"state")))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2)))))))
+               (Rupd "PC"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Bop Add (Dest "PC" F64 qVar"state") (LW 4 64))))))))))
+
+
+(Def "dfn'BNEL"
+  (TP (sqbkt (Var "rs" (FTy 5)) (Var "rt" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Mop Not
+                 (EQ
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state"))
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rt" (FTy 5))) qVar"state"))))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2)))))))
+               (Rupd "PC"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Bop Add (Dest "PC" F64 qVar"state") (LW 4 64))))))))))
+
+
+(Def "dfn'BLEZL" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Bop Le
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2)))))))
+               (Rupd "PC"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Bop Add (Dest "PC" F64 qVar"state") (LW 4 64))))))))))
+
+
+(Def "dfn'BGTZL" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Bop Gt
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2)))))))
+               (Rupd "PC"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Bop Add (Dest "PC" F64 qVar"state") (LW 4 64))))))))))
+
+
+(Def "dfn'BLTZL" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Bop Lt
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2)))))))
+               (Rupd "PC"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Bop Add (Dest "PC" F64 qVar"state") (LW 4 64))))))))))
+
+
+(Def "dfn'BGEZL" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (ITE
+               (Bop Ge
+                 (Mop Fst
+                   (Apply
+                     (Call "GPR" (ATy qTy (PTy F64 qTy))
+                       (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+               (Rupd "BranchStatus"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Mop Some
+                            (Bop Add (Dest "PC" F64 qVar"state")
+                              (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                (LN 2)))))))
+               (Rupd "PC"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Bop Add (Dest "PC" F64 qVar"state") (LW 4 64))))))))))
+
+
+(Def "dfn'BLTZALL" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let qVar"s"
+      (Mop Snd
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Bop Add (Dest "PC" F64 qVar"state") (LW 8 64))
+                     (LW 31 5)))) qVar"state"))
+      (TP
+        (sqbkt LU
+               (ITE
+                 (Bop Lt
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+                 (Rupd "BranchStatus"
+                   (TP
+                     (sqbkt qVar"s"
+                            (Mop Some
+                              (Bop Add (Dest "PC" F64 qVar"s")
+                                (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                  (LN 2)))))))
+                 (Rupd "PC"
+                   (TP
+                     (sqbkt qVar"s"
+                            (Bop Add (Dest "PC" F64 qVar"s") (LW 4 64)))))))))))
+
+
+(Def "dfn'BGEZALL" (TP (sqbkt (Var "rs" (FTy 5)) (Var "offset" F16)))
+  (Close qVar"state"
+    (Let qVar"s"
+      (Mop Snd
+        (Apply
+          (Call "write'GPR" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Bop Add (Dest "PC" F64 qVar"state") (LW 8 64))
+                     (LW 31 5)))) qVar"state"))
+      (TP
+        (sqbkt LU
+               (ITE
+                 (Bop Ge
+                   (Mop Fst
+                     (Apply
+                       (Call "GPR" (ATy qTy (PTy F64 qTy))
+                         (Var "rs" (FTy 5))) qVar"state")) (LW 0 64))
+                 (Rupd "BranchStatus"
+                   (TP
+                     (sqbkt qVar"s"
+                            (Mop Some
+                              (Bop Add (Dest "PC" F64 qVar"s")
+                                (Bop Lsl (Mop (SE F64) (Var "offset" F16))
+                                  (LN 2)))))))
+                 (Rupd "PC"
+                   (TP
+                     (sqbkt qVar"s"
+                            (Bop Add (Dest "PC" F64 qVar"s") (LW 4 64)))))))))))
+
+
+(Def "dfn'ReservedInstruction" qVar"state"
+  (Apply
+    (Call "SignalException" (ATy qTy (PTy uTy qTy))
+      (LC "RI" CTy"ExceptionType")) qVar"state"))
+
+
+(Def "Run" (Var "v0" CTy"instruction")
+  (Close qVar"state"
+    (CS (Var "v0" CTy"instruction")
+      (sqbkt ((Const "BREAK" CTy"instruction")
+               (Apply (Const "dfn'BREAK" (ATy qTy (PTy uTy qTy)))
+                 qVar"state"))
+             ((Const "ERET" CTy"instruction")
+               (Apply (Const "dfn'ERET" (ATy qTy (PTy uTy qTy)))
+                 qVar"state"))
+             ((Const "ReservedInstruction" CTy"instruction")
+               (Apply
+                 (Const "dfn'ReservedInstruction" (ATy qTy (PTy uTy qTy)))
+                 qVar"state"))
+             ((Const "SYSCALL" CTy"instruction")
+               (Apply (Const "dfn'SYSCALL" (ATy qTy (PTy uTy qTy)))
+                 qVar"state"))
+             ((Call "SYNC" CTy"instruction" (Var "v120" (FTy 5)))
+               (TP
+                 (sqbkt (Call "dfn'SYNC" uTy (Var "v120" (FTy 5)))
+                        qVar"state")))
+             ((Call "ArithI" CTy"instruction" (Var "v1" CTy"ArithI"))
+               (CS (Var "v1" CTy"ArithI")
+                 (sqbkt ((Call "ADDI" CTy"ArithI"
+                            (Var "v2" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'ADDI" (ATy qTy (PTy uTy qTy))
+                              (Var "v2" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "ADDIU" CTy"ArithI"
+                            (Var "v3" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'ADDIU" (ATy qTy (PTy uTy qTy))
+                              (Var "v3" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "ANDI" CTy"ArithI"
+                            (Var "v4" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'ANDI" (ATy qTy (PTy uTy qTy))
+                              (Var "v4" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "DADDI" CTy"ArithI"
+                            (Var "v5" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'DADDI" (ATy qTy (PTy uTy qTy))
+                              (Var "v5" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "DADDIU" CTy"ArithI"
+                            (Var "v6" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'DADDIU" (ATy qTy (PTy uTy qTy))
+                              (Var "v6" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LUI" CTy"ArithI"
+                            (Var "v7" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'LUI" (ATy qTy (PTy uTy qTy))
+                              (Var "v7" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "ORI" CTy"ArithI"
+                            (Var "v8" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'ORI" (ATy qTy (PTy uTy qTy))
+                              (Var "v8" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SLTI" CTy"ArithI"
+                            (Var "v9" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SLTI" (ATy qTy (PTy uTy qTy))
+                              (Var "v9" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SLTIU" CTy"ArithI"
+                            (Var "v10" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SLTIU" (ATy qTy (PTy uTy qTy))
+                              (Var "v10" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "XORI" CTy"ArithI"
+                            (Var "v11" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'XORI" (ATy qTy (PTy uTy qTy))
+                              (Var "v11" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state")))))
+             ((Call "ArithR" CTy"instruction" (Var "v12" CTy"ArithR"))
+               (CS (Var "v12" CTy"ArithR")
+                 (sqbkt ((Call "ADD" CTy"ArithR"
+                            (Var "v13"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'ADD" (ATy qTy (PTy uTy qTy))
+                              (Var "v13"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "ADDU" CTy"ArithR"
+                            (Var "v14"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'ADDU" (ATy qTy (PTy uTy qTy))
+                              (Var "v14"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "AND" CTy"ArithR"
+                            (Var "v15"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'AND" (ATy qTy (PTy uTy qTy))
+                              (Var "v15"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DADD" CTy"ArithR"
+                            (Var "v16"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DADD" (ATy qTy (PTy uTy qTy))
+                              (Var "v16"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DADDU" CTy"ArithR"
+                            (Var "v17"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DADDU" (ATy qTy (PTy uTy qTy))
+                              (Var "v17"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSUB" CTy"ArithR"
+                            (Var "v18"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSUB" (ATy qTy (PTy uTy qTy))
+                              (Var "v18"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSUBU" CTy"ArithR"
+                            (Var "v19"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSUBU" (ATy qTy (PTy uTy qTy))
+                              (Var "v19"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "NOR" CTy"ArithR"
+                            (Var "v20"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'NOR" (ATy qTy (PTy uTy qTy))
+                              (Var "v20"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "OR" CTy"ArithR"
+                            (Var "v21"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'OR" (ATy qTy (PTy uTy qTy))
+                              (Var "v21"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SLT" CTy"ArithR"
+                            (Var "v22"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SLT" (ATy qTy (PTy uTy qTy))
+                              (Var "v22"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SLTU" CTy"ArithR"
+                            (Var "v23"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SLTU" (ATy qTy (PTy uTy qTy))
+                              (Var "v23"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SUB" CTy"ArithR"
+                            (Var "v24"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SUB" (ATy qTy (PTy uTy qTy))
+                              (Var "v24"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SUBU" CTy"ArithR"
+                            (Var "v25"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SUBU" (ATy qTy (PTy uTy qTy))
+                              (Var "v25"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "XOR" CTy"ArithR"
+                            (Var "v26"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'XOR" (ATy qTy (PTy uTy qTy))
+                              (Var "v26"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state")))))
+             ((Call "Branch" CTy"instruction" (Var "v27" CTy"Branch"))
+               (CS (Var "v27" CTy"Branch")
+                 (sqbkt ((Call "BEQ" CTy"Branch"
+                            (Var "v28" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'BEQ" (ATy qTy (PTy uTy qTy))
+                              (Var "v28" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "BEQL" CTy"Branch"
+                            (Var "v29" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'BEQL" (ATy qTy (PTy uTy qTy))
+                              (Var "v29" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "BGEZ" CTy"Branch"
+                            (Var "v30" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BGEZ" (ATy qTy (PTy uTy qTy))
+                              (Var "v30" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BGEZAL" CTy"Branch"
+                            (Var "v31" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BGEZAL" (ATy qTy (PTy uTy qTy))
+                              (Var "v31" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BGEZALL" CTy"Branch"
+                            (Var "v32" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BGEZALL" (ATy qTy (PTy uTy qTy))
+                              (Var "v32" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BGEZL" CTy"Branch"
+                            (Var "v33" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BGEZL" (ATy qTy (PTy uTy qTy))
+                              (Var "v33" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BGTZ" CTy"Branch"
+                            (Var "v34" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BGTZ" (ATy qTy (PTy uTy qTy))
+                              (Var "v34" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BGTZL" CTy"Branch"
+                            (Var "v35" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BGTZL" (ATy qTy (PTy uTy qTy))
+                              (Var "v35" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BLEZ" CTy"Branch"
+                            (Var "v36" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BLEZ" (ATy qTy (PTy uTy qTy))
+                              (Var "v36" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BLEZL" CTy"Branch"
+                            (Var "v37" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BLEZL" (ATy qTy (PTy uTy qTy))
+                              (Var "v37" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BLTZ" CTy"Branch"
+                            (Var "v38" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BLTZ" (ATy qTy (PTy uTy qTy))
+                              (Var "v38" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BLTZAL" CTy"Branch"
+                            (Var "v39" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BLTZAL" (ATy qTy (PTy uTy qTy))
+                              (Var "v39" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BLTZALL" CTy"Branch"
+                            (Var "v40" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BLTZALL" (ATy qTy (PTy uTy qTy))
+                              (Var "v40" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BLTZL" CTy"Branch"
+                            (Var "v41" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'BLTZL" (ATy qTy (PTy uTy qTy))
+                              (Var "v41" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "BNE" CTy"Branch"
+                            (Var "v42" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'BNE" (ATy qTy (PTy uTy qTy))
+                              (Var "v42" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "BNEL" CTy"Branch"
+                            (Var "v43" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'BNEL" (ATy qTy (PTy uTy qTy))
+                              (Var "v43" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "J" CTy"Branch" (Var "v44" (FTy 26)))
+                          (Apply
+                            (Call "dfn'J" (ATy qTy (PTy uTy qTy))
+                              (Var "v44" (FTy 26))) qVar"state"))
+                        ((Call "JAL" CTy"Branch" (Var "v45" (FTy 26)))
+                          (Apply
+                            (Call "dfn'JAL" (ATy qTy (PTy uTy qTy))
+                              (Var "v45" (FTy 26))) qVar"state"))
+                        ((Call "JALR" CTy"Branch"
+                            (Var "v46" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'JALR" (ATy qTy (PTy uTy qTy))
+                              (Var "v46" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "JR" CTy"Branch" (Var "v47" (FTy 5)))
+                          (Apply
+                            (Call "dfn'JR" (ATy qTy (PTy uTy qTy))
+                              (Var "v47" (FTy 5))) qVar"state")))))
+             ((Call "CP" CTy"instruction" (Var "v48" CTy"CP"))
+               (CS (Var "v48" CTy"CP")
+                 (sqbkt ((Call "DMFC0" CTy"CP"
+                            (Var "v49"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                          (Apply
+                            (Call "dfn'DMFC0" (ATy qTy (PTy uTy qTy))
+                              (Var "v49"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                            qVar"state"))
+                        ((Call "DMTC0" CTy"CP"
+                            (Var "v50"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                          (Apply
+                            (Call "dfn'DMTC0" (ATy qTy (PTy uTy qTy))
+                              (Var "v50"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                            qVar"state"))
+                        ((Call "MFC0" CTy"CP"
+                            (Var "v51"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                          (Apply
+                            (Call "dfn'MFC0" (ATy qTy (PTy uTy qTy))
+                              (Var "v51"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                            qVar"state"))
+                        ((Call "MTC0" CTy"CP"
+                            (Var "v52"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                          (Apply
+                            (Call "dfn'MTC0" (ATy qTy (PTy uTy qTy))
+                              (Var "v52"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 3)))))
+                            qVar"state")))))
+             ((Call "Load" CTy"instruction" (Var "v53" CTy"Load"))
+               (CS (Var "v53" CTy"Load")
+                 (sqbkt ((Call "LB" CTy"Load"
+                            (Var "v54" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LB" (ATy qTy (PTy uTy qTy))
+                              (Var "v54" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LBU" CTy"Load"
+                            (Var "v55" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LBU" (ATy qTy (PTy uTy qTy))
+                              (Var "v55" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LD" CTy"Load"
+                            (Var "v56" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LD" (ATy qTy (PTy uTy qTy))
+                              (Var "v56" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LDL" CTy"Load"
+                            (Var "v57" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LDL" (ATy qTy (PTy uTy qTy))
+                              (Var "v57" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LDR" CTy"Load"
+                            (Var "v58" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LDR" (ATy qTy (PTy uTy qTy))
+                              (Var "v58" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LH" CTy"Load"
+                            (Var "v59" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LH" (ATy qTy (PTy uTy qTy))
+                              (Var "v59" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LHU" CTy"Load"
+                            (Var "v60" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LHU" (ATy qTy (PTy uTy qTy))
+                              (Var "v60" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LL" CTy"Load"
+                            (Var "v61" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LL" (ATy qTy (PTy uTy qTy))
+                              (Var "v61" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LLD" CTy"Load"
+                            (Var "v62" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LLD" (ATy qTy (PTy uTy qTy))
+                              (Var "v62" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LW" CTy"Load"
+                            (Var "v63" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LW" (ATy qTy (PTy uTy qTy))
+                              (Var "v63" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LWL" CTy"Load"
+                            (Var "v64" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LWL" (ATy qTy (PTy uTy qTy))
+                              (Var "v64" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LWR" CTy"Load"
+                            (Var "v65" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LWR" (ATy qTy (PTy uTy qTy))
+                              (Var "v65" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "LWU" CTy"Load"
+                            (Var "v66" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'LWU" (ATy qTy (PTy uTy qTy))
+                              (Var "v66" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state")))))
+             ((Call "MultDiv" CTy"instruction" (Var "v67" CTy"MultDiv"))
+               (CS (Var "v67" CTy"MultDiv")
+                 (sqbkt ((Call "DDIV" CTy"MultDiv"
+                            (Var "v68" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'DDIV" (ATy qTy (PTy uTy qTy))
+                              (Var "v68" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "DDIVU" CTy"MultDiv"
+                            (Var "v69" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'DDIVU" (ATy qTy (PTy uTy qTy))
+                              (Var "v69" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "DIV" CTy"MultDiv"
+                            (Var "v70" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'DIV" (ATy qTy (PTy uTy qTy))
+                              (Var "v70" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "DIVU" CTy"MultDiv"
+                            (Var "v71" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'DIVU" (ATy qTy (PTy uTy qTy))
+                              (Var "v71" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "DMULT" CTy"MultDiv"
+                            (Var "v72" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'DMULT" (ATy qTy (PTy uTy qTy))
+                              (Var "v72" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "DMULTU" CTy"MultDiv"
+                            (Var "v73" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'DMULTU" (ATy qTy (PTy uTy qTy))
+                              (Var "v73" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "MFHI" CTy"MultDiv" (Var "v74" (FTy 5)))
+                          (Apply
+                            (Call "dfn'MFHI" (ATy qTy (PTy uTy qTy))
+                              (Var "v74" (FTy 5))) qVar"state"))
+                        ((Call "MFLO" CTy"MultDiv" (Var "v75" (FTy 5)))
+                          (Apply
+                            (Call "dfn'MFLO" (ATy qTy (PTy uTy qTy))
+                              (Var "v75" (FTy 5))) qVar"state"))
+                        ((Call "MTHI" CTy"MultDiv" (Var "v76" (FTy 5)))
+                          (Apply
+                            (Call "dfn'MTHI" (ATy qTy (PTy uTy qTy))
+                              (Var "v76" (FTy 5))) qVar"state"))
+                        ((Call "MTLO" CTy"MultDiv" (Var "v77" (FTy 5)))
+                          (Apply
+                            (Call "dfn'MTLO" (ATy qTy (PTy uTy qTy))
+                              (Var "v77" (FTy 5))) qVar"state"))
+                        ((Call "MULT" CTy"MultDiv"
+                            (Var "v78" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'MULT" (ATy qTy (PTy uTy qTy))
+                              (Var "v78" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "MULTU" CTy"MultDiv"
+                            (Var "v79" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'MULTU" (ATy qTy (PTy uTy qTy))
+                              (Var "v79" (PTy (FTy 5) (FTy 5))))
+                            qVar"state")))))
+             ((Call "Shift" CTy"instruction" (Var "v80" CTy"Shift"))
+               (CS (Var "v80" CTy"Shift")
+                 (sqbkt ((Call "DSLL" CTy"Shift"
+                            (Var "v81"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSLL" (ATy qTy (PTy uTy qTy))
+                              (Var "v81"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSLL32" CTy"Shift"
+                            (Var "v82"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSLL32" (ATy qTy (PTy uTy qTy))
+                              (Var "v82"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSLLV" CTy"Shift"
+                            (Var "v83"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSLLV" (ATy qTy (PTy uTy qTy))
+                              (Var "v83"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSRA" CTy"Shift"
+                            (Var "v84"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSRA" (ATy qTy (PTy uTy qTy))
+                              (Var "v84"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSRA32" CTy"Shift"
+                            (Var "v85"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSRA32" (ATy qTy (PTy uTy qTy))
+                              (Var "v85"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSRAV" CTy"Shift"
+                            (Var "v86"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSRAV" (ATy qTy (PTy uTy qTy))
+                              (Var "v86"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSRL" CTy"Shift"
+                            (Var "v87"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSRL" (ATy qTy (PTy uTy qTy))
+                              (Var "v87"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSRL32" CTy"Shift"
+                            (Var "v88"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSRL32" (ATy qTy (PTy uTy qTy))
+                              (Var "v88"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "DSRLV" CTy"Shift"
+                            (Var "v89"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'DSRLV" (ATy qTy (PTy uTy qTy))
+                              (Var "v89"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SLL" CTy"Shift"
+                            (Var "v90"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SLL" (ATy qTy (PTy uTy qTy))
+                              (Var "v90"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SLLV" CTy"Shift"
+                            (Var "v91"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SLLV" (ATy qTy (PTy uTy qTy))
+                              (Var "v91"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SRA" CTy"Shift"
+                            (Var "v92"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SRA" (ATy qTy (PTy uTy qTy))
+                              (Var "v92"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SRAV" CTy"Shift"
+                            (Var "v93"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SRAV" (ATy qTy (PTy uTy qTy))
+                              (Var "v93"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SRL" CTy"Shift"
+                            (Var "v94"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SRL" (ATy qTy (PTy uTy qTy))
+                              (Var "v94"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state"))
+                        ((Call "SRLV" CTy"Shift"
+                            (Var "v95"
+                              (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                          (Apply
+                            (Call "dfn'SRLV" (ATy qTy (PTy uTy qTy))
+                              (Var "v95"
+                                (PTy (FTy 5) (PTy (FTy 5) (FTy 5)))))
+                            qVar"state")))))
+             ((Call "Store" CTy"instruction" (Var "v96" CTy"Store"))
+               (CS (Var "v96" CTy"Store")
+                 (sqbkt ((Call "SB" CTy"Store"
+                            (Var "v97" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SB" (ATy qTy (PTy uTy qTy))
+                              (Var "v97" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SC" CTy"Store"
+                            (Var "v98" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SC" (ATy qTy (PTy uTy qTy))
+                              (Var "v98" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SCD" CTy"Store"
+                            (Var "v99" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SCD" (ATy qTy (PTy uTy qTy))
+                              (Var "v99" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SD" CTy"Store"
+                            (Var "v100" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SD" (ATy qTy (PTy uTy qTy))
+                              (Var "v100" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SDL" CTy"Store"
+                            (Var "v101" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SDL" (ATy qTy (PTy uTy qTy))
+                              (Var "v101" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SDR" CTy"Store"
+                            (Var "v102" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SDR" (ATy qTy (PTy uTy qTy))
+                              (Var "v102" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SH" CTy"Store"
+                            (Var "v103" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SH" (ATy qTy (PTy uTy qTy))
+                              (Var "v103" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SW" CTy"Store"
+                            (Var "v104" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SW" (ATy qTy (PTy uTy qTy))
+                              (Var "v104" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SWL" CTy"Store"
+                            (Var "v105" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SWL" (ATy qTy (PTy uTy qTy))
+                              (Var "v105" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state"))
+                        ((Call "SWR" CTy"Store"
+                            (Var "v106" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                          (Apply
+                            (Call "dfn'SWR" (ATy qTy (PTy uTy qTy))
+                              (Var "v106" (PTy (FTy 5) (PTy (FTy 5) F16))))
+                            qVar"state")))))
+             ((Call "Trap" CTy"instruction" (Var "v107" CTy"Trap"))
+               (CS (Var "v107" CTy"Trap")
+                 (sqbkt ((Call "TEQ" CTy"Trap"
+                            (Var "v108" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'TEQ" (ATy qTy (PTy uTy qTy))
+                              (Var "v108" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "TEQI" CTy"Trap"
+                            (Var "v109" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'TEQI" (ATy qTy (PTy uTy qTy))
+                              (Var "v109" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "TGE" CTy"Trap"
+                            (Var "v110" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'TGE" (ATy qTy (PTy uTy qTy))
+                              (Var "v110" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "TGEI" CTy"Trap"
+                            (Var "v111" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'TGEI" (ATy qTy (PTy uTy qTy))
+                              (Var "v111" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "TGEIU" CTy"Trap"
+                            (Var "v112" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'TGEIU" (ATy qTy (PTy uTy qTy))
+                              (Var "v112" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "TGEU" CTy"Trap"
+                            (Var "v113" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'TGEU" (ATy qTy (PTy uTy qTy))
+                              (Var "v113" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "TLT" CTy"Trap"
+                            (Var "v114" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'TLT" (ATy qTy (PTy uTy qTy))
+                              (Var "v114" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "TLTI" CTy"Trap"
+                            (Var "v115" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'TLTI" (ATy qTy (PTy uTy qTy))
+                              (Var "v115" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "TLTIU" CTy"Trap"
+                            (Var "v116" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'TLTIU" (ATy qTy (PTy uTy qTy))
+                              (Var "v116" (PTy (FTy 5) F16))) qVar"state"))
+                        ((Call "TLTU" CTy"Trap"
+                            (Var "v117" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'TLTU" (ATy qTy (PTy uTy qTy))
+                              (Var "v117" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "TNE" CTy"Trap"
+                            (Var "v118" (PTy (FTy 5) (FTy 5))))
+                          (Apply
+                            (Call "dfn'TNE" (ATy qTy (PTy uTy qTy))
+                              (Var "v118" (PTy (FTy 5) (FTy 5))))
+                            qVar"state"))
+                        ((Call "TNEI" CTy"Trap"
+                            (Var "v119" (PTy (FTy 5) F16)))
+                          (Apply
+                            (Call "dfn'TNEI" (ATy qTy (PTy uTy qTy))
+                              (Var "v119" (PTy (FTy 5) F16))) qVar"state")))))))))
+
+
+(Def "Decode" (Var "w" F32)
+  (Let
+    (TP
+      (sqbkt bVar"b'31" bVar"b'30" bVar"b'29" bVar"b'28" bVar"b'27"
+             bVar"b'26" bVar"b'25" bVar"b'24" bVar"b'23" bVar"b'22"
+             bVar"b'21" bVar"b'20" bVar"b'19" bVar"b'18" bVar"b'17"
+             bVar"b'16" bVar"b'15" bVar"b'14" bVar"b'13" bVar"b'12"
+             bVar"b'11" bVar"b'10" bVar"b'9" bVar"b'8" bVar"b'7" bVar"b'6"
+             bVar"b'5" bVar"b'4" bVar"b'3" bVar"b'2" bVar"b'1" bVar"b'0"))
+    (BL 32 (Var "w" F32))
+    (ITE
+      (Bop And (Mop Not bVar"b'31")
+        (Bop And (Mop Not bVar"b'29") (Mop Not bVar"b'28")))
+      (ITB
+        (sqbkt ((Bop And (Mop Not bVar"b'30")
+                   (Bop And (Mop Not bVar"b'27") (Mop Not bVar"b'26")))
+                 (Let (Var "rt" (FTy 5))
+                   (EX (Var "w" F32) (LN 20) (LN 16) (FTy 5))
+                   (Let (Var "rs" (FTy 5))
+                     (EX (Var "w" F32) (LN 25) (LN 21) (FTy 5))
+                     (Let (Var "rd" (FTy 5))
+                       (EX (Var "w" F32) (LN 15) (LN 11) (FTy 5))
+                       (Let (Var "imm5" (FTy 5))
+                         (EX (Var "w" F32) (LN 10) (LN 6) (FTy 5))
+                         (Let
+                           (TP
+                             (sqbkt bVar"b'5" bVar"b'4" bVar"b'3"
+                                    bVar"b'2" bVar"b'1" bVar"b'0"))
+                           (BL 6 (EX (Var "w" F32) (LN 5) (LN 0) (FTy 6)))
+                           (ITB
+                             (sqbkt (bVar"b'5"
+                                      (ITB
+                                        (sqbkt (bVar"b'2"
+                                                 (ITB
+                                                   (sqbkt (bVar"b'3"
+                                                            (ITB
+                                                              (sqbkt ((Bop
+                                                                         And
+                                                                         (Mop
+                                                                           Not
+                                                                           bVar"b'4")
+                                                                         (Bop
+                                                                           And
+                                                                           (Mop
+                                                                             Not
+                                                                             bVar"b'1")
+                                                                           (Mop
+                                                                             Not
+                                                                             bVar"b'0")))
+                                                                       (Call
+                                                                         "ArithR"
+                                                                         CTy"instruction"
+                                                                         (Call
+                                                                           "DADD"
+                                                                           CTy"ArithR"
+                                                                           (TP
+                                                                             (sqbkt (Var
+                                                                                      "rs"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rt"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rd"
+                                                                                      (FTy
+                                                                                        5)))))))
+                                                                     ((Bop
+                                                                         And
+                                                                         (Mop
+                                                                           Not
+                                                                           bVar"b'4")
+                                                                         (Bop
+                                                                           And
+                                                                           (Mop
+                                                                             Not
+                                                                             bVar"b'1")
+                                                                           bVar"b'0"))
+                                                                       (Call
+                                                                         "ArithR"
+                                                                         CTy"instruction"
+                                                                         (Call
+                                                                           "DADDU"
+                                                                           CTy"ArithR"
+                                                                           (TP
+                                                                             (sqbkt (Var
+                                                                                      "rs"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rt"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rd"
+                                                                                      (FTy
+                                                                                        5)))))))
+                                                                     ((Bop
+                                                                         And
+                                                                         (Mop
+                                                                           Not
+                                                                           bVar"b'4")
+                                                                         (Bop
+                                                                           And
+                                                                           bVar"b'1"
+                                                                           (Mop
+                                                                             Not
+                                                                             bVar"b'0")))
+                                                                       (Call
+                                                                         "ArithR"
+                                                                         CTy"instruction"
+                                                                         (Call
+                                                                           "DSUB"
+                                                                           CTy"ArithR"
+                                                                           (TP
+                                                                             (sqbkt (Var
+                                                                                      "rs"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rt"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rd"
+                                                                                      (FTy
+                                                                                        5)))))))
+                                                                     ((Bop
+                                                                         And
+                                                                         (Mop
+                                                                           Not
+                                                                           bVar"b'4")
+                                                                         (Bop
+                                                                           And
+                                                                           bVar"b'1"
+                                                                           bVar"b'0"))
+                                                                       (Call
+                                                                         "ArithR"
+                                                                         CTy"instruction"
+                                                                         (Call
+                                                                           "DSUBU"
+                                                                           CTy"ArithR"
+                                                                           (TP
+                                                                             (sqbkt (Var
+                                                                                      "rs"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rt"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rd"
+                                                                                      (FTy
+                                                                                        5)))))))
+                                                                     ((Bop
+                                                                         And
+                                                                         bVar"b'4"
+                                                                         (Bop
+                                                                           And
+                                                                           (Mop
+                                                                             Not
+                                                                             bVar"b'1")
+                                                                           (Mop
+                                                                             Not
+                                                                             bVar"b'0")))
+                                                                       (Call
+                                                                         "Shift"
+                                                                         CTy"instruction"
+                                                                         (Call
+                                                                           "DSLL32"
+                                                                           CTy"Shift"
+                                                                           (TP
+                                                                             (sqbkt (Var
+                                                                                      "rt"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rd"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "imm5"
+                                                                                      (FTy
+                                                                                        5)))))))
+                                                                     ((Bop
+                                                                         And
+                                                                         bVar"b'4"
+                                                                         (Bop
+                                                                           And
+                                                                           bVar"b'1"
+                                                                           (Mop
+                                                                             Not
+                                                                             bVar"b'0")))
+                                                                       (Call
+                                                                         "Shift"
+                                                                         CTy"instruction"
+                                                                         (Call
+                                                                           "DSRL32"
+                                                                           CTy"Shift"
+                                                                           (TP
+                                                                             (sqbkt (Var
+                                                                                      "rt"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rd"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "imm5"
+                                                                                      (FTy
+                                                                                        5)))))))
+                                                                     ((Bop
+                                                                         And
+                                                                         bVar"b'4"
+                                                                         (Bop
+                                                                           And
+                                                                           bVar"b'1"
+                                                                           bVar"b'0"))
+                                                                       (Call
+                                                                         "Shift"
+                                                                         CTy"instruction"
+                                                                         (Call
+                                                                           "DSRA32"
+                                                                           CTy"Shift"
+                                                                           (TP
+                                                                             (sqbkt (Var
+                                                                                      "rt"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "rd"
+                                                                                      (FTy
+                                                                                        5))
+                                                                                    (Var
+                                                                                      "imm5"
+                                                                                      (FTy
+                                                                                        5))))))))
+                                                              (Const
+                                                                "ReservedInstruction"
+                                                                CTy"instruction")))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "ArithR"
+                                                              CTy"instruction"
+                                                              (Call "AND"
+                                                                CTy"ArithR"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rd"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                bVar"b'0"))
+                                                            (Call "ArithR"
+                                                              CTy"instruction"
+                                                              (Call "OR"
+                                                                CTy"ArithR"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rd"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "ArithR"
+                                                              CTy"instruction"
+                                                              (Call "XOR"
+                                                                CTy"ArithR"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rd"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                bVar"b'0"))
+                                                            (Call "ArithR"
+                                                              CTy"instruction"
+                                                              (Call "NOR"
+                                                                CTy"ArithR"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rd"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              bVar"b'4"
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Trap"
+                                                              CTy"instruction"
+                                                              (Call "TEQ"
+                                                                CTy"Trap"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              bVar"b'4"
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Trap"
+                                                              CTy"instruction"
+                                                              (Call "TNE"
+                                                                CTy"Trap"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))))))))
+                                                   (Const
+                                                     "ReservedInstruction"
+                                                     CTy"instruction")))
+                                               (bVar"b'4"
+                                                 (ITB
+                                                   (sqbkt ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'3")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Trap"
+                                                              CTy"instruction"
+                                                              (Call "TGE"
+                                                                CTy"Trap"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'3")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                bVar"b'0"))
+                                                            (Call "Trap"
+                                                              CTy"instruction"
+                                                              (Call "TGEU"
+                                                                CTy"Trap"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'3")
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Trap"
+                                                              CTy"instruction"
+                                                              (Call "TLT"
+                                                                CTy"Trap"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'3")
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                bVar"b'0"))
+                                                            (Call "Trap"
+                                                              CTy"instruction"
+                                                              (Call "TLTU"
+                                                                CTy"Trap"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              bVar"b'3"
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Shift"
+                                                              CTy"instruction"
+                                                              (Call "DSLL"
+                                                                CTy"Shift"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rd"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "imm5"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              bVar"b'3"
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Shift"
+                                                              CTy"instruction"
+                                                              (Call "DSRL"
+                                                                CTy"Shift"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rd"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "imm5"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              bVar"b'3"
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                bVar"b'0"))
+                                                            (Call "Shift"
+                                                              CTy"instruction"
+                                                              (Call "DSRA"
+                                                                CTy"Shift"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rd"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "imm5"
+                                                                           (FTy
+                                                                             5))))))))
+                                                   (Const
+                                                     "ReservedInstruction"
+                                                     CTy"instruction")))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'3")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "ArithR"
+                                                   CTy"instruction"
+                                                   (Call "ADD" CTy"ArithR"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5)))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'3")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     bVar"b'0"))
+                                                 (Call "ArithR"
+                                                   CTy"instruction"
+                                                   (Call "ADDU"
+                                                     CTy"ArithR"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5)))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'3")
+                                                   (Bop And bVar"b'1"
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "ArithR"
+                                                   CTy"instruction"
+                                                   (Call "SUB" CTy"ArithR"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5)))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'3")
+                                                   (Bop And bVar"b'1"
+                                                     bVar"b'0"))
+                                                 (Call "ArithR"
+                                                   CTy"instruction"
+                                                   (Call "SUBU"
+                                                     CTy"ArithR"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5)))))))
+                                               ((Bop And bVar"b'3"
+                                                   (Bop And bVar"b'1"
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "ArithR"
+                                                   CTy"instruction"
+                                                   (Call "SLT" CTy"ArithR"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5)))))))
+                                               ((Bop And bVar"b'3"
+                                                   (Bop And bVar"b'1"
+                                                     bVar"b'0"))
+                                                 (Call "ArithR"
+                                                   CTy"instruction"
+                                                   (Call "SLTU"
+                                                     CTy"ArithR"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5))))))))
+                                        (Const "ReservedInstruction"
+                                          CTy"instruction")))
+                                    (bVar"b'3"
+                                      (ITB
+                                        (sqbkt (bVar"b'2"
+                                                 (ITB
+                                                   (sqbkt ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Const
+                                                              "SYSCALL"
+                                                              CTy"instruction"))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                bVar"b'0"))
+                                                            (Const "BREAK"
+                                                              CTy"instruction"))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                bVar"b'0"))
+                                                            (Call "SYNC"
+                                                              CTy"instruction"
+                                                              (Var "imm5"
+                                                                (FTy 5))))
+                                                          ((Bop And
+                                                              bVar"b'4"
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call
+                                                              "MultDiv"
+                                                              CTy"instruction"
+                                                              (Call
+                                                                "DMULT"
+                                                                CTy"MultDiv"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              bVar"b'4"
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                bVar"b'0"))
+                                                            (Call
+                                                              "MultDiv"
+                                                              CTy"instruction"
+                                                              (Call
+                                                                "DMULTU"
+                                                                CTy"MultDiv"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              bVar"b'4"
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call
+                                                              "MultDiv"
+                                                              CTy"instruction"
+                                                              (Call "DDIV"
+                                                                CTy"MultDiv"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5)))))))
+                                                          ((Bop And
+                                                              bVar"b'4"
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                bVar"b'0"))
+                                                            (Call
+                                                              "MultDiv"
+                                                              CTy"instruction"
+                                                              (Call
+                                                                "DDIVU"
+                                                                CTy"MultDiv"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))))))))
+                                                   (Const
+                                                     "ReservedInstruction"
+                                                     CTy"instruction")))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Branch"
+                                                   CTy"instruction"
+                                                   (Call "JR" CTy"Branch"
+                                                     (Var "rs" (FTy 5)))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     bVar"b'0"))
+                                                 (Call "Branch"
+                                                   CTy"instruction"
+                                                   (Call "JALR"
+                                                     CTy"Branch"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5)))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "MultDiv"
+                                                   CTy"instruction"
+                                                   (Call "MULT"
+                                                     CTy"MultDiv"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5)))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     bVar"b'0"))
+                                                 (Call "MultDiv"
+                                                   CTy"instruction"
+                                                   (Call "MULTU"
+                                                     CTy"MultDiv"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5)))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And bVar"b'1"
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "MultDiv"
+                                                   CTy"instruction"
+                                                   (Call "DIV"
+                                                     CTy"MultDiv"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5)))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And bVar"b'1"
+                                                     bVar"b'0"))
+                                                 (Call "MultDiv"
+                                                   CTy"instruction"
+                                                   (Call "DIVU"
+                                                     CTy"MultDiv"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))))))))
+                                        (Const "ReservedInstruction"
+                                          CTy"instruction")))
+                                    (bVar"b'4"
+                                      (ITB
+                                        (sqbkt ((Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "MultDiv"
+                                                   CTy"instruction"
+                                                   (Call "MFHI"
+                                                     CTy"MultDiv"
+                                                     (Var "rd" (FTy 5)))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     bVar"b'0"))
+                                                 (Call "MultDiv"
+                                                   CTy"instruction"
+                                                   (Call "MTHI"
+                                                     CTy"MultDiv"
+                                                     (Var "rd" (FTy 5)))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   (Bop And bVar"b'1"
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "MultDiv"
+                                                   CTy"instruction"
+                                                   (Call "MFLO"
+                                                     CTy"MultDiv"
+                                                     (Var "rs" (FTy 5)))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   (Bop And bVar"b'1"
+                                                     bVar"b'0"))
+                                                 (Call "MultDiv"
+                                                   CTy"instruction"
+                                                   (Call "MTLO"
+                                                     CTy"MultDiv"
+                                                     (Var "rs" (FTy 5)))))
+                                               ((Bop And bVar"b'2"
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Shift"
+                                                   CTy"instruction"
+                                                   (Call "DSLLV"
+                                                     CTy"Shift"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5)))))))
+                                               ((Bop And bVar"b'2"
+                                                   (Bop And bVar"b'1"
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Shift"
+                                                   CTy"instruction"
+                                                   (Call "DSRLV"
+                                                     CTy"Shift"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5)))))))
+                                               ((Bop And bVar"b'2"
+                                                   (Bop And bVar"b'1"
+                                                     bVar"b'0"))
+                                                 (Call "Shift"
+                                                   CTy"instruction"
+                                                   (Call "DSRAV"
+                                                     CTy"Shift"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var "rd"
+                                                                (FTy 5))))))))
+                                        (Const "ReservedInstruction"
+                                          CTy"instruction")))
+                                    ((Bop And (Mop Not bVar"b'2")
+                                        (Bop And (Mop Not bVar"b'1")
+                                          (Mop Not bVar"b'0")))
+                                      (Call "Shift" CTy"instruction"
+                                        (Call "SLL" CTy"Shift"
+                                          (TP
+                                            (sqbkt (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5))
+                                                   (Var "imm5" (FTy 5)))))))
+                                    ((Bop And (Mop Not bVar"b'2")
+                                        (Bop And bVar"b'1"
+                                          (Mop Not bVar"b'0")))
+                                      (Call "Shift" CTy"instruction"
+                                        (Call "SRL" CTy"Shift"
+                                          (TP
+                                            (sqbkt (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5))
+                                                   (Var "imm5" (FTy 5)))))))
+                                    ((Bop And (Mop Not bVar"b'2")
+                                        (Bop And bVar"b'1" bVar"b'0"))
+                                      (Call "Shift" CTy"instruction"
+                                        (Call "SRA" CTy"Shift"
+                                          (TP
+                                            (sqbkt (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5))
+                                                   (Var "imm5" (FTy 5)))))))
+                                    ((Bop And bVar"b'2"
+                                        (Bop And (Mop Not bVar"b'1")
+                                          (Mop Not bVar"b'0")))
+                                      (Call "Shift" CTy"instruction"
+                                        (Call "SLLV" CTy"Shift"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5)))))))
+                                    ((Bop And bVar"b'2"
+                                        (Bop And bVar"b'1"
+                                          (Mop Not bVar"b'0")))
+                                      (Call "Shift" CTy"instruction"
+                                        (Call "SRLV" CTy"Shift"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5)))))))
+                                    ((Bop And bVar"b'2"
+                                        (Bop And bVar"b'1" bVar"b'0"))
+                                      (Call "Shift" CTy"instruction"
+                                        (Call "SRAV" CTy"Shift"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5))))))))
+                             (Const "ReservedInstruction"
+                               CTy"instruction"))))))))
+               ((Bop And (Mop Not bVar"b'30")
+                   (Bop And (Mop Not bVar"b'27") bVar"b'26"))
+                 (Let (Var "rs" (FTy 5))
+                   (EX (Var "w" F32) (LN 25) (LN 21) (FTy 5))
+                   (Let (Var "immediate" F16)
+                     (EX (Var "w" F32) (LN 15) (LN 0) F16)
+                     (Let
+                       (TP
+                         (sqbkt bVar"b'4" bVar"b'3" bVar"b'2" bVar"b'1"
+                                bVar"b'0"))
+                       (BL 5 (EX (Var "w" F32) (LN 20) (LN 16) (FTy 5)))
+                       (ITB
+                         (sqbkt (bVar"b'1"
+                                  (ITB
+                                    (sqbkt ((Bop And (Mop Not bVar"b'4")
+                                               (Bop And
+                                                 (Mop Not bVar"b'3")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   (Mop Not bVar"b'0"))))
+                                             (Call "Branch"
+                                               CTy"instruction"
+                                               (Call "BLTZL" CTy"Branch"
+                                                 (TP
+                                                   (sqbkt (Var "rs"
+                                                            (FTy 5))
+                                                          (Var "immediate"
+                                                            F16))))))
+                                           ((Bop And (Mop Not bVar"b'4")
+                                               (Bop And
+                                                 (Mop Not bVar"b'3")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   bVar"b'0")))
+                                             (Call "Branch"
+                                               CTy"instruction"
+                                               (Call "BGEZL" CTy"Branch"
+                                                 (TP
+                                                   (sqbkt (Var "rs"
+                                                            (FTy 5))
+                                                          (Var "immediate"
+                                                            F16))))))
+                                           ((Bop And (Mop Not bVar"b'4")
+                                               (Bop And bVar"b'3"
+                                                 (Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   (Mop Not bVar"b'0"))))
+                                             (Call "Trap" CTy"instruction"
+                                               (Call "TLTI" CTy"Trap"
+                                                 (TP
+                                                   (sqbkt (Var "rs"
+                                                            (FTy 5))
+                                                          (Var "immediate"
+                                                            F16))))))
+                                           ((Bop And (Mop Not bVar"b'4")
+                                               (Bop And bVar"b'3"
+                                                 (Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   bVar"b'0")))
+                                             (Call "Trap" CTy"instruction"
+                                               (Call "TLTIU" CTy"Trap"
+                                                 (TP
+                                                   (sqbkt (Var "rs"
+                                                            (FTy 5))
+                                                          (Var "immediate"
+                                                            F16))))))
+                                           ((Bop And (Mop Not bVar"b'4")
+                                               (Bop And bVar"b'3"
+                                                 (Bop And bVar"b'2"
+                                                   (Mop Not bVar"b'0"))))
+                                             (Call "Trap" CTy"instruction"
+                                               (Call "TNEI" CTy"Trap"
+                                                 (TP
+                                                   (sqbkt (Var "rs"
+                                                            (FTy 5))
+                                                          (Var "immediate"
+                                                            F16))))))
+                                           ((Bop And bVar"b'4"
+                                               (Bop And
+                                                 (Mop Not bVar"b'3")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   (Mop Not bVar"b'0"))))
+                                             (Call "Branch"
+                                               CTy"instruction"
+                                               (Call "BLTZALL" CTy"Branch"
+                                                 (TP
+                                                   (sqbkt (Var "rs"
+                                                            (FTy 5))
+                                                          (Var "immediate"
+                                                            F16))))))
+                                           ((Bop And bVar"b'4"
+                                               (Bop And
+                                                 (Mop Not bVar"b'3")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'2")
+                                                   bVar"b'0")))
+                                             (Call "Branch"
+                                               CTy"instruction"
+                                               (Call "BGEZALL" CTy"Branch"
+                                                 (TP
+                                                   (sqbkt (Var "rs"
+                                                            (FTy 5))
+                                                          (Var "immediate"
+                                                            F16)))))))
+                                    (Const "ReservedInstruction"
+                                      CTy"instruction")))
+                                ((Bop And (Mop Not bVar"b'4")
+                                    (Bop And (Mop Not bVar"b'3")
+                                      (Bop And (Mop Not bVar"b'2")
+                                        (Mop Not bVar"b'0"))))
+                                  (Call "Branch" CTy"instruction"
+                                    (Call "BLTZ" CTy"Branch"
+                                      (TP
+                                        (sqbkt (Var "rs" (FTy 5))
+                                               (Var "immediate" F16))))))
+                                ((Bop And (Mop Not bVar"b'4")
+                                    (Bop And (Mop Not bVar"b'3")
+                                      (Bop And (Mop Not bVar"b'2")
+                                        bVar"b'0")))
+                                  (Call "Branch" CTy"instruction"
+                                    (Call "BGEZ" CTy"Branch"
+                                      (TP
+                                        (sqbkt (Var "rs" (FTy 5))
+                                               (Var "immediate" F16))))))
+                                ((Bop And (Mop Not bVar"b'4")
+                                    (Bop And bVar"b'3"
+                                      (Bop And (Mop Not bVar"b'2")
+                                        (Mop Not bVar"b'0"))))
+                                  (Call "Trap" CTy"instruction"
+                                    (Call "TGEI" CTy"Trap"
+                                      (TP
+                                        (sqbkt (Var "rs" (FTy 5))
+                                               (Var "immediate" F16))))))
+                                ((Bop And (Mop Not bVar"b'4")
+                                    (Bop And bVar"b'3"
+                                      (Bop And (Mop Not bVar"b'2")
+                                        bVar"b'0")))
+                                  (Call "Trap" CTy"instruction"
+                                    (Call "TGEIU" CTy"Trap"
+                                      (TP
+                                        (sqbkt (Var "rs" (FTy 5))
+                                               (Var "immediate" F16))))))
+                                ((Bop And (Mop Not bVar"b'4")
+                                    (Bop And bVar"b'3"
+                                      (Bop And bVar"b'2"
+                                        (Mop Not bVar"b'0"))))
+                                  (Call "Trap" CTy"instruction"
+                                    (Call "TEQI" CTy"Trap"
+                                      (TP
+                                        (sqbkt (Var "rs" (FTy 5))
+                                               (Var "immediate" F16))))))
+                                ((Bop And bVar"b'4"
+                                    (Bop And (Mop Not bVar"b'3")
+                                      (Bop And (Mop Not bVar"b'2")
+                                        (Mop Not bVar"b'0"))))
+                                  (Call "Branch" CTy"instruction"
+                                    (Call "BLTZAL" CTy"Branch"
+                                      (TP
+                                        (sqbkt (Var "rs" (FTy 5))
+                                               (Var "immediate" F16))))))
+                                ((Bop And bVar"b'4"
+                                    (Bop And (Mop Not bVar"b'3")
+                                      (Bop And (Mop Not bVar"b'2")
+                                        bVar"b'0")))
+                                  (Call "Branch" CTy"instruction"
+                                    (Call "BGEZAL" CTy"Branch"
+                                      (TP
+                                        (sqbkt (Var "rs" (FTy 5))
+                                               (Var "immediate" F16)))))))
+                         (Const "ReservedInstruction" CTy"instruction"))))))
+               ((Bop And (Mop Not bVar"b'30")
+                   (Bop And bVar"b'27" (Mop Not bVar"b'26")))
+                 (Call "Branch" CTy"instruction"
+                   (Call "J" CTy"Branch"
+                     (EX (Var "w" F32) (LN 25) (LN 0) (FTy 26)))))
+               ((Bop And (Mop Not bVar"b'30")
+                   (Bop And bVar"b'27" bVar"b'26"))
+                 (Call "Branch" CTy"instruction"
+                   (Call "JAL" CTy"Branch"
+                     (EX (Var "w" F32) (LN 25) (LN 0) (FTy 26)))))
+               ((Bop And bVar"b'30"
+                   (Bop And (Mop Not bVar"b'27")
+                     (Bop And (Mop Not bVar"b'26")
+                       (Bop And (Mop Not bVar"b'10")
+                         (Bop And (Mop Not bVar"b'9")
+                           (Bop And (Mop Not bVar"b'8")
+                             (Bop And (Mop Not bVar"b'7")
+                               (Bop And (Mop Not bVar"b'6")
+                                 (Bop And (Mop Not bVar"b'5")
+                                   (Bop And (Mop Not bVar"b'4")
+                                     (Mop Not bVar"b'3")))))))))))
+                 (Let (Var "sel" (FTy 3))
+                   (EX (Var "w" F32) (LN 2) (LN 0) (FTy 3))
+                   (Let (Var "rt" (FTy 5))
+                     (EX (Var "w" F32) (LN 20) (LN 16) (FTy 5))
+                     (Let (Var "rd" (FTy 5))
+                       (EX (Var "w" F32) (LN 15) (LN 11) (FTy 5))
+                       (Let
+                         (TP
+                           (sqbkt bVar"b'4" bVar"b'3" bVar"b'2" bVar"b'1"
+                                  bVar"b'0"))
+                         (BL 5 (EX (Var "w" F32) (LN 25) (LN 21) (FTy 5)))
+                         (ITE
+                           (Bop And (Mop Not bVar"b'4")
+                             (Bop And (Mop Not bVar"b'3")
+                               (Mop Not bVar"b'1")))
+                           (ITB
+                             (sqbkt ((Bop And (Mop Not bVar"b'2")
+                                        (Mop Not bVar"b'0"))
+                                      (Call "CP" CTy"instruction"
+                                        (Call "MFC0" CTy"CP"
+                                          (TP
+                                            (sqbkt (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5))
+                                                   (Var "sel" (FTy 3)))))))
+                                    ((Bop And (Mop Not bVar"b'2")
+                                        bVar"b'0")
+                                      (Call "CP" CTy"instruction"
+                                        (Call "DMFC0" CTy"CP"
+                                          (TP
+                                            (sqbkt (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5))
+                                                   (Var "sel" (FTy 3)))))))
+                                    ((Bop And bVar"b'2"
+                                        (Mop Not bVar"b'0"))
+                                      (Call "CP" CTy"instruction"
+                                        (Call "MTC0" CTy"CP"
+                                          (TP
+                                            (sqbkt (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5))
+                                                   (Var "sel" (FTy 3)))))))
+                                    ((Bop And bVar"b'2" bVar"b'0")
+                                      (Call "CP" CTy"instruction"
+                                        (Call "DMTC0" CTy"CP"
+                                          (TP
+                                            (sqbkt (Var "rt" (FTy 5))
+                                                   (Var "rd" (FTy 5))
+                                                   (Var "sel" (FTy 3))))))))
+                             (Const "ReservedInstruction"
+                               CTy"instruction"))
+                           (Const "ReservedInstruction" CTy"instruction"))))))))
+        (Let (Var "rt" (FTy 5)) (EX (Var "w" F32) (LN 20) (LN 16) (FTy 5))
+          (Let (Var "rs" (FTy 5))
+            (EX (Var "w" F32) (LN 25) (LN 21) (FTy 5))
+            (Let (Var "immediate" F16)
+              (EX (Var "w" F32) (LN 15) (LN 0) F16)
+              (Let
+                (TP
+                  (sqbkt bVar"b'5" bVar"b'4" bVar"b'3" bVar"b'2" bVar"b'1"
+                         bVar"b'0"))
+                (BL 6 (EX (Var "w" F32) (LN 31) (LN 26) (FTy 6)))
+                (ITB
+                  (sqbkt (bVar"b'5"
+                           (ITB
+                             (sqbkt (bVar"b'2"
+                                      (ITB
+                                        (sqbkt (bVar"b'3"
+                                                 (ITB
+                                                   (sqbkt ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Store"
+                                                              CTy"instruction"
+                                                              (Call "SDL"
+                                                                CTy"Store"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "immediate"
+                                                                           F16))))))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                bVar"b'0"))
+                                                            (Call "Store"
+                                                              CTy"instruction"
+                                                              (Call "SDR"
+                                                                CTy"Store"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "immediate"
+                                                                           F16))))))
+                                                          ((Bop And
+                                                              (Mop Not
+                                                                bVar"b'4")
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Store"
+                                                              CTy"instruction"
+                                                              (Call "SWR"
+                                                                CTy"Store"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "immediate"
+                                                                           F16))))))
+                                                          ((Bop And
+                                                              bVar"b'4"
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'1")
+                                                                (Mop Not
+                                                                  bVar"b'0")))
+                                                            (Call "Store"
+                                                              CTy"instruction"
+                                                              (Call "SCD"
+                                                                CTy"Store"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "immediate"
+                                                                           F16))))))
+                                                          ((Bop And
+                                                              bVar"b'4"
+                                                              (Bop And
+                                                                bVar"b'1"
+                                                                bVar"b'0"))
+                                                            (Call "Store"
+                                                              CTy"instruction"
+                                                              (Call "SD"
+                                                                CTy"Store"
+                                                                (TP
+                                                                  (sqbkt (Var
+                                                                           "rs"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "rt"
+                                                                           (FTy
+                                                                             5))
+                                                                         (Var
+                                                                           "immediate"
+                                                                           F16)))))))
+                                                   (Const
+                                                     "ReservedInstruction"
+                                                     CTy"instruction")))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Load"
+                                                   CTy"instruction"
+                                                   (Call "LBU" CTy"Load"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     bVar"b'0"))
+                                                 (Call "Load"
+                                                   CTy"instruction"
+                                                   (Call "LHU" CTy"Load"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And bVar"b'1"
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Load"
+                                                   CTy"instruction"
+                                                   (Call "LWR" CTy"Load"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And bVar"b'1"
+                                                     bVar"b'0"))
+                                                 (Call "Load"
+                                                   CTy"instruction"
+                                                   (Call "LWU" CTy"Load"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Load"
+                                                   CTy"instruction"
+                                                   (Call "LLD" CTy"Load"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And bVar"b'1"
+                                                     bVar"b'0"))
+                                                 (Call "Load"
+                                                   CTy"instruction"
+                                                   (Call "LD" CTy"Load"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16)))))))
+                                        (Const "ReservedInstruction"
+                                          CTy"instruction")))
+                                    (bVar"b'3"
+                                      (ITB
+                                        (sqbkt ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Store"
+                                                   CTy"instruction"
+                                                   (Call "SB" CTy"Store"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     bVar"b'0"))
+                                                 (Call "Store"
+                                                   CTy"instruction"
+                                                   (Call "SH" CTy"Store"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And bVar"b'1"
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Store"
+                                                   CTy"instruction"
+                                                   (Call "SWL" CTy"Store"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And bVar"b'1"
+                                                     bVar"b'0"))
+                                                 (Call "Store"
+                                                   CTy"instruction"
+                                                   (Call "SW" CTy"Store"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And
+                                                     (Mop Not bVar"b'1")
+                                                     (Mop Not bVar"b'0")))
+                                                 (Call "Store"
+                                                   CTy"instruction"
+                                                   (Call "SC" CTy"Store"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16)))))))
+                                        (Const "ReservedInstruction"
+                                          CTy"instruction")))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And (Mop Not bVar"b'1")
+                                          (Mop Not bVar"b'0")))
+                                      (Call "Load" CTy"instruction"
+                                        (Call "LB" CTy"Load"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And (Mop Not bVar"b'1")
+                                          bVar"b'0"))
+                                      (Call "Load" CTy"instruction"
+                                        (Call "LH" CTy"Load"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And bVar"b'1"
+                                          (Mop Not bVar"b'0")))
+                                      (Call "Load" CTy"instruction"
+                                        (Call "LWL" CTy"Load"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And bVar"b'1" bVar"b'0"))
+                                      (Call "Load" CTy"instruction"
+                                        (Call "LW" CTy"Load"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And bVar"b'4"
+                                        (Bop And (Mop Not bVar"b'1")
+                                          (Mop Not bVar"b'0")))
+                                      (Call "Load" CTy"instruction"
+                                        (Call "LL" CTy"Load"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16)))))))
+                             (Const "ReservedInstruction"
+                               CTy"instruction")))
+                         (bVar"b'1"
+                           (ITB
+                             (sqbkt (bVar"b'0"
+                                      (ITB
+                                        (sqbkt ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And
+                                                     (Mop Not bVar"b'3")
+                                                     bVar"b'2"))
+                                                 (Call "Branch"
+                                                   CTy"instruction"
+                                                   (Call "BGTZ"
+                                                     CTy"Branch"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And bVar"b'3"
+                                                     (Mop Not bVar"b'2")))
+                                                 (Call "ArithI"
+                                                   CTy"instruction"
+                                                   (Call "SLTIU"
+                                                     CTy"ArithI"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And
+                                                   (Mop Not bVar"b'4")
+                                                   (Bop And bVar"b'3"
+                                                     bVar"b'2"))
+                                                 (Call "ArithI"
+                                                   CTy"instruction"
+                                                   (Call "LUI" CTy"ArithI"
+                                                     (TP
+                                                       (sqbkt (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And
+                                                     (Mop Not bVar"b'3")
+                                                     bVar"b'2"))
+                                                 (Call "Branch"
+                                                   CTy"instruction"
+                                                   (Call "BGTZL"
+                                                     CTy"Branch"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16))))))
+                                               ((Bop And bVar"b'4"
+                                                   (Bop And bVar"b'3"
+                                                     (Mop Not bVar"b'2")))
+                                                 (Call "Load"
+                                                   CTy"instruction"
+                                                   (Call "LDR" CTy"Load"
+                                                     (TP
+                                                       (sqbkt (Var "rs"
+                                                                (FTy 5))
+                                                              (Var "rt"
+                                                                (FTy 5))
+                                                              (Var
+                                                                "immediate"
+                                                                F16)))))))
+                                        (Const "ReservedInstruction"
+                                          CTy"instruction")))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And (Mop Not bVar"b'3")
+                                          bVar"b'2"))
+                                      (Call "Branch" CTy"instruction"
+                                        (Call "BLEZ" CTy"Branch"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And bVar"b'3"
+                                          (Mop Not bVar"b'2")))
+                                      (Call "ArithI" CTy"instruction"
+                                        (Call "SLTI" CTy"ArithI"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And bVar"b'3" bVar"b'2"))
+                                      (Call "ArithI" CTy"instruction"
+                                        (Call "XORI" CTy"ArithI"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And bVar"b'4"
+                                        (Bop And (Mop Not bVar"b'3")
+                                          bVar"b'2"))
+                                      (Call "Branch" CTy"instruction"
+                                        (Call "BLEZL" CTy"Branch"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And bVar"b'4"
+                                        (Bop And bVar"b'3"
+                                          (Mop Not bVar"b'2")))
+                                      (Call "Load" CTy"instruction"
+                                        (Call "LDL" CTy"Load"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16)))))))
+                             (Const "ReservedInstruction"
+                               CTy"instruction")))
+                         (bVar"b'0"
+                           (ITB
+                             (sqbkt ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And (Mop Not bVar"b'3")
+                                          bVar"b'2"))
+                                      (Call "Branch" CTy"instruction"
+                                        (Call "BNE" CTy"Branch"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And bVar"b'3"
+                                          (Mop Not bVar"b'2")))
+                                      (Call "ArithI" CTy"instruction"
+                                        (Call "ADDIU" CTy"ArithI"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And (Mop Not bVar"b'4")
+                                        (Bop And bVar"b'3" bVar"b'2"))
+                                      (Call "ArithI" CTy"instruction"
+                                        (Call "ORI" CTy"ArithI"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And bVar"b'4"
+                                        (Bop And (Mop Not bVar"b'3")
+                                          bVar"b'2"))
+                                      (Call "Branch" CTy"instruction"
+                                        (Call "BNEL" CTy"Branch"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16))))))
+                                    ((Bop And bVar"b'4"
+                                        (Bop And bVar"b'3"
+                                          (Mop Not bVar"b'2")))
+                                      (Call "ArithI" CTy"instruction"
+                                        (Call "DADDIU" CTy"ArithI"
+                                          (TP
+                                            (sqbkt (Var "rs" (FTy 5))
+                                                   (Var "rt" (FTy 5))
+                                                   (Var "immediate" F16)))))))
+                             (Const "ReservedInstruction"
+                               CTy"instruction")))
+                         ((Bop And (Mop Not bVar"b'4")
+                             (Bop And (Mop Not bVar"b'3") bVar"b'2"))
+                           (Call "Branch" CTy"instruction"
+                             (Call "BEQ" CTy"Branch"
+                               (TP
+                                 (sqbkt (Var "rs" (FTy 5))
+                                        (Var "rt" (FTy 5))
+                                        (Var "immediate" F16))))))
+                         ((Bop And (Mop Not bVar"b'4")
+                             (Bop And bVar"b'3" (Mop Not bVar"b'2")))
+                           (Call "ArithI" CTy"instruction"
+                             (Call "ADDI" CTy"ArithI"
+                               (TP
+                                 (sqbkt (Var "rs" (FTy 5))
+                                        (Var "rt" (FTy 5))
+                                        (Var "immediate" F16))))))
+                         ((Bop And (Mop Not bVar"b'4")
+                             (Bop And bVar"b'3" bVar"b'2"))
+                           (Call "ArithI" CTy"instruction"
+                             (Call "ANDI" CTy"ArithI"
+                               (TP
+                                 (sqbkt (Var "rs" (FTy 5))
+                                        (Var "rt" (FTy 5))
+                                        (Var "immediate" F16))))))
+                         ((Bop And bVar"b'4"
+                             (Bop And (Mop Not bVar"b'3") bVar"b'2"))
+                           (Call "Branch" CTy"instruction"
+                             (Call "BEQL" CTy"Branch"
+                               (TP
+                                 (sqbkt (Var "rs" (FTy 5))
+                                        (Var "rt" (FTy 5))
+                                        (Var "immediate" F16))))))
+                         ((Bop And bVar"b'4"
+                             (Bop And bVar"b'3" (Mop Not bVar"b'2")))
+                           (Call "ArithI" CTy"instruction"
+                             (Call "DADDI" CTy"ArithI"
+                               (TP
+                                 (sqbkt (Var "rs" (FTy 5))
+                                        (Var "rt" (FTy 5))
+                                        (Var "immediate" F16)))))))
+                  (Const "ReservedInstruction" CTy"instruction")))))))
+      (Let (Var "rt" (FTy 5)) (EX (Var "w" F32) (LN 20) (LN 16) (FTy 5))
+        (Let (Var "rs" (FTy 5)) (EX (Var "w" F32) (LN 25) (LN 21) (FTy 5))
+          (Let (Var "immediate" F16) (EX (Var "w" F32) (LN 15) (LN 0) F16)
+            (Let
+              (TP
+                (sqbkt bVar"b'5" bVar"b'4" bVar"b'3" bVar"b'2" bVar"b'1"
+                       bVar"b'0"))
+              (BL 6 (EX (Var "w" F32) (LN 31) (LN 26) (FTy 6)))
+              (ITB
+                (sqbkt (bVar"b'5"
+                         (ITB
+                           (sqbkt (bVar"b'2"
+                                    (ITB
+                                      (sqbkt (bVar"b'3"
+                                               (ITB
+                                                 (sqbkt ((Bop And
+                                                            (Mop Not
+                                                              bVar"b'4")
+                                                            (Bop And
+                                                              (Mop Not
+                                                                bVar"b'1")
+                                                              (Mop Not
+                                                                bVar"b'0")))
+                                                          (Call "Store"
+                                                            CTy"instruction"
+                                                            (Call "SDL"
+                                                              CTy"Store"
+                                                              (TP
+                                                                (sqbkt (Var
+                                                                         "rs"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "rt"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "immediate"
+                                                                         F16))))))
+                                                        ((Bop And
+                                                            (Mop Not
+                                                              bVar"b'4")
+                                                            (Bop And
+                                                              (Mop Not
+                                                                bVar"b'1")
+                                                              bVar"b'0"))
+                                                          (Call "Store"
+                                                            CTy"instruction"
+                                                            (Call "SDR"
+                                                              CTy"Store"
+                                                              (TP
+                                                                (sqbkt (Var
+                                                                         "rs"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "rt"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "immediate"
+                                                                         F16))))))
+                                                        ((Bop And
+                                                            (Mop Not
+                                                              bVar"b'4")
+                                                            (Bop And
+                                                              bVar"b'1"
+                                                              (Mop Not
+                                                                bVar"b'0")))
+                                                          (Call "Store"
+                                                            CTy"instruction"
+                                                            (Call "SWR"
+                                                              CTy"Store"
+                                                              (TP
+                                                                (sqbkt (Var
+                                                                         "rs"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "rt"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "immediate"
+                                                                         F16))))))
+                                                        ((Bop And
+                                                            bVar"b'4"
+                                                            (Bop And
+                                                              (Mop Not
+                                                                bVar"b'1")
+                                                              (Mop Not
+                                                                bVar"b'0")))
+                                                          (Call "Store"
+                                                            CTy"instruction"
+                                                            (Call "SCD"
+                                                              CTy"Store"
+                                                              (TP
+                                                                (sqbkt (Var
+                                                                         "rs"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "rt"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "immediate"
+                                                                         F16))))))
+                                                        ((Bop And
+                                                            bVar"b'4"
+                                                            (Bop And
+                                                              bVar"b'1"
+                                                              bVar"b'0"))
+                                                          (Call "Store"
+                                                            CTy"instruction"
+                                                            (Call "SD"
+                                                              CTy"Store"
+                                                              (TP
+                                                                (sqbkt (Var
+                                                                         "rs"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "rt"
+                                                                         (FTy
+                                                                           5))
+                                                                       (Var
+                                                                         "immediate"
+                                                                         F16)))))))
+                                                 (Const
+                                                   "ReservedInstruction"
+                                                   CTy"instruction")))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'1")
+                                                   (Mop Not bVar"b'0")))
+                                               (Call "Load"
+                                                 CTy"instruction"
+                                                 (Call "LBU" CTy"Load"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'1")
+                                                   bVar"b'0"))
+                                               (Call "Load"
+                                                 CTy"instruction"
+                                                 (Call "LHU" CTy"Load"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And bVar"b'1"
+                                                   (Mop Not bVar"b'0")))
+                                               (Call "Load"
+                                                 CTy"instruction"
+                                                 (Call "LWR" CTy"Load"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And bVar"b'1"
+                                                   bVar"b'0"))
+                                               (Call "Load"
+                                                 CTy"instruction"
+                                                 (Call "LWU" CTy"Load"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And bVar"b'4"
+                                                 (Bop And
+                                                   (Mop Not bVar"b'1")
+                                                   (Mop Not bVar"b'0")))
+                                               (Call "Load"
+                                                 CTy"instruction"
+                                                 (Call "LLD" CTy"Load"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And bVar"b'4"
+                                                 (Bop And bVar"b'1"
+                                                   bVar"b'0"))
+                                               (Call "Load"
+                                                 CTy"instruction"
+                                                 (Call "LD" CTy"Load"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16)))))))
+                                      (Const "ReservedInstruction"
+                                        CTy"instruction")))
+                                  (bVar"b'3"
+                                    (ITB
+                                      (sqbkt ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'1")
+                                                   (Mop Not bVar"b'0")))
+                                               (Call "Store"
+                                                 CTy"instruction"
+                                                 (Call "SB" CTy"Store"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'1")
+                                                   bVar"b'0"))
+                                               (Call "Store"
+                                                 CTy"instruction"
+                                                 (Call "SH" CTy"Store"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And bVar"b'1"
+                                                   (Mop Not bVar"b'0")))
+                                               (Call "Store"
+                                                 CTy"instruction"
+                                                 (Call "SWL" CTy"Store"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And bVar"b'1"
+                                                   bVar"b'0"))
+                                               (Call "Store"
+                                                 CTy"instruction"
+                                                 (Call "SW" CTy"Store"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And bVar"b'4"
+                                                 (Bop And
+                                                   (Mop Not bVar"b'1")
+                                                   (Mop Not bVar"b'0")))
+                                               (Call "Store"
+                                                 CTy"instruction"
+                                                 (Call "SC" CTy"Store"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16)))))))
+                                      (Const "ReservedInstruction"
+                                        CTy"instruction")))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And (Mop Not bVar"b'1")
+                                        (Mop Not bVar"b'0")))
+                                    (Call "Load" CTy"instruction"
+                                      (Call "LB" CTy"Load"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And (Mop Not bVar"b'1")
+                                        bVar"b'0"))
+                                    (Call "Load" CTy"instruction"
+                                      (Call "LH" CTy"Load"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And bVar"b'1"
+                                        (Mop Not bVar"b'0")))
+                                    (Call "Load" CTy"instruction"
+                                      (Call "LWL" CTy"Load"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And bVar"b'1" bVar"b'0"))
+                                    (Call "Load" CTy"instruction"
+                                      (Call "LW" CTy"Load"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And bVar"b'4"
+                                      (Bop And (Mop Not bVar"b'1")
+                                        (Mop Not bVar"b'0")))
+                                    (Call "Load" CTy"instruction"
+                                      (Call "LL" CTy"Load"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16)))))))
+                           (Const "ReservedInstruction" CTy"instruction")))
+                       (bVar"b'1"
+                         (ITB
+                           (sqbkt (bVar"b'0"
+                                    (ITB
+                                      (sqbkt ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And
+                                                   (Mop Not bVar"b'3")
+                                                   bVar"b'2"))
+                                               (Call "Branch"
+                                                 CTy"instruction"
+                                                 (Call "BGTZ" CTy"Branch"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And bVar"b'3"
+                                                   (Mop Not bVar"b'2")))
+                                               (Call "ArithI"
+                                                 CTy"instruction"
+                                                 (Call "SLTIU" CTy"ArithI"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And (Mop Not bVar"b'4")
+                                                 (Bop And bVar"b'3"
+                                                   bVar"b'2"))
+                                               (Call "ArithI"
+                                                 CTy"instruction"
+                                                 (Call "LUI" CTy"ArithI"
+                                                   (TP
+                                                     (sqbkt (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And bVar"b'4"
+                                                 (Bop And
+                                                   (Mop Not bVar"b'3")
+                                                   bVar"b'2"))
+                                               (Call "Branch"
+                                                 CTy"instruction"
+                                                 (Call "BGTZL" CTy"Branch"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16))))))
+                                             ((Bop And bVar"b'4"
+                                                 (Bop And bVar"b'3"
+                                                   (Mop Not bVar"b'2")))
+                                               (Call "Load"
+                                                 CTy"instruction"
+                                                 (Call "LDR" CTy"Load"
+                                                   (TP
+                                                     (sqbkt (Var "rs"
+                                                              (FTy 5))
+                                                            (Var "rt"
+                                                              (FTy 5))
+                                                            (Var
+                                                              "immediate"
+                                                              F16)))))))
+                                      (Const "ReservedInstruction"
+                                        CTy"instruction")))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And (Mop Not bVar"b'3")
+                                        bVar"b'2"))
+                                    (Call "Branch" CTy"instruction"
+                                      (Call "BLEZ" CTy"Branch"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And bVar"b'3"
+                                        (Mop Not bVar"b'2")))
+                                    (Call "ArithI" CTy"instruction"
+                                      (Call "SLTI" CTy"ArithI"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And bVar"b'3" bVar"b'2"))
+                                    (Call "ArithI" CTy"instruction"
+                                      (Call "XORI" CTy"ArithI"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And bVar"b'4"
+                                      (Bop And (Mop Not bVar"b'3")
+                                        bVar"b'2"))
+                                    (Call "Branch" CTy"instruction"
+                                      (Call "BLEZL" CTy"Branch"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And bVar"b'4"
+                                      (Bop And bVar"b'3"
+                                        (Mop Not bVar"b'2")))
+                                    (Call "Load" CTy"instruction"
+                                      (Call "LDL" CTy"Load"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16)))))))
+                           (Const "ReservedInstruction" CTy"instruction")))
+                       (bVar"b'0"
+                         (ITB
+                           (sqbkt ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And (Mop Not bVar"b'3")
+                                        bVar"b'2"))
+                                    (Call "Branch" CTy"instruction"
+                                      (Call "BNE" CTy"Branch"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And bVar"b'3"
+                                        (Mop Not bVar"b'2")))
+                                    (Call "ArithI" CTy"instruction"
+                                      (Call "ADDIU" CTy"ArithI"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And (Mop Not bVar"b'4")
+                                      (Bop And bVar"b'3" bVar"b'2"))
+                                    (Call "ArithI" CTy"instruction"
+                                      (Call "ORI" CTy"ArithI"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And bVar"b'4"
+                                      (Bop And (Mop Not bVar"b'3")
+                                        bVar"b'2"))
+                                    (Call "Branch" CTy"instruction"
+                                      (Call "BNEL" CTy"Branch"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16))))))
+                                  ((Bop And bVar"b'4"
+                                      (Bop And bVar"b'3"
+                                        (Mop Not bVar"b'2")))
+                                    (Call "ArithI" CTy"instruction"
+                                      (Call "DADDIU" CTy"ArithI"
+                                        (TP
+                                          (sqbkt (Var "rs" (FTy 5))
+                                                 (Var "rt" (FTy 5))
+                                                 (Var "immediate" F16)))))))
+                           (Const "ReservedInstruction" CTy"instruction")))
+                       ((Bop And (Mop Not bVar"b'4")
+                           (Bop And (Mop Not bVar"b'3") bVar"b'2"))
+                         (Call "Branch" CTy"instruction"
+                           (Call "BEQ" CTy"Branch"
+                             (TP
+                               (sqbkt (Var "rs" (FTy 5))
+                                      (Var "rt" (FTy 5))
+                                      (Var "immediate" F16))))))
+                       ((Bop And (Mop Not bVar"b'4")
+                           (Bop And bVar"b'3" (Mop Not bVar"b'2")))
+                         (Call "ArithI" CTy"instruction"
+                           (Call "ADDI" CTy"ArithI"
+                             (TP
+                               (sqbkt (Var "rs" (FTy 5))
+                                      (Var "rt" (FTy 5))
+                                      (Var "immediate" F16))))))
+                       ((Bop And (Mop Not bVar"b'4")
+                           (Bop And bVar"b'3" bVar"b'2"))
+                         (Call "ArithI" CTy"instruction"
+                           (Call "ANDI" CTy"ArithI"
+                             (TP
+                               (sqbkt (Var "rs" (FTy 5))
+                                      (Var "rt" (FTy 5))
+                                      (Var "immediate" F16))))))
+                       ((Bop And bVar"b'4"
+                           (Bop And (Mop Not bVar"b'3") bVar"b'2"))
+                         (Call "Branch" CTy"instruction"
+                           (Call "BEQL" CTy"Branch"
+                             (TP
+                               (sqbkt (Var "rs" (FTy 5))
+                                      (Var "rt" (FTy 5))
+                                      (Var "immediate" F16))))))
+                       ((Bop And bVar"b'4"
+                           (Bop And bVar"b'3" (Mop Not bVar"b'2")))
+                         (Call "ArithI" CTy"instruction"
+                           (Call "DADDI" CTy"ArithI"
+                             (TP
+                               (sqbkt (Var "rs" (FTy 5))
+                                      (Var "rt" (FTy 5))
+                                      (Var "immediate" F16)))))))
+                (Const "ReservedInstruction" CTy"instruction")))))))))
+
+
+(Def "Fetch" qVar"state"
+  (Let (Var "v" F64) (Dest "PC" F64 qVar"state")
+    (Let (TP (sqbkt (Var "pAddr" F64) (Var "CCA" (FTy 3))))
+      (Call "AddressTranslation" (PTy F64 (FTy 3))
+        (TP
+          (sqbkt (Var "v" F64) (LC "INSTRUCTION" CTy"IorD")
+                 (LC "LOAD" CTy"LorS"))))
+      (Let (Var "v0" (FTy 3))
+        (Bop BXor (EX (Var "v" F64) (LN 2) (LN 0) (FTy 3))
+          (CC(sqbkt (Mop Fst
+                      (Apply (Const "BigEndianCPU" (ATy qTy (PTy F1 qTy)))
+                        qVar"state")) (LW 0 2))))
+        (TP
+          (sqbkt (EX
+                   (Mop Fst
+                     (Apply
+                       (Call "LoadMemory" (ATy qTy (PTy F64 qTy))
+                         (TP
+                           (sqbkt (Var "CCA" (FTy 3))
+                                  (Const "WORD" (FTy 3)) (Var "pAddr" F64)
+                                  (Var "v" F64)
+                                  (LC "INSTRUCTION" CTy"IorD"))))
+                       qVar"state"))
+                   (Bop Add (LN 31)
+                     (Bop Mul (LN 8) (Mop (Cast nTy) (Var "v0" (FTy 3)))))
+                   (Bop Mul (LN 8) (Mop (Cast nTy) (Var "v0" (FTy 3))))
+                   F32) qVar"state"))))))
+
+
+(Def "Next" qVar"state"
+  (Let qVar"s"
+    (Mop Snd
+      (Apply
+        (Call "Run" (ATy qTy (PTy uTy qTy))
+          (Call "Decode" CTy"instruction"
+            (Mop Fst
+              (Apply (Const "Fetch" (ATy qTy (PTy F32 qTy))) qVar"state"))))
+        (Rupd "BranchStatus" (TP (sqbkt qVar"state" (LO F64))))))
+    (Let qVar"s"
+      (CS (Dest "BranchStatus" (OTy F64) qVar"state")
+        (sqbkt ((Mop Some (Var "addr" F64))
+                 (ITE (Mop IsSome (Dest "BranchStatus" (OTy F64) qVar"s"))
+                   (Mop Snd
+                     (Apply
+                       (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                         (Call "UNPREDICTABLE" CTy"exception"
+                           (LS"Branch follows branch"))) qVar"s"))
+                   (Rupd "PC" (TP (sqbkt qVar"s" (Var "addr" F64))))))
+               ((LO F64) qVar"s")))
+      (Let qVar"s"
+        (Rupd "PC"
+          (TP (sqbkt qVar"s" (Bop Add (Dest "PC" F64 qVar"s") (LW 4 64)))))
+        (TP
+          (sqbkt LU
+                 (Rupd "CP0"
+                   (TP
+                     (sqbkt qVar"s"
+                            (Rupd "Count"
+                              (TP
+                                (sqbkt (Dest "CP0" CTy"CP0" qVar"s")
+                                       (Bop Add
+                                         (Dest "Count" F32
+                                           (Dest "CP0" CTy"CP0" qVar"s"))
+                                         (LW 1 32))))))))))))))
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/mips/mips.lisp acl2-6.3/books/translators/l3-to-acl2/examples/mips/mips.lisp
--- acl2-6.2/books/translators/l3-to-acl2/examples/mips/mips.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/mips/mips.lisp	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,7895 @@
+(IN-PACKAGE "ACL2")
+
+(VALUE-TRIPLE
+     '(:GENERATED-BY (L3-TO-ACL2 "mips-acl2.txt" "mips.lisp"
+                                 :STR-TO-SYM '(("LOAD" . IS_LOAD)
+                                               ("STORE" . IS_STORE)
+                                               ("INSTRUCTION" . IS_INSTRUCTION)
+                                               ("DATA" . IS_DATA)
+                                               ("gpr" . GPREGS)))))
+
+(INCLUDE-BOOK "/Users/kaufmann/projects/l3-to-acl2/translator/l3")
+
+(VALUE-TRIPLE (LIST :ERROR (VAL _ = RECORD
+                                ("StatusRegister" (SQBKT ("'rst" (FTY 23))
+                                                         ("BEV" BTY)
+                                                         ("ERL" BTY)
+                                                         ("EXL" BTY)
+                                                         ("IE" BTY)
+                                                         ("IM0" BTY)
+                                                         ("IM1" BTY)
+                                                         ("KSU" (FTY 2))
+                                                         ("RE" BTY))))))
+
+(VALUE-TRIPLE
+    (LIST :ERROR (VAL _ = RECORD
+                      ("ConfigRegister" (SQBKT ("'rst" (FTY 31)) ("BE" BTY))))))
+
+(VALUE-TRIPLE (LIST :ERROR (VAL _ = RECORD
+                                ("CauseRegister" (SQBKT ("'rst" (FTY 27))
+                                                        ("ExcCode" (FTY 5)))))))
+
+(VALUE-TRIPLE
+     (LIST :ERROR (VAL _ = RECORD
+                       ("CP0" (SQBKT ("Cause" (CTY "CauseRegister"))
+                                     ("Config" (CTY "ConfigRegister"))
+                                     ("Count" F32)
+                                     ("EPC" F64)
+                                     ("ErrorEPC" F64)
+                                     ("Status" (CTY "StatusRegister")))))))
+
+(CONSTRUCT HLSTATUS (HLARITH HLOK HLMTHI HLMTLO))
+
+(CONSTRUCT IORD (IS_INSTRUCTION IS_DATA))
+
+(CONSTRUCT LORS (IS_LOAD IS_STORE))
+
+(CONSTRUCT EXCEPTIONTYPE
+           (ADEL ADES SYS BP RI OV TR))
+
+(CONSTRUCT BRANCH
+           ((BEQ ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (BEQL ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 16)))
+            (BGEZ ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BGEZAL ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BGEZALL ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BGEZL ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BGTZ ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BGTZL ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BLEZ ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BLEZL ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BLTZ ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BLTZAL ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BLTZALL ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BLTZL ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (BNE ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (BNEL ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 16)))
+            (J (UNSIGNED-BYTE 26))
+            (JAL (UNSIGNED-BYTE 26))
+            (JALR ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (JR (UNSIGNED-BYTE 5))))
+
+(CONSTRUCT CP
+           ((DMFC0 ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 3)))
+            (DMTC0 ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 3)))
+            (MFC0 ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 3)))
+            (MTC0 ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 3)))))
+
+(CONSTRUCT STORE
+           ((SB ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (SC ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (SCD ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (SD ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (SDL ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (SDR ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (SH ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (SW ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (SWL ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (SWR ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))))
+
+(CONSTRUCT LOAD
+           ((LB ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (LBU ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (LD ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (LDL ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (LDR ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (LH ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (LHU ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (LL ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (LLD ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (LW ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 16)))
+            (LWL ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (LWR ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (LWU ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))))
+
+(CONSTRUCT TRAP
+           ((TEQ ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (TEQI ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (TGE ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (TGEI ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (TGEIU ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (TGEU ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (TLT ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (TLTI ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (TLTIU ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (TLTU ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (TNE ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (TNEI ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 16)))))
+
+(CONSTRUCT SHIFT
+           ((DSLL ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (DSLL32 ((UNSIGNED-BYTE 5)
+                     (UNSIGNED-BYTE 5)
+                     (UNSIGNED-BYTE 5)))
+            (DSLLV ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)))
+            (DSRA ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (DSRA32 ((UNSIGNED-BYTE 5)
+                     (UNSIGNED-BYTE 5)
+                     (UNSIGNED-BYTE 5)))
+            (DSRAV ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)))
+            (DSRL ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (DSRL32 ((UNSIGNED-BYTE 5)
+                     (UNSIGNED-BYTE 5)
+                     (UNSIGNED-BYTE 5)))
+            (DSRLV ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)))
+            (SLL ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))
+            (SLLV ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (SRA ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))
+            (SRAV ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (SRL ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))
+            (SRLV ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))))
+
+(CONSTRUCT MULTDIV
+           ((DDIV ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (DDIVU ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (DIV ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (DIVU ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (DMULT ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (DMULTU ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (MFHI (UNSIGNED-BYTE 5))
+            (MFLO (UNSIGNED-BYTE 5))
+            (MTHI (UNSIGNED-BYTE 5))
+            (MTLO (UNSIGNED-BYTE 5))
+            (MULT ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))
+            (MULTU ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 5)))))
+
+(CONSTRUCT ARITHR
+           ((ADD ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))
+            (ADDU ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (AND ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))
+            (DADD ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (DADDU ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)))
+            (DSUB ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (DSUBU ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)))
+            (NOR ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))
+            (OR ((UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)
+                 (UNSIGNED-BYTE 5)))
+            (SLT ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))
+            (SLTU ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (SUB ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))
+            (SUBU ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)))
+            (XOR ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)))))
+
+(CONSTRUCT ARITHI
+           ((ADDI ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 16)))
+            (ADDIU ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 16)))
+            (ANDI ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 16)))
+            (DADDI ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 16)))
+            (DADDIU ((UNSIGNED-BYTE 5)
+                     (UNSIGNED-BYTE 5)
+                     (UNSIGNED-BYTE 16)))
+            (LUI ((UNSIGNED-BYTE 5) (UNSIGNED-BYTE 16)))
+            (ORI ((UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 5)
+                  (UNSIGNED-BYTE 16)))
+            (SLTI ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 16)))
+            (SLTIU ((UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 5)
+                    (UNSIGNED-BYTE 16)))
+            (XORI ((UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 5)
+                   (UNSIGNED-BYTE 16)))))
+
+(CONSTRUCT INSTRUCTION
+           ((ARITHI ARITHI)
+            (ARITHR ARITHR)
+            BREAK (BRANCH BRANCH)
+            (CP CP)
+            ERET (LOAD LOAD)
+            (MULTDIV MULTDIV)
+            RESERVEDINSTRUCTION
+            (SYNC (UNSIGNED-BYTE 5))
+            SYSCALL (SHIFT SHIFT)
+            (STORE STORE)
+            (TRAP TRAP)))
+
+(CONSTRUCT EXCEPTION
+           (NOEXCEPTION (UNPREDICTABLE STY)))
+
+(DEFSTOBJ+ ST$ (BRANCHSTATUS)
+           CP0
+           (HI :TYPE (UNSIGNED-BYTE 64)
+               :INITIALLY 0)
+           HLSTATUS (LLBIT)
+           (LO :TYPE (UNSIGNED-BYTE 64)
+               :INITIALLY 0)
+           (MEM :TYPE (ARRAY (UNSIGNED-BYTE 8)
+                             (18446744073709551616))
+                :INITIALLY 0)
+           (PC :TYPE (UNSIGNED-BYTE 64)
+               :INITIALLY 0)
+           EXCEPTION
+           (GPREGS :TYPE (ARRAY (UNSIGNED-BYTE 64) (32))
+                   :INITIALLY 0))
+
+(VALUE-TRIPLE "See l3.lisp for the definition of raise-exception")
+
+(PROGRAM)
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "reg'StatusRegister"
+   (VAR "x" (CTY "StatusRegister"))
+   (CS (VAR "x" (CTY "StatusRegister"))
+       (SQBKT ((REC (CTY "StatusRegister")
+                    (SQBKT (VAR "'rst" (FTY 23))
+                           (VAR "BEV" BTY)
+                           (VAR "ERL" BTY)
+                           (VAR "EXL" BTY)
+                           (VAR "IE" BTY)
+                           (VAR "IM0" BTY)
+                           (VAR "IM1" BTY)
+                           (VAR "KSU" (FTY 2))
+                           (VAR "RE" BTY)))
+               (BOP MDFY
+                    (CLOSE (TP (SQBKT (VAR "i" NTY) (AVAR BTY)))
+                           (ITB (SQBKT ((EQ (VAR "i" NTY) (LN 31))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 4)))
+                                       ((EQ (VAR "i" NTY) (LN 30))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 3)))
+                                       ((EQ (VAR "i" NTY) (LN 29))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 2)))
+                                       ((EQ (VAR "i" NTY) (LN 28))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 1)))
+                                       ((EQ (VAR "i" NTY) (LN 27))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 0)))
+                                       ((EQ (VAR "i" NTY) (LN 26))
+                                        (VAR "RE" BTY))
+                                       ((EQ (VAR "i" NTY) (LN 25))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 7)))
+                                       ((EQ (VAR "i" NTY) (LN 24))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 6)))
+                                       ((EQ (VAR "i" NTY) (LN 23))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 5)))
+                                       ((EQ (VAR "i" NTY) (LN 22))
+                                        (VAR "BEV" BTY))
+                                       ((EQ (VAR "i" NTY) (LN 21))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 19)))
+                                       ((EQ (VAR "i" NTY) (LN 20))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 18)))
+                                       ((EQ (VAR "i" NTY) (LN 19))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 17)))
+                                       ((EQ (VAR "i" NTY) (LN 18))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 16)))
+                                       ((EQ (VAR "i" NTY) (LN 17))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 15)))
+                                       ((EQ (VAR "i" NTY) (LN 16))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 14)))
+                                       ((EQ (VAR "i" NTY) (LN 15))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 13)))
+                                       ((EQ (VAR "i" NTY) (LN 14))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 12)))
+                                       ((EQ (VAR "i" NTY) (LN 13))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 11)))
+                                       ((EQ (VAR "i" NTY) (LN 12))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 10)))
+                                       ((EQ (VAR "i" NTY) (LN 11))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 9)))
+                                       ((EQ (VAR "i" NTY) (LN 10))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 8)))
+                                       ((EQ (VAR "i" NTY) (LN 9))
+                                        (VAR "IM1" BTY))
+                                       ((EQ (VAR "i" NTY) (LN 8))
+                                        (VAR "IM0" BTY))
+                                       ((EQ (VAR "i" NTY) (LN 7))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 22)))
+                                       ((EQ (VAR "i" NTY) (LN 6))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 21)))
+                                       ((EQ (VAR "i" NTY) (LN 5))
+                                        (BOP BIT (VAR "'rst" (FTY 23)) (LN 20)))
+                                       ((EQ (VAR "i" NTY) (LN 4))
+                                        (BOP BIT (VAR "KSU" (FTY 2)) (LN 1)))
+                                       ((EQ (VAR "i" NTY) (LN 3))
+                                        (BOP BIT (VAR "KSU" (FTY 2)) (LN 0)))
+                                       ((EQ (VAR "i" NTY) (LN 2))
+                                        (VAR "ERL" BTY))
+                                       ((EQ (VAR "i" NTY) (LN 1))
+                                        (VAR "EXL" BTY)))
+                                (VAR "IE" BTY)))
+                    (LW 0 32))))))))
+
+(VALUE-TRIPLE
+   (LIST :ERROR (DEF "rec'StatusRegister" (VAR "x" F32)
+                     (REC (CTY "StatusRegister")
+                          (SQBKT CC
+                                 (SQBKT (EX (VAR "x" F32) (LN 7) (LN 5) (FTY 3))
+                                        (EX (VAR "x" F32)
+                                            (LN 21)
+                                            (LN 10)
+                                            (FTY 12))
+                                        (EX (VAR "x" F32)
+                                            (LN 25)
+                                            (LN 23)
+                                            (FTY 3))
+                                        (EX (VAR "x" F32)
+                                            (LN 31)
+                                            (LN 27)
+                                            (FTY 5)))
+                                 (BOP BIT (VAR "x" F32) (LN 22))
+                                 (BOP BIT (VAR "x" F32) (LN 2))
+                                 (BOP BIT (VAR "x" F32) (LN 1))
+                                 (BOP BIT (VAR "x" F32) (LN 0))
+                                 (BOP BIT (VAR "x" F32) (LN 8))
+                                 (BOP BIT (VAR "x" F32) (LN 9))
+                                 (EX (VAR "x" F32) (LN 4) (LN 3) (FTY 2))
+                                 (BOP BIT (VAR "x" F32) (LN 26)))))))
+
+(VALUE-TRIPLE (LIST :ERROR (DEF "write'rec'StatusRegister"
+                                (TP (SQBKT (AVAR F32)
+                                           (VAR "x" (CTY "StatusRegister"))))
+                                (CALL "reg'StatusRegister"
+                                      F32 (VAR "x" (CTY "StatusRegister"))))))
+
+(VALUE-TRIPLE (LIST :ERROR (DEF "write'reg'StatusRegister"
+                                (TP (SQBKT (AVAR (CTY "StatusRegister"))
+                                           (VAR "x" F32)))
+                                (CALL "rec'StatusRegister"
+                                      (CTY "StatusRegister")
+                                      (VAR "x" F32)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "reg'ConfigRegister"
+   (VAR "x" (CTY "ConfigRegister"))
+   (CS (VAR "x" (CTY "ConfigRegister"))
+       (SQBKT ((REC (CTY "ConfigRegister")
+                    (SQBKT (VAR "'rst" (FTY 31))
+                           (VAR "BE" BTY)))
+               (BOP MDFY
+                    (CLOSE (TP (SQBKT (VAR "i" NTY) (AVAR BTY)))
+                           (ITB (SQBKT ((EQ (VAR "i" NTY) (LN 31))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 15)))
+                                       ((EQ (VAR "i" NTY) (LN 30))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 14)))
+                                       ((EQ (VAR "i" NTY) (LN 29))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 13)))
+                                       ((EQ (VAR "i" NTY) (LN 28))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 12)))
+                                       ((EQ (VAR "i" NTY) (LN 27))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 11)))
+                                       ((EQ (VAR "i" NTY) (LN 26))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 10)))
+                                       ((EQ (VAR "i" NTY) (LN 25))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 9)))
+                                       ((EQ (VAR "i" NTY) (LN 24))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 8)))
+                                       ((EQ (VAR "i" NTY) (LN 23))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 7)))
+                                       ((EQ (VAR "i" NTY) (LN 22))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 6)))
+                                       ((EQ (VAR "i" NTY) (LN 21))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 5)))
+                                       ((EQ (VAR "i" NTY) (LN 20))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 4)))
+                                       ((EQ (VAR "i" NTY) (LN 19))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 3)))
+                                       ((EQ (VAR "i" NTY) (LN 18))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 2)))
+                                       ((EQ (VAR "i" NTY) (LN 17))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 1)))
+                                       ((EQ (VAR "i" NTY) (LN 16))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 0)))
+                                       ((EQ (VAR "i" NTY) (LN 15))
+                                        (VAR "BE" BTY))
+                                       ((EQ (VAR "i" NTY) (LN 14))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 30)))
+                                       ((EQ (VAR "i" NTY) (LN 13))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 29)))
+                                       ((EQ (VAR "i" NTY) (LN 12))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 28)))
+                                       ((EQ (VAR "i" NTY) (LN 11))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 27)))
+                                       ((EQ (VAR "i" NTY) (LN 10))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 26)))
+                                       ((EQ (VAR "i" NTY) (LN 9))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 25)))
+                                       ((EQ (VAR "i" NTY) (LN 8))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 24)))
+                                       ((EQ (VAR "i" NTY) (LN 7))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 23)))
+                                       ((EQ (VAR "i" NTY) (LN 6))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 22)))
+                                       ((EQ (VAR "i" NTY) (LN 5))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 21)))
+                                       ((EQ (VAR "i" NTY) (LN 4))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 20)))
+                                       ((EQ (VAR "i" NTY) (LN 3))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 19)))
+                                       ((EQ (VAR "i" NTY) (LN 2))
+                                        (BOP BIT (VAR "'rst" (FTY 31)) (LN 18)))
+                                       ((EQ (VAR "i" NTY) (LN 1))
+                                        (BOP BIT (VAR "'rst" (FTY 31))
+                                             (LN 17))))
+                                (BOP BIT (VAR "'rst" (FTY 31))
+                                     (LN 16))))
+                    (LW 0 32))))))))
+
+(VALUE-TRIPLE
+    (LIST :ERROR (DEF "rec'ConfigRegister" (VAR "x" F32)
+                      (REC (CTY "ConfigRegister")
+                           (SQBKT CC
+                                  (SQBKT (EX (VAR "x" F32)
+                                             (LN 14)
+                                             (LN 0)
+                                             (FTY 15))
+                                         (EX (VAR "x" F32) (LN 31) (LN 16) F16))
+                                  (BOP BIT (VAR "x" F32) (LN 15)))))))
+
+(VALUE-TRIPLE (LIST :ERROR (DEF "write'rec'ConfigRegister"
+                                (TP (SQBKT (AVAR F32)
+                                           (VAR "x" (CTY "ConfigRegister"))))
+                                (CALL "reg'ConfigRegister"
+                                      F32 (VAR "x" (CTY "ConfigRegister"))))))
+
+(VALUE-TRIPLE (LIST :ERROR (DEF "write'reg'ConfigRegister"
+                                (TP (SQBKT (AVAR (CTY "ConfigRegister"))
+                                           (VAR "x" F32)))
+                                (CALL "rec'ConfigRegister"
+                                      (CTY "ConfigRegister")
+                                      (VAR "x" F32)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "reg'CauseRegister"
+   (VAR "x" (CTY "CauseRegister"))
+   (CS (VAR "x" (CTY "CauseRegister"))
+       (SQBKT ((REC (CTY "CauseRegister")
+                    (SQBKT (VAR "'rst" (FTY 27))
+                           (VAR "ExcCode" (FTY 5))))
+               (BOP MDFY
+                    (CLOSE (TP (SQBKT (VAR "i" NTY) (AVAR BTY)))
+                           (ITB (SQBKT ((EQ (VAR "i" NTY) (LN 31))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 24)))
+                                       ((EQ (VAR "i" NTY) (LN 30))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 23)))
+                                       ((EQ (VAR "i" NTY) (LN 29))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 22)))
+                                       ((EQ (VAR "i" NTY) (LN 28))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 21)))
+                                       ((EQ (VAR "i" NTY) (LN 27))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 20)))
+                                       ((EQ (VAR "i" NTY) (LN 26))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 19)))
+                                       ((EQ (VAR "i" NTY) (LN 25))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 18)))
+                                       ((EQ (VAR "i" NTY) (LN 24))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 17)))
+                                       ((EQ (VAR "i" NTY) (LN 23))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 16)))
+                                       ((EQ (VAR "i" NTY) (LN 22))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 15)))
+                                       ((EQ (VAR "i" NTY) (LN 21))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 14)))
+                                       ((EQ (VAR "i" NTY) (LN 20))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 13)))
+                                       ((EQ (VAR "i" NTY) (LN 19))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 12)))
+                                       ((EQ (VAR "i" NTY) (LN 18))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 11)))
+                                       ((EQ (VAR "i" NTY) (LN 17))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 10)))
+                                       ((EQ (VAR "i" NTY) (LN 16))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 9)))
+                                       ((EQ (VAR "i" NTY) (LN 15))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 8)))
+                                       ((EQ (VAR "i" NTY) (LN 14))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 7)))
+                                       ((EQ (VAR "i" NTY) (LN 13))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 6)))
+                                       ((EQ (VAR "i" NTY) (LN 12))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 5)))
+                                       ((EQ (VAR "i" NTY) (LN 11))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 4)))
+                                       ((EQ (VAR "i" NTY) (LN 10))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 3)))
+                                       ((EQ (VAR "i" NTY) (LN 9))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 2)))
+                                       ((EQ (VAR "i" NTY) (LN 8))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 1)))
+                                       ((EQ (VAR "i" NTY) (LN 7))
+                                        (BOP BIT (VAR "'rst" (FTY 27)) (LN 0)))
+                                       ((EQ (VAR "i" NTY) (LN 6))
+                                        (BOP BIT (VAR "ExcCode" (FTY 5))
+                                             (LN 4)))
+                                       ((EQ (VAR "i" NTY) (LN 5))
+                                        (BOP BIT (VAR "ExcCode" (FTY 5))
+                                             (LN 3)))
+                                       ((EQ (VAR "i" NTY) (LN 4))
+                                        (BOP BIT (VAR "ExcCode" (FTY 5))
+                                             (LN 2)))
+                                       ((EQ (VAR "i" NTY) (LN 3))
+                                        (BOP BIT (VAR "ExcCode" (FTY 5))
+                                             (LN 1)))
+                                       ((EQ (VAR "i" NTY) (LN 2))
+                                        (BOP BIT (VAR "ExcCode" (FTY 5))
+                                             (LN 0)))
+                                       ((EQ (VAR "i" NTY) (LN 1))
+                                        (BOP BIT (VAR "'rst" (FTY 27))
+                                             (LN 26))))
+                                (BOP BIT (VAR "'rst" (FTY 27))
+                                     (LN 25))))
+                    (LW 0 32))))))))
+
+(VALUE-TRIPLE
+   (LIST :ERROR (DEF "rec'CauseRegister" (VAR "x" F32)
+                     (REC (CTY "CauseRegister")
+                          (SQBKT CC
+                                 (SQBKT (EX (VAR "x" F32) (LN 1) (LN 0) (FTY 2))
+                                        (EX (VAR "x" F32)
+                                            (LN 31)
+                                            (LN 7)
+                                            (FTY 25)))
+                                 (EX (VAR "x" F32)
+                                     (LN 6)
+                                     (LN 2)
+                                     (FTY 5)))))))
+
+(VALUE-TRIPLE (LIST :ERROR (DEF "write'rec'CauseRegister"
+                                (TP (SQBKT (AVAR F32)
+                                           (VAR "x" (CTY "CauseRegister"))))
+                                (CALL "reg'CauseRegister"
+                                      F32 (VAR "x" (CTY "CauseRegister"))))))
+
+(VALUE-TRIPLE (LIST :ERROR (DEF "write'reg'CauseRegister"
+                                (TP (SQBKT (AVAR (CTY "CauseRegister"))
+                                           (VAR "x" F32)))
+                                (CALL "rec'CauseRegister"
+                                      (CTY "CauseRegister")
+                                      (VAR "x" F32)))))
+
+(DEFUN-STRUCT WRITE-GPR
+              (((VALUE (UNSIGNED-BYTE-P 64 VALUE))
+                (N (UNSIGNED-BYTE-P 5 N)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((ST$ (IF (NOT (EQL N 0))
+                             (UPDATE-GPREGSI N VALUE ST$)
+                             ST$)))
+                   (MV (UNIT-VALUE) ST$)))
+
+(DEFUN-STRUCT GPR ((N (UNSIGNED-BYTE-P 5 N)) ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (MV (IF (EQL N 0) 0 (GPREGSI N ST$))
+                  ST$))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "write'CPR"
+   (TP (SQBKT (VAR "value" F64)
+              (VAR "n" NTY)
+              (VAR "reg" (FTY 5))
+              (VAR "sel" (FTY 3))))
+   (CLOSE
+    QVAR
+    (CS
+     (TP (SQBKT (VAR "n" NTY)
+                (VAR "reg" (FTY 5))
+                (VAR "sel" (FTY 3))))
+     (SQBKT
+      ((TP (SQBKT LN 0 (LW 9 5) (LW 0 3)))
+       (TP
+          (SQBKT LU
+                 (RUPD "CP0"
+                       (TP (SQBKT QVAR
+                                  (RUPD "Count"
+                                        (TP (SQBKT (DEST "CP0" (CTY "CP0") QVAR)
+                                                   (EX (VAR "value" F64)
+                                                       (LN 31)
+                                                       (LN 0)
+                                                       F32))))))))))
+      ((TP (SQBKT LN 0 (LW 12 5) (LW 0 3)))
+       (LET
+        (VAR "v" (CTY "CP0"))
+        (DEST "CP0" (CTY "CP0") QVAR)
+        (TP
+         (SQBKT
+          LU
+          (RUPD
+           "CP0"
+           (TP
+            (SQBKT
+             QVAR
+             (RUPD
+               "Status"
+               (TP (SQBKT (VAR "v" (CTY "CP0"))
+                          (CALL "write'reg'StatusRegister"
+                                (CTY "StatusRegister")
+                                (TP (SQBKT (DEST "Status" (CTY "StatusRegister")
+                                                 (VAR "v" (CTY "CP0")))
+                                           (EX (VAR "value" F64)
+                                               (LN 31)
+                                               (LN 0)
+                                               F32))))))))))))))
+      ((TP (SQBKT LN 0 (LW 13 5) (LW 0 3)))
+       (LET
+        (VAR "v" (CTY "CP0"))
+        (DEST "CP0" (CTY "CP0") QVAR)
+        (TP
+         (SQBKT
+          LU
+          (RUPD
+           "CP0"
+           (TP
+            (SQBKT
+             QVAR
+             (RUPD
+                 "Cause"
+                 (TP (SQBKT (VAR "v" (CTY "CP0"))
+                            (CALL "write'reg'CauseRegister"
+                                  (CTY "CauseRegister")
+                                  (TP (SQBKT (DEST "Cause" (CTY "CauseRegister")
+                                                   (VAR "v" (CTY "CP0")))
+                                             (EX (VAR "value" F64)
+                                                 (LN 31)
+                                                 (LN 0)
+                                                 F32))))))))))))))
+      ((TP (SQBKT LN 0 (LW 14 5) (LW 0 3)))
+       (TP
+          (SQBKT LU
+                 (RUPD "CP0"
+                       (TP (SQBKT QVAR
+                                  (RUPD "EPC"
+                                        (TP (SQBKT (DEST "CP0" (CTY "CP0") QVAR)
+                                                   (VAR "value" F64))))))))))
+      ((TP (SQBKT LN 0 (LW 16 5) (LW 0 3)))
+       (LET
+        (VAR "v" (CTY "CP0"))
+        (DEST "CP0" (CTY "CP0") QVAR)
+        (TP
+         (SQBKT
+          LU
+          (RUPD
+           "CP0"
+           (TP
+            (SQBKT
+             QVAR
+             (RUPD
+               "Config"
+               (TP (SQBKT (VAR "v" (CTY "CP0"))
+                          (CALL "write'reg'ConfigRegister"
+                                (CTY "ConfigRegister")
+                                (TP (SQBKT (DEST "Config" (CTY "ConfigRegister")
+                                                 (VAR "v" (CTY "CP0")))
+                                           (EX (VAR "value" F64)
+                                               (LN 31)
+                                               (LN 0)
+                                               F32))))))))))))))
+      ((TP (SQBKT LN 0 (LW 30 5) (LW 0 3)))
+       (TP
+          (SQBKT LU
+                 (RUPD "CP0"
+                       (TP (SQBKT QVAR
+                                  (RUPD "ErrorEPC"
+                                        (TP (SQBKT (DEST "CP0" (CTY "CP0") QVAR)
+                                                   (VAR "value" F64))))))))))
+      ((AVAR (PTY NTY (PTY (FTY 5) (FTY 3))))
+       (TP (SQBKT LU QVAR)))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "CPR"
+   (TP (SQBKT (VAR "n" NTY)
+              (VAR "reg" (FTY 5))
+              (VAR "sel" (FTY 3))))
+   (CLOSE
+        QVAR
+        (CS (TP (SQBKT (VAR "n" NTY)
+                       (VAR "reg" (FTY 5))
+                       (VAR "sel" (FTY 3))))
+            (SQBKT ((TP (SQBKT LN 0 (LW 9 5) (LW 0 3)))
+                    (TP (SQBKT (MOP (CAST F64)
+                                    (DEST "Count"
+                                          F32 (DEST "CP0" (CTY "CP0") QVAR)))
+                               QVAR)))
+                   ((TP (SQBKT LN 0 (LW 12 5) (LW 0 3)))
+                    (TP (SQBKT (MOP (CAST F64)
+                                    (CALL "reg'StatusRegister" F32
+                                          (DEST "Status" (CTY "StatusRegister")
+                                                (DEST "CP0" (CTY "CP0") QVAR))))
+                               QVAR)))
+                   ((TP (SQBKT LN 0 (LW 13 5) (LW 0 3)))
+                    (TP (SQBKT (MOP (CAST F64)
+                                    (CALL "reg'CauseRegister" F32
+                                          (DEST "Cause" (CTY "CauseRegister")
+                                                (DEST "CP0" (CTY "CP0") QVAR))))
+                               QVAR)))
+                   ((TP (SQBKT LN 0 (LW 14 5) (LW 0 3)))
+                    (TP (SQBKT (DEST "EPC" F64 (DEST "CP0" (CTY "CP0") QVAR))
+                               QVAR)))
+                   ((TP (SQBKT LN 0 (LW 16 5) (LW 0 3)))
+                    (TP (SQBKT (MOP (CAST F64)
+                                    (CALL "reg'ConfigRegister" F32
+                                          (DEST "Config" (CTY "ConfigRegister")
+                                                (DEST "CP0" (CTY "CP0") QVAR))))
+                               QVAR)))
+                   ((TP (SQBKT LN 0 (LW 30 5) (LW 0 3)))
+                    (TP (SQBKT (DEST "ErrorEPC"
+                                     F64 (DEST "CP0" (CTY "CP0") QVAR))
+                               QVAR)))
+                   ((AVAR (PTY NTY (PTY (FTY 5) (FTY 3))))
+                    (TP (SQBKT (LX F64) QVAR)))))))))
+
+(DEFCONST *BYTE* 0)
+
+(DEFCONST *HALFWORD* 1)
+
+(DEFCONST *WORD* 3)
+
+(DEFCONST *DOUBLEWORD* 7)
+
+(DEFCONST *PSIZE* 64)
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR
+    (DEF "UserMode" QVAR
+         (TP (SQBKT (BOP AND
+                         (BOP AND
+                              (EQ (DEST "KSU" (FTY 2)
+                                        (DEST "Status" (CTY "StatusRegister")
+                                              (DEST "CP0" (CTY "CP0") QVAR)))
+                                  (LW 2 2))
+                              (MOP NOT
+                                   (DEST "EXL" BTY
+                                         (DEST "Status" (CTY "StatusRegister")
+                                               (DEST "CP0" (CTY "CP0") QVAR)))))
+                         (MOP NOT
+                              (DEST "ERL" BTY
+                                    (DEST "Status" (CTY "StatusRegister")
+                                          (DEST "CP0" (CTY "CP0") QVAR)))))
+                    QVAR)))))
+
+(VALUE-TRIPLE
+     (LIST :ERROR (DEF "BigEndianMem" QVAR
+                       (TP (SQBKT (DEST "BE" BTY
+                                        (DEST "Config" (CTY "ConfigRegister")
+                                              (DEST "CP0" (CTY "CP0") QVAR)))
+                                  QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+     "ReverseEndian" QVAR
+     (TP (SQBKT (MOP (CAST F1)
+                     (BOP AND
+                          (DEST "RE" BTY
+                                (DEST "Status" (CTY "StatusRegister")
+                                      (DEST "CP0" (CTY "CP0") QVAR)))
+                          (MOP FST
+                               (APPLY (CONST "UserMode" (ATY QTY (PTY BTY QTY)))
+                                      QVAR))))
+                QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "BigEndianCPU" QVAR
+   (TP
+     (SQBKT (BOP BXOR
+                 (MOP (CAST F1)
+                      (MOP FST
+                           (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                                  QVAR)))
+                 (MOP FST
+                      (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                             QVAR)))
+            QVAR)))))
+
+(VALUE-TRIPLE (LIST :ERROR (DEF "AddressTranslation"
+                                (TP (SQBKT (VAR "vAddr" F64)
+                                           (VAR "IorD" (CTY "IorD"))
+                                           (VAR "LorS" (CTY "LorS"))))
+                                (TP (SQBKT (VAR "vAddr" F64)
+                                           (LX (FTY 3)))))))
+
+(DEFUN-STRUCT LOADMEMORY
+              (((CCA (UNSIGNED-BYTE-P 3 CCA))
+                (ACCESSLENGTH (UNSIGNED-BYTE-P 3 ACCESSLENGTH))
+                (PADDR (UNSIGNED-BYTE-P 64 PADDR))
+                (VADDR (UNSIGNED-BYTE-P 64 VADDR))
+                (IORD (TYPE-IORD IORD)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((A (LOGAND PADDR (LOGNOT 7))))
+                   (MV (IF (EQL (CAR (BIGENDIANCPU ST$)) 1)
+                           (CAT (MEMI A ST$)
+                                8 (MEMI (N+ 64 A 1) ST$)
+                                8 (MEMI (N+ 64 A 2) ST$)
+                                8 (MEMI (N+ 64 A 3) ST$)
+                                8 (MEMI (N+ 64 A 4) ST$)
+                                8 (MEMI (N+ 64 A 5) ST$)
+                                8 (MEMI (N+ 64 A 6) ST$)
+                                8 (MEMI (N+ 64 A 7) ST$)
+                                8)
+                           (CAT (MEMI (N+ 64 A 7) ST$)
+                                8 (MEMI (N+ 64 A 6) ST$)
+                                8 (MEMI (N+ 64 A 5) ST$)
+                                8 (MEMI (N+ 64 A 4) ST$)
+                                8 (MEMI (N+ 64 A 3) ST$)
+                                8 (MEMI (N+ 64 A 2) ST$)
+                                8 (MEMI (N+ 64 A 1) ST$)
+                                8 (MEMI A ST$)
+                                8))
+                       ST$)))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "StoreMemory"
+   (TP (SQBKT (VAR "CCA" (FTY 3))
+              (VAR "AccessLength" (FTY 3))
+              (VAR "MemElem" F64)
+              (VAR "pAddr" F64)
+              (VAR "vAddr" F64)
+              (VAR "IorD" (CTY "IorD"))))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "a" F64)
+     (BOP BAND (VAR "pAddr" F64)
+          (MOP BNOT (LW 7 64)))
+     (LET
+      (VAR "l" (FTY 3))
+      (EX (VAR "vAddr" F64)
+          (LN 2)
+          (LN 0)
+          (FTY 3))
+      (LET
+       (VAR "h" (FTY 3))
+       (BOP ADD (VAR "l" (FTY 3))
+            (VAR "AccessLength" (FTY 3)))
+       (ITE
+        (EQ (MOP FST
+                 (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                        QVAR))
+            (LW 1 1))
+        (LET
+         QVAR
+         (ITE (EQ (VAR "l" (FTY 3)) (LW 0 3))
+              (RUPD "MEM"
+                    (TP (SQBKT QVAR
+                               (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                     (VAR "a" F64)
+                                     (EX (VAR "MemElem" F64)
+                                         (LN 63)
+                                         (LN 56)
+                                         F8)))))
+              QVAR)
+         (LET
+          QVAR
+          (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 1 3))
+                    (BOP ULE (LW 1 3) (VAR "h" (FTY 3))))
+               (RUPD "MEM"
+                     (TP (SQBKT QVAR
+                                (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                      (BOP ADD (VAR "a" F64) (LW 1 64))
+                                      (EX (VAR "MemElem" F64)
+                                          (LN 55)
+                                          (LN 48)
+                                          F8)))))
+               QVAR)
+          (LET
+           QVAR
+           (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 2 3))
+                     (BOP ULE (LW 2 3) (VAR "h" (FTY 3))))
+                (RUPD "MEM"
+                      (TP (SQBKT QVAR
+                                 (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                       (BOP ADD (VAR "a" F64) (LW 2 64))
+                                       (EX (VAR "MemElem" F64)
+                                           (LN 47)
+                                           (LN 40)
+                                           F8)))))
+                QVAR)
+           (LET
+            QVAR
+            (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 3 3))
+                      (BOP ULE (LW 3 3) (VAR "h" (FTY 3))))
+                 (RUPD "MEM"
+                       (TP (SQBKT QVAR
+                                  (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                        (BOP ADD (VAR "a" F64) (LW 3 64))
+                                        (EX (VAR "MemElem" F64)
+                                            (LN 39)
+                                            (LN 32)
+                                            F8)))))
+                 QVAR)
+            (LET
+             QVAR
+             (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 4 3))
+                       (BOP ULE (LW 4 3) (VAR "h" (FTY 3))))
+                  (RUPD "MEM"
+                        (TP (SQBKT QVAR
+                                   (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                         (BOP ADD (VAR "a" F64) (LW 4 64))
+                                         (EX (VAR "MemElem" F64)
+                                             (LN 31)
+                                             (LN 24)
+                                             F8)))))
+                  QVAR)
+             (LET
+              QVAR
+              (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 5 3))
+                        (BOP ULE (LW 5 3) (VAR "h" (FTY 3))))
+                   (RUPD "MEM"
+                         (TP (SQBKT QVAR
+                                    (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                          (BOP ADD (VAR "a" F64) (LW 5 64))
+                                          (EX (VAR "MemElem" F64)
+                                              (LN 23)
+                                              (LN 16)
+                                              F8)))))
+                   QVAR)
+              (LET
+               QVAR
+               (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 6 3))
+                         (BOP ULE (LW 6 3) (VAR "h" (FTY 3))))
+                    (RUPD "MEM"
+                          (TP (SQBKT QVAR
+                                     (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                           (BOP ADD (VAR "a" F64) (LW 6 64))
+                                           (EX (VAR "MemElem" F64)
+                                               (LN 15)
+                                               (LN 8)
+                                               F8)))))
+                    QVAR)
+               (TP
+                (SQBKT
+                   LU
+                   (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 7 3))
+                             (BOP ULE (LW 7 3) (VAR "h" (FTY 3))))
+                        (RUPD "MEM"
+                              (TP (SQBKT QVAR
+                                         (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                               (BOP ADD (VAR "a" F64) (LW 7 64))
+                                               (EX (VAR "MemElem" F64)
+                                                   (LN 7)
+                                                   (LN 0)
+                                                   F8)))))
+                        QVAR))))))))))
+        (LET
+         QVAR
+         (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 7 3))
+                   (BOP ULE (LW 7 3) (VAR "h" (FTY 3))))
+              (RUPD "MEM"
+                    (TP (SQBKT QVAR
+                               (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                     (BOP ADD (VAR "a" F64) (LW 7 64))
+                                     (EX (VAR "MemElem" F64)
+                                         (LN 63)
+                                         (LN 56)
+                                         F8)))))
+              QVAR)
+         (LET
+          QVAR
+          (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 6 3))
+                    (BOP ULE (LW 6 3) (VAR "h" (FTY 3))))
+               (RUPD "MEM"
+                     (TP (SQBKT QVAR
+                                (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                      (BOP ADD (VAR "a" F64) (LW 6 64))
+                                      (EX (VAR "MemElem" F64)
+                                          (LN 55)
+                                          (LN 48)
+                                          F8)))))
+               QVAR)
+          (LET
+           QVAR
+           (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 5 3))
+                     (BOP ULE (LW 5 3) (VAR "h" (FTY 3))))
+                (RUPD "MEM"
+                      (TP (SQBKT QVAR
+                                 (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                       (BOP ADD (VAR "a" F64) (LW 5 64))
+                                       (EX (VAR "MemElem" F64)
+                                           (LN 47)
+                                           (LN 40)
+                                           F8)))))
+                QVAR)
+           (LET
+            QVAR
+            (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 4 3))
+                      (BOP ULE (LW 4 3) (VAR "h" (FTY 3))))
+                 (RUPD "MEM"
+                       (TP (SQBKT QVAR
+                                  (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                        (BOP ADD (VAR "a" F64) (LW 4 64))
+                                        (EX (VAR "MemElem" F64)
+                                            (LN 39)
+                                            (LN 32)
+                                            F8)))))
+                 QVAR)
+            (LET
+             QVAR
+             (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 3 3))
+                       (BOP ULE (LW 3 3) (VAR "h" (FTY 3))))
+                  (RUPD "MEM"
+                        (TP (SQBKT QVAR
+                                   (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                         (BOP ADD (VAR "a" F64) (LW 3 64))
+                                         (EX (VAR "MemElem" F64)
+                                             (LN 31)
+                                             (LN 24)
+                                             F8)))))
+                  QVAR)
+             (LET
+              QVAR
+              (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 2 3))
+                        (BOP ULE (LW 2 3) (VAR "h" (FTY 3))))
+                   (RUPD "MEM"
+                         (TP (SQBKT QVAR
+                                    (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                          (BOP ADD (VAR "a" F64) (LW 2 64))
+                                          (EX (VAR "MemElem" F64)
+                                              (LN 23)
+                                              (LN 16)
+                                              F8)))))
+                   QVAR)
+              (LET
+               QVAR
+               (ITE (BOP AND (BOP ULE (VAR "l" (FTY 3)) (LW 1 3))
+                         (BOP ULE (LW 1 3) (VAR "h" (FTY 3))))
+                    (RUPD "MEM"
+                          (TP (SQBKT QVAR
+                                     (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                           (BOP ADD (VAR "a" F64) (LW 1 64))
+                                           (EX (VAR "MemElem" F64)
+                                               (LN 15)
+                                               (LN 8)
+                                               F8)))))
+                    QVAR)
+               (TP
+                 (SQBKT
+                      LU
+                      (ITE (EQ (VAR "l" (FTY 3)) (LW 0 3))
+                           (RUPD "MEM"
+                                 (TP (SQBKT QVAR
+                                            (FUPD (DEST "MEM" (ATY F64 F8) QVAR)
+                                                  (VAR "a" F64)
+                                                  (EX (VAR "MemElem" F64)
+                                                      (LN 7)
+                                                      (LN 0)
+                                                      F8)))))
+                           QVAR))))))))))))))))))
+
+(DEFUN-STRUCT EXCEPTIONCODE
+              ((EXCEPTIONTYPE (TYPE-EXCEPTIONTYPE EXCEPTIONTYPE)))
+              (CASE-MATCH+ EXCEPTIONTYPE ('ADEL 4)
+                           ('ADES 5)
+                           ('SYS 8)
+                           ('BP 9)
+                           ('RI 10)
+                           ('OV 12)
+                           ('TR 13)
+                           (& (ASSERT! NIL (ARB (UNSIGNED-BYTE 5))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "SignalException"
+   (VAR "ExceptionType" (CTY "ExceptionType"))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (MOP NOT
+               (DEST "EXL" BTY
+                     (DEST "Status" (CTY "StatusRegister")
+                           (DEST "CP0" (CTY "CP0") QVAR))))
+          (RUPD "CP0"
+                (TP (SQBKT QVAR
+                           (RUPD "EPC"
+                                 (TP (SQBKT (DEST "CP0" (CTY "CP0") QVAR)
+                                            (DEST "PC" F64 QVAR)))))))
+          QVAR)
+     (LET
+      (VAR "v" (CTY "CP0"))
+      (DEST "CP0" (CTY "CP0") QVAR)
+      (LET
+       QVAR
+       (RUPD
+        "CP0"
+        (TP
+         (SQBKT
+          QVAR
+          (RUPD
+           "Cause"
+           (TP
+             (SQBKT (VAR "v" (CTY "CP0"))
+                    (RUPD "ExcCode"
+                          (TP (SQBKT (DEST "Cause" (CTY "CauseRegister")
+                                           (VAR "v" (CTY "CP0")))
+                                     (CALL "ExceptionCode" (FTY 5)
+                                           (VAR "ExceptionType"
+                                                (CTY "ExceptionType"))))))))))))
+       (LET
+        (VAR "v" (CTY "CP0"))
+        (DEST "CP0" (CTY "CP0") QVAR)
+        (LET
+         QVAR
+         (RUPD
+          "CP0"
+          (TP
+           (SQBKT
+            QVAR
+            (RUPD
+               "Status"
+               (TP (SQBKT (VAR "v" (CTY "CP0"))
+                          (RUPD "EXL"
+                                (TP (SQBKT (DEST "Status" (CTY "StatusRegister")
+                                                 (VAR "v" (CTY "CP0")))
+                                           LT)))))))))
+         (LET
+            (VAR "v" F64)
+            (ITE (DEST "BEV" BTY
+                       (DEST "Status" (CTY "StatusRegister")
+                             (DEST "CP0" (CTY "CP0") QVAR)))
+                 (LW 18446744072631616000 64)
+                 (LW 18446744071562067968 64))
+            (TP (SQBKT LU
+                       (RUPD "PC"
+                             (TP (SQBKT QVAR CC
+                                        (SQBKT (EX (VAR "v" F64)
+                                                   (LN 63)
+                                                   (LN 30)
+                                                   (FTY 34))
+                                               (BOP ADD
+                                                    (EX (VAR "v" F64)
+                                                        (LN 29)
+                                                        (LN 0)
+                                                        (FTY 30))
+                                                    (LW 384 30))))))))))))))))))
+
+(DEFUN-STRUCT NOTWORDVALUE
+              ((VALUE (UNSIGNED-BYTE-P 64 VALUE)))
+              (LET ((TOP (BITS VALUE 63 32)))
+                   (IF (LOGBITP 64 VALUE 31)
+                       (NOT (EQL TOP 4294967295))
+                       (NOT (EQL TOP 0)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+      "dfn'ADDI"
+      (TP (SQBKT (VAR "rs" (FTY 5))
+                 (VAR "rt" (FTY 5))
+                 (VAR "immediate" F16)))
+      (CLOSE QVAR
+             (LET QVAR
+                  (ITE (CALL "NotWordValue" BTY
+                             (MOP FST
+                                  (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                               (VAR "rs" (FTY 5)))
+                                         QVAR)))
+                       (MOP SND
+                            (APPLY (CALL "raise'exception"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (CALL "UNPREDICTABLE" (CTY "exception")
+                                               (LS "ADDI: NotWordValue")))
+                                   QVAR))
+                       QVAR)
+                  (LET (VAR "v" (FTY 33))
+                       (BOP ADD
+                            (EX (MOP FST
+                                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                  (VAR "rs" (FTY 5)))
+                                            QVAR))
+                                (LN 32)
+                                (LN 0)
+                                (FTY 33))
+                            (MOP (SE (FTY 33))
+                                 (VAR "immediate" F16)))
+                       (ITE (MOP NOT
+                                 (EQ (BOP BIT (VAR "v" (FTY 33)) (LN 32))
+                                     (BOP BIT (VAR "v" (FTY 33)) (LN 31))))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Ov" (CTY "ExceptionType")))
+                                   QVAR)
+                            (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                         (TP (SQBKT (MOP (SE F64)
+                                                         (EX (VAR "v" (FTY 33))
+                                                             (LN 31)
+                                                             (LN 0)
+                                                             F32))
+                                                    (VAR "rt" (FTY 5)))))
+                                   QVAR))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'ADDIU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "immediate" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (CALL "NotWordValue" BTY
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR)))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "ADDIU: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (APPLY
+      (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (MOP (SE F64)
+                        (BOP ADD
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)
+                             (MOP (SE F32) (VAR "immediate" F16))))
+                   (VAR "rt" (FTY 5)))))
+      QVAR))))))
+
+(VALUE-TRIPLE
+ (LIST
+      :ERROR
+      (DEF "dfn'DADDI"
+           (TP (SQBKT (VAR "rs" (FTY 5))
+                      (VAR "rt" (FTY 5))
+                      (VAR "immediate" F16)))
+           (CLOSE QVAR
+                  (LET (VAR "v" (FTY 65))
+                       (BOP ADD
+                            (MOP (SE (FTY 65))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR)))
+                            (MOP (SE (FTY 65))
+                                 (VAR "immediate" F16)))
+                       (ITE (MOP NOT
+                                 (EQ (BOP BIT (VAR "v" (FTY 65)) (LN 64))
+                                     (BOP BIT (VAR "v" (FTY 65)) (LN 63))))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Ov" (CTY "ExceptionType")))
+                                   QVAR)
+                            (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                         (TP (SQBKT (EX (VAR "v" (FTY 65))
+                                                        (LN 63)
+                                                        (LN 0)
+                                                        F64)
+                                                    (VAR "rt" (FTY 5)))))
+                                   QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DADDIU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "immediate" F16)))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP ADD
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16)))
+                            (VAR "rt" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SLTI"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "immediate" F16)))
+   (CLOSE
+    QVAR
+    (APPLY
+      (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+            (TP (SQBKT (MOP (CAST F64)
+                            (BOP LT
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16))))
+                       (VAR "rt" (FTY 5)))))
+      QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SLTIU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "immediate" F16)))
+   (CLOSE
+    QVAR
+    (APPLY
+      (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+            (TP (SQBKT (MOP (CAST F64)
+                            (BOP ULT
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16))))
+                       (VAR "rt" (FTY 5)))))
+      QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'ANDI"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "immediate" F16)))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP BAND
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (CAST F64) (VAR "immediate" F16)))
+                            (VAR "rt" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'ORI"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "immediate" F16)))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP BOR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (CAST F64) (VAR "immediate" F16)))
+                            (VAR "rt" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'XORI"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "immediate" F16)))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP BXOR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (CAST F64) (VAR "immediate" F16)))
+                            (VAR "rt" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST :ERROR
+       (DEF "dfn'LUI"
+            (TP (SQBKT (VAR "rt" (FTY 5))
+                       (VAR "immediate" F16)))
+            (CLOSE QVAR
+                   (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                (TP (SQBKT (MOP (SE F64)
+                                                (CC (SQBKT (VAR "immediate" F16)
+                                                           (LW 0 16))))
+                                           (VAR "rt" (FTY 5)))))
+                          QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+     "dfn'ADD"
+     (TP (SQBKT (VAR "rs" (FTY 5))
+                (VAR "rt" (FTY 5))
+                (VAR "rd" (FTY 5))))
+     (CLOSE QVAR
+            (LET QVAR
+                 (ITE (BOP OR
+                           (CALL "NotWordValue" BTY
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR)))
+                           (CALL "NotWordValue" BTY
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))
+                      (MOP SND
+                           (APPLY (CALL "raise'exception"
+                                        (ATY QTY (PTY UTY QTY))
+                                        (CALL "UNPREDICTABLE" (CTY "exception")
+                                              (LS "ADD: NotWordValue")))
+                                  QVAR))
+                      QVAR)
+                 (LET (VAR "v" (FTY 33))
+                      (BOP ADD
+                           (EX (MOP FST
+                                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                 (VAR "rs" (FTY 5)))
+                                           QVAR))
+                               (LN 32)
+                               (LN 0)
+                               (FTY 33))
+                           (EX (MOP FST
+                                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                 (VAR "rt" (FTY 5)))
+                                           QVAR))
+                               (LN 32)
+                               (LN 0)
+                               (FTY 33)))
+                      (ITE (MOP NOT
+                                (EQ (BOP BIT (VAR "v" (FTY 33)) (LN 32))
+                                    (BOP BIT (VAR "v" (FTY 33)) (LN 31))))
+                           (APPLY (CALL "SignalException"
+                                        (ATY QTY (PTY UTY QTY))
+                                        (LC "Ov" (CTY "ExceptionType")))
+                                  QVAR)
+                           (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                        (TP (SQBKT (MOP (SE F64)
+                                                        (EX (VAR "v" (FTY 33))
+                                                            (LN 31)
+                                                            (LN 0)
+                                                            F32))
+                                                   (VAR "rd" (FTY 5)))))
+                                  QVAR))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'ADDU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (BOP OR
+               (CALL "NotWordValue" BTY
+                     (MOP FST
+                          (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                       (VAR "rs" (FTY 5)))
+                                 QVAR)))
+               (CALL "NotWordValue" BTY
+                     (MOP FST
+                          (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                       (VAR "rt" (FTY 5)))
+                                 QVAR))))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "ADDU: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (APPLY
+      (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (MOP (SE F64)
+                        (BOP ADD
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)))
+                   (VAR "rd" (FTY 5)))))
+      QVAR))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+     "dfn'SUB"
+     (TP (SQBKT (VAR "rs" (FTY 5))
+                (VAR "rt" (FTY 5))
+                (VAR "rd" (FTY 5))))
+     (CLOSE QVAR
+            (LET QVAR
+                 (ITE (BOP OR
+                           (CALL "NotWordValue" BTY
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR)))
+                           (CALL "NotWordValue" BTY
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))
+                      (MOP SND
+                           (APPLY (CALL "raise'exception"
+                                        (ATY QTY (PTY UTY QTY))
+                                        (CALL "UNPREDICTABLE" (CTY "exception")
+                                              (LS "SUB: NotWordValue")))
+                                  QVAR))
+                      QVAR)
+                 (LET (VAR "v" (FTY 33))
+                      (BOP SUB
+                           (EX (MOP FST
+                                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                 (VAR "rs" (FTY 5)))
+                                           QVAR))
+                               (LN 32)
+                               (LN 0)
+                               (FTY 33))
+                           (EX (MOP FST
+                                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                 (VAR "rt" (FTY 5)))
+                                           QVAR))
+                               (LN 32)
+                               (LN 0)
+                               (FTY 33)))
+                      (ITE (MOP NOT
+                                (EQ (BOP BIT (VAR "v" (FTY 33)) (LN 32))
+                                    (BOP BIT (VAR "v" (FTY 33)) (LN 31))))
+                           (APPLY (CALL "SignalException"
+                                        (ATY QTY (PTY UTY QTY))
+                                        (LC "Ov" (CTY "ExceptionType")))
+                                  QVAR)
+                           (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                        (TP (SQBKT (MOP (SE F64)
+                                                        (EX (VAR "v" (FTY 33))
+                                                            (LN 31)
+                                                            (LN 0)
+                                                            F32))
+                                                   (VAR "rd" (FTY 5)))))
+                                  QVAR))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SUBU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (BOP OR
+               (CALL "NotWordValue" BTY
+                     (MOP FST
+                          (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                       (VAR "rs" (FTY 5)))
+                                 QVAR)))
+               (CALL "NotWordValue" BTY
+                     (MOP FST
+                          (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                       (VAR "rt" (FTY 5)))
+                                 QVAR))))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "SUBU: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (APPLY
+      (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (MOP (SE F64)
+                        (BOP SUB
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 32)
+                                 (LN 0)
+                                 (FTY 33))
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 32)
+                                 (LN 0)
+                                 (FTY 33))))
+                   (VAR "rd" (FTY 5)))))
+      QVAR))))))
+
+(VALUE-TRIPLE
+ (LIST
+      :ERROR
+      (DEF "dfn'DADD"
+           (TP (SQBKT (VAR "rs" (FTY 5))
+                      (VAR "rt" (FTY 5))
+                      (VAR "rd" (FTY 5))))
+           (CLOSE QVAR
+                  (LET (VAR "v" (FTY 65))
+                       (BOP ADD
+                            (MOP (SE (FTY 65))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR)))
+                            (MOP (SE (FTY 65))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))
+                       (ITE (MOP NOT
+                                 (EQ (BOP BIT (VAR "v" (FTY 65)) (LN 64))
+                                     (BOP BIT (VAR "v" (FTY 65)) (LN 63))))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Ov" (CTY "ExceptionType")))
+                                   QVAR)
+                            (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                         (TP (SQBKT (EX (VAR "v" (FTY 65))
+                                                        (LN 63)
+                                                        (LN 0)
+                                                        F64)
+                                                    (VAR "rd" (FTY 5)))))
+                                   QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DADDU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP ADD
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+      :ERROR
+      (DEF "dfn'DSUB"
+           (TP (SQBKT (VAR "rs" (FTY 5))
+                      (VAR "rt" (FTY 5))
+                      (VAR "rd" (FTY 5))))
+           (CLOSE QVAR
+                  (LET (VAR "v" (FTY 65))
+                       (BOP SUB
+                            (MOP (SE (FTY 65))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR)))
+                            (MOP (SE (FTY 65))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))
+                       (ITE (MOP NOT
+                                 (EQ (BOP BIT (VAR "v" (FTY 65)) (LN 64))
+                                     (BOP BIT (VAR "v" (FTY 65)) (LN 63))))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Ov" (CTY "ExceptionType")))
+                                   QVAR)
+                            (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                         (TP (SQBKT (EX (VAR "v" (FTY 65))
+                                                        (LN 63)
+                                                        (LN 0)
+                                                        F64)
+                                                    (VAR "rd" (FTY 5)))))
+                                   QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSUBU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP SUB
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SLT"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY
+      (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+            (TP (SQBKT (MOP (CAST F64)
+                            (BOP LT
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))
+                       (VAR "rd" (FTY 5)))))
+      QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SLTU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY
+      (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+            (TP (SQBKT (MOP (CAST F64)
+                            (BOP ULT
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))
+                       (VAR "rd" (FTY 5)))))
+      QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'AND"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP BAND
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'OR"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP BOR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'XOR"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP BXOR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'NOR"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY
+      (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+            (TP (SQBKT (MOP BNOT
+                            (BOP BOR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))
+                       (VAR "rd" (FTY 5)))))
+      QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'MULT"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (BOP OR
+               (CALL "NotWordValue" BTY
+                     (MOP FST
+                          (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                       (VAR "rs" (FTY 5)))
+                                 QVAR)))
+               (CALL "NotWordValue" BTY
+                     (MOP FST
+                          (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                       (VAR "rt" (FTY 5)))
+                                 QVAR))))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "MULT: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (LET
+      (VAR "v" F64)
+      (BOP MUL
+           (MOP (SE F64)
+                (EX (MOP FST
+                         (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                      (VAR "rs" (FTY 5)))
+                                QVAR))
+                    (LN 31)
+                    (LN 0)
+                    F32))
+           (MOP (SE F64)
+                (EX (MOP FST
+                         (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                      (VAR "rt" (FTY 5)))
+                                QVAR))
+                    (LN 31)
+                    (LN 0)
+                    F32)))
+      (TP
+       (SQBKT
+        LU
+        (RUPD
+             "HLStatus"
+             (TP (SQBKT (RUPD "HI"
+                              (TP (SQBKT (RUPD "LO"
+                                               (TP (SQBKT QVAR
+                                                          (MOP (SE F64)
+                                                               (EX (VAR "v" F64)
+                                                                   (LN 31)
+                                                                   (LN 0)
+                                                                   F32)))))
+                                         (MOP (SE F64)
+                                              (EX (VAR "v" F64)
+                                                  (LN 63)
+                                                  (LN 32)
+                                                  F32)))))
+                        (LC "HLarith" (CTY "HLStatus")))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'MULTU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (BOP OR
+               (CALL "NotWordValue" BTY
+                     (MOP FST
+                          (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                       (VAR "rs" (FTY 5)))
+                                 QVAR)))
+               (CALL "NotWordValue" BTY
+                     (MOP FST
+                          (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                       (VAR "rt" (FTY 5)))
+                                 QVAR))))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "MULTU: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (LET
+      (VAR "v" F64)
+      (BOP MUL
+           (MOP (CAST F64)
+                (EX (MOP FST
+                         (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                      (VAR "rs" (FTY 5)))
+                                QVAR))
+                    (LN 31)
+                    (LN 0)
+                    F32))
+           (MOP (CAST F64)
+                (EX (MOP FST
+                         (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                      (VAR "rt" (FTY 5)))
+                                QVAR))
+                    (LN 31)
+                    (LN 0)
+                    F32)))
+      (TP
+       (SQBKT
+        LU
+        (RUPD
+             "HLStatus"
+             (TP (SQBKT (RUPD "HI"
+                              (TP (SQBKT (RUPD "LO"
+                                               (TP (SQBKT QVAR
+                                                          (MOP (SE F64)
+                                                               (EX (VAR "v" F64)
+                                                                   (LN 31)
+                                                                   (LN 0)
+                                                                   F32)))))
+                                         (MOP (SE F64)
+                                              (EX (VAR "v" F64)
+                                                  (LN 63)
+                                                  (LN 32)
+                                                  F32)))))
+                        (LC "HLarith" (CTY "HLStatus")))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DMULT"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" (FTY 128))
+     (BOP MUL
+          (MOP (SE (FTY 128))
+               (MOP FST
+                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                 (VAR "rs" (FTY 5)))
+                           QVAR)))
+          (MOP (SE (FTY 128))
+               (MOP FST
+                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                 (VAR "rt" (FTY 5)))
+                           QVAR))))
+     (TP
+      (SQBKT
+       LU
+       (RUPD
+            "HLStatus"
+            (TP (SQBKT (RUPD "HI"
+                             (TP (SQBKT (RUPD "LO"
+                                              (TP (SQBKT QVAR
+                                                         (EX (VAR "v" (FTY 128))
+                                                             (LN 63)
+                                                             (LN 0)
+                                                             F64))))
+                                        (EX (VAR "v" (FTY 128))
+                                            (LN 127)
+                                            (LN 64)
+                                            F64))))
+                       (LC "HLarith" (CTY "HLStatus"))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DMULTU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" (FTY 128))
+     (BOP MUL
+          (MOP (CAST (FTY 128))
+               (MOP FST
+                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                 (VAR "rs" (FTY 5)))
+                           QVAR)))
+          (MOP (CAST (FTY 128))
+               (MOP FST
+                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                 (VAR "rt" (FTY 5)))
+                           QVAR))))
+     (TP
+      (SQBKT
+       LU
+       (RUPD
+            "HLStatus"
+            (TP (SQBKT (RUPD "HI"
+                             (TP (SQBKT (RUPD "LO"
+                                              (TP (SQBKT QVAR
+                                                         (EX (VAR "v" (FTY 128))
+                                                             (LN 63)
+                                                             (LN 0)
+                                                             F64))))
+                                        (EX (VAR "v" (FTY 128))
+                                            (LN 127)
+                                            (LN 64)
+                                            F64))))
+                       (LC "HLarith" (CTY "HLStatus"))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DIV"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (EQ (MOP FST
+                   (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                (VAR "rt" (FTY 5)))
+                          QVAR))
+              (LW 0 64))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "DIV: divide by zero")))
+                      QVAR))
+          QVAR)
+     (LET
+      QVAR
+      (ITE (BOP OR
+                (CALL "NotWordValue" BTY
+                      (MOP FST
+                           (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                        (VAR "rs" (FTY 5)))
+                                  QVAR)))
+                (CALL "NotWordValue" BTY
+                      (MOP FST
+                           (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                        (VAR "rt" (FTY 5)))
+                                  QVAR))))
+           (MOP SND
+                (APPLY (CALL "raise'exception"
+                             (ATY QTY (PTY UTY QTY))
+                             (CALL "UNPREDICTABLE" (CTY "exception")
+                                   (LS "DIV: NotWordValue")))
+                       QVAR))
+           QVAR)
+      (LET
+       QVAR
+       (RUPD
+        "LO"
+        (TP (SQBKT QVAR
+                   (MOP (SE F64)
+                        (BOP QUOT
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32))))))
+       (TP
+        (SQBKT
+         LU
+         (RUPD
+          "HLStatus"
+          (TP
+           (SQBKT
+            (RUPD
+             "HI"
+             (TP
+              (SQBKT
+                   QVAR
+                   (MOP (SE F64)
+                        (BOP REM
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32))))))
+            (LC "HLarith" (CTY "HLStatus"))))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DIVU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (EQ (MOP FST
+                   (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                (VAR "rt" (FTY 5)))
+                          QVAR))
+              (LW 0 64))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "DIVU: divide by zero")))
+                      QVAR))
+          QVAR)
+     (LET
+      QVAR
+      (ITE (BOP OR
+                (CALL "NotWordValue" BTY
+                      (MOP FST
+                           (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                        (VAR "rs" (FTY 5)))
+                                  QVAR)))
+                (CALL "NotWordValue" BTY
+                      (MOP FST
+                           (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                        (VAR "rt" (FTY 5)))
+                                  QVAR))))
+           (MOP SND
+                (APPLY (CALL "raise'exception"
+                             (ATY QTY (PTY UTY QTY))
+                             (CALL "UNPREDICTABLE" (CTY "exception")
+                                   (LS "DIVU: NotWordValue")))
+                       QVAR))
+           QVAR)
+      (TP
+       (SQBKT
+        LU
+        (RUPD
+         "HLStatus"
+         (TP
+          (SQBKT
+           (RUPD
+            "HI"
+            (TP
+             (SQBKT
+              (RUPD
+               "LO"
+               (TP
+                (SQBKT
+                   QVAR
+                   (MOP (SE F64)
+                        (BOP DIV
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32))))))
+              (MOP (SE F64)
+                   (BOP MOD
+                        (EX (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rs" (FTY 5)))
+                                        QVAR))
+                            (LN 31)
+                            (LN 0)
+                            F32)
+                        (EX (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rt" (FTY 5)))
+                                        QVAR))
+                            (LN 31)
+                            (LN 0)
+                            F32))))))
+           (LC "HLarith" (CTY "HLStatus")))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DDIV"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (EQ (MOP FST
+                   (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                (VAR "rt" (FTY 5)))
+                          QVAR))
+              (LW 0 64))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "DDIV: divide by zero")))
+                      QVAR))
+          QVAR)
+     (LET
+      QVAR
+      (RUPD "LO"
+            (TP (SQBKT QVAR
+                       (BOP QUOT
+                            (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rs" (FTY 5)))
+                                        QVAR))
+                            (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rt" (FTY 5)))
+                                        QVAR))))))
+      (TP
+       (SQBKT
+        LU
+        (RUPD
+         "HLStatus"
+         (TP
+          (SQBKT
+           (RUPD "HI"
+                 (TP (SQBKT QVAR
+                            (BOP REM
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))))
+           (LC "HLarith" (CTY "HLStatus")))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DDIVU"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (EQ (MOP FST
+                   (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                (VAR "rt" (FTY 5)))
+                          QVAR))
+              (LW 0 64))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "DDIVU: divide by zero")))
+                      QVAR))
+          QVAR)
+     (LET
+      QVAR
+      (RUPD "LO"
+            (TP (SQBKT QVAR
+                       (BOP DIV
+                            (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rs" (FTY 5)))
+                                        QVAR))
+                            (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rt" (FTY 5)))
+                                        QVAR))))))
+      (TP
+       (SQBKT
+        LU
+        (RUPD
+         "HLStatus"
+         (TP
+          (SQBKT
+           (RUPD "HI"
+                 (TP (SQBKT QVAR
+                            (BOP MOD
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))))))
+           (LC "HLarith" (CTY "HLStatus")))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+     "dfn'MFHI" (VAR "rd" (FTY 5))
+     (CLOSE QVAR
+            (LET QVAR
+                 (ITE (EQ (DEST "HLStatus" (CTY "HLStatus") QVAR)
+                          (LC "HLmtlo" (CTY "HLStatus")))
+                      (MOP SND
+                           (APPLY (CALL "raise'exception"
+                                        (ATY QTY (PTY UTY QTY))
+                                        (CALL "UNPREDICTABLE" (CTY "exception")
+                                              (LS "MFHI")))
+                                  QVAR))
+                      QVAR)
+                 (LET QVAR
+                      (ITE (EQ (DEST "HLStatus" (CTY "HLStatus") QVAR)
+                               (LC "HLarith" (CTY "HLStatus")))
+                           (RUPD "HLStatus"
+                                 (TP (SQBKT QVAR (LC "HLok" (CTY "HLStatus")))))
+                           QVAR)
+                      (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                   (TP (SQBKT (DEST "HI" F64 QVAR)
+                                              (VAR "rd" (FTY 5)))))
+                             QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+     "dfn'MFLO" (VAR "rd" (FTY 5))
+     (CLOSE QVAR
+            (LET QVAR
+                 (ITE (EQ (DEST "HLStatus" (CTY "HLStatus") QVAR)
+                          (LC "HLmthi" (CTY "HLStatus")))
+                      (MOP SND
+                           (APPLY (CALL "raise'exception"
+                                        (ATY QTY (PTY UTY QTY))
+                                        (CALL "UNPREDICTABLE" (CTY "exception")
+                                              (LS "MFLO")))
+                                  QVAR))
+                      QVAR)
+                 (LET QVAR
+                      (ITE (EQ (DEST "HLStatus" (CTY "HLStatus") QVAR)
+                               (LC "HLarith" (CTY "HLStatus")))
+                           (RUPD "HLStatus"
+                                 (TP (SQBKT QVAR (LC "HLok" (CTY "HLStatus")))))
+                           QVAR)
+                      (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                   (TP (SQBKT (DEST "LO" F64 QVAR)
+                                              (VAR "rd" (FTY 5)))))
+                             QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'MTHI" (VAR "rd" (FTY 5))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITB (SQBKT ((EQ (DEST "HLStatus" (CTY "HLStatus") QVAR)
+                      (LC "HLarith" (CTY "HLStatus")))
+                  (RUPD "HLStatus"
+                        (TP (SQBKT QVAR (LC "HLmthi" (CTY "HLStatus"))))))
+                 ((EQ (DEST "HLStatus" (CTY "HLStatus") QVAR)
+                      (LC "HLmtlo" (CTY "HLStatus")))
+                  (RUPD "HLStatus"
+                        (TP (SQBKT QVAR (LC "HLok" (CTY "HLStatus")))))))
+          QVAR)
+     (TP (SQBKT LU
+                (RUPD "HI"
+                      (TP (SQBKT QVAR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rd" (FTY 5)))
+                                             QVAR))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'MTLO" (VAR "rd" (FTY 5))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITB (SQBKT ((EQ (DEST "HLStatus" (CTY "HLStatus") QVAR)
+                      (LC "HLarith" (CTY "HLStatus")))
+                  (RUPD "HLStatus"
+                        (TP (SQBKT QVAR (LC "HLmtlo" (CTY "HLStatus"))))))
+                 ((EQ (DEST "HLStatus" (CTY "HLStatus") QVAR)
+                      (LC "HLmthi" (CTY "HLStatus")))
+                  (RUPD "HLStatus"
+                        (TP (SQBKT QVAR (LC "HLok" (CTY "HLStatus")))))))
+          QVAR)
+     (TP (SQBKT LU
+                (RUPD "LO"
+                      (TP (SQBKT QVAR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rd" (FTY 5)))
+                                             QVAR))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SLL"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY
+     (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (MOP (SE F64)
+                        (BOP LSL
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)
+                             (MOP (CAST NTY) (VAR "sa" (FTY 5)))))
+                   (VAR "rd" (FTY 5)))))
+     QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SRL"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (CALL "NotWordValue" BTY
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rt" (FTY 5)))
+                            QVAR)))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "SRL: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (APPLY
+      (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (MOP (SE F64)
+                        (BOP LSR
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)
+                             (MOP (CAST NTY) (VAR "sa" (FTY 5)))))
+                   (VAR "rd" (FTY 5)))))
+      QVAR))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SRA"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (CALL "NotWordValue" BTY
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rt" (FTY 5)))
+                            QVAR)))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "SRA: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (APPLY
+      (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (MOP (SE F64)
+                        (BOP ASR
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32)
+                             (MOP (CAST NTY) (VAR "sa" (FTY 5)))))
+                   (VAR "rd" (FTY 5)))))
+      QVAR))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SLLV"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY
+     (CALL
+      "write'GPR" (ATY QTY (PTY UTY QTY))
+      (TP
+       (SQBKT (MOP (SE F64)
+                   (BOP LSL
+                        (EX (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rt" (FTY 5)))
+                                        QVAR))
+                            (LN 31)
+                            (LN 0)
+                            F32)
+                        (MOP (CAST NTY)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 4)
+                                 (LN 0)
+                                 (FTY 5)))))
+              (VAR "rd" (FTY 5)))))
+     QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SRLV"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (CALL "NotWordValue" BTY
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rt" (FTY 5)))
+                            QVAR)))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "SRLV: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (APPLY
+      (CALL
+       "write'GPR" (ATY QTY (PTY UTY QTY))
+       (TP
+         (SQBKT
+              (MOP (SE F64)
+                   (BOP LSR
+                        (EX (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rt" (FTY 5)))
+                                        QVAR))
+                            (LN 31)
+                            (LN 0)
+                            F32)
+                        (MOP (CAST NTY)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 4)
+                                 (LN 0)
+                                 (FTY 5)))))
+              (VAR "rd" (FTY 5)))))
+      QVAR))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SRAV"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (ITE (CALL "NotWordValue" BTY
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rt" (FTY 5)))
+                            QVAR)))
+          (MOP SND
+               (APPLY (CALL "raise'exception"
+                            (ATY QTY (PTY UTY QTY))
+                            (CALL "UNPREDICTABLE" (CTY "exception")
+                                  (LS "SRAV: NotWordValue")))
+                      QVAR))
+          QVAR)
+     (APPLY
+      (CALL
+       "write'GPR" (ATY QTY (PTY UTY QTY))
+       (TP
+         (SQBKT
+              (MOP (SE F64)
+                   (BOP ASR
+                        (EX (MOP FST
+                                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                              (VAR "rt" (FTY 5)))
+                                        QVAR))
+                            (LN 31)
+                            (LN 0)
+                            F32)
+                        (MOP (CAST NTY)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 4)
+                                 (LN 0)
+                                 (FTY 5)))))
+              (VAR "rd" (FTY 5)))))
+      QVAR))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSLL"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP LSL
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (MOP (CAST NTY) (VAR "sa" (FTY 5))))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSRL"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP LSR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (MOP (CAST NTY) (VAR "sa" (FTY 5))))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSRA"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP ASR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (MOP (CAST NTY) (VAR "sa" (FTY 5))))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSLLV"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY
+     (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (BOP LSL
+                        (MOP FST
+                             (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                          (VAR "rt" (FTY 5)))
+                                    QVAR))
+                        (MOP (CAST NTY)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 5)
+                                 (LN 0)
+                                 (FTY 6))))
+                   (VAR "rd" (FTY 5)))))
+     QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSRLV"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY
+     (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (BOP LSR
+                        (MOP FST
+                             (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                          (VAR "rt" (FTY 5)))
+                                    QVAR))
+                        (MOP (CAST NTY)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 5)
+                                 (LN 0)
+                                 (FTY 6))))
+                   (VAR "rd" (FTY 5)))))
+     QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSRAV"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY
+     (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (BOP ASR
+                        (MOP FST
+                             (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                          (VAR "rt" (FTY 5)))
+                                    QVAR))
+                        (MOP (CAST NTY)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (LN 5)
+                                 (LN 0)
+                                 (FTY 6))))
+                   (VAR "rd" (FTY 5)))))
+     QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSLL32"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP LSL
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (BOP ADD (MOP (CAST NTY) (VAR "sa" (FTY 5)))
+                                      (LN 32)))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSRL32"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP LSR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (BOP ADD (MOP (CAST NTY) (VAR "sa" (FTY 5)))
+                                      (LN 32)))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DSRA32"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sa" (FTY 5))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (BOP ASR
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (BOP ADD (MOP (CAST NTY) (VAR "sa" (FTY 5)))
+                                      (LN 32)))
+                            (VAR "rd" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR (DEF "dfn'TGE"
+                (TP (SQBKT (VAR "rs" (FTY 5))
+                           (VAR "rt" (FTY 5))))
+                (CLOSE QVAR
+                       (ITE (BOP GE
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Tr" (CTY "ExceptionType")))
+                                   QVAR)
+                            (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR (DEF "dfn'TGEU"
+                (TP (SQBKT (VAR "rs" (FTY 5))
+                           (VAR "rt" (FTY 5))))
+                (CLOSE QVAR
+                       (ITE (BOP UGE
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Tr" (CTY "ExceptionType")))
+                                   QVAR)
+                            (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR (DEF "dfn'TLT"
+                (TP (SQBKT (VAR "rs" (FTY 5))
+                           (VAR "rt" (FTY 5))))
+                (CLOSE QVAR
+                       (ITE (BOP LT
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Tr" (CTY "ExceptionType")))
+                                   QVAR)
+                            (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR (DEF "dfn'TLTU"
+                (TP (SQBKT (VAR "rs" (FTY 5))
+                           (VAR "rt" (FTY 5))))
+                (CLOSE QVAR
+                       (ITE (BOP ULT
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR)))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Tr" (CTY "ExceptionType")))
+                                   QVAR)
+                            (TP (SQBKT LU QVAR)))))))
+
+(DEFUN-STRUCT DFN-TEQ
+              (((RS (UNSIGNED-BYTE-P 5 RS))
+                (RT (UNSIGNED-BYTE-P 5 RT)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (IF (EQUAL (CAR (GPR RS ST$))
+                         (CAR (GPR RT ST$)))
+                  (SIGNALEXCEPTION 'TR ST$)
+                  (MV (UNIT-VALUE) ST$)))
+
+(DEFUN-STRUCT DFN-TNE
+              (((RS (UNSIGNED-BYTE-P 5 RS))
+                (RT (UNSIGNED-BYTE-P 5 RT)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (IF (NOT (EQUAL (CAR (GPR RS ST$))
+                              (CAR (GPR RT ST$))))
+                  (SIGNALEXCEPTION 'TR ST$)
+                  (MV (UNIT-VALUE) ST$)))
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR (DEF "dfn'TGEI"
+                (TP (SQBKT (VAR "rs" (FTY 5))
+                           (VAR "immediate" F16)))
+                (CLOSE QVAR
+                       (ITE (BOP GE
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16)))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Tr" (CTY "ExceptionType")))
+                                   QVAR)
+                            (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR (DEF "dfn'TGEIU"
+                (TP (SQBKT (VAR "rs" (FTY 5))
+                           (VAR "immediate" F16)))
+                (CLOSE QVAR
+                       (ITE (BOP UGE
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16)))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Tr" (CTY "ExceptionType")))
+                                   QVAR)
+                            (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR (DEF "dfn'TLTI"
+                (TP (SQBKT (VAR "rs" (FTY 5))
+                           (VAR "immediate" F16)))
+                (CLOSE QVAR
+                       (ITE (BOP LT
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16)))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Tr" (CTY "ExceptionType")))
+                                   QVAR)
+                            (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+    :ERROR (DEF "dfn'TLTIU"
+                (TP (SQBKT (VAR "rs" (FTY 5))
+                           (VAR "immediate" F16)))
+                (CLOSE QVAR
+                       (ITE (BOP ULT
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16)))
+                            (APPLY (CALL "SignalException"
+                                         (ATY QTY (PTY UTY QTY))
+                                         (LC "Tr" (CTY "ExceptionType")))
+                                   QVAR)
+                            (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+     :ERROR (DEF "dfn'TEQI"
+                 (TP (SQBKT (VAR "rs" (FTY 5))
+                            (VAR "immediate" F16)))
+                 (CLOSE QVAR
+                        (ITE (EQ (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16)))
+                             (APPLY (CALL "SignalException"
+                                          (ATY QTY (PTY UTY QTY))
+                                          (LC "Tr" (CTY "ExceptionType")))
+                                    QVAR)
+                             (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST :ERROR
+       (DEF "dfn'TNEI"
+            (TP (SQBKT (VAR "rs" (FTY 5))
+                       (VAR "immediate" F16)))
+            (CLOSE QVAR
+                   (ITE (MOP NOT
+                             (EQ (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))
+                                 (MOP (SE F64) (VAR "immediate" F16))))
+                        (APPLY (CALL "SignalException"
+                                     (ATY QTY (PTY UTY QTY))
+                                     (LC "Tr" (CTY "ExceptionType")))
+                               QVAR)
+                        (TP (SQBKT LU QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "loadByte"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)
+              (VAR "unsigned" BTY)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "LOAD" (CTY "LorS")))))
+      (LET
+       (VAR "v0" (FTY 3))
+       (BOP BXOR
+            (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+            (BOP REP
+                 (MOP FST
+                      (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                             QVAR))
+                 (LN 3)))
+       (LET
+        (VAR "membyte" F8)
+        (EX
+         (MOP
+          FST
+          (APPLY
+           (CALL
+            "LoadMemory" (ATY QTY (PTY F64 QTY))
+            (TP
+             (SQBKT
+              (VAR "CCA" (FTY 3))
+              (CONST "BYTE" (FTY 3))
+              CC
+              (SQBKT
+               (EX (VAR "pAddr" F64)
+                   (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                   (LN 3)
+                   (FTY 61))
+               (BOP
+                 BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3))))
+              (VAR "v" F64)
+              (LC "DATA" (CTY "IorD")))))
+           QVAR))
+         (BOP ADD (LN 7)
+              (BOP MUL (LN 8)
+                   (MOP (CAST NTY) (VAR "v0" (FTY 3)))))
+         (BOP MUL (LN 8)
+              (MOP (CAST NTY) (VAR "v0" (FTY 3))))
+         F8)
+        (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                     (TP (SQBKT (ITE (VAR "unsigned" BTY)
+                                     (MOP (CAST F64) (VAR "membyte" F8))
+                                     (MOP (SE F64) (VAR "membyte" F8)))
+                                (VAR "rt" (FTY 5)))))
+               QVAR)))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "loadHalf"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)
+              (VAR "unsigned" BTY)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (ITE
+      (BOP BIT (VAR "v" F64) (LN 0))
+      (APPLY (CALL "SignalException"
+                   (ATY QTY (PTY UTY QTY))
+                   (LC "AdEL" (CTY "ExceptionType")))
+             QVAR)
+      (LET
+       (TP (SQBKT (VAR "pAddr" F64)
+                  (VAR "CCA" (FTY 3))))
+       (CALL "AddressTranslation" (PTY F64 (FTY 3))
+             (TP (SQBKT (VAR "v" F64)
+                        (LC "DATA" (CTY "IorD"))
+                        (LC "LOAD" (CTY "LorS")))))
+       (LET
+        (VAR "v0" (FTY 3))
+        (BOP
+         BXOR
+         (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+         (CC
+           (SQBKT (BOP REP
+                       (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR))
+                       (LN 2))
+                  (LW 0 1))))
+        (LET
+         (VAR "memhalf" F16)
+         (EX
+          (MOP
+           FST
+           (APPLY
+            (CALL
+             "LoadMemory" (ATY QTY (PTY F64 QTY))
+             (TP
+              (SQBKT
+               (VAR "CCA" (FTY 3))
+               (CONST "HALFWORD" (FTY 3))
+               CC
+               (SQBKT
+                (EX (VAR "pAddr" F64)
+                    (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                    (LN 3)
+                    (FTY 61))
+                (BOP
+                 BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (CC
+                  (SQBKT
+                   (BOP
+                      REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 2))
+                   (LW 0 1)))))
+               (VAR "v" F64)
+               (LC "DATA" (CTY "IorD")))))
+            QVAR))
+          (BOP ADD (LN 15)
+               (BOP MUL (LN 8)
+                    (MOP (CAST NTY) (VAR "v0" (FTY 3)))))
+          (BOP MUL (LN 8)
+               (MOP (CAST NTY) (VAR "v0" (FTY 3))))
+          F16)
+         (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                      (TP (SQBKT (ITE (VAR "unsigned" BTY)
+                                      (MOP (CAST F64) (VAR "memhalf" F16))
+                                      (MOP (SE F64) (VAR "memhalf" F16)))
+                                 (VAR "rt" (FTY 5)))))
+                QVAR))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "loadWord"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)
+              (VAR "unsigned" BTY)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (ITE
+      (MOP NOT
+           (EQ (EX (VAR "v" F64) (LN 1) (LN 0) (FTY 2))
+               (LW 0 2)))
+      (APPLY (CALL "SignalException"
+                   (ATY QTY (PTY UTY QTY))
+                   (LC "AdEL" (CTY "ExceptionType")))
+             QVAR)
+      (LET
+       (TP (SQBKT (VAR "pAddr" F64)
+                  (VAR "CCA" (FTY 3))))
+       (CALL "AddressTranslation" (PTY F64 (FTY 3))
+             (TP (SQBKT (VAR "v" F64)
+                        (LC "DATA" (CTY "IorD"))
+                        (LC "LOAD" (CTY "LorS")))))
+       (LET
+        (VAR "v0" (FTY 3))
+        (BOP
+            BXOR
+            (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+            (CC (SQBKT (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR))
+                       (LW 0 2))))
+        (LET
+         (VAR "memword" F32)
+         (EX
+          (MOP
+           FST
+           (APPLY
+            (CALL
+             "LoadMemory" (ATY QTY (PTY F64 QTY))
+             (TP
+              (SQBKT
+               (VAR "CCA" (FTY 3))
+               (CONST "WORD" (FTY 3))
+               CC
+               (SQBKT
+                (EX (VAR "pAddr" F64)
+                    (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                    (LN 3)
+                    (FTY 61))
+                (BOP
+                 BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (CC
+                  (SQBKT
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LW 0 2)))))
+               (VAR "v" F64)
+               (LC "DATA" (CTY "IorD")))))
+            QVAR))
+          (BOP ADD (LN 31)
+               (BOP MUL (LN 8)
+                    (MOP (CAST NTY) (VAR "v0" (FTY 3)))))
+          (BOP MUL (LN 8)
+               (MOP (CAST NTY) (VAR "v0" (FTY 3))))
+          F32)
+         (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                      (TP (SQBKT (ITE (VAR "unsigned" BTY)
+                                      (MOP (CAST F64) (VAR "memword" F32))
+                                      (MOP (SE F64) (VAR "memword" F32)))
+                                 (VAR "rt" (FTY 5)))))
+                QVAR))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "loadDoubleword"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (ITE
+      (MOP NOT
+           (EQ (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+               (LW 0 3)))
+      (APPLY (CALL "SignalException"
+                   (ATY QTY (PTY UTY QTY))
+                   (LC "AdEL" (CTY "ExceptionType")))
+             QVAR)
+      (LET
+       (TP (SQBKT (VAR "pAddr" F64)
+                  (VAR "CCA" (FTY 3))))
+       (CALL "AddressTranslation" (PTY F64 (FTY 3))
+             (TP (SQBKT (VAR "v" F64)
+                        (LC "DATA" (CTY "IorD"))
+                        (LC "LOAD" (CTY "LorS")))))
+       (APPLY
+        (CALL
+            "write'GPR" (ATY QTY (PTY UTY QTY))
+            (TP (SQBKT (MOP FST
+                            (APPLY (CALL "LoadMemory" (ATY QTY (PTY F64 QTY))
+                                         (TP (SQBKT (VAR "CCA" (FTY 3))
+                                                    (CONST "DOUBLEWORD" (FTY 3))
+                                                    (VAR "pAddr" F64)
+                                                    (VAR "v" F64)
+                                                    (LC "DATA" (CTY "IorD")))))
+                                   QVAR))
+                       (VAR "rt" (FTY 5)))))
+        QVAR))))))))
+
+(DEFUN-STRUCT DFN-LB
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LOADBYTE (TUPLE BASE RT OFFSET (FALSE))
+                        ST$))
+
+(DEFUN-STRUCT DFN-LBU
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LOADBYTE (TUPLE BASE RT OFFSET (TRUE))
+                        ST$))
+
+(DEFUN-STRUCT DFN-LH
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LOADHALF (TUPLE BASE RT OFFSET (FALSE))
+                        ST$))
+
+(DEFUN-STRUCT DFN-LHU
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LOADHALF (TUPLE BASE RT OFFSET (TRUE))
+                        ST$))
+
+(DEFUN-STRUCT DFN-LW
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LOADWORD (TUPLE BASE RT OFFSET (FALSE))
+                        ST$))
+
+(DEFUN-STRUCT DFN-LWU
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LOADWORD (TUPLE BASE RT OFFSET (TRUE))
+                        ST$))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'LL"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+      (SQBKT
+           LU
+           (RUPD "LLbit"
+                 (TP (SQBKT (MOP SND
+                                 (APPLY (CALL "loadWord" (ATY QTY (PTY UTY QTY))
+                                              (TP (SQBKT (VAR "base" (FTY 5))
+                                                         (VAR "rt" (FTY 5))
+                                                         (VAR "offset" F16)
+                                                         LF)))
+                                        QVAR))
+                            (MOP SOME LT))))))))))
+
+(DEFUN-STRUCT DFN-LD
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LOADDOUBLEWORD (TUPLE BASE RT OFFSET)
+                              ST$))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'LLD"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (RUPD
+           "LLbit"
+           (TP (SQBKT (MOP SND
+                           (APPLY (CALL "loadDoubleword" (ATY QTY (PTY UTY QTY))
+                                        (TP (SQBKT (VAR "base" (FTY 5))
+                                                   (VAR "rt" (FTY 5))
+                                                   (VAR "offset" F16))))
+                                  QVAR))
+                      (MOP SOME LT))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'LWL"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "LOAD" (CTY "LorS")))))
+      (LET
+       (VAR "v0" F64)
+       (CC
+        (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3)))))
+       (LET
+        (VAR "v1" (FTY 2))
+        (BOP BXOR
+             (EX (VAR "v" F64) (LN 1) (LN 0) (FTY 2))
+             (BOP REP
+                  (MOP FST
+                       (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                              QVAR))
+                  (LN 2)))
+        (LET
+         (VAR "v2" F64)
+         (MOP
+          FST
+          (APPLY
+           (CALL
+            "LoadMemory" (ATY QTY (PTY F64 QTY))
+            (TP
+             (SQBKT
+                 (VAR "CCA" (FTY 3))
+                 CC (SQBKT (LW 0 1) (VAR "v1" (FTY 2)))
+                 (ITE (MOP FST
+                           (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                                  QVAR))
+                      (VAR "v0" F64)
+                      (BOP BAND (VAR "v0" F64)
+                           (MOP BNOT (LW 7 64))))
+                 (VAR "v" F64)
+                 (LC "DATA" (CTY "IorD")))))
+           QVAR))
+         (LET
+          (TP (SQBKT (VAR "v" F32) QVAR))
+          (CS
+           (TP
+             (SQBKT
+                  (BOP BXOR (EX (VAR "v" F64) (LN 2) (LN 2) F1)
+                       (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR)))
+                  (VAR "v1" (FTY 2))))
+           (SQBKT
+            ((TP (SQBKT (LW 0 1) (LW 0 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64) (LN 7) (LN 0) F8)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 23)
+                                 (LN 0)
+                                 (FTY 24)))
+                      QVAR)))
+            ((TP (SQBKT (LW 0 1) (LW 1 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64) (LN 15) (LN 0) F16)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 15)
+                                 (LN 0)
+                                 F16))
+                      QVAR)))
+            ((TP (SQBKT (LW 0 1) (LW 2 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64)
+                                 (LN 23)
+                                 (LN 0)
+                                 (FTY 24))
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 7)
+                                 (LN 0)
+                                 F8))
+                      QVAR)))
+            ((TP (SQBKT (LW 0 1) (LW 3 2)))
+             (TP (SQBKT (EX (VAR "v2" F64) (LN 31) (LN 0) F32)
+                        QVAR)))
+            ((TP (SQBKT (LW 1 1) (LW 0 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64) (LN 39) (LN 32) F8)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 23)
+                                 (LN 0)
+                                 (FTY 24)))
+                      QVAR)))
+            ((TP (SQBKT (LW 1 1) (LW 1 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64) (LN 47) (LN 32) F16)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 15)
+                                 (LN 0)
+                                 F16))
+                      QVAR)))
+            ((TP (SQBKT (LW 1 1) (LW 2 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64)
+                                 (LN 55)
+                                 (LN 32)
+                                 (FTY 24))
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 7)
+                                 (LN 0)
+                                 F8))
+                      QVAR)))
+            ((TP (SQBKT (LW 1 1) (LW 3 2)))
+             (TP (SQBKT (EX (VAR "v2" F64) (LN 63) (LN 32) F32)
+                        QVAR)))))
+          (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                       (TP (SQBKT (MOP (SE F64) (VAR "v" F32))
+                                  (VAR "rt" (FTY 5)))))
+                 QVAR)))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'LWR"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "LOAD" (CTY "LorS")))))
+      (LET
+       (VAR "v0" F64)
+       (CC
+        (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3)))))
+       (LET
+        (VAR "v1" (FTY 2))
+        (BOP BXOR
+             (EX (VAR "v" F64) (LN 1) (LN 0) (FTY 2))
+             (BOP REP
+                  (MOP FST
+                       (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                              QVAR))
+                  (LN 2)))
+        (LET
+         (VAR "v2" F64)
+         (MOP
+          FST
+          (APPLY
+           (CALL
+            "LoadMemory" (ATY QTY (PTY F64 QTY))
+            (TP
+             (SQBKT
+                 (VAR "CCA" (FTY 3))
+                 (BOP SUB (CONST "WORD" (FTY 3))
+                      (CC (SQBKT (LW 0 1) (VAR "v1" (FTY 2)))))
+                 (ITE (MOP FST
+                           (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                                  QVAR))
+                      (VAR "v0" F64)
+                      (BOP BAND (VAR "v0" F64)
+                           (MOP BNOT (LW 7 64))))
+                 (VAR "v" F64)
+                 (LC "DATA" (CTY "IorD")))))
+           QVAR))
+         (LET
+          (TP (SQBKT (VAR "v" F32) QVAR))
+          (CS
+           (TP
+             (SQBKT
+                  (BOP BXOR (EX (VAR "v" F64) (LN 2) (LN 2) F1)
+                       (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR)))
+                  (VAR "v1" (FTY 2))))
+           (SQBKT
+            ((TP (SQBKT (LW 0 1) (LW 0 2)))
+             (TP (SQBKT (EX (VAR "v2" F64) (LN 31) (LN 0) F32)
+                        QVAR)))
+            ((TP (SQBKT (LW 0 1) (LW 1 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 24)
+                                 F8)
+                             (EX (VAR "v2" F64)
+                                 (LN 31)
+                                 (LN 8)
+                                 (FTY 24)))
+                      QVAR)))
+            ((TP (SQBKT (LW 0 1) (LW 2 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 16)
+                                 F16)
+                             (EX (VAR "v2" F64) (LN 31) (LN 16) F16))
+                      QVAR)))
+            ((TP (SQBKT (LW 0 1) (LW 3 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 8)
+                                 (FTY 24))
+                             (EX (VAR "v2" F64) (LN 31) (LN 24) F8))
+                      QVAR)))
+            ((TP (SQBKT (LW 1 1) (LW 0 2)))
+             (TP (SQBKT (EX (VAR "v2" F64) (LN 63) (LN 32) F32)
+                        QVAR)))
+            ((TP (SQBKT (LW 1 1) (LW 1 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 24)
+                                 F8)
+                             (EX (VAR "v2" F64)
+                                 (LN 63)
+                                 (LN 40)
+                                 (FTY 24)))
+                      QVAR)))
+            ((TP (SQBKT (LW 1 1) (LW 2 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 16)
+                                 F16)
+                             (EX (VAR "v2" F64) (LN 63) (LN 48) F16))
+                      QVAR)))
+            ((TP (SQBKT (LW 1 1) (LW 3 2)))
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 8)
+                                 (FTY 24))
+                             (EX (VAR "v2" F64) (LN 63) (LN 56) F8))
+                      QVAR)))))
+          (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                       (TP (SQBKT (MOP (SE F64) (VAR "v" F32))
+                                  (VAR "rt" (FTY 5)))))
+                 QVAR)))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'LDL"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "LOAD" (CTY "LorS")))))
+      (LET
+       (VAR "v0" F64)
+       (CC
+        (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3)))))
+       (LET
+        (VAR "v1" (FTY 3))
+        (BOP BXOR
+             (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+             (BOP REP
+                  (MOP FST
+                       (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                              QVAR))
+                  (LN 3)))
+        (LET
+         (VAR "v2" F64)
+         (MOP
+          FST
+          (APPLY
+           (CALL
+            "LoadMemory" (ATY QTY (PTY F64 QTY))
+            (TP
+             (SQBKT
+                 (VAR "CCA" (FTY 3))
+                 (VAR "v1" (FTY 3))
+                 (ITE (MOP FST
+                           (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                                  QVAR))
+                      (VAR "v0" F64)
+                      (BOP BAND (VAR "v0" F64)
+                           (MOP BNOT (LW 7 64))))
+                 (VAR "v" F64)
+                 (LC "DATA" (CTY "IorD")))))
+           QVAR))
+         (LET
+          (TP (SQBKT (VAR "v" F64) QVAR))
+          (CS
+           (VAR "v1" (FTY 3))
+           (SQBKT
+            ((LW 0 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64) (LN 7) (LN 0) F8)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 55)
+                                 (LN 0)
+                                 (FTY 56)))
+                      QVAR)))
+            ((LW 1 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64) (LN 15) (LN 0) F16)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 47)
+                                 (LN 0)
+                                 (FTY 48)))
+                      QVAR)))
+            ((LW 2 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64)
+                                 (LN 23)
+                                 (LN 0)
+                                 (FTY 24))
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 39)
+                                 (LN 0)
+                                 (FTY 40)))
+                      QVAR)))
+            ((LW 3 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64) (LN 31) (LN 0) F32)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32))
+                      QVAR)))
+            ((LW 4 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64)
+                                 (LN 39)
+                                 (LN 0)
+                                 (FTY 40))
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 23)
+                                 (LN 0)
+                                 (FTY 24)))
+                      QVAR)))
+            ((LW 5 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64)
+                                 (LN 47)
+                                 (LN 0)
+                                 (FTY 48))
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 15)
+                                 (LN 0)
+                                 F16))
+                      QVAR)))
+            ((LW 6 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (VAR "v2" F64)
+                                 (LN 55)
+                                 (LN 0)
+                                 (FTY 56))
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 7)
+                                 (LN 0)
+                                 F8))
+                      QVAR)))
+            ((LW 7 3)
+             (TP (SQBKT (EX (VAR "v2" F64) (LN 63) (LN 0) F64)
+                        QVAR)))))
+          (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                       (TP (SQBKT (VAR "v" F64)
+                                  (VAR "rt" (FTY 5)))))
+                 QVAR)))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'LDR"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "LOAD" (CTY "LorS")))))
+      (LET
+       (VAR "v0" F64)
+       (CC
+        (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3)))))
+       (LET
+        (VAR "v1" (FTY 3))
+        (BOP BXOR
+             (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+             (BOP REP
+                  (MOP FST
+                       (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                              QVAR))
+                  (LN 3)))
+        (LET
+         (VAR "v2" F64)
+         (MOP
+          FST
+          (APPLY
+           (CALL
+            "LoadMemory" (ATY QTY (PTY F64 QTY))
+            (TP
+             (SQBKT
+                 (VAR "CCA" (FTY 3))
+                 (BOP SUB (CONST "DOUBLEWORD" (FTY 3))
+                      (VAR "v1" (FTY 3)))
+                 (ITE (MOP FST
+                           (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                                  QVAR))
+                      (VAR "v0" F64)
+                      (BOP BAND (VAR "v0" F64)
+                           (MOP BNOT (LW 7 64))))
+                 (VAR "v" F64)
+                 (LC "DATA" (CTY "IorD")))))
+           QVAR))
+         (LET
+          (TP (SQBKT (VAR "v" F64) QVAR))
+          (CS
+           (VAR "v1" (FTY 3))
+           (SQBKT
+            ((LW 0 3)
+             (TP (SQBKT (EX (VAR "v2" F64) (LN 63) (LN 0) F64)
+                        QVAR)))
+            ((LW 1 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 56)
+                                 F8)
+                             (EX (VAR "v2" F64)
+                                 (LN 63)
+                                 (LN 8)
+                                 (FTY 56)))
+                      QVAR)))
+            ((LW 2 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 48)
+                                 F16)
+                             (EX (VAR "v2" F64)
+                                 (LN 63)
+                                 (LN 16)
+                                 (FTY 48)))
+                      QVAR)))
+            ((LW 3 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 40)
+                                 (FTY 24))
+                             (EX (VAR "v2" F64)
+                                 (LN 63)
+                                 (LN 24)
+                                 (FTY 40)))
+                      QVAR)))
+            ((LW 4 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 32)
+                                 F32)
+                             (EX (VAR "v2" F64) (LN 63) (LN 32) F32))
+                      QVAR)))
+            ((LW 5 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 24)
+                                 (FTY 40))
+                             (EX (VAR "v2" F64)
+                                 (LN 63)
+                                 (LN 40)
+                                 (FTY 24)))
+                      QVAR)))
+            ((LW 6 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 16)
+                                 (FTY 48))
+                             (EX (VAR "v2" F64) (LN 63) (LN 48) F16))
+                      QVAR)))
+            ((LW 7 3)
+             (TP
+               (SQBKT CC
+                      (SQBKT (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 8)
+                                 (FTY 56))
+                             (EX (VAR "v2" F64) (LN 63) (LN 56) F8))
+                      QVAR)))))
+          (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                       (TP (SQBKT (VAR "v" F64)
+                                  (VAR "rt" (FTY 5)))))
+                 QVAR)))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SB"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "STORE" (CTY "LorS")))))
+      (APPLY
+       (CALL
+        "StoreMemory" (ATY QTY (PTY UTY QTY))
+        (TP
+         (SQBKT
+          (VAR "CCA" (FTY 3))
+          (CONST "BYTE" (FTY 3))
+          (BOP
+           LSL
+           (MOP FST
+                (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                             (VAR "rt" (FTY 5)))
+                       QVAR))
+           (BOP
+            MUL (LN 8)
+            (MOP
+             (CAST NTY)
+             (BOP BXOR
+                  (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+                  (BOP REP
+                       (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR))
+                       (LN 3))))))
+          CC
+          (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3))))
+          (VAR "v" F64)
+          (LC "DATA" (CTY "IorD")))))
+       QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SH"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (ITE
+      (BOP BIT (VAR "v" F64) (LN 0))
+      (APPLY (CALL "SignalException"
+                   (ATY QTY (PTY UTY QTY))
+                   (LC "AdES" (CTY "ExceptionType")))
+             QVAR)
+      (LET
+       (TP (SQBKT (VAR "pAddr" F64)
+                  (VAR "CCA" (FTY 3))))
+       (CALL "AddressTranslation" (PTY F64 (FTY 3))
+             (TP (SQBKT (VAR "v" F64)
+                        (LC "DATA" (CTY "IorD"))
+                        (LC "STORE" (CTY "LorS")))))
+       (APPLY
+        (CALL
+         "StoreMemory" (ATY QTY (PTY UTY QTY))
+         (TP
+          (SQBKT
+           (VAR "CCA" (FTY 3))
+           (CONST "HALFWORD" (FTY 3))
+           (BOP
+            LSL
+            (MOP FST
+                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                              (VAR "rt" (FTY 5)))
+                        QVAR))
+            (BOP
+             MUL (LN 8)
+             (MOP
+              (CAST NTY)
+              (BOP
+               BXOR
+               (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+               (CC
+                (SQBKT
+                  (BOP REP
+                       (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR))
+                       (LN 2))
+                  (LW 0 1)))))))
+           CC
+           (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP
+             BXOR
+             (EX (VAR "pAddr" F64)
+                 (LN 2)
+                 (LN 0)
+                 (FTY 3))
+             (CC
+              (SQBKT
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 2))
+                 (LW 0 1)))))
+           (VAR "v" F64)
+           (LC "DATA" (CTY "IorD")))))
+        QVAR))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "storeWord"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (ITE
+      (MOP NOT
+           (EQ (EX (VAR "v" F64) (LN 1) (LN 0) (FTY 2))
+               (LW 0 2)))
+      (APPLY (CALL "SignalException"
+                   (ATY QTY (PTY UTY QTY))
+                   (LC "AdES" (CTY "ExceptionType")))
+             QVAR)
+      (LET
+       (TP (SQBKT (VAR "pAddr" F64)
+                  (VAR "CCA" (FTY 3))))
+       (CALL "AddressTranslation" (PTY F64 (FTY 3))
+             (TP (SQBKT (VAR "v" F64)
+                        (LC "DATA" (CTY "IorD"))
+                        (LC "STORE" (CTY "LorS")))))
+       (APPLY
+        (CALL
+         "StoreMemory" (ATY QTY (PTY UTY QTY))
+         (TP
+          (SQBKT
+           (VAR "CCA" (FTY 3))
+           (CONST "WORD" (FTY 3))
+           (BOP
+            LSL
+            (MOP FST
+                 (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                              (VAR "rt" (FTY 5)))
+                        QVAR))
+            (BOP
+             MUL (LN 8)
+             (MOP
+              (CAST NTY)
+              (BOP
+               BXOR
+               (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+               (CC
+                (SQBKT (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR))
+                       (LW 0 2)))))))
+           CC
+           (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP
+             BXOR
+             (EX (VAR "pAddr" F64)
+                 (LN 2)
+                 (LN 0)
+                 (FTY 3))
+             (CC
+               (SQBKT (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LW 0 2)))))
+           (VAR "v" F64)
+           (LC "DATA" (CTY "IorD")))))
+        QVAR))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "storeDoubleword"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (ITE
+      (MOP NOT
+           (EQ (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+               (LW 0 3)))
+      (APPLY (CALL "SignalException"
+                   (ATY QTY (PTY UTY QTY))
+                   (LC "AdES" (CTY "ExceptionType")))
+             QVAR)
+      (LET
+         (TP (SQBKT (VAR "pAddr" F64)
+                    (VAR "CCA" (FTY 3))))
+         (CALL "AddressTranslation" (PTY F64 (FTY 3))
+               (TP (SQBKT (VAR "v" F64)
+                          (LC "DATA" (CTY "IorD"))
+                          (LC "STORE" (CTY "LorS")))))
+         (APPLY (CALL "StoreMemory" (ATY QTY (PTY UTY QTY))
+                      (TP (SQBKT (VAR "CCA" (FTY 3))
+                                 (CONST "DOUBLEWORD" (FTY 3))
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (VAR "pAddr" F64)
+                                 (VAR "v" F64)
+                                 (LC "DATA" (CTY "IorD")))))
+                QVAR))))))))
+
+(DEFUN-STRUCT DFN-SW
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (STOREWORD (TUPLE BASE RT OFFSET) ST$))
+
+(DEFUN-STRUCT DFN-SD
+              (((BASE (UNSIGNED-BYTE-P 5 BASE))
+                (RT (UNSIGNED-BYTE-P 5 RT))
+                (OFFSET (UNSIGNED-BYTE-P 16 OFFSET)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (STOREDOUBLEWORD (TUPLE BASE RT OFFSET)
+                               ST$))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SC"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+        QVAR
+        (CS (DEST "LLbit" (OTY BTY) QVAR)
+            (SQBKT ((LO BTY)
+                    (APPLY (CALL "raise'exception"
+                                 (ATY QTY (PTY UTY QTY))
+                                 (CALL "UNPREDICTABLE" (CTY "exception")
+                                       (LS "SC: LLbit not set")))
+                           QVAR))
+                   ((MOP SOME LF)
+                    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                 (TP (SQBKT (LW 0 64) (VAR "rt" (FTY 5)))))
+                           QVAR))
+                   ((MOP SOME LT)
+                    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                 (TP (SQBKT (LW 1 64) (VAR "rt" (FTY 5)))))
+                           (MOP SND
+                                (APPLY (CALL "storeWord" (ATY QTY (PTY UTY QTY))
+                                             (TP (SQBKT (VAR "base" (FTY 5))
+                                                        (VAR "rt" (FTY 5))
+                                                        (VAR "offset" F16))))
+                                       QVAR))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+    "dfn'SCD"
+    (TP (SQBKT (VAR "base" (FTY 5))
+               (VAR "rt" (FTY 5))
+               (VAR "offset" F16)))
+    (CLOSE QVAR
+           (CS (DEST "LLbit" (OTY BTY) QVAR)
+               (SQBKT ((LO BTY)
+                       (APPLY (CALL "raise'exception"
+                                    (ATY QTY (PTY UTY QTY))
+                                    (CALL "UNPREDICTABLE" (CTY "exception")
+                                          (LS "SCD: LLbit not set")))
+                              QVAR))
+                      ((MOP SOME LF)
+                       (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                    (TP (SQBKT (LW 0 64) (VAR "rt" (FTY 5)))))
+                              QVAR))
+                      ((MOP SOME LT)
+                       (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                                    (TP (SQBKT (LW 1 64) (VAR "rt" (FTY 5)))))
+                              (MOP SND
+                                   (APPLY (CALL "storeDoubleword"
+                                                (ATY QTY (PTY UTY QTY))
+                                                (TP (SQBKT (VAR "base" (FTY 5))
+                                                           (VAR "rt" (FTY 5))
+                                                           (VAR "offset" F16))))
+                                          QVAR))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SWL"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "STORE" (CTY "LorS")))))
+      (LET
+       (VAR "v0" F64)
+       (CC
+        (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3)))))
+       (LET
+        (VAR "v1" (FTY 2))
+        (BOP BXOR
+             (EX (VAR "v" F64) (LN 1) (LN 0) (FTY 2))
+             (BOP REP
+                  (MOP FST
+                       (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                              QVAR))
+                  (LN 2)))
+        (LET
+         (TP (SQBKT (VAR "v2" F64) QVAR))
+         (CS
+          (VAR "v1" (FTY 2))
+          (SQBKT
+            ((LW 0 2)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 24)
+                                 F8))
+                        QVAR)))
+            ((LW 1 2)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 16)
+                                 F16))
+                        QVAR)))
+            ((LW 2 2)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 8)
+                                 (FTY 24)))
+                        QVAR)))
+            ((LW 3 2)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32))
+                        QVAR)))))
+         (APPLY
+          (CALL
+           "StoreMemory" (ATY QTY (PTY UTY QTY))
+           (TP
+            (SQBKT
+             (VAR "CCA" (FTY 3))
+             (MOP (CAST (FTY 3)) (VAR "v1" (FTY 2)))
+             (ITE
+              (EQ (BOP BXOR (EX (VAR "v" F64) (LN 2) (LN 2) F1)
+                       (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR)))
+                  (LW 1 1))
+              (BOP LSL (VAR "v2" F64) (LN 32))
+              (VAR "v2" F64))
+             (ITE (MOP FST
+                       (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                              QVAR))
+                  (VAR "v0" F64)
+                  (BOP BAND (VAR "v0" F64)
+                       (MOP BNOT (LW 3 64))))
+             (VAR "v" F64)
+             (LC "DATA" (CTY "IorD")))))
+          QVAR))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SWR"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "STORE" (CTY "LorS")))))
+      (LET
+       (VAR "v0" F64)
+       (CC
+        (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3)))))
+       (LET
+        (VAR "v1" (FTY 2))
+        (BOP BXOR
+             (EX (VAR "v" F64) (LN 1) (LN 0) (FTY 2))
+             (BOP REP
+                  (MOP FST
+                       (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                              QVAR))
+                  (LN 2)))
+        (LET
+         (TP (SQBKT (VAR "v2" F64) QVAR))
+         (CS
+          (TP
+           (SQBKT (BOP BXOR (EX (VAR "v" F64) (LN 2) (LN 2) F1)
+                       (MOP FST
+                            (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                   QVAR)))
+                  (VAR "v1" (FTY 2))))
+          (SQBKT
+           ((TP (SQBKT (LW 0 1) (LW 0 2)))
+            (TP (SQBKT (MOP (CAST F64)
+                            (EX (MOP FST
+                                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                  (VAR "rt" (FTY 5)))
+                                            QVAR))
+                                (LN 31)
+                                (LN 0)
+                                F32))
+                       QVAR)))
+           ((TP (SQBKT (LW 0 1) (LW 1 2)))
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 23)
+                                 (LN 0)
+                                 (FTY 24)))
+                        (LN 8))
+                   QVAR)))
+           ((TP (SQBKT (LW 0 1) (LW 2 2)))
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 15)
+                                 (LN 0)
+                                 F16))
+                        (LN 16))
+                   QVAR)))
+           ((TP (SQBKT (LW 0 1) (LW 3 2)))
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 7)
+                                 (LN 0)
+                                 F8))
+                        (LN 24))
+                   QVAR)))
+           ((TP (SQBKT (LW 1 1) (LW 0 2)))
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 31)
+                                 (LN 0)
+                                 F32))
+                        (LN 32))
+                   QVAR)))
+           ((TP (SQBKT (LW 1 1) (LW 1 2)))
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 23)
+                                 (LN 0)
+                                 (FTY 24)))
+                        (LN 40))
+                   QVAR)))
+           ((TP (SQBKT (LW 1 1) (LW 2 2)))
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 15)
+                                 (LN 0)
+                                 F16))
+                        (LN 48))
+                   QVAR)))
+           ((TP (SQBKT (LW 1 1) (LW 3 2)))
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 7)
+                                 (LN 0)
+                                 F8))
+                        (LN 56))
+                   QVAR)))))
+         (APPLY
+          (CALL
+           "StoreMemory" (ATY QTY (PTY UTY QTY))
+           (TP
+            (SQBKT
+                 (VAR "CCA" (FTY 3))
+                 (BOP SUB (CONST "WORD" (FTY 3))
+                      (MOP (CAST (FTY 3)) (VAR "v1" (FTY 2))))
+                 (VAR "v2" F64)
+                 (ITE (MOP FST
+                           (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                                  QVAR))
+                      (VAR "v0" F64)
+                      (BOP BAND (VAR "v0" F64)
+                           (MOP BNOT (LW 3 64))))
+                 (VAR "v" F64)
+                 (LC "DATA" (CTY "IorD")))))
+          QVAR))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SDL"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "STORE" (CTY "LorS")))))
+      (LET
+       (VAR "v0" F64)
+       (CC
+        (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3)))))
+       (LET
+        (VAR "v1" (FTY 3))
+        (BOP BXOR
+             (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+             (BOP REP
+                  (MOP FST
+                       (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                              QVAR))
+                  (LN 3)))
+        (LET
+         (TP (SQBKT (VAR "v2" F64) QVAR))
+         (CS
+          (VAR "v1" (FTY 3))
+          (SQBKT
+            ((LW 0 3)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 56)
+                                 F8))
+                        QVAR)))
+            ((LW 1 3)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 48)
+                                 F16))
+                        QVAR)))
+            ((LW 2 3)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 40)
+                                 (FTY 24)))
+                        QVAR)))
+            ((LW 3 3)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 32)
+                                 F32))
+                        QVAR)))
+            ((LW 4 3)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 24)
+                                 (FTY 40)))
+                        QVAR)))
+            ((LW 5 3)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 16)
+                                 (FTY 48)))
+                        QVAR)))
+            ((LW 6 3)
+             (TP (SQBKT (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 8)
+                                 (FTY 56)))
+                        QVAR)))
+            ((LW 7 3)
+             (TP (SQBKT (MOP FST
+                             (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                          (VAR "rt" (FTY 5)))
+                                    QVAR))
+                        QVAR)))))
+         (APPLY
+          (CALL
+           "StoreMemory" (ATY QTY (PTY UTY QTY))
+           (TP
+            (SQBKT
+                 (VAR "CCA" (FTY 3))
+                 (VAR "v1" (FTY 3))
+                 (VAR "v2" F64)
+                 (ITE (MOP FST
+                           (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                                  QVAR))
+                      (VAR "v0" F64)
+                      (BOP BAND (VAR "v0" F64)
+                           (MOP BNOT (LW 7 64))))
+                 (VAR "v" F64)
+                 (LC "DATA" (CTY "IorD")))))
+          QVAR))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'SDR"
+   (TP (SQBKT (VAR "base" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     (VAR "v" F64)
+     (BOP ADD (MOP (SE F64) (VAR "offset" F16))
+          (MOP FST
+               (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                            (VAR "base" (FTY 5)))
+                      QVAR)))
+     (LET
+      (TP (SQBKT (VAR "pAddr" F64)
+                 (VAR "CCA" (FTY 3))))
+      (CALL "AddressTranslation" (PTY F64 (FTY 3))
+            (TP (SQBKT (VAR "v" F64)
+                       (LC "DATA" (CTY "IorD"))
+                       (LC "STORE" (CTY "LorS")))))
+      (LET
+       (VAR "v0" F64)
+       (CC
+        (SQBKT
+            (EX (VAR "pAddr" F64)
+                (BOP SUB (CONST "PSIZE" NTY) (LN 1))
+                (LN 3)
+                (FTY 61))
+            (BOP BXOR
+                 (EX (VAR "pAddr" F64)
+                     (LN 2)
+                     (LN 0)
+                     (FTY 3))
+                 (BOP REP
+                      (MOP FST
+                           (APPLY (CONST "ReverseEndian" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LN 3)))))
+       (LET
+        (VAR "v1" (FTY 3))
+        (BOP BXOR
+             (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+             (BOP REP
+                  (MOP FST
+                       (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                              QVAR))
+                  (LN 3)))
+        (LET
+         (TP (SQBKT (VAR "v2" F64) QVAR))
+         (CS
+          (VAR "v1" (FTY 3))
+          (SQBKT
+           ((LW 0 3)
+            (TP (SQBKT (MOP FST
+                            (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                         (VAR "rt" (FTY 5)))
+                                   QVAR))
+                       QVAR)))
+           ((LW 1 3)
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 8)
+                                 (FTY 56)))
+                        (LN 8))
+                   QVAR)))
+           ((LW 2 3)
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 16)
+                                 (FTY 48)))
+                        (LN 16))
+                   QVAR)))
+           ((LW 3 3)
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 24)
+                                 (FTY 40)))
+                        (LN 24))
+                   QVAR)))
+           ((LW 4 3)
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 32)
+                                 F32))
+                        (LN 32))
+                   QVAR)))
+           ((LW 5 3)
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 40)
+                                 (FTY 24)))
+                        (LN 40))
+                   QVAR)))
+           ((LW 6 3)
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 48)
+                                 F16))
+                        (LN 48))
+                   QVAR)))
+           ((LW 7 3)
+            (TP
+              (SQBKT
+                   (BOP LSL
+                        (MOP (CAST F64)
+                             (EX (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 (LN 63)
+                                 (LN 56)
+                                 F8))
+                        (LN 56))
+                   QVAR)))))
+         (APPLY
+          (CALL
+           "StoreMemory" (ATY QTY (PTY UTY QTY))
+           (TP
+            (SQBKT
+                 (VAR "CCA" (FTY 3))
+                 (BOP SUB (CONST "DOUBLEWORD" (FTY 3))
+                      (VAR "v1" (FTY 3)))
+                 (VAR "v2" F64)
+                 (ITE (MOP FST
+                           (APPLY (CONST "BigEndianMem" (ATY QTY (PTY BTY QTY)))
+                                  QVAR))
+                      (VAR "v0" F64)
+                      (BOP BAND (VAR "v0" F64)
+                           (MOP BNOT (LW 7 64))))
+                 (VAR "v" F64)
+                 (LC "DATA" (CTY "IorD")))))
+          QVAR))))))))))
+
+(DEFUN-STRUCT DFN-SYNC
+              ((STYPE (UNSIGNED-BYTE-P 5 STYPE)))
+              (UNIT-VALUE))
+
+(DEFUN-STRUCT DFN-BREAK (ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (SIGNALEXCEPTION 'BP ST$))
+
+(DEFUN-STRUCT DFN-SYSCALL (ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (SIGNALEXCEPTION 'SYS ST$))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'ERET" QVAR
+   (TP
+    (SQBKT
+     LU
+     (RUPD
+      "LLbit"
+      (TP
+       (SQBKT
+        (ITE
+         (DEST "ERL" BTY
+               (DEST "Status" (CTY "StatusRegister")
+                     (DEST "CP0" (CTY "CP0") QVAR)))
+         (LET
+          QVAR
+          (RUPD "PC"
+                (TP (SQBKT QVAR
+                           (DEST "ErrorEPC"
+                                 F64 (DEST "CP0" (CTY "CP0") QVAR)))))
+          (LET
+           (VAR "v" (CTY "CP0"))
+           (DEST "CP0" (CTY "CP0") QVAR)
+           (RUPD
+            "CP0"
+            (TP
+             (SQBKT
+              QVAR
+              (RUPD
+               "Status"
+               (TP (SQBKT (VAR "v" (CTY "CP0"))
+                          (RUPD "ERL"
+                                (TP (SQBKT (DEST "Status" (CTY "StatusRegister")
+                                                 (VAR "v" (CTY "CP0")))
+                                           LF)))))))))))
+         (LET
+          QVAR
+          (RUPD "PC"
+                (TP (SQBKT QVAR
+                           (DEST "EPC"
+                                 F64 (DEST "CP0" (CTY "CP0") QVAR)))))
+          (LET
+           (VAR "v" (CTY "CP0"))
+           (DEST "CP0" (CTY "CP0") QVAR)
+           (RUPD
+            "CP0"
+            (TP
+             (SQBKT
+              QVAR
+              (RUPD
+               "Status"
+               (TP (SQBKT (VAR "v" (CTY "CP0"))
+                          (RUPD "EXL"
+                                (TP (SQBKT (DEST "Status" (CTY "StatusRegister")
+                                                 (VAR "v" (CTY "CP0")))
+                                           LF))))))))))))
+        (MOP SOME LF)))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+    "dfn'MTC0"
+    (TP (SQBKT (VAR "rt" (FTY 5))
+               (VAR "rd" (FTY 5))
+               (VAR "sel" (FTY 3))))
+    (CLOSE
+         QVAR
+         (APPLY (CALL "write'CPR" (ATY QTY (PTY UTY QTY))
+                      (TP (SQBKT (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 LN 0 (VAR "rd" (FTY 5))
+                                 (VAR "sel" (FTY 3)))))
+                QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+    "dfn'DMTC0"
+    (TP (SQBKT (VAR "rt" (FTY 5))
+               (VAR "rd" (FTY 5))
+               (VAR "sel" (FTY 3))))
+    (CLOSE
+         QVAR
+         (APPLY (CALL "write'CPR" (ATY QTY (PTY UTY QTY))
+                      (TP (SQBKT (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rt" (FTY 5)))
+                                             QVAR))
+                                 LN 0 (VAR "rd" (FTY 5))
+                                 (VAR "sel" (FTY 3)))))
+                QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'MFC0"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sel" (FTY 3))))
+   (CLOSE
+    QVAR
+    (APPLY
+     (CALL
+        "write'GPR" (ATY QTY (PTY UTY QTY))
+        (TP (SQBKT (MOP (SE F64)
+                        (EX (MOP FST
+                                 (APPLY (CALL "CPR" (ATY QTY (PTY F64 QTY))
+                                              (TP (SQBKT LN 0 (VAR "rd" (FTY 5))
+                                                         (VAR "sel" (FTY 3)))))
+                                        QVAR))
+                            (LN 32)
+                            (LN 0)
+                            (FTY 33)))
+                   (VAR "rt" (FTY 5)))))
+     QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'DMFC0"
+   (TP (SQBKT (VAR "rt" (FTY 5))
+              (VAR "rd" (FTY 5))
+              (VAR "sel" (FTY 3))))
+   (CLOSE
+    QVAR
+    (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                 (TP (SQBKT (MOP FST
+                                 (APPLY (CALL "CPR" (ATY QTY (PTY F64 QTY))
+                                              (TP (SQBKT LN 0 (VAR "rd" (FTY 5))
+                                                         (VAR "sel" (FTY 3)))))
+                                        QVAR))
+                            (VAR "rt" (FTY 5)))))
+           QVAR)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'J" (VAR "instr_index" (FTY 26))
+   (CLOSE
+        QVAR
+        (TP (SQBKT LU
+                   (RUPD "BranchStatus"
+                         (TP (SQBKT QVAR
+                                    (MOP SOME
+                                         (CC (SQBKT (EX (DEST "PC" F64 QVAR)
+                                                        (LN 63)
+                                                        (LN 28)
+                                                        (FTY 36))
+                                                    (VAR "instr_index" (FTY 26))
+                                                    (LW 0 2)))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'JAL" (VAR "instr_index" (FTY 26))
+   (CLOSE
+    QVAR
+    (LET
+        QVAR
+        (MOP SND
+             (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                          (TP (SQBKT (BOP ADD (DEST "PC" F64 QVAR) (LW 8 64))
+                                     (LW 31 5))))
+                    QVAR))
+        (TP (SQBKT LU
+                   (RUPD "BranchStatus"
+                         (TP (SQBKT QVAR
+                                    (MOP SOME
+                                         (CC (SQBKT (EX (DEST "PC" F64 QVAR)
+                                                        (LN 63)
+                                                        (LN 28)
+                                                        (FTY 36))
+                                                    (VAR "instr_index" (FTY 26))
+                                                    (LW 0 2))))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'JR" (VAR "rs" (FTY 5))
+   (CLOSE
+    QVAR
+    (TP
+      (SQBKT
+           LU
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (MOP FST
+                                      (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                                   (VAR "rs" (FTY 5)))
+                                             QVAR))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'JALR"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rd" (FTY 5))))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (RUPD
+       "BranchStatus"
+       (TP
+        (SQBKT
+           (MOP SND
+                (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                             (TP (SQBKT (BOP ADD (DEST "PC" F64 QVAR) (LW 8 64))
+                                        (VAR "rd" (FTY 5)))))
+                       QVAR))
+           (MOP SOME
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BEQ"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (EQ (MOP FST
+                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                 (VAR "rs" (FTY 5)))
+                           QVAR))
+               (MOP FST
+                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                 (VAR "rt" (FTY 5)))
+                           QVAR)))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BNE"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (MOP NOT
+                (EQ (MOP FST
+                         (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                      (VAR "rs" (FTY 5)))
+                                QVAR))
+                    (MOP FST
+                         (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                      (VAR "rt" (FTY 5)))
+                                QVAR))))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BLEZ"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (BOP LE
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BGTZ"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (BOP GT
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BLTZ"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (BOP LT
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BGEZ"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (BOP GE
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           QVAR)))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BLTZAL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (MOP SND
+          (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                       (TP (SQBKT (BOP ADD (DEST "PC" F64 QVAR) (LW 8 64))
+                                  (LW 31 5))))
+                 QVAR))
+     (TP
+      (SQBKT
+       LU
+       (ITE
+           (BOP LT
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           QVAR))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BGEZAL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (MOP SND
+          (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                       (TP (SQBKT (BOP ADD (DEST "PC" F64 QVAR) (LW 8 64))
+                                  (LW 31 5))))
+                 QVAR))
+     (TP
+      (SQBKT
+       LU
+       (ITE
+           (BOP GE
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           QVAR))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BEQL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (EQ (MOP FST
+                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                 (VAR "rs" (FTY 5)))
+                           QVAR))
+               (MOP FST
+                    (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                 (VAR "rt" (FTY 5)))
+                           QVAR)))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           (RUPD "PC"
+                 (TP (SQBKT QVAR
+                            (BOP ADD (DEST "PC" F64 QVAR)
+                                 (LW 4 64))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BNEL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "rt" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (MOP NOT
+                (EQ (MOP FST
+                         (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                      (VAR "rs" (FTY 5)))
+                                QVAR))
+                    (MOP FST
+                         (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                      (VAR "rt" (FTY 5)))
+                                QVAR))))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           (RUPD "PC"
+                 (TP (SQBKT QVAR
+                            (BOP ADD (DEST "PC" F64 QVAR)
+                                 (LW 4 64))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BLEZL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (BOP LE
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           (RUPD "PC"
+                 (TP (SQBKT QVAR
+                            (BOP ADD (DEST "PC" F64 QVAR)
+                                 (LW 4 64))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BGTZL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (BOP GT
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           (RUPD "PC"
+                 (TP (SQBKT QVAR
+                            (BOP ADD (DEST "PC" F64 QVAR)
+                                 (LW 4 64))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BLTZL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (BOP LT
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           (RUPD "PC"
+                 (TP (SQBKT QVAR
+                            (BOP ADD (DEST "PC" F64 QVAR)
+                                 (LW 4 64))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BGEZL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (TP
+     (SQBKT
+      LU
+      (ITE (BOP GE
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           (RUPD "PC"
+                 (TP (SQBKT QVAR
+                            (BOP ADD (DEST "PC" F64 QVAR)
+                                 (LW 4 64))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BLTZALL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (MOP SND
+          (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                       (TP (SQBKT (BOP ADD (DEST "PC" F64 QVAR) (LW 8 64))
+                                  (LW 31 5))))
+                 QVAR))
+     (TP
+      (SQBKT
+       LU
+       (ITE
+           (BOP LT
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           (RUPD "PC"
+                 (TP (SQBKT QVAR
+                            (BOP ADD (DEST "PC" F64 QVAR)
+                                 (LW 4 64)))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "dfn'BGEZALL"
+   (TP (SQBKT (VAR "rs" (FTY 5))
+              (VAR "offset" F16)))
+   (CLOSE
+    QVAR
+    (LET
+     QVAR
+     (MOP SND
+          (APPLY (CALL "write'GPR" (ATY QTY (PTY UTY QTY))
+                       (TP (SQBKT (BOP ADD (DEST "PC" F64 QVAR) (LW 8 64))
+                                  (LW 31 5))))
+                 QVAR))
+     (TP
+      (SQBKT
+       LU
+       (ITE
+           (BOP GE
+                (MOP FST
+                     (APPLY (CALL "GPR" (ATY QTY (PTY F64 QTY))
+                                  (VAR "rs" (FTY 5)))
+                            QVAR))
+                (LW 0 64))
+           (RUPD "BranchStatus"
+                 (TP (SQBKT QVAR
+                            (MOP SOME
+                                 (BOP ADD (DEST "PC" F64 QVAR)
+                                      (BOP LSL (MOP (SE F64) (VAR "offset" F16))
+                                           (LN 2)))))))
+           (RUPD "PC"
+                 (TP (SQBKT QVAR
+                            (BOP ADD (DEST "PC" F64 QVAR)
+                                 (LW 4 64)))))))))))))
+
+(DEFUN-STRUCT DFN-RESERVEDINSTRUCTION (ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (SIGNALEXCEPTION 'RI ST$))
+
+(DEFUN-STRUCT RUN ((V0 (TYPE-INSTRUCTION V0)) ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (CASE-MATCH+ V0 ('BREAK (DFN-BREAK ST$))
+                           ('ERET (DFN-ERET ST$))
+                           ('RESERVEDINSTRUCTION
+                            (DFN-RESERVEDINSTRUCTION ST$))
+                           ('SYSCALL (DFN-SYSCALL ST$))
+                           (('SYNC V120) (MV (DFN-SYNC V120) ST$))
+                           (('ARITHI V1)
+                            (CASE-MATCH+ V1 (('ADDI V2) (DFN-ADDI V2 ST$))
+                                         (('ADDIU V3) (DFN-ADDIU V3 ST$))
+                                         (('ANDI V4) (DFN-ANDI V4 ST$))
+                                         (('DADDI V5) (DFN-DADDI V5 ST$))
+                                         (('DADDIU V6) (DFN-DADDIU V6 ST$))
+                                         (('LUI V7) (DFN-LUI V7 ST$))
+                                         (('ORI V8) (DFN-ORI V8 ST$))
+                                         (('SLTI V9) (DFN-SLTI V9 ST$))
+                                         (('SLTIU V10) (DFN-SLTIU V10 ST$))
+                                         (('XORI V11) (DFN-XORI V11 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (('ARITHR V12)
+                            (CASE-MATCH+ V12 (('ADD V13) (DFN-ADD V13 ST$))
+                                         (('ADDU V14) (DFN-ADDU V14 ST$))
+                                         (('AND V15) (DFN-AND V15 ST$))
+                                         (('DADD V16) (DFN-DADD V16 ST$))
+                                         (('DADDU V17) (DFN-DADDU V17 ST$))
+                                         (('DSUB V18) (DFN-DSUB V18 ST$))
+                                         (('DSUBU V19) (DFN-DSUBU V19 ST$))
+                                         (('NOR V20) (DFN-NOR V20 ST$))
+                                         (('OR V21) (DFN-OR V21 ST$))
+                                         (('SLT V22) (DFN-SLT V22 ST$))
+                                         (('SLTU V23) (DFN-SLTU V23 ST$))
+                                         (('SUB V24) (DFN-SUB V24 ST$))
+                                         (('SUBU V25) (DFN-SUBU V25 ST$))
+                                         (('XOR V26) (DFN-XOR V26 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (('BRANCH V27)
+                            (CASE-MATCH+ V27 (('BEQ V28) (DFN-BEQ V28 ST$))
+                                         (('BEQL V29) (DFN-BEQL V29 ST$))
+                                         (('BGEZ V30) (DFN-BGEZ V30 ST$))
+                                         (('BGEZAL V31) (DFN-BGEZAL V31 ST$))
+                                         (('BGEZALL V32) (DFN-BGEZALL V32 ST$))
+                                         (('BGEZL V33) (DFN-BGEZL V33 ST$))
+                                         (('BGTZ V34) (DFN-BGTZ V34 ST$))
+                                         (('BGTZL V35) (DFN-BGTZL V35 ST$))
+                                         (('BLEZ V36) (DFN-BLEZ V36 ST$))
+                                         (('BLEZL V37) (DFN-BLEZL V37 ST$))
+                                         (('BLTZ V38) (DFN-BLTZ V38 ST$))
+                                         (('BLTZAL V39) (DFN-BLTZAL V39 ST$))
+                                         (('BLTZALL V40) (DFN-BLTZALL V40 ST$))
+                                         (('BLTZL V41) (DFN-BLTZL V41 ST$))
+                                         (('BNE V42) (DFN-BNE V42 ST$))
+                                         (('BNEL V43) (DFN-BNEL V43 ST$))
+                                         (('J V44) (DFN-J V44 ST$))
+                                         (('JAL V45) (DFN-JAL V45 ST$))
+                                         (('JALR V46) (DFN-JALR V46 ST$))
+                                         (('JR V47) (DFN-JR V47 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (('CP V48)
+                            (CASE-MATCH+ V48 (('DMFC0 V49) (DFN-DMFC0 V49 ST$))
+                                         (('DMTC0 V50) (DFN-DMTC0 V50 ST$))
+                                         (('MFC0 V51) (DFN-MFC0 V51 ST$))
+                                         (('MTC0 V52) (DFN-MTC0 V52 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (('LOAD V53)
+                            (CASE-MATCH+ V53 (('LB V54) (DFN-LB V54 ST$))
+                                         (('LBU V55) (DFN-LBU V55 ST$))
+                                         (('LD V56) (DFN-LD V56 ST$))
+                                         (('LDL V57) (DFN-LDL V57 ST$))
+                                         (('LDR V58) (DFN-LDR V58 ST$))
+                                         (('LH V59) (DFN-LH V59 ST$))
+                                         (('LHU V60) (DFN-LHU V60 ST$))
+                                         (('LL V61) (DFN-LL V61 ST$))
+                                         (('LLD V62) (DFN-LLD V62 ST$))
+                                         (('LW V63) (DFN-LW V63 ST$))
+                                         (('LWL V64) (DFN-LWL V64 ST$))
+                                         (('LWR V65) (DFN-LWR V65 ST$))
+                                         (('LWU V66) (DFN-LWU V66 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (('MULTDIV V67)
+                            (CASE-MATCH+ V67 (('DDIV V68) (DFN-DDIV V68 ST$))
+                                         (('DDIVU V69) (DFN-DDIVU V69 ST$))
+                                         (('DIV V70) (DFN-DIV V70 ST$))
+                                         (('DIVU V71) (DFN-DIVU V71 ST$))
+                                         (('DMULT V72) (DFN-DMULT V72 ST$))
+                                         (('DMULTU V73) (DFN-DMULTU V73 ST$))
+                                         (('MFHI V74) (DFN-MFHI V74 ST$))
+                                         (('MFLO V75) (DFN-MFLO V75 ST$))
+                                         (('MTHI V76) (DFN-MTHI V76 ST$))
+                                         (('MTLO V77) (DFN-MTLO V77 ST$))
+                                         (('MULT V78) (DFN-MULT V78 ST$))
+                                         (('MULTU V79) (DFN-MULTU V79 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (('SHIFT V80)
+                            (CASE-MATCH+ V80 (('DSLL V81) (DFN-DSLL V81 ST$))
+                                         (('DSLL32 V82) (DFN-DSLL32 V82 ST$))
+                                         (('DSLLV V83) (DFN-DSLLV V83 ST$))
+                                         (('DSRA V84) (DFN-DSRA V84 ST$))
+                                         (('DSRA32 V85) (DFN-DSRA32 V85 ST$))
+                                         (('DSRAV V86) (DFN-DSRAV V86 ST$))
+                                         (('DSRL V87) (DFN-DSRL V87 ST$))
+                                         (('DSRL32 V88) (DFN-DSRL32 V88 ST$))
+                                         (('DSRLV V89) (DFN-DSRLV V89 ST$))
+                                         (('SLL V90) (DFN-SLL V90 ST$))
+                                         (('SLLV V91) (DFN-SLLV V91 ST$))
+                                         (('SRA V92) (DFN-SRA V92 ST$))
+                                         (('SRAV V93) (DFN-SRAV V93 ST$))
+                                         (('SRL V94) (DFN-SRL V94 ST$))
+                                         (('SRLV V95) (DFN-SRLV V95 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (('STORE V96)
+                            (CASE-MATCH+ V96 (('SB V97) (DFN-SB V97 ST$))
+                                         (('SC V98) (DFN-SC V98 ST$))
+                                         (('SCD V99) (DFN-SCD V99 ST$))
+                                         (('SD V100) (DFN-SD V100 ST$))
+                                         (('SDL V101) (DFN-SDL V101 ST$))
+                                         (('SDR V102) (DFN-SDR V102 ST$))
+                                         (('SH V103) (DFN-SH V103 ST$))
+                                         (('SW V104) (DFN-SW V104 ST$))
+                                         (('SWL V105) (DFN-SWL V105 ST$))
+                                         (('SWR V106) (DFN-SWR V106 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (('TRAP V107)
+                            (CASE-MATCH+ V107 (('TEQ V108) (DFN-TEQ V108 ST$))
+                                         (('TEQI V109) (DFN-TEQI V109 ST$))
+                                         (('TGE V110) (DFN-TGE V110 ST$))
+                                         (('TGEI V111) (DFN-TGEI V111 ST$))
+                                         (('TGEIU V112) (DFN-TGEIU V112 ST$))
+                                         (('TGEU V113) (DFN-TGEU V113 ST$))
+                                         (('TLT V114) (DFN-TLT V114 ST$))
+                                         (('TLTI V115) (DFN-TLTI V115 ST$))
+                                         (('TLTIU V116) (DFN-TLTIU V116 ST$))
+                                         (('TLTU V117) (DFN-TLTU V117 ST$))
+                                         (('TNE V118) (DFN-TNE V118 ST$))
+                                         (('TNEI V119) (DFN-TNEI V119 ST$))
+                                         (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+                           (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "Decode" (VAR "w" F32)
+   (LET
+    (TP (SQBKT (VAR "b'31" BTY)
+               (VAR "b'30" BTY)
+               (VAR "b'29" BTY)
+               (VAR "b'28" BTY)
+               (VAR "b'27" BTY)
+               (VAR "b'26" BTY)
+               (VAR "b'25" BTY)
+               (VAR "b'24" BTY)
+               (VAR "b'23" BTY)
+               (VAR "b'22" BTY)
+               (VAR "b'21" BTY)
+               (VAR "b'20" BTY)
+               (VAR "b'19" BTY)
+               (VAR "b'18" BTY)
+               (VAR "b'17" BTY)
+               (VAR "b'16" BTY)
+               (VAR "b'15" BTY)
+               (VAR "b'14" BTY)
+               (VAR "b'13" BTY)
+               (VAR "b'12" BTY)
+               (VAR "b'11" BTY)
+               (VAR "b'10" BTY)
+               (VAR "b'9" BTY)
+               (VAR "b'8" BTY)
+               (VAR "b'7" BTY)
+               (VAR "b'6" BTY)
+               (VAR "b'5" BTY)
+               (VAR "b'4" BTY)
+               (VAR "b'3" BTY)
+               (VAR "b'2" BTY)
+               (VAR "b'1" BTY)
+               (VAR "b'0" BTY)))
+    (BL 32 (VAR "w" F32))
+    (ITE
+     (BOP AND (MOP NOT (VAR "b'31" BTY))
+          (BOP AND (MOP NOT (VAR "b'29" BTY))
+               (MOP NOT (VAR "b'28" BTY))))
+     (ITB
+      (SQBKT
+       ((BOP AND (MOP NOT (VAR "b'30" BTY))
+             (BOP AND (MOP NOT (VAR "b'27" BTY))
+                  (MOP NOT (VAR "b'26" BTY))))
+        (LET
+         (VAR "rt" (FTY 5))
+         (EX (VAR "w" F32)
+             (LN 20)
+             (LN 16)
+             (FTY 5))
+         (LET
+          (VAR "rs" (FTY 5))
+          (EX (VAR "w" F32)
+              (LN 25)
+              (LN 21)
+              (FTY 5))
+          (LET
+           (VAR "rd" (FTY 5))
+           (EX (VAR "w" F32)
+               (LN 15)
+               (LN 11)
+               (FTY 5))
+           (LET
+            (VAR "imm5" (FTY 5))
+            (EX (VAR "w" F32)
+                (LN 10)
+                (LN 6)
+                (FTY 5))
+            (LET
+             (TP (SQBKT (VAR "b'5" BTY)
+                        (VAR "b'4" BTY)
+                        (VAR "b'3" BTY)
+                        (VAR "b'2" BTY)
+                        (VAR "b'1" BTY)
+                        (VAR "b'0" BTY)))
+             (BL 6
+                 (EX (VAR "w" F32)
+                     (LN 5)
+                     (LN 0)
+                     (FTY 6)))
+             (ITB
+              (SQBKT
+               ((VAR "b'5" BTY)
+                (ITB
+                 (SQBKT
+                  ((VAR "b'2" BTY)
+                   (ITB
+                    (SQBKT
+                     ((VAR "b'3" BTY)
+                      (ITB
+                       (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                         (MOP NOT (VAR "b'0" BTY))))
+                               (CALL "ArithR" (CTY "instruction")
+                                     (CALL "DADD" (CTY "ArithR")
+                                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                                      (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5)))))))
+                              ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                         (VAR "b'0" BTY)))
+                               (CALL "ArithR" (CTY "instruction")
+                                     (CALL "DADDU" (CTY "ArithR")
+                                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                                      (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5)))))))
+                              ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                    (BOP AND (VAR "b'1" BTY)
+                                         (MOP NOT (VAR "b'0" BTY))))
+                               (CALL "ArithR" (CTY "instruction")
+                                     (CALL "DSUB" (CTY "ArithR")
+                                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                                      (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5)))))))
+                              ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                    (BOP AND (VAR "b'1" BTY)
+                                         (VAR "b'0" BTY)))
+                               (CALL "ArithR" (CTY "instruction")
+                                     (CALL "DSUBU" (CTY "ArithR")
+                                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                                      (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5)))))))
+                              ((BOP AND (VAR "b'4" BTY)
+                                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                         (MOP NOT (VAR "b'0" BTY))))
+                               (CALL "Shift" (CTY "instruction")
+                                     (CALL "DSLL32" (CTY "Shift")
+                                           (TP (SQBKT (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5))
+                                                      (VAR "imm5" (FTY 5)))))))
+                              ((BOP AND (VAR "b'4" BTY)
+                                    (BOP AND (VAR "b'1" BTY)
+                                         (MOP NOT (VAR "b'0" BTY))))
+                               (CALL "Shift" (CTY "instruction")
+                                     (CALL "DSRL32" (CTY "Shift")
+                                           (TP (SQBKT (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5))
+                                                      (VAR "imm5" (FTY 5)))))))
+                              ((BOP AND (VAR "b'4" BTY)
+                                    (BOP AND (VAR "b'1" BTY)
+                                         (VAR "b'0" BTY)))
+                               (CALL "Shift" (CTY "instruction")
+                                     (CALL "DSRA32" (CTY "Shift")
+                                           (TP (SQBKT (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5))
+                                                      (VAR "imm5" (FTY 5))))))))
+                       (CONST "ReservedInstruction"
+                              (CTY "instruction"))))
+                     ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                           (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                (MOP NOT (VAR "b'0" BTY))))
+                      (CALL "ArithR" (CTY "instruction")
+                            (CALL "AND" (CTY "ArithR")
+                                  (TP (SQBKT (VAR "rs" (FTY 5))
+                                             (VAR "rt" (FTY 5))
+                                             (VAR "rd" (FTY 5)))))))
+                     ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                           (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                (VAR "b'0" BTY)))
+                      (CALL "ArithR" (CTY "instruction")
+                            (CALL "OR" (CTY "ArithR")
+                                  (TP (SQBKT (VAR "rs" (FTY 5))
+                                             (VAR "rt" (FTY 5))
+                                             (VAR "rd" (FTY 5)))))))
+                     ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                           (BOP AND (VAR "b'1" BTY)
+                                (MOP NOT (VAR "b'0" BTY))))
+                      (CALL "ArithR" (CTY "instruction")
+                            (CALL "XOR" (CTY "ArithR")
+                                  (TP (SQBKT (VAR "rs" (FTY 5))
+                                             (VAR "rt" (FTY 5))
+                                             (VAR "rd" (FTY 5)))))))
+                     ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                           (BOP AND (VAR "b'1" BTY)
+                                (VAR "b'0" BTY)))
+                      (CALL "ArithR" (CTY "instruction")
+                            (CALL "NOR" (CTY "ArithR")
+                                  (TP (SQBKT (VAR "rs" (FTY 5))
+                                             (VAR "rt" (FTY 5))
+                                             (VAR "rd" (FTY 5)))))))
+                     ((BOP AND (VAR "b'4" BTY)
+                           (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                (MOP NOT (VAR "b'0" BTY))))
+                      (CALL "Trap" (CTY "instruction")
+                            (CALL "TEQ" (CTY "Trap")
+                                  (TP (SQBKT (VAR "rs" (FTY 5))
+                                             (VAR "rt" (FTY 5)))))))
+                     ((BOP AND (VAR "b'4" BTY)
+                           (BOP AND (VAR "b'1" BTY)
+                                (MOP NOT (VAR "b'0" BTY))))
+                      (CALL "Trap" (CTY "instruction")
+                            (CALL "TNE" (CTY "Trap")
+                                  (TP (SQBKT (VAR "rs" (FTY 5))
+                                             (VAR "rt" (FTY 5))))))))
+                    (CONST "ReservedInstruction"
+                           (CTY "instruction"))))
+                  ((VAR "b'4" BTY)
+                   (ITB
+                       (SQBKT ((BOP AND (MOP NOT (VAR "b'3" BTY))
+                                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                         (MOP NOT (VAR "b'0" BTY))))
+                               (CALL "Trap" (CTY "instruction")
+                                     (CALL "TGE" (CTY "Trap")
+                                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                                      (VAR "rt" (FTY 5)))))))
+                              ((BOP AND (MOP NOT (VAR "b'3" BTY))
+                                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                         (VAR "b'0" BTY)))
+                               (CALL "Trap" (CTY "instruction")
+                                     (CALL "TGEU" (CTY "Trap")
+                                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                                      (VAR "rt" (FTY 5)))))))
+                              ((BOP AND (MOP NOT (VAR "b'3" BTY))
+                                    (BOP AND (VAR "b'1" BTY)
+                                         (MOP NOT (VAR "b'0" BTY))))
+                               (CALL "Trap" (CTY "instruction")
+                                     (CALL "TLT" (CTY "Trap")
+                                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                                      (VAR "rt" (FTY 5)))))))
+                              ((BOP AND (MOP NOT (VAR "b'3" BTY))
+                                    (BOP AND (VAR "b'1" BTY)
+                                         (VAR "b'0" BTY)))
+                               (CALL "Trap" (CTY "instruction")
+                                     (CALL "TLTU" (CTY "Trap")
+                                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                                      (VAR "rt" (FTY 5)))))))
+                              ((BOP AND (VAR "b'3" BTY)
+                                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                         (MOP NOT (VAR "b'0" BTY))))
+                               (CALL "Shift" (CTY "instruction")
+                                     (CALL "DSLL" (CTY "Shift")
+                                           (TP (SQBKT (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5))
+                                                      (VAR "imm5" (FTY 5)))))))
+                              ((BOP AND (VAR "b'3" BTY)
+                                    (BOP AND (VAR "b'1" BTY)
+                                         (MOP NOT (VAR "b'0" BTY))))
+                               (CALL "Shift" (CTY "instruction")
+                                     (CALL "DSRL" (CTY "Shift")
+                                           (TP (SQBKT (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5))
+                                                      (VAR "imm5" (FTY 5)))))))
+                              ((BOP AND (VAR "b'3" BTY)
+                                    (BOP AND (VAR "b'1" BTY)
+                                         (VAR "b'0" BTY)))
+                               (CALL "Shift" (CTY "instruction")
+                                     (CALL "DSRA" (CTY "Shift")
+                                           (TP (SQBKT (VAR "rt" (FTY 5))
+                                                      (VAR "rd" (FTY 5))
+                                                      (VAR "imm5" (FTY 5))))))))
+                       (CONST "ReservedInstruction"
+                              (CTY "instruction"))))
+                  ((BOP AND (MOP NOT (VAR "b'3" BTY))
+                        (BOP AND (MOP NOT (VAR "b'1" BTY))
+                             (MOP NOT (VAR "b'0" BTY))))
+                   (CALL "ArithR" (CTY "instruction")
+                         (CALL "ADD" (CTY "ArithR")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "rd" (FTY 5)))))))
+                  ((BOP AND (MOP NOT (VAR "b'3" BTY))
+                        (BOP AND (MOP NOT (VAR "b'1" BTY))
+                             (VAR "b'0" BTY)))
+                   (CALL "ArithR" (CTY "instruction")
+                         (CALL "ADDU" (CTY "ArithR")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "rd" (FTY 5)))))))
+                  ((BOP AND (MOP NOT (VAR "b'3" BTY))
+                        (BOP AND (VAR "b'1" BTY)
+                             (MOP NOT (VAR "b'0" BTY))))
+                   (CALL "ArithR" (CTY "instruction")
+                         (CALL "SUB" (CTY "ArithR")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "rd" (FTY 5)))))))
+                  ((BOP AND (MOP NOT (VAR "b'3" BTY))
+                        (BOP AND (VAR "b'1" BTY)
+                             (VAR "b'0" BTY)))
+                   (CALL "ArithR" (CTY "instruction")
+                         (CALL "SUBU" (CTY "ArithR")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "rd" (FTY 5)))))))
+                  ((BOP AND (VAR "b'3" BTY)
+                        (BOP AND (VAR "b'1" BTY)
+                             (MOP NOT (VAR "b'0" BTY))))
+                   (CALL "ArithR" (CTY "instruction")
+                         (CALL "SLT" (CTY "ArithR")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "rd" (FTY 5)))))))
+                  ((BOP AND (VAR "b'3" BTY)
+                        (BOP AND (VAR "b'1" BTY)
+                             (VAR "b'0" BTY)))
+                   (CALL "ArithR" (CTY "instruction")
+                         (CALL "SLTU" (CTY "ArithR")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "rd" (FTY 5))))))))
+                 (CONST "ReservedInstruction"
+                        (CTY "instruction"))))
+               ((VAR "b'3" BTY)
+                (ITB
+                 (SQBKT
+                   ((VAR "b'2" BTY)
+                    (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                      (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                           (MOP NOT (VAR "b'0" BTY))))
+                                 (CONST "SYSCALL" (CTY "instruction")))
+                                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                      (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                           (VAR "b'0" BTY)))
+                                 (CONST "BREAK" (CTY "instruction")))
+                                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                      (BOP AND (VAR "b'1" BTY)
+                                           (VAR "b'0" BTY)))
+                                 (CALL "SYNC" (CTY "instruction")
+                                       (VAR "imm5" (FTY 5))))
+                                ((BOP AND (VAR "b'4" BTY)
+                                      (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                           (MOP NOT (VAR "b'0" BTY))))
+                                 (CALL "MultDiv" (CTY "instruction")
+                                       (CALL "DMULT" (CTY "MultDiv")
+                                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                                        (VAR "rt" (FTY 5)))))))
+                                ((BOP AND (VAR "b'4" BTY)
+                                      (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                           (VAR "b'0" BTY)))
+                                 (CALL "MultDiv" (CTY "instruction")
+                                       (CALL "DMULTU" (CTY "MultDiv")
+                                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                                        (VAR "rt" (FTY 5)))))))
+                                ((BOP AND (VAR "b'4" BTY)
+                                      (BOP AND (VAR "b'1" BTY)
+                                           (MOP NOT (VAR "b'0" BTY))))
+                                 (CALL "MultDiv" (CTY "instruction")
+                                       (CALL "DDIV" (CTY "MultDiv")
+                                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                                        (VAR "rt" (FTY 5)))))))
+                                ((BOP AND (VAR "b'4" BTY)
+                                      (BOP AND (VAR "b'1" BTY)
+                                           (VAR "b'0" BTY)))
+                                 (CALL "MultDiv" (CTY "instruction")
+                                       (CALL "DDIVU" (CTY "MultDiv")
+                                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                                        (VAR "rt" (FTY 5))))))))
+                         (CONST "ReservedInstruction"
+                                (CTY "instruction"))))
+                   ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                         (BOP AND (MOP NOT (VAR "b'1" BTY))
+                              (MOP NOT (VAR "b'0" BTY))))
+                    (CALL "Branch" (CTY "instruction")
+                          (CALL "JR" (CTY "Branch")
+                                (VAR "rs" (FTY 5)))))
+                   ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                         (BOP AND (MOP NOT (VAR "b'1" BTY))
+                              (VAR "b'0" BTY)))
+                    (CALL "Branch" (CTY "instruction")
+                          (CALL "JALR" (CTY "Branch")
+                                (TP (SQBKT (VAR "rs" (FTY 5))
+                                           (VAR "rd" (FTY 5)))))))
+                   ((BOP AND (VAR "b'4" BTY)
+                         (BOP AND (MOP NOT (VAR "b'1" BTY))
+                              (MOP NOT (VAR "b'0" BTY))))
+                    (CALL "MultDiv" (CTY "instruction")
+                          (CALL "MULT" (CTY "MultDiv")
+                                (TP (SQBKT (VAR "rs" (FTY 5))
+                                           (VAR "rt" (FTY 5)))))))
+                   ((BOP AND (VAR "b'4" BTY)
+                         (BOP AND (MOP NOT (VAR "b'1" BTY))
+                              (VAR "b'0" BTY)))
+                    (CALL "MultDiv" (CTY "instruction")
+                          (CALL "MULTU" (CTY "MultDiv")
+                                (TP (SQBKT (VAR "rs" (FTY 5))
+                                           (VAR "rt" (FTY 5)))))))
+                   ((BOP AND (VAR "b'4" BTY)
+                         (BOP AND (VAR "b'1" BTY)
+                              (MOP NOT (VAR "b'0" BTY))))
+                    (CALL "MultDiv" (CTY "instruction")
+                          (CALL "DIV" (CTY "MultDiv")
+                                (TP (SQBKT (VAR "rs" (FTY 5))
+                                           (VAR "rt" (FTY 5)))))))
+                   ((BOP AND (VAR "b'4" BTY)
+                         (BOP AND (VAR "b'1" BTY)
+                              (VAR "b'0" BTY)))
+                    (CALL "MultDiv" (CTY "instruction")
+                          (CALL "DIVU" (CTY "MultDiv")
+                                (TP (SQBKT (VAR "rs" (FTY 5))
+                                           (VAR "rt" (FTY 5))))))))
+                 (CONST "ReservedInstruction"
+                        (CTY "instruction"))))
+               ((VAR "b'4" BTY)
+                (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                                  (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                       (MOP NOT (VAR "b'0" BTY))))
+                             (CALL "MultDiv" (CTY "instruction")
+                                   (CALL "MFHI" (CTY "MultDiv")
+                                         (VAR "rd" (FTY 5)))))
+                            ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                                  (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                       (VAR "b'0" BTY)))
+                             (CALL "MultDiv" (CTY "instruction")
+                                   (CALL "MTHI" (CTY "MultDiv")
+                                         (VAR "rd" (FTY 5)))))
+                            ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                                  (BOP AND (VAR "b'1" BTY)
+                                       (MOP NOT (VAR "b'0" BTY))))
+                             (CALL "MultDiv" (CTY "instruction")
+                                   (CALL "MFLO" (CTY "MultDiv")
+                                         (VAR "rs" (FTY 5)))))
+                            ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                                  (BOP AND (VAR "b'1" BTY)
+                                       (VAR "b'0" BTY)))
+                             (CALL "MultDiv" (CTY "instruction")
+                                   (CALL "MTLO" (CTY "MultDiv")
+                                         (VAR "rs" (FTY 5)))))
+                            ((BOP AND (VAR "b'2" BTY)
+                                  (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                       (MOP NOT (VAR "b'0" BTY))))
+                             (CALL "Shift" (CTY "instruction")
+                                   (CALL "DSLLV" (CTY "Shift")
+                                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                                    (VAR "rt" (FTY 5))
+                                                    (VAR "rd" (FTY 5)))))))
+                            ((BOP AND (VAR "b'2" BTY)
+                                  (BOP AND (VAR "b'1" BTY)
+                                       (MOP NOT (VAR "b'0" BTY))))
+                             (CALL "Shift" (CTY "instruction")
+                                   (CALL "DSRLV" (CTY "Shift")
+                                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                                    (VAR "rt" (FTY 5))
+                                                    (VAR "rd" (FTY 5)))))))
+                            ((BOP AND (VAR "b'2" BTY)
+                                  (BOP AND (VAR "b'1" BTY)
+                                       (VAR "b'0" BTY)))
+                             (CALL "Shift" (CTY "instruction")
+                                   (CALL "DSRAV" (CTY "Shift")
+                                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                                    (VAR "rt" (FTY 5))
+                                                    (VAR "rd" (FTY 5))))))))
+                     (CONST "ReservedInstruction"
+                            (CTY "instruction"))))
+               ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                     (BOP AND (MOP NOT (VAR "b'1" BTY))
+                          (MOP NOT (VAR "b'0" BTY))))
+                (CALL "Shift" (CTY "instruction")
+                      (CALL "SLL" (CTY "Shift")
+                            (TP (SQBKT (VAR "rt" (FTY 5))
+                                       (VAR "rd" (FTY 5))
+                                       (VAR "imm5" (FTY 5)))))))
+               ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                     (BOP AND (VAR "b'1" BTY)
+                          (MOP NOT (VAR "b'0" BTY))))
+                (CALL "Shift" (CTY "instruction")
+                      (CALL "SRL" (CTY "Shift")
+                            (TP (SQBKT (VAR "rt" (FTY 5))
+                                       (VAR "rd" (FTY 5))
+                                       (VAR "imm5" (FTY 5)))))))
+               ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                     (BOP AND (VAR "b'1" BTY)
+                          (VAR "b'0" BTY)))
+                (CALL "Shift" (CTY "instruction")
+                      (CALL "SRA" (CTY "Shift")
+                            (TP (SQBKT (VAR "rt" (FTY 5))
+                                       (VAR "rd" (FTY 5))
+                                       (VAR "imm5" (FTY 5)))))))
+               ((BOP AND (VAR "b'2" BTY)
+                     (BOP AND (MOP NOT (VAR "b'1" BTY))
+                          (MOP NOT (VAR "b'0" BTY))))
+                (CALL "Shift" (CTY "instruction")
+                      (CALL "SLLV" (CTY "Shift")
+                            (TP (SQBKT (VAR "rs" (FTY 5))
+                                       (VAR "rt" (FTY 5))
+                                       (VAR "rd" (FTY 5)))))))
+               ((BOP AND (VAR "b'2" BTY)
+                     (BOP AND (VAR "b'1" BTY)
+                          (MOP NOT (VAR "b'0" BTY))))
+                (CALL "Shift" (CTY "instruction")
+                      (CALL "SRLV" (CTY "Shift")
+                            (TP (SQBKT (VAR "rs" (FTY 5))
+                                       (VAR "rt" (FTY 5))
+                                       (VAR "rd" (FTY 5)))))))
+               ((BOP AND (VAR "b'2" BTY)
+                     (BOP AND (VAR "b'1" BTY)
+                          (VAR "b'0" BTY)))
+                (CALL "Shift" (CTY "instruction")
+                      (CALL "SRAV" (CTY "Shift")
+                            (TP (SQBKT (VAR "rs" (FTY 5))
+                                       (VAR "rt" (FTY 5))
+                                       (VAR "rd" (FTY 5))))))))
+              (CONST "ReservedInstruction"
+                     (CTY "instruction")))))))))
+       ((BOP AND (MOP NOT (VAR "b'30" BTY))
+             (BOP AND (MOP NOT (VAR "b'27" BTY))
+                  (VAR "b'26" BTY)))
+        (LET
+         (VAR "rs" (FTY 5))
+         (EX (VAR "w" F32)
+             (LN 25)
+             (LN 21)
+             (FTY 5))
+         (LET
+          (VAR "immediate" F16)
+          (EX (VAR "w" F32) (LN 15) (LN 0) F16)
+          (LET
+           (TP (SQBKT (VAR "b'4" BTY)
+                      (VAR "b'3" BTY)
+                      (VAR "b'2" BTY)
+                      (VAR "b'1" BTY)
+                      (VAR "b'0" BTY)))
+           (BL 5
+               (EX (VAR "w" F32)
+                   (LN 20)
+                   (LN 16)
+                   (FTY 5)))
+           (ITB
+            (SQBKT
+                ((VAR "b'1" BTY)
+                 (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                        (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                             (MOP NOT (VAR "b'0" BTY)))))
+                              (CALL "Branch" (CTY "instruction")
+                                    (CALL "BLTZL" (CTY "Branch")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                        (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                             (VAR "b'0" BTY))))
+                              (CALL "Branch" (CTY "instruction")
+                                    (CALL "BGEZL" (CTY "Branch")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                             (MOP NOT (VAR "b'0" BTY)))))
+                              (CALL "Trap" (CTY "instruction")
+                                    (CALL "TLTI" (CTY "Trap")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                             (VAR "b'0" BTY))))
+                              (CALL "Trap" (CTY "instruction")
+                                    (CALL "TLTIU" (CTY "Trap")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (BOP AND (VAR "b'2" BTY)
+                                             (MOP NOT (VAR "b'0" BTY)))))
+                              (CALL "Trap" (CTY "instruction")
+                                    (CALL "TNEI" (CTY "Trap")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                        (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                             (MOP NOT (VAR "b'0" BTY)))))
+                              (CALL "Branch" (CTY "instruction")
+                                    (CALL "BLTZALL" (CTY "Branch")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                        (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                             (VAR "b'0" BTY))))
+                              (CALL "Branch" (CTY "instruction")
+                                    (CALL "BGEZALL" (CTY "Branch")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16)))))))
+                      (CONST "ReservedInstruction"
+                             (CTY "instruction"))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (MOP NOT (VAR "b'3" BTY))
+                           (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                (MOP NOT (VAR "b'0" BTY)))))
+                 (CALL "Branch" (CTY "instruction")
+                       (CALL "BLTZ" (CTY "Branch")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (MOP NOT (VAR "b'3" BTY))
+                           (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                (VAR "b'0" BTY))))
+                 (CALL "Branch" (CTY "instruction")
+                       (CALL "BGEZ" (CTY "Branch")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (VAR "b'3" BTY)
+                           (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                (MOP NOT (VAR "b'0" BTY)))))
+                 (CALL "Trap" (CTY "instruction")
+                       (CALL "TGEI" (CTY "Trap")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (VAR "b'3" BTY)
+                           (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                (VAR "b'0" BTY))))
+                 (CALL "Trap" (CTY "instruction")
+                       (CALL "TGEIU" (CTY "Trap")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (VAR "b'3" BTY)
+                           (BOP AND (VAR "b'2" BTY)
+                                (MOP NOT (VAR "b'0" BTY)))))
+                 (CALL "Trap" (CTY "instruction")
+                       (CALL "TEQI" (CTY "Trap")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (VAR "b'4" BTY)
+                      (BOP AND (MOP NOT (VAR "b'3" BTY))
+                           (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                (MOP NOT (VAR "b'0" BTY)))))
+                 (CALL "Branch" (CTY "instruction")
+                       (CALL "BLTZAL" (CTY "Branch")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (VAR "b'4" BTY)
+                      (BOP AND (MOP NOT (VAR "b'3" BTY))
+                           (BOP AND (MOP NOT (VAR "b'2" BTY))
+                                (VAR "b'0" BTY))))
+                 (CALL "Branch" (CTY "instruction")
+                       (CALL "BGEZAL" (CTY "Branch")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16)))))))
+            (CONST "ReservedInstruction"
+                   (CTY "instruction")))))))
+       ((BOP AND (MOP NOT (VAR "b'30" BTY))
+             (BOP AND (VAR "b'27" BTY)
+                  (MOP NOT (VAR "b'26" BTY))))
+        (CALL "Branch" (CTY "instruction")
+              (CALL "J" (CTY "Branch")
+                    (EX (VAR "w" F32)
+                        (LN 25)
+                        (LN 0)
+                        (FTY 26)))))
+       ((BOP AND (MOP NOT (VAR "b'30" BTY))
+             (BOP AND (VAR "b'27" BTY)
+                  (VAR "b'26" BTY)))
+        (CALL "Branch" (CTY "instruction")
+              (CALL "JAL" (CTY "Branch")
+                    (EX (VAR "w" F32)
+                        (LN 25)
+                        (LN 0)
+                        (FTY 26)))))
+       ((BOP
+         AND (VAR "b'30" BTY)
+         (BOP
+          AND (MOP NOT (VAR "b'27" BTY))
+          (BOP
+           AND (MOP NOT (VAR "b'26" BTY))
+           (BOP
+               AND (MOP NOT (VAR "b'10" BTY))
+               (BOP AND (MOP NOT (VAR "b'9" BTY))
+                    (BOP AND (MOP NOT (VAR "b'8" BTY))
+                         (BOP AND (MOP NOT (VAR "b'7" BTY))
+                              (BOP AND (MOP NOT (VAR "b'6" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'5" BTY))
+                                        (BOP AND (MOP NOT (VAR "b'4" BTY))
+                                             (MOP NOT (VAR "b'3" BTY))))))))))))
+        (LET
+         (VAR "sel" (FTY 3))
+         (EX (VAR "w" F32) (LN 2) (LN 0) (FTY 3))
+         (LET
+          (VAR "rt" (FTY 5))
+          (EX (VAR "w" F32)
+              (LN 20)
+              (LN 16)
+              (FTY 5))
+          (LET
+           (VAR "rd" (FTY 5))
+           (EX (VAR "w" F32)
+               (LN 15)
+               (LN 11)
+               (FTY 5))
+           (LET
+              (TP (SQBKT (VAR "b'4" BTY)
+                         (VAR "b'3" BTY)
+                         (VAR "b'2" BTY)
+                         (VAR "b'1" BTY)
+                         (VAR "b'0" BTY)))
+              (BL 5
+                  (EX (VAR "w" F32)
+                      (LN 25)
+                      (LN 21)
+                      (FTY 5)))
+              (ITE (BOP AND (MOP NOT (VAR "b'4" BTY))
+                        (BOP AND (MOP NOT (VAR "b'3" BTY))
+                             (MOP NOT (VAR "b'1" BTY))))
+                   (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                                     (MOP NOT (VAR "b'0" BTY)))
+                                (CALL "CP" (CTY "instruction")
+                                      (CALL "MFC0" (CTY "CP")
+                                            (TP (SQBKT (VAR "rt" (FTY 5))
+                                                       (VAR "rd" (FTY 5))
+                                                       (VAR "sel" (FTY 3)))))))
+                               ((BOP AND (MOP NOT (VAR "b'2" BTY))
+                                     (VAR "b'0" BTY))
+                                (CALL "CP" (CTY "instruction")
+                                      (CALL "DMFC0" (CTY "CP")
+                                            (TP (SQBKT (VAR "rt" (FTY 5))
+                                                       (VAR "rd" (FTY 5))
+                                                       (VAR "sel" (FTY 3)))))))
+                               ((BOP AND (VAR "b'2" BTY)
+                                     (MOP NOT (VAR "b'0" BTY)))
+                                (CALL "CP" (CTY "instruction")
+                                      (CALL "MTC0" (CTY "CP")
+                                            (TP (SQBKT (VAR "rt" (FTY 5))
+                                                       (VAR "rd" (FTY 5))
+                                                       (VAR "sel" (FTY 3)))))))
+                               ((BOP AND (VAR "b'2" BTY)
+                                     (VAR "b'0" BTY))
+                                (CALL "CP" (CTY "instruction")
+                                      (CALL "DMTC0" (CTY "CP")
+                                            (TP (SQBKT (VAR "rt" (FTY 5))
+                                                       (VAR "rd" (FTY 5))
+                                                       (VAR "sel" (FTY 3))))))))
+                        (CONST "ReservedInstruction"
+                               (CTY "instruction")))
+                   (CONST "ReservedInstruction"
+                          (CTY "instruction")))))))))
+      (LET
+       (VAR "rt" (FTY 5))
+       (EX (VAR "w" F32)
+           (LN 20)
+           (LN 16)
+           (FTY 5))
+       (LET
+        (VAR "rs" (FTY 5))
+        (EX (VAR "w" F32)
+            (LN 25)
+            (LN 21)
+            (FTY 5))
+        (LET
+         (VAR "immediate" F16)
+         (EX (VAR "w" F32) (LN 15) (LN 0) F16)
+         (LET
+          (TP (SQBKT (VAR "b'5" BTY)
+                     (VAR "b'4" BTY)
+                     (VAR "b'3" BTY)
+                     (VAR "b'2" BTY)
+                     (VAR "b'1" BTY)
+                     (VAR "b'0" BTY)))
+          (BL 6
+              (EX (VAR "w" F32)
+                  (LN 31)
+                  (LN 26)
+                  (FTY 6)))
+          (ITB
+           (SQBKT
+            ((VAR "b'5" BTY)
+             (ITB
+              (SQBKT
+               ((VAR "b'2" BTY)
+                (ITB
+                 (SQBKT
+                  ((VAR "b'3" BTY)
+                   (ITB
+                      (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                        (MOP NOT (VAR "b'0" BTY))))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SDL" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                        (VAR "b'0" BTY)))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SDR" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'1" BTY)
+                                        (MOP NOT (VAR "b'0" BTY))))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SWR" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                        (MOP NOT (VAR "b'0" BTY))))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SCD" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (VAR "b'1" BTY)
+                                        (VAR "b'0" BTY)))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SD" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16)))))))
+                      (CONST "ReservedInstruction"
+                             (CTY "instruction"))))
+                  ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                        (BOP AND (MOP NOT (VAR "b'1" BTY))
+                             (MOP NOT (VAR "b'0" BTY))))
+                   (CALL "Load" (CTY "instruction")
+                         (CALL "LBU" (CTY "Load")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "immediate" F16))))))
+                  ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                        (BOP AND (MOP NOT (VAR "b'1" BTY))
+                             (VAR "b'0" BTY)))
+                   (CALL "Load" (CTY "instruction")
+                         (CALL "LHU" (CTY "Load")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "immediate" F16))))))
+                  ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                        (BOP AND (VAR "b'1" BTY)
+                             (MOP NOT (VAR "b'0" BTY))))
+                   (CALL "Load" (CTY "instruction")
+                         (CALL "LWR" (CTY "Load")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "immediate" F16))))))
+                  ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                        (BOP AND (VAR "b'1" BTY)
+                             (VAR "b'0" BTY)))
+                   (CALL "Load" (CTY "instruction")
+                         (CALL "LWU" (CTY "Load")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "immediate" F16))))))
+                  ((BOP AND (VAR "b'4" BTY)
+                        (BOP AND (MOP NOT (VAR "b'1" BTY))
+                             (MOP NOT (VAR "b'0" BTY))))
+                   (CALL "Load" (CTY "instruction")
+                         (CALL "LLD" (CTY "Load")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "immediate" F16))))))
+                  ((BOP AND (VAR "b'4" BTY)
+                        (BOP AND (VAR "b'1" BTY)
+                             (VAR "b'0" BTY)))
+                   (CALL "Load" (CTY "instruction")
+                         (CALL "LD" (CTY "Load")
+                               (TP (SQBKT (VAR "rs" (FTY 5))
+                                          (VAR "rt" (FTY 5))
+                                          (VAR "immediate" F16)))))))
+                 (CONST "ReservedInstruction"
+                        (CTY "instruction"))))
+               ((VAR "b'3" BTY)
+                (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                  (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                       (MOP NOT (VAR "b'0" BTY))))
+                             (CALL "Store" (CTY "instruction")
+                                   (CALL "SB" (CTY "Store")
+                                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                                    (VAR "rt" (FTY 5))
+                                                    (VAR "immediate" F16))))))
+                            ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                  (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                       (VAR "b'0" BTY)))
+                             (CALL "Store" (CTY "instruction")
+                                   (CALL "SH" (CTY "Store")
+                                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                                    (VAR "rt" (FTY 5))
+                                                    (VAR "immediate" F16))))))
+                            ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                  (BOP AND (VAR "b'1" BTY)
+                                       (MOP NOT (VAR "b'0" BTY))))
+                             (CALL "Store" (CTY "instruction")
+                                   (CALL "SWL" (CTY "Store")
+                                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                                    (VAR "rt" (FTY 5))
+                                                    (VAR "immediate" F16))))))
+                            ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                  (BOP AND (VAR "b'1" BTY)
+                                       (VAR "b'0" BTY)))
+                             (CALL "Store" (CTY "instruction")
+                                   (CALL "SW" (CTY "Store")
+                                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                                    (VAR "rt" (FTY 5))
+                                                    (VAR "immediate" F16))))))
+                            ((BOP AND (VAR "b'4" BTY)
+                                  (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                       (MOP NOT (VAR "b'0" BTY))))
+                             (CALL "Store" (CTY "instruction")
+                                   (CALL "SC" (CTY "Store")
+                                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                                    (VAR "rt" (FTY 5))
+                                                    (VAR "immediate" F16)))))))
+                     (CONST "ReservedInstruction"
+                            (CTY "instruction"))))
+               ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                     (BOP AND (MOP NOT (VAR "b'1" BTY))
+                          (MOP NOT (VAR "b'0" BTY))))
+                (CALL "Load" (CTY "instruction")
+                      (CALL "LB" (CTY "Load")
+                            (TP (SQBKT (VAR "rs" (FTY 5))
+                                       (VAR "rt" (FTY 5))
+                                       (VAR "immediate" F16))))))
+               ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                     (BOP AND (MOP NOT (VAR "b'1" BTY))
+                          (VAR "b'0" BTY)))
+                (CALL "Load" (CTY "instruction")
+                      (CALL "LH" (CTY "Load")
+                            (TP (SQBKT (VAR "rs" (FTY 5))
+                                       (VAR "rt" (FTY 5))
+                                       (VAR "immediate" F16))))))
+               ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                     (BOP AND (VAR "b'1" BTY)
+                          (MOP NOT (VAR "b'0" BTY))))
+                (CALL "Load" (CTY "instruction")
+                      (CALL "LWL" (CTY "Load")
+                            (TP (SQBKT (VAR "rs" (FTY 5))
+                                       (VAR "rt" (FTY 5))
+                                       (VAR "immediate" F16))))))
+               ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                     (BOP AND (VAR "b'1" BTY)
+                          (VAR "b'0" BTY)))
+                (CALL "Load" (CTY "instruction")
+                      (CALL "LW" (CTY "Load")
+                            (TP (SQBKT (VAR "rs" (FTY 5))
+                                       (VAR "rt" (FTY 5))
+                                       (VAR "immediate" F16))))))
+               ((BOP AND (VAR "b'4" BTY)
+                     (BOP AND (MOP NOT (VAR "b'1" BTY))
+                          (MOP NOT (VAR "b'0" BTY))))
+                (CALL "Load" (CTY "instruction")
+                      (CALL "LL" (CTY "Load")
+                            (TP (SQBKT (VAR "rs" (FTY 5))
+                                       (VAR "rt" (FTY 5))
+                                       (VAR "immediate" F16)))))))
+              (CONST "ReservedInstruction"
+                     (CTY "instruction"))))
+            ((VAR "b'1" BTY)
+             (ITB
+              (SQBKT
+                ((VAR "b'0" BTY)
+                 (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                        (VAR "b'2" BTY)))
+                              (CALL "Branch" (CTY "instruction")
+                                    (CALL "BGTZ" (CTY "Branch")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (MOP NOT (VAR "b'2" BTY))))
+                              (CALL "ArithI" (CTY "instruction")
+                                    (CALL "SLTIU" (CTY "ArithI")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (VAR "b'2" BTY)))
+                              (CALL "ArithI" (CTY "instruction")
+                                    (CALL "LUI" (CTY "ArithI")
+                                          (TP (SQBKT (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                        (VAR "b'2" BTY)))
+                              (CALL "Branch" (CTY "instruction")
+                                    (CALL "BGTZL" (CTY "Branch")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (MOP NOT (VAR "b'2" BTY))))
+                              (CALL "Load" (CTY "instruction")
+                                    (CALL "LDR" (CTY "Load")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16)))))))
+                      (CONST "ReservedInstruction"
+                             (CTY "instruction"))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (MOP NOT (VAR "b'3" BTY))
+                           (VAR "b'2" BTY)))
+                 (CALL "Branch" (CTY "instruction")
+                       (CALL "BLEZ" (CTY "Branch")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (VAR "b'3" BTY)
+                           (MOP NOT (VAR "b'2" BTY))))
+                 (CALL "ArithI" (CTY "instruction")
+                       (CALL "SLTI" (CTY "ArithI")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "rt" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (VAR "b'3" BTY)
+                           (VAR "b'2" BTY)))
+                 (CALL "ArithI" (CTY "instruction")
+                       (CALL "XORI" (CTY "ArithI")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "rt" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (VAR "b'4" BTY)
+                      (BOP AND (MOP NOT (VAR "b'3" BTY))
+                           (VAR "b'2" BTY)))
+                 (CALL "Branch" (CTY "instruction")
+                       (CALL "BLEZL" (CTY "Branch")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (VAR "b'4" BTY)
+                      (BOP AND (VAR "b'3" BTY)
+                           (MOP NOT (VAR "b'2" BTY))))
+                 (CALL "Load" (CTY "instruction")
+                       (CALL "LDL" (CTY "Load")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "rt" (FTY 5))
+                                        (VAR "immediate" F16)))))))
+              (CONST "ReservedInstruction"
+                     (CTY "instruction"))))
+            ((VAR "b'0" BTY)
+             (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                               (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                    (VAR "b'2" BTY)))
+                          (CALL "Branch" (CTY "instruction")
+                                (CALL "BNE" (CTY "Branch")
+                                      (TP (SQBKT (VAR "rs" (FTY 5))
+                                                 (VAR "rt" (FTY 5))
+                                                 (VAR "immediate" F16))))))
+                         ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                               (BOP AND (VAR "b'3" BTY)
+                                    (MOP NOT (VAR "b'2" BTY))))
+                          (CALL "ArithI" (CTY "instruction")
+                                (CALL "ADDIU" (CTY "ArithI")
+                                      (TP (SQBKT (VAR "rs" (FTY 5))
+                                                 (VAR "rt" (FTY 5))
+                                                 (VAR "immediate" F16))))))
+                         ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                               (BOP AND (VAR "b'3" BTY)
+                                    (VAR "b'2" BTY)))
+                          (CALL "ArithI" (CTY "instruction")
+                                (CALL "ORI" (CTY "ArithI")
+                                      (TP (SQBKT (VAR "rs" (FTY 5))
+                                                 (VAR "rt" (FTY 5))
+                                                 (VAR "immediate" F16))))))
+                         ((BOP AND (VAR "b'4" BTY)
+                               (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                    (VAR "b'2" BTY)))
+                          (CALL "Branch" (CTY "instruction")
+                                (CALL "BNEL" (CTY "Branch")
+                                      (TP (SQBKT (VAR "rs" (FTY 5))
+                                                 (VAR "rt" (FTY 5))
+                                                 (VAR "immediate" F16))))))
+                         ((BOP AND (VAR "b'4" BTY)
+                               (BOP AND (VAR "b'3" BTY)
+                                    (MOP NOT (VAR "b'2" BTY))))
+                          (CALL "ArithI" (CTY "instruction")
+                                (CALL "DADDIU" (CTY "ArithI")
+                                      (TP (SQBKT (VAR "rs" (FTY 5))
+                                                 (VAR "rt" (FTY 5))
+                                                 (VAR "immediate" F16)))))))
+                  (CONST "ReservedInstruction"
+                         (CTY "instruction"))))
+            ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                  (BOP AND (MOP NOT (VAR "b'3" BTY))
+                       (VAR "b'2" BTY)))
+             (CALL "Branch" (CTY "instruction")
+                   (CALL "BEQ" (CTY "Branch")
+                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                    (VAR "rt" (FTY 5))
+                                    (VAR "immediate" F16))))))
+            ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                  (BOP AND (VAR "b'3" BTY)
+                       (MOP NOT (VAR "b'2" BTY))))
+             (CALL "ArithI" (CTY "instruction")
+                   (CALL "ADDI" (CTY "ArithI")
+                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                    (VAR "rt" (FTY 5))
+                                    (VAR "immediate" F16))))))
+            ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                  (BOP AND (VAR "b'3" BTY)
+                       (VAR "b'2" BTY)))
+             (CALL "ArithI" (CTY "instruction")
+                   (CALL "ANDI" (CTY "ArithI")
+                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                    (VAR "rt" (FTY 5))
+                                    (VAR "immediate" F16))))))
+            ((BOP AND (VAR "b'4" BTY)
+                  (BOP AND (MOP NOT (VAR "b'3" BTY))
+                       (VAR "b'2" BTY)))
+             (CALL "Branch" (CTY "instruction")
+                   (CALL "BEQL" (CTY "Branch")
+                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                    (VAR "rt" (FTY 5))
+                                    (VAR "immediate" F16))))))
+            ((BOP AND (VAR "b'4" BTY)
+                  (BOP AND (VAR "b'3" BTY)
+                       (MOP NOT (VAR "b'2" BTY))))
+             (CALL "ArithI" (CTY "instruction")
+                   (CALL "DADDI" (CTY "ArithI")
+                         (TP (SQBKT (VAR "rs" (FTY 5))
+                                    (VAR "rt" (FTY 5))
+                                    (VAR "immediate" F16)))))))
+           (CONST "ReservedInstruction"
+                  (CTY "instruction"))))))))
+     (LET
+      (VAR "rt" (FTY 5))
+      (EX (VAR "w" F32)
+          (LN 20)
+          (LN 16)
+          (FTY 5))
+      (LET
+       (VAR "rs" (FTY 5))
+       (EX (VAR "w" F32)
+           (LN 25)
+           (LN 21)
+           (FTY 5))
+       (LET
+        (VAR "immediate" F16)
+        (EX (VAR "w" F32) (LN 15) (LN 0) F16)
+        (LET
+         (TP (SQBKT (VAR "b'5" BTY)
+                    (VAR "b'4" BTY)
+                    (VAR "b'3" BTY)
+                    (VAR "b'2" BTY)
+                    (VAR "b'1" BTY)
+                    (VAR "b'0" BTY)))
+         (BL 6
+             (EX (VAR "w" F32)
+                 (LN 31)
+                 (LN 26)
+                 (FTY 6)))
+         (ITB
+          (SQBKT
+           ((VAR "b'5" BTY)
+            (ITB
+             (SQBKT
+              ((VAR "b'2" BTY)
+               (ITB
+                (SQBKT
+                 ((VAR "b'3" BTY)
+                  (ITB
+                      (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                        (MOP NOT (VAR "b'0" BTY))))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SDL" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                        (VAR "b'0" BTY)))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SDR" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'1" BTY)
+                                        (MOP NOT (VAR "b'0" BTY))))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SWR" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                        (MOP NOT (VAR "b'0" BTY))))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SCD" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (VAR "b'1" BTY)
+                                        (VAR "b'0" BTY)))
+                              (CALL "Store" (CTY "instruction")
+                                    (CALL "SD" (CTY "Store")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16)))))))
+                      (CONST "ReservedInstruction"
+                             (CTY "instruction"))))
+                 ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                       (BOP AND (MOP NOT (VAR "b'1" BTY))
+                            (MOP NOT (VAR "b'0" BTY))))
+                  (CALL "Load" (CTY "instruction")
+                        (CALL "LBU" (CTY "Load")
+                              (TP (SQBKT (VAR "rs" (FTY 5))
+                                         (VAR "rt" (FTY 5))
+                                         (VAR "immediate" F16))))))
+                 ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                       (BOP AND (MOP NOT (VAR "b'1" BTY))
+                            (VAR "b'0" BTY)))
+                  (CALL "Load" (CTY "instruction")
+                        (CALL "LHU" (CTY "Load")
+                              (TP (SQBKT (VAR "rs" (FTY 5))
+                                         (VAR "rt" (FTY 5))
+                                         (VAR "immediate" F16))))))
+                 ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                       (BOP AND (VAR "b'1" BTY)
+                            (MOP NOT (VAR "b'0" BTY))))
+                  (CALL "Load" (CTY "instruction")
+                        (CALL "LWR" (CTY "Load")
+                              (TP (SQBKT (VAR "rs" (FTY 5))
+                                         (VAR "rt" (FTY 5))
+                                         (VAR "immediate" F16))))))
+                 ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                       (BOP AND (VAR "b'1" BTY)
+                            (VAR "b'0" BTY)))
+                  (CALL "Load" (CTY "instruction")
+                        (CALL "LWU" (CTY "Load")
+                              (TP (SQBKT (VAR "rs" (FTY 5))
+                                         (VAR "rt" (FTY 5))
+                                         (VAR "immediate" F16))))))
+                 ((BOP AND (VAR "b'4" BTY)
+                       (BOP AND (MOP NOT (VAR "b'1" BTY))
+                            (MOP NOT (VAR "b'0" BTY))))
+                  (CALL "Load" (CTY "instruction")
+                        (CALL "LLD" (CTY "Load")
+                              (TP (SQBKT (VAR "rs" (FTY 5))
+                                         (VAR "rt" (FTY 5))
+                                         (VAR "immediate" F16))))))
+                 ((BOP AND (VAR "b'4" BTY)
+                       (BOP AND (VAR "b'1" BTY)
+                            (VAR "b'0" BTY)))
+                  (CALL "Load" (CTY "instruction")
+                        (CALL "LD" (CTY "Load")
+                              (TP (SQBKT (VAR "rs" (FTY 5))
+                                         (VAR "rt" (FTY 5))
+                                         (VAR "immediate" F16)))))))
+                (CONST "ReservedInstruction"
+                       (CTY "instruction"))))
+              ((VAR "b'3" BTY)
+               (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                 (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                      (MOP NOT (VAR "b'0" BTY))))
+                            (CALL "Store" (CTY "instruction")
+                                  (CALL "SB" (CTY "Store")
+                                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                                   (VAR "rt" (FTY 5))
+                                                   (VAR "immediate" F16))))))
+                           ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                 (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                      (VAR "b'0" BTY)))
+                            (CALL "Store" (CTY "instruction")
+                                  (CALL "SH" (CTY "Store")
+                                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                                   (VAR "rt" (FTY 5))
+                                                   (VAR "immediate" F16))))))
+                           ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                 (BOP AND (VAR "b'1" BTY)
+                                      (MOP NOT (VAR "b'0" BTY))))
+                            (CALL "Store" (CTY "instruction")
+                                  (CALL "SWL" (CTY "Store")
+                                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                                   (VAR "rt" (FTY 5))
+                                                   (VAR "immediate" F16))))))
+                           ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                 (BOP AND (VAR "b'1" BTY)
+                                      (VAR "b'0" BTY)))
+                            (CALL "Store" (CTY "instruction")
+                                  (CALL "SW" (CTY "Store")
+                                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                                   (VAR "rt" (FTY 5))
+                                                   (VAR "immediate" F16))))))
+                           ((BOP AND (VAR "b'4" BTY)
+                                 (BOP AND (MOP NOT (VAR "b'1" BTY))
+                                      (MOP NOT (VAR "b'0" BTY))))
+                            (CALL "Store" (CTY "instruction")
+                                  (CALL "SC" (CTY "Store")
+                                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                                   (VAR "rt" (FTY 5))
+                                                   (VAR "immediate" F16)))))))
+                    (CONST "ReservedInstruction"
+                           (CTY "instruction"))))
+              ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                         (MOP NOT (VAR "b'0" BTY))))
+               (CALL "Load" (CTY "instruction")
+                     (CALL "LB" (CTY "Load")
+                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                      (VAR "rt" (FTY 5))
+                                      (VAR "immediate" F16))))))
+              ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                         (VAR "b'0" BTY)))
+               (CALL "Load" (CTY "instruction")
+                     (CALL "LH" (CTY "Load")
+                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                      (VAR "rt" (FTY 5))
+                                      (VAR "immediate" F16))))))
+              ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                    (BOP AND (VAR "b'1" BTY)
+                         (MOP NOT (VAR "b'0" BTY))))
+               (CALL "Load" (CTY "instruction")
+                     (CALL "LWL" (CTY "Load")
+                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                      (VAR "rt" (FTY 5))
+                                      (VAR "immediate" F16))))))
+              ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                    (BOP AND (VAR "b'1" BTY)
+                         (VAR "b'0" BTY)))
+               (CALL "Load" (CTY "instruction")
+                     (CALL "LW" (CTY "Load")
+                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                      (VAR "rt" (FTY 5))
+                                      (VAR "immediate" F16))))))
+              ((BOP AND (VAR "b'4" BTY)
+                    (BOP AND (MOP NOT (VAR "b'1" BTY))
+                         (MOP NOT (VAR "b'0" BTY))))
+               (CALL "Load" (CTY "instruction")
+                     (CALL "LL" (CTY "Load")
+                           (TP (SQBKT (VAR "rs" (FTY 5))
+                                      (VAR "rt" (FTY 5))
+                                      (VAR "immediate" F16)))))))
+             (CONST "ReservedInstruction"
+                    (CTY "instruction"))))
+           ((VAR "b'1" BTY)
+            (ITB
+             (SQBKT
+                ((VAR "b'0" BTY)
+                 (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                        (VAR "b'2" BTY)))
+                              (CALL "Branch" (CTY "instruction")
+                                    (CALL "BGTZ" (CTY "Branch")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (MOP NOT (VAR "b'2" BTY))))
+                              (CALL "ArithI" (CTY "instruction")
+                                    (CALL "SLTIU" (CTY "ArithI")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (VAR "b'2" BTY)))
+                              (CALL "ArithI" (CTY "instruction")
+                                    (CALL "LUI" (CTY "ArithI")
+                                          (TP (SQBKT (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                        (VAR "b'2" BTY)))
+                              (CALL "Branch" (CTY "instruction")
+                                    (CALL "BGTZL" (CTY "Branch")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "immediate" F16))))))
+                             ((BOP AND (VAR "b'4" BTY)
+                                   (BOP AND (VAR "b'3" BTY)
+                                        (MOP NOT (VAR "b'2" BTY))))
+                              (CALL "Load" (CTY "instruction")
+                                    (CALL "LDR" (CTY "Load")
+                                          (TP (SQBKT (VAR "rs" (FTY 5))
+                                                     (VAR "rt" (FTY 5))
+                                                     (VAR "immediate" F16)))))))
+                      (CONST "ReservedInstruction"
+                             (CTY "instruction"))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (MOP NOT (VAR "b'3" BTY))
+                           (VAR "b'2" BTY)))
+                 (CALL "Branch" (CTY "instruction")
+                       (CALL "BLEZ" (CTY "Branch")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (VAR "b'3" BTY)
+                           (MOP NOT (VAR "b'2" BTY))))
+                 (CALL "ArithI" (CTY "instruction")
+                       (CALL "SLTI" (CTY "ArithI")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "rt" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                      (BOP AND (VAR "b'3" BTY)
+                           (VAR "b'2" BTY)))
+                 (CALL "ArithI" (CTY "instruction")
+                       (CALL "XORI" (CTY "ArithI")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "rt" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (VAR "b'4" BTY)
+                      (BOP AND (MOP NOT (VAR "b'3" BTY))
+                           (VAR "b'2" BTY)))
+                 (CALL "Branch" (CTY "instruction")
+                       (CALL "BLEZL" (CTY "Branch")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "immediate" F16))))))
+                ((BOP AND (VAR "b'4" BTY)
+                      (BOP AND (VAR "b'3" BTY)
+                           (MOP NOT (VAR "b'2" BTY))))
+                 (CALL "Load" (CTY "instruction")
+                       (CALL "LDL" (CTY "Load")
+                             (TP (SQBKT (VAR "rs" (FTY 5))
+                                        (VAR "rt" (FTY 5))
+                                        (VAR "immediate" F16)))))))
+             (CONST "ReservedInstruction"
+                    (CTY "instruction"))))
+           ((VAR "b'0" BTY)
+            (ITB (SQBKT ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                              (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                   (VAR "b'2" BTY)))
+                         (CALL "Branch" (CTY "instruction")
+                               (CALL "BNE" (CTY "Branch")
+                                     (TP (SQBKT (VAR "rs" (FTY 5))
+                                                (VAR "rt" (FTY 5))
+                                                (VAR "immediate" F16))))))
+                        ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                              (BOP AND (VAR "b'3" BTY)
+                                   (MOP NOT (VAR "b'2" BTY))))
+                         (CALL "ArithI" (CTY "instruction")
+                               (CALL "ADDIU" (CTY "ArithI")
+                                     (TP (SQBKT (VAR "rs" (FTY 5))
+                                                (VAR "rt" (FTY 5))
+                                                (VAR "immediate" F16))))))
+                        ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                              (BOP AND (VAR "b'3" BTY)
+                                   (VAR "b'2" BTY)))
+                         (CALL "ArithI" (CTY "instruction")
+                               (CALL "ORI" (CTY "ArithI")
+                                     (TP (SQBKT (VAR "rs" (FTY 5))
+                                                (VAR "rt" (FTY 5))
+                                                (VAR "immediate" F16))))))
+                        ((BOP AND (VAR "b'4" BTY)
+                              (BOP AND (MOP NOT (VAR "b'3" BTY))
+                                   (VAR "b'2" BTY)))
+                         (CALL "Branch" (CTY "instruction")
+                               (CALL "BNEL" (CTY "Branch")
+                                     (TP (SQBKT (VAR "rs" (FTY 5))
+                                                (VAR "rt" (FTY 5))
+                                                (VAR "immediate" F16))))))
+                        ((BOP AND (VAR "b'4" BTY)
+                              (BOP AND (VAR "b'3" BTY)
+                                   (MOP NOT (VAR "b'2" BTY))))
+                         (CALL "ArithI" (CTY "instruction")
+                               (CALL "DADDIU" (CTY "ArithI")
+                                     (TP (SQBKT (VAR "rs" (FTY 5))
+                                                (VAR "rt" (FTY 5))
+                                                (VAR "immediate" F16)))))))
+                 (CONST "ReservedInstruction"
+                        (CTY "instruction"))))
+           ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                 (BOP AND (MOP NOT (VAR "b'3" BTY))
+                      (VAR "b'2" BTY)))
+            (CALL "Branch" (CTY "instruction")
+                  (CALL "BEQ" (CTY "Branch")
+                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                   (VAR "rt" (FTY 5))
+                                   (VAR "immediate" F16))))))
+           ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                 (BOP AND (VAR "b'3" BTY)
+                      (MOP NOT (VAR "b'2" BTY))))
+            (CALL "ArithI" (CTY "instruction")
+                  (CALL "ADDI" (CTY "ArithI")
+                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                   (VAR "rt" (FTY 5))
+                                   (VAR "immediate" F16))))))
+           ((BOP AND (MOP NOT (VAR "b'4" BTY))
+                 (BOP AND (VAR "b'3" BTY)
+                      (VAR "b'2" BTY)))
+            (CALL "ArithI" (CTY "instruction")
+                  (CALL "ANDI" (CTY "ArithI")
+                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                   (VAR "rt" (FTY 5))
+                                   (VAR "immediate" F16))))))
+           ((BOP AND (VAR "b'4" BTY)
+                 (BOP AND (MOP NOT (VAR "b'3" BTY))
+                      (VAR "b'2" BTY)))
+            (CALL "Branch" (CTY "instruction")
+                  (CALL "BEQL" (CTY "Branch")
+                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                   (VAR "rt" (FTY 5))
+                                   (VAR "immediate" F16))))))
+           ((BOP AND (VAR "b'4" BTY)
+                 (BOP AND (VAR "b'3" BTY)
+                      (MOP NOT (VAR "b'2" BTY))))
+            (CALL "ArithI" (CTY "instruction")
+                  (CALL "DADDI" (CTY "ArithI")
+                        (TP (SQBKT (VAR "rs" (FTY 5))
+                                   (VAR "rt" (FTY 5))
+                                   (VAR "immediate" F16)))))))
+          (CONST "ReservedInstruction"
+                 (CTY "instruction"))))))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "Fetch" QVAR
+   (LET
+    (VAR "v" F64)
+    (DEST "PC" F64 QVAR)
+    (LET
+     (TP (SQBKT (VAR "pAddr" F64)
+                (VAR "CCA" (FTY 3))))
+     (CALL "AddressTranslation" (PTY F64 (FTY 3))
+           (TP (SQBKT (VAR "v" F64)
+                      (LC "INSTRUCTION" (CTY "IorD"))
+                      (LC "LOAD" (CTY "LorS")))))
+     (LET
+      (VAR "v0" (FTY 3))
+      (BOP BXOR
+           (EX (VAR "v" F64) (LN 2) (LN 0) (FTY 3))
+           (CC (SQBKT (MOP FST
+                           (APPLY (CONST "BigEndianCPU" (ATY QTY (PTY F1 QTY)))
+                                  QVAR))
+                      (LW 0 2))))
+      (TP
+        (SQBKT
+             (EX (MOP FST
+                      (APPLY (CALL "LoadMemory" (ATY QTY (PTY F64 QTY))
+                                   (TP (SQBKT (VAR "CCA" (FTY 3))
+                                              (CONST "WORD" (FTY 3))
+                                              (VAR "pAddr" F64)
+                                              (VAR "v" F64)
+                                              (LC "INSTRUCTION" (CTY "IorD")))))
+                             QVAR))
+                 (BOP ADD (LN 31)
+                      (BOP MUL (LN 8)
+                           (MOP (CAST NTY) (VAR "v0" (FTY 3)))))
+                 (BOP MUL (LN 8)
+                      (MOP (CAST NTY) (VAR "v0" (FTY 3))))
+                 F32)
+             QVAR))))))))
+
+(VALUE-TRIPLE
+ (LIST
+  :ERROR
+  (DEF
+   "Next" QVAR
+   (LET
+    QVAR
+    (MOP SND
+         (APPLY (CALL "Run" (ATY QTY (PTY UTY QTY))
+                      (CALL "Decode" (CTY "instruction")
+                            (MOP FST
+                                 (APPLY (CONST "Fetch" (ATY QTY (PTY F32 QTY)))
+                                        QVAR))))
+                (RUPD "BranchStatus"
+                      (TP (SQBKT QVAR (LO F64))))))
+    (LET
+     QVAR
+     (CS (DEST "BranchStatus" (OTY F64) QVAR)
+         (SQBKT ((MOP SOME (VAR "addr" F64))
+                 (ITE (MOP ISSOME
+                           (DEST "BranchStatus" (OTY F64) QVAR))
+                      (MOP SND
+                           (APPLY (CALL "raise'exception"
+                                        (ATY QTY (PTY UTY QTY))
+                                        (CALL "UNPREDICTABLE" (CTY "exception")
+                                              (LS "Branch follows branch")))
+                                  QVAR))
+                      (RUPD "PC"
+                            (TP (SQBKT QVAR (VAR "addr" F64))))))
+                ((LO F64) QVAR)))
+     (LET
+      QVAR
+      (RUPD "PC"
+            (TP (SQBKT QVAR
+                       (BOP ADD (DEST "PC" F64 QVAR)
+                            (LW 4 64)))))
+      (TP
+       (SQBKT
+        LU
+        (RUPD
+         "CP0"
+         (TP
+           (SQBKT QVAR
+                  (RUPD "Count"
+                        (TP (SQBKT (DEST "CP0" (CTY "CP0") QVAR)
+                                   (BOP ADD
+                                        (DEST "Count"
+                                              F32 (DEST "CP0" (CTY "CP0") QVAR))
+                                        (LW 1 32))))))))))))))))
+
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/mips/mips.spec acl2-6.3/books/translators/l3-to-acl2/examples/mips/mips.spec
--- acl2-6.2/books/translators/l3-to-acl2/examples/mips/mips.spec	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/mips/mips.spec	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,1697 @@
+---------------------------------------------------------------------------
+-- Model of the 64-bit MIPS ISA (R4000)
+---------------------------------------------------------------------------
+
+type CCA   = bits(3)
+type reg   = bits(5)
+type byte  = bits(8)
+type word  = bits(32)
+type dword = bits(64)
+type vAddr = bits(64)
+type pAddr = bits(64)
+
+exception UNPREDICTABLE :: string
+
+--------------------------------------------------
+-- Coprocessor 0 registers
+--------------------------------------------------
+
+register StatusRegister :: word
+{
+   26 : RE        -- Reverse endianness
+   22 : BEV       -- Controls location of exception vectors
+    9 : IM1       -- Interrupt mask
+    8 : IM0       -- Interrupt mask
+  4-3 : KSU       -- Operating mode
+    2 : ERL       -- Error level
+    1 : EXL       -- Exception level
+    0 : IE        -- Interrupt enable
+}
+
+register ConfigRegister :: word
+{
+   15 : BE        -- Big endian
+}
+
+register CauseRegister :: word
+{
+   6-2 : ExcCode  -- Exception code
+}
+
+record CP0
+{
+-- Index    :: word            -- 0   Index to TLB array
+-- Random   :: word            -- 1   Pseudorandom pointer to TLB array
+-- EntryLo0 :: word            -- 2   Low half of TLB entry for even VPN
+-- EntryLo1 :: word            -- 3   Low half of TLB entry for odd VPN
+-- Context  :: word            -- 4   Kernel virtual page table entry (PTE)
+-- PageMask :: word            -- 5   TLB page mask
+-- Wired    :: word            -- 6   Number of wired TLB entries
+-- HWREna   :: word            -- 7   See RDHWR instruction
+-- BadVAddr :: word            -- 8   Bad virtual address
+   Count    :: word            -- 9   Timer count
+-- EntryHi  :: word            -- 10  High half of TLB entry
+-- Compare  :: word            -- 11  Timer compare
+   Status   :: StatusRegister  -- 12  Status register
+   Cause    :: CauseRegister   -- 13  Cause of last exception
+   EPC      :: dword           -- 14  Exception program counter
+-- PRId     :: word            -- 15  Processor revision identifier
+   Config   :: ConfigRegister  -- 16  Configuration register
+-- LLAddr   :: word            -- 17  Load linked address
+-- WatchLo  :: word            -- 18  Memory reference trap address low bits
+-- WatchHi  :: word            -- 19  Memory reference trap address high bits
+-- XContext :: word            -- 20  PTE entry in 64-bit mode
+-- Reserved                    -- 21
+-- Implementation dependent    -- 22
+-- Debug    :: word            -- 23  EJTAG Debug register
+-- DEPC     :: word            -- 24  Program counter EJTAG debug exception
+-- PerfCnt  :: word            -- 25  Performance counter interface
+-- ECC      :: word            -- 26  Second cache error checking and correcting
+-- CacheErr :: word            -- 27  Cache error and status register
+-- TagLo    :: word            -- 28  Cache tage register
+-- TagHi    :: word            -- 29  Cache tage register
+   ErrorEPC :: dword           -- 30  Error exception program counter
+-- KScratch :: word            -- 31  Scratch Registers for Kernel Mode
+}
+
+construct HLStatus { HLarith, HLok, HLmthi, HLmtlo }
+
+--================================================
+-- The state space
+--================================================
+
+declare
+{
+   gpr          :: reg -> dword   -- general purpose registers
+   PC           :: dword          -- the program counter
+   HI           :: dword          -- multiply and divide register high result
+   LO           :: dword          -- multiply and divide register low result
+   HLStatus     :: HLStatus       -- status of the HI and LO registers
+   CP0          :: CP0            -- CP0 registers
+   MEM          :: vAddr -> byte  -- memory
+   BranchStatus :: dword option   -- Branch to be taken after instruction
+   LLbit        :: bool option    -- Load link flag
+}
+
+--------------------------------------------------
+-- Gereral purpose register access
+--------------------------------------------------
+
+component GPR (n::reg) :: dword
+{
+   value = if n == 0 then 0 else gpr(n)
+   assign value = when n <> 0 do gpr(n) <- value
+}
+
+--------------------------------------------------
+-- CP0 register access
+--------------------------------------------------
+
+component CPR (n::nat, reg::bits(5), sel::bits(3)) :: dword
+{
+   value =
+      match n, reg, sel
+      {
+         case 0,  9, 0 => [CP0.Count]
+         case 0, 12, 0 => [CP0.&Status]
+         case 0, 13, 0 => [CP0.&Cause]
+         case 0, 14, 0 =>  CP0.EPC
+         case 0, 16, 0 => [CP0.&Config]
+         case 0, 30, 0 =>  CP0.ErrorEPC
+         case _ => UNKNOWN
+      }
+   assign value =
+      match n, reg, sel
+      {
+         case 0,  9, 0 => CP0.Count    <- value<31:0>
+         case 0, 12, 0 => CP0.&Status  <- value<31:0>
+         case 0, 13, 0 => CP0.&Cause   <- value<31:0>
+         case 0, 14, 0 => CP0.EPC      <- value
+         case 0, 16, 0 => CP0.&Config  <- value<31:0>
+         case 0, 30, 0 => CP0.ErrorEPC <- value
+         case _ => nothing
+      }
+}
+
+--------------------------------------------------
+-- Memory access
+--------------------------------------------------
+
+construct IorD  { INSTRUCTION, DATA }
+construct LorS  { LOAD, STORE }
+
+bits(3) BYTE       = 0`3
+bits(3) HALFWORD   = 1`3
+bits(3) WORD       = 3`3
+bits(3) DOUBLEWORD = 7`3
+
+nat PSIZE = 64 -- 64-bit physical memory
+
+bool UserMode =
+   CP0.Status.KSU == '10' and not CP0.Status.EXL and not CP0.Status.ERL
+
+bool BigEndianMem = CP0.Config.BE
+bits(1) ReverseEndian = [CP0.Status.RE and UserMode]
+bits(1) BigEndianCPU  = [BigEndianMem] ?? ReverseEndian
+
+pAddr * CCA AddressTranslation (vAddr::vAddr, IorD::IorD, LorS::LorS) =
+   return (vAddr, UNKNOWN) -- null address translation
+
+dword LoadMemory (CCA::CCA, AccessLength::bits(3),
+                  pAddr::pAddr, vAddr::vAddr, IorD::IorD) =
+{
+   a = pAddr && ~0b111; -- align to 64-bit word
+   if BigEndianCPU == '1' then
+      MEM(a) :
+      MEM(a + 1) :
+      MEM(a + 2) :
+      MEM(a + 3) :
+      MEM(a + 4) :
+      MEM(a + 5) :
+      MEM(a + 6) :
+      MEM(a + 7)
+   else
+      MEM(a + 7) :
+      MEM(a + 6) :
+      MEM(a + 5) :
+      MEM(a + 4) :
+      MEM(a + 3) :
+      MEM(a + 2) :
+      MEM(a + 1) :
+      MEM(a)
+}
+
+unit StoreMemory (CCA::CCA, AccessLength::bits(3), MemElem::dword,
+                  pAddr::pAddr, vAddr::vAddr, IorD::IorD) =
+{  a = pAddr && ~0b111; -- align to 64-bit word
+   l = vAddr<2:0>;
+   h = l + AccessLength;
+   if BigEndianCPU == '1' then
+   {
+      when l == 0              do MEM(a)     <- MemElem<63:56>;
+      when l <=+ 1 and 1 <=+ h do MEM(a + 1) <- MemElem<55:48>;
+      when l <=+ 2 and 2 <=+ h do MEM(a + 2) <- MemElem<47:40>;
+      when l <=+ 3 and 3 <=+ h do MEM(a + 3) <- MemElem<39:32>;
+      when l <=+ 4 and 4 <=+ h do MEM(a + 4) <- MemElem<31:24>;
+      when l <=+ 5 and 5 <=+ h do MEM(a + 5) <- MemElem<23:16>;
+      when l <=+ 6 and 6 <=+ h do MEM(a + 6) <- MemElem<15:8>;
+      when l <=+ 7 and 7 <=+ h do MEM(a + 7) <- MemElem<7:0>
+   }
+   else
+   {
+      when l <=+ 7 and 7 <=+ h do MEM(a + 7) <- MemElem<63:56>;
+      when l <=+ 6 and 6 <=+ h do MEM(a + 6) <- MemElem<55:48>;
+      when l <=+ 5 and 5 <=+ h do MEM(a + 5) <- MemElem<47:40>;
+      when l <=+ 4 and 4 <=+ h do MEM(a + 4) <- MemElem<39:32>;
+      when l <=+ 3 and 3 <=+ h do MEM(a + 3) <- MemElem<31:24>;
+      when l <=+ 2 and 2 <=+ h do MEM(a + 2) <- MemElem<23:16>;
+      when l <=+ 1 and 1 <=+ h do MEM(a + 1) <- MemElem<15:8>;
+      when l == 0              do MEM(a)     <- MemElem<7:0>
+   }
+}
+
+--------------------------------------------------
+-- Exceptions
+--------------------------------------------------
+
+construct ExceptionType { AdEL, AdES, Sys, Bp, RI, Ov, Tr }
+
+bits(5) ExceptionCode (ExceptionType::ExceptionType) =
+   match ExceptionType
+   {
+      case AdEL => 0x04 -- Address error (load)
+      case AdES => 0x05 -- Address error (store)
+      case Sys  => 0x08 -- Syscall
+      case Bp   => 0x09 -- Breakpoint
+      case RI   => 0x0a -- Reserved instruction
+      case Ov   => 0x0c -- Arithmetic overflow
+      case Tr   => 0x0d -- Trap
+   }
+
+unit SignalException (ExceptionType::ExceptionType) =
+{
+   when not CP0.Status.EXL do CP0.EPC <- PC;
+   vectorOffset = 0x180`30;
+   CP0.Cause.ExcCode <- ExceptionCode (ExceptionType);
+   CP0.Status.EXL <- true;
+   vectorBase = if CP0.Status.BEV then
+                   0xFFFF_FFFF_BFC0_0200`64
+                else
+                   0xFFFF_FFFF_8000_0000;
+   PC <- vectorBase<63:30> : (vectorBase<29:0> + vectorOffset)
+}
+
+--================================================
+-- Instructions
+--================================================
+
+bool NotWordValue(value::dword) =
+{  top = value<63:32>;
+   if value<31> then
+      top <> 0xFFFF_FFFF
+   else
+      top <> 0x0
+}
+
+-----------------------------------
+-- ADDI rt, rs, immediate
+-----------------------------------
+define ArithI > ADDI (rs::reg, rt::reg, immediate::bits(16)) =
+{
+   when NotWordValue (GPR(rs)) do #UNPREDICTABLE("ADDI: NotWordValue");
+   temp = GPR(rs)<32:0> + SignExtend (immediate);
+   if temp<32> <> temp<31> then
+      SignalException (Ov)
+   else
+      GPR(rt) <- SignExtend (temp<31:0>)
+}
+
+-----------------------------------
+-- ADDIU rt, rs, immediate
+-----------------------------------
+define ArithI > ADDIU (rs::reg, rt::reg, immediate::bits(16)) =
+{
+   when NotWordValue (GPR(rs)) do #UNPREDICTABLE("ADDIU: NotWordValue");
+   temp = GPR(rs)<31:0> + SignExtend (immediate);
+   GPR(rt) <- SignExtend (temp)
+}
+
+-----------------------------------
+-- DADDI rt, rs, immediate
+-----------------------------------
+define ArithI > DADDI (rs::reg, rt::reg, immediate::bits(16)) =
+{
+   temp`65 = SignExtend (GPR(rs)) + SignExtend (immediate);
+   if temp<64> <> temp<63> then
+      SignalException (Ov)
+   else
+      GPR(rt) <- temp<63:0>
+}
+
+-----------------------------------
+-- DADDIU rt, rs, immediate
+-----------------------------------
+define ArithI > DADDIU (rs::reg, rt::reg, immediate::bits(16)) =
+   GPR(rt) <- GPR(rs) + SignExtend (immediate)
+
+-----------------------------------
+-- SLTI rt, rs, immediate
+-----------------------------------
+define ArithI > SLTI (rs::reg, rt::reg, immediate::bits(16)) =
+   GPR(rt) <- [GPR(rs) < SignExtend (immediate)]
+
+-----------------------------------
+-- SLTIU rt, rs, immediate
+-----------------------------------
+define ArithI > SLTIU (rs::reg, rt::reg, immediate::bits(16)) =
+   GPR(rt) <- [GPR(rs) <+ SignExtend (immediate)]
+
+-----------------------------------
+-- ANDI rt, rs, immediate
+-----------------------------------
+define ArithI > ANDI (rs::reg, rt::reg, immediate::bits(16)) =
+   GPR(rt) <- GPR(rs) && ZeroExtend (immediate)
+
+-----------------------------------
+-- ORI rt, rs, immediate
+-----------------------------------
+define ArithI > ORI (rs::reg, rt::reg, immediate::bits(16)) =
+   GPR(rt) <- GPR(rs) || ZeroExtend (immediate)
+
+-----------------------------------
+-- XORI rt, rs, immediate
+-----------------------------------
+define ArithI > XORI (rs::reg, rt::reg, immediate::bits(16)) =
+   GPR(rt) <- GPR(rs) ?? ZeroExtend (immediate)
+
+-----------------------------------
+-- LUI rt, immediate
+-----------------------------------
+define ArithI > LUI (rt::reg, immediate::bits(16)) =
+   GPR(rt) <- SignExtend (immediate : 0`16)
+
+-----------------------------------
+-- ADD rd, rs, rt
+-----------------------------------
+define ArithR > ADD (rs::reg, rt::reg, rd::reg) =
+{
+   when NotWordValue (GPR(rs)) or NotWordValue (GPR(rt))
+     do #UNPREDICTABLE("ADD: NotWordValue");
+   temp = GPR(rs)<32:0> + GPR(rt)<32:0>;
+   if temp<32> <> temp<31> then
+      SignalException (Ov)
+   else
+      GPR(rd) <- SignExtend (temp<31:0>)
+}
+
+-----------------------------------
+-- ADDU rd, rs, rt
+-----------------------------------
+define ArithR > ADDU (rs::reg, rt::reg, rd::reg) =
+{
+   when NotWordValue (GPR(rs)) or NotWordValue (GPR(rt))
+     do #UNPREDICTABLE("ADDU: NotWordValue");
+   temp = GPR(rs)<31:0> + GPR(rt)<31:0>;
+   GPR(rd) <- SignExtend (temp)
+}
+
+-----------------------------------
+-- SUB rd, rs, rt
+-----------------------------------
+define ArithR > SUB (rs::reg, rt::reg, rd::reg) =
+{
+   when NotWordValue (GPR(rs)) or NotWordValue (GPR(rt))
+     do #UNPREDICTABLE("SUB: NotWordValue");
+   temp = GPR(rs)<32:0> - GPR(rt)<32:0>;
+   if temp<32> <> temp<31> then
+      SignalException (Ov)
+   else
+      GPR(rd) <- SignExtend (temp<31:0>)
+}
+
+-----------------------------------
+-- SUBU rd, rs, rt
+-----------------------------------
+define ArithR > SUBU (rs::reg, rt::reg, rd::reg) =
+{
+   when NotWordValue (GPR(rs)) or NotWordValue (GPR(rt))
+     do #UNPREDICTABLE("SUBU: NotWordValue");
+   temp = GPR(rs)<32:0> - GPR(rt)<32:0>;
+   GPR(rd) <- SignExtend (temp)
+}
+
+-----------------------------------
+-- DADD rd, rs, rt
+-----------------------------------
+define ArithR > DADD (rs::reg, rt::reg, rd::reg) =
+{
+   temp`65 = SignExtend (GPR(rs)) + SignExtend (GPR(rt));
+   if temp<64> <> temp<63> then
+      SignalException (Ov)
+   else
+      GPR(rd) <- temp<63:0>
+}
+
+-----------------------------------
+-- DADDU rd, rs, rt
+-----------------------------------
+define ArithR > DADDU (rs::reg, rt::reg, rd::reg) =
+   GPR(rd) <- GPR(rs) + GPR(rt)
+
+-----------------------------------
+-- DSUB rd, rs, rt
+-----------------------------------
+define ArithR > DSUB (rs::reg, rt::reg, rd::reg) =
+{
+   temp`65 = SignExtend (GPR(rs)) - SignExtend (GPR(rt));
+   if temp<64> <> temp<63> then
+      SignalException (Ov)
+   else
+      GPR(rd) <- temp<63:0>
+}
+
+-----------------------------------
+-- DSUBU rd, rs, rt
+-----------------------------------
+define ArithR > DSUBU (rs::reg, rt::reg, rd::reg) =
+   GPR(rd) <- GPR(rs) - GPR(rt)
+
+-----------------------------------
+-- SLT rd, rs, rt
+-----------------------------------
+define ArithR > SLT (rs::reg, rt::reg, rd::reg) =
+   GPR(rd) <- [GPR(rs) < GPR(rt)]
+
+-----------------------------------
+-- SLTU rd, rs, rt
+-----------------------------------
+define ArithR > SLTU (rs::reg, rt::reg, rd::reg) =
+   GPR(rd) <- [GPR(rs) <+ GPR(rt)]
+
+-----------------------------------
+-- AND rd, rs, rt
+-----------------------------------
+define ArithR > AND (rs::reg, rt::reg, rd::reg) =
+   GPR(rd) <- GPR(rs) && GPR(rt)
+
+-----------------------------------
+-- OR rd, rs, rt
+-----------------------------------
+define ArithR > OR (rs::reg, rt::reg, rd::reg) =
+   GPR(rd) <- GPR(rs) || GPR(rt)
+
+-----------------------------------
+-- XOR rd, rs, rt
+-----------------------------------
+define ArithR > XOR (rs::reg, rt::reg, rd::reg) =
+   GPR(rd) <- GPR(rs) ?? GPR(rt)
+
+-----------------------------------
+-- NOR rd, rs, rt
+-----------------------------------
+define ArithR > NOR (rs::reg, rt::reg, rd::reg) =
+   GPR(rd) <- ~(GPR(rs) || GPR(rt))
+
+-----------------------------------
+-- MULT rs, rt
+-----------------------------------
+define MultDiv > MULT (rs::reg, rt::reg) =
+{
+   when NotWordValue (GPR(rs)) or NotWordValue (GPR(rt))
+     do #UNPREDICTABLE("MULT: NotWordValue");
+   prod`64 = SignExtend (GPR(rs)<31:0>) * SignExtend (GPR(rt)<31:0>);
+   LO <- SignExtend (prod<31:0>);
+   HI <- SignExtend (prod<63:32>);
+   HLStatus <- HLarith
+}
+
+-----------------------------------
+-- MULTU rs, rt
+-----------------------------------
+define MultDiv > MULTU (rs::reg, rt::reg) =
+{
+   when NotWordValue (GPR(rs)) or NotWordValue (GPR(rt))
+     do #UNPREDICTABLE("MULTU: NotWordValue");
+   prod`64 = ZeroExtend (GPR(rs)<31:0>) * ZeroExtend (GPR(rt)<31:0>);
+   LO <- SignExtend (prod<31:0>);
+   HI <- SignExtend (prod<63:32>);
+   HLStatus <- HLarith
+}
+
+-----------------------------------
+-- DMULT rs, rt
+-----------------------------------
+define MultDiv > DMULT (rs::reg, rt::reg) =
+{
+   prod`128 = SignExtend (GPR(rs)) * SignExtend (GPR(rt));
+   LO <- prod<63:0>;
+   HI <- prod<127:64>;
+   HLStatus <- HLarith
+}
+
+-----------------------------------
+-- DMULTU rs, rt
+-----------------------------------
+define MultDiv > DMULTU (rs::reg, rt::reg) =
+{
+   prod`128 = ZeroExtend (GPR(rs)) * ZeroExtend (GPR(rt));
+   LO <- prod<63:0>;
+   HI <- prod<127:64>;
+   HLStatus <- HLarith
+}
+
+-----------------------------------
+-- DIV rs, rt
+-----------------------------------
+define MultDiv > DIV (rs::reg, rt::reg) =
+{
+   when GPR(rt) == 0
+     do #UNPREDICTABLE("DIV: divide by zero");
+   when NotWordValue (GPR(rs)) or NotWordValue (GPR(rt))
+     do #UNPREDICTABLE("DIV: NotWordValue");
+   q = GPR(rs)<31:0> quot GPR(rt)<31:0>;
+   LO <- SignExtend (q);
+   r = GPR(rs)<31:0> rem GPR(rt)<31:0>;
+   HI <- SignExtend (r);
+   HLStatus <- HLarith
+}
+
+-----------------------------------
+-- DIVU rs, rt
+-----------------------------------
+define MultDiv > DIVU (rs::reg, rt::reg) =
+{
+   when GPR(rt) == 0
+     do #UNPREDICTABLE("DIVU: divide by zero");
+   when NotWordValue (GPR(rs)) or NotWordValue (GPR(rt))
+     do #UNPREDICTABLE("DIVU: NotWordValue");
+   q = GPR(rs)<31:0> div GPR(rt)<31:0>;
+   r = GPR(rs)<31:0> mod GPR(rt)<31:0>;
+   LO <- SignExtend (q);
+   HI <- SignExtend (r);
+   HLStatus <- HLarith
+}
+
+-----------------------------------
+-- DDIV rs, rt
+-----------------------------------
+define MultDiv > DDIV (rs::reg, rt::reg) =
+{
+   when GPR(rt) == 0 do #UNPREDICTABLE("DDIV: divide by zero");
+   LO <- GPR(rs) quot GPR(rt);
+   HI <- GPR(rs) rem GPR(rt);
+   HLStatus <- HLarith
+}
+
+-----------------------------------
+-- DDIVU rs, rt
+-----------------------------------
+define MultDiv > DDIVU (rs::reg, rt::reg) =
+{
+   when GPR(rt) == 0 do #UNPREDICTABLE("DDIVU: divide by zero");
+   LO <- GPR(rs) div GPR(rt);
+   HI <- GPR(rs) mod GPR(rt);
+   HLStatus <- HLarith
+}
+
+-----------------------------------
+-- MFHI rd
+-----------------------------------
+define MultDiv > MFHI (rd::reg) =
+{
+   when HLStatus == HLmtlo do #UNPREDICTABLE("MFHI");
+   when HLStatus == HLarith do HLStatus <- HLok;
+   GPR(rd) <- HI
+}
+
+-----------------------------------
+-- MFLO rd
+-----------------------------------
+define MultDiv > MFLO (rd::reg) =
+{
+   when HLStatus == HLmthi do #UNPREDICTABLE("MFLO");
+   when HLStatus == HLarith do HLStatus <- HLok;
+   GPR(rd) <- LO
+}
+
+-----------------------------------
+-- MTHI rd
+-----------------------------------
+define MultDiv > MTHI (rd::reg) =
+{
+   if HLStatus == HLarith then
+      HLStatus <- HLmthi
+   else if HLStatus == HLmtlo then
+      HLStatus <- HLok
+   else nothing;
+   HI <- GPR(rd)
+}
+
+-----------------------------------
+-- MTLO rd
+-----------------------------------
+define MultDiv > MTLO (rd::reg) =
+{
+   if HLStatus == HLarith then
+      HLStatus <- HLmtlo
+   else if HLStatus == HLmthi then
+      HLStatus <- HLok
+   else nothing;
+   LO <- GPR(rd)
+}
+
+-----------------------------------
+-- SLL rd, rt, sa
+-----------------------------------
+define Shift > SLL (rt::reg, rd::reg, sa::bits(5)) =
+   GPR(rd) <- SignExtend (GPR(rt)<31:0> << [sa])
+
+-----------------------------------
+-- SRL rd, rt, sa
+-----------------------------------
+define Shift > SRL (rt::reg, rd::reg, sa::bits(5)) =
+{
+   when NotWordValue (GPR(rt)) do #UNPREDICTABLE("SRL: NotWordValue");
+   GPR(rd) <- SignExtend (GPR(rt)<31:0> >>+ [sa])
+}
+
+-----------------------------------
+-- SRA rd, rt, sa
+-----------------------------------
+define Shift > SRA (rt::reg, rd::reg, sa::bits(5)) =
+{
+   when NotWordValue (GPR(rt)) do #UNPREDICTABLE("SRA: NotWordValue");
+   GPR(rd) <- SignExtend (GPR(rt)<31:0> >> [sa])
+}
+
+-----------------------------------
+-- SLLV rd, rt, rs
+-----------------------------------
+define Shift > SLLV (rs::reg, rt::reg, rd::reg) =
+{
+   sa = GPR(rs)<4:0>;
+   GPR(rd) <- SignExtend (GPR(rt)<31:0> << [sa])
+}
+
+-----------------------------------
+-- SRLV rd, rt, rs
+-----------------------------------
+define Shift > SRLV (rs::reg, rt::reg, rd::reg) =
+{
+   when NotWordValue (GPR(rt)) do #UNPREDICTABLE("SRLV: NotWordValue");
+   sa = GPR(rs)<4:0>;
+   GPR(rd) <- SignExtend (GPR(rt)<31:0> >>+ [sa])
+}
+
+-----------------------------------
+-- SRAV rd, rt, rs
+-----------------------------------
+define Shift > SRAV (rs::reg, rt::reg, rd::reg) =
+{
+   when NotWordValue (GPR(rt)) do #UNPREDICTABLE("SRAV: NotWordValue");
+   sa = GPR(rs)<4:0>;
+   GPR(rd) <- SignExtend (GPR(rt)<31:0> >> [sa])
+}
+
+-----------------------------------
+-- DSLL rd, rt, sa
+-----------------------------------
+define Shift > DSLL (rt::reg, rd::reg, sa::bits(5)) =
+   GPR(rd) <- GPR(rt) << [sa]
+
+-----------------------------------
+-- DSRL rd, rt, sa
+-----------------------------------
+define Shift > DSRL (rt::reg, rd::reg, sa::bits(5)) =
+   GPR(rd) <- GPR(rt) >>+ [sa]
+
+-----------------------------------
+-- DSRA rd, rt, sa
+-----------------------------------
+define Shift > DSRA (rt::reg, rd::reg, sa::bits(5)) =
+   GPR(rd) <- GPR(rt) >> [sa]
+
+-----------------------------------
+-- DSLLV rd, rt, rs
+-----------------------------------
+define Shift > DSLLV (rs::reg, rt::reg, rd::reg) =
+{
+   sa = GPR(rs)<5:0>;
+   GPR(rd) <- GPR(rt) << [sa]
+}
+
+-----------------------------------
+-- DSRLV rd, rt, rs
+-----------------------------------
+define Shift > DSRLV (rs::reg, rt::reg, rd::reg) =
+{
+   sa = GPR(rs)<5:0>;
+   GPR(rd) <- GPR(rt) >>+ [sa]
+}
+
+-----------------------------------
+-- DSRAV rd, rt, rs
+-----------------------------------
+define Shift > DSRAV (rs::reg, rt::reg, rd::reg) =
+{
+   sa = GPR(rs)<5:0>;
+   GPR(rd) <- GPR(rt) >> [sa]
+}
+
+-----------------------------------
+-- DSLL32 rd, rt, sa
+-----------------------------------
+define Shift > DSLL32 (rt::reg, rd::reg, sa::bits(5)) =
+   GPR(rd) <- GPR(rt) << ([sa] + 0n32)
+
+-----------------------------------
+-- DSRL32 rd, rt, sa
+-----------------------------------
+define Shift > DSRL32 (rt::reg, rd::reg, sa::bits(5)) =
+   GPR(rd) <- GPR(rt) >>+ ([sa] + 0n32)
+
+-----------------------------------
+-- DSRA32 rd, rt, sa
+-----------------------------------
+define Shift > DSRA32 (rt::reg, rd::reg, sa::bits(5)) =
+   GPR(rd) <- GPR(rt) >> ([sa] + 0n32)
+
+-----------------------------------
+-- TGE rs, rt
+-----------------------------------
+define Trap > TGE (rs::reg, rt::reg) =
+   when GPR(rs) >= GPR(rt) do SignalException (Tr)
+
+-----------------------------------
+-- TGEU rs, rt
+-----------------------------------
+define Trap > TGEU (rs::reg, rt::reg) =
+   when GPR(rs) >=+ GPR(rt) do SignalException (Tr)
+
+-----------------------------------
+-- TLT rs, rt
+-----------------------------------
+define Trap > TLT (rs::reg, rt::reg) =
+   when GPR(rs) < GPR(rt) do SignalException (Tr)
+
+-----------------------------------
+-- TLTU rs, rt
+-----------------------------------
+define Trap > TLTU (rs::reg, rt::reg) =
+   when GPR(rs) <+ GPR(rt) do SignalException (Tr)
+
+-----------------------------------
+-- TEQ rs, rt
+-----------------------------------
+define Trap > TEQ (rs::reg, rt::reg) =
+   when GPR(rs) == GPR(rt) do SignalException (Tr)
+
+-----------------------------------
+-- TNE rs, rt
+-----------------------------------
+define Trap > TNE (rs::reg, rt::reg) =
+   when GPR(rs) <> GPR(rt) do SignalException (Tr)
+
+-----------------------------------
+-- TGEI rs, immediate
+-----------------------------------
+define Trap > TGEI (rs::reg, immediate::bits(16)) =
+   when GPR(rs) >= SignExtend (immediate) do SignalException (Tr)
+
+-----------------------------------
+-- TGEIU rs, immediate
+-----------------------------------
+define Trap > TGEIU (rs::reg, immediate::bits(16)) =
+   when GPR(rs) >=+ SignExtend (immediate) do SignalException (Tr)
+
+-----------------------------------
+-- TLTI rs, immediate
+-----------------------------------
+define Trap > TLTI (rs::reg, immediate::bits(16)) =
+   when GPR(rs) < SignExtend (immediate) do SignalException (Tr)
+
+-----------------------------------
+-- TLTIU rs, immediate
+-----------------------------------
+define Trap > TLTIU (rs::reg, immediate::bits(16)) =
+   when GPR(rs) <+ SignExtend (immediate) do SignalException (Tr)
+
+-----------------------------------
+-- TEQI rs, immediate
+-----------------------------------
+define Trap > TEQI (rs::reg, immediate::bits(16)) =
+   when GPR(rs) == SignExtend (immediate) do SignalException (Tr)
+
+-----------------------------------
+-- TNEI rs, immediate
+-----------------------------------
+define Trap > TNEI (rs::reg, immediate::bits(16)) =
+   when GPR(rs) <> SignExtend (immediate) do SignalException (Tr)
+
+-----------------------------------
+-- LB  rt, offset(base)
+-- LBU rt, offset(base)
+-- LH  rt, offset(base)
+-- LHU rt, offset(base)
+-- LW  rt, offset(base)
+-- LWU rt, offset(base)
+-- LL  rt, offset(base)
+-- LD  rt, offset(base)
+-- LDU rt, offset(base)
+-- LLD rt, offset(base)
+-----------------------------------
+unit loadByte (base::reg, rt::reg, offset::bits(16), unsigned::bool) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, LOAD);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   memdoubleword = LoadMemory (CCA, BYTE, pAddr, vAddr, DATA);
+   byte = vAddr<2:0> ?? BigEndianCPU^3;
+   membyte`8 = memdoubleword <7 + 8 * [byte] : 8 * [byte]>;
+   GPR(rt) <- if unsigned then ZeroExtend (membyte) else SignExtend (membyte)
+}
+
+unit loadHalf (base::reg, rt::reg, offset::bits(16), unsigned::bool) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   if vAddr<0> then
+      SignalException (AdEL)
+   else
+   {
+      pAddr, CCA = AddressTranslation (vAddr, DATA, LOAD);
+      pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? (ReverseEndian^2 : '0'));
+      memdoubleword = LoadMemory (CCA, HALFWORD, pAddr, vAddr, DATA);
+      byte = vAddr<2:0> ?? (BigEndianCPU^2 : '0');
+      memhalf`16 = memdoubleword <15 + 8 * [byte] : 8 * [byte]>;
+      GPR(rt) <- if unsigned then
+                     ZeroExtend (memhalf)
+                  else
+                     SignExtend (memhalf)
+   }
+}
+
+unit loadWord (base::reg, rt::reg, offset::bits(16), unsigned::bool) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   if vAddr<1:0> <> '00' then
+      SignalException (AdEL)
+   else
+   {
+      pAddr, CCA = AddressTranslation (vAddr, DATA, LOAD);
+      pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? (ReverseEndian : '00'));
+      memdoubleword = LoadMemory (CCA, WORD, pAddr, vAddr, DATA);
+      byte = vAddr<2:0> ?? (BigEndianCPU : '00');
+      memword`32 = memdoubleword <31 + 8 * [byte] : 8 * [byte]>;
+      GPR(rt) <- if unsigned then
+                     ZeroExtend (memword)
+                  else
+                     SignExtend (memword)
+   }
+}
+
+unit loadDoubleword (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   if vAddr<2:0> <> '000' then
+      SignalException (AdEL)
+   else
+   {
+      pAddr, CCA = AddressTranslation (vAddr, DATA, LOAD);
+      memdoubleword = LoadMemory (CCA, DOUBLEWORD, pAddr, vAddr, DATA);
+      GPR(rt) <- memdoubleword
+   }
+}
+
+--
+
+define Load > LB (base::reg, rt::reg, offset::bits(16)) =
+   loadByte (base, rt, offset, false)
+
+define Load > LBU (base::reg, rt::reg, offset::bits(16)) =
+   loadByte (base, rt, offset, true)
+
+define Load > LH (base::reg, rt::reg, offset::bits(16)) =
+   loadHalf (base, rt, offset, false)
+
+define Load > LHU (base::reg, rt::reg, offset::bits(16)) =
+   loadHalf (base, rt, offset, true)
+
+define Load > LW (base::reg, rt::reg, offset::bits(16)) =
+   loadWord (base, rt, offset, false)
+
+define Load > LWU (base::reg, rt::reg, offset::bits(16)) =
+   loadWord (base, rt, offset, true)
+
+define Load > LL (base::reg, rt::reg, offset::bits(16)) =
+{
+   loadWord (base, rt, offset, false);
+   LLbit <- Some (true)
+}
+
+define Load > LD (base::reg, rt::reg, offset::bits(16)) =
+   loadDoubleword (base, rt, offset)
+
+define Load > LLD (base::reg, rt::reg, offset::bits(16)) =
+{
+   loadDoubleword (base, rt, offset);
+   LLbit <- Some (true)
+}
+
+-----------------------------------
+-- LWL rt, offset(base)
+-----------------------------------
+define Load > LWL (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, LOAD);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   pAddr = if BigEndianMem then pAddr else pAddr && ~0b111;
+   byte = vAddr<1:0> ?? BigEndianCPU^2;
+   word = vAddr<2:2> ?? BigEndianCPU;
+   memdoubleword = LoadMemory (CCA, '0' : byte, pAddr, vAddr, DATA);
+   temp`32 =
+      match word, byte
+      {
+         case 0, 0 => memdoubleword <7:0>   : GPR(rt)<23:0>
+         case 0, 1 => memdoubleword <15:0>  : GPR(rt)<15:0>
+         case 0, 2 => memdoubleword <23:0>  : GPR(rt)<7:0>
+         case 0, 3 => memdoubleword <31:0>
+         case 1, 0 => memdoubleword <39:32> : GPR(rt)<23:0>
+         case 1, 1 => memdoubleword <47:32> : GPR(rt)<15:0>
+         case 1, 2 => memdoubleword <55:32> : GPR(rt)<7:0>
+         case 1, 3 => memdoubleword <63:32>
+      };
+   GPR(rt) <- SignExtend (temp)
+}
+
+-----------------------------------
+-- LWR rt, offset(base)
+-----------------------------------
+define Load > LWR (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, LOAD);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   pAddr = if BigEndianMem then pAddr else pAddr && ~0b111;
+   byte = vAddr<1:0> ?? BigEndianCPU^2;
+   word = vAddr<2:2> ?? BigEndianCPU;
+   memdoubleword = LoadMemory (CCA, WORD - ('0' : byte), pAddr, vAddr, DATA);
+   temp`32 =
+      match word, byte
+      {
+         case 0, 0 =>                  memdoubleword <31:0>
+         case 0, 1 => GPR(rt)<31:24> : memdoubleword <31:8>
+         case 0, 2 => GPR(rt)<31:16> : memdoubleword <31:16>
+         case 0, 3 => GPR(rt)<31:8>  : memdoubleword <31:24>
+         case 1, 0 =>                  memdoubleword <63:32>
+         case 1, 1 => GPR(rt)<31:24> : memdoubleword <63:40>
+         case 1, 2 => GPR(rt)<31:16> : memdoubleword <63:48>
+         case 1, 3 => GPR(rt)<31:8>  : memdoubleword <63:56>
+      };
+   GPR(rt) <- SignExtend (temp)
+   -- alternative specification when byte specification <> 0 is
+   -- GPR(rt)<31:0> <- temp
+}
+
+-----------------------------------
+-- LDL rt, offset(base)
+-----------------------------------
+define Load > LDL (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, LOAD);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   pAddr = if BigEndianMem then pAddr else pAddr && ~0b111;
+   byte = vAddr<2:0> ?? BigEndianCPU^3;
+   memdoubleword = LoadMemory (CCA, byte, pAddr, vAddr, DATA);
+   GPR(rt) <-
+      match byte
+      {
+         case 0 => memdoubleword <7:0>  : GPR(rt)<55:0>
+         case 1 => memdoubleword <15:0> : GPR(rt)<47:0>
+         case 2 => memdoubleword <23:0> : GPR(rt)<39:0>
+         case 3 => memdoubleword <31:0> : GPR(rt)<31:0>
+         case 4 => memdoubleword <39:0> : GPR(rt)<23:0>
+         case 5 => memdoubleword <47:0> : GPR(rt)<15:0>
+         case 6 => memdoubleword <55:0> : GPR(rt)<7:0>
+         case 7 => memdoubleword <63:0>
+      }
+}
+
+-----------------------------------
+-- LDR rt, offset(base)
+-----------------------------------
+define Load > LDR (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, LOAD);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   pAddr = if BigEndianMem then pAddr else pAddr && ~0b111;
+   byte = vAddr<2:0> ?? BigEndianCPU^3;
+   memdoubleword = LoadMemory (CCA, DOUBLEWORD - byte, pAddr, vAddr, DATA);
+   GPR(rt) <-
+      match byte
+      {
+         case 0 =>                  memdoubleword <63:0>
+         case 1 => GPR(rt)<63:56> : memdoubleword <63:8>
+         case 2 => GPR(rt)<63:48> : memdoubleword <63:16>
+         case 3 => GPR(rt)<63:40> : memdoubleword <63:24>
+         case 4 => GPR(rt)<63:32> : memdoubleword <63:32>
+         case 5 => GPR(rt)<63:24> : memdoubleword <63:40>
+         case 6 => GPR(rt)<63:16> : memdoubleword <63:48>
+         case 7 => GPR(rt)<63:8>  : memdoubleword <63:56>
+      }
+}
+
+-----------------------------------
+-- SB rt, offset(base)
+-----------------------------------
+define Store > SB (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, STORE);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   bytesel = vAddr<2:0> ?? BigEndianCPU^3;
+   datadoubleword = GPR(rt) << (0n8 * [bytesel]);
+   StoreMemory (CCA, BYTE, datadoubleword, pAddr, vAddr, DATA)
+}
+
+-----------------------------------
+-- SH rt, offset(base)
+-----------------------------------
+define Store > SH (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   if vAddr<0> then
+      SignalException (AdES)
+   else
+   {
+      pAddr, CCA = AddressTranslation (vAddr, DATA, STORE);
+      pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? (ReverseEndian^2 : '0'));
+      bytesel = vAddr<2:0> ?? (BigEndianCPU^2 : '0');
+      datadoubleword = GPR(rt) << (0n8 * [bytesel]);
+      StoreMemory (CCA, HALFWORD, datadoubleword, pAddr, vAddr, DATA)
+   }
+}
+
+-----------------------------------
+-- SW  rt, offset(base)
+-- SC  rt, offset(base)
+-- SD  rt, offset(base)
+-- SCD rt, offset(base)
+-----------------------------------
+unit storeWord (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   if vAddr<1:0> <> '00' then
+      SignalException (AdES)
+   else
+   {
+      pAddr, CCA = AddressTranslation (vAddr, DATA, STORE);
+      pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? (ReverseEndian : '00'));
+      bytesel = vAddr<2:0> ?? (BigEndianCPU : '00');
+      datadoubleword = GPR(rt) << (0n8 * [bytesel]);
+      StoreMemory (CCA, WORD, datadoubleword, pAddr, vAddr, DATA)
+   }
+}
+
+unit storeDoubleword (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   if vAddr<2:0> <> '000' then
+      SignalException (AdES)
+   else
+   {
+      pAddr, CCA = AddressTranslation (vAddr, DATA, STORE);
+      datadoubleword = GPR(rt);
+      StoreMemory (CCA, DOUBLEWORD, datadoubleword, pAddr, vAddr, DATA)
+   }
+}
+
+--
+
+define Store > SW (base::reg, rt::reg, offset::bits(16)) =
+   storeWord (base, rt, offset)
+
+define Store > SD (base::reg, rt::reg, offset::bits(16)) =
+   storeDoubleword (base, rt, offset)
+
+define Store > SC (base::reg, rt::reg, offset::bits(16)) =
+   match LLbit
+   {
+      case None => #UNPREDICTABLE("SC: LLbit not set")
+      case Some (false) => GPR(rt) <- 0
+      case Some (true) =>
+        {
+           storeWord (base, rt, offset);
+           GPR(rt) <- 1
+        }
+   }
+
+define Store > SCD (base::reg, rt::reg, offset::bits(16)) =
+   match LLbit
+   {
+      case None => #UNPREDICTABLE("SCD: LLbit not set")
+      case Some (false) => GPR(rt) <- 0
+      case Some (true) =>
+        {
+           storeDoubleword (base, rt, offset);
+           GPR(rt) <- 1
+        }
+   }
+
+-----------------------------------
+-- SWL rt, offset(base)
+-----------------------------------
+define Store > SWL (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, STORE);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   pAddr = if BigEndianMem then pAddr else pAddr && ~0b11;
+   byte = vAddr<1:0> ?? BigEndianCPU^2;
+   word = vAddr<2:2> ?? BigEndianCPU;
+   datadoubleword`64 =
+      match byte
+      {
+        case 0 => [GPR(rt)<31:24>]
+        case 1 => [GPR(rt)<31:16>]
+        case 2 => [GPR(rt)<31:8>]
+        case 3 => [GPR(rt)<31:0>]
+      };
+   datadoubleword =
+      if word == '1' then datadoubleword << 32 else datadoubleword;
+   StoreMemory (CCA, [byte], datadoubleword, pAddr, vAddr, DATA)
+}
+
+-----------------------------------
+-- SWR rt, offset(base)
+-----------------------------------
+define Store > SWR (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, STORE);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   pAddr = if BigEndianMem then pAddr else pAddr && ~0b11;
+   byte = vAddr<1:0> ?? BigEndianCPU^2;
+   word = vAddr<2:2> ?? BigEndianCPU;
+   datadoubleword =
+      match word, byte
+      {
+         case 0, 0 => [GPR(rt)<31:0>]
+         case 0, 1 => [GPR(rt)<23:0>] << 8
+         case 0, 2 => [GPR(rt)<15:0>] << 16
+         case 0, 3 => [GPR(rt)<7:0>]  << 24
+         case 1, 0 => [GPR(rt)<31:0>] << 32
+         case 1, 1 => [GPR(rt)<23:0>] << 40
+         case 1, 2 => [GPR(rt)<15:0>] << 48
+         case 1, 3 => [GPR(rt)<7:0>]  << 56
+      };
+   StoreMemory (CCA, WORD - [byte], datadoubleword,  pAddr, vAddr, DATA)
+}
+
+-----------------------------------
+-- SDL rt, offset(base)
+-----------------------------------
+define Store > SDL (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, STORE);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   pAddr = if BigEndianMem then pAddr else pAddr && ~0b111;
+   byte = vAddr<2:0> ?? BigEndianCPU^3;
+   datadoubleword =
+      match byte
+      {
+         case 0 => [GPR(rt)<63:56>]
+         case 1 => [GPR(rt)<63:48>]
+         case 2 => [GPR(rt)<63:40>]
+         case 3 => [GPR(rt)<63:32>]
+         case 4 => [GPR(rt)<63:24>]
+         case 5 => [GPR(rt)<63:16>]
+         case 6 => [GPR(rt)<63:8>]
+         case 7 =>  GPR(rt)
+      };
+   StoreMemory (CCA, byte, datadoubleword,  pAddr, vAddr, DATA)
+}
+
+-----------------------------------
+-- SDR rt, offset(base)
+-----------------------------------
+define Store > SDR (base::reg, rt::reg, offset::bits(16)) =
+{
+   vAddr = SignExtend (offset) + GPR(base);
+   pAddr, CCA = AddressTranslation (vAddr, DATA, STORE);
+   pAddr = pAddr<PSIZE - 1 : 3> : (pAddr<2:0> ?? ReverseEndian^3);
+   pAddr = if BigEndianMem then pAddr else pAddr && ~0b111;
+   byte = vAddr<2:0> ?? BigEndianCPU^3;
+   datadoubleword =
+      match byte
+      {
+         case 0 =>  GPR(rt)
+         case 1 => [GPR(rt)<63:8>]  << 8
+         case 2 => [GPR(rt)<63:16>] << 16
+         case 3 => [GPR(rt)<63:24>] << 24
+         case 4 => [GPR(rt)<63:32>] << 32
+         case 5 => [GPR(rt)<63:40>] << 40
+         case 6 => [GPR(rt)<63:48>] << 48
+         case 7 => [GPR(rt)<63:56>] << 56
+      };
+   StoreMemory (CCA, DOUBLEWORD - byte, datadoubleword,  pAddr, vAddr, DATA)
+}
+
+-----------------------------------
+-- SYNC stype
+-----------------------------------
+define SYNC (stype::bits(5)) = nothing
+
+-----------------------------------
+-- BREAK
+-----------------------------------
+define BREAK = SignalException (Bp)
+
+-----------------------------------
+-- SYSCALL
+-----------------------------------
+define SYSCALL = SignalException (Sys)
+
+-----------------------------------
+-- ERET
+-----------------------------------
+define ERET =
+{
+   if CP0.Status.ERL then
+   {
+      PC <- CP0.ErrorEPC;
+      CP0.Status.ERL <- false
+   }
+   else
+   {
+      PC <- CP0.EPC;
+      CP0.Status.EXL <- false
+   };
+   LLbit <- Some (false)
+}
+
+-----------------------------------
+-- MTC0 rt, rd
+-- MTC0 rt, rd, sel
+-----------------------------------
+define CP > MTC0 (rt::reg, rd::reg, sel::bits(3)) =
+   -- Will need adapting for EntryLo1 and EntryLo0
+   CPR (0, rd, sel) <- GPR(rt)
+
+-----------------------------------
+-- DMTC0 rt, rd
+-- DMTC0 rt, rd, sel
+-----------------------------------
+define CP > DMTC0 (rt::reg, rd::reg, sel::bits(3)) =
+   CPR (0, rd, sel) <- GPR(rt)
+
+-----------------------------------
+-- MFC0 rt, rd
+-- MFC0 rt, rd, sel
+-----------------------------------
+define CP > MFC0 (rt::reg, rd::reg, sel::bits(3)) =
+   -- Will need adapting for EntryLo1 and EntryLo0
+   GPR(rt) <- SignExtend (CPR (0, rd, sel)<32:0>)
+
+-----------------------------------
+-- DMFC0 rt, rd
+-- DMFC0 rt, rd, sel
+-----------------------------------
+define CP > DMFC0 (rt::reg, rd::reg, sel::bits(3)) =
+   GPR(rt) <- CPR (0, rd, sel)
+
+-----------------------------------
+-- J target
+-----------------------------------
+define Branch > J (instr_index::bits(26)) =
+   BranchStatus <- Some (PC<63:28> : instr_index : '00')
+
+-----------------------------------
+-- JAL target
+-----------------------------------
+define Branch > JAL (instr_index::bits(26)) =
+{
+   GPR(31) <- PC + 8;
+   BranchStatus <- Some (PC<63:28> : instr_index : '00')
+}
+
+-----------------------------------
+-- JR rs
+-----------------------------------
+define Branch > JR (rs::reg) =
+   BranchStatus <- Some (GPR(rs))
+
+-----------------------------------
+-- JALR rs (rd = 31 implied)
+-- JALR rd, rs
+-----------------------------------
+define Branch > JALR (rs::reg, rd::reg) =
+{
+   temp = GPR(rs);
+   GPR(rd) <- PC + 8;
+   BranchStatus <- Some (temp)
+}
+
+-----------------------------------
+-- BEQ rs, rt, offset
+-----------------------------------
+define Branch > BEQ (rs::reg, rt::reg, offset::bits(16)) =
+   when GPR(rs) == GPR(rt) do
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+
+-----------------------------------
+-- BNE rs, rt, offset
+-----------------------------------
+define Branch > BNE (rs::reg, rt::reg, offset::bits(16)) =
+   when GPR(rs) <> GPR(rt) do
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+
+-----------------------------------
+-- BLEZ rs, offset
+-----------------------------------
+define Branch > BLEZ (rs::reg, offset::bits(16)) =
+   when GPR(rs) <= 0 do
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+
+-----------------------------------
+-- BGTZ rs, offset
+-----------------------------------
+define Branch > BGTZ (rs::reg, offset::bits(16)) =
+   when GPR(rs) > 0 do
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+
+-----------------------------------
+-- BLTZ rs, offset
+-----------------------------------
+define Branch > BLTZ (rs::reg, offset::bits(16)) =
+   when GPR(rs) < 0 do
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+
+-----------------------------------
+-- BGEZ rs, offset
+-----------------------------------
+define Branch > BGEZ (rs::reg, offset::bits(16)) =
+   when GPR(rs) >= 0 do
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+
+-----------------------------------
+-- BLTZAL rs, offset
+-----------------------------------
+define Branch > BLTZAL (rs::reg, offset::bits(16)) =
+{
+   temp = GPR(rs);
+   GPR(31) <- PC + 8;
+   when temp < 0 do
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+}
+
+-----------------------------------
+-- BGEZAL rs, offset
+-----------------------------------
+define Branch > BGEZAL (rs::reg, offset::bits(16)) =
+{
+   temp = GPR(rs);
+   GPR(31) <- PC + 8;
+   when temp >= 0 do
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+}
+
+-----------------------------------
+-- BEQL rs, rt, offset
+-----------------------------------
+define Branch > BEQL (rs::reg, rt::reg, offset::bits(16)) =
+   if GPR(rs) == GPR(rt) then
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+   else
+      PC <- PC + 4
+
+-----------------------------------
+-- BNEL rs, rt, offset
+-----------------------------------
+define Branch > BNEL (rs::reg, rt::reg, offset::bits(16)) =
+   if GPR(rs) <> GPR(rt) then
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+   else
+      PC <- PC + 4
+
+-----------------------------------
+-- BLEZL rs, offset
+-----------------------------------
+define Branch > BLEZL (rs::reg, offset::bits(16)) =
+   if GPR(rs) <= 0 then
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+   else
+      PC <- PC + 4
+
+-----------------------------------
+-- BGTZL rs, offset
+-----------------------------------
+define Branch > BGTZL (rs::reg, offset::bits(16)) =
+   if GPR(rs) > 0 then
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+   else
+      PC <- PC + 4
+
+-----------------------------------
+-- BLTZL rs, offset
+-----------------------------------
+define Branch > BLTZL (rs::reg, offset::bits(16)) =
+   if GPR(rs) < 0 then
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+   else
+      PC <- PC + 4
+
+-----------------------------------
+-- BGEZL rs, offset
+-----------------------------------
+define Branch > BGEZL (rs::reg, offset::bits(16)) =
+   if GPR(rs) >= 0 then
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+   else
+      PC <- PC + 4
+
+-----------------------------------
+-- BLTZALL rs, offset
+-----------------------------------
+define Branch > BLTZALL (rs::reg, offset::bits(16)) =
+{
+   temp = GPR(rs);
+   GPR(31) <- PC + 8;
+   if temp < 0 then
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+   else
+      PC <- PC + 4
+}
+
+-----------------------------------
+-- BGEZALL rs, offset
+-----------------------------------
+define Branch > BGEZALL (rs::reg, offset::bits(16)) =
+{
+   temp = GPR(rs);
+   GPR(31) <- PC + 8;
+   if temp >= 0 then
+      BranchStatus <- Some (PC + SignExtend (offset) << 2)
+   else
+      PC <- PC + 4
+}
+
+-----------------------------------
+-- Rerserved instruction, i.e. unsuccessful decode.
+-----------------------------------
+define ReservedInstruction =
+   SignalException (RI)
+
+define Run
+
+-------------------------------------------------------
+-- Not implemented:
+--
+-- LWCz, SWCz, MTCz, MFCz, CTCz, CFCz, COPz, BCzT, BCzF
+-- DMFCz, DMTCz, LDCz, SDCz
+-- BCzTL, BCzFL
+-- TLBR, TLBWI, TLBWR, TLBP, CACHE
+-- Floating-point
+-------------------------------------------------------
+
+--================================================
+-- Instruction decoding
+--================================================
+
+instruction Decode (w::word) =
+   match w
+   {
+      case '000 000 rs rt rd imm5 function' =>
+         match function
+         {
+            case '000 000' => Shift (SLL (rt, rd, imm5))
+            case '000 010' => Shift (SRL (rt, rd, imm5))
+            case '000 011' => Shift (SRA (rt, rd, imm5))
+            case '000 100' => Shift (SLLV (rs, rt, rd))
+            case '000 110' => Shift (SRLV (rs, rt, rd))
+            case '000 111' => Shift (SRAV (rs, rt, rd))
+            case '001 000' => Branch (JR (rs))
+            case '001 001' => Branch (JALR (rs, rd))
+            case '001 100' => SYSCALL
+            case '001 101' => BREAK
+            case '001 111' => SYNC (imm5)
+            case '010 000' => MultDiv (MFHI (rd))
+            case '010 001' => MultDiv (MTHI (rd))
+            case '010 010' => MultDiv (MFLO (rs))
+            case '010 011' => MultDiv (MTLO (rs))
+            case '010 100' => Shift (DSLLV (rs, rt, rd))
+            case '010 110' => Shift (DSRLV (rs, rt, rd))
+            case '010 111' => Shift (DSRAV (rs, rt, rd))
+            case '011 000' => MultDiv (MULT (rs, rt))
+            case '011 001' => MultDiv (MULTU (rs, rt))
+            case '011 010' => MultDiv (DIV (rs, rt))
+            case '011 011' => MultDiv (DIVU (rs, rt))
+            case '011 100' => MultDiv (DMULT (rs, rt))
+            case '011 101' => MultDiv (DMULTU (rs, rt))
+            case '011 110' => MultDiv (DDIV (rs, rt))
+            case '011 111' => MultDiv (DDIVU (rs, rt))
+            case '100 000' => ArithR (ADD (rs, rt, rd))
+            case '100 001' => ArithR (ADDU (rs, rt, rd))
+            case '100 010' => ArithR (SUB (rs, rt, rd))
+            case '100 011' => ArithR (SUBU (rs, rt, rd))
+            case '100 100' => ArithR (AND (rs, rt, rd))
+            case '100 101' => ArithR (OR (rs, rt, rd))
+            case '100 110' => ArithR (XOR (rs, rt, rd))
+            case '100 111' => ArithR (NOR (rs, rt, rd))
+            case '101 010' => ArithR (SLT (rs, rt, rd))
+            case '101 011' => ArithR (SLTU (rs, rt, rd))
+            case '101 100' => ArithR (DADD (rs, rt, rd))
+            case '101 101' => ArithR (DADDU (rs, rt, rd))
+            case '101 110' => ArithR (DSUB (rs, rt, rd))
+            case '101 111' => ArithR (DSUBU (rs, rt, rd))
+            case '110 000' => Trap (TGE (rs, rt))
+            case '110 001' => Trap (TGEU (rs, rt))
+            case '110 010' => Trap (TLT (rs, rt))
+            case '110 011' => Trap (TLTU (rs, rt))
+            case '110 100' => Trap (TEQ (rs, rt))
+            case '110 110' => Trap (TNE (rs, rt))
+            case '111 000' => Shift (DSLL (rt, rd, imm5))
+            case '111 010' => Shift (DSRL (rt, rd, imm5))
+            case '111 011' => Shift (DSRA (rt, rd, imm5))
+            case '111 100' => Shift (DSLL32 (rt, rd, imm5))
+            case '111 110' => Shift (DSRL32 (rt, rd, imm5))
+            case '111 111' => Shift (DSRA32 (rt, rd, imm5))
+            case _ => ReservedInstruction
+         }
+      case '000 001 rs function immediate' =>
+         match function
+         {
+            case '00 000' => Branch (BLTZ (rs, immediate))
+            case '00 001' => Branch (BGEZ (rs, immediate))
+            case '00 010' => Branch (BLTZL (rs, immediate))
+            case '00 011' => Branch (BGEZL (rs, immediate))
+            case '01 000' => Trap (TGEI (rs, immediate))
+            case '01 001' => Trap (TGEIU (rs, immediate))
+            case '01 010' => Trap (TLTI (rs, immediate))
+            case '01 011' => Trap (TLTIU (rs, immediate))
+            case '01 100' => Trap (TEQI (rs, immediate))
+            case '01 110' => Trap (TNEI (rs, immediate))
+            case '10 000' => Branch (BLTZAL (rs, immediate))
+            case '10 001' => Branch (BGEZAL (rs, immediate))
+            case '10 010' => Branch (BLTZALL (rs, immediate))
+            case '10 011' => Branch (BGEZALL (rs, immediate))
+            case _ => ReservedInstruction
+         }
+      case '000 010 immediate' => Branch (J (immediate))
+      case '000 011 immediate' => Branch (JAL (immediate))
+      case '010 000 function rt rd 00000000 sel' =>
+         match function
+         {
+            case '00 000' => CP (MFC0 (rt, rd, sel))
+            case '00 001' => CP (DMFC0 (rt, rd, sel))
+            case '00 100' => CP (MTC0 (rt, rd, sel))
+            case '00 101' => CP (DMTC0 (rt, rd, sel))
+            case _ => ReservedInstruction
+         }
+      case 'function rs rt immediate' =>
+         match function
+         {
+            case '000 100' => Branch (BEQ (rs, rt, immediate))
+            case '000 101' => Branch (BNE (rs, rt, immediate))
+            case '000 110' => Branch (BLEZ (rs, immediate))
+            case '000 111' => Branch (BGTZ (rs, immediate))
+            case '001 000' => ArithI (ADDI (rs, rt, immediate))
+            case '001 001' => ArithI (ADDIU (rs, rt, immediate))
+            case '001 010' => ArithI (SLTI (rs, rt, immediate))
+            case '001 011' => ArithI (SLTIU (rs, rt, immediate))
+            case '001 100' => ArithI (ANDI (rs, rt, immediate))
+            case '001 101' => ArithI (ORI (rs, rt, immediate))
+            case '001 110' => ArithI (XORI (rs, rt, immediate))
+            case '001 111' => ArithI (LUI (rt, immediate))
+            case '010 100' => Branch (BEQL (rs, rt, immediate))
+            case '010 101' => Branch (BNEL (rs, rt, immediate))
+            case '010 110' => Branch (BLEZL (rs, immediate))
+            case '010 111' => Branch (BGTZL (rs, immediate))
+            case '011 000' => ArithI (DADDI (rs, rt, immediate))
+            case '011 001' => ArithI (DADDIU (rs, rt, immediate))
+            case '011 010' => Load (LDL (rs, rt, immediate))
+            case '011 011' => Load (LDR (rs, rt, immediate))
+            case '100 000' => Load (LB (rs, rt, immediate))
+            case '100 001' => Load (LH (rs, rt, immediate))
+            case '100 010' => Load (LWL (rs, rt, immediate))
+            case '100 011' => Load (LW (rs, rt, immediate))
+            case '100 100' => Load (LBU (rs, rt, immediate))
+            case '100 101' => Load (LHU (rs, rt, immediate))
+            case '100 110' => Load (LWR (rs, rt, immediate))
+            case '100 111' => Load (LWU (rs, rt, immediate))
+            case '101 000' => Store (SB (rs, rt, immediate))
+            case '101 001' => Store (SH (rs, rt, immediate))
+            case '101 010' => Store (SWL (rs, rt, immediate))
+            case '101 011' => Store (SW (rs, rt, immediate))
+            case '101 100' => Store (SDL (rs, rt, immediate))
+            case '101 101' => Store (SDR (rs, rt, immediate))
+            case '101 110' => Store (SWR (rs, rt, immediate))
+            case '110 000' => Load (LL (rs, rt, immediate))
+            case '110 100' => Load (LLD (rs, rt, immediate))
+            case '110 111' => Load (LD (rs, rt, immediate))
+            case '111 000' => Store (SC (rs, rt, immediate))
+            case '111 100' => Store (SCD (rs, rt, immediate))
+            case '111 111' => Store (SD (rs, rt, immediate))
+            case _ => ReservedInstruction
+         }
+   }
+
+--================================================
+-- The next state function
+--================================================
+
+word Fetch =
+{
+   vAddr = PC;
+   pAddr, CCA = AddressTranslation (vAddr, INSTRUCTION, LOAD);
+   memdoubleword = LoadMemory (CCA, WORD, pAddr, vAddr, INSTRUCTION);
+   bytesel = vAddr<2:0> ?? (BigEndianCPU : '00');
+   memword = memdoubleword <31 + 8 * [bytesel] : 8 * [bytesel]>;
+   return memword
+}
+
+unit Next =
+{
+   bstatus = BranchStatus;
+   i = Decode (Fetch);
+   BranchStatus <- None;
+   Run (i);
+   match bstatus
+   {
+      case Some (addr) =>
+        if IsSome (BranchStatus) then
+           #UNPREDICTABLE("Branch follows branch")
+        else
+           PC <- addr
+      case None => nothing
+   };
+   PC <- PC + 4;
+   CP0.Count <- CP0.Count + 1
+}
+
+{-
+Testing
+
+Runtime.LoadF "mips.spec"
+
+  Runtime.evalQ`
+    {
+      CP0.Config.BE <- true;
+      CP0.Config.BE <- false;
+      CP0.Status.RE <- false;
+      CP0.Status.RE <- true;
+      CP0.Status.KSU <- '10';
+      CP0.Status.EXL <- false;
+      CP0.Status.ERL <- false;
+      GPR(1) <- 0x1122_3344_5566_7788;
+      GPR(2) <- 0;
+      MEM <- InitMap(0xCC)
+    }`
+
+  Runtime.evalQ `BigEndianCPU`
+
+  Runtime.evalQ `Run (Store (SD (2, 1, 0)))`
+  Runtime.evalQ `Run (Store (SD (2, 1, 8)))`
+
+  Runtime.evalQ `Run (Store (SW (2, 1, 0)))`
+  Runtime.evalQ `Run (Store (SW (2, 1, 4)))`
+  Runtime.evalQ `Run (Store (SW (2, 1, 8)))`
+
+  Runtime.evalQ `Run (Store (SH (2, 1, 0)))`
+  Runtime.evalQ `Run (Store (SH (2, 1, 2)))`
+  Runtime.evalQ `Run (Store (SH (2, 1, 4)))`
+  Runtime.evalQ `Run (Store (SH (2, 1, 6)))`
+
+  Runtime.evalQ `Run (Store (SB (2, 1, 0)))`
+  Runtime.evalQ `Run (Store (SB (2, 1, 1)))`
+  Runtime.evalQ `Run (Store (SB (2, 1, 2)))`
+  Runtime.evalQ `Run (Store (SB (2, 1, 3)))`
+  Runtime.evalQ `Run (Store (SB (2, 1, 4)))`
+
+  Runtime.evalQ `MEM(0)`;
+  Runtime.evalQ `MEM(1)`;
+  Runtime.evalQ `MEM(2)`;
+  Runtime.evalQ `MEM(3)`;
+  Runtime.evalQ `MEM(4)`;
+  Runtime.evalQ `MEM(5)`;
+  Runtime.evalQ `MEM(6)`;
+  Runtime.evalQ `MEM(7)`;
+  Runtime.evalQ `MEM(8)`;
+  Runtime.evalQ `MEM(9)`;
+  Runtime.evalQ `MEM(10)`;
+  Runtime.evalQ `MEM(11)`;
+  Runtime.evalQ `MEM(12)`;
+  Runtime.evalQ `MEM(13)`;
+  Runtime.evalQ `MEM(14)`;
+  Runtime.evalQ `MEM(15)`;
+  Runtime.evalQ `MEM(16)`;
+
+  Runtime.evalQ `MEM`;
+
+Runtime.LoadF "mips.spec"
+HolExport.spec ("mips.spec", "mips")
+
+-}
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/Makefile acl2-6.3/books/translators/l3-to-acl2/examples/thacker/Makefile
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/Makefile	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,104 @@
+# Note that ACL2 and ACL2_SYSTEM_BOOKS should be defined, e.g.:
+# bash
+# ACL2_DIR=/Users/kaufmann/acl2/v6-2/acl2-sources
+# export ACL2=${ACL2_DIR}/saved_acl2
+# export ACL2_SYSTEM_BOOKS=${ACL2_DIR}/books
+
+# WARNING: Do not run with -j (unless it's -j 1)!  Otherwise you may
+# get errors.  (Note from Matt K.: I've tried, but I can't seem to
+# figure out why file tiny.lisp can be created more than once when -j
+# is supplied a value greater than 1.)
+
+# Given the warning above, I'm not going to try to support provisional
+# certification for this directory.
+
+override ACL2_PCERT =
+
+top: all run-check.txt run-test
+
+include $(ACL2_SYSTEM_BOOKS)/Makefile-generic
+# See the end for dependencies -- we don't auto-generate
+# Makefile-deps, because tiny.lisp and tiny-logic.lisp are generated
+# files.
+# -include Makefile-deps
+
+L3_TO_ACL2_DIR ?= $(shell cd ../../translator/ ; pwd)
+
+BOOKS = tiny run tiny-logic tiny-manual
+
+tiny.lisp: ../../translator/l3-to-acl2.cert tiny-acl2.txt
+	@echo '####################'
+	@echo 'Creating file $@'
+	@echo '(include-book "$(L3_TO_ACL2_DIR)/l3-to-acl2")' > workxxx.$@
+	@echo '(l3-to-acl2 "tiny-acl2.txt" "tiny.lisp"' >> workxxx.$@
+	@echo '            :str-to-sym' >> workxxx.$@
+	@echo '            (quote (("PC" . pctr) ("alu" . alu_var) ("function" . function0))))' >> workxxx.$@
+	@$(ACL2) < workxxx.$@ > $@.out
+	@echo "diff tiny.lisp gold/tiny.lisp --ignore-matching-lines='(INCLUDE-BOOK' --ignore-matching-lines='/l3'"
+	@diff tiny.lisp gold/tiny.lisp --ignore-matching-lines='(INCLUDE-BOOK' --ignore-matching-lines='/l3'
+	@echo "Successfully built $@"
+
+tiny-logic.lisp: ../../translator/l3-to-acl2.cert tiny-acl2.txt
+	@echo '####################'
+	@echo 'Creating file $@'
+	@echo '(include-book "$(L3_TO_ACL2_DIR)/l3-to-acl2")' > workxxx.$@
+	@echo '(l3-to-acl2 "tiny-acl2.txt" "tiny-logic.lisp"' >> workxxx.$@
+	@echo '            :logic :logic-only' >> workxxx.$@
+	@echo '            :str-to-sym' >> workxxx.$@
+	@echo '            (quote (("PC" . pctr) ("alu" . alu_var) ("function" . function0))))' >> workxxx.$@
+	@$(ACL2) < workxxx.$@ > $@.out
+	@echo "diff tiny-logic.lisp gold/tiny-logic.lisp --ignore-matching-lines='(INCLUDE-BOOK' --ignore-matching-lines='/l3'"
+	@diff tiny-logic.lisp gold/tiny-logic.lisp --ignore-matching-lines='(INCLUDE-BOOK' --ignore-matching-lines='/l3'
+	@echo "Successfully built $@"
+
+run-check.txt: run.cert
+	@echo '####################'
+	@echo 'Checking that the model runs as expected.'
+	@echo '(include-book "run")' > workxxx.$@
+	@echo '(run-output st$$ state)' >> workxxx.$@
+	@$(ACL2) < workxxx.$@ > run-check.out
+	@echo "diff run-check.txt gold/run-check.txt"
+	@diff run-check.txt gold/run-check.txt
+	@echo "Successfully completed $@"
+
+run-test.out: run.cert
+	@echo '####################'
+	@echo "Running :program mode test (from auto-generated tiny.lisp):"
+	@-rm -f workxxx.$@
+	@./run-test.sh $@
+
+run-test-logic.out: run.cert tiny-logic.cert
+	@echo '####################'
+	@echo "Running :logic mode test (from auto-generated tiny-logic.lisp):"
+	@echo '(include-book "tiny-logic")' > workxxx.$@
+	@./run-test.sh $@
+
+run-test-guard-verified.out: run.cert tiny-manual.cert
+	@echo '####################'
+	@echo "Running test for guard-verified functions (from"
+	@echo "manually produced tiny-manual.lisp):"
+	@echo '(include-book "tiny-manual")' > workxxx.$@
+	@./run-test.sh $@
+
+# We use recursive calls of make below so that even if -j is used,
+# they are run sequentially -- so that their output isn't interleaved.
+run-test:
+	@$(MAKE) run-test.out
+	@$(MAKE) run-test-logic.out
+	@$(MAKE) run-test-guard-verified.out
+
+clean: clean-more
+
+clean-more:
+	rm -f tiny.lisp tiny-logic.lisp run-check.txt
+
+# Dependencies for generated files:
+
+tiny.cert: tiny.lisp
+tiny-logic.cert: tiny-logic.lisp
+
+# From Makefile-deps generated after a manual cleaning:
+
+run.cert: tiny.cert
+
+tiny-manual.cert: ../../translator/l3.cert
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/README acl2-6.3/books/translators/l3-to-acl2/examples/thacker/README
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/README	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,24 @@
+Files in this directory (see notes below for further explanation):
+
+Makefile           support for using "make" to certify books
+README             this README
+gold/              some saved results:
+  mail.txt           saved result from Anthony Fox
+  run-check.out      result from our run, which compares with mail.txt
+  tiny.lisp          :program mode, auto-generated tiny.lisp
+  tiny-logic.lisp    :logic mode, auto-generated tiny.lisp
+l3-run             (not used here) from Anthony Fox, for running HOL4 model
+run.lisp           support for running the translated model
+tiny-acl2.txt      input for translator from Anthony Fox, produced from tiny.spec
+tiny-manual.lisp   guard-verified, manually-generated version of tiny.lisp
+... and these files from Anthony Fox, not used here:
+  tiny.spec          Thacker L3 example
+  tinyScript.sml     original form for tiny-acl2.txt
+  tinyTheory.sig     HOL4 code generated from tiny.spec
+
+See ../../README for instructions and explanation.
+
+Run "make clean" to clean.  Sorry about some issues, which might be
+cleaned up later:
+- Errors from egrep
+- Rebuilding of some other stuff
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/gold/mail.txt acl2-6.3/books/translators/l3-to-acl2/examples/thacker/gold/mail.txt
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/gold/mail.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/gold/mail.txt	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,85 @@
+from:	 Anthony Fox <acjf3@cam.ac.uk>
+to:	 Matt Kaufmann <matthew.j.kaufmann@gmail.com>
+date:	 Tue, Jul 2, 2013 at 7:48 AM
+subject:	 Re: test message
+mailed-by:	 cam.ac.uk
+
+Hi Matt,
+
+Here's an updated version of the Tiny example. This defines an initialisation function and has a very basic test program. (For reference, the SML code for running this is l3-run.) The printed output of a run (the value of the strobe) is:
+
+0
+1
+2
+3
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+7 [1010]
+8
+Done.
+
+Examining the final state shows that the first registers have value:
+
+R(0): 0
+R(1): 1010
+R(2): 1010
+R(3): 4
+R(4): 0
+
+The memory satisfies:
+
+0: 16777216
+1: 50332648
+2: 83887090
+3: 117440516
+4: 33686785
+5: 134351632
+6: 134610950
+7: 33685507
+8: 7
+
+
+1000: 1000
+1001: 1001
+1002: 1002
+1003: 1003
+1004: 1004
+1005: 1005
+1006: 1006
+1007: 1007
+1008: 1008
+1009: 1009
+1010: 0
+
+I've also included our x86-64 L3 model.
+
+Cheers,
+Anthony
+
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/gold/run-check.txt acl2-6.3/books/translators/l3-to-acl2/examples/thacker/gold/run-check.txt
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/gold/run-check.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/gold/run-check.txt	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,64 @@
+
+0
+1
+2
+3
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+6
+4
+5
+7
+ [1010]
+8
+Final state (34 steps):
+((:DM :DEFAULT 0
+      ((1000 1000)
+       (1001 1001)
+       (1002 1002)
+       (1003 1003)
+       (1004 1004)
+       (1005 1005)
+       (1006 1006)
+       (1007 1007)
+       (1008 1008)
+       (1009 1009)))
+ (:IM :DEFAULT 7
+      ((0 16777216)
+       (1 50332648)
+       (2 83887090)
+       (3 117440516)
+       (4 33686785)
+       (5 134351632)
+       (6 134610950)
+       (7 33685507)))
+ (:INDATA 0)
+ (:INRDY NIL)
+ (:OUTSTROBE 1010)
+ (:PCTR 8)
+ (:R :DEFAULT 0 ((1 1010) (2 1010) (3 4)))
+ (:EXCEPTION NIL))
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/gold/tiny-logic.lisp acl2-6.3/books/translators/l3-to-acl2/examples/thacker/gold/tiny-logic.lisp
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/gold/tiny-logic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/gold/tiny-logic.lisp	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,434 @@
+(IN-PACKAGE "ACL2")
+
+(VALUE-TRIPLE
+     '(:GENERATED-BY (L3-TO-ACL2 "tiny-acl2.txt" "tiny-logic.lisp"
+                                 :LOGIC :LOGIC-ONLY
+                                 :STR-TO-SYM '(("PC" . PCTR)
+                                               ("alu" . ALU_VAR)
+                                               ("function" . FUNCTION0)))))
+
+(INCLUDE-BOOK "/Users/kaufmann/projects/l3-to-acl2/translator/l3")
+
+(CONSTRUCT FUNCT
+           (FADD FSUB FINC FDEC FAND FOR FXOR FRESERVED))
+
+(CONSTRUCT SHIFTT (NOSHIFT RCY1 RCY8 RCY16))
+
+(CONSTRUCT CONDITIONT
+           (SKIPNEVER SKIPNEG SKIPZERO SKIPINRDY))
+
+(CONSTRUCT INSTRUCTION
+           ((IN (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                       (UNSIGNED-BYTE 7)
+                       (UNSIGNED-BYTE 7)))
+            (JUMP (FUNCT SHIFTT (UNSIGNED-BYTE 7)
+                         (UNSIGNED-BYTE 7)
+                         (UNSIGNED-BYTE 7)))
+            (LOADCONSTANT ((UNSIGNED-BYTE 7) (UNSIGNED-BYTE 24)))
+            (LOADDM (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                           (UNSIGNED-BYTE 7)
+                           (UNSIGNED-BYTE 7)))
+            (NORMAL (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                           (UNSIGNED-BYTE 7)
+                           (UNSIGNED-BYTE 7)))
+            (OUT (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                        (UNSIGNED-BYTE 7)
+                        (UNSIGNED-BYTE 7)))
+            RESERVEDINSTR
+            (STOREDM (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                            (UNSIGNED-BYTE 7)
+                            (UNSIGNED-BYTE 7)))
+            (STOREIM (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                            (UNSIGNED-BYTE 7)
+                            (UNSIGNED-BYTE 7)))))
+
+(CONSTRUCT EXCEPTION (NOEXCEPTION RESERVED))
+
+(DEFSTOBJ+ ST$
+           (DM :TYPE (ARRAY (UNSIGNED-BYTE 32) (1024))
+               :INITIALLY 0)
+           (IM :TYPE (ARRAY (UNSIGNED-BYTE 32) (1024))
+               :INITIALLY 0)
+           (INDATA :TYPE (UNSIGNED-BYTE 32)
+                   :INITIALLY 0)
+           (INRDY :TYPE (SATISFIES BOOLEANP))
+           (OUTSTROBE :TYPE (UNSIGNED-BYTE 32)
+                      :INITIALLY 0)
+           (PCTR :TYPE (UNSIGNED-BYTE 10)
+                 :INITIALLY 0)
+           (R :TYPE (ARRAY (UNSIGNED-BYTE 32) (128))
+              :INITIALLY 0)
+           EXCEPTION)
+
+(VALUE-TRIPLE "See l3.lisp for the definition of raise-exception")
+
+(SET-VERIFY-GUARDS-EAGERNESS 0)
+
+(DEFUN-STRUCT FUNCTION0
+              (((FUNC (TYPE-FUNCT FUNC))
+                (A (UNSIGNED-BYTE-P 32 A))
+                (B (UNSIGNED-BYTE-P 32 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (CASE-MATCH+ FUNC ('FADD (MV (N+ 32 A B) ST$))
+                           ('FSUB (MV (N- 32 A B) ST$))
+                           ('FINC (MV (N+ 32 B 1) ST$))
+                           ('FDEC (MV (N- 32 B 1) ST$))
+                           ('FAND (MV (LOGAND A B) ST$))
+                           ('FOR (MV (LOGIOR A B) ST$))
+                           ('FXOR (MV (LOGXOR A B) ST$))
+                           (& (RAISE-EXCEPTION 'RESERVED
+                                               (ARB (UNSIGNED-BYTE 32))
+                                               ST$))))
+
+(DEFUN-STRUCT SHIFTER
+              (((SHIFT (TYPE-SHIFTT SHIFT))
+                (A (UNSIGNED-BYTE-P 32 A))))
+              (CASE-MATCH+ SHIFT ('NOSHIFT A)
+                           ('RCY1 (ASH A -1))
+                           ('RCY8 (ASH A -8))
+                           ('RCY16 (ASH A -16))
+                           (& (ASSERT! NIL (ARB (UNSIGNED-BYTE 32))))))
+
+(DEFUN-STRUCT ALU
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (A (UNSIGNED-BYTE-P 32 A))
+                (B (UNSIGNED-BYTE-P 32 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (MV-LET (V ST$)
+                      (FUNCTION0 (TUPLE FUNC A B) ST$)
+                      (MV (SHIFTER (TUPLE SHIFT V)) ST$)))
+
+(DEFUN-STRUCT
+   INCPC
+   (((SKIP (TYPE-CONDITIONT SKIP))
+     (ALU_VAR (UNSIGNED-BYTE-P 32 ALU_VAR)))
+    ST$)
+   (DECLARE (XARGS :STOBJS ST$))
+   (CASE-MATCH+ SKIP
+                ('SKIPNEVER
+                 (LET ((ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$) 1) ST$)))
+                      (MV (UNIT-VALUE) ST$)))
+                ('SKIPNEG
+                 (LET ((ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$)
+                                             (IF (< ALU_VAR 0) 2 1))
+                                         ST$)))
+                      (MV (UNIT-VALUE) ST$)))
+                ('SKIPZERO
+                 (LET ((ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$)
+                                             (IF (EQL ALU_VAR 0) 2 1))
+                                         ST$)))
+                      (MV (UNIT-VALUE) ST$)))
+                ('SKIPINRDY
+                 (LET ((ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$) (IF (INRDY ST$) 2 1))
+                                         ST$)))
+                      (MV (UNIT-VALUE) ST$)))
+                (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+
+(DEFUN-STRUCT NORM
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (SKIP (TYPE-CONDITIONT SKIP))
+                (WBACK (BOOLEANP WBACK))
+                (STROBE (BOOLEANP STROBE))
+                (W (UNSIGNED-BYTE-P 7 W))
+                (A (UNSIGNED-BYTE-P 7 A))
+                (B (UNSIGNED-BYTE-P 7 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (MV-LET (V ST$)
+                      (ALU (TUPLE FUNC SHIFT (RI A ST$) (RI B ST$))
+                           ST$)
+                      (LET* ((ST$ (IF WBACK (UPDATE-RI W V ST$) ST$))
+                             (ST$ (IF STROBE (UPDATE-OUTSTROBE V ST$)
+                                      ST$)))
+                            (INCPC (TUPLE SKIP V) ST$))))
+
+(DEFUN-STRUCT DFN-NORMAL
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (SKIP (TYPE-CONDITIONT SKIP))
+                (W (UNSIGNED-BYTE-P 7 W))
+                (A (UNSIGNED-BYTE-P 7 A))
+                (B (UNSIGNED-BYTE-P 7 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (NORM (TUPLE FUNC SHIFT SKIP (TRUE)
+                           (FALSE)
+                           W A B)
+                    ST$))
+
+(DEFUN-STRUCT
+     DFN-STOREDM
+     (((FUNC (TYPE-FUNCT FUNC))
+       (SHIFT (TYPE-SHIFTT SHIFT))
+       (SKIP (TYPE-CONDITIONT SKIP))
+       (W (UNSIGNED-BYTE-P 7 W))
+       (A (UNSIGNED-BYTE-P 7 A))
+       (B (UNSIGNED-BYTE-P 7 B)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET ((ST$ (UPDATE-DMI (CAST ((UNSIGNED-BYTE 32) (UNSIGNED-BYTE 10))
+                                  (RI B ST$))
+                            (RI A ST$)
+                            ST$)))
+          (NORM (TUPLE FUNC SHIFT SKIP (TRUE)
+                       (FALSE)
+                       W A B)
+                ST$)))
+
+(DEFUN-STRUCT
+     DFN-STOREIM
+     (((FUNC (TYPE-FUNCT FUNC))
+       (SHIFT (TYPE-SHIFTT SHIFT))
+       (SKIP (TYPE-CONDITIONT SKIP))
+       (W (UNSIGNED-BYTE-P 7 W))
+       (A (UNSIGNED-BYTE-P 7 A))
+       (B (UNSIGNED-BYTE-P 7 B)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET ((ST$ (UPDATE-IMI (CAST ((UNSIGNED-BYTE 32) (UNSIGNED-BYTE 10))
+                                  (RI B ST$))
+                            (RI A ST$)
+                            ST$)))
+          (NORM (TUPLE FUNC SHIFT SKIP (TRUE)
+                       (FALSE)
+                       W A B)
+                ST$)))
+
+(DEFUN-STRUCT DFN-OUT
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (SKIP (TYPE-CONDITIONT SKIP))
+                (W (UNSIGNED-BYTE-P 7 W))
+                (A (UNSIGNED-BYTE-P 7 A))
+                (B (UNSIGNED-BYTE-P 7 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (NORM (TUPLE FUNC SHIFT SKIP (TRUE)
+                           (TRUE)
+                           W A B)
+                    ST$))
+
+(DEFUN-STRUCT
+     DFN-LOADDM
+     (((FUNC (TYPE-FUNCT FUNC))
+       (SHIFT (TYPE-SHIFTT SHIFT))
+       (SKIP (TYPE-CONDITIONT SKIP))
+       (W (UNSIGNED-BYTE-P 7 W))
+       (A (UNSIGNED-BYTE-P 7 A))
+       (B (UNSIGNED-BYTE-P 7 B)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET ((ST$ (UPDATE-RI W
+                           (DMI (CAST ((UNSIGNED-BYTE 32) (UNSIGNED-BYTE 10))
+                                      (RI B ST$))
+                                ST$)
+                           ST$)))
+          (NORM (TUPLE FUNC SHIFT SKIP (FALSE)
+                       (FALSE)
+                       W A B)
+                ST$)))
+
+(DEFUN-STRUCT DFN-IN
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (SKIP (TYPE-CONDITIONT SKIP))
+                (W (UNSIGNED-BYTE-P 7 W))
+                (A (UNSIGNED-BYTE-P 7 A))
+                (B (UNSIGNED-BYTE-P 7 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((ST$ (UPDATE-RI W (INDATA ST$) ST$)))
+                   (NORM (TUPLE FUNC SHIFT SKIP (FALSE)
+                                (FALSE)
+                                W A B)
+                         ST$)))
+
+(DEFUN-STRUCT
+     DFN-JUMP
+     (((FUNC (TYPE-FUNCT FUNC))
+       (SHIFT (TYPE-SHIFTT SHIFT))
+       (W (UNSIGNED-BYTE-P 7 W))
+       (A (UNSIGNED-BYTE-P 7 A))
+       (B (UNSIGNED-BYTE-P 7 B)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET ((ST$ (UPDATE-RI W
+                           (CAST ((UNSIGNED-BYTE 10) (UNSIGNED-BYTE 32))
+                                 (N+ 10 (PCTR ST$) 1))
+                           ST$)))
+          (MV-LET (V ST$)
+                  (MV-LET (V ST$)
+                          (ALU (TUPLE FUNC SHIFT (RI A ST$) (RI B ST$))
+                               ST$)
+                          (MV (CAST ((UNSIGNED-BYTE 32) (UNSIGNED-BYTE 10))
+                                    V)
+                              ST$))
+                  (LET ((ST$ (UPDATE-PCTR V ST$)))
+                       (MV (UNIT-VALUE) ST$)))))
+
+(DEFUN-STRUCT
+     DFN-LOADCONSTANT
+     (((W (UNSIGNED-BYTE-P 7 W))
+       (IMM (UNSIGNED-BYTE-P 24 IMM)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET* ((ST$ (UPDATE-RI W
+                            (CAST ((UNSIGNED-BYTE 24) (UNSIGNED-BYTE 32))
+                                  IMM)
+                            ST$))
+            (ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$) 1) ST$)))
+           (MV (UNIT-VALUE) ST$)))
+
+(DEFUN-STRUCT DFN-RESERVEDINSTR (ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (RAISE-EXCEPTION 'RESERVED
+                               (ARB UTY)
+                               ST$))
+
+(DEFUN-STRUCT RUN ((V0 (TYPE-INSTRUCTION V0)) ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (CASE-MATCH+ V0
+                           ('RESERVEDINSTR (DFN-RESERVEDINSTR ST$))
+                           (('IN V1) (DFN-IN V1 ST$))
+                           (('JUMP V2) (DFN-JUMP V2 ST$))
+                           (('LOADCONSTANT V3)
+                            (DFN-LOADCONSTANT V3 ST$))
+                           (('LOADDM V4) (DFN-LOADDM V4 ST$))
+                           (('NORMAL V5) (DFN-NORMAL V5 ST$))
+                           (('OUT V6) (DFN-OUT V6 ST$))
+                           (('STOREDM V7) (DFN-STOREDM V7 ST$))
+                           (('STOREIM V8) (DFN-STOREIM V8 ST$))
+                           (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+
+(DEFUN-STRUCT
+ DECODE ((OPC (UNSIGNED-BYTE-P 32 OPC)))
+ (MV-LET-IGNORABLE
+  (B-31 B-30 B-29 B-28 B-27 B-26
+        B-25 B-24 B-23 B-22 B-21 B-20 B-19 B-18
+        B-17 B-16 B-15 B-14 B-13 B-12 B-11 B-10
+        B-9 B-8 B-7 B-6 B-5 B-4 B-3 B-2 B-1 B-0)
+  (BL 32 OPC)
+  (IF
+   B-24
+   (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT
+                     (TUPLE (BITS OPC 31 25)
+                            (BITS OPC 23 0)))
+   (LET*
+        ((RW (BITS OPC 31 25))
+         (RB (BITS OPC 16 10))
+         (RA (BITS OPC 23 17))
+         (FUNC (CAST ((UNSIGNED-BYTE 3) FUNCT)
+                     (BITS OPC 9 7)))
+         (SHIFT (CAST ((UNSIGNED-BYTE 2) SHIFTT)
+                      (BITS OPC 6 5)))
+         (SKIP (CAST ((UNSIGNED-BYTE 2) CONDITIONT)
+                     (BITS OPC 4 3))))
+        (CASE-MATCH+ (BITS OPC 2 0)
+                     (0 (CALL-CONSTRUCTOR INSTRUCTION NORMAL
+                                          (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (1 (CALL-CONSTRUCTOR INSTRUCTION STOREDM
+                                          (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (2 (CALL-CONSTRUCTOR INSTRUCTION STOREIM
+                                          (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (3 (CALL-CONSTRUCTOR INSTRUCTION
+                                          OUT (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (4 (CALL-CONSTRUCTOR INSTRUCTION LOADDM
+                                          (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (5 (CALL-CONSTRUCTOR INSTRUCTION
+                                          IN (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (6 (CALL-CONSTRUCTOR INSTRUCTION
+                                          JUMP (TUPLE FUNC SHIFT RW RA RB)))
+                     (7 'RESERVEDINSTR)
+                     (& (ASSERT! NIL (ARB INSTRUCTION))))))))
+
+(DEFUN-STRUCT NEXT (ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((V (DECODE (IMI (PCTR ST$) ST$))))
+                   (IF (NOT (EQ V 'RESERVEDINSTR))
+                       (RUN V ST$)
+                       (MV (UNIT-VALUE) ST$))))
+
+(DEFUN-STRUCT ENC
+              (((ARGS (SLET (X0 X1 X2 X3 X4 X5)
+                            ARGS
+                            (AND (TYPE-FUNCT X0)
+                                 (TYPE-SHIFTT X1)
+                                 (TYPE-CONDITIONT X2)
+                                 (UNSIGNED-BYTE-P 7 X3)
+                                 (UNSIGNED-BYTE-P 7 X4)
+                                 (UNSIGNED-BYTE-P 7 X5))
+                            NIL NIL))
+                (OPC (UNSIGNED-BYTE-P 3 OPC))))
+              (SLET (FUNC SHIFT SKIP W A B)
+                    ARGS
+                    (CAT W 7 0 1 A 7 B
+                         7 (CAST (FUNCT (UNSIGNED-BYTE 3)) FUNC)
+                         3
+                         (CAST (SHIFTT (UNSIGNED-BYTE 2)) SHIFT)
+                         2
+                         (CAST (CONDITIONT (UNSIGNED-BYTE 2))
+                               SKIP)
+                         2 OPC 3)))
+
+(DEFUN-STRUCT ENCODE ((I (TYPE-INSTRUCTION I)))
+              (CASE-MATCH+ I
+                           (('LOADCONSTANT (RW IMM))
+                            (CAT RW 7 1 1 IMM 24))
+                           (('NORMAL ARGS) (ENC (TUPLE ARGS 0)))
+                           (('STOREDM ARGS) (ENC (TUPLE ARGS 1)))
+                           (('STOREIM ARGS) (ENC (TUPLE ARGS 2)))
+                           (('OUT ARGS) (ENC (TUPLE ARGS 3)))
+                           (('LOADDM ARGS) (ENC (TUPLE ARGS 4)))
+                           (('IN ARGS) (ENC (TUPLE ARGS 5)))
+                           (('JUMP (FUNC SHIFT RW RA RB))
+                            (ENC (TUPLE (TUPLE FUNC SHIFT 'SKIPNEVER RW RA RB)
+                                        6)))
+                           ('RESERVEDINSTR 7)
+                           (& (ASSERT! NIL (ARB (UNSIGNED-BYTE 32))))))
+
+(DEFUN-STRUCT LOADIM
+              (((A (UNSIGNED-BYTE-P 10 A))
+                (I (TYPE-INSTRUCTION-LIST I)))
+               ST$)
+              :MEASURE (LEN I)
+              (DECLARE (XARGS :STOBJS ST$))
+              (CASE-MATCH+ I ('NIL (MV (UNIT-VALUE) ST$))
+                           ((H . T_VAR)
+                            (LET ((ST$ (UPDATE-IMI A (ENCODE H) ST$)))
+                                 (LOADIM (TUPLE (N+ 10 A 1) T_VAR) ST$)))
+                           (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+
+(DEFUN-STRUCT INITIALIZE
+              ((P (TYPE-INSTRUCTION-LIST P)) ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((ST$ (LET* ((ST$ (UPDATE-PCTR 0 ST$))
+                                (ST$ (MAP-UPDATE-RI 0 ST$))
+                                (ST$ (MAP-UPDATE-DMI 0 ST$))
+                                (ST$ (UPDATE-INRDY (FALSE) ST$))
+                                (ST$ (UPDATE-INDATA 0 ST$))
+                                (ST$ (UPDATE-OUTSTROBE 0 ST$)))
+                               (MAP-UPDATE-IMI (ENCODE 'RESERVEDINSTR)
+                                               ST$))))
+                   (LOADIM (TUPLE 0 P) ST$)))
+
+(DEFCONST *TEST_PROG*
+          (LIST (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 0 0))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 1 1000))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 2 1010))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 3 4))
+                (CALL-CONSTRUCTOR INSTRUCTION STOREDM
+                                  (TUPLE 'FINC 'NOSHIFT 'SKIPNEVER 1 1 1))
+                (CALL-CONSTRUCTOR INSTRUCTION NORMAL
+                                  (TUPLE 'FXOR 'NOSHIFT 'SKIPZERO 4 1 2))
+                (CALL-CONSTRUCTOR INSTRUCTION
+                                  JUMP (TUPLE 'FADD 'NOSHIFT 4 3 0))
+                (CALL-CONSTRUCTOR INSTRUCTION OUT
+                                  (TUPLE 'FADD
+                                         'NOSHIFT
+                                         'SKIPNEVER
+                                         1 1 0))))
+
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/gold/tiny.lisp acl2-6.3/books/translators/l3-to-acl2/examples/thacker/gold/tiny.lisp
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/gold/tiny.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/gold/tiny.lisp	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,433 @@
+(IN-PACKAGE "ACL2")
+
+(VALUE-TRIPLE
+     '(:GENERATED-BY (L3-TO-ACL2 "tiny-acl2.txt" "tiny.lisp"
+                                 :STR-TO-SYM '(("PC" . PCTR)
+                                               ("alu" . ALU_VAR)
+                                               ("function" . FUNCTION0)))))
+
+(INCLUDE-BOOK "/Users/kaufmann/projects/l3-to-acl2/translator/l3")
+
+(CONSTRUCT FUNCT
+           (FADD FSUB FINC FDEC FAND FOR FXOR FRESERVED))
+
+(CONSTRUCT SHIFTT (NOSHIFT RCY1 RCY8 RCY16))
+
+(CONSTRUCT CONDITIONT
+           (SKIPNEVER SKIPNEG SKIPZERO SKIPINRDY))
+
+(CONSTRUCT INSTRUCTION
+           ((IN (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                       (UNSIGNED-BYTE 7)
+                       (UNSIGNED-BYTE 7)))
+            (JUMP (FUNCT SHIFTT (UNSIGNED-BYTE 7)
+                         (UNSIGNED-BYTE 7)
+                         (UNSIGNED-BYTE 7)))
+            (LOADCONSTANT ((UNSIGNED-BYTE 7) (UNSIGNED-BYTE 24)))
+            (LOADDM (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                           (UNSIGNED-BYTE 7)
+                           (UNSIGNED-BYTE 7)))
+            (NORMAL (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                           (UNSIGNED-BYTE 7)
+                           (UNSIGNED-BYTE 7)))
+            (OUT (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                        (UNSIGNED-BYTE 7)
+                        (UNSIGNED-BYTE 7)))
+            RESERVEDINSTR
+            (STOREDM (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                            (UNSIGNED-BYTE 7)
+                            (UNSIGNED-BYTE 7)))
+            (STOREIM (FUNCT SHIFTT CONDITIONT (UNSIGNED-BYTE 7)
+                            (UNSIGNED-BYTE 7)
+                            (UNSIGNED-BYTE 7)))))
+
+(CONSTRUCT EXCEPTION (NOEXCEPTION RESERVED))
+
+(DEFSTOBJ+ ST$
+           (DM :TYPE (ARRAY (UNSIGNED-BYTE 32) (1024))
+               :INITIALLY 0)
+           (IM :TYPE (ARRAY (UNSIGNED-BYTE 32) (1024))
+               :INITIALLY 0)
+           (INDATA :TYPE (UNSIGNED-BYTE 32)
+                   :INITIALLY 0)
+           (INRDY :TYPE (SATISFIES BOOLEANP))
+           (OUTSTROBE :TYPE (UNSIGNED-BYTE 32)
+                      :INITIALLY 0)
+           (PCTR :TYPE (UNSIGNED-BYTE 10)
+                 :INITIALLY 0)
+           (R :TYPE (ARRAY (UNSIGNED-BYTE 32) (128))
+              :INITIALLY 0)
+           EXCEPTION)
+
+(VALUE-TRIPLE "See l3.lisp for the definition of raise-exception")
+
+(PROGRAM)
+
+(DEFUN-STRUCT FUNCTION0
+              (((FUNC (TYPE-FUNCT FUNC))
+                (A (UNSIGNED-BYTE-P 32 A))
+                (B (UNSIGNED-BYTE-P 32 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (CASE-MATCH+ FUNC ('FADD (MV (N+ 32 A B) ST$))
+                           ('FSUB (MV (N- 32 A B) ST$))
+                           ('FINC (MV (N+ 32 B 1) ST$))
+                           ('FDEC (MV (N- 32 B 1) ST$))
+                           ('FAND (MV (LOGAND A B) ST$))
+                           ('FOR (MV (LOGIOR A B) ST$))
+                           ('FXOR (MV (LOGXOR A B) ST$))
+                           (& (RAISE-EXCEPTION 'RESERVED
+                                               (ARB (UNSIGNED-BYTE 32))
+                                               ST$))))
+
+(DEFUN-STRUCT SHIFTER
+              (((SHIFT (TYPE-SHIFTT SHIFT))
+                (A (UNSIGNED-BYTE-P 32 A))))
+              (CASE-MATCH+ SHIFT ('NOSHIFT A)
+                           ('RCY1 (ASH A -1))
+                           ('RCY8 (ASH A -8))
+                           ('RCY16 (ASH A -16))
+                           (& (ASSERT! NIL (ARB (UNSIGNED-BYTE 32))))))
+
+(DEFUN-STRUCT ALU
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (A (UNSIGNED-BYTE-P 32 A))
+                (B (UNSIGNED-BYTE-P 32 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (MV-LET (V ST$)
+                      (FUNCTION0 (TUPLE FUNC A B) ST$)
+                      (MV (SHIFTER (TUPLE SHIFT V)) ST$)))
+
+(DEFUN-STRUCT
+   INCPC
+   (((SKIP (TYPE-CONDITIONT SKIP))
+     (ALU_VAR (UNSIGNED-BYTE-P 32 ALU_VAR)))
+    ST$)
+   (DECLARE (XARGS :STOBJS ST$))
+   (CASE-MATCH+ SKIP
+                ('SKIPNEVER
+                 (LET ((ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$) 1) ST$)))
+                      (MV (UNIT-VALUE) ST$)))
+                ('SKIPNEG
+                 (LET ((ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$)
+                                             (IF (< ALU_VAR 0) 2 1))
+                                         ST$)))
+                      (MV (UNIT-VALUE) ST$)))
+                ('SKIPZERO
+                 (LET ((ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$)
+                                             (IF (EQL ALU_VAR 0) 2 1))
+                                         ST$)))
+                      (MV (UNIT-VALUE) ST$)))
+                ('SKIPINRDY
+                 (LET ((ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$) (IF (INRDY ST$) 2 1))
+                                         ST$)))
+                      (MV (UNIT-VALUE) ST$)))
+                (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+
+(DEFUN-STRUCT NORM
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (SKIP (TYPE-CONDITIONT SKIP))
+                (WBACK (BOOLEANP WBACK))
+                (STROBE (BOOLEANP STROBE))
+                (W (UNSIGNED-BYTE-P 7 W))
+                (A (UNSIGNED-BYTE-P 7 A))
+                (B (UNSIGNED-BYTE-P 7 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (MV-LET (V ST$)
+                      (ALU (TUPLE FUNC SHIFT (RI A ST$) (RI B ST$))
+                           ST$)
+                      (LET* ((ST$ (IF WBACK (UPDATE-RI W V ST$) ST$))
+                             (ST$ (IF STROBE (UPDATE-OUTSTROBE V ST$)
+                                      ST$)))
+                            (INCPC (TUPLE SKIP V) ST$))))
+
+(DEFUN-STRUCT DFN-NORMAL
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (SKIP (TYPE-CONDITIONT SKIP))
+                (W (UNSIGNED-BYTE-P 7 W))
+                (A (UNSIGNED-BYTE-P 7 A))
+                (B (UNSIGNED-BYTE-P 7 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (NORM (TUPLE FUNC SHIFT SKIP (TRUE)
+                           (FALSE)
+                           W A B)
+                    ST$))
+
+(DEFUN-STRUCT
+     DFN-STOREDM
+     (((FUNC (TYPE-FUNCT FUNC))
+       (SHIFT (TYPE-SHIFTT SHIFT))
+       (SKIP (TYPE-CONDITIONT SKIP))
+       (W (UNSIGNED-BYTE-P 7 W))
+       (A (UNSIGNED-BYTE-P 7 A))
+       (B (UNSIGNED-BYTE-P 7 B)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET ((ST$ (UPDATE-DMI (CAST ((UNSIGNED-BYTE 32) (UNSIGNED-BYTE 10))
+                                  (RI B ST$))
+                            (RI A ST$)
+                            ST$)))
+          (NORM (TUPLE FUNC SHIFT SKIP (TRUE)
+                       (FALSE)
+                       W A B)
+                ST$)))
+
+(DEFUN-STRUCT
+     DFN-STOREIM
+     (((FUNC (TYPE-FUNCT FUNC))
+       (SHIFT (TYPE-SHIFTT SHIFT))
+       (SKIP (TYPE-CONDITIONT SKIP))
+       (W (UNSIGNED-BYTE-P 7 W))
+       (A (UNSIGNED-BYTE-P 7 A))
+       (B (UNSIGNED-BYTE-P 7 B)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET ((ST$ (UPDATE-IMI (CAST ((UNSIGNED-BYTE 32) (UNSIGNED-BYTE 10))
+                                  (RI B ST$))
+                            (RI A ST$)
+                            ST$)))
+          (NORM (TUPLE FUNC SHIFT SKIP (TRUE)
+                       (FALSE)
+                       W A B)
+                ST$)))
+
+(DEFUN-STRUCT DFN-OUT
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (SKIP (TYPE-CONDITIONT SKIP))
+                (W (UNSIGNED-BYTE-P 7 W))
+                (A (UNSIGNED-BYTE-P 7 A))
+                (B (UNSIGNED-BYTE-P 7 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (NORM (TUPLE FUNC SHIFT SKIP (TRUE)
+                           (TRUE)
+                           W A B)
+                    ST$))
+
+(DEFUN-STRUCT
+     DFN-LOADDM
+     (((FUNC (TYPE-FUNCT FUNC))
+       (SHIFT (TYPE-SHIFTT SHIFT))
+       (SKIP (TYPE-CONDITIONT SKIP))
+       (W (UNSIGNED-BYTE-P 7 W))
+       (A (UNSIGNED-BYTE-P 7 A))
+       (B (UNSIGNED-BYTE-P 7 B)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET ((ST$ (UPDATE-RI W
+                           (DMI (CAST ((UNSIGNED-BYTE 32) (UNSIGNED-BYTE 10))
+                                      (RI B ST$))
+                                ST$)
+                           ST$)))
+          (NORM (TUPLE FUNC SHIFT SKIP (FALSE)
+                       (FALSE)
+                       W A B)
+                ST$)))
+
+(DEFUN-STRUCT DFN-IN
+              (((FUNC (TYPE-FUNCT FUNC))
+                (SHIFT (TYPE-SHIFTT SHIFT))
+                (SKIP (TYPE-CONDITIONT SKIP))
+                (W (UNSIGNED-BYTE-P 7 W))
+                (A (UNSIGNED-BYTE-P 7 A))
+                (B (UNSIGNED-BYTE-P 7 B)))
+               ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((ST$ (UPDATE-RI W (INDATA ST$) ST$)))
+                   (NORM (TUPLE FUNC SHIFT SKIP (FALSE)
+                                (FALSE)
+                                W A B)
+                         ST$)))
+
+(DEFUN-STRUCT
+     DFN-JUMP
+     (((FUNC (TYPE-FUNCT FUNC))
+       (SHIFT (TYPE-SHIFTT SHIFT))
+       (W (UNSIGNED-BYTE-P 7 W))
+       (A (UNSIGNED-BYTE-P 7 A))
+       (B (UNSIGNED-BYTE-P 7 B)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET ((ST$ (UPDATE-RI W
+                           (CAST ((UNSIGNED-BYTE 10) (UNSIGNED-BYTE 32))
+                                 (N+ 10 (PCTR ST$) 1))
+                           ST$)))
+          (MV-LET (V ST$)
+                  (MV-LET (V ST$)
+                          (ALU (TUPLE FUNC SHIFT (RI A ST$) (RI B ST$))
+                               ST$)
+                          (MV (CAST ((UNSIGNED-BYTE 32) (UNSIGNED-BYTE 10))
+                                    V)
+                              ST$))
+                  (LET ((ST$ (UPDATE-PCTR V ST$)))
+                       (MV (UNIT-VALUE) ST$)))))
+
+(DEFUN-STRUCT
+     DFN-LOADCONSTANT
+     (((W (UNSIGNED-BYTE-P 7 W))
+       (IMM (UNSIGNED-BYTE-P 24 IMM)))
+      ST$)
+     (DECLARE (XARGS :STOBJS ST$))
+     (LET* ((ST$ (UPDATE-RI W
+                            (CAST ((UNSIGNED-BYTE 24) (UNSIGNED-BYTE 32))
+                                  IMM)
+                            ST$))
+            (ST$ (UPDATE-PCTR (N+ 10 (PCTR ST$) 1) ST$)))
+           (MV (UNIT-VALUE) ST$)))
+
+(DEFUN-STRUCT DFN-RESERVEDINSTR (ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (RAISE-EXCEPTION 'RESERVED
+                               (ARB UTY)
+                               ST$))
+
+(DEFUN-STRUCT RUN ((V0 (TYPE-INSTRUCTION V0)) ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (CASE-MATCH+ V0
+                           ('RESERVEDINSTR (DFN-RESERVEDINSTR ST$))
+                           (('IN V1) (DFN-IN V1 ST$))
+                           (('JUMP V2) (DFN-JUMP V2 ST$))
+                           (('LOADCONSTANT V3)
+                            (DFN-LOADCONSTANT V3 ST$))
+                           (('LOADDM V4) (DFN-LOADDM V4 ST$))
+                           (('NORMAL V5) (DFN-NORMAL V5 ST$))
+                           (('OUT V6) (DFN-OUT V6 ST$))
+                           (('STOREDM V7) (DFN-STOREDM V7 ST$))
+                           (('STOREIM V8) (DFN-STOREIM V8 ST$))
+                           (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+
+(DEFUN-STRUCT
+ DECODE ((OPC (UNSIGNED-BYTE-P 32 OPC)))
+ (MV-LET-IGNORABLE
+  (B-31 B-30 B-29 B-28 B-27 B-26
+        B-25 B-24 B-23 B-22 B-21 B-20 B-19 B-18
+        B-17 B-16 B-15 B-14 B-13 B-12 B-11 B-10
+        B-9 B-8 B-7 B-6 B-5 B-4 B-3 B-2 B-1 B-0)
+  (BL 32 OPC)
+  (IF
+   B-24
+   (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT
+                     (TUPLE (BITS OPC 31 25)
+                            (BITS OPC 23 0)))
+   (LET*
+        ((RW (BITS OPC 31 25))
+         (RB (BITS OPC 16 10))
+         (RA (BITS OPC 23 17))
+         (FUNC (CAST ((UNSIGNED-BYTE 3) FUNCT)
+                     (BITS OPC 9 7)))
+         (SHIFT (CAST ((UNSIGNED-BYTE 2) SHIFTT)
+                      (BITS OPC 6 5)))
+         (SKIP (CAST ((UNSIGNED-BYTE 2) CONDITIONT)
+                     (BITS OPC 4 3))))
+        (CASE-MATCH+ (BITS OPC 2 0)
+                     (0 (CALL-CONSTRUCTOR INSTRUCTION NORMAL
+                                          (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (1 (CALL-CONSTRUCTOR INSTRUCTION STOREDM
+                                          (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (2 (CALL-CONSTRUCTOR INSTRUCTION STOREIM
+                                          (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (3 (CALL-CONSTRUCTOR INSTRUCTION
+                                          OUT (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (4 (CALL-CONSTRUCTOR INSTRUCTION LOADDM
+                                          (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (5 (CALL-CONSTRUCTOR INSTRUCTION
+                                          IN (TUPLE FUNC SHIFT SKIP RW RA RB)))
+                     (6 (CALL-CONSTRUCTOR INSTRUCTION
+                                          JUMP (TUPLE FUNC SHIFT RW RA RB)))
+                     (7 'RESERVEDINSTR)
+                     (& (ASSERT! NIL (ARB INSTRUCTION))))))))
+
+(DEFUN-STRUCT NEXT (ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((V (DECODE (IMI (PCTR ST$) ST$))))
+                   (IF (NOT (EQ V 'RESERVEDINSTR))
+                       (RUN V ST$)
+                       (MV (UNIT-VALUE) ST$))))
+
+(DEFUN-STRUCT ENC
+              (((ARGS (SLET (X0 X1 X2 X3 X4 X5)
+                            ARGS
+                            (AND (TYPE-FUNCT X0)
+                                 (TYPE-SHIFTT X1)
+                                 (TYPE-CONDITIONT X2)
+                                 (UNSIGNED-BYTE-P 7 X3)
+                                 (UNSIGNED-BYTE-P 7 X4)
+                                 (UNSIGNED-BYTE-P 7 X5))
+                            NIL NIL))
+                (OPC (UNSIGNED-BYTE-P 3 OPC))))
+              (SLET (FUNC SHIFT SKIP W A B)
+                    ARGS
+                    (CAT W 7 0 1 A 7 B
+                         7 (CAST (FUNCT (UNSIGNED-BYTE 3)) FUNC)
+                         3
+                         (CAST (SHIFTT (UNSIGNED-BYTE 2)) SHIFT)
+                         2
+                         (CAST (CONDITIONT (UNSIGNED-BYTE 2))
+                               SKIP)
+                         2 OPC 3)))
+
+(DEFUN-STRUCT ENCODE ((I (TYPE-INSTRUCTION I)))
+              (CASE-MATCH+ I
+                           (('LOADCONSTANT (RW IMM))
+                            (CAT RW 7 1 1 IMM 24))
+                           (('NORMAL ARGS) (ENC (TUPLE ARGS 0)))
+                           (('STOREDM ARGS) (ENC (TUPLE ARGS 1)))
+                           (('STOREIM ARGS) (ENC (TUPLE ARGS 2)))
+                           (('OUT ARGS) (ENC (TUPLE ARGS 3)))
+                           (('LOADDM ARGS) (ENC (TUPLE ARGS 4)))
+                           (('IN ARGS) (ENC (TUPLE ARGS 5)))
+                           (('JUMP (FUNC SHIFT RW RA RB))
+                            (ENC (TUPLE (TUPLE FUNC SHIFT 'SKIPNEVER RW RA RB)
+                                        6)))
+                           ('RESERVEDINSTR 7)
+                           (& (ASSERT! NIL (ARB (UNSIGNED-BYTE 32))))))
+
+(DEFUN-STRUCT LOADIM
+              (((A (UNSIGNED-BYTE-P 10 A))
+                (I (TYPE-INSTRUCTION-LIST I)))
+               ST$)
+              :MEASURE (LEN I)
+              (DECLARE (XARGS :STOBJS ST$))
+              (CASE-MATCH+ I ('NIL (MV (UNIT-VALUE) ST$))
+                           ((H . T_VAR)
+                            (LET ((ST$ (UPDATE-IMI A (ENCODE H) ST$)))
+                                 (LOADIM (TUPLE (N+ 10 A 1) T_VAR) ST$)))
+                           (& (ASSERT! NIL (MV (ARB UTY) ST$)))))
+
+(DEFUN-STRUCT INITIALIZE
+              ((P (TYPE-INSTRUCTION-LIST P)) ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((ST$ (LET* ((ST$ (UPDATE-PCTR 0 ST$))
+                                (ST$ (MAP-UPDATE-RI 0 ST$))
+                                (ST$ (MAP-UPDATE-DMI 0 ST$))
+                                (ST$ (UPDATE-INRDY (FALSE) ST$))
+                                (ST$ (UPDATE-INDATA 0 ST$))
+                                (ST$ (UPDATE-OUTSTROBE 0 ST$)))
+                               (MAP-UPDATE-IMI (ENCODE 'RESERVEDINSTR)
+                                               ST$))))
+                   (LOADIM (TUPLE 0 P) ST$)))
+
+(DEFCONST *TEST_PROG*
+          (LIST (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 0 0))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 1 1000))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 2 1010))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 3 4))
+                (CALL-CONSTRUCTOR INSTRUCTION STOREDM
+                                  (TUPLE 'FINC 'NOSHIFT 'SKIPNEVER 1 1 1))
+                (CALL-CONSTRUCTOR INSTRUCTION NORMAL
+                                  (TUPLE 'FXOR 'NOSHIFT 'SKIPZERO 4 1 2))
+                (CALL-CONSTRUCTOR INSTRUCTION
+                                  JUMP (TUPLE 'FADD 'NOSHIFT 4 3 0))
+                (CALL-CONSTRUCTOR INSTRUCTION OUT
+                                  (TUPLE 'FADD
+                                         'NOSHIFT
+                                         'SKIPNEVER
+                                         1 1 0))))
+
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/l3-run acl2-6.3/books/translators/l3-to-acl2/examples/thacker/l3-run
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/l3-run	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/l3-run	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,83 @@
+val () = Runtime.LoadF "tiny.spec";
+
+(* ------------------------------------------------------------------------ *)
+
+local
+   val bitsOptionString =
+      fn SOME n => BitsN.toString n
+       | NONE => "-"
+   val evalS = Runtime.evalQ o Lib.stringToQuote
+   fun readBits s =
+      case evalS s of
+         Eval.Values.Bits n => SOME n
+       | _ => NONE
+   fun getBits s err =
+      fn () => Option.valOf (readBits s) handle Option.Option => raise Fail err
+in
+   val readPC = getBits "PC" "readPC"
+   val readStrobe = getBits "OutStrobe" "readStrobe"
+   fun readMap m addr = readBits (m ^ "(" ^ Int.toString addr ^ ")")
+   fun readMem m addr n =
+      let
+         val read = readMap m
+         fun iter a n =
+            if n = 0
+               then a
+            else let
+                    val p = n - 1
+                 in
+                    iter ((addr + p, read (addr + p)) :: a) p
+                 end
+      in
+         iter [] n
+      end
+   fun printMem m addr n =
+      List.app
+         (fn (i, d) => print (Int.toString i ^ ": " ^ bitsOptionString d ^"\n"))
+         (readMem m addr n)
+   val printRegs =
+      List.app
+        (fn i =>
+           print ("R(" ^ Int.toString i ^ "): " ^
+                  bitsOptionString (readMap "R" i) ^ "\n"))
+end
+
+(* ------------------------------------------------------------------------ *)
+
+fun initialize () =
+   General.ignore
+     (Runtime.reset ()
+      ; Runtime.evalQ `initialize (test_prog)`)
+
+(* ------------------------------------------------------------------------ *)
+
+fun run () =
+   let
+      fun loop () =
+         let
+            val pc = readPC ()
+            val strobe = readStrobe ()
+            val () = print (BitsN.toString pc)
+            val () = General.ignore (Runtime.evalQ `Next`)
+            val npc = readPC ()
+            val nstrobe = readStrobe ()
+            val () = if nstrobe <> strobe
+                        then print (" [" ^ BitsN.toString nstrobe ^ "]")
+                     else ()
+            val () = print "\n"
+         in
+            if npc = pc then () else loop ()
+         end
+   in
+      loop(); print "Done.\n"
+   end
+
+(*
+Runtime.reset()
+initialize()
+run()
+
+printRegs (List.tabulate (5, I))
+printMem "IM" 0 9
+printMem "DM" 1000 12
+*)
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/run-test.sh acl2-6.3/books/translators/l3-to-acl2/examples/thacker/run-test.sh
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/run-test.sh	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/run-test.sh	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,28 @@
+#!/bin/sh
+
+# Note: Assumes that $workfile is empty or suitably initialized
+# and that $ACL2 is defined.
+
+if [ $# != 1 ] ; then
+    echo "Usage: run-test.sh outfile"
+    exit 1
+fi
+
+outfile=$1
+workfile=workxxx.$1
+
+echo '(include-book "run")' >> $workfile
+echo '(time$ (run-timing* 10000 st$))' >> $workfile
+echo '(time$ (run-init* 10000 st$))' >> $workfile
+echo '(time$ (run-timing* 10000 st$))' >> $workfile
+echo '(time$ (run-init* 10000 st$))' >> $workfile
+echo 'Preparing to run the following commands:'
+echo '----------'
+cat $workfile
+echo 'Running the above commands and then displaying timing'
+echo 'results from running 350000 instructions: first the total,'
+echo 'then just running the corresponding initializations.'
+echo '(So ips is 350000 divided by their difference.)'
+echo '----------'
+echo '(ld "'$workfile'" :ld-pre-eval-print t)' | $ACL2 > $outfile
+tail -13 $outfile
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/run.lisp acl2-6.3/books/translators/l3-to-acl2/examples/thacker/run.lisp
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/run.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/run.lisp	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,177 @@
+; To execute in :logic mode, first do one of these before including this book:
+; (include-book "tiny-manual")
+; (include-book "tiny-logic")
+
+(in-package "ACL2")
+
+(include-book "tiny")
+
+(program)
+
+(defun show-dm-rec (n default st$ acc)
+  (declare (xargs :stobjs st$))
+  (cond ((zp n) acc)
+        (t (let* ((n (1- n))
+                  (v (dmi n st$)))
+             (show-dm-rec n default st$
+                          (cond ((eql v default) acc)
+                                (t (cons (list n v) acc))))))))
+
+(defun show-dm (default st$)
+  (declare (xargs :stobjs st$))
+  (show-dm-rec 1024 default st$ nil))
+
+(defun show-im-rec (n default st$ acc)
+  (declare (xargs :stobjs st$))
+  (cond ((zp n) acc)
+        (t (let* ((n (1- n))
+                  (v (imi n st$)))
+             (show-im-rec n default st$
+                          (cond ((eql v default) acc)
+                                (t (cons (list n v) acc))))))))
+
+(defun show-im (default st$)
+  (declare (xargs :stobjs st$))
+  (show-im-rec 1024 default st$ nil))
+
+(defun show-indata (st$)
+  (declare (xargs :stobjs st$))
+  (indata st$))
+
+(defun show-inrdy (st$)
+  (declare (xargs :stobjs st$))
+  (inrdy st$))
+
+(defun show-outstrobe (st$)
+  (declare (xargs :stobjs st$))
+  (outstrobe st$))
+
+(defun show-pctr (st$)
+  (declare (xargs :stobjs st$))
+  (pctr st$))
+
+(defun show-r-rec (n default st$ acc)
+  (declare (xargs :stobjs st$))
+  (cond ((zp n) acc)
+        (t (let* ((n (1- n))
+                  (v (ri n st$)))
+             (show-r-rec n default st$
+                         (cond ((eql v default) acc)
+                               (t (cons (list n v) acc))))))))
+
+(defun show-r (default st$)
+  (declare (xargs :stobjs st$))
+  (show-r-rec 128 default st$ nil))
+
+(defun show-exception (st$)
+  (declare (xargs :stobjs st$))
+  (exception st$))
+
+(defun show-st$ (st$)
+  (declare (xargs :stobjs st$))
+  (list (let ((default 0))
+          (list :DM
+                :DEFAULT default
+                (show-DM default st$)))
+        (let ((default (encode 'RESERVEDINSTR)))
+          (list :IM
+                :DEFAULT default
+                (show-IM default st$)))
+        (list :INDATA (show-INDATA st$))
+        (list :INRDY (show-INRDY st$))
+        (list :OUTSTROBE (show-OUTSTROBE st$))
+        (list :PCTR (show-PCTR st$))
+        (let ((default 0))
+          (list :R
+                :DEFAULT default
+                (show-R default st$)))
+        (list :EXCEPTION (show-EXCEPTION st$))))
+
+; Running with output.
+
+(defun next-output (st$ chan state)
+  (declare (xargs :stobjs (st$ state)))
+  (let ((old-strobe (outstrobe st$)))
+    (pprogn (fms "~x0"
+                 (list (cons #\0 (pctr st$)))
+                 chan state nil)
+            (mv-let (unit-val st$)
+                    (next st$)
+                    (declare (ignore unit-val))
+                    (pprogn (let ((new-strobe (outstrobe st$)))
+                              (cond ((eql old-strobe new-strobe)
+                                     state)
+                                    (t (fms " [~x0]"
+                                            (list (cons #\0 new-strobe))
+                                            chan state nil))))
+                            (mv st$ state))))))
+
+(defun run-loop-output (n st$ chan state)
+  (declare (xargs :stobjs (st$ state)))
+  (let ((pc (pctr st$)))
+    (mv-let
+     (st$ state)
+     (next-output st$ chan state)
+     (cond ((eql pc (pctr st$))
+            (pprogn (fms "Final state (~x0 steps):~|~X12~|"
+                         (list (cons #\0 n)
+                               (cons #\1 (show-st$ st$))
+                               (cons #\2 nil))
+                         chan state nil)
+                    (close-output-channel chan state)
+                    (mv st$ state)))
+           (t (run-loop-output (1+ n) st$ chan state))))))
+
+(defun run-output (st$ state)
+  (declare (xargs :stobjs (st$ state)))
+  (mv-let (unit-val st$)
+          (initialize *test_prog* st$)
+          (declare (ignore unit-val))
+          (mv-let
+           (chan state)
+           (open-output-channel "run-check.txt" :character state)
+           (cond (chan (run-loop-output 0 st$ chan state))
+                 (t (pprogn
+                     (fms "ERROR: Unable to open file ~x0 for output.~|"
+                          (list (cons #\0 "run-check.txt"))
+                          *standard-co* state nil)
+                     (mv st$ state)))))))
+
+; Running for timing (no output).
+
+(defun run-loop-timing (st$)
+  (declare (xargs :stobjs st$))
+  (let ((pc (pctr st$)))
+    (mv-let (unit-val st$)
+            (next st$)
+            (declare (ignore unit-val))
+            (cond ((eql pc (pctr st$))
+                   st$)
+                  (t (run-loop-timing st$))))))
+
+(defun run-timing (st$)
+  (declare (xargs :stobjs st$))
+  (mv-let (unit-val st$)
+          (initialize *test_prog* st$)
+          (declare (ignore unit-val))
+          (run-loop-timing st$)))
+
+(defun run-timing* (k st$)
+  (declare (xargs :stobjs st$))
+  (declare (type (unsigned-byte 28) k))
+  (cond ((eql k 0) st$)
+        (t (let ((st$ (run-timing st$)))
+             (run-timing* (1- k) st$)))))
+
+(defun run-init* (k st$)
+  (declare (xargs :stobjs st$))
+  (declare (type (unsigned-byte 28) k))
+  (cond ((eql k 0) st$)
+        (t (mv-let (unit-val st$)
+                   (initialize *test_prog* st$)
+                   (declare (ignore unit-val))
+                   (run-init* (1- k) st$)))))
+
+; (time$ (run-timing* 10000 st$))
+; (time$ (run-init* 10000 st$))
+; ips: (/ 350000 (- time1 time2))
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tiny-acl2.txt acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tiny-acl2.txt
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tiny-acl2.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tiny-acl2.txt	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,822 @@
+(val _ = Construct
+  (sqbkt ("funcT"
+           (sqbkt ("fADD" []) ("fSUB" []) ("fINC" []) ("fDEC" [])
+                  ("fAND" []) ("fOR" []) ("fXOR" []) ("fReserved" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("shiftT"
+           (sqbkt ("noShift" []) ("RCY1" []) ("RCY8" []) ("RCY16" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("conditionT"
+           (sqbkt ("skipNever" []) ("skipNeg" []) ("skipZero" [])
+                  ("skipInRdy" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("instruction"
+           (sqbkt ("In"
+                    (sqbkt (PTy CTy"funcT"
+                             (PTy CTy"shiftT"
+                               (PTy CTy"conditionT"
+                                 (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                  ("Jump"
+                    (sqbkt (PTy CTy"funcT"
+                             (PTy CTy"shiftT"
+                               (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+                  ("LoadConstant" (sqbkt (PTy (FTy 7) (FTy 24))))
+                  ("LoadDM"
+                    (sqbkt (PTy CTy"funcT"
+                             (PTy CTy"shiftT"
+                               (PTy CTy"conditionT"
+                                 (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                  ("Normal"
+                    (sqbkt (PTy CTy"funcT"
+                             (PTy CTy"shiftT"
+                               (PTy CTy"conditionT"
+                                 (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                  ("Out"
+                    (sqbkt (PTy CTy"funcT"
+                             (PTy CTy"shiftT"
+                               (PTy CTy"conditionT"
+                                 (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                  ("ReservedInstr" [])
+                  ("StoreDM"
+                    (sqbkt (PTy CTy"funcT"
+                             (PTy CTy"shiftT"
+                               (PTy CTy"conditionT"
+                                 (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                  ("StoreIM"
+                    (sqbkt (PTy CTy"funcT"
+                             (PTy CTy"shiftT"
+                               (PTy CTy"conditionT"
+                                 (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))))))
+
+
+(val _ = Construct
+  (sqbkt ("exception" (sqbkt ("NoException" []) ("Reserved" [])))))
+
+
+(val _ = Record
+  ("state"
+    (sqbkt ("DM" (ATy (FTy 10) F32)) ("IM" (ATy (FTy 10) F32))
+           ("InData" F32) ("InRdy" bTy) ("OutStrobe" F32) ("PC" (FTy 10))
+           ("R" (ATy (FTy 7) F32)) ("exception" CTy"exception"))))
+
+
+(Def "raise'exception" (Var "e" CTy"exception")
+  (Close qVar"state"
+    (TP
+      (sqbkt (LX VTy"a")
+             (ITE
+               (EQ (Dest "exception" CTy"exception" qVar"state")
+                 (LC "NoException" CTy"exception"))
+               (Rupd "exception"
+                 (TP (sqbkt qVar"state" (Var "e" CTy"exception"))))
+               qVar"state")))))
+
+
+(Def "function"
+  (TP (sqbkt (Var "func" CTy"funcT") (Var "a" F32) (Var "b" F32)))
+  (Close qVar"state"
+    (CS (Var "func" CTy"funcT")
+      (sqbkt ((LC "fADD" CTy"funcT")
+               (TP
+                 (sqbkt (Bop Add (Var "a" F32) (Var "b" F32)) qVar"state")))
+             ((LC "fSUB" CTy"funcT")
+               (TP
+                 (sqbkt (Bop Sub (Var "a" F32) (Var "b" F32)) qVar"state")))
+             ((LC "fINC" CTy"funcT")
+               (TP (sqbkt (Bop Add (Var "b" F32) (LW 1 32)) qVar"state")))
+             ((LC "fDEC" CTy"funcT")
+               (TP (sqbkt (Bop Sub (Var "b" F32) (LW 1 32)) qVar"state")))
+             ((LC "fAND" CTy"funcT")
+               (TP
+                 (sqbkt (Bop BAnd (Var "a" F32) (Var "b" F32)) qVar"state")))
+             ((LC "fOR" CTy"funcT")
+               (TP
+                 (sqbkt (Bop BOr (Var "a" F32) (Var "b" F32)) qVar"state")))
+             ((LC "fXOR" CTy"funcT")
+               (TP
+                 (sqbkt (Bop BXor (Var "a" F32) (Var "b" F32)) qVar"state")))
+             ((AVar CTy"funcT")
+               (Apply
+                 (Call "raise'exception" (ATy qTy (PTy F32 qTy))
+                   (LC "Reserved" CTy"exception")) qVar"state"))))))
+
+
+(Def "shifter" (TP (sqbkt (Var "shift" CTy"shiftT") (Var "a" F32)))
+  (CS (Var "shift" CTy"shiftT")
+    (sqbkt ((LC "noShift" CTy"shiftT") (Var "a" F32))
+           ((LC "RCY1" CTy"shiftT") (Bop Ror (Var "a" F32) (LN 1)))
+           ((LC "RCY8" CTy"shiftT") (Bop Ror (Var "a" F32) (LN 8)))
+           ((LC "RCY16" CTy"shiftT") (Bop Ror (Var "a" F32) (LN 16))))))
+
+
+(Def "ALU"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT") (Var "a" F32)
+           (Var "b" F32)))
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" F32) qVar"s"))
+      (Apply
+        (Call "function" (ATy qTy (PTy F32 qTy))
+          (TP (sqbkt (Var "func" CTy"funcT") (Var "a" F32) (Var "b" F32))))
+        qVar"state")
+      (TP
+        (sqbkt (Call "shifter" F32
+                 (TP (sqbkt (Var "shift" CTy"shiftT") (Var "v" F32))))
+               qVar"s")))))
+
+
+(Def "incPC" (TP (sqbkt (Var "skip" CTy"conditionT") (Var "alu" F32)))
+  (Close qVar"state"
+    (CS (Var "skip" CTy"conditionT")
+      (sqbkt ((LC "skipNever" CTy"conditionT")
+               (TP
+                 (sqbkt LU
+                        (Rupd "PC"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Bop Add
+                                     (Dest "PC" (FTy 10) qVar"state")
+                                     (LW 1 10))))))))
+             ((LC "skipNeg" CTy"conditionT")
+               (TP
+                 (sqbkt LU
+                        (Rupd "PC"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Bop Add
+                                     (Dest "PC" (FTy 10) qVar"state")
+                                     (ITE
+                                       (Bop Lt (Var "alu" F32) (LW 0 32))
+                                       (LW 2 10) (LW 1 10)))))))))
+             ((LC "skipZero" CTy"conditionT")
+               (TP
+                 (sqbkt LU
+                        (Rupd "PC"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Bop Add
+                                     (Dest "PC" (FTy 10) qVar"state")
+                                     (ITE (EQ (Var "alu" F32) (LW 0 32))
+                                       (LW 2 10) (LW 1 10)))))))))
+             ((LC "skipInRdy" CTy"conditionT")
+               (TP
+                 (sqbkt LU
+                        (Rupd "PC"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Bop Add
+                                     (Dest "PC" (FTy 10) qVar"state")
+                                     (ITE (Dest "InRdy" bTy qVar"state")
+                                       (LW 2 10) (LW 1 10)))))))))))))
+
+
+(Def "norm"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+           (Var "skip" CTy"conditionT") bVar"wback" bVar"strobe"
+           (Var "w" (FTy 7)) (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" F32) qVar"s"))
+      (Apply
+        (Call "ALU" (ATy qTy (PTy F32 qTy))
+          (TP
+            (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                   (Apply (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                     (Var "a" (FTy 7)))
+                   (Apply (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                     (Var "b" (FTy 7)))))) qVar"state")
+      (Let qVar"s"
+        (ITE bVar"wback"
+          (Rupd "R"
+            (TP
+              (sqbkt qVar"s"
+                     (Fupd (Dest "R" (ATy (FTy 7) F32) qVar"s")
+                       (Var "w" (FTy 7)) (Var "v" F32))))) qVar"s")
+        (Apply
+          (Call "incPC" (ATy qTy (PTy uTy qTy))
+            (TP (sqbkt (Var "skip" CTy"conditionT") (Var "v" F32))))
+          (ITE bVar"strobe"
+            (Rupd "OutStrobe" (TP (sqbkt qVar"s" (Var "v" F32)))) qVar"s"))))))
+
+
+(Def "dfn'Normal"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+           (Var "skip" CTy"conditionT") (Var "w" (FTy 7))
+           (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+  (Close qVar"state"
+    (Apply
+      (Call "norm" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                 (Var "skip" CTy"conditionT") LT LF (Var "w" (FTy 7))
+                 (Var "a" (FTy 7)) (Var "b" (FTy 7))))) qVar"state")))
+
+
+(Def "dfn'StoreDM"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+           (Var "skip" CTy"conditionT") (Var "w" (FTy 7))
+           (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+  (Close qVar"state"
+    (Apply
+      (Call "norm" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                 (Var "skip" CTy"conditionT") LT LF (Var "w" (FTy 7))
+                 (Var "a" (FTy 7)) (Var "b" (FTy 7)))))
+      (Rupd "DM"
+        (TP
+          (sqbkt qVar"state"
+                 (Fupd (Dest "DM" (ATy (FTy 10) F32) qVar"state")
+                   (Mop (Cast (FTy 10))
+                     (Apply (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                       (Var "b" (FTy 7))))
+                   (Apply (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                     (Var "a" (FTy 7))))))))))
+
+
+(Def "dfn'StoreIM"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+           (Var "skip" CTy"conditionT") (Var "w" (FTy 7))
+           (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+  (Close qVar"state"
+    (Apply
+      (Call "norm" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                 (Var "skip" CTy"conditionT") LT LF (Var "w" (FTy 7))
+                 (Var "a" (FTy 7)) (Var "b" (FTy 7)))))
+      (Rupd "IM"
+        (TP
+          (sqbkt qVar"state"
+                 (Fupd (Dest "IM" (ATy (FTy 10) F32) qVar"state")
+                   (Mop (Cast (FTy 10))
+                     (Apply (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                       (Var "b" (FTy 7))))
+                   (Apply (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                     (Var "a" (FTy 7))))))))))
+
+
+(Def "dfn'Out"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+           (Var "skip" CTy"conditionT") (Var "w" (FTy 7))
+           (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+  (Close qVar"state"
+    (Apply
+      (Call "norm" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                 (Var "skip" CTy"conditionT") LT LT (Var "w" (FTy 7))
+                 (Var "a" (FTy 7)) (Var "b" (FTy 7))))) qVar"state")))
+
+
+(Def "dfn'LoadDM"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+           (Var "skip" CTy"conditionT") (Var "w" (FTy 7))
+           (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+  (Close qVar"state"
+    (Apply
+      (Call "norm" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                 (Var "skip" CTy"conditionT") LF LF (Var "w" (FTy 7))
+                 (Var "a" (FTy 7)) (Var "b" (FTy 7)))))
+      (Rupd "R"
+        (TP
+          (sqbkt qVar"state"
+                 (Fupd (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                   (Var "w" (FTy 7))
+                   (Apply (Dest "DM" (ATy (FTy 10) F32) qVar"state")
+                     (Mop (Cast (FTy 10))
+                       (Apply (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                         (Var "b" (FTy 7))))))))))))
+
+
+(Def "dfn'In"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+           (Var "skip" CTy"conditionT") (Var "w" (FTy 7))
+           (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+  (Close qVar"state"
+    (Apply
+      (Call "norm" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                 (Var "skip" CTy"conditionT") LF LF (Var "w" (FTy 7))
+                 (Var "a" (FTy 7)) (Var "b" (FTy 7)))))
+      (Rupd "R"
+        (TP
+          (sqbkt qVar"state"
+                 (Fupd (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                   (Var "w" (FTy 7)) (Dest "InData" F32 qVar"state"))))))))
+
+
+(Def "dfn'Jump"
+  (TP
+    (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+           (Var "w" (FTy 7)) (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (Rupd "R"
+        (TP
+          (sqbkt qVar"state"
+                 (Fupd (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                   (Var "w" (FTy 7))
+                   (Mop (Cast F32)
+                     (Bop Add (Dest "PC" (FTy 10) qVar"state") (LW 1 10)))))))
+      (Let (TP (sqbkt (Var "v" (FTy 10)) qVar"s"))
+        (Let (TP (sqbkt (Var "v" F32) qVar"s"))
+          (Apply
+            (Call "ALU" (ATy qTy (PTy F32 qTy))
+              (TP
+                (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                       (Apply (Dest "R" (ATy (FTy 7) F32) qVar"s")
+                         (Var "a" (FTy 7)))
+                       (Apply (Dest "R" (ATy (FTy 7) F32) qVar"s")
+                         (Var "b" (FTy 7)))))) qVar"s")
+          (TP (sqbkt (Mop (Cast (FTy 10)) (Var "v" F32)) qVar"s")))
+        (TP
+          (sqbkt LU (Rupd "PC" (TP (sqbkt qVar"s" (Var "v" (FTy 10)))))))))))
+
+
+(Def "dfn'LoadConstant"
+  (TP (sqbkt (Var "w" (FTy 7)) (Var "imm" (FTy 24))))
+  (Close qVar"state"
+    (Let qVar"s"
+      (Rupd "R"
+        (TP
+          (sqbkt qVar"state"
+                 (Fupd (Dest "R" (ATy (FTy 7) F32) qVar"state")
+                   (Var "w" (FTy 7))
+                   (Mop (Cast F32) (Var "imm" (FTy 24)))))))
+      (TP
+        (sqbkt LU
+               (Rupd "PC"
+                 (TP
+                   (sqbkt qVar"s"
+                          (Bop Add (Dest "PC" (FTy 10) qVar"s") (LW 1 10))))))))))
+
+
+(Def "dfn'ReservedInstr" qVar"state"
+  (Apply
+    (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+      (LC "Reserved" CTy"exception")) qVar"state"))
+
+
+(Def "Run" (Var "v0" CTy"instruction")
+  (Close qVar"state"
+    (CS (Var "v0" CTy"instruction")
+      (sqbkt ((Const "ReservedInstr" CTy"instruction")
+               (Apply (Const "dfn'ReservedInstr" (ATy qTy (PTy uTy qTy)))
+                 qVar"state"))
+             ((Call "In" CTy"instruction"
+                 (Var "v1"
+                   (PTy CTy"funcT"
+                     (PTy CTy"shiftT"
+                       (PTy CTy"conditionT"
+                         (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+               (Apply
+                 (Call "dfn'In" (ATy qTy (PTy uTy qTy))
+                   (Var "v1"
+                     (PTy CTy"funcT"
+                       (PTy CTy"shiftT"
+                         (PTy CTy"conditionT"
+                           (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                 qVar"state"))
+             ((Call "Jump" CTy"instruction"
+                 (Var "v2"
+                   (PTy CTy"funcT"
+                     (PTy CTy"shiftT" (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+               (Apply
+                 (Call "dfn'Jump" (ATy qTy (PTy uTy qTy))
+                   (Var "v2"
+                     (PTy CTy"funcT"
+                       (PTy CTy"shiftT"
+                         (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+                 qVar"state"))
+             ((Call "LoadConstant" CTy"instruction"
+                 (Var "v3" (PTy (FTy 7) (FTy 24))))
+               (Apply
+                 (Call "dfn'LoadConstant" (ATy qTy (PTy uTy qTy))
+                   (Var "v3" (PTy (FTy 7) (FTy 24)))) qVar"state"))
+             ((Call "LoadDM" CTy"instruction"
+                 (Var "v4"
+                   (PTy CTy"funcT"
+                     (PTy CTy"shiftT"
+                       (PTy CTy"conditionT"
+                         (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+               (Apply
+                 (Call "dfn'LoadDM" (ATy qTy (PTy uTy qTy))
+                   (Var "v4"
+                     (PTy CTy"funcT"
+                       (PTy CTy"shiftT"
+                         (PTy CTy"conditionT"
+                           (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                 qVar"state"))
+             ((Call "Normal" CTy"instruction"
+                 (Var "v5"
+                   (PTy CTy"funcT"
+                     (PTy CTy"shiftT"
+                       (PTy CTy"conditionT"
+                         (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+               (Apply
+                 (Call "dfn'Normal" (ATy qTy (PTy uTy qTy))
+                   (Var "v5"
+                     (PTy CTy"funcT"
+                       (PTy CTy"shiftT"
+                         (PTy CTy"conditionT"
+                           (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                 qVar"state"))
+             ((Call "Out" CTy"instruction"
+                 (Var "v6"
+                   (PTy CTy"funcT"
+                     (PTy CTy"shiftT"
+                       (PTy CTy"conditionT"
+                         (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+               (Apply
+                 (Call "dfn'Out" (ATy qTy (PTy uTy qTy))
+                   (Var "v6"
+                     (PTy CTy"funcT"
+                       (PTy CTy"shiftT"
+                         (PTy CTy"conditionT"
+                           (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                 qVar"state"))
+             ((Call "StoreDM" CTy"instruction"
+                 (Var "v7"
+                   (PTy CTy"funcT"
+                     (PTy CTy"shiftT"
+                       (PTy CTy"conditionT"
+                         (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+               (Apply
+                 (Call "dfn'StoreDM" (ATy qTy (PTy uTy qTy))
+                   (Var "v7"
+                     (PTy CTy"funcT"
+                       (PTy CTy"shiftT"
+                         (PTy CTy"conditionT"
+                           (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                 qVar"state"))
+             ((Call "StoreIM" CTy"instruction"
+                 (Var "v8"
+                   (PTy CTy"funcT"
+                     (PTy CTy"shiftT"
+                       (PTy CTy"conditionT"
+                         (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+               (Apply
+                 (Call "dfn'StoreIM" (ATy qTy (PTy uTy qTy))
+                   (Var "v8"
+                     (PTy CTy"funcT"
+                       (PTy CTy"shiftT"
+                         (PTy CTy"conditionT"
+                           (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+                 qVar"state"))))))
+
+
+(Def "Decode" (Var "opc" F32)
+  (Let
+    (TP
+      (sqbkt bVar"b'31" bVar"b'30" bVar"b'29" bVar"b'28" bVar"b'27"
+             bVar"b'26" bVar"b'25" bVar"b'24" bVar"b'23" bVar"b'22"
+             bVar"b'21" bVar"b'20" bVar"b'19" bVar"b'18" bVar"b'17"
+             bVar"b'16" bVar"b'15" bVar"b'14" bVar"b'13" bVar"b'12"
+             bVar"b'11" bVar"b'10" bVar"b'9" bVar"b'8" bVar"b'7" bVar"b'6"
+             bVar"b'5" bVar"b'4" bVar"b'3" bVar"b'2" bVar"b'1" bVar"b'0"))
+    (BL 32 (Var "opc" F32))
+    (ITE bVar"b'24"
+      (Call "LoadConstant" CTy"instruction"
+        (TP
+          (sqbkt (EX (Var "opc" F32) (LN 31) (LN 25) (FTy 7))
+                 (EX (Var "opc" F32) (LN 23) (LN 0) (FTy 24)))))
+      (Let (Var "Rw" (FTy 7)) (EX (Var "opc" F32) (LN 31) (LN 25) (FTy 7))
+        (Let (Var "Rb" (FTy 7))
+          (EX (Var "opc" F32) (LN 16) (LN 10) (FTy 7))
+          (Let (Var "Ra" (FTy 7))
+            (EX (Var "opc" F32) (LN 23) (LN 17) (FTy 7))
+            (Let (Var "func" CTy"funcT")
+              (Mop (Cast CTy"funcT")
+                (EX (Var "opc" F32) (LN 9) (LN 7) (FTy 3)))
+              (Let (Var "shift" CTy"shiftT")
+                (Mop (Cast CTy"shiftT")
+                  (EX (Var "opc" F32) (LN 6) (LN 5) (FTy 2)))
+                (Let (Var "skip" CTy"conditionT")
+                  (Mop (Cast CTy"conditionT")
+                    (EX (Var "opc" F32) (LN 4) (LN 3) (FTy 2)))
+                  (CS (EX (Var "opc" F32) (LN 2) (LN 0) (FTy 3))
+                    (sqbkt ((LW 0 3)
+                             (Call "Normal" CTy"instruction"
+                               (TP
+                                 (sqbkt (Var "func" CTy"funcT")
+                                        (Var "shift" CTy"shiftT")
+                                        (Var "skip" CTy"conditionT")
+                                        (Var "Rw" (FTy 7))
+                                        (Var "Ra" (FTy 7))
+                                        (Var "Rb" (FTy 7))))))
+                           ((LW 1 3)
+                             (Call "StoreDM" CTy"instruction"
+                               (TP
+                                 (sqbkt (Var "func" CTy"funcT")
+                                        (Var "shift" CTy"shiftT")
+                                        (Var "skip" CTy"conditionT")
+                                        (Var "Rw" (FTy 7))
+                                        (Var "Ra" (FTy 7))
+                                        (Var "Rb" (FTy 7))))))
+                           ((LW 2 3)
+                             (Call "StoreIM" CTy"instruction"
+                               (TP
+                                 (sqbkt (Var "func" CTy"funcT")
+                                        (Var "shift" CTy"shiftT")
+                                        (Var "skip" CTy"conditionT")
+                                        (Var "Rw" (FTy 7))
+                                        (Var "Ra" (FTy 7))
+                                        (Var "Rb" (FTy 7))))))
+                           ((LW 3 3)
+                             (Call "Out" CTy"instruction"
+                               (TP
+                                 (sqbkt (Var "func" CTy"funcT")
+                                        (Var "shift" CTy"shiftT")
+                                        (Var "skip" CTy"conditionT")
+                                        (Var "Rw" (FTy 7))
+                                        (Var "Ra" (FTy 7))
+                                        (Var "Rb" (FTy 7))))))
+                           ((LW 4 3)
+                             (Call "LoadDM" CTy"instruction"
+                               (TP
+                                 (sqbkt (Var "func" CTy"funcT")
+                                        (Var "shift" CTy"shiftT")
+                                        (Var "skip" CTy"conditionT")
+                                        (Var "Rw" (FTy 7))
+                                        (Var "Ra" (FTy 7))
+                                        (Var "Rb" (FTy 7))))))
+                           ((LW 5 3)
+                             (Call "In" CTy"instruction"
+                               (TP
+                                 (sqbkt (Var "func" CTy"funcT")
+                                        (Var "shift" CTy"shiftT")
+                                        (Var "skip" CTy"conditionT")
+                                        (Var "Rw" (FTy 7))
+                                        (Var "Ra" (FTy 7))
+                                        (Var "Rb" (FTy 7))))))
+                           ((LW 6 3)
+                             (Call "Jump" CTy"instruction"
+                               (TP
+                                 (sqbkt (Var "func" CTy"funcT")
+                                        (Var "shift" CTy"shiftT")
+                                        (Var "Rw" (FTy 7))
+                                        (Var "Ra" (FTy 7))
+                                        (Var "Rb" (FTy 7))))))
+                           ((LW 7 3)
+                             (Const "ReservedInstr" CTy"instruction")))))))))))))
+
+
+(Def "Next" qVar"state"
+  (Let (Var "v" CTy"instruction")
+    (Call "Decode" CTy"instruction"
+      (Apply (Dest "IM" (ATy (FTy 10) F32) qVar"state")
+        (Dest "PC" (FTy 10) qVar"state")))
+    (ITE
+      (Mop Not
+        (EQ (Var "v" CTy"instruction")
+          (Const "ReservedInstr" CTy"instruction")))
+      (Apply
+        (Call "Run" (ATy qTy (PTy uTy qTy)) (Var "v" CTy"instruction"))
+        qVar"state") (TP (sqbkt LU qVar"state")))))
+
+
+(Def "enc"
+  (TP
+    (sqbkt (Var "args"
+             (PTy CTy"funcT"
+               (PTy CTy"shiftT"
+                 (PTy CTy"conditionT" (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+           (Var "opc" (FTy 3))))
+  (Let
+    (TP
+      (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+             (Var "skip" CTy"conditionT") (Var "w" (FTy 7))
+             (Var "a" (FTy 7)) (Var "b" (FTy 7))))
+    (Var "args"
+      (PTy CTy"funcT"
+        (PTy CTy"shiftT"
+          (PTy CTy"conditionT" (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+    (CC(sqbkt (Var "w" (FTy 7)) (LW 0 1) (Var "a" (FTy 7))
+              (Var "b" (FTy 7))
+              (Mop (Cast (FTy 3)) (Var "func" CTy"funcT"))
+              (Mop (Cast (FTy 2)) (Var "shift" CTy"shiftT"))
+              (Mop (Cast (FTy 2)) (Var "skip" CTy"conditionT"))
+              (Var "opc" (FTy 3))))))
+
+
+(Def "Encode" (Var "i" CTy"instruction")
+  (CS (Var "i" CTy"instruction")
+    (sqbkt ((Call "LoadConstant" CTy"instruction"
+               (TP (sqbkt (Var "Rw" (FTy 7)) (Var "imm" (FTy 24)))))
+             (CC(sqbkt (Var "Rw" (FTy 7)) (LW 1 1) (Var "imm" (FTy 24)))))
+           ((Call "Normal" CTy"instruction"
+               (Var "args"
+                 (PTy CTy"funcT"
+                   (PTy CTy"shiftT"
+                     (PTy CTy"conditionT"
+                       (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+             (Call "enc" F32
+               (TP
+                 (sqbkt (Var "args"
+                          (PTy CTy"funcT"
+                            (PTy CTy"shiftT"
+                              (PTy CTy"conditionT"
+                                (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+                        (LW 0 3)))))
+           ((Call "StoreDM" CTy"instruction"
+               (Var "args"
+                 (PTy CTy"funcT"
+                   (PTy CTy"shiftT"
+                     (PTy CTy"conditionT"
+                       (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+             (Call "enc" F32
+               (TP
+                 (sqbkt (Var "args"
+                          (PTy CTy"funcT"
+                            (PTy CTy"shiftT"
+                              (PTy CTy"conditionT"
+                                (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+                        (LW 1 3)))))
+           ((Call "StoreIM" CTy"instruction"
+               (Var "args"
+                 (PTy CTy"funcT"
+                   (PTy CTy"shiftT"
+                     (PTy CTy"conditionT"
+                       (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+             (Call "enc" F32
+               (TP
+                 (sqbkt (Var "args"
+                          (PTy CTy"funcT"
+                            (PTy CTy"shiftT"
+                              (PTy CTy"conditionT"
+                                (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+                        (LW 2 3)))))
+           ((Call "Out" CTy"instruction"
+               (Var "args"
+                 (PTy CTy"funcT"
+                   (PTy CTy"shiftT"
+                     (PTy CTy"conditionT"
+                       (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+             (Call "enc" F32
+               (TP
+                 (sqbkt (Var "args"
+                          (PTy CTy"funcT"
+                            (PTy CTy"shiftT"
+                              (PTy CTy"conditionT"
+                                (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+                        (LW 3 3)))))
+           ((Call "LoadDM" CTy"instruction"
+               (Var "args"
+                 (PTy CTy"funcT"
+                   (PTy CTy"shiftT"
+                     (PTy CTy"conditionT"
+                       (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+             (Call "enc" F32
+               (TP
+                 (sqbkt (Var "args"
+                          (PTy CTy"funcT"
+                            (PTy CTy"shiftT"
+                              (PTy CTy"conditionT"
+                                (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+                        (LW 4 3)))))
+           ((Call "In" CTy"instruction"
+               (Var "args"
+                 (PTy CTy"funcT"
+                   (PTy CTy"shiftT"
+                     (PTy CTy"conditionT"
+                       (PTy (FTy 7) (PTy (FTy 7) (FTy 7))))))))
+             (Call "enc" F32
+               (TP
+                 (sqbkt (Var "args"
+                          (PTy CTy"funcT"
+                            (PTy CTy"shiftT"
+                              (PTy CTy"conditionT"
+                                (PTy (FTy 7) (PTy (FTy 7) (FTy 7)))))))
+                        (LW 5 3)))))
+           ((Call "Jump" CTy"instruction"
+               (TP
+                 (sqbkt (Var "func" CTy"funcT") (Var "shift" CTy"shiftT")
+                        (Var "Rw" (FTy 7)) (Var "Ra" (FTy 7))
+                        (Var "Rb" (FTy 7)))))
+             (Call "enc" F32
+               (TP
+                 (sqbkt (TP
+                          (sqbkt (Var "func" CTy"funcT")
+                                 (Var "shift" CTy"shiftT")
+                                 (LC "skipNever" CTy"conditionT")
+                                 (Var "Rw" (FTy 7)) (Var "Ra" (FTy 7))
+                                 (Var "Rb" (FTy 7)))) (LW 6 3)))))
+           ((Const "ReservedInstr" CTy"instruction") (LW 7 32)))))
+
+
+(tDef "LoadIM"
+  (TP (sqbkt (Var "a" (FTy 10)) (Var "i" (LTy CTy"instruction"))))
+  (Close qVar"state"
+    (CS (Var "i" (LTy CTy"instruction"))
+      (sqbkt ((LNL CTy"instruction") (TP (sqbkt LU qVar"state")))
+             ((LLC (sqbkt (Var "h" CTy"instruction"))
+                 (Var "t" (LTy CTy"instruction")))
+               (Apply
+                 (Call "LoadIM" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Bop Add (Var "a" (FTy 10)) (LW 1 10))
+                            (Var "t" (LTy CTy"instruction")))))
+                 (Rupd "IM"
+                   (TP
+                     (sqbkt qVar"state"
+                            (Fupd
+                              (Dest "IM" (ATy (FTy 10) F32) qVar"state")
+                              (Var "a" (FTy 10))
+                              (Call "Encode" F32
+                                (Var "h" CTy"instruction")))))))))))
+  (Close (Var "x" (PTy (PTy (FTy 10) (LTy CTy"instruction")) qTy))
+    (CS (Var "x" (PTy (PTy (FTy 10) (LTy CTy"instruction")) qTy))
+      (sqbkt ((TP
+                 (sqbkt (TP
+                          (sqbkt (Var "a" (FTy 10))
+                                 (Var "i" (LTy CTy"instruction"))))
+                        (AVar qTy)))
+               (Mop Length (Var "i" (LTy CTy"instruction"))))))))
+
+
+(Def "initialize" (Var "p" (LTy CTy"instruction"))
+  (Close qVar"state"
+    (Apply
+      (Call "LoadIM" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt (LW 0 10) (Var "p" (LTy CTy"instruction")))))
+      (Rupd "IM"
+        (TP
+          (sqbkt (Rupd "OutStrobe"
+                   (TP
+                     (sqbkt (Rupd "InData"
+                              (TP
+                                (sqbkt (Rupd "InRdy"
+                                         (TP
+                                           (sqbkt (Rupd "DM"
+                                                    (TP
+                                                      (sqbkt (Rupd "R"
+                                                               (TP
+                                                                 (sqbkt (Rupd
+                                                                          "PC"
+                                                                          (TP
+                                                                            (sqbkt qVar"state"
+                                                                                   (LW
+                                                                                     0
+                                                                                     10))))
+                                                                        (Mop
+                                                                          (K1
+                                                                            (FTy
+                                                                              7))
+                                                                          (LW
+                                                                            0
+                                                                            32)))))
+                                                             (Mop
+                                                               (K1
+                                                                 (FTy 10))
+                                                               (LW 0 32)))))
+                                                  LF))) (LW 0 32))))
+                            (LW 0 32))))
+                 (Mop (K1 (FTy 10))
+                   (Call "Encode" F32
+                     (Const "ReservedInstr" CTy"instruction")))))))))
+
+
+(Def0 "test_prog"
+  (LL(sqbkt (Call "LoadConstant" CTy"instruction"
+              (TP (sqbkt (LW 0 7) (LW 0 24))))
+            (Call "LoadConstant" CTy"instruction"
+              (TP (sqbkt (LW 1 7) (LW 1000 24))))
+            (Call "LoadConstant" CTy"instruction"
+              (TP (sqbkt (LW 2 7) (LW 1010 24))))
+            (Call "LoadConstant" CTy"instruction"
+              (TP (sqbkt (LW 3 7) (LW 4 24))))
+            (Call "StoreDM" CTy"instruction"
+              (TP
+                (sqbkt (LC "fINC" CTy"funcT") (LC "noShift" CTy"shiftT")
+                       (LC "skipNever" CTy"conditionT") (LW 1 7) (LW 1 7)
+                       (LW 1 7))))
+            (Call "Normal" CTy"instruction"
+              (TP
+                (sqbkt (LC "fXOR" CTy"funcT") (LC "noShift" CTy"shiftT")
+                       (LC "skipZero" CTy"conditionT") (LW 4 7) (LW 1 7)
+                       (LW 2 7))))
+            (Call "Jump" CTy"instruction"
+              (TP
+                (sqbkt (LC "fADD" CTy"funcT") (LC "noShift" CTy"shiftT")
+                       (LW 4 7) (LW 3 7) (LW 0 7))))
+            (Call "Out" CTy"instruction"
+              (TP
+                (sqbkt (LC "fADD" CTy"funcT") (LC "noShift" CTy"shiftT")
+                       (LC "skipNever" CTy"conditionT") (LW 1 7) (LW 1 7)
+                       (LW 0 7)))))))
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tiny-manual.lisp acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tiny-manual.lisp
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tiny-manual.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tiny-manual.lisp	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,1916 @@
+; ACL2 hand-translation of tiny.spec
+
+; See notes.txt for thoughts about automated translation.
+
+(in-package "ACL2")
+
+(include-book "../../translator/l3")
+
+#||
+type regT  = bits(7)
+type wordT = bits(32)
+type immT  = bits(24)
+type addrT = bits(10)
+type memT  = addrT -> wordT
+||#
+
+#||
+exception Reserved
+||#
+
+#||
+construct funcT {fADD, fSUB, fINC, fDEC, fAND, fOR, fXOR, fReserved}
+construct shiftT {noShift, RCY1, RCY8, RCY16}
+construct conditionT {skipNever, skipNeg, skipZero, skipInRdy}
+
+val _ = Construct[("funcT",
+    [("fADD",[]), ("fSUB",[]), ("fINC",[]), ("fDEC",[]), ("fAND",[]),
+     ("fOR",[]), ("fXOR",[]), ("fReserved",[])])]
+;
+||#
+
+(construct funcT (fADD fSUB fINC fDEC fAND fOR fXOR fReserved))
+(construct shiftT (noShift RCY1 RCY8 RCY16))
+(construct conditionT (skipNever skipNeg skipZero skipInRdy))
+(construct exception (NoException Reserved))
+
+#||
+
+---------------------------------------------
+-- State
+---------------------------------------------
+
+declare
+{
+   PC :: addrT          -- Program Counter
+   R :: regT -> wordT   -- Registers
+   IM :: memT           -- Instruction Memory
+   DM :: memT           -- Data Memory
+   InRdy :: bool        -- Input Ready
+   InData :: wordT      -- Input Data
+   OutStrobe :: wordT   -- Output Data
+}
+
+||#
+
+#||
+(val _ = Record
+  ("tiny-acl2.txt_state"
+    (sqbkt ("DM" (ATy (FTy 10) F32)) ("IM" (ATy (FTy 10) F32))
+           ("InData" F32) ("InRdy" bTy) ("OutStrobe" F32) ("PC" (FTy 10))
+           ("R" (ATy (FTy 7) F32)) ("exception" CTy"exception"))))
+||#
+
+(defstobj+ st$
+  (dm :type (array (unsigned-byte 32) (1024)) ; addrT -> wordT
+      :initially 0)
+  (im :type (array (unsigned-byte 32) (1024)) ; addrT -> wordT
+      :initially 0)
+  (indata :type (unsigned-byte 32) ; wordT
+          :initially 0)
+  (inrdy :type (satisfies booleanp))
+  (outstrobe :type (unsigned-byte 32) ; wordT
+             :initially 0)
+  (pctr :type (unsigned-byte 10) ; addrT
+        :initially 0)
+  (r :type (array (unsigned-byte 32) (128)) ; regT -> wordT
+     :initially 0)
+  exception
+  )
+
+#||
+
+---------------------------------------------
+-- Operations
+---------------------------------------------
+
+wordT function (func::funcT, a:: wordT, b:: wordT) =
+   match func
+   {
+     case fADD => a + b
+     case fSUB => a - b
+     case fINC => b + 1
+     case fDEC => b - 1
+     case fAND => a && b
+     case fOR  => a || b
+     case fXOR => a ?? b
+     case _ => #Reserved
+   }
+
+val function_def = Def
+  ("function",TP[Var("func",CTy"funcT"), Var("a",F32), Var("b",F32)],
+   Close
+     (qVar"state",
+      CS
+        (Var("func",CTy"funcT"),
+         [(LC("fADD",CTy"funcT"),
+           TP[Bop(Add,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (LC("fSUB",CTy"funcT"),
+           TP[Bop(Sub,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (LC("fINC",CTy"funcT"),
+           TP[Bop(Add,Var("b",F32),LW(1,32)), qVar"state"]),
+          (LC("fDEC",CTy"funcT"),
+           TP[Bop(Sub,Var("b",F32),LW(1,32)), qVar"state"]),
+          (LC("fAND",CTy"funcT"),
+           TP[Bop(BAnd,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (LC("fOR",CTy"funcT"),
+           TP[Bop(BOr,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (LC("fXOR",CTy"funcT"),
+           TP[Bop(BXor,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (AVar(CTy"funcT"),
+           Apply
+             (Call
+                ("raise'exception",ATy(qTy,PTy(F32,qTy)),
+                 LC("Reserved",CTy"exception")),qVar"state"))])))
+;
+
+   [function_def]  Definition
+
+      |-  func a b.
+           function (func,a,b) =
+           ( state.
+              case func of
+                fADD => (a + b,state)
+              | fSUB => (a   b,state)
+              | fINC => (b + 1w,state)
+              | fDEC => (b   1w,state)
+              | fAND => (a && b,state)
+              | fOR => (a   b,state)
+              | fXOR => (a   b,state)
+              | fReserved => raise'exception Reserved state)
+||#
+
+(defun-struct function0 (((func (type-funct func))
+                          (a (unsigned-byte-p 32 a))
+                          (b (unsigned-byte-p 32 b)))
+                         st$)
+  (declare (xargs :stobjs st$))
+  (case-match+
+   func
+   ('fadd (mv (n+ 32 a b) st$))
+   ('fsub (mv (n- 32 a b) st$))
+   ('finc (mv (n+ 32 b 1) st$))
+   ('fdec (mv (n- 32 b 1) st$))
+   ('fand (mv (logand a b) st$))
+   ('for  (mv (logior a b) st$))
+   ('fxor (mv (logxor a b) st$))
+   (& (raise-exception 'reserved
+                       (arb (unsigned-byte 32))
+                       st$))))
+
+#||
+wordT shifter (shift::shiftT, a::wordT) =
+   match shift
+   {
+      case noShift => a
+      case RCY1    => a #>> 1
+      case RCY8    => a #>> 8
+      case RCY16   => a #>> 16
+   }
+
+val shifter_def = Def
+  ("shifter",TP[Var("shift",CTy"shiftT"), Var("a",F32)],
+   CS
+     (Var("shift",CTy"shiftT"),
+      [(LC("noShift",CTy"shiftT"),Var("a",F32)),
+       (LC("RCY1",CTy"shiftT"),Bop(Ror,Var("a",F32),LN 1)),
+       (LC("RCY8",CTy"shiftT"),Bop(Ror,Var("a",F32),LN 8)),
+       (LC("RCY16",CTy"shiftT"),Bop(Ror,Var("a",F32),LN 16))]))
+;
+
+   [shifter_def]  Definition
+
+      |-  shift a.
+           shifter (shift,a) =
+           case shift of
+             noShift => a
+           | RCY1 => a   1
+           | RCY8 => a   8
+           | RCY16 => a   16
+
+||#
+
+;;; Translation note: when generating case-match+, when the last condition is
+;;; not t, we may replace the last case with t and just call assert! (see
+;;; l3.lisp) to check that it's the expected value.
+
+(defun-struct shifter (((shift (type-shiftt shift))
+                        (a (unsigned-byte-p 32 a))))
+  (case-match+
+   shift
+   ('noshift a)
+   ('rcy1 (ash a -1))
+   ('rcy8 (ash a -8))
+   ('rcy16 (ash a -16))
+   (& (assert! nil
+               (arb (unsigned-byte 32))))))
+
+#||
+wordT ALU (func::funcT, shift::shiftT, a::wordT, b::wordT) =
+   shifter (shift, function (func, a, b))
+
+val ALU_def = Def
+  ("ALU",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"), Var("a",F32),
+      Var("b",F32)],
+   Close
+     (qVar"state",
+      Let
+        (TP[Var("v",F32), qVar"s"],
+         Apply
+           (Call
+              ("function",ATy(qTy,PTy(F32,qTy)),
+               TP[Var("func",CTy"funcT"), Var("a",F32), Var("b",F32)]),
+            qVar"state"),
+         TP[Call("shifter",F32,TP[Var("shift",CTy"shiftT"), Var("v",F32)]),
+            qVar"s"])))
+;
+
+   [ALU_def]  Definition
+
+      |-  func shift a b.
+           ALU (func,shift,a,b) =
+           ( state.
+              (let (v,s) = function (func,a,b) state
+               in
+                 (shifter (shift,v),s)))
+
+||#
+
+; Note that since alu takes st$, it returns st$ -- well, at least I think
+; that's the scheme, but actually no such thinking is required if I simply go
+; by what's in the ML code.
+
+(defun-struct alu (((func (type-funct func))
+                    (shift (type-shiftt shift))
+                    (a (unsigned-byte-p 32 a))
+                    (b (unsigned-byte-p 32 b)))
+                   st$)
+  (declare (xargs :stobjs st$))
+  (mv-let (v st$)
+          (function0 (tuple func a b) st$)
+          (mv (shifter (tuple shift v)) st$)))
+
+#||
+unit incPC (skip::conditionT, alu::wordT) =
+   match skip
+   {
+      case skipNever => PC <- PC + 1
+      case skipNeg   => PC <- PC + if alu < 0  then 2 else 1
+      case skipZero  => PC <- PC + if alu == 0 then 2 else 1
+      case skipInRdy => PC <- PC + if InRdy    then 2 else 1
+   }
+
+val incPC_def = Def
+  ("incPC",TP[Var("skip",CTy"conditionT"), Var("alu",F32)],
+   Close
+     (qVar"state",
+      CS
+        (Var("skip",CTy"conditionT"),
+         [(LC("skipNever",CTy"conditionT"),
+           TP[LU,
+              Rupd
+                ("PC",
+                 TP[qVar"state",
+                    Bop(Add,Dest("PC",FTy 10,qVar"state"),LW(1,10))])]),
+          (LC("skipNeg",CTy"conditionT"),
+           TP[LU,
+              Rupd
+                ("PC",
+                 TP[qVar"state",
+                    Bop
+                      (Add,Dest("PC",FTy 10,qVar"state"),
+                       ITE
+                         (Bop(Lt,Var("alu",F32),LW(0,32)),LW(2,10),
+                          LW(1,10)))])]),
+          (LC("skipZero",CTy"conditionT"),
+           TP[LU,
+              Rupd
+                ("PC",
+                 TP[qVar"state",
+                    Bop
+                      (Add,Dest("PC",FTy 10,qVar"state"),
+                       ITE(EQ(Var("alu",F32),LW(0,32)),LW(2,10),LW(1,10)))])]),
+          (LC("skipInRdy",CTy"conditionT"),
+           TP[LU,
+              Rupd
+                ("PC",
+                 TP[qVar"state",
+                    Bop
+                      (Add,Dest("PC",FTy 10,qVar"state"),
+                       ITE
+                         (Dest("InRdy",bTy,qVar"state"),LW(2,10),LW(1,10)))])])])))
+;
+
+   [incPC_def]  Definition
+
+      |-  skip alu.
+           incPC (skip,alu) =
+           ( state.
+              case skip of
+                skipNever => ((),state with PC := state.PC + 1w)
+              | skipNeg =>
+                  ((),
+                   state with PC := state.PC + if alu < 0w then 2w else 1w)
+              | skipZero =>
+                  ((),
+                   state with PC := state.PC + if alu = 0w then 2w else 1w)
+              | skipInRdy =>
+                  ((),
+                   state with
+                   PC := state.PC + if state.InRdy then 2w else 1w))
+
+||#
+
+(defun-struct incpc (((skip (type-conditiont skip))
+                      (alu_var (unsigned-byte-p 32 alu_var)))
+                     st$)
+  (declare (xargs :stobjs st$))
+  (case-match+
+   skip
+   ('skipnever (let ((st$ (update-pctr (n+ 10 (pctr st$) 1) st$)))
+                 (mv (unit-value) st$)))
+   ('skipneg (let ((st$ (update-pctr (n+ 10
+                                         (pctr st$)
+                                         (if (< alu_var 0) 2 1))
+                                     st$)))
+               (mv (unit-value) st$)))
+   ('skipzero (let ((st$ (update-pctr (n+ 10
+                                          (pctr st$)
+                                          (if (eql alu_var 0) 2 1))
+                                      st$)))
+                (mv (unit-value) st$)))
+   ('skipinrdy (let ((st$ (update-pctr (n+ 10
+                                           (pctr st$)
+                                           (if (inrdy st$) 2 1))
+                                       st$)))
+                 (mv (unit-value) st$)))
+   (& (assert! nil
+               (mv (arb uty) st$)))))
+
+#||
+-- Common functionality
+unit norm (func::funcT, shift::shiftT, skip::conditionT,
+           wback::bool, strobe::bool, w::regT, a::regT, b::regT) =
+{
+   alu = ALU (func, shift, R(a), R(b));
+   when wback do R(w) <- alu;
+   when strobe do OutStrobe <- alu;
+   incPC (skip, alu)
+}
+
+val norm_def = Def
+  ("norm",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), bVar"wback", bVar"strobe",
+      Var("w",FTy 7), Var("a",FTy 7), Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Let
+        (TP[Var("v",F32), qVar"s"],
+         Apply
+           (Call
+              ("ALU",ATy(qTy,PTy(F32,qTy)),
+               TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+                  Apply
+                    (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("a",FTy 7)),
+                  Apply
+                    (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("b",FTy 7))]),
+            qVar"state"),
+         Let
+           (qVar"s",
+            ITE
+              (bVar"wback",
+               Rupd
+                 ("R",
+                  TP[qVar"s",
+                     Fupd
+                       (Dest("R",ATy(FTy 7,F32),qVar"s"),Var("w",FTy 7),
+                        Var("v",F32))]),qVar"s"),
+            Apply
+              (Call
+                 ("incPC",ATy(qTy,PTy(uTy,qTy)),
+                  TP[Var("skip",CTy"conditionT"), Var("v",F32)]),
+               ITE
+                 (bVar"strobe",
+                  Rupd("OutStrobe",TP[qVar"s", Var("v",F32)]),qVar"s"))))))
+;
+
+   [norm_def]  Definition
+
+      |-  func shift skip wback strobe w a b.
+           norm (func,shift,skip,wback,strobe,w,a,b) =
+           ( state.
+              (let (v,s) = ALU (func,shift,state.R a,state.R b) state in
+               let s = if wback then s with R := (w =+ v) s.R else s
+               in
+                 incPC (skip,v)
+                   (if strobe then s with OutStrobe := v else s)))
+
+||#
+
+(defthm rp-yields-unsigned-byte-p-32
+  (implies (and (rp x)
+                (natp a)
+                (< a (len x)))
+           (unsigned-byte-p 32 (nth a x)))
+  :rule-classes ((:rewrite
+                  :corollary
+                  (implies (and (rp x)
+                                (natp a)
+                                (< a (len x)))
+                           (unsigned-byte-p 32 (nth a x))))
+                 (:type-prescription
+                  :corollary
+                  (implies (and (rp x)
+                                (natp a)
+                                (< a (len x)))
+                           (integerp (nth a x))))))
+
+(encapsulate
+ ()
+
+ (local (scatter-exponents))
+
+ (defthm unsigned-byte-p-ash-negative
+   (implies (and (posp k)
+                 (unsigned-byte-p k x)
+                 (integerp n)
+                 (<= n 0))
+            (unsigned-byte-p k (ash x n)))
+   :hints (("Goal"
+            :in-theory (enable unsigned-byte-p)
+            :nonlinearp t))))
+
+(defun-struct norm (((func (type-funct func))
+                     (shift (type-shiftt shift))
+                     (skip (type-conditiont skip))
+                     (wback (booleanp wback))
+                     (strobe (booleanp strobe))
+                     (w (unsigned-byte-p 7 w))
+                     (a (unsigned-byte-p 7 a))
+                     (b (unsigned-byte-p 7 b)))
+                    st$)
+  (declare (xargs :stobjs st$))
+  (mv-let (v st$)
+          (alu (tuple func shift (ri a st$) (ri b st$)) st$)
+          (let* ((st$ (if wback
+                          (update-ri w v st$)
+                        st$))
+                 (st$ (if strobe
+                          (update-outstrobe v st$)
+                        st$)))
+            (incpc (tuple skip v) st$))))
+
+#||
+---------------------------------------------
+-- Instructions
+---------------------------------------------
+||#
+
+#||
+define Normal (func::funcT, shift::shiftT, skip::conditionT,
+               w::regT, a::regT, b::regT) =
+   norm (func, shift, skip, true, false, w, a, b)
+
+val dfn'Normal_def = Def
+  ("dfn'Normal",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+      Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Apply
+        (Call
+           ("norm",ATy(qTy,PTy(uTy,qTy)),
+            TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+               Var("skip",CTy"conditionT"), LT, LF, Var("w",FTy 7),
+               Var("a",FTy 7), Var("b",FTy 7)]),qVar"state")))
+;
+
+   [dfn'Normal_def]  Definition
+
+      |-  func shift skip w a b.
+           dfn'Normal (func,shift,skip,w,a,b) =
+           ( state. norm (func,shift,skip,T,F,w,a,b) state)
+
+||#
+
+(defun-struct dfn-normal (((func (type-funct func))
+                           (shift (type-shiftt shift))
+                           (skip (type-conditiont skip))
+                           (w (unsigned-byte-p 7 w))
+                           (a (unsigned-byte-p 7 a))
+                           (b (unsigned-byte-p 7 b)))
+                          st$)
+  (declare (xargs :stobjs st$))
+  (norm (tuple func shift skip (true) (false) w a b)
+        st$))
+
+#||
+
+define StoreDM (func::funcT, shift::shiftT, skip::conditionT,
+                w::regT, a::regT, b::regT) =
+{
+   DM([R(b)]) <- R(a);
+   norm (func, shift, skip, true, false, w, a, b)
+}
+
+val dfn'StoreDM_def = Def
+  ("dfn'StoreDM",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+      Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Apply
+        (Call
+           ("norm",ATy(qTy,PTy(uTy,qTy)),
+            TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+               Var("skip",CTy"conditionT"), LT, LF, Var("w",FTy 7),
+               Var("a",FTy 7), Var("b",FTy 7)]),
+         Rupd
+           ("DM",
+            TP[qVar"state",
+               Fupd
+                 (Dest("DM",ATy(FTy 10,F32),qVar"state"),
+                  Mop
+                    (Cast(FTy 10),
+                     Apply
+                       (Dest("R",ATy(FTy 7,F32),qVar"state"),
+                        Var("b",FTy 7))),
+                  Apply
+                    (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("a",FTy 7)))]))))
+;
+
+   [dfn'StoreDM_def]  Definition
+
+      |-  func shift skip w a b.
+           dfn'StoreDM (func,shift,skip,w,a,b) =
+           ( state.
+              norm (func,shift,skip,T,F,w,a,b)
+                (state with DM := (w2w (state.R b) =+ state.R a) state.DM))
+
+||#
+
+(defun-struct dfn-storedm (((func (type-funct func))
+                            (shift (type-shiftt shift))
+                            (skip (type-conditiont skip))
+                            (w (unsigned-byte-p 7 w))
+                            (a (unsigned-byte-p 7 a))
+                            (b (unsigned-byte-p 7 b)))
+                           st$)
+  (declare (xargs :stobjs st$))
+  (let ((st$ (update-dmi (cast ((unsigned-byte 32) (unsigned-byte 10))
+                               (ri b st$))
+                         (ri a st$)
+                         st$)))
+    (norm (tuple func shift skip (true) (false) w a b) st$)))
+
+#||
+
+define StoreIM (func::funcT, shift::shiftT, skip::conditionT,
+                w::regT, a::regT, b::regT) =
+{
+   IM([R(b)]) <- R(a);
+   norm (func, shift, skip, true, false, w, a, b)
+}
+
+||#
+
+(defun-struct dfn-storeim (((func (type-funct func))
+                            (shift (type-shiftt shift))
+                            (skip (type-conditiont skip))
+                            (w (unsigned-byte-p 7 w))
+                            (a (unsigned-byte-p 7 a))
+                            (b (unsigned-byte-p 7 b)))
+                           st$)
+  (declare (xargs :stobjs st$))
+  (let ((st$ (update-imi (cast ((unsigned-byte 32) (unsigned-byte 10))
+                               (ri b st$))
+                         (ri a st$)
+                         st$)))
+    (norm (tuple func shift skip (true) (false) w a b)
+          st$)))
+
+#||
+
+define Out (func::funcT, shift::shiftT, skip::conditionT,
+            w::regT, a::regT, b::regT) =
+   norm (func, shift, skip, true, true, w, a, b)
+||#
+
+(defun-struct dfn-out (((func (type-funct func))
+                        (shift (type-shiftt shift))
+                        (skip (type-conditiont skip))
+                        (w (unsigned-byte-p 7 w))
+                        (a (unsigned-byte-p 7 a))
+                        (b (unsigned-byte-p 7 b)))
+                       st$)
+  (declare (xargs :stobjs st$))
+  (norm (tuple func shift skip (true) (true) w a b)
+        st$))
+
+#||
+define LoadDM (func::funcT, shift::shiftT, skip::conditionT,
+               w::regT, a::regT, b::regT) =
+{
+   R(w) <- DM([R(b)]);
+   norm (func, shift, skip, false, false, w, a, b)
+}
+||#
+
+(defthm dmp-yields-unsigned-byte-p-32
+  (implies (and (dmp x)
+                (natp a)
+                (< a (len x)))
+           (unsigned-byte-p 32 (nth a x)))
+  :rule-classes ((:rewrite
+                  :corollary
+                  (implies (and (dmp x)
+                                (natp a)
+                                (< a (len x)))
+                           (unsigned-byte-p 32 (nth a x))))
+                 (:type-prescription
+                  :corollary
+                  (implies (and (dmp x)
+                                (natp a)
+                                (< a (len x)))
+                           (integerp (nth a x))))))
+
+(defun-struct dfn-loaddm (((func (type-funct func))
+                           (shift (type-shiftt shift))
+                           (skip (type-conditiont skip))
+                           (w (unsigned-byte-p 7 w))
+                           (a (unsigned-byte-p 7 a))
+                           (b (unsigned-byte-p 7 b)))
+                          st$)
+  (declare (xargs :stobjs st$))
+  (let ((st$ (update-ri w
+                        (dmi (cast ((unsigned-byte 32) (unsigned-byte 10))
+                                   (ri b st$))
+                             st$)
+                        st$)))
+    (norm (tuple func shift skip (false) (false) w a b)
+          st$)))
+
+#||
+define In (func::funcT, shift::shiftT, skip::conditionT,
+           w::regT, a::regT, b::regT) =
+{
+   R(w) <- InData;
+   norm (func, shift, skip, false, false, w, a, b)
+}
+||#
+
+(defun-struct dfn-in (((func (type-funct func))
+                       (shift (type-shiftt shift))
+                       (skip (type-conditiont skip))
+                       (w (unsigned-byte-p 7 w))
+                       (a (unsigned-byte-p 7 a))
+                       (b (unsigned-byte-p 7 b)))
+                      st$)
+  (declare (xargs :stobjs st$))
+  (let ((st$ (update-ri w (indata st$) st$)))
+    (norm (tuple func shift skip (false) (false) w a b)
+          st$)))
+
+#||
+define Jump (func::funcT, shift::shiftT, w::regT, a::regT, b::regT) =
+{
+   R(w) <- ZeroExtend (PC + 1);
+   PC <- [ALU (func, shift, R(a), R(b))]
+}
+
+val dfn'Jump_def = Def
+  ("dfn'Jump",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"), Var("w",FTy 7),
+      Var("a",FTy 7), Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Let
+        (qVar"s",
+         Rupd
+           ("R",
+            TP[qVar"state",
+               Fupd
+                 (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("w",FTy 7),
+                  Mop
+                    (Cast(F32),
+                     Bop(Add,Dest("PC",FTy 10,qVar"state"),LW(1,10))))]),
+         Let
+           (TP[Var("v",FTy 10), qVar"s"],
+            Let
+              (TP[Var("v",F32), qVar"s"],
+               Apply
+                 (Call
+                    ("ALU",ATy(qTy,PTy(F32,qTy)),
+                     TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+                        Apply
+                          (Dest("R",ATy(FTy 7,F32),qVar"s"),
+                           Var("a",FTy 7)),
+                        Apply
+                          (Dest("R",ATy(FTy 7,F32),qVar"s"),
+                           Var("b",FTy 7))]),qVar"s"),
+               TP[Mop(Cast(FTy 10),Var("v",F32)), qVar"s"]),
+            TP[LU, Rupd("PC",TP[qVar"s", Var("v",FTy 10)])]))))
+;
+||#
+
+(defun-struct dfn-jump (((func (type-funct func))
+                         (shift (type-shiftt shift))
+                         (w (unsigned-byte-p 7 w))
+                         (a (unsigned-byte-p 7 a))
+                         (b (unsigned-byte-p 7 b)))
+                        st$)
+  (declare (xargs :stobjs st$))
+  (let ((st$ (update-ri w
+                        (cast ((unsigned-byte 10) (unsigned-byte 32))
+                              (n+ 10 (pctr st$) 1))
+                        st$)))
+    (mv-let (v st$)
+            (mv-let (v st$)
+                    (alu (tuple func shift (ri a st$) (ri b st$))
+                         st$)
+                    (mv (cast ((unsigned-byte 32) (unsigned-byte 10))
+                              v)
+                        st$))
+            (let ((st$ (update-pctr v st$)))
+              (mv (unit-value) st$)))))
+
+#||
+define LoadConstant (w::regT, imm::immT) =
+{
+   R(w) <- ZeroExtend (imm);
+   PC <- PC + 1
+}
+||#
+
+(defun-struct dfn-loadconstant (((w (unsigned-byte-p 7 w))
+                                 (imm (unsigned-byte-p 24 imm)))
+                                st$)
+  (declare (xargs :stobjs st$))
+  (let* ((st$ (update-ri w
+                         (cast ((unsigned-byte 24) (unsigned-byte 32))
+                               imm)
+                         st$))
+         (st$ (update-pctr (n+ 10 (pctr st$) 1) st$)))
+    (mv (unit-value) st$)))
+
+#||
+define ReservedInstr = #Reserved
+
+(Def "dfn'ReservedInstr" qVar"state"
+  (Apply
+    (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+      (LC "Reserved" CTy"exception")) qVar"state"))
+
+||#
+
+(defun-struct dfn-reservedinstr (st$)
+  (declare (xargs :stobjs st$))
+  (raise-exception 'reserved
+                   (arb uty)
+                   st$))
+
+(construct instruction
+           ((in (funct shiftt conditiont
+                       (unsigned-byte 7)
+                       (unsigned-byte 7)
+                       (unsigned-byte 7)))
+            (jump (funct shiftt
+                         (unsigned-byte 7)
+                         (unsigned-byte 7)
+                         (unsigned-byte 7)))
+            (loadconstant ((unsigned-byte 7)
+                           (unsigned-byte 24)))
+            (loaddm (funct shiftt conditiont
+                           (unsigned-byte 7)
+                           (unsigned-byte 7)
+                           (unsigned-byte 7)))
+            (normal (funct shiftt conditiont
+                           (unsigned-byte 7)
+                           (unsigned-byte 7)
+                           (unsigned-byte 7)))
+            (out (funct shiftt conditiont
+                        (unsigned-byte 7)
+                        (unsigned-byte 7)
+                        (unsigned-byte 7)))
+            reservedinstr
+            (storedm (funct shiftt conditiont
+                            (unsigned-byte 7)
+                            (unsigned-byte 7)
+                            (unsigned-byte 7)))
+            (storeim (funct shiftt conditiont
+                            (unsigned-byte 7)
+                            (unsigned-byte 7)
+                            (unsigned-byte 7)))))
+
+#||
+define Run
+
+val Run_def = Def
+  ("Run",Var("v0",CTy"instruction"),
+   Close
+     (qVar"state",
+      CS
+        (Var("v0",CTy"instruction"),
+         [(Const("ReservedInstr",CTy"instruction"),
+           Apply
+             (Const("dfn'ReservedInstr",ATy(qTy,PTy(uTy,qTy))),
+              qVar"state")),
+          (Call
+             ("In",CTy"instruction",
+              Var
+                ("v1",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'In",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v1",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("Jump",CTy"instruction",
+              Var
+                ("v2",
+                 PTy
+                   (CTy"funcT",
+                    PTy(CTy"shiftT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+           Apply
+             (Call
+                ("dfn'Jump",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v2",
+                    PTy
+                      (CTy"funcT",
+                       PTy(CTy"shiftT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              qVar"state")),
+          (Call
+             ("LoadConstant",CTy"instruction",Var("v3",PTy(FTy 7,FTy 24))),
+           Apply
+             (Call
+                ("dfn'LoadConstant",ATy(qTy,PTy(uTy,qTy)),
+                 Var("v3",PTy(FTy 7,FTy 24))),qVar"state")),
+          (Call
+             ("LoadDM",CTy"instruction",
+              Var
+                ("v4",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'LoadDM",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v4",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("Normal",CTy"instruction",
+              Var
+                ("v5",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'Normal",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v5",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("Out",CTy"instruction",
+              Var
+                ("v6",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'Out",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v6",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("StoreDM",CTy"instruction",
+              Var
+                ("v7",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'StoreDM",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v7",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("StoreIM",CTy"instruction",
+              Var
+                ("v8",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'StoreIM",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v8",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state"))])))
+;
+
+   [Run_def]  Definition
+
+      |-  v0.
+           Run v0 =
+           ( state.
+              case v0 of
+                In v1 => dfn'In v1 state
+              | Jump v2 => dfn'Jump v2 state
+              | LoadConstant v3 => dfn'LoadConstant v3 state
+              | LoadDM v4 => dfn'LoadDM v4 state
+              | Normal v5 => dfn'Normal v5 state
+              | Out v6 => dfn'Out v6 state
+              | ReservedInstr => dfn'ReservedInstr state
+              | StoreDM v7 => dfn'StoreDM v7 state
+              | StoreIM v8 => dfn'StoreIM v8 state)
+||#
+
+(defun-struct run ((v0 (type-instruction v0))
+                   st$)
+  (declare (xargs :stobjs st$))
+  (case-match+
+   v0
+   ('reservedinstr (dfn-reservedinstr st$))
+   (('in v1) (dfn-in v1 st$))
+   (('jump v2) (dfn-jump v2 st$))
+   (('loadconstant v3) (dfn-loadconstant v3 st$))
+   (('loaddm v4) (dfn-loaddm v4 st$))
+   (('normal v5) (dfn-normal v5 st$))
+   (('out v6) (dfn-out v6 st$))
+   (('storedm v7) (dfn-storedm v7 st$))
+   (('storeim v8) (dfn-storeim v8 st$))
+   (& (assert! nil
+               (mv (arb uty) st$)))))
+  
+#||
+
+---------------------------------------------
+-- Decode
+---------------------------------------------
+
+instruction Decode (opc::wordT) =
+   match opc
+   {
+      case 'Rw 1 imm`24' => LoadConstant (Rw, imm)
+      case 'Rw 0 Ra Rb Function Shift Skip Op' =>
+         {
+            func  = [Function :: bits(3)] :: funcT;
+            shift = [Shift :: bits(2)] :: shiftT;
+            skip  = [Skip :: bits(2)] :: conditionT;
+            match Op
+            {
+               case 0 => Normal (func, shift, skip, Rw, Ra, Rb)
+               case 1 => StoreDM (func, shift, skip, Rw, Ra, Rb)
+               case 2 => StoreIM (func, shift, skip, Rw, Ra, Rb)
+               case 3 => Out (func, shift, skip, Rw, Ra, Rb)
+               case 4 => LoadDM (func, shift, skip, Rw, Ra, Rb)
+               case 5 => In (func, shift, skip, Rw, Ra, Rb)
+               case 6 => Jump (func, shift, Rw, Ra, Rb)
+               case 7 => ReservedInstr
+            }
+         }
+   }
+
+val Decode_def = Def
+  ("Decode",Var("opc",F32),
+   Let
+     (TP[bVar"b'31", bVar"b'30", bVar"b'29", bVar"b'28", bVar"b'27",
+         bVar"b'26", bVar"b'25", bVar"b'24", bVar"b'23", bVar"b'22",
+         bVar"b'21", bVar"b'20", bVar"b'19", bVar"b'18", bVar"b'17",
+         bVar"b'16", bVar"b'15", bVar"b'14", bVar"b'13", bVar"b'12",
+         bVar"b'11", bVar"b'10", bVar"b'9", bVar"b'8", bVar"b'7",
+         bVar"b'6", bVar"b'5", bVar"b'4", bVar"b'3", bVar"b'2", bVar"b'1",
+         bVar"b'0"],BL(32,Var("opc",F32)),
+      ITE
+        (bVar"b'24",
+         Call
+           ("LoadConstant",CTy"instruction",
+            TP[EX(Var("opc",F32),LN 31,LN 25,FTy 7),
+               EX(Var("opc",F32),LN 23,LN 0,FTy 24)]),
+         Let
+           (Var("Rw",FTy 7),EX(Var("opc",F32),LN 31,LN 25,FTy 7),
+            Let
+              (Var("Rb",FTy 7),EX(Var("opc",F32),LN 16,LN 10,FTy 7),
+               Let
+                 (Var("Ra",FTy 7),EX(Var("opc",F32),LN 23,LN 17,FTy 7),
+                  Let
+                    (Var("func",CTy"funcT"),
+                     Mop
+                       (Cast(CTy"funcT"),
+                        EX(Var("opc",F32),LN 9,LN 7,FTy 3)),
+                     Let
+                       (Var("shift",CTy"shiftT"),
+                        Mop
+                          (Cast(CTy"shiftT"),
+                           EX(Var("opc",F32),LN 6,LN 5,FTy 2)),
+                        Let
+                          (Var("skip",CTy"conditionT"),
+                           Mop
+                             (Cast(CTy"conditionT"),
+                              EX(Var("opc",F32),LN 4,LN 3,FTy 2)),
+                           CS
+                             (EX(Var("opc",F32),LN 2,LN 0,FTy 3),
+                              [(LW(0,3),
+                                Call
+                                  ("Normal",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(1,3),
+                                Call
+                                  ("StoreDM",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(2,3),
+                                Call
+                                  ("StoreIM",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(3,3),
+                                Call
+                                  ("Out",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(4,3),
+                                Call
+                                  ("LoadDM",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(5,3),
+                                Call
+                                  ("In",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(6,3),
+                                Call
+                                  ("Jump",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(7,3),
+                                Const("ReservedInstr",CTy"instruction"))]))))))))))
+;
+
+   [Decode_def]  Definition
+
+      |-  opc.
+           Decode opc =
+           (let (b'31,b'30,b'29,b'28,b'27,b'26,b'25,b'24,b'23,b'22,b'21,
+                 b'20,b'19,b'18,b'17,b'16,b'15,b'14,b'13,b'12,b'11,b'10,
+                 b'9,b'8,b'7,b'6,b'5,b'4,b'3,b'2,b'1,b'0) = boolify32 opc
+            in
+              if b'24 then LoadConstant ((31 >< 25) opc,(23 >< 0) opc)
+              else
+                (let Rw = (31 >< 25) opc in
+                 let Rb = (16 >< 10) opc in
+                 let Ra = (23 >< 17) opc in
+                 let func = num2funcT (w2n ((9 >< 7) opc)) in
+                 let shift = num2shiftT (w2n ((6 >< 5) opc)) in
+                 let skip = num2conditionT (w2n ((4 >< 3) opc))
+                 in
+                   case (2 >< 0) opc of
+                     0w => Normal (func,shift,skip,Rw,Ra,Rb)
+                   | 1w => StoreDM (func,shift,skip,Rw,Ra,Rb)
+                   | 2w => StoreIM (func,shift,skip,Rw,Ra,Rb)
+                   | 3w => Out (func,shift,skip,Rw,Ra,Rb)
+                   | 4w => LoadDM (func,shift,skip,Rw,Ra,Rb)
+                   | 5w => In (func,shift,skip,Rw,Ra,Rb)
+                   | 6w => Jump (func,shift,Rw,Ra,Rb)
+                   | 7w => ReservedInstr
+                   | v => ARB))
+
+||#
+
+; !! Generate the following automatically, based on case-match+ expressions that
+; are encountered.
+(defthm bits-diff-2-forward
+  (implies (and (natp i)
+                (natp j)
+                (equal (- i j) 2))
+           (or (equal (bits x i j) 0)
+               (equal (bits x i j) 1)
+               (equal (bits x i j) 2)
+               (equal (bits x i j) 3)
+               (equal (bits x i j) 4)
+               (equal (bits x i j) 5)
+               (equal (bits x i j) 6)
+               (equal (bits x i j) 7)))
+  :rule-classes ((:forward-chaining
+                  :trigger-terms
+                  ((bits x i j))))
+  :hints (("Goal" :in-theory (enable bits))))
+
+(defun-struct decode ((opc (unsigned-byte-p 32 opc)))
+  (mv-let-ignorable
+   (b-31 b-30 b-29 b-28 b-27 b-26
+         b-25 b-24 b-23 b-22 b-21 b-20 b-19 b-18
+         b-17 b-16 b-15 b-14 b-13 b-12 b-11 b-10
+         b-9 b-8 b-7 b-6 b-5 b-4 b-3 b-2 b-1 b-0)
+   (bl 32 opc)
+   (if b-24
+       (call-constructor instruction loadconstant
+                         (tuple (bits opc 31 25) (bits opc 23 0)))
+     (let* ((rw (bits opc 31 25))
+            (rb (bits opc 16 10))
+            (ra (bits opc 23 17))
+            (func (cast ((unsigned-byte 3) funct)
+                        (bits opc 9 7)))
+            (shift (cast ((unsigned-byte 2) shiftt)
+                         (bits opc 6 5)))
+            (skip (cast ((unsigned-byte 2) conditiont)
+                        (bits opc 4 3))))
+       (case-match+
+        (bits opc 2 0)
+        (0 (call-constructor instruction normal
+                             (tuple func shift skip rw ra rb)))
+        (1 (call-constructor instruction storedm
+                             (tuple func shift skip rw ra rb)))
+        (2 (call-constructor instruction storeim
+                             (tuple func shift skip rw ra rb)))
+        (3 (call-constructor instruction out
+                             (tuple func shift skip rw ra rb)))
+        (4 (call-constructor instruction loaddm
+                             (tuple func shift skip rw ra rb)))
+        (5 (call-constructor instruction in
+                             (tuple func shift skip rw ra rb)))
+        (6 (call-constructor instruction jump
+                             (tuple func shift      rw ra rb)))
+        (7 'reservedinstr)
+        (& (assert! nil
+                    (arb instruction)))
+        )))))
+
+#||
+
+---------------------------------------------
+-- Next State
+---------------------------------------------
+
+unit Next =
+{
+  i = Decode (IM (PC));
+  when i <> ReservedInstr do Run (i)
+}
+
+val Next_def = Def
+  ("Next",qVar"state",
+   Let
+     (Var("v",CTy"instruction"),
+      Call
+        ("Decode",CTy"instruction",
+         Apply
+           (Dest("IM",ATy(FTy 10,F32),qVar"state"),
+            Dest("PC",FTy 10,qVar"state"))),
+      ITE
+        (Mop
+           (Not,
+            EQ
+              (Var("v",CTy"instruction"),
+               Const("ReservedInstr",CTy"instruction"))),
+         Apply
+           (Call("Run",ATy(qTy,PTy(uTy,qTy)),Var("v",CTy"instruction")),
+            qVar"state"),TP[LU, qVar"state"])))
+;
+
+   [Next_def]  Definition
+
+      |-  state.
+           Next state =
+           (let v = Decode (state.IM state.PC)
+            in
+              if v   ReservedInstr then Run v state else ((),state))
+
+||#
+
+(defthm type-instruction-in
+  (implies (force (and (type-funct func)
+                       (type-shiftt shift)
+                       (type-conditiont skip)
+                       (unsigned-byte-p 7 rw)
+                       (unsigned-byte-p 7 ra)
+                       (unsigned-byte-p 7 rb)))
+           (type-instruction
+            (tuple 'in (tuple func shift skip rw ra rb)))))
+
+(defthm type-instruction-jump
+  (implies (force (and (type-funct func)
+                       (type-shiftt shift)
+                       (unsigned-byte-p 7 rw)
+                       (unsigned-byte-p 7 ra)
+                       (unsigned-byte-p 7 rb)))
+           (type-instruction
+            (tuple 'jump (tuple func shift rw ra rb)))))
+
+(defthm type-instruction-loadconstant
+  (implies (force (and (unsigned-byte-p 7 rw)
+                       (unsigned-byte-p 24 imm)))
+           (type-instruction (tuple 'loadconstant (tuple rw imm)))))
+
+(defthm type-instruction-loaddm
+  (implies (force (and (type-funct func)
+                       (type-shiftt shift)
+                       (type-conditiont skip)
+                       (unsigned-byte-p 7 rw)
+                       (unsigned-byte-p 7 ra)
+                       (unsigned-byte-p 7 rb)))
+           (type-instruction
+            (tuple 'loaddm (tuple func shift skip rw ra rb)))))
+
+(defthm type-instruction-normal
+  (implies (force (and (type-funct func)
+                       (type-shiftt shift)
+                       (type-conditiont skip)
+                       (unsigned-byte-p 7 rw)
+                       (unsigned-byte-p 7 ra)
+                       (unsigned-byte-p 7 rb)))
+           (type-instruction
+            (tuple 'normal (tuple func shift skip rw ra rb)))))
+
+(defthm type-instruction-out
+  (implies (force (and (type-funct func)
+                       (type-shiftt shift)
+                       (type-conditiont skip)
+                       (unsigned-byte-p 7 rw)
+                       (unsigned-byte-p 7 ra)
+                       (unsigned-byte-p 7 rb)))
+           (type-instruction
+            (tuple 'out (tuple func shift skip rw ra rb)))))
+
+(defthm type-instruction-storedm
+  (implies (force (and (type-funct func)
+                       (type-shiftt shift)
+                       (type-conditiont skip)
+                       (unsigned-byte-p 7 rw)
+                       (unsigned-byte-p 7 ra)
+                       (unsigned-byte-p 7 rb)))
+           (type-instruction
+            (tuple 'storedm (tuple func shift skip rw ra rb)))))
+
+(defthm type-instruction-storeim
+  (implies (force (and (type-funct func)
+                       (type-shiftt shift)
+                       (type-conditiont skip)
+                       (unsigned-byte-p 7 rw)
+                       (unsigned-byte-p 7 ra)
+                       (unsigned-byte-p 7 rb)))
+           (type-instruction
+            (tuple 'storeim (tuple func shift skip rw ra rb)))))
+
+(in-theory (disable type-instruction))
+
+(defthm imp-yields-unsigned-byte-p-32
+  (implies (and (imp x)
+                (natp a)
+                (< a (len x)))
+           (unsigned-byte-p 32 (nth a x)))
+  :rule-classes ((:rewrite
+                  :corollary
+                  (implies (and (imp x)
+                                (natp a)
+                                (< a (len x)))
+                           (unsigned-byte-p 32 (nth a x))))
+                 (:type-prescription
+                  :corollary
+                  (implies (and (imp x)
+                                (natp a)
+                                (< a (len x)))
+                           (integerp (nth a x))))))
+
+; !! Generate the following automatically, based on case-match+ expressions that
+; are encountered.
+(defthm bits-diff-1-forward
+  (implies (and (natp i)
+                (natp j)
+                (equal (- i j) 1))
+           (or (equal (bits x i j) 0)
+               (equal (bits x i j) 1)
+               (equal (bits x i j) 2)
+               (equal (bits x i j) 3)))
+  :rule-classes ((:forward-chaining
+                  :trigger-terms
+                  ((bits x i j))))
+  :hints (("Goal" :in-theory (enable bits))))
+
+; !! Perhaps should only be used with some sort of staged simplification, e.g.,
+; after stable-under-simplification.
+(defthm nth-bits-diff-1-open
+  (implies (and (syntaxp (quotep i))
+                (syntaxp (quotep j))
+                (natp i)
+                (natp j)
+                (equal (- i j) 1))
+           (equal (nth (bits x i j) (list* a0 a1 a2 a3 tail))
+                  (case (bits x i j)
+                    (0 a0)
+                    (1 a1)
+                    (2 a2)
+                    (otherwise a3))))
+  :hints (("Goal" :use bits-diff-1-forward)))
+                  
+(defun-struct next (st$)
+  (declare (xargs :stobjs st$))
+  (let ((v (decode (imi (pctr st$) st$))))
+    (if (not (eq v 'reservedinstr))
+        (run v st$)
+      (mv (unit-value) st$))))
+
+#||
+---------------------------------------------
+-- Encode
+---------------------------------------------
+
+wordT enc
+  (args::funcT * shiftT * conditionT * regT * regT * regT, opc::bits(3)) =
+{
+   func, shift, skip, w, a, b = args;
+   return (w : '0' : a : b : [func]`3 : [shift]`2 : [skip]`2 : opc)
+}
+
+val enc_def = Def
+  ("enc",
+   TP[Var
+        ("args",
+         PTy
+           (CTy"funcT",
+            PTy
+              (CTy"shiftT",
+               PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+      Var("opc",FTy 3)],
+   Let
+     (TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+         Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+         Var("b",FTy 7)],
+      Var
+        ("args",
+         PTy
+           (CTy"funcT",
+            PTy
+              (CTy"shiftT",
+               PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+      CC[Var("w",FTy 7), LW(0,1), Var("a",FTy 7), Var("b",FTy 7),
+         Mop(Cast(FTy 3),Var("func",CTy"funcT")),
+         Mop(Cast(FTy 2),Var("shift",CTy"shiftT")),
+         Mop(Cast(FTy 2),Var("skip",CTy"conditionT")), Var("opc",FTy 3)]))
+;
+
+   [enc_def]  Definition
+
+      |-  args opc.
+           enc (args,opc) =
+           (let (func,shift,skip,w,a,b) = args
+            in
+              w @@ 0w @@ a @@ b @@ n2w (funcT2num func) @@
+              n2w (shiftT2num shift) @@ n2w (conditionT2num skip) @@ opc)
+
+
+||#
+
+(defun-struct enc (((args (slet (x0 x1 x2 x3 x4 x5)
+                                args
+                                (and (type-funct x0)
+                                     (type-shiftt x1)
+                                     (type-conditiont x2)
+                                     (unsigned-byte-p 7 x3)
+                                     (unsigned-byte-p 7 x4)
+                                     (unsigned-byte-p 7 x5))
+                                nil
+                                nil))
+                    (opc (unsigned-byte-p 3 opc))))
+  (slet (func shift skip w a b)
+        args
+        (cat w 7
+             0 1
+             a 7
+             b 7
+             (cast (funct (unsigned-byte 3)) func) 3
+             (cast (shiftt (unsigned-byte 2)) shift) 2
+             (cast (conditiont (unsigned-byte 2)) skip) 2
+             opc 3)))
+
+#||
+wordT Encode (i::instruction) =
+   match i
+   {
+      case LoadConstant (Rw, imm) => Rw : '1' : imm
+      case Normal (args)  => enc (args, '000')
+      case StoreDM (args) => enc (args, '001')
+      case StoreIM (args) => enc (args, '010')
+      case Out (args)     => enc (args, '011')
+      case LoadDM (args)  => enc (args, '100')
+      case In (args)      => enc (args, '101')
+      case Jump (func, shift, Rw, Ra, Rb) =>
+         enc ((func, shift, skipNever, Rw, Ra, Rb), '110')
+      case ReservedInstr => 0b111
+   }
+
+val Encode_def = Def
+  ("Encode",Var("i",CTy"instruction"),
+   CS
+     (Var("i",CTy"instruction"),
+      [(Call
+          ("LoadConstant",CTy"instruction",
+           TP[Var("Rw",FTy 7), Var("imm",FTy 24)]),
+        CC[Var("Rw",FTy 7), LW(1,1), Var("imm",FTy 24)]),
+       (Call
+          ("Normal",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(0,3)])),
+       (Call
+          ("StoreDM",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(1,3)])),
+       (Call
+          ("StoreIM",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(2,3)])),
+       (Call
+          ("Out",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(3,3)])),
+       (Call
+          ("LoadDM",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(4,3)])),
+       (Call
+          ("In",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(5,3)])),
+       (Call
+          ("Jump",CTy"instruction",
+           TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+              Var("Rw",FTy 7), Var("Ra",FTy 7), Var("Rb",FTy 7)]),
+        Call
+          ("enc",F32,
+           TP[TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+                 LC("skipNever",CTy"conditionT"), Var("Rw",FTy 7),
+                 Var("Ra",FTy 7), Var("Rb",FTy 7)], LW(6,3)])),
+       (Const("ReservedInstr",CTy"instruction"),LW(7,32))]))
+;
+
+   [Encode_def]  Definition
+
+      |-  i.
+           Encode i =
+           case i of
+             In args_5 => enc (args_5,5w)
+           | Jump (func,shift,Rw_1,Ra,Rb) =>
+               enc ((func,shift,skipNever,Rw_1,Ra,Rb),6w)
+           | LoadConstant (Rw,imm) => Rw @@ 1w @@ imm
+           | LoadDM args_4 => enc (args_4,4w)
+           | Normal args => enc (args,0w)
+           | Out args_3 => enc (args_3,3w)
+           | ReservedInstr => 7w
+           | StoreDM args_1 => enc (args_1,1w)
+           | StoreIM args_2 => enc (args_2,2w)
+
+||#
+
+; !! Think about eliminating in-theory hint by proving a suitable hierarchy of
+; forward-chaining rules for our types.
+(defun-struct encode ((i (type-instruction i)))
+  (declare (xargs :guard-hints
+                  (("Goal" :in-theory (enable type-instruction)))))
+  (case-match+
+   i
+   (('loadconstant (rw imm))
+    (cat rw 7 1 1 imm 24))
+   (('normal args)  (enc (tuple args 0)))
+   (('storedm args) (enc (tuple args 1)))
+   (('storeim args) (enc (tuple args 2)))
+   (('out args)     (enc (tuple args 3)))
+   (('loaddm args)  (enc (tuple args 4)))
+   (('in args)      (enc (tuple args 5)))
+   (('jump (func shift Rw Ra Rb))
+    (enc (tuple (tuple func shift 'skipNever Rw Ra Rb) 6)))
+   ('ReservedInstr 7)
+   (& (assert! nil
+               (arb (unsigned-byte 32))))))
+
+#||
+---------------------------------------------
+-- Load into Instruction Memory
+---------------------------------------------
+
+unit LoadIM (a::addrT, i::instruction list) measure Length (i) =
+   match i
+   {
+      case Nil => nothing
+      case Cons (h, t) =>
+        {
+           IM(a) <- Encode (h);
+           LoadIM (a + 1, t)
+        }
+   }
+
+val LoadIM_def = tDef
+  ("LoadIM",TP[Var("a",FTy 10), Var("i",LTy(CTy"instruction"))],
+   Close
+     (qVar"state",
+      CS
+        (Var("i",LTy(CTy"instruction")),
+         [(LNL(CTy"instruction"),TP[LU, qVar"state"]),
+          (LLC([Var("h",CTy"instruction")],Var("t",LTy(CTy"instruction"))),
+           Apply
+             (Call
+                ("LoadIM",ATy(qTy,PTy(uTy,qTy)),
+                 TP[Bop(Add,Var("a",FTy 10),LW(1,10)),
+                    Var("t",LTy(CTy"instruction"))]),
+              Rupd
+                ("IM",
+                 TP[qVar"state",
+                    Fupd
+                      (Dest("IM",ATy(FTy 10,F32),qVar"state"),
+                       Var("a",FTy 10),
+                       Call("Encode",F32,Var("h",CTy"instruction")))])))])),
+   Close
+     (Var("x",PTy(PTy(FTy 10,LTy(CTy"instruction")),qTy)),
+      CS
+        (Var("x",PTy(PTy(FTy 10,LTy(CTy"instruction")),qTy)),
+         [(TP[TP[Var("a",FTy 10), Var("i",LTy(CTy"instruction"))],
+              AVar(qTy)],Mop(Length,Var("i",LTy(CTy"instruction"))))])))
+
+   [LoadIM_curried_def]  Definition
+
+      |-  x x1. LoadIM x x1 = LoadIM_tupled (x,x1)
+
+   [LoadIM_tupled_primitive_def]  Definition
+
+      |- LoadIM_tupled =
+         WFREC
+           (@R.
+              WF R  
+               state a i h t.
+                (i = h::t)  
+                R ((a + 1w,t),state with IM := (a =+ Encode h) state.IM)
+                  ((a,i),state))
+           ( LoadIM_tupled a'.
+              case a' of
+                ((a,i),state) =>
+                  I
+                    (case i of
+                       [] => ((),state)
+                     | h::t =>
+                         LoadIM_tupled
+                           ((a + 1w,t),
+                            state with IM := (a =+ Encode h) state.IM)))
+
+   [LoadIM_def]  Theorem
+
+      |-  state i a.
+           LoadIM (a,i) state =
+           case i of
+             [] => ((),state)
+           | h::t =>
+               LoadIM (a + 1w,t)
+                 (state with IM := (a =+ Encode h) state.IM)
+
+
+||#
+
+; !! Think about how to deal with the following, which cuts the time to admit
+; loadim from 78 seconds down to less than 1/10 second.  I made an attempt to 
+; start proving type theorems in tiny.lisp.10, but I stumbled at dfn-jump,
+; maybe simply because I hadn't proved all necessary type theorems yet.
+; As of tiny.lisp.13.good, at least, this book certifies with the following
+; four events (two defthms, two in-theory events) commented out.
+(defthm unsigned-byte-p-32-enc
+  (unsigned-byte-p 32 (enc x)))
+(in-theory (disable enc))
+(defthm unsigned-byte-p-32-encode
+  (unsigned-byte-p 32 (encode x)))
+(in-theory (disable encode))
+
+(defun-struct loadim (((a (unsigned-byte-p 10 a))
+                       (i (type-instruction-list i)))
+                      st$)
+  :measure (len i)
+  (declare (xargs :stobjs st$))
+  (case-match+
+   i
+   ('nil (mv (unit-value) st$))
+   ((h . t_var) (let ((st$ (update-imi a (encode h) st$)))
+                  (loadim (tuple (n+ 10 a 1) t_var)
+                          st$)))
+   (& (assert! nil
+               (mv (arb uty) st$)))))
+
+#||
+---------------------------------------------
+-- Initialization & testing
+---------------------------------------------
+
+unit initialize (p::instruction list) =
+{
+   PC <- 0;
+   R <- InitMap (0);
+   DM <- InitMap (0);
+   InRdy <- false;
+   InData <- 0;
+   OutStrobe <- 0;
+   IM <- InitMap (Encode (ReservedInstr));
+   LoadIM (0, p)
+}
+
+(Def "initialize" (Var "p" (LTy CTy"instruction"))
+  (Close qVar"state"
+    (Apply
+      (Call "LoadIM" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt (LW 0 10) (Var "p" (LTy CTy"instruction")))))
+      (Rupd "IM"
+        (TP
+          (sqbkt (Rupd "OutStrobe"
+                   (TP
+                     (sqbkt (Rupd "InData"
+                              (TP
+                                (sqbkt (Rupd "InRdy"
+                                         (TP
+                                           (sqbkt (Rupd "DM"
+                                                    (TP
+                                                      (sqbkt (Rupd "R"
+                                                               (TP
+                                                                 (sqbkt (Rupd
+                                                                          "PC"
+                                                                          (TP
+                                                                            (sqbkt qVar"state"
+                                                                                   (LW
+                                                                                     0
+                                                                                     10))))
+                                                                        (Mop
+                                                                          (K1
+                                                                            (FTy
+                                                                              7))
+                                                                          (LW
+                                                                            0
+                                                                            32)))))
+                                                             (Mop
+                                                               (K1
+                                                                 (FTy 10))
+                                                               (LW 0 32)))))
+                                                  LF))) (LW 0 32))))
+                            (LW 0 32))))
+                 (Mop (K1 (FTy 10))
+                   (Call "Encode" F32
+                     (Const "ReservedInstr" CTy"instruction")))))))))
+
+   [initialize_def]  Definition
+
+      |-  p.
+           initialize p =
+           ( state.
+              LoadIM (0w,p)
+                (state with
+                 <|IM := K (Encode ReservedInstr); OutStrobe := 0w;
+                   InData := 0w; InRdy := F; DM := K 0w; R := K 0w;
+                   PC := 0w|>))
+
+
+||#
+
+; Auto-generated the following (copied from out.lisp):
+(DEFUN-STRUCT INITIALIZE
+              ((P (TYPE-INSTRUCTION-LIST P)) ST$)
+              (DECLARE (XARGS :STOBJS ST$))
+              (LET ((ST$ (LET* ((ST$ (UPDATE-PCTR 0 ST$))
+                                (ST$ (MAP-UPDATE-RI 0 ST$))
+                                (ST$ (MAP-UPDATE-DMI 0 ST$))
+                                (ST$ (UPDATE-INRDY (FALSE) ST$))
+                                (ST$ (UPDATE-INDATA 0 ST$))
+                                (ST$ (UPDATE-OUTSTROBE 0 ST$)))
+                               (MAP-UPDATE-IMI (ENCODE 'RESERVEDINSTR)
+                                               ST$))))
+                   (LOADIM (TUPLE 0 P) ST$)))
+
+#||
+instruction list test_prog =
+   list {
+      LoadConstant (0, 0),
+      LoadConstant (1, 1000),
+      LoadConstant (2, 1010),
+      LoadConstant (3, 4),
+      StoreDM (fINC, noShift, skipNever, 1, 1, 1),
+      Normal (fXOR, noShift, skipZero, 4, 1, 2),
+      Jump (fADD, noShift, 4, 3, 0),
+      Out (fADD, noShift, skipNever, 1, 1, 0)
+   }
+
+(Def0 "test_prog"
+  (LL(sqbkt (Call "LoadConstant" CTy"instruction"
+              (TP (sqbkt (LW 0 7) (LW 0 24))))
+            (Call "LoadConstant" CTy"instruction"
+              (TP (sqbkt (LW 1 7) (LW 1000 24))))
+            (Call "LoadConstant" CTy"instruction"
+              (TP (sqbkt (LW 2 7) (LW 1010 24))))
+            (Call "LoadConstant" CTy"instruction"
+              (TP (sqbkt (LW 3 7) (LW 4 24))))
+            (Call "StoreDM" CTy"instruction"
+              (TP
+                (sqbkt (LC "fINC" CTy"funcT") (LC "noShift" CTy"shiftT")
+                       (LC "skipNever" CTy"conditionT") (LW 1 7) (LW 1 7)
+                       (LW 1 7))))
+            (Call "Normal" CTy"instruction"
+              (TP
+                (sqbkt (LC "fXOR" CTy"funcT") (LC "noShift" CTy"shiftT")
+                       (LC "skipZero" CTy"conditionT") (LW 4 7) (LW 1 7)
+                       (LW 2 7))))
+            (Call "Jump" CTy"instruction"
+              (TP
+                (sqbkt (LC "fADD" CTy"funcT") (LC "noShift" CTy"shiftT")
+                       (LW 4 7) (LW 3 7) (LW 0 7))))
+            (Call "Out" CTy"instruction"
+              (TP
+                (sqbkt (LC "fADD" CTy"funcT") (LC "noShift" CTy"shiftT")
+                       (LC "skipNever" CTy"conditionT") (LW 1 7) (LW 1 7)
+                       (LW 0 7)))))))
+
+   [test_prog_def]  Definition
+
+      |- test_prog =
+         [LoadConstant (0w,0w); LoadConstant (1w,1000w);
+          LoadConstant (2w,1010w); LoadConstant (3w,4w);
+          StoreDM (fINC,noShift,skipNever,1w,1w,1w);
+          Normal (fXOR,noShift,skipZero,4w,1w,2w);
+          Jump (fADD,noShift,4w,3w,0w);
+          Out (fADD,noShift,skipNever,1w,1w,0w)]
+
+||#
+
+; Auto-generated the following (copied from out.lisp):
+(DEFCONST *TEST_PROG*
+          (LIST (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 0 0))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 1 1000))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 2 1010))
+                (CALL-CONSTRUCTOR INSTRUCTION LOADCONSTANT (TUPLE 3 4))
+                (CALL-CONSTRUCTOR INSTRUCTION STOREDM
+                                  (TUPLE 'FINC 'NOSHIFT 'SKIPNEVER 1 1 1))
+                (CALL-CONSTRUCTOR INSTRUCTION NORMAL
+                                  (TUPLE 'FXOR 'NOSHIFT 'SKIPZERO 4 1 2))
+                (CALL-CONSTRUCTOR INSTRUCTION
+                                  JUMP (TUPLE 'FADD 'NOSHIFT 4 3 0))
+                (CALL-CONSTRUCTOR INSTRUCTION OUT
+                                  (TUPLE 'FADD
+                                         'NOSHIFT
+                                         'SKIPNEVER
+                                         1 1 0))))
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tiny.spec acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tiny.spec
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tiny.spec	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tiny.spec	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,256 @@
+----------------------------------------------------------------------------
+-- Specification of Thacker's Tiny 3 Computer
+-- See: http://www.cl.cam.ac.uk/~swm11/examples/bluespec/Tiny3/
+----------------------------------------------------------------------------
+
+{-
+val () = Runtime.LoadF "tiny.spec"
+val () = HolExport.monadicExport true
+val () = HolExport.monadicExport false
+val () = HolExport.spec ("tiny.spec", "tiny")
+val () = HolExport.acl2spec ("tiny.spec", "tiny-acl2.txt")
+
+Runtime.evalQ `function (fADD, 1, 2)`
+-}
+
+---------------------------------------------
+-- Types
+---------------------------------------------
+
+type regT  = bits(7)
+type wordT = bits(32)
+type immT  = bits(24)
+type addrT = bits(10)
+type memT  = addrT -> wordT
+
+exception Reserved
+
+construct funcT {fADD, fSUB, fINC, fDEC, fAND, fOR, fXOR, fReserved}
+construct shiftT {noShift, RCY1, RCY8, RCY16}
+construct conditionT {skipNever, skipNeg, skipZero, skipInRdy}
+
+---------------------------------------------
+-- State
+---------------------------------------------
+
+declare
+{
+   PC :: addrT          -- Program Counter
+   R :: regT -> wordT   -- Registers
+   IM :: memT           -- Instruction Memory
+   DM :: memT           -- Data Memory
+   InRdy :: bool        -- Input Ready
+   InData :: wordT      -- Input Data
+   OutStrobe :: wordT   -- Output Data
+}
+
+---------------------------------------------
+-- Operations
+---------------------------------------------
+
+wordT function (func::funcT, a:: wordT, b:: wordT) =
+   match func
+   {
+     case fADD => a + b
+     case fSUB => a - b
+     case fINC => b + 1
+     case fDEC => b - 1
+     case fAND => a && b
+     case fOR  => a || b
+     case fXOR => a ?? b
+     case _ => #Reserved
+   }
+
+wordT shifter (shift::shiftT, a::wordT) =
+   match shift
+   {
+      case noShift => a
+      case RCY1    => a #>> 1
+      case RCY8    => a #>> 8
+      case RCY16   => a #>> 16
+   }
+
+wordT ALU (func::funcT, shift::shiftT, a::wordT, b::wordT) =
+   shifter (shift, function (func, a, b))
+
+unit incPC (skip::conditionT, alu::wordT) =
+   match skip
+   {
+      case skipNever => PC <- PC + 1
+      case skipNeg   => PC <- PC + if alu < 0  then 2 else 1
+      case skipZero  => PC <- PC + if alu == 0 then 2 else 1
+      case skipInRdy => PC <- PC + if InRdy    then 2 else 1
+   }
+
+-- Common functionality
+unit norm (func::funcT, shift::shiftT, skip::conditionT,
+           wback::bool, strobe::bool, w::regT, a::regT, b::regT) =
+{
+   alu = ALU (func, shift, R(a), R(b));
+   when wback do R(w) <- alu;
+   when strobe do OutStrobe <- alu;
+   incPC (skip, alu)
+}
+
+---------------------------------------------
+-- Instructions
+---------------------------------------------
+
+define Normal (func::funcT, shift::shiftT, skip::conditionT,
+               w::regT, a::regT, b::regT) =
+   norm (func, shift, skip, true, false, w, a, b)
+
+
+define StoreDM (func::funcT, shift::shiftT, skip::conditionT,
+                w::regT, a::regT, b::regT) =
+{
+   DM([R(b)]) <- R(a);
+   norm (func, shift, skip, true, false, w, a, b)
+}
+
+define StoreIM (func::funcT, shift::shiftT, skip::conditionT,
+                w::regT, a::regT, b::regT) =
+{
+   IM([R(b)]) <- R(a);
+   norm (func, shift, skip, true, false, w, a, b)
+}
+
+define Out (func::funcT, shift::shiftT, skip::conditionT,
+            w::regT, a::regT, b::regT) =
+   norm (func, shift, skip, true, true, w, a, b)
+
+define LoadDM (func::funcT, shift::shiftT, skip::conditionT,
+               w::regT, a::regT, b::regT) =
+{
+   R(w) <- DM([R(b)]);
+   norm (func, shift, skip, false, false, w, a, b)
+}
+
+define In (func::funcT, shift::shiftT, skip::conditionT,
+           w::regT, a::regT, b::regT) =
+{
+   R(w) <- InData;
+   norm (func, shift, skip, false, false, w, a, b)
+}
+
+define Jump (func::funcT, shift::shiftT, w::regT, a::regT, b::regT) =
+{
+   R(w) <- ZeroExtend (PC + 1);
+   PC <- [ALU (func, shift, R(a), R(b))]
+}
+
+define LoadConstant (w::regT, imm::immT) =
+{
+   R(w) <- ZeroExtend (imm);
+   PC <- PC + 1
+}
+
+define ReservedInstr = #Reserved
+
+define Run
+
+---------------------------------------------
+-- Decode
+---------------------------------------------
+
+instruction Decode (opc::wordT) =
+   match opc
+   {
+      case 'Rw 1 imm`24' => LoadConstant (Rw, imm)
+      case 'Rw 0 Ra Rb Function Shift Skip Op' =>
+         {
+            func  = [Function :: bits(3)] :: funcT;
+            shift = [Shift :: bits(2)] :: shiftT;
+            skip  = [Skip :: bits(2)] :: conditionT;
+            match Op
+            {
+               case 0 => Normal (func, shift, skip, Rw, Ra, Rb)
+               case 1 => StoreDM (func, shift, skip, Rw, Ra, Rb)
+               case 2 => StoreIM (func, shift, skip, Rw, Ra, Rb)
+               case 3 => Out (func, shift, skip, Rw, Ra, Rb)
+               case 4 => LoadDM (func, shift, skip, Rw, Ra, Rb)
+               case 5 => In (func, shift, skip, Rw, Ra, Rb)
+               case 6 => Jump (func, shift, Rw, Ra, Rb)
+               case 7 => ReservedInstr
+            }
+         }
+   }
+
+---------------------------------------------
+-- Next State
+---------------------------------------------
+
+unit Next =
+{
+  i = Decode (IM (PC));
+  when i <> ReservedInstr do Run (i)
+}
+
+---------------------------------------------
+-- Encode
+---------------------------------------------
+
+wordT enc
+  (args::funcT * shiftT * conditionT * regT * regT * regT, opc::bits(3)) =
+{
+   func, shift, skip, w, a, b = args;
+   return (w : '0' : a : b : [func]`3 : [shift]`2 : [skip]`2 : opc)
+}
+
+wordT Encode (i::instruction) =
+   match i
+   {
+      case LoadConstant (Rw, imm) => Rw : '1' : imm
+      case Normal (args)  => enc (args, '000')
+      case StoreDM (args) => enc (args, '001')
+      case StoreIM (args) => enc (args, '010')
+      case Out (args)     => enc (args, '011')
+      case LoadDM (args)  => enc (args, '100')
+      case In (args)      => enc (args, '101')
+      case Jump (func, shift, Rw, Ra, Rb) =>
+         enc ((func, shift, skipNever, Rw, Ra, Rb), '110')
+      case ReservedInstr => 0b111
+   }
+
+---------------------------------------------
+-- Load into Instruction Memory
+---------------------------------------------
+
+unit LoadIM (a::addrT, i::instruction list) measure Length (i) =
+   match i
+   {
+      case Nil => nothing
+      case Cons (h, t) =>
+        {
+           IM(a) <- Encode (h);
+           LoadIM (a + 1, t)
+        }
+   }
+
+---------------------------------------------
+-- Initialization & testing
+---------------------------------------------
+
+unit initialize (p::instruction list) =
+{
+   PC <- 0;
+   R <- InitMap (0);
+   DM <- InitMap (0);
+   InRdy <- false;
+   InData <- 0;
+   OutStrobe <- 0;
+   IM <- InitMap (Encode (ReservedInstr));
+   LoadIM (0, p)
+}
+
+instruction list test_prog =
+   list {
+      LoadConstant (0, 0),
+      LoadConstant (1, 1000),
+      LoadConstant (2, 1010),
+      LoadConstant (3, 4),
+      StoreDM (fINC, noShift, skipNever, 1, 1, 1),
+      Normal (fXOR, noShift, skipZero, 4, 1, 2),
+      Jump (fADD, noShift, 4, 3, 0),
+      Out (fADD, noShift, skipNever, 1, 1, 0)
+   }
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tinyScript.sml acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tinyScript.sml
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tinyScript.sml	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tinyScript.sml	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,869 @@
+(* tinyScript.sml - generated by L<3> - Mon Jun 24 13:23:24 2013 *)
+
+open HolKernel boolLib bossLib Import
+
+val () = Import.start "tiny"
+
+val _ = Construct[("funcT",
+    [("fADD",[]), ("fSUB",[]), ("fINC",[]), ("fDEC",[]), ("fAND",[]),
+     ("fOR",[]), ("fXOR",[]), ("fReserved",[])])]
+;
+
+val _ = Construct[("shiftT",
+    [("noShift",[]), ("RCY1",[]), ("RCY8",[]), ("RCY16",[])])]
+;
+
+val _ = Construct[("conditionT",
+    [("skipNever",[]), ("skipNeg",[]), ("skipZero",[]), ("skipInRdy",[])])]
+;
+
+val _ = Construct[("instruction",
+    [("In",
+      [PTy
+         (CTy"funcT",
+          PTy
+            (CTy"shiftT",PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))]),
+     ("Jump",
+      [PTy(CTy"funcT",PTy(CTy"shiftT",PTy(FTy 7,PTy(FTy 7,FTy 7))))]),
+     ("LoadConstant",[PTy(FTy 7,FTy 24)]),
+     ("LoadDM",
+      [PTy
+         (CTy"funcT",
+          PTy
+            (CTy"shiftT",PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))]),
+     ("Normal",
+      [PTy
+         (CTy"funcT",
+          PTy
+            (CTy"shiftT",PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))]),
+     ("Out",
+      [PTy
+         (CTy"funcT",
+          PTy
+            (CTy"shiftT",PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))]),
+     ("ReservedInstr",[]),
+     ("StoreDM",
+      [PTy
+         (CTy"funcT",
+          PTy
+            (CTy"shiftT",PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))]),
+     ("StoreIM",
+      [PTy
+         (CTy"funcT",
+          PTy
+            (CTy"shiftT",PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))])])]
+;
+
+val _ = Construct[("exception",[("NoException",[]), ("Reserved",[])])]
+;
+
+val _ = Record("tiny_state",
+   [("DM",ATy(FTy 10,F32)), ("IM",ATy(FTy 10,F32)), ("InData",F32),
+    ("InRdy",bTy), ("OutStrobe",F32), ("PC",FTy 10), ("R",ATy(FTy 7,F32)),
+    ("exception",CTy"exception")])
+;
+
+val qTy = CTy "tiny_state"
+;
+
+fun qVar v = Term.mk_var (v, ParseDatatype.pretypeToType qTy)
+;
+
+val raise'exception_def = Def
+  ("raise'exception",Var("e",CTy"exception"),
+   Close
+     (qVar"state",
+      TP[LX(VTy"a"),
+         ITE
+           (EQ
+              (Dest("exception",CTy"exception",qVar"state"),
+               LC("NoException",CTy"exception")),
+            Rupd("exception",TP[qVar"state", Var("e",CTy"exception")]),
+            qVar"state")]))
+;
+
+val function_def = Def
+  ("function",TP[Var("func",CTy"funcT"), Var("a",F32), Var("b",F32)],
+   Close
+     (qVar"state",
+      CS
+        (Var("func",CTy"funcT"),
+         [(LC("fADD",CTy"funcT"),
+           TP[Bop(Add,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (LC("fSUB",CTy"funcT"),
+           TP[Bop(Sub,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (LC("fINC",CTy"funcT"),
+           TP[Bop(Add,Var("b",F32),LW(1,32)), qVar"state"]),
+          (LC("fDEC",CTy"funcT"),
+           TP[Bop(Sub,Var("b",F32),LW(1,32)), qVar"state"]),
+          (LC("fAND",CTy"funcT"),
+           TP[Bop(BAnd,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (LC("fOR",CTy"funcT"),
+           TP[Bop(BOr,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (LC("fXOR",CTy"funcT"),
+           TP[Bop(BXor,Var("a",F32),Var("b",F32)), qVar"state"]),
+          (AVar(CTy"funcT"),
+           Apply
+             (Call
+                ("raise'exception",ATy(qTy,PTy(F32,qTy)),
+                 LC("Reserved",CTy"exception")),qVar"state"))])))
+;
+
+val shifter_def = Def
+  ("shifter",TP[Var("shift",CTy"shiftT"), Var("a",F32)],
+   CS
+     (Var("shift",CTy"shiftT"),
+      [(LC("noShift",CTy"shiftT"),Var("a",F32)),
+       (LC("RCY1",CTy"shiftT"),Bop(Ror,Var("a",F32),LN 1)),
+       (LC("RCY8",CTy"shiftT"),Bop(Ror,Var("a",F32),LN 8)),
+       (LC("RCY16",CTy"shiftT"),Bop(Ror,Var("a",F32),LN 16))]))
+;
+
+val ALU_def = Def
+  ("ALU",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"), Var("a",F32),
+      Var("b",F32)],
+   Close
+     (qVar"state",
+      Let
+        (TP[Var("v",F32), qVar"s"],
+         Apply
+           (Call
+              ("function",ATy(qTy,PTy(F32,qTy)),
+               TP[Var("func",CTy"funcT"), Var("a",F32), Var("b",F32)]),
+            qVar"state"),
+         TP[Call("shifter",F32,TP[Var("shift",CTy"shiftT"), Var("v",F32)]),
+            qVar"s"])))
+;
+
+val incPC_def = Def
+  ("incPC",TP[Var("skip",CTy"conditionT"), Var("alu",F32)],
+   Close
+     (qVar"state",
+      CS
+        (Var("skip",CTy"conditionT"),
+         [(LC("skipNever",CTy"conditionT"),
+           TP[LU,
+              Rupd
+                ("PC",
+                 TP[qVar"state",
+                    Bop(Add,Dest("PC",FTy 10,qVar"state"),LW(1,10))])]),
+          (LC("skipNeg",CTy"conditionT"),
+           TP[LU,
+              Rupd
+                ("PC",
+                 TP[qVar"state",
+                    Bop
+                      (Add,Dest("PC",FTy 10,qVar"state"),
+                       ITE
+                         (Bop(Lt,Var("alu",F32),LW(0,32)),LW(2,10),
+                          LW(1,10)))])]),
+          (LC("skipZero",CTy"conditionT"),
+           TP[LU,
+              Rupd
+                ("PC",
+                 TP[qVar"state",
+                    Bop
+                      (Add,Dest("PC",FTy 10,qVar"state"),
+                       ITE(EQ(Var("alu",F32),LW(0,32)),LW(2,10),LW(1,10)))])]),
+          (LC("skipInRdy",CTy"conditionT"),
+           TP[LU,
+              Rupd
+                ("PC",
+                 TP[qVar"state",
+                    Bop
+                      (Add,Dest("PC",FTy 10,qVar"state"),
+                       ITE
+                         (Dest("InRdy",bTy,qVar"state"),LW(2,10),LW(1,10)))])])])))
+;
+
+val norm_def = Def
+  ("norm",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), bVar"wback", bVar"strobe",
+      Var("w",FTy 7), Var("a",FTy 7), Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Let
+        (TP[Var("v",F32), qVar"s"],
+         Apply
+           (Call
+              ("ALU",ATy(qTy,PTy(F32,qTy)),
+               TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+                  Apply
+                    (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("a",FTy 7)),
+                  Apply
+                    (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("b",FTy 7))]),
+            qVar"state"),
+         Let
+           (qVar"s",
+            ITE
+              (bVar"wback",
+               Rupd
+                 ("R",
+                  TP[qVar"s",
+                     Fupd
+                       (Dest("R",ATy(FTy 7,F32),qVar"s"),Var("w",FTy 7),
+                        Var("v",F32))]),qVar"s"),
+            Apply
+              (Call
+                 ("incPC",ATy(qTy,PTy(uTy,qTy)),
+                  TP[Var("skip",CTy"conditionT"), Var("v",F32)]),
+               ITE
+                 (bVar"strobe",
+                  Rupd("OutStrobe",TP[qVar"s", Var("v",F32)]),qVar"s"))))))
+;
+
+val dfn'Normal_def = Def
+  ("dfn'Normal",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+      Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Apply
+        (Call
+           ("norm",ATy(qTy,PTy(uTy,qTy)),
+            TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+               Var("skip",CTy"conditionT"), LT, LF, Var("w",FTy 7),
+               Var("a",FTy 7), Var("b",FTy 7)]),qVar"state")))
+;
+
+val dfn'StoreDM_def = Def
+  ("dfn'StoreDM",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+      Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Apply
+        (Call
+           ("norm",ATy(qTy,PTy(uTy,qTy)),
+            TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+               Var("skip",CTy"conditionT"), LT, LF, Var("w",FTy 7),
+               Var("a",FTy 7), Var("b",FTy 7)]),
+         Rupd
+           ("DM",
+            TP[qVar"state",
+               Fupd
+                 (Dest("DM",ATy(FTy 10,F32),qVar"state"),
+                  Mop
+                    (Cast(FTy 10),
+                     Apply
+                       (Dest("R",ATy(FTy 7,F32),qVar"state"),
+                        Var("b",FTy 7))),
+                  Apply
+                    (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("a",FTy 7)))]))))
+;
+
+val dfn'StoreIM_def = Def
+  ("dfn'StoreIM",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+      Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Apply
+        (Call
+           ("norm",ATy(qTy,PTy(uTy,qTy)),
+            TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+               Var("skip",CTy"conditionT"), LT, LF, Var("w",FTy 7),
+               Var("a",FTy 7), Var("b",FTy 7)]),
+         Rupd
+           ("IM",
+            TP[qVar"state",
+               Fupd
+                 (Dest("IM",ATy(FTy 10,F32),qVar"state"),
+                  Mop
+                    (Cast(FTy 10),
+                     Apply
+                       (Dest("R",ATy(FTy 7,F32),qVar"state"),
+                        Var("b",FTy 7))),
+                  Apply
+                    (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("a",FTy 7)))]))))
+;
+
+val dfn'Out_def = Def
+  ("dfn'Out",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+      Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Apply
+        (Call
+           ("norm",ATy(qTy,PTy(uTy,qTy)),
+            TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+               Var("skip",CTy"conditionT"), LT, LT, Var("w",FTy 7),
+               Var("a",FTy 7), Var("b",FTy 7)]),qVar"state")))
+;
+
+val dfn'LoadDM_def = Def
+  ("dfn'LoadDM",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+      Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Apply
+        (Call
+           ("norm",ATy(qTy,PTy(uTy,qTy)),
+            TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+               Var("skip",CTy"conditionT"), LF, LF, Var("w",FTy 7),
+               Var("a",FTy 7), Var("b",FTy 7)]),
+         Rupd
+           ("R",
+            TP[qVar"state",
+               Fupd
+                 (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("w",FTy 7),
+                  Apply
+                    (Dest("DM",ATy(FTy 10,F32),qVar"state"),
+                     Mop
+                       (Cast(FTy 10),
+                        Apply
+                          (Dest("R",ATy(FTy 7,F32),qVar"state"),
+                           Var("b",FTy 7)))))]))))
+;
+
+val dfn'In_def = Def
+  ("dfn'In",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+      Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+      Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Apply
+        (Call
+           ("norm",ATy(qTy,PTy(uTy,qTy)),
+            TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+               Var("skip",CTy"conditionT"), LF, LF, Var("w",FTy 7),
+               Var("a",FTy 7), Var("b",FTy 7)]),
+         Rupd
+           ("R",
+            TP[qVar"state",
+               Fupd
+                 (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("w",FTy 7),
+                  Dest("InData",F32,qVar"state"))]))))
+;
+
+val dfn'Jump_def = Def
+  ("dfn'Jump",
+   TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"), Var("w",FTy 7),
+      Var("a",FTy 7), Var("b",FTy 7)],
+   Close
+     (qVar"state",
+      Let
+        (qVar"s",
+         Rupd
+           ("R",
+            TP[qVar"state",
+               Fupd
+                 (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("w",FTy 7),
+                  Mop
+                    (Cast(F32),
+                     Bop(Add,Dest("PC",FTy 10,qVar"state"),LW(1,10))))]),
+         Let
+           (TP[Var("v",FTy 10), qVar"s"],
+            Let
+              (TP[Var("v",F32), qVar"s"],
+               Apply
+                 (Call
+                    ("ALU",ATy(qTy,PTy(F32,qTy)),
+                     TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+                        Apply
+                          (Dest("R",ATy(FTy 7,F32),qVar"s"),
+                           Var("a",FTy 7)),
+                        Apply
+                          (Dest("R",ATy(FTy 7,F32),qVar"s"),
+                           Var("b",FTy 7))]),qVar"s"),
+               TP[Mop(Cast(FTy 10),Var("v",F32)), qVar"s"]),
+            TP[LU, Rupd("PC",TP[qVar"s", Var("v",FTy 10)])]))))
+;
+
+val dfn'LoadConstant_def = Def
+  ("dfn'LoadConstant",TP[Var("w",FTy 7), Var("imm",FTy 24)],
+   Close
+     (qVar"state",
+      Let
+        (qVar"s",
+         Rupd
+           ("R",
+            TP[qVar"state",
+               Fupd
+                 (Dest("R",ATy(FTy 7,F32),qVar"state"),Var("w",FTy 7),
+                  Mop(Cast(F32),Var("imm",FTy 24)))]),
+         TP[LU,
+            Rupd
+              ("PC",
+               TP[qVar"s", Bop(Add,Dest("PC",FTy 10,qVar"s"),LW(1,10))])])))
+;
+
+val dfn'ReservedInstr_def = Def
+  ("dfn'ReservedInstr",qVar"state",
+   Apply
+     (Call
+        ("raise'exception",ATy(qTy,PTy(uTy,qTy)),
+         LC("Reserved",CTy"exception")),qVar"state"))
+;
+
+val Run_def = Def
+  ("Run",Var("v0",CTy"instruction"),
+   Close
+     (qVar"state",
+      CS
+        (Var("v0",CTy"instruction"),
+         [(Const("ReservedInstr",CTy"instruction"),
+           Apply
+             (Const("dfn'ReservedInstr",ATy(qTy,PTy(uTy,qTy))),
+              qVar"state")),
+          (Call
+             ("In",CTy"instruction",
+              Var
+                ("v1",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'In",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v1",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("Jump",CTy"instruction",
+              Var
+                ("v2",
+                 PTy
+                   (CTy"funcT",
+                    PTy(CTy"shiftT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+           Apply
+             (Call
+                ("dfn'Jump",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v2",
+                    PTy
+                      (CTy"funcT",
+                       PTy(CTy"shiftT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              qVar"state")),
+          (Call
+             ("LoadConstant",CTy"instruction",Var("v3",PTy(FTy 7,FTy 24))),
+           Apply
+             (Call
+                ("dfn'LoadConstant",ATy(qTy,PTy(uTy,qTy)),
+                 Var("v3",PTy(FTy 7,FTy 24))),qVar"state")),
+          (Call
+             ("LoadDM",CTy"instruction",
+              Var
+                ("v4",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'LoadDM",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v4",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("Normal",CTy"instruction",
+              Var
+                ("v5",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'Normal",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v5",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("Out",CTy"instruction",
+              Var
+                ("v6",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'Out",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v6",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("StoreDM",CTy"instruction",
+              Var
+                ("v7",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'StoreDM",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v7",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state")),
+          (Call
+             ("StoreIM",CTy"instruction",
+              Var
+                ("v8",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+           Apply
+             (Call
+                ("dfn'StoreIM",ATy(qTy,PTy(uTy,qTy)),
+                 Var
+                   ("v8",
+                    PTy
+                      (CTy"funcT",
+                       PTy
+                         (CTy"shiftT",
+                          PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+              qVar"state"))])))
+;
+
+val Decode_def = Def
+  ("Decode",Var("opc",F32),
+   Let
+     (TP[bVar"b'31", bVar"b'30", bVar"b'29", bVar"b'28", bVar"b'27",
+         bVar"b'26", bVar"b'25", bVar"b'24", bVar"b'23", bVar"b'22",
+         bVar"b'21", bVar"b'20", bVar"b'19", bVar"b'18", bVar"b'17",
+         bVar"b'16", bVar"b'15", bVar"b'14", bVar"b'13", bVar"b'12",
+         bVar"b'11", bVar"b'10", bVar"b'9", bVar"b'8", bVar"b'7",
+         bVar"b'6", bVar"b'5", bVar"b'4", bVar"b'3", bVar"b'2", bVar"b'1",
+         bVar"b'0"],BL(32,Var("opc",F32)),
+      ITE
+        (bVar"b'24",
+         Call
+           ("LoadConstant",CTy"instruction",
+            TP[EX(Var("opc",F32),LN 31,LN 25,FTy 7),
+               EX(Var("opc",F32),LN 23,LN 0,FTy 24)]),
+         Let
+           (Var("Rw",FTy 7),EX(Var("opc",F32),LN 31,LN 25,FTy 7),
+            Let
+              (Var("Rb",FTy 7),EX(Var("opc",F32),LN 16,LN 10,FTy 7),
+               Let
+                 (Var("Ra",FTy 7),EX(Var("opc",F32),LN 23,LN 17,FTy 7),
+                  Let
+                    (Var("func",CTy"funcT"),
+                     Mop
+                       (Cast(CTy"funcT"),
+                        EX(Var("opc",F32),LN 9,LN 7,FTy 3)),
+                     Let
+                       (Var("shift",CTy"shiftT"),
+                        Mop
+                          (Cast(CTy"shiftT"),
+                           EX(Var("opc",F32),LN 6,LN 5,FTy 2)),
+                        Let
+                          (Var("skip",CTy"conditionT"),
+                           Mop
+                             (Cast(CTy"conditionT"),
+                              EX(Var("opc",F32),LN 4,LN 3,FTy 2)),
+                           CS
+                             (EX(Var("opc",F32),LN 2,LN 0,FTy 3),
+                              [(LW(0,3),
+                                Call
+                                  ("Normal",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(1,3),
+                                Call
+                                  ("StoreDM",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(2,3),
+                                Call
+                                  ("StoreIM",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(3,3),
+                                Call
+                                  ("Out",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(4,3),
+                                Call
+                                  ("LoadDM",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(5,3),
+                                Call
+                                  ("In",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("skip",CTy"conditionT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(6,3),
+                                Call
+                                  ("Jump",CTy"instruction",
+                                   TP[Var("func",CTy"funcT"),
+                                      Var("shift",CTy"shiftT"),
+                                      Var("Rw",FTy 7), Var("Ra",FTy 7),
+                                      Var("Rb",FTy 7)])),
+                               (LW(7,3),
+                                Const("ReservedInstr",CTy"instruction"))]))))))))))
+;
+
+val Next_def = Def
+  ("Next",qVar"state",
+   Let
+     (Var("v",CTy"instruction"),
+      Call
+        ("Decode",CTy"instruction",
+         Apply
+           (Dest("IM",ATy(FTy 10,F32),qVar"state"),
+            Dest("PC",FTy 10,qVar"state"))),
+      ITE
+        (Mop
+           (Not,
+            EQ
+              (Var("v",CTy"instruction"),
+               Const("ReservedInstr",CTy"instruction"))),
+         Apply
+           (Call("Run",ATy(qTy,PTy(uTy,qTy)),Var("v",CTy"instruction")),
+            qVar"state"),TP[LU, qVar"state"])))
+;
+
+val enc_def = Def
+  ("enc",
+   TP[Var
+        ("args",
+         PTy
+           (CTy"funcT",
+            PTy
+              (CTy"shiftT",
+               PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+      Var("opc",FTy 3)],
+   Let
+     (TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+         Var("skip",CTy"conditionT"), Var("w",FTy 7), Var("a",FTy 7),
+         Var("b",FTy 7)],
+      Var
+        ("args",
+         PTy
+           (CTy"funcT",
+            PTy
+              (CTy"shiftT",
+               PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+      CC[Var("w",FTy 7), LW(0,1), Var("a",FTy 7), Var("b",FTy 7),
+         Mop(Cast(FTy 3),Var("func",CTy"funcT")),
+         Mop(Cast(FTy 2),Var("shift",CTy"shiftT")),
+         Mop(Cast(FTy 2),Var("skip",CTy"conditionT")), Var("opc",FTy 3)]))
+;
+
+val Encode_def = Def
+  ("Encode",Var("i",CTy"instruction"),
+   CS
+     (Var("i",CTy"instruction"),
+      [(Call
+          ("LoadConstant",CTy"instruction",
+           TP[Var("Rw",FTy 7), Var("imm",FTy 24)]),
+        CC[Var("Rw",FTy 7), LW(1,1), Var("imm",FTy 24)]),
+       (Call
+          ("Normal",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(0,3)])),
+       (Call
+          ("StoreDM",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(1,3)])),
+       (Call
+          ("StoreIM",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(2,3)])),
+       (Call
+          ("Out",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(3,3)])),
+       (Call
+          ("LoadDM",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(4,3)])),
+       (Call
+          ("In",CTy"instruction",
+           Var
+             ("args",
+              PTy
+                (CTy"funcT",
+                 PTy
+                   (CTy"shiftT",
+                    PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7))))))),
+        Call
+          ("enc",F32,
+           TP[Var
+                ("args",
+                 PTy
+                   (CTy"funcT",
+                    PTy
+                      (CTy"shiftT",
+                       PTy(CTy"conditionT",PTy(FTy 7,PTy(FTy 7,FTy 7)))))),
+              LW(5,3)])),
+       (Call
+          ("Jump",CTy"instruction",
+           TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+              Var("Rw",FTy 7), Var("Ra",FTy 7), Var("Rb",FTy 7)]),
+        Call
+          ("enc",F32,
+           TP[TP[Var("func",CTy"funcT"), Var("shift",CTy"shiftT"),
+                 LC("skipNever",CTy"conditionT"), Var("Rw",FTy 7),
+                 Var("Ra",FTy 7), Var("Rb",FTy 7)], LW(6,3)])),
+       (Const("ReservedInstr",CTy"instruction"),LW(7,32))]))
+;
+
+val LoadIM_def = tDef
+  ("LoadIM",TP[Var("a",FTy 10), Var("i",LTy(CTy"instruction"))],
+   Close
+     (qVar"state",
+      CS
+        (Var("i",LTy(CTy"instruction")),
+         [(LNL(CTy"instruction"),TP[LU, qVar"state"]),
+          (LLC([Var("h",CTy"instruction")],Var("t",LTy(CTy"instruction"))),
+           Apply
+             (Call
+                ("LoadIM",ATy(qTy,PTy(uTy,qTy)),
+                 TP[Bop(Add,Var("a",FTy 10),LW(1,10)),
+                    Var("t",LTy(CTy"instruction"))]),
+              Rupd
+                ("IM",
+                 TP[qVar"state",
+                    Fupd
+                      (Dest("IM",ATy(FTy 10,F32),qVar"state"),
+                       Var("a",FTy 10),
+                       Call("Encode",F32,Var("h",CTy"instruction")))])))])),
+   Close
+     (Var("x",PTy(PTy(FTy 10,LTy(CTy"instruction")),qTy)),
+      CS
+        (Var("x",PTy(PTy(FTy 10,LTy(CTy"instruction")),qTy)),
+         [(TP[TP[Var("a",FTy 10), Var("i",LTy(CTy"instruction"))],
+              AVar(qTy)],Mop(Length,Var("i",LTy(CTy"instruction"))))])))
+
+val () = Import.finish 1
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tinyTheory.sig acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tinyTheory.sig
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/tinyTheory.sig	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/tinyTheory.sig	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,2030 @@
+signature tinyTheory =
+sig
+  type thm = Thm.thm
+
+  (*  Definitions  *)
+    val ALU_def : thm
+    val Decode_def : thm
+    val Encode_def : thm
+    val LoadIM_curried_def : thm
+    val LoadIM_tupled_primitive_def : thm
+    val Next_def : thm
+    val Run_def : thm
+    val bitify32_def : thm
+    val boolify32_def : thm
+    val conditionT_BIJ : thm
+    val conditionT_CASE : thm
+    val conditionT_TY_DEF : thm
+    val conditionT_size_def : thm
+    val dfn'In_def : thm
+    val dfn'Jump_def : thm
+    val dfn'LoadConstant_def : thm
+    val dfn'LoadDM_def : thm
+    val dfn'Normal_def : thm
+    val dfn'Out_def : thm
+    val dfn'ReservedInstr_def : thm
+    val dfn'StoreDM_def : thm
+    val dfn'StoreIM_def : thm
+    val enc_def : thm
+    val exception_BIJ : thm
+    val exception_CASE : thm
+    val exception_TY_DEF : thm
+    val exception_size_def : thm
+    val funcT_BIJ : thm
+    val funcT_CASE : thm
+    val funcT_TY_DEF : thm
+    val funcT_size_def : thm
+    val function_def : thm
+    val incPC_def : thm
+    val initialize_def : thm
+    val instruction_TY_DEF : thm
+    val instruction_case_def : thm
+    val instruction_size_def : thm
+    val norm_def : thm
+    val raise'exception_def : thm
+    val shiftT_BIJ : thm
+    val shiftT_CASE : thm
+    val shiftT_TY_DEF : thm
+    val shiftT_size_def : thm
+    val shifter_def : thm
+    val test_prog_def : thm
+    val tiny_state_DM : thm
+    val tiny_state_DM_fupd : thm
+    val tiny_state_IM : thm
+    val tiny_state_IM_fupd : thm
+    val tiny_state_InData : thm
+    val tiny_state_InData_fupd : thm
+    val tiny_state_InRdy : thm
+    val tiny_state_InRdy_fupd : thm
+    val tiny_state_OutStrobe : thm
+    val tiny_state_OutStrobe_fupd : thm
+    val tiny_state_PC : thm
+    val tiny_state_PC_fupd : thm
+    val tiny_state_R : thm
+    val tiny_state_R_fupd : thm
+    val tiny_state_TY_DEF : thm
+    val tiny_state_case_def : thm
+    val tiny_state_exception : thm
+    val tiny_state_exception_fupd : thm
+    val tiny_state_size_def : thm
+
+  (*  Theorems  *)
+    val EXISTS_tiny_state : thm
+    val FORALL_tiny_state : thm
+    val LoadIM_def : thm
+    val LoadIM_ind : thm
+    val bitify32boolify32 : thm
+    val boolify32_n2w : thm
+    val boolify32_v2w : thm
+    val boolify32bitify32 : thm
+    val conditionT2num_11 : thm
+    val conditionT2num_ONTO : thm
+    val conditionT2num_num2conditionT : thm
+    val conditionT2num_thm : thm
+    val conditionT_Axiom : thm
+    val conditionT_EQ_conditionT : thm
+    val conditionT_case_cong : thm
+    val conditionT_case_def : thm
+    val conditionT_distinct : thm
+    val conditionT_induction : thm
+    val conditionT_nchotomy : thm
+    val datatype_conditionT : thm
+    val datatype_exception : thm
+    val datatype_funcT : thm
+    val datatype_instruction : thm
+    val datatype_shiftT : thm
+    val datatype_tiny_state : thm
+    val exception2num_11 : thm
+    val exception2num_ONTO : thm
+    val exception2num_num2exception : thm
+    val exception2num_thm : thm
+    val exception_Axiom : thm
+    val exception_EQ_exception : thm
+    val exception_case_cong : thm
+    val exception_case_def : thm
+    val exception_distinct : thm
+    val exception_induction : thm
+    val exception_nchotomy : thm
+    val funcT2num_11 : thm
+    val funcT2num_ONTO : thm
+    val funcT2num_num2funcT : thm
+    val funcT2num_thm : thm
+    val funcT_Axiom : thm
+    val funcT_EQ_funcT : thm
+    val funcT_case_cong : thm
+    val funcT_case_def : thm
+    val funcT_distinct : thm
+    val funcT_induction : thm
+    val funcT_nchotomy : thm
+    val instruction_11 : thm
+    val instruction_Axiom : thm
+    val instruction_case_cong : thm
+    val instruction_distinct : thm
+    val instruction_induction : thm
+    val instruction_nchotomy : thm
+    val num2conditionT_11 : thm
+    val num2conditionT_ONTO : thm
+    val num2conditionT_conditionT2num : thm
+    val num2conditionT_thm : thm
+    val num2exception_11 : thm
+    val num2exception_ONTO : thm
+    val num2exception_exception2num : thm
+    val num2exception_thm : thm
+    val num2funcT_11 : thm
+    val num2funcT_ONTO : thm
+    val num2funcT_funcT2num : thm
+    val num2funcT_thm : thm
+    val num2shiftT_11 : thm
+    val num2shiftT_ONTO : thm
+    val num2shiftT_shiftT2num : thm
+    val num2shiftT_thm : thm
+    val shiftT2num_11 : thm
+    val shiftT2num_ONTO : thm
+    val shiftT2num_num2shiftT : thm
+    val shiftT2num_thm : thm
+    val shiftT_Axiom : thm
+    val shiftT_EQ_shiftT : thm
+    val shiftT_case_cong : thm
+    val shiftT_case_def : thm
+    val shiftT_distinct : thm
+    val shiftT_induction : thm
+    val shiftT_nchotomy : thm
+    val tiny_state_11 : thm
+    val tiny_state_Axiom : thm
+    val tiny_state_accessors : thm
+    val tiny_state_accfupds : thm
+    val tiny_state_case_cong : thm
+    val tiny_state_component_equality : thm
+    val tiny_state_fn_updates : thm
+    val tiny_state_fupdcanon : thm
+    val tiny_state_fupdcanon_comp : thm
+    val tiny_state_fupdfupds : thm
+    val tiny_state_fupdfupds_comp : thm
+    val tiny_state_induction : thm
+    val tiny_state_literal_11 : thm
+    val tiny_state_literal_nchotomy : thm
+    val tiny_state_nchotomy : thm
+    val tiny_state_updates_eq_literal : thm
+
+  val tiny_grammars : type_grammar.grammar * term_grammar.grammar
+
+  val inventory: {Thy: string, T: string list, C: string list, N: int list}
+(*
+   [bitstring] Parent theory of "tiny"
+
+   [integer_word] Parent theory of "tiny"
+
+   [machine_ieee] Parent theory of "tiny"
+
+   [state_transformer] Parent theory of "tiny"
+
+   [ALU_def]  Definition
+
+      |- ∀func shift a b.
+           ALU (func,shift,a,b) =
+           (λstate.
+              (let (v,s) = function (func,a,b) state
+               in
+                 (shifter (shift,v),s)))
+
+   [Decode_def]  Definition
+
+      |- ∀opc.
+           Decode opc =
+           (let (b'31,b'30,b'29,b'28,b'27,b'26,b'25,b'24,b'23,b'22,b'21,
+                 b'20,b'19,b'18,b'17,b'16,b'15,b'14,b'13,b'12,b'11,b'10,
+                 b'9,b'8,b'7,b'6,b'5,b'4,b'3,b'2,b'1,b'0) = boolify32 opc
+            in
+              if b'24 then LoadConstant ((31 >< 25) opc,(23 >< 0) opc)
+              else
+                (let Rw = (31 >< 25) opc in
+                 let Rb = (16 >< 10) opc in
+                 let Ra = (23 >< 17) opc in
+                 let func = num2funcT (w2n ((9 >< 7) opc)) in
+                 let shift = num2shiftT (w2n ((6 >< 5) opc)) in
+                 let skip = num2conditionT (w2n ((4 >< 3) opc))
+                 in
+                   case (2 >< 0) opc of
+                     0w => Normal (func,shift,skip,Rw,Ra,Rb)
+                   | 1w => StoreDM (func,shift,skip,Rw,Ra,Rb)
+                   | 2w => StoreIM (func,shift,skip,Rw,Ra,Rb)
+                   | 3w => Out (func,shift,skip,Rw,Ra,Rb)
+                   | 4w => LoadDM (func,shift,skip,Rw,Ra,Rb)
+                   | 5w => In (func,shift,skip,Rw,Ra,Rb)
+                   | 6w => Jump (func,shift,Rw,Ra,Rb)
+                   | 7w => ReservedInstr
+                   | v => ARB))
+
+   [Encode_def]  Definition
+
+      |- ∀i.
+           Encode i =
+           case i of
+             In args_5 => enc (args_5,5w)
+           | Jump (func,shift,Rw_1,Ra,Rb) =>
+               enc ((func,shift,skipNever,Rw_1,Ra,Rb),6w)
+           | LoadConstant (Rw,imm) => Rw @@ 1w @@ imm
+           | LoadDM args_4 => enc (args_4,4w)
+           | Normal args => enc (args,0w)
+           | Out args_3 => enc (args_3,3w)
+           | ReservedInstr => 7w
+           | StoreDM args_1 => enc (args_1,1w)
+           | StoreIM args_2 => enc (args_2,2w)
+
+   [LoadIM_curried_def]  Definition
+
+      |- ∀x x1. LoadIM x x1 = LoadIM_tupled (x,x1)
+
+   [LoadIM_tupled_primitive_def]  Definition
+
+      |- LoadIM_tupled =
+         WFREC
+           (@R.
+              WF R ∧
+              ∀state a i h t.
+                (i = h::t) ⇒
+                R ((a + 1w,t),state with IM := (a =+ Encode h) state.IM)
+                  ((a,i),state))
+           (λLoadIM_tupled a'.
+              case a' of
+                ((a,i),state) =>
+                  I
+                    (case i of
+                       [] => ((),state)
+                     | h::t =>
+                         LoadIM_tupled
+                           ((a + 1w,t),
+                            state with IM := (a =+ Encode h) state.IM)))
+
+   [Next_def]  Definition
+
+      |- ∀state.
+           Next state =
+           (let v = Decode (state.IM state.PC)
+            in
+              if v ≠ ReservedInstr then Run v state else ((),state))
+
+   [Run_def]  Definition
+
+      |- ∀v0.
+           Run v0 =
+           (λstate.
+              case v0 of
+                In v1 => dfn'In v1 state
+              | Jump v2 => dfn'Jump v2 state
+              | LoadConstant v3 => dfn'LoadConstant v3 state
+              | LoadDM v4 => dfn'LoadDM v4 state
+              | Normal v5 => dfn'Normal v5 state
+              | Out v6 => dfn'Out v6 state
+              | ReservedInstr => dfn'ReservedInstr state
+              | StoreDM v7 => dfn'StoreDM v7 state
+              | StoreIM v8 => dfn'StoreIM v8 state)
+
+   [bitify32_def]  Definition
+
+      |- ∀b31 b30 b29 b28 b27 b26 b25 b24 b23 b22 b21 b20 b19 b18 b17 b16
+            b15 b14 b13 b12 b11 b10 b9 b8 b7 b6 b5 b4 b3 b2 b1 b0.
+           bitify32
+             (b31,b30,b29,b28,b27,b26,b25,b24,b23,b22,b21,b20,b19,b18,b17,
+              b16,b15,b14,b13,b12,b11,b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0) =
+           v2w
+             [b31; b30; b29; b28; b27; b26; b25; b24; b23; b22; b21; b20;
+              b19; b18; b17; b16; b15; b14; b13; b12; b11; b10; b9; b8; b7;
+              b6; b5; b4; b3; b2; b1; b0]
+
+   [boolify32_def]  Definition
+
+      |- ∀w.
+           boolify32 w =
+           (word_bit 31 w,word_bit 30 w,word_bit 29 w,word_bit 28 w,
+            word_bit 27 w,word_bit 26 w,word_bit 25 w,word_bit 24 w,
+            word_bit 23 w,word_bit 22 w,word_bit 21 w,word_bit 20 w,
+            word_bit 19 w,word_bit 18 w,word_bit 17 w,word_bit 16 w,
+            word_bit 15 w,word_bit 14 w,word_bit 13 w,word_bit 12 w,
+            word_bit 11 w,word_bit 10 w,word_bit 9 w,word_bit 8 w,
+            word_bit 7 w,word_bit 6 w,word_bit 5 w,word_bit 4 w,
+            word_bit 3 w,word_bit 2 w,word_bit 1 w,word_bit 0 w)
+
+   [conditionT_BIJ]  Definition
+
+      |- (∀a. num2conditionT (conditionT2num a) = a) ∧
+         ∀r. (λn. n < 4) r ⇔ (conditionT2num (num2conditionT r) = r)
+
+   [conditionT_CASE]  Definition
+
+      |- ∀x v0 v1 v2 v3.
+           (case x of
+              skipNever => v0
+            | skipNeg => v1
+            | skipZero => v2
+            | skipInRdy => v3) =
+           (λm.
+              if m < 1 then v0
+              else if m < 2 then v1
+              else if m = 2 then v2
+              else v3) (conditionT2num x)
+
+   [conditionT_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 4) rep
+
+   [conditionT_size_def]  Definition
+
+      |- ∀x. conditionT_size x = 0
+
+   [dfn'In_def]  Definition
+
+      |- ∀func shift skip w a b.
+           dfn'In (func,shift,skip,w,a,b) =
+           (λstate.
+              norm (func,shift,skip,F,F,w,a,b)
+                (state with R := (w =+ state.InData) state.R))
+
+   [dfn'Jump_def]  Definition
+
+      |- ∀func shift w a b.
+           dfn'Jump (func,shift,w,a,b) =
+           (λstate.
+              (let s = state with R := (w =+ w2w (state.PC + 1w)) state.R
+               in
+               let (v,s) =
+                     (let (v,s) = ALU (func,shift,s.R a,s.R b) s
+                      in
+                        (w2w v,s))
+               in
+                 ((),s with PC := v)))
+
+   [dfn'LoadConstant_def]  Definition
+
+      |- ∀w imm.
+           dfn'LoadConstant (w,imm) =
+           (λstate.
+              (let s = state with R := (w =+ w2w imm) state.R
+               in
+                 ((),s with PC := s.PC + 1w)))
+
+   [dfn'LoadDM_def]  Definition
+
+      |- ∀func shift skip w a b.
+           dfn'LoadDM (func,shift,skip,w,a,b) =
+           (λstate.
+              norm (func,shift,skip,F,F,w,a,b)
+                (state with
+                 R := (w =+ state.DM (w2w (state.R b))) state.R))
+
+   [dfn'Normal_def]  Definition
+
+      |- ∀func shift skip w a b.
+           dfn'Normal (func,shift,skip,w,a,b) =
+           (λstate. norm (func,shift,skip,T,F,w,a,b) state)
+
+   [dfn'Out_def]  Definition
+
+      |- ∀func shift skip w a b.
+           dfn'Out (func,shift,skip,w,a,b) =
+           (λstate. norm (func,shift,skip,T,T,w,a,b) state)
+
+   [dfn'ReservedInstr_def]  Definition
+
+      |- ∀state. dfn'ReservedInstr state = raise'exception Reserved state
+
+   [dfn'StoreDM_def]  Definition
+
+      |- ∀func shift skip w a b.
+           dfn'StoreDM (func,shift,skip,w,a,b) =
+           (λstate.
+              norm (func,shift,skip,T,F,w,a,b)
+                (state with DM := (w2w (state.R b) =+ state.R a) state.DM))
+
+   [dfn'StoreIM_def]  Definition
+
+      |- ∀func shift skip w a b.
+           dfn'StoreIM (func,shift,skip,w,a,b) =
+           (λstate.
+              norm (func,shift,skip,T,F,w,a,b)
+                (state with IM := (w2w (state.R b) =+ state.R a) state.IM))
+
+   [enc_def]  Definition
+
+      |- ∀args opc.
+           enc (args,opc) =
+           (let (func,shift,skip,w,a,b) = args
+            in
+              w @@ 0w @@ a @@ b @@ n2w (funcT2num func) @@
+              n2w (shiftT2num shift) @@ n2w (conditionT2num skip) @@ opc)
+
+   [exception_BIJ]  Definition
+
+      |- (∀a. num2exception (exception2num a) = a) ∧
+         ∀r. (λn. n < 2) r ⇔ (exception2num (num2exception r) = r)
+
+   [exception_CASE]  Definition
+
+      |- ∀x v0 v1.
+           (case x of NoException => v0 | Reserved => v1) =
+           (λm. if m = 0 then v0 else v1) (exception2num x)
+
+   [exception_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 2) rep
+
+   [exception_size_def]  Definition
+
+      |- ∀x. exception_size x = 0
+
+   [funcT_BIJ]  Definition
+
+      |- (∀a. num2funcT (funcT2num a) = a) ∧
+         ∀r. (λn. n < 8) r ⇔ (funcT2num (num2funcT r) = r)
+
+   [funcT_CASE]  Definition
+
+      |- ∀x v0 v1 v2 v3 v4 v5 v6 v7.
+           (case x of
+              fADD => v0
+            | fSUB => v1
+            | fINC => v2
+            | fDEC => v3
+            | fAND => v4
+            | fOR => v5
+            | fXOR => v6
+            | fReserved => v7) =
+           (λm.
+              if m < 3 then if m < 1 then v0 else if m = 1 then v1 else v2
+              else if m < 5 then if m = 3 then v3 else v4
+              else if m < 6 then v5
+              else if m = 6 then v6
+              else v7) (funcT2num x)
+
+   [funcT_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 8) rep
+
+   [funcT_size_def]  Definition
+
+      |- ∀x. funcT_size x = 0
+
+   [function_def]  Definition
+
+      |- ∀func a b.
+           function (func,a,b) =
+           (λstate.
+              case func of
+                fADD => (a + b,state)
+              | fSUB => (a − b,state)
+              | fINC => (b + 1w,state)
+              | fDEC => (b − 1w,state)
+              | fAND => (a && b,state)
+              | fOR => (a ‖ b,state)
+              | fXOR => (a ⊕ b,state)
+              | fReserved => raise'exception Reserved state)
+
+   [incPC_def]  Definition
+
+      |- ∀skip alu.
+           incPC (skip,alu) =
+           (λstate.
+              case skip of
+                skipNever => ((),state with PC := state.PC + 1w)
+              | skipNeg =>
+                  ((),
+                   state with PC := state.PC + if alu < 0w then 2w else 1w)
+              | skipZero =>
+                  ((),
+                   state with PC := state.PC + if alu = 0w then 2w else 1w)
+              | skipInRdy =>
+                  ((),
+                   state with
+                   PC := state.PC + if state.InRdy then 2w else 1w))
+
+   [initialize_def]  Definition
+
+      |- ∀p.
+           initialize p =
+           (λstate.
+              LoadIM (0w,p)
+                (state with
+                 <|IM := K (Encode ReservedInstr); OutStrobe := 0w;
+                   InData := 0w; InRdy := F; DM := K 0w; R := K 0w;
+                   PC := 0w|>))
+
+   [instruction_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'instruction' .
+                  (∀a0.
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR 0 (a,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0) (ARB,a,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC 0)) (ARB,ARB,a)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC (SUC 0))) (a,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC (SUC (SUC 0))))
+                             (a,ARB,ARB) (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC (SUC (SUC (SUC 0)))))
+                             (a,ARB,ARB) (λn. ind_type$BOTTOM)) a) ∨
+                     (a0 =
+                      ind_type$CONSTR (SUC (SUC (SUC (SUC (SUC (SUC 0))))))
+                        (ARB,ARB,ARB) (λn. ind_type$BOTTOM)) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC (SUC (SUC (SUC (SUC (SUC (SUC 0)))))))
+                             (a,ARB,ARB) (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC (SUC (SUC (SUC (SUC (SUC 0))))))))
+                             (a,ARB,ARB) (λn. ind_type$BOTTOM)) a) ⇒
+                     'instruction' a0) ⇒
+                  'instruction' a0) rep
+
+   [instruction_case_def]  Definition
+
+      |- (∀a f f1 f2 f3 f4 f5 v f6 f7.
+            instruction_CASE (In a) f f1 f2 f3 f4 f5 v f6 f7 = f a) ∧
+         (∀a f f1 f2 f3 f4 f5 v f6 f7.
+            instruction_CASE (Jump a) f f1 f2 f3 f4 f5 v f6 f7 = f1 a) ∧
+         (∀a f f1 f2 f3 f4 f5 v f6 f7.
+            instruction_CASE (LoadConstant a) f f1 f2 f3 f4 f5 v f6 f7 =
+            f2 a) ∧
+         (∀a f f1 f2 f3 f4 f5 v f6 f7.
+            instruction_CASE (LoadDM a) f f1 f2 f3 f4 f5 v f6 f7 = f3 a) ∧
+         (∀a f f1 f2 f3 f4 f5 v f6 f7.
+            instruction_CASE (Normal a) f f1 f2 f3 f4 f5 v f6 f7 = f4 a) ∧
+         (∀a f f1 f2 f3 f4 f5 v f6 f7.
+            instruction_CASE (Out a) f f1 f2 f3 f4 f5 v f6 f7 = f5 a) ∧
+         (∀f f1 f2 f3 f4 f5 v f6 f7.
+            instruction_CASE ReservedInstr f f1 f2 f3 f4 f5 v f6 f7 = v) ∧
+         (∀a f f1 f2 f3 f4 f5 v f6 f7.
+            instruction_CASE (StoreDM a) f f1 f2 f3 f4 f5 v f6 f7 = f6 a) ∧
+         ∀a f f1 f2 f3 f4 f5 v f6 f7.
+           instruction_CASE (StoreIM a) f f1 f2 f3 f4 f5 v f6 f7 = f7 a
+
+   [instruction_size_def]  Definition
+
+      |- (∀a.
+            instruction_size (In a) =
+            1 +
+            pair_size funcT_size
+              (pair_size shiftT_size
+                 (pair_size conditionT_size
+                    (pair_size (λv. 0) (pair_size (λv. 0) (λv. 0))))) a) ∧
+         (∀a.
+            instruction_size (Jump a) =
+            1 +
+            pair_size funcT_size
+              (pair_size shiftT_size
+                 (pair_size (λv. 0) (pair_size (λv. 0) (λv. 0)))) a) ∧
+         (∀a.
+            instruction_size (LoadConstant a) =
+            1 + pair_size (λv. 0) (λv. 0) a) ∧
+         (∀a.
+            instruction_size (LoadDM a) =
+            1 +
+            pair_size funcT_size
+              (pair_size shiftT_size
+                 (pair_size conditionT_size
+                    (pair_size (λv. 0) (pair_size (λv. 0) (λv. 0))))) a) ∧
+         (∀a.
+            instruction_size (Normal a) =
+            1 +
+            pair_size funcT_size
+              (pair_size shiftT_size
+                 (pair_size conditionT_size
+                    (pair_size (λv. 0) (pair_size (λv. 0) (λv. 0))))) a) ∧
+         (∀a.
+            instruction_size (Out a) =
+            1 +
+            pair_size funcT_size
+              (pair_size shiftT_size
+                 (pair_size conditionT_size
+                    (pair_size (λv. 0) (pair_size (λv. 0) (λv. 0))))) a) ∧
+         (instruction_size ReservedInstr = 0) ∧
+         (∀a.
+            instruction_size (StoreDM a) =
+            1 +
+            pair_size funcT_size
+              (pair_size shiftT_size
+                 (pair_size conditionT_size
+                    (pair_size (λv. 0) (pair_size (λv. 0) (λv. 0))))) a) ∧
+         ∀a.
+           instruction_size (StoreIM a) =
+           1 +
+           pair_size funcT_size
+             (pair_size shiftT_size
+                (pair_size conditionT_size
+                   (pair_size (λv. 0) (pair_size (λv. 0) (λv. 0))))) a
+
+   [norm_def]  Definition
+
+      |- ∀func shift skip wback strobe w a b.
+           norm (func,shift,skip,wback,strobe,w,a,b) =
+           (λstate.
+              (let (v,s) = ALU (func,shift,state.R a,state.R b) state in
+               let s = if wback then s with R := (w =+ v) s.R else s
+               in
+                 incPC (skip,v)
+                   (if strobe then s with OutStrobe := v else s)))
+
+   [raise'exception_def]  Definition
+
+      |- ∀e.
+           raise'exception e =
+           (λstate.
+              (ARB,
+               if state.exception = NoException then
+                 state with exception := e
+               else state))
+
+   [shiftT_BIJ]  Definition
+
+      |- (∀a. num2shiftT (shiftT2num a) = a) ∧
+         ∀r. (λn. n < 4) r ⇔ (shiftT2num (num2shiftT r) = r)
+
+   [shiftT_CASE]  Definition
+
+      |- ∀x v0 v1 v2 v3.
+           (case x of
+              noShift => v0
+            | RCY1 => v1
+            | RCY8 => v2
+            | RCY16 => v3) =
+           (λm.
+              if m < 1 then v0
+              else if m < 2 then v1
+              else if m = 2 then v2
+              else v3) (shiftT2num x)
+
+   [shiftT_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 4) rep
+
+   [shiftT_size_def]  Definition
+
+      |- ∀x. shiftT_size x = 0
+
+   [shifter_def]  Definition
+
+      |- ∀shift a.
+           shifter (shift,a) =
+           case shift of
+             noShift => a
+           | RCY1 => a ⇄ 1
+           | RCY8 => a ⇄ 8
+           | RCY16 => a ⇄ 16
+
+   [test_prog_def]  Definition
+
+      |- test_prog =
+         [LoadConstant (0w,0w); LoadConstant (1w,1000w);
+          LoadConstant (2w,1010w); LoadConstant (3w,4w);
+          StoreDM (fINC,noShift,skipNever,1w,1w,1w);
+          Normal (fXOR,noShift,skipZero,4w,1w,2w);
+          Jump (fADD,noShift,4w,3w,0w);
+          Out (fADD,noShift,skipNever,1w,1w,0w)]
+
+   [tiny_state_DM]  Definition
+
+      |- ∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).DM = f
+
+   [tiny_state_DM_fupd]  Definition
+
+      |- ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with DM updated_by f2 =
+           tiny_state (f2 f) f0 c b c0 c1 f1 e
+
+   [tiny_state_IM]  Definition
+
+      |- ∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).IM = f0
+
+   [tiny_state_IM_fupd]  Definition
+
+      |- ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with IM updated_by f2 =
+           tiny_state f (f2 f0) c b c0 c1 f1 e
+
+   [tiny_state_InData]  Definition
+
+      |- ∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).InData = c
+
+   [tiny_state_InData_fupd]  Definition
+
+      |- ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with InData updated_by f2 =
+           tiny_state f f0 (f2 c) b c0 c1 f1 e
+
+   [tiny_state_InRdy]  Definition
+
+      |- ∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).InRdy ⇔ b
+
+   [tiny_state_InRdy_fupd]  Definition
+
+      |- ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with InRdy updated_by f2 =
+           tiny_state f f0 c (f2 b) c0 c1 f1 e
+
+   [tiny_state_OutStrobe]  Definition
+
+      |- ∀f f0 c b c0 c1 f1 e.
+           (tiny_state f f0 c b c0 c1 f1 e).OutStrobe = c0
+
+   [tiny_state_OutStrobe_fupd]  Definition
+
+      |- ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with OutStrobe updated_by f2 =
+           tiny_state f f0 c b (f2 c0) c1 f1 e
+
+   [tiny_state_PC]  Definition
+
+      |- ∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).PC = c1
+
+   [tiny_state_PC_fupd]  Definition
+
+      |- ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with PC updated_by f2 =
+           tiny_state f f0 c b c0 (f2 c1) f1 e
+
+   [tiny_state_R]  Definition
+
+      |- ∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).R = f1
+
+   [tiny_state_R_fupd]  Definition
+
+      |- ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with R updated_by f2 =
+           tiny_state f f0 c b c0 c1 (f2 f1) e
+
+   [tiny_state_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0'.
+                ∀'tiny_state' .
+                  (∀a0'.
+                     (∃a0 a1 a2 a3 a4 a5 a6 a7.
+                        a0' =
+                        (λa0 a1 a2 a3 a4 a5 a6 a7.
+                           ind_type$CONSTR 0 (a0,a1,a2,a3,a4,a5,a6,a7)
+                             (λn. ind_type$BOTTOM)) a0 a1 a2 a3 a4 a5 a6
+                          a7) ⇒
+                     'tiny_state' a0') ⇒
+                  'tiny_state' a0') rep
+
+   [tiny_state_case_def]  Definition
+
+      |- ∀a0 a1 a2 a3 a4 a5 a6 a7 f.
+           tiny_state_CASE (tiny_state a0 a1 a2 a3 a4 a5 a6 a7) f =
+           f a0 a1 a2 a3 a4 a5 a6 a7
+
+   [tiny_state_exception]  Definition
+
+      |- ∀f f0 c b c0 c1 f1 e.
+           (tiny_state f f0 c b c0 c1 f1 e).exception = e
+
+   [tiny_state_exception_fupd]  Definition
+
+      |- ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with exception updated_by f2 =
+           tiny_state f f0 c b c0 c1 f1 (f2 e)
+
+   [tiny_state_size_def]  Definition
+
+      |- ∀a0 a1 a2 a3 a4 a5 a6 a7.
+           tiny_state_size (tiny_state a0 a1 a2 a3 a4 a5 a6 a7) =
+           1 + (bool_size a3 + exception_size a7)
+
+   [EXISTS_tiny_state]  Theorem
+
+      |- ∀P.
+           (∃t. P t) ⇔
+           ∃f1 f0 c1 b c0 c f e.
+             P
+               <|DM := f1; IM := f0; InData := c1; InRdy := b;
+                 OutStrobe := c0; PC := c; R := f; exception := e|>
+
+   [FORALL_tiny_state]  Theorem
+
+      |- ∀P.
+           (∀t. P t) ⇔
+           ∀f1 f0 c1 b c0 c f e.
+             P
+               <|DM := f1; IM := f0; InData := c1; InRdy := b;
+                 OutStrobe := c0; PC := c; R := f; exception := e|>
+
+   [LoadIM_def]  Theorem
+
+      |- ∀state i a.
+           LoadIM (a,i) state =
+           case i of
+             [] => ((),state)
+           | h::t =>
+               LoadIM (a + 1w,t)
+                 (state with IM := (a =+ Encode h) state.IM)
+
+   [LoadIM_ind]  Theorem
+
+      |- ∀P.
+           (∀a i state.
+              (∀h t.
+                 (i = h::t) ⇒
+                 P (a + 1w,t)
+                   (state with IM := (a =+ Encode h) state.IM)) ⇒
+              P (a,i) state) ⇒
+           ∀v v1 v2. P (v,v1) v2
+
+   [bitify32boolify32]  Theorem
+
+      |- ∀w. bitify32 (boolify32 w) = w
+
+   [boolify32_n2w]  Theorem
+
+      |- ∀n.
+           boolify32 (n2w n) =
+           (let n1 = DIV2 n in
+            let n2 = DIV2 n1 in
+            let n3 = DIV2 n2 in
+            let n4 = DIV2 n3 in
+            let n5 = DIV2 n4 in
+            let n6 = DIV2 n5 in
+            let n7 = DIV2 n6 in
+            let n8 = DIV2 n7 in
+            let n9 = DIV2 n8 in
+            let n10 = DIV2 n9 in
+            let n11 = DIV2 n10 in
+            let n12 = DIV2 n11 in
+            let n13 = DIV2 n12 in
+            let n14 = DIV2 n13 in
+            let n15 = DIV2 n14 in
+            let n16 = DIV2 n15 in
+            let n17 = DIV2 n16 in
+            let n18 = DIV2 n17 in
+            let n19 = DIV2 n18 in
+            let n20 = DIV2 n19 in
+            let n21 = DIV2 n20 in
+            let n22 = DIV2 n21 in
+            let n23 = DIV2 n22 in
+            let n24 = DIV2 n23 in
+            let n25 = DIV2 n24 in
+            let n26 = DIV2 n25 in
+            let n27 = DIV2 n26 in
+            let n28 = DIV2 n27 in
+            let n29 = DIV2 n28 in
+            let n30 = DIV2 n29 in
+            let n31 = DIV2 n30
+            in
+              (ODD n31,ODD n30,ODD n29,ODD n28,ODD n27,ODD n26,ODD n25,
+               ODD n24,ODD n23,ODD n22,ODD n21,ODD n20,ODD n19,ODD n18,
+               ODD n17,ODD n16,ODD n15,ODD n14,ODD n13,ODD n12,ODD n11,
+               ODD n10,ODD n9,ODD n8,ODD n7,ODD n6,ODD n5,ODD n4,ODD n3,
+               ODD n2,ODD n1,ODD n))
+
+   [boolify32_v2w]  Theorem
+
+      |- ∀b31 b30 b29 b28 b27 b26 b25 b24 b23 b22 b21 b20 b19 b18 b17 b16
+            b15 b14 b13 b12 b11 b10 b9 b8 b7 b6 b5 b4 b3 b2 b1 b0.
+           boolify32
+             (v2w
+                [b31; b30; b29; b28; b27; b26; b25; b24; b23; b22; b21;
+                 b20; b19; b18; b17; b16; b15; b14; b13; b12; b11; b10; b9;
+                 b8; b7; b6; b5; b4; b3; b2; b1; b0]) =
+           (b31,b30,b29,b28,b27,b26,b25,b24,b23,b22,b21,b20,b19,b18,b17,
+            b16,b15,b14,b13,b12,b11,b10,b9,b8,b7,b6,b5,b4,b3,b2,b1,b0)
+
+   [boolify32bitify32]  Theorem
+
+      |- ∀x. boolify32 (bitify32 x) = x
+
+   [conditionT2num_11]  Theorem
+
+      |- ∀a a'. (conditionT2num a = conditionT2num a') ⇔ (a = a')
+
+   [conditionT2num_ONTO]  Theorem
+
+      |- ∀r. r < 4 ⇔ ∃a. r = conditionT2num a
+
+   [conditionT2num_num2conditionT]  Theorem
+
+      |- ∀r. r < 4 ⇔ (conditionT2num (num2conditionT r) = r)
+
+   [conditionT2num_thm]  Theorem
+
+      |- (conditionT2num skipNever = 0) ∧ (conditionT2num skipNeg = 1) ∧
+         (conditionT2num skipZero = 2) ∧ (conditionT2num skipInRdy = 3)
+
+   [conditionT_Axiom]  Theorem
+
+      |- ∀x0 x1 x2 x3.
+           ∃f.
+             (f skipNever = x0) ∧ (f skipNeg = x1) ∧ (f skipZero = x2) ∧
+             (f skipInRdy = x3)
+
+   [conditionT_EQ_conditionT]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (conditionT2num a = conditionT2num a')
+
+   [conditionT_case_cong]  Theorem
+
+      |- ∀M M' v0 v1 v2 v3.
+           (M = M') ∧ ((M' = skipNever) ⇒ (v0 = v0')) ∧
+           ((M' = skipNeg) ⇒ (v1 = v1')) ∧ ((M' = skipZero) ⇒ (v2 = v2')) ∧
+           ((M' = skipInRdy) ⇒ (v3 = v3')) ⇒
+           ((case M of
+               skipNever => v0
+             | skipNeg => v1
+             | skipZero => v2
+             | skipInRdy => v3) =
+            case M' of
+              skipNever => v0'
+            | skipNeg => v1'
+            | skipZero => v2'
+            | skipInRdy => v3')
+
+   [conditionT_case_def]  Theorem
+
+      |- (∀v0 v1 v2 v3.
+            (case skipNever of
+               skipNever => v0
+             | skipNeg => v1
+             | skipZero => v2
+             | skipInRdy => v3) =
+            v0) ∧
+         (∀v0 v1 v2 v3.
+            (case skipNeg of
+               skipNever => v0
+             | skipNeg => v1
+             | skipZero => v2
+             | skipInRdy => v3) =
+            v1) ∧
+         (∀v0 v1 v2 v3.
+            (case skipZero of
+               skipNever => v0
+             | skipNeg => v1
+             | skipZero => v2
+             | skipInRdy => v3) =
+            v2) ∧
+         ∀v0 v1 v2 v3.
+           (case skipInRdy of
+              skipNever => v0
+            | skipNeg => v1
+            | skipZero => v2
+            | skipInRdy => v3) =
+           v3
+
+   [conditionT_distinct]  Theorem
+
+      |- skipNever ≠ skipNeg ∧ skipNever ≠ skipZero ∧
+         skipNever ≠ skipInRdy ∧ skipNeg ≠ skipZero ∧ skipNeg ≠ skipInRdy ∧
+         skipZero ≠ skipInRdy
+
+   [conditionT_induction]  Theorem
+
+      |- ∀P. P skipInRdy ∧ P skipNeg ∧ P skipNever ∧ P skipZero ⇒ ∀a. P a
+
+   [conditionT_nchotomy]  Theorem
+
+      |- ∀a.
+           (a = skipNever) ∨ (a = skipNeg) ∨ (a = skipZero) ∨
+           (a = skipInRdy)
+
+   [datatype_conditionT]  Theorem
+
+      |- DATATYPE (conditionT skipNever skipNeg skipZero skipInRdy)
+
+   [datatype_exception]  Theorem
+
+      |- DATATYPE (exception NoException Reserved)
+
+   [datatype_funcT]  Theorem
+
+      |- DATATYPE (funcT fADD fSUB fINC fDEC fAND fOR fXOR fReserved)
+
+   [datatype_instruction]  Theorem
+
+      |- DATATYPE
+           (instruction In Jump LoadConstant LoadDM Normal Out
+              ReservedInstr StoreDM StoreIM)
+
+   [datatype_shiftT]  Theorem
+
+      |- DATATYPE (shiftT noShift RCY1 RCY8 RCY16)
+
+   [datatype_tiny_state]  Theorem
+
+      |- DATATYPE
+           (record tiny_state DM IM InData InRdy OutStrobe PC R exception)
+
+   [exception2num_11]  Theorem
+
+      |- ∀a a'. (exception2num a = exception2num a') ⇔ (a = a')
+
+   [exception2num_ONTO]  Theorem
+
+      |- ∀r. r < 2 ⇔ ∃a. r = exception2num a
+
+   [exception2num_num2exception]  Theorem
+
+      |- ∀r. r < 2 ⇔ (exception2num (num2exception r) = r)
+
+   [exception2num_thm]  Theorem
+
+      |- (exception2num NoException = 0) ∧ (exception2num Reserved = 1)
+
+   [exception_Axiom]  Theorem
+
+      |- ∀x0 x1. ∃f. (f NoException = x0) ∧ (f Reserved = x1)
+
+   [exception_EQ_exception]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (exception2num a = exception2num a')
+
+   [exception_case_cong]  Theorem
+
+      |- ∀M M' v0 v1.
+           (M = M') ∧ ((M' = NoException) ⇒ (v0 = v0')) ∧
+           ((M' = Reserved) ⇒ (v1 = v1')) ⇒
+           ((case M of NoException => v0 | Reserved => v1) =
+            case M' of NoException => v0' | Reserved => v1')
+
+   [exception_case_def]  Theorem
+
+      |- (∀v0 v1.
+            (case NoException of NoException => v0 | Reserved => v1) =
+            v0) ∧
+         ∀v0 v1. (case Reserved of NoException => v0 | Reserved => v1) = v1
+
+   [exception_distinct]  Theorem
+
+      |- NoException ≠ Reserved
+
+   [exception_induction]  Theorem
+
+      |- ∀P. P NoException ∧ P Reserved ⇒ ∀a. P a
+
+   [exception_nchotomy]  Theorem
+
+      |- ∀a. (a = NoException) ∨ (a = Reserved)
+
+   [funcT2num_11]  Theorem
+
+      |- ∀a a'. (funcT2num a = funcT2num a') ⇔ (a = a')
+
+   [funcT2num_ONTO]  Theorem
+
+      |- ∀r. r < 8 ⇔ ∃a. r = funcT2num a
+
+   [funcT2num_num2funcT]  Theorem
+
+      |- ∀r. r < 8 ⇔ (funcT2num (num2funcT r) = r)
+
+   [funcT2num_thm]  Theorem
+
+      |- (funcT2num fADD = 0) ∧ (funcT2num fSUB = 1) ∧
+         (funcT2num fINC = 2) ∧ (funcT2num fDEC = 3) ∧
+         (funcT2num fAND = 4) ∧ (funcT2num fOR = 5) ∧
+         (funcT2num fXOR = 6) ∧ (funcT2num fReserved = 7)
+
+   [funcT_Axiom]  Theorem
+
+      |- ∀x0 x1 x2 x3 x4 x5 x6 x7.
+           ∃f.
+             (f fADD = x0) ∧ (f fSUB = x1) ∧ (f fINC = x2) ∧
+             (f fDEC = x3) ∧ (f fAND = x4) ∧ (f fOR = x5) ∧ (f fXOR = x6) ∧
+             (f fReserved = x7)
+
+   [funcT_EQ_funcT]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (funcT2num a = funcT2num a')
+
+   [funcT_case_cong]  Theorem
+
+      |- ∀M M' v0 v1 v2 v3 v4 v5 v6 v7.
+           (M = M') ∧ ((M' = fADD) ⇒ (v0 = v0')) ∧
+           ((M' = fSUB) ⇒ (v1 = v1')) ∧ ((M' = fINC) ⇒ (v2 = v2')) ∧
+           ((M' = fDEC) ⇒ (v3 = v3')) ∧ ((M' = fAND) ⇒ (v4 = v4')) ∧
+           ((M' = fOR) ⇒ (v5 = v5')) ∧ ((M' = fXOR) ⇒ (v6 = v6')) ∧
+           ((M' = fReserved) ⇒ (v7 = v7')) ⇒
+           ((case M of
+               fADD => v0
+             | fSUB => v1
+             | fINC => v2
+             | fDEC => v3
+             | fAND => v4
+             | fOR => v5
+             | fXOR => v6
+             | fReserved => v7) =
+            case M' of
+              fADD => v0'
+            | fSUB => v1'
+            | fINC => v2'
+            | fDEC => v3'
+            | fAND => v4'
+            | fOR => v5'
+            | fXOR => v6'
+            | fReserved => v7')
+
+   [funcT_case_def]  Theorem
+
+      |- (∀v0 v1 v2 v3 v4 v5 v6 v7.
+            (case fADD of
+               fADD => v0
+             | fSUB => v1
+             | fINC => v2
+             | fDEC => v3
+             | fAND => v4
+             | fOR => v5
+             | fXOR => v6
+             | fReserved => v7) =
+            v0) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7.
+            (case fSUB of
+               fADD => v0
+             | fSUB => v1
+             | fINC => v2
+             | fDEC => v3
+             | fAND => v4
+             | fOR => v5
+             | fXOR => v6
+             | fReserved => v7) =
+            v1) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7.
+            (case fINC of
+               fADD => v0
+             | fSUB => v1
+             | fINC => v2
+             | fDEC => v3
+             | fAND => v4
+             | fOR => v5
+             | fXOR => v6
+             | fReserved => v7) =
+            v2) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7.
+            (case fDEC of
+               fADD => v0
+             | fSUB => v1
+             | fINC => v2
+             | fDEC => v3
+             | fAND => v4
+             | fOR => v5
+             | fXOR => v6
+             | fReserved => v7) =
+            v3) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7.
+            (case fAND of
+               fADD => v0
+             | fSUB => v1
+             | fINC => v2
+             | fDEC => v3
+             | fAND => v4
+             | fOR => v5
+             | fXOR => v6
+             | fReserved => v7) =
+            v4) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7.
+            (case fOR of
+               fADD => v0
+             | fSUB => v1
+             | fINC => v2
+             | fDEC => v3
+             | fAND => v4
+             | fOR => v5
+             | fXOR => v6
+             | fReserved => v7) =
+            v5) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7.
+            (case fXOR of
+               fADD => v0
+             | fSUB => v1
+             | fINC => v2
+             | fDEC => v3
+             | fAND => v4
+             | fOR => v5
+             | fXOR => v6
+             | fReserved => v7) =
+            v6) ∧
+         ∀v0 v1 v2 v3 v4 v5 v6 v7.
+           (case fReserved of
+              fADD => v0
+            | fSUB => v1
+            | fINC => v2
+            | fDEC => v3
+            | fAND => v4
+            | fOR => v5
+            | fXOR => v6
+            | fReserved => v7) =
+           v7
+
+   [funcT_distinct]  Theorem
+
+      |- fADD ≠ fSUB ∧ fADD ≠ fINC ∧ fADD ≠ fDEC ∧ fADD ≠ fAND ∧
+         fADD ≠ fOR ∧ fADD ≠ fXOR ∧ fADD ≠ fReserved ∧ fSUB ≠ fINC ∧
+         fSUB ≠ fDEC ∧ fSUB ≠ fAND ∧ fSUB ≠ fOR ∧ fSUB ≠ fXOR ∧
+         fSUB ≠ fReserved ∧ fINC ≠ fDEC ∧ fINC ≠ fAND ∧ fINC ≠ fOR ∧
+         fINC ≠ fXOR ∧ fINC ≠ fReserved ∧ fDEC ≠ fAND ∧ fDEC ≠ fOR ∧
+         fDEC ≠ fXOR ∧ fDEC ≠ fReserved ∧ fAND ≠ fOR ∧ fAND ≠ fXOR ∧
+         fAND ≠ fReserved ∧ fOR ≠ fXOR ∧ fOR ≠ fReserved ∧ fXOR ≠ fReserved
+
+   [funcT_induction]  Theorem
+
+      |- ∀P.
+           P fADD ∧ P fAND ∧ P fDEC ∧ P fINC ∧ P fOR ∧ P fReserved ∧
+           P fSUB ∧ P fXOR ⇒
+           ∀a. P a
+
+   [funcT_nchotomy]  Theorem
+
+      |- ∀a.
+           (a = fADD) ∨ (a = fSUB) ∨ (a = fINC) ∨ (a = fDEC) ∨ (a = fAND) ∨
+           (a = fOR) ∨ (a = fXOR) ∨ (a = fReserved)
+
+   [instruction_11]  Theorem
+
+      |- (∀a a'. (In a = In a') ⇔ (a = a')) ∧
+         (∀a a'. (Jump a = Jump a') ⇔ (a = a')) ∧
+         (∀a a'. (LoadConstant a = LoadConstant a') ⇔ (a = a')) ∧
+         (∀a a'. (LoadDM a = LoadDM a') ⇔ (a = a')) ∧
+         (∀a a'. (Normal a = Normal a') ⇔ (a = a')) ∧
+         (∀a a'. (Out a = Out a') ⇔ (a = a')) ∧
+         (∀a a'. (StoreDM a = StoreDM a') ⇔ (a = a')) ∧
+         ∀a a'. (StoreIM a = StoreIM a') ⇔ (a = a')
+
+   [instruction_Axiom]  Theorem
+
+      |- ∀f0 f1 f2 f3 f4 f5 f6 f7 f8.
+           ∃fn.
+             (∀a. fn (In a) = f0 a) ∧ (∀a. fn (Jump a) = f1 a) ∧
+             (∀a. fn (LoadConstant a) = f2 a) ∧
+             (∀a. fn (LoadDM a) = f3 a) ∧ (∀a. fn (Normal a) = f4 a) ∧
+             (∀a. fn (Out a) = f5 a) ∧ (fn ReservedInstr = f6) ∧
+             (∀a. fn (StoreDM a) = f7 a) ∧ ∀a. fn (StoreIM a) = f8 a
+
+   [instruction_case_cong]  Theorem
+
+      |- ∀M M' f f1 f2 f3 f4 f5 v f6 f7.
+           (M = M') ∧ (∀a. (M' = In a) ⇒ (f a = f' a)) ∧
+           (∀a. (M' = Jump a) ⇒ (f1 a = f1' a)) ∧
+           (∀a. (M' = LoadConstant a) ⇒ (f2 a = f2' a)) ∧
+           (∀a. (M' = LoadDM a) ⇒ (f3 a = f3' a)) ∧
+           (∀a. (M' = Normal a) ⇒ (f4 a = f4' a)) ∧
+           (∀a. (M' = Out a) ⇒ (f5 a = f5' a)) ∧
+           ((M' = ReservedInstr) ⇒ (v = v')) ∧
+           (∀a. (M' = StoreDM a) ⇒ (f6 a = f6' a)) ∧
+           (∀a. (M' = StoreIM a) ⇒ (f7 a = f7' a)) ⇒
+           (instruction_CASE M f f1 f2 f3 f4 f5 v f6 f7 =
+            instruction_CASE M' f' f1' f2' f3' f4' f5' v' f6' f7')
+
+   [instruction_distinct]  Theorem
+
+      |- (∀a' a. In a ≠ Jump a') ∧ (∀a' a. In a ≠ LoadConstant a') ∧
+         (∀a' a. In a ≠ LoadDM a') ∧ (∀a' a. In a ≠ Normal a') ∧
+         (∀a' a. In a ≠ Out a') ∧ (∀a. In a ≠ ReservedInstr) ∧
+         (∀a' a. In a ≠ StoreDM a') ∧ (∀a' a. In a ≠ StoreIM a') ∧
+         (∀a' a. Jump a ≠ LoadConstant a') ∧ (∀a' a. Jump a ≠ LoadDM a') ∧
+         (∀a' a. Jump a ≠ Normal a') ∧ (∀a' a. Jump a ≠ Out a') ∧
+         (∀a. Jump a ≠ ReservedInstr) ∧ (∀a' a. Jump a ≠ StoreDM a') ∧
+         (∀a' a. Jump a ≠ StoreIM a') ∧
+         (∀a' a. LoadConstant a ≠ LoadDM a') ∧
+         (∀a' a. LoadConstant a ≠ Normal a') ∧
+         (∀a' a. LoadConstant a ≠ Out a') ∧
+         (∀a. LoadConstant a ≠ ReservedInstr) ∧
+         (∀a' a. LoadConstant a ≠ StoreDM a') ∧
+         (∀a' a. LoadConstant a ≠ StoreIM a') ∧
+         (∀a' a. LoadDM a ≠ Normal a') ∧ (∀a' a. LoadDM a ≠ Out a') ∧
+         (∀a. LoadDM a ≠ ReservedInstr) ∧ (∀a' a. LoadDM a ≠ StoreDM a') ∧
+         (∀a' a. LoadDM a ≠ StoreIM a') ∧ (∀a' a. Normal a ≠ Out a') ∧
+         (∀a. Normal a ≠ ReservedInstr) ∧ (∀a' a. Normal a ≠ StoreDM a') ∧
+         (∀a' a. Normal a ≠ StoreIM a') ∧ (∀a. Out a ≠ ReservedInstr) ∧
+         (∀a' a. Out a ≠ StoreDM a') ∧ (∀a' a. Out a ≠ StoreIM a') ∧
+         (∀a. ReservedInstr ≠ StoreDM a) ∧
+         (∀a. ReservedInstr ≠ StoreIM a) ∧ ∀a' a. StoreDM a ≠ StoreIM a'
+
+   [instruction_induction]  Theorem
+
+      |- ∀P.
+           (∀p. P (In p)) ∧ (∀p. P (Jump p)) ∧ (∀p. P (LoadConstant p)) ∧
+           (∀p. P (LoadDM p)) ∧ (∀p. P (Normal p)) ∧ (∀p. P (Out p)) ∧
+           P ReservedInstr ∧ (∀p. P (StoreDM p)) ∧ (∀p. P (StoreIM p)) ⇒
+           ∀i. P i
+
+   [instruction_nchotomy]  Theorem
+
+      |- ∀ii.
+           (∃p. ii = In p) ∨ (∃p. ii = Jump p) ∨
+           (∃p. ii = LoadConstant p) ∨ (∃p. ii = LoadDM p) ∨
+           (∃p. ii = Normal p) ∨ (∃p. ii = Out p) ∨ (ii = ReservedInstr) ∨
+           (∃p. ii = StoreDM p) ∨ ∃p. ii = StoreIM p
+
+   [num2conditionT_11]  Theorem
+
+      |- ∀r r'.
+           r < 4 ⇒
+           r' < 4 ⇒
+           ((num2conditionT r = num2conditionT r') ⇔ (r = r'))
+
+   [num2conditionT_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2conditionT r) ∧ r < 4
+
+   [num2conditionT_conditionT2num]  Theorem
+
+      |- ∀a. num2conditionT (conditionT2num a) = a
+
+   [num2conditionT_thm]  Theorem
+
+      |- (num2conditionT 0 = skipNever) ∧ (num2conditionT 1 = skipNeg) ∧
+         (num2conditionT 2 = skipZero) ∧ (num2conditionT 3 = skipInRdy)
+
+   [num2exception_11]  Theorem
+
+      |- ∀r r'.
+           r < 2 ⇒
+           r' < 2 ⇒
+           ((num2exception r = num2exception r') ⇔ (r = r'))
+
+   [num2exception_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2exception r) ∧ r < 2
+
+   [num2exception_exception2num]  Theorem
+
+      |- ∀a. num2exception (exception2num a) = a
+
+   [num2exception_thm]  Theorem
+
+      |- (num2exception 0 = NoException) ∧ (num2exception 1 = Reserved)
+
+   [num2funcT_11]  Theorem
+
+      |- ∀r r'. r < 8 ⇒ r' < 8 ⇒ ((num2funcT r = num2funcT r') ⇔ (r = r'))
+
+   [num2funcT_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2funcT r) ∧ r < 8
+
+   [num2funcT_funcT2num]  Theorem
+
+      |- ∀a. num2funcT (funcT2num a) = a
+
+   [num2funcT_thm]  Theorem
+
+      |- (num2funcT 0 = fADD) ∧ (num2funcT 1 = fSUB) ∧
+         (num2funcT 2 = fINC) ∧ (num2funcT 3 = fDEC) ∧
+         (num2funcT 4 = fAND) ∧ (num2funcT 5 = fOR) ∧
+         (num2funcT 6 = fXOR) ∧ (num2funcT 7 = fReserved)
+
+   [num2shiftT_11]  Theorem
+
+      |- ∀r r'.
+           r < 4 ⇒ r' < 4 ⇒ ((num2shiftT r = num2shiftT r') ⇔ (r = r'))
+
+   [num2shiftT_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2shiftT r) ∧ r < 4
+
+   [num2shiftT_shiftT2num]  Theorem
+
+      |- ∀a. num2shiftT (shiftT2num a) = a
+
+   [num2shiftT_thm]  Theorem
+
+      |- (num2shiftT 0 = noShift) ∧ (num2shiftT 1 = RCY1) ∧
+         (num2shiftT 2 = RCY8) ∧ (num2shiftT 3 = RCY16)
+
+   [shiftT2num_11]  Theorem
+
+      |- ∀a a'. (shiftT2num a = shiftT2num a') ⇔ (a = a')
+
+   [shiftT2num_ONTO]  Theorem
+
+      |- ∀r. r < 4 ⇔ ∃a. r = shiftT2num a
+
+   [shiftT2num_num2shiftT]  Theorem
+
+      |- ∀r. r < 4 ⇔ (shiftT2num (num2shiftT r) = r)
+
+   [shiftT2num_thm]  Theorem
+
+      |- (shiftT2num noShift = 0) ∧ (shiftT2num RCY1 = 1) ∧
+         (shiftT2num RCY8 = 2) ∧ (shiftT2num RCY16 = 3)
+
+   [shiftT_Axiom]  Theorem
+
+      |- ∀x0 x1 x2 x3.
+           ∃f.
+             (f noShift = x0) ∧ (f RCY1 = x1) ∧ (f RCY8 = x2) ∧
+             (f RCY16 = x3)
+
+   [shiftT_EQ_shiftT]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (shiftT2num a = shiftT2num a')
+
+   [shiftT_case_cong]  Theorem
+
+      |- ∀M M' v0 v1 v2 v3.
+           (M = M') ∧ ((M' = noShift) ⇒ (v0 = v0')) ∧
+           ((M' = RCY1) ⇒ (v1 = v1')) ∧ ((M' = RCY8) ⇒ (v2 = v2')) ∧
+           ((M' = RCY16) ⇒ (v3 = v3')) ⇒
+           ((case M of
+               noShift => v0
+             | RCY1 => v1
+             | RCY8 => v2
+             | RCY16 => v3) =
+            case M' of
+              noShift => v0'
+            | RCY1 => v1'
+            | RCY8 => v2'
+            | RCY16 => v3')
+
+   [shiftT_case_def]  Theorem
+
+      |- (∀v0 v1 v2 v3.
+            (case noShift of
+               noShift => v0
+             | RCY1 => v1
+             | RCY8 => v2
+             | RCY16 => v3) =
+            v0) ∧
+         (∀v0 v1 v2 v3.
+            (case RCY1 of
+               noShift => v0
+             | RCY1 => v1
+             | RCY8 => v2
+             | RCY16 => v3) =
+            v1) ∧
+         (∀v0 v1 v2 v3.
+            (case RCY8 of
+               noShift => v0
+             | RCY1 => v1
+             | RCY8 => v2
+             | RCY16 => v3) =
+            v2) ∧
+         ∀v0 v1 v2 v3.
+           (case RCY16 of
+              noShift => v0
+            | RCY1 => v1
+            | RCY8 => v2
+            | RCY16 => v3) =
+           v3
+
+   [shiftT_distinct]  Theorem
+
+      |- noShift ≠ RCY1 ∧ noShift ≠ RCY8 ∧ noShift ≠ RCY16 ∧ RCY1 ≠ RCY8 ∧
+         RCY1 ≠ RCY16 ∧ RCY8 ≠ RCY16
+
+   [shiftT_induction]  Theorem
+
+      |- ∀P. P RCY1 ∧ P RCY16 ∧ P RCY8 ∧ P noShift ⇒ ∀a. P a
+
+   [shiftT_nchotomy]  Theorem
+
+      |- ∀a. (a = noShift) ∨ (a = RCY1) ∨ (a = RCY8) ∨ (a = RCY16)
+
+   [tiny_state_11]  Theorem
+
+      |- ∀a0 a1 a2 a3 a4 a5 a6 a7 a0' a1' a2' a3' a4' a5' a6' a7'.
+           (tiny_state a0 a1 a2 a3 a4 a5 a6 a7 =
+            tiny_state a0' a1' a2' a3' a4' a5' a6' a7') ⇔
+           (a0 = a0') ∧ (a1 = a1') ∧ (a2 = a2') ∧ (a3 ⇔ a3') ∧ (a4 = a4') ∧
+           (a5 = a5') ∧ (a6 = a6') ∧ (a7 = a7')
+
+   [tiny_state_Axiom]  Theorem
+
+      |- ∀f.
+           ∃fn.
+             ∀a0 a1 a2 a3 a4 a5 a6 a7.
+               fn (tiny_state a0 a1 a2 a3 a4 a5 a6 a7) =
+               f a0 a1 a2 a3 a4 a5 a6 a7
+
+   [tiny_state_accessors]  Theorem
+
+      |- (∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).DM = f) ∧
+         (∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).IM = f0) ∧
+         (∀f f0 c b c0 c1 f1 e.
+            (tiny_state f f0 c b c0 c1 f1 e).InData = c) ∧
+         (∀f f0 c b c0 c1 f1 e.
+            (tiny_state f f0 c b c0 c1 f1 e).InRdy ⇔ b) ∧
+         (∀f f0 c b c0 c1 f1 e.
+            (tiny_state f f0 c b c0 c1 f1 e).OutStrobe = c0) ∧
+         (∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).PC = c1) ∧
+         (∀f f0 c b c0 c1 f1 e. (tiny_state f f0 c b c0 c1 f1 e).R = f1) ∧
+         ∀f f0 c b c0 c1 f1 e.
+           (tiny_state f f0 c b c0 c1 f1 e).exception = e
+
+   [tiny_state_accfupds]  Theorem
+
+      |- (∀t f. (t with IM updated_by f).DM = t.DM) ∧
+         (∀t f. (t with InData updated_by f).DM = t.DM) ∧
+         (∀t f. (t with InRdy updated_by f).DM = t.DM) ∧
+         (∀t f. (t with OutStrobe updated_by f).DM = t.DM) ∧
+         (∀t f. (t with PC updated_by f).DM = t.DM) ∧
+         (∀t f. (t with R updated_by f).DM = t.DM) ∧
+         (∀t f. (t with exception updated_by f).DM = t.DM) ∧
+         (∀t f. (t with DM updated_by f).IM = t.IM) ∧
+         (∀t f. (t with InData updated_by f).IM = t.IM) ∧
+         (∀t f. (t with InRdy updated_by f).IM = t.IM) ∧
+         (∀t f. (t with OutStrobe updated_by f).IM = t.IM) ∧
+         (∀t f. (t with PC updated_by f).IM = t.IM) ∧
+         (∀t f. (t with R updated_by f).IM = t.IM) ∧
+         (∀t f. (t with exception updated_by f).IM = t.IM) ∧
+         (∀t f. (t with DM updated_by f).InData = t.InData) ∧
+         (∀t f. (t with IM updated_by f).InData = t.InData) ∧
+         (∀t f. (t with InRdy updated_by f).InData = t.InData) ∧
+         (∀t f. (t with OutStrobe updated_by f).InData = t.InData) ∧
+         (∀t f. (t with PC updated_by f).InData = t.InData) ∧
+         (∀t f. (t with R updated_by f).InData = t.InData) ∧
+         (∀t f. (t with exception updated_by f).InData = t.InData) ∧
+         (∀t f. (t with DM updated_by f).InRdy ⇔ t.InRdy) ∧
+         (∀t f. (t with IM updated_by f).InRdy ⇔ t.InRdy) ∧
+         (∀t f. (t with InData updated_by f).InRdy ⇔ t.InRdy) ∧
+         (∀t f. (t with OutStrobe updated_by f).InRdy ⇔ t.InRdy) ∧
+         (∀t f. (t with PC updated_by f).InRdy ⇔ t.InRdy) ∧
+         (∀t f. (t with R updated_by f).InRdy ⇔ t.InRdy) ∧
+         (∀t f. (t with exception updated_by f).InRdy ⇔ t.InRdy) ∧
+         (∀t f. (t with DM updated_by f).OutStrobe = t.OutStrobe) ∧
+         (∀t f. (t with IM updated_by f).OutStrobe = t.OutStrobe) ∧
+         (∀t f. (t with InData updated_by f).OutStrobe = t.OutStrobe) ∧
+         (∀t f. (t with InRdy updated_by f).OutStrobe = t.OutStrobe) ∧
+         (∀t f. (t with PC updated_by f).OutStrobe = t.OutStrobe) ∧
+         (∀t f. (t with R updated_by f).OutStrobe = t.OutStrobe) ∧
+         (∀t f. (t with exception updated_by f).OutStrobe = t.OutStrobe) ∧
+         (∀t f. (t with DM updated_by f).PC = t.PC) ∧
+         (∀t f. (t with IM updated_by f).PC = t.PC) ∧
+         (∀t f. (t with InData updated_by f).PC = t.PC) ∧
+         (∀t f. (t with InRdy updated_by f).PC = t.PC) ∧
+         (∀t f. (t with OutStrobe updated_by f).PC = t.PC) ∧
+         (∀t f. (t with R updated_by f).PC = t.PC) ∧
+         (∀t f. (t with exception updated_by f).PC = t.PC) ∧
+         (∀t f. (t with DM updated_by f).R = t.R) ∧
+         (∀t f. (t with IM updated_by f).R = t.R) ∧
+         (∀t f. (t with InData updated_by f).R = t.R) ∧
+         (∀t f. (t with InRdy updated_by f).R = t.R) ∧
+         (∀t f. (t with OutStrobe updated_by f).R = t.R) ∧
+         (∀t f. (t with PC updated_by f).R = t.R) ∧
+         (∀t f. (t with exception updated_by f).R = t.R) ∧
+         (∀t f. (t with DM updated_by f).exception = t.exception) ∧
+         (∀t f. (t with IM updated_by f).exception = t.exception) ∧
+         (∀t f. (t with InData updated_by f).exception = t.exception) ∧
+         (∀t f. (t with InRdy updated_by f).exception = t.exception) ∧
+         (∀t f. (t with OutStrobe updated_by f).exception = t.exception) ∧
+         (∀t f. (t with PC updated_by f).exception = t.exception) ∧
+         (∀t f. (t with R updated_by f).exception = t.exception) ∧
+         (∀t f. (t with DM updated_by f).DM = f t.DM) ∧
+         (∀t f. (t with IM updated_by f).IM = f t.IM) ∧
+         (∀t f. (t with InData updated_by f).InData = f t.InData) ∧
+         (∀t f. (t with InRdy updated_by f).InRdy ⇔ f t.InRdy) ∧
+         (∀t f.
+            (t with OutStrobe updated_by f).OutStrobe = f t.OutStrobe) ∧
+         (∀t f. (t with PC updated_by f).PC = f t.PC) ∧
+         (∀t f. (t with R updated_by f).R = f t.R) ∧
+         ∀t f. (t with exception updated_by f).exception = f t.exception
+
+   [tiny_state_case_cong]  Theorem
+
+      |- ∀M M' f.
+           (M = M') ∧
+           (∀a0 a1 a2 a3 a4 a5 a6 a7.
+              (M' = tiny_state a0 a1 a2 a3 a4 a5 a6 a7) ⇒
+              (f a0 a1 a2 a3 a4 a5 a6 a7 = f' a0 a1 a2 a3 a4 a5 a6 a7)) ⇒
+           (tiny_state_CASE M f = tiny_state_CASE M' f')
+
+   [tiny_state_component_equality]  Theorem
+
+      |- ∀t1 t2.
+           (t1 = t2) ⇔
+           (t1.DM = t2.DM) ∧ (t1.IM = t2.IM) ∧ (t1.InData = t2.InData) ∧
+           (t1.InRdy ⇔ t2.InRdy) ∧ (t1.OutStrobe = t2.OutStrobe) ∧
+           (t1.PC = t2.PC) ∧ (t1.R = t2.R) ∧ (t1.exception = t2.exception)
+
+   [tiny_state_fn_updates]  Theorem
+
+      |- (∀f2 f f0 c b c0 c1 f1 e.
+            tiny_state f f0 c b c0 c1 f1 e with DM updated_by f2 =
+            tiny_state (f2 f) f0 c b c0 c1 f1 e) ∧
+         (∀f2 f f0 c b c0 c1 f1 e.
+            tiny_state f f0 c b c0 c1 f1 e with IM updated_by f2 =
+            tiny_state f (f2 f0) c b c0 c1 f1 e) ∧
+         (∀f2 f f0 c b c0 c1 f1 e.
+            tiny_state f f0 c b c0 c1 f1 e with InData updated_by f2 =
+            tiny_state f f0 (f2 c) b c0 c1 f1 e) ∧
+         (∀f2 f f0 c b c0 c1 f1 e.
+            tiny_state f f0 c b c0 c1 f1 e with InRdy updated_by f2 =
+            tiny_state f f0 c (f2 b) c0 c1 f1 e) ∧
+         (∀f2 f f0 c b c0 c1 f1 e.
+            tiny_state f f0 c b c0 c1 f1 e with OutStrobe updated_by f2 =
+            tiny_state f f0 c b (f2 c0) c1 f1 e) ∧
+         (∀f2 f f0 c b c0 c1 f1 e.
+            tiny_state f f0 c b c0 c1 f1 e with PC updated_by f2 =
+            tiny_state f f0 c b c0 (f2 c1) f1 e) ∧
+         (∀f2 f f0 c b c0 c1 f1 e.
+            tiny_state f f0 c b c0 c1 f1 e with R updated_by f2 =
+            tiny_state f f0 c b c0 c1 (f2 f1) e) ∧
+         ∀f2 f f0 c b c0 c1 f1 e.
+           tiny_state f f0 c b c0 c1 f1 e with exception updated_by f2 =
+           tiny_state f f0 c b c0 c1 f1 (f2 e)
+
+   [tiny_state_fupdcanon]  Theorem
+
+      |- (∀t g f.
+            t with <|IM updated_by f; DM updated_by g|> =
+            t with <|DM updated_by g; IM updated_by f|>) ∧
+         (∀t g f.
+            t with <|InData updated_by f; DM updated_by g|> =
+            t with <|DM updated_by g; InData updated_by f|>) ∧
+         (∀t g f.
+            t with <|InData updated_by f; IM updated_by g|> =
+            t with <|IM updated_by g; InData updated_by f|>) ∧
+         (∀t g f.
+            t with <|InRdy updated_by f; DM updated_by g|> =
+            t with <|DM updated_by g; InRdy updated_by f|>) ∧
+         (∀t g f.
+            t with <|InRdy updated_by f; IM updated_by g|> =
+            t with <|IM updated_by g; InRdy updated_by f|>) ∧
+         (∀t g f.
+            t with <|InRdy updated_by f; InData updated_by g|> =
+            t with <|InData updated_by g; InRdy updated_by f|>) ∧
+         (∀t g f.
+            t with <|OutStrobe updated_by f; DM updated_by g|> =
+            t with <|DM updated_by g; OutStrobe updated_by f|>) ∧
+         (∀t g f.
+            t with <|OutStrobe updated_by f; IM updated_by g|> =
+            t with <|IM updated_by g; OutStrobe updated_by f|>) ∧
+         (∀t g f.
+            t with <|OutStrobe updated_by f; InData updated_by g|> =
+            t with <|InData updated_by g; OutStrobe updated_by f|>) ∧
+         (∀t g f.
+            t with <|OutStrobe updated_by f; InRdy updated_by g|> =
+            t with <|InRdy updated_by g; OutStrobe updated_by f|>) ∧
+         (∀t g f.
+            t with <|PC updated_by f; DM updated_by g|> =
+            t with <|DM updated_by g; PC updated_by f|>) ∧
+         (∀t g f.
+            t with <|PC updated_by f; IM updated_by g|> =
+            t with <|IM updated_by g; PC updated_by f|>) ∧
+         (∀t g f.
+            t with <|PC updated_by f; InData updated_by g|> =
+            t with <|InData updated_by g; PC updated_by f|>) ∧
+         (∀t g f.
+            t with <|PC updated_by f; InRdy updated_by g|> =
+            t with <|InRdy updated_by g; PC updated_by f|>) ∧
+         (∀t g f.
+            t with <|PC updated_by f; OutStrobe updated_by g|> =
+            t with <|OutStrobe updated_by g; PC updated_by f|>) ∧
+         (∀t g f.
+            t with <|R updated_by f; DM updated_by g|> =
+            t with <|DM updated_by g; R updated_by f|>) ∧
+         (∀t g f.
+            t with <|R updated_by f; IM updated_by g|> =
+            t with <|IM updated_by g; R updated_by f|>) ∧
+         (∀t g f.
+            t with <|R updated_by f; InData updated_by g|> =
+            t with <|InData updated_by g; R updated_by f|>) ∧
+         (∀t g f.
+            t with <|R updated_by f; InRdy updated_by g|> =
+            t with <|InRdy updated_by g; R updated_by f|>) ∧
+         (∀t g f.
+            t with <|R updated_by f; OutStrobe updated_by g|> =
+            t with <|OutStrobe updated_by g; R updated_by f|>) ∧
+         (∀t g f.
+            t with <|R updated_by f; PC updated_by g|> =
+            t with <|PC updated_by g; R updated_by f|>) ∧
+         (∀t g f.
+            t with <|exception updated_by f; DM updated_by g|> =
+            t with <|DM updated_by g; exception updated_by f|>) ∧
+         (∀t g f.
+            t with <|exception updated_by f; IM updated_by g|> =
+            t with <|IM updated_by g; exception updated_by f|>) ∧
+         (∀t g f.
+            t with <|exception updated_by f; InData updated_by g|> =
+            t with <|InData updated_by g; exception updated_by f|>) ∧
+         (∀t g f.
+            t with <|exception updated_by f; InRdy updated_by g|> =
+            t with <|InRdy updated_by g; exception updated_by f|>) ∧
+         (∀t g f.
+            t with <|exception updated_by f; OutStrobe updated_by g|> =
+            t with <|OutStrobe updated_by g; exception updated_by f|>) ∧
+         (∀t g f.
+            t with <|exception updated_by f; PC updated_by g|> =
+            t with <|PC updated_by g; exception updated_by f|>) ∧
+         ∀t g f.
+           t with <|exception updated_by f; R updated_by g|> =
+           t with <|R updated_by g; exception updated_by f|>
+
+   [tiny_state_fupdcanon_comp]  Theorem
+
+      |- ((∀g f.
+              _ record fupdateIM f o  _ record fupdateDM g =
+              _ record fupdateDM g o  _ record fupdateIM f) ∧
+          ∀h g f.
+             _ record fupdateIM f o  _ record fupdateDM g o h =
+             _ record fupdateDM g o  _ record fupdateIM f o h) ∧
+         ((∀g f.
+              _ record fupdateInData f o  _ record fupdateDM g =
+              _ record fupdateDM g o  _ record fupdateInData f) ∧
+          ∀h g f.
+             _ record fupdateInData f o  _ record fupdateDM g o h =
+             _ record fupdateDM g o  _ record fupdateInData f o h) ∧
+         ((∀g f.
+              _ record fupdateInData f o  _ record fupdateIM g =
+              _ record fupdateIM g o  _ record fupdateInData f) ∧
+          ∀h g f.
+             _ record fupdateInData f o  _ record fupdateIM g o h =
+             _ record fupdateIM g o  _ record fupdateInData f o h) ∧
+         ((∀g f.
+              _ record fupdateInRdy f o  _ record fupdateDM g =
+              _ record fupdateDM g o  _ record fupdateInRdy f) ∧
+          ∀h g f.
+             _ record fupdateInRdy f o  _ record fupdateDM g o h =
+             _ record fupdateDM g o  _ record fupdateInRdy f o h) ∧
+         ((∀g f.
+              _ record fupdateInRdy f o  _ record fupdateIM g =
+              _ record fupdateIM g o  _ record fupdateInRdy f) ∧
+          ∀h g f.
+             _ record fupdateInRdy f o  _ record fupdateIM g o h =
+             _ record fupdateIM g o  _ record fupdateInRdy f o h) ∧
+         ((∀g f.
+              _ record fupdateInRdy f o  _ record fupdateInData g =
+              _ record fupdateInData g o  _ record fupdateInRdy f) ∧
+          ∀h g f.
+             _ record fupdateInRdy f o  _ record fupdateInData g o h =
+             _ record fupdateInData g o  _ record fupdateInRdy f o h) ∧
+         ((∀g f.
+              _ record fupdateOutStrobe f o  _ record fupdateDM g =
+              _ record fupdateDM g o  _ record fupdateOutStrobe f) ∧
+          ∀h g f.
+             _ record fupdateOutStrobe f o  _ record fupdateDM g o h =
+             _ record fupdateDM g o  _ record fupdateOutStrobe f o h) ∧
+         ((∀g f.
+              _ record fupdateOutStrobe f o  _ record fupdateIM g =
+              _ record fupdateIM g o  _ record fupdateOutStrobe f) ∧
+          ∀h g f.
+             _ record fupdateOutStrobe f o  _ record fupdateIM g o h =
+             _ record fupdateIM g o  _ record fupdateOutStrobe f o h) ∧
+         ((∀g f.
+              _ record fupdateOutStrobe f o  _ record fupdateInData g =
+              _ record fupdateInData g o  _ record fupdateOutStrobe f) ∧
+          ∀h g f.
+             _ record fupdateOutStrobe f o  _ record fupdateInData g o h =
+             _ record fupdateInData g o  _ record fupdateOutStrobe f o h) ∧
+         ((∀g f.
+              _ record fupdateOutStrobe f o  _ record fupdateInRdy g =
+              _ record fupdateInRdy g o  _ record fupdateOutStrobe f) ∧
+          ∀h g f.
+             _ record fupdateOutStrobe f o  _ record fupdateInRdy g o h =
+             _ record fupdateInRdy g o  _ record fupdateOutStrobe f o h) ∧
+         ((∀g f.
+              _ record fupdatePC f o  _ record fupdateDM g =
+              _ record fupdateDM g o  _ record fupdatePC f) ∧
+          ∀h g f.
+             _ record fupdatePC f o  _ record fupdateDM g o h =
+             _ record fupdateDM g o  _ record fupdatePC f o h) ∧
+         ((∀g f.
+              _ record fupdatePC f o  _ record fupdateIM g =
+              _ record fupdateIM g o  _ record fupdatePC f) ∧
+          ∀h g f.
+             _ record fupdatePC f o  _ record fupdateIM g o h =
+             _ record fupdateIM g o  _ record fupdatePC f o h) ∧
+         ((∀g f.
+              _ record fupdatePC f o  _ record fupdateInData g =
+              _ record fupdateInData g o  _ record fupdatePC f) ∧
+          ∀h g f.
+             _ record fupdatePC f o  _ record fupdateInData g o h =
+             _ record fupdateInData g o  _ record fupdatePC f o h) ∧
+         ((∀g f.
+              _ record fupdatePC f o  _ record fupdateInRdy g =
+              _ record fupdateInRdy g o  _ record fupdatePC f) ∧
+          ∀h g f.
+             _ record fupdatePC f o  _ record fupdateInRdy g o h =
+             _ record fupdateInRdy g o  _ record fupdatePC f o h) ∧
+         ((∀g f.
+              _ record fupdatePC f o  _ record fupdateOutStrobe g =
+              _ record fupdateOutStrobe g o  _ record fupdatePC f) ∧
+          ∀h g f.
+             _ record fupdatePC f o  _ record fupdateOutStrobe g o h =
+             _ record fupdateOutStrobe g o  _ record fupdatePC f o h) ∧
+         ((∀g f.
+              _ record fupdateR f o  _ record fupdateDM g =
+              _ record fupdateDM g o  _ record fupdateR f) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdateDM g o h =
+             _ record fupdateDM g o  _ record fupdateR f o h) ∧
+         ((∀g f.
+              _ record fupdateR f o  _ record fupdateIM g =
+              _ record fupdateIM g o  _ record fupdateR f) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdateIM g o h =
+             _ record fupdateIM g o  _ record fupdateR f o h) ∧
+         ((∀g f.
+              _ record fupdateR f o  _ record fupdateInData g =
+              _ record fupdateInData g o  _ record fupdateR f) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdateInData g o h =
+             _ record fupdateInData g o  _ record fupdateR f o h) ∧
+         ((∀g f.
+              _ record fupdateR f o  _ record fupdateInRdy g =
+              _ record fupdateInRdy g o  _ record fupdateR f) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdateInRdy g o h =
+             _ record fupdateInRdy g o  _ record fupdateR f o h) ∧
+         ((∀g f.
+              _ record fupdateR f o  _ record fupdateOutStrobe g =
+              _ record fupdateOutStrobe g o  _ record fupdateR f) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdateOutStrobe g o h =
+             _ record fupdateOutStrobe g o  _ record fupdateR f o h) ∧
+         ((∀g f.
+              _ record fupdateR f o  _ record fupdatePC g =
+              _ record fupdatePC g o  _ record fupdateR f) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdatePC g o h =
+             _ record fupdatePC g o  _ record fupdateR f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateDM g =
+              _ record fupdateDM g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateDM g o h =
+             _ record fupdateDM g o  _ record fupdateexception f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateIM g =
+              _ record fupdateIM g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateIM g o h =
+             _ record fupdateIM g o  _ record fupdateexception f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateInData g =
+              _ record fupdateInData g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateInData g o h =
+             _ record fupdateInData g o  _ record fupdateexception f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateInRdy g =
+              _ record fupdateInRdy g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateInRdy g o h =
+             _ record fupdateInRdy g o  _ record fupdateexception f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateOutStrobe g =
+              _ record fupdateOutStrobe g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateOutStrobe g o
+            h =
+             _ record fupdateOutStrobe g o  _ record fupdateexception f o
+            h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdatePC g =
+              _ record fupdatePC g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdatePC g o h =
+             _ record fupdatePC g o  _ record fupdateexception f o h) ∧
+         (∀g f.
+             _ record fupdateexception f o  _ record fupdateR g =
+             _ record fupdateR g o  _ record fupdateexception f) ∧
+         ∀h g f.
+            _ record fupdateexception f o  _ record fupdateR g o h =
+            _ record fupdateR g o  _ record fupdateexception f o h
+
+   [tiny_state_fupdfupds]  Theorem
+
+      |- (∀t g f.
+            t with <|DM updated_by f; DM updated_by g|> =
+            t with DM updated_by f o g) ∧
+         (∀t g f.
+            t with <|IM updated_by f; IM updated_by g|> =
+            t with IM updated_by f o g) ∧
+         (∀t g f.
+            t with <|InData updated_by f; InData updated_by g|> =
+            t with InData updated_by f o g) ∧
+         (∀t g f.
+            t with <|InRdy updated_by f; InRdy updated_by g|> =
+            t with InRdy updated_by f o g) ∧
+         (∀t g f.
+            t with <|OutStrobe updated_by f; OutStrobe updated_by g|> =
+            t with OutStrobe updated_by f o g) ∧
+         (∀t g f.
+            t with <|PC updated_by f; PC updated_by g|> =
+            t with PC updated_by f o g) ∧
+         (∀t g f.
+            t with <|R updated_by f; R updated_by g|> =
+            t with R updated_by f o g) ∧
+         ∀t g f.
+           t with <|exception updated_by f; exception updated_by g|> =
+           t with exception updated_by f o g
+
+   [tiny_state_fupdfupds_comp]  Theorem
+
+      |- ((∀g f.
+              _ record fupdateDM f o  _ record fupdateDM g =
+              _ record fupdateDM (f o g)) ∧
+          ∀h g f.
+             _ record fupdateDM f o  _ record fupdateDM g o h =
+             _ record fupdateDM (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateIM f o  _ record fupdateIM g =
+              _ record fupdateIM (f o g)) ∧
+          ∀h g f.
+             _ record fupdateIM f o  _ record fupdateIM g o h =
+             _ record fupdateIM (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateInData f o  _ record fupdateInData g =
+              _ record fupdateInData (f o g)) ∧
+          ∀h g f.
+             _ record fupdateInData f o  _ record fupdateInData g o h =
+             _ record fupdateInData (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateInRdy f o  _ record fupdateInRdy g =
+              _ record fupdateInRdy (f o g)) ∧
+          ∀h g f.
+             _ record fupdateInRdy f o  _ record fupdateInRdy g o h =
+             _ record fupdateInRdy (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateOutStrobe f o  _ record fupdateOutStrobe g =
+              _ record fupdateOutStrobe (f o g)) ∧
+          ∀h g f.
+             _ record fupdateOutStrobe f o  _ record fupdateOutStrobe g o
+            h =
+             _ record fupdateOutStrobe (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdatePC f o  _ record fupdatePC g =
+              _ record fupdatePC (f o g)) ∧
+          ∀h g f.
+             _ record fupdatePC f o  _ record fupdatePC g o h =
+             _ record fupdatePC (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateR f o  _ record fupdateR g =
+              _ record fupdateR (f o g)) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdateR g o h =
+             _ record fupdateR (f o g) o h) ∧
+         (∀g f.
+             _ record fupdateexception f o  _ record fupdateexception g =
+             _ record fupdateexception (f o g)) ∧
+         ∀h g f.
+            _ record fupdateexception f o  _ record fupdateexception g o
+           h =
+            _ record fupdateexception (f o g) o h
+
+   [tiny_state_induction]  Theorem
+
+      |- ∀P.
+           (∀f f0 c b c0 c1 f1 e. P (tiny_state f f0 c b c0 c1 f1 e)) ⇒
+           ∀t. P t
+
+   [tiny_state_literal_11]  Theorem
+
+      |- ∀f11 f01 c11 b1 c01 c1 f1 e1 f12 f02 c12 b2 c02 c2 f2 e2.
+           (<|DM := f11; IM := f01; InData := c11; InRdy := b1;
+              OutStrobe := c01; PC := c1; R := f1; exception := e1|> =
+            <|DM := f12; IM := f02; InData := c12; InRdy := b2;
+              OutStrobe := c02; PC := c2; R := f2; exception := e2|>) ⇔
+           (f11 = f12) ∧ (f01 = f02) ∧ (c11 = c12) ∧ (b1 ⇔ b2) ∧
+           (c01 = c02) ∧ (c1 = c2) ∧ (f1 = f2) ∧ (e1 = e2)
+
+   [tiny_state_literal_nchotomy]  Theorem
+
+      |- ∀t.
+           ∃f1 f0 c1 b c0 c f e.
+             t =
+             <|DM := f1; IM := f0; InData := c1; InRdy := b;
+               OutStrobe := c0; PC := c; R := f; exception := e|>
+
+   [tiny_state_nchotomy]  Theorem
+
+      |- ∀tt. ∃f f0 c b c0 c1 f1 e. tt = tiny_state f f0 c b c0 c1 f1 e
+
+   [tiny_state_updates_eq_literal]  Theorem
+
+      |- ∀t f1 f0 c1 b c0 c f e.
+           t with
+           <|DM := f1; IM := f0; InData := c1; InRdy := b; OutStrobe := c0;
+             PC := c; R := f; exception := e|> =
+           <|DM := f1; IM := f0; InData := c1; InRdy := b; OutStrobe := c0;
+             PC := c; R := f; exception := e|>
+
+
+*)
+end
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/thacker/unversioned-files-extra.txt acl2-6.3/books/translators/l3-to-acl2/examples/thacker/unversioned-files-extra.txt
--- acl2-6.2/books/translators/l3-to-acl2/examples/thacker/unversioned-files-extra.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/thacker/unversioned-files-extra.txt	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,3 @@
+tiny-logic.lisp
+tiny.lisp
+run-check.txt
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/x86-64/README acl2-6.3/books/translators/l3-to-acl2/examples/x86-64/README
--- acl2-6.2/books/translators/l3-to-acl2/examples/x86-64/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/x86-64/README	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,2 @@
+This directory contains an example from Anthony Fox that can not
+yet be run through the translator from L3 to ACL2.
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/x86-64/x64-acl2.txt acl2-6.3/books/translators/l3-to-acl2/examples/x86-64/x64-acl2.txt
--- acl2-6.2/books/translators/l3-to-acl2/examples/x86-64/x64-acl2.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/x86-64/x64-acl2.txt	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,4760 @@
+(val _ = Construct
+  (sqbkt ("Zreg"
+           (sqbkt ("RAX" []) ("RCX" []) ("RDX" []) ("RBX" []) ("RSP" [])
+                  ("RBP" []) ("RSI" []) ("RDI" []) ("zR8" []) ("zR9" [])
+                  ("zR10" []) ("zR11" []) ("zR12" []) ("zR13" [])
+                  ("zR14" []) ("zR15" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("Zeflags"
+           (sqbkt ("Z_CF" []) ("Z_PF" []) ("Z_AF" []) ("Z_ZF" [])
+                  ("Z_SF" []) ("Z_OF" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("Zsize"
+           (sqbkt ("Z16" []) ("Z32" []) ("Z64" []) ("Z8" (sqbkt bTy))))))
+
+
+(val _ = Construct
+  (sqbkt ("Zbase"
+           (sqbkt ("ZnoBase" []) ("ZregBase" (sqbkt CTy"Zreg"))
+                  ("ZripBase" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("Zrm"
+           (sqbkt ("Zm"
+                    (sqbkt (PTy (OTy (PTy (FTy 2) CTy"Zreg"))
+                             (PTy CTy"Zbase" F64))))
+                  ("Zr" (sqbkt CTy"Zreg"))))))
+
+
+(val _ = Construct
+  (sqbkt ("Zdest_src"
+           (sqbkt ("Zr_rm" (sqbkt (PTy CTy"Zreg" CTy"Zrm")))
+                  ("Zrm_i" (sqbkt (PTy CTy"Zrm" F64)))
+                  ("Zrm_r" (sqbkt (PTy CTy"Zrm" CTy"Zreg")))))))
+
+
+(val _ = Construct
+  (sqbkt ("Zimm_rm" (sqbkt ("Zimm" (sqbkt F64)) ("Zrm" (sqbkt CTy"Zrm"))))))
+
+
+(val _ = Construct
+  (sqbkt ("Zmonop_name"
+           (sqbkt ("Zdec" []) ("Zinc" []) ("Znot" []) ("Zneg" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("Zbinop_name"
+           (sqbkt ("Zadd" []) ("Zor" []) ("Zadc" []) ("Zsbb" [])
+                  ("Zand" []) ("Zsub" []) ("Zxor" []) ("Zcmp" [])
+                  ("Zrol" []) ("Zror" []) ("Zrcl" []) ("Zrcr" [])
+                  ("Zshl" []) ("Zshr" []) ("Ztest" []) ("Zsar" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("Zcond"
+           (sqbkt ("Z_O" []) ("Z_NO" []) ("Z_B" []) ("Z_NB" []) ("Z_E" [])
+                  ("Z_NE" []) ("Z_NA" []) ("Z_A" []) ("Z_S" [])
+                  ("Z_NS" []) ("Z_P" []) ("Z_NP" []) ("Z_L" [])
+                  ("Z_NL" []) ("Z_NG" []) ("Z_G" []) ("Z_ALWAYS" [])))))
+
+
+(val _ = Construct
+  (sqbkt ("Zea"
+           (sqbkt ("Zea_i" (sqbkt (PTy CTy"Zsize" F64)))
+                  ("Zea_m" (sqbkt (PTy CTy"Zsize" F64)))
+                  ("Zea_r" (sqbkt (PTy CTy"Zsize" CTy"Zreg")))))))
+
+
+(val _ = Construct
+  (sqbkt ("instruction"
+           (sqbkt ("Zbinop"
+                    (sqbkt (PTy CTy"Zbinop_name"
+                             (PTy CTy"Zsize" CTy"Zdest_src"))))
+                  ("Zcall" (sqbkt CTy"Zimm_rm"))
+                  ("Zcmpxchg"
+                    (sqbkt (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))
+                  ("Zcpuid" []) ("Zdiv" (sqbkt (PTy CTy"Zsize" CTy"Zrm")))
+                  ("Zjcc" (sqbkt (PTy CTy"Zcond" F64)))
+                  ("Zjmp" (sqbkt CTy"Zrm"))
+                  ("Zlea" (sqbkt (PTy CTy"Zsize" CTy"Zdest_src")))
+                  ("Zloop" (sqbkt (PTy CTy"Zcond" F64)))
+                  ("Zmonop"
+                    (sqbkt (PTy CTy"Zmonop_name"
+                             (PTy CTy"Zsize" CTy"Zrm"))))
+                  ("Zmov"
+                    (sqbkt (PTy CTy"Zcond"
+                             (PTy CTy"Zsize" CTy"Zdest_src"))))
+                  ("Zmovzx"
+                    (sqbkt (PTy CTy"Zsize"
+                             (PTy CTy"Zdest_src" CTy"Zsize"))))
+                  ("Zmul" (sqbkt (PTy CTy"Zsize" CTy"Zrm"))) ("Znop" [])
+                  ("Zpop" (sqbkt CTy"Zrm")) ("Zpush" (sqbkt CTy"Zimm_rm"))
+                  ("Zret" (sqbkt F64))
+                  ("Zxadd"
+                    (sqbkt (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))
+                  ("Zxchg"
+                    (sqbkt (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))))))
+
+
+(val _ = Construct
+  (sqbkt ("Zinst"
+           (sqbkt ("Zdec_fail" (sqbkt sTy))
+                  ("Zfull_inst"
+                    (sqbkt (PTy (LTy F8) (PTy CTy"instruction" (LTy F8)))))))))
+
+
+(val _ = Record ("REX" (sqbkt ("B" bTy) ("R" bTy) ("W" bTy) ("X" bTy))))
+
+
+(val _ = Construct
+  (sqbkt ("exception"
+           (sqbkt ("BadFlagAccess" (sqbkt sTy))
+                  ("BadMemAccess" (sqbkt F64)) ("FAIL" (sqbkt sTy))
+                  ("NoException" [])))))
+
+
+(val _ = Record
+  ("state"
+    (sqbkt ("EFLAGS" (ATy CTy"Zeflags" (OTy bTy)))
+           ("ICACHE" (ATy F64 (OTy F8))) ("MEM" (ATy F64 (OTy F8)))
+           ("REG" (ATy CTy"Zreg" F64)) ("RIP" F64)
+           ("exception" CTy"exception"))))
+
+
+(Def "raise'exception" (Var "e" CTy"exception")
+  (Close qVar"state"
+    (TP
+      (sqbkt (LX VTy"a")
+             (ITE
+               (EQ (Dest "exception" CTy"exception" qVar"state")
+                 (Const "NoException" CTy"exception"))
+               (Rupd "exception"
+                 (TP (sqbkt qVar"state" (Var "e" CTy"exception"))))
+               qVar"state")))))
+
+
+(Def "write'mem8" (TP (sqbkt (Var "b" F8) (Var "addr" F64)))
+  (Close qVar"state"
+    (ITE
+      (Mop IsSome
+        (Apply (Dest "MEM" (ATy F64 (OTy F8)) qVar"state")
+          (Var "addr" F64)))
+      (TP
+        (sqbkt LU
+               (Rupd "MEM"
+                 (TP
+                   (sqbkt qVar"state"
+                          (Fupd
+                            (Dest "MEM" (ATy F64 (OTy F8)) qVar"state")
+                            (Var "addr" F64) (Mop Some (Var "b" F8))))))))
+      (Apply
+        (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+          (Call "BadMemAccess" CTy"exception" (Var "addr" F64)))
+        qVar"state"))))
+
+
+(Def "mem8" (Var "addr" F64)
+  (Close qVar"state"
+    (CS
+      (Apply (Dest "MEM" (ATy F64 (OTy F8)) qVar"state") (Var "addr" F64))
+      (sqbkt ((Mop Some (Var "b" F8))
+               (TP (sqbkt (Var "b" F8) qVar"state")))
+             ((LO F8)
+               (Apply
+                 (Call "raise'exception" (ATy qTy (PTy F8 qTy))
+                   (Call "BadMemAccess" CTy"exception" (Var "addr" F64)))
+                 qVar"state"))))))
+
+
+(Def "write'mem16" (TP (sqbkt (Var "w" F16) (Var "addr" F64)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'mem8" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (EX (Var "w" F16) (LN 15) (LN 8) F8)
+                 (Bop Add (Var "addr" F64) (LW 1 64)))))
+      (Mop Snd
+        (Apply
+          (Call "write'mem8" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (EX (Var "w" F16) (LN 7) (LN 0) F8) (Var "addr" F64))))
+          qVar"state")))))
+
+
+(Def "mem16" (Var "addr" F64)
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" F8) qVar"s"))
+      (Apply
+        (Call "mem8" (ATy qTy (PTy F8 qTy))
+          (Bop Add (Var "addr" F64) (LW 1 64))) qVar"state")
+      (Let (TP (sqbkt (Var "v0" F8) qVar"s"))
+        (Apply (Call "mem8" (ATy qTy (PTy F8 qTy)) (Var "addr" F64))
+          qVar"s")
+        (TP (sqbkt CC(sqbkt (Var "v" F8) (Var "v0" F8)) qVar"s"))))))
+
+
+(Def "write'mem32" (TP (sqbkt (Var "w" F32) (Var "addr" F64)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'mem16" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (EX (Var "w" F32) (LN 31) (LN 16) F16)
+                 (Bop Add (Var "addr" F64) (LW 2 64)))))
+      (Mop Snd
+        (Apply
+          (Call "write'mem16" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (EX (Var "w" F32) (LN 15) (LN 0) F16)
+                     (Var "addr" F64)))) qVar"state")))))
+
+
+(Def "mem32" (Var "addr" F64)
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" F16) qVar"s"))
+      (Apply
+        (Call "mem16" (ATy qTy (PTy F16 qTy))
+          (Bop Add (Var "addr" F64) (LW 2 64))) qVar"state")
+      (Let (TP (sqbkt (Var "v0" F16) qVar"s"))
+        (Apply (Call "mem16" (ATy qTy (PTy F16 qTy)) (Var "addr" F64))
+          qVar"s")
+        (TP (sqbkt CC(sqbkt (Var "v" F16) (Var "v0" F16)) qVar"s"))))))
+
+
+(Def "write'mem64" (TP (sqbkt (Var "w" F64) (Var "addr" F64)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'mem32" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (EX (Var "w" F64) (LN 63) (LN 32) F32)
+                 (Bop Add (Var "addr" F64) (LW 4 64)))))
+      (Mop Snd
+        (Apply
+          (Call "write'mem32" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (EX (Var "w" F64) (LN 31) (LN 0) F32)
+                     (Var "addr" F64)))) qVar"state")))))
+
+
+(Def "mem64" (Var "addr" F64)
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" F32) qVar"s"))
+      (Apply
+        (Call "mem32" (ATy qTy (PTy F32 qTy))
+          (Bop Add (Var "addr" F64) (LW 4 64))) qVar"state")
+      (Let (TP (sqbkt (Var "v0" F32) qVar"s"))
+        (Apply (Call "mem32" (ATy qTy (PTy F32 qTy)) (Var "addr" F64))
+          qVar"s")
+        (TP (sqbkt CC(sqbkt (Var "v" F32) (Var "v0" F32)) qVar"s"))))))
+
+
+(Def "Eflag" (Var "flag" CTy"Zeflags")
+  (Close qVar"state"
+    (CS
+      (Apply (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy)) qVar"state")
+        (Var "flag" CTy"Zeflags"))
+      (sqbkt ((Mop Some bVar"b") (TP (sqbkt bVar"b" qVar"state")))
+             ((LO bTy)
+               (Apply
+                 (Call "raise'exception" (ATy qTy (PTy bTy qTy))
+                   (Call "BadFlagAccess" CTy"exception"
+                     (Mop (Cast sTy) (Var "flag" CTy"Zeflags"))))
+                 qVar"state"))))))
+
+
+(Def "write'Eflag" (TP (sqbkt bVar"b" (Var "flag" CTy"Zeflags")))
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (Rupd "EFLAGS"
+               (TP
+                 (sqbkt qVar"state"
+                        (Fupd
+                          (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                            qVar"state") (Var "flag" CTy"Zeflags")
+                          (Mop Some bVar"b")))))))))
+
+
+(Def "FlagUnspecified" (Var "flag" CTy"Zeflags")
+  (Close qVar"state"
+    (TP
+      (sqbkt LU
+             (Rupd "EFLAGS"
+               (TP
+                 (sqbkt qVar"state"
+                        (Fupd
+                          (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                            qVar"state") (Var "flag" CTy"Zeflags")
+                          (LO bTy)))))))))
+
+
+(Def "CF" qVar"state"
+  (Apply (Call "Eflag" (ATy qTy (PTy bTy qTy)) (LC "Z_CF" CTy"Zeflags"))
+    qVar"state"))
+
+
+(Def "write'CF" bVar"b"
+  (Close qVar"state"
+    (Apply
+      (Call "write'Eflag" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt bVar"b" (LC "Z_CF" CTy"Zeflags")))) qVar"state")))
+
+
+(Def "PF" qVar"state"
+  (Apply (Call "Eflag" (ATy qTy (PTy bTy qTy)) (LC "Z_PF" CTy"Zeflags"))
+    qVar"state"))
+
+
+(Def "write'PF" bVar"b"
+  (Close qVar"state"
+    (Apply
+      (Call "write'Eflag" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt bVar"b" (LC "Z_PF" CTy"Zeflags")))) qVar"state")))
+
+
+(Def "write'AF" bVar"b"
+  (Close qVar"state"
+    (Apply
+      (Call "write'Eflag" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt bVar"b" (LC "Z_AF" CTy"Zeflags")))) qVar"state")))
+
+
+(Def "AF" qVar"state"
+  (Apply (Call "Eflag" (ATy qTy (PTy bTy qTy)) (LC "Z_AF" CTy"Zeflags"))
+    qVar"state"))
+
+
+(Def "write'ZF" bVar"b"
+  (Close qVar"state"
+    (Apply
+      (Call "write'Eflag" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt bVar"b" (LC "Z_ZF" CTy"Zeflags")))) qVar"state")))
+
+
+(Def "ZF" qVar"state"
+  (Apply (Call "Eflag" (ATy qTy (PTy bTy qTy)) (LC "Z_ZF" CTy"Zeflags"))
+    qVar"state"))
+
+
+(Def "write'SF" bVar"b"
+  (Close qVar"state"
+    (Apply
+      (Call "write'Eflag" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt bVar"b" (LC "Z_SF" CTy"Zeflags")))) qVar"state")))
+
+
+(Def "SF" qVar"state"
+  (Apply (Call "Eflag" (ATy qTy (PTy bTy qTy)) (LC "Z_SF" CTy"Zeflags"))
+    qVar"state"))
+
+
+(Def "write'OF" bVar"b"
+  (Close qVar"state"
+    (Apply
+      (Call "write'Eflag" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt bVar"b" (LC "Z_OF" CTy"Zeflags")))) qVar"state")))
+
+
+(Def "OF" qVar"state"
+  (Apply (Call "Eflag" (ATy qTy (PTy bTy qTy)) (LC "Z_OF" CTy"Zeflags"))
+    qVar"state"))
+
+
+(Def "ea_index" (Var "index" (OTy (PTy (FTy 2) CTy"Zreg")))
+  (Close qVar"state"
+    (CS (Var "index" (OTy (PTy (FTy 2) CTy"Zreg")))
+      (sqbkt ((LO (PTy (FTy 2) CTy"Zreg"))
+               (TP (sqbkt (LW 0 64) qVar"state")))
+             ((Mop Some
+                 (TP (sqbkt (Var "scale" (FTy 2)) (Var "idx" CTy"Zreg"))))
+               (TP
+                 (sqbkt (Bop Mul
+                          (Bop Lsl (LW 1 64)
+                            (Mop (Cast nTy) (Var "scale" (FTy 2))))
+                          (Apply
+                            (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                            (Var "idx" CTy"Zreg"))) qVar"state")))))))
+
+
+(Def "ea_base" (Var "base" CTy"Zbase")
+  (Close qVar"state"
+    (CS (Var "base" CTy"Zbase")
+      (sqbkt ((Const "ZnoBase" CTy"Zbase")
+               (TP (sqbkt (LW 0 64) qVar"state")))
+             ((Const "ZripBase" CTy"Zbase")
+               (TP (sqbkt (Dest "RIP" F64 qVar"state") qVar"state")))
+             ((Call "ZregBase" CTy"Zbase" (Var "b" CTy"Zreg"))
+               (TP
+                 (sqbkt (Apply
+                          (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                          (Var "b" CTy"Zreg")) qVar"state")))))))
+
+
+(Def "ea_Zrm" (TP (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm")))
+  (Close qVar"state"
+    (CS (Var "rm" CTy"Zrm")
+      (sqbkt ((Call "Zr" CTy"Zrm" (Var "r" CTy"Zreg"))
+               (TP
+                 (sqbkt (Call "Zea_r" CTy"Zea"
+                          (TP
+                            (sqbkt (Var "size" CTy"Zsize")
+                                   (Var "r" CTy"Zreg")))) qVar"state")))
+             ((Call "Zm" CTy"Zrm"
+                 (TP
+                   (sqbkt (Var "index" (OTy (PTy (FTy 2) CTy"Zreg")))
+                          (Var "base" CTy"Zbase") (Var "displacement" F64))))
+               (TP
+                 (sqbkt (Call "Zea_m" CTy"Zea"
+                          (TP
+                            (sqbkt (Var "size" CTy"Zsize")
+                                   (Bop Add
+                                     (Bop Add
+                                       (Mop Fst
+                                         (Apply
+                                           (Call "ea_index"
+                                             (ATy qTy (PTy F64 qTy))
+                                             (Var "index"
+                                               (OTy
+                                                 (PTy (FTy 2) CTy"Zreg"))))
+                                           qVar"state"))
+                                       (Mop Fst
+                                         (Apply
+                                           (Call "ea_base"
+                                             (ATy qTy (PTy F64 qTy))
+                                             (Var "base" CTy"Zbase"))
+                                           qVar"state")))
+                                     (Var "displacement" F64)))))
+                        qVar"state")))))))
+
+
+(Def "ea_Zdest"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "ds" CTy"Zdest_src")))
+  (Close qVar"state"
+    (CS (Var "ds" CTy"Zdest_src")
+      (sqbkt ((Call "Zrm_i" CTy"Zdest_src"
+                 (TP (sqbkt (Var "rm" CTy"Zrm") (AVar F64))))
+               (TP
+                 (sqbkt (Mop Fst
+                          (Apply
+                            (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+                              (TP
+                                (sqbkt (Var "size" CTy"Zsize")
+                                       (Var "rm" CTy"Zrm")))) qVar"state"))
+                        qVar"state")))
+             ((Call "Zrm_r" CTy"Zdest_src"
+                 (TP (sqbkt (Var "rm" CTy"Zrm") (AVar CTy"Zreg"))))
+               (TP
+                 (sqbkt (Mop Fst
+                          (Apply
+                            (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+                              (TP
+                                (sqbkt (Var "size" CTy"Zsize")
+                                       (Var "rm" CTy"Zrm")))) qVar"state"))
+                        qVar"state")))
+             ((Call "Zr_rm" CTy"Zdest_src"
+                 (TP (sqbkt (Var "r" CTy"Zreg") (AVar CTy"Zrm"))))
+               (TP
+                 (sqbkt (Call "Zea_r" CTy"Zea"
+                          (TP
+                            (sqbkt (Var "size" CTy"Zsize")
+                                   (Var "r" CTy"Zreg")))) qVar"state")))))))
+
+
+(Def "ea_Zsrc"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "ds" CTy"Zdest_src")))
+  (Close qVar"state"
+    (CS (Var "ds" CTy"Zdest_src")
+      (sqbkt ((Call "Zrm_i" CTy"Zdest_src"
+                 (TP (sqbkt (AVar CTy"Zrm") (Var "i" F64))))
+               (TP
+                 (sqbkt (Call "Zea_i" CTy"Zea"
+                          (TP
+                            (sqbkt (Var "size" CTy"Zsize") (Var "i" F64))))
+                        qVar"state")))
+             ((Call "Zrm_r" CTy"Zdest_src"
+                 (TP (sqbkt (AVar CTy"Zrm") (Var "r" CTy"Zreg"))))
+               (TP
+                 (sqbkt (Call "Zea_r" CTy"Zea"
+                          (TP
+                            (sqbkt (Var "size" CTy"Zsize")
+                                   (Var "r" CTy"Zreg")))) qVar"state")))
+             ((Call "Zr_rm" CTy"Zdest_src"
+                 (TP (sqbkt (AVar CTy"Zreg") (Var "rm" CTy"Zrm"))))
+               (TP
+                 (sqbkt (Mop Fst
+                          (Apply
+                            (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+                              (TP
+                                (sqbkt (Var "size" CTy"Zsize")
+                                       (Var "rm" CTy"Zrm")))) qVar"state"))
+                        qVar"state")))))))
+
+
+(Def "ea_Zimm_rm"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "imm_rm" CTy"Zimm_rm")))
+  (Close qVar"state"
+    (CS (Var "imm_rm" CTy"Zimm_rm")
+      (sqbkt ((Call "Zrm" CTy"Zimm_rm" (Var "rm" CTy"Zrm"))
+               (TP
+                 (sqbkt (Mop Fst
+                          (Apply
+                            (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+                              (TP
+                                (sqbkt (Var "size" CTy"Zsize")
+                                       (Var "rm" CTy"Zrm")))) qVar"state"))
+                        qVar"state")))
+             ((Call "Zimm" CTy"Zimm_rm" (Var "imm" F64))
+               (TP
+                 (sqbkt (Call "Zea_i" CTy"Zea"
+                          (TP
+                            (sqbkt (Var "size" CTy"Zsize") (Var "imm" F64))))
+                        qVar"state")))))))
+
+
+(Def "restrictSize" (TP (sqbkt (Var "size" CTy"Zsize") (Var "imm" F64)))
+  (CS (Var "size" CTy"Zsize")
+    (sqbkt ((Call "Z8" CTy"Zsize" (AVar bTy))
+             (Bop BAnd (Var "imm" F64) (LW 255 64)))
+           ((Const "Z16" CTy"Zsize")
+             (Bop BAnd (Var "imm" F64) (LW 65535 64)))
+           ((Const "Z32" CTy"Zsize")
+             (Bop BAnd (Var "imm" F64) (LW 4294967295 64)))
+           ((Const "Z64" CTy"Zsize") (Var "imm" F64)))))
+
+
+(Def "EA" (Var "ea" CTy"Zea")
+  (Close qVar"state"
+    (CS (Var "ea" CTy"Zea")
+      (sqbkt ((Call "Zea_i" CTy"Zea" (Var "i" (PTy CTy"Zsize" F64)))
+               (TP
+                 (sqbkt (Call "restrictSize" F64
+                          (Var "i" (PTy CTy"Zsize" F64))) qVar"state")))
+             ((Call "Zea_r" CTy"Zea"
+                 (TP
+                   (sqbkt (Call "Z8" CTy"Zsize" bVar"have_rex")
+                          (Var "r" CTy"Zreg"))))
+               (TP
+                 (sqbkt (ITE
+                          (Bop Or bVar"have_rex"
+                            (Mop Not
+                              (Bop In (Var "r" CTy"Zreg")
+                                (SL(sqbkt (LC "RSP" CTy"Zreg")
+                                          (LC "RBP" CTy"Zreg")
+                                          (LC "RSI" CTy"Zreg")
+                                          (LC "RDI" CTy"Zreg"))))))
+                          (Bop BAnd
+                            (Apply
+                              (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                              (Var "r" CTy"Zreg")) (LW 255 64))
+                          (Bop BAnd
+                            (Bop Lsr
+                              (Apply
+                                (Dest "REG" (ATy CTy"Zreg" F64)
+                                  qVar"state")
+                                (Mop (Cast CTy"Zreg")
+                                  (Bop Sub
+                                    (Mop (Cast nTy) (Var "r" CTy"Zreg"))
+                                    (LN 4)))) (LN 8)) (LW 255 64)))
+                        qVar"state")))
+             ((Call "Zea_r" CTy"Zea"
+                 (TP (sqbkt (Var "s" CTy"Zsize") (Var "r" CTy"Zreg"))))
+               (TP
+                 (sqbkt (Call "restrictSize" F64
+                          (TP
+                            (sqbkt (Var "s" CTy"Zsize")
+                                   (Apply
+                                     (Dest "REG" (ATy CTy"Zreg" F64)
+                                       qVar"state") (Var "r" CTy"Zreg")))))
+                        qVar"state")))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP
+                   (sqbkt (Call "Z8" CTy"Zsize" (AVar bTy)) (Var "a" F64))))
+               (Let (TP (sqbkt (Var "v" F8) qVar"s"))
+                 (Apply (Call "mem8" (ATy qTy (PTy F8 qTy)) (Var "a" F64))
+                   qVar"state")
+                 (TP (sqbkt (Mop (Cast F64) (Var "v" F8)) qVar"s"))))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP (sqbkt (Const "Z16" CTy"Zsize") (Var "a" F64))))
+               (Let (TP (sqbkt (Var "v" F16) qVar"s"))
+                 (Apply
+                   (Call "mem16" (ATy qTy (PTy F16 qTy)) (Var "a" F64))
+                   qVar"state")
+                 (TP (sqbkt (Mop (Cast F64) (Var "v" F16)) qVar"s"))))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP (sqbkt (Const "Z32" CTy"Zsize") (Var "a" F64))))
+               (Let (TP (sqbkt (Var "v" F32) qVar"s"))
+                 (Apply
+                   (Call "mem32" (ATy qTy (PTy F32 qTy)) (Var "a" F64))
+                   qVar"state")
+                 (TP (sqbkt (Mop (Cast F64) (Var "v" F32)) qVar"s"))))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP (sqbkt (Const "Z64" CTy"Zsize") (Var "a" F64))))
+               (Apply (Call "mem64" (ATy qTy (PTy F64 qTy)) (Var "a" F64))
+                 qVar"state"))))))
+
+
+(Def "write'EA" (TP (sqbkt (Var "w" F64) (Var "ea" CTy"Zea")))
+  (Close qVar"state"
+    (CS (Var "ea" CTy"Zea")
+      (sqbkt ((Call "Zea_i" CTy"Zea" (Var "i" (PTy CTy"Zsize" F64)))
+               (Apply
+                 (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                   (Call "FAIL" CTy"exception" (LS"write to constant")))
+                 qVar"state"))
+             ((Call "Zea_r" CTy"Zea"
+                 (TP
+                   (sqbkt (Call "Z8" CTy"Zsize" bVar"have_rex")
+                          (Var "r" CTy"Zreg"))))
+               (ITE
+                 (Bop Or bVar"have_rex"
+                   (Mop Not
+                     (Bop In (Var "r" CTy"Zreg")
+                       (SL(sqbkt (LC "RSP" CTy"Zreg") (LC "RBP" CTy"Zreg")
+                                 (LC "RSI" CTy"Zreg") (LC "RDI" CTy"Zreg"))))))
+                 (Let (Var "v" (ATy CTy"Zreg" F64))
+                   (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                   (TP
+                     (sqbkt LU
+                            (Rupd "REG"
+                              (TP
+                                (sqbkt qVar"state"
+                                       (Fupd (Var "v" (ATy CTy"Zreg" F64))
+                                         (Var "r" CTy"Zreg")
+                                         (BFI (LN 7) (LN 0)
+                                           (EX (Var "w" F64) (LN 7) (LN 0)
+                                             F8)
+                                           (Apply
+                                             (Var "v" (ATy CTy"Zreg" F64))
+                                             (Var "r" CTy"Zreg"))))))))))
+                 (Let (Var "v" (ATy CTy"Zreg" F64))
+                   (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                   (Let (Var "x" CTy"Zreg")
+                     (Mop (Cast CTy"Zreg")
+                       (Bop Sub (Mop (Cast nTy) (Var "r" CTy"Zreg"))
+                         (LN 4)))
+                     (TP
+                       (sqbkt LU
+                              (Rupd "REG"
+                                (TP
+                                  (sqbkt qVar"state"
+                                         (Fupd
+                                           (Var "v" (ATy CTy"Zreg" F64))
+                                           (Var "x" CTy"Zreg")
+                                           (BFI (LN 15) (LN 8)
+                                             (EX (Var "w" F64) (LN 7)
+                                               (LN 0) F8)
+                                             (Apply
+                                               (Var "v"
+                                                 (ATy CTy"Zreg" F64))
+                                               (Var "x" CTy"Zreg")))))))))))))
+             ((Call "Zea_r" CTy"Zea"
+                 (TP (sqbkt (Const "Z16" CTy"Zsize") (Var "r" CTy"Zreg"))))
+               (Let (Var "v" (ATy CTy"Zreg" F64))
+                 (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                 (TP
+                   (sqbkt LU
+                          (Rupd "REG"
+                            (TP
+                              (sqbkt qVar"state"
+                                     (Fupd (Var "v" (ATy CTy"Zreg" F64))
+                                       (Var "r" CTy"Zreg")
+                                       (BFI (LN 15) (LN 0)
+                                         (EX (Var "w" F64) (LN 15) (LN 0)
+                                           F16)
+                                         (Apply
+                                           (Var "v" (ATy CTy"Zreg" F64))
+                                           (Var "r" CTy"Zreg")))))))))))
+             ((Call "Zea_r" CTy"Zea"
+                 (TP (sqbkt (Const "Z32" CTy"Zsize") (Var "r" CTy"Zreg"))))
+               (TP
+                 (sqbkt LU
+                        (Rupd "REG"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Fupd
+                                     (Dest "REG" (ATy CTy"Zreg" F64)
+                                       qVar"state") (Var "r" CTy"Zreg")
+                                     (Mop (Cast F64)
+                                       (EX (Var "w" F64) (LN 31) (LN 0)
+                                         F32)))))))))
+             ((Call "Zea_r" CTy"Zea"
+                 (TP (sqbkt (Const "Z64" CTy"Zsize") (Var "r" CTy"Zreg"))))
+               (TP
+                 (sqbkt LU
+                        (Rupd "REG"
+                          (TP
+                            (sqbkt qVar"state"
+                                   (Fupd
+                                     (Dest "REG" (ATy CTy"Zreg" F64)
+                                       qVar"state") (Var "r" CTy"Zreg")
+                                     (Var "w" F64))))))))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP
+                   (sqbkt (Call "Z8" CTy"Zsize" (AVar bTy)) (Var "a" F64))))
+               (Apply
+                 (Call "write'mem8" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (EX (Var "w" F64) (LN 7) (LN 0) F8)
+                            (Var "a" F64)))) qVar"state"))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP (sqbkt (Const "Z16" CTy"Zsize") (Var "a" F64))))
+               (Apply
+                 (Call "write'mem16" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (EX (Var "w" F64) (LN 15) (LN 0) F16)
+                            (Var "a" F64)))) qVar"state"))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP (sqbkt (Const "Z32" CTy"Zsize") (Var "a" F64))))
+               (Apply
+                 (Call "write'mem32" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (EX (Var "w" F64) (LN 31) (LN 0) F32)
+                            (Var "a" F64)))) qVar"state"))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP (sqbkt (Const "Z64" CTy"Zsize") (Var "a" F64))))
+               (Apply
+                 (Call "write'mem64" (ATy qTy (PTy uTy qTy))
+                   (TP (sqbkt (Var "w" F64) (Var "a" F64)))) qVar"state"))))))
+
+
+(Def "read_dest_src_ea" (Var "sd" (PTy CTy"Zsize" CTy"Zdest_src"))
+  (Close qVar"state"
+    (Let (Var "v" CTy"Zea")
+      (Mop Fst
+        (Apply
+          (Call "ea_Zdest" (ATy qTy (PTy CTy"Zea" qTy))
+            (Var "sd" (PTy CTy"Zsize" CTy"Zdest_src"))) qVar"state"))
+      (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+        (Apply (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "v" CTy"Zea"))
+          qVar"state")
+        (Let (TP (sqbkt (Var "v0" (PTy F64 F64)) qVar"s"))
+          (Let (TP (sqbkt (Var "v1" F64) qVar"s"))
+            (Apply
+              (Call "EA" (ATy qTy (PTy F64 qTy))
+                (Mop Fst
+                  (Apply
+                    (Call "ea_Zsrc" (ATy qTy (PTy CTy"Zea" qTy))
+                      (Var "sd" (PTy CTy"Zsize" CTy"Zdest_src"))) qVar"s")))
+              qVar"s")
+            (TP
+              (sqbkt (TP (sqbkt (Var "v0" F64) (Var "v1" F64))) qVar"s")))
+          (TP
+            (sqbkt (TP
+                     (sqbkt (Var "v" CTy"Zea") (Var "v0" (PTy F64 F64))))
+                   qVar"s")))))))
+
+
+(Def "call_dest_from_ea" (Var "ea" CTy"Zea")
+  (Close qVar"state"
+    (CS (Var "ea" CTy"Zea")
+      (sqbkt ((Call "Zea_i" CTy"Zea"
+                 (TP (sqbkt (AVar CTy"Zsize") (Var "i" F64))))
+               (TP
+                 (sqbkt (Bop Add (Dest "RIP" F64 qVar"state")
+                          (Var "i" F64)) qVar"state")))
+             ((Call "Zea_r" CTy"Zea"
+                 (TP (sqbkt (AVar CTy"Zsize") (Var "r" CTy"Zreg"))))
+               (TP
+                 (sqbkt (Apply
+                          (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                          (Var "r" CTy"Zreg")) qVar"state")))
+             ((Call "Zea_m" CTy"Zea"
+                 (TP (sqbkt (AVar CTy"Zsize") (Var "a" F64))))
+               (Apply (Call "mem64" (ATy qTy (PTy F64 qTy)) (Var "a" F64))
+                 qVar"state"))))))
+
+
+(Def "get_ea_address" (Var "ea" CTy"Zea")
+  (CS (Var "ea" CTy"Zea")
+    (sqbkt ((Call "Zea_i" CTy"Zea"
+               (TP (sqbkt (AVar CTy"Zsize") (Var "i" F64)))) (LW 0 64))
+           ((Call "Zea_r" CTy"Zea"
+               (TP (sqbkt (AVar CTy"Zsize") (Var "r" CTy"Zreg"))))
+             (LW 0 64))
+           ((Call "Zea_m" CTy"Zea"
+               (TP (sqbkt (AVar CTy"Zsize") (Var "a" F64))))
+             (Var "a" F64)))))
+
+
+(Def "jump_to_ea" (Var "ea" CTy"Zea")
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+      (Apply
+        (Call "call_dest_from_ea" (ATy qTy (PTy F64 qTy))
+          (Var "ea" CTy"Zea")) qVar"state")
+      (TP (sqbkt LU (Rupd "RIP" (TP (sqbkt qVar"s" (Var "v" F64)))))))))
+
+
+(Def "ByteParity" (Var "b" F8)
+  (EQ
+    (Bop Mod
+      (Bop Add
+        (Bop Add
+          (Bop Add
+            (Bop Add
+              (Bop Add
+                (Bop Add
+                  (Bop Add (Mop (Cast nTy) (Bop Bit (Var "b" F8) (LN 7)))
+                    (Mop (Cast nTy) (Bop Bit (Var "b" F8) (LN 6))))
+                  (Mop (Cast nTy) (Bop Bit (Var "b" F8) (LN 5))))
+                (Mop (Cast nTy) (Bop Bit (Var "b" F8) (LN 4))))
+              (Mop (Cast nTy) (Bop Bit (Var "b" F8) (LN 3))))
+            (Mop (Cast nTy) (Bop Bit (Var "b" F8) (LN 2))))
+          (Mop (Cast nTy) (Bop Bit (Var "b" F8) (LN 1))))
+        (Mop (Cast nTy) (Bop Bit (Var "b" F8) (LN 0)))) (LN 2)) (LN 0)))
+
+
+(Def "Zsize_width" (Var "size" CTy"Zsize")
+  (CS (Var "size" CTy"Zsize")
+    (sqbkt ((Call "Z8" CTy"Zsize" (AVar bTy)) (LN 8))
+           ((Const "Z16" CTy"Zsize") (LN 16))
+           ((Const "Z32" CTy"Zsize") (LN 32))
+           ((Const "Z64" CTy"Zsize") (LN 64)))))
+
+
+(Def "word_size_msb" (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64)))
+  (Bop Bit (Var "w" F64)
+    (Bop Sub (Call "Zsize_width" nTy (Var "size" CTy"Zsize")) (LN 1))))
+
+
+(Def "write_PF" (Var "w" F64)
+  (Close qVar"state"
+    (Apply
+      (Call "write'PF" (ATy qTy (PTy uTy qTy))
+        (Call "ByteParity" bTy (EX (Var "w" F64) (LN 7) (LN 0) F8)))
+      qVar"state")))
+
+
+(Def "write_SF" (Var "s_w" (PTy CTy"Zsize" F64))
+  (Close qVar"state"
+    (Apply
+      (Call "write'SF" (ATy qTy (PTy uTy qTy))
+        (Call "word_size_msb" bTy (Var "s_w" (PTy CTy"Zsize" F64))))
+      qVar"state")))
+
+
+(Def "write_ZF" (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64)))
+  (Close qVar"state"
+    (Apply
+      (Call "write'ZF" (ATy qTy (PTy uTy qTy))
+        (CS (Var "size" CTy"Zsize")
+          (sqbkt ((Call "Z8" CTy"Zsize" (AVar bTy))
+                   (EQ (Mop (Cast F8) (Var "w" F64)) (LW 0 8)))
+                 ((Const "Z16" CTy"Zsize")
+                   (EQ (Mop (Cast F16) (Var "w" F64)) (LW 0 16)))
+                 ((Const "Z32" CTy"Zsize")
+                   (EQ (Mop (Cast F32) (Var "w" F64)) (LW 0 32)))
+                 ((Const "Z64" CTy"Zsize") (EQ (Var "w" F64) (LW 0 64))))))
+      qVar"state")))
+
+
+(Def "write_logical_eflags"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64)))
+  (Close qVar"state"
+    (Apply
+      (Call "FlagUnspecified" (ATy qTy (PTy uTy qTy))
+        (LC "Z_AF" CTy"Zeflags"))
+      (Mop Snd
+        (Apply
+          (Call "write_ZF" (ATy qTy (PTy uTy qTy))
+            (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64))))
+          (Mop Snd
+            (Apply
+              (Call "write_SF" (ATy qTy (PTy uTy qTy))
+                (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64))))
+              (Mop Snd
+                (Apply
+                  (Call "write_PF" (ATy qTy (PTy uTy qTy)) (Var "w" F64))
+                  (Mop Snd
+                    (Apply (Call "write'OF" (ATy qTy (PTy uTy qTy)) LF)
+                      (Mop Snd
+                        (Apply
+                          (Call "write'CF" (ATy qTy (PTy uTy qTy)) LF)
+                          qVar"state")))))))))))))
+
+
+(Def "write_arith_eflags_except_CF_OF"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64)))
+  (Close qVar"state"
+    (Apply
+      (Call "FlagUnspecified" (ATy qTy (PTy uTy qTy))
+        (LC "Z_AF" CTy"Zeflags"))
+      (Mop Snd
+        (Apply
+          (Call "write_ZF" (ATy qTy (PTy uTy qTy))
+            (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64))))
+          (Mop Snd
+            (Apply
+              (Call "write_SF" (ATy qTy (PTy uTy qTy))
+                (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64))))
+              (Mop Snd
+                (Apply
+                  (Call "write_PF" (ATy qTy (PTy uTy qTy)) (Var "w" F64))
+                  qVar"state")))))))))
+
+
+(Def "write_arith_eflags"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "r" (PTy F64 (PTy bTy bTy)))))
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "w" F64) bVar"c" bVar"x"))
+      (Var "r" (PTy F64 (PTy bTy bTy)))
+      (Apply
+        (Call "write_arith_eflags_except_CF_OF" (ATy qTy (PTy uTy qTy))
+          (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64))))
+        (Mop Snd
+          (Apply (Call "write'OF" (ATy qTy (PTy uTy qTy)) bVar"x")
+            (Mop Snd
+              (Apply (Call "write'CF" (ATy qTy (PTy uTy qTy)) bVar"c")
+                qVar"state"))))))))
+
+
+(Def "erase_eflags" qVar"state"
+  (TP
+    (sqbkt LU
+           (Rupd "EFLAGS"
+             (TP (sqbkt qVar"state" (Mop (K1 CTy"Zeflags") (LO bTy))))))))
+
+
+(Def "value_width" (Var "s" CTy"Zsize")
+  (Bop Exp (LN 2) (Call "Zsize_width" nTy (Var "s" CTy"Zsize"))))
+
+
+(Def "word_signed_overflow_add"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "a" F64) (Var "b" F64)))
+  (Bop And
+    (EQ
+      (Call "word_size_msb" bTy
+        (TP (sqbkt (Var "size" CTy"Zsize") (Var "a" F64))))
+      (Call "word_size_msb" bTy
+        (TP (sqbkt (Var "size" CTy"Zsize") (Var "b" F64)))))
+    (Mop Not
+      (EQ
+        (Call "word_size_msb" bTy
+          (TP
+            (sqbkt (Var "size" CTy"Zsize")
+                   (Bop Add (Var "a" F64) (Var "b" F64)))))
+        (Call "word_size_msb" bTy
+          (TP (sqbkt (Var "size" CTy"Zsize") (Var "a" F64))))))))
+
+
+(Def "word_signed_overflow_sub"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "a" F64) (Var "b" F64)))
+  (Bop And
+    (Mop Not
+      (EQ
+        (Call "word_size_msb" bTy
+          (TP (sqbkt (Var "size" CTy"Zsize") (Var "a" F64))))
+        (Call "word_size_msb" bTy
+          (TP (sqbkt (Var "size" CTy"Zsize") (Var "b" F64))))))
+    (Mop Not
+      (EQ
+        (Call "word_size_msb" bTy
+          (TP
+            (sqbkt (Var "size" CTy"Zsize")
+                   (Bop Sub (Var "a" F64) (Var "b" F64)))))
+        (Call "word_size_msb" bTy
+          (TP (sqbkt (Var "size" CTy"Zsize") (Var "a" F64))))))))
+
+
+(Def "add_with_carry_out"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "x" F64) (Var "y" F64)))
+  (TP
+    (sqbkt (Bop Add (Var "x" F64) (Var "y" F64))
+           (Bop Le (Call "value_width" nTy (Var "size" CTy"Zsize"))
+             (Bop Add (Mop (Cast nTy) (Var "x" F64))
+               (Mop (Cast nTy) (Var "y" F64))))
+           (Call "word_signed_overflow_add" bTy
+             (TP
+               (sqbkt (Var "size" CTy"Zsize") (Var "x" F64) (Var "y" F64)))))))
+
+
+(Def "sub_with_borrow"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "x" F64) (Var "y" F64)))
+  (TP
+    (sqbkt (Bop Sub (Var "x" F64) (Var "y" F64))
+           (Bop Ult (Var "x" F64) (Var "y" F64))
+           (Call "word_signed_overflow_sub" bTy
+             (TP
+               (sqbkt (Var "size" CTy"Zsize") (Var "x" F64) (Var "y" F64)))))))
+
+
+(Def "write_arith_result"
+  (TP
+    (sqbkt (Var "size" CTy"Zsize") (Var "r" (PTy F64 (PTy bTy bTy)))
+           (Var "ea" CTy"Zea")))
+  (Close qVar"state"
+    (Apply
+      (Call "write'EA" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Mop Fst (Var "r" (PTy F64 (PTy bTy bTy))))
+                 (Var "ea" CTy"Zea"))))
+      (Mop Snd
+        (Apply
+          (Call "write_arith_eflags" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Var "size" CTy"Zsize")
+                     (Var "r" (PTy F64 (PTy bTy bTy)))))) qVar"state")))))
+
+
+(Def "write_arith_result_no_CF_OF"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64) (Var "ea" CTy"Zea")))
+  (Close qVar"state"
+    (Apply
+      (Call "write'EA" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt (Var "w" F64) (Var "ea" CTy"Zea"))))
+      (Mop Snd
+        (Apply
+          (Call "write_arith_eflags_except_CF_OF" (ATy qTy (PTy uTy qTy))
+            (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64))))
+          qVar"state")))))
+
+
+(Def "write_logical_result"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64) (Var "ea" CTy"Zea")))
+  (Close qVar"state"
+    (Apply
+      (Call "write'EA" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt (Var "w" F64) (Var "ea" CTy"Zea"))))
+      (Mop Snd
+        (Apply
+          (Call "write_logical_eflags" (ATy qTy (PTy uTy qTy))
+            (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64))))
+          qVar"state")))))
+
+
+(Def "write_result_erase_eflags"
+  (TP (sqbkt (Var "w" F64) (Var "ea" CTy"Zea")))
+  (Close qVar"state"
+    (Apply
+      (Call "write'EA" (ATy qTy (PTy uTy qTy))
+        (TP (sqbkt (Var "w" F64) (Var "ea" CTy"Zea"))))
+      (Mop Snd
+        (Apply (Const "erase_eflags" (ATy qTy (PTy uTy qTy))) qVar"state")))))
+
+
+(Def "maskShift" (TP (sqbkt (Var "size" CTy"Zsize") (Var "w" F64)))
+  (ITE (EQ (Var "size" CTy"Zsize") (Const "Z64" CTy"Zsize"))
+    (Mop (Cast nTy) (EX (Var "w" F64) (LN 5) (LN 0) (FTy 6)))
+    (Mop (Cast nTy) (EX (Var "w" F64) (LN 4) (LN 0) (FTy 5)))))
+
+
+(Def "ROL"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "x" F64) (Var "y" F64)))
+  (CS (Var "size" CTy"Zsize")
+    (sqbkt ((Call "Z8" CTy"Zsize" (AVar bTy))
+             (Mop (Cast F64)
+               (Bop Rol (EX (Var "x" F64) (LN 7) (LN 0) F8)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z16" CTy"Zsize")
+             (Mop (Cast F64)
+               (Bop Rol (EX (Var "x" F64) (LN 15) (LN 0) F16)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z32" CTy"Zsize")
+             (Mop (Cast F64)
+               (Bop Rol (EX (Var "x" F64) (LN 31) (LN 0) F32)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z64" CTy"Zsize")
+             (Bop Rol (Var "x" F64)
+               (Mop (Cast nTy) (EX (Var "y" F64) (LN 5) (LN 0) (FTy 6))))))))
+
+
+(Def "ROR"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "x" F64) (Var "y" F64)))
+  (CS (Var "size" CTy"Zsize")
+    (sqbkt ((Call "Z8" CTy"Zsize" (AVar bTy))
+             (Mop (Cast F64)
+               (Bop Ror (EX (Var "x" F64) (LN 7) (LN 0) F8)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z16" CTy"Zsize")
+             (Mop (Cast F64)
+               (Bop Ror (EX (Var "x" F64) (LN 15) (LN 0) F16)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z32" CTy"Zsize")
+             (Mop (Cast F64)
+               (Bop Ror (EX (Var "x" F64) (LN 31) (LN 0) F32)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z64" CTy"Zsize")
+             (Bop Ror (Var "x" F64)
+               (Mop (Cast nTy) (EX (Var "y" F64) (LN 5) (LN 0) (FTy 6))))))))
+
+
+(Def "SAR"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "x" F64) (Var "y" F64)))
+  (CS (Var "size" CTy"Zsize")
+    (sqbkt ((Call "Z8" CTy"Zsize" (AVar bTy))
+             (Mop (Cast F64)
+               (Bop Asr (EX (Var "x" F64) (LN 7) (LN 0) F8)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z16" CTy"Zsize")
+             (Mop (Cast F64)
+               (Bop Asr (EX (Var "x" F64) (LN 15) (LN 0) F16)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z32" CTy"Zsize")
+             (Mop (Cast F64)
+               (Bop Asr (EX (Var "x" F64) (LN 31) (LN 0) F32)
+                 (Mop (Cast nTy) (EX (Var "y" F64) (LN 4) (LN 0) (FTy 5))))))
+           ((Const "Z64" CTy"Zsize")
+             (Bop Asr (Var "x" F64)
+               (Mop (Cast nTy) (EX (Var "y" F64) (LN 5) (LN 0) (FTy 6))))))))
+
+
+(Def "write_binop"
+  (TP
+    (sqbkt (Var "s" CTy"Zsize") (Var "bop" CTy"Zbinop_name") (Var "x" F64)
+           (Var "y" F64) (Var "ea" CTy"Zea")))
+  (Close qVar"state"
+    (CS (Var "bop" CTy"Zbinop_name")
+      (sqbkt ((LC "Zadd" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_arith_result" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Call "add_with_carry_out"
+                              (PTy F64 (PTy bTy bTy))
+                              (TP
+                                (sqbkt (Var "s" CTy"Zsize") (Var "x" F64)
+                                       (Var "y" F64))))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zsub" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_arith_result" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Call "sub_with_borrow"
+                              (PTy F64 (PTy bTy bTy))
+                              (TP
+                                (sqbkt (Var "s" CTy"Zsize") (Var "x" F64)
+                                       (Var "y" F64))))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zcmp" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_arith_eflags" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Call "sub_with_borrow"
+                              (PTy F64 (PTy bTy bTy))
+                              (TP
+                                (sqbkt (Var "s" CTy"Zsize") (Var "x" F64)
+                                       (Var "y" F64))))))) qVar"state"))
+             ((LC "Ztest" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_logical_eflags" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Bop BAnd (Var "x" F64) (Var "y" F64)))))
+                 qVar"state"))
+             ((LC "Zand" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_logical_result" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Bop BAnd (Var "x" F64) (Var "y" F64))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zxor" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_logical_result" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Bop BXor (Var "x" F64) (Var "y" F64))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zor" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_logical_result" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Bop BOr (Var "x" F64) (Var "y" F64))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zrol" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_result_erase_eflags" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Call "ROL" F64
+                              (TP
+                                (sqbkt (Var "s" CTy"Zsize") (Var "x" F64)
+                                       (Var "y" F64))))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zror" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_result_erase_eflags" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Call "ROR" F64
+                              (TP
+                                (sqbkt (Var "s" CTy"Zsize") (Var "x" F64)
+                                       (Var "y" F64))))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zsar" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_result_erase_eflags" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Call "SAR" F64
+                              (TP
+                                (sqbkt (Var "s" CTy"Zsize") (Var "x" F64)
+                                       (Var "y" F64))))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zshl" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_result_erase_eflags" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Bop Lsl (Var "x" F64)
+                              (Call "maskShift" nTy
+                                (TP
+                                  (sqbkt (Var "s" CTy"Zsize")
+                                         (Var "y" F64)))))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zshr" CTy"Zbinop_name")
+               (Apply
+                 (Call "write_result_erase_eflags" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Bop Lsr (Var "x" F64)
+                              (Call "maskShift" nTy
+                                (TP
+                                  (sqbkt (Var "s" CTy"Zsize")
+                                         (Var "y" F64)))))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zadc" CTy"Zbinop_name")
+               (Let (TP (sqbkt bVar"v" qVar"s0"))
+                 (Apply (Const "CF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (Apply
+                   (Call "write_arith_result_no_CF_OF"
+                     (ATy qTy (PTy uTy qTy))
+                     (TP
+                       (sqbkt (Var "s" CTy"Zsize")
+                              (Bop Add
+                                (Bop Add (Var "x" F64) (Var "y" F64))
+                                (Mop (Cast F64) bVar"v"))
+                              (Var "ea" CTy"Zea"))))
+                   (Mop Snd
+                     (Apply
+                       (Call "FlagUnspecified" (ATy qTy (PTy uTy qTy))
+                         (LC "Z_OF" CTy"Zeflags"))
+                       (Mop Snd
+                         (Apply
+                           (Call "write'CF" (ATy qTy (PTy uTy qTy))
+                             (Bop Le
+                               (Call "value_width" nTy
+                                 (Var "s" CTy"Zsize"))
+                               (Bop Add
+                                 (Bop Add (Mop (Cast nTy) (Var "x" F64))
+                                   (Mop (Cast nTy) (Var "y" F64)))
+                                 (Mop (Cast nTy) bVar"v")))) qVar"s0")))))))
+             ((LC "Zsbb" CTy"Zbinop_name")
+               (Let (TP (sqbkt bVar"v" qVar"s0"))
+                 (Apply (Const "CF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (Apply
+                   (Call "write_arith_result_no_CF_OF"
+                     (ATy qTy (PTy uTy qTy))
+                     (TP
+                       (sqbkt (Var "s" CTy"Zsize")
+                              (Bop Sub (Var "x" F64)
+                                (Bop Add (Var "y" F64)
+                                  (Mop (Cast F64) bVar"v")))
+                              (Var "ea" CTy"Zea"))))
+                   (Mop Snd
+                     (Apply
+                       (Call "FlagUnspecified" (ATy qTy (PTy uTy qTy))
+                         (LC "Z_OF" CTy"Zeflags"))
+                       (Mop Snd
+                         (Apply
+                           (Call "write'CF" (ATy qTy (PTy uTy qTy))
+                             (Bop Lt (Mop (Cast nTy) (Var "x" F64))
+                               (Bop Add (Mop (Cast nTy) (Var "y" F64))
+                                 (Mop (Cast nTy) bVar"v")))) qVar"s0")))))))
+             ((AVar CTy"Zbinop_name")
+               (Apply
+                 (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                   (Call "FAIL" CTy"exception"
+                     (CC(sqbkt LS"Binary op not implemented: "
+                               (Mop (Cast sTy)
+                                 (Var "bop" CTy"Zbinop_name"))))))
+                 qVar"state"))))))
+
+
+(Def "write_monop"
+  (TP
+    (sqbkt (Var "s" CTy"Zsize") (Var "mop" CTy"Zmonop_name") (Var "x" F64)
+           (Var "ea" CTy"Zea")))
+  (Close qVar"state"
+    (CS (Var "mop" CTy"Zmonop_name")
+      (sqbkt ((LC "Znot" CTy"Zmonop_name")
+               (Apply
+                 (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Mop BNot (Var "x" F64)) (Var "ea" CTy"Zea"))))
+                 qVar"state"))
+             ((LC "Zdec" CTy"Zmonop_name")
+               (Apply
+                 (Call "write_arith_result_no_CF_OF"
+                   (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Bop Sub (Var "x" F64) (LW 1 64))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zinc" CTy"Zmonop_name")
+               (Apply
+                 (Call "write_arith_result_no_CF_OF"
+                   (ATy qTy (PTy uTy qTy))
+                   (TP
+                     (sqbkt (Var "s" CTy"Zsize")
+                            (Bop Add (Var "x" F64) (LW 1 64))
+                            (Var "ea" CTy"Zea")))) qVar"state"))
+             ((LC "Zneg" CTy"Zmonop_name")
+               (Apply
+                 (Call "FlagUnspecified" (ATy qTy (PTy uTy qTy))
+                   (LC "Z_CF" CTy"Zeflags"))
+                 (Mop Snd
+                   (Apply
+                     (Call "write_arith_result_no_CF_OF"
+                       (ATy qTy (PTy uTy qTy))
+                       (TP
+                         (sqbkt (Var "s" CTy"Zsize")
+                                (Mop Neg (Var "x" F64))
+                                (Var "ea" CTy"Zea")))) qVar"state"))))))))
+
+
+(Def "read_cond" (Var "c" CTy"Zcond")
+  (Close qVar"state"
+    (CS (Var "c" CTy"Zcond")
+      (sqbkt ((LC "Z_O" CTy"Zcond")
+               (Apply (Const "OF" (ATy qTy (PTy bTy qTy))) qVar"state"))
+             ((LC "Z_NO" CTy"Zcond")
+               (Let (TP (sqbkt bVar"v" qVar"s"))
+                 (Apply (Const "OF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (TP (sqbkt (Mop Not bVar"v") qVar"s"))))
+             ((LC "Z_B" CTy"Zcond")
+               (Apply (Const "CF" (ATy qTy (PTy bTy qTy))) qVar"state"))
+             ((LC "Z_NB" CTy"Zcond")
+               (Let (TP (sqbkt bVar"v" qVar"s"))
+                 (Apply (Const "CF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (TP (sqbkt (Mop Not bVar"v") qVar"s"))))
+             ((LC "Z_E" CTy"Zcond")
+               (Apply (Const "ZF" (ATy qTy (PTy bTy qTy))) qVar"state"))
+             ((LC "Z_NE" CTy"Zcond")
+               (Let (TP (sqbkt bVar"v" qVar"s"))
+                 (Apply (Const "ZF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (TP (sqbkt (Mop Not bVar"v") qVar"s"))))
+             ((LC "Z_A" CTy"Zcond")
+               (CS
+                 (TP
+                   (sqbkt (Apply
+                            (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                              qVar"state") (LC "Z_CF" CTy"Zeflags"))
+                          (Apply
+                            (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                              qVar"state") (LC "Z_ZF" CTy"Zeflags"))))
+                 (sqbkt ((TP (sqbkt (Mop Some LF) (Mop Some LF)))
+                          (TP (sqbkt LT qVar"state")))
+                        ((TP (sqbkt (Mop Some LT) (AVar (OTy bTy))))
+                          (TP (sqbkt LF qVar"state")))
+                        ((TP (sqbkt (AVar (OTy bTy)) (Mop Some LT)))
+                          (TP (sqbkt LF qVar"state")))
+                        ((AVar (PTy (OTy bTy) (OTy bTy)))
+                          (Apply
+                            (Call "raise'exception"
+                              (ATy qTy (PTy bTy qTy))
+                              (Call "BadFlagAccess" CTy"exception"
+                                (CC(sqbkt LS"read_cond: "
+                                          (Mop (Cast sTy)
+                                            (Var "c" CTy"Zcond"))))))
+                            qVar"state")))))
+             ((LC "Z_NA" CTy"Zcond")
+               (CS
+                 (TP
+                   (sqbkt (Apply
+                            (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                              qVar"state") (LC "Z_CF" CTy"Zeflags"))
+                          (Apply
+                            (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                              qVar"state") (LC "Z_ZF" CTy"Zeflags"))))
+                 (sqbkt ((TP (sqbkt (Mop Some LT) (AVar (OTy bTy))))
+                          (TP (sqbkt LT qVar"state")))
+                        ((TP (sqbkt (AVar (OTy bTy)) (Mop Some LT)))
+                          (TP (sqbkt LT qVar"state")))
+                        ((TP (sqbkt (Mop Some LF) (Mop Some LF)))
+                          (TP (sqbkt LF qVar"state")))
+                        ((AVar (PTy (OTy bTy) (OTy bTy)))
+                          (Apply
+                            (Call "raise'exception"
+                              (ATy qTy (PTy bTy qTy))
+                              (Call "BadFlagAccess" CTy"exception"
+                                (CC(sqbkt LS"read_cond: "
+                                          (Mop (Cast sTy)
+                                            (Var "c" CTy"Zcond"))))))
+                            qVar"state")))))
+             ((LC "Z_S" CTy"Zcond")
+               (Apply (Const "SF" (ATy qTy (PTy bTy qTy))) qVar"state"))
+             ((LC "Z_NS" CTy"Zcond")
+               (Let (TP (sqbkt bVar"v" qVar"s"))
+                 (Apply (Const "SF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (TP (sqbkt (Mop Not bVar"v") qVar"s"))))
+             ((LC "Z_P" CTy"Zcond")
+               (Apply (Const "PF" (ATy qTy (PTy bTy qTy))) qVar"state"))
+             ((LC "Z_NP" CTy"Zcond")
+               (Let (TP (sqbkt bVar"v" qVar"s"))
+                 (Apply (Const "PF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (TP (sqbkt (Mop Not bVar"v") qVar"s"))))
+             ((LC "Z_L" CTy"Zcond")
+               (Let (TP (sqbkt bVar"v" qVar"s"))
+                 (Apply (Const "SF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (Let (TP (sqbkt bVar"v" qVar"s"))
+                   (Let (TP (sqbkt bVar"v0" qVar"s"))
+                     (Apply (Const "OF" (ATy qTy (PTy bTy qTy))) qVar"s")
+                     (TP (sqbkt (EQ bVar"v" bVar"v0") qVar"s")))
+                   (TP (sqbkt (Mop Not bVar"v") qVar"s")))))
+             ((LC "Z_NL" CTy"Zcond")
+               (Let (TP (sqbkt bVar"v" qVar"s"))
+                 (Apply (Const "SF" (ATy qTy (PTy bTy qTy))) qVar"state")
+                 (Let (TP (sqbkt bVar"v0" qVar"s"))
+                   (Apply (Const "OF" (ATy qTy (PTy bTy qTy))) qVar"s")
+                   (TP (sqbkt (EQ bVar"v" bVar"v0") qVar"s")))))
+             ((LC "Z_G" CTy"Zcond")
+               (CS
+                 (TP
+                   (sqbkt (Apply
+                            (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                              qVar"state") (LC "Z_SF" CTy"Zeflags"))
+                          (Apply
+                            (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                              qVar"state") (LC "Z_OF" CTy"Zeflags"))))
+                 (sqbkt ((TP
+                            (sqbkt (Mop Some bVar"a") (Mop Some bVar"b")))
+                          (Let (TP (sqbkt bVar"v" qVar"s"))
+                            (Apply (Const "ZF" (ATy qTy (PTy bTy qTy)))
+                              qVar"state")
+                            (TP
+                              (sqbkt (Bop And (EQ bVar"a" bVar"b")
+                                       (Mop Not bVar"v")) qVar"s"))))
+                        ((AVar (PTy (OTy bTy) (OTy bTy)))
+                          (CS
+                            (Apply
+                              (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                                qVar"state") (LC "Z_ZF" CTy"Zeflags"))
+                            (sqbkt ((Mop Some LT)
+                                     (TP (sqbkt LF qVar"state")))
+                                   ((AVar (OTy bTy))
+                                     (Apply
+                                       (Call "raise'exception"
+                                         (ATy qTy (PTy bTy qTy))
+                                         (Call "BadFlagAccess"
+                                           CTy"exception"
+                                           (CC(sqbkt LS"read_cond: "
+                                                     (Mop (Cast sTy)
+                                                       (Var "c"
+                                                         CTy"Zcond"))))))
+                                       qVar"state"))))))))
+             ((LC "Z_NG" CTy"Zcond")
+               (CS
+                 (TP
+                   (sqbkt (Apply
+                            (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                              qVar"state") (LC "Z_SF" CTy"Zeflags"))
+                          (Apply
+                            (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                              qVar"state") (LC "Z_OF" CTy"Zeflags"))))
+                 (sqbkt ((TP
+                            (sqbkt (Mop Some bVar"a") (Mop Some bVar"b")))
+                          (Let (TP (sqbkt bVar"v" qVar"s"))
+                            (Apply (Const "ZF" (ATy qTy (PTy bTy qTy)))
+                              qVar"state")
+                            (TP
+                              (sqbkt (Bop Or
+                                       (Mop Not (EQ bVar"a" bVar"b"))
+                                       bVar"v") qVar"s"))))
+                        ((AVar (PTy (OTy bTy) (OTy bTy)))
+                          (CS
+                            (Apply
+                              (Dest "EFLAGS" (ATy CTy"Zeflags" (OTy bTy))
+                                qVar"state") (LC "Z_ZF" CTy"Zeflags"))
+                            (sqbkt ((Mop Some LT)
+                                     (TP (sqbkt LT qVar"state")))
+                                   ((AVar (OTy bTy))
+                                     (Apply
+                                       (Call "raise'exception"
+                                         (ATy qTy (PTy bTy qTy))
+                                         (Call "BadFlagAccess"
+                                           CTy"exception"
+                                           (CC(sqbkt LS"read_cond: "
+                                                     (Mop (Cast sTy)
+                                                       (Var "c"
+                                                         CTy"Zcond"))))))
+                                       qVar"state"))))))))
+             ((LC "Z_ALWAYS" CTy"Zcond") (TP (sqbkt LT qVar"state")))))))
+
+
+(Def "x64_pop_aux" qVar"state"
+  (Let (Var "v" F64)
+    (Apply (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+      (LC "RSP" CTy"Zreg"))
+    (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+      (Apply (Call "mem64" (ATy qTy (PTy F64 qTy)) (Var "v" F64))
+        qVar"state")
+      (TP
+        (sqbkt (Var "v0" F64)
+               (Rupd "REG"
+                 (TP
+                   (sqbkt qVar"s"
+                          (Fupd (Dest "REG" (ATy CTy"Zreg" F64) qVar"s")
+                            (LC "RSP" CTy"Zreg")
+                            (Bop Add (Var "v" F64) (LW 8 64)))))))))))
+
+
+(Def "x64_pop" (Var "rm" CTy"Zrm")
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+      (Apply (Const "x64_pop_aux" (ATy qTy (PTy F64 qTy))) qVar"state")
+      (Apply
+        (Call "write'EA" (ATy qTy (PTy uTy qTy))
+          (TP
+            (sqbkt (Var "v0" F64)
+                   (Mop Fst
+                     (Apply
+                       (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+                         (TP
+                           (sqbkt (Const "Z64" CTy"Zsize")
+                                  (Var "rm" CTy"Zrm")))) qVar"state")))))
+        qVar"s"))))
+
+
+(Def "x64_pop_rip" qVar"state"
+  (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+    (Apply (Const "x64_pop_aux" (ATy qTy (PTy F64 qTy))) qVar"state")
+    (TP (sqbkt LU (Rupd "RIP" (TP (sqbkt qVar"s" (Var "v" F64))))))))
+
+
+(Def "x64_push_aux" (Var "w" F64)
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Sub
+        (Apply (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+          (LC "RSP" CTy"Zreg")) (LW 8 64))
+      (Apply
+        (Call "write'mem64" (ATy qTy (PTy uTy qTy))
+          (TP (sqbkt (Var "w" F64) (Var "v" F64))))
+        (Rupd "REG"
+          (TP
+            (sqbkt qVar"state"
+                   (Fupd (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                     (LC "RSP" CTy"Zreg") (Var "v" F64)))))))))
+
+
+(Def "x64_push" (Var "imm_rm" CTy"Zimm_rm")
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+      (Apply
+        (Call "EA" (ATy qTy (PTy F64 qTy))
+          (Mop Fst
+            (Apply
+              (Call "ea_Zimm_rm" (ATy qTy (PTy CTy"Zea" qTy))
+                (TP
+                  (sqbkt (Const "Z64" CTy"Zsize")
+                         (Var "imm_rm" CTy"Zimm_rm")))) qVar"state")))
+        qVar"state")
+      (Apply (Call "x64_push_aux" (ATy qTy (PTy uTy qTy)) (Var "v" F64))
+        qVar"s"))))
+
+
+(Def "x64_push_rip" qVar"state"
+  (Apply
+    (Call "x64_push_aux" (ATy qTy (PTy uTy qTy))
+      (Dest "RIP" F64 qVar"state")) qVar"state"))
+
+
+(Def "x64_drop" (Var "imm" F64)
+  (Close qVar"state"
+    (Let qVar"s"
+      (ITE (Mop Not (EQ (EX (Var "imm" F64) (LN 7) (LN 0) F8) (LW 0 8)))
+        (Mop Snd
+          (Apply
+            (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+              (Call "FAIL" CTy"exception" (LS"x64_drop"))) qVar"state"))
+        qVar"state")
+      (TP
+        (sqbkt LU
+               (Rupd "REG"
+                 (TP
+                   (sqbkt qVar"s"
+                          (Fupd (Dest "REG" (ATy CTy"Zreg" F64) qVar"s")
+                            (LC "RSP" CTy"Zreg")
+                            (Bop Add
+                              (Apply
+                                (Dest "REG" (ATy CTy"Zreg" F64) qVar"s")
+                                (LC "RSP" CTy"Zreg")) (Var "imm" F64)))))))))))
+
+
+(Def "dfn'Zbinop"
+  (TP
+    (sqbkt (Var "bop" CTy"Zbinop_name") (Var "size" CTy"Zsize")
+           (Var "dst_src" CTy"Zdest_src")))
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" (PTy CTy"Zea" (PTy F64 F64))) qVar"s"))
+      (Apply
+        (Call "read_dest_src_ea"
+          (ATy qTy (PTy (PTy CTy"Zea" (PTy F64 F64)) qTy))
+          (TP
+            (sqbkt (Var "size" CTy"Zsize") (Var "dst_src" CTy"Zdest_src"))))
+        qVar"state")
+      (Let
+        (TP
+          (sqbkt (Var "ea" CTy"Zea") (Var "val_dst" F64)
+                 (Var "val_src" F64)))
+        (Var "v" (PTy CTy"Zea" (PTy F64 F64)))
+        (Apply
+          (Call "write_binop" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Var "size" CTy"Zsize") (Var "bop" CTy"Zbinop_name")
+                     (Var "val_dst" F64) (Var "val_src" F64)
+                     (Var "ea" CTy"Zea")))) qVar"s")))))
+
+
+(Def "dfn'Zcall" (Var "imm_rm" CTy"Zimm_rm")
+  (Close qVar"state"
+    (Let qVar"s"
+      (Mop Snd
+        (Apply (Const "x64_push_rip" (ATy qTy (PTy uTy qTy))) qVar"state"))
+      (Apply
+        (Call "jump_to_ea" (ATy qTy (PTy uTy qTy))
+          (Mop Fst
+            (Apply
+              (Call "ea_Zimm_rm" (ATy qTy (PTy CTy"Zea" qTy))
+                (TP
+                  (sqbkt (Const "Z64" CTy"Zsize")
+                         (Var "imm_rm" CTy"Zimm_rm")))) qVar"s")))
+        qVar"s"))))
+
+
+(Def "dfn'Zcmpxchg"
+  (TP
+    (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm") (Var "r" CTy"Zreg")))
+  (Close qVar"state"
+    (Let (Var "ea_src" CTy"Zea")
+      (Call "Zea_r" CTy"Zea"
+        (TP (sqbkt (Var "size" CTy"Zsize") (Var "r" CTy"Zreg"))))
+      (Let (Var "v" CTy"Zea")
+        (Mop Fst
+          (Apply
+            (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+              (TP (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm"))))
+            qVar"state"))
+        (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+          (Apply (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "v" CTy"Zea"))
+            qVar"state")
+          (Let (TP (sqbkt (Var "v1" F64) qVar"s"))
+            (Apply
+              (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "ea_src" CTy"Zea"))
+              qVar"s")
+            (Let qVar"s"
+              (Mop Snd
+                (Apply
+                  (Call "write_binop" (ATy qTy (PTy uTy qTy))
+                    (TP
+                      (sqbkt (Var "size" CTy"Zsize")
+                             (LC "Zcmp" CTy"Zbinop_name") (Var "v1" F64)
+                             (Var "v0" F64) (Var "ea_src" CTy"Zea"))))
+                  qVar"s"))
+              (ITE (EQ (Var "v1" F64) (Var "v0" F64))
+                (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+                  (Apply
+                    (Call "EA" (ATy qTy (PTy F64 qTy))
+                      (Var "ea_src" CTy"Zea")) qVar"s")
+                  (Apply
+                    (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                      (TP (sqbkt (Var "v0" F64) (Var "v" CTy"Zea"))))
+                    qVar"s"))
+                (Apply
+                  (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                    (TP
+                      (sqbkt (Var "v0" F64)
+                             (Call "Zea_r" CTy"Zea"
+                               (TP
+                                 (sqbkt (Var "size" CTy"Zsize")
+                                        (LC "RAX" CTy"Zreg")))))))
+                  qVar"s")))))))))
+
+
+(Def "dfn'Zcpuid" qVar"state"
+  (Let qVar"s"
+    (Rupd "ICACHE"
+      (TP (sqbkt qVar"state" (Dest "MEM" (ATy F64 (OTy F8)) qVar"state"))))
+    (Let qVar"s"
+      (Rupd "REG"
+        (TP
+          (sqbkt qVar"s"
+                 (Fupd (Dest "REG" (ATy CTy"Zreg" F64) qVar"s")
+                   (LC "RAX" CTy"Zreg") (LX F64)))))
+      (Let qVar"s"
+        (Rupd "REG"
+          (TP
+            (sqbkt qVar"s"
+                   (Fupd (Dest "REG" (ATy CTy"Zreg" F64) qVar"s")
+                     (LC "RBX" CTy"Zreg") (LX F64)))))
+        (Let qVar"s"
+          (Rupd "REG"
+            (TP
+              (sqbkt qVar"s"
+                     (Fupd (Dest "REG" (ATy CTy"Zreg" F64) qVar"s")
+                       (LC "RCX" CTy"Zreg") (LX F64)))))
+          (TP
+            (sqbkt LU
+                   (Rupd "REG"
+                     (TP
+                       (sqbkt qVar"s"
+                              (Fupd
+                                (Dest "REG" (ATy CTy"Zreg" F64) qVar"s")
+                                (LC "RDX" CTy"Zreg") (LX F64))))))))))))
+
+
+(Def "dfn'Zdiv" (TP (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm")))
+  (Close qVar"state"
+    (Let nVar"w" (Call "value_width" nTy (Var "size" CTy"Zsize"))
+      (Let (Var "ea_eax" CTy"Zea")
+        (Call "Zea_r" CTy"Zea"
+          (TP (sqbkt (Var "size" CTy"Zsize") (LC "RAX" CTy"Zreg"))))
+        (Let (Var "ea_edx" CTy"Zea")
+          (Call "Zea_r" CTy"Zea"
+            (TP (sqbkt (Var "size" CTy"Zsize") (LC "RAX" CTy"Zreg"))))
+          (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+            (Apply
+              (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "ea_eax" CTy"Zea"))
+              qVar"state")
+            (Let (TP (sqbkt nVar"v" qVar"s"))
+              (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+                (Apply
+                  (Call "EA" (ATy qTy (PTy F64 qTy))
+                    (Var "ea_edx" CTy"Zea")) qVar"s")
+                (TP
+                  (sqbkt (Bop Add
+                           (Bop Mul (Mop (Cast nTy) (Var "v" F64))
+                             nVar"w") (Mop (Cast nTy) (Var "v0" F64)))
+                         qVar"s")))
+              (Let (TP (sqbkt nVar"v0" qVar"s"))
+                (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+                  (Apply
+                    (Call "EA" (ATy qTy (PTy F64 qTy))
+                      (Mop Fst
+                        (Apply
+                          (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+                            (TP
+                              (sqbkt (Var "size" CTy"Zsize")
+                                     (Var "rm" CTy"Zrm")))) qVar"s")))
+                    qVar"s")
+                  (TP (sqbkt (Mop (Cast nTy) (Var "v" F64)) qVar"s")))
+                (Let nVar"q" (Bop Div nVar"v" nVar"v0")
+                  (Apply (Const "erase_eflags" (ATy qTy (PTy uTy qTy)))
+                    (Mop Snd
+                      (Apply
+                        (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                          (TP
+                            (sqbkt (Mop (Cast F64)
+                                     (Bop Mod nVar"v" nVar"v0"))
+                                   (Var "ea_edx" CTy"Zea"))))
+                        (Mop Snd
+                          (Apply
+                            (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                              (TP
+                                (sqbkt (Mop (Cast F64) nVar"q")
+                                       (Var "ea_eax" CTy"Zea"))))
+                            (ITE
+                              (Bop Or (EQ nVar"v0" (LN 0))
+                                (Bop Le nVar"w" nVar"q"))
+                              (Mop Snd
+                                (Apply
+                                  (Call "raise'exception"
+                                    (ATy qTy (PTy uTy qTy))
+                                    (Call "FAIL" CTy"exception"
+                                      (LS"division"))) qVar"s")) qVar"s")))))))))))))))
+
+
+(Def "dfn'Zjcc" (TP (sqbkt (Var "cond" CTy"Zcond") (Var "imm" F64)))
+  (Close qVar"state"
+    (Let (TP (sqbkt bVar"v" qVar"s"))
+      (Apply
+        (Call "read_cond" (ATy qTy (PTy bTy qTy)) (Var "cond" CTy"Zcond"))
+        qVar"state")
+      (TP
+        (sqbkt LU
+               (ITE bVar"v"
+                 (Rupd "RIP"
+                   (TP
+                     (sqbkt qVar"s"
+                            (Bop Add (Dest "RIP" F64 qVar"s")
+                              (Var "imm" F64))))) qVar"s"))))))
+
+
+(Def "dfn'Zjmp" (Var "rm" CTy"Zrm")
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+      (Apply
+        (Call "EA" (ATy qTy (PTy F64 qTy))
+          (Mop Fst
+            (Apply
+              (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+                (TP (sqbkt (Const "Z64" CTy"Zsize") (Var "rm" CTy"Zrm"))))
+              qVar"state"))) qVar"state")
+      (TP (sqbkt LU (Rupd "RIP" (TP (sqbkt qVar"s" (Var "v" F64)))))))))
+
+
+(Def "dfn'Zlea"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "dst_src" CTy"Zdest_src")))
+  (Close qVar"state"
+    (Apply
+      (Call "write'EA" (ATy qTy (PTy uTy qTy))
+        (TP
+          (sqbkt (Call "get_ea_address" F64
+                   (Mop Fst
+                     (Apply
+                       (Call "ea_Zsrc" (ATy qTy (PTy CTy"Zea" qTy))
+                         (TP
+                           (sqbkt (Var "size" CTy"Zsize")
+                                  (Var "dst_src" CTy"Zdest_src"))))
+                       qVar"state")))
+                 (Mop Fst
+                   (Apply
+                     (Call "ea_Zdest" (ATy qTy (PTy CTy"Zea" qTy))
+                       (TP
+                         (sqbkt (Var "size" CTy"Zsize")
+                                (Var "dst_src" CTy"Zdest_src"))))
+                     qVar"state"))))) qVar"state")))
+
+
+(Def "dfn'Zloop" (TP (sqbkt (Var "cond" CTy"Zcond") (Var "imm" F64)))
+  (Close qVar"state"
+    (Let (Var "v" F64)
+      (Bop Sub
+        (Apply (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+          (LC "RCX" CTy"Zreg")) (LW 1 64))
+      (Let (TP (sqbkt bVar"v0" qVar"s"))
+        (Apply
+          (Call "read_cond" (ATy qTy (PTy bTy qTy))
+            (Var "cond" CTy"Zcond"))
+          (Rupd "REG"
+            (TP
+              (sqbkt qVar"state"
+                     (Fupd (Dest "REG" (ATy CTy"Zreg" F64) qVar"state")
+                       (LC "RCX" CTy"Zreg") (Var "v" F64))))))
+        (TP
+          (sqbkt LU
+                 (ITE
+                   (Bop And (Mop Not (EQ (Var "v" F64) (LW 0 64)))
+                     bVar"v0")
+                   (Rupd "RIP"
+                     (TP
+                       (sqbkt qVar"s"
+                              (Bop Add (Dest "RIP" F64 qVar"s")
+                                (Var "imm" F64))))) qVar"s")))))))
+
+
+(Def "dfn'Zmonop"
+  (TP
+    (sqbkt (Var "mop" CTy"Zmonop_name") (Var "size" CTy"Zsize")
+           (Var "rm" CTy"Zrm")))
+  (Close qVar"state"
+    (Let (Var "v" CTy"Zea")
+      (Mop Fst
+        (Apply
+          (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+            (TP (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm"))))
+          qVar"state"))
+      (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+        (Apply (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "v" CTy"Zea"))
+          qVar"state")
+        (Apply
+          (Call "write_monop" (ATy qTy (PTy uTy qTy))
+            (TP
+              (sqbkt (Var "size" CTy"Zsize") (Var "mop" CTy"Zmonop_name")
+                     (Var "v0" F64) (Var "v" CTy"Zea")))) qVar"s")))))
+
+
+(Def "dfn'Zmov"
+  (TP
+    (sqbkt (Var "cond" CTy"Zcond") (Var "size" CTy"Zsize")
+           (Var "dst_src" CTy"Zdest_src")))
+  (Close qVar"state"
+    (Let (TP (sqbkt bVar"v" qVar"s"))
+      (Apply
+        (Call "read_cond" (ATy qTy (PTy bTy qTy)) (Var "cond" CTy"Zcond"))
+        qVar"state")
+      (ITE bVar"v"
+        (Let (TP (sqbkt (Var "v0" F64) qVar"s0"))
+          (Apply
+            (Call "EA" (ATy qTy (PTy F64 qTy))
+              (Mop Fst
+                (Apply
+                  (Call "ea_Zsrc" (ATy qTy (PTy CTy"Zea" qTy))
+                    (TP
+                      (sqbkt (Var "size" CTy"Zsize")
+                             (Var "dst_src" CTy"Zdest_src")))) qVar"s")))
+            qVar"s")
+          (Apply
+            (Call "write'EA" (ATy qTy (PTy uTy qTy))
+              (TP
+                (sqbkt (Var "v0" F64)
+                       (Mop Fst
+                         (Apply
+                           (Call "ea_Zdest" (ATy qTy (PTy CTy"Zea" qTy))
+                             (TP
+                               (sqbkt (Var "size" CTy"Zsize")
+                                      (Var "dst_src" CTy"Zdest_src"))))
+                           qVar"s"))))) qVar"s0"))
+        (TP (sqbkt LU qVar"s"))))))
+
+
+(Def "dfn'Zmovzx"
+  (TP
+    (sqbkt (Var "size1" CTy"Zsize") (Var "dst_src" CTy"Zdest_src")
+           (Var "size2" CTy"Zsize")))
+  (Close qVar"state"
+    (Let (TP (sqbkt (Var "v" (PTy F64 CTy"Zea")) qVar"s"))
+      (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+        (Apply
+          (Call "EA" (ATy qTy (PTy F64 qTy))
+            (Mop Fst
+              (Apply
+                (Call "ea_Zsrc" (ATy qTy (PTy CTy"Zea" qTy))
+                  (TP
+                    (sqbkt (Var "size1" CTy"Zsize")
+                           (Var "dst_src" CTy"Zdest_src")))) qVar"state")))
+          qVar"state")
+        (TP
+          (sqbkt (TP
+                   (sqbkt (Var "v0" F64)
+                          (Mop Fst
+                            (Apply
+                              (Call "ea_Zdest"
+                                (ATy qTy (PTy CTy"Zea" qTy))
+                                (TP
+                                  (sqbkt (Var "size2" CTy"Zsize")
+                                         (Var "dst_src" CTy"Zdest_src"))))
+                              qVar"state")))) qVar"s")))
+      (Apply
+        (Call "write'EA" (ATy qTy (PTy uTy qTy))
+          (Var "v" (PTy F64 CTy"Zea"))) qVar"s"))))
+
+
+(Def "dfn'Zmul" (TP (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm")))
+  (Close qVar"state"
+    (Let (Var "ea_eax" CTy"Zea")
+      (Call "Zea_r" CTy"Zea"
+        (TP (sqbkt (Var "size" CTy"Zsize") (LC "RAX" CTy"Zreg"))))
+      (Let (TP (sqbkt (Var "v" F64) qVar"s"))
+        (Apply (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "ea_eax" CTy"Zea"))
+          qVar"state")
+        (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+          (Apply
+            (Call "EA" (ATy qTy (PTy F64 qTy))
+              (Mop Fst
+                (Apply
+                  (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+                    (TP
+                      (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm"))))
+                  qVar"s"))) qVar"s")
+          (Apply (Const "erase_eflags" (ATy qTy (PTy uTy qTy)))
+            (CS (Var "size" CTy"Zsize")
+              (sqbkt ((Call "Z8" CTy"Zsize" (AVar bTy))
+                       (Mop Snd
+                         (Apply
+                           (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                             (TP
+                               (sqbkt (Bop Mul (Var "v" F64)
+                                        (Var "v0" F64))
+                                      (Call "Zea_r" CTy"Zea"
+                                        (TP
+                                          (sqbkt (Const "Z16" CTy"Zsize")
+                                                 (LC "RAX" CTy"Zreg")))))))
+                           qVar"s")))
+                     ((AVar CTy"Zsize")
+                       (Mop Snd
+                         (Apply
+                           (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                             (TP
+                               (sqbkt (Mop (Cast F64)
+                                        (Bop Div
+                                          (Bop Mul
+                                            (Mop (Cast nTy) (Var "v" F64))
+                                            (Mop (Cast nTy)
+                                              (Var "v0" F64)))
+                                          (Call "value_width" nTy
+                                            (Var "size" CTy"Zsize"))))
+                                      (Call "Zea_r" CTy"Zea"
+                                        (TP
+                                          (sqbkt (Var "size" CTy"Zsize")
+                                                 (LC "RDX" CTy"Zreg")))))))
+                           (Mop Snd
+                             (Apply
+                               (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                                 (TP
+                                   (sqbkt (Bop Mul (Var "v" F64)
+                                            (Var "v0" F64))
+                                          (Var "ea_eax" CTy"Zea"))))
+                               qVar"s")))))))))))))
+
+
+(Def0 "dfn'Znop" LU)
+
+
+(Def "dfn'Zpop" (Var "rm" CTy"Zrm")
+  (Close qVar"state"
+    (Apply (Call "x64_pop" (ATy qTy (PTy uTy qTy)) (Var "rm" CTy"Zrm"))
+      qVar"state")))
+
+
+(Def "dfn'Zpush" (Var "imm_rm" CTy"Zimm_rm")
+  (Close qVar"state"
+    (Apply
+      (Call "x64_push" (ATy qTy (PTy uTy qTy))
+        (Var "imm_rm" CTy"Zimm_rm")) qVar"state")))
+
+
+(Def "dfn'Zret" (Var "imm" F64)
+  (Close qVar"state"
+    (Apply (Call "x64_drop" (ATy qTy (PTy uTy qTy)) (Var "imm" F64))
+      (Mop Snd
+        (Apply (Const "x64_pop_rip" (ATy qTy (PTy uTy qTy))) qVar"state")))))
+
+
+(Def "dfn'Zxadd"
+  (TP
+    (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm") (Var "r" CTy"Zreg")))
+  (Close qVar"state"
+    (Let (Var "ea_src" CTy"Zea")
+      (Call "Zea_r" CTy"Zea"
+        (TP (sqbkt (Var "size" CTy"Zsize") (Var "r" CTy"Zreg"))))
+      (Let (Var "v" CTy"Zea")
+        (Mop Fst
+          (Apply
+            (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+              (TP (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm"))))
+            qVar"state"))
+        (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+          (Apply
+            (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "ea_src" CTy"Zea"))
+            qVar"state")
+          (Let (TP (sqbkt (Var "v1" F64) qVar"s"))
+            (Apply (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "v" CTy"Zea"))
+              qVar"s")
+            (Apply
+              (Call "write_binop" (ATy qTy (PTy uTy qTy))
+                (TP
+                  (sqbkt (Var "size" CTy"Zsize")
+                         (LC "Zadd" CTy"Zbinop_name") (Var "v0" F64)
+                         (Var "v1" F64) (Var "v" CTy"Zea"))))
+              (Mop Snd
+                (Apply
+                  (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                    (TP (sqbkt (Var "v1" F64) (Var "ea_src" CTy"Zea"))))
+                  qVar"s")))))))))
+
+
+(Def "dfn'Zxchg"
+  (TP
+    (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm") (Var "r" CTy"Zreg")))
+  (Close qVar"state"
+    (Let (Var "ea_src" CTy"Zea")
+      (Call "Zea_r" CTy"Zea"
+        (TP (sqbkt (Var "size" CTy"Zsize") (Var "r" CTy"Zreg"))))
+      (Let (Var "v" CTy"Zea")
+        (Mop Fst
+          (Apply
+            (Call "ea_Zrm" (ATy qTy (PTy CTy"Zea" qTy))
+              (TP (sqbkt (Var "size" CTy"Zsize") (Var "rm" CTy"Zrm"))))
+            qVar"state"))
+        (Let (TP (sqbkt (Var "v0" F64) qVar"s"))
+          (Apply
+            (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "ea_src" CTy"Zea"))
+            qVar"state")
+          (Let (TP (sqbkt (Var "v1" F64) qVar"s"))
+            (Apply (Call "EA" (ATy qTy (PTy F64 qTy)) (Var "v" CTy"Zea"))
+              qVar"s")
+            (Apply
+              (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                (TP (sqbkt (Var "v0" F64) (Var "v" CTy"Zea"))))
+              (Mop Snd
+                (Apply
+                  (Call "write'EA" (ATy qTy (PTy uTy qTy))
+                    (TP (sqbkt (Var "v1" F64) (Var "ea_src" CTy"Zea"))))
+                  qVar"s")))))))))
+
+
+(Def "Run" (Var "v0" CTy"instruction")
+  (Close qVar"state"
+    (CS (Var "v0" CTy"instruction")
+      (sqbkt ((Const "Zcpuid" CTy"instruction")
+               (Apply (Const "dfn'Zcpuid" (ATy qTy (PTy uTy qTy)))
+                 qVar"state"))
+             ((Const "Znop" CTy"instruction")
+               (TP (sqbkt (Const "dfn'Znop" uTy) qVar"state")))
+             ((Call "Zbinop" CTy"instruction"
+                 (Var "v1"
+                   (PTy CTy"Zbinop_name" (PTy CTy"Zsize" CTy"Zdest_src"))))
+               (Apply
+                 (Call "dfn'Zbinop" (ATy qTy (PTy uTy qTy))
+                   (Var "v1"
+                     (PTy CTy"Zbinop_name"
+                       (PTy CTy"Zsize" CTy"Zdest_src")))) qVar"state"))
+             ((Call "Zcall" CTy"instruction" (Var "v2" CTy"Zimm_rm"))
+               (Apply
+                 (Call "dfn'Zcall" (ATy qTy (PTy uTy qTy))
+                   (Var "v2" CTy"Zimm_rm")) qVar"state"))
+             ((Call "Zcmpxchg" CTy"instruction"
+                 (Var "v3" (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))
+               (Apply
+                 (Call "dfn'Zcmpxchg" (ATy qTy (PTy uTy qTy))
+                   (Var "v3" (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))
+                 qVar"state"))
+             ((Call "Zdiv" CTy"instruction"
+                 (Var "v4" (PTy CTy"Zsize" CTy"Zrm")))
+               (Apply
+                 (Call "dfn'Zdiv" (ATy qTy (PTy uTy qTy))
+                   (Var "v4" (PTy CTy"Zsize" CTy"Zrm"))) qVar"state"))
+             ((Call "Zjcc" CTy"instruction"
+                 (Var "v5" (PTy CTy"Zcond" F64)))
+               (Apply
+                 (Call "dfn'Zjcc" (ATy qTy (PTy uTy qTy))
+                   (Var "v5" (PTy CTy"Zcond" F64))) qVar"state"))
+             ((Call "Zjmp" CTy"instruction" (Var "v6" CTy"Zrm"))
+               (Apply
+                 (Call "dfn'Zjmp" (ATy qTy (PTy uTy qTy))
+                   (Var "v6" CTy"Zrm")) qVar"state"))
+             ((Call "Zlea" CTy"instruction"
+                 (Var "v7" (PTy CTy"Zsize" CTy"Zdest_src")))
+               (Apply
+                 (Call "dfn'Zlea" (ATy qTy (PTy uTy qTy))
+                   (Var "v7" (PTy CTy"Zsize" CTy"Zdest_src")))
+                 qVar"state"))
+             ((Call "Zloop" CTy"instruction"
+                 (Var "v8" (PTy CTy"Zcond" F64)))
+               (Apply
+                 (Call "dfn'Zloop" (ATy qTy (PTy uTy qTy))
+                   (Var "v8" (PTy CTy"Zcond" F64))) qVar"state"))
+             ((Call "Zmonop" CTy"instruction"
+                 (Var "v9"
+                   (PTy CTy"Zmonop_name" (PTy CTy"Zsize" CTy"Zrm"))))
+               (Apply
+                 (Call "dfn'Zmonop" (ATy qTy (PTy uTy qTy))
+                   (Var "v9"
+                     (PTy CTy"Zmonop_name" (PTy CTy"Zsize" CTy"Zrm"))))
+                 qVar"state"))
+             ((Call "Zmov" CTy"instruction"
+                 (Var "v10"
+                   (PTy CTy"Zcond" (PTy CTy"Zsize" CTy"Zdest_src"))))
+               (Apply
+                 (Call "dfn'Zmov" (ATy qTy (PTy uTy qTy))
+                   (Var "v10"
+                     (PTy CTy"Zcond" (PTy CTy"Zsize" CTy"Zdest_src"))))
+                 qVar"state"))
+             ((Call "Zmovzx" CTy"instruction"
+                 (Var "v11"
+                   (PTy CTy"Zsize" (PTy CTy"Zdest_src" CTy"Zsize"))))
+               (Apply
+                 (Call "dfn'Zmovzx" (ATy qTy (PTy uTy qTy))
+                   (Var "v11"
+                     (PTy CTy"Zsize" (PTy CTy"Zdest_src" CTy"Zsize"))))
+                 qVar"state"))
+             ((Call "Zmul" CTy"instruction"
+                 (Var "v12" (PTy CTy"Zsize" CTy"Zrm")))
+               (Apply
+                 (Call "dfn'Zmul" (ATy qTy (PTy uTy qTy))
+                   (Var "v12" (PTy CTy"Zsize" CTy"Zrm"))) qVar"state"))
+             ((Call "Zpop" CTy"instruction" (Var "v13" CTy"Zrm"))
+               (Apply
+                 (Call "dfn'Zpop" (ATy qTy (PTy uTy qTy))
+                   (Var "v13" CTy"Zrm")) qVar"state"))
+             ((Call "Zpush" CTy"instruction" (Var "v14" CTy"Zimm_rm"))
+               (Apply
+                 (Call "dfn'Zpush" (ATy qTy (PTy uTy qTy))
+                   (Var "v14" CTy"Zimm_rm")) qVar"state"))
+             ((Call "Zret" CTy"instruction" (Var "v15" F64))
+               (Apply
+                 (Call "dfn'Zret" (ATy qTy (PTy uTy qTy)) (Var "v15" F64))
+                 qVar"state"))
+             ((Call "Zxadd" CTy"instruction"
+                 (Var "v16" (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))
+               (Apply
+                 (Call "dfn'Zxadd" (ATy qTy (PTy uTy qTy))
+                   (Var "v16" (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))
+                 qVar"state"))
+             ((Call "Zxchg" CTy"instruction"
+                 (Var "v17" (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))
+               (Apply
+                 (Call "dfn'Zxchg" (ATy qTy (PTy uTy qTy))
+                   (Var "v17" (PTy CTy"Zsize" (PTy CTy"Zrm" CTy"Zreg"))))
+                 qVar"state"))))))
+
+
+(Def "immediate8" (Var "strm" (LTy F8))
+  (CS (Var "strm" (LTy F8))
+    (sqbkt ((LLC (sqbkt (Var "b" F8)) (Var "t" (LTy F8)))
+             (TP (sqbkt (Mop (SE F64) (Var "b" F8)) (Var "t" (LTy F8)))))
+           ((AVar (LTy F8)) (LX (PTy F64 (LTy F8)))))))
+
+
+(Def "immediate16" (Var "strm" (LTy F8))
+  (CS (Var "strm" (LTy F8))
+    (sqbkt ((LLC (sqbkt (Var "b1" F8) (Var "b2" F8)) (Var "t" (LTy F8)))
+             (TP
+               (sqbkt (Mop (SE F64)
+                        (CC(sqbkt (Var "b2" F8) (Var "b1" F8))))
+                      (Var "t" (LTy F8)))))
+           ((AVar (LTy F8)) (LX (PTy F64 (LTy F8)))))))
+
+
+(Def "immediate32" (Var "strm" (LTy F8))
+  (CS (Var "strm" (LTy F8))
+    (sqbkt ((LLC
+               (sqbkt (Var "b1" F8) (Var "b2" F8) (Var "b3" F8)
+                      (Var "b4" F8)) (Var "t" (LTy F8)))
+             (TP
+               (sqbkt (Mop (SE F64)
+                        (CC(sqbkt (Var "b4" F8) (Var "b3" F8)
+                                  (Var "b2" F8) (Var "b1" F8))))
+                      (Var "t" (LTy F8)))))
+           ((AVar (LTy F8)) (LX (PTy F64 (LTy F8)))))))
+
+
+(Def "immediate64" (Var "strm" (LTy F8))
+  (CS (Var "strm" (LTy F8))
+    (sqbkt ((LLC
+               (sqbkt (Var "b1" F8) (Var "b2" F8) (Var "b3" F8)
+                      (Var "b4" F8) (Var "b5" F8) (Var "b6" F8)
+                      (Var "b7" F8) (Var "b8" F8)) (Var "t" (LTy F8)))
+             (TP
+               (sqbkt CC(sqbkt (Var "b8" F8) (Var "b7" F8) (Var "b6" F8)
+                               (Var "b5" F8) (Var "b4" F8) (Var "b3" F8)
+                               (Var "b2" F8) (Var "b1" F8))
+                      (Var "t" (LTy F8)))))
+           ((AVar (LTy F8)) (LX (PTy F64 (LTy F8)))))))
+
+
+(Def "immediate"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "strm" (LTy F8))))
+  (CS (Var "size" CTy"Zsize")
+    (sqbkt ((Call "Z8" CTy"Zsize" (AVar bTy))
+             (Call "immediate8" (PTy F64 (LTy F8)) (Var "strm" (LTy F8))))
+           ((Const "Z16" CTy"Zsize")
+             (Call "immediate16" (PTy F64 (LTy F8)) (Var "strm" (LTy F8))))
+           ((AVar CTy"Zsize")
+             (Call "immediate32" (PTy F64 (LTy F8)) (Var "strm" (LTy F8)))))))
+
+
+(Def "full_immediate"
+  (TP (sqbkt (Var "size" CTy"Zsize") (Var "strm" (LTy F8))))
+  (ITE (EQ (Var "size" CTy"Zsize") (Const "Z64" CTy"Zsize"))
+    (Call "immediate64" (PTy F64 (LTy F8)) (Var "strm" (LTy F8)))
+    (Call "immediate" (PTy F64 (LTy F8))
+      (TP (sqbkt (Var "size" CTy"Zsize") (Var "strm" (LTy F8)))))))
+
+
+(Def "rec'REX" (Var "x" F4)
+  (Rec CTy"REX"
+    (sqbkt (Bop Bit (Var "x" F4) (LN 0)) (Bop Bit (Var "x" F4) (LN 2))
+           (Bop Bit (Var "x" F4) (LN 3)) (Bop Bit (Var "x" F4) (LN 1)))))
+
+
+(Def "reg'REX" (Var "x" CTy"REX")
+  (CS (Var "x" CTy"REX")
+    (sqbkt ((Rec CTy"REX" (sqbkt bVar"B" bVar"R" bVar"W" bVar"X"))
+             (Bop Mdfy
+               (Close (TP (sqbkt nVar"i" (AVar bTy)))
+                 (ITB
+                   (sqbkt ((EQ nVar"i" (LN 3)) bVar"W")
+                          ((EQ nVar"i" (LN 2)) bVar"R")
+                          ((EQ nVar"i" (LN 1)) bVar"X")) bVar"B"))
+               (LW 0 4))))))
+
+
+(Def "write'rec'REX" (TP (sqbkt (AVar F4) (Var "x" CTy"REX")))
+  (Call "reg'REX" F4 (Var "x" CTy"REX")))
+
+
+(Def "write'reg'REX" (TP (sqbkt (AVar CTy"REX") (Var "x" F4)))
+  (Call "rec'REX" CTy"REX" (Var "x" F4)))
+
+
+(Def "RexReg" (TP (sqbkt bVar"b" (Var "r" (FTy 3))))
+  (Mop (Cast CTy"Zreg")
+    (CC(sqbkt (Mop (Cast F1) bVar"b") (Var "r" (FTy 3))))))
+
+
+(Def "readDisplacement"
+  (TP (sqbkt (Var "Mod" (FTy 2)) (Var "strm" (LTy F8))))
+  (ITB
+    (sqbkt ((EQ (Var "Mod" (FTy 2)) (LW 1 2))
+             (Call "immediate8" (PTy F64 (LTy F8)) (Var "strm" (LTy F8))))
+           ((EQ (Var "Mod" (FTy 2)) (LW 2 2))
+             (Call "immediate32" (PTy F64 (LTy F8)) (Var "strm" (LTy F8)))))
+    (TP (sqbkt (LW 0 64) (Var "strm" (LTy F8))))))
+
+
+(Def "readSibDisplacement"
+  (TP (sqbkt (Var "Mod" (FTy 2)) (Var "strm" (LTy F8))))
+  (ITB
+    (sqbkt ((EQ (Var "Mod" (FTy 2)) (LW 0 2))
+             (TP (sqbkt (LW 0 64) (Var "strm" (LTy F8)))))
+           ((EQ (Var "Mod" (FTy 2)) (LW 1 2))
+             (Call "immediate8" (PTy F64 (LTy F8)) (Var "strm" (LTy F8)))))
+    (Call "immediate32" (PTy F64 (LTy F8)) (Var "strm" (LTy F8)))))
+
+
+(Def "readSIB"
+  (TP
+    (sqbkt (Var "REX" CTy"REX") (Var "Mod" (FTy 2)) (Var "strm" (LTy F8))))
+  (CS (Var "strm" (LTy F8))
+    (sqbkt ((LLC (sqbkt (Var "v#0" F8)) (Var "v#1" (LTy F8)))
+             (Let (Var "base" CTy"Zreg")
+               (Call "RexReg" CTy"Zreg"
+                 (TP
+                   (sqbkt (Dest "B" bTy (Var "REX" CTy"REX"))
+                          (EX (Var "v#0" F8) (LN 2) (LN 0) (FTy 3)))))
+               (Let (Var "index" CTy"Zreg")
+                 (Call "RexReg" CTy"Zreg"
+                   (TP
+                     (sqbkt (Dest "X" bTy (Var "REX" CTy"REX"))
+                            (EX (Var "v#0" F8) (LN 5) (LN 3) (FTy 3)))))
+                 (Let (Var "scaled_index" (OTy (PTy (FTy 2) CTy"Zreg")))
+                   (ITE (EQ (Var "index" CTy"Zreg") (LC "RSP" CTy"Zreg"))
+                     (LO (PTy (FTy 2) CTy"Zreg"))
+                     (Mop Some
+                       (TP
+                         (sqbkt (EX (Var "v#0" F8) (LN 7) (LN 6) (FTy 2))
+                                (Var "index" CTy"Zreg")))))
+                   (ITE (EQ (Var "base" CTy"Zreg") (LC "RBP" CTy"Zreg"))
+                     (Let
+                       (TP
+                         (sqbkt (Var "displacement" F64)
+                                (Var "strm2" (LTy F8))))
+                       (Call "readSibDisplacement" (PTy F64 (LTy F8))
+                         (TP
+                           (sqbkt (Var "Mod" (FTy 2)) (Var "v#1" (LTy F8)))))
+                       (TP
+                         (sqbkt (Call "Zm" CTy"Zrm"
+                                  (TP
+                                    (sqbkt (Var "scaled_index"
+                                             (OTy (PTy (FTy 2) CTy"Zreg")))
+                                           (ITE
+                                             (EQ (Var "Mod" (FTy 2))
+                                               (LW 0 2))
+                                             (Const "ZnoBase" CTy"Zbase")
+                                             (Call "ZregBase" CTy"Zbase"
+                                               (Var "base" CTy"Zreg")))
+                                           (Var "displacement" F64))))
+                                (Var "strm2" (LTy F8)))))
+                     (Let
+                       (TP
+                         (sqbkt (Var "displacement" F64)
+                                (Var "strm2" (LTy F8))))
+                       (Call "readDisplacement" (PTy F64 (LTy F8))
+                         (TP
+                           (sqbkt (Var "Mod" (FTy 2)) (Var "v#1" (LTy F8)))))
+                       (TP
+                         (sqbkt (Call "Zm" CTy"Zrm"
+                                  (TP
+                                    (sqbkt (Var "scaled_index"
+                                             (OTy (PTy (FTy 2) CTy"Zreg")))
+                                           (Call "ZregBase" CTy"Zbase"
+                                             (Var "base" CTy"Zreg"))
+                                           (Var "displacement" F64))))
+                                (Var "strm2" (LTy F8))))))))))
+           ((AVar (LTy F8))
+             (TP (sqbkt (LX CTy"Zrm") (Var "strm" (LTy F8))))))))
+
+
+(Def "readModRM" (TP (sqbkt (Var "REX" CTy"REX") (Var "strm" (LTy F8))))
+  (CS (Var "strm" (LTy F8))
+    (sqbkt ((LLC (sqbkt (Var "v#0" F8)) (Var "v#1" (LTy F8)))
+             (CS (TP (sqbkt (BL 8 (Var "v#0" F8)) (Var "v#1" (LTy F8))))
+               (sqbkt ((TP
+                          (sqbkt (TP
+                                   (sqbkt LF LF (AVar bTy) (AVar bTy)
+                                          (AVar bTy) LT LF LT))
+                                 (Var "strm1" (LTy F8))))
+                        (Let
+                          (TP
+                            (sqbkt (Var "displacement" F64)
+                                   (Var "strm2" (LTy F8))))
+                          (Call "immediate32" (PTy F64 (LTy F8))
+                            (Var "strm1" (LTy F8)))
+                          (TP
+                            (sqbkt (Call "RexReg" CTy"Zreg"
+                                     (TP
+                                       (sqbkt (Dest "R" bTy
+                                                (Var "REX" CTy"REX"))
+                                              (EX (Var "v#0" F8) (LN 5)
+                                                (LN 3) (FTy 3)))))
+                                   (Call "Zm" CTy"Zrm"
+                                     (TP
+                                       (sqbkt (LO (PTy (FTy 2) CTy"Zreg"))
+                                              (Const "ZripBase"
+                                                CTy"Zbase")
+                                              (Var "displacement" F64))))
+                                   (Var "strm2" (LTy F8))))))
+                      ((TP
+                          (sqbkt (TP
+                                   (sqbkt LT LT (AVar bTy) (AVar bTy)
+                                          (AVar bTy) (AVar bTy) (AVar bTy)
+                                          (AVar bTy)))
+                                 (Var "strm1" (LTy F8))))
+                        (TP
+                          (sqbkt (Call "RexReg" CTy"Zreg"
+                                   (TP
+                                     (sqbkt (Dest "R" bTy
+                                              (Var "REX" CTy"REX"))
+                                            (EX (Var "v#0" F8) (LN 5)
+                                              (LN 3) (FTy 3)))))
+                                 (Call "Zr" CTy"Zrm"
+                                   (Call "RexReg" CTy"Zreg"
+                                     (TP
+                                       (sqbkt (Dest "B" bTy
+                                                (Var "REX" CTy"REX"))
+                                              (EX (Var "v#0" F8) (LN 2)
+                                                (LN 0) (FTy 3))))))
+                                 (Var "strm1" (LTy F8)))))
+                      ((TP
+                          (sqbkt (TP
+                                   (sqbkt (AVar bTy) (AVar bTy) (AVar bTy)
+                                          (AVar bTy) (AVar bTy) LT LF LF))
+                                 (Var "strm1" (LTy F8))))
+                        (Let
+                          (TP
+                            (sqbkt (Var "sib" CTy"Zrm")
+                                   (Var "strm2" (LTy F8))))
+                          (Call "readSIB" (PTy CTy"Zrm" (LTy F8))
+                            (TP
+                              (sqbkt (Var "REX" CTy"REX")
+                                     (EX (Var "v#0" F8) (LN 7) (LN 6)
+                                       (FTy 2)) (Var "strm1" (LTy F8)))))
+                          (TP
+                            (sqbkt (Call "RexReg" CTy"Zreg"
+                                     (TP
+                                       (sqbkt (Dest "R" bTy
+                                                (Var "REX" CTy"REX"))
+                                              (EX (Var "v#0" F8) (LN 5)
+                                                (LN 3) (FTy 3)))))
+                                   (Var "sib" CTy"Zrm")
+                                   (Var "strm2" (LTy F8))))))
+                      ((TP
+                          (sqbkt (TP
+                                   (sqbkt (AVar bTy) (AVar bTy) (AVar bTy)
+                                          (AVar bTy) (AVar bTy) (AVar bTy)
+                                          (AVar bTy) (AVar bTy)))
+                                 (Var "strm1" (LTy F8))))
+                        (Let
+                          (TP
+                            (sqbkt (Var "displacement" F64)
+                                   (Var "strm2" (LTy F8))))
+                          (Call "readDisplacement" (PTy F64 (LTy F8))
+                            (TP
+                              (sqbkt (EX (Var "v#0" F8) (LN 7) (LN 6)
+                                       (FTy 2)) (Var "strm1" (LTy F8)))))
+                          (TP
+                            (sqbkt (Call "RexReg" CTy"Zreg"
+                                     (TP
+                                       (sqbkt (Dest "R" bTy
+                                                (Var "REX" CTy"REX"))
+                                              (EX (Var "v#0" F8) (LN 5)
+                                                (LN 3) (FTy 3)))))
+                                   (Call "Zm" CTy"Zrm"
+                                     (TP
+                                       (sqbkt (LO (PTy (FTy 2) CTy"Zreg"))
+                                              (Call "ZregBase" CTy"Zbase"
+                                                (Call "RexReg" CTy"Zreg"
+                                                  (TP
+                                                    (sqbkt (Dest "B" bTy
+                                                             (Var "REX"
+                                                               CTy"REX"))
+                                                           (EX
+                                                             (Var "v#0"
+                                                               F8) (LN 2)
+                                                             (LN 0)
+                                                             (FTy 3))))))
+                                              (Var "displacement" F64))))
+                                   (Var "strm2" (LTy F8)))))))))
+           ((AVar (LTy F8))
+             (TP
+               (sqbkt (LX CTy"Zreg") (LX CTy"Zrm") (Var "strm" (LTy F8))))))))
+
+
+(Def "readOpcodeModRM"
+  (TP (sqbkt (Var "REX" CTy"REX") (Var "strm" (LTy F8))))
+  (Let
+    (TP
+      (sqbkt (Var "opcode" CTy"Zreg") (Var "rm" CTy"Zrm")
+             (Var "strm1" (LTy F8))))
+    (Call "readModRM" (PTy CTy"Zreg" (PTy CTy"Zrm" (LTy F8)))
+      (TP (sqbkt (Var "REX" CTy"REX") (Var "strm" (LTy F8)))))
+    (TP
+      (sqbkt (Mop (Cast (FTy 3))
+               (Bop Mod (Mop (Cast nTy) (Var "opcode" CTy"Zreg")) (LN 8)))
+             (Var "rm" CTy"Zrm") (Var "strm1" (LTy F8))))))
+
+
+(Def "prefixGroup" (Var "b" F8)
+  (CS (Var "b" F8)
+    (sqbkt ((LW 240 8) (LN 1)) ((LW 242 8) (LN 1)) ((LW 243 8) (LN 1))
+           ((LW 38 8) (LN 2)) ((LW 46 8) (LN 2)) ((LW 54 8) (LN 2))
+           ((LW 62 8) (LN 2)) ((LW 100 8) (LN 2)) ((LW 101 8) (LN 2))
+           ((LW 102 8) (LN 3)) ((LW 103 8) (LN 4))
+           ((AVar F8)
+             (ITE (EQ (EX (Var "b" F8) (LN 7) (LN 4) F4) (LW 4 4)) (LN 5)
+               (LN 0))))))
+
+
+(Def "readPrefix"
+  (TP
+    (sqbkt (Var "s" (STy nTy)) (Var "p" (LTy F8)) (Var "strm" (LTy F8))))
+  (CS (Var "strm" (LTy F8))
+    (sqbkt ((LLC (sqbkt (Var "h" F8)) (Var "strm1" (LTy F8)))
+             (Let nVar"group" (Call "prefixGroup" nTy (Var "h" F8))
+               (ITB
+                 (sqbkt ((EQ nVar"group" (LN 0))
+                          (Mop Some
+                            (TP
+                              (sqbkt (Var "p" (LTy F8)) LF
+                                     (Call "rec'REX" CTy"REX" (LW 0 4))
+                                     (Var "strm" (LTy F8))))))
+                        ((EQ nVar"group" (LN 5))
+                          (Mop Some
+                            (TP
+                              (sqbkt (Var "p" (LTy F8)) LT
+                                     (Call "rec'REX" CTy"REX"
+                                       (EX (Var "h" F8) (LN 3) (LN 0) F4))
+                                     (Var "strm1" (LTy F8))))))
+                        ((Bop In nVar"group" (Var "s" (STy nTy)))
+                          (LO
+                            (PTy (LTy F8)
+                              (PTy bTy (PTy CTy"REX" (LTy F8)))))))
+                 (Call "readPrefix"
+                   (OTy (PTy (LTy F8) (PTy bTy (PTy CTy"REX" (LTy F8)))))
+                   (TP
+                     (sqbkt (Bop Insert nVar"group" (Var "s" (STy nTy)))
+                            (LLC (sqbkt (Var "h" F8)) (Var "p" (LTy F8)))
+                            (Var "strm1" (LTy F8))))))))
+           ((LNL F8)
+             (Mop Some
+               (TP
+                 (sqbkt (Var "p" (LTy F8)) LF (LX CTy"REX")
+                        (Var "strm" (LTy F8)))))))))
+
+
+(Def "readPrefixes" (Var "strm" (LTy F8))
+  (Call "readPrefix"
+    (OTy (PTy (LTy F8) (PTy bTy (PTy CTy"REX" (LTy F8)))))
+    (TP (sqbkt (LE nTy) (LNL F8) (Var "strm" (LTy F8))))))
+
+
+(Def "OpSize"
+  (TP (sqbkt bVar"have_rex" bVar"w" (Var "v" F1) bVar"override"))
+  (ITB
+    (sqbkt ((EQ (Var "v" F1) (LW 0 1))
+             (Call "Z8" CTy"Zsize" bVar"have_rex"))
+           (bVar"w" (Const "Z64" CTy"Zsize"))
+           (bVar"override" (Const "Z16" CTy"Zsize")))
+    (Const "Z32" CTy"Zsize")))
+
+
+(Def "isZm" (Var "rm" CTy"Zrm")
+  (CS (Var "rm" CTy"Zrm")
+    (sqbkt ((Call "Zm" CTy"Zrm"
+               (AVar
+                 (PTy (OTy (PTy (FTy 2) CTy"Zreg")) (PTy CTy"Zbase" F64))))
+             LT) ((AVar CTy"Zrm") LF))))
+
+
+(Def "x64_decode" (Var "strm" (LTy F8))
+  (CS
+    (Call "readPrefixes"
+      (OTy (PTy (LTy F8) (PTy bTy (PTy CTy"REX" (LTy F8)))))
+      (Var "strm" (LTy F8)))
+    (sqbkt ((LO (PTy (LTy F8) (PTy bTy (PTy CTy"REX" (LTy F8)))))
+             (Call "Zdec_fail" CTy"Zinst" (LS"Bad prefix")))
+           ((Mop Some
+               (TP
+                 (sqbkt (Var "p" (LTy F8)) bVar"have_rex"
+                        (Var "REX" CTy"REX") (Var "strm1" (LTy F8)))))
+             (Let bVar"op_size_override"
+               (Bop In (LW 102 8) (Mop SofL (Var "p" (LTy F8))))
+               (ITE
+                 (Bop And (Dest "W" bTy (Var "REX" CTy"REX"))
+                   bVar"op_size_override")
+                 (Call "Zdec_fail" CTy"Zinst"
+                   (LS"REX.W together with override prefix"))
+                 (CS (Var "strm1" (LTy F8))
+                   (sqbkt ((LLC (sqbkt (Var "v#0" F8))
+                              (Var "v#1" (LTy F8)))
+                            (CS
+                              (TP
+                                (sqbkt (BL 8 (Var "v#0" F8))
+                                       (Var "v#1" (LTy F8))))
+                              (sqbkt ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LF LF (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy) LF
+                                                         (AVar bTy)
+                                                         (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "reg" CTy"Zreg")
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readModRM"
+                                           (PTy CTy"Zreg"
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zbinop"
+                                                      CTy"instruction"
+                                                      (TP
+                                                        (sqbkt (Mop
+                                                                 (Cast
+                                                                   CTy"Zbinop_name")
+                                                                 (EX
+                                                                   (Var
+                                                                     "v#0"
+                                                                     F8)
+                                                                   (LN 5)
+                                                                   (LN 3)
+                                                                   (FTy 3)))
+                                                               (Call
+                                                                 "OpSize"
+                                                                 CTy"Zsize"
+                                                                 (TP
+                                                                   (sqbkt bVar"have_rex"
+                                                                          (Dest
+                                                                            "W"
+                                                                            bTy
+                                                                            (Var
+                                                                              "REX"
+                                                                              CTy"REX"))
+                                                                          (EX
+                                                                            (Var
+                                                                              "v#0"
+                                                                              F8)
+                                                                            (LN
+                                                                              0)
+                                                                            (LN
+                                                                              0)
+                                                                            F1)
+                                                                          bVar"op_size_override")))
+                                                               (ITE
+                                                                 (EQ
+                                                                   (EX
+                                                                     (Var
+                                                                       "v#0"
+                                                                       F8)
+                                                                     (LN 1)
+                                                                     (LN 1)
+                                                                     F1)
+                                                                   (LW 0
+                                                                     1))
+                                                                 (Call
+                                                                   "Zrm_r"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Var
+                                                                              "rm"
+                                                                              CTy"Zrm")
+                                                                            (Var
+                                                                              "reg"
+                                                                              CTy"Zreg"))))
+                                                                 (Call
+                                                                   "Zr_rm"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Var
+                                                                              "reg"
+                                                                              CTy"Zreg")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm"))))))))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LF LF (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy) LT LF
+                                                         (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "size" CTy"Zsize")
+                                         (Call "OpSize" CTy"Zsize"
+                                           (TP
+                                             (sqbkt bVar"have_rex"
+                                                    (Dest "W" bTy
+                                                      (Var "REX" CTy"REX"))
+                                                    (EX (Var "v#0" F8)
+                                                      (LN 0) (LN 0) F1)
+                                                    bVar"op_size_override")))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "imm" F64)
+                                                    (Var "strm3" (LTy F8))))
+                                           (Call "immediate"
+                                             (PTy F64 (LTy F8))
+                                             (TP
+                                               (sqbkt (Var "size"
+                                                        CTy"Zsize")
+                                                      (Var "strm2"
+                                                        (LTy F8)))))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zbinop"
+                                                        CTy"instruction"
+                                                        (TP
+                                                          (sqbkt (Mop
+                                                                   (Cast
+                                                                     CTy"Zbinop_name")
+                                                                   (EX
+                                                                     (Var
+                                                                       "v#0"
+                                                                       F8)
+                                                                     (LN 5)
+                                                                     (LN 3)
+                                                                     (FTy
+                                                                       3)))
+                                                                 (Var
+                                                                   "size"
+                                                                   CTy"Zsize")
+                                                                 (Call
+                                                                   "Zrm_i"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Call
+                                                                              "Zr"
+                                                                              CTy"Zrm"
+                                                                              (LC
+                                                                                "RAX"
+                                                                                CTy"Zreg"))
+                                                                            (Var
+                                                                              "imm"
+                                                                              F64)))))))
+                                                      (Var "strm3"
+                                                        (LTy F8))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LF LT LF LT
+                                                         (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "reg" CTy"Zrm")
+                                         (Call "Zr" CTy"Zrm"
+                                           (Mop (Cast CTy"Zreg")
+                                             (CC(sqbkt (Mop (Cast F1)
+                                                         (Dest "B" bTy
+                                                           (Var "REX"
+                                                             CTy"REX")))
+                                                       (EX (Var "v#0" F8)
+                                                         (LN 2) (LN 0)
+                                                         (FTy 3))))))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (ITE
+                                                      (EQ
+                                                        (EX (Var "v#0" F8)
+                                                          (LN 3) (LN 3)
+                                                          F1) (LW 0 1))
+                                                      (Call "Zpush"
+                                                        CTy"instruction"
+                                                        (Call "Zrm"
+                                                          CTy"Zimm_rm"
+                                                          (Var "reg"
+                                                            CTy"Zrm")))
+                                                      (Call "Zpop"
+                                                        CTy"instruction"
+                                                        (Var "reg"
+                                                          CTy"Zrm")))
+                                                    (Var "strm2" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LF LT LT LF LT LF
+                                                         (AVar bTy) LF))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "imm" F64)
+                                                  (Var "strm3" (LTy F8))))
+                                         (ITE
+                                           (EQ
+                                             (EX (Var "v#0" F8) (LN 1)
+                                               (LN 1) F1) (LW 1 1))
+                                           (Call "immediate8"
+                                             (PTy F64 (LTy F8))
+                                             (Var "strm2" (LTy F8)))
+                                           (Call "immediate32"
+                                             (PTy F64 (LTy F8))
+                                             (Var "strm2" (LTy F8))))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zpush"
+                                                      CTy"instruction"
+                                                      (Call "Zimm"
+                                                        CTy"Zimm_rm"
+                                                        (Var "imm" F64)))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LF LT LT LT
+                                                         (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "imm" F64)
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "immediate8"
+                                           (PTy F64 (LTy F8))
+                                           (Var "strm2" (LTy F8)))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zjcc"
+                                                      CTy"instruction"
+                                                      (TP
+                                                        (sqbkt (Mop
+                                                                 (Cast
+                                                                   CTy"Zcond")
+                                                                 (EX
+                                                                   (Var
+                                                                     "v#0"
+                                                                     F8)
+                                                                   (LN 3)
+                                                                   (LN 0)
+                                                                   F4))
+                                                               (Var "imm"
+                                                                 F64))))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LF LF LF LF
+                                                         LF (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "size" CTy"Zsize")
+                                         (Call "OpSize" CTy"Zsize"
+                                           (TP
+                                             (sqbkt bVar"have_rex"
+                                                    (Dest "W" bTy
+                                                      (Var "REX" CTy"REX"))
+                                                    (EX (Var "v#0" F8)
+                                                      (LN 0) (LN 0) F1)
+                                                    bVar"op_size_override")))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "opcode" (FTy 3))
+                                                    (Var "rm" CTy"Zrm")
+                                                    (Var "strm3" (LTy F8))))
+                                           (Call "readOpcodeModRM"
+                                             (PTy (FTy 3)
+                                               (PTy CTy"Zrm" (LTy F8)))
+                                             (TP
+                                               (sqbkt (Var "REX" CTy"REX")
+                                                      (Var "strm2"
+                                                        (LTy F8)))))
+                                           (Let
+                                             (TP
+                                               (sqbkt (Var "imm" F64)
+                                                      (Var "strm4"
+                                                        (LTy F8))))
+                                             (Call "immediate"
+                                               (PTy F64 (LTy F8))
+                                               (TP
+                                                 (sqbkt (Var "size"
+                                                          CTy"Zsize")
+                                                        (Var "strm3"
+                                                          (LTy F8)))))
+                                             (Call "Zfull_inst" CTy"Zinst"
+                                               (TP
+                                                 (sqbkt (Var "p" (LTy F8))
+                                                        (Call "Zbinop"
+                                                          CTy"instruction"
+                                                          (TP
+                                                            (sqbkt (Mop
+                                                                     (Cast
+                                                                       CTy"Zbinop_name")
+                                                                     (Var
+                                                                       "opcode"
+                                                                       (FTy
+                                                                         3)))
+                                                                   (Var
+                                                                     "size"
+                                                                     CTy"Zsize")
+                                                                   (Call
+                                                                     "Zrm_i"
+                                                                     CTy"Zdest_src"
+                                                                     (TP
+                                                                       (sqbkt (Var
+                                                                                "rm"
+                                                                                CTy"Zrm")
+                                                                              (Var
+                                                                                "imm"
+                                                                                F64)))))))
+                                                        (Var "strm4"
+                                                          (LTy F8)))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LF LF LF LF
+                                                         LT LT))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "opcode" (FTy 3))
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readOpcodeModRM"
+                                           (PTy (FTy 3)
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "imm" F64)
+                                                    (Var "strm4" (LTy F8))))
+                                           (Call "immediate8"
+                                             (PTy F64 (LTy F8))
+                                             (Var "strm3" (LTy F8)))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zbinop"
+                                                        CTy"instruction"
+                                                        (TP
+                                                          (sqbkt (Mop
+                                                                   (Cast
+                                                                     CTy"Zbinop_name")
+                                                                   (Var
+                                                                     "opcode"
+                                                                     (FTy
+                                                                       3)))
+                                                                 (Call
+                                                                   "OpSize"
+                                                                   CTy"Zsize"
+                                                                   (TP
+                                                                     (sqbkt LF
+                                                                            (Dest
+                                                                              "W"
+                                                                              bTy
+                                                                              (Var
+                                                                                "REX"
+                                                                                CTy"REX"))
+                                                                            (LW
+                                                                              1
+                                                                              1)
+                                                                            bVar"op_size_override")))
+                                                                 (Call
+                                                                   "Zrm_i"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Var
+                                                                              "rm"
+                                                                              CTy"Zrm")
+                                                                            (Var
+                                                                              "imm"
+                                                                              F64)))))))
+                                                      (Var "strm4"
+                                                        (LTy F8))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LF LF LF LT
+                                                         LF (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "reg" CTy"Zreg")
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readModRM"
+                                           (PTy CTy"Zreg"
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zbinop"
+                                                      CTy"instruction"
+                                                      (TP
+                                                        (sqbkt (LC "Ztest"
+                                                                 CTy"Zbinop_name")
+                                                               (Call
+                                                                 "OpSize"
+                                                                 CTy"Zsize"
+                                                                 (TP
+                                                                   (sqbkt bVar"have_rex"
+                                                                          (Dest
+                                                                            "W"
+                                                                            bTy
+                                                                            (Var
+                                                                              "REX"
+                                                                              CTy"REX"))
+                                                                          (EX
+                                                                            (Var
+                                                                              "v#0"
+                                                                              F8)
+                                                                            (LN
+                                                                              0)
+                                                                            (LN
+                                                                              0)
+                                                                            F1)
+                                                                          bVar"op_size_override")))
+                                                               (Call
+                                                                 "Zrm_r"
+                                                                 CTy"Zdest_src"
+                                                                 (TP
+                                                                   (sqbkt (Var
+                                                                            "rm"
+                                                                            CTy"Zrm")
+                                                                          (Var
+                                                                            "reg"
+                                                                            CTy"Zreg")))))))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LF LF LF LT
+                                                         LT (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "reg" CTy"Zreg")
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readModRM"
+                                           (PTy CTy"Zreg"
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zxchg"
+                                                      CTy"instruction"
+                                                      (TP
+                                                        (sqbkt (Call
+                                                                 "OpSize"
+                                                                 CTy"Zsize"
+                                                                 (TP
+                                                                   (sqbkt bVar"have_rex"
+                                                                          (Dest
+                                                                            "W"
+                                                                            bTy
+                                                                            (Var
+                                                                              "REX"
+                                                                              CTy"REX"))
+                                                                          (EX
+                                                                            (Var
+                                                                              "v#0"
+                                                                              F8)
+                                                                            (LN
+                                                                              0)
+                                                                            (LN
+                                                                              0)
+                                                                            F1)
+                                                                          bVar"op_size_override")))
+                                                               (Var "rm"
+                                                                 CTy"Zrm")
+                                                               (Var "reg"
+                                                                 CTy"Zreg"))))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LF LF LT LF
+                                                         (AVar bTy)
+                                                         (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "reg" CTy"Zreg")
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readModRM"
+                                           (PTy CTy"Zreg"
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zmov"
+                                                      CTy"instruction"
+                                                      (TP
+                                                        (sqbkt (LC
+                                                                 "Z_ALWAYS"
+                                                                 CTy"Zcond")
+                                                               (Call
+                                                                 "OpSize"
+                                                                 CTy"Zsize"
+                                                                 (TP
+                                                                   (sqbkt bVar"have_rex"
+                                                                          (Dest
+                                                                            "W"
+                                                                            bTy
+                                                                            (Var
+                                                                              "REX"
+                                                                              CTy"REX"))
+                                                                          (EX
+                                                                            (Var
+                                                                              "v#0"
+                                                                              F8)
+                                                                            (LN
+                                                                              0)
+                                                                            (LN
+                                                                              0)
+                                                                            F1)
+                                                                          bVar"op_size_override")))
+                                                               (ITE
+                                                                 (EQ
+                                                                   (EX
+                                                                     (Var
+                                                                       "v#0"
+                                                                       F8)
+                                                                     (LN 1)
+                                                                     (LN 1)
+                                                                     F1)
+                                                                   (LW 0
+                                                                     1))
+                                                                 (Call
+                                                                   "Zrm_r"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Var
+                                                                              "rm"
+                                                                              CTy"Zrm")
+                                                                            (Var
+                                                                              "reg"
+                                                                              CTy"Zreg"))))
+                                                                 (Call
+                                                                   "Zr_rm"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Var
+                                                                              "reg"
+                                                                              CTy"Zreg")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm"))))))))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LF LF LT LT
+                                                         LF LT))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "reg" CTy"Zreg")
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readModRM"
+                                           (PTy CTy"Zreg"
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (ITE
+                                           (Call "isZm" bTy
+                                             (Var "rm" CTy"Zrm"))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zlea"
+                                                        CTy"instruction"
+                                                        (TP
+                                                          (sqbkt (Call
+                                                                   "OpSize"
+                                                                   CTy"Zsize"
+                                                                   (TP
+                                                                     (sqbkt LT
+                                                                            (Dest
+                                                                              "W"
+                                                                              bTy
+                                                                              (Var
+                                                                                "REX"
+                                                                                CTy"REX"))
+                                                                            (LW
+                                                                              1
+                                                                              1)
+                                                                            bVar"op_size_override")))
+                                                                 (Call
+                                                                   "Zr_rm"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Var
+                                                                              "reg"
+                                                                              CTy"Zreg")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm")))))))
+                                                      (Var "strm3"
+                                                        (LTy F8)))))
+                                           (Call "Zdec_fail" CTy"Zinst"
+                                             (LS
+                                               "LEA with register argument")))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LF LF LT LT
+                                                         LT LT))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "opcode" (FTy 3))
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readOpcodeModRM"
+                                           (PTy (FTy 3)
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (ITE
+                                           (EQ (Var "opcode" (FTy 3))
+                                             (LW 0 3))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zpop"
+                                                        CTy"instruction"
+                                                        (Var "rm"
+                                                          CTy"Zrm"))
+                                                      (Var "strm3"
+                                                        (LTy F8)))))
+                                           (Call "Zdec_fail" CTy"Zinst"
+                                             (LS
+                                               "Unsupported opcode: Group 1a")))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LF LT LF
+                                                         (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "reg" CTy"Zreg")
+                                         (Call "RexReg" CTy"Zreg"
+                                           (TP
+                                             (sqbkt (Dest "B" bTy
+                                                      (Var "REX" CTy"REX"))
+                                                    (EX (Var "v#0" F8)
+                                                      (LN 2) (LN 0)
+                                                      (FTy 3)))))
+                                         (ITE
+                                           (EQ (Var "reg" CTy"Zreg")
+                                             (LC "RAX" CTy"Zreg"))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Const "Znop"
+                                                        CTy"instruction")
+                                                      (Var "strm2"
+                                                        (LTy F8)))))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zxchg"
+                                                        CTy"instruction"
+                                                        (TP
+                                                          (sqbkt (Call
+                                                                   "OpSize"
+                                                                   CTy"Zsize"
+                                                                   (TP
+                                                                     (sqbkt LT
+                                                                            (Dest
+                                                                              "W"
+                                                                              bTy
+                                                                              (Var
+                                                                                "REX"
+                                                                                CTy"REX"))
+                                                                            (LW
+                                                                              1
+                                                                              1)
+                                                                            bVar"op_size_override")))
+                                                                 (Call
+                                                                   "Zr"
+                                                                   CTy"Zrm"
+                                                                   (LC
+                                                                     "RAX"
+                                                                     CTy"Zreg"))
+                                                                 (Var
+                                                                   "reg"
+                                                                   CTy"Zreg"))))
+                                                      (Var "strm2"
+                                                        (LTy F8))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LT LF LT LF
+                                                         LF (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "size" CTy"Zsize")
+                                         (Call "OpSize" CTy"Zsize"
+                                           (TP
+                                             (sqbkt LT
+                                                    (Dest "W" bTy
+                                                      (Var "REX" CTy"REX"))
+                                                    (EX (Var "v#0" F8)
+                                                      (LN 0) (LN 0) F1)
+                                                    bVar"op_size_override")))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "imm" F64)
+                                                    (Var "strm3" (LTy F8))))
+                                           (Call "immediate"
+                                             (PTy F64 (LTy F8))
+                                             (TP
+                                               (sqbkt (Var "size"
+                                                        CTy"Zsize")
+                                                      (Var "strm2"
+                                                        (LTy F8)))))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zbinop"
+                                                        CTy"instruction"
+                                                        (TP
+                                                          (sqbkt (LC
+                                                                   "Ztest"
+                                                                   CTy"Zbinop_name")
+                                                                 (Var
+                                                                   "size"
+                                                                   CTy"Zsize")
+                                                                 (Call
+                                                                   "Zrm_i"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Call
+                                                                              "Zr"
+                                                                              CTy"Zrm"
+                                                                              (LC
+                                                                                "RAX"
+                                                                                CTy"Zreg"))
+                                                                            (Var
+                                                                              "imm"
+                                                                              F64)))))))
+                                                      (Var "strm3"
+                                                        (LTy F8))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LF LT LT
+                                                         (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy)
+                                                         (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "size" CTy"Zsize")
+                                         (Call "OpSize" CTy"Zsize"
+                                           (TP
+                                             (sqbkt bVar"have_rex"
+                                                    (Dest "W" bTy
+                                                      (Var "REX" CTy"REX"))
+                                                    (EX (Var "v#0" F8)
+                                                      (LN 3) (LN 3) F1)
+                                                    bVar"op_size_override")))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "imm" F64)
+                                                    (Var "strm3" (LTy F8))))
+                                           (Call "full_immediate"
+                                             (PTy F64 (LTy F8))
+                                             (TP
+                                               (sqbkt (Var "size"
+                                                        CTy"Zsize")
+                                                      (Var "strm2"
+                                                        (LTy F8)))))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zmov"
+                                                        CTy"instruction"
+                                                        (TP
+                                                          (sqbkt (LC
+                                                                   "Z_ALWAYS"
+                                                                   CTy"Zcond")
+                                                                 (Var
+                                                                   "size"
+                                                                   CTy"Zsize")
+                                                                 (Call
+                                                                   "Zrm_i"
+                                                                   CTy"Zdest_src"
+                                                                   (TP
+                                                                     (sqbkt (Call
+                                                                              "Zr"
+                                                                              CTy"Zrm"
+                                                                              (Mop
+                                                                                (Cast
+                                                                                  CTy"Zreg")
+                                                                                (CC(sqbkt (Mop
+                                                                                            (Cast
+                                                                                              F1)
+                                                                                            (Dest
+                                                                                              "B"
+                                                                                              bTy
+                                                                                              (Var
+                                                                                                "REX"
+                                                                                                CTy"REX")))
+                                                                                          (EX
+                                                                                            (Var
+                                                                                              "v#0"
+                                                                                              F8)
+                                                                                            (LN
+                                                                                              2)
+                                                                                            (LN
+                                                                                              0)
+                                                                                            (FTy
+                                                                                              3))))))
+                                                                            (Var
+                                                                              "imm"
+                                                                              F64)))))))
+                                                      (Var "strm3"
+                                                        (LTy F8))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LF LF LF LF
+                                                         LF (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "opcode" (FTy 3))
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readOpcodeModRM"
+                                           (PTy (FTy 3)
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "imm" F64)
+                                                    (Var "strm4" (LTy F8))))
+                                           (Call "immediate8"
+                                             (PTy F64 (LTy F8))
+                                             (Var "strm3" (LTy F8)))
+                                           (ITE
+                                             (EQ (Var "opcode" (FTy 3))
+                                               (LW 6 3))
+                                             (Call "Zdec_fail" CTy"Zinst"
+                                               (LS
+                                                 "Unsupported opcode: Shift Group 2"))
+                                             (Call "Zfull_inst" CTy"Zinst"
+                                               (TP
+                                                 (sqbkt (Var "p" (LTy F8))
+                                                        (Call "Zbinop"
+                                                          CTy"instruction"
+                                                          (TP
+                                                            (sqbkt (Mop
+                                                                     (Cast
+                                                                       CTy"Zbinop_name")
+                                                                     (Bop
+                                                                       Add
+                                                                       (Mop
+                                                                         (Cast
+                                                                           nTy)
+                                                                         (Var
+                                                                           "opcode"
+                                                                           (FTy
+                                                                             3)))
+                                                                       (LN
+                                                                         8)))
+                                                                   (Call
+                                                                     "OpSize"
+                                                                     CTy"Zsize"
+                                                                     (TP
+                                                                       (sqbkt bVar"have_rex"
+                                                                              (Dest
+                                                                                "W"
+                                                                                bTy
+                                                                                (Var
+                                                                                  "REX"
+                                                                                  CTy"REX"))
+                                                                              (EX
+                                                                                (Var
+                                                                                  "v#0"
+                                                                                  F8)
+                                                                                (LN
+                                                                                  0)
+                                                                                (LN
+                                                                                  0)
+                                                                                F1)
+                                                                              bVar"op_size_override")))
+                                                                   (Call
+                                                                     "Zrm_i"
+                                                                     CTy"Zdest_src"
+                                                                     (TP
+                                                                       (sqbkt (Var
+                                                                                "rm"
+                                                                                CTy"Zrm")
+                                                                              (Var
+                                                                                "imm"
+                                                                                F64)))))))
+                                                        (Var "strm4"
+                                                          (LTy F8)))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LF LF LF LF
+                                                         LT (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (ITE
+                                         (EQ
+                                           (EX (Var "v#0" F8) (LN 0)
+                                             (LN 0) F1) (LW 0 1))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "imm" F64)
+                                                    (Var "strm3" (LTy F8))))
+                                           (Call "immediate16"
+                                             (PTy F64 (LTy F8))
+                                             (Var "strm2" (LTy F8)))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zret"
+                                                        CTy"instruction"
+                                                        (Var "imm" F64))
+                                                      (Var "strm3"
+                                                        (LTy F8))))))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zret"
+                                                      CTy"instruction"
+                                                      (LW 0 64))
+                                                    (Var "strm2" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LF LF LF LT
+                                                         LT (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "size" CTy"Zsize")
+                                         (Call "OpSize" CTy"Zsize"
+                                           (TP
+                                             (sqbkt bVar"have_rex"
+                                                    (Dest "W" bTy
+                                                      (Var "REX" CTy"REX"))
+                                                    (EX (Var "v#0" F8)
+                                                      (LN 0) (LN 0) F1)
+                                                    bVar"op_size_override")))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "opcode" (FTy 3))
+                                                    (Var "rm" CTy"Zrm")
+                                                    (Var "strm3" (LTy F8))))
+                                           (Call "readOpcodeModRM"
+                                             (PTy (FTy 3)
+                                               (PTy CTy"Zrm" (LTy F8)))
+                                             (TP
+                                               (sqbkt (Var "REX" CTy"REX")
+                                                      (Var "strm2"
+                                                        (LTy F8)))))
+                                           (Let
+                                             (TP
+                                               (sqbkt (Var "imm" F64)
+                                                      (Var "strm4"
+                                                        (LTy F8))))
+                                             (Call "immediate"
+                                               (PTy F64 (LTy F8))
+                                               (TP
+                                                 (sqbkt (Var "size"
+                                                          CTy"Zsize")
+                                                        (Var "strm3"
+                                                          (LTy F8)))))
+                                             (ITE
+                                               (EQ (Var "opcode" (FTy 3))
+                                                 (LW 0 3))
+                                               (Call "Zfull_inst"
+                                                 CTy"Zinst"
+                                                 (TP
+                                                   (sqbkt (Var "p"
+                                                            (LTy F8))
+                                                          (Call "Zmov"
+                                                            CTy"instruction"
+                                                            (TP
+                                                              (sqbkt (LC
+                                                                       "Z_ALWAYS"
+                                                                       CTy"Zcond")
+                                                                     (Var
+                                                                       "size"
+                                                                       CTy"Zsize")
+                                                                     (Call
+                                                                       "Zrm_i"
+                                                                       CTy"Zdest_src"
+                                                                       (TP
+                                                                         (sqbkt (Var
+                                                                                  "rm"
+                                                                                  CTy"Zrm")
+                                                                                (Var
+                                                                                  "imm"
+                                                                                  F64)))))))
+                                                          (Var "strm4"
+                                                            (LTy F8)))))
+                                               (Call "Zdec_fail"
+                                                 CTy"Zinst"
+                                                 (LS
+                                                   "Unsupported opcode: Group 11")))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LF LT LF LF
+                                                         (AVar bTy)
+                                                         (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "opcode" (FTy 3))
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readOpcodeModRM"
+                                           (PTy (FTy 3)
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (ITE
+                                           (EQ (Var "opcode" (FTy 3))
+                                             (LW 6 3))
+                                           (Call "Zdec_fail" CTy"Zinst"
+                                             (LS
+                                               "Unsupported opcode: Shift Group 2"))
+                                           (Call "Zfull_inst" CTy"Zinst"
+                                             (TP
+                                               (sqbkt (Var "p" (LTy F8))
+                                                      (Call "Zbinop"
+                                                        CTy"instruction"
+                                                        (TP
+                                                          (sqbkt (Mop
+                                                                   (Cast
+                                                                     CTy"Zbinop_name")
+                                                                   (Bop
+                                                                     Add
+                                                                     (Mop
+                                                                       (Cast
+                                                                         nTy)
+                                                                       (Var
+                                                                         "opcode"
+                                                                         (FTy
+                                                                           3)))
+                                                                     (LN 8)))
+                                                                 (Call
+                                                                   "OpSize"
+                                                                   CTy"Zsize"
+                                                                   (TP
+                                                                     (sqbkt bVar"have_rex"
+                                                                            (Dest
+                                                                              "W"
+                                                                              bTy
+                                                                              (Var
+                                                                                "REX"
+                                                                                CTy"REX"))
+                                                                            (EX
+                                                                              (Var
+                                                                                "v#0"
+                                                                                F8)
+                                                                              (LN
+                                                                                0)
+                                                                              (LN
+                                                                                0)
+                                                                              F1)
+                                                                            bVar"op_size_override")))
+                                                                 (ITE
+                                                                   (EQ
+                                                                     (EX
+                                                                       (Var
+                                                                         "v#0"
+                                                                         F8)
+                                                                       (LN
+                                                                         1)
+                                                                       (LN
+                                                                         1)
+                                                                       F1)
+                                                                     (LW 0
+                                                                       1))
+                                                                   (Call
+                                                                     "Zrm_i"
+                                                                     CTy"Zdest_src"
+                                                                     (TP
+                                                                       (sqbkt (Var
+                                                                                "rm"
+                                                                                CTy"Zrm")
+                                                                              (LW
+                                                                                1
+                                                                                64))))
+                                                                   (Call
+                                                                     "Zrm_r"
+                                                                     CTy"Zdest_src"
+                                                                     (TP
+                                                                       (sqbkt (Var
+                                                                                "rm"
+                                                                                CTy"Zrm")
+                                                                              (LC
+                                                                                "RCX"
+                                                                                CTy"Zreg"))))))))
+                                                      (Var "strm3"
+                                                        (LTy F8))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LT LF LF LF
+                                                         LF (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "imm" F64)
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "immediate8"
+                                           (PTy F64 (LTy F8))
+                                           (Var "strm2" (LTy F8)))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zloop"
+                                                      CTy"instruction"
+                                                      (TP
+                                                        (sqbkt (ITE
+                                                                 (EQ
+                                                                   (EX
+                                                                     (Var
+                                                                       "v#0"
+                                                                       F8)
+                                                                     (LN 0)
+                                                                     (LN 0)
+                                                                     F1)
+                                                                   (LW 0
+                                                                     1))
+                                                                 (LC
+                                                                   "Z_NE"
+                                                                   CTy"Zcond")
+                                                                 (LC "Z_E"
+                                                                   CTy"Zcond"))
+                                                               (Var "imm"
+                                                                 F64))))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LT LF LF LF
+                                                         LT LF))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "imm" F64)
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "immediate8"
+                                           (PTy F64 (LTy F8))
+                                           (Var "strm2" (LTy F8)))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zloop"
+                                                      CTy"instruction"
+                                                      (TP
+                                                        (sqbkt (LC
+                                                                 "Z_ALWAYS"
+                                                                 CTy"Zcond")
+                                                               (Var "imm"
+                                                                 F64))))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LT LF LT LF
+                                                         LF LF))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "imm" F64)
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "immediate32"
+                                           (PTy F64 (LTy F8))
+                                           (Var "strm2" (LTy F8)))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zcall"
+                                                      CTy"instruction"
+                                                      (Call "Zimm"
+                                                        CTy"Zimm_rm"
+                                                        (Var "imm" F64)))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LT LF LT LF
+                                                         (AVar bTy) LT))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "imm" F64)
+                                                  (Var "strm3" (LTy F8))))
+                                         (ITE
+                                           (EQ
+                                             (EX (Var "v#0" F8) (LN 1)
+                                               (LN 1) F1) (LW 0 1))
+                                           (Call "immediate32"
+                                             (PTy F64 (LTy F8))
+                                             (Var "strm2" (LTy F8)))
+                                           (Call "immediate8"
+                                             (PTy F64 (LTy F8))
+                                             (Var "strm2" (LTy F8))))
+                                         (Call "Zfull_inst" CTy"Zinst"
+                                           (TP
+                                             (sqbkt (Var "p" (LTy F8))
+                                                    (Call "Zjcc"
+                                                      CTy"instruction"
+                                                      (TP
+                                                        (sqbkt (LC
+                                                                 "Z_ALWAYS"
+                                                                 CTy"Zcond")
+                                                               (Var "imm"
+                                                                 F64))))
+                                                    (Var "strm3" (LTy F8)))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LT LT LF LT
+                                                         LT (AVar bTy)))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "size" CTy"Zsize")
+                                         (Call "OpSize" CTy"Zsize"
+                                           (TP
+                                             (sqbkt bVar"have_rex"
+                                                    (Dest "W" bTy
+                                                      (Var "REX" CTy"REX"))
+                                                    (EX (Var "v#0" F8)
+                                                      (LN 0) (LN 0) F1)
+                                                    bVar"op_size_override")))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "opcode" (FTy 3))
+                                                    (Var "rm" CTy"Zrm")
+                                                    (Var "strm3" (LTy F8))))
+                                           (Call "readOpcodeModRM"
+                                             (PTy (FTy 3)
+                                               (PTy CTy"Zrm" (LTy F8)))
+                                             (TP
+                                               (sqbkt (Var "REX" CTy"REX")
+                                                      (Var "strm2"
+                                                        (LTy F8)))))
+                                           (CS (Var "opcode" (FTy 3))
+                                             (sqbkt ((LW 0 3)
+                                                      (Let
+                                                        (TP
+                                                          (sqbkt (Var
+                                                                   "imm"
+                                                                   F64)
+                                                                 (Var
+                                                                   "strm4"
+                                                                   (LTy
+                                                                     F8))))
+                                                        (Call "immediate"
+                                                          (PTy F64
+                                                            (LTy F8))
+                                                          (TP
+                                                            (sqbkt (Var
+                                                                     "size"
+                                                                     CTy"Zsize")
+                                                                   (Var
+                                                                     "strm3"
+                                                                     (LTy
+                                                                       F8)))))
+                                                        (Call "Zfull_inst"
+                                                          CTy"Zinst"
+                                                          (TP
+                                                            (sqbkt (Var
+                                                                     "p"
+                                                                     (LTy
+                                                                       F8))
+                                                                   (Call
+                                                                     "Zbinop"
+                                                                     CTy"instruction"
+                                                                     (TP
+                                                                       (sqbkt (LC
+                                                                                "Ztest"
+                                                                                CTy"Zbinop_name")
+                                                                              (Var
+                                                                                "size"
+                                                                                CTy"Zsize")
+                                                                              (Call
+                                                                                "Zrm_i"
+                                                                                CTy"Zdest_src"
+                                                                                (TP
+                                                                                  (sqbkt (Var
+                                                                                           "rm"
+                                                                                           CTy"Zrm")
+                                                                                         (Var
+                                                                                           "imm"
+                                                                                           F64)))))))
+                                                                   (Var
+                                                                     "strm4"
+                                                                     (LTy
+                                                                       F8)))))))
+                                                    ((LW 2 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zmonop"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (LC
+                                                                              "Znot"
+                                                                              CTy"Zmonop_name")
+                                                                            (Var
+                                                                              "size"
+                                                                              CTy"Zsize")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm"))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((LW 3 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zmonop"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (LC
+                                                                              "Zneg"
+                                                                              CTy"Zmonop_name")
+                                                                            (Var
+                                                                              "size"
+                                                                              CTy"Zsize")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm"))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((LW 4 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zmul"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (Var
+                                                                              "size"
+                                                                              CTy"Zsize")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm"))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((LW 6 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zdiv"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (Var
+                                                                              "size"
+                                                                              CTy"Zsize")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm"))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((AVar (FTy 3))
+                                                      (Call "Zdec_fail"
+                                                        CTy"Zinst"
+                                                        (LS
+                                                          "Unsupported opcode: Unary Group 3"))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LT LT LT LT
+                                                         LT LF))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let
+                                         (TP
+                                           (sqbkt (Var "opcode" (FTy 3))
+                                                  (Var "rm" CTy"Zrm")
+                                                  (Var "strm3" (LTy F8))))
+                                         (Call "readOpcodeModRM"
+                                           (PTy (FTy 3)
+                                             (PTy CTy"Zrm" (LTy F8)))
+                                           (TP
+                                             (sqbkt (Var "REX" CTy"REX")
+                                                    (Var "strm2" (LTy F8)))))
+                                         (ITB
+                                           (sqbkt ((EQ
+                                                      (Var "opcode"
+                                                        (FTy 3)) (LW 0 3))
+                                                    (Call "Zfull_inst"
+                                                      CTy"Zinst"
+                                                      (TP
+                                                        (sqbkt (Var "p"
+                                                                 (LTy F8))
+                                                               (Call
+                                                                 "Zmonop"
+                                                                 CTy"instruction"
+                                                                 (TP
+                                                                   (sqbkt (LC
+                                                                            "Zinc"
+                                                                            CTy"Zmonop_name")
+                                                                          (Call
+                                                                            "Z8"
+                                                                            CTy"Zsize"
+                                                                            bVar"have_rex")
+                                                                          (Var
+                                                                            "rm"
+                                                                            CTy"Zrm"))))
+                                                               (Var
+                                                                 "strm3"
+                                                                 (LTy F8))))))
+                                                  ((EQ
+                                                      (Var "opcode"
+                                                        (FTy 3)) (LW 1 3))
+                                                    (Call "Zfull_inst"
+                                                      CTy"Zinst"
+                                                      (TP
+                                                        (sqbkt (Var "p"
+                                                                 (LTy F8))
+                                                               (Call
+                                                                 "Zmonop"
+                                                                 CTy"instruction"
+                                                                 (TP
+                                                                   (sqbkt (LC
+                                                                            "Zdec"
+                                                                            CTy"Zmonop_name")
+                                                                          (Call
+                                                                            "Z8"
+                                                                            CTy"Zsize"
+                                                                            bVar"have_rex")
+                                                                          (Var
+                                                                            "rm"
+                                                                            CTy"Zrm"))))
+                                                               (Var
+                                                                 "strm3"
+                                                                 (LTy F8)))))))
+                                           (Call "Zdec_fail" CTy"Zinst"
+                                             (LS
+                                               "Unsupported opcode: INC/DEC Group 4")))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LT LT LT LT LT LT
+                                                         LT LT))
+                                                (Var "strm2" (LTy F8))))
+                                       (Let (Var "size" CTy"Zsize")
+                                         (Call "OpSize" CTy"Zsize"
+                                           (TP
+                                             (sqbkt bVar"have_rex"
+                                                    (Dest "W" bTy
+                                                      (Var "REX" CTy"REX"))
+                                                    (LW 1 1)
+                                                    bVar"op_size_override")))
+                                         (Let
+                                           (TP
+                                             (sqbkt (Var "opcode" (FTy 3))
+                                                    (Var "rm" CTy"Zrm")
+                                                    (Var "strm3" (LTy F8))))
+                                           (Call "readOpcodeModRM"
+                                             (PTy (FTy 3)
+                                               (PTy CTy"Zrm" (LTy F8)))
+                                             (TP
+                                               (sqbkt (Var "REX" CTy"REX")
+                                                      (Var "strm2"
+                                                        (LTy F8)))))
+                                           (CS (Var "opcode" (FTy 3))
+                                             (sqbkt ((LW 0 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zmonop"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (LC
+                                                                              "Zinc"
+                                                                              CTy"Zmonop_name")
+                                                                            (Var
+                                                                              "size"
+                                                                              CTy"Zsize")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm"))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((LW 1 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zmonop"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (LC
+                                                                              "Zdec"
+                                                                              CTy"Zmonop_name")
+                                                                            (Var
+                                                                              "size"
+                                                                              CTy"Zsize")
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm"))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((LW 2 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zcall"
+                                                                   CTy"instruction"
+                                                                   (Call
+                                                                     "Zrm"
+                                                                     CTy"Zimm_rm"
+                                                                     (Var
+                                                                       "rm"
+                                                                       CTy"Zrm")))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((LW 4 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zjmp"
+                                                                   CTy"instruction"
+                                                                   (Var
+                                                                     "rm"
+                                                                     CTy"Zrm"))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((LW 6 3)
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zpush"
+                                                                   CTy"instruction"
+                                                                   (Call
+                                                                     "Zrm"
+                                                                     CTy"Zimm_rm"
+                                                                     (Var
+                                                                       "rm"
+                                                                       CTy"Zrm")))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))
+                                                    ((AVar (FTy 3))
+                                                      (Call "Zdec_fail"
+                                                        CTy"Zinst"
+                                                        (LS
+                                                          "Unsupported opcode: INC/DEC Group 5"))))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LF LF LF LF LT LT
+                                                         LT LT))
+                                                (LLC
+                                                  (sqbkt (LW 56 8)
+                                                         (Var "opc" F8))
+                                                  (AVar (LTy F8)))))
+                                       (Call "Zdec_fail" CTy"Zinst"
+                                         (CC(sqbkt LS
+                                                    "Unsupported opcode: 0F 38 "
+                                                   (Mop (Cast sTy)
+                                                     (Var "opc" F8))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LF LF LF LF LT LT
+                                                         LT LT))
+                                                (LLC
+                                                  (sqbkt (LW 58 8)
+                                                         (Var "opc" F8))
+                                                  (AVar (LTy F8)))))
+                                       (Call "Zdec_fail" CTy"Zinst"
+                                         (CC(sqbkt LS
+                                                    "Unsupported opcode: 0F 3A "
+                                                   (Mop (Cast sTy)
+                                                     (Var "opc" F8))))))
+                                     ((TP
+                                         (sqbkt (TP
+                                                  (sqbkt LF LF LF LF LT LT
+                                                         LT LT))
+                                                (LLC
+                                                  (sqbkt (Var "opc" F8))
+                                                  (Var "strm2" (LTy F8)))))
+                                       (Let
+                                         (TP
+                                           (sqbkt bVar"b'7" bVar"b'6"
+                                                  bVar"b'5" bVar"b'4"
+                                                  bVar"b'3" bVar"b'2"
+                                                  bVar"b'1" bVar"b'0"))
+                                         (BL 8 (Var "opc" F8))
+                                         (ITB
+                                           (sqbkt ((Bop And
+                                                      (Mop Not bVar"b'7")
+                                                      (Bop And bVar"b'6"
+                                                        (Bop And
+                                                          (Mop Not
+                                                            bVar"b'5")
+                                                          (Mop Not
+                                                            bVar"b'4"))))
+                                                    (Let
+                                                      (TP
+                                                        (sqbkt (Var "reg"
+                                                                 CTy"Zreg")
+                                                               (Var "rm"
+                                                                 CTy"Zrm")
+                                                               (Var
+                                                                 "strm3"
+                                                                 (LTy F8))))
+                                                      (Call "readModRM"
+                                                        (PTy CTy"Zreg"
+                                                          (PTy CTy"Zrm"
+                                                            (LTy F8)))
+                                                        (TP
+                                                          (sqbkt (Var
+                                                                   "REX"
+                                                                   CTy"REX")
+                                                                 (Var
+                                                                   "strm2"
+                                                                   (LTy
+                                                                     F8)))))
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zmov"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (Mop
+                                                                              (Cast
+                                                                                CTy"Zcond")
+                                                                              (EX
+                                                                                (Var
+                                                                                  "opc"
+                                                                                  F8)
+                                                                                (LN
+                                                                                  3)
+                                                                                (LN
+                                                                                  0)
+                                                                                F4))
+                                                                            (Call
+                                                                              "OpSize"
+                                                                              CTy"Zsize"
+                                                                              (TP
+                                                                                (sqbkt LT
+                                                                                       (Dest
+                                                                                         "W"
+                                                                                         bTy
+                                                                                         (Var
+                                                                                           "REX"
+                                                                                           CTy"REX"))
+                                                                                       (LW
+                                                                                         1
+                                                                                         1)
+                                                                                       bVar"op_size_override")))
+                                                                            (Call
+                                                                              "Zr_rm"
+                                                                              CTy"Zdest_src"
+                                                                              (TP
+                                                                                (sqbkt (Var
+                                                                                         "reg"
+                                                                                         CTy"Zreg")
+                                                                                       (Var
+                                                                                         "rm"
+                                                                                         CTy"Zrm")))))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8)))))))
+                                                  ((Bop And bVar"b'7"
+                                                      (Bop And
+                                                        (Mop Not
+                                                          bVar"b'6")
+                                                        (Bop And
+                                                          (Mop Not
+                                                            bVar"b'5")
+                                                          (Mop Not
+                                                            bVar"b'4"))))
+                                                    (Let
+                                                      (TP
+                                                        (sqbkt (Var "imm"
+                                                                 F64)
+                                                               (Var
+                                                                 "strm3"
+                                                                 (LTy F8))))
+                                                      (Call "immediate32"
+                                                        (PTy F64 (LTy F8))
+                                                        (Var "strm2"
+                                                          (LTy F8)))
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zjcc"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (Mop
+                                                                              (Cast
+                                                                                CTy"Zcond")
+                                                                              (EX
+                                                                                (Var
+                                                                                  "opc"
+                                                                                  F8)
+                                                                                (LN
+                                                                                  3)
+                                                                                (LN
+                                                                                  0)
+                                                                                F4))
+                                                                            (Var
+                                                                              "imm"
+                                                                              F64))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8)))))))
+                                                  ((Bop And bVar"b'7"
+                                                      (Bop And
+                                                        (Mop Not
+                                                          bVar"b'6")
+                                                        (Bop And bVar"b'5"
+                                                          (Bop And
+                                                            (Mop Not
+                                                              bVar"b'4")
+                                                            (Bop And
+                                                              (Mop Not
+                                                                bVar"b'3")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'2")
+                                                                (Bop And
+                                                                  bVar"b'1"
+                                                                  (Mop Not
+                                                                    bVar"b'0"))))))))
+                                                    (Call "Zfull_inst"
+                                                      CTy"Zinst"
+                                                      (TP
+                                                        (sqbkt (Var "p"
+                                                                 (LTy F8))
+                                                               (Const
+                                                                 "Zcpuid"
+                                                                 CTy"instruction")
+                                                               (Var
+                                                                 "strm2"
+                                                                 (LTy F8))))))
+                                                  ((Bop And bVar"b'7"
+                                                      (Bop And
+                                                        (Mop Not
+                                                          bVar"b'6")
+                                                        (Bop And bVar"b'5"
+                                                          (Bop And
+                                                            bVar"b'4"
+                                                            (Bop And
+                                                              (Mop Not
+                                                                bVar"b'3")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'2")
+                                                                (Mop Not
+                                                                  bVar"b'1")))))))
+                                                    (Let
+                                                      (TP
+                                                        (sqbkt (Var "reg"
+                                                                 CTy"Zreg")
+                                                               (Var "rm"
+                                                                 CTy"Zrm")
+                                                               (Var
+                                                                 "strm3"
+                                                                 (LTy F8))))
+                                                      (Call "readModRM"
+                                                        (PTy CTy"Zreg"
+                                                          (PTy CTy"Zrm"
+                                                            (LTy F8)))
+                                                        (TP
+                                                          (sqbkt (Var
+                                                                   "REX"
+                                                                   CTy"REX")
+                                                                 (Var
+                                                                   "strm2"
+                                                                   (LTy
+                                                                     F8)))))
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zcmpxchg"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (Call
+                                                                              "OpSize"
+                                                                              CTy"Zsize"
+                                                                              (TP
+                                                                                (sqbkt bVar"have_rex"
+                                                                                       (Dest
+                                                                                         "W"
+                                                                                         bTy
+                                                                                         (Var
+                                                                                           "REX"
+                                                                                           CTy"REX"))
+                                                                                       (EX
+                                                                                         (Var
+                                                                                           "opc"
+                                                                                           F8)
+                                                                                         (LN
+                                                                                           0)
+                                                                                         (LN
+                                                                                           0)
+                                                                                         F1)
+                                                                                       bVar"op_size_override")))
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm")
+                                                                            (Var
+                                                                              "reg"
+                                                                              CTy"Zreg"))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8)))))))
+                                                  ((Bop And bVar"b'7"
+                                                      (Bop And bVar"b'6"
+                                                        (Bop And
+                                                          (Mop Not
+                                                            bVar"b'5")
+                                                          (Bop And
+                                                            (Mop Not
+                                                              bVar"b'4")
+                                                            (Bop And
+                                                              (Mop Not
+                                                                bVar"b'3")
+                                                              (Bop And
+                                                                (Mop Not
+                                                                  bVar"b'2")
+                                                                (Mop Not
+                                                                  bVar"b'1")))))))
+                                                    (Let
+                                                      (TP
+                                                        (sqbkt (Var "reg"
+                                                                 CTy"Zreg")
+                                                               (Var "rm"
+                                                                 CTy"Zrm")
+                                                               (Var
+                                                                 "strm3"
+                                                                 (LTy F8))))
+                                                      (Call "readModRM"
+                                                        (PTy CTy"Zreg"
+                                                          (PTy CTy"Zrm"
+                                                            (LTy F8)))
+                                                        (TP
+                                                          (sqbkt (Var
+                                                                   "REX"
+                                                                   CTy"REX")
+                                                                 (Var
+                                                                   "strm2"
+                                                                   (LTy
+                                                                     F8)))))
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zxadd"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (Call
+                                                                              "OpSize"
+                                                                              CTy"Zsize"
+                                                                              (TP
+                                                                                (sqbkt bVar"have_rex"
+                                                                                       (Dest
+                                                                                         "W"
+                                                                                         bTy
+                                                                                         (Var
+                                                                                           "REX"
+                                                                                           CTy"REX"))
+                                                                                       (EX
+                                                                                         (Var
+                                                                                           "opc"
+                                                                                           F8)
+                                                                                         (LN
+                                                                                           0)
+                                                                                         (LN
+                                                                                           0)
+                                                                                         F1)
+                                                                                       bVar"op_size_override")))
+                                                                            (Var
+                                                                              "rm"
+                                                                              CTy"Zrm")
+                                                                            (Var
+                                                                              "reg"
+                                                                              CTy"Zreg"))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8)))))))
+                                                  ((Bop And bVar"b'7"
+                                                      (Bop And
+                                                        (Mop Not
+                                                          bVar"b'6")
+                                                        (Bop And bVar"b'5"
+                                                          (Bop And
+                                                            bVar"b'4"
+                                                            (Bop And
+                                                              (Mop Not
+                                                                bVar"b'3")
+                                                              (Bop And
+                                                                bVar"b'2"
+                                                                bVar"b'1"))))))
+                                                    (Let
+                                                      (TP
+                                                        (sqbkt (Var "reg"
+                                                                 CTy"Zreg")
+                                                               (Var "rm"
+                                                                 CTy"Zrm")
+                                                               (Var
+                                                                 "strm3"
+                                                                 (LTy F8))))
+                                                      (Call "readModRM"
+                                                        (PTy CTy"Zreg"
+                                                          (PTy CTy"Zrm"
+                                                            (LTy F8)))
+                                                        (TP
+                                                          (sqbkt (Var
+                                                                   "REX"
+                                                                   CTy"REX")
+                                                                 (Var
+                                                                   "strm2"
+                                                                   (LTy
+                                                                     F8)))))
+                                                      (Call "Zfull_inst"
+                                                        CTy"Zinst"
+                                                        (TP
+                                                          (sqbkt (Var "p"
+                                                                   (LTy
+                                                                     F8))
+                                                                 (Call
+                                                                   "Zmovzx"
+                                                                   CTy"instruction"
+                                                                   (TP
+                                                                     (sqbkt (Call
+                                                                              "OpSize"
+                                                                              CTy"Zsize"
+                                                                              (TP
+                                                                                (sqbkt bVar"have_rex"
+                                                                                       (Dest
+                                                                                         "W"
+                                                                                         bTy
+                                                                                         (Var
+                                                                                           "REX"
+                                                                                           CTy"REX"))
+                                                                                       (LW
+                                                                                         1
+                                                                                         1)
+                                                                                       bVar"op_size_override")))
+                                                                            (Call
+                                                                              "Zr_rm"
+                                                                              CTy"Zdest_src"
+                                                                              (TP
+                                                                                (sqbkt (Var
+                                                                                         "reg"
+                                                                                         CTy"Zreg")
+                                                                                       (Var
+                                                                                         "rm"
+                                                                                         CTy"Zrm"))))
+                                                                            (ITE
+                                                                              (EQ
+                                                                                (EX
+                                                                                  (Var
+                                                                                    "opc"
+                                                                                    F8)
+                                                                                  (LN
+                                                                                    0)
+                                                                                  (LN
+                                                                                    0)
+                                                                                  F1)
+                                                                                (LW
+                                                                                  1
+                                                                                  1))
+                                                                              (Const
+                                                                                "Z16"
+                                                                                CTy"Zsize")
+                                                                              (Call
+                                                                                "Z8"
+                                                                                CTy"Zsize"
+                                                                                bVar"have_rex")))))
+                                                                 (Var
+                                                                   "strm3"
+                                                                   (LTy
+                                                                     F8))))))))
+                                           (Call "Zdec_fail" CTy"Zinst"
+                                             (CC(sqbkt LS
+                                                        "Unsupported opcode: 0F "
+                                                       (Mop (Cast sTy)
+                                                         (Var "opc" F8))))))))
+                                     ((TP
+                                         (sqbkt (AVar
+                                                  (PTy bTy
+                                                    (PTy bTy
+                                                      (PTy bTy
+                                                        (PTy bTy
+                                                          (PTy bTy
+                                                            (PTy bTy
+                                                              (PTy bTy
+                                                                bTy))))))))
+                                                (AVar (LTy F8))))
+                                       (Call "Zdec_fail" CTy"Zinst"
+                                         (CC(sqbkt LS
+                                                    "Unsupported opcode: "
+                                                   (Mop (Cast sTy)
+                                                     (Var "v#0" F8)))))))))
+                          ((LNL F8)
+                            (Call "Zdec_fail" CTy"Zinst" (LS"No opcode")))))))))))
+
+
+(Def "x64_fetch" qVar"state"
+  (Let (TP (sqbkt (Var "r" (LTy F8)) (Var "s1" (PTy (LTy F8) qTy))))
+    (Let (Var "s" (PTy (LTy F8) qTy))
+      (Mop Snd
+        (Apply
+          (For
+            (TP
+              (sqbkt LN 19 LN 0
+                     (Close nVar"i"
+                       (Close (Var "state" (PTy (LTy F8) qTy))
+                         (TP
+                           (sqbkt LU
+                                  (LLC
+                                    (sqbkt (Mop ValOf
+                                             (Apply
+                                               (Dest "MEM"
+                                                 (ATy F64 (OTy F8))
+                                                 (Mop Snd
+                                                   (Var "state"
+                                                     (PTy (LTy F8) qTy))))
+                                               (Bop Add
+                                                 (Dest "RIP" F64
+                                                   (Mop Snd
+                                                     (Var "state"
+                                                       (PTy (LTy F8) qTy))))
+                                                 (Mop (Cast F64) nVar"i")))))
+                                    (Mop Fst
+                                      (Var "state" (PTy (LTy F8) qTy))))
+                                  (Mop Snd
+                                    (Var "state" (PTy (LTy F8) qTy))))))))))
+          (TP (sqbkt (LNL F8) qVar"state"))))
+      (TP
+        (sqbkt (Mop Fst (Var "s" (PTy (LTy F8) qTy)))
+               (Var "s" (PTy (LTy F8) qTy)))))
+    (TP
+      (sqbkt (Var "r" (LTy F8)) (Mop Snd (Var "s1" (PTy (LTy F8) qTy)))))))
+
+
+(Def "checkIcache" nVar"n"
+  (Close qVar"state"
+    (Apply
+      (For
+        (TP
+          (sqbkt LN 0 (Bop Sub nVar"n" (LN 1))
+                 (Close nVar"i"
+                   (Close qVar"state"
+                     (Let (Var "v" F64)
+                       (Bop Add (Dest "RIP" F64 qVar"state")
+                         (Mop (Cast F64) nVar"i"))
+                       (ITE
+                         (Mop Not
+                           (EQ
+                             (Apply
+                               (Dest "MEM" (ATy F64 (OTy F8)) qVar"state")
+                               (Var "v" F64))
+                             (Apply
+                               (Dest "ICACHE" (ATy F64 (OTy F8))
+                                 qVar"state") (Var "v" F64))))
+                         (Apply
+                           (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                             (Call "FAIL" CTy"exception"
+                               (LS"icache miss"))) qVar"state")
+                         (TP (sqbkt LU qVar"state"))))))))) qVar"state")))
+
+
+(Def "x64_next" qVar"state"
+  (CS
+    (Call "x64_decode" CTy"Zinst"
+      (Mop Fst
+        (Apply (Const "x64_fetch" (ATy qTy (PTy (LTy F8) qTy)))
+          qVar"state")))
+    (sqbkt ((Call "Zfull_inst" CTy"Zinst"
+               (TP
+                 (sqbkt (AVar (LTy F8)) (Var "i" CTy"instruction")
+                        (Var "strm1" (LTy F8)))))
+             (Let nVar"len"
+               (Bop Sub (LN 20) (Mop Length (Var "strm1" (LTy F8))))
+               (Let qVar"s"
+                 (Mop Snd
+                   (Apply
+                     (Call "checkIcache" (ATy qTy (PTy uTy qTy))
+                       nVar"len") qVar"state"))
+                 (Apply
+                   (Call "Run" (ATy qTy (PTy uTy qTy))
+                     (Var "i" CTy"instruction"))
+                   (Rupd "RIP"
+                     (TP
+                       (sqbkt qVar"s"
+                              (Bop Add (Dest "RIP" F64 qVar"s")
+                                (Mop (Cast F64) nVar"len")))))))))
+           ((Call "Zdec_fail" CTy"Zinst" sVar"s0")
+             (Apply
+               (Call "raise'exception" (ATy qTy (PTy uTy qTy))
+                 (Call "FAIL" CTy"exception" sVar"s0")) qVar"state")))))
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/x86-64/x64.spec acl2-6.3/books/translators/l3-to-acl2/examples/x86-64/x64.spec
--- acl2-6.2/books/translators/l3-to-acl2/examples/x86-64/x64.spec	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/x86-64/x64.spec	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,1287 @@
+-- =======================
+-- Specification of x86-64
+-- =======================
+
+type byte = bits(8)
+type word = bits(16)
+type dword = bits(32)
+type qword = bits(64)
+
+type stream = byte list
+
+---------------------------------------------------------------------------
+
+-- ===============
+-- The State Space
+-- ===============
+
+exception FAIL :: string
+
+------------
+-- Registers
+------------
+
+-- General purpose registers
+
+construct Zreg
+  { RAX RCX RDX RBX RSP RBP RSI RDI zR8 zR9 zR10 zR11 zR12 zR13 zR14 zR15 }
+
+type reg = Zreg -> qword
+
+declare REG :: reg
+
+-- The program counter
+
+declare RIP :: qword
+
+---------
+-- Memory
+---------
+
+exception BadMemAccess :: qword
+
+type mem = qword -> byte option
+
+declare MEM :: mem
+declare ICACHE :: mem
+
+component mem8 (addr :: qword) :: byte
+{
+   value =
+      match MEM (addr)
+      {
+         case Some (b) => b
+         case None => #BadMemAccess(addr)
+      }
+   assign b =
+      if IsSome (MEM (addr))
+         then MEM (addr) <- Some (b)
+      else #BadMemAccess(addr)
+}
+
+component mem16 (addr :: qword) :: word
+{
+   value = ( mem8 (addr + 1) : mem8 (addr) )
+   assign w =
+      { mem8 (addr)     <- w<7:0>;
+        mem8 (addr + 1) <- w<15:8>
+      }
+}
+
+component mem32 (addr :: qword) :: dword
+{
+   value = ( mem16 (addr + 2) : mem16 (addr) )
+   assign w =
+      { mem16 (addr)     <- w<15:0>;
+        mem16 (addr + 2) <- w<31:16>
+      }
+}
+
+component mem64 (addr :: qword) :: qword
+{
+   value = ( mem32 (addr + 4) : mem32 (addr) )
+   assign w =
+      { mem32 (addr)     <- w<31:0>;
+        mem32 (addr + 4) <- w<63:32>
+      }
+}
+
+--------
+-- Flags
+--------
+
+exception BadFlagAccess :: string
+
+construct Zeflags { Z_CF Z_PF Z_AF Z_ZF Z_SF Z_OF }
+
+type eflags = Zeflags -> bool option
+
+declare EFLAGS :: eflags
+
+component Eflag (flag :: Zeflags) :: bool
+{
+   value =
+      match EFLAGS (flag)
+      {
+         case Some (b) => b
+         case None => #BadFlagAccess([flag])
+      }
+  assign b = EFLAGS (flag) <- Some (b)
+}
+
+unit FlagUnspecified (flag :: Zeflags) = EFLAGS (flag) <- None
+
+component CF :: bool { value = Eflag (Z_CF) assign b = Eflag (Z_CF) <- b }
+component PF :: bool { value = Eflag (Z_PF) assign b = Eflag (Z_PF) <- b }
+component AF :: bool { value = Eflag (Z_AF) assign b = Eflag (Z_AF) <- b }
+component ZF :: bool { value = Eflag (Z_ZF) assign b = Eflag (Z_ZF) <- b }
+component SF :: bool { value = Eflag (Z_SF) assign b = Eflag (Z_SF) <- b }
+component OF :: bool { value = Eflag (Z_OF) assign b = Eflag (Z_OF) <- b }
+
+---------------------------------------------------------------------------
+
+-- =========
+-- AST types
+-- =========
+
+construct Zsize { Z8 :: bool Z16 Z32 Z64 }
+
+construct Zbase
+{
+  ZnoBase
+  ZripBase
+  ZregBase :: Zreg
+}
+
+construct Zrm
+{
+  Zr :: Zreg    -- register
+  Zm :: (bits(2) * Zreg) option * Zbase * qword
+                -- mem [2^{scale} * index + base + displacement]
+}
+
+-- Here XX is one of 8, 16, 32, 64.
+construct Zdest_src
+{
+  Zrm_i :: Zrm * qword   -- mnemonic r/mXX, immXX (sign-extended)
+  Zrm_r :: Zrm * Zreg    -- mnemonic r/mXX, rXX
+  Zr_rm :: Zreg * Zrm    -- mnemonic rXX, r/mXX
+}
+
+construct Zimm_rm
+{
+   Zrm  :: Zrm    -- r/mXX
+   Zimm :: qword  -- sign-extended immediate
+}
+
+construct Zmonop_name { Zdec Zinc Znot Zneg }
+
+construct Zbinop_name
+  { Zadd Zor  Zadc Zsbb Zand Zsub Zxor  Zcmp
+    Zrol Zror Zrcl Zrcr Zshl Zshr Ztest Zsar }
+
+construct Zcond
+{                 -- N = not
+  Z_O    Z_NO     -- O = overflow
+  Z_B    Z_NB     -- B = below
+  Z_E    Z_NE     -- E = equal
+  Z_NA   Z_A      -- A = above
+  Z_S    Z_NS     -- S = signed
+  Z_P    Z_NP     -- P = parity
+  Z_L    Z_NL     -- L = less
+  Z_NG   Z_G      -- L = greater
+  Z_ALWAYS
+}
+
+---------------------------------------------------------------------------
+
+-- =====================
+-- Instruction Semantics
+-- =====================
+
+-- Effective addresses
+
+construct Zea
+{
+  Zea_i :: Zsize * qword   -- Constant
+  Zea_r :: Zsize * Zreg    -- Register name
+  Zea_m :: Zsize * qword   -- Memory address
+}
+
+qword ea_index (index :: (bits(2) * Zreg) option) =
+   match index
+   {
+      case None => 0
+      case Some (scale, idx) => 1 << [scale] * REG (idx)
+   }
+
+qword ea_base (base :: Zbase) =
+   match base
+   {
+      case ZnoBase => 0
+      case ZripBase => RIP
+      case ZregBase (b) => REG (b)
+   }
+
+Zea ea_Zrm (size :: Zsize, rm :: Zrm) =
+   match rm
+   {
+     case Zr (r) => Zea_r (size, r)
+     case Zm (index, base, displacement) =>
+        Zea_m (size, ea_index (index) + ea_base (base) + displacement)
+   }
+
+Zea ea_Zdest (size :: Zsize, ds :: Zdest_src) =
+   match ds
+   {
+      case Zrm_i (rm, _) => ea_Zrm (size, rm)
+      case Zrm_r (rm, _) => ea_Zrm (size, rm)
+      case Zr_rm (r, _)  => Zea_r (size, r)
+   }
+
+Zea ea_Zsrc (size :: Zsize, ds :: Zdest_src) =
+   match ds
+   {
+      case Zrm_i (_, i)  => Zea_i (size, i)
+      case Zrm_r (_, r)  => Zea_r (size, r)
+      case Zr_rm (_, rm) => ea_Zrm (size, rm)
+   }
+
+Zea ea_Zimm_rm (size :: Zsize, imm_rm :: Zimm_rm) =
+   match imm_rm
+   {
+      case Zrm (rm)   => ea_Zrm (size, rm)
+      case Zimm (imm) => Zea_i (size, imm)
+   }
+
+-- Reading / Writing an EA
+
+qword restrictSize (size :: Zsize, imm :: qword) =
+   match size
+   {
+      case Z8 (_) => imm && 0xFF
+      case Z16    => imm && 0xFFFF
+      case Z32    => imm && 0xFFFFFFFF
+      case Z64    => imm
+   }
+
+component EA (ea :: Zea) :: qword
+{
+   value =
+      match ea
+      {
+         case Zea_i (i) => restrictSize (i)
+         case Zea_r (Z8 (have_rex), r) =>
+            if have_rex or r notin set { RSP, RBP, RSI, RDI }
+               then REG (r) && 0xFF
+            else (REG ([[r] - 0n4]) >>+ 8) && 0xFF
+         case Zea_r (s, r)      => restrictSize (s, REG (r))
+         case Zea_m (Z8 (_), a) => [mem8 (a)]
+         case Zea_m (Z16, a)    => [mem16 (a)]
+         case Zea_m (Z32, a)    => [mem32 (a)]
+         case Zea_m (Z64, a)    => mem64 (a)
+      }
+   assign w =
+      match ea
+      {
+         case Zea_i (i) => #FAIL ("write to constant")
+         case Zea_r (Z8 (have_rex), r) =>
+            if have_rex or r notin set { RSP, RBP, RSI, RDI }
+               then REG (r)<7:0> <- w<7:0>
+            else REG ([[r] - 0n4])<15:8> <- w<7:0>
+         case Zea_r (Z16, r)       => REG (r)<15:0> <- w<15:0>
+         case Zea_r (Z32, r)       => REG (r) <- ZeroExtend (w<31:0>)
+         case Zea_r (Z64, r)       => REG (r) <- w
+         case Zea_m (Z8 (_), a)    => mem8 (a) <- w<7:0>
+         case Zea_m (Z16, a)       => mem16 (a) <- w<15:0>
+         case Zea_m (Z32, a)       => mem32 (a) <- w<31:0>
+         case Zea_m (Z64, a)       => mem64 (a) <- w
+      }
+}
+
+Zea * qword * qword read_dest_src_ea (sd :: Zsize * Zdest_src) =
+{
+   ea = ea_Zdest (sd);
+   return (ea, EA (ea), EA (ea_Zsrc (sd)))
+}
+
+-- Find the destination according to procedure call semantics
+qword call_dest_from_ea (ea :: Zea) =
+   match ea
+   {
+      case Zea_i (_, i) => RIP + i
+      case Zea_r (_, r) => REG (r)
+      case Zea_m (_, a) => mem64 (a)
+   }
+
+qword get_ea_address (ea :: Zea) =
+   match ea
+   {
+      case Zea_i (_, i) => 0
+      case Zea_r (_, r) => 0
+      case Zea_m (_, a) => a
+   }
+
+-- RIP update
+
+-- Update RIP according to procedure call
+unit jump_to_ea (ea :: Zea) = RIP <- call_dest_from_ea (ea)
+
+-- EFLAG updates
+
+bool ByteParity (b :: byte) =
+{  count = [b<7>] + [b<6>] + [b<5>] + [b<4>] +
+           [b<3>] + [b<2>] + [b<1>] + [b<0>] :: nat;
+   return (count mod 2 == 0)
+}
+
+nat Zsize_width (size :: Zsize) =
+   match size
+   {
+      case Z8 (_) => 8
+      case Z16    => 16
+      case Z32    => 32
+      case Z64    => 64
+   }
+
+bool word_size_msb (size :: Zsize, w :: qword) = ( w<Zsize_width (size) - 1> )
+
+unit write_PF (w :: qword) = PF <- ByteParity (w<7:0>)
+
+unit write_SF (s_w :: Zsize * qword) = SF <- word_size_msb (s_w)
+
+unit write_ZF (size :: Zsize, w :: qword) =
+   ZF <- match size
+         {
+            case Z8 (_)  => [w] == 0`8
+            case Z16     => [w] == 0`16
+            case Z32     => [w] == 0`32
+            case Z64     => w == 0
+         }
+
+unit write_logical_eflags (size :: Zsize, w :: qword) =
+{
+   CF <- false;
+   OF <- false;
+   write_PF (w);
+   write_SF (size, w);
+   write_ZF (size, w);
+   FlagUnspecified (Z_AF)
+}
+
+unit write_arith_eflags_except_CF_OF (size :: Zsize, w :: qword) =
+{
+   write_PF (w);
+   write_SF (size, w);
+   write_ZF (size, w);
+   FlagUnspecified (Z_AF)
+}
+
+type result = qword * bool * bool
+
+unit write_arith_eflags (size :: Zsize, r :: result) =
+{
+   w, c, x = r;
+   CF <- c;
+   OF <- x;
+   write_arith_eflags_except_CF_OF (size, w)
+}
+
+unit erase_eflags = EFLAGS <- InitMap (None)
+
+-- Bin-ops
+
+nat value_width (s :: Zsize) = 2 ** Zsize_width (s)
+
+bool word_signed_overflow_add (size :: Zsize, a :: qword, b :: qword) =
+  ( word_size_msb (size, a) == word_size_msb (size, b) and
+    word_size_msb (size, a + b) != word_size_msb (size, a) )
+
+bool word_signed_overflow_sub (size :: Zsize, a :: qword, b :: qword) =
+  ( word_size_msb (size, a) != word_size_msb (size, b) and
+    word_size_msb (size, a - b) != word_size_msb (size, a) )
+
+result add_with_carry_out (size :: Zsize, x :: qword, y :: qword) =
+   return (x + y, value_width (size) <= [x] + [y] :: nat,
+           word_signed_overflow_add (size, x, y))
+
+result sub_with_borrow (size :: Zsize, x :: qword, y :: qword) =
+   return (x - y, x <+ y, word_signed_overflow_sub (size, x, y))
+
+unit write_arith_result (size :: Zsize, r :: result, ea :: Zea) =
+{
+   write_arith_eflags (size, r);
+   EA (ea) <- Fst (r)
+}
+
+unit write_arith_result_no_CF_OF (size :: Zsize, w :: qword, ea :: Zea) =
+{
+   write_arith_eflags_except_CF_OF (size, w);
+   EA (ea) <- w
+}
+
+unit write_logical_result (size :: Zsize, w :: qword, ea :: Zea) =
+{
+   write_logical_eflags (size, w);
+   EA (ea) <- w
+}
+
+unit write_result_erase_eflags (w :: qword, ea :: Zea) =
+{
+   erase_eflags;
+   EA (ea) <- w
+}
+
+nat maskShift (size :: Zsize, w :: qword) =
+   if size == Z64 then [w<5:0>] else [w<4:0>]
+
+qword ROL (size :: Zsize, x :: qword, y :: qword) =
+   match size
+   {
+      case Z8 (_) => [x<7:0>  #<< ([y<4:0>]::nat)]
+      case Z16    => [x<15:0> #<< ([y<4:0>]::nat)]
+      case Z32    => [x<31:0> #<< ([y<4:0>]::nat)]
+      case Z64    => x #<< ([y<5:0>]::nat)
+   }
+
+qword ROR (size :: Zsize, x :: qword, y :: qword) =
+   match size
+   {
+      case Z8 (_) => [x<7:0>  #>> ([y<4:0>]::nat)]
+      case Z16    => [x<15:0> #>> ([y<4:0>]::nat)]
+      case Z32    => [x<31:0> #>> ([y<4:0>]::nat)]
+      case Z64    => x #>> ([y<5:0>]::nat)
+   }
+
+qword SAR (size :: Zsize, x :: qword, y :: qword) =
+   match size
+   {
+      case Z8 (_) => [x<7:0>  >> ([y<4:0>]::nat)]
+      case Z16    => [x<15:0> >> ([y<4:0>]::nat)]
+      case Z32    => [x<31:0> >> ([y<4:0>]::nat)]
+      case Z64    => x >> ([y<5:0>]::nat)
+   }
+
+unit write_binop
+   ( s :: Zsize,
+     bop :: Zbinop_name,
+     x :: qword,
+     y :: qword,
+     ea :: Zea) =
+   match bop
+   {
+      case Zadd  => write_arith_result (s, add_with_carry_out (s, x, y), ea)
+      case Zsub  => write_arith_result (s, sub_with_borrow (s, x, y), ea)
+      case Zcmp  => write_arith_eflags (s, sub_with_borrow (s, x, y))
+      case Ztest => write_logical_eflags (s, x && y)
+      case Zand  => write_logical_result (s, x && y, ea)
+      case Zxor  => write_logical_result (s, x ?? y, ea)
+      case Zor   => write_logical_result (s, x || y, ea)
+      case Zrol  => write_result_erase_eflags (ROL (s, x, y), ea)
+      case Zror  => write_result_erase_eflags (ROR (s, x, y), ea)
+      case Zsar  => write_result_erase_eflags (SAR (s, x, y), ea)
+      case Zshl  => write_result_erase_eflags (x << maskShift (s, y), ea)
+      case Zshr  => write_result_erase_eflags (x >>+ maskShift (s, y), ea)
+      case Zadc  =>
+         {
+            carry = CF;
+            result = x + y + [carry];
+            CF <- value_width (s) <= [x] + [y] + [carry] :: nat;
+            FlagUnspecified (Z_OF);
+            write_arith_result_no_CF_OF (s, result, ea)
+         }
+      case Zsbb  =>
+         {
+            carry = CF;
+            result = x - (y + [carry]);
+            CF <- [x] < [y] + [carry] :: nat;
+            FlagUnspecified (Z_OF);
+            write_arith_result_no_CF_OF (s, result, ea)
+         }
+      -- rcl and rcr
+      case _ => #FAIL ("Binary op not implemented: " : [bop])
+   }
+
+-- Mon-ops
+
+unit write_monop
+   ( s :: Zsize,
+     mop :: Zmonop_name,
+     x :: qword,
+     ea :: Zea) =
+   match mop
+   {
+      case Znot => EA (ea) <- ~x
+      case Zdec => write_arith_result_no_CF_OF (s, x - 1, ea)
+      case Zinc => write_arith_result_no_CF_OF (s, x + 1, ea)
+      case Zneg =>
+         {
+            write_arith_result_no_CF_OF (s, -x, ea);
+            FlagUnspecified (Z_CF)
+         }
+   }
+
+-- Evaluating conditions of eflags
+
+bool read_cond (c :: Zcond) =
+   match c
+   {
+      case Z_O  => OF
+      case Z_NO => not OF
+      case Z_B  => CF
+      case Z_NB => not CF
+      case Z_E  => ZF
+      case Z_NE => not ZF
+      case Z_A  => -- not CF and not ZF
+         match EFLAGS (Z_CF), EFLAGS (Z_ZF)
+         {
+            case Some (false), Some (false) => true
+            case Some (true), _ => false
+            case _, Some (true) => false
+            case _ => #BadFlagAccess("read_cond: " : [c])
+         }
+      case Z_NA => -- CF or ZF
+         match EFLAGS (Z_CF), EFLAGS (Z_ZF)
+         {
+            case Some (true), _ => true
+            case _, Some (true) => true
+            case Some (false), Some (false) => false
+            case _ => #BadFlagAccess("read_cond: " : [c])
+         }
+      case Z_S  => SF
+      case Z_NS => not SF
+      case Z_P  => PF
+      case Z_NP => not PF
+      case Z_L  => SF != OF
+      case Z_NL => SF == OF
+      case Z_G  => -- not ZF and SF == OF
+         match EFLAGS (Z_SF), EFLAGS (Z_OF)
+         {
+            case Some (a), Some (b) => a == b and not ZF
+            case _ =>
+               match EFLAGS (Z_ZF)
+               {
+                  case Some (true) => false
+                  case _ => #BadFlagAccess("read_cond: " : [c])
+               }
+         }
+      case Z_NG => -- ZF or SF != OF
+         match EFLAGS (Z_SF), EFLAGS (Z_OF)
+         {
+            case Some (a), Some (b) => a != b or ZF
+            case _ =>
+               match EFLAGS (Z_ZF)
+               {
+                  case Some (true) => true
+                  case _ => #BadFlagAccess("read_cond: " : [c])
+               }
+         }
+      case Z_ALWAYS => true
+   }
+
+-- Stack operations
+
+qword x64_pop_aux =
+{
+   rsp = REG (RSP);
+   top = mem64 (rsp);
+   REG (RSP) <- rsp + 8;
+   return top
+}
+
+unit x64_pop (rm :: Zrm) = EA (ea_Zrm (Z64, rm)) <- x64_pop_aux
+
+unit x64_pop_rip = RIP <- x64_pop_aux
+
+unit x64_push_aux (w :: qword) =
+{
+   rsp = REG (RSP) - 8;
+   REG (RSP) <- rsp;
+   mem64 (rsp) <- w
+}
+
+unit x64_push (imm_rm :: Zimm_rm) = x64_push_aux (EA (ea_Zimm_rm (Z64, imm_rm)))
+
+unit x64_push_rip = x64_push_aux (RIP)
+
+unit x64_drop (imm :: qword) =
+{
+   when imm<7:0> != 0 do #FAIL ("x64_drop");
+   REG (RSP) <- REG (RSP) + imm
+}
+
+---------------------------------------------------------------------------
+
+-- =====================
+-- Operational Semantics
+-- =====================
+
+define Zbinop (bop :: Zbinop_name, size :: Zsize, dst_src :: Zdest_src) =
+{
+   ea, val_dst, val_src = read_dest_src_ea (size, dst_src);
+   write_binop (size, bop, val_dst, val_src, ea)
+}
+
+define Zcall (imm_rm :: Zimm_rm) =
+{
+   x64_push_rip;
+   jump_to_ea (ea_Zimm_rm (Z64, imm_rm))
+}
+
+define Zcmpxchg (size :: Zsize, rm :: Zrm, r :: Zreg) =
+{
+   ea_src = Zea_r (size, r);
+   ea_acc = Zea_r (size, RAX);
+   ea_dst = ea_Zrm (size, rm);
+   val_dst = EA (ea_dst);
+   acc = EA (ea_src);
+   write_binop (size, Zcmp, acc, val_dst, ea_src);
+   if acc == val_dst
+      then EA (ea_dst) <- EA (ea_src)
+   else EA (ea_acc) <- val_dst
+}
+
+define Zcpuid =
+{
+   ICACHE <- MEM;
+   REG (RAX) <- UNKNOWN;
+   REG (RBX) <- UNKNOWN;
+   REG (RCX) <- UNKNOWN;
+   REG (RDX) <- UNKNOWN
+}
+
+define Zdiv (size :: Zsize, rm :: Zrm) =
+{
+   w = value_width (size);
+   ea_eax = Zea_r (size, RAX);
+   ea_edx = Zea_r (size, RAX);
+   n = [EA (ea_eax)] * w + [EA (ea_edx)] :: nat;
+   d = [EA (ea_Zrm (size, rm))] :: nat;
+   q = n div d;
+   r = n mod d;
+   when d == 0 or w <= q do #FAIL ("division");
+   EA (ea_eax) <- [q];
+   EA (ea_edx) <- [r];
+   erase_eflags
+}
+
+-- includes jmp rel, i.e. unconditional relative jumps.
+define Zjcc (cond :: Zcond, imm :: qword) =
+   when read_cond (cond) do RIP <- RIP + imm
+
+-- jmp excludes relative jumps, see jcc.
+define Zjmp (rm :: Zrm) = RIP <- EA (ea_Zrm (Z64, rm))
+
+define Zlea (size :: Zsize, dst_src :: Zdest_src) =
+{
+   ea_src = ea_Zsrc (size, dst_src);
+   ea_dst = ea_Zdest (size, dst_src);
+   EA (ea_dst) <- get_ea_address (ea_src)
+}
+
+define Zloop (cond :: Zcond, imm :: qword) =
+{
+   ecx1 = REG (RCX) - 1;
+   REG (RCX) <- ecx1;
+   when ecx1 != 0 and read_cond (cond) do RIP <- RIP + imm
+}
+
+define Zmonop (mop :: Zmonop_name, size :: Zsize, rm :: Zrm) =
+{
+   ea = ea_Zrm (size, rm);
+   write_monop (size, mop, EA (ea), ea)
+}
+
+define Zmov (cond :: Zcond, size :: Zsize, dst_src :: Zdest_src) =
+   when read_cond (cond) do
+   {
+      ea_src = ea_Zsrc (size, dst_src);
+      ea_dst = ea_Zdest (size, dst_src);
+      EA (ea_dst) <- EA (ea_src)
+   }
+
+define Zmovzx (size1 :: Zsize, dst_src :: Zdest_src, size2 :: Zsize) =
+   EA (ea_Zdest (size2, dst_src)) <- EA (ea_Zsrc (size1, dst_src))
+
+define Zmul (size :: Zsize, rm :: Zrm) =
+{
+   ea_eax = Zea_r (size, RAX);
+   eax = EA (ea_eax);
+   val_src = EA (ea_Zrm (size, rm));
+   match size
+   {
+      case Z8 (_) => EA (Zea_r (Z16, RAX)) <- eax * val_src
+      case _ =>
+      {
+         EA (ea_eax) <- eax * val_src;
+         ea_edx = Zea_r (size, RDX);
+         EA (ea_edx) <- [([eax] * [val_src] :: nat) div value_width (size)]
+      }
+   };
+   erase_eflags  -- over appoximation
+}
+
+define Znop = ()
+
+define Zpop (rm :: Zrm) = x64_pop (rm)
+
+define Zpush (imm_rm :: Zimm_rm) = x64_push (imm_rm)
+
+define Zret (imm :: qword) =
+{
+   x64_pop_rip;
+   x64_drop (imm)
+}
+
+define Zxadd (size :: Zsize, rm :: Zrm, r :: Zreg) =
+{
+   ea_src = Zea_r (size, r);
+   ea_dst = ea_Zrm (size, rm);
+   val_src = EA (ea_src);
+   val_dst = EA (ea_dst);
+   EA (ea_src) <- val_dst;
+   write_binop (size, Zadd, val_src, val_dst, ea_dst)
+}
+
+define Zxchg (size :: Zsize, rm :: Zrm, r :: Zreg) =
+{
+   ea_src = Zea_r (size, r);
+   ea_dst = ea_Zrm (size, rm);
+   val_src = EA (ea_src);
+   val_dst = EA (ea_dst);
+   EA (ea_src) <- val_dst;
+   EA (ea_dst) <- val_src
+}
+
+define Run
+
+---------------------------------------------------------------------------
+
+-- ====================
+-- Instruction Decoding
+-- ====================
+
+construct Zinst
+{
+  Zfull_inst :: stream * instruction * stream
+  Zdec_fail  :: string
+}
+
+-- Parse immediates
+
+qword * stream immediate8 (strm :: stream) =
+   match strm
+   {  case Cons (b, t) => SignExtend (b), t
+      case _ => UNKNOWN
+   }
+
+qword * stream immediate16 (strm :: stream) =
+   match strm {
+      case Cons (b1, Cons (b2, t)) => SignExtend (b2 : b1 ), t
+      case _ => UNKNOWN
+   }
+
+qword * stream immediate32 (strm :: stream) =
+   match strm {
+      case Cons (b1, Cons (b2, (Cons (b3, Cons (b4, t))))) =>
+        SignExtend (b4 : b3 : b2 : b1), t
+      case _ => UNKNOWN
+   }
+
+qword * stream immediate64 (strm :: stream) =
+   match strm {
+      case Cons (b1, Cons (b2, (Cons (b3, Cons (b4,
+           Cons (b5, Cons (b6, (Cons (b7, Cons (b8, t)))))))))) =>
+        (b8 : b7 : b6 : b5 : b4 : b3 : b2 : b1), t
+      case _ => UNKNOWN
+   }
+
+qword * stream immediate (size :: Zsize, strm :: stream) =
+   match size
+   {
+      case Z8 (_) => immediate8 (strm)
+      case Z16    => immediate16 (strm)
+      case _      => immediate32 (strm)
+   }
+
+qword * stream full_immediate (size :: Zsize, strm :: stream) =
+ ( if size == Z64 then immediate64 (strm) else immediate (size, strm) )
+
+---------------------------------------------------------------------------
+
+-- Parse the ModRM and SIB bytes
+
+register REX :: bits(4) { 3:W, 2:R, 1:X, 0:B }
+
+Zreg RexReg (b :: bool, r :: bits(3)) = [[b]`1 : r]
+
+qword * stream readDisplacement (Mod :: bits(2), strm :: stream) =
+   if Mod == 1
+      then immediate8 (strm)
+   else if Mod == 2
+      then immediate32 (strm)
+   else (0, strm)
+
+qword * stream readSibDisplacement (Mod :: bits(2), strm :: stream) =
+   if Mod == 0
+      then (0, strm)
+   else if Mod == 1
+      then immediate8 (strm)
+   else immediate32 (strm)
+
+Zrm * stream readSIB (REX :: REX, Mod :: bits(2), strm :: stream) =
+   match strm
+   {  case Cons ('SS Index Base', strm1) =>
+         { base = RexReg (REX.B, Base);
+           index = RexReg (REX.X, Index);
+           scaled_index = if index == RSP then None else Some (SS, index);
+           if base == RBP
+              then {  displacement, strm2 = readSibDisplacement (Mod, strm1);
+                      base = if Mod == 0 then ZnoBase else ZregBase (base);
+                      return (Zm (scaled_index, base, displacement), strm2)
+                   }
+           else
+           {  displacement, strm2 = readDisplacement (Mod, strm1);
+              return (Zm (scaled_index, ZregBase (base), displacement), strm2)
+           }
+         }
+      case _ => return (UNKNOWN, strm)
+   }
+
+Zreg * Zrm * stream readModRM (REX :: REX, strm :: stream) =
+   match strm {
+     case Cons ('00 RegOpc 101', strm1) =>
+       { displacement, strm2 = immediate32 (strm1);
+         return
+            (RexReg (REX.R, RegOpc), Zm (None, ZripBase, displacement), strm2)
+       }
+     case Cons ('11 REG RM', strm1) =>
+         return (RexReg (REX.R, REG), Zr (RexReg (REX.B, RM)), strm1)
+     case Cons ('Mod RegOpc 100', strm1) =>
+       { sib, strm2 = readSIB (REX, Mod, strm1);
+         return (RexReg (REX.R, RegOpc), sib, strm2)
+       }
+     case Cons ('Mod RegOpc RM', strm1) =>
+       { displacement, strm2 = readDisplacement (Mod, strm1);
+         return
+            (RexReg (REX.R, RegOpc),
+             Zm (None, ZregBase (RexReg (REX.B, RM)), displacement),
+             strm2)
+       }
+     case _ => return (UNKNOWN, UNKNOWN, strm)
+   }
+
+bits(3) * Zrm * stream readOpcodeModRM (REX :: REX, strm :: stream) =
+{  opcode, rm, strm1 = readModRM (REX, strm);
+   return ([[opcode] mod 0n8], rm, strm1)
+}
+
+---------------------------------------------------------------------------
+
+-- Parse Prefixes
+
+nat prefixGroup (b :: byte) =
+   match b
+   { case 0xF0 or 0xF2 or 0xF3 => 1
+     case 0x26 or 0x2E or 0x36 or 0x3E or 0x64 or 0x65 => 2
+     case 0x66 => 3
+     case 0x67 => 4
+     case _ => if b<7:4> == '0100' then 5 else 0
+   }
+
+(stream * bool * REX * stream) option
+   readPrefix (s :: nat set, p :: stream, strm :: stream) =
+   match strm
+   {  case Cons (h, strm1) =>
+         {  group = prefixGroup (h);
+            if group == 0
+               then Some (p, false, REX ('0000'), strm)
+            else if group == 5
+               then Some (p, true, REX (h<3:0>), strm1)
+            else if group in s
+               then None
+            else readPrefix (group insert s, Cons (h, p), strm1)
+         }
+     case Nil => Some (p, false, UNKNOWN, strm)
+   }
+
+(stream * bool * REX * stream) option readPrefixes (strm :: stream) =
+   readPrefix (set {}, Nil, strm)
+
+---------------------------------------------------------------------------
+
+-- Operand Size
+
+-- w from REX.W
+-- v from opcode
+-- override from 0x66 prefix
+
+-- r/m8, imm8        not v
+-- r/m16, imm16      override and not w and v
+-- r/m32, imm32      not W and v
+-- r/m64, imm32      w and v
+
+Zsize OpSize (have_rex :: bool, w :: bool, v :: bits(1), override :: bool) =
+   ( if v == 0
+        then Z8 (have_rex)
+     else if w
+        then Z64
+     else if override
+        then Z16
+     else Z32 )
+
+---------------------------------------------------------------------------
+
+-- Tests
+
+bool isZm (rm :: Zrm) =
+   match rm {
+     case Zm (_) => true
+     case _ => false
+   }
+
+---------------------------------------------------------------------------
+
+-- The decoder
+
+Zinst x64_decode (strm :: stream) =
+match readPrefixes (strm)
+{ case None => Zdec_fail ("Bad prefix")
+  case Some (p, have_rex, REX, strm1) =>
+  { op_size_override = 0x66 in SetOfList(p);
+    if REX.W and op_size_override
+       then Zdec_fail ("REX.W together with override prefix")
+    else
+       match strm1
+       { -- Binop (ADD..CMP)
+         -- ADD r/mX, rX
+         -- ADD rX, r/mX
+         case Cons ('00 opc 0 x v', strm2) =>
+            { reg, rm, strm3 = readModRM (REX, strm2);
+              size = OpSize (have_rex, REX.W, v, op_size_override);
+              binop = [opc] :: Zbinop_name;
+              src_dst = if x == 0`1 then Zrm_r (rm, reg) else Zr_rm (reg, rm);
+              Zfull_inst (p, Zbinop (binop, size, src_dst), strm3)
+            }
+
+         -- Binop (ADD..CMP)
+         -- ADD EAX, immX
+         case Cons ('00 opc 1 0 v', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              imm, strm3 = immediate (size, strm2);
+              Zfull_inst (p, Zbinop ([opc], size, Zrm_i (Zr (RAX), imm)), strm3)
+            }
+
+         -- PUSH r/mX
+         -- POP r/mX
+         case Cons ('0x5 b r', strm2) =>
+            { reg = Zr ([[REX.B] : r]);
+              Zfull_inst
+                (p, (if b == 0`1 then Zpush (Zrm (reg)) else Zpop (reg)), strm2)
+            }
+
+         -- PUSH immX
+         case Cons ('0x6 10 b 0', strm2) =>
+            { imm, strm3 =
+                if b == 1 then immediate8 (strm2) else immediate32 (strm2);
+              Zfull_inst (p, Zpush (Zimm (imm)), strm3)
+            }
+
+         -- Jcc rel8
+         case Cons ('0x7 c', strm2) =>
+            { imm, strm3 = immediate8 (strm2);
+              Zfull_inst (p, Zjcc ([c], imm), strm3)
+            }
+
+         -- Immediate Group 1 (ADD..CMP)
+         -- ADD r/mX, immX
+         case Cons ('0x8 000 v', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+              imm, strm4 = immediate (size, strm3);
+              binop = [opcode] :: Zbinop_name;
+              Zfull_inst (p, Zbinop (binop, size, Zrm_i (rm, imm)), strm4)
+            }
+         -- ADD r/mX, imm8
+         case Cons (0x83, strm2) =>
+            { size = OpSize (false, REX.W, 1, op_size_override);
+              opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+              imm, strm4 = immediate8 (strm3);
+              binop = [opcode] :: Zbinop_name;
+              Zfull_inst (p, Zbinop (binop, size, Zrm_i (rm, imm)), strm4)
+            }
+
+         -- TEST r/mX, rX
+         case Cons ('0x8 010 v', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              reg, rm, strm3 = readModRM (REX, strm2);
+              Zfull_inst (p, Zbinop (Ztest, size, Zrm_r (rm, reg)), strm3)
+            }
+
+         -- XCHG r/mX, rX
+         case Cons ('0x8 011 v', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              reg, rm, strm3 = readModRM (REX, strm2);
+              Zfull_inst (p, Zxchg (size, rm, reg), strm3)
+            }
+
+         -- MOV r/mX, rX
+         -- MOV rX, r/mX
+         case Cons ('0x8 10 x v', strm2) =>
+            { reg, rm, strm3 = readModRM (REX, strm2);
+              size = OpSize (have_rex, REX.W, v, op_size_override);
+              src_dst = if x == 0`1 then Zrm_r (rm, reg) else Zr_rm (reg, rm);
+              Zfull_inst (p, Zmov (Z_ALWAYS, size, src_dst), strm3)
+            }
+
+         -- LEA r/mX, m
+         case Cons ('0x8D', strm2) =>
+            { size = OpSize (true, REX.W, 1, op_size_override);
+              reg, rm, strm3 = readModRM (REX, strm2);
+              if isZm (rm)
+                 then Zfull_inst (p, Zlea (size, Zr_rm (reg, rm)), strm3)
+              else Zdec_fail ("LEA with register argument")
+            }
+
+         -- Unary Group 1a
+         case Cons ('0x8F', strm2) =>
+            { opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+              if opcode == 0
+                 then Zfull_inst (p, Zpop (rm), strm3)
+              else Zdec_fail ("Unsupported opcode: Group 1a")
+            }
+
+         -- XCHG EAX, rX
+         case Cons ('0x9 0 r', strm2) =>
+            { size = OpSize (true, REX.W, 1, op_size_override);
+              reg = RexReg (REX.B, r);
+              if reg == RAX
+                 then Zfull_inst (p, Znop, strm2)
+              else Zfull_inst (p, Zxchg (size, Zr (RAX), reg), strm2)
+            }
+
+         -- TEST EAX, immX
+         case Cons ('0xA 100 v', strm2) =>
+            { size = OpSize (true, REX.W, v, op_size_override);
+              imm, strm3 = immediate (size, strm2);
+              Zfull_inst (p, Zbinop (Ztest, size, Zrm_i (Zr (RAX), imm)), strm3)
+            }
+
+         -- MOV rX, immX
+         case Cons ('0xB v r', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              imm, strm3 = full_immediate (size, strm2);
+              reg = [[REX.B] : r] :: Zreg;
+              Zfull_inst
+                 (p, Zmov (Z_ALWAYS, size, Zrm_i (Zr (reg), imm)), strm3)
+            }
+
+         -- Shift Group 2
+         case Cons ('0xC 000 v', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+              imm, strm4 = immediate8 (strm3);
+              binop = [[opcode] + 0n8] :: Zbinop_name;
+              if opcode == '110'
+                 then Zdec_fail ("Unsupported opcode: Shift Group 2")
+              else Zfull_inst (p, Zbinop (binop, size, Zrm_i (rm, imm)), strm4)
+            }
+
+         -- RETN
+         -- RETN imm16
+         case Cons ('0xC 001 v', strm2) =>
+            if v == 0
+               then { imm, strm3 = immediate16 (strm2);
+                      Zfull_inst (p, Zret (imm), strm3)
+                    }
+            else Zfull_inst (p, Zret (0), strm2)
+
+         -- Group 11
+         case Cons ('0xC 011 v', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+              imm, strm4 = immediate (size, strm3);
+              if opcode == '000'
+                 then -- MOV r/mX, immX
+                      Zfull_inst
+                         (p, Zmov (Z_ALWAYS, size, Zrm_i (rm, imm)), strm4)
+              else Zdec_fail ("Unsupported opcode: Group 11")
+            }
+
+         -- Shift Group 2
+         case Cons ('0xD 00 b v', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+              shift = if b == 0`1 then Zrm_i (rm, 1) else Zrm_r (rm, RCX);
+              binop = [[opcode] + 0n8] :: Zbinop_name;
+              if opcode == '110'
+                 then Zdec_fail ("Unsupported opcode: Shift Group 2")
+              else Zfull_inst (p, Zbinop (binop, size, shift), strm3)
+            }
+
+         -- LOOPE rel8
+         -- LOOPNE rel8
+         case Cons ('0xE 000 b', strm2) =>
+            { imm, strm3 = immediate8 (strm2);
+              cond = if b == 0 then Z_NE else Z_E;
+              Zfull_inst (p, Zloop (cond, imm), strm3)
+            }
+
+         -- LOOP rel8
+         case Cons ('0xE2', strm2) =>
+            { imm, strm3 = immediate8 (strm2);
+              Zfull_inst (p, Zloop (Z_ALWAYS, imm), strm3)
+            }
+
+         -- CALL rel32
+         case Cons ('0xE8', strm2) =>
+            { imm, strm3 = immediate32 (strm2);
+              Zfull_inst (p, Zcall (Zimm (imm)), strm3)
+            }
+
+         -- JMP rel8
+         -- JMP rel32
+         case Cons ('0xE 10 b 1', strm2) =>
+            { imm, strm3 =
+                if b == 0 then immediate32 (strm2) else immediate8 (strm2);
+              Zfull_inst (p, Zjcc (Z_ALWAYS, imm), strm3)
+            }
+
+         -- Unary Group 3
+         case Cons ('0xF 011 v', strm2) =>
+            { size = OpSize (have_rex, REX.W, v, op_size_override);
+              opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+              match opcode
+              {  -- TEST r/mX, immX
+                 case '000' =>
+                  { imm, strm4 = immediate (size, strm3);
+                    Zfull_inst (p, Zbinop (Ztest, size, Zrm_i (rm, imm)), strm4)
+                  }
+
+                 -- NOT r/mX
+                 case '010' =>
+                    Zfull_inst (p, Zmonop (Znot, size, rm), strm3)
+
+                 -- NEG r/mX
+                 case '011' =>
+                    Zfull_inst (p, Zmonop (Zneg, size, rm), strm3)
+
+                 -- MUL r/mX
+                 case '100' =>
+                    Zfull_inst (p, Zmul (size, rm), strm3)
+
+                 -- DIV r/mX
+                 case '110' =>
+                    Zfull_inst (p, Zdiv (size, rm), strm3)
+
+                 case _ => Zdec_fail ("Unsupported opcode: Unary Group 3")
+              }
+            }
+
+         -- INC/DEC Group 4
+         case Cons (0xFE, strm2) =>
+            { opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+               if opcode == '000'
+                  then Zfull_inst (p, Zmonop (Zinc, Z8 (have_rex), rm), strm3)
+               else if opcode == '001'
+                  then Zfull_inst (p, Zmonop (Zdec, Z8 (have_rex), rm), strm3)
+               else Zdec_fail ("Unsupported opcode: INC/DEC Group 4")
+            }
+
+         -- INC/DEC Group 5
+         case Cons (0xFF, strm2) =>
+            { size = OpSize (have_rex, REX.W, 1, op_size_override);
+              opcode, rm, strm3 = readOpcodeModRM (REX, strm2);
+              match opcode
+              {  -- INC r/mX
+                 case '000' =>
+                    Zfull_inst (p, Zmonop (Zinc, size, rm), strm3)
+                 -- DEC rm/X
+                 case '001' =>
+                    Zfull_inst (p, Zmonop (Zdec, size, rm), strm3)
+                 -- CALL rm/X
+                 case '010' =>
+                    Zfull_inst (p, Zcall (Zrm (rm)), strm3)
+                 -- JMP rm/X
+                 case '100' =>
+                    Zfull_inst (p, Zjmp (rm), strm3)
+                 -- PUSH rm/X
+                 case '110' =>
+                    Zfull_inst (p, Zpush (Zrm (rm)), strm3)
+                 case _ => Zdec_fail ("Unsupported opcode: INC/DEC Group 5")
+              }
+            }
+
+         -- Three byte opcodes
+         case Cons (0x0F, Cons (0x38, Cons (opc, _))) =>
+            Zdec_fail ("Unsupported opcode: 0F 38 " : [opc])
+         case Cons (0x0F, Cons (0x3A, Cons (opc, _))) =>
+            Zdec_fail ("Unsupported opcode: 0F 3A " : [opc])
+
+         -- Two byte opcodes
+         case Cons (0x0F, Cons (opc, strm2)) =>
+            match opc
+            {  -- CMOVcc rX, r/mX
+               case '0x4 c' =>
+               {  size = OpSize (true, REX.W, 1, op_size_override);
+                  reg, rm, strm3 = readModRM (REX, strm2);
+                  Zfull_inst (p, Zmov ([c], size, Zr_rm (reg, rm)), strm3)
+               }
+
+               -- Jcc rel32
+               case '0x8 c' =>
+               {  imm, strm3 = immediate32 (strm2);
+                  Zfull_inst (p, Zjcc ([c], imm), strm3)
+               }
+
+               -- CPUID
+               case 0xA2 => Zfull_inst (p, Zcpuid, strm2)
+
+               -- CMPXCHG r/mX, rX
+               case '0xB 000 v' =>
+               {  size = OpSize (have_rex, REX.W, v, op_size_override);
+                  reg, rm, strm3 = readModRM (REX, strm2);
+                  Zfull_inst (p, Zcmpxchg (size, rm, reg), strm3)
+               }
+
+               -- XADD r/mX, rX
+               case '0xC 000 v' =>
+               {  size = OpSize (have_rex, REX.W, v, op_size_override);
+                  reg, rm, strm3 = readModRM (REX, strm2);
+                  Zfull_inst (p, Zxadd (size, rm, reg), strm3)
+               }
+
+               -- MOVZX rX, r/m8
+               -- MOVZX rX, r/m16
+               case '0xB 011 v' =>
+               {  size = OpSize (have_rex, REX.W, 1, op_size_override);
+                  size2 = if v == 1 then Z16 else Z8 (have_rex);
+                  reg, rm, strm3 = readModRM (REX, strm2);
+                  Zfull_inst (p, Zmovzx (size, Zr_rm (reg, rm), size2), strm3)
+               }
+              case _ => Zdec_fail ("Unsupported opcode: 0F " : [opc])
+            }
+
+         -- Unsupported
+         case Cons (opc, _) =>
+            Zdec_fail ("Unsupported opcode: " : [opc])
+
+         case Nil => Zdec_fail ("No opcode")
+       }
+  }
+}
+
+---------------------------------------------------------------------------
+
+-- ===================
+-- Next State Function
+-- ===================
+
+stream x64_fetch =
+{
+  var strm = Nil;
+  for i in 19 .. 0 do strm <- Cons (ValOf (MEM (RIP + [i])), strm);
+  return strm
+}
+
+unit checkIcache (n :: nat) =
+   for i in 0 .. n - 1 do
+   {
+      addr = RIP + [i];
+      when MEM (addr) != ICACHE (addr) do #FAIL ("icache miss")
+   }
+
+unit x64_next =
+   match x64_decode (x64_fetch)
+   {
+      case Zfull_inst (_, i, strm1) =>
+        {
+           len = 20 - Length (strm1);
+           checkIcache (len);
+           RIP <- RIP + [len];
+           Run (i)
+        }
+      case Zdec_fail (s) => #FAIL (s)
+   }
+
+---------------------------------------------------------------------------
diff -Nru acl2-6.2/books/translators/l3-to-acl2/examples/x86-64/x64Theory.sig acl2-6.3/books/translators/l3-to-acl2/examples/x86-64/x64Theory.sig
--- acl2-6.2/books/translators/l3-to-acl2/examples/x86-64/x64Theory.sig	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/examples/x86-64/x64Theory.sig	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,6123 @@
+signature x64Theory =
+sig
+  type thm = Thm.thm
+
+  (*  Definitions  *)
+    val AF_def : thm
+    val ByteParity_def : thm
+    val CF_def : thm
+    val EA_def : thm
+    val Eflag_def : thm
+    val FlagUnspecified_def : thm
+    val OF_def : thm
+    val OpSize_def : thm
+    val PF_def : thm
+    val REX_B : thm
+    val REX_B_fupd : thm
+    val REX_R : thm
+    val REX_R_fupd : thm
+    val REX_TY_DEF : thm
+    val REX_W : thm
+    val REX_W_fupd : thm
+    val REX_X : thm
+    val REX_X_fupd : thm
+    val REX_case_def : thm
+    val REX_size_def : thm
+    val ROL_def : thm
+    val ROR_def : thm
+    val RexReg_def : thm
+    val Run_def : thm
+    val SAR_def : thm
+    val SF_def : thm
+    val ZF_def : thm
+    val Zbase_TY_DEF : thm
+    val Zbase_case_def : thm
+    val Zbase_size_def : thm
+    val Zbinop_name2string_def : thm
+    val Zbinop_name_BIJ : thm
+    val Zbinop_name_CASE : thm
+    val Zbinop_name_TY_DEF : thm
+    val Zbinop_name_size_def : thm
+    val Zcond2string_def : thm
+    val Zcond_BIJ : thm
+    val Zcond_CASE : thm
+    val Zcond_TY_DEF : thm
+    val Zcond_size_def : thm
+    val Zdest_src_TY_DEF : thm
+    val Zdest_src_case_def : thm
+    val Zdest_src_size_def : thm
+    val Zea_TY_DEF : thm
+    val Zea_case_def : thm
+    val Zea_size_def : thm
+    val Zeflags2string_def : thm
+    val Zeflags_BIJ : thm
+    val Zeflags_CASE : thm
+    val Zeflags_TY_DEF : thm
+    val Zeflags_size_def : thm
+    val Zimm_rm_TY_DEF : thm
+    val Zimm_rm_case_def : thm
+    val Zimm_rm_size_def : thm
+    val Zinst_TY_DEF : thm
+    val Zinst_case_def : thm
+    val Zinst_size_def : thm
+    val Zmonop_name_BIJ : thm
+    val Zmonop_name_CASE : thm
+    val Zmonop_name_TY_DEF : thm
+    val Zmonop_name_size_def : thm
+    val Zreg_BIJ : thm
+    val Zreg_CASE : thm
+    val Zreg_TY_DEF : thm
+    val Zreg_size_def : thm
+    val Zrm_TY_DEF : thm
+    val Zrm_case_def : thm
+    val Zrm_size_def : thm
+    val Zsize_TY_DEF : thm
+    val Zsize_case_def : thm
+    val Zsize_size_def : thm
+    val Zsize_width_def : thm
+    val add_with_carry_out_def : thm
+    val bitify8_def : thm
+    val boolify8_def : thm
+    val call_dest_from_ea_def : thm
+    val checkIcache_def : thm
+    val dfn'Zbinop_def : thm
+    val dfn'Zcall_def : thm
+    val dfn'Zcmpxchg_def : thm
+    val dfn'Zcpuid_def : thm
+    val dfn'Zdiv_def : thm
+    val dfn'Zjcc_def : thm
+    val dfn'Zjmp_def : thm
+    val dfn'Zlea_def : thm
+    val dfn'Zloop_def : thm
+    val dfn'Zmonop_def : thm
+    val dfn'Zmov_def : thm
+    val dfn'Zmovzx_def : thm
+    val dfn'Zmul_def : thm
+    val dfn'Znop_def : thm
+    val dfn'Zpop_def : thm
+    val dfn'Zpush_def : thm
+    val dfn'Zret_def : thm
+    val dfn'Zxadd_def : thm
+    val dfn'Zxchg_def : thm
+    val ea_Zdest_def : thm
+    val ea_Zimm_rm_def : thm
+    val ea_Zrm_def : thm
+    val ea_Zsrc_def : thm
+    val ea_base_def : thm
+    val ea_index_def : thm
+    val erase_eflags_def : thm
+    val exception_TY_DEF : thm
+    val exception_case_def : thm
+    val exception_size_def : thm
+    val full_immediate_def : thm
+    val get_ea_address_def : thm
+    val immediate16_def : thm
+    val immediate32_def : thm
+    val immediate64_def : thm
+    val immediate8_def : thm
+    val immediate_def : thm
+    val instruction_TY_DEF : thm
+    val instruction_case_def : thm
+    val instruction_size_def : thm
+    val isZm_def : thm
+    val jump_to_ea_def : thm
+    val maskShift_def : thm
+    val mem16_def : thm
+    val mem32_def : thm
+    val mem64_def : thm
+    val mem8_def : thm
+    val prefixGroup_def : thm
+    val raise'exception_def : thm
+    val readDisplacement_def : thm
+    val readModRM_def : thm
+    val readOpcodeModRM_def : thm
+    val readPrefix_primitive_def : thm
+    val readPrefixes_def : thm
+    val readSIB_def : thm
+    val readSibDisplacement_def : thm
+    val read_cond_def : thm
+    val read_dest_src_ea_def : thm
+    val rec'REX_def : thm
+    val reg'REX_def : thm
+    val restrictSize_def : thm
+    val sub_with_borrow_def : thm
+    val value_width_def : thm
+    val word_signed_overflow_add_def : thm
+    val word_signed_overflow_sub_def : thm
+    val word_size_msb_def : thm
+    val write'AF_def : thm
+    val write'CF_def : thm
+    val write'EA_def : thm
+    val write'Eflag_def : thm
+    val write'OF_def : thm
+    val write'PF_def : thm
+    val write'SF_def : thm
+    val write'ZF_def : thm
+    val write'mem16_def : thm
+    val write'mem32_def : thm
+    val write'mem64_def : thm
+    val write'mem8_def : thm
+    val write'rec'REX_def : thm
+    val write'reg'REX_def : thm
+    val write_PF_def : thm
+    val write_SF_def : thm
+    val write_ZF_def : thm
+    val write_arith_eflags_def : thm
+    val write_arith_eflags_except_CF_OF_def : thm
+    val write_arith_result_def : thm
+    val write_arith_result_no_CF_OF_def : thm
+    val write_binop_def : thm
+    val write_logical_eflags_def : thm
+    val write_logical_result_def : thm
+    val write_monop_def : thm
+    val write_result_erase_eflags_def : thm
+    val x64_decode_def : thm
+    val x64_drop_def : thm
+    val x64_fetch_def : thm
+    val x64_next_def : thm
+    val x64_pop_aux_def : thm
+    val x64_pop_def : thm
+    val x64_pop_rip_def : thm
+    val x64_push_aux_def : thm
+    val x64_push_def : thm
+    val x64_push_rip_def : thm
+    val x64_state_EFLAGS : thm
+    val x64_state_EFLAGS_fupd : thm
+    val x64_state_ICACHE : thm
+    val x64_state_ICACHE_fupd : thm
+    val x64_state_MEM : thm
+    val x64_state_MEM_fupd : thm
+    val x64_state_REG : thm
+    val x64_state_REG_fupd : thm
+    val x64_state_RIP : thm
+    val x64_state_RIP_fupd : thm
+    val x64_state_TY_DEF : thm
+    val x64_state_case_def : thm
+    val x64_state_exception : thm
+    val x64_state_exception_fupd : thm
+    val x64_state_size_def : thm
+
+  (*  Theorems  *)
+    val EXISTS_REX : thm
+    val EXISTS_x64_state : thm
+    val FORALL_REX : thm
+    val FORALL_x64_state : thm
+    val REX_11 : thm
+    val REX_Axiom : thm
+    val REX_accessors : thm
+    val REX_accfupds : thm
+    val REX_case_cong : thm
+    val REX_component_equality : thm
+    val REX_fn_updates : thm
+    val REX_fupdcanon : thm
+    val REX_fupdcanon_comp : thm
+    val REX_fupdfupds : thm
+    val REX_fupdfupds_comp : thm
+    val REX_induction : thm
+    val REX_literal_11 : thm
+    val REX_literal_nchotomy : thm
+    val REX_nchotomy : thm
+    val REX_updates_eq_literal : thm
+    val Zbase_11 : thm
+    val Zbase_Axiom : thm
+    val Zbase_case_cong : thm
+    val Zbase_distinct : thm
+    val Zbase_induction : thm
+    val Zbase_nchotomy : thm
+    val Zbinop_name2num_11 : thm
+    val Zbinop_name2num_ONTO : thm
+    val Zbinop_name2num_num2Zbinop_name : thm
+    val Zbinop_name2num_thm : thm
+    val Zbinop_name_Axiom : thm
+    val Zbinop_name_EQ_Zbinop_name : thm
+    val Zbinop_name_case_cong : thm
+    val Zbinop_name_case_def : thm
+    val Zbinop_name_induction : thm
+    val Zbinop_name_nchotomy : thm
+    val Zcond2num_11 : thm
+    val Zcond2num_ONTO : thm
+    val Zcond2num_num2Zcond : thm
+    val Zcond2num_thm : thm
+    val Zcond_Axiom : thm
+    val Zcond_EQ_Zcond : thm
+    val Zcond_case_cong : thm
+    val Zcond_case_def : thm
+    val Zcond_induction : thm
+    val Zcond_nchotomy : thm
+    val Zdest_src_11 : thm
+    val Zdest_src_Axiom : thm
+    val Zdest_src_case_cong : thm
+    val Zdest_src_distinct : thm
+    val Zdest_src_induction : thm
+    val Zdest_src_nchotomy : thm
+    val Zea_11 : thm
+    val Zea_Axiom : thm
+    val Zea_case_cong : thm
+    val Zea_distinct : thm
+    val Zea_induction : thm
+    val Zea_nchotomy : thm
+    val Zeflags2num_11 : thm
+    val Zeflags2num_ONTO : thm
+    val Zeflags2num_num2Zeflags : thm
+    val Zeflags2num_thm : thm
+    val Zeflags_Axiom : thm
+    val Zeflags_EQ_Zeflags : thm
+    val Zeflags_case_cong : thm
+    val Zeflags_case_def : thm
+    val Zeflags_distinct : thm
+    val Zeflags_induction : thm
+    val Zeflags_nchotomy : thm
+    val Zimm_rm_11 : thm
+    val Zimm_rm_Axiom : thm
+    val Zimm_rm_case_cong : thm
+    val Zimm_rm_distinct : thm
+    val Zimm_rm_induction : thm
+    val Zimm_rm_nchotomy : thm
+    val Zinst_11 : thm
+    val Zinst_Axiom : thm
+    val Zinst_case_cong : thm
+    val Zinst_distinct : thm
+    val Zinst_induction : thm
+    val Zinst_nchotomy : thm
+    val Zmonop_name2num_11 : thm
+    val Zmonop_name2num_ONTO : thm
+    val Zmonop_name2num_num2Zmonop_name : thm
+    val Zmonop_name2num_thm : thm
+    val Zmonop_name_Axiom : thm
+    val Zmonop_name_EQ_Zmonop_name : thm
+    val Zmonop_name_case_cong : thm
+    val Zmonop_name_case_def : thm
+    val Zmonop_name_distinct : thm
+    val Zmonop_name_induction : thm
+    val Zmonop_name_nchotomy : thm
+    val Zreg2num_11 : thm
+    val Zreg2num_ONTO : thm
+    val Zreg2num_num2Zreg : thm
+    val Zreg2num_thm : thm
+    val Zreg_Axiom : thm
+    val Zreg_EQ_Zreg : thm
+    val Zreg_case_cong : thm
+    val Zreg_case_def : thm
+    val Zreg_induction : thm
+    val Zreg_nchotomy : thm
+    val Zrm_11 : thm
+    val Zrm_Axiom : thm
+    val Zrm_case_cong : thm
+    val Zrm_distinct : thm
+    val Zrm_induction : thm
+    val Zrm_nchotomy : thm
+    val Zsize_11 : thm
+    val Zsize_Axiom : thm
+    val Zsize_case_cong : thm
+    val Zsize_distinct : thm
+    val Zsize_induction : thm
+    val Zsize_nchotomy : thm
+    val bitify8boolify8 : thm
+    val boolify8_n2w : thm
+    val boolify8_v2w : thm
+    val boolify8bitify8 : thm
+    val datatype_REX : thm
+    val datatype_Zbase : thm
+    val datatype_Zbinop_name : thm
+    val datatype_Zcond : thm
+    val datatype_Zdest_src : thm
+    val datatype_Zea : thm
+    val datatype_Zeflags : thm
+    val datatype_Zimm_rm : thm
+    val datatype_Zinst : thm
+    val datatype_Zmonop_name : thm
+    val datatype_Zreg : thm
+    val datatype_Zrm : thm
+    val datatype_Zsize : thm
+    val datatype_exception : thm
+    val datatype_instruction : thm
+    val datatype_x64_state : thm
+    val exception_11 : thm
+    val exception_Axiom : thm
+    val exception_case_cong : thm
+    val exception_distinct : thm
+    val exception_induction : thm
+    val exception_nchotomy : thm
+    val instruction_11 : thm
+    val instruction_Axiom : thm
+    val instruction_case_cong : thm
+    val instruction_distinct : thm
+    val instruction_induction : thm
+    val instruction_nchotomy : thm
+    val num2Zbinop_name_11 : thm
+    val num2Zbinop_name_ONTO : thm
+    val num2Zbinop_name_Zbinop_name2num : thm
+    val num2Zbinop_name_thm : thm
+    val num2Zcond_11 : thm
+    val num2Zcond_ONTO : thm
+    val num2Zcond_Zcond2num : thm
+    val num2Zcond_thm : thm
+    val num2Zeflags_11 : thm
+    val num2Zeflags_ONTO : thm
+    val num2Zeflags_Zeflags2num : thm
+    val num2Zeflags_thm : thm
+    val num2Zmonop_name_11 : thm
+    val num2Zmonop_name_ONTO : thm
+    val num2Zmonop_name_Zmonop_name2num : thm
+    val num2Zmonop_name_thm : thm
+    val num2Zreg_11 : thm
+    val num2Zreg_ONTO : thm
+    val num2Zreg_Zreg2num : thm
+    val num2Zreg_thm : thm
+    val readPrefix_def : thm
+    val readPrefix_ind : thm
+    val x64_state_11 : thm
+    val x64_state_Axiom : thm
+    val x64_state_accessors : thm
+    val x64_state_accfupds : thm
+    val x64_state_case_cong : thm
+    val x64_state_component_equality : thm
+    val x64_state_fn_updates : thm
+    val x64_state_fupdcanon : thm
+    val x64_state_fupdcanon_comp : thm
+    val x64_state_fupdfupds : thm
+    val x64_state_fupdfupds_comp : thm
+    val x64_state_induction : thm
+    val x64_state_literal_11 : thm
+    val x64_state_literal_nchotomy : thm
+    val x64_state_nchotomy : thm
+    val x64_state_updates_eq_literal : thm
+
+  val x64_grammars : type_grammar.grammar * term_grammar.grammar
+
+  val inventory: {Thy: string, T: string list, C: string list, N: int list}
+(*
+   [bitstring] Parent theory of "x64"
+
+   [integer_word] Parent theory of "x64"
+
+   [machine_ieee] Parent theory of "x64"
+
+   [state_transformer] Parent theory of "x64"
+
+   [AF_def]  Definition
+
+      |- ∀state. AF state = Eflag Z_AF state
+
+   [ByteParity_def]  Definition
+
+      |- ∀b.
+           ByteParity b ⇔
+           (((if word_bit 7 b then 1 else 0) +
+             (if word_bit 6 b then 1 else 0) +
+             (if word_bit 5 b then 1 else 0) +
+             (if word_bit 4 b then 1 else 0) +
+             (if word_bit 3 b then 1 else 0) +
+             (if word_bit 2 b then 1 else 0) +
+             (if word_bit 1 b then 1 else 0) +
+             if word_bit 0 b then 1 else 0) MOD 2 =
+            0)
+
+   [CF_def]  Definition
+
+      |- ∀state. CF state = Eflag Z_CF state
+
+   [EA_def]  Definition
+
+      |- ∀ea.
+           EA ea =
+           (λstate.
+              case ea of
+                Zea_i i => (restrictSize i,state)
+              | Zea_m (Z16,a) => (let (v,s) = mem16 a state in (w2w v,s))
+              | Zea_m (Z32,a) => (let (v,s) = mem32 a state in (w2w v,s))
+              | Zea_m (Z64,a) => mem64 a state
+              | Zea_m (Z8 v5,a) => (let (v,s) = mem8 a state in (w2w v,s))
+              | Zea_r (Z16,r) => (restrictSize (Z16,state.REG r),state)
+              | Zea_r (Z32,r) => (restrictSize (Z32,state.REG r),state)
+              | Zea_r (Z64,r) => (restrictSize (Z64,state.REG r),state)
+              | Zea_r (Z8 have_rex,r) =>
+                  (if have_rex ∨ r ∉ {RSP; RBP; RSI; RDI} then
+                     state.REG r && 255w
+                   else state.REG (num2Zreg (Zreg2num r − 4)) ⋙ 8 && 255w,
+                   state))
+
+   [Eflag_def]  Definition
+
+      |- ∀flag.
+           Eflag flag =
+           (λstate.
+              case state.EFLAGS flag of
+                NONE =>
+                  raise'exception (BadFlagAccess (Zeflags2string flag))
+                    state
+              | SOME b => (b,state))
+
+   [FlagUnspecified_def]  Definition
+
+      |- ∀flag.
+           FlagUnspecified flag =
+           (λstate. ((),state with EFLAGS := (flag =+ NONE) state.EFLAGS))
+
+   [OF_def]  Definition
+
+      |- ∀state. OF state = Eflag Z_OF state
+
+   [OpSize_def]  Definition
+
+      |- ∀have_rex w v override.
+           OpSize (have_rex,w,v,override) =
+           if v = 0w then Z8 have_rex
+           else if w then Z64
+           else if override then Z16
+           else Z32
+
+   [PF_def]  Definition
+
+      |- ∀state. PF state = Eflag Z_PF state
+
+   [REX_B]  Definition
+
+      |- ∀b b0 b1 b2. (REX b b0 b1 b2).B ⇔ b
+
+   [REX_B_fupd]  Definition
+
+      |- ∀f b b0 b1 b2.
+           REX b b0 b1 b2 with B updated_by f = REX (f b) b0 b1 b2
+
+   [REX_R]  Definition
+
+      |- ∀b b0 b1 b2. (REX b b0 b1 b2).R ⇔ b0
+
+   [REX_R_fupd]  Definition
+
+      |- ∀f b b0 b1 b2.
+           REX b b0 b1 b2 with R updated_by f = REX b (f b0) b1 b2
+
+   [REX_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0'.
+                ∀'REX' .
+                  (∀a0'.
+                     (∃a0 a1 a2 a3.
+                        a0' =
+                        (λa0 a1 a2 a3.
+                           ind_type$CONSTR 0 (a0,a1,a2,a3)
+                             (λn. ind_type$BOTTOM)) a0 a1 a2 a3) ⇒
+                     'REX' a0') ⇒
+                  'REX' a0') rep
+
+   [REX_W]  Definition
+
+      |- ∀b b0 b1 b2. (REX b b0 b1 b2).W ⇔ b1
+
+   [REX_W_fupd]  Definition
+
+      |- ∀f b b0 b1 b2.
+           REX b b0 b1 b2 with W updated_by f = REX b b0 (f b1) b2
+
+   [REX_X]  Definition
+
+      |- ∀b b0 b1 b2. (REX b b0 b1 b2).X ⇔ b2
+
+   [REX_X_fupd]  Definition
+
+      |- ∀f b b0 b1 b2.
+           REX b b0 b1 b2 with X updated_by f = REX b b0 b1 (f b2)
+
+   [REX_case_def]  Definition
+
+      |- ∀a0 a1 a2 a3 f. REX_CASE (REX a0 a1 a2 a3) f = f a0 a1 a2 a3
+
+   [REX_size_def]  Definition
+
+      |- ∀a0 a1 a2 a3.
+           REX_size (REX a0 a1 a2 a3) =
+           1 +
+           (bool_size a0 + (bool_size a1 + (bool_size a2 + bool_size a3)))
+
+   [ROL_def]  Definition
+
+      |- ∀size x y.
+           ROL (size,x,y) =
+           case size of
+             Z16 => w2w ((15 >< 0) x ⇆ w2n ((4 >< 0) y))
+           | Z32 => w2w ((31 >< 0) x ⇆ w2n ((4 >< 0) y))
+           | Z64 => x ⇆ w2n ((5 >< 0) y)
+           | Z8 v => w2w ((7 >< 0) x ⇆ w2n ((4 >< 0) y))
+
+   [ROR_def]  Definition
+
+      |- ∀size x y.
+           ROR (size,x,y) =
+           case size of
+             Z16 => w2w ((15 >< 0) x ⇄ w2n ((4 >< 0) y))
+           | Z32 => w2w ((31 >< 0) x ⇄ w2n ((4 >< 0) y))
+           | Z64 => x ⇄ w2n ((5 >< 0) y)
+           | Z8 v => w2w ((7 >< 0) x ⇄ w2n ((4 >< 0) y))
+
+   [RexReg_def]  Definition
+
+      |- ∀b r. RexReg (b,r) = num2Zreg (w2n ((if b then 1w else 0w) @@ r))
+
+   [Run_def]  Definition
+
+      |- ∀v0.
+           Run v0 =
+           (λstate.
+              case v0 of
+                Zbinop v1 => dfn'Zbinop v1 state
+              | Zcall v2 => dfn'Zcall v2 state
+              | Zcmpxchg v3 => dfn'Zcmpxchg v3 state
+              | Zcpuid => dfn'Zcpuid state
+              | Zdiv v4 => dfn'Zdiv v4 state
+              | Zjcc v5 => dfn'Zjcc v5 state
+              | Zjmp v6 => dfn'Zjmp v6 state
+              | Zlea v7 => dfn'Zlea v7 state
+              | Zloop v8 => dfn'Zloop v8 state
+              | Zmonop v9 => dfn'Zmonop v9 state
+              | Zmov v10 => dfn'Zmov v10 state
+              | Zmovzx v11 => dfn'Zmovzx v11 state
+              | Zmul v12 => dfn'Zmul v12 state
+              | Znop => (dfn'Znop,state)
+              | Zpop v13 => dfn'Zpop v13 state
+              | Zpush v14 => dfn'Zpush v14 state
+              | Zret v15 => dfn'Zret v15 state
+              | Zxadd v16 => dfn'Zxadd v16 state
+              | Zxchg v17 => dfn'Zxchg v17 state)
+
+   [SAR_def]  Definition
+
+      |- ∀size x y.
+           SAR (size,x,y) =
+           case size of
+             Z16 => w2w ((15 >< 0) x ≫ w2n ((4 >< 0) y))
+           | Z32 => w2w ((31 >< 0) x ≫ w2n ((4 >< 0) y))
+           | Z64 => x ≫ w2n ((5 >< 0) y)
+           | Z8 v => w2w ((7 >< 0) x ≫ w2n ((4 >< 0) y))
+
+   [SF_def]  Definition
+
+      |- ∀state. SF state = Eflag Z_SF state
+
+   [ZF_def]  Definition
+
+      |- ∀state. ZF state = Eflag Z_ZF state
+
+   [Zbase_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'Zbase' .
+                  (∀a0.
+                     (a0 = ind_type$CONSTR 0 ARB (λn. ind_type$BOTTOM)) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0) a (λn. ind_type$BOTTOM))
+                          a) ∨
+                     (a0 =
+                      ind_type$CONSTR (SUC (SUC 0)) ARB
+                        (λn. ind_type$BOTTOM)) ⇒
+                     'Zbase' a0) ⇒
+                  'Zbase' a0) rep
+
+   [Zbase_case_def]  Definition
+
+      |- (∀v f v1. Zbase_CASE ZnoBase v f v1 = v) ∧
+         (∀a v f v1. Zbase_CASE (ZregBase a) v f v1 = f a) ∧
+         ∀v f v1. Zbase_CASE ZripBase v f v1 = v1
+
+   [Zbase_size_def]  Definition
+
+      |- (Zbase_size ZnoBase = 0) ∧
+         (∀a. Zbase_size (ZregBase a) = 1 + Zreg_size a) ∧
+         (Zbase_size ZripBase = 0)
+
+   [Zbinop_name2string_def]  Definition
+
+      |- (Zbinop_name2string Zadd = "Zadd") ∧
+         (Zbinop_name2string Zor = "Zor") ∧
+         (Zbinop_name2string Zadc = "Zadc") ∧
+         (Zbinop_name2string Zsbb = "Zsbb") ∧
+         (Zbinop_name2string Zand = "Zand") ∧
+         (Zbinop_name2string Zsub = "Zsub") ∧
+         (Zbinop_name2string Zxor = "Zxor") ∧
+         (Zbinop_name2string Zcmp = "Zcmp") ∧
+         (Zbinop_name2string Zrol = "Zrol") ∧
+         (Zbinop_name2string Zror = "Zror") ∧
+         (Zbinop_name2string Zrcl = "Zrcl") ∧
+         (Zbinop_name2string Zrcr = "Zrcr") ∧
+         (Zbinop_name2string Zshl = "Zshl") ∧
+         (Zbinop_name2string Zshr = "Zshr") ∧
+         (Zbinop_name2string Ztest = "Ztest") ∧
+         (Zbinop_name2string Zsar = "Zsar")
+
+   [Zbinop_name_BIJ]  Definition
+
+      |- (∀a. num2Zbinop_name (Zbinop_name2num a) = a) ∧
+         ∀r. (λn. n < 16) r ⇔ (Zbinop_name2num (num2Zbinop_name r) = r)
+
+   [Zbinop_name_CASE]  Definition
+
+      |- ∀x v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+           (case x of
+              Zadd => v0
+            | Zor => v1
+            | Zadc => v2
+            | Zsbb => v3
+            | Zand => v4
+            | Zsub => v5
+            | Zxor => v6
+            | Zcmp => v7
+            | Zrol => v8
+            | Zror => v9
+            | Zrcl => v10
+            | Zrcr => v11
+            | Zshl => v12
+            | Zshr => v13
+            | Ztest => v14
+            | Zsar => v15) =
+           (λm.
+              if m < 7 then
+                if m < 3 then
+                  if m < 1 then v0 else if m = 1 then v1 else v2
+                else if m < 4 then v3
+                else if m < 5 then v4
+                else if m = 5 then v5
+                else v6
+              else if m < 11 then
+                if m < 8 then v7
+                else if m < 9 then v8
+                else if m = 9 then v9
+                else v10
+              else if m < 13 then if m = 11 then v11 else v12
+              else if m < 14 then v13
+              else if m = 14 then v14
+              else v15) (Zbinop_name2num x)
+
+   [Zbinop_name_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 16) rep
+
+   [Zbinop_name_size_def]  Definition
+
+      |- ∀x. Zbinop_name_size x = 0
+
+   [Zcond2string_def]  Definition
+
+      |- (Zcond2string Z_O = "Z_O") ∧ (Zcond2string Z_NO = "Z_NO") ∧
+         (Zcond2string Z_B = "Z_B") ∧ (Zcond2string Z_NB = "Z_NB") ∧
+         (Zcond2string Z_E = "Z_E") ∧ (Zcond2string Z_NE = "Z_NE") ∧
+         (Zcond2string Z_NA = "Z_NA") ∧ (Zcond2string Z_A = "Z_A") ∧
+         (Zcond2string Z_S = "Z_S") ∧ (Zcond2string Z_NS = "Z_NS") ∧
+         (Zcond2string Z_P = "Z_P") ∧ (Zcond2string Z_NP = "Z_NP") ∧
+         (Zcond2string Z_L = "Z_L") ∧ (Zcond2string Z_NL = "Z_NL") ∧
+         (Zcond2string Z_NG = "Z_NG") ∧ (Zcond2string Z_G = "Z_G") ∧
+         (Zcond2string Z_ALWAYS = "Z_ALWAYS")
+
+   [Zcond_BIJ]  Definition
+
+      |- (∀a. num2Zcond (Zcond2num a) = a) ∧
+         ∀r. (λn. n < 17) r ⇔ (Zcond2num (num2Zcond r) = r)
+
+   [Zcond_CASE]  Definition
+
+      |- ∀x v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+           (case x of
+              Z_O => v0
+            | Z_NO => v1
+            | Z_B => v2
+            | Z_NB => v3
+            | Z_E => v4
+            | Z_NE => v5
+            | Z_NA => v6
+            | Z_A => v7
+            | Z_S => v8
+            | Z_NS => v9
+            | Z_P => v10
+            | Z_NP => v11
+            | Z_L => v12
+            | Z_NL => v13
+            | Z_NG => v14
+            | Z_G => v15
+            | Z_ALWAYS => v16) =
+           (λm.
+              if m < 8 then
+                if m < 3 then
+                  if m < 1 then v0 else if m = 1 then v1 else v2
+                else if m < 5 then if m = 3 then v3 else v4
+                else if m < 6 then v5
+                else if m = 6 then v6
+                else v7
+              else if m < 12 then
+                if m < 9 then v8
+                else if m < 10 then v9
+                else if m = 10 then v10
+                else v11
+              else if m < 14 then if m = 12 then v12 else v13
+              else if m < 15 then v14
+              else if m = 15 then v15
+              else v16) (Zcond2num x)
+
+   [Zcond_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 17) rep
+
+   [Zcond_size_def]  Definition
+
+      |- ∀x. Zcond_size x = 0
+
+   [Zdest_src_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'Zdest_src' .
+                  (∀a0.
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR 0 (a,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0) (ARB,a,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC 0)) (ARB,ARB,a)
+                             (λn. ind_type$BOTTOM)) a) ⇒
+                     'Zdest_src' a0) ⇒
+                  'Zdest_src' a0) rep
+
+   [Zdest_src_case_def]  Definition
+
+      |- (∀a f f1 f2. Zdest_src_CASE (Zr_rm a) f f1 f2 = f a) ∧
+         (∀a f f1 f2. Zdest_src_CASE (Zrm_i a) f f1 f2 = f1 a) ∧
+         ∀a f f1 f2. Zdest_src_CASE (Zrm_r a) f f1 f2 = f2 a
+
+   [Zdest_src_size_def]  Definition
+
+      |- (∀a.
+            Zdest_src_size (Zr_rm a) =
+            1 + pair_size Zreg_size Zrm_size a) ∧
+         (∀a.
+            Zdest_src_size (Zrm_i a) = 1 + pair_size Zrm_size (λv. 0) a) ∧
+         ∀a. Zdest_src_size (Zrm_r a) = 1 + pair_size Zrm_size Zreg_size a
+
+   [Zea_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'Zea' .
+                  (∀a0.
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR 0 (a,ARB) (λn. ind_type$BOTTOM))
+                          a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0) (a,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC 0)) (ARB,a)
+                             (λn. ind_type$BOTTOM)) a) ⇒
+                     'Zea' a0) ⇒
+                  'Zea' a0) rep
+
+   [Zea_case_def]  Definition
+
+      |- (∀a f f1 f2. Zea_CASE (Zea_i a) f f1 f2 = f a) ∧
+         (∀a f f1 f2. Zea_CASE (Zea_m a) f f1 f2 = f1 a) ∧
+         ∀a f f1 f2. Zea_CASE (Zea_r a) f f1 f2 = f2 a
+
+   [Zea_size_def]  Definition
+
+      |- (∀a. Zea_size (Zea_i a) = 1 + pair_size Zsize_size (λv. 0) a) ∧
+         (∀a. Zea_size (Zea_m a) = 1 + pair_size Zsize_size (λv. 0) a) ∧
+         ∀a. Zea_size (Zea_r a) = 1 + pair_size Zsize_size Zreg_size a
+
+   [Zeflags2string_def]  Definition
+
+      |- (Zeflags2string Z_CF = "Z_CF") ∧ (Zeflags2string Z_PF = "Z_PF") ∧
+         (Zeflags2string Z_AF = "Z_AF") ∧ (Zeflags2string Z_ZF = "Z_ZF") ∧
+         (Zeflags2string Z_SF = "Z_SF") ∧ (Zeflags2string Z_OF = "Z_OF")
+
+   [Zeflags_BIJ]  Definition
+
+      |- (∀a. num2Zeflags (Zeflags2num a) = a) ∧
+         ∀r. (λn. n < 6) r ⇔ (Zeflags2num (num2Zeflags r) = r)
+
+   [Zeflags_CASE]  Definition
+
+      |- ∀x v0 v1 v2 v3 v4 v5.
+           (case x of
+              Z_CF => v0
+            | Z_PF => v1
+            | Z_AF => v2
+            | Z_ZF => v3
+            | Z_SF => v4
+            | Z_OF => v5) =
+           (λm.
+              if m < 2 then if m = 0 then v0 else v1
+              else if m < 3 then v2
+              else if m < 4 then v3
+              else if m = 4 then v4
+              else v5) (Zeflags2num x)
+
+   [Zeflags_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 6) rep
+
+   [Zeflags_size_def]  Definition
+
+      |- ∀x. Zeflags_size x = 0
+
+   [Zimm_rm_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'Zimm_rm' .
+                  (∀a0.
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR 0 (a,ARB) (λn. ind_type$BOTTOM))
+                          a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0) (ARB,a)
+                             (λn. ind_type$BOTTOM)) a) ⇒
+                     'Zimm_rm' a0) ⇒
+                  'Zimm_rm' a0) rep
+
+   [Zimm_rm_case_def]  Definition
+
+      |- (∀a f f1. Zimm_rm_CASE (Zimm a) f f1 = f a) ∧
+         ∀a f f1. Zimm_rm_CASE (Zrm a) f f1 = f1 a
+
+   [Zimm_rm_size_def]  Definition
+
+      |- (∀a. Zimm_rm_size (Zimm a) = 1) ∧
+         ∀a. Zimm_rm_size (Zrm a) = 1 + Zrm_size a
+
+   [Zinst_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'Zinst' .
+                  (∀a0.
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR 0 (a,ARB) (λn. ind_type$BOTTOM))
+                          a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0) (ARB,a)
+                             (λn. ind_type$BOTTOM)) a) ⇒
+                     'Zinst' a0) ⇒
+                  'Zinst' a0) rep
+
+   [Zinst_case_def]  Definition
+
+      |- (∀a f f1. Zinst_CASE (Zdec_fail a) f f1 = f a) ∧
+         ∀a f f1. Zinst_CASE (Zfull_inst a) f f1 = f1 a
+
+   [Zinst_size_def]  Definition
+
+      |- (∀a. Zinst_size (Zdec_fail a) = 1 + list_size char_size a) ∧
+         ∀a.
+           Zinst_size (Zfull_inst a) =
+           1 +
+           pair_size (list_size (λv. 0))
+             (pair_size instruction_size (list_size (λv. 0))) a
+
+   [Zmonop_name_BIJ]  Definition
+
+      |- (∀a. num2Zmonop_name (Zmonop_name2num a) = a) ∧
+         ∀r. (λn. n < 4) r ⇔ (Zmonop_name2num (num2Zmonop_name r) = r)
+
+   [Zmonop_name_CASE]  Definition
+
+      |- ∀x v0 v1 v2 v3.
+           (case x of Zdec => v0 | Zinc => v1 | Znot => v2 | Zneg => v3) =
+           (λm.
+              if m < 1 then v0
+              else if m < 2 then v1
+              else if m = 2 then v2
+              else v3) (Zmonop_name2num x)
+
+   [Zmonop_name_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 4) rep
+
+   [Zmonop_name_size_def]  Definition
+
+      |- ∀x. Zmonop_name_size x = 0
+
+   [Zreg_BIJ]  Definition
+
+      |- (∀a. num2Zreg (Zreg2num a) = a) ∧
+         ∀r. (λn. n < 16) r ⇔ (Zreg2num (num2Zreg r) = r)
+
+   [Zreg_CASE]  Definition
+
+      |- ∀x v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+           (case x of
+              RAX => v0
+            | RCX => v1
+            | RDX => v2
+            | RBX => v3
+            | RSP => v4
+            | RBP => v5
+            | RSI => v6
+            | RDI => v7
+            | zR8 => v8
+            | zR9 => v9
+            | zR10 => v10
+            | zR11 => v11
+            | zR12 => v12
+            | zR13 => v13
+            | zR14 => v14
+            | zR15 => v15) =
+           (λm.
+              if m < 7 then
+                if m < 3 then
+                  if m < 1 then v0 else if m = 1 then v1 else v2
+                else if m < 4 then v3
+                else if m < 5 then v4
+                else if m = 5 then v5
+                else v6
+              else if m < 11 then
+                if m < 8 then v7
+                else if m < 9 then v8
+                else if m = 9 then v9
+                else v10
+              else if m < 13 then if m = 11 then v11 else v12
+              else if m < 14 then v13
+              else if m = 14 then v14
+              else v15) (Zreg2num x)
+
+   [Zreg_TY_DEF]  Definition
+
+      |- ∃rep. TYPE_DEFINITION (λn. n < 16) rep
+
+   [Zreg_size_def]  Definition
+
+      |- ∀x. Zreg_size x = 0
+
+   [Zrm_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'Zrm' .
+                  (∀a0.
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR 0 (a,ARB) (λn. ind_type$BOTTOM))
+                          a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0) (ARB,a)
+                             (λn. ind_type$BOTTOM)) a) ⇒
+                     'Zrm' a0) ⇒
+                  'Zrm' a0) rep
+
+   [Zrm_case_def]  Definition
+
+      |- (∀a f f1. Zrm_CASE (Zm a) f f1 = f a) ∧
+         ∀a f f1. Zrm_CASE (Zr a) f f1 = f1 a
+
+   [Zrm_size_def]  Definition
+
+      |- (∀a.
+            Zrm_size (Zm a) =
+            1 +
+            pair_size (option_size (pair_size (λv. 0) Zreg_size))
+              (pair_size Zbase_size (λv. 0)) a) ∧
+         ∀a. Zrm_size (Zr a) = 1 + Zreg_size a
+
+   [Zsize_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'Zsize' .
+                  (∀a0.
+                     (a0 = ind_type$CONSTR 0 ARB (λn. ind_type$BOTTOM)) ∨
+                     (a0 =
+                      ind_type$CONSTR (SUC 0) ARB (λn. ind_type$BOTTOM)) ∨
+                     (a0 =
+                      ind_type$CONSTR (SUC (SUC 0)) ARB
+                        (λn. ind_type$BOTTOM)) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC (SUC 0))) a
+                             (λn. ind_type$BOTTOM)) a) ⇒
+                     'Zsize' a0) ⇒
+                  'Zsize' a0) rep
+
+   [Zsize_case_def]  Definition
+
+      |- (∀v v1 v2 f. Zsize_CASE Z16 v v1 v2 f = v) ∧
+         (∀v v1 v2 f. Zsize_CASE Z32 v v1 v2 f = v1) ∧
+         (∀v v1 v2 f. Zsize_CASE Z64 v v1 v2 f = v2) ∧
+         ∀a v v1 v2 f. Zsize_CASE (Z8 a) v v1 v2 f = f a
+
+   [Zsize_size_def]  Definition
+
+      |- (Zsize_size Z16 = 0) ∧ (Zsize_size Z32 = 0) ∧
+         (Zsize_size Z64 = 0) ∧ ∀a. Zsize_size (Z8 a) = 1 + bool_size a
+
+   [Zsize_width_def]  Definition
+
+      |- ∀size.
+           Zsize_width size =
+           case size of Z16 => 16 | Z32 => 32 | Z64 => 64 | Z8 v => 8
+
+   [add_with_carry_out_def]  Definition
+
+      |- ∀size x y.
+           add_with_carry_out (size,x,y) =
+           (x + y,value_width size ≤ w2n x + w2n y,
+            word_signed_overflow_add (size,x,y))
+
+   [bitify8_def]  Definition
+
+      |- ∀b7 b6 b5 b4 b3 b2 b1 b0.
+           bitify8 (b7,b6,b5,b4,b3,b2,b1,b0) =
+           v2w [b7; b6; b5; b4; b3; b2; b1; b0]
+
+   [boolify8_def]  Definition
+
+      |- ∀w.
+           boolify8 w =
+           (word_bit 7 w,word_bit 6 w,word_bit 5 w,word_bit 4 w,
+            word_bit 3 w,word_bit 2 w,word_bit 1 w,word_bit 0 w)
+
+   [call_dest_from_ea_def]  Definition
+
+      |- ∀ea.
+           call_dest_from_ea ea =
+           (λstate.
+              case ea of
+                Zea_i (v3,i) => (state.RIP + i,state)
+              | Zea_m (v5,a) => mem64 a state
+              | Zea_r (v7,r) => (state.REG r,state))
+
+   [checkIcache_def]  Definition
+
+      |- ∀n.
+           checkIcache n =
+           (λstate.
+              FOR
+                (0,n − 1,
+                 (λi state.
+                    (let v = state.RIP + n2w i
+                     in
+                       if state.MEM v ≠ state.ICACHE v then
+                         raise'exception (FAIL "icache miss") state
+                       else ((),state)))) state)
+
+   [dfn'Zbinop_def]  Definition
+
+      |- ∀bop size dst_src.
+           dfn'Zbinop (bop,size,dst_src) =
+           (λstate.
+              (let (v,s) = read_dest_src_ea (size,dst_src) state in
+               let (ea,val_dst,val_src) = v
+               in
+                 write_binop (size,bop,val_dst,val_src,ea) s))
+
+   [dfn'Zcall_def]  Definition
+
+      |- ∀imm_rm.
+           dfn'Zcall imm_rm =
+           (λstate.
+              (let s = SND (x64_push_rip state)
+               in
+                 jump_to_ea (FST (ea_Zimm_rm (Z64,imm_rm) s)) s))
+
+   [dfn'Zcmpxchg_def]  Definition
+
+      |- ∀size rm r.
+           dfn'Zcmpxchg (size,rm,r) =
+           (λstate.
+              (let ea_src = Zea_r (size,r) in
+               let v = FST (ea_Zrm (size,rm) state) in
+               let (v0,s) = EA v state in
+               let (v1,s) = EA ea_src s in
+               let s = SND (write_binop (size,Zcmp,v1,v0,ea_src) s)
+               in
+                 if v1 = v0 then
+                   (let (v0,s) = EA ea_src s in write'EA (v0,v) s)
+                 else write'EA (v0,Zea_r (size,RAX)) s))
+
+   [dfn'Zcpuid_def]  Definition
+
+      |- ∀state.
+           dfn'Zcpuid state =
+           (let s = state with ICACHE := state.MEM in
+            let s = s with REG := (RAX =+ ARB) s.REG in
+            let s = s with REG := (RBX =+ ARB) s.REG in
+            let s = s with REG := (RCX =+ ARB) s.REG
+            in
+              ((),s with REG := (RDX =+ ARB) s.REG))
+
+   [dfn'Zdiv_def]  Definition
+
+      |- ∀size rm.
+           dfn'Zdiv (size,rm) =
+           (λstate.
+              (let w = value_width size in
+               let ea_eax = Zea_r (size,RAX) in
+               let ea_edx = Zea_r (size,RAX) in
+               let (v,s) = EA ea_eax state in
+               let (v,s) =
+                     (let (v0,s) = EA ea_edx s in (w2n v * w + w2n v0,s))
+               in
+               let (v0,s) =
+                     (let (v,s) = EA (FST (ea_Zrm (size,rm) s)) s
+                      in
+                        (w2n v,s))
+               in
+               let q = v DIV v0
+               in
+                 erase_eflags
+                   (SND
+                      (write'EA (n2w (v MOD v0),ea_edx)
+                         (SND
+                            (write'EA (n2w q,ea_eax)
+                               (if (v0 = 0) ∨ w ≤ q then
+                                  SND (raise'exception (FAIL "division") s)
+                                else s)))))))
+
+   [dfn'Zjcc_def]  Definition
+
+      |- ∀cond imm.
+           dfn'Zjcc (cond,imm) =
+           (λstate.
+              (let (v,s) = read_cond cond state
+               in
+                 ((),if v then s with RIP := s.RIP + imm else s)))
+
+   [dfn'Zjmp_def]  Definition
+
+      |- ∀rm.
+           dfn'Zjmp rm =
+           (λstate.
+              (let (v,s) = EA (FST (ea_Zrm (Z64,rm) state)) state
+               in
+                 ((),s with RIP := v)))
+
+   [dfn'Zlea_def]  Definition
+
+      |- ∀size dst_src.
+           dfn'Zlea (size,dst_src) =
+           (λstate.
+              write'EA
+                (get_ea_address (FST (ea_Zsrc (size,dst_src) state)),
+                 FST (ea_Zdest (size,dst_src) state)) state)
+
+   [dfn'Zloop_def]  Definition
+
+      |- ∀cond imm.
+           dfn'Zloop (cond,imm) =
+           (λstate.
+              (let v = state.REG RCX − 1w in
+               let (v0,s) =
+                     read_cond cond
+                       (state with REG := (RCX =+ v) state.REG)
+               in
+                 ((),
+                  if v ≠ 0w ∧ v0 then s with RIP := s.RIP + imm else s)))
+
+   [dfn'Zmonop_def]  Definition
+
+      |- ∀mop size rm.
+           dfn'Zmonop (mop,size,rm) =
+           (λstate.
+              (let v = FST (ea_Zrm (size,rm) state) in
+               let (v0,s) = EA v state
+               in
+                 write_monop (size,mop,v0,v) s))
+
+   [dfn'Zmov_def]  Definition
+
+      |- ∀cond size dst_src.
+           dfn'Zmov (cond,size,dst_src) =
+           (λstate.
+              (let (v,s) = read_cond cond state
+               in
+                 if v then
+                   (let (v0,s0) = EA (FST (ea_Zsrc (size,dst_src) s)) s
+                    in
+                      write'EA (v0,FST (ea_Zdest (size,dst_src) s)) s0)
+                 else ((),s)))
+
+   [dfn'Zmovzx_def]  Definition
+
+      |- ∀size1 dst_src size2.
+           dfn'Zmovzx (size1,dst_src,size2) =
+           (λstate.
+              (let (v,s) =
+                     (let (v0,s) =
+                            EA (FST (ea_Zsrc (size1,dst_src) state)) state
+                      in
+                        ((v0,FST (ea_Zdest (size2,dst_src) state)),s))
+               in
+                 write'EA v s))
+
+   [dfn'Zmul_def]  Definition
+
+      |- ∀size rm.
+           dfn'Zmul (size,rm) =
+           (λstate.
+              (let ea_eax = Zea_r (size,RAX) in
+               let (v,s) = EA ea_eax state in
+               let (v0,s) = EA (FST (ea_Zrm (size,rm) s)) s
+               in
+                 erase_eflags
+                   (case size of
+                      Z16 =>
+                        SND
+                          (write'EA
+                             (n2w (w2n v * w2n v0 DIV value_width size),
+                              Zea_r (size,RDX))
+                             (SND (write'EA (v * v0,ea_eax) s)))
+                    | Z32 =>
+                        SND
+                          (write'EA
+                             (n2w (w2n v * w2n v0 DIV value_width size),
+                              Zea_r (size,RDX))
+                             (SND (write'EA (v * v0,ea_eax) s)))
+                    | Z64 =>
+                        SND
+                          (write'EA
+                             (n2w (w2n v * w2n v0 DIV value_width size),
+                              Zea_r (size,RDX))
+                             (SND (write'EA (v * v0,ea_eax) s)))
+                    | Z8 v2 => SND (write'EA (v * v0,Zea_r (Z16,RAX)) s))))
+
+   [dfn'Znop_def]  Definition
+
+      |- dfn'Znop = ()
+
+   [dfn'Zpop_def]  Definition
+
+      |- ∀rm. dfn'Zpop rm = (λstate. x64_pop rm state)
+
+   [dfn'Zpush_def]  Definition
+
+      |- ∀imm_rm. dfn'Zpush imm_rm = (λstate. x64_push imm_rm state)
+
+   [dfn'Zret_def]  Definition
+
+      |- ∀imm.
+           dfn'Zret imm = (λstate. x64_drop imm (SND (x64_pop_rip state)))
+
+   [dfn'Zxadd_def]  Definition
+
+      |- ∀size rm r.
+           dfn'Zxadd (size,rm,r) =
+           (λstate.
+              (let ea_src = Zea_r (size,r) in
+               let v = FST (ea_Zrm (size,rm) state) in
+               let (v0,s) = EA ea_src state in
+               let (v1,s) = EA v s
+               in
+                 write_binop (size,Zadd,v0,v1,v)
+                   (SND (write'EA (v1,ea_src) s))))
+
+   [dfn'Zxchg_def]  Definition
+
+      |- ∀size rm r.
+           dfn'Zxchg (size,rm,r) =
+           (λstate.
+              (let ea_src = Zea_r (size,r) in
+               let v = FST (ea_Zrm (size,rm) state) in
+               let (v0,s) = EA ea_src state in
+               let (v1,s) = EA v s
+               in
+                 write'EA (v0,v) (SND (write'EA (v1,ea_src) s))))
+
+   [ea_Zdest_def]  Definition
+
+      |- ∀size ds.
+           ea_Zdest (size,ds) =
+           (λstate.
+              case ds of
+                Zr_rm (r,v4) => (Zea_r (size,r),state)
+              | Zrm_i (rm,v6) => (FST (ea_Zrm (size,rm) state),state)
+              | Zrm_r (rm_1,v8) => (FST (ea_Zrm (size,rm_1) state),state))
+
+   [ea_Zimm_rm_def]  Definition
+
+      |- ∀size imm_rm.
+           ea_Zimm_rm (size,imm_rm) =
+           (λstate.
+              case imm_rm of
+                Zimm imm => (Zea_i (size,imm),state)
+              | Zrm rm => (FST (ea_Zrm (size,rm) state),state))
+
+   [ea_Zrm_def]  Definition
+
+      |- ∀size rm.
+           ea_Zrm (size,rm) =
+           (λstate.
+              case rm of
+                Zm (index,base,displacement) =>
+                  (Zea_m
+                     (size,
+                      FST (ea_index index state) +
+                      FST (ea_base base state) + displacement),state)
+              | Zr r => (Zea_r (size,r),state))
+
+   [ea_Zsrc_def]  Definition
+
+      |- ∀size ds.
+           ea_Zsrc (size,ds) =
+           (λstate.
+              case ds of
+                Zr_rm (v3,rm) => (FST (ea_Zrm (size,rm) state),state)
+              | Zrm_i (v5,i) => (Zea_i (size,i),state)
+              | Zrm_r (v7,r) => (Zea_r (size,r),state))
+
+   [ea_base_def]  Definition
+
+      |- ∀base.
+           ea_base base =
+           (λstate.
+              case base of
+                ZnoBase => (0w,state)
+              | ZregBase b => (state.REG b,state)
+              | ZripBase => (state.RIP,state))
+
+   [ea_index_def]  Definition
+
+      |- ∀index.
+           ea_index index =
+           (λstate.
+              case index of
+                NONE => (0w,state)
+              | SOME (scale,idx) => (1w ≪ w2n scale * state.REG idx,state))
+
+   [erase_eflags_def]  Definition
+
+      |- ∀state. erase_eflags state = ((),state with EFLAGS := K NONE)
+
+   [exception_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'exception' .
+                  (∀a0.
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR 0 (a,ARB) (λn. ind_type$BOTTOM))
+                          a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0) (ARB,a)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC 0)) (a,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (a0 =
+                      ind_type$CONSTR (SUC (SUC (SUC 0))) (ARB,ARB)
+                        (λn. ind_type$BOTTOM)) ⇒
+                     'exception' a0) ⇒
+                  'exception' a0) rep
+
+   [exception_case_def]  Definition
+
+      |- (∀a f f1 f2 v. exception_CASE (BadFlagAccess a) f f1 f2 v = f a) ∧
+         (∀a f f1 f2 v. exception_CASE (BadMemAccess a) f f1 f2 v = f1 a) ∧
+         (∀a f f1 f2 v. exception_CASE (FAIL a) f f1 f2 v = f2 a) ∧
+         ∀f f1 f2 v. exception_CASE NoException f f1 f2 v = v
+
+   [exception_size_def]  Definition
+
+      |- (∀a.
+            exception_size (BadFlagAccess a) = 1 + list_size char_size a) ∧
+         (∀a. exception_size (BadMemAccess a) = 1) ∧
+         (∀a. exception_size (FAIL a) = 1 + list_size char_size a) ∧
+         (exception_size NoException = 0)
+
+   [full_immediate_def]  Definition
+
+      |- ∀size strm.
+           full_immediate (size,strm) =
+           if size = Z64 then immediate64 strm else immediate (size,strm)
+
+   [get_ea_address_def]  Definition
+
+      |- ∀ea.
+           get_ea_address ea =
+           case ea of Zea_i v => 0w | Zea_m (v5,a) => a | Zea_r v2 => 0w
+
+   [immediate16_def]  Definition
+
+      |- ∀strm.
+           immediate16 strm =
+           case strm of
+             [] => ARB
+           | [b1] => ARB
+           | b1::b2::t => (sw2sw (b2 @@ b1),t)
+
+   [immediate32_def]  Definition
+
+      |- ∀strm.
+           immediate32 strm =
+           case strm of
+             [] => ARB
+           | [b1] => ARB
+           | [b1; b2] => ARB
+           | [b1; b2; b3] => ARB
+           | b1::b2::b3::b4::t => (sw2sw (b4 @@ b3 @@ b2 @@ b1),t)
+
+   [immediate64_def]  Definition
+
+      |- ∀strm.
+           immediate64 strm =
+           case strm of
+             [] => ARB
+           | [b1] => ARB
+           | [b1; b2] => ARB
+           | [b1; b2; b3] => ARB
+           | [b1; b2; b3; b4] => ARB
+           | [b1; b2; b3; b4; b5] => ARB
+           | [b1; b2; b3; b4; b5; b6] => ARB
+           | [b1; b2; b3; b4; b5; b6; b7] => ARB
+           | b1::b2::b3::b4::b5::b6::b7::b8::t =>
+               (b8 @@ b7 @@ b6 @@ b5 @@ b4 @@ b3 @@ b2 @@ b1,t)
+
+   [immediate8_def]  Definition
+
+      |- ∀strm.
+           immediate8 strm = case strm of [] => ARB | b::t => (sw2sw b,t)
+
+   [immediate_def]  Definition
+
+      |- ∀size strm.
+           immediate (size,strm) =
+           case size of
+             Z16 => immediate16 strm
+           | Z32 => immediate32 strm
+           | Z64 => immediate32 strm
+           | Z8 v1 => immediate8 strm
+
+   [instruction_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0.
+                ∀'instruction' .
+                  (∀a0.
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR 0
+                             (a,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC 0)
+                             (ARB,a,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC 0))
+                             (ARB,ARB,a,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (a0 =
+                      ind_type$CONSTR (SUC (SUC (SUC 0)))
+                        (ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                        (λn. ind_type$BOTTOM)) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC (SUC (SUC 0))))
+                             (ARB,ARB,ARB,a,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR (SUC (SUC (SUC (SUC (SUC 0)))))
+                             (ARB,ARB,ARB,ARB,a,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC (SUC (SUC (SUC (SUC (SUC 0))))))
+                             (ARB,ARB,ARB,ARB,ARB,a,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC (SUC (SUC (SUC (SUC (SUC (SUC 0)))))))
+                             (ARB,ARB,ARB,ARB,ARB,ARB,a,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC (SUC (SUC (SUC (SUC (SUC 0))))))))
+                             (ARB,ARB,ARB,ARB,a,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC (SUC (SUC (SUC 0)))))))))
+                             (ARB,ARB,ARB,ARB,ARB,ARB,ARB,a,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC
+                                               (SUC
+                                                  (SUC
+                                                     (SUC (SUC 0))))))))))
+                             (ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,a,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC
+                                               (SUC
+                                                  (SUC
+                                                     (SUC
+                                                        (SUC
+                                                           (SUC
+                                                              0)))))))))))
+                             (ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,a,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC
+                                               (SUC
+                                                  (SUC
+                                                     (SUC
+                                                        (SUC
+                                                           (SUC
+                                                              (SUC
+                                                                 0))))))))))))
+                             (ARB,ARB,ARB,a,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (a0 =
+                      ind_type$CONSTR
+                        (SUC
+                           (SUC
+                              (SUC
+                                 (SUC
+                                    (SUC
+                                       (SUC
+                                          (SUC
+                                             (SUC
+                                                (SUC
+                                                   (SUC
+                                                      (SUC
+                                                         (SUC
+                                                            (SUC
+                                                               0)))))))))))))
+                        (ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                        (λn. ind_type$BOTTOM)) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC
+                                               (SUC
+                                                  (SUC
+                                                     (SUC
+                                                        (SUC
+                                                           (SUC
+                                                              (SUC
+                                                                 (SUC
+                                                                    (SUC
+                                                                       0))))))))))))))
+                             (ARB,ARB,ARB,ARB,ARB,a,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC
+                                               (SUC
+                                                  (SUC
+                                                     (SUC
+                                                        (SUC
+                                                           (SUC
+                                                              (SUC
+                                                                 (SUC
+                                                                    (SUC
+                                                                       (SUC
+                                                                          0)))))))))))))))
+                             (ARB,a,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC
+                                               (SUC
+                                                  (SUC
+                                                     (SUC
+                                                        (SUC
+                                                           (SUC
+                                                              (SUC
+                                                                 (SUC
+                                                                    (SUC
+                                                                       (SUC
+                                                                          (SUC
+                                                                             0))))))))))))))))
+                             (ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB,a)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC
+                                               (SUC
+                                                  (SUC
+                                                     (SUC
+                                                        (SUC
+                                                           (SUC
+                                                              (SUC
+                                                                 (SUC
+                                                                    (SUC
+                                                                       (SUC
+                                                                          (SUC
+                                                                             (SUC
+                                                                                0)))))))))))))))))
+                             (ARB,ARB,a,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ∨
+                     (∃a.
+                        a0 =
+                        (λa.
+                           ind_type$CONSTR
+                             (SUC
+                                (SUC
+                                   (SUC
+                                      (SUC
+                                         (SUC
+                                            (SUC
+                                               (SUC
+                                                  (SUC
+                                                     (SUC
+                                                        (SUC
+                                                           (SUC
+                                                              (SUC
+                                                                 (SUC
+                                                                    (SUC
+                                                                       (SUC
+                                                                          (SUC
+                                                                             (SUC
+                                                                                (SUC
+                                                                                   0))))))))))))))))))
+                             (ARB,ARB,a,ARB,ARB,ARB,ARB,ARB,ARB,ARB,ARB)
+                             (λn. ind_type$BOTTOM)) a) ⇒
+                     'instruction' a0) ⇒
+                  'instruction' a0) rep
+
+   [instruction_case_def]  Definition
+
+      |- (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zbinop a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zcall a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f1 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zcmpxchg a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9
+              f10 f11 v1 f12 f13 f14 f15 f16 =
+            f2 a) ∧
+         (∀f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE Zcpuid f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11
+              v1 f12 f13 f14 f15 f16 =
+            v) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zdiv a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f3 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zjcc a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f4 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zjmp a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f5 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zlea a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f6 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zloop a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f7 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zmonop a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f8 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zmov a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f9 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zmovzx a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f10 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zmul a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f11 a) ∧
+         (∀f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE Znop f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1
+              f12 f13 f14 f15 f16 =
+            v1) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zpop a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f12 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zpush a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f13 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zret a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f14 a) ∧
+         (∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+            instruction_CASE (Zxadd a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+              f11 v1 f12 f13 f14 f15 f16 =
+            f15 a) ∧
+         ∀a f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15 f16.
+           instruction_CASE (Zxchg a) f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10
+             f11 v1 f12 f13 f14 f15 f16 =
+           f16 a
+
+   [instruction_size_def]  Definition
+
+      |- (∀a.
+            instruction_size (Zbinop a) =
+            1 +
+            pair_size Zbinop_name_size
+              (pair_size Zsize_size Zdest_src_size) a) ∧
+         (∀a. instruction_size (Zcall a) = 1 + Zimm_rm_size a) ∧
+         (∀a.
+            instruction_size (Zcmpxchg a) =
+            1 + pair_size Zsize_size (pair_size Zrm_size Zreg_size) a) ∧
+         (instruction_size Zcpuid = 0) ∧
+         (∀a.
+            instruction_size (Zdiv a) =
+            1 + pair_size Zsize_size Zrm_size a) ∧
+         (∀a.
+            instruction_size (Zjcc a) =
+            1 + pair_size Zcond_size (λv. 0) a) ∧
+         (∀a. instruction_size (Zjmp a) = 1 + Zrm_size a) ∧
+         (∀a.
+            instruction_size (Zlea a) =
+            1 + pair_size Zsize_size Zdest_src_size a) ∧
+         (∀a.
+            instruction_size (Zloop a) =
+            1 + pair_size Zcond_size (λv. 0) a) ∧
+         (∀a.
+            instruction_size (Zmonop a) =
+            1 +
+            pair_size Zmonop_name_size (pair_size Zsize_size Zrm_size) a) ∧
+         (∀a.
+            instruction_size (Zmov a) =
+            1 +
+            pair_size Zcond_size (pair_size Zsize_size Zdest_src_size) a) ∧
+         (∀a.
+            instruction_size (Zmovzx a) =
+            1 +
+            pair_size Zsize_size (pair_size Zdest_src_size Zsize_size) a) ∧
+         (∀a.
+            instruction_size (Zmul a) =
+            1 + pair_size Zsize_size Zrm_size a) ∧
+         (instruction_size Znop = 0) ∧
+         (∀a. instruction_size (Zpop a) = 1 + Zrm_size a) ∧
+         (∀a. instruction_size (Zpush a) = 1 + Zimm_rm_size a) ∧
+         (∀a. instruction_size (Zret a) = 1) ∧
+         (∀a.
+            instruction_size (Zxadd a) =
+            1 + pair_size Zsize_size (pair_size Zrm_size Zreg_size) a) ∧
+         ∀a.
+           instruction_size (Zxchg a) =
+           1 + pair_size Zsize_size (pair_size Zrm_size Zreg_size) a
+
+   [isZm_def]  Definition
+
+      |- ∀rm. isZm rm ⇔ case rm of Zm v2 => T | Zr v3 => F
+
+   [jump_to_ea_def]  Definition
+
+      |- ∀ea.
+           jump_to_ea ea =
+           (λstate.
+              (let (v,s) = call_dest_from_ea ea state
+               in
+                 ((),s with RIP := v)))
+
+   [maskShift_def]  Definition
+
+      |- ∀size w.
+           maskShift (size,w) =
+           if size = Z64 then w2n ((5 >< 0) w) else w2n ((4 >< 0) w)
+
+   [mem16_def]  Definition
+
+      |- ∀addr.
+           mem16 addr =
+           (λstate.
+              (let (v,s) = mem8 (addr + 1w) state in
+               let (v0,s) = mem8 addr s
+               in
+                 (v @@ v0,s)))
+
+   [mem32_def]  Definition
+
+      |- ∀addr.
+           mem32 addr =
+           (λstate.
+              (let (v,s) = mem16 (addr + 2w) state in
+               let (v0,s) = mem16 addr s
+               in
+                 (v @@ v0,s)))
+
+   [mem64_def]  Definition
+
+      |- ∀addr.
+           mem64 addr =
+           (λstate.
+              (let (v,s) = mem32 (addr + 4w) state in
+               let (v0,s) = mem32 addr s
+               in
+                 (v @@ v0,s)))
+
+   [mem8_def]  Definition
+
+      |- ∀addr.
+           mem8 addr =
+           (λstate.
+              case state.MEM addr of
+                NONE => raise'exception (BadMemAccess addr) state
+              | SOME b => (b,state))
+
+   [prefixGroup_def]  Definition
+
+      |- ∀b.
+           prefixGroup b =
+           case b of
+             240w => 1
+           | 242w => 1
+           | 243w => 1
+           | 38w => 2
+           | 46w => 2
+           | 54w => 2
+           | 62w => 2
+           | 100w => 2
+           | 101w => 2
+           | 102w => 3
+           | 103w => 4
+           | v => if (7 >< 4) b = 4w then 5 else 0
+
+   [raise'exception_def]  Definition
+
+      |- ∀e.
+           raise'exception e =
+           (λstate.
+              (ARB,
+               if state.exception = NoException then
+                 state with exception := e
+               else state))
+
+   [readDisplacement_def]  Definition
+
+      |- ∀Mod strm.
+           readDisplacement (Mod,strm) =
+           if Mod = 1w then immediate8 strm
+           else if Mod = 2w then immediate32 strm
+           else (0w,strm)
+
+   [readModRM_def]  Definition
+
+      |- ∀REX strm.
+           readModRM (REX,strm) =
+           case strm of
+             [] => (ARB,ARB,strm)
+           | v#0 ::v#1 =>
+               case (boolify8 v#0 ,v#1 ) of
+                 ((T,T,v6,v8,v10,v12,v14,v15),strm1) =>
+                   (RexReg (REX.R,(5 >< 3) v#0 ),
+                    Zr (RexReg (REX.B,(2 >< 0) v#0 )),strm1)
+               | ((F,T,v6,v8,v10,v12,T,v15),strm1) =>
+                   (let (displacement,strm2) =
+                          readDisplacement ((7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),
+                       Zm
+                         (NONE,ZregBase (RexReg (REX.B,(2 >< 0) v#0 )),
+                          displacement),strm2))
+               | ((F,T,v6,v8,v10,v12,F,T),strm1) =>
+                   (let (displacement,strm2) =
+                          readDisplacement ((7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),
+                       Zm
+                         (NONE,ZregBase (RexReg (REX.B,(2 >< 0) v#0 )),
+                          displacement),strm2))
+               | ((F,T,v6,v8,v10,T,F,F),strm1) =>
+                   (let (sib,strm2) = readSIB (REX,(7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),sib,strm2))
+               | ((F,T,v6,v8,v10,F,F,F),strm1) =>
+                   (let (displacement,strm2) =
+                          readDisplacement ((7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),
+                       Zm
+                         (NONE,ZregBase (RexReg (REX.B,(2 >< 0) v#0 )),
+                          displacement),strm2))
+               | ((v2_1,F,v6,v8,v10,v12,T,v15),strm1) =>
+                   (let (displacement,strm2) =
+                          readDisplacement ((7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),
+                       Zm
+                         (NONE,ZregBase (RexReg (REX.B,(2 >< 0) v#0 )),
+                          displacement),strm2))
+               | ((T,F,v6,v8,v10,T,F,T),strm1) =>
+                   (let (displacement,strm2) =
+                          readDisplacement ((7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),
+                       Zm
+                         (NONE,ZregBase (RexReg (REX.B,(2 >< 0) v#0 )),
+                          displacement),strm2))
+               | ((F,F,v6,v8,v10,T,F,T),strm1) =>
+                   (let (displacement,strm2) = immediate32 strm1
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),
+                       Zm (NONE,ZripBase,displacement),strm2))
+               | ((v2_1,F,v6,v8,v10,F,F,T),strm1) =>
+                   (let (displacement,strm2) =
+                          readDisplacement ((7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),
+                       Zm
+                         (NONE,ZregBase (RexReg (REX.B,(2 >< 0) v#0 )),
+                          displacement),strm2))
+               | ((v2_1,F,v6,v8,v10,T,F,F),strm1) =>
+                   (let (sib,strm2) = readSIB (REX,(7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),sib,strm2))
+               | ((v2_1,F,v6,v8,v10,F,F,F),strm1) =>
+                   (let (displacement,strm2) =
+                          readDisplacement ((7 >< 6) v#0 ,strm1)
+                    in
+                      (RexReg (REX.R,(5 >< 3) v#0 ),
+                       Zm
+                         (NONE,ZregBase (RexReg (REX.B,(2 >< 0) v#0 )),
+                          displacement),strm2))
+
+   [readOpcodeModRM_def]  Definition
+
+      |- ∀REX strm.
+           readOpcodeModRM (REX,strm) =
+           (let (opcode,rm,strm1) = readModRM (REX,strm)
+            in
+              (n2w (Zreg2num opcode MOD 8),rm,strm1))
+
+   [readPrefix_primitive_def]  Definition
+
+      |- readPrefix =
+         WFREC
+           (@R.
+              WF R ∧
+              ∀p s strm h strm1 group.
+                (strm = h::strm1) ∧ (group = prefixGroup h) ∧ group ≠ 0 ∧
+                group ≠ 5 ∧ group ∉ s ⇒
+                R (group INSERT s,h::p,strm1) (s,p,strm))
+           (λreadPrefix a.
+              case a of
+                (s,p,strm) =>
+                  I
+                    (case strm of
+                       [] => SOME (p,F,ARB,strm)
+                     | h::strm1 =>
+                         (let group = prefixGroup h
+                          in
+                            if group = 0 then SOME (p,F,rec'REX 0w,strm)
+                            else if group = 5 then
+                              SOME (p,T,rec'REX ((3 >< 0) h),strm1)
+                            else if group ∈ s then NONE
+                            else readPrefix (group INSERT s,h::p,strm1))))
+
+   [readPrefixes_def]  Definition
+
+      |- ∀strm. readPrefixes strm = readPrefix (∅,[],strm)
+
+   [readSIB_def]  Definition
+
+      |- ∀REX Mod strm.
+           readSIB (REX,Mod,strm) =
+           case strm of
+             [] => (ARB,strm)
+           | v#0 ::v#1 =>
+               (let base = RexReg (REX.B,(2 >< 0) v#0 ) in
+                let index = RexReg (REX.X,(5 >< 3) v#0 ) in
+                let scaled_index =
+                      if index = RSP then NONE
+                      else SOME ((7 >< 6) v#0 ,index)
+                in
+                  if base = RBP then
+                    (let (displacement,strm2) =
+                           readSibDisplacement (Mod,v#1 )
+                     in
+                       (Zm
+                          (scaled_index,
+                           if Mod = 0w then ZnoBase else ZregBase base,
+                           displacement),strm2))
+                  else
+                    (let (displacement,strm2) = readDisplacement (Mod,v#1 )
+                     in
+                       (Zm (scaled_index,ZregBase base,displacement),
+                        strm2)))
+
+   [readSibDisplacement_def]  Definition
+
+      |- ∀Mod strm.
+           readSibDisplacement (Mod,strm) =
+           if Mod = 0w then (0w,strm)
+           else if Mod = 1w then immediate8 strm
+           else immediate32 strm
+
+   [read_cond_def]  Definition
+
+      |- ∀c.
+           read_cond c =
+           (λstate.
+              case c of
+                Z_O => OF state
+              | Z_NO => (let (v,s) = OF state in (¬v,s))
+              | Z_B => CF state
+              | Z_NB => (let (v,s) = CF state in (¬v,s))
+              | Z_E => ZF state
+              | Z_NE => (let (v,s) = ZF state in (¬v,s))
+              | Z_NA =>
+                  (case (state.EFLAGS Z_CF,state.EFLAGS Z_ZF) of
+                     (NONE,NONE) =>
+                       raise'exception
+                         (BadFlagAccess
+                            (STRCAT "read_cond: " (Zcond2string c))) state
+                   | (NONE,SOME T) => (T,state)
+                   | (NONE,SOME F) =>
+                       raise'exception
+                         (BadFlagAccess
+                            (STRCAT "read_cond: " (Zcond2string c))) state
+                   | (SOME T,v3) => (T,state)
+                   | (SOME F,NONE) =>
+                       raise'exception
+                         (BadFlagAccess
+                            (STRCAT "read_cond: " (Zcond2string c))) state
+                   | (SOME F,SOME T) => (T,state)
+                   | (SOME F,SOME F) => (F,state))
+              | Z_A =>
+                  (case (state.EFLAGS Z_CF,state.EFLAGS Z_ZF) of
+                     (NONE,NONE) =>
+                       raise'exception
+                         (BadFlagAccess
+                            (STRCAT "read_cond: " (Zcond2string c))) state
+                   | (NONE,SOME T) => (F,state)
+                   | (NONE,SOME F) =>
+                       raise'exception
+                         (BadFlagAccess
+                            (STRCAT "read_cond: " (Zcond2string c))) state
+                   | (SOME T,v3) => (F,state)
+                   | (SOME F,NONE) =>
+                       raise'exception
+                         (BadFlagAccess
+                            (STRCAT "read_cond: " (Zcond2string c))) state
+                   | (SOME F,SOME T) => (F,state)
+                   | (SOME F,SOME F) => (T,state))
+              | Z_S => SF state
+              | Z_NS => (let (v,s) = SF state in (¬v,s))
+              | Z_P => PF state
+              | Z_NP => (let (v,s) = PF state in (¬v,s))
+              | Z_L =>
+                  (let (v,s) = SF state in
+                   let (v,s) = (let (v0,s) = OF s in (v ⇔ v0,s))
+                   in
+                     (¬v,s))
+              | Z_NL =>
+                  (let (v,s) = SF state in let (v0,s) = OF s in (v ⇔ v0,s))
+              | Z_NG =>
+                  (case (state.EFLAGS Z_SF,state.EFLAGS Z_OF) of
+                     (NONE,v3) =>
+                       (case state.EFLAGS Z_ZF of
+                          NONE =>
+                            raise'exception
+                              (BadFlagAccess
+                                 (STRCAT "read_cond: " (Zcond2string c)))
+                              state
+                        | SOME T => (T,state)
+                        | SOME F =>
+                            raise'exception
+                              (BadFlagAccess
+                                 (STRCAT "read_cond: " (Zcond2string c)))
+                              state)
+                   | (SOME a,NONE) =>
+                       (case state.EFLAGS Z_ZF of
+                          NONE =>
+                            raise'exception
+                              (BadFlagAccess
+                                 (STRCAT "read_cond: " (Zcond2string c)))
+                              state
+                        | SOME T => (T,state)
+                        | SOME F =>
+                            raise'exception
+                              (BadFlagAccess
+                                 (STRCAT "read_cond: " (Zcond2string c)))
+                              state)
+                   | (SOME a,SOME b) =>
+                       (let (v,s) = ZF state in ((a ⇎ b) ∨ v,s)))
+              | Z_G =>
+                  (case (state.EFLAGS Z_SF,state.EFLAGS Z_OF) of
+                     (NONE,v3) =>
+                       (case state.EFLAGS Z_ZF of
+                          NONE =>
+                            raise'exception
+                              (BadFlagAccess
+                                 (STRCAT "read_cond: " (Zcond2string c)))
+                              state
+                        | SOME T => (F,state)
+                        | SOME F =>
+                            raise'exception
+                              (BadFlagAccess
+                                 (STRCAT "read_cond: " (Zcond2string c)))
+                              state)
+                   | (SOME a,NONE) =>
+                       (case state.EFLAGS Z_ZF of
+                          NONE =>
+                            raise'exception
+                              (BadFlagAccess
+                                 (STRCAT "read_cond: " (Zcond2string c)))
+                              state
+                        | SOME T => (F,state)
+                        | SOME F =>
+                            raise'exception
+                              (BadFlagAccess
+                                 (STRCAT "read_cond: " (Zcond2string c)))
+                              state)
+                   | (SOME a,SOME b) =>
+                       (let (v,s) = ZF state in ((a ⇔ b) ∧ ¬v,s)))
+              | Z_ALWAYS => (T,state))
+
+   [read_dest_src_ea_def]  Definition
+
+      |- ∀sd.
+           read_dest_src_ea sd =
+           (λstate.
+              (let v = FST (ea_Zdest sd state) in
+               let (v0,s) = EA v state in
+               let (v0,s) =
+                     (let (v1,s) = EA (FST (ea_Zsrc sd s)) s
+                      in
+                        ((v0,v1),s))
+               in
+                 ((v,v0),s)))
+
+   [rec'REX_def]  Definition
+
+      |- ∀x.
+           rec'REX x =
+           REX (word_bit 0 x) (word_bit 2 x) (word_bit 3 x) (word_bit 1 x)
+
+   [reg'REX_def]  Definition
+
+      |- ∀x.
+           reg'REX x =
+           case x of
+             REX B_1 R W_1 X =>
+               word_modify
+                 (CURRY
+                    (λ(i,_).
+                       if i = 3 then W_1
+                       else if i = 2 then R
+                       else if i = 1 then X
+                       else B_1)) 0w
+
+   [restrictSize_def]  Definition
+
+      |- ∀size imm.
+           restrictSize (size,imm) =
+           case size of
+             Z16 => imm && 65535w
+           | Z32 => imm && 0xFFFFFFFFw
+           | Z64 => imm
+           | Z8 v => imm && 255w
+
+   [sub_with_borrow_def]  Definition
+
+      |- ∀size x y.
+           sub_with_borrow (size,x,y) =
+           (x − y,x <₊ y,word_signed_overflow_sub (size,x,y))
+
+   [value_width_def]  Definition
+
+      |- ∀s. value_width s = 2 ** Zsize_width s
+
+   [word_signed_overflow_add_def]  Definition
+
+      |- ∀size a b.
+           word_signed_overflow_add (size,a,b) ⇔
+           (word_size_msb (size,a) ⇔ word_size_msb (size,b)) ∧
+           (word_size_msb (size,a + b) ⇎ word_size_msb (size,a))
+
+   [word_signed_overflow_sub_def]  Definition
+
+      |- ∀size a b.
+           word_signed_overflow_sub (size,a,b) ⇔
+           (word_size_msb (size,a) ⇎ word_size_msb (size,b)) ∧
+           (word_size_msb (size,a − b) ⇎ word_size_msb (size,a))
+
+   [word_size_msb_def]  Definition
+
+      |- ∀size w.
+           word_size_msb (size,w) ⇔ word_bit (Zsize_width size − 1) w
+
+   [write'AF_def]  Definition
+
+      |- ∀b. write'AF b = (λstate. write'Eflag (b,Z_AF) state)
+
+   [write'CF_def]  Definition
+
+      |- ∀b. write'CF b = (λstate. write'Eflag (b,Z_CF) state)
+
+   [write'EA_def]  Definition
+
+      |- ∀w ea.
+           write'EA (w,ea) =
+           (λstate.
+              case ea of
+                Zea_i i => raise'exception (FAIL "write to constant") state
+              | Zea_m (Z16,a) => write'mem16 ((15 >< 0) w,a) state
+              | Zea_m (Z32,a) => write'mem32 ((31 >< 0) w,a) state
+              | Zea_m (Z64,a) => write'mem64 (w,a) state
+              | Zea_m (Z8 v5,a) => write'mem8 ((7 >< 0) w,a) state
+              | Zea_r (Z16,r) =>
+                  (let v = state.REG
+                   in
+                     ((),
+                      state with
+                      REG :=
+                        (r =+ bit_field_insert 15 0 ((15 >< 0) w) (v r))
+                          v))
+              | Zea_r (Z32,r) =>
+                  ((),state with REG := (r =+ w2w ((31 >< 0) w)) state.REG)
+              | Zea_r (Z64,r) => ((),state with REG := (r =+ w) state.REG)
+              | Zea_r (Z8 have_rex,r) =>
+                  if have_rex ∨ r ∉ {RSP; RBP; RSI; RDI} then
+                    (let v = state.REG
+                     in
+                       ((),
+                        state with
+                        REG :=
+                          (r =+ bit_field_insert 7 0 ((7 >< 0) w) (v r))
+                            v))
+                  else
+                    (let v = state.REG in
+                     let x = num2Zreg (Zreg2num r − 4)
+                     in
+                       ((),
+                        state with
+                        REG :=
+                          (x =+ bit_field_insert 15 8 ((7 >< 0) w) (v x))
+                            v)))
+
+   [write'Eflag_def]  Definition
+
+      |- ∀b flag.
+           write'Eflag (b,flag) =
+           (λstate.
+              ((),state with EFLAGS := (flag =+ SOME b) state.EFLAGS))
+
+   [write'OF_def]  Definition
+
+      |- ∀b. write'OF b = (λstate. write'Eflag (b,Z_OF) state)
+
+   [write'PF_def]  Definition
+
+      |- ∀b. write'PF b = (λstate. write'Eflag (b,Z_PF) state)
+
+   [write'SF_def]  Definition
+
+      |- ∀b. write'SF b = (λstate. write'Eflag (b,Z_SF) state)
+
+   [write'ZF_def]  Definition
+
+      |- ∀b. write'ZF b = (λstate. write'Eflag (b,Z_ZF) state)
+
+   [write'mem16_def]  Definition
+
+      |- ∀w addr.
+           write'mem16 (w,addr) =
+           (λstate.
+              write'mem8 ((15 >< 8) w,addr + 1w)
+                (SND (write'mem8 ((7 >< 0) w,addr) state)))
+
+   [write'mem32_def]  Definition
+
+      |- ∀w addr.
+           write'mem32 (w,addr) =
+           (λstate.
+              write'mem16 ((31 >< 16) w,addr + 2w)
+                (SND (write'mem16 ((15 >< 0) w,addr) state)))
+
+   [write'mem64_def]  Definition
+
+      |- ∀w addr.
+           write'mem64 (w,addr) =
+           (λstate.
+              write'mem32 ((63 >< 32) w,addr + 4w)
+                (SND (write'mem32 ((31 >< 0) w,addr) state)))
+
+   [write'mem8_def]  Definition
+
+      |- ∀b addr.
+           write'mem8 (b,addr) =
+           (λstate.
+              if IS_SOME (state.MEM addr) then
+                ((),state with MEM := (addr =+ SOME b) state.MEM)
+              else raise'exception (BadMemAccess addr) state)
+
+   [write'rec'REX_def]  Definition
+
+      |- ∀_ x. write'rec'REX (_,x) = reg'REX x
+
+   [write'reg'REX_def]  Definition
+
+      |- ∀_ x. write'reg'REX (_,x) = rec'REX x
+
+   [write_PF_def]  Definition
+
+      |- ∀w.
+           write_PF w = (λstate. write'PF (ByteParity ((7 >< 0) w)) state)
+
+   [write_SF_def]  Definition
+
+      |- ∀s_w. write_SF s_w = (λstate. write'SF (word_size_msb s_w) state)
+
+   [write_ZF_def]  Definition
+
+      |- ∀size w.
+           write_ZF (size,w) =
+           (λstate.
+              write'ZF
+                (case size of
+                   Z16 => w2w w = 0w
+                 | Z32 => w2w w = 0w
+                 | Z64 => w = 0w
+                 | Z8 v => w2w w = 0w) state)
+
+   [write_arith_eflags_def]  Definition
+
+      |- ∀size r.
+           write_arith_eflags (size,r) =
+           (λstate.
+              (let (w,c,x) = r
+               in
+                 write_arith_eflags_except_CF_OF (size,w)
+                   (SND (write'OF x (SND (write'CF c state))))))
+
+   [write_arith_eflags_except_CF_OF_def]  Definition
+
+      |- ∀size w.
+           write_arith_eflags_except_CF_OF (size,w) =
+           (λstate.
+              FlagUnspecified Z_AF
+                (SND
+                   (write_ZF (size,w)
+                      (SND (write_SF (size,w) (SND (write_PF w state)))))))
+
+   [write_arith_result_def]  Definition
+
+      |- ∀size r ea.
+           write_arith_result (size,r,ea) =
+           (λstate.
+              write'EA (FST r,ea)
+                (SND (write_arith_eflags (size,r) state)))
+
+   [write_arith_result_no_CF_OF_def]  Definition
+
+      |- ∀size w ea.
+           write_arith_result_no_CF_OF (size,w,ea) =
+           (λstate.
+              write'EA (w,ea)
+                (SND (write_arith_eflags_except_CF_OF (size,w) state)))
+
+   [write_binop_def]  Definition
+
+      |- ∀s bop x y ea.
+           write_binop (s,bop,x,y,ea) =
+           (λstate.
+              case bop of
+                Zadd =>
+                  write_arith_result (s,add_with_carry_out (s,x,y),ea)
+                    state
+              | Zor => write_logical_result (s,x ‖ y,ea) state
+              | Zadc =>
+                  (let (v,s0) = CF state
+                   in
+                     write_arith_result_no_CF_OF
+                       (s,x + y + if v then 1w else 0w,ea)
+                       (SND
+                          (FlagUnspecified Z_OF
+                             (SND
+                                (write'CF
+                                   (value_width s ≤
+                                    w2n x + w2n y + if v then 1 else 0)
+                                   s0)))))
+              | Zsbb =>
+                  (let (v,s0) = CF state
+                   in
+                     write_arith_result_no_CF_OF
+                       (s,x − (y + if v then 1w else 0w),ea)
+                       (SND
+                          (FlagUnspecified Z_OF
+                             (SND
+                                (write'CF
+                                   (w2n x < w2n y + if v then 1 else 0)
+                                   s0)))))
+              | Zand => write_logical_result (s,x && y,ea) state
+              | Zsub =>
+                  write_arith_result (s,sub_with_borrow (s,x,y),ea) state
+              | Zxor => write_logical_result (s,x ⊕ y,ea) state
+              | Zcmp =>
+                  write_arith_eflags (s,sub_with_borrow (s,x,y)) state
+              | Zrol => write_result_erase_eflags (ROL (s,x,y),ea) state
+              | Zror => write_result_erase_eflags (ROR (s,x,y),ea) state
+              | Zrcl =>
+                  raise'exception
+                    (FAIL
+                       (STRCAT "Binary op not implemented: "
+                          (Zbinop_name2string bop))) state
+              | Zrcr =>
+                  raise'exception
+                    (FAIL
+                       (STRCAT "Binary op not implemented: "
+                          (Zbinop_name2string bop))) state
+              | Zshl =>
+                  write_result_erase_eflags (x ≪ maskShift (s,y),ea) state
+              | Zshr =>
+                  write_result_erase_eflags (x ⋙ maskShift (s,y),ea) state
+              | Ztest => write_logical_eflags (s,x && y) state
+              | Zsar => write_result_erase_eflags (SAR (s,x,y),ea) state)
+
+   [write_logical_eflags_def]  Definition
+
+      |- ∀size w.
+           write_logical_eflags (size,w) =
+           (λstate.
+              FlagUnspecified Z_AF
+                (SND
+                   (write_ZF (size,w)
+                      (SND
+                         (write_SF (size,w)
+                            (SND
+                               (write_PF w
+                                  (SND
+                                     (write'OF F
+                                        (SND (write'CF F state)))))))))))
+
+   [write_logical_result_def]  Definition
+
+      |- ∀size w ea.
+           write_logical_result (size,w,ea) =
+           (λstate.
+              write'EA (w,ea) (SND (write_logical_eflags (size,w) state)))
+
+   [write_monop_def]  Definition
+
+      |- ∀s mop x ea.
+           write_monop (s,mop,x,ea) =
+           (λstate.
+              case mop of
+                Zdec => write_arith_result_no_CF_OF (s,x − 1w,ea) state
+              | Zinc => write_arith_result_no_CF_OF (s,x + 1w,ea) state
+              | Znot => write'EA (¬x,ea) state
+              | Zneg =>
+                  FlagUnspecified Z_CF
+                    (SND (write_arith_result_no_CF_OF (s,-x,ea) state)))
+
+   [write_result_erase_eflags_def]  Definition
+
+      |- ∀w ea.
+           write_result_erase_eflags (w,ea) =
+           (λstate. write'EA (w,ea) (SND (erase_eflags state)))
+
+   [x64_decode_def]  Definition
+
+      |- ∀strm.
+           x64_decode strm =
+           case readPrefixes strm of
+             NONE => Zdec_fail "Bad prefix"
+           | SOME (p,have_rex,REX_1,strm1) =>
+               (let op_size_override = MEM 102w p
+                in
+                  if REX_1.W ∧ op_size_override then
+                    Zdec_fail "REX.W together with override prefix"
+                  else
+                    case strm1 of
+                      [] => Zdec_fail "No opcode"
+                    | v#0 ::v#1 =>
+                        case (boolify8 v#0 ,v#1 ) of
+                          ((T,T,T,T,T,T,T,T),strm2) =>
+                            (let size =
+                                   OpSize
+                                     (have_rex,REX_1.W,1w,op_size_override)
+                             in
+                             let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                               case opcode of
+                                 0w =>
+                                   Zfull_inst
+                                     (p,Zmonop (Zinc,size,rm),strm3)
+                               | 1w =>
+                                   Zfull_inst
+                                     (p,Zmonop (Zdec,size,rm),strm3)
+                               | 2w => Zfull_inst (p,Zcall (Zrm rm),strm3)
+                               | 4w => Zfull_inst (p,Zjmp rm,strm3)
+                               | 6w => Zfull_inst (p,Zpush (Zrm rm),strm3)
+                               | v =>
+                                   Zdec_fail
+                                     "Unsupported opcode: INC/DEC Group 5")
+                        | ((T,T,T,T,T,T,T,F),strm2) =>
+                            (let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                               if opcode = 0w then
+                                 Zfull_inst
+                                   (p,Zmonop (Zinc,Z8 have_rex,rm),strm3)
+                               else if opcode = 1w then
+                                 Zfull_inst
+                                   (p,Zmonop (Zdec,Z8 have_rex,rm),strm3)
+                               else
+                                 Zdec_fail
+                                   "Unsupported opcode: INC/DEC Group 4")
+                        | ((T,T,T,T,T,T,F,v29),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,T,T,T,F,v25),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,T,T,F,T,T,v37),strm2) =>
+                            (let size =
+                                   OpSize
+                                     (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                      op_size_override)
+                             in
+                             let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                               case opcode of
+                                 0w =>
+                                   (let (imm,strm4) =
+                                          immediate (size,strm3)
+                                    in
+                                      Zfull_inst
+                                        (p,
+                                         Zbinop
+                                           (Ztest,size,Zrm_i (rm,imm)),
+                                         strm4))
+                               | 2w =>
+                                   Zfull_inst
+                                     (p,Zmonop (Znot,size,rm),strm3)
+                               | 3w =>
+                                   Zfull_inst
+                                     (p,Zmonop (Zneg,size,rm),strm3)
+                               | 4w => Zfull_inst (p,Zmul (size,rm),strm3)
+                               | 6w => Zfull_inst (p,Zdiv (size,rm),strm3)
+                               | v =>
+                                   Zdec_fail
+                                     "Unsupported opcode: Unary Group 3")
+                        | ((T,T,T,T,F,T,F,v37),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,T,T,F,F,v33),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,T,F,T,T,v45),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,T,F,T,F,v48,T),strm2) =>
+                            (let (imm,strm3) =
+                                   if (1 >< 1) v#0 = 0w then
+                                     immediate32 strm2
+                                   else immediate8 strm2
+                             in
+                               Zfull_inst (p,Zjcc (Z_ALWAYS,imm),strm3))
+                        | ((T,T,T,F,T,F,T,F),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,T,F,T,F,F,F),strm2) =>
+                            (let (imm,strm3) = immediate32 strm2
+                             in
+                               Zfull_inst (p,Zcall (Zimm imm),strm3))
+                        | ((T,T,T,F,F,T,v53),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,T,F,F,F,T,T),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,T,F,F,F,T,F),strm2) =>
+                            (let (imm,strm3) = immediate8 strm2
+                             in
+                               Zfull_inst (p,Zloop (Z_ALWAYS,imm),strm3))
+                        | ((T,T,T,F,F,F,F,v57),strm2) =>
+                            (let (imm,strm3) = immediate8 strm2
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zloop
+                                    (if (0 >< 0) v#0 = 0w then Z_NE
+                                     else Z_E,imm),strm3))
+                        | ((T,T,F,T,T,v65),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,F,T,F,T,v69),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,F,T,F,F,v69),strm2) =>
+                            (let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                               if opcode = 6w then
+                                 Zdec_fail
+                                   "Unsupported opcode: Shift Group 2"
+                               else
+                                 Zfull_inst
+                                   (p,
+                                    Zbinop
+                                      (num2Zbinop_name (w2n opcode + 8),
+                                       OpSize
+                                         (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                          op_size_override),
+                                       if (1 >< 1) v#0 = 0w then
+                                         Zrm_i (rm,1w)
+                                       else Zrm_r (rm,RCX)),strm3))
+                        | ((T,T,F,F,T,v77),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,F,F,F,T,T,v85),strm2) =>
+                            (let size =
+                                   OpSize
+                                     (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                      op_size_override)
+                             in
+                             let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                             let (imm,strm4) = immediate (size,strm3)
+                             in
+                               if opcode = 0w then
+                                 Zfull_inst
+                                   (p,Zmov (Z_ALWAYS,size,Zrm_i (rm,imm)),
+                                    strm4)
+                               else
+                                 Zdec_fail "Unsupported opcode: Group 11")
+                        | ((T,T,F,F,F,T,F,v85),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,T,F,F,F,F,T,v89),strm2) =>
+                            if (0 >< 0) v#0 = 0w then
+                              (let (imm,strm3) = immediate16 strm2
+                               in
+                                 Zfull_inst (p,Zret imm,strm3))
+                            else Zfull_inst (p,Zret 0w,strm2)
+                        | ((T,T,F,F,F,F,F,v89),strm2) =>
+                            (let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                             let (imm,strm4) = immediate8 strm3
+                             in
+                               if opcode = 6w then
+                                 Zdec_fail
+                                   "Unsupported opcode: Shift Group 2"
+                               else
+                                 Zfull_inst
+                                   (p,
+                                    Zbinop
+                                      (num2Zbinop_name (w2n opcode + 8),
+                                       OpSize
+                                         (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                          op_size_override),
+                                       Zrm_i (rm,imm)),strm4))
+                        | ((T,F,T,T,v97),strm2) =>
+                            (let size =
+                                   OpSize
+                                     (have_rex,REX_1.W,(3 >< 3) v#0 ,
+                                      op_size_override)
+                             in
+                             let (imm,strm3) = full_immediate (size,strm2)
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zmov
+                                    (Z_ALWAYS,size,
+                                     Zrm_i
+                                       (Zr
+                                          (num2Zreg
+                                             (w2n
+                                                ((if REX_1.B then 1w
+                                                  else 0w) @@
+                                                 (2 >< 0) v#0 ))),imm)),
+                                  strm3))
+                        | ((T,F,T,F,T,T,v117),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,F,T,F,T,F,T,v121),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,F,T,F,T,F,F,v121),strm2) =>
+                            (let size =
+                                   OpSize
+                                     (T,REX_1.W,(0 >< 0) v#0 ,
+                                      op_size_override)
+                             in
+                             let (imm,strm3) = immediate (size,strm2)
+                             in
+                               Zfull_inst
+                                 (p,Zbinop (Ztest,size,Zrm_i (Zr RAX,imm)),
+                                  strm3))
+                        | ((T,F,T,F,F,v113),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,F,F,T,T,v129),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,F,F,T,F,v129),strm2) =>
+                            (let reg = RexReg (REX_1.B,(2 >< 0) v#0 )
+                             in
+                               if reg = RAX then Zfull_inst (p,Znop,strm2)
+                               else
+                                 Zfull_inst
+                                   (p,
+                                    Zxchg
+                                      (OpSize
+                                         (T,REX_1.W,1w,op_size_override),
+                                       Zr RAX,reg),strm2))
+                        | ((T,F,F,F,T,T,T,T),strm2) =>
+                            (let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                               if opcode = 0w then
+                                 Zfull_inst (p,Zpop rm,strm3)
+                               else
+                                 Zdec_fail "Unsupported opcode: Group 1a")
+                        | ((T,F,F,F,T,T,T,F),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,F,F,F,T,T,F,T),strm2) =>
+                            (let (reg,rm,strm3) = readModRM (REX_1,strm2)
+                             in
+                               if isZm rm then
+                                 Zfull_inst
+                                   (p,
+                                    Zlea
+                                      (OpSize
+                                         (T,REX_1.W,1w,op_size_override),
+                                       Zr_rm (reg,rm)),strm3)
+                               else Zdec_fail "LEA with register argument")
+                        | ((T,F,F,F,T,T,F,F),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,F,F,F,T,F,v145),strm2) =>
+                            (let (reg,rm,strm3) = readModRM (REX_1,strm2)
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zmov
+                                    (Z_ALWAYS,
+                                     OpSize
+                                       (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                        op_size_override),
+                                     if (1 >< 1) v#0 = 0w then
+                                       Zrm_r (rm,reg)
+                                     else Zr_rm (reg,rm)),strm3))
+                        | ((T,F,F,F,F,T,T,v161),strm2) =>
+                            (let (reg,rm,strm3) = readModRM (REX_1,strm2)
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zxchg
+                                    (OpSize
+                                       (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                        op_size_override),rm,reg),strm3))
+                        | ((T,F,F,F,F,T,F,v161),strm2) =>
+                            (let (reg,rm,strm3) = readModRM (REX_1,strm2)
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zbinop
+                                    (Ztest,
+                                     OpSize
+                                       (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                        op_size_override),Zrm_r (rm,reg)),
+                                  strm3))
+                        | ((T,F,F,F,F,F,T,T),strm2) =>
+                            (let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                             let (imm,strm4) = immediate8 strm3
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zbinop
+                                    (num2Zbinop_name (w2n opcode),
+                                     OpSize
+                                       (F,REX_1.W,1w,op_size_override),
+                                     Zrm_i (rm,imm)),strm4))
+                        | ((T,F,F,F,F,F,T,F),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((T,F,F,F,F,F,F,v165),strm2) =>
+                            (let size =
+                                   OpSize
+                                     (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                      op_size_override)
+                             in
+                             let (opcode,rm,strm3) =
+                                   readOpcodeModRM (REX_1,strm2)
+                             in
+                             let (imm,strm4) = immediate (size,strm3)
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zbinop
+                                    (num2Zbinop_name (w2n opcode),size,
+                                     Zrm_i (rm,imm)),strm4))
+                        | ((F,T,T,T,v177),strm2) =>
+                            (let (imm,strm3) = immediate8 strm2
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zjcc
+                                    (num2Zcond (w2n ((3 >< 0) v#0 )),imm),
+                                  strm3))
+                        | ((F,T,T,F,T,T,v197),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,T,T,F,T,F,v200,T),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,T,T,F,T,F,v200,F),strm2) =>
+                            (let (imm,strm3) =
+                                   if (1 >< 1) v#0 = 1w then
+                                     immediate8 strm2
+                                   else immediate32 strm2
+                             in
+                               Zfull_inst (p,Zpush (Zimm imm),strm3))
+                        | ((F,T,T,F,F,v193),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,T,F,T,v205),strm2) =>
+                            (let reg =
+                                   Zr
+                                     (num2Zreg
+                                        (w2n
+                                           ((if REX_1.B then 1w else 0w) @@
+                                            (2 >< 0) v#0 )))
+                             in
+                               Zfull_inst
+                                 (p,
+                                  if (3 >< 3) v#0 = 0w then Zpush (Zrm reg)
+                                  else Zpop reg,strm2))
+                        | ((F,T,F,F,v205),strm2) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,F,v220,v224,v228,T,T,v237),[]) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,F,v220,T,T,T,T,T),v240::v241) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,F,T,F,T,T,T,T),v240::v241) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,F,F,F,T,T,T,T),[v240]) =>
+                            (let (b'7,b'6,b'5,b'4,b'3,b'2,b'1,b'0) =
+                                   boolify8 v240
+                             in
+                               if ¬b'7 ∧ b'6 ∧ ¬b'5 ∧ ¬b'4 then
+                                 (let (reg,rm,strm3) = readModRM (REX_1,[])
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zmov
+                                         (num2Zcond (w2n ((3 >< 0) v240)),
+                                          OpSize
+                                            (T,REX_1.W,1w,
+                                             op_size_override),
+                                          Zr_rm (reg,rm)),strm3))
+                               else if b'7 ∧ ¬b'6 ∧ ¬b'5 ∧ ¬b'4 then
+                                 (let (imm,strm3) = immediate32 []
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zjcc
+                                         (num2Zcond (w2n ((3 >< 0) v240)),
+                                          imm),strm3))
+                               else if
+                                 b'7 ∧ ¬b'6 ∧ b'5 ∧ ¬b'4 ∧ ¬b'3 ∧ ¬b'2 ∧
+                                 b'1 ∧ ¬b'0
+                               then
+                                 Zfull_inst (p,Zcpuid,[])
+                               else if
+                                 b'7 ∧ ¬b'6 ∧ b'5 ∧ b'4 ∧ ¬b'3 ∧ ¬b'2 ∧
+                                 ¬b'1
+                               then
+                                 (let (reg,rm,strm3) = readModRM (REX_1,[])
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zcmpxchg
+                                         (OpSize
+                                            (have_rex,REX_1.W,
+                                             (0 >< 0) v240,
+                                             op_size_override),rm,reg),
+                                       strm3))
+                               else if
+                                 b'7 ∧ b'6 ∧ ¬b'5 ∧ ¬b'4 ∧ ¬b'3 ∧ ¬b'2 ∧
+                                 ¬b'1
+                               then
+                                 (let (reg,rm,strm3) = readModRM (REX_1,[])
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zxadd
+                                         (OpSize
+                                            (have_rex,REX_1.W,
+                                             (0 >< 0) v240,
+                                             op_size_override),rm,reg),
+                                       strm3))
+                               else if
+                                 b'7 ∧ ¬b'6 ∧ b'5 ∧ b'4 ∧ ¬b'3 ∧ b'2 ∧ b'1
+                               then
+                                 (let (reg,rm,strm3) = readModRM (REX_1,[])
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zmovzx
+                                         (OpSize
+                                            (have_rex,REX_1.W,1w,
+                                             op_size_override),
+                                          Zr_rm (reg,rm),
+                                          if (0 >< 0) v240 = 1w then Z16
+                                          else Z8 have_rex),strm3))
+                               else
+                                 Zdec_fail
+                                   (STRCAT "Unsupported opcode: 0F "
+                                      (word_to_hex_string v240)))
+                        | ((F,F,F,F,T,T,T,T),56w::opc::v247) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: 0F 38 "
+                                 (word_to_hex_string opc))
+                        | ((F,F,F,F,T,T,T,T),58w::opc::v247) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: 0F 3A "
+                                 (word_to_hex_string opc))
+                        | ((F,F,F,F,T,T,T,T),v248::opc::v247) =>
+                            (let (b'7,b'6,b'5,b'4,b'3,b'2,b'1,b'0) =
+                                   boolify8 v248
+                             in
+                               if ¬b'7 ∧ b'6 ∧ ¬b'5 ∧ ¬b'4 then
+                                 (let (reg,rm,strm3) =
+                                        readModRM (REX_1,opc::v247)
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zmov
+                                         (num2Zcond (w2n ((3 >< 0) v248)),
+                                          OpSize
+                                            (T,REX_1.W,1w,
+                                             op_size_override),
+                                          Zr_rm (reg,rm)),strm3))
+                               else if b'7 ∧ ¬b'6 ∧ ¬b'5 ∧ ¬b'4 then
+                                 (let (imm,strm3) = immediate32 (opc::v247)
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zjcc
+                                         (num2Zcond (w2n ((3 >< 0) v248)),
+                                          imm),strm3))
+                               else if
+                                 b'7 ∧ ¬b'6 ∧ b'5 ∧ ¬b'4 ∧ ¬b'3 ∧ ¬b'2 ∧
+                                 b'1 ∧ ¬b'0
+                               then
+                                 Zfull_inst (p,Zcpuid,opc::v247)
+                               else if
+                                 b'7 ∧ ¬b'6 ∧ b'5 ∧ b'4 ∧ ¬b'3 ∧ ¬b'2 ∧
+                                 ¬b'1
+                               then
+                                 (let (reg,rm,strm3) =
+                                        readModRM (REX_1,opc::v247)
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zcmpxchg
+                                         (OpSize
+                                            (have_rex,REX_1.W,
+                                             (0 >< 0) v248,
+                                             op_size_override),rm,reg),
+                                       strm3))
+                               else if
+                                 b'7 ∧ b'6 ∧ ¬b'5 ∧ ¬b'4 ∧ ¬b'3 ∧ ¬b'2 ∧
+                                 ¬b'1
+                               then
+                                 (let (reg,rm,strm3) =
+                                        readModRM (REX_1,opc::v247)
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zxadd
+                                         (OpSize
+                                            (have_rex,REX_1.W,
+                                             (0 >< 0) v248,
+                                             op_size_override),rm,reg),
+                                       strm3))
+                               else if
+                                 b'7 ∧ ¬b'6 ∧ b'5 ∧ b'4 ∧ ¬b'3 ∧ b'2 ∧ b'1
+                               then
+                                 (let (reg,rm,strm3) =
+                                        readModRM (REX_1,opc::v247)
+                                  in
+                                    Zfull_inst
+                                      (p,
+                                       Zmovzx
+                                         (OpSize
+                                            (have_rex,REX_1.W,1w,
+                                             op_size_override),
+                                          Zr_rm (reg,rm),
+                                          if (0 >< 0) v248 = 1w then Z16
+                                          else Z8 have_rex),strm3))
+                               else
+                                 Zdec_fail
+                                   (STRCAT "Unsupported opcode: 0F "
+                                      (word_to_hex_string v248)))
+                        | ((F,F,v220,v224,F,T,T,T),v240::v241) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,F,v220,v224,v228,T,T,F),v240::v241) =>
+                            Zdec_fail
+                              (STRCAT "Unsupported opcode: "
+                                 (word_to_hex_string v#0 ))
+                        | ((F,F,v220,v224,v228,T,F,v237),strm2) =>
+                            (let size =
+                                   OpSize
+                                     (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                      op_size_override)
+                             in
+                             let (imm,strm3) = immediate (size,strm2)
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zbinop
+                                    (num2Zbinop_name (w2n ((5 >< 3) v#0 )),
+                                     size,Zrm_i (Zr RAX,imm)),strm3))
+                        | ((F,F,v220,v224,v228,F,v233),strm2) =>
+                            (let (reg,rm,strm3) = readModRM (REX_1,strm2)
+                             in
+                               Zfull_inst
+                                 (p,
+                                  Zbinop
+                                    (num2Zbinop_name (w2n ((5 >< 3) v#0 )),
+                                     OpSize
+                                       (have_rex,REX_1.W,(0 >< 0) v#0 ,
+                                        op_size_override),
+                                     if (1 >< 1) v#0 = 0w then
+                                       Zrm_r (rm,reg)
+                                     else Zr_rm (reg,rm)),strm3)))
+
+   [x64_drop_def]  Definition
+
+      |- ∀imm.
+           x64_drop imm =
+           (λstate.
+              (let s =
+                     if (7 >< 0) imm ≠ 0w then
+                       SND (raise'exception (FAIL "x64_drop") state)
+                     else state
+               in
+                 ((),s with REG := (RSP =+ s.REG RSP + imm) s.REG)))
+
+   [x64_fetch_def]  Definition
+
+      |- ∀state.
+           x64_fetch state =
+           (let (r,s1) =
+                  (let s =
+                         SND
+                           (FOR
+                              (19,0,
+                               (λi state.
+                                  ((),
+                                   THE
+                                     ((SND state).MEM
+                                        ((SND state).RIP + n2w i))::
+                                       FST state,SND state))) ([],state))
+                   in
+                     (FST s,s))
+            in
+              (r,SND s1))
+
+   [x64_next_def]  Definition
+
+      |- ∀state.
+           x64_next state =
+           case x64_decode (FST (x64_fetch state)) of
+             Zdec_fail s0 => raise'exception (FAIL s0) state
+           | Zfull_inst (v2,i,strm1) =>
+               (let len = 20 − LENGTH strm1 in
+                let s = SND (checkIcache len state)
+                in
+                  Run i (s with RIP := s.RIP + n2w len))
+
+   [x64_pop_aux_def]  Definition
+
+      |- ∀state.
+           x64_pop_aux state =
+           (let v = state.REG RSP in
+            let (v0,s) = mem64 v state
+            in
+              (v0,s with REG := (RSP =+ v + 8w) s.REG))
+
+   [x64_pop_def]  Definition
+
+      |- ∀rm.
+           x64_pop rm =
+           (λstate.
+              (let (v0,s) = x64_pop_aux state
+               in
+                 write'EA (v0,FST (ea_Zrm (Z64,rm) state)) s))
+
+   [x64_pop_rip_def]  Definition
+
+      |- ∀state.
+           x64_pop_rip state =
+           (let (v,s) = x64_pop_aux state in ((),s with RIP := v))
+
+   [x64_push_aux_def]  Definition
+
+      |- ∀w.
+           x64_push_aux w =
+           (λstate.
+              (let v = state.REG RSP − 8w
+               in
+                 write'mem64 (w,v)
+                   (state with REG := (RSP =+ v) state.REG)))
+
+   [x64_push_def]  Definition
+
+      |- ∀imm_rm.
+           x64_push imm_rm =
+           (λstate.
+              (let (v,s) = EA (FST (ea_Zimm_rm (Z64,imm_rm) state)) state
+               in
+                 x64_push_aux v s))
+
+   [x64_push_rip_def]  Definition
+
+      |- ∀state. x64_push_rip state = x64_push_aux state.RIP state
+
+   [x64_state_EFLAGS]  Definition
+
+      |- ∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).EFLAGS = f
+
+   [x64_state_EFLAGS_fupd]  Definition
+
+      |- ∀f3 f f0 f1 f2 c e.
+           x64_state f f0 f1 f2 c e with EFLAGS updated_by f3 =
+           x64_state (f3 f) f0 f1 f2 c e
+
+   [x64_state_ICACHE]  Definition
+
+      |- ∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).ICACHE = f0
+
+   [x64_state_ICACHE_fupd]  Definition
+
+      |- ∀f3 f f0 f1 f2 c e.
+           x64_state f f0 f1 f2 c e with ICACHE updated_by f3 =
+           x64_state f (f3 f0) f1 f2 c e
+
+   [x64_state_MEM]  Definition
+
+      |- ∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).MEM = f1
+
+   [x64_state_MEM_fupd]  Definition
+
+      |- ∀f3 f f0 f1 f2 c e.
+           x64_state f f0 f1 f2 c e with MEM updated_by f3 =
+           x64_state f f0 (f3 f1) f2 c e
+
+   [x64_state_REG]  Definition
+
+      |- ∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).REG = f2
+
+   [x64_state_REG_fupd]  Definition
+
+      |- ∀f3 f f0 f1 f2 c e.
+           x64_state f f0 f1 f2 c e with REG updated_by f3 =
+           x64_state f f0 f1 (f3 f2) c e
+
+   [x64_state_RIP]  Definition
+
+      |- ∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).RIP = c
+
+   [x64_state_RIP_fupd]  Definition
+
+      |- ∀f3 f f0 f1 f2 c e.
+           x64_state f f0 f1 f2 c e with RIP updated_by f3 =
+           x64_state f f0 f1 f2 (f3 c) e
+
+   [x64_state_TY_DEF]  Definition
+
+      |- ∃rep.
+           TYPE_DEFINITION
+             (λa0'.
+                ∀'x64_state' .
+                  (∀a0'.
+                     (∃a0 a1 a2 a3 a4 a5.
+                        a0' =
+                        (λa0 a1 a2 a3 a4 a5.
+                           ind_type$CONSTR 0 (a0,a1,a2,a3,a4,a5)
+                             (λn. ind_type$BOTTOM)) a0 a1 a2 a3 a4 a5) ⇒
+                     'x64_state' a0') ⇒
+                  'x64_state' a0') rep
+
+   [x64_state_case_def]  Definition
+
+      |- ∀a0 a1 a2 a3 a4 a5 f.
+           x64_state_CASE (x64_state a0 a1 a2 a3 a4 a5) f =
+           f a0 a1 a2 a3 a4 a5
+
+   [x64_state_exception]  Definition
+
+      |- ∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).exception = e
+
+   [x64_state_exception_fupd]  Definition
+
+      |- ∀f3 f f0 f1 f2 c e.
+           x64_state f f0 f1 f2 c e with exception updated_by f3 =
+           x64_state f f0 f1 f2 c (f3 e)
+
+   [x64_state_size_def]  Definition
+
+      |- ∀a0 a1 a2 a3 a4 a5.
+           x64_state_size (x64_state a0 a1 a2 a3 a4 a5) =
+           1 + exception_size a5
+
+   [EXISTS_REX]  Theorem
+
+      |- ∀P.
+           (∃R. P R) ⇔ ∃b2 b1 b0 b. P <|B := b2; R := b1; W := b0; X := b|>
+
+   [EXISTS_x64_state]  Theorem
+
+      |- ∀P.
+           (∃x. P x) ⇔
+           ∃f2 f1 f0 f c e.
+             P
+               <|EFLAGS := f2; ICACHE := f1; MEM := f0; REG := f; RIP := c;
+                 exception := e|>
+
+   [FORALL_REX]  Theorem
+
+      |- ∀P.
+           (∀R. P R) ⇔ ∀b2 b1 b0 b. P <|B := b2; R := b1; W := b0; X := b|>
+
+   [FORALL_x64_state]  Theorem
+
+      |- ∀P.
+           (∀x. P x) ⇔
+           ∀f2 f1 f0 f c e.
+             P
+               <|EFLAGS := f2; ICACHE := f1; MEM := f0; REG := f; RIP := c;
+                 exception := e|>
+
+   [REX_11]  Theorem
+
+      |- ∀a0 a1 a2 a3 a0' a1' a2' a3'.
+           (REX a0 a1 a2 a3 = REX a0' a1' a2' a3') ⇔
+           (a0 ⇔ a0') ∧ (a1 ⇔ a1') ∧ (a2 ⇔ a2') ∧ (a3 ⇔ a3')
+
+   [REX_Axiom]  Theorem
+
+      |- ∀f. ∃fn. ∀a0 a1 a2 a3. fn (REX a0 a1 a2 a3) = f a0 a1 a2 a3
+
+   [REX_accessors]  Theorem
+
+      |- (∀b b0 b1 b2. (REX b b0 b1 b2).B ⇔ b) ∧
+         (∀b b0 b1 b2. (REX b b0 b1 b2).R ⇔ b0) ∧
+         (∀b b0 b1 b2. (REX b b0 b1 b2).W ⇔ b1) ∧
+         ∀b b0 b1 b2. (REX b b0 b1 b2).X ⇔ b2
+
+   [REX_accfupds]  Theorem
+
+      |- (∀f R. (R with R updated_by f).B ⇔ R.B) ∧
+         (∀f R. (R with W updated_by f).B ⇔ R.B) ∧
+         (∀f R. (R with X updated_by f).B ⇔ R.B) ∧
+         (∀f R. (R with B updated_by f).R ⇔ R.R) ∧
+         (∀f R. (R with W updated_by f).R ⇔ R.R) ∧
+         (∀f R. (R with X updated_by f).R ⇔ R.R) ∧
+         (∀f R. (R with B updated_by f).W ⇔ R.W) ∧
+         (∀f R. (R with R updated_by f).W ⇔ R.W) ∧
+         (∀f R. (R with X updated_by f).W ⇔ R.W) ∧
+         (∀f R. (R with B updated_by f).X ⇔ R.X) ∧
+         (∀f R. (R with R updated_by f).X ⇔ R.X) ∧
+         (∀f R. (R with W updated_by f).X ⇔ R.X) ∧
+         (∀f R. (R with B updated_by f).B ⇔ f R.B) ∧
+         (∀f R. (R with R updated_by f).R ⇔ f R.R) ∧
+         (∀f R. (R with W updated_by f).W ⇔ f R.W) ∧
+         ∀f R. (R with X updated_by f).X ⇔ f R.X
+
+   [REX_case_cong]  Theorem
+
+      |- ∀M M' f.
+           (M = M') ∧
+           (∀a0 a1 a2 a3.
+              (M' = REX a0 a1 a2 a3) ⇒ (f a0 a1 a2 a3 = f' a0 a1 a2 a3)) ⇒
+           (REX_CASE M f = REX_CASE M' f')
+
+   [REX_component_equality]  Theorem
+
+      |- ∀R1 R2.
+           (R1 = R2) ⇔
+           (R1.B ⇔ R2.B) ∧ (R1.R ⇔ R2.R) ∧ (R1.W ⇔ R2.W) ∧ (R1.X ⇔ R2.X)
+
+   [REX_fn_updates]  Theorem
+
+      |- (∀f b b0 b1 b2.
+            REX b b0 b1 b2 with B updated_by f = REX (f b) b0 b1 b2) ∧
+         (∀f b b0 b1 b2.
+            REX b b0 b1 b2 with R updated_by f = REX b (f b0) b1 b2) ∧
+         (∀f b b0 b1 b2.
+            REX b b0 b1 b2 with W updated_by f = REX b b0 (f b1) b2) ∧
+         ∀f b b0 b1 b2.
+           REX b b0 b1 b2 with X updated_by f = REX b b0 b1 (f b2)
+
+   [REX_fupdcanon]  Theorem
+
+      |- (∀g f R.
+            R with <|R updated_by f; B updated_by g|> =
+            R with <|B updated_by g; R updated_by f|>) ∧
+         (∀g f R.
+            R with <|W updated_by f; B updated_by g|> =
+            R with <|B updated_by g; W updated_by f|>) ∧
+         (∀g f R.
+            R with <|W updated_by f; R updated_by g|> =
+            R with <|R updated_by g; W updated_by f|>) ∧
+         (∀g f R.
+            R with <|X updated_by f; B updated_by g|> =
+            R with <|B updated_by g; X updated_by f|>) ∧
+         (∀g f R.
+            R with <|X updated_by f; R updated_by g|> =
+            R with <|R updated_by g; X updated_by f|>) ∧
+         ∀g f R.
+           R with <|X updated_by f; W updated_by g|> =
+           R with <|W updated_by g; X updated_by f|>
+
+   [REX_fupdcanon_comp]  Theorem
+
+      |- ((∀g f.
+              _ record fupdateR f o  _ record fupdateB g =
+              _ record fupdateB g o  _ record fupdateR f) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdateB g o h =
+             _ record fupdateB g o  _ record fupdateR f o h) ∧
+         ((∀g f.
+              _ record fupdateW f o  _ record fupdateB g =
+              _ record fupdateB g o  _ record fupdateW f) ∧
+          ∀h g f.
+             _ record fupdateW f o  _ record fupdateB g o h =
+             _ record fupdateB g o  _ record fupdateW f o h) ∧
+         ((∀g f.
+              _ record fupdateW f o  _ record fupdateR g =
+              _ record fupdateR g o  _ record fupdateW f) ∧
+          ∀h g f.
+             _ record fupdateW f o  _ record fupdateR g o h =
+             _ record fupdateR g o  _ record fupdateW f o h) ∧
+         ((∀g f.
+              _ record fupdateX f o  _ record fupdateB g =
+              _ record fupdateB g o  _ record fupdateX f) ∧
+          ∀h g f.
+             _ record fupdateX f o  _ record fupdateB g o h =
+             _ record fupdateB g o  _ record fupdateX f o h) ∧
+         ((∀g f.
+              _ record fupdateX f o  _ record fupdateR g =
+              _ record fupdateR g o  _ record fupdateX f) ∧
+          ∀h g f.
+             _ record fupdateX f o  _ record fupdateR g o h =
+             _ record fupdateR g o  _ record fupdateX f o h) ∧
+         (∀g f.
+             _ record fupdateX f o  _ record fupdateW g =
+             _ record fupdateW g o  _ record fupdateX f) ∧
+         ∀h g f.
+            _ record fupdateX f o  _ record fupdateW g o h =
+            _ record fupdateW g o  _ record fupdateX f o h
+
+   [REX_fupdfupds]  Theorem
+
+      |- (∀g f R.
+            R with <|B updated_by f; B updated_by g|> =
+            R with B updated_by f o g) ∧
+         (∀g f R.
+            R with <|R updated_by f; R updated_by g|> =
+            R with R updated_by f o g) ∧
+         (∀g f R.
+            R with <|W updated_by f; W updated_by g|> =
+            R with W updated_by f o g) ∧
+         ∀g f R.
+           R with <|X updated_by f; X updated_by g|> =
+           R with X updated_by f o g
+
+   [REX_fupdfupds_comp]  Theorem
+
+      |- ((∀g f.
+              _ record fupdateB f o  _ record fupdateB g =
+              _ record fupdateB (f o g)) ∧
+          ∀h g f.
+             _ record fupdateB f o  _ record fupdateB g o h =
+             _ record fupdateB (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateR f o  _ record fupdateR g =
+              _ record fupdateR (f o g)) ∧
+          ∀h g f.
+             _ record fupdateR f o  _ record fupdateR g o h =
+             _ record fupdateR (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateW f o  _ record fupdateW g =
+              _ record fupdateW (f o g)) ∧
+          ∀h g f.
+             _ record fupdateW f o  _ record fupdateW g o h =
+             _ record fupdateW (f o g) o h) ∧
+         (∀g f.
+             _ record fupdateX f o  _ record fupdateX g =
+             _ record fupdateX (f o g)) ∧
+         ∀h g f.
+            _ record fupdateX f o  _ record fupdateX g o h =
+            _ record fupdateX (f o g) o h
+
+   [REX_induction]  Theorem
+
+      |- ∀P. (∀b b0 b1 b2. P (REX b b0 b1 b2)) ⇒ ∀R. P R
+
+   [REX_literal_11]  Theorem
+
+      |- ∀b21 b11 b01 b1 b22 b12 b02 b2.
+           (<|B := b21; R := b11; W := b01; X := b1|> =
+            <|B := b22; R := b12; W := b02; X := b2|>) ⇔
+           (b21 ⇔ b22) ∧ (b11 ⇔ b12) ∧ (b01 ⇔ b02) ∧ (b1 ⇔ b2)
+
+   [REX_literal_nchotomy]  Theorem
+
+      |- ∀R. ∃b2 b1 b0 b. R = <|B := b2; R := b1; W := b0; X := b|>
+
+   [REX_nchotomy]  Theorem
+
+      |- ∀RR. ∃b b0 b1 b2. RR = REX b b0 b1 b2
+
+   [REX_updates_eq_literal]  Theorem
+
+      |- ∀R b2 b1 b0 b.
+           R with <|B := b2; R := b1; W := b0; X := b|> =
+           <|B := b2; R := b1; W := b0; X := b|>
+
+   [Zbase_11]  Theorem
+
+      |- ∀a a'. (ZregBase a = ZregBase a') ⇔ (a = a')
+
+   [Zbase_Axiom]  Theorem
+
+      |- ∀f0 f1 f2.
+           ∃fn.
+             (fn ZnoBase = f0) ∧ (∀a. fn (ZregBase a) = f1 a) ∧
+             (fn ZripBase = f2)
+
+   [Zbase_case_cong]  Theorem
+
+      |- ∀M M' v f v1.
+           (M = M') ∧ ((M' = ZnoBase) ⇒ (v = v')) ∧
+           (∀a. (M' = ZregBase a) ⇒ (f a = f' a)) ∧
+           ((M' = ZripBase) ⇒ (v1 = v1')) ⇒
+           (Zbase_CASE M v f v1 = Zbase_CASE M' v' f' v1')
+
+   [Zbase_distinct]  Theorem
+
+      |- (∀a. ZnoBase ≠ ZregBase a) ∧ ZnoBase ≠ ZripBase ∧
+         ∀a. ZregBase a ≠ ZripBase
+
+   [Zbase_induction]  Theorem
+
+      |- ∀P. P ZnoBase ∧ (∀Z. P (ZregBase Z)) ∧ P ZripBase ⇒ ∀Z. P Z
+
+   [Zbase_nchotomy]  Theorem
+
+      |- ∀ZZ. (ZZ = ZnoBase) ∨ (∃Z. ZZ = ZregBase Z) ∨ (ZZ = ZripBase)
+
+   [Zbinop_name2num_11]  Theorem
+
+      |- ∀a a'. (Zbinop_name2num a = Zbinop_name2num a') ⇔ (a = a')
+
+   [Zbinop_name2num_ONTO]  Theorem
+
+      |- ∀r. r < 16 ⇔ ∃a. r = Zbinop_name2num a
+
+   [Zbinop_name2num_num2Zbinop_name]  Theorem
+
+      |- ∀r. r < 16 ⇔ (Zbinop_name2num (num2Zbinop_name r) = r)
+
+   [Zbinop_name2num_thm]  Theorem
+
+      |- (Zbinop_name2num Zadd = 0) ∧ (Zbinop_name2num Zor = 1) ∧
+         (Zbinop_name2num Zadc = 2) ∧ (Zbinop_name2num Zsbb = 3) ∧
+         (Zbinop_name2num Zand = 4) ∧ (Zbinop_name2num Zsub = 5) ∧
+         (Zbinop_name2num Zxor = 6) ∧ (Zbinop_name2num Zcmp = 7) ∧
+         (Zbinop_name2num Zrol = 8) ∧ (Zbinop_name2num Zror = 9) ∧
+         (Zbinop_name2num Zrcl = 10) ∧ (Zbinop_name2num Zrcr = 11) ∧
+         (Zbinop_name2num Zshl = 12) ∧ (Zbinop_name2num Zshr = 13) ∧
+         (Zbinop_name2num Ztest = 14) ∧ (Zbinop_name2num Zsar = 15)
+
+   [Zbinop_name_Axiom]  Theorem
+
+      |- ∀x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15.
+           ∃f.
+             (f Zadd = x0) ∧ (f Zor = x1) ∧ (f Zadc = x2) ∧ (f Zsbb = x3) ∧
+             (f Zand = x4) ∧ (f Zsub = x5) ∧ (f Zxor = x6) ∧
+             (f Zcmp = x7) ∧ (f Zrol = x8) ∧ (f Zror = x9) ∧
+             (f Zrcl = x10) ∧ (f Zrcr = x11) ∧ (f Zshl = x12) ∧
+             (f Zshr = x13) ∧ (f Ztest = x14) ∧ (f Zsar = x15)
+
+   [Zbinop_name_EQ_Zbinop_name]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (Zbinop_name2num a = Zbinop_name2num a')
+
+   [Zbinop_name_case_cong]  Theorem
+
+      |- ∀M M' v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+           (M = M') ∧ ((M' = Zadd) ⇒ (v0 = v0')) ∧
+           ((M' = Zor) ⇒ (v1 = v1')) ∧ ((M' = Zadc) ⇒ (v2 = v2')) ∧
+           ((M' = Zsbb) ⇒ (v3 = v3')) ∧ ((M' = Zand) ⇒ (v4 = v4')) ∧
+           ((M' = Zsub) ⇒ (v5 = v5')) ∧ ((M' = Zxor) ⇒ (v6 = v6')) ∧
+           ((M' = Zcmp) ⇒ (v7 = v7')) ∧ ((M' = Zrol) ⇒ (v8 = v8')) ∧
+           ((M' = Zror) ⇒ (v9 = v9')) ∧ ((M' = Zrcl) ⇒ (v10 = v10')) ∧
+           ((M' = Zrcr) ⇒ (v11 = v11')) ∧ ((M' = Zshl) ⇒ (v12 = v12')) ∧
+           ((M' = Zshr) ⇒ (v13 = v13')) ∧ ((M' = Ztest) ⇒ (v14 = v14')) ∧
+           ((M' = Zsar) ⇒ (v15 = v15')) ⇒
+           ((case M of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            case M' of
+              Zadd => v0'
+            | Zor => v1'
+            | Zadc => v2'
+            | Zsbb => v3'
+            | Zand => v4'
+            | Zsub => v5'
+            | Zxor => v6'
+            | Zcmp => v7'
+            | Zrol => v8'
+            | Zror => v9'
+            | Zrcl => v10'
+            | Zrcr => v11'
+            | Zshl => v12'
+            | Zshr => v13'
+            | Ztest => v14'
+            | Zsar => v15')
+
+   [Zbinop_name_case_def]  Theorem
+
+      |- (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zadd of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v0) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zor of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v1) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zadc of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v2) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zsbb of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v3) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zand of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v4) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zsub of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v5) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zxor of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v6) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zcmp of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v7) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zrol of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v8) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zror of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v9) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zrcl of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v10) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zrcr of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v11) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zshl of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v12) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Zshr of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v13) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case Ztest of
+               Zadd => v0
+             | Zor => v1
+             | Zadc => v2
+             | Zsbb => v3
+             | Zand => v4
+             | Zsub => v5
+             | Zxor => v6
+             | Zcmp => v7
+             | Zrol => v8
+             | Zror => v9
+             | Zrcl => v10
+             | Zrcr => v11
+             | Zshl => v12
+             | Zshr => v13
+             | Ztest => v14
+             | Zsar => v15) =
+            v14) ∧
+         ∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+           (case Zsar of
+              Zadd => v0
+            | Zor => v1
+            | Zadc => v2
+            | Zsbb => v3
+            | Zand => v4
+            | Zsub => v5
+            | Zxor => v6
+            | Zcmp => v7
+            | Zrol => v8
+            | Zror => v9
+            | Zrcl => v10
+            | Zrcr => v11
+            | Zshl => v12
+            | Zshr => v13
+            | Ztest => v14
+            | Zsar => v15) =
+           v15
+
+   [Zbinop_name_induction]  Theorem
+
+      |- ∀P.
+           P Zadc ∧ P Zadd ∧ P Zand ∧ P Zcmp ∧ P Zor ∧ P Zrcl ∧ P Zrcr ∧
+           P Zrol ∧ P Zror ∧ P Zsar ∧ P Zsbb ∧ P Zshl ∧ P Zshr ∧ P Zsub ∧
+           P Ztest ∧ P Zxor ⇒
+           ∀a. P a
+
+   [Zbinop_name_nchotomy]  Theorem
+
+      |- ∀a.
+           (a = Zadd) ∨ (a = Zor) ∨ (a = Zadc) ∨ (a = Zsbb) ∨ (a = Zand) ∨
+           (a = Zsub) ∨ (a = Zxor) ∨ (a = Zcmp) ∨ (a = Zrol) ∨ (a = Zror) ∨
+           (a = Zrcl) ∨ (a = Zrcr) ∨ (a = Zshl) ∨ (a = Zshr) ∨
+           (a = Ztest) ∨ (a = Zsar)
+
+   [Zcond2num_11]  Theorem
+
+      |- ∀a a'. (Zcond2num a = Zcond2num a') ⇔ (a = a')
+
+   [Zcond2num_ONTO]  Theorem
+
+      |- ∀r. r < 17 ⇔ ∃a. r = Zcond2num a
+
+   [Zcond2num_num2Zcond]  Theorem
+
+      |- ∀r. r < 17 ⇔ (Zcond2num (num2Zcond r) = r)
+
+   [Zcond2num_thm]  Theorem
+
+      |- (Zcond2num Z_O = 0) ∧ (Zcond2num Z_NO = 1) ∧ (Zcond2num Z_B = 2) ∧
+         (Zcond2num Z_NB = 3) ∧ (Zcond2num Z_E = 4) ∧
+         (Zcond2num Z_NE = 5) ∧ (Zcond2num Z_NA = 6) ∧
+         (Zcond2num Z_A = 7) ∧ (Zcond2num Z_S = 8) ∧ (Zcond2num Z_NS = 9) ∧
+         (Zcond2num Z_P = 10) ∧ (Zcond2num Z_NP = 11) ∧
+         (Zcond2num Z_L = 12) ∧ (Zcond2num Z_NL = 13) ∧
+         (Zcond2num Z_NG = 14) ∧ (Zcond2num Z_G = 15) ∧
+         (Zcond2num Z_ALWAYS = 16)
+
+   [Zcond_Axiom]  Theorem
+
+      |- ∀x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16.
+           ∃f.
+             (f Z_O = x0) ∧ (f Z_NO = x1) ∧ (f Z_B = x2) ∧ (f Z_NB = x3) ∧
+             (f Z_E = x4) ∧ (f Z_NE = x5) ∧ (f Z_NA = x6) ∧ (f Z_A = x7) ∧
+             (f Z_S = x8) ∧ (f Z_NS = x9) ∧ (f Z_P = x10) ∧
+             (f Z_NP = x11) ∧ (f Z_L = x12) ∧ (f Z_NL = x13) ∧
+             (f Z_NG = x14) ∧ (f Z_G = x15) ∧ (f Z_ALWAYS = x16)
+
+   [Zcond_EQ_Zcond]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (Zcond2num a = Zcond2num a')
+
+   [Zcond_case_cong]  Theorem
+
+      |- ∀M M' v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+           (M = M') ∧ ((M' = Z_O) ⇒ (v0 = v0')) ∧
+           ((M' = Z_NO) ⇒ (v1 = v1')) ∧ ((M' = Z_B) ⇒ (v2 = v2')) ∧
+           ((M' = Z_NB) ⇒ (v3 = v3')) ∧ ((M' = Z_E) ⇒ (v4 = v4')) ∧
+           ((M' = Z_NE) ⇒ (v5 = v5')) ∧ ((M' = Z_NA) ⇒ (v6 = v6')) ∧
+           ((M' = Z_A) ⇒ (v7 = v7')) ∧ ((M' = Z_S) ⇒ (v8 = v8')) ∧
+           ((M' = Z_NS) ⇒ (v9 = v9')) ∧ ((M' = Z_P) ⇒ (v10 = v10')) ∧
+           ((M' = Z_NP) ⇒ (v11 = v11')) ∧ ((M' = Z_L) ⇒ (v12 = v12')) ∧
+           ((M' = Z_NL) ⇒ (v13 = v13')) ∧ ((M' = Z_NG) ⇒ (v14 = v14')) ∧
+           ((M' = Z_G) ⇒ (v15 = v15')) ∧ ((M' = Z_ALWAYS) ⇒ (v16 = v16')) ⇒
+           ((case M of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            case M' of
+              Z_O => v0'
+            | Z_NO => v1'
+            | Z_B => v2'
+            | Z_NB => v3'
+            | Z_E => v4'
+            | Z_NE => v5'
+            | Z_NA => v6'
+            | Z_A => v7'
+            | Z_S => v8'
+            | Z_NS => v9'
+            | Z_P => v10'
+            | Z_NP => v11'
+            | Z_L => v12'
+            | Z_NL => v13'
+            | Z_NG => v14'
+            | Z_G => v15'
+            | Z_ALWAYS => v16')
+
+   [Zcond_case_def]  Theorem
+
+      |- (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_O of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v0) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_NO of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v1) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_B of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v2) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_NB of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v3) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_E of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v4) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_NE of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v5) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_NA of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v6) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_A of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v7) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_S of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v8) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_NS of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v9) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_P of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v10) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_NP of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v11) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_L of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v12) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_NL of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v13) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_NG of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v14) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+            (case Z_G of
+               Z_O => v0
+             | Z_NO => v1
+             | Z_B => v2
+             | Z_NB => v3
+             | Z_E => v4
+             | Z_NE => v5
+             | Z_NA => v6
+             | Z_A => v7
+             | Z_S => v8
+             | Z_NS => v9
+             | Z_P => v10
+             | Z_NP => v11
+             | Z_L => v12
+             | Z_NL => v13
+             | Z_NG => v14
+             | Z_G => v15
+             | Z_ALWAYS => v16) =
+            v15) ∧
+         ∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16.
+           (case Z_ALWAYS of
+              Z_O => v0
+            | Z_NO => v1
+            | Z_B => v2
+            | Z_NB => v3
+            | Z_E => v4
+            | Z_NE => v5
+            | Z_NA => v6
+            | Z_A => v7
+            | Z_S => v8
+            | Z_NS => v9
+            | Z_P => v10
+            | Z_NP => v11
+            | Z_L => v12
+            | Z_NL => v13
+            | Z_NG => v14
+            | Z_G => v15
+            | Z_ALWAYS => v16) =
+           v16
+
+   [Zcond_induction]  Theorem
+
+      |- ∀P.
+           P Z_A ∧ P Z_ALWAYS ∧ P Z_B ∧ P Z_E ∧ P Z_G ∧ P Z_L ∧ P Z_NA ∧
+           P Z_NB ∧ P Z_NE ∧ P Z_NG ∧ P Z_NL ∧ P Z_NO ∧ P Z_NP ∧ P Z_NS ∧
+           P Z_O ∧ P Z_P ∧ P Z_S ⇒
+           ∀a. P a
+
+   [Zcond_nchotomy]  Theorem
+
+      |- ∀a.
+           (a = Z_O) ∨ (a = Z_NO) ∨ (a = Z_B) ∨ (a = Z_NB) ∨ (a = Z_E) ∨
+           (a = Z_NE) ∨ (a = Z_NA) ∨ (a = Z_A) ∨ (a = Z_S) ∨ (a = Z_NS) ∨
+           (a = Z_P) ∨ (a = Z_NP) ∨ (a = Z_L) ∨ (a = Z_NL) ∨ (a = Z_NG) ∨
+           (a = Z_G) ∨ (a = Z_ALWAYS)
+
+   [Zdest_src_11]  Theorem
+
+      |- (∀a a'. (Zr_rm a = Zr_rm a') ⇔ (a = a')) ∧
+         (∀a a'. (Zrm_i a = Zrm_i a') ⇔ (a = a')) ∧
+         ∀a a'. (Zrm_r a = Zrm_r a') ⇔ (a = a')
+
+   [Zdest_src_Axiom]  Theorem
+
+      |- ∀f0 f1 f2.
+           ∃fn.
+             (∀a. fn (Zr_rm a) = f0 a) ∧ (∀a. fn (Zrm_i a) = f1 a) ∧
+             ∀a. fn (Zrm_r a) = f2 a
+
+   [Zdest_src_case_cong]  Theorem
+
+      |- ∀M M' f f1 f2.
+           (M = M') ∧ (∀a. (M' = Zr_rm a) ⇒ (f a = f' a)) ∧
+           (∀a. (M' = Zrm_i a) ⇒ (f1 a = f1' a)) ∧
+           (∀a. (M' = Zrm_r a) ⇒ (f2 a = f2' a)) ⇒
+           (Zdest_src_CASE M f f1 f2 = Zdest_src_CASE M' f' f1' f2')
+
+   [Zdest_src_distinct]  Theorem
+
+      |- (∀a' a. Zr_rm a ≠ Zrm_i a') ∧ (∀a' a. Zr_rm a ≠ Zrm_r a') ∧
+         ∀a' a. Zrm_i a ≠ Zrm_r a'
+
+   [Zdest_src_induction]  Theorem
+
+      |- ∀P.
+           (∀p. P (Zr_rm p)) ∧ (∀p. P (Zrm_i p)) ∧ (∀p. P (Zrm_r p)) ⇒
+           ∀Z. P Z
+
+   [Zdest_src_nchotomy]  Theorem
+
+      |- ∀ZZ. (∃p. ZZ = Zr_rm p) ∨ (∃p. ZZ = Zrm_i p) ∨ ∃p. ZZ = Zrm_r p
+
+   [Zea_11]  Theorem
+
+      |- (∀a a'. (Zea_i a = Zea_i a') ⇔ (a = a')) ∧
+         (∀a a'. (Zea_m a = Zea_m a') ⇔ (a = a')) ∧
+         ∀a a'. (Zea_r a = Zea_r a') ⇔ (a = a')
+
+   [Zea_Axiom]  Theorem
+
+      |- ∀f0 f1 f2.
+           ∃fn.
+             (∀a. fn (Zea_i a) = f0 a) ∧ (∀a. fn (Zea_m a) = f1 a) ∧
+             ∀a. fn (Zea_r a) = f2 a
+
+   [Zea_case_cong]  Theorem
+
+      |- ∀M M' f f1 f2.
+           (M = M') ∧ (∀a. (M' = Zea_i a) ⇒ (f a = f' a)) ∧
+           (∀a. (M' = Zea_m a) ⇒ (f1 a = f1' a)) ∧
+           (∀a. (M' = Zea_r a) ⇒ (f2 a = f2' a)) ⇒
+           (Zea_CASE M f f1 f2 = Zea_CASE M' f' f1' f2')
+
+   [Zea_distinct]  Theorem
+
+      |- (∀a' a. Zea_i a ≠ Zea_m a') ∧ (∀a' a. Zea_i a ≠ Zea_r a') ∧
+         ∀a' a. Zea_m a ≠ Zea_r a'
+
+   [Zea_induction]  Theorem
+
+      |- ∀P.
+           (∀p. P (Zea_i p)) ∧ (∀p. P (Zea_m p)) ∧ (∀p. P (Zea_r p)) ⇒
+           ∀Z. P Z
+
+   [Zea_nchotomy]  Theorem
+
+      |- ∀ZZ. (∃p. ZZ = Zea_i p) ∨ (∃p. ZZ = Zea_m p) ∨ ∃p. ZZ = Zea_r p
+
+   [Zeflags2num_11]  Theorem
+
+      |- ∀a a'. (Zeflags2num a = Zeflags2num a') ⇔ (a = a')
+
+   [Zeflags2num_ONTO]  Theorem
+
+      |- ∀r. r < 6 ⇔ ∃a. r = Zeflags2num a
+
+   [Zeflags2num_num2Zeflags]  Theorem
+
+      |- ∀r. r < 6 ⇔ (Zeflags2num (num2Zeflags r) = r)
+
+   [Zeflags2num_thm]  Theorem
+
+      |- (Zeflags2num Z_CF = 0) ∧ (Zeflags2num Z_PF = 1) ∧
+         (Zeflags2num Z_AF = 2) ∧ (Zeflags2num Z_ZF = 3) ∧
+         (Zeflags2num Z_SF = 4) ∧ (Zeflags2num Z_OF = 5)
+
+   [Zeflags_Axiom]  Theorem
+
+      |- ∀x0 x1 x2 x3 x4 x5.
+           ∃f.
+             (f Z_CF = x0) ∧ (f Z_PF = x1) ∧ (f Z_AF = x2) ∧
+             (f Z_ZF = x3) ∧ (f Z_SF = x4) ∧ (f Z_OF = x5)
+
+   [Zeflags_EQ_Zeflags]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (Zeflags2num a = Zeflags2num a')
+
+   [Zeflags_case_cong]  Theorem
+
+      |- ∀M M' v0 v1 v2 v3 v4 v5.
+           (M = M') ∧ ((M' = Z_CF) ⇒ (v0 = v0')) ∧
+           ((M' = Z_PF) ⇒ (v1 = v1')) ∧ ((M' = Z_AF) ⇒ (v2 = v2')) ∧
+           ((M' = Z_ZF) ⇒ (v3 = v3')) ∧ ((M' = Z_SF) ⇒ (v4 = v4')) ∧
+           ((M' = Z_OF) ⇒ (v5 = v5')) ⇒
+           ((case M of
+               Z_CF => v0
+             | Z_PF => v1
+             | Z_AF => v2
+             | Z_ZF => v3
+             | Z_SF => v4
+             | Z_OF => v5) =
+            case M' of
+              Z_CF => v0'
+            | Z_PF => v1'
+            | Z_AF => v2'
+            | Z_ZF => v3'
+            | Z_SF => v4'
+            | Z_OF => v5')
+
+   [Zeflags_case_def]  Theorem
+
+      |- (∀v0 v1 v2 v3 v4 v5.
+            (case Z_CF of
+               Z_CF => v0
+             | Z_PF => v1
+             | Z_AF => v2
+             | Z_ZF => v3
+             | Z_SF => v4
+             | Z_OF => v5) =
+            v0) ∧
+         (∀v0 v1 v2 v3 v4 v5.
+            (case Z_PF of
+               Z_CF => v0
+             | Z_PF => v1
+             | Z_AF => v2
+             | Z_ZF => v3
+             | Z_SF => v4
+             | Z_OF => v5) =
+            v1) ∧
+         (∀v0 v1 v2 v3 v4 v5.
+            (case Z_AF of
+               Z_CF => v0
+             | Z_PF => v1
+             | Z_AF => v2
+             | Z_ZF => v3
+             | Z_SF => v4
+             | Z_OF => v5) =
+            v2) ∧
+         (∀v0 v1 v2 v3 v4 v5.
+            (case Z_ZF of
+               Z_CF => v0
+             | Z_PF => v1
+             | Z_AF => v2
+             | Z_ZF => v3
+             | Z_SF => v4
+             | Z_OF => v5) =
+            v3) ∧
+         (∀v0 v1 v2 v3 v4 v5.
+            (case Z_SF of
+               Z_CF => v0
+             | Z_PF => v1
+             | Z_AF => v2
+             | Z_ZF => v3
+             | Z_SF => v4
+             | Z_OF => v5) =
+            v4) ∧
+         ∀v0 v1 v2 v3 v4 v5.
+           (case Z_OF of
+              Z_CF => v0
+            | Z_PF => v1
+            | Z_AF => v2
+            | Z_ZF => v3
+            | Z_SF => v4
+            | Z_OF => v5) =
+           v5
+
+   [Zeflags_distinct]  Theorem
+
+      |- Z_CF ≠ Z_PF ∧ Z_CF ≠ Z_AF ∧ Z_CF ≠ Z_ZF ∧ Z_CF ≠ Z_SF ∧
+         Z_CF ≠ Z_OF ∧ Z_PF ≠ Z_AF ∧ Z_PF ≠ Z_ZF ∧ Z_PF ≠ Z_SF ∧
+         Z_PF ≠ Z_OF ∧ Z_AF ≠ Z_ZF ∧ Z_AF ≠ Z_SF ∧ Z_AF ≠ Z_OF ∧
+         Z_ZF ≠ Z_SF ∧ Z_ZF ≠ Z_OF ∧ Z_SF ≠ Z_OF
+
+   [Zeflags_induction]  Theorem
+
+      |- ∀P. P Z_AF ∧ P Z_CF ∧ P Z_OF ∧ P Z_PF ∧ P Z_SF ∧ P Z_ZF ⇒ ∀a. P a
+
+   [Zeflags_nchotomy]  Theorem
+
+      |- ∀a.
+           (a = Z_CF) ∨ (a = Z_PF) ∨ (a = Z_AF) ∨ (a = Z_ZF) ∨ (a = Z_SF) ∨
+           (a = Z_OF)
+
+   [Zimm_rm_11]  Theorem
+
+      |- (∀a a'. (Zimm a = Zimm a') ⇔ (a = a')) ∧
+         ∀a a'. (Zrm a = Zrm a') ⇔ (a = a')
+
+   [Zimm_rm_Axiom]  Theorem
+
+      |- ∀f0 f1. ∃fn. (∀a. fn (Zimm a) = f0 a) ∧ ∀a. fn (Zrm a) = f1 a
+
+   [Zimm_rm_case_cong]  Theorem
+
+      |- ∀M M' f f1.
+           (M = M') ∧ (∀a. (M' = Zimm a) ⇒ (f a = f' a)) ∧
+           (∀a. (M' = Zrm a) ⇒ (f1 a = f1' a)) ⇒
+           (Zimm_rm_CASE M f f1 = Zimm_rm_CASE M' f' f1')
+
+   [Zimm_rm_distinct]  Theorem
+
+      |- ∀a' a. Zimm a ≠ Zrm a'
+
+   [Zimm_rm_induction]  Theorem
+
+      |- ∀P. (∀c. P (Zimm c)) ∧ (∀Z. P (Zrm Z)) ⇒ ∀Z. P Z
+
+   [Zimm_rm_nchotomy]  Theorem
+
+      |- ∀ZZ. (∃c. ZZ = Zimm c) ∨ ∃Z. ZZ = Zrm Z
+
+   [Zinst_11]  Theorem
+
+      |- (∀a a'. (Zdec_fail a = Zdec_fail a') ⇔ (a = a')) ∧
+         ∀a a'. (Zfull_inst a = Zfull_inst a') ⇔ (a = a')
+
+   [Zinst_Axiom]  Theorem
+
+      |- ∀f0 f1.
+           ∃fn.
+             (∀a. fn (Zdec_fail a) = f0 a) ∧ ∀a. fn (Zfull_inst a) = f1 a
+
+   [Zinst_case_cong]  Theorem
+
+      |- ∀M M' f f1.
+           (M = M') ∧ (∀a. (M' = Zdec_fail a) ⇒ (f a = f' a)) ∧
+           (∀a. (M' = Zfull_inst a) ⇒ (f1 a = f1' a)) ⇒
+           (Zinst_CASE M f f1 = Zinst_CASE M' f' f1')
+
+   [Zinst_distinct]  Theorem
+
+      |- ∀a' a. Zdec_fail a ≠ Zfull_inst a'
+
+   [Zinst_induction]  Theorem
+
+      |- ∀P. (∀s. P (Zdec_fail s)) ∧ (∀p. P (Zfull_inst p)) ⇒ ∀Z. P Z
+
+   [Zinst_nchotomy]  Theorem
+
+      |- ∀ZZ. (∃s. ZZ = Zdec_fail s) ∨ ∃p. ZZ = Zfull_inst p
+
+   [Zmonop_name2num_11]  Theorem
+
+      |- ∀a a'. (Zmonop_name2num a = Zmonop_name2num a') ⇔ (a = a')
+
+   [Zmonop_name2num_ONTO]  Theorem
+
+      |- ∀r. r < 4 ⇔ ∃a. r = Zmonop_name2num a
+
+   [Zmonop_name2num_num2Zmonop_name]  Theorem
+
+      |- ∀r. r < 4 ⇔ (Zmonop_name2num (num2Zmonop_name r) = r)
+
+   [Zmonop_name2num_thm]  Theorem
+
+      |- (Zmonop_name2num Zdec = 0) ∧ (Zmonop_name2num Zinc = 1) ∧
+         (Zmonop_name2num Znot = 2) ∧ (Zmonop_name2num Zneg = 3)
+
+   [Zmonop_name_Axiom]  Theorem
+
+      |- ∀x0 x1 x2 x3.
+           ∃f.
+             (f Zdec = x0) ∧ (f Zinc = x1) ∧ (f Znot = x2) ∧ (f Zneg = x3)
+
+   [Zmonop_name_EQ_Zmonop_name]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (Zmonop_name2num a = Zmonop_name2num a')
+
+   [Zmonop_name_case_cong]  Theorem
+
+      |- ∀M M' v0 v1 v2 v3.
+           (M = M') ∧ ((M' = Zdec) ⇒ (v0 = v0')) ∧
+           ((M' = Zinc) ⇒ (v1 = v1')) ∧ ((M' = Znot) ⇒ (v2 = v2')) ∧
+           ((M' = Zneg) ⇒ (v3 = v3')) ⇒
+           ((case M of Zdec => v0 | Zinc => v1 | Znot => v2 | Zneg => v3) =
+            case M' of
+              Zdec => v0'
+            | Zinc => v1'
+            | Znot => v2'
+            | Zneg => v3')
+
+   [Zmonop_name_case_def]  Theorem
+
+      |- (∀v0 v1 v2 v3.
+            (case Zdec of
+               Zdec => v0
+             | Zinc => v1
+             | Znot => v2
+             | Zneg => v3) =
+            v0) ∧
+         (∀v0 v1 v2 v3.
+            (case Zinc of
+               Zdec => v0
+             | Zinc => v1
+             | Znot => v2
+             | Zneg => v3) =
+            v1) ∧
+         (∀v0 v1 v2 v3.
+            (case Znot of
+               Zdec => v0
+             | Zinc => v1
+             | Znot => v2
+             | Zneg => v3) =
+            v2) ∧
+         ∀v0 v1 v2 v3.
+           (case Zneg of
+              Zdec => v0
+            | Zinc => v1
+            | Znot => v2
+            | Zneg => v3) =
+           v3
+
+   [Zmonop_name_distinct]  Theorem
+
+      |- Zdec ≠ Zinc ∧ Zdec ≠ Znot ∧ Zdec ≠ Zneg ∧ Zinc ≠ Znot ∧
+         Zinc ≠ Zneg ∧ Znot ≠ Zneg
+
+   [Zmonop_name_induction]  Theorem
+
+      |- ∀P. P Zdec ∧ P Zinc ∧ P Zneg ∧ P Znot ⇒ ∀a. P a
+
+   [Zmonop_name_nchotomy]  Theorem
+
+      |- ∀a. (a = Zdec) ∨ (a = Zinc) ∨ (a = Znot) ∨ (a = Zneg)
+
+   [Zreg2num_11]  Theorem
+
+      |- ∀a a'. (Zreg2num a = Zreg2num a') ⇔ (a = a')
+
+   [Zreg2num_ONTO]  Theorem
+
+      |- ∀r. r < 16 ⇔ ∃a. r = Zreg2num a
+
+   [Zreg2num_num2Zreg]  Theorem
+
+      |- ∀r. r < 16 ⇔ (Zreg2num (num2Zreg r) = r)
+
+   [Zreg2num_thm]  Theorem
+
+      |- (Zreg2num RAX = 0) ∧ (Zreg2num RCX = 1) ∧ (Zreg2num RDX = 2) ∧
+         (Zreg2num RBX = 3) ∧ (Zreg2num RSP = 4) ∧ (Zreg2num RBP = 5) ∧
+         (Zreg2num RSI = 6) ∧ (Zreg2num RDI = 7) ∧ (Zreg2num zR8 = 8) ∧
+         (Zreg2num zR9 = 9) ∧ (Zreg2num zR10 = 10) ∧ (Zreg2num zR11 = 11) ∧
+         (Zreg2num zR12 = 12) ∧ (Zreg2num zR13 = 13) ∧
+         (Zreg2num zR14 = 14) ∧ (Zreg2num zR15 = 15)
+
+   [Zreg_Axiom]  Theorem
+
+      |- ∀x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15.
+           ∃f.
+             (f RAX = x0) ∧ (f RCX = x1) ∧ (f RDX = x2) ∧ (f RBX = x3) ∧
+             (f RSP = x4) ∧ (f RBP = x5) ∧ (f RSI = x6) ∧ (f RDI = x7) ∧
+             (f zR8 = x8) ∧ (f zR9 = x9) ∧ (f zR10 = x10) ∧
+             (f zR11 = x11) ∧ (f zR12 = x12) ∧ (f zR13 = x13) ∧
+             (f zR14 = x14) ∧ (f zR15 = x15)
+
+   [Zreg_EQ_Zreg]  Theorem
+
+      |- ∀a a'. (a = a') ⇔ (Zreg2num a = Zreg2num a')
+
+   [Zreg_case_cong]  Theorem
+
+      |- ∀M M' v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+           (M = M') ∧ ((M' = RAX) ⇒ (v0 = v0')) ∧
+           ((M' = RCX) ⇒ (v1 = v1')) ∧ ((M' = RDX) ⇒ (v2 = v2')) ∧
+           ((M' = RBX) ⇒ (v3 = v3')) ∧ ((M' = RSP) ⇒ (v4 = v4')) ∧
+           ((M' = RBP) ⇒ (v5 = v5')) ∧ ((M' = RSI) ⇒ (v6 = v6')) ∧
+           ((M' = RDI) ⇒ (v7 = v7')) ∧ ((M' = zR8) ⇒ (v8 = v8')) ∧
+           ((M' = zR9) ⇒ (v9 = v9')) ∧ ((M' = zR10) ⇒ (v10 = v10')) ∧
+           ((M' = zR11) ⇒ (v11 = v11')) ∧ ((M' = zR12) ⇒ (v12 = v12')) ∧
+           ((M' = zR13) ⇒ (v13 = v13')) ∧ ((M' = zR14) ⇒ (v14 = v14')) ∧
+           ((M' = zR15) ⇒ (v15 = v15')) ⇒
+           ((case M of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            case M' of
+              RAX => v0'
+            | RCX => v1'
+            | RDX => v2'
+            | RBX => v3'
+            | RSP => v4'
+            | RBP => v5'
+            | RSI => v6'
+            | RDI => v7'
+            | zR8 => v8'
+            | zR9 => v9'
+            | zR10 => v10'
+            | zR11 => v11'
+            | zR12 => v12'
+            | zR13 => v13'
+            | zR14 => v14'
+            | zR15 => v15')
+
+   [Zreg_case_def]  Theorem
+
+      |- (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case RAX of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v0) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case RCX of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v1) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case RDX of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v2) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case RBX of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v3) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case RSP of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v4) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case RBP of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v5) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case RSI of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v6) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case RDI of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v7) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case zR8 of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v8) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case zR9 of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v9) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case zR10 of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v10) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case zR11 of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v11) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case zR12 of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v12) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case zR13 of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v13) ∧
+         (∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+            (case zR14 of
+               RAX => v0
+             | RCX => v1
+             | RDX => v2
+             | RBX => v3
+             | RSP => v4
+             | RBP => v5
+             | RSI => v6
+             | RDI => v7
+             | zR8 => v8
+             | zR9 => v9
+             | zR10 => v10
+             | zR11 => v11
+             | zR12 => v12
+             | zR13 => v13
+             | zR14 => v14
+             | zR15 => v15) =
+            v14) ∧
+         ∀v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15.
+           (case zR15 of
+              RAX => v0
+            | RCX => v1
+            | RDX => v2
+            | RBX => v3
+            | RSP => v4
+            | RBP => v5
+            | RSI => v6
+            | RDI => v7
+            | zR8 => v8
+            | zR9 => v9
+            | zR10 => v10
+            | zR11 => v11
+            | zR12 => v12
+            | zR13 => v13
+            | zR14 => v14
+            | zR15 => v15) =
+           v15
+
+   [Zreg_induction]  Theorem
+
+      |- ∀P.
+           P RAX ∧ P RBP ∧ P RBX ∧ P RCX ∧ P RDI ∧ P RDX ∧ P RSI ∧ P RSP ∧
+           P zR10 ∧ P zR11 ∧ P zR12 ∧ P zR13 ∧ P zR14 ∧ P zR15 ∧ P zR8 ∧
+           P zR9 ⇒
+           ∀a. P a
+
+   [Zreg_nchotomy]  Theorem
+
+      |- ∀a.
+           (a = RAX) ∨ (a = RCX) ∨ (a = RDX) ∨ (a = RBX) ∨ (a = RSP) ∨
+           (a = RBP) ∨ (a = RSI) ∨ (a = RDI) ∨ (a = zR8) ∨ (a = zR9) ∨
+           (a = zR10) ∨ (a = zR11) ∨ (a = zR12) ∨ (a = zR13) ∨ (a = zR14) ∨
+           (a = zR15)
+
+   [Zrm_11]  Theorem
+
+      |- (∀a a'. (Zm a = Zm a') ⇔ (a = a')) ∧
+         ∀a a'. (Zr a = Zr a') ⇔ (a = a')
+
+   [Zrm_Axiom]  Theorem
+
+      |- ∀f0 f1. ∃fn. (∀a. fn (Zm a) = f0 a) ∧ ∀a. fn (Zr a) = f1 a
+
+   [Zrm_case_cong]  Theorem
+
+      |- ∀M M' f f1.
+           (M = M') ∧ (∀a. (M' = Zm a) ⇒ (f a = f' a)) ∧
+           (∀a. (M' = Zr a) ⇒ (f1 a = f1' a)) ⇒
+           (Zrm_CASE M f f1 = Zrm_CASE M' f' f1')
+
+   [Zrm_distinct]  Theorem
+
+      |- ∀a' a. Zm a ≠ Zr a'
+
+   [Zrm_induction]  Theorem
+
+      |- ∀P. (∀p. P (Zm p)) ∧ (∀Z. P (Zr Z)) ⇒ ∀Z. P Z
+
+   [Zrm_nchotomy]  Theorem
+
+      |- ∀ZZ. (∃p. ZZ = Zm p) ∨ ∃Z. ZZ = Zr Z
+
+   [Zsize_11]  Theorem
+
+      |- ∀a a'. (Z8 a = Z8 a') ⇔ (a ⇔ a')
+
+   [Zsize_Axiom]  Theorem
+
+      |- ∀f0 f1 f2 f3.
+           ∃fn.
+             (fn Z16 = f0) ∧ (fn Z32 = f1) ∧ (fn Z64 = f2) ∧
+             ∀a. fn (Z8 a) = f3 a
+
+   [Zsize_case_cong]  Theorem
+
+      |- ∀M M' v v1 v2 f.
+           (M = M') ∧ ((M' = Z16) ⇒ (v = v')) ∧ ((M' = Z32) ⇒ (v1 = v1')) ∧
+           ((M' = Z64) ⇒ (v2 = v2')) ∧ (∀a. (M' = Z8 a) ⇒ (f a = f' a)) ⇒
+           (Zsize_CASE M v v1 v2 f = Zsize_CASE M' v' v1' v2' f')
+
+   [Zsize_distinct]  Theorem
+
+      |- Z16 ≠ Z32 ∧ Z16 ≠ Z64 ∧ (∀a. Z16 ≠ Z8 a) ∧ Z32 ≠ Z64 ∧
+         (∀a. Z32 ≠ Z8 a) ∧ ∀a. Z64 ≠ Z8 a
+
+   [Zsize_induction]  Theorem
+
+      |- ∀P. P Z16 ∧ P Z32 ∧ P Z64 ∧ (∀b. P (Z8 b)) ⇒ ∀Z. P Z
+
+   [Zsize_nchotomy]  Theorem
+
+      |- ∀ZZ. (ZZ = Z16) ∨ (ZZ = Z32) ∨ (ZZ = Z64) ∨ ∃b. ZZ = Z8 b
+
+   [bitify8boolify8]  Theorem
+
+      |- ∀w. bitify8 (boolify8 w) = w
+
+   [boolify8_n2w]  Theorem
+
+      |- ∀n.
+           boolify8 (n2w n) =
+           (let n1 = DIV2 n in
+            let n2 = DIV2 n1 in
+            let n3 = DIV2 n2 in
+            let n4 = DIV2 n3 in
+            let n5 = DIV2 n4 in
+            let n6 = DIV2 n5 in
+            let n7 = DIV2 n6
+            in
+              (ODD n7,ODD n6,ODD n5,ODD n4,ODD n3,ODD n2,ODD n1,ODD n))
+
+   [boolify8_v2w]  Theorem
+
+      |- ∀b7 b6 b5 b4 b3 b2 b1 b0.
+           boolify8 (v2w [b7; b6; b5; b4; b3; b2; b1; b0]) =
+           (b7,b6,b5,b4,b3,b2,b1,b0)
+
+   [boolify8bitify8]  Theorem
+
+      |- ∀x. boolify8 (bitify8 x) = x
+
+   [datatype_REX]  Theorem
+
+      |- DATATYPE (record REX B R W X)
+
+   [datatype_Zbase]  Theorem
+
+      |- DATATYPE (Zbase ZnoBase ZregBase ZripBase)
+
+   [datatype_Zbinop_name]  Theorem
+
+      |- DATATYPE
+           (Zbinop_name Zadd Zor Zadc Zsbb Zand Zsub Zxor Zcmp Zrol Zror
+              Zrcl Zrcr Zshl Zshr Ztest Zsar)
+
+   [datatype_Zcond]  Theorem
+
+      |- DATATYPE
+           (Zcond Z_O Z_NO Z_B Z_NB Z_E Z_NE Z_NA Z_A Z_S Z_NS Z_P Z_NP Z_L
+              Z_NL Z_NG Z_G Z_ALWAYS)
+
+   [datatype_Zdest_src]  Theorem
+
+      |- DATATYPE (Zdest_src Zr_rm Zrm_i Zrm_r)
+
+   [datatype_Zea]  Theorem
+
+      |- DATATYPE (Zea Zea_i Zea_m Zea_r)
+
+   [datatype_Zeflags]  Theorem
+
+      |- DATATYPE (Zeflags Z_CF Z_PF Z_AF Z_ZF Z_SF Z_OF)
+
+   [datatype_Zimm_rm]  Theorem
+
+      |- DATATYPE (Zimm_rm Zimm Zrm)
+
+   [datatype_Zinst]  Theorem
+
+      |- DATATYPE (Zinst Zdec_fail Zfull_inst)
+
+   [datatype_Zmonop_name]  Theorem
+
+      |- DATATYPE (Zmonop_name Zdec Zinc Znot Zneg)
+
+   [datatype_Zreg]  Theorem
+
+      |- DATATYPE
+           (Zreg RAX RCX RDX RBX RSP RBP RSI RDI zR8 zR9 zR10 zR11 zR12
+              zR13 zR14 zR15)
+
+   [datatype_Zrm]  Theorem
+
+      |- DATATYPE (Zrm Zm Zr)
+
+   [datatype_Zsize]  Theorem
+
+      |- DATATYPE (Zsize Z16 Z32 Z64 Z8)
+
+   [datatype_exception]  Theorem
+
+      |- DATATYPE (exception BadFlagAccess BadMemAccess FAIL NoException)
+
+   [datatype_instruction]  Theorem
+
+      |- DATATYPE
+           (instruction Zbinop Zcall Zcmpxchg Zcpuid Zdiv Zjcc Zjmp Zlea
+              Zloop Zmonop Zmov Zmovzx Zmul Znop Zpop Zpush Zret Zxadd
+              Zxchg)
+
+   [datatype_x64_state]  Theorem
+
+      |- DATATYPE (record x64_state EFLAGS ICACHE MEM REG RIP exception)
+
+   [exception_11]  Theorem
+
+      |- (∀a a'. (BadFlagAccess a = BadFlagAccess a') ⇔ (a = a')) ∧
+         (∀a a'. (BadMemAccess a = BadMemAccess a') ⇔ (a = a')) ∧
+         ∀a a'. (FAIL a = FAIL a') ⇔ (a = a')
+
+   [exception_Axiom]  Theorem
+
+      |- ∀f0 f1 f2 f3.
+           ∃fn.
+             (∀a. fn (BadFlagAccess a) = f0 a) ∧
+             (∀a. fn (BadMemAccess a) = f1 a) ∧ (∀a. fn (FAIL a) = f2 a) ∧
+             (fn NoException = f3)
+
+   [exception_case_cong]  Theorem
+
+      |- ∀M M' f f1 f2 v.
+           (M = M') ∧ (∀a. (M' = BadFlagAccess a) ⇒ (f a = f' a)) ∧
+           (∀a. (M' = BadMemAccess a) ⇒ (f1 a = f1' a)) ∧
+           (∀a. (M' = FAIL a) ⇒ (f2 a = f2' a)) ∧
+           ((M' = NoException) ⇒ (v = v')) ⇒
+           (exception_CASE M f f1 f2 v = exception_CASE M' f' f1' f2' v')
+
+   [exception_distinct]  Theorem
+
+      |- (∀a' a. BadFlagAccess a ≠ BadMemAccess a') ∧
+         (∀a' a. BadFlagAccess a ≠ FAIL a') ∧
+         (∀a. BadFlagAccess a ≠ NoException) ∧
+         (∀a' a. BadMemAccess a ≠ FAIL a') ∧
+         (∀a. BadMemAccess a ≠ NoException) ∧ ∀a. FAIL a ≠ NoException
+
+   [exception_induction]  Theorem
+
+      |- ∀P.
+           (∀s. P (BadFlagAccess s)) ∧ (∀c. P (BadMemAccess c)) ∧
+           (∀s. P (FAIL s)) ∧ P NoException ⇒
+           ∀e. P e
+
+   [exception_nchotomy]  Theorem
+
+      |- ∀ee.
+           (∃s. ee = BadFlagAccess s) ∨ (∃c. ee = BadMemAccess c) ∨
+           (∃s. ee = FAIL s) ∨ (ee = NoException)
+
+   [instruction_11]  Theorem
+
+      |- (∀a a'. (Zbinop a = Zbinop a') ⇔ (a = a')) ∧
+         (∀a a'. (Zcall a = Zcall a') ⇔ (a = a')) ∧
+         (∀a a'. (Zcmpxchg a = Zcmpxchg a') ⇔ (a = a')) ∧
+         (∀a a'. (Zdiv a = Zdiv a') ⇔ (a = a')) ∧
+         (∀a a'. (Zjcc a = Zjcc a') ⇔ (a = a')) ∧
+         (∀a a'. (Zjmp a = Zjmp a') ⇔ (a = a')) ∧
+         (∀a a'. (Zlea a = Zlea a') ⇔ (a = a')) ∧
+         (∀a a'. (Zloop a = Zloop a') ⇔ (a = a')) ∧
+         (∀a a'. (Zmonop a = Zmonop a') ⇔ (a = a')) ∧
+         (∀a a'. (Zmov a = Zmov a') ⇔ (a = a')) ∧
+         (∀a a'. (Zmovzx a = Zmovzx a') ⇔ (a = a')) ∧
+         (∀a a'. (Zmul a = Zmul a') ⇔ (a = a')) ∧
+         (∀a a'. (Zpop a = Zpop a') ⇔ (a = a')) ∧
+         (∀a a'. (Zpush a = Zpush a') ⇔ (a = a')) ∧
+         (∀a a'. (Zret a = Zret a') ⇔ (a = a')) ∧
+         (∀a a'. (Zxadd a = Zxadd a') ⇔ (a = a')) ∧
+         ∀a a'. (Zxchg a = Zxchg a') ⇔ (a = a')
+
+   [instruction_Axiom]  Theorem
+
+      |- ∀f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17
+            f18.
+           ∃fn.
+             (∀a. fn (Zbinop a) = f0 a) ∧ (∀a. fn (Zcall a) = f1 a) ∧
+             (∀a. fn (Zcmpxchg a) = f2 a) ∧ (fn Zcpuid = f3) ∧
+             (∀a. fn (Zdiv a) = f4 a) ∧ (∀a. fn (Zjcc a) = f5 a) ∧
+             (∀a. fn (Zjmp a) = f6 a) ∧ (∀a. fn (Zlea a) = f7 a) ∧
+             (∀a. fn (Zloop a) = f8 a) ∧ (∀a. fn (Zmonop a) = f9 a) ∧
+             (∀a. fn (Zmov a) = f10 a) ∧ (∀a. fn (Zmovzx a) = f11 a) ∧
+             (∀a. fn (Zmul a) = f12 a) ∧ (fn Znop = f13) ∧
+             (∀a. fn (Zpop a) = f14 a) ∧ (∀a. fn (Zpush a) = f15 a) ∧
+             (∀a. fn (Zret a) = f16 a) ∧ (∀a. fn (Zxadd a) = f17 a) ∧
+             ∀a. fn (Zxchg a) = f18 a
+
+   [instruction_case_cong]  Theorem
+
+      |- ∀M M' f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 f12 f13 f14 f15
+            f16.
+           (M = M') ∧ (∀a. (M' = Zbinop a) ⇒ (f a = f' a)) ∧
+           (∀a. (M' = Zcall a) ⇒ (f1 a = f1' a)) ∧
+           (∀a. (M' = Zcmpxchg a) ⇒ (f2 a = f2' a)) ∧
+           ((M' = Zcpuid) ⇒ (v = v')) ∧
+           (∀a. (M' = Zdiv a) ⇒ (f3 a = f3' a)) ∧
+           (∀a. (M' = Zjcc a) ⇒ (f4 a = f4' a)) ∧
+           (∀a. (M' = Zjmp a) ⇒ (f5 a = f5' a)) ∧
+           (∀a. (M' = Zlea a) ⇒ (f6 a = f6' a)) ∧
+           (∀a. (M' = Zloop a) ⇒ (f7 a = f7' a)) ∧
+           (∀a. (M' = Zmonop a) ⇒ (f8 a = f8' a)) ∧
+           (∀a. (M' = Zmov a) ⇒ (f9 a = f9' a)) ∧
+           (∀a. (M' = Zmovzx a) ⇒ (f10 a = f10' a)) ∧
+           (∀a. (M' = Zmul a) ⇒ (f11 a = f11' a)) ∧
+           ((M' = Znop) ⇒ (v1 = v1')) ∧
+           (∀a. (M' = Zpop a) ⇒ (f12 a = f12' a)) ∧
+           (∀a. (M' = Zpush a) ⇒ (f13 a = f13' a)) ∧
+           (∀a. (M' = Zret a) ⇒ (f14 a = f14' a)) ∧
+           (∀a. (M' = Zxadd a) ⇒ (f15 a = f15' a)) ∧
+           (∀a. (M' = Zxchg a) ⇒ (f16 a = f16' a)) ⇒
+           (instruction_CASE M f f1 f2 v f3 f4 f5 f6 f7 f8 f9 f10 f11 v1
+              f12 f13 f14 f15 f16 =
+            instruction_CASE M' f' f1' f2' v' f3' f4' f5' f6' f7' f8' f9'
+              f10' f11' v1' f12' f13' f14' f15' f16')
+
+   [instruction_distinct]  Theorem
+
+      |- (∀a' a. Zbinop a ≠ Zcall a') ∧ (∀a' a. Zbinop a ≠ Zcmpxchg a') ∧
+         (∀a. Zbinop a ≠ Zcpuid) ∧ (∀a' a. Zbinop a ≠ Zdiv a') ∧
+         (∀a' a. Zbinop a ≠ Zjcc a') ∧ (∀a' a. Zbinop a ≠ Zjmp a') ∧
+         (∀a' a. Zbinop a ≠ Zlea a') ∧ (∀a' a. Zbinop a ≠ Zloop a') ∧
+         (∀a' a. Zbinop a ≠ Zmonop a') ∧ (∀a' a. Zbinop a ≠ Zmov a') ∧
+         (∀a' a. Zbinop a ≠ Zmovzx a') ∧ (∀a' a. Zbinop a ≠ Zmul a') ∧
+         (∀a. Zbinop a ≠ Znop) ∧ (∀a' a. Zbinop a ≠ Zpop a') ∧
+         (∀a' a. Zbinop a ≠ Zpush a') ∧ (∀a' a. Zbinop a ≠ Zret a') ∧
+         (∀a' a. Zbinop a ≠ Zxadd a') ∧ (∀a' a. Zbinop a ≠ Zxchg a') ∧
+         (∀a' a. Zcall a ≠ Zcmpxchg a') ∧ (∀a. Zcall a ≠ Zcpuid) ∧
+         (∀a' a. Zcall a ≠ Zdiv a') ∧ (∀a' a. Zcall a ≠ Zjcc a') ∧
+         (∀a' a. Zcall a ≠ Zjmp a') ∧ (∀a' a. Zcall a ≠ Zlea a') ∧
+         (∀a' a. Zcall a ≠ Zloop a') ∧ (∀a' a. Zcall a ≠ Zmonop a') ∧
+         (∀a' a. Zcall a ≠ Zmov a') ∧ (∀a' a. Zcall a ≠ Zmovzx a') ∧
+         (∀a' a. Zcall a ≠ Zmul a') ∧ (∀a. Zcall a ≠ Znop) ∧
+         (∀a' a. Zcall a ≠ Zpop a') ∧ (∀a' a. Zcall a ≠ Zpush a') ∧
+         (∀a' a. Zcall a ≠ Zret a') ∧ (∀a' a. Zcall a ≠ Zxadd a') ∧
+         (∀a' a. Zcall a ≠ Zxchg a') ∧ (∀a. Zcmpxchg a ≠ Zcpuid) ∧
+         (∀a' a. Zcmpxchg a ≠ Zdiv a') ∧ (∀a' a. Zcmpxchg a ≠ Zjcc a') ∧
+         (∀a' a. Zcmpxchg a ≠ Zjmp a') ∧ (∀a' a. Zcmpxchg a ≠ Zlea a') ∧
+         (∀a' a. Zcmpxchg a ≠ Zloop a') ∧ (∀a' a. Zcmpxchg a ≠ Zmonop a') ∧
+         (∀a' a. Zcmpxchg a ≠ Zmov a') ∧ (∀a' a. Zcmpxchg a ≠ Zmovzx a') ∧
+         (∀a' a. Zcmpxchg a ≠ Zmul a') ∧ (∀a. Zcmpxchg a ≠ Znop) ∧
+         (∀a' a. Zcmpxchg a ≠ Zpop a') ∧ (∀a' a. Zcmpxchg a ≠ Zpush a') ∧
+         (∀a' a. Zcmpxchg a ≠ Zret a') ∧ (∀a' a. Zcmpxchg a ≠ Zxadd a') ∧
+         (∀a' a. Zcmpxchg a ≠ Zxchg a') ∧ (∀a. Zcpuid ≠ Zdiv a) ∧
+         (∀a. Zcpuid ≠ Zjcc a) ∧ (∀a. Zcpuid ≠ Zjmp a) ∧
+         (∀a. Zcpuid ≠ Zlea a) ∧ (∀a. Zcpuid ≠ Zloop a) ∧
+         (∀a. Zcpuid ≠ Zmonop a) ∧ (∀a. Zcpuid ≠ Zmov a) ∧
+         (∀a. Zcpuid ≠ Zmovzx a) ∧ (∀a. Zcpuid ≠ Zmul a) ∧ Zcpuid ≠ Znop ∧
+         (∀a. Zcpuid ≠ Zpop a) ∧ (∀a. Zcpuid ≠ Zpush a) ∧
+         (∀a. Zcpuid ≠ Zret a) ∧ (∀a. Zcpuid ≠ Zxadd a) ∧
+         (∀a. Zcpuid ≠ Zxchg a) ∧ (∀a' a. Zdiv a ≠ Zjcc a') ∧
+         (∀a' a. Zdiv a ≠ Zjmp a') ∧ (∀a' a. Zdiv a ≠ Zlea a') ∧
+         (∀a' a. Zdiv a ≠ Zloop a') ∧ (∀a' a. Zdiv a ≠ Zmonop a') ∧
+         (∀a' a. Zdiv a ≠ Zmov a') ∧ (∀a' a. Zdiv a ≠ Zmovzx a') ∧
+         (∀a' a. Zdiv a ≠ Zmul a') ∧ (∀a. Zdiv a ≠ Znop) ∧
+         (∀a' a. Zdiv a ≠ Zpop a') ∧ (∀a' a. Zdiv a ≠ Zpush a') ∧
+         (∀a' a. Zdiv a ≠ Zret a') ∧ (∀a' a. Zdiv a ≠ Zxadd a') ∧
+         (∀a' a. Zdiv a ≠ Zxchg a') ∧ (∀a' a. Zjcc a ≠ Zjmp a') ∧
+         (∀a' a. Zjcc a ≠ Zlea a') ∧ (∀a' a. Zjcc a ≠ Zloop a') ∧
+         (∀a' a. Zjcc a ≠ Zmonop a') ∧ (∀a' a. Zjcc a ≠ Zmov a') ∧
+         (∀a' a. Zjcc a ≠ Zmovzx a') ∧ (∀a' a. Zjcc a ≠ Zmul a') ∧
+         (∀a. Zjcc a ≠ Znop) ∧ (∀a' a. Zjcc a ≠ Zpop a') ∧
+         (∀a' a. Zjcc a ≠ Zpush a') ∧ (∀a' a. Zjcc a ≠ Zret a') ∧
+         (∀a' a. Zjcc a ≠ Zxadd a') ∧ (∀a' a. Zjcc a ≠ Zxchg a') ∧
+         (∀a' a. Zjmp a ≠ Zlea a') ∧ (∀a' a. Zjmp a ≠ Zloop a') ∧
+         (∀a' a. Zjmp a ≠ Zmonop a') ∧ (∀a' a. Zjmp a ≠ Zmov a') ∧
+         (∀a' a. Zjmp a ≠ Zmovzx a') ∧ (∀a' a. Zjmp a ≠ Zmul a') ∧
+         (∀a. Zjmp a ≠ Znop) ∧ (∀a' a. Zjmp a ≠ Zpop a') ∧
+         (∀a' a. Zjmp a ≠ Zpush a') ∧ (∀a' a. Zjmp a ≠ Zret a') ∧
+         (∀a' a. Zjmp a ≠ Zxadd a') ∧ (∀a' a. Zjmp a ≠ Zxchg a') ∧
+         (∀a' a. Zlea a ≠ Zloop a') ∧ (∀a' a. Zlea a ≠ Zmonop a') ∧
+         (∀a' a. Zlea a ≠ Zmov a') ∧ (∀a' a. Zlea a ≠ Zmovzx a') ∧
+         (∀a' a. Zlea a ≠ Zmul a') ∧ (∀a. Zlea a ≠ Znop) ∧
+         (∀a' a. Zlea a ≠ Zpop a') ∧ (∀a' a. Zlea a ≠ Zpush a') ∧
+         (∀a' a. Zlea a ≠ Zret a') ∧ (∀a' a. Zlea a ≠ Zxadd a') ∧
+         (∀a' a. Zlea a ≠ Zxchg a') ∧ (∀a' a. Zloop a ≠ Zmonop a') ∧
+         (∀a' a. Zloop a ≠ Zmov a') ∧ (∀a' a. Zloop a ≠ Zmovzx a') ∧
+         (∀a' a. Zloop a ≠ Zmul a') ∧ (∀a. Zloop a ≠ Znop) ∧
+         (∀a' a. Zloop a ≠ Zpop a') ∧ (∀a' a. Zloop a ≠ Zpush a') ∧
+         (∀a' a. Zloop a ≠ Zret a') ∧ (∀a' a. Zloop a ≠ Zxadd a') ∧
+         (∀a' a. Zloop a ≠ Zxchg a') ∧ (∀a' a. Zmonop a ≠ Zmov a') ∧
+         (∀a' a. Zmonop a ≠ Zmovzx a') ∧ (∀a' a. Zmonop a ≠ Zmul a') ∧
+         (∀a. Zmonop a ≠ Znop) ∧ (∀a' a. Zmonop a ≠ Zpop a') ∧
+         (∀a' a. Zmonop a ≠ Zpush a') ∧ (∀a' a. Zmonop a ≠ Zret a') ∧
+         (∀a' a. Zmonop a ≠ Zxadd a') ∧ (∀a' a. Zmonop a ≠ Zxchg a') ∧
+         (∀a' a. Zmov a ≠ Zmovzx a') ∧ (∀a' a. Zmov a ≠ Zmul a') ∧
+         (∀a. Zmov a ≠ Znop) ∧ (∀a' a. Zmov a ≠ Zpop a') ∧
+         (∀a' a. Zmov a ≠ Zpush a') ∧ (∀a' a. Zmov a ≠ Zret a') ∧
+         (∀a' a. Zmov a ≠ Zxadd a') ∧ (∀a' a. Zmov a ≠ Zxchg a') ∧
+         (∀a' a. Zmovzx a ≠ Zmul a') ∧ (∀a. Zmovzx a ≠ Znop) ∧
+         (∀a' a. Zmovzx a ≠ Zpop a') ∧ (∀a' a. Zmovzx a ≠ Zpush a') ∧
+         (∀a' a. Zmovzx a ≠ Zret a') ∧ (∀a' a. Zmovzx a ≠ Zxadd a') ∧
+         (∀a' a. Zmovzx a ≠ Zxchg a') ∧ (∀a. Zmul a ≠ Znop) ∧
+         (∀a' a. Zmul a ≠ Zpop a') ∧ (∀a' a. Zmul a ≠ Zpush a') ∧
+         (∀a' a. Zmul a ≠ Zret a') ∧ (∀a' a. Zmul a ≠ Zxadd a') ∧
+         (∀a' a. Zmul a ≠ Zxchg a') ∧ (∀a. Znop ≠ Zpop a) ∧
+         (∀a. Znop ≠ Zpush a) ∧ (∀a. Znop ≠ Zret a) ∧
+         (∀a. Znop ≠ Zxadd a) ∧ (∀a. Znop ≠ Zxchg a) ∧
+         (∀a' a. Zpop a ≠ Zpush a') ∧ (∀a' a. Zpop a ≠ Zret a') ∧
+         (∀a' a. Zpop a ≠ Zxadd a') ∧ (∀a' a. Zpop a ≠ Zxchg a') ∧
+         (∀a' a. Zpush a ≠ Zret a') ∧ (∀a' a. Zpush a ≠ Zxadd a') ∧
+         (∀a' a. Zpush a ≠ Zxchg a') ∧ (∀a' a. Zret a ≠ Zxadd a') ∧
+         (∀a' a. Zret a ≠ Zxchg a') ∧ ∀a' a. Zxadd a ≠ Zxchg a'
+
+   [instruction_induction]  Theorem
+
+      |- ∀P.
+           (∀p. P (Zbinop p)) ∧ (∀Z. P (Zcall Z)) ∧ (∀p. P (Zcmpxchg p)) ∧
+           P Zcpuid ∧ (∀p. P (Zdiv p)) ∧ (∀p. P (Zjcc p)) ∧
+           (∀Z. P (Zjmp Z)) ∧ (∀p. P (Zlea p)) ∧ (∀p. P (Zloop p)) ∧
+           (∀p. P (Zmonop p)) ∧ (∀p. P (Zmov p)) ∧ (∀p. P (Zmovzx p)) ∧
+           (∀p. P (Zmul p)) ∧ P Znop ∧ (∀Z. P (Zpop Z)) ∧
+           (∀Z. P (Zpush Z)) ∧ (∀c. P (Zret c)) ∧ (∀p. P (Zxadd p)) ∧
+           (∀p. P (Zxchg p)) ⇒
+           ∀i. P i
+
+   [instruction_nchotomy]  Theorem
+
+      |- ∀ii.
+           (∃p. ii = Zbinop p) ∨ (∃Z. ii = Zcall Z) ∨
+           (∃p. ii = Zcmpxchg p) ∨ (ii = Zcpuid) ∨ (∃p. ii = Zdiv p) ∨
+           (∃p. ii = Zjcc p) ∨ (∃Z. ii = Zjmp Z) ∨ (∃p. ii = Zlea p) ∨
+           (∃p. ii = Zloop p) ∨ (∃p. ii = Zmonop p) ∨ (∃p. ii = Zmov p) ∨
+           (∃p. ii = Zmovzx p) ∨ (∃p. ii = Zmul p) ∨ (ii = Znop) ∨
+           (∃Z. ii = Zpop Z) ∨ (∃Z. ii = Zpush Z) ∨ (∃c. ii = Zret c) ∨
+           (∃p. ii = Zxadd p) ∨ ∃p. ii = Zxchg p
+
+   [num2Zbinop_name_11]  Theorem
+
+      |- ∀r r'.
+           r < 16 ⇒
+           r' < 16 ⇒
+           ((num2Zbinop_name r = num2Zbinop_name r') ⇔ (r = r'))
+
+   [num2Zbinop_name_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2Zbinop_name r) ∧ r < 16
+
+   [num2Zbinop_name_Zbinop_name2num]  Theorem
+
+      |- ∀a. num2Zbinop_name (Zbinop_name2num a) = a
+
+   [num2Zbinop_name_thm]  Theorem
+
+      |- (num2Zbinop_name 0 = Zadd) ∧ (num2Zbinop_name 1 = Zor) ∧
+         (num2Zbinop_name 2 = Zadc) ∧ (num2Zbinop_name 3 = Zsbb) ∧
+         (num2Zbinop_name 4 = Zand) ∧ (num2Zbinop_name 5 = Zsub) ∧
+         (num2Zbinop_name 6 = Zxor) ∧ (num2Zbinop_name 7 = Zcmp) ∧
+         (num2Zbinop_name 8 = Zrol) ∧ (num2Zbinop_name 9 = Zror) ∧
+         (num2Zbinop_name 10 = Zrcl) ∧ (num2Zbinop_name 11 = Zrcr) ∧
+         (num2Zbinop_name 12 = Zshl) ∧ (num2Zbinop_name 13 = Zshr) ∧
+         (num2Zbinop_name 14 = Ztest) ∧ (num2Zbinop_name 15 = Zsar)
+
+   [num2Zcond_11]  Theorem
+
+      |- ∀r r'.
+           r < 17 ⇒ r' < 17 ⇒ ((num2Zcond r = num2Zcond r') ⇔ (r = r'))
+
+   [num2Zcond_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2Zcond r) ∧ r < 17
+
+   [num2Zcond_Zcond2num]  Theorem
+
+      |- ∀a. num2Zcond (Zcond2num a) = a
+
+   [num2Zcond_thm]  Theorem
+
+      |- (num2Zcond 0 = Z_O) ∧ (num2Zcond 1 = Z_NO) ∧ (num2Zcond 2 = Z_B) ∧
+         (num2Zcond 3 = Z_NB) ∧ (num2Zcond 4 = Z_E) ∧
+         (num2Zcond 5 = Z_NE) ∧ (num2Zcond 6 = Z_NA) ∧
+         (num2Zcond 7 = Z_A) ∧ (num2Zcond 8 = Z_S) ∧ (num2Zcond 9 = Z_NS) ∧
+         (num2Zcond 10 = Z_P) ∧ (num2Zcond 11 = Z_NP) ∧
+         (num2Zcond 12 = Z_L) ∧ (num2Zcond 13 = Z_NL) ∧
+         (num2Zcond 14 = Z_NG) ∧ (num2Zcond 15 = Z_G) ∧
+         (num2Zcond 16 = Z_ALWAYS)
+
+   [num2Zeflags_11]  Theorem
+
+      |- ∀r r'.
+           r < 6 ⇒ r' < 6 ⇒ ((num2Zeflags r = num2Zeflags r') ⇔ (r = r'))
+
+   [num2Zeflags_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2Zeflags r) ∧ r < 6
+
+   [num2Zeflags_Zeflags2num]  Theorem
+
+      |- ∀a. num2Zeflags (Zeflags2num a) = a
+
+   [num2Zeflags_thm]  Theorem
+
+      |- (num2Zeflags 0 = Z_CF) ∧ (num2Zeflags 1 = Z_PF) ∧
+         (num2Zeflags 2 = Z_AF) ∧ (num2Zeflags 3 = Z_ZF) ∧
+         (num2Zeflags 4 = Z_SF) ∧ (num2Zeflags 5 = Z_OF)
+
+   [num2Zmonop_name_11]  Theorem
+
+      |- ∀r r'.
+           r < 4 ⇒
+           r' < 4 ⇒
+           ((num2Zmonop_name r = num2Zmonop_name r') ⇔ (r = r'))
+
+   [num2Zmonop_name_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2Zmonop_name r) ∧ r < 4
+
+   [num2Zmonop_name_Zmonop_name2num]  Theorem
+
+      |- ∀a. num2Zmonop_name (Zmonop_name2num a) = a
+
+   [num2Zmonop_name_thm]  Theorem
+
+      |- (num2Zmonop_name 0 = Zdec) ∧ (num2Zmonop_name 1 = Zinc) ∧
+         (num2Zmonop_name 2 = Znot) ∧ (num2Zmonop_name 3 = Zneg)
+
+   [num2Zreg_11]  Theorem
+
+      |- ∀r r'. r < 16 ⇒ r' < 16 ⇒ ((num2Zreg r = num2Zreg r') ⇔ (r = r'))
+
+   [num2Zreg_ONTO]  Theorem
+
+      |- ∀a. ∃r. (a = num2Zreg r) ∧ r < 16
+
+   [num2Zreg_Zreg2num]  Theorem
+
+      |- ∀a. num2Zreg (Zreg2num a) = a
+
+   [num2Zreg_thm]  Theorem
+
+      |- (num2Zreg 0 = RAX) ∧ (num2Zreg 1 = RCX) ∧ (num2Zreg 2 = RDX) ∧
+         (num2Zreg 3 = RBX) ∧ (num2Zreg 4 = RSP) ∧ (num2Zreg 5 = RBP) ∧
+         (num2Zreg 6 = RSI) ∧ (num2Zreg 7 = RDI) ∧ (num2Zreg 8 = zR8) ∧
+         (num2Zreg 9 = zR9) ∧ (num2Zreg 10 = zR10) ∧ (num2Zreg 11 = zR11) ∧
+         (num2Zreg 12 = zR12) ∧ (num2Zreg 13 = zR13) ∧
+         (num2Zreg 14 = zR14) ∧ (num2Zreg 15 = zR15)
+
+   [readPrefix_def]  Theorem
+
+      |- ∀strm s p.
+           readPrefix (s,p,strm) =
+           case strm of
+             [] => SOME (p,F,ARB,strm)
+           | h::strm1 =>
+               (let group = prefixGroup h
+                in
+                  if group = 0 then SOME (p,F,rec'REX 0w,strm)
+                  else if group = 5 then
+                    SOME (p,T,rec'REX ((3 >< 0) h),strm1)
+                  else if group ∈ s then NONE
+                  else readPrefix (group INSERT s,h::p,strm1))
+
+   [readPrefix_ind]  Theorem
+
+      |- ∀P.
+           (∀s p strm.
+              (∀h strm1 group.
+                 (strm = h::strm1) ∧ (group = prefixGroup h) ∧ group ≠ 0 ∧
+                 group ≠ 5 ∧ group ∉ s ⇒
+                 P (group INSERT s,h::p,strm1)) ⇒
+              P (s,p,strm)) ⇒
+           ∀v v1 v2. P (v,v1,v2)
+
+   [x64_state_11]  Theorem
+
+      |- ∀a0 a1 a2 a3 a4 a5 a0' a1' a2' a3' a4' a5'.
+           (x64_state a0 a1 a2 a3 a4 a5 =
+            x64_state a0' a1' a2' a3' a4' a5') ⇔
+           (a0 = a0') ∧ (a1 = a1') ∧ (a2 = a2') ∧ (a3 = a3') ∧ (a4 = a4') ∧
+           (a5 = a5')
+
+   [x64_state_Axiom]  Theorem
+
+      |- ∀f.
+           ∃fn.
+             ∀a0 a1 a2 a3 a4 a5.
+               fn (x64_state a0 a1 a2 a3 a4 a5) = f a0 a1 a2 a3 a4 a5
+
+   [x64_state_accessors]  Theorem
+
+      |- (∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).EFLAGS = f) ∧
+         (∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).ICACHE = f0) ∧
+         (∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).MEM = f1) ∧
+         (∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).REG = f2) ∧
+         (∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).RIP = c) ∧
+         ∀f f0 f1 f2 c e. (x64_state f f0 f1 f2 c e).exception = e
+
+   [x64_state_accfupds]  Theorem
+
+      |- (∀x f. (x with ICACHE updated_by f).EFLAGS = x.EFLAGS) ∧
+         (∀x f. (x with MEM updated_by f).EFLAGS = x.EFLAGS) ∧
+         (∀x f. (x with REG updated_by f).EFLAGS = x.EFLAGS) ∧
+         (∀x f. (x with RIP updated_by f).EFLAGS = x.EFLAGS) ∧
+         (∀x f. (x with exception updated_by f).EFLAGS = x.EFLAGS) ∧
+         (∀x f. (x with EFLAGS updated_by f).ICACHE = x.ICACHE) ∧
+         (∀x f. (x with MEM updated_by f).ICACHE = x.ICACHE) ∧
+         (∀x f. (x with REG updated_by f).ICACHE = x.ICACHE) ∧
+         (∀x f. (x with RIP updated_by f).ICACHE = x.ICACHE) ∧
+         (∀x f. (x with exception updated_by f).ICACHE = x.ICACHE) ∧
+         (∀x f. (x with EFLAGS updated_by f).MEM = x.MEM) ∧
+         (∀x f. (x with ICACHE updated_by f).MEM = x.MEM) ∧
+         (∀x f. (x with REG updated_by f).MEM = x.MEM) ∧
+         (∀x f. (x with RIP updated_by f).MEM = x.MEM) ∧
+         (∀x f. (x with exception updated_by f).MEM = x.MEM) ∧
+         (∀x f. (x with EFLAGS updated_by f).REG = x.REG) ∧
+         (∀x f. (x with ICACHE updated_by f).REG = x.REG) ∧
+         (∀x f. (x with MEM updated_by f).REG = x.REG) ∧
+         (∀x f. (x with RIP updated_by f).REG = x.REG) ∧
+         (∀x f. (x with exception updated_by f).REG = x.REG) ∧
+         (∀x f. (x with EFLAGS updated_by f).RIP = x.RIP) ∧
+         (∀x f. (x with ICACHE updated_by f).RIP = x.RIP) ∧
+         (∀x f. (x with MEM updated_by f).RIP = x.RIP) ∧
+         (∀x f. (x with REG updated_by f).RIP = x.RIP) ∧
+         (∀x f. (x with exception updated_by f).RIP = x.RIP) ∧
+         (∀x f. (x with EFLAGS updated_by f).exception = x.exception) ∧
+         (∀x f. (x with ICACHE updated_by f).exception = x.exception) ∧
+         (∀x f. (x with MEM updated_by f).exception = x.exception) ∧
+         (∀x f. (x with REG updated_by f).exception = x.exception) ∧
+         (∀x f. (x with RIP updated_by f).exception = x.exception) ∧
+         (∀x f. (x with EFLAGS updated_by f).EFLAGS = f x.EFLAGS) ∧
+         (∀x f. (x with ICACHE updated_by f).ICACHE = f x.ICACHE) ∧
+         (∀x f. (x with MEM updated_by f).MEM = f x.MEM) ∧
+         (∀x f. (x with REG updated_by f).REG = f x.REG) ∧
+         (∀x f. (x with RIP updated_by f).RIP = f x.RIP) ∧
+         ∀x f. (x with exception updated_by f).exception = f x.exception
+
+   [x64_state_case_cong]  Theorem
+
+      |- ∀M M' f.
+           (M = M') ∧
+           (∀a0 a1 a2 a3 a4 a5.
+              (M' = x64_state a0 a1 a2 a3 a4 a5) ⇒
+              (f a0 a1 a2 a3 a4 a5 = f' a0 a1 a2 a3 a4 a5)) ⇒
+           (x64_state_CASE M f = x64_state_CASE M' f')
+
+   [x64_state_component_equality]  Theorem
+
+      |- ∀x1 x2.
+           (x1 = x2) ⇔
+           (x1.EFLAGS = x2.EFLAGS) ∧ (x1.ICACHE = x2.ICACHE) ∧
+           (x1.MEM = x2.MEM) ∧ (x1.REG = x2.REG) ∧ (x1.RIP = x2.RIP) ∧
+           (x1.exception = x2.exception)
+
+   [x64_state_fn_updates]  Theorem
+
+      |- (∀f3 f f0 f1 f2 c e.
+            x64_state f f0 f1 f2 c e with EFLAGS updated_by f3 =
+            x64_state (f3 f) f0 f1 f2 c e) ∧
+         (∀f3 f f0 f1 f2 c e.
+            x64_state f f0 f1 f2 c e with ICACHE updated_by f3 =
+            x64_state f (f3 f0) f1 f2 c e) ∧
+         (∀f3 f f0 f1 f2 c e.
+            x64_state f f0 f1 f2 c e with MEM updated_by f3 =
+            x64_state f f0 (f3 f1) f2 c e) ∧
+         (∀f3 f f0 f1 f2 c e.
+            x64_state f f0 f1 f2 c e with REG updated_by f3 =
+            x64_state f f0 f1 (f3 f2) c e) ∧
+         (∀f3 f f0 f1 f2 c e.
+            x64_state f f0 f1 f2 c e with RIP updated_by f3 =
+            x64_state f f0 f1 f2 (f3 c) e) ∧
+         ∀f3 f f0 f1 f2 c e.
+           x64_state f f0 f1 f2 c e with exception updated_by f3 =
+           x64_state f f0 f1 f2 c (f3 e)
+
+   [x64_state_fupdcanon]  Theorem
+
+      |- (∀x g f.
+            x with <|ICACHE updated_by f; EFLAGS updated_by g|> =
+            x with <|EFLAGS updated_by g; ICACHE updated_by f|>) ∧
+         (∀x g f.
+            x with <|MEM updated_by f; EFLAGS updated_by g|> =
+            x with <|EFLAGS updated_by g; MEM updated_by f|>) ∧
+         (∀x g f.
+            x with <|MEM updated_by f; ICACHE updated_by g|> =
+            x with <|ICACHE updated_by g; MEM updated_by f|>) ∧
+         (∀x g f.
+            x with <|REG updated_by f; EFLAGS updated_by g|> =
+            x with <|EFLAGS updated_by g; REG updated_by f|>) ∧
+         (∀x g f.
+            x with <|REG updated_by f; ICACHE updated_by g|> =
+            x with <|ICACHE updated_by g; REG updated_by f|>) ∧
+         (∀x g f.
+            x with <|REG updated_by f; MEM updated_by g|> =
+            x with <|MEM updated_by g; REG updated_by f|>) ∧
+         (∀x g f.
+            x with <|RIP updated_by f; EFLAGS updated_by g|> =
+            x with <|EFLAGS updated_by g; RIP updated_by f|>) ∧
+         (∀x g f.
+            x with <|RIP updated_by f; ICACHE updated_by g|> =
+            x with <|ICACHE updated_by g; RIP updated_by f|>) ∧
+         (∀x g f.
+            x with <|RIP updated_by f; MEM updated_by g|> =
+            x with <|MEM updated_by g; RIP updated_by f|>) ∧
+         (∀x g f.
+            x with <|RIP updated_by f; REG updated_by g|> =
+            x with <|REG updated_by g; RIP updated_by f|>) ∧
+         (∀x g f.
+            x with <|exception updated_by f; EFLAGS updated_by g|> =
+            x with <|EFLAGS updated_by g; exception updated_by f|>) ∧
+         (∀x g f.
+            x with <|exception updated_by f; ICACHE updated_by g|> =
+            x with <|ICACHE updated_by g; exception updated_by f|>) ∧
+         (∀x g f.
+            x with <|exception updated_by f; MEM updated_by g|> =
+            x with <|MEM updated_by g; exception updated_by f|>) ∧
+         (∀x g f.
+            x with <|exception updated_by f; REG updated_by g|> =
+            x with <|REG updated_by g; exception updated_by f|>) ∧
+         ∀x g f.
+           x with <|exception updated_by f; RIP updated_by g|> =
+           x with <|RIP updated_by g; exception updated_by f|>
+
+   [x64_state_fupdcanon_comp]  Theorem
+
+      |- ((∀g f.
+              _ record fupdateICACHE f o  _ record fupdateEFLAGS g =
+              _ record fupdateEFLAGS g o  _ record fupdateICACHE f) ∧
+          ∀h g f.
+             _ record fupdateICACHE f o  _ record fupdateEFLAGS g o h =
+             _ record fupdateEFLAGS g o  _ record fupdateICACHE f o h) ∧
+         ((∀g f.
+              _ record fupdateMEM f o  _ record fupdateEFLAGS g =
+              _ record fupdateEFLAGS g o  _ record fupdateMEM f) ∧
+          ∀h g f.
+             _ record fupdateMEM f o  _ record fupdateEFLAGS g o h =
+             _ record fupdateEFLAGS g o  _ record fupdateMEM f o h) ∧
+         ((∀g f.
+              _ record fupdateMEM f o  _ record fupdateICACHE g =
+              _ record fupdateICACHE g o  _ record fupdateMEM f) ∧
+          ∀h g f.
+             _ record fupdateMEM f o  _ record fupdateICACHE g o h =
+             _ record fupdateICACHE g o  _ record fupdateMEM f o h) ∧
+         ((∀g f.
+              _ record fupdateREG f o  _ record fupdateEFLAGS g =
+              _ record fupdateEFLAGS g o  _ record fupdateREG f) ∧
+          ∀h g f.
+             _ record fupdateREG f o  _ record fupdateEFLAGS g o h =
+             _ record fupdateEFLAGS g o  _ record fupdateREG f o h) ∧
+         ((∀g f.
+              _ record fupdateREG f o  _ record fupdateICACHE g =
+              _ record fupdateICACHE g o  _ record fupdateREG f) ∧
+          ∀h g f.
+             _ record fupdateREG f o  _ record fupdateICACHE g o h =
+             _ record fupdateICACHE g o  _ record fupdateREG f o h) ∧
+         ((∀g f.
+              _ record fupdateREG f o  _ record fupdateMEM g =
+              _ record fupdateMEM g o  _ record fupdateREG f) ∧
+          ∀h g f.
+             _ record fupdateREG f o  _ record fupdateMEM g o h =
+             _ record fupdateMEM g o  _ record fupdateREG f o h) ∧
+         ((∀g f.
+              _ record fupdateRIP f o  _ record fupdateEFLAGS g =
+              _ record fupdateEFLAGS g o  _ record fupdateRIP f) ∧
+          ∀h g f.
+             _ record fupdateRIP f o  _ record fupdateEFLAGS g o h =
+             _ record fupdateEFLAGS g o  _ record fupdateRIP f o h) ∧
+         ((∀g f.
+              _ record fupdateRIP f o  _ record fupdateICACHE g =
+              _ record fupdateICACHE g o  _ record fupdateRIP f) ∧
+          ∀h g f.
+             _ record fupdateRIP f o  _ record fupdateICACHE g o h =
+             _ record fupdateICACHE g o  _ record fupdateRIP f o h) ∧
+         ((∀g f.
+              _ record fupdateRIP f o  _ record fupdateMEM g =
+              _ record fupdateMEM g o  _ record fupdateRIP f) ∧
+          ∀h g f.
+             _ record fupdateRIP f o  _ record fupdateMEM g o h =
+             _ record fupdateMEM g o  _ record fupdateRIP f o h) ∧
+         ((∀g f.
+              _ record fupdateRIP f o  _ record fupdateREG g =
+              _ record fupdateREG g o  _ record fupdateRIP f) ∧
+          ∀h g f.
+             _ record fupdateRIP f o  _ record fupdateREG g o h =
+             _ record fupdateREG g o  _ record fupdateRIP f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateEFLAGS g =
+              _ record fupdateEFLAGS g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateEFLAGS g o h =
+             _ record fupdateEFLAGS g o  _ record fupdateexception f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateICACHE g =
+              _ record fupdateICACHE g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateICACHE g o h =
+             _ record fupdateICACHE g o  _ record fupdateexception f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateMEM g =
+              _ record fupdateMEM g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateMEM g o h =
+             _ record fupdateMEM g o  _ record fupdateexception f o h) ∧
+         ((∀g f.
+              _ record fupdateexception f o  _ record fupdateREG g =
+              _ record fupdateREG g o  _ record fupdateexception f) ∧
+          ∀h g f.
+             _ record fupdateexception f o  _ record fupdateREG g o h =
+             _ record fupdateREG g o  _ record fupdateexception f o h) ∧
+         (∀g f.
+             _ record fupdateexception f o  _ record fupdateRIP g =
+             _ record fupdateRIP g o  _ record fupdateexception f) ∧
+         ∀h g f.
+            _ record fupdateexception f o  _ record fupdateRIP g o h =
+            _ record fupdateRIP g o  _ record fupdateexception f o h
+
+   [x64_state_fupdfupds]  Theorem
+
+      |- (∀x g f.
+            x with <|EFLAGS updated_by f; EFLAGS updated_by g|> =
+            x with EFLAGS updated_by f o g) ∧
+         (∀x g f.
+            x with <|ICACHE updated_by f; ICACHE updated_by g|> =
+            x with ICACHE updated_by f o g) ∧
+         (∀x g f.
+            x with <|MEM updated_by f; MEM updated_by g|> =
+            x with MEM updated_by f o g) ∧
+         (∀x g f.
+            x with <|REG updated_by f; REG updated_by g|> =
+            x with REG updated_by f o g) ∧
+         (∀x g f.
+            x with <|RIP updated_by f; RIP updated_by g|> =
+            x with RIP updated_by f o g) ∧
+         ∀x g f.
+           x with <|exception updated_by f; exception updated_by g|> =
+           x with exception updated_by f o g
+
+   [x64_state_fupdfupds_comp]  Theorem
+
+      |- ((∀g f.
+              _ record fupdateEFLAGS f o  _ record fupdateEFLAGS g =
+              _ record fupdateEFLAGS (f o g)) ∧
+          ∀h g f.
+             _ record fupdateEFLAGS f o  _ record fupdateEFLAGS g o h =
+             _ record fupdateEFLAGS (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateICACHE f o  _ record fupdateICACHE g =
+              _ record fupdateICACHE (f o g)) ∧
+          ∀h g f.
+             _ record fupdateICACHE f o  _ record fupdateICACHE g o h =
+             _ record fupdateICACHE (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateMEM f o  _ record fupdateMEM g =
+              _ record fupdateMEM (f o g)) ∧
+          ∀h g f.
+             _ record fupdateMEM f o  _ record fupdateMEM g o h =
+             _ record fupdateMEM (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateREG f o  _ record fupdateREG g =
+              _ record fupdateREG (f o g)) ∧
+          ∀h g f.
+             _ record fupdateREG f o  _ record fupdateREG g o h =
+             _ record fupdateREG (f o g) o h) ∧
+         ((∀g f.
+              _ record fupdateRIP f o  _ record fupdateRIP g =
+              _ record fupdateRIP (f o g)) ∧
+          ∀h g f.
+             _ record fupdateRIP f o  _ record fupdateRIP g o h =
+             _ record fupdateRIP (f o g) o h) ∧
+         (∀g f.
+             _ record fupdateexception f o  _ record fupdateexception g =
+             _ record fupdateexception (f o g)) ∧
+         ∀h g f.
+            _ record fupdateexception f o  _ record fupdateexception g o
+           h =
+            _ record fupdateexception (f o g) o h
+
+   [x64_state_induction]  Theorem
+
+      |- ∀P. (∀f f0 f1 f2 c e. P (x64_state f f0 f1 f2 c e)) ⇒ ∀x. P x
+
+   [x64_state_literal_11]  Theorem
+
+      |- ∀f21 f11 f01 f1 c1 e1 f22 f12 f02 f2 c2 e2.
+           (<|EFLAGS := f21; ICACHE := f11; MEM := f01; REG := f1;
+              RIP := c1; exception := e1|> =
+            <|EFLAGS := f22; ICACHE := f12; MEM := f02; REG := f2;
+              RIP := c2; exception := e2|>) ⇔
+           (f21 = f22) ∧ (f11 = f12) ∧ (f01 = f02) ∧ (f1 = f2) ∧
+           (c1 = c2) ∧ (e1 = e2)
+
+   [x64_state_literal_nchotomy]  Theorem
+
+      |- ∀x.
+           ∃f2 f1 f0 f c e.
+             x =
+             <|EFLAGS := f2; ICACHE := f1; MEM := f0; REG := f; RIP := c;
+               exception := e|>
+
+   [x64_state_nchotomy]  Theorem
+
+      |- ∀xx. ∃f f0 f1 f2 c e. xx = x64_state f f0 f1 f2 c e
+
+   [x64_state_updates_eq_literal]  Theorem
+
+      |- ∀x f2 f1 f0 f c e.
+           x with
+           <|EFLAGS := f2; ICACHE := f1; MEM := f0; REG := f; RIP := c;
+             exception := e|> =
+           <|EFLAGS := f2; ICACHE := f1; MEM := f0; REG := f; RIP := c;
+             exception := e|>
+
+
+*)
+end
diff -Nru acl2-6.2/books/translators/l3-to-acl2/misc/Import.sml acl2-6.3/books/translators/l3-to-acl2/misc/Import.sml
--- acl2-6.2/books/translators/l3-to-acl2/misc/Import.sml	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/misc/Import.sml	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,981 @@
+structure Import :> Import =
+struct
+
+open HolKernel boolLib bossLib
+open state_transformerTheory bitstringLib stringLib machine_ieeeSyntax
+open intSyntax integer_wordSyntax bitstringSyntax state_transformerSyntax
+
+val ERR = mk_HOL_ERR "Import"
+
+(* ------------------------------------------------------------------------ *)
+
+local
+   val boolify_vals = ref (Redblackset.empty Int.compare)
+   val type_names = ref []
+   val const_names = ref []
+   fun decl s = "val " ^ s
+   val typ = "{Thy: string, T: string list, C: string list, N: int list}"
+in
+   fun log_boolify n = boolify_vals := Redblackset.add (!boolify_vals, n)
+   fun log_type s = type_names := s :: !type_names
+   fun log_constant s = const_names := (s ^ "_def") :: !const_names
+   fun start thy =
+      (type_names := []
+       ; const_names := []
+       ; Theory.new_theory thy)
+   fun open_monad_syntax () =
+      Theory.adjoin_to_theory
+        {sig_ps = NONE,
+         struct_ps =
+            SOME (fn ppstrm => PP.add_string ppstrm "open monadsyntax")}
+   fun finish i =
+      (Theory.adjoin_to_theory {
+         sig_ps =
+           SOME (fn ppstrm =>
+                   (PP.add_string ppstrm (decl "inventory:")
+                    ; PP.add_break ppstrm (1, 2)
+                    ; PP.add_string ppstrm typ)),
+         struct_ps =
+           SOME (fn ppstrm =>
+                    let
+                       val name = Lib.quote (Theory.current_theory ())
+                       fun bl f s l =
+                          ( PP.add_break ppstrm (1, 0)
+                          ; PP.add_string ppstrm (s ^ " [")
+                          ; PP.begin_block ppstrm PP.INCONSISTENT 0
+                          ; Portable.pr_list
+                              (PP.add_string ppstrm o f)
+                              (fn () => PP.add_string ppstrm ",")
+                              (fn () => PP.add_break ppstrm (1, 0)) l
+                          ; PP.add_string ppstrm "]"
+                          ; PP.end_block ppstrm)
+                    in
+                       PP.add_string ppstrm (decl "inventory = {")
+                       ; PP.add_break ppstrm (0, 2)
+                       ; PP.begin_block ppstrm PP.CONSISTENT 0
+                       ; PP.add_string ppstrm ("Thy = " ^ name ^ ",")
+                       ; bl Lib.quote "T =" (!type_names)
+                       ; PP.add_string ppstrm (",")
+                       ; bl Lib.quote "C =" (!const_names)
+                       ; PP.add_string ppstrm (",")
+                       ; bl Int.toString "N ="
+                           (Redblackset.listItems (!boolify_vals))
+                       ; PP.add_string ppstrm "}"
+                       ; PP.end_block ppstrm
+                       ; PP.add_newline ppstrm
+                    end)}
+       ; Feedback.set_trace "TheoryPP.include_docs" i
+       ; Theory.export_theory ()
+       ; type_names := []
+       ; const_names := [])
+end
+
+(* ------------------------------------------------------------------------ *)
+
+val Ty = ParseDatatype.pretypeToType
+fun typeName ty = String.extract (Parse.type_to_string ty, 1, NONE)
+
+(* Constant type *)
+local
+   fun mkTy (t, n) = ParseDatatype.dTyop {Thy = t, Tyop = n, Args = []}
+   fun mkListTy a =
+      ParseDatatype.dTyop {Thy = SOME "list", Tyop = "list", Args = [a]}
+   val charTy = mkTy (SOME "string", "char")
+in
+   val uTy = mkTy (SOME "one", "one")
+   val iTy = mkTy (SOME "integer", "int")
+   val nTy = mkTy (SOME "num", "num")
+   val bTy = mkTy (SOME "min", "bool")
+   val rTy = mkTy (SOME "binary_ieee", "rounding")
+   val sTy = mkListTy charTy
+   val vTy = mkListTy bTy
+   fun CTy n = mkTy (NONE, n)
+end
+
+(* Variable type *)
+fun VTy s = ParseDatatype.dVartype ("'" ^ s)
+
+(* Fixed-width bit-vector type *)
+val FTy = ParseDatatype.dAQ o wordsSyntax.mk_int_word_type
+
+val F1 = FTy 1
+val F4 = FTy 4
+val F8 = FTy 8
+val F16 = FTy 16
+val F32 = FTy 32
+val F64 = FTy 64
+
+(* N-bit type *)
+fun typevar s = Type.mk_vartype ("'" ^ s)
+fun BTy s = ParseDatatype.dAQ (wordsSyntax.mk_word_type (typevar s))
+
+(* Arrow type *)
+fun ATy (t1, t2) =
+   ParseDatatype.dTyop {Thy = SOME "min", Tyop = "fun", Args = [t1, t2]}
+
+(* Product type *)
+fun PTy (t1, t2) =
+   ParseDatatype.dTyop {Thy = SOME "pair", Tyop = "prod", Args = [t1, t2]}
+
+(* Set type *)
+fun STy t = ATy (t, bTy)
+
+(* List type *)
+fun LTy t =
+   ParseDatatype.dTyop {Thy = SOME "list", Tyop = "list", Args = [t]}
+
+(* Option type *)
+fun OTy t =
+   ParseDatatype.dTyop {Thy = SOME "option", Tyop = "option", Args = [t]}
+
+(* ------------------------------------------------------------------------ *)
+
+val myDatatype =
+   let
+      val w = String.size "Defined type: \""
+   in
+      (Lib.with_flag
+         (Feedback.MESG_to_string,
+          fn s => (log_type
+                     (String.extract (s, w, SOME (String.size s - w - 1)))
+                   ; s ^ "\n")) o
+       Feedback.trace ("Theory.save_thm_reporting", 0) o
+       Lib.with_flag (Datatype.big_record_size, 25))
+       Datatype.astHol_datatype
+   end
+
+(* Record type *)
+fun Record (n, l) = myDatatype [(n, ParseDatatype.Record l)]
+
+(* Algebraic type *)
+val Construct = myDatatype o List.map (I ## ParseDatatype.Constructors)
+
+(* ------------------------------------------------------------------------ *)
+
+fun mk_local_const (n, ty) =
+   Term.mk_thy_const {Ty = ty, Thy = Theory.current_theory (), Name = n}
+
+(* Literals *)
+
+(* Unit *)
+val LU = oneSyntax.one_tm
+(* Bool *)
+val LT = boolSyntax.T
+val LF = boolSyntax.F
+(* Integer *)
+fun LI i = intSyntax.term_of_int (Arbint.fromInt i)
+(* Natural *)
+fun LN n = numSyntax.term_of_int n
+(* String *)
+fun LS s = stringSyntax.fromMLstring s
+(* Bitstring *)
+fun LV v = bitstringSyntax.bitstring_of_binstring v
+(* Fixed-width  *)
+fun LW (i, w) = wordsSyntax.mk_wordii (i, w)
+(* N-bit  *)
+fun LY (i, n) = wordsSyntax.mk_n2w (LN i, typevar n)
+(* Enumerated  *)
+fun LC (c, ty) = mk_local_const (c, Ty ty)
+(* NONE *)
+fun LO ty = optionSyntax.mk_none (Ty ty)
+(* Empty set *)
+fun LE ty = pred_setSyntax.mk_empty (Ty ty)
+(* Empty list (Nil) *)
+fun LNL ty = listSyntax.mk_nil (Ty ty)
+(* UNKNOWN  *)
+fun LX ty = boolSyntax.mk_arb (Ty ty)
+
+(* ------------------------------------------------------------------------ *)
+
+(* Function call *)
+
+fun Call (f, ty, tm) =
+   let
+      val typ = Type.--> (Term.type_of tm, Ty ty)
+      val vc = mk_local_const (f, typ)
+               handle HOL_ERR {origin_function = "mk_thy_const", ...} =>
+                 Term.mk_var (f, typ) (* for recursion *)
+   in
+      Term.mk_comb (vc, tm)
+   end
+
+(* Constants *)
+
+fun Const (c, ty) =
+   let
+      val typ = Ty ty
+   in
+      mk_local_const (c, typ)
+      handle HOL_ERR {origin_function = "mk_thy_const", ...} =>
+        Term.mk_var (c, typ) (* for recursion *)
+   end
+
+(* Variables *)
+
+local
+   val anon = ref 0
+   fun anonSuffix () = (if !anon = 0 then "" else Int.toString (!anon))
+                       before anon := !anon + 1
+in
+   fun resetAnon () = anon := 0
+   fun AVar ty = Term.mk_var ("_" ^ anonSuffix(), Ty ty)
+end
+
+fun Var (v, ty) = Term.mk_var (v, Ty ty)
+
+fun uVar v = Term.mk_var (v, oneSyntax.one_ty)
+fun bVar v = Term.mk_var (v, Type.bool)
+fun nVar v = Term.mk_var (v, numSyntax.num)
+fun iVar v = Term.mk_var (v, intSyntax.int_ty)
+fun sVar v = Term.mk_var (v, stringSyntax.string_ty)
+fun vVar v = Term.mk_var (v, bitstringSyntax.bitstring_ty)
+
+(* Closure *)
+
+val Close = pairSyntax.mk_pabs
+
+(* Application *)
+
+val Apply = Term.mk_comb
+
+(* Tuple *)
+
+fun TP l =
+   let
+      val (f, lst) = Lib.front_last l
+   in
+      List.foldr pairSyntax.mk_pair lst f
+   end
+
+(* Map update *)
+
+fun Fupd (m, i, e) = Term.mk_comb (combinSyntax.mk_update (i, e), m)
+
+(* Cases *)
+
+(* val CS = TypeBase.mk_case *)
+
+fun CS (x, cs) =
+   Term.beta_conv (Term.mk_comb
+     (Lib.with_flag (Feedback.emit_MESG, false)
+        (Lib.with_flag (Globals.priming, SOME "_")
+           TypeBase.mk_pattern_fn) cs, x))
+   before resetAnon ()
+
+(* Let-expression *)
+
+fun Let (v,e,b) =
+   boolSyntax.mk_let (Close (v, b), e)
+   handle HOL_ERR {origin_function = "mk_pabs", ...} => CS (e, [(v, b)])
+
+(* Set of list *)
+
+val SL =
+   fn [] => raise ERR "SL" "empty"
+    | l as (h::_) => pred_setSyntax.prim_mk_set (l, Term.type_of h)
+
+(* List of list *)
+
+val LL =
+   fn [] => raise ERR "LL" "empty"
+    | l as (h::_) => listSyntax.mk_list (l, Term.type_of h)
+
+local
+   fun gen_mk_list (l, tm) = List.foldr listSyntax.mk_cons tm l
+in
+   val LLC =
+      fn ([], tm) =>
+           let
+              val ty = fst (pairSyntax.dest_prod (Term.type_of tm))
+              val cons = Term.inst [Type.alpha |-> ty] listSyntax.cons_tm
+           in
+              pairSyntax.mk_uncurry (cons, tm)
+           end
+       | ltm => gen_mk_list ltm
+end
+
+(* Record constructor (may not work for really big records) *)
+
+local
+   fun strip_fun_type ty =
+      let
+         fun strip (a, ty) =
+            case Lib.total Type.dom_rng ty of
+              SOME (ty1, ty2) => strip (ty1::a, ty2)
+            | NONE => (List.rev a, ty)
+      in
+         strip ([], ty)
+      end
+   fun get_cons ty =
+      let
+         val tm = Lib.singleton_of_list (TypeBase.constructors_of ty)
+      in
+         (fst (strip_fun_type (Term.type_of tm)), tm)
+      end
+   fun split l = Lib.split_after (List.length l)
+in
+   fun Rec (ty, l) =
+      let
+         val (tys, tm) = get_cons (Ty ty)
+      in
+         if List.length l = List.length tys
+            then Term.list_mk_comb (tm, l)
+         else let
+                 val cs = List.map get_cons tys
+                 val (tms, rst) =
+                    List.foldl
+                      (fn ((tys, f), (a, r)) =>
+                          let
+                              val (args, rst) = split tys r
+                          in
+                             (Term.list_mk_comb (f, args) :: a, rst)
+                          end) ([], l) cs
+              in
+                 List.null rst orelse raise ERR "Rec" "too many arguments";
+                 Term.list_mk_comb (tm, List.rev tms)
+              end
+      end
+end
+
+(* Record destructor *)
+
+fun Dest (f, ty, tm) = Call (typeName (Term.type_of tm) ^ "_" ^ f, ty, tm)
+
+(* Record update *)
+
+fun smart_dest_pair tm =
+   case Lib.total pairSyntax.dest_pair tm of
+      SOME p => p
+    | NONE => (pairSyntax.mk_fst tm, pairSyntax.mk_snd tm)
+
+fun Rupd (f, tm) =
+   let
+      val (rty, fty) = pairSyntax.dest_prod (Term.type_of tm)
+      val typ = Type.--> (Type.--> (fty, fty), Type.--> (rty, rty))
+      val fupd = mk_local_const (typeName rty ^ "_" ^ f ^ "_fupd", typ)
+      val (x, d) = smart_dest_pair tm
+   in
+      Term.list_mk_comb (fupd, [combinSyntax.mk_K_1 (d, Term.type_of d), x])
+   end
+
+(* Boolify constructor *)
+
+val bit_bool =
+   Feedback.trace ("Theory.save_thm_reporting", 0) bitstringLib.bitify_boolify
+
+fun BL (i, tm) =
+   let
+      val () = log_boolify i
+      val { mk_boolify, ... } = bit_bool i
+   in
+      mk_boolify tm
+   end
+
+(* If-then-else *)
+
+fun ITE (i, t, e) = boolSyntax.mk_cond (i, t, e)
+
+fun ITB (l, e) = List.foldr (fn ((b, t), e) => ITE (b, t, e)) e l
+
+(* Sub-word extract *)
+
+fun EX (x, h, l, ty) =
+   let
+      val typ = Ty ty
+   in
+      if typ = bitstringSyntax.bitstring_ty
+         then bitstringSyntax.mk_field (h, l, x)
+      else wordsSyntax.mk_word_extract (h, l, x, wordsSyntax.dest_word_type typ)
+   end
+
+(* Bit-field insert *)
+
+fun BFI (t as (_, _, x, _)) =
+   if Term.type_of x = bitstringSyntax.bitstring_ty
+      then bitstringSyntax.mk_field_insert t
+   else wordsSyntax.mk_bit_field_insert t
+
+(* Concatenation *)
+
+fun CC [] = raise ERR "CC" "empty"
+  | CC l =
+   let
+      val (f, lst) = Lib.front_last l
+      val ty = Term.type_of lst
+      val mk = if ty = stringSyntax.string_ty
+                  then stringSyntax.mk_strcat
+               else if ty = bitstringSyntax.bitstring_ty
+                  then listSyntax.mk_append
+               else wordsSyntax.mk_word_concat
+   in
+      List.foldr mk lst f
+   end
+
+(* Equality *)
+
+fun EQ (x, y) = boolSyntax.mk_eq (x, y)
+
+(* Monad operations *)
+
+(* Return/Unit *)
+
+val MU = state_transformerSyntax.mk_unit o (I ## Ty)
+
+(* Bind *)
+
+val MB = state_transformerSyntax.mk_bind
+
+(* Read *)
+
+val MR = state_transformerSyntax.mk_read
+
+(* Write *)
+
+val MW = state_transformerSyntax.mk_write
+
+(* Narrow *)
+
+val MN = state_transformerSyntax.mk_narrow
+
+(* Widen *)
+
+val MD = state_transformerSyntax.mk_widen o (I ## Ty)
+
+(* For-loop *)
+
+val For = HolKernel.mk_monop state_transformerSyntax.for_tm
+
+(* ------------------------------------------------------------------------ *)
+
+(* Primitive binary and unary operations *)
+
+datatype monop =
+     Abs
+   | BNot
+   | Cast of ParseDatatype.pretype
+   | Fst
+   | Head
+   | IsSome
+   | K1 of ParseDatatype.pretype
+   | Length
+   | Log
+   | Max
+   | Min
+   | Msb
+   | Neg
+   | Not
+   | Rev
+   | SE of ParseDatatype.pretype
+   | Size
+   | Smax
+   | Smin
+   | Snd
+   | SofL
+   | Some
+   | Tail
+   | ValOf
+   | fpAdd32
+   | fpAdd64
+   | fpMul32
+   | fpMul64
+   | fpNeg32
+   | fpNeg64
+   | fpSub32
+   | fpSub64
+
+datatype binop =
+     Add
+   | And
+   | Asr
+   | BAnd
+   | BOr
+   | BXor
+   | Bit
+   | Div
+   | Exp
+   | Ge
+   | Gt
+   | In
+   | Insert
+   | Le
+   | Lsl
+   | Lsr
+   | Lt
+   | Mdfy
+   | Mod
+   | Mul
+   | Or
+   | Quot
+   | Rem
+   | Rep
+   | Rol
+   | Ror
+   | Sub
+   | Uge
+   | Ugt
+   | Ule
+   | Ult
+
+local
+   val m =
+      ref (Redblackmap.mkDict String.compare : (string, term) Redblackmap.dict)
+in
+   fun string2enum ty =
+      let
+         val name = fst (Type.dest_type ty)
+      in
+         case Redblackmap.peek (!m, name) of
+            SOME tm => tm
+          | NONE =>
+              let
+                 val tm = ty
+                          |> stringLib.Define_string2enum
+                          |> Thm.concl
+                          |> boolSyntax.dest_forall
+                          |> snd
+                          |> boolSyntax.lhs
+                          |> boolSyntax.rator
+              in
+                 m := Redblackmap.insert (!m, name, tm)
+                 ; tm
+              end
+      end
+end
+
+local
+   val m =
+      ref (Redblackmap.mkDict String.compare : (string, term) Redblackmap.dict)
+in
+   fun enum2string ty =
+      let
+         val name = fst (Type.dest_type ty)
+      in
+         case Redblackmap.peek (!m, name) of
+            SOME tm => tm
+          | NONE =>
+              let
+                 val tm = ty
+                          |> stringLib.Define_enum2string
+                          |> Thm.concl
+                          |> boolSyntax.strip_conj
+                          |> hd
+                          |> boolSyntax.lhs
+                          |> boolSyntax.rator
+              in
+                 m := Redblackmap.insert (!m, name, tm)
+                 ; tm
+              end
+      end
+end
+
+local
+   val one_tm = numSyntax.mk_numeral Arbnum.one
+
+   fun mk_w tm ty = wordsSyntax.mk_n2w (tm, wordsSyntax.dest_word_type ty)
+   val mk_word0 = mk_w numSyntax.zero_tm
+   val mk_word1 = mk_w one_tm
+
+   fun enum2num ty =
+      Lib.with_exn mk_local_const
+        (typeName ty ^ "2num", Type.--> (ty, numLib.num))
+        (ERR "pickCast" "enum2num not found")
+
+   fun num2enum ty =
+      Lib.with_exn mk_local_const
+        ("num2" ^ typeName ty, Type.--> (numLib.num, ty))
+        (ERR "pickCast" "num2enum not found")
+
+   fun mk_test a b c d = boolSyntax.mk_cond (boolSyntax.mk_eq (a, b), c, d)
+
+   val string2bool =
+      let
+         val v = Term.mk_var ("s", stringSyntax.string_ty)
+      in
+         Term.mk_abs (v,
+            mk_test v (stringSyntax.fromMLstring "true") boolSyntax.T
+              (mk_test v (stringSyntax.fromMLstring "false") boolSyntax.F
+                 (boolSyntax.mk_arb Type.bool)))
+      end
+
+   val fstTy = fst o pairSyntax.dest_prod o Term.type_of
+
+   fun s f (tm1:term) tm2 = pairSyntax.mk_uncurry (f tm2 tm1, tm2)
+
+   fun ialpha tm =
+      Term.inst [Type.alpha |-> wordsSyntax.dest_word_type (fstTy tm)]
+
+   fun mk_from_bool (x as (tm, a, b)) =
+      if tm = boolSyntax.T
+         then a
+      else if tm = boolSyntax.F
+         then b
+      else boolSyntax.mk_cond x
+
+   val mk_word_min  = s ialpha wordsSyntax.word_min_tm
+   val mk_word_max  = s ialpha wordsSyntax.word_max_tm
+   val mk_word_smin = s ialpha wordsSyntax.word_smin_tm
+   val mk_word_smax = s ialpha wordsSyntax.word_smax_tm
+
+   val mk_num_min = s (K I) numSyntax.min_tm
+   val mk_num_max = s (K I) numSyntax.max_tm
+   val mk_int_min = s (K I) intSyntax.min_tm
+   val mk_int_max = s (K I) intSyntax.max_tm
+
+   val c_mk_comb = Lib.curry Term.mk_comb
+
+   fun mk_from_enum ty =
+      SOME (Lib.curry Term.mk_comb (enum2num ty)) handle HOL_ERR _ => NONE
+
+   fun mk_fp_triop f =
+      let
+         val ftm = case f of
+                      fpAdd32 => machine_ieeeSyntax.fp32Syntax.fp_add_tm
+                    | fpAdd64 => machine_ieeeSyntax.fp64Syntax.fp_add_tm
+                    | fpMul32 => machine_ieeeSyntax.fp32Syntax.fp_mul_tm
+                    | fpMul64 => machine_ieeeSyntax.fp64Syntax.fp_mul_tm
+                    | fpSub32 => machine_ieeeSyntax.fp32Syntax.fp_sub_tm
+                    | fpSub64 => machine_ieeeSyntax.fp64Syntax.fp_sub_tm
+                    | _ => raise ERR "mk_fp_triop" ""
+         val ty = ftm |> Term.type_of
+                      |> Type.dom_rng |> snd
+                      |> Type.dom_rng |> fst
+         val a = Term.mk_var ("a", binary_ieeeSyntax.rounding_ty)
+         val b = Term.mk_var ("b", ty)
+         val c = Term.mk_var ("c", ty)
+         val l = [a, b, c]
+         val p = pairSyntax.list_mk_pair l
+         val ptm = pairSyntax.mk_pabs (p, Term.list_mk_comb (ftm, l))
+      in
+         fn tm =>
+            (ptm, tm) |> Term.mk_comb
+                      |> PairRules.PBETA_CONV
+                      |> Thm.concl
+                      |> boolSyntax.rhs
+      end
+
+   fun pickCast ty2 tm =
+      let
+         val ty1 = Term.type_of tm
+         val dw = wordsSyntax.dest_word_type
+      in
+         if wordsSyntax.is_word_type ty1
+            then if wordsSyntax.is_word_type ty2
+                    then wordsSyntax.mk_w2w (tm, dw ty2)
+                 else if ty2 = bitstringSyntax.bitstring_ty
+                    then bitstringSyntax.mk_w2v tm
+                 else if ty2 = numSyntax.num
+                    then wordsSyntax.mk_w2n tm
+                 else if ty2 = intSyntax.int_ty
+                    then integer_wordSyntax.mk_w2i tm
+                 else if ty2 = stringSyntax.string_ty
+                    then wordsSyntax.mk_word_to_hex_string tm
+                 else if ty2 = Type.bool
+                    then boolSyntax.mk_neg (boolSyntax.mk_eq (tm, mk_word0 ty1))
+                 else Term.mk_comb (num2enum ty2, wordsSyntax.mk_w2n tm)
+         else if ty1 = bitstringSyntax.bitstring_ty
+            then if wordsSyntax.is_word_type ty2
+                    then bitstringSyntax.mk_v2w (tm, dw ty2)
+                 else if ty2 = bitstringSyntax.bitstring_ty
+                    then tm
+                 else if ty2 = numSyntax.num
+                    then bitstringSyntax.mk_v2n tm
+                 else if ty2 = intSyntax.int_ty
+                    then intSyntax.mk_injected (bitstringSyntax.mk_v2n tm)
+                 else if ty2 = stringSyntax.string_ty
+                    then bitstringSyntax.mk_v2s tm
+                 else if ty2 = Type.bool
+                    then boolSyntax.mk_neg (boolSyntax.mk_eq
+                           (bitstringSyntax.mk_v2n tm, numSyntax.zero_tm))
+                 else Term.mk_comb (num2enum ty2, bitstringSyntax.mk_v2n tm)
+         else if ty1 = numSyntax.num
+            then if wordsSyntax.is_word_type ty2
+                    then wordsSyntax.mk_n2w (tm, dw ty2)
+                 else if ty2 = bitstringSyntax.bitstring_ty
+                    then bitstringSyntax.mk_n2v tm
+                 else if ty2 = numSyntax.num
+                    then tm
+                 else if ty2 = intSyntax.int_ty
+                    then intSyntax.mk_injected tm
+                 else if ty2 = stringSyntax.string_ty
+                    then ASCIInumbersSyntax.mk_num_to_dec_string tm
+                 else if ty2 = Type.bool
+                    then boolSyntax.mk_neg (boolSyntax.mk_eq
+                           (tm, numSyntax.zero_tm))
+                 else Term.mk_comb (num2enum ty2, tm)
+         else if ty1 = intSyntax.int_ty
+            then if wordsSyntax.is_word_type ty2
+                    then integer_wordSyntax.mk_i2w (tm, dw ty2)
+                 else if ty2 = bitstringSyntax.bitstring_ty
+                    then bitstringSyntax.mk_n2v (intSyntax.mk_Num tm)
+                 else if ty2 = numSyntax.num
+                    then intSyntax.mk_Num tm
+                 else if ty2 = intSyntax.int_ty
+                    then tm
+                 else if ty2 = stringSyntax.string_ty
+                    then integer_wordSyntax.mk_toString tm
+                 else if ty2 = Type.bool
+                    then boolSyntax.mk_neg (boolSyntax.mk_eq
+                           (tm, intSyntax.zero_tm))
+                 else Term.mk_comb (num2enum ty2, intSyntax.mk_Num tm)
+         else if ty1 = stringSyntax.string_ty
+            then if wordsSyntax.is_word_type ty2
+                    then wordsSyntax.mk_word_from_hex_string (tm, dw ty2)
+                 else if ty2 = bitstringSyntax.bitstring_ty
+                    then bitstringSyntax.mk_s2v tm
+                 else if ty2 = numSyntax.num
+                    then ASCIInumbersSyntax.mk_num_from_dec_string tm
+                 else if ty2 = intSyntax.int_ty
+                    then integer_wordSyntax.mk_fromString tm
+                 else if ty2 = stringSyntax.string_ty
+                    then tm
+                 else if ty2 = Type.bool
+                    then Term.mk_comb (string2bool, tm)
+                 else Term.mk_comb (string2enum ty2, tm)
+         else if ty1 = Type.bool
+            then if wordsSyntax.is_word_type ty2
+                    then mk_from_bool (tm, mk_word1 ty2, mk_word0 ty2)
+                 else if ty2 = bitstringSyntax.bitstring_ty
+                    then mk_from_bool (tm,
+                           bitstringSyntax.bitstring_of_binstring "1",
+                           bitstringSyntax.bitstring_of_binstring "0")
+                 else if ty2 = numSyntax.num
+                    then mk_from_bool (tm, one_tm, numSyntax.zero_tm)
+                 else if ty2 = intSyntax.int_ty
+                    then mk_from_bool (tm,
+                           intSyntax.one_tm, intSyntax.zero_tm)
+                 else if ty2 = stringSyntax.string_ty
+                    then mk_from_bool (tm,
+                           stringSyntax.fromMLstring "true",
+                           stringSyntax.fromMLstring "false")
+                 else if ty2 = Type.bool
+                    then tm
+                 else raise ERR "pickCast" "bool -> ?"
+         else case mk_from_enum ty1 of
+                 SOME e2n =>
+                    if wordsSyntax.is_word_type ty2
+                       then wordsSyntax.mk_n2w (e2n tm, dw ty2)
+                    else if ty2 = bitstringSyntax.bitstring_ty
+                       then bitstringSyntax.mk_n2v (e2n tm)
+                    else if ty2 = numSyntax.num
+                       then e2n tm
+                    else if ty2 = intSyntax.int_ty
+                       then intSyntax.mk_injected (e2n tm)
+                    else if ty2 = stringSyntax.string_ty
+                       then Term.mk_comb (enum2string ty1, tm)
+                    else if ty2 = Type.bool
+                       then boolSyntax.mk_neg (boolSyntax.mk_eq
+                              (tm, hd (TypeBase.constructors_of ty1)))
+                    else Term.mk_comb (num2enum ty2, e2n tm)
+               | _ => raise ERR "pickCast"
+                        ("bad domain: " ^ typeName ty1 ^ " -> " ^ typeName ty2)
+      end
+
+      fun pick (a, b, c, d) tm =
+         let
+            val ty = Term.type_of tm
+         in
+            Option.valOf
+              (if Option.isSome a andalso wordsSyntax.is_word_type ty
+                  then a
+               else if Option.isSome b andalso ty = bitstringSyntax.bitstring_ty
+                  then b
+               else if Option.isSome c andalso ty = numSyntax.num
+                  then c
+               else if Option.isSome d andalso ty = intSyntax.int_ty
+                  then d
+               else raise ERR "Mop" "pick") tm
+         end
+
+      fun pickMinMax (a, b, c) tm =
+         let
+            val ty = fstTy tm
+         in
+           (if wordsSyntax.is_word_type ty
+               then a
+            else if ty = numSyntax.num
+               then b
+            else if ty = intSyntax.int_ty
+               then c
+            else raise ERR "Mop" "pickMinMax") tm
+         end
+in
+   fun Mop (m : monop, x) =
+      (case m of
+         BNot   => wordsSyntax.mk_word_1comp
+       | Fst    => pairSyntax.mk_fst
+       | Head   => listSyntax.mk_hd
+       | IsSome => optionSyntax.mk_is_some
+       | Length => listSyntax.mk_length
+       | Msb    => wordsSyntax.mk_word_msb
+       | Not    => boolSyntax.mk_neg
+       | Rev    => wordsSyntax.mk_word_reverse
+       | Smax   => mk_word_smax
+       | Smin   => mk_word_smin
+       | Snd    => pairSyntax.mk_snd
+       | SofL   => listSyntax.mk_list_to_set
+       | Some   => optionSyntax.mk_some
+       | Tail   => listSyntax.mk_tl
+       | ValOf  => optionSyntax.mk_the
+       | Min  => pickMinMax (mk_word_min, mk_num_min, mk_int_min)
+       | Max  => pickMinMax (mk_word_max, mk_num_max, mk_int_max)
+       | Abs  => pick (SOME wordsSyntax.mk_word_abs, NONE, NONE,
+                       SOME intSyntax.mk_absval)
+       | Neg  => pick (SOME wordsSyntax.mk_word_2comp, NONE, NONE,
+                       SOME intSyntax.mk_negated)
+       | Size => pick (SOME wordsSyntax.mk_word_len,
+                       SOME listSyntax.mk_length, NONE, NONE)
+       | Log  => pick (SOME wordsSyntax.mk_word_log2, NONE,
+                       SOME bitSyntax.mk_log2, NONE)
+       | K1 ty => (fn tm => combinSyntax.mk_K_1 (tm, Ty ty))
+       | SE ty =>
+           (fn tm =>
+              wordsSyntax.mk_sw2sw (tm, wordsSyntax.dest_word_type (Ty ty)))
+       | Cast ty => pickCast (Ty ty)
+       | fpNeg32 => machine_ieeeSyntax.fp32Syntax.mk_fp_negate
+       | fpNeg64 => machine_ieeeSyntax.fp64Syntax.mk_fp_negate
+       | _ => mk_fp_triop m
+      ) x
+end
+
+local
+   fun pick (a, b, c, d) (tm1, tm2: term) : term =
+      let
+         val ty = Term.type_of tm1
+      in
+         Option.valOf
+           (if Option.isSome a andalso wordsSyntax.is_word_type ty
+               then a
+            else if Option.isSome b andalso ty = bitstringSyntax.bitstring_ty
+               then b
+            else if Option.isSome c andalso ty = numSyntax.num
+               then c
+            else if Option.isSome d andalso ty = intSyntax.int_ty
+               then d
+            else raise ERR "Bop" "pick") (tm1, tm2)
+      end
+   fun pickShift (a, b) (tm1 : term, tm2) : term =
+      (if wordsSyntax.is_word_type (Term.type_of tm2) then a else b) (tm1, tm2)
+   fun COMM f (x, y) = f (y, x)
+   fun icurry tm =
+       Term.mk_comb
+          (Term.inst [Type.alpha |-> numSyntax.num, Type.beta |-> Type.bool,
+                      Type.gamma |-> Type.bool] pairSyntax.curry_tm, tm)
+   fun mk_modify (f, a) = wordsSyntax.mk_word_modify (icurry f, a)
+in
+   fun Bop (b : binop, x, y) = (x, y) |>
+     (case b of
+        And    => boolSyntax.mk_conj
+      | BAnd   => wordsSyntax.mk_word_and
+      | BOr    => wordsSyntax.mk_word_or
+      | BXor   => wordsSyntax.mk_word_xor
+      | In     => pred_setSyntax.mk_in
+      | Insert => pred_setSyntax.mk_insert
+      | Mdfy   => mk_modify
+      | Or     => boolSyntax.mk_disj
+      | Uge    => wordsSyntax.mk_word_hs
+      | Ugt    => wordsSyntax.mk_word_hi
+      | Ule    => wordsSyntax.mk_word_ls
+      | Ult    => wordsSyntax.mk_word_lo
+      | Lt   => pick (SOME wordsSyntax.mk_word_lt, NONE,
+                      SOME numSyntax.mk_less, SOME intSyntax.mk_less)
+      | Gt   => pick (SOME wordsSyntax.mk_word_gt, NONE,
+                      SOME numSyntax.mk_greater, SOME intSyntax.mk_great)
+      | Le   => pick (SOME wordsSyntax.mk_word_le, NONE,
+                      SOME numSyntax.mk_leq, SOME intSyntax.mk_leq)
+      | Ge   => pick (SOME wordsSyntax.mk_word_ge, NONE,
+                      SOME numSyntax.mk_geq, SOME intSyntax.mk_geq)
+      | Bit  => pick (SOME (COMM wordsSyntax.mk_word_bit),
+                      SOME (COMM bitstringSyntax.mk_testbit), NONE, NONE)
+      | Add  => pick (SOME wordsSyntax.mk_word_add,
+                      SOME bitstringSyntax.mk_add, SOME numSyntax.mk_plus,
+                      SOME intSyntax.mk_plus)
+      | Sub  => pick (SOME wordsSyntax.mk_word_sub, NONE,
+                      SOME numSyntax.mk_minus, SOME intSyntax.mk_minus)
+      | Mul  => pick (SOME wordsSyntax.mk_word_mul, NONE,
+                      SOME numSyntax.mk_mult, SOME intSyntax.mk_mult)
+      | Div  => pick (SOME wordsSyntax.mk_word_div, NONE,
+                      SOME numSyntax.mk_div, SOME intSyntax.mk_div)
+      | Mod  => pick (SOME wordsSyntax.mk_word_mod, NONE,
+                      SOME numSyntax.mk_mod, SOME intSyntax.mk_mod)
+      | Quot => pick (SOME wordsSyntax.mk_word_sdiv, NONE, NONE,
+                      SOME intSyntax.mk_quot)
+      | Rem  => pick (SOME wordsSyntax.mk_word_srem, NONE, NONE,
+                      SOME intSyntax.mk_rem)
+      | Rep  => pick (SOME (wordsSyntax.mk_word_replicate o Lib.swap),
+                      SOME bitstringSyntax.mk_replicate, NONE, NONE)
+      | Exp  => pick (NONE, NONE, SOME numSyntax.mk_exp, SOME intSyntax.mk_exp)
+      | Lsl  => pick (SOME (pickShift (wordsSyntax.mk_word_lsl_bv,
+                                       wordsSyntax.mk_word_lsl)),
+                      SOME bitstringSyntax.mk_shiftl, NONE, NONE)
+      | Lsr  => pickShift (wordsSyntax.mk_word_lsr_bv, wordsSyntax.mk_word_lsr)
+      | Asr  => pickShift (wordsSyntax.mk_word_asr_bv, wordsSyntax.mk_word_asr)
+      | Ror  => pickShift (wordsSyntax.mk_word_ror_bv, wordsSyntax.mk_word_ror)
+      | Rol  => pickShift (wordsSyntax.mk_word_rol_bv, wordsSyntax.mk_word_rol))
+end
+
+(* ------------------------------------------------------------------------ *)
+
+(* Definitions *)
+
+local
+   val tac = SRW_TAC [listSimps.LIST_ss, numSimps.ARITH_ss] []
+in
+   fun MEASURE_TAC tm =
+      TotalDefn.WF_REL_TAC `^(boolSyntax.mk_icomb (numSyntax.measure_tm, tm))`
+      THEN tac
+end
+
+fun new_def s x = Definition.new_definition (s ^ "_def", boolSyntax.mk_eq x)
+
+fun z_def def =
+   Feedback.trace ("Define.storage_message", 0)
+   bossLib.zDefine [HOLPP.ANTIQUOTE (boolSyntax.mk_eq def)]
+
+fun t_def s def m =
+   Feedback.trace ("Define.storage_message", 0)
+   (bossLib.tDefine s [HOLPP.ANTIQUOTE (boolSyntax.mk_eq def)])
+     (MEASURE_TAC m)
+
+val mesg =
+   Lib.with_flag
+      (Feedback.MESG_to_string,
+       fn s => (log_constant s; "Defined: " ^ s ^ "\n"))
+      Feedback.HOL_MESG
+
+fun Def (s, a, b) =
+   let
+      val ty = Type.--> (Term.type_of a, Term.type_of b)
+      val c = Term.mk_var (s, ty)
+      val isrec = (HolKernel.find_term (Lib.equal c) b; true)
+                  handle HOL_ERR _ => false
+      val def = if isrec andalso Term.is_abs b
+                   then let
+                           val (vs, b1) = Term.strip_abs b
+                        in
+                           (Term.list_mk_comb (c, a :: vs), b1)
+                        end
+                else (Term.mk_comb (c, a), b)
+      val () = resetAnon ()
+   in
+      (if isrec then z_def else new_def s) def before mesg s
+   end
+
+fun tDef (s, a, b, m) =
+   let
+      val ty = Type.--> (Term.type_of a, Term.type_of b)
+      val c = Term.mk_var (s, ty)
+      val def = if Term.is_abs b
+                   then let
+                           val (vs, b1) = Term.strip_abs b
+                        in
+                           (Term.list_mk_comb (c, a :: vs), b1)
+                        end
+                else (Term.mk_comb (c, a), b)
+      val () = resetAnon ()
+   in
+      t_def s def m before mesg s
+   end
+
+fun Def0 (s, b) = new_def s (Term.mk_var (s, Term.type_of b), b) before mesg s
+
+end (* Import *)
diff -Nru acl2-6.2/books/translators/l3-to-acl2/misc/README acl2-6.3/books/translators/l3-to-acl2/misc/README
--- acl2-6.2/books/translators/l3-to-acl2/misc/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/misc/README	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1 @@
+Import.sml comes from Anthony Fox, and is related to translation to HOL.
diff -Nru acl2-6.2/books/translators/l3-to-acl2/notes.txt acl2-6.3/books/translators/l3-to-acl2/notes.txt
--- acl2-6.2/books/translators/l3-to-acl2/notes.txt	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/notes.txt	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,55 @@
+Miscellaneous notes on translator issues
+
+There may be name clashes, in part due to case sensitivity of L3
+vs. case-insensitivity of ACL2.  Our solution is to uppercase all
+names by default, but to take input that renames some strings to the
+desired symbols.  Indeed, renaming may be necessary for other reasons
+as well, besides case.  For example, the name PC is taken in the ACL2
+package, so I've manually renamed PC to PCTR in the example runs found
+in examples/thacker/Makefile.  Such renaming is the responsibility of
+the user, e.g., to map "PC" to the symbol PCTR.  Similarly, note that
+I mapped the name function to function0, since the name FUNCTION is
+unavailable for a function name in the ACL2 package.  The translator
+automatically renames t and nil, since those are constants, not
+variables, in ACL2.
+
+I could consider using (include-book "cutil/define" :dir :system),
+probably in l3.lisp.  I wonder if it might help in proving theorems
+about function outputs, of a type-like nature.
+
+The defun-struct definition of DECODE illustrates the need for
+ignorable declarations.  Perhaps there's a way to avoid the expense of
+that call of BL, which only creates one bit that we care about.
+
+There is currently no way for users to override the built-in
+translation of strings to constants (in analogy to the :str-to-sym
+keyword argument of l3-to-acl2), but that could be changed.
+
+I should consider combining the constant and sym alists -- we don't
+want any duplicates even between the two.
+
+Some observations from Anthony Fox (some of them already clear to me
+as of July 10, 2013, but I'll save them anyhow):
+
+Anthony points out that casting is of various sorts, including
+enumerated types to strings -- so I'll need to save info about the
+original names for enums.
+
+``Close (qvar"state"'' idiom is a fine way to look for state.  But
+there might be later issues with local state.
+
+LC represents "literal constant" in tinyScript.sml, so I'll take these
+to be (quoted) symbols.
+
+Anthony is fairly sure that he doesn't get a - in names, so
+translating ' to - makes sense, as in dfn'normal to dfn-normal.
+
+Anthony notes that the instructions can be linear trees, e.g.:
+(StoreDM (StoreOther (StoreOther2 v1))) ==> dfn'StoreOther2 v2 state
+
+Anthony notes that the kind of "arb" returned depends on the type --
+and that type will be in the generated ML.
+
+As Anthony notes, I'll want to think about how much of what's in
+l3.lisp is universal and how much is per-model.
+
diff -Nru acl2-6.2/books/translators/l3-to-acl2/target.lisp acl2-6.3/books/translators/l3-to-acl2/target.lisp
--- acl2-6.2/books/translators/l3-to-acl2/target.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/target.lisp	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,3 @@
+; Silly file to support ../../Makefile
+
+(in-package "ACL2")
diff -Nru acl2-6.2/books/translators/l3-to-acl2/translator/Makefile acl2-6.3/books/translators/l3-to-acl2/translator/Makefile
--- acl2-6.2/books/translators/l3-to-acl2/translator/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/translator/Makefile	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,8 @@
+# Note that ACL2 and ACL2_SYSTEM_BOOKS should be defined, e.g.:
+# bash
+# ACL2_DIR=/Users/kaufmann/acl2/v6-2/acl2-sources
+# export ACL2=${ACL2_DIR}/saved_acl2
+# export ACL2_SYSTEM_BOOKS=${ACL2_DIR}/books
+
+include $(ACL2_SYSTEM_BOOKS)/Makefile-generic
+-include Makefile-deps
diff -Nru acl2-6.2/books/translators/l3-to-acl2/translator/README acl2-6.3/books/translators/l3-to-acl2/translator/README
--- acl2-6.2/books/translators/l3-to-acl2/translator/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/translator/README	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,5 @@
+File l3-to-acl2.lisp implements a translator from L3 to ACL2.  See the
+macro at the end for how to invoke it, or see ../README.
+
+File l3.lisp is a supporting library -- really, a book with some
+necessary definitions.
diff -Nru acl2-6.2/books/translators/l3-to-acl2/translator/l3-to-acl2.lisp acl2-6.3/books/translators/l3-to-acl2/translator/l3-to-acl2.lisp
--- acl2-6.2/books/translators/l3-to-acl2/translator/l3-to-acl2.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/translator/l3-to-acl2.lisp	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,1300 @@
+(in-package "ACL2")
+
+; General comments:
+
+; We translate objects of option type to nil, for NONE, and (SOME . x), for
+; SOME x.  We considered translating (SOME . x) to x in the case that x cannot
+; be nil, but we worried that case-matching would be awkward to work out in
+; that case.
+
+; We start by including l3, so that various functions are defined, e.g.: BITS
+; and BL are defined, for use in term-stobj-out below; type-expr, for use in
+; l3-trans-formal below.
+(include-book "l3")
+
+(defun trans-breaker ()
+; To trace errors, e.g.:
+; (set-iprint t)
+; (trace$ (trans-breaker :entry (break$)))
+  (declare (xargs :guard t))
+  nil)
+
+(defmacro trans-err (&rest args)
+  `(prog2$ (trans-breaker) ; to break: (trace$ (trans-breaker :entry (break$)))
+           (trans-er ,@args)))
+
+(defstobj bindings
+  str-to-const    ; alist mapping strings to constant symbols
+  const-to-str    ; alist mapping constant symbols to strings
+  sym-to-str      ; alist mapping symbols seen to strings they came from
+  str-to-sym      ; inverse of sym-to-str
+  st$-fields      ; alist binding each field to nil or (for array) dimension
+  construct-alist ; alist mapping constructor types to field names
+  bw              ; binding world, extended with some stobjs-out for defs
+  )
+
+(defun str-to-sym-alistp (x)
+  (declare (xargs :guard (alistp x)))
+  (cond ((atom x) (null x))
+        (t (and (consp (car x))
+                (stringp (caar x))
+                (symbolp (cdar x))
+                (not (assoc-equal (caar x) (cdr x)))
+                (not (rassoc-eq (cdar x) (cdr x)))
+                (str-to-sym-alistp (cdr x))))))
+
+(defthm str-to-sym-alistp-forward-to-alistp
+  (implies (str-to-sym-alistp x)
+           (alistp x))
+  :rule-classes :forward-chaining)
+
+(defun invert-alist (x)
+  (declare (xargs :guard (alistp x)))
+  (cond ((endp x) nil)
+        (t (acons (cdar x)
+                  (caar x)
+                  (invert-alist (cdr x))))))
+
+(defconst *initial-bindings*
+  '(("t" . T_VAR)
+    ("nil" . NIL_VAR)))
+
+(defun initialize-bindings (str-to-sym wrld ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (let ((str-to-sym (append *initial-bindings* str-to-sym)))
+    (cond
+     ((not (and (alistp str-to-sym)
+                (str-to-sym-alistp str-to-sym)))
+      (trans-err ctx
+                 "STR-TO-SYM should be, after extending by ~x0, an alist ~
+                  mapping strings to symbols, without duplicate CARs or CDRs; ~
+                  but that extension is:~|~x1"
+                 *initial-bindings* str-to-sym))
+     (t (let* ((bindings (update-str-to-const nil bindings))
+               (bindings (update-const-to-str nil bindings))
+               (bindings (update-str-to-sym str-to-sym bindings))
+               (bindings (update-sym-to-str (invert-alist str-to-sym)
+                                            bindings))
+               (bindings (update-st$-fields nil bindings))
+               (bindings (update-construct-alist nil bindings))
+               (bindings (update-bw wrld bindings)))
+          (trans-value nil))))))
+
+(defun l3-reparse (x)
+
+; Replaces subexpressions
+;   qvar"s"
+;   qvar"state"
+; and for that matter, any
+;   qvar x
+; by just qvar.
+; Also, replaces subexpressions
+;   bvar"name"
+; by
+;   (var "name" bty)
+
+  (cond ((atom x) x)
+        ((atom (cdr x))
+         (cons (l3-reparse (car x))
+               (cdr x)))
+        (t (case (car x)
+             (bvar (cons (list 'var (cadr x) 'bty)
+                         (l3-reparse (cddr x))))
+             (nvar (cons (list 'var (cadr x) 'nty)
+                         (l3-reparse (cddr x))))
+             (ivar (cons (list 'var (cadr x) 'ity)
+                         (l3-reparse (cddr x))))
+             (qvar (cons 'qvar
+                         (l3-reparse (cddr x))))
+             (svar (cons (list 'var (cadr x) 'sty)
+                         (l3-reparse (cddr x))))
+             (uvar (cons (list 'var (cadr x) 'uty)
+                         (l3-reparse (cddr x))))
+             (vvar (cons (list 'var (cadr x) 'vty)
+                         (l3-reparse (cddr x))))
+             (cty  (cons (list 'cty (cadr x))
+                         (l3-reparse (cddr x))))
+             (otherwise (cons (l3-reparse (car x))
+                              (l3-reparse (cdr x))))))))
+
+; At this point we get lazy.  If we want to convert to guard-verified :logic
+; mode then at a minimum, we'll need to define a "good-bindings-p" predicate
+; that says that sym-to-str and str-to-sym are alists mapping symbols to/from
+; strings.
+(program)
+
+(defun l3-trans-constant (s ctx bindings)
+
+; S is expected to be a string (we cause an error if not).  We translate s to a
+; constant symbol or nil.
+
+  (declare (xargs :stobjs bindings))
+  (cond
+   ((not (stringp s))
+    (trans-err ctx
+               "String expected, but got:~|~x0"
+               s))
+   (t (trans-value (cdr (assoc-equal s (str-to-const bindings)))))))
+
+(defun l3-trans-sym (s ctx bindings)
+
+; S is expected to be a string (we cause an error if not).  We translate s to a
+; symbol, using bindings and avoiding the returning of symbol ST$.
+
+  (declare (xargs :stobjs bindings))
+  (cond
+   ((not (stringp s))
+    (trans-err ctx
+               "String expected, but got:~|~x0"
+               s))
+   ((string-equal s "ST$")
+    (trans-err ctx
+               "The name ST$ is reserved."))
+   (t (let* ((str-to-sym (str-to-sym bindings))
+             (pair (assoc-equal s str-to-sym)))
+        (cond
+         (pair (trans-value (cdr pair)))
+         (t
+          (let* ((sym (intern (string-upcase (if (position #\' s)
+                                                 (substitute #\- #\' s)
+                                               s))
+                              "ACL2"))
+                 (sym-to-str (sym-to-str bindings))
+                 (pair (assoc-eq sym sym-to-str)))
+            (cond
+             ((null pair)
+              (let* ((bindings (update-str-to-sym (acons s sym str-to-sym)
+                                                  bindings))
+                     (bindings (update-sym-to-str (acons sym s sym-to-str)
+                                                  bindings)))
+                (trans-value sym)))
+             (t (trans-err ctx
+                           "Strings ~x0 and ~x1 both map to symbol '~x2.  ~
+                            Re-run with keyword argument :STR-TO-SYM set to ~
+                            an alist that binds at least one of these strings ~
+                            to some other symbol."
+                           (cdr pair) s sym))))))))))
+
+(defun l3-trans-type-expr (texpr ctx bindings)
+
+; Texpr is a type-expression, which we want to translate to a corresponding
+; symbolic type expression or a list of such.  For example, the type-expression
+
+; (PTy (CTy "funcT")
+;      (PTy (CTy "shiftT")
+;           (PTy (FTy 7)
+;                (PTy (FTy 7)
+;                     (FTy 7)))))
+
+; translates to the list:
+
+; (funct shiftt (unsigned-byte 7) (unsigned-byte 7) (unsigned-byte 7))
+
+; Also, for example, (lty (CTy "instruction")) translates to instruction-list.
+
+  (declare (xargs :stobjs bindings))
+  (case-match texpr
+    (('cty s)
+     (l3-trans-sym s ctx bindings))
+    (('pty t1 t2)
+     (trans-er-let*
+      ((x1 (l3-trans-type-expr t1 ctx bindings))
+       (x2 (l3-trans-type-expr t2 ctx bindings)))
+      (trans-value (if (and (consp t2)
+                            (eq (car t2) 'pty))
+                       (cons x1 x2)
+                     (list x1 x2)))))
+    (('fty n)
+     (cond ((posp n)
+            (trans-value (list 'unsigned-byte n)))
+           (t (trans-err ctx
+                         "Unexpected type expression:~|~x0"
+                         texpr))))
+    (('lty t1)
+     (trans-er-let*
+      ((x1 (l3-trans-type-expr t1 ctx bindings)))
+      (trans-value (type-list-name x1))))
+    (('oty t1)
+     (trans-er-let*
+      ((x1 (l3-trans-type-expr t1 ctx bindings)))
+      (trans-value (list 'oty x1))))
+    (& (case texpr
+         (F1 (trans-value (list 'unsigned-byte 1)))
+         (F4 (trans-value (list 'unsigned-byte 4)))
+         (F8 (trans-value (list 'unsigned-byte 8)))
+         (F16 (trans-value (list 'unsigned-byte 16)))
+         (F32 (trans-value (list 'unsigned-byte 32)))
+         (F64 (trans-value (list 'unsigned-byte 64)))
+         (bTy (trans-value 'bty))
+         (sTy (trans-value 'sty))
+         (uTy (trans-value 'uty))
+         (qTy (trans-value 'qty))
+         (otherwise
+          (trans-err ctx
+                     "Unexpected type expression:~|~x0"
+                     texpr))))))
+
+(defun l3-trans-construct-1 (cl ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (case-match cl
+    ((s '[])
+     (l3-trans-sym s ctx bindings))
+    ((s ('sqbkt texpr))
+     (trans-er-let*
+      ((sym (l3-trans-sym s ctx bindings))
+       (texpr (l3-trans-type-expr texpr ctx bindings)))
+      (trans-value (list sym texpr))))
+    (& (trans-err ctx
+                  "Illegal CONSTRUCT clause:~|~x0"
+                  cl))))
+
+(defun l3-trans-construct-rec (clauses ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (cond ((endp clauses)
+         (trans-value nil))
+        (t (trans-er-let*
+            ((cl (l3-trans-construct-1 (car clauses) ctx bindings))
+             (x (l3-trans-construct-rec (cdr clauses) ctx bindings)))
+            (trans-value (cons cl x))))))
+
+(defun construct-constructors (clauses)
+
+; Clauses is the second argument of a construct form.  We skip over atomic
+; members of clauses, but for each cons (constructor-name types), we collect up
+; constructor-name.
+
+  (cond ((endp clauses) nil)
+        ((atom (car clauses))
+         (construct-constructors (cdr clauses)))
+        (t (cons (caar clauses)
+                 (construct-constructors (cdr clauses))))))
+
+(defun l3-trans-construct (name clauses ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (trans-er-let*
+   ((sym (l3-trans-sym name ctx bindings))
+    (x (l3-trans-construct-rec clauses ctx bindings)))
+   (let* ((field-names (construct-constructors x))
+          (old-construct-alist (construct-alist bindings))
+          (bindings (if field-names
+                        (update-construct-alist
+                         (put-assoc-eq sym field-names old-construct-alist)
+                         bindings)
+                      bindings)))
+     (trans-value (list 'construct sym x)))))
+
+(defmacro extend-st$-fields (sym-expr val)
+
+; Sym-expr is an expression whose value is a tuple (trans-value sym), where sym
+; is the (translated) name of an st$ field.  Val is to be associated with that
+; name in the st$-fields of bindings.
+
+  `(trans-er-let*
+    ((sym ,sym-expr))
+    (let ((bindings
+           (update-st$-fields (put-assoc-eq sym ,val (st$-fields bindings))
+                              bindings)))
+      (trans-value sym))))
+
+(defun l3-trans-st$-field (field ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (case-match field
+    ((name ('CTy &))
+     (extend-st$-fields (l3-trans-sym name ctx bindings) nil))
+    ((name ('ATy t1 t2))
+     (trans-er-let*
+      ((x1 (l3-trans-type-expr t1 ctx bindings))
+       (x2 (l3-trans-type-expr t2 ctx bindings)))
+      (case-match x1
+        (('unsigned-byte n)
+         (let ((expt-2-n (expt 2 n)))
+           (trans-er-let*
+            ((sym (extend-st$-fields (l3-trans-sym name ctx bindings)
+                                     expt-2-n)))
+            (trans-value
+             (case-match x2
+               (('unsigned-byte &)
+                `(,sym :type (array ,x2 (,expt-2-n)) :initially 0))
+               (&
+                `(,sym :type (array t (,expt-2-n)))))))))
+        (& (trans-err ctx
+                      "Illegal defstobj array field spec:~|~x0"
+                      field)))))
+    ((name t1)
+     (trans-er-let*
+      ((sym (extend-st$-fields (l3-trans-sym name ctx bindings) nil))
+       (x1 (l3-trans-type-expr t1 ctx bindings)))
+      (cond
+       ((and (consp x1)
+             (eq (car x1) 'unsigned-byte))
+        (trans-value `(,sym :type ,x1 :initially 0)))
+       ((symbolp x1)
+        (trans-value `(,sym :type (satisfies ,(make-type x1)))))
+       (t
+        (trans-value `(,sym)))
+
+; If x1 is an option type expression, or for that matter any other type
+; expression not handled above, we simply make no contraints on the type of the
+; field.  This seems harmless enough for now, though we may want to revisit it
+; when we start doing proofs.
+
+;       (trans-err ctx
+;                  "Unexpected type for stobj field, ~x0"
+;                  x1)
+       )))
+    (& (trans-err ctx
+                  "Illegal defstobj field spec:~|~x0"
+                  field))))
+
+(defun l3-trans-st$-fields (fields ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (cond ((endp fields) (trans-value nil))
+        (t (trans-er-let*
+            ((field (l3-trans-st$-field (car fields) ctx bindings))
+             (fields (l3-trans-st$-fields (cdr fields) ctx bindings)))
+            (trans-value (cons field fields))))))
+
+(defun l3-trans-st$ (fields ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (trans-er-let*
+   ((tfields (l3-trans-st$-fields fields ctx bindings)))
+   (trans-value `(defstobj+ st$ ,@tfields))))
+
+(defun l3-trans-record (name fields ctx bindings)
+; !! Needs to be written.
+; Example:
+; ("CauseRegister" (sqbkt ("'rst" (FTy 27)) ("ExcCode" (FTy 5))))
+; so name is "CauseRegister"
+  (declare (xargs :stobjs bindings)
+           (ignore fields))
+  (trans-err ctx
+             "Sorry: l3-trans-record is not yet implemented (attempted to ~
+              translate a record definition for name ~x0)."
+             name))
+
+(mutual-recursion
+
+(defun l3-get-type-mop (mop expr ctx bindings)
+; Keep in sync with l3-trans-map.
+; !! Need to support fst and snd.
+  (declare (xargs :stobjs bindings))
+  (case-match mop
+    ('length (trans-value '(integer 0 *)))
+    ('bnot (l3-get-type expr ctx bindings))
+    ('not (trans-value 'bty))
+    (('cast x)
+     (l3-trans-type-expr x ctx bindings))
+    (& (trans-err ctx
+                  "Unimplemented mop for l3-get-type-mop: ~x0"
+                  mop))))
+
+(defun l3-get-type (l3-expr ctx bindings)
+
+; Warning: keep in sync with l3-trans-expr and expr-st$-out-p.
+
+; Return the translated type of expr.
+
+  (declare (xargs :stobjs bindings))
+  (case-match l3-expr
+    ('lu (trans-value 'uTy))
+    ('qvar (trans-value 'qTy))
+    ('lt (trans-value 'bty))
+    ('lf (trans-value 'bty))
+    (('lnl typ)
+     (l3-trans-type-expr typ ctx bindings))
+    (('llc ('sqbkt &) expr)
+     (l3-get-type expr ctx bindings))
+    (('ll ('sqbkt . exprs))
+     (cond ((null exprs) ; maybe impossible?
+            (trans-value 'null))
+           (t (trans-er-let*
+               ((x (l3-get-type (car exprs) ctx bindings)))
+               (cond ((symbolp x)
+                      (trans-value (type-list-name x)))
+                     (t (trans-err ctx
+                                   "~x0 doesn't know how to get the type for ~
+                                     expression~|  ~x1~|because it doesn't ~
+                                     know how to get the list type ~
+                                     corresponding to the type ~x2."
+                                   'l3-get-type
+                                   l3-expr
+                                   x)))))))
+    (('var & typ)
+     (l3-trans-type-expr typ ctx bindings))
+    (('avar typ)
+     (l3-trans-type-expr typ ctx bindings))
+    (('lc & typ)
+     (l3-trans-type-expr typ ctx bindings))
+    (('const & typ)
+     (l3-trans-type-expr typ ctx bindings))
+    (('lw & n)
+     (trans-value `(unsigned-byte ,n)))
+    (('tp ('sqbkt . args))
+     (l3-get-type-lst args ctx bindings))
+    (('ite & expr1 expr2) ; same as for bop (except for error message)
+     (trans-er-let*
+      ((x1 (l3-get-type expr1 ctx bindings))
+       (x2 (l3-get-type expr2 ctx bindings)))
+      (cond ((equal x1 x2)
+             (trans-value x1))
+            (t (trans-er
+                "Obtained different types for second and third arguments of ~
+                 expression~|~x0~|, as follow.~|  True-branch: ~
+                 ~x1~|  False-branch: ~x2"
+                l3-expr x1 x2)))))
+    (('bop & expr1 expr2) ; same as for ite (except for error message)
+     (trans-er-let*
+      ((x1 (l3-get-type expr1 ctx bindings))
+       (x2 (l3-get-type expr2 ctx bindings)))
+      (cond ((equal x1 x2)
+             (trans-value x1))
+            (t (trans-er
+                "Obtained different types for second and third arguments of ~
+                 expression~|~x0~|, as follow.~|  True-branch: ~
+                 ~x1~|  False-branch: ~x2"
+                l3-expr x1 x2)))))
+    (('mop mop expr1)
+     (l3-get-type-mop mop expr1 ctx bindings))
+    (('apply ('const & ('ATy 'qTy t1)) 'qvar)
+     (l3-trans-type-expr t1 ctx bindings))
+    (('apply ('call & ('ATy 'qTy typ) &) &)
+     (l3-trans-type-expr typ ctx bindings))
+    (('apply ('dest & ('ATy & typ) 'qvar) &)
+; !! Need to consider records other than the state record.
+     (l3-trans-type-expr typ ctx bindings))
+    (('dest & typ 'qvar)
+; !! Need to consider records other than the state record.
+     (l3-trans-type-expr typ ctx bindings))
+    (('rupd & &)
+; !! Need to consider records other than the state record.
+     (trans-value 'qTy))
+    (('call & typ &)
+     (l3-trans-type-expr typ ctx bindings))
+    (('cs & ('sqbkt (& x) . &))
+; We could check that all clauses give the same type, but that seems
+; unnecessary at this point.
+     (l3-get-type x ctx bindings))
+    (('let & & x)
+     (l3-get-type x ctx bindings))
+    (('cc ('sqbkt . lst))
+     (trans-er-let*
+      ((n (l3-trans-width-lst lst ctx bindings)))
+      (trans-value `(unsigned-byte ,n))))
+    (('bl n x)
+     (trans-er-let*
+      ((typ (l3-get-type x ctx bindings)))
+      (let ((expected `(unsigned-byte ,n)))
+        (cond ((equal typ expected)
+               (trans-value typ))
+              (t (trans-err ctx
+                            "Unexpected type, ~x0, for ~x1 (expected type to ~
+                             be ~x2), in expression:~|~x3."
+                           typ x expected l3-expr))))))
+    (('ex & & & typ)
+     (l3-trans-type-expr typ ctx bindings))
+    (('eq & &)
+     (trans-value `bty))
+    (& (trans-err ctx
+                  "Unrecognized type expresion: ~x0"
+                  l3-expr))))
+
+(defun l3-get-type-lst (lst ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (cond ((endp lst) (trans-value nil))
+        (t (trans-er-let*
+            ((x1 (l3-get-type (car lst) ctx bindings))
+             (x2 (l3-get-type-lst (cdr lst) ctx bindings)))
+            (trans-value (cons x1 x2))))))
+
+(defun l3-trans-width (x ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (trans-er-let*
+   ((typ (l3-get-type x ctx bindings)))
+   (case-match typ
+     (('unsigned-byte n)
+      (trans-value n))
+     (& (trans-err ctx
+                   "Unable to compute bit width for ~x0."
+                   x)))))
+
+(defun l3-trans-width-lst (lst ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (cond ((endp lst) (trans-value 0))
+        (t (trans-er-let*
+            ((n1 (l3-trans-width (car lst) ctx bindings))
+             (n2 (l3-trans-width-lst (cdr lst) ctx bindings)))
+            (trans-value (+ n1 n2))))))
+)
+
+(defun l3-trans-st$-field-name (field array-p update-p ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (trans-er-let*
+   ((sym (l3-trans-sym field ctx bindings)))
+   (let ((pair (assoc-eq sym (st$-fields bindings)))
+         (key2 (if array-p :array :non-array)))
+     (cond ((null pair)
+            (trans-err ctx
+                       "Implementation error: Failed to find symbol ~x0 (from ~
+                        field ~x1) in ~x2"
+                       sym field '(st$-fields bindings)))
+           ((not (iff (cdr pair) array-p))
+            (trans-err ctx
+                       "Implementation error: symbol ~x0 (from field ~x1) is ~
+                        associated in ~x2 with ~x3, but array-p is ~x4 in ~
+                        call:~|~x5"
+                       sym field '(st$-fields bindings) (cdr pair) array-p
+                       `(l3-trans-st$-field-name
+                         ,field ,array-p ,update-p ,ctx bindings)))
+           ((eq update-p 'map)
+            (trans-value (stobj-mapper-name
+                          (defstobj-fnname sym :updater key2 nil)
+                          nil)))
+           (update-p (trans-value (defstobj-fnname sym :updater key2 nil)))
+           (t (trans-value (defstobj-fnname sym :accessor key2 nil)))))))
+
+(defun type-st$-out-p (x n)
+
+; This function is called at the top level with n = nil.
+
+; X is an untranslated type.  We return a non-nil result iff x represents
+; state.  If x is a pair type, then in that case we return n+k where state is
+; the kth component of the resulting tuple; otherwise we return t.
+
+  (case-match x
+    ('qty (or n t))
+    (('pty 'qty &) n)
+    (('pty & x2)
+     (type-st$-out-p x2
+                     (if (null n) 1 (1+ n))))
+    (& nil)))
+
+(mutual-recursion
+
+(defun expr-st$-out-p (x)
+
+; Warning: keep in sync with l3-get-type and l3-trans-expr.
+
+; X is an untranslated expression.  We return t if x represents a value of st$,
+; n if x represents an mv for which component number n (0-based) represents a
+; value of st$, and nil otherwise.
+
+  (case-match x
+    ('lu nil)
+    ('qvar t)
+    ('lt nil)
+    ('lf nil)
+    (('lnl &) nil)
+    (('llc . &) nil)
+    (('ll . &) nil)
+    (('var & &) nil)
+    (('avar typ)
+     (not (eq typ 'qty)))
+    (('lc & &) nil)
+    (('const & &) nil)
+    (('lw & &) nil)
+    (('tp ('sqbkt . args))
+     (expr-st$-out-listp args 0))
+    (('ite & tbr fbr)
+     (let ((x1 (expr-st$-out-p tbr))
+           (x2 (expr-st$-out-p fbr)))
+       (cond ((not (eq x1 x2))
+              (cond ((iff x1 x2)
+                     (er hard 'expr-st$-out-p
+                         "Surprise!  Expr-st$-out-p returns different state ~
+                          resutls, ~x0 and ~x1, for the two branches of an ~
+                          ITE expression:~|~x2"
+                         x1 x2 x))
+                    (t
+                     (er hard 'expr-st$-out-p
+                         "Surprise!  The following ITE expression seems to ~
+                          return state in its ~s0 branch but not in its ~s1 ~
+                          branch:~|~x2"
+                         (if x1 "true" "false")
+                         (if x1 "false" "true")
+                         x))))
+             (t (or x1 x2)))))
+    (('bop . &) nil)
+    (('mop . &) nil)
+    (('apply ('const & ('ATy 'qTy t1)) 'qvar)
+     (type-st$-out-p t1 nil))
+    (('apply ('call & ('ATy & t1) &) &)
+     (type-st$-out-p t1 nil))
+    (('apply ('dest & & &) &) nil)
+    (('dest & & &) nil)
+    (('rupd & &) t)
+; !! Need to consider records other than the state record.
+    (('call & t1 &)
+     (type-st$-out-p t1 nil))
+    (('cs & ('sqbkt (& x1) . &))
+     (expr-st$-out-p x1))
+    (('let ('tp ('sqbkt . lst)) & &)
+     (expr-st$-out-listp lst 0))
+    (('let var & &)
+     (eq var 'st$))
+    (('cc ('sqbkt . &)) nil)
+    (('bl & &) nil)
+    (('ex & & & &) nil)
+    (('ln &) nil)
+    (('eq & &) nil)
+    (& (er hard 'expr-st$-out-p
+           "Unrecognized expresion: ~x0"
+           x))))
+
+(defun expr-st$-out-listp (x n)
+  (cond ((endp x) nil)
+        ((expr-st$-out-p (car x)) n)
+        (t (expr-st$-out-listp (cdr x) (1+ n)))))
+)
+
+(defun lift-st$-lst (args lst)
+
+; !! Consider redoing to better match lift-st$, or maybe even eliminate this
+; function if possible and only use lift-st$.
+
+; Keep in sync with lift-st$.
+
+; Args is a list of l3 expressions and lst is the corresponding list of
+; translations.  We return (mv let-sym bs new-lst), where let-sym is nil, t,
+; let, or let*; bs is a list of bindings for let or let* (according to
+; let-sym); and new-lst is the result of replacing an element e of lst that
+; represents st$, by st$ itself.  The intention is that either let-sym is nil
+; or t, in which case lst is returned unchanged, or else e is equal to (let-sym
+; bs st).  Also, lst contains an expression representing st$ if and only if
+; let-sym is non-nil.
+
+  (let ((posn (expr-st$-out-listp args 0)))
+    (cond
+     (posn (let ((st$-expr (nth posn lst)))
+             (case-match st$-expr
+               ('st$ (mv t nil lst))
+               (('let (('st$ e)) body) ; assume single-threadedness:
+                (mv 'let
+                    `((st$ ,e))
+                    (update-nth posn body lst)))
+               (('let* bindings body) ; assume single-threadedness:
+                (cond ((equal (remove-duplicates-eq (strip-cars bindings))
+                              '(st$))
+                       (mv 'let*
+                           bindings
+                           (update-nth posn body lst)))
+                      (t (mv 'let
+                             `((st$ ,st$-expr))
+                             (update-nth posn 'st$ lst)))))
+               (&
+                (mv 'let
+                    `((st$ ,st$-expr))
+                    (update-nth posn 'st$ lst))))))
+     (t (mv nil nil lst)))))
+
+(defun lift-st$ (call posn)
+
+; Keep in sync with lift-st$-lst.
+
+; Call is (fn arg1 ... argk) and posn is the position (0-based in the call,
+; 1-based in (arg1 ... argk)) of the st$ argument, which might be an expression
+; other than 'st$ itself.  We rewrite call to make ACL2's single-threadedness
+; check happy.
+
+  (let ((st$-expr (nth posn call)))
+    (case-match st$-expr
+      ('st$ call)
+      (('let (('st$ e)) body) ; assume single-threadedness:
+       `(let* ((st$ ,e)
+               (st$ ,body))
+          ,(update-nth posn 'st$ call)))
+      (('let* bindings body) ; assume single-threadedness:
+       (cond ((equal (remove-duplicates-eq (strip-cars bindings))
+                     '(st$))
+              `(let* ,(append bindings `((st$ ,body)))
+                 ,(update-nth posn 'st$ call)))
+             (t `(let ((st$ ,st$-expr))
+                   ,(update-nth posn 'st$ call)))))
+      (&
+       `(let ((st$ ,st$-expr))
+          ,(update-nth posn 'st$ call))))))
+
+(mutual-recursion
+
+(defun l3-trans-expr (patp l3-expr ctx bindings)
+
+; Warning: keep in sync with l3-get-type and expr-st$-out-p.
+
+  (declare (xargs :stobjs bindings))
+  (case-match l3-expr
+    ('lu (trans-value '(unit-value)))
+    ('qvar (trans-value 'st$))
+    ('lt (trans-value '(true)))
+    ('lf (trans-value '(false)))
+    (('lnl &) (trans-value (if patp ''nil nil)))
+    (('llc ('sqbkt expr1) expr2)
+     (trans-er-let*
+      ((x1 (l3-trans-expr patp expr1 ctx bindings))
+       (x2 (l3-trans-expr patp expr2 ctx bindings)))
+      (trans-value (if patp
+                       `(,x1 . ,x2)
+                     `(cons ,x1 ,x2)))))
+    (('ll ('sqbkt . lst))
+     (trans-er-let*
+      ((x (l3-trans-expr-lst patp lst ctx bindings)))
+      (trans-value (cond (patp ; (not (equal patp nil))
+                          lst)
+                         (t (cons 'list x))))))
+    (('var s &)
+     (l3-trans-sym s ctx bindings))
+    (('avar &)
+; Anthony expects that user code will only generate avar terms within case
+; expressions.
+     (trans-value '&))
+    (('lc s &) ; enumerated type constant
+     (trans-er-let*
+      ((sym (l3-trans-sym s ctx bindings)))
+      (trans-value (kwote sym))))
+    (('const s &) ; non-enumerated type constant, or a def0-defined constant
+     (trans-er-let*
+      ((const (l3-trans-constant s ctx bindings)))
+      (cond (const ; def0 case
+             (trans-value const))
+            (t (trans-er-let*
+                ((sym (l3-trans-sym s ctx bindings)))
+                (trans-value (kwote sym)))))))
+    (('lw i &)
+     (trans-value i))
+    (('tp ('sqbkt . args))
+     (trans-er-let*
+      ((lst (l3-trans-expr-lst patp args ctx bindings)))
+      (trans-value
+       (cond
+        (patp lst)
+        (t (mv-let (let-sym bs new-lst)
+                   (lift-st$-lst args lst)
+                   (cond ((null let-sym) (cons 'tuple lst))
+                         ((eq let-sym t) (cons 'mv lst))
+                         (t `(,let-sym ,bs (mv ,@new-lst))))))))))
+    (('ite . args)
+     (trans-er-let*
+      ((lst (l3-trans-expr-lst nil args ctx bindings)))
+      (trans-value (cons 'if lst))))
+    (('bop sym expr1 expr2)
+; !! Should really cause an error here, and in many other analogous places, if
+; patp is true, because we don't have a way of matching a function call (other
+; than cons).
+     (l3-trans-bop sym expr1 expr2 ctx bindings))
+    (('mop mop expr)
+     (l3-trans-mop mop expr ctx bindings))
+    (('apply ('const s &) 'qvar)
+     (trans-er-let*
+      ((sym (l3-trans-sym s ctx bindings)))
+      (trans-value `(,sym st$))))
+    (('apply ('call s typ expr1) expr2)
+     (trans-er-let*
+      ((sym (l3-trans-sym s ctx bindings))
+       (x1 (l3-trans-expr patp expr1 ctx bindings))
+       (x2 (l3-trans-expr patp expr2 ctx bindings)))
+      (cond ((eq sym 'raise-exception)
+             (case-match typ
+               (('ATy 'qTy ('PTy typ1 'qTy))
+                (trans-er-let*
+                 ((t1 (l3-trans-type-expr typ1 ctx bindings)))
+                 (trans-value
+                  (let ((type-term `(arb ,t1)))
+                    (cond
+                     ((eq x2 'st$)
+                      `(,sym ,x1 ,type-term ,x2))
+                     (t `(let ((st$ ,x2))
+                           (,sym ,x1 ,type-term st$))))))))
+               (& (trans-err ctx
+                             "Unexpected type encountered for raise-exception ~
+                              term:~|~x0"
+                             l3-expr))))
+            ((eq x2 'st$)
+             (trans-value `(,sym ,x1 ,x2)))
+            (t (trans-value `(let ((st$ ,x2))
+                               (,sym ,x1 st$)))))))
+    (('apply ('dest field & 'qvar) expr)
+; !! Need to consider records other than the state record.
+     (trans-er-let*
+      ((sym (l3-trans-st$-field-name field t nil ctx bindings))
+       (x (l3-trans-expr patp expr ctx bindings)))
+      (trans-value `(,sym ,x st$))))
+    (('dest field & 'qvar)
+; !! Need to consider records other than the state record.
+     (trans-er-let*
+      ((sym (l3-trans-st$-field-name field nil nil ctx bindings)))
+      (trans-value `(,sym st$))))
+    (('rupd field ('tp ('sqbkt st$-expr
+                               ('mop ('k1 &) init-expr))))
+
+; !! Need to consider records other than the state record.  To elaborate:
+
+; The above needs to be modified for the case that we are updating other than
+; the state.  Probably we can just test, using expr-st$-out-p, whether st$-expr
+; is a state expression.  If true, then use what's below.  If false, then think
+; about what to use for the non-state case of record update.
+
+; E.g.:
+; (RUPD "R" (TP (SQBKT QVAR (MOP (K1 (FTY 7)) (LW 0 32)))))
+; translates to:
+; (map-update-r 0 st$)
+
+     (trans-er-let*
+      ((sym (l3-trans-st$-field-name field t 'map ctx bindings))
+       (trans-st$-expr (l3-trans-expr patp st$-expr ctx bindings))
+       (trans-init-expr (l3-trans-expr patp init-expr ctx bindings)))
+      (trans-value
+       (lift-st$ `(,sym ,trans-init-expr ,trans-st$-expr) 2))))
+    (('rupd field ('tp ('sqbkt st$-expr
+                               ('Fupd ('Dest field & 'qVar)
+                                      index
+                                      value))))
+; !! Need to consider records other than the state record.
+; See comment for first rupd case above.
+     (trans-er-let*
+      ((sym (l3-trans-st$-field-name field t t ctx bindings))
+       (trans-st$-expr (l3-trans-expr patp st$-expr ctx bindings))
+       (i (l3-trans-expr patp index ctx bindings))
+       (v (l3-trans-expr patp value ctx bindings)))
+      (trans-value (lift-st$ `(,sym ,i ,v ,trans-st$-expr) 3))))
+    (('rupd field ('tp ('sqbkt st$-expr expr)))
+; !! Need to consider records other than the state record.
+; See comment for first rupd case above.
+     (trans-er-let*
+      ((sym (l3-trans-st$-field-name field nil t ctx bindings))
+       (trans-st$-expr (l3-trans-expr patp st$-expr ctx bindings))
+       (v (l3-trans-expr patp expr ctx bindings)))
+      (trans-value (lift-st$ `(,sym ,v ,trans-st$-expr) 2))))
+    (('call s typ expr)
+     (trans-er-let*
+      ((sym (l3-trans-sym s ctx bindings))
+       (x (l3-trans-expr patp expr ctx bindings))
+       (trans-typ (l3-trans-type-expr typ ctx bindings)))
+      (case-match typ
+        (('cty &)
+         (cond ((member-eq sym
+                           (cdr (assoc-eq trans-typ
+                                          (construct-alist bindings))))
+                (trans-value
+                 (cond (patp `(',sym ,x))
+                       (t `(call-constructor ,trans-typ ,sym ,x)))))
+               (patp (trans-err ctx
+                                "We do not know how to translate this ~
+                                 function call into a case-match+ ~
+                                 pattern:~|~x0"
+                                l3-expr))
+               (t (trans-value `(,sym ,x)))))
+        (& (cond (patp (trans-err ctx
+                                  "We do not know how to translate this ~
+                                   function call into a case-match+ ~
+                                   pattern:~|~x0"
+                                  l3-expr))
+                 (t (trans-value `(,sym ,x))))))))
+    (('cs case-expr ('sqbkt . clauses))
+     (trans-er-let*
+      ((typ (l3-get-type l3-expr ctx bindings))
+       (x (l3-trans-expr patp case-expr ctx bindings))
+       (c (l3-trans-cs-clauses clauses typ ctx bindings)))
+      (trans-value `(case-match+ ,x ,@c))))
+    (('let expr0 expr1 expr2)
+     (trans-er-let*
+      ((x1 (l3-trans-expr patp expr1 ctx bindings))
+       (x2 (l3-trans-expr patp expr2 ctx bindings)))
+      (let ((stobjs-out (term-stobjs-out x1 nil (bw bindings))))
+        (case-match expr0
+          (('tp ('sqbkt . lst))
+           (let ((let-macro (cond
+                             ((and (consp x1)
+                                   (eq (car x1) 'bl))
+                              'mv-let-ignorable)
+                             ((or (and (consp stobjs-out)
+                                       (consp (cdr stobjs-out)))
+                                  (member-eq 'qvar lst))
+                              'mv-let)
+                             (t 'slet))))
+             (trans-er-let*
+              ((x0 (l3-trans-expr-lst nil lst ctx bindings)))
+              (trans-value `(,let-macro ,x0 ,x1 ,x2)))))
+          (& (cond ((and (consp stobjs-out)
+                         (consp (cdr stobjs-out)))
+                    (trans-err ctx
+                               "Attempted to bind non-tuple expression,~|  ~
+                                ~x0,~|to expression generating stobjs-out = ~
+                                ~x1:~|~x2"
+                               expr0 stobjs-out expr1))
+                   (t (trans-er-let*
+                       ((x0 (l3-trans-expr patp expr0 ctx bindings)))
+                       (trans-value
+                        (case-match x2
+                          (('let (b) body)
+                           `(let* ((,x0 ,x1) ,b) ,body))
+                          (('let* bs body)
+                           `(let* ((,x0 ,x1) ,@bs) ,body))
+                          (& `(let ((,x0 ,x1)) ,x2))))))))))))
+    (('cc ('sqbkt . lst))
+     (trans-er-let*
+      ((x (l3-trans-cc-exprs lst ctx bindings)))
+      (trans-value (cons 'cat x))))
+    (('bl n expr)
+     (cond ((natp n)
+            (trans-er-let*
+             ((x (l3-trans-expr patp expr ctx bindings)))
+             (trans-value `(bl ,n ,x))))
+           (t (trans-err ctx
+                         "The first argument of BL is expected to be a natp, ~
+                          which is not the case for:~|~x0."
+                         l3-expr))))
+    (('ex expr0 expr1 expr2 &)
+     (trans-er-let*
+      ((x0 (l3-trans-expr patp expr0 ctx bindings))
+       (x1 (l3-trans-expr patp expr1 ctx bindings))
+       (x2 (l3-trans-expr patp expr2 ctx bindings)))
+      (trans-value `(bits ,x0 ,x1 ,x2))))
+    (('ln n) ; only for l3-trans-expr (not for l3-get-type)
+     (trans-value n))
+    (('eq expr1 expr2)
+     (trans-er-let*
+      ((x1 (l3-trans-expr patp expr1 ctx bindings))
+       (x2 (l3-trans-expr patp expr2 ctx bindings)))
+      (let ((eq-sym (cond ((or (case-match x1
+                                 (('quote sym)
+                                  (symbolp sym)))
+                               (case-match x2
+                                 (('quote sym)
+                                  (symbolp sym))))
+                           'eq)
+                          ((or (acl2-numberp x1)
+                               (acl2-numberp x2))
+                           'eql)
+                          (t 'equal))))
+        (trans-value `(,eq-sym ,x1 ,x2)))))
+    (& (trans-err ctx
+                  "Unrecognized expresion: ~x0"
+                  l3-expr))))
+
+(defun l3-trans-cs-clauses (clauses typ ctx bindings)
+
+; Note that typ is a translated type.
+
+  (declare (xargs :stobjs bindings))
+  (trans-er-let*
+   ((trans-clauses (l3-trans-cs-clauses-rec clauses ctx bindings)))
+   (let* ((cl (car (last trans-clauses)))
+          (tst (car cl)))
+     (cond ((eq tst '&)
+            (trans-value trans-clauses))
+           (t (trans-value
+               (append trans-clauses
+                       `((& (assert! nil
+
+; Here we assume that if the processor state st$ is returned, then it is
+; returned as st$ or (mv .. st$).
+
+                                     ,(case-match typ
+                                        ('qty 'st$)
+                                        ((t0 'qty)
+                                         `(mv (arb ,t0) st$))
+                                        (&
+                                         `(arb ,typ)))))))))))))
+
+(defun l3-trans-cs-clauses-rec (clauses ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (cond ((endp clauses)
+         (trans-value nil))
+        (t (trans-er-let*
+            ((tst (l3-trans-expr t (caar clauses) ctx bindings))
+             (val (l3-trans-expr nil (cadar clauses) ctx bindings))
+             (rst (l3-trans-cs-clauses-rec (cdr clauses) ctx bindings)))
+            (trans-value (cons (list tst val) rst))))))
+
+(defun l3-trans-bop (bop expr1 expr2 ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (trans-er-let*
+   ((type (l3-get-type expr1 ctx bindings))
+    (texpr1 (l3-trans-expr nil expr1 ctx bindings))
+    (texpr2 (l3-trans-expr nil expr2 ctx bindings)))
+   (case bop
+     ((Add Sub Mul Bit)
+      (case-match type
+        (('unsigned-byte n) ; ((quote unsigned-byte) n)
+         (let ((fn (cdr (or (assoc-eq bop
+                                      '((add . n+)
+                                        (sub . n-)
+                                        (mul . n*)
+                                        (bit . logbitp)))
+                            (er hard ctx
+                                "Implementation error for bop: ~x0"
+                                bop)))))
+           (trans-value `(,fn ,n ,texpr1 ,texpr2))))
+        (& (trans-err ctx
+                      "Illegal ~x0 type:~|~x1"
+                      type))))
+     ((BAnd BOr BXor
+            Lt Gt Le Ge
+            And Or)
+      (let ((fn (cdr (or (assoc-eq bop
+                                   '((band . logand)
+                                     (bor . logior)
+                                     (bxor . logxor)
+                                     (lt . <)
+                                     (gt . >)
+                                     (le . <=)
+                                     (ge . >=)
+                                     (and . and)
+                                     (or . or)))
+                         (er hard ctx
+                             "Implementation error for bop: ~x0"
+                             bop)))))
+        (trans-value `(,fn ,texpr1 ,texpr2))))
+     (Ror (trans-value `(ash ,texpr1
+                             ,(cond ((natp texpr2)
+                                     (- texpr2))
+                                    (t (list '- texpr2))))))
+     (otherwise (trans-err ctx
+                           "Unimplemented bop: ~x0"
+                           bop)))))
+
+(defun l3-trans-mop (mop expr ctx bindings)
+; Keep in sync with l3-get-type-mop.
+  (declare (xargs :stobjs bindings))
+  (trans-er-let*
+   ((from-type (l3-get-type expr ctx bindings))
+    (trans-expr (l3-trans-expr nil expr ctx bindings)))
+   (case-match mop
+     ('length (trans-value (list 'len trans-expr)))
+     ('bnot (trans-value (list 'lognot trans-expr)))
+     ('not (trans-value (list 'not trans-expr)))
+     ('fst (trans-value (list 'car trans-expr)))
+     ('snd (trans-er-let*
+            ((t1 (l3-get-type trans-expr ctx bindings)))
+            (trans-value (list (case-match t1
+                                 ((& &)
+; second arg of input pair isn't itself a pair
+                                  'cadr)
+                                 (& 'cdr))
+                               trans-expr))))
+     (('cast to-type)
+      (trans-er-let*
+       ((to-type (l3-trans-type-expr to-type ctx bindings)))
+       (trans-value `(cast (,from-type ,to-type) ,trans-expr))))
+     (& (trans-err ctx
+                   "Unimplemented mop for l3-trans-mop: ~x0"
+                   mop)))))
+
+(defun l3-trans-cc-exprs (lst ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (cond ((endp lst) (trans-value nil))
+        (t (trans-er-let*
+            ((x (l3-trans-expr nil (car lst) ctx bindings))
+             (n (l3-trans-width (car lst) ctx bindings))
+             (rest (l3-trans-cc-exprs (cdr lst) ctx bindings)))
+            (trans-value (list* x n rest))))))
+
+(defun l3-trans-expr-lst (patp lst ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (cond ((endp lst) (trans-value nil))
+        (t (trans-er-let*
+            ((x1 (l3-trans-expr patp (car lst) ctx bindings))
+             (x2 (l3-trans-expr-lst patp (cdr lst) ctx bindings)))
+            (trans-value (cons x1 x2))))))
+)
+
+(mutual-recursion
+
+(defun l3-trans-formal (formal ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (case-match formal
+    (('tp ('sqbkt . formals))
+     (l3-trans-formal-lst formals ctx bindings))
+    (('var name typ)
+     (trans-er-let*
+      ((x (l3-trans-sym name ctx bindings))
+       (typ (l3-trans-type-expr typ ctx bindings)))
+      (trans-value (list x (type-expr x typ)))))
+    ('qvar (trans-value 'st$))
+    (& (trans-err ctx
+                  "Unexpected formal passed to l3-trans-formal:~|~x0"
+                  formal))))
+
+(defun l3-trans-formal-lst (formals ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (cond ((endp formals) (trans-value nil))
+        (t (trans-er-let*
+            ((x (l3-trans-formal (car formals) ctx bindings))
+             (lst (l3-trans-formal-lst (cdr formals) ctx bindings)))
+            (trans-value (cons x lst))))))
+)
+
+(defun l3-trans-def (name formal expr closep measure-expr ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (trans-er-let*
+   ((sym (l3-trans-sym name ctx bindings))
+    (trans-formal (l3-trans-formal formal ctx bindings))
+    (trans-expr (l3-trans-expr nil expr ctx bindings))
+    (trans-measure-expr ; only used if measure-expr is non-nil
+     (if (null measure-expr)
+         (trans-value nil) ; arbitrary
+       (l3-trans-expr nil measure-expr ctx bindings))))
+   (trans-value `(defun-struct ,sym
+                   ,(if closep
+                        `(,trans-formal st$)
+                      `(,trans-formal))
+                   ,@(and measure-expr
+                          `(:measure ,trans-measure-expr))
+                   ,@(and (or closep (eq 'st$ trans-formal))
+                          '((declare (xargs :stobjs st$))))
+                   ,trans-expr))))
+
+(defun sym-to-const (str)
+  (intern
+   (concatenate 'string "*" (string-upcase str) "*")
+   "ACL2"))
+
+(defun l3-trans-def0 (name expr ctx bindings)
+  (declare (xargs :stobjs bindings))
+  (let ((sym (sym-to-const name)))
+    (cond ((assoc-eq sym (const-to-str bindings))
+           (trans-err ctx
+                      "Apparently def0 was applied to two strings with the ~
+                       same upper-case, ~x0 and ~x1.  A workaround is not yet ~
+                       implemented, but probably could be."
+                      (cdr (assoc-eq sym (const-to-str bindings)))
+                      name))
+          (t (let* ((bindings (update-str-to-const
+                               (acons name sym (str-to-const bindings))
+                               bindings))
+                    (bindings (update-const-to-str
+                               (acons sym name (const-to-str bindings))
+                               bindings)))
+               (trans-er-let*
+                ((trans-expr (l3-trans-expr nil expr ctx bindings)))
+                (trans-value `(defconst ,sym
+                                ,trans-expr))))))))
+
+(defmacro chk-pass1p (when-pass1-p-true form)
+  (declare (xargs :guard (booleanp when-pass1-p-true)))
+  `(cond ((eq pass1p ,when-pass1-p-true) ,form)
+         (t (trans-value nil))))
+
+(defun main-state-name-p (name)
+  (equal name "state"))
+
+(defun l3-to-acl2-fn3 (pass1p input-list ctx bindings state acc)
+  (declare (xargs :stobjs (bindings state)))
+  (cond
+   ((endp input-list)
+    (mv nil
+        (if pass1p acc (reverse acc))
+        bindings
+        state))
+   (t
+    (let ((x (l3-reparse (car input-list))))
+      (mv-let
+       (erp form bindings)
+       (case-match x
+         (('val '_ '= 'Construct
+                ('sqbkt (name ('sqbkt . clauses))))
+          (chk-pass1p t (l3-trans-construct name clauses ctx bindings)))
+         (('val '_ '= 'Record
+                (name ('sqbkt . fields)))
+          (chk-pass1p t
+                      (if (main-state-name-p name)
+                          (l3-trans-st$ fields ctx bindings)
+                        (l3-trans-record name fields ctx bindings))))
+         (('Def "raise'exception" . &)
+          (chk-pass1p
+           t
+           (trans-value
+            '(value-triple
+              "See l3.lisp for the definition of raise-exception"))))
+         (('def name formal
+                ('Close 'qVar expr))
+          (chk-pass1p nil
+                      (l3-trans-def name formal expr t nil ctx bindings)))
+         (('def name formal expr)
+          (chk-pass1p nil
+                      (l3-trans-def name formal expr nil nil ctx bindings)))
+         (('tdef name formal
+                 ('close 'qvar expr)
+                 ('close ('var var-name &)
+                         ('cs ('var var-name &)
+                              ('sqbkt (('tp ('sqbkt . &))
+                                       measure-expr)))))
+          (declare (ignore var-name))
+          (chk-pass1p nil
+                      (l3-trans-def name formal expr t measure-expr ctx
+                                    bindings)))
+         (('def0 name expr)
+          (chk-pass1p nil
+                      (l3-trans-def0 name expr ctx bindings)))
+         (& (trans-err ctx
+                       "Unexpected input form:~|~x0"
+                       x)))
+       (cond
+        (erp (mv-let
+              (erp2 val2 state)
+              (er soft erp
+                  "Translation problem for ~x0: ~@1"
+                  x form)
+              (declare (ignore erp2 val2))
+              (l3-to-acl2-fn3 pass1p (cdr input-list) ctx bindings state
+                              (cons `(value-triple (list :error ,x))
+                                    acc))))
+        (t (l3-to-acl2-fn3 pass1p (cdr input-list) ctx bindings state
+                           (if form
+                               (cons form acc)
+                             acc)))))))))
+
+(defun l3-to-acl2-fn2 (input-list str-to-sym logic-p ctx bindings state)
+  (declare (xargs :stobjs (bindings state)))
+  (mv-let
+   (erp initial-acc bindings)
+   (initialize-bindings str-to-sym (w state) ctx bindings)
+   (cond
+    (erp (mv-let (erp2 val2 state)
+                 (cmp-to-error-triple (mv erp initial-acc))
+                 (declare (ignore erp2 val2))
+                 (mv erp initial-acc bindings state)))
+    (t (mv-let
+        (erp1 new-acc bindings state)
+        (l3-to-acl2-fn3 t input-list ctx bindings state initial-acc)
+        (mv-let
+         (erp2 result bindings state)
+         (l3-to-acl2-fn3 nil input-list ctx bindings state
+                         (cond ((null logic-p)
+                                (cons '(program) new-acc))
+                               ((eq logic-p :logic-only) ; not guard-verified
+                                (cons '(set-verify-guards-eagerness 0)
+                                      new-acc))
+                               (t new-acc)))
+         (mv (or erp1 erp2) result bindings state)))))))
+
+(defun l3-to-acl2-fn1 (input-list str-to-sym logic-p ctx state)
+  (declare (xargs :stobjs state))
+  (with-local-stobj
+   bindings
+   (mv-let
+    (erp val bindings state)
+    (l3-to-acl2-fn2 input-list str-to-sym logic-p ctx bindings state)
+    (mv erp val state))))
+
+(include-book "misc/file-io" :dir :system)
+
+(make-event
+ `(defconst *translator-dir* ,(cbd)))
+
+(defun l3-to-acl2-fn (infile outfile logic-p str-to-sym form state)
+  (declare (xargs :stobjs state))
+  (er-let* ((ctx (value 'l3-to-acl2)) ; (ctx (mv nil 'l3-to-acl2 state))
+            (input-list (read-file infile state))
+            (output-list (l3-to-acl2-fn1 input-list str-to-sym logic-p ctx
+                                         state)))
+    (write-list (list* '(in-package "ACL2")
+                       `(value-triple '(:generated-by ,form))
+                       `(include-book ,(concatenate 'string
+                                                    *translator-dir*
+                                                    "l3"))
+                       output-list)
+                outfile
+                ctx
+                state)))
+
+(defmacro l3-to-acl2 (&whole form infile outfile &key logic str-to-sym)
+  `(l3-to-acl2-fn ,infile ,outfile ,logic ,str-to-sym ',form state))
diff -Nru acl2-6.2/books/translators/l3-to-acl2/translator/l3.lisp acl2-6.3/books/translators/l3-to-acl2/translator/l3.lisp
--- acl2-6.2/books/translators/l3-to-acl2/translator/l3.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2/translator/l3.lisp	2013-09-30 17:53:31.000000000 +0000
@@ -0,0 +1,738 @@
+; L3 prelude
+
+(in-package "ACL2")
+
+(defconst *case-match+-var* 'case-match+-var)
+
+(defun case-match+-1 (x)
+  (cond ((endp x) nil)
+        (t (cons (append (butlast (car x) 1)
+                         `((check-vars-not-free (,*case-match+-var*)
+                                                ,(car (last (car x))))))
+                 (case-match+-1 (cdr x))))))
+
+(defmacro case-match+ (var &rest clauses)
+  (declare (xargs :guard (alistp clauses)))
+  (cond ((symbolp var)
+         `(case-match ,var
+            ,@clauses))
+        (t `(let ((,*case-match+-var* ,var))
+              (case-match ,*case-match+-var*
+                ,@(pairlis$ (strip-cars clauses)
+                            (case-match+-1 (strip-cdrs clauses))))))))
+
+(defun make-type (sym)
+  (declare (xargs :guard t))
+  (cond ((not (symbolp sym))
+         (er hard? 'make-type
+             "Non-symbol argument to make-type: ~x0"
+             sym))
+        (t (case sym
+             (bty 'booleanp)
+             (nty 'natp)
+             (ity 'integerp)
+             (qty 'st$p)
+             (sty 'stringp)
+             (uty 'null)
+             (vty 'boolean-listp)
+             (otherwise
+              (intern-in-package-of-symbol
+               (concatenate 'string "TYPE-" (symbol-name sym))
+               sym))))))
+
+(defthm true-listp-make-var-lst1
+  (equal (true-listp (make-var-lst1 root sym n acc))
+         (true-listp acc)))
+
+(mutual-recursion
+
+(defun type-expr-lst (vars lst)
+  (declare (xargs :guard (and (true-listp vars)
+                              (true-listp lst))
+                  :measure (* 2 (acl2-count lst))))
+  (cond ((endp lst) nil)
+        (t (cons (type-expr (car vars) (car lst))
+                 (type-expr-lst (cdr vars) (cdr lst))))))
+
+(defun type-expr (name spec)
+
+; E.g., (type-expr name (funct shiftt conditiont regt regt regt)) says that
+; name is a 6-tuple of elements having the indicated types.
+
+  (declare (xargs :guard t
+                  :measure (1+ (* 2 (acl2-count spec)))))
+  (cond ((null spec) ; or, spec is [] in input file
+         `(null ,name))
+        ((symbolp spec)
+         `(,(make-type spec) ,name))
+        ((true-listp spec)
+         (case-match spec
+           (('unsigned-byte n)
+            `(unsigned-byte-p ,n ,name))
+           (& (let ((vars (make-var-lst 'x (length spec))))
+                `(slet ,vars
+                       ,name
+                       (and ,@(type-expr-lst vars spec))
+                       nil ; hardp
+                       nil ; default
+                       )))))
+        (t (er hard? 'type-expr
+               "Illegal type spec for ~x0: ~x1"
+               name spec))))
+)
+
+(defun construct-disjunct (clause)
+
+; Clause is from a construct form, e.g.,
+;   reservedinstr
+; or:
+;   (in (funct shiftt conditiont
+;              (unsigned-byte 7)
+;              (unsigned-byte 7)
+;              (unsigned-byte 7)))
+
+  (declare (xargs :guard t))
+  (cond ((symbolp clause)
+         `(eq x ',clause))
+        ((and (consp clause)
+              (symbolp (car clause))
+              (consp (cdr clause))
+              (true-listp (cadr clause))
+              (null (cddr clause)))
+         (let* ((type-expr (type-expr '(cadr x) (cadr clause)))
+                (type-expr-conjuncts (cond ((and (consp type-expr)
+                                                 (eq (car type-expr) 'and))
+                                            (cdr type-expr))
+                                           (t (list type-expr)))))
+           `(and (consp x)
+                 (eq (car x) ',(car clause))
+                 (consp (cdr x))
+                 (null (cddr x))
+                 ,@type-expr-conjuncts)))
+        (t (er hard? 'construct-disjunct
+               "Illegal CONSTRUCT clause: ~x0"
+               clause))))
+
+(defun construct-disjuncts (clauses)
+  (declare (xargs :guard (true-listp clauses)))
+  (cond ((endp clauses) nil)
+        (t (cons (construct-disjunct (car clauses))
+                 (construct-disjuncts (cdr clauses))))))
+
+(defun make-cast-to-nat (sym)
+  (declare (type symbol sym))
+  (intern-in-package-of-symbol
+   (concatenate 'string "CAST-" (symbol-name sym) "-TO-NAT")
+   sym))
+
+(defun make-cast-from-nat (sym)
+  (declare (type symbol sym))
+  (intern-in-package-of-symbol
+   (concatenate 'string "CAST-" (symbol-name sym) "-FROM-NAT")
+   sym))
+
+(defun construct-casters (type clauses)
+  (cond ((symbol-listp clauses)
+         `((defun ,(make-cast-to-nat type) (x)
+             (declare (xargs :guard t :mode :logic))
+             (let ((lst (member-eq x ',clauses)))
+               (- ,(len clauses)
+                  (len lst))))
+           (defun ,(make-cast-from-nat type) (n)
+             (declare (xargs :guard (natp n) :mode :logic))
+             (nth n ',clauses))))
+        (t nil)))
+
+(defmacro cast-unsigned-byte (n x)
+  (declare (xargs :guard (natp n)))
+  `(logand ,(1- (expt 2 n)) ,x))
+
+(defmacro cast (from-to x)
+  (case-match from-to
+    ((('unsigned-byte from) ('unsigned-byte to))
+     (cond ((or (not (natp from))
+                (not (natp to)))
+            (er hard 'cast
+                "Illegal cast from-to (expected natural numbers):~|~x0"
+                from-to))
+           ((<= from to)
+            x)
+           (t `(cast-unsigned-byte ,to ,x))))
+    ((('unsigned-byte &) to)
+     `(,(make-cast-from-nat to) ,x))
+    ((from ('unsigned-byte &))
+     `(,(make-cast-to-nat from) ,x))
+    (& (er hard 'cast
+           "Illegal cast from-to:~|~x0"
+           from-to))))
+
+(defmacro arb-qty ()
+  'st$)
+
+(defun make-arb (sym)
+  (declare (type symbol sym))
+  (intern-in-package-of-symbol
+   (concatenate 'string "ARB-" (symbol-name sym))
+   sym))
+
+(mutual-recursion
+
+(defun construct-arb-cdr (x)
+  (declare (xargs :guard t
+                  :measure (1+ (* 2 (acl2-count x)))))
+  (cond ((null x) nil)
+        ((symbolp x)
+         `(,(make-arb x)))
+        ((not (true-listp x))
+         (er hard? 'construct-arb-cdr
+             "Illegal piece of construct def: ~x0"
+             x))
+        (t (case-match x
+             (('unsigned-byte n)
+              `(arb-unsigned-byte ,n))
+             (& (cons 'list
+                      (construct-arb-cdr-lst x)))))))
+
+(defun construct-arb-cdr-lst (x)
+  (declare (xargs :guard (true-listp x)
+                  :measure (* 2 (acl2-count x))))
+  (cond ((endp x) nil)
+        (t (cons (construct-arb-cdr (car x))
+                 (construct-arb-cdr-lst (cdr x))))))
+)
+
+(defun construct-arb-def (type type-name clause)
+  (declare (xargs :guard (symbolp type)))
+  (let* ((arb-name (make-arb type))
+         (thm-name (intern-in-package-of-symbol
+                    (concatenate 'string
+                                 (symbol-name arb-name)
+                                 "-IS-"
+                                 (symbol-name type))
+                    type)))
+    `(encapsulate
+      (((,arb-name) => *))
+      (logic)
+      (set-ignore-ok t)
+      (local (defun ,arb-name ()
+               ,(cond ((atom clause)
+                       (kwote clause))
+                      ((and (symbolp (car clause))
+                            (true-listp (cdr clause)))
+                       `(cons ',(car clause)
+                              ,(construct-arb-cdr (cdr clause))))
+                      (t (er hard? 'construct-arb-def
+                             "Illegal construct clause for type ~x0:~|~x1"
+                             type clause)))))
+      (defthm ,thm-name
+        (,type-name (,arb-name))))))
+
+(defun type-list-name (type-name)
+  (declare (type symbol type-name))
+  (intern-in-package-of-symbol
+   (concatenate 'string (symbol-name type-name) "-LIST")
+   type-name))
+
+(defmacro construct (type clauses)
+  (declare (xargs :guard (symbolp type)))
+  (let* ((type-name (make-type type))
+         (type-def `(defun ,type-name (x)
+                      (declare (xargs :guard t :mode :logic))
+                      (or ,@(construct-disjuncts clauses))))
+         (arb-def (construct-arb-def type type-name (car clauses)))
+         (cast-defs (construct-casters type clauses))
+         (type-list-name (type-list-name type-name)))
+    `(progn ,@cast-defs
+            ,type-def
+            ,arb-def
+            (defun ,type-list-name (x)
+              (declare (xargs :guard t :mode :logic))
+              (cond ((atom x) (null x))
+                    (t (and (,type-name (car x))
+                            (,type-list-name (cdr x)))))))))
+
+(defmacro true ()
+  t)
+
+(defmacro false ()
+  nil)
+
+(defmacro assert! (condition value)
+; Like assert$, but avoids runtime check when in :program mode.
+  `(assert$ (mbt ,condition)
+            ,value))
+
+(verify-termination doubleton-list-p)
+(verify-guards doubleton-list-p)
+
+#||
+   [raise'exception_def]  Definition
+
+      |-  e.
+           raise'exception e =
+           ( state.
+              (ARB,
+               if state.exception = NoException then
+                 state with exception := e
+               else state))
+||#
+
+(encapsulate
+ (((arb-unsigned-byte *) => *))
+ (logic)
+ (local (defun arb-unsigned-byte (n) (declare (ignore n)) 0))
+ (defthm unsigned-byte-p-arb-unsigned-byte
+   (implies (force (natp n))
+            (unsigned-byte-p n (arb-unsigned-byte n)))))
+
+(defthm natp-arb-unsigned-byte
+  (implies (natp n)
+           (natp (arb-unsigned-byte n)))
+  :rule-classes :type-prescription
+  :hints (("Goal" :in-theory (disable unsigned-byte-p-arb-unsigned-byte)
+           :use unsigned-byte-p-arb-unsigned-byte)))
+
+(defthm natp-expt
+  (implies (and (natp b)
+                (natp e))
+           (natp (expt b e)))
+  :rule-classes :type-prescription)
+
+(defthm arb32-upper-bound
+  (implies (natp n)
+           (<= (arb-unsigned-byte n) (1- (expt 2 n))))
+  :rule-classes ((:linear :trigger-terms ((arb-unsigned-byte n))))
+  :hints (("Goal" :in-theory (disable unsigned-byte-p-arb-unsigned-byte)
+           :use unsigned-byte-p-arb-unsigned-byte)))
+
+(defmacro raise-exception (e val st)
+  (declare (xargs :guard (symbolp st)))
+  `(let ((,st (if (eq (exception ,st) 'NoException)
+                  (update-exception ,e ,st)
+                ,st)))
+     (mv ,val ,st)))
+
+; Start development of defun-struct, which is like defun except that a formal
+; may be "structured":
+;   (f1 f2 f3 ... fk)
+; where each fi is either a symbol or a pair (sym guard).
+; Each such is replaced by SFORMAL1, SFORMAL2, etc.
+
+(defthm character-listp-explode-nonnegative-integer
+  (implies
+   (character-listp ans)
+   (character-listp (explode-nonnegative-integer n print-base ans))))
+
+(defun new-formal (i)
+  (declare (xargs :guard (natp i)))
+  (intern (concatenate 'string
+                       "SFORMAL"
+                       (coerce (explode-atom i 10) 'string))
+          "ACL2"))
+
+(defun destructure-formals-1 (sformal x orig)
+  (declare (xargs :guard t))
+  (cond ((atom x)
+         (prog2$ (or (null x)
+                     (er hard? 'destructure-formals-1
+                         "Illegal structured formal, ~x0"
+                         orig))
+                 (mv nil nil)))
+        (t (mv-let
+            (cdr-bindings cdr-guards)
+            (destructure-formals-1 sformal (cdr x) orig)
+            (let* ((name (if (atom (car x))
+                             (car x)
+                           (caar x)))
+                   (bindings
+                    (cons (list name (list 'car sformal))
+                          (cond ((null (cdr x))
+                                 cdr-bindings)
+                                (t (cons (list sformal (list 'cdr sformal))
+                                         cdr-bindings))))))
+              (prog2$
+               (or (symbolp name)
+                   (er hard? 'destructure-formals-1
+                       "Illegal structured formal, ~x0"
+                       orig))
+               (cond ((atom (car x))
+                      (mv bindings cdr-guards))
+                     ((and (true-listp (car x))
+                           (eql (length (car x)) 2))
+                      (mv bindings (cons (cadr (car x)) cdr-guards)))
+                     (t (mv (er hard? 'destructure-formals-1
+                                "Illegal structured formal, ~x0"
+                                orig)
+                            nil)))))))))
+
+(defthm true-listp-car-destructure-formals-1
+  (true-listp (car (destructure-formals-1 sformal x orig))))
+
+(defthm true-listp-nth-1-destructure-formals-1
+  (true-listp (mv-nth 1 (destructure-formals-1 sformal x orig))))
+
+(defun destructure-formals (formals i)
+  (declare (xargs :guard (and (true-listp formals)
+                              (natp i))))
+  (cond ((endp formals)
+         (mv nil nil nil nil nil))
+        (t
+         (mv-let
+          (cdr-bindings cdr-names cdr-formals cdr-len-guards cdr-guards)
+          (destructure-formals (cdr formals) (1+ i))
+          (cond
+           ((symbolp (car formals))
+            (mv cdr-bindings
+                cdr-names
+                (cons (car formals) cdr-formals)
+                cdr-len-guards
+                cdr-guards))
+           ((and (consp (car formals))
+                 (symbolp (caar formals))
+                 (consp (cdar formals))
+                 (null (cddar formals)))
+            (mv cdr-bindings
+                cdr-names
+                (cons (caar formals) cdr-formals)
+                cdr-len-guards
+                (cons (cadar formals)
+                      cdr-guards)))
+           (t
+            (let ((new-formal (new-formal i)))
+              (mv-let (new-bindings new-guards)
+                      (destructure-formals-1 new-formal
+                                             (car formals)
+                                             (car formals))
+                      (mv (append new-bindings cdr-bindings)
+                          (cons new-formal cdr-names)
+                          (cons new-formal cdr-formals)
+                          (if (consp (car formals))
+                              (cons `(eql (len ,new-formal)
+                                          ,(len (car formals)))
+                                    cdr-len-guards)
+                            cdr-len-guards)
+                          (append new-guards cdr-guards))))))))))
+
+(defmacro defun-struct (name formals &rest rest)
+  (declare (xargs :guard (true-listp formals)))
+  (mv-let
+   (measure rest)
+   (cond ((eq (car rest) :measure)
+          (mv (cadr rest) (cddr rest)))
+         (t (mv nil rest)))
+   (mv-let
+    (bindings new-names new-formals len-guards guards)
+    (destructure-formals formals 1)
+    (let* ((ign-decl `(declare (ignorable
+                                ,@(set-difference-eq (strip-cars bindings)
+                                                     new-names))))
+           (guard0 (if guards
+                      `(let* ,bindings
+                         ,ign-decl
+                         (check-vars-not-free ,new-names
+                                              (and ,@guards)))
+                    t)))
+      `(defun ,name ,new-formals
+         (declare (xargs :guard
+                         ,(if len-guards
+                              (if (eq guard0 t)
+                                  len-guards
+                                `(and ,@len-guards
+                                      ,guard0))
+                            guard0)
+                         ,@(and measure
+                                `(:measure
+                                  (let* ,bindings
+                                    ,ign-decl
+                                    (check-vars-not-free ,new-names
+                                                         ,measure))))))
+         ,@(butlast rest 1)
+         (let* ,bindings
+           ,ign-decl
+           (check-vars-not-free ,new-names
+                                ,(car (last rest)))))))))
+
+(include-book "arithmetic-5/top" :dir :system)
+
+(defmacro n+ (n x y)
+  (declare (xargs :guard (natp n)))
+  `(cast-unsigned-byte ,n (+ ,x ,y)))
+
+(defmacro n- (n x y)
+  (declare (xargs :guard (natp n)))
+  `(cast-unsigned-byte ,n (- ,x ,y)))
+
+; The following has lemmas like SIGNED-BYTE-P-LOGOPS and
+; UNSIGNED-BYTE-P-LOGXOR.
+(include-book "ihs/logops-lemmas" :dir :system)
+
+(in-theory (disable signed-byte-p))
+
+(defun bl-fn (n x)
+  (declare (xargs :guard (and (natp n)
+                              (symbolp x))))
+  (cond ((zp n) nil)
+        (t (let ((n (1- n)))
+             (cons `(logbitp ,n ,x)
+                   (bl-fn n x))))))
+
+(defmacro bl (n x)
+  (declare (xargs :guard (and (natp n)
+                              (symbolp x))))
+  (cons 'mv (bl-fn n x)))
+
+; Here is a definition of bits adapted from books/rtl/rel8/lib/bits.lisp.  If
+; we want to get serious about reasoning for this project, we should
+; investigate more carefully which libraries to use.
+
+(defund bits (x i j)
+  (declare (xargs :guard (and (integerp x)
+                              (integerp i)
+                              (integerp j))))
+  (if (< i j)
+      0
+    (logand (ash x (- j)) (1- (ash 1 (1+ (- i j)))))))
+
+; Anthony will supply HOL4 imports, and then I can (hopefully!) find
+; corresponding ACL2 libraries.
+
+; Theory management:
+(in-theory (disable ash-to-floor
+                    unsigned-byte-p
+                    logand-with-mask
+                    logand-constant-mask
+                    logbitp))
+
+(defthm unsigned-byte-p-bits
+  (implies (and (natp i)
+                (natp j)
+                (< j i)
+                (equal k (1+ (- i j))))
+           (unsigned-byte-p k (bits x i j)))
+  :hints (("Goal" :in-theory (e/d (bits ash unsigned-byte-p)))))
+
+(defthm natp-bits
+  (natp (bits x i j))
+  :rule-classes :type-prescription
+  :hints (("Goal"
+           :in-theory (enable unsigned-byte-p bits ash))))
+
+; !! Consider making more efficient by adding guard that args are of expected
+; maximum bit width and then using mbe to avoid the call of BITS in the body.
+(defund binary-cat (x m y n)
+; Loosely based on rtl/rel8/lib/bits.lisp, but uses logior instead of +.
+  (declare (xargs :guard (and (integerp x)
+                              (integerp y)
+                              (natp m)
+                              (natp n))))
+  (if (and (natp m) (natp n))
+      (logior (ash (bits x (1- m) 0) n)
+              (bits y (1- n) 0))
+    0))
+
+; From rtl/rel8/lib/bits.lisp:
+
+(defun formal-+ (x y)
+  (declare (xargs :guard t))
+  (if (and (acl2-numberp x) (acl2-numberp y))
+      (+ x y)
+    (list '+ x y)))
+
+(defun cat-size (x)
+  (declare (xargs :guard (and (true-listp x) (evenp (length x)))))
+  (if (endp (cddr x))
+      (cadr x)
+    (formal-+ (cadr x)
+	      (cat-size (cddr x)))))
+
+(defmacro cat (&rest x)
+  (declare (xargs :guard (and x (true-listp x) (evenp (length x)))))
+  (cond ((endp (cddr x))
+         `(bits ,(car x) ,(formal-+ -1 (cadr x)) 0))
+        ((endp (cddddr x))
+         `(binary-cat ,@x))
+        (t
+         `(binary-cat ,(car x) 
+                      ,(cadr x) 
+                      (cat ,@(cddr x)) 
+                      ,(cat-size (cddr x))))))
+
+(defthm unsigned-byte-p-cat
+   (implies (and (natp n1)
+                 (natp n2)
+                 (equal k (+ n1 n2)))
+            (unsigned-byte-p k (cat x n1 y n2)))
+   :hints (("Goal" :in-theory (enable unsigned-byte-p binary-cat bits ash))))
+
+(defun unit-value ()
+
+; Warning: If this is replaced with something other than nil, then 
+
+  (declare (xargs :guard t))
+  nil)
+
+(defmacro tuple (&rest args)
+  (cons 'list args))
+
+(defun slet-ignores (x)
+  (declare (xargs :guard t))
+  (cond ((null x) nil)
+        ((symbolp x) (list x))
+        ((atom x) nil)
+        ((eq (car x) 'quote) nil)
+        (t (union-eq (slet-ignores (car x))
+                     (slet-ignores (cdr x))))))
+
+(defmacro slet (str val expr &optional (hardp 't) (default '0))
+
+; Structured let, for example:
+; (slet (func shift skip w a b) args expr)
+
+  `(case-match+ ,val
+     (,str
+      (declare (ignorable ,@(slet-ignores str)))
+      ,expr)
+     (& ,(cond (hardp `(prog2$ (er hard! 'slet
+                                   "Ill-formed: ~x0"
+                                   '(slet ,str ,val ,expr))
+                               ,default))
+               (t default)))))
+
+; The following was needed in order to admit encode in tiny.lisp.
+(defthm equal-len-0
+  (equal (equal (len x) 0)
+         (atom x)))
+
+; The following was useful for admitting dfn-loadconstant.
+(encapsulate
+ ()
+
+ (local (scatter-exponents))
+
+ (defthm unsigned-byte-p-monotone
+   (implies (and (unsigned-byte-p k x)
+                 (natp k)
+                 (integerp n)
+                 (<= k n))
+            (unsigned-byte-p n x))
+   :hints (("Goal" :in-theory (enable unsigned-byte-p)))))
+
+(defun arb-uty ()
+  (declare (xargs :guard t))
+  (unit-value))
+
+(defun arb-list-fn (lst)
+  (declare (xargs :guard (true-listp lst)))
+  (cond ((endp lst) nil)
+        (t (cons `(arb ,(car lst))
+                 (arb-list-fn (cdr lst))))))
+
+(defmacro arb (type)
+  (case-match type
+    (('unsigned-byte n)
+     `(arb-unsigned-byte ,n))
+    ('qty ''st$)
+    ((& . &)
+     (let ((lst (arb-list-fn type)))
+       (cond ((member-equal 'qty type)
+              (cons 'mv lst))
+             (t (cons 'tuple lst)))))
+    (& (cond ((symbolp type)
+              `(,(make-arb type)))
+             (t (er hard 'arb
+                    "Illegal argument to arb:~|~x0"
+                    type))))))
+
+(defmacro call-constructor (typ sym x)
+  (declare (ignore typ))
+  `(list ',sym ,x))
+
+(defmacro mv-let-ignorable (&rest rst)
+  (declare (xargs :guard ; from mv-let
+                  (and (>= (length rst) 3)
+                       (true-listp (car rst))
+                       (>= (length (car rst)) 2))))
+  `(mv-let ,(car rst)
+           ,(cadr rst)
+           (declare (ignorable ,@(car rst)))
+           ,@(cddr rst)))
+
+(defun stobj-mapper-name (updater rec-p)
+  (declare (xargs :guard (symbolp updater)))
+  (intern-in-package-of-symbol
+   (cond (rec-p
+          (concatenate 'string "MAP-" (symbol-name updater)
+                       "-REC"))
+         (t
+          (concatenate 'string "MAP-" (symbol-name updater))))
+   updater))
+
+(defun defstobj-mappers-1 (field-name n type-spec st-name renaming-alist)
+  (declare (xargs :guard (and (symbolp field-name)
+                              (posp n)
+                              (symbolp st-name))
+                  :mode ; because of defstobj-fnname
+                  :program))
+  (let* ((init (if (eq st-name 'init)
+                   'init-val
+                 'init))
+         (k (if (eq st-name 'k)
+                'i
+              'k))
+         (updater (defstobj-fnname field-name :updater :array renaming-alist))
+         (mapper (stobj-mapper-name updater nil))
+         (mapper-rec (stobj-mapper-name updater t)))
+    `((defun ,mapper-rec (,k ,init ,st-name)
+        (declare (xargs :stobjs ,st-name)
+                 (type ,type-spec ,init)
+                 (type (integer 0 ,n) ,k))
+        (cond ((zp ,k) ,st-name)
+              (t (let* ((,k (1- ,k))
+                        (,st-name (,updater ,k ,init ,st-name)))
+                   (,mapper-rec ,k ,init ,st-name)))))
+      (defun ,mapper (,init ,st-name)
+        (declare (xargs :stobjs ,st-name)
+                 (type ,type-spec ,init))
+        (,mapper-rec ,n ,init ,st-name)))))
+
+(defun defstobj-mappers (x st-name renaming-alist)
+
+; X is the cdr of a defstobj form, and thus is a list consisting of field
+; specifications followed, optionally, by a keyword-value-listp.
+
+; Note that we do not support renaming of stobj updaters.  That could be added
+; if necessary.
+
+  (declare (xargs :guard (and (true-listp x)
+                              (symbolp st-name))
+                  :mode ; because of defstobj-mappers-1
+                  :program))
+  (cond ((endp x) nil)
+        ((keywordp (car x)) nil)
+        ((atom (car x))
+         (defstobj-mappers (cdr x) st-name renaming-alist))
+        ((keyword-value-listp (cdr (car x)))
+         (cond
+          ((not (symbolp (car (car x))))
+           (er hard? 'defstobj-mappers
+               "Found non-symbolp CAR of stobj field ~x0"
+               (car x)))
+          (t (let ((tp (cadr (assoc-keyword :type (cdr (car x))))))
+               (case-match tp
+                 (('array type-spec (n))
+                  (cond ((posp n)
+                         (append (defstobj-mappers-1 (car (car x)) n type-spec
+                                   st-name renaming-alist)
+                                 (defstobj-mappers (cdr x) st-name
+                                   renaming-alist)))
+                        (t (er hard? 'defstobj-mappers
+                               "Found non-posp array dimension in stobj ~
+                                field:~|~x0"
+                               (car x)))))
+                 (& (defstobj-mappers (cdr x) st-name renaming-alist)))))))
+        (t (defstobj-mappers (cdr x) st-name renaming-alist))))
+
+(defmacro defstobj+ (&rest args)
+  (let ((renaming-alist (cadr (member-eq :renaming args))))
+    `(progn (defstobj ,@args)
+            ,@(defstobj-mappers (cdr args) (car args) renaming-alist))))
diff -Nru acl2-6.2/books/translators/l3-to-acl2-deps.lisp acl2-6.3/books/translators/l3-to-acl2-deps.lisp
--- acl2-6.2/books/translators/l3-to-acl2-deps.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/translators/l3-to-acl2-deps.lisp	2013-09-30 17:53:32.000000000 +0000
@@ -0,0 +1,9 @@
+;; Silly file to trick cert.pl into including the right books.
+
+(in-package "ACL2")
+
+#||
+(include-book "arithmetic-5/top" :dir :system)
+(include-book "ihs/logops-lemmas" :dir :system)
+(include-book "misc/file-io" :dir :system)
+||#
diff -Nru acl2-6.2/books/tutorial-problems/introductory-challenge-problem-4-athena.lisp acl2-6.3/books/tutorial-problems/introductory-challenge-problem-4-athena.lisp
--- acl2-6.2/books/tutorial-problems/introductory-challenge-problem-4-athena.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/tutorial-problems/introductory-challenge-problem-4-athena.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -1,8 +1,11 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann and J Moore, January, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; (certify-book "introductory-challenge-problem-4-athena")
 ; -----------------------------------------------------------------
 
 ; Some Solutions to Introductory Challenge Problem 4
-; Matt Kaufmann and J Moore
 
 ; See :doc introductory-challenge-problem-4
 
diff -Nru acl2-6.2/books/tutorial-problems/introductory-challenge-problem-4.lisp acl2-6.3/books/tutorial-problems/introductory-challenge-problem-4.lisp
--- acl2-6.2/books/tutorial-problems/introductory-challenge-problem-4.lisp	2013-06-06 17:11:04.000000000 +0000
+++ acl2-6.3/books/tutorial-problems/introductory-challenge-problem-4.lisp	2013-09-30 17:52:17.000000000 +0000
@@ -1,8 +1,11 @@
+; Copyright (C) 2013, Regents of the University of Texas
+; Written by Matt Kaufmann and J Moore, January, 2010
+; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
+
 ; (certify-book "introductory-challenge-problem-4")
 ; -----------------------------------------------------------------
 
 ; Some Solutions to Introductory Challenge Problem 4
-; Matt Kaufmann and J Moore
 
 ; See :doc introductory-challenge-problem-4
 
diff -Nru acl2-6.2/books/unicode/read-utf8.lisp acl2-6.3/books/unicode/read-utf8.lisp
--- acl2-6.2/books/unicode/read-utf8.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/unicode/read-utf8.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -18,14 +18,26 @@
 (in-package "ACL2")
 (include-book "utf8-decode")
 (include-book "std/io/take-bytes" :dir :system)
-;; (local (include-book "open-input-channel"))
-;; (local (include-book "close-input-channel"))
 (local (include-book "std/io/base" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "centaur/bitops/signed-byte-p" :dir :system))
 (set-state-ok t)
 
+(local (in-theory (disable signed-byte-p)))
+
 (local (in-theory (disable take-redefinition)))
 
+(local (defthm signed-byte-p-resolver
+         (implies (and (integerp n)
+                       (<= 1 n)
+                       (integerp x)
+                       (<= (- (expt 2 (1- n))) x)
+                       (< x (expt 2 (1- n))))
+                  (signed-byte-p n x))
+         :hints(("Goal" :in-theory (enable signed-byte-p)))))
+
+
 
 ;; We now want to recreate our utf8=>ustring function but directly using the
 ;; file reading operations.  We begin by writing equivalents of "take" and
@@ -274,308 +286,316 @@
 ;; a lot of this is the same as what we needed for utf8=>ustring-fast.
 
 (encapsulate
- ()
- (local (in-theory (enable take-redefinition)))
-
- (local (defthm terrible-lemma-1
-          (implies (and (integerp x)
-                        (<= 0 x)
-                        (<= x 127))
-                   (uchar? x))
-          :hints(("Goal" :in-theory (enable uchar?)))))
-
- (local (defthm terrible-lemma-2
-          (IMPLIES (AND (force (integerp x1))
-                        (force (integerp x2))
-                        (< 127 X1)
-                        (<= 194 X1)
-                        (<= X1 223)
-                        (<= 128 X2)
-                        (<= X2 191))
-                   (UCHAR? (LOGIOR (ASH (LOGAND X1 31) 6)
-                                   (LOGAND X2 63))))
-          :hints(("Goal"
-                  :in-theory (enable utf8-combine2-guard
-                                     utf8-combine2
-                                     utf8-table35-bytes
-                                     utf8-table36-bytes)
-                  :use ((:instance uchar?-of-utf8-combine2))))))
-
- (local (defthm terrible-lemma-3
-          (IMPLIES (AND (force (integerp x2))
-                        (force (integerp x3))
-                        (<= 160 X2)
-                        (<= X2 191)
-                        (<= 128 X3)
-                        (<= X3 191))
-                   (UCHAR? (LOGIOR 0 (ASH (LOGAND X2 63) 6)
-                                   (LOGAND X3 63))))
-          :hints(("Goal"
-                  :in-theory (enable utf8-combine3-guard
-                                     utf8-combine3
-                                     utf8-table35-bytes
-                                     utf8-table36-bytes)
-                  :use ((:instance uchar?-of-utf8-combine3
-                                   (x1 224)))))))
-
- (local (defthm terrible-lemma-4
-          (IMPLIES (AND (force (integerp X1))
-                        (force (integerp X2))
-                        (force (integerp X3))
-                        (<= 224 X1)
-                        (<= X1 239)
-                        (NOT (EQUAL X1 224))
-                        (NOT (EQUAL X1 237))
-                        (<= 128 X2)
-                        (<= X2 191)
-                        (<= 128 X3)
-                        (<= X3 191))
-                   (UCHAR? (LOGIOR (ASH (LOGAND X1 15) 12)
-                                   (ASH (LOGAND X2 63) 6)
-                                   (LOGAND X3 63))))
-          :hints(("Goal"
-                  :in-theory (enable utf8-combine3-guard
-                                     utf8-combine3
-                                     utf8-table35-bytes
-                                     utf8-table36-bytes)
-                  :use ((:instance uchar?-of-utf8-combine3))))))
-
- (local (defthm terrible-lemma-5
-          (IMPLIES (AND (force (integerp x2))
-                        (force (integerp x3))
-                        (<= 128 X2)
-                        (<= X2 159)
-                        (<= 128 X3)
-                        (<= X3 191))
-                   (UCHAR? (LOGIOR 53248 (ASH (LOGAND X2 63) 6)
-                                   (LOGAND X3 63))))
-          :hints(("Goal"
-                  :in-theory (enable utf8-combine3-guard
-                                     utf8-combine3
-                                     utf8-table35-bytes
-                                     utf8-table36-bytes)
-                  :use ((:instance uchar?-of-utf8-combine3
-                                   (x1 237)))))))
-
- (local (defthm terrible-lemma-6
-          (IMPLIES (AND (force (integerp x2))
-                        (force (integerp x3))
-                        (force (integerp x4))
-                        (<= 144 X2)
-                        (<= X2 191)
-                        (<= 128 X3)
-                        (<= X3 191)
-                        (<= 128 X4)
-                        (<= X4 191))
-                   (UCHAR? (LOGIOR 0 (ASH (LOGAND X2 63) 12)
-                                   (ASH (LOGAND X3 63) 6)
-                                   (LOGAND X4 63))))
-          :hints(("Goal"
-                  :in-theory (enable utf8-combine4-guard
-                                     utf8-combine4
-                                     utf8-table35-bytes
-                                     utf8-table36-bytes)
-                  :use ((:instance uchar?-of-utf8-combine4
-                                   (x1 240)))))))
-
- (local (defthm terrible-lemma-7
-          (IMPLIES (AND (force (integerp x1))
-                        (force (integerp x2))
-                        (force (integerp x3))
-                        (force (integerp x4))
-                        (<= 240 X1)
-                        (<= X1 244)
-                        (NOT (EQUAL X1 240))
-                        (NOT (EQUAL X1 244))
-                        (<= 128 X2)
-                        (<= X2 191)
-                        (<= 128 X3)
-                        (<= X3 191)
-                        (<= 128 X4)
-                        (<= X4 191))
-                   (UCHAR? (LOGIOR (ASH (LOGAND X1 7) 18)
-                                   (ASH (LOGAND X2 63) 12)
-                                   (ASH (LOGAND X3 63) 6)
-                                   (LOGAND X4 63))))
-          :hints(("Goal"
-                  :in-theory (enable utf8-combine4-guard
-                                     utf8-combine4
-                                     utf8-table35-bytes
-                                     utf8-table36-bytes)
-                  :use ((:instance uchar?-of-utf8-combine4))))))
-
- (local (defthm terrible-lemma-8
-          (IMPLIES (AND (force (integerp x2))
-                        (force (integerp x3))
-                        (force (integerp x4))
-                        (<= 128 x2)
-                        (<= x2 143)
-                        (<= 128 x3)
-                        (<= x3 191)
-                        (<= 128 x4)
-                        (<= x4 191))
-                   (UCHAR? (LOGIOR 1048576 (ASH (LOGAND x2 63) 12)
-                                   (ASH (LOGAND x3 63) 6)
-                                   (LOGAND x4 63))))
-          :hints(("Goal"
-                  :in-theory (enable utf8-combine4-guard
-                                     utf8-combine4
-                                     utf8-table35-bytes
-                                     utf8-table36-bytes)
-                  :use ((:instance uchar?-of-utf8-combine4
-                                   (x1 244)))))))
-
- (local (include-book "std/io/signed-byte-listp" :dir :system))
-
- (local (defthm unsigned-byte-listp-8-of-car-of-read-byte$-all-forward
-          (implies (and (force (state-p1 state))
-                        (force (open-input-channel-p1 channel :byte state))
-                        (force (symbolp channel)))
-                   (unsigned-byte-listp 8 (mv-nth 0 (read-byte$-all channel state))))
-          :rule-classes ((:forward-chaining :trigger-terms ((read-byte$-all channel state))))))
-
- (local (defthm unsigned-byte-listp-8-of-cdr-when-unsigned-byte-listp-8
-          (implies (unsigned-byte-listp 8 x)
-                   (unsigned-byte-listp 8 (cdr x)))
-          :rule-classes ((:forward-chaining))))
-
- (local (defthm crock
-          (implies (unsigned-byte-listp bytes x)
-                   (iff (consp x)
-                        x))))
-
-(local (defthm hideous-lemma-1
-          (implies (and (force (state-p1 state))
-                        (force (open-input-channel-p1 channel :byte state))
-                        (force (symbolp channel))
-                        (mv-nth 0 (read-byte$-all channel state)))
-                   (unsigned-byte-p 8 (car (mv-nth 0 (read-byte$-all channel state)))))
-          :rule-classes ((:rewrite)
-                         (:forward-chaining
-                          :trigger-terms ((mv-nth 0 (read-byte$-all channel state)))))))
-
-(local (defthm hideous-lemma-2
-          (implies (and (force (state-p1 state))
-                        (force (open-input-channel-p1 channel :byte state))
-                        (force (symbolp channel))
-                        (cdr (mv-nth 0 (read-byte$-all channel state))))
-                   (unsigned-byte-p 8 (cadr (mv-nth 0 (read-byte$-all channel state)))))
-          :rule-classes ((:rewrite)
-                         (:forward-chaining
-                          :trigger-terms ((cdr (mv-nth 0 (read-byte$-all channel state))))))))
-
-(local (defthm hideous-lemma-3
-          (implies (and (force (state-p1 state))
-                        (force (open-input-channel-p1 channel :byte state))
-                        (force (symbolp channel))
-                        (cddr (mv-nth 0 (read-byte$-all channel state))))
-                   (unsigned-byte-p 8 (caddr (mv-nth 0 (read-byte$-all channel state)))))
-          :rule-classes ((:rewrite)
-                         (:forward-chaining
-                          :trigger-terms ((cddr (mv-nth 0 (read-byte$-all channel state))))))
-          :hints(("Goal"
-                  :in-theory (e/d (read-byte$-all)
-                                  (car-of-read-byte$))
-                  :expand ((read-byte$-all channel state)
-                           (read-byte$-all channel (mv-nth 1 (read-byte$ channel state)))
-                           (read-byte$-all
-                            channel
-                            (mv-nth 1 (read-byte$ channel
-                                                  (mv-nth 1 (read-byte$ channel
-                                                                        state))))))))))
-
-(local (defthm hideous-lemma-4
-          (implies (and (force (state-p1 state))
-                        (force (open-input-channel-p1 channel :byte state))
-                        (force (symbolp channel))
-                        (cdddr (mv-nth 0 (read-byte$-all channel state))))
-                   (unsigned-byte-p 8 (car (cdddr (mv-nth 0 (read-byte$-all channel state))))))
-          :rule-classes ((:rewrite)
-                         (:forward-chaining
-                          :trigger-terms ((cdddr (mv-nth 0 (read-byte$-all channel state))))))
-          :hints(("Goal"
-                  :in-theory (e/d (read-byte$-all)
-                                  (car-of-read-byte$))
-                  :expand ((read-byte$-all channel state)
-                           (read-byte$-all channel
-                                           (mv-nth 1 (read-byte$ channel state)))
-                           (read-byte$-all
-                            channel
-                            (mv-nth 1 (read-byte$ channel
-                                                  (mv-nth 1 (read-byte$ channel state)))))
-                           (read-byte$-all
-                            channel
-                            (mv-nth 1 (read-byte$
-                                       channel
-                                       (mv-nth 1 (read-byte$
-                                                  channel
-                                                  (mv-nth 1 (read-byte$ channel
-                                                                        state))))))))))))
-
-(local (defthm integerp-when-unsigned-byte-p-8
-          (implies (unsigned-byte-p 8 x)
-                   (integerp x))))
-
-(local (defthm signed-byte-p-from-unsigned-byte-p-8
-          (implies (and (unsigned-byte-p 8 x)
-                        (< 8 (nfix n)))
-                   (signed-byte-p n x))))
-
-(local (defthm len-zero-when-true-listp
-          (implies (true-listp x)
-                   (equal (equal (len x) 0)
-                          (not x)))))
-
-(local (defthm integer-squeeze-lemma
-          (implies (and (syntaxp (quotep n))
-                        (integerp n)
-                        (< (1- n) x)
-                        (< x (1+ n)))
-                   (equal (equal x n)
-                          (integerp x)))
-          :rule-classes ((:rewrite :backchain-limit-lst 1))))
-
-(local (defthm unsigned-byte-p-8-when-valid-integer
-          (implies (and (<= 0 x)
-                        (< x 255))
-                   (equal (unsigned-byte-p 8 x)
-                          (integerp x)))
-          :rule-classes ((:rewrite :backchain-limit-lst 1))
-          :hints(("Goal" :in-theory (enable unsigned-byte-p)))))
-
-(local (include-book "arithmetic-3/bind-free/top" :dir :system))
-
-(local (defthm nthcdr-bytes-hack
-          (implies (and (force (state-p1 state))
-                        (force (open-input-channel-p1 channel :byte state))
-                        (force (symbolp channel))
-                        (force (natp n)))
-                   (equal (nthcdr-bytes n channel (mv-nth 1 (read-byte$ channel state)))
-                          (nthcdr-bytes (+ 1 n) channel state)))
-          :hints(("Goal"
-                  :expand (nthcdr-bytes (+ 1 n) channel state)
-                  :in-theory (enable nthcdr-bytes)
-                  :do-not-induct t))))
-
-(local (in-theory (enable unsigned-byte-listp
-                           utf8-char=>uchar
-                           utf8-table35-bytes
-                           utf8-table36-bytes
-                           utf8-combine2
-                           utf8-combine3
-                           utf8-combine4
-                           utf8-combine2-guard
-                           utf8-combine3-guard
-                           utf8-combine4-guard)))
-
-(verify-guards read-utf8-fast
-                :hints(("Subgoal 2"
-                        :in-theory (disable unsigned-byte-p-8-when-valid-integer
-                                            nthcdr-bytes-hack))))
-
- )
+  ()
+  (local (in-theory (enable take-redefinition)))
 
+  (local (defthm terrible-lemma-1
+           (implies (and (integerp x)
+                         (<= 0 x)
+                         (<= x 127))
+                    (uchar? x))
+           :hints(("Goal" :in-theory (enable uchar?)))))
+
+  (local (defthm terrible-lemma-2
+           (IMPLIES (AND (force (integerp x1))
+                         (force (integerp x2))
+                         (< 127 X1)
+                         (<= 194 X1)
+                         (<= X1 223)
+                         (<= 128 X2)
+                         (<= X2 191))
+                    (UCHAR? (LOGIOR (ASH (LOGAND X1 31) 6)
+                                    (LOGAND X2 63))))
+           :hints(("Goal"
+                   :in-theory (enable utf8-combine2-guard
+                                      utf8-combine2
+                                      utf8-table35-bytes
+                                      utf8-table36-bytes)
+                   :use ((:instance uchar?-of-utf8-combine2))))))
+
+  (local (defthm terrible-lemma-3
+           (IMPLIES (AND (force (integerp x2))
+                         (force (integerp x3))
+                         (<= 160 X2)
+                         (<= X2 191)
+                         (<= 128 X3)
+                         (<= X3 191))
+                    (UCHAR? (LOGIOR 0 (ASH (LOGAND X2 63) 6)
+                                    (LOGAND X3 63))))
+           :hints(("Goal"
+                   :in-theory (enable utf8-combine3-guard
+                                      utf8-combine3
+                                      utf8-table35-bytes
+                                      utf8-table36-bytes)
+                   :use ((:instance uchar?-of-utf8-combine3
+                                    (x1 224)))))))
+
+  (local (defthm terrible-lemma-4
+           (IMPLIES (AND (force (integerp X1))
+                         (force (integerp X2))
+                         (force (integerp X3))
+                         (<= 224 X1)
+                         (<= X1 239)
+                         (NOT (EQUAL X1 224))
+                         (NOT (EQUAL X1 237))
+                         (<= 128 X2)
+                         (<= X2 191)
+                         (<= 128 X3)
+                         (<= X3 191))
+                    (UCHAR? (LOGIOR (ASH (LOGAND X1 15) 12)
+                                    (ASH (LOGAND X2 63) 6)
+                                    (LOGAND X3 63))))
+           :hints(("Goal"
+                   :in-theory (enable utf8-combine3-guard
+                                      utf8-combine3
+                                      utf8-table35-bytes
+                                      utf8-table36-bytes)
+                   :use ((:instance uchar?-of-utf8-combine3))))))
+
+  (local (defthm terrible-lemma-5
+           (IMPLIES (AND (force (integerp x2))
+                         (force (integerp x3))
+                         (<= 128 X2)
+                         (<= X2 159)
+                         (<= 128 X3)
+                         (<= X3 191))
+                    (UCHAR? (LOGIOR 53248 (ASH (LOGAND X2 63) 6)
+                                    (LOGAND X3 63))))
+           :hints(("Goal"
+                   :in-theory (enable utf8-combine3-guard
+                                      utf8-combine3
+                                      utf8-table35-bytes
+                                      utf8-table36-bytes)
+                   :use ((:instance uchar?-of-utf8-combine3
+                                    (x1 237)))))))
+
+  (local (defthm terrible-lemma-6
+           (IMPLIES (AND (force (integerp x2))
+                         (force (integerp x3))
+                         (force (integerp x4))
+                         (<= 144 X2)
+                         (<= X2 191)
+                         (<= 128 X3)
+                         (<= X3 191)
+                         (<= 128 X4)
+                         (<= X4 191))
+                    (UCHAR? (LOGIOR 0 (ASH (LOGAND X2 63) 12)
+                                    (ASH (LOGAND X3 63) 6)
+                                    (LOGAND X4 63))))
+           :hints(("Goal"
+                   :in-theory (enable utf8-combine4-guard
+                                      utf8-combine4
+                                      utf8-table35-bytes
+                                      utf8-table36-bytes)
+                   :use ((:instance uchar?-of-utf8-combine4
+                                    (x1 240)))))))
+
+  (local (defthm terrible-lemma-7
+           (IMPLIES (AND (force (integerp x1))
+                         (force (integerp x2))
+                         (force (integerp x3))
+                         (force (integerp x4))
+                         (<= 240 X1)
+                         (<= X1 244)
+                         (NOT (EQUAL X1 240))
+                         (NOT (EQUAL X1 244))
+                         (<= 128 X2)
+                         (<= X2 191)
+                         (<= 128 X3)
+                         (<= X3 191)
+                         (<= 128 X4)
+                         (<= X4 191))
+                    (UCHAR? (LOGIOR (ASH (LOGAND X1 7) 18)
+                                    (ASH (LOGAND X2 63) 12)
+                                    (ASH (LOGAND X3 63) 6)
+                                    (LOGAND X4 63))))
+           :hints(("Goal"
+                   :in-theory (enable utf8-combine4-guard
+                                      utf8-combine4
+                                      utf8-table35-bytes
+                                      utf8-table36-bytes)
+                   :use ((:instance uchar?-of-utf8-combine4))))))
+
+  (local (defthm terrible-lemma-8
+           (IMPLIES (AND (force (integerp x2))
+                         (force (integerp x3))
+                         (force (integerp x4))
+                         (<= 128 x2)
+                         (<= x2 143)
+                         (<= 128 x3)
+                         (<= x3 191)
+                         (<= 128 x4)
+                         (<= x4 191))
+                    (UCHAR? (LOGIOR 1048576 (ASH (LOGAND x2 63) 12)
+                                    (ASH (LOGAND x3 63) 6)
+                                    (LOGAND x4 63))))
+           :hints(("Goal"
+                   :in-theory (enable utf8-combine4-guard
+                                      utf8-combine4
+                                      utf8-table35-bytes
+                                      utf8-table36-bytes)
+                   :use ((:instance uchar?-of-utf8-combine4
+                                    (x1 244)))))))
+
+  (local (include-book "std/typed-lists/signed-byte-listp" :dir :system))
+
+  (local (defthm unsigned-byte-listp-8-of-car-of-read-byte$-all-forward
+           (implies (and (force (state-p1 state))
+                         (force (open-input-channel-p1 channel :byte state))
+                         (force (symbolp channel)))
+                    (unsigned-byte-listp 8 (mv-nth 0 (read-byte$-all channel state))))
+           :rule-classes ((:forward-chaining :trigger-terms ((read-byte$-all channel state))))))
+
+  (local (defthm unsigned-byte-listp-8-of-cdr-when-unsigned-byte-listp-8
+           (implies (unsigned-byte-listp 8 x)
+                    (unsigned-byte-listp 8 (cdr x)))
+           :rule-classes ((:forward-chaining))))
+
+  (local (defthm crock
+           (implies (unsigned-byte-listp bytes x)
+                    (iff (consp x)
+                         x))))
+
+  (local (defthm hideous-lemma-1
+           (implies (and (force (state-p1 state))
+                         (force (open-input-channel-p1 channel :byte state))
+                         (force (symbolp channel))
+                         (mv-nth 0 (read-byte$-all channel state)))
+                    (unsigned-byte-p 8 (car (mv-nth 0 (read-byte$-all channel state)))))
+           :rule-classes ((:rewrite)
+                          (:forward-chaining
+                           :trigger-terms ((mv-nth 0 (read-byte$-all channel state)))))))
+
+  (local (defthm hideous-lemma-2
+           (implies (and (force (state-p1 state))
+                         (force (open-input-channel-p1 channel :byte state))
+                         (force (symbolp channel))
+                         (cdr (mv-nth 0 (read-byte$-all channel state))))
+                    (unsigned-byte-p 8 (cadr (mv-nth 0 (read-byte$-all channel state)))))
+           :rule-classes ((:rewrite)
+                          (:forward-chaining
+                           :trigger-terms ((cdr (mv-nth 0 (read-byte$-all channel state))))))))
+
+  (local (defthm hideous-lemma-3
+           (implies (and (force (state-p1 state))
+                         (force (open-input-channel-p1 channel :byte state))
+                         (force (symbolp channel))
+                         (cddr (mv-nth 0 (read-byte$-all channel state))))
+                    (unsigned-byte-p 8 (caddr (mv-nth 0 (read-byte$-all channel state)))))
+           :rule-classes ((:rewrite)
+                          (:forward-chaining
+                           :trigger-terms ((cddr (mv-nth 0 (read-byte$-all channel state))))))
+           :hints(("Goal"
+                   :in-theory (e/d (read-byte$-all)
+                                   (car-of-read-byte$))
+                   :expand ((read-byte$-all channel state)
+                            (read-byte$-all channel (mv-nth 1 (read-byte$ channel state)))
+                            (read-byte$-all
+                             channel
+                             (mv-nth 1 (read-byte$ channel
+                                                   (mv-nth 1 (read-byte$ channel
+                                                                         state))))))))))
+
+  (local (defthm hideous-lemma-4
+           (implies (and (force (state-p1 state))
+                         (force (open-input-channel-p1 channel :byte state))
+                         (force (symbolp channel))
+                         (cdddr (mv-nth 0 (read-byte$-all channel state))))
+                    (unsigned-byte-p 8 (car (cdddr (mv-nth 0 (read-byte$-all channel state))))))
+           :rule-classes ((:rewrite)
+                          (:forward-chaining
+                           :trigger-terms ((cdddr (mv-nth 0 (read-byte$-all channel state))))))
+           :hints(("Goal"
+                   :in-theory (e/d (read-byte$-all)
+                                   (car-of-read-byte$))
+                   :expand ((read-byte$-all channel state)
+                            (read-byte$-all channel
+                                            (mv-nth 1 (read-byte$ channel state)))
+                            (read-byte$-all
+                             channel
+                             (mv-nth 1 (read-byte$ channel
+                                                   (mv-nth 1 (read-byte$ channel state)))))
+                            (read-byte$-all
+                             channel
+                             (mv-nth 1 (read-byte$
+                                        channel
+                                        (mv-nth 1 (read-byte$
+                                                   channel
+                                                   (mv-nth 1 (read-byte$ channel
+                                                                         state))))))))))))
+
+  (local (defthm integerp-when-unsigned-byte-p-8
+           (implies (unsigned-byte-p 8 x)
+                    (integerp x))))
+
+  (local (defthm signed-byte-p-from-unsigned-byte-p-8
+           (implies (and (unsigned-byte-p 8 x)
+                         (< 8 (nfix n)))
+                    (signed-byte-p n x))))
+
+  (local (defthm len-zero-when-true-listp
+           (implies (true-listp x)
+                    (equal (equal (len x) 0)
+                           (not x)))))
+
+  (local (defthm integer-squeeze-lemma
+           (implies (and (syntaxp (quotep n))
+                         (integerp n)
+                         (< (1- n) x)
+                         (< x (1+ n)))
+                    (equal (equal x n)
+                           (integerp x)))
+           :rule-classes ((:rewrite :backchain-limit-lst 1))))
+
+  (local (defthm unsigned-byte-p-8-when-valid-integer
+           (implies (and (<= 0 x)
+                         (< x 255))
+                    (equal (unsigned-byte-p 8 x)
+                           (integerp x)))
+           :rule-classes ((:rewrite :backchain-limit-lst 1))
+           :hints(("Goal" :in-theory (enable unsigned-byte-p)))))
+
+  (local (include-book "arithmetic-3/bind-free/top" :dir :system))
+
+  (local (defthm nthcdr-bytes-hack
+           (implies (and (force (state-p1 state))
+                         (force (open-input-channel-p1 channel :byte state))
+                         (force (symbolp channel))
+                         (force (natp n)))
+                    (equal (nthcdr-bytes n channel (mv-nth 1 (read-byte$ channel state)))
+                           (nthcdr-bytes (+ 1 n) channel state)))
+           :hints(("Goal"
+                   :expand (nthcdr-bytes (+ 1 n) channel state)
+                   :in-theory (enable nthcdr-bytes)
+                   :do-not-induct t))))
+
+  (local (in-theory (e/d (unsigned-byte-listp
+                          utf8-char=>uchar
+                          utf8-table35-bytes
+                          utf8-table36-bytes
+                          utf8-combine2
+                          utf8-combine3
+                          utf8-combine4
+                          utf8-combine2-guard
+                          utf8-combine3-guard
+                          utf8-combine4-guard)
+                         (
+                          ;; BOZO the above "terrible lemmas" were developed before
+                          ;; including bitops, so they're targeting the wrong normal
+                          ;; forms...
+                          LOGAND-WITH-BITMASK
+                          simplify-logior
+                          commutativity-of-logior
+                          commutativity-of-logand
+                          UTF8-PARTITION-SUCCESSFUL-WHEN-ANY-VALID-PARTITIONING-EXISTS
+                          ))))
+
+  (verify-guards read-utf8-fast
+    :hints(("Goal"
+            :do-not-induct t
+            :do-not '(generalize fertilize))))
 
+  )
 
 
 (defun read-utf8 (filename state)
diff -Nru acl2-6.2/books/unicode/utf8-decode.lisp acl2-6.3/books/unicode/utf8-decode.lisp
--- acl2-6.2/books/unicode/utf8-decode.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/unicode/utf8-decode.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -22,15 +22,26 @@
 (include-book "utf8-encode")
 (include-book "partition")
 (local (include-book "std/lists/nthcdr" :dir :system))
-(local (include-book "std/io/signed-byte-listp" :dir :system))
+(local (include-book "std/typed-lists/signed-byte-listp" :dir :system))
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "centaur/bitops/signed-byte-p" :dir :system))
 (local (include-book "tools/mv-nth" :dir :system))
+(local (include-book "std/lists/append" :dir :system))
+(local (include-book "std/lists/revappend" :dir :system))
 (set-verify-guards-eagerness 2)
 (set-state-ok t)
 
+(local (defthm signed-byte-p-resolver
+         (implies (and (integerp n)
+                       (<= 1 n)
+                       (integerp x)
+                       (<= (- (expt 2 (1- n))) x)
+                       (< x (expt 2 (1- n))))
+                  (signed-byte-p n x))
+         :hints(("Goal" :in-theory (enable signed-byte-p)))))
 
-;; BOZO library stuff
 
-(local (include-book "std/lists/append" :dir :system))
+;; BOZO library stuff
 
 (local
  (encapsulate
@@ -572,89 +583,79 @@
  )
 
 
-
 (encapsulate
- ()
-
- (local (include-book "arithmetic-3/bind-free/top" :dir :system))
-
- (local (defthm lemma1
-          (implies (utf8-table35-byte-1/1? x)
-                   (utf8-table35-ok? x (list x)))
-          :hints(("Goal" :in-theory (enable unsigned-byte-p
-                                            uchar?
-                                            utf8-table35-ok?
-                                            utf8-table35-row-1?
-                                            utf8-table35-codepoint-1?
-                                            utf8-table35-byte-1/1?)))))
-
- (local (defthm lemma2
-          (implies (and (equal (len x) 1)
-                        (true-listp x)
-                        (utf8-table35-byte-1/1? (first x)))
-                   (utf8-table35-ok? (first x) x))))
-
- (local (defthm lemma3
-          (implies (utf8-table35-byte-1/1? x)
-                   (utf8-table36-ok? x (list x)))
-          :hints(("Goal" :in-theory (enable unsigned-byte-p
-                                            uchar?
-                                            utf8-table36-ok?
-                                            utf8-table36-row-1?
-                                            utf8-table36-codepoint-1?
-                                            utf8-table36-bytes-1?
-                                            utf8-table35-byte-1/1?)))))
+  ()
+  (local (include-book "arithmetic/top" :dir :system))
+  (local (include-book "std/lists/len" :dir :system))
+
+  (local (defthm lemma1
+           (implies (utf8-table35-byte-1/1? x)
+                    (utf8-table35-ok? x (list x)))
+           :hints(("Goal" :in-theory (enable unsigned-byte-p
+                                             uchar?
+                                             utf8-table35-ok?
+                                             utf8-table35-row-1?
+                                             utf8-table35-codepoint-1?
+                                             utf8-table35-byte-1/1?)))))
+
+  (local (defthm lemma2
+           (implies (and (equal (len x) 1)
+                         (true-listp x)
+                         (utf8-table35-byte-1/1? (first x)))
+                    (utf8-table35-ok? (first x) x))))
+
+  (local (defthm lemma3
+           (implies (utf8-table35-byte-1/1? x)
+                    (utf8-table36-ok? x (list x)))
+           :hints(("Goal" :in-theory (enable unsigned-byte-p
+                                             uchar?
+                                             utf8-table36-ok?
+                                             utf8-table36-row-1?
+                                             utf8-table36-codepoint-1?
+                                             utf8-table36-bytes-1?
+                                             utf8-table35-byte-1/1?)))))
+
+  (local (defthm lemma4
+           (implies (and (equal (len x) 1)
+                         (true-listp x)
+                         (utf8-table35-byte-1/1? (first x)))
+                    (utf8-table36-ok? (first x) x))))
+
+  (local (defthm lemma5-for-utf8-table35-byte-1/1?
+           (implies (utf8-table35-byte-1/1? x)
+                    (uchar? x))
+           :hints(("Goal" :in-theory (enable utf8-table35-byte-1/1?
+                                             uchar?)))))
+
+  (local (defthm lemma6
+           (implies (utf8-table35-byte-1/1? x)
+                    (equal (uchar=>utf8 x)
+                           (list x)))
+           :hints(("Goal" :in-theory (enable uchar=>utf8
+                                             utf8-table35-byte-1/1?)))))
+
+  (defthm uchar?-of-utf8-char=>uchar
+    (implies (utf8-char=>uchar x)
+             (uchar? (utf8-char=>uchar x)))
+    :hints(("Goal" :in-theory (enable utf8-char=>uchar))))
+
+  (defthm utf8-table35-okp-of-utf8-char=>uchar
+    (implies (utf8-char=>uchar x)
+             (utf8-table35-ok? (utf8-char=>uchar x) x))
+    :hints(("Goal" :in-theory (enable utf8-char=>uchar))))
+
+  (defthm utf8-table36-okp-of-utf8-char=>uchar
+    (implies (utf8-char=>uchar x)
+             (utf8-table36-ok? (utf8-char=>uchar x) x))
+    :hints(("Goal" :in-theory (enable utf8-char=>uchar))))
+
+  (defthm uchar=>utf8-of-utf8-char=>uchar
+    (implies (utf8-char=>uchar x)
+             (equal (uchar=>utf8 (utf8-char=>uchar x))
+                    x))
+    :hints(("Goal" :in-theory (enable utf8-char=>uchar))))
 
- (local (defthm lemma4
-          (implies (and (equal (len x) 1)
-                        (true-listp x)
-                        (utf8-table35-byte-1/1? (first x)))
-                   (utf8-table36-ok? (first x) x))))
-
- (local (defthm lemma5-for-utf8-table35-byte-1/1?
-          (implies (utf8-table35-byte-1/1? x)
-                   (uchar? x))
-          :hints(("Goal" :in-theory (enable utf8-table35-byte-1/1?
-                                            uchar?)))))
-
- (local (defthm lemma6
-          (implies (utf8-table35-byte-1/1? x)
-                   (equal (uchar=>utf8 x)
-                          (list x)))
-          :hints(("Goal" :in-theory (enable uchar=>utf8
-                                            utf8-table35-byte-1/1?)))))
-
- (local (defthm len-when-true-listp
-          (implies (true-listp x)
-                   (equal (equal (len x) 0)
-                          (equal x nil)))))
-
- (local (defthm true-listp-of-cdr-when-true-listp
-          (implies (true-listp x)
-                   (true-listp (cdr x)))))
-
- (defthm uchar?-of-utf8-char=>uchar
-   (implies (utf8-char=>uchar x)
-            (uchar? (utf8-char=>uchar x)))
-   :hints(("Goal" :in-theory (enable utf8-char=>uchar))))
-
- (defthm utf8-table35-okp-of-utf8-char=>uchar
-   (implies (utf8-char=>uchar x)
-            (utf8-table35-ok? (utf8-char=>uchar x) x))
-   :hints(("Goal" :in-theory (enable utf8-char=>uchar))))
-
- (defthm utf8-table36-okp-of-utf8-char=>uchar
-   (implies (utf8-char=>uchar x)
-            (utf8-table36-ok? (utf8-char=>uchar x) x))
-   :hints(("Goal" :in-theory (enable utf8-char=>uchar))))
-
- (defthm uchar=>utf8-of-utf8-char=>uchar
-   (implies (utf8-char=>uchar x)
-            (equal (uchar=>utf8 (utf8-char=>uchar x))
-                   x))
-   :hints(("Goal" :in-theory (enable utf8-char=>uchar))))
-
- )
+  )
 
 
 
@@ -1227,20 +1228,28 @@
                  :use ((:instance uchar?-of-utf8-combine4
                                   (x1 244)))))))
 
+
 (verify-guards utf8=>ustring-fast
   :hints(("Goal"
           :do-not '(generalize fertilize)
           :do-not-induct t
-          :in-theory (enable unsigned-byte-listp
-                             utf8-char=>uchar
-                             utf8-table35-bytes
-                             utf8-table36-bytes
-                             utf8-combine2
-                             utf8-combine3
-                             utf8-combine4
-                             utf8-combine2-guard
-                             utf8-combine3-guard
-                             utf8-combine4-guard))))
+          :in-theory (e/d (unsigned-byte-listp
+                           utf8-char=>uchar
+                           utf8-table35-bytes
+                           utf8-table36-bytes
+                           utf8-combine2
+                           utf8-combine3
+                           utf8-combine4
+                           utf8-combine2-guard
+                           utf8-combine3-guard
+                           utf8-combine4-guard)
+                          ;; BOZO the above "terrible lemmas" were developed
+                          ;; before including bitops, so they're targeting the
+                          ;; wrong normal forms...
+                          (LOGAND-WITH-BITMASK
+                           simplify-logior
+                           commutativity-of-logior
+                           commutativity-of-logand)))))
 
 
 ;; Finally we are ready to present our "simpler" view of the algorithm.  The
@@ -1323,8 +1332,6 @@
 
 (encapsulate
  ()
- (local (include-book "std/lists/revappend" :dir :system))
-
  (local (defthm lemma
           (implies (and (true-listp acc)
                         (mv-nth 0 (utf8-partition x)))
diff -Nru acl2-6.2/books/unicode/utf8-encode.lisp acl2-6.3/books/unicode/utf8-encode.lisp
--- acl2-6.2/books/unicode/utf8-encode.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/unicode/utf8-encode.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -19,9 +19,20 @@
 (include-book "utf8-table35")
 (include-book "utf8-table36")
 (local (include-book "std/lists/append" :dir :system))
-(local (include-book "std/io/signed-byte-listp" :dir :system))  ;; for the-fixnum
+(local (include-book "std/typed-lists/signed-byte-listp" :dir :system))  ;; for the-fixnum
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "centaur/bitops/signed-byte-p" :dir :system))
 
 
+(local (defthm signed-byte-p-resolver
+         (implies (and (integerp n)
+                       (<= 1 n)
+                       (integerp x)
+                       (<= (- (expt 2 (1- n))) x)
+                       (< x (expt 2 (1- n))))
+                  (signed-byte-p n x))
+         :hints(("Goal" :in-theory (enable signed-byte-p)))))
+
 
 ;; Conversion From Unicode to UTF-8 ===========================================
 ;;
@@ -99,7 +110,6 @@
 
 (encapsulate
  ()
-
  (local (defun test-uchar=>utf8 (i)
           (declare (xargs :guard (natp i)))
           (and (if (uchar? i)
@@ -112,6 +122,13 @@
  ;; We now show that if we have successfully tested all the integers between 0
  ;; and i, then each of these integers satisfies our desired property.
 
+ (local (defthm l0
+          (implies (and (integerp i)
+                        (integerp j)
+                        (<= j i))
+                   (equal (< (+ -1 i) j)
+                          (equal i j)))))
+
  (local (defthmd lemma
           (implies (and (test-uchar=>utf8 i)
                         (natp i)
diff -Nru acl2-6.2/books/unicode/utf8-table35.lisp acl2-6.3/books/unicode/utf8-table35.lisp
--- acl2-6.2/books/unicode/utf8-table35.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/unicode/utf8-table35.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -17,9 +17,19 @@
 
 (in-package "ACL2")
 (include-book "uchar")
-(include-book "std/io/unsigned-byte-listp" :dir :system)
-(local (include-book "std/io/signed-byte-listp" :dir :system))
-(local (in-theory (enable unsigned-byte-p)))
+(include-book "std/typed-lists/unsigned-byte-listp" :dir :system)
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "centaur/bitops/signed-byte-p" :dir :system))
+(local (include-book "std/typed-lists/signed-byte-listp" :dir :system))
+
+(local (defthm signed-byte-p-resolver
+         (implies (and (integerp n)
+                       (<= 1 n)
+                       (integerp x)
+                       (<= (- (expt 2 (1- n))) x)
+                       (< x (expt 2 (1- n))))
+                  (signed-byte-p n x))
+         :hints(("Goal" :in-theory (enable signed-byte-p)))))
 
 
 
diff -Nru acl2-6.2/books/unicode/utf8-table36.lisp acl2-6.3/books/unicode/utf8-table36.lisp
--- acl2-6.2/books/unicode/utf8-table36.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/unicode/utf8-table36.lisp	2013-09-30 17:53:20.000000000 +0000
@@ -17,11 +17,20 @@
 
 (in-package "ACL2")
 (include-book "uchar")
-(include-book "std/io/unsigned-byte-listp" :dir :system)
-(local (include-book "std/io/signed-byte-listp" :dir :system))
-(local (in-theory (enable unsigned-byte-p)))
+(include-book "std/typed-lists/unsigned-byte-listp" :dir :system)
+(local (include-book "centaur/bitops/ihsext-basics" :dir :system))
+(local (include-book "centaur/bitops/signed-byte-p" :dir :system))
+(local (include-book "std/typed-lists/signed-byte-listp" :dir :system))
 
 
+(local (defthm signed-byte-p-resolver
+         (implies (and (integerp n)
+                       (<= 1 n)
+                       (integerp x)
+                       (<= (- (expt 2 (1- n))) x)
+                       (< x (expt 2 (1- n))))
+                  (signed-byte-p n x))
+         :hints(("Goal" :in-theory (enable signed-byte-p)))))
 
 ;; UTF-8 sequences are also required to satisfy the informal constraints as
 ;; established in Table 3-6, which we recreate below:
diff -Nru acl2-6.2/books/xdoc/Makefile acl2-6.3/books/xdoc/Makefile
--- acl2-6.2/books/xdoc/Makefile	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,3 +0,0 @@
-include ../Makefile-generic
--include Makefile-deps
-
diff -Nru acl2-6.2/books/xdoc/README acl2-6.3/books/xdoc/README
--- acl2-6.2/books/xdoc/README	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/README	2013-09-30 17:52:15.000000000 +0000
@@ -1,23 +1,26 @@
 
-                      XDOC/ DIRECTORY README
+                             XDOC README
 
-The files that make up the XDOC system are split across two directories:
+XDOC is a tool for documenting ACL2 books, and is intended as a
+replacement for ACL2 facilities like defdoc, :doc, etc.
 
-    xdoc/              -- interfacing macros for documentation commands
-    xdoc-impl/         -- actual implementation of documentation commands
+XDOC can create manuals like this:
 
-Splitting up the files this way is an unfortunate hack that is necessary to
-deal with the limitations of the ACL2 build system.  In particular, ACL2's
-books/Makefile can't cope with a situation such as
+    http://fv.centtech.com/acl2/latest/doc/
 
-    foo/A depends on bar/B
-    bar/B depends on foo/C
+If you just want to see documentation for ACL2 and its books, the
+above link may be all you need.
 
-In our case, the xdoc implementation uses books from other directories like
-misc, tools, and str.  But we want to be able to document books in these
-directories with xdoc!
+You might prefer a local copy of the documentation, e.g., for offline
+use.  If you have already built the ACL2 books, you should already
+have a local copy here:
 
-Fortunately, very little is needed to implement the defxdoc command.  So, my
-basic approach is to make the interface available in the xdoc/ directory, which
-has no dependencies.  Then, books in directories like misc can just depend on
-xdoc, and xdoc-impl can depend on them.
+    acl2-sources/books/centaur/manual/
+
+Additional information about XDOC itself can be found here:
+
+    http://fv.centtech.com/acl2/latest/doc/frames2.html?topic=ACL2____XDOC
+
+This documentation explains how to use XDOC to document your own
+books, generate extended manuals (e.g., that cover your proprietary
+books in addition to the ordinary ACL2 books), and so forth.
diff -Nru acl2-6.2/books/xdoc/all.lisp acl2-6.3/books/xdoc/all.lisp
--- acl2-6.2/books/xdoc/all.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/all.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,45 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+
+; all.lisp -- most users should ignore this book and include top.lisp instead.
+;
+; Unlike top.lisp, this book depends on everything else in xdoc.  It may be
+; useful as a target in some Makefiles that want to ensure that all of XDOC
+; gets built.
+
+(in-package "XDOC")
+
+(include-book "base")
+(include-book "top")
+(include-book "defxdoc-raw")
+(include-book "names")
+
+(include-book "display")
+(include-book "import-acl2doc")
+(include-book "importance")
+(include-book "parse-xml")
+(include-book "preprocess")
+(include-book "save-classic")
+(include-book "save-fancy")
+(include-book "topics")
+(include-book "write-acl2-xdoc")
+
+
diff -Nru acl2-6.2/books/xdoc/autolink.lisp acl2-6.3/books/xdoc/autolink.lisp
--- acl2-6.2/books/xdoc/autolink.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/autolink.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,392 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+
+; autolink.lisp -- automatically insert links into pretty-printed s-expressions
+
+(in-package "XDOC")
+(include-book "fmt-to-str")
+(include-book "names")
+(local (include-book "misc/assert" :dir :system))
+(set-state-ok t)
+(program)
+
+
+; Convention: X is a string we are traversing, N is our current position in the
+; string, and XL is the length of the string.  The imagined guard is:
+;
+;  (declare (xargs :guard (and (stringp x)
+;                              (natp n)
+;                              (natp xl)
+;                              (= xl (length x))
+;                              (<= n xl))))
+;
+; We could do a lot of this in logic mode, but there doesn't seem to be much
+; point to that.
+
+(defun error-context (x n xl) ;; ==> STRING
+  ;; Tries to show what text is near an error.
+  (declare (type string x))
+  (let ((min (nfix (- n 40)))
+        (max (min (+ n 20) xl)))
+    (subseq x min max)))
+
+
+
+; What a pain.  We have to implement a symbol parser.
+
+(defun parse-symbol-name-part (x n xl
+                                 bar-escape-p        ; have we read an opening bar?
+                                 slash-escape-p      ; have we just read a backslash?
+                                 some-chars-p        ; have we read any chars at all yet?
+                                 nice-error-msg-p    ; do we care about nice error msgs?
+                                 acc)
+  ;; ==> (MV ERROR NAME N-PRIME)
+  (declare (type string x))
+
+; This tries to read just one part of a symbol name (i.e., the package part,
+; or the name part.)
+
+  (b* (((when (= xl n))
+        ;; End of string?  Error if we were escaped, or if we have not actually
+        ;; read some characters yet.  Otherwise, it was okay.
+        (let ((result (str::rchars-to-string acc)))
+          (if (or bar-escape-p slash-escape-p (not some-chars-p))
+              (mv (if nice-error-msg-p
+                      (concatenate 'string "Near " (error-context x n xl)
+                                   ": unexpected end of string while reading symbol.  "
+                                   "Characters read so far: " result)
+                    "Symbol Parse Error")
+                  result n)
+            (mv nil result n))))
+
+       (n+1  (+ n 1))
+       (char (char x n))
+
+       ((when slash-escape-p)
+        ;; Slash escape is on, so just add next char verbatim and turn off
+        ;; slash escape.
+        (parse-symbol-name-part x n+1 xl bar-escape-p nil t nice-error-msg-p (cons char acc)))
+
+       ((when (eql char #\|))
+        ;; Bar just toggles bar-escaped-ness.
+        (parse-symbol-name-part x n+1 xl (not bar-escape-p) nil t nice-error-msg-p acc))
+
+       ((when (eql char #\\))
+        ;; Slash starts a slash-escape.
+        (parse-symbol-name-part x n+1 xl bar-escape-p t t nice-error-msg-p acc))
+
+       ((when bar-escape-p)
+        ;; Bar-escape is on and not a special char.  Read verbatim through it's
+        ;; turned off.
+        (parse-symbol-name-part x n+1 xl t nil t nice-error-msg-p (cons char acc)))
+
+       ((when (member char '(#\Space #\( #\) #\Newline #\Tab #\Page #\: #\, #\' #\`)))
+        ;; Whitespace, paren, colon, comma, quote, backquote, outside of a bar
+        ;; escape; end of symbol.  We can stop as long as we've actually read
+        ;; some characters.
+        (if some-chars-p
+            (mv nil (str::rchars-to-string acc) n)
+          (mv (if nice-error-msg-p
+                  (str::cat "Near " (error-context x n xl)
+                            ": expected to read some part of a symbol, but found "
+                            (implode (list char)) ".")
+                "Symbol Parse Error")
+              "" n)))
+
+       ((when (or (and (char<= #\a char) (char<= char #\z))))
+        ;; lowercase letters outside of bar escape get capitalized
+        (parse-symbol-name-part x n+1 xl nil nil t nice-error-msg-p
+                                (cons (char-upcase char) acc))))
+
+    ;; Otherwise add the char verbatim
+    (parse-symbol-name-part x n+1 xl nil nil t nice-error-msg-p (cons char acc))))
+
+(defun parse-symbol (x n xl
+                       base-pkg ; default package to intern into
+                       kpa      ; (known-package-alist state)
+                       nice-error-msg-p)
+  ;; ==> (MV ERROR SYMBOL N-PRIME)
+  (declare (type string x))
+
+; This extends parse-symbol-name-part to read both parts.  We support keywords,
+; etc.  This is definitely not going to handle everything in Common Lisp, but
+; whatever.
+
+  (b* (((when (= xl n))
+        (mv (if nice-error-msg-p
+                (str::cat "Near " (error-context x n xl)
+                          ": end of string while trying to parse a symbol.")
+              "Symbol Parse Error")
+            nil n))
+       (char (char x n))
+
+       ((when (eql char #\:))
+        ;; Starts with a colon.  Maybe it's keyword symbol?
+        (b* (((mv error name n)
+              (parse-symbol-name-part x (+ n 1) xl nil nil nil nice-error-msg-p nil)))
+          (if error
+              (mv error nil n)
+            (mv nil (intern-in-package-of-symbol name :keyword) n))))
+
+       ;; Could start with a package name, or with the symbol name (for symbols
+       ;; in the base pkg). Either way, we need to read a symbol name part.
+       ((mv error part1 n)
+        (parse-symbol-name-part x n xl nil nil nil nice-error-msg-p nil))
+       ((when error)
+        (mv error nil n))
+
+       ((when (and (< (+ n 1) xl)
+                   (eql (char x n) #\:)
+                   (eql (char x (+ n 1)) #\:)))
+        ;; Found "::" after the first part, so it's a package name.
+        (b* (((unless (assoc-equal part1 kpa))
+              (mv (if nice-error-msg-p
+                      (str::cat "Near " (error-context x n xl)
+                                ": not a known package: " part1 ".")
+                    "Symbol Parse Error")
+                  nil n))
+             ((mv error part2 n)
+              (parse-symbol-name-part x (+ n 2) xl nil nil nil nice-error-msg-p nil))
+             ((when error)
+              (mv error nil n))
+             ;; Things look pretty good here.  One weird thing we will try to
+             ;; detect is if there are extra colons, e.g., foo::bar::baz should
+             ;; be disallowed.  We really want a whitespace or paren or quote
+             ;; or something
+             ((when (eql (char x n) #\:))
+              (mv (if nice-error-msg-p
+                      (str::cat "Near " (error-context x n xl)
+                                ": Three layers of colons in symbol name?")
+                    "Symbol Parse Error")
+                  nil n)))
+          (mv nil (intern$ part2 part1) n)))
+
+       ;; Didn't find a :: after part1.
+       ((when (and (< n xl)
+                   (eql (char x n) #\:)))
+        (mv (if nice-error-msg-p
+                (str::cat "Near " (error-context x n xl)
+                          ": Lone colon after symbol name?")
+              "Symbol Parse Error")
+            nil n)))
+
+    ;; We seem to have an okay package name, but no ::, so put it into the base
+    ;; package.
+    (mv nil (intern-in-package-of-symbol part1 base-pkg) n)))
+
+(encapsulate
+  ()
+  (logic) ;; since otherwise local stuff gets skipped
+
+  (local
+   (defun test (x expect-errmsg expect-result expect-n-prime)
+     (declare (xargs :mode :program))
+     (b* ((known-pkgs (pairlis$ '("KEYWORD" "ACL2" "XDOC") nil))
+          ((mv errmsg result n-prime)
+           (parse-symbol x 0 (length x) 'acl2::foo known-pkgs t)))
+       (cw "Errmsg: Found ~x0, expected ~x1~%" errmsg expect-errmsg)
+       (cw "Result: Found ~x0, expected ~x1~%" result expect-result)
+       (cw "N-prime: Found ~x0, expected ~x1~%" n-prime expect-n-prime)
+       (and (or (iff errmsg expect-errmsg) (cw "Errmsg failed!~%"))
+            (or expect-errmsg
+                (equal result expect-result)
+                (cw "Result failed!~%"))
+            (or expect-errmsg
+                (equal n-prime expect-n-prime)
+                (cw "N-Prime failed!~%"))))))
+
+  (local
+   (progn
+     ;; Things that should work
+     (assert! (test "foo" nil 'acl2::foo 3))
+     (assert! (test "bar" nil 'acl2::bar 3))
+     (assert! (test "acl2::bar)" nil 'acl2::bar 9))
+     (assert! (test "xdoc::bar)" nil 'xdoc::bar 9))
+     (assert! (test "xdoc::|foo|)" nil 'xdoc::|foo| 11))
+     (assert! (test "xdoc::bar12 " nil 'xdoc::bar12 11))
+
+     (assert! (test ":foo)" nil :foo 4))
+     (assert! (test ":|foo|)" nil :|foo| 6))
+     (assert! (test ":||" nil :|| 3))
+     (assert! (test "acl2::bar|:|)" nil 'acl2::bar|:| 12))
+
+     ;; Things that should fail
+     (assert! (test ":" t nil nil))     ;; lone colon, not ok
+     (assert! (test "||:" t nil nil))   ;; ending colon, not ok
+     (assert! (test "::|foo|)" t nil nil)) ;; starting colons w/o pkgname, not ok
+     (assert! (test "acl2:::bar)" t nil nil)) ;; three colons, not ok
+     (assert! (test "acl2::bar:" t nil nil))  ;; extra colon, not ok
+
+     ;; Uh... bug?  feature?
+     (assert! (test "123" nil 'acl2::|123| 3)))))
+
+
+
+
+(defun autolink-and-encode (x n xl topics base-pkg kpa acc) ;; ==> ACC
+
+; Main routine for autolinking and HTML encoding s-expressions.  X typically
+; has a pretty-printed S-expression that we want to turn into an XDOC <code>
+; segment.  TOPICS is a fast alist whose keys are the known topic names, for
+; fast lookups of whether a symbol is a topic.
+;
+; We walk over the string and look for symbols following open-parens; this
+; limitation is meant to reduce the amount of symbol parsing we have to do and
+; should be good enough to insert links to function calls.  Whenever we find a
+; symbol that is a documented topic, we insert a link to it.  We also HTML
+; encode the string in the process.
+
+  (b* (((when (int= n xl))
+        acc)
+       (char1 (char x n))
+       ((when (eql char1 #\<)) ;; --> "&lt;" in reverse
+        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa
+                             (list* #\; #\t #\l #\& acc)))
+       ((when (eql char1 #\>)) ;; --> "&gt;" in reverse
+        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa
+                             (list* #\; #\t #\g #\& acc)))
+       ((when (eql char1 #\&)) ;; --> "&amp;" in reverse
+        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa
+                             (list* #\; #\p #\m #\a #\& acc)))
+       ((when (eql char1 #\")) ;; --> "&quot;" in reverse
+        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa
+                             (list* #\; #\t #\o #\u #\q #\& acc)))
+       ((unless (eql char1 #\())
+        ;; Anything else except an open paren, we aren't going to do anything
+        ;; special with.  This way we don't have to call parse-symbol most of
+        ;; the time.
+        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa (cons char1 acc)))
+
+       (acc (cons char1 acc))
+       ((mv err symbol n-prime) (parse-symbol x (+ 1 n) xl base-pkg kpa nil))
+
+       ((when err)
+        ;; Failed to parse a valid symbol after it, so that's fine, maybe we hit
+        ;; a quoted thing like '((1 . 2)) or whatever.  Just keep going.
+        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa acc))
+
+       (look (hons-get symbol topics))
+       ((unless look)
+        ;; Nope, not a documented topic, so that's fine, just leave the paren
+        ;; there and keep on encoding things without inserting a link.
+        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa acc))
+
+       ;; Finally, the interesting case.  We just found something like
+       ;; "(append".  We want to convert this into, e.g.,
+       ;; (<see topic='[url-for-append]'>append</see>
+       ;; and then keep going with our encoding.
+       (acc
+        ;; <see topic="
+        (list* #\" #\= #\c #\i #\p #\o #\t #\Space #\e #\e #\s #\< acc))
+       (acc (file-name-mangle symbol acc))
+       (acc
+        ;; ">
+        (list* #\> #\" acc))
+       ;; Subtle: normally the "xl" argument should be the length of the string
+       ;; here, but we only want to encode the part of the name that we read.
+       ;; So, use the new N-PRIME returned by the symbol parser for the XL part
+       ;; to stop early.
+       (acc (simple-html-encode-str x (+ 1 n) n-prime acc))
+       (acc
+        ;; </see>
+        (list* #\> #\e #\e #\s #\/ #\< acc)))
+    ;; Finally recur...
+    (autolink-and-encode x n-prime xl topics base-pkg kpa acc)))
+
+(encapsulate
+  ()
+  (logic)
+
+  (local (defun test (str expect)
+           (declare (xargs :mode :program))
+           (b* ((topics '(acl2::f g h foo bar baz + - xdoc::top1 xdoc::top2)) ;; just for testing
+                (alist  (make-fast-alist (pairlis$ topics nil)))
+                (known-pkgs (pairlis$ '("ACL2" "KEYWORD" "XDOC") nil))
+                (acc    (autolink-and-encode str 0 (length str) alist 'acl2::foo known-pkgs nil))
+                (-      (fast-alist-free alist))
+                (result (str::rchars-to-string acc)))
+             (or (equal result expect)
+                 (cw "Result: ~x0~%" result)
+                 (cw "Expected: ~x0~%" expect)))))
+
+  (local
+   (progn
+
+     (assert! (test "foo"
+                    ;; -->
+                    "foo"))
+
+     (assert! (test "foo & bar"
+                    ;; -->
+                    "foo &amp; bar"))
+
+     (assert! (test "foo & bar <baz>"
+                    ;; -->
+                    "foo &amp; bar &lt;baz&gt;"))
+
+     (assert! (test "(foo (+ 1 2))"
+                    ;; note that foo doesn't get processed: xdoc::foo is among the topics, but
+                    ;; since the base-pkg is acl2, the foo here is acl2::foo.
+                    "(foo (<see topic=\"COMMON-LISP_____B2\">+</see> 1 2))"))
+
+     (assert! (test "(xdoc::foo (f 1 2))"
+                    ;; -->
+                    "(<see topic=\"XDOC____FOO\">xdoc::foo</see> (<see topic=\"ACL2____F\">f</see> 1 2))")))))
+
+
+
+(defun xml-ppr-obj-aux
+  (x          ; object to pretty-print
+   topics-fal ; fast alist binding all xdoc topic names to [irrelevant]
+   base-pkg   ; base package to print from
+   state
+   acc)
+  (b* ((kpa (known-package-alist state))
+       ((mv str state) (fmt-to-str x base-pkg state))
+       (acc (autolink-and-encode str 0 (length str) topics-fal base-pkg kpa acc)))
+    (mv acc state)))
+
+(defun xml-ppr-obj-fn (x topics-fal base-pkg state)
+  (b* (((mv acc state) (xml-ppr-obj-aux x topics-fal base-pkg state nil))
+       (ret (str::rchars-to-string acc)))
+    (mv ret state)))
+
+;; Ugh, the use of state-state here is awful.  formerly this wasn't a macro and
+;; was just took x and state.  But then I added topics-fal and base-pkg, and
+;; there's too much code that calls it directly.  So, I want to maintain some
+;; kind of interface compatibility.
+(defmacro xml-ppr-obj (x state-state
+                         &key
+                         (topics-fal 'nil)
+                         (base-pkg   ''acl2::foo))
+  `(b* (((mv acc ,state-state)
+         (xml-ppr-obj-aux ,x ,topics-fal ,base-pkg ,state-state nil))
+        (ret (str::rchars-to-string acc)))
+     (mv ret ,state-state)))
+
+
+
+#|
+(xml-ppr-obj '(f 1 2) state :topics-fal (make-fast-alist '((f . nil))))
+(xml-ppr-obj '(f 1 2) state
+             :topics-fal (make-fast-alist '((f . nil)))
+             :base-pkg 'xdoc::foo)
+|#
diff -Nru acl2-6.2/books/xdoc/base.acl2 acl2-6.3/books/xdoc/base.acl2
--- acl2-6.2/books/xdoc/base.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/base.acl2	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,24 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+;; Special .acl2 file for base.lisp, so that base.lisp won't need to include
+;; the portcullis files for libraries other than XDOC.
+(include-book "portcullis")
+
diff -Nru acl2-6.2/books/xdoc/base.lisp acl2-6.3/books/xdoc/base.lisp
--- acl2-6.2/books/xdoc/base.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/base.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -23,6 +23,7 @@
 ; instead.
 
 (in-package "XDOC")
+(set-state-ok t)
 
 #!ACL2
 (defmacro lnfix (x)
@@ -37,21 +38,31 @@
   `(mbe :logic (ifix ,x) :exec ,x))
 
 
-(make-event
- `(defconst *xdoc-dir* ,(cbd)))
-
-(make-event
- (let* ((books/xdoc      (cbd))
-        (books/          (acl2::extend-pathname books/xdoc ".." state))
-        (books/xdoc-impl (acl2::extend-pathname books/ "xdoc-impl" state)))
-   `(defconst *xdoc-impl-dir* ,books/xdoc-impl)))
-
 (table xdoc 'doc nil)
+(table xdoc 'default-parents nil)
+(table xdoc 'post-defxdoc-event nil)
 
 (defun get-xdoc-table (world)
   (declare (xargs :mode :program))
   (cdr (assoc-eq 'doc (table-alist 'xdoc world))))
 
+(defmacro set-default-parents (&rest parents)
+  `(table xdoc 'default-parents
+          (let ((parents ',parents))
+            (cond ((symbol-listp parents)
+                   parents)
+                  ((and (consp parents)
+                        (atom (cdr parents))
+                        (symbol-listp (car parents)))
+                   (car parents))
+                  (t
+                   (er hard? 'set-default-parents
+                       "Expected a symbol-listp, but found ~x0" parents))))))
+
+(defun get-default-parents (world)
+  (declare (xargs :mode :program))
+  (cdr (assoc-eq 'default-parents (table-alist 'xdoc world))))
+
 (defun guard-for-defxdoc (name parents short long)
   (declare (xargs :guard t))
   (and (or (symbolp name)
@@ -65,17 +76,47 @@
            (stringp long)
            (cw ":long is not a string (or nil)~%"))))
 
+(defun normalize-bookname (bookname state)
+  (let* ((dir-system (acl2::f-get-global 'acl2::system-books-dir state))
+         (lds        (length dir-system)))
+    ;; Eventually we could do something fancier to support
+    ;; add-include-book-dirs, but this is probably fine for the Community
+    ;; Books, at least.
+    (if (and (stringp dir-system)
+             (stringp bookname)
+             (<= lds (length bookname))
+             (equal dir-system (subseq bookname 0 lds)))
+        (concatenate 'string "[books]/"
+                     (subseq bookname lds nil))
+      nil)))
+
 (defmacro defxdoc (name &key parents short long)
   (declare (xargs :guard (guard-for-defxdoc name parents short long)))
-  `(make-event
-    (let* ((pkg   (acl2::f-get-global 'current-package state))
-           (entry (list (cons :name ',name)
-                        (cons :base-pkg (acl2::pkg-witness pkg))
-                        (cons :parents ',parents)
-                        (cons :short ',short)
-                        (cons :long ',long))))
-     `(table xdoc 'doc
-             (cons ',entry (get-xdoc-table world))))))
+  `(with-output :off (event summary)
+    (make-event
+     (let* ((world (w state))
+            (pkg   (acl2::f-get-global 'acl2::current-package state))
+            (info  (acl2::f-get-global 'acl2::certify-book-info state))
+            (bookname (if info
+                          (acl2::access acl2::certify-book-info info :full-book-name)
+                        "Current Interactive Session"))
+            (bookname (normalize-bookname bookname state))
+            (parents (or ',parents (get-default-parents (w state))))
+            (entry (list (cons :name ',name)
+                         (cons :base-pkg (acl2::pkg-witness pkg))
+                         (cons :parents parents)
+                         (cons :short ',short)
+                         (cons :long ',long)
+                         (cons :from bookname)))
+            (table-event
+             `(table xdoc 'doc
+                     (cons ',entry (get-xdoc-table world))))
+            (post-event
+             (cdr (assoc-eq 'post-defxdoc-event (table-alist 'xdoc world)))))
+       `(progn
+          ,table-event
+          ,@(and post-event (list post-event))
+          (value-triple '(defxdoc ,',name)))))))
 
 (defun defxdoc-raw-fn (name parents short long)
   (declare (xargs :guard t)
@@ -97,4 +138,4 @@
       nil
     (if (equal (cdr (assoc :name (car x))) name)
         (car x)
-      (find-topic name (cdr x)))))
\ No newline at end of file
+      (find-topic name (cdr x)))))
diff -Nru acl2-6.2/books/xdoc/book-thms.acl2 acl2-6.3/books/xdoc/book-thms.acl2
--- acl2-6.2/books/xdoc/book-thms.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/book-thms.acl2	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,22 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+;; Special .acl2 file for book-thms.lisp, because it doesn't need to depend
+;; on any packages at all.
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc/cert.acl2 acl2-6.3/books/xdoc/cert.acl2
--- acl2-6.2/books/xdoc/cert.acl2	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/cert.acl2	2013-09-30 17:52:15.000000000 +0000
@@ -18,5 +18,8 @@
 ;
 ; Original author: Jared Davis <jared@centtech.com>
 
+(include-book "str/portcullis" :dir :system)
+(include-book "oslib/portcullis" :dir :system)
+(include-book "centaur/bridge/portcullis" :dir :system)
 (include-book "portcullis")
 ; cert-flags: ? t :ttags :all
diff -Nru acl2-6.2/books/xdoc/classic/LICENSE acl2-6.3/books/xdoc/classic/LICENSE
--- acl2-6.2/books/xdoc/classic/LICENSE	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/LICENSE	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,74 @@
+
+                   ACL2 XDOC CLASSIC VIEWER - SUPPORT FILES
+                            COPYRIGHT INFORMATION
+
+
+Most source files (Makefile-trans, *.xsl, *.html, *.js, *.css) have copyright
+information embedded within them; for most of these files the copyright is as
+follows:
+
+   XDOC Documentation System for ACL2
+   Copyright (C) 2009-2013 Centaur Technology
+
+   Contact:
+     Centaur Technology Formal Verification Group
+     7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+     http://www.centtech.com/
+
+   This program is free software; you can redistribute it and/or modify it
+   under the terms of the GNU General Public License as published by the Free
+   Software Foundation; either version 2 of the License, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+   more details.
+
+   You should have received a copy of the GNU General Public License along with
+   this program; if not, write to the Free Software Foundation, Inc., 51
+   Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+   Original author: Jared Davis <jared@centtech.com>
+
+This copyright also applies to the following images, which are original
+drawings by Centaur Technology for XDOC:
+
+   - leaf.png
+   - minus.png
+   - plus.png
+
+
+However, the many image files supporting the ACL2 Tours have a different
+heritage and copyright.  These images (*.gif) were copied from ACL2, and their
+license is as follows:
+
+    Copyright (c) 2012 Regents of the University of Texas.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions are met:
+
+    o Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+
+    o Redistributions in binary form must reproduce the above copyright notice,
+      this list of conditions and the following disclaimer in the documentation
+      and/or other materials provided with the distribution.
+
+    o Neither the name of the University of Texas, Austin nor the names of its
+      contributors may be used to endorse or promote products derived from this
+      software without specific prior written permission.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+    AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+    IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+    ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+    LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+
diff -Nru acl2-6.2/books/xdoc/classic/Makefile-trans acl2-6.3/books/xdoc/classic/Makefile-trans
--- acl2-6.2/books/xdoc/classic/Makefile-trans	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/Makefile-trans	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,149 @@
+# -*- mode: Makefile -*-
+# XDOC Documentation System for ACL2
+# Copyright (C) 2009 Centaur Technology
+#
+# Contact:
+#   Centaur Technology Formal Verification Group
+#   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+#   http://www.centtech.com/
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.  This program is distributed in the hope that it will be useful but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.  You should have received a copy of the GNU General Public
+# License along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# Original author: Jared Davis <jared@centtech.com>
+
+
+# XDOC CONVERSION MAKEFILE
+#
+# This Makefile can convert generate HTML and TEXT documentation from XDOC
+# documentation in XML format.
+#
+# Steps to using it:
+#
+#   (1) Generate your xdoc documentation using xdoc::save.  This should result
+#       in a directory, say "my-doc-dir", with a subdirectory named "xml" that
+#       contains a lot of XML files, and a copy of this Makefile as its Makefile.
+#
+#   (2) In my-doc-dir, just run "make" to do the conversion.  By default all
+#       supported formats will be generated.  If you only want a particular
+#       format, you can do, e.g., "make html", or "make text", etc.  If you 
+#       encounter an error, consider using GNU Make's "-k" flag.
+
+
+
+# --- Sanity check that Xalan is installed -----------------------------------
+
+XALAN ?= $(shell which Xalan 2>/dev/null || echo "")
+XALAN_UBUNTU ?= $(shell which xalan 2>/dev/null || echo "")
+
+ifeq "$(XALAN)" ""
+ifeq "$(XALAN_UBUNTU)" ""
+
+$(info )
+$(info Error: Xalan-C++ not found.)
+$(info )
+$(info Xalan-C++ is available from http://xml.apache.org/xalan-c/.)
+$(info )
+$(info Depending on your operating system, it may be possible to easily install it)
+$(info using tools like apt-get, port, or similar.)
+$(info )
+$(info Once you have Xalan installed, you should be able to invoke "Xalan" with no)
+$(info arguments and see a message like:)
+$(info )
+$(info     Xalan version 1.10.0.)
+$(info     Xerces version 2.7.0.)
+$(info     Usage: Xalan [options] source stylesheet)
+$(info     ...)
+$(info )
+$(info Note: if you just want to view the documentation and do not care about)
+$(info turning into HTML, try opening preview.html in your web browser.)
+$(info )
+$(error Xalan-C++ not found)
+
+endif
+endif
+
+
+# ----------------------------------------------------------------------------
+
+# Define a function named xslt-translate that take three arguments:
+# (1) the input xml file, (2) the xsl file that indicates how the xml
+# should be rendered, and (3) the output file.
+ifneq "$(XALAN)" ""
+$(info Using $(XALAN) with -o [output] [input] [stylesheet])
+xslt-translate = $(XALAN) -o $(3) $(1) $(2)
+else
+$(info Using $(XALAN_UBUNTU) with -in [input] -xsl [stylesheet] -out [output])
+xslt-translate = $(XALAN_UBUNTU) -in $(1) -xsl $(2) -out $(3)
+endif
+
+
+XML_TOPICS := $(wildcard xml/*.xml)
+XDOC_LINKS := $(wildcard xml/*.xdoc-link)
+
+HTML_TOPICS := $(patsubst xml/%.xml, html/%.html, $(XML_TOPICS))
+TEXT_TOPICS := $(patsubst xml/%.xml, text/%.text, $(XML_TOPICS))
+
+HTML_XDOC_LINKS := $(patsubst xml/%.xdoc-link, html/%.xdoc-link, $(XDOC_LINKS))
+
+
+FORMATS := text html
+
+.PHONY: all
+all: $(FORMATS)
+
+
+.PHONY: text
+text: $(TEXT_TOPICS)
+
+.PHONY: text-dir
+text-dir:
+	@echo "Preparing text/ directory"
+	@mkdir -p text
+
+text/%.text: xml/%.xml xml/text-topic.xsl text-dir
+	@echo $@
+	@$(call xslt-translate,xml/$*.xml,xml/text-topic.xsl,text/$*.text)
+
+.PHONY: html
+html: $(HTML_TOPICS) \
+      $(HTML_XDOC_LINKS) \
+      html/full-index.html \
+      html/brief-index.html \
+      html/topic-index.html
+
+.PHONY: html-dir
+html-dir:
+	@echo "Preparing html/ directory"
+	@mkdir -p html
+	@cp xml/xdoc.css xml/xdoc.js html
+	@cp xml/*.png xml/*.gif html
+
+# Goofy to copy them all one by one, but prevents "too many arguments"
+# warnings during the copy command in some extreme cases
+html/%.xdoc-link: xml/%.xdoc-link
+	@echo $@
+	@cp xml/$*.xdoc-link html/$*.xdoc-link
+
+html/%.html: xml/%.xml xml/html-topic.xsl html-dir
+	@echo $@
+	@$(call xslt-translate,xml/$*.xml,xml/html-topic.xsl,html/$*.html)
+
+html/full-index.html: xml/index.xml xml/html-full-index.xsl html-dir
+	@echo $@
+	@$(call xslt-translate,xml/index.xml,xml/html-full-index.xsl,$@)
+
+html/brief-index.html: xml/index.xml xml/html-brief-index.xsl html-dir
+	@echo $@
+	@$(call xslt-translate,xml/index.xml,xml/html-brief-index.xsl,$@)
+
+html/topic-index.html: xml/topics.xml xml/html-topic-index.xsl html-dir
+	@echo $@
+	@$(call xslt-translate,xml/topics.xml,xml/html-topic-index.xsl,$@)
diff -Nru acl2-6.2/books/xdoc/classic/README acl2-6.3/books/xdoc/classic/README
--- acl2-6.2/books/xdoc/classic/README	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/README	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,3 @@
+These are supporting files for "classic" XDOC manuals.
+See, for instance, xdoc/save-classic.lisp.
+The GIF images here are also used in the fancy viewer.
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/acl2-logo-200-134.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/acl2-logo-200-134.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/acl2-logo-62-41.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/acl2-logo-62-41.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/acl2-system-architecture.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/acl2-system-architecture.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/automatic-theorem-prover.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/automatic-theorem-prover.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/binary-trees-app-expl.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/binary-trees-app-expl.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/binary-trees-app.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/binary-trees-app.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/binary-trees-x-y.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/binary-trees-x-y.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/book04.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/book04.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/bridge-analysis.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/bridge-analysis.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/bridge.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/bridge.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/chem01.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/chem01.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/common-lisp.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/common-lisp.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/computing-machine-5x7.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/computing-machine-5x7.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/computing-machine-5xy.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/computing-machine-5xy.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/computing-machine-a.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/computing-machine-a.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/computing-machine-xxy.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/computing-machine-xxy.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/computing-machine.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/computing-machine.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/concrete-proof.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/concrete-proof.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/doc03.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/doc03.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/docbag2.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/docbag2.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/door02.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/door02.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/file03.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/file03.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/file04.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/file04.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/flying.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/flying.gif differ
diff -Nru acl2-6.2/books/xdoc/classic/frames2.html acl2-6.3/books/xdoc/classic/frames2.html
--- acl2-6.2/books/xdoc/classic/frames2.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/frames2.html	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,68 @@
+<html>
+
+<!--
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+-->
+
+
+<!-- You may wish to develop a customized replacement for this page. -->
+
+<head>
+<title>XDOC Manual</title>
+</head>
+
+<script language="JavaScript">
+<!--
+
+function getPageParameters ()
+{
+   var ret = {};
+   if (!window.location.toString().match(/\?(.+)$/)) {
+       return ret;
+   }
+   param_strs = RegExp.$1.split("&");
+   var param_arr = {};
+   for(var i = 0; i < param_strs.length; ++i)
+   {
+      var tmp = param_strs[i].split("=");
+      var key = decodeURI(tmp[0]);
+      var val = decodeURI(tmp[1]);
+      param_arr[key] = val;
+   }
+   return param_arr;
+}
+
+// We generate the frameset so that you can deeply link to a particular page
+// by adding, e.g., ?topic=COMMON-LISP____APPEND
+
+var params = getPageParameters();
+var topic = params["topic"] || "ACL2____TOP";
+var url = topic ? ("html/" + topic + ".html") : "html/full-index.html";
+
+document.write("<frameset cols='20%,*' border='2' bordercolor='#000000'>\n");
+document.write("  <frame src='html/topic-index.html' name='topics' />\n");
+document.write("  <frame src='" + url + "' name='detail' />\n");
+document.write("</frameset>\n");
+
+// -->
+</script>
+
+</html>
diff -Nru acl2-6.2/books/xdoc/classic/frames3.html acl2-6.3/books/xdoc/classic/frames3.html
--- acl2-6.2/books/xdoc/classic/frames3.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/frames3.html	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,71 @@
+<html>
+
+<!--
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+-->
+
+
+<!-- You may wish to develop a customized replacement for this page. -->
+
+<head>
+<title>XDOC Manual</title>
+</head>
+
+<script language="JavaScript">
+<!--
+
+// We generate the frameset so that you can deeply link to a particular page
+// by adding, e.g., ?topic=COMMON-LISP____APPEND
+
+function getPageParameters ()
+{
+   var ret = {};
+   if (!window.location.toString().match(/\?(.+)$/)) {
+       return ret;
+   }
+   param_strs = RegExp.$1.split("&");
+   var param_arr = {};
+   for(var i = 0; i < param_strs.length; ++i)
+   {
+      var tmp = param_strs[i].split("=");
+      var key = decodeURI(tmp[0]);
+      var val = decodeURI(tmp[1]);
+      param_arr[key] = val;
+   }
+   return param_arr;
+}
+
+var params = getPageParameters();
+var topic = params["topic"] || "ACL2____TOP";
+var url = topic ? ("html/" + topic + ".html") : "html/full-index.html";
+
+document.write("<frameset cols='20%,*' border='2' bordercolor='#000000'>\n");
+document.write("  <frameset rows='70%,30%' border='2' bordercolor='#000000'>\n");
+document.write("    <frame src='html/topic-index.html' name='topics' />\n");
+document.write("    <frame src='html/brief-index.html' name='brief' />\n");
+document.write("  </frameset>\n");
+document.write("  <frame src='" + url + "' name='detail' />\n");
+document.write("</frameset>\n");
+
+-->
+</script>
+
+</html>
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/ftp2.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/ftp2.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/gift.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/gift.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/green-line.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/green-line.gif differ
diff -Nru acl2-6.2/books/xdoc/classic/html-brief-index.xsl acl2-6.3/books/xdoc/classic/html-brief-index.xsl
--- acl2-6.2/books/xdoc/classic/html-brief-index.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/html-brief-index.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,62 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  html-brief-index.xsl
+
+  Provides a compact view of the index for the three-frame html display.  You
+  can compare/contrast with html-full-index.xsl which generates the more
+  elaborate index.
+
+-->
+
+<xsl:include href="html-topic.xsl"/>
+
+<xsl:template match="page">
+  <html>
+  <head>
+    <title><xsl:value-of select="@name"/></title>
+    <link rel="stylesheet" type="text/css" href="xdoc.css"/>
+    <base target="detail"/>
+  </head>
+  <body class="body_brief">
+<!--   <h4>Alphabetic Listing</h4> -->
+  <xsl:apply-templates/>
+  </body>
+  </html>
+</xsl:template>
+
+<xsl:template match="index">
+  <dl class="index_brief">
+  <dt class="index_brief_dt"><a href="full-index.html">Full Index</a></dt>
+  </dl>
+  <dl class="index_brief">
+  <xsl:for-each select="index_entry">
+    <xsl:sort select="index_head/see" />
+    <dt class="index_brief_dt"><xsl:apply-templates select="index_head"/></dt>
+  </xsl:for-each>
+  </dl>
+</xsl:template>
+
+</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/classic/html-core.xsl acl2-6.3/books/xdoc/classic/html-core.xsl
--- acl2-6.2/books/xdoc/classic/html-core.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/html-core.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,244 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  html-core.xsl - main conversion from xdoc markup to html
+
+-->
+
+<xsl:template match="page">
+  <html>
+  <head>
+    <title><xsl:value-of select="@name"/></title>
+    <link rel="stylesheet" type="text/css" href="xdoc.css"/>
+    <script type="text/javascript" src="xdoc.js"/>
+  </head>
+  <body class="body_normal">
+  <xsl:apply-templates/>
+  </body>
+  </html>
+</xsl:template>
+
+<xsl:template match="index">
+  <h3><xsl:value-of select="@title"/></h3>
+  <dl class="index_dl">
+  <xsl:for-each select="index_entry">
+    <xsl:sort select="index_head/see" />
+    <dt class="index_dt"><xsl:apply-templates select="index_head"/></dt>
+    <dd class="index_dd"><xsl:apply-templates select="index_body"/></dd>
+  </xsl:for-each>
+  </dl>
+</xsl:template>
+
+<xsl:template match="topic">
+  <h1><xsl:value-of select="@name"/></h1>
+  <xsl:apply-templates/>
+</xsl:template>
+
+<xsl:template match="hindex_root">
+  <ul class="hindex"><xsl:apply-templates/></ul>
+</xsl:template>
+
+<xsl:template match="hindex_children">
+  <xsl:choose>
+    <xsl:when test="@kind='hide'">
+	<ul class="hindex" id="{@id}" style="display: none">
+	<xsl:apply-templates/>
+	</ul>
+    </xsl:when>
+
+    <xsl:otherwise>
+	<ul class="hindex" id="{@id}">
+	<xsl:apply-templates/>
+	</ul>
+    </xsl:otherwise>
+  </xsl:choose>
+</xsl:template>
+
+<xsl:template match="hindex_short">
+</xsl:template>
+
+<xsl:template match="hindex_name">
+</xsl:template>
+
+<xsl:template match="short">
+  <p><xsl:apply-templates/></p>
+</xsl:template>
+
+<xsl:template match="srclink">
+  <a href="{@file}" class="srclink" title="Find-Tag in Emacs">
+    <xsl:apply-templates/>
+  </a>
+</xsl:template>
+
+<xsl:template match="code">
+  <pre class="code"><xsl:apply-templates/></pre>
+</xsl:template>
+
+<xsl:template match="box">
+  <div class="box"><xsl:apply-templates/></div>
+</xsl:template>
+
+<xsl:template match="p">
+  <p><xsl:apply-templates/></p>
+</xsl:template>
+
+<xsl:template match="blockquote">
+  <blockquote><xsl:apply-templates/></blockquote>
+</xsl:template>
+
+<xsl:template match="br">
+  <xsl:apply-templates/><br/>
+</xsl:template>
+
+<xsl:template match="a">
+  <a href="{@href}">
+    <xsl:value-of select="."/>
+  </a>
+</xsl:template>
+
+<xsl:template match="img">
+  <img src="{@src}"/>
+</xsl:template>
+
+<xsl:template match="b">
+  <b><xsl:apply-templates/></b>
+</xsl:template>
+
+<xsl:template match="i">
+  <i><xsl:apply-templates/></i>
+</xsl:template>
+
+<xsl:template match="color">
+  <font color="{@rgb}"><xsl:apply-templates/></font>
+</xsl:template>
+
+<xsl:template match="sf">
+  <span class="sf"><xsl:apply-templates/></span>
+</xsl:template>
+
+<xsl:template match="u">
+  <u><xsl:apply-templates/></u>
+</xsl:template>
+
+<xsl:template match="tt">
+  <span class="tt"><xsl:apply-templates/></span>
+</xsl:template>
+
+<xsl:template match="ul">
+  <ul><xsl:apply-templates/></ul>
+</xsl:template>
+
+<xsl:template match="ol">
+  <ol><xsl:apply-templates/></ol>
+</xsl:template>
+
+<xsl:template match="li">
+  <li><xsl:apply-templates/></li>
+</xsl:template>
+
+<xsl:template match="dl">
+  <dl><xsl:apply-templates/></dl>
+</xsl:template>
+
+<xsl:template match="dt">
+  <dt><xsl:apply-templates/></dt>
+</xsl:template>
+
+<xsl:template match="dd">
+  <dd><xsl:apply-templates/></dd>
+</xsl:template>
+
+<xsl:template match="h1">
+  <h1><xsl:apply-templates/></h1>
+</xsl:template>
+
+<xsl:template match="h2">
+  <h2><xsl:apply-templates/></h2>
+</xsl:template>
+
+<xsl:template match="h3">
+  <h3><xsl:apply-templates/></h3>
+</xsl:template>
+
+<xsl:template match="h4">
+  <h4><xsl:apply-templates/></h4>
+</xsl:template>
+
+<xsl:template match="h5">
+  <h5><xsl:apply-templates/></h5>
+</xsl:template>
+
+
+
+<!-- Extra stuff for Symbolic Test Vectors at Centaur -->
+
+
+<xsl:template match="stv">
+  <table class="stv" cellspacing="0" cellpadding="2"><xsl:apply-templates/></table>
+</xsl:template>
+
+<xsl:template match="stv_labels">
+ <tr class="stv_labels"><xsl:apply-templates/></tr>
+</xsl:template>
+
+<xsl:template match="stv_inputs">
+  <xsl:for-each select="stv_line">
+   <tr class="stv_input_line"><xsl:apply-templates/></tr>
+  </xsl:for-each>
+</xsl:template>
+
+<xsl:template match="stv_outputs">
+  <xsl:for-each select="stv_line">
+   <tr class="stv_output_line"><xsl:apply-templates/></tr>
+  </xsl:for-each>
+</xsl:template>
+
+<xsl:template match="stv_internals">
+  <xsl:for-each select="stv_line">
+   <tr class="stv_internal_line"><xsl:apply-templates/></tr>
+  </xsl:for-each>
+</xsl:template>
+
+<xsl:template match="stv_initials">
+  <xsl:for-each select="stv_line">
+   <tr class="stv_initial_line"><xsl:apply-templates/></tr>
+  </xsl:for-each>
+</xsl:template>
+
+<xsl:template match="stv_name">
+  <th class="stv_name"><xsl:apply-templates/></th>
+</xsl:template>
+
+<xsl:template match="stv_entry">
+  <td class="stv_entry"><xsl:apply-templates/></td>
+</xsl:template>
+
+<xsl:template match="stv_label">
+  <th class="stv_label"><xsl:apply-templates/></th>
+</xsl:template>
+
+
+
+</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/classic/html-full-index.xsl acl2-6.3/books/xdoc/classic/html-full-index.xsl
--- acl2-6.2/books/xdoc/classic/html-full-index.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/html-full-index.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,46 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  html-full-index.xsl
+
+  Provides the more full view of the index, which is shown when the "Full
+  index" page is loaded.
+
+-->
+
+<xsl:include href="html-topic.xsl"/>
+
+<xsl:template match="index">
+  <h1>Full Index</h1>
+  <dl class="index_dl">
+  <xsl:for-each select="index_entry">
+    <xsl:sort select="index_head/see" />
+    <dt class="index_dt"><xsl:apply-templates select="index_head"/></dt>
+    <dd class="index_dd"><xsl:apply-templates select="index_body"/></dd>
+  </xsl:for-each>
+  </dl>
+</xsl:template>
+
+</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/classic/html-topic-index.xsl acl2-6.3/books/xdoc/classic/html-topic-index.xsl
--- acl2-6.2/books/xdoc/classic/html-topic-index.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/html-topic-index.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,55 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  html-topic-index.xsl
+
+  This generates the hierarchical topic-navigator for both the two-frame and
+  three-frame html versions.
+
+-->
+
+<xsl:include href="html-topic.xsl"/>
+
+<xsl:template match="page">
+  <html>
+  <head>
+    <title><xsl:value-of select="@name"/></title>
+    <link rel="stylesheet" type="text/css" href="xdoc.css"/>
+    <script type="text/javascript" src="xdoc.js"/>
+    <base target="detail"/>
+  </head>
+  <body class="body_brief">
+<!--   <h4>Organized Listing</h4> -->
+  <dl class="index_brief">
+  <dt class="index_brief_dt"><a href="full-index.html">Full Index</a></dt>
+  </dl>
+  <div class="hindex_fix">
+  <xsl:apply-templates/>
+  </div>
+  </body>
+  </html>
+</xsl:template>
+
+</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/classic/html-topic.xsl acl2-6.3/books/xdoc/classic/html-topic.xsl
--- acl2-6.2/books/xdoc/classic/html-topic.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/html-topic.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,72 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  html-topic.xsl
+
+  Converts an xdoc topic page to a static html page.  This is basically
+  html-core.xsl, with .html file extensions on <see> links.
+
+-->
+
+<xsl:include href="html-core.xsl"/>
+
+<xsl:template match="parent">
+  <p>Parent: <a href="{@topic}.html">
+    <xsl:value-of select="."/>
+  </a></p>
+</xsl:template>
+
+<xsl:template match="see">
+  <a href="{@topic}.html">
+    <xsl:apply-templates/>
+  </a>
+</xsl:template>
+
+<xsl:template match="hindex">
+  <li><nobr><xsl:choose>
+	<xsl:when test="@kind='leaf'">
+           <img src="leaf.png"/>
+        </xsl:when>
+
+        <xsl:when test="@kind='show'">
+           <a href="JavaScript:toggleVisible('{@id}')">
+             <img id="img-{@id}" src="minus.png" border="0"/>
+           </a>
+        </xsl:when>
+
+        <xsl:when test="@kind='hide'">
+           <a href="JavaScript:toggleVisible('{@id}')">
+             <img id="img-{@id}" src="plus.png" border="0"/>
+           </a>
+	</xsl:when>
+      </xsl:choose>
+      <a href="{@topic}.html" title="{hindex_short}">
+	<xsl:value-of select="hindex_name"/>
+     </a></nobr>
+    <xsl:apply-templates/>
+  </li>
+</xsl:template>
+
+</xsl:stylesheet>
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/index.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/index.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/info04.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/info04.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/interactive-theorem-prover-a.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/interactive-theorem-prover-a.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/interactive-theorem-prover.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/interactive-theorem-prover.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/landing.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/landing.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/large-flying.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/large-flying.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/large-walking.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/large-walking.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/leaf.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/leaf.png differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/llogo.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/llogo.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/logo.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/logo.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/mailbox1.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/mailbox1.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/minus.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/minus.png differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/new04.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/new04.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/note02.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/note02.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/open-book.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/open-book.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/pisa.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/pisa.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/plus.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/plus.png differ
diff -Nru acl2-6.2/books/xdoc/classic/preview.html acl2-6.3/books/xdoc/classic/preview.html
--- acl2-6.2/books/xdoc/classic/preview.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/preview.html	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,66 @@
+<html>
+
+<!--
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+-->
+
+
+<head>
+<title>XDOC Manual Preview</title>
+</head>
+
+<script language="JavaScript">
+<!--
+
+// We generate the frameset so that you can deeply link to a particular page
+// by adding, e.g., ?topic=COMMON-LISP____APPEND
+
+function getPageParameters ()
+{
+   var ret = {};
+   if (!window.location.toString().match(/\?(.+)$/)) {
+       return ret;
+   }
+   param_strs = RegExp.$1.split("&");
+   var param_arr = {};
+   for(var i = 0; i < param_strs.length; ++i)
+   {
+      var tmp = param_strs[i].split("=");
+      var key = decodeURI(tmp[0]);
+      var val = decodeURI(tmp[1]);
+      param_arr[key] = val;
+   }
+   return param_arr;
+}
+
+var params = getPageParameters();
+var topic = params["topic"] || "ACL2____TOP";
+var url = topic ? ("xml/" + topic + ".xml") : "xml/index.xml";
+
+document.write("<frameset cols='20%,*' border='3' bordercolor='black'>\n");
+document.write("  <frame src='xml/topics.xml' name='topics' />\n");
+document.write("  <frame src='" + url + "' name='detail' />\n");
+document.write("</frameset>\n");
+
+-->
+</script>
+
+</html>
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/proof.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/proof.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/sitting.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/sitting.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/stack.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/stack.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/state-object.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/state-object.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/teacher1.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/teacher1.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/teacher2.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/teacher2.gif differ
diff -Nru acl2-6.2/books/xdoc/classic/text-topic.xsl acl2-6.3/books/xdoc/classic/text-topic.xsl
--- acl2-6.2/books/xdoc/classic/text-topic.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/text-topic.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,226 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  text.xsl - converts xdoc markup to plain text
+
+  [Jared 1/03/11]: Note that the :xdoc command does NOT use this file; this is
+   only used to generate the files in the text/ directory of a manual, and I
+   think its output is inferior to the acl2-based :xdoc command.
+
+
+  [Jared 10/21/09]:  I haven't put too much work into this.  Doing fancy
+  things with XSLT seems rather difficult and I am not an expert.
+
+     The main deficiency right now is that I do not know how to make links
+  stand out. My word-wrapping code is copied from some web site, and to use it
+  I seem to have to treat the contents of elements such as <p> and <li> as
+  ordinary text.  This means that templates for <a> and <see> are never
+  processed.  Maybe someone who knows XSLT will be able to provide a fix.
+
+-->
+
+<xsl:output method="text"/>
+<xsl:strip-space elements="box ul ol dl p topic"/>
+
+<xsl:template match="topic">
+  <xsl:text>------------------------------------------------------------------------&#xA;&#xA;</xsl:text>
+  <xsl:text>     </xsl:text>
+  <xsl:value-of select="@name"/>
+  <xsl:text>&#xA;&#xA;</xsl:text>
+  <xsl:text>------------------------------------------------------------------------&#xA;&#xA;</xsl:text>
+  <xsl:apply-templates/>
+  <xsl:text>&#xA;------------------------------------------------------------------------&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="parent">
+  <xsl:text>Parent Topic: </xsl:text>
+  <xsl:value-of select="."/>
+  <xsl:text> (</xsl:text>
+  <xsl:value-of select="@topic"/>
+  <xsl:text>)&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="p">
+  <!-- Word wrap paragraphs. -->
+  <xsl:call-template name="wrap-string">
+   <xsl:with-param name="str" select="normalize-space(.)"/>
+   <xsl:with-param name="wrap-col" select="65"/>
+   <xsl:with-param name="break-mark" select="'&#xA;'"/>
+  </xsl:call-template>
+  <xsl:text>&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="blockquote">
+  <!-- just treat blockquotes like regular paragraphs -->
+  <xsl:call-template name="wrap-string">
+   <xsl:with-param name="str" select="normalize-space(.)"/>
+   <xsl:with-param name="wrap-col" select="65"/>
+   <xsl:with-param name="break-mark" select="'&#xA;'"/>
+  </xsl:call-template>
+  <xsl:text>&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="ul">
+  <xsl:apply-templates/>
+  <xsl:text>&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="ol">
+  <xsl:apply-templates/>
+  <xsl:text>&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="dl">
+  <xsl:apply-templates/>
+  <xsl:text>&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="box">
+  <!-- This isn't great. -->
+  <xsl:apply-templates/>
+</xsl:template>
+
+<xsl:template match="li">
+  <!-- Word wrap li elements and star them. -->
+  <xsl:text>  * </xsl:text>
+  <xsl:call-template name="wrap-string">
+   <xsl:with-param name="str" select="normalize-space(.)"/>
+   <xsl:with-param name="wrap-col" select="65"/>
+   <xsl:with-param name="break-mark" select="'&#xA;'"/>
+   <xsl:with-param name="pos" select="4"/>
+  </xsl:call-template>
+  <xsl:text>&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="dd">
+  <!-- Word wrap dd elements and indent them. -->
+  <xsl:text>      </xsl:text>
+  <xsl:call-template name="wrap-string">
+   <xsl:with-param name="str" select="normalize-space(.)"/>
+   <xsl:with-param name="wrap-col" select="65"/>
+   <xsl:with-param name="break-mark" select="'&#xA;'"/>
+   <xsl:with-param name="pos" select="6"/>
+  </xsl:call-template>
+  <xsl:text>&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="dt">
+  <!-- Word wrap dt elements and indent them. -->
+  <xsl:text>  </xsl:text>
+  <xsl:call-template name="wrap-string">
+   <xsl:with-param name="str" select="normalize-space(.)"/>
+   <xsl:with-param name="wrap-col" select="65"/>
+   <xsl:with-param name="break-mark" select="'&#xA;'"/>
+   <xsl:with-param name="pos" select="2"/>
+  </xsl:call-template>
+  <xsl:text>&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="short">
+  <xsl:apply-templates/>
+  <xsl:text>&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="h1">
+  <xsl:text>&#xA;--- </xsl:text>
+  <xsl:apply-templates/>
+  <xsl:text> ---&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="h2">
+  <xsl:text>&#xA;--- </xsl:text>
+  <xsl:apply-templates/>
+  <xsl:text> ---&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="h3">
+  <xsl:text>&#xA;--- </xsl:text>
+  <xsl:apply-templates/>
+  <xsl:text> ---&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="h4">
+  <xsl:text>&#xA;</xsl:text>
+  <xsl:apply-templates/>
+  <xsl:text>&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="h5">
+  <xsl:text>&#xA;</xsl:text>
+  <xsl:apply-templates/>
+  <xsl:text>&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="code">
+  <xsl:value-of select="."/>
+  <xsl:text>&#xA;&#xA;</xsl:text>
+</xsl:template>
+
+<xsl:template match="see">
+  <!-- This doesn't work with word-wrapping tags like <p> and <li>. -->
+  <xsl:value-of select="."/>
+  <xsl:text> (Link: </xsl:text>
+  <xsl:value-of select="@topic"/>
+  <xsl:text>)</xsl:text>
+</xsl:template>
+
+<!-- I got this this word-wrapping code from http://plasmasturm.org/log/204/ -->
+<xsl:template name="wrap-string">
+    <xsl:param name="str" />
+    <xsl:param name="wrap-col" />
+    <xsl:param name="break-mark" />
+    <xsl:param name="pos" select="0" />
+    <xsl:choose>
+        <xsl:when test="contains( $str, ' ' )">
+            <xsl:variable name="before" select="substring-before( $str, ' ' )" />
+            <xsl:variable name="pos-now" select="$pos + string-length( $before )" />
+
+            <xsl:choose>
+                <xsl:when test="$pos = 0" />
+                <xsl:when test="floor( $pos div $wrap-col ) != floor( $pos-now div $wrap-col )">
+                    <xsl:copy-of select="$break-mark" />
+                </xsl:when>
+                <xsl:otherwise>
+                    <xsl:text> </xsl:text>
+                </xsl:otherwise>
+            </xsl:choose>
+
+            <xsl:value-of select="$before" />
+
+            <xsl:call-template name="wrap-string">
+                <xsl:with-param name="str" select="substring-after( $str, ' ' )" />
+                <xsl:with-param name="wrap-col" select="$wrap-col" />
+                <xsl:with-param name="break-mark" select="$break-mark" />
+                <xsl:with-param name="pos" select="$pos-now" />
+            </xsl:call-template>
+        </xsl:when>
+        <xsl:otherwise>
+            <xsl:if test="$pos &gt; 0"><xsl:text> </xsl:text></xsl:if>
+            <xsl:value-of select="$str" />
+        </xsl:otherwise>
+    </xsl:choose>
+</xsl:template>
+
+</xsl:stylesheet>
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/time-out.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/time-out.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/tools3.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/tools3.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/twarning.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/twarning.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/uaa-rewrite.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/uaa-rewrite.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/walking.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/walking.gif differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/classic/warning.gif and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/classic/warning.gif differ
diff -Nru acl2-6.2/books/xdoc/classic/xdoc.css acl2-6.3/books/xdoc/classic/xdoc.css
--- acl2-6.2/books/xdoc/classic/xdoc.css	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/xdoc.css	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,236 @@
+/*
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+*/
+
+body {
+  font-family: "Georgia", "Bookman Old Style", serif;
+}
+
+.body_normal {
+  margin-left: 1em;
+  width: 45em;
+}
+
+h1,h2,h3,h4,h5 {
+  font-family: "Geneva", "Verdana", sans-serif;
+}
+
+h1 { font-size: 2.2em; color: #900000; text-align: center; }
+h2 { font-size: 1.8em; color: #900000; }
+h3 { font-size: 1.5em; color: #600000; }
+h4 { font-size: 1.2em; color: #600000; }
+h5 { font-size: 1.1em; color: #600000; margin-left: 1em;}
+
+p, dl { margin-left: 1em; }
+
+li    { margin-left: 1.0em; margin-bottom: 0.5em; }
+li li { margin-left: -1.0em; margin-bottom: 0em; }
+
+dt {
+  margin-left: 1em;
+  margin-top: 1em;
+  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
+  font-weight: bold;
+}
+
+.box {
+  margin-left: 1.5em;
+  margin-right: 1.5em;
+  border-width: 1px;
+  border-style: solid;
+  border-color: black;
+}
+
+.code {
+  margin-left: 2.5em;
+  padding: .5em;
+  border-left-width: 3px;
+  border-left-style: solid;
+  border-left-color: #f9e0a3;
+  color: #306030;
+  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
+}
+li .code {
+  margin-left: 1em;
+}
+
+a { text-decoration: none; }
+a:hover {
+  background-color: #ffffb0;
+  text-decoration: underline;
+}
+.code a {
+    color: #309030;
+}
+
+.srclink {
+  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
+  text-decoration: none;
+  background-color: #e0e0e0;
+  padding: 2px;
+/*  font-size: 100%; */
+}
+.srclink:hover {
+  text-decoration: none;
+}
+
+.sf {
+  font-family: "Geneva", "Verdana", sans-serif;
+}
+
+.tt {
+  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
+  color: #306030;
+/*   font-size: 100%; */
+}
+
+
+.tip {
+    width: 50em; 
+    background-color: red;
+}
+
+
+/* Brief index, used only in the 3-frame displayed */
+
+.index_brief_dt {
+  margin-top: 0px;
+  margin-left: 0em;
+  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
+  font-weight: normal;
+}
+
+.index_brief_dt a {
+  text-decoration: none;
+}
+.index_brief_dt a:hover {
+  text-decoration: underline;
+}
+
+
+/* Main, hierarchical index, used in both 2- and 3-frame displays. */
+
+.hindex {
+  list-style-type: none;
+  padding: 0px;
+  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
+  font-weight: normal;
+}
+
+.hindex li {
+  margin-bottom: 0em;
+}
+
+.hindex li li {
+  margin-left: 0.5em;
+}
+
+
+
+
+/* Extra stuff for Symbolic Test Vectors at Centaur */
+
+
+.stv {
+  margin-left: 1em;
+  border: 1px;
+  border-color: black;
+  border-style: solid;
+}
+
+.stv th {
+  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
+}
+
+.stv td {
+  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
+
+  text-align: right;
+  padding-left: .5em;
+  padding-right: .5em;
+}
+
+.stv_labels {
+  background-color: #e0ffc3;
+}
+
+.stv_labels th:nth-child(even) {
+  background-color: #e9ffd6;
+}
+
+.stv_labels th {
+  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
+  text-align: left;
+
+  border-bottom: 2px;
+  border-bottom-style: solid;
+  border-bottom-color: #b0dda3;
+
+  border-right: 1px;
+  border-right-style: solid;
+  border-right-color: #b0dda3;
+}
+
+.stv_input_line {
+  background-color: #ffe0c3;
+}
+
+.stv_input_line td:nth-child(even) {
+  background-color: #ffe9d6;
+}
+
+.stv_input_line td {
+  border-bottom: 1px;
+  border-bottom-color: #ddb0a3;
+  border-bottom-style: solid;
+  border-right: 1px;
+  border-right-style: solid;
+  border-right-color: #ddb0a3;
+}
+
+
+.stv_output_line {
+    background-color: #c3e0ff;
+}
+
+.stv_output_line td:nth-child(even) {
+  background-color: #d6e9ff;
+}
+
+.stv_output_line td {
+  border-bottom: 1px;
+  border-bottom-color: #a3b0dd;
+  border-bottom-style: solid;
+  border-right: 1px;
+  border-right-style: solid;
+  border-right-color: #a3b0dd;
+}
+
+
+.stv_name {
+    border-right: 2px;
+    border-right-style: solid;
+    border-right-color: #000060;
+    text-align: left;
+    padding-right: 1em;
+}
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc/classic/xdoc.js acl2-6.3/books/xdoc/classic/xdoc.js
--- acl2-6.2/books/xdoc/classic/xdoc.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/xdoc.js	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,42 @@
+/*
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  xdoc.js
+  JavaScript functions for XDOC
+
+*/
+
+function toggleVisible(d)
+{
+    var doc = parent.topics.document;
+
+    if (doc.getElementById(d).style.display == "none")
+    {
+	doc.getElementById(d).style.display = "block";
+        doc.getElementById("img-" + d).src = "minus.png";
+    }
+    else
+    {
+	doc.getElementById(d).style.display = "none";
+        doc.getElementById("img-" + d).src = "plus.png";
+    }
+}
diff -Nru acl2-6.2/books/xdoc/classic/xml-full-index.xsl acl2-6.3/books/xdoc/classic/xml-full-index.xsl
--- acl2-6.2/books/xdoc/classic/xml-full-index.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/xml-full-index.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,46 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  xml-full-index.xsl
+
+  Provides the more full view of the index, which is shown when the "Full
+  index" page is loaded.
+
+-->
+
+<xsl:include href="xml-topic.xsl"/>
+
+<xsl:template match="index">
+  <h1>Full Index</h1>
+  <dl class="index_dl">
+  <xsl:for-each select="index_entry">
+    <xsl:sort select="index_head/see" />
+    <dt class="index_dt"><xsl:apply-templates select="index_head"/></dt>
+    <dd class="index_dd"><xsl:apply-templates select="index_body"/></dd>
+  </xsl:for-each>
+  </dl>
+</xsl:template>
+
+</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/classic/xml-topic-index.xsl acl2-6.3/books/xdoc/classic/xml-topic-index.xsl
--- acl2-6.2/books/xdoc/classic/xml-topic-index.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/xml-topic-index.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,55 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  xml-topic-index.xsl
+
+  Used for the hierarchical topic-navigator for both the two-frame and
+  three-frame xml versions.
+
+-->
+
+<xsl:include href="xml-topic.xsl"/>
+
+<xsl:template match="page">
+  <html>
+  <head>
+    <title><xsl:value-of select="@name"/></title>
+    <link rel="stylesheet" type="text/css" href="xdoc.css"/>
+    <script type="text/javascript" src="xdoc.js"/>
+    <base target="detail"/>
+  </head>
+  <body class="body_brief">
+<!--  <h4>Organized Listing</h4> -->
+  <dl class="index_brief">
+  <dt class="index_brief_dt"><a href="index.xml">Full Index</a></dt>
+  </dl>
+  <div class="hindex_fix">
+  <xsl:apply-templates/>
+  </div>
+  </body>
+  </html>
+</xsl:template>
+
+</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/classic/xml-topic.xsl acl2-6.3/books/xdoc/classic/xml-topic.xsl
--- acl2-6.2/books/xdoc/classic/xml-topic.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/classic/xml-topic.xsl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,71 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+  xml-topic.xsl  -  directly stylize .xml files for use in a web browser
+
+  This is basically html-core.xsl, with .xml file extensions on <see> links.
+
+-->
+
+<xsl:include href="html-core.xsl"/>
+
+<xsl:template match="parent">
+  <p>Parent: <a href="{@topic}.xml">
+    <xsl:value-of select="."/>
+  </a></p>
+</xsl:template>
+
+<xsl:template match="see">
+  <a href="{@topic}.xml">
+    <xsl:apply-templates/>
+  </a>
+</xsl:template>
+
+<xsl:template match="hindex">
+  <li><nobr><xsl:choose>
+	<xsl:when test="@kind='leaf'">
+           <img src="leaf.png"/>
+        </xsl:when>
+
+        <xsl:when test="@kind='show'">
+           <a href="JavaScript:toggleVisible('{@id}')">
+             <img id="img-{@id}" src="minus.png" border="0"/>
+           </a>
+        </xsl:when>
+
+        <xsl:when test="@kind='hide'">
+           <a href="JavaScript:toggleVisible('{@id}')">
+             <img id="img-{@id}" src="plus.png" border="0"/>
+           </a>
+	</xsl:when>
+      </xsl:choose>
+      <a href="{@topic}.xml" title="{hindex_short}">
+	<xsl:value-of select="hindex_name"/>
+     </a></nobr>
+    <xsl:apply-templates/>
+  </li>
+</xsl:template>
+
+</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/debug.lisp acl2-6.3/books/xdoc/debug.lisp
--- acl2-6.2/books/xdoc/debug.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/debug.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,42 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "XDOC")
+(include-book "display")
+
+(defmacro xdoc-autodebug ()
+  '(local (make-event
+           (b* ((topics (get-xdoc-table (w state)))
+                ((unless (consp topics))
+                 (er soft 'xdoc-autodebug "No topics after defxdoc form?"))
+                (new-topic (car topics))
+                (name      (cdr (assoc :name new-topic)))
+                (state (princ$
+"-------------------------------- xdoc preview ---------------------------------
+" *standard-co* state))
+                ((mv ?er ?val state)
+                 (colon-xdoc-fn name topics state))
+                (state (princ$ "
+-------------------------------------------------------------------------------
+" *standard-co* state)))
+             (value '(value-triple :invisible))))))
+
+(table xdoc 'post-defxdoc-event '(xdoc-autodebug))
+
diff -Nru acl2-6.2/books/xdoc/defxdoc-raw-impl.lsp acl2-6.3/books/xdoc/defxdoc-raw-impl.lsp
--- acl2-6.2/books/xdoc/defxdoc-raw-impl.lsp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/defxdoc-raw-impl.lsp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,64 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+; defxdoc-raw-impl.lsp - raw Lisp version of all-xdoc-topics/defxdoc-raw-fn.
+
+(in-package "XDOC")
+(defvar *raw-xdoc-list* nil)
+
+(defun defxdoc-raw-fn (name parents short long)
+  (let* ((pkg   (package-name *package*))
+         (entry (list (cons :name name)
+                      (cons :base-pkg (acl2::pkg-witness pkg))
+                      (cons :parents parents)
+                      (cons :short short)
+                      (cons :long long))))
+    (push entry *raw-xdoc-list*)
+    nil))
+
+(defxdoc-raw defxdoc-raw
+  :parents (xdoc)
+  :short "Add documentation in raw mode."
+
+  :long "<p>@('Defxdoc-raw') allows you to document raw-lisp code with XDOC.
+It isn't possible to do this with the ordinary @(see defxdoc) command because
+@('defxdoc') is a macro that expands to a @('make-event'), and @('make-event')
+is not permitted in raw Lisp.</p>
+
+<p>@('Defxdoc-raw') is not available just by including @('xdoc/top'), because
+it requires a ttag.  So, to use it you will need:</p>
+
+@({
+ (include-book \"xdoc/defxdoc-raw\" :dir :system)
+})
+
+<p>@('Defxdoc-raw') takes the same arguments as @(see defxdoc), but adds its
+documentation to a Lisp variable rather than to the XDOC table.  Note that the
+@(':xdoc') and @(see save) commands already know about this table, so to the
+end-user, documentation added by @('defxdoc-raw') is not any different than
+documentation added by @('defxdoc').</p>")
+
+(defun all-xdoc-topics (state)
+  (if (not (acl2::live-state-p state))
+      (prog2$ (er hard? 'all-xdoc-topics "all-xdoc-topics requires a live state.")
+              (mv nil state))
+    (mv (append *raw-xdoc-list*
+                (get-xdoc-table (w state)))
+        state)))
diff -Nru acl2-6.2/books/xdoc/defxdoc-raw.acl2 acl2-6.3/books/xdoc/defxdoc-raw.acl2
--- acl2-6.2/books/xdoc/defxdoc-raw.acl2	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/defxdoc-raw.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(include-book "portcullis")
-; cert-flags: ? t :ttags :all
-(certify-book "defxdoc-raw" ? t :ttags :all)
diff -Nru acl2-6.2/books/xdoc/defxdoc-raw.lisp acl2-6.3/books/xdoc/defxdoc-raw.lisp
--- acl2-6.2/books/xdoc/defxdoc-raw.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/defxdoc-raw.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -25,12 +25,12 @@
 
 (in-package "XDOC")
 (include-book "base")
+(include-book "tools/include-raw" :dir :system)
+; (depends-on "defxdoc-raw-impl.lsp")
 (set-state-ok t)
 
 (defttag :xdoc)
 
-(remove-untouchable 'read-acl2-oracle t)
-
 (defun all-xdoc-topics (state)
   (declare (xargs :mode :program))
   (prog2$
@@ -40,50 +40,4 @@
      (declare (ignore err))
      (mv val state))))
 
-
-(acl2::progn!
- (set-raw-mode t)
-
- (defparameter *raw-xdoc-list* nil)
-
- (defun defxdoc-raw-fn (name parents short long)
-   (let* ((pkg   (package-name *package*))
-          (entry (list (cons :name name)
-                       (cons :base-pkg (acl2::pkg-witness pkg))
-                       (cons :parents parents)
-                       (cons :short short)
-                       (cons :long long))))
-     (push entry *raw-xdoc-list*)
-     nil))
-
- (defxdoc-raw defxdoc-raw
-   :parents (xdoc)
-   :short "Add documentation in raw mode."
-
-   :long "<p>@('Defxdoc-raw') allows you to document raw-lisp code with XDOC.
-It isn't possible to do this with the ordinary @(see defxdoc) command because
-@('defxdoc') is a macro that expands to a @('make-event'), and @('make-event')
-is not permitted in raw Lisp.</p>
-
-<p>@('Defxdoc-raw') is not available just by including @('xdoc/top'), because
-it requires a ttag.  So, to use it you will need:</p>
-
-@({
- (include-book \"xdoc/defxdoc-raw\" :dir :system)
-})
-
-<p>@('Defxdoc-raw') takes the same arguments as @(see defxdoc), but adds its
-documentation to a Lisp variable rather than to the XDOC table.  Note that the
-@(':xdoc') and @(see save) commands already know about this table, so to the
-end-user, documentation added by @('defxdoc-raw') is not any different than
-documentation added by @('defxdoc').</p>")
-
- (defun all-xdoc-topics (state)
-   (if (not (acl2::live-state-p state))
-       (prog2$ (er hard? 'all-xdoc-topics "all-xdoc-topics requires a live state.")
-               (mv nil state))
-     (mv (append *raw-xdoc-list*
-                 (get-xdoc-table (w state)))
-         state))))
-
-
+(acl2::include-raw "defxdoc-raw-impl.lsp")
diff -Nru acl2-6.2/books/xdoc/display.lisp acl2-6.3/books/xdoc/display.lisp
--- acl2-6.2/books/xdoc/display.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/display.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,482 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "XDOC")
+(include-book "prepare-topic")
+(include-book "spellcheck")
+(include-book "word-wrap")
+(set-state-ok t)
+(program)
+
+
+; Implements the :xdoc command for printing xdoc topics to the terminal.
+;
+; The basic approach is:
+;   1. preprocess the topic using the ordinary preprocessor (see save.lisp)
+;   2. parse the resulting xml string into a list of tokens (see parse-xml.lisp)
+;   3. transform the token list into reasonably nice plain-text
+;   4. print the text to the terminal
+;
+; Loading this file does not require a ttag.  However, actually using the :xdoc
+; command incurs a ttag by loading the defxdoc-raw book.  Of course, this is
+; typically not a problem since you only use :xdoc in interactive sessions, and
+; not while certifying books.
+
+
+
+; MERGE-TEXT eats any "throwaway tags" that we can't support in a terminal,
+; normalizes whitespace throughout text nodes, and merges any adjacent text
+; nodes.
+
+(defconst *throwaway-tags*
+  (list "b" "i" "u" "tt" "color" "sf" "a" "box" "img"
+        "page" "long"))
+
+(defun merge-text (x acc codes)
+  ;; CODES is number of open <code> tags -- we don't normalize whitespace
+  ;; within them, but entities still get converted.
+  (b* (((when (atom x))
+        acc)
+       (tok1 (car x))
+       (rest (cdr x))
+       ((when (opentok-p tok1))
+        (b* ((name (opentok-name tok1))
+             (codes (if (equal name "code")
+                        (+ 1 codes)
+                      codes)))
+          (cond ((member-equal name *throwaway-tags*)
+                 (merge-text rest acc codes))
+                ((equal name "a")
+                 (b* ((href (cdr (assoc :href (opentok-atts tok1))))
+                      (href (if (stringp href) href ""))
+                      (tok  (list :TEXT (str::cat "[" href " "))))
+                   (merge-text (cons tok rest) acc codes)))
+                ((equal name "see")
+                 (b* ((tok  (list :TEXT "[")))
+                   (merge-text (cons tok rest) acc codes)))
+                ((equal name "srclink")
+                 (b* ((tok  (list :TEXT "<")))
+                   (merge-text (cons tok rest) acc codes)))
+                (t
+                 (merge-text rest (cons tok1 acc) codes)))))
+       ((when (closetok-p tok1))
+        (b* ((name  (closetok-name tok1))
+             (codes (if (equal name "code")
+                        (- 1 codes)
+                      codes)))
+          (cond ((member-equal name *throwaway-tags*)
+                 (merge-text rest acc codes))
+                ((member-equal name '("a" "see"))
+                 (let ((tok (list :TEXT "]")))
+                   (merge-text (cons tok rest) acc codes)))
+                ((equal name "srclink")
+                 (let ((tok (list :TEXT ">")))
+                   (merge-text (cons tok rest) acc codes)))
+                (t
+                 (merge-text rest (cons tok1 acc) codes)))))
+       (tok1
+        ;; Goofy.  Convert any entities into ordinary text.  Normalize
+        ;; whitespace for any non-code tokens.
+        (cond ((entitytok-p tok1)
+               (list :TEXT (entitytok-as-plaintext tok1)))
+              ((zp codes)
+               ;; NOT in a <code> block, so normalize ws.
+               (list :TEXT (normalize-whitespace (texttok-text tok1))))
+              (t
+               ;; Inside a <code> block, so don't touch ws.
+               tok1)))
+       ((unless (texttok-p (car acc)))
+        (merge-text rest (cons tok1 acc) codes))
+
+       (merged-tok (list :TEXT (str::cat (texttok-text (car acc))
+                                         (texttok-text tok1)))))
+    (merge-text rest (cons merged-tok (cdr acc)) codes)))
+
+
+(defun has-tag-above (tag open-tags)
+  (if (atom open-tags)
+      nil
+    (or (equal tag (opentok-name (car open-tags)))
+        (has-tag-above tag (cdr open-tags)))))
+
+(defun get-indent-level (open-tags)
+  (b* (((when (atom open-tags))
+        0)
+       (name (opentok-name (car open-tags)))
+       ((when (member-equal name '("h1" "h2" "h3")))
+        0)
+       ((when (member-equal name '("p" "short" "h4" "h5" "index_entry")))
+        (+ 2 (get-indent-level (cdr open-tags))))
+       ((when (member-equal name '("index_body")))
+        (+ 4 (get-indent-level (cdr open-tags))))
+       ((when (member-equal name '("ol" "ul")))
+        ;; Note: the bullet is put into the indented space, so in practice
+        ;; an indent-level of 6 is more like an indent-level of 3.
+        (if (has-tag-above "li" open-tags)
+            (+ 4 (get-indent-level (cdr open-tags)))
+          (+ 6 (get-indent-level (cdr open-tags)))))
+       ((when (equal name "dt"))
+        (+ 4 (get-indent-level (cdr open-tags))))
+       ((when (equal name "dd"))
+        (+ 6 (get-indent-level (cdr open-tags))))
+       ((when (equal name "code"))
+        (+ 4 (get-indent-level (cdr open-tags))))
+       ((when (equal name "blockquote"))
+        (+ 4 (get-indent-level (cdr open-tags)))))
+    (get-indent-level (cdr open-tags))))
+
+(defun get-list-type (open-tags)
+  (b* (((when (atom open-tags))
+        ;; arbitrary default
+        :bulleted)
+       (name (opentok-name (car open-tags)))
+       ((when (equal name "ol"))
+        :numbered)
+       ((when (equal name "ul"))
+        :bulleted))
+    (get-list-type (cdr open-tags))))
+
+(defun auto-indent (acc open-tags)
+  (append (make-list (get-indent-level open-tags)
+                     :initial-element #\Space)
+          acc))
+
+(defun maybe-newline (acc)
+  ;; Make sure there is a newline at the start of acc.
+  (b* ((acc (remove-spaces-from-front acc))
+       (acc (if (or (atom acc)
+                    (eql (car acc) #\Newline))
+                acc
+              (cons #\Newline acc))))
+    acc))
+
+(defun maybe-doublespace (acc)
+  ;; Make sure there are two newlines at the start of acc.
+  (b* ((acc (remove-spaces-from-front acc))
+       ((when (atom acc))
+        ;; Nothing at all, don't insert anything
+        acc)
+       ((unless (eql (car acc) #\Newline))
+        ;; No newlines at all -- insert two of them.
+        (list* #\Newline #\Newline acc))
+       ;; At least one newline.  Let's eat it and see what's further on.
+       (acc (remove-spaces-from-front (cdr acc)))
+       ((when (atom acc))
+        ;; Nothing at all, don't insert anything.
+        acc)
+       ((unless (eql (car acc) #\Newline))
+        ;; No second newline.  So since we've eaten the only newline
+        ;; there was, insert two newlines.
+        (list* #\Newline #\Newline acc)))
+  ;; Found the second newline, so just restore the first one.
+  (cons #\Newline acc)))
+
+(defun maybe-triplespace (acc)
+  ;; Make sure there are three newlines at the start of acc.
+  (b* ((acc (remove-spaces-from-front acc))
+       ((when (atom acc)) acc)
+       ((unless (eql (car acc) #\Newline))
+        (list* #\Newline #\Newline #\Newline acc))
+
+       ;; Eat newline #1
+       (acc (remove-spaces-from-front (cdr acc)))
+       ((when (atom acc)) acc)
+       ((unless (eql (car acc) #\Newline))
+        (list* #\Newline #\Newline #\Newline acc))
+
+       ;; Eat newline #2
+       (acc (remove-spaces-from-front (cdr acc)))
+       ((when (atom acc)) acc)
+       ((unless (eql (car acc) #\Newline))
+        (list* #\Newline #\Newline #\Newline acc)))
+
+    (list* #\Newline #\Newline acc)))
+
+(defun prepend-each-line (spaces x n xl acc)
+  (b* (((when (>= n xl))
+        acc)
+       (char-n (char x n))
+       ((unless (eql char-n #\Newline))
+        (prepend-each-line spaces x (+ 1 n) xl (cons char-n acc)))
+       ;; Else, a newline.  delete trailing whitespace
+       (acc (remove-spaces-from-front acc))
+       (acc (cons #\Newline acc))
+       (acc (append spaces acc)))
+    (prepend-each-line spaces x (+ 1 n) xl acc)))
+
+(defun tokens-to-terminal
+  (tokens    ;; the tokens to print
+   wrap-col  ;; the goal column for word-wrap
+   open-tags ;; currently open tags
+   list-nums ;; stack of current element numbers for list printing
+   acc       ;; accumulator for output characters (in reverse order)
+   )
+  (b* (((when (atom tokens))
+        acc)
+       (tok1 (car tokens))
+       (rest (cdr tokens))
+
+       ((when (opentok-p tok1))
+        (b* ((name (opentok-name tok1))
+             (open-tags (cons tok1 open-tags))
+             (list-nums (cond
+                         ((member-equal name '("ol" "ul"))
+                          (cons 0 list-nums))
+                         ((equal name "li")
+                          (cons (+ 1 (nfix (car list-nums)))
+                                (cdr list-nums)))
+                         (t
+                          list-nums)))
+             (acc (cond
+                   ((equal name "parent")
+                    (b* ((acc (maybe-newline acc))
+                         (acc (str::revappend-chars "Parent topic: " acc)))
+                      acc))
+                   ((equal name "li")
+                    (b* ((bullet (if (eq (get-list-type open-tags) :bulleted)
+                                     "* "
+                                   (str::cat (str::natstr (nfix (car list-nums))) ". ")))
+                         (bullet-len (length bullet))
+                         (desired    (get-indent-level open-tags))
+                         (spaces  (make-list (nfix (- desired bullet-len))
+                                             :initial-element #\Space))
+                         (acc     (maybe-newline acc))
+                         (acc     (append spaces acc))
+                         (acc     (str::revappend-chars bullet acc)))
+                      acc))
+                   ((member-equal name '("h4" "h5" "short" "p" "li" "dt" "dd" "br"
+                                         "index_head" "index_body" "blockquote"))
+                    ;; This kind of tag has some level of indenting associated
+                    ;; with it, so make sure we indent over to the right level.
+                    (auto-indent (maybe-newline acc) open-tags))
+                   ((member-equal name '("code"))
+                    (auto-indent (maybe-doublespace acc) open-tags))
+                   ((member-equal name '("h1" "h2" "h3"))
+                    (auto-indent (maybe-triplespace acc) open-tags))
+                   ((equal name "index")
+                    (b* ((atts  (opentok-atts tok1))
+                         (title (cdr (assoc-equal "title" atts)))
+                         (title (if (stringp title) title "??? title ???"))
+                         (acc   (maybe-triplespace acc))
+                         (acc   (str::revappend-chars title acc))
+                         (acc   (maybe-doublespace acc)))
+                      acc))
+                   (t
+                    acc))))
+          (tokens-to-terminal rest wrap-col open-tags list-nums acc)))
+
+       ((when (closetok-p tok1))
+        (b* ((name (closetok-name tok1))
+             (open-tags (cdr open-tags))
+             (list-nums (if (member-equal name '("ol" "ul"))
+                            (cdr list-nums)
+                          list-nums))
+             (acc (cond
+                   ((member-equal name '("h1" "h2" "h3" "h4" "h5" "p" "dl" "ul" "ol"
+                                         "short" "code" "parent" "index" "index_body"
+                                         "blockquote"))
+                    (auto-indent (maybe-doublespace acc) open-tags))
+                   ((member-equal name '("li" "dd" "dt" "index_head"))
+                    (auto-indent (maybe-newline acc) open-tags))
+                   (t
+                    acc))))
+          (tokens-to-terminal rest wrap-col open-tags list-nums acc)))
+
+       ;; Else, it should be a text token.
+       ;; We assume we are already indented to the right level.
+       ;; BOZO handle <code> correctly.
+       (text (texttok-text tok1))
+
+       (codep (has-tag-above "code" open-tags))
+       (level (get-indent-level open-tags))
+       (acc (if codep
+                (b* ((len (length text))
+                     (starts-with-newline-p (and (> len 0)
+                                                 (eql (char text 0) #\Newline)))
+                     (start-from (if starts-with-newline-p
+                                     1
+                                   0)))
+                  (prepend-each-line (make-list level :initial-element #\Space)
+                                     text start-from (length text) acc))
+              (let ((wrapped (word-wrap-paragraph text level wrap-col)))
+                (str::revappend-chars wrapped acc)))))
+    (tokens-to-terminal rest wrap-col open-tags list-nums acc)))
+
+
+
+(defun display-topic (x all-topics state)
+  (b* ((name (cdr (assoc :name x)))
+;       (- (cw "Preprocessing...~%"))
+       ;; Use NIL as the topics-fal as a simple way to suppress autolinks...
+       ((mv text state) (preprocess-topic x all-topics nil nil state))
+;       (- (cw "Text is ~x0.~%" text))
+;       (- (cw "Parsing xml...~%"))
+       ((mv err tokens) (parse-xml text))
+;       (- (cw "Checking result...~%"))
+       ((when err)
+        ;; Don't consult XDOC-VERBOSE-P here.  The user has explicitly asked to
+        ;; be shown this topic but we can't show it to them.  They need to be
+        ;; told why.
+        (cw "Error displaying xdoc topic:~%~%")
+        (b* ((state (princ$ err *standard-co* state))
+             (state (newline *standard-co* state))
+             (state (newline *standard-co* state)))
+          state))
+;       (- (cw "Tokens are ~x0.~%" tokens))
+;       (- (cw "Merging tokens...~%"))
+       (merged-tokens (reverse (merge-text tokens nil 0)))
+;       (- (cw "Merged tokens are ~x0.~%" merged-tokens))
+       (terminal (str::rchars-to-string
+                  (tokens-to-terminal merged-tokens 70 nil nil nil)))
+       (state (princ$ (symbol-package-name name) *standard-co* state))
+       (state (princ$ "::" *standard-co* state))
+       (state (princ$ (symbol-name name) *standard-co* state))
+       (state (newline *standard-co* state))
+       (state (princ$ terminal *standard-co* state))
+       (state (newline *standard-co* state)))
+    state))
+
+
+
+; We previously tried to see if there was an acl2 doc topic.  But now that we
+; have a fast importer from acl2 documentation, we just run (import-acl2doc)
+; before calling colon-xdoc-fn, so we should only need to look in the xdoc
+; database.
+
+; Until we hijacked the :doc command, I didn't feel so bad about XDOC not
+; trying very hard to tell you about related topics.  But now at least sort of
+; try to do something.  See spellcheck.lisp for the basic gist.  Eventually
+; we could extend this to include other search features.
+
+;; (defun skip-through-close-long (xml-tokens)
+;;   (cond ((atom xml-tokens)
+;;          nil)
+;;         ((equal (car xml-tokens) '(:CLOSE "long"))
+;;          (cdr xml-tokens))
+;;         (t
+;;          (skip-through-close-long (cdr xml-tokens)))))
+    
+;; (defun eliminate-long (xml-tokens)
+;;   (cond ((atom xml-tokens)
+;;          nil)
+;;         ((and (consp (car xml-tokens))
+;;               (eq (first (car xml-tokens)) :OPEN)
+;;               (equal (second (car xml-tokens)) "long"))
+;;          (skip-through-close-long xml-tokens))
+;;         (t
+;;          (cons (car xml-tokens)
+;;                (eliminate-long (cdr xml-tokens))))))
+
+(defun summarize-nearby-topic (x state)
+  (b* ((name     (cdr (assoc :name x)))
+       (base-pkg (cdr (assoc :base-pkg x)))
+       (short    (cdr (assoc :short x)))
+;       (- (cw "Preprocessing...~%"))
+       ;; Use NIL as the topics-fal as a simple way to suppress autolinks...
+       ((mv short-acc state) (preprocess-main short
+                                              nil ;; no directory is needed here
+                                              nil ;; no topics-fal, just keep it simple
+                                              base-pkg
+                                              state
+                                              nil ;; accumulator
+                                              ))
+       (short (str::rchars-to-string short-acc))
+;       (- (cw "Text is ~x0.~%" text))
+;       (- (cw "Parsing xml...~%"))
+       ((mv err tokens) (parse-xml short))
+
+;       (- (cw "Checking result...~%"))
+       ((when err)
+        (cw "Error summarizing xdoc topic:~%~%")
+        (b* ((state (princ$ err *standard-co* state))
+             (state (newline *standard-co* state))
+             (state (newline *standard-co* state)))
+          state))
+;       (- (cw "Tokens are ~x0.~%" tokens))
+;       (- (cw "Merging tokens...~%"))
+       (merged-tokens (reverse (merge-text tokens nil 0)))
+;       (- (cw "Merged tokens are ~x0.~%" merged-tokens))
+       (terminal (str::rchars-to-string (tokens-to-terminal merged-tokens 70 nil nil nil)))
+       (state (princ$ "    " *standard-co* state))
+       (state (princ$ (symbol-package-name name) *standard-co* state))
+       (state (princ$ "::" *standard-co* state))
+       (state (princ$ (symbol-name name) *standard-co* state))
+       (state (newline *standard-co* state))
+       (state (princ$ (str::prefix-lines terminal "      ") *standard-co* state))
+       (state (newline *standard-co* state)))
+    state))
+
+(defun summarize-nearby-topics (x state)
+  (if (atom x)
+      state
+    (pprogn (summarize-nearby-topic (car x) state)
+            (summarize-nearby-topics (cdr x) state))))
+
+(defun find-topics (names all-topics)
+  (if (atom names)
+      nil
+    (cons (find-topic (car names) all-topics)
+          (find-topics (cdr names) all-topics))))
+
+(defun all-topic-names (topics)
+  (if (atom topics)
+      nil
+    (cons (cdr (assoc :name (car topics)))
+          (all-topic-names (cdr topics)))))
+
+(defun suggest-alternatives (name all-topics state)
+  (declare (xargs :guard (symbolp name)))
+  (b* ((topic-names (all-topic-names all-topics))
+       (suggestions (xdoc-autocorrect name topic-names))
+       (- (cw "~%Argh!  No documentation for ~s0::~s1.~%" (symbol-package-name name)
+              (symbol-name name)))
+       ((unless suggestions)
+        state)
+       ;; Otherwise, suggestions is at most five other topics.
+       (- (if (eql (len suggestions) 1)
+              (cw "Hrmn, maybe you wanted this one:~%~%")
+            (cw "Hrmn, maybe you wanted one of these:~%~%")))
+       (suggested-topics (find-topics suggestions all-topics))
+       (state (summarize-nearby-topics suggested-topics state))
+       (state (newline *standard-co* state)))
+    state))
+      
+             
+(defun colon-xdoc-fn (name all-topics state)
+  (declare (xargs :guard (symbolp name)))
+  (b* ((xdoc-entry (find-topic name all-topics))
+
+       ((when (not xdoc-entry))
+        (let ((state (suggest-alternatives name all-topics state)))
+          (value :invisible)))
+       
+       (state (display-topic xdoc-entry all-topics state)))
+    (value :invisible)))
+
+#|
+(include-book
+ "centaur/vl/parsetree" :dir :system)
+
+(colon-xdoc-fn 'modulep (get-xdoc-table (w state)) state)
+(colon-xdoc-fn 'module->name (get-xdoc-table (w state)) state)
+(colon-xdoc-fn 'all-equal (get-xdoc-table (w state)) state)
+(colon-xdoc-fn 'cons (get-xdoc-table (w state)) state)
+
+|#
diff -Nru acl2-6.2/books/xdoc/emacsclient-wrapper.sh acl2-6.3/books/xdoc/emacsclient-wrapper.sh
--- acl2-6.2/books/xdoc/emacsclient-wrapper.sh	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/emacsclient-wrapper.sh	2013-09-30 17:52:15.000000000 +0000
@@ -4,4 +4,4 @@
 # additional options.  A script like this may be useful for connecting
 # your web browser to emacs for .xdoc-link files.
 
-emacsclient --no-wait $1
+emacsclient --no-wait "$1"
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/Icon_External_Link.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/Icon_External_Link.png differ
diff -Nru acl2-6.2/books/xdoc/fancy/LICENSE acl2-6.3/books/xdoc/fancy/LICENSE
--- acl2-6.2/books/xdoc/fancy/LICENSE	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/LICENSE	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,100 @@
+
+                         ACL2 XDOC FANCY VIEWER
+                           License Information
+
+Copyright for main source files:
+
+   XDOC Documentation System for ACL2
+   Copyright (C) 2009-2013 Centaur Technology
+
+   Contact:
+     Centaur Technology Formal Verification Group
+     7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+     http://www.centtech.com/
+
+   This program is free software; you can redistribute it and/or modify it
+   under the terms of the GNU General Public License as published by the Free
+   Software Foundation; either version 2 of the License, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful but WITHOUT
+   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+   more details.
+
+   You should have received a copy of the GNU General Public License along with
+   this program; if not, write to the Free Software Foundation, Inc., 51
+   Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+
+   Original author: Jared Davis <jared@centtech.com>
+
+
+Copyrights for Supporting Libraries: (within the "lib" directory)
+
+   Hogan:
+     Copyright 2011 Twitter, Inc.
+     Released under Apache License
+     http://twitter.github.io/hogan.js/
+
+   jQuery:
+     Copyright 2005, 2013 jQuery Foundation, Inc. and other contributors
+     Released under the MIT license.
+     http://jquery.com/
+
+   jquery.base64.js:
+     Copyright 2012 Yannick Albert
+     Released under MIT license.
+     https://github.com/yckart/jquery.base64.js
+
+   PowerTip:
+     Copyright 2013 Steven Benner
+     Released under MIT license.
+     http://stevenbenner.github.com/jquery-powertip/
+
+   LazyLoad:
+     Copyright 2011 Ryan Grove
+     Released under MIT license.
+     https://github.com/rgrove/lazyload
+
+   Typeahead:
+     Copyright 2013 Twitter, Inc. and other contributors
+     Released under MIT license.
+     https://github.com/twitter/typeahead
+
+
+Copyrights for other supporting files:
+
+   Original XDOC Images
+     Copyright 2009-2013 Centaur Technology
+     License: GNU General Public License
+
+     - leaf.png
+     - plus.png
+     - minus.png
+     - expand_subtopics.png
+     - collapse_subtopics.png
+     - favicon.png
+     - xdoc-home.png
+     - xdoc-logo.png
+
+   Oxygen Icon Set Images
+     http://www.oxygen-icons.org/
+     Released under GNU General Public License
+     Accessed 2012-08-13 from:
+       http://kde-look.org/content/show.php/Oxygen+Icons?content=74184
+
+     - view_flat.png   (adapted)
+     - view_tree.png   (adapted)
+
+   External Link Image:
+     Released under GNU General Public License
+     Accessed 2013-07-26 from
+       http://commons.wikimedia.org/wiki/File:Icon_External_Link.png
+
+     - Icon_External_Link.png
+
+
+   ACL2 Tour Images (.gif files within the images/ directory)
+     Copyright 2012 Regents of the University of Texas
+     Released under a BSD-style license (distributed with ACL2)
+
diff -Nru acl2-6.2/books/xdoc/fancy/Makefile acl2-6.3/books/xdoc/fancy/Makefile
--- acl2-6.2/books/xdoc/fancy/Makefile	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/Makefile	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,11 @@
+# This is an extremely stupid hack for converting render.xsl into a form that
+# can be easily loaded into JavaScript.  There's probably a much better way to
+# do this.
+
+render.js : render.xsl
+	echo "var xslt_base64 = \"" > render.tmp
+	base64 < render.xsl >> render.tmp
+	echo "\";" >> render.tmp
+	tr -d '\n' < render.tmp > render.js
+	rm render.tmp
+	ls -la render.js
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/collapse_subtopics.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/collapse_subtopics.png differ
diff -Nru acl2-6.2/books/xdoc/fancy/config.js acl2-6.3/books/xdoc/fancy/config.js
--- acl2-6.2/books/xdoc/fancy/config.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/config.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,38 @@
+/*
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+*/
+
+// XDOC Configuration
+//
+// Most users should not edit this file.
+//
+// You only need to change this if you are going to load your data on the fly
+// via ajax queries and xdataget.pl.  In this case, you need to:
+//
+//   (1) Build the sqlite database using xdata2sql.pl
+//   (2) Install xdata.db and xdataget.pl somewhere on your web server
+//   (3) Point this at your xdataget.pl script.
+//
+// Example Syntax:
+// var XDATAGET = "http://my-server/cgi-bin/my-manual/xdataget.pl";
+
+var XDATAGET = "";
+
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/expand_subtopics.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/expand_subtopics.png differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/favicon.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/favicon.png differ
diff -Nru acl2-6.2/books/xdoc/fancy/index.html acl2-6.3/books/xdoc/fancy/index.html
--- acl2-6.2/books/xdoc/fancy/index.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/index.html	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,131 @@
+<!DOCTYPE html>
+<html>
+<head id="#head">
+<meta charset="UTF-8">
+
+<!--
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+-->
+
+<title>XDOC (Loading)</title>
+<link rel="stylesheet" type="text/css" href="style.css"/>
+<link rel="shortcut icon" href="favicon.png"/>
+
+<!-- General Libraries -->
+<script src="lib/jquery-2.0.3.min.js"></script>
+<script src="lib/jquery.base64.js"></script>
+<script src="lib/jquery.powertip.min.js"></script>
+<link rel="stylesheet" type="text/css" href="lib/jquery.powertip.css"/>
+<script src="lib/typeahead.min.js"></script>
+<script src="lib/lazyload.js"></script>
+<script src="lib/hogan-2.0.0.js"></script>
+
+<!-- Actual XDOC stuff -->
+<script src="render.js"></script>
+<script src="config.js"></script>
+<script src="xdoc_index.js"></script>
+<script src="xdoc.js"></script>
+
+</head>
+<body>
+
+<div id="top">
+
+  <table border="0" id="toolbar">
+    <tr>
+      <th>
+	<a href="javascript:action_go_key('ACL2____TOP')">
+	  <img class="toolbutton" src="xdoc-home.png"
+	       data-powertip="<p>Go to the Top topic.</p>">
+	</a>
+        &#160; &#160;
+	<a href="javascript:nav_tree()">
+	  <img class="toolbutton" src="view_tree.png"
+	       data-powertip="<p>Use hierarchical navigation.</p>"/>
+	</a>
+	<a href="javascript:nav_flat()">
+	  <img class="toolbutton" src="view_flat.png"
+	       data-powertip="<p>Use flat navigation.</p>"/>
+	</a>
+      </th>
+      <th id="letters"></th>
+      <td>
+<!-- Come back to this after Typeahead 0.10.  There may be a way to get it to
+     autocomplete when the user hits enter, then. -->
+ 	<form> 
+	<label id="jumpmsg" data-powertip="<p>If you know what topic you want, you
+					  can type its symbol-name here (without
+                                          a package name), then choose the match
+                                          when it comes up.</p>
+
+					  <p>This is kind of buggy.  Start typing,
+					  then either click or use up/down to
+                                          choose what you want before hitting
+                                          Enter.</p>">
+	  Jump to </label>
+	<input id="jump" type="text" size="20" placeholder="loading..."
+	       disabled="disabled"/>
+	</form>
+      </td>
+      <td>
+	<form onsubmit="{search_submit(); return false;}">
+	<label id="searchmsg"/>
+  	  Search </label>
+        <input id="searchbox" type="text" size="30" placeholder="loading..."
+	       disabled="disabled"/>
+	<input type="submit" style="position: absolute; left: -9999px; width: 1px; height: 1px;"
+	       hidefocus="true" tabindex="-1"/>
+	</form>
+      </td>
+    </tr>
+  </table>
+
+</div>
+
+<div id="left">
+  <div id="nav">
+    <p>Loading...</p>
+  </div>
+
+  <div id="flat" style="display: none">
+    <p>Loading...</p>
+  </div>
+</div>
+
+<div id="right">
+  <div id="parents" style="display: none">
+  </div>
+  <div id="data">
+    <p>Loading...</p>
+  </div>
+</div>
+
+<div id="still_loading" style="display: none">
+</div>
+
+<!--
+<div id="bottom">
+Bottom
+</div>
+-->
+
+</body>
+</html>
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/leaf.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/leaf.png differ
diff -Nru acl2-6.2/books/xdoc/fancy/lib/hogan-2.0.0.js acl2-6.3/books/xdoc/fancy/lib/hogan-2.0.0.js
--- acl2-6.2/books/xdoc/fancy/lib/hogan-2.0.0.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/hogan-2.0.0.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,575 @@
+/*
+ *  Copyright 2011 Twitter, Inc.
+ *  Licensed under the Apache License, Version 2.0 (the "License");
+ *  you may not use this file except in compliance with the License.
+ *  You may obtain a copy of the License at
+ *
+ *  http://www.apache.org/licenses/LICENSE-2.0
+ *
+ *  Unless required by applicable law or agreed to in writing, software
+ *  distributed under the License is distributed on an "AS IS" BASIS,
+ *  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ *  See the License for the specific language governing permissions and
+ *  limitations under the License.
+ */
+
+
+
+var Hogan = {};
+
+(function (Hogan, useArrayBuffer) {
+  Hogan.Template = function (renderFunc, text, compiler, options) {
+    this.r = renderFunc || this.r;
+    this.c = compiler;
+    this.options = options;
+    this.text = text || '';
+    this.buf = (useArrayBuffer) ? [] : '';
+  }
+
+  Hogan.Template.prototype = {
+    // render: replaced by generated code.
+    r: function (context, partials, indent) { return ''; },
+
+    // variable escaping
+    v: hoganEscape,
+
+    // triple stache
+    t: coerceToString,
+
+    render: function render(context, partials, indent) {
+      return this.ri([context], partials || {}, indent);
+    },
+
+    // render internal -- a hook for overrides that catches partials too
+    ri: function (context, partials, indent) {
+      return this.r(context, partials, indent);
+    },
+
+    // tries to find a partial in the curent scope and render it
+    rp: function(name, context, partials, indent) {
+      var partial = partials[name];
+
+      if (!partial) {
+        return '';
+      }
+
+      if (this.c && typeof partial == 'string') {
+        partial = this.c.compile(partial, this.options);
+      }
+
+      return partial.ri(context, partials, indent);
+    },
+
+    // render a section
+    rs: function(context, partials, section) {
+      var tail = context[context.length - 1];
+
+      if (!isArray(tail)) {
+        section(context, partials, this);
+        return;
+      }
+
+      for (var i = 0; i < tail.length; i++) {
+        context.push(tail[i]);
+        section(context, partials, this);
+        context.pop();
+      }
+    },
+
+    // maybe start a section
+    s: function(val, ctx, partials, inverted, start, end, tags) {
+      var pass;
+
+      if (isArray(val) && val.length === 0) {
+        return false;
+      }
+
+      if (typeof val == 'function') {
+        val = this.ls(val, ctx, partials, inverted, start, end, tags);
+      }
+
+      pass = (val === '') || !!val;
+
+      if (!inverted && pass && ctx) {
+        ctx.push((typeof val == 'object') ? val : ctx[ctx.length - 1]);
+      }
+
+      return pass;
+    },
+
+    // find values with dotted names
+    d: function(key, ctx, partials, returnFound) {
+      var names = key.split('.'),
+          val = this.f(names[0], ctx, partials, returnFound),
+          cx = null;
+
+      if (key === '.' && isArray(ctx[ctx.length - 2])) {
+        return ctx[ctx.length - 1];
+      }
+
+      for (var i = 1; i < names.length; i++) {
+        if (val && typeof val == 'object' && names[i] in val) {
+          cx = val;
+          val = val[names[i]];
+        } else {
+          val = '';
+        }
+      }
+
+      if (returnFound && !val) {
+        return false;
+      }
+
+      if (!returnFound && typeof val == 'function') {
+        ctx.push(cx);
+        val = this.lv(val, ctx, partials);
+        ctx.pop();
+      }
+
+      return val;
+    },
+
+    // find values with normal names
+    f: function(key, ctx, partials, returnFound) {
+      var val = false,
+          v = null,
+          found = false;
+
+      for (var i = ctx.length - 1; i >= 0; i--) {
+        v = ctx[i];
+        if (v && typeof v == 'object' && key in v) {
+          val = v[key];
+          found = true;
+          break;
+        }
+      }
+
+      if (!found) {
+        return (returnFound) ? false : "";
+      }
+
+      if (!returnFound && typeof val == 'function') {
+        val = this.lv(val, ctx, partials);
+      }
+
+      return val;
+    },
+
+    // higher order templates
+    ho: function(val, cx, partials, text, tags) {
+      var compiler = this.c;
+      var options = this.options;
+      options.delimiters = tags;
+      var text = val.call(cx, text);
+      text = (text == null) ? String(text) : text.toString();
+      this.b(compiler.compile(text, options).render(cx, partials));
+      return false;
+    },
+
+    // template result buffering
+    b: (useArrayBuffer) ? function(s) { this.buf.push(s); } :
+                          function(s) { this.buf += s; },
+    fl: (useArrayBuffer) ? function() { var r = this.buf.join(''); this.buf = []; return r; } :
+                           function() { var r = this.buf; this.buf = ''; return r; },
+
+    // lambda replace section
+    ls: function(val, ctx, partials, inverted, start, end, tags) {
+      var cx = ctx[ctx.length - 1],
+          t = null;
+
+      if (!inverted && this.c && val.length > 0) {
+        return this.ho(val, cx, partials, this.text.substring(start, end), tags);
+      }
+
+      t = val.call(cx);
+
+      if (typeof t == 'function') {
+        if (inverted) {
+          return true;
+        } else if (this.c) {
+          return this.ho(t, cx, partials, this.text.substring(start, end), tags);
+        }
+      }
+
+      return t;
+    },
+
+    // lambda replace variable
+    lv: function(val, ctx, partials) {
+      var cx = ctx[ctx.length - 1];
+      var result = val.call(cx);
+
+      if (typeof result == 'function') {
+        result = coerceToString(result.call(cx));
+        if (this.c && ~result.indexOf("{\u007B")) {
+          return this.c.compile(result, this.options).render(cx, partials);
+        }
+      }
+
+      return coerceToString(result);
+    }
+
+  };
+
+  var rAmp = /&/g,
+      rLt = /</g,
+      rGt = />/g,
+      rApos =/\'/g,
+      rQuot = /\"/g,
+      hChars =/[&<>\"\']/;
+
+
+  function coerceToString(val) {
+    return String((val === null || val === undefined) ? '' : val);
+  }
+
+  function hoganEscape(str) {
+    str = coerceToString(str);
+    return hChars.test(str) ?
+      str
+        .replace(rAmp,'&amp;')
+        .replace(rLt,'&lt;')
+        .replace(rGt,'&gt;')
+        .replace(rApos,'&#39;')
+        .replace(rQuot, '&quot;') :
+      str;
+  }
+
+  var isArray = Array.isArray || function(a) {
+    return Object.prototype.toString.call(a) === '[object Array]';
+  };
+
+})(typeof exports !== 'undefined' ? exports : Hogan);
+
+
+
+
+(function (Hogan) {
+  // Setup regex  assignments
+  // remove whitespace according to Mustache spec
+  var rIsWhitespace = /\S/,
+      rQuot = /\"/g,
+      rNewline =  /\n/g,
+      rCr = /\r/g,
+      rSlash = /\\/g,
+      tagTypes = {
+        '#': 1, '^': 2, '/': 3,  '!': 4, '>': 5,
+        '<': 6, '=': 7, '_v': 8, '{': 9, '&': 10
+      };
+
+  Hogan.scan = function scan(text, delimiters) {
+    var len = text.length,
+        IN_TEXT = 0,
+        IN_TAG_TYPE = 1,
+        IN_TAG = 2,
+        state = IN_TEXT,
+        tagType = null,
+        tag = null,
+        buf = '',
+        tokens = [],
+        seenTag = false,
+        i = 0,
+        lineStart = 0,
+        otag = '{{',
+        ctag = '}}';
+
+    function addBuf() {
+      if (buf.length > 0) {
+        tokens.push(new String(buf));
+        buf = '';
+      }
+    }
+
+    function lineIsWhitespace() {
+      var isAllWhitespace = true;
+      for (var j = lineStart; j < tokens.length; j++) {
+        isAllWhitespace =
+          (tokens[j].tag && tagTypes[tokens[j].tag] < tagTypes['_v']) ||
+          (!tokens[j].tag && tokens[j].match(rIsWhitespace) === null);
+        if (!isAllWhitespace) {
+          return false;
+        }
+      }
+
+      return isAllWhitespace;
+    }
+
+    function filterLine(haveSeenTag, noNewLine) {
+      addBuf();
+
+      if (haveSeenTag && lineIsWhitespace()) {
+        for (var j = lineStart, next; j < tokens.length; j++) {
+          if (!tokens[j].tag) {
+            if ((next = tokens[j+1]) && next.tag == '>') {
+              // set indent to token value
+              next.indent = tokens[j].toString()
+            }
+            tokens.splice(j, 1);
+          }
+        }
+      } else if (!noNewLine) {
+        tokens.push({tag:'\n'});
+      }
+
+      seenTag = false;
+      lineStart = tokens.length;
+    }
+
+    function changeDelimiters(text, index) {
+      var close = '=' + ctag,
+          closeIndex = text.indexOf(close, index),
+          delimiters = trim(
+            text.substring(text.indexOf('=', index) + 1, closeIndex)
+          ).split(' ');
+
+      otag = delimiters[0];
+      ctag = delimiters[1];
+
+      return closeIndex + close.length - 1;
+    }
+
+    if (delimiters) {
+      delimiters = delimiters.split(' ');
+      otag = delimiters[0];
+      ctag = delimiters[1];
+    }
+
+    for (i = 0; i < len; i++) {
+      if (state == IN_TEXT) {
+        if (tagChange(otag, text, i)) {
+          --i;
+          addBuf();
+          state = IN_TAG_TYPE;
+        } else {
+          if (text.charAt(i) == '\n') {
+            filterLine(seenTag);
+          } else {
+            buf += text.charAt(i);
+          }
+        }
+      } else if (state == IN_TAG_TYPE) {
+        i += otag.length - 1;
+        tag = tagTypes[text.charAt(i + 1)];
+        tagType = tag ? text.charAt(i + 1) : '_v';
+        if (tagType == '=') {
+          i = changeDelimiters(text, i);
+          state = IN_TEXT;
+        } else {
+          if (tag) {
+            i++;
+          }
+          state = IN_TAG;
+        }
+        seenTag = i;
+      } else {
+        if (tagChange(ctag, text, i)) {
+          tokens.push({tag: tagType, n: trim(buf), otag: otag, ctag: ctag,
+                       i: (tagType == '/') ? seenTag - ctag.length : i + otag.length});
+          buf = '';
+          i += ctag.length - 1;
+          state = IN_TEXT;
+          if (tagType == '{') {
+            if (ctag == '}}') {
+              i++;
+            } else {
+              cleanTripleStache(tokens[tokens.length - 1]);
+            }
+          }
+        } else {
+          buf += text.charAt(i);
+        }
+      }
+    }
+
+    filterLine(seenTag, true);
+
+    return tokens;
+  }
+
+  function cleanTripleStache(token) {
+    if (token.n.substr(token.n.length - 1) === '}') {
+      token.n = token.n.substring(0, token.n.length - 1);
+    }
+  }
+
+  function trim(s) {
+    if (s.trim) {
+      return s.trim();
+    }
+
+    return s.replace(/^\s*|\s*$/g, '');
+  }
+
+  function tagChange(tag, text, index) {
+    if (text.charAt(index) != tag.charAt(0)) {
+      return false;
+    }
+
+    for (var i = 1, l = tag.length; i < l; i++) {
+      if (text.charAt(index + i) != tag.charAt(i)) {
+        return false;
+      }
+    }
+
+    return true;
+  }
+
+  function buildTree(tokens, kind, stack, customTags) {
+    var instructions = [],
+        opener = null,
+        token = null;
+
+    while (tokens.length > 0) {
+      token = tokens.shift();
+      if (token.tag == '#' || token.tag == '^' || isOpener(token, customTags)) {
+        stack.push(token);
+        token.nodes = buildTree(tokens, token.tag, stack, customTags);
+        instructions.push(token);
+      } else if (token.tag == '/') {
+        if (stack.length === 0) {
+          throw new Error('Closing tag without opener: /' + token.n);
+        }
+        opener = stack.pop();
+        if (token.n != opener.n && !isCloser(token.n, opener.n, customTags)) {
+          throw new Error('Nesting error: ' + opener.n + ' vs. ' + token.n);
+        }
+        opener.end = token.i;
+        return instructions;
+      } else {
+        instructions.push(token);
+      }
+    }
+
+    if (stack.length > 0) {
+      throw new Error('missing closing tag: ' + stack.pop().n);
+    }
+
+    return instructions;
+  }
+
+  function isOpener(token, tags) {
+    for (var i = 0, l = tags.length; i < l; i++) {
+      if (tags[i].o == token.n) {
+        token.tag = '#';
+        return true;
+      }
+    }
+  }
+
+  function isCloser(close, open, tags) {
+    for (var i = 0, l = tags.length; i < l; i++) {
+      if (tags[i].c == close && tags[i].o == open) {
+        return true;
+      }
+    }
+  }
+
+  Hogan.generate = function (tree, text, options) {
+    var code = 'var _=this;_.b(i=i||"");' + walk(tree) + 'return _.fl();';
+    if (options.asString) {
+      return 'function(c,p,i){' + code + ';}';
+    }
+
+    return new Hogan.Template(new Function('c', 'p', 'i', code), text, Hogan, options);
+  }
+
+  function esc(s) {
+    return s.replace(rSlash, '\\\\')
+            .replace(rQuot, '\\\"')
+            .replace(rNewline, '\\n')
+            .replace(rCr, '\\r');
+  }
+
+  function chooseMethod(s) {
+    return (~s.indexOf('.')) ? 'd' : 'f';
+  }
+
+  function walk(tree) {
+    var code = '';
+    for (var i = 0, l = tree.length; i < l; i++) {
+      var tag = tree[i].tag;
+      if (tag == '#') {
+        code += section(tree[i].nodes, tree[i].n, chooseMethod(tree[i].n),
+                        tree[i].i, tree[i].end, tree[i].otag + " " + tree[i].ctag);
+      } else if (tag == '^') {
+        code += invertedSection(tree[i].nodes, tree[i].n,
+                                chooseMethod(tree[i].n));
+      } else if (tag == '<' || tag == '>') {
+        code += partial(tree[i]);
+      } else if (tag == '{' || tag == '&') {
+        code += tripleStache(tree[i].n, chooseMethod(tree[i].n));
+      } else if (tag == '\n') {
+        code += text('"\\n"' + (tree.length-1 == i ? '' : ' + i'));
+      } else if (tag == '_v') {
+        code += variable(tree[i].n, chooseMethod(tree[i].n));
+      } else if (tag === undefined) {
+        code += text('"' + esc(tree[i]) + '"');
+      }
+    }
+    return code;
+  }
+
+  function section(nodes, id, method, start, end, tags) {
+    return 'if(_.s(_.' + method + '("' + esc(id) + '",c,p,1),' +
+           'c,p,0,' + start + ',' + end + ',"' + tags + '")){' +
+           '_.rs(c,p,' +
+           'function(c,p,_){' +
+           walk(nodes) +
+           '});c.pop();}';
+  }
+
+  function invertedSection(nodes, id, method) {
+    return 'if(!_.s(_.' + method + '("' + esc(id) + '",c,p,1),c,p,1,0,0,"")){' +
+           walk(nodes) +
+           '};';
+  }
+
+  function partial(tok) {
+    return '_.b(_.rp("' +  esc(tok.n) + '",c,p,"' + (tok.indent || '') + '"));';
+  }
+
+  function tripleStache(id, method) {
+    return '_.b(_.t(_.' + method + '("' + esc(id) + '",c,p,0)));';
+  }
+
+  function variable(id, method) {
+    return '_.b(_.v(_.' + method + '("' + esc(id) + '",c,p,0)));';
+  }
+
+  function text(id) {
+    return '_.b(' + id + ');';
+  }
+
+  Hogan.parse = function(tokens, text, options) {
+    options = options || {};
+    return buildTree(tokens, '', [], options.sectionTags || []);
+  },
+
+  Hogan.cache = {};
+
+  Hogan.compile = function(text, options) {
+    // options
+    //
+    // asString: false (default)
+    //
+    // sectionTags: [{o: '_foo', c: 'foo'}]
+    // An array of object with o and c fields that indicate names for custom
+    // section tags. The example above allows parsing of {{_foo}}{{/foo}}.
+    //
+    // delimiters: A string that overrides the default delimiters.
+    // Example: "<% %>"
+    //
+    options = options || {};
+
+    var key = text + '||' + !!options.asString;
+
+    var t = this.cache[key];
+
+    if (t) {
+      return t;
+    }
+
+    t = this.generate(this.parse(this.scan(text, options.delimiters), text, options), text, options);
+    return this.cache[key] = t;
+  };
+})(typeof exports !== 'undefined' ? exports : Hogan);
diff -Nru acl2-6.2/books/xdoc/fancy/lib/jquery-2.0.3.js acl2-6.3/books/xdoc/fancy/lib/jquery-2.0.3.js
--- acl2-6.2/books/xdoc/fancy/lib/jquery-2.0.3.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/jquery-2.0.3.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,8829 @@
+/*!
+ * jQuery JavaScript Library v2.0.3
+ * http://jquery.com/
+ *
+ * Includes Sizzle.js
+ * http://sizzlejs.com/
+ *
+ * Copyright 2005, 2013 jQuery Foundation, Inc. and other contributors
+ * Released under the MIT license
+ * http://jquery.org/license
+ *
+ * Date: 2013-07-03T13:30Z
+ */
+(function( window, undefined ) {
+
+// Can't do this because several apps including ASP.NET trace
+// the stack via arguments.caller.callee and Firefox dies if
+// you try to trace through "use strict" call chains. (#13335)
+// Support: Firefox 18+
+//"use strict";
+var
+	// A central reference to the root jQuery(document)
+	rootjQuery,
+
+	// The deferred used on DOM ready
+	readyList,
+
+	// Support: IE9
+	// For `typeof xmlNode.method` instead of `xmlNode.method !== undefined`
+	core_strundefined = typeof undefined,
+
+	// Use the correct document accordingly with window argument (sandbox)
+	location = window.location,
+	document = window.document,
+	docElem = document.documentElement,
+
+	// Map over jQuery in case of overwrite
+	_jQuery = window.jQuery,
+
+	// Map over the $ in case of overwrite
+	_$ = window.$,
+
+	// [[Class]] -> type pairs
+	class2type = {},
+
+	// List of deleted data cache ids, so we can reuse them
+	core_deletedIds = [],
+
+	core_version = "2.0.3",
+
+	// Save a reference to some core methods
+	core_concat = core_deletedIds.concat,
+	core_push = core_deletedIds.push,
+	core_slice = core_deletedIds.slice,
+	core_indexOf = core_deletedIds.indexOf,
+	core_toString = class2type.toString,
+	core_hasOwn = class2type.hasOwnProperty,
+	core_trim = core_version.trim,
+
+	// Define a local copy of jQuery
+	jQuery = function( selector, context ) {
+		// The jQuery object is actually just the init constructor 'enhanced'
+		return new jQuery.fn.init( selector, context, rootjQuery );
+	},
+
+	// Used for matching numbers
+	core_pnum = /[+-]?(?:\d*\.|)\d+(?:[eE][+-]?\d+|)/.source,
+
+	// Used for splitting on whitespace
+	core_rnotwhite = /\S+/g,
+
+	// A simple way to check for HTML strings
+	// Prioritize #id over <tag> to avoid XSS via location.hash (#9521)
+	// Strict HTML recognition (#11290: must start with <)
+	rquickExpr = /^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]*))$/,
+
+	// Match a standalone tag
+	rsingleTag = /^<(\w+)\s*\/?>(?:<\/\1>|)$/,
+
+	// Matches dashed string for camelizing
+	rmsPrefix = /^-ms-/,
+	rdashAlpha = /-([\da-z])/gi,
+
+	// Used by jQuery.camelCase as callback to replace()
+	fcamelCase = function( all, letter ) {
+		return letter.toUpperCase();
+	},
+
+	// The ready event handler and self cleanup method
+	completed = function() {
+		document.removeEventListener( "DOMContentLoaded", completed, false );
+		window.removeEventListener( "load", completed, false );
+		jQuery.ready();
+	};
+
+jQuery.fn = jQuery.prototype = {
+	// The current version of jQuery being used
+	jquery: core_version,
+
+	constructor: jQuery,
+	init: function( selector, context, rootjQuery ) {
+		var match, elem;
+
+		// HANDLE: $(""), $(null), $(undefined), $(false)
+		if ( !selector ) {
+			return this;
+		}
+
+		// Handle HTML strings
+		if ( typeof selector === "string" ) {
+			if ( selector.charAt(0) === "<" && selector.charAt( selector.length - 1 ) === ">" && selector.length >= 3 ) {
+				// Assume that strings that start and end with <> are HTML and skip the regex check
+				match = [ null, selector, null ];
+
+			} else {
+				match = rquickExpr.exec( selector );
+			}
+
+			// Match html or make sure no context is specified for #id
+			if ( match && (match[1] || !context) ) {
+
+				// HANDLE: $(html) -> $(array)
+				if ( match[1] ) {
+					context = context instanceof jQuery ? context[0] : context;
+
+					// scripts is true for back-compat
+					jQuery.merge( this, jQuery.parseHTML(
+						match[1],
+						context && context.nodeType ? context.ownerDocument || context : document,
+						true
+					) );
+
+					// HANDLE: $(html, props)
+					if ( rsingleTag.test( match[1] ) && jQuery.isPlainObject( context ) ) {
+						for ( match in context ) {
+							// Properties of context are called as methods if possible
+							if ( jQuery.isFunction( this[ match ] ) ) {
+								this[ match ]( context[ match ] );
+
+							// ...and otherwise set as attributes
+							} else {
+								this.attr( match, context[ match ] );
+							}
+						}
+					}
+
+					return this;
+
+				// HANDLE: $(#id)
+				} else {
+					elem = document.getElementById( match[2] );
+
+					// Check parentNode to catch when Blackberry 4.6 returns
+					// nodes that are no longer in the document #6963
+					if ( elem && elem.parentNode ) {
+						// Inject the element directly into the jQuery object
+						this.length = 1;
+						this[0] = elem;
+					}
+
+					this.context = document;
+					this.selector = selector;
+					return this;
+				}
+
+			// HANDLE: $(expr, $(...))
+			} else if ( !context || context.jquery ) {
+				return ( context || rootjQuery ).find( selector );
+
+			// HANDLE: $(expr, context)
+			// (which is just equivalent to: $(context).find(expr)
+			} else {
+				return this.constructor( context ).find( selector );
+			}
+
+		// HANDLE: $(DOMElement)
+		} else if ( selector.nodeType ) {
+			this.context = this[0] = selector;
+			this.length = 1;
+			return this;
+
+		// HANDLE: $(function)
+		// Shortcut for document ready
+		} else if ( jQuery.isFunction( selector ) ) {
+			return rootjQuery.ready( selector );
+		}
+
+		if ( selector.selector !== undefined ) {
+			this.selector = selector.selector;
+			this.context = selector.context;
+		}
+
+		return jQuery.makeArray( selector, this );
+	},
+
+	// Start with an empty selector
+	selector: "",
+
+	// The default length of a jQuery object is 0
+	length: 0,
+
+	toArray: function() {
+		return core_slice.call( this );
+	},
+
+	// Get the Nth element in the matched element set OR
+	// Get the whole matched element set as a clean array
+	get: function( num ) {
+		return num == null ?
+
+			// Return a 'clean' array
+			this.toArray() :
+
+			// Return just the object
+			( num < 0 ? this[ this.length + num ] : this[ num ] );
+	},
+
+	// Take an array of elements and push it onto the stack
+	// (returning the new matched element set)
+	pushStack: function( elems ) {
+
+		// Build a new jQuery matched element set
+		var ret = jQuery.merge( this.constructor(), elems );
+
+		// Add the old object onto the stack (as a reference)
+		ret.prevObject = this;
+		ret.context = this.context;
+
+		// Return the newly-formed element set
+		return ret;
+	},
+
+	// Execute a callback for every element in the matched set.
+	// (You can seed the arguments with an array of args, but this is
+	// only used internally.)
+	each: function( callback, args ) {
+		return jQuery.each( this, callback, args );
+	},
+
+	ready: function( fn ) {
+		// Add the callback
+		jQuery.ready.promise().done( fn );
+
+		return this;
+	},
+
+	slice: function() {
+		return this.pushStack( core_slice.apply( this, arguments ) );
+	},
+
+	first: function() {
+		return this.eq( 0 );
+	},
+
+	last: function() {
+		return this.eq( -1 );
+	},
+
+	eq: function( i ) {
+		var len = this.length,
+			j = +i + ( i < 0 ? len : 0 );
+		return this.pushStack( j >= 0 && j < len ? [ this[j] ] : [] );
+	},
+
+	map: function( callback ) {
+		return this.pushStack( jQuery.map(this, function( elem, i ) {
+			return callback.call( elem, i, elem );
+		}));
+	},
+
+	end: function() {
+		return this.prevObject || this.constructor(null);
+	},
+
+	// For internal use only.
+	// Behaves like an Array's method, not like a jQuery method.
+	push: core_push,
+	sort: [].sort,
+	splice: [].splice
+};
+
+// Give the init function the jQuery prototype for later instantiation
+jQuery.fn.init.prototype = jQuery.fn;
+
+jQuery.extend = jQuery.fn.extend = function() {
+	var options, name, src, copy, copyIsArray, clone,
+		target = arguments[0] || {},
+		i = 1,
+		length = arguments.length,
+		deep = false;
+
+	// Handle a deep copy situation
+	if ( typeof target === "boolean" ) {
+		deep = target;
+		target = arguments[1] || {};
+		// skip the boolean and the target
+		i = 2;
+	}
+
+	// Handle case when target is a string or something (possible in deep copy)
+	if ( typeof target !== "object" && !jQuery.isFunction(target) ) {
+		target = {};
+	}
+
+	// extend jQuery itself if only one argument is passed
+	if ( length === i ) {
+		target = this;
+		--i;
+	}
+
+	for ( ; i < length; i++ ) {
+		// Only deal with non-null/undefined values
+		if ( (options = arguments[ i ]) != null ) {
+			// Extend the base object
+			for ( name in options ) {
+				src = target[ name ];
+				copy = options[ name ];
+
+				// Prevent never-ending loop
+				if ( target === copy ) {
+					continue;
+				}
+
+				// Recurse if we're merging plain objects or arrays
+				if ( deep && copy && ( jQuery.isPlainObject(copy) || (copyIsArray = jQuery.isArray(copy)) ) ) {
+					if ( copyIsArray ) {
+						copyIsArray = false;
+						clone = src && jQuery.isArray(src) ? src : [];
+
+					} else {
+						clone = src && jQuery.isPlainObject(src) ? src : {};
+					}
+
+					// Never move original objects, clone them
+					target[ name ] = jQuery.extend( deep, clone, copy );
+
+				// Don't bring in undefined values
+				} else if ( copy !== undefined ) {
+					target[ name ] = copy;
+				}
+			}
+		}
+	}
+
+	// Return the modified object
+	return target;
+};
+
+jQuery.extend({
+	// Unique for each copy of jQuery on the page
+	expando: "jQuery" + ( core_version + Math.random() ).replace( /\D/g, "" ),
+
+	noConflict: function( deep ) {
+		if ( window.$ === jQuery ) {
+			window.$ = _$;
+		}
+
+		if ( deep && window.jQuery === jQuery ) {
+			window.jQuery = _jQuery;
+		}
+
+		return jQuery;
+	},
+
+	// Is the DOM ready to be used? Set to true once it occurs.
+	isReady: false,
+
+	// A counter to track how many items to wait for before
+	// the ready event fires. See #6781
+	readyWait: 1,
+
+	// Hold (or release) the ready event
+	holdReady: function( hold ) {
+		if ( hold ) {
+			jQuery.readyWait++;
+		} else {
+			jQuery.ready( true );
+		}
+	},
+
+	// Handle when the DOM is ready
+	ready: function( wait ) {
+
+		// Abort if there are pending holds or we're already ready
+		if ( wait === true ? --jQuery.readyWait : jQuery.isReady ) {
+			return;
+		}
+
+		// Remember that the DOM is ready
+		jQuery.isReady = true;
+
+		// If a normal DOM Ready event fired, decrement, and wait if need be
+		if ( wait !== true && --jQuery.readyWait > 0 ) {
+			return;
+		}
+
+		// If there are functions bound, to execute
+		readyList.resolveWith( document, [ jQuery ] );
+
+		// Trigger any bound ready events
+		if ( jQuery.fn.trigger ) {
+			jQuery( document ).trigger("ready").off("ready");
+		}
+	},
+
+	// See test/unit/core.js for details concerning isFunction.
+	// Since version 1.3, DOM methods and functions like alert
+	// aren't supported. They return false on IE (#2968).
+	isFunction: function( obj ) {
+		return jQuery.type(obj) === "function";
+	},
+
+	isArray: Array.isArray,
+
+	isWindow: function( obj ) {
+		return obj != null && obj === obj.window;
+	},
+
+	isNumeric: function( obj ) {
+		return !isNaN( parseFloat(obj) ) && isFinite( obj );
+	},
+
+	type: function( obj ) {
+		if ( obj == null ) {
+			return String( obj );
+		}
+		// Support: Safari <= 5.1 (functionish RegExp)
+		return typeof obj === "object" || typeof obj === "function" ?
+			class2type[ core_toString.call(obj) ] || "object" :
+			typeof obj;
+	},
+
+	isPlainObject: function( obj ) {
+		// Not plain objects:
+		// - Any object or value whose internal [[Class]] property is not "[object Object]"
+		// - DOM nodes
+		// - window
+		if ( jQuery.type( obj ) !== "object" || obj.nodeType || jQuery.isWindow( obj ) ) {
+			return false;
+		}
+
+		// Support: Firefox <20
+		// The try/catch suppresses exceptions thrown when attempting to access
+		// the "constructor" property of certain host objects, ie. |window.location|
+		// https://bugzilla.mozilla.org/show_bug.cgi?id=814622
+		try {
+			if ( obj.constructor &&
+					!core_hasOwn.call( obj.constructor.prototype, "isPrototypeOf" ) ) {
+				return false;
+			}
+		} catch ( e ) {
+			return false;
+		}
+
+		// If the function hasn't returned already, we're confident that
+		// |obj| is a plain object, created by {} or constructed with new Object
+		return true;
+	},
+
+	isEmptyObject: function( obj ) {
+		var name;
+		for ( name in obj ) {
+			return false;
+		}
+		return true;
+	},
+
+	error: function( msg ) {
+		throw new Error( msg );
+	},
+
+	// data: string of html
+	// context (optional): If specified, the fragment will be created in this context, defaults to document
+	// keepScripts (optional): If true, will include scripts passed in the html string
+	parseHTML: function( data, context, keepScripts ) {
+		if ( !data || typeof data !== "string" ) {
+			return null;
+		}
+		if ( typeof context === "boolean" ) {
+			keepScripts = context;
+			context = false;
+		}
+		context = context || document;
+
+		var parsed = rsingleTag.exec( data ),
+			scripts = !keepScripts && [];
+
+		// Single tag
+		if ( parsed ) {
+			return [ context.createElement( parsed[1] ) ];
+		}
+
+		parsed = jQuery.buildFragment( [ data ], context, scripts );
+
+		if ( scripts ) {
+			jQuery( scripts ).remove();
+		}
+
+		return jQuery.merge( [], parsed.childNodes );
+	},
+
+	parseJSON: JSON.parse,
+
+	// Cross-browser xml parsing
+	parseXML: function( data ) {
+		var xml, tmp;
+		if ( !data || typeof data !== "string" ) {
+			return null;
+		}
+
+		// Support: IE9
+		try {
+			tmp = new DOMParser();
+			xml = tmp.parseFromString( data , "text/xml" );
+		} catch ( e ) {
+			xml = undefined;
+		}
+
+		if ( !xml || xml.getElementsByTagName( "parsererror" ).length ) {
+			jQuery.error( "Invalid XML: " + data );
+		}
+		return xml;
+	},
+
+	noop: function() {},
+
+	// Evaluates a script in a global context
+	globalEval: function( code ) {
+		var script,
+				indirect = eval;
+
+		code = jQuery.trim( code );
+
+		if ( code ) {
+			// If the code includes a valid, prologue position
+			// strict mode pragma, execute code by injecting a
+			// script tag into the document.
+			if ( code.indexOf("use strict") === 1 ) {
+				script = document.createElement("script");
+				script.text = code;
+				document.head.appendChild( script ).parentNode.removeChild( script );
+			} else {
+			// Otherwise, avoid the DOM node creation, insertion
+			// and removal by using an indirect global eval
+				indirect( code );
+			}
+		}
+	},
+
+	// Convert dashed to camelCase; used by the css and data modules
+	// Microsoft forgot to hump their vendor prefix (#9572)
+	camelCase: function( string ) {
+		return string.replace( rmsPrefix, "ms-" ).replace( rdashAlpha, fcamelCase );
+	},
+
+	nodeName: function( elem, name ) {
+		return elem.nodeName && elem.nodeName.toLowerCase() === name.toLowerCase();
+	},
+
+	// args is for internal usage only
+	each: function( obj, callback, args ) {
+		var value,
+			i = 0,
+			length = obj.length,
+			isArray = isArraylike( obj );
+
+		if ( args ) {
+			if ( isArray ) {
+				for ( ; i < length; i++ ) {
+					value = callback.apply( obj[ i ], args );
+
+					if ( value === false ) {
+						break;
+					}
+				}
+			} else {
+				for ( i in obj ) {
+					value = callback.apply( obj[ i ], args );
+
+					if ( value === false ) {
+						break;
+					}
+				}
+			}
+
+		// A special, fast, case for the most common use of each
+		} else {
+			if ( isArray ) {
+				for ( ; i < length; i++ ) {
+					value = callback.call( obj[ i ], i, obj[ i ] );
+
+					if ( value === false ) {
+						break;
+					}
+				}
+			} else {
+				for ( i in obj ) {
+					value = callback.call( obj[ i ], i, obj[ i ] );
+
+					if ( value === false ) {
+						break;
+					}
+				}
+			}
+		}
+
+		return obj;
+	},
+
+	trim: function( text ) {
+		return text == null ? "" : core_trim.call( text );
+	},
+
+	// results is for internal usage only
+	makeArray: function( arr, results ) {
+		var ret = results || [];
+
+		if ( arr != null ) {
+			if ( isArraylike( Object(arr) ) ) {
+				jQuery.merge( ret,
+					typeof arr === "string" ?
+					[ arr ] : arr
+				);
+			} else {
+				core_push.call( ret, arr );
+			}
+		}
+
+		return ret;
+	},
+
+	inArray: function( elem, arr, i ) {
+		return arr == null ? -1 : core_indexOf.call( arr, elem, i );
+	},
+
+	merge: function( first, second ) {
+		var l = second.length,
+			i = first.length,
+			j = 0;
+
+		if ( typeof l === "number" ) {
+			for ( ; j < l; j++ ) {
+				first[ i++ ] = second[ j ];
+			}
+		} else {
+			while ( second[j] !== undefined ) {
+				first[ i++ ] = second[ j++ ];
+			}
+		}
+
+		first.length = i;
+
+		return first;
+	},
+
+	grep: function( elems, callback, inv ) {
+		var retVal,
+			ret = [],
+			i = 0,
+			length = elems.length;
+		inv = !!inv;
+
+		// Go through the array, only saving the items
+		// that pass the validator function
+		for ( ; i < length; i++ ) {
+			retVal = !!callback( elems[ i ], i );
+			if ( inv !== retVal ) {
+				ret.push( elems[ i ] );
+			}
+		}
+
+		return ret;
+	},
+
+	// arg is for internal usage only
+	map: function( elems, callback, arg ) {
+		var value,
+			i = 0,
+			length = elems.length,
+			isArray = isArraylike( elems ),
+			ret = [];
+
+		// Go through the array, translating each of the items to their
+		if ( isArray ) {
+			for ( ; i < length; i++ ) {
+				value = callback( elems[ i ], i, arg );
+
+				if ( value != null ) {
+					ret[ ret.length ] = value;
+				}
+			}
+
+		// Go through every key on the object,
+		} else {
+			for ( i in elems ) {
+				value = callback( elems[ i ], i, arg );
+
+				if ( value != null ) {
+					ret[ ret.length ] = value;
+				}
+			}
+		}
+
+		// Flatten any nested arrays
+		return core_concat.apply( [], ret );
+	},
+
+	// A global GUID counter for objects
+	guid: 1,
+
+	// Bind a function to a context, optionally partially applying any
+	// arguments.
+	proxy: function( fn, context ) {
+		var tmp, args, proxy;
+
+		if ( typeof context === "string" ) {
+			tmp = fn[ context ];
+			context = fn;
+			fn = tmp;
+		}
+
+		// Quick check to determine if target is callable, in the spec
+		// this throws a TypeError, but we will just return undefined.
+		if ( !jQuery.isFunction( fn ) ) {
+			return undefined;
+		}
+
+		// Simulated bind
+		args = core_slice.call( arguments, 2 );
+		proxy = function() {
+			return fn.apply( context || this, args.concat( core_slice.call( arguments ) ) );
+		};
+
+		// Set the guid of unique handler to the same of original handler, so it can be removed
+		proxy.guid = fn.guid = fn.guid || jQuery.guid++;
+
+		return proxy;
+	},
+
+	// Multifunctional method to get and set values of a collection
+	// The value/s can optionally be executed if it's a function
+	access: function( elems, fn, key, value, chainable, emptyGet, raw ) {
+		var i = 0,
+			length = elems.length,
+			bulk = key == null;
+
+		// Sets many values
+		if ( jQuery.type( key ) === "object" ) {
+			chainable = true;
+			for ( i in key ) {
+				jQuery.access( elems, fn, i, key[i], true, emptyGet, raw );
+			}
+
+		// Sets one value
+		} else if ( value !== undefined ) {
+			chainable = true;
+
+			if ( !jQuery.isFunction( value ) ) {
+				raw = true;
+			}
+
+			if ( bulk ) {
+				// Bulk operations run against the entire set
+				if ( raw ) {
+					fn.call( elems, value );
+					fn = null;
+
+				// ...except when executing function values
+				} else {
+					bulk = fn;
+					fn = function( elem, key, value ) {
+						return bulk.call( jQuery( elem ), value );
+					};
+				}
+			}
+
+			if ( fn ) {
+				for ( ; i < length; i++ ) {
+					fn( elems[i], key, raw ? value : value.call( elems[i], i, fn( elems[i], key ) ) );
+				}
+			}
+		}
+
+		return chainable ?
+			elems :
+
+			// Gets
+			bulk ?
+				fn.call( elems ) :
+				length ? fn( elems[0], key ) : emptyGet;
+	},
+
+	now: Date.now,
+
+	// A method for quickly swapping in/out CSS properties to get correct calculations.
+	// Note: this method belongs to the css module but it's needed here for the support module.
+	// If support gets modularized, this method should be moved back to the css module.
+	swap: function( elem, options, callback, args ) {
+		var ret, name,
+			old = {};
+
+		// Remember the old values, and insert the new ones
+		for ( name in options ) {
+			old[ name ] = elem.style[ name ];
+			elem.style[ name ] = options[ name ];
+		}
+
+		ret = callback.apply( elem, args || [] );
+
+		// Revert the old values
+		for ( name in options ) {
+			elem.style[ name ] = old[ name ];
+		}
+
+		return ret;
+	}
+});
+
+jQuery.ready.promise = function( obj ) {
+	if ( !readyList ) {
+
+		readyList = jQuery.Deferred();
+
+		// Catch cases where $(document).ready() is called after the browser event has already occurred.
+		// we once tried to use readyState "interactive" here, but it caused issues like the one
+		// discovered by ChrisS here: http://bugs.jquery.com/ticket/12282#comment:15
+		if ( document.readyState === "complete" ) {
+			// Handle it asynchronously to allow scripts the opportunity to delay ready
+			setTimeout( jQuery.ready );
+
+		} else {
+
+			// Use the handy event callback
+			document.addEventListener( "DOMContentLoaded", completed, false );
+
+			// A fallback to window.onload, that will always work
+			window.addEventListener( "load", completed, false );
+		}
+	}
+	return readyList.promise( obj );
+};
+
+// Populate the class2type map
+jQuery.each("Boolean Number String Function Array Date RegExp Object Error".split(" "), function(i, name) {
+	class2type[ "[object " + name + "]" ] = name.toLowerCase();
+});
+
+function isArraylike( obj ) {
+	var length = obj.length,
+		type = jQuery.type( obj );
+
+	if ( jQuery.isWindow( obj ) ) {
+		return false;
+	}
+
+	if ( obj.nodeType === 1 && length ) {
+		return true;
+	}
+
+	return type === "array" || type !== "function" &&
+		( length === 0 ||
+		typeof length === "number" && length > 0 && ( length - 1 ) in obj );
+}
+
+// All jQuery objects should point back to these
+rootjQuery = jQuery(document);
+/*!
+ * Sizzle CSS Selector Engine v1.9.4-pre
+ * http://sizzlejs.com/
+ *
+ * Copyright 2013 jQuery Foundation, Inc. and other contributors
+ * Released under the MIT license
+ * http://jquery.org/license
+ *
+ * Date: 2013-06-03
+ */
+(function( window, undefined ) {
+
+var i,
+	support,
+	cachedruns,
+	Expr,
+	getText,
+	isXML,
+	compile,
+	outermostContext,
+	sortInput,
+
+	// Local document vars
+	setDocument,
+	document,
+	docElem,
+	documentIsHTML,
+	rbuggyQSA,
+	rbuggyMatches,
+	matches,
+	contains,
+
+	// Instance-specific data
+	expando = "sizzle" + -(new Date()),
+	preferredDoc = window.document,
+	dirruns = 0,
+	done = 0,
+	classCache = createCache(),
+	tokenCache = createCache(),
+	compilerCache = createCache(),
+	hasDuplicate = false,
+	sortOrder = function( a, b ) {
+		if ( a === b ) {
+			hasDuplicate = true;
+			return 0;
+		}
+		return 0;
+	},
+
+	// General-purpose constants
+	strundefined = typeof undefined,
+	MAX_NEGATIVE = 1 << 31,
+
+	// Instance methods
+	hasOwn = ({}).hasOwnProperty,
+	arr = [],
+	pop = arr.pop,
+	push_native = arr.push,
+	push = arr.push,
+	slice = arr.slice,
+	// Use a stripped-down indexOf if we can't use a native one
+	indexOf = arr.indexOf || function( elem ) {
+		var i = 0,
+			len = this.length;
+		for ( ; i < len; i++ ) {
+			if ( this[i] === elem ) {
+				return i;
+			}
+		}
+		return -1;
+	},
+
+	booleans = "checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped",
+
+	// Regular expressions
+
+	// Whitespace characters http://www.w3.org/TR/css3-selectors/#whitespace
+	whitespace = "[\\x20\\t\\r\\n\\f]",
+	// http://www.w3.org/TR/css3-syntax/#characters
+	characterEncoding = "(?:\\\\.|[\\w-]|[^\\x00-\\xa0])+",
+
+	// Loosely modeled on CSS identifier characters
+	// An unquoted value should be a CSS identifier http://www.w3.org/TR/css3-selectors/#attribute-selectors
+	// Proper syntax: http://www.w3.org/TR/CSS21/syndata.html#value-def-identifier
+	identifier = characterEncoding.replace( "w", "w#" ),
+
+	// Acceptable operators http://www.w3.org/TR/selectors/#attribute-selectors
+	attributes = "\\[" + whitespace + "*(" + characterEncoding + ")" + whitespace +
+		"*(?:([*^$|!~]?=)" + whitespace + "*(?:(['\"])((?:\\\\.|[^\\\\])*?)\\3|(" + identifier + ")|)|)" + whitespace + "*\\]",
+
+	// Prefer arguments quoted,
+	//   then not containing pseudos/brackets,
+	//   then attribute selectors/non-parenthetical expressions,
+	//   then anything else
+	// These preferences are here to reduce the number of selectors
+	//   needing tokenize in the PSEUDO preFilter
+	pseudos = ":(" + characterEncoding + ")(?:\\(((['\"])((?:\\\\.|[^\\\\])*?)\\3|((?:\\\\.|[^\\\\()[\\]]|" + attributes.replace( 3, 8 ) + ")*)|.*)\\)|)",
+
+	// Leading and non-escaped trailing whitespace, capturing some non-whitespace characters preceding the latter
+	rtrim = new RegExp( "^" + whitespace + "+|((?:^|[^\\\\])(?:\\\\.)*)" + whitespace + "+$", "g" ),
+
+	rcomma = new RegExp( "^" + whitespace + "*," + whitespace + "*" ),
+	rcombinators = new RegExp( "^" + whitespace + "*([>+~]|" + whitespace + ")" + whitespace + "*" ),
+
+	rsibling = new RegExp( whitespace + "*[+~]" ),
+	rattributeQuotes = new RegExp( "=" + whitespace + "*([^\\]'\"]*)" + whitespace + "*\\]", "g" ),
+
+	rpseudo = new RegExp( pseudos ),
+	ridentifier = new RegExp( "^" + identifier + "$" ),
+
+	matchExpr = {
+		"ID": new RegExp( "^#(" + characterEncoding + ")" ),
+		"CLASS": new RegExp( "^\\.(" + characterEncoding + ")" ),
+		"TAG": new RegExp( "^(" + characterEncoding.replace( "w", "w*" ) + ")" ),
+		"ATTR": new RegExp( "^" + attributes ),
+		"PSEUDO": new RegExp( "^" + pseudos ),
+		"CHILD": new RegExp( "^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\(" + whitespace +
+			"*(even|odd|(([+-]|)(\\d*)n|)" + whitespace + "*(?:([+-]|)" + whitespace +
+			"*(\\d+)|))" + whitespace + "*\\)|)", "i" ),
+		"bool": new RegExp( "^(?:" + booleans + ")$", "i" ),
+		// For use in libraries implementing .is()
+		// We use this for POS matching in `select`
+		"needsContext": new RegExp( "^" + whitespace + "*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\(" +
+			whitespace + "*((?:-\\d)?\\d*)" + whitespace + "*\\)|)(?=[^-]|$)", "i" )
+	},
+
+	rnative = /^[^{]+\{\s*\[native \w/,
+
+	// Easily-parseable/retrievable ID or TAG or CLASS selectors
+	rquickExpr = /^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,
+
+	rinputs = /^(?:input|select|textarea|button)$/i,
+	rheader = /^h\d$/i,
+
+	rescape = /'|\\/g,
+
+	// CSS escapes http://www.w3.org/TR/CSS21/syndata.html#escaped-characters
+	runescape = new RegExp( "\\\\([\\da-f]{1,6}" + whitespace + "?|(" + whitespace + ")|.)", "ig" ),
+	funescape = function( _, escaped, escapedWhitespace ) {
+		var high = "0x" + escaped - 0x10000;
+		// NaN means non-codepoint
+		// Support: Firefox
+		// Workaround erroneous numeric interpretation of +"0x"
+		return high !== high || escapedWhitespace ?
+			escaped :
+			// BMP codepoint
+			high < 0 ?
+				String.fromCharCode( high + 0x10000 ) :
+				// Supplemental Plane codepoint (surrogate pair)
+				String.fromCharCode( high >> 10 | 0xD800, high & 0x3FF | 0xDC00 );
+	};
+
+// Optimize for push.apply( _, NodeList )
+try {
+	push.apply(
+		(arr = slice.call( preferredDoc.childNodes )),
+		preferredDoc.childNodes
+	);
+	// Support: Android<4.0
+	// Detect silently failing push.apply
+	arr[ preferredDoc.childNodes.length ].nodeType;
+} catch ( e ) {
+	push = { apply: arr.length ?
+
+		// Leverage slice if possible
+		function( target, els ) {
+			push_native.apply( target, slice.call(els) );
+		} :
+
+		// Support: IE<9
+		// Otherwise append directly
+		function( target, els ) {
+			var j = target.length,
+				i = 0;
+			// Can't trust NodeList.length
+			while ( (target[j++] = els[i++]) ) {}
+			target.length = j - 1;
+		}
+	};
+}
+
+function Sizzle( selector, context, results, seed ) {
+	var match, elem, m, nodeType,
+		// QSA vars
+		i, groups, old, nid, newContext, newSelector;
+
+	if ( ( context ? context.ownerDocument || context : preferredDoc ) !== document ) {
+		setDocument( context );
+	}
+
+	context = context || document;
+	results = results || [];
+
+	if ( !selector || typeof selector !== "string" ) {
+		return results;
+	}
+
+	if ( (nodeType = context.nodeType) !== 1 && nodeType !== 9 ) {
+		return [];
+	}
+
+	if ( documentIsHTML && !seed ) {
+
+		// Shortcuts
+		if ( (match = rquickExpr.exec( selector )) ) {
+			// Speed-up: Sizzle("#ID")
+			if ( (m = match[1]) ) {
+				if ( nodeType === 9 ) {
+					elem = context.getElementById( m );
+					// Check parentNode to catch when Blackberry 4.6 returns
+					// nodes that are no longer in the document #6963
+					if ( elem && elem.parentNode ) {
+						// Handle the case where IE, Opera, and Webkit return items
+						// by name instead of ID
+						if ( elem.id === m ) {
+							results.push( elem );
+							return results;
+						}
+					} else {
+						return results;
+					}
+				} else {
+					// Context is not a document
+					if ( context.ownerDocument && (elem = context.ownerDocument.getElementById( m )) &&
+						contains( context, elem ) && elem.id === m ) {
+						results.push( elem );
+						return results;
+					}
+				}
+
+			// Speed-up: Sizzle("TAG")
+			} else if ( match[2] ) {
+				push.apply( results, context.getElementsByTagName( selector ) );
+				return results;
+
+			// Speed-up: Sizzle(".CLASS")
+			} else if ( (m = match[3]) && support.getElementsByClassName && context.getElementsByClassName ) {
+				push.apply( results, context.getElementsByClassName( m ) );
+				return results;
+			}
+		}
+
+		// QSA path
+		if ( support.qsa && (!rbuggyQSA || !rbuggyQSA.test( selector )) ) {
+			nid = old = expando;
+			newContext = context;
+			newSelector = nodeType === 9 && selector;
+
+			// qSA works strangely on Element-rooted queries
+			// We can work around this by specifying an extra ID on the root
+			// and working up from there (Thanks to Andrew Dupont for the technique)
+			// IE 8 doesn't work on object elements
+			if ( nodeType === 1 && context.nodeName.toLowerCase() !== "object" ) {
+				groups = tokenize( selector );
+
+				if ( (old = context.getAttribute("id")) ) {
+					nid = old.replace( rescape, "\\$&" );
+				} else {
+					context.setAttribute( "id", nid );
+				}
+				nid = "[id='" + nid + "'] ";
+
+				i = groups.length;
+				while ( i-- ) {
+					groups[i] = nid + toSelector( groups[i] );
+				}
+				newContext = rsibling.test( selector ) && context.parentNode || context;
+				newSelector = groups.join(",");
+			}
+
+			if ( newSelector ) {
+				try {
+					push.apply( results,
+						newContext.querySelectorAll( newSelector )
+					);
+					return results;
+				} catch(qsaError) {
+				} finally {
+					if ( !old ) {
+						context.removeAttribute("id");
+					}
+				}
+			}
+		}
+	}
+
+	// All others
+	return select( selector.replace( rtrim, "$1" ), context, results, seed );
+}
+
+/**
+ * Create key-value caches of limited size
+ * @returns {Function(string, Object)} Returns the Object data after storing it on itself with
+ *	property name the (space-suffixed) string and (if the cache is larger than Expr.cacheLength)
+ *	deleting the oldest entry
+ */
+function createCache() {
+	var keys = [];
+
+	function cache( key, value ) {
+		// Use (key + " ") to avoid collision with native prototype properties (see Issue #157)
+		if ( keys.push( key += " " ) > Expr.cacheLength ) {
+			// Only keep the most recent entries
+			delete cache[ keys.shift() ];
+		}
+		return (cache[ key ] = value);
+	}
+	return cache;
+}
+
+/**
+ * Mark a function for special use by Sizzle
+ * @param {Function} fn The function to mark
+ */
+function markFunction( fn ) {
+	fn[ expando ] = true;
+	return fn;
+}
+
+/**
+ * Support testing using an element
+ * @param {Function} fn Passed the created div and expects a boolean result
+ */
+function assert( fn ) {
+	var div = document.createElement("div");
+
+	try {
+		return !!fn( div );
+	} catch (e) {
+		return false;
+	} finally {
+		// Remove from its parent by default
+		if ( div.parentNode ) {
+			div.parentNode.removeChild( div );
+		}
+		// release memory in IE
+		div = null;
+	}
+}
+
+/**
+ * Adds the same handler for all of the specified attrs
+ * @param {String} attrs Pipe-separated list of attributes
+ * @param {Function} handler The method that will be applied
+ */
+function addHandle( attrs, handler ) {
+	var arr = attrs.split("|"),
+		i = attrs.length;
+
+	while ( i-- ) {
+		Expr.attrHandle[ arr[i] ] = handler;
+	}
+}
+
+/**
+ * Checks document order of two siblings
+ * @param {Element} a
+ * @param {Element} b
+ * @returns {Number} Returns less than 0 if a precedes b, greater than 0 if a follows b
+ */
+function siblingCheck( a, b ) {
+	var cur = b && a,
+		diff = cur && a.nodeType === 1 && b.nodeType === 1 &&
+			( ~b.sourceIndex || MAX_NEGATIVE ) -
+			( ~a.sourceIndex || MAX_NEGATIVE );
+
+	// Use IE sourceIndex if available on both nodes
+	if ( diff ) {
+		return diff;
+	}
+
+	// Check if b follows a
+	if ( cur ) {
+		while ( (cur = cur.nextSibling) ) {
+			if ( cur === b ) {
+				return -1;
+			}
+		}
+	}
+
+	return a ? 1 : -1;
+}
+
+/**
+ * Returns a function to use in pseudos for input types
+ * @param {String} type
+ */
+function createInputPseudo( type ) {
+	return function( elem ) {
+		var name = elem.nodeName.toLowerCase();
+		return name === "input" && elem.type === type;
+	};
+}
+
+/**
+ * Returns a function to use in pseudos for buttons
+ * @param {String} type
+ */
+function createButtonPseudo( type ) {
+	return function( elem ) {
+		var name = elem.nodeName.toLowerCase();
+		return (name === "input" || name === "button") && elem.type === type;
+	};
+}
+
+/**
+ * Returns a function to use in pseudos for positionals
+ * @param {Function} fn
+ */
+function createPositionalPseudo( fn ) {
+	return markFunction(function( argument ) {
+		argument = +argument;
+		return markFunction(function( seed, matches ) {
+			var j,
+				matchIndexes = fn( [], seed.length, argument ),
+				i = matchIndexes.length;
+
+			// Match elements found at the specified indexes
+			while ( i-- ) {
+				if ( seed[ (j = matchIndexes[i]) ] ) {
+					seed[j] = !(matches[j] = seed[j]);
+				}
+			}
+		});
+	});
+}
+
+/**
+ * Detect xml
+ * @param {Element|Object} elem An element or a document
+ */
+isXML = Sizzle.isXML = function( elem ) {
+	// documentElement is verified for cases where it doesn't yet exist
+	// (such as loading iframes in IE - #4833)
+	var documentElement = elem && (elem.ownerDocument || elem).documentElement;
+	return documentElement ? documentElement.nodeName !== "HTML" : false;
+};
+
+// Expose support vars for convenience
+support = Sizzle.support = {};
+
+/**
+ * Sets document-related variables once based on the current document
+ * @param {Element|Object} [doc] An element or document object to use to set the document
+ * @returns {Object} Returns the current document
+ */
+setDocument = Sizzle.setDocument = function( node ) {
+	var doc = node ? node.ownerDocument || node : preferredDoc,
+		parent = doc.defaultView;
+
+	// If no document and documentElement is available, return
+	if ( doc === document || doc.nodeType !== 9 || !doc.documentElement ) {
+		return document;
+	}
+
+	// Set our document
+	document = doc;
+	docElem = doc.documentElement;
+
+	// Support tests
+	documentIsHTML = !isXML( doc );
+
+	// Support: IE>8
+	// If iframe document is assigned to "document" variable and if iframe has been reloaded,
+	// IE will throw "permission denied" error when accessing "document" variable, see jQuery #13936
+	// IE6-8 do not support the defaultView property so parent will be undefined
+	if ( parent && parent.attachEvent && parent !== parent.top ) {
+		parent.attachEvent( "onbeforeunload", function() {
+			setDocument();
+		});
+	}
+
+	/* Attributes
+	---------------------------------------------------------------------- */
+
+	// Support: IE<8
+	// Verify that getAttribute really returns attributes and not properties (excepting IE8 booleans)
+	support.attributes = assert(function( div ) {
+		div.className = "i";
+		return !div.getAttribute("className");
+	});
+
+	/* getElement(s)By*
+	---------------------------------------------------------------------- */
+
+	// Check if getElementsByTagName("*") returns only elements
+	support.getElementsByTagName = assert(function( div ) {
+		div.appendChild( doc.createComment("") );
+		return !div.getElementsByTagName("*").length;
+	});
+
+	// Check if getElementsByClassName can be trusted
+	support.getElementsByClassName = assert(function( div ) {
+		div.innerHTML = "<div class='a'></div><div class='a i'></div>";
+
+		// Support: Safari<4
+		// Catch class over-caching
+		div.firstChild.className = "i";
+		// Support: Opera<10
+		// Catch gEBCN failure to find non-leading classes
+		return div.getElementsByClassName("i").length === 2;
+	});
+
+	// Support: IE<10
+	// Check if getElementById returns elements by name
+	// The broken getElementById methods don't pick up programatically-set names,
+	// so use a roundabout getElementsByName test
+	support.getById = assert(function( div ) {
+		docElem.appendChild( div ).id = expando;
+		return !doc.getElementsByName || !doc.getElementsByName( expando ).length;
+	});
+
+	// ID find and filter
+	if ( support.getById ) {
+		Expr.find["ID"] = function( id, context ) {
+			if ( typeof context.getElementById !== strundefined && documentIsHTML ) {
+				var m = context.getElementById( id );
+				// Check parentNode to catch when Blackberry 4.6 returns
+				// nodes that are no longer in the document #6963
+				return m && m.parentNode ? [m] : [];
+			}
+		};
+		Expr.filter["ID"] = function( id ) {
+			var attrId = id.replace( runescape, funescape );
+			return function( elem ) {
+				return elem.getAttribute("id") === attrId;
+			};
+		};
+	} else {
+		// Support: IE6/7
+		// getElementById is not reliable as a find shortcut
+		delete Expr.find["ID"];
+
+		Expr.filter["ID"] =  function( id ) {
+			var attrId = id.replace( runescape, funescape );
+			return function( elem ) {
+				var node = typeof elem.getAttributeNode !== strundefined && elem.getAttributeNode("id");
+				return node && node.value === attrId;
+			};
+		};
+	}
+
+	// Tag
+	Expr.find["TAG"] = support.getElementsByTagName ?
+		function( tag, context ) {
+			if ( typeof context.getElementsByTagName !== strundefined ) {
+				return context.getElementsByTagName( tag );
+			}
+		} :
+		function( tag, context ) {
+			var elem,
+				tmp = [],
+				i = 0,
+				results = context.getElementsByTagName( tag );
+
+			// Filter out possible comments
+			if ( tag === "*" ) {
+				while ( (elem = results[i++]) ) {
+					if ( elem.nodeType === 1 ) {
+						tmp.push( elem );
+					}
+				}
+
+				return tmp;
+			}
+			return results;
+		};
+
+	// Class
+	Expr.find["CLASS"] = support.getElementsByClassName && function( className, context ) {
+		if ( typeof context.getElementsByClassName !== strundefined && documentIsHTML ) {
+			return context.getElementsByClassName( className );
+		}
+	};
+
+	/* QSA/matchesSelector
+	---------------------------------------------------------------------- */
+
+	// QSA and matchesSelector support
+
+	// matchesSelector(:active) reports false when true (IE9/Opera 11.5)
+	rbuggyMatches = [];
+
+	// qSa(:focus) reports false when true (Chrome 21)
+	// We allow this because of a bug in IE8/9 that throws an error
+	// whenever `document.activeElement` is accessed on an iframe
+	// So, we allow :focus to pass through QSA all the time to avoid the IE error
+	// See http://bugs.jquery.com/ticket/13378
+	rbuggyQSA = [];
+
+	if ( (support.qsa = rnative.test( doc.querySelectorAll )) ) {
+		// Build QSA regex
+		// Regex strategy adopted from Diego Perini
+		assert(function( div ) {
+			// Select is set to empty string on purpose
+			// This is to test IE's treatment of not explicitly
+			// setting a boolean content attribute,
+			// since its presence should be enough
+			// http://bugs.jquery.com/ticket/12359
+			div.innerHTML = "<select><option selected=''></option></select>";
+
+			// Support: IE8
+			// Boolean attributes and "value" are not treated correctly
+			if ( !div.querySelectorAll("[selected]").length ) {
+				rbuggyQSA.push( "\\[" + whitespace + "*(?:value|" + booleans + ")" );
+			}
+
+			// Webkit/Opera - :checked should return selected option elements
+			// http://www.w3.org/TR/2011/REC-css3-selectors-20110929/#checked
+			// IE8 throws error here and will not see later tests
+			if ( !div.querySelectorAll(":checked").length ) {
+				rbuggyQSA.push(":checked");
+			}
+		});
+
+		assert(function( div ) {
+
+			// Support: Opera 10-12/IE8
+			// ^= $= *= and empty values
+			// Should not select anything
+			// Support: Windows 8 Native Apps
+			// The type attribute is restricted during .innerHTML assignment
+			var input = doc.createElement("input");
+			input.setAttribute( "type", "hidden" );
+			div.appendChild( input ).setAttribute( "t", "" );
+
+			if ( div.querySelectorAll("[t^='']").length ) {
+				rbuggyQSA.push( "[*^$]=" + whitespace + "*(?:''|\"\")" );
+			}
+
+			// FF 3.5 - :enabled/:disabled and hidden elements (hidden elements are still enabled)
+			// IE8 throws error here and will not see later tests
+			if ( !div.querySelectorAll(":enabled").length ) {
+				rbuggyQSA.push( ":enabled", ":disabled" );
+			}
+
+			// Opera 10-11 does not throw on post-comma invalid pseudos
+			div.querySelectorAll("*,:x");
+			rbuggyQSA.push(",.*:");
+		});
+	}
+
+	if ( (support.matchesSelector = rnative.test( (matches = docElem.webkitMatchesSelector ||
+		docElem.mozMatchesSelector ||
+		docElem.oMatchesSelector ||
+		docElem.msMatchesSelector) )) ) {
+
+		assert(function( div ) {
+			// Check to see if it's possible to do matchesSelector
+			// on a disconnected node (IE 9)
+			support.disconnectedMatch = matches.call( div, "div" );
+
+			// This should fail with an exception
+			// Gecko does not error, returns false instead
+			matches.call( div, "[s!='']:x" );
+			rbuggyMatches.push( "!=", pseudos );
+		});
+	}
+
+	rbuggyQSA = rbuggyQSA.length && new RegExp( rbuggyQSA.join("|") );
+	rbuggyMatches = rbuggyMatches.length && new RegExp( rbuggyMatches.join("|") );
+
+	/* Contains
+	---------------------------------------------------------------------- */
+
+	// Element contains another
+	// Purposefully does not implement inclusive descendent
+	// As in, an element does not contain itself
+	contains = rnative.test( docElem.contains ) || docElem.compareDocumentPosition ?
+		function( a, b ) {
+			var adown = a.nodeType === 9 ? a.documentElement : a,
+				bup = b && b.parentNode;
+			return a === bup || !!( bup && bup.nodeType === 1 && (
+				adown.contains ?
+					adown.contains( bup ) :
+					a.compareDocumentPosition && a.compareDocumentPosition( bup ) & 16
+			));
+		} :
+		function( a, b ) {
+			if ( b ) {
+				while ( (b = b.parentNode) ) {
+					if ( b === a ) {
+						return true;
+					}
+				}
+			}
+			return false;
+		};
+
+	/* Sorting
+	---------------------------------------------------------------------- */
+
+	// Document order sorting
+	sortOrder = docElem.compareDocumentPosition ?
+	function( a, b ) {
+
+		// Flag for duplicate removal
+		if ( a === b ) {
+			hasDuplicate = true;
+			return 0;
+		}
+
+		var compare = b.compareDocumentPosition && a.compareDocumentPosition && a.compareDocumentPosition( b );
+
+		if ( compare ) {
+			// Disconnected nodes
+			if ( compare & 1 ||
+				(!support.sortDetached && b.compareDocumentPosition( a ) === compare) ) {
+
+				// Choose the first element that is related to our preferred document
+				if ( a === doc || contains(preferredDoc, a) ) {
+					return -1;
+				}
+				if ( b === doc || contains(preferredDoc, b) ) {
+					return 1;
+				}
+
+				// Maintain original order
+				return sortInput ?
+					( indexOf.call( sortInput, a ) - indexOf.call( sortInput, b ) ) :
+					0;
+			}
+
+			return compare & 4 ? -1 : 1;
+		}
+
+		// Not directly comparable, sort on existence of method
+		return a.compareDocumentPosition ? -1 : 1;
+	} :
+	function( a, b ) {
+		var cur,
+			i = 0,
+			aup = a.parentNode,
+			bup = b.parentNode,
+			ap = [ a ],
+			bp = [ b ];
+
+		// Exit early if the nodes are identical
+		if ( a === b ) {
+			hasDuplicate = true;
+			return 0;
+
+		// Parentless nodes are either documents or disconnected
+		} else if ( !aup || !bup ) {
+			return a === doc ? -1 :
+				b === doc ? 1 :
+				aup ? -1 :
+				bup ? 1 :
+				sortInput ?
+				( indexOf.call( sortInput, a ) - indexOf.call( sortInput, b ) ) :
+				0;
+
+		// If the nodes are siblings, we can do a quick check
+		} else if ( aup === bup ) {
+			return siblingCheck( a, b );
+		}
+
+		// Otherwise we need full lists of their ancestors for comparison
+		cur = a;
+		while ( (cur = cur.parentNode) ) {
+			ap.unshift( cur );
+		}
+		cur = b;
+		while ( (cur = cur.parentNode) ) {
+			bp.unshift( cur );
+		}
+
+		// Walk down the tree looking for a discrepancy
+		while ( ap[i] === bp[i] ) {
+			i++;
+		}
+
+		return i ?
+			// Do a sibling check if the nodes have a common ancestor
+			siblingCheck( ap[i], bp[i] ) :
+
+			// Otherwise nodes in our document sort first
+			ap[i] === preferredDoc ? -1 :
+			bp[i] === preferredDoc ? 1 :
+			0;
+	};
+
+	return doc;
+};
+
+Sizzle.matches = function( expr, elements ) {
+	return Sizzle( expr, null, null, elements );
+};
+
+Sizzle.matchesSelector = function( elem, expr ) {
+	// Set document vars if needed
+	if ( ( elem.ownerDocument || elem ) !== document ) {
+		setDocument( elem );
+	}
+
+	// Make sure that attribute selectors are quoted
+	expr = expr.replace( rattributeQuotes, "='$1']" );
+
+	if ( support.matchesSelector && documentIsHTML &&
+		( !rbuggyMatches || !rbuggyMatches.test( expr ) ) &&
+		( !rbuggyQSA     || !rbuggyQSA.test( expr ) ) ) {
+
+		try {
+			var ret = matches.call( elem, expr );
+
+			// IE 9's matchesSelector returns false on disconnected nodes
+			if ( ret || support.disconnectedMatch ||
+					// As well, disconnected nodes are said to be in a document
+					// fragment in IE 9
+					elem.document && elem.document.nodeType !== 11 ) {
+				return ret;
+			}
+		} catch(e) {}
+	}
+
+	return Sizzle( expr, document, null, [elem] ).length > 0;
+};
+
+Sizzle.contains = function( context, elem ) {
+	// Set document vars if needed
+	if ( ( context.ownerDocument || context ) !== document ) {
+		setDocument( context );
+	}
+	return contains( context, elem );
+};
+
+Sizzle.attr = function( elem, name ) {
+	// Set document vars if needed
+	if ( ( elem.ownerDocument || elem ) !== document ) {
+		setDocument( elem );
+	}
+
+	var fn = Expr.attrHandle[ name.toLowerCase() ],
+		// Don't get fooled by Object.prototype properties (jQuery #13807)
+		val = fn && hasOwn.call( Expr.attrHandle, name.toLowerCase() ) ?
+			fn( elem, name, !documentIsHTML ) :
+			undefined;
+
+	return val === undefined ?
+		support.attributes || !documentIsHTML ?
+			elem.getAttribute( name ) :
+			(val = elem.getAttributeNode(name)) && val.specified ?
+				val.value :
+				null :
+		val;
+};
+
+Sizzle.error = function( msg ) {
+	throw new Error( "Syntax error, unrecognized expression: " + msg );
+};
+
+/**
+ * Document sorting and removing duplicates
+ * @param {ArrayLike} results
+ */
+Sizzle.uniqueSort = function( results ) {
+	var elem,
+		duplicates = [],
+		j = 0,
+		i = 0;
+
+	// Unless we *know* we can detect duplicates, assume their presence
+	hasDuplicate = !support.detectDuplicates;
+	sortInput = !support.sortStable && results.slice( 0 );
+	results.sort( sortOrder );
+
+	if ( hasDuplicate ) {
+		while ( (elem = results[i++]) ) {
+			if ( elem === results[ i ] ) {
+				j = duplicates.push( i );
+			}
+		}
+		while ( j-- ) {
+			results.splice( duplicates[ j ], 1 );
+		}
+	}
+
+	return results;
+};
+
+/**
+ * Utility function for retrieving the text value of an array of DOM nodes
+ * @param {Array|Element} elem
+ */
+getText = Sizzle.getText = function( elem ) {
+	var node,
+		ret = "",
+		i = 0,
+		nodeType = elem.nodeType;
+
+	if ( !nodeType ) {
+		// If no nodeType, this is expected to be an array
+		for ( ; (node = elem[i]); i++ ) {
+			// Do not traverse comment nodes
+			ret += getText( node );
+		}
+	} else if ( nodeType === 1 || nodeType === 9 || nodeType === 11 ) {
+		// Use textContent for elements
+		// innerText usage removed for consistency of new lines (see #11153)
+		if ( typeof elem.textContent === "string" ) {
+			return elem.textContent;
+		} else {
+			// Traverse its children
+			for ( elem = elem.firstChild; elem; elem = elem.nextSibling ) {
+				ret += getText( elem );
+			}
+		}
+	} else if ( nodeType === 3 || nodeType === 4 ) {
+		return elem.nodeValue;
+	}
+	// Do not include comment or processing instruction nodes
+
+	return ret;
+};
+
+Expr = Sizzle.selectors = {
+
+	// Can be adjusted by the user
+	cacheLength: 50,
+
+	createPseudo: markFunction,
+
+	match: matchExpr,
+
+	attrHandle: {},
+
+	find: {},
+
+	relative: {
+		">": { dir: "parentNode", first: true },
+		" ": { dir: "parentNode" },
+		"+": { dir: "previousSibling", first: true },
+		"~": { dir: "previousSibling" }
+	},
+
+	preFilter: {
+		"ATTR": function( match ) {
+			match[1] = match[1].replace( runescape, funescape );
+
+			// Move the given value to match[3] whether quoted or unquoted
+			match[3] = ( match[4] || match[5] || "" ).replace( runescape, funescape );
+
+			if ( match[2] === "~=" ) {
+				match[3] = " " + match[3] + " ";
+			}
+
+			return match.slice( 0, 4 );
+		},
+
+		"CHILD": function( match ) {
+			/* matches from matchExpr["CHILD"]
+				1 type (only|nth|...)
+				2 what (child|of-type)
+				3 argument (even|odd|\d*|\d*n([+-]\d+)?|...)
+				4 xn-component of xn+y argument ([+-]?\d*n|)
+				5 sign of xn-component
+				6 x of xn-component
+				7 sign of y-component
+				8 y of y-component
+			*/
+			match[1] = match[1].toLowerCase();
+
+			if ( match[1].slice( 0, 3 ) === "nth" ) {
+				// nth-* requires argument
+				if ( !match[3] ) {
+					Sizzle.error( match[0] );
+				}
+
+				// numeric x and y parameters for Expr.filter.CHILD
+				// remember that false/true cast respectively to 0/1
+				match[4] = +( match[4] ? match[5] + (match[6] || 1) : 2 * ( match[3] === "even" || match[3] === "odd" ) );
+				match[5] = +( ( match[7] + match[8] ) || match[3] === "odd" );
+
+			// other types prohibit arguments
+			} else if ( match[3] ) {
+				Sizzle.error( match[0] );
+			}
+
+			return match;
+		},
+
+		"PSEUDO": function( match ) {
+			var excess,
+				unquoted = !match[5] && match[2];
+
+			if ( matchExpr["CHILD"].test( match[0] ) ) {
+				return null;
+			}
+
+			// Accept quoted arguments as-is
+			if ( match[3] && match[4] !== undefined ) {
+				match[2] = match[4];
+
+			// Strip excess characters from unquoted arguments
+			} else if ( unquoted && rpseudo.test( unquoted ) &&
+				// Get excess from tokenize (recursively)
+				(excess = tokenize( unquoted, true )) &&
+				// advance to the next closing parenthesis
+				(excess = unquoted.indexOf( ")", unquoted.length - excess ) - unquoted.length) ) {
+
+				// excess is a negative index
+				match[0] = match[0].slice( 0, excess );
+				match[2] = unquoted.slice( 0, excess );
+			}
+
+			// Return only captures needed by the pseudo filter method (type and argument)
+			return match.slice( 0, 3 );
+		}
+	},
+
+	filter: {
+
+		"TAG": function( nodeNameSelector ) {
+			var nodeName = nodeNameSelector.replace( runescape, funescape ).toLowerCase();
+			return nodeNameSelector === "*" ?
+				function() { return true; } :
+				function( elem ) {
+					return elem.nodeName && elem.nodeName.toLowerCase() === nodeName;
+				};
+		},
+
+		"CLASS": function( className ) {
+			var pattern = classCache[ className + " " ];
+
+			return pattern ||
+				(pattern = new RegExp( "(^|" + whitespace + ")" + className + "(" + whitespace + "|$)" )) &&
+				classCache( className, function( elem ) {
+					return pattern.test( typeof elem.className === "string" && elem.className || typeof elem.getAttribute !== strundefined && elem.getAttribute("class") || "" );
+				});
+		},
+
+		"ATTR": function( name, operator, check ) {
+			return function( elem ) {
+				var result = Sizzle.attr( elem, name );
+
+				if ( result == null ) {
+					return operator === "!=";
+				}
+				if ( !operator ) {
+					return true;
+				}
+
+				result += "";
+
+				return operator === "=" ? result === check :
+					operator === "!=" ? result !== check :
+					operator === "^=" ? check && result.indexOf( check ) === 0 :
+					operator === "*=" ? check && result.indexOf( check ) > -1 :
+					operator === "$=" ? check && result.slice( -check.length ) === check :
+					operator === "~=" ? ( " " + result + " " ).indexOf( check ) > -1 :
+					operator === "|=" ? result === check || result.slice( 0, check.length + 1 ) === check + "-" :
+					false;
+			};
+		},
+
+		"CHILD": function( type, what, argument, first, last ) {
+			var simple = type.slice( 0, 3 ) !== "nth",
+				forward = type.slice( -4 ) !== "last",
+				ofType = what === "of-type";
+
+			return first === 1 && last === 0 ?
+
+				// Shortcut for :nth-*(n)
+				function( elem ) {
+					return !!elem.parentNode;
+				} :
+
+				function( elem, context, xml ) {
+					var cache, outerCache, node, diff, nodeIndex, start,
+						dir = simple !== forward ? "nextSibling" : "previousSibling",
+						parent = elem.parentNode,
+						name = ofType && elem.nodeName.toLowerCase(),
+						useCache = !xml && !ofType;
+
+					if ( parent ) {
+
+						// :(first|last|only)-(child|of-type)
+						if ( simple ) {
+							while ( dir ) {
+								node = elem;
+								while ( (node = node[ dir ]) ) {
+									if ( ofType ? node.nodeName.toLowerCase() === name : node.nodeType === 1 ) {
+										return false;
+									}
+								}
+								// Reverse direction for :only-* (if we haven't yet done so)
+								start = dir = type === "only" && !start && "nextSibling";
+							}
+							return true;
+						}
+
+						start = [ forward ? parent.firstChild : parent.lastChild ];
+
+						// non-xml :nth-child(...) stores cache data on `parent`
+						if ( forward && useCache ) {
+							// Seek `elem` from a previously-cached index
+							outerCache = parent[ expando ] || (parent[ expando ] = {});
+							cache = outerCache[ type ] || [];
+							nodeIndex = cache[0] === dirruns && cache[1];
+							diff = cache[0] === dirruns && cache[2];
+							node = nodeIndex && parent.childNodes[ nodeIndex ];
+
+							while ( (node = ++nodeIndex && node && node[ dir ] ||
+
+								// Fallback to seeking `elem` from the start
+								(diff = nodeIndex = 0) || start.pop()) ) {
+
+								// When found, cache indexes on `parent` and break
+								if ( node.nodeType === 1 && ++diff && node === elem ) {
+									outerCache[ type ] = [ dirruns, nodeIndex, diff ];
+									break;
+								}
+							}
+
+						// Use previously-cached element index if available
+						} else if ( useCache && (cache = (elem[ expando ] || (elem[ expando ] = {}))[ type ]) && cache[0] === dirruns ) {
+							diff = cache[1];
+
+						// xml :nth-child(...) or :nth-last-child(...) or :nth(-last)?-of-type(...)
+						} else {
+							// Use the same loop as above to seek `elem` from the start
+							while ( (node = ++nodeIndex && node && node[ dir ] ||
+								(diff = nodeIndex = 0) || start.pop()) ) {
+
+								if ( ( ofType ? node.nodeName.toLowerCase() === name : node.nodeType === 1 ) && ++diff ) {
+									// Cache the index of each encountered element
+									if ( useCache ) {
+										(node[ expando ] || (node[ expando ] = {}))[ type ] = [ dirruns, diff ];
+									}
+
+									if ( node === elem ) {
+										break;
+									}
+								}
+							}
+						}
+
+						// Incorporate the offset, then check against cycle size
+						diff -= last;
+						return diff === first || ( diff % first === 0 && diff / first >= 0 );
+					}
+				};
+		},
+
+		"PSEUDO": function( pseudo, argument ) {
+			// pseudo-class names are case-insensitive
+			// http://www.w3.org/TR/selectors/#pseudo-classes
+			// Prioritize by case sensitivity in case custom pseudos are added with uppercase letters
+			// Remember that setFilters inherits from pseudos
+			var args,
+				fn = Expr.pseudos[ pseudo ] || Expr.setFilters[ pseudo.toLowerCase() ] ||
+					Sizzle.error( "unsupported pseudo: " + pseudo );
+
+			// The user may use createPseudo to indicate that
+			// arguments are needed to create the filter function
+			// just as Sizzle does
+			if ( fn[ expando ] ) {
+				return fn( argument );
+			}
+
+			// But maintain support for old signatures
+			if ( fn.length > 1 ) {
+				args = [ pseudo, pseudo, "", argument ];
+				return Expr.setFilters.hasOwnProperty( pseudo.toLowerCase() ) ?
+					markFunction(function( seed, matches ) {
+						var idx,
+							matched = fn( seed, argument ),
+							i = matched.length;
+						while ( i-- ) {
+							idx = indexOf.call( seed, matched[i] );
+							seed[ idx ] = !( matches[ idx ] = matched[i] );
+						}
+					}) :
+					function( elem ) {
+						return fn( elem, 0, args );
+					};
+			}
+
+			return fn;
+		}
+	},
+
+	pseudos: {
+		// Potentially complex pseudos
+		"not": markFunction(function( selector ) {
+			// Trim the selector passed to compile
+			// to avoid treating leading and trailing
+			// spaces as combinators
+			var input = [],
+				results = [],
+				matcher = compile( selector.replace( rtrim, "$1" ) );
+
+			return matcher[ expando ] ?
+				markFunction(function( seed, matches, context, xml ) {
+					var elem,
+						unmatched = matcher( seed, null, xml, [] ),
+						i = seed.length;
+
+					// Match elements unmatched by `matcher`
+					while ( i-- ) {
+						if ( (elem = unmatched[i]) ) {
+							seed[i] = !(matches[i] = elem);
+						}
+					}
+				}) :
+				function( elem, context, xml ) {
+					input[0] = elem;
+					matcher( input, null, xml, results );
+					return !results.pop();
+				};
+		}),
+
+		"has": markFunction(function( selector ) {
+			return function( elem ) {
+				return Sizzle( selector, elem ).length > 0;
+			};
+		}),
+
+		"contains": markFunction(function( text ) {
+			return function( elem ) {
+				return ( elem.textContent || elem.innerText || getText( elem ) ).indexOf( text ) > -1;
+			};
+		}),
+
+		// "Whether an element is represented by a :lang() selector
+		// is based solely on the element's language value
+		// being equal to the identifier C,
+		// or beginning with the identifier C immediately followed by "-".
+		// The matching of C against the element's language value is performed case-insensitively.
+		// The identifier C does not have to be a valid language name."
+		// http://www.w3.org/TR/selectors/#lang-pseudo
+		"lang": markFunction( function( lang ) {
+			// lang value must be a valid identifier
+			if ( !ridentifier.test(lang || "") ) {
+				Sizzle.error( "unsupported lang: " + lang );
+			}
+			lang = lang.replace( runescape, funescape ).toLowerCase();
+			return function( elem ) {
+				var elemLang;
+				do {
+					if ( (elemLang = documentIsHTML ?
+						elem.lang :
+						elem.getAttribute("xml:lang") || elem.getAttribute("lang")) ) {
+
+						elemLang = elemLang.toLowerCase();
+						return elemLang === lang || elemLang.indexOf( lang + "-" ) === 0;
+					}
+				} while ( (elem = elem.parentNode) && elem.nodeType === 1 );
+				return false;
+			};
+		}),
+
+		// Miscellaneous
+		"target": function( elem ) {
+			var hash = window.location && window.location.hash;
+			return hash && hash.slice( 1 ) === elem.id;
+		},
+
+		"root": function( elem ) {
+			return elem === docElem;
+		},
+
+		"focus": function( elem ) {
+			return elem === document.activeElement && (!document.hasFocus || document.hasFocus()) && !!(elem.type || elem.href || ~elem.tabIndex);
+		},
+
+		// Boolean properties
+		"enabled": function( elem ) {
+			return elem.disabled === false;
+		},
+
+		"disabled": function( elem ) {
+			return elem.disabled === true;
+		},
+
+		"checked": function( elem ) {
+			// In CSS3, :checked should return both checked and selected elements
+			// http://www.w3.org/TR/2011/REC-css3-selectors-20110929/#checked
+			var nodeName = elem.nodeName.toLowerCase();
+			return (nodeName === "input" && !!elem.checked) || (nodeName === "option" && !!elem.selected);
+		},
+
+		"selected": function( elem ) {
+			// Accessing this property makes selected-by-default
+			// options in Safari work properly
+			if ( elem.parentNode ) {
+				elem.parentNode.selectedIndex;
+			}
+
+			return elem.selected === true;
+		},
+
+		// Contents
+		"empty": function( elem ) {
+			// http://www.w3.org/TR/selectors/#empty-pseudo
+			// :empty is only affected by element nodes and content nodes(including text(3), cdata(4)),
+			//   not comment, processing instructions, or others
+			// Thanks to Diego Perini for the nodeName shortcut
+			//   Greater than "@" means alpha characters (specifically not starting with "#" or "?")
+			for ( elem = elem.firstChild; elem; elem = elem.nextSibling ) {
+				if ( elem.nodeName > "@" || elem.nodeType === 3 || elem.nodeType === 4 ) {
+					return false;
+				}
+			}
+			return true;
+		},
+
+		"parent": function( elem ) {
+			return !Expr.pseudos["empty"]( elem );
+		},
+
+		// Element/input types
+		"header": function( elem ) {
+			return rheader.test( elem.nodeName );
+		},
+
+		"input": function( elem ) {
+			return rinputs.test( elem.nodeName );
+		},
+
+		"button": function( elem ) {
+			var name = elem.nodeName.toLowerCase();
+			return name === "input" && elem.type === "button" || name === "button";
+		},
+
+		"text": function( elem ) {
+			var attr;
+			// IE6 and 7 will map elem.type to 'text' for new HTML5 types (search, etc)
+			// use getAttribute instead to test this case
+			return elem.nodeName.toLowerCase() === "input" &&
+				elem.type === "text" &&
+				( (attr = elem.getAttribute("type")) == null || attr.toLowerCase() === elem.type );
+		},
+
+		// Position-in-collection
+		"first": createPositionalPseudo(function() {
+			return [ 0 ];
+		}),
+
+		"last": createPositionalPseudo(function( matchIndexes, length ) {
+			return [ length - 1 ];
+		}),
+
+		"eq": createPositionalPseudo(function( matchIndexes, length, argument ) {
+			return [ argument < 0 ? argument + length : argument ];
+		}),
+
+		"even": createPositionalPseudo(function( matchIndexes, length ) {
+			var i = 0;
+			for ( ; i < length; i += 2 ) {
+				matchIndexes.push( i );
+			}
+			return matchIndexes;
+		}),
+
+		"odd": createPositionalPseudo(function( matchIndexes, length ) {
+			var i = 1;
+			for ( ; i < length; i += 2 ) {
+				matchIndexes.push( i );
+			}
+			return matchIndexes;
+		}),
+
+		"lt": createPositionalPseudo(function( matchIndexes, length, argument ) {
+			var i = argument < 0 ? argument + length : argument;
+			for ( ; --i >= 0; ) {
+				matchIndexes.push( i );
+			}
+			return matchIndexes;
+		}),
+
+		"gt": createPositionalPseudo(function( matchIndexes, length, argument ) {
+			var i = argument < 0 ? argument + length : argument;
+			for ( ; ++i < length; ) {
+				matchIndexes.push( i );
+			}
+			return matchIndexes;
+		})
+	}
+};
+
+Expr.pseudos["nth"] = Expr.pseudos["eq"];
+
+// Add button/input type pseudos
+for ( i in { radio: true, checkbox: true, file: true, password: true, image: true } ) {
+	Expr.pseudos[ i ] = createInputPseudo( i );
+}
+for ( i in { submit: true, reset: true } ) {
+	Expr.pseudos[ i ] = createButtonPseudo( i );
+}
+
+// Easy API for creating new setFilters
+function setFilters() {}
+setFilters.prototype = Expr.filters = Expr.pseudos;
+Expr.setFilters = new setFilters();
+
+function tokenize( selector, parseOnly ) {
+	var matched, match, tokens, type,
+		soFar, groups, preFilters,
+		cached = tokenCache[ selector + " " ];
+
+	if ( cached ) {
+		return parseOnly ? 0 : cached.slice( 0 );
+	}
+
+	soFar = selector;
+	groups = [];
+	preFilters = Expr.preFilter;
+
+	while ( soFar ) {
+
+		// Comma and first run
+		if ( !matched || (match = rcomma.exec( soFar )) ) {
+			if ( match ) {
+				// Don't consume trailing commas as valid
+				soFar = soFar.slice( match[0].length ) || soFar;
+			}
+			groups.push( tokens = [] );
+		}
+
+		matched = false;
+
+		// Combinators
+		if ( (match = rcombinators.exec( soFar )) ) {
+			matched = match.shift();
+			tokens.push({
+				value: matched,
+				// Cast descendant combinators to space
+				type: match[0].replace( rtrim, " " )
+			});
+			soFar = soFar.slice( matched.length );
+		}
+
+		// Filters
+		for ( type in Expr.filter ) {
+			if ( (match = matchExpr[ type ].exec( soFar )) && (!preFilters[ type ] ||
+				(match = preFilters[ type ]( match ))) ) {
+				matched = match.shift();
+				tokens.push({
+					value: matched,
+					type: type,
+					matches: match
+				});
+				soFar = soFar.slice( matched.length );
+			}
+		}
+
+		if ( !matched ) {
+			break;
+		}
+	}
+
+	// Return the length of the invalid excess
+	// if we're just parsing
+	// Otherwise, throw an error or return tokens
+	return parseOnly ?
+		soFar.length :
+		soFar ?
+			Sizzle.error( selector ) :
+			// Cache the tokens
+			tokenCache( selector, groups ).slice( 0 );
+}
+
+function toSelector( tokens ) {
+	var i = 0,
+		len = tokens.length,
+		selector = "";
+	for ( ; i < len; i++ ) {
+		selector += tokens[i].value;
+	}
+	return selector;
+}
+
+function addCombinator( matcher, combinator, base ) {
+	var dir = combinator.dir,
+		checkNonElements = base && dir === "parentNode",
+		doneName = done++;
+
+	return combinator.first ?
+		// Check against closest ancestor/preceding element
+		function( elem, context, xml ) {
+			while ( (elem = elem[ dir ]) ) {
+				if ( elem.nodeType === 1 || checkNonElements ) {
+					return matcher( elem, context, xml );
+				}
+			}
+		} :
+
+		// Check against all ancestor/preceding elements
+		function( elem, context, xml ) {
+			var data, cache, outerCache,
+				dirkey = dirruns + " " + doneName;
+
+			// We can't set arbitrary data on XML nodes, so they don't benefit from dir caching
+			if ( xml ) {
+				while ( (elem = elem[ dir ]) ) {
+					if ( elem.nodeType === 1 || checkNonElements ) {
+						if ( matcher( elem, context, xml ) ) {
+							return true;
+						}
+					}
+				}
+			} else {
+				while ( (elem = elem[ dir ]) ) {
+					if ( elem.nodeType === 1 || checkNonElements ) {
+						outerCache = elem[ expando ] || (elem[ expando ] = {});
+						if ( (cache = outerCache[ dir ]) && cache[0] === dirkey ) {
+							if ( (data = cache[1]) === true || data === cachedruns ) {
+								return data === true;
+							}
+						} else {
+							cache = outerCache[ dir ] = [ dirkey ];
+							cache[1] = matcher( elem, context, xml ) || cachedruns;
+							if ( cache[1] === true ) {
+								return true;
+							}
+						}
+					}
+				}
+			}
+		};
+}
+
+function elementMatcher( matchers ) {
+	return matchers.length > 1 ?
+		function( elem, context, xml ) {
+			var i = matchers.length;
+			while ( i-- ) {
+				if ( !matchers[i]( elem, context, xml ) ) {
+					return false;
+				}
+			}
+			return true;
+		} :
+		matchers[0];
+}
+
+function condense( unmatched, map, filter, context, xml ) {
+	var elem,
+		newUnmatched = [],
+		i = 0,
+		len = unmatched.length,
+		mapped = map != null;
+
+	for ( ; i < len; i++ ) {
+		if ( (elem = unmatched[i]) ) {
+			if ( !filter || filter( elem, context, xml ) ) {
+				newUnmatched.push( elem );
+				if ( mapped ) {
+					map.push( i );
+				}
+			}
+		}
+	}
+
+	return newUnmatched;
+}
+
+function setMatcher( preFilter, selector, matcher, postFilter, postFinder, postSelector ) {
+	if ( postFilter && !postFilter[ expando ] ) {
+		postFilter = setMatcher( postFilter );
+	}
+	if ( postFinder && !postFinder[ expando ] ) {
+		postFinder = setMatcher( postFinder, postSelector );
+	}
+	return markFunction(function( seed, results, context, xml ) {
+		var temp, i, elem,
+			preMap = [],
+			postMap = [],
+			preexisting = results.length,
+
+			// Get initial elements from seed or context
+			elems = seed || multipleContexts( selector || "*", context.nodeType ? [ context ] : context, [] ),
+
+			// Prefilter to get matcher input, preserving a map for seed-results synchronization
+			matcherIn = preFilter && ( seed || !selector ) ?
+				condense( elems, preMap, preFilter, context, xml ) :
+				elems,
+
+			matcherOut = matcher ?
+				// If we have a postFinder, or filtered seed, or non-seed postFilter or preexisting results,
+				postFinder || ( seed ? preFilter : preexisting || postFilter ) ?
+
+					// ...intermediate processing is necessary
+					[] :
+
+					// ...otherwise use results directly
+					results :
+				matcherIn;
+
+		// Find primary matches
+		if ( matcher ) {
+			matcher( matcherIn, matcherOut, context, xml );
+		}
+
+		// Apply postFilter
+		if ( postFilter ) {
+			temp = condense( matcherOut, postMap );
+			postFilter( temp, [], context, xml );
+
+			// Un-match failing elements by moving them back to matcherIn
+			i = temp.length;
+			while ( i-- ) {
+				if ( (elem = temp[i]) ) {
+					matcherOut[ postMap[i] ] = !(matcherIn[ postMap[i] ] = elem);
+				}
+			}
+		}
+
+		if ( seed ) {
+			if ( postFinder || preFilter ) {
+				if ( postFinder ) {
+					// Get the final matcherOut by condensing this intermediate into postFinder contexts
+					temp = [];
+					i = matcherOut.length;
+					while ( i-- ) {
+						if ( (elem = matcherOut[i]) ) {
+							// Restore matcherIn since elem is not yet a final match
+							temp.push( (matcherIn[i] = elem) );
+						}
+					}
+					postFinder( null, (matcherOut = []), temp, xml );
+				}
+
+				// Move matched elements from seed to results to keep them synchronized
+				i = matcherOut.length;
+				while ( i-- ) {
+					if ( (elem = matcherOut[i]) &&
+						(temp = postFinder ? indexOf.call( seed, elem ) : preMap[i]) > -1 ) {
+
+						seed[temp] = !(results[temp] = elem);
+					}
+				}
+			}
+
+		// Add elements to results, through postFinder if defined
+		} else {
+			matcherOut = condense(
+				matcherOut === results ?
+					matcherOut.splice( preexisting, matcherOut.length ) :
+					matcherOut
+			);
+			if ( postFinder ) {
+				postFinder( null, results, matcherOut, xml );
+			} else {
+				push.apply( results, matcherOut );
+			}
+		}
+	});
+}
+
+function matcherFromTokens( tokens ) {
+	var checkContext, matcher, j,
+		len = tokens.length,
+		leadingRelative = Expr.relative[ tokens[0].type ],
+		implicitRelative = leadingRelative || Expr.relative[" "],
+		i = leadingRelative ? 1 : 0,
+
+		// The foundational matcher ensures that elements are reachable from top-level context(s)
+		matchContext = addCombinator( function( elem ) {
+			return elem === checkContext;
+		}, implicitRelative, true ),
+		matchAnyContext = addCombinator( function( elem ) {
+			return indexOf.call( checkContext, elem ) > -1;
+		}, implicitRelative, true ),
+		matchers = [ function( elem, context, xml ) {
+			return ( !leadingRelative && ( xml || context !== outermostContext ) ) || (
+				(checkContext = context).nodeType ?
+					matchContext( elem, context, xml ) :
+					matchAnyContext( elem, context, xml ) );
+		} ];
+
+	for ( ; i < len; i++ ) {
+		if ( (matcher = Expr.relative[ tokens[i].type ]) ) {
+			matchers = [ addCombinator(elementMatcher( matchers ), matcher) ];
+		} else {
+			matcher = Expr.filter[ tokens[i].type ].apply( null, tokens[i].matches );
+
+			// Return special upon seeing a positional matcher
+			if ( matcher[ expando ] ) {
+				// Find the next relative operator (if any) for proper handling
+				j = ++i;
+				for ( ; j < len; j++ ) {
+					if ( Expr.relative[ tokens[j].type ] ) {
+						break;
+					}
+				}
+				return setMatcher(
+					i > 1 && elementMatcher( matchers ),
+					i > 1 && toSelector(
+						// If the preceding token was a descendant combinator, insert an implicit any-element `*`
+						tokens.slice( 0, i - 1 ).concat({ value: tokens[ i - 2 ].type === " " ? "*" : "" })
+					).replace( rtrim, "$1" ),
+					matcher,
+					i < j && matcherFromTokens( tokens.slice( i, j ) ),
+					j < len && matcherFromTokens( (tokens = tokens.slice( j )) ),
+					j < len && toSelector( tokens )
+				);
+			}
+			matchers.push( matcher );
+		}
+	}
+
+	return elementMatcher( matchers );
+}
+
+function matcherFromGroupMatchers( elementMatchers, setMatchers ) {
+	// A counter to specify which element is currently being matched
+	var matcherCachedRuns = 0,
+		bySet = setMatchers.length > 0,
+		byElement = elementMatchers.length > 0,
+		superMatcher = function( seed, context, xml, results, expandContext ) {
+			var elem, j, matcher,
+				setMatched = [],
+				matchedCount = 0,
+				i = "0",
+				unmatched = seed && [],
+				outermost = expandContext != null,
+				contextBackup = outermostContext,
+				// We must always have either seed elements or context
+				elems = seed || byElement && Expr.find["TAG"]( "*", expandContext && context.parentNode || context ),
+				// Use integer dirruns iff this is the outermost matcher
+				dirrunsUnique = (dirruns += contextBackup == null ? 1 : Math.random() || 0.1);
+
+			if ( outermost ) {
+				outermostContext = context !== document && context;
+				cachedruns = matcherCachedRuns;
+			}
+
+			// Add elements passing elementMatchers directly to results
+			// Keep `i` a string if there are no elements so `matchedCount` will be "00" below
+			for ( ; (elem = elems[i]) != null; i++ ) {
+				if ( byElement && elem ) {
+					j = 0;
+					while ( (matcher = elementMatchers[j++]) ) {
+						if ( matcher( elem, context, xml ) ) {
+							results.push( elem );
+							break;
+						}
+					}
+					if ( outermost ) {
+						dirruns = dirrunsUnique;
+						cachedruns = ++matcherCachedRuns;
+					}
+				}
+
+				// Track unmatched elements for set filters
+				if ( bySet ) {
+					// They will have gone through all possible matchers
+					if ( (elem = !matcher && elem) ) {
+						matchedCount--;
+					}
+
+					// Lengthen the array for every element, matched or not
+					if ( seed ) {
+						unmatched.push( elem );
+					}
+				}
+			}
+
+			// Apply set filters to unmatched elements
+			matchedCount += i;
+			if ( bySet && i !== matchedCount ) {
+				j = 0;
+				while ( (matcher = setMatchers[j++]) ) {
+					matcher( unmatched, setMatched, context, xml );
+				}
+
+				if ( seed ) {
+					// Reintegrate element matches to eliminate the need for sorting
+					if ( matchedCount > 0 ) {
+						while ( i-- ) {
+							if ( !(unmatched[i] || setMatched[i]) ) {
+								setMatched[i] = pop.call( results );
+							}
+						}
+					}
+
+					// Discard index placeholder values to get only actual matches
+					setMatched = condense( setMatched );
+				}
+
+				// Add matches to results
+				push.apply( results, setMatched );
+
+				// Seedless set matches succeeding multiple successful matchers stipulate sorting
+				if ( outermost && !seed && setMatched.length > 0 &&
+					( matchedCount + setMatchers.length ) > 1 ) {
+
+					Sizzle.uniqueSort( results );
+				}
+			}
+
+			// Override manipulation of globals by nested matchers
+			if ( outermost ) {
+				dirruns = dirrunsUnique;
+				outermostContext = contextBackup;
+			}
+
+			return unmatched;
+		};
+
+	return bySet ?
+		markFunction( superMatcher ) :
+		superMatcher;
+}
+
+compile = Sizzle.compile = function( selector, group /* Internal Use Only */ ) {
+	var i,
+		setMatchers = [],
+		elementMatchers = [],
+		cached = compilerCache[ selector + " " ];
+
+	if ( !cached ) {
+		// Generate a function of recursive functions that can be used to check each element
+		if ( !group ) {
+			group = tokenize( selector );
+		}
+		i = group.length;
+		while ( i-- ) {
+			cached = matcherFromTokens( group[i] );
+			if ( cached[ expando ] ) {
+				setMatchers.push( cached );
+			} else {
+				elementMatchers.push( cached );
+			}
+		}
+
+		// Cache the compiled function
+		cached = compilerCache( selector, matcherFromGroupMatchers( elementMatchers, setMatchers ) );
+	}
+	return cached;
+};
+
+function multipleContexts( selector, contexts, results ) {
+	var i = 0,
+		len = contexts.length;
+	for ( ; i < len; i++ ) {
+		Sizzle( selector, contexts[i], results );
+	}
+	return results;
+}
+
+function select( selector, context, results, seed ) {
+	var i, tokens, token, type, find,
+		match = tokenize( selector );
+
+	if ( !seed ) {
+		// Try to minimize operations if there is only one group
+		if ( match.length === 1 ) {
+
+			// Take a shortcut and set the context if the root selector is an ID
+			tokens = match[0] = match[0].slice( 0 );
+			if ( tokens.length > 2 && (token = tokens[0]).type === "ID" &&
+					support.getById && context.nodeType === 9 && documentIsHTML &&
+					Expr.relative[ tokens[1].type ] ) {
+
+				context = ( Expr.find["ID"]( token.matches[0].replace(runescape, funescape), context ) || [] )[0];
+				if ( !context ) {
+					return results;
+				}
+				selector = selector.slice( tokens.shift().value.length );
+			}
+
+			// Fetch a seed set for right-to-left matching
+			i = matchExpr["needsContext"].test( selector ) ? 0 : tokens.length;
+			while ( i-- ) {
+				token = tokens[i];
+
+				// Abort if we hit a combinator
+				if ( Expr.relative[ (type = token.type) ] ) {
+					break;
+				}
+				if ( (find = Expr.find[ type ]) ) {
+					// Search, expanding context for leading sibling combinators
+					if ( (seed = find(
+						token.matches[0].replace( runescape, funescape ),
+						rsibling.test( tokens[0].type ) && context.parentNode || context
+					)) ) {
+
+						// If seed is empty or no tokens remain, we can return early
+						tokens.splice( i, 1 );
+						selector = seed.length && toSelector( tokens );
+						if ( !selector ) {
+							push.apply( results, seed );
+							return results;
+						}
+
+						break;
+					}
+				}
+			}
+		}
+	}
+
+	// Compile and execute a filtering function
+	// Provide `match` to avoid retokenization if we modified the selector above
+	compile( selector, match )(
+		seed,
+		context,
+		!documentIsHTML,
+		results,
+		rsibling.test( selector )
+	);
+	return results;
+}
+
+// One-time assignments
+
+// Sort stability
+support.sortStable = expando.split("").sort( sortOrder ).join("") === expando;
+
+// Support: Chrome<14
+// Always assume duplicates if they aren't passed to the comparison function
+support.detectDuplicates = hasDuplicate;
+
+// Initialize against the default document
+setDocument();
+
+// Support: Webkit<537.32 - Safari 6.0.3/Chrome 25 (fixed in Chrome 27)
+// Detached nodes confoundingly follow *each other*
+support.sortDetached = assert(function( div1 ) {
+	// Should return 1, but returns 4 (following)
+	return div1.compareDocumentPosition( document.createElement("div") ) & 1;
+});
+
+// Support: IE<8
+// Prevent attribute/property "interpolation"
+// http://msdn.microsoft.com/en-us/library/ms536429%28VS.85%29.aspx
+if ( !assert(function( div ) {
+	div.innerHTML = "<a href='#'></a>";
+	return div.firstChild.getAttribute("href") === "#" ;
+}) ) {
+	addHandle( "type|href|height|width", function( elem, name, isXML ) {
+		if ( !isXML ) {
+			return elem.getAttribute( name, name.toLowerCase() === "type" ? 1 : 2 );
+		}
+	});
+}
+
+// Support: IE<9
+// Use defaultValue in place of getAttribute("value")
+if ( !support.attributes || !assert(function( div ) {
+	div.innerHTML = "<input/>";
+	div.firstChild.setAttribute( "value", "" );
+	return div.firstChild.getAttribute( "value" ) === "";
+}) ) {
+	addHandle( "value", function( elem, name, isXML ) {
+		if ( !isXML && elem.nodeName.toLowerCase() === "input" ) {
+			return elem.defaultValue;
+		}
+	});
+}
+
+// Support: IE<9
+// Use getAttributeNode to fetch booleans when getAttribute lies
+if ( !assert(function( div ) {
+	return div.getAttribute("disabled") == null;
+}) ) {
+	addHandle( booleans, function( elem, name, isXML ) {
+		var val;
+		if ( !isXML ) {
+			return (val = elem.getAttributeNode( name )) && val.specified ?
+				val.value :
+				elem[ name ] === true ? name.toLowerCase() : null;
+		}
+	});
+}
+
+jQuery.find = Sizzle;
+jQuery.expr = Sizzle.selectors;
+jQuery.expr[":"] = jQuery.expr.pseudos;
+jQuery.unique = Sizzle.uniqueSort;
+jQuery.text = Sizzle.getText;
+jQuery.isXMLDoc = Sizzle.isXML;
+jQuery.contains = Sizzle.contains;
+
+
+})( window );
+// String to Object options format cache
+var optionsCache = {};
+
+// Convert String-formatted options into Object-formatted ones and store in cache
+function createOptions( options ) {
+	var object = optionsCache[ options ] = {};
+	jQuery.each( options.match( core_rnotwhite ) || [], function( _, flag ) {
+		object[ flag ] = true;
+	});
+	return object;
+}
+
+/*
+ * Create a callback list using the following parameters:
+ *
+ *	options: an optional list of space-separated options that will change how
+ *			the callback list behaves or a more traditional option object
+ *
+ * By default a callback list will act like an event callback list and can be
+ * "fired" multiple times.
+ *
+ * Possible options:
+ *
+ *	once:			will ensure the callback list can only be fired once (like a Deferred)
+ *
+ *	memory:			will keep track of previous values and will call any callback added
+ *					after the list has been fired right away with the latest "memorized"
+ *					values (like a Deferred)
+ *
+ *	unique:			will ensure a callback can only be added once (no duplicate in the list)
+ *
+ *	stopOnFalse:	interrupt callings when a callback returns false
+ *
+ */
+jQuery.Callbacks = function( options ) {
+
+	// Convert options from String-formatted to Object-formatted if needed
+	// (we check in cache first)
+	options = typeof options === "string" ?
+		( optionsCache[ options ] || createOptions( options ) ) :
+		jQuery.extend( {}, options );
+
+	var // Last fire value (for non-forgettable lists)
+		memory,
+		// Flag to know if list was already fired
+		fired,
+		// Flag to know if list is currently firing
+		firing,
+		// First callback to fire (used internally by add and fireWith)
+		firingStart,
+		// End of the loop when firing
+		firingLength,
+		// Index of currently firing callback (modified by remove if needed)
+		firingIndex,
+		// Actual callback list
+		list = [],
+		// Stack of fire calls for repeatable lists
+		stack = !options.once && [],
+		// Fire callbacks
+		fire = function( data ) {
+			memory = options.memory && data;
+			fired = true;
+			firingIndex = firingStart || 0;
+			firingStart = 0;
+			firingLength = list.length;
+			firing = true;
+			for ( ; list && firingIndex < firingLength; firingIndex++ ) {
+				if ( list[ firingIndex ].apply( data[ 0 ], data[ 1 ] ) === false && options.stopOnFalse ) {
+					memory = false; // To prevent further calls using add
+					break;
+				}
+			}
+			firing = false;
+			if ( list ) {
+				if ( stack ) {
+					if ( stack.length ) {
+						fire( stack.shift() );
+					}
+				} else if ( memory ) {
+					list = [];
+				} else {
+					self.disable();
+				}
+			}
+		},
+		// Actual Callbacks object
+		self = {
+			// Add a callback or a collection of callbacks to the list
+			add: function() {
+				if ( list ) {
+					// First, we save the current length
+					var start = list.length;
+					(function add( args ) {
+						jQuery.each( args, function( _, arg ) {
+							var type = jQuery.type( arg );
+							if ( type === "function" ) {
+								if ( !options.unique || !self.has( arg ) ) {
+									list.push( arg );
+								}
+							} else if ( arg && arg.length && type !== "string" ) {
+								// Inspect recursively
+								add( arg );
+							}
+						});
+					})( arguments );
+					// Do we need to add the callbacks to the
+					// current firing batch?
+					if ( firing ) {
+						firingLength = list.length;
+					// With memory, if we're not firing then
+					// we should call right away
+					} else if ( memory ) {
+						firingStart = start;
+						fire( memory );
+					}
+				}
+				return this;
+			},
+			// Remove a callback from the list
+			remove: function() {
+				if ( list ) {
+					jQuery.each( arguments, function( _, arg ) {
+						var index;
+						while( ( index = jQuery.inArray( arg, list, index ) ) > -1 ) {
+							list.splice( index, 1 );
+							// Handle firing indexes
+							if ( firing ) {
+								if ( index <= firingLength ) {
+									firingLength--;
+								}
+								if ( index <= firingIndex ) {
+									firingIndex--;
+								}
+							}
+						}
+					});
+				}
+				return this;
+			},
+			// Check if a given callback is in the list.
+			// If no argument is given, return whether or not list has callbacks attached.
+			has: function( fn ) {
+				return fn ? jQuery.inArray( fn, list ) > -1 : !!( list && list.length );
+			},
+			// Remove all callbacks from the list
+			empty: function() {
+				list = [];
+				firingLength = 0;
+				return this;
+			},
+			// Have the list do nothing anymore
+			disable: function() {
+				list = stack = memory = undefined;
+				return this;
+			},
+			// Is it disabled?
+			disabled: function() {
+				return !list;
+			},
+			// Lock the list in its current state
+			lock: function() {
+				stack = undefined;
+				if ( !memory ) {
+					self.disable();
+				}
+				return this;
+			},
+			// Is it locked?
+			locked: function() {
+				return !stack;
+			},
+			// Call all callbacks with the given context and arguments
+			fireWith: function( context, args ) {
+				if ( list && ( !fired || stack ) ) {
+					args = args || [];
+					args = [ context, args.slice ? args.slice() : args ];
+					if ( firing ) {
+						stack.push( args );
+					} else {
+						fire( args );
+					}
+				}
+				return this;
+			},
+			// Call all the callbacks with the given arguments
+			fire: function() {
+				self.fireWith( this, arguments );
+				return this;
+			},
+			// To know if the callbacks have already been called at least once
+			fired: function() {
+				return !!fired;
+			}
+		};
+
+	return self;
+};
+jQuery.extend({
+
+	Deferred: function( func ) {
+		var tuples = [
+				// action, add listener, listener list, final state
+				[ "resolve", "done", jQuery.Callbacks("once memory"), "resolved" ],
+				[ "reject", "fail", jQuery.Callbacks("once memory"), "rejected" ],
+				[ "notify", "progress", jQuery.Callbacks("memory") ]
+			],
+			state = "pending",
+			promise = {
+				state: function() {
+					return state;
+				},
+				always: function() {
+					deferred.done( arguments ).fail( arguments );
+					return this;
+				},
+				then: function( /* fnDone, fnFail, fnProgress */ ) {
+					var fns = arguments;
+					return jQuery.Deferred(function( newDefer ) {
+						jQuery.each( tuples, function( i, tuple ) {
+							var action = tuple[ 0 ],
+								fn = jQuery.isFunction( fns[ i ] ) && fns[ i ];
+							// deferred[ done | fail | progress ] for forwarding actions to newDefer
+							deferred[ tuple[1] ](function() {
+								var returned = fn && fn.apply( this, arguments );
+								if ( returned && jQuery.isFunction( returned.promise ) ) {
+									returned.promise()
+										.done( newDefer.resolve )
+										.fail( newDefer.reject )
+										.progress( newDefer.notify );
+								} else {
+									newDefer[ action + "With" ]( this === promise ? newDefer.promise() : this, fn ? [ returned ] : arguments );
+								}
+							});
+						});
+						fns = null;
+					}).promise();
+				},
+				// Get a promise for this deferred
+				// If obj is provided, the promise aspect is added to the object
+				promise: function( obj ) {
+					return obj != null ? jQuery.extend( obj, promise ) : promise;
+				}
+			},
+			deferred = {};
+
+		// Keep pipe for back-compat
+		promise.pipe = promise.then;
+
+		// Add list-specific methods
+		jQuery.each( tuples, function( i, tuple ) {
+			var list = tuple[ 2 ],
+				stateString = tuple[ 3 ];
+
+			// promise[ done | fail | progress ] = list.add
+			promise[ tuple[1] ] = list.add;
+
+			// Handle state
+			if ( stateString ) {
+				list.add(function() {
+					// state = [ resolved | rejected ]
+					state = stateString;
+
+				// [ reject_list | resolve_list ].disable; progress_list.lock
+				}, tuples[ i ^ 1 ][ 2 ].disable, tuples[ 2 ][ 2 ].lock );
+			}
+
+			// deferred[ resolve | reject | notify ]
+			deferred[ tuple[0] ] = function() {
+				deferred[ tuple[0] + "With" ]( this === deferred ? promise : this, arguments );
+				return this;
+			};
+			deferred[ tuple[0] + "With" ] = list.fireWith;
+		});
+
+		// Make the deferred a promise
+		promise.promise( deferred );
+
+		// Call given func if any
+		if ( func ) {
+			func.call( deferred, deferred );
+		}
+
+		// All done!
+		return deferred;
+	},
+
+	// Deferred helper
+	when: function( subordinate /* , ..., subordinateN */ ) {
+		var i = 0,
+			resolveValues = core_slice.call( arguments ),
+			length = resolveValues.length,
+
+			// the count of uncompleted subordinates
+			remaining = length !== 1 || ( subordinate && jQuery.isFunction( subordinate.promise ) ) ? length : 0,
+
+			// the master Deferred. If resolveValues consist of only a single Deferred, just use that.
+			deferred = remaining === 1 ? subordinate : jQuery.Deferred(),
+
+			// Update function for both resolve and progress values
+			updateFunc = function( i, contexts, values ) {
+				return function( value ) {
+					contexts[ i ] = this;
+					values[ i ] = arguments.length > 1 ? core_slice.call( arguments ) : value;
+					if( values === progressValues ) {
+						deferred.notifyWith( contexts, values );
+					} else if ( !( --remaining ) ) {
+						deferred.resolveWith( contexts, values );
+					}
+				};
+			},
+
+			progressValues, progressContexts, resolveContexts;
+
+		// add listeners to Deferred subordinates; treat others as resolved
+		if ( length > 1 ) {
+			progressValues = new Array( length );
+			progressContexts = new Array( length );
+			resolveContexts = new Array( length );
+			for ( ; i < length; i++ ) {
+				if ( resolveValues[ i ] && jQuery.isFunction( resolveValues[ i ].promise ) ) {
+					resolveValues[ i ].promise()
+						.done( updateFunc( i, resolveContexts, resolveValues ) )
+						.fail( deferred.reject )
+						.progress( updateFunc( i, progressContexts, progressValues ) );
+				} else {
+					--remaining;
+				}
+			}
+		}
+
+		// if we're not waiting on anything, resolve the master
+		if ( !remaining ) {
+			deferred.resolveWith( resolveContexts, resolveValues );
+		}
+
+		return deferred.promise();
+	}
+});
+jQuery.support = (function( support ) {
+	var input = document.createElement("input"),
+		fragment = document.createDocumentFragment(),
+		div = document.createElement("div"),
+		select = document.createElement("select"),
+		opt = select.appendChild( document.createElement("option") );
+
+	// Finish early in limited environments
+	if ( !input.type ) {
+		return support;
+	}
+
+	input.type = "checkbox";
+
+	// Support: Safari 5.1, iOS 5.1, Android 4.x, Android 2.3
+	// Check the default checkbox/radio value ("" on old WebKit; "on" elsewhere)
+	support.checkOn = input.value !== "";
+
+	// Must access the parent to make an option select properly
+	// Support: IE9, IE10
+	support.optSelected = opt.selected;
+
+	// Will be defined later
+	support.reliableMarginRight = true;
+	support.boxSizingReliable = true;
+	support.pixelPosition = false;
+
+	// Make sure checked status is properly cloned
+	// Support: IE9, IE10
+	input.checked = true;
+	support.noCloneChecked = input.cloneNode( true ).checked;
+
+	// Make sure that the options inside disabled selects aren't marked as disabled
+	// (WebKit marks them as disabled)
+	select.disabled = true;
+	support.optDisabled = !opt.disabled;
+
+	// Check if an input maintains its value after becoming a radio
+	// Support: IE9, IE10
+	input = document.createElement("input");
+	input.value = "t";
+	input.type = "radio";
+	support.radioValue = input.value === "t";
+
+	// #11217 - WebKit loses check when the name is after the checked attribute
+	input.setAttribute( "checked", "t" );
+	input.setAttribute( "name", "t" );
+
+	fragment.appendChild( input );
+
+	// Support: Safari 5.1, Android 4.x, Android 2.3
+	// old WebKit doesn't clone checked state correctly in fragments
+	support.checkClone = fragment.cloneNode( true ).cloneNode( true ).lastChild.checked;
+
+	// Support: Firefox, Chrome, Safari
+	// Beware of CSP restrictions (https://developer.mozilla.org/en/Security/CSP)
+	support.focusinBubbles = "onfocusin" in window;
+
+	div.style.backgroundClip = "content-box";
+	div.cloneNode( true ).style.backgroundClip = "";
+	support.clearCloneStyle = div.style.backgroundClip === "content-box";
+
+	// Run tests that need a body at doc ready
+	jQuery(function() {
+		var container, marginDiv,
+			// Support: Firefox, Android 2.3 (Prefixed box-sizing versions).
+			divReset = "padding:0;margin:0;border:0;display:block;-webkit-box-sizing:content-box;-moz-box-sizing:content-box;box-sizing:content-box",
+			body = document.getElementsByTagName("body")[ 0 ];
+
+		if ( !body ) {
+			// Return for frameset docs that don't have a body
+			return;
+		}
+
+		container = document.createElement("div");
+		container.style.cssText = "border:0;width:0;height:0;position:absolute;top:0;left:-9999px;margin-top:1px";
+
+		// Check box-sizing and margin behavior.
+		body.appendChild( container ).appendChild( div );
+		div.innerHTML = "";
+		// Support: Firefox, Android 2.3 (Prefixed box-sizing versions).
+		div.style.cssText = "-webkit-box-sizing:border-box;-moz-box-sizing:border-box;box-sizing:border-box;padding:1px;border:1px;display:block;width:4px;margin-top:1%;position:absolute;top:1%";
+
+		// Workaround failing boxSizing test due to offsetWidth returning wrong value
+		// with some non-1 values of body zoom, ticket #13543
+		jQuery.swap( body, body.style.zoom != null ? { zoom: 1 } : {}, function() {
+			support.boxSizing = div.offsetWidth === 4;
+		});
+
+		// Use window.getComputedStyle because jsdom on node.js will break without it.
+		if ( window.getComputedStyle ) {
+			support.pixelPosition = ( window.getComputedStyle( div, null ) || {} ).top !== "1%";
+			support.boxSizingReliable = ( window.getComputedStyle( div, null ) || { width: "4px" } ).width === "4px";
+
+			// Support: Android 2.3
+			// Check if div with explicit width and no margin-right incorrectly
+			// gets computed margin-right based on width of container. (#3333)
+			// WebKit Bug 13343 - getComputedStyle returns wrong value for margin-right
+			marginDiv = div.appendChild( document.createElement("div") );
+			marginDiv.style.cssText = div.style.cssText = divReset;
+			marginDiv.style.marginRight = marginDiv.style.width = "0";
+			div.style.width = "1px";
+
+			support.reliableMarginRight =
+				!parseFloat( ( window.getComputedStyle( marginDiv, null ) || {} ).marginRight );
+		}
+
+		body.removeChild( container );
+	});
+
+	return support;
+})( {} );
+
+/*
+	Implementation Summary
+
+	1. Enforce API surface and semantic compatibility with 1.9.x branch
+	2. Improve the module's maintainability by reducing the storage
+		paths to a single mechanism.
+	3. Use the same single mechanism to support "private" and "user" data.
+	4. _Never_ expose "private" data to user code (TODO: Drop _data, _removeData)
+	5. Avoid exposing implementation details on user objects (eg. expando properties)
+	6. Provide a clear path for implementation upgrade to WeakMap in 2014
+*/
+var data_user, data_priv,
+	rbrace = /(?:\{[\s\S]*\}|\[[\s\S]*\])$/,
+	rmultiDash = /([A-Z])/g;
+
+function Data() {
+	// Support: Android < 4,
+	// Old WebKit does not have Object.preventExtensions/freeze method,
+	// return new empty object instead with no [[set]] accessor
+	Object.defineProperty( this.cache = {}, 0, {
+		get: function() {
+			return {};
+		}
+	});
+
+	this.expando = jQuery.expando + Math.random();
+}
+
+Data.uid = 1;
+
+Data.accepts = function( owner ) {
+	// Accepts only:
+	//  - Node
+	//    - Node.ELEMENT_NODE
+	//    - Node.DOCUMENT_NODE
+	//  - Object
+	//    - Any
+	return owner.nodeType ?
+		owner.nodeType === 1 || owner.nodeType === 9 : true;
+};
+
+Data.prototype = {
+	key: function( owner ) {
+		// We can accept data for non-element nodes in modern browsers,
+		// but we should not, see #8335.
+		// Always return the key for a frozen object.
+		if ( !Data.accepts( owner ) ) {
+			return 0;
+		}
+
+		var descriptor = {},
+			// Check if the owner object already has a cache key
+			unlock = owner[ this.expando ];
+
+		// If not, create one
+		if ( !unlock ) {
+			unlock = Data.uid++;
+
+			// Secure it in a non-enumerable, non-writable property
+			try {
+				descriptor[ this.expando ] = { value: unlock };
+				Object.defineProperties( owner, descriptor );
+
+			// Support: Android < 4
+			// Fallback to a less secure definition
+			} catch ( e ) {
+				descriptor[ this.expando ] = unlock;
+				jQuery.extend( owner, descriptor );
+			}
+		}
+
+		// Ensure the cache object
+		if ( !this.cache[ unlock ] ) {
+			this.cache[ unlock ] = {};
+		}
+
+		return unlock;
+	},
+	set: function( owner, data, value ) {
+		var prop,
+			// There may be an unlock assigned to this node,
+			// if there is no entry for this "owner", create one inline
+			// and set the unlock as though an owner entry had always existed
+			unlock = this.key( owner ),
+			cache = this.cache[ unlock ];
+
+		// Handle: [ owner, key, value ] args
+		if ( typeof data === "string" ) {
+			cache[ data ] = value;
+
+		// Handle: [ owner, { properties } ] args
+		} else {
+			// Fresh assignments by object are shallow copied
+			if ( jQuery.isEmptyObject( cache ) ) {
+				jQuery.extend( this.cache[ unlock ], data );
+			// Otherwise, copy the properties one-by-one to the cache object
+			} else {
+				for ( prop in data ) {
+					cache[ prop ] = data[ prop ];
+				}
+			}
+		}
+		return cache;
+	},
+	get: function( owner, key ) {
+		// Either a valid cache is found, or will be created.
+		// New caches will be created and the unlock returned,
+		// allowing direct access to the newly created
+		// empty data object. A valid owner object must be provided.
+		var cache = this.cache[ this.key( owner ) ];
+
+		return key === undefined ?
+			cache : cache[ key ];
+	},
+	access: function( owner, key, value ) {
+		var stored;
+		// In cases where either:
+		//
+		//   1. No key was specified
+		//   2. A string key was specified, but no value provided
+		//
+		// Take the "read" path and allow the get method to determine
+		// which value to return, respectively either:
+		//
+		//   1. The entire cache object
+		//   2. The data stored at the key
+		//
+		if ( key === undefined ||
+				((key && typeof key === "string") && value === undefined) ) {
+
+			stored = this.get( owner, key );
+
+			return stored !== undefined ?
+				stored : this.get( owner, jQuery.camelCase(key) );
+		}
+
+		// [*]When the key is not a string, or both a key and value
+		// are specified, set or extend (existing objects) with either:
+		//
+		//   1. An object of properties
+		//   2. A key and value
+		//
+		this.set( owner, key, value );
+
+		// Since the "set" path can have two possible entry points
+		// return the expected data based on which path was taken[*]
+		return value !== undefined ? value : key;
+	},
+	remove: function( owner, key ) {
+		var i, name, camel,
+			unlock = this.key( owner ),
+			cache = this.cache[ unlock ];
+
+		if ( key === undefined ) {
+			this.cache[ unlock ] = {};
+
+		} else {
+			// Support array or space separated string of keys
+			if ( jQuery.isArray( key ) ) {
+				// If "name" is an array of keys...
+				// When data is initially created, via ("key", "val") signature,
+				// keys will be converted to camelCase.
+				// Since there is no way to tell _how_ a key was added, remove
+				// both plain key and camelCase key. #12786
+				// This will only penalize the array argument path.
+				name = key.concat( key.map( jQuery.camelCase ) );
+			} else {
+				camel = jQuery.camelCase( key );
+				// Try the string as a key before any manipulation
+				if ( key in cache ) {
+					name = [ key, camel ];
+				} else {
+					// If a key with the spaces exists, use it.
+					// Otherwise, create an array by matching non-whitespace
+					name = camel;
+					name = name in cache ?
+						[ name ] : ( name.match( core_rnotwhite ) || [] );
+				}
+			}
+
+			i = name.length;
+			while ( i-- ) {
+				delete cache[ name[ i ] ];
+			}
+		}
+	},
+	hasData: function( owner ) {
+		return !jQuery.isEmptyObject(
+			this.cache[ owner[ this.expando ] ] || {}
+		);
+	},
+	discard: function( owner ) {
+		if ( owner[ this.expando ] ) {
+			delete this.cache[ owner[ this.expando ] ];
+		}
+	}
+};
+
+// These may be used throughout the jQuery core codebase
+data_user = new Data();
+data_priv = new Data();
+
+
+jQuery.extend({
+	acceptData: Data.accepts,
+
+	hasData: function( elem ) {
+		return data_user.hasData( elem ) || data_priv.hasData( elem );
+	},
+
+	data: function( elem, name, data ) {
+		return data_user.access( elem, name, data );
+	},
+
+	removeData: function( elem, name ) {
+		data_user.remove( elem, name );
+	},
+
+	// TODO: Now that all calls to _data and _removeData have been replaced
+	// with direct calls to data_priv methods, these can be deprecated.
+	_data: function( elem, name, data ) {
+		return data_priv.access( elem, name, data );
+	},
+
+	_removeData: function( elem, name ) {
+		data_priv.remove( elem, name );
+	}
+});
+
+jQuery.fn.extend({
+	data: function( key, value ) {
+		var attrs, name,
+			elem = this[ 0 ],
+			i = 0,
+			data = null;
+
+		// Gets all values
+		if ( key === undefined ) {
+			if ( this.length ) {
+				data = data_user.get( elem );
+
+				if ( elem.nodeType === 1 && !data_priv.get( elem, "hasDataAttrs" ) ) {
+					attrs = elem.attributes;
+					for ( ; i < attrs.length; i++ ) {
+						name = attrs[ i ].name;
+
+						if ( name.indexOf( "data-" ) === 0 ) {
+							name = jQuery.camelCase( name.slice(5) );
+							dataAttr( elem, name, data[ name ] );
+						}
+					}
+					data_priv.set( elem, "hasDataAttrs", true );
+				}
+			}
+
+			return data;
+		}
+
+		// Sets multiple values
+		if ( typeof key === "object" ) {
+			return this.each(function() {
+				data_user.set( this, key );
+			});
+		}
+
+		return jQuery.access( this, function( value ) {
+			var data,
+				camelKey = jQuery.camelCase( key );
+
+			// The calling jQuery object (element matches) is not empty
+			// (and therefore has an element appears at this[ 0 ]) and the
+			// `value` parameter was not undefined. An empty jQuery object
+			// will result in `undefined` for elem = this[ 0 ] which will
+			// throw an exception if an attempt to read a data cache is made.
+			if ( elem && value === undefined ) {
+				// Attempt to get data from the cache
+				// with the key as-is
+				data = data_user.get( elem, key );
+				if ( data !== undefined ) {
+					return data;
+				}
+
+				// Attempt to get data from the cache
+				// with the key camelized
+				data = data_user.get( elem, camelKey );
+				if ( data !== undefined ) {
+					return data;
+				}
+
+				// Attempt to "discover" the data in
+				// HTML5 custom data-* attrs
+				data = dataAttr( elem, camelKey, undefined );
+				if ( data !== undefined ) {
+					return data;
+				}
+
+				// We tried really hard, but the data doesn't exist.
+				return;
+			}
+
+			// Set the data...
+			this.each(function() {
+				// First, attempt to store a copy or reference of any
+				// data that might've been store with a camelCased key.
+				var data = data_user.get( this, camelKey );
+
+				// For HTML5 data-* attribute interop, we have to
+				// store property names with dashes in a camelCase form.
+				// This might not apply to all properties...*
+				data_user.set( this, camelKey, value );
+
+				// *... In the case of properties that might _actually_
+				// have dashes, we need to also store a copy of that
+				// unchanged property.
+				if ( key.indexOf("-") !== -1 && data !== undefined ) {
+					data_user.set( this, key, value );
+				}
+			});
+		}, null, value, arguments.length > 1, null, true );
+	},
+
+	removeData: function( key ) {
+		return this.each(function() {
+			data_user.remove( this, key );
+		});
+	}
+});
+
+function dataAttr( elem, key, data ) {
+	var name;
+
+	// If nothing was found internally, try to fetch any
+	// data from the HTML5 data-* attribute
+	if ( data === undefined && elem.nodeType === 1 ) {
+		name = "data-" + key.replace( rmultiDash, "-$1" ).toLowerCase();
+		data = elem.getAttribute( name );
+
+		if ( typeof data === "string" ) {
+			try {
+				data = data === "true" ? true :
+					data === "false" ? false :
+					data === "null" ? null :
+					// Only convert to a number if it doesn't change the string
+					+data + "" === data ? +data :
+					rbrace.test( data ) ? JSON.parse( data ) :
+					data;
+			} catch( e ) {}
+
+			// Make sure we set the data so it isn't changed later
+			data_user.set( elem, key, data );
+		} else {
+			data = undefined;
+		}
+	}
+	return data;
+}
+jQuery.extend({
+	queue: function( elem, type, data ) {
+		var queue;
+
+		if ( elem ) {
+			type = ( type || "fx" ) + "queue";
+			queue = data_priv.get( elem, type );
+
+			// Speed up dequeue by getting out quickly if this is just a lookup
+			if ( data ) {
+				if ( !queue || jQuery.isArray( data ) ) {
+					queue = data_priv.access( elem, type, jQuery.makeArray(data) );
+				} else {
+					queue.push( data );
+				}
+			}
+			return queue || [];
+		}
+	},
+
+	dequeue: function( elem, type ) {
+		type = type || "fx";
+
+		var queue = jQuery.queue( elem, type ),
+			startLength = queue.length,
+			fn = queue.shift(),
+			hooks = jQuery._queueHooks( elem, type ),
+			next = function() {
+				jQuery.dequeue( elem, type );
+			};
+
+		// If the fx queue is dequeued, always remove the progress sentinel
+		if ( fn === "inprogress" ) {
+			fn = queue.shift();
+			startLength--;
+		}
+
+		if ( fn ) {
+
+			// Add a progress sentinel to prevent the fx queue from being
+			// automatically dequeued
+			if ( type === "fx" ) {
+				queue.unshift( "inprogress" );
+			}
+
+			// clear up the last queue stop function
+			delete hooks.stop;
+			fn.call( elem, next, hooks );
+		}
+
+		if ( !startLength && hooks ) {
+			hooks.empty.fire();
+		}
+	},
+
+	// not intended for public consumption - generates a queueHooks object, or returns the current one
+	_queueHooks: function( elem, type ) {
+		var key = type + "queueHooks";
+		return data_priv.get( elem, key ) || data_priv.access( elem, key, {
+			empty: jQuery.Callbacks("once memory").add(function() {
+				data_priv.remove( elem, [ type + "queue", key ] );
+			})
+		});
+	}
+});
+
+jQuery.fn.extend({
+	queue: function( type, data ) {
+		var setter = 2;
+
+		if ( typeof type !== "string" ) {
+			data = type;
+			type = "fx";
+			setter--;
+		}
+
+		if ( arguments.length < setter ) {
+			return jQuery.queue( this[0], type );
+		}
+
+		return data === undefined ?
+			this :
+			this.each(function() {
+				var queue = jQuery.queue( this, type, data );
+
+				// ensure a hooks for this queue
+				jQuery._queueHooks( this, type );
+
+				if ( type === "fx" && queue[0] !== "inprogress" ) {
+					jQuery.dequeue( this, type );
+				}
+			});
+	},
+	dequeue: function( type ) {
+		return this.each(function() {
+			jQuery.dequeue( this, type );
+		});
+	},
+	// Based off of the plugin by Clint Helfers, with permission.
+	// http://blindsignals.com/index.php/2009/07/jquery-delay/
+	delay: function( time, type ) {
+		time = jQuery.fx ? jQuery.fx.speeds[ time ] || time : time;
+		type = type || "fx";
+
+		return this.queue( type, function( next, hooks ) {
+			var timeout = setTimeout( next, time );
+			hooks.stop = function() {
+				clearTimeout( timeout );
+			};
+		});
+	},
+	clearQueue: function( type ) {
+		return this.queue( type || "fx", [] );
+	},
+	// Get a promise resolved when queues of a certain type
+	// are emptied (fx is the type by default)
+	promise: function( type, obj ) {
+		var tmp,
+			count = 1,
+			defer = jQuery.Deferred(),
+			elements = this,
+			i = this.length,
+			resolve = function() {
+				if ( !( --count ) ) {
+					defer.resolveWith( elements, [ elements ] );
+				}
+			};
+
+		if ( typeof type !== "string" ) {
+			obj = type;
+			type = undefined;
+		}
+		type = type || "fx";
+
+		while( i-- ) {
+			tmp = data_priv.get( elements[ i ], type + "queueHooks" );
+			if ( tmp && tmp.empty ) {
+				count++;
+				tmp.empty.add( resolve );
+			}
+		}
+		resolve();
+		return defer.promise( obj );
+	}
+});
+var nodeHook, boolHook,
+	rclass = /[\t\r\n\f]/g,
+	rreturn = /\r/g,
+	rfocusable = /^(?:input|select|textarea|button)$/i;
+
+jQuery.fn.extend({
+	attr: function( name, value ) {
+		return jQuery.access( this, jQuery.attr, name, value, arguments.length > 1 );
+	},
+
+	removeAttr: function( name ) {
+		return this.each(function() {
+			jQuery.removeAttr( this, name );
+		});
+	},
+
+	prop: function( name, value ) {
+		return jQuery.access( this, jQuery.prop, name, value, arguments.length > 1 );
+	},
+
+	removeProp: function( name ) {
+		return this.each(function() {
+			delete this[ jQuery.propFix[ name ] || name ];
+		});
+	},
+
+	addClass: function( value ) {
+		var classes, elem, cur, clazz, j,
+			i = 0,
+			len = this.length,
+			proceed = typeof value === "string" && value;
+
+		if ( jQuery.isFunction( value ) ) {
+			return this.each(function( j ) {
+				jQuery( this ).addClass( value.call( this, j, this.className ) );
+			});
+		}
+
+		if ( proceed ) {
+			// The disjunction here is for better compressibility (see removeClass)
+			classes = ( value || "" ).match( core_rnotwhite ) || [];
+
+			for ( ; i < len; i++ ) {
+				elem = this[ i ];
+				cur = elem.nodeType === 1 && ( elem.className ?
+					( " " + elem.className + " " ).replace( rclass, " " ) :
+					" "
+				);
+
+				if ( cur ) {
+					j = 0;
+					while ( (clazz = classes[j++]) ) {
+						if ( cur.indexOf( " " + clazz + " " ) < 0 ) {
+							cur += clazz + " ";
+						}
+					}
+					elem.className = jQuery.trim( cur );
+
+				}
+			}
+		}
+
+		return this;
+	},
+
+	removeClass: function( value ) {
+		var classes, elem, cur, clazz, j,
+			i = 0,
+			len = this.length,
+			proceed = arguments.length === 0 || typeof value === "string" && value;
+
+		if ( jQuery.isFunction( value ) ) {
+			return this.each(function( j ) {
+				jQuery( this ).removeClass( value.call( this, j, this.className ) );
+			});
+		}
+		if ( proceed ) {
+			classes = ( value || "" ).match( core_rnotwhite ) || [];
+
+			for ( ; i < len; i++ ) {
+				elem = this[ i ];
+				// This expression is here for better compressibility (see addClass)
+				cur = elem.nodeType === 1 && ( elem.className ?
+					( " " + elem.className + " " ).replace( rclass, " " ) :
+					""
+				);
+
+				if ( cur ) {
+					j = 0;
+					while ( (clazz = classes[j++]) ) {
+						// Remove *all* instances
+						while ( cur.indexOf( " " + clazz + " " ) >= 0 ) {
+							cur = cur.replace( " " + clazz + " ", " " );
+						}
+					}
+					elem.className = value ? jQuery.trim( cur ) : "";
+				}
+			}
+		}
+
+		return this;
+	},
+
+	toggleClass: function( value, stateVal ) {
+		var type = typeof value;
+
+		if ( typeof stateVal === "boolean" && type === "string" ) {
+			return stateVal ? this.addClass( value ) : this.removeClass( value );
+		}
+
+		if ( jQuery.isFunction( value ) ) {
+			return this.each(function( i ) {
+				jQuery( this ).toggleClass( value.call(this, i, this.className, stateVal), stateVal );
+			});
+		}
+
+		return this.each(function() {
+			if ( type === "string" ) {
+				// toggle individual class names
+				var className,
+					i = 0,
+					self = jQuery( this ),
+					classNames = value.match( core_rnotwhite ) || [];
+
+				while ( (className = classNames[ i++ ]) ) {
+					// check each className given, space separated list
+					if ( self.hasClass( className ) ) {
+						self.removeClass( className );
+					} else {
+						self.addClass( className );
+					}
+				}
+
+			// Toggle whole class name
+			} else if ( type === core_strundefined || type === "boolean" ) {
+				if ( this.className ) {
+					// store className if set
+					data_priv.set( this, "__className__", this.className );
+				}
+
+				// If the element has a class name or if we're passed "false",
+				// then remove the whole classname (if there was one, the above saved it).
+				// Otherwise bring back whatever was previously saved (if anything),
+				// falling back to the empty string if nothing was stored.
+				this.className = this.className || value === false ? "" : data_priv.get( this, "__className__" ) || "";
+			}
+		});
+	},
+
+	hasClass: function( selector ) {
+		var className = " " + selector + " ",
+			i = 0,
+			l = this.length;
+		for ( ; i < l; i++ ) {
+			if ( this[i].nodeType === 1 && (" " + this[i].className + " ").replace(rclass, " ").indexOf( className ) >= 0 ) {
+				return true;
+			}
+		}
+
+		return false;
+	},
+
+	val: function( value ) {
+		var hooks, ret, isFunction,
+			elem = this[0];
+
+		if ( !arguments.length ) {
+			if ( elem ) {
+				hooks = jQuery.valHooks[ elem.type ] || jQuery.valHooks[ elem.nodeName.toLowerCase() ];
+
+				if ( hooks && "get" in hooks && (ret = hooks.get( elem, "value" )) !== undefined ) {
+					return ret;
+				}
+
+				ret = elem.value;
+
+				return typeof ret === "string" ?
+					// handle most common string cases
+					ret.replace(rreturn, "") :
+					// handle cases where value is null/undef or number
+					ret == null ? "" : ret;
+			}
+
+			return;
+		}
+
+		isFunction = jQuery.isFunction( value );
+
+		return this.each(function( i ) {
+			var val;
+
+			if ( this.nodeType !== 1 ) {
+				return;
+			}
+
+			if ( isFunction ) {
+				val = value.call( this, i, jQuery( this ).val() );
+			} else {
+				val = value;
+			}
+
+			// Treat null/undefined as ""; convert numbers to string
+			if ( val == null ) {
+				val = "";
+			} else if ( typeof val === "number" ) {
+				val += "";
+			} else if ( jQuery.isArray( val ) ) {
+				val = jQuery.map(val, function ( value ) {
+					return value == null ? "" : value + "";
+				});
+			}
+
+			hooks = jQuery.valHooks[ this.type ] || jQuery.valHooks[ this.nodeName.toLowerCase() ];
+
+			// If set returns undefined, fall back to normal setting
+			if ( !hooks || !("set" in hooks) || hooks.set( this, val, "value" ) === undefined ) {
+				this.value = val;
+			}
+		});
+	}
+});
+
+jQuery.extend({
+	valHooks: {
+		option: {
+			get: function( elem ) {
+				// attributes.value is undefined in Blackberry 4.7 but
+				// uses .value. See #6932
+				var val = elem.attributes.value;
+				return !val || val.specified ? elem.value : elem.text;
+			}
+		},
+		select: {
+			get: function( elem ) {
+				var value, option,
+					options = elem.options,
+					index = elem.selectedIndex,
+					one = elem.type === "select-one" || index < 0,
+					values = one ? null : [],
+					max = one ? index + 1 : options.length,
+					i = index < 0 ?
+						max :
+						one ? index : 0;
+
+				// Loop through all the selected options
+				for ( ; i < max; i++ ) {
+					option = options[ i ];
+
+					// IE6-9 doesn't update selected after form reset (#2551)
+					if ( ( option.selected || i === index ) &&
+							// Don't return options that are disabled or in a disabled optgroup
+							( jQuery.support.optDisabled ? !option.disabled : option.getAttribute("disabled") === null ) &&
+							( !option.parentNode.disabled || !jQuery.nodeName( option.parentNode, "optgroup" ) ) ) {
+
+						// Get the specific value for the option
+						value = jQuery( option ).val();
+
+						// We don't need an array for one selects
+						if ( one ) {
+							return value;
+						}
+
+						// Multi-Selects return an array
+						values.push( value );
+					}
+				}
+
+				return values;
+			},
+
+			set: function( elem, value ) {
+				var optionSet, option,
+					options = elem.options,
+					values = jQuery.makeArray( value ),
+					i = options.length;
+
+				while ( i-- ) {
+					option = options[ i ];
+					if ( (option.selected = jQuery.inArray( jQuery(option).val(), values ) >= 0) ) {
+						optionSet = true;
+					}
+				}
+
+				// force browsers to behave consistently when non-matching value is set
+				if ( !optionSet ) {
+					elem.selectedIndex = -1;
+				}
+				return values;
+			}
+		}
+	},
+
+	attr: function( elem, name, value ) {
+		var hooks, ret,
+			nType = elem.nodeType;
+
+		// don't get/set attributes on text, comment and attribute nodes
+		if ( !elem || nType === 3 || nType === 8 || nType === 2 ) {
+			return;
+		}
+
+		// Fallback to prop when attributes are not supported
+		if ( typeof elem.getAttribute === core_strundefined ) {
+			return jQuery.prop( elem, name, value );
+		}
+
+		// All attributes are lowercase
+		// Grab necessary hook if one is defined
+		if ( nType !== 1 || !jQuery.isXMLDoc( elem ) ) {
+			name = name.toLowerCase();
+			hooks = jQuery.attrHooks[ name ] ||
+				( jQuery.expr.match.bool.test( name ) ? boolHook : nodeHook );
+		}
+
+		if ( value !== undefined ) {
+
+			if ( value === null ) {
+				jQuery.removeAttr( elem, name );
+
+			} else if ( hooks && "set" in hooks && (ret = hooks.set( elem, value, name )) !== undefined ) {
+				return ret;
+
+			} else {
+				elem.setAttribute( name, value + "" );
+				return value;
+			}
+
+		} else if ( hooks && "get" in hooks && (ret = hooks.get( elem, name )) !== null ) {
+			return ret;
+
+		} else {
+			ret = jQuery.find.attr( elem, name );
+
+			// Non-existent attributes return null, we normalize to undefined
+			return ret == null ?
+				undefined :
+				ret;
+		}
+	},
+
+	removeAttr: function( elem, value ) {
+		var name, propName,
+			i = 0,
+			attrNames = value && value.match( core_rnotwhite );
+
+		if ( attrNames && elem.nodeType === 1 ) {
+			while ( (name = attrNames[i++]) ) {
+				propName = jQuery.propFix[ name ] || name;
+
+				// Boolean attributes get special treatment (#10870)
+				if ( jQuery.expr.match.bool.test( name ) ) {
+					// Set corresponding property to false
+					elem[ propName ] = false;
+				}
+
+				elem.removeAttribute( name );
+			}
+		}
+	},
+
+	attrHooks: {
+		type: {
+			set: function( elem, value ) {
+				if ( !jQuery.support.radioValue && value === "radio" && jQuery.nodeName(elem, "input") ) {
+					// Setting the type on a radio button after the value resets the value in IE6-9
+					// Reset value to default in case type is set after value during creation
+					var val = elem.value;
+					elem.setAttribute( "type", value );
+					if ( val ) {
+						elem.value = val;
+					}
+					return value;
+				}
+			}
+		}
+	},
+
+	propFix: {
+		"for": "htmlFor",
+		"class": "className"
+	},
+
+	prop: function( elem, name, value ) {
+		var ret, hooks, notxml,
+			nType = elem.nodeType;
+
+		// don't get/set properties on text, comment and attribute nodes
+		if ( !elem || nType === 3 || nType === 8 || nType === 2 ) {
+			return;
+		}
+
+		notxml = nType !== 1 || !jQuery.isXMLDoc( elem );
+
+		if ( notxml ) {
+			// Fix name and attach hooks
+			name = jQuery.propFix[ name ] || name;
+			hooks = jQuery.propHooks[ name ];
+		}
+
+		if ( value !== undefined ) {
+			return hooks && "set" in hooks && (ret = hooks.set( elem, value, name )) !== undefined ?
+				ret :
+				( elem[ name ] = value );
+
+		} else {
+			return hooks && "get" in hooks && (ret = hooks.get( elem, name )) !== null ?
+				ret :
+				elem[ name ];
+		}
+	},
+
+	propHooks: {
+		tabIndex: {
+			get: function( elem ) {
+				return elem.hasAttribute( "tabindex" ) || rfocusable.test( elem.nodeName ) || elem.href ?
+					elem.tabIndex :
+					-1;
+			}
+		}
+	}
+});
+
+// Hooks for boolean attributes
+boolHook = {
+	set: function( elem, value, name ) {
+		if ( value === false ) {
+			// Remove boolean attributes when set to false
+			jQuery.removeAttr( elem, name );
+		} else {
+			elem.setAttribute( name, name );
+		}
+		return name;
+	}
+};
+jQuery.each( jQuery.expr.match.bool.source.match( /\w+/g ), function( i, name ) {
+	var getter = jQuery.expr.attrHandle[ name ] || jQuery.find.attr;
+
+	jQuery.expr.attrHandle[ name ] = function( elem, name, isXML ) {
+		var fn = jQuery.expr.attrHandle[ name ],
+			ret = isXML ?
+				undefined :
+				/* jshint eqeqeq: false */
+				// Temporarily disable this handler to check existence
+				(jQuery.expr.attrHandle[ name ] = undefined) !=
+					getter( elem, name, isXML ) ?
+
+					name.toLowerCase() :
+					null;
+
+		// Restore handler
+		jQuery.expr.attrHandle[ name ] = fn;
+
+		return ret;
+	};
+});
+
+// Support: IE9+
+// Selectedness for an option in an optgroup can be inaccurate
+if ( !jQuery.support.optSelected ) {
+	jQuery.propHooks.selected = {
+		get: function( elem ) {
+			var parent = elem.parentNode;
+			if ( parent && parent.parentNode ) {
+				parent.parentNode.selectedIndex;
+			}
+			return null;
+		}
+	};
+}
+
+jQuery.each([
+	"tabIndex",
+	"readOnly",
+	"maxLength",
+	"cellSpacing",
+	"cellPadding",
+	"rowSpan",
+	"colSpan",
+	"useMap",
+	"frameBorder",
+	"contentEditable"
+], function() {
+	jQuery.propFix[ this.toLowerCase() ] = this;
+});
+
+// Radios and checkboxes getter/setter
+jQuery.each([ "radio", "checkbox" ], function() {
+	jQuery.valHooks[ this ] = {
+		set: function( elem, value ) {
+			if ( jQuery.isArray( value ) ) {
+				return ( elem.checked = jQuery.inArray( jQuery(elem).val(), value ) >= 0 );
+			}
+		}
+	};
+	if ( !jQuery.support.checkOn ) {
+		jQuery.valHooks[ this ].get = function( elem ) {
+			// Support: Webkit
+			// "" is returned instead of "on" if a value isn't specified
+			return elem.getAttribute("value") === null ? "on" : elem.value;
+		};
+	}
+});
+var rkeyEvent = /^key/,
+	rmouseEvent = /^(?:mouse|contextmenu)|click/,
+	rfocusMorph = /^(?:focusinfocus|focusoutblur)$/,
+	rtypenamespace = /^([^.]*)(?:\.(.+)|)$/;
+
+function returnTrue() {
+	return true;
+}
+
+function returnFalse() {
+	return false;
+}
+
+function safeActiveElement() {
+	try {
+		return document.activeElement;
+	} catch ( err ) { }
+}
+
+/*
+ * Helper functions for managing events -- not part of the public interface.
+ * Props to Dean Edwards' addEvent library for many of the ideas.
+ */
+jQuery.event = {
+
+	global: {},
+
+	add: function( elem, types, handler, data, selector ) {
+
+		var handleObjIn, eventHandle, tmp,
+			events, t, handleObj,
+			special, handlers, type, namespaces, origType,
+			elemData = data_priv.get( elem );
+
+		// Don't attach events to noData or text/comment nodes (but allow plain objects)
+		if ( !elemData ) {
+			return;
+		}
+
+		// Caller can pass in an object of custom data in lieu of the handler
+		if ( handler.handler ) {
+			handleObjIn = handler;
+			handler = handleObjIn.handler;
+			selector = handleObjIn.selector;
+		}
+
+		// Make sure that the handler has a unique ID, used to find/remove it later
+		if ( !handler.guid ) {
+			handler.guid = jQuery.guid++;
+		}
+
+		// Init the element's event structure and main handler, if this is the first
+		if ( !(events = elemData.events) ) {
+			events = elemData.events = {};
+		}
+		if ( !(eventHandle = elemData.handle) ) {
+			eventHandle = elemData.handle = function( e ) {
+				// Discard the second event of a jQuery.event.trigger() and
+				// when an event is called after a page has unloaded
+				return typeof jQuery !== core_strundefined && (!e || jQuery.event.triggered !== e.type) ?
+					jQuery.event.dispatch.apply( eventHandle.elem, arguments ) :
+					undefined;
+			};
+			// Add elem as a property of the handle fn to prevent a memory leak with IE non-native events
+			eventHandle.elem = elem;
+		}
+
+		// Handle multiple events separated by a space
+		types = ( types || "" ).match( core_rnotwhite ) || [""];
+		t = types.length;
+		while ( t-- ) {
+			tmp = rtypenamespace.exec( types[t] ) || [];
+			type = origType = tmp[1];
+			namespaces = ( tmp[2] || "" ).split( "." ).sort();
+
+			// There *must* be a type, no attaching namespace-only handlers
+			if ( !type ) {
+				continue;
+			}
+
+			// If event changes its type, use the special event handlers for the changed type
+			special = jQuery.event.special[ type ] || {};
+
+			// If selector defined, determine special event api type, otherwise given type
+			type = ( selector ? special.delegateType : special.bindType ) || type;
+
+			// Update special based on newly reset type
+			special = jQuery.event.special[ type ] || {};
+
+			// handleObj is passed to all event handlers
+			handleObj = jQuery.extend({
+				type: type,
+				origType: origType,
+				data: data,
+				handler: handler,
+				guid: handler.guid,
+				selector: selector,
+				needsContext: selector && jQuery.expr.match.needsContext.test( selector ),
+				namespace: namespaces.join(".")
+			}, handleObjIn );
+
+			// Init the event handler queue if we're the first
+			if ( !(handlers = events[ type ]) ) {
+				handlers = events[ type ] = [];
+				handlers.delegateCount = 0;
+
+				// Only use addEventListener if the special events handler returns false
+				if ( !special.setup || special.setup.call( elem, data, namespaces, eventHandle ) === false ) {
+					if ( elem.addEventListener ) {
+						elem.addEventListener( type, eventHandle, false );
+					}
+				}
+			}
+
+			if ( special.add ) {
+				special.add.call( elem, handleObj );
+
+				if ( !handleObj.handler.guid ) {
+					handleObj.handler.guid = handler.guid;
+				}
+			}
+
+			// Add to the element's handler list, delegates in front
+			if ( selector ) {
+				handlers.splice( handlers.delegateCount++, 0, handleObj );
+			} else {
+				handlers.push( handleObj );
+			}
+
+			// Keep track of which events have ever been used, for event optimization
+			jQuery.event.global[ type ] = true;
+		}
+
+		// Nullify elem to prevent memory leaks in IE
+		elem = null;
+	},
+
+	// Detach an event or set of events from an element
+	remove: function( elem, types, handler, selector, mappedTypes ) {
+
+		var j, origCount, tmp,
+			events, t, handleObj,
+			special, handlers, type, namespaces, origType,
+			elemData = data_priv.hasData( elem ) && data_priv.get( elem );
+
+		if ( !elemData || !(events = elemData.events) ) {
+			return;
+		}
+
+		// Once for each type.namespace in types; type may be omitted
+		types = ( types || "" ).match( core_rnotwhite ) || [""];
+		t = types.length;
+		while ( t-- ) {
+			tmp = rtypenamespace.exec( types[t] ) || [];
+			type = origType = tmp[1];
+			namespaces = ( tmp[2] || "" ).split( "." ).sort();
+
+			// Unbind all events (on this namespace, if provided) for the element
+			if ( !type ) {
+				for ( type in events ) {
+					jQuery.event.remove( elem, type + types[ t ], handler, selector, true );
+				}
+				continue;
+			}
+
+			special = jQuery.event.special[ type ] || {};
+			type = ( selector ? special.delegateType : special.bindType ) || type;
+			handlers = events[ type ] || [];
+			tmp = tmp[2] && new RegExp( "(^|\\.)" + namespaces.join("\\.(?:.*\\.|)") + "(\\.|$)" );
+
+			// Remove matching events
+			origCount = j = handlers.length;
+			while ( j-- ) {
+				handleObj = handlers[ j ];
+
+				if ( ( mappedTypes || origType === handleObj.origType ) &&
+					( !handler || handler.guid === handleObj.guid ) &&
+					( !tmp || tmp.test( handleObj.namespace ) ) &&
+					( !selector || selector === handleObj.selector || selector === "**" && handleObj.selector ) ) {
+					handlers.splice( j, 1 );
+
+					if ( handleObj.selector ) {
+						handlers.delegateCount--;
+					}
+					if ( special.remove ) {
+						special.remove.call( elem, handleObj );
+					}
+				}
+			}
+
+			// Remove generic event handler if we removed something and no more handlers exist
+			// (avoids potential for endless recursion during removal of special event handlers)
+			if ( origCount && !handlers.length ) {
+				if ( !special.teardown || special.teardown.call( elem, namespaces, elemData.handle ) === false ) {
+					jQuery.removeEvent( elem, type, elemData.handle );
+				}
+
+				delete events[ type ];
+			}
+		}
+
+		// Remove the expando if it's no longer used
+		if ( jQuery.isEmptyObject( events ) ) {
+			delete elemData.handle;
+			data_priv.remove( elem, "events" );
+		}
+	},
+
+	trigger: function( event, data, elem, onlyHandlers ) {
+
+		var i, cur, tmp, bubbleType, ontype, handle, special,
+			eventPath = [ elem || document ],
+			type = core_hasOwn.call( event, "type" ) ? event.type : event,
+			namespaces = core_hasOwn.call( event, "namespace" ) ? event.namespace.split(".") : [];
+
+		cur = tmp = elem = elem || document;
+
+		// Don't do events on text and comment nodes
+		if ( elem.nodeType === 3 || elem.nodeType === 8 ) {
+			return;
+		}
+
+		// focus/blur morphs to focusin/out; ensure we're not firing them right now
+		if ( rfocusMorph.test( type + jQuery.event.triggered ) ) {
+			return;
+		}
+
+		if ( type.indexOf(".") >= 0 ) {
+			// Namespaced trigger; create a regexp to match event type in handle()
+			namespaces = type.split(".");
+			type = namespaces.shift();
+			namespaces.sort();
+		}
+		ontype = type.indexOf(":") < 0 && "on" + type;
+
+		// Caller can pass in a jQuery.Event object, Object, or just an event type string
+		event = event[ jQuery.expando ] ?
+			event :
+			new jQuery.Event( type, typeof event === "object" && event );
+
+		// Trigger bitmask: & 1 for native handlers; & 2 for jQuery (always true)
+		event.isTrigger = onlyHandlers ? 2 : 3;
+		event.namespace = namespaces.join(".");
+		event.namespace_re = event.namespace ?
+			new RegExp( "(^|\\.)" + namespaces.join("\\.(?:.*\\.|)") + "(\\.|$)" ) :
+			null;
+
+		// Clean up the event in case it is being reused
+		event.result = undefined;
+		if ( !event.target ) {
+			event.target = elem;
+		}
+
+		// Clone any incoming data and prepend the event, creating the handler arg list
+		data = data == null ?
+			[ event ] :
+			jQuery.makeArray( data, [ event ] );
+
+		// Allow special events to draw outside the lines
+		special = jQuery.event.special[ type ] || {};
+		if ( !onlyHandlers && special.trigger && special.trigger.apply( elem, data ) === false ) {
+			return;
+		}
+
+		// Determine event propagation path in advance, per W3C events spec (#9951)
+		// Bubble up to document, then to window; watch for a global ownerDocument var (#9724)
+		if ( !onlyHandlers && !special.noBubble && !jQuery.isWindow( elem ) ) {
+
+			bubbleType = special.delegateType || type;
+			if ( !rfocusMorph.test( bubbleType + type ) ) {
+				cur = cur.parentNode;
+			}
+			for ( ; cur; cur = cur.parentNode ) {
+				eventPath.push( cur );
+				tmp = cur;
+			}
+
+			// Only add window if we got to document (e.g., not plain obj or detached DOM)
+			if ( tmp === (elem.ownerDocument || document) ) {
+				eventPath.push( tmp.defaultView || tmp.parentWindow || window );
+			}
+		}
+
+		// Fire handlers on the event path
+		i = 0;
+		while ( (cur = eventPath[i++]) && !event.isPropagationStopped() ) {
+
+			event.type = i > 1 ?
+				bubbleType :
+				special.bindType || type;
+
+			// jQuery handler
+			handle = ( data_priv.get( cur, "events" ) || {} )[ event.type ] && data_priv.get( cur, "handle" );
+			if ( handle ) {
+				handle.apply( cur, data );
+			}
+
+			// Native handler
+			handle = ontype && cur[ ontype ];
+			if ( handle && jQuery.acceptData( cur ) && handle.apply && handle.apply( cur, data ) === false ) {
+				event.preventDefault();
+			}
+		}
+		event.type = type;
+
+		// If nobody prevented the default action, do it now
+		if ( !onlyHandlers && !event.isDefaultPrevented() ) {
+
+			if ( (!special._default || special._default.apply( eventPath.pop(), data ) === false) &&
+				jQuery.acceptData( elem ) ) {
+
+				// Call a native DOM method on the target with the same name name as the event.
+				// Don't do default actions on window, that's where global variables be (#6170)
+				if ( ontype && jQuery.isFunction( elem[ type ] ) && !jQuery.isWindow( elem ) ) {
+
+					// Don't re-trigger an onFOO event when we call its FOO() method
+					tmp = elem[ ontype ];
+
+					if ( tmp ) {
+						elem[ ontype ] = null;
+					}
+
+					// Prevent re-triggering of the same event, since we already bubbled it above
+					jQuery.event.triggered = type;
+					elem[ type ]();
+					jQuery.event.triggered = undefined;
+
+					if ( tmp ) {
+						elem[ ontype ] = tmp;
+					}
+				}
+			}
+		}
+
+		return event.result;
+	},
+
+	dispatch: function( event ) {
+
+		// Make a writable jQuery.Event from the native event object
+		event = jQuery.event.fix( event );
+
+		var i, j, ret, matched, handleObj,
+			handlerQueue = [],
+			args = core_slice.call( arguments ),
+			handlers = ( data_priv.get( this, "events" ) || {} )[ event.type ] || [],
+			special = jQuery.event.special[ event.type ] || {};
+
+		// Use the fix-ed jQuery.Event rather than the (read-only) native event
+		args[0] = event;
+		event.delegateTarget = this;
+
+		// Call the preDispatch hook for the mapped type, and let it bail if desired
+		if ( special.preDispatch && special.preDispatch.call( this, event ) === false ) {
+			return;
+		}
+
+		// Determine handlers
+		handlerQueue = jQuery.event.handlers.call( this, event, handlers );
+
+		// Run delegates first; they may want to stop propagation beneath us
+		i = 0;
+		while ( (matched = handlerQueue[ i++ ]) && !event.isPropagationStopped() ) {
+			event.currentTarget = matched.elem;
+
+			j = 0;
+			while ( (handleObj = matched.handlers[ j++ ]) && !event.isImmediatePropagationStopped() ) {
+
+				// Triggered event must either 1) have no namespace, or
+				// 2) have namespace(s) a subset or equal to those in the bound event (both can have no namespace).
+				if ( !event.namespace_re || event.namespace_re.test( handleObj.namespace ) ) {
+
+					event.handleObj = handleObj;
+					event.data = handleObj.data;
+
+					ret = ( (jQuery.event.special[ handleObj.origType ] || {}).handle || handleObj.handler )
+							.apply( matched.elem, args );
+
+					if ( ret !== undefined ) {
+						if ( (event.result = ret) === false ) {
+							event.preventDefault();
+							event.stopPropagation();
+						}
+					}
+				}
+			}
+		}
+
+		// Call the postDispatch hook for the mapped type
+		if ( special.postDispatch ) {
+			special.postDispatch.call( this, event );
+		}
+
+		return event.result;
+	},
+
+	handlers: function( event, handlers ) {
+		var i, matches, sel, handleObj,
+			handlerQueue = [],
+			delegateCount = handlers.delegateCount,
+			cur = event.target;
+
+		// Find delegate handlers
+		// Black-hole SVG <use> instance trees (#13180)
+		// Avoid non-left-click bubbling in Firefox (#3861)
+		if ( delegateCount && cur.nodeType && (!event.button || event.type !== "click") ) {
+
+			for ( ; cur !== this; cur = cur.parentNode || this ) {
+
+				// Don't process clicks on disabled elements (#6911, #8165, #11382, #11764)
+				if ( cur.disabled !== true || event.type !== "click" ) {
+					matches = [];
+					for ( i = 0; i < delegateCount; i++ ) {
+						handleObj = handlers[ i ];
+
+						// Don't conflict with Object.prototype properties (#13203)
+						sel = handleObj.selector + " ";
+
+						if ( matches[ sel ] === undefined ) {
+							matches[ sel ] = handleObj.needsContext ?
+								jQuery( sel, this ).index( cur ) >= 0 :
+								jQuery.find( sel, this, null, [ cur ] ).length;
+						}
+						if ( matches[ sel ] ) {
+							matches.push( handleObj );
+						}
+					}
+					if ( matches.length ) {
+						handlerQueue.push({ elem: cur, handlers: matches });
+					}
+				}
+			}
+		}
+
+		// Add the remaining (directly-bound) handlers
+		if ( delegateCount < handlers.length ) {
+			handlerQueue.push({ elem: this, handlers: handlers.slice( delegateCount ) });
+		}
+
+		return handlerQueue;
+	},
+
+	// Includes some event props shared by KeyEvent and MouseEvent
+	props: "altKey bubbles cancelable ctrlKey currentTarget eventPhase metaKey relatedTarget shiftKey target timeStamp view which".split(" "),
+
+	fixHooks: {},
+
+	keyHooks: {
+		props: "char charCode key keyCode".split(" "),
+		filter: function( event, original ) {
+
+			// Add which for key events
+			if ( event.which == null ) {
+				event.which = original.charCode != null ? original.charCode : original.keyCode;
+			}
+
+			return event;
+		}
+	},
+
+	mouseHooks: {
+		props: "button buttons clientX clientY offsetX offsetY pageX pageY screenX screenY toElement".split(" "),
+		filter: function( event, original ) {
+			var eventDoc, doc, body,
+				button = original.button;
+
+			// Calculate pageX/Y if missing and clientX/Y available
+			if ( event.pageX == null && original.clientX != null ) {
+				eventDoc = event.target.ownerDocument || document;
+				doc = eventDoc.documentElement;
+				body = eventDoc.body;
+
+				event.pageX = original.clientX + ( doc && doc.scrollLeft || body && body.scrollLeft || 0 ) - ( doc && doc.clientLeft || body && body.clientLeft || 0 );
+				event.pageY = original.clientY + ( doc && doc.scrollTop  || body && body.scrollTop  || 0 ) - ( doc && doc.clientTop  || body && body.clientTop  || 0 );
+			}
+
+			// Add which for click: 1 === left; 2 === middle; 3 === right
+			// Note: button is not normalized, so don't use it
+			if ( !event.which && button !== undefined ) {
+				event.which = ( button & 1 ? 1 : ( button & 2 ? 3 : ( button & 4 ? 2 : 0 ) ) );
+			}
+
+			return event;
+		}
+	},
+
+	fix: function( event ) {
+		if ( event[ jQuery.expando ] ) {
+			return event;
+		}
+
+		// Create a writable copy of the event object and normalize some properties
+		var i, prop, copy,
+			type = event.type,
+			originalEvent = event,
+			fixHook = this.fixHooks[ type ];
+
+		if ( !fixHook ) {
+			this.fixHooks[ type ] = fixHook =
+				rmouseEvent.test( type ) ? this.mouseHooks :
+				rkeyEvent.test( type ) ? this.keyHooks :
+				{};
+		}
+		copy = fixHook.props ? this.props.concat( fixHook.props ) : this.props;
+
+		event = new jQuery.Event( originalEvent );
+
+		i = copy.length;
+		while ( i-- ) {
+			prop = copy[ i ];
+			event[ prop ] = originalEvent[ prop ];
+		}
+
+		// Support: Cordova 2.5 (WebKit) (#13255)
+		// All events should have a target; Cordova deviceready doesn't
+		if ( !event.target ) {
+			event.target = document;
+		}
+
+		// Support: Safari 6.0+, Chrome < 28
+		// Target should not be a text node (#504, #13143)
+		if ( event.target.nodeType === 3 ) {
+			event.target = event.target.parentNode;
+		}
+
+		return fixHook.filter? fixHook.filter( event, originalEvent ) : event;
+	},
+
+	special: {
+		load: {
+			// Prevent triggered image.load events from bubbling to window.load
+			noBubble: true
+		},
+		focus: {
+			// Fire native event if possible so blur/focus sequence is correct
+			trigger: function() {
+				if ( this !== safeActiveElement() && this.focus ) {
+					this.focus();
+					return false;
+				}
+			},
+			delegateType: "focusin"
+		},
+		blur: {
+			trigger: function() {
+				if ( this === safeActiveElement() && this.blur ) {
+					this.blur();
+					return false;
+				}
+			},
+			delegateType: "focusout"
+		},
+		click: {
+			// For checkbox, fire native event so checked state will be right
+			trigger: function() {
+				if ( this.type === "checkbox" && this.click && jQuery.nodeName( this, "input" ) ) {
+					this.click();
+					return false;
+				}
+			},
+
+			// For cross-browser consistency, don't fire native .click() on links
+			_default: function( event ) {
+				return jQuery.nodeName( event.target, "a" );
+			}
+		},
+
+		beforeunload: {
+			postDispatch: function( event ) {
+
+				// Support: Firefox 20+
+				// Firefox doesn't alert if the returnValue field is not set.
+				if ( event.result !== undefined ) {
+					event.originalEvent.returnValue = event.result;
+				}
+			}
+		}
+	},
+
+	simulate: function( type, elem, event, bubble ) {
+		// Piggyback on a donor event to simulate a different one.
+		// Fake originalEvent to avoid donor's stopPropagation, but if the
+		// simulated event prevents default then we do the same on the donor.
+		var e = jQuery.extend(
+			new jQuery.Event(),
+			event,
+			{
+				type: type,
+				isSimulated: true,
+				originalEvent: {}
+			}
+		);
+		if ( bubble ) {
+			jQuery.event.trigger( e, null, elem );
+		} else {
+			jQuery.event.dispatch.call( elem, e );
+		}
+		if ( e.isDefaultPrevented() ) {
+			event.preventDefault();
+		}
+	}
+};
+
+jQuery.removeEvent = function( elem, type, handle ) {
+	if ( elem.removeEventListener ) {
+		elem.removeEventListener( type, handle, false );
+	}
+};
+
+jQuery.Event = function( src, props ) {
+	// Allow instantiation without the 'new' keyword
+	if ( !(this instanceof jQuery.Event) ) {
+		return new jQuery.Event( src, props );
+	}
+
+	// Event object
+	if ( src && src.type ) {
+		this.originalEvent = src;
+		this.type = src.type;
+
+		// Events bubbling up the document may have been marked as prevented
+		// by a handler lower down the tree; reflect the correct value.
+		this.isDefaultPrevented = ( src.defaultPrevented ||
+			src.getPreventDefault && src.getPreventDefault() ) ? returnTrue : returnFalse;
+
+	// Event type
+	} else {
+		this.type = src;
+	}
+
+	// Put explicitly provided properties onto the event object
+	if ( props ) {
+		jQuery.extend( this, props );
+	}
+
+	// Create a timestamp if incoming event doesn't have one
+	this.timeStamp = src && src.timeStamp || jQuery.now();
+
+	// Mark it as fixed
+	this[ jQuery.expando ] = true;
+};
+
+// jQuery.Event is based on DOM3 Events as specified by the ECMAScript Language Binding
+// http://www.w3.org/TR/2003/WD-DOM-Level-3-Events-20030331/ecma-script-binding.html
+jQuery.Event.prototype = {
+	isDefaultPrevented: returnFalse,
+	isPropagationStopped: returnFalse,
+	isImmediatePropagationStopped: returnFalse,
+
+	preventDefault: function() {
+		var e = this.originalEvent;
+
+		this.isDefaultPrevented = returnTrue;
+
+		if ( e && e.preventDefault ) {
+			e.preventDefault();
+		}
+	},
+	stopPropagation: function() {
+		var e = this.originalEvent;
+
+		this.isPropagationStopped = returnTrue;
+
+		if ( e && e.stopPropagation ) {
+			e.stopPropagation();
+		}
+	},
+	stopImmediatePropagation: function() {
+		this.isImmediatePropagationStopped = returnTrue;
+		this.stopPropagation();
+	}
+};
+
+// Create mouseenter/leave events using mouseover/out and event-time checks
+// Support: Chrome 15+
+jQuery.each({
+	mouseenter: "mouseover",
+	mouseleave: "mouseout"
+}, function( orig, fix ) {
+	jQuery.event.special[ orig ] = {
+		delegateType: fix,
+		bindType: fix,
+
+		handle: function( event ) {
+			var ret,
+				target = this,
+				related = event.relatedTarget,
+				handleObj = event.handleObj;
+
+			// For mousenter/leave call the handler if related is outside the target.
+			// NB: No relatedTarget if the mouse left/entered the browser window
+			if ( !related || (related !== target && !jQuery.contains( target, related )) ) {
+				event.type = handleObj.origType;
+				ret = handleObj.handler.apply( this, arguments );
+				event.type = fix;
+			}
+			return ret;
+		}
+	};
+});
+
+// Create "bubbling" focus and blur events
+// Support: Firefox, Chrome, Safari
+if ( !jQuery.support.focusinBubbles ) {
+	jQuery.each({ focus: "focusin", blur: "focusout" }, function( orig, fix ) {
+
+		// Attach a single capturing handler while someone wants focusin/focusout
+		var attaches = 0,
+			handler = function( event ) {
+				jQuery.event.simulate( fix, event.target, jQuery.event.fix( event ), true );
+			};
+
+		jQuery.event.special[ fix ] = {
+			setup: function() {
+				if ( attaches++ === 0 ) {
+					document.addEventListener( orig, handler, true );
+				}
+			},
+			teardown: function() {
+				if ( --attaches === 0 ) {
+					document.removeEventListener( orig, handler, true );
+				}
+			}
+		};
+	});
+}
+
+jQuery.fn.extend({
+
+	on: function( types, selector, data, fn, /*INTERNAL*/ one ) {
+		var origFn, type;
+
+		// Types can be a map of types/handlers
+		if ( typeof types === "object" ) {
+			// ( types-Object, selector, data )
+			if ( typeof selector !== "string" ) {
+				// ( types-Object, data )
+				data = data || selector;
+				selector = undefined;
+			}
+			for ( type in types ) {
+				this.on( type, selector, data, types[ type ], one );
+			}
+			return this;
+		}
+
+		if ( data == null && fn == null ) {
+			// ( types, fn )
+			fn = selector;
+			data = selector = undefined;
+		} else if ( fn == null ) {
+			if ( typeof selector === "string" ) {
+				// ( types, selector, fn )
+				fn = data;
+				data = undefined;
+			} else {
+				// ( types, data, fn )
+				fn = data;
+				data = selector;
+				selector = undefined;
+			}
+		}
+		if ( fn === false ) {
+			fn = returnFalse;
+		} else if ( !fn ) {
+			return this;
+		}
+
+		if ( one === 1 ) {
+			origFn = fn;
+			fn = function( event ) {
+				// Can use an empty set, since event contains the info
+				jQuery().off( event );
+				return origFn.apply( this, arguments );
+			};
+			// Use same guid so caller can remove using origFn
+			fn.guid = origFn.guid || ( origFn.guid = jQuery.guid++ );
+		}
+		return this.each( function() {
+			jQuery.event.add( this, types, fn, data, selector );
+		});
+	},
+	one: function( types, selector, data, fn ) {
+		return this.on( types, selector, data, fn, 1 );
+	},
+	off: function( types, selector, fn ) {
+		var handleObj, type;
+		if ( types && types.preventDefault && types.handleObj ) {
+			// ( event )  dispatched jQuery.Event
+			handleObj = types.handleObj;
+			jQuery( types.delegateTarget ).off(
+				handleObj.namespace ? handleObj.origType + "." + handleObj.namespace : handleObj.origType,
+				handleObj.selector,
+				handleObj.handler
+			);
+			return this;
+		}
+		if ( typeof types === "object" ) {
+			// ( types-object [, selector] )
+			for ( type in types ) {
+				this.off( type, selector, types[ type ] );
+			}
+			return this;
+		}
+		if ( selector === false || typeof selector === "function" ) {
+			// ( types [, fn] )
+			fn = selector;
+			selector = undefined;
+		}
+		if ( fn === false ) {
+			fn = returnFalse;
+		}
+		return this.each(function() {
+			jQuery.event.remove( this, types, fn, selector );
+		});
+	},
+
+	trigger: function( type, data ) {
+		return this.each(function() {
+			jQuery.event.trigger( type, data, this );
+		});
+	},
+	triggerHandler: function( type, data ) {
+		var elem = this[0];
+		if ( elem ) {
+			return jQuery.event.trigger( type, data, elem, true );
+		}
+	}
+});
+var isSimple = /^.[^:#\[\.,]*$/,
+	rparentsprev = /^(?:parents|prev(?:Until|All))/,
+	rneedsContext = jQuery.expr.match.needsContext,
+	// methods guaranteed to produce a unique set when starting from a unique set
+	guaranteedUnique = {
+		children: true,
+		contents: true,
+		next: true,
+		prev: true
+	};
+
+jQuery.fn.extend({
+	find: function( selector ) {
+		var i,
+			ret = [],
+			self = this,
+			len = self.length;
+
+		if ( typeof selector !== "string" ) {
+			return this.pushStack( jQuery( selector ).filter(function() {
+				for ( i = 0; i < len; i++ ) {
+					if ( jQuery.contains( self[ i ], this ) ) {
+						return true;
+					}
+				}
+			}) );
+		}
+
+		for ( i = 0; i < len; i++ ) {
+			jQuery.find( selector, self[ i ], ret );
+		}
+
+		// Needed because $( selector, context ) becomes $( context ).find( selector )
+		ret = this.pushStack( len > 1 ? jQuery.unique( ret ) : ret );
+		ret.selector = this.selector ? this.selector + " " + selector : selector;
+		return ret;
+	},
+
+	has: function( target ) {
+		var targets = jQuery( target, this ),
+			l = targets.length;
+
+		return this.filter(function() {
+			var i = 0;
+			for ( ; i < l; i++ ) {
+				if ( jQuery.contains( this, targets[i] ) ) {
+					return true;
+				}
+			}
+		});
+	},
+
+	not: function( selector ) {
+		return this.pushStack( winnow(this, selector || [], true) );
+	},
+
+	filter: function( selector ) {
+		return this.pushStack( winnow(this, selector || [], false) );
+	},
+
+	is: function( selector ) {
+		return !!winnow(
+			this,
+
+			// If this is a positional/relative selector, check membership in the returned set
+			// so $("p:first").is("p:last") won't return true for a doc with two "p".
+			typeof selector === "string" && rneedsContext.test( selector ) ?
+				jQuery( selector ) :
+				selector || [],
+			false
+		).length;
+	},
+
+	closest: function( selectors, context ) {
+		var cur,
+			i = 0,
+			l = this.length,
+			matched = [],
+			pos = ( rneedsContext.test( selectors ) || typeof selectors !== "string" ) ?
+				jQuery( selectors, context || this.context ) :
+				0;
+
+		for ( ; i < l; i++ ) {
+			for ( cur = this[i]; cur && cur !== context; cur = cur.parentNode ) {
+				// Always skip document fragments
+				if ( cur.nodeType < 11 && (pos ?
+					pos.index(cur) > -1 :
+
+					// Don't pass non-elements to Sizzle
+					cur.nodeType === 1 &&
+						jQuery.find.matchesSelector(cur, selectors)) ) {
+
+					cur = matched.push( cur );
+					break;
+				}
+			}
+		}
+
+		return this.pushStack( matched.length > 1 ? jQuery.unique( matched ) : matched );
+	},
+
+	// Determine the position of an element within
+	// the matched set of elements
+	index: function( elem ) {
+
+		// No argument, return index in parent
+		if ( !elem ) {
+			return ( this[ 0 ] && this[ 0 ].parentNode ) ? this.first().prevAll().length : -1;
+		}
+
+		// index in selector
+		if ( typeof elem === "string" ) {
+			return core_indexOf.call( jQuery( elem ), this[ 0 ] );
+		}
+
+		// Locate the position of the desired element
+		return core_indexOf.call( this,
+
+			// If it receives a jQuery object, the first element is used
+			elem.jquery ? elem[ 0 ] : elem
+		);
+	},
+
+	add: function( selector, context ) {
+		var set = typeof selector === "string" ?
+				jQuery( selector, context ) :
+				jQuery.makeArray( selector && selector.nodeType ? [ selector ] : selector ),
+			all = jQuery.merge( this.get(), set );
+
+		return this.pushStack( jQuery.unique(all) );
+	},
+
+	addBack: function( selector ) {
+		return this.add( selector == null ?
+			this.prevObject : this.prevObject.filter(selector)
+		);
+	}
+});
+
+function sibling( cur, dir ) {
+	while ( (cur = cur[dir]) && cur.nodeType !== 1 ) {}
+
+	return cur;
+}
+
+jQuery.each({
+	parent: function( elem ) {
+		var parent = elem.parentNode;
+		return parent && parent.nodeType !== 11 ? parent : null;
+	},
+	parents: function( elem ) {
+		return jQuery.dir( elem, "parentNode" );
+	},
+	parentsUntil: function( elem, i, until ) {
+		return jQuery.dir( elem, "parentNode", until );
+	},
+	next: function( elem ) {
+		return sibling( elem, "nextSibling" );
+	},
+	prev: function( elem ) {
+		return sibling( elem, "previousSibling" );
+	},
+	nextAll: function( elem ) {
+		return jQuery.dir( elem, "nextSibling" );
+	},
+	prevAll: function( elem ) {
+		return jQuery.dir( elem, "previousSibling" );
+	},
+	nextUntil: function( elem, i, until ) {
+		return jQuery.dir( elem, "nextSibling", until );
+	},
+	prevUntil: function( elem, i, until ) {
+		return jQuery.dir( elem, "previousSibling", until );
+	},
+	siblings: function( elem ) {
+		return jQuery.sibling( ( elem.parentNode || {} ).firstChild, elem );
+	},
+	children: function( elem ) {
+		return jQuery.sibling( elem.firstChild );
+	},
+	contents: function( elem ) {
+		return elem.contentDocument || jQuery.merge( [], elem.childNodes );
+	}
+}, function( name, fn ) {
+	jQuery.fn[ name ] = function( until, selector ) {
+		var matched = jQuery.map( this, fn, until );
+
+		if ( name.slice( -5 ) !== "Until" ) {
+			selector = until;
+		}
+
+		if ( selector && typeof selector === "string" ) {
+			matched = jQuery.filter( selector, matched );
+		}
+
+		if ( this.length > 1 ) {
+			// Remove duplicates
+			if ( !guaranteedUnique[ name ] ) {
+				jQuery.unique( matched );
+			}
+
+			// Reverse order for parents* and prev-derivatives
+			if ( rparentsprev.test( name ) ) {
+				matched.reverse();
+			}
+		}
+
+		return this.pushStack( matched );
+	};
+});
+
+jQuery.extend({
+	filter: function( expr, elems, not ) {
+		var elem = elems[ 0 ];
+
+		if ( not ) {
+			expr = ":not(" + expr + ")";
+		}
+
+		return elems.length === 1 && elem.nodeType === 1 ?
+			jQuery.find.matchesSelector( elem, expr ) ? [ elem ] : [] :
+			jQuery.find.matches( expr, jQuery.grep( elems, function( elem ) {
+				return elem.nodeType === 1;
+			}));
+	},
+
+	dir: function( elem, dir, until ) {
+		var matched = [],
+			truncate = until !== undefined;
+
+		while ( (elem = elem[ dir ]) && elem.nodeType !== 9 ) {
+			if ( elem.nodeType === 1 ) {
+				if ( truncate && jQuery( elem ).is( until ) ) {
+					break;
+				}
+				matched.push( elem );
+			}
+		}
+		return matched;
+	},
+
+	sibling: function( n, elem ) {
+		var matched = [];
+
+		for ( ; n; n = n.nextSibling ) {
+			if ( n.nodeType === 1 && n !== elem ) {
+				matched.push( n );
+			}
+		}
+
+		return matched;
+	}
+});
+
+// Implement the identical functionality for filter and not
+function winnow( elements, qualifier, not ) {
+	if ( jQuery.isFunction( qualifier ) ) {
+		return jQuery.grep( elements, function( elem, i ) {
+			/* jshint -W018 */
+			return !!qualifier.call( elem, i, elem ) !== not;
+		});
+
+	}
+
+	if ( qualifier.nodeType ) {
+		return jQuery.grep( elements, function( elem ) {
+			return ( elem === qualifier ) !== not;
+		});
+
+	}
+
+	if ( typeof qualifier === "string" ) {
+		if ( isSimple.test( qualifier ) ) {
+			return jQuery.filter( qualifier, elements, not );
+		}
+
+		qualifier = jQuery.filter( qualifier, elements );
+	}
+
+	return jQuery.grep( elements, function( elem ) {
+		return ( core_indexOf.call( qualifier, elem ) >= 0 ) !== not;
+	});
+}
+var rxhtmlTag = /<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/gi,
+	rtagName = /<([\w:]+)/,
+	rhtml = /<|&#?\w+;/,
+	rnoInnerhtml = /<(?:script|style|link)/i,
+	manipulation_rcheckableType = /^(?:checkbox|radio)$/i,
+	// checked="checked" or checked
+	rchecked = /checked\s*(?:[^=]|=\s*.checked.)/i,
+	rscriptType = /^$|\/(?:java|ecma)script/i,
+	rscriptTypeMasked = /^true\/(.*)/,
+	rcleanScript = /^\s*<!(?:\[CDATA\[|--)|(?:\]\]|--)>\s*$/g,
+
+	// We have to close these tags to support XHTML (#13200)
+	wrapMap = {
+
+		// Support: IE 9
+		option: [ 1, "<select multiple='multiple'>", "</select>" ],
+
+		thead: [ 1, "<table>", "</table>" ],
+		col: [ 2, "<table><colgroup>", "</colgroup></table>" ],
+		tr: [ 2, "<table><tbody>", "</tbody></table>" ],
+		td: [ 3, "<table><tbody><tr>", "</tr></tbody></table>" ],
+
+		_default: [ 0, "", "" ]
+	};
+
+// Support: IE 9
+wrapMap.optgroup = wrapMap.option;
+
+wrapMap.tbody = wrapMap.tfoot = wrapMap.colgroup = wrapMap.caption = wrapMap.thead;
+wrapMap.th = wrapMap.td;
+
+jQuery.fn.extend({
+	text: function( value ) {
+		return jQuery.access( this, function( value ) {
+			return value === undefined ?
+				jQuery.text( this ) :
+				this.empty().append( ( this[ 0 ] && this[ 0 ].ownerDocument || document ).createTextNode( value ) );
+		}, null, value, arguments.length );
+	},
+
+	append: function() {
+		return this.domManip( arguments, function( elem ) {
+			if ( this.nodeType === 1 || this.nodeType === 11 || this.nodeType === 9 ) {
+				var target = manipulationTarget( this, elem );
+				target.appendChild( elem );
+			}
+		});
+	},
+
+	prepend: function() {
+		return this.domManip( arguments, function( elem ) {
+			if ( this.nodeType === 1 || this.nodeType === 11 || this.nodeType === 9 ) {
+				var target = manipulationTarget( this, elem );
+				target.insertBefore( elem, target.firstChild );
+			}
+		});
+	},
+
+	before: function() {
+		return this.domManip( arguments, function( elem ) {
+			if ( this.parentNode ) {
+				this.parentNode.insertBefore( elem, this );
+			}
+		});
+	},
+
+	after: function() {
+		return this.domManip( arguments, function( elem ) {
+			if ( this.parentNode ) {
+				this.parentNode.insertBefore( elem, this.nextSibling );
+			}
+		});
+	},
+
+	// keepData is for internal use only--do not document
+	remove: function( selector, keepData ) {
+		var elem,
+			elems = selector ? jQuery.filter( selector, this ) : this,
+			i = 0;
+
+		for ( ; (elem = elems[i]) != null; i++ ) {
+			if ( !keepData && elem.nodeType === 1 ) {
+				jQuery.cleanData( getAll( elem ) );
+			}
+
+			if ( elem.parentNode ) {
+				if ( keepData && jQuery.contains( elem.ownerDocument, elem ) ) {
+					setGlobalEval( getAll( elem, "script" ) );
+				}
+				elem.parentNode.removeChild( elem );
+			}
+		}
+
+		return this;
+	},
+
+	empty: function() {
+		var elem,
+			i = 0;
+
+		for ( ; (elem = this[i]) != null; i++ ) {
+			if ( elem.nodeType === 1 ) {
+
+				// Prevent memory leaks
+				jQuery.cleanData( getAll( elem, false ) );
+
+				// Remove any remaining nodes
+				elem.textContent = "";
+			}
+		}
+
+		return this;
+	},
+
+	clone: function( dataAndEvents, deepDataAndEvents ) {
+		dataAndEvents = dataAndEvents == null ? false : dataAndEvents;
+		deepDataAndEvents = deepDataAndEvents == null ? dataAndEvents : deepDataAndEvents;
+
+		return this.map( function () {
+			return jQuery.clone( this, dataAndEvents, deepDataAndEvents );
+		});
+	},
+
+	html: function( value ) {
+		return jQuery.access( this, function( value ) {
+			var elem = this[ 0 ] || {},
+				i = 0,
+				l = this.length;
+
+			if ( value === undefined && elem.nodeType === 1 ) {
+				return elem.innerHTML;
+			}
+
+			// See if we can take a shortcut and just use innerHTML
+			if ( typeof value === "string" && !rnoInnerhtml.test( value ) &&
+				!wrapMap[ ( rtagName.exec( value ) || [ "", "" ] )[ 1 ].toLowerCase() ] ) {
+
+				value = value.replace( rxhtmlTag, "<$1></$2>" );
+
+				try {
+					for ( ; i < l; i++ ) {
+						elem = this[ i ] || {};
+
+						// Remove element nodes and prevent memory leaks
+						if ( elem.nodeType === 1 ) {
+							jQuery.cleanData( getAll( elem, false ) );
+							elem.innerHTML = value;
+						}
+					}
+
+					elem = 0;
+
+				// If using innerHTML throws an exception, use the fallback method
+				} catch( e ) {}
+			}
+
+			if ( elem ) {
+				this.empty().append( value );
+			}
+		}, null, value, arguments.length );
+	},
+
+	replaceWith: function() {
+		var
+			// Snapshot the DOM in case .domManip sweeps something relevant into its fragment
+			args = jQuery.map( this, function( elem ) {
+				return [ elem.nextSibling, elem.parentNode ];
+			}),
+			i = 0;
+
+		// Make the changes, replacing each context element with the new content
+		this.domManip( arguments, function( elem ) {
+			var next = args[ i++ ],
+				parent = args[ i++ ];
+
+			if ( parent ) {
+				// Don't use the snapshot next if it has moved (#13810)
+				if ( next && next.parentNode !== parent ) {
+					next = this.nextSibling;
+				}
+				jQuery( this ).remove();
+				parent.insertBefore( elem, next );
+			}
+		// Allow new content to include elements from the context set
+		}, true );
+
+		// Force removal if there was no new content (e.g., from empty arguments)
+		return i ? this : this.remove();
+	},
+
+	detach: function( selector ) {
+		return this.remove( selector, true );
+	},
+
+	domManip: function( args, callback, allowIntersection ) {
+
+		// Flatten any nested arrays
+		args = core_concat.apply( [], args );
+
+		var fragment, first, scripts, hasScripts, node, doc,
+			i = 0,
+			l = this.length,
+			set = this,
+			iNoClone = l - 1,
+			value = args[ 0 ],
+			isFunction = jQuery.isFunction( value );
+
+		// We can't cloneNode fragments that contain checked, in WebKit
+		if ( isFunction || !( l <= 1 || typeof value !== "string" || jQuery.support.checkClone || !rchecked.test( value ) ) ) {
+			return this.each(function( index ) {
+				var self = set.eq( index );
+				if ( isFunction ) {
+					args[ 0 ] = value.call( this, index, self.html() );
+				}
+				self.domManip( args, callback, allowIntersection );
+			});
+		}
+
+		if ( l ) {
+			fragment = jQuery.buildFragment( args, this[ 0 ].ownerDocument, false, !allowIntersection && this );
+			first = fragment.firstChild;
+
+			if ( fragment.childNodes.length === 1 ) {
+				fragment = first;
+			}
+
+			if ( first ) {
+				scripts = jQuery.map( getAll( fragment, "script" ), disableScript );
+				hasScripts = scripts.length;
+
+				// Use the original fragment for the last item instead of the first because it can end up
+				// being emptied incorrectly in certain situations (#8070).
+				for ( ; i < l; i++ ) {
+					node = fragment;
+
+					if ( i !== iNoClone ) {
+						node = jQuery.clone( node, true, true );
+
+						// Keep references to cloned scripts for later restoration
+						if ( hasScripts ) {
+							// Support: QtWebKit
+							// jQuery.merge because core_push.apply(_, arraylike) throws
+							jQuery.merge( scripts, getAll( node, "script" ) );
+						}
+					}
+
+					callback.call( this[ i ], node, i );
+				}
+
+				if ( hasScripts ) {
+					doc = scripts[ scripts.length - 1 ].ownerDocument;
+
+					// Reenable scripts
+					jQuery.map( scripts, restoreScript );
+
+					// Evaluate executable scripts on first document insertion
+					for ( i = 0; i < hasScripts; i++ ) {
+						node = scripts[ i ];
+						if ( rscriptType.test( node.type || "" ) &&
+							!data_priv.access( node, "globalEval" ) && jQuery.contains( doc, node ) ) {
+
+							if ( node.src ) {
+								// Hope ajax is available...
+								jQuery._evalUrl( node.src );
+							} else {
+								jQuery.globalEval( node.textContent.replace( rcleanScript, "" ) );
+							}
+						}
+					}
+				}
+			}
+		}
+
+		return this;
+	}
+});
+
+jQuery.each({
+	appendTo: "append",
+	prependTo: "prepend",
+	insertBefore: "before",
+	insertAfter: "after",
+	replaceAll: "replaceWith"
+}, function( name, original ) {
+	jQuery.fn[ name ] = function( selector ) {
+		var elems,
+			ret = [],
+			insert = jQuery( selector ),
+			last = insert.length - 1,
+			i = 0;
+
+		for ( ; i <= last; i++ ) {
+			elems = i === last ? this : this.clone( true );
+			jQuery( insert[ i ] )[ original ]( elems );
+
+			// Support: QtWebKit
+			// .get() because core_push.apply(_, arraylike) throws
+			core_push.apply( ret, elems.get() );
+		}
+
+		return this.pushStack( ret );
+	};
+});
+
+jQuery.extend({
+	clone: function( elem, dataAndEvents, deepDataAndEvents ) {
+		var i, l, srcElements, destElements,
+			clone = elem.cloneNode( true ),
+			inPage = jQuery.contains( elem.ownerDocument, elem );
+
+		// Support: IE >= 9
+		// Fix Cloning issues
+		if ( !jQuery.support.noCloneChecked && ( elem.nodeType === 1 || elem.nodeType === 11 ) && !jQuery.isXMLDoc( elem ) ) {
+
+			// We eschew Sizzle here for performance reasons: http://jsperf.com/getall-vs-sizzle/2
+			destElements = getAll( clone );
+			srcElements = getAll( elem );
+
+			for ( i = 0, l = srcElements.length; i < l; i++ ) {
+				fixInput( srcElements[ i ], destElements[ i ] );
+			}
+		}
+
+		// Copy the events from the original to the clone
+		if ( dataAndEvents ) {
+			if ( deepDataAndEvents ) {
+				srcElements = srcElements || getAll( elem );
+				destElements = destElements || getAll( clone );
+
+				for ( i = 0, l = srcElements.length; i < l; i++ ) {
+					cloneCopyEvent( srcElements[ i ], destElements[ i ] );
+				}
+			} else {
+				cloneCopyEvent( elem, clone );
+			}
+		}
+
+		// Preserve script evaluation history
+		destElements = getAll( clone, "script" );
+		if ( destElements.length > 0 ) {
+			setGlobalEval( destElements, !inPage && getAll( elem, "script" ) );
+		}
+
+		// Return the cloned set
+		return clone;
+	},
+
+	buildFragment: function( elems, context, scripts, selection ) {
+		var elem, tmp, tag, wrap, contains, j,
+			i = 0,
+			l = elems.length,
+			fragment = context.createDocumentFragment(),
+			nodes = [];
+
+		for ( ; i < l; i++ ) {
+			elem = elems[ i ];
+
+			if ( elem || elem === 0 ) {
+
+				// Add nodes directly
+				if ( jQuery.type( elem ) === "object" ) {
+					// Support: QtWebKit
+					// jQuery.merge because core_push.apply(_, arraylike) throws
+					jQuery.merge( nodes, elem.nodeType ? [ elem ] : elem );
+
+				// Convert non-html into a text node
+				} else if ( !rhtml.test( elem ) ) {
+					nodes.push( context.createTextNode( elem ) );
+
+				// Convert html into DOM nodes
+				} else {
+					tmp = tmp || fragment.appendChild( context.createElement("div") );
+
+					// Deserialize a standard representation
+					tag = ( rtagName.exec( elem ) || ["", ""] )[ 1 ].toLowerCase();
+					wrap = wrapMap[ tag ] || wrapMap._default;
+					tmp.innerHTML = wrap[ 1 ] + elem.replace( rxhtmlTag, "<$1></$2>" ) + wrap[ 2 ];
+
+					// Descend through wrappers to the right content
+					j = wrap[ 0 ];
+					while ( j-- ) {
+						tmp = tmp.lastChild;
+					}
+
+					// Support: QtWebKit
+					// jQuery.merge because core_push.apply(_, arraylike) throws
+					jQuery.merge( nodes, tmp.childNodes );
+
+					// Remember the top-level container
+					tmp = fragment.firstChild;
+
+					// Fixes #12346
+					// Support: Webkit, IE
+					tmp.textContent = "";
+				}
+			}
+		}
+
+		// Remove wrapper from fragment
+		fragment.textContent = "";
+
+		i = 0;
+		while ( (elem = nodes[ i++ ]) ) {
+
+			// #4087 - If origin and destination elements are the same, and this is
+			// that element, do not do anything
+			if ( selection && jQuery.inArray( elem, selection ) !== -1 ) {
+				continue;
+			}
+
+			contains = jQuery.contains( elem.ownerDocument, elem );
+
+			// Append to fragment
+			tmp = getAll( fragment.appendChild( elem ), "script" );
+
+			// Preserve script evaluation history
+			if ( contains ) {
+				setGlobalEval( tmp );
+			}
+
+			// Capture executables
+			if ( scripts ) {
+				j = 0;
+				while ( (elem = tmp[ j++ ]) ) {
+					if ( rscriptType.test( elem.type || "" ) ) {
+						scripts.push( elem );
+					}
+				}
+			}
+		}
+
+		return fragment;
+	},
+
+	cleanData: function( elems ) {
+		var data, elem, events, type, key, j,
+			special = jQuery.event.special,
+			i = 0;
+
+		for ( ; (elem = elems[ i ]) !== undefined; i++ ) {
+			if ( Data.accepts( elem ) ) {
+				key = elem[ data_priv.expando ];
+
+				if ( key && (data = data_priv.cache[ key ]) ) {
+					events = Object.keys( data.events || {} );
+					if ( events.length ) {
+						for ( j = 0; (type = events[j]) !== undefined; j++ ) {
+							if ( special[ type ] ) {
+								jQuery.event.remove( elem, type );
+
+							// This is a shortcut to avoid jQuery.event.remove's overhead
+							} else {
+								jQuery.removeEvent( elem, type, data.handle );
+							}
+						}
+					}
+					if ( data_priv.cache[ key ] ) {
+						// Discard any remaining `private` data
+						delete data_priv.cache[ key ];
+					}
+				}
+			}
+			// Discard any remaining `user` data
+			delete data_user.cache[ elem[ data_user.expando ] ];
+		}
+	},
+
+	_evalUrl: function( url ) {
+		return jQuery.ajax({
+			url: url,
+			type: "GET",
+			dataType: "script",
+			async: false,
+			global: false,
+			"throws": true
+		});
+	}
+});
+
+// Support: 1.x compatibility
+// Manipulating tables requires a tbody
+function manipulationTarget( elem, content ) {
+	return jQuery.nodeName( elem, "table" ) &&
+		jQuery.nodeName( content.nodeType === 1 ? content : content.firstChild, "tr" ) ?
+
+		elem.getElementsByTagName("tbody")[0] ||
+			elem.appendChild( elem.ownerDocument.createElement("tbody") ) :
+		elem;
+}
+
+// Replace/restore the type attribute of script elements for safe DOM manipulation
+function disableScript( elem ) {
+	elem.type = (elem.getAttribute("type") !== null) + "/" + elem.type;
+	return elem;
+}
+function restoreScript( elem ) {
+	var match = rscriptTypeMasked.exec( elem.type );
+
+	if ( match ) {
+		elem.type = match[ 1 ];
+	} else {
+		elem.removeAttribute("type");
+	}
+
+	return elem;
+}
+
+// Mark scripts as having already been evaluated
+function setGlobalEval( elems, refElements ) {
+	var l = elems.length,
+		i = 0;
+
+	for ( ; i < l; i++ ) {
+		data_priv.set(
+			elems[ i ], "globalEval", !refElements || data_priv.get( refElements[ i ], "globalEval" )
+		);
+	}
+}
+
+function cloneCopyEvent( src, dest ) {
+	var i, l, type, pdataOld, pdataCur, udataOld, udataCur, events;
+
+	if ( dest.nodeType !== 1 ) {
+		return;
+	}
+
+	// 1. Copy private data: events, handlers, etc.
+	if ( data_priv.hasData( src ) ) {
+		pdataOld = data_priv.access( src );
+		pdataCur = data_priv.set( dest, pdataOld );
+		events = pdataOld.events;
+
+		if ( events ) {
+			delete pdataCur.handle;
+			pdataCur.events = {};
+
+			for ( type in events ) {
+				for ( i = 0, l = events[ type ].length; i < l; i++ ) {
+					jQuery.event.add( dest, type, events[ type ][ i ] );
+				}
+			}
+		}
+	}
+
+	// 2. Copy user data
+	if ( data_user.hasData( src ) ) {
+		udataOld = data_user.access( src );
+		udataCur = jQuery.extend( {}, udataOld );
+
+		data_user.set( dest, udataCur );
+	}
+}
+
+
+function getAll( context, tag ) {
+	var ret = context.getElementsByTagName ? context.getElementsByTagName( tag || "*" ) :
+			context.querySelectorAll ? context.querySelectorAll( tag || "*" ) :
+			[];
+
+	return tag === undefined || tag && jQuery.nodeName( context, tag ) ?
+		jQuery.merge( [ context ], ret ) :
+		ret;
+}
+
+// Support: IE >= 9
+function fixInput( src, dest ) {
+	var nodeName = dest.nodeName.toLowerCase();
+
+	// Fails to persist the checked state of a cloned checkbox or radio button.
+	if ( nodeName === "input" && manipulation_rcheckableType.test( src.type ) ) {
+		dest.checked = src.checked;
+
+	// Fails to return the selected option to the default selected state when cloning options
+	} else if ( nodeName === "input" || nodeName === "textarea" ) {
+		dest.defaultValue = src.defaultValue;
+	}
+}
+jQuery.fn.extend({
+	wrapAll: function( html ) {
+		var wrap;
+
+		if ( jQuery.isFunction( html ) ) {
+			return this.each(function( i ) {
+				jQuery( this ).wrapAll( html.call(this, i) );
+			});
+		}
+
+		if ( this[ 0 ] ) {
+
+			// The elements to wrap the target around
+			wrap = jQuery( html, this[ 0 ].ownerDocument ).eq( 0 ).clone( true );
+
+			if ( this[ 0 ].parentNode ) {
+				wrap.insertBefore( this[ 0 ] );
+			}
+
+			wrap.map(function() {
+				var elem = this;
+
+				while ( elem.firstElementChild ) {
+					elem = elem.firstElementChild;
+				}
+
+				return elem;
+			}).append( this );
+		}
+
+		return this;
+	},
+
+	wrapInner: function( html ) {
+		if ( jQuery.isFunction( html ) ) {
+			return this.each(function( i ) {
+				jQuery( this ).wrapInner( html.call(this, i) );
+			});
+		}
+
+		return this.each(function() {
+			var self = jQuery( this ),
+				contents = self.contents();
+
+			if ( contents.length ) {
+				contents.wrapAll( html );
+
+			} else {
+				self.append( html );
+			}
+		});
+	},
+
+	wrap: function( html ) {
+		var isFunction = jQuery.isFunction( html );
+
+		return this.each(function( i ) {
+			jQuery( this ).wrapAll( isFunction ? html.call(this, i) : html );
+		});
+	},
+
+	unwrap: function() {
+		return this.parent().each(function() {
+			if ( !jQuery.nodeName( this, "body" ) ) {
+				jQuery( this ).replaceWith( this.childNodes );
+			}
+		}).end();
+	}
+});
+var curCSS, iframe,
+	// swappable if display is none or starts with table except "table", "table-cell", or "table-caption"
+	// see here for display values: https://developer.mozilla.org/en-US/docs/CSS/display
+	rdisplayswap = /^(none|table(?!-c[ea]).+)/,
+	rmargin = /^margin/,
+	rnumsplit = new RegExp( "^(" + core_pnum + ")(.*)$", "i" ),
+	rnumnonpx = new RegExp( "^(" + core_pnum + ")(?!px)[a-z%]+$", "i" ),
+	rrelNum = new RegExp( "^([+-])=(" + core_pnum + ")", "i" ),
+	elemdisplay = { BODY: "block" },
+
+	cssShow = { position: "absolute", visibility: "hidden", display: "block" },
+	cssNormalTransform = {
+		letterSpacing: 0,
+		fontWeight: 400
+	},
+
+	cssExpand = [ "Top", "Right", "Bottom", "Left" ],
+	cssPrefixes = [ "Webkit", "O", "Moz", "ms" ];
+
+// return a css property mapped to a potentially vendor prefixed property
+function vendorPropName( style, name ) {
+
+	// shortcut for names that are not vendor prefixed
+	if ( name in style ) {
+		return name;
+	}
+
+	// check for vendor prefixed names
+	var capName = name.charAt(0).toUpperCase() + name.slice(1),
+		origName = name,
+		i = cssPrefixes.length;
+
+	while ( i-- ) {
+		name = cssPrefixes[ i ] + capName;
+		if ( name in style ) {
+			return name;
+		}
+	}
+
+	return origName;
+}
+
+function isHidden( elem, el ) {
+	// isHidden might be called from jQuery#filter function;
+	// in that case, element will be second argument
+	elem = el || elem;
+	return jQuery.css( elem, "display" ) === "none" || !jQuery.contains( elem.ownerDocument, elem );
+}
+
+// NOTE: we've included the "window" in window.getComputedStyle
+// because jsdom on node.js will break without it.
+function getStyles( elem ) {
+	return window.getComputedStyle( elem, null );
+}
+
+function showHide( elements, show ) {
+	var display, elem, hidden,
+		values = [],
+		index = 0,
+		length = elements.length;
+
+	for ( ; index < length; index++ ) {
+		elem = elements[ index ];
+		if ( !elem.style ) {
+			continue;
+		}
+
+		values[ index ] = data_priv.get( elem, "olddisplay" );
+		display = elem.style.display;
+		if ( show ) {
+			// Reset the inline display of this element to learn if it is
+			// being hidden by cascaded rules or not
+			if ( !values[ index ] && display === "none" ) {
+				elem.style.display = "";
+			}
+
+			// Set elements which have been overridden with display: none
+			// in a stylesheet to whatever the default browser style is
+			// for such an element
+			if ( elem.style.display === "" && isHidden( elem ) ) {
+				values[ index ] = data_priv.access( elem, "olddisplay", css_defaultDisplay(elem.nodeName) );
+			}
+		} else {
+
+			if ( !values[ index ] ) {
+				hidden = isHidden( elem );
+
+				if ( display && display !== "none" || !hidden ) {
+					data_priv.set( elem, "olddisplay", hidden ? display : jQuery.css(elem, "display") );
+				}
+			}
+		}
+	}
+
+	// Set the display of most of the elements in a second loop
+	// to avoid the constant reflow
+	for ( index = 0; index < length; index++ ) {
+		elem = elements[ index ];
+		if ( !elem.style ) {
+			continue;
+		}
+		if ( !show || elem.style.display === "none" || elem.style.display === "" ) {
+			elem.style.display = show ? values[ index ] || "" : "none";
+		}
+	}
+
+	return elements;
+}
+
+jQuery.fn.extend({
+	css: function( name, value ) {
+		return jQuery.access( this, function( elem, name, value ) {
+			var styles, len,
+				map = {},
+				i = 0;
+
+			if ( jQuery.isArray( name ) ) {
+				styles = getStyles( elem );
+				len = name.length;
+
+				for ( ; i < len; i++ ) {
+					map[ name[ i ] ] = jQuery.css( elem, name[ i ], false, styles );
+				}
+
+				return map;
+			}
+
+			return value !== undefined ?
+				jQuery.style( elem, name, value ) :
+				jQuery.css( elem, name );
+		}, name, value, arguments.length > 1 );
+	},
+	show: function() {
+		return showHide( this, true );
+	},
+	hide: function() {
+		return showHide( this );
+	},
+	toggle: function( state ) {
+		if ( typeof state === "boolean" ) {
+			return state ? this.show() : this.hide();
+		}
+
+		return this.each(function() {
+			if ( isHidden( this ) ) {
+				jQuery( this ).show();
+			} else {
+				jQuery( this ).hide();
+			}
+		});
+	}
+});
+
+jQuery.extend({
+	// Add in style property hooks for overriding the default
+	// behavior of getting and setting a style property
+	cssHooks: {
+		opacity: {
+			get: function( elem, computed ) {
+				if ( computed ) {
+					// We should always get a number back from opacity
+					var ret = curCSS( elem, "opacity" );
+					return ret === "" ? "1" : ret;
+				}
+			}
+		}
+	},
+
+	// Don't automatically add "px" to these possibly-unitless properties
+	cssNumber: {
+		"columnCount": true,
+		"fillOpacity": true,
+		"fontWeight": true,
+		"lineHeight": true,
+		"opacity": true,
+		"order": true,
+		"orphans": true,
+		"widows": true,
+		"zIndex": true,
+		"zoom": true
+	},
+
+	// Add in properties whose names you wish to fix before
+	// setting or getting the value
+	cssProps: {
+		// normalize float css property
+		"float": "cssFloat"
+	},
+
+	// Get and set the style property on a DOM Node
+	style: function( elem, name, value, extra ) {
+		// Don't set styles on text and comment nodes
+		if ( !elem || elem.nodeType === 3 || elem.nodeType === 8 || !elem.style ) {
+			return;
+		}
+
+		// Make sure that we're working with the right name
+		var ret, type, hooks,
+			origName = jQuery.camelCase( name ),
+			style = elem.style;
+
+		name = jQuery.cssProps[ origName ] || ( jQuery.cssProps[ origName ] = vendorPropName( style, origName ) );
+
+		// gets hook for the prefixed version
+		// followed by the unprefixed version
+		hooks = jQuery.cssHooks[ name ] || jQuery.cssHooks[ origName ];
+
+		// Check if we're setting a value
+		if ( value !== undefined ) {
+			type = typeof value;
+
+			// convert relative number strings (+= or -=) to relative numbers. #7345
+			if ( type === "string" && (ret = rrelNum.exec( value )) ) {
+				value = ( ret[1] + 1 ) * ret[2] + parseFloat( jQuery.css( elem, name ) );
+				// Fixes bug #9237
+				type = "number";
+			}
+
+			// Make sure that NaN and null values aren't set. See: #7116
+			if ( value == null || type === "number" && isNaN( value ) ) {
+				return;
+			}
+
+			// If a number was passed in, add 'px' to the (except for certain CSS properties)
+			if ( type === "number" && !jQuery.cssNumber[ origName ] ) {
+				value += "px";
+			}
+
+			// Fixes #8908, it can be done more correctly by specifying setters in cssHooks,
+			// but it would mean to define eight (for every problematic property) identical functions
+			if ( !jQuery.support.clearCloneStyle && value === "" && name.indexOf("background") === 0 ) {
+				style[ name ] = "inherit";
+			}
+
+			// If a hook was provided, use that value, otherwise just set the specified value
+			if ( !hooks || !("set" in hooks) || (value = hooks.set( elem, value, extra )) !== undefined ) {
+				style[ name ] = value;
+			}
+
+		} else {
+			// If a hook was provided get the non-computed value from there
+			if ( hooks && "get" in hooks && (ret = hooks.get( elem, false, extra )) !== undefined ) {
+				return ret;
+			}
+
+			// Otherwise just get the value from the style object
+			return style[ name ];
+		}
+	},
+
+	css: function( elem, name, extra, styles ) {
+		var val, num, hooks,
+			origName = jQuery.camelCase( name );
+
+		// Make sure that we're working with the right name
+		name = jQuery.cssProps[ origName ] || ( jQuery.cssProps[ origName ] = vendorPropName( elem.style, origName ) );
+
+		// gets hook for the prefixed version
+		// followed by the unprefixed version
+		hooks = jQuery.cssHooks[ name ] || jQuery.cssHooks[ origName ];
+
+		// If a hook was provided get the computed value from there
+		if ( hooks && "get" in hooks ) {
+			val = hooks.get( elem, true, extra );
+		}
+
+		// Otherwise, if a way to get the computed value exists, use that
+		if ( val === undefined ) {
+			val = curCSS( elem, name, styles );
+		}
+
+		//convert "normal" to computed value
+		if ( val === "normal" && name in cssNormalTransform ) {
+			val = cssNormalTransform[ name ];
+		}
+
+		// Return, converting to number if forced or a qualifier was provided and val looks numeric
+		if ( extra === "" || extra ) {
+			num = parseFloat( val );
+			return extra === true || jQuery.isNumeric( num ) ? num || 0 : val;
+		}
+		return val;
+	}
+});
+
+curCSS = function( elem, name, _computed ) {
+	var width, minWidth, maxWidth,
+		computed = _computed || getStyles( elem ),
+
+		// Support: IE9
+		// getPropertyValue is only needed for .css('filter') in IE9, see #12537
+		ret = computed ? computed.getPropertyValue( name ) || computed[ name ] : undefined,
+		style = elem.style;
+
+	if ( computed ) {
+
+		if ( ret === "" && !jQuery.contains( elem.ownerDocument, elem ) ) {
+			ret = jQuery.style( elem, name );
+		}
+
+		// Support: Safari 5.1
+		// A tribute to the "awesome hack by Dean Edwards"
+		// Safari 5.1.7 (at least) returns percentage for a larger set of values, but width seems to be reliably pixels
+		// this is against the CSSOM draft spec: http://dev.w3.org/csswg/cssom/#resolved-values
+		if ( rnumnonpx.test( ret ) && rmargin.test( name ) ) {
+
+			// Remember the original values
+			width = style.width;
+			minWidth = style.minWidth;
+			maxWidth = style.maxWidth;
+
+			// Put in the new values to get a computed value out
+			style.minWidth = style.maxWidth = style.width = ret;
+			ret = computed.width;
+
+			// Revert the changed values
+			style.width = width;
+			style.minWidth = minWidth;
+			style.maxWidth = maxWidth;
+		}
+	}
+
+	return ret;
+};
+
+
+function setPositiveNumber( elem, value, subtract ) {
+	var matches = rnumsplit.exec( value );
+	return matches ?
+		// Guard against undefined "subtract", e.g., when used as in cssHooks
+		Math.max( 0, matches[ 1 ] - ( subtract || 0 ) ) + ( matches[ 2 ] || "px" ) :
+		value;
+}
+
+function augmentWidthOrHeight( elem, name, extra, isBorderBox, styles ) {
+	var i = extra === ( isBorderBox ? "border" : "content" ) ?
+		// If we already have the right measurement, avoid augmentation
+		4 :
+		// Otherwise initialize for horizontal or vertical properties
+		name === "width" ? 1 : 0,
+
+		val = 0;
+
+	for ( ; i < 4; i += 2 ) {
+		// both box models exclude margin, so add it if we want it
+		if ( extra === "margin" ) {
+			val += jQuery.css( elem, extra + cssExpand[ i ], true, styles );
+		}
+
+		if ( isBorderBox ) {
+			// border-box includes padding, so remove it if we want content
+			if ( extra === "content" ) {
+				val -= jQuery.css( elem, "padding" + cssExpand[ i ], true, styles );
+			}
+
+			// at this point, extra isn't border nor margin, so remove border
+			if ( extra !== "margin" ) {
+				val -= jQuery.css( elem, "border" + cssExpand[ i ] + "Width", true, styles );
+			}
+		} else {
+			// at this point, extra isn't content, so add padding
+			val += jQuery.css( elem, "padding" + cssExpand[ i ], true, styles );
+
+			// at this point, extra isn't content nor padding, so add border
+			if ( extra !== "padding" ) {
+				val += jQuery.css( elem, "border" + cssExpand[ i ] + "Width", true, styles );
+			}
+		}
+	}
+
+	return val;
+}
+
+function getWidthOrHeight( elem, name, extra ) {
+
+	// Start with offset property, which is equivalent to the border-box value
+	var valueIsBorderBox = true,
+		val = name === "width" ? elem.offsetWidth : elem.offsetHeight,
+		styles = getStyles( elem ),
+		isBorderBox = jQuery.support.boxSizing && jQuery.css( elem, "boxSizing", false, styles ) === "border-box";
+
+	// some non-html elements return undefined for offsetWidth, so check for null/undefined
+	// svg - https://bugzilla.mozilla.org/show_bug.cgi?id=649285
+	// MathML - https://bugzilla.mozilla.org/show_bug.cgi?id=491668
+	if ( val <= 0 || val == null ) {
+		// Fall back to computed then uncomputed css if necessary
+		val = curCSS( elem, name, styles );
+		if ( val < 0 || val == null ) {
+			val = elem.style[ name ];
+		}
+
+		// Computed unit is not pixels. Stop here and return.
+		if ( rnumnonpx.test(val) ) {
+			return val;
+		}
+
+		// we need the check for style in case a browser which returns unreliable values
+		// for getComputedStyle silently falls back to the reliable elem.style
+		valueIsBorderBox = isBorderBox && ( jQuery.support.boxSizingReliable || val === elem.style[ name ] );
+
+		// Normalize "", auto, and prepare for extra
+		val = parseFloat( val ) || 0;
+	}
+
+	// use the active box-sizing model to add/subtract irrelevant styles
+	return ( val +
+		augmentWidthOrHeight(
+			elem,
+			name,
+			extra || ( isBorderBox ? "border" : "content" ),
+			valueIsBorderBox,
+			styles
+		)
+	) + "px";
+}
+
+// Try to determine the default display value of an element
+function css_defaultDisplay( nodeName ) {
+	var doc = document,
+		display = elemdisplay[ nodeName ];
+
+	if ( !display ) {
+		display = actualDisplay( nodeName, doc );
+
+		// If the simple way fails, read from inside an iframe
+		if ( display === "none" || !display ) {
+			// Use the already-created iframe if possible
+			iframe = ( iframe ||
+				jQuery("<iframe frameborder='0' width='0' height='0'/>")
+				.css( "cssText", "display:block !important" )
+			).appendTo( doc.documentElement );
+
+			// Always write a new HTML skeleton so Webkit and Firefox don't choke on reuse
+			doc = ( iframe[0].contentWindow || iframe[0].contentDocument ).document;
+			doc.write("<!doctype html><html><body>");
+			doc.close();
+
+			display = actualDisplay( nodeName, doc );
+			iframe.detach();
+		}
+
+		// Store the correct default display
+		elemdisplay[ nodeName ] = display;
+	}
+
+	return display;
+}
+
+// Called ONLY from within css_defaultDisplay
+function actualDisplay( name, doc ) {
+	var elem = jQuery( doc.createElement( name ) ).appendTo( doc.body ),
+		display = jQuery.css( elem[0], "display" );
+	elem.remove();
+	return display;
+}
+
+jQuery.each([ "height", "width" ], function( i, name ) {
+	jQuery.cssHooks[ name ] = {
+		get: function( elem, computed, extra ) {
+			if ( computed ) {
+				// certain elements can have dimension info if we invisibly show them
+				// however, it must have a current display style that would benefit from this
+				return elem.offsetWidth === 0 && rdisplayswap.test( jQuery.css( elem, "display" ) ) ?
+					jQuery.swap( elem, cssShow, function() {
+						return getWidthOrHeight( elem, name, extra );
+					}) :
+					getWidthOrHeight( elem, name, extra );
+			}
+		},
+
+		set: function( elem, value, extra ) {
+			var styles = extra && getStyles( elem );
+			return setPositiveNumber( elem, value, extra ?
+				augmentWidthOrHeight(
+					elem,
+					name,
+					extra,
+					jQuery.support.boxSizing && jQuery.css( elem, "boxSizing", false, styles ) === "border-box",
+					styles
+				) : 0
+			);
+		}
+	};
+});
+
+// These hooks cannot be added until DOM ready because the support test
+// for it is not run until after DOM ready
+jQuery(function() {
+	// Support: Android 2.3
+	if ( !jQuery.support.reliableMarginRight ) {
+		jQuery.cssHooks.marginRight = {
+			get: function( elem, computed ) {
+				if ( computed ) {
+					// Support: Android 2.3
+					// WebKit Bug 13343 - getComputedStyle returns wrong value for margin-right
+					// Work around by temporarily setting element display to inline-block
+					return jQuery.swap( elem, { "display": "inline-block" },
+						curCSS, [ elem, "marginRight" ] );
+				}
+			}
+		};
+	}
+
+	// Webkit bug: https://bugs.webkit.org/show_bug.cgi?id=29084
+	// getComputedStyle returns percent when specified for top/left/bottom/right
+	// rather than make the css module depend on the offset module, we just check for it here
+	if ( !jQuery.support.pixelPosition && jQuery.fn.position ) {
+		jQuery.each( [ "top", "left" ], function( i, prop ) {
+			jQuery.cssHooks[ prop ] = {
+				get: function( elem, computed ) {
+					if ( computed ) {
+						computed = curCSS( elem, prop );
+						// if curCSS returns percentage, fallback to offset
+						return rnumnonpx.test( computed ) ?
+							jQuery( elem ).position()[ prop ] + "px" :
+							computed;
+					}
+				}
+			};
+		});
+	}
+
+});
+
+if ( jQuery.expr && jQuery.expr.filters ) {
+	jQuery.expr.filters.hidden = function( elem ) {
+		// Support: Opera <= 12.12
+		// Opera reports offsetWidths and offsetHeights less than zero on some elements
+		return elem.offsetWidth <= 0 && elem.offsetHeight <= 0;
+	};
+
+	jQuery.expr.filters.visible = function( elem ) {
+		return !jQuery.expr.filters.hidden( elem );
+	};
+}
+
+// These hooks are used by animate to expand properties
+jQuery.each({
+	margin: "",
+	padding: "",
+	border: "Width"
+}, function( prefix, suffix ) {
+	jQuery.cssHooks[ prefix + suffix ] = {
+		expand: function( value ) {
+			var i = 0,
+				expanded = {},
+
+				// assumes a single number if not a string
+				parts = typeof value === "string" ? value.split(" ") : [ value ];
+
+			for ( ; i < 4; i++ ) {
+				expanded[ prefix + cssExpand[ i ] + suffix ] =
+					parts[ i ] || parts[ i - 2 ] || parts[ 0 ];
+			}
+
+			return expanded;
+		}
+	};
+
+	if ( !rmargin.test( prefix ) ) {
+		jQuery.cssHooks[ prefix + suffix ].set = setPositiveNumber;
+	}
+});
+var r20 = /%20/g,
+	rbracket = /\[\]$/,
+	rCRLF = /\r?\n/g,
+	rsubmitterTypes = /^(?:submit|button|image|reset|file)$/i,
+	rsubmittable = /^(?:input|select|textarea|keygen)/i;
+
+jQuery.fn.extend({
+	serialize: function() {
+		return jQuery.param( this.serializeArray() );
+	},
+	serializeArray: function() {
+		return this.map(function(){
+			// Can add propHook for "elements" to filter or add form elements
+			var elements = jQuery.prop( this, "elements" );
+			return elements ? jQuery.makeArray( elements ) : this;
+		})
+		.filter(function(){
+			var type = this.type;
+			// Use .is(":disabled") so that fieldset[disabled] works
+			return this.name && !jQuery( this ).is( ":disabled" ) &&
+				rsubmittable.test( this.nodeName ) && !rsubmitterTypes.test( type ) &&
+				( this.checked || !manipulation_rcheckableType.test( type ) );
+		})
+		.map(function( i, elem ){
+			var val = jQuery( this ).val();
+
+			return val == null ?
+				null :
+				jQuery.isArray( val ) ?
+					jQuery.map( val, function( val ){
+						return { name: elem.name, value: val.replace( rCRLF, "\r\n" ) };
+					}) :
+					{ name: elem.name, value: val.replace( rCRLF, "\r\n" ) };
+		}).get();
+	}
+});
+
+//Serialize an array of form elements or a set of
+//key/values into a query string
+jQuery.param = function( a, traditional ) {
+	var prefix,
+		s = [],
+		add = function( key, value ) {
+			// If value is a function, invoke it and return its value
+			value = jQuery.isFunction( value ) ? value() : ( value == null ? "" : value );
+			s[ s.length ] = encodeURIComponent( key ) + "=" + encodeURIComponent( value );
+		};
+
+	// Set traditional to true for jQuery <= 1.3.2 behavior.
+	if ( traditional === undefined ) {
+		traditional = jQuery.ajaxSettings && jQuery.ajaxSettings.traditional;
+	}
+
+	// If an array was passed in, assume that it is an array of form elements.
+	if ( jQuery.isArray( a ) || ( a.jquery && !jQuery.isPlainObject( a ) ) ) {
+		// Serialize the form elements
+		jQuery.each( a, function() {
+			add( this.name, this.value );
+		});
+
+	} else {
+		// If traditional, encode the "old" way (the way 1.3.2 or older
+		// did it), otherwise encode params recursively.
+		for ( prefix in a ) {
+			buildParams( prefix, a[ prefix ], traditional, add );
+		}
+	}
+
+	// Return the resulting serialization
+	return s.join( "&" ).replace( r20, "+" );
+};
+
+function buildParams( prefix, obj, traditional, add ) {
+	var name;
+
+	if ( jQuery.isArray( obj ) ) {
+		// Serialize array item.
+		jQuery.each( obj, function( i, v ) {
+			if ( traditional || rbracket.test( prefix ) ) {
+				// Treat each array item as a scalar.
+				add( prefix, v );
+
+			} else {
+				// Item is non-scalar (array or object), encode its numeric index.
+				buildParams( prefix + "[" + ( typeof v === "object" ? i : "" ) + "]", v, traditional, add );
+			}
+		});
+
+	} else if ( !traditional && jQuery.type( obj ) === "object" ) {
+		// Serialize object item.
+		for ( name in obj ) {
+			buildParams( prefix + "[" + name + "]", obj[ name ], traditional, add );
+		}
+
+	} else {
+		// Serialize scalar item.
+		add( prefix, obj );
+	}
+}
+jQuery.each( ("blur focus focusin focusout load resize scroll unload click dblclick " +
+	"mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave " +
+	"change select submit keydown keypress keyup error contextmenu").split(" "), function( i, name ) {
+
+	// Handle event binding
+	jQuery.fn[ name ] = function( data, fn ) {
+		return arguments.length > 0 ?
+			this.on( name, null, data, fn ) :
+			this.trigger( name );
+	};
+});
+
+jQuery.fn.extend({
+	hover: function( fnOver, fnOut ) {
+		return this.mouseenter( fnOver ).mouseleave( fnOut || fnOver );
+	},
+
+	bind: function( types, data, fn ) {
+		return this.on( types, null, data, fn );
+	},
+	unbind: function( types, fn ) {
+		return this.off( types, null, fn );
+	},
+
+	delegate: function( selector, types, data, fn ) {
+		return this.on( types, selector, data, fn );
+	},
+	undelegate: function( selector, types, fn ) {
+		// ( namespace ) or ( selector, types [, fn] )
+		return arguments.length === 1 ? this.off( selector, "**" ) : this.off( types, selector || "**", fn );
+	}
+});
+var
+	// Document location
+	ajaxLocParts,
+	ajaxLocation,
+
+	ajax_nonce = jQuery.now(),
+
+	ajax_rquery = /\?/,
+	rhash = /#.*$/,
+	rts = /([?&])_=[^&]*/,
+	rheaders = /^(.*?):[ \t]*([^\r\n]*)$/mg,
+	// #7653, #8125, #8152: local protocol detection
+	rlocalProtocol = /^(?:about|app|app-storage|.+-extension|file|res|widget):$/,
+	rnoContent = /^(?:GET|HEAD)$/,
+	rprotocol = /^\/\//,
+	rurl = /^([\w.+-]+:)(?:\/\/([^\/?#:]*)(?::(\d+)|)|)/,
+
+	// Keep a copy of the old load method
+	_load = jQuery.fn.load,
+
+	/* Prefilters
+	 * 1) They are useful to introduce custom dataTypes (see ajax/jsonp.js for an example)
+	 * 2) These are called:
+	 *    - BEFORE asking for a transport
+	 *    - AFTER param serialization (s.data is a string if s.processData is true)
+	 * 3) key is the dataType
+	 * 4) the catchall symbol "*" can be used
+	 * 5) execution will start with transport dataType and THEN continue down to "*" if needed
+	 */
+	prefilters = {},
+
+	/* Transports bindings
+	 * 1) key is the dataType
+	 * 2) the catchall symbol "*" can be used
+	 * 3) selection will start with transport dataType and THEN go to "*" if needed
+	 */
+	transports = {},
+
+	// Avoid comment-prolog char sequence (#10098); must appease lint and evade compression
+	allTypes = "*/".concat("*");
+
+// #8138, IE may throw an exception when accessing
+// a field from window.location if document.domain has been set
+try {
+	ajaxLocation = location.href;
+} catch( e ) {
+	// Use the href attribute of an A element
+	// since IE will modify it given document.location
+	ajaxLocation = document.createElement( "a" );
+	ajaxLocation.href = "";
+	ajaxLocation = ajaxLocation.href;
+}
+
+// Segment location into parts
+ajaxLocParts = rurl.exec( ajaxLocation.toLowerCase() ) || [];
+
+// Base "constructor" for jQuery.ajaxPrefilter and jQuery.ajaxTransport
+function addToPrefiltersOrTransports( structure ) {
+
+	// dataTypeExpression is optional and defaults to "*"
+	return function( dataTypeExpression, func ) {
+
+		if ( typeof dataTypeExpression !== "string" ) {
+			func = dataTypeExpression;
+			dataTypeExpression = "*";
+		}
+
+		var dataType,
+			i = 0,
+			dataTypes = dataTypeExpression.toLowerCase().match( core_rnotwhite ) || [];
+
+		if ( jQuery.isFunction( func ) ) {
+			// For each dataType in the dataTypeExpression
+			while ( (dataType = dataTypes[i++]) ) {
+				// Prepend if requested
+				if ( dataType[0] === "+" ) {
+					dataType = dataType.slice( 1 ) || "*";
+					(structure[ dataType ] = structure[ dataType ] || []).unshift( func );
+
+				// Otherwise append
+				} else {
+					(structure[ dataType ] = structure[ dataType ] || []).push( func );
+				}
+			}
+		}
+	};
+}
+
+// Base inspection function for prefilters and transports
+function inspectPrefiltersOrTransports( structure, options, originalOptions, jqXHR ) {
+
+	var inspected = {},
+		seekingTransport = ( structure === transports );
+
+	function inspect( dataType ) {
+		var selected;
+		inspected[ dataType ] = true;
+		jQuery.each( structure[ dataType ] || [], function( _, prefilterOrFactory ) {
+			var dataTypeOrTransport = prefilterOrFactory( options, originalOptions, jqXHR );
+			if( typeof dataTypeOrTransport === "string" && !seekingTransport && !inspected[ dataTypeOrTransport ] ) {
+				options.dataTypes.unshift( dataTypeOrTransport );
+				inspect( dataTypeOrTransport );
+				return false;
+			} else if ( seekingTransport ) {
+				return !( selected = dataTypeOrTransport );
+			}
+		});
+		return selected;
+	}
+
+	return inspect( options.dataTypes[ 0 ] ) || !inspected[ "*" ] && inspect( "*" );
+}
+
+// A special extend for ajax options
+// that takes "flat" options (not to be deep extended)
+// Fixes #9887
+function ajaxExtend( target, src ) {
+	var key, deep,
+		flatOptions = jQuery.ajaxSettings.flatOptions || {};
+
+	for ( key in src ) {
+		if ( src[ key ] !== undefined ) {
+			( flatOptions[ key ] ? target : ( deep || (deep = {}) ) )[ key ] = src[ key ];
+		}
+	}
+	if ( deep ) {
+		jQuery.extend( true, target, deep );
+	}
+
+	return target;
+}
+
+jQuery.fn.load = function( url, params, callback ) {
+	if ( typeof url !== "string" && _load ) {
+		return _load.apply( this, arguments );
+	}
+
+	var selector, type, response,
+		self = this,
+		off = url.indexOf(" ");
+
+	if ( off >= 0 ) {
+		selector = url.slice( off );
+		url = url.slice( 0, off );
+	}
+
+	// If it's a function
+	if ( jQuery.isFunction( params ) ) {
+
+		// We assume that it's the callback
+		callback = params;
+		params = undefined;
+
+	// Otherwise, build a param string
+	} else if ( params && typeof params === "object" ) {
+		type = "POST";
+	}
+
+	// If we have elements to modify, make the request
+	if ( self.length > 0 ) {
+		jQuery.ajax({
+			url: url,
+
+			// if "type" variable is undefined, then "GET" method will be used
+			type: type,
+			dataType: "html",
+			data: params
+		}).done(function( responseText ) {
+
+			// Save response for use in complete callback
+			response = arguments;
+
+			self.html( selector ?
+
+				// If a selector was specified, locate the right elements in a dummy div
+				// Exclude scripts to avoid IE 'Permission Denied' errors
+				jQuery("<div>").append( jQuery.parseHTML( responseText ) ).find( selector ) :
+
+				// Otherwise use the full result
+				responseText );
+
+		}).complete( callback && function( jqXHR, status ) {
+			self.each( callback, response || [ jqXHR.responseText, status, jqXHR ] );
+		});
+	}
+
+	return this;
+};
+
+// Attach a bunch of functions for handling common AJAX events
+jQuery.each( [ "ajaxStart", "ajaxStop", "ajaxComplete", "ajaxError", "ajaxSuccess", "ajaxSend" ], function( i, type ){
+	jQuery.fn[ type ] = function( fn ){
+		return this.on( type, fn );
+	};
+});
+
+jQuery.extend({
+
+	// Counter for holding the number of active queries
+	active: 0,
+
+	// Last-Modified header cache for next request
+	lastModified: {},
+	etag: {},
+
+	ajaxSettings: {
+		url: ajaxLocation,
+		type: "GET",
+		isLocal: rlocalProtocol.test( ajaxLocParts[ 1 ] ),
+		global: true,
+		processData: true,
+		async: true,
+		contentType: "application/x-www-form-urlencoded; charset=UTF-8",
+		/*
+		timeout: 0,
+		data: null,
+		dataType: null,
+		username: null,
+		password: null,
+		cache: null,
+		throws: false,
+		traditional: false,
+		headers: {},
+		*/
+
+		accepts: {
+			"*": allTypes,
+			text: "text/plain",
+			html: "text/html",
+			xml: "application/xml, text/xml",
+			json: "application/json, text/javascript"
+		},
+
+		contents: {
+			xml: /xml/,
+			html: /html/,
+			json: /json/
+		},
+
+		responseFields: {
+			xml: "responseXML",
+			text: "responseText",
+			json: "responseJSON"
+		},
+
+		// Data converters
+		// Keys separate source (or catchall "*") and destination types with a single space
+		converters: {
+
+			// Convert anything to text
+			"* text": String,
+
+			// Text to html (true = no transformation)
+			"text html": true,
+
+			// Evaluate text as a json expression
+			"text json": jQuery.parseJSON,
+
+			// Parse text as xml
+			"text xml": jQuery.parseXML
+		},
+
+		// For options that shouldn't be deep extended:
+		// you can add your own custom options here if
+		// and when you create one that shouldn't be
+		// deep extended (see ajaxExtend)
+		flatOptions: {
+			url: true,
+			context: true
+		}
+	},
+
+	// Creates a full fledged settings object into target
+	// with both ajaxSettings and settings fields.
+	// If target is omitted, writes into ajaxSettings.
+	ajaxSetup: function( target, settings ) {
+		return settings ?
+
+			// Building a settings object
+			ajaxExtend( ajaxExtend( target, jQuery.ajaxSettings ), settings ) :
+
+			// Extending ajaxSettings
+			ajaxExtend( jQuery.ajaxSettings, target );
+	},
+
+	ajaxPrefilter: addToPrefiltersOrTransports( prefilters ),
+	ajaxTransport: addToPrefiltersOrTransports( transports ),
+
+	// Main method
+	ajax: function( url, options ) {
+
+		// If url is an object, simulate pre-1.5 signature
+		if ( typeof url === "object" ) {
+			options = url;
+			url = undefined;
+		}
+
+		// Force options to be an object
+		options = options || {};
+
+		var transport,
+			// URL without anti-cache param
+			cacheURL,
+			// Response headers
+			responseHeadersString,
+			responseHeaders,
+			// timeout handle
+			timeoutTimer,
+			// Cross-domain detection vars
+			parts,
+			// To know if global events are to be dispatched
+			fireGlobals,
+			// Loop variable
+			i,
+			// Create the final options object
+			s = jQuery.ajaxSetup( {}, options ),
+			// Callbacks context
+			callbackContext = s.context || s,
+			// Context for global events is callbackContext if it is a DOM node or jQuery collection
+			globalEventContext = s.context && ( callbackContext.nodeType || callbackContext.jquery ) ?
+				jQuery( callbackContext ) :
+				jQuery.event,
+			// Deferreds
+			deferred = jQuery.Deferred(),
+			completeDeferred = jQuery.Callbacks("once memory"),
+			// Status-dependent callbacks
+			statusCode = s.statusCode || {},
+			// Headers (they are sent all at once)
+			requestHeaders = {},
+			requestHeadersNames = {},
+			// The jqXHR state
+			state = 0,
+			// Default abort message
+			strAbort = "canceled",
+			// Fake xhr
+			jqXHR = {
+				readyState: 0,
+
+				// Builds headers hashtable if needed
+				getResponseHeader: function( key ) {
+					var match;
+					if ( state === 2 ) {
+						if ( !responseHeaders ) {
+							responseHeaders = {};
+							while ( (match = rheaders.exec( responseHeadersString )) ) {
+								responseHeaders[ match[1].toLowerCase() ] = match[ 2 ];
+							}
+						}
+						match = responseHeaders[ key.toLowerCase() ];
+					}
+					return match == null ? null : match;
+				},
+
+				// Raw string
+				getAllResponseHeaders: function() {
+					return state === 2 ? responseHeadersString : null;
+				},
+
+				// Caches the header
+				setRequestHeader: function( name, value ) {
+					var lname = name.toLowerCase();
+					if ( !state ) {
+						name = requestHeadersNames[ lname ] = requestHeadersNames[ lname ] || name;
+						requestHeaders[ name ] = value;
+					}
+					return this;
+				},
+
+				// Overrides response content-type header
+				overrideMimeType: function( type ) {
+					if ( !state ) {
+						s.mimeType = type;
+					}
+					return this;
+				},
+
+				// Status-dependent callbacks
+				statusCode: function( map ) {
+					var code;
+					if ( map ) {
+						if ( state < 2 ) {
+							for ( code in map ) {
+								// Lazy-add the new callback in a way that preserves old ones
+								statusCode[ code ] = [ statusCode[ code ], map[ code ] ];
+							}
+						} else {
+							// Execute the appropriate callbacks
+							jqXHR.always( map[ jqXHR.status ] );
+						}
+					}
+					return this;
+				},
+
+				// Cancel the request
+				abort: function( statusText ) {
+					var finalText = statusText || strAbort;
+					if ( transport ) {
+						transport.abort( finalText );
+					}
+					done( 0, finalText );
+					return this;
+				}
+			};
+
+		// Attach deferreds
+		deferred.promise( jqXHR ).complete = completeDeferred.add;
+		jqXHR.success = jqXHR.done;
+		jqXHR.error = jqXHR.fail;
+
+		// Remove hash character (#7531: and string promotion)
+		// Add protocol if not provided (prefilters might expect it)
+		// Handle falsy url in the settings object (#10093: consistency with old signature)
+		// We also use the url parameter if available
+		s.url = ( ( url || s.url || ajaxLocation ) + "" ).replace( rhash, "" )
+			.replace( rprotocol, ajaxLocParts[ 1 ] + "//" );
+
+		// Alias method option to type as per ticket #12004
+		s.type = options.method || options.type || s.method || s.type;
+
+		// Extract dataTypes list
+		s.dataTypes = jQuery.trim( s.dataType || "*" ).toLowerCase().match( core_rnotwhite ) || [""];
+
+		// A cross-domain request is in order when we have a protocol:host:port mismatch
+		if ( s.crossDomain == null ) {
+			parts = rurl.exec( s.url.toLowerCase() );
+			s.crossDomain = !!( parts &&
+				( parts[ 1 ] !== ajaxLocParts[ 1 ] || parts[ 2 ] !== ajaxLocParts[ 2 ] ||
+					( parts[ 3 ] || ( parts[ 1 ] === "http:" ? "80" : "443" ) ) !==
+						( ajaxLocParts[ 3 ] || ( ajaxLocParts[ 1 ] === "http:" ? "80" : "443" ) ) )
+			);
+		}
+
+		// Convert data if not already a string
+		if ( s.data && s.processData && typeof s.data !== "string" ) {
+			s.data = jQuery.param( s.data, s.traditional );
+		}
+
+		// Apply prefilters
+		inspectPrefiltersOrTransports( prefilters, s, options, jqXHR );
+
+		// If request was aborted inside a prefilter, stop there
+		if ( state === 2 ) {
+			return jqXHR;
+		}
+
+		// We can fire global events as of now if asked to
+		fireGlobals = s.global;
+
+		// Watch for a new set of requests
+		if ( fireGlobals && jQuery.active++ === 0 ) {
+			jQuery.event.trigger("ajaxStart");
+		}
+
+		// Uppercase the type
+		s.type = s.type.toUpperCase();
+
+		// Determine if request has content
+		s.hasContent = !rnoContent.test( s.type );
+
+		// Save the URL in case we're toying with the If-Modified-Since
+		// and/or If-None-Match header later on
+		cacheURL = s.url;
+
+		// More options handling for requests with no content
+		if ( !s.hasContent ) {
+
+			// If data is available, append data to url
+			if ( s.data ) {
+				cacheURL = ( s.url += ( ajax_rquery.test( cacheURL ) ? "&" : "?" ) + s.data );
+				// #9682: remove data so that it's not used in an eventual retry
+				delete s.data;
+			}
+
+			// Add anti-cache in url if needed
+			if ( s.cache === false ) {
+				s.url = rts.test( cacheURL ) ?
+
+					// If there is already a '_' parameter, set its value
+					cacheURL.replace( rts, "$1_=" + ajax_nonce++ ) :
+
+					// Otherwise add one to the end
+					cacheURL + ( ajax_rquery.test( cacheURL ) ? "&" : "?" ) + "_=" + ajax_nonce++;
+			}
+		}
+
+		// Set the If-Modified-Since and/or If-None-Match header, if in ifModified mode.
+		if ( s.ifModified ) {
+			if ( jQuery.lastModified[ cacheURL ] ) {
+				jqXHR.setRequestHeader( "If-Modified-Since", jQuery.lastModified[ cacheURL ] );
+			}
+			if ( jQuery.etag[ cacheURL ] ) {
+				jqXHR.setRequestHeader( "If-None-Match", jQuery.etag[ cacheURL ] );
+			}
+		}
+
+		// Set the correct header, if data is being sent
+		if ( s.data && s.hasContent && s.contentType !== false || options.contentType ) {
+			jqXHR.setRequestHeader( "Content-Type", s.contentType );
+		}
+
+		// Set the Accepts header for the server, depending on the dataType
+		jqXHR.setRequestHeader(
+			"Accept",
+			s.dataTypes[ 0 ] && s.accepts[ s.dataTypes[0] ] ?
+				s.accepts[ s.dataTypes[0] ] + ( s.dataTypes[ 0 ] !== "*" ? ", " + allTypes + "; q=0.01" : "" ) :
+				s.accepts[ "*" ]
+		);
+
+		// Check for headers option
+		for ( i in s.headers ) {
+			jqXHR.setRequestHeader( i, s.headers[ i ] );
+		}
+
+		// Allow custom headers/mimetypes and early abort
+		if ( s.beforeSend && ( s.beforeSend.call( callbackContext, jqXHR, s ) === false || state === 2 ) ) {
+			// Abort if not done already and return
+			return jqXHR.abort();
+		}
+
+		// aborting is no longer a cancellation
+		strAbort = "abort";
+
+		// Install callbacks on deferreds
+		for ( i in { success: 1, error: 1, complete: 1 } ) {
+			jqXHR[ i ]( s[ i ] );
+		}
+
+		// Get transport
+		transport = inspectPrefiltersOrTransports( transports, s, options, jqXHR );
+
+		// If no transport, we auto-abort
+		if ( !transport ) {
+			done( -1, "No Transport" );
+		} else {
+			jqXHR.readyState = 1;
+
+			// Send global event
+			if ( fireGlobals ) {
+				globalEventContext.trigger( "ajaxSend", [ jqXHR, s ] );
+			}
+			// Timeout
+			if ( s.async && s.timeout > 0 ) {
+				timeoutTimer = setTimeout(function() {
+					jqXHR.abort("timeout");
+				}, s.timeout );
+			}
+
+			try {
+				state = 1;
+				transport.send( requestHeaders, done );
+			} catch ( e ) {
+				// Propagate exception as error if not done
+				if ( state < 2 ) {
+					done( -1, e );
+				// Simply rethrow otherwise
+				} else {
+					throw e;
+				}
+			}
+		}
+
+		// Callback for when everything is done
+		function done( status, nativeStatusText, responses, headers ) {
+			var isSuccess, success, error, response, modified,
+				statusText = nativeStatusText;
+
+			// Called once
+			if ( state === 2 ) {
+				return;
+			}
+
+			// State is "done" now
+			state = 2;
+
+			// Clear timeout if it exists
+			if ( timeoutTimer ) {
+				clearTimeout( timeoutTimer );
+			}
+
+			// Dereference transport for early garbage collection
+			// (no matter how long the jqXHR object will be used)
+			transport = undefined;
+
+			// Cache response headers
+			responseHeadersString = headers || "";
+
+			// Set readyState
+			jqXHR.readyState = status > 0 ? 4 : 0;
+
+			// Determine if successful
+			isSuccess = status >= 200 && status < 300 || status === 304;
+
+			// Get response data
+			if ( responses ) {
+				response = ajaxHandleResponses( s, jqXHR, responses );
+			}
+
+			// Convert no matter what (that way responseXXX fields are always set)
+			response = ajaxConvert( s, response, jqXHR, isSuccess );
+
+			// If successful, handle type chaining
+			if ( isSuccess ) {
+
+				// Set the If-Modified-Since and/or If-None-Match header, if in ifModified mode.
+				if ( s.ifModified ) {
+					modified = jqXHR.getResponseHeader("Last-Modified");
+					if ( modified ) {
+						jQuery.lastModified[ cacheURL ] = modified;
+					}
+					modified = jqXHR.getResponseHeader("etag");
+					if ( modified ) {
+						jQuery.etag[ cacheURL ] = modified;
+					}
+				}
+
+				// if no content
+				if ( status === 204 || s.type === "HEAD" ) {
+					statusText = "nocontent";
+
+				// if not modified
+				} else if ( status === 304 ) {
+					statusText = "notmodified";
+
+				// If we have data, let's convert it
+				} else {
+					statusText = response.state;
+					success = response.data;
+					error = response.error;
+					isSuccess = !error;
+				}
+			} else {
+				// We extract error from statusText
+				// then normalize statusText and status for non-aborts
+				error = statusText;
+				if ( status || !statusText ) {
+					statusText = "error";
+					if ( status < 0 ) {
+						status = 0;
+					}
+				}
+			}
+
+			// Set data for the fake xhr object
+			jqXHR.status = status;
+			jqXHR.statusText = ( nativeStatusText || statusText ) + "";
+
+			// Success/Error
+			if ( isSuccess ) {
+				deferred.resolveWith( callbackContext, [ success, statusText, jqXHR ] );
+			} else {
+				deferred.rejectWith( callbackContext, [ jqXHR, statusText, error ] );
+			}
+
+			// Status-dependent callbacks
+			jqXHR.statusCode( statusCode );
+			statusCode = undefined;
+
+			if ( fireGlobals ) {
+				globalEventContext.trigger( isSuccess ? "ajaxSuccess" : "ajaxError",
+					[ jqXHR, s, isSuccess ? success : error ] );
+			}
+
+			// Complete
+			completeDeferred.fireWith( callbackContext, [ jqXHR, statusText ] );
+
+			if ( fireGlobals ) {
+				globalEventContext.trigger( "ajaxComplete", [ jqXHR, s ] );
+				// Handle the global AJAX counter
+				if ( !( --jQuery.active ) ) {
+					jQuery.event.trigger("ajaxStop");
+				}
+			}
+		}
+
+		return jqXHR;
+	},
+
+	getJSON: function( url, data, callback ) {
+		return jQuery.get( url, data, callback, "json" );
+	},
+
+	getScript: function( url, callback ) {
+		return jQuery.get( url, undefined, callback, "script" );
+	}
+});
+
+jQuery.each( [ "get", "post" ], function( i, method ) {
+	jQuery[ method ] = function( url, data, callback, type ) {
+		// shift arguments if data argument was omitted
+		if ( jQuery.isFunction( data ) ) {
+			type = type || callback;
+			callback = data;
+			data = undefined;
+		}
+
+		return jQuery.ajax({
+			url: url,
+			type: method,
+			dataType: type,
+			data: data,
+			success: callback
+		});
+	};
+});
+
+/* Handles responses to an ajax request:
+ * - finds the right dataType (mediates between content-type and expected dataType)
+ * - returns the corresponding response
+ */
+function ajaxHandleResponses( s, jqXHR, responses ) {
+
+	var ct, type, finalDataType, firstDataType,
+		contents = s.contents,
+		dataTypes = s.dataTypes;
+
+	// Remove auto dataType and get content-type in the process
+	while( dataTypes[ 0 ] === "*" ) {
+		dataTypes.shift();
+		if ( ct === undefined ) {
+			ct = s.mimeType || jqXHR.getResponseHeader("Content-Type");
+		}
+	}
+
+	// Check if we're dealing with a known content-type
+	if ( ct ) {
+		for ( type in contents ) {
+			if ( contents[ type ] && contents[ type ].test( ct ) ) {
+				dataTypes.unshift( type );
+				break;
+			}
+		}
+	}
+
+	// Check to see if we have a response for the expected dataType
+	if ( dataTypes[ 0 ] in responses ) {
+		finalDataType = dataTypes[ 0 ];
+	} else {
+		// Try convertible dataTypes
+		for ( type in responses ) {
+			if ( !dataTypes[ 0 ] || s.converters[ type + " " + dataTypes[0] ] ) {
+				finalDataType = type;
+				break;
+			}
+			if ( !firstDataType ) {
+				firstDataType = type;
+			}
+		}
+		// Or just use first one
+		finalDataType = finalDataType || firstDataType;
+	}
+
+	// If we found a dataType
+	// We add the dataType to the list if needed
+	// and return the corresponding response
+	if ( finalDataType ) {
+		if ( finalDataType !== dataTypes[ 0 ] ) {
+			dataTypes.unshift( finalDataType );
+		}
+		return responses[ finalDataType ];
+	}
+}
+
+/* Chain conversions given the request and the original response
+ * Also sets the responseXXX fields on the jqXHR instance
+ */
+function ajaxConvert( s, response, jqXHR, isSuccess ) {
+	var conv2, current, conv, tmp, prev,
+		converters = {},
+		// Work with a copy of dataTypes in case we need to modify it for conversion
+		dataTypes = s.dataTypes.slice();
+
+	// Create converters map with lowercased keys
+	if ( dataTypes[ 1 ] ) {
+		for ( conv in s.converters ) {
+			converters[ conv.toLowerCase() ] = s.converters[ conv ];
+		}
+	}
+
+	current = dataTypes.shift();
+
+	// Convert to each sequential dataType
+	while ( current ) {
+
+		if ( s.responseFields[ current ] ) {
+			jqXHR[ s.responseFields[ current ] ] = response;
+		}
+
+		// Apply the dataFilter if provided
+		if ( !prev && isSuccess && s.dataFilter ) {
+			response = s.dataFilter( response, s.dataType );
+		}
+
+		prev = current;
+		current = dataTypes.shift();
+
+		if ( current ) {
+
+		// There's only work to do if current dataType is non-auto
+			if ( current === "*" ) {
+
+				current = prev;
+
+			// Convert response if prev dataType is non-auto and differs from current
+			} else if ( prev !== "*" && prev !== current ) {
+
+				// Seek a direct converter
+				conv = converters[ prev + " " + current ] || converters[ "* " + current ];
+
+				// If none found, seek a pair
+				if ( !conv ) {
+					for ( conv2 in converters ) {
+
+						// If conv2 outputs current
+						tmp = conv2.split( " " );
+						if ( tmp[ 1 ] === current ) {
+
+							// If prev can be converted to accepted input
+							conv = converters[ prev + " " + tmp[ 0 ] ] ||
+								converters[ "* " + tmp[ 0 ] ];
+							if ( conv ) {
+								// Condense equivalence converters
+								if ( conv === true ) {
+									conv = converters[ conv2 ];
+
+								// Otherwise, insert the intermediate dataType
+								} else if ( converters[ conv2 ] !== true ) {
+									current = tmp[ 0 ];
+									dataTypes.unshift( tmp[ 1 ] );
+								}
+								break;
+							}
+						}
+					}
+				}
+
+				// Apply converter (if not an equivalence)
+				if ( conv !== true ) {
+
+					// Unless errors are allowed to bubble, catch and return them
+					if ( conv && s[ "throws" ] ) {
+						response = conv( response );
+					} else {
+						try {
+							response = conv( response );
+						} catch ( e ) {
+							return { state: "parsererror", error: conv ? e : "No conversion from " + prev + " to " + current };
+						}
+					}
+				}
+			}
+		}
+	}
+
+	return { state: "success", data: response };
+}
+// Install script dataType
+jQuery.ajaxSetup({
+	accepts: {
+		script: "text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"
+	},
+	contents: {
+		script: /(?:java|ecma)script/
+	},
+	converters: {
+		"text script": function( text ) {
+			jQuery.globalEval( text );
+			return text;
+		}
+	}
+});
+
+// Handle cache's special case and crossDomain
+jQuery.ajaxPrefilter( "script", function( s ) {
+	if ( s.cache === undefined ) {
+		s.cache = false;
+	}
+	if ( s.crossDomain ) {
+		s.type = "GET";
+	}
+});
+
+// Bind script tag hack transport
+jQuery.ajaxTransport( "script", function( s ) {
+	// This transport only deals with cross domain requests
+	if ( s.crossDomain ) {
+		var script, callback;
+		return {
+			send: function( _, complete ) {
+				script = jQuery("<script>").prop({
+					async: true,
+					charset: s.scriptCharset,
+					src: s.url
+				}).on(
+					"load error",
+					callback = function( evt ) {
+						script.remove();
+						callback = null;
+						if ( evt ) {
+							complete( evt.type === "error" ? 404 : 200, evt.type );
+						}
+					}
+				);
+				document.head.appendChild( script[ 0 ] );
+			},
+			abort: function() {
+				if ( callback ) {
+					callback();
+				}
+			}
+		};
+	}
+});
+var oldCallbacks = [],
+	rjsonp = /(=)\?(?=&|$)|\?\?/;
+
+// Default jsonp settings
+jQuery.ajaxSetup({
+	jsonp: "callback",
+	jsonpCallback: function() {
+		var callback = oldCallbacks.pop() || ( jQuery.expando + "_" + ( ajax_nonce++ ) );
+		this[ callback ] = true;
+		return callback;
+	}
+});
+
+// Detect, normalize options and install callbacks for jsonp requests
+jQuery.ajaxPrefilter( "json jsonp", function( s, originalSettings, jqXHR ) {
+
+	var callbackName, overwritten, responseContainer,
+		jsonProp = s.jsonp !== false && ( rjsonp.test( s.url ) ?
+			"url" :
+			typeof s.data === "string" && !( s.contentType || "" ).indexOf("application/x-www-form-urlencoded") && rjsonp.test( s.data ) && "data"
+		);
+
+	// Handle iff the expected data type is "jsonp" or we have a parameter to set
+	if ( jsonProp || s.dataTypes[ 0 ] === "jsonp" ) {
+
+		// Get callback name, remembering preexisting value associated with it
+		callbackName = s.jsonpCallback = jQuery.isFunction( s.jsonpCallback ) ?
+			s.jsonpCallback() :
+			s.jsonpCallback;
+
+		// Insert callback into url or form data
+		if ( jsonProp ) {
+			s[ jsonProp ] = s[ jsonProp ].replace( rjsonp, "$1" + callbackName );
+		} else if ( s.jsonp !== false ) {
+			s.url += ( ajax_rquery.test( s.url ) ? "&" : "?" ) + s.jsonp + "=" + callbackName;
+		}
+
+		// Use data converter to retrieve json after script execution
+		s.converters["script json"] = function() {
+			if ( !responseContainer ) {
+				jQuery.error( callbackName + " was not called" );
+			}
+			return responseContainer[ 0 ];
+		};
+
+		// force json dataType
+		s.dataTypes[ 0 ] = "json";
+
+		// Install callback
+		overwritten = window[ callbackName ];
+		window[ callbackName ] = function() {
+			responseContainer = arguments;
+		};
+
+		// Clean-up function (fires after converters)
+		jqXHR.always(function() {
+			// Restore preexisting value
+			window[ callbackName ] = overwritten;
+
+			// Save back as free
+			if ( s[ callbackName ] ) {
+				// make sure that re-using the options doesn't screw things around
+				s.jsonpCallback = originalSettings.jsonpCallback;
+
+				// save the callback name for future use
+				oldCallbacks.push( callbackName );
+			}
+
+			// Call if it was a function and we have a response
+			if ( responseContainer && jQuery.isFunction( overwritten ) ) {
+				overwritten( responseContainer[ 0 ] );
+			}
+
+			responseContainer = overwritten = undefined;
+		});
+
+		// Delegate to script
+		return "script";
+	}
+});
+jQuery.ajaxSettings.xhr = function() {
+	try {
+		return new XMLHttpRequest();
+	} catch( e ) {}
+};
+
+var xhrSupported = jQuery.ajaxSettings.xhr(),
+	xhrSuccessStatus = {
+		// file protocol always yields status code 0, assume 200
+		0: 200,
+		// Support: IE9
+		// #1450: sometimes IE returns 1223 when it should be 204
+		1223: 204
+	},
+	// Support: IE9
+	// We need to keep track of outbound xhr and abort them manually
+	// because IE is not smart enough to do it all by itself
+	xhrId = 0,
+	xhrCallbacks = {};
+
+if ( window.ActiveXObject ) {
+	jQuery( window ).on( "unload", function() {
+		for( var key in xhrCallbacks ) {
+			xhrCallbacks[ key ]();
+		}
+		xhrCallbacks = undefined;
+	});
+}
+
+jQuery.support.cors = !!xhrSupported && ( "withCredentials" in xhrSupported );
+jQuery.support.ajax = xhrSupported = !!xhrSupported;
+
+jQuery.ajaxTransport(function( options ) {
+	var callback;
+	// Cross domain only allowed if supported through XMLHttpRequest
+	if ( jQuery.support.cors || xhrSupported && !options.crossDomain ) {
+		return {
+			send: function( headers, complete ) {
+				var i, id,
+					xhr = options.xhr();
+				xhr.open( options.type, options.url, options.async, options.username, options.password );
+				// Apply custom fields if provided
+				if ( options.xhrFields ) {
+					for ( i in options.xhrFields ) {
+						xhr[ i ] = options.xhrFields[ i ];
+					}
+				}
+				// Override mime type if needed
+				if ( options.mimeType && xhr.overrideMimeType ) {
+					xhr.overrideMimeType( options.mimeType );
+				}
+				// X-Requested-With header
+				// For cross-domain requests, seeing as conditions for a preflight are
+				// akin to a jigsaw puzzle, we simply never set it to be sure.
+				// (it can always be set on a per-request basis or even using ajaxSetup)
+				// For same-domain requests, won't change header if already provided.
+				if ( !options.crossDomain && !headers["X-Requested-With"] ) {
+					headers["X-Requested-With"] = "XMLHttpRequest";
+				}
+				// Set headers
+				for ( i in headers ) {
+					xhr.setRequestHeader( i, headers[ i ] );
+				}
+				// Callback
+				callback = function( type ) {
+					return function() {
+						if ( callback ) {
+							delete xhrCallbacks[ id ];
+							callback = xhr.onload = xhr.onerror = null;
+							if ( type === "abort" ) {
+								xhr.abort();
+							} else if ( type === "error" ) {
+								complete(
+									// file protocol always yields status 0, assume 404
+									xhr.status || 404,
+									xhr.statusText
+								);
+							} else {
+								complete(
+									xhrSuccessStatus[ xhr.status ] || xhr.status,
+									xhr.statusText,
+									// Support: IE9
+									// #11426: When requesting binary data, IE9 will throw an exception
+									// on any attempt to access responseText
+									typeof xhr.responseText === "string" ? {
+										text: xhr.responseText
+									} : undefined,
+									xhr.getAllResponseHeaders()
+								);
+							}
+						}
+					};
+				};
+				// Listen to events
+				xhr.onload = callback();
+				xhr.onerror = callback("error");
+				// Create the abort callback
+				callback = xhrCallbacks[( id = xhrId++ )] = callback("abort");
+				// Do send the request
+				// This may raise an exception which is actually
+				// handled in jQuery.ajax (so no try/catch here)
+				xhr.send( options.hasContent && options.data || null );
+			},
+			abort: function() {
+				if ( callback ) {
+					callback();
+				}
+			}
+		};
+	}
+});
+var fxNow, timerId,
+	rfxtypes = /^(?:toggle|show|hide)$/,
+	rfxnum = new RegExp( "^(?:([+-])=|)(" + core_pnum + ")([a-z%]*)$", "i" ),
+	rrun = /queueHooks$/,
+	animationPrefilters = [ defaultPrefilter ],
+	tweeners = {
+		"*": [function( prop, value ) {
+			var tween = this.createTween( prop, value ),
+				target = tween.cur(),
+				parts = rfxnum.exec( value ),
+				unit = parts && parts[ 3 ] || ( jQuery.cssNumber[ prop ] ? "" : "px" ),
+
+				// Starting value computation is required for potential unit mismatches
+				start = ( jQuery.cssNumber[ prop ] || unit !== "px" && +target ) &&
+					rfxnum.exec( jQuery.css( tween.elem, prop ) ),
+				scale = 1,
+				maxIterations = 20;
+
+			if ( start && start[ 3 ] !== unit ) {
+				// Trust units reported by jQuery.css
+				unit = unit || start[ 3 ];
+
+				// Make sure we update the tween properties later on
+				parts = parts || [];
+
+				// Iteratively approximate from a nonzero starting point
+				start = +target || 1;
+
+				do {
+					// If previous iteration zeroed out, double until we get *something*
+					// Use a string for doubling factor so we don't accidentally see scale as unchanged below
+					scale = scale || ".5";
+
+					// Adjust and apply
+					start = start / scale;
+					jQuery.style( tween.elem, prop, start + unit );
+
+				// Update scale, tolerating zero or NaN from tween.cur()
+				// And breaking the loop if scale is unchanged or perfect, or if we've just had enough
+				} while ( scale !== (scale = tween.cur() / target) && scale !== 1 && --maxIterations );
+			}
+
+			// Update tween properties
+			if ( parts ) {
+				start = tween.start = +start || +target || 0;
+				tween.unit = unit;
+				// If a +=/-= token was provided, we're doing a relative animation
+				tween.end = parts[ 1 ] ?
+					start + ( parts[ 1 ] + 1 ) * parts[ 2 ] :
+					+parts[ 2 ];
+			}
+
+			return tween;
+		}]
+	};
+
+// Animations created synchronously will run synchronously
+function createFxNow() {
+	setTimeout(function() {
+		fxNow = undefined;
+	});
+	return ( fxNow = jQuery.now() );
+}
+
+function createTween( value, prop, animation ) {
+	var tween,
+		collection = ( tweeners[ prop ] || [] ).concat( tweeners[ "*" ] ),
+		index = 0,
+		length = collection.length;
+	for ( ; index < length; index++ ) {
+		if ( (tween = collection[ index ].call( animation, prop, value )) ) {
+
+			// we're done with this property
+			return tween;
+		}
+	}
+}
+
+function Animation( elem, properties, options ) {
+	var result,
+		stopped,
+		index = 0,
+		length = animationPrefilters.length,
+		deferred = jQuery.Deferred().always( function() {
+			// don't match elem in the :animated selector
+			delete tick.elem;
+		}),
+		tick = function() {
+			if ( stopped ) {
+				return false;
+			}
+			var currentTime = fxNow || createFxNow(),
+				remaining = Math.max( 0, animation.startTime + animation.duration - currentTime ),
+				// archaic crash bug won't allow us to use 1 - ( 0.5 || 0 ) (#12497)
+				temp = remaining / animation.duration || 0,
+				percent = 1 - temp,
+				index = 0,
+				length = animation.tweens.length;
+
+			for ( ; index < length ; index++ ) {
+				animation.tweens[ index ].run( percent );
+			}
+
+			deferred.notifyWith( elem, [ animation, percent, remaining ]);
+
+			if ( percent < 1 && length ) {
+				return remaining;
+			} else {
+				deferred.resolveWith( elem, [ animation ] );
+				return false;
+			}
+		},
+		animation = deferred.promise({
+			elem: elem,
+			props: jQuery.extend( {}, properties ),
+			opts: jQuery.extend( true, { specialEasing: {} }, options ),
+			originalProperties: properties,
+			originalOptions: options,
+			startTime: fxNow || createFxNow(),
+			duration: options.duration,
+			tweens: [],
+			createTween: function( prop, end ) {
+				var tween = jQuery.Tween( elem, animation.opts, prop, end,
+						animation.opts.specialEasing[ prop ] || animation.opts.easing );
+				animation.tweens.push( tween );
+				return tween;
+			},
+			stop: function( gotoEnd ) {
+				var index = 0,
+					// if we are going to the end, we want to run all the tweens
+					// otherwise we skip this part
+					length = gotoEnd ? animation.tweens.length : 0;
+				if ( stopped ) {
+					return this;
+				}
+				stopped = true;
+				for ( ; index < length ; index++ ) {
+					animation.tweens[ index ].run( 1 );
+				}
+
+				// resolve when we played the last frame
+				// otherwise, reject
+				if ( gotoEnd ) {
+					deferred.resolveWith( elem, [ animation, gotoEnd ] );
+				} else {
+					deferred.rejectWith( elem, [ animation, gotoEnd ] );
+				}
+				return this;
+			}
+		}),
+		props = animation.props;
+
+	propFilter( props, animation.opts.specialEasing );
+
+	for ( ; index < length ; index++ ) {
+		result = animationPrefilters[ index ].call( animation, elem, props, animation.opts );
+		if ( result ) {
+			return result;
+		}
+	}
+
+	jQuery.map( props, createTween, animation );
+
+	if ( jQuery.isFunction( animation.opts.start ) ) {
+		animation.opts.start.call( elem, animation );
+	}
+
+	jQuery.fx.timer(
+		jQuery.extend( tick, {
+			elem: elem,
+			anim: animation,
+			queue: animation.opts.queue
+		})
+	);
+
+	// attach callbacks from options
+	return animation.progress( animation.opts.progress )
+		.done( animation.opts.done, animation.opts.complete )
+		.fail( animation.opts.fail )
+		.always( animation.opts.always );
+}
+
+function propFilter( props, specialEasing ) {
+	var index, name, easing, value, hooks;
+
+	// camelCase, specialEasing and expand cssHook pass
+	for ( index in props ) {
+		name = jQuery.camelCase( index );
+		easing = specialEasing[ name ];
+		value = props[ index ];
+		if ( jQuery.isArray( value ) ) {
+			easing = value[ 1 ];
+			value = props[ index ] = value[ 0 ];
+		}
+
+		if ( index !== name ) {
+			props[ name ] = value;
+			delete props[ index ];
+		}
+
+		hooks = jQuery.cssHooks[ name ];
+		if ( hooks && "expand" in hooks ) {
+			value = hooks.expand( value );
+			delete props[ name ];
+
+			// not quite $.extend, this wont overwrite keys already present.
+			// also - reusing 'index' from above because we have the correct "name"
+			for ( index in value ) {
+				if ( !( index in props ) ) {
+					props[ index ] = value[ index ];
+					specialEasing[ index ] = easing;
+				}
+			}
+		} else {
+			specialEasing[ name ] = easing;
+		}
+	}
+}
+
+jQuery.Animation = jQuery.extend( Animation, {
+
+	tweener: function( props, callback ) {
+		if ( jQuery.isFunction( props ) ) {
+			callback = props;
+			props = [ "*" ];
+		} else {
+			props = props.split(" ");
+		}
+
+		var prop,
+			index = 0,
+			length = props.length;
+
+		for ( ; index < length ; index++ ) {
+			prop = props[ index ];
+			tweeners[ prop ] = tweeners[ prop ] || [];
+			tweeners[ prop ].unshift( callback );
+		}
+	},
+
+	prefilter: function( callback, prepend ) {
+		if ( prepend ) {
+			animationPrefilters.unshift( callback );
+		} else {
+			animationPrefilters.push( callback );
+		}
+	}
+});
+
+function defaultPrefilter( elem, props, opts ) {
+	/* jshint validthis: true */
+	var prop, value, toggle, tween, hooks, oldfire,
+		anim = this,
+		orig = {},
+		style = elem.style,
+		hidden = elem.nodeType && isHidden( elem ),
+		dataShow = data_priv.get( elem, "fxshow" );
+
+	// handle queue: false promises
+	if ( !opts.queue ) {
+		hooks = jQuery._queueHooks( elem, "fx" );
+		if ( hooks.unqueued == null ) {
+			hooks.unqueued = 0;
+			oldfire = hooks.empty.fire;
+			hooks.empty.fire = function() {
+				if ( !hooks.unqueued ) {
+					oldfire();
+				}
+			};
+		}
+		hooks.unqueued++;
+
+		anim.always(function() {
+			// doing this makes sure that the complete handler will be called
+			// before this completes
+			anim.always(function() {
+				hooks.unqueued--;
+				if ( !jQuery.queue( elem, "fx" ).length ) {
+					hooks.empty.fire();
+				}
+			});
+		});
+	}
+
+	// height/width overflow pass
+	if ( elem.nodeType === 1 && ( "height" in props || "width" in props ) ) {
+		// Make sure that nothing sneaks out
+		// Record all 3 overflow attributes because IE9-10 do not
+		// change the overflow attribute when overflowX and
+		// overflowY are set to the same value
+		opts.overflow = [ style.overflow, style.overflowX, style.overflowY ];
+
+		// Set display property to inline-block for height/width
+		// animations on inline elements that are having width/height animated
+		if ( jQuery.css( elem, "display" ) === "inline" &&
+				jQuery.css( elem, "float" ) === "none" ) {
+
+			style.display = "inline-block";
+		}
+	}
+
+	if ( opts.overflow ) {
+		style.overflow = "hidden";
+		anim.always(function() {
+			style.overflow = opts.overflow[ 0 ];
+			style.overflowX = opts.overflow[ 1 ];
+			style.overflowY = opts.overflow[ 2 ];
+		});
+	}
+
+
+	// show/hide pass
+	for ( prop in props ) {
+		value = props[ prop ];
+		if ( rfxtypes.exec( value ) ) {
+			delete props[ prop ];
+			toggle = toggle || value === "toggle";
+			if ( value === ( hidden ? "hide" : "show" ) ) {
+
+				// If there is dataShow left over from a stopped hide or show and we are going to proceed with show, we should pretend to be hidden
+				if ( value === "show" && dataShow && dataShow[ prop ] !== undefined ) {
+					hidden = true;
+				} else {
+					continue;
+				}
+			}
+			orig[ prop ] = dataShow && dataShow[ prop ] || jQuery.style( elem, prop );
+		}
+	}
+
+	if ( !jQuery.isEmptyObject( orig ) ) {
+		if ( dataShow ) {
+			if ( "hidden" in dataShow ) {
+				hidden = dataShow.hidden;
+			}
+		} else {
+			dataShow = data_priv.access( elem, "fxshow", {} );
+		}
+
+		// store state if its toggle - enables .stop().toggle() to "reverse"
+		if ( toggle ) {
+			dataShow.hidden = !hidden;
+		}
+		if ( hidden ) {
+			jQuery( elem ).show();
+		} else {
+			anim.done(function() {
+				jQuery( elem ).hide();
+			});
+		}
+		anim.done(function() {
+			var prop;
+
+			data_priv.remove( elem, "fxshow" );
+			for ( prop in orig ) {
+				jQuery.style( elem, prop, orig[ prop ] );
+			}
+		});
+		for ( prop in orig ) {
+			tween = createTween( hidden ? dataShow[ prop ] : 0, prop, anim );
+
+			if ( !( prop in dataShow ) ) {
+				dataShow[ prop ] = tween.start;
+				if ( hidden ) {
+					tween.end = tween.start;
+					tween.start = prop === "width" || prop === "height" ? 1 : 0;
+				}
+			}
+		}
+	}
+}
+
+function Tween( elem, options, prop, end, easing ) {
+	return new Tween.prototype.init( elem, options, prop, end, easing );
+}
+jQuery.Tween = Tween;
+
+Tween.prototype = {
+	constructor: Tween,
+	init: function( elem, options, prop, end, easing, unit ) {
+		this.elem = elem;
+		this.prop = prop;
+		this.easing = easing || "swing";
+		this.options = options;
+		this.start = this.now = this.cur();
+		this.end = end;
+		this.unit = unit || ( jQuery.cssNumber[ prop ] ? "" : "px" );
+	},
+	cur: function() {
+		var hooks = Tween.propHooks[ this.prop ];
+
+		return hooks && hooks.get ?
+			hooks.get( this ) :
+			Tween.propHooks._default.get( this );
+	},
+	run: function( percent ) {
+		var eased,
+			hooks = Tween.propHooks[ this.prop ];
+
+		if ( this.options.duration ) {
+			this.pos = eased = jQuery.easing[ this.easing ](
+				percent, this.options.duration * percent, 0, 1, this.options.duration
+			);
+		} else {
+			this.pos = eased = percent;
+		}
+		this.now = ( this.end - this.start ) * eased + this.start;
+
+		if ( this.options.step ) {
+			this.options.step.call( this.elem, this.now, this );
+		}
+
+		if ( hooks && hooks.set ) {
+			hooks.set( this );
+		} else {
+			Tween.propHooks._default.set( this );
+		}
+		return this;
+	}
+};
+
+Tween.prototype.init.prototype = Tween.prototype;
+
+Tween.propHooks = {
+	_default: {
+		get: function( tween ) {
+			var result;
+
+			if ( tween.elem[ tween.prop ] != null &&
+				(!tween.elem.style || tween.elem.style[ tween.prop ] == null) ) {
+				return tween.elem[ tween.prop ];
+			}
+
+			// passing an empty string as a 3rd parameter to .css will automatically
+			// attempt a parseFloat and fallback to a string if the parse fails
+			// so, simple values such as "10px" are parsed to Float.
+			// complex values such as "rotate(1rad)" are returned as is.
+			result = jQuery.css( tween.elem, tween.prop, "" );
+			// Empty strings, null, undefined and "auto" are converted to 0.
+			return !result || result === "auto" ? 0 : result;
+		},
+		set: function( tween ) {
+			// use step hook for back compat - use cssHook if its there - use .style if its
+			// available and use plain properties where available
+			if ( jQuery.fx.step[ tween.prop ] ) {
+				jQuery.fx.step[ tween.prop ]( tween );
+			} else if ( tween.elem.style && ( tween.elem.style[ jQuery.cssProps[ tween.prop ] ] != null || jQuery.cssHooks[ tween.prop ] ) ) {
+				jQuery.style( tween.elem, tween.prop, tween.now + tween.unit );
+			} else {
+				tween.elem[ tween.prop ] = tween.now;
+			}
+		}
+	}
+};
+
+// Support: IE9
+// Panic based approach to setting things on disconnected nodes
+
+Tween.propHooks.scrollTop = Tween.propHooks.scrollLeft = {
+	set: function( tween ) {
+		if ( tween.elem.nodeType && tween.elem.parentNode ) {
+			tween.elem[ tween.prop ] = tween.now;
+		}
+	}
+};
+
+jQuery.each([ "toggle", "show", "hide" ], function( i, name ) {
+	var cssFn = jQuery.fn[ name ];
+	jQuery.fn[ name ] = function( speed, easing, callback ) {
+		return speed == null || typeof speed === "boolean" ?
+			cssFn.apply( this, arguments ) :
+			this.animate( genFx( name, true ), speed, easing, callback );
+	};
+});
+
+jQuery.fn.extend({
+	fadeTo: function( speed, to, easing, callback ) {
+
+		// show any hidden elements after setting opacity to 0
+		return this.filter( isHidden ).css( "opacity", 0 ).show()
+
+			// animate to the value specified
+			.end().animate({ opacity: to }, speed, easing, callback );
+	},
+	animate: function( prop, speed, easing, callback ) {
+		var empty = jQuery.isEmptyObject( prop ),
+			optall = jQuery.speed( speed, easing, callback ),
+			doAnimation = function() {
+				// Operate on a copy of prop so per-property easing won't be lost
+				var anim = Animation( this, jQuery.extend( {}, prop ), optall );
+
+				// Empty animations, or finishing resolves immediately
+				if ( empty || data_priv.get( this, "finish" ) ) {
+					anim.stop( true );
+				}
+			};
+			doAnimation.finish = doAnimation;
+
+		return empty || optall.queue === false ?
+			this.each( doAnimation ) :
+			this.queue( optall.queue, doAnimation );
+	},
+	stop: function( type, clearQueue, gotoEnd ) {
+		var stopQueue = function( hooks ) {
+			var stop = hooks.stop;
+			delete hooks.stop;
+			stop( gotoEnd );
+		};
+
+		if ( typeof type !== "string" ) {
+			gotoEnd = clearQueue;
+			clearQueue = type;
+			type = undefined;
+		}
+		if ( clearQueue && type !== false ) {
+			this.queue( type || "fx", [] );
+		}
+
+		return this.each(function() {
+			var dequeue = true,
+				index = type != null && type + "queueHooks",
+				timers = jQuery.timers,
+				data = data_priv.get( this );
+
+			if ( index ) {
+				if ( data[ index ] && data[ index ].stop ) {
+					stopQueue( data[ index ] );
+				}
+			} else {
+				for ( index in data ) {
+					if ( data[ index ] && data[ index ].stop && rrun.test( index ) ) {
+						stopQueue( data[ index ] );
+					}
+				}
+			}
+
+			for ( index = timers.length; index--; ) {
+				if ( timers[ index ].elem === this && (type == null || timers[ index ].queue === type) ) {
+					timers[ index ].anim.stop( gotoEnd );
+					dequeue = false;
+					timers.splice( index, 1 );
+				}
+			}
+
+			// start the next in the queue if the last step wasn't forced
+			// timers currently will call their complete callbacks, which will dequeue
+			// but only if they were gotoEnd
+			if ( dequeue || !gotoEnd ) {
+				jQuery.dequeue( this, type );
+			}
+		});
+	},
+	finish: function( type ) {
+		if ( type !== false ) {
+			type = type || "fx";
+		}
+		return this.each(function() {
+			var index,
+				data = data_priv.get( this ),
+				queue = data[ type + "queue" ],
+				hooks = data[ type + "queueHooks" ],
+				timers = jQuery.timers,
+				length = queue ? queue.length : 0;
+
+			// enable finishing flag on private data
+			data.finish = true;
+
+			// empty the queue first
+			jQuery.queue( this, type, [] );
+
+			if ( hooks && hooks.stop ) {
+				hooks.stop.call( this, true );
+			}
+
+			// look for any active animations, and finish them
+			for ( index = timers.length; index--; ) {
+				if ( timers[ index ].elem === this && timers[ index ].queue === type ) {
+					timers[ index ].anim.stop( true );
+					timers.splice( index, 1 );
+				}
+			}
+
+			// look for any animations in the old queue and finish them
+			for ( index = 0; index < length; index++ ) {
+				if ( queue[ index ] && queue[ index ].finish ) {
+					queue[ index ].finish.call( this );
+				}
+			}
+
+			// turn off finishing flag
+			delete data.finish;
+		});
+	}
+});
+
+// Generate parameters to create a standard animation
+function genFx( type, includeWidth ) {
+	var which,
+		attrs = { height: type },
+		i = 0;
+
+	// if we include width, step value is 1 to do all cssExpand values,
+	// if we don't include width, step value is 2 to skip over Left and Right
+	includeWidth = includeWidth? 1 : 0;
+	for( ; i < 4 ; i += 2 - includeWidth ) {
+		which = cssExpand[ i ];
+		attrs[ "margin" + which ] = attrs[ "padding" + which ] = type;
+	}
+
+	if ( includeWidth ) {
+		attrs.opacity = attrs.width = type;
+	}
+
+	return attrs;
+}
+
+// Generate shortcuts for custom animations
+jQuery.each({
+	slideDown: genFx("show"),
+	slideUp: genFx("hide"),
+	slideToggle: genFx("toggle"),
+	fadeIn: { opacity: "show" },
+	fadeOut: { opacity: "hide" },
+	fadeToggle: { opacity: "toggle" }
+}, function( name, props ) {
+	jQuery.fn[ name ] = function( speed, easing, callback ) {
+		return this.animate( props, speed, easing, callback );
+	};
+});
+
+jQuery.speed = function( speed, easing, fn ) {
+	var opt = speed && typeof speed === "object" ? jQuery.extend( {}, speed ) : {
+		complete: fn || !fn && easing ||
+			jQuery.isFunction( speed ) && speed,
+		duration: speed,
+		easing: fn && easing || easing && !jQuery.isFunction( easing ) && easing
+	};
+
+	opt.duration = jQuery.fx.off ? 0 : typeof opt.duration === "number" ? opt.duration :
+		opt.duration in jQuery.fx.speeds ? jQuery.fx.speeds[ opt.duration ] : jQuery.fx.speeds._default;
+
+	// normalize opt.queue - true/undefined/null -> "fx"
+	if ( opt.queue == null || opt.queue === true ) {
+		opt.queue = "fx";
+	}
+
+	// Queueing
+	opt.old = opt.complete;
+
+	opt.complete = function() {
+		if ( jQuery.isFunction( opt.old ) ) {
+			opt.old.call( this );
+		}
+
+		if ( opt.queue ) {
+			jQuery.dequeue( this, opt.queue );
+		}
+	};
+
+	return opt;
+};
+
+jQuery.easing = {
+	linear: function( p ) {
+		return p;
+	},
+	swing: function( p ) {
+		return 0.5 - Math.cos( p*Math.PI ) / 2;
+	}
+};
+
+jQuery.timers = [];
+jQuery.fx = Tween.prototype.init;
+jQuery.fx.tick = function() {
+	var timer,
+		timers = jQuery.timers,
+		i = 0;
+
+	fxNow = jQuery.now();
+
+	for ( ; i < timers.length; i++ ) {
+		timer = timers[ i ];
+		// Checks the timer has not already been removed
+		if ( !timer() && timers[ i ] === timer ) {
+			timers.splice( i--, 1 );
+		}
+	}
+
+	if ( !timers.length ) {
+		jQuery.fx.stop();
+	}
+	fxNow = undefined;
+};
+
+jQuery.fx.timer = function( timer ) {
+	if ( timer() && jQuery.timers.push( timer ) ) {
+		jQuery.fx.start();
+	}
+};
+
+jQuery.fx.interval = 13;
+
+jQuery.fx.start = function() {
+	if ( !timerId ) {
+		timerId = setInterval( jQuery.fx.tick, jQuery.fx.interval );
+	}
+};
+
+jQuery.fx.stop = function() {
+	clearInterval( timerId );
+	timerId = null;
+};
+
+jQuery.fx.speeds = {
+	slow: 600,
+	fast: 200,
+	// Default speed
+	_default: 400
+};
+
+// Back Compat <1.8 extension point
+jQuery.fx.step = {};
+
+if ( jQuery.expr && jQuery.expr.filters ) {
+	jQuery.expr.filters.animated = function( elem ) {
+		return jQuery.grep(jQuery.timers, function( fn ) {
+			return elem === fn.elem;
+		}).length;
+	};
+}
+jQuery.fn.offset = function( options ) {
+	if ( arguments.length ) {
+		return options === undefined ?
+			this :
+			this.each(function( i ) {
+				jQuery.offset.setOffset( this, options, i );
+			});
+	}
+
+	var docElem, win,
+		elem = this[ 0 ],
+		box = { top: 0, left: 0 },
+		doc = elem && elem.ownerDocument;
+
+	if ( !doc ) {
+		return;
+	}
+
+	docElem = doc.documentElement;
+
+	// Make sure it's not a disconnected DOM node
+	if ( !jQuery.contains( docElem, elem ) ) {
+		return box;
+	}
+
+	// If we don't have gBCR, just use 0,0 rather than error
+	// BlackBerry 5, iOS 3 (original iPhone)
+	if ( typeof elem.getBoundingClientRect !== core_strundefined ) {
+		box = elem.getBoundingClientRect();
+	}
+	win = getWindow( doc );
+	return {
+		top: box.top + win.pageYOffset - docElem.clientTop,
+		left: box.left + win.pageXOffset - docElem.clientLeft
+	};
+};
+
+jQuery.offset = {
+
+	setOffset: function( elem, options, i ) {
+		var curPosition, curLeft, curCSSTop, curTop, curOffset, curCSSLeft, calculatePosition,
+			position = jQuery.css( elem, "position" ),
+			curElem = jQuery( elem ),
+			props = {};
+
+		// Set position first, in-case top/left are set even on static elem
+		if ( position === "static" ) {
+			elem.style.position = "relative";
+		}
+
+		curOffset = curElem.offset();
+		curCSSTop = jQuery.css( elem, "top" );
+		curCSSLeft = jQuery.css( elem, "left" );
+		calculatePosition = ( position === "absolute" || position === "fixed" ) && ( curCSSTop + curCSSLeft ).indexOf("auto") > -1;
+
+		// Need to be able to calculate position if either top or left is auto and position is either absolute or fixed
+		if ( calculatePosition ) {
+			curPosition = curElem.position();
+			curTop = curPosition.top;
+			curLeft = curPosition.left;
+
+		} else {
+			curTop = parseFloat( curCSSTop ) || 0;
+			curLeft = parseFloat( curCSSLeft ) || 0;
+		}
+
+		if ( jQuery.isFunction( options ) ) {
+			options = options.call( elem, i, curOffset );
+		}
+
+		if ( options.top != null ) {
+			props.top = ( options.top - curOffset.top ) + curTop;
+		}
+		if ( options.left != null ) {
+			props.left = ( options.left - curOffset.left ) + curLeft;
+		}
+
+		if ( "using" in options ) {
+			options.using.call( elem, props );
+
+		} else {
+			curElem.css( props );
+		}
+	}
+};
+
+
+jQuery.fn.extend({
+
+	position: function() {
+		if ( !this[ 0 ] ) {
+			return;
+		}
+
+		var offsetParent, offset,
+			elem = this[ 0 ],
+			parentOffset = { top: 0, left: 0 };
+
+		// Fixed elements are offset from window (parentOffset = {top:0, left: 0}, because it is it's only offset parent
+		if ( jQuery.css( elem, "position" ) === "fixed" ) {
+			// We assume that getBoundingClientRect is available when computed position is fixed
+			offset = elem.getBoundingClientRect();
+
+		} else {
+			// Get *real* offsetParent
+			offsetParent = this.offsetParent();
+
+			// Get correct offsets
+			offset = this.offset();
+			if ( !jQuery.nodeName( offsetParent[ 0 ], "html" ) ) {
+				parentOffset = offsetParent.offset();
+			}
+
+			// Add offsetParent borders
+			parentOffset.top += jQuery.css( offsetParent[ 0 ], "borderTopWidth", true );
+			parentOffset.left += jQuery.css( offsetParent[ 0 ], "borderLeftWidth", true );
+		}
+
+		// Subtract parent offsets and element margins
+		return {
+			top: offset.top - parentOffset.top - jQuery.css( elem, "marginTop", true ),
+			left: offset.left - parentOffset.left - jQuery.css( elem, "marginLeft", true )
+		};
+	},
+
+	offsetParent: function() {
+		return this.map(function() {
+			var offsetParent = this.offsetParent || docElem;
+
+			while ( offsetParent && ( !jQuery.nodeName( offsetParent, "html" ) && jQuery.css( offsetParent, "position") === "static" ) ) {
+				offsetParent = offsetParent.offsetParent;
+			}
+
+			return offsetParent || docElem;
+		});
+	}
+});
+
+
+// Create scrollLeft and scrollTop methods
+jQuery.each( {scrollLeft: "pageXOffset", scrollTop: "pageYOffset"}, function( method, prop ) {
+	var top = "pageYOffset" === prop;
+
+	jQuery.fn[ method ] = function( val ) {
+		return jQuery.access( this, function( elem, method, val ) {
+			var win = getWindow( elem );
+
+			if ( val === undefined ) {
+				return win ? win[ prop ] : elem[ method ];
+			}
+
+			if ( win ) {
+				win.scrollTo(
+					!top ? val : window.pageXOffset,
+					top ? val : window.pageYOffset
+				);
+
+			} else {
+				elem[ method ] = val;
+			}
+		}, method, val, arguments.length, null );
+	};
+});
+
+function getWindow( elem ) {
+	return jQuery.isWindow( elem ) ? elem : elem.nodeType === 9 && elem.defaultView;
+}
+// Create innerHeight, innerWidth, height, width, outerHeight and outerWidth methods
+jQuery.each( { Height: "height", Width: "width" }, function( name, type ) {
+	jQuery.each( { padding: "inner" + name, content: type, "": "outer" + name }, function( defaultExtra, funcName ) {
+		// margin is only for outerHeight, outerWidth
+		jQuery.fn[ funcName ] = function( margin, value ) {
+			var chainable = arguments.length && ( defaultExtra || typeof margin !== "boolean" ),
+				extra = defaultExtra || ( margin === true || value === true ? "margin" : "border" );
+
+			return jQuery.access( this, function( elem, type, value ) {
+				var doc;
+
+				if ( jQuery.isWindow( elem ) ) {
+					// As of 5/8/2012 this will yield incorrect results for Mobile Safari, but there
+					// isn't a whole lot we can do. See pull request at this URL for discussion:
+					// https://github.com/jquery/jquery/pull/764
+					return elem.document.documentElement[ "client" + name ];
+				}
+
+				// Get document width or height
+				if ( elem.nodeType === 9 ) {
+					doc = elem.documentElement;
+
+					// Either scroll[Width/Height] or offset[Width/Height] or client[Width/Height],
+					// whichever is greatest
+					return Math.max(
+						elem.body[ "scroll" + name ], doc[ "scroll" + name ],
+						elem.body[ "offset" + name ], doc[ "offset" + name ],
+						doc[ "client" + name ]
+					);
+				}
+
+				return value === undefined ?
+					// Get width or height on the element, requesting but not forcing parseFloat
+					jQuery.css( elem, type, extra ) :
+
+					// Set width or height on the element
+					jQuery.style( elem, type, value, extra );
+			}, type, chainable ? margin : undefined, chainable, null );
+		};
+	});
+});
+// Limit scope pollution from any deprecated API
+// (function() {
+
+// The number of elements contained in the matched element set
+jQuery.fn.size = function() {
+	return this.length;
+};
+
+jQuery.fn.andSelf = jQuery.fn.addBack;
+
+// })();
+if ( typeof module === "object" && module && typeof module.exports === "object" ) {
+	// Expose jQuery as module.exports in loaders that implement the Node
+	// module pattern (including browserify). Do not create the global, since
+	// the user will be storing it themselves locally, and globals are frowned
+	// upon in the Node module world.
+	module.exports = jQuery;
+} else {
+	// Register as a named AMD module, since jQuery can be concatenated with other
+	// files that may use define, but not via a proper concatenation script that
+	// understands anonymous AMD modules. A named AMD is safest and most robust
+	// way to register. Lowercase jquery is used because AMD module names are
+	// derived from file names, and jQuery is normally delivered in a lowercase
+	// file name. Do this after creating the global so that if an AMD module wants
+	// to call noConflict to hide this version of jQuery, it will work.
+	if ( typeof define === "function" && define.amd ) {
+		define( "jquery", [], function () { return jQuery; } );
+	}
+}
+
+// If there is a window object, that at least has a document property,
+// define jQuery and $ identifiers
+if ( typeof window === "object" && typeof window.document === "object" ) {
+	window.jQuery = window.$ = jQuery;
+}
+
+})( window );
diff -Nru acl2-6.2/books/xdoc/fancy/lib/jquery-2.0.3.min.js acl2-6.3/books/xdoc/fancy/lib/jquery-2.0.3.min.js
--- acl2-6.2/books/xdoc/fancy/lib/jquery-2.0.3.min.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/jquery-2.0.3.min.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,6 @@
+/*! jQuery v2.0.3 | (c) 2005, 2013 jQuery Foundation, Inc. | jquery.org/license
+//@ sourceMappingURL=jquery-2.0.3.min.map
+*/
+(function(e,undefined){var t,n,r=typeof undefined,i=e.location,o=e.document,s=o.documentElement,a=e.jQuery,u=e.$,l={},c=[],p="2.0.3",f=c.concat,h=c.push,d=c.slice,g=c.indexOf,m=l.toString,y=l.hasOwnProperty,v=p.trim,x=function(e,n){return new x.fn.init(e,n,t)},b=/[+-]?(?:\d*\.|)\d+(?:[eE][+-]?\d+|)/.source,w=/\S+/g,T=/^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]*))$/,C=/^<(\w+)\s*\/?>(?:<\/\1>|)$/,k=/^-ms-/,N=/-([\da-z])/gi,E=function(e,t){return t.toUpperCase()},S=function(){o.removeEventListener("DOMContentLoaded",S,!1),e.removeEventListener("load",S,!1),x.ready()};x.fn=x.prototype={jquery:p,constructor:x,init:function(e,t,n){var r,i;if(!e)return this;if("string"==typeof e){if(r="<"===e.charAt(0)&&">"===e.charAt(e.length-1)&&e.length>=3?[null,e,null]:T.exec(e),!r||!r[1]&&t)return!t||t.jquery?(t||n).find(e):this.constructor(t).find(e);if(r[1]){if(t=t instanceof x?t[0]:t,x.merge(this,x.parseHTML(r[1],t&&t.nodeType?t.ownerDocument||t:o,!0)),C.test(r[1])&&x.isPlainObject(t))for(r in t)x.isFunction(this[r])?this[r](t[r]):this.attr(r,t[r]);return this}return i=o.getElementById(r[2]),i&&i.parentNode&&(this.length=1,this[0]=i),this.context=o,this.selector=e,this}return e.nodeType?(this.context=this[0]=e,this.length=1,this):x.isFunction(e)?n.ready(e):(e.selector!==undefined&&(this.selector=e.selector,this.context=e.context),x.makeArray(e,this))},selector:"",length:0,toArray:function(){return d.call(this)},get:function(e){return null==e?this.toArray():0>e?this[this.length+e]:this[e]},pushStack:function(e){var t=x.merge(this.constructor(),e);return t.prevObject=this,t.context=this.context,t},each:function(e,t){return x.each(this,e,t)},ready:function(e){return x.ready.promise().done(e),this},slice:function(){return this.pushStack(d.apply(this,arguments))},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},eq:function(e){var t=this.length,n=+e+(0>e?t:0);return this.pushStack(n>=0&&t>n?[this[n]]:[])},map:function(e){return this.pushStack(x.map(this,function(t,n){return e.call(t,n,t)}))},end:function(){return this.prevObject||this.constructor(null)},push:h,sort:[].sort,splice:[].splice},x.fn.init.prototype=x.fn,x.extend=x.fn.extend=function(){var e,t,n,r,i,o,s=arguments[0]||{},a=1,u=arguments.length,l=!1;for("boolean"==typeof s&&(l=s,s=arguments[1]||{},a=2),"object"==typeof s||x.isFunction(s)||(s={}),u===a&&(s=this,--a);u>a;a++)if(null!=(e=arguments[a]))for(t in e)n=s[t],r=e[t],s!==r&&(l&&r&&(x.isPlainObject(r)||(i=x.isArray(r)))?(i?(i=!1,o=n&&x.isArray(n)?n:[]):o=n&&x.isPlainObject(n)?n:{},s[t]=x.extend(l,o,r)):r!==undefined&&(s[t]=r));return s},x.extend({expando:"jQuery"+(p+Math.random()).replace(/\D/g,""),noConflict:function(t){return e.$===x&&(e.$=u),t&&e.jQuery===x&&(e.jQuery=a),x},isReady:!1,readyWait:1,holdReady:function(e){e?x.readyWait++:x.ready(!0)},ready:function(e){(e===!0?--x.readyWait:x.isReady)||(x.isReady=!0,e!==!0&&--x.readyWait>0||(n.resolveWith(o,[x]),x.fn.trigger&&x(o).trigger("ready").off("ready")))},isFunction:function(e){return"function"===x.type(e)},isArray:Array.isArray,isWindow:function(e){return null!=e&&e===e.window},isNumeric:function(e){return!isNaN(parseFloat(e))&&isFinite(e)},type:function(e){return null==e?e+"":"object"==typeof e||"function"==typeof e?l[m.call(e)]||"object":typeof e},isPlainObject:function(e){if("object"!==x.type(e)||e.nodeType||x.isWindow(e))return!1;try{if(e.constructor&&!y.call(e.constructor.prototype,"isPrototypeOf"))return!1}catch(t){return!1}return!0},isEmptyObject:function(e){var t;for(t in e)return!1;return!0},error:function(e){throw Error(e)},parseHTML:function(e,t,n){if(!e||"string"!=typeof e)return null;"boolean"==typeof t&&(n=t,t=!1),t=t||o;var r=C.exec(e),i=!n&&[];return r?[t.createElement(r[1])]:(r=x.buildFragment([e],t,i),i&&x(i).remove(),x.merge([],r.childNodes))},parseJSON:JSON.parse,parseXML:function(e){var t,n;if(!e||"string"!=typeof e)return null;try{n=new DOMParser,t=n.parseFromString(e,"text/xml")}catch(r){t=undefined}return(!t||t.getElementsByTagName("parsererror").length)&&x.error("Invalid XML: "+e),t},noop:function(){},globalEval:function(e){var t,n=eval;e=x.trim(e),e&&(1===e.indexOf("use strict")?(t=o.createElement("script"),t.text=e,o.head.appendChild(t).parentNode.removeChild(t)):n(e))},camelCase:function(e){return e.replace(k,"ms-").replace(N,E)},nodeName:function(e,t){return e.nodeName&&e.nodeName.toLowerCase()===t.toLowerCase()},each:function(e,t,n){var r,i=0,o=e.length,s=j(e);if(n){if(s){for(;o>i;i++)if(r=t.apply(e[i],n),r===!1)break}else for(i in e)if(r=t.apply(e[i],n),r===!1)break}else if(s){for(;o>i;i++)if(r=t.call(e[i],i,e[i]),r===!1)break}else for(i in e)if(r=t.call(e[i],i,e[i]),r===!1)break;return e},trim:function(e){return null==e?"":v.call(e)},makeArray:function(e,t){var n=t||[];return null!=e&&(j(Object(e))?x.merge(n,"string"==typeof e?[e]:e):h.call(n,e)),n},inArray:function(e,t,n){return null==t?-1:g.call(t,e,n)},merge:function(e,t){var n=t.length,r=e.length,i=0;if("number"==typeof n)for(;n>i;i++)e[r++]=t[i];else while(t[i]!==undefined)e[r++]=t[i++];return e.length=r,e},grep:function(e,t,n){var r,i=[],o=0,s=e.length;for(n=!!n;s>o;o++)r=!!t(e[o],o),n!==r&&i.push(e[o]);return i},map:function(e,t,n){var r,i=0,o=e.length,s=j(e),a=[];if(s)for(;o>i;i++)r=t(e[i],i,n),null!=r&&(a[a.length]=r);else for(i in e)r=t(e[i],i,n),null!=r&&(a[a.length]=r);return f.apply([],a)},guid:1,proxy:function(e,t){var n,r,i;return"string"==typeof t&&(n=e[t],t=e,e=n),x.isFunction(e)?(r=d.call(arguments,2),i=function(){return e.apply(t||this,r.concat(d.call(arguments)))},i.guid=e.guid=e.guid||x.guid++,i):undefined},access:function(e,t,n,r,i,o,s){var a=0,u=e.length,l=null==n;if("object"===x.type(n)){i=!0;for(a in n)x.access(e,t,a,n[a],!0,o,s)}else if(r!==undefined&&(i=!0,x.isFunction(r)||(s=!0),l&&(s?(t.call(e,r),t=null):(l=t,t=function(e,t,n){return l.call(x(e),n)})),t))for(;u>a;a++)t(e[a],n,s?r:r.call(e[a],a,t(e[a],n)));return i?e:l?t.call(e):u?t(e[0],n):o},now:Date.now,swap:function(e,t,n,r){var i,o,s={};for(o in t)s[o]=e.style[o],e.style[o]=t[o];i=n.apply(e,r||[]);for(o in t)e.style[o]=s[o];return i}}),x.ready.promise=function(t){return n||(n=x.Deferred(),"complete"===o.readyState?setTimeout(x.ready):(o.addEventListener("DOMContentLoaded",S,!1),e.addEventListener("load",S,!1))),n.promise(t)},x.each("Boolean Number String Function Array Date RegExp Object Error".split(" "),function(e,t){l["[object "+t+"]"]=t.toLowerCase()});function j(e){var t=e.length,n=x.type(e);return x.isWindow(e)?!1:1===e.nodeType&&t?!0:"array"===n||"function"!==n&&(0===t||"number"==typeof t&&t>0&&t-1 in e)}t=x(o),function(e,undefined){var t,n,r,i,o,s,a,u,l,c,p,f,h,d,g,m,y,v="sizzle"+-new Date,b=e.document,w=0,T=0,C=st(),k=st(),N=st(),E=!1,S=function(e,t){return e===t?(E=!0,0):0},j=typeof undefined,D=1<<31,A={}.hasOwnProperty,L=[],q=L.pop,H=L.push,O=L.push,F=L.slice,P=L.indexOf||function(e){var t=0,n=this.length;for(;n>t;t++)if(this[t]===e)return t;return-1},R="checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped",M="[\\x20\\t\\r\\n\\f]",W="(?:\\\\.|[\\w-]|[^\\x00-\\xa0])+",$=W.replace("w","w#"),B="\\["+M+"*("+W+")"+M+"*(?:([*^$|!~]?=)"+M+"*(?:(['\"])((?:\\\\.|[^\\\\])*?)\\3|("+$+")|)|)"+M+"*\\]",I=":("+W+")(?:\\(((['\"])((?:\\\\.|[^\\\\])*?)\\3|((?:\\\\.|[^\\\\()[\\]]|"+B.replace(3,8)+")*)|.*)\\)|)",z=RegExp("^"+M+"+|((?:^|[^\\\\])(?:\\\\.)*)"+M+"+$","g"),_=RegExp("^"+M+"*,"+M+"*"),X=RegExp("^"+M+"*([>+~]|"+M+")"+M+"*"),U=RegExp(M+"*[+~]"),Y=RegExp("="+M+"*([^\\]'\"]*)"+M+"*\\]","g"),V=RegExp(I),G=RegExp("^"+$+"$"),J={ID:RegExp("^#("+W+")"),CLASS:RegExp("^\\.("+W+")"),TAG:RegExp("^("+W.replace("w","w*")+")"),ATTR:RegExp("^"+B),PSEUDO:RegExp("^"+I),CHILD:RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+M+"*(even|odd|(([+-]|)(\\d*)n|)"+M+"*(?:([+-]|)"+M+"*(\\d+)|))"+M+"*\\)|)","i"),bool:RegExp("^(?:"+R+")$","i"),needsContext:RegExp("^"+M+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+M+"*((?:-\\d)?\\d*)"+M+"*\\)|)(?=[^-]|$)","i")},Q=/^[^{]+\{\s*\[native \w/,K=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,Z=/^(?:input|select|textarea|button)$/i,et=/^h\d$/i,tt=/'|\\/g,nt=RegExp("\\\\([\\da-f]{1,6}"+M+"?|("+M+")|.)","ig"),rt=function(e,t,n){var r="0x"+t-65536;return r!==r||n?t:0>r?String.fromCharCode(r+65536):String.fromCharCode(55296|r>>10,56320|1023&r)};try{O.apply(L=F.call(b.childNodes),b.childNodes),L[b.childNodes.length].nodeType}catch(it){O={apply:L.length?function(e,t){H.apply(e,F.call(t))}:function(e,t){var n=e.length,r=0;while(e[n++]=t[r++]);e.length=n-1}}}function ot(e,t,r,i){var o,s,a,u,l,f,g,m,x,w;if((t?t.ownerDocument||t:b)!==p&&c(t),t=t||p,r=r||[],!e||"string"!=typeof e)return r;if(1!==(u=t.nodeType)&&9!==u)return[];if(h&&!i){if(o=K.exec(e))if(a=o[1]){if(9===u){if(s=t.getElementById(a),!s||!s.parentNode)return r;if(s.id===a)return r.push(s),r}else if(t.ownerDocument&&(s=t.ownerDocument.getElementById(a))&&y(t,s)&&s.id===a)return r.push(s),r}else{if(o[2])return O.apply(r,t.getElementsByTagName(e)),r;if((a=o[3])&&n.getElementsByClassName&&t.getElementsByClassName)return O.apply(r,t.getElementsByClassName(a)),r}if(n.qsa&&(!d||!d.test(e))){if(m=g=v,x=t,w=9===u&&e,1===u&&"object"!==t.nodeName.toLowerCase()){f=gt(e),(g=t.getAttribute("id"))?m=g.replace(tt,"\\$&"):t.setAttribute("id",m),m="[id='"+m+"'] ",l=f.length;while(l--)f[l]=m+mt(f[l]);x=U.test(e)&&t.parentNode||t,w=f.join(",")}if(w)try{return O.apply(r,x.querySelectorAll(w)),r}catch(T){}finally{g||t.removeAttribute("id")}}}return kt(e.replace(z,"$1"),t,r,i)}function st(){var e=[];function t(n,r){return e.push(n+=" ")>i.cacheLength&&delete t[e.shift()],t[n]=r}return t}function at(e){return e[v]=!0,e}function ut(e){var t=p.createElement("div");try{return!!e(t)}catch(n){return!1}finally{t.parentNode&&t.parentNode.removeChild(t),t=null}}function lt(e,t){var n=e.split("|"),r=e.length;while(r--)i.attrHandle[n[r]]=t}function ct(e,t){var n=t&&e,r=n&&1===e.nodeType&&1===t.nodeType&&(~t.sourceIndex||D)-(~e.sourceIndex||D);if(r)return r;if(n)while(n=n.nextSibling)if(n===t)return-1;return e?1:-1}function pt(e){return function(t){var n=t.nodeName.toLowerCase();return"input"===n&&t.type===e}}function ft(e){return function(t){var n=t.nodeName.toLowerCase();return("input"===n||"button"===n)&&t.type===e}}function ht(e){return at(function(t){return t=+t,at(function(n,r){var i,o=e([],n.length,t),s=o.length;while(s--)n[i=o[s]]&&(n[i]=!(r[i]=n[i]))})})}s=ot.isXML=function(e){var t=e&&(e.ownerDocument||e).documentElement;return t?"HTML"!==t.nodeName:!1},n=ot.support={},c=ot.setDocument=function(e){var t=e?e.ownerDocument||e:b,r=t.defaultView;return t!==p&&9===t.nodeType&&t.documentElement?(p=t,f=t.documentElement,h=!s(t),r&&r.attachEvent&&r!==r.top&&r.attachEvent("onbeforeunload",function(){c()}),n.attributes=ut(function(e){return e.className="i",!e.getAttribute("className")}),n.getElementsByTagName=ut(function(e){return e.appendChild(t.createComment("")),!e.getElementsByTagName("*").length}),n.getElementsByClassName=ut(function(e){return e.innerHTML="<div class='a'></div><div class='a i'></div>",e.firstChild.className="i",2===e.getElementsByClassName("i").length}),n.getById=ut(function(e){return f.appendChild(e).id=v,!t.getElementsByName||!t.getElementsByName(v).length}),n.getById?(i.find.ID=function(e,t){if(typeof t.getElementById!==j&&h){var n=t.getElementById(e);return n&&n.parentNode?[n]:[]}},i.filter.ID=function(e){var t=e.replace(nt,rt);return function(e){return e.getAttribute("id")===t}}):(delete i.find.ID,i.filter.ID=function(e){var t=e.replace(nt,rt);return function(e){var n=typeof e.getAttributeNode!==j&&e.getAttributeNode("id");return n&&n.value===t}}),i.find.TAG=n.getElementsByTagName?function(e,t){return typeof t.getElementsByTagName!==j?t.getElementsByTagName(e):undefined}:function(e,t){var n,r=[],i=0,o=t.getElementsByTagName(e);if("*"===e){while(n=o[i++])1===n.nodeType&&r.push(n);return r}return o},i.find.CLASS=n.getElementsByClassName&&function(e,t){return typeof t.getElementsByClassName!==j&&h?t.getElementsByClassName(e):undefined},g=[],d=[],(n.qsa=Q.test(t.querySelectorAll))&&(ut(function(e){e.innerHTML="<select><option selected=''></option></select>",e.querySelectorAll("[selected]").length||d.push("\\["+M+"*(?:value|"+R+")"),e.querySelectorAll(":checked").length||d.push(":checked")}),ut(function(e){var n=t.createElement("input");n.setAttribute("type","hidden"),e.appendChild(n).setAttribute("t",""),e.querySelectorAll("[t^='']").length&&d.push("[*^$]="+M+"*(?:''|\"\")"),e.querySelectorAll(":enabled").length||d.push(":enabled",":disabled"),e.querySelectorAll("*,:x"),d.push(",.*:")})),(n.matchesSelector=Q.test(m=f.webkitMatchesSelector||f.mozMatchesSelector||f.oMatchesSelector||f.msMatchesSelector))&&ut(function(e){n.disconnectedMatch=m.call(e,"div"),m.call(e,"[s!='']:x"),g.push("!=",I)}),d=d.length&&RegExp(d.join("|")),g=g.length&&RegExp(g.join("|")),y=Q.test(f.contains)||f.compareDocumentPosition?function(e,t){var n=9===e.nodeType?e.documentElement:e,r=t&&t.parentNode;return e===r||!(!r||1!==r.nodeType||!(n.contains?n.contains(r):e.compareDocumentPosition&&16&e.compareDocumentPosition(r)))}:function(e,t){if(t)while(t=t.parentNode)if(t===e)return!0;return!1},S=f.compareDocumentPosition?function(e,r){if(e===r)return E=!0,0;var i=r.compareDocumentPosition&&e.compareDocumentPosition&&e.compareDocumentPosition(r);return i?1&i||!n.sortDetached&&r.compareDocumentPosition(e)===i?e===t||y(b,e)?-1:r===t||y(b,r)?1:l?P.call(l,e)-P.call(l,r):0:4&i?-1:1:e.compareDocumentPosition?-1:1}:function(e,n){var r,i=0,o=e.parentNode,s=n.parentNode,a=[e],u=[n];if(e===n)return E=!0,0;if(!o||!s)return e===t?-1:n===t?1:o?-1:s?1:l?P.call(l,e)-P.call(l,n):0;if(o===s)return ct(e,n);r=e;while(r=r.parentNode)a.unshift(r);r=n;while(r=r.parentNode)u.unshift(r);while(a[i]===u[i])i++;return i?ct(a[i],u[i]):a[i]===b?-1:u[i]===b?1:0},t):p},ot.matches=function(e,t){return ot(e,null,null,t)},ot.matchesSelector=function(e,t){if((e.ownerDocument||e)!==p&&c(e),t=t.replace(Y,"='$1']"),!(!n.matchesSelector||!h||g&&g.test(t)||d&&d.test(t)))try{var r=m.call(e,t);if(r||n.disconnectedMatch||e.document&&11!==e.document.nodeType)return r}catch(i){}return ot(t,p,null,[e]).length>0},ot.contains=function(e,t){return(e.ownerDocument||e)!==p&&c(e),y(e,t)},ot.attr=function(e,t){(e.ownerDocument||e)!==p&&c(e);var r=i.attrHandle[t.toLowerCase()],o=r&&A.call(i.attrHandle,t.toLowerCase())?r(e,t,!h):undefined;return o===undefined?n.attributes||!h?e.getAttribute(t):(o=e.getAttributeNode(t))&&o.specified?o.value:null:o},ot.error=function(e){throw Error("Syntax error, unrecognized expression: "+e)},ot.uniqueSort=function(e){var t,r=[],i=0,o=0;if(E=!n.detectDuplicates,l=!n.sortStable&&e.slice(0),e.sort(S),E){while(t=e[o++])t===e[o]&&(i=r.push(o));while(i--)e.splice(r[i],1)}return e},o=ot.getText=function(e){var t,n="",r=0,i=e.nodeType;if(i){if(1===i||9===i||11===i){if("string"==typeof e.textContent)return e.textContent;for(e=e.firstChild;e;e=e.nextSibling)n+=o(e)}else if(3===i||4===i)return e.nodeValue}else for(;t=e[r];r++)n+=o(t);return n},i=ot.selectors={cacheLength:50,createPseudo:at,match:J,attrHandle:{},find:{},relative:{">":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(e){return e[1]=e[1].replace(nt,rt),e[3]=(e[4]||e[5]||"").replace(nt,rt),"~="===e[2]&&(e[3]=" "+e[3]+" "),e.slice(0,4)},CHILD:function(e){return e[1]=e[1].toLowerCase(),"nth"===e[1].slice(0,3)?(e[3]||ot.error(e[0]),e[4]=+(e[4]?e[5]+(e[6]||1):2*("even"===e[3]||"odd"===e[3])),e[5]=+(e[7]+e[8]||"odd"===e[3])):e[3]&&ot.error(e[0]),e},PSEUDO:function(e){var t,n=!e[5]&&e[2];return J.CHILD.test(e[0])?null:(e[3]&&e[4]!==undefined?e[2]=e[4]:n&&V.test(n)&&(t=gt(n,!0))&&(t=n.indexOf(")",n.length-t)-n.length)&&(e[0]=e[0].slice(0,t),e[2]=n.slice(0,t)),e.slice(0,3))}},filter:{TAG:function(e){var t=e.replace(nt,rt).toLowerCase();return"*"===e?function(){return!0}:function(e){return e.nodeName&&e.nodeName.toLowerCase()===t}},CLASS:function(e){var t=C[e+" "];return t||(t=RegExp("(^|"+M+")"+e+"("+M+"|$)"))&&C(e,function(e){return t.test("string"==typeof e.className&&e.className||typeof e.getAttribute!==j&&e.getAttribute("class")||"")})},ATTR:function(e,t,n){return function(r){var i=ot.attr(r,e);return null==i?"!="===t:t?(i+="","="===t?i===n:"!="===t?i!==n:"^="===t?n&&0===i.indexOf(n):"*="===t?n&&i.indexOf(n)>-1:"$="===t?n&&i.slice(-n.length)===n:"~="===t?(" "+i+" ").indexOf(n)>-1:"|="===t?i===n||i.slice(0,n.length+1)===n+"-":!1):!0}},CHILD:function(e,t,n,r,i){var o="nth"!==e.slice(0,3),s="last"!==e.slice(-4),a="of-type"===t;return 1===r&&0===i?function(e){return!!e.parentNode}:function(t,n,u){var l,c,p,f,h,d,g=o!==s?"nextSibling":"previousSibling",m=t.parentNode,y=a&&t.nodeName.toLowerCase(),x=!u&&!a;if(m){if(o){while(g){p=t;while(p=p[g])if(a?p.nodeName.toLowerCase()===y:1===p.nodeType)return!1;d=g="only"===e&&!d&&"nextSibling"}return!0}if(d=[s?m.firstChild:m.lastChild],s&&x){c=m[v]||(m[v]={}),l=c[e]||[],h=l[0]===w&&l[1],f=l[0]===w&&l[2],p=h&&m.childNodes[h];while(p=++h&&p&&p[g]||(f=h=0)||d.pop())if(1===p.nodeType&&++f&&p===t){c[e]=[w,h,f];break}}else if(x&&(l=(t[v]||(t[v]={}))[e])&&l[0]===w)f=l[1];else while(p=++h&&p&&p[g]||(f=h=0)||d.pop())if((a?p.nodeName.toLowerCase()===y:1===p.nodeType)&&++f&&(x&&((p[v]||(p[v]={}))[e]=[w,f]),p===t))break;return f-=i,f===r||0===f%r&&f/r>=0}}},PSEUDO:function(e,t){var n,r=i.pseudos[e]||i.setFilters[e.toLowerCase()]||ot.error("unsupported pseudo: "+e);return r[v]?r(t):r.length>1?(n=[e,e,"",t],i.setFilters.hasOwnProperty(e.toLowerCase())?at(function(e,n){var i,o=r(e,t),s=o.length;while(s--)i=P.call(e,o[s]),e[i]=!(n[i]=o[s])}):function(e){return r(e,0,n)}):r}},pseudos:{not:at(function(e){var t=[],n=[],r=a(e.replace(z,"$1"));return r[v]?at(function(e,t,n,i){var o,s=r(e,null,i,[]),a=e.length;while(a--)(o=s[a])&&(e[a]=!(t[a]=o))}):function(e,i,o){return t[0]=e,r(t,null,o,n),!n.pop()}}),has:at(function(e){return function(t){return ot(e,t).length>0}}),contains:at(function(e){return function(t){return(t.textContent||t.innerText||o(t)).indexOf(e)>-1}}),lang:at(function(e){return G.test(e||"")||ot.error("unsupported lang: "+e),e=e.replace(nt,rt).toLowerCase(),function(t){var n;do if(n=h?t.lang:t.getAttribute("xml:lang")||t.getAttribute("lang"))return n=n.toLowerCase(),n===e||0===n.indexOf(e+"-");while((t=t.parentNode)&&1===t.nodeType);return!1}}),target:function(t){var n=e.location&&e.location.hash;return n&&n.slice(1)===t.id},root:function(e){return e===f},focus:function(e){return e===p.activeElement&&(!p.hasFocus||p.hasFocus())&&!!(e.type||e.href||~e.tabIndex)},enabled:function(e){return e.disabled===!1},disabled:function(e){return e.disabled===!0},checked:function(e){var t=e.nodeName.toLowerCase();return"input"===t&&!!e.checked||"option"===t&&!!e.selected},selected:function(e){return e.parentNode&&e.parentNode.selectedIndex,e.selected===!0},empty:function(e){for(e=e.firstChild;e;e=e.nextSibling)if(e.nodeName>"@"||3===e.nodeType||4===e.nodeType)return!1;return!0},parent:function(e){return!i.pseudos.empty(e)},header:function(e){return et.test(e.nodeName)},input:function(e){return Z.test(e.nodeName)},button:function(e){var t=e.nodeName.toLowerCase();return"input"===t&&"button"===e.type||"button"===t},text:function(e){var t;return"input"===e.nodeName.toLowerCase()&&"text"===e.type&&(null==(t=e.getAttribute("type"))||t.toLowerCase()===e.type)},first:ht(function(){return[0]}),last:ht(function(e,t){return[t-1]}),eq:ht(function(e,t,n){return[0>n?n+t:n]}),even:ht(function(e,t){var n=0;for(;t>n;n+=2)e.push(n);return e}),odd:ht(function(e,t){var n=1;for(;t>n;n+=2)e.push(n);return e}),lt:ht(function(e,t,n){var r=0>n?n+t:n;for(;--r>=0;)e.push(r);return e}),gt:ht(function(e,t,n){var r=0>n?n+t:n;for(;t>++r;)e.push(r);return e})}},i.pseudos.nth=i.pseudos.eq;for(t in{radio:!0,checkbox:!0,file:!0,password:!0,image:!0})i.pseudos[t]=pt(t);for(t in{submit:!0,reset:!0})i.pseudos[t]=ft(t);function dt(){}dt.prototype=i.filters=i.pseudos,i.setFilters=new dt;function gt(e,t){var n,r,o,s,a,u,l,c=k[e+" "];if(c)return t?0:c.slice(0);a=e,u=[],l=i.preFilter;while(a){(!n||(r=_.exec(a)))&&(r&&(a=a.slice(r[0].length)||a),u.push(o=[])),n=!1,(r=X.exec(a))&&(n=r.shift(),o.push({value:n,type:r[0].replace(z," ")}),a=a.slice(n.length));for(s in i.filter)!(r=J[s].exec(a))||l[s]&&!(r=l[s](r))||(n=r.shift(),o.push({value:n,type:s,matches:r}),a=a.slice(n.length));if(!n)break}return t?a.length:a?ot.error(e):k(e,u).slice(0)}function mt(e){var t=0,n=e.length,r="";for(;n>t;t++)r+=e[t].value;return r}function yt(e,t,n){var i=t.dir,o=n&&"parentNode"===i,s=T++;return t.first?function(t,n,r){while(t=t[i])if(1===t.nodeType||o)return e(t,n,r)}:function(t,n,a){var u,l,c,p=w+" "+s;if(a){while(t=t[i])if((1===t.nodeType||o)&&e(t,n,a))return!0}else while(t=t[i])if(1===t.nodeType||o)if(c=t[v]||(t[v]={}),(l=c[i])&&l[0]===p){if((u=l[1])===!0||u===r)return u===!0}else if(l=c[i]=[p],l[1]=e(t,n,a)||r,l[1]===!0)return!0}}function vt(e){return e.length>1?function(t,n,r){var i=e.length;while(i--)if(!e[i](t,n,r))return!1;return!0}:e[0]}function xt(e,t,n,r,i){var o,s=[],a=0,u=e.length,l=null!=t;for(;u>a;a++)(o=e[a])&&(!n||n(o,r,i))&&(s.push(o),l&&t.push(a));return s}function bt(e,t,n,r,i,o){return r&&!r[v]&&(r=bt(r)),i&&!i[v]&&(i=bt(i,o)),at(function(o,s,a,u){var l,c,p,f=[],h=[],d=s.length,g=o||Ct(t||"*",a.nodeType?[a]:a,[]),m=!e||!o&&t?g:xt(g,f,e,a,u),y=n?i||(o?e:d||r)?[]:s:m;if(n&&n(m,y,a,u),r){l=xt(y,h),r(l,[],a,u),c=l.length;while(c--)(p=l[c])&&(y[h[c]]=!(m[h[c]]=p))}if(o){if(i||e){if(i){l=[],c=y.length;while(c--)(p=y[c])&&l.push(m[c]=p);i(null,y=[],l,u)}c=y.length;while(c--)(p=y[c])&&(l=i?P.call(o,p):f[c])>-1&&(o[l]=!(s[l]=p))}}else y=xt(y===s?y.splice(d,y.length):y),i?i(null,s,y,u):O.apply(s,y)})}function wt(e){var t,n,r,o=e.length,s=i.relative[e[0].type],a=s||i.relative[" "],l=s?1:0,c=yt(function(e){return e===t},a,!0),p=yt(function(e){return P.call(t,e)>-1},a,!0),f=[function(e,n,r){return!s&&(r||n!==u)||((t=n).nodeType?c(e,n,r):p(e,n,r))}];for(;o>l;l++)if(n=i.relative[e[l].type])f=[yt(vt(f),n)];else{if(n=i.filter[e[l].type].apply(null,e[l].matches),n[v]){for(r=++l;o>r;r++)if(i.relative[e[r].type])break;return bt(l>1&&vt(f),l>1&&mt(e.slice(0,l-1).concat({value:" "===e[l-2].type?"*":""})).replace(z,"$1"),n,r>l&&wt(e.slice(l,r)),o>r&&wt(e=e.slice(r)),o>r&&mt(e))}f.push(n)}return vt(f)}function Tt(e,t){var n=0,o=t.length>0,s=e.length>0,a=function(a,l,c,f,h){var d,g,m,y=[],v=0,x="0",b=a&&[],T=null!=h,C=u,k=a||s&&i.find.TAG("*",h&&l.parentNode||l),N=w+=null==C?1:Math.random()||.1;for(T&&(u=l!==p&&l,r=n);null!=(d=k[x]);x++){if(s&&d){g=0;while(m=e[g++])if(m(d,l,c)){f.push(d);break}T&&(w=N,r=++n)}o&&((d=!m&&d)&&v--,a&&b.push(d))}if(v+=x,o&&x!==v){g=0;while(m=t[g++])m(b,y,l,c);if(a){if(v>0)while(x--)b[x]||y[x]||(y[x]=q.call(f));y=xt(y)}O.apply(f,y),T&&!a&&y.length>0&&v+t.length>1&&ot.uniqueSort(f)}return T&&(w=N,u=C),b};return o?at(a):a}a=ot.compile=function(e,t){var n,r=[],i=[],o=N[e+" "];if(!o){t||(t=gt(e)),n=t.length;while(n--)o=wt(t[n]),o[v]?r.push(o):i.push(o);o=N(e,Tt(i,r))}return o};function Ct(e,t,n){var r=0,i=t.length;for(;i>r;r++)ot(e,t[r],n);return n}function kt(e,t,r,o){var s,u,l,c,p,f=gt(e);if(!o&&1===f.length){if(u=f[0]=f[0].slice(0),u.length>2&&"ID"===(l=u[0]).type&&n.getById&&9===t.nodeType&&h&&i.relative[u[1].type]){if(t=(i.find.ID(l.matches[0].replace(nt,rt),t)||[])[0],!t)return r;e=e.slice(u.shift().value.length)}s=J.needsContext.test(e)?0:u.length;while(s--){if(l=u[s],i.relative[c=l.type])break;if((p=i.find[c])&&(o=p(l.matches[0].replace(nt,rt),U.test(u[0].type)&&t.parentNode||t))){if(u.splice(s,1),e=o.length&&mt(u),!e)return O.apply(r,o),r;break}}}return a(e,f)(o,t,!h,r,U.test(e)),r}n.sortStable=v.split("").sort(S).join("")===v,n.detectDuplicates=E,c(),n.sortDetached=ut(function(e){return 1&e.compareDocumentPosition(p.createElement("div"))}),ut(function(e){return e.innerHTML="<a href='#'></a>","#"===e.firstChild.getAttribute("href")})||lt("type|href|height|width",function(e,t,n){return n?undefined:e.getAttribute(t,"type"===t.toLowerCase()?1:2)}),n.attributes&&ut(function(e){return e.innerHTML="<input/>",e.firstChild.setAttribute("value",""),""===e.firstChild.getAttribute("value")})||lt("value",function(e,t,n){return n||"input"!==e.nodeName.toLowerCase()?undefined:e.defaultValue}),ut(function(e){return null==e.getAttribute("disabled")})||lt(R,function(e,t,n){var r;return n?undefined:(r=e.getAttributeNode(t))&&r.specified?r.value:e[t]===!0?t.toLowerCase():null}),x.find=ot,x.expr=ot.selectors,x.expr[":"]=x.expr.pseudos,x.unique=ot.uniqueSort,x.text=ot.getText,x.isXMLDoc=ot.isXML,x.contains=ot.contains}(e);var D={};function A(e){var t=D[e]={};return x.each(e.match(w)||[],function(e,n){t[n]=!0}),t}x.Callbacks=function(e){e="string"==typeof e?D[e]||A(e):x.extend({},e);var t,n,r,i,o,s,a=[],u=!e.once&&[],l=function(p){for(t=e.memory&&p,n=!0,s=i||0,i=0,o=a.length,r=!0;a&&o>s;s++)if(a[s].apply(p[0],p[1])===!1&&e.stopOnFalse){t=!1;break}r=!1,a&&(u?u.length&&l(u.shift()):t?a=[]:c.disable())},c={add:function(){if(a){var n=a.length;(function s(t){x.each(t,function(t,n){var r=x.type(n);"function"===r?e.unique&&c.has(n)||a.push(n):n&&n.length&&"string"!==r&&s(n)})})(arguments),r?o=a.length:t&&(i=n,l(t))}return this},remove:function(){return a&&x.each(arguments,function(e,t){var n;while((n=x.inArray(t,a,n))>-1)a.splice(n,1),r&&(o>=n&&o--,s>=n&&s--)}),this},has:function(e){return e?x.inArray(e,a)>-1:!(!a||!a.length)},empty:function(){return a=[],o=0,this},disable:function(){return a=u=t=undefined,this},disabled:function(){return!a},lock:function(){return u=undefined,t||c.disable(),this},locked:function(){return!u},fireWith:function(e,t){return!a||n&&!u||(t=t||[],t=[e,t.slice?t.slice():t],r?u.push(t):l(t)),this},fire:function(){return c.fireWith(this,arguments),this},fired:function(){return!!n}};return c},x.extend({Deferred:function(e){var t=[["resolve","done",x.Callbacks("once memory"),"resolved"],["reject","fail",x.Callbacks("once memory"),"rejected"],["notify","progress",x.Callbacks("memory")]],n="pending",r={state:function(){return n},always:function(){return i.done(arguments).fail(arguments),this},then:function(){var e=arguments;return x.Deferred(function(n){x.each(t,function(t,o){var s=o[0],a=x.isFunction(e[t])&&e[t];i[o[1]](function(){var e=a&&a.apply(this,arguments);e&&x.isFunction(e.promise)?e.promise().done(n.resolve).fail(n.reject).progress(n.notify):n[s+"With"](this===r?n.promise():this,a?[e]:arguments)})}),e=null}).promise()},promise:function(e){return null!=e?x.extend(e,r):r}},i={};return r.pipe=r.then,x.each(t,function(e,o){var s=o[2],a=o[3];r[o[1]]=s.add,a&&s.add(function(){n=a},t[1^e][2].disable,t[2][2].lock),i[o[0]]=function(){return i[o[0]+"With"](this===i?r:this,arguments),this},i[o[0]+"With"]=s.fireWith}),r.promise(i),e&&e.call(i,i),i},when:function(e){var t=0,n=d.call(arguments),r=n.length,i=1!==r||e&&x.isFunction(e.promise)?r:0,o=1===i?e:x.Deferred(),s=function(e,t,n){return function(r){t[e]=this,n[e]=arguments.length>1?d.call(arguments):r,n===a?o.notifyWith(t,n):--i||o.resolveWith(t,n)}},a,u,l;if(r>1)for(a=Array(r),u=Array(r),l=Array(r);r>t;t++)n[t]&&x.isFunction(n[t].promise)?n[t].promise().done(s(t,l,n)).fail(o.reject).progress(s(t,u,a)):--i;return i||o.resolveWith(l,n),o.promise()}}),x.support=function(t){var n=o.createElement("input"),r=o.createDocumentFragment(),i=o.createElement("div"),s=o.createElement("select"),a=s.appendChild(o.createElement("option"));return n.type?(n.type="checkbox",t.checkOn=""!==n.value,t.optSelected=a.selected,t.reliableMarginRight=!0,t.boxSizingReliable=!0,t.pixelPosition=!1,n.checked=!0,t.noCloneChecked=n.cloneNode(!0).checked,s.disabled=!0,t.optDisabled=!a.disabled,n=o.createElement("input"),n.value="t",n.type="radio",t.radioValue="t"===n.value,n.setAttribute("checked","t"),n.setAttribute("name","t"),r.appendChild(n),t.checkClone=r.cloneNode(!0).cloneNode(!0).lastChild.checked,t.focusinBubbles="onfocusin"in e,i.style.backgroundClip="content-box",i.cloneNode(!0).style.backgroundClip="",t.clearCloneStyle="content-box"===i.style.backgroundClip,x(function(){var n,r,s="padding:0;margin:0;border:0;display:block;-webkit-box-sizing:content-box;-moz-box-sizing:content-box;box-sizing:content-box",a=o.getElementsByTagName("body")[0];a&&(n=o.createElement("div"),n.style.cssText="border:0;width:0;height:0;position:absolute;top:0;left:-9999px;margin-top:1px",a.appendChild(n).appendChild(i),i.innerHTML="",i.style.cssText="-webkit-box-sizing:border-box;-moz-box-sizing:border-box;box-sizing:border-box;padding:1px;border:1px;display:block;width:4px;margin-top:1%;position:absolute;top:1%",x.swap(a,null!=a.style.zoom?{zoom:1}:{},function(){t.boxSizing=4===i.offsetWidth}),e.getComputedStyle&&(t.pixelPosition="1%"!==(e.getComputedStyle(i,null)||{}).top,t.boxSizingReliable="4px"===(e.getComputedStyle(i,null)||{width:"4px"}).width,r=i.appendChild(o.createElement("div")),r.style.cssText=i.style.cssText=s,r.style.marginRight=r.style.width="0",i.style.width="1px",t.reliableMarginRight=!parseFloat((e.getComputedStyle(r,null)||{}).marginRight)),a.removeChild(n))}),t):t}({});var L,q,H=/(?:\{[\s\S]*\}|\[[\s\S]*\])$/,O=/([A-Z])/g;function F(){Object.defineProperty(this.cache={},0,{get:function(){return{}}}),this.expando=x.expando+Math.random()}F.uid=1,F.accepts=function(e){return e.nodeType?1===e.nodeType||9===e.nodeType:!0},F.prototype={key:function(e){if(!F.accepts(e))return 0;var t={},n=e[this.expando];if(!n){n=F.uid++;try{t[this.expando]={value:n},Object.defineProperties(e,t)}catch(r){t[this.expando]=n,x.extend(e,t)}}return this.cache[n]||(this.cache[n]={}),n},set:function(e,t,n){var r,i=this.key(e),o=this.cache[i];if("string"==typeof t)o[t]=n;else if(x.isEmptyObject(o))x.extend(this.cache[i],t);else for(r in t)o[r]=t[r];return o},get:function(e,t){var n=this.cache[this.key(e)];return t===undefined?n:n[t]},access:function(e,t,n){var r;return t===undefined||t&&"string"==typeof t&&n===undefined?(r=this.get(e,t),r!==undefined?r:this.get(e,x.camelCase(t))):(this.set(e,t,n),n!==undefined?n:t)},remove:function(e,t){var n,r,i,o=this.key(e),s=this.cache[o];if(t===undefined)this.cache[o]={};else{x.isArray(t)?r=t.concat(t.map(x.camelCase)):(i=x.camelCase(t),t in s?r=[t,i]:(r=i,r=r in s?[r]:r.match(w)||[])),n=r.length;while(n--)delete s[r[n]]}},hasData:function(e){return!x.isEmptyObject(this.cache[e[this.expando]]||{})},discard:function(e){e[this.expando]&&delete this.cache[e[this.expando]]}},L=new F,q=new F,x.extend({acceptData:F.accepts,hasData:function(e){return L.hasData(e)||q.hasData(e)},data:function(e,t,n){return L.access(e,t,n)},removeData:function(e,t){L.remove(e,t)},_data:function(e,t,n){return q.access(e,t,n)},_removeData:function(e,t){q.remove(e,t)}}),x.fn.extend({data:function(e,t){var n,r,i=this[0],o=0,s=null;if(e===undefined){if(this.length&&(s=L.get(i),1===i.nodeType&&!q.get(i,"hasDataAttrs"))){for(n=i.attributes;n.length>o;o++)r=n[o].name,0===r.indexOf("data-")&&(r=x.camelCase(r.slice(5)),P(i,r,s[r]));q.set(i,"hasDataAttrs",!0)}return s}return"object"==typeof e?this.each(function(){L.set(this,e)}):x.access(this,function(t){var n,r=x.camelCase(e);if(i&&t===undefined){if(n=L.get(i,e),n!==undefined)return n;if(n=L.get(i,r),n!==undefined)return n;if(n=P(i,r,undefined),n!==undefined)return n}else this.each(function(){var n=L.get(this,r);L.set(this,r,t),-1!==e.indexOf("-")&&n!==undefined&&L.set(this,e,t)})},null,t,arguments.length>1,null,!0)},removeData:function(e){return this.each(function(){L.remove(this,e)})}});function P(e,t,n){var r;if(n===undefined&&1===e.nodeType)if(r="data-"+t.replace(O,"-$1").toLowerCase(),n=e.getAttribute(r),"string"==typeof n){try{n="true"===n?!0:"false"===n?!1:"null"===n?null:+n+""===n?+n:H.test(n)?JSON.parse(n):n}catch(i){}L.set(e,t,n)}else n=undefined;return n}x.extend({queue:function(e,t,n){var r;return e?(t=(t||"fx")+"queue",r=q.get(e,t),n&&(!r||x.isArray(n)?r=q.access(e,t,x.makeArray(n)):r.push(n)),r||[]):undefined},dequeue:function(e,t){t=t||"fx";var n=x.queue(e,t),r=n.length,i=n.shift(),o=x._queueHooks(e,t),s=function(){x.dequeue(e,t)
+};"inprogress"===i&&(i=n.shift(),r--),i&&("fx"===t&&n.unshift("inprogress"),delete o.stop,i.call(e,s,o)),!r&&o&&o.empty.fire()},_queueHooks:function(e,t){var n=t+"queueHooks";return q.get(e,n)||q.access(e,n,{empty:x.Callbacks("once memory").add(function(){q.remove(e,[t+"queue",n])})})}}),x.fn.extend({queue:function(e,t){var n=2;return"string"!=typeof e&&(t=e,e="fx",n--),n>arguments.length?x.queue(this[0],e):t===undefined?this:this.each(function(){var n=x.queue(this,e,t);x._queueHooks(this,e),"fx"===e&&"inprogress"!==n[0]&&x.dequeue(this,e)})},dequeue:function(e){return this.each(function(){x.dequeue(this,e)})},delay:function(e,t){return e=x.fx?x.fx.speeds[e]||e:e,t=t||"fx",this.queue(t,function(t,n){var r=setTimeout(t,e);n.stop=function(){clearTimeout(r)}})},clearQueue:function(e){return this.queue(e||"fx",[])},promise:function(e,t){var n,r=1,i=x.Deferred(),o=this,s=this.length,a=function(){--r||i.resolveWith(o,[o])};"string"!=typeof e&&(t=e,e=undefined),e=e||"fx";while(s--)n=q.get(o[s],e+"queueHooks"),n&&n.empty&&(r++,n.empty.add(a));return a(),i.promise(t)}});var R,M,W=/[\t\r\n\f]/g,$=/\r/g,B=/^(?:input|select|textarea|button)$/i;x.fn.extend({attr:function(e,t){return x.access(this,x.attr,e,t,arguments.length>1)},removeAttr:function(e){return this.each(function(){x.removeAttr(this,e)})},prop:function(e,t){return x.access(this,x.prop,e,t,arguments.length>1)},removeProp:function(e){return this.each(function(){delete this[x.propFix[e]||e]})},addClass:function(e){var t,n,r,i,o,s=0,a=this.length,u="string"==typeof e&&e;if(x.isFunction(e))return this.each(function(t){x(this).addClass(e.call(this,t,this.className))});if(u)for(t=(e||"").match(w)||[];a>s;s++)if(n=this[s],r=1===n.nodeType&&(n.className?(" "+n.className+" ").replace(W," "):" ")){o=0;while(i=t[o++])0>r.indexOf(" "+i+" ")&&(r+=i+" ");n.className=x.trim(r)}return this},removeClass:function(e){var t,n,r,i,o,s=0,a=this.length,u=0===arguments.length||"string"==typeof e&&e;if(x.isFunction(e))return this.each(function(t){x(this).removeClass(e.call(this,t,this.className))});if(u)for(t=(e||"").match(w)||[];a>s;s++)if(n=this[s],r=1===n.nodeType&&(n.className?(" "+n.className+" ").replace(W," "):"")){o=0;while(i=t[o++])while(r.indexOf(" "+i+" ")>=0)r=r.replace(" "+i+" "," ");n.className=e?x.trim(r):""}return this},toggleClass:function(e,t){var n=typeof e;return"boolean"==typeof t&&"string"===n?t?this.addClass(e):this.removeClass(e):x.isFunction(e)?this.each(function(n){x(this).toggleClass(e.call(this,n,this.className,t),t)}):this.each(function(){if("string"===n){var t,i=0,o=x(this),s=e.match(w)||[];while(t=s[i++])o.hasClass(t)?o.removeClass(t):o.addClass(t)}else(n===r||"boolean"===n)&&(this.className&&q.set(this,"__className__",this.className),this.className=this.className||e===!1?"":q.get(this,"__className__")||"")})},hasClass:function(e){var t=" "+e+" ",n=0,r=this.length;for(;r>n;n++)if(1===this[n].nodeType&&(" "+this[n].className+" ").replace(W," ").indexOf(t)>=0)return!0;return!1},val:function(e){var t,n,r,i=this[0];{if(arguments.length)return r=x.isFunction(e),this.each(function(n){var i;1===this.nodeType&&(i=r?e.call(this,n,x(this).val()):e,null==i?i="":"number"==typeof i?i+="":x.isArray(i)&&(i=x.map(i,function(e){return null==e?"":e+""})),t=x.valHooks[this.type]||x.valHooks[this.nodeName.toLowerCase()],t&&"set"in t&&t.set(this,i,"value")!==undefined||(this.value=i))});if(i)return t=x.valHooks[i.type]||x.valHooks[i.nodeName.toLowerCase()],t&&"get"in t&&(n=t.get(i,"value"))!==undefined?n:(n=i.value,"string"==typeof n?n.replace($,""):null==n?"":n)}}}),x.extend({valHooks:{option:{get:function(e){var t=e.attributes.value;return!t||t.specified?e.value:e.text}},select:{get:function(e){var t,n,r=e.options,i=e.selectedIndex,o="select-one"===e.type||0>i,s=o?null:[],a=o?i+1:r.length,u=0>i?a:o?i:0;for(;a>u;u++)if(n=r[u],!(!n.selected&&u!==i||(x.support.optDisabled?n.disabled:null!==n.getAttribute("disabled"))||n.parentNode.disabled&&x.nodeName(n.parentNode,"optgroup"))){if(t=x(n).val(),o)return t;s.push(t)}return s},set:function(e,t){var n,r,i=e.options,o=x.makeArray(t),s=i.length;while(s--)r=i[s],(r.selected=x.inArray(x(r).val(),o)>=0)&&(n=!0);return n||(e.selectedIndex=-1),o}}},attr:function(e,t,n){var i,o,s=e.nodeType;if(e&&3!==s&&8!==s&&2!==s)return typeof e.getAttribute===r?x.prop(e,t,n):(1===s&&x.isXMLDoc(e)||(t=t.toLowerCase(),i=x.attrHooks[t]||(x.expr.match.bool.test(t)?M:R)),n===undefined?i&&"get"in i&&null!==(o=i.get(e,t))?o:(o=x.find.attr(e,t),null==o?undefined:o):null!==n?i&&"set"in i&&(o=i.set(e,n,t))!==undefined?o:(e.setAttribute(t,n+""),n):(x.removeAttr(e,t),undefined))},removeAttr:function(e,t){var n,r,i=0,o=t&&t.match(w);if(o&&1===e.nodeType)while(n=o[i++])r=x.propFix[n]||n,x.expr.match.bool.test(n)&&(e[r]=!1),e.removeAttribute(n)},attrHooks:{type:{set:function(e,t){if(!x.support.radioValue&&"radio"===t&&x.nodeName(e,"input")){var n=e.value;return e.setAttribute("type",t),n&&(e.value=n),t}}}},propFix:{"for":"htmlFor","class":"className"},prop:function(e,t,n){var r,i,o,s=e.nodeType;if(e&&3!==s&&8!==s&&2!==s)return o=1!==s||!x.isXMLDoc(e),o&&(t=x.propFix[t]||t,i=x.propHooks[t]),n!==undefined?i&&"set"in i&&(r=i.set(e,n,t))!==undefined?r:e[t]=n:i&&"get"in i&&null!==(r=i.get(e,t))?r:e[t]},propHooks:{tabIndex:{get:function(e){return e.hasAttribute("tabindex")||B.test(e.nodeName)||e.href?e.tabIndex:-1}}}}),M={set:function(e,t,n){return t===!1?x.removeAttr(e,n):e.setAttribute(n,n),n}},x.each(x.expr.match.bool.source.match(/\w+/g),function(e,t){var n=x.expr.attrHandle[t]||x.find.attr;x.expr.attrHandle[t]=function(e,t,r){var i=x.expr.attrHandle[t],o=r?undefined:(x.expr.attrHandle[t]=undefined)!=n(e,t,r)?t.toLowerCase():null;return x.expr.attrHandle[t]=i,o}}),x.support.optSelected||(x.propHooks.selected={get:function(e){var t=e.parentNode;return t&&t.parentNode&&t.parentNode.selectedIndex,null}}),x.each(["tabIndex","readOnly","maxLength","cellSpacing","cellPadding","rowSpan","colSpan","useMap","frameBorder","contentEditable"],function(){x.propFix[this.toLowerCase()]=this}),x.each(["radio","checkbox"],function(){x.valHooks[this]={set:function(e,t){return x.isArray(t)?e.checked=x.inArray(x(e).val(),t)>=0:undefined}},x.support.checkOn||(x.valHooks[this].get=function(e){return null===e.getAttribute("value")?"on":e.value})});var I=/^key/,z=/^(?:mouse|contextmenu)|click/,_=/^(?:focusinfocus|focusoutblur)$/,X=/^([^.]*)(?:\.(.+)|)$/;function U(){return!0}function Y(){return!1}function V(){try{return o.activeElement}catch(e){}}x.event={global:{},add:function(e,t,n,i,o){var s,a,u,l,c,p,f,h,d,g,m,y=q.get(e);if(y){n.handler&&(s=n,n=s.handler,o=s.selector),n.guid||(n.guid=x.guid++),(l=y.events)||(l=y.events={}),(a=y.handle)||(a=y.handle=function(e){return typeof x===r||e&&x.event.triggered===e.type?undefined:x.event.dispatch.apply(a.elem,arguments)},a.elem=e),t=(t||"").match(w)||[""],c=t.length;while(c--)u=X.exec(t[c])||[],d=m=u[1],g=(u[2]||"").split(".").sort(),d&&(f=x.event.special[d]||{},d=(o?f.delegateType:f.bindType)||d,f=x.event.special[d]||{},p=x.extend({type:d,origType:m,data:i,handler:n,guid:n.guid,selector:o,needsContext:o&&x.expr.match.needsContext.test(o),namespace:g.join(".")},s),(h=l[d])||(h=l[d]=[],h.delegateCount=0,f.setup&&f.setup.call(e,i,g,a)!==!1||e.addEventListener&&e.addEventListener(d,a,!1)),f.add&&(f.add.call(e,p),p.handler.guid||(p.handler.guid=n.guid)),o?h.splice(h.delegateCount++,0,p):h.push(p),x.event.global[d]=!0);e=null}},remove:function(e,t,n,r,i){var o,s,a,u,l,c,p,f,h,d,g,m=q.hasData(e)&&q.get(e);if(m&&(u=m.events)){t=(t||"").match(w)||[""],l=t.length;while(l--)if(a=X.exec(t[l])||[],h=g=a[1],d=(a[2]||"").split(".").sort(),h){p=x.event.special[h]||{},h=(r?p.delegateType:p.bindType)||h,f=u[h]||[],a=a[2]&&RegExp("(^|\\.)"+d.join("\\.(?:.*\\.|)")+"(\\.|$)"),s=o=f.length;while(o--)c=f[o],!i&&g!==c.origType||n&&n.guid!==c.guid||a&&!a.test(c.namespace)||r&&r!==c.selector&&("**"!==r||!c.selector)||(f.splice(o,1),c.selector&&f.delegateCount--,p.remove&&p.remove.call(e,c));s&&!f.length&&(p.teardown&&p.teardown.call(e,d,m.handle)!==!1||x.removeEvent(e,h,m.handle),delete u[h])}else for(h in u)x.event.remove(e,h+t[l],n,r,!0);x.isEmptyObject(u)&&(delete m.handle,q.remove(e,"events"))}},trigger:function(t,n,r,i){var s,a,u,l,c,p,f,h=[r||o],d=y.call(t,"type")?t.type:t,g=y.call(t,"namespace")?t.namespace.split("."):[];if(a=u=r=r||o,3!==r.nodeType&&8!==r.nodeType&&!_.test(d+x.event.triggered)&&(d.indexOf(".")>=0&&(g=d.split("."),d=g.shift(),g.sort()),c=0>d.indexOf(":")&&"on"+d,t=t[x.expando]?t:new x.Event(d,"object"==typeof t&&t),t.isTrigger=i?2:3,t.namespace=g.join("."),t.namespace_re=t.namespace?RegExp("(^|\\.)"+g.join("\\.(?:.*\\.|)")+"(\\.|$)"):null,t.result=undefined,t.target||(t.target=r),n=null==n?[t]:x.makeArray(n,[t]),f=x.event.special[d]||{},i||!f.trigger||f.trigger.apply(r,n)!==!1)){if(!i&&!f.noBubble&&!x.isWindow(r)){for(l=f.delegateType||d,_.test(l+d)||(a=a.parentNode);a;a=a.parentNode)h.push(a),u=a;u===(r.ownerDocument||o)&&h.push(u.defaultView||u.parentWindow||e)}s=0;while((a=h[s++])&&!t.isPropagationStopped())t.type=s>1?l:f.bindType||d,p=(q.get(a,"events")||{})[t.type]&&q.get(a,"handle"),p&&p.apply(a,n),p=c&&a[c],p&&x.acceptData(a)&&p.apply&&p.apply(a,n)===!1&&t.preventDefault();return t.type=d,i||t.isDefaultPrevented()||f._default&&f._default.apply(h.pop(),n)!==!1||!x.acceptData(r)||c&&x.isFunction(r[d])&&!x.isWindow(r)&&(u=r[c],u&&(r[c]=null),x.event.triggered=d,r[d](),x.event.triggered=undefined,u&&(r[c]=u)),t.result}},dispatch:function(e){e=x.event.fix(e);var t,n,r,i,o,s=[],a=d.call(arguments),u=(q.get(this,"events")||{})[e.type]||[],l=x.event.special[e.type]||{};if(a[0]=e,e.delegateTarget=this,!l.preDispatch||l.preDispatch.call(this,e)!==!1){s=x.event.handlers.call(this,e,u),t=0;while((i=s[t++])&&!e.isPropagationStopped()){e.currentTarget=i.elem,n=0;while((o=i.handlers[n++])&&!e.isImmediatePropagationStopped())(!e.namespace_re||e.namespace_re.test(o.namespace))&&(e.handleObj=o,e.data=o.data,r=((x.event.special[o.origType]||{}).handle||o.handler).apply(i.elem,a),r!==undefined&&(e.result=r)===!1&&(e.preventDefault(),e.stopPropagation()))}return l.postDispatch&&l.postDispatch.call(this,e),e.result}},handlers:function(e,t){var n,r,i,o,s=[],a=t.delegateCount,u=e.target;if(a&&u.nodeType&&(!e.button||"click"!==e.type))for(;u!==this;u=u.parentNode||this)if(u.disabled!==!0||"click"!==e.type){for(r=[],n=0;a>n;n++)o=t[n],i=o.selector+" ",r[i]===undefined&&(r[i]=o.needsContext?x(i,this).index(u)>=0:x.find(i,this,null,[u]).length),r[i]&&r.push(o);r.length&&s.push({elem:u,handlers:r})}return t.length>a&&s.push({elem:this,handlers:t.slice(a)}),s},props:"altKey bubbles cancelable ctrlKey currentTarget eventPhase metaKey relatedTarget shiftKey target timeStamp view which".split(" "),fixHooks:{},keyHooks:{props:"char charCode key keyCode".split(" "),filter:function(e,t){return null==e.which&&(e.which=null!=t.charCode?t.charCode:t.keyCode),e}},mouseHooks:{props:"button buttons clientX clientY offsetX offsetY pageX pageY screenX screenY toElement".split(" "),filter:function(e,t){var n,r,i,s=t.button;return null==e.pageX&&null!=t.clientX&&(n=e.target.ownerDocument||o,r=n.documentElement,i=n.body,e.pageX=t.clientX+(r&&r.scrollLeft||i&&i.scrollLeft||0)-(r&&r.clientLeft||i&&i.clientLeft||0),e.pageY=t.clientY+(r&&r.scrollTop||i&&i.scrollTop||0)-(r&&r.clientTop||i&&i.clientTop||0)),e.which||s===undefined||(e.which=1&s?1:2&s?3:4&s?2:0),e}},fix:function(e){if(e[x.expando])return e;var t,n,r,i=e.type,s=e,a=this.fixHooks[i];a||(this.fixHooks[i]=a=z.test(i)?this.mouseHooks:I.test(i)?this.keyHooks:{}),r=a.props?this.props.concat(a.props):this.props,e=new x.Event(s),t=r.length;while(t--)n=r[t],e[n]=s[n];return e.target||(e.target=o),3===e.target.nodeType&&(e.target=e.target.parentNode),a.filter?a.filter(e,s):e},special:{load:{noBubble:!0},focus:{trigger:function(){return this!==V()&&this.focus?(this.focus(),!1):undefined},delegateType:"focusin"},blur:{trigger:function(){return this===V()&&this.blur?(this.blur(),!1):undefined},delegateType:"focusout"},click:{trigger:function(){return"checkbox"===this.type&&this.click&&x.nodeName(this,"input")?(this.click(),!1):undefined},_default:function(e){return x.nodeName(e.target,"a")}},beforeunload:{postDispatch:function(e){e.result!==undefined&&(e.originalEvent.returnValue=e.result)}}},simulate:function(e,t,n,r){var i=x.extend(new x.Event,n,{type:e,isSimulated:!0,originalEvent:{}});r?x.event.trigger(i,null,t):x.event.dispatch.call(t,i),i.isDefaultPrevented()&&n.preventDefault()}},x.removeEvent=function(e,t,n){e.removeEventListener&&e.removeEventListener(t,n,!1)},x.Event=function(e,t){return this instanceof x.Event?(e&&e.type?(this.originalEvent=e,this.type=e.type,this.isDefaultPrevented=e.defaultPrevented||e.getPreventDefault&&e.getPreventDefault()?U:Y):this.type=e,t&&x.extend(this,t),this.timeStamp=e&&e.timeStamp||x.now(),this[x.expando]=!0,undefined):new x.Event(e,t)},x.Event.prototype={isDefaultPrevented:Y,isPropagationStopped:Y,isImmediatePropagationStopped:Y,preventDefault:function(){var e=this.originalEvent;this.isDefaultPrevented=U,e&&e.preventDefault&&e.preventDefault()},stopPropagation:function(){var e=this.originalEvent;this.isPropagationStopped=U,e&&e.stopPropagation&&e.stopPropagation()},stopImmediatePropagation:function(){this.isImmediatePropagationStopped=U,this.stopPropagation()}},x.each({mouseenter:"mouseover",mouseleave:"mouseout"},function(e,t){x.event.special[e]={delegateType:t,bindType:t,handle:function(e){var n,r=this,i=e.relatedTarget,o=e.handleObj;return(!i||i!==r&&!x.contains(r,i))&&(e.type=o.origType,n=o.handler.apply(this,arguments),e.type=t),n}}}),x.support.focusinBubbles||x.each({focus:"focusin",blur:"focusout"},function(e,t){var n=0,r=function(e){x.event.simulate(t,e.target,x.event.fix(e),!0)};x.event.special[t]={setup:function(){0===n++&&o.addEventListener(e,r,!0)},teardown:function(){0===--n&&o.removeEventListener(e,r,!0)}}}),x.fn.extend({on:function(e,t,n,r,i){var o,s;if("object"==typeof e){"string"!=typeof t&&(n=n||t,t=undefined);for(s in e)this.on(s,t,n,e[s],i);return this}if(null==n&&null==r?(r=t,n=t=undefined):null==r&&("string"==typeof t?(r=n,n=undefined):(r=n,n=t,t=undefined)),r===!1)r=Y;else if(!r)return this;return 1===i&&(o=r,r=function(e){return x().off(e),o.apply(this,arguments)},r.guid=o.guid||(o.guid=x.guid++)),this.each(function(){x.event.add(this,e,r,n,t)})},one:function(e,t,n,r){return this.on(e,t,n,r,1)},off:function(e,t,n){var r,i;if(e&&e.preventDefault&&e.handleObj)return r=e.handleObj,x(e.delegateTarget).off(r.namespace?r.origType+"."+r.namespace:r.origType,r.selector,r.handler),this;if("object"==typeof e){for(i in e)this.off(i,t,e[i]);return this}return(t===!1||"function"==typeof t)&&(n=t,t=undefined),n===!1&&(n=Y),this.each(function(){x.event.remove(this,e,n,t)})},trigger:function(e,t){return this.each(function(){x.event.trigger(e,t,this)})},triggerHandler:function(e,t){var n=this[0];return n?x.event.trigger(e,t,n,!0):undefined}});var G=/^.[^:#\[\.,]*$/,J=/^(?:parents|prev(?:Until|All))/,Q=x.expr.match.needsContext,K={children:!0,contents:!0,next:!0,prev:!0};x.fn.extend({find:function(e){var t,n=[],r=this,i=r.length;if("string"!=typeof e)return this.pushStack(x(e).filter(function(){for(t=0;i>t;t++)if(x.contains(r[t],this))return!0}));for(t=0;i>t;t++)x.find(e,r[t],n);return n=this.pushStack(i>1?x.unique(n):n),n.selector=this.selector?this.selector+" "+e:e,n},has:function(e){var t=x(e,this),n=t.length;return this.filter(function(){var e=0;for(;n>e;e++)if(x.contains(this,t[e]))return!0})},not:function(e){return this.pushStack(et(this,e||[],!0))},filter:function(e){return this.pushStack(et(this,e||[],!1))},is:function(e){return!!et(this,"string"==typeof e&&Q.test(e)?x(e):e||[],!1).length},closest:function(e,t){var n,r=0,i=this.length,o=[],s=Q.test(e)||"string"!=typeof e?x(e,t||this.context):0;for(;i>r;r++)for(n=this[r];n&&n!==t;n=n.parentNode)if(11>n.nodeType&&(s?s.index(n)>-1:1===n.nodeType&&x.find.matchesSelector(n,e))){n=o.push(n);break}return this.pushStack(o.length>1?x.unique(o):o)},index:function(e){return e?"string"==typeof e?g.call(x(e),this[0]):g.call(this,e.jquery?e[0]:e):this[0]&&this[0].parentNode?this.first().prevAll().length:-1},add:function(e,t){var n="string"==typeof e?x(e,t):x.makeArray(e&&e.nodeType?[e]:e),r=x.merge(this.get(),n);return this.pushStack(x.unique(r))},addBack:function(e){return this.add(null==e?this.prevObject:this.prevObject.filter(e))}});function Z(e,t){while((e=e[t])&&1!==e.nodeType);return e}x.each({parent:function(e){var t=e.parentNode;return t&&11!==t.nodeType?t:null},parents:function(e){return x.dir(e,"parentNode")},parentsUntil:function(e,t,n){return x.dir(e,"parentNode",n)},next:function(e){return Z(e,"nextSibling")},prev:function(e){return Z(e,"previousSibling")},nextAll:function(e){return x.dir(e,"nextSibling")},prevAll:function(e){return x.dir(e,"previousSibling")},nextUntil:function(e,t,n){return x.dir(e,"nextSibling",n)},prevUntil:function(e,t,n){return x.dir(e,"previousSibling",n)},siblings:function(e){return x.sibling((e.parentNode||{}).firstChild,e)},children:function(e){return x.sibling(e.firstChild)},contents:function(e){return e.contentDocument||x.merge([],e.childNodes)}},function(e,t){x.fn[e]=function(n,r){var i=x.map(this,t,n);return"Until"!==e.slice(-5)&&(r=n),r&&"string"==typeof r&&(i=x.filter(r,i)),this.length>1&&(K[e]||x.unique(i),J.test(e)&&i.reverse()),this.pushStack(i)}}),x.extend({filter:function(e,t,n){var r=t[0];return n&&(e=":not("+e+")"),1===t.length&&1===r.nodeType?x.find.matchesSelector(r,e)?[r]:[]:x.find.matches(e,x.grep(t,function(e){return 1===e.nodeType}))},dir:function(e,t,n){var r=[],i=n!==undefined;while((e=e[t])&&9!==e.nodeType)if(1===e.nodeType){if(i&&x(e).is(n))break;r.push(e)}return r},sibling:function(e,t){var n=[];for(;e;e=e.nextSibling)1===e.nodeType&&e!==t&&n.push(e);return n}});function et(e,t,n){if(x.isFunction(t))return x.grep(e,function(e,r){return!!t.call(e,r,e)!==n});if(t.nodeType)return x.grep(e,function(e){return e===t!==n});if("string"==typeof t){if(G.test(t))return x.filter(t,e,n);t=x.filter(t,e)}return x.grep(e,function(e){return g.call(t,e)>=0!==n})}var tt=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/gi,nt=/<([\w:]+)/,rt=/<|&#?\w+;/,it=/<(?:script|style|link)/i,ot=/^(?:checkbox|radio)$/i,st=/checked\s*(?:[^=]|=\s*.checked.)/i,at=/^$|\/(?:java|ecma)script/i,ut=/^true\/(.*)/,lt=/^\s*<!(?:\[CDATA\[|--)|(?:\]\]|--)>\s*$/g,ct={option:[1,"<select multiple='multiple'>","</select>"],thead:[1,"<table>","</table>"],col:[2,"<table><colgroup>","</colgroup></table>"],tr:[2,"<table><tbody>","</tbody></table>"],td:[3,"<table><tbody><tr>","</tr></tbody></table>"],_default:[0,"",""]};ct.optgroup=ct.option,ct.tbody=ct.tfoot=ct.colgroup=ct.caption=ct.thead,ct.th=ct.td,x.fn.extend({text:function(e){return x.access(this,function(e){return e===undefined?x.text(this):this.empty().append((this[0]&&this[0].ownerDocument||o).createTextNode(e))},null,e,arguments.length)},append:function(){return this.domManip(arguments,function(e){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var t=pt(this,e);t.appendChild(e)}})},prepend:function(){return this.domManip(arguments,function(e){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var t=pt(this,e);t.insertBefore(e,t.firstChild)}})},before:function(){return this.domManip(arguments,function(e){this.parentNode&&this.parentNode.insertBefore(e,this)})},after:function(){return this.domManip(arguments,function(e){this.parentNode&&this.parentNode.insertBefore(e,this.nextSibling)})},remove:function(e,t){var n,r=e?x.filter(e,this):this,i=0;for(;null!=(n=r[i]);i++)t||1!==n.nodeType||x.cleanData(mt(n)),n.parentNode&&(t&&x.contains(n.ownerDocument,n)&&dt(mt(n,"script")),n.parentNode.removeChild(n));return this},empty:function(){var e,t=0;for(;null!=(e=this[t]);t++)1===e.nodeType&&(x.cleanData(mt(e,!1)),e.textContent="");return this},clone:function(e,t){return e=null==e?!1:e,t=null==t?e:t,this.map(function(){return x.clone(this,e,t)})},html:function(e){return x.access(this,function(e){var t=this[0]||{},n=0,r=this.length;if(e===undefined&&1===t.nodeType)return t.innerHTML;if("string"==typeof e&&!it.test(e)&&!ct[(nt.exec(e)||["",""])[1].toLowerCase()]){e=e.replace(tt,"<$1></$2>");try{for(;r>n;n++)t=this[n]||{},1===t.nodeType&&(x.cleanData(mt(t,!1)),t.innerHTML=e);t=0}catch(i){}}t&&this.empty().append(e)},null,e,arguments.length)},replaceWith:function(){var e=x.map(this,function(e){return[e.nextSibling,e.parentNode]}),t=0;return this.domManip(arguments,function(n){var r=e[t++],i=e[t++];i&&(r&&r.parentNode!==i&&(r=this.nextSibling),x(this).remove(),i.insertBefore(n,r))},!0),t?this:this.remove()},detach:function(e){return this.remove(e,!0)},domManip:function(e,t,n){e=f.apply([],e);var r,i,o,s,a,u,l=0,c=this.length,p=this,h=c-1,d=e[0],g=x.isFunction(d);if(g||!(1>=c||"string"!=typeof d||x.support.checkClone)&&st.test(d))return this.each(function(r){var i=p.eq(r);g&&(e[0]=d.call(this,r,i.html())),i.domManip(e,t,n)});if(c&&(r=x.buildFragment(e,this[0].ownerDocument,!1,!n&&this),i=r.firstChild,1===r.childNodes.length&&(r=i),i)){for(o=x.map(mt(r,"script"),ft),s=o.length;c>l;l++)a=r,l!==h&&(a=x.clone(a,!0,!0),s&&x.merge(o,mt(a,"script"))),t.call(this[l],a,l);if(s)for(u=o[o.length-1].ownerDocument,x.map(o,ht),l=0;s>l;l++)a=o[l],at.test(a.type||"")&&!q.access(a,"globalEval")&&x.contains(u,a)&&(a.src?x._evalUrl(a.src):x.globalEval(a.textContent.replace(lt,"")))}return this}}),x.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(e,t){x.fn[e]=function(e){var n,r=[],i=x(e),o=i.length-1,s=0;for(;o>=s;s++)n=s===o?this:this.clone(!0),x(i[s])[t](n),h.apply(r,n.get());return this.pushStack(r)}}),x.extend({clone:function(e,t,n){var r,i,o,s,a=e.cloneNode(!0),u=x.contains(e.ownerDocument,e);if(!(x.support.noCloneChecked||1!==e.nodeType&&11!==e.nodeType||x.isXMLDoc(e)))for(s=mt(a),o=mt(e),r=0,i=o.length;i>r;r++)yt(o[r],s[r]);if(t)if(n)for(o=o||mt(e),s=s||mt(a),r=0,i=o.length;i>r;r++)gt(o[r],s[r]);else gt(e,a);return s=mt(a,"script"),s.length>0&&dt(s,!u&&mt(e,"script")),a},buildFragment:function(e,t,n,r){var i,o,s,a,u,l,c=0,p=e.length,f=t.createDocumentFragment(),h=[];for(;p>c;c++)if(i=e[c],i||0===i)if("object"===x.type(i))x.merge(h,i.nodeType?[i]:i);else if(rt.test(i)){o=o||f.appendChild(t.createElement("div")),s=(nt.exec(i)||["",""])[1].toLowerCase(),a=ct[s]||ct._default,o.innerHTML=a[1]+i.replace(tt,"<$1></$2>")+a[2],l=a[0];while(l--)o=o.lastChild;x.merge(h,o.childNodes),o=f.firstChild,o.textContent=""}else h.push(t.createTextNode(i));f.textContent="",c=0;while(i=h[c++])if((!r||-1===x.inArray(i,r))&&(u=x.contains(i.ownerDocument,i),o=mt(f.appendChild(i),"script"),u&&dt(o),n)){l=0;while(i=o[l++])at.test(i.type||"")&&n.push(i)}return f},cleanData:function(e){var t,n,r,i,o,s,a=x.event.special,u=0;for(;(n=e[u])!==undefined;u++){if(F.accepts(n)&&(o=n[q.expando],o&&(t=q.cache[o]))){if(r=Object.keys(t.events||{}),r.length)for(s=0;(i=r[s])!==undefined;s++)a[i]?x.event.remove(n,i):x.removeEvent(n,i,t.handle);q.cache[o]&&delete q.cache[o]}delete L.cache[n[L.expando]]}},_evalUrl:function(e){return x.ajax({url:e,type:"GET",dataType:"script",async:!1,global:!1,"throws":!0})}});function pt(e,t){return x.nodeName(e,"table")&&x.nodeName(1===t.nodeType?t:t.firstChild,"tr")?e.getElementsByTagName("tbody")[0]||e.appendChild(e.ownerDocument.createElement("tbody")):e}function ft(e){return e.type=(null!==e.getAttribute("type"))+"/"+e.type,e}function ht(e){var t=ut.exec(e.type);return t?e.type=t[1]:e.removeAttribute("type"),e}function dt(e,t){var n=e.length,r=0;for(;n>r;r++)q.set(e[r],"globalEval",!t||q.get(t[r],"globalEval"))}function gt(e,t){var n,r,i,o,s,a,u,l;if(1===t.nodeType){if(q.hasData(e)&&(o=q.access(e),s=q.set(t,o),l=o.events)){delete s.handle,s.events={};for(i in l)for(n=0,r=l[i].length;r>n;n++)x.event.add(t,i,l[i][n])}L.hasData(e)&&(a=L.access(e),u=x.extend({},a),L.set(t,u))}}function mt(e,t){var n=e.getElementsByTagName?e.getElementsByTagName(t||"*"):e.querySelectorAll?e.querySelectorAll(t||"*"):[];return t===undefined||t&&x.nodeName(e,t)?x.merge([e],n):n}function yt(e,t){var n=t.nodeName.toLowerCase();"input"===n&&ot.test(e.type)?t.checked=e.checked:("input"===n||"textarea"===n)&&(t.defaultValue=e.defaultValue)}x.fn.extend({wrapAll:function(e){var t;return x.isFunction(e)?this.each(function(t){x(this).wrapAll(e.call(this,t))}):(this[0]&&(t=x(e,this[0].ownerDocument).eq(0).clone(!0),this[0].parentNode&&t.insertBefore(this[0]),t.map(function(){var e=this;while(e.firstElementChild)e=e.firstElementChild;return e}).append(this)),this)},wrapInner:function(e){return x.isFunction(e)?this.each(function(t){x(this).wrapInner(e.call(this,t))}):this.each(function(){var t=x(this),n=t.contents();n.length?n.wrapAll(e):t.append(e)})},wrap:function(e){var t=x.isFunction(e);return this.each(function(n){x(this).wrapAll(t?e.call(this,n):e)})},unwrap:function(){return this.parent().each(function(){x.nodeName(this,"body")||x(this).replaceWith(this.childNodes)}).end()}});var vt,xt,bt=/^(none|table(?!-c[ea]).+)/,wt=/^margin/,Tt=RegExp("^("+b+")(.*)$","i"),Ct=RegExp("^("+b+")(?!px)[a-z%]+$","i"),kt=RegExp("^([+-])=("+b+")","i"),Nt={BODY:"block"},Et={position:"absolute",visibility:"hidden",display:"block"},St={letterSpacing:0,fontWeight:400},jt=["Top","Right","Bottom","Left"],Dt=["Webkit","O","Moz","ms"];function At(e,t){if(t in e)return t;var n=t.charAt(0).toUpperCase()+t.slice(1),r=t,i=Dt.length;while(i--)if(t=Dt[i]+n,t in e)return t;return r}function Lt(e,t){return e=t||e,"none"===x.css(e,"display")||!x.contains(e.ownerDocument,e)}function qt(t){return e.getComputedStyle(t,null)}function Ht(e,t){var n,r,i,o=[],s=0,a=e.length;for(;a>s;s++)r=e[s],r.style&&(o[s]=q.get(r,"olddisplay"),n=r.style.display,t?(o[s]||"none"!==n||(r.style.display=""),""===r.style.display&&Lt(r)&&(o[s]=q.access(r,"olddisplay",Rt(r.nodeName)))):o[s]||(i=Lt(r),(n&&"none"!==n||!i)&&q.set(r,"olddisplay",i?n:x.css(r,"display"))));for(s=0;a>s;s++)r=e[s],r.style&&(t&&"none"!==r.style.display&&""!==r.style.display||(r.style.display=t?o[s]||"":"none"));return e}x.fn.extend({css:function(e,t){return x.access(this,function(e,t,n){var r,i,o={},s=0;if(x.isArray(t)){for(r=qt(e),i=t.length;i>s;s++)o[t[s]]=x.css(e,t[s],!1,r);return o}return n!==undefined?x.style(e,t,n):x.css(e,t)},e,t,arguments.length>1)},show:function(){return Ht(this,!0)},hide:function(){return Ht(this)},toggle:function(e){return"boolean"==typeof e?e?this.show():this.hide():this.each(function(){Lt(this)?x(this).show():x(this).hide()})}}),x.extend({cssHooks:{opacity:{get:function(e,t){if(t){var n=vt(e,"opacity");return""===n?"1":n}}}},cssNumber:{columnCount:!0,fillOpacity:!0,fontWeight:!0,lineHeight:!0,opacity:!0,order:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":"cssFloat"},style:function(e,t,n,r){if(e&&3!==e.nodeType&&8!==e.nodeType&&e.style){var i,o,s,a=x.camelCase(t),u=e.style;return t=x.cssProps[a]||(x.cssProps[a]=At(u,a)),s=x.cssHooks[t]||x.cssHooks[a],n===undefined?s&&"get"in s&&(i=s.get(e,!1,r))!==undefined?i:u[t]:(o=typeof n,"string"===o&&(i=kt.exec(n))&&(n=(i[1]+1)*i[2]+parseFloat(x.css(e,t)),o="number"),null==n||"number"===o&&isNaN(n)||("number"!==o||x.cssNumber[a]||(n+="px"),x.support.clearCloneStyle||""!==n||0!==t.indexOf("background")||(u[t]="inherit"),s&&"set"in s&&(n=s.set(e,n,r))===undefined||(u[t]=n)),undefined)}},css:function(e,t,n,r){var i,o,s,a=x.camelCase(t);return t=x.cssProps[a]||(x.cssProps[a]=At(e.style,a)),s=x.cssHooks[t]||x.cssHooks[a],s&&"get"in s&&(i=s.get(e,!0,n)),i===undefined&&(i=vt(e,t,r)),"normal"===i&&t in St&&(i=St[t]),""===n||n?(o=parseFloat(i),n===!0||x.isNumeric(o)?o||0:i):i}}),vt=function(e,t,n){var r,i,o,s=n||qt(e),a=s?s.getPropertyValue(t)||s[t]:undefined,u=e.style;return s&&(""!==a||x.contains(e.ownerDocument,e)||(a=x.style(e,t)),Ct.test(a)&&wt.test(t)&&(r=u.width,i=u.minWidth,o=u.maxWidth,u.minWidth=u.maxWidth=u.width=a,a=s.width,u.width=r,u.minWidth=i,u.maxWidth=o)),a};function Ot(e,t,n){var r=Tt.exec(t);return r?Math.max(0,r[1]-(n||0))+(r[2]||"px"):t}function Ft(e,t,n,r,i){var o=n===(r?"border":"content")?4:"width"===t?1:0,s=0;for(;4>o;o+=2)"margin"===n&&(s+=x.css(e,n+jt[o],!0,i)),r?("content"===n&&(s-=x.css(e,"padding"+jt[o],!0,i)),"margin"!==n&&(s-=x.css(e,"border"+jt[o]+"Width",!0,i))):(s+=x.css(e,"padding"+jt[o],!0,i),"padding"!==n&&(s+=x.css(e,"border"+jt[o]+"Width",!0,i)));return s}function Pt(e,t,n){var r=!0,i="width"===t?e.offsetWidth:e.offsetHeight,o=qt(e),s=x.support.boxSizing&&"border-box"===x.css(e,"boxSizing",!1,o);if(0>=i||null==i){if(i=vt(e,t,o),(0>i||null==i)&&(i=e.style[t]),Ct.test(i))return i;r=s&&(x.support.boxSizingReliable||i===e.style[t]),i=parseFloat(i)||0}return i+Ft(e,t,n||(s?"border":"content"),r,o)+"px"}function Rt(e){var t=o,n=Nt[e];return n||(n=Mt(e,t),"none"!==n&&n||(xt=(xt||x("<iframe frameborder='0' width='0' height='0'/>").css("cssText","display:block !important")).appendTo(t.documentElement),t=(xt[0].contentWindow||xt[0].contentDocument).document,t.write("<!doctype html><html><body>"),t.close(),n=Mt(e,t),xt.detach()),Nt[e]=n),n}function Mt(e,t){var n=x(t.createElement(e)).appendTo(t.body),r=x.css(n[0],"display");return n.remove(),r}x.each(["height","width"],function(e,t){x.cssHooks[t]={get:function(e,n,r){return n?0===e.offsetWidth&&bt.test(x.css(e,"display"))?x.swap(e,Et,function(){return Pt(e,t,r)}):Pt(e,t,r):undefined},set:function(e,n,r){var i=r&&qt(e);return Ot(e,n,r?Ft(e,t,r,x.support.boxSizing&&"border-box"===x.css(e,"boxSizing",!1,i),i):0)}}}),x(function(){x.support.reliableMarginRight||(x.cssHooks.marginRight={get:function(e,t){return t?x.swap(e,{display:"inline-block"},vt,[e,"marginRight"]):undefined}}),!x.support.pixelPosition&&x.fn.position&&x.each(["top","left"],function(e,t){x.cssHooks[t]={get:function(e,n){return n?(n=vt(e,t),Ct.test(n)?x(e).position()[t]+"px":n):undefined}}})}),x.expr&&x.expr.filters&&(x.expr.filters.hidden=function(e){return 0>=e.offsetWidth&&0>=e.offsetHeight},x.expr.filters.visible=function(e){return!x.expr.filters.hidden(e)}),x.each({margin:"",padding:"",border:"Width"},function(e,t){x.cssHooks[e+t]={expand:function(n){var r=0,i={},o="string"==typeof n?n.split(" "):[n];for(;4>r;r++)i[e+jt[r]+t]=o[r]||o[r-2]||o[0];return i}},wt.test(e)||(x.cssHooks[e+t].set=Ot)});var Wt=/%20/g,$t=/\[\]$/,Bt=/\r?\n/g,It=/^(?:submit|button|image|reset|file)$/i,zt=/^(?:input|select|textarea|keygen)/i;x.fn.extend({serialize:function(){return x.param(this.serializeArray())},serializeArray:function(){return this.map(function(){var e=x.prop(this,"elements");return e?x.makeArray(e):this}).filter(function(){var e=this.type;return this.name&&!x(this).is(":disabled")&&zt.test(this.nodeName)&&!It.test(e)&&(this.checked||!ot.test(e))}).map(function(e,t){var n=x(this).val();return null==n?null:x.isArray(n)?x.map(n,function(e){return{name:t.name,value:e.replace(Bt,"\r\n")}}):{name:t.name,value:n.replace(Bt,"\r\n")}}).get()}}),x.param=function(e,t){var n,r=[],i=function(e,t){t=x.isFunction(t)?t():null==t?"":t,r[r.length]=encodeURIComponent(e)+"="+encodeURIComponent(t)};if(t===undefined&&(t=x.ajaxSettings&&x.ajaxSettings.traditional),x.isArray(e)||e.jquery&&!x.isPlainObject(e))x.each(e,function(){i(this.name,this.value)});else for(n in e)_t(n,e[n],t,i);return r.join("&").replace(Wt,"+")};function _t(e,t,n,r){var i;if(x.isArray(t))x.each(t,function(t,i){n||$t.test(e)?r(e,i):_t(e+"["+("object"==typeof i?t:"")+"]",i,n,r)});else if(n||"object"!==x.type(t))r(e,t);else for(i in t)_t(e+"["+i+"]",t[i],n,r)}x.each("blur focus focusin focusout load resize scroll unload click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup error contextmenu".split(" "),function(e,t){x.fn[t]=function(e,n){return arguments.length>0?this.on(t,null,e,n):this.trigger(t)}}),x.fn.extend({hover:function(e,t){return this.mouseenter(e).mouseleave(t||e)},bind:function(e,t,n){return this.on(e,null,t,n)},unbind:function(e,t){return this.off(e,null,t)
+},delegate:function(e,t,n,r){return this.on(t,e,n,r)},undelegate:function(e,t,n){return 1===arguments.length?this.off(e,"**"):this.off(t,e||"**",n)}});var Xt,Ut,Yt=x.now(),Vt=/\?/,Gt=/#.*$/,Jt=/([?&])_=[^&]*/,Qt=/^(.*?):[ \t]*([^\r\n]*)$/gm,Kt=/^(?:about|app|app-storage|.+-extension|file|res|widget):$/,Zt=/^(?:GET|HEAD)$/,en=/^\/\//,tn=/^([\w.+-]+:)(?:\/\/([^\/?#:]*)(?::(\d+)|)|)/,nn=x.fn.load,rn={},on={},sn="*/".concat("*");try{Ut=i.href}catch(an){Ut=o.createElement("a"),Ut.href="",Ut=Ut.href}Xt=tn.exec(Ut.toLowerCase())||[];function un(e){return function(t,n){"string"!=typeof t&&(n=t,t="*");var r,i=0,o=t.toLowerCase().match(w)||[];if(x.isFunction(n))while(r=o[i++])"+"===r[0]?(r=r.slice(1)||"*",(e[r]=e[r]||[]).unshift(n)):(e[r]=e[r]||[]).push(n)}}function ln(e,t,n,r){var i={},o=e===on;function s(a){var u;return i[a]=!0,x.each(e[a]||[],function(e,a){var l=a(t,n,r);return"string"!=typeof l||o||i[l]?o?!(u=l):undefined:(t.dataTypes.unshift(l),s(l),!1)}),u}return s(t.dataTypes[0])||!i["*"]&&s("*")}function cn(e,t){var n,r,i=x.ajaxSettings.flatOptions||{};for(n in t)t[n]!==undefined&&((i[n]?e:r||(r={}))[n]=t[n]);return r&&x.extend(!0,e,r),e}x.fn.load=function(e,t,n){if("string"!=typeof e&&nn)return nn.apply(this,arguments);var r,i,o,s=this,a=e.indexOf(" ");return a>=0&&(r=e.slice(a),e=e.slice(0,a)),x.isFunction(t)?(n=t,t=undefined):t&&"object"==typeof t&&(i="POST"),s.length>0&&x.ajax({url:e,type:i,dataType:"html",data:t}).done(function(e){o=arguments,s.html(r?x("<div>").append(x.parseHTML(e)).find(r):e)}).complete(n&&function(e,t){s.each(n,o||[e.responseText,t,e])}),this},x.each(["ajaxStart","ajaxStop","ajaxComplete","ajaxError","ajaxSuccess","ajaxSend"],function(e,t){x.fn[t]=function(e){return this.on(t,e)}}),x.extend({active:0,lastModified:{},etag:{},ajaxSettings:{url:Ut,type:"GET",isLocal:Kt.test(Xt[1]),global:!0,processData:!0,async:!0,contentType:"application/x-www-form-urlencoded; charset=UTF-8",accepts:{"*":sn,text:"text/plain",html:"text/html",xml:"application/xml, text/xml",json:"application/json, text/javascript"},contents:{xml:/xml/,html:/html/,json:/json/},responseFields:{xml:"responseXML",text:"responseText",json:"responseJSON"},converters:{"* text":String,"text html":!0,"text json":x.parseJSON,"text xml":x.parseXML},flatOptions:{url:!0,context:!0}},ajaxSetup:function(e,t){return t?cn(cn(e,x.ajaxSettings),t):cn(x.ajaxSettings,e)},ajaxPrefilter:un(rn),ajaxTransport:un(on),ajax:function(e,t){"object"==typeof e&&(t=e,e=undefined),t=t||{};var n,r,i,o,s,a,u,l,c=x.ajaxSetup({},t),p=c.context||c,f=c.context&&(p.nodeType||p.jquery)?x(p):x.event,h=x.Deferred(),d=x.Callbacks("once memory"),g=c.statusCode||{},m={},y={},v=0,b="canceled",T={readyState:0,getResponseHeader:function(e){var t;if(2===v){if(!o){o={};while(t=Qt.exec(i))o[t[1].toLowerCase()]=t[2]}t=o[e.toLowerCase()]}return null==t?null:t},getAllResponseHeaders:function(){return 2===v?i:null},setRequestHeader:function(e,t){var n=e.toLowerCase();return v||(e=y[n]=y[n]||e,m[e]=t),this},overrideMimeType:function(e){return v||(c.mimeType=e),this},statusCode:function(e){var t;if(e)if(2>v)for(t in e)g[t]=[g[t],e[t]];else T.always(e[T.status]);return this},abort:function(e){var t=e||b;return n&&n.abort(t),k(0,t),this}};if(h.promise(T).complete=d.add,T.success=T.done,T.error=T.fail,c.url=((e||c.url||Ut)+"").replace(Gt,"").replace(en,Xt[1]+"//"),c.type=t.method||t.type||c.method||c.type,c.dataTypes=x.trim(c.dataType||"*").toLowerCase().match(w)||[""],null==c.crossDomain&&(a=tn.exec(c.url.toLowerCase()),c.crossDomain=!(!a||a[1]===Xt[1]&&a[2]===Xt[2]&&(a[3]||("http:"===a[1]?"80":"443"))===(Xt[3]||("http:"===Xt[1]?"80":"443")))),c.data&&c.processData&&"string"!=typeof c.data&&(c.data=x.param(c.data,c.traditional)),ln(rn,c,t,T),2===v)return T;u=c.global,u&&0===x.active++&&x.event.trigger("ajaxStart"),c.type=c.type.toUpperCase(),c.hasContent=!Zt.test(c.type),r=c.url,c.hasContent||(c.data&&(r=c.url+=(Vt.test(r)?"&":"?")+c.data,delete c.data),c.cache===!1&&(c.url=Jt.test(r)?r.replace(Jt,"$1_="+Yt++):r+(Vt.test(r)?"&":"?")+"_="+Yt++)),c.ifModified&&(x.lastModified[r]&&T.setRequestHeader("If-Modified-Since",x.lastModified[r]),x.etag[r]&&T.setRequestHeader("If-None-Match",x.etag[r])),(c.data&&c.hasContent&&c.contentType!==!1||t.contentType)&&T.setRequestHeader("Content-Type",c.contentType),T.setRequestHeader("Accept",c.dataTypes[0]&&c.accepts[c.dataTypes[0]]?c.accepts[c.dataTypes[0]]+("*"!==c.dataTypes[0]?", "+sn+"; q=0.01":""):c.accepts["*"]);for(l in c.headers)T.setRequestHeader(l,c.headers[l]);if(c.beforeSend&&(c.beforeSend.call(p,T,c)===!1||2===v))return T.abort();b="abort";for(l in{success:1,error:1,complete:1})T[l](c[l]);if(n=ln(on,c,t,T)){T.readyState=1,u&&f.trigger("ajaxSend",[T,c]),c.async&&c.timeout>0&&(s=setTimeout(function(){T.abort("timeout")},c.timeout));try{v=1,n.send(m,k)}catch(C){if(!(2>v))throw C;k(-1,C)}}else k(-1,"No Transport");function k(e,t,o,a){var l,m,y,b,w,C=t;2!==v&&(v=2,s&&clearTimeout(s),n=undefined,i=a||"",T.readyState=e>0?4:0,l=e>=200&&300>e||304===e,o&&(b=pn(c,T,o)),b=fn(c,b,T,l),l?(c.ifModified&&(w=T.getResponseHeader("Last-Modified"),w&&(x.lastModified[r]=w),w=T.getResponseHeader("etag"),w&&(x.etag[r]=w)),204===e||"HEAD"===c.type?C="nocontent":304===e?C="notmodified":(C=b.state,m=b.data,y=b.error,l=!y)):(y=C,(e||!C)&&(C="error",0>e&&(e=0))),T.status=e,T.statusText=(t||C)+"",l?h.resolveWith(p,[m,C,T]):h.rejectWith(p,[T,C,y]),T.statusCode(g),g=undefined,u&&f.trigger(l?"ajaxSuccess":"ajaxError",[T,c,l?m:y]),d.fireWith(p,[T,C]),u&&(f.trigger("ajaxComplete",[T,c]),--x.active||x.event.trigger("ajaxStop")))}return T},getJSON:function(e,t,n){return x.get(e,t,n,"json")},getScript:function(e,t){return x.get(e,undefined,t,"script")}}),x.each(["get","post"],function(e,t){x[t]=function(e,n,r,i){return x.isFunction(n)&&(i=i||r,r=n,n=undefined),x.ajax({url:e,type:t,dataType:i,data:n,success:r})}});function pn(e,t,n){var r,i,o,s,a=e.contents,u=e.dataTypes;while("*"===u[0])u.shift(),r===undefined&&(r=e.mimeType||t.getResponseHeader("Content-Type"));if(r)for(i in a)if(a[i]&&a[i].test(r)){u.unshift(i);break}if(u[0]in n)o=u[0];else{for(i in n){if(!u[0]||e.converters[i+" "+u[0]]){o=i;break}s||(s=i)}o=o||s}return o?(o!==u[0]&&u.unshift(o),n[o]):undefined}function fn(e,t,n,r){var i,o,s,a,u,l={},c=e.dataTypes.slice();if(c[1])for(s in e.converters)l[s.toLowerCase()]=e.converters[s];o=c.shift();while(o)if(e.responseFields[o]&&(n[e.responseFields[o]]=t),!u&&r&&e.dataFilter&&(t=e.dataFilter(t,e.dataType)),u=o,o=c.shift())if("*"===o)o=u;else if("*"!==u&&u!==o){if(s=l[u+" "+o]||l["* "+o],!s)for(i in l)if(a=i.split(" "),a[1]===o&&(s=l[u+" "+a[0]]||l["* "+a[0]])){s===!0?s=l[i]:l[i]!==!0&&(o=a[0],c.unshift(a[1]));break}if(s!==!0)if(s&&e["throws"])t=s(t);else try{t=s(t)}catch(p){return{state:"parsererror",error:s?p:"No conversion from "+u+" to "+o}}}return{state:"success",data:t}}x.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/(?:java|ecma)script/},converters:{"text script":function(e){return x.globalEval(e),e}}}),x.ajaxPrefilter("script",function(e){e.cache===undefined&&(e.cache=!1),e.crossDomain&&(e.type="GET")}),x.ajaxTransport("script",function(e){if(e.crossDomain){var t,n;return{send:function(r,i){t=x("<script>").prop({async:!0,charset:e.scriptCharset,src:e.url}).on("load error",n=function(e){t.remove(),n=null,e&&i("error"===e.type?404:200,e.type)}),o.head.appendChild(t[0])},abort:function(){n&&n()}}}});var hn=[],dn=/(=)\?(?=&|$)|\?\?/;x.ajaxSetup({jsonp:"callback",jsonpCallback:function(){var e=hn.pop()||x.expando+"_"+Yt++;return this[e]=!0,e}}),x.ajaxPrefilter("json jsonp",function(t,n,r){var i,o,s,a=t.jsonp!==!1&&(dn.test(t.url)?"url":"string"==typeof t.data&&!(t.contentType||"").indexOf("application/x-www-form-urlencoded")&&dn.test(t.data)&&"data");return a||"jsonp"===t.dataTypes[0]?(i=t.jsonpCallback=x.isFunction(t.jsonpCallback)?t.jsonpCallback():t.jsonpCallback,a?t[a]=t[a].replace(dn,"$1"+i):t.jsonp!==!1&&(t.url+=(Vt.test(t.url)?"&":"?")+t.jsonp+"="+i),t.converters["script json"]=function(){return s||x.error(i+" was not called"),s[0]},t.dataTypes[0]="json",o=e[i],e[i]=function(){s=arguments},r.always(function(){e[i]=o,t[i]&&(t.jsonpCallback=n.jsonpCallback,hn.push(i)),s&&x.isFunction(o)&&o(s[0]),s=o=undefined}),"script"):undefined}),x.ajaxSettings.xhr=function(){try{return new XMLHttpRequest}catch(e){}};var gn=x.ajaxSettings.xhr(),mn={0:200,1223:204},yn=0,vn={};e.ActiveXObject&&x(e).on("unload",function(){for(var e in vn)vn[e]();vn=undefined}),x.support.cors=!!gn&&"withCredentials"in gn,x.support.ajax=gn=!!gn,x.ajaxTransport(function(e){var t;return x.support.cors||gn&&!e.crossDomain?{send:function(n,r){var i,o,s=e.xhr();if(s.open(e.type,e.url,e.async,e.username,e.password),e.xhrFields)for(i in e.xhrFields)s[i]=e.xhrFields[i];e.mimeType&&s.overrideMimeType&&s.overrideMimeType(e.mimeType),e.crossDomain||n["X-Requested-With"]||(n["X-Requested-With"]="XMLHttpRequest");for(i in n)s.setRequestHeader(i,n[i]);t=function(e){return function(){t&&(delete vn[o],t=s.onload=s.onerror=null,"abort"===e?s.abort():"error"===e?r(s.status||404,s.statusText):r(mn[s.status]||s.status,s.statusText,"string"==typeof s.responseText?{text:s.responseText}:undefined,s.getAllResponseHeaders()))}},s.onload=t(),s.onerror=t("error"),t=vn[o=yn++]=t("abort"),s.send(e.hasContent&&e.data||null)},abort:function(){t&&t()}}:undefined});var xn,bn,wn=/^(?:toggle|show|hide)$/,Tn=RegExp("^(?:([+-])=|)("+b+")([a-z%]*)$","i"),Cn=/queueHooks$/,kn=[An],Nn={"*":[function(e,t){var n=this.createTween(e,t),r=n.cur(),i=Tn.exec(t),o=i&&i[3]||(x.cssNumber[e]?"":"px"),s=(x.cssNumber[e]||"px"!==o&&+r)&&Tn.exec(x.css(n.elem,e)),a=1,u=20;if(s&&s[3]!==o){o=o||s[3],i=i||[],s=+r||1;do a=a||".5",s/=a,x.style(n.elem,e,s+o);while(a!==(a=n.cur()/r)&&1!==a&&--u)}return i&&(s=n.start=+s||+r||0,n.unit=o,n.end=i[1]?s+(i[1]+1)*i[2]:+i[2]),n}]};function En(){return setTimeout(function(){xn=undefined}),xn=x.now()}function Sn(e,t,n){var r,i=(Nn[t]||[]).concat(Nn["*"]),o=0,s=i.length;for(;s>o;o++)if(r=i[o].call(n,t,e))return r}function jn(e,t,n){var r,i,o=0,s=kn.length,a=x.Deferred().always(function(){delete u.elem}),u=function(){if(i)return!1;var t=xn||En(),n=Math.max(0,l.startTime+l.duration-t),r=n/l.duration||0,o=1-r,s=0,u=l.tweens.length;for(;u>s;s++)l.tweens[s].run(o);return a.notifyWith(e,[l,o,n]),1>o&&u?n:(a.resolveWith(e,[l]),!1)},l=a.promise({elem:e,props:x.extend({},t),opts:x.extend(!0,{specialEasing:{}},n),originalProperties:t,originalOptions:n,startTime:xn||En(),duration:n.duration,tweens:[],createTween:function(t,n){var r=x.Tween(e,l.opts,t,n,l.opts.specialEasing[t]||l.opts.easing);return l.tweens.push(r),r},stop:function(t){var n=0,r=t?l.tweens.length:0;if(i)return this;for(i=!0;r>n;n++)l.tweens[n].run(1);return t?a.resolveWith(e,[l,t]):a.rejectWith(e,[l,t]),this}}),c=l.props;for(Dn(c,l.opts.specialEasing);s>o;o++)if(r=kn[o].call(l,e,c,l.opts))return r;return x.map(c,Sn,l),x.isFunction(l.opts.start)&&l.opts.start.call(e,l),x.fx.timer(x.extend(u,{elem:e,anim:l,queue:l.opts.queue})),l.progress(l.opts.progress).done(l.opts.done,l.opts.complete).fail(l.opts.fail).always(l.opts.always)}function Dn(e,t){var n,r,i,o,s;for(n in e)if(r=x.camelCase(n),i=t[r],o=e[n],x.isArray(o)&&(i=o[1],o=e[n]=o[0]),n!==r&&(e[r]=o,delete e[n]),s=x.cssHooks[r],s&&"expand"in s){o=s.expand(o),delete e[r];for(n in o)n in e||(e[n]=o[n],t[n]=i)}else t[r]=i}x.Animation=x.extend(jn,{tweener:function(e,t){x.isFunction(e)?(t=e,e=["*"]):e=e.split(" ");var n,r=0,i=e.length;for(;i>r;r++)n=e[r],Nn[n]=Nn[n]||[],Nn[n].unshift(t)},prefilter:function(e,t){t?kn.unshift(e):kn.push(e)}});function An(e,t,n){var r,i,o,s,a,u,l=this,c={},p=e.style,f=e.nodeType&&Lt(e),h=q.get(e,"fxshow");n.queue||(a=x._queueHooks(e,"fx"),null==a.unqueued&&(a.unqueued=0,u=a.empty.fire,a.empty.fire=function(){a.unqueued||u()}),a.unqueued++,l.always(function(){l.always(function(){a.unqueued--,x.queue(e,"fx").length||a.empty.fire()})})),1===e.nodeType&&("height"in t||"width"in t)&&(n.overflow=[p.overflow,p.overflowX,p.overflowY],"inline"===x.css(e,"display")&&"none"===x.css(e,"float")&&(p.display="inline-block")),n.overflow&&(p.overflow="hidden",l.always(function(){p.overflow=n.overflow[0],p.overflowX=n.overflow[1],p.overflowY=n.overflow[2]}));for(r in t)if(i=t[r],wn.exec(i)){if(delete t[r],o=o||"toggle"===i,i===(f?"hide":"show")){if("show"!==i||!h||h[r]===undefined)continue;f=!0}c[r]=h&&h[r]||x.style(e,r)}if(!x.isEmptyObject(c)){h?"hidden"in h&&(f=h.hidden):h=q.access(e,"fxshow",{}),o&&(h.hidden=!f),f?x(e).show():l.done(function(){x(e).hide()}),l.done(function(){var t;q.remove(e,"fxshow");for(t in c)x.style(e,t,c[t])});for(r in c)s=Sn(f?h[r]:0,r,l),r in h||(h[r]=s.start,f&&(s.end=s.start,s.start="width"===r||"height"===r?1:0))}}function Ln(e,t,n,r,i){return new Ln.prototype.init(e,t,n,r,i)}x.Tween=Ln,Ln.prototype={constructor:Ln,init:function(e,t,n,r,i,o){this.elem=e,this.prop=n,this.easing=i||"swing",this.options=t,this.start=this.now=this.cur(),this.end=r,this.unit=o||(x.cssNumber[n]?"":"px")},cur:function(){var e=Ln.propHooks[this.prop];return e&&e.get?e.get(this):Ln.propHooks._default.get(this)},run:function(e){var t,n=Ln.propHooks[this.prop];return this.pos=t=this.options.duration?x.easing[this.easing](e,this.options.duration*e,0,1,this.options.duration):e,this.now=(this.end-this.start)*t+this.start,this.options.step&&this.options.step.call(this.elem,this.now,this),n&&n.set?n.set(this):Ln.propHooks._default.set(this),this}},Ln.prototype.init.prototype=Ln.prototype,Ln.propHooks={_default:{get:function(e){var t;return null==e.elem[e.prop]||e.elem.style&&null!=e.elem.style[e.prop]?(t=x.css(e.elem,e.prop,""),t&&"auto"!==t?t:0):e.elem[e.prop]},set:function(e){x.fx.step[e.prop]?x.fx.step[e.prop](e):e.elem.style&&(null!=e.elem.style[x.cssProps[e.prop]]||x.cssHooks[e.prop])?x.style(e.elem,e.prop,e.now+e.unit):e.elem[e.prop]=e.now}}},Ln.propHooks.scrollTop=Ln.propHooks.scrollLeft={set:function(e){e.elem.nodeType&&e.elem.parentNode&&(e.elem[e.prop]=e.now)}},x.each(["toggle","show","hide"],function(e,t){var n=x.fn[t];x.fn[t]=function(e,r,i){return null==e||"boolean"==typeof e?n.apply(this,arguments):this.animate(qn(t,!0),e,r,i)}}),x.fn.extend({fadeTo:function(e,t,n,r){return this.filter(Lt).css("opacity",0).show().end().animate({opacity:t},e,n,r)},animate:function(e,t,n,r){var i=x.isEmptyObject(e),o=x.speed(t,n,r),s=function(){var t=jn(this,x.extend({},e),o);(i||q.get(this,"finish"))&&t.stop(!0)};return s.finish=s,i||o.queue===!1?this.each(s):this.queue(o.queue,s)},stop:function(e,t,n){var r=function(e){var t=e.stop;delete e.stop,t(n)};return"string"!=typeof e&&(n=t,t=e,e=undefined),t&&e!==!1&&this.queue(e||"fx",[]),this.each(function(){var t=!0,i=null!=e&&e+"queueHooks",o=x.timers,s=q.get(this);if(i)s[i]&&s[i].stop&&r(s[i]);else for(i in s)s[i]&&s[i].stop&&Cn.test(i)&&r(s[i]);for(i=o.length;i--;)o[i].elem!==this||null!=e&&o[i].queue!==e||(o[i].anim.stop(n),t=!1,o.splice(i,1));(t||!n)&&x.dequeue(this,e)})},finish:function(e){return e!==!1&&(e=e||"fx"),this.each(function(){var t,n=q.get(this),r=n[e+"queue"],i=n[e+"queueHooks"],o=x.timers,s=r?r.length:0;for(n.finish=!0,x.queue(this,e,[]),i&&i.stop&&i.stop.call(this,!0),t=o.length;t--;)o[t].elem===this&&o[t].queue===e&&(o[t].anim.stop(!0),o.splice(t,1));for(t=0;s>t;t++)r[t]&&r[t].finish&&r[t].finish.call(this);delete n.finish})}});function qn(e,t){var n,r={height:e},i=0;for(t=t?1:0;4>i;i+=2-t)n=jt[i],r["margin"+n]=r["padding"+n]=e;return t&&(r.opacity=r.width=e),r}x.each({slideDown:qn("show"),slideUp:qn("hide"),slideToggle:qn("toggle"),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"},fadeToggle:{opacity:"toggle"}},function(e,t){x.fn[e]=function(e,n,r){return this.animate(t,e,n,r)}}),x.speed=function(e,t,n){var r=e&&"object"==typeof e?x.extend({},e):{complete:n||!n&&t||x.isFunction(e)&&e,duration:e,easing:n&&t||t&&!x.isFunction(t)&&t};return r.duration=x.fx.off?0:"number"==typeof r.duration?r.duration:r.duration in x.fx.speeds?x.fx.speeds[r.duration]:x.fx.speeds._default,(null==r.queue||r.queue===!0)&&(r.queue="fx"),r.old=r.complete,r.complete=function(){x.isFunction(r.old)&&r.old.call(this),r.queue&&x.dequeue(this,r.queue)},r},x.easing={linear:function(e){return e},swing:function(e){return.5-Math.cos(e*Math.PI)/2}},x.timers=[],x.fx=Ln.prototype.init,x.fx.tick=function(){var e,t=x.timers,n=0;for(xn=x.now();t.length>n;n++)e=t[n],e()||t[n]!==e||t.splice(n--,1);t.length||x.fx.stop(),xn=undefined},x.fx.timer=function(e){e()&&x.timers.push(e)&&x.fx.start()},x.fx.interval=13,x.fx.start=function(){bn||(bn=setInterval(x.fx.tick,x.fx.interval))},x.fx.stop=function(){clearInterval(bn),bn=null},x.fx.speeds={slow:600,fast:200,_default:400},x.fx.step={},x.expr&&x.expr.filters&&(x.expr.filters.animated=function(e){return x.grep(x.timers,function(t){return e===t.elem}).length}),x.fn.offset=function(e){if(arguments.length)return e===undefined?this:this.each(function(t){x.offset.setOffset(this,e,t)});var t,n,i=this[0],o={top:0,left:0},s=i&&i.ownerDocument;if(s)return t=s.documentElement,x.contains(t,i)?(typeof i.getBoundingClientRect!==r&&(o=i.getBoundingClientRect()),n=Hn(s),{top:o.top+n.pageYOffset-t.clientTop,left:o.left+n.pageXOffset-t.clientLeft}):o},x.offset={setOffset:function(e,t,n){var r,i,o,s,a,u,l,c=x.css(e,"position"),p=x(e),f={};"static"===c&&(e.style.position="relative"),a=p.offset(),o=x.css(e,"top"),u=x.css(e,"left"),l=("absolute"===c||"fixed"===c)&&(o+u).indexOf("auto")>-1,l?(r=p.position(),s=r.top,i=r.left):(s=parseFloat(o)||0,i=parseFloat(u)||0),x.isFunction(t)&&(t=t.call(e,n,a)),null!=t.top&&(f.top=t.top-a.top+s),null!=t.left&&(f.left=t.left-a.left+i),"using"in t?t.using.call(e,f):p.css(f)}},x.fn.extend({position:function(){if(this[0]){var e,t,n=this[0],r={top:0,left:0};return"fixed"===x.css(n,"position")?t=n.getBoundingClientRect():(e=this.offsetParent(),t=this.offset(),x.nodeName(e[0],"html")||(r=e.offset()),r.top+=x.css(e[0],"borderTopWidth",!0),r.left+=x.css(e[0],"borderLeftWidth",!0)),{top:t.top-r.top-x.css(n,"marginTop",!0),left:t.left-r.left-x.css(n,"marginLeft",!0)}}},offsetParent:function(){return this.map(function(){var e=this.offsetParent||s;while(e&&!x.nodeName(e,"html")&&"static"===x.css(e,"position"))e=e.offsetParent;return e||s})}}),x.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(t,n){var r="pageYOffset"===n;x.fn[t]=function(i){return x.access(this,function(t,i,o){var s=Hn(t);return o===undefined?s?s[n]:t[i]:(s?s.scrollTo(r?e.pageXOffset:o,r?o:e.pageYOffset):t[i]=o,undefined)},t,i,arguments.length,null)}});function Hn(e){return x.isWindow(e)?e:9===e.nodeType&&e.defaultView}x.each({Height:"height",Width:"width"},function(e,t){x.each({padding:"inner"+e,content:t,"":"outer"+e},function(n,r){x.fn[r]=function(r,i){var o=arguments.length&&(n||"boolean"!=typeof r),s=n||(r===!0||i===!0?"margin":"border");return x.access(this,function(t,n,r){var i;return x.isWindow(t)?t.document.documentElement["client"+e]:9===t.nodeType?(i=t.documentElement,Math.max(t.body["scroll"+e],i["scroll"+e],t.body["offset"+e],i["offset"+e],i["client"+e])):r===undefined?x.css(t,n,s):x.style(t,n,r,s)},t,o?r:undefined,o,null)}})}),x.fn.size=function(){return this.length},x.fn.andSelf=x.fn.addBack,"object"==typeof module&&module&&"object"==typeof module.exports?module.exports=x:"function"==typeof define&&define.amd&&define("jquery",[],function(){return x}),"object"==typeof e&&"object"==typeof e.document&&(e.jQuery=e.$=x)})(window);
diff -Nru acl2-6.2/books/xdoc/fancy/lib/jquery.base64.js acl2-6.3/books/xdoc/fancy/lib/jquery.base64.js
--- acl2-6.2/books/xdoc/fancy/lib/jquery.base64.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/jquery.base64.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,122 @@
+/*!
+ * jquery.base64.js 0.1 - https://github.com/yckart/jquery.base64.js
+ * Makes Base64 en & -decoding simpler as it is.
+ *
+ * Based upon: https://gist.github.com/Yaffle/1284012
+ *
+ * Copyright (c) 2012 Yannick Albert (http://yckart.com)
+ * Licensed under the MIT license (http://www.opensource.org/licenses/mit-license.php).
+ * 2013/02/10
+ **/
+;(function($) {
+
+    var b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
+        a256 = '',
+        r64 = [256],
+        r256 = [256],
+        i = 0;
+
+    var UTF8 = {
+
+        /**
+         * Encode multi-byte Unicode string into utf-8 multiple single-byte characters
+         * (BMP / basic multilingual plane only)
+         *
+         * Chars in range U+0080 - U+07FF are encoded in 2 chars, U+0800 - U+FFFF in 3 chars
+         *
+         * @param {String} strUni Unicode string to be encoded as UTF-8
+         * @returns {String} encoded string
+         */
+        encode: function(strUni) {
+            // use regular expressions & String.replace callback function for better efficiency
+            // than procedural approaches
+            var strUtf = strUni.replace(/[\u0080-\u07ff]/g, // U+0080 - U+07FF => 2 bytes 110yyyyy, 10zzzzzz
+            function(c) {
+                var cc = c.charCodeAt(0);
+                return String.fromCharCode(0xc0 | cc >> 6, 0x80 | cc & 0x3f);
+            })
+            .replace(/[\u0800-\uffff]/g, // U+0800 - U+FFFF => 3 bytes 1110xxxx, 10yyyyyy, 10zzzzzz
+            function(c) {
+                var cc = c.charCodeAt(0);
+                return String.fromCharCode(0xe0 | cc >> 12, 0x80 | cc >> 6 & 0x3F, 0x80 | cc & 0x3f);
+            });
+            return strUtf;
+        },
+
+        /**
+         * Decode utf-8 encoded string back into multi-byte Unicode characters
+         *
+         * @param {String} strUtf UTF-8 string to be decoded back to Unicode
+         * @returns {String} decoded string
+         */
+        decode: function(strUtf) {
+            // note: decode 3-byte chars first as decoded 2-byte strings could appear to be 3-byte char!
+            var strUni = strUtf.replace(/[\u00e0-\u00ef][\u0080-\u00bf][\u0080-\u00bf]/g, // 3-byte chars
+            function(c) { // (note parentheses for precence)
+                var cc = ((c.charCodeAt(0) & 0x0f) << 12) | ((c.charCodeAt(1) & 0x3f) << 6) | (c.charCodeAt(2) & 0x3f);
+                return String.fromCharCode(cc);
+            })
+            .replace(/[\u00c0-\u00df][\u0080-\u00bf]/g, // 2-byte chars
+            function(c) { // (note parentheses for precence)
+                var cc = (c.charCodeAt(0) & 0x1f) << 6 | c.charCodeAt(1) & 0x3f;
+                return String.fromCharCode(cc);
+            });
+            return strUni;
+        }
+    };
+
+    while(i < 256) {
+        var c = String.fromCharCode(i);
+        a256 += c;
+        r256[i] = i;
+        r64[i] = b64.indexOf(c);
+        ++i;
+    }
+
+    function code(s, discard, alpha, beta, w1, w2) {
+        s = String(s);
+        var buffer = 0,
+            i = 0,
+            length = s.length,
+            result = '',
+            bitsInBuffer = 0;
+
+        while(i < length) {
+            var c = s.charCodeAt(i);
+            c = c < 256 ? alpha[c] : -1;
+
+            buffer = (buffer << w1) + c;
+            bitsInBuffer += w1;
+
+            while(bitsInBuffer >= w2) {
+                bitsInBuffer -= w2;
+                var tmp = buffer >> bitsInBuffer;
+                result += beta.charAt(tmp);
+                buffer ^= tmp << bitsInBuffer;
+            }
+            ++i;
+        }
+        if(!discard && bitsInBuffer > 0) result += beta.charAt(buffer << (w2 - bitsInBuffer));
+        return result;
+    }
+
+    var Plugin = $.base64 = function(dir, input, encode) {
+            return input ? Plugin[dir](input, encode) : dir ? null : this;
+        };
+
+    Plugin.btoa = Plugin.encode = function(plain, utf8encode) {
+        plain = Plugin.raw === false || Plugin.utf8encode || utf8encode ? UTF8.encode(plain) : plain;
+        plain = code(plain, false, r256, b64, 8, 6);
+        return plain + '===='.slice((plain.length % 4) || 4);
+    };
+
+    Plugin.atob = Plugin.decode = function(coded, utf8decode) {
+        coded = String(coded).split('=');
+        var i = coded.length;
+        do {--i;
+            coded[i] = code(coded[i], true, r64, a256, 6, 8);
+        } while (i > 0);
+        coded = coded.join('');
+        return Plugin.raw === false || Plugin.utf8decode || utf8decode ? UTF8.decode(coded) : coded;
+    };
+}(jQuery));
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc/fancy/lib/jquery.powertip.css acl2-6.3/books/xdoc/fancy/lib/jquery.powertip.css
--- acl2-6.2/books/xdoc/fancy/lib/jquery.powertip.css	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/jquery.powertip.css	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,93 @@
+/* PowerTip Plugin */
+#powerTip {
+	cursor: default;
+	background-color: #333;
+	background-color: rgba(0, 0, 0, 0.8);
+	border-radius: 6px;
+	color: #fff;
+	display: none;
+	padding: 10px;
+	position: absolute;
+	z-index: 2147483647;
+	width: 400px;
+}
+#powerTip:before {
+	content: "";
+	position: absolute;
+}
+#powerTip.n:before, #powerTip.s:before {
+	border-right: 5px solid transparent;
+	border-left: 5px solid transparent;
+	left: 50%;
+	margin-left: -5px;
+}
+#powerTip.e:before, #powerTip.w:before {
+	border-bottom: 5px solid transparent;
+	border-top: 5px solid transparent;
+	margin-top: -5px;
+	top: 50%;
+}
+#powerTip.n:before {
+	border-top: 10px solid #333;
+	border-top: 10px solid rgba(0, 0, 0, 0.8);
+	bottom: -10px;
+}
+#powerTip.e:before {
+	border-right: 10px solid #333;
+	border-right: 10px solid rgba(0, 0, 0, 0.8);
+	left: -10px;
+}
+#powerTip.s:before {
+	border-bottom: 10px solid #333;
+	border-bottom: 10px solid rgba(0, 0, 0, 0.8);
+	top: -10px;
+}
+#powerTip.w:before {
+	border-left: 10px solid #333;
+	border-left: 10px solid rgba(0, 0, 0, 0.8);
+	right: -10px;
+}
+#powerTip.ne:before, #powerTip.se:before {
+	border-right: 10px solid transparent;
+	border-left: 0;
+	left: 10px;
+}
+#powerTip.nw:before, #powerTip.sw:before {
+	border-left: 10px solid transparent;
+	border-right: 0;
+	right: 10px;
+}
+#powerTip.ne:before, #powerTip.nw:before {
+	border-top: 10px solid #333;
+	border-top: 10px solid rgba(0, 0, 0, 0.8);
+	bottom: -10px;
+}
+#powerTip.se:before, #powerTip.sw:before {
+	border-bottom: 10px solid #333;
+	border-bottom: 10px solid rgba(0, 0, 0, 0.8);
+	top: -10px;
+}
+#powerTip.nw-alt:before, #powerTip.ne-alt:before,
+#powerTip.sw-alt:before, #powerTip.se-alt:before {
+	border-top: 10px solid #333;
+	border-top: 10px solid rgba(0, 0, 0, 0.8);
+	bottom: -10px;
+	border-left: 5px solid transparent;
+	border-right: 5px solid transparent;
+	left: 10px;
+}
+#powerTip.ne-alt:before {
+	left: auto;
+	right: 10px;
+}
+#powerTip.sw-alt:before, #powerTip.se-alt:before {
+	border-top: none;
+	border-bottom: 10px solid #333;
+	border-bottom: 10px solid rgba(0, 0, 0, 0.8);
+	bottom: auto;
+	top: -10px;
+}
+#powerTip.se-alt:before {
+	left: auto;
+	right: 10px;
+}
diff -Nru acl2-6.2/books/xdoc/fancy/lib/jquery.powertip.js acl2-6.3/books/xdoc/fancy/lib/jquery.powertip.js
--- acl2-6.2/books/xdoc/fancy/lib/jquery.powertip.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/jquery.powertip.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,1166 @@
+/*!
+ PowerTip - v1.2.0 - 2013-04-03
+ http://stevenbenner.github.com/jquery-powertip/
+ Copyright (c) 2013 Steven Benner (http://stevenbenner.com/).
+ Released under MIT license.
+ https://raw.github.com/stevenbenner/jquery-powertip/master/LICENSE.txt
+*/
+(function(factory) {
+	if (typeof define === 'function' && define.amd) {
+		// AMD. Register as an anonymous module.
+		define(['jquery'], factory);
+	} else {
+		// Browser globals
+		factory(jQuery);
+	}
+}(function($) {
+
+	// useful private variables
+	var $document = $(document),
+		$window = $(window),
+		$body = $('body');
+
+	// constants
+	var DATA_DISPLAYCONTROLLER = 'displayController',
+		DATA_HASACTIVEHOVER = 'hasActiveHover',
+		DATA_FORCEDOPEN = 'forcedOpen',
+		DATA_HASMOUSEMOVE = 'hasMouseMove',
+		DATA_MOUSEONTOTIP = 'mouseOnToPopup',
+		DATA_ORIGINALTITLE = 'originalTitle',
+		DATA_POWERTIP = 'powertip',
+		DATA_POWERTIPJQ = 'powertipjq',
+		DATA_POWERTIPTARGET = 'powertiptarget',
+		RAD2DEG = 180 / Math.PI;
+
+	/**
+	 * Session data
+	 * Private properties global to all powerTip instances
+	 */
+	var session = {
+		isTipOpen: false,
+		isFixedTipOpen: false,
+		isClosing: false,
+		tipOpenImminent: false,
+		activeHover: null,
+		currentX: 0,
+		currentY: 0,
+		previousX: 0,
+		previousY: 0,
+		desyncTimeout: null,
+		mouseTrackingActive: false,
+		delayInProgress: false,
+		windowWidth: 0,
+		windowHeight: 0,
+		scrollTop: 0,
+		scrollLeft: 0
+	};
+
+	/**
+	 * Collision enumeration
+	 * @enum {number}
+	 */
+	var Collision = {
+		none: 0,
+		top: 1,
+		bottom: 2,
+		left: 4,
+		right: 8
+	};
+
+	/**
+	 * Display hover tooltips on the matched elements.
+	 * @param {(Object|string)} opts The options object to use for the plugin, or
+	 *     the name of a method to invoke on the first matched element.
+	 * @param {*=} [arg] Argument for an invoked method (optional).
+	 * @return {jQuery} jQuery object for the matched selectors.
+	 */
+	$.fn.powerTip = function(opts, arg) {
+		// don't do any work if there were no matched elements
+		if (!this.length) {
+			return this;
+		}
+
+		// handle api method calls on the plugin, e.g. powerTip('hide')
+		if ($.type(opts) === 'string' && $.powerTip[opts]) {
+			return $.powerTip[opts].call(this, this, arg);
+		}
+
+		// extend options and instantiate TooltipController
+		var options = $.extend({}, $.fn.powerTip.defaults, opts),
+			tipController = new TooltipController(options);
+
+		// hook mouse and viewport dimension tracking
+		initTracking();
+
+		// setup the elements
+		this.each(function elementSetup() {
+			var $this = $(this),
+				dataPowertip = $this.data(DATA_POWERTIP),
+				dataElem = $this.data(DATA_POWERTIPJQ),
+				dataTarget = $this.data(DATA_POWERTIPTARGET),
+				title;
+
+			// handle repeated powerTip calls on the same element by destroying the
+			// original instance hooked to it and replacing it with this call
+			if ($this.data(DATA_DISPLAYCONTROLLER)) {
+				$.powerTip.destroy($this);
+			}
+
+			// attempt to use title attribute text if there is no data-powertip,
+			// data-powertipjq or data-powertiptarget. If we do use the title
+			// attribute, delete the attribute so the browser will not show it
+			title = $this.attr('title');
+			if (!dataPowertip && !dataTarget && !dataElem && title) {
+				$this.data(DATA_POWERTIP, title);
+				$this.data(DATA_ORIGINALTITLE, title);
+				$this.removeAttr('title');
+			}
+
+			// create hover controllers for each element
+			$this.data(
+				DATA_DISPLAYCONTROLLER,
+				new DisplayController($this, options, tipController)
+			);
+		});
+
+		// attach events to matched elements if the manual options is not enabled
+		if (!options.manual) {
+			this.on({
+				// mouse events
+				'mouseenter.powertip': function elementMouseEnter(event) {
+					$.powerTip.show(this, event);
+				},
+				'mouseleave.powertip': function elementMouseLeave() {
+					$.powerTip.hide(this);
+				},
+				// keyboard events
+				'focus.powertip': function elementFocus() {
+					$.powerTip.show(this);
+				},
+				'blur.powertip': function elementBlur() {
+					$.powerTip.hide(this, true);
+				},
+				'keydown.powertip': function elementKeyDown(event) {
+					// close tooltip when the escape key is pressed
+					if (event.keyCode === 27) {
+						$.powerTip.hide(this, true);
+					}
+				}
+			});
+		}
+
+		return this;
+	};
+
+	/**
+	 * Default options for the powerTip plugin.
+	 */
+	$.fn.powerTip.defaults = {
+		fadeInTime: 200,
+		fadeOutTime: 100,
+		followMouse: false,
+		popupId: 'powerTip',
+		intentSensitivity: 7,
+		intentPollInterval: 100,
+		closeDelay: 100,
+		placement: 'n',
+		smartPlacement: false,
+		offset: 10,
+		mouseOnToPopup: false,
+		manual: false
+	};
+
+	/**
+	 * Default smart placement priority lists.
+	 * The first item in the array is the highest priority, the last is the lowest.
+	 * The last item is also the default, which will be used if all previous options
+	 * do not fit.
+	 */
+	$.fn.powerTip.smartPlacementLists = {
+		n: ['n', 'ne', 'nw', 's'],
+		e: ['e', 'ne', 'se', 'w', 'nw', 'sw', 'n', 's', 'e'],
+		s: ['s', 'se', 'sw', 'n'],
+		w: ['w', 'nw', 'sw', 'e', 'ne', 'se', 'n', 's', 'w'],
+		nw: ['nw', 'w', 'sw', 'n', 's', 'se', 'nw'],
+		ne: ['ne', 'e', 'se', 'n', 's', 'sw', 'ne'],
+		sw: ['sw', 'w', 'nw', 's', 'n', 'ne', 'sw'],
+		se: ['se', 'e', 'ne', 's', 'n', 'nw', 'se'],
+		'nw-alt': ['nw-alt', 'n', 'ne-alt', 'sw-alt', 's', 'se-alt', 'w', 'e'],
+		'ne-alt': ['ne-alt', 'n', 'nw-alt', 'se-alt', 's', 'sw-alt', 'e', 'w'],
+		'sw-alt': ['sw-alt', 's', 'se-alt', 'nw-alt', 'n', 'ne-alt', 'w', 'e'],
+		'se-alt': ['se-alt', 's', 'sw-alt', 'ne-alt', 'n', 'nw-alt', 'e', 'w']
+	};
+
+	/**
+	 * Public API
+	 */
+	$.powerTip = {
+		/**
+		 * Attempts to show the tooltip for the specified element.
+		 * @param {jQuery|Element} element The element to open the tooltip for.
+		 * @param {jQuery.Event=} event jQuery event for hover intent and mouse
+		 *     tracking (optional).
+		 */
+		show: function apiShowTip(element, event) {
+			if (event) {
+				trackMouse(event);
+				session.previousX = event.pageX;
+				session.previousY = event.pageY;
+				$(element).data(DATA_DISPLAYCONTROLLER).show();
+			} else {
+				$(element).first().data(DATA_DISPLAYCONTROLLER).show(true, true);
+			}
+			return element;
+		},
+
+		/**
+		 * Repositions the tooltip on the element.
+		 * @param {jQuery|Element} element The element the tooltip is shown for.
+		 */
+		reposition: function apiResetPosition(element) {
+			$(element).first().data(DATA_DISPLAYCONTROLLER).resetPosition();
+			return element;
+		},
+
+		/**
+		 * Attempts to close any open tooltips.
+		 * @param {(jQuery|Element)=} element The element with the tooltip that
+		 *     should be closed (optional).
+		 * @param {boolean=} immediate Disable close delay (optional).
+		 */
+		hide: function apiCloseTip(element, immediate) {
+			if (element) {
+				$(element).first().data(DATA_DISPLAYCONTROLLER).hide(immediate);
+			} else {
+				if (session.activeHover) {
+					session.activeHover.data(DATA_DISPLAYCONTROLLER).hide(true);
+				}
+			}
+			return element;
+		},
+
+		/**
+		 * Destroy and roll back any powerTip() instance on the specified element.
+		 * @param {jQuery|Element} element The element with the powerTip instance.
+		 */
+		destroy: function apiDestroy(element) {
+			$(element).off('.powertip').each(function destroy() {
+				var $this = $(this),
+					dataAttributes = [
+						DATA_ORIGINALTITLE,
+						DATA_DISPLAYCONTROLLER,
+						DATA_HASACTIVEHOVER,
+						DATA_FORCEDOPEN
+					];
+
+				if ($this.data(DATA_ORIGINALTITLE)) {
+					$this.attr('title', $this.data(DATA_ORIGINALTITLE));
+					dataAttributes.push(DATA_POWERTIP);
+				}
+
+				$this.removeData(dataAttributes);
+			});
+			return element;
+		}
+	};
+
+	// API aliasing
+	$.powerTip.showTip = $.powerTip.show;
+	$.powerTip.closeTip = $.powerTip.hide;
+
+	/**
+	 * Creates a new CSSCoordinates object.
+	 * @private
+	 * @constructor
+	 */
+	function CSSCoordinates() {
+		var me = this;
+
+		// initialize object properties
+		me.top = 'auto';
+		me.left = 'auto';
+		me.right = 'auto';
+		me.bottom = 'auto';
+
+		/**
+		 * Set a property to a value.
+		 * @private
+		 * @param {string} property The name of the property.
+		 * @param {number} value The value of the property.
+		 */
+		me.set = function(property, value) {
+			if ($.isNumeric(value)) {
+				me[property] = Math.round(value);
+			}
+		};
+	}
+
+	/**
+	 * Creates a new tooltip display controller.
+	 * @private
+	 * @constructor
+	 * @param {jQuery} element The element that this controller will handle.
+	 * @param {Object} options Options object containing settings.
+	 * @param {TooltipController} tipController The TooltipController object for
+	 *     this instance.
+	 */
+	function DisplayController(element, options, tipController) {
+		var hoverTimer = null;
+
+		/**
+		 * Begins the process of showing a tooltip.
+		 * @private
+		 * @param {boolean=} immediate Skip intent testing (optional).
+		 * @param {boolean=} forceOpen Ignore cursor position and force tooltip to
+		 *     open (optional).
+		 */
+		function openTooltip(immediate, forceOpen) {
+			cancelTimer();
+			if (!element.data(DATA_HASACTIVEHOVER)) {
+				if (!immediate) {
+					session.tipOpenImminent = true;
+					hoverTimer = setTimeout(
+						function intentDelay() {
+							hoverTimer = null;
+							checkForIntent();
+						},
+						options.intentPollInterval
+					);
+				} else {
+					if (forceOpen) {
+						element.data(DATA_FORCEDOPEN, true);
+					}
+					tipController.showTip(element);
+				}
+			}
+		}
+
+		/**
+		 * Begins the process of closing a tooltip.
+		 * @private
+		 * @param {boolean=} disableDelay Disable close delay (optional).
+		 */
+		function closeTooltip(disableDelay) {
+			cancelTimer();
+			session.tipOpenImminent = false;
+			if (element.data(DATA_HASACTIVEHOVER)) {
+				element.data(DATA_FORCEDOPEN, false);
+				if (!disableDelay) {
+					session.delayInProgress = true;
+					hoverTimer = setTimeout(
+						function closeDelay() {
+							hoverTimer = null;
+							tipController.hideTip(element);
+							session.delayInProgress = false;
+						},
+						options.closeDelay
+					);
+				} else {
+					tipController.hideTip(element);
+				}
+			}
+		}
+
+		/**
+		 * Checks mouse position to make sure that the user intended to hover on the
+		 * specified element before showing the tooltip.
+		 * @private
+		 */
+		function checkForIntent() {
+			// calculate mouse position difference
+			var xDifference = Math.abs(session.previousX - session.currentX),
+				yDifference = Math.abs(session.previousY - session.currentY),
+				totalDifference = xDifference + yDifference;
+
+			// check if difference has passed the sensitivity threshold
+			if (totalDifference < options.intentSensitivity) {
+				tipController.showTip(element);
+			} else {
+				// try again
+				session.previousX = session.currentX;
+				session.previousY = session.currentY;
+				openTooltip();
+			}
+		}
+
+		/**
+		 * Cancels active hover timer.
+		 * @private
+		 */
+		function cancelTimer() {
+			hoverTimer = clearTimeout(hoverTimer);
+			session.delayInProgress = false;
+		}
+
+		/**
+		 * Repositions the tooltip on this element.
+		 * @private
+		 */
+		function repositionTooltip() {
+			tipController.resetPosition(element);
+		}
+
+		// expose the methods
+		this.show = openTooltip;
+		this.hide = closeTooltip;
+		this.cancel = cancelTimer;
+		this.resetPosition = repositionTooltip;
+	}
+
+	/**
+	 * Creates a new Placement Calculator.
+	 * @private
+	 * @constructor
+	 */
+	function PlacementCalculator() {
+		/**
+		 * Compute the CSS position to display a tooltip at the specified placement
+		 * relative to the specified element.
+		 * @private
+		 * @param {jQuery} element The element that the tooltip should target.
+		 * @param {string} placement The placement for the tooltip.
+		 * @param {number} tipWidth Width of the tooltip element in pixels.
+		 * @param {number} tipHeight Height of the tooltip element in pixels.
+		 * @param {number} offset Distance to offset tooltips in pixels.
+		 * @return {CSSCoordinates} A CSSCoordinates object with the position.
+		 */
+		function computePlacementCoords(element, placement, tipWidth, tipHeight, offset) {
+			var placementBase = placement.split('-')[0], // ignore 'alt' for corners
+				coords = new CSSCoordinates(),
+				position;
+
+			if (isSvgElement(element)) {
+				position = getSvgPlacement(element, placementBase);
+			} else {
+				position = getHtmlPlacement(element, placementBase);
+			}
+
+			// calculate the appropriate x and y position in the document
+			switch (placement) {
+			case 'n':
+				coords.set('left', position.left - (tipWidth / 2));
+				coords.set('bottom', session.windowHeight - position.top + offset);
+				break;
+			case 'e':
+				coords.set('left', position.left + offset);
+				coords.set('top', position.top - (tipHeight / 2));
+				break;
+			case 's':
+				coords.set('left', position.left - (tipWidth / 2));
+				coords.set('top', position.top + offset);
+				break;
+			case 'w':
+				coords.set('top', position.top - (tipHeight / 2));
+				coords.set('right', session.windowWidth - position.left + offset);
+				break;
+			case 'nw':
+				coords.set('bottom', session.windowHeight - position.top + offset);
+				coords.set('right', session.windowWidth - position.left - 20);
+				break;
+			case 'nw-alt':
+				coords.set('left', position.left);
+				coords.set('bottom', session.windowHeight - position.top + offset);
+				break;
+			case 'ne':
+				coords.set('left', position.left - 20);
+				coords.set('bottom', session.windowHeight - position.top + offset);
+				break;
+			case 'ne-alt':
+				coords.set('bottom', session.windowHeight - position.top + offset);
+				coords.set('right', session.windowWidth - position.left);
+				break;
+			case 'sw':
+				coords.set('top', position.top + offset);
+				coords.set('right', session.windowWidth - position.left - 20);
+				break;
+			case 'sw-alt':
+				coords.set('left', position.left);
+				coords.set('top', position.top + offset);
+				break;
+			case 'se':
+				coords.set('left', position.left - 20);
+				coords.set('top', position.top + offset);
+				break;
+			case 'se-alt':
+				coords.set('top', position.top + offset);
+				coords.set('right', session.windowWidth - position.left);
+				break;
+			}
+
+			return coords;
+		}
+
+		/**
+		 * Finds the tooltip attachment point in the document for a HTML DOM element
+		 * for the specified placement.
+		 * @private
+		 * @param {jQuery} element The element that the tooltip should target.
+		 * @param {string} placement The placement for the tooltip.
+		 * @return {Object} An object with the top,left position values.
+		 */
+		function getHtmlPlacement(element, placement) {
+			var objectOffset = element.offset(),
+				objectWidth = element.outerWidth(),
+				objectHeight = element.outerHeight(),
+				left,
+				top;
+
+			// calculate the appropriate x and y position in the document
+			switch (placement) {
+			case 'n':
+				left = objectOffset.left + objectWidth / 2;
+				top = objectOffset.top;
+				break;
+			case 'e':
+				left = objectOffset.left + objectWidth;
+				top = objectOffset.top + objectHeight / 2;
+				break;
+			case 's':
+				left = objectOffset.left + objectWidth / 2;
+				top = objectOffset.top + objectHeight;
+				break;
+			case 'w':
+				left = objectOffset.left;
+				top = objectOffset.top + objectHeight / 2;
+				break;
+			case 'nw':
+				left = objectOffset.left;
+				top = objectOffset.top;
+				break;
+			case 'ne':
+				left = objectOffset.left + objectWidth;
+				top = objectOffset.top;
+				break;
+			case 'sw':
+				left = objectOffset.left;
+				top = objectOffset.top + objectHeight;
+				break;
+			case 'se':
+				left = objectOffset.left + objectWidth;
+				top = objectOffset.top + objectHeight;
+				break;
+			}
+
+			return {
+				top: top,
+				left: left
+			};
+		}
+
+		/**
+		 * Finds the tooltip attachment point in the document for a SVG element for
+		 * the specified placement.
+		 * @private
+		 * @param {jQuery} element The element that the tooltip should target.
+		 * @param {string} placement The placement for the tooltip.
+		 * @return {Object} An object with the top,left position values.
+		 */
+		function getSvgPlacement(element, placement) {
+			var svgElement = element.closest('svg')[0],
+				domElement = element[0],
+				point = svgElement.createSVGPoint(),
+				boundingBox = domElement.getBBox(),
+				matrix = domElement.getScreenCTM(),
+				halfWidth = boundingBox.width / 2,
+				halfHeight = boundingBox.height / 2,
+				placements = [],
+				placementKeys = ['nw', 'n', 'ne', 'e', 'se', 's', 'sw', 'w'],
+				coords,
+				rotation,
+				steps,
+				x;
+
+			function pushPlacement() {
+				placements.push(point.matrixTransform(matrix));
+			}
+
+			// get bounding box corners and midpoints
+			point.x = boundingBox.x;
+			point.y = boundingBox.y;
+			pushPlacement();
+			point.x += halfWidth;
+			pushPlacement();
+			point.x += halfWidth;
+			pushPlacement();
+			point.y += halfHeight;
+			pushPlacement();
+			point.y += halfHeight;
+			pushPlacement();
+			point.x -= halfWidth;
+			pushPlacement();
+			point.x -= halfWidth;
+			pushPlacement();
+			point.y -= halfHeight;
+			pushPlacement();
+
+			// determine rotation
+			if (placements[0].y !== placements[1].y || placements[0].x !== placements[7].x) {
+				rotation = Math.atan2(matrix.b, matrix.a) * RAD2DEG;
+				steps = Math.ceil(((rotation % 360) - 22.5) / 45);
+				if (steps < 1) {
+					steps += 8;
+				}
+				while (steps--) {
+					placementKeys.push(placementKeys.shift());
+				}
+			}
+
+			// find placement
+			for (x = 0; x < placements.length; x++) {
+				if (placementKeys[x] === placement) {
+					coords = placements[x];
+					break;
+				}
+			}
+
+			return {
+				top: coords.y + session.scrollTop,
+				left: coords.x + session.scrollLeft
+			};
+		}
+
+		// expose methods
+		this.compute = computePlacementCoords;
+	}
+
+	/**
+	 * Creates a new tooltip controller.
+	 * @private
+	 * @constructor
+	 * @param {Object} options Options object containing settings.
+	 */
+	function TooltipController(options) {
+		var placementCalculator = new PlacementCalculator(),
+			tipElement = $('#' + options.popupId);
+
+		// build and append tooltip div if it does not already exist
+		if (tipElement.length === 0) {
+			tipElement = $('<div/>', { id: options.popupId });
+			// grab body element if it was not populated when the script loaded
+			// note: this hack exists solely for jsfiddle support
+			if ($body.length === 0) {
+				$body = $('body');
+			}
+			$body.append(tipElement);
+		}
+
+		// hook mousemove for cursor follow tooltips
+		if (options.followMouse) {
+			// only one positionTipOnCursor hook per tooltip element, please
+			if (!tipElement.data(DATA_HASMOUSEMOVE)) {
+				$document.on('mousemove', positionTipOnCursor);
+				$window.on('scroll', positionTipOnCursor);
+				tipElement.data(DATA_HASMOUSEMOVE, true);
+			}
+		}
+
+		// if we want to be able to mouse onto the tooltip then we need to attach
+		// hover events to the tooltip that will cancel a close request on hover and
+		// start a new close request on mouseleave
+		if (options.mouseOnToPopup) {
+			tipElement.on({
+				mouseenter: function tipMouseEnter() {
+					// we only let the mouse stay on the tooltip if it is set to let
+					// users interact with it
+					if (tipElement.data(DATA_MOUSEONTOTIP)) {
+						// check activeHover in case the mouse cursor entered the
+						// tooltip during the fadeOut and close cycle
+						if (session.activeHover) {
+							session.activeHover.data(DATA_DISPLAYCONTROLLER).cancel();
+						}
+					}
+				},
+				mouseleave: function tipMouseLeave() {
+					// check activeHover in case the mouse cursor entered the
+					// tooltip during the fadeOut and close cycle
+					if (session.activeHover) {
+						session.activeHover.data(DATA_DISPLAYCONTROLLER).hide();
+					}
+				}
+			});
+		}
+
+		/**
+		 * Gives the specified element the active-hover state and queues up the
+		 * showTip function.
+		 * @private
+		 * @param {jQuery} element The element that the tooltip should target.
+		 */
+		function beginShowTip(element) {
+			element.data(DATA_HASACTIVEHOVER, true);
+			// show tooltip, asap
+			tipElement.queue(function queueTipInit(next) {
+				showTip(element);
+				next();
+			});
+		}
+
+		/**
+		 * Shows the tooltip, as soon as possible.
+		 * @private
+		 * @param {jQuery} element The element that the tooltip should target.
+		 */
+		function showTip(element) {
+			var tipContent;
+
+			// it is possible, especially with keyboard navigation, to move on to
+			// another element with a tooltip during the queue to get to this point
+			// in the code. if that happens then we need to not proceed or we may
+			// have the fadeout callback for the last tooltip execute immediately
+			// after this code runs, causing bugs.
+			if (!element.data(DATA_HASACTIVEHOVER)) {
+				return;
+			}
+
+			// if the tooltip is open and we got asked to open another one then the
+			// old one is still in its fadeOut cycle, so wait and try again
+			if (session.isTipOpen) {
+				if (!session.isClosing) {
+					hideTip(session.activeHover);
+				}
+				tipElement.delay(100).queue(function queueTipAgain(next) {
+					showTip(element);
+					next();
+				});
+				return;
+			}
+
+			// trigger powerTipPreRender event
+			element.trigger('powerTipPreRender');
+
+			// set tooltip content
+			tipContent = getTooltipContent(element);
+			if (tipContent) {
+				tipElement.empty().append(tipContent);
+			} else {
+				// we have no content to display, give up
+				return;
+			}
+
+			// trigger powerTipRender event
+			element.trigger('powerTipRender');
+
+			session.activeHover = element;
+			session.isTipOpen = true;
+
+			tipElement.data(DATA_MOUSEONTOTIP, options.mouseOnToPopup);
+
+			// set tooltip position
+			if (!options.followMouse) {
+				positionTipOnElement(element);
+				session.isFixedTipOpen = true;
+			} else {
+				positionTipOnCursor();
+			}
+
+			// fadein
+			tipElement.fadeIn(options.fadeInTime, function fadeInCallback() {
+				// start desync polling
+				if (!session.desyncTimeout) {
+					session.desyncTimeout = setInterval(closeDesyncedTip, 500);
+				}
+
+				// trigger powerTipOpen event
+				element.trigger('powerTipOpen');
+			});
+		}
+
+		/**
+		 * Hides the tooltip.
+		 * @private
+		 * @param {jQuery} element The element that the tooltip should target.
+		 */
+		function hideTip(element) {
+			// reset session
+			session.isClosing = true;
+			session.activeHover = null;
+			session.isTipOpen = false;
+
+			// stop desync polling
+			session.desyncTimeout = clearInterval(session.desyncTimeout);
+
+			// reset element state
+			element.data(DATA_HASACTIVEHOVER, false);
+			element.data(DATA_FORCEDOPEN, false);
+
+			// fade out
+			tipElement.fadeOut(options.fadeOutTime, function fadeOutCallback() {
+				var coords = new CSSCoordinates();
+
+				// reset session and tooltip element
+				session.isClosing = false;
+				session.isFixedTipOpen = false;
+				tipElement.removeClass();
+
+				// support mouse-follow and fixed position tips at the same time by
+				// moving the tooltip to the last cursor location after it is hidden
+				coords.set('top', session.currentY + options.offset);
+				coords.set('left', session.currentX + options.offset);
+				tipElement.css(coords);
+
+				// trigger powerTipClose event
+				element.trigger('powerTipClose');
+			});
+		}
+
+		/**
+		 * Moves the tooltip to the users mouse cursor.
+		 * @private
+		 */
+		function positionTipOnCursor() {
+			// to support having fixed tooltips on the same page as cursor tooltips,
+			// where both instances are referencing the same tooltip element, we
+			// need to keep track of the mouse position constantly, but we should
+			// only set the tip location if a fixed tip is not currently open, a tip
+			// open is imminent or active, and the tooltip element in question does
+			// have a mouse-follow using it.
+			if (!session.isFixedTipOpen && (session.isTipOpen || (session.tipOpenImminent && tipElement.data(DATA_HASMOUSEMOVE)))) {
+				// grab measurements
+				var tipWidth = tipElement.outerWidth(),
+					tipHeight = tipElement.outerHeight(),
+					coords = new CSSCoordinates(),
+					collisions,
+					collisionCount;
+
+				// grab collisions
+				coords.set('top', session.currentY + options.offset);
+				coords.set('left', session.currentX + options.offset);
+				collisions = getViewportCollisions(
+					coords,
+					tipWidth,
+					tipHeight
+				);
+
+				// handle tooltip view port collisions
+				if (collisions !== Collision.none) {
+					collisionCount = countFlags(collisions);
+					if (collisionCount === 1) {
+						// if there is only one collision (bottom or right) then
+						// simply constrain the tooltip to the view port
+						if (collisions === Collision.right) {
+							coords.set('left', session.windowWidth - tipWidth);
+						} else if (collisions === Collision.bottom) {
+							coords.set('top', session.scrollTop + session.windowHeight - tipHeight);
+						}
+					} else {
+						// if the tooltip has more than one collision then it is
+						// trapped in the corner and should be flipped to get it out
+						// of the users way
+						coords.set('left', session.currentX - tipWidth - options.offset);
+						coords.set('top', session.currentY - tipHeight - options.offset);
+					}
+				}
+
+				// position the tooltip
+				tipElement.css(coords);
+			}
+		}
+
+		/**
+		 * Sets the tooltip to the correct position relative to the specified target
+		 * element. Based on options settings.
+		 * @private
+		 * @param {jQuery} element The element that the tooltip should target.
+		 */
+		function positionTipOnElement(element) {
+			var priorityList,
+				finalPlacement;
+
+			if (options.smartPlacement) {
+				priorityList = $.fn.powerTip.smartPlacementLists[options.placement];
+
+				// iterate over the priority list and use the first placement option
+				// that does not collide with the view port. if they all collide
+				// then the last placement in the list will be used.
+				$.each(priorityList, function(idx, pos) {
+					// place tooltip and find collisions
+					var collisions = getViewportCollisions(
+						placeTooltip(element, pos),
+						tipElement.outerWidth(),
+						tipElement.outerHeight()
+					);
+
+					// update the final placement variable
+					finalPlacement = pos;
+
+					// break if there were no collisions
+					if (collisions === Collision.none) {
+						return false;
+					}
+				});
+			} else {
+				// if we're not going to use the smart placement feature then just
+				// compute the coordinates and do it
+				placeTooltip(element, options.placement);
+				finalPlacement = options.placement;
+			}
+
+			// add placement as class for CSS arrows
+			tipElement.addClass(finalPlacement);
+		}
+
+		/**
+		 * Sets the tooltip position to the appropriate values to show the tip at
+		 * the specified placement. This function will iterate and test the tooltip
+		 * to support elastic tooltips.
+		 * @private
+		 * @param {jQuery} element The element that the tooltip should target.
+		 * @param {string} placement The placement for the tooltip.
+		 * @return {CSSCoordinates} A CSSCoordinates object with the top, left, and
+		 *     right position values.
+		 */
+		function placeTooltip(element, placement) {
+			var iterationCount = 0,
+				tipWidth,
+				tipHeight,
+				coords = new CSSCoordinates();
+
+			// set the tip to 0,0 to get the full expanded width
+			coords.set('top', 0);
+			coords.set('left', 0);
+			tipElement.css(coords);
+
+			// to support elastic tooltips we need to check for a change in the
+			// rendered dimensions after the tooltip has been positioned
+			do {
+				// grab the current tip dimensions
+				tipWidth = tipElement.outerWidth();
+				tipHeight = tipElement.outerHeight();
+
+				// get placement coordinates
+				coords = placementCalculator.compute(
+					element,
+					placement,
+					tipWidth,
+					tipHeight,
+					options.offset
+				);
+
+				// place the tooltip
+				tipElement.css(coords);
+			} while (
+				// sanity check: limit to 5 iterations, and...
+				++iterationCount <= 5 &&
+				// try again if the dimensions changed after placement
+				(tipWidth !== tipElement.outerWidth() || tipHeight !== tipElement.outerHeight())
+			);
+
+			return coords;
+		}
+
+		/**
+		 * Checks for a tooltip desync and closes the tooltip if one occurs.
+		 * @private
+		 */
+		function closeDesyncedTip() {
+			var isDesynced = false;
+			// It is possible for the mouse cursor to leave an element without
+			// firing the mouseleave or blur event. This most commonly happens when
+			// the element is disabled under mouse cursor. If this happens it will
+			// result in a desynced tooltip because the tooltip was never asked to
+			// close. So we should periodically check for a desync situation and
+			// close the tip if such a situation arises.
+			if (session.isTipOpen && !session.isClosing && !session.delayInProgress) {
+				// user moused onto another tip or active hover is disabled
+				if (session.activeHover.data(DATA_HASACTIVEHOVER) === false || session.activeHover.is(':disabled')) {
+					isDesynced = true;
+				} else {
+					// hanging tip - have to test if mouse position is not over the
+					// active hover and not over a tooltip set to let the user
+					// interact with it.
+					// for keyboard navigation: this only counts if the element does
+					// not have focus.
+					// for tooltips opened via the api: we need to check if it has
+					// the forcedOpen flag.
+					if (!isMouseOver(session.activeHover) && !session.activeHover.is(':focus') && !session.activeHover.data(DATA_FORCEDOPEN)) {
+						if (tipElement.data(DATA_MOUSEONTOTIP)) {
+							if (!isMouseOver(tipElement)) {
+								isDesynced = true;
+							}
+						} else {
+							isDesynced = true;
+						}
+					}
+				}
+
+				if (isDesynced) {
+					// close the desynced tip
+					hideTip(session.activeHover);
+				}
+			}
+		}
+
+		// expose methods
+		this.showTip = beginShowTip;
+		this.hideTip = hideTip;
+		this.resetPosition = positionTipOnElement;
+	}
+
+	/**
+	 * Determine whether a jQuery object is an SVG element
+	 * @private
+	 * @param {jQuery} element The element to check
+	 * @return {boolean} Whether this is an SVG element
+	 */
+	function isSvgElement(element) {
+		return window.SVGElement && element[0] instanceof SVGElement;
+	}
+
+	/**
+	 * Initializes the viewport dimension cache and hooks up the mouse position
+	 * tracking and viewport dimension tracking events.
+	 * Prevents attaching the events more than once.
+	 * @private
+	 */
+	function initTracking() {
+		if (!session.mouseTrackingActive) {
+			session.mouseTrackingActive = true;
+
+			// grab the current viewport dimensions on load
+			$(function getViewportDimensions() {
+				session.scrollLeft = $window.scrollLeft();
+				session.scrollTop = $window.scrollTop();
+				session.windowWidth = $window.width();
+				session.windowHeight = $window.height();
+			});
+
+			// hook mouse move tracking
+			$document.on('mousemove', trackMouse);
+
+			// hook viewport dimensions tracking
+			$window.on({
+				resize: function trackResize() {
+					session.windowWidth = $window.width();
+					session.windowHeight = $window.height();
+				},
+				scroll: function trackScroll() {
+					var x = $window.scrollLeft(),
+						y = $window.scrollTop();
+					if (x !== session.scrollLeft) {
+						session.currentX += x - session.scrollLeft;
+						session.scrollLeft = x;
+					}
+					if (y !== session.scrollTop) {
+						session.currentY += y - session.scrollTop;
+						session.scrollTop = y;
+					}
+				}
+			});
+		}
+	}
+
+	/**
+	 * Saves the current mouse coordinates to the session object.
+	 * @private
+	 * @param {jQuery.Event} event The mousemove event for the document.
+	 */
+	function trackMouse(event) {
+		session.currentX = event.pageX;
+		session.currentY = event.pageY;
+	}
+
+	/**
+	 * Tests if the mouse is currently over the specified element.
+	 * @private
+	 * @param {jQuery} element The element to check for hover.
+	 * @return {boolean}
+	 */
+	function isMouseOver(element) {
+		// use getBoundingClientRect() because jQuery's width() and height()
+		// methods do not work with SVG elements
+		// compute width/height because those properties do not exist on the object
+		// returned by getBoundingClientRect() in older versions of IE
+		var elementPosition = element.offset(),
+			elementBox = element[0].getBoundingClientRect(),
+			elementWidth = elementBox.right - elementBox.left,
+			elementHeight = elementBox.bottom - elementBox.top;
+
+		return session.currentX >= elementPosition.left &&
+			session.currentX <= elementPosition.left + elementWidth &&
+			session.currentY >= elementPosition.top &&
+			session.currentY <= elementPosition.top + elementHeight;
+	}
+
+	/**
+	 * Fetches the tooltip content from the specified element's data attributes.
+	 * @private
+	 * @param {jQuery} element The element to get the tooltip content for.
+	 * @return {(string|jQuery|undefined)} The text/HTML string, jQuery object, or
+	 *     undefined if there was no tooltip content for the element.
+	 */
+	function getTooltipContent(element) {
+		var tipText = element.data(DATA_POWERTIP),
+			tipObject = element.data(DATA_POWERTIPJQ),
+			tipTarget = element.data(DATA_POWERTIPTARGET),
+			targetElement,
+			content;
+
+		if (tipText) {
+			if ($.isFunction(tipText)) {
+				tipText = tipText.call(element[0]);
+			}
+			content = tipText;
+		} else if (tipObject) {
+			if ($.isFunction(tipObject)) {
+				tipObject = tipObject.call(element[0]);
+			}
+			if (tipObject.length > 0) {
+				content = tipObject.clone(true, true);
+			}
+		} else if (tipTarget) {
+			targetElement = $('#' + tipTarget);
+			if (targetElement.length > 0) {
+				content = targetElement.html();
+			}
+		}
+
+		return content;
+	}
+
+	/**
+	 * Finds any viewport collisions that an element (the tooltip) would have if it
+	 * were absolutely positioned at the specified coordinates.
+	 * @private
+	 * @param {CSSCoordinates} coords Coordinates for the element.
+	 * @param {number} elementWidth Width of the element in pixels.
+	 * @param {number} elementHeight Height of the element in pixels.
+	 * @return {number} Value with the collision flags.
+	 */
+	function getViewportCollisions(coords, elementWidth, elementHeight) {
+		var viewportTop = session.scrollTop,
+			viewportLeft =  session.scrollLeft,
+			viewportBottom = viewportTop + session.windowHeight,
+			viewportRight = viewportLeft + session.windowWidth,
+			collisions = Collision.none;
+
+		if (coords.top < viewportTop || Math.abs(coords.bottom - session.windowHeight) - elementHeight < viewportTop) {
+			collisions |= Collision.top;
+		}
+		if (coords.top + elementHeight > viewportBottom || Math.abs(coords.bottom - session.windowHeight) > viewportBottom) {
+			collisions |= Collision.bottom;
+		}
+		if (coords.left < viewportLeft || coords.right + elementWidth > viewportRight) {
+			collisions |= Collision.left;
+		}
+		if (coords.left + elementWidth > viewportRight || coords.right < viewportLeft) {
+			collisions |= Collision.right;
+		}
+
+		return collisions;
+	}
+
+	/**
+	 * Counts the number of bits set on a flags value.
+	 * @param {number} value The flags value.
+	 * @return {number} The number of bits that have been set.
+	 */
+	function countFlags(value) {
+		var count = 0;
+		while (value) {
+			value &= value - 1;
+			count++;
+		}
+		return count;
+	}
+
+}));
diff -Nru acl2-6.2/books/xdoc/fancy/lib/jquery.powertip.min.js acl2-6.3/books/xdoc/fancy/lib/jquery.powertip.min.js
--- acl2-6.2/books/xdoc/fancy/lib/jquery.powertip.min.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/jquery.powertip.min.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,8 @@
+/*!
+ PowerTip - v1.2.0 - 2013-04-03
+ http://stevenbenner.github.com/jquery-powertip/
+ Copyright (c) 2013 Steven Benner (http://stevenbenner.com/).
+ Released under MIT license.
+ https://raw.github.com/stevenbenner/jquery-powertip/master/LICENSE.txt
+*/
+(function(e){"function"==typeof define&&define.amd?define(["jquery"],e):e(jQuery)})(function(e){function t(){var t=this;t.top="auto",t.left="auto",t.right="auto",t.bottom="auto",t.set=function(o,n){e.isNumeric(n)&&(t[o]=Math.round(n))}}function o(e,t,o){function n(n,i){r(),e.data(v)||(n?(i&&e.data(m,!0),o.showTip(e)):(P.tipOpenImminent=!0,l=setTimeout(function(){l=null,s()},t.intentPollInterval)))}function i(n){r(),P.tipOpenImminent=!1,e.data(v)&&(e.data(m,!1),n?o.hideTip(e):(P.delayInProgress=!0,l=setTimeout(function(){l=null,o.hideTip(e),P.delayInProgress=!1},t.closeDelay)))}function s(){var i=Math.abs(P.previousX-P.currentX),s=Math.abs(P.previousY-P.currentY),r=i+s;t.intentSensitivity>r?o.showTip(e):(P.previousX=P.currentX,P.previousY=P.currentY,n())}function r(){l=clearTimeout(l),P.delayInProgress=!1}function a(){o.resetPosition(e)}var l=null;this.show=n,this.hide=i,this.cancel=r,this.resetPosition=a}function n(){function e(e,i,r,a,l){var p,c=i.split("-")[0],u=new t;switch(p=s(e)?n(e,c):o(e,c),i){case"n":u.set("left",p.left-r/2),u.set("bottom",P.windowHeight-p.top+l);break;case"e":u.set("left",p.left+l),u.set("top",p.top-a/2);break;case"s":u.set("left",p.left-r/2),u.set("top",p.top+l);break;case"w":u.set("top",p.top-a/2),u.set("right",P.windowWidth-p.left+l);break;case"nw":u.set("bottom",P.windowHeight-p.top+l),u.set("right",P.windowWidth-p.left-20);break;case"nw-alt":u.set("left",p.left),u.set("bottom",P.windowHeight-p.top+l);break;case"ne":u.set("left",p.left-20),u.set("bottom",P.windowHeight-p.top+l);break;case"ne-alt":u.set("bottom",P.windowHeight-p.top+l),u.set("right",P.windowWidth-p.left);break;case"sw":u.set("top",p.top+l),u.set("right",P.windowWidth-p.left-20);break;case"sw-alt":u.set("left",p.left),u.set("top",p.top+l);break;case"se":u.set("left",p.left-20),u.set("top",p.top+l);break;case"se-alt":u.set("top",p.top+l),u.set("right",P.windowWidth-p.left)}return u}function o(e,t){var o,n,i=e.offset(),s=e.outerWidth(),r=e.outerHeight();switch(t){case"n":o=i.left+s/2,n=i.top;break;case"e":o=i.left+s,n=i.top+r/2;break;case"s":o=i.left+s/2,n=i.top+r;break;case"w":o=i.left,n=i.top+r/2;break;case"nw":o=i.left,n=i.top;break;case"ne":o=i.left+s,n=i.top;break;case"sw":o=i.left,n=i.top+r;break;case"se":o=i.left+s,n=i.top+r}return{top:n,left:o}}function n(e,t){function o(){d.push(p.matrixTransform(u))}var n,i,s,r,a=e.closest("svg")[0],l=e[0],p=a.createSVGPoint(),c=l.getBBox(),u=l.getScreenCTM(),f=c.width/2,w=c.height/2,d=[],h=["nw","n","ne","e","se","s","sw","w"];if(p.x=c.x,p.y=c.y,o(),p.x+=f,o(),p.x+=f,o(),p.y+=w,o(),p.y+=w,o(),p.x-=f,o(),p.x-=f,o(),p.y-=w,o(),d[0].y!==d[1].y||d[0].x!==d[7].x)for(i=Math.atan2(u.b,u.a)*O,s=Math.ceil((i%360-22.5)/45),1>s&&(s+=8);s--;)h.push(h.shift());for(r=0;d.length>r;r++)if(h[r]===t){n=d[r];break}return{top:n.y+P.scrollTop,left:n.x+P.scrollLeft}}this.compute=e}function i(o){function i(e){e.data(v,!0),O.queue(function(t){s(e),t()})}function s(e){var t;if(e.data(v)){if(P.isTipOpen)return P.isClosing||r(P.activeHover),O.delay(100).queue(function(t){s(e),t()}),void 0;e.trigger("powerTipPreRender"),t=p(e),t&&(O.empty().append(t),e.trigger("powerTipRender"),P.activeHover=e,P.isTipOpen=!0,O.data(g,o.mouseOnToPopup),o.followMouse?a():(b(e),P.isFixedTipOpen=!0),O.fadeIn(o.fadeInTime,function(){P.desyncTimeout||(P.desyncTimeout=setInterval(H,500)),e.trigger("powerTipOpen")}))}}function r(e){P.isClosing=!0,P.activeHover=null,P.isTipOpen=!1,P.desyncTimeout=clearInterval(P.desyncTimeout),e.data(v,!1),e.data(m,!1),O.fadeOut(o.fadeOutTime,function(){var n=new t;P.isClosing=!1,P.isFixedTipOpen=!1,O.removeClass(),n.set("top",P.currentY+o.offset),n.set("left",P.currentX+o.offset),O.css(n),e.trigger("powerTipClose")})}function a(){if(!P.isFixedTipOpen&&(P.isTipOpen||P.tipOpenImminent&&O.data(T))){var e,n,i=O.outerWidth(),s=O.outerHeight(),r=new t;r.set("top",P.currentY+o.offset),r.set("left",P.currentX+o.offset),e=c(r,i,s),e!==I.none&&(n=u(e),1===n?e===I.right?r.set("left",P.windowWidth-i):e===I.bottom&&r.set("top",P.scrollTop+P.windowHeight-s):(r.set("left",P.currentX-i-o.offset),r.set("top",P.currentY-s-o.offset))),O.css(r)}}function b(t){var n,i;o.smartPlacement?(n=e.fn.powerTip.smartPlacementLists[o.placement],e.each(n,function(e,o){var n=c(y(t,o),O.outerWidth(),O.outerHeight());return i=o,n===I.none?!1:void 0})):(y(t,o.placement),i=o.placement),O.addClass(i)}function y(e,n){var i,s,r=0,a=new t;a.set("top",0),a.set("left",0),O.css(a);do i=O.outerWidth(),s=O.outerHeight(),a=k.compute(e,n,i,s,o.offset),O.css(a);while(5>=++r&&(i!==O.outerWidth()||s!==O.outerHeight()));return a}function H(){var e=!1;!P.isTipOpen||P.isClosing||P.delayInProgress||(P.activeHover.data(v)===!1||P.activeHover.is(":disabled")?e=!0:l(P.activeHover)||P.activeHover.is(":focus")||P.activeHover.data(m)||(O.data(g)?l(O)||(e=!0):e=!0),e&&r(P.activeHover))}var k=new n,O=e("#"+o.popupId);0===O.length&&(O=e("<div/>",{id:o.popupId}),0===d.length&&(d=e("body")),d.append(O)),o.followMouse&&(O.data(T)||(f.on("mousemove",a),w.on("scroll",a),O.data(T,!0))),o.mouseOnToPopup&&O.on({mouseenter:function(){O.data(g)&&P.activeHover&&P.activeHover.data(h).cancel()},mouseleave:function(){P.activeHover&&P.activeHover.data(h).hide()}}),this.showTip=i,this.hideTip=r,this.resetPosition=b}function s(e){return window.SVGElement&&e[0]instanceof SVGElement}function r(){P.mouseTrackingActive||(P.mouseTrackingActive=!0,e(function(){P.scrollLeft=w.scrollLeft(),P.scrollTop=w.scrollTop(),P.windowWidth=w.width(),P.windowHeight=w.height()}),f.on("mousemove",a),w.on({resize:function(){P.windowWidth=w.width(),P.windowHeight=w.height()},scroll:function(){var e=w.scrollLeft(),t=w.scrollTop();e!==P.scrollLeft&&(P.currentX+=e-P.scrollLeft,P.scrollLeft=e),t!==P.scrollTop&&(P.currentY+=t-P.scrollTop,P.scrollTop=t)}}))}function a(e){P.currentX=e.pageX,P.currentY=e.pageY}function l(e){var t=e.offset(),o=e[0].getBoundingClientRect(),n=o.right-o.left,i=o.bottom-o.top;return P.currentX>=t.left&&P.currentX<=t.left+n&&P.currentY>=t.top&&P.currentY<=t.top+i}function p(t){var o,n,i=t.data(y),s=t.data(H),r=t.data(k);return i?(e.isFunction(i)&&(i=i.call(t[0])),n=i):s?(e.isFunction(s)&&(s=s.call(t[0])),s.length>0&&(n=s.clone(!0,!0))):r&&(o=e("#"+r),o.length>0&&(n=o.html())),n}function c(e,t,o){var n=P.scrollTop,i=P.scrollLeft,s=n+P.windowHeight,r=i+P.windowWidth,a=I.none;return(n>e.top||n>Math.abs(e.bottom-P.windowHeight)-o)&&(a|=I.top),(e.top+o>s||Math.abs(e.bottom-P.windowHeight)>s)&&(a|=I.bottom),(i>e.left||e.right+t>r)&&(a|=I.left),(e.left+t>r||i>e.right)&&(a|=I.right),a}function u(e){for(var t=0;e;)e&=e-1,t++;return t}var f=e(document),w=e(window),d=e("body"),h="displayController",v="hasActiveHover",m="forcedOpen",T="hasMouseMove",g="mouseOnToPopup",b="originalTitle",y="powertip",H="powertipjq",k="powertiptarget",O=180/Math.PI,P={isTipOpen:!1,isFixedTipOpen:!1,isClosing:!1,tipOpenImminent:!1,activeHover:null,currentX:0,currentY:0,previousX:0,previousY:0,desyncTimeout:null,mouseTrackingActive:!1,delayInProgress:!1,windowWidth:0,windowHeight:0,scrollTop:0,scrollLeft:0},I={none:0,top:1,bottom:2,left:4,right:8};e.fn.powerTip=function(t,n){if(!this.length)return this;if("string"===e.type(t)&&e.powerTip[t])return e.powerTip[t].call(this,this,n);var s=e.extend({},e.fn.powerTip.defaults,t),a=new i(s);return r(),this.each(function(){var t,n=e(this),i=n.data(y),r=n.data(H),l=n.data(k);n.data(h)&&e.powerTip.destroy(n),t=n.attr("title"),i||l||r||!t||(n.data(y,t),n.data(b,t),n.removeAttr("title")),n.data(h,new o(n,s,a))}),s.manual||this.on({"mouseenter.powertip":function(t){e.powerTip.show(this,t)},"mouseleave.powertip":function(){e.powerTip.hide(this)},"focus.powertip":function(){e.powerTip.show(this)},"blur.powertip":function(){e.powerTip.hide(this,!0)},"keydown.powertip":function(t){27===t.keyCode&&e.powerTip.hide(this,!0)}}),this},e.fn.powerTip.defaults={fadeInTime:200,fadeOutTime:100,followMouse:!1,popupId:"powerTip",intentSensitivity:7,intentPollInterval:100,closeDelay:100,placement:"n",smartPlacement:!1,offset:10,mouseOnToPopup:!1,manual:!1},e.fn.powerTip.smartPlacementLists={n:["n","ne","nw","s"],e:["e","ne","se","w","nw","sw","n","s","e"],s:["s","se","sw","n"],w:["w","nw","sw","e","ne","se","n","s","w"],nw:["nw","w","sw","n","s","se","nw"],ne:["ne","e","se","n","s","sw","ne"],sw:["sw","w","nw","s","n","ne","sw"],se:["se","e","ne","s","n","nw","se"],"nw-alt":["nw-alt","n","ne-alt","sw-alt","s","se-alt","w","e"],"ne-alt":["ne-alt","n","nw-alt","se-alt","s","sw-alt","e","w"],"sw-alt":["sw-alt","s","se-alt","nw-alt","n","ne-alt","w","e"],"se-alt":["se-alt","s","sw-alt","ne-alt","n","nw-alt","e","w"]},e.powerTip={show:function(t,o){return o?(a(o),P.previousX=o.pageX,P.previousY=o.pageY,e(t).data(h).show()):e(t).first().data(h).show(!0,!0),t},reposition:function(t){return e(t).first().data(h).resetPosition(),t},hide:function(t,o){return t?e(t).first().data(h).hide(o):P.activeHover&&P.activeHover.data(h).hide(!0),t},destroy:function(t){return e(t).off(".powertip").each(function(){var t=e(this),o=[b,h,v,m];t.data(b)&&(t.attr("title",t.data(b)),o.push(y)),t.removeData(o)}),t}},e.powerTip.showTip=e.powerTip.show,e.powerTip.closeTip=e.powerTip.hide});
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc/fancy/lib/lazyload.js acl2-6.3/books/xdoc/fancy/lib/lazyload.js
--- acl2-6.2/books/xdoc/fancy/lib/lazyload.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/lazyload.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,390 @@
+/*jslint browser: true, eqeqeq: true, bitwise: true, newcap: true, immed: true, regexp: false */
+
+/**
+LazyLoad makes it easy and painless to lazily load one or more external
+JavaScript or CSS files on demand either during or after the rendering of a web
+page.
+
+Supported browsers include Firefox 2+, IE6+, Safari 3+ (including Mobile
+Safari), Google Chrome, and Opera 9+. Other browsers may or may not work and
+are not officially supported.
+
+Visit https://github.com/rgrove/lazyload/ for more info.
+
+Copyright (c) 2011 Ryan Grove <ryan@wonko.com>
+All rights reserved.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the 'Software'), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+the Software, and to permit persons to whom the Software is furnished to do so,
+subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+@module lazyload
+@class LazyLoad
+@static
+*/
+
+LazyLoad = (function (doc) {
+  // -- Private Variables ------------------------------------------------------
+
+  // User agent and feature test information.
+  var env,
+
+  // Reference to the <head> element (populated lazily).
+  head,
+
+  // Requests currently in progress, if any.
+  pending = {},
+
+  // Number of times we've polled to check whether a pending stylesheet has
+  // finished loading. If this gets too high, we're probably stalled.
+  pollCount = 0,
+
+  // Queued requests.
+  queue = {css: [], js: []},
+
+  // Reference to the browser's list of stylesheets.
+  styleSheets = doc.styleSheets;
+
+  // -- Private Methods --------------------------------------------------------
+
+  /**
+  Creates and returns an HTML element with the specified name and attributes.
+
+  @method createNode
+  @param {String} name element name
+  @param {Object} attrs name/value mapping of element attributes
+  @return {HTMLElement}
+  @private
+  */
+  function createNode(name, attrs) {
+    var node = doc.createElement(name), attr;
+
+    for (attr in attrs) {
+      if (attrs.hasOwnProperty(attr)) {
+        node.setAttribute(attr, attrs[attr]);
+      }
+    }
+
+    return node;
+  }
+
+  /**
+  Called when the current pending resource of the specified type has finished
+  loading. Executes the associated callback (if any) and loads the next
+  resource in the queue.
+
+  @method finish
+  @param {String} type resource type ('css' or 'js')
+  @private
+  */
+  function finish(type) {
+    var p = pending[type],
+        callback,
+        urls;
+
+    if (p) {
+      callback = p.callback;
+      urls     = p.urls;
+
+      urls.shift();
+      pollCount = 0;
+
+      // If this is the last of the pending URLs, execute the callback and
+      // start the next request in the queue (if any).
+      if (!urls.length) {
+        callback && callback.call(p.context, p.obj);
+        pending[type] = null;
+        queue[type].length && load(type);
+      }
+    }
+  }
+
+  /**
+  Populates the <code>env</code> variable with user agent and feature test
+  information.
+
+  @method getEnv
+  @private
+  */
+  function getEnv() {
+    var ua = navigator.userAgent;
+
+    env = {
+      // True if this browser supports disabling async mode on dynamically
+      // created script nodes. See
+      // http://wiki.whatwg.org/wiki/Dynamic_Script_Execution_Order
+      async: doc.createElement('script').async === true
+    };
+
+    (env.webkit = /AppleWebKit\//.test(ua))
+      || (env.ie = /MSIE|Trident/.test(ua))
+      || (env.opera = /Opera/.test(ua))
+      || (env.gecko = /Gecko\//.test(ua))
+      || (env.unknown = true);
+  }
+
+  /**
+  Loads the specified resources, or the next resource of the specified type
+  in the queue if no resources are specified. If a resource of the specified
+  type is already being loaded, the new request will be queued until the
+  first request has been finished.
+
+  When an array of resource URLs is specified, those URLs will be loaded in
+  parallel if it is possible to do so while preserving execution order. All
+  browsers support parallel loading of CSS, but only Firefox and Opera
+  support parallel loading of scripts. In other browsers, scripts will be
+  queued and loaded one at a time to ensure correct execution order.
+
+  @method load
+  @param {String} type resource type ('css' or 'js')
+  @param {String|Array} urls (optional) URL or array of URLs to load
+  @param {Function} callback (optional) callback function to execute when the
+    resource is loaded
+  @param {Object} obj (optional) object to pass to the callback function
+  @param {Object} context (optional) if provided, the callback function will
+    be executed in this object's context
+  @private
+  */
+  function load(type, urls, callback, obj, context) {
+    var _finish = function () { finish(type); },
+        isCSS   = type === 'css',
+        nodes   = [],
+        i, len, node, p, pendingUrls, url;
+
+    env || getEnv();
+
+    if (urls) {
+      // If urls is a string, wrap it in an array. Otherwise assume it's an
+      // array and create a copy of it so modifications won't be made to the
+      // original.
+      urls = typeof urls === 'string' ? [urls] : urls.concat();
+
+      // Create a request object for each URL. If multiple URLs are specified,
+      // the callback will only be executed after all URLs have been loaded.
+      //
+      // Sadly, Firefox and Opera are the only browsers capable of loading
+      // scripts in parallel while preserving execution order. In all other
+      // browsers, scripts must be loaded sequentially.
+      //
+      // All browsers respect CSS specificity based on the order of the link
+      // elements in the DOM, regardless of the order in which the stylesheets
+      // are actually downloaded.
+      if (isCSS || env.async || env.gecko || env.opera) {
+        // Load in parallel.
+        queue[type].push({
+          urls    : urls,
+          callback: callback,
+          obj     : obj,
+          context : context
+        });
+      } else {
+        // Load sequentially.
+        for (i = 0, len = urls.length; i < len; ++i) {
+          queue[type].push({
+            urls    : [urls[i]],
+            callback: i === len - 1 ? callback : null, // callback is only added to the last URL
+            obj     : obj,
+            context : context
+          });
+        }
+      }
+    }
+
+    // If a previous load request of this type is currently in progress, we'll
+    // wait our turn. Otherwise, grab the next item in the queue.
+    if (pending[type] || !(p = pending[type] = queue[type].shift())) {
+      return;
+    }
+
+    head || (head = doc.head || doc.getElementsByTagName('head')[0]);
+    pendingUrls = p.urls;
+
+    for (i = 0, len = pendingUrls.length; i < len; ++i) {
+      url = pendingUrls[i];
+
+      if (isCSS) {
+          node = env.gecko ? createNode('style') : createNode('link', {
+            href: url,
+            rel : 'stylesheet'
+          });
+      } else {
+        node = createNode('script', {src: url});
+        node.async = false;
+      }
+
+      node.className = 'lazyload';
+      node.setAttribute('charset', 'utf-8');
+
+      if (env.ie && !isCSS && 'onreadystatechange' in node && !('draggable' in node)) {
+        node.onreadystatechange = function () {
+          if (/loaded|complete/.test(node.readyState)) {
+            node.onreadystatechange = null;
+            _finish();
+          }
+        };
+      } else if (isCSS && (env.gecko || env.webkit)) {
+        // Gecko and WebKit don't support the onload event on link nodes.
+        if (env.webkit) {
+          // In WebKit, we can poll for changes to document.styleSheets to
+          // figure out when stylesheets have loaded.
+          p.urls[i] = node.href; // resolve relative URLs (or polling won't work)
+          pollWebKit();
+        } else {
+          // In Gecko, we can import the requested URL into a <style> node and
+          // poll for the existence of node.sheet.cssRules. Props to Zach
+          // Leatherman for calling my attention to this technique.
+          node.innerHTML = '@import "' + url + '";';
+          pollGecko(node);
+        }
+      } else {
+        node.onload = node.onerror = _finish;
+      }
+
+      nodes.push(node);
+    }
+
+    for (i = 0, len = nodes.length; i < len; ++i) {
+      head.appendChild(nodes[i]);
+    }
+  }
+
+  /**
+  Begins polling to determine when the specified stylesheet has finished loading
+  in Gecko. Polling stops when all pending stylesheets have loaded or after 10
+  seconds (to prevent stalls).
+
+  Thanks to Zach Leatherman for calling my attention to the @import-based
+  cross-domain technique used here, and to Oleg Slobodskoi for an earlier
+  same-domain implementation. See Zach's blog for more details:
+  http://www.zachleat.com/web/2010/07/29/load-css-dynamically/
+
+  @method pollGecko
+  @param {HTMLElement} node Style node to poll.
+  @private
+  */
+  function pollGecko(node) {
+    var hasRules;
+
+    try {
+      // We don't really need to store this value or ever refer to it again, but
+      // if we don't store it, Closure Compiler assumes the code is useless and
+      // removes it.
+      hasRules = !!node.sheet.cssRules;
+    } catch (ex) {
+      // An exception means the stylesheet is still loading.
+      pollCount += 1;
+
+      if (pollCount < 200) {
+        setTimeout(function () { pollGecko(node); }, 50);
+      } else {
+        // We've been polling for 10 seconds and nothing's happened. Stop
+        // polling and finish the pending requests to avoid blocking further
+        // requests.
+        hasRules && finish('css');
+      }
+
+      return;
+    }
+
+    // If we get here, the stylesheet has loaded.
+    finish('css');
+  }
+
+  /**
+  Begins polling to determine when pending stylesheets have finished loading
+  in WebKit. Polling stops when all pending stylesheets have loaded or after 10
+  seconds (to prevent stalls).
+
+  @method pollWebKit
+  @private
+  */
+  function pollWebKit() {
+    var css = pending.css, i;
+
+    if (css) {
+      i = styleSheets.length;
+
+      // Look for a stylesheet matching the pending URL.
+      while (--i >= 0) {
+        if (styleSheets[i].href === css.urls[0]) {
+          finish('css');
+          break;
+        }
+      }
+
+      pollCount += 1;
+
+      if (css) {
+        if (pollCount < 200) {
+          setTimeout(pollWebKit, 50);
+        } else {
+          // We've been polling for 10 seconds and nothing's happened, which may
+          // indicate that the stylesheet has been removed from the document
+          // before it had a chance to load. Stop polling and finish the pending
+          // request to prevent blocking further requests.
+          finish('css');
+        }
+      }
+    }
+  }
+
+  return {
+
+    /**
+    Requests the specified CSS URL or URLs and executes the specified
+    callback (if any) when they have finished loading. If an array of URLs is
+    specified, the stylesheets will be loaded in parallel and the callback
+    will be executed after all stylesheets have finished loading.
+
+    @method css
+    @param {String|Array} urls CSS URL or array of CSS URLs to load
+    @param {Function} callback (optional) callback function to execute when
+      the specified stylesheets are loaded
+    @param {Object} obj (optional) object to pass to the callback function
+    @param {Object} context (optional) if provided, the callback function
+      will be executed in this object's context
+    @static
+    */
+    css: function (urls, callback, obj, context) {
+      load('css', urls, callback, obj, context);
+    },
+
+    /**
+    Requests the specified JavaScript URL or URLs and executes the specified
+    callback (if any) when they have finished loading. If an array of URLs is
+    specified and the browser supports it, the scripts will be loaded in
+    parallel and the callback will be executed after all scripts have
+    finished loading.
+
+    Currently, only Firefox and Opera support parallel loading of scripts while
+    preserving execution order. In other browsers, scripts will be
+    queued and loaded one at a time to ensure correct execution order.
+
+    @method js
+    @param {String|Array} urls JS URL or array of JS URLs to load
+    @param {Function} callback (optional) callback function to execute when
+      the specified scripts are loaded
+    @param {Object} obj (optional) object to pass to the callback function
+    @param {Object} context (optional) if provided, the callback function
+      will be executed in this object's context
+    @static
+    */
+    js: function (urls, callback, obj, context) {
+      load('js', urls, callback, obj, context);
+    }
+
+  };
+})(this.document);
diff -Nru acl2-6.2/books/xdoc/fancy/lib/typeahead.js acl2-6.3/books/xdoc/fancy/lib/typeahead.js
--- acl2-6.2/books/xdoc/fancy/lib/typeahead.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/typeahead.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,1139 @@
+/*!
+ * typeahead.js 0.9.3
+ * https://github.com/twitter/typeahead
+ * Copyright 2013 Twitter, Inc. and other contributors; Licensed MIT
+ */
+
+(function($) {
+    var VERSION = "0.9.3";
+    var utils = {
+        isMsie: function() {
+            var match = /(msie) ([\w.]+)/i.exec(navigator.userAgent);
+            return match ? parseInt(match[2], 10) : false;
+        },
+        isBlankString: function(str) {
+            return !str || /^\s*$/.test(str);
+        },
+        escapeRegExChars: function(str) {
+            return str.replace(/[\-\[\]\/\{\}\(\)\*\+\?\.\\\^\$\|]/g, "\\$&");
+        },
+        isString: function(obj) {
+            return typeof obj === "string";
+        },
+        isNumber: function(obj) {
+            return typeof obj === "number";
+        },
+        isArray: $.isArray,
+        isFunction: $.isFunction,
+        isObject: $.isPlainObject,
+        isUndefined: function(obj) {
+            return typeof obj === "undefined";
+        },
+        bind: $.proxy,
+        bindAll: function(obj) {
+            var val;
+            for (var key in obj) {
+                $.isFunction(val = obj[key]) && (obj[key] = $.proxy(val, obj));
+            }
+        },
+        indexOf: function(haystack, needle) {
+            for (var i = 0; i < haystack.length; i++) {
+                if (haystack[i] === needle) {
+                    return i;
+                }
+            }
+            return -1;
+        },
+        each: $.each,
+        map: $.map,
+        filter: $.grep,
+        every: function(obj, test) {
+            var result = true;
+            if (!obj) {
+                return result;
+            }
+            $.each(obj, function(key, val) {
+                if (!(result = test.call(null, val, key, obj))) {
+                    return false;
+                }
+            });
+            return !!result;
+        },
+        some: function(obj, test) {
+            var result = false;
+            if (!obj) {
+                return result;
+            }
+            $.each(obj, function(key, val) {
+                if (result = test.call(null, val, key, obj)) {
+                    return false;
+                }
+            });
+            return !!result;
+        },
+        mixin: $.extend,
+        getUniqueId: function() {
+            var counter = 0;
+            return function() {
+                return counter++;
+            };
+        }(),
+        defer: function(fn) {
+            setTimeout(fn, 0);
+        },
+        debounce: function(func, wait, immediate) {
+            var timeout, result;
+            return function() {
+                var context = this, args = arguments, later, callNow;
+                later = function() {
+                    timeout = null;
+                    if (!immediate) {
+                        result = func.apply(context, args);
+                    }
+                };
+                callNow = immediate && !timeout;
+                clearTimeout(timeout);
+                timeout = setTimeout(later, wait);
+                if (callNow) {
+                    result = func.apply(context, args);
+                }
+                return result;
+            };
+        },
+        throttle: function(func, wait) {
+            var context, args, timeout, result, previous, later;
+            previous = 0;
+            later = function() {
+                previous = new Date();
+                timeout = null;
+                result = func.apply(context, args);
+            };
+            return function() {
+                var now = new Date(), remaining = wait - (now - previous);
+                context = this;
+                args = arguments;
+                if (remaining <= 0) {
+                    clearTimeout(timeout);
+                    timeout = null;
+                    previous = now;
+                    result = func.apply(context, args);
+                } else if (!timeout) {
+                    timeout = setTimeout(later, remaining);
+                }
+                return result;
+            };
+        },
+        tokenizeQuery: function(str) {
+            return $.trim(str).toLowerCase().split(/[\s]+/);
+        },
+        tokenizeText: function(str) {
+            return $.trim(str).toLowerCase().split(/[\s\-_]+/);
+        },
+        getProtocol: function() {
+            return location.protocol;
+        },
+        noop: function() {}
+    };
+    var EventTarget = function() {
+        var eventSplitter = /\s+/;
+        return {
+            on: function(events, callback) {
+                var event;
+                if (!callback) {
+                    return this;
+                }
+                this._callbacks = this._callbacks || {};
+                events = events.split(eventSplitter);
+                while (event = events.shift()) {
+                    this._callbacks[event] = this._callbacks[event] || [];
+                    this._callbacks[event].push(callback);
+                }
+                return this;
+            },
+            trigger: function(events, data) {
+                var event, callbacks;
+                if (!this._callbacks) {
+                    return this;
+                }
+                events = events.split(eventSplitter);
+                while (event = events.shift()) {
+                    if (callbacks = this._callbacks[event]) {
+                        for (var i = 0; i < callbacks.length; i += 1) {
+                            callbacks[i].call(this, {
+                                type: event,
+                                data: data
+                            });
+                        }
+                    }
+                }
+                return this;
+            }
+        };
+    }();
+    var EventBus = function() {
+        var namespace = "typeahead:";
+        function EventBus(o) {
+            if (!o || !o.el) {
+                $.error("EventBus initialized without el");
+            }
+            this.$el = $(o.el);
+        }
+        utils.mixin(EventBus.prototype, {
+            trigger: function(type) {
+                var args = [].slice.call(arguments, 1);
+                this.$el.trigger(namespace + type, args);
+            }
+        });
+        return EventBus;
+    }();
+    var PersistentStorage = function() {
+        var ls, methods;
+        try {
+            ls = window.localStorage;
+            ls.setItem("~~~", "!");
+            ls.removeItem("~~~");
+        } catch (err) {
+            ls = null;
+        }
+        function PersistentStorage(namespace) {
+            this.prefix = [ "__", namespace, "__" ].join("");
+            this.ttlKey = "__ttl__";
+            this.keyMatcher = new RegExp("^" + this.prefix);
+        }
+        if (ls && window.JSON) {
+            methods = {
+                _prefix: function(key) {
+                    return this.prefix + key;
+                },
+                _ttlKey: function(key) {
+                    return this._prefix(key) + this.ttlKey;
+                },
+                get: function(key) {
+                    if (this.isExpired(key)) {
+                        this.remove(key);
+                    }
+                    return decode(ls.getItem(this._prefix(key)));
+                },
+                set: function(key, val, ttl) {
+                    if (utils.isNumber(ttl)) {
+                        ls.setItem(this._ttlKey(key), encode(now() + ttl));
+                    } else {
+                        ls.removeItem(this._ttlKey(key));
+                    }
+                    return ls.setItem(this._prefix(key), encode(val));
+                },
+                remove: function(key) {
+                    ls.removeItem(this._ttlKey(key));
+                    ls.removeItem(this._prefix(key));
+                    return this;
+                },
+                clear: function() {
+                    var i, key, keys = [], len = ls.length;
+                    for (i = 0; i < len; i++) {
+                        if ((key = ls.key(i)).match(this.keyMatcher)) {
+                            keys.push(key.replace(this.keyMatcher, ""));
+                        }
+                    }
+                    for (i = keys.length; i--; ) {
+                        this.remove(keys[i]);
+                    }
+                    return this;
+                },
+                isExpired: function(key) {
+                    var ttl = decode(ls.getItem(this._ttlKey(key)));
+                    return utils.isNumber(ttl) && now() > ttl ? true : false;
+                }
+            };
+        } else {
+            methods = {
+                get: utils.noop,
+                set: utils.noop,
+                remove: utils.noop,
+                clear: utils.noop,
+                isExpired: utils.noop
+            };
+        }
+        utils.mixin(PersistentStorage.prototype, methods);
+        return PersistentStorage;
+        function now() {
+            return new Date().getTime();
+        }
+        function encode(val) {
+            return JSON.stringify(utils.isUndefined(val) ? null : val);
+        }
+        function decode(val) {
+            return JSON.parse(val);
+        }
+    }();
+    var RequestCache = function() {
+        function RequestCache(o) {
+            utils.bindAll(this);
+            o = o || {};
+            this.sizeLimit = o.sizeLimit || 10;
+            this.cache = {};
+            this.cachedKeysByAge = [];
+        }
+        utils.mixin(RequestCache.prototype, {
+            get: function(url) {
+                return this.cache[url];
+            },
+            set: function(url, resp) {
+                var requestToEvict;
+                if (this.cachedKeysByAge.length === this.sizeLimit) {
+                    requestToEvict = this.cachedKeysByAge.shift();
+                    delete this.cache[requestToEvict];
+                }
+                this.cache[url] = resp;
+                this.cachedKeysByAge.push(url);
+            }
+        });
+        return RequestCache;
+    }();
+    var Transport = function() {
+        var pendingRequestsCount = 0, pendingRequests = {}, maxPendingRequests, requestCache;
+        function Transport(o) {
+            utils.bindAll(this);
+            o = utils.isString(o) ? {
+                url: o
+            } : o;
+            requestCache = requestCache || new RequestCache();
+            maxPendingRequests = utils.isNumber(o.maxParallelRequests) ? o.maxParallelRequests : maxPendingRequests || 6;
+            this.url = o.url;
+            this.wildcard = o.wildcard || "%QUERY";
+            this.filter = o.filter;
+            this.replace = o.replace;
+            this.ajaxSettings = {
+                type: "get",
+                cache: o.cache,
+                timeout: o.timeout,
+                dataType: o.dataType || "json",
+                beforeSend: o.beforeSend
+            };
+            this._get = (/^throttle$/i.test(o.rateLimitFn) ? utils.throttle : utils.debounce)(this._get, o.rateLimitWait || 300);
+        }
+        utils.mixin(Transport.prototype, {
+            _get: function(url, cb) {
+                var that = this;
+                if (belowPendingRequestsThreshold()) {
+                    this._sendRequest(url).done(done);
+                } else {
+                    this.onDeckRequestArgs = [].slice.call(arguments, 0);
+                }
+                function done(resp) {
+                    var data = that.filter ? that.filter(resp) : resp;
+                    cb && cb(data);
+                    requestCache.set(url, resp);
+                }
+            },
+            _sendRequest: function(url) {
+                var that = this, jqXhr = pendingRequests[url];
+                if (!jqXhr) {
+                    incrementPendingRequests();
+                    jqXhr = pendingRequests[url] = $.ajax(url, this.ajaxSettings).always(always);
+                }
+                return jqXhr;
+                function always() {
+                    decrementPendingRequests();
+                    pendingRequests[url] = null;
+                    if (that.onDeckRequestArgs) {
+                        that._get.apply(that, that.onDeckRequestArgs);
+                        that.onDeckRequestArgs = null;
+                    }
+                }
+            },
+            get: function(query, cb) {
+                var that = this, encodedQuery = encodeURIComponent(query || ""), url, resp;
+                cb = cb || utils.noop;
+                url = this.replace ? this.replace(this.url, encodedQuery) : this.url.replace(this.wildcard, encodedQuery);
+                if (resp = requestCache.get(url)) {
+                    utils.defer(function() {
+                        cb(that.filter ? that.filter(resp) : resp);
+                    });
+                } else {
+                    this._get(url, cb);
+                }
+                return !!resp;
+            }
+        });
+        return Transport;
+        function incrementPendingRequests() {
+            pendingRequestsCount++;
+        }
+        function decrementPendingRequests() {
+            pendingRequestsCount--;
+        }
+        function belowPendingRequestsThreshold() {
+            return pendingRequestsCount < maxPendingRequests;
+        }
+    }();
+    var Dataset = function() {
+        var keys = {
+            thumbprint: "thumbprint",
+            protocol: "protocol",
+            itemHash: "itemHash",
+            adjacencyList: "adjacencyList"
+        };
+        function Dataset(o) {
+            utils.bindAll(this);
+            if (utils.isString(o.template) && !o.engine) {
+                $.error("no template engine specified");
+            }
+            if (!o.local && !o.prefetch && !o.remote) {
+                $.error("one of local, prefetch, or remote is required");
+            }
+            this.name = o.name || utils.getUniqueId();
+            this.limit = o.limit || 5;
+            this.minLength = o.minLength || 1;
+            this.header = o.header;
+            this.footer = o.footer;
+            this.valueKey = o.valueKey || "value";
+            this.template = compileTemplate(o.template, o.engine, this.valueKey);
+            this.local = o.local;
+            this.prefetch = o.prefetch;
+            this.remote = o.remote;
+            this.itemHash = {};
+            this.adjacencyList = {};
+            this.storage = o.name ? new PersistentStorage(o.name) : null;
+        }
+        utils.mixin(Dataset.prototype, {
+            _processLocalData: function(data) {
+                this._mergeProcessedData(this._processData(data));
+            },
+            _loadPrefetchData: function(o) {
+                var that = this, thumbprint = VERSION + (o.thumbprint || ""), storedThumbprint, storedProtocol, storedItemHash, storedAdjacencyList, isExpired, deferred;
+                if (this.storage) {
+                    storedThumbprint = this.storage.get(keys.thumbprint);
+                    storedProtocol = this.storage.get(keys.protocol);
+                    storedItemHash = this.storage.get(keys.itemHash);
+                    storedAdjacencyList = this.storage.get(keys.adjacencyList);
+                }
+                isExpired = storedThumbprint !== thumbprint || storedProtocol !== utils.getProtocol();
+                o = utils.isString(o) ? {
+                    url: o
+                } : o;
+                o.ttl = utils.isNumber(o.ttl) ? o.ttl : 24 * 60 * 60 * 1e3;
+                if (storedItemHash && storedAdjacencyList && !isExpired) {
+                    this._mergeProcessedData({
+                        itemHash: storedItemHash,
+                        adjacencyList: storedAdjacencyList
+                    });
+                    deferred = $.Deferred().resolve();
+                } else {
+                    deferred = $.getJSON(o.url).done(processPrefetchData);
+                }
+                return deferred;
+                function processPrefetchData(data) {
+                    var filteredData = o.filter ? o.filter(data) : data, processedData = that._processData(filteredData), itemHash = processedData.itemHash, adjacencyList = processedData.adjacencyList;
+                    if (that.storage) {
+                        that.storage.set(keys.itemHash, itemHash, o.ttl);
+                        that.storage.set(keys.adjacencyList, adjacencyList, o.ttl);
+                        that.storage.set(keys.thumbprint, thumbprint, o.ttl);
+                        that.storage.set(keys.protocol, utils.getProtocol(), o.ttl);
+                    }
+                    that._mergeProcessedData(processedData);
+                }
+            },
+            _transformDatum: function(datum) {
+                var value = utils.isString(datum) ? datum : datum[this.valueKey], tokens = datum.tokens || utils.tokenizeText(value), item = {
+                    value: value,
+                    tokens: tokens
+                };
+                if (utils.isString(datum)) {
+                    item.datum = {};
+                    item.datum[this.valueKey] = datum;
+                } else {
+                    item.datum = datum;
+                }
+                item.tokens = utils.filter(item.tokens, function(token) {
+                    return !utils.isBlankString(token);
+                });
+                item.tokens = utils.map(item.tokens, function(token) {
+                    return token.toLowerCase();
+                });
+                return item;
+            },
+            _processData: function(data) {
+                var that = this, itemHash = {}, adjacencyList = {};
+                utils.each(data, function(i, datum) {
+                    var item = that._transformDatum(datum), id = utils.getUniqueId(item.value);
+                    itemHash[id] = item;
+                    utils.each(item.tokens, function(i, token) {
+                        var character = token.charAt(0), adjacency = adjacencyList[character] || (adjacencyList[character] = [ id ]);
+                        !~utils.indexOf(adjacency, id) && adjacency.push(id);
+                    });
+                });
+                return {
+                    itemHash: itemHash,
+                    adjacencyList: adjacencyList
+                };
+            },
+            _mergeProcessedData: function(processedData) {
+                var that = this;
+                utils.mixin(this.itemHash, processedData.itemHash);
+                utils.each(processedData.adjacencyList, function(character, adjacency) {
+                    var masterAdjacency = that.adjacencyList[character];
+                    that.adjacencyList[character] = masterAdjacency ? masterAdjacency.concat(adjacency) : adjacency;
+                });
+            },
+            _getLocalSuggestions: function(terms) {
+                var that = this, firstChars = [], lists = [], shortestList, suggestions = [];
+                utils.each(terms, function(i, term) {
+                    var firstChar = term.charAt(0);
+                    !~utils.indexOf(firstChars, firstChar) && firstChars.push(firstChar);
+                });
+                utils.each(firstChars, function(i, firstChar) {
+                    var list = that.adjacencyList[firstChar];
+                    if (!list) {
+                        return false;
+                    }
+                    lists.push(list);
+                    if (!shortestList || list.length < shortestList.length) {
+                        shortestList = list;
+                    }
+                });
+                if (lists.length < firstChars.length) {
+                    return [];
+                }
+                utils.each(shortestList, function(i, id) {
+                    var item = that.itemHash[id], isCandidate, isMatch;
+                    isCandidate = utils.every(lists, function(list) {
+                        return ~utils.indexOf(list, id);
+                    });
+                    isMatch = isCandidate && utils.every(terms, function(term) {
+                        return utils.some(item.tokens, function(token) {
+                            return token.indexOf(term) === 0;
+                        });
+                    });
+                    isMatch && suggestions.push(item);
+                });
+                return suggestions;
+            },
+            initialize: function() {
+                var deferred;
+                this.local && this._processLocalData(this.local);
+                this.transport = this.remote ? new Transport(this.remote) : null;
+                deferred = this.prefetch ? this._loadPrefetchData(this.prefetch) : $.Deferred().resolve();
+                this.local = this.prefetch = this.remote = null;
+                this.initialize = function() {
+                    return deferred;
+                };
+                return deferred;
+            },
+            getSuggestions: function(query, cb) {
+                var that = this, terms, suggestions, cacheHit = false;
+                if (query.length < this.minLength) {
+                    return;
+                }
+                terms = utils.tokenizeQuery(query);
+                suggestions = this._getLocalSuggestions(terms).slice(0, this.limit);
+                if (suggestions.length < this.limit && this.transport) {
+                    cacheHit = this.transport.get(query, processRemoteData);
+                }
+                !cacheHit && cb && cb(suggestions);
+                function processRemoteData(data) {
+                    suggestions = suggestions.slice(0);
+                    utils.each(data, function(i, datum) {
+                        var item = that._transformDatum(datum), isDuplicate;
+                        isDuplicate = utils.some(suggestions, function(suggestion) {
+                            return item.value === suggestion.value;
+                        });
+                        !isDuplicate && suggestions.push(item);
+                        return suggestions.length < that.limit;
+                    });
+                    cb && cb(suggestions);
+                }
+            }
+        });
+        return Dataset;
+        function compileTemplate(template, engine, valueKey) {
+            var renderFn, compiledTemplate;
+            if (utils.isFunction(template)) {
+                renderFn = template;
+            } else if (utils.isString(template)) {
+                compiledTemplate = engine.compile(template);
+                renderFn = utils.bind(compiledTemplate.render, compiledTemplate);
+            } else {
+                renderFn = function(context) {
+                    return "<p>" + context[valueKey] + "</p>";
+                };
+            }
+            return renderFn;
+        }
+    }();
+    var InputView = function() {
+        function InputView(o) {
+            var that = this;
+            utils.bindAll(this);
+            this.specialKeyCodeMap = {
+                9: "tab",
+                27: "esc",
+                37: "left",
+                39: "right",
+                13: "enter",
+                38: "up",
+                40: "down"
+            };
+            this.$hint = $(o.hint);
+            this.$input = $(o.input).on("blur.tt", this._handleBlur).on("focus.tt", this._handleFocus).on("keydown.tt", this._handleSpecialKeyEvent);
+            if (!utils.isMsie()) {
+                this.$input.on("input.tt", this._compareQueryToInputValue);
+            } else {
+                this.$input.on("keydown.tt keypress.tt cut.tt paste.tt", function($e) {
+                    if (that.specialKeyCodeMap[$e.which || $e.keyCode]) {
+                        return;
+                    }
+                    utils.defer(that._compareQueryToInputValue);
+                });
+            }
+            this.query = this.$input.val();
+            this.$overflowHelper = buildOverflowHelper(this.$input);
+        }
+        utils.mixin(InputView.prototype, EventTarget, {
+            _handleFocus: function() {
+                this.trigger("focused");
+            },
+            _handleBlur: function() {
+                this.trigger("blured");
+            },
+            _handleSpecialKeyEvent: function($e) {
+                var keyName = this.specialKeyCodeMap[$e.which || $e.keyCode];
+                keyName && this.trigger(keyName + "Keyed", $e);
+            },
+            _compareQueryToInputValue: function() {
+                var inputValue = this.getInputValue(), isSameQuery = compareQueries(this.query, inputValue), isSameQueryExceptWhitespace = isSameQuery ? this.query.length !== inputValue.length : false;
+                if (isSameQueryExceptWhitespace) {
+                    this.trigger("whitespaceChanged", {
+                        value: this.query
+                    });
+                } else if (!isSameQuery) {
+                    this.trigger("queryChanged", {
+                        value: this.query = inputValue
+                    });
+                }
+            },
+            destroy: function() {
+                this.$hint.off(".tt");
+                this.$input.off(".tt");
+                this.$hint = this.$input = this.$overflowHelper = null;
+            },
+            focus: function() {
+                this.$input.focus();
+            },
+            blur: function() {
+                this.$input.blur();
+            },
+            getQuery: function() {
+                return this.query;
+            },
+            setQuery: function(query) {
+                this.query = query;
+            },
+            getInputValue: function() {
+                return this.$input.val();
+            },
+            setInputValue: function(value, silent) {
+                this.$input.val(value);
+                !silent && this._compareQueryToInputValue();
+            },
+            getHintValue: function() {
+                return this.$hint.val();
+            },
+            setHintValue: function(value) {
+                this.$hint.val(value);
+            },
+            getLanguageDirection: function() {
+                return (this.$input.css("direction") || "ltr").toLowerCase();
+            },
+            isOverflow: function() {
+                this.$overflowHelper.text(this.getInputValue());
+                return this.$overflowHelper.width() > this.$input.width();
+            },
+            isCursorAtEnd: function() {
+                var valueLength = this.$input.val().length, selectionStart = this.$input[0].selectionStart, range;
+                if (utils.isNumber(selectionStart)) {
+                    return selectionStart === valueLength;
+                } else if (document.selection) {
+                    range = document.selection.createRange();
+                    range.moveStart("character", -valueLength);
+                    return valueLength === range.text.length;
+                }
+                return true;
+            }
+        });
+        return InputView;
+        function buildOverflowHelper($input) {
+            return $("<span></span>").css({
+                position: "absolute",
+                left: "-9999px",
+                visibility: "hidden",
+                whiteSpace: "nowrap",
+                fontFamily: $input.css("font-family"),
+                fontSize: $input.css("font-size"),
+                fontStyle: $input.css("font-style"),
+                fontVariant: $input.css("font-variant"),
+                fontWeight: $input.css("font-weight"),
+                wordSpacing: $input.css("word-spacing"),
+                letterSpacing: $input.css("letter-spacing"),
+                textIndent: $input.css("text-indent"),
+                textRendering: $input.css("text-rendering"),
+                textTransform: $input.css("text-transform")
+            }).insertAfter($input);
+        }
+        function compareQueries(a, b) {
+            a = (a || "").replace(/^\s*/g, "").replace(/\s{2,}/g, " ");
+            b = (b || "").replace(/^\s*/g, "").replace(/\s{2,}/g, " ");
+            return a === b;
+        }
+    }();
+    var DropdownView = function() {
+        var html = {
+            suggestionsList: '<span class="tt-suggestions"></span>'
+        }, css = {
+            suggestionsList: {
+                display: "block"
+            },
+            suggestion: {
+                whiteSpace: "nowrap",
+                cursor: "pointer"
+            },
+            suggestionChild: {
+                whiteSpace: "normal"
+            }
+        };
+        function DropdownView(o) {
+            utils.bindAll(this);
+            this.isOpen = false;
+            this.isEmpty = true;
+            this.isMouseOverDropdown = false;
+            this.$menu = $(o.menu).on("mouseenter.tt", this._handleMouseenter).on("mouseleave.tt", this._handleMouseleave).on("click.tt", ".tt-suggestion", this._handleSelection).on("mouseover.tt", ".tt-suggestion", this._handleMouseover);
+        }
+        utils.mixin(DropdownView.prototype, EventTarget, {
+            _handleMouseenter: function() {
+                this.isMouseOverDropdown = true;
+            },
+            _handleMouseleave: function() {
+                this.isMouseOverDropdown = false;
+            },
+            _handleMouseover: function($e) {
+                var $suggestion = $($e.currentTarget);
+                this._getSuggestions().removeClass("tt-is-under-cursor");
+                $suggestion.addClass("tt-is-under-cursor");
+            },
+            _handleSelection: function($e) {
+                var $suggestion = $($e.currentTarget);
+                this.trigger("suggestionSelected", extractSuggestion($suggestion));
+            },
+            _show: function() {
+                this.$menu.css("display", "block");
+            },
+            _hide: function() {
+                this.$menu.hide();
+            },
+            _moveCursor: function(increment) {
+                var $suggestions, $cur, nextIndex, $underCursor;
+                if (!this.isVisible()) {
+                    return;
+                }
+                $suggestions = this._getSuggestions();
+                $cur = $suggestions.filter(".tt-is-under-cursor");
+                $cur.removeClass("tt-is-under-cursor");
+                nextIndex = $suggestions.index($cur) + increment;
+                nextIndex = (nextIndex + 1) % ($suggestions.length + 1) - 1;
+                if (nextIndex === -1) {
+                    this.trigger("cursorRemoved");
+                    return;
+                } else if (nextIndex < -1) {
+                    nextIndex = $suggestions.length - 1;
+                }
+                $underCursor = $suggestions.eq(nextIndex).addClass("tt-is-under-cursor");
+                this._ensureVisibility($underCursor);
+                this.trigger("cursorMoved", extractSuggestion($underCursor));
+            },
+            _getSuggestions: function() {
+                return this.$menu.find(".tt-suggestions > .tt-suggestion");
+            },
+            _ensureVisibility: function($el) {
+                var menuHeight = this.$menu.height() + parseInt(this.$menu.css("paddingTop"), 10) + parseInt(this.$menu.css("paddingBottom"), 10), menuScrollTop = this.$menu.scrollTop(), elTop = $el.position().top, elBottom = elTop + $el.outerHeight(true);
+                if (elTop < 0) {
+                    this.$menu.scrollTop(menuScrollTop + elTop);
+                } else if (menuHeight < elBottom) {
+                    this.$menu.scrollTop(menuScrollTop + (elBottom - menuHeight));
+                }
+            },
+            destroy: function() {
+                this.$menu.off(".tt");
+                this.$menu = null;
+            },
+            isVisible: function() {
+                return this.isOpen && !this.isEmpty;
+            },
+            closeUnlessMouseIsOverDropdown: function() {
+                if (!this.isMouseOverDropdown) {
+                    this.close();
+                }
+            },
+            close: function() {
+                if (this.isOpen) {
+                    this.isOpen = false;
+                    this.isMouseOverDropdown = false;
+                    this._hide();
+                    this.$menu.find(".tt-suggestions > .tt-suggestion").removeClass("tt-is-under-cursor");
+                    this.trigger("closed");
+                }
+            },
+            open: function() {
+                if (!this.isOpen) {
+                    this.isOpen = true;
+                    !this.isEmpty && this._show();
+                    this.trigger("opened");
+                }
+            },
+            setLanguageDirection: function(dir) {
+                var ltrCss = {
+                    left: "0",
+                    right: "auto"
+                }, rtlCss = {
+                    left: "auto",
+                    right: " 0"
+                };
+                dir === "ltr" ? this.$menu.css(ltrCss) : this.$menu.css(rtlCss);
+            },
+            moveCursorUp: function() {
+                this._moveCursor(-1);
+            },
+            moveCursorDown: function() {
+                this._moveCursor(+1);
+            },
+            getSuggestionUnderCursor: function() {
+                var $suggestion = this._getSuggestions().filter(".tt-is-under-cursor").first();
+                return $suggestion.length > 0 ? extractSuggestion($suggestion) : null;
+            },
+            getFirstSuggestion: function() {
+                var $suggestion = this._getSuggestions().first();
+                return $suggestion.length > 0 ? extractSuggestion($suggestion) : null;
+            },
+            renderSuggestions: function(dataset, suggestions) {
+                var datasetClassName = "tt-dataset-" + dataset.name, wrapper = '<div class="tt-suggestion">%body</div>', compiledHtml, $suggestionsList, $dataset = this.$menu.find("." + datasetClassName), elBuilder, fragment, $el;
+                if ($dataset.length === 0) {
+                    $suggestionsList = $(html.suggestionsList).css(css.suggestionsList);
+                    $dataset = $("<div></div>").addClass(datasetClassName).append(dataset.header).append($suggestionsList).append(dataset.footer).appendTo(this.$menu);
+                }
+                if (suggestions.length > 0) {
+                    this.isEmpty = false;
+                    this.isOpen && this._show();
+                    elBuilder = document.createElement("div");
+                    fragment = document.createDocumentFragment();
+                    utils.each(suggestions, function(i, suggestion) {
+                        suggestion.dataset = dataset.name;
+                        compiledHtml = dataset.template(suggestion.datum);
+                        elBuilder.innerHTML = wrapper.replace("%body", compiledHtml);
+                        $el = $(elBuilder.firstChild).css(css.suggestion).data("suggestion", suggestion);
+                        $el.children().each(function() {
+                            $(this).css(css.suggestionChild);
+                        });
+                        fragment.appendChild($el[0]);
+                    });
+                    $dataset.show().find(".tt-suggestions").html(fragment);
+                } else {
+                    this.clearSuggestions(dataset.name);
+                }
+                this.trigger("suggestionsRendered");
+            },
+            clearSuggestions: function(datasetName) {
+                var $datasets = datasetName ? this.$menu.find(".tt-dataset-" + datasetName) : this.$menu.find('[class^="tt-dataset-"]'), $suggestions = $datasets.find(".tt-suggestions");
+                $datasets.hide();
+                $suggestions.empty();
+                if (this._getSuggestions().length === 0) {
+                    this.isEmpty = true;
+                    this._hide();
+                }
+            }
+        });
+        return DropdownView;
+        function extractSuggestion($el) {
+            return $el.data("suggestion");
+        }
+    }();
+    var TypeaheadView = function() {
+        var html = {
+            wrapper: '<span class="twitter-typeahead"></span>',
+            hint: '<input class="tt-hint" type="text" autocomplete="off" spellcheck="off" disabled>',
+            dropdown: '<span class="tt-dropdown-menu"></span>'
+        }, css = {
+            wrapper: {
+                position: "relative",
+                display: "inline-block"
+            },
+            hint: {
+                position: "absolute",
+                top: "0",
+                left: "0",
+                borderColor: "transparent",
+                boxShadow: "none"
+            },
+            query: {
+                position: "relative",
+                verticalAlign: "top",
+                backgroundColor: "transparent"
+            },
+            dropdown: {
+                position: "absolute",
+                top: "100%",
+                left: "0",
+                zIndex: "100",
+                display: "none"
+            }
+        };
+        if (utils.isMsie()) {
+            utils.mixin(css.query, {
+                backgroundImage: "url(data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)"
+            });
+        }
+        if (utils.isMsie() && utils.isMsie() <= 7) {
+            utils.mixin(css.wrapper, {
+                display: "inline",
+                zoom: "1"
+            });
+            utils.mixin(css.query, {
+                marginTop: "-1px"
+            });
+        }
+        function TypeaheadView(o) {
+            var $menu, $input, $hint;
+            utils.bindAll(this);
+            this.$node = buildDomStructure(o.input);
+            this.datasets = o.datasets;
+            this.dir = null;
+            this.eventBus = o.eventBus;
+            $menu = this.$node.find(".tt-dropdown-menu");
+            $input = this.$node.find(".tt-query");
+            $hint = this.$node.find(".tt-hint");
+            this.dropdownView = new DropdownView({
+                menu: $menu
+            }).on("suggestionSelected", this._handleSelection).on("cursorMoved", this._clearHint).on("cursorMoved", this._setInputValueToSuggestionUnderCursor).on("cursorRemoved", this._setInputValueToQuery).on("cursorRemoved", this._updateHint).on("suggestionsRendered", this._updateHint).on("opened", this._updateHint).on("closed", this._clearHint).on("opened closed", this._propagateEvent);
+            this.inputView = new InputView({
+                input: $input,
+                hint: $hint
+            }).on("focused", this._openDropdown).on("blured", this._closeDropdown).on("blured", this._setInputValueToQuery).on("enterKeyed tabKeyed", this._handleSelection).on("queryChanged", this._clearHint).on("queryChanged", this._clearSuggestions).on("queryChanged", this._getSuggestions).on("whitespaceChanged", this._updateHint).on("queryChanged whitespaceChanged", this._openDropdown).on("queryChanged whitespaceChanged", this._setLanguageDirection).on("escKeyed", this._closeDropdown).on("escKeyed", this._setInputValueToQuery).on("tabKeyed upKeyed downKeyed", this._managePreventDefault).on("upKeyed downKeyed", this._moveDropdownCursor).on("upKeyed downKeyed", this._openDropdown).on("tabKeyed leftKeyed rightKeyed", this._autocomplete);
+        }
+        utils.mixin(TypeaheadView.prototype, EventTarget, {
+            _managePreventDefault: function(e) {
+                var $e = e.data, hint, inputValue, preventDefault = false;
+                switch (e.type) {
+                  case "tabKeyed":
+                    hint = this.inputView.getHintValue();
+                    inputValue = this.inputView.getInputValue();
+                    preventDefault = hint && hint !== inputValue;
+                    break;
+
+                  case "upKeyed":
+                  case "downKeyed":
+                    preventDefault = !$e.shiftKey && !$e.ctrlKey && !$e.metaKey;
+                    break;
+                }
+                preventDefault && $e.preventDefault();
+            },
+            _setLanguageDirection: function() {
+                var dir = this.inputView.getLanguageDirection();
+                if (dir !== this.dir) {
+                    this.dir = dir;
+                    this.$node.css("direction", dir);
+                    this.dropdownView.setLanguageDirection(dir);
+                }
+            },
+            _updateHint: function() {
+                var suggestion = this.dropdownView.getFirstSuggestion(), hint = suggestion ? suggestion.value : null, dropdownIsVisible = this.dropdownView.isVisible(), inputHasOverflow = this.inputView.isOverflow(), inputValue, query, escapedQuery, beginsWithQuery, match;
+                if (hint && dropdownIsVisible && !inputHasOverflow) {
+                    inputValue = this.inputView.getInputValue();
+                    query = inputValue.replace(/\s{2,}/g, " ").replace(/^\s+/g, "");
+                    escapedQuery = utils.escapeRegExChars(query);
+                    beginsWithQuery = new RegExp("^(?:" + escapedQuery + ")(.*$)", "i");
+                    match = beginsWithQuery.exec(hint);
+                    this.inputView.setHintValue(inputValue + (match ? match[1] : ""));
+                }
+            },
+            _clearHint: function() {
+                this.inputView.setHintValue("");
+            },
+            _clearSuggestions: function() {
+                this.dropdownView.clearSuggestions();
+            },
+            _setInputValueToQuery: function() {
+                this.inputView.setInputValue(this.inputView.getQuery());
+            },
+            _setInputValueToSuggestionUnderCursor: function(e) {
+                var suggestion = e.data;
+                this.inputView.setInputValue(suggestion.value, true);
+            },
+            _openDropdown: function() {
+                this.dropdownView.open();
+            },
+            _closeDropdown: function(e) {
+                this.dropdownView[e.type === "blured" ? "closeUnlessMouseIsOverDropdown" : "close"]();
+            },
+            _moveDropdownCursor: function(e) {
+                var $e = e.data;
+                if (!$e.shiftKey && !$e.ctrlKey && !$e.metaKey) {
+                    this.dropdownView[e.type === "upKeyed" ? "moveCursorUp" : "moveCursorDown"]();
+                }
+            },
+            _handleSelection: function(e) {
+                var byClick = e.type === "suggestionSelected", suggestion = byClick ? e.data : this.dropdownView.getSuggestionUnderCursor();
+                if (suggestion) {
+                    this.inputView.setInputValue(suggestion.value);
+                    byClick ? this.inputView.focus() : e.data.preventDefault();
+                    byClick && utils.isMsie() ? utils.defer(this.dropdownView.close) : this.dropdownView.close();
+                    this.eventBus.trigger("selected", suggestion.datum, suggestion.dataset);
+                }
+            },
+            _getSuggestions: function() {
+                var that = this, query = this.inputView.getQuery();
+                if (utils.isBlankString(query)) {
+                    return;
+                }
+                utils.each(this.datasets, function(i, dataset) {
+                    dataset.getSuggestions(query, function(suggestions) {
+                        if (query === that.inputView.getQuery()) {
+                            that.dropdownView.renderSuggestions(dataset, suggestions);
+                        }
+                    });
+                });
+            },
+            _autocomplete: function(e) {
+                var isCursorAtEnd, ignoreEvent, query, hint, suggestion;
+                if (e.type === "rightKeyed" || e.type === "leftKeyed") {
+                    isCursorAtEnd = this.inputView.isCursorAtEnd();
+                    ignoreEvent = this.inputView.getLanguageDirection() === "ltr" ? e.type === "leftKeyed" : e.type === "rightKeyed";
+                    if (!isCursorAtEnd || ignoreEvent) {
+                        return;
+                    }
+                }
+                query = this.inputView.getQuery();
+                hint = this.inputView.getHintValue();
+                if (hint !== "" && query !== hint) {
+                    suggestion = this.dropdownView.getFirstSuggestion();
+                    this.inputView.setInputValue(suggestion.value);
+                    this.eventBus.trigger("autocompleted", suggestion.datum, suggestion.dataset);
+                }
+            },
+            _propagateEvent: function(e) {
+                this.eventBus.trigger(e.type);
+            },
+            destroy: function() {
+                this.inputView.destroy();
+                this.dropdownView.destroy();
+                destroyDomStructure(this.$node);
+                this.$node = null;
+            },
+            setQuery: function(query) {
+                this.inputView.setQuery(query);
+                this.inputView.setInputValue(query);
+                this._clearHint();
+                this._clearSuggestions();
+                this._getSuggestions();
+            }
+        });
+        return TypeaheadView;
+        function buildDomStructure(input) {
+            var $wrapper = $(html.wrapper), $dropdown = $(html.dropdown), $input = $(input), $hint = $(html.hint);
+            $wrapper = $wrapper.css(css.wrapper);
+            $dropdown = $dropdown.css(css.dropdown);
+            $hint.css(css.hint).css({
+                backgroundAttachment: $input.css("background-attachment"),
+                backgroundClip: $input.css("background-clip"),
+                backgroundColor: $input.css("background-color"),
+                backgroundImage: $input.css("background-image"),
+                backgroundOrigin: $input.css("background-origin"),
+                backgroundPosition: $input.css("background-position"),
+                backgroundRepeat: $input.css("background-repeat"),
+                backgroundSize: $input.css("background-size")
+            });
+            $input.data("ttAttrs", {
+                dir: $input.attr("dir"),
+                autocomplete: $input.attr("autocomplete"),
+                spellcheck: $input.attr("spellcheck"),
+                style: $input.attr("style")
+            });
+            $input.addClass("tt-query").attr({
+                autocomplete: "off",
+                spellcheck: false
+            }).css(css.query);
+            try {
+                !$input.attr("dir") && $input.attr("dir", "auto");
+            } catch (e) {}
+            return $input.wrap($wrapper).parent().prepend($hint).append($dropdown);
+        }
+        function destroyDomStructure($node) {
+            var $input = $node.find(".tt-query");
+            utils.each($input.data("ttAttrs"), function(key, val) {
+                utils.isUndefined(val) ? $input.removeAttr(key) : $input.attr(key, val);
+            });
+            $input.detach().removeData("ttAttrs").removeClass("tt-query").insertAfter($node);
+            $node.remove();
+        }
+    }();
+    (function() {
+        var cache = {}, viewKey = "ttView", methods;
+        methods = {
+            initialize: function(datasetDefs) {
+                var datasets;
+                datasetDefs = utils.isArray(datasetDefs) ? datasetDefs : [ datasetDefs ];
+                if (datasetDefs.length === 0) {
+                    $.error("no datasets provided");
+                }
+                datasets = utils.map(datasetDefs, function(o) {
+                    var dataset = cache[o.name] ? cache[o.name] : new Dataset(o);
+                    if (o.name) {
+                        cache[o.name] = dataset;
+                    }
+                    return dataset;
+                });
+                return this.each(initialize);
+                function initialize() {
+                    var $input = $(this), deferreds, eventBus = new EventBus({
+                        el: $input
+                    });
+                    deferreds = utils.map(datasets, function(dataset) {
+                        return dataset.initialize();
+                    });
+                    $input.data(viewKey, new TypeaheadView({
+                        input: $input,
+                        eventBus: eventBus = new EventBus({
+                            el: $input
+                        }),
+                        datasets: datasets
+                    }));
+                    $.when.apply($, deferreds).always(function() {
+                        utils.defer(function() {
+                            eventBus.trigger("initialized");
+                        });
+                    });
+                }
+            },
+            destroy: function() {
+                return this.each(destroy);
+                function destroy() {
+                    var $this = $(this), view = $this.data(viewKey);
+                    if (view) {
+                        view.destroy();
+                        $this.removeData(viewKey);
+                    }
+                }
+            },
+            setQuery: function(query) {
+                return this.each(setQuery);
+                function setQuery() {
+                    var view = $(this).data(viewKey);
+                    view && view.setQuery(query);
+                }
+            }
+        };
+        jQuery.fn.typeahead = function(method) {
+            if (methods[method]) {
+                return methods[method].apply(this, [].slice.call(arguments, 1));
+            } else {
+                return methods.initialize.apply(this, arguments);
+            }
+        };
+    })();
+})(window.jQuery);
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc/fancy/lib/typeahead.min.js acl2-6.3/books/xdoc/fancy/lib/typeahead.min.js
--- acl2-6.2/books/xdoc/fancy/lib/typeahead.min.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/lib/typeahead.min.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,7 @@
+/*!
+ * typeahead.js 0.9.3
+ * https://github.com/twitter/typeahead
+ * Copyright 2013 Twitter, Inc. and other contributors; Licensed MIT
+ */
+
+!function(a){var b="0.9.3",c={isMsie:function(){var a=/(msie) ([\w.]+)/i.exec(navigator.userAgent);return a?parseInt(a[2],10):!1},isBlankString:function(a){return!a||/^\s*$/.test(a)},escapeRegExChars:function(a){return a.replace(/[\-\[\]\/\{\}\(\)\*\+\?\.\\\^\$\|]/g,"\\$&")},isString:function(a){return"string"==typeof a},isNumber:function(a){return"number"==typeof a},isArray:a.isArray,isFunction:a.isFunction,isObject:a.isPlainObject,isUndefined:function(a){return"undefined"==typeof a},bind:a.proxy,bindAll:function(b){var c;for(var d in b)a.isFunction(c=b[d])&&(b[d]=a.proxy(c,b))},indexOf:function(a,b){for(var c=0;c<a.length;c++)if(a[c]===b)return c;return-1},each:a.each,map:a.map,filter:a.grep,every:function(b,c){var d=!0;return b?(a.each(b,function(a,e){return(d=c.call(null,e,a,b))?void 0:!1}),!!d):d},some:function(b,c){var d=!1;return b?(a.each(b,function(a,e){return(d=c.call(null,e,a,b))?!1:void 0}),!!d):d},mixin:a.extend,getUniqueId:function(){var a=0;return function(){return a++}}(),defer:function(a){setTimeout(a,0)},debounce:function(a,b,c){var d,e;return function(){var f,g,h=this,i=arguments;return f=function(){d=null,c||(e=a.apply(h,i))},g=c&&!d,clearTimeout(d),d=setTimeout(f,b),g&&(e=a.apply(h,i)),e}},throttle:function(a,b){var c,d,e,f,g,h;return g=0,h=function(){g=new Date,e=null,f=a.apply(c,d)},function(){var i=new Date,j=b-(i-g);return c=this,d=arguments,0>=j?(clearTimeout(e),e=null,g=i,f=a.apply(c,d)):e||(e=setTimeout(h,j)),f}},tokenizeQuery:function(b){return a.trim(b).toLowerCase().split(/[\s]+/)},tokenizeText:function(b){return a.trim(b).toLowerCase().split(/[\s\-_]+/)},getProtocol:function(){return location.protocol},noop:function(){}},d=function(){var a=/\s+/;return{on:function(b,c){var d;if(!c)return this;for(this._callbacks=this._callbacks||{},b=b.split(a);d=b.shift();)this._callbacks[d]=this._callbacks[d]||[],this._callbacks[d].push(c);return this},trigger:function(b,c){var d,e;if(!this._callbacks)return this;for(b=b.split(a);d=b.shift();)if(e=this._callbacks[d])for(var f=0;f<e.length;f+=1)e[f].call(this,{type:d,data:c});return this}}}(),e=function(){function b(b){b&&b.el||a.error("EventBus initialized without el"),this.$el=a(b.el)}var d="typeahead:";return c.mixin(b.prototype,{trigger:function(a){var b=[].slice.call(arguments,1);this.$el.trigger(d+a,b)}}),b}(),f=function(){function a(a){this.prefix=["__",a,"__"].join(""),this.ttlKey="__ttl__",this.keyMatcher=new RegExp("^"+this.prefix)}function b(){return(new Date).getTime()}function d(a){return JSON.stringify(c.isUndefined(a)?null:a)}function e(a){return JSON.parse(a)}var f,g;try{f=window.localStorage,f.setItem("~~~","!"),f.removeItem("~~~")}catch(h){f=null}return g=f&&window.JSON?{_prefix:function(a){return this.prefix+a},_ttlKey:function(a){return this._prefix(a)+this.ttlKey},get:function(a){return this.isExpired(a)&&this.remove(a),e(f.getItem(this._prefix(a)))},set:function(a,e,g){return c.isNumber(g)?f.setItem(this._ttlKey(a),d(b()+g)):f.removeItem(this._ttlKey(a)),f.setItem(this._prefix(a),d(e))},remove:function(a){return f.removeItem(this._ttlKey(a)),f.removeItem(this._prefix(a)),this},clear:function(){var a,b,c=[],d=f.length;for(a=0;d>a;a++)(b=f.key(a)).match(this.keyMatcher)&&c.push(b.replace(this.keyMatcher,""));for(a=c.length;a--;)this.remove(c[a]);return this},isExpired:function(a){var d=e(f.getItem(this._ttlKey(a)));return c.isNumber(d)&&b()>d?!0:!1}}:{get:c.noop,set:c.noop,remove:c.noop,clear:c.noop,isExpired:c.noop},c.mixin(a.prototype,g),a}(),g=function(){function a(a){c.bindAll(this),a=a||{},this.sizeLimit=a.sizeLimit||10,this.cache={},this.cachedKeysByAge=[]}return c.mixin(a.prototype,{get:function(a){return this.cache[a]},set:function(a,b){var c;this.cachedKeysByAge.length===this.sizeLimit&&(c=this.cachedKeysByAge.shift(),delete this.cache[c]),this.cache[a]=b,this.cachedKeysByAge.push(a)}}),a}(),h=function(){function b(a){c.bindAll(this),a=c.isString(a)?{url:a}:a,i=i||new g,h=c.isNumber(a.maxParallelRequests)?a.maxParallelRequests:h||6,this.url=a.url,this.wildcard=a.wildcard||"%QUERY",this.filter=a.filter,this.replace=a.replace,this.ajaxSettings={type:"get",cache:a.cache,timeout:a.timeout,dataType:a.dataType||"json",beforeSend:a.beforeSend},this._get=(/^throttle$/i.test(a.rateLimitFn)?c.throttle:c.debounce)(this._get,a.rateLimitWait||300)}function d(){j++}function e(){j--}function f(){return h>j}var h,i,j=0,k={};return c.mixin(b.prototype,{_get:function(a,b){function c(c){var e=d.filter?d.filter(c):c;b&&b(e),i.set(a,c)}var d=this;f()?this._sendRequest(a).done(c):this.onDeckRequestArgs=[].slice.call(arguments,0)},_sendRequest:function(b){function c(){e(),k[b]=null,f.onDeckRequestArgs&&(f._get.apply(f,f.onDeckRequestArgs),f.onDeckRequestArgs=null)}var f=this,g=k[b];return g||(d(),g=k[b]=a.ajax(b,this.ajaxSettings).always(c)),g},get:function(a,b){var d,e,f=this,g=encodeURIComponent(a||"");return b=b||c.noop,d=this.replace?this.replace(this.url,g):this.url.replace(this.wildcard,g),(e=i.get(d))?c.defer(function(){b(f.filter?f.filter(e):e)}):this._get(d,b),!!e}}),b}(),i=function(){function d(b){c.bindAll(this),c.isString(b.template)&&!b.engine&&a.error("no template engine specified"),b.local||b.prefetch||b.remote||a.error("one of local, prefetch, or remote is required"),this.name=b.name||c.getUniqueId(),this.limit=b.limit||5,this.minLength=b.minLength||1,this.header=b.header,this.footer=b.footer,this.valueKey=b.valueKey||"value",this.template=e(b.template,b.engine,this.valueKey),this.local=b.local,this.prefetch=b.prefetch,this.remote=b.remote,this.itemHash={},this.adjacencyList={},this.storage=b.name?new f(b.name):null}function e(a,b,d){var e,f;return c.isFunction(a)?e=a:c.isString(a)?(f=b.compile(a),e=c.bind(f.render,f)):e=function(a){return"<p>"+a[d]+"</p>"},e}var g={thumbprint:"thumbprint",protocol:"protocol",itemHash:"itemHash",adjacencyList:"adjacencyList"};return c.mixin(d.prototype,{_processLocalData:function(a){this._mergeProcessedData(this._processData(a))},_loadPrefetchData:function(d){function e(a){var b=d.filter?d.filter(a):a,e=m._processData(b),f=e.itemHash,h=e.adjacencyList;m.storage&&(m.storage.set(g.itemHash,f,d.ttl),m.storage.set(g.adjacencyList,h,d.ttl),m.storage.set(g.thumbprint,n,d.ttl),m.storage.set(g.protocol,c.getProtocol(),d.ttl)),m._mergeProcessedData(e)}var f,h,i,j,k,l,m=this,n=b+(d.thumbprint||"");return this.storage&&(f=this.storage.get(g.thumbprint),h=this.storage.get(g.protocol),i=this.storage.get(g.itemHash),j=this.storage.get(g.adjacencyList)),k=f!==n||h!==c.getProtocol(),d=c.isString(d)?{url:d}:d,d.ttl=c.isNumber(d.ttl)?d.ttl:864e5,i&&j&&!k?(this._mergeProcessedData({itemHash:i,adjacencyList:j}),l=a.Deferred().resolve()):l=a.getJSON(d.url).done(e),l},_transformDatum:function(a){var b=c.isString(a)?a:a[this.valueKey],d=a.tokens||c.tokenizeText(b),e={value:b,tokens:d};return c.isString(a)?(e.datum={},e.datum[this.valueKey]=a):e.datum=a,e.tokens=c.filter(e.tokens,function(a){return!c.isBlankString(a)}),e.tokens=c.map(e.tokens,function(a){return a.toLowerCase()}),e},_processData:function(a){var b=this,d={},e={};return c.each(a,function(a,f){var g=b._transformDatum(f),h=c.getUniqueId(g.value);d[h]=g,c.each(g.tokens,function(a,b){var d=b.charAt(0),f=e[d]||(e[d]=[h]);!~c.indexOf(f,h)&&f.push(h)})}),{itemHash:d,adjacencyList:e}},_mergeProcessedData:function(a){var b=this;c.mixin(this.itemHash,a.itemHash),c.each(a.adjacencyList,function(a,c){var d=b.adjacencyList[a];b.adjacencyList[a]=d?d.concat(c):c})},_getLocalSuggestions:function(a){var b,d=this,e=[],f=[],g=[];return c.each(a,function(a,b){var d=b.charAt(0);!~c.indexOf(e,d)&&e.push(d)}),c.each(e,function(a,c){var e=d.adjacencyList[c];return e?(f.push(e),(!b||e.length<b.length)&&(b=e),void 0):!1}),f.length<e.length?[]:(c.each(b,function(b,e){var h,i,j=d.itemHash[e];h=c.every(f,function(a){return~c.indexOf(a,e)}),i=h&&c.every(a,function(a){return c.some(j.tokens,function(b){return 0===b.indexOf(a)})}),i&&g.push(j)}),g)},initialize:function(){var b;return this.local&&this._processLocalData(this.local),this.transport=this.remote?new h(this.remote):null,b=this.prefetch?this._loadPrefetchData(this.prefetch):a.Deferred().resolve(),this.local=this.prefetch=this.remote=null,this.initialize=function(){return b},b},getSuggestions:function(a,b){function d(a){f=f.slice(0),c.each(a,function(a,b){var d,e=g._transformDatum(b);return d=c.some(f,function(a){return e.value===a.value}),!d&&f.push(e),f.length<g.limit}),b&&b(f)}var e,f,g=this,h=!1;a.length<this.minLength||(e=c.tokenizeQuery(a),f=this._getLocalSuggestions(e).slice(0,this.limit),f.length<this.limit&&this.transport&&(h=this.transport.get(a,d)),!h&&b&&b(f))}}),d}(),j=function(){function b(b){var d=this;c.bindAll(this),this.specialKeyCodeMap={9:"tab",27:"esc",37:"left",39:"right",13:"enter",38:"up",40:"down"},this.$hint=a(b.hint),this.$input=a(b.input).on("blur.tt",this._handleBlur).on("focus.tt",this._handleFocus).on("keydown.tt",this._handleSpecialKeyEvent),c.isMsie()?this.$input.on("keydown.tt keypress.tt cut.tt paste.tt",function(a){d.specialKeyCodeMap[a.which||a.keyCode]||c.defer(d._compareQueryToInputValue)}):this.$input.on("input.tt",this._compareQueryToInputValue),this.query=this.$input.val(),this.$overflowHelper=e(this.$input)}function e(b){return a("<span></span>").css({position:"absolute",left:"-9999px",visibility:"hidden",whiteSpace:"nowrap",fontFamily:b.css("font-family"),fontSize:b.css("font-size"),fontStyle:b.css("font-style"),fontVariant:b.css("font-variant"),fontWeight:b.css("font-weight"),wordSpacing:b.css("word-spacing"),letterSpacing:b.css("letter-spacing"),textIndent:b.css("text-indent"),textRendering:b.css("text-rendering"),textTransform:b.css("text-transform")}).insertAfter(b)}function f(a,b){return a=(a||"").replace(/^\s*/g,"").replace(/\s{2,}/g," "),b=(b||"").replace(/^\s*/g,"").replace(/\s{2,}/g," "),a===b}return c.mixin(b.prototype,d,{_handleFocus:function(){this.trigger("focused")},_handleBlur:function(){this.trigger("blured")},_handleSpecialKeyEvent:function(a){var b=this.specialKeyCodeMap[a.which||a.keyCode];b&&this.trigger(b+"Keyed",a)},_compareQueryToInputValue:function(){var a=this.getInputValue(),b=f(this.query,a),c=b?this.query.length!==a.length:!1;c?this.trigger("whitespaceChanged",{value:this.query}):b||this.trigger("queryChanged",{value:this.query=a})},destroy:function(){this.$hint.off(".tt"),this.$input.off(".tt"),this.$hint=this.$input=this.$overflowHelper=null},focus:function(){this.$input.focus()},blur:function(){this.$input.blur()},getQuery:function(){return this.query},setQuery:function(a){this.query=a},getInputValue:function(){return this.$input.val()},setInputValue:function(a,b){this.$input.val(a),!b&&this._compareQueryToInputValue()},getHintValue:function(){return this.$hint.val()},setHintValue:function(a){this.$hint.val(a)},getLanguageDirection:function(){return(this.$input.css("direction")||"ltr").toLowerCase()},isOverflow:function(){return this.$overflowHelper.text(this.getInputValue()),this.$overflowHelper.width()>this.$input.width()},isCursorAtEnd:function(){var a,b=this.$input.val().length,d=this.$input[0].selectionStart;return c.isNumber(d)?d===b:document.selection?(a=document.selection.createRange(),a.moveStart("character",-b),b===a.text.length):!0}}),b}(),k=function(){function b(b){c.bindAll(this),this.isOpen=!1,this.isEmpty=!0,this.isMouseOverDropdown=!1,this.$menu=a(b.menu).on("mouseenter.tt",this._handleMouseenter).on("mouseleave.tt",this._handleMouseleave).on("click.tt",".tt-suggestion",this._handleSelection).on("mouseover.tt",".tt-suggestion",this._handleMouseover)}function e(a){return a.data("suggestion")}var f={suggestionsList:'<span class="tt-suggestions"></span>'},g={suggestionsList:{display:"block"},suggestion:{whiteSpace:"nowrap",cursor:"pointer"},suggestionChild:{whiteSpace:"normal"}};return c.mixin(b.prototype,d,{_handleMouseenter:function(){this.isMouseOverDropdown=!0},_handleMouseleave:function(){this.isMouseOverDropdown=!1},_handleMouseover:function(b){var c=a(b.currentTarget);this._getSuggestions().removeClass("tt-is-under-cursor"),c.addClass("tt-is-under-cursor")},_handleSelection:function(b){var c=a(b.currentTarget);this.trigger("suggestionSelected",e(c))},_show:function(){this.$menu.css("display","block")},_hide:function(){this.$menu.hide()},_moveCursor:function(a){var b,c,d,f;if(this.isVisible()){if(b=this._getSuggestions(),c=b.filter(".tt-is-under-cursor"),c.removeClass("tt-is-under-cursor"),d=b.index(c)+a,d=(d+1)%(b.length+1)-1,-1===d)return this.trigger("cursorRemoved"),void 0;-1>d&&(d=b.length-1),f=b.eq(d).addClass("tt-is-under-cursor"),this._ensureVisibility(f),this.trigger("cursorMoved",e(f))}},_getSuggestions:function(){return this.$menu.find(".tt-suggestions > .tt-suggestion")},_ensureVisibility:function(a){var b=this.$menu.height()+parseInt(this.$menu.css("paddingTop"),10)+parseInt(this.$menu.css("paddingBottom"),10),c=this.$menu.scrollTop(),d=a.position().top,e=d+a.outerHeight(!0);0>d?this.$menu.scrollTop(c+d):e>b&&this.$menu.scrollTop(c+(e-b))},destroy:function(){this.$menu.off(".tt"),this.$menu=null},isVisible:function(){return this.isOpen&&!this.isEmpty},closeUnlessMouseIsOverDropdown:function(){this.isMouseOverDropdown||this.close()},close:function(){this.isOpen&&(this.isOpen=!1,this.isMouseOverDropdown=!1,this._hide(),this.$menu.find(".tt-suggestions > .tt-suggestion").removeClass("tt-is-under-cursor"),this.trigger("closed"))},open:function(){this.isOpen||(this.isOpen=!0,!this.isEmpty&&this._show(),this.trigger("opened"))},setLanguageDirection:function(a){var b={left:"0",right:"auto"},c={left:"auto",right:" 0"};"ltr"===a?this.$menu.css(b):this.$menu.css(c)},moveCursorUp:function(){this._moveCursor(-1)},moveCursorDown:function(){this._moveCursor(1)},getSuggestionUnderCursor:function(){var a=this._getSuggestions().filter(".tt-is-under-cursor").first();return a.length>0?e(a):null},getFirstSuggestion:function(){var a=this._getSuggestions().first();return a.length>0?e(a):null},renderSuggestions:function(b,d){var e,h,i,j,k,l="tt-dataset-"+b.name,m='<div class="tt-suggestion">%body</div>',n=this.$menu.find("."+l);0===n.length&&(h=a(f.suggestionsList).css(g.suggestionsList),n=a("<div></div>").addClass(l).append(b.header).append(h).append(b.footer).appendTo(this.$menu)),d.length>0?(this.isEmpty=!1,this.isOpen&&this._show(),i=document.createElement("div"),j=document.createDocumentFragment(),c.each(d,function(c,d){d.dataset=b.name,e=b.template(d.datum),i.innerHTML=m.replace("%body",e),k=a(i.firstChild).css(g.suggestion).data("suggestion",d),k.children().each(function(){a(this).css(g.suggestionChild)}),j.appendChild(k[0])}),n.show().find(".tt-suggestions").html(j)):this.clearSuggestions(b.name),this.trigger("suggestionsRendered")},clearSuggestions:function(a){var b=a?this.$menu.find(".tt-dataset-"+a):this.$menu.find('[class^="tt-dataset-"]'),c=b.find(".tt-suggestions");b.hide(),c.empty(),0===this._getSuggestions().length&&(this.isEmpty=!0,this._hide())}}),b}(),l=function(){function b(a){var b,d,f;c.bindAll(this),this.$node=e(a.input),this.datasets=a.datasets,this.dir=null,this.eventBus=a.eventBus,b=this.$node.find(".tt-dropdown-menu"),d=this.$node.find(".tt-query"),f=this.$node.find(".tt-hint"),this.dropdownView=new k({menu:b}).on("suggestionSelected",this._handleSelection).on("cursorMoved",this._clearHint).on("cursorMoved",this._setInputValueToSuggestionUnderCursor).on("cursorRemoved",this._setInputValueToQuery).on("cursorRemoved",this._updateHint).on("suggestionsRendered",this._updateHint).on("opened",this._updateHint).on("closed",this._clearHint).on("opened closed",this._propagateEvent),this.inputView=new j({input:d,hint:f}).on("focused",this._openDropdown).on("blured",this._closeDropdown).on("blured",this._setInputValueToQuery).on("enterKeyed tabKeyed",this._handleSelection).on("queryChanged",this._clearHint).on("queryChanged",this._clearSuggestions).on("queryChanged",this._getSuggestions).on("whitespaceChanged",this._updateHint).on("queryChanged whitespaceChanged",this._openDropdown).on("queryChanged whitespaceChanged",this._setLanguageDirection).on("escKeyed",this._closeDropdown).on("escKeyed",this._setInputValueToQuery).on("tabKeyed upKeyed downKeyed",this._managePreventDefault).on("upKeyed downKeyed",this._moveDropdownCursor).on("upKeyed downKeyed",this._openDropdown).on("tabKeyed leftKeyed rightKeyed",this._autocomplete)}function e(b){var c=a(g.wrapper),d=a(g.dropdown),e=a(b),f=a(g.hint);c=c.css(h.wrapper),d=d.css(h.dropdown),f.css(h.hint).css({backgroundAttachment:e.css("background-attachment"),backgroundClip:e.css("background-clip"),backgroundColor:e.css("background-color"),backgroundImage:e.css("background-image"),backgroundOrigin:e.css("background-origin"),backgroundPosition:e.css("background-position"),backgroundRepeat:e.css("background-repeat"),backgroundSize:e.css("background-size")}),e.data("ttAttrs",{dir:e.attr("dir"),autocomplete:e.attr("autocomplete"),spellcheck:e.attr("spellcheck"),style:e.attr("style")}),e.addClass("tt-query").attr({autocomplete:"off",spellcheck:!1}).css(h.query);try{!e.attr("dir")&&e.attr("dir","auto")}catch(i){}return e.wrap(c).parent().prepend(f).append(d)}function f(a){var b=a.find(".tt-query");c.each(b.data("ttAttrs"),function(a,d){c.isUndefined(d)?b.removeAttr(a):b.attr(a,d)}),b.detach().removeData("ttAttrs").removeClass("tt-query").insertAfter(a),a.remove()}var g={wrapper:'<span class="twitter-typeahead"></span>',hint:'<input class="tt-hint" type="text" autocomplete="off" spellcheck="off" disabled>',dropdown:'<span class="tt-dropdown-menu"></span>'},h={wrapper:{position:"relative",display:"inline-block"},hint:{position:"absolute",top:"0",left:"0",borderColor:"transparent",boxShadow:"none"},query:{position:"relative",verticalAlign:"top",backgroundColor:"transparent"},dropdown:{position:"absolute",top:"100%",left:"0",zIndex:"100",display:"none"}};return c.isMsie()&&c.mixin(h.query,{backgroundImage:"url(data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)"}),c.isMsie()&&c.isMsie()<=7&&(c.mixin(h.wrapper,{display:"inline",zoom:"1"}),c.mixin(h.query,{marginTop:"-1px"})),c.mixin(b.prototype,d,{_managePreventDefault:function(a){var b,c,d=a.data,e=!1;switch(a.type){case"tabKeyed":b=this.inputView.getHintValue(),c=this.inputView.getInputValue(),e=b&&b!==c;break;case"upKeyed":case"downKeyed":e=!d.shiftKey&&!d.ctrlKey&&!d.metaKey}e&&d.preventDefault()},_setLanguageDirection:function(){var a=this.inputView.getLanguageDirection();a!==this.dir&&(this.dir=a,this.$node.css("direction",a),this.dropdownView.setLanguageDirection(a))},_updateHint:function(){var a,b,d,e,f,g=this.dropdownView.getFirstSuggestion(),h=g?g.value:null,i=this.dropdownView.isVisible(),j=this.inputView.isOverflow();h&&i&&!j&&(a=this.inputView.getInputValue(),b=a.replace(/\s{2,}/g," ").replace(/^\s+/g,""),d=c.escapeRegExChars(b),e=new RegExp("^(?:"+d+")(.*$)","i"),f=e.exec(h),this.inputView.setHintValue(a+(f?f[1]:"")))},_clearHint:function(){this.inputView.setHintValue("")},_clearSuggestions:function(){this.dropdownView.clearSuggestions()},_setInputValueToQuery:function(){this.inputView.setInputValue(this.inputView.getQuery())},_setInputValueToSuggestionUnderCursor:function(a){var b=a.data;this.inputView.setInputValue(b.value,!0)},_openDropdown:function(){this.dropdownView.open()},_closeDropdown:function(a){this.dropdownView["blured"===a.type?"closeUnlessMouseIsOverDropdown":"close"]()},_moveDropdownCursor:function(a){var b=a.data;b.shiftKey||b.ctrlKey||b.metaKey||this.dropdownView["upKeyed"===a.type?"moveCursorUp":"moveCursorDown"]()},_handleSelection:function(a){var b="suggestionSelected"===a.type,d=b?a.data:this.dropdownView.getSuggestionUnderCursor();d&&(this.inputView.setInputValue(d.value),b?this.inputView.focus():a.data.preventDefault(),b&&c.isMsie()?c.defer(this.dropdownView.close):this.dropdownView.close(),this.eventBus.trigger("selected",d.datum,d.dataset))},_getSuggestions:function(){var a=this,b=this.inputView.getQuery();c.isBlankString(b)||c.each(this.datasets,function(c,d){d.getSuggestions(b,function(c){b===a.inputView.getQuery()&&a.dropdownView.renderSuggestions(d,c)})})},_autocomplete:function(a){var b,c,d,e,f;("rightKeyed"!==a.type&&"leftKeyed"!==a.type||(b=this.inputView.isCursorAtEnd(),c="ltr"===this.inputView.getLanguageDirection()?"leftKeyed"===a.type:"rightKeyed"===a.type,b&&!c))&&(d=this.inputView.getQuery(),e=this.inputView.getHintValue(),""!==e&&d!==e&&(f=this.dropdownView.getFirstSuggestion(),this.inputView.setInputValue(f.value),this.eventBus.trigger("autocompleted",f.datum,f.dataset)))},_propagateEvent:function(a){this.eventBus.trigger(a.type)},destroy:function(){this.inputView.destroy(),this.dropdownView.destroy(),f(this.$node),this.$node=null},setQuery:function(a){this.inputView.setQuery(a),this.inputView.setInputValue(a),this._clearHint(),this._clearSuggestions(),this._getSuggestions()}}),b}();!function(){var b,d={},f="ttView";b={initialize:function(b){function g(){var b,d=a(this),g=new e({el:d});b=c.map(h,function(a){return a.initialize()}),d.data(f,new l({input:d,eventBus:g=new e({el:d}),datasets:h})),a.when.apply(a,b).always(function(){c.defer(function(){g.trigger("initialized")})})}var h;return b=c.isArray(b)?b:[b],0===b.length&&a.error("no datasets provided"),h=c.map(b,function(a){var b=d[a.name]?d[a.name]:new i(a);return a.name&&(d[a.name]=b),b}),this.each(g)},destroy:function(){function b(){var b=a(this),c=b.data(f);c&&(c.destroy(),b.removeData(f))}return this.each(b)},setQuery:function(b){function c(){var c=a(this).data(f);c&&c.setQuery(b)}return this.each(c)}},jQuery.fn.typeahead=function(a){return b[a]?b[a].apply(this,[].slice.call(arguments,1)):b.initialize.apply(this,arguments)}}()}(window.jQuery);
\ No newline at end of file
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/minus.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/minus.png differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/plus.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/plus.png differ
diff -Nru acl2-6.2/books/xdoc/fancy/render.js acl2-6.3/books/xdoc/fancy/render.js
--- acl2-6.2/books/xdoc/fancy/render.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/render.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1 @@
+var xslt_base64 = "PD94bWwgdmVyc2lvbj0iMS4wIiBlbmNvZGluZz0iVVRGLTgiPz4KPHhzbDpzdHlsZXNoZWV0IHZlcnNpb249IjEuMCIgeG1sbnM6eHNsPSJodHRwOi8vd3d3LnczLm9yZy8xOTk5L1hTTC9UcmFuc2Zvcm0iPgoKPCEtLQoKOyBYRE9DIERvY3VtZW50YXRpb24gU3lzdGVtIGZvciBBQ0wyCjsgQ29weXJpZ2h0IChDKSAyMDA5LTIwMTMgQ2VudGF1ciBUZWNobm9sb2d5CjsKOyBDb250YWN0Ogo7ICAgQ2VudGF1ciBUZWNobm9sb2d5IEZvcm1hbCBWZXJpZmljYXRpb24gR3JvdXAKOyAgIDc2MDAtQyBOLiBDYXBpdGFsIG9mIFRleGFzIEhpZ2h3YXksIFN1aXRlIDMwMCwgQXVzdGluLCBUWCA3ODczMSwgVVNBLgo7ICAgaHR0cDovL3d3dy5jZW50dGVjaC5jb20vCjsKOyBUaGlzIHByb2dyYW0gaXMgZnJlZSBzb2Z0d2FyZTsgeW91IGNhbiByZWRpc3RyaWJ1dGUgaXQgYW5kL29yIG1vZGlmeSBpdCB1bmRlcgo7IHRoZSB0ZXJtcyBvZiB0aGUgR05VIEdlbmVyYWwgUHVibGljIExpY2Vuc2UgYXMgcHVibGlzaGVkIGJ5IHRoZSBGcmVlIFNvZnR3YXJlCjsgRm91bmRhdGlvbjsgZWl0aGVyIHZlcnNpb24gMiBvZiB0aGUgTGljZW5zZSwgb3IgKGF0IHlvdXIgb3B0aW9uKSBhbnkgbGF0ZXIKOyB2ZXJzaW9uLiAgVGhpcyBwcm9ncmFtIGlzIGRpc3RyaWJ1dGVkIGluIHRoZSBob3BlIHRoYXQgaXQgd2lsbCBiZSB1c2VmdWwgYnV0CjsgV0lUSE9VVCBBTlkgV0FSUkFOVFk7IHdpdGhvdXQgZXZlbiB0aGUgaW1wbGllZCB3YXJyYW50eSBvZiBNRVJDSEFOVEFCSUxJVFkgb3IKOyBGSVRORVNTIEZPUiBBIFBBUlRJQ1VMQVIgUFVSUE9TRS4gIFNlZSB0aGUgR05VIEdlbmVyYWwgUHVibGljIExpY2Vuc2UgZm9yCjsgbW9yZSBkZXRhaWxzLiAgWW91IHNob3VsZCBoYXZlIHJlY2VpdmVkIGEgY29weSBvZiB0aGUgR05VIEdlbmVyYWwgUHVibGljCjsgTGljZW5zZSBhbG9uZyB3aXRoIHRoaXMgcHJvZ3JhbTsgaWYgbm90LCB3cml0ZSB0byB0aGUgRnJlZSBTb2Z0d2FyZQo7IEZvdW5kYXRpb24sIEluYy4sIDUxIEZyYW5rbGluIFN0cmVldCwgU3VpdGUgNTAwLCBCb3N0b24sIE1BIDAyMTEwLTEzMzUsIFVTQS4KOwo7IE9yaWdpbmFsIGF1dGhvcjogSmFyZWQgRGF2aXMgPGphcmVkQGNlbnR0ZWNoLmNvbT4KCjsgVGhpcyBpcyBhbiBYU0xUIHN0eWxlIHNoZWV0IHRoYXQgdHJhbnNmb3JtcyB0aGUgc21hbGwgWERPQyBtYXJrdXAgbGFuZ3VhZ2UKOyBpbnRvIEhUTUwuICBUaGlzIGlzIG1vc3RseSBzdHJhaWdodGZvcndhcmQuCgotLT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9InNlZSI+CiAgPGEgaHJlZj0iamF2YXNjcmlwdDphY3Rpb25fZ29fa2V5KCd7QHRvcGljfScpIj4KICAgIDx4c2w6YXBwbHktdGVtcGxhdGVzLz4KICA8L2E+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0ic3JjbGluayI+CiAgPGEgY2xhc3M9InNyY2xpbmsiIHRpdGxlPSJGaW5kLVRhZyBpbiBFbWFjcyI+CiAgICA8eHNsOmF0dHJpYnV0ZSBuYW1lPSJocmVmIj5qYXZhc2NyaXB0OnNyY2xpbmsoJzx4c2w6dmFsdWUtb2Ygc2VsZWN0PSIuIi8+Jyk8L3hzbDphdHRyaWJ1dGU+CiAgICA8eHNsOmFwcGx5LXRlbXBsYXRlcy8+CiAgPC9hPgo8L3hzbDp0ZW1wbGF0ZT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9ImNvZGUiPgogIDxwcmUgY2xhc3M9ImNvZGUiPjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L3ByZT4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJib3giPgogIDxkaXYgY2xhc3M9ImJveCI+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvZGl2Pgo8L3hzbDp0ZW1wbGF0ZT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9InAiPgogIDxwPjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L3A+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0iYmxvY2txdW90ZSI+CiAgPGJsb2NrcXVvdGU+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvYmxvY2txdW90ZT4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJiciI+CiAgPHhzbDphcHBseS10ZW1wbGF0ZXMvPjxici8+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0iYSI+CiAgPGEgaHJlZj0ie0BocmVmfSIgdGFyZ2V0PSJfYmxhbmsiPgogICAgPHhzbDp2YWx1ZS1vZiBzZWxlY3Q9Ii4iLz4KICAgIDxpbWcgc3JjPSJJY29uX0V4dGVybmFsX0xpbmsucG5nIiB0aXRsZT0iRXh0ZXJuYWwgbGluayB0byB7QGhyZWZ9Ii8+CiAgPC9hPgo8L3hzbDp0ZW1wbGF0ZT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9ImltZyI+CiAgPGltZyBzcmM9ImltYWdlcy97QHNyY30iLz4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJiIj4KICA8Yj48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC9iPgo8L3hzbDp0ZW1wbGF0ZT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9ImkiPgogIDxpPjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L2k+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0iY29sb3IiPgogIDxmb250IGNvbG9yPSJ7QHJnYn0iPjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L2ZvbnQ+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0ic2YiPgogIDxzcGFuIGNsYXNzPSJzZiI+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvc3Bhbj4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJ1Ij4KICA8dT48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC91Pgo8L3hzbDp0ZW1wbGF0ZT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9InR0Ij4KICA8c3BhbiBjbGFzcz0idHQiPjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L3NwYW4+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0idWwiPgogIDx1bD48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC91bD4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJvbCI+CiAgPG9sPjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L29sPgo8L3hzbDp0ZW1wbGF0ZT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9ImxpIj4KICA8bGk+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvbGk+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0iZGwiPgogIDxkbD48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC9kbD4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJkdCI+CiAgPGR0Pjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L2R0Pgo8L3hzbDp0ZW1wbGF0ZT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9ImRkIj4KICA8ZGQ+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvZGQ+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0iaDEiPgogIDxoMT48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC9oMT4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJoMiI+CiAgPGgyPjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L2gyPgo8L3hzbDp0ZW1wbGF0ZT4KCjx4c2w6dGVtcGxhdGUgbWF0Y2g9ImgzIj4KICA8aDM+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvaDM+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0iaDQiPgogIDxoND48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC9oND4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJoNSI+CiAgPGg1Pjx4c2w6YXBwbHktdGVtcGxhdGVzLz48L2g1Pgo8L3hzbDp0ZW1wbGF0ZT4KCgoKPCEtLSBFeHRyYSBzdHVmZiBmb3IgU3ltYm9saWMgVGVzdCBWZWN0b3JzIGF0IENlbnRhdXIgLS0+CgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0ic3R2Ij4KICA8dGFibGUgY2xhc3M9InN0diIgY2VsbHNwYWNpbmc9IjAiIGNlbGxwYWRkaW5nPSIyIj48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC90YWJsZT4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJzdHZfbGFiZWxzIj4KIDx0ciBjbGFzcz0ic3R2X2xhYmVscyI+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvdHI+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0ic3R2X2lucHV0cyI+CiAgPHhzbDpmb3ItZWFjaCBzZWxlY3Q9InN0dl9saW5lIj4KICAgPHRyIGNsYXNzPSJzdHZfaW5wdXRfbGluZSI+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvdHI+CiAgPC94c2w6Zm9yLWVhY2g+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0ic3R2X291dHB1dHMiPgogIDx4c2w6Zm9yLWVhY2ggc2VsZWN0PSJzdHZfbGluZSI+CiAgIDx0ciBjbGFzcz0ic3R2X291dHB1dF9saW5lIj48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC90cj4KICA8L3hzbDpmb3ItZWFjaD4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJzdHZfaW50ZXJuYWxzIj4KICA8eHNsOmZvci1lYWNoIHNlbGVjdD0ic3R2X2xpbmUiPgogICA8dHIgY2xhc3M9InN0dl9pbnRlcm5hbF9saW5lIj48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC90cj4KICA8L3hzbDpmb3ItZWFjaD4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJzdHZfb3ZlcnJpZGVzIj4KICA8eHNsOmZvci1lYWNoIHNlbGVjdD0ic3R2X2xpbmUiPgogICA8dHIgY2xhc3M9InN0dl9vdmVycmlkZV9saW5lIj48eHNsOmFwcGx5LXRlbXBsYXRlcy8+PC90cj4KICA8L3hzbDpmb3ItZWFjaD4KPC94c2w6dGVtcGxhdGU+Cgo8eHNsOnRlbXBsYXRlIG1hdGNoPSJzdHZfbmFtZSI+CiAgPHRoIGNsYXNzPSJzdHZfbmFtZSI+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvdGg+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0ic3R2X2VudHJ5Ij4KICA8dGQgY2xhc3M9InN0dl9lbnRyeSI+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvdGQ+CjwveHNsOnRlbXBsYXRlPgoKPHhzbDp0ZW1wbGF0ZSBtYXRjaD0ic3R2X2xhYmVsIj4KICA8dGggY2xhc3M9InN0dl9sYWJlbCI+PHhzbDphcHBseS10ZW1wbGF0ZXMvPjwvdGg+CjwveHNsOnRlbXBsYXRlPgoKPC94c2w6c3R5bGVzaGVldD4K";
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc/fancy/render.xsl acl2-6.3/books/xdoc/fancy/render.xsl
--- acl2-6.2/books/xdoc/fancy/render.xsl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/render.xsl	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,193 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+<!--
+
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+; This is an XSLT style sheet that transforms the small XDOC markup language
+; into HTML.  This is mostly straightforward.
+
+-->
+
+<xsl:template match="see">
+  <a href="javascript:action_go_key('{@topic}')">
+    <xsl:apply-templates/>
+  </a>
+</xsl:template>
+
+<xsl:template match="srclink">
+  <a class="srclink" title="Find-Tag in Emacs">
+    <xsl:attribute name="href">javascript:srclink('<xsl:value-of select="."/>')</xsl:attribute>
+    <xsl:apply-templates/>
+  </a>
+</xsl:template>
+
+<xsl:template match="code">
+  <pre class="code"><xsl:apply-templates/></pre>
+</xsl:template>
+
+<xsl:template match="box">
+  <div class="box"><xsl:apply-templates/></div>
+</xsl:template>
+
+<xsl:template match="p">
+  <p><xsl:apply-templates/></p>
+</xsl:template>
+
+<xsl:template match="blockquote">
+  <blockquote><xsl:apply-templates/></blockquote>
+</xsl:template>
+
+<xsl:template match="br">
+  <xsl:apply-templates/><br/>
+</xsl:template>
+
+<xsl:template match="a">
+  <a href="{@href}" target="_blank">
+    <nobr>
+    <xsl:value-of select="."/><img src="Icon_External_Link.png" title="External link to {@href}"/>
+    </nobr>
+  </a>
+</xsl:template>
+
+<xsl:template match="img">
+  <img src="images/{@src}"/>
+</xsl:template>
+
+<xsl:template match="b">
+  <b><xsl:apply-templates/></b>
+</xsl:template>
+
+<xsl:template match="i">
+  <i><xsl:apply-templates/></i>
+</xsl:template>
+
+<xsl:template match="color">
+  <font color="{@rgb}"><xsl:apply-templates/></font>
+</xsl:template>
+
+<xsl:template match="sf">
+  <span class="sf"><xsl:apply-templates/></span>
+</xsl:template>
+
+<xsl:template match="u">
+  <u><xsl:apply-templates/></u>
+</xsl:template>
+
+<xsl:template match="tt">
+  <span class="tt"><xsl:apply-templates/></span>
+</xsl:template>
+
+<xsl:template match="ul">
+  <ul><xsl:apply-templates/></ul>
+</xsl:template>
+
+<xsl:template match="ol">
+  <ol><xsl:apply-templates/></ol>
+</xsl:template>
+
+<xsl:template match="li">
+  <li><xsl:apply-templates/></li>
+</xsl:template>
+
+<xsl:template match="dl">
+  <dl><xsl:apply-templates/></dl>
+</xsl:template>
+
+<xsl:template match="dt">
+  <dt><xsl:apply-templates/></dt>
+</xsl:template>
+
+<xsl:template match="dd">
+  <dd><xsl:apply-templates/></dd>
+</xsl:template>
+
+<xsl:template match="h1">
+  <h1><xsl:apply-templates/></h1>
+</xsl:template>
+
+<xsl:template match="h2">
+  <h2><xsl:apply-templates/></h2>
+</xsl:template>
+
+<xsl:template match="h3">
+  <h3><xsl:apply-templates/></h3>
+</xsl:template>
+
+<xsl:template match="h4">
+  <h4><xsl:apply-templates/></h4>
+</xsl:template>
+
+<xsl:template match="h5">
+  <h5><xsl:apply-templates/></h5>
+</xsl:template>
+
+
+
+<!-- Extra stuff for Symbolic Test Vectors at Centaur -->
+
+
+<xsl:template match="stv">
+  <table class="stv" cellspacing="0" cellpadding="2"><xsl:apply-templates/></table>
+</xsl:template>
+
+<xsl:template match="stv_labels">
+ <tr class="stv_labels"><xsl:apply-templates/></tr>
+</xsl:template>
+
+<xsl:template match="stv_inputs">
+  <xsl:for-each select="stv_line">
+   <tr class="stv_input_line"><xsl:apply-templates/></tr>
+  </xsl:for-each>
+</xsl:template>
+
+<xsl:template match="stv_outputs">
+  <xsl:for-each select="stv_line">
+   <tr class="stv_output_line"><xsl:apply-templates/></tr>
+  </xsl:for-each>
+</xsl:template>
+
+<xsl:template match="stv_internals">
+  <xsl:for-each select="stv_line">
+   <tr class="stv_internal_line"><xsl:apply-templates/></tr>
+  </xsl:for-each>
+</xsl:template>
+
+<xsl:template match="stv_overrides">
+  <xsl:for-each select="stv_line">
+   <tr class="stv_override_line"><xsl:apply-templates/></tr>
+  </xsl:for-each>
+</xsl:template>
+
+<xsl:template match="stv_name">
+  <th class="stv_name"><xsl:apply-templates/></th>
+</xsl:template>
+
+<xsl:template match="stv_entry">
+  <td class="stv_entry"><xsl:apply-templates/></td>
+</xsl:template>
+
+<xsl:template match="stv_label">
+  <th class="stv_label"><xsl:apply-templates/></th>
+</xsl:template>
+
+</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/fancy/style.css acl2-6.3/books/xdoc/fancy/style.css
--- acl2-6.2/books/xdoc/fancy/style.css	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/style.css	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,454 @@
+/*
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+; Cascading Style Sheet for the fancy viewer.  You can easily tweak the colors,
+; layout, etc., here.
+
+*/
+
+
+/* ---------------------------- LAYOUT -------------------------------- */
+
+body {
+   margin: 0;
+   background-color: white;
+}
+
+#top {
+    position: fixed;
+    z-index: 100;
+    left: 0;
+    top: 0;
+    height: 60px;
+    width: 100%;
+    border-top: solid 2px;
+    border-bottom: solid 3px;
+}
+
+/*
+#bottom {
+    position: fixed;
+    z-index: 100
+    left: 0;
+    bottom: 0;
+    height: 2em;
+    border-top: solid 3px;
+    width: 100%;
+}
+*/
+
+#left {
+    position: fixed;
+    left: 0;
+    top: 65px;
+    bottom: 0em;
+    width: 254px;
+    padding: 0;
+    overflow-y: scroll;
+    overflow-x: hidden;
+}
+
+#right {
+    border-left: solid 1px;
+    position: fixed;
+    left: 254px;
+    top: 65px;
+    right: 0em;
+    bottom: 0em;
+    overflow: auto;
+    margin: 0;
+    padding-left: 0;
+    padding-right: 0;
+    padding-top: 0;
+    padding-bottom: 2em;
+}
+
+#data {
+    margin-left: 1em;
+    margin-right: 1em;
+    width: 45em;
+    height: 100%;
+}
+
+#still_loading {
+    z-index: 200;
+    position: fixed;
+    left: 350px;
+    top: 120px;
+    border-radius: 7px;
+    background-color: #007730;
+    color: white;
+    padding-left: 30px;
+    padding-right: 30px;
+    padding-top: 10px;
+    padding-bottom: 10px;
+    font-size: 120%;
+    box-shadow: 0px 0px 0px 3px rgba(0,0,70,0.3);
+}
+
+h1 { margin-bottom: 0; }
+
+.from {
+    font-size: 90%;
+    text-align: center;
+    margin-left: 0;
+    margin-right: 0;
+    margin-top: -.2em;
+    padding: 0;
+}
+
+
+/* ---------------------------- COLORS -------------------------------- */
+
+#top    { background-color: #034569; }
+#bottom { background-color: #228A4C; }
+#left   { background-color: #ffcba3; }
+#right  { background-color: white; }
+
+#top, #bottom, #right, #left, #parents { border-color: #3C9DD0; }
+
+body          { background-color: white;}
+#data_wrapper { background-color: #ffffff; }
+
+h1,h2    {  color: #A64300; }
+h3,h4,h5 {  color: #FF6700; }
+
+.box          { border-color: black; }
+#data_wrapper { border-color: #034569; }
+
+.code,.tt { color: #306030;}
+.code a   { color: #309030;}
+.code     { border-color: #3C9DD0; }
+
+#nav a:hover, #flat a:hover { background-color: #FFAB73; }
+#data a:hover { background-color: #ffffa0; }
+
+#parents { background-color: #63DB93; }
+#parents li a       {  }
+#parents li a:hover { background-color: #00B74A; text-decoration: none; }
+
+.tt-is-under-cursor { background-color: #ffffa0; }
+
+#jumpmsg,#searchmsg { color: white; }
+
+#letters { padding-left: .4em; }
+#letters a { color: #3C9DD0; }
+#letters a:hover { text-decoration: none; color: white; background-color: #086CA2; }
+
+.dat_long {
+    border-color: #FF6700;
+}
+
+.from {
+    color: #3C9DD0;
+}
+
+
+/* ----------------------- FONTS --------------------------------- */
+
+body { font-family: "Georgia", "Bookman Old Style", serif; }
+
+#parents, #toolbar, h1, h2, h3, h4, h5, .sf {
+    font-family: "Geneva", "Verdana", sans-serif;
+}
+
+dt, .hindex, #flat, #still_loading {
+    font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
+}
+
+.code, .srclink, .tt, #letters, .from {
+    font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
+}
+
+
+
+/* ----------------------- PARENTS DISPLAY ----------------------- */
+
+#parents {
+    padding: 10px;
+    border-bottom-width: 1px;
+    border-bottom-style: solid;
+}
+
+#parents ul {
+    margin: 0;
+    padding: 0;
+    list-style-type: none;
+}
+
+#parents li {
+    display: inline;
+}
+
+#parents li a {
+    padding: .2em 1em;
+}
+
+
+
+/* ---------------------- JUMP TO BOX ---------------------------- */
+
+#toolbar {
+    padding: .5em;
+}
+#toolbar td {
+    padding-left: 3em;
+}
+
+
+#jump, #searchbox {
+    background-color: #ffffa0;
+    box-shadow: 0px 0px 0px 2px rgba(0,0,0,0.3);
+    border-radius: 3px;
+    border: 2px solid #dadada;
+    background-clip: padding-box;
+}
+
+#jump:focus, #searchbox:focus {
+    outline: none;
+    border-color: #9ecaed;
+    box-shadow: 0 0 10px #9ecaed;
+}
+
+/* These are fancy things for the typeahead menu: */
+
+.tt-dropdown-menu {
+    background-color: white;
+    color: black;
+    width: 450px;
+    font-size: 90%;
+}
+
+.tt-suggestion {
+    border: 1px black solid;
+    padding: .25em;
+}
+
+.tt-suggstion tt {
+    font-size: 50%;
+}
+
+
+/* ------------------------ NAVIGATION MENU ---------------------- */
+
+.hindex {
+  list-style-type: none;
+  padding: 0;
+  font-weight: normal;
+}
+
+.hindex li {
+  margin-bottom: 0em;
+}
+
+.hindex li li {
+  margin-left: 0.5em;
+}
+
+
+#flat ul {
+  list-style-type: none;
+  margin-left: 1em;
+  padding: 0;
+}
+
+#flat li {
+  margin-left: 0;
+  margin-bottom: 0;
+}
+
+.flatsec {
+    margin-top: 2em;
+}
+
+
+
+img {
+  border: 0px;
+}
+
+
+h1 { font-size: 2.2em; text-align: center; }
+h2 { font-size: 1.8em; }
+h3 { font-size: 1.5em; }
+h4 { font-size: 1.2em; }
+h5 { font-size: 1.1em; margin-left: 1em;}
+
+p, dl { margin-left: 1em; margin-right: 1em; }
+
+li    { margin-left: 1.0em; margin-right: 1em; margin-bottom: 0.5em; }
+li li { margin-left: -1.0em; margin-bottom: 0em; }
+
+dt {
+  margin-left: 1em;
+  margin-top: 1em;
+  font-weight: bold;
+}
+
+.box {
+  margin-left: 1.5em;
+  margin-right: 1.5em;
+  border-width: 1px;
+  border-style: solid;
+}
+
+.code {
+  margin-left: 2.5em;
+  margin-right: 1em;
+  padding: .5em;
+  border-left-width: 3px;
+  border-left-style: solid;
+}
+
+li .code {
+  margin-left: 1em;
+}
+
+a { text-decoration: none; }
+a:hover { text-decoration: underline; }
+
+.srclink {
+  text-decoration: none;
+  background-color: #e0e0e0;
+  padding: 2px;
+/*  font-size: 100%; */
+}
+.srclink:hover {
+  text-decoration: none;
+}
+
+hr { margin-top: 2em; }
+
+
+
+.dat_long {
+    border-left-style: solid;
+    border-left-width: 2px;
+    margin-left: .2em;
+    padding-left: 1em;
+}
+
+/* Extra stuff for Symbolic Test Vectors at Centaur */
+
+
+.stv {
+  margin-left: 1em;
+  border: 1px;
+  border-color: black;
+  border-style: solid;
+}
+
+.stv th {
+  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
+}
+
+.stv td {
+  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
+
+  text-align: right;
+  padding-left: .5em;
+  padding-right: .5em;
+}
+
+.stv_labels {
+  background-color: #e0ffc3;
+}
+
+.stv_labels th:nth-child(even) {
+  background-color: #e9ffd6;
+}
+
+.stv_labels th {
+  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
+  text-align: left;
+
+  border-bottom: 2px;
+  border-bottom-style: solid;
+  border-bottom-color: #b0dda3;
+
+  border-right: 1px;
+  border-right-style: solid;
+  border-right-color: #b0dda3;
+}
+
+.stv_input_line {
+  background-color: #ffe0c3;
+}
+
+.stv_input_line td:nth-child(even) {
+  background-color: #ffe9d6;
+}
+
+.stv_input_line td {
+  border-bottom: 1px;
+  border-bottom-color: #ddb0a3;
+  border-bottom-style: solid;
+  border-right: 1px;
+  border-right-style: solid;
+  border-right-color: #ddb0a3;
+}
+
+
+.stv_output_line {
+    background-color: #c3e0ff;
+}
+
+.stv_output_line td:nth-child(even) {
+  background-color: #d6e9ff;
+}
+
+.stv_output_line td {
+  border-bottom: 1px;
+  border-bottom-color: #a3b0dd;
+  border-bottom-style: solid;
+  border-right: 1px;
+  border-right-style: solid;
+  border-right-color: #a3b0dd;
+}
+
+
+.stv_internal_line {
+    background-color: #ff0000; /* bozo fix colors */
+}
+
+.stv_internal_line td:nth-child(even) {
+  background-color: #ffcc00; /* bozo fix colors */
+}
+
+.stv_internal_line td {
+  border-bottom: 1px;
+  border-bottom-color: #000000; /* bozo fix colors */
+  border-bottom-style: solid;
+  border-right: 1px;
+  border-right-style: solid;
+  border-right-color: #000000;
+}
+
+
+
+
+.stv_name {
+    border-right: 2px;
+    border-right-style: solid;
+    border-right-color: #000060;
+    text-align: left;
+    padding-right: 1em;
+}
\ No newline at end of file
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/view_flat.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/view_flat.png differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/view_tree.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/view_tree.png differ
diff -Nru acl2-6.2/books/xdoc/fancy/xdata2sql.pl acl2-6.3/books/xdoc/fancy/xdata2sql.pl
--- acl2-6.2/books/xdoc/fancy/xdata2sql.pl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/xdata2sql.pl	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,135 @@
+#!/usr/bin/env perl
+
+# XDOC Documentation System for ACL2
+# Copyright (C) 2009-2013 Centaur Technology
+#
+# Contact:
+#   Centaur Technology Formal Verification Group
+#   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+#   http://www.centtech.com/
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.  This program is distributed in the hope that it will be useful but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.  You should have received a copy of the GNU General Public
+# License along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+#
+# Original author: Jared Davis <jared@centtech.com>
+
+use warnings;
+use strict;
+use DBI;
+use JSON::XS;
+
+print <<END;
+
+-------------------------------------------------------------------------------
+
+xdata2sql.pl: Convert xdata.js into xdata.db (an sqlite3 database)
+
+   NOTE: Most folks don\'t need to run this at all!
+         If you just want to:
+          - browse an XDOC manual on your local hard drive, or
+          - share an XDOC manual on your fast intranet
+         then ignore this script and just see index.html.
+
+The main use for this script is to share XDOC manuals on the internet.  In this
+scenario, just having the web browser load in the entire (generally 20+ MB)
+xdata.js file is not very practical, because some users will have slow
+connections and will take too long to load the file.
+
+There are many ways to solve this.  Our approach is to convert xdata.js into an
+sqlite3 database, and then use a server-side script that will allow us to
+access topics only as they are requested.
+
+-------------------------------------------------------------------------------
+
+END
+
+print "; Converting xdata.js\n\n";
+
+sub read_whole_file {
+  my $filename = shift;
+  open (my $fh, "<", $filename) or die("Can't open $filename: $!\n");
+  local $/ = undef;
+  my $ret = <$fh>;
+  close($fh);
+  return $ret;
+}
+
+if (! -f "xdata.js") {
+    print "Error: xdata.js not found.\n";
+    exit(1);
+}
+
+
+print "; Reading file\n";
+
+my $javascript = read_whole_file("xdata.js");
+
+
+print "; Checking file\n";
+
+my $json;
+my $start = "var xdata = ";
+if (length($start) < length($javascript)
+    && substr($javascript, 0, length($start)) eq $start
+    && substr($javascript, length($javascript)-1, 1) eq ";")
+{
+    my $stop = length($javascript) - length($start) - length(";");
+    $json = substr($javascript, length($start), $stop);
+}
+else {
+    print "Error: xdata.js does not have the expected format\n";
+    exit(1);
+}
+
+
+print "; Parsing JSON data.\n";
+my $xs = new JSON::XS;
+my $xdata = $xs->decode($json);
+if (!(ref($xdata) eq "HASH")) {
+    print "Error: JSON object within xdata.js not a hash?\n";
+    exit(1);
+}
+
+if (-f "xdata.db") {
+    print "; Deleting old xdata.db.\n";
+    unlink("xdata.db");
+}
+
+
+print "; Creating new xdata.db.\n";
+my $dbh = DBI->connect("dbi:SQLite:dbname=xdata.db", "", "",
+		       {RaiseError=>1, AutoCommit=>0})
+    or die $DBI::errstr;
+
+print "; Creating xdoc_data table.\n";
+
+$dbh->do("CREATE TABLE XTABLE ("
+	 . "XKEY TEXT PRIMARY KEY NOT NULL,"
+	 . "XDATA TEXT)");
+
+
+print "; Populating xdoc_data table.\n";
+my $query = $dbh->prepare("INSERT INTO XTABLE (XKEY, XDATA) VALUES (?, ?)");
+
+while(my ($key,$val) = each %$xdata)
+{
+    my $enc = $xs->encode($val);
+    $query->bind_param(1, $key);
+    $query->bind_param(2, $enc);
+    $query->execute();
+}
+
+$dbh->commit();
+$dbh->disconnect();
+
+print "; All done.\n\n";
+
+
+print "To actually use the database, see xdataget.pl.\n\n";
diff -Nru acl2-6.2/books/xdoc/fancy/xdataget.pl acl2-6.3/books/xdoc/fancy/xdataget.pl
--- acl2-6.2/books/xdoc/fancy/xdataget.pl	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/xdataget.pl	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+
+# XDOC Documentation System for ACL2
+# Copyright (C) 2009-2013 Centaur Technology
+#
+# Contact:
+#   Centaur Technology Formal Verification Group
+#   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+#   http://www.centtech.com/
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.  This program is distributed in the hope that it will be useful but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.  You should have received a copy of the GNU General Public
+# License along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+#
+# Original author: Jared Davis <jared@centtech.com>
+
+
+# xdataget.pl: look up a key (or several keys) from the XDATA SQL database.
+#
+# This is a companion script for xdata2sql.pl.
+# Typically the flow is:
+#   - Create xdata.js using xdoc::save.
+#   - Create xdata.db using xdata2sql.pl.
+#   - Run xdataget.pl keys=COMMON-LISP____APPEND:ACL2____TOP to test it
+#   - Copy xdata.db and xdataget.pl into your web server.
+#
+# Now if you point your browser to something like:
+#    http://server/cgi-bin/xdataget.pl?keys=COMMON-LISP____APPEND:ACL2____TOP
+#
+# And you should see a JSON reply.
+
+use warnings;
+use strict;
+use DBI;
+use CGI;
+
+my $cgi = CGI->new;
+print $cgi->header("application/json");
+
+my $arg = $cgi->param("keys") || "";
+
+if (!($arg =~ /^[A-Za-z0-9:._\-]*$/))
+{
+    print "{\"error\":\"keys contain illegal characters, rejecting to prevent xss attacks.\"}\n";
+    exit;
+}
+
+my @keys = split(':', $arg);
+
+if (! -f "xdata.db") {
+    print "{\"error\":\"xdata.db not found\"}\n";
+    exit;
+}
+
+my $dbh = DBI->connect("dbi:SQLite:dbname=xdata.db", "", "", {RaiseError=>1});
+my $query = $dbh->prepare("SELECT * FROM XTABLE WHERE XKEY=?");
+
+print "{\"results\":[\n";
+for(my $i = 0; $i < @keys; ++$i)
+{
+    my $key = $keys[$i];
+    $query->execute($key);
+    my $ret = $query->fetchrow_hashref();
+    if (!$ret) {
+	print "  \"Error: no such topic.\"";
+    }
+    else {
+	my $val = $ret->{"XDATA"};
+	print "  $val";
+    }
+    if ($i != @keys-1) {
+	print ",\n";
+    }
+}
+print "\n]}\n";
+
+$query->finish();
+$dbh->disconnect();
+
+
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/xdoc-home.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/xdoc-home.png differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/fancy/xdoc-logo.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/fancy/xdoc-logo.png differ
diff -Nru acl2-6.2/books/xdoc/fancy/xdoc.js acl2-6.3/books/xdoc/fancy/xdoc.js
--- acl2-6.2/books/xdoc/fancy/xdoc.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/xdoc.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,1004 @@
+/*
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+*/
+
+"use strict";
+
+var TOP_KEY = "ACL2____TOP";
+var xdata_loaded = false;
+var xdata = [];
+
+
+// --------------------------------------------------------------------------
+//
+//                         RANDOM UTILITIES
+//
+// --------------------------------------------------------------------------
+
+// Initialize an XSLT processor for XDOC --> HTML conversion
+var xslt_processor = new XSLTProcessor();
+{
+    var xslt_plain = $.base64.decode(xslt_base64);
+    var xslt_dom = $.parseXML(xslt_plain);
+    xslt_processor.importStylesheet(xslt_dom);
+}
+
+function wrap_xdoc_fragment(str) {
+    var wrap = "<!DOCTYPE xdoc [";
+    wrap += "<!ENTITY mdash \"&#8212;\">";
+    wrap += "<!ENTITY rarr \"&#8594;\">";
+    wrap += "<!ENTITY nbsp \"&#160;\">";
+    wrap += "]>";
+    wrap += "<root>" + str + "</root>";
+    return wrap;
+}
+
+function render_text (str) { // XDOC Markup (string) --> Plain Text Fragment
+    var xml = $.parseXML(wrap_xdoc_fragment(str));
+    var dom = xslt_processor.transformToFragment(xml,document);
+    var str = $(dom).text();
+
+    // It's not clear to me whether this is good or bad.  The basic problem
+    // is that strings like "short" strings might legitimately have quotes
+    // or apostrophes in them.  This is no problem if we're going to stick the
+    // render_text into a paragraph or something like that.  But it *is* a
+    // problem if we're going to stick it into an attribute like a tooltip
+    // or similar.  So, just to avoid problems like that, make sure the resulting
+    // string is free of " and ' characters.
+    return String(str)
+             .replace(/"/g, '&quot;')
+             .replace(/'/g, '&apos;');
+}
+
+var short_plaintext_cache = {};
+function topic_short_plaintext(key) {
+    if (key in short_plaintext_cache) {
+	return short_plaintext_cache[key];
+    }
+    var ret = render_text(topic_short(key));
+    short_plaintext_cache[key] = ret;
+    return ret;
+}
+
+function render_html (str) { // XDOC Markup (string) --> HTML DOM Fragment
+    var xml = $.parseXML(wrap_xdoc_fragment(str));
+    var dom = xslt_processor.transformToFragment(xml,document);
+    return dom;
+}
+
+function htmlEncode(value){
+  // copied from stackoverflow:1219860
+  return $('<div/>').text(value).html();
+}
+
+function alphanum(a, b) { // Alphanumeric comparison (for nice sorting)
+  // Credit: http://my.opera.com/GreyWyvern/blog/show.dml/1671288
+  function chunkify(t) {
+    var tz = [], x = 0, y = -1, n = 0, i, j;
+
+    while ((i = (j = t.charAt(x++)).charCodeAt(0))) {
+      var m = (i == 46 || (i >=48 && i <= 57));
+      if (m !== n) {
+        tz[++y] = "";
+        n = m;
+      }
+      tz[y] += j;
+    }
+    return tz;
+  }
+
+  var aa = chunkify(a);
+  var bb = chunkify(b);
+
+  for (var x = 0; aa[x] && bb[x]; x++) {
+    if (aa[x] !== bb[x]) {
+      var c = Number(aa[x]), d = Number(bb[x]);
+      if (c == aa[x] && d == bb[x]) {
+        return c - d;
+      } else return (aa[x] > bb[x]) ? 1 : -1;
+    }
+  }
+  return aa.length - bb.length;
+}
+
+function starts_with_alpha(str) {
+    var little_a = "a".charCodeAt(0);
+    var little_z = "z".charCodeAt(0);
+    var big_a = "A".charCodeAt(0);
+    var big_z = "Z".charCodeAt(0);
+    var code = str.charCodeAt(0);
+    return (little_a <= code && code <= little_z)
+        || (   big_a <= code && code <= big_z   );
+}
+
+var waitmsg = 0;
+function please_wait() {
+    var msgs = ["Still loading",
+                "Gah, what's taking so long?",
+                "Man, tubes must be clogged...",
+                "The boy has no patience.",
+                "It's not ready yet!",
+                "Dude, stop clicking already!"];
+    $("#still_loading").html("<p>" + msgs[waitmsg] + "</p>");
+    $("#still_loading").fadeIn(100).delay(500).fadeOut(100);
+    waitmsg = waitmsg + 1;
+    if (waitmsg == msgs.length)
+        waitmsg = msgs.length - 1;
+}
+
+
+// --------------------------------------------------------------------------
+//
+//                          MAIN DATA STRUCTURES
+//
+// --------------------------------------------------------------------------
+//
+// The XDOC database is split up into two files: XINDEX and XDATA.  Both of
+// these files are generated ahead of time by the ACL2 code for XDOC.
+//    - xindex is smaller and contains just the navigation data
+//    - xdata is larger and has the full "long" strings for each topic
+//
+// We load these files lazily to make the page seem to appear faster!  This
+// means you have to sort of be aware of when the data becomes available.  We
+// load xindex first, then once it's complete we load xdata.  The format of
+// xindex is described in xdoc_index.js.  The XDATA table is simpler:
+//
+//   xdata:         KEY -> {"pnames" : [array of xml encoded nice parent names],
+//                          "from"   : "xml encoded string for topic location",
+//                          "long"   : "xml encoded long topic description"}
+//
+// Except that we represent each entry with an array, instead of a hash, to
+// save a tiny amount of space.
+
+var XD_PNAMES = 0;
+var XD_FROM = 1;
+var XD_LONG = 2;
+
+function key_title(key)
+{
+    return (topic_exists(key))
+       ? ("XDOC &mdash; " + topic_name(key))
+       : ("XDOC &mdash; " + key);
+}
+
+function key_sorted_children(key) { // Returns a nicely sorted array of child_keys
+    var children = topic_child_keys(key);
+
+    var tmp = [];
+    for(var i in children) {
+        var child_key = children[i];
+        var rawname = topic_rawname(child_key);
+        tmp.push({key:child_key, rawname:rawname});
+    }
+    tmp.sort(function(a,b) { return alphanum(a.rawname, b.rawname); });
+
+    var ret = [];
+    for(var i in tmp) {
+        ret.push(tmp[i].key);
+    }
+    return ret;
+}
+
+function xdata_when_ready (keys, whenReady)
+{
+    var missing = [];  // Optimization, don't load keys we've already loaded
+    for(var i in keys) {
+        if (!xdata[keys[i]])
+            missing.push(keys[i]);
+    }
+
+    if (missing.length == 0) {
+        whenReady();
+        return;
+    }
+
+    if (!XDATAGET) {
+        // We're running in local mode, so we can't load any more data from
+        // the server.  Any missing keys are errors!
+        for(var i in missing)
+            xdata[missing[i]] = "Error: no such topic.";
+        whenReady();
+        return;
+    }
+
+    // Else, running on a server and missing some keys.  Try to load them.
+    var url = XDATAGET + "?keys=" + missing.join(":");
+
+    $.ajax({url: url,
+            type: "GET",
+            dataType: "json",
+            success: function(obj) {
+                var results = "results" in obj && obj["results"];
+                if (results && results.length == missing.length) {
+                    for(var i in results)
+                        xdata[missing[i]] = results[i];
+                }
+                else {
+                    var val = "Error: malformed reply from " + url;
+                    if ("error" in obj)
+                        val = obj["error"];
+                    for(var i in missing)
+                        xdata[missing[i]] = val;
+                }
+                whenReady();
+                return;
+            },
+            error: function(xhr, status, exception) {
+                var val = "Error: AJAX query failed."
+                        + "xhr status " + xhr.status
+                        + ", text" + xhr.responseText
+                        + ", exception" + exception;
+                for(var i in missing)
+                    xdata[missing[i]] = val;
+                whenReady();
+                return;
+            }});
+}
+
+
+// --------------------------------------------------------------------------
+//
+//                          NAVIGATION TREE
+//
+// --------------------------------------------------------------------------
+//
+// Turning the index into a navigation tree is made more complicated by the
+// following mismatch.
+//
+//    In the xindex, each topic can have many parents.
+//    In the navigation window we show a tree, i.e., there's just one parent!
+//
+// To reconcile this difference, we basically "replicate" topics in the tree.
+// For instance, we could show the user something like this:
+//
+//     TOP
+//      - Parent1
+//          OurTopic  -------+   (occurrence 1)
+//            Child1         |
+//            Child2         |   The topic and its children are "replicated"
+//      - Parent2            |
+//          OurTopic  -------+   (occurrence 2)
+//            Child1
+//            Child2
+//
+// The tricky part is: what happens when the user clicks on Occurrence 1 of
+// OurTopic?  In this case, we want to:
+//
+//     - hide/show the children only underneath occurrence 1, but
+//     - NOT change the state of occurrence 2 or its children!
+//
+// This means that we need to be able to distinguish between OCCURRENCES of
+// topics, not just the topic names/keys themselves.
+//
+// To do this, we are going to dumbly assign a "unique identifiers" to each
+// node in the navigation window.
+//
+// To simplify some things, we insist that the TOP topic gets identifier 0.
+// But otherwise, there's no reason we even need to assign these indices until
+// we can see the node.  So we lazily assign IDs to other nodes, as they become
+// visible in the navigation window.  These assignments are stored in the ID
+// table:
+
+var nav_id_table = []; // map of ID to {"key":KEY,"ever_expanded":bool}
+
+function nav_make_node(key) {
+    // Create the navigation entry for a new occurrence of KEY.
+    var id = nav_id_table.length;
+    nav_id_table[id] = {"key":key, "ever_expanded":false};
+
+    var name = topic_name(key);
+    var tooltip = "<p>" + topic_short_plaintext(key) + "</p>";
+
+    var node = "<ul class=\"hindex\" id=\"_nav" + id + "\">";
+    node += "<li><nobr>";
+    if (topic_child_keys(key).length == 0) {
+        node += "<img src=\"leaf.png\"/>";
+    }
+    else {
+        node += "<a id=\"_nav_ilink" + id + "\" ";
+        node += " href=\"javascript:nav_expand(" + id + ")\">";
+        node += "<img src=\"plus.png\" id=\"_nav_img" + id + "\"/>";
+        node += "</a>";
+    }
+    node += "<a id=\"_golink" + id + "\" href=\"javascript:nav_go(" + id
+            + ")\" data-powertip=\"" + tooltip + "\">";
+    node += name;
+    node += "</a>";
+    node += "</nobr>";
+    node += "<li><ul class=\"hindex\" id=\"_nav_tree" + id + "\"></ul></li>";
+    return node;
+}
+
+function nav_activate_tooltip(id) {
+    // This sort of "should" be part of nav_make_node, but it can't be because
+    // the node has to be properly installed into the document before jquery
+    // can find it.
+    $("#_golink" + id).powerTip({placement:'se',smartPlacement: true});
+}
+
+function nav_expand(id) {
+    // The user has just clicked on a node.  We may or may not have expanded it
+    // already.  If we haven't expanded it before, we need to make nodes for
+    // its children and add them.  If we have expanded it already, then we must
+    // have subsequently collapsed it, and we just want to make it visible
+    // again.
+    $("#_nav_img" + id).attr("src", "minus.png");
+    $("#_nav_ilink" + id).attr("href", "javascript:nav_retract(" + id + ")");
+    var key = nav_id_table[id]["key"];
+
+    if(nav_id_table[id]["ever_expanded"]) {
+        $("#_nav_tree" + id).show();
+        return;
+    }
+
+    nav_id_table[id]["ever_expanded"] = true;
+    var children = key_sorted_children(key);
+
+    var start = nav_id_table.length; // stupid hack for tooltip activation
+    var exp = "";
+    for(var i in children) {
+        exp += nav_make_node(children[i]);
+    }
+    $("#_nav_tree" + id).append(exp);
+
+    // Activate only the tooltips that we have just added.  (If we try to
+    // activate them more than once, they don't seem to work.)
+    for(var i = start; i < nav_id_table.length; ++i) {
+        nav_activate_tooltip(i);
+    }
+}
+
+function nav_retract(id)
+{
+    $("#_nav_img" + id).attr("src", "plus.png");
+    $("#_nav_ilink" + id).attr("href", "JavaScript:nav_expand(" + id + ")");
+    $("#_nav_tree" + id).hide();
+}
+
+var nav_mode = "tree";
+var nav_tree_top = 0;
+var nav_flat_top = 0;
+var nav_flat_ever_shown = false;
+
+function nav_tree() {
+    if (!xindex_ready()) {
+        please_wait();
+        return;
+    }
+    if (nav_mode == "tree") { return; }
+    nav_flat_top = $("#left").scrollTop();
+    $("#left").scrollTop(nav_tree_top);
+    $("#flat").hide();
+    $("#nav").show();
+    nav_mode = "tree";
+}
+
+function nav_flat() {
+    if (!xindex_ready()) {
+        please_wait();
+        return;
+    }
+    if (nav_mode == "flat") { return; }
+    nav_tree_top = $("#left").scrollTop();
+    $("#left").scrollTop(nav_flat_top);
+    $("#nav").hide();
+    $("#flat").show();
+    nav_mode = "flat";
+
+    if (nav_flat_ever_shown) {
+       // Nothing to do, we've already built the flat index.
+       return;
+    }
+    $("#flat").html("<p>Loading...</p>");
+    nav_flat_ever_shown = true;
+
+    setTimeout(nav_flat_really_install, 10);
+}
+
+function nav_flat_really_install() {
+
+    var myarr = [];
+    var keys = all_keys();
+    for(var i in keys) {
+	var key = keys[i];
+        myarr.push({key:key, rawname: topic_rawname(key)});
+    }
+    myarr.sort(function(a,b) { return alphanum(a.rawname, b.rawname); });
+
+    var dl = jQuery("<ul></ul>");
+    var current_startchar = "";
+    for(var i in myarr) {
+        var key = myarr[i].key;
+        var name = topic_name(key);
+        var rawname = topic_rawname(key);
+        var tooltip = "<p>" + topic_short_plaintext(key) + "</p>";
+        if ((rawname.charAt(0) != current_startchar) && starts_with_alpha(rawname)) {
+            current_startchar = rawname.charAt(0).toUpperCase();
+            dl.append("<li class=\"flatsec\" id=\"flat_startchar_" + current_startchar + "\"><b>"
+                      + current_startchar + "</b></li>");
+        }
+
+        dl.append("<li><a class=\"flatnav\""
+                  + " href=\"JavaScript:action_go_key('" + key + "')\""
+                  + " data-powertip=\"" + tooltip + "\">"
+                  + name
+                  + "</li>");
+    }
+    $("#flat").html(dl);
+    $(".flatnav").powerTip({placement:'se',smartPlacement: true});
+}
+
+
+function nav_flat_tochar(c) {
+    nav_flat();
+    $("#left").scrollTop(0);
+    var target = $("#flat_startchar_" + c).offset().top;
+    var adjust = target - $("#left").offset().top;
+    $("#left").scrollTop(adjust);
+}
+
+function nav_go(id)
+{
+    var key = nav_id_table[id]["key"];
+    action_go_key(key);
+}
+
+
+
+// --------------------------------------------------------------------------
+//
+//                          MAIN DATA DISPLAY
+//
+// --------------------------------------------------------------------------
+//
+// My first cut at the data display didn't have any way to expand subtopics,
+// and that was nice and simple.  But subtopic expansion seems like a cool
+// feature.  To support it recursively, we run into the same multi-parent
+// problem as above in the hierarchical navigation tree.  The same solution
+// works again.  But this time we need to clear the ID table every time we
+// go to a new topic.
+
+var dat_id_table = []; // map of Occurrence ID to {"key":KEY,"ever_expanded":bool}
+
+function dat_load_parents(key) {
+    // Assumes xdata[key] is ready
+    var parent_keys = topic_parent_keys(key);
+    var parent_names = xdata[key][XD_PNAMES];
+    var acc = "";
+    if (parent_keys.length == 0) {
+        $("#parents").hide();
+        $("#parents").html("");
+        return;
+    }
+    acc += "<ul>";
+    for(var i in parent_keys) {
+        var pkey = parent_keys[i];
+        var pname = parent_names[i];
+        var tooltip = "Error: parent topic is missing!";
+        if (topic_exists(key)) {
+            tooltip = topic_short_plaintext(pkey);
+        }
+        acc += "<li>";
+        acc += "<a href=\"javascript:action_go_key('" + pkey + "')\""
+            + "data-powertip=\"<p>" + tooltip + "</p>\">";
+        acc += pname;
+        acc += "</a>";
+        acc += "</li>\n";
+    }
+    acc += "</ul>";
+    $("#parents").html(acc);
+    $("#parents a").powerTip({placement:'se',smartPlacement: true});
+    $("#parents").show();
+}
+
+function dat_short_subtopics(key)
+{
+    var children = key_sorted_children(key);
+
+    var dl = jQuery("<div></div>");
+    for(var i in children) {
+        var child_key = children[i];
+        dl.append("<dt><a href=\"javascript:action_go_key('" + child_key + "')\">"
+                  + topic_name(child_key)
+                  + "</dt>");
+        var dd = jQuery("<dd></dd>");
+        dd.append(render_html(topic_short(child_key)));
+        dl.append(dd);
+    }
+    return dl;
+}
+
+function dat_expand(dat_id)
+{
+    $("#_dat_img" + dat_id).attr("src", "collapse_subtopics.png");
+    $("#_dat_ilink" + dat_id).attr("href", "JavaScript:dat_collapse(" + dat_id + ")");
+    $("#_dat_short" + dat_id).hide();
+    $("#_dat_long" + dat_id).show();
+
+    if (dat_id_table[dat_id]["ever_expanded"] == true) {
+        // Already showed it, nothing more to do
+        return;
+    }
+
+    dat_id_table[dat_id]["ever_expanded"] = true;
+    var key = dat_id_table[dat_id]["key"];
+    var children = key_sorted_children(key);
+    xdata_when_ready(children,
+    function(){
+        var div = $("#_dat_long" + dat_id);
+        for(var i in children) {
+            var child_key = children[i];
+            div.append(dat_long_topic(child_key));
+            if (i != children.length - 1) {
+                div.append("<hr></hr>");
+            }
+        }
+    });
+}
+
+function dat_collapse(dat_id)
+{
+    $("#_dat_img" + dat_id).attr("src", "expand_subtopics.png");
+    $("#_dat_ilink" + dat_id).attr("href", "JavaScript:dat_expand(" + dat_id + ")");
+    $("#_dat_short" + dat_id).show();
+    $("#_dat_long" + dat_id).hide();
+}
+
+function dat_long_topic(key)
+{
+    // Assumes xdata[key] is ready
+    var dat_id = dat_id_table.length;
+    dat_id_table[dat_id] = {"key":key, "ever_expanded":false};
+
+    var div = jQuery("<div></div>");
+    if (!topic_exists(key)) {
+        div.append("<h3>Error: " + key + " not found</h3>");
+        return div;
+    }
+
+    var from = xdata[key][XD_FROM];
+    var fromp = (from == "Unknown")
+                   ? ""
+                   : "<p class='from'>" + xdata[key][XD_FROM] + "</p>";
+    var shortp;
+    if (key != TOP_KEY) {
+	div.append("<h1>" + topic_name(key) + "</h1>" + fromp);
+	shortp = jQuery("<p></p>");
+    } else {
+	div.append("<h1><img src='xdoc-logo.png'/></h1>");
+	shortp = jQuery("<p align='center'></p>");
+    }
+    shortp.append(render_html(topic_short(key)));
+    div.append(shortp);
+    div.append(render_html(xdata[key][XD_LONG]));
+    if (topic_child_keys(key).length != 0) {
+        var acc = "<h3>";
+        acc += "Subtopics ";
+        acc += "<a id=\"_dat_ilink" + dat_id + "\""
+                + " href=\"javascript:dat_expand(" + dat_id + ")\">";
+        acc += "<img id=\"_dat_img" + dat_id + "\""
+                + " src=\"expand_subtopics.png\" align=\"top\"/>";
+        acc += "</a>";
+        acc += "</h3>";
+        var sub = jQuery("<dl id=\"_dat_short" + dat_id + "\"></dl>");
+        sub.append(dat_short_subtopics(key));
+        div.append(acc);
+        div.append(sub);
+        div.append("<div id=\"_dat_long" + dat_id + "\" "
+                   + "style=\"display:none\" class=\"dat_long\"></dl>");
+    }
+
+    return div;
+}
+
+function dat_load_key(key)
+{
+    // BOZO consider doing something to find the key in the navigation
+    // hierarchy somewhere, to make the navigation follow along with you?
+    var keys = [key];
+    xdata_when_ready(keys,
+    function() {
+        $("#parents").html("");
+        $("#data").html("");
+        $("#right").scrollTop(0);
+        dat_id_table = [];
+        dat_load_parents(key);
+        $("#data").append(dat_long_topic(key));
+        $("title").html(key_title(key));
+    });
+}
+
+
+
+
+// --------------------------------------------------------------------------
+//
+//                          SEARCHING FEATURE
+//
+// --------------------------------------------------------------------------
+
+var short_tokens_initialized = false;
+var short_tokens = {};
+
+function search_tokenize(plaintext) {
+    var tokens = plaintext.toLowerCase().split(/[ \t\n:]+/);
+    if (tokens.length == 1 && tokens[0] == "") {
+	// Correct for ridiculous behavior of string.split
+	return [];
+    }
+    for(var i in tokens) {
+	var orig = tokens[i];
+	var trim = orig.replace(/^[()"'`.,;?!]*/, '')
+	               .replace(/[()"'`.,;?!]*$/, '');
+	tokens[i] = trim;
+    }
+    return tokens;
+}
+
+function make_short_tokens() {
+    if (short_tokens_initialized)
+	return;
+    var keys = all_keys();
+    for(var i in keys) {
+	var key = keys[i];
+	var name = topic_name(key);
+	var rawname = topic_rawname(key);
+	var plaintext = topic_short_plaintext(key);
+	var tokens = search_tokenize(name + " " + rawname + " " + plaintext);
+	short_tokens[key] = tokens;
+    }
+    short_tokens_initialized = true;
+}
+
+function subarray_at_offsetp (a, b, n) {
+    // Does array A occur at array B, starting from position N?
+    var al = a.length;
+    var bl = b.length - n;
+    if (al > bl) {
+	return false;
+    }
+    for(var i = 0; i < al; ++i) {
+	if (a[i] != b[(i+n)])
+	    return false;
+    }
+    return true;
+}
+
+function subarrayp (a, b) {
+    var al = a.length;
+    var bl = b.length;
+    if (al == 0) return true;
+    if (al > bl) return false;
+    var stop = (bl-al)+1;
+    for(var i = 0; i < stop; ++i) {
+	if (subarray_at_offsetp(a,b,i))
+	    return true;
+    }
+    return false;
+}
+
+function search_submit() {
+    var str = $("#searchbox").val();
+    var str_url = encodeURIComponent(str);
+    var str_html = "XDOC Search &mdash; " + htmlEncode(str);
+    window.history.pushState({"search":str}, str_html, "?search=" + str_url);
+    search_go(str);
+}
+
+function search_go(str) {
+    // Kludgy: get the page ready to receive data.
+    $("#parents").html("");
+    $("#parents").hide();
+
+    $("#data").html("");
+    $("#right").scrollTop(0);
+
+    $("#data").append("<p><b style='color: red'>Note:</b> <i>search is extremely beta.</i> "
+		      + "It doesn't even search the <tt>:long</tt> sections yet.</p>");
+
+    $("#data").append("<p id='searching_message'>Searching (takes much longer the first time)...</p>");
+
+    var query = search_tokenize(str);
+
+    // Now wait a bit to allow that to render, before starting the search.
+    setTimeout(search_go_main, 10, query);
+    return false;
+}
+
+function search_add_hit(matches, hits, key) {
+    if (key in matches) {
+	// already showed this result, don't show it again
+	return;
+    }
+    matches[key] = 1;
+    hits.append("<dt><a href=\"javascript:action_go_key('" + key + "')\">"
+		+ topic_name(key)
+		+ "</a>"
+//		+ " (" + topic_uid(key) + ")" // nice for debugging
+		+ "</dt>");
+    var dd = jQuery("<dd></dd>");
+    dd.append(render_html(topic_short(key)));
+    hits.append(dd);
+}
+
+function search_go_main(query) {
+    make_short_tokens();
+
+    $("#searching_message").hide();
+    if (query.length == 0) {
+	$("#data").append("<h3>No results (empty search)</h3>");
+	return;
+    }
+
+    var query_str = query.join(" ");
+    $("#data").append("<h1><u>" + htmlEncode(query_str) + "</u></h1>");
+
+    // Matches will just bind keys we've already shown, so we don't repeatedly
+    // shown a topic just because it matches multiple criteria.
+    var matches = {};
+
+    // Hits will collect all the results
+    var hits = jQuery("<dl></dl>");
+    var keys = all_keys();
+
+    // We'll start with a stupid topic name search, in case there are any very
+    // exact hits.
+    for(var i in keys) {
+	var key = keys[i];
+	var name = topic_rawname(key);
+	var tokens = search_tokenize(name);
+	if (subarrayp(query,tokens))
+	    search_add_hit(matches, hits, key);
+    }
+
+    // Next, expand to a basic topic name substring search
+    for(var i in keys) {
+	var key = keys[i];
+	var name = topic_rawname(key);
+	if (name.toLowerCase().indexOf(query_str) != -1)
+	    search_add_hit(matches, hits, key);
+    }
+
+    // Next expand to a short-string search
+    for(var i in keys) {
+	var key = keys[i];
+	var tokens = short_tokens[key];
+	var uid = topic_uid(key);
+	if (subarrayp(query, tokens))
+	    search_add_hit(matches, hits, key);
+    }
+
+    var num_hits = Object.keys(matches).length;
+    if (num_hits != 0) {
+	$("#data").append("<h3><b>" + num_hits + "</b> Results</h3>");
+	$("#data").append(hits);
+    }
+    else {
+	$("#data").append("<h3>No results</h3>");
+    }
+
+    return;
+}
+
+
+
+
+
+// --------------------------------------------------------------------------
+//
+//                    DATA LOADING / INITIALIZATION
+//
+// --------------------------------------------------------------------------
+
+$(document).ready(function()
+{
+    LazyLoad.js('xindex.js', onIndexLoaded);
+    $(".toolbutton").powerTip({placement:'se'});
+});
+
+
+function jump_init() {
+
+    var ta_data = [];
+    var keys = all_keys();
+    for(var i in keys) {
+	var key = keys[i];
+        var tokens = [];
+        tokens.push(topic_rawname(key));
+        var entry = {"value": key,
+                     "nicename": topic_name(key),
+                     "short": render_text(topic_short(key)),
+                     "tokens": tokens};
+        ta_data.push(entry);
+    }
+
+    $("#jump").typeahead([{
+            name: "topics",
+            local: ta_data,
+            limit: 6,
+	autoselect: 'first',
+            template: "<p><b class=\"sf\">{{{nicename}}}</b> &mdash; {{{short}}}<br/>"
+                     + "<tt>{{value}}</tt></p>",
+            engine: Hogan
+    }]);
+
+    $("#jump").bind('typeahead:selected', jump_go);
+    $("#jump").bind('typeahead:autocompleted', jump_go);
+    $("#jumpmsg").powerTip({placement:'se'});
+    $("#jump").attr("placeholder", "append");
+    $("#jump").removeAttr("disabled");
+}
+
+function jump_go(obj,datum) {
+    var key = datum["value"];
+    if (topic_exists(key))
+        action_go_key(key);
+    else
+        alert("Invalid key " + key);
+    $("#jump").val("");
+    $("#jump").typeahead('setQuery', '');
+}
+
+function search_init() {
+    $("#searchbox").attr("placeholder", "files");
+    $("#searchbox").removeAttr("disabled");
+}
+
+
+
+
+
+function onIndexLoaded()
+{
+    xindex_init();
+
+    if (XDATAGET == "") {
+        // Load xdata.js after xindex_init() because that way we know the
+        // index is fully initialized by the time we run onDataLoaded.
+        LazyLoad.js('xdata.js', onDataLoaded);
+    }
+    else {
+        // Running with the support of a server.  We can just regard the data
+        // as already loaded.
+        onDataLoaded();
+    }
+
+    var acc = "";
+    var chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+    for(var i in chars) {
+        var c = chars.charAt(i);
+        acc += "<a href=\"javascript:nav_flat_tochar('" + c + "')\">" + c + "</a>";
+        if (c == "M")
+            acc += "<br/>";
+    }
+    $("#letters").html(acc);
+
+    var top_node = nav_make_node(TOP_KEY);
+    $("#nav").html(top_node);
+    nav_expand(0);
+    nav_activate_tooltip(0);
+
+    jump_init();
+    search_init();
+}
+
+
+
+function onDataLoaded()
+{
+    xdata_loaded = true;
+    var params = getPageParameters();
+
+    if ("search" in params) {
+	var str = params["search"];
+	var str_url = encodeURIComponent(str);
+	var str_html = htmlEncode(str);
+	window.history.replaceState({"search":str}, str_html, "?search=" + str_url);
+	search_go(str);
+    }
+
+    else {
+	var key = params["topic"] || TOP_KEY;
+	if (!key.match(/^[A-Za-z0-9._\-]*$/)) {
+	    $("#right").html("Illegal topic name, rejecting to prevent XSS attacks.");
+	    return;
+	}
+	window.history.replaceState({"key":key}, key_title(key), "?topic=" + key);
+	dat_load_key(key);
+    }
+
+    window.addEventListener('popstate',
+                            function(event) {
+                                action_go_back(event.state);
+                            });
+}
+
+function getPageParameters ()
+{
+   var ret = {};
+   if (!window.location.toString().match(/\?(.+)$/)) {
+       return ret;
+   }
+   var param_strs = RegExp.$1.split("&");
+   var param_arr = {};
+   for(var i in param_strs)
+   {
+      var tmp = param_strs[i].split("=");
+      var key = decodeURI(tmp[0]);
+      var val = decodeURI(tmp[1]);
+      param_arr[key] = val;
+   }
+   return param_arr;
+}
+
+
+function srclink(key)
+{
+    // BOZO stupid hack, eventually generate this without the .xdoc-link part.
+    key = key.replace(".xdoc-link", "");
+    var rawname = key;
+    if (topic_exists(key)) {
+        rawname = topic_rawname(key);
+    }
+
+    // Fancy Data URL generator
+    var srclink_header =
+        "; -*- mode: xdoc-link -*-\n" +
+        "; This is an XDOC Link file.\n" +
+        "; Ordinarily, you should not see this file.\n" +
+        ";\n" +
+        "; If you are viewing this file in a web browser, you probably\n" +
+        "; have not configured your web browser to send .xdoc-link files\n" +
+        "; to Emacs.\n" +
+        ";\n" +
+        "; If you are viewing this file in Emacs, you probably have not\n" +
+        "; loaded xdoc.el from the xdoc/ directory.\n" +
+        ";\n" +
+        "; For more information, please see \"Emacs Links\" in the XDOC\n" +
+        "; manual.\n\n"
+
+    window.open('data:application/x-acl2-xdoc-link;charset=utf-8,' +
+    encodeURIComponent(srclink_header + rawname));
+}
+
+function action_go_key(key)
+{
+    if (!xdata_loaded) {
+        please_wait();
+        return;
+    }
+    window.history.pushState({"key":key}, key_title(key), "?topic=" + key);
+    dat_load_key(key);
+}
+
+function action_go_back(data) {
+    if ("search" in data) {
+	var str = data["search"];
+	search_go(str);
+    }
+    var key = ("key" in data) ? data["key"] : null;
+    if (key) {
+        dat_load_key(key);
+    }
+}
+
+
+
diff -Nru acl2-6.2/books/xdoc/fancy/xdoc_index.js acl2-6.3/books/xdoc/fancy/xdoc_index.js
--- acl2-6.2/books/xdoc/fancy/xdoc_index.js	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fancy/xdoc_index.js	2013-09-30 17:52:14.000000000 +0000
@@ -0,0 +1,146 @@
+/*
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+*/
+
+"use strict";
+
+// Public:
+//
+//    xindex_ready() -> Bool  -- Has the xindex been loaded and initialized?
+//                               May be called at any time.
+//
+//    xindex_init();     -- Prepare the index for use.
+//                          Must only be called after loading xindex.js
+//                          Must be called before using the below functions
+//
+//    all_keys() -> [array of all valid keys]
+//
+//    uid_to_key        : UID -> KEY
+//
+//    topic_exists      : KEY -> bool
+//    topic_uid         : KEY -> unique integer identifier
+//    topic_name        : KEY -> xml encoded nice topic name
+//    topic_rawname     : KEY -> non-encoded symbol-name (no package)
+//    topic_short       : KEY -> xml encoded short topic description
+//    topic_parent_keys : KEY -> [array of KEYS of parents]
+//    topic_child_keys  : KEY -> [array of KEYS of children]
+//
+//
+// Implementation details:
+//
+// The file xindex.js contains most of the XDOC database (the metadata like
+// topic names, parents, keys---everything but the :long data).  This is a
+// lot of data so we load it lazily.  Once xindex.js is loaded, we just end
+// up with the "xindex" variable loaded.
+//
+// "xindex" contains the data in a somewhat compressed form.  To reduce its
+// size, we leave out some information that we can reconstruct, e.g., the
+// children of each topic.  So there's a little work we need to decode the
+// xindex and turn it into a suitable table.
+//
+// We want to separate the format of xindex.js from the rest of the viewer
+// application, and hence be able to easily change the format.
+//
+// The xindex holds an array of entries.  The UID for each topic is implicitly
+// just its position in the array.
+//
+// Format of each entry (xdoc/save-fancy.lisp:json-encode-index-entry)
+//
+//      0     1      2         3         4
+//    [key, name, rawname, parentkeys, short]
+//
+// We translate the xindex into an "xhash" of the form:
+//
+//             0    1      2         3          4           5       6
+//    KEY -> [uid, name, rawname, parentuids, parentkeys, short, childkeys].
+
+var xindex_loaded = false;
+var xhash = {};
+
+function xindex_ready()
+{ return xindex_loaded; }
+
+function all_keys()
+{ return Object.keys(xhash); }
+
+function topic_exists(key)
+{ return key in xhash; }
+
+function topic_uid(key)
+{ return key in xhash ? xhash[key][0] : null; }
+
+function topic_name(key)
+{ return key in xhash ? xhash[key][1] : "Error: Key " + key + " not found"; }
+
+function topic_rawname(key)
+{ return key in xhash ? xhash[key][2] : "Error: Key " + key + " not found"; }
+
+function topic_parent_keys(key)
+{ return key in xhash ? xhash[key][4] : []; }
+
+function topic_short(key)
+{ return key in xhash ? xhash[key][5] : "Error: Key " + key + " not found"; }
+
+function topic_child_keys(key)
+{ return key in xhash ? xhash[key][6] : []; }
+
+function xindex_init()
+{
+    // Fill in most of the xhash directly from the xindex
+    for(var uid in xindex) {
+	var entry = xindex[uid];
+	var key = entry[0];
+	var name = entry[1];
+	var rawname = entry[2];
+	var parentuids = entry[3];
+	var shortstr = entry[4];
+	xhash[key] = [uid,name,rawname,parentuids,[],shortstr,[]];
+    }
+
+    // Fill in the parent_keys by resolving all parent uids
+    var xl = xindex.length;
+    for(var key in xhash) {
+	var parentuids = xhash[key][3];
+	for(var i in parentuids) {
+	    var uid = parentuids[i];
+	    var parentkey = (0 <= uid && uid < xl)
+	                      ? xindex[uid][0]
+	                      : "XDOC____ERROR-BROKEN-PARENT";
+	    xhash[key][4].push(parentkey);
+	}
+    }
+
+    // Fill in all child_keys by cross-referencing parents
+    for(var child_key in xhash) {
+        var parent_keys = topic_parent_keys(child_key);
+        for(var i in parent_keys) {
+            var parent_key = parent_keys[i];
+            // It's incorrect, but possible for a child topic to list parents
+            // that don't exist, so we have to make sure it really exists:
+            if (parent_key in xhash) {
+                var parent_node = xhash[parent_key];
+                parent_node[6].push(child_key);
+            }
+        }
+    }
+
+    xindex_loaded = true;
+}
diff -Nru acl2-6.2/books/xdoc/fmt-to-str.lisp acl2-6.3/books/xdoc/fmt-to-str.lisp
--- acl2-6.2/books/xdoc/fmt-to-str.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/fmt-to-str.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,86 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+
+; fmt-to-str.lisp -- alternative to fmt-to-string with narrower margins
+; and downcased symbols
+
+(in-package "XDOC")
+(include-book "tools/bstar" :dir :system)
+(set-state-ok t)
+(program)
+
+(defun fmt-to-str (x base-pkg state)
+
+; Use ACL2's fancy new string-printing stuff to pretty-print an object into a
+; string.
+
+  (b* ((hard-right-margin   (f-get-global 'acl2::fmt-hard-right-margin state))
+       (soft-right-margin   (f-get-global 'acl2::fmt-soft-right-margin state))
+       (print-case          (f-get-global 'acl2::print-case state))
+       (pkg                 (current-package state))
+       (state               (set-fmt-hard-right-margin 68 state))
+       (state               (set-fmt-soft-right-margin 62 state))
+       (state               (set-print-case :downcase state))
+
+       ((mv er ?val state)  (acl2::in-package-fn (symbol-package-name base-pkg) state))
+       ((when er)
+        (er hard? 'fmt-to-str "Error switching to package ~x0~%"
+            (symbol-package-name base-pkg))
+        (mv "" state))
+
+       ((mv channel state)  (open-output-channel :string :character state))
+       ((mv & state)        (fmt1 "~x0" (list (cons #\0 x)) 0 channel state nil))
+
+       ((mv er str state)  (get-output-stream-string$ channel state))
+       ((when er)
+        (er hard? 'fmt-to-str "Error with get-output-stream-string$???")
+        (mv "" state))
+
+       ((mv er ?val state) (acl2::in-package-fn pkg state))
+       ((when er)
+        (er hard? 'fmt-to-str "Error switching back to package ~x0~%" pkg)
+        (mv "" state))
+
+       (state               (set-fmt-hard-right-margin hard-right-margin state))
+       (state               (set-fmt-soft-right-margin soft-right-margin state))
+       (state               (set-print-case print-case state)))
+    (mv str state)))
+
+(defun simple-html-encode-str (x n xl acc)
+
+; Revappend the HTML encoding of X (e.g., & --> &amp;) onto ACC.
+
+  (b* (((when (int= n xl))
+        acc)
+       (char1 (char x n))
+       (acc   (case char1
+                (#\< (list* #\; #\t #\l #\& acc))         ;; "&lt;" (in reverse)
+                (#\> (list* #\; #\t #\g #\& acc))         ;; "&gt;"
+                (#\& (list* #\; #\p #\m #\a #\& acc))     ;; "&amp;"
+                (#\" (list* #\; #\t #\o #\u #\q #\& acc)) ;; "&quot;"
+                (t   (cons char1 acc)))))
+    (simple-html-encode-str x (+ 1 n) xl acc)))
+
+(defun fmt-and-encode-to-acc (x base-pkg state acc)
+  ;; Basic encoding of sexprs with no autolinking.
+  (b* (((mv str state) (fmt-to-str x base-pkg state))
+       (acc (simple-html-encode-str str 0 (length str) acc)))
+    (mv acc state)))
diff -Nru acl2-6.2/books/xdoc/import-acl2doc.lisp acl2-6.3/books/xdoc/import-acl2doc.lisp
--- acl2-6.2/books/xdoc/import-acl2doc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/import-acl2doc.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,309 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "ACL2") ;; So the acl2 topic comes from the acl2 package.
+(include-book "write-acl2-xdoc")
+(include-book "system/origin" :dir :system)
+(set-state-ok t)
+(program)
+
+(defdoc broken-link
+  ;; Keep topic name in sync with write-acl2-xdoc.lisp
+  ":Doc-Section Documentation
+Placeholder for undocumented topics~/
+
+This topic is used as a placeholder in XDOC when an imported ACL2
+documentation topic (~pl[documentation]) topic, written in the classic
+~il[doc-string] format, links to an underfined topic.~/~/")
+
+#||
+
+;; To test broken-link handling, uncomment this and regenerate the manual.  We
+;; should be warned about the broken links, and they should take us to the
+;; broken-link topic.
+
+(defdoc broken-link-test
+  ":Doc-Section broken-link
+Test of broken links.  IL: ~il[test-broken-link]. ILC: ~ilc[test-broken-link].
+L: ~l[test-broken-link].  PL: ~pl[test-broken-link]~/
+
+This is a silly topic intended to test our linking to missing documentation.
+
+IL: ~il[test-broken-link]
+ILC: ~ilc[test-broken-link]
+L: ~l[test-broken-link]
+PL: ~pl[test-broken-link]~/~/")
+
+||#
+
+; Initial import of acl2 system documentation.  We do this before including any
+; books other than the basic portcullis, because we don't want any libraries
+; loaded when we import the system-level documentation.
+;
+; One other minor fixup: In ACL2, a top-level topic has a parent of itself.  We
+; change all such top-level topics so that they have a parent of acl2::acl2.
+
+#!XDOC
+(progn
+  (defun remove-alist-key (key x)
+    (cond ((atom x)
+           nil)
+          ((atom (car x))
+           (remove-alist-key key (cdr x)))
+          ((equal (caar x) key)
+           (remove-alist-key key (cdr x)))
+          (t
+           (cons (car x) (remove-alist-key key (cdr x))))))
+
+  (defun change-self-parent-to-acl2 (topic)
+    (let ((name    (cdr (assoc :name topic)))
+          (parents (cdr (assoc :parents topic))))
+      (if (member name parents)
+          (acons :parents
+                 (cons 'acl2::acl2 (remove-equal name parents))
+                 (remove-alist-key :parents topic))
+        topic)))
+
+  (defun change-self-parents-to-acl2 (topics)
+    (if (atom topics)
+        nil
+      (cons (change-self-parent-to-acl2 (car topics))
+            (change-self-parents-to-acl2 (cdr topics)))))
+
+  (defun add-from-acl2 (topics)
+    (if (atom topics)
+        nil
+      (cons (acons :from "ACL2 Sources" (car topics))
+            (add-from-acl2 (cdr topics)))))
+
+  (defun all-topic-names (topics)
+    (if (atom topics)
+        nil
+      (cons (cdr (assoc :name (car topics)))
+            (all-topic-names (cdr topics)))))
+
+  (defun remove-topics-by-name (topics names)
+    (cond ((atom topics)
+           nil)
+          ((member (cdr (assoc :name (car topics))) names)
+           (remove-topics-by-name (cdr topics) names))
+          (t
+           (cons (car topics) (remove-topics-by-name (cdr topics) names)))))
+
+  (make-event
+   (mv-let (er val state)
+     (time$ (acl2::write-xdoc-alist)
+            :msg "; Importing ground-zero acl2 :doc topics: ~st sec, ~sa bytes~%"
+            :mintime 1)
+     (declare (ignore er val))
+     (let* ((topics (acl2::f-get-global 'acl2::xdoc-alist state))
+            (topics (change-self-parents-to-acl2 topics))
+            (topics (add-from-acl2 topics)))
+       (value `(defconst *acl2-ground-zero-topics* ',topics))))))
+
+(include-book "base")
+(include-book "tools/bstar" :dir :system)
+
+;; Actually install the ground-zero topics
+#!XDOC
+(table xdoc 'doc
+
+; Something subtle about this is, what do we do if there is both an ACL2 :doc
+; topic and an XDOC topic?
+;
+; Originally we appended the *acl2-ground-zero-topics* to (get-xdoc-table
+; world), which meant that built-in ACL2 documentation "won" and overwrote the
+; xdoc documentation.  But when I documented the system/io.lisp book, I found
+; that this wasn't what I wanted, because it meant stupid tiny little
+; placeholder documentation for things like read-char$ was overwriting the much
+; nicer XDOC documentation for it.
+;
+; Arguably we should do some kind of smart merge, but, well, this *is* xdoc
+; after all.  So I'm just going to say ACL2 loses, and if someone cares enough
+; to come up with something better, power to them.
+
+       (append (get-xdoc-table world)
+               *acl2-ground-zero-topics*))
+
+(defxdoc acl2
+  :short "Documentation for the <a
+  href=\"http://www.cs.utexas.edu/users/moore/acl2\">ACL2 Theorem Prover</a>."
+  :long "<p>This is a parent topic for most <see topic=\"@(url
+documentation)\">ACL2 documentation</see> that is written in the classic @(see
+doc-string) format.  (We take some liberties with the hierarchy to integrate
+certain topics into more appropriate places.)</p>")
+
+(include-book "system/origin" :dir :system)
+
+(defun defdoc-include-book-path (name wrld)
+
+; Tool from Matt Kaufmann for figuring out where a DEFDOC event comes from.
+;
+; We return nil if there is no defdoc for name.  Otherwise, we return the
+; include-book path (with closest book first, hence opposite from the order
+; typically displayed by :pe) for the most recent defdoc of name, else t if
+; that path is nil.
+
+  (declare (xargs :mode :program))
+  (cond ((endp wrld)
+         nil)
+        (t (or (let ((x (car wrld)))
+                 (case-match x
+                   (('EVENT-LANDMARK 'GLOBAL-VALUE . event-tuple)
+                    (let ((form (access-event-tuple-form event-tuple)))
+                      (case-match form
+                        (('DEFDOC !name . &)
+                         ;; Matt's version didn't reverse these, but mine
+                         ;; does for compatibility with the origin book.
+                         (or (reverse (global-val 'include-book-path wrld))
+                             t)))))))
+               (defdoc-include-book-path name (cdr wrld))))))
+
+#!XDOC
+(defun extend-topic-with-origin (topic state)
+  ;; Returns (MV TOPIC STATE)
+  (b* ((name (cdr (assoc :name topic)))
+       (from (cdr (assoc :from topic)))
+
+       ((when from)
+        (er hard? 'extend-topic-with-origin
+            "Topic ~x0 already has :from." name)
+        (mv topic state))
+
+       ((unless (symbolp name))
+        (er hard? 'extend-topic-with-origin
+            "Topic with non-symbolic name ~x0" name)
+        (mv topic state))
+
+       ((mv er val state)
+        (acl2::origin-fn name state))
+       ((mv er val)
+        (b* (((unless er)
+              (mv er val))
+             ;; This can occur at least in cases such as DEFDOC, which do not
+             ;; introduce logical names.
+             ;(- (cw "~x0: unknown: ~@1~%" name er))
+             (new-val (acl2::defdoc-include-book-path name (w state)))
+             ((when new-val)
+              ;(cw "~x0: tried harder and found ~x1.~%" name new-val)
+              (mv nil new-val)))
+          ;(cw "~x0: tried harder and still failed." name)
+          (mv er val)))
+
+       ((when er)
+        (mv (acons :from "Unknown" topic)
+            state))
+
+       ((when (eq val :built-in))
+        ;;(cw "~x0: built-in~%" name)
+        (mv (acons :from "ACL2 Sources" topic)
+            state))
+
+       ((when (natp val))
+        ;;(cw "~x0: current session.~%" name)
+        (mv (acons :from "Current Interactive Session" topic)
+            state))
+
+       ((when (and (consp val)
+                   (string-listp val)))
+        (b* ((bookname (car (last val)))
+             (bookname (normalize-bookname bookname state)))
+          ;; (cw "~x0: ~x1~%" name bookname)
+          (mv (acons :from bookname topic)
+              state))))
+
+    (er hard? 'extend-topic-with-origin
+        "origin-fn returned unexpected value ~x0." val)
+    (mv topic state)))
+
+#!XDOC
+(defun extend-topics-with-origins (topics state)
+  (b* (((when (atom topics))
+        (mv nil state))
+       ((mv first state)
+        (extend-topic-with-origin (car topics) state))
+       ((mv rest state)
+        (extend-topics-with-origins (cdr topics) state)))
+    (mv (cons first rest) state)))
+
+#!XDOC
+(defmacro import-acl2doc ()
+  ;; This is for refreshing the documentation to reflect topics documented in
+  ;; libraries.  We throw away any defdoc topics for names that already have
+  ;; documentation.  This saves us the work of repeatedly importing
+  ;; documentation topics, and usually allows XDOC topics to override ACL2
+  ;; defdoc topics.
+  `(make-event
+    (b* ((all-topics (get-xdoc-table (w state)))
+         (names      (xdoc::all-topic-names all-topics))
+         (skip-fal   (make-fast-alist (pairlis$ names nil)))
+         ((mv ?er ?val state)
+          (time$ (acl2::write-xdoc-alist :skip-topics-fal skip-fal)
+                 :msg "~|; Importing acl2 :doc topics: ~st sec, ~sa bytes~%"
+                 :mintime 1))
+         (new-topics (acl2::f-get-global 'acl2::xdoc-alist state))
+         ((mv new-topics state)
+          (extend-topics-with-origins new-topics state)))
+      (value `(table xdoc 'doc
+                     (append ',new-topics (get-xdoc-table world)))))))
+
+
+#||
+;; Test code:
+
+(len (xdoc::get-xdoc-table (w state)))  ;; 1546
+(make-event
+ `(defconst *prev-names*
+    ',(xdoc::all-topic-names (xdoc::get-xdoc-table (w state)))))
+(include-book
+ "ihs/logops-lemmas" :dir :system)
+(len (xdoc::get-xdoc-table (w state)))  ;; 1546
+(time$ (xdoc::import-acl2doc))  ;; .2 seconds, converting all that ihs doc
+(len (xdoc::get-xdoc-table (w state)))  ;; 1841
+(set-difference-equal
+ (xdoc::all-topic-names (xdoc::get-xdoc-table (w state)))
+ *prev-names*)
+(time$ (xdoc::import-acl2doc))  ;; almost no time
+(len (xdoc::get-xdoc-table (w state))) ;; 1841
+
+
+(defun all-topic-froms (topics)
+  (if (atom topics)
+      nil
+    (cons (cdr (assoc :from (car topics)))
+          (all-topic-froms (cdr topics)))))
+
+(let ((topics (xdoc::get-xdoc-table (w state))))
+  (pairlis$ (xdoc::all-topic-names topics)
+            (all-topic-froms topics)))
+
+;; ACL2::UNSIGNED-BYTE-P-LEMMAS: unknown: Not logical name: 
+;; ACL2::UNSIGNED-BYTE-P-LEMMAS.
+;; ACL2::SIGNED-BYTE-P-LEMMAS: unknown: Not logical name: 
+;; ACL2::SIGNED-BYTE-P-LEMMAS.
+;; ACL2::IHS: unknown: Not logical name: ACL2::IHS.
+;; ACL2::DATA-STRUCTURES: unknown: Not logical name: ACL2::DATA-STRUCTURES.
+;; ACL2::B*-BINDERS: unknown: Not logical name: ACL2::B*-BINDERS.
+
+(acl2::defdoc-include-book-path 'acl2::ihs (w state))
+
+
+
+||#
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc/importance.lisp acl2-6.3/books/xdoc/importance.lisp
--- acl2-6.2/books/xdoc/importance.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/importance.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,740 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "XDOC")
+(include-book "parse-xml")
+(include-book "save-classic")
+(set-state-ok t)
+(program)
+
+(defun make-key (x)
+  (declare (type symbol x))
+  (str::rchars-to-string (file-name-mangle x nil)))
+
+(defun make-keys (x)
+  (declare (xargs :guard (symbol-listp x)))
+  (if (atom x)
+      nil
+    (cons (make-key (car x))
+          (make-keys (cdr x)))))
+
+
+; importance.lisp
+;
+; Apparently a way that real search engines produce useful results is to give
+; pages "importance" scores/ranks.  This lets them put the results of a query
+; into a good order, with important pages coming first.  In XDOC we can get a
+; lot of clues about a topic's importance, for instance,
+;
+;   - How far from the root is it?
+;   - How many other pages link to it? (if it's worth mentioning from other
+;     pages then it's likely to be important)
+;   - How many children does it have (a section with lots of subtopics is
+;     likely to be more major than a leaf topic.)
+;   - How much (preferably non-generated) content is there?  (a real www
+;     search engine wouldn't want to consider that because it could be
+;     easily gamed, but in our controlled environment it's probably a
+;     good indicator of how much content there is.)
+;
+; Our top level function is
+;
+;  (order-topics-by-importance all-topics state) --> (mv all-topics state)
+;
+; It just permutes the input topics into a "good" order so that "more
+; important" topics come first.  The goal is to improve the relevance of
+; results produced by search features, by allowing the search feature to assume
+; that the earlier topics are more important.
+;
+; Design decision: we target the post-preprocessing XML version of the data.
+; This way we can reuse our XML parser.  An alternative would be to target the
+; pre-preprocessing code; this might have some advantages in terms of being
+; able to identify generated versus typed-in content.  But maybe just looking
+; at <code> tags is enough to avoid those kinds of problems.
+;
+; Quick and dirty: We'll do all the preprocessing and XML parsing ahead of time
+; so that we can just have straight up token lists to deal with.  We'll call
+; these post-preprocessing, pure XML topics "XTOPICS".  While we collect these,
+; we'll collect up some heuristically interesting data, e.g., all of the links
+; to other topics that are NOT in <code> tags (to avoid counting generated
+; autolinks) while we generate these xtopics.
+
+(cutil::def-primitive-aggregate xtopic
+  (name         ; copy of :name from normal topic
+   base-pkg     ; copy of base-pkg from normal topic
+   parents      ; copy of parents from normal topic
+   short-tokens ; already preprocessed
+   long-tokens  ; already preprocessed
+   links        ; collected up links (short+long combined) keys (i.e., "ACL2____FOO")
+   size         ; heuristic for how much content there is
+   ))
+
+(defun xtopiclist->names (x)
+  (if (atom x)
+      nil
+    (cons (xtopic->name (car x))
+          (xtopiclist->names (cdr x)))))
+
+(defun xtopiclist->sizes (x)
+  (if (atom x)
+      nil
+    (cons (xtopic->size (car x))
+          (xtopiclist->sizes (cdr x)))))
+
+(defun find-xtopic (name xtopics)
+  (cond ((atom xtopics)
+         nil)
+        ((equal name (xtopic->name (car xtopics)))
+         (car xtopics))
+        (t
+         (find-xtopic name (cdr xtopics)))))
+
+(defun extract-links
+  (ctx       ; Context for warnings about malformed XML
+   tokens    ; Tokens (see parse-xml.lisp) we are processing
+   open-tags ; Stack of currently open tags (so we can see if we're in <code>)
+   )
+  ; Returns the list of "file names" / "keys" / "topic urls" that we have
+  ; found, i.e., if the tokens contain <see topic="ACL2____CAR">, then our
+  ; results list will include ACL2____CAR.
+  (b* (((when (atom tokens))
+        nil)
+
+       (token1 (car tokens))
+       ((when (closetok-p token1))
+        (extract-links ctx (cdr tokens) (cdr open-tags)))
+       ((unless (opentok-p token1))
+        (extract-links ctx (cdr tokens) open-tags))
+
+       (tagname (opentok-name token1))
+       (open-tags (cons tagname open-tags))
+
+       ((unless (equal tagname "see"))
+        (extract-links ctx (cdr tokens) open-tags))
+
+       (atts  (opentok-atts token1))
+       (topic (cdr (assoc-equal "topic" atts)))
+       ((unless topic)
+        (cw "Warning: missing 'topic' in <see> tag, in ~x0, before ~x1."
+            ctx (take (min (len tokens) 10) tokens))
+        (extract-links ctx (cdr tokens) open-tags))
+
+       (in-code-p (member-equal "code" open-tags))
+       (rest (extract-links ctx (cdr tokens) open-tags)))
+    (if in-code-p
+        rest
+      (cons topic rest))))
+
+
+; Broken link reports.
+;
+; BOZO.  This really doesn't belong here at all.  But it's convenient to reuse
+; xtopics for this, since we already have gone to the work of extracting the
+; links from topic to topic, from both preprocessor and manually entered
+; <see topic='...'> tags.
+;
+; Terminology: if page A has a link to page B, then A is the "source" of the
+; link and B is the "target" of the link.
+;
+; Below, a LINKS-FAL is a fast alist that binds
+;
+;          TARGET (key) -> SOURCE LIST (names) 
+;
+; For instance, the LINKS-FAL might bind:
+;
+;       "ACL2____FOO" -> (ACL2::BAR ACL2::BAZ)
+;
+; When both ACL2::BAR and ACL2::BAZ have links to ACL2::FOO.
+
+(defun extend-links-fal
+  (source    ; symbol, name of the page we're processing
+   targets   ; string list, keys of the pages linked to from source
+   links-fal ; the fal being constructed
+   )
+  (declare (xargs :guard (and (stringp source)
+                              (symbol-listp targets))))
+  (b* (((when (atom targets))
+        links-fal)
+       (target1      (car targets))
+       (prev-sources (cdr (hons-get target1 links-fal)))
+       ((when (member source prev-sources))
+        (extend-links-fal source (cdr targets) links-fal))
+       (new-sources (cons source prev-sources))
+       (links-fal   (hons-acons target1 new-sources links-fal)))
+    (extend-links-fal source (cdr targets) links-fal)))
+
+(defun make-links-fal-aux (xtopics links-fal)
+  (b* (((when (atom xtopics))
+        links-fal)
+       (xtopic    (car xtopics))
+       (source    (xtopic->name xtopic))
+       (targets   (xtopic->links xtopic))
+       (links-fal (extend-links-fal source targets links-fal)))
+    (make-links-fal-aux (cdr xtopics) links-fal)))
+
+(defun make-links-fal (xtopics)
+  (b* ((links-fal (make-links-fal-aux xtopics nil))
+       (ans       (hons-shrink-alist links-fal nil)))
+    (fast-alist-free links-fal)
+    (fast-alist-free ans)
+    ans))
+
+(defun find-broken-links
+  (links-al   ; The (shrunk) links al we constructed above
+   keys-fal   ; Fast alist binding KEY to NIL for every defined topic
+   )
+  ;; returns a broken-links-al, which is a links-al but that only has entries
+  ;; for the topics that don't exist
+  (b* (((when (atom links-al))
+        nil)
+       ((cons target-key ?sources) (car links-al))
+       (look (hons-get target-key keys-fal))
+       ((when look)
+        ;; This is a defined topic, so nothing to report
+        (find-broken-links (cdr links-al) keys-fal)))
+    ;; This is NOT a defined topic, so keep it.
+    (cons (car links-al)
+          (find-broken-links (cdr links-al) keys-fal))))
+
+(defun sum-lengths (x)
+  (if (atom x)
+      0
+    (+ (length (car x))
+       (sum-lengths (cdr x)))))
+
+(defun report-broken-links-more-sources (sources)
+  (if (atom sources)
+      (cw ";;; ~%")
+    (progn$ (cw ";;; ~t0~s1~%" 12 (car sources))
+            (report-broken-links-more-sources (cdr sources)))))
+
+(defun report-broken-links-aux (links-al)
+  (b* (((when (atom links-al))
+        nil)
+       ((cons target sources) (car links-al)))
+    (cw ";;; ~s0:~%" target)
+    (cw ";;; ~t0 from ~s1~%" 6 (car sources))
+    (report-broken-links-more-sources (cdr sources))
+    (report-broken-links-aux (cdr links-al))))
+
+(defun report-broken-links (xtopics state)
+  (declare (xargs :stobjs state))
+  (b* ((links-fal (make-links-fal xtopics))
+       (keys-fal  (make-fast-alist
+                   (pairlis$ (make-keys (xtopiclist->names xtopics))
+                             nil)))
+       (broken (find-broken-links links-fal keys-fal))
+       (- (fast-alist-free links-fal))
+       (- (fast-alist-free keys-fal))
+       ((unless broken)
+        state)
+       (soft (acl2::fmt-soft-right-margin state))
+       (hard (acl2::fmt-hard-right-margin state))
+       (state (set-fmt-soft-right-margin 10000 state))
+       (state (set-fmt-hard-right-margin 10000 state))
+       (num (sum-lengths (strip-cdrs broken)))
+       (- (cw "~%;;; WARNING: Found ~x0 broken topic links: ~%" num)
+          (cw ";;;~%")
+          (report-broken-links-aux broken)
+          (cw ";;;~%"))
+       (state (set-fmt-soft-right-margin soft state))
+       (state (set-fmt-hard-right-margin hard state)))
+    state))
+
+
+; Size ranking.  Perhaps the simplest way to measure if a topic is "important"
+; is to just see how much content is has.  We'll regard the topic as more
+; important if it has more content.
+
+
+; Original attempt -- this didn't work well because converted defdoc topics
+; don't have any kind of sensible <p></p> structure, so even big topics like
+; set-gag-mode ended up with quite low scores.
+
+;; (defun text-length-through-close-paragraph (tokens acc)
+;;   (b* (((when (atom tokens))
+;;         acc)
+;;        (tok (car tokens))
+;;        (type (first tok))
+;;        ((when (equal type :close))
+;;         (let ((str (second tok)))
+;;           (if (equal str "p")
+;;               acc
+;;             (text-length-through-close-paragraph (cdr tokens) acc))))
+;;        ((when (equal type :text))
+;;         (let ((text (second tok)))
+;;           (text-length-through-close-paragraph (cdr tokens)
+;;                                                (+ acc (length text)))))
+;;        ((when (equal type :entity))
+;;         (text-length-through-close-paragraph (cdr tokens) (+ 1 acc))))
+;;     (text-length-through-close-paragraph (cdr tokens) acc)))
+
+;; (defun rough-size (tokens acc)
+;;   ;; Score for how much content a topic contains, just based on tags...
+;;   (b* (((when (atom tokens))
+;;         acc)
+;;        (type (caar tokens))
+;;        ((unless (eq type :open))
+;;         (rough-size (cdr tokens) acc))
+;;        (tagname (second (car tokens)))
+;;        ;; Don't use fractions smaller than 1/20 unless you adjust the size-int
+;;        ;; computation below.
+;;        (acc (cond ((member-equal tagname '("h1" "h2" "h3" "h4" "h5" "a"))
+;;                    ;; Structural tags indicate there is enough content to need
+;;                    ;; to be structured.  I also want links to external
+;;                    ;; resources to weigh heavily since they presumably lead to
+;;                    ;; additional information that's not in the manual.
+;;                    (+ 2 acc))
+;;                   ((member-equal tagname '("ul" "dl" "ol" "img"))
+;;                    (+ 1 acc))
+;;                   ((member-equal tagname '("li" "dt" "dd" "see" "code"))
+;;                    ;; Including code here helps cut down on automatically
+;;                    ;; generated stuff.
+;;                    (+ 1/10 acc))
+;;                   ((member-equal tagname '("tt" "b" "u" "i" "color" "sf" ))
+;;                    (+ 1/20 acc))
+;;                   ((member-equal tagname '("p"))
+;;                    (let ((len (text-length-through-close-paragraph (cdr tokens) 0)))
+;;                      (if (< len 50)
+;;                          ;; A very short paragraph.  Don't give this much credit.  This
+;;                          ;; helps to avoid inflating article scores just because they
+;;                          ;; have a long list of "Definition:", etc., as are generated
+;;                          ;; by defsection, etc.
+;;                          1/20
+;;                        1)))
+;;                   (t
+;;                    acc))))
+;;     (rough-size (cdr tokens) acc)))
+
+; The version below seems to work much better.  It could perhaps be tuned a
+; bit, but by rough inspection it does a pretty good job.
+
+(defun rough-size
+  (tokens    ; Tokens (see parse-xml.lisp) we are processing
+   open-tags ; Stack of currently open tags (so we can see if we're in <code>)
+   acc       ; Natural-number accumulator, the dumb heuristic weight we're assigning
+   )
+  ;; Returns the accumulated weight of the topic.  Note that we'll scale this
+  ;; down before installing it into the xtopic.
+  (b* (((when (atom tokens))
+        acc)
+
+       (tok  (car tokens))
+       (type (car tok))
+
+       ((when (eq type :close))
+        (rough-size (cdr tokens) (cdr open-tags) acc))
+
+       ((when (eq type :open))
+        (b* ((tagname (opentok-name tok))
+             (acc
+              ;; Extra bonuses for certain tags
+              (cond ((member-equal tagname '("h1" "h2" "h3" "h4" "h5" "a"))
+                     ;; Heading tags indicate there is enough content to need
+                     ;; to be structured.  I also want links to external
+                     ;; resources to weigh heavily since they presumably lead
+                     ;; to additional information that's not in the manual.
+                     ;; That is, pointers to papers, etc., may be very
+                     ;; valuable.
+                     (+ 50 acc))
+                    ((member-equal tagname '("ul" "dl" "ol" "img"))
+                     (+ 10 acc))
+                    ((member-equal tagname '("li" "dt" "dd" "see" "code" "p" "box"))
+                     ;; Including code here helps cut down on automatically
+                     ;; generated stuff.
+                     (+ 2 acc))
+                    ((member-equal tagname '("tt" "b" "u" "i" "color" "sf" ))
+                     (+ 1 acc))
+                    (t acc))))
+          (rough-size (cdr tokens) (cons tagname open-tags) acc)))
+
+       (len (if (eq type :text)
+                (length (texttok-text tok))
+              ;; An entity token is just one character
+              1))
+       (points (if (member-equal "code" open-tags)
+                   ;; Count anything in <code> tags for something, but not very
+                   ;; much, because it's often automatically generated.
+                   (floor len 5)
+                 len)))
+
+    (rough-size (cdr tokens) open-tags (+ points acc))))
+
+(defun xtopic-from-topic
+  (topic      ; ordinary xdoc topic to convert
+   topics-fal ; for the preprocessor
+   state      ; for the preprocessor
+   )
+  ; returns the corresponding xtopic
+  (b* ((name     (cdr (assoc :name topic)))
+       (base-pkg (cdr (assoc :base-pkg topic)))
+       (short    (or (cdr (assoc :short topic)) ""))
+       (long     (or (cdr (assoc :long topic)) ""))
+       (parents  (cdr (assoc :parents topic)))
+
+       ((mv long-rchars state) (preprocess-main long nil topics-fal base-pkg state nil))
+       (long-str (str::rchars-to-string long-rchars))
+       ((mv err long-tokens) (parse-xml long-str))
+       (state
+        (if err
+            (pprogn
+             (fms "~|~%WARNING: problem with :long in topic ~x0:~%"
+                  (list (cons #\0 name))
+                    *standard-co* state nil)
+             (princ$ err *standard-co* state)
+             (fms "~%~%" nil *standard-co* state nil))
+          state))
+       ((when err)
+        (mv nil state))
+
+       ((mv short-rchars state) (preprocess-main short nil topics-fal base-pkg state nil))
+       (short-str (str::rchars-to-string short-rchars))
+       ((mv err short-tokens) (parse-xml short-str))
+       (state
+        (if err
+            (pprogn
+               (fms "~|~%WARNING: problem with :short in topic ~x0:~%"
+                    (list (cons #\0 name))
+                    *standard-co* state nil)
+               (princ$ err *standard-co* state)
+               (fms "~%~%" nil *standard-co* state nil))
+          state))
+       ((when err)
+        (mv nil state))
+
+       (short-links (extract-links (list name :short) short-tokens nil))
+       (long-links  (extract-links (list name :long) long-tokens nil))
+
+       (raw-size (+ (rough-size short-tokens nil 0)
+                    (rough-size long-tokens nil 0)
+                    ;; Basic bonuses for having short/long sections
+                    (if (equal short "") 0 10)
+                    (if (equal long "")  0 30)))
+
+       (capped-size
+        ;; Just by rough inspection, it seems like topics that rack up 4000+
+        ;; points seem to be pretty good.  To avoid giving too much weight to
+        ;; very long topics, cap things at 4000 and then normalize down to a
+        ;; 1-100 scale.
+        (if (< raw-size 4000)
+            raw-size
+          4000))
+
+       (normalized-size
+        (floor capped-size 40))
+
+       (xtopic (make-xtopic :name name
+                            :base-pkg base-pkg
+                            :parents parents
+                            :short-tokens short-tokens
+                            :long-tokens long-tokens
+                            :links (append short-links long-links)
+                            :size normalized-size)))
+    (mv xtopic state)))
+
+(defun xtopics-from-topics-aux (topics topics-fal state)
+  (b* (((when (atom topics))
+        (mv nil state))
+       ((mv first state)
+        (xtopic-from-topic (car topics) topics-fal state))
+       ((mv rest state)
+        (xtopics-from-topics-aux (cdr topics) topics-fal state))
+       (ret (if first
+                (cons first rest)
+              rest)))
+    (mv ret state)))
+
+(defun xtopics-from-topics (topics state)
+  (b* ((topics-fal (topics-fal topics))
+       ((mv xtopics state)
+        (xtopics-from-topics-aux topics topics-fal state)))
+    (fast-alist-free topics-fal)
+    (mv xtopics state)))
+
+; Cross-reference/subtopic scoring.
+
+(defun dumb-increment-ranks
+  (keys      ; Keys whose rank should be incremented
+   rank-fal  ; Fast alist binding keys to their current ranks
+   by        ; Amount to increment the rank of each key in keys
+   )
+  (b* (((when (atom keys))
+        rank-fal)
+       (key      (car keys))
+       (curr     (nfix (cdr (hons-get key rank-fal))))
+       (rank-fal (hons-acons key (+ by curr) rank-fal)))
+    (dumb-increment-ranks (cdr keys) rank-fal by)))
+
+(defun dumb-rank-pages-aux
+  (xtopics     ; List of topics, which we iterate through
+   rank-fal    ; Fast alist binding keys to ranks, which we update
+   )
+  ;; This is our main routine for calculating linkage scores.  The weights here
+  ;; are somewhat arbitrary but seem (by some inspection) to produce reasonably
+  ;; good results
+  (b* (((when (atom xtopics))
+        rank-fal)
+       (rank-fal
+        ;; You get a point for existing at all.
+        (dumb-increment-ranks 
+         (list (make-key (xtopic->name (car xtopics))))
+         rank-fal
+         1))
+       ;; You get some points for every @(see foo) link pointed at you.
+       (rank-fal (dumb-increment-ranks (xtopic->links (car xtopics)) rank-fal 2))
+       ;; You get some points for every child topic you have.
+       (rank-fal (dumb-increment-ranks
+                  (make-keys (xtopic->parents (car xtopics))) rank-fal 5)))
+    (dumb-rank-pages-aux (cdr xtopics) rank-fal)))
+
+(defun rescale-page-ranks (rank-fal)
+  ;; Assumes rank-fal has been shrunk already.
+  (b* (((when (atom rank-fal))
+        nil)
+       ((cons name rank) (car rank-fal))
+       ;; By inspection, it seems that quite few pages rack up more than around
+       ;; 250 points.  But some pages get way more points than that.  To avoid
+       ;; letting extremely heavily linked pages racking up too many points, we
+       ;; cut off at 250 and then rescale down to 100.
+       (scaled-rank (floor (* 2 (min 250 rank)) 5)))
+    (cons (cons name scaled-rank)
+          (rescale-page-ranks (cdr rank-fal)))))
+
+(defun dumb-rank-pages (xtopics)
+  ;; Returns an alist mapping each KEY to its (rescaled) linkage weight.
+  (b* ((rank-fal (dumb-rank-pages-aux xtopics (len xtopics)))
+       (ans      (hons-shrink-alist rank-fal nil)))
+    (fast-alist-free rank-fal)
+    (fast-alist-free ans)
+    (rescale-page-ranks ans)))
+
+
+
+
+
+
+
+
+
+
+; Now we have two different sets of ranks: the size rank for the amount of
+; content, and the linkage rank for the number of cross-references/children.
+; We want to merge these into a unified score.
+
+(defun merge-ranks
+  (keys        ; list of keys that should typically be bound in the rank fals
+   ranks-fal1  ; fast alist mapping keys to ranks (of some kind)
+   ranks-fal2  ; fast alist mapping keys to ranks (of some other kind)
+   )
+  ;; Returns a new alist where each key is bound to the sum of its ranks in the
+  ;; two alists.  This is an especially simple and naive merge.  We *could*
+  ;; alter how these are merged to, e.g., say that size counts for 70% of your
+  ;; score and linkage only 30%, or similar.  Alternately, we could adjust the
+  ;; scaling factors above to achieve the same effect -- e.g., in
+  ;; rescale-page-ranks we could just change the scaled-rank to be between 1-70
+  ;; instead of 1-100, and so on.  For now, scoring things 50/50 doesn't seem
+  ;; too bad.
+  (b* (((when (atom keys))
+        nil)
+       (key1 (car keys))
+       (r1   (nfix (cdr (hons-get key1 ranks-fal1))))
+       (r2   (nfix (cdr (hons-get key1 ranks-fal2)))))
+    (cons (cons key1 (+ r1 r2))
+          (merge-ranks (cdr keys) ranks-fal1 ranks-fal2))))
+
+(defun rank-xtopics
+  (keys     ; all keys to consider (may differ from xtopics keys if there are bad
+            ; topics for which we didn't compute xtopics.
+   xtopics  ; list of all xtopics
+   )
+  ;; returns a slow alist binding keys to ranks
+  (b* (;(names       (xtopiclist->names xtopics))
+       (ranks-fal1  (make-fast-alist (dumb-rank-pages xtopics)))
+       (ranks-fal2  (make-fast-alist (pairlis$ (make-keys (xtopiclist->names xtopics))
+                                               (xtopiclist->sizes xtopics))))
+       (keys->ranks (merge-ranks keys ranks-fal1 ranks-fal2))
+       (-           (fast-alist-free ranks-fal1))
+       (-           (fast-alist-free ranks-fal2))
+       (- (or (equal (mergesort (strip-cars keys->ranks))
+                     (mergesort keys))
+              (er hard? 'rank-topics "Blah, wrong keys!")))
+                                
+       ;; keys->ranks binds keys to ranks and should have unique keys.  invert
+       ;; it and sort it to order the keys by their ranks
+       (ranks->keys (pairlis$ (strip-cdrs keys->ranks)
+                              (strip-cars keys->ranks)))
+       (keys-lo-to-hi (strip-cdrs (mergesort ranks->keys)))
+       ;(- (cw "Length of keys->ranks ~x0~%" (len keys->ranks)))
+       ;(- (cw "Length of ranks->keys ~x0~%" (len ranks->keys)))
+       ;(- (cw "Length of keys-lo-to-hi ~x0~%" (len keys-lo-to-hi)))
+       (- (or (equal (mergesort keys-lo-to-hi)
+                     (mergesort keys))
+              (er hard? 'rank-topics "Blah, wrong keys 2")))
+       (keys-hi-to-lo (reverse keys-lo-to-hi))
+       (- (or (equal (mergesort keys-hi-to-lo)
+                     (mergesort keys))
+              (er hard? 'rank-topics "Blah, wrong keys 3"))))
+    keys-hi-to-lo))
+
+(defun collect-topics-by-importance
+  (keys         ; list of keys for all topics in most-important-first order
+   keymap       ; fast alist mapping keys to topic names (for fast lookups)
+   topics-fal   ; alist of xdoc topic names to topics (for fast lookups)
+   )
+  ;; Returns a list of ordinary xdoc topics in most-important-first order
+  (b* (((when (atom keys))
+        nil)
+       (key1        (car keys))
+       (name1-look  (hons-get key1 keymap))
+       (- (or name1-look
+              (er hard? 'collect-topics-by-importance
+                  "Error looking up key ~x0 in keymap!" key1)))
+       (name1 (cdr name1-look))
+       (topic1-look (hons-get name1 topics-fal))
+       (- (or topic1-look
+              (er hard? 'collect-topics-by-importance
+                  "Error looking up topic ~x0 in topics-fal!" name1)))
+       (topic1 (cdr topic1-look)))
+    (cons topic1
+          (collect-topics-by-importance (cdr keys) keymap topics-fal))))
+
+(defun order-topics-by-importance (all-topics state)
+  (b* ((topics-fal   (topics-fal all-topics))
+       ;(- (cw "First 3 of topics-fal: ~x0.~%" (take 3 topics-fal)))
+       ;(- (cw "Length of topics-fal: ~x0.~%" (len topics-fal)))
+       (topics-names (strip-cars topics-fal))
+       (topics-keys  (make-keys topics-names))
+       ((mv xtopics state) (xtopics-from-topics all-topics state))
+       (state        (report-broken-links xtopics state))
+       (ordered-keys (rank-xtopics topics-keys xtopics))
+
+       ;(- (cw "First 3 ordered-keys: ~x0.~%" (take 3 ordered-keys)))
+       ;(- (cw "First 3 topics-keys: ~x0.~%" (take 3 topics-keys)))
+       ;(- (cw "Number of ordered keys: ~x0.~%" (len ordered-keys)))
+       ;(- (or (equal (mergesort ordered-keys)
+       ;              (mergesort topics-keys))
+       ;       (cw "Diff ordered-keys, topic-keys: ~x0.~%"
+       ;           (mergesort (set-difference-equal ordered-keys topics-keys)))
+       ;       (cw "Diff topic-keys, ordered-keys: ~x0.~%"
+       ;           (mergesort (set-difference-equal topics-keys ordered-keys)))
+       ;       (er hard? 'order-topics-by-importance "Don't have the same keys!")))
+       (keymap       (make-fast-alist (pairlis$ topics-keys topics-names)))
+       ;(- (cw "Keymap is ~x0.~%" keymap))
+       (result       (collect-topics-by-importance ordered-keys keymap topics-fal))
+       ;(- (cw "First 3 results: ~x0.~%" (take 3 result)))
+       ;(- (cw "Length of result: ~x0.~%" (length result)))
+       ;(- (cw "Names of result: ~x0.~%" (strip-cars (fast-alist-free (topics-fal result)))))
+       )
+    (fast-alist-free topics-fal)
+    (fast-alist-free keymap)
+    (or (equal (mergesort topics-names)
+               (mergesort (strip-cars (fast-alist-free (topics-fal result)))))
+        (er hard? 'order-topics-by-importance
+            "Screwed up the database!"))
+    (mv result state)))       
+
+
+
+#||
+
+For testing, get documentation loaded.  Newlines to avoid dependency scanner
+picking these up.
+
+(ld
+ "importance.lisp")
+
+(include-book
+ "tools/defconsts" :dir :system)
+(include-book
+ "centaur/aignet/portcullis" :dir :system)
+(include-book
+ "centaur/getopt/portcullis" :dir :system)
+(include-book
+ "centaur/vl/portcullis" :dir :system)
+(include-book
+ "centaur/gl/portcullis" :dir :system)
+(include-book
+ "centaur/clex/portcullis" :dir :system)
+(ld
+ "cgen/package.lsp" :dir :system)
+
+(acl2::defconsts (*xdoc.sao* state)
+  (serialize-read "../centaur/xdoc.sao" :verbosep t))
+
+(table xdoc 'doc
+       (clean-topics *xdoc.sao*))
+
+(acl2::defconsts *all-topic-names*
+                 (gather-topic-names (get-xdoc-table (w state))))
+
+(xdoc-quiet)
+(make-event
+ (b* (((mv xtopics state)
+       (xtopics-from-topics (get-xdoc-table (w state)) state)))
+   (value
+    `(defconst *xtopics* ',xtopics))))
+
+;; (trace$ (dumb-rank-pages-aux :entry
+;;                              (if (xtopic-p (car xtopics))
+;;                                  (change-xtopic (car xtopics)
+;;                                                 :short-tokens "..."
+;;                                                 :long-tokens "...")
+;;                                (car xtopics))
+;;                              :exit nil))
+
+(defconst *page-ranks*
+  (make-fast-alist (dumb-rank-pages *xtopics*)))
+
+(defconst *size-ranks*
+  (make-fast-alist (pairlis$ (make-keys (xtopiclist->names *xtopics*))
+                             (xtopiclist->sizes *xtopics*))))
+
+(defconst *final-ranks*
+  (make-fast-alist
+   (merge-ranks (make-keys *all-topic-names*)
+                *page-ranks* *size-ranks*)))
+
+(defun report (keys)
+  (b* (((when (atom keys))
+        nil)
+       (key   (car keys))
+       (final (cdr (hons-get key *final-ranks*)))
+       (page  (cdr (hons-get key *page-ranks*)))
+       (size  (cdr (hons-get key *size-ranks*))))
+    (cons (list final key page size)
+          (report (cdr keys)))))
+
+(make-event
+ (b* ((keys   (make-keys *all-topic-names*))
+      (result (rank-xtopics keys *xtopics*)))
+   `(defconst *keys-in-order-of-importance*
+      ',result)))
+
+(report *keys-in-order-of-importance*)
+
+
+(acl2::defconsts (*new-topics* state)
+  (b* ((all-topics (get-xdoc-table (w state)))
+       ((mv new-topics state)
+        (time$ (order-topics-by-importance all-topics state))))
+    (mv new-topics state)))
+
+(report (make-keys (gather-topic-names *new-topics*)))
+
+||#
diff -Nru acl2-6.2/books/xdoc/names.lisp acl2-6.3/books/xdoc/names.lisp
--- acl2-6.2/books/xdoc/names.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/names.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -27,6 +27,7 @@
 
 (in-package "XDOC")
 (include-book "base")
+(include-book "str/defs" :dir :system)
 (program)
 
 
@@ -68,12 +69,19 @@
 ; package and the symbol name when creating file names.
 
   (declare (type symbol x))
-  (let ((str (concatenate 'string
-                          (symbol-package-name x)
-                          "::"
-                          (symbol-name x))))
+  (let ((str (str::cat (symbol-package-name x)
+                       "::"
+                       (symbol-name x))))
     (file-name-mangle-aux str 0 (length str) acc)))
 
+(defun url (x)
+
+; Simplest way to get the URL for a topic.  Give it the symbol, it gives you
+; the URL.  Meant for use in macros that generate documentation.  See also
+; XDOC::SEE, defined below.
+
+  (declare (type symbol x))
+  (str::rchars-to-string (file-name-mangle x nil)))
 
 
 ; ----------------- Displaying Symbols --------------------------
@@ -112,118 +120,41 @@
 ;(reverse (coerce (simple-html-encode-chars '(#\a #\& #\b) nil) 'string))
 ;(reverse (coerce (simple-html-encode-chars '(#\a #\" #\b) nil) 'string))
 
+(defun sneaky-downcase (x)
+  (let ((down (str::downcase-string x)))
+    (str::strsubst "acl2" "ACL2" down)))
 
+;(sneaky-downcase "SILLY-ACL2-TUTORIAL")
 
-(defund revappend-chars-aux (x n xl y)
-  ;; YUCK, copy from string library to avoid str/ dependency
-  (declare (xargs :guard (and (stringp x)
-                              (natp n)
-                              (natp xl)
-                              (<= n xl)
-                              (equal xl (length x)))
-                  :measure (nfix (- (nfix xl) (nfix n)))))
-  (if (mbe :logic (zp (- (nfix xl) (nfix n)))
-           :exec (= n xl))
-      y
-    (revappend-chars-aux x (+ 1 (lnfix n)) xl (cons (char x n) y))))
-
-(defund revappend-chars (x y)
-  ;; YUCK, copy from string library to avoid str/ dependency
-  (declare (xargs :guard (stringp x))
-           (type string x))
-
-  (mbe :logic (revappend (coerce x 'list) y)
-       :exec (revappend-chars-aux x 0 (length x) y)))
-
-(defund strprefixp-impl (x y xn yn xl yl)
-  ;; YUCK, copy from string library to avoid str/ dependency
-  (declare (type string x)
-           (type string y)
-           (type integer xn)
-           (type integer yn)
-           (type integer xl)
-           (type integer yl)
-           (xargs :guard (and (stringp x)
-                              (stringp y)
-                              (natp xn)
-                              (natp yn)
-                              (natp xl)
-                              (natp yl)
-                              (= xl (length x))
-                              (= yl (length y))
-                              (<= xn (length x))
-                              (<= yn (length y)))
-                  :measure (min (nfix (- (nfix xl) (nfix xn)))
-                                (nfix (- (nfix yl) (nfix yn))))))
-  (cond ((mbe :logic (zp (- (nfix xl) (nfix xn)))
-              :exec (= (the integer xn)
-                       (the integer xl)))
-         t)
-        ((mbe :logic (zp (- (nfix yl) (nfix yn)))
-              :exec (= (the integer yn)
-                       (the integer yl)))
-         nil)
-        ((eql (the character (char x xn))
-              (the character (char y yn)))
-         (strprefixp-impl x y
-                          (+ (lnfix xn) 1)
-                          (+ (lnfix yn) 1)
-                          xl yl))
-        (t
-         nil)))
-
-(defund strsubst-aux (old new x n xl oldl acc)
-  ;; YUCK, copy from string library to avoid str/ dependency
-  (declare (type string old)
-           (type string new)
-           (type string x)
-           (type integer n)
-           (type integer xl)
-           (type integer oldl)
-           (xargs :guard (and (stringp old)
-                              (stringp new)
-                              (stringp x)
-                              (natp n)
-                              (natp xl)
-                              (posp oldl)
-                              (= oldl (length old))
-                              (= xl (length x)))
-                  :measure (nfix (- (nfix xl) (nfix n)))))
-  (cond ((mbe :logic (zp oldl)
-              :exec nil)
-         acc)
-
-        ((mbe :logic (zp (- (nfix xl) (nfix n)))
-              :exec (>= n xl))
-         acc)
-
-        ((strprefixp-impl old x 0 n oldl xl)
-         (let ((acc (revappend-chars new acc)))
-           (strsubst-aux old new x (+ oldl (lnfix n)) xl oldl acc)))
-
-        (t
-         (let ((acc (cons (char x n) acc)))
-           (strsubst-aux old new x (+ 1 (lnfix n)) xl oldl acc)))))
-
-(defund strsubst (old new x)
-  ;; YUCK, copy from string library to avoid str/ dependency
-  (declare (xargs :guard (and (stringp old)
-                              (stringp new)
-                              (stringp x))))
-  (let ((xl   (length x))
-        (oldl (length old)))
-    (if (= oldl 0)
-        (mbe :logic (if (stringp x)
-                        x
-                      "")
-             :exec x)
-      (reverse (coerce (strsubst-aux old new x 0 xl oldl nil) 'string)))))
 
-(defun sneaky-downcase (x)
-  (let ((down (string-downcase x)))
-    (strsubst "acl2" "ACL2" down)))
+(defun name-low (name)
+  (declare (type string name))
+  (b* ((has-lowercase-p (str::string-has-some-down-alpha-p name 0 (length name)))
+       (name-low        (if has-lowercase-p
+                            ;; They had to go out of their way to type this
+                            ;; name, using something like |foo| instead of FOO.
+                            ;; So let's not forcibly downcase things, in case
+                            ;; they want mixed case for some reason.
+                            name
+                          (sneaky-downcase name))))
+    name-low))
+
+
+(defun see (x)
+
+; Simplest way to get a <see...> link that leads to a symbol.  Give it the
+; symbol, it gives you <see topic='<url>'>name</see>, where name is properly
+; lower-cased, etc. Meant for use in macros that generate documentation. See
+; also XDOC::URL, above.
 
-;(sneaky-downcase "SILLY-ACL2-TUTORIAL")
+  (declare (type symbol x))
+  (b* ((acc nil)
+       (acc (str::revappend-chars "<see topic=\"" acc))
+       (acc (file-name-mangle x acc))
+       (acc (str::revappend-chars "\">" acc))
+       (acc (str::revappend-chars (name-low (symbol-name x)) acc))
+       (acc (str::revappend-chars "</see>" acc)))
+    (str::rchars-to-string acc)))
 
 
 (defun sym-mangle (x base-pkg acc)
@@ -233,36 +164,30 @@
 ; Characters to print are accumulated onto acc in reverse order.  BOZO think
 ; about adding keyword support?
 
-  (let* ((pkg-low  (string-downcase (symbol-package-name x)))
-         (name-low (sneaky-downcase (symbol-name x)))
+  (let* ((name-low (name-low (symbol-name x)))
          (acc (if (in-package-p x base-pkg)
                   acc
-                (list* #\: #\:
-                       (simple-html-encode-chars (coerce pkg-low 'list) acc)))))
+                (let ((pkg-low (name-low (symbol-package-name x))))
+                  (list* #\: #\:
+                         (simple-html-encode-chars (coerce pkg-low 'list) acc))))))
     (simple-html-encode-chars (coerce name-low 'list) acc)))
 
-(defun upcase-first-letter (x)
-  (declare (type string x))
-  (if (equal x "")
-      x
-    (concatenate 'string
-                 (coerce (list (char-upcase (char x 0))) 'string)
-                 (subseq x 1 nil))))
-
 (defun sym-mangle-cap (x base-pkg acc)
 
 ; Same as sym-mangle, but upper-case the first letter.
 
+  (b* ((name-low (name-low (symbol-name x))))
     (if (in-package-p x base-pkg)
-        (let* ((name-low (sneaky-downcase (symbol-name x)))
-               (name-cap (upcase-first-letter name-low)))
-          (simple-html-encode-chars (coerce name-cap 'list) acc))
-      (let* ((pkg-low (string-downcase (symbol-package-name x)))
-             (pkg-cap (upcase-first-letter pkg-low))
-             (name-low (sneaky-downcase (symbol-name x)))
-             (acc (list* #\: #\: (simple-html-encode-chars (coerce pkg-cap 'list) acc))))
-        (simple-html-encode-chars (coerce name-low 'list) acc))))
+        (let* ((name-cap (str::upcase-first name-low)))
+          (simple-html-encode-chars (explode name-cap) acc))
+      (let* ((pkg-low (name-low (symbol-package-name x)))
+             (pkg-cap (str::upcase-first pkg-low))
+             (acc (list* #\: #\:
+                         (simple-html-encode-chars (explode pkg-cap) acc))))
+        (simple-html-encode-chars (explode name-low) acc)))))
+
+
+; (reverse (implode (sym-mangle 'acl2 'acl2::foo nil)))
+; (reverse (implode (sym-mangle 'acl2-tutorial 'acl2::foo nil)))
 
 
-; (reverse (coerce (sym-mangle 'acl2 'acl2::foo nil) 'string))
-; (reverse (coerce (sym-mangle 'acl2-tutorial 'acl2::foo nil) 'string))
diff -Nru acl2-6.2/books/xdoc/package.lsp acl2-6.3/books/xdoc/package.lsp
--- acl2-6.2/books/xdoc/package.lsp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/package.lsp	2013-09-30 17:52:15.000000000 +0000
@@ -27,9 +27,10 @@
              ;; Things to add:
              '(b* quit exit value defxdoc defxdoc-raw macro-args
                   xdoc-extend defsection defsection-progn cutil lnfix
+                  set-default-parents
                   getprop formals justification def-bodies current-acl2-world def-body
                   access theorem untranslated-theorem guard xdoc xdoc! unquote
-                  undocumented assert!))
+                  undocumented assert! top explode implode))
    ;; Things to remove:
    '(
      )))
diff -Nru acl2-6.2/books/xdoc/parse-xml.lisp acl2-6.3/books/xdoc/parse-xml.lisp
--- acl2-6.2/books/xdoc/parse-xml.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/parse-xml.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,417 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "XDOC")
+(include-book "preprocess")
+(set-state-ok t)
+(program)
+
+
+; (PARSE-XML X) --> (MV ERR TOKENS)
+;
+; This is an extremely primitive XML lexer.  It is incomplete, doesn't support
+; unicode, and probably is dead wrong as far as the XML standard is concerned.
+; But, it's adequate for XDOC stuff.
+;
+; X should be an XML-formatted string (with no preprocessor stuff).  We break
+; it into a list of tokens, which may be any of the following:
+;
+;    (:OPEN STR ALIST LOC) represents <tag [... atts ...]>
+;
+;       - STR is a string that is the tag name, e.g., "p" for <p>
+;
+;       - ALIST is an alist of the attribute.  Each entry is either:
+;            (KEY-STR . VAL-STR)   for ordinary key="val" style atts
+;            (KEY-STR . NIL)       for value-free atts like <hr noshade>
+;
+;       - LOC is semantically irrelevant.  It's the location of this
+;         open token in the string, which can be useful for better
+;         error messages about unbalanced strings.
+;
+;    (:CLOSE STR) represents </tag>
+;
+;       - STR is a string that is the tag name, e.g., "p" for </p>
+;
+;    (:TEXT STR) represents ordinary text
+;
+;       - STR is the contents of the text.  This is ordinary text with no
+;         embedded tags or entities.
+;
+;    (:ENTITY TYPE) represents entities like &amp;
+;
+;      - TYPE is :AMP, :LT, :GT, :APOS, :NBSP, :MDASH, or :RARR
+
+(defconst *nls* (coerce (list #\Newline) 'string))
+
+(defun read-until (x n xl stop-chars acc)
+  ;; Accumulate chars until one of the stop-chars is seen
+  "Returns (MV FOUNDP N ACC)"
+  (b* (((when (>= n xl))
+        (mv nil n acc))
+       (char-n (char x n))
+       ((when (member char-n stop-chars))
+        (mv t n acc)))
+    (read-until x (+ 1 n) xl stop-chars (cons char-n acc))))
+
+(defun read-name-aux (x n xl acc)
+  ;; For attribute/tag names.  We just expect alphanumeric characters.  This is
+  ;; probably horribly wrong as far as the XML spec is concerned, but should be
+  ;; reasonable for all the tag and attribute names in xdoc.
+  "Returns (MV N ACC)"
+  (b* (((when (>= n xl))
+        (mv n acc))
+       (char-n (char x n))
+       ((when (or (and (char<= #\a char-n) (char<= char-n #\z))
+                  (and (char<= #\Z char-n) (char<= char-n #\Z))
+                  (and (char<= #\0 char-n) (char<= char-n #\9))
+                  (eql char-n #\_)
+                  (eql char-n #\-)
+                  ))
+        (read-name-aux x (+ 1 n) xl (cons char-n acc))))
+    (mv n acc)))
+
+(defun read-name (x n xl)
+  ;; Try to read an attribute/tag name at the current spot.
+  "Returns (MV ERR N NAME-STR)"
+  (b* (((mv n rchars)
+        (read-name-aux x n xl nil))
+       ((unless (consp rchars))
+        (mv (str::cat "Expected a name, but found unexpected character "
+                      (coerce (list (char x n)) 'string) *nls*
+                      "Nearby text: {" (error-context x n xl) "}" *nls*)
+            n nil))
+       (str (str::rchars-to-string rchars)))
+    (mv nil n str)))
+
+(defun read-attrval (x n xl)
+  ;; Try to read "value" or 'value' at the current spot.
+  "Returns (MV ERR N VAL-STR)"
+  (b* ((saved-n n)
+       (quote-char (char x n))
+       ((unless (or (eql quote-char #\")
+                    (eql quote-char #\')))
+        (mv (str::cat "Expected value to start with a quote, but found "
+                      (coerce (list (char x n)) 'string) *nls*
+                      "Nearby text: {" (error-context x n xl) "}" *nls*)
+            n nil))
+       (n (+ 1 n)) ;; eat the quote-char
+       ((mv found-endp n chars)
+        (read-until x n xl (list quote-char) nil))
+       ((unless found-endp)
+        (mv (str::cat "Attribute value never ends." *nls*
+                      "Nearby text: {" (error-context x saved-n xl) "}" *nls*)
+            n nil))
+       (n (+ n 1)) ;; eat the closing quote-char
+       (val-str (str::rchars-to-string chars)))
+    (mv nil n val-str)))
+
+(defun read-tag-attributes (x n xl tag-start-n atts)
+  ;; Assumes "<foo" and perhaps some attributes have just been read.
+  ;; Reads through the closing > or />, setting CLOSEP=T if we read />
+  ;; as in <br/>.
+  "Returns (MV ERR N ATTS CLOSEP)"
+  (b* ((n (skip-past-ws x n xl))
+       ((when (>= n xl))
+        (mv (str::cat "Tag never closes." *nls*
+                      "Nearby text: {" (error-context x tag-start-n xl) "}" *nls*)
+            n nil nil))
+       ((when (eql (char x n) #\>))
+        ;; End of tag via >
+        (mv nil (+ 1 n) atts nil))
+       ((when (eql (char x n) #\/))
+        ;; It had better be />.
+        (b* ((n (+ 1 n))
+             ((unless (and (< n xl)
+                           (eql (char x n) #\>)))
+              (mv (str::cat "Stray / in tag." *nls*
+                            "Nearby text: {" (error-context x tag-start-n xl) "}" *nls*)
+                  n nil nil)))
+          (mv nil (+ 1 n) atts t)))
+       ;; We should now be at the start of some new attribute.
+       ((mv err n key1) (read-name x n xl))
+       ((when err)
+        (mv err n nil nil))
+       (n (skip-past-ws x n xl))
+       ((when (>= n xl))
+        (mv (str::cat "Tag never closes." *nls*
+                      "Nearby text: {" (error-context x tag-start-n xl) "}" *nls*)
+            n nil nil))
+       ((unless (eql (char x n) #\=))
+        ;; I guess this is okay for things like "noshade" that don't have an
+        ;; associated value.
+        (read-tag-attributes x n xl tag-start-n (acons key1 nil atts)))
+       (n (+ n 1)) ;; eat the =
+       (n (skip-past-ws x n xl))
+       ((mv err n val1) (read-attrval x n xl))
+       ((when err)
+        (mv err n nil nil)))
+    (read-tag-attributes x n xl tag-start-n (acons key1 val1 atts))))
+
+(defun read-close-tag (x n xl)
+  ;; Assumes </ has just been read.
+  ;; Reads through the closing >.
+  "Returns (MV ERR N TOKEN-LIST)"
+  (b* ((saved-n n)
+       (n (skip-past-ws x n xl))
+       ((mv err n name) (read-name x n xl))
+       ((when err)
+        (mv err n nil))
+       (n (skip-past-ws x n xl))
+       ((unless (eql (char x n) #\>))
+        (mv (str::cat "Invalid closing tag." *nls*
+                      "Nearby text: {" (error-context x saved-n xl) "}" *nls*)
+            n nil))
+       (n (+ 1 n)) ;; eat the final >
+       (close (list :CLOSE name)))
+    (mv nil n (list close))))
+
+(defun skip-declaration (x n xl start-n)
+  ;; Read through ?>
+  "Returns (MV ERR N NIL)"
+  (b* (((when (>= (- n 1) xl))
+        (mv (str::cat "<? ... ?> declaration never closes." *nls*
+                      "Nearby text: {" (error-context x start-n xl) "}" *nls*)
+            n nil))
+       ((unless (and (eql (char x n) #\?)
+                     (eql (char x (+ n 1)) #\>)))
+        (skip-declaration x (+ n 1) xl start-n)))
+    (mv nil (+ n 2) nil)))
+
+(defun skip-entity-stuff (x n xl start-n)
+  ;; Read through ]>
+  "Returns (MV ERR N NIL)"
+  (b* (((when (>= (- n 1) xl))
+        (mv (str::cat "<! ... ]> declaration never closes." *nls*
+                      "Nearby text: {" (error-context x start-n xl) "}" *nls*)
+            n nil))
+       ((unless (and (eql (char x n) #\])
+                     (eql (char x (+ n 1)) #\>)))
+        (skip-entity-stuff x (+ n 1) xl start-n)))
+    (mv nil (+ n 2) nil)))
+
+(defun read-tag (x n xl)
+  ;; Assumes (char x n) is "<"
+  "Returns (MV ERR N TOKEN-LIST)"
+  (b* ((tag-start-n n)
+       (n (+ 1 n))
+       (n (skip-past-ws x n xl))
+       ((when (>= n xl))
+        (mv (str::cat "Tag never closes." *nls*
+                      "Nearby text: {" (error-context x tag-start-n xl) "}" *nls*)
+            n nil))
+       ((when (eql (char x n) #\?))
+        (skip-declaration x n xl tag-start-n))
+       ((when (eql (char x n) #\!))
+        (skip-entity-stuff x n xl tag-start-n))
+       ((when (eql (char x n) #\/))
+        (read-close-tag x (+ 1 n) xl))
+       ;; Else, it's an opening tag.  This should be its name.
+       ((mv err n name)
+        (read-name x n xl))
+       ((when err)
+        (mv err n nil))
+       ((mv err n atts closep)
+        (read-tag-attributes x n xl tag-start-n nil))
+       ((when err)
+        (mv err n nil))
+       (open (list :OPEN name (reverse atts) tag-start-n))
+       ((when (not closep))
+        (mv nil n (list open)))
+       (close (list :CLOSE name)))
+    (mv nil n (list open close))))
+
+(defun read-entity (x n xl)
+  ;; Assumes (char x n) is "&"
+  "Returns (MV ERR N TOK)"
+  (b* ((saved-n n)
+       (n (+ 1 n)) ;; eat the &
+       ((mv foundp n rchars)
+        (read-until x n xl (list #\;) nil))
+       ((unless foundp)
+        (mv (str::cat "Entity does not have a closing semicolon." *nls*
+                      "Nearby text: {" (error-context x saved-n xl) "}" *nls*)
+            n nil))
+       (n (+ 1 n)) ;; eat the ;
+       (str (str::rchars-to-string rchars))
+       ((when (equal str "amp"))  (mv nil n '(:ENTITY :AMP)))
+       ((when (equal str "lt"))   (mv nil n '(:ENTITY :LT)))
+       ((when (equal str "gt"))   (mv nil n '(:ENTITY :GT)))
+       ((when (equal str "quot")) (mv nil n '(:ENTITY :QUOT)))
+       ((when (equal str "apos")) (mv nil n '(:ENTITY :APOS)))
+       ((when (equal str "nbsp")) (mv nil n '(:ENTITY :NBSP)))
+       ((when (equal str "mdash")) (mv nil n '(:ENTITY :MDASH)))
+       ((when (equal str "rarr")) (mv nil n '(:ENTITY :RARR))))
+    (mv (str::cat "Unsupported entity: &" str ";" *nls*
+                  "Nearby text: {" (error-context x saved-n xl) "}" *nls*)
+        n nil)))
+
+(defun parse-xml-aux (x n xl acc)
+  "Returns (MV ERR TOKENS)"
+  (b* (((when (>= n xl))
+        (mv nil acc))
+       (char-n (char x n))
+       ((when (eql char-n #\<))
+        ;; Open/closing tag
+        (b* (((mv err n token-list) (read-tag x n xl))
+             ((when err)
+              (mv err nil))
+             (acc (revappend token-list acc)))
+          (parse-xml-aux x n xl acc)))
+       ((when (eql char-n #\&))
+        ;; Entity
+        (b* (((mv err n token) (read-entity x n xl))
+             ((when err)
+              (mv err nil)))
+          (parse-xml-aux x n xl (cons token acc))))
+       ((when (eql char-n #\>))
+        (mv (str::cat "Stray end-of-tag character '>'" *nls*
+                      "Nearby text: {" (error-context x n xl) "}" *nls*)
+            nil))
+       ;; Otherwise, plain text.
+       ((mv ?foundp n rchars)
+        (read-until x n xl '(#\< #\& #\>) nil))
+       (token (list :TEXT (str::rchars-to-string rchars))))
+    (parse-xml-aux x n xl (cons token acc))))
+
+
+; Basic tag balance checking with nice error reporting
+
+(defun opentok-p (x) (eq (first x) :OPEN))
+(defun opentok-name (x) (second x))
+(defun opentok-atts (x) (third x))
+(defun opentok-loc (x) (fourth x))
+
+(defun closetok-p (x) (eq (first x) :CLOSE))
+(defun closetok-name (x) (second x))
+
+(defun entitytok-p (x) (eq (first x) :ENTITY))
+(defun entitytok-type (x) (second x))
+
+(defun texttok-p (x) (eq (first x) :TEXT))
+(defun texttok-text (x) (second x))
+
+(defun entitytok-as-entity (x)
+  (case (entitytok-type x)
+    (:AMP   "&amp;")
+    (:LT    "&lt;")
+    (:GT    "&gt;")
+    (:QUOT  "&quot;")
+    (:APOS  "&apos;")
+    (:NBSP  "&nbsp;")
+    (:MDASH "&mdash;")
+    (:RARR  "&rarr;")
+    ))
+
+(defun entitytok-as-plaintext (x)
+  (case (entitytok-type x)
+    (:AMP   "&")
+    (:LT    "<")
+    (:GT    ">")
+    (:QUOT  "\"")
+    (:APOS  "'")
+    (:NBSP  " ")
+    (:MDASH "---")
+    (:RARR  "-->")))
+
+(defun flatten-token-for-errormsg (x)
+  (cond ((opentok-p x)
+         (str::cat "<" (opentok-name x)
+                   (if (opentok-atts x) " [...]>" ">")))
+        ((closetok-p x)
+         (str::cat "</" (closetok-name x) ">"))
+        ((entitytok-p x)
+         (entitytok-as-entity x))
+        ((texttok-p x)
+         (texttok-text x))
+        (t
+         (er hard? 'flatten-token-for-errormsg "Invalid token ~x0" x))))
+
+(defun flatten-tokens-for-errormsg (x)
+  (if (atom x)
+      ""
+    (str::cat (flatten-token-for-errormsg (car x))
+              (flatten-tokens-for-errormsg (cdr x)))))
+
+
+(defun nearby-text (index str)
+  (let* ((strlen (length str))
+         (start index)
+         (stop   (min strlen (+ index 60))))
+    (str::cat (substitute #\Space #\Newline (subseq str start stop))
+              (if (equal stop strlen) "" "..."))))
+
+(defun open-tag-backtrace-entry (orig-str open-tok)
+  (declare (type string orig-str))
+  (let* ((n          (opentok-loc open-tok))
+         (name       (opentok-name open-tok))
+         (name-len   (length name))
+         (spaces-len (max 0 (- 6 name-len)))
+         (pad        (coerce (make-list spaces-len :initial-element #\Space) 'string))
+         (nearby     (nearby-text n orig-str)))
+    (str::cat "   <" name "> " pad nearby *nls*)))
+
+(defun open-tags-backtrace (orig-str open-tags)
+  (if (atom open-tags)
+      ""
+    (str::cat (open-tag-backtrace-entry orig-str (car open-tags))
+              (open-tags-backtrace orig-str (cdr open-tags)))))
+
+(defun find-tag-imbalance (x open-tags loc)
+  "Returns (MV ERROR/NIL LOC/NIL STILL-OPEN-TAGS/NIL)"
+  (b* (((when (atom x))
+        (if open-tags
+            (mv (str::cat (opentok-name (car open-tags)) " tag is never closed.")
+                nil open-tags)
+          (mv nil nil nil)))
+       ((when (opentok-p (car x)))
+        (find-tag-imbalance (cdr x) (cons (car x) open-tags) (+ 1 loc)))
+       ((when (closetok-p (car x)))
+        (b* ((close-name (closetok-name (car x)))
+             ((unless (consp open-tags))
+              (mv (str::cat "Found </" close-name "> with no matching opening tag.")
+                  loc open-tags))
+             (open-name (opentok-name (car open-tags)))
+             ((unless (equal close-name open-name))
+              (mv (str::cat "Found <" open-name "> with mismatched </" close-name ">.")
+                  loc open-tags)))
+          (find-tag-imbalance (cdr x) (cdr open-tags) (+ 1 loc)))))
+    (find-tag-imbalance (cdr x) open-tags (+ 1 loc))))
+
+(defun parse-xml (x)
+  (declare (type string x))
+  (b* (((mv err rtokens) (parse-xml-aux x 0 (length x) nil))
+       ((when err)
+        (mv err nil))
+       (tokens (reverse rtokens))
+       ((mv err loc open-tags) (find-tag-imbalance tokens nil 0))
+       ((when err)
+        (b* (((when (not loc))
+              (mv err nil))
+             (back-one  (max 0 (- loc 4)))
+             (start-ctx (nthcdr back-one tokens))
+             (context   (take (min 8 (len start-ctx)) start-ctx))
+             (nearby    (flatten-tokens-for-errormsg context)))
+          (mv (str::cat err *nls* "Nearby text: {" nearby "}" *nls* *nls*
+                        (if open-tags
+                            (str::cat "Open tags stack:" *nls*
+                                      (open-tags-backtrace x (reverse open-tags)))
+                          ""))
+              nil))))
+    (mv err tokens)))
diff -Nru acl2-6.2/books/xdoc/portcullis.acl2 acl2-6.3/books/xdoc/portcullis.acl2
--- acl2-6.2/books/xdoc/portcullis.acl2	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/portcullis.acl2	2013-09-30 17:52:15.000000000 +0000
@@ -19,5 +19,4 @@
 ; Original author: Jared Davis <jared@centtech.com>
 
 (ld "package.lsp")
-; cert-flags: ? t :ttags :all
-(certify-book "portcullis" ? t :ttags :all)
+
diff -Nru acl2-6.2/books/xdoc/prepare-topic.lisp acl2-6.3/books/xdoc/prepare-topic.lisp
--- acl2-6.2/books/xdoc/prepare-topic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/prepare-topic.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,232 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "XDOC")
+(include-book "base")
+(include-book "sort")
+(include-book "preprocess")
+(include-book "parse-xml")
+(program)
+(set-state-ok t)
+
+(defun find-children-aux (par x)
+
+; Gather names of all xdoc topics in x which have parent par.  I.e., this finds
+; the immediate children.
+
+  (if (atom x)
+      nil
+    (if (member-equal par (cdr (assoc :parents (car x))))
+        (cons (cdr (assoc :name (car x)))
+              (find-children-aux par (cdr x)))
+      (find-children-aux par (cdr x)))))
+
+(defun find-children (par x)
+
+; Gather names of immediate children topics and sort them.
+
+  (mergesort (find-children-aux par x)))
+
+
+(defconst *xml-entity-stuff*
+  "<!DOCTYPE xdoc [
+  <!ENTITY mdash \"&#8212;\">
+  <!ENTITY rarr \"&#8594;\">
+  <!ENTITY nbsp \"&#160;\">
+]>
+")
+
+
+; ------------------ Making Flat Indexes ------------------------
+
+(defun index-add-topic (x dir topics-fal index-pkg state acc)
+
+; X is a single topic entry in the xdoc table.  Index-pkg says the base package
+; for symbols seen frmo the index.
+
+  (b* ((name     (cdr (assoc :name x)))
+       (short    (cdr (assoc :short x)))
+       (base-pkg (cdr (assoc :base-pkg x)))
+       (acc   (str::revappend-chars "<index_entry>" acc))
+       (acc   (cons #\Newline acc))
+       (acc   (str::revappend-chars "<index_head><see topic=\"" acc))
+       (acc   (file-name-mangle name acc))
+       (acc   (str::revappend-chars "\">" acc))
+       (acc   (sym-mangle-cap name index-pkg acc))
+       (acc   (str::revappend-chars "</see>" acc))
+       (acc   (str::revappend-chars "</index_head>" acc))
+       (acc   (cons #\Newline acc))
+       (acc   (str::revappend-chars "<index_body>" acc))
+       (acc   (cons #\Newline acc))
+       ((mv acc state) (preprocess-main short dir topics-fal base-pkg state acc))
+       (acc   (cons #\Newline acc))
+       (acc   (str::revappend-chars "</index_body>" acc))
+       (acc   (cons #\Newline acc))
+       (acc   (str::revappend-chars "</index_entry>" acc))
+       (acc   (cons #\Newline acc)))
+      (mv acc state)))
+
+(defun index-add-topics (x dir topics-fal index-pkg state acc)
+
+; X is a list of topics.  Index-pkg says the base package for these symbols.
+
+  (if (atom x)
+      (mv acc state)
+    (b* (((mv acc state) (index-add-topic (car x) dir topics-fal index-pkg state acc)))
+        (index-add-topics (cdr x) dir topics-fal index-pkg state acc))))
+
+(defun index-topics (x title dir topics-fal index-pkg state acc)
+
+; X is a list of topics.  Generate <index>...</index> for these topics and
+; add to acc.
+
+  (b* ((acc (str::revappend-chars "<index title=\"" acc))
+       (acc (str::revappend-chars title acc))
+       (acc (str::revappend-chars "\">" acc))
+       (acc (cons #\Newline acc))
+       ((mv acc state) (index-add-topics x dir topics-fal index-pkg state acc))
+       (acc (str::revappend-chars "</index>" acc))
+       (acc (cons #\Newline acc)))
+      (mv acc state)))
+
+
+
+(defun add-parents (parents base-pkg acc)
+  (if (atom parents)
+      acc
+    (let* ((acc (str::revappend-chars "<parent topic=\"" acc))
+           (acc (file-name-mangle (car parents) acc))
+           (acc (str::revappend-chars "\">" acc))
+           (acc (sym-mangle-cap (car parents) base-pkg acc))
+           (acc (str::revappend-chars "</parent>" acc))
+           (acc (cons #\Newline acc)))
+      (add-parents (cdr parents) base-pkg acc))))
+
+(defun gather-topics (names all-topics)
+
+; Given a list of topic names, get their entries from the list of all topics.
+
+  (cond ((atom all-topics)
+         nil)
+        ((member (cdr (assoc :name (car all-topics))) names)
+         (cons (car all-topics)
+               (gather-topics names (cdr all-topics))))
+        (t
+         (gather-topics names (cdr all-topics)))))
+
+(defun preprocess-topic (x all-topics dir topics-fal state)
+  (b* ((name     (cdr (assoc :name x)))
+       (base-pkg (cdr (assoc :base-pkg x)))
+       (short    (or (cdr (assoc :short x)) ""))
+       (long     (or (cdr (assoc :long x)) ""))
+       (parents  (cdr (assoc :parents x)))
+       ((unless (symbolp name))
+        (mv (er hard? 'preprocess-topic "Name is not a string: ~x0.~%" x)
+            state))
+       ((unless (symbolp base-pkg))
+        (mv (er hard? 'preprocess-topic "Base-pkg is not a symbol: ~x0.~%" base-pkg)
+            state))
+       ((unless (symbol-listp parents))
+        (mv (er hard? 'preprocess-topic "Parents are not a symbol-listp: ~x0.~%" x)
+            state))
+       ((unless (stringp short))
+        (mv (er hard? 'preprocess-topic "Short is not a string: ~x0.~%" x)
+            state))
+       ((unless (stringp long))
+        (mv (er hard? 'preprocess-topic "Long is not a string: ~x0.~%" x)
+            state))
+
+       (acc    nil)
+       (acc    (str::revappend-chars "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" acc))
+       (acc    (cons #\Newline acc))
+       (acc    (str::revappend-chars "<?xml-stylesheet type=\"text/xsl\" href=\"xml-topic.xsl\"?>" acc))
+       (acc    (cons #\Newline acc))
+       (acc    (str::revappend-chars *xml-entity-stuff* acc))
+       (acc    (str::revappend-chars "<page>" acc))
+       (acc    (str::revappend-chars "<topic name=\"" acc))
+       (acc    (sym-mangle-cap name base-pkg acc))
+       (acc    (str::revappend-chars "\">" acc))
+       (acc    (cons #\Newline acc))
+       (acc    (add-parents parents base-pkg acc))
+       (acc    (cons #\Newline acc))
+       (acc    (str::revappend-chars "<short>" acc))
+
+       ((mv short-acc state)
+        (preprocess-main short dir topics-fal base-pkg state nil))
+       (short-str  (str::rchars-to-string short-acc))
+
+       ((mv err &) (parse-xml short-str))
+       (state
+        (if (and err (xdoc-verbose-p))
+            (pprogn
+               (fms "~|~%WARNING: problem with :short in topic ~x0:~%" 
+                    (list (cons #\0 name))
+                    *standard-co* state nil)
+               (princ$ err *standard-co* state)
+               (fms "~%~%" nil *standard-co* state nil))
+          state))
+
+       (acc (b* (((unless err)
+                  (append short-acc acc))
+                 (acc (str::revappend-chars "<b>Markup error in :short: </b><code>" acc))
+                 (acc (simple-html-encode-str err 0 (length err) acc))
+                 (acc (str::revappend-chars "</code>" acc)))
+              acc))
+
+       (acc    (str::revappend-chars "</short>" acc))
+       (acc    (cons #\Newline acc))
+       (acc    (str::revappend-chars "<long>" acc))
+
+       ((mv long-acc state) (preprocess-main long dir topics-fal base-pkg state nil))
+       (long-str (str::rchars-to-string long-acc))
+       ((mv err &) (parse-xml long-str))
+
+       (state
+        (if (and err (xdoc-verbose-p))
+            (pprogn
+               (fms "~|~%WARNING: problem with :long in topic ~x0:~%"
+                    (list (cons #\0 name))
+                    *standard-co* state nil)
+               (princ$ err *standard-co* state)
+               (fms "~%~%" nil *standard-co* state nil))
+          state))
+
+       (acc (b* (((unless err)
+                  (append long-acc acc))
+                 (acc (str::revappend-chars "<h3>Markup error in :long</h3><code>" acc))
+                 (acc (simple-html-encode-str err 0 (length err) acc))
+                 (acc (str::revappend-chars "</code>" acc)))
+              acc))
+
+       (acc    (str::revappend-chars "</long>" acc))
+       (acc    (cons #\Newline acc))
+
+       (children (find-children name all-topics))
+       (topics   (gather-topics children all-topics))
+
+       ((mv acc state) (if (not topics)
+                           (mv acc state)
+                         (index-topics topics "Subtopics" dir topics-fal base-pkg state acc)))
+
+       (acc    (str::revappend-chars "</topic>" acc))
+       (acc    (cons #\Newline acc))
+       (acc    (str::revappend-chars "</page>" acc))
+       (acc    (cons #\Newline acc)))
+      (mv (str::rchars-to-string acc) state)))
diff -Nru acl2-6.2/books/xdoc/preprocess.lisp acl2-6.3/books/xdoc/preprocess.lisp
--- acl2-6.2/books/xdoc/preprocess.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/preprocess.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,1088 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+
+; preprocess.lisp  -- the xdoc preprocessor
+
+(in-package "XDOC")
+(include-book "autolink")
+(include-book "str/defs" :dir :system)
+(local (include-book "misc/assert" :dir :system))
+(set-state-ok t)
+(program)
+
+(encapsulate
+ ()
+ ;; We're not allowed to attach to program mode functions without a ttag, so
+ ;; make this logic mode.
+ (logic)
+ (defstub xdoc-verbose-p () t)
+ (defun xdoc-verbose-fn ()
+   (declare (xargs :guard t))
+   t)
+ (defun xdoc-quiet-fn ()
+   (declare (xargs :guard t))
+   nil)
+ (defmacro xdoc-verbose ()
+   `(defattach xdoc-verbose-p xdoc-verbose-fn))
+ (defmacro xdoc-quiet ()
+   `(defattach xdoc-verbose-p xdoc-quiet-fn))
+ (xdoc-verbose))
+
+; ----------------- World Lookup Stuff --------------------------
+
+(defun get-formals (fn world)
+  (b* ((formals (getprop fn 'formals :bad 'current-acl2-world world))
+       ((unless (eq formals :bad))
+        formals)
+       (macro-args (getprop fn 'macro-args :bad 'current-acl2-world world))
+       ((unless (eq macro-args :bad))
+        macro-args))
+    (and (xdoc-verbose-p)
+         (cw "; xdoc note: get-formals failed for ~s0::~s1.~%"
+             (symbol-package-name fn) (symbol-name fn)))
+    (str::cat "Error getting formals for "
+              (symbol-package-name fn)
+              "::"
+              (symbol-name fn))))
+
+(defun get-measure (fn world)
+  (b* ((just (getprop fn 'justification nil 'current-acl2-world world))
+       ((when just)
+        (access justification just :measure)))
+    (and (xdoc-verbose-p)
+         (cw "; xdoc note: get-measure failed for ~x0.~%" fn))
+    (str::cat "Error getting measure for "
+              (symbol-package-name fn)
+              "::"
+              (symbol-name fn))))
+
+(defun get-guard (fn world)
+  (b* ((formals (getprop fn 'formals :bad 'current-acl2-world world))
+       ((unless (eq formals :bad))
+        (getprop fn 'guard nil 'current-acl2-world world)))
+    (and (xdoc-verbose-p)
+         (cw "; xdoc note: get-guard failed for ~x0.~%" fn))
+    (str::cat "Error getting guard for "
+              (symbol-package-name fn)
+              "::"
+              (symbol-name fn))))
+
+(defun get-body (fn world)
+  ;; This gets the original body normalized or non-normalized body based on
+  ;; what the user typed for the :normalize xarg.  The use of "last" skips past
+  ;; any other :definition rules that have been added since then.
+  (b* ((bodies (getprop fn 'def-bodies nil 'current-acl2-world world))
+       ((when bodies)
+        (access def-body (car (last bodies)) :concl)))
+    (and (xdoc-verbose-p)
+         (cw "; xdoc note: get-body failed for ~x0.~%" fn))
+    (str::cat "Error getting body for "
+              (symbol-package-name fn)
+              "::"
+              (symbol-name fn))))
+
+
+(defun eat-things-from-event (keys event)
+  ;; EVENT might be something like (DEFTHM FOO :HINTS ... :RULE-CLASSES ...)
+  ;; KEYS is a list of things we want to remove, e.g., it might contain HINTS.
+  ;; We look for members of keys and eat them and their associated values.
+  (cond ((atom event)
+         event)
+        ((atom (cdr event))
+         event)
+        ((member (car event) keys)
+         (eat-things-from-event keys (cddr event)))
+        (t
+         (cons (car event) (eat-things-from-event keys (cdr event))))))
+
+(defun clean-up-xargs (xargs)
+  ;; Xargs is like (xargs :guard t :verify-guards nil ...) from a function declaration
+  ;; I leave in :guard, :stobjs, and :non-executable since those are possibly of interest...
+  (eat-things-from-event '(:guard-hints :guard-debug :hints :measure :ruler-extenders :mode
+                                        :normalize :otf-flg :verify-guards :well-founded-relation)
+                         xargs))
+
+(defun clean-up-function-decl-item (item)
+  ;; Item is like (xargs ...) or (integer foo) or whatever; it's something that occurs
+  ;; in a declaration.  I'll leave in type declarations.
+  (cond ((and (consp item)
+              (eq (car item) 'xargs))
+         (let ((clean-xargs (clean-up-xargs (cdr item))))
+           (if clean-xargs
+               (cons 'xargs clean-xargs)
+             nil)))
+        (t
+         item)))
+
+(defun clean-up-function-decl-items (items)
+  (if (consp items)
+      (let ((clean1 (clean-up-function-decl-item (car items)))
+            (rest   (clean-up-function-decl-items (cdr items))))
+        (if clean1
+            (cons clean1 rest)
+          rest))
+    items))
+
+(defun clean-up-function-decl (decl)
+  ;; DECL is like (declare (xargs ...) (type string ...)) etc.
+  (cond ((and (consp decl)
+              (eq (car decl) 'declare))
+         (let ((items (clean-up-function-decl-items (cdr decl))))
+           (if items
+               (cons 'declare items)
+             nil)))
+        ((stringp decl)
+         ;; drop doc-strings, but leave other string documentation
+         (if (str::istrprefixp ":doc-section" decl)
+             nil
+           decl))
+        (t
+         decl)))
+
+(defun clean-up-function-decls (decls)
+  (if (consp decls)
+      (let ((clean1 (clean-up-function-decl (car decls)))
+            (rest   (clean-up-function-decls (cdr decls))))
+        (if clean1
+            (cons clean1 rest)
+          rest))
+    decls))
+
+(defun clean-up-event (event)
+  (if (atom event)
+      event
+    (case (car event)
+      (defthm
+        ;; I'll leave in the rule-classes, since they're probably important.
+        (eat-things-from-event '(:hints :instructions :doc :otf-flg) event))
+      (defun
+        (let ((name    (second event))
+              (formals (third event))
+              (decls   (clean-up-function-decls (butlast (cdddr event) 1)))
+              (body    (car (last event))))
+          (if decls
+              (append (list 'defun name formals)
+                      decls
+                      (list body))
+            (list 'defun name formals body))))
+      (defmacro
+        (let ((name    (second event))
+              (formals (third event))
+              (decls   (clean-up-function-decls (butlast (cdddr event) 1)))
+              (body    (car (last event))))
+          (if decls
+              (append (list 'defmacro name formals) decls (list body))
+            (list 'defmacro name formals body))))
+      (otherwise
+       event))))
+
+(defun get-event-aux (name world)
+  ;; A general purpose event lookup as in :pe
+  (b* ((props (acl2::getprops name 'current-acl2-world world))
+       (evt   (and props (acl2::get-event name world)))
+       ((when evt)
+        evt))
+    (and (xdoc-verbose-p)
+         (cw "; xdoc note: get-event failed for ~x0.~%" name))
+    (str::cat "Error getting event for "
+              (symbol-package-name name)
+              "::"
+              (symbol-name name))))
+
+(defun get-event (name world)
+  (clean-up-event (get-event-aux name world)))
+
+#||
+
+(get-event-aux 'append (w state))
+(get-event 'append (w state))
+
+(get-event-aux 'binary-append (w state))
+(get-event 'binary-append (w state))
+
+(get-event-aux 'write-byte$ (w state))
+(get-event 'write-byte$ (w state))
+
+(defun UGLY (X)
+  (DECLARE
+   (XARGS :GUARD T
+          :GUARD-HINTS (("Goal" :USE ((:INSTANCE DEFAULT-CAR))))
+          :VERIFY-GUARDS NIL))
+  (IF (CONSP X) (UGLY (CDR X)) 0))
+
+(get-event-aux 'ugly (w state))
+(get-event 'ugly (w state))
+
+(xml-ppr-obj (get-event 'ugly (w state))
+             state
+             :topics-fal (make-fast-alist '((acl2::consp . t)
+                                            (acl2::defun . t)
+                                            (acl2::declare . t)
+                                            (acl2::xargs . t)
+                                            (xdoc::ugly . t)
+                                            (acl2::cdr . t)))
+             :base-pkg 'xdoc::foo)
+
+||#
+
+(defun get-def (fn world)
+  (get-event fn world))
+
+(defun get-theorem (name world)
+  ;; BOZO maybe do some cleaning to remove hints, etc.
+  (get-event name world))
+
+#||
+
+(defmacro foo ()
+  `(progn (logic)
+          (make-event
+           '(encapsulate
+              (((h *) => *))
+              (local (defun h (x) (+ x 1)))
+              (defun f (x) (+ x 1))
+              (defun g (x) (+ x 2))))))
+
+(defstobj st fld)
+
+(defun-sk all-integerp (x)
+  (forall a (implies (member-equal a x)
+                     (integerp a))))
+
+(defconst *const* 3)
+
+(foo)
+
+(get-event 'undefined (w state)) ; good, fails
+(get-event 'append (w state))
+(get-event 'binary-append (w state))
+(get-event 'st (w state))
+(get-event 'fld (w state)) ;; bad? returns the whole stobj
+(get-event 'all-integerp (w state))
+(get-event 'all-integerp-witness (w state)) ;; good i guess - returns the encapsulate
+(get-event 'f (w state))
+(get-event 'h (w state)) ;; good i guess, returns the encapsulate
+(get-event 'acl2::car-cons (w state))
+(get-event '*const* (w state))
+
+(get-formals 'binary-append (w state))  ;; --> (ACL2::X ACL2::Y)
+(get-formals 'append (w state)) ;; --> (ACL2::X ACL2::Y &REST ACL2::RST)
+(get-formals 'all-integerp-witness (w state)) ;; good, works
+(get-formals 'all-integerp (w state)) ;; good, works
+(get-formals 'fld (w state)) ;; good, works
+(get-formals 'st (w state)) ;; good, fails
+
+(get-measure 'binary-append (w state)) ;; good, works
+(get-measure 'append (w state))  ;; good, fails
+(get-measure 'st (w state)) ;; good, fails
+(get-measure 'fld (w state)) ;; good, fails
+(get-measure 'all-integerp-witness (w state)) ;; good, fails
+(get-measure 'all-integerp (w state)) ;; good, fails
+
+(get-guard 'binary-append (w state)) ;; good, works
+(get-guard 'append (w state)) ;; hrmn -- fails?
+(get-guard 'all-integerp-witness (w state)) ;; NIL???
+(get-guard 'all-integerp (w state)) ;; NIL???
+(get-guard 'fld (w state)) ;; works
+(get-guard 'st (w state)) ;; good, fails
+
+||#
+
+
+; -------------- Preprocessor Command Parsing  ------------------
+
+
+; Convention: X is a string we are traversing, N is our current position in the
+; string, and XL is the length of the string.  See autolink.lisp.
+
+(defun read-literal (x n xl chars) ;; ==> (MV SUCCESSP N-PRIME)
+  ;; Try to read CHARS, verbatim.
+  (declare (type string x))
+  (cond ((eql n xl)
+         (mv (atom chars) n))
+        ((consp chars)
+         (if (eql (char x n) (car chars))
+             (read-literal x (+ n 1) xl (cdr chars))
+           (mv nil n)))
+        (t
+         (mv t n))))
+
+(defun read-through-some-char-aux (x n xl chars acc) ;; ==> (MV SUCCESSP STRING N-PRIME)
+  (declare (type string x))
+  (if (eql xl n)
+      (mv nil (str::rchars-to-string acc) n)
+    (let ((charN (char x n)))
+      (if (member charN chars)
+          (mv t (str::rchars-to-string (cons charN acc)) n)
+        (read-through-some-char-aux x (+ 1 n) xl chars (cons charN acc))))))
+
+(defun read-through-some-char (x n xl chars)
+  ;; Try to read until one of CHARS is found
+  (declare (type string x))
+  (read-through-some-char-aux x n xl chars nil))
+
+(defun skip-past-ws (x n xl) ;; ==> N-PRIME
+  (declare (type string x))
+  (cond ((eql xl n)
+         n)
+        ((member (char x n) '(#\Space #\Tab #\Newline #\Page))
+         (skip-past-ws x (+ 1 n) xl))
+        (t
+         n)))
+
+(defun parse-directive (x n xl base-pkg kpa) ;; ==> (MV ERROR COMMAND ARG N-PRIME)
+  ;; Every directive has the form @(command arg)
+  ;; Where command and arg are symbols.
+  ;; We assume @( has just been read, and N is now pointing right after the open paren.
+  (declare (type string x))
+  (b* ((n                    (skip-past-ws x n xl))
+       ;; We want to get nice error messages here, because if there'a a directive we
+       ;; really do expect it to be a valid symbol.
+       ((mv error command n) (parse-symbol x n xl (pkg-witness "XDOC") kpa t))
+       ((when error)
+        (mv error nil nil n))
+       (n                    (skip-past-ws x n xl))
+       ((mv error arg n)     (parse-symbol x n xl base-pkg kpa t)))
+      (cond
+       ;; Some error parsing arg.  Add a little more context.
+       (error (mv (str::cat "In " (symbol-name command) " directive: " error)
+                  nil nil n))
+
+       ;; Ends with ), good.
+       ((and (< n xl)
+             (eql (char x n) #\)))
+        (mv nil command arg (+ n 1)))
+
+       (t
+        (mv (str::cat "In " (symbol-name command) " directive, expected ) after "
+                      (symbol-name arg)
+                      ". Near " (error-context x n xl) ".")
+            nil nil n)))))
+
+;; (let ((x "body foo)"))
+;;   (parse-directive x 0 (length x) 'acl2::foo))
+
+;; (let ((x "body foo) bar"))
+;;   (parse-directive x 0 (length x) 'acl2::foo))
+
+;; (let ((x "body xdoc::foo) bar"))
+;;   (parse-directive x 0 (length x) 'acl2::foo))
+
+;; (let ((x "xdoc::body xdoc::foo) bar"))
+;;   (parse-directive x 0 (length x) 'acl2::foo))
+
+;; (let ((x "acl2::body xdoc::foo) bar"))
+;;   (parse-directive x 0 (length x) 'acl2::foo))
+
+;; (let ((x "acl2::body)xdoc::foo) bar"))
+;;   (parse-directive x 0 (length x) 'acl2::foo))
+
+
+
+
+; -------------- Executing Directives ---------------------------
+
+(defun process-url-directive (arg state acc) ;; ===> (MV ACC STATE)
+
+; @(url foo) just expands into the file name for foo.
+
+  (b* ((acc            (file-name-mangle arg acc)))
+      (mv acc state)))
+
+
+(defun process-sym-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(sym foo) just expands into the standard name mangling for foo
+
+  (b* ((acc            (sym-mangle arg base-pkg acc)))
+      (mv acc state)))
+
+
+(defun process-sym-cap-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(csym foo) just expands into the standard capitalized name mangling for foo
+
+  (b* ((acc            (sym-mangle-cap arg base-pkg acc)))
+      (mv acc state)))
+
+
+(defun process-see-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(see foo) just expands into a link with a lowercase name.
+
+  (b* ((acc            (str::revappend-chars "<see topic=\"" acc))
+       (acc            (file-name-mangle arg acc))
+       (acc            (str::revappend-chars "\">" acc))
+       (acc            (sym-mangle arg base-pkg acc))
+       (acc            (str::revappend-chars "</see>" acc)))
+      (mv acc state)))
+
+
+(defun process-see-cap-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(csee foo) just expands into a link with a capitalized name.
+
+  (b* ((acc            (str::revappend-chars "<see topic=\"" acc))
+       (acc            (file-name-mangle arg acc))
+       (acc            (str::revappend-chars "\">" acc))
+       (acc            (sym-mangle-cap arg base-pkg acc))
+       (acc            (str::revappend-chars "</see>" acc)))
+      (mv acc state)))
+
+
+;; (defconst *xdoc-link-file-message*
+;;   "; This is an XDOC Link file.
+;; ; Ordinarily, you should not see this file.
+;; ;
+;; ; If you are viewing this file in a web browser, you probably
+;; ; have not configured your web browser to send .xdoc-link files
+;; ; to Emacs.
+;; ;
+;; ;   (Or, if you have already done that, but you accessed this
+;; ;    file through a web server, the server may just not be
+;; ;    assigning .xdoc-link files the appropriate MIME type.)
+;; ;
+;; ; If you are viewing this file in Emacs, you probably have not
+;; ; loaded xdoc.el from the xdoc/ directory.
+;; ;
+;; ; Please see the XDOC manual for more information.")
+
+(defun process-srclink-directive (arg dir state acc) ;; ===> (MV ACC STATE)
+
+; We previously did two things:
+;
+;   1. Extend acc with a srclink tag, and
+;
+;   2. Write a .xdoc-link file to dir for this tag, unless DIR is NIL in
+;      which case we skip this step
+;
+; This was kind of ugly in that we may write the same .xdoc-link file many
+; times, but this didn't seem to practically be a problem.
+;
+; Our emacs linking mechanism is slightly broken, in that all we can tell emacs
+; is the name of a symbol to look for using its tags mechanism.  We are hoping
+; that:
+;
+;   1. The user has the appropriate TAGS tables set up (reasonable),
+;
+;   2. The symbol is actually defined in a source file somewhere, instead of
+;      being introduced by a macro or something, and
+;
+;   3. The symbol is not defined in multiple packages, so that the user will be
+;      taken to the right source file.  (That is, we can't tell emacs something
+;      like "foo::bar", because it doesn't understand (in-package ...); We can
+;      only tell it to search for bar.)
+;
+; Whether or not #2 and #3 hold is a total crap-shoot, and we're basically
+; hoping that most of the time find-tag will take them to the right place.
+;
+; We no longer write .srclink files because the fancy viewer doesn't need them;
+; it uses a fancy URL scheme along the lines of:
+;    data:application/x-acl2-xdoc-link;charset=utf-8,<contents>
+; where <contents> are the entire source link file we previously generated.
+; Web browsers understand this and can "open" the "file" that they've just
+; been given directly in the URL.
+
+  (b* ((shortname (explode (str::downcase-string (symbol-name arg))))
+
+       ; NOTE: for srclink support in the classic viewer, we needed to include
+       ; the file=... part.  We need it or use it in the fancy viewer.  The
+       ; fancy viewer only uses the shortname, i.e., the text of the link.
+       ; Well, since we've broken srclinks in the classic viewer anyway, may
+       ; as well not include it.
+
+       ;; (filename  (b* ((nacc (file-name-mangle arg nil))
+       ;;                 (nacc (str::revappend-chars ".xdoc-link" nacc)))
+       ;;             (str::rchars-to-string nacc)))
+       ;; (acc (str::revappend-chars "<srclink file=\"" acc))
+       ;; (acc (str::revappend-chars filename acc))
+       ;; (acc (str::revappend-chars "\">" acc))
+
+       (acc (str::revappend-chars "<srclink>" acc))
+       (acc (simple-html-encode-chars shortname acc))
+       (acc (str::revappend-chars "</srclink>" acc))
+
+       ((unless dir)
+        ;; This is an important hack for, e.g., :xdoc to work correctly.  If
+        ;; DIR is nil, then don't actually try to write any files!
+        (mv acc state))
+
+       ;; It seems nice to get rid of this.  It'll break source links in the
+       ;; classic viewer.  That seems okay.  In exchange we don't need catpath.
+       ;; (fullpath           (oslib::catpath dir filename))
+       ;; ((mv channel state) (open-output-channel fullpath :character state))
+       ;; (state (princ$ *xdoc-link-file-message* channel state))
+       ;; (state (newline channel state))
+       ;; (state (newline channel state))
+       ;; (state (princ$ (coerce shortname 'string) channel state))
+       ;; (state (newline channel state))
+       ;; (state (close-output-channel channel state))
+       )
+      (mv acc state)))
+
+(defun process-body-directive (arg topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(body foo) -- look up the body and pretty-print it in a <code> block.
+
+  (b* ((body           (get-body arg (w state)))
+       (acc            (str::revappend-chars "<code>" acc))
+       ((mv acc state) (xml-ppr-obj-aux body topics-fal base-pkg state acc))
+       (acc            (str::revappend-chars "</code>" acc)))
+      (mv acc state)))
+
+(defun process-def-directive (arg dir topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(def foo) -- look up the definition for foo, pretty-print it in a <code>
+; block, along with a source-code link.
+
+  (b* ((def            (get-def arg (w state)))
+       (acc            (str::revappend-chars "<p><b>Definition: </b>" acc))
+       ((mv acc state) (process-srclink-directive arg dir state acc))
+       (acc            (str::revappend-chars "</p>" acc))
+       (acc            (str::revappend-chars "<code>" acc))
+       ((mv acc state) (xml-ppr-obj-aux def topics-fal base-pkg state acc))
+       (acc            (str::revappend-chars "</code>" acc)))
+      (mv acc state)))
+
+(defun process-gdef-directive (arg topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(gdef foo) -- Look up the definition for foo, pretty-print it as in @def,
+; but don't use a source-code link because this is a "Generated Definition" for
+; which a tags-search will probably fail.
+
+  (b* ((def            (get-def arg (w state)))
+       (acc            (str::revappend-chars "<p><b>Definition: </b>" acc))
+       (acc            (sym-mangle arg base-pkg acc))
+       (acc            (str::revappend-chars "</p>" acc))
+       (acc            (str::revappend-chars "<code>" acc))
+       ((mv acc state) (xml-ppr-obj-aux def topics-fal base-pkg state acc))
+       (acc            (str::revappend-chars "</code>" acc)))
+      (mv acc state)))
+
+(defun process-thm-directive (arg dir topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(thm foo) -- Look up the theorem named foo, and pretty-print its event along
+; with a source link.
+
+  (b* ((theorem        (get-theorem arg (w state)))
+       (acc            (str::revappend-chars "<p><b>Theorem: </b>" acc))
+       ((mv acc state) (process-srclink-directive arg dir state acc))
+       (acc            (str::revappend-chars "</p>" acc))
+       (acc            (str::revappend-chars "<code>" acc))
+       ((mv acc state) (xml-ppr-obj-aux theorem topics-fal base-pkg state acc))
+       (acc            (str::revappend-chars "</code>" acc)))
+      (mv acc state)))
+
+(defun process-gthm-directive (arg topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(gthm foo) -- Like @(thm foo), but don't provide a source link since this is
+; a generated theorem.
+
+  (b* ((theorem        (get-theorem arg (w state)))
+       (acc            (str::revappend-chars "<p><b>Theorem: </b>" acc))
+       (acc            (sym-mangle arg base-pkg acc))
+       (acc            (str::revappend-chars "</p>" acc))
+       (acc            (str::revappend-chars "<code>" acc))
+       ((mv acc state) (xml-ppr-obj-aux theorem topics-fal base-pkg state acc))
+       (acc            (str::revappend-chars "</code>" acc)))
+      (mv acc state)))
+
+(defun process-formals-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(formals foo) -- just find the formals for foo and print them without any
+; extra formatting.
+
+  (b* ((formals        (get-formals arg (w state)))
+       ((mv acc state) (fmt-and-encode-to-acc formals base-pkg state acc)))
+      (mv acc state)))
+
+(defun process-call-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(call foo) -- find the formals to foo and insert <tt>(foo x y z)</tt>.
+; BOZO consider adding an emacs link.
+
+  (b* ((formals        (get-formals arg (w state)))
+       (call           (cons arg formals))
+       (acc            (str::revappend-chars "<tt>" acc))
+       ((mv acc state) (fmt-and-encode-to-acc call base-pkg state acc))
+       (acc            (str::revappend-chars "</tt>" acc)))
+      (mv acc state)))
+
+(defun process-ccall-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(ccall foo) -- "code call" is like @(call foo), but uses <code> instead
+; of <tt> tags.
+
+  (b* ((formals        (get-formals arg (w state)))
+       (call           (cons arg formals))
+       (acc            (str::revappend-chars "<code>" acc))
+       ((mv acc state) (fmt-and-encode-to-acc call base-pkg state acc))
+       (acc            (str::revappend-chars "</code>" acc)))
+      (mv acc state)))
+
+(defun process-measure-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; @(measure foo) -- find the measure for foo and print it without any extra
+; formatting.
+
+  (b* ((measure        (get-measure arg (w state)))
+       ((mv acc state) (fmt-and-encode-to-acc measure base-pkg state acc)))
+      (mv acc state)))
+
+
+(defun process-directive (command arg dir topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
+
+; Command and Arg are the already-parsed symbols we have read from the
+; documentation string.  Carry out whatever directive we've been asked to do.
+; DIR is the output dir.  Acc is the accumulator for our output characters.
+
+  (case command
+    (def       (process-def-directive     arg dir topics-fal base-pkg state acc))
+    (thm       (process-thm-directive     arg dir topics-fal base-pkg state acc))
+    (srclink   (process-srclink-directive arg dir state acc))
+    (gdef      (process-gdef-directive    arg topics-fal base-pkg state acc))
+    (gthm      (process-gthm-directive    arg topics-fal base-pkg state acc))
+    (body      (process-body-directive    arg topics-fal base-pkg state acc))
+    (formals   (process-formals-directive arg base-pkg state acc))
+    (measure   (process-measure-directive arg base-pkg state acc))
+    (call      (process-call-directive    arg base-pkg state acc))
+    (ccall     (process-ccall-directive   arg base-pkg state acc))
+    (url       (process-url-directive     arg state acc))
+    (see       (process-see-directive     arg base-pkg state acc))
+    (csee      (process-see-cap-directive arg base-pkg state acc))
+    (sym       (process-sym-directive     arg base-pkg state acc))
+    (csym      (process-sym-cap-directive arg base-pkg state acc))
+    (otherwise
+     (progn$
+      (and (xdoc-verbose-p)
+           (cw "; xdoc error: unknown directive ~x0.~%" command))
+      (let* ((acc (str::revappend-chars "[[ unknown directive " acc))
+             (acc (str::revappend-chars (symbol-package-name command) acc))
+             (acc (str::revappend-chars "::" acc))
+             (acc (str::revappend-chars (symbol-name command) acc))
+             (acc (str::revappend-chars "]]" acc)))
+        (mv acc state))))))
+
+
+
+
+; Ugly special hacks for some problems with <code> segments.
+;
+; As an example, consider:
+;
+;  |(defxdoc ...
+;  |  :long "<p>blah blah blah</p>
+;  |
+;  |<p>blah blah blah</p>
+;  |
+;  |<code>
+;  |(example-sexpr ...)
+;  |</code>
+;  |
+;  |<p>blah blah blah</p>")
+;
+; The <code> block above causes problems for Emacs, because the algorithm for
+; figuring out where an S-expression begins seems to basically look for an
+; opening paren at the start of a line.  The result is that Emacs thinks the
+; "(example-sexpr ...)" is the start of a form, rather than the "(defxdoc
+; ...)," which can cause incorrect and irritating syntax highlighting, and can
+; also cause problems for commands like "C-t e" that want to send a form to the
+; *shell* buffer.  To cope with this, I typically indent <code> blocks with a
+; single space, e.g.,
+;
+;  |<code>                   instead of    |<code>
+;  | (example-sexpr ...)                   |(example-sexpr ...)
+;  |</code>                                |</code>
+;
+; but, this convention isn't followed by the code blocks introduced with @(def
+; ...)  and similar, and so the <code> blocks I write may not line up right
+; with generated code blocks.
+;
+; To fix this, we look at the text between <code> and </code>, and if every
+; line begins with a space, we eat those spaces.
+
+(encapsulate
+  ()
+  (local (defthm first-n-ac-expand
+           (implies (syntaxp (quotep i))
+                    (equal (first-n-ac i l ac)
+                           (cond ((zp i) (reverse ac))
+                                 (t (first-n-ac (1- i)
+                                                (cdr l)
+                                                (cons (car l) ac))))))))
+
+  (defun just-started-code-p (acc)
+    (declare (xargs :guard (true-listp acc)))
+    (mbe :logic (equal (take 6 acc)
+                       (reverse (coerce "<code>" 'list)))
+         :exec
+         (and (consp (cdr (cdr (cdr (cdr (cdr acc))))))
+              (eql (first acc) #\>)
+              (eql (second acc) #\e)
+              (eql (third acc) #\d)
+              (eql (fourth acc) #\o)
+              (eql (fifth acc) #\c)
+              (eql (sixth acc) #\<)))))
+
+(defun read-code-segment (x n xl acc always-spacep)
+  "Returns (MV N ACC ALWAYS-SPACEP)"
+
+; We assume we're inside a <code> block.  We read until </code> is found,
+; gathering the characters we see and tracking whether each newline is followed
+; by a space.
+
+  (b* (((when (>= n xl))
+        (mv n acc always-spacep))
+
+       (char-n (char x n))
+       ((when (and (eql char-n #\<)
+                   (str::strprefixp-impl "</code>" x 0 n
+                                         7 ;; (length "</code>")
+                                         xl)))
+        ;; Found </code> tag, so stop reading
+        (mv n acc always-spacep))
+
+       (acc (cons char-n acc))
+       ((unless (eql char-n #\Newline))
+        ;; A normal character, just accumulate it.
+        (read-code-segment x (+ 1 n) xl acc always-spacep))
+
+       (n (+ 1 n))
+       ((when (>= n xl))
+        ;; End of string while reading <code>?  Shouldn't really happen...
+        (mv n acc always-spacep))
+
+       (char-n (char x n))
+       ((when (eql char-n #\<))
+        ;; We allow the </code> to come without a space.
+        (mv n acc always-spacep))
+
+       (acc (cons char-n acc))
+       (always-spacep (and always-spacep
+                           (or (eql char-n #\Space)
+                               (eql char-n #\Newline)))))
+    (read-code-segment x (+ 1 n) xl acc always-spacep)))
+
+(defun revappend-code-chars (code-chars acc always-spacep)
+  (b* (((when (atom code-chars))
+        acc)
+       (char1 (car code-chars))
+       (acc   (cons char1 acc))
+       ((unless (eql char1 #\Newline))
+        (revappend-code-chars (cdr code-chars) acc always-spacep))
+       ((when (and always-spacep
+                   (consp (cdr code-chars))
+                   (eql (second code-chars) #\Space)))
+        ;; Skip the first space
+        (revappend-code-chars (cddr code-chars) acc always-spacep)))
+    (revappend-code-chars (cdr code-chars) acc always-spacep)))
+
+(defun transform-code-segments (x n xl acc)
+  (b* (((when (>= n xl))
+        acc)
+       (char-n (char x n))
+       (acc    (cons char-n acc))
+       (n      (+ 1 n))
+       ((unless (and (eql char-n #\>)
+                     (just-started-code-p acc)))
+        (transform-code-segments x n xl acc))
+       ;; Started a code segment.
+       ((mv n code-acc always-spacep)
+        (read-code-segment x n xl nil t))
+       (code-chars (reverse code-acc))
+       (acc (revappend-code-chars code-chars acc always-spacep)))
+    (transform-code-segments x n xl acc)))
+
+(defun transform-code (x)
+  ;; Fix leading spaces in <code> segments
+  (str::rchars-to-string (transform-code-segments x 0 (length x) nil)))
+
+;; (transform-code 
+;; "<p>This is 
+;; some regular text</p>
+;; <code>
+;;     blah1
+;;     <blah>blah2</blah>
+;;     blah3
+;; </code>
+;; <p>And more text</p>")
+
+(defun advance-line (x n xl)
+  ;; Returns the index of the next newline after character N, or else XL
+  (b* (((when (eql n xl))
+        n)
+       (c (char x n))
+       ((when (eql c #\Newline))
+        n))
+    (advance-line x (+ 1 n) xl)))
+
+(defun all-lines-start-with-space-p (x n xl)
+  ;; Assumptions:
+  ;;  - We are starting a line
+  ;;  - Every line we've seen so far starts with a space
+  (b* (((when (>= n xl))
+        ;; DO NOT WEAKEN TO (= N XL).  We unusually allow this to exceed the
+        ;; string length; consider the call of advance-line below.
+        ;; Success, reached end of string, no space required
+        t)
+       (c (char x n))
+       ((when (eql c #\Newline))
+        ;; Fine, blank line, no space required
+        (all-lines-start-with-space-p x (+ 1 n) xl))
+       ((when (eql c #\Space))
+        ;; Fine, has a space, skip to next line
+        (b* ((n (advance-line x (+ 1 n) xl)))
+          (all-lines-start-with-space-p x (+ 1 n) xl))))
+    ;; Nope, found a non-space char at start of the line.
+    nil))
+
+(encapsulate
+  ()
+  (logic)
+
+  (local
+   (progn
+
+     (defun test (x)
+       (declare (xargs :mode :program))
+       (all-lines-start-with-space-p x 0 (length x)))
+
+     (assert! (test " foo
+ bar
+ baz"))
+
+     (assert! (not (test " foo
+bar
+ baz")))
+
+     (assert! (test " foo
+
+ bar
+ baz
+"))
+
+     (assert! (not (test "foo
+ bar
+baz
+"))))))
+
+(defun delete-leading-line-space (x n xl acc)
+  ;; Assumes (all-lines-start-with-space-p x n xl)
+  (b* (((when (>= n xl))
+        acc)
+       (c (char x n))
+       ((when (eql c #\Newline))
+        (delete-leading-line-space x (+ 1 n) xl (cons c acc)))
+       ;; Else it must be a space.  Skip the space but copy the other chars
+       ;; through the end of the line.
+       (start (+ 1 n))
+       (end   (advance-line x start xl))
+       ;; BOZO abuse of revappend-chars-aux to only copy until end...
+       ;; should fix its guard to allow this sort of thing
+       (acc   (str::revappend-chars-aux x start end acc)))
+    (delete-leading-line-space x end xl acc)))
+
+(defun maybe-fix-spaces-in-sub (x)
+  (declare (type string x))
+  (b* ((xl (length x))
+       ((unless (all-lines-start-with-space-p x 0 xl))
+        ;; Fine, don't do anything
+        x)
+       (acc (delete-leading-line-space x 0 xl nil)))
+    (str::rchars-to-string acc)))
+
+(encapsulate
+  ()
+  (logic)
+
+  (local
+   (progn
+
+     (defun test (x expect)
+       (declare (xargs :mode :program))
+       (equal (maybe-fix-spaces-in-sub x) expect))
+
+     (assert! (test " foo
+ bar
+ baz"
+                    "foo
+bar
+baz"))
+
+     (assert! (test " foo
+bar
+ baz"
+                    " foo
+bar
+ baz"))
+
+     (assert! (test " foo
+
+ bar
+ baz
+"
+                    "foo
+
+bar
+baz
+"))
+
+     (assert! (test "foo
+ bar
+baz
+"
+                    "foo
+ bar
+baz
+")))))
+
+
+(defun fancy-trim-start (x n xl new-start)
+  (b* (((when (eql n xl))
+        ;; saw nothing but spaces and newlines, turn it into the empty string.
+        n)
+       (c (char x n))
+       (n (+ 1 n))
+       ((when (eql c #\Space))
+        (fancy-trim-start x n xl new-start))
+       ((when (eql c #\Newline))
+        (fancy-trim-start x n xl n)))
+    new-start))
+
+(defun fancy-trim-stop (x n start)
+  ;; N counts down from (length x) to start.
+  (b* (((when (<= n start))
+        ;; saw nothing but spaces and newlines, turn it into the empty string.
+        start)
+       (n (- n 1))
+       (c (char x n))
+       ((when (or (eql c #\Space)
+                  (eql c #\Newline)
+                  (eql c #\Tab)))
+        (fancy-trim-stop x n start)))
+    n))
+
+(defun fancy-extract-block (x start end)
+  (b* ((start (fancy-trim-start x start end start))
+       (end   (+ 1 (fancy-trim-stop x end start)))
+       ((unless (<= start end))
+        ""))
+    (subseq x start end)))
+
+
+
+
+
+(defun preprocess-aux (x n xl dir topics-fal base-pkg kpa state acc)
+  "Returns (MV ACC STATE)"
+  (declare (type string x))
+
+; Main preprocessor loop.  Read from the string and accumulate the result into
+; acc, expanding away any preprocessor directives.
+
+  (b* (((when (= n xl))
+        (mv acc state))
+
+       (char (char x n))
+       ((when (eql char #\@))
+        (cond ((and (< (+ n 1) xl)
+                    (eql (char x (+ n 1)) #\@))
+               ;; @@ --> @
+               (preprocess-aux x (+ n 2) xl dir topics-fal base-pkg kpa state (cons #\@ acc)))
+
+              ((and (< (+ n 1) xl)
+                    (eql (char x (+ n 1)) #\())
+               ;; @( --> directive
+               (b* (((when (and (< (+ n 2) xl)
+                                (eql (char x (+ n 2)) #\')))
+                     ;; @(' directive -- turns into raw <tt> block with auto linking
+                     (b* ((end (str::strpos-fast "')" x (+ n 2) 2 xl))
+                          ((unless end)
+                           (prog2$ (and (xdoc-verbose-p)
+                                        (cw "; xdoc error: no closing ') found for @(' ...~%"))
+                                   (mv acc state)))
+                          (sub (fancy-extract-block x (+ n 3) end))
+                          (acc (str::revappend-chars "<tt>" acc))
+                          (acc (autolink-and-encode sub 0 (length sub) topics-fal base-pkg kpa acc))
+                          (acc (str::revappend-chars "</tt>" acc)))
+                       (preprocess-aux x (+ end 2) xl dir topics-fal base-pkg kpa state acc)))
+
+                    ((when (and (< (+ n 2) xl)
+                                (eql (char x (+ n 2)) #\{)))
+                     ;; @({ directive -- turns into raw <code> block with auto linking
+                     (b* ((end (str::strpos-fast "})" x (+ n 2) 2 xl))
+                          ((unless end)
+                           (prog2$ (and (xdoc-verbose-p)
+                                        (cw "; xdoc error: no closing }) found for @({ ...~%"))
+                                   (mv acc state)))
+                          (sub (maybe-fix-spaces-in-sub (fancy-extract-block x (+ n 3) end)))
+                          (acc (str::revappend-chars "<code>" acc))
+                          (acc (autolink-and-encode sub 0 (length sub) topics-fal base-pkg kpa acc))
+                          (acc (str::revappend-chars "</code>" acc)))
+                       (preprocess-aux x (+ end 2) xl dir topics-fal base-pkg kpa state acc)))
+
+
+                    ((mv error command arg n) (parse-directive x (+ n 2) xl base-pkg kpa))
+                    ((when error)
+                     (prog2$ (and (xdoc-verbose-p)
+                                  (cw "; xdoc error: ~x0.~%" error))
+                             (mv acc state)))
+                    ((mv acc state)
+                     (process-directive command arg dir topics-fal base-pkg state acc)))
+                 (preprocess-aux x n xl dir topics-fal base-pkg kpa state acc)))
+
+              (t
+               ;; @ sign in some other context.
+               (preprocess-aux x (+ n 1) xl dir topics-fal base-pkg kpa state (cons #\@ acc)))))
+
+       ((when (eql char #\Newline))
+        ;; Gross hack #1: eat initial newlines from the start of a <code>
+        ;; block, since otherwise they look ugly when firefox renders them.
+        (if (just-started-code-p acc)
+            (if (and (< (+ n 1) xl)
+                     (eql (char x (+ n 1)) #\Newline))
+                ;; Avoid eating multiple newlines at the start of a code block.
+                (preprocess-aux x (+ n 2) xl dir topics-fal base-pkg kpa state (cons #\Newline acc))
+              (preprocess-aux x (+ n 1) xl dir topics-fal base-pkg kpa state acc))
+          ;; Gross hack #2: the XSLT transformer in firefox seems to have some
+          ;; problems if there aren't spaces at the end of lines, e.g., it will
+          ;; run together the hover-text in the hierarchical description in
+          ;; preview.html.  Fix by putting a space before newlines.  Horrible.
+          (preprocess-aux x (+ n 1) xl dir topics-fal base-pkg kpa state
+                          (list* #\Newline #\Space acc)))))
+
+    ;; Otherwise just keep the char and keep going.
+    (preprocess-aux x (+ n 1) xl dir topics-fal base-pkg kpa state (cons char acc))))
+
+(defun preprocess-main (x dir topics-fal base-pkg state acc)
+  (declare (type (or string null) x))
+  (b* ((x (or x ""))
+       ;; (current-pkg    (acl2::f-get-global 'current-package state))
+       ;; Temporarily make "fmt" print as if it's in base-pkg.
+       ;; ((mv & & state) (acl2::set-current-package (symbol-package-name base-pkg) state))
+       (kpa            (known-package-alist state))
+       (x              (transform-code x))
+       ((mv acc state) (preprocess-aux x 0 (length x) dir topics-fal base-pkg kpa state acc))
+       ;; Restore base-pkg for whoever called us.
+       ;; ((mv & & state) (acl2::set-current-package current-pkg state))
+       )
+      (mv acc state)))
+
diff -Nru acl2-6.2/books/xdoc/save-classic.lisp acl2-6.3/books/xdoc/save-classic.lisp
--- acl2-6.2/books/xdoc/save-classic.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/save-classic.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,513 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+; save.lisp
+;
+; This file defines the XDOC functions for running the preprocessor and saving
+; XML files.  Note that the save-topics command we introduce cannot actually be
+; used unless the oslib/mkdir book is loaded first.  This is automatically
+; handled by the "save" macro in top.lisp.
+
+(in-package "XDOC")
+(include-book "prepare-topic")
+(include-book "oslib/catpath" :dir :system)
+(include-book "oslib/logic-defs" :dir :system)
+(set-state-ok t)
+
+(program)
+
+(defconst *acl2-graphics*
+  ;; Blah, horrible
+  (list "acl2-logo-200-134.gif"
+        "acl2-logo-62-41.gif"
+        "acl2-system-architecture.gif"
+        "automatic-theorem-prover.gif"
+        "binary-trees-app-expl.gif"
+        "binary-trees-app.gif"
+        "binary-trees-x-y.gif"
+        "book04.gif"
+        "bridge-analysis.gif"
+        "bridge.gif"
+        "chem01.gif"
+        "common-lisp.gif"
+        "computing-machine-5x7.gif"
+        "computing-machine-5xy.gif"
+        "computing-machine-a.gif"
+        "computing-machine.gif"
+        "computing-machine-xxy.gif"
+        "concrete-proof.gif"
+        "doc03.gif"
+        "docbag2.gif"
+        "door02.gif"
+        "file03.gif"
+        "file04.gif"
+        "flying.gif"
+        "ftp2.gif"
+        "gift.gif"
+        "green-line.gif"
+        "index.gif"
+        "info04.gif"
+        "interactive-theorem-prover-a.gif"
+        "interactive-theorem-prover.gif"
+        "landing.gif"
+        "large-flying.gif"
+        "large-walking.gif"
+        "llogo.gif"
+        "logo.gif"
+        "mailbox1.gif"
+        "new04.gif"
+        "note02.gif"
+        "open-book.gif"
+        "pisa.gif"
+        "proof.gif"
+        "sitting.gif"
+        "stack.gif"
+        "state-object.gif"
+        "teacher1.gif"
+        "teacher2.gif"
+        "time-out.gif"
+        "tools3.gif"
+        "twarning.gif"
+        "uaa-rewrite.gif"
+        "walking.gif"
+        "warning.gif"
+        ))
+
+(defun clean-topics-aux (x seen-names-fal)
+  ;; Remove topics we've already seen.
+  (b* (((when (atom x))
+        (fast-alist-free seen-names-fal)
+        nil)
+       (name1 (cdr (assoc :name (car x))))
+
+       ((when (hons-get name1 seen-names-fal))
+        (cw "~|WARNING: dropping shadowed topic for ~x0.~%" name1)
+        (clean-topics-aux (cdr x) seen-names-fal))
+
+       (seen-names-fal (hons-acons name1 t seen-names-fal)))
+    (cons (car x)
+          (clean-topics-aux (cdr x) seen-names-fal))))
+
+(defun clean-topics (x)
+  (clean-topics-aux x (len x)))
+
+; --------------------- File Copying ----------------------------
+
+(defun stupid-copy-file-aux (in out state)
+
+; In, out are channels.  Copy from in to out, one byte at a time.
+
+  (b* (((mv byte state) (read-byte$ in state))
+       ((unless byte)
+        state)
+       (state (write-byte$ byte out state)))
+    (stupid-copy-file-aux in out state)))
+
+(defun stupid-copy-file (src dest state)
+
+; A stupid file copy routine, so we can copy our style files, etc.  We avoid
+; using "system" because of memory problems with forking on huge images.
+
+  (b* (((mv in state)  (open-input-channel src :byte state))
+       ((mv out state) (open-output-channel dest :byte state))
+       (state          (stupid-copy-file-aux in out state))
+       (state          (close-input-channel in state))
+       (state          (close-output-channel out state)))
+      state))
+
+(defun stupid-copy-files (srcdir filenames destdir state)
+  (b* (((when (atom filenames))
+        state)
+       (srcfile  (oslib::catpath srcdir (car filenames)))
+       (destfile (oslib::catpath destdir (car filenames)))
+       (state    (stupid-copy-file srcfile destfile state)))
+    (stupid-copy-files srcdir (cdr filenames) destdir state)))
+
+
+
+; ---------------- Hierarchical Index Generation ----------------
+
+(defun normalize-parents (x)
+
+; Given an xdoc entry, remove duplicate parents and self-parents.
+
+  (let* ((name    (cdr (assoc :name x)))
+         (parents (cdr (assoc :parents x)))
+         (orig    parents)
+         (parents (if (member-equal name parents)
+                      (prog2$
+                       (cw "; xdoc note: removing self-referencing :parents entry for ~x0.~%" name)
+                       (remove-equal name parents))
+                    parents))
+         (parents (if (no-duplicatesp-equal parents)
+                      parents
+                    (prog2$
+                     (cw "; xdoc note: removing duplicate :parents for ~x0.~%" name)
+                     (remove-duplicates-equal parents)))))
+    (if (equal parents orig)
+        x
+      (acons :parents parents x))))
+
+(defun force-root-parents (all-topics)
+  ;; Assumes the topics have been normalized.
+  (declare (xargs :mode :program))
+  (b* (((when (atom all-topics))
+        nil)
+       (topic (car all-topics))
+       (name    (cdr (assoc :name topic)))
+       (parents (cdr (assoc :parents topic)))
+       ((when (or (equal name 'acl2::top)
+                  (consp parents)))
+        (cons topic (force-root-parents (cdr all-topics))))
+       (- (cw "Relinking top-level ~x0 to be a child of TOPICS.~%" name))
+       (new-topic
+        (cons (cons :parents '(acl2::top))
+              topic)))
+    (cons new-topic (force-root-parents (cdr all-topics)))))
+
+(defun normalize-parents-list (x)
+
+; Clean up parents throughout all xdoc topics.
+
+  (if (atom x)
+      nil
+    (cons (normalize-parents (car x))
+          (normalize-parents-list (cdr x)))))
+
+(defun maybe-add-top-topic (all-topics)
+
+; We do it this way, rather than starting off with a top topic built in, to
+; ensure that the user's choice of a top topic wins.
+
+  (if (find-topic 'acl2::top all-topics)
+      all-topics
+    (cons
+     (list (cons :name 'acl2::top)
+           (cons :base-pkg (acl2::pkg-witness "ACL2"))
+           (cons :parents nil)
+           (cons :short "XDOC Manual -- Top Topic")
+           (cons :long "<p>This is the default top topic for an @(see xdoc)
+           manual.</p>
+
+<p>You may wish to customize this page.  The usual way to do this is to issue
+an @(see xdoc::defxdoc) command immediately before your @(see xdoc::save)
+command, along the following lines:</p>
+
+@({
+    (defxdoc acl2::top
+      :short \"your short text here\"
+      :long \"your long description here.\")
+})
+
+<p>Your topic should then automatically overwrite this default page.</p>")
+           (cons :from "[books]/xdoc/save-classic.lisp"))
+     all-topics)))
+
+(defun find-roots (x)
+
+; Gather names of all doc topics which have no parents.
+
+  (if (atom x)
+      nil
+    (if (not (cdr  (assoc :parents (car x))))
+        (cons (cdr (assoc :name (car x)))
+              (find-roots (cdr x)))
+      (find-roots (cdr x)))))
+
+(defun gather-topic-names (x)
+  (if (atom x)
+      nil
+    (cons (cdr (assoc :name (car x)))
+          (gather-topic-names (cdr x)))))
+
+(defun topics-fal (x)
+  (make-fast-alist (pairlis$ (gather-topic-names x) x)))
+
+
+(defun find-orphaned-topics-1 (child parents topics-fal acc)
+  ;; Returns an alist of (CHILD . MISSING-PARENT)
+  (cond ((atom parents)
+         acc)
+        ((hons-get (car parents) topics-fal)
+         (find-orphaned-topics-1 child (cdr parents) topics-fal acc))
+        (t
+         (find-orphaned-topics-1 child (cdr parents) topics-fal
+                                 (cons (cons child (car parents))
+                                       acc)))))
+
+(defun find-orphaned-topics (x topics-fal acc)
+  (b* (((when (atom x))
+        acc)
+       (child   (cdr (assoc :name (car x))))
+       (parents (cdr (assoc :parents (car x))))
+       (acc     (find-orphaned-topics-1 child parents topics-fal acc)))
+    (find-orphaned-topics (cdr x) topics-fal acc)))
+
+
+
+(mutual-recursion
+
+ (defun make-hierarchy-aux (path dir topics-fal index-pkg all id expand-level acc state)
+
+; - Path is our current location in the hierarchy, and is used to avoid loops.
+;   (The first element in path is the current topic we are on.)
+;
+; - Index-pkg is just used for symbol printing.
+;
+; - All is the list of all xdoc documentation topics.
+;
+; - ID is a number that we assign to this topic entry for hiding with
+;   JavaScript.  (We don't use names because the topics might be repeated under
+;   different parents).
+;
+; - Expand-level is how deep to expand topics, generally 1 by default.
+;
+; - Acc is the character list we are building.
+;
+; We return (MV ACC-PRIME ID-PRIME STATE)
+
+   (b* ((name     (car path))
+        (id-chars (list* #\t #\o #\p #\i #\c #\- (explode-atom id 10)))
+        (depth    (len path))
+        (children (find-children name all))
+        (kind     (cond ((not children) "leaf")
+                        ((< depth expand-level) "show")
+                        (t "hide")))
+
+        ((when    (member-equal name (cdr path)))
+         (prog2$
+          (er hard? 'make-hierarchy "Circular topic hierarchy.  Path is ~x0.~%" path)
+          (mv acc id state)))
+
+        (topic (find-topic name all))
+        (short    (cdr (assoc :short topic)))
+        (base-pkg (cdr (assoc :base-pkg topic)))
+
+        (acc (str::revappend-chars "<hindex topic=\"" acc))
+        (acc (file-name-mangle name acc))
+        (acc (str::revappend-chars "\" id=\"" acc))
+        (acc (revappend id-chars acc))
+        (acc (str::revappend-chars "\" kind=\"" acc))
+        (acc (str::revappend-chars kind acc))
+        (acc (str::revappend-chars "\">" acc))
+        (acc (cons #\Newline acc))
+
+        (acc (str::revappend-chars "<hindex_name>" acc))
+        (acc (sym-mangle-cap name index-pkg acc))
+        (acc (str::revappend-chars "</hindex_name>" acc))
+        (acc (cons #\Newline acc))
+
+        (acc (str::revappend-chars "<hindex_short id=\"" acc))
+        (acc (revappend id-chars acc))
+        (acc (str::revappend-chars "\">" acc))
+        ((mv acc state) (preprocess-main short dir topics-fal base-pkg state acc))
+        (acc (str::revappend-chars "</hindex_short>" acc))
+
+        (acc (str::revappend-chars "<hindex_children id=\"" acc))
+        (acc (revappend id-chars acc))
+        (acc (str::revappend-chars "\" kind=\"" acc))
+        (acc (str::revappend-chars kind acc))
+        (acc (str::revappend-chars "\">" acc))
+        (acc (cons #\Newline acc))
+
+        (id   (+ id 1))
+        ((mv acc id state)
+         (make-hierarchy-list-aux children path dir topics-fal index-pkg all id expand-level acc state))
+        (acc (str::revappend-chars "</hindex_children>" acc))
+        (acc (str::revappend-chars "</hindex>" acc))
+        (acc (cons #\Newline acc)))
+       (mv acc id state)))
+
+ (defun make-hierarchy-list-aux (children path dir topics-fal index-pkg all id expand-level acc state)
+
+; - Children are the children of this path.
+; - Path is our current location in the hierarchy.
+
+   (if (atom children)
+       (mv acc id state)
+     (b* (((mv acc id state)
+           (make-hierarchy-aux (cons (car children) path) dir topics-fal index-pkg all id
+                               expand-level acc state))
+          ((mv acc id state)
+           (make-hierarchy-list-aux (cdr children) path dir topics-fal index-pkg all id
+                                    expand-level acc state)))
+         (mv acc id state)))))
+
+
+(defun save-hierarchy (x dir topics-fal index-pkg expand-level state)
+
+; X is all topics.  We assume all parents are normalized.
+
+  (b* ((roots (mergesort (find-roots x)))
+       (acc   nil)
+       (acc   (str::revappend-chars "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" acc))
+       (acc   (cons #\Newline acc))
+       (acc   (str::revappend-chars "<?xml-stylesheet type=\"text/xsl\" href=\"xml-topic-index.xsl\"?>" acc))
+       (acc   (cons #\Newline acc))
+       (acc   (str::revappend-chars *xml-entity-stuff* acc))
+       (acc   (str::revappend-chars "<page>" acc))
+       (acc   (cons #\Newline acc))
+       (acc   (str::revappend-chars "<hindex_root>" acc))
+       (acc   (cons #\Newline acc))
+       ((mv acc & state) (make-hierarchy-list-aux roots nil dir topics-fal index-pkg x 0
+                                                  expand-level acc state))
+       (acc   (str::revappend-chars "</hindex_root>" acc))
+       (acc   (cons #\Newline acc))
+       (acc   (str::revappend-chars "</page>" acc))
+       (acc   (cons #\Newline acc))
+       (filename (oslib::catpath dir "topics.xml"))
+       ((mv channel state) (open-output-channel filename :character state))
+       (state (princ$ (str::rchars-to-string acc) channel state))
+       (state (close-output-channel channel state)))
+      state))
+
+
+
+
+
+(defun save-index (x dir topics-fal index-pkg state)
+
+; Write index.xml for the whole list of all topics.
+
+  (b* ((acc nil)
+       (acc (str::revappend-chars "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" acc))
+       (acc (cons #\Newline acc))
+       (acc (str::revappend-chars "<?xml-stylesheet type=\"text/xsl\" href=\"xml-full-index.xsl\"?>" acc))
+       (acc (cons #\Newline acc))
+       (acc   (str::revappend-chars *xml-entity-stuff* acc))
+       (acc (str::revappend-chars "<page>" acc))
+       (acc (cons #\Newline acc))
+       ((mv acc state) (index-topics x "Full Index" dir topics-fal index-pkg state acc))
+       (acc (str::revappend-chars "</page>" acc))
+       (filename (oslib::catpath dir "index.xml"))
+       ((mv channel state) (open-output-channel filename :character state))
+       (state (princ$ (str::rchars-to-string acc) channel state))
+       (state (close-output-channel channel state)))
+      state))
+
+
+
+
+; -------------------- Making Topic Pages -----------------------
+
+(defun save-topic (x all-topics dir topics-fal state)
+  (b* ((name               (cdr (assoc :name x)))
+       (-                  (cw "Saving ~s0::~s1.~%" (symbol-package-name name) (symbol-name name)))
+       ((mv text state)    (preprocess-topic x all-topics dir topics-fal state))
+       (filename           (str::cat (str::rchars-to-string
+                                      (file-name-mangle name nil))
+                                     ".xml"))
+       (fullpath           (oslib::catpath dir filename))
+       ((mv channel state) (open-output-channel fullpath :character state))
+       (state              (princ$ text channel state))
+       (state              (close-output-channel channel state)))
+      state))
+
+(defun save-topics-aux (x all-topics dir topics-fal state)
+  (if (atom x)
+      state
+    (let ((state (save-topic (car x) all-topics dir topics-fal state)))
+      (save-topics-aux (cdr x) all-topics dir topics-fal state))))
+
+
+
+(defun save-success-file (ntopics dir state)
+  (b* ((file           (oslib::catpath dir "success.txt"))
+       ((mv out state) (open-output-channel file :character state))
+       ((mv & state)   (fmt "Successfully wrote ~x0 topics.~%~%"
+                            (list (cons #\0 ntopics))
+                            out state nil))
+       (state          (close-output-channel out state)))
+      state))
+
+(defun prepare-dir (dir state)
+  (b* (((unless (stringp dir))
+        (prog2$ (er hard? 'prepare-dir "Dir must be a string, but is: ~x0.~%" dir)
+                state))
+       (- (cw "; Preparing directory ~s0.~%" dir))
+       (dir/xml     (oslib::catpath dir "xml"))
+       (state       (oslib::mkdir! dir))
+       (state       (oslib::mkdir! dir/xml))
+
+       (dir-system   (acl2::f-get-global 'acl2::system-books-dir state))
+       (xdoc-dir     (oslib::catpath dir-system "xdoc"))
+       (xdoc/classic (oslib::catpath xdoc-dir "classic"))
+
+       ;; We copy classic/Makefile-trans to dir/Makefile.  The "-trans" part of
+       ;; its name is just to prevent people from thinking they can type "make"
+       ;; in the classic directory to accomplish anything.
+       (Makefile-trans (oslib::catpath xdoc/classic "Makefile-trans"))
+       (Makefile-out   (oslib::catpath dir "Makefile"))
+       (state   (stupid-copy-file Makefile-trans Makefile-out state))
+       (state   (stupid-copy-files xdoc/classic
+                                   (list "xdoc.css"
+                                         "xdoc.js"
+                                         "plus.png"
+                                         "minus.png"
+                                         "leaf.png"
+                                         "text-topic.xsl"
+                                         "html-core.xsl"
+                                         "html-topic.xsl"
+                                         "html-full-index.xsl"
+                                         "html-brief-index.xsl"
+                                         "html-topic-index.xsl"
+                                         "xml-topic.xsl"
+                                         "xml-topic-index.xsl"
+                                         "xml-full-index.xsl")
+                                   dir/xml state))
+       (state   (stupid-copy-files xdoc/classic
+                                   (list "frames2.html"
+                                         "frames3.html"
+                                         "preview.html")
+                                   dir state))
+       (state   (stupid-copy-files xdoc/classic
+                                   *acl2-graphics*
+                                   dir/xml state)))
+    state))
+
+(defun save-topics (x dir index-pkg expand-level state)
+  (b* ((state (prepare-dir dir state))
+       (dir   (oslib::catpath dir "xml"))
+       (x     (clean-topics x))
+       (- (cw "; Processing ~x0 topics.~%" (len x)))
+       ;; Note: generate the index after the topic files, so that
+       ;; errors in short messages will be seen there.
+       (x      (time$ (normalize-parents-list x)
+                      :msg "; Normalizing parents: ~st sec, ~sa bytes~%"
+                      :mintime 1/2))
+       (topics-fal (time$ (topics-fal x)
+                          :msg "; Generating topics fal: ~st sec, ~sa bytes~%"
+                          :mintime 1/2))
+       (state  (time$ (save-topics-aux x x dir topics-fal state)
+                      :msg "; Saving topics: ~st sec, ~sa bytes~%"
+                      :mintime 1/2))
+       (state  (time$ (save-index x dir topics-fal index-pkg state)
+                      :msg "; Saving flat index: ~st sec, ~sa bytes~%"
+                      :mintime 1/2))
+       (state  (time$ (save-hierarchy x dir topics-fal index-pkg expand-level state)
+                      :msg "; Saving hierarchical index: ~st sec, ~sa bytes~%"))
+       (orphans (find-orphaned-topics x topics-fal nil))
+       (-       (fast-alist-free topics-fal))
+       (state   (save-success-file (len x) dir state)))
+    (or (not orphans)
+        (cw "~|~%WARNING: found topics with non-existent parents:~%~x0~%These ~
+             topics may only show up in the index pages.~%~%" orphans))
+    state))
+
diff -Nru acl2-6.2/books/xdoc/save-fancy.lisp acl2-6.3/books/xdoc/save-fancy.lisp
--- acl2-6.2/books/xdoc/save-fancy.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/save-fancy.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,510 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2013 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+; save-fancy.lisp
+;
+; Writes out the XDOC database into JSON format for the new, fancy viewer.
+
+(in-package "XDOC")
+(include-book "save-classic")
+(include-book "importance")
+(include-book "centaur/bridge/to-json" :dir :system)
+(set-state-ok t)
+(program)
+
+
+
+
+
+(defun-inline json-encode-string (x acc)
+  (declare (type string x))
+  (cons #\" (bridge::json-encode-str x (cons #\" acc))))
+
+
+(defun json-encode-filename (x acc)
+  (declare (type symbol x))
+  (json-encode-string
+   (str::rchars-to-string (file-name-mangle x nil))
+   acc))
+
+(defun json-encode-filenames-aux (x acc)
+  (declare (xargs :guard (symbol-listp x)))
+  (b* (((when (atom x))
+        acc)
+       (acc (json-encode-filename (car x) acc))
+       ((when (atom (cdr x)))
+        acc)
+       (acc (cons #\, acc)))
+    (json-encode-filenames-aux (cdr x) acc)))
+
+(defun json-encode-filenames (x acc)
+  (declare (xargs :guard (symbol-listp x)))
+  (b* ((acc (cons #\[ acc))
+       (acc (json-encode-filenames-aux x acc)))
+    (cons #\] acc)))
+
+#||
+(str::rchars-to-string (json-encode-filename 'xdoc::foo nil))
+(str::rchars-to-string (json-encode-filenames '(xdoc::a acl2::b str::c) nil))
+||#
+
+(defun json-encode-topicname (x base-pkg acc)
+  (declare (type symbol x)
+           (type symbol base-pkg))
+  (json-encode-string
+   (str::rchars-to-string (sym-mangle-cap x base-pkg nil))
+   acc))
+
+(defun json-encode-topicnames-aux (x base-pkg acc)
+  (declare (xargs :guard (symbol-listp x)))
+  (b* (((when (atom x))
+        acc)
+       (acc (json-encode-topicname (car x) base-pkg acc))
+       ((when (atom (cdr x)))
+        acc)
+       (acc (cons #\, acc)))
+    (json-encode-topicnames-aux (cdr x) base-pkg acc)))
+
+(defun json-encode-topicnames (x base-pkg acc)
+  (declare (xargs :guard (symbol-listp x)))
+  (b* ((acc (cons #\[ acc))
+       (acc (json-encode-topicnames-aux x base-pkg acc)))
+    (cons #\] acc)))
+
+
+#||
+(str::rchars-to-string (json-encode-topicname 'xdoc::foo 'acl2::foo nil))
+(str::rchars-to-string (json-encode-topicname 'xdoc::foo 'xdoc::bar nil))
+(str::rchars-to-string (json-encode-topicnames '(acl2::sock-monster xdoc::shoe-monster)
+                                               'xdoc::bar nil))
+||#
+
+(defun json-encode-uid (x acc)
+  (declare (type integer x))
+  (if (< x 0)
+      (str::revappend-natchars (- x) (cons #\- acc))
+    (str::revappend-natchars x acc)))
+
+(defun json-encode-uids-aux (x acc)
+  (declare (xargs :guard (integer-listp x)))
+  (b* (((when (atom x))
+        acc)
+       (acc (json-encode-uid (car x) acc))
+       ((when (atom (cdr x)))
+        acc)
+       (acc (cons #\, acc)))
+    (json-encode-uids-aux (cdr x) acc)))
+
+(defun json-encode-uids (x acc)
+  (declare (xargs :guard (integer-listp x)))
+  (b* ((acc (cons #\[ acc))
+       (acc (json-encode-uids-aux x acc)))
+    (cons #\] acc)))
+
+#||
+(str::rchars-to-string (json-encode-uids '() nil))
+(str::rchars-to-string (json-encode-uids '(1 2 3) nil))
+(str::rchars-to-string (json-encode-uids '(2 3 17 100) nil))
+(str::rchars-to-string (json-encode-uids '(1 2 -3 -77) nil))
+||#
+
+(defun make-uid-map (n topics map)
+  (b* (((when (atom topics))
+        map)
+       (name1 (cdr (assoc :name (car topics))))
+       (map   (hons-acons name1 n map)))
+    (make-uid-map (+ n 1) (cdr topics) map)))
+
+(defun collect-uids (names uid-map)
+  ;; Converts missing names into -1's.
+  (b* (((when (atom names))
+        nil)
+       (look (cdr (hons-get (car names) uid-map)))
+       ((when look)
+        (cons (nfix look) (collect-uids (cdr names) uid-map))))
+    (cons -1 (collect-uids (cdr names) uid-map))))
+
+
+; The basic idea here is to split the database into two files:
+;
+;  - The INDEX will be an array containing sub-arrays with
+;        [key, name, parents, short, ...]
+;
+;  - The DATA will bind KEY -> long
+;
+; Where the KEYs are just the "file names" in the old scheme.  That is, they
+; are nice, safe names that can be used in URLs or wherever.
+;
+; Why not just save it as one big table?  The hope is that this kind of split
+; will let us (in the web interface) load in the index and give the user a
+; working display, even before the data has been loaded.
+;
+; As of July 2013, the serialized version of the xdoc table (before
+; preprocessing, mind you) is 7.1 MB.  The JSON-encoded, post-preprocessing
+; (i.e., proper XML) version is over 22 MB.  This doesn't count the additional
+; documentation internal to Centaur or other companies.  Even with fast
+; internet connections, that can be a noticeable delay, and the size will only
+; grow.
+;
+; We previously represented the XINDEX as a hash binding KEY -> [name, ...],
+; but we now use an array instead and embed the key within it.  The advantage
+; of this new scheme is that it gives us an implicit way to refer to topics,
+; viz., their position in the array.  This seems like a useful capability for
+; implementing search features.
+
+(defun json-encode-index-entry (topic topics-fal uid-map state acc)
+  (b* ((name     (cdr (assoc :name topic)))
+       (base-pkg (cdr (assoc :base-pkg topic)))
+       (short    (or (cdr (assoc :short topic)) ""))
+       (long     (or (cdr (assoc :long topic)) ""))
+       (parents  (cdr (assoc :parents topic)))
+       ((unless (symbolp name))
+        (mv (er hard? 'preprocess-topic "Name is not a string: ~x0.~%" topic)
+            state))
+       ((unless (symbolp base-pkg))
+        (mv (er hard? 'preprocess-topic "Base-pkg is not a symbol: ~x0.~%" topic)
+            state))
+       ((unless (symbol-listp parents))
+        (mv (er hard? 'preprocess-topic "Parents are not a symbol-listp: ~x0.~%" topic)
+            state))
+       ((unless (stringp short))
+        (mv (er hard? 'preprocess-topic "Short is not a string: ~x0.~%" topic)
+            state))
+       ((unless (stringp long))
+        (mv (er hard? 'preprocess-topic "Long is not a string: ~x0.~%" topic)
+            state))
+
+       (parent-uids (collect-uids parents uid-map))
+
+       ((mv short-rchars state) (preprocess-main short nil topics-fal base-pkg state nil))
+       (short-str (str::rchars-to-string short-rchars))
+       ((mv err &) (parse-xml short-str))
+       (state
+        (if err
+            (pprogn
+               (fms "~|~%WARNING: problem with :short in topic ~x0:~%"
+                    (list (cons #\0 name))
+                    *standard-co* state nil)
+               (princ$ err *standard-co* state)
+               (fms "~%~%" nil *standard-co* state nil))
+          state))
+
+       (short-str
+        (b* (((unless err)
+              short-str)
+             (tmp nil)
+             (tmp (str::revappend-chars
+                   "<b><color rgb='#ff0000'>Markup error in :short</color></b>
+                    <code>" tmp))
+             (tmp (simple-html-encode-str err 0 (length err) tmp))
+             (tmp (str::revappend-chars "</code>" tmp)))
+          (str::rchars-to-string tmp)))
+
+; I originally used a JSON object like {"name":"Append","rawname":"..."}  But
+; then some back-of-the-napkin calculations said that these nice names were
+; taking up about 400 KB of space in the index, so I figured I'd get rid of
+; them and just use an array.
+
+; IF YOU ADD/CHANGE THE ORDER THEN YOU MUST UPDATE XDOC.JS:
+
+       ;; [key
+       (acc (cons #\[ acc))
+       (acc (json-encode-filename name acc))
+
+       ; ,name (xml encoded nice topic name)
+       (acc (cons #\, acc))
+       (acc (json-encode-topicname name base-pkg acc))
+
+       ; ,raw name (non-encoded symbol name, no package)
+       (acc (cons #\, acc))
+       (acc (json-encode-string (symbol-name name) acc))
+
+       ; ,parent keys (array of keys for parents)
+       (acc (cons #\, acc))
+       (acc (json-encode-uids parent-uids acc))
+
+       ; ,short: xml encoded short topic description
+       (acc (cons #\, acc))
+       (acc (json-encode-string short-str acc))
+
+       (acc (cons #\] acc)))
+    (mv acc state)))
+
+#||
+(b* ((topics (get-xdoc-table (w state)))
+     (topics-fal (topics-fal topics))
+     ((mv acc state)
+      (json-encode-index-entry (car topics) topics-fal state nil))
+     (state (princ$ (str::rchars-to-string acc) *standard-co* state)))
+  state)
+||#
+
+(defun json-encode-index-aux (topics topics-fal uid-map state acc)
+  (b* (((when (atom topics))
+        (mv acc state))
+       ((mv acc state) (json-encode-index-entry (car topics) topics-fal uid-map
+                                                state acc))
+       ((when (atom (cdr topics)))
+        (mv acc state))
+       (acc (list* #\Space #\Newline #\, acc)))
+    (json-encode-index-aux (cdr topics) topics-fal uid-map state acc)))
+
+(defun json-encode-index (topics topics-fal uid-map state acc)
+  (b* ((acc (cons #\[ acc))
+       ((mv acc state) (json-encode-index-aux topics topics-fal uid-map state acc))
+       (acc (cons #\] acc)))
+    (mv acc state)))
+
+#||
+(b* ((topics     (take 5 (get-xdoc-table (w state))))
+     (topics-fal (topics-fal topics))
+     ((mv acc state)
+      (json-encode-index topics topics-fal state nil))
+     (state (princ$ (str::rchars-to-string acc) *standard-co* state)))
+  state)
+||#
+
+
+(defun json-encode-data-entry (topic topics-fal state acc)
+  (b* ((__function__ 'json-encode-data-entry)
+       (name     (cdr (assoc :name topic)))
+       (base-pkg (cdr (assoc :base-pkg topic)))
+       (short    (or (cdr (assoc :short topic)) ""))
+       (long     (or (cdr (assoc :long topic)) ""))
+       (parents  (cdr (assoc :parents topic)))
+       (from     (or (cdr (assoc :from topic)) "Unknown"))
+       ((unless (symbolp name))
+        (mv (er hard? __function__ "Name is not a string: ~x0.~%" topic)
+            state))
+       ((unless (symbolp base-pkg))
+        (mv (er hard? __function__ "Base-pkg is not a symbol: ~x0.~%" topic)
+            state))
+       ((unless (symbol-listp parents))
+        (mv (er hard? __function__ "Parents are not a symbol-listp: ~x0.~%" topic)
+            state))
+       ((unless (stringp short))
+        (mv (er hard? __function__ "Short is not a string: ~x0.~%" topic)
+            state))
+       ((unless (stringp long))
+        (mv (er hard? __function__ "Long is not a string: ~x0.~%" topic)
+            state))
+       ((unless (stringp from))
+        (mv (er hard? __function__ "From is not a string: ~x0.~%" topic)
+            state))
+
+       ((mv long-rchars state) (preprocess-main long nil topics-fal base-pkg state nil))
+       (long-str (str::rchars-to-string long-rchars))
+       ((mv err &) (parse-xml long-str))
+       (state
+        (if err
+            (pprogn
+               (fms "~|~%WARNING: problem with :long in topic ~x0:~%"
+                    (list (cons #\0 name))
+                    *standard-co* state nil)
+               (princ$ err *standard-co* state)
+               (fms "~%~%" nil *standard-co* state nil))
+          state))
+       (long-str
+        (b* (((unless err)
+              long-str)
+             (tmp nil)
+             (tmp (str::revappend-chars
+                   "<h3><color rgb='#ff0000'>Markup error in :long</color></h3>
+                    <code>" tmp))
+             (tmp (simple-html-encode-str err 0 (length err) tmp))
+             (tmp (str::revappend-chars "</code>" tmp)))
+          (str::rchars-to-string tmp)))
+
+       (from-xml (str::rchars-to-string
+                  (simple-html-encode-chars
+                   (coerce from 'list) nil)))
+
+       (acc (json-encode-filename name acc))
+       (acc (str::revappend-chars ":[" acc))
+
+; IF YOU ADD/CHANGE THE ORDER THEN YOU MUST UPDATE XDOC.JS:
+
+       ; parent names (xml encoded nice parent names)
+       ; BOZO move to xdata, probably
+       (acc (json-encode-topicnames parents base-pkg acc))
+       (acc (cons #\, acc))
+
+       (acc (json-encode-string from-xml acc))
+       (acc (cons #\, acc))
+
+       (acc (json-encode-string long-str acc))
+       (acc (cons #\] acc)))
+    (mv acc state)))
+
+#||
+(b* ((topics (get-xdoc-table (w state)))
+     (topics-fal (topics-fal topics))
+     ((mv acc state)
+      (json-encode-data-entry (car topics) topics-fal state nil))
+     (state (princ$ (str::rchars-to-string acc) *standard-co* state)))
+  state)
+||#
+
+(defun json-encode-data-aux (topics topics-fal state acc)
+  (b* (((when (atom topics))
+        (mv acc state))
+       ((mv acc state) (json-encode-data-entry (car topics) topics-fal state acc))
+       ((when (atom (cdr topics)))
+        (mv acc state))
+       (acc (list* #\Space #\Newline #\Newline #\, acc)))
+    (json-encode-data-aux (cdr topics) topics-fal state acc)))
+
+(defun json-encode-data (topics topics-fal state acc)
+  (b* ((acc (cons #\{ acc))
+       ((mv acc state) (json-encode-data-aux topics topics-fal state acc))
+       (acc (cons #\} acc)))
+    (mv acc state)))
+
+#||
+(b* ((topics (take 5 (get-xdoc-table (w state))))
+     (topics-fal (topics-fal topics))
+     (acc nil)
+     ((mv acc state)
+      (json-encode-data topics topics-fal state acc))
+     (state (princ$ (str::rchars-to-string acc) *standard-co* state)))
+  state)
+||#
+
+(defun save-json-files (topics dir state)
+  (b* ((topics (force-root-parents
+                (maybe-add-top-topic
+                 (normalize-parents-list
+                  (clean-topics topics)))))
+
+       (- (cw "; Saving JSON files for ~x0 topics.~%" (len topics)))
+       ((mv topics state)
+        (time$ (order-topics-by-importance topics state)
+               :msg "; Importance sorting topics: ~st sec, ~sa bytes.~%"
+               :mintime 1/2))
+
+       (topics-fal (time$ (topics-fal topics)))
+       (uid-map    (time$ (make-uid-map 0 topics nil)))
+
+       (index nil)
+       (index (str::revappend-chars "var xindex = " index));
+       ((mv index state)
+        (time$ (json-encode-index topics topics-fal uid-map state index)
+               :msg "; Preparing JSON index: ~st sec, ~sa bytes.~%"))
+       (index (cons #\; index))
+       (index (str::rchars-to-string index))
+       (idxfile (oslib::catpath dir "xindex.js"))
+       ((mv channel state) (open-output-channel idxfile :character state))
+       (state (princ$ index channel state))
+       (state (close-output-channel channel state))
+
+       (data nil)
+       (data (str::revappend-chars "var xdata = " data))
+       ((mv data state)
+        (time$ (json-encode-data topics topics-fal state data)
+               :msg "; Preparing JSON topic data: ~st sec, ~sa bytes.~%"
+               :mintime 1/2))
+       (data (cons #\; data))
+       (data (str::rchars-to-string data))
+       (datafile (oslib::catpath dir "xdata.js"))
+       ((mv channel state) (open-output-channel datafile :character state))
+       (state (princ$ data channel state))
+       (state (close-output-channel channel state))
+
+       (orphans (find-orphaned-topics topics topics-fal nil)))
+
+    (or (not orphans)
+        (cw "~|~%WARNING: found topics with non-existent parents:~%~x0~%These ~
+             topics may only show up in the index pages.~%~%" orphans))
+
+    (fast-alist-free topics-fal)
+    (fast-alist-free uid-map)
+    state))
+
+
+(defun prepare-fancy-dir (dir state)
+  (b* (((unless (stringp dir))
+        (prog2$ (er hard? 'prepare-fancy-dir
+                    "Dir must be a string, but is: ~x0.~%" dir)
+                state))
+       (- (cw "; Preparing directory ~s0.~%" dir))
+
+       (dir/lib        (oslib::catpath dir "lib"))
+       (dir/images     (oslib::catpath dir "images"))
+       (state          (oslib::mkdir! dir))
+       (state          (oslib::mkdir! dir/lib))
+       (state          (oslib::mkdir! dir/images))
+
+       (dir-system     (acl2::f-get-global 'acl2::system-books-dir state))
+       (xdoc-dir       (oslib::catpath dir-system "xdoc"))
+       (xdoc/classic   (oslib::catpath xdoc-dir "classic"))
+       (xdoc/fancy     (oslib::catpath xdoc-dir "fancy"))
+       (xdoc/fancy/lib (oslib::catpath xdoc/fancy "lib"))
+
+       (- (cw "Copying fancy viewer main files...~%"))
+       (state          (stupid-copy-files xdoc/fancy
+                                          (list "collapse_subtopics.png"
+                                                "expand_subtopics.png"
+                                                "favicon.png"
+                                                "Icon_External_Link.png"
+                                                "index.html"
+                                                "xdoc-home.png"
+                                                "xdoc-logo.png"
+                                                "leaf.png"
+                                                "LICENSE"
+                                                "minus.png"
+                                                "plus.png"
+                                                "render.js"
+                                                "style.css"
+                                                "view_flat.png"
+                                                "view_tree.png"
+                                                "config.js"
+                                                "xdoc.js"
+                                                "xdoc_index.js"
+                                                "xdataget.pl"
+                                                "xdata2sql.pl"
+                                                )
+                                          dir state))
+
+       (- (cw "Copying fancy viewer library files...~%"))
+       (state          (stupid-copy-files xdoc/fancy/lib
+                                          (list "hogan-2.0.0.js"
+                                                "jquery-2.0.3.js"
+                                                "jquery-2.0.3.min.js"
+                                                "jquery.base64.js"
+                                                "jquery.powertip.css"
+                                                "jquery.powertip.js"
+                                                "jquery.powertip.min.js"
+                                                "lazyload.js"
+                                                "typeahead.js"
+                                                "typeahead.min.js")
+                                          dir/lib state))
+
+       (- (cw "Copying ACL2 tour graphics...~%"))
+       (state          (stupid-copy-files xdoc/classic
+                                          *acl2-graphics*
+                                          dir/images state)))
+    state))
+
+
+(defun save-fancy (all-topics dir state)
+  (b* ((state (prepare-fancy-dir dir state))
+       (state (save-json-files all-topics dir state)))
+    state))
+
diff -Nru acl2-6.2/books/xdoc/sort.lisp acl2-6.3/books/xdoc/sort.lisp
--- acl2-6.2/books/xdoc/sort.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/sort.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,63 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "XDOC")
+(program)
+
+; This is the same mergesort from the osets library.  We only copy it here so
+; that we can use it without depending on osets.  I modify it somewhat to
+; avoid set operations like "empty" and "tail", in lieu of ordinary atom and
+; cdr, etc.
+
+(defun << (a b)
+  (and (lexorder a b)
+       (not (equal a b))))
+
+(defun fast-union (x y acc)
+  (cond
+   ((atom x) (revappend acc y))
+   ((atom y) (revappend acc x))
+   ((equal (car x) (car y))
+    (fast-union (cdr x) (cdr y) (cons (car x) acc)))
+   ((<< (car x) (car y))
+    (fast-union (cdr x) y (cons (car x) acc)))
+   (t
+    (fast-union x (cdr y) (cons (car y) acc)))))
+
+(defun halve-list-aux (mid x acc)
+  (if (or (atom x)
+          (atom (cdr x)))
+      (mv acc mid)
+    (halve-list-aux (cdr mid)
+                    (cdr (cdr x))
+                    (cons (car mid) acc))))
+
+(defun halve-list (x)
+  (halve-list-aux x x nil))
+
+(defun mergesort (x)
+  (cond ((atom x) nil)
+        ((atom (cdr x))
+         (list (car x)))
+        (t (mv-let (part1 part2)
+                   (halve-list x)
+                   (fast-union (mergesort part1)
+                               (mergesort part2)
+                               nil)))))
diff -Nru acl2-6.2/books/xdoc/spellcheck.lisp acl2-6.3/books/xdoc/spellcheck.lisp
--- acl2-6.2/books/xdoc/spellcheck.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/spellcheck.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,388 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "XDOC")
+(include-book "str/defs" :dir :system)
+(include-book "sort")
+(program)
+
+
+; We now implement a primitive spell-checking capability so that, when a user
+; searches for something like in-theroy instead of in-theory, or fast-alist
+; instead of fast-alists, we can hopefully point them to the right topic.
+
+
+
+; This is similar to the basic idea of soundex codes, but slightly tweaked to
+; possibly better fit what we're trying to do...
+
+(defun soundex-mangle-tail-1 (x)
+  ;; Merge similar sounding characters into sets
+  (declare (xargs :guard (character-listp x)))
+  (b* (((when (atom x))
+        nil)
+       (x1   (str::downcase-char (car x)))
+       ((when (and (eql x1 #\s)
+                   (atom (cdr x))))
+        ;; Special hack to automatically drop the "s" from the end of the
+        ;; string, so that, e.g., "alist" and "alists" will merge to the same
+        ;; code.
+        nil)
+       (rest (soundex-mangle-tail-1 (cdr x))))
+      (cond ((position x1 "aeiouyhw$") (cons #\Space rest))
+            ((position x1 "bfpv")      (cons #\b rest))
+            ((position x1 "cgjkqsxz")  (cons #\c rest))
+            ((position x1 "dt")        (cons #\d rest))
+            ((eql x1 #\l)              (cons #\l rest))
+            ((position x1 "mn")        (cons #\m rest))
+            ((eql x1 #\r)              (cons #\r rest))
+            ((position x1 "-_/>? ")    (cons #\Space rest))
+            (t                         (cons x1 rest)))))
+
+(defun soundex-mangle-tail-2 (x)
+  ;; Eat adjacent duplicates except for spaces
+  (declare (xargs :guard (character-listp x)))
+  (b* (((when (atom x))
+        nil)
+       ((when (atom (cdr x)))
+        (cons (car x) (soundex-mangle-tail-2 (cdr x))))
+       (x1 (first x))
+       (x2 (second x))
+       ((when (and (eql x1 x2)
+                   (not (eql x1 #\Space))))
+        (cons x1 (soundex-mangle-tail-2 (cddr x)))))
+      (cons x1 (soundex-mangle-tail-2 (cdr x)))))
+
+(defun soundex-mangle-tail (x)
+  (declare (xargs :guard (character-listp x)))
+  (b* ((x (soundex-mangle-tail-1 x))
+       (x (soundex-mangle-tail-2 x))
+       (x (remove #\Space x)))
+      (cond ((atom x)
+             '(#\Space #\Space #\Space))
+            ((atom (cdr x))
+             (cons (first x) '(#\Space #\Space)))
+            ((atom (cddr x))
+             (list* (first x) (second x) '(#\Space)))
+            (t
+             (list (first x) (second x) (third x))))))
+
+#||            
+(soundex-mangle-tail (str::explode "xplode"))
+(soundex-mangle-tail (str::explode "xplod"))
+(soundex-mangle-tail (str::explode "xplds"))
+(soundex-mangle-tail (str::explode "xxpld"))
+(soundex-mangle-tail (str::explode "mpolde"))
+(soundex-mangle-tail (str::explode "ampolde"))
+(soundex-mangle-tail (str::explode "unpolde"))
+||#
+
+(defun soundex (x)
+  "Returns our soundex-like code as a string."
+  (declare (xargs :guard (stringp x)))
+  (b* ((chars (str::explode x)))
+    (if (atom chars)
+        "    "
+      (str::implode 
+       (cons (str::downcase-char (car chars))
+             (soundex-mangle-tail (cdr chars)))))))
+
+#||
+(soundex "explode")
+(soundex "explodes")
+(soundex "explod")
+(soundex "expld")
+(soundex "exxpld")
+(soundex "impolde")
+(soundex "ampolde")
+(soundex "unpolde")
+(soundex "alist")
+(soundex "alists")
+(soundex "+")
+(soundex "-")
+(soundex "foo-bar")
+(soundex "foobar")
+(soundex "foo_bar")
+(soundex "pairlis")
+(soundex "pairlis$")
+(soundex "union")
+(soundex "union$")
+
+;; basic performance test: a million soundex codes for reasonably sized names...
+;;   2.68 seconds, 880 MB
+;; so we're at 373,000 soundex codes per second.  that seems perfectly fine, since
+;; there are today well under 10k xdoc topics.
+
+(let ((x "reasonable-name"))
+  (time (loop for i from 1 to 1000000 do
+              (xdoc::soundex x))))
+
+||#
+
+(defun soundex-list (x)
+  (declare (xargs :guard (string-listp x)))
+  (if (atom x)
+      nil
+    (cons (soundex (car x))
+          (soundex-list (cdr x)))))
+
+
+; Now we have the problem of seeing how closely actual symbols match...
+
+(defun find-diffs (x y)
+  (declare (xargs :guard (equal (len x) (len y))))
+  (cond ((atom x)
+         nil)
+        ((equal (car x) (car y))
+         (find-diffs (cdr x) (cdr y)))
+        (t
+         (cons (cons (car x) (car y))
+               (find-diffs (cdr x) (cdr y))))))
+
+(defun nearly-equal-aux (x y)
+  (declare (xargs :guard (and (string-listp x)
+                              (string-listp y))))
+  (let ((xl (len x))
+        (yl (len y)))
+    (and ;; X is longer than Y by exactly 1.
+         (eql xl (+ 1 yl))
+         ;; There are at least a couple of tokens in each
+         (<= 1 xl)
+         (<= 1 yl)
+         (or ;; X is just ([prefix]@Y) for some short prefix
+          (and (equal (cdr x) y)
+               (<= (length (car x)) 3))
+          ;; X is just (Y@[suffix]) for some short suffix
+          (and (equal (butlast x 1) y)
+               (<= (length (car (last y))) 3))))))
+
+(defun nearly-equal (x y)
+  (declare (xargs :guard (and (string-listp x)
+                              (string-listp y))))
+  (or (nearly-equal-aux x y)
+      (nearly-equal-aux y x)))
+
+(defun merge-final-ps (x)
+  ;; Merge together final tokens to perhaps get better soundex matches for
+  ;; "foop" versus "foo" "p"
+  (declare (xargs :guard (string-listp x)))
+  (cond ((atom x) 
+         nil)
+        ((atom (cdr x))
+         (list (first x)))
+        ((and (atom (cddr x))
+              (equal (second x) "p"))
+         (list (str::cat (first x) "p")))
+        (t
+         (cons (car x) 
+               (merge-final-ps (cdr x))))))
+
+#||
+(merge-final-ps '("integer" "list" "p"))
+(merge-final-ps '("integer" "listp"))
+(merge-final-ps '("maybe" "string" "p"))
+||#
+
+(defun collect-plausible-misspellings-aux
+  (goal        ;; the exact symbol the user asked for
+   goal-tokens ;; the pre-tokenized name of the symbol the user asked for
+   desperation ;; number of tokens that can differ
+   topic-names ;; the list of all xdoc topic names to consider
+   )
+  (declare (xargs :guard (and (symbolp goal)
+                              (string-listp goal-tokens)
+                              (natp desperation)
+                              (symbol-listp topic-names))))
+  (b* (((when (atom topic-names))
+        nil)
+       (name1        (car topic-names))
+       (name1-tokens (str::strtok (str::downcase-string (symbol-name name1))
+                                  '(#\- #\_ #\/ #\> #\? #\Space)))
+       (rest         (collect-plausible-misspellings-aux goal goal-tokens desperation
+                                                         (cdr topic-names)))
+
+       ((when (equal goal-tokens name1-tokens))
+        ;; Identical except perhaps for package-name and/or the number of
+        ;; dashes/hyphens/etc
+        (cons name1 rest))
+
+       ((unless (>= desperation 1)) rest)
+
+       ((when (equal (mergesort name1-tokens)
+                     (mergesort goal-tokens)))
+        ;; Identical up to number of or order of tokens, i.e., foo-bar versus
+        ;; bar-foo.
+        (cons name1 rest))
+
+       ((unless (>= desperation 2)) rest)
+
+       ;; Merge in any final token whose name is just "p", so that, e.g., we
+       ;; treat "foo-p" and "foop" the same from now on.
+       (name1-tokens (merge-final-ps name1-tokens))
+       (goal-tokens  (merge-final-ps goal-tokens))
+
+       ((when (equal goal-tokens name1-tokens))
+        (cons name1 rest))
+
+       ((unless (>= desperation 3)) rest)
+
+       ((when (and (equal (len name1-tokens)
+                          (len goal-tokens))
+                   (let ((diffs (find-diffs name1-tokens goal-tokens)))
+                     (and (equal (len diffs) 1)
+                          (equal (soundex (caar diffs))
+                                 (soundex (cdar diffs)))))))
+        ;; Same number of tokens, only one token differs, and the token that is
+        ;; different is phonetically similar, catches things like intager-listp
+        (cons name1 rest))
+
+       ((unless (>= desperation 4)) rest)
+
+       ((when (equal (soundex (symbol-name goal))
+                     (soundex (symbol-name name1))))
+        ;; Straightforward phonetic comparison of both symbols without any
+        ;; regard to the tokenization.
+        (cons name1 rest))
+       
+       ((unless (>= desperation 5)) rest)
+
+       ((when (nearly-equal name1-tokens goal-tokens))
+        ;; Identical except that one or the other has an extra suffix/prefix.
+        (cons name1 rest)))
+      
+      rest))
+
+(defun collect-plausible-misspellings (goal topic-names)
+  (declare (xargs :guard (and (symbolp goal)
+                              (symbol-listp topic-names))))
+  (let ((goal-tokens (str::strtok (str::downcase-string (symbol-name goal))
+                                  '(#\- #\_ #\/ #\> #\? #\Space))))
+    (or (collect-plausible-misspellings-aux goal goal-tokens 0 topic-names)
+        (collect-plausible-misspellings-aux goal goal-tokens 1 topic-names)
+        (collect-plausible-misspellings-aux goal goal-tokens 2 topic-names)
+        (collect-plausible-misspellings-aux goal goal-tokens 3 topic-names)
+        (collect-plausible-misspellings-aux goal goal-tokens 4 topic-names)
+        (collect-plausible-misspellings-aux goal goal-tokens 5 topic-names)
+        )))
+
+#||
+(defconst *topic-names*
+  '(acl2::explode acl2::append str::cat acl2::implode acl2::coerce
+                  vl-maybe-integer-p vl-maybe-stringp
+                 acl2::integer-listp acl2::nat-listp revappend))
+
+(collect-plausible-misspellings 'xdoc::explode *topic-names*)
+(collect-plausible-misspellings 'xdoc::explode *topic-names*)
+(collect-plausible-misspellings 'xdoc::cate *topic-names*)
+
+(collect-plausible-misspellings 'integer-listp *topic-names*)
+(collect-plausible-misspellings 'integer-list-p *topic-names*)
+
+(collect-plausible-misspellings 'nat-lstp *topic-names*)
+(collect-plausible-misspellings 'integr-listp *topic-names*)
+(collect-plausible-misspellings 'intager-listp *topic-names*)
+(collect-plausible-misspellings 'appnd *topic-names*)
+(collect-plausible-misspellings 'apend *topic-names*)
+(collect-plausible-misspellings 'revapp *topic-names*)
+
+(collect-plausible-misspellings 'integr--listp *topic-names*)
+(collect-plausible-misspellings 'integrlistp *topic-names*)
+
+(collect-plausible-misspellings 'listp-integer *topic-names*)
+
+(collect-plausible-misspellings 'vl-nat-listp *topic-names*)
+(collect-plausible-misspellings 'maybe-integerp *topic-names*)
+(collect-plausible-misspellings 'maybe-integer-p *topic-names*)
+(collect-plausible-misspellings 'maybe-stringp *topic-names*)
+(collect-plausible-misspellings 'maybe-string-p *topic-names*)
+
+||#
+
+
+; Ranking the candidates.  The general hope is that the use of desperation
+; levels above should give us only a few candidates to choose from, all of
+; which are pretty likely.  As a stupid way to rank the candidates and choose
+; the "best" ones, we'll introduce a stupid heuristic:
+;
+;    - Consider each character c that occurs in the goal name and in the
+;      candidate name, excluding hyphens.
+;
+;    - Sum the differences been how many times each such c occurs in the
+;      goal, versus how many times it occurs in the candidate.
+;
+; The candidate with the lowest score wins.  This dumb heuristic should prefer
+; candidates that are simple permutations of words, transpositions of
+; characters, or where just one character was missing, etc., over candidates
+; that have more significant differences.
+
+(defun candidate-score-aux (domain goal-chars candidate-chars)
+  (declare (xargs :guard (and (character-listp domain)
+                              (character-listp goal-chars)
+                              (character-listp candidate-chars))))
+  (b* (((when (atom domain))
+        0)
+       (n1   (acl2::duplicity (car domain) goal-chars))
+       (n2   (acl2::duplicity (car domain) candidate-chars))
+       (diff (abs (- n1 n2))))
+      (+ diff
+         (candidate-score-aux (cdr domain) goal-chars candidate-chars))))
+  
+(defun candidate-score (goal candidate)
+  (declare (xargs :guard (and (stringp goal)
+                              (stringp candidate))))
+  (b* ((goal-chars      (str::explode (str::downcase-string goal)))
+       (candidate-chars (str::explode (str::downcase-string candidate)))
+       (domain          (remove #\- (mergesort
+                                     (append goal-chars candidate-chars)))))
+      (candidate-score-aux domain goal-chars candidate-chars)))
+
+(defun rank-candidates (goal candidates)
+  ;; Builds an alist of (score . candidate)
+  (declare (xargs :guard (and (symbolp goal)
+                              (symbol-listp candidates))))
+  (if (atom candidates)
+      nil
+    (cons (cons (candidate-score (symbol-name goal)
+                                 (symbol-name (car candidates)))
+                (car candidates))
+          (rank-candidates goal (cdr candidates)))))
+
+(defun sort-candidates (goal candidates)
+  (declare (xargs :guard (and (symbolp goal)
+                              (symbol-listp candidates))))
+  (strip-cdrs (mergesort (rank-candidates goal candidates))))
+
+
+(defun xdoc-autocorrect (goal topic-names)
+  ;; Returns a list of possible topics that the user might have meant
+  (declare (xargs :guard (and (symbolp goal)
+                              (symbol-listp topic-names))))
+  (b* ((candidates (collect-plausible-misspellings goal topic-names))
+       (candidates (sort-candidates goal candidates)))
+    (take (min (len candidates) 5)
+          candidates)))
+       
+  
+#||
+
+(xdoc-autocorrect 'aples '(appoles apples appals apols appals appels appllas appallas app-les))
+
+||#
+
diff -Nru acl2-6.2/books/xdoc/support/Makefile-trans acl2-6.3/books/xdoc/support/Makefile-trans
--- acl2-6.2/books/xdoc/support/Makefile-trans	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/Makefile-trans	1970-01-01 00:00:00.000000000 +0000
@@ -1,149 +0,0 @@
-# -*- mode: Makefile -*-
-# XDOC Documentation System for ACL2
-# Copyright (C) 2009 Centaur Technology
-#
-# Contact:
-#   Centaur Technology Formal Verification Group
-#   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-#   http://www.centtech.com/
-#
-# This program is free software; you can redistribute it and/or modify it under
-# the terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.  This program is distributed in the hope that it will be useful but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-# more details.  You should have received a copy of the GNU General Public
-# License along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# Original author: Jared Davis <jared@centtech.com>
-
-
-# XDOC CONVERSION MAKEFILE
-#
-# This Makefile can convert generate HTML and TEXT documentation from XDOC
-# documentation in XML format.
-#
-# Steps to using it:
-#
-#   (1) Generate your xdoc documentation using xdoc::save.  This should result
-#       in a directory, say "my-doc-dir", with a subdirectory named "xml" that
-#       contains a lot of XML files, and a copy of this Makefile as its Makefile.
-#
-#   (2) In my-doc-dir, just run "make" to do the conversion.  By default all
-#       supported formats will be generated.  If you only want a particular
-#       format, you can do, e.g., "make html", or "make text", etc.  If you 
-#       encounter an error, consider using GNU Make's "-k" flag.
-
-
-
-# --- Sanity check that Xalan is installed -----------------------------------
-
-XALAN ?= $(shell which Xalan 2>/dev/null || echo "")
-XALAN_UBUNTU ?= $(shell which xalan 2>/dev/null || echo "")
-
-ifeq "$(XALAN)" ""
-ifeq "$(XALAN_UBUNTU)" ""
-
-$(info )
-$(info Error: Xalan-C++ not found.)
-$(info )
-$(info Xalan-C++ is available from http://xml.apache.org/xalan-c/.)
-$(info )
-$(info Depending on your operating system, it may be possible to easily install it)
-$(info using tools like apt-get, port, or similar.)
-$(info )
-$(info Once you have Xalan installed, you should be able to invoke "Xalan" with no)
-$(info arguments and see a message like:)
-$(info )
-$(info     Xalan version 1.10.0.)
-$(info     Xerces version 2.7.0.)
-$(info     Usage: Xalan [options] source stylesheet)
-$(info     ...)
-$(info )
-$(info Note: if you just want to view the documentation and do not care about)
-$(info turning into HTML, try opening preview.html in your web browser.)
-$(info )
-$(error Xalan-C++ not found)
-
-endif
-endif
-
-
-# ----------------------------------------------------------------------------
-
-# Define a function named xslt-translate that take three arguments:
-# (1) the input xml file, (2) the xsl file that indicates how the xml
-# should be rendered, and (3) the output file.
-ifneq "$(XALAN)" ""
-$(info Using $(XALAN) with -o [output] [input] [stylesheet])
-xslt-translate = $(XALAN) -o $(3) $(1) $(2)
-else
-$(info Using $(XALAN_UBUNTU) with -in [input] -xsl [stylesheet] -out [output])
-xslt-translate = $(XALAN_UBUNTU) -in $(1) -xsl $(2) -out $(3)
-endif
-
-
-XML_TOPICS := $(wildcard xml/*.xml)
-XDOC_LINKS := $(wildcard xml/*.xdoc-link)
-
-HTML_TOPICS := $(patsubst xml/%.xml, html/%.html, $(XML_TOPICS))
-TEXT_TOPICS := $(patsubst xml/%.xml, text/%.text, $(XML_TOPICS))
-
-HTML_XDOC_LINKS := $(patsubst xml/%.xdoc-link, html/%.xdoc-link, $(XDOC_LINKS))
-
-
-FORMATS := text html
-
-.PHONY: all
-all: $(FORMATS)
-
-
-.PHONY: text
-text: $(TEXT_TOPICS)
-
-.PHONY: text-dir
-text-dir:
-	@echo "Preparing text/ directory"
-	@mkdir -p text
-
-text/%.text: xml/%.xml xml/text-topic.xsl text-dir
-	@echo $@
-	@$(call xslt-translate,xml/$*.xml,xml/text-topic.xsl,text/$*.text)
-
-.PHONY: html
-html: $(HTML_TOPICS) \
-      $(HTML_XDOC_LINKS) \
-      html/full-index.html \
-      html/brief-index.html \
-      html/topic-index.html
-
-.PHONY: html-dir
-html-dir:
-	@echo "Preparing html/ directory"
-	@mkdir -p html
-	@cp xml/xdoc.css xml/xdoc.js html
-	@cp xml/plus.png xml/minus.png xml/leaf.png html
-
-# Goofy to copy them all one by one, but prevents "too many arguments"
-# warnings during the copy command in some extreme cases
-html/%.xdoc-link: xml/%.xdoc-link
-	@echo $@
-	@cp xml/$*.xdoc-link html/$*.xdoc-link
-
-html/%.html: xml/%.xml xml/html-topic.xsl html-dir
-	@echo $@
-	@$(call xslt-translate,xml/$*.xml,xml/html-topic.xsl,html/$*.html)
-
-html/full-index.html: xml/index.xml xml/html-full-index.xsl html-dir
-	@echo $@
-	@$(call xslt-translate,xml/index.xml,xml/html-full-index.xsl,$@)
-
-html/brief-index.html: xml/index.xml xml/html-brief-index.xsl html-dir
-	@echo $@
-	@$(call xslt-translate,xml/index.xml,xml/html-brief-index.xsl,$@)
-
-html/topic-index.html: xml/topics.xml xml/html-topic-index.xsl html-dir
-	@echo $@
-	@$(call xslt-translate,xml/topics.xml,xml/html-topic-index.xsl,$@)
diff -Nru acl2-6.2/books/xdoc/support/frames2.html acl2-6.3/books/xdoc/support/frames2.html
--- acl2-6.2/books/xdoc/support/frames2.html	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/frames2.html	1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-<html>
-
-<!-- You may wish to develop a customized replacement for this page. -->
-
-<head>
-<title>XDOC Manual</title>
-</head>
-
-<script language="JavaScript">
-<!--
-
-function getPageParameters ()
-{
-   var ret = {};
-   if (!window.location.toString().match(/\?(.+)$/)) {
-       return ret;
-   }
-   param_strs = RegExp.$1.split("&");
-   var param_arr = {};
-   for(var i = 0; i < param_strs.length; ++i)
-   {
-      var tmp = param_strs[i].split("=");
-      var key = decodeURI(tmp[0]);
-      var val = decodeURI(tmp[1]);
-      param_arr[key] = val;
-   }
-   return param_arr;
-}
-
-// We generate the frameset so that you can deeply link to a particular page
-// by adding, e.g., ?topic=COMMON-LISP____APPEND
-
-var params = getPageParameters();
-var topic = params["topic"];
-var url = topic ? ("html/" + topic + ".html") : "html/full-index.html";
-
-document.write("<frameset cols='20%,*' border='2' bordercolor='#000000'>\n");
-document.write("  <frame src='html/topic-index.html' name='topics' />\n");
-document.write("  <frame src='" + url + "' name='detail' />\n");
-document.write("</frameset>\n");
-
-// -->
-</script>
-
-</html>
diff -Nru acl2-6.2/books/xdoc/support/frames3.html acl2-6.3/books/xdoc/support/frames3.html
--- acl2-6.2/books/xdoc/support/frames3.html	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/frames3.html	1970-01-01 00:00:00.000000000 +0000
@@ -1,48 +0,0 @@
-<html>
-
-<!-- You may wish to develop a customized replacement for this page. -->
-
-<head>
-<title>XDOC Manual</title>
-</head>
-
-<script language="JavaScript">
-<!--
-
-// We generate the frameset so that you can deeply link to a particular page
-// by adding, e.g., ?topic=COMMON-LISP____APPEND
-
-function getPageParameters ()
-{
-   var ret = {};
-   if (!window.location.toString().match(/\?(.+)$/)) {
-       return ret;
-   }
-   param_strs = RegExp.$1.split("&");
-   var param_arr = {};
-   for(var i = 0; i < param_strs.length; ++i)
-   {
-      var tmp = param_strs[i].split("=");
-      var key = decodeURI(tmp[0]);
-      var val = decodeURI(tmp[1]);
-      param_arr[key] = val;
-   }
-   return param_arr;
-}
-
-var params = getPageParameters();
-var topic = params["topic"];
-var url = topic ? ("html/" + topic + ".html") : "html/full-index.html";
-
-document.write("<frameset cols='20%,*' border='2' bordercolor='#000000'>\n");
-document.write("  <frameset rows='70%,30%' border='2' bordercolor='#000000'>\n");
-document.write("    <frame src='html/topic-index.html' name='topics' />\n");
-document.write("    <frame src='html/brief-index.html' name='brief' />\n");
-document.write("  </frameset>\n");
-document.write("  <frame src='" + url + "' name='detail' />\n");
-document.write("</frameset>\n");
-
--->
-</script>
-
-</html>
diff -Nru acl2-6.2/books/xdoc/support/html-brief-index.xsl acl2-6.3/books/xdoc/support/html-brief-index.xsl
--- acl2-6.2/books/xdoc/support/html-brief-index.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/html-brief-index.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,62 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  html-brief-index.xsl
-
-  Provides a compact view of the index for the three-frame html display.  You
-  can compare/contrast with html-full-index.xsl which generates the more
-  elaborate index.
-
--->
-
-<xsl:include href="html-topic.xsl"/>
-
-<xsl:template match="page">
-  <html>
-  <head>
-    <title><xsl:value-of select="@name"/></title>
-    <link rel="stylesheet" type="text/css" href="xdoc.css"/>
-    <base target="detail"/>
-  </head>
-  <body class="body_brief">
-<!--   <h4>Alphabetic Listing</h4> -->
-  <xsl:apply-templates/>
-  </body>
-  </html>
-</xsl:template>
-
-<xsl:template match="index">
-  <dl class="index_brief">
-  <dt class="index_brief_dt"><a href="full-index.html">Full Index</a></dt>
-  </dl>
-  <dl class="index_brief">
-  <xsl:for-each select="index_entry">
-    <xsl:sort select="index_head/see" />
-    <dt class="index_brief_dt"><xsl:apply-templates select="index_head"/></dt>
-  </xsl:for-each>
-  </dl>
-</xsl:template>
-
-</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/support/html-core.xsl acl2-6.3/books/xdoc/support/html-core.xsl
--- acl2-6.2/books/xdoc/support/html-core.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/html-core.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,244 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  html-core.xsl - main conversion from xdoc markup to html
-
--->
-
-<xsl:template match="page">
-  <html>
-  <head>
-    <title><xsl:value-of select="@name"/></title>
-    <link rel="stylesheet" type="text/css" href="xdoc.css"/>
-    <script type="text/javascript" src="xdoc.js"/>
-  </head>
-  <body class="body_normal">
-  <xsl:apply-templates/>
-  </body>
-  </html>
-</xsl:template>
-
-<xsl:template match="index">
-  <h3><xsl:value-of select="@title"/></h3>
-  <dl class="index_dl">
-  <xsl:for-each select="index_entry">
-    <xsl:sort select="index_head/see" />
-    <dt class="index_dt"><xsl:apply-templates select="index_head"/></dt>
-    <dd class="index_dd"><xsl:apply-templates select="index_body"/></dd>
-  </xsl:for-each>
-  </dl>
-</xsl:template>
-
-<xsl:template match="topic">
-  <h1><xsl:value-of select="@name"/></h1>
-  <xsl:apply-templates/>
-</xsl:template>
-
-<xsl:template match="hindex_root">
-  <ul class="hindex"><xsl:apply-templates/></ul>
-</xsl:template>
-
-<xsl:template match="hindex_children">
-  <xsl:choose>
-    <xsl:when test="@kind='hide'">
-	<ul class="hindex" id="{@id}" style="display: none">
-	<xsl:apply-templates/>
-	</ul>
-    </xsl:when>
-
-    <xsl:otherwise>
-	<ul class="hindex" id="{@id}">
-	<xsl:apply-templates/>
-	</ul>
-    </xsl:otherwise>
-  </xsl:choose>
-</xsl:template>
-
-<xsl:template match="hindex_short">
-</xsl:template>
-
-<xsl:template match="hindex_name">
-</xsl:template>
-
-<xsl:template match="short">
-  <p><xsl:apply-templates/></p>
-</xsl:template>
-
-<xsl:template match="srclink">
-  <a href="{@file}" class="srclink" title="Find-Tag in Emacs">
-    <xsl:apply-templates/>
-  </a>
-</xsl:template>
-
-<xsl:template match="code">
-  <pre class="code"><xsl:apply-templates/></pre>
-</xsl:template>
-
-<xsl:template match="box">
-  <div class="box"><xsl:apply-templates/></div>
-</xsl:template>
-
-<xsl:template match="p">
-  <p><xsl:apply-templates/></p>
-</xsl:template>
-
-<xsl:template match="blockquote">
-  <blockquote><xsl:apply-templates/></blockquote>
-</xsl:template>
-
-<xsl:template match="br">
-  <xsl:apply-templates/><br/>
-</xsl:template>
-
-<xsl:template match="a">
-  <a href="{@href}">
-    <xsl:value-of select="."/>
-  </a>
-</xsl:template>
-
-<xsl:template match="img">
-  <img src="{@src}"/>
-</xsl:template>
-
-<xsl:template match="b">
-  <b><xsl:apply-templates/></b>
-</xsl:template>
-
-<xsl:template match="i">
-  <i><xsl:apply-templates/></i>
-</xsl:template>
-
-<xsl:template match="color">
-  <font color="{@rgb}"><xsl:apply-templates/></font>
-</xsl:template>
-
-<xsl:template match="sf">
-  <span class="sf"><xsl:apply-templates/></span>
-</xsl:template>
-
-<xsl:template match="u">
-  <u><xsl:apply-templates/></u>
-</xsl:template>
-
-<xsl:template match="tt">
-  <span class="tt"><xsl:apply-templates/></span>
-</xsl:template>
-
-<xsl:template match="ul">
-  <ul><xsl:apply-templates/></ul>
-</xsl:template>
-
-<xsl:template match="ol">
-  <ol><xsl:apply-templates/></ol>
-</xsl:template>
-
-<xsl:template match="li">
-  <li><xsl:apply-templates/></li>
-</xsl:template>
-
-<xsl:template match="dl">
-  <dl><xsl:apply-templates/></dl>
-</xsl:template>
-
-<xsl:template match="dt">
-  <dt><xsl:apply-templates/></dt>
-</xsl:template>
-
-<xsl:template match="dd">
-  <dd><xsl:apply-templates/></dd>
-</xsl:template>
-
-<xsl:template match="h1">
-  <h1><xsl:apply-templates/></h1>
-</xsl:template>
-
-<xsl:template match="h2">
-  <h2><xsl:apply-templates/></h2>
-</xsl:template>
-
-<xsl:template match="h3">
-  <h3><xsl:apply-templates/></h3>
-</xsl:template>
-
-<xsl:template match="h4">
-  <h4><xsl:apply-templates/></h4>
-</xsl:template>
-
-<xsl:template match="h5">
-  <h5><xsl:apply-templates/></h5>
-</xsl:template>
-
-
-
-<!-- Extra stuff for Symbolic Test Vectors at Centaur -->
-
-
-<xsl:template match="stv">
-  <table class="stv" cellspacing="0" cellpadding="2"><xsl:apply-templates/></table>
-</xsl:template>
-
-<xsl:template match="stv_labels">
- <tr class="stv_labels"><xsl:apply-templates/></tr>
-</xsl:template>
-
-<xsl:template match="stv_inputs">
-  <xsl:for-each select="stv_line">
-   <tr class="stv_input_line"><xsl:apply-templates/></tr>
-  </xsl:for-each>
-</xsl:template>
-
-<xsl:template match="stv_outputs">
-  <xsl:for-each select="stv_line">
-   <tr class="stv_output_line"><xsl:apply-templates/></tr>
-  </xsl:for-each>
-</xsl:template>
-
-<xsl:template match="stv_internals">
-  <xsl:for-each select="stv_line">
-   <tr class="stv_internal_line"><xsl:apply-templates/></tr>
-  </xsl:for-each>
-</xsl:template>
-
-<xsl:template match="stv_initials">
-  <xsl:for-each select="stv_line">
-   <tr class="stv_initial_line"><xsl:apply-templates/></tr>
-  </xsl:for-each>
-</xsl:template>
-
-<xsl:template match="stv_name">
-  <th class="stv_name"><xsl:apply-templates/></th>
-</xsl:template>
-
-<xsl:template match="stv_entry">
-  <td class="stv_entry"><xsl:apply-templates/></td>
-</xsl:template>
-
-<xsl:template match="stv_label">
-  <th class="stv_label"><xsl:apply-templates/></th>
-</xsl:template>
-
-
-
-</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/support/html-full-index.xsl acl2-6.3/books/xdoc/support/html-full-index.xsl
--- acl2-6.2/books/xdoc/support/html-full-index.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/html-full-index.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  html-full-index.xsl
-
-  Provides the more full view of the index, which is shown when the "Full
-  index" page is loaded.
-
--->
-
-<xsl:include href="html-topic.xsl"/>
-
-<xsl:template match="index">
-  <h1>Full Index</h1>
-  <dl class="index_dl">
-  <xsl:for-each select="index_entry">
-    <xsl:sort select="index_head/see" />
-    <dt class="index_dt"><xsl:apply-templates select="index_head"/></dt>
-    <dd class="index_dd"><xsl:apply-templates select="index_body"/></dd>
-  </xsl:for-each>
-  </dl>
-</xsl:template>
-
-</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/support/html-topic-index.xsl acl2-6.3/books/xdoc/support/html-topic-index.xsl
--- acl2-6.2/books/xdoc/support/html-topic-index.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/html-topic-index.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  html-topic-index.xsl
-
-  This generates the hierarchical topic-navigator for both the two-frame and
-  three-frame html versions.
-
--->
-
-<xsl:include href="html-topic.xsl"/>
-
-<xsl:template match="page">
-  <html>
-  <head>
-    <title><xsl:value-of select="@name"/></title>
-    <link rel="stylesheet" type="text/css" href="xdoc.css"/>
-    <script type="text/javascript" src="xdoc.js"/>
-    <base target="detail"/>
-  </head>
-  <body class="body_brief">
-<!--   <h4>Organized Listing</h4> -->
-  <dl class="index_brief">
-  <dt class="index_brief_dt"><a href="full-index.html">Full Index</a></dt>
-  </dl>
-  <div class="hindex_fix">
-  <xsl:apply-templates/>
-  </div>
-  </body>
-  </html>
-</xsl:template>
-
-</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/support/html-topic.xsl acl2-6.3/books/xdoc/support/html-topic.xsl
--- acl2-6.2/books/xdoc/support/html-topic.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/html-topic.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,72 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  html-topic.xsl
-
-  Converts an xdoc topic page to a static html page.  This is basically
-  html-core.xsl, with .html file extensions on <see> links.
-
--->
-
-<xsl:include href="html-core.xsl"/>
-
-<xsl:template match="parent">
-  <p>Parent: <a href="{@topic}.html">
-    <xsl:value-of select="."/>
-  </a></p>
-</xsl:template>
-
-<xsl:template match="see">
-  <a href="{@topic}.html">
-    <xsl:value-of select="."/>
-  </a>
-</xsl:template>
-
-<xsl:template match="hindex">
-  <li><nobr><xsl:choose>
-	<xsl:when test="@kind='leaf'">
-           <img src="leaf.png"/>
-        </xsl:when>
-
-        <xsl:when test="@kind='show'">
-           <a href="JavaScript:toggleVisible('{@id}')">
-             <img id="img-{@id}" src="minus.png" border="0"/>
-           </a>
-        </xsl:when>
-
-        <xsl:when test="@kind='hide'">
-           <a href="JavaScript:toggleVisible('{@id}')">
-             <img id="img-{@id}" src="plus.png" border="0"/>
-           </a>
-	</xsl:when>
-      </xsl:choose>
-      <a href="{@topic}.html" title="{hindex_short}">
-	<xsl:value-of select="hindex_name"/>
-     </a></nobr>
-    <xsl:apply-templates/>
-  </li>
-</xsl:template>
-
-</xsl:stylesheet>
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/support/leaf.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/support/leaf.png differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/support/minus.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/support/minus.png differ
Binary files /tmp/7nKpiZgXK0/acl2-6.2/books/xdoc/support/plus.png and /tmp/b2KjCbRUvz/acl2-6.3/books/xdoc/support/plus.png differ
diff -Nru acl2-6.2/books/xdoc/support/preview.html acl2-6.3/books/xdoc/support/preview.html
--- acl2-6.2/books/xdoc/support/preview.html	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/preview.html	1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-<html>
-<head>
-<title>XDOC Manual Preview</title>
-</head>
-
-<script language="JavaScript">
-<!--
-
-// We generate the frameset so that you can deeply link to a particular page
-// by adding, e.g., ?topic=COMMON-LISP____APPEND
-
-function getPageParameters ()
-{
-   var ret = {};
-   if (!window.location.toString().match(/\?(.+)$/)) {
-       return ret;
-   }
-   param_strs = RegExp.$1.split("&");
-   var param_arr = {};
-   for(var i = 0; i < param_strs.length; ++i)
-   {
-      var tmp = param_strs[i].split("=");
-      var key = decodeURI(tmp[0]);
-      var val = decodeURI(tmp[1]);
-      param_arr[key] = val;
-   }
-   return param_arr;
-}
-
-var params = getPageParameters();
-var topic = params["topic"];
-var url = topic ? ("xml/" + topic + ".xml") : "xml/index.xml";
-
-document.write("<frameset cols='20%,*' border='3' bordercolor='black'>\n");
-document.write("  <frame src='xml/topics.xml' name='topics' />\n");
-document.write("  <frame src='" + url + "' name='detail' />\n");
-document.write("</frameset>\n");
-
--->
-</script>
-
-</html>
diff -Nru acl2-6.2/books/xdoc/support/text-topic.xsl acl2-6.3/books/xdoc/support/text-topic.xsl
--- acl2-6.2/books/xdoc/support/text-topic.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/text-topic.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,226 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  text.xsl - converts xdoc markup to plain text
-
-  [Jared 1/03/11]: Note that the :xdoc command does NOT use this file; this is
-   only used to generate the files in the text/ directory of a manual, and I
-   think its output is inferior to the acl2-based :xdoc command.
-
-
-  [Jared 10/21/09]:  I haven't put too much work into this.  Doing fancy
-  things with XSLT seems rather difficult and I am not an expert.
-
-     The main deficiency right now is that I do not know how to make links
-  stand out. My word-wrapping code is copied from some web site, and to use it
-  I seem to have to treat the contents of elements such as <p> and <li> as
-  ordinary text.  This means that templates for <a> and <see> are never
-  processed.  Maybe someone who knows XSLT will be able to provide a fix.
-
--->
-
-<xsl:output method="text"/>
-<xsl:strip-space elements="box ul ol dl p topic"/>
-
-<xsl:template match="topic">
-  <xsl:text>------------------------------------------------------------------------&#xA;&#xA;</xsl:text>
-  <xsl:text>     </xsl:text>
-  <xsl:value-of select="@name"/>
-  <xsl:text>&#xA;&#xA;</xsl:text>
-  <xsl:text>------------------------------------------------------------------------&#xA;&#xA;</xsl:text>
-  <xsl:apply-templates/>
-  <xsl:text>&#xA;------------------------------------------------------------------------&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="parent">
-  <xsl:text>Parent Topic: </xsl:text>
-  <xsl:value-of select="."/>
-  <xsl:text> (</xsl:text>
-  <xsl:value-of select="@topic"/>
-  <xsl:text>)&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="p">
-  <!-- Word wrap paragraphs. -->
-  <xsl:call-template name="wrap-string">
-   <xsl:with-param name="str" select="normalize-space(.)"/>
-   <xsl:with-param name="wrap-col" select="65"/>
-   <xsl:with-param name="break-mark" select="'&#xA;'"/>
-  </xsl:call-template>
-  <xsl:text>&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="blockquote">
-  <!-- just treat blockquotes like regular paragraphs -->
-  <xsl:call-template name="wrap-string">
-   <xsl:with-param name="str" select="normalize-space(.)"/>
-   <xsl:with-param name="wrap-col" select="65"/>
-   <xsl:with-param name="break-mark" select="'&#xA;'"/>
-  </xsl:call-template>
-  <xsl:text>&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="ul">
-  <xsl:apply-templates/>
-  <xsl:text>&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="ol">
-  <xsl:apply-templates/>
-  <xsl:text>&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="dl">
-  <xsl:apply-templates/>
-  <xsl:text>&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="box">
-  <!-- This isn't great. -->
-  <xsl:apply-templates/>
-</xsl:template>
-
-<xsl:template match="li">
-  <!-- Word wrap li elements and star them. -->
-  <xsl:text>  * </xsl:text>
-  <xsl:call-template name="wrap-string">
-   <xsl:with-param name="str" select="normalize-space(.)"/>
-   <xsl:with-param name="wrap-col" select="65"/>
-   <xsl:with-param name="break-mark" select="'&#xA;'"/>
-   <xsl:with-param name="pos" select="4"/>
-  </xsl:call-template>
-  <xsl:text>&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="dd">
-  <!-- Word wrap dd elements and indent them. -->
-  <xsl:text>      </xsl:text>
-  <xsl:call-template name="wrap-string">
-   <xsl:with-param name="str" select="normalize-space(.)"/>
-   <xsl:with-param name="wrap-col" select="65"/>
-   <xsl:with-param name="break-mark" select="'&#xA;'"/>
-   <xsl:with-param name="pos" select="6"/>
-  </xsl:call-template>
-  <xsl:text>&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="dt">
-  <!-- Word wrap dt elements and indent them. -->
-  <xsl:text>  </xsl:text>
-  <xsl:call-template name="wrap-string">
-   <xsl:with-param name="str" select="normalize-space(.)"/>
-   <xsl:with-param name="wrap-col" select="65"/>
-   <xsl:with-param name="break-mark" select="'&#xA;'"/>
-   <xsl:with-param name="pos" select="2"/>
-  </xsl:call-template>
-  <xsl:text>&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="short">
-  <xsl:apply-templates/>
-  <xsl:text>&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="h1">
-  <xsl:text>&#xA;--- </xsl:text>
-  <xsl:apply-templates/>
-  <xsl:text> ---&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="h2">
-  <xsl:text>&#xA;--- </xsl:text>
-  <xsl:apply-templates/>
-  <xsl:text> ---&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="h3">
-  <xsl:text>&#xA;--- </xsl:text>
-  <xsl:apply-templates/>
-  <xsl:text> ---&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="h4">
-  <xsl:text>&#xA;</xsl:text>
-  <xsl:apply-templates/>
-  <xsl:text>&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="h5">
-  <xsl:text>&#xA;</xsl:text>
-  <xsl:apply-templates/>
-  <xsl:text>&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="code">
-  <xsl:value-of select="."/>
-  <xsl:text>&#xA;&#xA;</xsl:text>
-</xsl:template>
-
-<xsl:template match="see">
-  <!-- This doesn't work with word-wrapping tags like <p> and <li>. -->
-  <xsl:value-of select="."/>
-  <xsl:text> (Link: </xsl:text>
-  <xsl:value-of select="@topic"/>
-  <xsl:text>)</xsl:text>
-</xsl:template>
-
-<!-- I got this this word-wrapping code from http://plasmasturm.org/log/204/ -->
-<xsl:template name="wrap-string">
-    <xsl:param name="str" />
-    <xsl:param name="wrap-col" />
-    <xsl:param name="break-mark" />
-    <xsl:param name="pos" select="0" />
-    <xsl:choose>
-        <xsl:when test="contains( $str, ' ' )">
-            <xsl:variable name="before" select="substring-before( $str, ' ' )" />
-            <xsl:variable name="pos-now" select="$pos + string-length( $before )" />
-
-            <xsl:choose>
-                <xsl:when test="$pos = 0" />
-                <xsl:when test="floor( $pos div $wrap-col ) != floor( $pos-now div $wrap-col )">
-                    <xsl:copy-of select="$break-mark" />
-                </xsl:when>
-                <xsl:otherwise>
-                    <xsl:text> </xsl:text>
-                </xsl:otherwise>
-            </xsl:choose>
-
-            <xsl:value-of select="$before" />
-
-            <xsl:call-template name="wrap-string">
-                <xsl:with-param name="str" select="substring-after( $str, ' ' )" />
-                <xsl:with-param name="wrap-col" select="$wrap-col" />
-                <xsl:with-param name="break-mark" select="$break-mark" />
-                <xsl:with-param name="pos" select="$pos-now" />
-            </xsl:call-template>
-        </xsl:when>
-        <xsl:otherwise>
-            <xsl:if test="$pos &gt; 0"><xsl:text> </xsl:text></xsl:if>
-            <xsl:value-of select="$str" />
-        </xsl:otherwise>
-    </xsl:choose>
-</xsl:template>
-
-</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/support/xdoc.css acl2-6.3/books/xdoc/support/xdoc.css
--- acl2-6.2/books/xdoc/support/xdoc.css	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/xdoc.css	1970-01-01 00:00:00.000000000 +0000
@@ -1,230 +0,0 @@
-/*
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-*/
-
-body {
-  font-family: "Georgia", "Bookman Old Style", serif;
-}
-
-.body_normal {
-  margin-left: 1em;
-  width: 45em;
-}
-
-h1,h2,h3,h4,h5 {
-  font-family: "Geneva", "Verdana", sans-serif;
-}
-
-h1 { font-size: 2.2em; color: #900000; text-align: center; }
-h2 { font-size: 1.8em; color: #900000; }
-h3 { font-size: 1.5em; color: #600000; }
-h4 { font-size: 1.2em; color: #600000; }
-h5 { font-size: 1.1em; color: #600000; margin-left: 1em;}
-
-p, dl { margin-left: 1em; }
-
-li    { margin-left: 1.0em; margin-bottom: 0.5em; }
-li li { margin-left: -1.0em; margin-bottom: 0em; }
-
-dt {
-  margin-left: 1em;
-  margin-top: 1em;
-  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
-  font-weight: bold;
-}
-
-.box {
-  margin-left: 1.5em;
-  margin-right: 1.5em;
-  border-width: 1px;
-  border-style: solid;
-  border-color: black;
-}
-
-.code {
-  margin-left: 2.5em;
-  padding: .5em;
-  border-left-width: 3px;
-  border-left-style: solid;
-  border-left-color: #f9e0a3;
-  color: #306030;
-  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
-}
-li .code {
-  margin-left: 1em;
-}
-
-a { text-decoration: none; }
-a:hover {
-  background-color: #ffffb0;
-  text-decoration: underline;
-}
-.code a {
-    color: #309030;
-}
-
-.srclink {
-  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
-  text-decoration: none;
-  background-color: #e0e0e0;
-  padding: 2px;
-/*  font-size: 100%; */
-}
-.srclink:hover {
-  text-decoration: none;
-}
-
-.sf {
-  font-family: "Geneva", "Verdana", sans-serif;
-}
-
-.tt {
-  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
-  color: #306030;
-/*   font-size: 100%; */
-}
-
-
-/* Brief index, used only in the 3-frame displayed */
-
-.index_brief_dt {
-  margin-top: 0px;
-  margin-left: 0em;
-  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
-  font-weight: normal;
-}
-
-.index_brief_dt a {
-  text-decoration: none;
-}
-.index_brief_dt a:hover {
-  text-decoration: underline;
-}
-
-
-/* Main, hierarchical index, used in both 2- and 3-frame displays. */
-
-.hindex {
-  list-style-type: none;
-  padding: 0px;
-  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
-  font-weight: normal;
-}
-
-.hindex li {
-  margin-bottom: 0em;
-}
-
-.hindex li li {
-  margin-left: 0.5em;
-}
-
-
-
-
-/* Extra stuff for Symbolic Test Vectors at Centaur */
-
-
-.stv {
-  margin-left: 1em;
-  border: 1px;
-  border-color: black;
-  border-style: solid;
-}
-
-.stv th {
-  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
-}
-
-.stv td {
-  font-family: "Consolas", "Bitstream Vera Sans Mono", "DejaVu Sans Mono", "Lucida Console", monospace;
-
-  text-align: right;
-  padding-left: .5em;
-  padding-right: .5em;
-}
-
-.stv_labels {
-  background-color: #e0ffc3;
-}
-
-.stv_labels th:nth-child(even) {
-  background-color: #e9ffd6;
-}
-
-.stv_labels th {
-  font-family: "Tahoma", "Geneva", "Verdana", sans-serif;
-  text-align: left;
-
-  border-bottom: 2px;
-  border-bottom-style: solid;
-  border-bottom-color: #b0dda3;
-
-  border-right: 1px;
-  border-right-style: solid;
-  border-right-color: #b0dda3;
-}
-
-.stv_input_line {
-  background-color: #ffe0c3;
-}
-
-.stv_input_line td:nth-child(even) {
-  background-color: #ffe9d6;
-}
-
-.stv_input_line td {
-  border-bottom: 1px;
-  border-bottom-color: #ddb0a3;
-  border-bottom-style: solid;
-  border-right: 1px;
-  border-right-style: solid;
-  border-right-color: #ddb0a3;
-}
-
-
-.stv_output_line {
-    background-color: #c3e0ff;
-}
-
-.stv_output_line td:nth-child(even) {
-  background-color: #d6e9ff;
-}
-
-.stv_output_line td {
-  border-bottom: 1px;
-  border-bottom-color: #a3b0dd;
-  border-bottom-style: solid;
-  border-right: 1px;
-  border-right-style: solid;
-  border-right-color: #a3b0dd;
-}
-
-
-.stv_name {
-    border-right: 2px;
-    border-right-style: solid;
-    border-right-color: #000060;
-    text-align: left;
-    padding-right: 1em;
-}
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc/support/xdoc.js acl2-6.3/books/xdoc/support/xdoc.js
--- acl2-6.2/books/xdoc/support/xdoc.js	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/xdoc.js	1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-/*
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  xdoc.js
-  JavaScript functions for XDOC
-
-*/
-
-function toggleVisible(d)
-{
-    var doc = parent.topics.document;
-
-    if (doc.getElementById(d).style.display == "none")
-    {
-	doc.getElementById(d).style.display = "block";
-        doc.getElementById("img-" + d).src = "minus.png";
-    }
-    else
-    {
-	doc.getElementById(d).style.display = "none";
-        doc.getElementById("img-" + d).src = "plus.png";
-    }
-}
diff -Nru acl2-6.2/books/xdoc/support/xml-full-index.xsl acl2-6.3/books/xdoc/support/xml-full-index.xsl
--- acl2-6.2/books/xdoc/support/xml-full-index.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/xml-full-index.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  xml-full-index.xsl
-
-  Provides the more full view of the index, which is shown when the "Full
-  index" page is loaded.
-
--->
-
-<xsl:include href="xml-topic.xsl"/>
-
-<xsl:template match="index">
-  <h1>Full Index</h1>
-  <dl class="index_dl">
-  <xsl:for-each select="index_entry">
-    <xsl:sort select="index_head/see" />
-    <dt class="index_dt"><xsl:apply-templates select="index_head"/></dt>
-    <dd class="index_dd"><xsl:apply-templates select="index_body"/></dd>
-  </xsl:for-each>
-  </dl>
-</xsl:template>
-
-</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/support/xml-topic-index.xsl acl2-6.3/books/xdoc/support/xml-topic-index.xsl
--- acl2-6.2/books/xdoc/support/xml-topic-index.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/xml-topic-index.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  xml-topic-index.xsl
-
-  Used for the hierarchical topic-navigator for both the two-frame and
-  three-frame xml versions.
-
--->
-
-<xsl:include href="xml-topic.xsl"/>
-
-<xsl:template match="page">
-  <html>
-  <head>
-    <title><xsl:value-of select="@name"/></title>
-    <link rel="stylesheet" type="text/css" href="xdoc.css"/>
-    <script type="text/javascript" src="xdoc.js"/>
-    <base target="detail"/>
-  </head>
-  <body class="body_brief">
-<!--  <h4>Organized Listing</h4> -->
-  <dl class="index_brief">
-  <dt class="index_brief_dt"><a href="index.xml">Full Index</a></dt>
-  </dl>
-  <div class="hindex_fix">
-  <xsl:apply-templates/>
-  </div>
-  </body>
-  </html>
-</xsl:template>
-
-</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/support/xml-topic.xsl acl2-6.3/books/xdoc/support/xml-topic.xsl
--- acl2-6.2/books/xdoc/support/xml-topic.xsl	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/support/xml-topic.xsl	1970-01-01 00:00:00.000000000 +0000
@@ -1,71 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
-
-<!--
-
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-  xml-topic.xsl  -  directly stylize .xml files for use in a web browser
-
-  This is basically html-core.xsl, with .xml file extensions on <see> links.
-
--->
-
-<xsl:include href="html-core.xsl"/>
-
-<xsl:template match="parent">
-  <p>Parent: <a href="{@topic}.xml">
-    <xsl:value-of select="."/>
-  </a></p>
-</xsl:template>
-
-<xsl:template match="see">
-  <a href="{@topic}.xml">
-    <xsl:value-of select="."/>
-  </a>
-</xsl:template>
-
-<xsl:template match="hindex">
-  <li><nobr><xsl:choose>
-	<xsl:when test="@kind='leaf'">
-           <img src="leaf.png"/>
-        </xsl:when>
-
-        <xsl:when test="@kind='show'">
-           <a href="JavaScript:toggleVisible('{@id}')">
-             <img id="img-{@id}" src="minus.png" border="0"/>
-           </a>
-        </xsl:when>
-
-        <xsl:when test="@kind='hide'">
-           <a href="JavaScript:toggleVisible('{@id}')">
-             <img id="img-{@id}" src="plus.png" border="0"/>
-           </a>
-	</xsl:when>
-      </xsl:choose>
-      <a href="{@topic}.xml" title="{hindex_short}">
-	<xsl:value-of select="hindex_name"/>
-     </a></nobr>
-    <xsl:apply-templates/>
-  </li>
-</xsl:template>
-
-</xsl:stylesheet>
diff -Nru acl2-6.2/books/xdoc/top.acl2 acl2-6.3/books/xdoc/top.acl2
--- acl2-6.2/books/xdoc/top.acl2	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/top.acl2	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,23 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+;; Special .acl2 file for top.lisp, so that top.lisp won't need to include
+;; the portcullis files for libraries other than XDOC.
+(include-book "portcullis")
diff -Nru acl2-6.2/books/xdoc/top.lisp acl2-6.3/books/xdoc/top.lisp
--- acl2-6.2/books/xdoc/top.lisp	2013-06-06 17:11:02.000000000 +0000
+++ acl2-6.3/books/xdoc/top.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -29,33 +29,21 @@
 (include-book "base")
 (include-book "book-thms")
 
-(make-event `(defconst *xdoc-dir/save*
-               ,(acl2::extend-pathname *xdoc-impl-dir* "save" state)))
-(make-event `(defconst *xdoc-dir/display*
-               ,(acl2::extend-pathname *xdoc-impl-dir* "display" state)))
-(make-event `(defconst *xdoc-dir/topics*
-               ,(acl2::extend-pathname *xdoc-impl-dir* "topics" state)))
-(make-event `(defconst *xdoc-dir/defxdoc-raw*
-               ,(acl2::extend-pathname *xdoc-dir* "defxdoc-raw" state)))
-(make-event `(defconst *xdoc-dir/mkdir-raw*
-               ,(acl2::extend-pathname *xdoc-impl-dir* "mkdir-raw" state)))
-(make-event `(defconst *xdoc-dir/extra-packages*
-               ,(acl2::extend-pathname *xdoc-impl-dir* "extra-packages" state)))
-
-
-
-
 (defmacro colon-xdoc-init ()
-  '(with-output :off (summary event)
+  '(with-output :off (summary event observation)
      (make-event
       (if (not (cdr (assoc 'colon-xdoc-support-loaded (table-alist 'xdoc (w state)))))
         `(progn
-           (include-book ,*xdoc-dir/defxdoc-raw* :ttags :all)
-           (include-book ,*xdoc-dir/topics*)
-           (include-book ,*xdoc-dir/display*)
-           (include-book ,*xdoc-dir/extra-packages*)
-           (import-acl2doc)
-           (maybe-import-bookdoc)
+           (include-book ;; newlines to fool dependency scanner
+            "xdoc/defxdoc-raw" :dir :system :ttags :all)
+           (include-book
+            "xdoc/topics" :dir :system)
+           (include-book
+            "xdoc/display" :dir :system)
+           (encapsulate ()
+            (local (xdoc-quiet)) ;; Suppress warnings when just using :xdoc (or :doc) 
+            (local (set-inhibit-warnings "Documentation"))
+            (import-acl2doc))
            (table xdoc 'colon-xdoc-support-loaded t))
         '(value-triple :invisible)))))
 
@@ -74,48 +62,44 @@
                ((mv & & state) (colon-xdoc-fn ',name all-xdoc-topics state)))
             (value '(value-triple :invisible))))))))
 
+; Hijack ACL2's :doc keyword and replace it with :xdoc
+
+(add-ld-keyword-alias! :doc '(1 xdoc))
+
 (defmacro save (dir &key
+                    (type ':fancy)
+                    (import 't)
+                    ;; Classic options (ignored for type :fancy)
                     (index-pkg 'acl2::foo)
-                    (expand-level '1)
-                    (import 't))
+                    (expand-level '1))
   `(progn
-     (include-book ,*xdoc-dir/defxdoc-raw* :ttags :all)
-     (include-book ,*xdoc-dir/mkdir-raw* :ttags :all)
-     (include-book ,*xdoc-dir/save*)
-
+     (include-book
+      "xdoc/defxdoc-raw" :dir :system :ttags :all)
+     (include-book
+      "oslib/mkdir" :dir :system)
+     (include-book
+      ,(if (eq type :fancy)
+           "xdoc/save-fancy"
+         "xdoc/save-classic")
+      :dir :system)
      ;; ugh, stupid stupid writes-ok stupidity
      (defttag :xdoc)
      (remove-untouchable acl2::writes-okp nil)
      ,@(and import
-            `((include-book ,*xdoc-dir/topics*)
-              (include-book ,*xdoc-dir/extra-packages*)
-              (import-acl2doc)
-              (maybe-import-bookdoc)))
+            `((include-book
+               "xdoc/topics" :dir :system)
+              (import-acl2doc)))
      ;; b* should have been included by the above includes
      (make-event
       (b* (((mv all-xdoc-topics state) (all-xdoc-topics state))
            (- (cw "(len all-xdoc-topics): ~x0~%" (len all-xdoc-topics)))
            ((mv & & state) (assign acl2::writes-okp t))
-           (state (save-topics all-xdoc-topics ,dir ',index-pkg ',expand-level state)))
+           (state
+            ,(if (eq type :fancy)
+                 `(save-fancy all-xdoc-topics ,dir state)
+               `(save-topics all-xdoc-topics ,dir ',index-pkg ',expand-level state))))
         (value '(value-triple :invisible))))))
 
-(defmacro xdoc-just-from-events (events)
-  `(encapsulate
-     ()
-     (local (include-book ,*xdoc-dir/topics*))
-     (local ,events)
-     (make-event
-      (mv-let (er val state)
-        (let ((state (acl2::f-put-global 'acl2::xdoc-alist nil state)))
-          (time$ (acl2::write-xdoc-alist :skip-topics xdoc::*acl2-ground-zero-names*)
-                 :msg "; Importing :doc topics took ~st sec, ~sa bytes~%"
-                 :mintime 1))
-        (declare (ignore er val))
-        (let ((topics (acl2::f-get-global 'acl2::xdoc-alist state)))
-          (prog2$
-           (cw "(len topics): ~x0~%" (len topics))
-           (value `(table xdoc 'doc ',topics))))))))
-
 (defmacro xdoc-extend (name long)
   ;; Extend an existing xdoc topic with more content.  Long is an xdoc
   ;; format string, e.g., "<p>blah blah @(def blah) blah.</p>" that will
diff -Nru acl2-6.2/books/xdoc/topics.lisp acl2-6.3/books/xdoc/topics.lisp
--- acl2-6.2/books/xdoc/topics.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/topics.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,986 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+
+; topics.lisp
+;
+; This is the actual xdoc documentation for the xdoc system.  We put the topics
+; here, instead of in top.lisp, in a probably silly effort to minimize the load
+; time of top.lisp.
+
+(in-package "XDOC")
+(include-book "import-acl2doc")  ;; For base acl2 documentation
+
+(defxdoc xdoc
+  :short "<i>XDOC</i> is a tool for documenting ACL2 books.  You can use it to
+access documentation about ACL2 and its books, to document your own books, and
+to create custom web-based manuals.  It is intended as a replacement for ACL2
+facilities like @(see defdoc), @(':doc'), and so on."
+
+  :long "<h3>Getting Documentation</h3>
+
+<p>Most of the documentation below is about using XDOC to document your own
+@(see acl2::books) and create manuals.  If you just want to browse the
+documentation, you probably don't need to read any of this!  Instead, see
+either:</p>
+
+<ul>
+
+<li><b>Online version.</b> If you expect to have an internet connection while
+using the documentation, you may be happy with the <a
+href='http://fv.centtech.com/acl2/latest/doc/'>online XDOC manual</a> hosted by
+<a href='http://www.centtech.com/'>Centaur Technology</a>.  This version covers
+the latest released version of ACL2 and the corresponding version of the <a
+href='http://code.google.com/p/acl2-books/'>ACL2 Community Books</a>.</li>
+
+<li><b>Local version.</b> If you sometimes work without an internet connection,
+or are using development snapshots of ACL2 and need up-to-date documentation,
+you can build a local version of the documentation.  You first need to build
+ACL2(h), then certify the @('centaur/doc') book as follows:
+
+@({
+  cd acl2-sources/books
+  make USE_QUICKLISP=1 centaur/doc.cert
+})
+
+After this is built, the manual should be available at:
+
+@({acl2-sources/books/centaur/manual/index.html})</li>
+
+</ul>
+
+<h3>Documenting your Books</h3>
+
+<p>To use XDOC to document your own books, the first step is:</p>
+
+@({
+ (include-book \"xdoc/top\" :dir :system)
+})
+
+<p>This book loads very quickly, requires no ttags, and provides a (nearly)
+complete interface to the XDOC system, including:</p>
+
+<ul>
+
+<li>@(see defxdoc) and @(see defsection), which are the basic commands for
+adding documentation &mdash; the XDOC alternatives to ACL2's @(see defdoc)
+command.</li>
+
+<li>The @(see save) command, which can be used to create web-based manuals for
+your libraries.</li>
+
+</ul>
+
+<p>The @('xdoc/top') book hijacks the @(':doc') command by installing a new
+<see topic='@(url ld-keyword-aliases)'>LD keyword alias</see>.  This way,
+you (and your users) can see both ordinary ACL2 documentation and XDOC
+documentation from the terminal by just using @(':doc'), without having to know
+which documentation system was used to document which topic.</p>
+
+<box><p><b><color rgb='#ff0000'>NEW</color></b> (experimental): When writing
+documentation, you can now automatically have XDOC topics displayed as you
+submit new @(see defxdoc) forms&mdash;just add:</p>
+
+@({
+ (include-book \"xdoc/debug\" :dir :system)
+})
+
+<p>to your @(see acl2::acl2-customization) file, or include it while you are
+developing your book.  Afterward, whenever you submit each @(see defxdoc) form,
+it will automatically be displayed in the terminal, showing you any markup
+problems and giving you a quick, text-mode preview.</p></box>")
+
+(local (set-default-parents xdoc))
+
+(defxdoc defxdoc
+  :short "Add documentation to the @(see xdoc) database."
+
+  :long "<box><p>Note: @('defxdoc') is very basic.  You will usually want to
+use @(see defsection) or @(see cutil::define) instead.</p></box>
+
+<p>@('Defxdoc') is the XDOC alternative to ACL2's built-in @('defdoc')
+command.</p>
+
+<p>General form:</p>
+
+@({
+ (defxdoc name
+   [:parents parents]
+   [:short   short]
+   [:long    long])
+})
+
+<p>Example:</p>
+
+@({
+ (defxdoc duplicity
+   :parents (std/lists defsort count no-duplicatesp)
+   :short \"@(call duplicity) counts how many times the
+            element @('a') occurs within the string @('x').\"
+   :long \"<p>This function is similar to ACL2's built-in
+          @('count') function but is more limited:</p>  ...\")
+})
+
+<p>The @('name') of each documentation topic must be a symbol.  All of the
+keyword arguments are optional:</p>
+
+<ul>
+
+<li>@('parents') let you associate this documentation with other topics.  A
+topic may have many parents, but circular chains of parents are not allowed and
+will lead to errors when generating manuals.  If no @(':parents') are given
+explicitly, the <see topic='@(url set-default-parents)'>default parents</see>
+will be used.</li>
+
+<li>@('short') should be a short description of this topic that is suitable for
+inlining in other pages.  For instance, it may be displayed in subtopic listing
+and in \"hover\" text on navigation pages.</li>
+
+<li>@('long') should be the full, detailed documentation for this topic.</li>
+
+</ul>
+
+<p>The @('short') and @('long') strings may be written using the XDOC @(see
+markup) language, and may also use @(see preprocessor) commands to insert
+function definitions, theorems, topic links, and so on.</p>
+
+<p>Many examples of using XDOC can be found throughout the ACL2 books.  See for
+instance the @(see acl2::std), @(see acl2::str) or @(see acl2::osets)
+libraries.</p>
+
+<h3>Note for Advanced Users</h3>
+
+<p>XDOC just stores its documentation in an ordinary ACL2 table, so if you want
+to do something like automatically generate documentation from macros, you
+might decide to bypass @('defxdoc') and just manipulate the table directly.</p>
+
+<p>It is not possible to directly use @('defxdoc') from raw Lisp, but you can
+use @(see defxdoc-raw) instead.</p>")
+
+
+(defxdoc markup
+  :short "The <a href='http://en.wikipedia.org/wiki/Xml'>XML</a> markup
+language that is the basis of XDOC documentation strings."
+
+  :long "<p>XDOC uses an XML markup language that is similar to a subset of <a
+href='http://en.wikipedia.org/wiki/HTML'>HTML</a>.  Note that in XML, beginning
+and ending tags really need to be balanced.</p>
+
+<h3>Formatting Text</h3>
+
+<p>Various tags allow you to control the font:</p>
+<ul>
+ <li><b>&lt;b&gt;bold&lt;/b&gt;</b></li>
+ <li><i>&lt;i&gt;italics&lt;/i&gt;</i></li>
+ <li><u>&lt;u&gt;underline&lt;/u&gt;</u></li>
+ <li><tt>&lt;tt&gt;typewriter text&lt;/tt&gt;</tt></li>
+ <li><color rgb=\"#ff0000\">&lt;color rgb=&quot;#ff0000&quot;&gt;colored text&lt;/color&gt;</color></li>
+ <li><sf>&lt;sf&gt;sans-serif&lt;/sf&gt;</sf></li>
+</ul>
+
+<h3>Displaying Source Code</h3>
+
+<p>The @(see preprocessor) allows you to insert function definitions, theorems,
+etc., from the ACL2 world.  This can help you avoid having to copy and paste
+definitions into your documentation, which can help to keep your documentation
+up to date.</p>
+
+<p>But sometimes you want to write other kinds of code fragments as examples.
+The raw markup options are:</p>
+
+<ul>
+
+<li>Use the @('<tt>') tag for short, inline pieces of code, such as <tt>(+ 1
+x)</tt>.</li>
+
+<li>Use the @('<code>') tag for longer code examples that should be indented
+and \"preformatted,\" i.e., newlines and spaces should be preserved.</li>
+
+</ul>
+
+<p><b>However</b>, it's often better to use the preprocessor's
+<tt>@@('...')</tt> and <tt>@@({...})</tt> macros, respectively.  These are nice
+because they automatically escape special HTML characters like &lt; into
+&amp;lt;, and also automatically add hyperlinks to documented functions.</p>
+
+<p>Whenever you include Lisp code fragments in your documentation, you should
+usually keep everything <b>indented one space</b> to prevent Emacs problems.
+For instance:</p>
+
+@({
+|(defxdoc foo
+|  :long \"<h3>How to format @('<code>') blocks</h3>
+|
+|<p>GOOD -- the form is indented one space:</p>
+|<code>
+| (my-lisp-form (foo ...)
+|               (bar ...))
+|</code>
+|
+|<p>BAD -- the form is directly on the left-margin:</p>
+|<code>
+|(my-lisp-form (foo ...)
+|              (bar ...))
+|</code>
+})
+
+<p>Without this leading space, Emacs can become confused and think that
+@('(my-lisp-form ...)'), rather than @('(defxdoc foo ...)'), is the top-level
+expression.  This can ruin syntax highlighting and also commands like @('C-t
+e') for sending s-expressions to the @('*shell*') window.</p>
+
+
+
+
+<h3>Hyperlinks</h3>
+
+<p><i>Internal links</i> between documentation topics and <i>Emacs
+tags-search links</i> into the source code are handled by the @(see
+preprocessor).</p>
+
+<p>You can add <i>external links</i> to web pages with ordinary HTML-style
+links, e.g.,</p>
+
+@({
+<a href=\"http://www.centtech.com/\">Centaur Technology</a>
+})
+
+<p>Produces a link to <a href=\"http://www.centtech.com/\">Centaur
+Technology</a>.</p>
+
+
+<h3>Structuring Documents</h3>
+
+<p>For section headings,</p>
+<ul>
+ <li>@('<h1>') creates the biggest heading:<h1>H1 Example</h1></li>
+ <li>@('<h2>') the next biggest:<h2>H2 Example</h2></li>
+ <li>@('<h3>') a medium-sized heading:<h3>H3 Example</h3></li>
+ <li>@('<h4>') the second smallest:<h4>H4 Example</h4></li>
+ <li>@('<h5>') the smallest heading:<h5>H5 Example</h5></li>
+</ul>
+
+<p>@('<p>') tags should be put around paragraphs.</p>
+
+<blockquote>@('<blockquote>') can be used to create indented paragraphs like
+this one.  (Let's put enough text here to make it word-wrap.  Mumble mumble
+mumble.  Mumble.  Mumble mumble.)</blockquote>
+
+<p>@('<br/>') can be used<br/>
+to write haikus and so on<br/>
+but is discouraged</p>
+
+<p>Bulleted and numbered lists work as in HTML.  The list itself begins with
+@('<ul>') (for bulleted lists) or @('<ol>') (for numbered lists).  Each list
+element is an @('<li>') tag.  For instance,</p>
+
+@({
+<ul>
+  <li>one</li>
+  <li>two</li>
+  <li>three</li>
+</ul>
+})
+
+<p>Produces:</p>
+
+<box>
+<ul>
+  <li>one</li>
+  <li>two</li>
+  <li>three</li>
+</ul>
+</box>
+
+<p>You can also use definition lists, which are comprised of @('<dl>'),
+@('<dt>'), and @('<dd>') tags.  For instance,</p>
+
+@({
+<dl>
+  <dt>Inputs</dt>
+  <dd><tt>x</tt>, the list we are traversing</dd>
+  <dd><tt>max</tt>, limit on how many we can accumulate</dd>
+  <dd><tt>acc</tt>, accumulator for our results</dd>
+</dl>
+})
+
+<p>Produces:</p>
+
+<box>
+<dl>
+  <dt>Inputs</dt>
+  <dd><tt>x</tt>, the list we are traversing</dd>
+  <dd><tt>max</tt>, limit on how many we can accumulate</dd>
+  <dd><tt>acc</tt>, accumulator for our results</dd>
+</dl>
+</box>
+
+<p>These framed boxes are generated with the @('<box>') tag.</p>
+
+<p>It's relatively easy to add new tags.  We'll probably add some kind of image
+support in the future, and maybe other tags that users want.</p>")
+
+
+(defxdoc preprocessor
+  :short "In addition to its @(see markup) language, XDOC includes a
+preprocessor which can be used to interpret certain directives of the form
+@('@(...)')."
+
+  :long "<h3>Functions and Theorems</h3>
+
+<p>To look up function definitions (or pieces of definitions) from the ACL2
+world and insert them into your documentation, you can use:</p>
+
+<ul>
+ <li>@('@(def fn)'), insert the definition of <i>fn</i><br/>
+     (also works for theorems, macros, ...)</li>
+ <li>@('@(body fn)'), just the body of <i>fn</i></li>
+ <li>@('@(formals fn)'), just the formals of <i>fn</i></li>
+ <li>@('@(measure fn)'), just the measure of <i>fn</i></li>
+ <li>@('@(call fn)'), a generic function call of <i>fn</i></li>
+</ul>
+
+<p>We expect that @('def') and @('body') directives will expand to large code
+fragments, so they are automatically wrapped in @('<code>') blocks.</p>
+
+<p>The @('call') directive is automatically wrapped in @('<tt>') tags, i.e.,
+@('@(call fib)') might become @('<tt>(fib x)</tt>').  An alternative is to use
+@('@(ccall fib)'), for \"code call,\" which inserts @('<code>') tags instead;
+this could be more appropriate for functions with many arguments.</p>
+
+<p>The other directives just become plain text, and you can wrap whatever
+formatting commands you like around them and use them inline in paragraphs,
+etc.</p>
+
+<h3>Adding Examples or Code Fragments</h3>
+
+<p>There's a special syntax to put in \"raw\" text.  This is especially
+useful for examples and code fragments.</p>
+
+<ul>
+<li><tt>@@('...')</tt> inserts @('...') into @('<tt>') tags.</li>
+<li><tt>@@({...})</tt> inserts @('...') into @('<code>') tags.</li>
+</ul>
+
+<p>These have a special feature for automatically linking to documented topics.
+For instance, <tt>@@('consp x')</tt> produces @('(consp x)'), and
+<tt>@@({ (consp x) })</tt> produces:</p>
+
+@({
+ (consp x)
+})
+
+
+<h3>Documentation Links</h3>
+
+<p>The easiest way to link between topics is to use @('@(see name)'), which
+expands into a link to @('name').  The text shown to the reader is just the
+name of the topic, in lower case.  Note also that @('@(csee name)') can be used
+for links whose first letter should be capitalized.</p>
+
+<p>For most purposes, @('@(see name)') is adequate and it is also recommended.
+Finer-grained control (e.g., changing the link text) is also possible, but then
+you have to understand how file names get mangled.  The basic story is that
+@('@(see name)') expands to:</p>
+
+@({
+<see topic=\"mangled-topic-name\">printed-topic-name</see>
+})
+
+<p>Where:</p>
+
+<ul>
+
+<li>@('mangled-topic-name') is a canonical, url/file-name friendly,
+human-hostile mangling of @('name')'s package and symbol names, and</li>
+
+<li>@('printed-topic-name') is an XML-escaped variant of @('name'), e.g., where
+@('<') becomes @('&lt;'), etc.; depending on the package of the current topic's
+name, it may or may not include the package portion of @('name').</li>
+
+</ul>
+
+<p>So, to support custom links, we provide</p>
+
+<ul>
+ <li>@('@(url name)'), which expands to @('mangled-topic-name')</li>
+ <li>@('@(sym name)'), which expands to @('printed-topic-name')</li>
+ <li>@('@(csym name)'), like @('sym'), but with the first letter capitalized</li>
+</ul>
+
+<p>You can use these to write your own @('<see>') tags.  You should probably
+<i>never</i> write a @('<see>') tag yourself without using @('@(url ...)').</p>
+
+
+<h3>Emacs Links</h3>
+
+<p>The @('@(srclink name)') directive inserts a source-code link for users who
+have configured their web browser as described in @(see emacs-links).</p>
+
+<p>It is often unnecessary to use @('srclink') directly, because these links
+are automatically inserted by @('@(def fn)').  One good reason to use
+@('srclink') is to link to macros like @(srclink defxdoc), which often are
+written using backquote and hence do not display nicely.</p>
+
+<p>Source links are sometimes inappropriate, e.g., for definitions or theorems
+that are generated by macros.  You can suppress the automatic source links on
+@('def') commands by using @('@(gdef fn)') instead.  This stands for
+\"generated definition.\"</p>
+
+
+<h3>Escaping of @</h3>
+
+<p>Since @('@(') is intercepted by the preprocessor, you may occasionally need
+to escape it.  You can write @('@@') to generate a single @('@') sign.</p>
+
+<p>Besides @('@(') and @('@@'), the preprocessor leaves any other uses of
+@('@') in tact.  So, most uses of @('@'), such as in email addresses, do not
+need to be escaped.</p>")
+
+
+(defxdoc save
+  :short "Saves the XDOC database into files for web browsers, etc."
+
+  :long "<p>Once you have documented your library with @(see defxdoc), you may
+wish to create a manual that can be viewed from a web browser.</p>
+
+<h3>Saving a Manual</h3>
+
+<p>The @('xdoc::save') command allows you to export all currently-loaded
+documented topics from ACL2.  Here's a basic example:</p>
+
+@({
+ ;; get documentation loaded
+ (include-book \"my-library1\")
+ (include-book \"my-library2\")
+ ;; save the manual
+ (xdoc::save \"/home/jared/mylib-manual\")
+})
+
+<p>The only required argument is the name of a directory where the
+documentation should be saved.  If the directory does not exist, it will be
+created.  If there are files in the directory, they <color rgb=\"#ff0000\">may
+be overwritten</color>.</p>
+
+<h3>Types of Manuals</h3>
+
+<p>XDOC can actually generate two kinds of manuals.</p>
+
+<ul>
+<li>By default, a @(see fancy-manual) is produced.</li>
+
+<li>Alternately, you can create a @(see classic-manual) by using
+@(':type :classic') in your save command.</li> </ul>")
+
+
+(defxdoc classic-manual
+  :parents (save)
+  :short "Structure of a @(':type :classic') manual."
+
+  :long "<p>If you run @(see save) with @(':type :classic'), it will write out
+a manual in the \"classic\" format.  In this case, the resulting manual
+directory will include:</p>
+
+<ul>
+
+<li>@('xml/'), a subdirectory with a @('.xml') file for each topic and some
+supporting files, and</li>
+
+<li>@('Makefile'), a Makefile for converting these files into other formats,
+and</li>
+
+<li>@('preview.html'), a web page that lets you directly view the XML files
+using your web browser.</li>
+
+</ul>
+
+<p>Many web browsers can directly display XML files, so you may be able to view
+@('preview.html') without any additional steps.</p>
+
+
+<h3>HTML and Other Formats</h3>
+
+<p>You can generate a plain HTML or TEXT version of your manual by using
+@('make html') or @('make text') from within the directory target of the above
+mentioned @('xdoc::save') command (in this example, the @('mylib-manual')
+directory).  We might add support for TEXINFO or other formats in the
+future.</p>
+
+<p>After running @('make html'), you may wish to open @('frames2.html') and
+@('frames3.html'), which allow you to navigate the HTML manual much like
+@('preview.html') allows you to navigate the XML version.  These pages accept
+an optional argument named <tt>topic</tt> that tells the browser to
+automatically go to a particular topic.  For example, one can go to the
+<tt>XDOC::save</tt> topic by using the url
+<tt>frames3.html?topic=XDOC____SAVE.html</tt>.</p>
+
+<p>Converting to HTML is a good idea because it ensures that all of your tags
+are balanced on every page.  Without this sanity check, your manual might
+contain errors that will prevent some topics from being loaded in a web
+browser.</p>
+
+<p>Creating the HTML code requires Xalan-C++.  Xalan is distributed with many
+Linux distributions.  For example, on Ubuntu, one can run <tt>sudo apt-get
+install xalan</tt> to install it.  Alternatively, see <a
+href=\"http://xml.apache.org/xalan-c/\">Apache Xalan</a> to download.  We have
+accomodated the various versions of Xalan that we know about and use, but we
+welcome modifications to file <tt>support/Makefile-trans</tt> if you wish to
+use a version we do not currently support.</p>")
+
+
+(defxdoc fancy-manual
+  :parents (save)
+  :short "Structure of a @(':type :fancy') manual."
+
+  :long "<p>By default, @(see save) will create a manual in the new, \"fancy\"
+format, which extensively uses JavaScript to provide rich documentation with
+dynamic navigation, quick jump-to links, and so forth.</p>
+
+<p>In many ways, a fancy manual is simpler than a @(see classic-manual).
+Instead of generating thousands of files ahead of time, we basically just write
+the XDOC database out into JSON format and then use JavaScript to do all of the
+layout and organization.</p>")
+
+
+(defxdoc emacs-links
+  :short "Instructions for integrating XDOC web pages with <a
+  href='http://www.gnu.org/software/emacs/'>Emacs</a>."
+
+  :long "<p>@(csee preprocessor) directives such as @('@(def get-xdoc-table)')
+result in the introduction of special links for Emacs.  Here's what these links
+look like:</p>
+
+@(def get-xdoc-table)
+
+<p>Depending on your environment, it <b>may</b> be easy to configure your web
+browser so that clicking on these links will cause Emacs to directly open up
+the appropriate source file and jump to the named function.</p>
+
+<p>The basic idea is:</p>
+
+<ul>
+
+<li>Each Emacs link generates a <a
+href='https://en.wikipedia.org/wiki/Data_URI_scheme'>Data URIs</a> that tells
+your web browser to download a new, generated file whose <a
+href='https://en.wikipedia.org/wiki/Internet_media_type'>MIME type</a> is
+@('application/x-acl2-xdoc-link').</li>
+
+<li>You configure your web browser to send @('application/x-acl2-xdoc-link')
+files to Emacs.</li>
+
+<li>You configure your Emacs to carry out a tags search instead of loading
+these files.</li>
+
+</ul>
+
+<p>The net effect is that clicking on these links will send you directly to the
+desired function in the source code.  This is <b>really slick</b> if you can
+get it working.</p>
+
+
+<h2>Configuring Emacs</h2>
+
+<h4>Loading the XDOC Elisp</h4>
+
+<p>The XDOC directory includes a file called @('xdoc.el'), which tells emacs
+what to do with these xdoc-link files.  To tell emacs to load this file at
+startup, you can just add a command to your @('.emacs') file like:</p>
+
+@({
+ (load \"/path/to/acl2/books/xdoc/xdoc.el\")
+})
+
+
+<h4>Managing your TAGS tables</h4>
+
+<p>For emacs to make sense of the links you follow, it will need to have the
+appropriate <a
+href=\"http://www.gnu.org/software/emacs/manual/html_node/emacs/Tags.html\">tags
+tables</a> loaded for all of the libraries you are using.</p>
+
+<p>If you aren't familiar with tags, you basically just need to:</p>
+
+<ul>
+
+<li>Occasionally generate @('TAGS') files for your libraries, using the command
+@('etags *.lisp') or similar.</li>
+
+<li>Tell Emacs to \"visit\" these tags tables with @('visit-tags-table').</li>
+
+</ul>
+
+<h5>Jared's Approach:</h5>
+
+<ul>
+
+<li>I add a @('TAGS') target to my Makefiles, so that when I build my library
+the @('etags *.lisp') command is re-run and the @('TAGS') file is kept up to
+date.  The Makefile syntax is:
+
+@({
+TAGS: $(wildcard *.lisp)
+      etags *.lisp
+})</li>
+
+<li>Then, in my @('.emacs') file, I have a series of commands like the
+following:
+
+@({
+ (ignore-errors (visit-tags-table \"/path/to/acl2/TAGS\"))
+ (ignore-errors (visit-tags-table \"/path/to/acl2/books/xdoc/TAGS\"))
+ (ignore-errors (visit-tags-table \"/path/to/my/stuff/TAGS\"))
+})
+
+This ensures that the relevant @('TAGS') files are loaded every time I start
+Emacs.  The use of @('ignore-errors') prevents Emacs from complaining if one of
+these @('TAGS') files was deleted in a \"make clean\" or similar.</li>
+
+<li>One final addition to the @('.emacs') file is:
+
+@({
+ (setq tags-revert-without-query t)
+})
+
+which tells Emacs to go ahead and reload these files when they are rebuilt by
+Make, instead of prompting you if you want to reload them.</li>
+
+</ul>
+
+
+<h4>Setting up Emacsclient (recommended)</h4>
+
+<p>You can set things up so that links open up in <b>new instances</b> of
+Emacs, or in <b>new buffers</b> of an already-running Emacs.</p>
+
+<p>If you want everything to open up in a new instance of Emacs, you can skip
+this section.  But I prefer to use a single Emacs for everything, and just have
+links open up in new buffers.</p>
+
+<p>This is quite easy.  First, add @('(server-start)') to your @('.emacs') file
+and restart Emacs.</p>
+
+<p>Next, to ensure everything is working properly, launch a separate terminal
+and type:</p>
+
+@({
+emacsclient --no-wait my-file
+})
+
+<p>If all is well, @('my-file') will be loaded into your already-running emacs
+as a new buffer.</p>
+
+
+
+<h2>Configuring the Web Browser</h2>
+
+<p>The last thing we need to do is instruct your web browser to send xdoc-link
+files to Emacs.</p>
+
+<p>How to do this depends on your web browser and/or operating system.  In some
+cases it may be hard to pass command-line options to emacs directly, so you may
+find it useful to use the script @('emacsclient-wrapper.sh'), found in the xdoc
+directory.</p>
+
+<p>The basic starting point is probably to try to click on an emacs link like
+@(srclink append) and try to tell your browser to open it with the
+@('emacsclient-wrapper.sh') script.  If your browser opens it with some other
+program, you might need to edit the default file associations of your operating
+system or window manager.</p>")
+
+
+(defxdoc go.xdoc-link
+  :parents (emacs-links)
+  :short "Trivial web service provided by @('fv.centtech.com') for resolving
+@(see emacs-links)."
+
+  :long "<p>Historically, @(see emacs-links) were implemented by writing out a
+separate @('xdoc-link') file for every tags-search that we wanted to support.
+To avoid writing out these thousands of files, we now just implement a simple
+web service at @('fv.centtech.com').</p>
+
+<p>The basic idea is that if you just go to:</p>
+
+@('http://fv.centtech.com/cgi-bin/go.xdoc-link?name=append')
+
+<p>Then it will generate an appropriate @('.xdoc-link') file that is flagged
+with the right mime-type.</p>
+
+<p>If you prefer to use your own web server, you can recreate this service by
+putting the following, trivial script into your cgi-bin:</p>
+
+@({
+    #!/usr/bin/perl
+
+    use warnings;
+    use strict;
+    use CGI qw(:standard);
+
+    my $name = param(\"name\") || \"APPEND\";
+
+    $| = 1;
+
+    print <<END;
+    Content-Type: application/x-acl2-xdoc-link .xdoc-link
+
+    ; This is an XDOC Link file.
+    ; Ordinarily, you should not see this file.
+    ;
+    ; If you are viewing this file in a web browser, you probably
+    ; have not configured your web browser to send .xdoc-link files
+    ; to Emacs.
+    ;
+    ; If you are viewing this file in Emacs, you probably have not
+    ; loaded xdoc.el from the xdoc/ directory.
+    ;
+    ; Please see the XDOC manual for more information.
+
+    $name
+
+    END
+})")
+
+
+
+(defxdoc extract-keyword-from-args
+  :parents (defsection) ; bozo hrmn, where should this go, really?
+  :short "Get the value for a keyword argument like @(':foo value')."
+
+  :long "<p>@(call extract-keyword-from-args) is given @('kwd'), which should
+be a keyword symbol, and a list of @('args') which are typically the @('&rest
+args') given to a macro.  It scans the list of @('args'), looking for the
+indicated keyword, and returns @('(kwd . value)'), or @('nil') if no such
+keyword is found.  For instance,</p>
+
+@({
+ (extract-keyword-from-args :bar '(:foo 3 :bar 5 :baz 7))
+   -->
+ (:bar . 5)
+})
+
+<p>This function is mainly useful for writing macros that mix @('&rest') parts
+with keyword arguments.  See also @(see throw-away-keyword-parts).</p>
+
+@(def extract-keyword-from-args)")
+
+
+(defxdoc throw-away-keyword-parts
+  :parents (defsection) ; bozo hrmn, where should this go, really?
+  :short "Throw away any keyword arguments and their values from a macro
+argument list."
+
+  :long "<p>@(call throw-away-keyword-parts) is given a list of arguments that
+are typically the @('&rest args') given to a macro.  It scans the arguments for
+any keyword symbols such as @(':foo'), and throws away both the keyword and the
+argument that follows it.  For instance,</p>
+
+@({
+ (throw-away-keyword-parts '(x y z :foo 3 :bar 5 blah blah blah))
+   -->
+ '(x y z blah blah blah)
+})
+
+<p>This function is mainly useful for writing macros that mix @('&rest') parts
+with keyword arguments.  See also @(see extract-keyword-from-args).</p>
+
+@(def throw-away-keyword-parts)")
+
+
+(defxdoc defsection
+  :short "Fancy @('(encapsulate nil ...)') with a name and @(see xdoc)
+support."
+
+  :long "<p>The main reasons to use @('defsection') instead of @('(encapsulate
+nil ...)')</p>
+
+<ul>
+ <li>It is easier to identify in the @(':pbt') history,</li>
+ <li>It indents more nicely than @('encapsulate') in a vanilla emacs,</li>
+ <li>It settles the question of where to put the @(see defxdoc) command, and</li>
+ <li>It can automatically add the definitions/theorems you supply into the
+     documentation for your section.</li>
+</ul>
+
+<p>General form:</p>
+
+@({
+ (defsection name
+    [:parents   parents]
+    [:short     short]
+    [:long      long]
+    [:autodoc   autodoc]
+    [:extension topic]
+    ... events ...)
+})
+
+<p>Example:</p>
+
+@({
+ (defsection foo
+   :parents (parent1 parent2 ...)
+   :short \"@(call foo) is like @(see bar), but better when...\"
+   :long \"<p>The main differences between @('foo') and @('bar') are ...</p>\"
+
+   (defund foo (x) ...)
+   (local (in-theory (enable foo)))
+   (defthm foo-thm1 ...)
+   (defthm foo-thm2 ...))
+})
+
+<box><p>Note: this example might be better written as a @(see cutil::define),
+which is much like a @('defsection') but has additional features.</p></box>
+
+
+<h3>Ordinary Sections</h3>
+
+<p>The @(':parents'), @(':short'), and @(':long') keywords are optional.  If
+any of these keywords are provided, they will be used to introduce a @(see
+defxdoc) command; otherwise no documentation will be generated.</p>
+
+<p>By default, the @(':long') string you give will be automatically extended
+with a \"Definitions and Theorems\" part that lists all the (non-local)
+definitions and theorems introduced in the section.  This makes it easy to keep
+the documentation up-to-date as you add and remove theorems to the section.  In
+the above example, the @(':long') field would be extended with:</p>
+
+@({
+ <h3>Definition and Theorems</h3>
+ @(def foo)
+ @(thm foo-thm1)
+ @(thm foo-thm2)
+})
+
+<p>If you do not want this automatic documentation, you can turn it off with
+@(':autodoc nil').</p>
+
+
+<h3>Extended Sections</h3>
+
+<p>The @(':extension') keyword allows you to say that this section is a
+continuation of a previously introduced concept.  When @(':extension topic') is
+provided, then @('topic') must be the name of a previously documented @(see
+xdoc) section, and you are not allowed to use @(':parents') or @(':short')
+since the topic already exists.</p>
+
+<p>The main purpose of an @(':extension') section is to add additional
+documentation, either via the @(':long') string or via the automatic
+documentation generation features of @('defsection').  The documentation
+obtained this way is just appended onto the existing @(':long') for the
+topic.</p>
+
+<p>For example, if we have already given the section @('foo') with basic
+theorems, above we now want to add a bunch of additional \"advanced\" theorems
+about it, we might write something like this:</p>
+
+@({
+ (defsection advanced-theorems-about-foo
+   :extension foo
+   (defthm foo-thm3 ...)
+   (defthm foo-thm4 ...))
+})
+
+<p>This will then append the definitions of @('foo-thm3') and @('foo-thm4')
+onto the end of the documentation for @('foo').</p>")
+
+
+(defxdoc defsection-progn
+  :short "Fancy @('(progn ...)') with a name and @(see xdoc) support."
+
+  :long "<p>The @('defsection-progn') macro is like @(see defsection) except
+that it generates @({(progn ...)}) instead of an @({(encapsulate nil ...)})</p>
+
+<p>This has a number of consequences, mostly having to do with the scope of
+@('local') events within the section.  In short, a @('defsection-progn') does
+not introduce a new local scope, but a @('defsection') does.</p>")
+
+
+(defxdoc undocumented
+  :short "Placeholder for undocumented topics.")
+
+
+(defxdoc test-of-entities
+  :short "Placeholder topic for testing out HTML entity support in XDOC."
+  :long "<p>Here are the entities that XDOC allows:</p>
+
+<p>Normal XML entities:</p>
+<ul>
+<li>@('&amp;')   becomes &amp;</li>
+<li>@('&lt;')    becomes &lt;</li>
+<li>@('&gt;')    becomes &gt;</li>
+<li>@('&quot;')  becomes &quot;</li>
+<li>@('&apos;')  becomes &apos;</li>
+</ul>
+
+<p>Additional entities allowed by XDOC:</p>
+<ul>
+<li>@('&nbsp;')  becomes &nbsp; (this one can be hard to see)</li>
+<li>@('&mdash;') becomes &mdash;</li>
+<li>@('&rarr;')  becomes &rarr;</li>
+</ul>")
+
+
+
+(defxdoc set-default-parents
+  :short "Set up default parents to use for @(see xdoc)."
+
+  :long "<p>When documenting a book of inter-related functions, you may
+sometimes wish to use the same @(':parents') across many @(see defxdoc) or
+@(see defsection) commands.  This can sometimes get tedious.</p>
+
+<p>The macro @(call set-default-parents) can be used to set up a default list
+of parent topics to be automatically used by commands such as @(see defxdoc)
+and @(see defsection).</p>
+
+<p>Basic Example:</p>
+
+@({
+   (local (set-default-parents fox-p))
+
+   (defxdoc make-fox           ;; use default :parents, (fox-p)
+     :short ...
+     :long ...)
+
+   (defsection feed-fox        ;; use default :parents, (fox-p)
+     :short ...
+     :long ...)
+
+   (defsection chase-mouse     ;; use explicit :parents, (fox-p mouse-p)
+     :parents (fox-p mouse-p)
+     :short ...
+     :long ...)
+
+   (local (set-default-parents fox-p hawk-p))
+
+   (defsection bother-hawk     ;; use default :parents, (fox-p hawk-p)
+     :short ...
+     :long ...)
+
+   (local (set-default-parents nil))
+
+   (defxdoc zebra-p            ;; use default :parents, nil
+     :short ...
+     :long ...)
+})
+
+<p>Note that @('set-default-parents') is just a macro that expands to a @(see
+table) event.  It's good practice to only <b>locally</b> set the default
+parents&mdash;otherwise the default parents can \"leak\" from your book and
+lead you to inadvertently set the parents of other, unrelated topics.</p>")
+
diff -Nru acl2-6.2/books/xdoc/word-wrap.lisp acl2-6.3/books/xdoc/word-wrap.lisp
--- acl2-6.2/books/xdoc/word-wrap.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/word-wrap.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,94 @@
+; XDOC Documentation System for ACL2
+; Copyright (C) 2009-2011 Centaur Technology
+;
+; Contact:
+;   Centaur Technology Formal Verification Group
+;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
+;   http://www.centtech.com/
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free Software
+; Foundation; either version 2 of the License, or (at your option) any later
+; version.  This program is distributed in the hope that it will be useful but
+; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+; more details.  You should have received a copy of the GNU General Public
+; License along with this program; if not, write to the Free Software
+; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
+;
+; Original author: Jared Davis <jared@centtech.com>
+
+(in-package "XDOC")
+(include-book "tools/bstar" :dir :system)
+(include-book "str/defs" :dir :system)
+(program)
+
+
+; NORMALIZE-WHITESPACE canonicalizes whitespace so that any adjacent whitespace
+; characters are merged into a single space.
+
+(defun normalize-whitespace-aux (x n xl acc)
+  (b* (((when (>= n xl))
+        acc)
+       (char-n (char x n))
+       ((when (member char-n '(#\Space #\Tab #\Page #\Newline)))
+        (normalize-whitespace-aux
+         x (+ n 1) xl
+         (if (and (< (+ n 1) xl)
+                  (member (char x (+ n 1)) '(#\Space #\Tab #\Page #\Newline)))
+             acc
+           (cons #\Space acc)))))
+    (normalize-whitespace-aux x (+ n 1) xl (cons char-n acc))))
+
+(defun normalize-whitespace (x)
+  (declare (type string x))
+  (str::rchars-to-string (normalize-whitespace-aux x 0 (length x) nil)))
+
+
+; (WORD-WRAP-PARAGRAPH X INDENT WRAP-COL) reformats the string X, trying to
+; word wrap to WRAP-COL and indenting each subsequent line to INDENT.  We
+; assume that indent-many characters have already been printed, so the first
+; line is not indented.
+
+(defun add-word-to-paragraph (x n xl col acc)
+  "Returns (MV N COL ACC)"
+  (b* (((when (>= n xl))
+        (mv n col acc))
+       (char-n (char x n))
+       ((when (eql char-n #\Space))
+        (mv n col acc)))
+    (add-word-to-paragraph x (+ n 1) xl (+ 1 col) (cons char-n acc))))
+
+(defun remove-spaces-from-front (x)
+  (if (atom x)
+      x
+    (if (eql (car x) #\Space)
+        (remove-spaces-from-front (cdr x))
+      x)))
+
+(defun word-wrap-paragraph-aux (x n xl col wrap-col indent acc)
+  (b* (((when (>= n xl))
+        acc)
+       (char-n (char x n))
+       ((when (eql char-n #\Space))
+        (word-wrap-paragraph-aux x (+ n 1) xl (+ col 1)
+                                 wrap-col indent (cons char-n acc)))
+       ((mv spec-n spec-col spec-acc)
+        (add-word-to-paragraph x n xl col acc))
+       ((when (or (< spec-col wrap-col)
+                  (= col indent)))
+        ;; Either (1) it fits, or (2) we can't get any more space by moving to
+        ;; the next line anyway, so accept this speculative addition.
+        (word-wrap-paragraph-aux x spec-n xl spec-col wrap-col indent spec-acc))
+       ;; Else, try again, starting on the next line.
+       (acc (remove-spaces-from-front acc)) ;; deletes trailing spaces on this line
+       (acc (cons #\Newline acc))
+       (acc (append (make-list indent :initial-element #\Space) acc)))
+    (word-wrap-paragraph-aux x n xl indent wrap-col indent acc)))
+
+(defun word-wrap-paragraph (x indent wrap-col)
+  (let* ((acc (word-wrap-paragraph-aux x 0 (length x) 0 wrap-col indent nil))
+         (acc (remove-spaces-from-front acc))
+         (acc (reverse acc))
+         (acc (remove-spaces-from-front acc)))
+    (str::implode acc)))
diff -Nru acl2-6.2/books/xdoc/write-acl2-xdoc.lisp acl2-6.3/books/xdoc/write-acl2-xdoc.lisp
--- acl2-6.2/books/xdoc/write-acl2-xdoc.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/books/xdoc/write-acl2-xdoc.lisp	2013-09-30 17:52:15.000000000 +0000
@@ -0,0 +1,299 @@
+; Conversion from ACL2 :DOC into XDOC Format
+; Copyright (C) 2011  University of Texas at Austin
+
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of Version 2 of the GNU General Public License as published by the
+; Free Software Foundation.
+
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+; GNU General Public License for more details.
+
+; You should have received a copy of the GNU General Public License
+; along with this program; if not, write to the Free Software
+; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+; Written by:  Matt Kaufmann               and J Strother Moore
+; email:       Kaufmann@cs.utexas.edu      and Moore@cs.utexas.edu
+; Department of Computer Science
+; University of Texas at Austin
+; Austin, TX 78701 U.S.A.
+
+; This file is based on doc/write-acl2-html.lisp, and serves to produce an xdoc
+; list (see books/xdoc/top.lisp) from (global-val 'documentation-alist (w
+; state)).  Thanks to Jared Davis for his assistance in developing this file.
+
+(in-package "ACL2-USER")
+
+(acl2::set-state-ok t)
+
+(acl2::program)
+
+; The idea of node names:  first apply the character substitution table, then
+; deal with the colon.
+
+(defconst *xdoc-doc-char-subst-table*
+  '((#\& #\& #\a #\m #\p #\;)
+    (#\< #\& #\l #\t #\;)
+    (#\> #\& #\g #\t #\;)
+    (#\@ #\@ #\@))
+  "Table with entries (char . char-list) for substituting characters.")
+
+(defconst *xdoc-doc-markup-table*
+  '(("-" nil .    "&mdash;")
+    ("B" nil .  "<b>~st</b>")
+    ("BF" nil .  "~%<code>")
+    ("BID" nil .    "")      ;begin implementation dependent
+    ("BPAR" nil .  "<p>")
+
+; XDOC question: Is <blockquote> supported?  I generate it just below.
+
+; A: it isn't supported, but I'll add support for it.
+
+    ("BQ" nil .  "</p>~%<blockquote><p>")
+    ("BV" nil .  "~%<code>")
+    ("C" nil .  "<tt>~st</tt>")
+    ("EF" nil .  "</code>~%")
+    ("EID" nil .    "")      ;end implementation dependent
+    ("EM" nil .  "<i>~st</i>") ;emphasis
+    ("EPAR" nil .  "</p>")
+    ("EQ" nil .  "</p></blockquote>~%<p>")
+    ("EV" nil .  "</code>~%")
+
+; XDOC question: Is <img> supported?  I generate it just below, but I'm not
+; sure I do it right.
+
+; A: hrmn.  not supported right now.  I'm just going to put in [image] until
+; I add support for it.
+
+    ("GIF" nil . "<img src='~st' />") ;gif files; e.g., ~gif[\"foo.gif\" align=top]
+;    ("GIF" nil . "[image]") ;gif files; e.g., ~gif[\"foo.gif\" align=top]
+
+    ("I" nil .  "<i>~st</i>")
+    ("ID" nil .    "")       ;implementation dependent
+
+; The ACL2 documentation prints out ~ilc[] links in fixed-width font all the
+; time, but I sort of dislike that and would rather just print them in the same
+; font.  So I arbitrarily choose to treat ~il and ~ilc the same.
+
+    ("IL" t .  "<see topic=\"@(url ~sc)\">~st</see>")
+    ("ILC" t .  "<see topic=\"@(url ~sc)\">~st</see>")
+    ("L" t .  "See @(see ~sc)")
+    ("NL" nil .  "<br/>~%")
+    ("PAR" nil .  "<p/>~%~%")
+    ("PL" t .  "see @(see ~sc)")
+    ("SC" nil .  "~sT")
+    ("ST" nil .  "<b>~st</b>") ;strong emphasis
+    ("T" nil .  "<tt>~st</tt>")
+    ("TERMINAL" nil . "") ; terminal only, ignore
+
+; XDOC question: Again, is <img> supported?  I generate it just below, but I'm
+; not sure I do it right, especially since it's within <a>.  There's the same
+; issue for "FLY", "WALK", and "LARGE WALK".
+; XDOC question: Is it OK to refer to an image?  I guess twarning.gif will need
+; to be around.
+
+; A: replacing images with [image] for now, I'll add support somehow.
+
+    ("WARN" nil . "<see topic='ACL2____A_02Tiny_02Warning_02Sign'><img src='twarning.gif'/></see>")
+;    ("WARN" nil . "[image]")
+
+; Jared note: these don't seem quite right.
+;    ("CLICK-HERE" t .  "Click <a href=\"~sc\">here</a>")
+;    ("PCLICK-HERE" t .  "click <a href=\"~sc\">here</a>")
+    ("CLICK-HERE" t .  "Click <see topic=\"@(url ~sc)\">here</see>")
+    ("PCLICK-HERE" t .  "click <see topic=\"@(url ~sc)\">here</see>")
+
+    ("FLY" t .  "<see topic=\"@(url ~sc)\"><img src='flying.gif'/></see>")
+    ("LARGE-FLY" t .  "<see topic=\"@(url ~sc)\"><img src='large-flying.gif'/></see>")
+    ("WALK" t .  "<see topic=\"@(url ~sc)\"><img src='walking.gif'/></see>")
+    ("LARGE-WALK" t .  "<see topic=\"@(url ~sc)\"><img src='large-walking.gif'/></see>")
+
+;    ("FLY" t .  "[image]")
+;    ("LARGE-FLY" t .  "[image]")
+;    ("WALK" t .  "[image]")
+;    ("LARGE-WALK" t .  "[image]")
+
+; XDOC question: Does this handling of "URL" seem OK?  I think it's
+; appropriate, rather than @(url ...), since it's not for symbols; but I'm not
+; sure.
+
+; A: I think it's probably okay.
+
+    ("URL" nil .  "<a href=\"~st\">~st</a>")
+    )
+  "Table for use in printing documentation strings, when printing to
+an xdoc file.  See :DOC markup")
+
+(defconst *xdoc-vp* ; see print-doc-string-part1
+  '(("BV" "BF") . ("EV" "EF")))
+
+(defconst *xdoc-undocumented-topic*
+  ;; Keep in sync with import-acl2doc.lisp
+  "acl2::broken-link")
+
+(defun jared-string-upcase-first (x)
+  ;; Upper-case the first letter of a string, if it's lower-case.
+  ;; Most one-liners in the acl2 documentation have lower-case descriptions.
+  ;; I prefer upper-case for xdoc.
+  (let ((len (length x)))
+    (if (and (< 0 len)
+             (standard-char-p (char x 0))
+             (not (equal (char-upcase (char x 0))
+                         (char x 0))))
+        (concatenate 'string
+                     (coerce (list (char-upcase (char x 0))) 'string)
+                     (subseq x 1 nil))
+      x)))
+
+(defun write-a-doc-section (doc-tuple doc-fmt-alist channel state)
+
+; We return an xdoc database entry based on doc-tuple.
+
+  (let ((name (if (stringp (nth 0 doc-tuple))
+                  (intern (nth 0 doc-tuple) "ACL2")
+                (nth 0 doc-tuple)))
+        (parent (nth 1 doc-tuple))
+; See comment below about (nth 2 doc-tuple).
+        (doc-string (nth 3 doc-tuple)))
+    (acl2::er-let*
+
+; XDOC change: We avoid writing the header, which would be something like
+; <h1>TOPIC-FOO</h1>.  Note that we no longer give special treatment to "Pages
+; Written Especially for the Tours" in that non-existent header or in the
+; short string (defined just below).
+
+     ((short
+       (pprogn
+        (acl2::print-doc-string-part
+         0 doc-string
+
+; Jared question: what's the purpose of the following?  It seems to insert
+; <code></code> blocks after newlines in the short string... this seems really
+; weird...?
+; It looks like this is inherited from the html writer.  I'm going to just
+; try taking it out.
+
+         "" ; was "<code>   </code>"
+         *xdoc-doc-markup-table* *xdoc-doc-char-subst-table* doc-fmt-alist
+         channel name t *xdoc-undocumented-topic* nil state)
+        (get-output-stream-string$ channel state nil)))
+
+; XDOC change: A block of code including a call (print-name-as-link ...)
+; normally prints the "Major Section" information that we see on html pages,
+; but I'll assume that the xdoc system will manage that sort of thing itself.
+
+      (long
+       (mv-let
+         (ln state)
+         (acl2::print-doc-string-part-mv
+          1 doc-string "" *xdoc-doc-markup-table* *xdoc-doc-char-subst-table*
+          doc-fmt-alist channel (car doc-tuple) :par
+          *xdoc-undocumented-topic* *xdoc-vp* state)
+
+; XDOC change: We omit a call (write-doc-menu ...), assuming that the xdoc
+; system will take care of menus.  But note that our menus include citations
+; which will thus probably be missing from the xdoc documentation unless we
+; take extra measures.  The list of children together with topics collected
+; from :cite and :cited-by fields is found in (nth 2 doc-tuple).
+
+         (pprogn
+          (acl2::print-doc-string-part
+           2 doc-string "" *xdoc-doc-markup-table* *xdoc-doc-char-subst-table*
+           doc-fmt-alist channel (car doc-tuple) ln *xdoc-undocumented-topic*
+           *xdoc-vp* state)
+          (get-output-stream-string$ channel state nil)))))
+
+; XDOC change: unlike the HTML pages, we avoid laying down images that link to
+; the documentation's main page and index.
+
+;    (write-trailer xdoc-file index-file channel state)
+
+     (acl2::value
+      (list (cons :name name)
+            (cons :parents (list parent))
+            (cons :base-pkg
+                  (if (equal (symbol-package-name name) "ACL2-PC")
+                      name
+                    'acl2::rewrite))
+            (cons :short (jared-string-upcase-first short))
+            (cons :long long))))))
+
+(defun xdoc-fmt-alist (doc-alist acc)
+  (cond
+   ((null doc-alist)
+    acc)
+   (t (xdoc-fmt-alist
+       (cdr doc-alist)
+       (cons (let* ((s (caar doc-alist)))
+               (list
+                (cond ((stringp s) s)
+                      (t (let ((name (symbol-name s)))
+                           (cond ((eq s (intern$ name "ACL2"))
+                                  name)
+                                 (t (concatenate 'string
+                                                 (symbol-package-name s)
+                                                 "::"
+                                                 name))))))
+                (cons #\p s)
+                (cons #\c s)))
+             acc)))))
+
+(defun xdoc-alist1 (doc-alist fmt-alist channel state acc)
+  (cond ((endp doc-alist) (acl2::value acc))
+        (t (acl2::er-let*
+            ((entry (write-a-doc-section (car doc-alist) fmt-alist channel
+                                         state)))
+            (xdoc-alist1 (cdr doc-alist) fmt-alist channel state
+                         (cons entry acc))))))
+
+(defun filter-doc-alist (skip-topics-fal doc-alist)
+  (if (atom doc-alist)
+      nil
+    (let* ((doc-tuple (car doc-alist))
+           (name (if (stringp (nth 0 doc-tuple))
+                     (intern (nth 0 doc-tuple) "ACL2")
+                   (nth 0 doc-tuple))))
+      (if (hons-get name skip-topics-fal)
+          (filter-doc-alist skip-topics-fal (cdr doc-alist))
+        (cons doc-tuple
+              (filter-doc-alist skip-topics-fal (cdr doc-alist)))))))
+
+(defun write-xdoc-alist-fn (write-p return-p skip-topics-fal state)
+  (acl2::state-global-let*
+   ((acl2::fmt-hard-right-margin 500 acl2::set-fmt-hard-right-margin)
+    (acl2::fmt-soft-right-margin 480 acl2::set-fmt-soft-right-margin))
+   (let ((doc-alist (global-val 'acl2::documentation-alist
+                                (acl2::w state))))
+     (mv-let
+      (channel state)
+      (open-output-channel :string :object state)
+      (acl2::er-let*
+       ((result (xdoc-alist1 (filter-doc-alist skip-topics-fal doc-alist)
+                             (xdoc-fmt-alist doc-alist nil)
+                             channel state nil)))
+       (pprogn (close-output-channel channel state)
+               (cond (write-p (acl2::f-put-global 'acl2::xdoc-alist
+                                                  result
+                                                  state))
+                     (t state))
+               (acl2::value (and return-p result))))))))
+
+(defmacro acl2::write-xdoc-alist (&key (write-p 't)
+                                       (return-p 'nil)
+                                       (skip-topics-fal 'nil))
+  `(write-xdoc-alist-fn ,write-p ,return-p ,skip-topics-fal state))
+
+; Utility for accessing element of xdoc-alist:
+
+(defun xdoc-entry-fn (name xdoc-alist)
+  (cond ((endp xdoc-alist) nil)
+        ((equal name (cdr (assoc-eq :name (car xdoc-alist))))
+         (car xdoc-alist))
+        (t (xdoc-entry-fn name (cdr xdoc-alist)))))
+
+(defmacro acl2::xdoc-entry (name)
+  `(xdoc-entry-fn ',name
+                  (acl2::f-get-global 'acl2::xdoc-alist
+                                      state)))
diff -Nru acl2-6.2/books/xdoc-impl/Makefile acl2-6.3/books/xdoc-impl/Makefile
--- acl2-6.2/books/xdoc-impl/Makefile	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/Makefile	1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-include ../Makefile-generic
--include Makefile-deps
-
-all: $(BOOKS_CERT) bookdoc.dat
-
-.PHONY: moreclean
-moreclean:
-	rm -rf manual
-	rm -rf *.time
-	rm -rf bookdoc.dat
-
-clean: moreclean
-
-# Goofy.  We don't want to actually list the dependencies of bookdoc.dat.  In
-# principle, we should rebuild it any time any Lisp file in :dir :system is
-# changed (and it should be smart enough to figure out which books have
-# documentation on its own).  But this is hard.  I don't want to manually
-# maintain a giant list of lisp files that bookdoc.dat depends on, and
-# automatic dependency scanning is painful in GNU Make, so I don't want to deal
-# with it.
-#
-# (On the above point, added by Matt K.: When we certify with the
-# saving of expansion files, as is the case for "make regression" with
-# ACL2_SAVE_EXPANSION=t, we create many files *@expansion.lsp.  Since
-# there are only three .lsp source files, we enumerate them explicitly
-# below in the dependencies for bookdoc.dat.)
-#
-# Practically speaking, it isn't really crucial that bookdoc.dat be rebuilt all
-# the time.  Documentation really isn't updated that frequently, and even if
-# the documentation in bookdoc.dat is out of date, the (maybe-import-bookdoc)
-# command only adds topics that aren't already loaded, so the user won't see
-# outdated documentation at runtime with :xdoc unless they're looking at a
-# topic in a book that they haven't loaded.  I think it's reasonable to accept
-# this.
-
-bookdoc.dat: acl2-customization.lsp bookdoc.lsp ../xdoc/package.lsp \
-             $(wildcard ../xdoc/*.lisp) \
-             $(wildcard *.lisp) \
-             extra-packages.cert
-	@$(ACL2) < bookdoc.lsp > bookdoc.out
-	@ls -l bookdoc.dat
-
-make-manual.cert: bookdoc.dat
-
-
diff -Nru acl2-6.2/books/xdoc-impl/acl2-customization.lsp acl2-6.3/books/xdoc-impl/acl2-customization.lsp
--- acl2-6.2/books/xdoc-impl/acl2-customization.lsp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/acl2-customization.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,22 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(ld "../xdoc/package.lsp")
-(in-package "XDOC")
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc-impl/all.acl2 acl2-6.3/books/xdoc-impl/all.acl2
--- acl2-6.2/books/xdoc-impl/all.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/all.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(ld "cert.acl2")
-; cert-flags: ? t :ttags :all
-(certify-book "all" ? t :ttags :all)
diff -Nru acl2-6.2/books/xdoc-impl/all.lisp acl2-6.3/books/xdoc-impl/all.lisp
--- acl2-6.2/books/xdoc-impl/all.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/all.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-; all.lisp -- most users should ignore this book and include top.lisp instead.
-;
-; Unlike top.lisp, this book depends on everything else in xdoc except for
-; bookdoc.dat.  It may be useful as a target in some Makefiles that want to
-; ensure that all of XDOC gets built.  Note that your Makefile will probably
-; also want to generate bookdoc.dat.
-
-(in-package "XDOC")
-
-(include-book "../xdoc/base")
-(include-book "../xdoc/top")
-(include-book "../xdoc/defxdoc-raw")
-(include-book "../xdoc/names")
-
-(include-book "display")
-(include-book "import-acl2doc")
-(include-book "mkdir")
-(include-book "mkdir-raw")
-(include-book "parse-xml")
-(include-book "preprocess")
-(include-book "save")
-(include-book "topics")
-(include-book "write-acl2-xdoc")
-
-
diff -Nru acl2-6.2/books/xdoc-impl/autolink.lisp acl2-6.3/books/xdoc-impl/autolink.lisp
--- acl2-6.2/books/xdoc-impl/autolink.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/autolink.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,392 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-; autolink.lisp -- automatically insert links into pretty-printed s-expressions
-
-(in-package "XDOC")
-(include-book "fmt-to-str")
-(include-book "../xdoc/names")
-(local (include-book "misc/assert" :dir :system))
-(set-state-ok t)
-(program)
-
-
-; Convention: X is a string we are traversing, N is our current position in the
-; string, and XL is the length of the string.  The imagined guard is:
-;
-;  (declare (xargs :guard (and (stringp x)
-;                              (natp n)
-;                              (natp xl)
-;                              (= xl (length x))
-;                              (<= n xl))))
-;
-; We could do a lot of this in logic mode, but there doesn't seem to be much
-; point to that.
-
-(defun error-context (x n xl) ;; ==> STRING
-  ;; Tries to show what text is near an error.
-  (declare (type string x))
-  (let ((min (nfix (- n 40)))
-        (max (min (+ n 20) xl)))
-    (subseq x min max)))
-
-
-
-; What a pain.  We have to implement a symbol parser.
-
-(defun parse-symbol-name-part (x n xl
-                                 bar-escape-p        ; have we read an opening bar?
-                                 slash-escape-p      ; have we just read a backslash?
-                                 some-chars-p        ; have we read any chars at all yet?
-                                 nice-error-msg-p    ; do we care about nice error msgs?
-                                 acc)
-  ;; ==> (MV ERROR NAME N-PRIME)
-  (declare (type string x))
-
-; This tries to read just one part of a symbol name (i.e., the package part,
-; or the name part.)
-
-  (b* (((when (= xl n))
-        ;; End of string?  Error if we were escaped, or if we have not actually
-        ;; read some characters yet.  Otherwise, it was okay.
-        (let ((result (reverse (coerce acc 'string))))
-          (if (or bar-escape-p slash-escape-p (not some-chars-p))
-              (mv (if nice-error-msg-p
-                      (concatenate 'string "Near " (error-context x n xl)
-                                   ": unexpected end of string while reading symbol.  "
-                                   "Characters read so far: " result)
-                    "Symbol Parse Error")
-                  result n)
-            (mv nil result n))))
-
-       (n+1  (+ n 1))
-       (char (char x n))
-
-       ((when slash-escape-p)
-        ;; Slash escape is on, so just add next char verbatim and turn off
-        ;; slash escape.
-        (parse-symbol-name-part x n+1 xl bar-escape-p nil t nice-error-msg-p (cons char acc)))
-
-       ((when (eql char #\|))
-        ;; Bar just toggles bar-escaped-ness.
-        (parse-symbol-name-part x n+1 xl (not bar-escape-p) nil t nice-error-msg-p acc))
-
-       ((when (eql char #\\))
-        ;; Slash starts a slash-escape.
-        (parse-symbol-name-part x n+1 xl bar-escape-p t t nice-error-msg-p acc))
-
-       ((when bar-escape-p)
-        ;; Bar-escape is on and not a special char.  Read verbatim through it's
-        ;; turned off.
-        (parse-symbol-name-part x n+1 xl t nil t nice-error-msg-p (cons char acc)))
-
-       ((when (member char '(#\Space #\( #\) #\Newline #\Tab #\Page #\: #\, #\' #\`)))
-        ;; Whitespace, paren, colon, comma, quote, backquote, outside of a bar
-        ;; escape; end of symbol.  We can stop as long as we've actually read
-        ;; some characters.
-        (if some-chars-p
-            (mv nil (reverse (coerce acc 'string)) n)
-          (mv (if nice-error-msg-p
-                  (concatenate 'string "Near " (error-context x n xl)
-                               ": expected to read some part of a symbol, but found "
-                               (coerce (list char) 'string) ".")
-                "Symbol Parse Error")
-              "" n)))
-
-       ((when (or (and (char<= #\a char) (char<= char #\z))))
-        ;; lowercase letters outside of bar escape get capitalized
-        (parse-symbol-name-part x n+1 xl nil nil t nice-error-msg-p
-                                (cons (char-upcase char) acc))))
-
-    ;; Otherwise add the char verbatim
-    (parse-symbol-name-part x n+1 xl nil nil t nice-error-msg-p (cons char acc))))
-
-(defun parse-symbol (x n xl
-                       base-pkg ; default package to intern into
-                       kpa      ; (known-package-alist state)
-                       nice-error-msg-p)
-  ;; ==> (MV ERROR SYMBOL N-PRIME)
-  (declare (type string x))
-
-; This extends parse-symbol-name-part to read both parts.  We support keywords,
-; etc.  This is definitely not going to handle everything in Common Lisp, but
-; whatever.
-
-  (b* (((when (= xl n))
-        (mv (if nice-error-msg-p
-                (concatenate 'string "Near " (error-context x n xl)
-                             ": end of string while trying to parse a symbol.")
-              "Symbol Parse Error")
-            nil n))
-       (char (char x n))
-
-       ((when (eql char #\:))
-        ;; Starts with a colon.  Maybe it's keyword symbol?
-        (b* (((mv error name n)
-              (parse-symbol-name-part x (+ n 1) xl nil nil nil nice-error-msg-p nil)))
-          (if error
-              (mv error nil n)
-            (mv nil (intern-in-package-of-symbol name :keyword) n))))
-
-       ;; Could start with a package name, or with the symbol name (for symbols
-       ;; in the base pkg). Either way, we need to read a symbol name part.
-       ((mv error part1 n)
-        (parse-symbol-name-part x n xl nil nil nil nice-error-msg-p nil))
-       ((when error)
-        (mv error nil n))
-
-       ((when (and (< (+ n 1) xl)
-                   (eql (char x n) #\:)
-                   (eql (char x (+ n 1)) #\:)))
-        ;; Found "::" after the first part, so it's a package name.
-        (b* (((unless (assoc-equal part1 kpa))
-              (mv (if nice-error-msg-p
-                      (concatenate 'string "Near " (error-context x n xl)
-                                   ": not a known package: " part1 ".")
-                    "Symbol Parse Error")
-                  nil n))
-             ((mv error part2 n)
-              (parse-symbol-name-part x (+ n 2) xl nil nil nil nice-error-msg-p nil))
-             ((when error)
-              (mv error nil n))
-             ;; Things look pretty good here.  One weird thing we will try to
-             ;; detect is if there are extra colons, e.g., foo::bar::baz should
-             ;; be disallowed.  We really want a whitespace or paren or quote
-             ;; or something
-             ((when (eql (char x n) #\:))
-              (mv (if nice-error-msg-p
-                      (concatenate 'string "Near " (error-context x n xl)
-                                   ": Three layers of colons in symbol name?")
-                    "Symbol Parse Error")
-                  nil n)))
-          (mv nil (intern$ part2 part1) n)))
-
-       ;; Didn't find a :: after part1.
-       ((when (and (< n xl)
-                   (eql (char x n) #\:)))
-        (mv (if nice-error-msg-p
-                (concatenate 'string "Near " (error-context x n xl)
-                             ": Lone colon after symbol name?")
-              "Symbol Parse Error")
-            nil n)))
-
-    ;; We seem to have an okay package name, but no ::, so put it into the base
-    ;; package.
-    (mv nil (intern-in-package-of-symbol part1 base-pkg) n)))
-
-(encapsulate
-  ()
-  (logic) ;; since otherwise local stuff gets skipped
-
-  (local
-   (defun test (x expect-errmsg expect-result expect-n-prime)
-     (declare (xargs :mode :program))
-     (b* ((known-pkgs (pairlis$ '("KEYWORD" "ACL2" "XDOC") nil))
-          ((mv errmsg result n-prime)
-           (parse-symbol x 0 (length x) 'acl2::foo known-pkgs t)))
-       (cw "Errmsg: Found ~x0, expected ~x1~%" errmsg expect-errmsg)
-       (cw "Result: Found ~x0, expected ~x1~%" result expect-result)
-       (cw "N-prime: Found ~x0, expected ~x1~%" n-prime expect-n-prime)
-       (and (or (iff errmsg expect-errmsg) (cw "Errmsg failed!~%"))
-            (or expect-errmsg
-                (equal result expect-result)
-                (cw "Result failed!~%"))
-            (or expect-errmsg
-                (equal n-prime expect-n-prime)
-                (cw "N-Prime failed!~%"))))))
-
-  (local
-   (progn
-     ;; Things that should work
-     (assert! (test "foo" nil 'acl2::foo 3))
-     (assert! (test "bar" nil 'acl2::bar 3))
-     (assert! (test "acl2::bar)" nil 'acl2::bar 9))
-     (assert! (test "xdoc::bar)" nil 'xdoc::bar 9))
-     (assert! (test "xdoc::|foo|)" nil 'xdoc::|foo| 11))
-     (assert! (test "xdoc::bar12 " nil 'xdoc::bar12 11))
-
-     (assert! (test ":foo)" nil :foo 4))
-     (assert! (test ":|foo|)" nil :|foo| 6))
-     (assert! (test ":||" nil :|| 3))
-     (assert! (test "acl2::bar|:|)" nil 'acl2::bar|:| 12))
-
-     ;; Things that should fail
-     (assert! (test ":" t nil nil))     ;; lone colon, not ok
-     (assert! (test "||:" t nil nil))   ;; ending colon, not ok
-     (assert! (test "::|foo|)" t nil nil)) ;; starting colons w/o pkgname, not ok
-     (assert! (test "acl2:::bar)" t nil nil)) ;; three colons, not ok
-     (assert! (test "acl2::bar:" t nil nil))  ;; extra colon, not ok
-
-     ;; Uh... bug?  feature?
-     (assert! (test "123" nil 'acl2::|123| 3)))))
-
-
-
-
-(defun autolink-and-encode (x n xl topics base-pkg kpa acc) ;; ==> ACC
-
-; Main routine for autolinking and HTML encoding s-expressions.  X typically
-; has a pretty-printed S-expression that we want to turn into an XDOC <code>
-; segment.  TOPICS is a fast alist whose keys are the known topic names, for
-; fast lookups of whether a symbol is a topic.
-;
-; We walk over the string and look for symbols following open-parens; this
-; limitation is meant to reduce the amount of symbol parsing we have to do and
-; should be good enough to insert links to function calls.  Whenever we find a
-; symbol that is a documented topic, we insert a link to it.  We also HTML
-; encode the string in the process.
-
-  (b* (((when (int= n xl))
-        acc)
-       (char1 (char x n))
-       ((when (eql char1 #\<)) ;; --> "&lt;" in reverse
-        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa
-                             (list* #\; #\t #\l #\& acc)))
-       ((when (eql char1 #\>)) ;; --> "&gt;" in reverse
-        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa
-                             (list* #\; #\t #\g #\& acc)))
-       ((when (eql char1 #\&)) ;; --> "&amp;" in reverse
-        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa
-                             (list* #\; #\p #\m #\a #\& acc)))
-       ((when (eql char1 #\")) ;; --> "&quot;" in reverse
-        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa
-                             (list* #\; #\t #\o #\u #\q #\& acc)))
-       ((unless (eql char1 #\())
-        ;; Anything else except an open paren, we aren't going to do anything
-        ;; special with.  This way we don't have to call parse-symbol most of
-        ;; the time.
-        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa (cons char1 acc)))
-
-       (acc (cons char1 acc))
-       ((mv err symbol n-prime) (parse-symbol x (+ 1 n) xl base-pkg kpa nil))
-
-       ((when err)
-        ;; Failed to parse a valid symbol after it, so that's fine, maybe we hit
-        ;; a quoted thing like '((1 . 2)) or whatever.  Just keep going.
-        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa acc))
-
-       (look (hons-get symbol topics))
-       ((unless look)
-        ;; Nope, not a documented topic, so that's fine, just leave the paren
-        ;; there and keep on encoding things without inserting a link.
-        (autolink-and-encode x (+ 1 n) xl topics base-pkg kpa acc))
-
-       ;; Finally, the interesting case.  We just found something like
-       ;; "(append".  We want to convert this into, e.g.,
-       ;; (<see topic='[url-for-append]'>append</see>
-       ;; and then keep going with our encoding.
-       (acc
-        ;; <see topic="
-        (list* #\" #\= #\c #\i #\p #\o #\t #\Space #\e #\e #\s #\< acc))
-       (acc (file-name-mangle symbol acc))
-       (acc
-        ;; ">
-        (list* #\> #\" acc))
-       ;; Subtle: normally the "xl" argument should be the length of the string
-       ;; here, but we only want to encode the part of the name that we read.
-       ;; So, use the new N-PRIME returned by the symbol parser for the XL part
-       ;; to stop early.
-       (acc (simple-html-encode-str x (+ 1 n) n-prime acc))
-       (acc
-        ;; </see>
-        (list* #\> #\e #\e #\s #\/ #\< acc)))
-    ;; Finally recur...
-    (autolink-and-encode x n-prime xl topics base-pkg kpa acc)))
-
-(encapsulate
-  ()
-  (logic)
-
-  (local (defun test (str expect)
-           (declare (xargs :mode :program))
-           (b* ((topics '(acl2::f g h foo bar baz + - xdoc::top1 xdoc::top2)) ;; just for testing
-                (alist  (make-fast-alist (pairlis$ topics nil)))
-                (known-pkgs (pairlis$ '("ACL2" "KEYWORD" "XDOC") nil))
-                (acc    (autolink-and-encode str 0 (length str) alist 'acl2::foo known-pkgs nil))
-                (-      (fast-alist-free alist))
-                (result (reverse (coerce acc 'string))))
-             (or (equal result expect)
-                 (cw "Result: ~x0~%" result)
-                 (cw "Expected: ~x0~%" expect)))))
-
-  (local
-   (progn
-
-     (assert! (test "foo"
-                    ;; -->
-                    "foo"))
-
-     (assert! (test "foo & bar"
-                    ;; -->
-                    "foo &amp; bar"))
-
-     (assert! (test "foo & bar <baz>"
-                    ;; -->
-                    "foo &amp; bar &lt;baz&gt;"))
-
-     (assert! (test "(foo (+ 1 2))"
-                    ;; note that foo doesn't get processed: xdoc::foo is among the topics, but
-                    ;; since the base-pkg is acl2, the foo here is acl2::foo.
-                    "(foo (<see topic=\"COMMON-LISP_____B2\">+</see> 1 2))"))
-
-     (assert! (test "(xdoc::foo (f 1 2))"
-                    ;; -->
-                    "(<see topic=\"XDOC____FOO\">xdoc::foo</see> (<see topic=\"ACL2____F\">f</see> 1 2))")))))
-
-
-
-(defun xml-ppr-obj-aux
-  (x          ; object to pretty-print
-   topics-fal ; fast alist binding all xdoc topic names to [irrelevant]
-   base-pkg   ; base package to print from
-   state
-   acc)
-  (b* ((kpa (known-package-alist state))
-       ((mv str state) (fmt-to-str x base-pkg state))
-       (acc (autolink-and-encode str 0 (length str) topics-fal base-pkg kpa acc)))
-    (mv acc state)))
-
-(defun xml-ppr-obj-fn (x topics-fal base-pkg state)
-  (b* (((mv acc state) (xml-ppr-obj-aux x topics-fal base-pkg state nil))
-       (ret (reverse (coerce acc 'string))))
-    (mv ret state)))
-
-;; Ugh, the use of state-state here is awful.  formerly this wasn't a macro and
-;; was just took x and state.  But then I added topics-fal and base-pkg, and
-;; there's too much code that calls it directly.  So, I want to maintain some
-;; kind of interface compatibility.
-(defmacro xml-ppr-obj (x state-state
-                         &key
-                         (topics-fal 'nil)
-                         (base-pkg   ''acl2::foo))
-  `(b* (((mv acc ,state-state)
-         (xml-ppr-obj-aux ,x ,topics-fal ,base-pkg ,state-state nil))
-        (ret (reverse (coerce acc 'string))))
-     (mv ret ,state-state)))
-
-
-
-#|
-(xml-ppr-obj '(f 1 2) state :topics-fal (make-fast-alist '((f . nil))))
-(xml-ppr-obj '(f 1 2) state
-             :topics-fal (make-fast-alist '((f . nil)))
-             :base-pkg 'xdoc::foo)
-|#
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc-impl/bookdoc.lsp acl2-6.3/books/xdoc-impl/bookdoc.lsp
--- acl2-6.2/books/xdoc-impl/bookdoc.lsp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/bookdoc.lsp	1970-01-01 00:00:00.000000000 +0000
@@ -1,354 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-#||
-
-bookdoc.lsp
-
-This script loads the ACL2 and XDOC documentation for many ACL2 libraries, and
-saves a unified manual into acl2/books/xdoc/bookdoc.  An important feature is
-that it actually works even when all of the ACL2 books are uncertified, so you
-don't have to wait for a regression to finish before generating the library
-documentation.
-
-Few ACL2 books have any documentation, and this script misses a few books that
-do have some documentation:
-
-  - I intentionally omit the workshop books.
-  - I'm omitting the COI books since they have some loading problems.
-  - The SULFA books seem to have some loading problems.
-  - The clause-processors/basic-examples book has loading problems.
-
-The basic strategy for To avoid book incompatibilities, I basically locally
-include each book, then use make-event to save its extracted documentation
-Because of this, we shouldn't need to worry (much) about name clashes, theory
-incompatibilities, etc.
-
-Well, there are still some (very) rough edges.
-
-First, the script doesn't have any smart way of knowing what books have
-documentation.  Instead, to get started, I just ran:
-
-     grep -c -i ":Doc-Section" \
-        `find . -name "*.lisp"` \
-        `find . -name "*.lsp"` \
-        `find . -name "*.acl2"` | grep -v :0
-
-And then looked at the books it found.  This is obviously not future-proof, so
-if someone adds some documentation to a new library in the future, it won't be
-included in the unified manual until this file is updated.
-
-Second, the script needs to explicitly load all of the packages involved in the
-process ahead of time.  There are two reasons for this.  First, if we're
-including uncertified books, ACL2 isn't smart enough to look at the
-corresponding .acl2 file to read the packages it needs.  Second, even if we are
-loading certified books, trying to save doc topics in a package that is only
-locally defined results in interning errors.
-
-We save the extracted documentation into book-documentation.lisp, which is
-automatically loaded (if present) into the XDOC database when the :xdoc
-and :save commands are executed.
-
-||#
-
-; In case ACL2 starts up outside its loop (formerly true for Lispworks):
-;(acl2::value :q)
-;(acl2::lp)
-
-(in-package "ACL2")
-(include-book "extra-packages")
-(include-book "xdoc-impl/import-acl2doc" :dir :system)
-
-
-(table book-doc 'doc nil)
-
-(defun get-book-doc-table (world)
-  (cdr (assoc-eq 'doc (table-alist 'book-doc world))))
-
-(defmacro extract-documentation-from-book (bookname &key dir)
-  `(with-output :off (event summary)
-     (encapsulate
-       ()
-       (with-output :on (summary)
-         (local (include-book ,bookname :dir ,dir)))
-       (make-event
-        (mv-let (er val state)
-          (time$ (acl2::write-xdoc-alist :skip-topics xdoc::*acl2-ground-zero-names*)
-                 :msg "; Importing :doc topics took ~st sec, ~sa bytes~%"
-                 :mintime 1)
-          (declare (ignore er val))
-          (let ((topics (acl2::f-get-global 'acl2::xdoc-alist state)))
-            (value `(table book-doc 'doc
-                           (acons ,,bookname ',topics
-                                  (get-book-doc-table world))))))))))
-
-(defun extract-documentation-from-books-fn (booknames dir)
-  (if (atom booknames)
-      nil
-    (cons `(extract-documentation-from-book ,(car booknames) :dir ,dir)
-          (extract-documentation-from-books-fn (cdr booknames) dir))))
-
-(defmacro extract-documentation-from-books (booknames &key dir)
-  (cons 'progn (extract-documentation-from-books-fn booknames dir)))
-
-;; I get errors on these
-;; (extract-documentation-from-books
-;;  ("coi/records/fast/private"
-;;   "coi/records/fast/memory"
-;;   "coi/adviser/adviser"
-;;   "coi/defstructure/defstructure"
-;;   "coi/defstructure/defstructure-definitions")
-;;  :dir :system)
-
-(extract-documentation-from-books
- ("ihs/ihs-theories"
-  "ihs/logops-definitions"
-  "ihs/quotient-remainder-lemmas"
-  "ihs/logops-lemmas"
-  "ihs/ihs-definitions"
-  "ihs/ihs-lemmas"
-  "ihs/ihs-init"
-  "ihs/math-lemmas"
-  "ihs/@logops")
- :dir :system)
-
-(extract-documentation-from-books
- ("str/top")
- :dir :system)
-
-(extract-documentation-from-books
- ("tools/bstar"
-  "tools/safe-case"
-  "tools/pattern-match"
-  "tools/defevaluator-fast"
-  "tools/do-not"
-  "tools/defconsts"
-  "tools/oracle-eval"
-  "tools/defsum")
- :dir :system)
-
-(extract-documentation-from-books
- ("misc/trace-star"
-  "misc/hons-help"
-  "misc/expander"
-  "misc/defmac"
-  "misc/qi-correct"
-  "misc/meta-lemmas"
-  "misc/defopener"
-  "misc/dump-events"
-  "misc/definline"
-  "misc/sin-cos"
-  "misc/untranslate-patterns"
-  "misc/qi")
- :dir :system)
-
-(extract-documentation-from-books
- ("data-structures/defalist"
-  "data-structures/deflist"
-  "data-structures/structures"
-  "data-structures/utilities"
-  "data-structures/array1"
-  "data-structures/memories/private"
-  "data-structures/memories/memory")
- :dir :system)
-
-(extract-documentation-from-books
- ("hints/consider-hint")
- :dir :system)
-
-;; This book has some problems.  First, we can't localize it due to defaxioms.
-;; Second, we can't even include it normally unless it's certified, or it
-;; seems to hit weird errors in make-event exapnsion.  So, I'm omitting it.
-;; (include-book "clause-processors/basic-examples" :dir :system)
-
-(extract-documentation-from-books
- ("clause-processors/SULFA/books/bv-smt-solver/bv-lib-definitions"
-  ;; These sulfa books cause errors about a missing file, at least
-  ;; without certification...
-  ;; "clause-processors/SULFA/books/sat-tests/tutorial"
-  ;; "clause-processors/SULFA/books/sat-tests/benchmark"
-  ;; "clause-processors/SULFA/books/sat-tests/test-incremental"
-  "clause-processors/autohide"
-  )
- :dir :system)
-
-(extract-documentation-from-books
- ("tools/safe-case"
-;;  "tools/flag" -- switched to xdoc
-  "tools/def-functional-instance"
-  "tools/include-raw"
-  "tools/pattern-match"
-  "tools/bstar"
-  "tools/defevaluator-fast"
-  "tools/do-not"
-  "tools/defconsts"
-  "tools/oracle-eval"
-  "tools/defsum")
- :dir :system)
-
-(extract-documentation-from-books
- ("serialize/serialize")
- :dir :system)
-
-(extract-documentation-from-books
- ("make-event/defconst-fast-examples")
- :dir :system)
-
-;; I don't want to include the workshop books.
-;; (extract-documentation-from-books
-;;  ("workshops/1999/embedded/Proof-Of-Contribution/private-qr-lemmas"
-;;   "workshops/1999/embedded/Exercises/Exercise1-2/private-qr-lemmas"
-;;   "workshops/1999/de-hdl/de4"
-;;   "workshops/2000/ruiz/multiset/defmul"
-;;   "workshops/2003/gamboa-cowles-van-baalen/support/kalman-defs"
-;;   "workshops/2006/swords-cook/lcsoundness/pattern-match"
-;;   "workshops/2006/swords-cook/lcsoundness/defsum"
-;;   "workshops/2006/hunt-reeber/support/bdd"
-;;   "workshops/2006/hunt-reeber/support/sat"
-;;   "workshops/2006/hunt-reeber/support/acl2"
-;;   "workshops/2007/rubio/support/multisets/defmul"
-;;   "workshops/2007/dillinger-et-al/code/hacker"
-;;   "workshops/2007/dillinger-et-al/code/bridge"
-;;   "workshops/2007/dillinger-et-al/code/subsumption"
-;;   "workshops/2007/schmaltz/genoc-v1.0/instantiations/interfaces/bi-phi-m"
-;;   )
-;;  :dir :system)
-
-(extract-documentation-from-books
- ("cowles/acl2-asg"
-  "cowles/acl2-crg"
-  "cowles/acl2-agp")
- :dir :system)
-
-(extract-documentation-from-books
- ("hacking/hacker"
-  "hacking/bridge"
-  "hacking/subsumption")
- :dir :system)
-
-
-
-(include-book "tools/defconsts" :dir :system)
-(include-book "finite-set-theory/osets/sets" :dir :system)
-(include-book "unicode/flatten" :dir :system)
-(include-book "defsort/duplicated-members" :dir :system)
-
-(defconsts *merged-book-doc*
-  (sets::mergesort
-   (flatten (strip-cdrs (get-book-doc-table (w state))))))
-
-
-
-
-;; Well, I guess we should also get books with XDOC documentation.
-
-(include-book "cutil/top" :dir :system)
-(include-book "xdoc/top" :dir :system)
-(include-book "tools/flag" :dir :system)
-(include-book "finite-set-theory/osets/osets" :dir :system)
-(include-book "str/top" :dir :system)
-(include-book "oslib/top" :dir :system)
-
-
-;; Okay, now the code to process what we've just loaded.
-
-(program)
-
-(defun stupid-find-files (topic book-doc-table)
-  ;; Walk over the book-doc-table and find all files that included this topic.
-  (cond ((atom book-doc-table)
-         nil)
-        ((member-equal topic (cdar book-doc-table))
-         (cons (caar book-doc-table)
-               (stupid-find-files topic (cdr book-doc-table))))
-        (t
-         (stupid-find-files topic (cdr book-doc-table)))))
-
-(defun stupid-annotate-topics (topics book-doc-table)
-  (if (atom topics)
-      nil
-    (let ((files  (stupid-find-files (car topics) book-doc-table))
-          (long   (or (cdr (assoc :long (car topics))) "")))
-      (cons (acons :long
-                   (concatenate 'string long
-                                "<p>[Imported by bookdoc from <tt>" (car files) "</tt>]</p>")
-                   (xdoc::remove-alist-key :long (car topics)))
-            (stupid-annotate-topics (cdr topics) book-doc-table)))))
-
-(defconsts *annotated-doc*
-  (stupid-annotate-topics *merged-book-doc* (get-book-doc-table (w state))))
-
-#!XDOC
-(table xdoc 'doc
-       (sets::mergesort
-        (append acl2::*annotated-doc* (get-xdoc-table world))))
-
-
-
-;; Now check for documentation collisions.
-
-(defun warn-about-collisions1 (collision-names topics)
-  (cond ((atom topics)
-         nil)
-        ((not (member (cdr (assoc :name (car topics))) collision-names))
-         (cons (car topics)
-               (warn-about-collisions1 collision-names (cdr topics))))
-        (t
-         (let* ((long (cdr (assoc :long (car topics))))
-                (long (concatenate 'string "<h4>Error: Multiple documentation
-topics share this name.  We have arbitrarily chosen one of them.</h4>" long))
-                (new-topic (acons :long long (xdoc::remove-alist-key :long (car topics)))))
-           (cons new-topic
-                 (warn-about-collisions1 collision-names (cdr topics)))))))
-
-(defun warn-about-collisions (topics)
-  (let ((dupes (duplicated-members (xdoc::all-topic-names topics))))
-    (if dupes
-        (prog2$
-         (cw "Oops, conflicting documentation for ~&0.~%" dupes)
-         (warn-about-collisions1 dupes topics))
-      topics)))
-
-(comp t) ; can be needed when host Lisp doesn't automatically compile, e.g., Allegro CL
-
-(defconsts *book-documentation*
-  (xdoc::remove-topics-by-name (warn-about-collisions (xdoc::get-xdoc-table (w state)))
-                               xdoc::*acl2-ground-zero-names*))
-
-
-;; This writing must be done relative to the ACL2 package!!!!!  See also
-;; maybe-import-bookdoc.
-
-(in-package "ACL2")
-(defttag write-book-documentation)
-(b* ((- (cw "Writing bookdoc.dat~%"))
-     ((mv channel state)
-      (open-output-channel! "bookdoc.dat" :character state))
-     (state (princ$ "; GENERATED FILE -- DO NOT HAND EDIT" channel state))
-     (state (newline channel state))
-     (state (newline channel state))
-     (state (fms! "~x0~%" (list (cons #\0 *book-documentation*)) channel state nil))
-     (state (newline channel state))
-     (state (close-output-channel channel state)))
-  state)
-
-
-
diff -Nru acl2-6.2/books/xdoc-impl/cert.acl2 acl2-6.3/books/xdoc-impl/cert.acl2
--- acl2-6.2/books/xdoc-impl/cert.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/cert.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "ACL2")
-(include-book "portcullis")
-; cert-flags: ? t :ttags :all
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc-impl/display.lisp acl2-6.3/books/xdoc-impl/display.lisp
--- acl2-6.2/books/xdoc-impl/display.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/display.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,444 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "XDOC")
-(include-book "save")
-(include-book "parse-xml")
-(set-state-ok t)
-(program)
-
-
-; Implements the :xdoc command for printing xdoc topics to the terminal.
-;
-; The basic approach is:
-;   1. preprocess the topic using the ordinary preprocessor (see save.lisp)
-;   2. parse the resulting xml string into a list of tokens (see parse-xml.lisp)
-;   3. transform the token list into reasonably nice plain-text
-;   4. print the text to the terminal
-;
-; Loading this file does not require a ttag.  However, actually using the :xdoc
-; command incurs a ttag by loading the defxdoc-raw book.  Of course, this is
-; typically not a problem since you only use :xdoc in interactive sessions, and
-; not while certifying books.
-
-
-; NORMALIZE-WHITESPACE canonicalizes whitespace so that any adjacent whitespace
-; characters are merged into a single space.
-
-(defun normalize-whitespace-aux (x n xl acc)
-  (b* (((when (>= n xl))
-        acc)
-       (char-n (char x n))
-       ((when (member char-n '(#\Space #\Tab #\Page #\Newline)))
-        (normalize-whitespace-aux
-         x (+ n 1) xl
-         (if (and (< (+ n 1) xl)
-                  (member (char x (+ n 1)) '(#\Space #\Tab #\Page #\Newline)))
-             acc
-           (cons #\Space acc)))))
-    (normalize-whitespace-aux x (+ n 1) xl (cons char-n acc))))
-
-(defun normalize-whitespace (x)
-  (declare (type string x))
-  (reverse (coerce (normalize-whitespace-aux x 0 (length x) nil) 'string)))
-
-
-
-; MERGE-TEXT eats any "throwaway tags" that we can't support in a terminal,
-; normalizes whitespace throughout text nodes, and merges any adjacent text
-; nodes.
-
-(defconst *throwaway-tags*
-  (list "b" "i" "u" "tt" "color" "sf" "a" "box" "img"
-        "page" "long"))
-
-(defun merge-text (x acc codes)
-  ;; CODES is number of open <code> tags -- we don't normalize whitespace
-  ;; within them, but entities still get converted.
-  (b* (((when (atom x))
-        acc)
-       (tok1 (car x))
-       (rest (cdr x))
-       ((when (opentok-p tok1))
-        (b* ((name (opentok-name tok1))
-             (codes (if (equal name "code")
-                        (+ 1 codes)
-                      codes)))
-          (cond ((member-equal name *throwaway-tags*)
-                 (merge-text rest acc codes))
-                ((equal name "a")
-                 (b* ((href (cdr (assoc :href (opentok-atts tok1))))
-                      (href (if (stringp href) href ""))
-                      (tok  (list :TEXT (str::cat "[" href " "))))
-                   (merge-text (cons tok rest) acc codes)))
-                ((equal name "see")
-                 (b* ((tok  (list :TEXT "[")))
-                   (merge-text (cons tok rest) acc codes)))
-                ((equal name "srclink")
-                 (b* ((tok  (list :TEXT "<")))
-                   (merge-text (cons tok rest) acc codes)))
-                (t
-                 (merge-text rest (cons tok1 acc) codes)))))
-       ((when (closetok-p tok1))
-        (b* ((name  (closetok-name tok1))
-             (codes (if (equal name "code")
-                        (- 1 codes)
-                      codes)))
-          (cond ((member-equal name *throwaway-tags*)
-                 (merge-text rest acc codes))
-                ((member-equal name '("a" "see"))
-                 (let ((tok (list :TEXT "]")))
-                   (merge-text (cons tok rest) acc codes)))
-                ((equal name "srclink")
-                 (let ((tok (list :TEXT ">")))
-                   (merge-text (cons tok rest) acc codes)))
-                (t
-                 (merge-text rest (cons tok1 acc) codes)))))
-       (tok1
-        ;; Goofy.  Convert any entities into ordinary text.  Normalize
-        ;; whitespace for any non-code tokens.
-        (cond ((entitytok-p tok1)
-               (list :TEXT (entitytok-as-plaintext tok1)))
-              ((zp codes)
-               ;; NOT in a <code> block, so normalize ws.
-               (list :TEXT (normalize-whitespace (texttok-text tok1))))
-              (t
-               ;; Inside a <code> block, so don't touch ws.
-               tok1)))
-       ((unless (texttok-p (car acc)))
-        (merge-text rest (cons tok1 acc) codes))
-
-       (merged-tok (list :TEXT (str::cat (texttok-text (car acc))
-                                         (texttok-text tok1)))))
-    (merge-text rest (cons merged-tok (cdr acc)) codes)))
-
-
-
-; (WORD-WRAP-PARAGRAPH X INDENT WRAP-COL) reformats the string X, trying to
-; word wrap to WRAP-COL and indenting each subsequent line to INDENT.  We
-; assume that indent-many characters have already been printed, so the first
-; line is not indented.
-
-(defun add-word-to-paragraph (x n xl col acc)
-  "Returns (MV N COL ACC)"
-  (b* (((when (>= n xl))
-        (mv n col acc))
-       (char-n (char x n))
-       ((when (eql char-n #\Space))
-        (mv n col acc)))
-    (add-word-to-paragraph x (+ n 1) xl (+ 1 col) (cons char-n acc))))
-
-(defun remove-spaces-from-front (x)
-  (if (atom x)
-      x
-    (if (eql (car x) #\Space)
-        (remove-spaces-from-front (cdr x))
-      x)))
-
-(defun word-wrap-paragraph-aux (x n xl col wrap-col indent acc)
-  (b* (((when (>= n xl))
-        acc)
-       (char-n (char x n))
-       ((when (eql char-n #\Space))
-        (word-wrap-paragraph-aux x (+ n 1) xl (+ col 1)
-                                 wrap-col indent (cons char-n acc)))
-       ((mv spec-n spec-col spec-acc)
-        (add-word-to-paragraph x n xl col acc))
-       ((when (or (< spec-col wrap-col)
-                  (= col indent)))
-        ;; Either (1) it fits, or (2) we can't get any more space by moving to
-        ;; the next line anyway, so accept this speculative addition.
-        (word-wrap-paragraph-aux x spec-n xl spec-col wrap-col indent spec-acc))
-       ;; Else, try again, starting on the next line.
-       (acc (remove-spaces-from-front acc)) ;; deletes trailing spaces on this line
-       (acc (cons #\Newline acc))
-       (acc (append (make-list indent :initial-element #\Space) acc)))
-    (word-wrap-paragraph-aux x n xl indent wrap-col indent acc)))
-
-(defun word-wrap-paragraph (x indent wrap-col)
-  (let* ((acc (word-wrap-paragraph-aux x 0 (length x) 0 wrap-col indent nil))
-         (acc (remove-spaces-from-front acc))
-         (acc (reverse acc))
-         (acc (remove-spaces-from-front acc)))
-    (coerce acc 'string)))
-
-
-
-(defun has-tag-above (tag open-tags)
-  (if (atom open-tags)
-      nil
-    (or (equal tag (opentok-name (car open-tags)))
-        (has-tag-above tag (cdr open-tags)))))
-
-(defun get-indent-level (open-tags)
-  (b* (((when (atom open-tags))
-        0)
-       (name (opentok-name (car open-tags)))
-       ((when (member-equal name '("h1" "h2" "h3")))
-        0)
-       ((when (member-equal name '("p" "short" "h4" "h5" "index_entry")))
-        (+ 2 (get-indent-level (cdr open-tags))))
-       ((when (member-equal name '("index_body")))
-        (+ 4 (get-indent-level (cdr open-tags))))
-       ((when (member-equal name '("ol" "ul")))
-        ;; Note: the bullet is put into the indented space, so in practice
-        ;; an indent-level of 6 is more like an indent-level of 3.
-        (if (has-tag-above "li" open-tags)
-            (+ 4 (get-indent-level (cdr open-tags)))
-          (+ 6 (get-indent-level (cdr open-tags)))))
-       ((when (equal name "dt"))
-        (+ 4 (get-indent-level (cdr open-tags))))
-       ((when (equal name "dd"))
-        (+ 6 (get-indent-level (cdr open-tags))))
-       ((when (equal name "code"))
-        (+ 4 (get-indent-level (cdr open-tags))))
-       ((when (equal name "blockquote"))
-        (+ 4 (get-indent-level (cdr open-tags)))))
-    (get-indent-level (cdr open-tags))))
-
-(defun get-list-type (open-tags)
-  (b* (((when (atom open-tags))
-        ;; arbitrary default
-        :bulleted)
-       (name (opentok-name (car open-tags)))
-       ((when (equal name "ol"))
-        :numbered)
-       ((when (equal name "ul"))
-        :bulleted))
-    (get-list-type (cdr open-tags))))
-
-(defun auto-indent (acc open-tags)
-  (append (make-list (get-indent-level open-tags)
-                     :initial-element #\Space)
-          acc))
-
-(defun maybe-newline (acc)
-  ;; Make sure there is a newline at the start of acc.
-  (b* ((acc (remove-spaces-from-front acc))
-       (acc (if (or (atom acc)
-                    (eql (car acc) #\Newline))
-                acc
-              (cons #\Newline acc))))
-    acc))
-
-(defun maybe-doublespace (acc)
-  ;; Make sure there are two newlines at the start of acc.
-  (b* ((acc (remove-spaces-from-front acc))
-       ((when (atom acc))
-        ;; Nothing at all, don't insert anything
-        acc)
-       ((unless (eql (car acc) #\Newline))
-        ;; No newlines at all -- insert two of them.
-        (list* #\Newline #\Newline acc))
-       ;; At least one newline.  Let's eat it and see what's further on.
-       (acc (remove-spaces-from-front (cdr acc)))
-       ((when (atom acc))
-        ;; Nothing at all, don't insert anything.
-        acc)
-       ((unless (eql (car acc) #\Newline))
-        ;; No second newline.  So since we've eaten the only newline
-        ;; there was, insert two newlines.
-        (list* #\Newline #\Newline acc)))
-  ;; Found the second newline, so just restore the first one.
-  (cons #\Newline acc)))
-
-(defun maybe-triplespace (acc)
-  ;; Make sure there are three newlines at the start of acc.
-  (b* ((acc (remove-spaces-from-front acc))
-       ((when (atom acc)) acc)
-       ((unless (eql (car acc) #\Newline))
-        (list* #\Newline #\Newline #\Newline acc))
-
-       ;; Eat newline #1
-       (acc (remove-spaces-from-front (cdr acc)))
-       ((when (atom acc)) acc)
-       ((unless (eql (car acc) #\Newline))
-        (list* #\Newline #\Newline #\Newline acc))
-
-       ;; Eat newline #2
-       (acc (remove-spaces-from-front (cdr acc)))
-       ((when (atom acc)) acc)
-       ((unless (eql (car acc) #\Newline))
-        (list* #\Newline #\Newline #\Newline acc)))
-
-    (list* #\Newline #\Newline acc)))
-
-(defun prepend-each-line (spaces x n xl acc)
-  (b* (((when (>= n xl))
-        acc)
-       (char-n (char x n))
-       ((unless (eql char-n #\Newline))
-        (prepend-each-line spaces x (+ 1 n) xl (cons char-n acc)))
-       ;; Else, a newline.  delete trailing whitespace
-       (acc (remove-spaces-from-front acc))
-       (acc (cons #\Newline acc))
-       (acc (append spaces acc)))
-    (prepend-each-line spaces x (+ 1 n) xl acc)))
-
-(defun tokens-to-terminal
-  (tokens    ;; the tokens to print
-   wrap-col  ;; the goal column for word-wrap
-   open-tags ;; currently open tags
-   list-nums ;; stack of current element numbers for list printing
-   acc       ;; accumulator for output characters (in reverse order)
-   )
-  (b* (((when (atom tokens))
-        acc)
-       (tok1 (car tokens))
-       (rest (cdr tokens))
-
-       ((when (opentok-p tok1))
-        (b* ((name (opentok-name tok1))
-             (open-tags (cons tok1 open-tags))
-             (list-nums (cond
-                         ((member-equal name '("ol" "ul"))
-                          (cons 0 list-nums))
-                         ((equal name "li")
-                          (cons (+ 1 (nfix (car list-nums)))
-                                (cdr list-nums)))
-                         (t
-                          list-nums)))
-             (acc (cond
-                   ((equal name "parent")
-                    (b* ((acc (maybe-newline acc))
-                         (acc (str::revappend-chars "Parent topic: " acc)))
-                      acc))
-                   ((equal name "li")
-                    (b* ((bullet (if (eq (get-list-type open-tags) :bulleted)
-                                     "* "
-                                   (str::cat (str::natstr (nfix (car list-nums))) ". ")))
-                         (bullet-len (length bullet))
-                         (desired    (get-indent-level open-tags))
-                         (spaces  (make-list (nfix (- desired bullet-len))
-                                             :initial-element #\Space))
-                         (acc     (maybe-newline acc))
-                         (acc     (append spaces acc))
-                         (acc     (str::revappend-chars bullet acc)))
-                      acc))
-                   ((member-equal name '("h4" "h5" "short" "p" "li" "dt" "dd" "br"
-                                         "index_head" "index_body" "blockquote"))
-                    ;; This kind of tag has some level of indenting associated
-                    ;; with it, so make sure we indent over to the right level.
-                    (auto-indent (maybe-newline acc) open-tags))
-                   ((member-equal name '("code"))
-                    (auto-indent (maybe-doublespace acc) open-tags))
-                   ((member-equal name '("h1" "h2" "h3"))
-                    (auto-indent (maybe-triplespace acc) open-tags))
-                   ((equal name "index")
-                    (b* ((atts  (opentok-atts tok1))
-                         (title (cdr (assoc-equal "title" atts)))
-                         (title (if (stringp title) title "??? title ???"))
-                         (acc   (maybe-triplespace acc))
-                         (acc   (str::revappend-chars title acc))
-                         (acc   (maybe-doublespace acc)))
-                      acc))
-                   (t
-                    acc))))
-          (tokens-to-terminal rest wrap-col open-tags list-nums acc)))
-
-       ((when (closetok-p tok1))
-        (b* ((name (closetok-name tok1))
-             (open-tags (cdr open-tags))
-             (list-nums (if (member-equal name '("ol" "ul"))
-                            (cdr list-nums)
-                          list-nums))
-             (acc (cond
-                   ((member-equal name '("h1" "h2" "h3" "h4" "h5" "p" "dl" "ul" "ol"
-                                         "short" "code" "parent" "index" "index_body"
-                                         "blockquote"))
-                    (auto-indent (maybe-doublespace acc) open-tags))
-                   ((member-equal name '("li" "dd" "dt" "index_head"))
-                    (auto-indent (maybe-newline acc) open-tags))
-                   (t
-                    acc))))
-          (tokens-to-terminal rest wrap-col open-tags list-nums acc)))
-
-       ;; Else, it should be a text token.
-       ;; We assume we are already indented to the right level.
-       ;; BOZO handle <code> correctly.
-       (text (texttok-text tok1))
-
-       (codep (has-tag-above "code" open-tags))
-       (level (get-indent-level open-tags))
-       (acc (if codep
-                (b* ((len (length text))
-                     (starts-with-newline-p (and (> len 0)
-                                                 (eql (char text 0) #\Newline)))
-                     (start-from (if starts-with-newline-p
-                                     1
-                                   0)))
-                  (prepend-each-line (make-list level :initial-element #\Space)
-                                     text start-from (length text) acc))
-              (let ((wrapped (word-wrap-paragraph text level wrap-col)))
-                (str::revappend-chars wrapped acc)))))
-    (tokens-to-terminal rest wrap-col open-tags list-nums acc)))
-
-
-
-(defun display-topic (x all-topics state)
-  (b* ((name (cdr (assoc :name x)))
-;       (- (cw "Preprocessing...~%"))
-       ;; Use NIL as the topics-fal as a simple way to suppress autolinks...
-       ((mv text state) (preprocess-topic x all-topics nil nil state))
-;       (- (cw "Text is ~x0.~%" text))
-;       (- (cw "Parsing xml...~%"))
-       ((mv err tokens) (parse-xml text))
-;       (- (cw "Checking result...~%"))
-       ((when err)
-        (cw "Error displaying xdoc topic:~%~%")
-        (b* ((state (princ$ err *standard-co* state))
-             (state (newline *standard-co* state))
-             (state (newline *standard-co* state)))
-          state))
-;       (- (cw "Tokens are ~x0.~%" tokens))
-;       (- (cw "Merging tokens...~%"))
-       (merged-tokens (reverse (merge-text tokens nil 0)))
-;       (- (cw "Merged tokens are ~x0.~%" merged-tokens))
-       (terminal (reverse (coerce (tokens-to-terminal merged-tokens 70 nil nil nil)
-                                  'string)))
-       (state (princ$ (symbol-package-name name) *standard-co* state))
-       (state (princ$ "::" *standard-co* state))
-       (state (princ$ (symbol-name name) *standard-co* state))
-       (state (newline *standard-co* state))
-       (state (princ$ terminal *standard-co* state))
-       (state (newline *standard-co* state)))
-    state))
-
-
-; We previously tried to see if there was an acl2 doc topic.  But now that we
-; have a fast importer from acl2 documentation, we just run (import-acl2doc)
-; before calling colon-xdoc-fn, so we should only need to look in the xdoc
-; database.
-
-(defun colon-xdoc-fn (name all-xdoc-topics state)
-  (declare (xargs :guard (symbolp name)))
-  (b* ((xdoc-entry      (find-topic name all-xdoc-topics))
-
-       ((when (not xdoc-entry))
-        ;; Seems safe to just print the acl2 documentation.  Even if there
-        ;; isn't an ACL2 topic, doc-fn can tell the user about similar topic
-        ;; names, which is nice.  It'd probably be nice to add nearby xdoc
-        ;; names, too.
-        (cw "No XDOC topics for ~s0::~s1.~%~%" (symbol-package-name name)
-            (symbol-name name))
-        (value :invisible))
-
-       (state      (display-topic xdoc-entry all-xdoc-topics state)))
-    (value :invisible)))
diff -Nru acl2-6.2/books/xdoc-impl/extra-packages.acl2 acl2-6.3/books/xdoc-impl/extra-packages.acl2
--- acl2-6.2/books/xdoc-impl/extra-packages.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/extra-packages.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-;; Horrible hack for loading all packages before loading book documentation.
-
-(ld "cert.acl2")
-(ld "cowles/packages.lsp" :dir :system)
-(ld "clause-processors/SULFA/books/sat/sat-package.acl2" :dir :system)
-(ld "data-structures/define-u-package.lsp" :dir :system)
-(ld "data-structures/define-structures-package.lsp" :dir :system)
-(ld "data-structures/memories/package.lsp" :dir :system)
-(ld "hacking/hacker-pkg.lsp" :dir :system)
-(ld "cutil/package.lsp" :dir :system)
-(ld "finite-set-theory/osets/sets.defpkg" :dir :system)
-(ld "str/package.lsp" :dir :system)
-(ld "tools/flag-package.lsp" :dir :system)
-(ld "oslib/package.lsp" :dir :system)
-; cert-flags: ? t :ttags :all
-(certify-book "extra-packages" ? t :ttags :all)
\ No newline at end of file
diff -Nru acl2-6.2/books/xdoc-impl/extra-packages.lisp acl2-6.3/books/xdoc-impl/extra-packages.lisp
--- acl2-6.2/books/xdoc-impl/extra-packages.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/extra-packages.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "ACL2")
diff -Nru acl2-6.2/books/xdoc-impl/fmt-to-str.lisp acl2-6.3/books/xdoc-impl/fmt-to-str.lisp
--- acl2-6.2/books/xdoc-impl/fmt-to-str.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/fmt-to-str.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,86 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-; fmt-to-str.lisp -- alternative to fmt-to-string with narrower margins
-; and downcased symbols
-
-(in-package "XDOC")
-(include-book "tools/bstar" :dir :system)
-(set-state-ok t)
-(program)
-
-(defun fmt-to-str (x base-pkg state)
-
-; Use ACL2's fancy new string-printing stuff to pretty-print an object into a
-; string.
-
-  (b* ((hard-right-margin   (f-get-global 'acl2::fmt-hard-right-margin state))
-       (soft-right-margin   (f-get-global 'acl2::fmt-soft-right-margin state))
-       (print-case          (f-get-global 'acl2::print-case state))
-       (pkg                 (current-package state))
-       (state               (set-fmt-hard-right-margin 68 state))
-       (state               (set-fmt-soft-right-margin 62 state))
-       (state               (set-print-case :downcase state))
-
-       ((mv er ?val state)  (acl2::in-package-fn (symbol-package-name base-pkg) state))
-       ((when er)
-        (er hard? 'fmt-to-str "Error switching to package ~x0~%"
-            (symbol-package-name base-pkg))
-        (mv "" state))
-
-       ((mv channel state)  (open-output-channel :string :character state))
-       ((mv & state)        (fmt1 "~x0" (list (cons #\0 x)) 0 channel state nil))
-
-       ((mv er str state)  (get-output-stream-string$ channel state))
-       ((when er)
-        (er hard? 'fmt-to-str "Error with get-output-stream-string$???")
-        (mv "" state))
-
-       ((mv er ?val state) (acl2::in-package-fn pkg state))
-       ((when er)
-        (er hard? 'fmt-to-str "Error switching back to package ~x0~%" pkg)
-        (mv "" state))
-
-       (state               (set-fmt-hard-right-margin hard-right-margin state))
-       (state               (set-fmt-soft-right-margin soft-right-margin state))
-       (state               (set-print-case print-case state)))
-    (mv str state)))
-
-(defun simple-html-encode-str (x n xl acc)
-
-; Revappend the HTML encoding of X (e.g., & --> &amp;) onto ACC.
-
-  (b* (((when (int= n xl))
-        acc)
-       (char1 (char x n))
-       (acc   (case char1
-                (#\< (list* #\; #\t #\l #\& acc))         ;; "&lt;" (in reverse)
-                (#\> (list* #\; #\t #\g #\& acc))         ;; "&gt;"
-                (#\& (list* #\; #\p #\m #\a #\& acc))     ;; "&amp;"
-                (#\" (list* #\; #\t #\o #\u #\q #\& acc)) ;; "&quot;"
-                (t   (cons char1 acc)))))
-    (simple-html-encode-str x (+ 1 n) xl acc)))
-
-(defun fmt-and-encode-to-acc (x base-pkg state acc)
-  ;; Basic encoding of sexprs with no autolinking.
-  (b* (((mv str state) (fmt-to-str x base-pkg state))
-       (acc (simple-html-encode-str str 0 (length str) acc)))
-    (mv acc state)))
diff -Nru acl2-6.2/books/xdoc-impl/import-acl2doc.lisp acl2-6.3/books/xdoc-impl/import-acl2doc.lisp
--- acl2-6.2/books/xdoc-impl/import-acl2doc.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/import-acl2doc.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,201 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "ACL2") ;; So the acl2 topic comes from the acl2 package.
-(include-book "write-acl2-xdoc")
-(program)
-
-(defdoc broken-link
-  ;; Keep topic name in sync with write-acl2-xdoc.lisp
-  ":Doc-Section Documentation
-Placeholder for undocumented topics~/
-
-This topic is used as a placeholder in XDOC when an imported ACL2
-documentation topic (~pl[documentation]) topic, written in the classic
-~il[doc-string] format, links to an underfined topic.~/~/")
-
-#||
-
-;; To test broken-link handling, uncomment this and regenerate the manual.  We
-;; should be warned about the broken links, and they should take us to the
-;; broken-link topic.
-
-(defdoc broken-link-test
-  ":Doc-Section broken-link
-Test of broken links.  IL: ~il[test-broken-link]. ILC: ~ilc[test-broken-link].
-L: ~l[test-broken-link].  PL: ~pl[test-broken-link]~/
-
-This is a silly topic intended to test our linking to missing documentation.
-
-IL: ~il[test-broken-link]
-ILC: ~ilc[test-broken-link]
-L: ~l[test-broken-link]
-PL: ~pl[test-broken-link]~/~/")
-
-||#
-
-; Initial import of acl2 system documentation.  We do this before including any
-; books other than the basic portcullis, because we don't want any libraries
-; loaded when we import the system-level documentation.
-;
-; One other minor fixup: In ACL2, a top-level topic has a parent of itself.  We
-; change all such top-level topics so that they have a parent of acl2::acl2.
-
-#!XDOC
-(progn
-  (defun remove-alist-key (key x)
-    (cond ((atom x)
-           nil)
-          ((atom (car x))
-           (remove-alist-key key (cdr x)))
-          ((equal (caar x) key)
-           (remove-alist-key key (cdr x)))
-          (t
-           (cons (car x) (remove-alist-key key (cdr x))))))
-
-  (defun change-self-parent-to-acl2 (topic)
-    (let ((name    (cdr (assoc :name topic)))
-          (parents (cdr (assoc :parents topic))))
-      (if (member name parents)
-          (acons :parents
-                 (cons 'acl2::acl2 (remove-equal name parents))
-                 (remove-alist-key :parents topic))
-        topic)))
-
-  (defun change-self-parents-to-acl2 (topics)
-    (if (atom topics)
-        nil
-      (cons (change-self-parent-to-acl2 (car topics))
-            (change-self-parents-to-acl2 (cdr topics)))))
-
-  (defun all-topic-names (topics)
-    (if (atom topics)
-        nil
-      (cons (cdr (assoc :name (car topics)))
-            (all-topic-names (cdr topics)))))
-
-  (defun remove-topics-by-name (topics names)
-    (cond ((atom topics)
-           nil)
-          ((member (cdr (assoc :name (car topics))) names)
-           (remove-topics-by-name (cdr topics) names))
-          (t
-           (cons (car topics) (remove-topics-by-name (cdr topics) names)))))
-
-  (make-event
-   (mv-let (er val state)
-     (time$ (acl2::write-xdoc-alist)
-            :msg "; Importing ground-zero acl2 :doc topics: ~st sec, ~sa bytes~%"
-            :mintime 1)
-     (declare (ignore er val))
-     (let* ((topics (acl2::f-get-global 'acl2::xdoc-alist state))
-            (topics (change-self-parents-to-acl2 topics))
-            (names  (all-topic-names topics)))
-       (value `(progn
-                 (defconst *acl2-ground-zero-names* ',names)
-                 (defconst *acl2-ground-zero-topics* ',topics)))))))
-
-(include-book "../xdoc/base")
-(include-book "tools/bstar" :dir :system)
-
-#!XDOC
-;; Actually install the ground-zero topics
-(table xdoc 'doc
-
-; Something subtle about this is, what do we do if there is both an ACL2 :doc
-; topic and an XDOC topic?
-;
-; Originally we appended the *acl2-ground-zero-topics* to (get-xdoc-table
-; world), which meant that built-in ACL2 documentation "won" and overwrote the
-; xdoc documentation.  But when I documented the system/io.lisp book, I found
-; that this wasn't what I wanted, because it meant stupid tiny little
-; placeholder documentation for things like read-char$ was overwriting the much
-; nicer XDOC documentation for it.
-;
-; Arguably we should do some kind of smart merge, but, well, this *is* xdoc
-; after all.  So I'm just going to say ACL2 loses, and if someone cares enough
-; to come up with something better, power to them.
-
-       (append (get-xdoc-table world)
-               *acl2-ground-zero-topics*))
-
-(defxdoc acl2
-  :short "Documentation for the <a
-  href=\"http://www.cs.utexas.edu/users/moore/acl2\">ACL2 Theorem Prover</a>."
-  :long "<p>This is a parent topic for <see topic=\"@(url documentation)\">ACL2
-documentation</see> that is written in the classic @(see doc-string)
-format.</p>")
-
-
-#!XDOC
-(defmacro import-acl2doc ()
-  ;; This is for refreshing the documentation to reflect topics documented in
-  ;; libraries.  We throw away any ACL2-system topics that we've already had
-  ;; added to the xdoc table.
-  `(make-event
-    (mv-let (er val state)
-      (time$ (acl2::write-xdoc-alist :skip-topics *acl2-ground-zero-names*)
-             :msg "~|; Importing acl2 :doc topics: ~st sec, ~sa bytes~%"
-             :mintime 1)
-      (declare (ignore er val))
-      (let* ((topics (acl2::f-get-global 'acl2::xdoc-alist state))
-             ;(topics (time$ (remove-topics-by-name topics *acl2-ground-zero-names*)))
-             )
-        (value `(table xdoc 'doc
-                       (append ',topics (get-xdoc-table world))))))))
-
-
-; see bookdoc.lsp
-
-#!XDOC
-(defmacro maybe-import-bookdoc ()
-  `(make-event
-    (b* (((when (cdr (assoc 'bookdoc-loaded (table-alist 'xdoc (w state)))))
-          ;; (cw "~|; Already loaded bookdoc.dat.~%")
-          (value `(value-triple :invisible)))
-         (path (acl2::extend-pathname *xdoc-impl-dir* "bookdoc.dat" state))
-         ((mv channel state) (open-input-channel path :object state))
-         ((when (not channel))
-          (cw "~|XDOC Note: unable to load bookdoc.dat.  For more complete ~
-            documentation, you may wish to run 'make bookdoc.dat' in ~
-            acl2/books/xdoc.~%~%")
-          (value `(value-triple :invisible)))
-         ((mv state new-topics)
-          (time$
-           ;; bookdoc.lsp always writes the topics relative to the ACL2
-           ;; package, so we need to be sure to read them in that way.
-           (b* (((mv & & state) (acl2::set-current-package "ACL2" state))
-                ((mv & book-topics state)
-                 (read-object channel state))
-                (state (close-input-channel channel state))
-                (curr-topics (get-xdoc-table (w state)))
-                (book-names (all-topic-names book-topics))
-                (curr-names (all-topic-names curr-topics))
-                (dont-want  (intersection-equal book-names curr-names))
-                (book-keep  (remove-topics-by-name book-topics dont-want))
-                (new-topics (append book-keep curr-topics)))
-             (mv state new-topics))
-           :msg "~|; Loading bookdoc.dat: ~st sec, ~sa bytes.~%"
-           :mintime 1/2)))
-      (value `(progn
-                (table xdoc 'doc ',new-topics)
-                (table xdoc 'bookdoc-loaded t))))))
-
-
diff -Nru acl2-6.2/books/xdoc-impl/make-manual.acl2 acl2-6.3/books/xdoc-impl/make-manual.acl2
--- acl2-6.2/books/xdoc-impl/make-manual.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/make-manual.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(ld "cert.acl2")
-; cert-flags: ? t :ttags :all
-(certify-book "make-manual" ? t :ttags :all)
diff -Nru acl2-6.2/books/xdoc-impl/make-manual.lisp acl2-6.3/books/xdoc-impl/make-manual.lisp
--- acl2-6.2/books/xdoc-impl/make-manual.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/make-manual.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,29 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "ACL2")
-(include-book "all")
-(include-book "finite-set-theory/osets/sets" :dir :system)
-
-; (depends-on "bookdoc.dat")
-
-(defttag manual)
-(xdoc::save "manual")
-
diff -Nru acl2-6.2/books/xdoc-impl/mkdir-raw.acl2 acl2-6.3/books/xdoc-impl/mkdir-raw.acl2
--- acl2-6.2/books/xdoc-impl/mkdir-raw.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/mkdir-raw.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,26 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-;; BOZO shouldn't need this ttag if we can fix the sys-call issue
-;; for stupid-mkdir
-
-(ld "cert.acl2")
-; cert-flags: ? t :ttags :all
-(certify-book "mkdir-raw" ? t :ttags :all)
diff -Nru acl2-6.2/books/xdoc-impl/mkdir-raw.lisp acl2-6.3/books/xdoc-impl/mkdir-raw.lisp
--- acl2-6.2/books/xdoc-impl/mkdir-raw.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/mkdir-raw.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,50 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-; mkdir-raw.lisp
-;
-; This book requires a TTAG.  You should not need to directly include it unless
-; you actually need to run mkdir, as in xdoc::save.  Ordinarily this is handled
-; by the macros in top.lisp.
-
-(in-package "XDOC")
-(include-book "mkdir")
-(include-book "tools/bstar" :dir :system)
-(set-state-ok t)
-
-(defttag :xdoc)
-
-(progn!
- (set-raw-mode t)
- (defun mkdir (dir state)
-   (b* (((unless (stringp dir))
-         (er hard? 'mkdir "Dir must be a string, but is: ~x0.~%" dir)
-         state)
-        (- (sys-call "mkdir" (list "-p" dir)))
-        ((mv status state)
-         (sys-call-status state))
-        ((unless (= status 0))
-         (er hard? 'mkdir "error making directory ~s0.~%" dir)
-         state))
-     state)))
-
-(defttag nil)
-
diff -Nru acl2-6.2/books/xdoc-impl/mkdir.lisp acl2-6.3/books/xdoc-impl/mkdir.lisp
--- acl2-6.2/books/xdoc-impl/mkdir.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/mkdir.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "XDOC")
-(set-state-ok t)
-
-; BOZO the real definition of mkdir is found in mkdir-raw.lisp.  We write this
-; stub so that books like save.lisp and display.lisp don't need ttags.  But the
-; top-level save command has to remember to load the mkdir-raw book so that the
-; under-the-hood definition can be loaded.
-
-(defun mkdir (dir state)
-  (declare (xargs :guard (stringp dir))
-           (ignorable dir))
-  (prog2$
-   (er hard? 'mkdir "raw lisp definition not yet installed.")
-   state))
-
diff -Nru acl2-6.2/books/xdoc-impl/parse-xml.lisp acl2-6.3/books/xdoc-impl/parse-xml.lisp
--- acl2-6.2/books/xdoc-impl/parse-xml.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/parse-xml.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,385 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "XDOC")
-(include-book "preprocess")
-(set-state-ok t)
-(program)
-
-
-; (PARSE-XML X) --> (MV ERR TOKENS)
-;
-; This is an extremely primitive XML lexer.  It is incomplete, doesn't support
-; unicode, and probably is dead wrong as far as the XML standard is concerned.
-; But, it's adequate for XDOC stuff.
-;
-; X should be an XML-formatted string (with no preprocessor stuff).  We break
-; it into a list of tokens, which may be any of the following:
-;
-;    (:OPEN STR ALIST) represents <tag [... atts ...]>
-;
-;       - STR is a string that is the tag name, e.g., "p" for <p>
-;
-;       - ALIST is an alist of the attribute.  Each entry is either:
-;            (KEY-STR . VAL-STR)   for ordinary key="val" style atts
-;            (KEY-STR . NIL)       for value-free atts like <hr noshade>
-;
-;    (:CLOSE STR) represents </tag>
-;
-;       - STR is a string that is the tag name, e.g., "p" for </p>
-;
-;    (:TEXT STR) represents ordinary text
-;
-;       - STR is the contents of the text.  This is ordinary text with no
-;         embedded tags or entities.
-;
-;    (:ENTITY TYPE) represents entities like &amp;
-;
-;      - TYPE is :AMP, :LT, :GT, :APOS, :NBSP, :MDASH, or :RARR
-
-(defconst *nls* (coerce (list #\Newline) 'string))
-
-(defun read-until (x n xl stop-chars acc)
-  ;; Accumulate chars until one of the stop-chars is seen
-  "Returns (MV FOUNDP N ACC)"
-  (b* (((when (>= n xl))
-        (mv nil n acc))
-       (char-n (char x n))
-       ((when (member char-n stop-chars))
-        (mv t n acc)))
-    (read-until x (+ 1 n) xl stop-chars (cons char-n acc))))
-
-(defun read-name-aux (x n xl acc)
-  ;; For attribute/tag names.  We just expect alphanumeric characters.  This is
-  ;; probably horribly wrong as far as the XML spec is concerned, but should be
-  ;; reasonable for all the tag and attribute names in xdoc.
-  "Returns (MV N ACC)"
-  (b* (((when (>= n xl))
-        (mv n acc))
-       (char-n (char x n))
-       ((when (or (and (char<= #\a char-n) (char<= char-n #\z))
-                  (and (char<= #\Z char-n) (char<= char-n #\Z))
-                  (and (char<= #\0 char-n) (char<= char-n #\9))
-                  (eql char-n #\_)
-                  (eql char-n #\-)
-                  ))
-        (read-name-aux x (+ 1 n) xl (cons char-n acc))))
-    (mv n acc)))
-
-(defun read-name (x n xl)
-  ;; Try to read an attribute/tag name at the current spot.
-  "Returns (MV ERR N NAME-STR)"
-  (b* (((mv n rchars)
-        (read-name-aux x n xl nil))
-       ((unless (consp rchars))
-        (mv (str::cat "Expected a name, but found unexpected character "
-                      (coerce (list (char x n)) 'string) *nls*
-                      "Nearby text: {" (error-context x n xl) "}" *nls*)
-            n nil))
-       (str (reverse (coerce rchars 'string))))
-    (mv nil n str)))
-
-(defun read-attrval (x n xl)
-  ;; Try to read "value" or 'value' at the current spot.
-  "Returns (MV ERR N VAL-STR)"
-  (b* ((saved-n n)
-       (quote-char (char x n))
-       ((unless (or (eql quote-char #\")
-                    (eql quote-char #\')))
-        (mv (str::cat "Expected value to start with a quote, but found "
-                      (coerce (list (char x n)) 'string) *nls*
-                      "Nearby text: {" (error-context x n xl) "}" *nls*)
-            n nil))
-       (n (+ 1 n)) ;; eat the quote-char
-       ((mv found-endp n chars)
-        (read-until x n xl (list quote-char) nil))
-       ((unless found-endp)
-        (mv (str::cat "Attribute value never ends." *nls*
-                      "Nearby text: {" (error-context x saved-n xl) "}" *nls*)
-            n nil))
-       (n (+ n 1)) ;; eat the closing quote-char
-       (val-str (reverse (coerce chars 'string))))
-    (mv nil n val-str)))
-
-(defun read-tag-attributes (x n xl tag-start-n atts)
-  ;; Assumes "<foo" and perhaps some attributes have just been read.
-  ;; Reads through the closing > or />, setting CLOSEP=T if we read />
-  ;; as in <br/>.
-  "Returns (MV ERR N ATTS CLOSEP)"
-  (b* ((n (skip-past-ws x n xl))
-       ((when (>= n xl))
-        (mv (str::cat "Tag never closes." *nls*
-                      "Nearby text: {" (error-context x tag-start-n xl) "}" *nls*)
-            n nil nil))
-       ((when (eql (char x n) #\>))
-        ;; End of tag via >
-        (mv nil (+ 1 n) atts nil))
-       ((when (eql (char x n) #\/))
-        ;; It had better be />.
-        (b* ((n (+ 1 n))
-             ((unless (and (< n xl)
-                           (eql (char x n) #\>)))
-              (mv (str::cat "Stray / in tag." *nls*
-                            "Nearby text: {" (error-context x tag-start-n xl) "}" *nls*)
-                  n nil nil)))
-          (mv nil (+ 1 n) atts t)))
-       ;; We should now be at the start of some new attribute.
-       ((mv err n key1) (read-name x n xl))
-       ((when err)
-        (mv err n nil nil))
-       (n (skip-past-ws x n xl))
-       ((when (>= n xl))
-        (mv (str::cat "Tag never closes." *nls*
-                      "Nearby text: {" (error-context x tag-start-n xl) "}" *nls*)
-            n nil nil))
-       ((unless (eql (char x n) #\=))
-        ;; I guess this is okay for things like "noshade" that don't have an
-        ;; associated value.
-        (read-tag-attributes x n xl tag-start-n (acons key1 nil atts)))
-       (n (+ n 1)) ;; eat the =
-       (n (skip-past-ws x n xl))
-       ((mv err n val1) (read-attrval x n xl))
-       ((when err)
-        (mv err n nil nil)))
-    (read-tag-attributes x n xl tag-start-n (acons key1 val1 atts))))
-
-(defun read-close-tag (x n xl)
-  ;; Assumes </ has just been read.
-  ;; Reads through the closing >.
-  "Returns (MV ERR N TOKEN-LIST)"
-  (b* ((saved-n n)
-       (n (skip-past-ws x n xl))
-       ((mv err n name) (read-name x n xl))
-       ((when err)
-        (mv err n nil))
-       (n (skip-past-ws x n xl))
-       ((unless (eql (char x n) #\>))
-        (mv (str::cat "Invalid closing tag." *nls*
-                      "Nearby text: {" (error-context x saved-n xl) "}" *nls*)
-            n nil))
-       (n (+ 1 n)) ;; eat the final >
-       (close (list :CLOSE name)))
-    (mv nil n (list close))))
-
-(defun skip-declaration (x n xl start-n)
-  ;; Read through ?>
-  "Returns (MV ERR N NIL)"
-  (b* (((when (>= (- n 1) xl))
-        (mv (str::cat "<? ... ?> declaration never closes." *nls*
-                      "Nearby text: {" (error-context x start-n xl) "}" *nls*)
-            n nil))
-       ((unless (and (eql (char x n) #\?)
-                     (eql (char x (+ n 1)) #\>)))
-        (skip-declaration x (+ n 1) xl start-n)))
-    (mv nil (+ n 2) nil)))
-
-(defun skip-entity-stuff (x n xl start-n)
-  ;; Read through ]>
-  "Returns (MV ERR N NIL)"
-  (b* (((when (>= (- n 1) xl))
-        (mv (str::cat "<! ... ]> declaration never closes." *nls*
-                      "Nearby text: {" (error-context x start-n xl) "}" *nls*)
-            n nil))
-       ((unless (and (eql (char x n) #\])
-                     (eql (char x (+ n 1)) #\>)))
-        (skip-entity-stuff x (+ n 1) xl start-n)))
-    (mv nil (+ n 2) nil)))
-
-(defun read-tag (x n xl)
-  ;; Assumes (char x n) is "<"
-  "Returns (MV ERR N TOKEN-LIST)"
-  (b* ((tag-start-n n)
-       (n (+ 1 n))
-       (n (skip-past-ws x n xl))
-       ((when (>= n xl))
-        (mv (str::cat "Tag never closes." *nls*
-                      "Nearby text: {" (error-context x tag-start-n xl) "}" *nls*)
-            n nil))
-       ((when (eql (char x n) #\?))
-        (skip-declaration x n xl tag-start-n))
-       ((when (eql (char x n) #\!))
-        (skip-entity-stuff x n xl tag-start-n))
-       ((when (eql (char x n) #\/))
-        (read-close-tag x (+ 1 n) xl))
-       ;; Else, it's an opening tag.  This should be its name.
-       ((mv err n name)
-        (read-name x n xl))
-       ((when err)
-        (mv err n nil))
-       ((mv err n atts closep)
-        (read-tag-attributes x n xl tag-start-n nil))
-       ((when err)
-        (mv err n nil))
-       (open (list :OPEN name (reverse atts)))
-       ((when (not closep))
-        (mv nil n (list open)))
-       (close (list :CLOSE name)))
-    (mv nil n (list open close))))
-
-(defun read-entity (x n xl)
-  ;; Assumes (char x n) is "&"
-  "Returns (MV ERR N TOK)"
-  (b* ((saved-n n)
-       (n (+ 1 n)) ;; eat the &
-       ((mv foundp n rchars)
-        (read-until x n xl (list #\;) nil))
-       ((unless foundp)
-        (mv (str::cat "Entity does not have a closing semicolon." *nls*
-                      "Nearby text: {" (error-context x saved-n xl) "}" *nls*)
-            n nil))
-       (n (+ 1 n)) ;; eat the ;
-       (str (reverse (coerce rchars 'string)))
-       ((when (equal str "amp"))  (mv nil n '(:ENTITY :AMP)))
-       ((when (equal str "lt"))   (mv nil n '(:ENTITY :LT)))
-       ((when (equal str "gt"))   (mv nil n '(:ENTITY :GT)))
-       ((when (equal str "quot")) (mv nil n '(:ENTITY :QUOT)))
-       ((when (equal str "apos")) (mv nil n '(:ENTITY :APOS)))
-       ((when (equal str "nbsp")) (mv nil n '(:ENTITY :NBSP)))
-       ((when (equal str "mdash")) (mv nil n '(:ENTITY :MDASH)))
-       ((when (equal str "rarr")) (mv nil n '(:ENTITY :RARR))))
-    (mv (str::cat "Unsupported entity: &" str ";" *nls*
-                  "Nearby text: {" (error-context x saved-n xl) "}" *nls*)
-        n nil)))
-
-(defun parse-xml-aux (x n xl acc)
-  "Returns (MV ERR TOKENS)"
-  (b* (((when (>= n xl))
-        (mv nil acc))
-       (char-n (char x n))
-       ((when (eql char-n #\<))
-        ;; Open/closing tag
-        (b* (((mv err n token-list) (read-tag x n xl))
-             ((when err)
-              (mv err nil))
-             (acc (revappend token-list acc)))
-          (parse-xml-aux x n xl acc)))
-       ((when (eql char-n #\&))
-        ;; Entity
-        (b* (((mv err n token) (read-entity x n xl))
-             ((when err)
-              (mv err nil)))
-          (parse-xml-aux x n xl (cons token acc))))
-       ((when (eql char-n #\>))
-        (mv (str::cat "Stray end-of-tag character '>'" *nls*
-                      "Nearby text: {" (error-context x n xl) "}" *nls*)
-            nil))
-       ;; Otherwise, plain text.
-       ((mv ?foundp n rchars)
-        (read-until x n xl '(#\< #\& #\>) nil))
-       (token (list :TEXT (reverse (coerce rchars 'string)))))
-    (parse-xml-aux x n xl (cons token acc))))
-
-
-; Basic tag balance checking with nice error reporting
-
-(defun opentok-p (x) (eq (first x) :OPEN))
-(defun opentok-name (x) (second x))
-(defun opentok-atts (x) (third x))
-
-(defun closetok-p (x) (eq (first x) :CLOSE))
-(defun closetok-name (x) (second x))
-
-(defun entitytok-p (x) (eq (first x) :ENTITY))
-(defun entitytok-type (x) (second x))
-
-(defun texttok-p (x) (eq (first x) :TEXT))
-(defun texttok-text (x) (second x))
-
-(defun entitytok-as-entity (x)
-  (case (entitytok-type x)
-    (:AMP   "&amp;")
-    (:LT    "&lt;")
-    (:GT    "&gt;")
-    (:QUOT  "&quot;")
-    (:APOS  "&apos;")
-    (:NBSP  "&nbsp;")
-    (:MDASH "&mdash;")
-    (:RARR  "&rarr;")
-    ))
-
-(defun entitytok-as-plaintext (x)
-  (case (entitytok-type x)
-    (:AMP   "&")
-    (:LT    "<")
-    (:GT    ">")
-    (:QUOT  "\"")
-    (:APOS  "'")
-    (:NBSP  " ")
-    (:MDASH "---")
-    (:RARR  "-->")))
-
-(defun flatten-token-for-errormsg (x)
-  (cond ((opentok-p x)
-         (str::cat "<" (opentok-name x)
-                   (if (opentok-atts x) " [...]>" ">")))
-        ((closetok-p x)
-         (str::cat "</" (closetok-name x) ">"))
-        ((entitytok-p x)
-         (entitytok-as-entity x))
-        ((texttok-p x)
-         (texttok-text x))
-        (t
-         (er hard? 'flatten-token-for-errormsg "Invalid token ~x0" x))))
-
-(defun flatten-tokens-for-errormsg (x)
-  (if (atom x)
-      ""
-    (str::cat (flatten-token-for-errormsg (car x))
-              (flatten-tokens-for-errormsg (cdr x)))))
-
-(defun find-tag-imbalance (x open-tags loc)
-  "Returns (MV ERROR/NIL LOC/NIL)"
-  (b* (((when (atom x))
-        (mv (if open-tags
-                (str::cat (opentok-name (car open-tags)) " tag is never closed.")
-              nil)
-            nil))
-       ((when (opentok-p (car x)))
-        (find-tag-imbalance (cdr x) (cons (car x) open-tags) (+ 1 loc)))
-       ((when (closetok-p (car x)))
-        (b* ((close-name (closetok-name (car x)))
-             ((unless (consp open-tags))
-              (mv (str::cat "Found </" close-name "> with no matching opening tag.")
-                  loc))
-             (open-name (opentok-name (car open-tags)))
-             ((unless (equal close-name open-name))
-              (mv (str::cat "Found <" open-name "> with mismatched </" close-name ">.")
-                  loc)))
-          (find-tag-imbalance (cdr x) (cdr open-tags) (+ 1 loc)))))
-    (find-tag-imbalance (cdr x) open-tags (+ 1 loc))))
-
-(defun parse-xml (x)
-  (declare (type string x))
-  (b* (((mv err rtokens) (parse-xml-aux x 0 (length x) nil))
-       ((when err)
-        (mv err nil))
-       (tokens (reverse rtokens))
-       ((mv err loc) (find-tag-imbalance tokens nil 0))
-       ((when err)
-        (b* (((when (not loc))
-              (mv err nil))
-             (back-one  (max 0 (- loc 4)))
-             (start-ctx (nthcdr back-one tokens))
-             (context   (take (min 8 (len start-ctx)) start-ctx))
-             (nearby    (flatten-tokens-for-errormsg context)))
-          (mv (str::cat err "
-Nearby text: {" nearby "}" *nls*)
-              nil))))
-    (mv err tokens)))
diff -Nru acl2-6.2/books/xdoc-impl/portcullis.acl2 acl2-6.3/books/xdoc-impl/portcullis.acl2
--- acl2-6.2/books/xdoc-impl/portcullis.acl2	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/portcullis.acl2	1970-01-01 00:00:00.000000000 +0000
@@ -1,24 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(ld "xdoc/package.lsp" :dir :system)
-(ld "str/package.lsp" :dir :system)
-; cert-flags: ? t :ttags :all
-(certify-book "portcullis" ? t :ttags :all)
diff -Nru acl2-6.2/books/xdoc-impl/portcullis.lisp acl2-6.3/books/xdoc-impl/portcullis.lisp
--- acl2-6.2/books/xdoc-impl/portcullis.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/portcullis.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,30 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-; portcullis.lisp
-;
-; This book gets included by cert.acl2, rather than directly putting in the
-; declaration of the xdoc package.  This way, the resulting .cert files for
-; the other xdoc books just contain an (include-book "portcullis") command,
-; rather than the whole package declaration for the XDOC package.
-
-(in-package "XDOC")
-
diff -Nru acl2-6.2/books/xdoc-impl/preprocess.lisp acl2-6.3/books/xdoc-impl/preprocess.lisp
--- acl2-6.2/books/xdoc-impl/preprocess.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/preprocess.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,1056 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-; preprocess.lisp  -- the xdoc preprocessor
-
-(in-package "XDOC")
-(include-book "autolink")
-(include-book "str/top" :dir :system)
-(local (include-book "misc/assert" :dir :system))
-(set-state-ok t)
-(program)
-
-
-
-; ----------------- World Lookup Stuff --------------------------
-
-(defun get-formals (fn world)
-  (let ((formals (getprop fn 'formals :bad 'current-acl2-world world)))
-    (if (not (eq formals :bad))
-        formals
-      (let ((macro-args (getprop fn 'macro-args :bad 'current-acl2-world world)))
-        (if (not (eq macro-args :bad))
-            macro-args
-          (prog2$
-           (cw "; xdoc note: get-formals failed for ~s0::~s1.~%"
-               (symbol-package-name fn) (symbol-name fn))
-           (concatenate 'string
-                        "Error getting formals for "
-                        (symbol-package-name fn)
-                        "::"
-                        (symbol-name fn))))))))
-
-(defun get-measure (fn world)
-  (let ((just (getprop fn 'justification nil 'current-acl2-world world)))
-    (if just
-        (access justification just :measure)
-      (or (cw "; xdoc note: get-measure failed for ~x0.~%" fn)
-          (concatenate 'string
-                       "Error getting measure for "
-                       (symbol-package-name fn)
-                       "::"
-                       (symbol-name fn))))))
-
-(defun get-guard (fn world)
-  (if (not (eq (getprop fn 'formals :bad 'current-acl2-world world) :bad))
-      (getprop fn 'guard nil 'current-acl2-world world)
-    (prog2$
-     (cw "; xdoc note: get-guard failed for ~x0.~%" fn)
-     (concatenate 'string
-                  "Error getting guard for "
-                  (symbol-package-name fn)
-                  "::"
-                  (symbol-name fn)))))
-
-(defun get-body (fn world)
-  ;; This gets the original body normalized or non-normalized body based on
-  ;; what the user typed for the :normalize xarg.  The use of "last" skips past
-  ;; any other :definition rules that have been added since then.
-  (let ((bodies (getprop fn 'def-bodies nil 'current-acl2-world world)))
-    (if bodies
-        (access def-body (car (last bodies)) :concl)
-      (or (cw "; xdoc note: get-body failed for ~x0.~%" fn)
-          (concatenate 'string
-                       "Error getting body for "
-                       (symbol-package-name fn)
-                       "::"
-                       (symbol-name fn))))))
-
-
-(defun eat-things-from-event (keys event)
-  ;; EVENT might be something like (DEFTHM FOO :HINTS ... :RULE-CLASSES ...)
-  ;; KEYS is a list of things we want to remove, e.g., it might contain HINTS.
-  ;; We look for members of keys and eat them and their associated values.
-  (cond ((atom event)
-         event)
-        ((atom (cdr event))
-         event)
-        ((member (car event) keys)
-         (eat-things-from-event keys (cddr event)))
-        (t
-         (cons (car event) (eat-things-from-event keys (cdr event))))))
-
-(defun clean-up-xargs (xargs)
-  ;; Xargs is like (xargs :guard t :verify-guards nil ...) from a function declaration
-  ;; I leave in :guard, :stobjs, and :non-executable since those are possibly of interest...
-  (eat-things-from-event '(:guard-hints :guard-debug :hints :measure :ruler-extenders :mode
-                                        :normalize :otf-flg :verify-guards :well-founded-relation)
-                         xargs))
-
-(defun clean-up-function-decl-item (item)
-  ;; Item is like (xargs ...) or (integer foo) or whatever; it's something that occurs
-  ;; in a declaration.  I'll leave in type declarations.
-  (cond ((and (consp item)
-              (eq (car item) 'xargs))
-         (let ((clean-xargs (clean-up-xargs (cdr item))))
-           (if clean-xargs
-               (cons 'xargs clean-xargs)
-             nil)))
-        (t
-         item)))
-
-(defun clean-up-function-decl-items (items)
-  (if (consp items)
-      (let ((clean1 (clean-up-function-decl-item (car items)))
-            (rest   (clean-up-function-decl-items (cdr items))))
-        (if clean1
-            (cons clean1 rest)
-          rest))
-    items))
-
-(defun clean-up-function-decl (decl)
-  ;; DECL is like (declare (xargs ...) (type string ...)) etc.
-  (cond ((and (consp decl)
-              (eq (car decl) 'declare))
-         (let ((items (clean-up-function-decl-items (cdr decl))))
-           (if items
-               (cons 'declare items)
-             nil)))
-        ((stringp decl)
-         ;; drop doc-strings, but leave other string documentation
-         (if (str::istrprefixp ":doc-section" decl)
-             nil
-           decl))
-        (t
-         decl)))
-
-(defun clean-up-function-decls (decls)
-  (if (consp decls)
-      (let ((clean1 (clean-up-function-decl (car decls)))
-            (rest   (clean-up-function-decls (cdr decls))))
-        (if clean1
-            (cons clean1 rest)
-          rest))
-    decls))
-
-(defun clean-up-event (event)
-  (if (atom event)
-      event
-    (case (car event)
-      (defthm
-        ;; I'll leave in the rule-classes, since they're probably important.
-        (eat-things-from-event '(:hints :instructions :doc :otf-flg) event))
-      (defun
-        (let ((name    (second event))
-              (formals (third event))
-              (decls   (clean-up-function-decls (butlast (cdddr event) 1)))
-              (body    (car (last event))))
-          (if decls
-              (append (list 'defun name formals)
-                      decls
-                      (list body))
-            (list 'defun name formals body))))
-      (defmacro
-        (let ((name    (second event))
-              (formals (third event))
-              (decls   (clean-up-function-decls (butlast (cdddr event) 1)))
-              (body    (car (last event))))
-          (if decls
-              (append (list 'defmacro name formals) decls (list body))
-            (list 'defmacro name formals body))))
-      (otherwise
-       event))))
-
-(defun get-event-aux (name world)
-  ;; A general purpose event lookup as in :pe
-  (let* ((props (acl2::getprops name 'current-acl2-world world))
-        (evt   (and props (acl2::get-event name world))))
-    (or evt
-        (cw "; xdoc note: get-event failed for ~x0.~%" name)
-        (concatenate 'string
-                     "Error getting event for "
-                     (symbol-package-name name)
-                     "::"
-                     (symbol-name name)))))
-
-(defun get-event (name world)
-  (clean-up-event (get-event-aux name world)))
-
-#|
-
-(get-event-aux 'append (w state))
-(get-event 'append (w state))
-
-(get-event-aux 'binary-append (w state))
-(get-event 'binary-append (w state))
-
-(get-event-aux 'write-byte$ (w state))
-(get-event 'write-byte$ (w state))
-
-(defun UGLY (X)
-  (DECLARE
-   (XARGS :GUARD T
-          :GUARD-HINTS (("Goal" :USE ((:INSTANCE DEFAULT-CAR))))
-          :VERIFY-GUARDS NIL))
-  (IF (CONSP X) (UGLY (CDR X)) 0))
-
-(get-event-aux 'ugly (w state))
-(get-event 'ugly (w state))
-
-(xml-ppr-obj (get-event 'ugly (w state))
-             state
-             :topics-fal (make-fast-alist '((acl2::consp . t)
-                                            (acl2::defun . t)
-                                            (acl2::declare . t)
-                                            (acl2::xargs . t)
-                                            (xdoc::ugly . t)
-                                            (acl2::cdr . t)))
-             :base-pkg 'xdoc::foo)
-
-|#
-
-(defun get-def (fn world)
-  (get-event fn world))
-
-(defun get-theorem (name world)
-  ;; BOZO maybe do some cleaning to remove hints, etc.
-  (get-event name world))
-
-;; (defmacro foo ()
-;;   `(progn (logic)
-;;           (make-event
-;;            '(encapsulate
-;;               (((h *) => *))
-;;               (local (defun h (x) (+ x 1)))
-;;               (defun f (x) (+ x 1))
-;;               (defun g (x) (+ x 2))))))
-
-;; (defstobj st fld)
-
-;; (defun-sk all-integerp (x)
-;;   (forall a (implies (member-equal a x)
-;;                      (integerp a))))
-
-;; (defconst *const* 3)
-
-;; (foo)
-
-;; (get-event 'undefined (w state)) ; good, fails
-;; (get-event 'append (w state))
-;; (get-event 'binary-append (w state))
-;; (get-event 'st (w state))
-;; (get-event 'fld (w state)) ;; bad? returns the whole stobj
-;; (get-event 'all-integerp (w state))
-;; (get-event 'all-integerp-witness (w state)) ;; good i guess - returns the encapsulate
-;; (get-event 'f (w state))
-;; (get-event 'h (w state)) ;; good i guess, returns the encapsulate
-;; (get-event 'acl2::car-cons (w state))
-;; (get-event '*const* (w state))
-
-;; (get-formals 'binary-append (w state))  ;; --> (ACL2::X ACL2::Y)
-;; (get-formals 'append (w state)) ;; --> (ACL2::X ACL2::Y &REST ACL2::RST)
-;; (get-formals 'all-integerp-witness (w state)) ;; good, works
-;; (get-formals 'all-integerp (w state)) ;; good, works
-;; (get-formals 'fld (w state)) ;; good, works
-;; (get-formals 'st (w state)) ;; good, fails
-
-;; (get-measure 'binary-append (w state)) ;; good, works
-;; (get-measure 'append (w state))  ;; good, fails
-;; (get-measure 'st (w state)) ;; good, fails
-;; (get-measure 'fld (w state)) ;; good, fails
-;; (get-measure 'all-integerp-witness (w state)) ;; good, fails
-;; (get-measure 'all-integerp (w state)) ;; good, fails
-
-;; (get-guard 'binary-append (w state)) ;; good, works
-;; (get-guard 'append (w state)) ;; hrmn -- fails?
-;; (get-guard 'all-integerp-witness (w state)) ;; NIL???
-;; (get-guard 'all-integerp (w state)) ;; NIL???
-;; (get-guard 'fld (w state)) ;; works
-;; (get-guard 'st (w state)) ;; good, fails
-
-
-
-
-
-
-
-
-
-
-
-; -------------- Preprocessor Command Parsing  ------------------
-
-
-; Convention: X is a string we are traversing, N is our current position in the
-; string, and XL is the length of the string.  See autolink.lisp.
-
-(defun read-literal (x n xl chars) ;; ==> (MV SUCCESSP N-PRIME)
-  ;; Try to read CHARS, verbatim.
-  (declare (type string x))
-  (cond ((= n xl)
-         (mv (atom chars) n))
-        ((consp chars)
-         (if (eql (char x n) (car chars))
-             (read-literal x (+ n 1) xl (cdr chars))
-           (mv nil n)))
-        (t
-         (mv t n))))
-
-(defun read-through-some-char-aux (x n xl chars acc) ;; ==> (MV SUCCESSP STRING N-PRIME)
-  (declare (type string x))
-  (if (= xl n)
-      (mv nil (reverse (coerce acc 'string)) n)
-    (let ((charN (char x n)))
-      (if (member charN chars)
-          (mv t (reverse (coerce (cons charN acc) 'string)) n)
-        (read-through-some-char-aux x (+ 1 n) xl chars (cons charN acc))))))
-
-(defun read-through-some-char (x n xl chars)
-  ;; Try to read until one of CHARS is found
-  (declare (type string x))
-  (read-through-some-char-aux x n xl chars nil))
-
-(defun skip-past-ws (x n xl) ;; ==> N-PRIME
-  (declare (type string x))
-  (cond ((= xl n)
-         n)
-        ((member (char x n) '(#\Space #\Tab #\Newline #\Page))
-         (skip-past-ws x (+ 1 n) xl))
-        (t
-         n)))
-
-(defun parse-directive (x n xl base-pkg kpa) ;; ==> (MV ERROR COMMAND ARG N-PRIME)
-  ;; Every directive has the form @(command arg)
-  ;; Where command and arg are symbols.
-  ;; We assume @( has just been read, and N is now pointing right after the open paren.
-  (declare (type string x))
-  (b* ((n                    (skip-past-ws x n xl))
-       ;; We want to get nice error messages here, because if there'a a directive we
-       ;; really do expect it to be a valid symbol.
-       ((mv error command n) (parse-symbol x n xl (pkg-witness "XDOC") kpa t))
-       ((when error)
-        (mv error nil nil n))
-       (n                    (skip-past-ws x n xl))
-       ((mv error arg n)     (parse-symbol x n xl base-pkg kpa t)))
-      (cond
-       ;; Some error parsing arg.  Add a little more context.
-       (error (mv (concatenate 'string "In " (symbol-name command) " directive: " error)
-                  nil nil n))
-
-       ;; Ends with ), good.
-       ((and (< n xl)
-             (eql (char x n) #\)))
-        (mv nil command arg (+ n 1)))
-
-       (t
-        (mv (concatenate 'string "In " (symbol-name command) " directive, expected ) after "
-                         (symbol-name arg)
-                         ". Near " (error-context x n xl) ".")
-            nil nil n)))))
-
-;; (let ((x "body foo)"))
-;;   (parse-directive x 0 (length x) 'acl2::foo))
-
-;; (let ((x "body foo) bar"))
-;;   (parse-directive x 0 (length x) 'acl2::foo))
-
-;; (let ((x "body xdoc::foo) bar"))
-;;   (parse-directive x 0 (length x) 'acl2::foo))
-
-;; (let ((x "xdoc::body xdoc::foo) bar"))
-;;   (parse-directive x 0 (length x) 'acl2::foo))
-
-;; (let ((x "acl2::body xdoc::foo) bar"))
-;;   (parse-directive x 0 (length x) 'acl2::foo))
-
-;; (let ((x "acl2::body)xdoc::foo) bar"))
-;;   (parse-directive x 0 (length x) 'acl2::foo))
-
-
-
-
-; -------------- Executing Directives ---------------------------
-
-(defun process-url-directive (arg state acc) ;; ===> (MV ACC STATE)
-
-; @(url foo) just expands into the file name for foo.
-
-  (b* ((acc            (file-name-mangle arg acc)))
-      (mv acc state)))
-
-
-(defun process-sym-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(sym foo) just expands into the standard name mangling for foo
-
-  (b* ((acc            (sym-mangle arg base-pkg acc)))
-      (mv acc state)))
-
-
-(defun process-sym-cap-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(csym foo) just expands into the standard capitalized name mangling for foo
-
-  (b* ((acc            (sym-mangle-cap arg base-pkg acc)))
-      (mv acc state)))
-
-
-(defun process-see-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(see foo) just expands into a link with a lowercase name.
-
-  (b* ((acc            (str::revappend-chars "<see topic=\"" acc))
-       (acc            (file-name-mangle arg acc))
-       (acc            (str::revappend-chars "\">" acc))
-       (acc            (sym-mangle arg base-pkg acc))
-       (acc            (str::revappend-chars "</see>" acc)))
-      (mv acc state)))
-
-
-(defun process-see-cap-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(csee foo) just expands into a link with a capitalized name.
-
-  (b* ((acc            (str::revappend-chars "<see topic=\"" acc))
-       (acc            (file-name-mangle arg acc))
-       (acc            (str::revappend-chars "\">" acc))
-       (acc            (sym-mangle-cap arg base-pkg acc))
-       (acc            (str::revappend-chars "</see>" acc)))
-      (mv acc state)))
-
-
-(defconst *xdoc-link-file-message*
-  "; This is an XDOC Link file.
-; Ordinarily, you should not see this file.
-;
-; If you are viewing this file in a web browser, you probably
-; have not configured your web browser to send .xdoc-link files
-; to Emacs.
-;
-;   (Or, if you have already done that, but you accessed this
-;    file through a web server, the server may just not be
-;    assigning .xdoc-link files the appropriate MIME type.)
-;
-; If you are viewing this file in Emacs, you probably have not
-; loaded xdoc.el from the xdoc/ directory.
-;
-; Please see the XDOC manual for more information.")
-
-(defun process-srclink-directive (arg dir state acc) ;; ===> (MV ACC STATE)
-
-; We do two things:
-;
-;   1. Extend acc with a srclink tag, and
-;
-;   2. Write a .xdoc-link file to dir for this tag, unless DIR is NIL in
-;      which case we skip this step
-;
-; This is kind of ugly in that we may write the same .xdoc-link file many
-; times, but this doesn't seem to practically be a problem.
-;
-; Our emacs linking mechanism is slightly broken, in that all we can tell emacs
-; is the name of a symbol to look for using its tags mechanism.  We are hoping
-; that:
-;
-;   1. The user has the appropriate TAGS tables set up (reasonable),
-;
-;   2. The symbol is actually defined in a source file somewhere, instead of
-;      being introduced by a macro or something, and
-;
-;   3. The symbol is not defined in multiple packages, so that the user will be
-;      taken to the right source file.  (That is, we can't tell emacs something
-;      like "foo::bar", because it doesn't understand (in-package ...); We can
-;      only tell it to search for bar.)
-;
-; Whether or not #2 and #3 hold is a total crap-shoot, and we're basically
-; hoping that most of the time find-tag will take them to the right place.
-
-  (b* ((shortname (coerce (string-downcase (symbol-name arg)) 'list))
-       (filename  (concatenate 'string
-                               (reverse (coerce (file-name-mangle arg nil) 'string))
-                               ".xdoc-link"))
-
-       (acc (str::revappend-chars "<srclink file=\"" acc))
-       (acc (str::revappend-chars filename acc))
-       (acc (str::revappend-chars "\">" acc))
-       (acc (simple-html-encode-chars shortname acc))
-       (acc (str::revappend-chars "</srclink>" acc))
-
-       ((unless dir)
-        (mv acc state))
-
-       (fullpath           (acl2::extend-pathname dir filename state))
-       ((mv channel state) (open-output-channel fullpath :character state))
-       (state (princ$ *xdoc-link-file-message* channel state))
-       (state (newline channel state))
-       (state (newline channel state))
-       (state (princ$ (coerce shortname 'string) channel state))
-       (state (newline channel state))
-       (state (close-output-channel channel state)))
-      (mv acc state)))
-
-(defun process-body-directive (arg topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(body foo) -- look up the body and pretty-print it in a <code> block.
-
-  (b* ((body           (get-body arg (w state)))
-       (acc            (str::revappend-chars "<code>" acc))
-       ((mv acc state) (xml-ppr-obj-aux body topics-fal base-pkg state acc))
-       (acc            (str::revappend-chars "</code>" acc)))
-      (mv acc state)))
-
-(defun process-def-directive (arg dir topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(def foo) -- look up the definition for foo, pretty-print it in a <code>
-; block, along with a source-code link.
-
-  (b* ((def            (get-def arg (w state)))
-       (acc            (str::revappend-chars "<p><b>Definition: </b>" acc))
-       ((mv acc state) (process-srclink-directive arg dir state acc))
-       (acc            (str::revappend-chars "</p>" acc))
-       (acc            (str::revappend-chars "<code>" acc))
-       ((mv acc state) (xml-ppr-obj-aux def topics-fal base-pkg state acc))
-       (acc            (str::revappend-chars "</code>" acc)))
-      (mv acc state)))
-
-(defun process-gdef-directive (arg topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(gdef foo) -- Look up the definition for foo, pretty-print it as in @def,
-; but don't use a source-code link because this is a "Generated Definition" for
-; which a tags-search will probably fail.
-
-  (b* ((def            (get-def arg (w state)))
-       (acc            (str::revappend-chars "<p><b>Definition: </b>" acc))
-       (acc            (sym-mangle arg base-pkg acc))
-       (acc            (str::revappend-chars "</p>" acc))
-       (acc            (str::revappend-chars "<code>" acc))
-       ((mv acc state) (xml-ppr-obj-aux def topics-fal base-pkg state acc))
-       (acc            (str::revappend-chars "</code>" acc)))
-      (mv acc state)))
-
-(defun process-thm-directive (arg dir topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(thm foo) -- Look up the theorem named foo, and pretty-print its event along
-; with a source link.
-
-  (b* ((theorem        (get-theorem arg (w state)))
-       (acc            (str::revappend-chars "<p><b>Theorem: </b>" acc))
-       ((mv acc state) (process-srclink-directive arg dir state acc))
-       (acc            (str::revappend-chars "</p>" acc))
-       (acc            (str::revappend-chars "<code>" acc))
-       ((mv acc state) (xml-ppr-obj-aux theorem topics-fal base-pkg state acc))
-       (acc            (str::revappend-chars "</code>" acc)))
-      (mv acc state)))
-
-(defun process-gthm-directive (arg topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(gthm foo) -- Like @(thm foo), but don't provide a source link since this is
-; a generated theorem.
-
-  (b* ((theorem        (get-theorem arg (w state)))
-       (acc            (str::revappend-chars "<p><b>Theorem: </b>" acc))
-       (acc            (sym-mangle arg base-pkg acc))
-       (acc            (str::revappend-chars "</p>" acc))
-       (acc            (str::revappend-chars "<code>" acc))
-       ((mv acc state) (xml-ppr-obj-aux theorem topics-fal base-pkg state acc))
-       (acc            (str::revappend-chars "</code>" acc)))
-      (mv acc state)))
-
-(defun process-formals-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(formals foo) -- just find the formals for foo and print them without any
-; extra formatting.
-
-  (b* ((formals        (get-formals arg (w state)))
-       ((mv acc state) (fmt-and-encode-to-acc formals base-pkg state acc)))
-      (mv acc state)))
-
-(defun process-call-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(call foo) -- find the formals to foo and insert <tt>(foo x y z)</tt>.
-; BOZO consider adding an emacs link.
-
-  (b* ((formals        (get-formals arg (w state)))
-       (call           (cons arg formals))
-       (acc            (str::revappend-chars "<tt>" acc))
-       ((mv acc state) (fmt-and-encode-to-acc call base-pkg state acc))
-       (acc            (str::revappend-chars "</tt>" acc)))
-      (mv acc state)))
-
-(defun process-ccall-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(ccall foo) -- "code call" is like @(call foo), but uses <code> instead
-; of <tt> tags.
-
-  (b* ((formals        (get-formals arg (w state)))
-       (call           (cons arg formals))
-       (acc            (str::revappend-chars "<code>" acc))
-       ((mv acc state) (fmt-and-encode-to-acc call base-pkg state acc))
-       (acc            (str::revappend-chars "</code>" acc)))
-      (mv acc state)))
-
-(defun process-measure-directive (arg base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; @(measure foo) -- find the measure for foo and print it without any extra
-; formatting.
-
-  (b* ((measure        (get-measure arg (w state)))
-       ((mv acc state) (fmt-and-encode-to-acc measure base-pkg state acc)))
-      (mv acc state)))
-
-
-(defun process-directive (command arg dir topics-fal base-pkg state acc) ;; ===> (MV ACC STATE)
-
-; Command and Arg are the already-parsed symbols we have read from the
-; documentation string.  Carry out whatever directive we've been asked to do.
-; DIR is the output dir.  Acc is the accumulator for our output characters.
-
-  (case command
-    (def       (process-def-directive     arg dir topics-fal base-pkg state acc))
-    (thm       (process-thm-directive     arg dir topics-fal base-pkg state acc))
-    (srclink   (process-srclink-directive arg dir state acc))
-    (gdef      (process-gdef-directive    arg topics-fal base-pkg state acc))
-    (gthm      (process-gthm-directive    arg topics-fal base-pkg state acc))
-    (body      (process-body-directive    arg topics-fal base-pkg state acc))
-    (formals   (process-formals-directive arg base-pkg state acc))
-    (measure   (process-measure-directive arg base-pkg state acc))
-    (call      (process-call-directive    arg base-pkg state acc))
-    (ccall     (process-ccall-directive   arg base-pkg state acc))
-    (url       (process-url-directive     arg state acc))
-    (see       (process-see-directive     arg base-pkg state acc))
-    (csee      (process-see-cap-directive arg base-pkg state acc))
-    (sym       (process-sym-directive     arg base-pkg state acc))
-    (csym      (process-sym-cap-directive arg base-pkg state acc))
-    (otherwise
-     (prog2$
-      (cw "; xdoc error: unknown directive ~x0.~%" command)
-      (let* ((acc (str::revappend-chars "[[ unknown directive " acc))
-             (acc (str::revappend-chars (symbol-package-name command) acc))
-             (acc (str::revappend-chars "::" acc))
-             (acc (str::revappend-chars (symbol-name command) acc))
-             (acc (str::revappend-chars "]]" acc)))
-        (mv acc state))))))
-
-
-
-
-; Ugly special hacks for some problems with <code> segments.
-;
-; As an example, consider:
-;
-;  |(defxdoc ...
-;  |  :long "<p>blah blah blah</p>
-;  |
-;  |<p>blah blah blah</p>
-;  |
-;  |<code>
-;  |(example-sexpr ...)
-;  |</code>
-;  |
-;  |<p>blah blah blah</p>")
-;
-; The <code> block above causes problems for Emacs, because the algorithm for
-; figuring out where an S-expression begins seems to basically look for an
-; opening paren at the start of a line.  The result is that Emacs thinks the
-; "(example-sexpr ...)" is the start of a form, rather than the "(defxdoc
-; ...)," which can cause incorrect and irritating syntax highlighting, and can
-; also cause problems for commands like "C-t e" that want to send a form to the
-; *shell* buffer.  To cope with this, I typically indent <code> blocks with a
-; single space, e.g.,
-;
-;  |<code>                   instead of    |<code>
-;  | (example-sexpr ...)                   |(example-sexpr ...)
-;  |</code>                                |</code>
-;
-; but, this convention isn't followed by the code blocks introduced with @(def
-; ...)  and similar, and so the <code> blocks I write may not line up right
-; with generated code blocks.
-;
-; To fix this, we look at the text between <code> and </code>, and if every
-; line begins with a space, we eat those spaces.
-
-(encapsulate
-  ()
-  (local (defthm first-n-ac-expand
-           (implies (syntaxp (quotep i))
-                    (equal (first-n-ac i l ac)
-                           (cond ((zp i) (reverse ac))
-                                 (t (first-n-ac (1- i)
-                                                (cdr l)
-                                                (cons (car l) ac))))))))
-
-  (defun just-started-code-p (acc)
-    (declare (xargs :guard (true-listp acc)))
-    (mbe :logic (equal (take 6 acc)
-                       (reverse (coerce "<code>" 'list)))
-         :exec
-         (and (consp (cdr (cdr (cdr (cdr (cdr acc))))))
-              (eql (first acc) #\>)
-              (eql (second acc) #\e)
-              (eql (third acc) #\d)
-              (eql (fourth acc) #\o)
-              (eql (fifth acc) #\c)
-              (eql (sixth acc) #\<)))))
-
-(defun read-code-segment (x n xl acc always-spacep)
-  "Returns (MV N ACC ALWAYS-SPACEP)"
-
-; We assume we're inside a <code> block.  We read until </code> is found,
-; gathering the characters we see and tracking whether each newline is followed
-; by a space.
-
-  (b* (((when (>= n xl))
-        (mv n acc always-spacep))
-
-       (char-n (char x n))
-       ((when (and (eql char-n #\<)
-                   (str::strprefixp-impl "</code>" x 0 n
-                                         7 ;; (length "</code>")
-                                         xl)))
-        ;; Found </code> tag, so stop reading
-        (mv n acc always-spacep))
-
-       (acc (cons char-n acc))
-       ((unless (eql char-n #\Newline))
-        ;; A normal character, just accumulate it.
-        (read-code-segment x (+ 1 n) xl acc always-spacep))
-
-       (n (+ 1 n))
-       ((when (>= n xl))
-        ;; End of string while reading <code>?  Shouldn't really happen...
-        (mv n acc always-spacep))
-
-       (char-n (char x n))
-       ((when (eql char-n #\<))
-        ;; We allow the </code> to come without a space.
-        (mv n acc always-spacep))
-
-       (acc (cons char-n acc))
-       (always-spacep (and always-spacep
-                           (or (eql char-n #\Space)
-                               (eql char-n #\Newline)))))
-    (read-code-segment x (+ 1 n) xl acc always-spacep)))
-
-(defun revappend-code-chars (code-chars acc always-spacep)
-  (b* (((when (atom code-chars))
-        acc)
-       (char1 (car code-chars))
-       (acc   (cons char1 acc))
-       ((unless (eql char1 #\Newline))
-        (revappend-code-chars (cdr code-chars) acc always-spacep))
-       ((when (and always-spacep
-                   (consp (cdr code-chars))
-                   (eql (second code-chars) #\Space)))
-        ;; Skip the first space
-        (revappend-code-chars (cddr code-chars) acc always-spacep)))
-    (revappend-code-chars (cdr code-chars) acc always-spacep)))
-
-(defun transform-code-segments (x n xl acc)
-  (b* (((when (>= n xl))
-        acc)
-       (char-n (char x n))
-       (acc    (cons char-n acc))
-       (n      (+ 1 n))
-       ((unless (and (eql char-n #\>)
-                     (just-started-code-p acc)))
-        (transform-code-segments x n xl acc))
-       ;; Started a code segment.
-       ((mv n code-acc always-spacep)
-        (read-code-segment x n xl nil t))
-       (code-chars (reverse code-acc))
-       (acc (revappend-code-chars code-chars acc always-spacep)))
-    (transform-code-segments x n xl acc)))
-
-(defun transform-code (x)
-  ;; Fix leading spaces in <code> segments
-  (reverse (coerce (transform-code-segments x 0 (length x) nil) 'string)))
-
-;; (transform-code 
-;; "<p>This is 
-;; some regular text</p>
-;; <code>
-;;     blah1
-;;     <blah>blah2</blah>
-;;     blah3
-;; </code>
-;; <p>And more text</p>")
-
-(defun advance-line (x n xl)
-  ;; Returns the index of the next newline after character N, or else XL
-  (b* (((when (= n xl))
-        n)
-       (c (char x n))
-       ((when (eql c #\Newline))
-        n))
-    (advance-line x (+ 1 n) xl)))
-
-(defun all-lines-start-with-space-p (x n xl)
-  ;; Assumptions:
-  ;;  - We are starting a line
-  ;;  - Every line we've seen so far starts with a space
-  (b* (((when (>= n xl))
-        ;; DO NOT WEAKEN TO (= N XL).  We unusually allow this to exceed the
-        ;; string length; consider the call of advance-line below.
-        ;; Success, reached end of string, no space required
-        t)
-       (c (char x n))
-       ((when (eql c #\Newline))
-        ;; Fine, blank line, no space required
-        (all-lines-start-with-space-p x (+ 1 n) xl))
-       ((when (eql c #\Space))
-        ;; Fine, has a space, skip to next line
-        (b* ((n (advance-line x (+ 1 n) xl)))
-          (all-lines-start-with-space-p x (+ 1 n) xl))))
-    ;; Nope, found a non-space char at start of the line.
-    nil))
-
-(encapsulate
-  ()
-  (logic)
-
-  (local
-   (progn
-
-     (defun test (x)
-       (declare (xargs :mode :program))
-       (all-lines-start-with-space-p x 0 (length x)))
-
-     (assert! (test " foo
- bar
- baz"))
-
-     (assert! (not (test " foo
-bar
- baz")))
-
-     (assert! (test " foo
-
- bar
- baz
-"))
-
-     (assert! (not (test "foo
- bar
-baz
-"))))))
-
-(defun delete-leading-line-space (x n xl acc)
-  ;; Assumes (all-lines-start-with-space-p x n xl)
-  (b* (((when (>= n xl))
-        acc)
-       (c (char x n))
-       ((when (eql c #\Newline))
-        (delete-leading-line-space x (+ 1 n) xl (cons c acc)))
-       ;; Else it must be a space.  Skip the space but copy the other chars
-       ;; through the end of the line.
-       (start (+ 1 n))
-       (end   (advance-line x start xl))
-       ;; BOZO abuse of revappend-chars-aux to only copy until end...
-       ;; should fix its guard to allow this sort of thing
-       (acc   (str::revappend-chars-aux x start end acc)))
-    (delete-leading-line-space x end xl acc)))
-
-(defun maybe-fix-spaces-in-sub (x)
-  (declare (type string x))
-  (b* ((xl (length x))
-       ((unless (all-lines-start-with-space-p x 0 xl))
-        ;; Fine, don't do anything
-        x)
-       (acc (delete-leading-line-space x 0 xl nil)))
-    (reverse (coerce acc 'string))))
-
-(encapsulate
-  ()
-  (logic)
-
-  (local
-   (progn
-
-     (defun test (x expect)
-       (declare (xargs :mode :program))
-       (equal (maybe-fix-spaces-in-sub x) expect))
-
-     (assert! (test " foo
- bar
- baz"
-                    "foo
-bar
-baz"))
-
-     (assert! (test " foo
-bar
- baz"
-                    " foo
-bar
- baz"))
-
-     (assert! (test " foo
-
- bar
- baz
-"
-                    "foo
-
-bar
-baz
-"))
-
-     (assert! (test "foo
- bar
-baz
-"
-                    "foo
- bar
-baz
-")))))
-
-
-(defun fancy-trim-start (x n xl new-start)
-  (b* (((when (= n xl))
-        ;; saw nothing but spaces and newlines, turn it into the empty string.
-        n)
-       (c (char x n))
-       (n (+ 1 n))
-       ((when (eql c #\Space))
-        (fancy-trim-start x n xl new-start))
-       ((when (eql c #\Newline))
-        (fancy-trim-start x n xl n)))
-    new-start))
-
-(defun fancy-trim-stop (x n start)
-  ;; N counts down from (length x) to start.
-  (b* (((when (<= n start))
-        ;; saw nothing but spaces and newlines, turn it into the empty string.
-        start)
-       (n (- n 1))
-       (c (char x n))
-       ((when (or (eql c #\Space)
-                  (eql c #\Newline)
-                  (eql c #\Tab)))
-        (fancy-trim-stop x n start)))
-    n))
-
-(defun fancy-extract-block (x start end)
-  (b* ((start (fancy-trim-start x start end start))
-       (end   (+ 1 (fancy-trim-stop x end start)))
-       ((unless (<= start end))
-        ""))
-    (subseq x start end)))
-
-
-
-
-
-(defun preprocess-aux (x n xl dir topics-fal base-pkg kpa state acc)
-  "Returns (MV ACC STATE)"
-  (declare (type string x))
-
-; Main preprocessor loop.  Read from the string and accumulate the result into
-; acc, expanding away any preprocessor directives.
-
-  (b* (((when (= n xl))
-        (mv acc state))
-
-       (char (char x n))
-       ((when (eql char #\@))
-        (cond ((and (< (+ n 1) xl)
-                    (eql (char x (+ n 1)) #\@))
-               ;; @@ --> @
-               (preprocess-aux x (+ n 2) xl dir topics-fal base-pkg kpa state (cons #\@ acc)))
-
-              ((and (< (+ n 1) xl)
-                    (eql (char x (+ n 1)) #\())
-               ;; @( --> directive
-               (b* (((when (and (< (+ n 2) xl)
-                                (eql (char x (+ n 2)) #\')))
-                     ;; @(' directive -- turns into raw <tt> block with auto linking
-                     (b* ((end (str::strpos-fast "')" x (+ n 2) 2 xl))
-                          ((unless end)
-                           (prog2$ (cw "; xdoc error: no closing ') found for @(' ...~%")
-                                   (mv acc state)))
-                          (sub (fancy-extract-block x (+ n 3) end))
-                          (acc (str::revappend-chars "<tt>" acc))
-                          (acc (autolink-and-encode sub 0 (length sub) topics-fal base-pkg kpa acc))
-                          (acc (str::revappend-chars "</tt>" acc)))
-                       (preprocess-aux x (+ end 2) xl dir topics-fal base-pkg kpa state acc)))
-
-                    ((when (and (< (+ n 2) xl)
-                                (eql (char x (+ n 2)) #\{)))
-                     ;; @({ directive -- turns into raw <code> block with auto linking
-                     (b* ((end (str::strpos-fast "})" x (+ n 2) 2 xl))
-                          ((unless end)
-                           (prog2$ (cw "; xdoc error: no closing }) found for @({ ...~%")
-                                   (mv acc state)))
-                          (sub (maybe-fix-spaces-in-sub (fancy-extract-block x (+ n 3) end)))
-                          (acc (str::revappend-chars "<code>" acc))
-                          (acc (autolink-and-encode sub 0 (length sub) topics-fal base-pkg kpa acc))
-                          (acc (str::revappend-chars "</code>" acc)))
-                       (preprocess-aux x (+ end 2) xl dir topics-fal base-pkg kpa state acc)))
-
-
-                    ((mv error command arg n) (parse-directive x (+ n 2) xl base-pkg kpa))
-                    ((when error)
-                     (prog2$ (cw "; xdoc error: ~x0.~%" error)
-                             (mv acc state)))
-                    ((mv acc state)
-                     (process-directive command arg dir topics-fal base-pkg state acc)))
-                 (preprocess-aux x n xl dir topics-fal base-pkg kpa state acc)))
-
-              (t
-               ;; @ sign in some other context.
-               (preprocess-aux x (+ n 1) xl dir topics-fal base-pkg kpa state (cons #\@ acc)))))
-
-       ((when (eql char #\Newline))
-        ;; Gross hack #1: eat initial newlines from the start of a <code>
-        ;; block, since otherwise they look ugly when firefox renders them.
-        (if (just-started-code-p acc)
-            (if (and (< (+ n 1) xl)
-                     (eql (char x (+ n 1)) #\Newline))
-                ;; Avoid eating multiple newlines at the start of a code block.
-                (preprocess-aux x (+ n 2) xl dir topics-fal base-pkg kpa state (cons #\Newline acc))
-              (preprocess-aux x (+ n 1) xl dir topics-fal base-pkg kpa state acc))
-          ;; Gross hack #2: the XSLT transformer in firefox seems to have some
-          ;; problems if there aren't spaces at the end of lines, e.g., it will
-          ;; run together the hover-text in the hierarchical description in
-          ;; preview.html.  Fix by putting a space before newlines.  Horrible.
-          (preprocess-aux x (+ n 1) xl dir topics-fal base-pkg kpa state
-                          (list* #\Newline #\Space acc)))))
-
-    ;; Otherwise just keep the char and keep going.
-    (preprocess-aux x (+ n 1) xl dir topics-fal base-pkg kpa state (cons char acc))))
-
-(defun preprocess-main (x dir topics-fal base-pkg state acc)
-  (declare (type (or string null) x))
-  (b* ((x (or x ""))
-       ;; (current-pkg    (acl2::f-get-global 'current-package state))
-       ;; Temporarily make "fmt" print as if it's in base-pkg.
-       ;; ((mv & & state) (acl2::set-current-package (symbol-package-name base-pkg) state))
-       (kpa            (known-package-alist state))
-       (x              (transform-code x))
-       ((mv acc state) (preprocess-aux x 0 (length x) dir topics-fal base-pkg kpa state acc))
-       ;; Restore base-pkg for whoever called us.
-       ;; ((mv & & state) (acl2::set-current-package current-pkg state))
-       )
-      (mv acc state)))
-
-
-
-
diff -Nru acl2-6.2/books/xdoc-impl/save.lisp acl2-6.3/books/xdoc-impl/save.lisp
--- acl2-6.2/books/xdoc-impl/save.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/save.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,600 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-; save.lisp
-;
-; This file defines the XDOC functions for running the preprocessor and saving
-; XML files.  Note that the save-topics command we introduce cannot actually be
-; used unless the mkdir-raw book is loaded first.  This is automatically handled
-; by the "save" macro in top.lisp.
-
-(in-package "XDOC")
-(include-book "mkdir")
-(include-book "../xdoc/base")
-(include-book "preprocess")
-(include-book "parse-xml")
-(include-book "sort")
-(set-state-ok t)
-
-(program)
-
-(defun clean-topics-aux (x seen-names-fal)
-  ;; Remove topics we've already seen.
-  (b* (((when (atom x))
-        (fast-alist-free seen-names-fal)
-        nil)
-       (name1 (cdr (assoc :name (car x))))
-
-       ((when (hons-get name1 seen-names-fal))
-        (cw "~|WARNING: dropping shadowed topic for ~x0.~%" name1)
-        (clean-topics-aux (cdr x) seen-names-fal))
-
-       (seen-names-fal (hons-acons name1 t seen-names-fal)))
-    (cons (car x)
-          (clean-topics-aux (cdr x) seen-names-fal))))
-
-(defun clean-topics (x)
-  (clean-topics-aux x (len x)))
-
-; --------------------- File Copying ----------------------------
-
-(defun stupid-copy-file-aux (in out state)
-
-; In, out are channels.  Copy from in to out, one byte at a time.
-
-  (mv-let (byte state)
-          (read-byte$ in state)
-          (if (not byte)
-              state
-            (let ((state (write-byte$ byte out state)))
-              (stupid-copy-file-aux in out state)))))
-
-(defun stupid-copy-file (src dest state)
-
-; A stupid file copy routine, so we can copy our style files, etc.  We avoid
-; using "system" because of memory problems with forking on huge images.
-
-  (b* (((mv in state)  (open-input-channel src :byte state))
-       ((mv out state) (open-output-channel dest :byte state))
-       (state          (stupid-copy-file-aux in out state))
-       (state          (close-input-channel in state))
-       (state          (close-output-channel out state)))
-      state))
-
-(defun stupid-copy-files (srcdir filenames destdir state)
-  (if (atom filenames)
-      state
-    (b* ((srcfile  (acl2::extend-pathname srcdir (car filenames) state))
-         (destfile (acl2::extend-pathname destdir (car filenames) state))
-         (state    (stupid-copy-file srcfile destfile state)))
-        (stupid-copy-files srcdir (cdr filenames) destdir state))))
-
-
-
-; ---------------- Hierarchical Index Generation ----------------
-
-(defun normalize-parents (x)
-
-; Given an xdoc entry, remove duplicate parents and self-parents.
-
-  (let* ((name    (cdr (assoc :name x)))
-         (parents (cdr (assoc :parents x)))
-         (orig    parents)
-         (parents (if (member-equal name parents)
-                      (prog2$
-                       (cw "; xdoc note: removing self-referencing :parents entry for ~x0.~%" name)
-                       (remove-equal name parents))
-                    parents))
-         (parents (if (no-duplicatesp-equal parents)
-                      parents
-                    (prog2$
-                     (cw "; xdoc note: removing duplicate :parents for ~x0.~%" name)
-                     (remove-duplicates-equal parents)))))
-    (if (equal parents orig)
-        x
-      (acons :parents parents x))))
-
-(defun normalize-parents-list (x)
-
-; Clean up parents throughout all xdoc topics.
-
-  (if (atom x)
-      nil
-    (cons (normalize-parents (car x))
-          (normalize-parents-list (cdr x)))))
-
-(defun find-roots (x)
-
-; Gather names of all doc topics which have no parents.
-
-  (if (atom x)
-      nil
-    (if (not (cdr  (assoc :parents (car x))))
-        (cons (cdr (assoc :name (car x)))
-              (find-roots (cdr x)))
-      (find-roots (cdr x)))))
-
-(defun find-children-aux (par x)
-
-; Gather names of all xdoc topics in x which have parent par.  I.e., this finds
-; the immediate children.
-
-  (if (atom x)
-      nil
-    (if (member-equal par (cdr (assoc :parents (car x))))
-        (cons (cdr (assoc :name (car x)))
-              (find-children-aux par (cdr x)))
-      (find-children-aux par (cdr x)))))
-
-(defun find-children (par x)
-
-; Gather names of immediate children topics and sort them.
-
-  (mergesort (find-children-aux par x)))
-
-
-(defun gather-topic-names (x)
-  (if (atom x)
-      nil
-    (cons (cdr (assoc :name (car x)))
-          (gather-topic-names (cdr x)))))
-
-(defun topics-fal (x)
-  (make-fast-alist (pairlis$ (gather-topic-names x) nil)))
-
-
-(defun find-orphaned-topics-1 (child parents topics-fal acc)
-  ;; Returns an alist of (CHILD . MISSING-PARENT)
-  (cond ((atom parents)
-         acc)
-        ((hons-get (car parents) topics-fal)
-         (find-orphaned-topics-1 child (cdr parents) topics-fal acc))
-        (t
-         (find-orphaned-topics-1 child (cdr parents) topics-fal
-                                 (cons (cons child (car parents))
-                                       acc)))))
-
-(defun find-orphaned-topics (x topics-fal acc)
-  (b* (((when (atom x))
-        acc)
-       (child   (cdr (assoc :name (car x))))
-       (parents (cdr (assoc :parents (car x))))
-       (acc     (find-orphaned-topics-1 child parents topics-fal acc)))
-    (find-orphaned-topics (cdr x) topics-fal acc)))
-
-
-
-(mutual-recursion
-
- (defun make-hierarchy-aux (path dir topics-fal index-pkg all id expand-level acc state)
-
-; - Path is our current location in the hierarchy, and is used to avoid loops.
-;   (The first element in path is the current topic we are on.)
-;
-; - Index-pkg is just used for symbol printing.
-;
-; - All is the list of all xdoc documentation topics.
-;
-; - ID is a number that we assign to this topic entry for hiding with
-;   JavaScript.  (We don't use names because the topics might be repeated under
-;   different parents).
-;
-; - Expand-level is how deep to expand topics, generally 1 by default.
-;
-; - Acc is the character list we are building.
-;
-; We return (MV ACC-PRIME ID-PRIME STATE)
-
-   (b* ((name     (car path))
-        (id-chars (list* #\t #\o #\p #\i #\c #\- (explode-atom id 10)))
-        (depth    (len path))
-        (children (find-children name all))
-        (kind     (cond ((not children) "leaf")
-                        ((< depth expand-level) "show")
-                        (t "hide")))
-
-        ((when    (member-equal name (cdr path)))
-         (prog2$
-          (er hard? 'make-hierarchy "Circular topic hierarchy.  Path is ~x0.~%" path)
-          (mv acc id state)))
-
-        (topic (find-topic name all))
-        (short    (cdr (assoc :short topic)))
-        (base-pkg (cdr (assoc :base-pkg topic)))
-
-        (acc (str::revappend-chars "<hindex topic=\"" acc))
-        (acc (file-name-mangle name acc))
-        (acc (str::revappend-chars "\" id=\"" acc))
-        (acc (revappend id-chars acc))
-        (acc (str::revappend-chars "\" kind=\"" acc))
-        (acc (str::revappend-chars kind acc))
-        (acc (str::revappend-chars "\">" acc))
-        (acc (cons #\Newline acc))
-
-        (acc (str::revappend-chars "<hindex_name>" acc))
-        (acc (sym-mangle-cap name index-pkg acc))
-        (acc (str::revappend-chars "</hindex_name>" acc))
-        (acc (cons #\Newline acc))
-
-        (acc (str::revappend-chars "<hindex_short id=\"" acc))
-        (acc (revappend id-chars acc))
-        (acc (str::revappend-chars "\">" acc))
-        ((mv acc state) (preprocess-main short dir topics-fal base-pkg state acc))
-        (acc (str::revappend-chars "</hindex_short>" acc))
-
-        (acc (str::revappend-chars "<hindex_children id=\"" acc))
-        (acc (revappend id-chars acc))
-        (acc (str::revappend-chars "\" kind=\"" acc))
-        (acc (str::revappend-chars kind acc))
-        (acc (str::revappend-chars "\">" acc))
-        (acc (cons #\Newline acc))
-
-        (id   (+ id 1))
-        ((mv acc id state)
-         (make-hierarchy-list-aux children path dir topics-fal index-pkg all id expand-level acc state))
-        (acc (str::revappend-chars "</hindex_children>" acc))
-        (acc (str::revappend-chars "</hindex>" acc))
-        (acc (cons #\Newline acc)))
-       (mv acc id state)))
-
- (defun make-hierarchy-list-aux (children path dir topics-fal index-pkg all id expand-level acc state)
-
-; - Children are the children of this path.
-; - Path is our current location in the hierarchy.
-
-   (if (atom children)
-       (mv acc id state)
-     (b* (((mv acc id state)
-           (make-hierarchy-aux (cons (car children) path) dir topics-fal index-pkg all id
-                               expand-level acc state))
-          ((mv acc id state)
-           (make-hierarchy-list-aux (cdr children) path dir topics-fal index-pkg all id
-                                    expand-level acc state)))
-         (mv acc id state)))))
-
-(defconst *xml-entity-stuff*
-  "<!DOCTYPE xdoc [
-  <!ENTITY mdash \"&#8212;\">
-  <!ENTITY rarr \"&#8594;\">
-  <!ENTITY nbsp \"&#160;\">
-]>
-")
-
-(defun save-hierarchy (x dir topics-fal index-pkg expand-level state)
-
-; X is all topics.  We assume all parents are normalized.
-
-  (b* ((roots (mergesort (find-roots x)))
-       (acc   nil)
-       (acc   (str::revappend-chars "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" acc))
-       (acc   (cons #\Newline acc))
-       (acc   (str::revappend-chars "<?xml-stylesheet type=\"text/xsl\" href=\"xml-topic-index.xsl\"?>" acc))
-       (acc   (cons #\Newline acc))
-       (acc   (str::revappend-chars *xml-entity-stuff* acc))
-       (acc   (str::revappend-chars "<page>" acc))
-       (acc   (cons #\Newline acc))
-       (acc   (str::revappend-chars "<hindex_root>" acc))
-       (acc   (cons #\Newline acc))
-       ((mv acc & state) (make-hierarchy-list-aux roots nil dir topics-fal index-pkg x 0
-                                                  expand-level acc state))
-       (acc   (str::revappend-chars "</hindex_root>" acc))
-       (acc   (cons #\Newline acc))
-       (acc   (str::revappend-chars "</page>" acc))
-       (acc   (cons #\Newline acc))
-       (filename (acl2::extend-pathname dir "topics.xml" state))
-       ((mv channel state) (open-output-channel filename :character state))
-       (state (princ$ (reverse (coerce acc 'string)) channel state))
-       (state (close-output-channel channel state)))
-      state))
-
-
-
-
-; ------------------ Making Flat Indexes ------------------------
-
-(defun index-add-topic (x dir topics-fal index-pkg state acc)
-
-; X is a single topic entry in the xdoc table.  Index-pkg says the base package
-; for symbols seen frmo the index.
-
-  (b* ((name     (cdr (assoc :name x)))
-       (short    (cdr (assoc :short x)))
-       (base-pkg (cdr (assoc :base-pkg x)))
-       (acc   (str::revappend-chars "<index_entry>" acc))
-       (acc   (cons #\Newline acc))
-       (acc   (str::revappend-chars "<index_head><see topic=\"" acc))
-       (acc   (file-name-mangle name acc))
-       (acc   (str::revappend-chars "\">" acc))
-       (acc   (sym-mangle-cap name index-pkg acc))
-       (acc   (str::revappend-chars "</see>" acc))
-       (acc   (str::revappend-chars "</index_head>" acc))
-       (acc   (cons #\Newline acc))
-       (acc   (str::revappend-chars "<index_body>" acc))
-       (acc   (cons #\Newline acc))
-       ((mv acc state) (preprocess-main short dir topics-fal base-pkg state acc))
-       (acc   (cons #\Newline acc))
-       (acc   (str::revappend-chars "</index_body>" acc))
-       (acc   (cons #\Newline acc))
-       (acc   (str::revappend-chars "</index_entry>" acc))
-       (acc   (cons #\Newline acc)))
-      (mv acc state)))
-
-(defun index-add-topics (x dir topics-fal index-pkg state acc)
-
-; X is a list of topics.  Index-pkg says the base package for these symbols.
-
-  (if (atom x)
-      (mv acc state)
-    (b* (((mv acc state) (index-add-topic (car x) dir topics-fal index-pkg state acc)))
-        (index-add-topics (cdr x) dir topics-fal index-pkg state acc))))
-
-(defun index-topics (x title dir topics-fal index-pkg state acc)
-
-; X is a list of topics.  Generate <index>...</index> for these topics and
-; add to acc.
-
-  (b* ((acc (str::revappend-chars "<index title=\"" acc))
-       (acc (str::revappend-chars title acc))
-       (acc (str::revappend-chars "\">" acc))
-       (acc (cons #\Newline acc))
-       ((mv acc state) (index-add-topics x dir topics-fal index-pkg state acc))
-       (acc (str::revappend-chars "</index>" acc))
-       (acc (cons #\Newline acc)))
-      (mv acc state)))
-
-(defun save-index (x dir topics-fal index-pkg state)
-
-; Write index.xml for the whole list of all topics.
-
-  (b* ((acc nil)
-       (acc (str::revappend-chars "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" acc))
-       (acc (cons #\Newline acc))
-       (acc (str::revappend-chars "<?xml-stylesheet type=\"text/xsl\" href=\"xml-full-index.xsl\"?>" acc))
-       (acc (cons #\Newline acc))
-       (acc   (str::revappend-chars *xml-entity-stuff* acc))
-       (acc (str::revappend-chars "<page>" acc))
-       (acc (cons #\Newline acc))
-       ((mv acc state) (index-topics x "Full Index" dir topics-fal index-pkg state acc))
-       (acc (str::revappend-chars "</page>" acc))
-       (filename (acl2::extend-pathname dir "index.xml" state))
-       ((mv channel state) (open-output-channel filename :character state))
-       (state (princ$ (reverse (coerce acc 'string)) channel state))
-       (state (close-output-channel channel state)))
-      state))
-
-
-
-
-; -------------------- Making Topic Pages -----------------------
-
-(defun add-parents (parents base-pkg acc)
-  (if (atom parents)
-      acc
-    (let* ((acc (str::revappend-chars "<parent topic=\"" acc))
-           (acc (file-name-mangle (car parents) acc))
-           (acc (str::revappend-chars "\">" acc))
-           (acc (sym-mangle-cap (car parents) base-pkg acc))
-           (acc (str::revappend-chars "</parent>" acc))
-           (acc (cons #\Newline acc)))
-      (add-parents (cdr parents) base-pkg acc))))
-
-(defun gather-topics (names all-topics)
-
-; Given a list of topic names, get their entries from the list of all topics.
-
-  (cond ((atom all-topics)
-         nil)
-        ((member (cdr (assoc :name (car all-topics))) names)
-         (cons (car all-topics)
-               (gather-topics names (cdr all-topics))))
-        (t
-         (gather-topics names (cdr all-topics)))))
-
-
-(defun preprocess-topic (x all-topics dir topics-fal state)
-  (b* ((name     (cdr (assoc :name x)))
-       (base-pkg (cdr (assoc :base-pkg x)))
-       (short    (or (cdr (assoc :short x)) ""))
-       (long     (or (cdr (assoc :long x)) ""))
-       (parents  (cdr (assoc :parents x)))
-       ((unless (symbolp name))
-        (mv (er hard? 'preprocess-topic "Name is not a string: ~x0.~%" x)
-            state))
-       ((unless (symbolp base-pkg))
-        (mv (er hard? 'preprocess-topic "Base-pkg is not a symbol: ~x0.~%" base-pkg)
-            state))
-       ((unless (symbol-listp parents))
-        (mv (er hard? 'preprocess-topic "Parents are not a symbol-listp: ~x0.~%" x)
-            state))
-       ((unless (stringp short))
-        (mv (er hard? 'preprocess-topic "Short is not a string: ~x0.~%" x)
-            state))
-       ((unless (stringp long))
-        (mv (er hard? 'preprocess-topic "Long is not a string: ~x0.~%" x)
-            state))
-       (acc    nil)
-       (acc    (str::revappend-chars "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" acc))
-       (acc    (cons #\Newline acc))
-       (acc    (str::revappend-chars "<?xml-stylesheet type=\"text/xsl\" href=\"xml-topic.xsl\"?>" acc))
-       (acc    (cons #\Newline acc))
-       (acc    (str::revappend-chars *xml-entity-stuff* acc))
-       (acc    (str::revappend-chars "<page>" acc))
-       (acc    (str::revappend-chars "<topic name=\"" acc))
-       (acc    (sym-mangle-cap name base-pkg acc))
-       (acc    (str::revappend-chars "\">" acc))
-       (acc    (cons #\Newline acc))
-       (acc    (add-parents parents base-pkg acc))
-       (acc    (cons #\Newline acc))
-       (acc    (str::revappend-chars "<short>" acc))
-
-       ;; Previously: ((mv acc state) (preprocess-main short dir base-pkg state acc))
-
-       ((mv short-acc state) (preprocess-main short dir topics-fal base-pkg state nil))
-       (short-str  (reverse (coerce short-acc 'string)))
-       (acc        (append short-acc acc))
-       ((mv err &) (parse-xml short-str))
-       (state
-        (if err
-            (pprogn
-               (fms "~|~%WARNING: problem with :short in topic ~x0:~%" 
-                    (list (cons #\0 name))
-                    *standard-co* state nil)
-               (princ$ err *standard-co* state)
-               (fms "~%~%" nil *standard-co* state nil))
-          state))
-
-       (acc    (str::revappend-chars "</short>" acc))
-       (acc    (cons #\Newline acc))
-       (acc    (str::revappend-chars "<long>" acc))
-
-       ;; Previously: ((mv acc state) (preprocess-main long dir base-pkg state acc))
-       ((mv long-acc state) (preprocess-main long dir topics-fal base-pkg state nil))
-       (long-str (reverse (coerce long-acc 'string)))
-       (acc      (append long-acc acc))
-       ((mv err &) (parse-xml long-str))
-       (state
-        (if err
-            (pprogn
-               (fms "~|~%WARNING: problem with :long in topic ~x0:~%" 
-                    (list (cons #\0 name))
-                    *standard-co* state nil)
-               (princ$ err *standard-co* state)
-               (fms "~%~%" nil *standard-co* state nil))
-          state))
-
-       (acc    (str::revappend-chars "</long>" acc))
-       (acc    (cons #\Newline acc))
-
-       (children (find-children name all-topics))
-       (topics   (gather-topics children all-topics))
-
-       ((mv acc state) (if (not topics)
-                           (mv acc state)
-                         (index-topics topics "Subtopics" dir topics-fal base-pkg state acc)))
-
-       (acc    (str::revappend-chars "</topic>" acc))
-       (acc    (cons #\Newline acc))
-       (acc    (str::revappend-chars "</page>" acc))
-       (acc    (cons #\Newline acc)))
-      (mv (reverse (coerce acc 'string)) state)))
-
-(defun save-topic (x all-topics dir topics-fal state)
-  (b* ((name               (cdr (assoc :name x)))
-       (-                  (cw "Saving ~s0::~s1.~%" (symbol-package-name name) (symbol-name name)))
-       ((mv text state)    (preprocess-topic x all-topics dir topics-fal state))
-       (filename           (concatenate 'string
-                                        (reverse (coerce (file-name-mangle name nil) 'string))
-                                        ".xml"))
-       (fullpath           (acl2::extend-pathname dir filename state))
-       ((mv channel state) (open-output-channel fullpath :character state))
-       (state              (princ$ text channel state))
-       (state              (close-output-channel channel state)))
-      state))
-
-(defun save-topics-aux (x all-topics dir topics-fal state)
-  (if (atom x)
-      state
-    (let ((state (save-topic (car x) all-topics dir topics-fal state)))
-      (save-topics-aux (cdr x) all-topics dir topics-fal state))))
-
-
-
-(defun save-success-file (ntopics dir state)
-  (b* ((file           (acl2::extend-pathname dir "success.txt" state))
-       ((mv out state) (open-output-channel file :character state))
-       ((mv & state)   (fmt "Successfully wrote ~x0 topics.~%~%"
-                            (list (cons #\0 ntopics))
-                            out state nil))
-       (state          (close-output-channel out state)))
-      state))
-
-(defun prepare-dir (dir state)
-  (b* (((unless (stringp dir))
-        (prog2$ (er hard? 'prepare-dir "Dir must be a string, but is: ~x0.~%" dir)
-                state))
-       (- (cw "; Preparing directory ~s0.~%" dir))
-       (dir/xml     (acl2::extend-pathname dir "xml" state))
-       (state       (mkdir dir state))
-       (state       (mkdir dir/xml state))
-
-;;       (dir/support (acl2::extend-pathname dir "support" state))
-;;       (state       (mkdir dir/support state))
-
-       (xdoc/support (acl2::extend-pathname *xdoc-dir* "support" state))
-
-       ;; We copy support/Makefile-trans to dir/Makefile.  The "-trans" part of
-       ;; its name is just to prevent people from thinking they can type "make"
-       ;; in the support directory to accomplish anything.
-       (Makefile-trans (acl2::extend-pathname xdoc/support "Makefile-trans" state))
-       (Makefile-out   (acl2::extend-pathname dir "Makefile" state))
-       (state   (stupid-copy-file Makefile-trans Makefile-out state))
-
-       (state   (stupid-copy-files xdoc/support
-                                   (list "xdoc.css"
-                                         "xdoc.js"
-                                         "plus.png"
-                                         "minus.png"
-                                         "leaf.png"
-                                         "text-topic.xsl"
-                                         "html-core.xsl"
-                                         "html-topic.xsl"
-                                         "html-full-index.xsl"
-                                         "html-brief-index.xsl"
-                                         "html-topic-index.xsl"
-                                         "xml-topic.xsl"
-                                         "xml-topic-index.xsl"
-                                         "xml-full-index.xsl")
-                                   dir/xml state))
-       (state   (stupid-copy-files xdoc/support
-                                   (list "frames2.html"
-                                         "frames3.html"
-                                         "preview.html")
-                                   dir state)))
-    state))
-
-(defun save-topics (x dir index-pkg expand-level state)
-  (b* ((state (prepare-dir dir state))
-       (dir   (acl2::extend-pathname dir "xml" state))
-       (x     (clean-topics x))
-       (- (cw "; Processing ~x0 topics.~%" (len x)))
-       ;; Note: generate the index after the topic files, so that
-       ;; errors in short messages will be seen there.
-       (x      (time$ (normalize-parents-list x)
-                      :msg "; Normalizing parents: ~st sec, ~sa bytes~%"
-                      :mintime 1/2))
-       (topics-fal (time$ (topics-fal x)
-                          :msg "; Generating topics fal: ~st sec, ~sa bytes~%"
-                          :mintime 1/2))
-       (state  (time$ (save-topics-aux x x dir topics-fal state)
-                      :msg "; Saving topics: ~st sec, ~sa bytes~%"
-                      :mintime 1/2))
-       (state  (time$ (save-index x dir topics-fal index-pkg state)
-                      :msg "; Saving flat index: ~st sec, ~sa bytes~%"
-                      :mintime 1/2))
-       (state  (time$ (save-hierarchy x dir topics-fal index-pkg expand-level state)
-                      :msg "; Saving hierarchical index: ~st sec, ~sa bytes~%"))
-       (orphans (find-orphaned-topics x topics-fal nil))
-       (-       (fast-alist-free topics-fal))
-       (state   (save-success-file (len x) dir state)))
-    (or (not orphans)
-        (cw "~|~%WARNING: found topics with non-existent parents:~%~x0~%These ~
-             topics may only show up in the index pages.~%~%" orphans))
-    state))
-
diff -Nru acl2-6.2/books/xdoc-impl/sort.lisp acl2-6.3/books/xdoc-impl/sort.lisp
--- acl2-6.2/books/xdoc-impl/sort.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/sort.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,63 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-(in-package "XDOC")
-(program)
-
-; This is the same mergesort from the osets library.  We only copy it here so
-; that we can use it without depending on osets.  I modify it somewhat to
-; avoid set operations like "empty" and "tail", in lieu of ordinary atom and
-; cdr, etc.
-
-(defun << (a b)
-  (and (lexorder a b)
-       (not (equal a b))))
-
-(defun fast-union (x y acc)
-  (cond
-   ((atom x) (revappend acc y))
-   ((atom y) (revappend acc x))
-   ((equal (car x) (car y))
-    (fast-union (cdr x) (cdr y) (cons (car x) acc)))
-   ((<< (car x) (car y))
-    (fast-union (cdr x) y (cons (car x) acc)))
-   (t
-    (fast-union x (cdr y) (cons (car y) acc)))))
-
-(defund halve-list-aux (mid x acc)
-  (if (or (atom x)
-          (atom (cdr x)))
-      (mv acc mid)
-    (halve-list-aux (cdr mid)
-                    (cdr (cdr x))
-                    (cons (car mid) acc))))
-
-(defund halve-list (x)
-  (halve-list-aux x x nil))
-
-(defun mergesort (x)
-  (cond ((atom x) nil)
-        ((atom (cdr x))
-         (list (car x)))
-        (t (mv-let (part1 part2)
-                   (halve-list x)
-                   (fast-union (mergesort part1)
-                               (mergesort part2)
-                               nil)))))
diff -Nru acl2-6.2/books/xdoc-impl/topics.lisp acl2-6.3/books/xdoc-impl/topics.lisp
--- acl2-6.2/books/xdoc-impl/topics.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/topics.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,824 +0,0 @@
-; XDOC Documentation System for ACL2
-; Copyright (C) 2009-2011 Centaur Technology
-;
-; Contact:
-;   Centaur Technology Formal Verification Group
-;   7600-C N. Capital of Texas Highway, Suite 300, Austin, TX 78731, USA.
-;   http://www.centtech.com/
-;
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of the GNU General Public License as published by the Free Software
-; Foundation; either version 2 of the License, or (at your option) any later
-; version.  This program is distributed in the hope that it will be useful but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
-; more details.  You should have received a copy of the GNU General Public
-; License along with this program; if not, write to the Free Software
-; Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
-;
-; Original author: Jared Davis <jared@centtech.com>
-
-
-; topics.lisp
-;
-; This is the actual xdoc documentation for the xdoc system.  We put the topics
-; here, instead of in top.lisp, in a probably silly effort to minimize the load
-; time of top.lisp.
-
-(in-package "XDOC")
-(include-book "import-acl2doc")  ;; For base acl2 documentation
-(program)
-
-(defxdoc xdoc
-  :short "<i>XDOC</i> is a tool for documenting ACL2 libraries, and is
-intended as a replacement for ACL2 facilities such as @('defdoc'), @(':doc'),
-and so on."
-
-  :long "<p>To use the XDOC system, the first step is:</p>
-
-@({
- (include-book \"xdoc/top\" :dir :system)
-})
-
-<p>This is a regular ACL2 book that loads quickly, requires no ttags, and
-provides a (nearly) complete interface to the XDOC system, including:</p>
-
-<ul>
-
-<li>@(see defxdoc), the basic command for adding documentation, which is the
-XDOC replacement for ACL2's @('defdoc') command.</li>
-
-<li>The @(':xdoc') command for viewing documentation within the terminal, which
-is the XDOC replacement for ACL2's @(':doc') command.</li>
-
-<li>The @(see save) command, which exports all XDOC documentation as XML files
-that can be viewed in a web browser or transformed into formats like HTML.</li>
-
-</ul>
-
-<p>The @(':xdoc') command consults the XDOC database <b>and</b> ACL2's
-@(':doc') database, so you can always use @(':xdoc foo') without having to know
-which documentation system was used to document the topic.</p>")
-
-
-(defxdoc defxdoc
-  :parents (xdoc)
-  :short "Add documentation to the @(see xdoc) database."
-
-  :long "<box><p>Note: @('defxdoc') is very basic.  You will usually want to
-use @(see defsection) instead.</p></box>
-
-<p>@('Defxdoc') is the XDOC alternative to ACL2's built-in @('defdoc') command.
-The general form is:</p>
-
-@({
- (defxdoc name
-   :parents (topic1 topic2 ...)
-   :short \"short description\"
-   :long \"longer description\")
-})
-
-<p>All of the keyword arguments are optional.</p>
-
-<ul>
-
-<li>@('name') is the name of this documentation topic, and should be a
-symbol.</li>
-
-<li>@('parents') let you associate this documentation with other topics.  A
-topic can have many parents, but circular parents are not allowed and will lead
-to errors when generating documentation.</li>
-
-<li>@('short') should be a short description of this topic and should be
-suitable for inlining in other pages.  For instance, it is displayed in the
-full index, and as \"hover\" text in the navigation page.</li>
-
-<li>@('long') should be the full, detailed documentation for this topic.</li>
-
-</ul>
-
-<p>The @('short') and @('long') strings may be written using the XDOC @(see
-markup) language, and may also use @(see preprocessor) commands to insert
-function definitions, theorems, topic links, and so on.</p>
-
-<p>Many examples of using XDOC can be found throughout the <tt>acl2/books</tt>
-directory.  See for instance the @(see acl2::str) or @(see acl2::osets)
-libraries.</p>
-
-<h3>Note for Advanced Users</h3>
-
-<p>XDOC just stores its documentation in an ordinary ACL2 table, so if you want
-to do something like automatically generate documentation from macros, you
-might decide to bypass @('defxdoc') and just manipulate the table directly.</p>
-
-<p>It is not possible to directly use @('defxdoc') from raw Lisp, but you can
-use @(see defxdoc-raw) instead.</p>")
-
-
-(defxdoc markup
-  :parents (xdoc)
-  :short "XDOC documentation strings are mainly written in a simple XML markup
-language."
-
-  :long "<p>XML is basically similar to HTML, but requires that tags begin and
-end in balance.</p>
-
-<h3>Formatting Text</h3>
-
-<p>Various tags allow you to control the font:</p>
-<ul>
- <li><b>&lt;b&gt;bold&lt;/b&gt;</b></li>
- <li><i>&lt;i&gt;italics&lt;/i&gt;</i></li>
- <li><u>&lt;u&gt;underline&lt;/u&gt;</u></li>
- <li><tt>&lt;tt&gt;typewriter text&lt;/tt&gt;</tt></li>
- <li><color rgb=\"#ff0000\">&lt;color rgb=&quot;#ff0000&quot;&gt;colored text&lt;/color&gt;</color></li>
- <li><sf>&lt;sf&gt;sans-serif&lt;/sf&gt;</sf></li>
-</ul>
-
-<h3>Displaying Source Code</h3>
-
-<p>The @(see preprocessor) allows you to insert function definitions, theorems,
-etc., from the ACL2 world.  But sometimes you want to write other kinds of code
-fragments as examples.</p>
-
-<p>The raw markup options are:</p>
-
-<ul>
-
-<li>Use the @('<tt>') tag for short, inline pieces of code, such as <tt>(+ 1
-x)</tt>.</li>
-
-<li>Use the @('<code>') tag for longer code examples that should be indented
-and \"preformatted,\" i.e., newlines and spaces should be preserved.</li>
-
-</ul>
-
-<p><b>However</b>, it's often better to use the preprocessor's
-<tt>@@('...')</tt> and <tt>@@({...})</tt> macros.  These are nice because they
-automatically escape special HTML characters like &lt; into &amp;lt;, and also
-automatically add hyperlinks to documented functions.</p>
-
-<p>If you do decide to write raw @('<code>') blocks, your lisp forms should
-usually be <b>indented one space</b> to prevent Emacs problems.  For
-instance:</p>
-
-@({
- (defxdoc foo
-   :long \"<h3>How to format @('<code>') blocks</h3>
-
- <p>GOOD -- the form is indented one space:</p>
- <code>
-  (my-lisp-form (foo ...)
-                (bar ...))
- </code>
-
- <p>BAD -- the form is directly on the left-margin:</p>
- <code>
- (my-lisp-form (foo ...)
-               (bar ...))
- </code>
-})
-
-<p>Without this leading space, Emacs can become confused and think that
-@('(my-lisp-form ...)'), rather than @('(defxdoc foo ...)'), is the top-level
-expression.  This can ruin syntax highlighting and also commands like @('C-t
-e') for sending s-expressions to the @('*shell*') window.</p>
-
-
-
-
-<h3>Hyperlinks</h3>
-
-<p><i>Internal links</i> between documentation topics and <i>Emacs
-tags-search links</i> into the source code are handled by the @(see
-preprocessor).</p>
-
-<p>You can add <i>external links</i> to web pages with ordinary HTML-style
-links, e.g.,</p>
-
-@({
-<a href=\"http://www.centtech.com/\">Centaur Technology</a>
-})
-
-<p>Produces a link to <a href=\"http://www.centtech.com/\">Centaur
-Technology</a>.</p>
-
-
-<h3>Structuring Documents</h3>
-
-<p>For section headings,</p>
-<ul>
- <li>@('<h1>') creates the biggest heading,</li>
- <li>@('<h2>') the next biggest,</li>
- <li>... and so on ...</li>
- <li>@('<h5>') is the smallest heading.</li>
-</ul>
-
-<p>@('<p>') tags should be put around paragraphs.</p>
-
-<blockquote>@('<blockquote>') can be used to create indented paragraphs like
-this one.  (Let's put enough text here to make it word-wrap.  Mumble mumble
-mumble.  Mumble.  Mumble mumble.)</blockquote>
-
-<p>@('<br/>') can be used<br/>
-to write haikus and so on<br/>
-but is discouraged</p>
-
-<p>Bulleted and numbered lists work as in HTML.  The list itself begins with
-@('<ul>') (for bulleted lists) or @('<ol>') (for numbered lists).  Each list
-element is an @('<li>') tag.  For instance,</p>
-
-@({
-<ul>
-  <li>one</li>
-  <li>two</li>
-  <li>three</li>
-</ul>
-})
-
-<p>Produces:</p>
-
-<box>
-<ul>
-  <li>one</li>
-  <li>two</li>
-  <li>three</li>
-</ul>
-</box>
-
-<p>You can also use definition lists, which are comprised of @('<dl>'),
-@('<dt>'), and @('<dd>') tags.  For instance,</p>
-
-@({
-<dl>
-  <dt>Inputs</dt>
-  <dd><tt>x</tt>, the list we are traversing</dd>
-  <dd><tt>max</tt>, limit on how many we can accumulate</dd>
-  <dd><tt>acc</tt>, accumulator for our results</dd>
-</dl>
-})
-
-<p>Produces:</p>
-
-<box>
-<dl>
-  <dt>Inputs</dt>
-  <dd><tt>x</tt>, the list we are traversing</dd>
-  <dd><tt>max</tt>, limit on how many we can accumulate</dd>
-  <dd><tt>acc</tt>, accumulator for our results</dd>
-</dl>
-</box>
-
-<p>These framed boxes are generated with the @('<box>') tag.</p>
-
-<p>It's relatively easy to add new tags.  We'll probably add some kind of image
-support in the future, and maybe other tags that users want.</p>")
-
-
-(defxdoc preprocessor
-  :parents (xdoc)
-  :short "In addition to its @(see markup) language, XDOC includes a
-preprocessor which can be used to interpret certain directives of the form
-@('@(...)')."
-
-  :long "<h3>Functions and Theorems</h3>
-
-<p>To look up function definitions (or pieces of definitions) from the ACL2
-world and insert them into your documentation, you can use:</p>
-
-<ul>
- <li>@('@(def fn)'), insert the definition of <i>fn</i><br/>
-     (also works for theorems, macros, ...)</li>
- <li>@('@(body fn)'), just the body of <i>fn</i></li>
- <li>@('@(formals fn)'), just the formals of <i>fn</i></li>
- <li>@('@(measure fn)'), just the measure of <i>fn</i></li>
- <li>@('@(call fn)'), a generic function call of <i>fn</i></li>
-</ul>
-
-<p>We expect that @('def') and @('body') directives will expand to large code
-fragments, so they are automatically wrapped in @('<code>') blocks.</p>
-
-<p>The @('call') directive is automatically wrapped in @('<tt>') tags, i.e.,
-@('@(call fib)') might become @('<tt>(fib x)</tt>').  An alternative is to use
-@('@(ccall fib)'), for \"code call,\" which inserts @('<code>') tags instead;
-this could be more appropriate for functions with many arguments.</p>
-
-<p>The other directives just become plain text, and you can wrap whatever
-formatting commands you like around them and use them inline in paragraphs,
-etc.</p>
-
-<h3>Adding Examples or Code Fragments</h3>
-
-<p>There's a special syntax to put in \"raw\" text.  This is especially
-useful for examples and code fragments.</p>
-
-<ul>
-<li><tt>@@('...')</tt> inserts @('...') into @('<tt>') tags.</li>
-<li><tt>@@({...})</tt> inserts @('...') into @('<code>') tags.</li>
-</ul>
-
-<p>These have a special feature for automatically linking to documented topics.
-For instance, <tt>@@('consp x')</tt> produces @('(consp x)'), and
-<tt>@@({ (consp x) })</tt> produces:</p>
-
-@({
- (consp x)
-})
-
-
-<h3>Documentation Links</h3>
-
-<p>The easiest way to link between topics is to use @('@(see name)'), which
-expands into a link to @('name').  The text shown to the reader is just the
-name of the topic, in lower case.  Note also that @('@(csee name)') can be used
-for links whose first letter should be capitalized.</p>
-
-<p>For most purposes, @('@(see name)') is adequate and it is also recommended.
-Finer-grained control (e.g., changing the link text) is also possible, but then
-you have to understand how file names get mangled.  The basic story is that
-@('@(see name)') expands to:</p>
-
-@({
-<see topic=\"mangled-topic-name\">printed-topic-name</see>
-})
-
-<p>Where:</p>
-
-<ul>
-
-<li>@('mangled-topic-name') is a canonical, url/file-name friendly,
-human-hostile mangling of @('name')'s package and symbol names, and</li>
-
-<li>@('printed-topic-name') is an XML-escaped variant of @('name'), e.g., where
-@('<') becomes @('&lt;'), etc.; depending on the package of the current topic's
-name, it may or may not include the package portion of @('name').</li>
-
-</ul>
-
-<p>So, to support custom links, we provide</p>
-
-<ul>
- <li>@('@(url name)'), which expands to @('mangled-topic-name')</li>
- <li>@('@(sym name)'), which expands to @('printed-topic-name')</li>
- <li>@('@(csym name)'), like @('sym'), but with the first letter capitalized</li>
-</ul>
-
-<p>You can use these to write your own @('<see>') tags.  You should probably
-<i>never</i> write a @('<see>') tag yourself without using @('@(url ...)').</p>
-
-
-<h3>Emacs Links</h3>
-
-<p>The @('@(srclink name)') directive inserts a source-code link for users who
-have configured their web browser as described in @(see emacs-links).</p>
-
-<p>It is often unnecessary to use @('srclink') directly, because these links
-are automatically inserted by @('@(def fn)').  One good reason to use
-@('srclink') is to link to macros like @(srclink defxdoc), which often are
-written using backquote and hence do not display nicely.</p>
-
-<p>Source links are sometimes inappropriate, e.g., for definitions or theorems
-that are generated by macros.  You can suppress the automatic source links on
-@('def') commands by using @('@(gdef fn)') instead.  This stands for
-\"generated definition.\"</p>
-
-
-<h3>Escaping of @</h3>
-
-<p>Since @('@(') is intercepted by the preprocessor, you may occasionally need
-to escape it.  You can write @('@@') to generate a single @('@') sign.</p>
-
-<p>Besides @('@(') and @('@@'), the preprocessor leaves any other uses of
-@('@') in tact.  So, most uses of @('@'), such as in email addresses, do not
-need to be escaped.</p>")
-
-
-(defxdoc save
-  :parents (xdoc)
-  :short "Saves the XDOC database as @('.xml') files (which can also be
-translated into HTML or other formats)."
-
-  :long "<p>Once you have documented your library with @(see defxdoc), you may
-wish to create a manual that can be viewed from a web browser.</p>
-
-
-<h3>Saving a Manual</h3>
-
-<p>The @('xdoc::save') command allows you to save all of the documented topics
-as @('.xml') files.  Here's an example:</p>
-
-@({
- (xdoc::save \"/home/jared/mylib-manual\")
-})
-
-<p>The argument is the name of a directory where the documentation should be
-saved.  If the directory does not exist, it will be created.  If there are
-files in the directory, they <color rgb=\"#ff0000\">may be
-overwritten</color>.</p>
-
-
-<h3>Structure of a Manual</h3>
-
-<p>The resulting @('mylib-manual') directory includes:</p>
-
-<ul>
-
-<li>@('xml/'), a subdirectory with a @('.xml') file for each topic and some
-supporting files, and</li>
-
-<li>@('Makefile'), a Makefile for converting these files into other formats,
-and</li>
-
-<li>@('preview.html'), a web page that lets you directly view the XML files
-using your web browser.</li>
-
-</ul>
-
-<p>Many web browsers can now directly display XML files.  So, you may be able
-to view @('preview.html') without any additional steps.</p>
-
-
-<h3>HTML and Other Formats</h3>
-
-<p>You can generate a plain HTML or TEXT version of your manual by using
-@('make html') or @('make text') from within the directory target of the above
-mentioned @('xdoc::save') command (in this example, the @('mylib-manual')
-directory).  We might add support for TEXINFO or other formats in the
-future.</p>
-
-<p>After running @('make html'), you may wish to open @('frames2.html') and
-@('frames3.html'), which allow you to navigate the HTML manual much like
-@('preview.html') allows you to navigate the XML version.  These pages accept
-an optional argument named <tt>topic</tt> that tells the browser to
-automatically go to a particular topic.  For example, one can go to the
-<tt>XDOC::save</tt> topic by using the url
-<tt>frames3.html?topic=XDOC____SAVE.html</tt>.</p>
-
-<p>Converting to HTML is a good idea because it ensures that all of your tags
-are balanced on every page.  Without this sanity check, your manual might
-contain errors that will prevent some topics from being loaded in a web
-browser.</p>
-
-<p>Creating the HTML code requires Xalan-C++.  Xalan is distributed with many
-Linux distributions.  For example, on Ubuntu, one can run <tt>sudo apt-get
-install xalan</tt> to install it.  Alternatively, see <a
-href=\"http://xml.apache.org/xalan-c/\">Apache Xalan</a> to download.  We have
-accomodated the various versions of Xalan that we know about and use, but we
-welcome modifications to file <tt>support/Makefile-trans</tt> if you wish to
-use a version we do not currently support.</p>")
-
-
-(defxdoc emacs-links
-  :parents (xdoc)
-  :short "Instructions for integrating XDOC web pages with Emacs."
-
-  :long "<p>@(csee preprocessor) directives such as @('@(def get-xdoc-table)')
-result in the introduction of special links for Emacs.  It is possible to
-configure your web browser so that clicking on these links will cause Emacs to
-directly open up the appropriate source file and jump to the named function.
-Here is what such a link looks like:</p>
-
-@(def get-xdoc-table)
-
-<p>How does this work?</p>
-
-<ul>
-
-<li>These Emacs links point to @('xdoc-link') files.</li>
-
-<li>We instruct your web browser to send these files to Emacs.</li>
-
-<li>We instruct Emacs to carry out a tags search instead of loading these
-files.</li>
-
-</ul>
-
-<p>The net effect is that clicking on these links will send you directly to the
-desired function in the source code.  This can be <i>really</i> slick, and
-depending on your web browser, it may not be too hard to set up.</p>
-
-
-<h2>Configuring Emacs</h2>
-
-<h4>Loading the XDOC Elisp</h4>
-
-<p>The XDOC directory includes a file called @('xdoc.el'), which tells emacs
-what to do with these @('xdoc-link') files.  To tell emacs to load this file at
-startup, you can just add a command to your @('.emacs') file such as:</p>
-
-@({
- (load \"/path/to/xdoc/xdoc.el\")
-})
-
-
-<h4>Managing your TAGS tables</h4>
-
-<p>For emacs to make sense of the links you follow, it will need to have the
-appropriate <a
-href=\"http://www.gnu.org/software/emacs/manual/html_node/emacs/Tags.html\">tags
-tables</a> loaded for all of the libraries you are using.</p>
-
-<p>If you aren't familiar with tags, you basically just need to:</p>
-
-<ul>
-
-<li>Occasionally generate @('TAGS') files for your libraries, using the command
-@('etags *.lisp') or similar.</li>
-
-<li>Tell Emacs to \"visit\" these tags tables with @('visit-tags-table').</li>
-
-</ul>
-
-<h5>Jared's Approach:</h5>
-
-<ul>
-
-<li>I add a @('TAGS') target to my Makefiles, so that when I build my library
-the @('etags *.lisp') command is re-run and the @('TAGS') file is kept up to
-date.  The Makefile syntax is:
-
-@({
-TAGS: $(wildcard *.lisp)
-      etags *.lisp
-})</li>
-
-<li>Then, in my @('.emacs') file, I have a series of commands like the
-following:
-
-@({
- (ignore-errors (visit-tags-table \"/path/to/acl2/TAGS\"))
- (ignore-errors (visit-tags-table \"/path/to/acl2/books/xdoc/TAGS\"))
- (ignore-errors (visit-tags-table \"/path/to/my/stuff/TAGS\"))
-})
-
-This ensures that the relevant @('TAGS') files are loaded every time I start
-Emacs.  The use of @('ignore-errors') prevents Emacs from complaining if one of
-these @('TAGS') files was deleted in a \"make clean\" or similar.</li>
-
-<li>One final addition to the @('.emacs') file is:
-
-@({
- (setq tags-revert-without-query t)
-})
-
-which tells Emacs to go ahead and reload these files when they are rebuilt by
-Make, instead of prompting you if you want to reload them.</li>
-
-</ul>
-
-
-<h4>Setting up Emacsclient (recommended)</h4>
-
-<p>You can set things up so that links open up in <b>new instances</b> of
-Emacs, or in <b>new buffers</b> of an already-running Emacs.  If you want
-everything to open up in a new instance of Emacs, you can skip this section.
-But I prefer to use a single Emacs for everything, and just have links open up
-in new buffers.</p>
-
-<p>This is quite easy.  First, add @('(server-start)') to your @('.emacs') file
-and restart Emacs.</p>
-
-<p>Next, to ensure everything is working properly, launch a separate terminal
-and type:</p>
-
-@({
-emacsclient --no-wait my-file
-})
-
-<p>If all is well, @('my-file') will be loaded into your already-running emacs
-as a new buffer.</p>
-
-
-
-<h2>Configuring the Web Browser</h2>
-
-<p>The last thing we need to do is instruct your web browser to send
-@('xdoc-link') files to Emacs.  How this is done depends on your web
-browser.</p>
-
-<p>Here are old instructions for Firefox, but I don't believe mime-edit still
-exists/works, so you may need to do something else now.</p>
-
-<p><b>Note:</b> I have not yet found a way to get Firefox to call
-@('emacsclient') with the @('--no-wait') option.  To work around this, I wrote
-a trivial script called @('emacsclient-wrapper.sh'), which is included in the
-XDOC directory.</p>
-
-<ol>
-
-<li>Install the <a
-href=\"https://addons.mozilla.org/en-US/firefox/addon/4498\">MIME Edit</a>
-firefox plugin.  This is quite easy, but requires firefox to be restarted.</li>
-
-<li>Use MIME-EDIT to tell firefox to give @('.xdoc-link') files to emacs:
-
-<ul>
-  <li>Choose (from the menu bar): @('Tools'), @('MIME Edit')</li>
-  <li>Pick the @('Edit') tab</li>
-  <li>Click @('New Type')</li>
-  <li>MIME Type: <u>application/acl2-xdoc-link</u></li>
-  <li>Description: <u>Link to ACL2 Source Code</u></li>
-  <li>Extension: <u>xdoc-link</u></li>
-  <li>When encountered, open file with <u>/path/to/emacsclient-wrapper.sh</u></li>
-</ul>
-
-</li>
-</ol>
-
-<h2>Possibly Necessary: Configuring the Web Server</h2>
-
-<p>This step shouldn't be needed if you're viewing the documentation on your
-hard drive.  But if you are using a web server like Apache to serve your
-documentation, you may need to use something like:</p>
-
-@({
-AddType application/x-acl2-xdoc-link .xdoc-link
-})
-
-<p>to your @('httpd.conf') or an @('.htaccess') file as appropriate.  Without
-this step, your web server might report that @('.xdoc-link') files are just
-text files to the web browser, and the web browser will not load them with the
-content-handler.</p>")
-
-
-
-(defxdoc extract-keyword-from-args
-  :parents (defsection) ; bozo hrmn, where should this go, really?
-  :short "Get the value for a keyword argument like @(':foo value')."
-
-  :long "<p>@(call extract-keyword-from-args) is given @('kwd'), which should
-be a keyword symbol, and a list of @('args') which are typically the @('&rest
-args') given to a macro.  It scans the list of @('args'), looking for the
-indicated keyword, and returns @('(kwd . value)'), or @('nil') if no such
-keyword is found.  For instance,</p>
-
-@({
- (extract-keyword-from-args :bar '(:foo 3 :bar 5 :baz 7))
-   -->
- (:bar . 5)
-})
-
-<p>This function is mainly useful for writing macros that mix @('&rest') parts
-with keyword arguments.  See also @(see throw-away-keyword-parts).</p>
-
-@(def extract-keyword-from-args)")
-
-
-(defxdoc throw-away-keyword-parts
-  :parents (defsection) ; bozo hrmn, where should this go, really?
-  :short "Throw away any keyword arguments and their values from a macro
-argument list."
-
-  :long "<p>@(call throw-away-keyword-parts) is given a list of arguments that
-are typically the @('&rest args') given to a macro.  It scans the arguments for
-any keyword symbols such as @(':foo'), and throws away both the keyword and the
-argument that follows it.  For instance,</p>
-
-@({
- (throw-away-keyword-parts '(x y z :foo 3 :bar 5 blah blah blah))
-   -->
- '(x y z blah blah blah)
-})
-
-<p>This function is mainly useful for writing macros that mix @('&rest') parts
-with keyword arguments.  See also @(see extract-keyword-from-args).</p>
-
-@(def throw-away-keyword-parts)")
-
-
-(defxdoc defsection
-  :parents (xdoc)
-  :short "Fancy @('(encapsulate nil ...)') with a name and @(see xdoc)
-support."
-
-  :long "<p>The main reasons to use @('defsection') instead of @('(encapsulate
-nil ...)')</p>
-
-<ul>
- <li>It is easier to identify in the @(':pbt') history,</li>
- <li>It indents more nicely than @('encapsulate') in a vanilla emacs,</li>
- <li>It settles the question of where to put the @(see defxdoc) command, and</li>
- <li>It can automatically add the definitions/theorems you supply into the
-     documentation for your section.</li>
-</ul>
-
-<p>General form:</p>
-
-@({
- (defsection name
-    [:parents   parents]
-    [:short     short]
-    [:long      long]
-    [:autodoc   autodoc]
-    [:extension topic]
-    ... events ...)
-})
-
-<p>For example,</p>
-
-@({
- (defsection foo
-   :parents (parent1 parent2 ...)
-   :short \"@(call foo) is like @(see bar), but better when...\"
-   :long \"<p>The main difference is ...</p>\"
-
-   (defund foo (x) ...)
-   (local (in-theory (enable foo)))
-   (defthm foo-thm1 ...)
-   (defthm foo-thm2 ...))
-})
-
-<h3>Ordinary Sections</h3>
-
-<p>The @(':parents'), @(':short'), and @(':long') keywords are optional.  If
-any of these keywords are provided, they will be used to introduce a @(see
-defxdoc) command; otherwise no documentation will be generated.</p>
-
-<p>By default, the @(':long') string you give will be automatically extended
-with a \"Definitions and Theorems\" part that lists all the (non-local)
-definitions and theorems introduced in the section.  This makes it easy to keep
-the documentation up-to-date as you add and remove theorems to the section.  In
-the above example, the @(':long') field would be extended with:</p>
-
-@({
- <h3>Definition and Theorems</h3>
- @(def foo)
- @(thm foo-thm1)
- @(thm foo-thm2)
-})
-
-<p>If you do not want this automatic documentation, you can turn it off with
-@(':autodoc nil').</p>
-
-<p>By the way, I particularly like to use the above style, where a @('defund')
-is immediately followed by a local @('enable'), because if I want to add a new
-theorem, say @('foo-thm3'), then I can just re-submit the defsection without
-undoing the previous one, and all of the enabling and disabling still happens
-correctly.</p>
-
-<h3>Extended Sections</h3>
-
-<p>The @(':extension') keyword allows you to say that this section is a
-continuation of a previously introduced concept.  When @(':extension topic') is
-provided, then @('topic') must be the name of a previously documented @(see
-xdoc) section, and you are not allowed to use @(':parents') or @(':short')
-since the topic already exists.</p>
-
-<p>The main purpose of an @(':extension') section is to add additional
-documentation, either via the @(':long') string or via the automatic
-documentation generation features of @('defsection').  The documentation
-obtained this way is just appended onto the existing @(':long') for the
-topic.</p>
-
-<p>For example, if we have already given the section @('foo') with basic
-theorems, above we now want to add a bunch of additional \"advanced\" theorems
-about it, we might write something like this:</p>
-
-@({
- (defsection advanced-theorems-about-foo
-   :extension foo
-   (defthm foo-thm3 ...)
-   (defthm foo-thm4 ...))
-})
-
-<p>This will then append the definitions of @('foo-thm3') and @('foo-thm4')
-onto the end of the documentation for @('foo').</p>")
-
-
-(defxdoc defsection-progn
-  :parents (xdoc)
-  :short "Fancy @('(progn ...)') with a name and @(see xdoc) support."
-
-  :long "<p>The @('defsection-progn') macro is like @(see defsection) except
-that it generates a @('(progn ...)') instead of an @('(encapsulate nil
-...)').</p>
-
-<p>This has a number of consequences, mostly having to do with the scope of
-@('local') events within the section.  A @('defsection-progn') basically does
-not introduce a new scope, whereas a @('defsection') does.</p>")
-
-
-(defxdoc undocumented
-  :short "Placeholder for undocumented topics.")
-
-
-(defxdoc test-of-entities
-  :parents (xdoc)
-  :short "Placeholder topic for testing out HTML entity support in XDOC."
-  :long "<p>Here are the entities that XDOC allows:</p>
-
-<p>Normal XML entities:</p>
-<ul>
-<li>@('&amp;')   becomes &amp;</li>
-<li>@('&lt;')    becomes &lt;</li>
-<li>@('&gt;')    becomes &gt;</li>
-<li>@('&quot;')  becomes &quot;</li>
-<li>@('&apos;')  becomes &apos;</li>
-</ul>
-
-<p>Additional entities allowed by XDOC:</p>
-<ul>
-<li>@('&nbsp;')  becomes &nbsp; (this one can be hard to see)</li>
-<li>@('&mdash;') becomes &mdash;</li>
-<li>@('&rarr;')  becomes &rarr;</li>
-</ul>")
diff -Nru acl2-6.2/books/xdoc-impl/unversioned-files-extra.txt acl2-6.3/books/xdoc-impl/unversioned-files-extra.txt
--- acl2-6.2/books/xdoc-impl/unversioned-files-extra.txt	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/unversioned-files-extra.txt	1970-01-01 00:00:00.000000000 +0000
@@ -1,2 +0,0 @@
-manual
-bookdoc.dat
diff -Nru acl2-6.2/books/xdoc-impl/write-acl2-xdoc.lisp acl2-6.3/books/xdoc-impl/write-acl2-xdoc.lisp
--- acl2-6.2/books/xdoc-impl/write-acl2-xdoc.lisp	2013-06-06 17:11:50.000000000 +0000
+++ acl2-6.3/books/xdoc-impl/write-acl2-xdoc.lisp	1970-01-01 00:00:00.000000000 +0000
@@ -1,294 +0,0 @@
-; Conversion from ACL2 :DOC into XDOC Format
-; Copyright (C) 2011  University of Texas at Austin
-
-; This program is free software; you can redistribute it and/or modify it under
-; the terms of Version 2 of the GNU General Public License as published by the
-; Free Software Foundation.
-
-; This program is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-; GNU General Public License for more details.
-
-; You should have received a copy of the GNU General Public License
-; along with this program; if not, write to the Free Software
-; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-; Written by:  Matt Kaufmann               and J Strother Moore
-; email:       Kaufmann@cs.utexas.edu      and Moore@cs.utexas.edu
-; Department of Computer Science
-; University of Texas at Austin
-; Austin, TX 78701 U.S.A.
-
-; This file is based on doc/write-acl2-html.lisp, and serves to produce an xdoc
-; list (see books/xdoc/top.lisp) from (global-val 'documentation-alist (w
-; state)).  Thanks to Jared Davis for his assistance in developing this file.
-
-(in-package "ACL2-USER")
-
-(acl2::set-state-ok t)
-
-(acl2::program)
-
-; The idea of node names:  first apply the character substitution table, then
-; deal with the colon.
-
-(defconst *xdoc-doc-char-subst-table*
-  '((#\& #\& #\a #\m #\p #\;)
-    (#\< #\& #\l #\t #\;)
-    (#\> #\& #\g #\t #\;)
-    (#\@ #\@ #\@))
-  "Table with entries (char . char-list) for substituting characters.")
-
-(defconst *xdoc-doc-markup-table*
-  '(("-" nil .    "--")
-    ("B" nil .  "<b>~st</b>")
-    ("BF" nil .  "~%<code>")
-    ("BID" nil .    "")      ;begin implementation dependent
-    ("BPAR" nil .  "<p>")
-
-; XDOC question: Is <blockquote> supported?  I generate it just below.
-
-; A: it isn't supported, but I'll add support for it.
-
-    ("BQ" nil .  "</p>~%<blockquote><p>")
-    ("BV" nil .  "~%<code>")
-    ("C" nil .  "<tt>~st</tt>")
-    ("EF" nil .  "</code>~%")
-    ("EID" nil .    "")      ;end implementation dependent
-    ("EM" nil .  "<i>~st</i>") ;emphasis
-    ("EPAR" nil .  "</p>")
-    ("EQ" nil .  "</p></blockquote>~%<p>")
-    ("EV" nil .  "</code>~%")
-
-; XDOC question: Is <img> supported?  I generate it just below, but I'm not
-; sure I do it right.
-
-; A: hrmn.  not supported right now.  I'm just going to put in [image] until
-; I add support for it.
-
-;    ("GIF" nil . "<img src=~st></img>") ;gif files; e.g., ~gif[\"foo.gif\" align=top]
-    ("GIF" nil . "[image]") ;gif files; e.g., ~gif[\"foo.gif\" align=top]
-
-    ("I" nil .  "<i>~st</i>")
-    ("ID" nil .    "")       ;implementation dependent
-    ("IL" t .  "@(see ~sc)")
-    ("ILC" t .  "<tt>@(see ~sc)</tt>")
-    ("L" t .  "See @(see ~sc)")
-    ("NL" nil .  "<br/>~%")
-    ("PAR" nil .  "<p/>~%~%")
-    ("PL" t .  "see @(see ~sc)")
-    ("SC" nil .  "~sT")
-    ("ST" nil .  "<b>~st</b>") ;strong emphasis
-    ("T" nil .  "<tt>~st</tt>")
-    ("TERMINAL" nil . "") ; terminal only, ignore
-
-; XDOC question: Again, is <img> supported?  I generate it just below, but I'm
-; not sure I do it right, especially since it's within <a>.  There's the same
-; issue for "FLY", "WALK", and "LARGE WALK".
-; XDOC question: Is it OK to refer to an image?  I guess twarning.gif will need
-; to be around.
-
-; A: replacing images with [image] for now, I'll add support somehow.
-
-;    ("WARN" nil . "<a href=\"A_Tiny_Warning_Sign.html\"><img src=twarning.gif></img></a>")
-    ("WARN" nil . "[image]")
-
-; Jared note: these don't seem quite right.
-;    ("CLICK-HERE" t .  "Click <a href=\"~sc\">here</a>")
-;    ("PCLICK-HERE" t .  "click <a href=\"~sc\">here</a>")
-    ("CLICK-HERE" t .  "Click <see topic=\"@(url ~sc)\">here</see>")
-    ("PCLICK-HERE" t .  "click <see topic=\"@(url ~sc)\">here</see>")
-
-;    ("FLY" t .  "<a href=\"~sc\"><img src=flying.gif></img></a>")
-;    ("LARGE-FLY" t .  "<a href=\"~sc\"><img src=large-flying.gif></img></a>")
-;    ("WALK" t .  "<a href=\"~sc\"><img src=walking.gif></img></a>")
-;    ("LARGE-WALK" t .  "<a href=\"~sc\"><img src=large-walking.gif></img></a>")
-
-    ("FLY" t .  "[image]")
-    ("LARGE-FLY" t .  "[image]")
-    ("WALK" t .  "[image]")
-    ("LARGE-WALK" t .  "[image]")
-
-; XDOC question: Does this handling of "URL" seem OK?  I think it's
-; appropriate, rather than @(url ...), since it's not for symbols; but I'm not
-; sure.
-
-; A: I think it's probably okay.
-
-    ("URL" nil .  "<a href=\"~st\">~st</a>")
-    )
-  "Table for use in printing documentation strings, when printing to
-an xdoc file.  See :DOC markup")
-
-(defconst *xdoc-vp* ; see print-doc-string-part1
-  '(("BV" "BF") . ("EV" "EF")))
-
-(defconst *xdoc-undocumented-topic*
-  ;; Keep in sync with import-acl2doc.lisp
-  "acl2::broken-link")
-
-(defun jared-string-upcase-first (x)
-  ;; Upper-case the first letter of a string, if it's lower-case.
-  ;; Most one-liners in the acl2 documentation have lower-case descriptions.
-  ;; I prefer upper-case for xdoc.
-  (let ((len (length x)))
-    (if (and (< 0 len)
-             (standard-char-p (char x 0))
-             (not (equal (char-upcase (char x 0))
-                         (char x 0))))
-        (concatenate 'string
-                     (coerce (list (char-upcase (char x 0))) 'string)
-                     (subseq x 1 nil))
-      x)))
-
-(defun write-a-doc-section (doc-tuple doc-fmt-alist channel state)
-
-; We return an xdoc database entry based on doc-tuple.
-
-  (let ((name (if (stringp (nth 0 doc-tuple))
-                  (intern (nth 0 doc-tuple) "ACL2")
-                (nth 0 doc-tuple)))
-        (parent (nth 1 doc-tuple))
-; See comment below about (nth 2 doc-tuple).
-        (doc-string (nth 3 doc-tuple)))
-    (acl2::er-let*
-
-; XDOC change: We avoid writing the header, which would be something like
-; <h1>TOPIC-FOO</h1>.  Note that we no longer give special treatment to "Pages
-; Written Especially for the Tours" in that non-existent header or in the
-; short string (defined just below).
-
-     ((short
-       (pprogn
-        (acl2::print-doc-string-part
-         0 doc-string
-
-; Jared question: what's the purpose of the following?  It seems to insert
-; <code></code> blocks after newlines in the short string... this seems really
-; weird...?
-; It looks like this is inherited from the html writer.  I'm going to just
-; try taking it out.
-
-         "" ; was "<code>   </code>"
-         *xdoc-doc-markup-table* *xdoc-doc-char-subst-table* doc-fmt-alist
-         channel name t *xdoc-undocumented-topic* nil state)
-        (get-output-stream-string$ channel state nil)))
-
-; XDOC change: A block of code including a call (print-name-as-link ...)
-; normally prints the "Major Section" information that we see on html pages,
-; but I'll assume that the xdoc system will manage that sort of thing itself.
-
-      (long
-       (mv-let
-         (ln state)
-         (acl2::print-doc-string-part-mv
-          1 doc-string "" *xdoc-doc-markup-table* *xdoc-doc-char-subst-table*
-          doc-fmt-alist channel (car doc-tuple) :par
-          *xdoc-undocumented-topic* *xdoc-vp* state)
-
-; XDOC change: We omit a call (write-doc-menu ...), assuming that the xdoc
-; system will take care of menus.  But note that our menus include citations
-; which will thus probably be missing from the xdoc documentation unless we
-; take extra measures.  The list of children together with topics collected
-; from :cite and :cited-by fields is found in (nth 2 doc-tuple).
-
-         (pprogn
-          (acl2::print-doc-string-part
-           2 doc-string "" *xdoc-doc-markup-table* *xdoc-doc-char-subst-table*
-           doc-fmt-alist channel (car doc-tuple) ln *xdoc-undocumented-topic*
-           *xdoc-vp* state)
-          (get-output-stream-string$ channel state nil)))))
-
-; XDOC change: unlike the HTML pages, we avoid laying down images that link to
-; the documentation's main page and index.
-
-;    (write-trailer xdoc-file index-file channel state)
-
-     (acl2::value
-      (list (cons :name name)
-            (cons :parents (list parent))
-            (cons :base-pkg
-                  (if (equal (symbol-package-name name) "ACL2-PC")
-                      name
-                    'acl2::rewrite))
-            (cons :short (jared-string-upcase-first short))
-            (cons :long long))))))
-
-(defun xdoc-fmt-alist (doc-alist acc)
-  (cond
-   ((null doc-alist)
-    acc)
-   (t (xdoc-fmt-alist
-       (cdr doc-alist)
-       (cons (let* ((s (caar doc-alist)))
-               (list
-                (cond ((stringp s) s)
-                      (t (let ((name (symbol-name s)))
-                           (cond ((eq s (intern$ name "ACL2"))
-                                  name)
-                                 (t (concatenate 'string
-                                                 (symbol-package-name s)
-                                                 "::"
-                                                 name))))))
-                (cons #\p s)
-                (cons #\c s)))
-             acc)))))
-
-(defun xdoc-alist1 (doc-alist fmt-alist channel state acc)
-  (cond ((endp doc-alist) (acl2::value acc))
-        (t (acl2::er-let*
-            ((entry (write-a-doc-section (car doc-alist) fmt-alist channel
-                                         state)))
-            (xdoc-alist1 (cdr doc-alist) fmt-alist channel state
-                         (cons entry acc))))))
-
-(defun filter-doc-alist (skip-topics doc-alist)
-  (if (atom doc-alist)
-      nil
-    (let* ((doc-tuple (car doc-alist))
-           (name (if (stringp (nth 0 doc-tuple))
-                     (intern (nth 0 doc-tuple) "ACL2")
-                   (nth 0 doc-tuple))))
-      (if (member name skip-topics)
-          (filter-doc-alist skip-topics (cdr doc-alist))
-        (cons doc-tuple
-              (filter-doc-alist skip-topics (cdr doc-alist)))))))
-
-(defun write-xdoc-alist-fn (write-p return-p skip-topics state)
-  (acl2::state-global-let*
-   ((acl2::fmt-hard-right-margin 500 acl2::set-fmt-hard-right-margin)
-    (acl2::fmt-soft-right-margin 480 acl2::set-fmt-soft-right-margin))
-   (let ((doc-alist (global-val 'acl2::documentation-alist
-                                (acl2::w state))))
-     (mv-let
-      (channel state)
-      (open-output-channel :string :object state)
-      (acl2::er-let*
-       ((result (xdoc-alist1 (filter-doc-alist skip-topics doc-alist)
-                             (xdoc-fmt-alist doc-alist nil)
-                             channel state nil)))
-       (pprogn (close-output-channel channel state)
-               (cond (write-p (acl2::f-put-global 'acl2::xdoc-alist
-                                                  result
-                                                  state))
-                     (t state))
-               (acl2::value (and return-p result))))))))
-
-(defmacro acl2::write-xdoc-alist (&key (write-p 't)
-                                       (return-p 'nil)
-                                       (skip-topics 'nil))
-  `(write-xdoc-alist-fn ,write-p ,return-p ,skip-topics state))
-
-; Utility for accessing element of xdoc-alist:
-
-(defun xdoc-entry-fn (name xdoc-alist)
-  (cond ((endp xdoc-alist) nil)
-        ((equal name (cdr (assoc-eq :name (car xdoc-alist))))
-         (car xdoc-alist))
-        (t (xdoc-entry-fn name (cdr xdoc-alist)))))
-
-(defmacro acl2::xdoc-entry (name)
-  `(xdoc-entry-fn ',name
-                  (acl2::f-get-global 'acl2::xdoc-alist
-                                      state)))
diff -Nru acl2-6.2/boot-strap-pass-2.lisp acl2-6.3/boot-strap-pass-2.lisp
--- acl2-6.2/boot-strap-pass-2.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/boot-strap-pass-2.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -1350,13 +1350,17 @@
 ; :acl2-devel set (see discussion in the comment at the top of this section).
 ; For example, cdr of the entry for "system/top" is produced by evaluating:
 ; (include-book "system/top" :dir :system).
-; The indicated books need to be certified with :acl2-devel set, but this takes
-; about 2.5 minutes on a fast machine in Feb. 2013, as follows:
+; The indicated books need to be certified using an ACL2 executable that was
+; built with feature :acl2-devel set, but this takes about 2.5 minutes on a
+; fast machine in Feb. 2013, as follows:
 
 ; make -j 8 regression ACL2_BOOK_DIRS=system ACL2=<:acl2-devel version>
 
 ; Each member of each cdr below is of the form (fn . measured-subset).
 
+; Note that it is not necessary to do a full regression with an :acl2-devel
+; executable; only the books in the keys of this alist need to be certified.
+
   '(("system/top"
      (ARGLISTP)
      (ARGLISTP1 LST)
diff -Nru acl2-6.2/debian/changelog acl2-6.3/debian/changelog
--- acl2-6.2/debian/changelog	2013-07-29 18:54:53.000000000 +0000
+++ acl2-6.3/debian/changelog	2013-10-18 16:10:57.000000000 +0000
@@ -1,3 +1,51 @@
+acl2 (6.3-5) unstable; urgency=low
+
+  * rebuild against latest gcl
+
+ -- Camm Maguire <camm@debian.org>  Fri, 18 Oct 2013 16:10:57 +0000
+
+acl2 (6.3-4) unstable; urgency=low
+
+  * set HOME for mini-proveall make
+
+ -- Camm Maguire <camm@debian.org>  Tue, 15 Oct 2013 14:12:15 +0000
+
+acl2 (6.3-3) unstable; urgency=low
+
+  * set HOME to $(pwd)
+
+ -- Camm Maguire <camm@debian.org>  Mon, 14 Oct 2013 15:09:48 +0000
+
+acl2 (6.3-2) unstable; urgency=low
+
+  * build dep against latest gcl
+
+ -- Camm Maguire <camm@debian.org>  Sat, 12 Oct 2013 01:46:31 +0000
+
+acl2 (6.3-1) unstable; urgency=low
+
+  * New upstream release
+
+ -- Camm Maguire <camm@debian.org>  Wed, 02 Oct 2013 20:19:51 +0000
+
+acl2 (6.2-8) unstable; urgency=low
+
+  * Allow certification failures for 1) dlopen machines, as we cannot
+    control the surpassed 1024 maximum dlopen limit, and 2) machines with
+    an insufficient hard limit on data segment size (e.g. kfreebsd-i386, or any
+    machine which cannot brk 1Gb).
+  * add build-dep on texinfo
+  * add upstream certificate relocation patch to other-events.lisp
+
+ -- Camm Maguire <camm@debian.org>  Mon, 09 Sep 2013 15:27:04 +0000
+
+acl2 (6.2-7) unstable; urgency=low
+
+  * build-dep against latest gcl
+  * again allow optimize-maximum-pages in elementary-bounders.acl2
+
+ -- Camm Maguire <camm@debian.org>  Tue, 06 Aug 2013 11:30:55 +0000
+
 acl2 (6.2-6) unstable; urgency=low
 
   * fix elementary-bounders.acl2
diff -Nru acl2-6.2/debian/control acl2-6.3/debian/control
--- acl2-6.2/debian/control	2013-07-27 12:50:00.000000000 +0000
+++ acl2-6.3/debian/control	2013-10-18 16:11:04.000000000 +0000
@@ -2,7 +2,7 @@
 Section: math
 Priority: optional
 Maintainer: Camm Maguire <camm@debian.org>
-Build-Depends: gcl ( >= 2.6.7+dfsga-37 ), libgmp3-dev, libreadline-dev, emacs24 | emacsen, debhelper ( >= 5 ), texlive-latex-recommended, libxmu-dev, libxaw7-dev, time, tex-common
+Build-Depends: gcl ( >= 2.6.9-12 ), libgmp3-dev, libreadline-dev, emacs24 | emacsen, debhelper ( >= 5 ), texlive-latex-recommended, libxmu-dev, libxaw7-dev, time, tex-common, texinfo
 Standards-Version: 3.9.4
 
 Package: acl2
diff -Nru acl2-6.2/debian/patches/add-upstream-certificate-relocation-patch-to-other-events.lisp acl2-6.3/debian/patches/add-upstream-certificate-relocation-patch-to-other-events.lisp
--- acl2-6.2/debian/patches/add-upstream-certificate-relocation-patch-to-other-events.lisp	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/debian/patches/add-upstream-certificate-relocation-patch-to-other-events.lisp	2013-09-09 15:28:20.000000000 +0000
@@ -0,0 +1,43 @@
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ acl2 (6.2-8) unstable; urgency=low
+ .
+   * Allow certification failures for 1) dlopen machines, as we cannot
+     control the surpassed 1024 maximum dlopen limit, and 2) machines with
+     an insufficient hard limit on data segment size (e.g. kfreebsd-i386, or any
+     machine which cannot brk 1Gb).
+   * add build-dep on texinfo
+   * add upstream certificate relocation patch to other-events.lisp
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: http://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- acl2-6.2.orig/other-events.lisp
++++ acl2-6.2/other-events.lisp
+@@ -12970,7 +12970,9 @@
+    certification-file
+    (replace-string-prefix-in-tree
+     post-alist3 old-dir (length old-dir) new-dir)
+-   expansion-alist pcert-info cert-op ctx state))
++   (replace-string-prefix-in-tree
++    expansion-alist old-dir (length old-dir) new-dir)
++   pcert-info cert-op ctx state))
+ 
+ (defun make-certificate-file (file portcullis post-alist1 post-alist2
+                                    expansion-alist pcert-info
diff -Nru acl2-6.2/debian/patches/series acl2-6.3/debian/patches/series
--- acl2-6.2/debian/patches/series	2013-07-29 18:54:33.000000000 +0000
+++ acl2-6.3/debian/patches/series	2013-09-09 15:28:20.000000000 +0000
@@ -1,3 +1,2 @@
 consolidate-in-6.2
-(setq-si::*optimize-maximum-pages*-nil)-in-elementary-bounders.acl2
-fix-elementary-bounders.acl2
+add-upstream-certificate-relocation-patch-to-other-events.lisp
diff -Nru acl2-6.2/debian/rules acl2-6.3/debian/rules
--- acl2-6.2/debian/rules	2013-07-15 16:33:45.000000000 +0000
+++ acl2-6.3/debian/rules	2013-10-15 14:13:12.000000000 +0000
@@ -71,23 +71,25 @@
 	mv $@.gcl $@
 
 debian/mini-proveall.out: saved_acl2
-	$(MAKE) mini-proveall
+	HOME=$$(pwd) $(MAKE) mini-proveall
 	mv $(@F) $@
 
 books/short-test.log: saved_acl2.c
 	cp saved_acl2 saved_acl2.ori
-	$(MAKE) certify-books-short
+	HOME=$$(pwd) $(MAKE) certify-books-short
 	cp saved_acl2.ori saved_acl2
 
+#	tail -f --pid=$$j --retry $@ $$(find books -name "*.lisp" | sed 's,\.lisp$$,.out,1') & \
+
 debian/test.log: saved_acl2.c
 	mv saved_acl2 saved_acl2.ori
 	cp $< saved_acl2
 	BUILDDIR="$$(dirname $$(pwd))" \
 	FINALDIR="/usr/share/$(PD)" \
-	HOME="/tmp/" \
+	HOME=$$(pwd) \
 	$(MAKE) certify-books >$@ 2>&1 & j=$$! ; \
-	tail -f --pid=$$j --retry $@ $$(find books -name "*.lisp" | sed 's,\.lisp$$,.out,1') & \
-	wait $$j
+	while sleep 1800; do echo Tick; done & k=$$! ; tail -f debian/test.log & l=$! ; \
+	wait $$j ; kill $$k $$l
 	[ -f $@ ] && ! fgrep '**' $@ || echo FULL TEST FAILS
 	for i in $$(find books -name "*.out"); do \
 		if ! [ -e $${i%out}cert ] ; then \
@@ -96,7 +98,9 @@
 		fi ; \
 	done
 	mv saved_acl2.ori saved_acl2
-	[ -f $@ ] && ! fgrep '**' $@
+	[ -f $@ ] && ( ! fgrep '**' $@ || \
+	  gcl -batch -eval "(bye #+native-reloc 1)" || \
+	  [ $$(ulimit -d -H | sed 's,unlimited,1000000,g') -lt 1000000 ] )
 
 books/interface/infix/Makefile: books/interface/infix/makefile
 	sed -e "s,^DIR = .*,DIR = $$(pwd)/books/interface/infix,1" \
@@ -109,7 +113,7 @@
 	touch $@
 
 doc/TEX/acl2-book.ps.gz: saved_acl2
-	HOME="/tmp/" $(MAKE) DOC
+	HOME=$$(pwd) $(MAKE) DOC
 	rm -f doc/HTML/LICENSE
 	find doc -empty -exec rm {} \;
 
diff -Nru acl2-6.2/defpkgs.lisp acl2-6.3/defpkgs.lisp
--- acl2-6.2/defpkgs.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/defpkgs.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -90,9 +90,9 @@
         ACL2-ORACLE ACL2-OUTPUT-CHANNEL-PACKAGE
         ACL2-PACKAGE ACONS ACTIVE-RUNEP
         ADD-BINOP ADD-CUSTOM-KEYWORD-HINT
-        ADD-DEFAULT-HINTS
-        ADD-DEFAULT-HINTS! ADD-INCLUDE-BOOK-DIR
-        ADD-INVISIBLE-FNS ADD-MACRO-ALIAS ADD-MACRO-FN
+        ADD-DEFAULT-HINTS ADD-DEFAULT-HINTS! ADD-INCLUDE-BOOK-DIR
+        ADD-INVISIBLE-FNS ADD-LD-KEYWORD-ALIAS ADD-LD-KEYWORD-ALIAS!
+        ADD-MACRO-ALIAS ADD-MACRO-FN
         ADD-MATCH-FREE-OVERRIDE ADD-NTH-ALIAS
         ADD-OVERRIDE-HINTS ADD-OVERRIDE-HINTS!
         ADD-PAIR ADD-PAIR-PRESERVES-ALL-BOUNDP
@@ -296,7 +296,7 @@
         KNOWN-PACKAGE-ALIST KNOWN-PACKAGE-ALISTP
         KNOWN-PACKAGE-ALISTP-FORWARD-TO-TRUE-LIST-LISTP-AND-ALISTP
         KWOTE
-        KWOTE-LST LAMBDA LAST LD LD-ERROR-ACTION
+        KWOTE-LST LAMBDA LAST LAST-PROVER-STEPS LD LD-ERROR-ACTION
         LD-ERROR-TRIPLES LD-EVISC-TUPLE
         LD-KEYWORD-ALIASES LD-MISSING-INPUT-OK LD-POST-EVAL-PRINT
         LD-PRE-EVAL-FILTER LD-PRE-EVAL-PRINT
@@ -330,7 +330,7 @@
         META-EXTRACT-GLOBAL-FACT META-EXTRACT-GLOBAL-FACT+ META-EXTRACT-RW+-TERM
         MFC MIN MINIMAL-THEORY MINUSP
         MOD MOD-EXPT MONITOR MONITORED-RUNES
-        MORE MORE! MORE-DOC MUST-BE-EQUAL
+        MORE MORE! MORE-DOC MSG MUST-BE-EQUAL
         MUTUAL-RECURSION MUTUAL-RECURSION-GUARDP
         MV MV? MV-LET MV?-LET MV-LIST
         MV-NTH NAT-LISTP NATP NEEDS-SLASHES NEVER-MEMOIZE NEWLINE
@@ -462,11 +462,11 @@
         SET-GAG-MODE SET-GUARD-CHECKING
         SET-IGNORE-DOC-STRING-ERROR
         SET-IGNORE-OK SET-INHIBIT-OUTPUT-LST
-        SET-INHIBIT-WARNINGS
+        SET-INHIBIT-WARNINGS SET-INHIBIT-WARNINGS!
         SET-INHIBITED-SUMMARY-TYPES
         SET-INVISIBLE-FNS-TABLE
         SET-IPRINT SET-IRRELEVANT-FORMALS-OK
-        SET-LD-KEYWORD-ALIASES
+        SET-LD-KEYWORD-ALIASES SET-LD-KEYWORD-ALIASES!
         SET-LD-REDEFINITION-ACTION
         SET-LD-SKIP-PROOFS
         SET-LD-SKIP-PROOFSP SET-LET*-ABSTRACTION
@@ -549,7 +549,7 @@
         SYMBOL-NAME-INTERN-IN-PACKAGE-OF-SYMBOL
         SYMBOL-PACKAGE-NAME SYMBOLP
         SYMBOLP-INTERN-IN-PACKAGE-OF-SYMBOL
-        SYNP SYNTAXP SYS-CALL SYS-CALL-STATUS
+        SYNP SYNTAXP SYS-CALL SYS-CALL+ SYS-CALL-STATUS
         T T-STACK T-STACK-LENGTH T-STACK-LENGTH1
         TABLE TABLE-ALIST TAKE
         TAU-DATA TAU-DATABASE
@@ -594,7 +594,7 @@
         UPPER-CASE-P-FORWARD-TO-ALPHA-CHAR-P
         USER-STOBJ-ALIST USER-STOBJ-ALIST1
         VALUE-TRIPLE VERBOSE-PSTACK VERIFY
-        VERIFY-GUARDS VERIFY-GUARDS-FORMULA
+        VERIFY-GUARDS VERIFY-GUARDS+ VERIFY-GUARDS-FORMULA
         VERIFY-TERMINATION W WALKABOUT
         WARNING! WATERFALL-PARALLELISM WATERFALL-PRINTING
         WET WITH-FAST-ALIST WITH-GUARD-CHECKING
diff -Nru acl2-6.2/defthm.lisp acl2-6.3/defthm.lisp
--- acl2-6.2/defthm.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/defthm.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -1614,7 +1614,7 @@
           proposed :REWRITE rule generated from ~x0 is of the form (equiv LHS ~
           RHS), where equiv was a known equivalence relation when this rule ~
           was originally processed, but that is no longer the case.  As a ~
-          result,the rule is now treated as rewriting (equiv LHS RHS) to t, ~
+          result, the rule is now treated as rewriting (equiv LHS RHS) to t, ~
           and yet a BIND-FREE hypothesis is attempting to bind a variable in ~
           RHS.  Perhaps you can fix this problem by making equiv an ~
           equivalence relation non-locally."
@@ -1678,18 +1678,19 @@
 
   make some arithmetic inequality rules~/
 
-  ~l[rule-classes] for a general discussion of rule classes and how they are
-  used to build rules from formulas.  An example ~c[:]~ilc[corollary] formula
-  from which a ~c[:linear] rule might be built is:
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
   ~bv[]
   Example:
-  (implies (and (eqlablep e)           if inequality reasoning begins to
-                (true-listp x))        consider how (length (member a b))
-           (<= (length (member e x))   compares to any other term, add to
-               (length x)))            set of known inequalities the fact
-                                       that it is no larger than (length b),
-                                       provided (eqlablep a) and (true-listp b)
-                                       rewrite to t
+  (defthm length-member-leq-length       If inequality reasoning begins to
+    (implies (and (eqlablep e)           consider how (length (member a b))
+                  (true-listp x))        compares to any other term, add to
+             (<= (length (member e x))   the set of known inequalities the fact
+                 (length x)))            that it is no larger than (length b),
+    :rule-classes :linear)               provided (eqlablep a) and
+                                         (true-listp b) rewrite to t.
 
   General Form:
   (and ...
@@ -2383,21 +2384,24 @@
 
   show that a relation is well-founded on a set~/
 
-  ~l[rule-classes] for a general discussion of rule classes and
-  how they are used to build rules from formulas.  An example
-  ~c[:]~ilc[corollary] formula from which a ~c[:well-founded-relation] rule might be
-  built is as follows.  (Of course, the functions ~c[pairp], ~c[lex2p], and
-  ~c[ordinate] would have to be defined first.)
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
   ~bv[]
   Example:
-  (and (implies (pairp x) (o-p (ordinate x)))
-       (implies (and (pairp x)
-                     (pairp y)
-                     (lex2p x y))
-                (o< (ordinate x) (ordinate y))))
-  ~ev[]
-  The above example establishes that ~c[lex2p] is a well-founded
-  relation on ~c[pairp]s.  We explain and give details below.~/
+  (defthm lex2p-is-well-founded-relation
+    (and (implies (pairp x) (o-p (ordinate x)))
+         (implies (and (pairp x)
+                       (pairp y)
+                       (lex2p x y))
+                  (o< (ordinate x) (ordinate y))))
+    :rule-classes :well-founded-relation)
+  ~ev[]
+  The example above creates a ~c[:well-founded-relation] rule, where of course
+  the functions ~c[pairp], ~c[lex2p], and ~c[ordinate] would have to be defined
+  first.  It establishes that ~c[lex2p] is a well-founded relation on
+  ~c[pairp]s.  We explain and give details below.~/
 
   Exactly two general forms are recognized:
   ~bv[]
@@ -2648,35 +2652,39 @@
 
   to build a clause into the simplifier~/
 
-  ~l[rule-classes] for a general discussion of rule classes and
-  how they are used to build rules from formulas.  A ~c[:built-in-clause]
-  rule can be built from any formula other than propositional
-  tautologies.  Roughly speaking, the system uses the list of built-in
-  clauses as the first method of proof when attacking a new goal.  Any
-  goal that is subsumed by a built in clause is proved ``silently.''~/
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
 
-  ACL2 maintains a set of ``built-in'' clauses that are used to
-  short-circuit certain theorem proving tasks.  We discuss this at
-  length below.  When a theorem is given the rule class
-  ~c[:built-in-clause] ACL2 flattens the ~ilc[implies] and ~ilc[and] structure of the
-  ~c[:]~ilc[corollary] formula so as to obtain a set of formulas whose
-  conjunction is equivalent to the given corollary.  It then converts
-  each of these to clausal form and adds each clause to the set of
-  built-in clauses.
-
-  For example, the following ~c[:]~ilc[corollary] (regardless of the definition
-  of ~c[abl])
-  ~bv[]
-  (and (implies (and (true-listp x)
-                     (not (equal x nil)))
-                (< (acl2-count (abl x))
-                   (acl2-count x)))
-       (implies (and (true-listp x)
-                     (not (equal nil x)))
-                (< (acl2-count (abl x))
-                   (acl2-count x))))
+  ~bv[]
+  Example:
+  (defthm acl2-count-abl
+    (and (implies (and (true-listp x)
+                       (not (equal x nil)))
+                  (< (acl2-count (abl x))
+                     (acl2-count x)))
+         (implies (and (true-listp x)
+                       (not (equal nil x)))
+                  (< (acl2-count (abl x))
+                     (acl2-count x))))
+    :rule-classes :built-in-clause)
   ~ev[]
-  will build in two clauses,
+
+  A ~c[:built-in-clause] rule can be built from any formula other than
+  propositional tautologies.  Roughly speaking, the system uses the list of
+  built-in clauses as the first method of proof when attacking a new goal.  Any
+  goal that is subsumed by a built in clause is proved ``silently.''~/
+
+  ACL2 maintains a set of ``built-in'' clauses that are used to short-circuit
+  certain theorem proving tasks.  We discuss this at length below.  When a
+  theorem is given the rule class ~c[:built-in-clause] ACL2 flattens the
+  ~ilc[implies] and ~ilc[and] structure of the ~c[:]~ilc[corollary] formula so
+  as to obtain a set of formulas whose conjunction is equivalent to the given
+  corollary.  It then converts each of these to clausal form and adds each
+  clause to the set of built-in clauses.
+
+  The example above (regardless of the definition of ~c[abl]) will build in two
+  clauses,
   ~bv[]
   {(not (true-listp x))
    (equal x nil)
@@ -2723,43 +2731,39 @@
   and the subsumption property just means that ~c[c1] follows trivially
   from ~c[c2] by instantiation.
 
-  The set of built-in clauses is just a set of known theorems in
-  clausal form.  Any formula that is subsumed by a built-in clause is
-  thus a theorem.  If the set of built-in theorems is reasonably
-  small, this little theorem prover is fast.  ACL2 uses the ``built-in
-  clause check'' in four places: (1) at the top of the iteration in
-  the prover -- thus if a built-in clause is generated as a subgoal it
-  will be recognized when that goal is considered, (2) within the
+  The set of built-in clauses is just a set of known theorems in clausal form.
+  Any formula that is subsumed by a built-in clause is thus a theorem.  If the
+  set of built-in theorems is reasonably small, this little theorem prover is
+  fast.  ACL2 uses the ``built-in clause check'' in four places: (1) at the top
+  of the iteration in the prover -- thus if a built-in clause is generated as a
+  subgoal it will be recognized when that goal is considered, (2) within the
   simplifier so that no built-in clause is ever generated by
-  simplification, (3) as a filter on the clauses generated to prove
-  the termination of recursively ~ilc[defun]'d functions and (4) as a
-  filter on the clauses generated to verify the guards of a function.
-
-  The latter two uses are the ones that most often motivate an
-  extension to the set of built-in clauses.  Frequently a given
-  formalization problem requires the definition of many functions
-  which require virtually identical termination and/or guard proofs.
-  These proofs can be short-circuited by extending the set of built-in
-  clauses to contain the most general forms of the clauses generated
-  by the definitional schemes in use.
-
-  The attentive user might have noticed that there are some recursive
-  schemes, e.g., recursion by ~ilc[cdr] after testing ~ilc[consp], that ACL2 just
-  seems to ``know'' are ok, while for others it generates measure
-  clauses to prove.  Actually, it always generates measure clauses but
-  then filters out any that pass the built-in clause check.  When ACL2
-  is initialized, the clause justifying ~ilc[cdr] recursion after a ~ilc[consp]
-  test is added to the set of built-in clauses.  (That clause is ~c[c2]
-  above.)
-
-  Note that only a subsumption check is made; no rewriting or
-  simplification is done.  Thus, if we want the system to ``know''
-  that ~ilc[cdr] recursion is ok after a negative ~ilc[atom] test (which, by the
-  definition of ~ilc[atom], is the same as a ~ilc[consp] test), we have to build
-  in a second clause.  The subsumption algorithm does not ``know''
-  about commutative functions.  Thus, for predictability, we have
-  built in commuted versions of each clause involving commutative
-  functions.  For example, we build in both
+  simplification, (3) as a filter on the clauses generated to prove the
+  termination of recursively ~ilc[defun]'d functions and (4) as a filter on the
+  clauses generated to verify the guards of a function.
+
+  The latter two uses are the ones that most often motivate an extension to the
+  set of built-in clauses.  Frequently a given formalization problem requires
+  the definition of many functions which require virtually identical
+  termination and/or guard proofs.  These proofs can be short-circuited by
+  extending the set of built-in clauses to contain the most general forms of
+  the clauses generated by the definitional schemes in use.
+
+  The attentive user might have noticed that there are some recursive schemes,
+  e.g., recursion by ~ilc[cdr] after testing ~ilc[consp], that ACL2 just seems
+  to ``know'' are ok, while for others it generates measure clauses to prove.
+  Actually, it always generates measure clauses but then filters out any that
+  pass the built-in clause check.  When ACL2 is initialized, the clause
+  justifying ~ilc[cdr] recursion after a ~ilc[consp] test is added to the set
+  of built-in clauses.  (That clause is ~c[c2] above.)
+
+  Note that only a subsumption check is made; no rewriting or simplification is
+  done.  Thus, if we want the system to ``know'' that ~ilc[cdr] recursion is ok
+  after a negative ~ilc[atom] test (which, by the definition of ~ilc[atom], is
+  the same as a ~ilc[consp] test), we have to build in a second clause.  The
+  subsumption algorithm does not ``know'' about commutative functions.  Thus,
+  for predictability, we have built in commuted versions of each clause
+  involving commutative functions.  For example, we build in both
   ~bv[]
   {(not (integerp x))
    (< 0 x)
@@ -3052,29 +3056,28 @@
 
   make a rule used by the typing mechanism~/
 
-  ~l[rule-classes] for a general discussion of rule classes and
-  how they are used to build rules from formulas.  An example
-  ~c[:]~ilc[corollary] formula from which a ~c[:compound-recognizer] rule might be
-  built is:
-  ~bv[]
-  Example:
-  (implies (alistp x)         When (alistp x) is assumed true,
-           (true-listp x))    add the additional hypothesis that x
-                              is of primitive type true-listp.~/
-  ~ev[]
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
 
-  Before presenting the General Forms, we start with a motivating example.  The
-  following provides a nice example of a ~c[:compound-recognizer] rule that is
-  built into ACL2.
   ~bv[]
-  (defthm natp-compound-recognizer
+  Examples:
+  (defthm alistp-implies-true-listp-compound-recognizer
+    (implies (alistp x)                 ; When (alistp x) is assumed true, add
+             (true-listp x))            ; the additional hypothesis that x is
+    :rule-classes :compound-recognizer) ; of primitive type true-listp.~/
+
+  (defthm natp-compound-recognizer      ; See discussion below.
     (equal (natp x)
            (and (integerp x)
                 (<= 0 x)))
     :rule-classes :compound-recognizer)
   ~ev[]
-  To see how this rule might be useful, consider the following (admittedly very
-  simple) ~il[events].
+
+  Before presenting the General Forms, we start with a motivating example: the
+  second ~ilc[defthm] form above, which provides a nice example of a
+  ~c[:compound-recognizer] rule that is built into ACL2.  To see how this rule
+  might be useful, consider the following (admittedly very simple) ~il[events].
   ~bv[]
   (defun triple (x)
     (* 3 x))
@@ -3590,23 +3593,25 @@
 
   make a rule to forward chain when a certain trigger arises~/
 
-  ~l[rule-classes] for a general discussion of rule classes and how they are
-  used to build rules from formulas.
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
 
   ~bv[]
   Examples:
-  (defthm p-and-r-forward
-   (implies (and (p x) (r x))       ; When (p a) appears in a formula to be
-            (q (f x)))              ; simplified, try to establish (p a) and
-                                    ; (r a) and, if successful, add (q (f a))
-                                    ; to the known assumptions.
-   :rule-classes :forward-chaining)
-
-  ; Equivalent to the above:
-  (defthm p-and-r-forward
-   (implies (and (p x) (r x))
-            (q (f x)))
-   :rule-classes ((:forward-chaining :trigger-terms ((p x)))))
+
+  (defthm p-and-r-forward           ; When (p a) appears in a formula to be
+   (implies (and (p x) (r x))       ; simplified, try to establish (p a) and
+            (q (f x)))              ; (r a) and, if successful, add (q (f a))
+   :rule-classes :forward-chaining) ; to the known assumptions.
+
+  (defthm p-and-r-forward           ; as above with most defaults filled in
+    (implies (and (p x) (r x))
+             (q (f x)))
+    :rule-classes ((:forward-chaining :trigger-terms ((p x))
+                                      :corollary (implies (and (p x) (r x))
+                                                          (q (f x)))
+                                      :match-free :all)))
   ~ev[]
 
   To specify the triggering terms provide a non-empty list of terms
@@ -3968,11 +3973,38 @@
 
   make a ~c[:meta] rule (a hand-written simplifier)~/
 
-  ~l[rule-classes] for a general discussion of rule classes and how they are
-  used to build rules from formulas.  Meta rules extend the ACL2 simplifier
-  with hand-written code to transform certain terms to equivalent ones.  To add
-  a meta rule, the ~c[:]~ilc[corollary] formula must establish that the
-  hand-written ``metafunction'' preserves the meaning of the transformed term.
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
+  Meta rules extend the ACL2 simplifier with hand-written code to transform
+  certain terms to equivalent ones.  To add a meta rule, the
+  ~c[:]~ilc[corollary] formula must establish that the hand-written
+  ``metafunction'' preserves the meaning of the transformed term.
+
+  ~bv[]
+  Examples:
+  (defthm fn-correct-1                ; Modify the rewriter to use fn to
+    (equal (evl x a)                  ; transform terms that are calls of
+           (evl (fn x) a))            ; nth or of foo.
+    :rule-classes ((:meta :trigger-fns (nth foo))))
+
+  (defthm fn-correct-2                ; As above, but this illustrates
+    (implies (and (pseudo-termp x)    ; that without loss of generality we
+                  (alistp a))         ; may restrict x to be shaped like a
+             (equal (evl x a)         ; term and a to be an alist.
+                    (evl (fn x) a)))
+    :rule-classes ((:meta :trigger-fns (nth foo))))
+
+  (defthm fn-correct-3                ; As above (with or without the
+    (implies (and (pseudo-termp x)    ; hypotheses on x and a), with the
+                  (alistp a)          ; additional restriction that the
+                  (evl (hyp-fn x) a)) ; meaning of (hyp-fn x) is true in
+             (equal (evl x a)         ; the current context.  That is, the
+                    (evl (fn x) a)))  ; applicability of the transformation
+    :rule-classes                     ; may be dependent upon some computed
+    ((:meta :trigger-fns (nth foo)))) ; hypotheses.
+  ~ev[]
 
   While our intention is that the set of ACL2 documentation topics is
   self-contained, readers might find it useful to see the following paper for
@@ -3982,35 +4014,11 @@
   Reasoning in ACL2.''  TPHOLs 2005, ed. J. Hurd and T. F. Melham, LNCS 3603,
   Springer-Verlag, Berlin, 2005, pp. 163-178.~eq[]
 
-  Example ~c[:]~ilc[corollary] formulas from which ~c[:meta] rules might be
-  built are:
-  ~bv[]
-  Examples:
-  (equal (evl x a)                  ; Modify the rewriter to use fn to
-         (evl (fn x) a))            ; transform terms.  The :trigger-fns
-                                    ; of the :meta rule-class specify
-                                    ; the top-most function symbols of
-                                    ; those x that are candidates for
-                                    ; this transformation.
-
-  (implies (and (pseudo-termp x)    ; As above, but this illustrates
-                (alistp a))         ; that without loss of generality we
-           (equal (evl x a)         ; may restrict x to be shaped like a
-                  (evl (fn x) a)))  ; term and a to be an alist.
-
-  (implies (and (pseudo-termp x)    ; As above (with or without the
-                (alistp a)          ; hypotheses on x and a) with the
-                (evl (hyp-fn x) a)) ; additional restriction that the
-           (equal (evl x a)         ; meaning of (hyp-fn x) is true in
-                  (evl (fn x) a)))  ; the current context.  That is, the
-                                    ; applicability of the transforma-
-                                    ; tion may be dependent upon some
-                                    ; computed hypotheses.
-  ~ev[]
   A non-~c[nil] list of function symbols must be supplied as the value
   of the ~c[:trigger-fns] field in a ~c[:meta] rule class object
   (except that a macro alias can stand in for a function symbol;
   ~pl[add-macro-alias]).~/
+
   ~bv[]
   General Forms:
   (implies (and (pseudo-termp x)        ; this hyp is optional
@@ -4905,8 +4913,9 @@
   forward chaining from the (negations of the) other literals in the clause
   returned by ~c[mfc-clause].
 
-  ~c[(mfc-unify-subst mfc)]: returns the unifying substitution when evaluating
-  a ~ilc[syntaxp] or ~ilc[bind-free] hypothesis, else returns ~c[nil].
+  ~c[(mfc-unify-subst mfc)]: returns ~c[nil] except when evaluating
+  a ~ilc[syntaxp] or ~ilc[bind-free] hypothesis, in which case, returns the
+  unifying substitution present at the start of that evaluation.
 
   ~c[(mfc-world mfc)]: returns the ACL2 logical ~ilc[world].
 
@@ -4965,14 +4974,16 @@
   returns the contradiction flag produced by linearizing ~c[term] and adding it
   to the ~c[linear-pot-lst].
 
-  ~c[(mfc-relieve-hyp hyp alist rune target bkptr mfc state): returns ~c[t] or
+  ~c[(mfc-relieve-hyp hyp alist rune target bkptr mfc state)]: returns ~c[t] or
   ~c[nil] according to whether the indicated hypothesis term, ~c[hyp], can be
-  relieved (proved) under the giving variable bindings, ~c[alist].  Here,
-  ~c[hyp] is the hypothesis of the indicated ~ilc[rune] at (one-based) position
-  ~c[bkptr], and ~c[target] is an instantiated term to which ~c[rune] is being
-  applied.  Note that no indication is returned for whether any assumptions
-  have been generated by ~ilc[force] or ~ilc[case-split].  (If you need such a
-  feature, feel free to request it of the ACL2 implementors.)
+  relieved (proved) under the giving variable bindings, ~c[alist].  Note that
+  this function returns ~c[nil] if ~c[hyp] has free variables
+  (~pl[free-variables]).  Here, ~c[hyp] is the hypothesis of the indicated
+  ~ilc[rune] at (one-based) position ~c[bkptr], and ~c[target] is an
+  instantiated term to which ~c[rune] is being applied.  Note that no
+  indication is returned for whether any assumptions have been generated by
+  ~ilc[force] or ~ilc[case-split].  (If you need such a feature, feel free to
+  request it of the ACL2 implementors.)
 
   We explain the ~c[:forcep] and ~c[:ttreep] keyword arguments provided in some
   expressions, as promised above.  Their defaults are ~c[:same] and ~c[nil],
@@ -7036,11 +7047,22 @@
 
   make a destructor elimination rule~/
 
-  ~l[rule-classes] for a general discussion of rule classes and how they are
-  used to build rules from formulas.  Here we describe the class of ~c[:elim]
-  rules, which is fundamentally quite different from the more common class of
-  ~c[:]~ilc[rewrite] rules.  Briefly put, a ~c[:rewrite] rule replaces
-  instances of its left-hand side with corresponding instances of its
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
+  The following example of an ~c[:elim] rule is an important one, and is built
+  into ACL2.
+  ~bv[]
+  (defaxiom car-cdr-elim
+    (implies (consp x)
+             (equal (cons (car x) (cdr x)) x))
+    :rule-classes :elim)
+  ~ev[]
+
+  The class of ~c[:elim] rules is fundamentally quite different from the more
+  common class of ~c[:]~ilc[rewrite] rules.  Briefly put, a ~c[:rewrite] rule
+  replaces instances of its left-hand side with corresponding instances of its
   right-hand side.  But an ~c[:elim] rule, on the other hand, has the effect of
   generalizing so-called ``destructor'' function applications to variables.  In
   essence, applicability of a ~c[:rewrite] rule is based on matching its
@@ -7090,26 +7112,17 @@
   we will focus on it, giving full details when we introduce the ``General
   Form'' below.
 
-  The example above employs the following built-in ~c[:elim] rule named
-  ~c[car-cdr-elim].
-  ~bv[]
-  Example:
-  (implies (consp x)                      when (car v) or (cdr v) appears
-           (equal (cons (car x) (cdr x))  in a conjecture, and v is a
-                  x))                     variable, consider replacing v by
-                                          (cons a b), for two new variables
-                                          a and b.
-  ~ev[]
-  Notice that the situation is complicated a bit by the fact that this
-  replacement is only valid if the variable being replaced a cons structure.
-  Thus, when ACL2 applies ~c[car-cdr-elim] to replace a variable ~c[v], it will
-  split into two cases: one case in which ~c[(consp v)] is true, in which ~c[v]
-  is replaced by ~c[(cons (car v) (cdr v))] and then ~c[(car v)] and
-  ~c[(cdr v)] are generalized to new variables; and one case in which
-  ~c[(consp v)] is false.  In practice, ~c[(consp v)] is often provable,
-  perhaps even literally present as a hypotheses; then of course there is no
-  need to introduce the second case.  That is why there is no such second case
-  in the example above.
+  Notice that the situation can be complicated a bit by a rule's hypotheses.
+  For example, the replacement specified by the rule ~c[car-cdr-elim] (shown
+  near the beginning of this discussion) is only valid if the variable being
+  replaced is a cons structure.  Thus, when ACL2 applies ~c[car-cdr-elim] to
+  replace a variable ~c[v], it will split into two cases: one case in which
+  ~c[(consp v)] is true, in which ~c[v] is replaced by
+  ~c[(cons (car v) (cdr v))] and then ~c[(car v)] and ~c[(cdr v)] are
+  generalized to new variables; and one case in which ~c[(consp v)] is false.
+  In practice, ~c[(consp v)] is often provable, perhaps even literally present
+  as a hypotheses; then of course there is no need to introduce the second
+  case.  That is why there is no such second case in the example above.
 
   You might find ~c[:elim] rules to be useful whenever you have in mind a data
   type that can be built up from its fields with a ``constructor'' function and
@@ -7320,21 +7333,31 @@
 
   make a rule to restrict generalizations~/
 
-  ~l[rule-classes] for a general discussion of rule classes and
-  how they are used to build rules from formulas.  An example
-  ~c[:]~ilc[corollary] formula from which a ~c[:generalize] rule might be built is:
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
   ~bv[]
   Example:
-  any theorem~/
+  (defthm integer-listp-rev
+    (implies (integer-listp x)
+             (integer-listp (rev x)))
+    :rule-classes :generalize)~/
 
   General Form:
   any theorem
   ~ev[]
-  To use such a ~c[:generalize] rule, the system waits until it has
-  decided to generalize some term, ~c[term], by replacing it with some new
-  variable ~c[v].  If any ~c[:generalize] formula can be instantiated so that
-  some non-variable subterm becomes ~c[term], then that instance of the
-  formula is added as a hypothesis.
+  To use a ~c[:generalize] rule, the system waits until it has decided to
+  generalize some term, ~c[term], by replacing it with some new variable ~c[v].
+  If any ~c[:generalize] formula can be instantiated so that some non-variable
+  subterm becomes ~c[term], then that instance of the formula is added as a
+  hypothesis.  Thus for the example above, if the term ~c[(rev x2)] is
+  generalized to the variable ~c[rv] during a proof, then the following is
+  added as a hypothesis when generalizing to a new goal.
+  ~bv[]
+  (implies (integer-listp x2)
+           (integer-listp rv))
+  ~ev[]
 
   At the moment, the best description of how ACL2 ~c[:generalize] rules
   are used may be found in the discussion of ``Generalize Rules,'' page
@@ -7368,29 +7391,47 @@
 
   make a rule that specifies the type of a term~/
 
-  ~l[rule-classes] for a general discussion of rule classes and how they are
-  used to build rules from formulas.  Some example ~c[:]~ilc[corollary]
-  formulas from which ~c[:type-prescription] rules might be built are:
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
   ~bv[]
   Examples:
-  (implies                           (nth n lst) is of type characterp
-   (and (character-listp lst)        provided the two hypotheses can
-        (< n (length lst)))          be established by type reasoning
-   (characterp (nth n lst))).
-
-  (implies                           (demodulize a lst 'value ans) is
-   (and (atom a)                     either a nonnegative integer or
-        (true-listp lst)             of the same type as ans, provided
-        (member-equal a lst))        the hyps can be established by type
-   (or (and                          reasoning
-         (integerp
-          (demodulize a lst 'value ans))
-         (>= (demodulize a lst 'value ans) 0))
-       (equal (demodulize a lst 'value ans) ans))).
+  (defthm integerp-foo                       ; Assumes that foo has been
+    (integerp (foo x y))                     ; defined; then, states that
+    :rule-classes :type-prescription)        ; (foo x y) is of type integer.
+
+  (defthm characterp-nth-type-prescription   ; (Nth n lst) is of type character
+    (implies                                 ; provided the hypotheses can be
+     (and (character-listp lst)              ; established by type reasoning.
+          (<= 0 n)
+          (< n (len lst)))
+     (characterp (nth n lst)))
+    :rule-classes :type-prescription)
+
+  (defthm characterp-nth-type-prescription-alt ; equivalent to the above
+    (implies
+     (and (character-listp lst)
+          (<= 0 n)
+          (< n (len lst)))
+     (characterp (nth n lst)))
+    :rule-classes ((:type-prescription :typed-term (nth n lst))))
+
+  (defthm demodulize-type-for-quote-value  ; (Demodulize a lst 'value ans) is
+    (implies                               ; either a nonnegative integer or
+     (and (atom a)                         ; of the same type as ans, provided
+          (true-listp lst)                 ; the hyps can be established by type
+          (member-equal a lst))            ; reasoning
+     (or (and (integerp (demodulize a lst 'value ans))
+              (>= (demodulize a lst 'value ans) 0))
+       (equal (demodulize a lst 'value ans) ans)))
+    :rule-classes :type-prescription)
   ~ev[]
+
   To specify the term whose type (~pl[type-set]) is described by the rule,
   provide that term as the value of the ~c[:typed-term] field of the rule class
   object.~/
+
   ~bv[]
   General Form (after preprocessing; see below):
   (implies hyps
@@ -7442,13 +7483,13 @@
   ~bv[]
     (defun my-statep (x)
       (and (true-listp x)
-           (equal (length x) 2)))
+           (equal (len x) 2)))
   ~ev[]
   and suppose ~c[(my-statep s)] occurs as a hypothesis of a
   ~c[:type-prescription] rule that is being considered for use in the proof
   attempt for a conjecture with the hypothesis ~c[(my-statep s)].  Since the
   hypothesis in the conjecture is rewritten, it will become the conjunction of
-  ~c[(true-listp s)] and ~c[(equal (length s) 2)].  Those two terms will be
+  ~c[(true-listp s)] and ~c[(equal (len s) 2)].  Those two terms will be
   assumed to have type ~c[t] in the context in which the ~c[:type-prescription]
   rule is tried.  But type reasoning will be unable to deduce that
   ~c[(my-statep s)] has type ~c[t] in this context.  Thus, either ~c[my-statep]
@@ -8024,15 +8065,29 @@
   (mv-let
    (erp hyps concl ts vars ttree)
    (destructure-type-prescription name typed-term term ens wrld)
-   (declare (ignore ts vars))
+   (declare (ignore ts))
    (cond
     (erp (er soft ctx "~@0" erp))
     (t (let* ((weakp
 
 ; We avoid calling weak-type-prescription-rulep if we are going to ignore the
-; warning anyhow.  Otherwise, we construct a temporary world using
+; warning anyhow.  Otherwise, we construct a temporary world.
 
-               (and (not (warning-disabled-p "Type prescription"))
+; We check (null vars) because otherwise, the warning can be needlessly harsh.
+; For example, try submitting these events in a fresh ACL2 session after
+; removing the (null vars) check from this function.
+
+; (defstub foo (x) x)
+; (defaxiom foo-type-prescription
+;           (or (integerp (foo y))
+;               (equal (foo y) y))
+;           :rule-classes :type-prescription)
+
+; Then the warning will be printed without the (null vars) check, even though
+; the rule above is a perfectly good one.
+
+               (and (null vars)
+                    (not (warning-disabled-p "Type prescription"))
                     (let* ((nume (get-next-nume wrld))
                            (rune (list :type-prescription name))
                            (wrld2 (add-type-prescription-rule
@@ -8050,8 +8105,8 @@
             (warning$ ctx ("Type prescription")
                       "The :type-prescription rule generated for ~x0 may be ~
                        weaker than you expect.  Note that the conclusion of a ~
-                       :type-prescription rule is stored as a type rather ~
-                       than a term.  It so happens that~|  ~p1~|is not ~
+                       :type-prescription rule is stored as a numeric type ~
+                       rather than a term.  It so happens that~|  ~p1~|is not ~
                        provable using type-set reasoning in the extension of ~
                        the current world by that rule.  Because information ~
                        has been lost, this rule probably does not have the ~
@@ -8143,20 +8198,24 @@
 
   mark a relation as an equivalence relation~/
 
-  ~l[rule-classes] for a general discussion of rule classes and
-  how they are used to build rules from formulas.  An example
-  ~c[:]~ilc[corollary] formula from which a ~c[:equivalence] rule might be built is
-  as follows.  (We assume that ~c[r-equal] has been defined.)
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
   ~bv[]
   Example:
-  (and (booleanp (r-equal x y))
-       (r-equal x x)
-       (implies (r-equal x y) (r-equal y x))
-       (implies (and (r-equal x y)
-                     (r-equal y z))
-                (r-equal x z))).
+  (defthm r-equal-is-an-equivalence ; assumes that r-equal has been defined
+    (and (booleanp (r-equal x y))
+         (r-equal x x)
+         (implies (r-equal x y) (r-equal y x))
+         (implies (and (r-equal x y)
+                       (r-equal y z))
+                  (r-equal x z)))
+    :rule-classes :equivalence)
   ~ev[]
+
   Also ~pl[defequiv].~/
+
   ~bv[]
   General Form:
   (and (booleanp (equiv x y))
@@ -8785,14 +8844,20 @@
 
   record that one equivalence relation refines another~/
 
-  ~l[rule-classes] for a general discussion of rule classes and
-  how they are used to build rules from formulas.  An example
-  ~c[:]~ilc[corollary] formula from which a ~c[:refinement] rule might be built is:
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
   ~bv[]
   Example:
-  (implies (bag-equal x y) (set-equal y x)).
+  (defthm bag-equal-refines-set-equal
+    (implies (bag-equal x y)
+             (set-equal y x))
+    :rule-classes :refinement)
   ~ev[]
+
   Also ~pl[defrefinement].~/
+
   ~bv[]
   General Form:
   (implies (equiv1 x y) (equiv2 x y))
@@ -8983,12 +9048,17 @@
   ~l[rule-classes] for a general discussion of rule classes and
   how they are used to build rules from formulas.  An example
   ~c[:]~ilc[corollary] formula from which a ~c[:congruence] rule might be built is:
+
   ~bv[]
   Example:
-  (implies (set-equal x y)
-           (iff (memb e x) (memb e y))).
+  (defthm set-equal-implies-iff-memb-2
+    (implies (set-equal x y)
+             (iff (memb e x) (memb e y)))
+    :rule-classes :congruence)
   ~ev[]
+
   Also ~pl[defcong] and ~pl[equivalence].~/
+
   ~bv[]
   General Form:
   (implies (equiv1 xk xk-equiv)
@@ -9383,14 +9453,27 @@
   used to build rules from formulas.  An example ~c[:]~ilc[corollary] formula
   from which a ~c[:definition] rule might be built is:
   ~bv[]
-  Example:
-  (implies (true-listp x)
-           (equal (len x)
-                  (if (null x)
-                      0
+  Examples:
+  (defthm open-len-twice
+    (implies (true-listp x)
+             (equal (len x)
+                    (if (null x)
+                        0
+                      (if (null (cdr x))
+                          1
+                        (+ 2 (len (cddr x)))))))
+    :rule-classes :definition)
+
+  ; Same as above, with :controller-alist made explicit:
+  (defthm open-len-twice
+    (implies (true-listp x)
+             (equal (len x)
+                    (if (null x)
+                        0
                       (if (null (cdr x))
                           1
-                          (+ 2 (len (cddr x)))))))~/
+                        (+ 2 (len (cddr x)))))))
+    :rule-classes ((:definition :controller-alist ((len t)))))~/
 
   General Form:
   (implies hyp (equiv (fn a1 ... an) body))
@@ -9673,65 +9756,62 @@
   make a rule that suggests a certain induction~/
   ~bv[]
   Example:
-  (:induction :corollary t  ; the theorem proved is irrelevant!
-              :pattern (* 1/2 i)
-              :condition (and (integerp i) (>= i 0))
-              :scheme (recursion-by-sub2 i))
+  (defthm recursion-by-sub2-induction-rule
+    t
+    :rule-classes ((:induction :pattern (* 1/2 i)
+                               :condition (and (integerp i) (>= i 0))
+                               :scheme (recursion-by-sub2 i))))
   ~ev[]~/
 
   In ACL2, as in Nqthm, the functions in a conjecture ``suggest'' the
-  inductions considered by the system.  Because every recursive
-  function must be admitted with a justification in terms of a measure
-  that decreases in a well-founded way on a given set of
-  ``controlling'' arguments, every recursive function suggests a dual
-  induction scheme that ``unwinds'' the function from a given
-  application.
+  inductions considered by the system.  Because every recursive function must
+  be admitted with a justification in terms of a measure that decreases in a
+  well-founded way on a given set of ``controlling'' arguments, every recursive
+  function suggests a dual induction scheme that ``unwinds'' the function from
+  a given application.
 
-  For example, since ~ilc[append] (actually ~ilc[binary-append], but we'll ignore
-  the distinction here) decomposes its first argument by successive
+  For example, since ~ilc[append] (actually ~ilc[binary-append], but we'll
+  ignore the distinction here) decomposes its first argument by successive
   ~ilc[cdr]s as long as it is a non-~c[nil] true list, the induction scheme
   suggested by ~c[(append x y)] has a base case supposing ~c[x] to be either
-  not a true list or to be ~c[nil] and then has an induction step in which
-  the induction hypothesis is obtained by replacing ~c[x] by ~c[(cdr x)].
-  This substitution decreases the same measure used to justify the
-  definition of ~ilc[append].  Observe that an induction scheme is suggested
-  by a recursive function application only if the controlling actuals
-  are distinct variables, a condition that is sufficient to ensure
-  that the ``substitution'' used to create the induction hypothesis is
-  indeed a substitution and that it drives down a certain measure.  In
-  particular, ~c[(append (foo x) y)] does not suggest an induction
-  unwinding ~ilc[append] because the induction scheme suggested by
-  ~c[(append x y)] requires that we substitute ~c[(cdr x)] for ~c[x] and
-  we cannot do that if ~c[x] is not a variable symbol.
-
-  Once ACL2 has collected together all the suggested induction schemes
-  it massages them in various ways, combining some to simultaneously
-  unwind certain cliques of functions and vetoing others because they
-  ``flaw'' others.  We do not further discuss the induction heuristics
-  here; the interested reader should see Chapter XIV of A
-  Computational Logic (Boyer and Moore, Academic Press, 1979) which
-  represents a fairly complete description of the induction heuristics
-  of ACL2.
-
-  However, unlike Nqthm, ACL2 provides a means by which the user can
-  elaborate the rules under which function applications suggest
-  induction schemes.  Such rules are called ~c[:induction] rules.  The
-  definitional principle automatically creates an ~c[:induction] rule,
-  named ~c[(:induction fn)], for each admitted recursive function, ~c[fn].  It
-  is this rule that links applications of ~c[fn] to the induction scheme
-  it suggests.  Disabling ~c[(:induction fn)] will prevent ~c[fn] from
-  suggesting the induction scheme derived from its recursive
-  definition.  It is possible for the user to create additional
-  ~c[:induction] rules by using the ~c[:induction] rule class in ~ilc[defthm].
-
-  Technically we are ``overloading'' ~ilc[defthm] by using it in the
-  creation of ~c[:induction] rules because no theorem need be proved to
-  set up the heuristic link represented by an ~c[:induction] rule.
-  However, since ~ilc[defthm] is generally used to create rules and
-  rule-class objects are generally used to specify the exact form of
-  each rule, we maintain that convention and introduce the notion of
-  an ~c[:induction] rule.  An ~c[:induction] rule can be created from any
-  lemma whatsoever.
+  not a true list or to be ~c[nil] and then has an induction step in which the
+  induction hypothesis is obtained by replacing ~c[x] by ~c[(cdr x)].  This
+  substitution decreases the same measure used to justify the definition of
+  ~ilc[append].  Observe that an induction scheme is suggested by a recursive
+  function application only if the controlling actuals are distinct variables,
+  a condition that is sufficient to ensure that the ``substitution'' used to
+  create the induction hypothesis is indeed a substitution and that it drives
+  down a certain measure.  In particular, ~c[(append (foo x) y)] does not
+  suggest an induction unwinding ~ilc[append] because the induction scheme
+  suggested by ~c[(append x y)] requires that we substitute ~c[(cdr x)] for
+  ~c[x] and we cannot do that if ~c[x] is not a variable symbol.
+
+  Once ACL2 has collected together all the suggested induction schemes it
+  massages them in various ways, combining some to simultaneously unwind
+  certain cliques of functions and vetoing others because they ``flaw'' others.
+  We do not further discuss the induction heuristics here; the interested
+  reader should see Chapter XIV of A Computational Logic (Boyer and Moore,
+  Academic Press, 1979) which represents a fairly complete description of the
+  induction heuristics of ACL2.
+
+  However, unlike Nqthm, ACL2 provides a means by which the user can elaborate
+  the rules under which function applications suggest induction schemes.  Such
+  rules are called ~c[:induction] rules.  The definitional principle
+  automatically creates an ~c[:induction] rule, named ~c[(:induction fn)], for
+  each admitted recursive function, ~c[fn].  It is this rule that links
+  applications of ~c[fn] to the induction scheme it suggests.  Disabling
+  ~c[(:induction fn)] will prevent ~c[fn] from suggesting the induction scheme
+  derived from its recursive definition.  It is possible for the user to create
+  additional ~c[:induction] rules by using the ~c[:induction] rule class in
+  ~ilc[defthm].
+
+  Technically we are ``overloading'' ~ilc[defthm] by using it in the creation
+  of ~c[:induction] rules because no theorem need be proved to set up the
+  heuristic link represented by an ~c[:induction] rule.  However, since
+  ~ilc[defthm] is generally used to create rules and rule-class objects are
+  generally used to specify the exact form of each rule, we maintain that
+  convention and introduce the notion of an ~c[:induction] rule.  An
+  ~c[:induction] rule can be created from any lemma whatsoever.
   ~bv[]
   General Form of an :induction Lemma or Corollary:
   T
@@ -9741,9 +9821,9 @@
               :condition cond-term
               :scheme scheme-term)
   ~ev[]
-  where ~c[pat-term], ~c[cond-term], and ~c[scheme-term] are all terms, ~c[pat-term]
-  is the application of a function symbol, ~c[fn], ~c[scheme-term] is the
-  application of a function symbol, ~c[rec-fn], that suggests an
+  where ~c[pat-term], ~c[cond-term], and ~c[scheme-term] are all terms,
+  ~c[pat-term] is the application of a function symbol, ~c[fn], ~c[scheme-term]
+  is the application of a function symbol, ~c[rec-fn], that suggests an
   induction, and, finally, every free variable of ~c[cond-term] and
   ~c[scheme-term] is a free variable of ~c[pat-term].  We actually check that
   ~c[rec-fn] is either recursively defined ~-[] so that it suggests the
@@ -9751,15 +9831,15 @@
   ~c[:induction] rule has been proved linking a call of ~c[rec-fn] as the
   ~c[:pattern] to some scheme.
 
-  The induction rule created is used as follows.  When an instance of
-  the ~c[:pattern] term occurs in a conjecture to be proved by induction
-  and the corresponding instance of the ~c[:condition] term is known to be
+  The induction rule created is used as follows.  When an instance of the
+  ~c[:pattern] term occurs in a conjecture to be proved by induction and the
+  corresponding instance of the ~c[:condition] term is known to be
   non-~c[nil] (by type reasoning alone), the corresponding instance of the
-  ~c[:scheme] term is created and the rule ``suggests'' the induction, if
-  any, suggested by that term.  (Analysis of that term may further involve
-  induction rules, though the applied rule is removed from consideration during
-  that further analysis, in order to avoid looping.)  If ~c[rec-fn] is
-  recursive, then the suggestion is the one that unwinds that recursion.
+  ~c[:scheme] term is created and the rule ``suggests'' the induction, if any,
+  suggested by that term.  (Analysis of that term may further involve induction
+  rules, though the applied rule is removed from consideration during that
+  further analysis, in order to avoid looping.)  If ~c[rec-fn] is recursive,
+  then the suggestion is the one that unwinds that recursion.
 
   Consider, for example, the example given above,
   ~bv[]
@@ -9776,11 +9856,11 @@
         (recursion-by-sub2 (- i 2))
         t))
   ~ev[]
-  Observe that this function recursively decomposes its integer
-  argument by subtracting ~c[2] from it repeatedly and stops when the
-  argument is ~c[1] or less.  The value of the function is irrelevant; it
-  is its induction scheme that concerns us.  The induction scheme
-  suggested by ~c[(recursion-by-sub2 i)] is
+  Observe that this function recursively decomposes its integer argument by
+  subtracting ~c[2] from it repeatedly and stops when the argument is ~c[1] or
+  less.  The value of the function is irrelevant; it is its induction scheme
+  that concerns us.  The induction scheme suggested by
+  ~c[(recursion-by-sub2 i)] is
   ~bv[]
   (and (implies (not (and (integerp i) (< 1 i)))   ; base case
                 (:p i))
@@ -9788,50 +9868,48 @@
                      (:p (- i 2)))
                 (:p i)))
   ~ev[]
-  We can think of the base case as covering two situations.  The
-  first is when ~c[i] is not an integer.  The second is when the integer ~c[i]
-  is ~c[0] or ~c[1].  In the base case we must prove ~c[(:p i)] without further
-  help.  The induction step deals with those integer ~c[i] greater than ~c[1],
-  and inductively assumes the conjecture for ~c[i-2] while proving it for
-  ~c[i].  Let us call this scheme ``induction on ~c[i] by twos.''
-
-  Suppose the above ~c[:induction] rule has been added.  Then an
-  occurrence of, say, ~c[(* 1/2 k)] in a conjecture to be proved by
-  induction would suggest, via this rule, an induction on ~c[k] by twos,
-  provided ~c[k] was known to be a nonnegative integer.  This is because
-  the induction rule's ~c[:pattern] is matched in the conjecture, its
-  ~c[:condition] is satisfied, and the ~c[:scheme] suggested by the rule is
-  that derived from ~c[(recursion-by-sub2 k)], which is induction on ~c[k] by
-  twos.  Similarly, the term ~c[(* 1/2 (length l))] would suggest no
-  induction via this rule, even though the rule ``fires'' because it
-  creates the ~c[:scheme] ~c[(recursion-by-sub2 (length l))] which suggests no
-  inductions unwinding ~c[recursion-by-sub2] (since the controlling
-  argument of ~c[recursion-by-sub2] in this ~c[:scheme] is not a variable
-  symbol).
+  We can think of the base case as covering two situations.  The first is when
+  ~c[i] is not an integer.  The second is when the integer ~c[i] is ~c[0] or
+  ~c[1].  In the base case we must prove ~c[(:p i)] without further help.  The
+  induction step deals with those integer ~c[i] greater than ~c[1], and
+  inductively assumes the conjecture for ~c[i-2] while proving it for ~c[i].
+  Let us call this scheme ``induction on ~c[i] by twos.''
+
+  Suppose the above ~c[:induction] rule has been added.  Then an occurrence of,
+  say, ~c[(* 1/2 k)] in a conjecture to be proved by induction would suggest,
+  via this rule, an induction on ~c[k] by twos, provided ~c[k] was known to be
+  a nonnegative integer.  This is because the induction rule's ~c[:pattern] is
+  matched in the conjecture, its ~c[:condition] is satisfied, and the
+  ~c[:scheme] suggested by the rule is that derived from
+  ~c[(recursion-by-sub2 k)], which is induction on ~c[k] by twos.  Similarly,
+  the term ~c[(* 1/2 (length l))] would suggest no induction via this rule,
+  even though the rule ``fires'' because it creates the ~c[:scheme]
+  ~c[(recursion-by-sub2 (length l))] which suggests no inductions unwinding
+  ~c[recursion-by-sub2] (since the controlling argument of
+  ~c[recursion-by-sub2] in this ~c[:scheme] is not a variable symbol).
 
   Continuing this example one step further illustrates the utility of
   ~c[:induction] rules.  We could define the function ~c[recursion-by-cddr]
-  that suggests the induction scheme decomposing its ~ilc[consp] argument
-  two ~ilc[cdr]s at a time.  We could then add the ~c[:induction] rule linking
+  that suggests the induction scheme decomposing its ~ilc[consp] argument two
+  ~ilc[cdr]s at a time.  We could then add the ~c[:induction] rule linking
   ~c[(* 1/2 (length x))] to ~c[(recursion-by-cddr x)] and arrange for
   ~c[(* 1/2 (length l))] to suggest induction on ~c[l] by ~ilc[cddr].
 
-  Observe that ~c[:induction] rules require no proofs to be done.  Such a
-  rule is merely a heuristic link between the ~c[:pattern] term, which may
-  occur in conjectures to be proved by induction, and the ~c[:scheme]
-  term, from which an induction scheme may be derived.  Hence, when an
-  ~c[:induction] rule-class is specified in a ~ilc[defthm] event, the theorem
-  proved is irrelevant.  The easiest theorem to prove is, of course,
-  ~c[t].  Thus, we suggest that when an ~c[:induction] rule is to be created,
-  the following form be used:
+  Observe that ~c[:induction] rules require no proofs to be done.  Such a rule
+  is merely a heuristic link between the ~c[:pattern] term, which may occur in
+  conjectures to be proved by induction, and the ~c[:scheme] term, from which
+  an induction scheme may be derived.  Hence, when an ~c[:induction] rule-class
+  is specified in a ~ilc[defthm] event, the theorem proved is irrelevant.  The
+  easiest theorem to prove is, of course, ~c[t].  Thus, we suggest that when an
+  ~c[:induction] rule is to be created, the following form be used:
   ~bv[]
   (defthm name T
     :rule-classes ((:induction :pattern pat-term
                                :condition cond-term
                                :scheme scheme-term)))
   ~ev[]
-  The name of the rule created is ~c[(:induction name)].  When that rune
-  is disabled the heuristic link between ~c[pat-term] and ~c[scheme-term] is
+  The name of the rule created is ~c[(:induction name)].  When that rune is
+  disabled the heuristic link between ~c[pat-term] and ~c[scheme-term] is
   broken.")
 
 (defun chk-acceptable-induction-rule (name term ctx wrld state)
@@ -9864,13 +9942,15 @@
 
   exhibit a new decoding for an ACL2 type-set~/
 
-  ~l[rule-classes] for a general discussion of rule classes and
-  how they are used to build rules from formulas.
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
   ~bv[]
   Example Rule Class:
   (:type-set-inverter
     :corollary (equal (and (counting-number x) (not (equal x 0)))
-                      (and (integerp x) (< x 0)))
+                      (and (integerp x) (< 0 x)))
     :type-set 2)~/
 
   General Forms of Rule Class:
@@ -10018,6 +10098,22 @@
 
   make or apply a ~c[:clause-processor] rule (goal-level simplifier)~/
 
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
+  ~bv[]
+  Example (which we'll return to, below):
+  (defthm correctness-of-note-fact-clause-processor
+    (implies (and (pseudo-term-listp cl)
+                  (alistp a)
+                  (evl0 (conjoin-clauses
+                         (note-fact-clause-processor cl term))
+                        a))
+             (evl0 (disjoin cl) a))
+    :rule-classes :clause-processor)
+  ~ev[]
+
   Also ~pl[define-trusted-clause-processor] for documentation of an analogous
   utility that does not require the clause-processor to be proved correct.  But
   please read the present documentation before reading about that utility.
@@ -10083,9 +10179,10 @@
     ((not x) (if x y z)))
 
   ~ev[]
-  ACL2 can now prove the following theorem automatically.  (Of course,
+  ACL2 can now prove the following theorem automatically.  (This is the example
+  displayed at the outset of this ~il[documentation] topic.)  Of course,
   ~c[:clause-processor] rules about clause-processor functions less trivial
-  than ~c[note-fact-clause-processor] may require lemmas to be proved first!)
+  than ~c[note-fact-clause-processor] may require lemmas to be proved first!
   The function ~c[disjoin] takes a clause and returns its disjunction (the
   result of applying ~ilc[OR] to its members), and ~c[conjoin-clauses] applies
   ~c[disjoin] to every element of a given list of clauses and then conjoins
diff -Nru acl2-6.2/defuns.lisp acl2-6.3/defuns.lisp
--- acl2-6.2/defuns.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/defuns.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -1070,69 +1070,71 @@
 
              (value (cons (or col 0) cl-set-ttree)))
             (t
-             (mv-let (erp ttree state)
-                     (prove (termify-clause-set cl-set)
-                            (make-pspv ens wrld
-                                       :displayed-goal displayed-goal
-                                       :otf-flg otf-flg)
-                            hints ens wrld ctx state)
-                     (cond (erp
-
-; We use io? with error1 instead of the usual (er soft ...), because we want to
-; avoid the cost of computing the alternate t-machines if we won't be printing
-; anyhow.
-
-                            (pprogn
-                             (io? error nil state
-                                  (ctx names t-machines bodies)
-                                  (error-fms
-                                   nil
-                                   ctx
-                                   "The proof of the measure conjecture for ~
-                                    ~&0 has failed.~@1~|"
-                                   (list
-                                    (cons #\0 names)
-                                    (cons #\1
-                                          (if (equal
-                                               t-machines
-                                               (termination-machines
-                                                names bodies
-                                                (make-list (length names)
-                                                           :initial-element
-                                                           :all)))
-                                              ""
-                                            (msg "~|**NOTE**:  The use of ~
-                                                  declaration ~x0 would ~
-                                                  change the measure ~
-                                                  conjecture, perhaps making ~
-                                                  it easier to prove.  See ~
-                                                  :DOC ruler-extenders."
-                                                 '(xargs :ruler-extenders
-                                                         :all)))))
-                                   state))
-                             (silent-error state)))
-                           (t
-                            (mv-let (col state)
-                                    (io? event nil (mv col state)
-                                         (names)
-                                         (fmt "That completes the proof of ~
-                                               the measure theorem for ~&1.  ~
-                                               Thus, we admit ~#1~[this ~
-                                               function~/these functions~] ~
-                                               under the principle of ~
-                                               definition."
-                                              (list (cons #\1 names))
-                                              (proofs-co state)
-                                              state
-                                              nil)
-                                         :default-bindings ((col 0)))
-                                    (pprogn
-                                     (increment-timer 'print-time state)
-                                     (value
-                                      (cons
-                                       (or col 0)
-                                       (cons-tag-trees
-                                        cl-set-ttree ttree)))))))))))))))))))
+             (mv-let
+              (erp ttree state)
+              (prove (termify-clause-set cl-set)
+                     (make-pspv ens wrld
+                                :displayed-goal displayed-goal
+                                :otf-flg otf-flg)
+                     hints ens wrld ctx state)
+              (cond (erp
+                     (let ((erp-msg
+                            (cond
+                             ((subsetp-eq
+                               '(summary error)
+                               (f-get-global 'inhibit-output-lst state))
+
+; This case is an optimization, in order to avoid the computations below, in
+; particular of termination-machines.  Note that erp-msg is potentially used in
+; error output -- see the (er soft ...) form below -- and it is also
+; potentially used in summary output, when print-summary passes to
+; print-failure the first component of the error triple returned below.
+
+                              nil)
+                             (t
+                              (msg
+                               "The proof of the measure conjecture for ~&0 ~
+                                has failed.~@1"
+                               names
+                               (if (equal
+                                    t-machines
+                                    (termination-machines
+                                     names bodies
+                                     (make-list (length names)
+                                                :initial-element
+                                                :all)))
+                                   ""
+                                 (msg "~|**NOTE**:  The use of declaration ~
+                                       ~x0 would change the measure ~
+                                       conjecture, perhaps making it easier ~
+                                       to prove.  See :DOC ruler-extenders."
+                                      '(xargs :ruler-extenders :all))))))))
+                       (mv-let
+                        (erp val state)
+                        (er soft ctx "~@0~|" erp-msg)
+                        (declare (ignore erp val))
+                        (mv (msg "~@0  " erp-msg) nil state))))
+                    (t
+                     (mv-let (col state)
+                             (io? event nil (mv col state)
+                                  (names)
+                                  (fmt "That completes the proof of the ~
+                                        measure theorem for ~&1.  Thus, we ~
+                                        admit ~#1~[this function~/these ~
+                                        functions~] under the principle of ~
+                                        definition."
+                                       (list (cons #\1 names))
+                                       (proofs-co state)
+                                       state
+                                       nil)
+                                  :default-bindings ((col 0)))
+                             (pprogn
+                              (increment-timer 'print-time state)
+                              (value
+                               (cons
+                                (or col 0)
+                                (cons-tag-trees
+                                 cl-set-ttree ttree)))))))))))))))))))
 
 ; When we succeed in proving termination, we will store the
 ; justification properties.
@@ -4615,74 +4617,79 @@
 ; an error and say you can't verify the guards of any of the functions in the
 ; nest.
 
-  (er-let*
-   ((symbol-class
-     (cond ((symbolp name)
-            (value (symbol-class name wrld)))
-           (t
-            (er soft ctx
-                "Verify-guards can only be applied to a name theorem or ~
-                 function symbol.  ~x0 is neither.  See :DOC verify-guards."
-                name)))))
-   (cond
-    ((eq symbol-class :common-lisp-compliant)
-     (value 'redundant))
-    ((getprop name 'theorem nil 'current-acl2-world wrld)
+  (er-let* ((symbol-class
+             (cond ((symbolp name)
+                    (value (symbol-class name wrld)))
+                   (t
+                    (er soft ctx
+                        "~x0 is not a symbol.  See :DOC verify-guards."
+                        name)))))
+    (cond
+     ((eq symbol-class :common-lisp-compliant)
+      (value 'redundant))
+     ((getprop name 'theorem nil 'current-acl2-world wrld)
 
 ; Theorems are of either symbol-class :ideal or :common-lisp-compliant.
 
-     (er-progn
-      (chk-acceptable-verify-guards-formula
-       name
-       (getprop name 'untranslated-theorem nil 'current-acl2-world wrld)
-       ctx wrld state)
-      (value (list name))))
-    ((function-symbolp name wrld)
-     (case symbol-class
-       (:program
-        (er soft ctx
-            "~x0 is :program.  Only :logic functions can have their guards ~
+      (er-progn
+       (chk-acceptable-verify-guards-formula
+        name
+        (getprop name 'untranslated-theorem nil 'current-acl2-world wrld)
+        ctx wrld state)
+       (value (list name))))
+     ((function-symbolp name wrld)
+      (case symbol-class
+        (:program
+         (er soft ctx
+             "~x0 is :program.  Only :logic functions can have their guards ~
              verified.  See :DOC verify-guards."
-            name))
-       (:ideal
-        (let* ((recp (getprop name 'recursivep nil
-                              'current-acl2-world wrld))
-               (names (cond
-                       ((null recp)
-                        (list name))
-                       (t recp)))
-               (non-ideal-names (collect-non-ideals names wrld)))
-          (cond (non-ideal-names
-                 (er soft ctx
-                     "One or more of the mutually-recursive peers of ~x0 ~
+             name))
+        (:ideal
+         (let* ((recp (getprop name 'recursivep nil
+                               'current-acl2-world wrld))
+                (names (cond
+                        ((null recp)
+                         (list name))
+                        (t recp)))
+                (non-ideal-names (collect-non-ideals names wrld)))
+           (cond (non-ideal-names
+                  (er soft ctx
+                      "One or more of the mutually-recursive peers of ~x0 ~
                       either was not defined in :logic mode or has already ~
                       had its guards verified.  The offending function~#1~[ ~
                       is~/s are~] ~&1.  We thus cannot verify the guards of ~
                       ~x0.  This situation can arise only through ~
                       redefinition."
-                     name
-                     non-ideal-names))
-                (t
-                 (er-progn
-                  (chk-common-lisp-compliant-subfunctions
-                   names names
-                   (guard-lst names nil wrld)
-                   wrld "guard" ctx state)
-                  (chk-common-lisp-compliant-subfunctions
-                   names names
-                   (getprop-x-lst names 'unnormalized-body wrld)
-                   wrld "body" ctx state)
-                  (value names))))))
-       (otherwise ; the symbol-class :common-lisp-compliant is handled above
-        (er soft ctx
-            "The argument to VERIFY-GUARDS must be the name of a function ~
-             defined in :logic mode.  ~x0 is thus illegal.  See :DOC ~
-             verify-guards."
-            name))))
-    (t (er soft ctx
-           "~x0 is not a theorem name or a function symbol in the current ~
-            ACL2 world.  See :DOC verify-guards."
-           name)))))
+                      name
+                      non-ideal-names))
+                 (t
+                  (er-progn
+                   (chk-common-lisp-compliant-subfunctions
+                    names names
+                    (guard-lst names nil wrld)
+                    wrld "guard" ctx state)
+                   (chk-common-lisp-compliant-subfunctions
+                    names names
+                    (getprop-x-lst names 'unnormalized-body wrld)
+                    wrld "body" ctx state)
+                   (value names))))))
+        (otherwise ; the symbol-class :common-lisp-compliant is handled above
+         (er soft ctx
+             "Implementation error: Unexpected symbol-class, ~x0, for the ~
+              function symbol ~x1."
+             symbol-class name))))
+     (t (let ((fn (deref-macro-name name (macro-aliases wrld))))
+          (er soft ctx
+              "~x0 is not a theorem name or a function symbol in the current ~
+               ACL2 world.  ~@1"
+              name
+              (cond ((eq fn name) "See :DOC verify-guards.")
+                    (t (msg "Note that ~x0 is a macro-alias for ~x1.  ~
+                             Consider calling verify-guards with argument ~x1 ~
+                             instead, or use verify-guards+.  See :DOC ~
+                             verify-guards, see :DOC verify-guards+, and see ~
+                             :DOC macro-aliases-table."
+                            name fn)))))))))
 
 (defun guard-obligation-clauses (x guard-debug ens wrld state)
 
@@ -4980,17 +4987,29 @@
                            ens wrld ctx state)
                     (cond
                      (erp
-                      (er soft ctx
-                          "The proof of the guard conjecture for ~&0 has ~
-                           failed.  You may wish to avoid specifying a guard, ~
-                           or to supply option :VERIFY-GUARDS ~x1 with the ~
-                           :GUARD.~@2~|"
-                          names
-                          nil
-                          (if guard-debug
-                              ""
-                            "  Otherwise, you may wish to specify ~
-                             :GUARD-DEBUG T; see :DOC verify-guards.")))
+                      (mv-let
+                       (erp1 val state)
+                       (er soft ctx
+                           "The proof of the guard conjecture for ~&0 has ~
+                            failed.  You may wish to avoid specifying a ~
+                            guard, or to supply option :VERIFY-GUARDS ~x1 ~
+                            with the :GUARD.~@2~|"
+                           names
+                           nil
+                           (if guard-debug
+                               ""
+                             "  Otherwise, you may wish to specify ~
+                             :GUARD-DEBUG T; see :DOC verify-guards."))
+                       (declare (ignore erp1))
+                       (mv (msg
+                            "The proof of the guard conjecture for ~&0 has ~
+                             failed; see the discussion above about ~&1.  "
+                            names
+                            (if guard-debug
+                                '(:VERIFY-GUARDS)
+                              '(:VERIFY-GUARDS :GUARD-DEBUG)))
+                           val
+                           state)))
                      (t
                       (mv-let (col state)
                               (io? event nil (mv col state)
@@ -6083,7 +6102,7 @@
 ; fns, args, bodies, types, stobjs, guards, and (if chk-measure-p is true)
 ; measures are equal -- except that the new measure can be (:? v1 ... vk) if
 ; (v1 ... vk) is the measured subset for the old definition.  We return nil if
-; def1 is thus redundant ("identical" to) with def2.  Otherwise we return a
+; def1 is thus redundant with ("identical" to) def2.  Otherwise we return a
 ; message suitable for printing using " Note that ~@k.".
 
 ; Note that def1 might actually be syntactically illegal, e.g., it might
@@ -6250,6 +6269,14 @@
                (car def1)))
          ((not chk-measure-p)
           nil)
+         ((null justification)
+
+; The old definition (def2) was non-recursive.  Then since the names and bodies
+; are identical (as checked above), the new definition (def1) is also
+; non-recursive.  In this case we don't care about the measures; see the
+; comment above about "syntactically illegal".
+
+          nil)
          (t
           (non-identical-defp-chk-measures
            (car def1)
@@ -7212,71 +7239,67 @@
 
   formals that are used but only insignificantly~/
 
-  Let ~c[fn] be a function of ~c[n] arguments.  Let ~c[x] be the ~c[i]th formal of ~c[fn].
-  We say ~c[x] is ``irrelevant in ~c[fn]'' if ~c[x] is not involved in either the
-  ~il[guard] or the measure for ~c[fn], ~c[x] is used in the body, but the value of
+  Let ~c[fn] be a function of ~c[n] arguments.  Let ~c[x] be the ~c[i]th formal
+  of ~c[fn].  We say ~c[x] is ``irrelevant in ~c[fn]'' if ~c[x] does not occur
+  in either the ~il[guard] or the measure for ~c[fn], and the value of
   ~c[(fn a1...ai...an)] is independent of ~c[ai].~/
 
-  The easiest way to define a function with an irrelevant formal is
-  simply not to use the formal in the body of the
-  function.  Such formals are said to be ``ignored'' by Common Lisp
-  and a special declaration is provided to allow ignored formals.
-  ACL2 makes a distinction between ignored and irrelevant formals.  Note
-  however that if a variable is ~ilc[declare]d ~c[ignore]d or ~c[ignorable],
-  then it will not be reported as irrelevant.
+  The easiest way to define a function with an irrelevant formal is simply not
+  to use the formal in the body of the function.  Such formals are said to be
+  ``ignored'' by Common Lisp and a special declaration is provided to allow
+  ignored formals.  ACL2 makes a distinction between ignored and irrelevant
+  formals.  Note however that if a variable is ~ilc[declare]d ~c[ignore]d or
+  ~c[ignorable], then it will not be reported as irrelevant.
 
   An example of an irrelevant formal is ~c[x] in the definition of ~c[fact]
   below.
   ~bv[]
   (defun fact (i x)
     (declare (xargs :guard (and (integerp i) (<= 0 i))))
-    (if (zerop i) 0 (* i (fact (1- i) (cons i x))))).
+    (if (zerop i) 1 (* i (fact (1- i) (cons i x))))).
   ~ev[]
   Observe that ~c[x] is only used in recursive calls of ~c[fact]; it never
-  ``gets out'' into the result.  ACL2 can detect some irrelevant
-  formals by a closure analysis on how the formals are used.  For
-  example, if the ~c[i]th formal is only used in the ~c[i]th argument position
-  of recursive calls, then it is irrelevant.  This is how ~c[x] is used
-  above.
-
-  It is possible for a formal to appear only in recursive calls but
-  still be relevant.  For example, ~c[x] is ~st[not] irrelevant below, even
-  though it only appears in the recursive call.
+  ``gets out'' into the result.  ACL2 can detect some irrelevant formals by a
+  closure analysis on how the formals are used.  For example, if the ~c[i]th
+  formal is only used in the ~c[i]th argument position of recursive calls, then
+  it is irrelevant.  This is how ~c[x] is used above.
+
+  It is possible for a formal to appear only in recursive calls but still be
+  relevant.  For example, ~c[x] is ~st[not] irrelevant below, even though it
+  only appears in the recursive call.
   ~bv[]
   (defun fn (i x) (if (zerop i) 0 (fn x (1- i))))
   ~ev[]
-  The key observation above is that while ~c[x] only appears in a
-  recursive call, it appears in an argument position, namely ~c[i]'s, that
-  is relevant.  (The function above can be admitted with a ~c[:]~ilc[guard]
-  requiring both arguments to be nonnegative integers and the ~c[:measure]
-  ~c[(+ i x)].)
-
-  Establishing that a formal is irrelevant, in the sense defined
-  above, can be an arbitrarily hard problem because it requires
-  theorem proving.  For example, is ~c[x] irrelevant below?
+  The key observation above is that while ~c[x] only appears in a recursive
+  call, it appears in an argument position, namely ~c[i]'s, that is
+  relevant.  (The function above can be admitted with a ~c[:measure] of
+  ~c[(+ (nfix i) (nfix x))].)
+
+  Establishing that a formal is irrelevant, in the sense defined above, can be
+  an arbitrarily hard problem because it requires theorem proving.  For
+  example, is ~c[x] irrelevant below?
   ~bv[]
   (defun test (i j k x) (if (p i j k) 0 x))
   ~ev[]
   Note that the value of ~c[(test i j k x)] is independent of ~c[x] ~-[] thus
-  making ~c[x] irrelevant ~-[] precisely if ~c[(p i j k)] is a theorem.
-  ACL2's syntactic analysis of a definition does not guarantee to
-  notice all irrelevant formals.
-
-  We regard the presence of irrelevant formals as an indication that
-  something is wrong with the definition.  We cause an error on such
-  definitions and suggest that you recode the definition so as to
-  eliminate the irrelevant formals.  If you must have an irrelevant
-  formal, one way to ``trick'' ACL2 into accepting the definition,
-  without slowing down the execution of your function, is to use the
-  formal in an irrelevant way in the ~il[guard].  For example, to admit
-  fact, above, with its irrelevant ~c[x] one might use
+  making ~c[x] irrelevant ~-[] precisely if ~c[(p i j k)] is a theorem.  ACL2's
+  syntactic analysis of a definition does not guarantee to notice all
+  irrelevant formals.
+
+  We regard the presence of irrelevant formals as an indication that something
+  is wrong with the definition.  We cause an error on such definitions and
+  suggest that you recode the definition so as to eliminate the irrelevant
+  formals.  If you must have an irrelevant formal, one way to ``trick'' ACL2
+  into accepting the definition, without slowing down the execution of your
+  function, is to use the formal in an irrelevant way in the ~il[guard].  For
+  example, to admit fact, above, with its irrelevant ~c[x] one might use
   ~bv[]
   (defun fact (i x)
     (declare (xargs :guard (and (integerp i) (<= 0 i) (equal x x))))
     (if (zerop i) 0 (* i (fact (1- i) (cons i x)))))
   ~ev[]
-  For those who really want to turn off this feature, we have
-  provided a way to use the ~ilc[acl2-defaults-table] for this purpose;
+  For those who really want to turn off this feature, we have provided a way to
+  use the ~ilc[acl2-defaults-table] for this purpose;
   ~pl[set-irrelevant-formals-ok].")
 
 (defun chk-logic-subfunctions (names0 names terms wrld str ctx state)
@@ -8197,7 +8220,8 @@
   valid measure involves only those formal parameters.  However, this special
   case is only allowed for definitions that are redundant
   (~pl[redundant-events]) or are executed when skipping proofs
-  (~pl[skip-proofs]).
+  (~pl[skip-proofs]).  Another special case is ~c[:MEASURE nil], which is
+  treated the same as if ~c[:MEASURE] is omitted.
 
   ~c[:RULER-EXTENDERS]~nl[]
   For recursive definitions (possibly mutually recursive), ~c[value] controls
@@ -8349,6 +8373,12 @@
              ld-skip-proofsp)
 (link-doc-to set-ld-keyword-aliases switches-parameters-and-modes
              ld-keyword-aliases)
+(link-doc-to set-ld-keyword-aliases! switches-parameters-and-modes
+             ld-keyword-aliases)
+(link-doc-to add-ld-keyword-alias switches-parameters-and-modes
+             ld-keyword-aliases)
+(link-doc-to add-ld-keyword-alias! switches-parameters-and-modes
+             ld-keyword-aliases)
 (link-doc-to set-ld-redefinition-action switches-parameters-and-modes
              ld-redefinition-action)
 
@@ -8452,6 +8482,8 @@
 (link-doc-to print-summary-user switches-parameters-and-modes
              finalize-event-user)
 
+(link-doc-to apropos miscellaneous finding-documentation)
+
 #+:non-standard-analysis
 (defun build-valid-std-usage-clause (arglist body)
   (cond ((null arglist)
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info acl2-6.3/doc/EMACS/acl2-doc-emacs.info
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info	2013-09-30 17:39:46.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -30,20 +30,20 @@
 
 Indirect:
 acl2-doc-emacs.info-1: 1042
-acl2-doc-emacs.info-2: 296043
-acl2-doc-emacs.info-3: 593912
-acl2-doc-emacs.info-4: 890058
-acl2-doc-emacs.info-5: 1189747
-acl2-doc-emacs.info-6: 1476689
-acl2-doc-emacs.info-7: 1776591
-acl2-doc-emacs.info-8: 2069753
-acl2-doc-emacs.info-9: 2369743
-acl2-doc-emacs.info-10: 2669625
-acl2-doc-emacs.info-11: 2961459
-acl2-doc-emacs.info-12: 3231285
-acl2-doc-emacs.info-13: 3525081
-acl2-doc-emacs.info-14: 3816487
-acl2-doc-emacs.info-15: 4115397
+acl2-doc-emacs.info-2: 296041
+acl2-doc-emacs.info-3: 594532
+acl2-doc-emacs.info-4: 891094
+acl2-doc-emacs.info-5: 1190722
+acl2-doc-emacs.info-6: 1490069
+acl2-doc-emacs.info-7: 1788891
+acl2-doc-emacs.info-8: 2086831
+acl2-doc-emacs.info-9: 2384624
+acl2-doc-emacs.info-10: 2682723
+acl2-doc-emacs.info-11: 2978561
+acl2-doc-emacs.info-12: 3278154
+acl2-doc-emacs.info-13: 3566414
+acl2-doc-emacs.info-14: 3846955
+acl2-doc-emacs.info-15: 4143845
 
 Tag Table:
 (Indirect)
@@ -65,1523 +65,1542 @@
 Node: FUNCTIONAL-INSTANTIATION-EXAMPLE109759
 Node: GUARD-EXAMPLE114950
 Node: MUTUAL-RECURSION-PROOF-EXAMPLE124592
-Node: EMACS130967
-Node: INTERESTING-APPLICATIONS131519
-Node: INTRODUCTION-TO-THE-THEOREM-PROVER138734
-Node: ARCHITECTURE-OF-THE-PROVER159695
-Node: DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS163631
-Node: EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES171024
-Node: EXAMPLE-INDUCTION-SCHEME-BINARY-TREES173829
-Node: EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2174910
-Node: EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION176520
-Node: EXAMPLE-INDUCTION-SCHEME-ON-LISTS178072
-Node: EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES179420
-Node: EXAMPLE-INDUCTION-SCHEME-UPWARDS180469
-Node: EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS182029
-Node: EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS184786
-Node: EXAMPLE-INDUCTIONS186571
-Node: FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS189383
-Node: FURTHER-INFORMATION-ON-REWRITING219363
-Node: GENERALIZING-KEY-CHECKPOINTS225736
-Node: INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS229584
-Node: INTRODUCTION-TO-HINTS237679
-Node: INTRODUCTION-TO-KEY-CHECKPOINTS242602
-Node: INTRODUCTION-TO-REWRITE-RULES-PART-1251581
-Node: INTRODUCTION-TO-REWRITE-RULES-PART-2259870
-Node: INTRODUCTION-TO-THE-DATABASE273216
-Node: INTRODUCTORY-CHALLENGE-PROBLEM-1284282
-Node: INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER285144
-Node: INTRODUCTORY-CHALLENGE-PROBLEM-2286566
-Node: INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER287222
-Node: INTRODUCTORY-CHALLENGE-PROBLEM-3288619
-Node: INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER289643
-Node: INTRODUCTORY-CHALLENGE-PROBLEM-4293795
-Node: INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER296043
-Node: INTRODUCTORY-CHALLENGES319166
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED320762
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE328286
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS329208
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION330970
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF332440
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE339499
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS340848
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER349413
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER353200
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER357492
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING358698
-Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY367830
-Node: POST-INDUCTION-KEY-CHECKPOINTS371032
-Node: PRACTICE-FORMULATING-STRONG-RULES373264
-Node: PRACTICE-FORMULATING-STRONG-RULES-1375058
-Node: PRACTICE-FORMULATING-STRONG-RULES-2379091
-Node: PRACTICE-FORMULATING-STRONG-RULES-3381031
-Node: PRACTICE-FORMULATING-STRONG-RULES-4385557
-Node: PRACTICE-FORMULATING-STRONG-RULES-5386825
-Node: PRACTICE-FORMULATING-STRONG-RULES-6389184
-Node: PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED392874
-Node: SPECIAL-CASES-FOR-REWRITE-RULES405268
-Node: SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES407443
-Node: STRONG-REWRITE-RULES411557
-Node: STARTUP415247
-Node: TIDBITS417924
-Node: TIPS421451
-Node: BDD441486
-Node: BDD-ALGORITHM443147
-Node: BDD-INTRODUCTION466270
-Node: IF*474505
-Node: SHOW-BDD481191
-Node: BOOKS483506
-Node: BOOK-COMPILED-FILE487700
-Node: BOOK-CONTENTS493015
-Node: BOOK-EXAMPLE496129
-Node: BOOK-NAME504465
-Node: BOOKS-CERTIFICATION508520
-Node: BOOKS-CERTIFICATION-CLASSIC519595
-Node: CBD531004
-Node: CERTIFICATE536060
-Node: CERTIFY-BOOK540194
-Node: COMMUNITY-BOOKS551930
-Node: FULL-BOOK-NAME552671
-Node: KEEP554517
-Node: PATHNAME555948
-Node: PORTCULLIS558172
-Node: PROVISIONAL-CERTIFICATION561829
-Node: REGRESSION576572
-Node: SET-CBD576730
-Node: UNCERTIFIED-BOOKS577761
-Node: BREAK-REWRITE580992
-Node: BREAK-LEMMA593912
-Node: BRR597358
-Node: BRR-COMMANDS601090
-Node: BRRatsign603274
-Node: MONITOR609205
-Node: MONITORED-RUNES617625
-Node: OK-IF617993
-Node: UNMONITOR619839
-Node: DOCUMENTATION620638
-Node: *TERMINAL-MARKUP-TABLE*629299
-Node: ARGS630940
-Node: DOC631421
-Node: DOC!634151
-Node: DOC-STRING634529
-Node: DOCS646012
-Node: HELP647977
-Node: MARKUP648229
-Node: MORE658941
-Node: MORE!660772
-Node: MORE-DOC661540
-Node: NQTHM-TO-ACL2662422
-Node: EVENTS670410
-Node: ADD-CUSTOM-KEYWORD-HINT675898
-Node: ASSERT-EVENT679362
-Node: COMP681170
-Node: COMP-GCL686555
-Node: DEFABBREV687192
-Node: DEFABSSTOBJ690406
-Node: DEFABSSTOBJ-MISSING-EVENTS720560
-Node: DEFATTACH721716
-Node: DEFAXIOM743825
-Node: DEFCHOOSE745017
-Node: CONSERVATIVITY-OF-DEFCHOOSE750677
-Node: DEFCONG769992
-Node: DEFCONST771584
-Node: DEFDOC773914
-Node: DEFEQUIV776504
-Node: DEFEVALUATOR777914
-Node: DEFEXEC782297
-Node: DEFINE-TRUSTED-CLAUSE-PROCESSOR790723
-Node: DEFLABEL801783
-Node: DEFMACRO802848
-Node: DEFMACRO-LAST806349
-Node: DEFN806651
-Node: DEFND806804
-Node: DEFPKG806962
-Node: HIDDEN-DEATH-PACKAGE811934
-Node: HIDDEN-DEFPKG814465
-Node: MANAGING-ACL2-PACKAGES814679
-Node: DEFPROXY814999
-Node: DEFPUN825686
-Node: DEFREFINEMENT826958
-Node: DEFSTOBJ828129
-Node: DEFSTUB847617
-Node: DEFTHEORY849370
-Node: DEFTHEORY-STATIC852081
-Node: DEFTHM855117
-Node: DEFTHMD857519
-Node: DEFTTAG858401
-Node: DEFUN870508
-Node: DEFUN-INLINE881549
-Node: DEFUN-NOTINLINE886313
-Node: DEFUN-NX887241
-Node: DEFUN-SK890058
-Node: DEFUN-SK-EXAMPLE902437
-Node: EXISTS906117
-Node: FORALL906559
-Node: QUANTIFIER-TUTORIAL907000
-Node: QUANTIFIERS933264
-Node: QUANTIFIERS-USING-DEFUN-SK935227
-Node: QUANTIFIERS-USING-DEFUN-SK-EXTENDED937023
-Node: QUANTIFIERS-USING-RECURSION939643
-Node: DEFUND940568
-Node: DEFUND-INLINE942097
-Node: DEFUND-NOTINLINE942451
-Node: ENCAPSULATE942823
-Node: EVISC-TABLE955294
-Node: IN-ARITHMETIC-THEORY958884
-Node: IN-THEORY960798
-Node: INCLUDE-BOOK963016
-Node: LOCAL972298
-Node: MAKE-EVENT974058
-Node: MAKE-EVENT-DETAILS995165
-Node: MEMOIZE1006203
-Node: MUTUAL-RECURSION1017634
-Node: PROFILE1022084
-Node: PROGN1024144
-Node: PROGN!1025541
-Node: REGENERATE-TAU-DATABASE1030872
-Node: REMOVE-CUSTOM-KEYWORD-HINT1034385
-Node: RESTORE-MEMOIZATION-SETTINGS1035023
-Node: SAVE-AND-CLEAR-MEMOIZATION-SETTINGS1035606
-Node: SET-BODY1036336
-Node: SHOW-CUSTOM-KEYWORD-HINT-EXPANSION1037684
-Node: TABLE1038496
-Node: USING-TABLES-EFFICIENTLY1048426
-Node: THEORY-INVARIANT1051591
-Node: UNMEMOIZE1057126
-Node: VALUE-TRIPLE1058176
-Node: VERIFY-GUARDS1059871
-Node: VERIFY-TERMINATION1073268
-Node: FORWARD-CHAINING-REPORTS1080628
-Node: FC-REPORT1093397
-Node: RESET-FC-REPORTING1093821
-Node: SET-FC-CRITERIA1094427
-Node: SET-FC-REPORT-ON-THE-FLY1097573
-Node: SHOW-FC-CRITERIA1098541
-Node: HISTORY1098918
-Node: GCS1101656
-Node: GET-COMMAND-SEQUENCE1101798
-Node: OOPS1102618
-Node: PBT1106513
-Node: PC1107357
-Node: PCB1112769
-Node: PCB!1114098
-Node: PCS1114701
-Node: PE1115607
-Node: PE!1117398
-Node: PF1117593
-Node: PL1118210
-Node: PL21120238
-Node: PR1121516
-Node: PR!1123078
-Node: PUFF1124014
-Node: PUFF*1130809
-Node: RESET-KILL-RING1133499
-Node: TAU-DATA1134738
-Node: TAU-DATABASE1135988
-Node: U1136556
-Node: UBT1136912
-Node: UBT!1138740
-Node: UBT-PREHISTORY1139238
-Node: UBU1139655
-Node: UBU!1140850
-Node: HONS-AND-MEMOIZATION1141365
-Node: CLEAR-HASH-TABLES1161022
-Node: CLEAR-MEMOIZE-STATISTICS1161494
-Node: CLEAR-MEMOIZE-TABLE1161986
-Node: CLEAR-MEMOIZE-TABLES1162457
-Node: CONS-SUBTREES1162983
-Node: FAST-ALIST-FREE1163395
-Node: FAST-ALIST-FREE-ON-EXIT1164484
-Node: FAST-ALIST-LEN1165685
-Node: FAST-ALIST-SUMMARY1166474
-Node: FAST-ALISTS1167187
-Node: FLUSH-HONS-GET-HASH-TABLE-LINK1169540
-Node: HONS1169921
-Node: HONS-ACONS1171037
-Node: HONS-ACONS!1173885
-Node: HONS-ASSOC-EQUAL1176373
-Node: HONS-CLEAR1177189
-Node: HONS-COPY1178515
-Node: HONS-COPY-PERSISTENT1179970
-Node: HONS-EQUAL1180807
-Node: HONS-EQUAL-LITE1181906
-Node: HONS-GET1182946
-Node: HONS-NOTE1183776
-Node: HONS-RESIZE1186920
-Node: HONS-SHRINK-ALIST1189747
-Node: HONS-SHRINK-ALIST!1191450
-Node: HONS-SUMMARY1192258
-Node: HONS-WASH1193166
-Node: MAKE-FAST-ALIST1194638
-Node: MEMOIZE-SUMMARY1195653
-Node: MEMSUM1196188
-Node: NEVER-MEMOIZE1196612
-Node: NORMED1197337
-Node: NUMBER-SUBTREES1200201
-Node: SLOW-ALIST-WARNING1200797
-Node: WITH-FAST-ALIST1202003
-Node: WITH-STOLEN-ALIST1204410
-Node: INTRODUCTION-TO-THE-TAU-SYSTEM1205428
-Node: DEALING-WITH-TAU-PROBLEMS1216751
-Node: FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM1223558
-Node: IO1228390
-Node: *STANDARD-CI*1241023
-Node: *STANDARD-CO*1241648
-Node: *STANDARD-OI*1243630
-Node: CHARACTER-ENCODING1244251
-Node: EVISC-TUPLE1245886
-Node: EVISCERATE-HIDE-TERMS1248144
-Node: EXTERNAL-FORMAT1248750
-Node: IPRINT1248909
-Node: IPRINTING1249039
-Node: OPEN-OUTPUT-CHANNEL!1249177
-Node: OUTPUT-TO-FILE1253466
-Node: PRINT-CONTROL1255644
-Node: PRINTING-TO-STRINGS1260603
-Node: RESET-PRINT-CONTROL1263511
-Node: SET-EVISC-TUPLE1263680
-Node: SET-FMT-HARD-RIGHT-MARGIN1268881
-Node: SET-FMT-SOFT-RIGHT-MARGIN1269796
-Node: SET-IPRINT1270110
-Node: SET-PRINT-BASE1278402
-Node: SET-PRINT-CASE1279501
-Node: SET-PRINT-CIRCLE1280993
-Node: SET-PRINT-ESCAPE1281152
-Node: SET-PRINT-LENGTH1281313
-Node: SET-PRINT-LEVEL1281473
-Node: SET-PRINT-LINES1281631
-Node: SET-PRINT-RADIX1281788
-Node: SET-PRINT-READABLY1282972
-Node: SET-PRINT-RIGHT-MARGIN1283142
-Node: WITHOUT-EVISC1283314
-Node: MISCELLANEOUS1285543
-Node: &ALLOW-OTHER-KEYS1296523
-Node: &BODY1296680
-Node: &KEY1296816
-Node: &OPTIONAL1296943
-Node: &REST1297075
-Node: &WHOLE1297205
-Node: A!1297329
-Node: ABORT!1298174
-Node: ACKNOWLEDGMENTS1298444
-Node: ACL2S1305540
-Node: APROPOS1305677
-Node: BACKCHAIN-LIMIT1305921
-Node: BACKCHAIN-LIMIT-RW1312052
-Node: BACKTRACK1312247
-Node: BIBLIOGRAPHY1312421
-Node: BIND-FREE1312682
-Node: BIND-FREE-EXAMPLES1321706
-Node: BY1328786
-Node: CASE-SPLIT1328928
-Node: CASE-SPLIT-LIMITATIONS1330695
-Node: CASES1331448
-Node: CLAUSE-IDENTIFIER1331619
-Node: COMMAND1333617
-Node: COMMAND-DESCRIPTOR1334657
-Node: COMMON-LISP1339047
-Node: DEFUN-MODE-CAVEAT1341219
-Node: GENERALIZED-BOOLEANS1345549
-Node: COMPUTED-HINTS1349287
-Node: CONSTRAINT1357090
-Node: COPYRIGHT1376260
-Node: COROLLARY1377282
-Node: CURRENT-PACKAGE1377636
-Node: CUSTOM-KEYWORD-HINTS1380265
-Node: DEFAULT-BACKCHAIN-LIMIT1380650
-Node: DEFAULT-DEFUN-MODE1381132
-Node: DEFAULT-HINTS1382875
-Node: DEFAULT-PRINT-PROMPT1383617
-Node: DEFAULT-RULER-EXTENDERS1385128
-Node: DEFUN-MODE1385897
-Node: DEFUNS1391531
-Node: DISABLE-FORCING1392409
-Node: DISABLE-IMMEDIATE-FORCE-MODEP1393134
-Node: DISABLEDP1394021
-Node: DO-NOT1395255
-Node: DO-NOT-INDUCT1395412
-Node: DOUBLE-REWRITE1395588
-Node: EMBEDDED-EVENT-FORM1405669
-Node: ENABLE-FORCING1411183
-Node: ENABLE-IMMEDIATE-FORCE-MODEP1411966
-Node: ENTER-BOOT-STRAP-MODE1412850
-Node: ESCAPE-TO-COMMON-LISP1414085
-Node: EXECUTABLE-COUNTERPART1414559
-Node: EXIT-BOOT-STRAP-MODE1418120
-Node: EXPAND1418838
-Node: EXTENDED-METAFUNCTIONS1419015
-Node: FAILED-FORCING1434737
-Node: FAILURE1441395
-Node: FIND-RULES-OF-RUNE1444069
-Node: FNCALL-TERM1445322
-Node: FORCE1445474
-Node: FORCED1451563
-Node: FORCING-ROUND1451693
-Node: FUNCTIONAL-INSTANTIATION-IN-ACL2R1456969
-Node: GAG-MODE1458089
-Node: GC$1458417
-Node: GC-VERBOSE1459393
-Node: GCL1460271
-Node: GET-WORMHOLE-STATUS1464871
-Node: GOAL-SPEC1465667
-Node: GUARD1469743
-Node: EXTRA-INFO1472099
-Node: GUARD-DEBUG1472398
-Node: GUARD-EVALUATION-EXAMPLES-LOG1476689
-Node: GUARD-EVALUATION-EXAMPLES-SCRIPT1498360
-Node: GUARD-EVALUATION-TABLE1504053
-Node: GUARD-INTRODUCTION1509647
-Node: GUARD-MISCELLANY1512019
-Node: GUARD-QUICK-REFERENCE1516201
-Node: GUARDS-AND-EVALUATION1518807
-Node: GUARDS-FOR-SPECIFICATION1535011
-Node: GUARD-HINTS1537353
-Node: HANDS-OFF1537517
-Node: HIDE1537676
-Node: HINTS1541990
-Node: HINTS-AND-THE-WATERFALL1575657
-Node: I-AM-HERE1587038
-Node: IF-INTRO1588040
-Node: IMMED-FORCED1588180
-Node: IMMEDIATE-FORCE-MODEP1588336
-Node: INDUCT1589709
-Node: KEYWORD1589872
-Node: KEYWORD-COMMANDS1590011
-Node: LAMBDA1592389
-Node: LD-ERROR-ACTION1592531
-Node: LD-ERROR-TRIPLES1598101
-Node: LD-EVISC-TUPLE1599163
-Node: LD-KEYWORD-ALIASES1600259
-Node: LD-MISSING-INPUT-OK1602375
-Node: LD-POST-EVAL-PRINT1603254
-Node: LD-PRE-EVAL-FILTER1606521
-Node: LD-PRE-EVAL-PRINT1607843
-Node: LD-PROMPT1609514
-Node: LD-QUERY-CONTROL-ALIST1611342
-Node: LD-REDEFINITION-ACTION1614346
-Node: LD-SKIP-PROOFSP1623438
-Node: LD-VERBOSE1628500
-Node: LEMMA-INSTANCE1629735
-Node: LINEAR-ARITHMETIC1635406
-Node: LOCAL-INCOMPATIBILITY1638738
-Node: LOGICAL-NAME1643434
-Node: LOOP-STOPPER1646751
-Node: LP1654744
-Node: MACRO-ARGS1658137
-Node: MAKE-WORMHOLE-STATUS1661020
-Node: MEASURE1661523
-Node: META-EXTRACT1661693
-Node: META-EXTRACT-CONTEXTUAL-FACT1676851
-Node: META-EXTRACT-FORMULA1677046
-Node: META-EXTRACT-GLOBAL-FACT1677245
-Node: META-EXTRACT-GLOBAL-FACT+1677445
-Node: META-EXTRACT-RW+-TERM1677647
-Node: MODE1677825
-Node: NAME1677979
-Node: NIL-GOAL1680120
-Node: NO-THANKS1682297
-Node: NON-EXECUTABLE1682463
-Node: NON-LINEAR-ARITHMETIC1682652
-Node: NONLINEARP1691038
-Node: NORMALIZE1691215
-Node: NU-REWRITER1691380
-Node: OBDD1695083
-Node: ORDINALS1695287
-Node: OTF-FLG1701911
-Node: OVERRIDE-HINTS1703649
-Node: P!1711042
-Node: PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS1712301
-Node: PARALLEL1714011
-Node: PARALLELISM-BUILD1714221
-Node: PRINT-DOC-START-COLUMN1714456
-Node: PROMPT1715314
-Node: PROOF-OF-WELL-FOUNDEDNESS1716251
-Node: PROOF-SUPPORTERS-ALIST1723478
-Node: REDEF1723658
-Node: REDEF!1724212
-Node: REDEF+1724734
-Node: REDEF-1725931
-Node: REDEFINED-NAMES1726483
-Node: REDUNDANT-EVENTS1728285
-Node: REORDER1742055
-Node: RESTRICT1742217
-Node: REWRITE-STACK-LIMIT1742384
-Node: SAVING-AND-RESTORING1743769
-Node: SET-WORMHOLE-DATA1744400
-Node: SET-WORMHOLE-ENTRY-CODE1745115
-Node: SHOW-BODIES1745854
-Node: SIGNATURE1746833
-Node: SIMPLE1753870
-Node: SPECIOUS-SIMPLIFICATION1755252
-Node: SPLITTER1760567
-Node: SPLITTER-OUTPUT1767580
-Node: STOBJS1768154
-Node: SUBVERSIVE-INDUCTIONS1768325
-Node: SUBVERSIVE-RECURSIONS1768560
-Node: SYNTAX1776078
-Node: SYNTAXP1776591
-Node: SYNTAXP-EXAMPLES1786564
-Node: TERM1792871
-Node: THE-METHOD1801821
-Node: TIME-TRACKER-TAU1807001
-Node: TRUST-TAG1809542
-Node: TTAGS-SEEN1809688
-Node: TTREE1811526
-Node: TYPE-SET1812714
-Node: TYPESPEC-CHECK1819603
-Node: USE1819749
-Node: USING-COMPUTED-HINTS1819909
-Node: USING-COMPUTED-HINTS-11821049
-Node: USING-COMPUTED-HINTS-21822301
-Node: USING-COMPUTED-HINTS-31826386
-Node: USING-COMPUTED-HINTS-41831145
-Node: USING-COMPUTED-HINTS-51837136
-Node: USING-COMPUTED-HINTS-61839492
-Node: USING-COMPUTED-HINTS-71849156
-Node: USING-COMPUTED-HINTS-81858050
-Node: USING-ENABLED-RULES1859919
-Node: VERSION1862879
-Node: WATERFALL1867622
-Node: WHY-BRR1867772
-Node: WORLD1870734
-Node: WORMHOLE1876962
-Node: WORMHOLE-DATA1897579
-Node: WORMHOLE-ENTRY-CODE1897962
-Node: WORMHOLE-EVAL1898369
-Node: WORMHOLE-IMPLEMENTATION1901944
-Node: WORMHOLE-P1906090
-Node: WORMHOLE-STATUSP1906439
-Node: XARGS1906819
-Node: OTHER1913229
-Node: ACCUMULATED-PERSISTENCE1916547
-Node: ACCUMULATED-PERSISTENCE-SUBTLETIES1935558
-Node: ACL2-DEFAULTS-TABLE1940547
-Node: ACL2-HELP1953610
-Node: CERTIFY-BOOK!1954064
-Node: CW-GSTACK1955023
-Node: DEAD-EVENTS1957216
-Node: DISASSEMBLE$1960636
-Node: DMR1962818
-Node: DYNAMICALLY-MONITOR-REWRITES1970714
-Node: EXIT1970867
-Node: GOOD-BYE1971029
-Node: GUARD-OBLIGATION1972145
-Node: IN-PACKAGE1974931
-Node: LD1975566
-Node: CALLING-LD-IN-BAD-CONTEXTS1989237
-Node: PRINT-GV1991049
-Node: PROPS1996106
-Node: PSO1996387
-Node: PSO!1996829
-Node: PSOF1997286
-Node: PSOG1998190
-Node: PSTACK1998565
-Node: VERBOSE-PSTACK2000903
-Node: Q2001751
-Node: QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP2002548
-Node: QUIT2004379
-Node: REBUILD2004556
-Node: REDO-FLAT2006715
-Node: RESET-LD-SPECIALS2011125
-Node: SAVE-EXEC2012291
-Node: SET-ACCUMULATED-PERSISTENCE2013922
-Node: SHARP-BANG-READER2014112
-Node: SHARP-COMMA-READER2015003
-Node: SHARP-DOT-READER2015284
-Node: SHARP-U-READER2016596
-Node: SHOW-ACCUMULATED-PERSISTENCE2018184
-Node: SKIP-PROOFS2018375
-Node: THM2023361
-Node: TOP-LEVEL2024010
-Node: TRANS2026357
-Node: TRANS!2027697
-Node: TRANS12028146
-Node: VERIFY-GUARDS-FORMULA2028683
-Node: WALKABOUT2029803
-Node: WITH-PROVER-STEP-LIMIT2032421
-Node: WITH-PROVER-TIME-LIMIT2038367
-Node: WOF2042932
-Node: PARALLELISM2043687
-Node: COMPILING-ACL2P2045987
-Node: PARALLEL-PROGRAMMING2047109
-Node: DEFLOCK2050131
-Node: EARLY-TERMINATION2053283
-Node: ERROR-TRIPLES-AND-PARALLELISM2055426
-Node: GRANULARITY2057943
-Node: PAND2062455
-Node: PARALLEL-EXECUTION2065202
-Node: PARALLELISM-AT-THE-TOP-LEVEL2065535
-Node: PARALLELISM-PERFORMANCE2067863
-Node: PARALLELISM-TUTORIAL2069753
-Node: PARGS2080643
-Node: PLET2082172
-Node: POR2083724
-Node: SPEC-MV-LET2085545
-Node: WITH-OUTPUT-LOCK2088407
-Node: PARALLEL-PROOF2091333
-Node: ACL2P-KEY-CHECKPOINTS2092983
-Node: DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT2094873
-Node: PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION2095216
-Node: UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES2097710
-Node: WATERFALL-PARALLELISM2105454
-Node: WATERFALL-PRINTING2105743
-Node: UNSUPPORTED-PARALLELISM-FEATURES2105982
-Node: WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION2108052
-Node: PROGRAMMING2109398
-Node: ACL2-BUILT-INS2111633
-Node: *2131099
-Node: +2131509
-Node: -2131813
-Node: /2132269
-Node: /=2132805
-Node: 1+2133314
-Node: 1-2133555
-Node: <2133795
-Node: <=2134700
-Node: =2134988
-Node: >2135458
-Node: >=2135731
-Node: atsign2136027
-Node: ABS2136842
-Node: ACL2-COUNT2137491
-Node: ACL2-NUMBER-LISTP2138238
-Node: ACL2-NUMBERP2138563
-Node: ACONS2138815
-Node: ADD-TO-SET2139296
-Node: ADD-TO-SET-EQ2140791
-Node: ADD-TO-SET-EQL2140947
-Node: ADD-TO-SET-EQUAL2141110
-Node: ALISTP2141268
-Node: ALLOCATE-FIXNUM-RANGE2141586
-Node: ALPHA-CHAR-P2142418
-Node: ALPHORDER2142958
-Node: AND2144089
-Node: APPEND2144494
-Node: ASH2145188
-Node: ASSERT$2145795
-Node: ASSIGN2146390
-Node: ASSOC2147714
-Node: ASSOC-EQ2149181
-Node: ASSOC-EQUAL2149314
-Node: ASSOC-KEYWORD2149458
-Node: ASSOC-STRING-EQUAL2149964
-Node: ATOM2150482
-Node: ATOM-LISTP2150865
-Node: BINARY-*2151212
-Node: BINARY-+2151785
-Node: BINARY-APPEND2152413
-Node: BOOLE$2152783
-Node: BOOLEANP2154414
-Node: BREAK$2154852
-Node: BREAKS2155294
-Node: BUTLAST2157375
-Node: CAAAAR2158370
-Node: CAAADR2158542
-Node: CAAAR2158712
-Node: CAADAR2158880
-Node: CAADDR2159050
-Node: CAADR2159220
-Node: CAAR2159386
-Node: CADAAR2159550
-Node: CADADR2159719
-Node: CADAR2159889
-Node: CADDAR2160057
-Node: CADDDR2160227
-Node: CADDR2160397
-Node: CADR2160563
-Node: CANONICAL-PATHNAME2160739
-Node: CAR2162565
-Node: CASE2162986
-Node: CASE-MATCH2164306
-Node: CDAAAR2167211
-Node: CDAADR2167386
-Node: CDAAR2167556
-Node: CDADAR2167724
-Node: CDADDR2167894
-Node: CDADR2168064
-Node: CDAR2168230
-Node: CDDAAR2168394
-Node: CDDADR2168563
-Node: CDDAR2168733
-Node: CDDDAR2168901
-Node: CDDDDR2169071
-Node: CDDDR2169241
-Node: CDDR2169407
-Node: CDR2169568
-Node: CEILING2169974
-Node: CHAR2170949
-Node: CHAR-CODE2171448
-Node: CHAR-DOWNCASE2171847
-Node: CHAR-EQUAL2172429
-Node: CHAR-UPCASE2172985
-Node: CHAR<2173553
-Node: CHAR<=2174019
-Node: CHAR>2174504
-Node: CHAR>=2174971
-Node: CHARACTER-ALISTP2175473
-Node: CHARACTER-LISTP2175785
-Node: CHARACTERP2176114
-Node: CHARACTERS2176324
-Node: CHECK-SUM2178858
-Node: CLOSE-INPUT-CHANNEL2180875
-Node: CLOSE-OUTPUT-CHANNEL2181040
-Node: CODE-CHAR2181206
-Node: COERCE2181783
-Node: COMPLEX2182629
-Node: COMPLEX-RATIONALP2184377
-Node: COMPLEX/COMPLEX-RATIONALP2184906
-Node: CONCATENATE2185551
-Node: COND2186826
-Node: CONJUGATE2187253
-Node: CONS2187677
-Node: CONSP2187972
-Node: COUNT2188151
-Node: CPU-CORE-COUNT2189295
-Node: CW2190123
-Node: CW!2193387
-Node: DELETE-ASSOC2193757
-Node: DELETE-ASSOC-EQ2195303
-Node: DELETE-ASSOC-EQUAL2195471
-Node: DENOMINATOR2195641
-Node: DIGIT-CHAR-P2196014
-Node: DIGIT-TO-CHAR2196828
-Node: E0-ORD-<2197450
-Node: E0-ORDINALP2198274
-Node: EC-CALL2199078
-Node: EIGHTH2204831
-Node: ENDP2205010
-Node: EQ2205595
-Node: EQL2206466
-Node: EQLABLE-ALISTP2207022
-Node: EQLABLE-LISTP2207401
-Node: EQLABLEP2207757
-Node: EQUAL2208203
-Node: ER2208503
-Node: ER-PROGN2210898
-Node: ERROR12212686
-Node: EVENP2213908
-Node: EXPLODE-NONNEGATIVE-INTEGER2214421
-Node: EXPT2215144
-Node: F-GET-GLOBAL2215827
-Node: F-PUT-GLOBAL2216756
-Node: FIFTH2217974
-Node: FIRST2218156
-Node: FIX2218329
-Node: FIX-TRUE-LIST2218799
-Node: FLET2219162
-Node: FLOOR2223715
-Node: FMS2224672
-Node: FMS!2224905
-Node: FMS!-TO-STRING2225353
-Node: FMS-TO-STRING2225513
-Node: FMT2225671
-Node: FMT!2244024
-Node: FMT!-TO-STRING2244472
-Node: FMT-TO-COMMENT-WINDOW2244640
-Node: FMT-TO-STRING2245583
-Node: FMT12245749
-Node: FMT1!2246006
-Node: FMT1!-TO-STRING2246472
-Node: FMT1-TO-STRING2246636
-Node: FOURTH2246800
-Node: GET-OUTPUT-STREAM-STRING$2247007
-Node: GETENV$2247168
-Node: GETPROP2247911
-Node: GOOD-ATOM-LISTP2248381
-Node: HARD-ERROR2248810
-Node: IDENTITY2250170
-Node: IF2250442
-Node: IFF2250820
-Node: IFIX2251145
-Node: ILLEGAL2251638
-Node: IMAGPART2252561
-Node: IMPLIES2252906
-Node: IMPROPER-CONSP2253235
-Node: INT=2253653
-Node: INTEGER-LENGTH2254040
-Node: INTEGER-LISTP2254682
-Node: INTEGERP2254997
-Node: INTERN2255197
-Node: INTERN$2256889
-Node: INTERN-IN-PACKAGE-OF-SYMBOL2257546
-Node: INTERSECTION$2259612
-Node: INTERSECTION-EQ2262015
-Node: INTERSECTION-EQUAL2262185
-Node: INTERSECTP2262355
-Node: INTERSECTP-EQ2263670
-Node: INTERSECTP-EQUAL2263828
-Node: KEYWORD-VALUE-LISTP2263998
-Node: KEYWORDP2264412
-Node: KWOTE2265132
-Node: KWOTE-LST2265484
-Node: LAST2265830
-Node: LEN2266406
-Node: LENGTH2266931
-Node: LET2267359
-Node: LET*2272293
-Node: LEXORDER2274017
-Node: LIST2274717
-Node: LIST*2275098
-Node: LISTP2275487
-Node: LOGAND2275891
-Node: LOGANDC12276469
-Node: LOGANDC22277029
-Node: LOGBITP2277591
-Node: LOGCOUNT2278140
-Node: LOGEQV2278585
-Node: LOGIOR2279176
-Node: LOGNAND2279767
-Node: LOGNOR2280245
-Node: LOGNOT2280744
-Node: LOGORC12281308
-Node: LOGORC22281876
-Node: LOGTEST2282446
-Node: LOGXOR2283001
-Node: LOWER-CASE-P2283598
-Node: MAKE-CHARACTER-LIST2284151
-Node: MAKE-LIST2284461
-Node: MAKE-ORD2285022
-Node: MAX2286162
-Node: MBE2286572
-Node: MBE12292237
-Node: MBT2292494
-Node: MEMBER2296406
-Node: MEMBER-EQ2297858
-Node: MEMBER-EQUAL2297996
-Node: MIN2298134
-Node: MINUSP2298553
-Node: MOD2298970
-Node: MOD-EXPT2299595
-Node: MUST-BE-EQUAL2300523
-Node: MV2301276
-Node: MV-LET2302215
-Node: MV-LIST2307398
-Node: MV-NTH2308943
-Node: MV?2310684
-Node: MV?-LET2311428
-Node: NAT-LISTP2312691
-Node: NATP2312998
-Node: NFIX2313569
-Node: NINTH2314087
-Node: NO-DUPLICATESP2314270
-Node: NO-DUPLICATESP-EQ2315557
-Node: NO-DUPLICATESP-EQUAL2315735
-Node: NON-EXEC2315910
-Node: NONNEGATIVE-INTEGER-QUOTIENT2318897
-Node: NOT2319691
-Node: NTH2320082
-Node: NTHCDR2320569
-Node: NULL2321345
-Node: NUMERATOR2321821
-Node: O-FINP2322163
-Node: O-FIRST-COEFF2322631
-Node: O-FIRST-EXPT2323281
-Node: O-INFP2323906
-Node: O-P2324135
-Node: O-RST2330353
-Node: O<2330975
-Node: O<=2334127
-Node: O>2334342
-Node: O>=2334543
-Node: OBSERVATION2334770
-Node: OBSERVATION-CW2337661
-Node: ODDP2337811
-Node: OPEN-INPUT-CHANNEL2338257
-Node: OPEN-INPUT-CHANNEL-P2338415
-Node: OPEN-OUTPUT-CHANNEL2338590
-Node: OPEN-OUTPUT-CHANNEL-P2338767
-Node: OR2338928
-Node: ORACLE-APPLY2339972
-Node: ORACLE-APPLY-RAW2343945
-Node: ORACLE-FUNCALL2345124
-Node: PAIRLIS2346148
-Node: PAIRLIS$2346438
-Node: PEEK-CHAR$2347099
-Node: PKG-IMPORTS2347236
-Node: PKG-WITNESS2349424
-Node: PLUSP2350134
-Node: POSITION2350559
-Node: POSITION-EQ2352111
-Node: POSITION-EQUAL2352259
-Node: POSP2352406
-Node: PPROGN2352927
-Node: PRINC$2354060
-Node: PRINT-OBJECT$2355935
-Node: PROG2$2356071
-Node: PROGN$2358341
-Node: PROOFS-CO2358982
-Node: PROPER-CONSP2359564
-Node: PSEUDO-TERMP2359940
-Node: PUT-ASSOC2362933
-Node: PUT-ASSOC-EQ2364553
-Node: PUT-ASSOC-EQL2364704
-Node: PUT-ASSOC-EQUAL2364862
-Node: PUTPROP2365017
-Node: QUOTE2365474
-Node: R-EQLABLE-ALISTP2365679
-Node: R-SYMBOL-ALISTP2366068
-Node: RANDOM$2366437
-Node: RASSOC2367460
-Node: RASSOC-EQ2369123
-Node: RASSOC-EQUAL2369261
-Node: RATIONAL-LISTP2369410
-Node: RATIONALP2369743
-Node: READ-BYTE$2369984
-Node: READ-CHAR$2370121
-Node: READ-OBJECT2370260
-Node: READ-RUN-TIME2370403
-Node: REAL/RATIONALP2370989
-Node: REALFIX2371552
-Node: REALPART2372068
-Node: REM2372404
-Node: REMOVE2373040
-Node: REMOVE-DUPLICATES2374540
-Node: REMOVE-DUPLICATES-EQ2376749
-Node: REMOVE-DUPLICATES-EQUAL2376942
-Node: REMOVE-EQ2377130
-Node: REMOVE-EQUAL2377285
-Node: REMOVE12377427
-Node: REMOVE1-EQ2378882
-Node: REMOVE1-EQUAL2379025
-Node: REST2379168
-Node: RETURN-LAST2379440
-Node: REVAPPEND2399148
-Node: REVERSE2399966
-Node: RFIX2400424
-Node: ROUND2400929
-Node: SEARCH2401985
-Node: SECOND2404626
-Node: SET-DIFFERENCE$2404815
-Node: SET-DIFFERENCE-EQ2406529
-Node: SET-DIFFERENCE-EQUAL2406709
-Node: SETENV$2406884
-Node: SEVENTH2407686
-Node: SIGNUM2407870
-Node: SIXTH2408592
-Node: STANDARD-CHAR-LISTP2408782
-Node: STANDARD-CHAR-P2409225
-Node: STANDARD-CO2409870
-Node: STANDARD-OI2410749
-Node: STANDARD-STRING-ALISTP2411889
-Node: STATE-GLOBAL-LET*2412399
-Node: STRING2415950
-Node: STRING-APPEND2416555
-Node: STRING-DOWNCASE2417132
-Node: STRING-EQUAL2417700
-Node: STRING-LISTP2418318
-Node: STRING-UPCASE2418632
-Node: STRING<2419182
-Node: STRING<=2420005
-Node: STRING>2420684
-Node: STRING>=2421187
-Node: STRINGP2421866
-Node: STRIP-CARS2422054
-Node: STRIP-CDRS2422530
-Node: SUBLIS2423000
-Node: SUBSEQ2423714
-Node: SUBSETP2424725
-Node: SUBSETP-EQ2426074
-Node: SUBSETP-EQUAL2426217
-Node: SUBST2426361
-Node: SUBSTITUTE2426968
-Node: SYMBOL-<2427713
-Node: SYMBOL-ALISTP2428366
-Node: SYMBOL-LISTP2428724
-Node: SYMBOL-NAME2429036
-Node: SYMBOL-PACKAGE-NAME2429404
-Node: SYMBOLP2430349
-Node: SYS-CALL2430546
-Node: SYS-CALL-STATUS2433577
-Node: TAKE2434349
-Node: TENTH2435315
-Node: TERM-ORDER2435494
-Node: THE2442279
-Node: THIRD2443819
-Node: TIME$2443992
-Node: TRUE-LIST-LISTP2450117
-Node: TRUE-LISTP2450548
-Node: TRUNCATE2450882
-Node: UNARY--2452033
-Node: UNARY-/2452532
-Node: UNION$2453099
-Node: UNION-EQ2455249
-Node: UNION-EQUAL2455384
-Node: UNTRANSLATE2455527
-Node: UPDATE-NTH2455694
-Node: UPPER-CASE-P2456770
-Node: WITH-LIVE-STATE2457324
-Node: WRITE-BYTE$2458709
-Node: XOR2458847
-Node: ZEROP2459149
-Node: ZIP2459919
-Node: ZP2460867
-Node: ZPF2461870
-Node: ACL2-USER2462301
-Node: ARRAYS2464186
-Node: AREF12485373
-Node: AREF22486183
-Node: ARRAY1P2486993
-Node: ARRAY2P2487454
-Node: ARRAYS-EXAMPLE2487924
-Node: ASET12490788
-Node: ASET22492347
-Node: COMPRESS12493909
-Node: COMPRESS22495841
-Node: DEFAULT2497225
-Node: DIMENSIONS2497982
-Node: FLUSH-COMPRESS2498878
-Node: HEADER2504267
-Node: MAXIMUM-LENGTH2504751
-Node: SLOW-ARRAY-WARNING2505500
-Node: COMPILATION2510566
-Node: DECLARE2512563
-Node: TYPE-SPEC2515049
-Node: EQUALITY-VARIANTS2518434
-Node: EQUALITY-VARIANTS-DETAILS2523189
-Node: IGNORABLE2529923
-Node: IGNORE2530064
-Node: IRRELEVANT-FORMALS2530203
-Node: OPTIMIZE2533373
-Node: REDEFINING-PROGRAMS2533526
-Node: SINGLE-THREADED-OBJECTS2539649
-Node: STATE2539817
-Node: ERROR-TRIPLES2548840
-Node: PROGRAMMING-WITH-STATE2550044
-Node: TIME-TRACKER2572019
-Node: TYPE2583923
-Node: ZERO-TEST-IDIOMS2584059
-Node: PROOF-CHECKER2591689
-Node: DEFINE-PC-HELP2594355
-Node: DEFINE-PC-MACRO2595584
-Node: DEFINE-PC-META2597053
-Node: INSTRUCTIONS2597572
-Node: MACRO-COMMAND2619580
-Node: PROOF-CHECKER-COMMANDS2620858
-Node: ACL2-PC||=2629315
-Node: ACL2-PC||ACL2-WRAP2633541
-Node: ACL2-PC||ADD-ABBREVIATION2633989
-Node: ACL2-PC||AL2636040
-Node: ACL2-PC||APPLY-LINEAR2636333
-Node: ACL2-PC||BASH2641096
-Node: ACL2-PC||BDD2642195
-Node: ACL2-PC||BK2642882
-Node: ACL2-PC||BOOKMARK2643586
-Node: ACL2-PC||CASESPLIT2644269
-Node: ACL2-PC||CG2646771
-Node: ACL2-PC||CHANGE-GOAL2647249
-Node: ACL2-PC||CL-PROC2648038
-Node: ACL2-PC||CLAIM2648325
-Node: ACL2-PC||CLAUSE-PROCESSOR2650437
-Node: ACL2-PC||COMM2651263
-Node: ACL2-PC||COMMANDS2653469
-Node: ACL2-PC||COMMENT2654499
-Node: ACL2-PC||CONTRADICT2654970
-Node: ACL2-PC||CONTRAPOSE2655194
-Node: ACL2-PC||DEMOTE2655984
-Node: ACL2-PC||DIVE2657117
-Node: ACL2-PC||DO-ALL2658548
-Node: ACL2-PC||DO-ALL-NO-PROMPT2659489
-Node: ACL2-PC||DO-STRICT2660083
-Node: ACL2-PC||DROP2660649
-Node: ACL2-PC||DV2661355
-Node: ACL2-PC||ELIM2663623
-Node: ACL2-PC||EQUIV2664107
-Node: ACL2-PC||EX2666330
-Node: ACL2-PC||EXIT2666701
-Node: ACL2-PC||EXPAND2669625
-Node: ACL2-PC||FAIL2670572
-Node: ACL2-PC||FINISH2671133
-Node: ACL2-PC||FORWARDCHAIN2671833
-Node: ACL2-PC||FREE2672987
-Node: ACL2-PC||GENEQV2673376
-Node: ACL2-PC||GENERALIZE2674771
-Node: ACL2-PC||GOALS2676559
-Node: ACL2-PC||HELP2677017
-Node: ACL2-PC||HELP!2679418
-Node: ACL2-PC||HELP-LONG2679777
-Node: ACL2-PC||HYPS2680103
-Node: ACL2-PC||ILLEGAL2682227
-Node: ACL2-PC||IN-THEORY2682737
-Node: ACL2-PC||INDUCT2685379
-Node: ACL2-PC||LEMMAS-USED2686437
-Node: ACL2-PC||LISP2686685
-Node: ACL2-PC||MORE2688459
-Node: ACL2-PC||MORE!2688782
-Node: ACL2-PC||NEGATE2689164
-Node: ACL2-PC||NIL2689643
-Node: ACL2-PC||NOISE2690098
-Node: ACL2-PC||NX2690784
-Node: ACL2-PC||ORELSE2691433
-Node: ACL2-PC||P2692023
-Node: ACL2-PC||P-TOP2692704
-Node: ACL2-PC||PL2693593
-Node: ACL2-PC||PP2694248
-Node: ACL2-PC||PR2694677
-Node: ACL2-PC||PRINT2695332
-Node: ACL2-PC||PRINT-ALL-CONCS2696239
-Node: ACL2-PC||PRINT-ALL-GOALS2696657
-Node: ACL2-PC||PRINT-MAIN2697049
-Node: ACL2-PC||PRO2697332
-Node: ACL2-PC||PROMOTE2697764
-Node: ACL2-PC||PROTECT2698767
-Node: ACL2-PC||PROVE2699384
-Node: ACL2-PC||PSO2700663
-Node: ACL2-PC||PSO!2701390
-Node: ACL2-PC||PSOG2702148
-Node: ACL2-PC||PUT2702899
-Node: ACL2-PC||QUIET2704303
-Node: ACL2-PC||R2704665
-Node: ACL2-PC||REDUCE2704922
-Node: ACL2-PC||REDUCE-BY-INDUCTION2706044
-Node: ACL2-PC||REMOVE-ABBREVIATIONS2707174
-Node: ACL2-PC||REPEAT2708266
-Node: ACL2-PC||REPEAT-REC2708810
-Node: ACL2-PC||REPLAY2709027
-Node: ACL2-PC||RESTORE2710192
-Node: ACL2-PC||RETAIN2710941
-Node: ACL2-PC||RETRIEVE2711533
-Node: ACL2-PC||REWRITE2712385
-Node: ACL2-PC||RUN-INSTR-ON-GOAL2717709
-Node: ACL2-PC||RUN-INSTR-ON-NEW-GOALS2717953
-Node: ACL2-PC||RUNES2718200
-Node: ACL2-PC||S2718939
-Node: ACL2-PC||S-PROP2721536
-Node: ACL2-PC||SAVE2722145
-Node: ACL2-PC||SEQUENCE2723057
-Node: ACL2-PC||SHOW-ABBREVIATIONS2726933
-Node: ACL2-PC||SHOW-LINEARS2728125
-Node: ACL2-PC||SHOW-REWRITES2728787
-Node: ACL2-PC||SHOW-TYPE-PRESCRIPTIONS2730305
-Node: ACL2-PC||SKIP2731030
-Node: ACL2-PC||SL2731348
-Node: ACL2-PC||SLS2732046
-Node: ACL2-PC||SPLIT2732561
-Node: ACL2-PC||SR2734020
-Node: ACL2-PC||ST2734356
-Node: ACL2-PC||SUCCEED2734707
-Node: ACL2-PC||TH2735169
-Node: ACL2-PC||THEN2736137
-Node: ACL2-PC||TOP2736782
-Node: ACL2-PC||TYPE-ALIST2737434
-Node: ACL2-PC||UNDO2740164
-Node: ACL2-PC||UNSAVE2741039
-Node: ACL2-PC||UP2741761
-Node: ACL2-PC||USE2742599
-Node: ACL2-PC||WRAP2743463
-Node: ACL2-PC||WRAP-INDUCT2744380
-Node: ACL2-PC||WRAP12745262
-Node: ACL2-PC||X2746644
-Node: ACL2-PC||X-DUMB2748606
-Node: RETRIEVE2749000
-Node: TOGGLE-PC-MACRO2749428
-Node: UNSAVE2750100
-Node: VERIFY2750501
-Node: PROOF-TREE2751747
-Node: CHECKPOINT-FORCED-GOALS2755951
-Node: PROOF-TREE-DETAILS2756696
-Node: PROOF-TREE-EXAMPLES2758825
-Node: START-PROOF-TREE2768746
-Node: STOP-PROOF-TREE2769419
-Node: Pages Written Especially for the Tours2770115
-Node: A Flying Tour of ACL22779916
-Node: A Sketch of How the Rewriter Works2781587
-Node: A Tiny Warning Sign2782841
-Node: A Trivial Proof2783528
-Node: A Typical State2783714
-Node: A Walking Tour of ACL22784580
-Node: ACL2 Characters2785700
-Node: ACL2 Conses or Ordered Pairs2786546
-Node: ACL2 Strings2788051
-Node: ACL2 Symbols2788892
-Node: ACL2 System Architecture2791429
-Node: ACL2 as an Interactive Theorem Prover2792607
-Node: ACL2 as an Interactive Theorem Prover (cont)2793151
-Node: ACL2 is an Untyped Language2794618
-Node: About Models2795745
-Node: About Types2796566
-Node: About the ACL2 Home Page2798694
-Node: About the Admission of Recursive Definitions2799962
-Node: About the Prompt2801560
-Node: An Example Common Lisp Function Definition2805044
-Node: An Example of ACL2 in Use2806314
-Node: Analyzing Common Lisp Models2808561
-Node: Common Lisp2809986
-Node: Common Lisp as a Modeling Language2811994
-Node: Conversion2813489
-Node: Corroborating Models2814401
-Node: Evaluating App on Sample Input2816485
-Node: Flawed Induction Candidates in App Example2817551
-Node: Free Variables in Top-Level Input2818266
-Node: Functions for Manipulating these Objects2820013
-Node: Guards2821165
-Node: Guessing the Type of a Newly Admitted Function2822921
-Node: Guiding the ACL2 Theorem Prover2823891
-Node: Hey Wait! Is ACL2 Typed or Untyped(Q)2824947
-Node: How Long Does It Take to Become an Effective User(Q)2825984
-Node: How To Find Out about ACL2 Functions2827081
-Node: How To Find Out about ACL2 Functions (cont)2828309
-Node: Modeling in ACL22829712
-Node: Models in Engineering2830545
-Node: Models of Computer Hardware and Software2831161
-Node: Name the Formula Above2832216
-Node: Nontautological Subgoals2832578
-Node: Numbers in ACL22833096
-Node: On the Naming of Subgoals2835376
-Node: Other Requirements2835892
-Node: Overview of the Expansion of ENDP in the Base Case2836749
-Node: Overview of the Expansion of ENDP in the Induction Step2837259
-Node: Overview of the Final Simplification in the Base Case2838003
-Node: Overview of the Proof of a Trivial Consequence2838529
-Node: Overview of the Simplification of the Base Case to T2840259
-Node: Overview of the Simplification of the Induction Conclusion2841220
-Node: Overview of the Simplification of the Induction Step to T2841919
-Node: Perhaps2843120
-Node: Popping out of an Inductive Proof2843465
-Node: Proving Theorems about Models2843914
-Node: Revisiting the Admission of App2845270
-Node: Rewrite Rules are Generated from DEFTHM Events2846552
-Node: Running Models2847549
-Node: Subsumption of Induction Candidates in App Example2848661
-Node: Suggested Inductions in the Associativity of App Example2849451
-Node: Symbolic Execution of Models2850239
-Node: The Admission of App2850942
-Node: The Associativity of App2852441
-Node: The Base Case in the App Example2853815
-Node: The End of the Flying Tour2854396
-Node: The End of the Proof of the Associativity of App2854844
-Node: The End of the Walking Tour2855713
-Node: The Event Summary2856920
-Node: The Expansion of ENDP in the Induction Step (Step 0)2859174
-Node: The Expansion of ENDP in the Induction Step (Step 1)2859841
-Node: The Expansion of ENDP in the Induction Step (Step 2)2860569
-Node: The Falling Body Model2861280
-Node: The Final Simplification in the Base Case (Step 0)2862090
-Node: The Final Simplification in the Base Case (Step 1)2862724
-Node: The Final Simplification in the Base Case (Step 2)2863334
-Node: The Final Simplification in the Base Case (Step 3)2863864
-Node: The First Application of the Associativity Rule2864509
-Node: The Induction Scheme Selected for the App Example2865310
-Node: The Induction Step in the App Example2866162
-Node: The Instantiation of the Induction Scheme2867065
-Node: The Justification of the Induction Scheme2867652
-Node: The Proof of the Associativity of App2868127
-Node: The Q.E.D. Message2870675
-Node: The Rules used in the Associativity of App Proof2871067
-Node: The Simplification of the Induction Conclusion (Step 0)2871857
-Node: The Simplification of the Induction Conclusion (Step 1)2872529
-Node: The Simplification of the Induction Conclusion (Step 10)2873655
-Node: The Simplification of the Induction Conclusion (Step 11)2874444
-Node: The Simplification of the Induction Conclusion (Step 12)2875154
-Node: The Simplification of the Induction Conclusion (Step 2)2875821
-Node: The Simplification of the Induction Conclusion (Step 3)2876612
-Node: The Simplification of the Induction Conclusion (Step 4)2877336
-Node: The Simplification of the Induction Conclusion (Step 5)2878252
-Node: The Simplification of the Induction Conclusion (Step 6)2879129
-Node: The Simplification of the Induction Conclusion (Step 7)2879977
-Node: The Simplification of the Induction Conclusion (Step 8)2880798
-Node: The Simplification of the Induction Conclusion (Step 9)2881691
-Node: The Summary of the Proof of the Trivial Consequence2882632
-Node: The Theorem that App is Associative2883152
-Node: The Time Taken to do the Associativity of App Proof2884530
-Node: The Tours2885316
-Node: The WARNING about the Trivial Consequence2887386
-Node: Undocumented Topic2888285
-Node: Using the Associativity of App to Prove a Trivial Consequence2888596
-Node: What Is ACL2(Q)2889377
-Node: What is Required of the User(Q)2890370
-Node: What is a Mathematical Logic(Q)2891410
-Node: What is a Mechanical Theorem Prover(Q)2892331
-Node: What is a Mechanical Theorem Prover(Q) (cont)2893255
-Node: You Must Think about the Use of a Formula as a Rule2893834
-Node: REAL2894951
-Node: I-CLOSE2897547
-Node: I-LARGE2897839
-Node: I-LIMITED2898138
-Node: I-SMALL2898426
-Node: REAL-LISTP2898718
-Node: STANDARD-PART2899029
-Node: STANDARDP2899397
-Node: RELEASE-NOTES2900429
-Node: NOTE-2-02904112
-Node: NOTE-2-12905312
-Node: NOTE-2-22905705
-Node: NOTE-2-32908440
-Node: NOTE-2-42910548
-Node: NOTE-2-52912033
-Node: NOTE-2-5(R)2927298
-Node: NOTE-2-62927631
-Node: NOTE-2-6-GUARDS2928876
-Node: NOTE-2-6-NEW-FUNCTIONALITY2931692
-Node: NOTE-2-6-OTHER2940209
-Node: NOTE-2-6-PROOF-CHECKER2945407
-Node: NOTE-2-6-PROOFS2946293
-Node: NOTE-2-6-RULES2951800
-Node: NOTE-2-6-SYSTEM2954899
-Node: NOTE-2-6(R)2956961
-Node: NOTE-2-72957324
-Node: NOTE-2-7-BUG-FIXES2961459
-Node: NOTE-2-7-GUARDS2974957
-Node: NOTE-2-7-NEW-FUNCTIONALITY2975834
-Node: NOTE-2-7-OTHER2983409
-Node: NOTE-2-7-PROOF-CHECKER2991497
-Node: NOTE-2-7-PROOFS2991830
-Node: NOTE-2-7-RULES2997181
-Node: NOTE-2-7-SYSTEM2998078
-Node: NOTE-2-7(R)3001050
-Node: NOTE-2-83001787
-Node: NOTE-2-8-BUG-FIXES3009541
-Node: NOTE-2-8-GUARDS3026038
-Node: NOTE-2-8-NEW-FUNCTIONALITY3026339
-Node: NOTE-2-8-ORDINALS3033821
-Node: NOTE-2-8-OTHER3034052
-Node: NOTE-2-8-PROOF-CHECKER3036347
-Node: NOTE-2-8-PROOFS3037950
-Node: NOTE-2-8-RULES3042041
-Node: NOTE-2-8-SYSTEM3043709
-Node: NOTE-2-8(R)3044760
-Node: NOTE-2-93045258
-Node: NOTE-2-9(R)3065985
-Node: NOTE-2-9-13066347
-Node: NOTE-2-9-23073727
-Node: NOTE-2-9-33082578
-Node: NOTE-2-9-3-PPR-CHANGE3092208
-Node: NOTE-2-9-43100935
-Node: NOTE-2-9-53116932
-Node: NOTE-3-03128535
-Node: NOTE-3-0(R)3129500
-Node: NOTE-3-0-13129842
-Node: NOTE-3-0-1(R)3141850
-Node: NOTE-3-0-23142206
-Node: NOTE-3-13157254
-Node: NOTE-3-1(R)3157710
-Node: NOTE-3-23158054
-Node: NOTE-3-2(R)3177674
-Node: NOTE-3-2-13178562
-Node: NOTE-3-2-1(R)3186807
-Node: NOTE-3-33187049
-Node: NOTE-3-3(R)3204142
-Node: NOTE-3-43204376
-Node: NOTE-3-4(R)3230702
-Node: NOTE-3-53231285
-Node: NOTE-3-5(R)3263779
-Node: NOTE-3-63266705
-Node: NOTE-3-6(R)3281011
-Node: NOTE-3-6-13281245
-Node: NOTE-4-03283125
-Node: NOTE-4-0-WORMHOLE-CHANGES3319992
-Node: NOTE-4-0(R)3322383
-Node: NOTE-4-13322608
-Node: NOTE-4-1(R)3328906
-Node: NOTE-4-23329136
-Node: NOTE-4-2(R)3350821
-Node: NOTE-4-33351049
-Node: NOTE-4-3(R)3378627
-Node: NOTE-5-03378852
-Node: NOTE-6-03423144
-Node: NOTE-6-13441578
-Node: NOTE-6-23451518
-Node: NOTE13467497
-Node: NOTE23468312
-Node: NOTE33469798
-Node: NOTE43475230
-Node: NOTE53481599
-Node: NOTE63492774
-Node: NOTE73497736
-Node: NOTE83505924
-Node: NOTE8-UPDATE3520031
-Node: NOTE93522120
-Node: RULE-CLASSES3525081
-Node: BUILT-IN-CLAUSE3543095
-Node: CLAUSE-PROCESSOR3548167
-Node: COMPOUND-RECOGNIZER3560860
-Node: CONGRUENCE3570535
-Node: DEFINITION3576890
-Node: ELIM3585624
-Node: EQUIVALENCE3592355
-Node: FORWARD-CHAINING3601221
-Node: FREE-VARIABLES3608848
-Node: FREE-VARIABLES-EXAMPLES3618886
-Node: FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING3619735
-Node: FREE-VARIABLES-EXAMPLES-REWRITE3625820
-Node: FREE-VARIABLES-TYPE-PRESCRIPTION3643909
-Node: GENERALIZE3647181
-Node: INDUCTION3648318
-Node: LINEAR3656403
-Node: META3663800
-Node: EVALUATOR-RESTRICTIONS3682448
-Node: REFINEMENT3694830
-Node: REWRITE3696825
-Node: TAU-SYSTEM3703034
-Node: BOUNDERS3719465
-Node: IN-TAU-INTERVALP3735299
-Node: MAKE-TAU-INTERVAL3738664
-Node: TAU-INTERVAL-DOM3740907
-Node: TAU-INTERVAL-HI3741455
-Node: TAU-INTERVAL-HI-REL3742104
-Node: TAU-INTERVAL-LO3742781
-Node: TAU-INTERVAL-LO-REL3743433
-Node: TAU-INTERVALP3744108
-Node: TYPE-PRESCRIPTION3746870
-Node: TYPE-SET-INVERTER3755514
-Node: WELL-FOUNDED-RELATION3757919
-Node: SERIALIZE3765109
-Node: SERIALIZE-ALTERNATIVES3766292
-Node: SERIALIZE-IN-BOOKS3767060
-Node: SERIALIZE-READ3768804
-Node: SERIALIZE-WRITE3770458
-Node: SET-SERIALIZE-CHARACTER3771366
-Node: WITH-SERIALIZE-CHARACTER3771566
-Node: STOBJ3774409
-Node: DECLARE-STOBJS3780420
-Node: RESIZE-LIST3782574
-Node: STOBJ-EXAMPLE-13783106
-Node: STOBJ-EXAMPLE-1-DEFUNS3791918
-Node: STOBJ-EXAMPLE-1-IMPLEMENTATION3796568
-Node: STOBJ-EXAMPLE-1-PROOFS3799318
-Node: STOBJ-EXAMPLE-23804717
-Node: STOBJ-EXAMPLE-33807787
-Node: STOBJ-LET3816487
-Node: WITH-LOCAL-STATE3838066
-Node: WITH-LOCAL-STOBJ3841118
-Node: SWITCHES-PARAMETERS-AND-MODES3844197
-Node: ACL2-CUSTOMIZATION3852360
-Node: ADD-BINOP3856348
-Node: ADD-DEFAULT-HINTS3856671
-Node: ADD-DEFAULT-HINTS!3858681
-Node: ADD-DIVE-INTO-MACRO3859221
-Node: ADD-INCLUDE-BOOK-DIR3859693
-Node: ADD-INVISIBLE-FNS3862074
-Node: ADD-MACRO-ALIAS3863116
-Node: ADD-MACRO-FN3863933
-Node: ADD-MATCH-FREE-OVERRIDE3865925
-Node: ADD-NTH-ALIAS3869851
-Node: ADD-OVERRIDE-HINTS3870470
-Node: ADD-OVERRIDE-HINTS!3871629
-Node: DEFAULT-HINTS-TABLE3872051
-Node: DEFAULT-VERIFY-GUARDS-EAGERNESS3872910
-Node: DELETE-INCLUDE-BOOK-DIR3873152
-Node: DIVE-INTO-MACROS-TABLE3874314
-Node: FINALIZE-EVENT-USER3876015
-Node: INITIALIZE-EVENT-USER3880643
-Node: INVISIBLE-FNS-TABLE3883245
-Node: LOGIC3885169
-Node: MACRO-ALIASES-TABLE3886363
-Node: NTH-ALIASES-TABLE3888935
-Node: PRINT-SUMMARY-USER3890007
-Node: PROGRAM3890197
-Node: PUSH-UNTOUCHABLE3891757
-Node: REMOVE-BINOP3893392
-Node: REMOVE-DEFAULT-HINTS3893733
-Node: REMOVE-DEFAULT-HINTS!3895207
-Node: REMOVE-DIVE-INTO-MACRO3895773
-Node: REMOVE-INVISIBLE-FNS3896348
-Node: REMOVE-MACRO-ALIAS3897213
-Node: REMOVE-MACRO-FN3897863
-Node: REMOVE-NTH-ALIAS3898533
-Node: REMOVE-OVERRIDE-HINTS3899158
-Node: REMOVE-OVERRIDE-HINTS!3900173
-Node: REMOVE-UNTOUCHABLE3900661
-Node: RESET-PREHISTORY3904224
-Node: RETURN-LAST-TABLE3905931
-Node: RULER-EXTENDERS3907254
-Node: SET-ABSSTOBJ-DEBUG3922735
-Node: SET-BACKCHAIN-LIMIT3926531
-Node: SET-BOGUS-DEFUN-HINTS-OK3928570
-Node: SET-BOGUS-MUTUAL-RECURSION-OK3929215
-Node: SET-CASE-SPLIT-LIMITATIONS3931068
-Node: SET-CHECKPOINT-SUMMARY-LIMIT3937946
-Node: SET-COMPILE-FNS3940222
-Node: SET-COMPILER-ENABLED3942422
-Node: SET-DEBUGGER-ENABLE3942618
-Node: SET-DEFAULT-BACKCHAIN-LIMIT3948163
-Node: SET-DEFAULT-HINTS3951171
-Node: SET-DEFAULT-HINTS!3953435
-Node: SET-DEFERRED-TTAG-NOTES3953976
-Node: SET-ENFORCE-REDUNDANCY3955361
-Node: SET-GAG-MODE3958573
-Node: SET-GUARD-CHECKING3963794
-Node: SET-IGNORE-DOC-STRING-ERROR3972828
-Node: SET-IGNORE-OK3974392
-Node: SET-INHIBIT-OUTPUT-LST3975798
-Node: SET-INHIBIT-WARNINGS3978313
-Node: SET-INHIBITED-SUMMARY-TYPES3979681
-Node: SET-INVISIBLE-FNS-TABLE3981157
-Node: SET-IRRELEVANT-FORMALS-OK3983441
-Node: SET-LD-KEYWORD-ALIASES3984449
-Node: SET-LD-REDEFINITION-ACTION3984673
-Node: SET-LD-SKIP-PROOFS3984898
-Node: SET-LD-SKIP-PROOFSP3985109
-Node: SET-LET*-ABSTRACTION3985311
-Node: SET-LET*-ABSTRACTIONP3985523
-Node: SET-MATCH-FREE-DEFAULT3987189
-Node: SET-MATCH-FREE-ERROR3989649
-Node: SET-MEASURE-FUNCTION3991580
-Node: SET-NON-LINEAR3992910
-Node: SET-NON-LINEARP3993099
-Node: SET-NU-REWRITER-MODE3993632
-Node: SET-OVERRIDE-HINTS3995694
-Node: SET-OVERRIDE-HINTS!3996507
-Node: SET-PARALLEL-EXECUTION3996929
-Node: SET-PRINT-CLAUSE-IDS3998868
-Node: SET-PROVER-STEP-LIMIT4000767
-Node: SET-RAW-MODE4006448
-Node: ADD-RAW-ARITY4012797
-Node: REMOVE-RAW-ARITY4014307
-Node: SET-RAW-MODE-ON!4014687
-Node: SET-RAW-PROOF-FORMAT4015182
-Node: SET-REWRITE-STACK-LIMIT4016120
-Node: SET-RULER-EXTENDERS4017432
-Node: SET-RW-CACHE-STATE4017637
-Node: SET-RW-CACHE-STATE!4020987
-Node: SET-SAVED-OUTPUT4021368
-Node: SET-SPLITTER-OUTPUT4024200
-Node: SET-STATE-OK4025801
-Node: SET-TAU-AUTO-MODE4028641
-Node: SET-TOTAL-PARALLELISM-WORK-LIMIT4034745
-Node: SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR4037020
-Node: SET-VERIFY-GUARDS-EAGERNESS4039234
-Node: SET-WATERFALL-PARALLELISM4041633
-Node: SET-WATERFALL-PARALLELISM-HACKS-ENABLED4046916
-Node: SET-WATERFALL-PARALLELISM-HACKS-ENABLED!4048152
-Node: SET-WATERFALL-PRINTING4048494
-Node: SET-WELL-FOUNDED-RELATION4051735
-Node: SET-WRITE-ACL2X4053190
-Node: TAU-STATUS4063066
-Node: TERM-TABLE4064756
-Node: UNTRANS-TABLE4065987
-Node: USER-DEFINED-FUNCTIONS-TABLE4066746
-Node: VERIFY-GUARDS-EAGERNESS4069928
-Node: WITH-GUARD-CHECKING4070159
-Node: WITH-OUTPUT4071033
-Node: THEORIES4077859
-Node: ACTIVE-RUNEP4087062
-Node: CURRENT-THEORY4087665
-Node: DISABLE4089346
-Node: E/D4090471
-Node: ENABLE4091644
-Node: EXECUTABLE-COUNTERPART-THEORY4092755
-Node: FUNCTION-THEORY4093929
-Node: GROUND-ZERO4095023
-Node: INCOMPATIBLE4095609
-Node: INTERSECTION-THEORIES4096195
-Node: MINIMAL-THEORY4096993
-Node: RULE-NAMES4097887
-Node: RUNE4098180
-Node: SET-DIFFERENCE-THEORIES4105055
-Node: THEORIES-AND-PRIMITIVES4106072
-Node: THEORY4109898
-Node: THEORY-FUNCTIONS4110611
-Node: UNION-THEORIES4112906
-Node: UNIVERSAL-THEORY4113666
-Node: TRACE4115397
-Node: BREAK-ON-ERROR4116971
-Node: CLOSE-TRACE-FILE4119002
-Node: OPEN-TRACE-FILE4119475
-Node: SET-TRACE-EVISC-TUPLE4120017
-Node: TRACE!4122429
-Node: TRACE$4129374
-Node: UNTRACE$4151453
-Node: WET4152148
-Node: Index4159456
+Node: EMACS130965
+Node: INTERESTING-APPLICATIONS131517
+Node: INTRODUCTION-TO-THE-THEOREM-PROVER138732
+Node: ARCHITECTURE-OF-THE-PROVER159693
+Node: DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS163629
+Node: EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES171022
+Node: EXAMPLE-INDUCTION-SCHEME-BINARY-TREES173827
+Node: EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2174908
+Node: EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION176518
+Node: EXAMPLE-INDUCTION-SCHEME-ON-LISTS178070
+Node: EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES179418
+Node: EXAMPLE-INDUCTION-SCHEME-UPWARDS180467
+Node: EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS182027
+Node: EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS184784
+Node: EXAMPLE-INDUCTIONS186569
+Node: FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS189381
+Node: FURTHER-INFORMATION-ON-REWRITING219361
+Node: GENERALIZING-KEY-CHECKPOINTS225734
+Node: INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS229582
+Node: INTRODUCTION-TO-HINTS237677
+Node: INTRODUCTION-TO-KEY-CHECKPOINTS242600
+Node: INTRODUCTION-TO-REWRITE-RULES-PART-1251579
+Node: INTRODUCTION-TO-REWRITE-RULES-PART-2259868
+Node: INTRODUCTION-TO-THE-DATABASE273214
+Node: INTRODUCTORY-CHALLENGE-PROBLEM-1284280
+Node: INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER285142
+Node: INTRODUCTORY-CHALLENGE-PROBLEM-2286564
+Node: INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER287220
+Node: INTRODUCTORY-CHALLENGE-PROBLEM-3288617
+Node: INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER289641
+Node: INTRODUCTORY-CHALLENGE-PROBLEM-4293793
+Node: INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER296041
+Node: INTRODUCTORY-CHALLENGES319164
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED320760
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE328284
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS329206
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION330968
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF332438
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE339497
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS340846
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER349411
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER353198
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER357490
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING358696
+Node: LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY367828
+Node: POST-INDUCTION-KEY-CHECKPOINTS371030
+Node: PRACTICE-FORMULATING-STRONG-RULES373262
+Node: PRACTICE-FORMULATING-STRONG-RULES-1375056
+Node: PRACTICE-FORMULATING-STRONG-RULES-2379089
+Node: PRACTICE-FORMULATING-STRONG-RULES-3381029
+Node: PRACTICE-FORMULATING-STRONG-RULES-4385555
+Node: PRACTICE-FORMULATING-STRONG-RULES-5386823
+Node: PRACTICE-FORMULATING-STRONG-RULES-6389182
+Node: PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED392872
+Node: SPECIAL-CASES-FOR-REWRITE-RULES405266
+Node: SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES407441
+Node: STRONG-REWRITE-RULES411555
+Node: STARTUP415245
+Node: TIDBITS417922
+Node: TIPS421449
+Node: BDD441484
+Node: BDD-ALGORITHM443145
+Node: BDD-INTRODUCTION466268
+Node: IF*474503
+Node: SHOW-BDD481189
+Node: BOOKS483504
+Node: BOOK-COMPILED-FILE487806
+Node: BOOK-CONTENTS493121
+Node: BOOK-EXAMPLE496235
+Node: BOOK-MAKEFILES504576
+Node: BOOK-NAME504731
+Node: BOOKS-CERTIFICATION508788
+Node: BOOKS-CERTIFICATION-CLASSIC520021
+Node: CBD531430
+Node: CERTIFICATE536486
+Node: CERTIFY-BOOK540620
+Node: CERTIFYING-BOOKS552357
+Node: COMMUNITY-BOOKS552522
+Node: FULL-BOOK-NAME553267
+Node: KEEP555113
+Node: PATHNAME556544
+Node: PORTCULLIS558768
+Node: PROVISIONAL-CERTIFICATION562425
+Node: REGRESSION577168
+Node: SET-CBD577326
+Node: UNCERTIFIED-BOOKS578357
+Node: BREAK-REWRITE581588
+Node: BREAK-LEMMA594532
+Node: BRR597978
+Node: BRR-COMMANDS601710
+Node: BRRatsign603894
+Node: MONITOR609825
+Node: MONITORED-RUNES618245
+Node: OK-IF618613
+Node: UNMONITOR620459
+Node: DOCUMENTATION621258
+Node: *TERMINAL-MARKUP-TABLE*630043
+Node: ARGS631684
+Node: DOC632165
+Node: DOC!635000
+Node: DOC-STRING635378
+Node: DOCS646861
+Node: HELP648826
+Node: MARKUP649078
+Node: MORE659790
+Node: MORE!661621
+Node: MORE-DOC662389
+Node: NQTHM-TO-ACL2663271
+Node: EVENTS671259
+Node: ADD-CUSTOM-KEYWORD-HINT676649
+Node: ASSERT-EVENT680113
+Node: COMP681921
+Node: COMP-GCL687525
+Node: DEFABBREV688162
+Node: DEFABSSTOBJ691376
+Node: DEFABSSTOBJ-MISSING-EVENTS721531
+Node: DEFATTACH722687
+Node: DEFAXIOM744791
+Node: DEFCHOOSE745983
+Node: CONSERVATIVITY-OF-DEFCHOOSE751643
+Node: DEFCONG770958
+Node: DEFCONST772550
+Node: DEFDOC774892
+Node: DEFEQUIV777482
+Node: DEFEVALUATOR778892
+Node: DEFEXEC783275
+Node: DEFINE-TRUSTED-CLAUSE-PROCESSOR791701
+Node: DEFLABEL802761
+Node: DEFMACRO803826
+Node: DEFMACRO-LAST807327
+Node: DEFN807629
+Node: DEFND807782
+Node: DEFPKG807940
+Node: HIDDEN-DEATH-PACKAGE812912
+Node: HIDDEN-DEFPKG815443
+Node: MANAGING-ACL2-PACKAGES815657
+Node: DEFPROXY815977
+Node: DEFPUN826664
+Node: DEFREFINEMENT827936
+Node: DEFSTOBJ829107
+Node: DEFSTUB848653
+Node: DEFTHEORY850406
+Node: DEFTHEORY-STATIC853117
+Node: DEFTHM856153
+Node: DEFTHMD858555
+Node: DEFTTAG859437
+Node: DEFUN871544
+Node: DEFUN-INLINE882585
+Node: DEFUN-NOTINLINE887349
+Node: DEFUN-NX888277
+Node: DEFUN-SK891094
+Node: DEFUN-SK-EXAMPLE903473
+Node: EXISTS907153
+Node: FORALL907595
+Node: QUANTIFIER-TUTORIAL908036
+Node: QUANTIFIERS934300
+Node: QUANTIFIERS-USING-DEFUN-SK936263
+Node: QUANTIFIERS-USING-DEFUN-SK-EXTENDED938059
+Node: QUANTIFIERS-USING-RECURSION940679
+Node: DEFUND941604
+Node: DEFUND-INLINE943133
+Node: DEFUND-NOTINLINE943487
+Node: ENCAPSULATE943859
+Node: REDUNDANT-ENCAPSULATE955493
+Node: EVISC-TABLE959234
+Node: IN-ARITHMETIC-THEORY962824
+Node: IN-THEORY964738
+Node: INCLUDE-BOOK966956
+Node: LOCAL976177
+Node: MAKE-EVENT977937
+Node: MAKE-EVENT-DETAILS1007378
+Node: MEMOIZE1018416
+Node: MUTUAL-RECURSION1029847
+Node: PROFILE1034297
+Node: PROGN1036357
+Node: PROGN!1037754
+Node: REGENERATE-TAU-DATABASE1043085
+Node: REMOVE-CUSTOM-KEYWORD-HINT1046598
+Node: RESTORE-MEMOIZATION-SETTINGS1047236
+Node: SAVE-AND-CLEAR-MEMOIZATION-SETTINGS1047819
+Node: SET-BODY1048549
+Node: TABLE1049868
+Node: USING-TABLES-EFFICIENTLY1059772
+Node: THEORY-INVARIANT1062937
+Node: UNMEMOIZE1068472
+Node: VALUE-TRIPLE1069522
+Node: VERIFY-GUARDS1071217
+Node: VERIFY-GUARDS+1084886
+Node: VERIFY-TERMINATION1087388
+Node: FORWARD-CHAINING-REPORTS1094749
+Node: FC-REPORT1107518
+Node: RESET-FC-REPORTING1107942
+Node: SET-FC-CRITERIA1108548
+Node: SET-FC-REPORT-ON-THE-FLY1111694
+Node: SHOW-FC-CRITERIA1112662
+Node: HISTORY1113039
+Node: GCS1115777
+Node: GET-COMMAND-SEQUENCE1115919
+Node: OOPS1116739
+Node: PBT1120634
+Node: PC1121478
+Node: PCB1126884
+Node: PCB!1128213
+Node: PCS1128816
+Node: PE1129722
+Node: PE!1131513
+Node: PF1131708
+Node: PL1132325
+Node: PL21134353
+Node: PR1135631
+Node: PR!1137193
+Node: PUFF1138129
+Node: PUFF*1144924
+Node: RESET-KILL-RING1147614
+Node: TAU-DATA1148853
+Node: TAU-DATABASE1150103
+Node: U1150671
+Node: UBT1151027
+Node: UBT!1152855
+Node: UBT-PREHISTORY1153353
+Node: UBU1153770
+Node: UBU!1154965
+Node: HONS-AND-MEMOIZATION1155480
+Node: CLEAR-HASH-TABLES1175137
+Node: CLEAR-MEMOIZE-STATISTICS1175609
+Node: CLEAR-MEMOIZE-TABLE1176101
+Node: CLEAR-MEMOIZE-TABLES1176572
+Node: CONS-SUBTREES1177098
+Node: FAST-ALIST-FREE1177510
+Node: FAST-ALIST-FREE-ON-EXIT1178642
+Node: FAST-ALIST-LEN1179881
+Node: FAST-ALIST-SUMMARY1180670
+Node: FAST-ALISTS1181383
+Node: FLUSH-HONS-GET-HASH-TABLE-LINK1183889
+Node: HONS1184270
+Node: HONS-ACONS1185386
+Node: HONS-ACONS!1188234
+Node: HONS-ASSOC-EQUAL1190722
+Node: HONS-CLEAR1191538
+Node: HONS-COPY1192864
+Node: HONS-COPY-PERSISTENT1194319
+Node: HONS-EQUAL1195156
+Node: HONS-EQUAL-LITE1196255
+Node: HONS-GET1197295
+Node: HONS-NOTE1198125
+Node: HONS-RESIZE1201269
+Node: HONS-SHRINK-ALIST1204096
+Node: HONS-SHRINK-ALIST!1206875
+Node: HONS-SUMMARY1207683
+Node: HONS-WASH1208591
+Node: MAKE-FAST-ALIST1210063
+Node: MEMOIZE-SUMMARY1211078
+Node: MEMSUM1211613
+Node: NEVER-MEMOIZE1212037
+Node: NORMED1212762
+Node: NUMBER-SUBTREES1215626
+Node: SLOW-ALIST-WARNING1216222
+Node: WITH-FAST-ALIST1217428
+Node: WITH-STOLEN-ALIST1219835
+Node: INTRODUCTION-TO-THE-TAU-SYSTEM1220853
+Node: DEALING-WITH-TAU-PROBLEMS1232176
+Node: FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM1238983
+Node: IO1243815
+Node: *STANDARD-CI*1256448
+Node: *STANDARD-CO*1257073
+Node: *STANDARD-OI*1259055
+Node: CHARACTER-ENCODING1259676
+Node: EVISC-TUPLE1261311
+Node: EVISCERATE-HIDE-TERMS1263569
+Node: EXTERNAL-FORMAT1264175
+Node: IPRINT1264334
+Node: IPRINTING1264464
+Node: OPEN-OUTPUT-CHANNEL!1264602
+Node: OUTPUT-TO-FILE1268891
+Node: PRINT-CONTROL1271069
+Node: PRINTING-TO-STRINGS1276028
+Node: RESET-PRINT-CONTROL1278936
+Node: SET-EVISC-TUPLE1279105
+Node: SET-FMT-HARD-RIGHT-MARGIN1284306
+Node: SET-FMT-SOFT-RIGHT-MARGIN1285221
+Node: SET-IPRINT1285535
+Node: SET-PRINT-BASE1293827
+Node: SET-PRINT-CASE1294926
+Node: SET-PRINT-CIRCLE1296418
+Node: SET-PRINT-ESCAPE1296577
+Node: SET-PRINT-LENGTH1296738
+Node: SET-PRINT-LEVEL1296898
+Node: SET-PRINT-LINES1297056
+Node: SET-PRINT-RADIX1297213
+Node: SET-PRINT-READABLY1298397
+Node: SET-PRINT-RIGHT-MARGIN1298567
+Node: WITHOUT-EVISC1298739
+Node: MISCELLANEOUS1300968
+Node: &ALLOW-OTHER-KEYS1312091
+Node: &BODY1312248
+Node: &KEY1312384
+Node: &OPTIONAL1312511
+Node: &REST1312643
+Node: &WHOLE1312773
+Node: A!1312897
+Node: ABORT!1313742
+Node: ACKNOWLEDGMENTS1314012
+Node: ACL2S1321108
+Node: APROPOS1321245
+Node: BACKCHAIN-LIMIT1321395
+Node: BACKCHAIN-LIMIT-RW1327526
+Node: BACKTRACK1327721
+Node: BIBLIOGRAPHY1327895
+Node: BIND-FREE1328156
+Node: BIND-FREE-EXAMPLES1340405
+Node: BY1347743
+Node: CASE-SPLIT1347885
+Node: CASE-SPLIT-LIMITATIONS1350051
+Node: CASES1350804
+Node: CLAUSE-IDENTIFIER1350975
+Node: COMMAND1352973
+Node: COMMAND-DESCRIPTOR1354013
+Node: COMMON-LISP1358403
+Node: DEFUN-MODE-CAVEAT1360575
+Node: GENERALIZED-BOOLEANS1364905
+Node: COMPUTED-HINTS1368643
+Node: CONSTRAINT1376446
+Node: COPYRIGHT1395616
+Node: COROLLARY1396638
+Node: CURRENT-PACKAGE1396992
+Node: CUSTOM-KEYWORD-HINTS1399621
+Node: SHOW-CUSTOM-KEYWORD-HINT-EXPANSION1400109
+Node: DEFAULT-BACKCHAIN-LIMIT1400933
+Node: DEFAULT-DEFUN-MODE1401415
+Node: DEFAULT-HINTS1403158
+Node: DEFAULT-PRINT-PROMPT1403900
+Node: DEFAULT-RULER-EXTENDERS1405411
+Node: DEFUN-MODE1406180
+Node: DEFUNS1411814
+Node: DISABLE-FORCING1412692
+Node: DISABLE-IMMEDIATE-FORCE-MODEP1413417
+Node: DISABLEDP1414304
+Node: DO-NOT1415538
+Node: DO-NOT-INDUCT1415695
+Node: DOUBLE-REWRITE1415871
+Node: EMBEDDED-EVENT-FORM1425952
+Node: ENABLE-FORCING1431466
+Node: ENABLE-IMMEDIATE-FORCE-MODEP1432249
+Node: ENTER-BOOT-STRAP-MODE1433133
+Node: ESCAPE-TO-COMMON-LISP1434368
+Node: EXECUTABLE-COUNTERPART1434842
+Node: EXIT-BOOT-STRAP-MODE1438403
+Node: EXPAND1439121
+Node: EXTENDED-METAFUNCTIONS1439298
+Node: FAILED-FORCING1455168
+Node: FAILURE1461826
+Node: FIND-RULES-OF-RUNE1464500
+Node: FINDING-DOCUMENTATION1465763
+Node: FNCALL-TERM1466916
+Node: FORCE1467071
+Node: FORCED1473780
+Node: FORCING-ROUND1473910
+Node: FUNCTIONAL-INSTANTIATION-IN-ACL2R1479186
+Node: GAG-MODE1480306
+Node: GC$1480634
+Node: GC-VERBOSE1481610
+Node: GCL1482488
+Node: GET-INTERNAL-TIME1487086
+Node: GET-WORMHOLE-STATUS1489259
+Node: GOAL-SPEC1490069
+Node: GUARD1494145
+Node: EXTRA-INFO1496501
+Node: GUARD-DEBUG1496800
+Node: GUARD-EVALUATION-EXAMPLES-LOG1501091
+Node: GUARD-EVALUATION-EXAMPLES-SCRIPT1522762
+Node: GUARD-EVALUATION-TABLE1528455
+Node: GUARD-INTRODUCTION1534049
+Node: GUARD-MISCELLANY1536421
+Node: GUARD-QUICK-REFERENCE1540603
+Node: GUARDS-AND-EVALUATION1543209
+Node: GUARDS-FOR-SPECIFICATION1559413
+Node: GUARD-HINTS1561755
+Node: HANDS-OFF1561919
+Node: HIDE1562078
+Node: HINTS1566392
+Node: HINTS-AND-THE-WATERFALL1600059
+Node: I-AM-HERE1611440
+Node: IF-INTRO1612442
+Node: IGNORED-ATTACHMENT1612588
+Node: IMMED-FORCED1616560
+Node: IMMEDIATE-FORCE-MODEP1616726
+Node: INDUCT1618099
+Node: KEYWORD1618262
+Node: KEYWORD-COMMANDS1618401
+Node: LAMBDA1620779
+Node: LAST-PROVER-STEPS1620923
+Node: LD-ERROR-ACTION1623181
+Node: LD-ERROR-TRIPLES1628762
+Node: LD-EVISC-TUPLE1629824
+Node: LD-MISSING-INPUT-OK1630921
+Node: LD-POST-EVAL-PRINT1631796
+Node: LD-PRE-EVAL-FILTER1635063
+Node: LD-PRE-EVAL-PRINT1636385
+Node: LD-PROMPT1638056
+Node: LD-QUERY-CONTROL-ALIST1639884
+Node: LD-REDEFINITION-ACTION1642888
+Node: LD-SKIP-PROOFSP1651980
+Node: LD-VERBOSE1657042
+Node: LEMMA-INSTANCE1658277
+Node: LINEAR-ARITHMETIC1663948
+Node: LOCAL-INCOMPATIBILITY1667280
+Node: LOGICAL-NAME1671976
+Node: LOOP-STOPPER1675293
+Node: LP1683286
+Node: MACRO-ARGS1686679
+Node: MAKE-WORMHOLE-STATUS1689562
+Node: MEASURE1690065
+Node: META-EXTRACT1690235
+Node: META-EXTRACT-CONTEXTUAL-FACT1705393
+Node: META-EXTRACT-FORMULA1705588
+Node: META-EXTRACT-GLOBAL-FACT1705787
+Node: META-EXTRACT-GLOBAL-FACT+1705987
+Node: META-EXTRACT-RW+-TERM1706189
+Node: MODE1706367
+Node: NAME1706521
+Node: NIL-GOAL1708662
+Node: NO-THANKS1710839
+Node: NON-EXECUTABLE1711005
+Node: NON-LINEAR-ARITHMETIC1711194
+Node: NONLINEARP1719580
+Node: NORMALIZE1719757
+Node: NU-REWRITER1719922
+Node: OBDD1723625
+Node: ORDINALS1723829
+Node: OTF-FLG1730453
+Node: OVERRIDE-HINTS1732191
+Node: P!1739584
+Node: PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS1740843
+Node: PARALLEL1742553
+Node: PARALLELISM-BUILD1742763
+Node: PRINT-DOC-START-COLUMN1742998
+Node: PROMPT1743856
+Node: PROOF-OF-WELL-FOUNDEDNESS1744793
+Node: PROOF-SUPPORTERS-ALIST1752020
+Node: REDEF1752200
+Node: REDEF!1752754
+Node: REDEF+1753276
+Node: REDEF-1754473
+Node: REDEFINED-NAMES1755025
+Node: REDUNDANT-EVENTS1756827
+Node: REORDER1770830
+Node: RESTRICT1770992
+Node: REWRITE-STACK-LIMIT1771159
+Node: SAVING-AND-RESTORING1772544
+Node: SET-WORMHOLE-DATA1772724
+Node: SET-WORMHOLE-ENTRY-CODE1773439
+Node: SHOW-BODIES1774178
+Node: SIGNATURE1775157
+Node: SIMPLE1782194
+Node: SPECIOUS-SIMPLIFICATION1783576
+Node: SPLITTER1788891
+Node: SPLITTER-OUTPUT1795904
+Node: STOBJS1796478
+Node: SUBVERSIVE-INDUCTIONS1796649
+Node: SUBVERSIVE-RECURSIONS1796884
+Node: SYNTAX1804402
+Node: SYNTAXP1804915
+Node: SYNTAXP-EXAMPLES1815120
+Node: TERM1821427
+Node: THE-METHOD1830377
+Node: TIME-TRACKER-TAU1835557
+Node: TRUST-TAG1838098
+Node: TTAGS-SEEN1838244
+Node: TTREE1840082
+Node: TYPE-SET1841270
+Node: TYPESPEC-CHECK1848159
+Node: USE1848305
+Node: USING-COMPUTED-HINTS1848465
+Node: USING-COMPUTED-HINTS-11849605
+Node: USING-COMPUTED-HINTS-21850857
+Node: USING-COMPUTED-HINTS-31854942
+Node: USING-COMPUTED-HINTS-41859701
+Node: USING-COMPUTED-HINTS-51865692
+Node: USING-COMPUTED-HINTS-61868048
+Node: USING-COMPUTED-HINTS-71877712
+Node: USING-COMPUTED-HINTS-81886606
+Node: USING-ENABLED-RULES1888475
+Node: VERSION1891435
+Node: WATERFALL1896178
+Node: WHY-BRR1896328
+Node: WORLD1899290
+Node: WORMHOLE1905518
+Node: WORMHOLE-DATA1926061
+Node: WORMHOLE-ENTRY-CODE1926444
+Node: WORMHOLE-EVAL1926851
+Node: WORMHOLE-IMPLEMENTATION1930426
+Node: WORMHOLE-P1934572
+Node: WORMHOLE-STATUSP1934921
+Node: XARGS1935301
+Node: OTHER1941803
+Node: ACCUMULATED-PERSISTENCE1945171
+Node: ACCUMULATED-PERSISTENCE-SUBTLETIES1964182
+Node: ACL2-DEFAULTS-TABLE1969171
+Node: ACL2-HELP1981668
+Node: CERTIFY-BOOK!1982122
+Node: COMMAND-LINE1983084
+Node: CW-GSTACK1983651
+Node: DEAD-EVENTS1985843
+Node: DISASSEMBLE$1989263
+Node: DMR1991445
+Node: DYNAMICALLY-MONITOR-REWRITES1999680
+Node: EXIT1999833
+Node: GOOD-BYE1999995
+Node: GUARD-OBLIGATION2001111
+Node: IN-PACKAGE2003897
+Node: LD2004532
+Node: CALLING-LD-IN-BAD-CONTEXTS2018123
+Node: PRINT-GV2019935
+Node: PROPS2024992
+Node: PSO2025273
+Node: PSO!2025715
+Node: PSOF2026172
+Node: PSOG2027076
+Node: PSTACK2027451
+Node: VERBOSE-PSTACK2029789
+Node: Q2030637
+Node: QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP2031434
+Node: QUIT2033265
+Node: REBUILD2033442
+Node: REDO-FLAT2035601
+Node: RESET-LD-SPECIALS2040011
+Node: SAVE-EXEC2041177
+Node: SET-ACCUMULATED-PERSISTENCE2053236
+Node: SHARP-BANG-READER2053426
+Node: SHARP-COMMA-READER2054317
+Node: SHARP-DOT-READER2054598
+Node: SHARP-U-READER2055910
+Node: SHOW-ACCUMULATED-PERSISTENCE2057498
+Node: SKIP-PROOFS2057689
+Node: THM2062675
+Node: TOP-LEVEL2063324
+Node: TRANS2065671
+Node: TRANS!2067011
+Node: TRANS12067460
+Node: VERIFY-GUARDS-FORMULA2067997
+Node: WALKABOUT2069117
+Node: WITH-PROVER-STEP-LIMIT2071735
+Node: WITH-PROVER-TIME-LIMIT2077963
+Node: WOF2082654
+Node: PARALLELISM2083409
+Node: COMPILING-ACL2P2085709
+Node: PARALLEL-PROGRAMMING2086831
+Node: DEFLOCK2089853
+Node: EARLY-TERMINATION2093005
+Node: ERROR-TRIPLES-AND-PARALLELISM2095148
+Node: GRANULARITY2097665
+Node: PAND2102177
+Node: PARALLEL-EXECUTION2104924
+Node: PARALLELISM-AT-THE-TOP-LEVEL2105257
+Node: PARALLELISM-PERFORMANCE2107585
+Node: PARALLELISM-TUTORIAL2109475
+Node: PARGS2120365
+Node: PLET2121894
+Node: POR2123446
+Node: SPEC-MV-LET2125267
+Node: WITH-OUTPUT-LOCK2128129
+Node: PARALLEL-PROOF2131055
+Node: ACL2P-KEY-CHECKPOINTS2132705
+Node: DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT2134595
+Node: PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION2134938
+Node: UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES2137432
+Node: WATERFALL-PARALLELISM2145176
+Node: WATERFALL-PRINTING2145465
+Node: UNSUPPORTED-PARALLELISM-FEATURES2145704
+Node: WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION2147774
+Node: PROGRAMMING2149120
+Node: ACL2-BUILT-INS2151355
+Node: *2171141
+Node: +2171551
+Node: -2171855
+Node: /2172311
+Node: /=2172847
+Node: 1+2173356
+Node: 1-2173597
+Node: <2173837
+Node: <=2174742
+Node: =2175030
+Node: >2175500
+Node: >=2175773
+Node: atsign2176069
+Node: ABS2176884
+Node: ACL2-COUNT2177533
+Node: ACL2-NUMBER-LISTP2178280
+Node: ACL2-NUMBERP2178605
+Node: ACONS2178857
+Node: ADD-TO-SET2179338
+Node: ADD-TO-SET-EQ2180833
+Node: ADD-TO-SET-EQL2180989
+Node: ADD-TO-SET-EQUAL2181152
+Node: ALISTP2181310
+Node: ALLOCATE-FIXNUM-RANGE2181628
+Node: ALPHA-CHAR-P2182460
+Node: ALPHORDER2183000
+Node: AND2184131
+Node: APPEND2184536
+Node: ASH2185230
+Node: ASSERT$2185837
+Node: ASSIGN2186432
+Node: ASSOC2187756
+Node: ASSOC-EQ2189223
+Node: ASSOC-EQUAL2189356
+Node: ASSOC-KEYWORD2189500
+Node: ASSOC-STRING-EQUAL2190006
+Node: ATOM2190524
+Node: ATOM-LISTP2190907
+Node: BINARY-*2191254
+Node: BINARY-+2191827
+Node: BINARY-APPEND2192455
+Node: BOOLE$2192825
+Node: BOOLEANP2194456
+Node: BREAK$2194894
+Node: BREAKS2195336
+Node: BUTLAST2197417
+Node: CAAAAR2198412
+Node: CAAADR2198584
+Node: CAAAR2198754
+Node: CAADAR2198922
+Node: CAADDR2199092
+Node: CAADR2199262
+Node: CAAR2199428
+Node: CADAAR2199592
+Node: CADADR2199761
+Node: CADAR2199931
+Node: CADDAR2200099
+Node: CADDDR2200269
+Node: CADDR2200439
+Node: CADR2200605
+Node: CANONICAL-PATHNAME2200781
+Node: CAR2202607
+Node: CASE2203028
+Node: CASE-MATCH2204348
+Node: CDAAAR2207253
+Node: CDAADR2207428
+Node: CDAAR2207598
+Node: CDADAR2207766
+Node: CDADDR2207936
+Node: CDADR2208106
+Node: CDAR2208272
+Node: CDDAAR2208436
+Node: CDDADR2208605
+Node: CDDAR2208775
+Node: CDDDAR2208943
+Node: CDDDDR2209113
+Node: CDDDR2209283
+Node: CDDR2209449
+Node: CDR2209610
+Node: CEILING2210016
+Node: CHAR2210991
+Node: CHAR-CODE2211490
+Node: CHAR-DOWNCASE2211889
+Node: CHAR-EQUAL2212471
+Node: CHAR-UPCASE2213027
+Node: CHAR<2213595
+Node: CHAR<=2214061
+Node: CHAR>2214546
+Node: CHAR>=2215013
+Node: CHARACTER-ALISTP2215515
+Node: CHARACTER-LISTP2215827
+Node: CHARACTERP2216156
+Node: CHARACTERS2216366
+Node: CHECK-SUM2218900
+Node: CLOSE-INPUT-CHANNEL2220917
+Node: CLOSE-OUTPUT-CHANNEL2221082
+Node: CODE-CHAR2221248
+Node: COERCE2221825
+Node: COMPLEX2222671
+Node: COMPLEX-RATIONALP2224419
+Node: COMPLEX/COMPLEX-RATIONALP2224948
+Node: CONCATENATE2225593
+Node: COND2226868
+Node: CONJUGATE2227295
+Node: CONS2227719
+Node: CONSP2228014
+Node: COUNT2228193
+Node: CPU-CORE-COUNT2229337
+Node: CW2230165
+Node: CW!2233429
+Node: DELETE-ASSOC2233799
+Node: DELETE-ASSOC-EQ2235347
+Node: DELETE-ASSOC-EQUAL2235515
+Node: DENOMINATOR2235685
+Node: DIGIT-CHAR-P2236058
+Node: DIGIT-TO-CHAR2236872
+Node: E0-ORD-<2237494
+Node: E0-ORDINALP2238318
+Node: EC-CALL2239122
+Node: EIGHTH2244876
+Node: ENDP2245055
+Node: EQ2245640
+Node: EQL2246511
+Node: EQLABLE-ALISTP2247067
+Node: EQLABLE-LISTP2247446
+Node: EQLABLEP2247802
+Node: EQUAL2248248
+Node: ER2248548
+Node: ER-PROGN2251081
+Node: ERROR12252869
+Node: EVENP2254091
+Node: EXPLODE-NONNEGATIVE-INTEGER2254604
+Node: EXPT2255327
+Node: F-GET-GLOBAL2256010
+Node: F-PUT-GLOBAL2256939
+Node: FIFTH2258157
+Node: FIRST2258339
+Node: FIX2258512
+Node: FIX-TRUE-LIST2258982
+Node: FLET2259345
+Node: FLOOR2263898
+Node: FMS2264855
+Node: FMS!2265088
+Node: FMS!-TO-STRING2265536
+Node: FMS-TO-STRING2265696
+Node: FMT2265854
+Node: FMT!2284207
+Node: FMT!-TO-STRING2284655
+Node: FMT-TO-COMMENT-WINDOW2284823
+Node: FMT-TO-STRING2285766
+Node: FMT12285932
+Node: FMT1!2286189
+Node: FMT1!-TO-STRING2286655
+Node: FMT1-TO-STRING2286819
+Node: FOURTH2286983
+Node: GET-OUTPUT-STREAM-STRING$2287190
+Node: GETENV$2287351
+Node: GETPROP2288094
+Node: GOOD-ATOM-LISTP2288564
+Node: HARD-ERROR2288993
+Node: IDENTITY2290353
+Node: IF2290625
+Node: IFF2291003
+Node: IFIX2291328
+Node: ILLEGAL2291821
+Node: IMAGPART2292744
+Node: IMPLIES2293089
+Node: IMPROPER-CONSP2293418
+Node: INT=2293836
+Node: INTEGER-LENGTH2294223
+Node: INTEGER-LISTP2294865
+Node: INTEGERP2295180
+Node: INTERN2295380
+Node: INTERN$2297072
+Node: INTERN-IN-PACKAGE-OF-SYMBOL2297729
+Node: INTERSECTION$2299795
+Node: INTERSECTION-EQ2302198
+Node: INTERSECTION-EQUAL2302368
+Node: INTERSECTP2302538
+Node: INTERSECTP-EQ2303853
+Node: INTERSECTP-EQUAL2304011
+Node: KEYWORD-VALUE-LISTP2304181
+Node: KEYWORDP2304595
+Node: KWOTE2305315
+Node: KWOTE-LST2305667
+Node: LAST2306013
+Node: LEN2306589
+Node: LENGTH2307114
+Node: LET2307542
+Node: LET*2312476
+Node: LEXORDER2314200
+Node: LIST2314900
+Node: LIST*2315281
+Node: LISTP2315670
+Node: LOGAND2316074
+Node: LOGANDC12316652
+Node: LOGANDC22317212
+Node: LOGBITP2317774
+Node: LOGCOUNT2318323
+Node: LOGEQV2318768
+Node: LOGIOR2319359
+Node: LOGNAND2319950
+Node: LOGNOR2320428
+Node: LOGNOT2320927
+Node: LOGORC12321491
+Node: LOGORC22322059
+Node: LOGTEST2322629
+Node: LOGXOR2323184
+Node: LOWER-CASE-P2323781
+Node: MAKE-CHARACTER-LIST2324334
+Node: MAKE-LIST2324644
+Node: MAKE-ORD2325205
+Node: MAX2326345
+Node: MBE2326755
+Node: MBE12332420
+Node: MBT2332677
+Node: MEMBER2336589
+Node: MEMBER-EQ2338041
+Node: MEMBER-EQUAL2338179
+Node: MIN2338317
+Node: MINUSP2338736
+Node: MOD2339153
+Node: MOD-EXPT2339778
+Node: MSG2340696
+Node: MUST-BE-EQUAL2345180
+Node: MV2345928
+Node: MV-LET2346867
+Node: MV-LIST2352050
+Node: MV-NTH2353595
+Node: MV?2355336
+Node: MV?-LET2356080
+Node: NAT-LISTP2357343
+Node: NATP2357650
+Node: NFIX2358221
+Node: NINTH2358739
+Node: NO-DUPLICATESP2358922
+Node: NO-DUPLICATESP-EQ2360209
+Node: NO-DUPLICATESP-EQUAL2360387
+Node: NON-EXEC2360562
+Node: NONNEGATIVE-INTEGER-QUOTIENT2363549
+Node: NOT2364343
+Node: NTH2364734
+Node: NTHCDR2365221
+Node: NULL2365997
+Node: NUMERATOR2366473
+Node: O-FINP2366815
+Node: O-FIRST-COEFF2367283
+Node: O-FIRST-EXPT2367933
+Node: O-INFP2368558
+Node: O-P2368787
+Node: O-RST2375005
+Node: O<2375627
+Node: O<=2378779
+Node: O>2378994
+Node: O>=2379195
+Node: OBSERVATION2379422
+Node: OBSERVATION-CW2382313
+Node: ODDP2382463
+Node: OPEN-INPUT-CHANNEL2382909
+Node: OPEN-INPUT-CHANNEL-P2383067
+Node: OPEN-OUTPUT-CHANNEL2383242
+Node: OPEN-OUTPUT-CHANNEL-P2383419
+Node: OR2383580
+Node: ORACLE-APPLY2384624
+Node: ORACLE-APPLY-RAW2388597
+Node: ORACLE-FUNCALL2389776
+Node: PAIRLIS2390800
+Node: PAIRLIS$2391090
+Node: PEEK-CHAR$2391751
+Node: PKG-IMPORTS2391888
+Node: PKG-WITNESS2394076
+Node: PLUSP2394786
+Node: POSITION2395211
+Node: POSITION-EQ2396763
+Node: POSITION-EQUAL2396911
+Node: POSP2397058
+Node: PPROGN2397579
+Node: PRINC$2398712
+Node: PRINT-OBJECT$2400587
+Node: PROG2$2400723
+Node: PROGN$2402993
+Node: PROOFS-CO2403634
+Node: PROPER-CONSP2404216
+Node: PSEUDO-TERMP2404592
+Node: PUT-ASSOC2407585
+Node: PUT-ASSOC-EQ2409205
+Node: PUT-ASSOC-EQL2409356
+Node: PUT-ASSOC-EQUAL2409514
+Node: PUTPROP2409669
+Node: QUOTE2410126
+Node: R-EQLABLE-ALISTP2410331
+Node: R-SYMBOL-ALISTP2410720
+Node: RANDOM$2411089
+Node: RASSOC2412112
+Node: RASSOC-EQ2413775
+Node: RASSOC-EQUAL2413913
+Node: RATIONAL-LISTP2414062
+Node: RATIONALP2414395
+Node: READ-BYTE$2414636
+Node: READ-CHAR$2414773
+Node: READ-OBJECT2414912
+Node: READ-RUN-TIME2415055
+Node: REAL/RATIONALP2415762
+Node: REALFIX2416325
+Node: REALPART2416841
+Node: REM2417177
+Node: REMOVE2417813
+Node: REMOVE-DUPLICATES2419313
+Node: REMOVE-DUPLICATES-EQ2421522
+Node: REMOVE-DUPLICATES-EQUAL2421715
+Node: REMOVE-EQ2421903
+Node: REMOVE-EQUAL2422058
+Node: REMOVE12422200
+Node: REMOVE1-EQ2423655
+Node: REMOVE1-EQUAL2423798
+Node: REST2423941
+Node: RETURN-LAST2424213
+Node: REVAPPEND2443921
+Node: REVERSE2444739
+Node: RFIX2445197
+Node: ROUND2445702
+Node: SEARCH2446758
+Node: SECOND2449399
+Node: SET-DIFFERENCE$2449588
+Node: SET-DIFFERENCE-EQ2451302
+Node: SET-DIFFERENCE-EQUAL2451482
+Node: SETENV$2451657
+Node: SEVENTH2452459
+Node: SIGNED-BYTE-P2452650
+Node: SIGNUM2453266
+Node: SIXTH2453994
+Node: STANDARD-CHAR-LISTP2454184
+Node: STANDARD-CHAR-P2454627
+Node: STANDARD-CO2455272
+Node: STANDARD-OI2456151
+Node: STANDARD-STRING-ALISTP2457291
+Node: STATE-GLOBAL-LET*2457801
+Node: STRING2461352
+Node: STRING-APPEND2461957
+Node: STRING-DOWNCASE2462534
+Node: STRING-EQUAL2463102
+Node: STRING-LISTP2463720
+Node: STRING-UPCASE2464034
+Node: STRING<2464584
+Node: STRING<=2465407
+Node: STRING>2466086
+Node: STRING>=2466589
+Node: STRINGP2467268
+Node: STRIP-CARS2467456
+Node: STRIP-CDRS2467932
+Node: SUBLIS2468402
+Node: SUBSEQ2469116
+Node: SUBSETP2470127
+Node: SUBSETP-EQ2471476
+Node: SUBSETP-EQUAL2471619
+Node: SUBST2471763
+Node: SUBSTITUTE2472370
+Node: SYMBOL-<2473115
+Node: SYMBOL-ALISTP2473768
+Node: SYMBOL-LISTP2474126
+Node: SYMBOL-NAME2474438
+Node: SYMBOL-PACKAGE-NAME2474806
+Node: SYMBOLP2475751
+Node: SYS-CALL2475948
+Node: SYS-CALL+2478959
+Node: SYS-CALL-STATUS2481269
+Node: TAKE2482042
+Node: TENTH2483008
+Node: TERM-ORDER2483187
+Node: THE2489972
+Node: THIRD2491512
+Node: TIME$2491685
+Node: TRUE-LIST-LISTP2497810
+Node: TRUE-LISTP2498241
+Node: TRUNCATE2498575
+Node: UNARY--2499726
+Node: UNARY-/2500225
+Node: UNION$2500792
+Node: UNION-EQ2502942
+Node: UNION-EQUAL2503077
+Node: UNSIGNED-BYTE-P2503224
+Node: UNTRANSLATE2503823
+Node: UPDATE-NTH2503994
+Node: UPPER-CASE-P2505070
+Node: WITH-LIVE-STATE2505624
+Node: WRITE-BYTE$2507009
+Node: XOR2507147
+Node: ZEROP2507449
+Node: ZIP2508219
+Node: ZP2509167
+Node: ZPF2510170
+Node: ACL2-USER2510601
+Node: ARRAYS2512486
+Node: AREF12533673
+Node: AREF22534483
+Node: ARRAY1P2535293
+Node: ARRAY2P2535754
+Node: ARRAYS-EXAMPLE2536224
+Node: ASET12539088
+Node: ASET22540647
+Node: COMPRESS12542209
+Node: COMPRESS22544141
+Node: DEFAULT2545525
+Node: DIMENSIONS2546282
+Node: FLUSH-COMPRESS2547178
+Node: HEADER2552567
+Node: MAXIMUM-LENGTH2553051
+Node: SLOW-ARRAY-WARNING2553800
+Node: COMPILATION2558866
+Node: DECLARE2560863
+Node: TYPE-SPEC2563349
+Node: EQUALITY-VARIANTS2566734
+Node: EQUALITY-VARIANTS-DETAILS2571489
+Node: IGNORABLE2578223
+Node: IGNORE2578364
+Node: IRRELEVANT-FORMALS2578503
+Node: OPTIMIZE2581599
+Node: REDEFINING-PROGRAMS2581752
+Node: SINGLE-THREADED-OBJECTS2587875
+Node: STATE2588043
+Node: ERROR-TRIPLES2597066
+Node: PROGRAMMING-WITH-STATE2598270
+Node: TIME-TRACKER2620242
+Node: TYPE2632346
+Node: ZERO-TEST-IDIOMS2632482
+Node: PROOF-CHECKER2640112
+Node: DEFINE-PC-HELP2642778
+Node: DEFINE-PC-MACRO2644007
+Node: DEFINE-PC-META2645476
+Node: INSTRUCTIONS2645995
+Node: MACRO-COMMAND2665970
+Node: PROOF-CHECKER-COMMANDS2667248
+Node: ACL2-PC||=2675705
+Node: ACL2-PC||ACL2-WRAP2679931
+Node: ACL2-PC||ADD-ABBREVIATION2680379
+Node: ACL2-PC||AL2682430
+Node: ACL2-PC||APPLY-LINEAR2682723
+Node: ACL2-PC||BASH2687486
+Node: ACL2-PC||BDD2688585
+Node: ACL2-PC||BK2689272
+Node: ACL2-PC||BOOKMARK2689976
+Node: ACL2-PC||CASESPLIT2690659
+Node: ACL2-PC||CG2693161
+Node: ACL2-PC||CHANGE-GOAL2693639
+Node: ACL2-PC||CL-PROC2694428
+Node: ACL2-PC||CLAIM2694715
+Node: ACL2-PC||CLAUSE-PROCESSOR2696827
+Node: ACL2-PC||COMM2697653
+Node: ACL2-PC||COMMANDS2699859
+Node: ACL2-PC||COMMENT2700889
+Node: ACL2-PC||CONTRADICT2701360
+Node: ACL2-PC||CONTRAPOSE2701584
+Node: ACL2-PC||DEMOTE2702374
+Node: ACL2-PC||DIVE2703507
+Node: ACL2-PC||DO-ALL2704938
+Node: ACL2-PC||DO-ALL-NO-PROMPT2705879
+Node: ACL2-PC||DO-STRICT2706473
+Node: ACL2-PC||DROP2707039
+Node: ACL2-PC||DV2707745
+Node: ACL2-PC||ELIM2710013
+Node: ACL2-PC||EQUIV2710497
+Node: ACL2-PC||EX2712720
+Node: ACL2-PC||EXIT2713091
+Node: ACL2-PC||EXPAND2716185
+Node: ACL2-PC||FAIL2717132
+Node: ACL2-PC||FINISH2717693
+Node: ACL2-PC||FORWARDCHAIN2718393
+Node: ACL2-PC||FREE2719547
+Node: ACL2-PC||GENEQV2719936
+Node: ACL2-PC||GENERALIZE2721331
+Node: ACL2-PC||GOALS2723119
+Node: ACL2-PC||HELP2723577
+Node: ACL2-PC||HELP!2725978
+Node: ACL2-PC||HELP-LONG2726337
+Node: ACL2-PC||HYPS2726663
+Node: ACL2-PC||ILLEGAL2728787
+Node: ACL2-PC||IN-THEORY2729297
+Node: ACL2-PC||INDUCT2731939
+Node: ACL2-PC||LEMMAS-USED2732997
+Node: ACL2-PC||LISP2733245
+Node: ACL2-PC||MORE2735019
+Node: ACL2-PC||MORE!2735342
+Node: ACL2-PC||NEGATE2735724
+Node: ACL2-PC||NIL2736203
+Node: ACL2-PC||NOISE2736658
+Node: ACL2-PC||NX2737344
+Node: ACL2-PC||ORELSE2737993
+Node: ACL2-PC||P2738583
+Node: ACL2-PC||P-TOP2739264
+Node: ACL2-PC||PL2740153
+Node: ACL2-PC||PP2740808
+Node: ACL2-PC||PR2741237
+Node: ACL2-PC||PRINT2741892
+Node: ACL2-PC||PRINT-ALL-CONCS2742799
+Node: ACL2-PC||PRINT-ALL-GOALS2743217
+Node: ACL2-PC||PRINT-MAIN2743609
+Node: ACL2-PC||PRO2743892
+Node: ACL2-PC||PROMOTE2744324
+Node: ACL2-PC||PROTECT2745327
+Node: ACL2-PC||PROVE2745944
+Node: ACL2-PC||PSO2747223
+Node: ACL2-PC||PSO!2747950
+Node: ACL2-PC||PSOG2748708
+Node: ACL2-PC||PUT2749459
+Node: ACL2-PC||QUIET2750863
+Node: ACL2-PC||R2751225
+Node: ACL2-PC||REDUCE2751482
+Node: ACL2-PC||REDUCE-BY-INDUCTION2752604
+Node: ACL2-PC||REMOVE-ABBREVIATIONS2753734
+Node: ACL2-PC||REPEAT2754826
+Node: ACL2-PC||REPEAT-REC2755370
+Node: ACL2-PC||REPLAY2755587
+Node: ACL2-PC||RESTORE2756752
+Node: ACL2-PC||RETAIN2757501
+Node: ACL2-PC||RETRIEVE2758093
+Node: ACL2-PC||REWRITE2758945
+Node: ACL2-PC||RUN-INSTR-ON-GOAL2764512
+Node: ACL2-PC||RUN-INSTR-ON-NEW-GOALS2764756
+Node: ACL2-PC||RUNES2765003
+Node: ACL2-PC||S2765742
+Node: ACL2-PC||S-PROP2768339
+Node: ACL2-PC||SAVE2768948
+Node: ACL2-PC||SEQUENCE2769860
+Node: ACL2-PC||SHOW-ABBREVIATIONS2773736
+Node: ACL2-PC||SHOW-LINEARS2774928
+Node: ACL2-PC||SHOW-REWRITES2775590
+Node: ACL2-PC||SHOW-TYPE-PRESCRIPTIONS2777108
+Node: ACL2-PC||SKIP2777833
+Node: ACL2-PC||SL2778151
+Node: ACL2-PC||SLS2778849
+Node: ACL2-PC||SPLIT2779364
+Node: ACL2-PC||SR2780823
+Node: ACL2-PC||ST2781159
+Node: ACL2-PC||SUCCEED2781510
+Node: ACL2-PC||TH2781972
+Node: ACL2-PC||THEN2782940
+Node: ACL2-PC||TOP2783585
+Node: ACL2-PC||TYPE-ALIST2784237
+Node: ACL2-PC||UNDO2786967
+Node: ACL2-PC||UNSAVE2787842
+Node: ACL2-PC||UP2788564
+Node: ACL2-PC||USE2789402
+Node: ACL2-PC||WRAP2790266
+Node: ACL2-PC||WRAP-INDUCT2791183
+Node: ACL2-PC||WRAP12792065
+Node: ACL2-PC||X2793447
+Node: ACL2-PC||X-DUMB2795409
+Node: RETRIEVE2795803
+Node: TOGGLE-PC-MACRO2796231
+Node: UNSAVE2796903
+Node: VERIFY2797304
+Node: PROOF-TREE2798550
+Node: CHECKPOINT-FORCED-GOALS2802754
+Node: PROOF-TREE-DETAILS2803499
+Node: PROOF-TREE-EXAMPLES2805628
+Node: START-PROOF-TREE2815549
+Node: STOP-PROOF-TREE2816222
+Node: Pages Written Especially for the Tours2816918
+Node: A Flying Tour of ACL22826719
+Node: A Sketch of How the Rewriter Works2828390
+Node: A Tiny Warning Sign2829644
+Node: A Trivial Proof2830331
+Node: A Typical State2830517
+Node: A Walking Tour of ACL22831383
+Node: ACL2 Characters2832503
+Node: ACL2 Conses or Ordered Pairs2833349
+Node: ACL2 Strings2834854
+Node: ACL2 Symbols2835695
+Node: ACL2 System Architecture2838232
+Node: ACL2 as an Interactive Theorem Prover2839410
+Node: ACL2 as an Interactive Theorem Prover (cont)2839954
+Node: ACL2 is an Untyped Language2841421
+Node: About Models2842548
+Node: About Types2843369
+Node: About the ACL2 Home Page2845497
+Node: About the Admission of Recursive Definitions2846765
+Node: About the Prompt2848363
+Node: An Example Common Lisp Function Definition2851847
+Node: An Example of ACL2 in Use2853117
+Node: Analyzing Common Lisp Models2855364
+Node: Common Lisp2856789
+Node: Common Lisp as a Modeling Language2858797
+Node: Conversion2860292
+Node: Corroborating Models2861204
+Node: Evaluating App on Sample Input2863288
+Node: Flawed Induction Candidates in App Example2864354
+Node: Free Variables in Top-Level Input2865069
+Node: Functions for Manipulating these Objects2866816
+Node: Guards2867968
+Node: Guessing the Type of a Newly Admitted Function2869724
+Node: Guiding the ACL2 Theorem Prover2870694
+Node: Hey Wait! Is ACL2 Typed or Untyped(Q)2871750
+Node: How Long Does It Take to Become an Effective User(Q)2872787
+Node: How To Find Out about ACL2 Functions2873884
+Node: How To Find Out about ACL2 Functions (cont)2875112
+Node: Modeling in ACL22876515
+Node: Models in Engineering2877348
+Node: Models of Computer Hardware and Software2877964
+Node: Name the Formula Above2879019
+Node: Nontautological Subgoals2879381
+Node: Numbers in ACL22879899
+Node: On the Naming of Subgoals2882179
+Node: Other Requirements2882695
+Node: Overview of the Expansion of ENDP in the Base Case2883552
+Node: Overview of the Expansion of ENDP in the Induction Step2884062
+Node: Overview of the Final Simplification in the Base Case2884806
+Node: Overview of the Proof of a Trivial Consequence2885332
+Node: Overview of the Simplification of the Base Case to T2887062
+Node: Overview of the Simplification of the Induction Conclusion2888023
+Node: Overview of the Simplification of the Induction Step to T2888722
+Node: Perhaps2889923
+Node: Popping out of an Inductive Proof2890268
+Node: Proving Theorems about Models2890717
+Node: Revisiting the Admission of App2892073
+Node: Rewrite Rules are Generated from DEFTHM Events2893355
+Node: Running Models2894352
+Node: Subsumption of Induction Candidates in App Example2895464
+Node: Suggested Inductions in the Associativity of App Example2896254
+Node: Symbolic Execution of Models2897042
+Node: The Admission of App2897745
+Node: The Associativity of App2899244
+Node: The Base Case in the App Example2900618
+Node: The End of the Flying Tour2901199
+Node: The End of the Proof of the Associativity of App2901647
+Node: The End of the Walking Tour2902516
+Node: The Event Summary2903723
+Node: The Expansion of ENDP in the Induction Step (Step 0)2905989
+Node: The Expansion of ENDP in the Induction Step (Step 1)2906656
+Node: The Expansion of ENDP in the Induction Step (Step 2)2907384
+Node: The Falling Body Model2908095
+Node: The Final Simplification in the Base Case (Step 0)2908905
+Node: The Final Simplification in the Base Case (Step 1)2909539
+Node: The Final Simplification in the Base Case (Step 2)2910149
+Node: The Final Simplification in the Base Case (Step 3)2910679
+Node: The First Application of the Associativity Rule2911324
+Node: The Induction Scheme Selected for the App Example2912125
+Node: The Induction Step in the App Example2912977
+Node: The Instantiation of the Induction Scheme2913880
+Node: The Justification of the Induction Scheme2914467
+Node: The Proof of the Associativity of App2914942
+Node: The Q.E.D. Message2917490
+Node: The Rules used in the Associativity of App Proof2917882
+Node: The Simplification of the Induction Conclusion (Step 0)2918672
+Node: The Simplification of the Induction Conclusion (Step 1)2919344
+Node: The Simplification of the Induction Conclusion (Step 10)2920470
+Node: The Simplification of the Induction Conclusion (Step 11)2921259
+Node: The Simplification of the Induction Conclusion (Step 12)2921969
+Node: The Simplification of the Induction Conclusion (Step 2)2922636
+Node: The Simplification of the Induction Conclusion (Step 3)2923427
+Node: The Simplification of the Induction Conclusion (Step 4)2924151
+Node: The Simplification of the Induction Conclusion (Step 5)2925067
+Node: The Simplification of the Induction Conclusion (Step 6)2925944
+Node: The Simplification of the Induction Conclusion (Step 7)2926792
+Node: The Simplification of the Induction Conclusion (Step 8)2927613
+Node: The Simplification of the Induction Conclusion (Step 9)2928506
+Node: The Summary of the Proof of the Trivial Consequence2929447
+Node: The Theorem that App is Associative2929967
+Node: The Time Taken to do the Associativity of App Proof2931345
+Node: The Tours2932131
+Node: The WARNING about the Trivial Consequence2934201
+Node: Undocumented Topic2935100
+Node: Using the Associativity of App to Prove a Trivial Consequence2935411
+Node: What Is ACL2(Q)2936192
+Node: What is Required of the User(Q)2937185
+Node: What is a Mathematical Logic(Q)2938225
+Node: What is a Mechanical Theorem Prover(Q)2939146
+Node: What is a Mechanical Theorem Prover(Q) (cont)2940070
+Node: You Must Think about the Use of a Formula as a Rule2940649
+Node: REAL2941766
+Node: I-CLOSE2944362
+Node: I-LARGE2944654
+Node: I-LIMITED2944953
+Node: I-SMALL2945241
+Node: REAL-LISTP2945533
+Node: STANDARD-PART2945844
+Node: STANDARDP2946212
+Node: RELEASE-NOTES2947244
+Node: NOTE-2-02950981
+Node: NOTE-2-12952181
+Node: NOTE-2-22952574
+Node: NOTE-2-32955309
+Node: NOTE-2-42957417
+Node: NOTE-2-52958902
+Node: NOTE-2-5(R)2974167
+Node: NOTE-2-62974500
+Node: NOTE-2-6-GUARDS2975745
+Node: NOTE-2-6-NEW-FUNCTIONALITY2978561
+Node: NOTE-2-6-OTHER2987078
+Node: NOTE-2-6-PROOF-CHECKER2992276
+Node: NOTE-2-6-PROOFS2993162
+Node: NOTE-2-6-RULES2998669
+Node: NOTE-2-6-SYSTEM3001768
+Node: NOTE-2-6(R)3003830
+Node: NOTE-2-73004193
+Node: NOTE-2-7-BUG-FIXES3008328
+Node: NOTE-2-7-GUARDS3021826
+Node: NOTE-2-7-NEW-FUNCTIONALITY3022703
+Node: NOTE-2-7-OTHER3030278
+Node: NOTE-2-7-PROOF-CHECKER3038366
+Node: NOTE-2-7-PROOFS3038699
+Node: NOTE-2-7-RULES3044050
+Node: NOTE-2-7-SYSTEM3044947
+Node: NOTE-2-7(R)3047919
+Node: NOTE-2-83048656
+Node: NOTE-2-8-BUG-FIXES3056410
+Node: NOTE-2-8-GUARDS3072907
+Node: NOTE-2-8-NEW-FUNCTIONALITY3073208
+Node: NOTE-2-8-ORDINALS3080690
+Node: NOTE-2-8-OTHER3080921
+Node: NOTE-2-8-PROOF-CHECKER3083216
+Node: NOTE-2-8-PROOFS3084819
+Node: NOTE-2-8-RULES3088910
+Node: NOTE-2-8-SYSTEM3090578
+Node: NOTE-2-8(R)3091629
+Node: NOTE-2-93092127
+Node: NOTE-2-9(R)3112854
+Node: NOTE-2-9-13113216
+Node: NOTE-2-9-23120596
+Node: NOTE-2-9-33129447
+Node: NOTE-2-9-3-PPR-CHANGE3139077
+Node: NOTE-2-9-43147804
+Node: NOTE-2-9-53163801
+Node: NOTE-3-03175404
+Node: NOTE-3-0(R)3176369
+Node: NOTE-3-0-13176711
+Node: NOTE-3-0-1(R)3188719
+Node: NOTE-3-0-23189075
+Node: NOTE-3-13204123
+Node: NOTE-3-1(R)3204579
+Node: NOTE-3-23204923
+Node: NOTE-3-2(R)3224543
+Node: NOTE-3-2-13225431
+Node: NOTE-3-2-1(R)3233676
+Node: NOTE-3-33233918
+Node: NOTE-3-3(R)3251011
+Node: NOTE-3-43251245
+Node: NOTE-3-4(R)3277571
+Node: NOTE-3-53278154
+Node: NOTE-3-5(R)3310648
+Node: NOTE-3-63313574
+Node: NOTE-3-6(R)3327880
+Node: NOTE-3-6-13328114
+Node: NOTE-4-03329994
+Node: NOTE-4-0-WORMHOLE-CHANGES3366861
+Node: NOTE-4-0(R)3369252
+Node: NOTE-4-13369477
+Node: NOTE-4-1(R)3375775
+Node: NOTE-4-23376005
+Node: NOTE-4-2(R)3397690
+Node: NOTE-4-33397918
+Node: NOTE-4-3(R)3425496
+Node: NOTE-5-03425721
+Node: NOTE-6-03470013
+Node: NOTE-6-13488447
+Node: NOTE-6-23498387
+Node: NOTE-6-33514368
+Node: NOTE13527987
+Node: NOTE23528802
+Node: NOTE33530288
+Node: NOTE43535720
+Node: NOTE53542089
+Node: NOTE63553264
+Node: NOTE73558226
+Node: NOTE83566414
+Node: NOTE8-UPDATE3580521
+Node: NOTE93582610
+Node: RULE-CLASSES3585571
+Node: BUILT-IN-CLAUSE3603585
+Node: CLAUSE-PROCESSOR3608809
+Node: COMPOUND-RECOGNIZER3622169
+Node: CONGRUENCE3631977
+Node: DEFINITION3638411
+Node: ELIM3647623
+Node: EQUIVALENCE3654274
+Node: FORWARD-CHAINING3663206
+Node: FREE-VARIABLES3671072
+Node: FREE-VARIABLES-EXAMPLES3681110
+Node: FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING3681959
+Node: FREE-VARIABLES-EXAMPLES-REWRITE3688044
+Node: FREE-VARIABLES-TYPE-PRESCRIPTION3706133
+Node: GENERALIZE3709405
+Node: INDUCTION3710900
+Node: LINEAR3719028
+Node: META3726444
+Node: EVALUATOR-RESTRICTIONS3745048
+Node: REFINEMENT3757430
+Node: REWRITE3759513
+Node: TAU-SYSTEM3766480
+Node: BOUNDERS3782911
+Node: IN-TAU-INTERVALP3798745
+Node: MAKE-TAU-INTERVAL3802110
+Node: TAU-INTERVAL-DOM3804353
+Node: TAU-INTERVAL-HI3804901
+Node: TAU-INTERVAL-HI-REL3805550
+Node: TAU-INTERVAL-LO3806227
+Node: TAU-INTERVAL-LO-REL3806879
+Node: TAU-INTERVALP3807554
+Node: TYPE-PRESCRIPTION3810316
+Node: TYPE-SET-INVERTER3819654
+Node: WELL-FOUNDED-RELATION3822135
+Node: SERIALIZE3829442
+Node: SERIALIZE-ALTERNATIVES3830625
+Node: SERIALIZE-IN-BOOKS3831393
+Node: SERIALIZE-READ3833137
+Node: SERIALIZE-WRITE3834791
+Node: SET-SERIALIZE-CHARACTER3835699
+Node: WITH-SERIALIZE-CHARACTER3835899
+Node: STOBJ3838742
+Node: DECLARE-STOBJS3844799
+Node: NESTED-STOBJS3846955
+Node: RESIZE-LIST3870828
+Node: STOBJ-EXAMPLE-13871359
+Node: STOBJ-EXAMPLE-1-DEFUNS3880171
+Node: STOBJ-EXAMPLE-1-IMPLEMENTATION3884821
+Node: STOBJ-EXAMPLE-1-PROOFS3887571
+Node: STOBJ-EXAMPLE-23892970
+Node: STOBJ-EXAMPLE-33896040
+Node: STOBJ-LET3904740
+Node: WITH-LOCAL-STATE3904889
+Node: WITH-LOCAL-STOBJ3907941
+Node: SWITCHES-PARAMETERS-AND-MODES3911020
+Node: ACL2-CUSTOMIZATION3919479
+Node: ADD-BINOP3923467
+Node: ADD-DEFAULT-HINTS3923790
+Node: ADD-DEFAULT-HINTS!3925800
+Node: ADD-DIVE-INTO-MACRO3926340
+Node: ADD-INCLUDE-BOOK-DIR3926812
+Node: ADD-INVISIBLE-FNS3929193
+Node: ADD-LD-KEYWORD-ALIAS3930240
+Node: ADD-LD-KEYWORD-ALIAS!3930447
+Node: ADD-MACRO-ALIAS3930653
+Node: ADD-MACRO-FN3931474
+Node: ADD-MATCH-FREE-OVERRIDE3933466
+Node: ADD-NTH-ALIAS3937392
+Node: ADD-OVERRIDE-HINTS3938011
+Node: ADD-OVERRIDE-HINTS!3939170
+Node: DEFAULT-HINTS-TABLE3939592
+Node: DEFAULT-VERIFY-GUARDS-EAGERNESS3940451
+Node: DELETE-INCLUDE-BOOK-DIR3940693
+Node: DIVE-INTO-MACROS-TABLE3941855
+Node: FINALIZE-EVENT-USER3943556
+Node: INITIALIZE-EVENT-USER3948184
+Node: INVISIBLE-FNS-TABLE3950786
+Node: LD-KEYWORD-ALIASES3952723
+Node: LOGIC3956173
+Node: MACRO-ALIASES-TABLE3957366
+Node: NTH-ALIASES-TABLE3959938
+Node: PRINT-SUMMARY-USER3961010
+Node: PROGRAM3961200
+Node: PUSH-UNTOUCHABLE3962760
+Node: REMOVE-BINOP3964395
+Node: REMOVE-DEFAULT-HINTS3964736
+Node: REMOVE-DEFAULT-HINTS!3966210
+Node: REMOVE-DIVE-INTO-MACRO3966776
+Node: REMOVE-INVISIBLE-FNS3967351
+Node: REMOVE-MACRO-ALIAS3968216
+Node: REMOVE-MACRO-FN3968866
+Node: REMOVE-NTH-ALIAS3969536
+Node: REMOVE-OVERRIDE-HINTS3970161
+Node: REMOVE-OVERRIDE-HINTS!3971176
+Node: REMOVE-UNTOUCHABLE3971664
+Node: RESET-PREHISTORY3975227
+Node: RETURN-LAST-TABLE3976934
+Node: RULER-EXTENDERS3978257
+Node: SET-ABSSTOBJ-DEBUG3993738
+Node: SET-BACKCHAIN-LIMIT3997534
+Node: SET-BOGUS-DEFUN-HINTS-OK3999573
+Node: SET-BOGUS-MUTUAL-RECURSION-OK4000218
+Node: SET-CASE-SPLIT-LIMITATIONS4002071
+Node: SET-CHECKPOINT-SUMMARY-LIMIT4008949
+Node: SET-COMPILE-FNS4011225
+Node: SET-COMPILER-ENABLED4013425
+Node: SET-DEBUGGER-ENABLE4013621
+Node: SET-DEFAULT-BACKCHAIN-LIMIT4019166
+Node: SET-DEFAULT-HINTS4022174
+Node: SET-DEFAULT-HINTS!4024437
+Node: SET-DEFERRED-TTAG-NOTES4024978
+Node: SET-ENFORCE-REDUNDANCY4026363
+Node: SET-GAG-MODE4029575
+Node: SET-GUARD-CHECKING4034796
+Node: SET-IGNORE-DOC-STRING-ERROR4043830
+Node: SET-IGNORE-OK4045394
+Node: SET-INHIBIT-OUTPUT-LST4046800
+Node: SET-INHIBIT-WARNINGS4049315
+Node: SET-INHIBIT-WARNINGS!4051500
+Node: SET-INHIBITED-SUMMARY-TYPES4052058
+Node: SET-INVISIBLE-FNS-TABLE4053535
+Node: SET-IRRELEVANT-FORMALS-OK4055819
+Node: SET-LD-KEYWORD-ALIASES4056827
+Node: SET-LD-KEYWORD-ALIASES!4057048
+Node: SET-LD-REDEFINITION-ACTION4057271
+Node: SET-LD-SKIP-PROOFS4057497
+Node: SET-LD-SKIP-PROOFSP4057708
+Node: SET-LET*-ABSTRACTION4057910
+Node: SET-LET*-ABSTRACTIONP4058122
+Node: SET-MATCH-FREE-DEFAULT4059788
+Node: SET-MATCH-FREE-ERROR4062248
+Node: SET-MEASURE-FUNCTION4064179
+Node: SET-NON-LINEAR4065509
+Node: SET-NON-LINEARP4065698
+Node: SET-NU-REWRITER-MODE4066231
+Node: SET-OVERRIDE-HINTS4068293
+Node: SET-OVERRIDE-HINTS!4069106
+Node: SET-PARALLEL-EXECUTION4069528
+Node: SET-PRINT-CLAUSE-IDS4071467
+Node: SET-PROVER-STEP-LIMIT4073366
+Node: SET-RAW-MODE4079260
+Node: ADD-RAW-ARITY4085609
+Node: REMOVE-RAW-ARITY4087119
+Node: SET-RAW-MODE-ON!4087499
+Node: SET-RAW-PROOF-FORMAT4087994
+Node: SET-REWRITE-STACK-LIMIT4088932
+Node: SET-RULER-EXTENDERS4090244
+Node: SET-RW-CACHE-STATE4090449
+Node: SET-RW-CACHE-STATE!4093799
+Node: SET-SAVED-OUTPUT4094180
+Node: SET-SPLITTER-OUTPUT4097012
+Node: SET-STATE-OK4098613
+Node: SET-TAU-AUTO-MODE4101453
+Node: SET-TOTAL-PARALLELISM-WORK-LIMIT4107557
+Node: SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR4109832
+Node: SET-VERIFY-GUARDS-EAGERNESS4112046
+Node: SET-WATERFALL-PARALLELISM4114445
+Node: SET-WATERFALL-PARALLELISM-HACKS-ENABLED4119728
+Node: SET-WATERFALL-PARALLELISM-HACKS-ENABLED!4120964
+Node: SET-WATERFALL-PRINTING4121306
+Node: SET-WELL-FOUNDED-RELATION4124547
+Node: SET-WRITE-ACL2X4126002
+Node: TAU-STATUS4135878
+Node: TERM-TABLE4137568
+Node: UNTRANS-TABLE4138799
+Node: USER-DEFINED-FUNCTIONS-TABLE4139558
+Node: VERIFY-GUARDS-EAGERNESS4142740
+Node: WITH-GUARD-CHECKING4142971
+Node: WITH-OUTPUT4143845
+Node: THEORIES4150653
+Node: ACTIVE-RUNEP4159856
+Node: CURRENT-THEORY4160459
+Node: DISABLE4162140
+Node: E/D4163265
+Node: ENABLE4164438
+Node: EXECUTABLE-COUNTERPART-THEORY4165549
+Node: FUNCTION-THEORY4166723
+Node: GROUND-ZERO4167817
+Node: INCOMPATIBLE4168403
+Node: INTERSECTION-THEORIES4168989
+Node: MINIMAL-THEORY4169787
+Node: RULE-NAMES4170681
+Node: RUNE4170974
+Node: SET-DIFFERENCE-THEORIES4177849
+Node: THEORIES-AND-PRIMITIVES4178866
+Node: THEORY4182692
+Node: THEORY-FUNCTIONS4183405
+Node: UNION-THEORIES4185700
+Node: UNIVERSAL-THEORY4186460
+Node: TRACE4188191
+Node: BREAK-ON-ERROR4189765
+Node: CLOSE-TRACE-FILE4191796
+Node: OPEN-TRACE-FILE4192269
+Node: SET-TRACE-EVISC-TUPLE4192811
+Node: TRACE!4195223
+Node: TRACE$4202168
+Node: UNTRACE$4224247
+Node: WET4224942
+Node: Index4232250
 
 End Tag Table
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-1 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-1
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-1	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-1	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -30,7 +30,7 @@
 
 File: acl2-doc-emacs.info,  Node: Top,  Up: (DIR)
 
-This manual documents ACL2 Version 6.2.
+This manual documents ACL2 Version 6.3.
 
 * Menu:
 
@@ -97,7 +97,7 @@
 
 ABOUT-ACL2    about ACL2
 
-This is ACL2 Version 6.2, copyright (C) 2013, Regents of the University
+This is ACL2 Version 6.3, copyright (C) 2013, Regents of the University
 of Texas, authored by Matt Kaufmann and J Strother Moore.
 
 For past versions, see
@@ -3163,7 +3163,7 @@
        (cond ((atom term)
               (add-to-set-eq term ans))
              ((fquotep term) ans)
-             (t (free-vars1-lst (fargs term) ans))))
+             (t (free-vars1-lst (cdr term) ans))))
 
      (defun free-vars1-lst (lst ans)
        (cond ((atom lst) ans)
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-10 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-10
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-10	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-10	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,6 +28,857 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: ACL2-PC||APPLY-LINEAR,  Next: ACL2-PC||BASH,  Prev: ACL2-PC||AL,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||APPLY-LINEAR    (primitive)
+apply a linear rule
+
+     Examples:
+     (apply-linear foo)
+        -- apply the linear rule `foo'
+     (apply-linear (:linear foo))
+        -- same as above
+     (apply-linear 2)
+        -- apply the second linear rule, as displayed by show-linears
+     rewrite
+        -- apply the first rewrite rule, as displayed by show-rewrites
+     (apply-linear foo ((y 7)))
+        -- apply the linear rule foo with the substitution
+           that associates 7 to the ``free variable'' y
+     (apply-linear foo ((x 2) (y 3)) t)
+        -- apply the linear rule foo by substituting 2 and 3 for free
+           variables x and y, respectively, and also binding all other
+           free variables possible by using the current context
+           (hypotheses and governors)
+
+     General Form:
+     (apply-linear &optional rule-id substitution instantiate-free)
+
+Add a new top-level hypothesis by applying a linear rule to the current
+subterm.  The new hypothesis will be created according to the
+information provided by the show-linears (sls) command.
+
+A short name for this command is al.
+
+We assume familiarity with the proof-checker's rewrite (r) command.  In
+brief, the apply-linear command is an analogue of the rewrite command,
+but for linear rules in place of rewrite rules.  There is a significant
+difference: for the apply-linear command, instead of rewriting the
+current subterm as is done by the rewrite command, the conclusion of
+the applicable linear rule, suitably instantiated, is added as a new
+(and last) top-level hypothesis of the goal.  There is another
+significant difference: the automatic application of linear rules in
+the theorem prover is somewhat more complex than the automatic
+application of rewrite rules, so the apply-linear command may not
+correspond as closely to the prover's automatic use of a linear rule as
+the rewrite command corresponds to the prover's automatic use of a
+rewrite rule.
+
+Below, we refer freely to the documentation for the proof-checker's
+rewrite command.
+
+The rule-id is treated just as it is by the rewrite command.  If
+rule-id is a positive integer n, then the nth rule as displayed by
+show-linears is the one that is applied.  If rule-id is nil or is not
+supplied, then it is treated as the number 1.  Otherwise, rule-id
+should be either a symbol or else a :linear rune.  If a symbol is
+supplied, then any linear rule of that name may be used.
+
+Consider the following example.  Suppose that the current subterm is (<
+(g (h y)) y) and that foo is the name of the following linear rule.
+
+     (implies (true-listp x)
+              (< (g x) 15))
+
+Then the instruction (apply-linear foo) applies foo by adding a new
+hypothesis (< (g (h y)) 15).  In addition, a new goal with conclusion
+(true-listp y) is created unless the current context (top-level
+hypotheses and governors) implies (true-listp y) using only "trivial
+reasoning", just as for the rewrite command.
+
+If the rule-id argument is a number or is not supplied, then the system
+will store an instruction of the form (apply-linear name ...), where
+name is the name of a linear rule; this is in order to make it easier
+to replay instructions when there have been changes to the history.
+Except: instead of the name (whether the name is supplied or
+calculated), the system stores the rune if there is any chance of
+ambiguity.  (Formally, "ambiguity" here means that the rune being
+applied is of the form (:rewrite name . index), where index is not nil.)
+
+Speaking in general, then, an apply-linear instruction works as follows.
+
+First, a linear rule is selected according to the arguments of the
+instruction.  The selection is made as explained under "General Form"
+above.
+
+Next, a trigger term of the rule (see *note LINEAR::) is matched with
+the current subterm, i.e., a substitution unify-subst is found such
+that if one instantiates that trigger term of the rule with
+unify-subst, then one obtains the current subterm.  If this match
+fails, then the instruction fails.
+
+Next, an attempt is made to relieve (discharge) the hypotheses, possibly
+handling free variables (see *note FREE-VARIABLES::), exactly as is
+done with hypotheses when applying the proof-checker command, rewrite
+(r).
+
+Finally, the instruction is applied exactly as the rewrite instruction
+is applied, except instead of replacing the current subterm, the rule's
+instantiated conclusion is added to the end of the list of top-level
+hypotheses of the goal.
+
+Note that as for the rewrite command, the substitution argument should
+be a list whose elements have the form (variable term), where term may
+contain abbreviations.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||BASH,  Next: ACL2-PC||BDD,  Prev: ACL2-PC||APPLY-LINEAR,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||BASH    (atomic macro)
+call the ACL2 theorem prover's simplifier
+
+     Examples:
+     bash -- attempt to prove the current goal by simplification alone
+     (bash ("Subgoal 2" :by foo) ("Subgoal 1" :use bar))
+          -- attempt to prove the current goal by simplification alone,
+             with the indicated hints
+
+     General Form:
+     (bash &rest hints)
+
+Call the theorem prover's simplifier, creating a subgoal for each
+resulting goal.
+
+Notice that unlike prove, the arguments to bash are spread out, and are
+all hints.
+
+Bash is similar to reduce in that neither of these allows induction.
+But bash only allows simplification, while reduce allows processes
+eliminate-destructors, fertilize, generalize, and eliminate-irrelevance.
+
+*Remark:*  All forcing rounds will be skipped (unless there are more
+than 15 subgoals generated in the first forcing round, an injustice
+that should be rectified, but might remain unless there is pressure to
+fix it).
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||BDD,  Next: ACL2-PC||BK,  Prev: ACL2-PC||BASH,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||BDD    (atomic macro)
+prove the current goal using bdds
+
+     Examples:
+     bdd
+     (bdd :vars nil :bdd-constructors (cons) :prove t :literal :all)
+
+The general form is as shown in the latter example above, but with any
+keyword-value pairs omitted and with values as described for the :bdd
+hint; see *note HINTS::.
+
+This command simply calls the theorem prover with the indicated bdd
+hint for the top-level goal.  Note that if :prove is t (the default),
+then the proof will succeed entirely using bdds or else it will fail
+immediately.  See *note BDD::.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||BK,  Next: ACL2-PC||BOOKMARK,  Prev: ACL2-PC||BDD,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||BK    (atomic macro)
+move backward one argument in the enclosing term
+
+     Example and General Form:
+     bk
+
+For example, if the conclusion is (= x (* (- y) z)) and the current
+subterm is (* (- y) z), then after executing bk, the current subterm
+will be x.
+
+Move to the previous argument of the enclosing term.
+
+This is the same as up followed by (dive n-1), where n is the position
+of the current subterm in its parent term in the conclusion.  Thus in
+particular, the nx command fails if one is already at the top of the
+conclusion.
+
+See also up, dive, top, and bk.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||BOOKMARK,  Next: ACL2-PC||CASESPLIT,  Prev: ACL2-PC||BK,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||BOOKMARK    (macro)
+insert matching "bookends" comments
+
+     Example:
+     (bookmark final-goal)
+
+     General Form:
+     (bookmark name &rest instruction-list)
+
+Run the instructions in instruction-list (as though this were a call of
+do-all; see the documentation for do-all), but first insert a begin
+bookend with the given name and then, when the instructions have been
+completed, insert an end bookend with that same name.  See the
+documentation of comm for an explanation of bookends and how they can
+affect the display of instructions.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||CASESPLIT,  Next: ACL2-PC||CG,  Prev: ACL2-PC||BOOKMARK,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||CASESPLIT    (primitive)
+split into two cases
+
+     Example:
+     (casesplit (< x y)) -- assuming that we are at the top of the
+                            conclusion, add (< x y) as a new top-level
+                            hypothesis in the current goal, and create a
+                            subgoal identical to the current goal except
+                            that it has (not (< x y)) as a new top-level
+                            hypothesis
+
+     General Form:
+     (casesplit expr &optional use-hyps-flag do-not-flatten-flag)
+
+When the current subterm is the entire conclusion, this instruction
+adds expr as a new top-level hypothesis, and create a subgoal identical
+to the existing current goal except that it has the negation of expr as
+a new top-level hypothesis.  See also claim.  The optional arguments
+control the use of governors and the "flattening" of new hypotheses, as
+we now explain.
+
+The argument use-hyps-flag is only of interest when there are
+governors.  (To read about governors, see the documentation for the
+command hyps).  In that case, if use-hyps-flag is not supplied or is
+nil, then the description above is correct; but otherwise, it is not
+expr but rather it is (implies govs expr) that is added as a new
+top-level hypothesis (and whose negation is added as a top-level
+hypothesis for the new goal), where govs is the conjunction of the
+governors.
+
+If do-not-flatten-flag is supplied and not nil, then that is all there
+is to this command.  Otherwise (thus this is the default), when the
+claimed term (first argument) is a conjunction (and) of terms and the
+claim instruction succeeds, then each (nested) conjunct of the claimed
+term is added as a separate new top-level hypothesis.  Consider the
+following example, assuming there are no governors.
+
+     (casesplit (and (and (< x y) (integerp a)) (equal r s)) t)
+
+Three new top-level hypotheses are added to the current goal, namely (<
+x y), (integerp a), and (equal r s).  In that case, only one hypothesis
+is added to create the new goal, namely the negation of (and (< x y)
+(integerp a) (equal r s)).  If the negation of this term had been
+claimed, then it would be the other way around:  the current goal would
+get a single new hypothesis while the new goal would be created by
+adding three hypotheses.
+
+*Remark:*  It is allowed to use abbreviations in the hints.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||CG,  Next: ACL2-PC||CHANGE-GOAL,  Prev: ACL2-PC||CASESPLIT,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||CG    (macro)
+change to another goal.
+
+     Examples:
+     (cg (main . 1)) -- change to the goal (main . 1)
+     cg              -- change to the next-to-top goal
+
+     General Form:
+     (CG &OPTIONAL goal-name)
+
+Same as (change-goal goal-name t), i.e. change to the indicated and
+move the current goal to the end of the goal stack.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||CHANGE-GOAL,  Next: ACL2-PC||CL-PROC,  Prev: ACL2-PC||CG,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||CHANGE-GOAL    (primitive)
+change to another goal.
+
+     Examples:
+     (change-goal (main . 1)) -- change to the goal (main . 1)
+     change-goal              -- change to the next-to-top goal
+
+     General Form:
+     (change-goal &optional goal-name end-flg)
+
+Change to the goal with the name goal-name, i.e. make it the current
+goal.  However, if goal-name is nil or is not supplied, then it
+defaults to the next-to-top goal, i.e., the second goal in the stack of
+goals.  If end-flg is supplied and not nil, then move the current goal
+to the end of the goal stack; else merely swap it with the next-to-top
+goal.  Also see documentation for cg.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||CL-PROC,  Next: ACL2-PC||CLAIM,  Prev: ACL2-PC||CHANGE-GOAL,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||CL-PROC    (macro)
+same as clause-processor
+
+See the documentation for proof-checker command clause-processor, which
+is identical to cl-proc.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||CLAIM,  Next: ACL2-PC||CLAUSE-PROCESSOR,  Prev: ACL2-PC||CL-PROC,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||CLAIM    (atomic macro)
+add a new hypothesis
+
+     Examples:
+     (claim (< x y))   -- attempt to prove (< x y) from the current
+                          top-level hypotheses and if successful, then
+                          add (< x y) as a new top-level hypothesis in
+                          the current goal
+     (claim (< x y)
+            :otf-flg t
+            :hints (("Goal" :induct t)))
+                       -- as above, but call the prover using the
+                          indicated values for the otf-flg and hints
+     (claim (< x y) 0) -- as above, except instead of attempting to
+                          prove (< x y), create a new subgoal with the
+                          same top-level hypotheses as the current goal
+                          that has (< x y) as its conclusion
+     (claim (< x y) :hints :none)
+                       -- same as immediately above
+
+     General Form:
+     (claim expr &rest rest-args)
+
+This command creates a new subgoal with the same top-level hypotheses
+as the current goal but with a conclusion of expr.  If rest-args is a
+non-empty list headed by a non-keyword, then there will be no proof
+attempted for the new subgoal.  With that possible exception, rest-args
+should consist of keyword arguments.  The keyword argument
+:do-not-flatten controls the "flattening" of new hypotheses, just as
+with the casesplit command (as described in its documentation).  The
+remaining rest-args are used with a call the prove command on the new
+subgoal, except that if :hints is a non-nil atom, then the prover is
+not called -- rather, this is the same as the situation described
+above, where rest-args is a non-empty list headed by a non-keyword.
+
+*Remarks:*  (1) Unlike the casesplit command, the claim command is
+completely insensitive to governors. (2) It is allowed to use
+abbreviations in the hints.  (3) The keyword :none has the special role
+as a value of :hints that is shown clearly in an example above.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||CLAUSE-PROCESSOR,  Next: ACL2-PC||COMM,  Prev: ACL2-PC||CLAIM,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||CLAUSE-PROCESSOR    (atomic macro)
+use a clause-processor
+
+     Example:
+     (cl-proc :function
+              note-fact-clause-processor
+             :hint
+             '(equal a a))
+     -- Invoke the indicated clause processor function with the indicated hint
+     argument (see the beginning of community book
+     books/clause-processors/basic-examples.lisp.
+
+     General Form:
+     (cl-proc &rest cl-proc-args)
+
+Invoke a clause-processor as indicated by cl-proc-args, which is a list
+of arguments that can serve as the value of a :clause-processor hint;
+see *note HINTS::.
+
+This command calls the prove command, and hence should only be used at
+the top of the conclusion.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||COMM,  Next: ACL2-PC||COMMANDS,  Prev: ACL2-PC||CLAUSE-PROCESSOR,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||COMM    (macro)
+display instructions from the current interactive session
+
+     Examples:
+     comm
+     (comm 10)
+
+     General Form:
+     (comm &optional n)
+
+Prints out instructions in reverse order.  This is actually the same as
+(commands n t) -- or, (commands nil t) if n is not supplied.  As
+explained in the documentation for commands, the final argument of t
+causes suppression of instructions occurring between so-called
+"matching bookends," which we now explain.
+
+A "begin bookend" is an instruction of the form
+
+     (COMMENT :BEGIN x . y).
+
+Similarly, an "end bookend" is an instruction of the form
+
+     (COMMENT :END x' . y').
+
+The "name" of the first bookend is x and the "name" of the second
+bookend is x'.  When such a pair of instructions occurs in the current
+state-stack, we call them "matching bookends" provided that they have
+the same name (i.e. x equals x') and if no other begin or end bookend
+with name x occurs between them.  The idea now is that comm hides
+matching bookends together with the instructions they enclose.  Here is
+a more precise explanation of this "hiding"; probably there is no value
+in reading on!
+
+A comm instruction hides bookends in the following manner.  (So does a
+comment instruction when its second optional argument is supplied and
+non-nil.)  First, if the first argument n is supplied and not nil, then
+we consider only the last n instructions from the state-stack;
+otherwise, we consider them all.  Now the resulting list of
+instructions is replaced by the result of applying the following
+process to each pair of matching bookends:  the pair is removed,
+together with everything in between the begin and end bookend of the
+pair, and all this is replaced by the "instruction"
+
+     ("***HIDING***" :COMMENT :BEGIN name ...)
+
+where (comment begin name ...) is the begin bookend of the pair.
+Finally, after applying this process to each pair of matching bookends,
+each begin bookend of the form (comment begin name ...)  that remains
+is replaced by
+
+     ("***UNFINISHED***" :COMMENT :BEGIN name ...) .
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||COMMANDS,  Next: ACL2-PC||COMMENT,  Prev: ACL2-PC||COMM,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||COMMANDS    (macro)
+display instructions from the current interactive session
+
+     Examples:
+     commands
+     (commands 10 t)
+
+     General Forms:
+
+     commands or (commands nil)
+     Print out all the instructions (in the current state-stack) in
+     reverse order, i.e. from the most recent instruction to the starting
+     instruction.
+
+     (commands n) [n a positive integer]
+     Print out the most recent n instructions (in the current
+     state-stack), in reverse order.
+
+     (commands x abbreviate-flag)
+     Same as above, but if abbreviate-flag is non-NIL, then do not
+     display commands between ``matching bookends''.  See documentation
+     for comm for an explanation of matching bookends.
+
+*Remark*:  If there are more than n instructions in the state-stack,
+then (commands n) is the same as commands (and also, (commands n abb)
+is the same as (commands nil abb)).
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||COMMENT,  Next: ACL2-PC||CONTRADICT,  Prev: ACL2-PC||COMMANDS,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||COMMENT    (primitive)
+insert a comment
+
+     Example:
+     (comment now begin difficult final goal)
+
+     General Form:
+     (comment &rest x)
+
+This instruction makes no change in the state except to insert the
+comment instruction.
+
+Some comments can be used to improve the display of commands; see
+documentation for comm.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||CONTRADICT,  Next: ACL2-PC||CONTRAPOSE,  Prev: ACL2-PC||COMMENT,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||CONTRADICT    (macro)
+same as contrapose
+
+see documentation for contrapose
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||CONTRAPOSE,  Next: ACL2-PC||DEMOTE,  Prev: ACL2-PC||CONTRADICT,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||CONTRAPOSE    (primitive)
+switch a hypothesis with the conclusion, negating both
+
+     Example:
+     (contrapose 3)
+
+     General Form:
+     (contrapose &optional n)
+
+The (optional) argument n should be a positive integer that does not
+exceed the number of hypotheses.  Negate the current conclusion and
+make it the nth hypothesis, while negating the current nth hypothesis
+and making it the current conclusion.  If no argument is supplied then
+the effect is the same as for (contrapose 1).
+
+*Remark:* By "negate" we mean an operation that replaces nil by t, x by
+nil for any other explicit value x, (not x) by x, and any other x by
+(not x).
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||DEMOTE,  Next: ACL2-PC||DIVE,  Prev: ACL2-PC||CONTRAPOSE,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||DEMOTE    (primitive)
+move top-level hypotheses to the conclusion
+
+     Examples:
+     demote        -- demote all top-level hypotheses
+     (demote 3 5)  -- demote hypotheses 3 and 5
+
+For example, if the top-level hypotheses are x and y and the conclusion
+is z, then after execution of demote, the conclusion will be (implies
+(and x y) z) and there will be no (top-level) hypotheses.
+
+     General Form:
+     (demote &rest hyps-indices)
+
+Eliminate the indicated (top-level) hypotheses, but replace the
+conclusion conc with (implies hyps conc) where hyps is the conjunction
+of the hypotheses that were eliminated.  If no arguments are supplied,
+then all hypotheses are demoted, i.e. demote is the same as (demote 1 2
+... n) where n is the number of top-level hypotheses.
+
+*Remark*:  You must be at the top of the conclusion in order to use
+this command.  Otherwise, first invoke top.  Also, demote fails if
+there are no top-level hypotheses or if indices are supplied that are
+out of range.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||DIVE,  Next: ACL2-PC||DO-ALL,  Prev: ACL2-PC||DEMOTE,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||DIVE    (primitive)
+move to the indicated subterm
+
+     Examples:
+     (DIVE 1)    -- assign the new current subterm to be the first
+                    argument of the existing current subterm
+     (DIVE 1 2)  -- assign the new current subterm to be the result of
+                    first taking the 1st argument of the existing
+                    current subterm, and then the 2nd argument of that
+
+For example, if the current subterm is
+
+     (* (+ a b) c),
+
+then after (dive 1) it is
+
+     (+ a b).
+
+If after that, then (dive 2) is invoked, the new current subterm will be
+
+     b.
+
+Instead of (dive 1) followed by (dive 2), the same current subterm
+could be obtained by instead submitting the single instruction (dive 1
+2).
+
+     General Form:
+     (dive &rest naturals-list)
+
+If naturals-list is a non-empty list (n_1 ... n_k) of natural numbers,
+let the new current subterm be the result of selecting the n_1-st
+argument of the current subterm, and then the n_2-th subterm of that,
+..., finally the n_k-th subterm.
+
+*Remark:*  Dive is related to the command pp, in that the diving is
+done according to raw (translated, internal form) syntax.  Use the
+command dv if you want to dive according to the syntax displayed by the
+command p.  Note that (dv n) can be abbreviated by simply n.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||DO-ALL,  Next: ACL2-PC||DO-ALL-NO-PROMPT,  Prev: ACL2-PC||DIVE,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||DO-ALL    (macro)
+run the given instructions
+
+     Example:
+     (do-all induct p prove)
+
+     General Form:
+     (do-all &rest instruction-list)
+
+Run the indicated instructions until there is a hard "failure".  The
+instruction "succeeds" if and only if each instruction in
+instruction-list does.  (See the documentation for sequence for an
+explanation of "success" and "failure.")  As each instruction is
+executed, the system will print the usual prompt followed by that
+instruction, unless the global state variable
+pc-print-prompt-and-instr-flg is nil.
+
+*Remark:*  If do-all "fails", then the failure is hard if and only if
+the last instruction it runs has a hard "failure".
+
+Obscure point:  For the record, (do-all ins_1 ins_2 ... ins_k) is the
+same as (sequence (ins_1 ins_2 ... ins_k)).
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||DO-ALL-NO-PROMPT,  Next: ACL2-PC||DO-STRICT,  Prev: ACL2-PC||DO-ALL,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||DO-ALL-NO-PROMPT    (macro)
+run the given instructions, halting once there is a "failure"
+
+     Example:
+     (do-all-no-prompt induct p prove)
+
+     General Form:
+     (do-all-no-prompt &rest instruction-list)
+
+Do-all-no-prompt is the same as do-all, except that the prompt and
+instruction are not printed each time, regardless of the value of
+pc-print-prompt-and-instr-flg.  Also, restoring is disabled.  See the
+documentation for do-all.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||DO-STRICT,  Next: ACL2-PC||DROP,  Prev: ACL2-PC||DO-ALL-NO-PROMPT,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||DO-STRICT    (macro)
+run the given instructions, halting once there is a "failure"
+
+     Example:
+     (do-strict induct p prove)
+
+     General Form:
+     (do-strict &rest instruction-list)
+
+Run the indicated instructions until there is a (hard or soft)
+"failure".  In fact do-strict is identical in effect to do-all, except
+that do-all only halts once there is a hard "failure".  See the
+documentation for do-all.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||DROP,  Next: ACL2-PC||DV,  Prev: ACL2-PC||DO-STRICT,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||DROP    (primitive)
+drop top-level hypotheses
+
+     Examples:
+     (drop 2 3) -- drop the second and third hypotheses
+     drop       -- drop all top-level hypotheses
+
+     General Forms:
+     (drop n1 n2 ...) -- Drop the hypotheses with the indicated indices.
+
+     drop             -- Drop all the top-level hypotheses.
+
+*Remark:*  If there are no top-level hypotheses, then the instruction
+drop will fail.  If any of the indices is out of range, i.e. is not an
+integer between one and the number of top-level hypotheses (inclusive),
+then (drop n1 n2 ...) will fail.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||DV,  Next: ACL2-PC||ELIM,  Prev: ACL2-PC||DROP,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||DV    (atomic macro)
+move to the indicated subterm
+
+     Examples:
+     (dv 1)    -- assign the new current subterm to be the first argument
+                  of the existing current subterm
+     (dv 1 2)  -- assign the new current subterm to be the result of
+                  first taking the 1st argument of the existing
+                  current subterm, and then the 2nd argument of that
+
+For example, if the current subterm is
+
+     (* (+ a b) c),
+
+then after (dv 1) it is
+
+     (+ a b).
+
+If after that, then (dv 2) is invoked, the new current subterm will be
+
+     b.
+
+Instead of (dv 1) followed by (dv 2), the same current subterm could be
+obtained by instead submitting the single instruction (dv 1 2).
+
+     General Form:
+     (dv &rest naturals-list)
+
+If naturals-list is a non-empty list (n_1 ... n_k) of natural numbers,
+let the new current subterm be the result of selecting the n_1-st
+argument of the current subterm, and then the n_2-th subterm of that,
+..., finally the n_k-th subterm.
+
+*Remark:*  (dv n) may be abbreviated by simply n, so we could have
+typed 1 instead of (dv 1) in the first example above.
+
+*Remark:*  See also dive, which is related to the command pp, in that
+the diving is done according to raw (translated, internal form) syntax.
+Use the command dv if you want to dive according to the syntax
+displayed by the command p.  Thus, the command "up" is the inverse of
+dive, not of dv.  The following example illustrates this point.
+
+     ACL2 !>(verify (equal (* a b c) x))
+     ->: p ; print user-level term
+     (EQUAL (* A B C) X)
+     ->: pp ; print internal-form (translated) term
+     (EQUAL (BINARY-* A (BINARY-* B C)) X)
+     ->: exit
+     Exiting....
+      NIL
+     ACL2 !>(verify (equal (* a b c) x))
+     ->: p
+     (EQUAL (* A B C) X)
+     ->: 1 ; same as (dv 1)
+     ->: p ; print user-level term
+     (* A B C)
+     ->: pp ; print internal-form (translated) term
+     (BINARY-* A (BINARY-* B C))
+     ->: 3 ; dive to third argument of (* A B C)
+     ->: p
+     C
+     ->: up ; go up one level in (BINARY-* A (BINARY-* B C))
+     ->: p
+     (* B C)
+     ->: pp
+     (BINARY-* B C)
+     ->:
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||ELIM,  Next: ACL2-PC||EQUIV,  Prev: ACL2-PC||DV,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||ELIM    (atomic macro)
+call the ACL2 theorem prover's elimination process
+
+     Example and General Form:
+     elim
+
+Upon running the elim command, the system will create a subgoal will be
+created for each goal that would have been pushed for proof by
+induction in an ordinary proof, where *only* elimination is used; not
+even simplification is used!
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||EQUIV,  Next: ACL2-PC||EX,  Prev: ACL2-PC||ELIM,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||EQUIV    (primitive)
+attempt an equality (or congruence-based) substitution
+
+     Examples:
+     (equiv (* x y) 3) -- replace (* x y) by 3 everywhere inside the
+                          current subterm, if their equality is among the
+                          top-level hypotheses or the governors
+     (equiv x t iff)   -- replace x by t everywhere inside the current
+                          subterm, where only propositional equivalence
+                          needs to be maintained at each occurrence of x
+
+     General form:
+     (equiv old new &optional relation)
+
+Substitute new for old everywhere inside the current subterm, provided
+that either (relation old new) or (relation new old) is among the
+top-level hypotheses or the governors (possibly by way of backchaining
+and/or refinement; see below).  If relation is nil or is not supplied,
+then it defaults to equal.  See also the command =, which is much more
+flexible.  Note that this command fails if no substitution is actually
+made.
+
+*Remark:*  No substitution takes place inside explicit values.  So for
+example, the instruction (equiv 3 x) will cause 3 to be replaced by x
+if the current subterm is, say, (* 3 y), but not if the current subterm
+is (* 4 y) even though 4 = (1+ 3).
+
+The following remarks are quite technical and mostly describe a certain
+weak form of "backchaining" that has been implemented for equiv in
+order to support the = command.  In fact neither the term (relation old
+new) nor the term (relation new old) needs to be *explicitly* among the
+current "assumptions", i.e., the top-level hypothesis or the governors.
+Rather, there need only be such an assumption that "tells us" (r old
+new) or (r new old), for *some* equivalence relation r that *refines*
+relation.  Here, "tells us" means that either one of the indicated
+terms is among those assumptions, or else there is an assumption that
+is an implication whose conclusion is one of the indicated terms and
+whose hypotheses (gathered up by appropriately flattening the first
+argument of the implies term) are all among the current assumptions.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||EX,  Next: ACL2-PC||EXIT,  Prev: ACL2-PC||EQUIV,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||EX    (macro)
+exit after possibly saving the state
+
+     Example and General Form:
+     ex
+
+Same as exit, except that first the instruction save is executed.
+
+If save queries the user and is answered negatively, then the exit is
+aborted.
+
+
+File: acl2-doc-emacs.info,  Node: ACL2-PC||EXIT,  Next: ACL2-PC||EXPAND,  Prev: ACL2-PC||EX,  Up: PROOF-CHECKER-COMMANDS
+
+ACL2-PC||EXIT    (meta)
+exit the interactive proof-checker
+
+     Examples:
+     exit                        -- exit the interactive proof-checker
+     (exit t)                    -- exit after printing a bogus defthm event
+     (exit append-associativity) -- exit and create a defthm
+                                    event named append-associativity
+
+     General Forms:
+
+     exit --  Exit without storing an event.
+
+     (exit t) -- Exit after printing a bogus defthm event, showing :INSTRUCTIONS.
+
+     (exit event-name &optional rule-classes do-it-flg) --
+     Exit, and perhaps store an event
+
+The command exit returns you to the ACL2 loop.  At a later time,
+(verify) may be executed to get back into the same proof-checker state,
+as long as there hasn't been an intervening use of the proof-checker
+(otherwise see save).
+
+When given one or more arguments as shown above, exit still returns you
+to the ACL2 loop, but first, if the interactive proof is complete, then
+it attempts create a defthm event with the specified event-name and
+rule-classes (which defaults to (:rewrite) if not supplied).  The event
+will be printed to the terminal, and then normally the user will be
+queried whether an event should really be created.  However, if the
+final optional argument do-it-flg is supplied and not nil, then an
+event will be made without a query.
+
+For example, the form
+
+     (exit top-pop-elim (:elim :rewrite) t)
+
+causes a defthm event named top-pop-elim to be created with
+rule-classes (:elim :rewrite), without a query to the user (because of
+the argument t).
+
+*Remark:* it is permitted for event-name to be nil.  In that case, the
+name of the event will be the name supplied during the original call of
+verify.  (See the documentation for verify and commands.)  Also in that
+case, if rule-classes is not supplied then it defaults to the
+rule-classes supplied in the original call of verify.
+
+Comments on "success" and "failure".  An exit instruction will always
+"fail", so for example, if it appears as an argument of a do-strict
+instruction then none of the later (instruction) arguments will be
+executed.  Moreover, the "failure" will be "hard" if an event is
+successfully created or if the instruction is simply exit; otherwise it
+will be "soft".  See the documentation for sequence for an explanation
+of hard and soft "failures".  An obscure but potentially important fact
+is that if the "failure" is hard, then the error signal is a special
+signal that the top-level interactive loop can interpret as a request
+to exit.  Thus for example, a sequencing command that turns an error
+triple (mv erp val state) into (mv t val state) would never cause an
+exit from the interactive loop.
+
+If the proof is not complete, then (exit event-name ...) will not cause
+an exit from the interactive loop.  However, in that case it will print
+out the original user-supplied goal (the one that was supplied with the
+call to verify) and the current list of instructions.
+
+
 File: acl2-doc-emacs.info,  Node: ACL2-PC||EXPAND,  Next: ACL2-PC||FAIL,  Prev: ACL2-PC||EXIT,  Up: PROOF-CHECKER-COMMANDS
 
 ACL2-PC||EXPAND    (primitive)
@@ -1282,7 +2133,10 @@
 (sr) and rewrite commands.  But normally, if even one hypothesis
 remains unrelieved, then no automatic extension of the substitution is
 made.  Except, if instantiate-free is not nil, then that extension to
-the substitution is kept.
+the substitution is kept.  (Technical note: in the case of an
+unrelieved hypothesis and a non-nil value of instantiate-free, if a
+bind-free hypothesis produces a list of binding alists, then the last
+of those alists is the one that is used to extend the substitution.)
 
 Finally, the instruction is applied as follows.  The current subterm is
 replaced by applying the final substitution described above to the
@@ -4777,8 +5631,8 @@
 fact that ACL2 is an applicative language it is possible to measure
 time with ACL2 programs.  The state <> contains a clock.  The times are
 printed in decimal notation but are actually counted in integral units.
-Note that each time is a runtime, also known as a cpu time, as opposed
-to being a real time, also known as a wall clock time.
+Note that by default, each time is a runtime, also known as a cpu time,
+as opposed to being a real time, also known as a wall clock time.
 
 The final APP is the value of the defun command and was printed by the
 read-eval-print loop.  The fact that it is indented one space is a
@@ -5605,7 +6459,7 @@
 
 Note that if you download community books as tarfiles, then you should
 be sure to download the `nonstd' books, from
-`http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz'.  Then
+`http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz'.  Then
 certify them from your acl2-sources directory, shown here as <DIR>:
 
      make regression-nonstd ACL2=<DIR>/saved_acl2r
@@ -5833,6 +6687,8 @@
 
 * NOTE-6-2:: ACL2 Version  6.2 (June, 2013) Notes
 
+* NOTE-6-3:: ACL2 Version  6.3 (October, 2013) Notes
+
 * NOTE1:: Acl2 Version 1.1 Notes
 
 * NOTE2:: Acl2 Version 1.2 Notes
@@ -6455,637 +7311,3 @@
 has been corrected; also, the guard is slightly stronger than the
 documentation had claimed (and that has been corrected).
 
-
-File: acl2-doc-emacs.info,  Node: NOTE-2-6-NEW-FUNCTIONALITY,  Next: NOTE-2-6-OTHER,  Prev: NOTE-2-6-GUARDS,  Up: NOTE-2-6
-
-NOTE-2-6-NEW-FUNCTIONALITY    ACL2 Version  2.6 Notes on New Functionality
-
-A fundamental change is the provision of the "nu-rewriter" for
-simplifying expressions composed of NTH, UPDATE-NTH, and
-UPDATE-NTH-ARRAY applications and LET expressions and other calls of
-non-recursive functions or LAMBDA expressions involving those symbols.
-The nu-rewriter applies the obvious rewrite rule for (NTH i (UPDATE-NTH
-j v s)) and the analogous rule for UPDATE-NTH-ARRAY.  See *note
-NU-REWRITER::  The nu-rewriter can be enabled with set-nu-rewriter-mode.
-
-A new flag has been added to the xargs of defun permitting the
-declaration that the function is non-executable.  The usage is (declare
-(xargs :non-executable t)) and the effect is that the function has no
-executable counterpart.  On the positive side:  the function is
-permitted to use single-threaded object names and functions
-arbitrarily, as in theorems rather than as in executable definitions.
-Such functions are not permitted to declare any names :stobjs but
-accessors, etc., may be used, just as in theorems.
-
-A new flag has been added to permit the system to abbreviate output by
-introducing LET* notation identifying common subterms.  The formula
-being proved is not affected; this flag changes its displayed form
-only.  See set-let*-abstractionp.
-
-A "raw mode" has been added, primarily for faster loading of
-applications.  see *note SET-RAW-MODE::.
-
-Functions alphorder and lexorder have been put in :logic mode.
-Lexorder is now a total order ordering of the ACL2 universe, and
-theorems are included to that effect.  Thanks to Pete Manolios for
-suggesting the idea and providing events to use, and to Rob Sumners for
-assistance with some modifications.  See also the new book
-books/misc/total-order for an irreflexive total order.
-
-The ACL2 user can now make system calls to the host operating system.
-See *note SYS-CALL:: and see *note SYS-CALL-STATUS::.  Thanks to Rob
-Sumners for working out this idea with Pete Manolios and Robert Krug,
-who we also thank, and for working out the implementation with us.
-
-It is no longer required to use absolute pathnames in include-book
-forms that have been executed before a certify-book.  Any relative
-pathname strings in such contexts will be expanded into absolute
-pathnames before they are saved in the portcullis of the certificate of
-the book being certified.
-
-ACL2 can now be built on top of Allegro Common Lisp 6.0, and also on
-Windows platforms on top of Allegro Common Lisp and GCL.  Thanks to Pete
-Manolios and Vinay K. Siddhavanahalli for their help with Windows.
-
-Rob Sumners has designed and provided an initial implementation for two
-improvements to defstobj (also see *note STOBJ::).  First, array fields
-can now be resized.  Resize and length functions are provided for array
-fields, which can be used to resize stobj array fields dynamically.
-The recognizers for array fields have been simplified to accommodate
-this change, so that they only check that each element of the array
-field has the specified type.  Second, performance has been improved
-for stobjs with a large number of fields, by changing their Common Lisp
-implementation to store the fields in a simple vector instead of a list.
-
-Now stobjs may be bound locally; see *note WITH-LOCAL-STOBJ::.  Thanks
-to Rob Sumners, who encouraged us to implement this capability, was an
-early user of it, and participated usefully in discussions on its
-design.
-
-New functions fms!, fmt!, and fmt1! are the same as their respective
-functions without the "!," except that the "!" functions are guaranteed
-to print forms that can be read back in (at a slight readability cost).
-
-We added extended-metafunctions, metafunctions which allow state and
-context sensitive rewriting to some extent.  We thank Robert Krug for
-pushing for and on this idea.
-
-The documentation has been improved.  In particular, a new
-documentation topic provides a gentle introduction to ACL2 arrays --
-see *note ARRAYS-EXAMPLE:: -- and additional documentation has been
-provided for getting started with proof trees in emacs -- see *note
-PROOF-TREE::.
-
-New Makefile targets fasl and o have been added to the books/ directory
-of the distribution.  For example, you might first certify books using
-an ACL2 built on top of GCL (which creates compiled files with suffix
-o).  Then, when standing in the books/ directory, you might execute the
-command
-
-     make fasl ACL2=my-allegro-acl2
-
-which will create compiled (.fasl) files for Allegro Common Lisp,
-assuming that my-allegro-acl2 starts up an ACL2 built on that Common
-Lisp.
-
-The macro let* now allows variables to be declared ignored.  See *note
-LET*:: and see *note LET::.
-
-The user may now control backchaining.  This feature was designed and
-primarily implemented by Robert Krug (though the authors of ACL2 are
-resposible for any errors); thanks, Robert!  See *note
-BACKCHAIN-LIMIT::.
-
-It is now possible to "slow down" the rate at which case splits are
-generated by the simplifier.  See *note SET-CASE-SPLIT-LIMITATIONS::.
-
-Accesses to stobjs using nth or update-nth are now displayed using
-symbolic constants instead of numeric indices.  For example, given the
-event
-
-     (defstobj foo a b :renaming ((b c)))
-
-then the term (nth 0 foo) will be displayed (for example, during
-proofs) as (nth *a* foo) while (nth 1 foo) will be displayed as (nth
-*c* foo).  The defstobj event now correspondingly introduces a defconst
-event for each field accessor function, introducing a constant whose
-name is obtained from the accessor's name by prefixing and suffixin a
-"*," as in the example above: accessor a generates (defconst *a* 0) and
-accessor c generates (defconst *c* 1). See *note NTH-ALIASES-TABLE::
-for how to extend this feature for alternate names of stobjs.
-
-Computed hints have been improved.  It is now possible to detect within
-a computed hint whether the goal clause is stable under simplification;
-it is also possible for a computed hint to change the list of available
-hints.  See *note COMPUTED-HINTS::.
-
-It is now possible to provide "default hints" that are appended to the
-hints explicitly provided.  See *note SET-DEFAULT-HINTS::.
-
-Using computed hints (see *note COMPUTED-HINTS::) and default hints
-(see *note SET-DEFAULT-HINTS::) it is possible to implement a book that
-supports "priority phased simplification."  Using this book you can
-assign priorities to your rules and cause the theorem prover to
-simplify each goal maximally under all the rules of one priority before
-enabling rules of the next priority.  See books/misc/priorities.lisp.
-
-The macro defabbrev has been improved to allow declare forms and
-documentation strings and to do more error-checking.  Thanks to Rob
-Sumners for designing this enhancement and providing the first
-implementation.  See *note DEFABBREV::.
-
-Further changes were made to support CMU Lisp.  Wolfhard Buss helped
-with these changes.
-
-A new table was added that is used when printing proof output, so that
-nests of right-associated calls of a binary function are replaced by
-corresponding macro calls, as has been the case for binary-+ and +,
-binary-append and append, and so on.  See *note ADD-BINOP::.
-
-Operators logand, logior, logxor, and logeqv are now macros (formerly,
-they were functions) that call corresponding binary functions (e.g.,
-binary-logand) defined in source file "axioms.lisp".  Thanks to Rob
-Sumners for this enhancement.  Proof output will however continue to
-show calls of logand, logior, logxor, and logeqv.
-
-Function (allocate-fixnum-range fixnum-lo fixnum-hi) sets aside more
-"permanent" fixnums in GCL.
-
-ACL2 now runs under CLISP.  Thanks to Wolfhard Buss and Sam Steingold
-for their assistance with the port.
-
-Michael "Bogo" Bogomolny has created a search engine, accessible from
-the ACL2 home page.  For that purpose he modified the HTML translator
-to create one file per topic (a good idea in any case).  Thanks, Bogo!
-
-An emacs file of potential (but optional) use for ACL2 users may be
-found in emacs/emacs-acl2.el.  In particular, this file supports the
-use of proof trees (see *note PROOF-TREE::).
-
-Some books have been added or modified.  In particular, Robert Krug has
-contributed books/arithmetic-2/, which provides an alternative to the
-existing collection of books about arithmetic, books/arithmetic/.  For a
-discussion of the distributed books see the link to README.html in the
-installation instructions.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE-2-6-OTHER,  Next: NOTE-2-6-PROOF-CHECKER,  Prev: NOTE-2-6-NEW-FUNCTIONALITY,  Up: NOTE-2-6
-
-NOTE-2-6-OTHER    ACL2 Version  2.6 Notes on Other (Minor) Changes
-
-Warning strings are now case-insensitive.  See *note
-SET-INHIBIT-WARNINGS::.
-
-ACL2 causes a warning when an in-theory hint or event causes a 0-ary
-function's definition to be disabled but its :executable-counterpart to
-be enabled.
-
-A minor modification has been made to defstobj that can have a positive
-impact on performance in Allegro Common Lisp.  (For Lisp hackers:  the
-stobj name was formerly declared special, and that was disabling
-Allegro's tail-merging routing for compilation of some recursive
-functions using stobjs.)  The downside is that stobj names can no
-longer be evaluated in raw Lisp.  However, raw Lisp is not the right
-place to be evaluating ACL2 forms anyhow; see *note SET-RAW-MODE::.  We
-thank Rob Sumners for bringing this issue to our attention.
-
-Before Version  2.6, there has been the following problem with defstub
-and encapsulate in the case that the current package is not the ACL2
-package.  If a signature was specified using the symbol =>, then that
-symbol had have been imported into the current package from the ACL2
-package when the current package was defined.  There are no longer any
-package restrictions on the use of =>.  Thanks to John Cowles for
-bringing this problem to our attention.
-
-Bugs in defun-sk have been fixed.  Defun-sk forms introducing functions
-of no arguments were failing to be admitted, for example: (defun-sk
-always-p1 () (forall (x) (p1 x))).  Thanks to John Cowles for bringing
-this problem to our attention.  Also, defun-sk failed on an example in
-the documentation (see *note TUTORIAL4-DEFUN-SK-EXAMPLE::), as pointed
-out by Matyas Sustik; this bug has been fixed as well.
-
-The trace mechanism has been fixed to handle stobjs, and to avoid the
-printing of so-called _enabled structures_.
-
-The brr command :type-alist now produces more readable output.
-
-An include-book of an uncertified book no longer loads an associated
-compiled file.
-
-We added a few checks to make sure that the underlying lisp is
-suitable, for example checking that the reader is case-insensitive and
-reads in symbols with upper-case names where appropriate.
-
-We now warn when forcing (see *note FORCE::) or immediate force mode
-(see *note IMMEDIATE-FORCE-MODEP::) change state between enabled and
-disabled.  Also see *note ENABLE-IMMEDIATE-FORCE-MODEP:: and see *note
-DISABLE-IMMEDIATE-FORCE-MODEP:: for information about these new macros,
-which may be used to control immediate force mode.
-
-We have eliminated the use of a low-level raw Lisp constant,
-*most-recent-multiplicity*.  Our test suite saw a speed-up of
-approximately 2% as a result for an ACL2 image built on GCL (but no
-significant speed-up for an ACL2 image built on Allegro Common Lisp).
-We thank Rob Sumners for suggesting this improvement.
-
-Fixnum declarations are now realized as (signed-byte 29) instead of
-(signed-byte 27).  We check that the underlying Common Lisp recognizes
-objects of type (signed-byte 29) as fixnums, with the exception of
-CLISP, which is said to have an efficient bignum implementation.
-
-A new documentation topic functional-instantiation-example illustrates
-functional instantiation.
-
-A bug has been fixed in the monitoring of runes (see *note MONITOR::).
-Thanks to Dave Greve for sending an example that clearly showed the
-problem.
-
-A warning is now issued when it is detected that a :type-prescription
-rule may not be as strong as it appears because it is not sufficient to
-prove itself by type reasoning.
-
-An error is caused for rules of class :meta when the function symbol IF
-is among the :trigger-fns.  (IF was ignored anyhow; the point of this
-change is to avoid misleading the user.)
-
-A minor bug has been fixed in :pr, evident for example if this command
-was applied to IF.
-
-A minor hole in :set-bogus-mutual-recursion-ok did not permit the
-acceptance of mutual-recursion forms that include constant function
-definitions.  This has been fixed.  Thanks to Eric Smith for coming up
-with a simple example illustrating the problem.
-
-The temporary files "TMP.lisp" and "TMP1.lisp" written out by :comp are
-now written to the connected book directory (see *note CBD::).
-
-Previously, the Allegro compiler was not eliminating tail recursion for
-executable counterparts of functions, because of the way one of its
-flags had been set.  As a result, calls of functions whose guards had
-not been verified could run out of stack space when this was not
-necessary.  This situation has been fixed.
-
-Executable counterparts could have slow array accesses.  This has been
-fixed (specifically, constants are no longer replaced with their values
-in the definitions of executable counterparts).
-
-Various improvements have been made to the documentation.  Thanks in
-particular to Eric Smith for pointing out a numbers of places where
-fixes were in order.
-
-File "mcl-acl2-startup.lisp" has been updated, thanks to feedback from
-Philippe Georgelin.
-
-Inefficiencies in GCL fixnum computations were remedied for macros +f
-and *f.  Thanks to Rob Sumners for pointing out this issue.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE-2-6-PROOF-CHECKER,  Next: NOTE-2-6-PROOFS,  Prev: NOTE-2-6-OTHER,  Up: NOTE-2-6
-
-NOTE-2-6-PROOF-CHECKER    ACL2 Version  2.6 Notes on Proof-checker Changes
-
-The proof-checker command =, when used with no arguments, now reports
-which hypothesis is being used.
-
-The output from proof-checker command type-alist has been improved.
-
-A slight change has been made to the proof-checker for commands
-promote, casesplit, equiv, and =, so that terms of the form (if x nil
-y) are recognized as conjunctions, (and (not x) y).  Thanks to Pete
-Manolios for suggesting that we consider such a change.
-
-There is a new proof-checker command print-all-concs that prints all
-the conclusions of the unproved goals.
-
-A new proof-checker command, runes, has been added.  It reports the
-runes that have participated in the interactive proof up to the current
-point.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE-2-6-PROOFS,  Next: NOTE-2-6-RULES,  Prev: NOTE-2-6-PROOF-CHECKER,  Up: NOTE-2-6
-
-NOTE-2-6-PROOFS    ACL2 Version  2.6 Notes on Changes in Proof Engine
-
-Certain optimizations are performed when converting terms to clausal
-form.  For example, (< 0 1) is known to be t, (HARD-ERROR ctx str
-alist) is known to be nil, and (INTEGERP n) is known to imply
-(RATIONALP n).
-
-In earlier versions of ACL2, the conversion of a term to clausal form
-expanded LAMBDA applications.  That may no longer occur.  Some proofs
-may slow down (or fail) because your LAMBDA-expressions are not
-expanded away when you "expected" them to be.
-
-Robert Krug found a soundness bug in our linear arithmetic package.
-The bug was caused by the derivation of an equation from two
-inequalities without taking adequate precautions to ensure that both
-sides of the inequalities were numeric.  Robert also kindly provided a
-fix which we adopted.  Thanks Robert!
-
-We fixed a bug that could prevent the application of a metatheorem.
-
-A bug has been fixed that had caused bogus forcing rounds (see *note
-FORCING-ROUND::).  The bug could occur when the hypothesis of a rule
-was forced (see *note FORCE::) before the prover decided to start over
-and prove the original goal by induction.  Thanks to Rob Sumners for
-drawing our attention to this problem.
-
-Some low-level fixes have been made that prevent certain infinite
-loops, based on reports by users.  We thank Yunja Choi, Matt Wilding,
-and Pete Manolios for reporting such problems.
-
-An obscure potential soundness hole has been fixed by redoing the way
-evaluation takes place in the ACL2 loop and during theorem proving.  We
-expect that users will see no difference based on this change.  (Those
-interested in the details can see the long comment "Essay on Evaluation
-in ACL2" in source file interface-raw.lisp.)
-
-A small change was made in computation for a heuristic that controls
-backchaining.  This will speed up proofs dramatically in a very few
-cases but should have a very small impact in general.
-
-The simplifier has been modified to avoid eliminating hypotheses of
-goals that can be established by contextual (specifically, type-set)
-reasoning alone.  We believe that this change will generally strengthen
-ACL2's reasoning engine, although on rare occasions a lemma that
-formerly was provable may require user assistance.  Thanks to Robert
-Krug for suggesting this change and providing its implementation.
-
-Case splits are now limited, by default.  This may allow some proof
-attempts to provide output where previously the prover would appear to
-"go out to lunch."  For a more complete discussion, including
-instructions for how users can control case splitting, see *note
-SET-CASE-SPLIT-LIMITATIONS::.
-
-A bug has been fixed in the handling of :type-prescription rules by the
-bdd package.  Thanks to Rob Sumners for discovering this bug and
-supplying a helpful example.
-
-ACL2 may now use the built-in induction scheme for a function symbol
-even if that function symbol is disabled.  Formerly, if a function
-symbol was disabled then its induction scheme was only considered if an
-explicit induction hint was supplied, other than :induct t.
-
-We eliminated the rule-class linear-alias.  This rule class was seldom
-used and complicated the linear arithmetic decision procedure in ways
-that made it difficult to extend to handle some non-linear special
-cases.  The only use of the rule-class that we know of was in our own
-nqthm books, which were an attempt to provide an embedding of the Nqthm
-logic and theorem prover into ACL2.  But that facility was also
-practically never used, as far as we know.  So both linear-alias rules
-and the nqthm books have been eliminated.
-
-In earlier versions of ACL2, when the IF-form of (AND p q) was assumed
-true - as when rewriting the alpha expression in (IF (AND p q) alpha
-beta) - the assumption mechanism did not deduce that p and q are true,
-only that their conjunction, in its IF-form, is true.  This has long
-been known as a deficiency in both ACL2 and the earlier Nqthm but it
-was tedious to do better when one considered the full range of IF-forms
-one might encounter in the test of another IF.  Rather than code all
-the cases, we just waited until clausification got rid of them.  Robert
-Krug developed a pretty nice treatment of the general case and we added
-it in this version.  This also involved a surprising number of changes
-elsewhere in the system because the improved handling of assumptions
-caused the theorem prover often to "erase" hypotheses provided by :use
-hints because it could simplify them to t.  Thank you Robert!
-
-In response to a suggestion from Robert Krug, we added mfc-ap so that
-extended metafunctions can take advantage of linear arithmetic.  See
-*note EXTENDED-METAFUNCTIONS::.
-
-There is less delay in printing goals.  In previous versions, a goal
-was not printed until its subgoals were created (or the goal was
-proved).  Now, the goal is printed essentially as soon as it is created.
-
-A small technical change has been made in the function term-order, to
-give priority on the function symbol count over the weighting of
-constants.  So for example, while previously the term (f) preceded the
-constant 2, that is no longer the case.  If this change is noticed at
-all, it will probably be noticed in how so-called _permutative_ rewrite
-rules are applied; see *note LOOP-STOPPER::.  Thanks to Robert Krug for
-suggesting this improvement and providing part of the implemtation.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE-2-6-RULES,  Next: NOTE-2-6-SYSTEM,  Prev: NOTE-2-6-PROOFS,  Up: NOTE-2-6
-
-NOTE-2-6-RULES    ACL2 Version  2.6 Notes on Changes in Rules and Constants
-
-The following symbols have been added to the list constant
-*common-lisp-specials-and-constants*: REPLACE, FILL, CHARACTER, =,
-BREAK, and PRIN1.  This was done in support of ports to Allegro 6.0 and
-Windows platforms (see *note NOTE-2-6-NEW-FUNCTIONALITY::).
-
-The list of symbols in *acl2-exports* has been modified, for example to
-include show-accumulated-persistence and the legal arguments to
-set-inhibit-output-lst.
-
-Functions zp and zip are now handled slightly differently.  They are
-are now disabled, but each comes with a :rewrite rule that allows their
-expansion on non-variable terms, and also with a :compound-recognizer
-rule that avoids the need for opening up these functions when applied
-to variables.  The resulting behavior should be very similar to the
-behavior of previous versions, except that case splits will be avoided
-when these functions are applied to variables.
-
-Function standard-string-alistp replaces function string-alistp.  For
-further discussion, see *note NOTE-2-6-GUARDS::.
-
-Rules of class :rewrite whose conclusion is a term of the form (equal
-lhs rhs) have always been stored in the expected way:  lhs rewrites to
-rhs.  This way of storing :rewrite rules has been extended to allow =,
-eq, or eql in place of equal.
-
-Rewrite rule nth-update-nth, in source file axioms.lisp, has been
-strengthened.
-
-A new rewrite rule equal-constant-+ has been added to the book
-arithmetic/equalities.  This should generally be a beneficial change,
-but existing proofs involving the arithmetic books could conceivably be
-affected.
-
-Function symbol-package-name and constant *main-lisp-package-name* have
-undergone small changes.  This change should rarely be noticed by users
-and is discussed elsewhere; see *note NOTE-2-6-SYSTEM::.
-
-We mention here that proofs involving stobjs may need to be modified
-because of changes in auxiliary functions generated by defstobj.
-(These changes were made in support of a new resizing capability,
-mentioned elsewhere in these release notes; see *note
-NOTE-2-6-NEW-FUNCTIONALITY::.
-
-In the distributed book directory books/arithmetic/, the book
-rationals-with-axioms-proved.lisp has been renamed rationals.lisp.
-
-(ACL2(r) only) Rewrite rules realp-+, realp-*, realp-unary-, and
-realp-unary-/ have been added in analogy to existing rules rationalp-+,
-rationalp-*, rationalp-unary-, and rationalp-unary-/.  Thanks to Jun
-Sawada for suggesting this change.
-
-The definition of aref1 has been modified slightly.  Previously, if
-*my-a* were an array then (aref1 'some-name *my-a* :header)  would
-evaluate to the cdr of the header of *my-a* rather than to its default.
-See *note ARRAYS::.
-
-Changes have been made in the ihs books, based on suggestions from Jun
-Sawada, that support its use with ACL2(r) (see *note REAL::).  The
-primary change is to replace calls of rationalp with calls of
-real/rationalp, which should have no effect on users of standard ACL2.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE-2-6-SYSTEM,  Prev: NOTE-2-6-RULES,  Up: NOTE-2-6
-
-NOTE-2-6-SYSTEM    ACL2 Version  2.6 Notes on System-level Changes
-
-We modified the tracking of skip-proofs events and the use of state
-global ld-skip-proofsp in order to avoid some soundness issues.  For
-example, skip-proofs events buried in locally-included books are now
-tracked.  The "Essay on Skip-proofs" in source file axioms.lisp gives
-several examples of dicey behavior that is no longer supported.
-
-We fixed a problem with some of the makefiles, so that recursive
-invocations of `make' now use the version of `make' specified on the
-command line.
-
-Files were fixed to help non-Unix/Linux users with book certification.
-Thanks to John Cowles for finding some problems and suggesting fixes to
-books/certify-numbers.lisp, books/arithmetic/certify.lsp, and
-books/cowles/certify.lsp.  We thank Scott Burson for noticing and
-fixing some other such problems.  Moreover, a bdd test was being
-ignored entirely in Version  2.5; this problem has been fixed as well.
-
-A minor change in system function save-acl2-in-allegro will allow this
-function to continue to work in Allegro CL versions starting (someday)
-with 10.0.  Thanks to Art Flatau for suggesting such a fix.
-
-The books/case-studies/ directory has been removed.  These books are in
-support of the first (1998) ACL2 workshop, and are accessible via the
-ACL2 home page on the Web,
-`http://www.cs.utexas.edu/users/moore/acl2/'.  Also, the books/cli-misc
-directory has been renamed books/misc, and the books/nqthm directory
-has been removed.
-
-The notion of ACL2 version has been slightly modified to catch
-unsoundness due to implementation dependencies.  See *note VERSION::.
-Another change to eliminate such unsoundness is that built-in symbols
-now have a symbol-package-name of "COMMON-LISP"; formerly, this string
-was "LISP" for ACL2 images built on GCL.  See *note
-SYMBOL-PACKAGE-NAME::.  At a low level, the (undocumented) constant
-*main-lisp-package-name* is now "COMMON-LISP"; before, it was "LISP"
-for GCL.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE-2-6(R),  Next: NOTE-2-7,  Prev: NOTE-2-6,  Up: RELEASE-NOTES
-
-NOTE-2-6(R)    ACL2 Version  2.6(r) (November, 2001) Notes
-
-Important changes to non-standard version:  None since Version  2.5.
-
-Please see *note NOTE-2-6:: for changes to Version  2.6 of ACL2.  We
-hope to write more documentation for ACL2(r) in the future.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE-2-7,  Next: NOTE-2-7(R),  Prev: NOTE-2-6(R),  Up: RELEASE-NOTES
-
-NOTE-2-7    ACL2 Version  2.7 (November, 2002) Notes
-
-The Version_2.7 notes are divided into the subtopics below.  Here we
-give only a brief summary of a few of the changes that seem most likely
-to impact existing proofs.  Not included in this brief summary, but
-included in the subtopics, are descriptions of improvements (including
-bug fixes and new functionality) that should not get in the way of
-existing proof efforts.
-
-In particular, please see *note NOTE-2-7-NEW-FUNCTIONALITY:: for
-discussion of a number of new features that you may find useful.
-
-Acknowledgements and elaboration, as well as other changes, can be
-found in the subtopics listed below.
-
-o Bug fixes (see *note NOTE-2-7-BUG-FIXES::):
-
-     + Three soundness bugs were fixed.  These bugs were probably
-     rarely hit, so users may well not notice these changes.
-
-     + Certify-book now requires :skip-proofs-ok t (respectively,
-     :defaxioms-okp t) if there are skip-proofs (respectively,
-     defaxiom) events in the book or any included sub-books.
-
-     + When :by hints refer to a definition, they now use the original
-     body of that definition rather than the simplfied ("normalized")
-     body.
-
-     + When ld is applied to a stringp file name, it now temporarily
-     sets the connected book directory (see *note CBD::) to the
-     directory of that file while evaluating forms in that file.
-
-o New functionality (see *note NOTE-2-7-NEW-FUNCTIONALITY::):
-
-     + ACL2 now works harder to apply :rewrite and :linear rules with
-     free variables in the hypotheses.  See *note
-     NOTE-2-7-NEW-FUNCTIONALITY::, in particular its first two
-     paragraphs, for details.  Forward-chaining also does more with
-     free variables.
-
-o Changes in proof engine (see *note NOTE-2-7-PROOFS::):
-
-     + Some prover heuristics have changed slightly.  Among other
-     consequences, this can cause subgoal hints to change.  For
-     example, suppose that the Version_2.6 proof of a particular
-     theorem generated "Subgoal 2" and "Subgoal 1" while Version_2.7
-     only generates the second of these.  Then a subgoal hint attached
-     to "Subgoal 1" in Version_2.6 would have to be attached to "Goal'"
-     in Version_2.7.  (See *note GOAL-SPEC::.)  The full topic has
-     details (see *note NOTE-2-7-PROOFS::).
-
-o Changes in rules and definitions (see *note NOTE-2-7-RULES::):
-
-     + The package name of a generated variable has changed for defcong.
-
-o Guard-related changes (see *note NOTE-2-7-GUARDS::):
-
-     + Guard verification formerly succeeded in a few cases where it
-     should have failed.
-
-     + Guards generated from type declarations now use functions
-     signed-byte-p and unsigned-byte-p, now defined in source file
-     axioms.lisp and formerly defined rather similarly under books/ihs/.
-
-o Proof-checker changes (see *note NOTE-2-7-PROOF-CHECKER::):
-
-     + See the above doc topic.
-
-o System-level changes (see *note NOTE-2-7-SYSTEM::):
-
-     + See the above doc topic.
-
-o Other changes (see *note NOTE-2-7-OTHER::):
-
-     + A new table, invisible-fns-table, takes the place of the
-     handling of invisible functions in the acl2-defaults-table,
-
-     + The theory-invariant event has been modified so that the default
-     action is an error rather than a warning.
-
-     +  Proof output that reports destructor elimination no longer uses
-     the word "generalizing".
-
-Again, please proceed to the subtopics for more thorough release notes.
-
-* Menu:
-
-* NOTE-2-7-BUG-FIXES:: ACL2 Version  2.7 Notes on Bug Fixes
-
-* NOTE-2-7-GUARDS:: ACL2 Version  2.7 Notes on Guard-related Changes
-
-* NOTE-2-7-NEW-FUNCTIONALITY:: ACL2 Version  2.7 Notes on New Functionality
-
-* NOTE-2-7-OTHER:: ACL2 Version  2.7 Notes on Miscellaneous Changes
-
-* NOTE-2-7-PROOF-CHECKER:: ACL2 Version  2.7 Notes on Proof-checker Changes
-
-* NOTE-2-7-PROOFS:: ACL2 Version  2.7 Notes on Changes in Proof Engine
-
-* NOTE-2-7-RULES:: ACL2 Version  2.7 Notes on Changes in Rules and Constants
-
-* NOTE-2-7-SYSTEM:: ACL2 Version  2.7 Notes on System-level Changes
-
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-11 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-11
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-11	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-11	2013-09-30 17:39:46.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,6 +28,640 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: NOTE-2-6-NEW-FUNCTIONALITY,  Next: NOTE-2-6-OTHER,  Prev: NOTE-2-6-GUARDS,  Up: NOTE-2-6
+
+NOTE-2-6-NEW-FUNCTIONALITY    ACL2 Version  2.6 Notes on New Functionality
+
+A fundamental change is the provision of the "nu-rewriter" for
+simplifying expressions composed of NTH, UPDATE-NTH, and
+UPDATE-NTH-ARRAY applications and LET expressions and other calls of
+non-recursive functions or LAMBDA expressions involving those symbols.
+The nu-rewriter applies the obvious rewrite rule for (NTH i (UPDATE-NTH
+j v s)) and the analogous rule for UPDATE-NTH-ARRAY.  See *note
+NU-REWRITER::  The nu-rewriter can be enabled with set-nu-rewriter-mode.
+
+A new flag has been added to the xargs of defun permitting the
+declaration that the function is non-executable.  The usage is (declare
+(xargs :non-executable t)) and the effect is that the function has no
+executable counterpart.  On the positive side:  the function is
+permitted to use single-threaded object names and functions
+arbitrarily, as in theorems rather than as in executable definitions.
+Such functions are not permitted to declare any names :stobjs but
+accessors, etc., may be used, just as in theorems.
+
+A new flag has been added to permit the system to abbreviate output by
+introducing LET* notation identifying common subterms.  The formula
+being proved is not affected; this flag changes its displayed form
+only.  See set-let*-abstractionp.
+
+A "raw mode" has been added, primarily for faster loading of
+applications.  see *note SET-RAW-MODE::.
+
+Functions alphorder and lexorder have been put in :logic mode.
+Lexorder is now a total order ordering of the ACL2 universe, and
+theorems are included to that effect.  Thanks to Pete Manolios for
+suggesting the idea and providing events to use, and to Rob Sumners for
+assistance with some modifications.  See also the new book
+books/misc/total-order for an irreflexive total order.
+
+The ACL2 user can now make system calls to the host operating system.
+See *note SYS-CALL:: and see *note SYS-CALL-STATUS::.  Thanks to Rob
+Sumners for working out this idea with Pete Manolios and Robert Krug,
+who we also thank, and for working out the implementation with us.
+
+It is no longer required to use absolute pathnames in include-book
+forms that have been executed before a certify-book.  Any relative
+pathname strings in such contexts will be expanded into absolute
+pathnames before they are saved in the portcullis of the certificate of
+the book being certified.
+
+ACL2 can now be built on top of Allegro Common Lisp 6.0, and also on
+Windows platforms on top of Allegro Common Lisp and GCL.  Thanks to Pete
+Manolios and Vinay K. Siddhavanahalli for their help with Windows.
+
+Rob Sumners has designed and provided an initial implementation for two
+improvements to defstobj (also see *note STOBJ::).  First, array fields
+can now be resized.  Resize and length functions are provided for array
+fields, which can be used to resize stobj array fields dynamically.
+The recognizers for array fields have been simplified to accommodate
+this change, so that they only check that each element of the array
+field has the specified type.  Second, performance has been improved
+for stobjs with a large number of fields, by changing their Common Lisp
+implementation to store the fields in a simple vector instead of a list.
+
+Now stobjs may be bound locally; see *note WITH-LOCAL-STOBJ::.  Thanks
+to Rob Sumners, who encouraged us to implement this capability, was an
+early user of it, and participated usefully in discussions on its
+design.
+
+New functions fms!, fmt!, and fmt1! are the same as their respective
+functions without the "!," except that the "!" functions are guaranteed
+to print forms that can be read back in (at a slight readability cost).
+
+We added extended-metafunctions, metafunctions which allow state and
+context sensitive rewriting to some extent.  We thank Robert Krug for
+pushing for and on this idea.
+
+The documentation has been improved.  In particular, a new
+documentation topic provides a gentle introduction to ACL2 arrays --
+see *note ARRAYS-EXAMPLE:: -- and additional documentation has been
+provided for getting started with proof trees in emacs -- see *note
+PROOF-TREE::.
+
+New Makefile targets fasl and o have been added to the books/ directory
+of the distribution.  For example, you might first certify books using
+an ACL2 built on top of GCL (which creates compiled files with suffix
+o).  Then, when standing in the books/ directory, you might execute the
+command
+
+     make fasl ACL2=my-allegro-acl2
+
+which will create compiled (.fasl) files for Allegro Common Lisp,
+assuming that my-allegro-acl2 starts up an ACL2 built on that Common
+Lisp.
+
+The macro let* now allows variables to be declared ignored.  See *note
+LET*:: and see *note LET::.
+
+The user may now control backchaining.  This feature was designed and
+primarily implemented by Robert Krug (though the authors of ACL2 are
+resposible for any errors); thanks, Robert!  See *note
+BACKCHAIN-LIMIT::.
+
+It is now possible to "slow down" the rate at which case splits are
+generated by the simplifier.  See *note SET-CASE-SPLIT-LIMITATIONS::.
+
+Accesses to stobjs using nth or update-nth are now displayed using
+symbolic constants instead of numeric indices.  For example, given the
+event
+
+     (defstobj foo a b :renaming ((b c)))
+
+then the term (nth 0 foo) will be displayed (for example, during
+proofs) as (nth *a* foo) while (nth 1 foo) will be displayed as (nth
+*c* foo).  The defstobj event now correspondingly introduces a defconst
+event for each field accessor function, introducing a constant whose
+name is obtained from the accessor's name by prefixing and suffixin a
+"*," as in the example above: accessor a generates (defconst *a* 0) and
+accessor c generates (defconst *c* 1). See *note NTH-ALIASES-TABLE::
+for how to extend this feature for alternate names of stobjs.
+
+Computed hints have been improved.  It is now possible to detect within
+a computed hint whether the goal clause is stable under simplification;
+it is also possible for a computed hint to change the list of available
+hints.  See *note COMPUTED-HINTS::.
+
+It is now possible to provide "default hints" that are appended to the
+hints explicitly provided.  See *note SET-DEFAULT-HINTS::.
+
+Using computed hints (see *note COMPUTED-HINTS::) and default hints
+(see *note SET-DEFAULT-HINTS::) it is possible to implement a book that
+supports "priority phased simplification."  Using this book you can
+assign priorities to your rules and cause the theorem prover to
+simplify each goal maximally under all the rules of one priority before
+enabling rules of the next priority.  See books/misc/priorities.lisp.
+
+The macro defabbrev has been improved to allow declare forms and
+documentation strings and to do more error-checking.  Thanks to Rob
+Sumners for designing this enhancement and providing the first
+implementation.  See *note DEFABBREV::.
+
+Further changes were made to support CMU Lisp.  Wolfhard Buss helped
+with these changes.
+
+A new table was added that is used when printing proof output, so that
+nests of right-associated calls of a binary function are replaced by
+corresponding macro calls, as has been the case for binary-+ and +,
+binary-append and append, and so on.  See *note ADD-BINOP::.
+
+Operators logand, logior, logxor, and logeqv are now macros (formerly,
+they were functions) that call corresponding binary functions (e.g.,
+binary-logand) defined in source file "axioms.lisp".  Thanks to Rob
+Sumners for this enhancement.  Proof output will however continue to
+show calls of logand, logior, logxor, and logeqv.
+
+Function (allocate-fixnum-range fixnum-lo fixnum-hi) sets aside more
+"permanent" fixnums in GCL.
+
+ACL2 now runs under CLISP.  Thanks to Wolfhard Buss and Sam Steingold
+for their assistance with the port.
+
+Michael "Bogo" Bogomolny has created a search engine, accessible from
+the ACL2 home page.  For that purpose he modified the HTML translator
+to create one file per topic (a good idea in any case).  Thanks, Bogo!
+
+An emacs file of potential (but optional) use for ACL2 users may be
+found in emacs/emacs-acl2.el.  In particular, this file supports the
+use of proof trees (see *note PROOF-TREE::).
+
+Some books have been added or modified.  In particular, Robert Krug has
+contributed books/arithmetic-2/, which provides an alternative to the
+existing collection of books about arithmetic, books/arithmetic/.  For a
+discussion of the distributed books see the link to README.html in the
+installation instructions.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE-2-6-OTHER,  Next: NOTE-2-6-PROOF-CHECKER,  Prev: NOTE-2-6-NEW-FUNCTIONALITY,  Up: NOTE-2-6
+
+NOTE-2-6-OTHER    ACL2 Version  2.6 Notes on Other (Minor) Changes
+
+Warning strings are now case-insensitive.  See *note
+SET-INHIBIT-WARNINGS::.
+
+ACL2 causes a warning when an in-theory hint or event causes a 0-ary
+function's definition to be disabled but its :executable-counterpart to
+be enabled.
+
+A minor modification has been made to defstobj that can have a positive
+impact on performance in Allegro Common Lisp.  (For Lisp hackers:  the
+stobj name was formerly declared special, and that was disabling
+Allegro's tail-merging routing for compilation of some recursive
+functions using stobjs.)  The downside is that stobj names can no
+longer be evaluated in raw Lisp.  However, raw Lisp is not the right
+place to be evaluating ACL2 forms anyhow; see *note SET-RAW-MODE::.  We
+thank Rob Sumners for bringing this issue to our attention.
+
+Before Version  2.6, there has been the following problem with defstub
+and encapsulate in the case that the current package is not the ACL2
+package.  If a signature was specified using the symbol =>, then that
+symbol had have been imported into the current package from the ACL2
+package when the current package was defined.  There are no longer any
+package restrictions on the use of =>.  Thanks to John Cowles for
+bringing this problem to our attention.
+
+Bugs in defun-sk have been fixed.  Defun-sk forms introducing functions
+of no arguments were failing to be admitted, for example: (defun-sk
+always-p1 () (forall (x) (p1 x))).  Thanks to John Cowles for bringing
+this problem to our attention.  Also, defun-sk failed on an example in
+the documentation (see *note TUTORIAL4-DEFUN-SK-EXAMPLE::), as pointed
+out by Matyas Sustik; this bug has been fixed as well.
+
+The trace mechanism has been fixed to handle stobjs, and to avoid the
+printing of so-called _enabled structures_.
+
+The brr command :type-alist now produces more readable output.
+
+An include-book of an uncertified book no longer loads an associated
+compiled file.
+
+We added a few checks to make sure that the underlying lisp is
+suitable, for example checking that the reader is case-insensitive and
+reads in symbols with upper-case names where appropriate.
+
+We now warn when forcing (see *note FORCE::) or immediate force mode
+(see *note IMMEDIATE-FORCE-MODEP::) change state between enabled and
+disabled.  Also see *note ENABLE-IMMEDIATE-FORCE-MODEP:: and see *note
+DISABLE-IMMEDIATE-FORCE-MODEP:: for information about these new macros,
+which may be used to control immediate force mode.
+
+We have eliminated the use of a low-level raw Lisp constant,
+*most-recent-multiplicity*.  Our test suite saw a speed-up of
+approximately 2% as a result for an ACL2 image built on GCL (but no
+significant speed-up for an ACL2 image built on Allegro Common Lisp).
+We thank Rob Sumners for suggesting this improvement.
+
+Fixnum declarations are now realized as (signed-byte 29) instead of
+(signed-byte 27).  We check that the underlying Common Lisp recognizes
+objects of type (signed-byte 29) as fixnums, with the exception of
+CLISP, which is said to have an efficient bignum implementation.
+
+A new documentation topic functional-instantiation-example illustrates
+functional instantiation.
+
+A bug has been fixed in the monitoring of runes (see *note MONITOR::).
+Thanks to Dave Greve for sending an example that clearly showed the
+problem.
+
+A warning is now issued when it is detected that a :type-prescription
+rule may not be as strong as it appears because it is not sufficient to
+prove itself by type reasoning.
+
+An error is caused for rules of class :meta when the function symbol IF
+is among the :trigger-fns.  (IF was ignored anyhow; the point of this
+change is to avoid misleading the user.)
+
+A minor bug has been fixed in :pr, evident for example if this command
+was applied to IF.
+
+A minor hole in :set-bogus-mutual-recursion-ok did not permit the
+acceptance of mutual-recursion forms that include constant function
+definitions.  This has been fixed.  Thanks to Eric Smith for coming up
+with a simple example illustrating the problem.
+
+The temporary files "TMP.lisp" and "TMP1.lisp" written out by :comp are
+now written to the connected book directory (see *note CBD::).
+
+Previously, the Allegro compiler was not eliminating tail recursion for
+executable counterparts of functions, because of the way one of its
+flags had been set.  As a result, calls of functions whose guards had
+not been verified could run out of stack space when this was not
+necessary.  This situation has been fixed.
+
+Executable counterparts could have slow array accesses.  This has been
+fixed (specifically, constants are no longer replaced with their values
+in the definitions of executable counterparts).
+
+Various improvements have been made to the documentation.  Thanks in
+particular to Eric Smith for pointing out a numbers of places where
+fixes were in order.
+
+File "mcl-acl2-startup.lisp" has been updated, thanks to feedback from
+Philippe Georgelin.
+
+Inefficiencies in GCL fixnum computations were remedied for macros +f
+and *f.  Thanks to Rob Sumners for pointing out this issue.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE-2-6-PROOF-CHECKER,  Next: NOTE-2-6-PROOFS,  Prev: NOTE-2-6-OTHER,  Up: NOTE-2-6
+
+NOTE-2-6-PROOF-CHECKER    ACL2 Version  2.6 Notes on Proof-checker Changes
+
+The proof-checker command =, when used with no arguments, now reports
+which hypothesis is being used.
+
+The output from proof-checker command type-alist has been improved.
+
+A slight change has been made to the proof-checker for commands
+promote, casesplit, equiv, and =, so that terms of the form (if x nil
+y) are recognized as conjunctions, (and (not x) y).  Thanks to Pete
+Manolios for suggesting that we consider such a change.
+
+There is a new proof-checker command print-all-concs that prints all
+the conclusions of the unproved goals.
+
+A new proof-checker command, runes, has been added.  It reports the
+runes that have participated in the interactive proof up to the current
+point.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE-2-6-PROOFS,  Next: NOTE-2-6-RULES,  Prev: NOTE-2-6-PROOF-CHECKER,  Up: NOTE-2-6
+
+NOTE-2-6-PROOFS    ACL2 Version  2.6 Notes on Changes in Proof Engine
+
+Certain optimizations are performed when converting terms to clausal
+form.  For example, (< 0 1) is known to be t, (HARD-ERROR ctx str
+alist) is known to be nil, and (INTEGERP n) is known to imply
+(RATIONALP n).
+
+In earlier versions of ACL2, the conversion of a term to clausal form
+expanded LAMBDA applications.  That may no longer occur.  Some proofs
+may slow down (or fail) because your LAMBDA-expressions are not
+expanded away when you "expected" them to be.
+
+Robert Krug found a soundness bug in our linear arithmetic package.
+The bug was caused by the derivation of an equation from two
+inequalities without taking adequate precautions to ensure that both
+sides of the inequalities were numeric.  Robert also kindly provided a
+fix which we adopted.  Thanks Robert!
+
+We fixed a bug that could prevent the application of a metatheorem.
+
+A bug has been fixed that had caused bogus forcing rounds (see *note
+FORCING-ROUND::).  The bug could occur when the hypothesis of a rule
+was forced (see *note FORCE::) before the prover decided to start over
+and prove the original goal by induction.  Thanks to Rob Sumners for
+drawing our attention to this problem.
+
+Some low-level fixes have been made that prevent certain infinite
+loops, based on reports by users.  We thank Yunja Choi, Matt Wilding,
+and Pete Manolios for reporting such problems.
+
+An obscure potential soundness hole has been fixed by redoing the way
+evaluation takes place in the ACL2 loop and during theorem proving.  We
+expect that users will see no difference based on this change.  (Those
+interested in the details can see the long comment "Essay on Evaluation
+in ACL2" in source file interface-raw.lisp.)
+
+A small change was made in computation for a heuristic that controls
+backchaining.  This will speed up proofs dramatically in a very few
+cases but should have a very small impact in general.
+
+The simplifier has been modified to avoid eliminating hypotheses of
+goals that can be established by contextual (specifically, type-set)
+reasoning alone.  We believe that this change will generally strengthen
+ACL2's reasoning engine, although on rare occasions a lemma that
+formerly was provable may require user assistance.  Thanks to Robert
+Krug for suggesting this change and providing its implementation.
+
+Case splits are now limited, by default.  This may allow some proof
+attempts to provide output where previously the prover would appear to
+"go out to lunch."  For a more complete discussion, including
+instructions for how users can control case splitting, see *note
+SET-CASE-SPLIT-LIMITATIONS::.
+
+A bug has been fixed in the handling of :type-prescription rules by the
+bdd package.  Thanks to Rob Sumners for discovering this bug and
+supplying a helpful example.
+
+ACL2 may now use the built-in induction scheme for a function symbol
+even if that function symbol is disabled.  Formerly, if a function
+symbol was disabled then its induction scheme was only considered if an
+explicit induction hint was supplied, other than :induct t.
+
+We eliminated the rule-class linear-alias.  This rule class was seldom
+used and complicated the linear arithmetic decision procedure in ways
+that made it difficult to extend to handle some non-linear special
+cases.  The only use of the rule-class that we know of was in our own
+nqthm books, which were an attempt to provide an embedding of the Nqthm
+logic and theorem prover into ACL2.  But that facility was also
+practically never used, as far as we know.  So both linear-alias rules
+and the nqthm books have been eliminated.
+
+In earlier versions of ACL2, when the IF-form of (AND p q) was assumed
+true - as when rewriting the alpha expression in (IF (AND p q) alpha
+beta) - the assumption mechanism did not deduce that p and q are true,
+only that their conjunction, in its IF-form, is true.  This has long
+been known as a deficiency in both ACL2 and the earlier Nqthm but it
+was tedious to do better when one considered the full range of IF-forms
+one might encounter in the test of another IF.  Rather than code all
+the cases, we just waited until clausification got rid of them.  Robert
+Krug developed a pretty nice treatment of the general case and we added
+it in this version.  This also involved a surprising number of changes
+elsewhere in the system because the improved handling of assumptions
+caused the theorem prover often to "erase" hypotheses provided by :use
+hints because it could simplify them to t.  Thank you Robert!
+
+In response to a suggestion from Robert Krug, we added mfc-ap so that
+extended metafunctions can take advantage of linear arithmetic.  See
+*note EXTENDED-METAFUNCTIONS::.
+
+There is less delay in printing goals.  In previous versions, a goal
+was not printed until its subgoals were created (or the goal was
+proved).  Now, the goal is printed essentially as soon as it is created.
+
+A small technical change has been made in the function term-order, to
+give priority on the function symbol count over the weighting of
+constants.  So for example, while previously the term (f) preceded the
+constant 2, that is no longer the case.  If this change is noticed at
+all, it will probably be noticed in how so-called _permutative_ rewrite
+rules are applied; see *note LOOP-STOPPER::.  Thanks to Robert Krug for
+suggesting this improvement and providing part of the implemtation.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE-2-6-RULES,  Next: NOTE-2-6-SYSTEM,  Prev: NOTE-2-6-PROOFS,  Up: NOTE-2-6
+
+NOTE-2-6-RULES    ACL2 Version  2.6 Notes on Changes in Rules and Constants
+
+The following symbols have been added to the list constant
+*common-lisp-specials-and-constants*: REPLACE, FILL, CHARACTER, =,
+BREAK, and PRIN1.  This was done in support of ports to Allegro 6.0 and
+Windows platforms (see *note NOTE-2-6-NEW-FUNCTIONALITY::).
+
+The list of symbols in *acl2-exports* has been modified, for example to
+include show-accumulated-persistence and the legal arguments to
+set-inhibit-output-lst.
+
+Functions zp and zip are now handled slightly differently.  They are
+are now disabled, but each comes with a :rewrite rule that allows their
+expansion on non-variable terms, and also with a :compound-recognizer
+rule that avoids the need for opening up these functions when applied
+to variables.  The resulting behavior should be very similar to the
+behavior of previous versions, except that case splits will be avoided
+when these functions are applied to variables.
+
+Function standard-string-alistp replaces function string-alistp.  For
+further discussion, see *note NOTE-2-6-GUARDS::.
+
+Rules of class :rewrite whose conclusion is a term of the form (equal
+lhs rhs) have always been stored in the expected way:  lhs rewrites to
+rhs.  This way of storing :rewrite rules has been extended to allow =,
+eq, or eql in place of equal.
+
+Rewrite rule nth-update-nth, in source file axioms.lisp, has been
+strengthened.
+
+A new rewrite rule equal-constant-+ has been added to the book
+arithmetic/equalities.  This should generally be a beneficial change,
+but existing proofs involving the arithmetic books could conceivably be
+affected.
+
+Function symbol-package-name and constant *main-lisp-package-name* have
+undergone small changes.  This change should rarely be noticed by users
+and is discussed elsewhere; see *note NOTE-2-6-SYSTEM::.
+
+We mention here that proofs involving stobjs may need to be modified
+because of changes in auxiliary functions generated by defstobj.
+(These changes were made in support of a new resizing capability,
+mentioned elsewhere in these release notes; see *note
+NOTE-2-6-NEW-FUNCTIONALITY::.
+
+In the distributed book directory books/arithmetic/, the book
+rationals-with-axioms-proved.lisp has been renamed rationals.lisp.
+
+(ACL2(r) only) Rewrite rules realp-+, realp-*, realp-unary-, and
+realp-unary-/ have been added in analogy to existing rules rationalp-+,
+rationalp-*, rationalp-unary-, and rationalp-unary-/.  Thanks to Jun
+Sawada for suggesting this change.
+
+The definition of aref1 has been modified slightly.  Previously, if
+*my-a* were an array then (aref1 'some-name *my-a* :header)  would
+evaluate to the cdr of the header of *my-a* rather than to its default.
+See *note ARRAYS::.
+
+Changes have been made in the ihs books, based on suggestions from Jun
+Sawada, that support its use with ACL2(r) (see *note REAL::).  The
+primary change is to replace calls of rationalp with calls of
+real/rationalp, which should have no effect on users of standard ACL2.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE-2-6-SYSTEM,  Prev: NOTE-2-6-RULES,  Up: NOTE-2-6
+
+NOTE-2-6-SYSTEM    ACL2 Version  2.6 Notes on System-level Changes
+
+We modified the tracking of skip-proofs events and the use of state
+global ld-skip-proofsp in order to avoid some soundness issues.  For
+example, skip-proofs events buried in locally-included books are now
+tracked.  The "Essay on Skip-proofs" in source file axioms.lisp gives
+several examples of dicey behavior that is no longer supported.
+
+We fixed a problem with some of the makefiles, so that recursive
+invocations of `make' now use the version of `make' specified on the
+command line.
+
+Files were fixed to help non-Unix/Linux users with book certification.
+Thanks to John Cowles for finding some problems and suggesting fixes to
+books/certify-numbers.lisp, books/arithmetic/certify.lsp, and
+books/cowles/certify.lsp.  We thank Scott Burson for noticing and
+fixing some other such problems.  Moreover, a bdd test was being
+ignored entirely in Version  2.5; this problem has been fixed as well.
+
+A minor change in system function save-acl2-in-allegro will allow this
+function to continue to work in Allegro CL versions starting (someday)
+with 10.0.  Thanks to Art Flatau for suggesting such a fix.
+
+The books/case-studies/ directory has been removed.  These books are in
+support of the first (1998) ACL2 workshop, and are accessible via the
+ACL2 home page on the Web,
+`http://www.cs.utexas.edu/users/moore/acl2/'.  Also, the books/cli-misc
+directory has been renamed books/misc, and the books/nqthm directory
+has been removed.
+
+The notion of ACL2 version has been slightly modified to catch
+unsoundness due to implementation dependencies.  See *note VERSION::.
+Another change to eliminate such unsoundness is that built-in symbols
+now have a symbol-package-name of "COMMON-LISP"; formerly, this string
+was "LISP" for ACL2 images built on GCL.  See *note
+SYMBOL-PACKAGE-NAME::.  At a low level, the (undocumented) constant
+*main-lisp-package-name* is now "COMMON-LISP"; before, it was "LISP"
+for GCL.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE-2-6(R),  Next: NOTE-2-7,  Prev: NOTE-2-6,  Up: RELEASE-NOTES
+
+NOTE-2-6(R)    ACL2 Version  2.6(r) (November, 2001) Notes
+
+Important changes to non-standard version:  None since Version  2.5.
+
+Please see *note NOTE-2-6:: for changes to Version  2.6 of ACL2.  We
+hope to write more documentation for ACL2(r) in the future.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE-2-7,  Next: NOTE-2-7(R),  Prev: NOTE-2-6(R),  Up: RELEASE-NOTES
+
+NOTE-2-7    ACL2 Version  2.7 (November, 2002) Notes
+
+The Version_2.7 notes are divided into the subtopics below.  Here we
+give only a brief summary of a few of the changes that seem most likely
+to impact existing proofs.  Not included in this brief summary, but
+included in the subtopics, are descriptions of improvements (including
+bug fixes and new functionality) that should not get in the way of
+existing proof efforts.
+
+In particular, please see *note NOTE-2-7-NEW-FUNCTIONALITY:: for
+discussion of a number of new features that you may find useful.
+
+Acknowledgements and elaboration, as well as other changes, can be
+found in the subtopics listed below.
+
+o Bug fixes (see *note NOTE-2-7-BUG-FIXES::):
+
+     + Three soundness bugs were fixed.  These bugs were probably
+     rarely hit, so users may well not notice these changes.
+
+     + Certify-book now requires :skip-proofs-ok t (respectively,
+     :defaxioms-okp t) if there are skip-proofs (respectively,
+     defaxiom) events in the book or any included sub-books.
+
+     + When :by hints refer to a definition, they now use the original
+     body of that definition rather than the simplfied ("normalized")
+     body.
+
+     + When ld is applied to a stringp file name, it now temporarily
+     sets the connected book directory (see *note CBD::) to the
+     directory of that file while evaluating forms in that file.
+
+o New functionality (see *note NOTE-2-7-NEW-FUNCTIONALITY::):
+
+     + ACL2 now works harder to apply :rewrite and :linear rules with
+     free variables in the hypotheses.  See *note
+     NOTE-2-7-NEW-FUNCTIONALITY::, in particular its first two
+     paragraphs, for details.  Forward-chaining also does more with
+     free variables.
+
+o Changes in proof engine (see *note NOTE-2-7-PROOFS::):
+
+     + Some prover heuristics have changed slightly.  Among other
+     consequences, this can cause subgoal hints to change.  For
+     example, suppose that the Version_2.6 proof of a particular
+     theorem generated "Subgoal 2" and "Subgoal 1" while Version_2.7
+     only generates the second of these.  Then a subgoal hint attached
+     to "Subgoal 1" in Version_2.6 would have to be attached to "Goal'"
+     in Version_2.7.  (See *note GOAL-SPEC::.)  The full topic has
+     details (see *note NOTE-2-7-PROOFS::).
+
+o Changes in rules and definitions (see *note NOTE-2-7-RULES::):
+
+     + The package name of a generated variable has changed for defcong.
+
+o Guard-related changes (see *note NOTE-2-7-GUARDS::):
+
+     + Guard verification formerly succeeded in a few cases where it
+     should have failed.
+
+     + Guards generated from type declarations now use functions
+     signed-byte-p and unsigned-byte-p, now defined in source file
+     axioms.lisp and formerly defined rather similarly under books/ihs/.
+
+o Proof-checker changes (see *note NOTE-2-7-PROOF-CHECKER::):
+
+     + See the above doc topic.
+
+o System-level changes (see *note NOTE-2-7-SYSTEM::):
+
+     + See the above doc topic.
+
+o Other changes (see *note NOTE-2-7-OTHER::):
+
+     + A new table, invisible-fns-table, takes the place of the
+     handling of invisible functions in the acl2-defaults-table,
+
+     + The theory-invariant event has been modified so that the default
+     action is an error rather than a warning.
+
+     +  Proof output that reports destructor elimination no longer uses
+     the word "generalizing".
+
+Again, please proceed to the subtopics for more thorough release notes.
+
+* Menu:
+
+* NOTE-2-7-BUG-FIXES:: ACL2 Version  2.7 Notes on Bug Fixes
+
+* NOTE-2-7-GUARDS:: ACL2 Version  2.7 Notes on Guard-related Changes
+
+* NOTE-2-7-NEW-FUNCTIONALITY:: ACL2 Version  2.7 Notes on New Functionality
+
+* NOTE-2-7-OTHER:: ACL2 Version  2.7 Notes on Miscellaneous Changes
+
+* NOTE-2-7-PROOF-CHECKER:: ACL2 Version  2.7 Notes on Proof-checker Changes
+
+* NOTE-2-7-PROOFS:: ACL2 Version  2.7 Notes on Changes in Proof Engine
+
+* NOTE-2-7-RULES:: ACL2 Version  2.7 Notes on Changes in Rules and Constants
+
+* NOTE-2-7-SYSTEM:: ACL2 Version  2.7 Notes on System-level Changes
+
+
 File: acl2-doc-emacs.info,  Node: NOTE-2-7-BUG-FIXES,  Next: NOTE-2-7-GUARDS,  Prev: NOTE-2-7,  Up: NOTE-2-7
 
 NOTE-2-7-BUG-FIXES    ACL2 Version  2.7 Notes on Bug Fixes
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-12 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-12
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-12	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-12	2013-09-30 17:39:46.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -4827,7 +4827,7 @@
 UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES::).
 
 
-File: acl2-doc-emacs.info,  Node: NOTE-6-2,  Next: NOTE1,  Prev: NOTE-6-1,  Up: RELEASE-NOTES
+File: acl2-doc-emacs.info,  Node: NOTE-6-2,  Next: NOTE-6-3,  Prev: NOTE-6-1,  Up: RELEASE-NOTES
 
 NOTE-6-2    ACL2 Version  6.2 (June, 2013) Notes
 
@@ -4835,7 +4835,7 @@
 documentation has been updated to reflect all changes that are recorded
 here.
 
-Below we roughly organize the changes since Version  6.1 into the
+Below we roughly organize the changes since Version 6.1 into the
 following categories of changes: existing features, new features,
 heuristic improvements, bug fixes, changes at the system level, Emacs
 support, and experimental versions.  Each change is described in just
@@ -5156,7 +5156,277 @@
 contribution to this capability.
 
 
-File: acl2-doc-emacs.info,  Node: NOTE1,  Next: NOTE2,  Prev: NOTE-6-2,  Up: RELEASE-NOTES
+File: acl2-doc-emacs.info,  Node: NOTE-6-3,  Next: NOTE1,  Prev: NOTE-6-2,  Up: RELEASE-NOTES
+
+NOTE-6-3    ACL2 Version  6.3 (October, 2013) Notes
+
+NOTE!  New users can ignore these release notes, because the
+documentation has been updated to reflect all changes that are recorded
+here.
+
+Below we roughly organize the changes since Version  6.2 into the
+following categories of changes: existing features, new features,
+heuristic improvements, bug fixes, changes at the system level, Emacs
+support, and experimental versions.  Each change is described in just
+one category, though of course many changes could be placed in more
+than one category.
+
+*CHANGES TO EXISTING FEATURES*
+
+The evaluation of a term from a bind-free hypothesis had been expected
+to produce an alist binding free variables to terms.  While that is
+still legal, it is also legal for that evaluation to produce a list of
+such alists: then each is considered, until one of them permits all
+remaining hypotheses to be relieved.  See *note BIND-FREE::.  Thanks to
+Sol Swords for requesting this enhancement.
+
+ACL2 continues to provide a way to specify keyword command
+abbreviations for the top-level loop; see *note LD-KEYWORD-ALIASES::.
+However, ld-keyword-aliases is now a table rather than a state global;
+it is thus no longer a so-called LD special.  The functionality of
+set-ld-keyword-aliases has essentially been preserved, except that it is
+now an event (see *note EVENTS::), hence it may appear in a book; it is
+local to a book (or encapsulate event); and the state argument is
+optional, and deprecated.  A non-local version (set-ld-keyword-aliases!)
+has been added, along with corresponding utilities add-keyword-alias and
+add-keyword-alias! for adding a single keyword alias.  See *note
+LD-KEYWORD-ALIASES::.  Thanks to Jared Davis for correspondence that
+led us to make this change.
+
+The proof-checker command (exit t) now exits without a query (but still
+prints an event to show the :INSTRUCTIONS).  Thanks to Warren Hunt for
+feedback leading us to make this change.
+
+We made the following minor changes to the behavior or dmr; see *note
+DMR::.  First, if dmr monitoring is enabled, then (dmr-start) will have
+no effect other than to print a corresponding observation, and if
+monitoring is disabled, then (dmr-stop) will have no effect other than
+to print a corresponding observation.  Second, it had been the case
+that when (dmr-start) is invoked, the debugger was always automatically
+enabled with value t (see *note SET-DEBUGGER-ENABLE::), and the
+debugger remained enabled when (dmr-stop) was invoked.  Now, the
+debugger is only enabled by (dmr-start) if it is not already enabled
+and does not have setting :never.  Moreover, if such automatic enabling
+takes place, then the old setting for the debugger is restored by
+(dmr-stop) unless set-debugger-enable has first been called after that
+automatic enabling.  Finally, if the value of state global variable
+'debugger-enable is :bt, then the new value will be :break-bt, not t.
+
+When a call of progn is executed in the ACL2 loop, its constituent
+events and their results are printed, just as was already done for calls
+of encapsulate.  Thanks to Jared Davis for a conversation causing us to
+consider this change.
+
+(CCL only) When set-debugger-enable is invoked with an argument that
+prints a backtrace and CCL is the host Lisp, the backtrace will be
+limited to 10,000 stack frames.  (We have seen more than 65,000 stack
+frames before this change.)  This limit is the value of raw Lisp
+variable *ccl-print-call-history-count*, which may be assigned another
+positive integer value to serve as the maximum number of stack frames
+to be printed.
+
+Improvements have been made pertaining to the disabling (inhibiting) of
+individual types of warning.  Now, inhibited warnings are implemented
+in a straightforward way using a separate table for this purpose, the
+inhibit-warnings-table, rather than using the acl2-defaults-table.  See
+*note SET-INHIBIT-WARNINGS::, and see *note SET-INHIBIT-WARNINGS!:: for
+a variant that is not local to an encapsulate or a book in which it
+occurs.  Thanks to Sol Swords for sending examples showing how
+set-inhibit-warnings did not always behave as one might reasonably
+expect when books are involved.
+
+It had been the case that lp took a single argument, 'raw.  This
+argument was not documented and also caused an error, so it has been
+eliminated.
+
+The functionality of make-event has been significantly expanded.
+First: if the expansion is of the form (:OR e1 e2 ...), then event forms
+e1, e2, and so on are evaluated, in order, until the evaluation of some
+ek completes without error.  In that case, the expansion is treated
+simply as ek.  With this capability, alternative expansions can be
+attempted and the successful one does not need to be evaluated again.
+See the new version of community book
+books/make-event/proof-by-arith.lisp for an example.  Second, an
+expansion may be of the form (:DO-PROOFS e), in which case the event e
+is evaluated with proofs *not* skipped; see *note LD-SKIP-PROOFSP::.
+Third, new keyword :EXPANSION? can be used to avoid storing expansions
+in certificate files.  See *note MAKE-EVENT::.
+
+When a defun event prints a failure message in the summary, that
+message now indicates when the failure is due to a failed proof of guard
+verification or a failed proof of the measure theorem.  Thanks to
+Shilpi Goel for requesting this enhancement.
+
+*NEW FEATURES*
+
+ACL2 can now be instructed to time activities using real time (wall
+clock time) instead of run time (typically, cpu time).  See *note
+GET-INTERNAL-TIME::.  Thanks to Jared Davis for asking to be able to
+obtain real-time reports in event summaries.
+
+A new utility, sys-call+, is similar to existing utility sys-call in
+that it executes a command.  Unlike sys-call, however, sys-call+
+returns values that include output from the command (in addition to the
+exit status), rather than simply printing the command.  See *note
+SYS-CALL+::.
+
+The new macro verify-guards+ extends the functionality of verify-guards
+by permitting macro-aliases (see *note MACRO-ALIASES-TABLE::).  See
+*note VERIFY-GUARDS+::.  Thanks to Jared Davis for requesting this
+feature and suggesting the use of make-event in its implementation.  We
+have also modified verify-guards to print a friendlier error message
+when its argument is a macro-alias.
+
+See *note LAST-PROVER-STEPS:: for a new utility that returns the number
+of prover steps most recently taken.
+
+*HEURISTIC IMPROVEMENTS*
+
+The processing of :use and :by hints has been changed in the following
+two rather subtle ways, thanks to suggestions from Sol Swords.
+
+     o For :by hints, the simplest check was an equality check, rather
+     than a more general subsumption check.  That equality check was
+     made after removing so-called "guard holders" (must-be-equal,
+     prog2$, ec-call, the) from both the previous theorem and the
+     purported theorem.  Now, guard-holder removal has been
+     strengthened, so that the results are also put into so-called
+     quote-normal form, for example replacing (cons '3 '4) by '(3 . 4).
+
+     o For a lemma-instance provided to a :use or :by hint that is a
+     :functional-instance, if a :do-not hint (see *note HINTS::) has
+     specified that preprocess-clause is not to be used, then
+     preprocessing will not be used on the constraints.
+
+We eliminated certain warnings about being "weak" for every
+:type-prescription rule whose conclusion designates that the function
+call can be equal to one of its arguments, e.g., (or (integerp (foo y))
+(equal (foo y) y)).  In many cases (such as the one above), such
+warnings about "weak" simply aren't correct.
+
+*BUG FIXES*
+
+Fixed a soundness bug that was permitting a stobj to be bound by a let
+or mv-let form, without being among the outputs of that form.  Thanks
+to Jen Davis and Dave Greve for reporting this bug.  Their report
+included an example which forms the basis for a proof of nil, included
+as a comment in the form (deflabel note-6-3 ...) in ACL2 source file
+ld.lisp.
+
+(GCL only) Fixed an obscure soundness bug due to an error in the GCL
+implementation of set-debugger-enable.  For details, see the relevant
+comment in the ACL2 source code under (deflabel note-6-3 ...).
+
+Fixed a bug in the case of a field of a (concrete) stobj that is an
+abstract stobj (see *note NESTED-STOBJS::).  Thanks to David Rager for
+bringing this bug to our attention.
+
+Splitter output for type if-intro (see *note SPLITTER::) could formerly
+occur even when at most one subgoal is generated.  This has been fixed.
+
+Fixed a bug in wof, hence in psof (which uses wof), that was causing
+the printing of a bogus error message.
+
+A small logical bug has been fixed in the logical definition of
+sys-call-status.  Formerly it always returned (mv nil state) whenever
+the oracle of the state is non-empty (see *note STATE::).
+
+Fixed a bug that was causing an error upon evaluation of the form
+(set-prover-step-limit nil).  Thanks to David Russinoff for reporting
+this error.
+
+The :measure (if supplied) is now ignored when checking redundancy with
+respect to a non-recursive definition that is not defined within a
+mutual-recursion.  (See *note REDUNDANT-EVENTS:: and see *note
+XARGS::.)  It had been possible to get a low-level ACL2 error in this
+situation.  Thanks to Jared Davis for reporting this bug with a helpful
+example.
+
+Eliminated a potential error when using comp to compile an uncompiled
+function defined under progn!, which we observed in LispWorks.
+
+*CHANGES AT THE SYSTEM LEVEL*
+
+The ACL2 sources are now publicly available between ACL2 releases,
+using svn; see the new "acl2-devel" project hosted by Google code at
+`http://acl2-devel.googlecode.com'.  Although such a copy of ACL2 is
+likely to work well with the latest svn (trunk) revision of the ACL2
+community books (see *note COMMUNITY-BOOKS::), please take seriously
+the warning message printed at startup: "The authors of ACL2 consider
+svn distributions to be experimental; they may be incomplete, fragile,
+and unable to pass our own regression."  That message also provides
+instructions for bug reports.  If you decide to use svn versions of
+either the community books or ACL2, then you should use both, as they
+tend to be kept in sync.  We fully expect ACL2 releases to continue
+from time to time, as usual.  Thanks to Jared Davis for his efforts in
+setting up the new acl2-devel project and svn repository, and to him
+and David Rager for convincing us to distribute ACL2 sources via svn
+between releases.
+
+Thanks to a suggestion from Jared Davis, over 30 built-in functions are
+now declared to be inline in order to boost performance.  (The list may
+be found by searching ACL2 source file axioms.lisp for "(declaim
+(inline".)
+
+Better support has been provided for command line arguments, especially
+those supplied directly by the user when calling ACL2.  For one,
+problems with quoting have been solved using "$@" in place of $*.
+Also, the function save-exec now allows specification of arguments,
+both for the host Lisp as well as "inert" arguments that can be passed
+along to calls of programs (as with sys-call).  A keyword argument,
+:return-from-lp, specifies a form to evaluate before quitting the
+read-eval-print loop at startup.  See *note SAVE-EXEC::.  Also see the
+source function user-args-string and its comments, source file
+acl2-init.lisp, for more information.  Thanks to Jared Davis for
+suggesting the use of "$@", as well as modifications to save-exec and
+helpful conversations about that.
+
+A rather extensive overhaul has taken place for the function proclaiming
+mechanism.  As before, this is only used when the host Lisp is GCL.
+However, building an executable is now faster for some Lisps, including
+GCL, by avoiding repeated recompilation and perhaps repeated
+initialization.
+
+(CCL only) We increased stack sizes when the host Lisp is CCL.  The
+default for recent CCL versions is equivalent to specifying `-Z 2M' on
+the command line, but saved ACL2 scripts (including experimental
+versions ACL2(h), ACL2(p), ACL2(r), and combinations of them) to `-Z
+64M', representing a 32-fold increase.  Thanks to Jared Davis for
+pointing us to community books file books/centaur/ccl-config.lsp and to
+Sol Swords for helpful discussions.
+
+(SBCL only) Fixed save-exec for host Lisp SBCL to provide the same
+export of variable SBCL_HOME that was provided in the original
+saved_acl2 script.
+
+(GCL only) We made changes, following suggestions from Camm Maguire
+(whom we thank for these suggestions), to support ACL2 builds on recent
+versions of GCL (2.6.8 and 2.6.10; we recommend against using GCL
+2.6.9, since issues there were fixed in 2.6.10).  Specifically, we no
+longer set the hole size, and we allocate contiguous pages sufficient
+to run an ACL2 regression without failing due to memory limitations.
+
+*EMACS SUPPORT*
+
+Modified file emacs/emacs-acl2.el to eliminate some warnings that were
+appearing in a recent Emacs version, replacing (end-of-buffer) by
+(goto-char (point-max)) and next-line by forward-line.  Thanks to
+Warren Hunt for bringing the warnings to our attention.
+
+*EXPERIMENTAL/ALTERNATE VERSIONS*
+
+(Allegro CL only) ACL2(h) now avoids blow-ups in hash table sizes that
+could be caused by hons-shrink-alist.  Thanks to Jared Davis for
+helping to debug this problem, and to David Rager for contributing the
+community book books/parsers/earley/earley-parser.lisp, which
+highlighted this problem.
+
+(SBCL only) Fixed a bug that was causing a Lisp break after turning on
+waterfall-parallelism.  Thanks to David Rager for confirming that our
+proposed fix is correct.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE1,  Next: NOTE2,  Prev: NOTE-6-3,  Up: RELEASE-NOTES
 
 NOTE1    Acl2 Version 1.1 Notes
 
@@ -5995,452 +6265,3 @@
      boolean-lstp     --> boolean-listp
      subst-expr1-lst-okp  --> subst-expr1-ok-listp
 
-
-File: acl2-doc-emacs.info,  Node: NOTE8,  Next: NOTE8-UPDATE,  Prev: NOTE7,  Up: RELEASE-NOTES
-
-NOTE8    ACL2 Version 1.8 (May, 1995) Notes
-
-See *note NOTE8-UPDATE:: for yet more recent changes.
-
-Guards have been eliminated from the ACL2 logic.  A summary is
-contained in this brief note.  Also see *note DEFUN-MODE:: and see
-*note SET-GUARD-CHECKING::.
-
-Guards may be included in defuns as usual but are ignored from the
-perspective of admission to the logic: functions must terminate on all
-arguments.
-
-As in Nqthm, primitive functions, e.g., + and car, logically default
-unexpected arguments to convenient values.  Thus, (+ 'abc 3) is 3 and
-(car 'abc) is nil.  See *note PROGRAMMING::, and see the documentation
-for the individual primitive functions.
-
-In contrast to earlier versions of ACL2, Version 1.8 logical functions
-are executed at Nqthm speeds even when guards have not been verified.
-In versions before 1.8, such functions were interpreted by ACL2.
-
-Colors have been eliminated.  Two "defun-modes" are supported, :program
-and :logic.  Roughly speaking, :program does what :red used to do,
-namely, allow you to prototype functions for execution without any
-proof burdens.  :Logic mode does what :blue used to do, namely, allow
-you to add a new definitional axiom to the logic.  A global
-default-defun-mode is comparable to the old default color.  The system
-comes up in :logic mode.  To change the global defun-mode, type
-:program or :logic at the top-level.  To specify the defun-mode of a
-defun locally use
-
-     (declare (xargs :mode mode)).
-
-The prompt has changed.  The initial prompt, indicating :logic mode, is
-
-     ACL2 !>
-
-If you change to :program mode the prompt becomes
-
-     ACL2 p!>
-
-Guards can be seen as having either of two roles: (a) they are a
-specification device allowing you to characterize the kinds of inputs a
-function "should" have, or (b) they are an efficiency device allowing
-logically defined functions to be executed directly in Common Lisp.  If
-a guard is specified, as with xargs :guard, then it is "verified" at
-defun-time (unless you also specify xargs :verify-guards nil).  Guard
-verification means what it always has: the input guard is shown to
-imply the guards on all subroutines in the body.  If the guards of a
-function are verified, then a call of the function on inputs satisfying
-the guard can be computed directly by Common Lisp.  Thus, verifying the
-guards on your functions will allow them to execute more efficiently.
-But it does not affect their logical behavior and since you will
-automatically get Nqthm speeds on unverified logical definitions, most
-users will probably use guards either as a specification device or only
-use them when execution efficiency is extremely important.
-
-Given the presence of guards in the system, two issues are unavoidable.
-Are guards verified as part of the defun process?  And are guards
-checked when terms are evaluated?  We answer both of those questions
-below.
-
-Roughly speaking, in its initial state the system will try to verify
-the guards of a defun if a :guard is supplied in the xargs and will not
-try otherwise.  However, guard verification in defun can be inhibited
-"locally" by supplying the xargs :verify-guards nil.  "Global"
-inhibition can be obtained via the :set-verify-guards-eagerness.  If
-you do not use the :guard xargs, you will not need to think about guard
-verification.
-
-We now turn to the evaluation of expressions.  Even if your functions
-contain no guards, the primitive functions do and hence you have the
-choice: when you submit an expression for evaluation do you mean for
-guards to be checked at runtime or not?  Put another way, do you mean
-for the expression to be evaluated in Common Lisp (if possible) or in
-the logic?  Note: If Common Lisp delivers an answer, it will be the
-same as in the logic, but it might be erroneous to execute the form in
-Common Lisp.  For example, should (car 'abc) cause a guard violation
-error or return nil?
-
-The top-level ACL2 loop has a variable which controls which sense of
-execution is provided.  To turn "guard checking on," by which we mean
-that guards are checked at runtime, execute the top-level form
-:set-guard-checking t.  To turn it off, do :set-guard-checking nil.
-The status of this variable is reflected in the prompt.
-
-     ACL2 !>
-
-means guard checking is on and
-
-     ACL2 >
-
-means guard checking is off.  The exclamation mark can be thought of as
-"barring" certain computations.  The absence of the mark suggests the
-absence of error messages or unbarred access to the logical axioms.
-Thus, for example
-
-     ACL2 !>(car 'abc)
-
-will signal an error, while
-
-     ACL2 >(car 'abc)
-
-will return nil.
-
-Note that whether or not guards are checked at runtime is independent
-of whether you are operating in :program mode or :logic mode and
-whether theorems are being proved or not.  (Although it must be added
-that functions defined in :program mode cannot help but check their
-guards because no logical definition exists.)
-
-Version 1.8 permits the verification of the guards of theorems, thus
-insuring that all instances of the theorem will evaluate without error
-in Common Lisp.  To verify the guards of a theorem named name execute
-the event
-
-     (verify-guards name).
-
-If a theorem's guards have been verified, the theorem is guaranteed to
-evaluate without error to non-nil in Common Lisp (provided resource
-errors do not arise).
-
-Caveat about verify-guards: implies is a function symbol, so in the
-term (implies p q), p cannot be assumed true when q is evaluated; they
-are both evaluated "outside."  Hence, you cannot generally verify the
-guards on a theorem if implies is used to state the hypotheses.  Use if
-instead.  In a future version of ACL2, implies will likely be a macro.
-
-See sum-list-example.lisp for a nice example of the use of Version 1.8.
-This is roughly the same as the documentation for guard-example.
-
-We have removed the capability to do "old-style-forcing" as existed
-before Version 1.5.  See *note NOTE5::.
-
-NOTE:  Some low level details have, of course, changed.  One such
-change is that there are no longer two distinct type prescriptions
-stored when a function is admitted with its guards verified.  So for
-example, the type prescription rune for binary-append is now
-
-     (:type-prescription binary-append)
-
-while in Versions 1.7 and earlier, there were two such runes:
-
-     (:type-prescription binary-append . 1)
-     (:type-prescription binary-append . 2)
-
-Nqthm-style forcing on linear arithmetic assumptions is no longer
-executed when forcing is disabled.
-
-Functional instantiation now benefits from a trick also used in Nqthm:
-once a constraint generated by a :functional-instance lemma instance
-(see *note LEMMA-INSTANCE::) has been proved on behalf of a successful
-event, it will not have to be re-proved on behalf of a later event.
-
-1+ and 1- are now macros in the logic, not functions.  Hence, for
-example, it is "safe" to use them on left-hand sides of rewrite rules,
-without invoking the common warning about the presence of nonrecursive
-function symbols.
-
-A new documentation section file-reading-example illustrates how to
-process forms in a file.
-
-A new proof-checker command forwardchain has been added; see *note
-ACL2-PC||FORWARDCHAIN::.
-
-It is now possible to use quantifiers.  See *note DEFUN-SK:: and see
-*note DEFCHOOSE::.
-
-There is a new event set-inhibit-warnings, which allows the user to
-turn off warnings of various types.  see *note SET-INHIBIT-WARNINGS::.
-
-An unsoundness relating encapsulate and :functional-instance hints has
-been remedied, with a few small effects visible at the user level.  The
-main observable effect is that defaxiom and non-local include-book
-events are no longer allowed in the scope of any encapsulate event that
-has a non-empty signature.
-
-When certify-book is called, we now require that the default defun-mode
-(see *note DEFAULT-DEFUN-MODE::) be :logic.  On a related note, the
-default defun-mode is irrelevant to include-book; the mode is always
-set to :logic initially, though it may be changed within the book and
-reverts to its original value at the conclusion of the include-book.  A
-bug in include-book prevented it from acting this way even though the
-documentation said otherwise.
-
-The documentation has been substantially improved.  A new section
-"Programming" contains documentation of many useful functions provided
-by ACL2; see *note PROGRAMMING::.  Also, the documentation has been
-"marked up" extensively.  Thus in particular, users of Mosaic will find
-many links in the documentation.
-
-The symbols force, mv-nth, and acl2-count have been added to the list
-*acl2-exports*.
-
-We now permit most names from the main Lisp package to be used as
-names, except for names that define functions, macros, or constants.
-See *note NAME::.
-
-We have changed the list of imports from the Common Lisp package to
-ACL2, i.e., the list *common-lisp-symbols-from-main-lisp-package*, to
-be exactly those external symbols of the Common Lisp package as
-specified by the draft Common Lisp standard.  In order to accommodate
-this change, we have renamed some ACL2 functions as shown below, but
-these and other ramifications of this change should be transparent to
-most ACL2 users.
-
-     warning      --> warning$
-     print-object --> print-object$
-
-Proof trees are no longer enabled by default.  To start them up,
-:start-proof-tree.
-
-We have added the capability of building smaller images.  The easiest
-way to do this on a Unix (trademark of AT&T) system is: make small.
-
-Here we will put some less important changes, additions, and so on.
-
-We have added definitions for the Common Lisp function position (for
-the test eql), as well as corresponding versions position-equal and
-position-eq that use tests equal and eq, respectively.  See *note
-POSITION::, see *note POSITION-EQUAL::, and see *note POSITION-EQ::.
-
-The defthm event rational-listp-implies-rationalp-car no longer exists.
-
-We fixed a bug in the hint mechanism that applied :by, :cases, and :use
-hints to the first induction goal when the prover reverted to proving
-the original goal by induction.
-
-We fixed a bug in the handling of (set-irrelevant-formals-ok :warn).
-
-In support of removing the old-style forcing capability, we deleted the
-initialization of state global old-style-forcing and deleted the
-definitions of recover-assumptions, recover-assumptions-from-goal,
-remove-assumptions1, remove-assumptions, and split-on-assumptions, and
-we renamed split-on-assumptions1 to split-on-assumptions.
-
-The special value 'none in the proof-checker commands claim and = has
-been replaced by :none.
-
-A bug in the handling of hints by subgoals has been fixed.  For
-example, formerly a :do-not hint could be "erased" by a :use hint on a
-subgoal.  Thanks go to Art Flatau for noticing the bug.
-
-The functions weak-termp and weak-term-listp have been deleted, and
-their calls have been replaced by corresponding calls of pseudo-termp
-and pseudo-term-listp.  The notion of pseudo-termp has been slightly
-strenthened by requiring that terms of the form (quote ...) have length
-2.
-
-Performance has been improved in various ways.  At the prover level,
-backchaining through the recognizer alist has been eliminated in order
-to significantly speed up ACL2's rewriter.  Among the other prover
-changes (of which there are several, all technical):  we no longer
-clausify the input term when a proof is interrupted in favor of
-inducting on the input term.  At the IO level, we have improved
-performance somewhat by suitable declarations and proclamations.  These
-include technical modifications to the macros mv and mv-let, and
-introduction of a macro the-mv analogous to the macro the but for forms
-returning multiple values.
-
-The function spaces now takes an extra argument, the current column.
-
-A bug in the proof-checker equiv command was fixed.
-
-The function intersectp has been deleted, because it was essentially
-duplicated by the function intersectp-equal.
-
-We now proclaim functions in AKCL and GCL before compiling books.  This
-should result in somewhat increased speed.
-
-The function repeat has been eliminated; use make-list instead.
-
-The proof-checker command expand has been fixed so that it eliminates
-let (lambda) expressions when one would expect it to.
-
-A new primitive function, mv-nth, has been introduced.  Mv-nth is
-equivalent to nth and is used in place of nth in the translation of
-mv-let expressions.  This allows the user to control the simplification
-of mv-let expressions without affecting how nth is treated.  In that
-spirit, the rewriter has been modified so that certain mv-nth
-expressions, namely those produced in the translation of (mv-let (a b
-c)(mv x y z) p), are given special treatment.
-
-A minor bug in untranslate has been fixed, which for example will fix
-the printing of conjunctions.
-
-Translate now takes a logicp argument, which indicates whether it
-enforces the restriction that :program mode functions do not occur in
-the result.
-
-The modified version of trace provided by ACL2, for use in raw Lisp,
-has been modified so that the lisp special variable *trace-alist* has a
-slightly different functionality.  This alist associates, using eq,
-symbols with the print representations of their values.  For example,
-initially *trace-alist* is a one-element list containing the pair (cons
-'state '|*the-live-state*|).  Thus, one may cons the pair (cons '*foo*
-"It's a FOO!") on to *trace-alist*; then until *foo* is defined, this
-change will have no effect, but after for example
-
-     (defconst *foo* 17)
-
-then trace will print 17 as "It's a FOO!".
-
-Trace also traces the corresponding logic function.
-
-Proof-tree display has been improved slightly in the case of successful
-proofs and certain event failures.
-
-The function positive-integer-log2 has been deleted.
-
-The macro skip-proofs now prints a warning message when it is
-encountered in the context of an encapsulate event or a book.  See
-*note SKIP-PROOFS::.
-
-Some functions related to the-fn and wormhole1 now have defun-mode
-:program, but this change is almost certain to be inconsequential to
-all users.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE8-UPDATE,  Next: NOTE9,  Prev: NOTE8,  Up: RELEASE-NOTES
-
-NOTE8-UPDATE    ACL2 Version 1.8 (Summer, 1995) Notes
-
-ACL2 can now use Ordered Binary Decision Diagram technology.  See *note
-BDD::.  There is also a proof-checker bdd command.
-
-ACL2 is now more respectful of the intention of the function hide.  In
-particular, it is more careful not to dive inside any call of hide
-during equality substitution and case splitting.
-
-The ld special (see *note LD::) ld-pre-eval-print may now be used to
-turn off printing of input forms during processing of encapsulate and
-certify-book forms, by setting it to the value :never, i.e.,
-(set-ld-pre-eval-print :never state).  See *note LD-PRE-EVAL-PRINT::.
-
-The TUTORIAL documentation section (now obsolete) has, with much help
-from Bill Young, been substantially improved to a bona fide
-introduction.
-
-The term pretty-printer has been modified to introduce (<= X Y) as an
-abbreviation for (not (< Y X)).
-
-Forward chaining and linear arithmetic now both benefit from the
-evaluation of ground subterms.
-
-A new macro set-inhibit-output-lst has been defined.  This should be
-used when setting the state global inhibit-output-lst; see *note
-SET-INHIBIT-OUTPUT-LST:: and see *note PROOF-TREE::.
-
-The test for redundancy in definitions includes the guard and type
-declarations.  See *note REDUNDANT-EVENTS::.
-
-See *note GENERALIZED-BOOLEANS:: for a discussion of a potential
-soundness problem for ACL2 related to the question:  Which Common Lisp
-functions are known to return Boolean values?
-
-Here we will put some less important changes, additions, and so on.
-
-A bug has been fixed so that now, execution of :comp t (see *note
-COMP::) correctly handles non-standard characters.
-
-A bug in digit-char-p has been fixed, so that the "default" is nil
-rather than 0.
-
-True-listp now tests the final cdr against nil using eq instead of
-equal, for improved efficiency.  The logical meaning is, however,
-unchanged.
-
-Put-assoc-equal has been added to the logic (it used to have
-:defun-mode :program, and has been documented.
-
-
-File: acl2-doc-emacs.info,  Node: NOTE9,  Prev: NOTE8-UPDATE,  Up: RELEASE-NOTES
-
-NOTE9    ACL2 Version 1.9 (Fall, 1996) Notes
-
-By default, when the system is started it is illegal to use the
-variable STATE as a formal parameter of a function definition.  The aim
-is to prevent novice users from stumbling into the Byzantine syntactic
-restrictions on that variable symbol.  Use
-
-     :set-state-ok t
-
-or, equivalently,
-
-     (set-state-ok t)
-
-to switch back to the old default mode.  See *note SET-STATE-OK::
-
-Set-state-ok is an event that affects the ACL2 defaults table (see
-*note ACL2-DEFAULTS-TABLE::).  Recall that when books are included, the
-defaults table is restored to its pre-inclusion state.  Thus, while a
-set-state-ok form will permit the book to define a state-using
-function, it will not permit the user of the book to make such a
-definition.  We recommend putting (set-state-ok t) in any book that
-defines a state using function.
-
-Books certified under Version 1.8 must be recertified under Version
-1.9.  See :DOC version.
-
-The simplifier has been made to look out for built-in clauses, whereas
-in past versions such clauses were only noticed by the "preprocessor"
-at the top of the waterfall.  THIS CHANGE MAY PREVENT OLD SCRIPTS FROM
-REPLAYING!  The undesirable side-effect is caused by the fact that
-:HINTS require you to refer to clauses by their exact name (see *note
-GOAL-SPEC::) and because the new simplifier proves more clauses than
-before, the goals produced have different names.  Thus, if a script
-uses :HINTS that refer to clauses other than "Goal", e.g., "Subgoal
-1.3" then the hint may be applied to a different subgoal than
-originally intended.
-
-The use of built-in-clauses has been made more efficient.  If a set of
-clauses arise often in a piece of work, it might be advantageous to
-build them in even if that results in a large set (hundreds?) of
-built-in clauses.  See *note BUILT-IN-CLAUSE::
-
-Wormholes can now be used in :logic mode functions. See *note WORMHOLE::
-
-It is now possible to provide "computed hints."  For example, have you
-ever wished to say "in all goals with a name like this, :use that" or
-"if this term is in the subgoal, then :use that"?  Well, see *note
-COMPUTED-HINTS:: and the extraordinarily long example in see *note
-USING-COMPUTED-HINTS::.
-
-Hide terms may be rewritten with :rewrite rules about hide.  See *note
-HIDE::, where we also now explain why hide terms are sometimes
-introduced into your proof attempts.
-
-A bug that sometimes caused the "non-lazy IF" hard error message was
-fixed.
-
-A bug that sometimes caused a hard error in forward chaining was fixed.
-
-A bug in print-rules (:pr) was fixed.
-
-We report the use of :executable-counterparts in the evaluation of
-SYNTAXP forms.
-
-Some documentation errors were fixed.
-
-A bug in parent-tree tracking in add-literal-and-pt was fixed.
-
-A bug in ok$, go$ and eval$ was fixed.
-
-Clausify now optimizes (mv-nth 'k (list x0 ... xk ... xn)) to xk.
-
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-13 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-13
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-13	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-13	2013-09-30 17:39:46.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,6 +28,455 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: NOTE8,  Next: NOTE8-UPDATE,  Prev: NOTE7,  Up: RELEASE-NOTES
+
+NOTE8    ACL2 Version 1.8 (May, 1995) Notes
+
+See *note NOTE8-UPDATE:: for yet more recent changes.
+
+Guards have been eliminated from the ACL2 logic.  A summary is
+contained in this brief note.  Also see *note DEFUN-MODE:: and see
+*note SET-GUARD-CHECKING::.
+
+Guards may be included in defuns as usual but are ignored from the
+perspective of admission to the logic: functions must terminate on all
+arguments.
+
+As in Nqthm, primitive functions, e.g., + and car, logically default
+unexpected arguments to convenient values.  Thus, (+ 'abc 3) is 3 and
+(car 'abc) is nil.  See *note PROGRAMMING::, and see the documentation
+for the individual primitive functions.
+
+In contrast to earlier versions of ACL2, Version 1.8 logical functions
+are executed at Nqthm speeds even when guards have not been verified.
+In versions before 1.8, such functions were interpreted by ACL2.
+
+Colors have been eliminated.  Two "defun-modes" are supported, :program
+and :logic.  Roughly speaking, :program does what :red used to do,
+namely, allow you to prototype functions for execution without any
+proof burdens.  :Logic mode does what :blue used to do, namely, allow
+you to add a new definitional axiom to the logic.  A global
+default-defun-mode is comparable to the old default color.  The system
+comes up in :logic mode.  To change the global defun-mode, type
+:program or :logic at the top-level.  To specify the defun-mode of a
+defun locally use
+
+     (declare (xargs :mode mode)).
+
+The prompt has changed.  The initial prompt, indicating :logic mode, is
+
+     ACL2 !>
+
+If you change to :program mode the prompt becomes
+
+     ACL2 p!>
+
+Guards can be seen as having either of two roles: (a) they are a
+specification device allowing you to characterize the kinds of inputs a
+function "should" have, or (b) they are an efficiency device allowing
+logically defined functions to be executed directly in Common Lisp.  If
+a guard is specified, as with xargs :guard, then it is "verified" at
+defun-time (unless you also specify xargs :verify-guards nil).  Guard
+verification means what it always has: the input guard is shown to
+imply the guards on all subroutines in the body.  If the guards of a
+function are verified, then a call of the function on inputs satisfying
+the guard can be computed directly by Common Lisp.  Thus, verifying the
+guards on your functions will allow them to execute more efficiently.
+But it does not affect their logical behavior and since you will
+automatically get Nqthm speeds on unverified logical definitions, most
+users will probably use guards either as a specification device or only
+use them when execution efficiency is extremely important.
+
+Given the presence of guards in the system, two issues are unavoidable.
+Are guards verified as part of the defun process?  And are guards
+checked when terms are evaluated?  We answer both of those questions
+below.
+
+Roughly speaking, in its initial state the system will try to verify
+the guards of a defun if a :guard is supplied in the xargs and will not
+try otherwise.  However, guard verification in defun can be inhibited
+"locally" by supplying the xargs :verify-guards nil.  "Global"
+inhibition can be obtained via the :set-verify-guards-eagerness.  If
+you do not use the :guard xargs, you will not need to think about guard
+verification.
+
+We now turn to the evaluation of expressions.  Even if your functions
+contain no guards, the primitive functions do and hence you have the
+choice: when you submit an expression for evaluation do you mean for
+guards to be checked at runtime or not?  Put another way, do you mean
+for the expression to be evaluated in Common Lisp (if possible) or in
+the logic?  Note: If Common Lisp delivers an answer, it will be the
+same as in the logic, but it might be erroneous to execute the form in
+Common Lisp.  For example, should (car 'abc) cause a guard violation
+error or return nil?
+
+The top-level ACL2 loop has a variable which controls which sense of
+execution is provided.  To turn "guard checking on," by which we mean
+that guards are checked at runtime, execute the top-level form
+:set-guard-checking t.  To turn it off, do :set-guard-checking nil.
+The status of this variable is reflected in the prompt.
+
+     ACL2 !>
+
+means guard checking is on and
+
+     ACL2 >
+
+means guard checking is off.  The exclamation mark can be thought of as
+"barring" certain computations.  The absence of the mark suggests the
+absence of error messages or unbarred access to the logical axioms.
+Thus, for example
+
+     ACL2 !>(car 'abc)
+
+will signal an error, while
+
+     ACL2 >(car 'abc)
+
+will return nil.
+
+Note that whether or not guards are checked at runtime is independent
+of whether you are operating in :program mode or :logic mode and
+whether theorems are being proved or not.  (Although it must be added
+that functions defined in :program mode cannot help but check their
+guards because no logical definition exists.)
+
+Version 1.8 permits the verification of the guards of theorems, thus
+insuring that all instances of the theorem will evaluate without error
+in Common Lisp.  To verify the guards of a theorem named name execute
+the event
+
+     (verify-guards name).
+
+If a theorem's guards have been verified, the theorem is guaranteed to
+evaluate without error to non-nil in Common Lisp (provided resource
+errors do not arise).
+
+Caveat about verify-guards: implies is a function symbol, so in the
+term (implies p q), p cannot be assumed true when q is evaluated; they
+are both evaluated "outside."  Hence, you cannot generally verify the
+guards on a theorem if implies is used to state the hypotheses.  Use if
+instead.  In a future version of ACL2, implies will likely be a macro.
+
+See sum-list-example.lisp for a nice example of the use of Version 1.8.
+This is roughly the same as the documentation for guard-example.
+
+We have removed the capability to do "old-style-forcing" as existed
+before Version 1.5.  See *note NOTE5::.
+
+NOTE:  Some low level details have, of course, changed.  One such
+change is that there are no longer two distinct type prescriptions
+stored when a function is admitted with its guards verified.  So for
+example, the type prescription rune for binary-append is now
+
+     (:type-prescription binary-append)
+
+while in Versions 1.7 and earlier, there were two such runes:
+
+     (:type-prescription binary-append . 1)
+     (:type-prescription binary-append . 2)
+
+Nqthm-style forcing on linear arithmetic assumptions is no longer
+executed when forcing is disabled.
+
+Functional instantiation now benefits from a trick also used in Nqthm:
+once a constraint generated by a :functional-instance lemma instance
+(see *note LEMMA-INSTANCE::) has been proved on behalf of a successful
+event, it will not have to be re-proved on behalf of a later event.
+
+1+ and 1- are now macros in the logic, not functions.  Hence, for
+example, it is "safe" to use them on left-hand sides of rewrite rules,
+without invoking the common warning about the presence of nonrecursive
+function symbols.
+
+A new documentation section file-reading-example illustrates how to
+process forms in a file.
+
+A new proof-checker command forwardchain has been added; see *note
+ACL2-PC||FORWARDCHAIN::.
+
+It is now possible to use quantifiers.  See *note DEFUN-SK:: and see
+*note DEFCHOOSE::.
+
+There is a new event set-inhibit-warnings, which allows the user to
+turn off warnings of various types.  see *note SET-INHIBIT-WARNINGS::.
+
+An unsoundness relating encapsulate and :functional-instance hints has
+been remedied, with a few small effects visible at the user level.  The
+main observable effect is that defaxiom and non-local include-book
+events are no longer allowed in the scope of any encapsulate event that
+has a non-empty signature.
+
+When certify-book is called, we now require that the default defun-mode
+(see *note DEFAULT-DEFUN-MODE::) be :logic.  On a related note, the
+default defun-mode is irrelevant to include-book; the mode is always
+set to :logic initially, though it may be changed within the book and
+reverts to its original value at the conclusion of the include-book.  A
+bug in include-book prevented it from acting this way even though the
+documentation said otherwise.
+
+The documentation has been substantially improved.  A new section
+"Programming" contains documentation of many useful functions provided
+by ACL2; see *note PROGRAMMING::.  Also, the documentation has been
+"marked up" extensively.  Thus in particular, users of Mosaic will find
+many links in the documentation.
+
+The symbols force, mv-nth, and acl2-count have been added to the list
+*acl2-exports*.
+
+We now permit most names from the main Lisp package to be used as
+names, except for names that define functions, macros, or constants.
+See *note NAME::.
+
+We have changed the list of imports from the Common Lisp package to
+ACL2, i.e., the list *common-lisp-symbols-from-main-lisp-package*, to
+be exactly those external symbols of the Common Lisp package as
+specified by the draft Common Lisp standard.  In order to accommodate
+this change, we have renamed some ACL2 functions as shown below, but
+these and other ramifications of this change should be transparent to
+most ACL2 users.
+
+     warning      --> warning$
+     print-object --> print-object$
+
+Proof trees are no longer enabled by default.  To start them up,
+:start-proof-tree.
+
+We have added the capability of building smaller images.  The easiest
+way to do this on a Unix (trademark of AT&T) system is: make small.
+
+Here we will put some less important changes, additions, and so on.
+
+We have added definitions for the Common Lisp function position (for
+the test eql), as well as corresponding versions position-equal and
+position-eq that use tests equal and eq, respectively.  See *note
+POSITION::, see *note POSITION-EQUAL::, and see *note POSITION-EQ::.
+
+The defthm event rational-listp-implies-rationalp-car no longer exists.
+
+We fixed a bug in the hint mechanism that applied :by, :cases, and :use
+hints to the first induction goal when the prover reverted to proving
+the original goal by induction.
+
+We fixed a bug in the handling of (set-irrelevant-formals-ok :warn).
+
+In support of removing the old-style forcing capability, we deleted the
+initialization of state global old-style-forcing and deleted the
+definitions of recover-assumptions, recover-assumptions-from-goal,
+remove-assumptions1, remove-assumptions, and split-on-assumptions, and
+we renamed split-on-assumptions1 to split-on-assumptions.
+
+The special value 'none in the proof-checker commands claim and = has
+been replaced by :none.
+
+A bug in the handling of hints by subgoals has been fixed.  For
+example, formerly a :do-not hint could be "erased" by a :use hint on a
+subgoal.  Thanks go to Art Flatau for noticing the bug.
+
+The functions weak-termp and weak-term-listp have been deleted, and
+their calls have been replaced by corresponding calls of pseudo-termp
+and pseudo-term-listp.  The notion of pseudo-termp has been slightly
+strenthened by requiring that terms of the form (quote ...) have length
+2.
+
+Performance has been improved in various ways.  At the prover level,
+backchaining through the recognizer alist has been eliminated in order
+to significantly speed up ACL2's rewriter.  Among the other prover
+changes (of which there are several, all technical):  we no longer
+clausify the input term when a proof is interrupted in favor of
+inducting on the input term.  At the IO level, we have improved
+performance somewhat by suitable declarations and proclamations.  These
+include technical modifications to the macros mv and mv-let, and
+introduction of a macro the-mv analogous to the macro the but for forms
+returning multiple values.
+
+The function spaces now takes an extra argument, the current column.
+
+A bug in the proof-checker equiv command was fixed.
+
+The function intersectp has been deleted, because it was essentially
+duplicated by the function intersectp-equal.
+
+We now proclaim functions in AKCL and GCL before compiling books.  This
+should result in somewhat increased speed.
+
+The function repeat has been eliminated; use make-list instead.
+
+The proof-checker command expand has been fixed so that it eliminates
+let (lambda) expressions when one would expect it to.
+
+A new primitive function, mv-nth, has been introduced.  Mv-nth is
+equivalent to nth and is used in place of nth in the translation of
+mv-let expressions.  This allows the user to control the simplification
+of mv-let expressions without affecting how nth is treated.  In that
+spirit, the rewriter has been modified so that certain mv-nth
+expressions, namely those produced in the translation of (mv-let (a b
+c)(mv x y z) p), are given special treatment.
+
+A minor bug in untranslate has been fixed, which for example will fix
+the printing of conjunctions.
+
+Translate now takes a logicp argument, which indicates whether it
+enforces the restriction that :program mode functions do not occur in
+the result.
+
+The modified version of trace provided by ACL2, for use in raw Lisp,
+has been modified so that the lisp special variable *trace-alist* has a
+slightly different functionality.  This alist associates, using eq,
+symbols with the print representations of their values.  For example,
+initially *trace-alist* is a one-element list containing the pair (cons
+'state '|*the-live-state*|).  Thus, one may cons the pair (cons '*foo*
+"It's a FOO!") on to *trace-alist*; then until *foo* is defined, this
+change will have no effect, but after for example
+
+     (defconst *foo* 17)
+
+then trace will print 17 as "It's a FOO!".
+
+Trace also traces the corresponding logic function.
+
+Proof-tree display has been improved slightly in the case of successful
+proofs and certain event failures.
+
+The function positive-integer-log2 has been deleted.
+
+The macro skip-proofs now prints a warning message when it is
+encountered in the context of an encapsulate event or a book.  See
+*note SKIP-PROOFS::.
+
+Some functions related to the-fn and wormhole1 now have defun-mode
+:program, but this change is almost certain to be inconsequential to
+all users.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE8-UPDATE,  Next: NOTE9,  Prev: NOTE8,  Up: RELEASE-NOTES
+
+NOTE8-UPDATE    ACL2 Version 1.8 (Summer, 1995) Notes
+
+ACL2 can now use Ordered Binary Decision Diagram technology.  See *note
+BDD::.  There is also a proof-checker bdd command.
+
+ACL2 is now more respectful of the intention of the function hide.  In
+particular, it is more careful not to dive inside any call of hide
+during equality substitution and case splitting.
+
+The ld special (see *note LD::) ld-pre-eval-print may now be used to
+turn off printing of input forms during processing of encapsulate and
+certify-book forms, by setting it to the value :never, i.e.,
+(set-ld-pre-eval-print :never state).  See *note LD-PRE-EVAL-PRINT::.
+
+The TUTORIAL documentation section (now obsolete) has, with much help
+from Bill Young, been substantially improved to a bona fide
+introduction.
+
+The term pretty-printer has been modified to introduce (<= X Y) as an
+abbreviation for (not (< Y X)).
+
+Forward chaining and linear arithmetic now both benefit from the
+evaluation of ground subterms.
+
+A new macro set-inhibit-output-lst has been defined.  This should be
+used when setting the state global inhibit-output-lst; see *note
+SET-INHIBIT-OUTPUT-LST:: and see *note PROOF-TREE::.
+
+The test for redundancy in definitions includes the guard and type
+declarations.  See *note REDUNDANT-EVENTS::.
+
+See *note GENERALIZED-BOOLEANS:: for a discussion of a potential
+soundness problem for ACL2 related to the question:  Which Common Lisp
+functions are known to return Boolean values?
+
+Here we will put some less important changes, additions, and so on.
+
+A bug has been fixed so that now, execution of :comp t (see *note
+COMP::) correctly handles non-standard characters.
+
+A bug in digit-char-p has been fixed, so that the "default" is nil
+rather than 0.
+
+True-listp now tests the final cdr against nil using eq instead of
+equal, for improved efficiency.  The logical meaning is, however,
+unchanged.
+
+Put-assoc-equal has been added to the logic (it used to have
+:defun-mode :program, and has been documented.
+
+
+File: acl2-doc-emacs.info,  Node: NOTE9,  Prev: NOTE8-UPDATE,  Up: RELEASE-NOTES
+
+NOTE9    ACL2 Version 1.9 (Fall, 1996) Notes
+
+By default, when the system is started it is illegal to use the
+variable STATE as a formal parameter of a function definition.  The aim
+is to prevent novice users from stumbling into the Byzantine syntactic
+restrictions on that variable symbol.  Use
+
+     :set-state-ok t
+
+or, equivalently,
+
+     (set-state-ok t)
+
+to switch back to the old default mode.  See *note SET-STATE-OK::
+
+Set-state-ok is an event that affects the ACL2 defaults table (see
+*note ACL2-DEFAULTS-TABLE::).  Recall that when books are included, the
+defaults table is restored to its pre-inclusion state.  Thus, while a
+set-state-ok form will permit the book to define a state-using
+function, it will not permit the user of the book to make such a
+definition.  We recommend putting (set-state-ok t) in any book that
+defines a state using function.
+
+Books certified under Version 1.8 must be recertified under Version
+1.9.  See :DOC version.
+
+The simplifier has been made to look out for built-in clauses, whereas
+in past versions such clauses were only noticed by the "preprocessor"
+at the top of the waterfall.  THIS CHANGE MAY PREVENT OLD SCRIPTS FROM
+REPLAYING!  The undesirable side-effect is caused by the fact that
+:HINTS require you to refer to clauses by their exact name (see *note
+GOAL-SPEC::) and because the new simplifier proves more clauses than
+before, the goals produced have different names.  Thus, if a script
+uses :HINTS that refer to clauses other than "Goal", e.g., "Subgoal
+1.3" then the hint may be applied to a different subgoal than
+originally intended.
+
+The use of built-in-clauses has been made more efficient.  If a set of
+clauses arise often in a piece of work, it might be advantageous to
+build them in even if that results in a large set (hundreds?) of
+built-in clauses.  See *note BUILT-IN-CLAUSE::
+
+Wormholes can now be used in :logic mode functions. See *note WORMHOLE::
+
+It is now possible to provide "computed hints."  For example, have you
+ever wished to say "in all goals with a name like this, :use that" or
+"if this term is in the subgoal, then :use that"?  Well, see *note
+COMPUTED-HINTS:: and the extraordinarily long example in see *note
+USING-COMPUTED-HINTS::.
+
+Hide terms may be rewritten with :rewrite rules about hide.  See *note
+HIDE::, where we also now explain why hide terms are sometimes
+introduced into your proof attempts.
+
+A bug that sometimes caused the "non-lazy IF" hard error message was
+fixed.
+
+A bug that sometimes caused a hard error in forward chaining was fixed.
+
+A bug in print-rules (:pr) was fixed.
+
+We report the use of :executable-counterparts in the evaluation of
+SYNTAXP forms.
+
+Some documentation errors were fixed.
+
+A bug in parent-tree tracking in add-literal-and-pt was fixed.
+
+A bug in ok$, go$ and eval$ was fixed.
+
+Clausify now optimizes (mv-nth 'k (list x0 ... xk ... xn)) to xk.
+
+
 File: acl2-doc-emacs.info,  Node: RULE-CLASSES,  Next: SERIALIZE,  Prev: RELEASE-NOTES,  Up: Top
 
 RULE-CLASSES    adding rules to the database
@@ -149,7 +598,7 @@
 * WELL-FOUNDED-RELATION:: show that a relation is well-founded on a set
 
 See also force, case-split, syntaxp, and bind-free for "pragmas" one
-can wrap around individual hypotheses of linear and rewrite rules to
+can wrap around individual hypotheses of certain classes of rules to
 affect how the hypothesis is relieved.
 
 Before we get into the discussion of rule classes, let us return to an
@@ -369,34 +818,38 @@
 
 BUILT-IN-CLAUSE    to build a clause into the simplifier
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  A :built-in-clause
-rule can be built from any formula other than propositional
-tautologies.  Roughly speaking, the system uses the list of built-in
-clauses as the first method of proof when attacking a new goal.  Any
-goal that is subsumed by a built in clause is proved "silently."
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
+
+     Example:
+     (defthm acl2-count-abl
+       (and (implies (and (true-listp x)
+                          (not (equal x nil)))
+                     (< (acl2-count (abl x))
+                        (acl2-count x)))
+            (implies (and (true-listp x)
+                          (not (equal nil x)))
+                     (< (acl2-count (abl x))
+                        (acl2-count x))))
+       :rule-classes :built-in-clause)
+
+A :built-in-clause rule can be built from any formula other than
+propositional tautologies.  Roughly speaking, the system uses the list
+of built-in clauses as the first method of proof when attacking a new
+goal.  Any goal that is subsumed by a built in clause is proved
+"silently."
 
 ACL2 maintains a set of "built-in" clauses that are used to
 short-circuit certain theorem proving tasks.  We discuss this at length
 below.  When a theorem is given the rule class :built-in-clause ACL2
 flattens the implies and and structure of the :corollary formula so as
-to obtain a set of formulas whose conjunction is equivalent to the
-given corollary.  It then converts each of these to clausal form and
-adds each clause to the set of built-in clauses.
-
-For example, the following :corollary (regardless of the definition of
-abl)
-
-     (and (implies (and (true-listp x)
-                        (not (equal x nil)))
-                   (< (acl2-count (abl x))
-                      (acl2-count x)))
-          (implies (and (true-listp x)
-                        (not (equal nil x)))
-                   (< (acl2-count (abl x))
-                      (acl2-count x))))
+to obtain a set of formulas whose conjunction is equivalent to the given
+corollary.  It then converts each of these to clausal form and adds each
+clause to the set of built-in clauses.
 
-will build in two clauses,
+The example above (regardless of the definition of abl) will build in
+two clauses,
 
      {(not (true-listp x))
       (equal x nil)
@@ -501,6 +954,20 @@
 
 CLAUSE-PROCESSOR    make or apply a :clause-processor rule (goal-level simplifier)
 
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
+
+     Example (which we'll return to, below):
+     (defthm correctness-of-note-fact-clause-processor
+       (implies (and (pseudo-term-listp cl)
+                     (alistp a)
+                     (evl0 (conjoin-clauses
+                            (note-fact-clause-processor cl term))
+                           a))
+                (evl0 (disjoin cl) a))
+       :rule-classes :clause-processor)
+
 Also see *note DEFINE-TRUSTED-CLAUSE-PROCESSOR:: for documentation of
 an analogous utility that does not require the clause-processor to be
 proved correct.  But please read the present documentation before
@@ -569,11 +1036,12 @@
      (defevaluator evl0 evl0-list
        ((not x) (if x y z)))
 
-ACL2 can now prove the following theorem automatically.  (Of course,
-:clause-processor rules about clause-processor functions less trivial
-than note-fact-clause-processor may require lemmas to be proved first!)
-The function disjoin takes a clause and returns its disjunction (the
-result of applying OR to its members), and conjoin-clauses applies
+ACL2 can now prove the following theorem automatically.  (This is the
+example displayed at the outset of this documentation topic.)  Of
+course, :clause-processor rules about clause-processor functions less
+trivial than note-fact-clause-processor may require lemmas to be proved
+first!  The function disjoin takes a clause and returns its disjunction
+(the result of applying OR to its members), and conjoin-clauses applies
 disjoin to every element of a given list of clauses and then conjoins
 (applies AND) to the corresponding list of resulting terms.
 
@@ -781,27 +1249,27 @@
 
 COMPOUND-RECOGNIZER    make a rule used by the typing mechanism
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example :corollary
-formula from which a :compound-recognizer rule might be built is:
-
-     Example:
-     (implies (alistp x)         When (alistp x) is assumed true,
-              (true-listp x))    add the additional hypothesis that x
-                                 is of primitive type true-listp.
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
-Before presenting the General Forms, we start with a motivating
-example.  The following provides a nice example of a
-:compound-recognizer rule that is built into ACL2.
+     Examples:
+     (defthm alistp-implies-true-listp-compound-recognizer
+       (implies (alistp x)                 ; When (alistp x) is assumed true, add
+                (true-listp x))            ; the additional hypothesis that x is
+       :rule-classes :compound-recognizer) ; of primitive type true-listp.
 
-     (defthm natp-compound-recognizer
+     (defthm natp-compound-recognizer      ; See discussion below.
        (equal (natp x)
               (and (integerp x)
                    (<= 0 x)))
        :rule-classes :compound-recognizer)
 
-To see how this rule might be useful, consider the following
-(admittedly very simple) events.
+Before presenting the General Forms, we start with a motivating
+example: the second defthm form above, which provides a nice example of
+a :compound-recognizer rule that is built into ACL2.  To see how this
+rule might be useful, consider the following (admittedly very simple)
+events.
 
      (defun triple (x)
        (* 3 x))
@@ -990,8 +1458,10 @@
 formula from which a :congruence rule might be built is:
 
      Example:
-     (implies (set-equal x y)
-              (iff (memb e x) (memb e y))).
+     (defthm set-equal-implies-iff-memb-2
+       (implies (set-equal x y)
+                (iff (memb e x) (memb e y)))
+       :rule-classes :congruence)
 
 Also see *note DEFCONG:: and see *note EQUIVALENCE::.
 
@@ -1129,14 +1599,27 @@
 how they are used to build rules from formulas.  An example :corollary
 formula from which a :definition rule might be built is:
 
-     Example:
-     (implies (true-listp x)
-              (equal (len x)
-                     (if (null x)
-                         0
+     Examples:
+     (defthm open-len-twice
+       (implies (true-listp x)
+                (equal (len x)
+                       (if (null x)
+                           0
+                         (if (null (cdr x))
+                             1
+                           (+ 2 (len (cddr x)))))))
+       :rule-classes :definition)
+
+     ; Same as above, with :controller-alist made explicit:
+     (defthm open-len-twice
+       (implies (true-listp x)
+                (equal (len x)
+                       (if (null x)
+                           0
                          (if (null (cdr x))
                              1
-                             (+ 2 (len (cddr x)))))))
+                           (+ 2 (len (cddr x)))))))
+       :rule-classes ((:definition :controller-alist ((len t)))))
 
      General Form:
      (implies hyp (equiv (fn a1 ... an) body))
@@ -1284,13 +1767,23 @@
 
 ELIM    make a destructor elimination rule
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  Here we describe the
-class of :elim rules, which is fundamentally quite different from the
-more common class of :rewrite rules.  Briefly put, a :rewrite rule
-replaces instances of its left-hand side with corresponding instances
-of its right-hand side.  But an :elim rule, on the other hand, has the
-effect of generalizing so-called "destructor" function applications to
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
+
+The following example of an :elim rule is an important one, and is built
+into ACL2.
+
+     (defaxiom car-cdr-elim
+       (implies (consp x)
+                (equal (cons (car x) (cdr x)) x))
+       :rule-classes :elim)
+
+The class of :elim rules is fundamentally quite different from the more
+common class of :rewrite rules.  Briefly put, a :rewrite rule replaces
+instances of its left-hand side with corresponding instances of its
+right-hand side.  But an :elim rule, on the other hand, has the effect
+of generalizing so-called "destructor" function applications to
 variables.  In essence, applicability of a :rewrite rule is based on
 matching its left-hand side, while applicability of an :elim rule is
 based on the presence of at least one destructor term.
@@ -1339,26 +1832,17 @@
 is typical, and we will focus on it, giving full details when we
 introduce the "General Form" below.
 
-The example above employs the following built-in :elim rule named
-car-cdr-elim.
-
-     Example:
-     (implies (consp x)                      when (car v) or (cdr v) appears
-              (equal (cons (car x) (cdr x))  in a conjecture, and v is a
-                     x))                     variable, consider replacing v by
-                                             (cons a b), for two new variables
-                                             a and b.
-
-Notice that the situation is complicated a bit by the fact that this
-replacement is only valid if the variable being replaced a cons
-structure.  Thus, when ACL2 applies car-cdr-elim to replace a variable
-v, it will split into two cases: one case in which (consp v) is true,
-in which v is replaced by (cons (car v) (cdr v)) and then (car v) and
-(cdr v) are generalized to new variables; and one case in which (consp
-v) is false.  In practice, (consp v) is often provable, perhaps even
-literally present as a hypotheses; then of course there is no need to
-introduce the second case.  That is why there is no such second case in
-the example above.
+Notice that the situation can be complicated a bit by a rule's
+hypotheses.  For example, the replacement specified by the rule
+car-cdr-elim (shown near the beginning of this discussion) is only
+valid if the variable being replaced is a cons structure.  Thus, when
+ACL2 applies car-cdr-elim to replace a variable v, it will split into
+two cases: one case in which (consp v) is true, in which v is replaced
+by (cons (car v) (cdr v)) and then (car v) and (cdr v) are generalized
+to new variables; and one case in which (consp v) is false.  In
+practice, (consp v) is often provable, perhaps even literally present
+as a hypotheses; then of course there is no need to introduce the second
+case.  That is why there is no such second case in the example above.
 
 You might find :elim rules to be useful whenever you have in mind a data
 type that can be built up from its fields with a "constructor" function
@@ -1422,18 +1906,19 @@
 
 EQUIVALENCE    mark a relation as an equivalence relation
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example :corollary
-formula from which a :equivalence rule might be built is as follows.
-(We assume that r-equal has been defined.)
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
      Example:
-     (and (booleanp (r-equal x y))
-          (r-equal x x)
-          (implies (r-equal x y) (r-equal y x))
-          (implies (and (r-equal x y)
-                        (r-equal y z))
-                   (r-equal x z))).
+     (defthm r-equal-is-an-equivalence ; assumes that r-equal has been defined
+       (and (booleanp (r-equal x y))
+            (r-equal x x)
+            (implies (r-equal x y) (r-equal y x))
+            (implies (and (r-equal x y)
+                          (r-equal y z))
+                     (r-equal x z)))
+       :rule-classes :equivalence)
 
 Also see *note DEFEQUIV::.
 
@@ -1700,22 +2185,24 @@
 
 FORWARD-CHAINING    make a rule to forward chain when a certain trigger arises
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
      Examples:
-     (defthm p-and-r-forward
-      (implies (and (p x) (r x))       ; When (p a) appears in a formula to be
-               (q (f x)))              ; simplified, try to establish (p a) and
-                                       ; (r a) and, if successful, add (q (f a))
-                                       ; to the known assumptions.
-      :rule-classes :forward-chaining)
-
-     ; Equivalent to the above:
-     (defthm p-and-r-forward
-      (implies (and (p x) (r x))
-               (q (f x)))
-      :rule-classes ((:forward-chaining :trigger-terms ((p x)))))
+
+     (defthm p-and-r-forward           ; When (p a) appears in a formula to be
+      (implies (and (p x) (r x))       ; simplified, try to establish (p a) and
+               (q (f x)))              ; (r a) and, if successful, add (q (f a))
+      :rule-classes :forward-chaining) ; to the known assumptions.
+
+     (defthm p-and-r-forward           ; as above with most defaults filled in
+       (implies (and (p x) (r x))
+                (q (f x)))
+       :rule-classes ((:forward-chaining :trigger-terms ((p x))
+                                         :corollary (implies (and (p x) (r x))
+                                                             (q (f x)))
+                                         :match-free :all)))
 
 To specify the triggering terms provide a non-empty list of terms as
 the value of the :trigger-terms field of the rule class object.
@@ -2811,21 +3298,29 @@
 
 GENERALIZE    make a rule to restrict generalizations
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example :corollary
-formula from which a :generalize rule might be built is:
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
      Example:
-     any theorem
+     (defthm integer-listp-rev
+       (implies (integer-listp x)
+                (integer-listp (rev x)))
+       :rule-classes :generalize)
 
      General Form:
      any theorem
 
-To use such a :generalize rule, the system waits until it has decided
-to generalize some term, term, by replacing it with some new variable
-v.  If any :generalize formula can be instantiated so that some
-non-variable subterm becomes term, then that instance of the formula is
-added as a hypothesis.
+To use a :generalize rule, the system waits until it has decided to
+generalize some term, term, by replacing it with some new variable v.
+If any :generalize formula can be instantiated so that some non-variable
+subterm becomes term, then that instance of the formula is added as a
+hypothesis.  Thus for the example above, if the term (rev x2) is
+generalized to the variable rv during a proof, then the following is
+added as a hypothesis when generalizing to a new goal.
+
+     (implies (integer-listp x2)
+              (integer-listp rv))
 
 At the moment, the best description of how ACL2 :generalize rules are
 used may be found in the discussion of "Generalize Rules," page 248 of
@@ -2840,10 +3335,11 @@
 INDUCTION    make a rule that suggests a certain induction
 
      Example:
-     (:induction :corollary t  ; the theorem proved is irrelevant!
-                 :pattern (* 1/2 i)
-                 :condition (and (integerp i) (>= i 0))
-                 :scheme (recursion-by-sub2 i))
+     (defthm recursion-by-sub2-induction-rule
+       t
+       :rule-classes ((:induction :pattern (* 1/2 i)
+                                  :condition (and (integerp i) (>= i 0))
+                                  :scheme (recursion-by-sub2 i))))
 
 In ACL2, as in Nqthm, the functions in a conjecture "suggest" the
 inductions considered by the system.  Because every recursive function
@@ -2881,11 +3377,11 @@
 schemes.  Such rules are called :induction rules.  The definitional
 principle automatically creates an :induction rule, named (:induction
 fn), for each admitted recursive function, fn.  It is this rule that
-links applications of fn to the induction scheme it suggests.
-Disabling (:induction fn) will prevent fn from suggesting the induction
-scheme derived from its recursive definition.  It is possible for the
-user to create additional :induction rules by using the :induction rule
-class in defthm.
+links applications of fn to the induction scheme it suggests.  Disabling
+(:induction fn) will prevent fn from suggesting the induction scheme
+derived from its recursive definition.  It is possible for the user to
+create additional :induction rules by using the :induction rule class in
+defthm.
 
 Technically we are "overloading" defthm by using it in the creation of
 :induction rules because no theorem need be proved to set up the
@@ -2975,14 +3471,14 @@
 (length x)) to (recursion-by-cddr x) and arrange for (* 1/2 (length l))
 to suggest induction on l by cddr.
 
-Observe that :induction rules require no proofs to be done.  Such a
-rule is merely a heuristic link between the :pattern term, which may
-occur in conjectures to be proved by induction, and the :scheme term,
-from which an induction scheme may be derived.  Hence, when an
-:induction rule-class is specified in a defthm event, the theorem
-proved is irrelevant.  The easiest theorem to prove is, of course, t.
-Thus, we suggest that when an :induction rule is to be created, the
-following form be used:
+Observe that :induction rules require no proofs to be done.  Such a rule
+is merely a heuristic link between the :pattern term, which may occur in
+conjectures to be proved by induction, and the :scheme term, from which
+an induction scheme may be derived.  Hence, when an :induction
+rule-class is specified in a defthm event, the theorem proved is
+irrelevant.  The easiest theorem to prove is, of course, t.  Thus, we
+suggest that when an :induction rule is to be created, the following
+form be used:
 
      (defthm name T
        :rule-classes ((:induction :pattern pat-term
@@ -2997,18 +3493,18 @@
 
 LINEAR    make some arithmetic inequality rules
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example :corollary
-formula from which a :linear rule might be built is:
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
      Example:
-     (implies (and (eqlablep e)           if inequality reasoning begins to
-                   (true-listp x))        consider how (length (member a b))
-              (<= (length (member e x))   compares to any other term, add to
-                  (length x)))            set of known inequalities the fact
-                                          that it is no larger than (length b),
-                                          provided (eqlablep a) and (true-listp b)
-                                          rewrite to t
+     (defthm length-member-leq-length       If inequality reasoning begins to
+       (implies (and (eqlablep e)           consider how (length (member a b))
+                     (true-listp x))        compares to any other term, add to
+                (<= (length (member e x))   the set of known inequalities the fact
+                    (length x)))            that it is no larger than (length b),
+       :rule-classes :linear)               provided (eqlablep a) and
+                                            (true-listp b) rewrite to t.
 
      General Form:
      (and ...
@@ -3135,12 +3631,36 @@
 
 META    make a :meta rule (a hand-written simplifier)
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  Meta rules extend the
-ACL2 simplifier with hand-written code to transform certain terms to
-equivalent ones.  To add a meta rule, the :corollary formula must
-establish that the hand-written "metafunction" preserves the meaning of
-the transformed term.
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
+
+Meta rules extend the ACL2 simplifier with hand-written code to
+transform certain terms to equivalent ones.  To add a meta rule, the
+:corollary formula must establish that the hand-written "metafunction"
+preserves the meaning of the transformed term.
+
+     Examples:
+     (defthm fn-correct-1                ; Modify the rewriter to use fn to
+       (equal (evl x a)                  ; transform terms that are calls of
+              (evl (fn x) a))            ; nth or of foo.
+       :rule-classes ((:meta :trigger-fns (nth foo))))
+
+     (defthm fn-correct-2                ; As above, but this illustrates
+       (implies (and (pseudo-termp x)    ; that without loss of generality we
+                     (alistp a))         ; may restrict x to be shaped like a
+                (equal (evl x a)         ; term and a to be an alist.
+                       (evl (fn x) a)))
+       :rule-classes ((:meta :trigger-fns (nth foo))))
+
+     (defthm fn-correct-3                ; As above (with or without the
+       (implies (and (pseudo-termp x)    ; hypotheses on x and a), with the
+                     (alistp a)          ; additional restriction that the
+                     (evl (hyp-fn x) a)) ; meaning of (hyp-fn x) is true in
+                (equal (evl x a)         ; the current context.  That is, the
+                       (evl (fn x) a)))  ; applicability of the transformation
+       :rule-classes                     ; may be dependent upon some computed
+       ((:meta :trigger-fns (nth foo)))) ; hypotheses.
 
 While our intention is that the set of ACL2 documentation topics is
 self-contained, readers might find it useful to see the following paper
@@ -3150,30 +3670,6 @@
      Smith, "Meta Reasoning in ACL2."  TPHOLs 2005, ed. J. Hurd and T.
      F. Melham, LNCS 3603, Springer-Verlag, Berlin, 2005, pp. 163-178.
 
-Example :corollary formulas from which :meta rules might be built are:
-
-     Examples:
-     (equal (evl x a)                  ; Modify the rewriter to use fn to
-            (evl (fn x) a))            ; transform terms.  The :trigger-fns
-                                       ; of the :meta rule-class specify
-                                       ; the top-most function symbols of
-                                       ; those x that are candidates for
-                                       ; this transformation.
-
-     (implies (and (pseudo-termp x)    ; As above, but this illustrates
-                   (alistp a))         ; that without loss of generality we
-              (equal (evl x a)         ; may restrict x to be shaped like a
-                     (evl (fn x) a)))  ; term and a to be an alist.
-
-     (implies (and (pseudo-termp x)    ; As above (with or without the
-                   (alistp a)          ; hypotheses on x and a) with the
-                   (evl (hyp-fn x) a)) ; additional restriction that the
-              (equal (evl x a)         ; meaning of (hyp-fn x) is true in
-                     (evl (fn x) a)))  ; the current context.  That is, the
-                                       ; applicability of the transforma-
-                                       ; tion may be dependent upon some
-                                       ; computed hypotheses.
-
 A non-nil list of function symbols must be supplied as the value of the
 :trigger-fns field in a :meta rule class object (except that a macro
 alias can stand in for a function symbol; see *note ADD-MACRO-ALIAS::).
@@ -3844,12 +4340,15 @@
 
 REFINEMENT    record that one equivalence relation refines another
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example :corollary
-formula from which a :refinement rule might be built is:
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
      Example:
-     (implies (bag-equal x y) (set-equal y x)).
+     (defthm bag-equal-refines-set-equal
+       (implies (bag-equal x y)
+                (set-equal y x))
+       :rule-classes :refinement)
 
 Also see *note DEFREFINEMENT::.
 
@@ -3893,37 +4392,53 @@
 
 REWRITE    make some :rewrite rules (possibly conditional ones)
 
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
+
 This doc topic discusses the rule-class :rewrite.  If you want a general
 discussion of how rewriting works in ACL2 and some guidance on how to
 construct effective rewrite rules, see *note
 INTRODUCTION-TO-REWRITE-RULES-PART-1:: and then see *note
 INTRODUCTION-TO-REWRITE-RULES-PART-2::.
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  Example :corollary
-formulas from which :rewrite rules might be built are:
+     Examples:
 
-     Example:
-     (equal (+ x y) (+ y x))            replace (+ a b) by (+ b a) provided
-                                        certain heuristics approve the
-                                        permutation.
-
-     (implies (true-listp x)            replace (append a nil) by a, if
-              (equal (append x nil) x)) (true-listp a) rewrites to t
-
-     (implies                           replace (member a (append b c)) by
-         (and (eqlablep e)              (member a (append c b)) in contexts
-              (true-listp x)            in which propositional equivalence
-              (true-listp y))           is sufficient, provided (eqlablep a)
-         (iff (member e (append x y))   (true-listp b) and (true-listp c)
-              (member e (append y x)))) rewrite to t and the permutative
-                                        heuristics approve
+     (defthm plus-commutes                 ; Replace (+ a b) by (+ b a) provided
+       (equal (+ x y) (+ y x)))            ; certain heuristics approve the
+                                           ; permutation.
+
+     (defthm plus-commutes                 ; equivalent to the above
+       (equal (+ x y) (+ y x))
+       :rule-classes ((:rewrite :corollary (equal (+ x y) (+ y x))
+                                :loop-stopper ((x y binary-+))
+                                :match-free :all)))
+
+     (defthm append-nil                    ; Replace (append a nil) by a, if
+       (implies (true-listp x)             ; (true-listp a) rewrites to t.
+                (equal (append x nil) x)))
+
+     (defthm append-nil                    ; as above, but with defaults and
+       (implies (true-listp x)             ; a backchain limit
+                (equal (append x nil) x))
+       :rule-classes ((:rewrite :corollary (implies (true-listp x)
+                                                    (equal (append x nil) x))
+                                :backchain-limit-lst (3) ; or equivalently, 3
+                                :match-free :all)))
+
+     (defthm member-append                 ; Replace (member e (append b c)) by
+       (implies                            ; (or (member e b) (member e c) in
+        (and                               ; contexts in which propositional
+         (true-listp x)                    ; equivalence is sufficient, provided
+         (true-listp y))                   ; b and c are true-lists.
+        (iff (member e (append x y))
+             (or (member e x) (member e y)))))
 
      * Menu:
 
 
      Related topics other than immediate subtopics:
-     * BIND-FREE:: to bind free variables of a rewrite or linear rule
+     * BIND-FREE:: to bind free variables of a rewrite, definition, or linear rule
 
      * CASE-SPLIT:: like force but immediately splits the top-level goal on the hypothesis
 
@@ -3933,7 +4448,7 @@
 
      * FREE-VARIABLES:: free variables in rules
 
-     * SYNTAXP:: attach a heuristic filter on a :rewrite, :meta, or :linear rule
+     * SYNTAXP:: attach a heuristic filter on a rule
 
      General Form:
      (and ...
@@ -5010,25 +5525,40 @@
 
 TYPE-PRESCRIPTION    make a rule that specifies the type of a term
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  Some example :corollary
-formulas from which :type-prescription rules might be built are:
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
      Examples:
-     (implies                           (nth n lst) is of type characterp
-      (and (character-listp lst)        provided the two hypotheses can
-           (< n (length lst)))          be established by type reasoning
-      (characterp (nth n lst))).
-
-     (implies                           (demodulize a lst 'value ans) is
-      (and (atom a)                     either a nonnegative integer or
-           (true-listp lst)             of the same type as ans, provided
-           (member-equal a lst))        the hyps can be established by type
-      (or (and                          reasoning
-            (integerp
-             (demodulize a lst 'value ans))
-            (>= (demodulize a lst 'value ans) 0))
-          (equal (demodulize a lst 'value ans) ans))).
+     (defthm integerp-foo                       ; Assumes that foo has been
+       (integerp (foo x y))                     ; defined; then, states that
+       :rule-classes :type-prescription)        ; (foo x y) is of type integer.
+
+     (defthm characterp-nth-type-prescription   ; (Nth n lst) is of type character
+       (implies                                 ; provided the hypotheses can be
+        (and (character-listp lst)              ; established by type reasoning.
+             (<= 0 n)
+             (< n (len lst)))
+        (characterp (nth n lst)))
+       :rule-classes :type-prescription)
+
+     (defthm characterp-nth-type-prescription-alt ; equivalent to the above
+       (implies
+        (and (character-listp lst)
+             (<= 0 n)
+             (< n (len lst)))
+        (characterp (nth n lst)))
+       :rule-classes ((:type-prescription :typed-term (nth n lst))))
+
+     (defthm demodulize-type-for-quote-value  ; (Demodulize a lst 'value ans) is
+       (implies                               ; either a nonnegative integer or
+        (and (atom a)                         ; of the same type as ans, provided
+             (true-listp lst)                 ; the hyps can be established by type
+             (member-equal a lst))            ; reasoning
+        (or (and (integerp (demodulize a lst 'value ans))
+                 (>= (demodulize a lst 'value ans) 0))
+          (equal (demodulize a lst 'value ans) ans)))
+       :rule-classes :type-prescription)
 
 To specify the term whose type (see *note TYPE-SET::) is described by
 the rule, provide that term as the value of the :typed-term field of
@@ -5085,14 +5615,14 @@
 
        (defun my-statep (x)
          (and (true-listp x)
-              (equal (length x) 2)))
+              (equal (len x) 2)))
 
 and suppose (my-statep s) occurs as a hypothesis of a
 :type-prescription rule that is being considered for use in the proof
 attempt for a conjecture with the hypothesis (my-statep s).  Since the
 hypothesis in the conjecture is rewritten, it will become the
-conjunction of (true-listp s) and (equal (length s) 2).  Those two
-terms will be assumed to have type t in the context in which the
+conjunction of (true-listp s) and (equal (len s) 2).  Those two terms
+will be assumed to have type t in the context in which the
 :type-prescription rule is tried.  But type reasoning will be unable to
 deduce that (my-statep s) has type t in this context.  Thus, either
 my-statep should be disabled (see *note DISABLE::) during the proof
@@ -5180,13 +5710,14 @@
 
 TYPE-SET-INVERTER    exhibit a new decoding for an ACL2 type-set
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
      Example Rule Class:
      (:type-set-inverter
        :corollary (equal (and (counting-number x) (not (equal x 0)))
-                         (and (integerp x) (< x 0)))
+                         (and (integerp x) (< 0 x)))
        :type-set 2)
 
      General Forms of Rule Class:
@@ -5233,21 +5764,23 @@
 
 WELL-FOUNDED-RELATION    show that a relation is well-founded on a set
 
-See *note RULE-CLASSES:: for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example :corollary
-formula from which a :well-founded-relation rule might be built is as
-follows.  (Of course, the functions pairp, lex2p, and ordinate would
-have to be defined first.)
+See *note RULE-CLASSES:: for a general discussion of rule classes,
+including how they are used to build rules from formulas and a
+discussion of the various keywords in a rule class description.
 
      Example:
-     (and (implies (pairp x) (o-p (ordinate x)))
-          (implies (and (pairp x)
-                        (pairp y)
-                        (lex2p x y))
-                   (o< (ordinate x) (ordinate y))))
-
-The above example establishes that lex2p is a well-founded relation on
-pairps.  We explain and give details below.
+     (defthm lex2p-is-well-founded-relation
+       (and (implies (pairp x) (o-p (ordinate x)))
+            (implies (and (pairp x)
+                          (pairp y)
+                          (lex2p x y))
+                     (o< (ordinate x) (ordinate y))))
+       :rule-classes :well-founded-relation)
+
+The example above creates a :well-founded-relation rule, where of course
+the functions pairp, lex2p, and ordinate would have to be defined
+first.  It establishes that lex2p is a well-founded relation on pairps.
+We explain and give details below.
 
 Exactly two general forms are recognized:
 
@@ -5506,7 +6039,7 @@
 
 In the logic this is an oracle read.
 
-Under the hood, we try to read and return a serialized object form a
+Under the hood, we try to read and return a serialized object from a
 file that was presumably created by serialize-write.  On success we
 return the contents of the file.  Any failures (e.g., file not found,
 bad file contents, etc.) will result in a hard Lisp error.
@@ -5643,6 +6176,8 @@
 
 * DECLARE-STOBJS:: declaring a formal parameter name to be a single-threaded object
 
+* NESTED-STOBJS:: using stobjs that contain stobjs
+
 * RESIZE-LIST:: list resizer in support of stobjs
 
 * STOBJ-EXAMPLE-1:: an example of the use of single-threaded objects
@@ -5657,7 +6192,7 @@
 
 * STOBJ-EXAMPLE-3:: another example of a single-threaded object
 
-* STOBJ-LET:: using stobjs that contain stobjs
+* STOBJ-LET:: See *note NESTED-STOBJS::.
 
 * WITH-LOCAL-STATE:: locally bind state
 
@@ -5751,7 +6286,7 @@
 *note STOBJ-EXAMPLE-1::.
 
 
-File: acl2-doc-emacs.info,  Node: DECLARE-STOBJS,  Next: RESIZE-LIST,  Prev: STOBJ,  Up: STOBJ
+File: acl2-doc-emacs.info,  Node: DECLARE-STOBJS,  Next: NESTED-STOBJS,  Prev: STOBJ,  Up: STOBJ
 
 DECLARE-STOBJS    declaring a formal parameter name to be a single-threaded object
 
@@ -5799,885 +6334,3 @@
 ACL2 insists on the declaration to ensure that the definition is
 processed the same way no matter what the context.
 
-
-File: acl2-doc-emacs.info,  Node: RESIZE-LIST,  Next: STOBJ-EXAMPLE-1,  Prev: DECLARE-STOBJS,  Up: STOBJ
-
-RESIZE-LIST    list resizer in support of stobjs
-
-(Resize-list lst n default-value) takes a list, lst, and a desired
-length, n, for the result list, as well as a default-value to use for
-the extra elements if n is greater than the length of lst.
-
-Resize-list has a guard of t.  This function is called in the body of
-function, resize-<a> where <a> is an array field of a stobj.  See *note
-STOBJ:: and see *note DEFSTOBJ::.
-
-
-File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-1,  Next: STOBJ-EXAMPLE-1-DEFUNS,  Prev: RESIZE-LIST,  Up: STOBJ
-
-STOBJ-EXAMPLE-1    an example of the use of single-threaded objects
-
-Suppose we want to sweep a tree and (1) count the number of interior
-nodes, (2) count the number of tips and (3) keep a record of every tip
-we encounter that is an integer.  We could use a single-threaded object
-as our "accumulator".  Such an object would have three fields, one
-holding the number of nodes seen so far, one holding the number of
-tips, and one holding all the integer tips seen.
-
-The following event declares counters to be a single-threaded object.
-
-     (defstobj counters
-       (NodeCnt     :type integer :initially 0)
-       (TipCnt      :type integer :initially 0)
-       (IntTipsSeen :type t       :initially nil))
-
-It has three fields, NodeCnt, TipCnt, and IntTipsSeen.  (As always in
-ACL2, capitalization is irrelevant in simple symbol names, so the first
-name could be written nodecnt or NODECNT, etc.) Those are the name of
-the accessor functions for the object.  The corresponding update
-functions are named update-NodeCnt, update-TipCnt and
-update-IntTipsSeen.
-
-If you do not like the default function names chosen above, there is a
-feature in the defstobj event that allows you to specify other names.
-
-If you want to see the ACL2 definitions of all the functions defined by
-this event, look at stobj-example-1-defuns.
-
-If, after this event, we evaluate the top-level "global variable"
-counters in the ACL2 read-eval-print loop we get:
-
-     ACL2 !>counters
-     <counters>
-
-Note that the value printed is "<counters>".  Actually, the value of
-counters in the logic is (0 0 NIL).  But ACL2 always prints
-single-threaded objects in this non-informative way because they are
-usually so big that to do otherwise would be unpleasant.
-
-Had you tried to evaluate the "global variable" counters before
-declaring it a single-threaded object, ACL2 would have complained that
-it does not support global variables.  So a lesson here is that once
-you have declared a new single-threaded object your top-level forms can
-reference it.  In versions of ACL2 prior to Version  2.4 the only
-variable enjoying this status was STATE.  single-threaded objects are a
-straightforward generalization of the long-implemented von Neumann
-state feature of ACL2.
-
-We can access the fields of counters as with:
-
-     ACL2 !>(NodeCnt counters)
-     0
-     ACL2 !>(IntTipsSeen counters)
-     NIL
-
-and we can set the fields of counters as with:
-
-     ACL2 !>(update-NodeCnt 3 counters)
-     <counters>
-     ACL2 !>(NodeCnt counters)
-     3
-
-Observe that when we evaluate an expression that returns a counter
-object, that object becomes the "current value" of counters.
-
-Here is a function that "converts" the counters object to its
-"ordinary" representation:
-
-     (defun show-counters (counters)
-       (declare (xargs :stobjs (counters)))
-       (list (NodeCnt counters)
-             (TipCnt counters)
-             (IntTipsSeen counters)))
-
-Observe that we _must_ declare, at the top of the defun, that we mean
-to use the formal parameter counters as a single-threaded object!  If
-we did not make this declaration, the body of show-counters would be
-processed as though counters were an ordinary object.  An error would
-be caused because the accessors used above cannot be applied to
-anything but the single-threaded object counters.  If you want to know
-why we insist on this declaration, see *note DECLARE-STOBJS::.
-
-When show-counters is admitted, the following message is printed:
-
-     Since SHOW-COUNTERS is non-recursive, its admission is trivial.  We
-     observe that the type of SHOW-COUNTERS is described by the theorem
-     (AND (CONSP (SHOW-COUNTERS COUNTERS))
-          (TRUE-LISTP (SHOW-COUNTERS COUNTERS))).
-     We used primitive type reasoning.
-
-     (SHOW-COUNTERS COUNTERS) => *.
-
-     The guard conjecture for SHOW-COUNTERS is trivial to prove.
-     SHOW-COUNTERS is compliant with Common Lisp.
-
-The line above containing the "=>" is called the "signature" of
-show-counters; it conveys the information that the first argument is
-the single-threaded object counters and the only result is an ordinary
-object.  Here is an example of another signature:
-
-     (PROCESSOR * * COUNTERS) => (MV * COUNTERS)
-
-which indicates that the function PROCESSOR (which we haven't shown
-you) takes three arguments, the third of which is the COUNTERS stobj,
-and returns two results, the second of which is the modified COUNTERS.
-
-Returning to the admission of show-counters above, the last sentence
-printed indicates that the guard conjectures for the function were
-proved.  When some argument of a function is declared to be a
-single-threaded object via the xargs :stobj, we automatically add
-(conjoin) to the guard the condition that the argument satisfy the
-recognizer for that single-threaded object.  In the case of
-show-counters the guard is (countersp counters).
-
-Here is an example of show-counters being called:
-
-     ACL2 !>(show-counters counters)
-     (3 0 NIL)
-
-This is what we would see had we set the NodeCnt field of the initial
-value of counters to 3, as we did earlier in this example.
-
-We next wish to define a function to reset the counters object.  We
-could define it this way:
-
-     (defun reset-counters (counters)
-       (declare (xargs :stobjs (counters)))
-       (let ((counters (update-NodeCnt 0 counters)))
-         (let ((counters (update-TipCnt 0 counters)))
-           (update-IntTipsSeen nil counters))))
-
-which "successively" sets the NodeCnt field to 0, then the TipCnt field
-to 0, and then the IntTipsSeen field to nil and returns the resulting
-object.
-
-However, the nest of let expressions is tedious and we use this
-definition instead.  This definition exploits a macro, here named "seq"
-(for "sequentially") which evaluates each of the forms given, binding
-their results successively to the stobj name given.
-
-     (defun reset-counters (counters)
-       (declare (xargs :stobjs (counters)))
-       (seq counters
-            (update-NodeCnt 0 counters)
-            (update-TipCnt 0 counters)
-            (update-IntTipsSeen nil counters)))
-
-This definition is syntactically identical to the one above, after macro
-expansion.  Our definition of seq is shown below and is not part of
-native ACL2.
-
-     (defmacro seq (stobj &rest rst)
-       (cond ((endp rst) stobj)
-             ((endp (cdr rst)) (car rst))
-             (t `(let ((,stobj ,(car rst)))
-                  (seq ,stobj ,@(cdr rst))))))
-
-The signature printed for reset-counters is
-
-     (RESET-COUNTERS COUNTERS) => COUNTERS.
-
-Here is an example.
-
-     ACL2 !>(show-counters counters)
-     (3 0 NIL)
-     ACL2 !>(reset-counters counters)
-     <counters>
-     ACL2 !>(show-counters counters)
-     (0 0 NIL)
-
-Here finally is a function that uses counters as a single-threaded
-accumulator to collect the desired information about the tree x.
-
-     (defun sweep-tree (x counters)
-       (declare (xargs :stobjs (counters)))
-       (cond ((atom x)
-              (seq counters
-                   (update-TipCnt (+ 1 (TipCnt counters)) counters)
-                   (if (integerp x)
-                       (update-IntTipsSeen (cons x (IntTipsSeen counters))
-                                       counters)
-                     counters)))
-             (t (seq counters
-                     (update-NodeCnt (+ 1 (NodeCnt counters)) counters)
-                     (sweep-tree (car x) counters)
-                     (sweep-tree (cdr x) counters)))))
-
-We can paraphrase this definition as follows.  If x is an atom, then
-increment the TipCnt field of counters and _then_, if x is an integer,
-add x to the IntTipsSeen field, and return counters.  On the other
-hand, if x is not an atom, then increment the NodeCnt field of
-counters, and _then_ sweep the car of x and _then_ sweep the cdr of x
-and return the result.
-
-Here is an example of its execution.  We have displayed the input tree
-in full dot notation so that the number of interior nodes is just the
-number of dots.
-
-     ACL2 !>(sweep-tree '((((a . 1) . (2 . b)) . 3)
-                          . (4 . (5 . d)))
-                        counters)
-     <counters>
-     ACL2 !>(show-counters counters)
-     (7 8 (5 4 3 2 1))
-     ACL2 !>(reset-counters counters)
-     <counters>
-     ACL2 !>(show-counters counters)
-     (0 0 NIL)
-
-The counters object has two integer fields and a field whose type is
-unrestricted.  single-threaded objects support other types of fields,
-such as arrays.  We deal with that in the stobj-example-2.  But we
-recommend that you first consider the implementation issues for the
-counters example (in stobj-example-1-implementation) and then consider
-the proof issues (in stobj-example-1-proofs).
-
-To continue the stobj tour, see *note STOBJ-EXAMPLE-2::.
-
-
-File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-1-DEFUNS,  Next: STOBJ-EXAMPLE-1-IMPLEMENTATION,  Prev: STOBJ-EXAMPLE-1,  Up: STOBJ
-
-STOBJ-EXAMPLE-1-DEFUNS    the defuns created by the counters stobj
-
-Consider the event shown in stobj-example-1:
-
-     (defstobj counters
-       (NodeCnt     :type integer :initially 0)
-       (TipCnt      :type integer :initially 0)
-       (IntTipsSeen :type t       :initially nil))
-
-Here is a complete list of the defuns added by the event.
-
-The careful reader will note that the counters argument below is _not_
-declared with the :stobjs xarg even though we insist that the argument
-be a stobj in calls of these functions.  This "mystery" is explained
-below.
-
-     (defun NodeCntp (x)                 ;;; Recognizer for 1st field
-       (declare (xargs :guard t :verify-guards t))
-       (integerp x))
-
-     (defun TipCntp (x)                  ;;; Recognizer for 2nd field
-       (declare (xargs :guard t :verify-guards t))
-       (integerp x))
-
-     (defun IntTipsSeenp (x)             ;;; Recognizer for 3rd field
-       (declare (xargs :guard t :verify-guards t) (ignore x))
-       t)
-
-     (defun countersp (counters)         ;;; Recognizer for object
-       (declare (xargs :guard t :verify-guards t))
-       (and (true-listp counters)
-            (= (length counters) 3)
-            (NodeCntp (nth 0 counters))
-            (TipCntp (nth 1 counters))
-            (IntTipsSeenp (nth 2 counters))
-            t))
-
-     (defun create-counters ()           ;;; Creator for object
-       (declare (xargs :guard t :verify-guards t))
-       (list '0 '0 'nil))
-
-     (defun NodeCnt (counters)           ;;; Accessor for 1st field
-       (declare (xargs :guard (countersp counters) :verify-guards t))
-       (nth 0 counters))
-
-     (defun update-NodeCnt (v counters)  ;;; Updater for 1st field
-       (declare (xargs :guard
-                       (and (integerp v)
-                            (countersp counters))
-                       :verify-guards t))
-       (update-nth 0 v counters))
-
-     (defun TipCnt (counters)            ;;; Accessor for 2nd field
-       (declare (xargs :guard (countersp counters) :verify-guards t))
-       (nth 1 counters))
-
-     (defun update-TipCnt (v counters)   ;;; Updater for 2nd field
-       (declare (xargs :guard
-                       (and (integerp v)
-                            (countersp counters))
-                       :verify-guards t))
-       (update-nth 1 v counters))
-
-     (defun IntTipsSeen (counters)       ;;; Accessor for 3rd field
-       (declare (xargs :guard (countersp counters) :verify-guards t))
-       (nth 2 counters))
-
-     (defun update-IntTipsSeen (v counters) ;;; Updater for 3rd field
-       (declare (xargs :guard (countersp counters) :verify-guards t))
-       (update-nth 2 v counters))
-
-Observe that there is a recognizer for each of the three fields and
-then a recognizer for the counters object itself.  Then, for each
-field, there is an accessor and an updater.
-
-Observe also that the functions are guarded so that they expect a
-countersp for their counters argument and an appropriate value for the
-new field values.
-
-You can see all of the defuns added by a defstobj event by executing
-the event and then using the :pcb! command on the stobj name.  E.g.,
-
-     ACL2 !>:pcb! counters
-
-will print the defuns above.
-
-We now clear up the "mystery" mentioned above.  Note, for example in
-TipCnt, that the formal counters is used.  From the discussion in
-stobj-example-1 it has been made clear that TipCnt can only be called
-on the counters object.  And yet, in that same discussion it was said
-that an argument is so treated only if it it declared among the :stobjs
-in the definition of the function.  So why doesn't TipCnt include
-something like (declare (xargs :stobjs (counters)))?
-
-The explanation of this mystery is as follows.  At the time TipCnt was
-defined, during the introduction of the counters stobj, the name
-"counters" was not yet a single-threaded object.  The introduction of a
-new single-threaded object occurs in three steps: (1) The new primitive
-recognizers, accessors, and updaters are introduced as "ordinary
-functions," producing their logical axiomatizations.  (2) The
-executable counterparts are defined in raw Lisp to support destructive
-updating.  (3) The new name is declared a single-threaded object to
-ensure that all future use of these primitives respects the
-single-threadedness of the object.  The functions defined as part of
-the introduction of a new single-threaded object are the only functions
-in the system that have undeclared stobj formals other than state.
-
-You may return to stobj-example-1 here.
-
-
-File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-1-IMPLEMENTATION,  Next: STOBJ-EXAMPLE-1-PROOFS,  Prev: STOBJ-EXAMPLE-1-DEFUNS,  Up: STOBJ
-
-STOBJ-EXAMPLE-1-IMPLEMENTATION    the implementation of the counters stobj
-
-the event
-
-     (defstobj counters
-       (NodeCnt     :type integer :initially 0)
-       (TipCnt      :type integer :initially 0)
-       (IntTipsSeen :type t       :initially nil))
-
-discussed in stobj-example-1, creates a Common Lisp object to represent
-the current value of counters.  That object is created by evaluating
-either of the following "raw" (non-ACL2) Common Lisp forms:
-
-     (create-counters)
-
-     (vector (make-array 1 :element-type 'integer
-                           :initial-element '0)
-             (make-array 1 :element-type 'integer
-                           :initial-element '0)
-             'nil)
-
-and the value is stored in the Common Lisp global variable named
-*the-live-counters*.
-
-Thus, the counters object is an array of length three.  The first two
-elements are arrays of size 1 and are used to hold the NodeCnt and
-TipCnt fields.  The third element is the IntTipsSeen field.  The first
-two fields are represented by arrays so that we can implement the
-integer type specification efficiently.  Generally, integers are
-"boxed" in some Common Lisp implementations, for example, GCL.
-Creating a new integer requires creating a new box to put it in.  But
-in some lisps, including GCL, the integers inside arrays of integers
-are not boxed.
-
-The function NodeCnt is defined in raw Lisp as:
-
-     (defun NodeCnt (counters)
-       (the integer
-            (aref (the (simple-array integer (1))
-                       (svref counters 0))
-                  0)))
-
-Observe that the form (svref counters 0) is evaluated to get an array
-of size 1, which is followed by a call of aref to access the 0th
-element of that array.
-
-The function update-NodeCnt is defined in raw Lisp as:
-
-     (defun update-NodeCnt (v counters)
-       (declare (type integer v))
-       (progn
-        (setf (aref (the (simple-array integer (1))
-                         (svref counters 0))
-                    0)
-              (the integer v))
-        counters))
-
-Note that when this function is called, it does not create a new vector
-of length three, but "smashes" the existing one.
-
-One way to see all the raw Lisp functions defined by a given defstobj is
-to evaluate the defstobj event and then evaluate, in the ACL2 loop, the
-expression (nth 4 (global-val 'cltl-command (w state))).  Those
-functions that contain (DECLARE (STOBJ-INLINE-FN T)) will generate
-defabbrev forms because the :inline keyword of defstobj was supplied the
-value t.  The rest will generate defuns.
-
-We now recommend that you look at stobj-example-1-proofs.
-
-
-File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-1-PROOFS,  Next: STOBJ-EXAMPLE-2,  Prev: STOBJ-EXAMPLE-1-IMPLEMENTATION,  Up: STOBJ
-
-STOBJ-EXAMPLE-1-PROOFS    some proofs involving the counters stobj
-
-Consider again the event
-
-     (defstobj counters
-       (NodeCnt     :type integer :initially 0)
-       (TipCnt      :type integer :initially 0)
-       (IntTipsSeen :type t       :initially nil))
-
-discussed in stobj-example-1, followed by the definition
-
-     (defun reset-counters (counters)
-       (declare (xargs :stobjs (counters)))
-       (seq counters
-            (update-NodeCnt 0 counters)
-            (update-TipCnt 0 counters)
-            (update-IntTipsSeen nil counters)))
-
-which, because of the seq macro in stobj-example-1, is just syntactic
-sugar for
-
-     (defun reset-counters (counters)
-       (declare (xargs :stobjs (counters)))
-       (let ((counters (update-NodeCnt 0 counters)))
-         (let ((counters (update-TipCnt 0 counters)))
-           (update-IntTipsSeen nil counters)))).
-
-Here is a simple theorem about reset-counters.
-
-     (defthm reset-counters-is-constant
-       (implies (countersp x)
-                (equal (reset-counters x)
-                       '(0 0 nil))))
-
-Before we talk about how to prove this theorem, note that the theorem
-is unusual in two respects.
-
-First, it calls reset-counters on an argument other than the variable
-counters!  That is allowed in theorems; logically speaking, the stobj
-functions are indistinguishable from ordinary functions.  Their use is
-syntactically restricted only in defuns, which might be compiled and
-run in raw Lisp.  Those restrictions allow us to implement stobj
-modification destructively.  But logically speaking, reset-counters and
-other stobj "modifying" functions just create new objects,
-constructively.
-
-Second, the theorem above explicitly provides the hypothesis that
-reset-counters is being applied to an object satisfying countersp.
-Such a hypothesis is not always required: reset-counters is total and
-will do something no matter what x is.  But in this particular case,
-the result is not '(0 0 nil) unless x is, at least, a true-list of
-length three.
-
-To make a long story short, to prove theorems about stobj functions you
-behave in exactly the way you would to prove the same theorems about the
-same functions defined without the stobj features.
-
-How can we prove the above theorem?  Unfolding the definition of
-reset-counters shows that (reset-counters x) is equal to
-
-     (update-IntTipsSeen nil
-       (update-TipCnt 0
-         (update-NodeCnt 0 x)))
-
-which in turn is
-
-     (update-nth 2 nil
-      (update-nth 1 0
-       (update-nth 0 0 x))).
-
-Opening up the definition of update-nth reduces this to
-
-     (list* 0 0 nil (cdddr x)).
-
-This is clearly equal to '(0 0 nil), provided we know that (cdddr x) is
-nil.
-
-Unfortunately, that last fact requires a lemma.  The most specific
-lemma we could provide is
-
-     (defthm special-lemma-for-counters
-       (implies (countersp x)
-                (equal (cdddr x) nil)))
-
-but if you try to prove that lemma you will find that it requires some
-reasoning about len and true-listp.  Furthermore, the special lemma
-above is of interest only for counters.
-
-The following lemma about len is the one we prefer.
-
-     (defthm equal-len-n
-       (implies (syntaxp (quotep n))
-                (equal (equal (len x) n)
-                       (if (integerp n)
-                           (if (< n 0)
-                               nil
-                             (if (equal n 0)
-                                 (atom x)
-                               (and (consp x)
-                                    (equal (len (cdr x)) (- n 1)))))
-                         nil))))
-
-This lemma will simplify any equality in which a len expression is
-equated to any explicitly given constant _n_, e.g., 3, reducing the
-equation to a conjunction of consp terms about the first _n_ cdrs.
-
-If the above lemma is available then ACL2 immediately proves
-
-     (defthm reset-counters-is-constant
-       (implies (countersp x)
-                (equal (reset-counters x)
-                       '(0 0 nil))))
-
-The point is presumably well made: proving theorems about
-single-threaded object accessors and updaters is no different than
-proving theorems about other recursively defined functions on lists.
-
-As we have seen, operations on stobjs turn into definitions involving
-nth and update-nth in the logic.  Here are two lemmas that are useful
-for simplifying terms involving nth and update-nth, which are therefore
-useful in reasoning about single-threaded objects.
-
-     (defthm update-nth-update-nth-same
-       (implies (equal (nfix i1) (nfix i2))
-                (equal (update-nth i1 v1 (update-nth i2 v2 l))
-                       (update-nth i1 v1 l))))
-
-     (defthm update-nth-update-nth-diff
-       (implies (not (equal (nfix i1) (nfix i2)))
-                (equal (update-nth i1 v1 (update-nth i2 v2 l))
-                       (update-nth i2 v2 (update-nth i1 v1 l))))
-       :rule-classes ((:rewrite :loop-stopper ((i1 i2)))))
-
-These lemmas are due to Matt Wilding.  See *note NU-REWRITER:: for a
-discussion of the efficient simplification of terms of the form (nth n
-(update-nth key val lst)), which can be critical in settings involving
-sequential bindings that commonly arise in operations involving stobjs.
-
-We now recommend that you see *note STOBJ-EXAMPLE-2::.
-
-
-File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-2,  Next: STOBJ-EXAMPLE-3,  Prev: STOBJ-EXAMPLE-1-PROOFS,  Up: STOBJ
-
-STOBJ-EXAMPLE-2    an example of the use of arrays in single-threaded objects
-
-The following event
-
-     (defstobj ms
-       (pcn  :type integer                  :initially 0)
-       (mem  :type (array integer (100000)) :initially -1)
-       (code :type t                        :initially nil))
-
-introduces a single-threaded object named ms (which stands for "machine
-state").  The object has three fields, a pcn or program counter, a mem
-or memory, and a code field.
-
-The mem field is occupied by an object initially of type (array integer
-(100000)).  Logically speaking, this is a list of length 100000, each
-element of which is an integer.  But in the underlying implementation
-of the ms object, this field is occupied by a raw Lisp array, initially
-of size 100000.
-
-You might expect the above defstobj to define the accessor function mem
-and the updater update-mem.  _That does not happen!_.
-
-The above event defines the accessor function memi and the updater
-update-memi.  These functions do not access/update the mem field of the
-ms object; they access/update the individual elements of the array in
-that field.
-
-In particular, the logical definitions of the two functions are:
-
-     (defun memi (i ms)
-       (declare (xargs :guard
-                       (and (msp ms)
-                            (integerp i)
-                            (<= 0 i)
-                            (< i (mem-length ms)))))
-       (nth i (nth 1 ms)))
-
-     (defun update-memi (i v ms)
-       (declare (xargs :guard
-                       (and (msp ms)
-                            (integerp i)
-                            (<= 0 i)
-                            (< i (mem-length ms))
-                            (integerp v))))
-       (update-nth-array 1 i v ms))
-
-For example, to access the 511th (0-based) memory location of the
-current ms you could evaluate:
-
-     ACL2 !>(memi 511 ms)
-     -1
-
-The answer is -1 initially, because that is the above-specified initial
-value of the elements of the mem array.
-
-To set that element you could do
-
-     ACL2 !>(update-memi 511 777 ms)
-     <ms>
-     ACL2 !>(memi 511 ms)
-     777
-
-The raw Lisp implementing these two functions is shown below.
-
-     (defun memi (i ms)
-       (declare (type (and fixnum (integer 0 *)) i))
-       (the integer
-            (aref (the (simple-array integer (*))
-                       (svref ms 1))
-                  (the (and fixnum (integer 0 *)) i))))
-
-     (defun update-memi (i v ms)
-       (declare (type (and fixnum (integer 0 *)) i)
-                (type integer v))
-       (progn
-        (setf (aref (the (simple-array integer (*))
-                         (svref ms 1))
-                    (the (and fixnum (integer 0 *)) i))
-              (the integer v))
-        ms))
-
-If you want to see the raw Lisp supporting a defstobj, execute the
-defstobj and then evaluate the ACL2 form (nth 4 (global-val
-'cltl-command (w state))).
-
-To continue the stobj tour, see *note STOBJ-EXAMPLE-3::.
-
-
-File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-3,  Next: STOBJ-LET,  Prev: STOBJ-EXAMPLE-2,  Up: STOBJ
-
-STOBJ-EXAMPLE-3    another example of a single-threaded object
-
-The event
-
-     (defstobj $s
-       (x :type integer :initially 0)
-       (a :type (array (integer 0 9) (3)) :initially 9 :resizable t))
-
-introduces a stobj named $S.  The stobj has two fields, X and A.  The A
-field is an array.  The X field contains an integer and is initially 0.
-The A field contains a list of integers, each between 0 and 9,
-inclusively.  (Under the hood, this "list" is actually implemented as
-an array.)  Initially, the A field has three elements, each of which is
-9.
-
-This event introduces the following sequence of function definitions:
-
-     (DEFUN XP (X) ...)               ; recognizer for X field
-     (DEFUN AP (X) ...)               ; recognizer of A field
-     (DEFUN $SP ($S) ...)             ; top-level recognizer for stobj $S
-     (DEFUN CREATE-$S NIL ...)        ; creator for stobj $S
-     (DEFUN X ($S) ...)               ; accessor for X field
-     (DEFUN UPDATE-X (V $S) ...)      ; updater for X field
-     (DEFUN A-LENGTH ($S) ...)        ; length of A field
-     (DEFUN RESIZE-A (K $S) ...)      ; resizer for A field
-     (DEFUN AI (I $S) ...)            ; accessor for A field at index I
-     (DEFUN UPDATE-AI (I V $S) ...)   ; updater for A field at index I
-
-Here is the definition of $SP:
-
-     (DEFUN $SP ($S)
-       (DECLARE (XARGS :GUARD T :VERIFY-GUARDS T))
-       (AND (TRUE-LISTP $S)
-            (= (LENGTH $S) 2)
-            (XP (NTH 0 $S))
-            (AP (NTH 1 $S))
-            T))
-
-This reveals that in order to satisfy $SP an object must be a true list
-of length 2 whose first element satisfies XP and whose second satisfies
-AP.  By printing the definition of AP one learns that it requires its
-argument to be a true list, each element of which is an integer between
-0 and 9.
-
-The initial value of stobj $S is given by zero-ary "creator" function
-CREATE-$S.  Creator functions may only be used in limited contexts.
-See *note WITH-LOCAL-STOBJ::.
-
-Here is the definition of UPDATE-AI, the updater for the A field at
-index I:
-
-     (DEFUN UPDATE-AI (I V $S)
-       (DECLARE (XARGS :GUARD
-                       (AND ($SP $S)
-                            (INTEGERP I)
-                            (<= 0 I)
-                            (< I (A-LENGTH $S))
-                            (AND (INTEGERP V) (<= 0 V) (<= V 9)))
-                       :VERIFY-GUARDS T))
-       (UPDATE-NTH-ARRAY 1 I V $S))
-
-By definition (UPDATE-NTH-ARRAY 1 I V $S) is (UPDATE-NTH 1 (UPDATE-NTH
-I V (NTH 1 $S)) $S).  This may be a little surprising but should be
-perfectly clear.
-
-First, ignore the guard, since it is irrelevant in the logic.  Reading
-from the inside out, (UPDATE-AI I V $S) extracts (NTH 1 $S), which is
-array a of $S.  (Recall that NTH is 0-based.)  The next higher
-expression in the definition above, (UPDATE-NTH I V a), "modifies" a by
-setting its Ith element to V.  Call this a'.  The next higher
-expression, (UPDATE-NTH 1 a' $S), "modifies" $S by setting its 1st
-component to a'.  Call this result $s'.  Then $s' is the result
-returned by UPDATE-AI.
-
-So the first useful observation is that from the perspective of the
-logic, the type "restrictions" on stobjs are irrelevant.  They are
-"enforced" by ACL2's guard mechanism, not by the definitions of the
-updater functions.
-
-As one might also imagine, the accessor functions do not really "care,"
-logically, whether they are applied to well-formed stobjs or not.  For
-example, (AI I $S) is defined to be (NTH I (NTH 1 $S)).
-
-Thus, you will not be able to prove that (AI 2 $S) is an integer.  That
-is,
-
-     (integerp (AI 2 $S))
-
-is not a theorem, because $S may not be well-formed.
-
-Now (integerp (AI 2 $S)) will always evaluate to T in the top-level
-ACL2 command loop, because we insist that the current value of the
-stobj $S always satisfies $SP by enforcing the guards on the updaters,
-independent of whether guard checking is on or off; see *note
-SET-GUARD-CHECKING::.  But in a theorem $S is just another variable,
-implicitly universally quantified.
-
-So (integerp (AI 2 $S)) is not a theorem because it is not true when
-the variable $S is instantiated with, say,
-
-     '(1 (0 1 TWO))
-
-because, logically speaking, (AI 2 '(1 (0 1 TWO))) evaluates to the
-symbol TWO.  That is,
-
-     (equal (AI 2 '(1 (0 1 TWO))) 'TWO)
-
-is true.
-
-However,
-
-     (implies (and ($SP $S) (< 2 (A-LENGTH $S))) (integerp (AI 2 $S)))
-
-is a theorem.  To prove it, you will have to prove a lemma about AP.
-The following will do:
-
-     (defthm ap-nth
-       (implies (and (AP x)
-                     (integerp i)
-                     (<= 0 i)
-                     (< i (len x)))
-                (integerp (nth i x)))).
-
-Similarly,
-
-     (implies (and (integerp i)
-                   (<= 0 i)
-                   (< i (A-LENGTH $S))
-                   (integerp v)
-                   (<= 0 v)
-                   (<= v 9))
-              ($SP (UPDATE-AI i v $S)))
-
-is not a theorem until you add the additional hypothesis ($SP $S).  To
-prove the resulting theorem, you will need a lemma such as the
-following.
-
-     (defthm ap-update-nth
-       (implies (and (AP a)
-                     (integerp v)
-                     (<= 0 v)
-                     (<= v 9)
-                     (integerp i)
-                     (<= 0 i)
-                     (< i (len a)))
-                (AP (update-nth i v a))))
-
-The moral here is that from the logical perspective, you must provide
-the hypotheses that, as a programmer, you think are implicit on the
-structure of your stobjs, and you must prove their invariance.  This is
-a good area for further support, perhaps in the form of a library of
-macros.
-
-_Resizing Array Fields_
-
-Recall the specification of the array field, A for the stobj $S
-introduced above:
-
-     (a :type (array (integer 0 9) (3)) :initially 9 :resizable t)
-
-Logically, this field is a list, initially of length 3.  Under the
-hood, this field is implemented using a Common Lisp array with 3
-elements.  In some applications, one may wish to lengthen an array
-field, or even (to reclaim space) to shrink an array field.  The
-defstobj event provides functions to access the current length of an
-array field and to change the array field, with default names obtained
-by suffixing the field name with "LENGTH-" or prefixing it with
-"RESIZE-," respectively.  The following log shows the uses of these
-fields in the above example.
-
-     ACL2 !>(A-LENGTH $S)
-     3
-     ACL2 !>(RESIZE-A 10 $S) ; change length of A to 10
-     <$s>
-     ACL2 !>(A-LENGTH $S)
-     10
-     ACL2 !>(AI 7 $S)        ; new elements get value from :initially
-     9
-     ACL2 !>(RESIZE-A 2 $S)  ; truncate A down to first 2 elements
-     <$s>
-     ACL2 !>(A-LENGTH $S)
-     2
-     ACL2 !>(AI 7 $S)        ; error:  access past array bound
-
-
-     ACL2 Error in TOP-LEVEL:  The guard for the function symbol AI, which
-     is (AND ($SP $S) (INTEGERP I) (<= 0 I) (< I (A-LENGTH $S))), is violated
-     by the arguments in the call (AI 7 $S).
-
-     ACL2 !>
-
-Here are the definitions of the relevant functions for the above
-example; also see *note RESIZE-LIST::.
-
-     (DEFUN A-LENGTH ($S)
-       (DECLARE (XARGS :GUARD ($SP $S) :VERIFY-GUARDS T))
-       (LEN (NTH 1 $S)))
-
-     (DEFUN RESIZE-A (K $S)
-       (DECLARE (XARGS :GUARD ($SP $S) :VERIFY-GUARDS T))
-       (UPDATE-NTH 1
-                   (RESIZE-LIST (NTH 1 $S) K 9)
-                   $S))
-
-It is important to note that the implementation of array resizing in
-ACL2 involves copying the entire array into a newly allocated space and
-thus can be quite costly if performed often.  This approach was chosen
-in order to make array access and update as efficient as possible, with
-the suspicion that for most applications, array access and update are
-considerably more frequent than resizing (especially if the programmer
-is aware of the relative costs beforehand).
-
-It should also be noted that computations of lengths of stobj array
-fields should be fast (constant-time) in all or most Common Lisp
-implementations.
-
-Finally, if :resizable t is not supplied as shown above, then an
-attempt to resize the array will result in an error.  If you do not
-intend to resize the array, it is better to omit the :resizable option
-(or to supply :resizable nil), since then the length function will be
-defined to return a constant, namely the initial length, which can
-simplify guard proofs (compare with the definition of A-LENGTH above).
-
-This completes the tour through the documentation of stobjs.  However,
-you may now wish to read the documentation for the event that
-introduces a new single-threaded object; see *note DEFSTOBJ::.
-
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-14 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-14
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-14	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-14	2013-09-30 17:39:46.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,9 +28,9 @@
 END-INFO-DIR-ENTRY
 
 
-File: acl2-doc-emacs.info,  Node: STOBJ-LET,  Next: WITH-LOCAL-STATE,  Prev: STOBJ-EXAMPLE-3,  Up: STOBJ
+File: acl2-doc-emacs.info,  Node: NESTED-STOBJS,  Next: RESIZE-LIST,  Prev: DECLARE-STOBJS,  Up: STOBJ
 
-STOBJ-LET    using stobjs that contain stobjs
+NESTED-STOBJS    using stobjs that contain stobjs
 
 For this topic we assume that you already understand the basics of
 single-threaded objects in ACL2.  See *note STOBJ::, and in particular,
@@ -59,10 +59,10 @@
 
 SECTION: Extension of defstobj to permit stobjs within stobjs
 
-Recall that the :type keyword of a defstobj field descriptor can
-specify the type of the field as a type-spec (see *note TYPE-SPEC::).
-For example, the following specifies an integer field and a field that
-is an array of bytes.
+Recall that the :type keyword of a defstobj field descriptor can be a
+"type-indicator" that specifies the type of the field as a type-spec
+(see *note TYPE-SPEC::).  For example, the following specifies an
+integer field and a field that is an array of bytes.
 
        (defstobj st
          (int-field :type integer :initially 0)
@@ -178,7 +178,7 @@
 The following form returns the result of updating the fld2 field of
 parent, which is a stobj isomorphic to child, to have a value of 3.
 Below we explain the terms "bindings", "producer variables",
-"producer", and "consumer", as well as how to understand the form above.
+"producer", and "consumer", as well as how to understand this form.
 
        (stobj-let
         ((child (fld2 parent)))  ; bindings
@@ -186,15 +186,15 @@
         (update-fld 3 child)     ; producer
         (update-fld3 'a parent)) ; consumer
 
-The four lines under "stobj-let" just above can be understood,
-respectively, as follows.
+The four lines under "stobj-let" just above can be understood as
+follows.
 
      o Bindings:
          Bind child to (fld2 parent).
      o Producer variable(s) and producer:
-         Bind the producer variable, child, to
+         Then bind the variable, child, to
          the value of the producer, (update-fld 3 child).
-     o Implicit extra step:
+     o Implicit update of parent:
          Update fld2 of parent with the producer variable, child.
      o Consumer:
          Finally, return (update-fld3 'a parent).
@@ -204,7 +204,7 @@
 
        (let ((child (fld2 parent))) ; bindings
          (let ((child (update-fld 3 child))) ; bind producer vars to producer
-           (let ((parent (update-fld2 child parent))) ; update parent
+           (let ((parent (update-fld2 child parent))) ; implicit update of parent
              (update-fld3 'a parent))))
 
 The bindings always bind distinct names to child stobjs of a unique
@@ -232,12 +232,72 @@
         (update-fld 3 child)     ; producer
         (update-fld3 'a parent)) ; consumer
 
-If you try to evaluate (either version of) the above stobj-let form in
-the top-level loop, you will get an error.  For technical reasons, ACL2
-limits stobj-let computation on "live" stobjs (as opposed to list
-structures that happen to satisfy stobj recognizers) to be within
-function bodies.  The following edited log illustrates how stobj-let
-may be used in function bodies.
+You can experiment using :trans1 to see the single-step macroexpansion
+of a stobj-let form in the logic.  For example, here is how that works
+for a stobj-let form that binds three fields and updates two of them.
+Notice that because more than one field is updated, an mv-let form is
+generated to bind the two fields to their values returned by the
+producer, rather than a let form as previously generated.  First, let's
+introduce some events.
+
+     (defstobj child1 child1-fld)
+     (defstobj child2 child2-fld)
+     (defstobj child3 child3-fld)
+     (defstobj mom
+       (fld1 :type child1)
+       (fld2 :type child2)
+       (fld3 :type child3))
+     ; Silly stub:
+     (defun update-last-op (op mom)
+       (declare (xargs :stobjs mom))
+       (declare (ignore op))
+       mom)
+     (defun new-mom (mom)
+       (declare (xargs :stobjs mom))
+       (stobj-let
+        ((child1 (fld1 mom))
+         (child2 (fld2 mom))
+         (child3 (fld3 mom)))
+        (child1 child3)
+        (let* ((child1 (update-child1-fld 'one child1))
+               (child3 (update-child3-fld 'three child3)))
+          (mv child1 child3))
+        (update-last-op 'my-compute mom)))
+
+Now let's look at the single-step macroexpansion of the above stobj-let
+form.
+
+     ACL2 !>:trans1 (stobj-let
+                     ((child1 (fld1 mom))
+                      (child2 (fld2 mom))
+                      (child3 (fld3 mom)))
+                     (child1 child3)
+                     (let* ((child1 (update-child1-fld 'one child1))
+                            (child3 (update-child3-fld 'three child3)))
+                       (mv child1 child3))
+                     (update-last-op 'my-compute mom))
+      (PROGN$
+       (LET
+        ((CHILD1 (FLD1 MOM))
+         (CHILD2 (FLD2 MOM))
+         (CHILD3 (FLD3 MOM)))
+        (DECLARE (IGNORABLE CHILD1 CHILD2 CHILD3))
+        (MV-LET
+           (CHILD1 CHILD3)
+           (CHECK-VARS-NOT-FREE (MOM)
+                                (LET* ((CHILD1 (UPDATE-CHILD1-FLD 'ONE CHILD1))
+                                       (CHILD3 (UPDATE-CHILD3-FLD 'THREE CHILD3)))
+                                      (MV CHILD1 CHILD3)))
+           (LET* ((MOM (UPDATE-FLD1 CHILD1 MOM))
+                  (MOM (UPDATE-FLD3 CHILD3 MOM)))
+                 (CHECK-VARS-NOT-FREE (CHILD1 CHILD2 CHILD3)
+                                      (UPDATE-LAST-OP 'MY-COMPUTE MOM))))))
+     ACL2 !>
+
+If you try to evaluate a stobj-let form directly in the top-level loop,
+rather than from within a function body, you will get an error.  The
+example above illustrates how stobj-let may be used in function bodies;
+here is another example, presented using an edited log.
 
        ACL2 !>(defstobj child fld)
 
@@ -286,15 +346,15 @@
 lack of a child stobj among the producer variables.  So for that
 stobj-let form, there is no implicit extra step.
 
-For the stobj-let expansion displayed earlier above, we said it was
-"approximate" for two reasons, which we give here informally.  (You can
-apply :trans1 to the stobj-let call above to see the formal expansion.)
-First, stobj-let declares the stobj-let-bound variables to be ignorable
-for the top let bindings.  Second, and more importantly, stobj-let
-imposes the following restrictions on the producer and consumer, to
-avoid the aliasing problem: it disallows references to the parent stobj
-in the producer and it also disallows references to any bound stobj
-(i.e., bound in the bindings) in the consumer.
+We labeled a stobj-let expansion above as "approximate" for two
+reasons, which we give here informally.  (Now you know how to apply
+:trans1 to that stobj-let call to see the precise expansion.)  First,
+stobj-let declares the stobj-let-bound variables to be ignorable for
+the top let bindings.  Second, and more importantly, stobj-let imposes
+the following restrictions on the producer and consumer, to avoid the
+aliasing problem: it disallows references to the parent stobj in the
+producer and it also disallows references to any bound stobj (i.e.,
+bound in the bindings) in the consumer.
 
 We conclude this section with examples based on a slight variation of
 the nested stobj example from the first section above.  These events
@@ -524,6 +584,893 @@
 ACCi-CHECK.
 
 
+File: acl2-doc-emacs.info,  Node: RESIZE-LIST,  Next: STOBJ-EXAMPLE-1,  Prev: NESTED-STOBJS,  Up: STOBJ
+
+RESIZE-LIST    list resizer in support of stobjs
+
+(Resize-list lst n default-value) takes a list, lst, and a desired
+length, n, for the result list, as well as a default-value to use for
+the extra elements if n is greater than the length of lst.
+
+Resize-list has a guard of t.  This function is called in the body of
+function, resize-<a> where <a> is an array field of a stobj.  See *note
+STOBJ:: and see *note DEFSTOBJ::.
+
+
+File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-1,  Next: STOBJ-EXAMPLE-1-DEFUNS,  Prev: RESIZE-LIST,  Up: STOBJ
+
+STOBJ-EXAMPLE-1    an example of the use of single-threaded objects
+
+Suppose we want to sweep a tree and (1) count the number of interior
+nodes, (2) count the number of tips and (3) keep a record of every tip
+we encounter that is an integer.  We could use a single-threaded object
+as our "accumulator".  Such an object would have three fields, one
+holding the number of nodes seen so far, one holding the number of
+tips, and one holding all the integer tips seen.
+
+The following event declares counters to be a single-threaded object.
+
+     (defstobj counters
+       (NodeCnt     :type integer :initially 0)
+       (TipCnt      :type integer :initially 0)
+       (IntTipsSeen :type t       :initially nil))
+
+It has three fields, NodeCnt, TipCnt, and IntTipsSeen.  (As always in
+ACL2, capitalization is irrelevant in simple symbol names, so the first
+name could be written nodecnt or NODECNT, etc.) Those are the name of
+the accessor functions for the object.  The corresponding update
+functions are named update-NodeCnt, update-TipCnt and
+update-IntTipsSeen.
+
+If you do not like the default function names chosen above, there is a
+feature in the defstobj event that allows you to specify other names.
+
+If you want to see the ACL2 definitions of all the functions defined by
+this event, look at stobj-example-1-defuns.
+
+If, after this event, we evaluate the top-level "global variable"
+counters in the ACL2 read-eval-print loop we get:
+
+     ACL2 !>counters
+     <counters>
+
+Note that the value printed is "<counters>".  Actually, the value of
+counters in the logic is (0 0 NIL).  But ACL2 always prints
+single-threaded objects in this non-informative way because they are
+usually so big that to do otherwise would be unpleasant.
+
+Had you tried to evaluate the "global variable" counters before
+declaring it a single-threaded object, ACL2 would have complained that
+it does not support global variables.  So a lesson here is that once
+you have declared a new single-threaded object your top-level forms can
+reference it.  In versions of ACL2 prior to Version  2.4 the only
+variable enjoying this status was STATE.  single-threaded objects are a
+straightforward generalization of the long-implemented von Neumann
+state feature of ACL2.
+
+We can access the fields of counters as with:
+
+     ACL2 !>(NodeCnt counters)
+     0
+     ACL2 !>(IntTipsSeen counters)
+     NIL
+
+and we can set the fields of counters as with:
+
+     ACL2 !>(update-NodeCnt 3 counters)
+     <counters>
+     ACL2 !>(NodeCnt counters)
+     3
+
+Observe that when we evaluate an expression that returns a counter
+object, that object becomes the "current value" of counters.
+
+Here is a function that "converts" the counters object to its
+"ordinary" representation:
+
+     (defun show-counters (counters)
+       (declare (xargs :stobjs (counters)))
+       (list (NodeCnt counters)
+             (TipCnt counters)
+             (IntTipsSeen counters)))
+
+Observe that we _must_ declare, at the top of the defun, that we mean
+to use the formal parameter counters as a single-threaded object!  If
+we did not make this declaration, the body of show-counters would be
+processed as though counters were an ordinary object.  An error would
+be caused because the accessors used above cannot be applied to
+anything but the single-threaded object counters.  If you want to know
+why we insist on this declaration, see *note DECLARE-STOBJS::.
+
+When show-counters is admitted, the following message is printed:
+
+     Since SHOW-COUNTERS is non-recursive, its admission is trivial.  We
+     observe that the type of SHOW-COUNTERS is described by the theorem
+     (AND (CONSP (SHOW-COUNTERS COUNTERS))
+          (TRUE-LISTP (SHOW-COUNTERS COUNTERS))).
+     We used primitive type reasoning.
+
+     (SHOW-COUNTERS COUNTERS) => *.
+
+     The guard conjecture for SHOW-COUNTERS is trivial to prove.
+     SHOW-COUNTERS is compliant with Common Lisp.
+
+The line above containing the "=>" is called the "signature" of
+show-counters; it conveys the information that the first argument is
+the single-threaded object counters and the only result is an ordinary
+object.  Here is an example of another signature:
+
+     (PROCESSOR * * COUNTERS) => (MV * COUNTERS)
+
+which indicates that the function PROCESSOR (which we haven't shown
+you) takes three arguments, the third of which is the COUNTERS stobj,
+and returns two results, the second of which is the modified COUNTERS.
+
+Returning to the admission of show-counters above, the last sentence
+printed indicates that the guard conjectures for the function were
+proved.  When some argument of a function is declared to be a
+single-threaded object via the xargs :stobj, we automatically add
+(conjoin) to the guard the condition that the argument satisfy the
+recognizer for that single-threaded object.  In the case of
+show-counters the guard is (countersp counters).
+
+Here is an example of show-counters being called:
+
+     ACL2 !>(show-counters counters)
+     (3 0 NIL)
+
+This is what we would see had we set the NodeCnt field of the initial
+value of counters to 3, as we did earlier in this example.
+
+We next wish to define a function to reset the counters object.  We
+could define it this way:
+
+     (defun reset-counters (counters)
+       (declare (xargs :stobjs (counters)))
+       (let ((counters (update-NodeCnt 0 counters)))
+         (let ((counters (update-TipCnt 0 counters)))
+           (update-IntTipsSeen nil counters))))
+
+which "successively" sets the NodeCnt field to 0, then the TipCnt field
+to 0, and then the IntTipsSeen field to nil and returns the resulting
+object.
+
+However, the nest of let expressions is tedious and we use this
+definition instead.  This definition exploits a macro, here named "seq"
+(for "sequentially") which evaluates each of the forms given, binding
+their results successively to the stobj name given.
+
+     (defun reset-counters (counters)
+       (declare (xargs :stobjs (counters)))
+       (seq counters
+            (update-NodeCnt 0 counters)
+            (update-TipCnt 0 counters)
+            (update-IntTipsSeen nil counters)))
+
+This definition is syntactically identical to the one above, after macro
+expansion.  Our definition of seq is shown below and is not part of
+native ACL2.
+
+     (defmacro seq (stobj &rest rst)
+       (cond ((endp rst) stobj)
+             ((endp (cdr rst)) (car rst))
+             (t `(let ((,stobj ,(car rst)))
+                  (seq ,stobj ,@(cdr rst))))))
+
+The signature printed for reset-counters is
+
+     (RESET-COUNTERS COUNTERS) => COUNTERS.
+
+Here is an example.
+
+     ACL2 !>(show-counters counters)
+     (3 0 NIL)
+     ACL2 !>(reset-counters counters)
+     <counters>
+     ACL2 !>(show-counters counters)
+     (0 0 NIL)
+
+Here finally is a function that uses counters as a single-threaded
+accumulator to collect the desired information about the tree x.
+
+     (defun sweep-tree (x counters)
+       (declare (xargs :stobjs (counters)))
+       (cond ((atom x)
+              (seq counters
+                   (update-TipCnt (+ 1 (TipCnt counters)) counters)
+                   (if (integerp x)
+                       (update-IntTipsSeen (cons x (IntTipsSeen counters))
+                                       counters)
+                     counters)))
+             (t (seq counters
+                     (update-NodeCnt (+ 1 (NodeCnt counters)) counters)
+                     (sweep-tree (car x) counters)
+                     (sweep-tree (cdr x) counters)))))
+
+We can paraphrase this definition as follows.  If x is an atom, then
+increment the TipCnt field of counters and _then_, if x is an integer,
+add x to the IntTipsSeen field, and return counters.  On the other
+hand, if x is not an atom, then increment the NodeCnt field of
+counters, and _then_ sweep the car of x and _then_ sweep the cdr of x
+and return the result.
+
+Here is an example of its execution.  We have displayed the input tree
+in full dot notation so that the number of interior nodes is just the
+number of dots.
+
+     ACL2 !>(sweep-tree '((((a . 1) . (2 . b)) . 3)
+                          . (4 . (5 . d)))
+                        counters)
+     <counters>
+     ACL2 !>(show-counters counters)
+     (7 8 (5 4 3 2 1))
+     ACL2 !>(reset-counters counters)
+     <counters>
+     ACL2 !>(show-counters counters)
+     (0 0 NIL)
+
+The counters object has two integer fields and a field whose type is
+unrestricted.  single-threaded objects support other types of fields,
+such as arrays.  We deal with that in the stobj-example-2.  But we
+recommend that you first consider the implementation issues for the
+counters example (in stobj-example-1-implementation) and then consider
+the proof issues (in stobj-example-1-proofs).
+
+To continue the stobj tour, see *note STOBJ-EXAMPLE-2::.
+
+
+File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-1-DEFUNS,  Next: STOBJ-EXAMPLE-1-IMPLEMENTATION,  Prev: STOBJ-EXAMPLE-1,  Up: STOBJ
+
+STOBJ-EXAMPLE-1-DEFUNS    the defuns created by the counters stobj
+
+Consider the event shown in stobj-example-1:
+
+     (defstobj counters
+       (NodeCnt     :type integer :initially 0)
+       (TipCnt      :type integer :initially 0)
+       (IntTipsSeen :type t       :initially nil))
+
+Here is a complete list of the defuns added by the event.
+
+The careful reader will note that the counters argument below is _not_
+declared with the :stobjs xarg even though we insist that the argument
+be a stobj in calls of these functions.  This "mystery" is explained
+below.
+
+     (defun NodeCntp (x)                 ;;; Recognizer for 1st field
+       (declare (xargs :guard t :verify-guards t))
+       (integerp x))
+
+     (defun TipCntp (x)                  ;;; Recognizer for 2nd field
+       (declare (xargs :guard t :verify-guards t))
+       (integerp x))
+
+     (defun IntTipsSeenp (x)             ;;; Recognizer for 3rd field
+       (declare (xargs :guard t :verify-guards t) (ignore x))
+       t)
+
+     (defun countersp (counters)         ;;; Recognizer for object
+       (declare (xargs :guard t :verify-guards t))
+       (and (true-listp counters)
+            (= (length counters) 3)
+            (NodeCntp (nth 0 counters))
+            (TipCntp (nth 1 counters))
+            (IntTipsSeenp (nth 2 counters))
+            t))
+
+     (defun create-counters ()           ;;; Creator for object
+       (declare (xargs :guard t :verify-guards t))
+       (list '0 '0 'nil))
+
+     (defun NodeCnt (counters)           ;;; Accessor for 1st field
+       (declare (xargs :guard (countersp counters) :verify-guards t))
+       (nth 0 counters))
+
+     (defun update-NodeCnt (v counters)  ;;; Updater for 1st field
+       (declare (xargs :guard
+                       (and (integerp v)
+                            (countersp counters))
+                       :verify-guards t))
+       (update-nth 0 v counters))
+
+     (defun TipCnt (counters)            ;;; Accessor for 2nd field
+       (declare (xargs :guard (countersp counters) :verify-guards t))
+       (nth 1 counters))
+
+     (defun update-TipCnt (v counters)   ;;; Updater for 2nd field
+       (declare (xargs :guard
+                       (and (integerp v)
+                            (countersp counters))
+                       :verify-guards t))
+       (update-nth 1 v counters))
+
+     (defun IntTipsSeen (counters)       ;;; Accessor for 3rd field
+       (declare (xargs :guard (countersp counters) :verify-guards t))
+       (nth 2 counters))
+
+     (defun update-IntTipsSeen (v counters) ;;; Updater for 3rd field
+       (declare (xargs :guard (countersp counters) :verify-guards t))
+       (update-nth 2 v counters))
+
+Observe that there is a recognizer for each of the three fields and
+then a recognizer for the counters object itself.  Then, for each
+field, there is an accessor and an updater.
+
+Observe also that the functions are guarded so that they expect a
+countersp for their counters argument and an appropriate value for the
+new field values.
+
+You can see all of the defuns added by a defstobj event by executing
+the event and then using the :pcb! command on the stobj name.  E.g.,
+
+     ACL2 !>:pcb! counters
+
+will print the defuns above.
+
+We now clear up the "mystery" mentioned above.  Note, for example in
+TipCnt, that the formal counters is used.  From the discussion in
+stobj-example-1 it has been made clear that TipCnt can only be called
+on the counters object.  And yet, in that same discussion it was said
+that an argument is so treated only if it it declared among the :stobjs
+in the definition of the function.  So why doesn't TipCnt include
+something like (declare (xargs :stobjs (counters)))?
+
+The explanation of this mystery is as follows.  At the time TipCnt was
+defined, during the introduction of the counters stobj, the name
+"counters" was not yet a single-threaded object.  The introduction of a
+new single-threaded object occurs in three steps: (1) The new primitive
+recognizers, accessors, and updaters are introduced as "ordinary
+functions," producing their logical axiomatizations.  (2) The
+executable counterparts are defined in raw Lisp to support destructive
+updating.  (3) The new name is declared a single-threaded object to
+ensure that all future use of these primitives respects the
+single-threadedness of the object.  The functions defined as part of
+the introduction of a new single-threaded object are the only functions
+in the system that have undeclared stobj formals other than state.
+
+You may return to stobj-example-1 here.
+
+
+File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-1-IMPLEMENTATION,  Next: STOBJ-EXAMPLE-1-PROOFS,  Prev: STOBJ-EXAMPLE-1-DEFUNS,  Up: STOBJ
+
+STOBJ-EXAMPLE-1-IMPLEMENTATION    the implementation of the counters stobj
+
+the event
+
+     (defstobj counters
+       (NodeCnt     :type integer :initially 0)
+       (TipCnt      :type integer :initially 0)
+       (IntTipsSeen :type t       :initially nil))
+
+discussed in stobj-example-1, creates a Common Lisp object to represent
+the current value of counters.  That object is created by evaluating
+either of the following "raw" (non-ACL2) Common Lisp forms:
+
+     (create-counters)
+
+     (vector (make-array 1 :element-type 'integer
+                           :initial-element '0)
+             (make-array 1 :element-type 'integer
+                           :initial-element '0)
+             'nil)
+
+and the value is stored in the Common Lisp global variable named
+*the-live-counters*.
+
+Thus, the counters object is an array of length three.  The first two
+elements are arrays of size 1 and are used to hold the NodeCnt and
+TipCnt fields.  The third element is the IntTipsSeen field.  The first
+two fields are represented by arrays so that we can implement the
+integer type specification efficiently.  Generally, integers are
+"boxed" in some Common Lisp implementations, for example, GCL.
+Creating a new integer requires creating a new box to put it in.  But
+in some lisps, including GCL, the integers inside arrays of integers
+are not boxed.
+
+The function NodeCnt is defined in raw Lisp as:
+
+     (defun NodeCnt (counters)
+       (the integer
+            (aref (the (simple-array integer (1))
+                       (svref counters 0))
+                  0)))
+
+Observe that the form (svref counters 0) is evaluated to get an array
+of size 1, which is followed by a call of aref to access the 0th
+element of that array.
+
+The function update-NodeCnt is defined in raw Lisp as:
+
+     (defun update-NodeCnt (v counters)
+       (declare (type integer v))
+       (progn
+        (setf (aref (the (simple-array integer (1))
+                         (svref counters 0))
+                    0)
+              (the integer v))
+        counters))
+
+Note that when this function is called, it does not create a new vector
+of length three, but "smashes" the existing one.
+
+One way to see all the raw Lisp functions defined by a given defstobj is
+to evaluate the defstobj event and then evaluate, in the ACL2 loop, the
+expression (nth 4 (global-val 'cltl-command (w state))).  Those
+functions that contain (DECLARE (STOBJ-INLINE-FN T)) will generate
+defabbrev forms because the :inline keyword of defstobj was supplied the
+value t.  The rest will generate defuns.
+
+We now recommend that you look at stobj-example-1-proofs.
+
+
+File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-1-PROOFS,  Next: STOBJ-EXAMPLE-2,  Prev: STOBJ-EXAMPLE-1-IMPLEMENTATION,  Up: STOBJ
+
+STOBJ-EXAMPLE-1-PROOFS    some proofs involving the counters stobj
+
+Consider again the event
+
+     (defstobj counters
+       (NodeCnt     :type integer :initially 0)
+       (TipCnt      :type integer :initially 0)
+       (IntTipsSeen :type t       :initially nil))
+
+discussed in stobj-example-1, followed by the definition
+
+     (defun reset-counters (counters)
+       (declare (xargs :stobjs (counters)))
+       (seq counters
+            (update-NodeCnt 0 counters)
+            (update-TipCnt 0 counters)
+            (update-IntTipsSeen nil counters)))
+
+which, because of the seq macro in stobj-example-1, is just syntactic
+sugar for
+
+     (defun reset-counters (counters)
+       (declare (xargs :stobjs (counters)))
+       (let ((counters (update-NodeCnt 0 counters)))
+         (let ((counters (update-TipCnt 0 counters)))
+           (update-IntTipsSeen nil counters)))).
+
+Here is a simple theorem about reset-counters.
+
+     (defthm reset-counters-is-constant
+       (implies (countersp x)
+                (equal (reset-counters x)
+                       '(0 0 nil))))
+
+Before we talk about how to prove this theorem, note that the theorem
+is unusual in two respects.
+
+First, it calls reset-counters on an argument other than the variable
+counters!  That is allowed in theorems; logically speaking, the stobj
+functions are indistinguishable from ordinary functions.  Their use is
+syntactically restricted only in defuns, which might be compiled and
+run in raw Lisp.  Those restrictions allow us to implement stobj
+modification destructively.  But logically speaking, reset-counters and
+other stobj "modifying" functions just create new objects,
+constructively.
+
+Second, the theorem above explicitly provides the hypothesis that
+reset-counters is being applied to an object satisfying countersp.
+Such a hypothesis is not always required: reset-counters is total and
+will do something no matter what x is.  But in this particular case,
+the result is not '(0 0 nil) unless x is, at least, a true-list of
+length three.
+
+To make a long story short, to prove theorems about stobj functions you
+behave in exactly the way you would to prove the same theorems about the
+same functions defined without the stobj features.
+
+How can we prove the above theorem?  Unfolding the definition of
+reset-counters shows that (reset-counters x) is equal to
+
+     (update-IntTipsSeen nil
+       (update-TipCnt 0
+         (update-NodeCnt 0 x)))
+
+which in turn is
+
+     (update-nth 2 nil
+      (update-nth 1 0
+       (update-nth 0 0 x))).
+
+Opening up the definition of update-nth reduces this to
+
+     (list* 0 0 nil (cdddr x)).
+
+This is clearly equal to '(0 0 nil), provided we know that (cdddr x) is
+nil.
+
+Unfortunately, that last fact requires a lemma.  The most specific
+lemma we could provide is
+
+     (defthm special-lemma-for-counters
+       (implies (countersp x)
+                (equal (cdddr x) nil)))
+
+but if you try to prove that lemma you will find that it requires some
+reasoning about len and true-listp.  Furthermore, the special lemma
+above is of interest only for counters.
+
+The following lemma about len is the one we prefer.
+
+     (defthm equal-len-n
+       (implies (syntaxp (quotep n))
+                (equal (equal (len x) n)
+                       (if (integerp n)
+                           (if (< n 0)
+                               nil
+                             (if (equal n 0)
+                                 (atom x)
+                               (and (consp x)
+                                    (equal (len (cdr x)) (- n 1)))))
+                         nil))))
+
+This lemma will simplify any equality in which a len expression is
+equated to any explicitly given constant _n_, e.g., 3, reducing the
+equation to a conjunction of consp terms about the first _n_ cdrs.
+
+If the above lemma is available then ACL2 immediately proves
+
+     (defthm reset-counters-is-constant
+       (implies (countersp x)
+                (equal (reset-counters x)
+                       '(0 0 nil))))
+
+The point is presumably well made: proving theorems about
+single-threaded object accessors and updaters is no different than
+proving theorems about other recursively defined functions on lists.
+
+As we have seen, operations on stobjs turn into definitions involving
+nth and update-nth in the logic.  Here are two lemmas that are useful
+for simplifying terms involving nth and update-nth, which are therefore
+useful in reasoning about single-threaded objects.
+
+     (defthm update-nth-update-nth-same
+       (implies (equal (nfix i1) (nfix i2))
+                (equal (update-nth i1 v1 (update-nth i2 v2 l))
+                       (update-nth i1 v1 l))))
+
+     (defthm update-nth-update-nth-diff
+       (implies (not (equal (nfix i1) (nfix i2)))
+                (equal (update-nth i1 v1 (update-nth i2 v2 l))
+                       (update-nth i2 v2 (update-nth i1 v1 l))))
+       :rule-classes ((:rewrite :loop-stopper ((i1 i2)))))
+
+These lemmas are due to Matt Wilding.  See *note NU-REWRITER:: for a
+discussion of the efficient simplification of terms of the form (nth n
+(update-nth key val lst)), which can be critical in settings involving
+sequential bindings that commonly arise in operations involving stobjs.
+
+We now recommend that you see *note STOBJ-EXAMPLE-2::.
+
+
+File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-2,  Next: STOBJ-EXAMPLE-3,  Prev: STOBJ-EXAMPLE-1-PROOFS,  Up: STOBJ
+
+STOBJ-EXAMPLE-2    an example of the use of arrays in single-threaded objects
+
+The following event
+
+     (defstobj ms
+       (pcn  :type integer                  :initially 0)
+       (mem  :type (array integer (100000)) :initially -1)
+       (code :type t                        :initially nil))
+
+introduces a single-threaded object named ms (which stands for "machine
+state").  The object has three fields, a pcn or program counter, a mem
+or memory, and a code field.
+
+The mem field is occupied by an object initially of type (array integer
+(100000)).  Logically speaking, this is a list of length 100000, each
+element of which is an integer.  But in the underlying implementation
+of the ms object, this field is occupied by a raw Lisp array, initially
+of size 100000.
+
+You might expect the above defstobj to define the accessor function mem
+and the updater update-mem.  _That does not happen!_.
+
+The above event defines the accessor function memi and the updater
+update-memi.  These functions do not access/update the mem field of the
+ms object; they access/update the individual elements of the array in
+that field.
+
+In particular, the logical definitions of the two functions are:
+
+     (defun memi (i ms)
+       (declare (xargs :guard
+                       (and (msp ms)
+                            (integerp i)
+                            (<= 0 i)
+                            (< i (mem-length ms)))))
+       (nth i (nth 1 ms)))
+
+     (defun update-memi (i v ms)
+       (declare (xargs :guard
+                       (and (msp ms)
+                            (integerp i)
+                            (<= 0 i)
+                            (< i (mem-length ms))
+                            (integerp v))))
+       (update-nth-array 1 i v ms))
+
+For example, to access the 511th (0-based) memory location of the
+current ms you could evaluate:
+
+     ACL2 !>(memi 511 ms)
+     -1
+
+The answer is -1 initially, because that is the above-specified initial
+value of the elements of the mem array.
+
+To set that element you could do
+
+     ACL2 !>(update-memi 511 777 ms)
+     <ms>
+     ACL2 !>(memi 511 ms)
+     777
+
+The raw Lisp implementing these two functions is shown below.
+
+     (defun memi (i ms)
+       (declare (type (and fixnum (integer 0 *)) i))
+       (the integer
+            (aref (the (simple-array integer (*))
+                       (svref ms 1))
+                  (the (and fixnum (integer 0 *)) i))))
+
+     (defun update-memi (i v ms)
+       (declare (type (and fixnum (integer 0 *)) i)
+                (type integer v))
+       (progn
+        (setf (aref (the (simple-array integer (*))
+                         (svref ms 1))
+                    (the (and fixnum (integer 0 *)) i))
+              (the integer v))
+        ms))
+
+If you want to see the raw Lisp supporting a defstobj, execute the
+defstobj and then evaluate the ACL2 form (nth 4 (global-val
+'cltl-command (w state))).
+
+To continue the stobj tour, see *note STOBJ-EXAMPLE-3::.
+
+
+File: acl2-doc-emacs.info,  Node: STOBJ-EXAMPLE-3,  Next: STOBJ-LET,  Prev: STOBJ-EXAMPLE-2,  Up: STOBJ
+
+STOBJ-EXAMPLE-3    another example of a single-threaded object
+
+The event
+
+     (defstobj $s
+       (x :type integer :initially 0)
+       (a :type (array (integer 0 9) (3)) :initially 9 :resizable t))
+
+introduces a stobj named $S.  The stobj has two fields, X and A.  The A
+field is an array.  The X field contains an integer and is initially 0.
+The A field contains a list of integers, each between 0 and 9,
+inclusively.  (Under the hood, this "list" is actually implemented as
+an array.)  Initially, the A field has three elements, each of which is
+9.
+
+This event introduces the following sequence of function definitions:
+
+     (DEFUN XP (X) ...)               ; recognizer for X field
+     (DEFUN AP (X) ...)               ; recognizer of A field
+     (DEFUN $SP ($S) ...)             ; top-level recognizer for stobj $S
+     (DEFUN CREATE-$S NIL ...)        ; creator for stobj $S
+     (DEFUN X ($S) ...)               ; accessor for X field
+     (DEFUN UPDATE-X (V $S) ...)      ; updater for X field
+     (DEFUN A-LENGTH ($S) ...)        ; length of A field
+     (DEFUN RESIZE-A (K $S) ...)      ; resizer for A field
+     (DEFUN AI (I $S) ...)            ; accessor for A field at index I
+     (DEFUN UPDATE-AI (I V $S) ...)   ; updater for A field at index I
+
+Here is the definition of $SP:
+
+     (DEFUN $SP ($S)
+       (DECLARE (XARGS :GUARD T :VERIFY-GUARDS T))
+       (AND (TRUE-LISTP $S)
+            (= (LENGTH $S) 2)
+            (XP (NTH 0 $S))
+            (AP (NTH 1 $S))
+            T))
+
+This reveals that in order to satisfy $SP an object must be a true list
+of length 2 whose first element satisfies XP and whose second satisfies
+AP.  By printing the definition of AP one learns that it requires its
+argument to be a true list, each element of which is an integer between
+0 and 9.
+
+The initial value of stobj $S is given by zero-ary "creator" function
+CREATE-$S.  Creator functions may only be used in limited contexts.
+See *note WITH-LOCAL-STOBJ::.
+
+Here is the definition of UPDATE-AI, the updater for the A field at
+index I:
+
+     (DEFUN UPDATE-AI (I V $S)
+       (DECLARE (XARGS :GUARD
+                       (AND ($SP $S)
+                            (INTEGERP I)
+                            (<= 0 I)
+                            (< I (A-LENGTH $S))
+                            (AND (INTEGERP V) (<= 0 V) (<= V 9)))
+                       :VERIFY-GUARDS T))
+       (UPDATE-NTH-ARRAY 1 I V $S))
+
+By definition (UPDATE-NTH-ARRAY 1 I V $S) is (UPDATE-NTH 1 (UPDATE-NTH
+I V (NTH 1 $S)) $S).  This may be a little surprising but should be
+perfectly clear.
+
+First, ignore the guard, since it is irrelevant in the logic.  Reading
+from the inside out, (UPDATE-AI I V $S) extracts (NTH 1 $S), which is
+array a of $S.  (Recall that NTH is 0-based.)  The next higher
+expression in the definition above, (UPDATE-NTH I V a), "modifies" a by
+setting its Ith element to V.  Call this a'.  The next higher
+expression, (UPDATE-NTH 1 a' $S), "modifies" $S by setting its 1st
+component to a'.  Call this result $s'.  Then $s' is the result
+returned by UPDATE-AI.
+
+So the first useful observation is that from the perspective of the
+logic, the type "restrictions" on stobjs are irrelevant.  They are
+"enforced" by ACL2's guard mechanism, not by the definitions of the
+updater functions.
+
+As one might also imagine, the accessor functions do not really "care,"
+logically, whether they are applied to well-formed stobjs or not.  For
+example, (AI I $S) is defined to be (NTH I (NTH 1 $S)).
+
+Thus, you will not be able to prove that (AI 2 $S) is an integer.  That
+is,
+
+     (integerp (AI 2 $S))
+
+is not a theorem, because $S may not be well-formed.
+
+Now (integerp (AI 2 $S)) will always evaluate to T in the top-level
+ACL2 command loop, because we insist that the current value of the
+stobj $S always satisfies $SP by enforcing the guards on the updaters,
+independent of whether guard checking is on or off; see *note
+SET-GUARD-CHECKING::.  But in a theorem $S is just another variable,
+implicitly universally quantified.
+
+So (integerp (AI 2 $S)) is not a theorem because it is not true when
+the variable $S is instantiated with, say,
+
+     '(1 (0 1 TWO))
+
+because, logically speaking, (AI 2 '(1 (0 1 TWO))) evaluates to the
+symbol TWO.  That is,
+
+     (equal (AI 2 '(1 (0 1 TWO))) 'TWO)
+
+is true.
+
+However,
+
+     (implies (and ($SP $S) (< 2 (A-LENGTH $S))) (integerp (AI 2 $S)))
+
+is a theorem.  To prove it, you will have to prove a lemma about AP.
+The following will do:
+
+     (defthm ap-nth
+       (implies (and (AP x)
+                     (integerp i)
+                     (<= 0 i)
+                     (< i (len x)))
+                (integerp (nth i x)))).
+
+Similarly,
+
+     (implies (and (integerp i)
+                   (<= 0 i)
+                   (< i (A-LENGTH $S))
+                   (integerp v)
+                   (<= 0 v)
+                   (<= v 9))
+              ($SP (UPDATE-AI i v $S)))
+
+is not a theorem until you add the additional hypothesis ($SP $S).  To
+prove the resulting theorem, you will need a lemma such as the
+following.
+
+     (defthm ap-update-nth
+       (implies (and (AP a)
+                     (integerp v)
+                     (<= 0 v)
+                     (<= v 9)
+                     (integerp i)
+                     (<= 0 i)
+                     (< i (len a)))
+                (AP (update-nth i v a))))
+
+The moral here is that from the logical perspective, you must provide
+the hypotheses that, as a programmer, you think are implicit on the
+structure of your stobjs, and you must prove their invariance.  This is
+a good area for further support, perhaps in the form of a library of
+macros.
+
+_Resizing Array Fields_
+
+Recall the specification of the array field, A for the stobj $S
+introduced above:
+
+     (a :type (array (integer 0 9) (3)) :initially 9 :resizable t)
+
+Logically, this field is a list, initially of length 3.  Under the
+hood, this field is implemented using a Common Lisp array with 3
+elements.  In some applications, one may wish to lengthen an array
+field, or even (to reclaim space) to shrink an array field.  The
+defstobj event provides functions to access the current length of an
+array field and to change the array field, with default names obtained
+by suffixing the field name with "LENGTH-" or prefixing it with
+"RESIZE-," respectively.  The following log shows the uses of these
+fields in the above example.
+
+     ACL2 !>(A-LENGTH $S)
+     3
+     ACL2 !>(RESIZE-A 10 $S) ; change length of A to 10
+     <$s>
+     ACL2 !>(A-LENGTH $S)
+     10
+     ACL2 !>(AI 7 $S)        ; new elements get value from :initially
+     9
+     ACL2 !>(RESIZE-A 2 $S)  ; truncate A down to first 2 elements
+     <$s>
+     ACL2 !>(A-LENGTH $S)
+     2
+     ACL2 !>(AI 7 $S)        ; error:  access past array bound
+
+
+     ACL2 Error in TOP-LEVEL:  The guard for the function symbol AI, which
+     is (AND ($SP $S) (INTEGERP I) (<= 0 I) (< I (A-LENGTH $S))), is violated
+     by the arguments in the call (AI 7 $S).
+
+     ACL2 !>
+
+Here are the definitions of the relevant functions for the above
+example; also see *note RESIZE-LIST::.
+
+     (DEFUN A-LENGTH ($S)
+       (DECLARE (XARGS :GUARD ($SP $S) :VERIFY-GUARDS T))
+       (LEN (NTH 1 $S)))
+
+     (DEFUN RESIZE-A (K $S)
+       (DECLARE (XARGS :GUARD ($SP $S) :VERIFY-GUARDS T))
+       (UPDATE-NTH 1
+                   (RESIZE-LIST (NTH 1 $S) K 9)
+                   $S))
+
+It is important to note that the implementation of array resizing in
+ACL2 involves copying the entire array into a newly allocated space and
+thus can be quite costly if performed often.  This approach was chosen
+in order to make array access and update as efficient as possible, with
+the suspicion that for most applications, array access and update are
+considerably more frequent than resizing (especially if the programmer
+is aware of the relative costs beforehand).
+
+It should also be noted that computations of lengths of stobj array
+fields should be fast (constant-time) in all or most Common Lisp
+implementations.
+
+Finally, if :resizable t is not supplied as shown above, then an
+attempt to resize the array will result in an error.  If you do not
+intend to resize the array, it is better to omit the :resizable option
+(or to supply :resizable nil), since then the length function will be
+defined to return a constant, namely the initial length, which can
+simplify guard proofs (compare with the definition of A-LENGTH above).
+
+This completes the tour through the documentation of stobjs.  However,
+you may now wish to read the documentation for the event that
+introduces a new single-threaded object; see *note DEFSTOBJ::.
+
+
+File: acl2-doc-emacs.info,  Node: STOBJ-LET,  Next: WITH-LOCAL-STATE,  Prev: STOBJ-EXAMPLE-3,  Up: STOBJ
+
+STOBJ-LET    See *note NESTED-STOBJS::.
+
+
 File: acl2-doc-emacs.info,  Node: WITH-LOCAL-STATE,  Next: WITH-LOCAL-STOBJ,  Prev: STOBJ-LET,  Up: STOBJ
 
 WITH-LOCAL-STATE    locally bind state
@@ -713,6 +1660,10 @@
 
 * ADD-INVISIBLE-FNS:: make some unary functions invisible to the loop-stopper algorithm
 
+* ADD-LD-KEYWORD-ALIAS:: See *note LD-KEYWORD-ALIASES::.
+
+* ADD-LD-KEYWORD-ALIAS!:: See *note LD-KEYWORD-ALIASES::.
+
 * ADD-MACRO-ALIAS:: associate a function name with a macro name
 
 * ADD-MACRO-FN:: associate a function name with a macro name
@@ -739,6 +1690,8 @@
 
 * INVISIBLE-FNS-TABLE:: functions that are invisible to the loop-stopper algorithm
 
+* LD-KEYWORD-ALIASES:: abbreviation of some keyword commands
+
 * LOGIC:: to set the default defun-mode to :logic
 
 * MACRO-ALIASES-TABLE:: a table used to associate function names with macro names
@@ -819,6 +1772,8 @@
 
 * SET-INHIBIT-WARNINGS:: control warnings
 
+* SET-INHIBIT-WARNINGS!:: control warnings non-locally
+
 * SET-INHIBITED-SUMMARY-TYPES:: control which parts of the summary are printed
 
 * SET-INVISIBLE-FNS-TABLE:: set the invisible functions table
@@ -827,6 +1782,8 @@
 
 * SET-LD-KEYWORD-ALIASES:: See *note LD-KEYWORD-ALIASES::.
 
+* SET-LD-KEYWORD-ALIASES!:: See *note LD-KEYWORD-ALIASES::.
+
 * SET-LD-REDEFINITION-ACTION:: See *note LD-REDEFINITION-ACTION::.
 
 * SET-LD-SKIP-PROOFS:: See *note SET-LD-SKIP-PROOFSP::.
@@ -1112,7 +2069,7 @@
 (see *note SET-RAW-MODE::),though by means other than a table.)
 
 
-File: acl2-doc-emacs.info,  Node: ADD-INVISIBLE-FNS,  Next: ADD-MACRO-ALIAS,  Prev: ADD-INCLUDE-BOOK-DIR,  Up: SWITCHES-PARAMETERS-AND-MODES
+File: acl2-doc-emacs.info,  Node: ADD-INVISIBLE-FNS,  Next: ADD-LD-KEYWORD-ALIAS,  Prev: ADD-INCLUDE-BOOK-DIR,  Up: SWITCHES-PARAMETERS-AND-MODES
 
 ADD-INVISIBLE-FNS    make some unary functions invisible to the loop-stopper algorithm
 
@@ -1137,7 +2094,17 @@
 in a single event, and see *note REMOVE-INVISIBLE-FNS::.
 
 
-File: acl2-doc-emacs.info,  Node: ADD-MACRO-ALIAS,  Next: ADD-MACRO-FN,  Prev: ADD-INVISIBLE-FNS,  Up: SWITCHES-PARAMETERS-AND-MODES
+File: acl2-doc-emacs.info,  Node: ADD-LD-KEYWORD-ALIAS,  Next: ADD-LD-KEYWORD-ALIAS!,  Prev: ADD-INVISIBLE-FNS,  Up: SWITCHES-PARAMETERS-AND-MODES
+
+ADD-LD-KEYWORD-ALIAS    See *note LD-KEYWORD-ALIASES::.
+
+
+File: acl2-doc-emacs.info,  Node: ADD-LD-KEYWORD-ALIAS!,  Next: ADD-MACRO-ALIAS,  Prev: ADD-LD-KEYWORD-ALIAS,  Up: SWITCHES-PARAMETERS-AND-MODES
+
+ADD-LD-KEYWORD-ALIAS!    See *note LD-KEYWORD-ALIASES::.
+
+
+File: acl2-doc-emacs.info,  Node: ADD-MACRO-ALIAS,  Next: ADD-MACRO-FN,  Prev: ADD-LD-KEYWORD-ALIAS!,  Up: SWITCHES-PARAMETERS-AND-MODES
 
 ADD-MACRO-ALIAS    associate a function name with a macro name
 
@@ -1608,7 +2575,7 @@
      ACL2 !>
 
 
-File: acl2-doc-emacs.info,  Node: INVISIBLE-FNS-TABLE,  Next: LOGIC,  Prev: INITIALIZE-EVENT-USER,  Up: SWITCHES-PARAMETERS-AND-MODES
+File: acl2-doc-emacs.info,  Node: INVISIBLE-FNS-TABLE,  Next: LD-KEYWORD-ALIASES,  Prev: INITIALIZE-EVENT-USER,  Up: SWITCHES-PARAMETERS-AND-MODES
 
 INVISIBLE-FNS-TABLE    functions that are invisible to the loop-stopper algorithm
 
@@ -1650,7 +2617,84 @@
 up as adjacent tips in the fn nest.  See *note LOOP-STOPPER::.
 
 
-File: acl2-doc-emacs.info,  Node: LOGIC,  Next: MACRO-ALIASES-TABLE,  Prev: INVISIBLE-FNS-TABLE,  Up: SWITCHES-PARAMETERS-AND-MODES
+File: acl2-doc-emacs.info,  Node: LD-KEYWORD-ALIASES,  Next: LOGIC,  Prev: INVISIBLE-FNS-TABLE,  Up: SWITCHES-PARAMETERS-AND-MODES
+
+LD-KEYWORD-ALIASES    abbreviation of some keyword commands
+
+     Examples:
+     (set-ld-keyword-aliases '((:q 0 q-fn)
+                               (:e 0 exit-acl2-macro))
+                             state)
+     (ld-keyword-aliases state) ; current value of the ld-keyword-aliases table
+
+Ld-keyword-aliases is the name of a ACL2 table (see *note TABLE::) and
+also the name of a function of state that returns the value of this
+table.  That value must be an alist, each element of which is of the
+form (:keyword n fn), where :keyword is a keyword, n is a nonnegative
+integer, and fn is a function symbol of arity n, a macro symbol, or a
+lambda expression of arity n.  When keyword is typed as an ld command,
+n more forms are read, x1, ..., xn, and the form (fn 'x1 ... 'xn) is
+then evaluated.  The initial value of the ld-keyword-aliases table is
+nil.
+
+ACL2 provides functions to modify the ld-keyword-aliases table, as
+follows.
+
+     (Set-ld-keyword-aliases val state): sets the table to val, which
+     must be a legal alist as described above.  This is an event that
+     may go into a book (see *note EVENTS::), but its effect will be
+     local to that book.
+
+     Set-ld-keyword-aliases! is the same as set-ld-keyword-aliases,
+     except that its effect is not local.  Indeed, the form
+     (set-ld-keyword-aliases val state) is equivalent to the form
+     (local (set-ld-keyword-aliases! val state).
+
+     (Add-ld-keyword-alias key val state): modifies the table by
+     binding the keyword key to val, which must be a legal value as
+     described above.  This is an event that may go into a book (see
+     *note EVENTS::), but its effect will be local to that book.
+
+     Add-ld-keyword-alias! is the same as add-ld-keyword-alias, except
+     that its effect is not local.  Indeed, the form
+     (add-ld-keyword-alias key val state) is equivalent to the form
+     (local (add-ld-keyword-alias! key val state).
+
+
+Consider the first example above:
+
+     (set-ld-keyword-aliases '((:q 0 q-fn)
+                               (:e 0 exit-acl2-macro))
+                             state)
+
+With this event, :q is redefined to have the effect of executing
+(q-fn), so for example if you have defined q-fn with
+
+     (defmacro q-fn ()
+       '(er soft 'q "You un-bound :q and now we have a soft error."))
+
+then :q will cause an error, and if you have defined
+
+     (defmacro exit-acl2-macro () '(exit-ld state))
+
+then :e will cause the effect (it so happens) that :q normally has.  If
+you prefer :e to :q for exiting the ACL2 loop, you might even want to
+put such definitions of q-fn and exit-acl2-macro together with the
+set-ld-keyword-aliases form above into your "acl2-customization.lsp"
+file; see *note ACL2-CUSTOMIZATION::.
+
+The general-purpose ACL2 read-eval-print loop, ld, reads forms from
+standard-oi, evaluates them and prints the result to standard-co.
+However, there are various flags that control ld's behavior and
+ld-keyword-aliases is one of them.  Ld-keyword-aliases affects how
+keyword commands are parsed.  Generally speaking, ld's command
+interpreter reads ":fn x1 ... xn" as "(fn 'x1 ... 'xn)" when :fn is a
+keyword and fn is the name of an n-ary function; see *note
+KEYWORD-COMMANDS::.  But this parse is overridden, as described above,
+for the keywords bound in the ld-keyword-aliases table.
+
+
+File: acl2-doc-emacs.info,  Node: LOGIC,  Next: MACRO-ALIASES-TABLE,  Prev: LD-KEYWORD-ALIASES,  Up: SWITCHES-PARAMETERS-AND-MODES
 
 LOGIC    to set the default defun-mode to :logic
 
@@ -3175,8 +4219,8 @@
 
 Note: This is an event!  It does not print the usual event summary but
 nevertheless changes the ACL2 logical world and is so recorded.  It is
-local to the book or encapsulate form in which it occurs (see *note
-SET-DEFAULT-HINTS!:: for a corresponding non-local event).
+local to the book or encapsulate form in which it occurs; see *note
+SET-DEFAULT-HINTS!:: for a corresponding non-local event.
 
      General Form:
      (set-default-hints lst)
@@ -3774,7 +4818,7 @@
 intended).
 
 
-File: acl2-doc-emacs.info,  Node: SET-INHIBIT-WARNINGS,  Next: SET-INHIBITED-SUMMARY-TYPES,  Prev: SET-INHIBIT-OUTPUT-LST,  Up: SWITCHES-PARAMETERS-AND-MODES
+File: acl2-doc-emacs.info,  Node: SET-INHIBIT-WARNINGS,  Next: SET-INHIBIT-WARNINGS!,  Prev: SET-INHIBIT-OUTPUT-LST,  Up: SWITCHES-PARAMETERS-AND-MODES
 
 SET-INHIBIT-WARNINGS    control warnings
 
@@ -3782,34 +4826,56 @@
      (set-inhibit-warnings "theory" "use")
 
 Note: This is an event!  It does not print the usual event summary but
-nevertheless changes the ACL2 logical world and is so recorded.
-Moreover, its effect is to set the acl2-defaults-table, and hence its
-effect is local to the book or encapsulate form containing it; see
-*note ACL2-DEFAULTS-TABLE::.
+nevertheless changes the ACL2 logical world and is so recorded.  It is
+local to the book or encapsulate form in which it occurs; see *note
+SET-INHIBIT-WARNINGS!:: for a corresponding non-local event.  Indeed,
+(set-inhibit-warnings ...) is equivalent to (local
+(set-inhibit-warnings! ...)).
 
      General Form:
      (set-inhibit-warnings string1 string2 ...)
 
 where each string is considered without regard to case.  This macro is
-equivalent to (table acl2-defaults-table :inhibit-warnings lst), where
-lst is the list of strings supplied.  This macro is an event (see *note
-TABLE::), but no output results from a set-inhibit-warnings event.
-
-The effect of this event is to suppress any warning whose label is a
-member of this list (where again, case is ignored).  For example, the
-warning
+equivalent to (local (table inhibit-warnings-table nil 'lst :clear)),
+where lst is the list of strings supplied.  This macro is an event (see
+*note TABLE::), but no output results from a set-inhibit-warnings event.
+
+ACL2 prints warnings that may, from time to time, seem excessive to
+experienced users.  Each warning is "labeled" with a string identifying
+the type of warning.  Consider for example
+
+     ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
+
+Here, the label is "Use".  The argument list for set-inhibit-warnings
+is a list of such labels, each of which is a string.  Any warning is
+suppressed if its label is a member of this list, where case is
+ignored, .  Thus, for example, the warning above will not be printed
+after a call of set-inhibit-warnings that contains the string, "Use"
+(or any string that is string-equal to "Use", such as "use" or "USE").
+In summary: the effect of this event is to suppress any warning whose
+label is a member of the given argument list, where case is ignored.
+
+The list of currently inhibited warnings is the list of keys in the
+table named inhibit-warnings-table.  (The values in the table are
+irrelevant.)  One way to get that value is to get the result from
+evaluating the following form: (table-alist 'inhibit-warnings-table (w
+state)).  Of course, if warnings are inhibited overall -- see *note
+SET-INHIBIT-OUTPUT-LST:: -- then this value is entirely irrelevant.
 
-       ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
+
+File: acl2-doc-emacs.info,  Node: SET-INHIBIT-WARNINGS!,  Next: SET-INHIBITED-SUMMARY-TYPES,  Prev: SET-INHIBIT-WARNINGS,  Up: SWITCHES-PARAMETERS-AND-MODES
 
-will not be printed if "use" (or "USE", etc.) is a member of the given
-list of strings.
+SET-INHIBIT-WARNINGS!    control warnings non-locally
 
-Of course, if warnings are inhibited overall -- see *note
-SET-INHIBIT-OUTPUT-LST:: -- then the value of :inhibit-warnings is
-entirely irrelevant.
+Please see *note SET-INHIBIT-WARNINGS::, which is the same as
+set-inhibit-warnings!  except that the latter is not local to the
+encapsulate or the book in which it occurs.  Probably
+set-inhibit-warnings is to be preferred unless you have a good reason
+for wanting to export the effect of this event outside the enclosing
+encapsulate or book.
 
 
-File: acl2-doc-emacs.info,  Node: SET-INHIBITED-SUMMARY-TYPES,  Next: SET-INVISIBLE-FNS-TABLE,  Prev: SET-INHIBIT-WARNINGS,  Up: SWITCHES-PARAMETERS-AND-MODES
+File: acl2-doc-emacs.info,  Node: SET-INHIBITED-SUMMARY-TYPES,  Next: SET-INVISIBLE-FNS-TABLE,  Prev: SET-INHIBIT-WARNINGS!,  Up: SWITCHES-PARAMETERS-AND-MODES
 
 SET-INHIBITED-SUMMARY-TYPES    control which parts of the summary are printed
 
@@ -3927,12 +4993,17 @@
 where flg is either t, nil, or :warn.
 
 
-File: acl2-doc-emacs.info,  Node: SET-LD-KEYWORD-ALIASES,  Next: SET-LD-REDEFINITION-ACTION,  Prev: SET-IRRELEVANT-FORMALS-OK,  Up: SWITCHES-PARAMETERS-AND-MODES
+File: acl2-doc-emacs.info,  Node: SET-LD-KEYWORD-ALIASES,  Next: SET-LD-KEYWORD-ALIASES!,  Prev: SET-IRRELEVANT-FORMALS-OK,  Up: SWITCHES-PARAMETERS-AND-MODES
 
 SET-LD-KEYWORD-ALIASES    See *note LD-KEYWORD-ALIASES::.
 
 
-File: acl2-doc-emacs.info,  Node: SET-LD-REDEFINITION-ACTION,  Next: SET-LD-SKIP-PROOFS,  Prev: SET-LD-KEYWORD-ALIASES,  Up: SWITCHES-PARAMETERS-AND-MODES
+File: acl2-doc-emacs.info,  Node: SET-LD-KEYWORD-ALIASES!,  Next: SET-LD-REDEFINITION-ACTION,  Prev: SET-LD-KEYWORD-ALIASES,  Up: SWITCHES-PARAMETERS-AND-MODES
+
+SET-LD-KEYWORD-ALIASES!    See *note LD-KEYWORD-ALIASES::.
+
+
+File: acl2-doc-emacs.info,  Node: SET-LD-REDEFINITION-ACTION,  Next: SET-LD-SKIP-PROOFS,  Prev: SET-LD-KEYWORD-ALIASES!,  Up: SWITCHES-PARAMETERS-AND-MODES
 
 SET-LD-REDEFINITION-ACTION    See *note LD-REDEFINITION-ACTION::.
 
@@ -4294,6 +5365,8 @@
 than globally.  For a related utility based on time instead of prover
 steps, see *note WITH-PROVER-TIME-LIMIT::.  For examples of how step
 limits work, see the community book books/misc/misc2/step-limits.lisp.
+For a utility that returns an indicator of the number of prover steps
+most recently taken, see *note LAST-PROVER-STEPS::.
 
 Note: This is an event!  It does not print the usual event summary but
 nevertheless changes the ACL2 logical world and is so recorded.
@@ -4330,6 +5403,11 @@
 Note however the exception stated above: if the "limit" is nil or is
 the value of *default-step-limit*, then no limit is imposed.
 
+There is at best a loose connection between the counting of steps and
+with-prover-time-limit.  In particular, for a call of mfc-rw or any
+mfc- function (see *note EXTENDED-METAFUNCTIONS::), the steps taken
+during that call are forgotten when returning from that call.
+
 The limit is relevant for every event, as well as for calls of thm and
 certify-book -- and more generally, to any form that creates a "summary
 context" to print the usual event summary.  The limit is also put in
@@ -4405,10 +5483,6 @@
       NIL
      ACL2 !>
 
-Technical Remark.  For a call of mfc-rw or any mfc- function (see *note
-EXTENDED-METAFUNCTIONS::), the steps taken during that call are
-forgotten when returning from that call.
-
 
 File: acl2-doc-emacs.info,  Node: SET-RAW-MODE,  Next: SET-RAW-MODE-ON!,  Prev: SET-PROVER-STEP-LIMIT,  Up: SWITCHES-PARAMETERS-AND-MODES
 
@@ -4640,7 +5714,7 @@
      (set-rewrite-stack-limit 30)                            ; set to small limit
      :set-rewrite-stack-limit 30                             ; same as above
      (set-rewrite-stack-limit *default-rewrite-stack-limit*) ; the default
-     :set-rewrite-stack-limit (1- (expt 2 28))               ; maximum legal limit
+     (set-rewrite-stack-limit (1- (expt 2 28)))              ; maximum legal limit
      :set-rewrite-stack-limit nil         ; same as above -- essentially, no limit
 
 This event sets the maximum stack depth for calls of certain functions
@@ -5757,1095 +6831,3 @@
 ignored once evaluation passes into raw Lisp functions (see *note
 GUARDS-AND-EVALUATION::).
 
-
-File: acl2-doc-emacs.info,  Node: WITH-OUTPUT,  Prev: WITH-GUARD-CHECKING,  Up: SWITCHES-PARAMETERS-AND-MODES
-
-WITH-OUTPUT    suppressing or turning on specified output for an event
-
-     Examples:
-
-     ; Turn off all output during evaluation of the indicated thm form.
-     (with-output
-      :off :all
-      :gag-mode nil
-      (thm (equal (app (app x y) z) (app x (app y z)))))
-
-     ; Prove the indicated theorem with the event summary turned off and
-     ; using the :goals setting for gag-mode.
-     (with-output
-        :off summary
-        :gag-mode :goals
-        (defthm app-assoc (equal (app (app x y) z) (app x (app y z)))))
-
-     ; Same effect as just above:
-     (with-output
-        :on summary
-        :summary :all ; equivalently, the value (a list) of *summary-types*
-        :gag-mode :goals
-        (defthm app-assoc (equal (app (app x y) z) (app x (app y z)))))
-
-     ; Same as just above, but turn off only the indicated parts of the summary.
-     (with-output
-        :on summary
-        :summary (time rules)
-        :gag-mode :goals  ; use gag-mode, with goal names printed
-        (defthm app-assoc (equal (app (app x y) z) (app x (app y z)))))
-
-     ; Same as specifying :off :all, but showing all output types:
-     (with-output
-      :off (error warning warning! observation prove proof-checker event expansion
-                  summary proof-tree)
-      :gag-mode nil
-      (thm (equal (app (app x y) z) (app x (app y z)))))
-
-     ; Same as above, but :stack :push says to save the current
-     ; inhibit-output-lst, which can be restored in a subsidiary with-output call
-     ; that specifies :stack :pop.
-     (with-output
-      :stack :push
-      :off :all
-      :gag-mode nil
-      (thm (equal (app (app x y) z) (app x (app y z)))))
-
-     General Form:
-     (with-output :key1 val1 ... :keyk valk form)
-
-where each :keyi is either :off, :on, :stack, :summary, or :gag-mode,
-and vali is as follows.  If :keyi is :off or :on, then vali can be
-:all, and otherwise is a symbol or non-empty list of symbols
-representing output types that can be inhibited; see *note
-SET-INHIBIT-OUTPUT-LST::.  If :keyi is :gag-mode, then vali is one of
-the legal values for :set-gag-mode.  If :keyi is :summary, then vali is
-either :all or a true-list of symbols each of which belongs to the list
-*summary-types*.  Otherwise :keyi is :stack, in which case :vali is
-:push or :pop; for now assume that :stack is not specified (we'll
-return to it below).  The result of evaluating the General Form above
-is to evaluate form, but in an environment where output occurs as
-follows.  If :on :all is specified, then every output type is turned on
-except as inhibited by :off; else if :off :all is specified, then every
-output type is inhibited except as specified by :on; and otherwise, the
-currently-inhibited output types are reduced as specified by :on and
-then extended as specified by :off.  But if :gag-mode is specified, then
-before modifying how output is inhibited, gag-mode is set for the
-evaluation of form as specified by the value of :gag-mode; see *note
-SET-GAG-MODE::.  If summary is among the output types that are turned
-on (not inhibited), then if :summary is specified, the only parts of the
-summary to be printed will be those specified by the value of :summary.
-The correspondence should be clear, except perhaps that header refers to
-the line containing only the word Summary, and value refers to the
-value of the form printed during evaluation of sequences of events as
-for progn and encapsulate.
-
-Note that the handling of the :stack argument pays no attention to the
-:summary argument.
-
-Note: When the scope of with-output is exited, then all modifications
-are undone, reverting gag-mode and the state of output inhibition to
-those which were present before the with-output call was entered.
-
-The :stack keyword's effect is illustrated by the following example,
-where "(encapsulate nil)" may replaced by "(progn" without any change
-to the output that is printed.
-
-     (with-output
-      :stack :push :off :all
-      (encapsulate ()
-        (defun f1 (x) x)
-        (with-output :stack :pop (defun f2 (x) x))
-        (defun f3 (x) x)
-        (with-output :stack :pop :off warning (in-theory nil))
-        (defun f4 (x) x)))
-
-The outer with-output call saves the current output settings (as may
-have been modified by earlier calls of set-inhibit-output-lst), by
-pushing them onto a stack, and then turns off all output.  Each inner
-with-output call temporarily pops that stack, restoring the starting
-output settings, until it completes and undoes the effects of that pop.
-Unless event output was inhibited at the top level (see *note
-SET-INHIBIT-OUTPUT-LST::), the following output is shown:
-
-     Since F2 is non-recursive, its admission is trivial.  We observe that
-     the type of F2 is described by the theorem (EQUAL (F2 X) X).
-
-And then, if summary output was not inhibited at the top level, we get
-the rest of this output:
-
-     Summary
-     Form:  ( DEFUN F2 ...)
-     Rules: NIL
-     Warnings:  None
-     Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
-
-     Summary
-     Form:  ( IN-THEORY NIL)
-     Rules: NIL
-     Warnings:  None
-     Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
-
-Note that the use of :off warning supresses a "Theory" warning for the
-(in-theory nil) event, and that in no case will output be printed for
-definitions of f1, f3, or f4, or for the encapsulate event itself.
-
-The following more detailed explanation of :stack is intended only for
-advanced users.  After :gag-mode is handled (if present) but before :on
-or :off is handled, the value of :stack is handled as follows.  If the
-value is :push, then state global inhibit-output-lst-stack is modified
-by pushing the value of state global inhibit-output-lst onto the value
-of state global inhibit-output-lst-stack, which is nil at the top
-level.  If the value is :pop, then state global
-inhibit-output-lst-stack is modified only if non-nil, in which case its
-top element is popped and becomes the value of of state global
-inhibit-output-lst.
-
-Warning: With-output has no effect in raw Lisp, and hence is disallowed
-in function bodies.  However, you can probably get the effect you want
-as illustrated below, where <form> must return an error triple (mv erp
-val state); see *note LD:: and see *note ERROR-TRIPLES::.
-
-     Examples avoiding with-output, for use in function definitions:
-
-     ; Inhibit all output:
-     (state-global-let*
-      ((inhibit-output-lst *valid-output-names*))
-      <form>)
-
-     ; Inhibit all warning output:
-     (state-global-let*
-      ((inhibit-output-lst
-        (union-eq (f-get-global 'inhibit-output-lst state)
-                  '(warning warning!))))
-      <form>)
-
-Note that with-output is allowed in books.  See *note
-EMBEDDED-EVENT-FORM::.
-
-
-File: acl2-doc-emacs.info,  Node: THEORIES,  Next: TRACE,  Prev: SWITCHES-PARAMETERS-AND-MODES,  Up: Top
-
-THEORIES    sets of runes to enable/disable in concert
-
-     Example: '((:definition app) ; or (:d app)
-                (:executable-counterpart app)
-                (:i app)
-                rv
-                (rv)
-                assoc-of-app)
-
-See:
-
-* Menu:
-
-* ACTIVE-RUNEP:: check that a rune exists and is enabled
-
-* CURRENT-THEORY:: currently enabled rules as of logical name
-
-* DISABLE:: deletes names from current theory
-
-* E/D:: enable/disable rules
-
-* ENABLE:: adds names to current theory
-
-* EXECUTABLE-COUNTERPART-THEORY:: executable counterpart rules as of logical name
-
-* FUNCTION-THEORY:: function symbol rules as of logical name
-
-* GROUND-ZERO:: enabled rules in the startup theory
-
-* INCOMPATIBLE:: declaring that two rules should not both be enabled
-
-* INTERSECTION-THEORIES:: intersect two theories
-
-* MINIMAL-THEORY:: a minimal theory to enable
-
-* RULE-NAMES:: How rules are named.
-
-* RUNE:: a rule name
-
-* SET-DIFFERENCE-THEORIES:: difference of two theories
-
-* THEORIES-AND-PRIMITIVES:: warnings from disabling certain built-in functions
-
-* THEORY:: retrieve named theory
-
-* THEORY-FUNCTIONS:: functions for obtaining or producing theories
-
-* UNION-THEORIES:: union two theories
-
-* UNIVERSAL-THEORY:: all rules as of logical name
-
-
-Related topics other than immediate subtopics:
-* DEFTHEORY:: define a theory (to enable or disable a set of rules)
-
-* DEFTHEORY-STATIC:: define a `static' theory (to enable or disable a set of rules)
-
-* IN-THEORY:: designate ``current'' theory (enabling its rules)
-
-A theory is a list of "runic designators" as described below.  Each
-runic designator denotes a set of "runes" (see *note RUNE::) and by
-unioning together the runes denoted by each member of a theory we
-define the set of runes corresponding to a theory.  Theories are used
-to control which rules are "enabled," i.e., available for automatic
-application by the theorem prover.  There is always a "current" theory.
-A rule is enabled precisely if its rune is an element of the set of
-runes corresponding to the current theory.  At the top-level, the
-current theory is the theory selected by the most recent in-theory
-event, extended with the rule names introduced since then.  Inside the
-theorem prover, the :in-theory hint (see *note HINTS::) can be used to
-select a particular theory as current during the proof attempt for a
-particular goal.
-
-Theories are generally constructed by "theory expressions."  Formally, a
-theory expression is any term, containing at most the single free
-variable world, that when evaluated with world bound to the current ACL2
-world (see *note WORLD::) produces a theory.  ACL2 provides various
-functions for the convenient construction and manipulation of theories.
-These are called "theory functions"(see *note THEORY-FUNCTIONS::).  For
-example, the theory function union-theories takes two theories and
-produces their union.  The theory function universal-theory returns the
-theory containing all known rule names as of the introduction of a
-given logical name.  But a theory expression can contain constants,
-e.g.,
-
-     '(len (len) (:rewrite car-cons) car-cdr-elim)
-
-and user-defined functions.  The only important criterion is that a
-theory expression mention no variable freely except world and evaluate
-to a theory.
-
-More often than not, theory expressions typed by the user do not
-mention the variable world.  This is because user-typed theory
-expressions are generally composed of applications of ACL2's theory
-functions.  These "functions" are actually macros that expand into
-terms in which world is used freely and appropriately.  Thus, the
-technical definition of "theory expression" should not mislead you into
-thinking that interestng theory expressions must mention world; they
-probably do and you just didn't know it!
-
-One aspect of this arrangement is that theory expressions cannot
-generally be evaluated at the top-level of ACL2, because world is not
-bound.  To see the value of a theory expression, expr, at the
-top-level, type
-
-     ACL2 !>(LET ((WORLD (W STATE))) expr).
-
-However, because the built-in theories are quite long, you may be sorry
-you printed the value of a theory expression!
-
-A theory is a true list of runic designators and to each theory there
-corresponds a set of runes, obtained by unioning together the sets of
-runes denoted by each runic designator.  For example, the theory
-constant
-
-        '(len (len) (:e nth) (:rewrite car-cons) car-cdr-elim)
-
-corresponds to the set of runes
-
-        {(:definition len)
-         (:induction len)
-         (:executable-counterpart len)
-         (:executable-counterpart nth)
-         (:elim car-cdr-elim)
-         (:rewrite car-cons)} .
-
-Observe that the theory contains five elements but its runic
-correspondent contains six.  That is because runic designators can
-denote sets of several runes, as is the case for the first designator,
-len.  If the above theory were selected as current then the six rules
-named in its runic counterpart would be enabled and all other rules
-would be disabled.
-
-We now precisely define the runic designators and the set of runes
-denoted by each.  When we refer below to the "macro-aliases dereference
-of" a symbol, symb, we mean the (function) symbol corresponding symb in
-the macro-aliases-table if there is such a symbol, else symb itself;
-see *note MACRO-ALIASES-TABLE::.  For example, the macro-aliases
-dereference of append is binary-append, and the macro-aliases
-dereference of nth is nth.
-
-     o A rune is a runic designator and denotes the singleton set
-     containing that rune.
-
-     o Suppose that symb is a symbol and symb' is the macro-aliases
-     dereference of symb, where symb' is a function symbol introduced
-     with a defun (or defuns) event.  Then symb is a runic designator
-     and denotes the set containing the runes (:definition symb') and
-     (:induction symb'), omitting the latter if no such induction rune
-     exists (presumably because the definition of symb' is not singly
-     recursive).
-
-     o Suppose that symb is a symbol and symb' is the macro-aliases
-     dereference of symb, where symb' is a function symbol introduced
-     with a defun (or defuns) event.  Then (symb) is a runic designator
-     and denotes the singleton set containing the rune
-     (:executable-counterpart symb').
-
-     o If symb is the name of a defthm (or defaxiom) event that
-     introduced at least one rule, then symb is a runic designator and
-     denotes the set of the names of all rules introduced by the named
-     event.
-
-     o If str is the string naming some defpkg event and symb is the
-     symbol returned by (intern str "ACL2"), then symb is a runic
-     designator and denotes the singleton set containing (:rewrite
-     symb), which is the name of the rule stating the conditions under
-     which the symbol-package-name of (intern x str) is str.
-
-     o If symb is the name of a deftheory event, then symb is a runic
-     designator and denotes the runic theory corresponding to symb.
-
-     o Finally, suppose that symb is a symbol and symb' is the
-     macro-aliases dereference of symb.  Then (:KWD symb . rest) is a
-     runic designator if (:KWD' symb' . rest) is a rune, where :KWD is
-     one of :d, :e, :i, or :t, and correspondingly :KWD' is
-     :definition, :executable-counterpart, :induction, or
-     :type-prescription, respectively.  In this case, (:KWD symb . rest)
-     denotes the runic theory corresponding to the rune (:KWD' symb' .
-     rest).
-
-Note that including a function name, e.g., len, in the current theory
-enables that function but does not enable the executable counterpart.
-Similarly, including (len) or (:e len) enables the executable
-counterpart but not the symbolic definition.  And including the name of
-a proved lemma enables all of the rules added by the event.  Of course,
-one can include explicitly the runes naming the rules in question and
-so can avoid entirely the use of non-runic elements in theories.
-
-Because a rune is a runic designator denoting the set containing that
-rune, a list of runes is a theory and denotes itself.  We call such
-theories "runic theories."  To every theory there corresponds a runic
-theory obtained by unioning together the sets denoted by each
-designator in the theory.  When a theory is selected as "current" it is
-actually its runic correspondent that is effectively used.  That is, a
-rune is enabled iff it is a member of the runic correspondent of the
-current theory.  The value of a theory defined with deftheory is the
-runic correspondent of the theory computed by the defining theory
-expression.  The theory manipulation functions, e.g., union-theories,
-actually convert their theory arguments to their runic correspondents
-before performing the required set operation.  The manipulation
-functions always return runic theories.  Thus, it is sometimes
-convenient to think of (non-runic) theories as merely abbreviations for
-their runic correspondents, abbreviations which are "expanded" at the
-first opportunity by theory manipulation functions and the "theory
-consumer" functions such as in-theory and deftheory.
-
-
-File: acl2-doc-emacs.info,  Node: ACTIVE-RUNEP,  Next: CURRENT-THEORY,  Prev: THEORIES,  Up: THEORIES
-
-ACTIVE-RUNEP    check that a rune exists and is enabled
-
-     Example:
-     (active-runep '(:rewrite left-to-right))
-
-     General Form:
-     (active-runep rune)
-
-where rune has the shape of a rune.  This macro expands to an
-expression using the variables ens and state, and returns non-nil when
-the given rune exists and is enabled (according to the given "enabled
-structure," ens, and the current logical world of the given state).
-See *note THEORY-INVARIANT:: for how this macro can be of use.
-
-
-File: acl2-doc-emacs.info,  Node: CURRENT-THEORY,  Next: DISABLE,  Prev: ACTIVE-RUNEP,  Up: THEORIES
-
-CURRENT-THEORY    currently enabled rules as of logical name
-
-     Examples:
-     (current-theory :here)
-     (current-theory 'lemma3)
-
-See *note LOGICAL-NAME::.
-
-     General Form:
-     (current-theory logical-name)
-
-Returns the current theory as it existed immediately after the
-introduction of logical-name provided it is evaluated in an environment
-in which the variable symbol WORLD is bound to the current ACL2 logical
-world, (w state).  Thus,
-
-     ACL2 !>(current-theory :here)
-
-will cause an (unbound variable) error while
-
-     ACL2 !>(let ((world (w state))) (current-theory :here))
-
-will return the current theory in world.
-
-See *note THEORIES:: and see *note LOGICAL-NAME:: for a discussion of
-theories in general and why the commonly used "theory functions" such
-as current-theory are really macros that expand into terms involving
-the variable world.
-
-The theory returned by current-theory is in fact the theory selected by
-the in-theory event most recently preceding logical name, extended by
-the rules introduced up through logical-name.
-
-You may experience a fencepost problem in deciding which logical name
-to use.  Deflabel can always be used to mark unambiguously for future
-reference a particular point in the development of your theory.  The
-order of events in the vicinity of an encapsulate is confusing.  See
-*note ENCAPSULATE::.
-
-This "function" is actually a macro that expands to a term mentioning
-the single free variable world.  When theory expressions are evaluated
-by in-theory or the :in-theory hint, world is bound to the current ACL2
-world.
-
-
-File: acl2-doc-emacs.info,  Node: DISABLE,  Next: E/D,  Prev: CURRENT-THEORY,  Up: THEORIES
-
-DISABLE    deletes names from current theory
-
-     Example:
-     (disable fact (fact) associativity-of-app)
-
-     General Form:
-     (disable name1 name2 ... namek)
-
-where each namei is a runic designator; see *note THEORIES::.  The
-result is the theory that contains all the names in the current theory
-except those listed.  Note that this is merely a function that returns
-a theory.  The result is generally a very long list of runes and you
-will probably regret printing it.
-
-The standard way to "disable" a fixed set of names, is as follows; see
-*note HINTS:: and see *note IN-THEORY::.
-
-     :in-theory (disable name1 name2 ... namek)    ; in a hint
-     (in-theory (disable name1 name2 ... namek))   ; as an event
-     (local ; often desirable, to avoid exporting from the current context
-      (in-theory (disable name1 name2 ... namek)))
-
-Note that all the names are implicitly quoted.  If you wish to disable
-a computed list of names, lst, use the theory expression
-(set-difference-theories (current-theory :here) lst).
-
-
-File: acl2-doc-emacs.info,  Node: E/D,  Next: ENABLE,  Prev: DISABLE,  Up: THEORIES
-
-E/D    enable/disable rules
-
-The macro e/d creates theory expressions for use in in-theory hints and
-events.  It provides a convenient way to enable and disable
-simultaneously, without having to write arcane theory expressions.
-
-     Examples:
-     (e/d (lemma1 lemma2))          ; equivalent to (enable lemma1 lemma2)
-     (e/d () (lemma))               ; equivalent to (disable lemma)
-     (e/d (lemma1) (lemma2 lemma3)) ; Enable lemma1 then disable lemma2, lemma3.
-     (e/d () (lemma1) (lemma2))     ; Disable lemma1 then enable lemma2.
-
-     General Form:
-     (e/d enables-0 disables-0 ... enables-n disables-n)
-
-where each enables-i and disables-i is a list of runic designators; see
-*note THEORIES::, see *note ENABLE::, and see *note DISABLE::.
-
-The e/d macro takes any number of lists suitable for the enable and
-disable macros, and creates a theory that is equal to (current-theory
-:here) after executing the following commands.
-
-(in-theory (enable . enables-0)) (in-theory (disable . disables-0))
-[etc.]  (in-theory (enable . enables-n)) (in-theory (disable .
-disables-n))
-
-
-File: acl2-doc-emacs.info,  Node: ENABLE,  Next: EXECUTABLE-COUNTERPART-THEORY,  Prev: E/D,  Up: THEORIES
-
-ENABLE    adds names to current theory
-
-     Example:
-     (enable fact (fact) associativity-of-app)
-
-     General Form:
-     (enable name1 name2 ... namek)
-
-where each namei is a runic designator; see *note THEORIES::.  The
-result is the theory that contains all the names in the current theory
-plus those listed.  Note that this is merely a function that returns a
-theory.  The result is generally a very long list of runes and you will
-probably regret printing it.
-
-The standard way to "enable" a fixed set of names, is as follows; see
-*note HINTS:: and see *note IN-THEORY::.
-
-     :in-theory (enable name1 name2 ... namek)  ; in a hint
-     (in-theory (enable name1 name2 ... namek)) ; as an event
-     (local ; often desirable, to avoid exporting from the current context
-      (in-theory (enable name1 name2 ... namek)))
-
-Note that all the names are implicitly quoted.  If you wish to enable a
-computed list of names, lst, use the theory expression (union-theories
-(current-theory :here) lst).
-
-
-File: acl2-doc-emacs.info,  Node: EXECUTABLE-COUNTERPART-THEORY,  Next: FUNCTION-THEORY,  Prev: ENABLE,  Up: THEORIES
-
-EXECUTABLE-COUNTERPART-THEORY    executable counterpart rules as of logical name
-
-     Examples:
-     (executable-counterpart-theory :here)
-     (executable-counterpart-theory 'lemma3)
-
-See *note LOGICAL-NAME::.
-
-     General Form:
-     (executable-counterpart-theory logical-name)
-
-Returns the theory containing all the :executable-counterpart runes,
-whether enabled or not, that existed immediately after logical-name was
-introduced.  See the documentation for theories, logical-name,
-executable-counterpart and function-theory.
-
-You may experience a fencepost problem in deciding which logical name
-to use.  Deflabel can always be used to mark unambiguously for future
-reference a particular point in the development of your theory.  The
-order of events in the vicinity of an encapsulate is confusing.  See
-*note ENCAPSULATE::.
-
-This "function" is actually a macro that expands to a term mentioning
-the single free variable world.  When theory expressions are evaluated
-by in-theory or the :in-theory hint, world is bound to the current ACL2
-world.
-
-
-File: acl2-doc-emacs.info,  Node: FUNCTION-THEORY,  Next: GROUND-ZERO,  Prev: EXECUTABLE-COUNTERPART-THEORY,  Up: THEORIES
-
-FUNCTION-THEORY    function symbol rules as of logical name
-
-     Examples:
-     (function-theory :here)
-     (function-theory 'lemma3)
-
-See *note LOGICAL-NAME::.
-
-     General Form:
-     (function-theory logical-name)
-
-Returns the theory containing all the :definition runes, whether
-enabled or not, that existed immediately after logical-name was
-introduced.  See the documentation for theories, logical-name and
-executable-counterpart-theory.
-
-You may experience a fencepost problem in deciding which logical name
-to use.  Deflabel can always be used to mark unambiguously for future
-reference a particular point in the development of your theory.  The
-order of events in the vicinity of an encapsulate is confusing.  See
-*note ENCAPSULATE::.
-
-This "function" is actually a macro that expands to a term mentioning
-the single free variable world.  When theory expressions are evaluated
-by in-theory or the :in-theory hint, world is bound to the current ACL2
-world.
-
-
-File: acl2-doc-emacs.info,  Node: GROUND-ZERO,  Next: INCOMPATIBLE,  Prev: FUNCTION-THEORY,  Up: THEORIES
-
-GROUND-ZERO    enabled rules in the startup theory
-
-ACL2 concludes its initialization (boot-strapping) procedure by
-defining the theory ground-zero; see *note THEORIES::.  In fact, this
-theory is just the theory defined by (current-theory :here) at the
-conclusion of initialization; see *note CURRENT-THEORY::.
-
-Note that by evaluating the event
-
-     (in-theory (current-theory 'ground-zero))
-
-you can restore the current theory to its value at the time you started
-up ACL2.
-
-
-File: acl2-doc-emacs.info,  Node: INCOMPATIBLE,  Next: INTERSECTION-THEORIES,  Prev: GROUND-ZERO,  Up: THEORIES
-
-INCOMPATIBLE    declaring that two rules should not both be enabled
-
-     Example:
-     (theory-invariant (incompatible (:rewrite left-to-right)
-                                     (:rewrite right-to-left)))
-
-     General Form:
-     (incompatible rune1 rune2)
-
-where rune1 and rune2 are two specific runes.  The arguments are not
-evaluated.  Invariant is just a macro that expands into a term that
-checks that not both runes are enabled.  See *note THEORY-INVARIANT::.
-
-
-File: acl2-doc-emacs.info,  Node: INTERSECTION-THEORIES,  Next: MINIMAL-THEORY,  Prev: INCOMPATIBLE,  Up: THEORIES
-
-INTERSECTION-THEORIES    intersect two theories
-
-     Example:
-     (intersection-theories (current-theory :here)
-                            (theory 'arith-patch))
-
-     General Form:
-     (intersection-theories th1 th2)
-
-where th1 and th2 are theories (see *note THEORIES::).  To each of the
-arguments there corresponds a runic theory.  This function returns the
-intersection of those two runic theories, represented as a list and
-ordered chronologically.
-
-This "function" is actually a macro that expands to a term mentioning
-the single free variable world.  When theory expressions are evaluated
-by in-theory or the :in-theory hint, world is bound to the current ACL2
-world.
-
-
-File: acl2-doc-emacs.info,  Node: MINIMAL-THEORY,  Next: RULE-NAMES,  Prev: INTERSECTION-THEORIES,  Up: THEORIES
-
-MINIMAL-THEORY    a minimal theory to enable
-
-This theory (see *note THEORIES::) enables only a few built-in
-functions and executable counterparts.  It can be useful when you want
-to formulate lemmas that rather immediately imply the theorem to be
-proved, by way of a :use hint (see *note HINTS::), for example as
-follows.
-
-     :use (lemma-1 lemma-2 lemma-3)
-     :in-theory (union-theories '(f1 f2) (theory 'minimal-theory))
-
-In this example, we expect the current goal to follow from lemmas
-lemma-1, lemma-2, and lemma-3 together with rules f1 and f2 and some
-obvious facts about built-in functions (such as the definition of
-implies and the :executable-counterpart of car).  The :in-theory hint
-above is intended to speed up the proof by turning off all inessential
-rules.
-
-
-File: acl2-doc-emacs.info,  Node: RULE-NAMES,  Next: RUNE,  Prev: MINIMAL-THEORY,  Up: THEORIES
-
-RULE-NAMES    How rules are named.
-
-     Examples:
-     (:rewrite assoc-of-app)
-     (:linear delta-aref . 2)
-     (:definition length)
-     (:executable-counterpart length)
-
-See *note RUNE::.
-
-
-File: acl2-doc-emacs.info,  Node: RUNE,  Next: SET-DIFFERENCE-THEORIES,  Prev: RULE-NAMES,  Up: THEORIES
-
-RUNE    a rule name
-
-     Examples:
-     (:rewrite assoc-of-app)
-     (:linear delta-aref . 2)
-     (:definition length)
-     (:executable-counterpart length)
-
-Note: This topic discusses a basic notion of "rule name", or "rune" for
-short.  Users often use abbrevitions for runes; for example, a theory
-expression (DISABLE APPEND) abbreviates the following set of runes:
-{(:DEFINITION BINARY-APPEND), (:INDUCTION BINARY-APPEND)}.  See *note
-THEORIES:: for a discussion of so-called "runic designators", which
-include expressions like APPEND (as above) as well as (APPEND) (for the
-executable-counterpart of BINARY-APPEND.  Runic designators can also be
-abbreviations including (:d APPEND), (:e APPEND), (:i APPEND), and (:t
-APPEND), which designate the definition, executable-counterpart,
-induction, and type-prescription rules for BINARY-APPEND.  For a
-complete description of runic designators, see *note THEORIES::; we
-return now to the more basic notion of a rune.
-
-Background: The theorem prover is driven from a database of rules.  The
-most common rules are :rewrite rules, which cause the simplifier to
-replace one term with another.  Events introduce rules into the
-database.  For example, a defun event may introduce runes for
-symbolically replacing a function call by its instantiated body, for
-evaluating the function on constants, for determining the type of a
-call of the function, and for the induction scheme introduced upon
-defining the function.  Defthm may introduce several rules, one for
-each of the :rule-classes specified (where one rule class is specified
-if :rule-classes is omitted, namely, :rewrite).
-
-Every rule in the system has a name.  Each name is a structured object
-called a "rune," which is short for "rule name".  Runes are always of
-the form (:token symbol . x), where :token is some keyword symbol
-indicating what kind of rule is named, symbol is the event name that
-created the rule (and is called the "base symbol" of the rune), and x
-is either nil or a natural number that makes the rule name distinct
-from that of rules generated by other events or by other :rule-classes
-within the same event.
-
-For example, an event of the form
-
-     (defthm name thm
-       :rule-classes ((:REWRITE :COROLLARY term1)
-                      (:REWRITE :COROLLARY term2)
-                      (:ELIM    :COROLLARY term3)))
-
-typically creates three rules, each with a unique rune.  The runes are
-
-     (:REWRITE name . 1), (:REWRITE name . 2), and (:ELIM name).
-
-However, a given formula may create more than one rule, and all rules
-generated by the same :corollary formula will share the same rune.
-Consider the following example.
-
-     (defthm my-thm
-       (and (equal (foo (bar x)) x)
-            (equal (bar (foo x)) x)))
-
-This is treated identically to the following.
-
-     (defthm my-thm
-       (and (equal (foo (bar x)) x)
-            (equal (bar (foo x)) x))
-       :rule-classes ((:rewrite
-                       :corollary
-                       (and (equal (foo (bar x)) x)
-                            (equal (bar (foo x)) x)))))
-
-In either case, two rules are created: one rewriting (foo (bar x)) to
-x, and one rewriting (bar (foo x)) to x.  However, only a single rune
-is created, (:REWRITE MY-THM), because there is only one rule class.
-But now consider the following example.
-
-     (defthm my-thm2
-       (and (equal (foo (bar x)) x)
-            (equal (bar (foo x)) x))
-       :rule-classes ((:rewrite
-                       :corollary
-                       (and (equal (foo (bar x)) x)
-                            (equal (bar (foo x)) x)))
-                      (:rewrite
-                       :corollary
-                       (and (equal (foo (bar (foo x))) (foo x))
-                            (equal (bar (foo (bar x))) (bar x))))))
-
-This time there are four rules created.  The first two rules are as
-before, and are assigned the rune (:REWRITE MY-THM . 1).  The other two
-rules are similarly generated for the second :corollary, and are
-assigned the rune (:REWRITE MY-THM . 2).
-
-The function corollary will return the corollary term associated with a
-given rune in a given world.  Example:
-
-     (corollary '(:TYPE-PRESCRIPTION DIGIT-TO-CHAR) (w state))
-
-However, the preferred way to see the corollary term associated with a
-rune or a name is to use :pf; see *note PF::.
-
-The defun event creates as many as four rules.  (:definition fn) is the
-rune given to the equality axiom defining the function, fn.
-(:executable-counterpart fn) is the rune given to the rule for computing
-fn on known arguments.  A type prescription rule may be created under
-the name (:type-prescription fn), and an induction rule may be created
-under the name (:induction fn).
-
-Runes may be individually enabled and disabled, according to whether
-they are included in the current theory.  See *note THEORIES::.  Thus,
-it is permitted to disable (:elim name), say, while enabling the other
-rules derived from name.  Similarly, (:definition fn) may be disabled
-while (:executable-counterpart fn) and the type prescriptions for fn
-are enabled.
-
-Associated with most runes is the formula justifying the rule named.
-This is called the "corollary formula" of the rune and may be obtained
-via the function corollary, which takes as its argument a rune and a
-property list world.  Also see *note PF::.  The corollary formula for
-(:rewrite name . 1) after the defthm event above is term1.  The
-corollary formulas for (:definition fn) and (:executable-counterpart
-fn) are always identical: the defining axiom.  Some runes, e.g.,
-(:definition car), do not have corollary formulas.  Corollary returns
-nil on such runes.  In any case, the corollary formula of a rune, when
-it is non-nil, is a theorem and may be used in the :use and :by hints.
-
-Note: The system has many built in rules that, for regularity, ought to
-have names but don't because they can never be disabled.  One such rule
-is that implemented by the linear arithmetic package.  Because many of
-our subroutines are required by their calling conventions to return the
-justifying rune, we have invented the notion of "fake runes." Fake
-runes always have the base symbol nil, use a keyword token that
-includes the phrase "fake-rune", and are always enabled.  For example,
-(:fake-rune-for-linear nil) is a fake rune.  Occasionally the system
-will print a fake rune where a rune is expected.  For example, when the
-linear arithmetic fake rune is reported among the rules used in a
-proof, it is an indication that the linear arithmetic package was used.
-However, fake runes are not allowed in theories, they cannot be enabled
-or disabled, and they do not have associated corollary formulas.  In
-short, despite the fact that the user may sometimes see fake runes
-printed, they should never be typed.
-
-
-File: acl2-doc-emacs.info,  Node: SET-DIFFERENCE-THEORIES,  Next: THEORIES-AND-PRIMITIVES,  Prev: RUNE,  Up: THEORIES
-
-SET-DIFFERENCE-THEORIES    difference of two theories
-
-     Example:
-     (set-difference-theories (current-theory :here)
-                              '(fact (fact)))
-
-     General Form:
-     (set-difference-theories th1 th2)
-
-where th1 and th2 are theories (see *note THEORIES::).  To each of the
-arguments there corresponds a runic theory.  This function returns the
-set-difference of those two runic theories, represented as a list and
-ordered chronologically.  That is, a rune is in the result iff it is in
-the first runic theory but not in the second.
-
-The standard way to "disable" a theory, lst, is: (in-theory
-(set-difference-theories (current-theory :here) lst)).
-
-This "function" is actually a macro that expands to a term mentioning
-the single free variable world.  When theory expressions are evaluated
-by in-theory or the :in-theory hint, world is bound to the current ACL2
-world.
-
-
-File: acl2-doc-emacs.info,  Node: THEORIES-AND-PRIMITIVES,  Next: THEORY,  Prev: SET-DIFFERENCE-THEORIES,  Up: THEORIES
-
-THEORIES-AND-PRIMITIVES    warnings from disabling certain built-in functions
-
-When you disable the definition or executable-counterpart of a built-in
-function, you may see a warning, for example as follows.
-
-       ACL2 !>(in-theory (disable mv-nth))
-
-       ACL2 Warning [Theory] in ( IN-THEORY (DISABLE ...)):  Although the
-       theory expression (DISABLE MV-NTH) disables the :DEFINITION rule for
-       MV-NTH, some expansions involving this function may still occur.  See
-       :DOC theories-and-primitives.
-
-This warning can be eliminated by turning off all theory warnings (see
-*note SET-INHIBIT-WARNINGS::) or simply by evaluating the following
-form.
-
-       (assign verbose-theory-warning nil)
-
-But before you eliminate such warnings, you may wish to read the
-following to understand their significance.
-
-First consider the following example, evaluated after the in-theory
-event displayed above.
-
-       ACL2 !>(thm (equal (mv-nth 2 (list a b c d e)) c))
-
-       Q.E.D.
-
-       Summary
-       Form:  ( THM ...)
-       Rules: ((:DEFINITION MV-NTH)
-               (:FAKE-RUNE-FOR-TYPE-SET NIL))
-       Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
-       Prover steps counted:  19
-
-       Proof succeeded.
-       ACL2 !>
-
-Note that even though the definition of mv-nth had been disabled,
-nevertheless its definition rule was used in proving this theorem.  It
-is as though mv-nth had not been been disabled after all!  The warning
-is intended to indicate that expansion of mv-nth calls may be made by
-the theorem prover even when mv-nth is disabled.  Indeed, the prover
-has special-purpose code for simplifying certain mv-nth calls.
-
-A similar issue can arise for executable-counterpart rules, as the
-following log illustrates.
-
-       ACL2 !>(in-theory (disable (:executable-counterpart symbolp)))
-
-       ACL2 Warning [Theory] in ( IN-THEORY (DISABLE ...)):  Although the
-       theory expression (DISABLE (:EXECUTABLE-COUNTERPART SYMBOLP)) disables
-       the :EXECUTABLE-COUNTERPART rule for SYMBOLP, some calls involving
-       this function may still be made.  See :DOC theories-and-primitives.
-
-
-       Summary
-       Form:  ( IN-THEORY (DISABLE ...))
-       Rules: NIL
-       Warnings:  Theory
-       Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
-        2921
-       ACL2 !>(thm (symbolp 'a))
-
-       Q.E.D.
-
-       Summary
-       Form:  ( THM ...)
-       Rules: NIL
-       Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
-
-       Proof succeeded.
-       ACL2 !>
-
-In general, ACL2 warns when in-theory events or hints leave you in a
-theory where a rule for a built-in function is disabled but may be
-applied in some cases nonetheless, because of special-purpose prover
-code for handling calls of that function.  The built-in function
-symbols with such definition rules or executable-counterpart rules are
-those in the following two lists, respectively.
-
-       ACL2 !>*definition-minimal-theory*
-       (MV-NTH IFF NOT
-               IMPLIES EQ ATOM EQL = /= NULL ENDP ZEROP
-               SYNP PLUSP MINUSP LISTP RETURN-LAST
-               MV-LIST THE-CHECK WORMHOLE-EVAL
-               FORCE CASE-SPLIT DOUBLE-REWRITE)
-       ACL2 !>*built-in-executable-counterparts*
-       (ACL2-NUMBERP BINARY-* BINARY-+ UNARY-- UNARY-/
-                     < CAR CDR CHAR-CODE CHARACTERP CODE-CHAR
-                     COMPLEX COMPLEX-RATIONALP COERCE
-                     CONS CONSP DENOMINATOR EQUAL IF IMAGPART
-                     INTEGERP INTERN-IN-PACKAGE-OF-SYMBOL
-                     NUMERATOR PKG-WITNESS PKG-IMPORTS
-                     RATIONALP REALPART STRINGP SYMBOL-NAME
-                     SYMBOL-PACKAGE-NAME SYMBOLP NOT)
-       ACL2 !>
-
-
-File: acl2-doc-emacs.info,  Node: THEORY,  Next: THEORY-FUNCTIONS,  Prev: THEORIES-AND-PRIMITIVES,  Up: THEORIES
-
-THEORY    retrieve named theory
-
-     Example:
-     (theory 'ground-zero)
-
-In the example above, the theory returned is the one in force when ACL2
-is started up (see *note GROUND-ZERO::).
-
-     General Form:
-     (theory name)
-
-where name is the name of a previously executed deftheory event
-(otherwise a hard error occurs).  Returns the named theory.  See *note
-THEORIES::.
-
-This "function" is actually a macro that expands to a term mentioning
-the single free variable world.  When theory expressions are evaluated
-by in-theory or the :in-theory hint, world is bound to the current ACL2
-world.
-
-
-File: acl2-doc-emacs.info,  Node: THEORY-FUNCTIONS,  Next: UNION-THEORIES,  Prev: THEORY,  Up: THEORIES
-
-THEORY-FUNCTIONS    functions for obtaining or producing theories
-
-     Example Calls of Theory Functions:
-     (universal-theory :here)
-     (union-theories th1 th2)
-     (set-difference-theories th1 th2)
-
-The theory functions are documented individually:
-
-* Menu:
-
-
-Related topics other than immediate subtopics:
-* CURRENT-THEORY:: currently enabled rules as of logical name
-
-* DISABLE:: deletes names from current theory
-
-* E/D:: enable/disable rules
-
-* ENABLE:: adds names to current theory
-
-* EXECUTABLE-COUNTERPART-THEORY:: executable counterpart rules as of logical name
-
-* FUNCTION-THEORY:: function symbol rules as of logical name
-
-* GROUND-ZERO:: enabled rules in the startup theory
-
-* INTERSECTION-THEORIES:: intersect two theories
-
-* MINIMAL-THEORY:: a minimal theory to enable
-
-* SET-DIFFERENCE-THEORIES:: difference of two theories
-
-* THEORY:: retrieve named theory
-
-* UNION-THEORIES:: union two theories
-
-* UNIVERSAL-THEORY:: all rules as of logical name
-
-The functions (actually, macros) mentioned above are convenient ways to
-produce theories.  (See *note THEORIES::.) Some, like universal-theory,
-take a logical name (see *note LOGICAL-NAME::) as an argument and
-return the relevant theory as of the time that name was introduced.
-Others, like union-theories, take two theories and produce a new one.
-See *note REDUNDANT-EVENTS:: for a caution about the use of logical
-names in theory expressions.
-
-Theory expressions are generally composed of applications of theory
-functions.  Formally, theory expressions are expressions that involve,
-at most, the free variable world and that when evaluated with world
-bound to the current ACL2 world (see *note WORLD::) return theories.
-The "theory functions" are actually macros that expand into forms that
-involve the free variable world.  Thus, for example (universal-theory
-:here) actually expands to (universal-theory-fn :here world) and when
-that form is evaluated with world bound to the current ACL2 world,
-universal-theory-fn scans the ACL2 property lists and computes the
-current universal theory.  Because the theory functions all implicitly
-use world, the variable does not generally appear in anything the user
-types.
-
-
-File: acl2-doc-emacs.info,  Node: UNION-THEORIES,  Next: UNIVERSAL-THEORY,  Prev: THEORY-FUNCTIONS,  Up: THEORIES
-
-UNION-THEORIES    union two theories
-
-     Example:
-     (union-theories (current-theory 'lemma3)
-                     (theory 'arith-patch))
-
-     General Form:
-     (union-theories th1 th2)
-
-where th1 and th2 are theories (see *note THEORIES::).  To each of the
-arguments there corresponds a runic theory.  This function returns the
-union of those two runic theories, represented as a list and ordered
-chronologically.
-
-This "function" is actually a macro that expands to a term mentioning
-the single free variable world.  When theory expressions are evaluated
-by in-theory or the :in-theory hint, world is bound to the current ACL2
-world.
-
-
-File: acl2-doc-emacs.info,  Node: UNIVERSAL-THEORY,  Prev: UNION-THEORIES,  Up: THEORIES
-
-UNIVERSAL-THEORY    all rules as of logical name
-
-     Examples:
-     (universal-theory :here)
-     (universal-theory 'lemma3)
-
-See *note LOGICAL-NAME::.
-
-     General Form:
-     (universal-theory logical-name)
-
-Returns the theory consisting of all the runes that existed immediately
-after logical-name was introduced.  See *note THEORIES:: and see *note
-LOGICAL-NAME::.  The theory includes logical-name itself (if there is a
-rule by that name).  (Note that since some events do not introduce
-rules (e.g., defmacro, defconst or defthm with :rule-classes nil), the
-universal-theory does not necessarily include a rune for every event
-name.)  The universal-theory is very long and you will probably regret
-printing it.
-
-You may experience a fencepost problem in deciding which logical-name
-to use.  Deflabel can always be used to mark unambiguously for future
-reference a particular point in the development of your theory.  This
-is convenient because deflabel does not introduce any rules and hence
-it doesn't matter if you count it as being in the interval or not.  The
-order of events in the vicinity of an encapsulate is confusing.  See
-*note ENCAPSULATE::.
-
-This "function" is actually a macro that expands to a term mentioning
-the single free variable world.  When theory expressions are evaluated
-by in-theory or the :in-theory hint, world is bound to the current ACL2
-world.
-
-Also see *note CURRENT-THEORY::.  Current-theory is much more commonly
-used than universal-theory.  The former includes only the enabled runes
-as of the given logical-name, which is probably what you want, while
-the latter includes disabled ones as well.
-
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-15 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-15
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-15	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-15	2013-09-30 17:39:46.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,6 +28,1099 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: WITH-OUTPUT,  Prev: WITH-GUARD-CHECKING,  Up: SWITCHES-PARAMETERS-AND-MODES
+
+WITH-OUTPUT    suppressing or turning on specified output for an event
+
+     Examples:
+
+     ; Turn off all output during evaluation of the indicated thm form.
+     (with-output
+      :off :all
+      :gag-mode nil
+      (thm (equal (app (app x y) z) (app x (app y z)))))
+
+     ; Prove the indicated theorem with the event summary turned off and
+     ; using the :goals setting for gag-mode.
+     (with-output
+        :off summary
+        :gag-mode :goals
+        (defthm app-assoc (equal (app (app x y) z) (app x (app y z)))))
+
+     ; Same effect as just above:
+     (with-output
+        :on summary
+        :summary nil
+        :gag-mode :goals
+        (defthm app-assoc (equal (app (app x y) z) (app x (app y z)))))
+
+     ; Turn on only the indicated parts of the summary.
+     (with-output
+        :on summary
+        :summary (time rules)
+        :gag-mode :goals  ; use gag-mode, with goal names printed
+        (defthm app-assoc (equal (app (app x y) z) (app x (app y z)))))
+
+     ; Same as specifying :off :all, but showing all output types:
+     (with-output
+      :off (error warning warning! observation prove proof-checker event expansion
+                  summary proof-tree)
+      :gag-mode nil
+      (thm (equal (app (app x y) z) (app x (app y z)))))
+
+     ; Same as above, but :stack :push says to save the current
+     ; inhibit-output-lst, which can be restored in a subsidiary with-output call
+     ; that specifies :stack :pop.
+     (with-output
+      :stack :push
+      :off :all
+      :gag-mode nil
+      (thm (equal (app (app x y) z) (app x (app y z)))))
+
+     General Form:
+     (with-output :key1 val1 ... :keyk valk form)
+
+where each :keyi is either :off, :on, :stack, :summary, or :gag-mode;
+form evaluates to an error triple (see *note ERROR-TRIPLES::); and vali
+is as follows.  If :keyi is :off or :on, then vali can be :all, and
+otherwise is a symbol or non-empty list of symbols representing output
+types that can be inhibited; see *note SET-INHIBIT-OUTPUT-LST::.  If
+:keyi is :gag-mode, then vali is one of the legal values for
+:set-gag-mode.  If :keyi is :summary, then vali is either :all or a
+true-list of symbols each of which belongs to the list *summary-types*.
+Otherwise :keyi is :stack, in which case :vali is :push or :pop; for
+now assume that :stack is not specified (we'll return to it below).
+The result of evaluating the General Form above is to evaluate form,
+but in an environment where output occurs as follows.  If :on :all is
+specified, then every output type is turned on except as inhibited by
+:off; else if :off :all is specified, then every output type is
+inhibited except as specified by :on; and otherwise, the
+currently-inhibited output types are reduced as specified by :on and
+then extended as specified by :off.  But if :gag-mode is specified,
+then before modifying how output is inhibited, gag-mode is set for the
+evaluation of form as specified by the value of :gag-mode; see *note
+SET-GAG-MODE::.  If summary is among the output types that are turned
+on (not inhibited), then if :summary is specified, the only parts of
+the summary to be printed will be those specified by the value of
+:summary.  The correspondence should be clear, except perhaps that
+header refers to the line containing only the word Summary, and value
+refers to the value of the form printed during evaluation of sequences
+of events as for progn and encapsulate.
+
+Note that the handling of the :stack argument pays no attention to the
+:summary argument.
+
+Note: When the scope of with-output is exited, then all modifications
+are undone, reverting gag-mode and the state of output inhibition to
+those which were present before the with-output call was entered.
+
+The :stack keyword's effect is illustrated by the following example,
+where "(encapsulate nil)" may replaced by "(progn" without any change
+to the output that is printed.
+
+     (with-output
+      :stack :push :off :all
+      (encapsulate ()
+        (defun f1 (x) x)
+        (with-output :stack :pop (defun f2 (x) x))
+        (defun f3 (x) x)
+        (with-output :stack :pop :off warning (in-theory nil))
+        (defun f4 (x) x)))
+
+The outer with-output call saves the current output settings (as may
+have been modified by earlier calls of set-inhibit-output-lst), by
+pushing them onto a stack, and then turns off all output.  Each inner
+with-output call temporarily pops that stack, restoring the starting
+output settings, until it completes and undoes the effects of that pop.
+Unless event output was inhibited at the top level (see *note
+SET-INHIBIT-OUTPUT-LST::), the following output is shown:
+
+     Since F2 is non-recursive, its admission is trivial.  We observe that
+     the type of F2 is described by the theorem (EQUAL (F2 X) X).
+
+And then, if summary output was not inhibited at the top level, we get
+the rest of this output:
+
+     Summary
+     Form:  ( DEFUN F2 ...)
+     Rules: NIL
+     Warnings:  None
+     Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
+
+     Summary
+     Form:  ( IN-THEORY NIL)
+     Rules: NIL
+     Warnings:  None
+     Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
+
+Note that the use of :off warning supresses a "Theory" warning for the
+(in-theory nil) event, and that in no case will output be printed for
+definitions of f1, f3, or f4, or for the encapsulate event itself.
+
+The following more detailed explanation of :stack is intended only for
+advanced users.  After :gag-mode is handled (if present) but before :on
+or :off is handled, the value of :stack is handled as follows.  If the
+value is :push, then state global inhibit-output-lst-stack is modified
+by pushing the value of state global inhibit-output-lst onto the value
+of state global inhibit-output-lst-stack, which is nil at the top
+level.  If the value is :pop, then state global
+inhibit-output-lst-stack is modified only if non-nil, in which case its
+top element is popped and becomes the value of of state global
+inhibit-output-lst.
+
+Warning: With-output has no effect in raw Lisp, and hence is disallowed
+in function bodies.  However, you can probably get the effect you want
+as illustrated below, where <form> must return an error triple (mv erp
+val state); see *note LD:: and see *note ERROR-TRIPLES::.
+
+     Examples avoiding with-output, for use in function definitions:
+
+     ; Inhibit all output:
+     (state-global-let*
+      ((inhibit-output-lst *valid-output-names*))
+      <form>)
+
+     ; Inhibit all warning output:
+     (state-global-let*
+      ((inhibit-output-lst
+        (union-eq (f-get-global 'inhibit-output-lst state)
+                  '(warning warning!))))
+      <form>)
+
+Note that with-output is allowed in books.  See *note
+EMBEDDED-EVENT-FORM::.
+
+
+File: acl2-doc-emacs.info,  Node: THEORIES,  Next: TRACE,  Prev: SWITCHES-PARAMETERS-AND-MODES,  Up: Top
+
+THEORIES    sets of runes to enable/disable in concert
+
+     Example: '((:definition app) ; or (:d app)
+                (:executable-counterpart app)
+                (:i app)
+                rv
+                (rv)
+                assoc-of-app)
+
+See:
+
+* Menu:
+
+* ACTIVE-RUNEP:: check that a rune exists and is enabled
+
+* CURRENT-THEORY:: currently enabled rules as of logical name
+
+* DISABLE:: deletes names from current theory
+
+* E/D:: enable/disable rules
+
+* ENABLE:: adds names to current theory
+
+* EXECUTABLE-COUNTERPART-THEORY:: executable counterpart rules as of logical name
+
+* FUNCTION-THEORY:: function symbol rules as of logical name
+
+* GROUND-ZERO:: enabled rules in the startup theory
+
+* INCOMPATIBLE:: declaring that two rules should not both be enabled
+
+* INTERSECTION-THEORIES:: intersect two theories
+
+* MINIMAL-THEORY:: a minimal theory to enable
+
+* RULE-NAMES:: How rules are named.
+
+* RUNE:: a rule name
+
+* SET-DIFFERENCE-THEORIES:: difference of two theories
+
+* THEORIES-AND-PRIMITIVES:: warnings from disabling certain built-in functions
+
+* THEORY:: retrieve named theory
+
+* THEORY-FUNCTIONS:: functions for obtaining or producing theories
+
+* UNION-THEORIES:: union two theories
+
+* UNIVERSAL-THEORY:: all rules as of logical name
+
+
+Related topics other than immediate subtopics:
+* DEFTHEORY:: define a theory (to enable or disable a set of rules)
+
+* DEFTHEORY-STATIC:: define a `static' theory (to enable or disable a set of rules)
+
+* IN-THEORY:: designate ``current'' theory (enabling its rules)
+
+A theory is a list of "runic designators" as described below.  Each
+runic designator denotes a set of "runes" (see *note RUNE::) and by
+unioning together the runes denoted by each member of a theory we
+define the set of runes corresponding to a theory.  Theories are used
+to control which rules are "enabled," i.e., available for automatic
+application by the theorem prover.  There is always a "current" theory.
+A rule is enabled precisely if its rune is an element of the set of
+runes corresponding to the current theory.  At the top-level, the
+current theory is the theory selected by the most recent in-theory
+event, extended with the rule names introduced since then.  Inside the
+theorem prover, the :in-theory hint (see *note HINTS::) can be used to
+select a particular theory as current during the proof attempt for a
+particular goal.
+
+Theories are generally constructed by "theory expressions."  Formally, a
+theory expression is any term, containing at most the single free
+variable world, that when evaluated with world bound to the current ACL2
+world (see *note WORLD::) produces a theory.  ACL2 provides various
+functions for the convenient construction and manipulation of theories.
+These are called "theory functions"(see *note THEORY-FUNCTIONS::).  For
+example, the theory function union-theories takes two theories and
+produces their union.  The theory function universal-theory returns the
+theory containing all known rule names as of the introduction of a
+given logical name.  But a theory expression can contain constants,
+e.g.,
+
+     '(len (len) (:rewrite car-cons) car-cdr-elim)
+
+and user-defined functions.  The only important criterion is that a
+theory expression mention no variable freely except world and evaluate
+to a theory.
+
+More often than not, theory expressions typed by the user do not
+mention the variable world.  This is because user-typed theory
+expressions are generally composed of applications of ACL2's theory
+functions.  These "functions" are actually macros that expand into
+terms in which world is used freely and appropriately.  Thus, the
+technical definition of "theory expression" should not mislead you into
+thinking that interestng theory expressions must mention world; they
+probably do and you just didn't know it!
+
+One aspect of this arrangement is that theory expressions cannot
+generally be evaluated at the top-level of ACL2, because world is not
+bound.  To see the value of a theory expression, expr, at the
+top-level, type
+
+     ACL2 !>(LET ((WORLD (W STATE))) expr).
+
+However, because the built-in theories are quite long, you may be sorry
+you printed the value of a theory expression!
+
+A theory is a true list of runic designators and to each theory there
+corresponds a set of runes, obtained by unioning together the sets of
+runes denoted by each runic designator.  For example, the theory
+constant
+
+        '(len (len) (:e nth) (:rewrite car-cons) car-cdr-elim)
+
+corresponds to the set of runes
+
+        {(:definition len)
+         (:induction len)
+         (:executable-counterpart len)
+         (:executable-counterpart nth)
+         (:elim car-cdr-elim)
+         (:rewrite car-cons)} .
+
+Observe that the theory contains five elements but its runic
+correspondent contains six.  That is because runic designators can
+denote sets of several runes, as is the case for the first designator,
+len.  If the above theory were selected as current then the six rules
+named in its runic counterpart would be enabled and all other rules
+would be disabled.
+
+We now precisely define the runic designators and the set of runes
+denoted by each.  When we refer below to the "macro-aliases dereference
+of" a symbol, symb, we mean the (function) symbol corresponding symb in
+the macro-aliases-table if there is such a symbol, else symb itself;
+see *note MACRO-ALIASES-TABLE::.  For example, the macro-aliases
+dereference of append is binary-append, and the macro-aliases
+dereference of nth is nth.
+
+     o A rune is a runic designator and denotes the singleton set
+     containing that rune.
+
+     o Suppose that symb is a symbol and symb' is the macro-aliases
+     dereference of symb, where symb' is a function symbol introduced
+     with a defun (or defuns) event.  Then symb is a runic designator
+     and denotes the set containing the runes (:definition symb') and
+     (:induction symb'), omitting the latter if no such induction rune
+     exists (presumably because the definition of symb' is not singly
+     recursive).
+
+     o Suppose that symb is a symbol and symb' is the macro-aliases
+     dereference of symb, where symb' is a function symbol introduced
+     with a defun (or defuns) event.  Then (symb) is a runic designator
+     and denotes the singleton set containing the rune
+     (:executable-counterpart symb').
+
+     o If symb is the name of a defthm (or defaxiom) event that
+     introduced at least one rule, then symb is a runic designator and
+     denotes the set of the names of all rules introduced by the named
+     event.
+
+     o If str is the string naming some defpkg event and symb is the
+     symbol returned by (intern str "ACL2"), then symb is a runic
+     designator and denotes the singleton set containing (:rewrite
+     symb), which is the name of the rule stating the conditions under
+     which the symbol-package-name of (intern x str) is str.
+
+     o If symb is the name of a deftheory event, then symb is a runic
+     designator and denotes the runic theory corresponding to symb.
+
+     o Finally, suppose that symb is a symbol and symb' is the
+     macro-aliases dereference of symb.  Then (:KWD symb . rest) is a
+     runic designator if (:KWD' symb' . rest) is a rune, where :KWD is
+     one of :d, :e, :i, or :t, and correspondingly :KWD' is
+     :definition, :executable-counterpart, :induction, or
+     :type-prescription, respectively.  In this case, (:KWD symb . rest)
+     denotes the runic theory corresponding to the rune (:KWD' symb' .
+     rest).
+
+Note that including a function name, e.g., len, in the current theory
+enables that function but does not enable the executable counterpart.
+Similarly, including (len) or (:e len) enables the executable
+counterpart but not the symbolic definition.  And including the name of
+a proved lemma enables all of the rules added by the event.  Of course,
+one can include explicitly the runes naming the rules in question and
+so can avoid entirely the use of non-runic elements in theories.
+
+Because a rune is a runic designator denoting the set containing that
+rune, a list of runes is a theory and denotes itself.  We call such
+theories "runic theories."  To every theory there corresponds a runic
+theory obtained by unioning together the sets denoted by each
+designator in the theory.  When a theory is selected as "current" it is
+actually its runic correspondent that is effectively used.  That is, a
+rune is enabled iff it is a member of the runic correspondent of the
+current theory.  The value of a theory defined with deftheory is the
+runic correspondent of the theory computed by the defining theory
+expression.  The theory manipulation functions, e.g., union-theories,
+actually convert their theory arguments to their runic correspondents
+before performing the required set operation.  The manipulation
+functions always return runic theories.  Thus, it is sometimes
+convenient to think of (non-runic) theories as merely abbreviations for
+their runic correspondents, abbreviations which are "expanded" at the
+first opportunity by theory manipulation functions and the "theory
+consumer" functions such as in-theory and deftheory.
+
+
+File: acl2-doc-emacs.info,  Node: ACTIVE-RUNEP,  Next: CURRENT-THEORY,  Prev: THEORIES,  Up: THEORIES
+
+ACTIVE-RUNEP    check that a rune exists and is enabled
+
+     Example:
+     (active-runep '(:rewrite left-to-right))
+
+     General Form:
+     (active-runep rune)
+
+where rune has the shape of a rune.  This macro expands to an
+expression using the variables ens and state, and returns non-nil when
+the given rune exists and is enabled (according to the given "enabled
+structure," ens, and the current logical world of the given state).
+See *note THEORY-INVARIANT:: for how this macro can be of use.
+
+
+File: acl2-doc-emacs.info,  Node: CURRENT-THEORY,  Next: DISABLE,  Prev: ACTIVE-RUNEP,  Up: THEORIES
+
+CURRENT-THEORY    currently enabled rules as of logical name
+
+     Examples:
+     (current-theory :here)
+     (current-theory 'lemma3)
+
+See *note LOGICAL-NAME::.
+
+     General Form:
+     (current-theory logical-name)
+
+Returns the current theory as it existed immediately after the
+introduction of logical-name provided it is evaluated in an environment
+in which the variable symbol WORLD is bound to the current ACL2 logical
+world, (w state).  Thus,
+
+     ACL2 !>(current-theory :here)
+
+will cause an (unbound variable) error while
+
+     ACL2 !>(let ((world (w state))) (current-theory :here))
+
+will return the current theory in world.
+
+See *note THEORIES:: and see *note LOGICAL-NAME:: for a discussion of
+theories in general and why the commonly used "theory functions" such
+as current-theory are really macros that expand into terms involving
+the variable world.
+
+The theory returned by current-theory is in fact the theory selected by
+the in-theory event most recently preceding logical name, extended by
+the rules introduced up through logical-name.
+
+You may experience a fencepost problem in deciding which logical name
+to use.  Deflabel can always be used to mark unambiguously for future
+reference a particular point in the development of your theory.  The
+order of events in the vicinity of an encapsulate is confusing.  See
+*note ENCAPSULATE::.
+
+This "function" is actually a macro that expands to a term mentioning
+the single free variable world.  When theory expressions are evaluated
+by in-theory or the :in-theory hint, world is bound to the current ACL2
+world.
+
+
+File: acl2-doc-emacs.info,  Node: DISABLE,  Next: E/D,  Prev: CURRENT-THEORY,  Up: THEORIES
+
+DISABLE    deletes names from current theory
+
+     Example:
+     (disable fact (fact) associativity-of-app)
+
+     General Form:
+     (disable name1 name2 ... namek)
+
+where each namei is a runic designator; see *note THEORIES::.  The
+result is the theory that contains all the names in the current theory
+except those listed.  Note that this is merely a function that returns
+a theory.  The result is generally a very long list of runes and you
+will probably regret printing it.
+
+The standard way to "disable" a fixed set of names, is as follows; see
+*note HINTS:: and see *note IN-THEORY::.
+
+     :in-theory (disable name1 name2 ... namek)    ; in a hint
+     (in-theory (disable name1 name2 ... namek))   ; as an event
+     (local ; often desirable, to avoid exporting from the current context
+      (in-theory (disable name1 name2 ... namek)))
+
+Note that all the names are implicitly quoted.  If you wish to disable
+a computed list of names, lst, use the theory expression
+(set-difference-theories (current-theory :here) lst).
+
+
+File: acl2-doc-emacs.info,  Node: E/D,  Next: ENABLE,  Prev: DISABLE,  Up: THEORIES
+
+E/D    enable/disable rules
+
+The macro e/d creates theory expressions for use in in-theory hints and
+events.  It provides a convenient way to enable and disable
+simultaneously, without having to write arcane theory expressions.
+
+     Examples:
+     (e/d (lemma1 lemma2))          ; equivalent to (enable lemma1 lemma2)
+     (e/d () (lemma))               ; equivalent to (disable lemma)
+     (e/d (lemma1) (lemma2 lemma3)) ; Enable lemma1 then disable lemma2, lemma3.
+     (e/d () (lemma1) (lemma2))     ; Disable lemma1 then enable lemma2.
+
+     General Form:
+     (e/d enables-0 disables-0 ... enables-n disables-n)
+
+where each enables-i and disables-i is a list of runic designators; see
+*note THEORIES::, see *note ENABLE::, and see *note DISABLE::.
+
+The e/d macro takes any number of lists suitable for the enable and
+disable macros, and creates a theory that is equal to (current-theory
+:here) after executing the following commands.
+
+(in-theory (enable . enables-0)) (in-theory (disable . disables-0))
+[etc.]  (in-theory (enable . enables-n)) (in-theory (disable .
+disables-n))
+
+
+File: acl2-doc-emacs.info,  Node: ENABLE,  Next: EXECUTABLE-COUNTERPART-THEORY,  Prev: E/D,  Up: THEORIES
+
+ENABLE    adds names to current theory
+
+     Example:
+     (enable fact (fact) associativity-of-app)
+
+     General Form:
+     (enable name1 name2 ... namek)
+
+where each namei is a runic designator; see *note THEORIES::.  The
+result is the theory that contains all the names in the current theory
+plus those listed.  Note that this is merely a function that returns a
+theory.  The result is generally a very long list of runes and you will
+probably regret printing it.
+
+The standard way to "enable" a fixed set of names, is as follows; see
+*note HINTS:: and see *note IN-THEORY::.
+
+     :in-theory (enable name1 name2 ... namek)  ; in a hint
+     (in-theory (enable name1 name2 ... namek)) ; as an event
+     (local ; often desirable, to avoid exporting from the current context
+      (in-theory (enable name1 name2 ... namek)))
+
+Note that all the names are implicitly quoted.  If you wish to enable a
+computed list of names, lst, use the theory expression (union-theories
+(current-theory :here) lst).
+
+
+File: acl2-doc-emacs.info,  Node: EXECUTABLE-COUNTERPART-THEORY,  Next: FUNCTION-THEORY,  Prev: ENABLE,  Up: THEORIES
+
+EXECUTABLE-COUNTERPART-THEORY    executable counterpart rules as of logical name
+
+     Examples:
+     (executable-counterpart-theory :here)
+     (executable-counterpart-theory 'lemma3)
+
+See *note LOGICAL-NAME::.
+
+     General Form:
+     (executable-counterpart-theory logical-name)
+
+Returns the theory containing all the :executable-counterpart runes,
+whether enabled or not, that existed immediately after logical-name was
+introduced.  See the documentation for theories, logical-name,
+executable-counterpart and function-theory.
+
+You may experience a fencepost problem in deciding which logical name
+to use.  Deflabel can always be used to mark unambiguously for future
+reference a particular point in the development of your theory.  The
+order of events in the vicinity of an encapsulate is confusing.  See
+*note ENCAPSULATE::.
+
+This "function" is actually a macro that expands to a term mentioning
+the single free variable world.  When theory expressions are evaluated
+by in-theory or the :in-theory hint, world is bound to the current ACL2
+world.
+
+
+File: acl2-doc-emacs.info,  Node: FUNCTION-THEORY,  Next: GROUND-ZERO,  Prev: EXECUTABLE-COUNTERPART-THEORY,  Up: THEORIES
+
+FUNCTION-THEORY    function symbol rules as of logical name
+
+     Examples:
+     (function-theory :here)
+     (function-theory 'lemma3)
+
+See *note LOGICAL-NAME::.
+
+     General Form:
+     (function-theory logical-name)
+
+Returns the theory containing all the :definition runes, whether
+enabled or not, that existed immediately after logical-name was
+introduced.  See the documentation for theories, logical-name and
+executable-counterpart-theory.
+
+You may experience a fencepost problem in deciding which logical name
+to use.  Deflabel can always be used to mark unambiguously for future
+reference a particular point in the development of your theory.  The
+order of events in the vicinity of an encapsulate is confusing.  See
+*note ENCAPSULATE::.
+
+This "function" is actually a macro that expands to a term mentioning
+the single free variable world.  When theory expressions are evaluated
+by in-theory or the :in-theory hint, world is bound to the current ACL2
+world.
+
+
+File: acl2-doc-emacs.info,  Node: GROUND-ZERO,  Next: INCOMPATIBLE,  Prev: FUNCTION-THEORY,  Up: THEORIES
+
+GROUND-ZERO    enabled rules in the startup theory
+
+ACL2 concludes its initialization (boot-strapping) procedure by
+defining the theory ground-zero; see *note THEORIES::.  In fact, this
+theory is just the theory defined by (current-theory :here) at the
+conclusion of initialization; see *note CURRENT-THEORY::.
+
+Note that by evaluating the event
+
+     (in-theory (current-theory 'ground-zero))
+
+you can restore the current theory to its value at the time you started
+up ACL2.
+
+
+File: acl2-doc-emacs.info,  Node: INCOMPATIBLE,  Next: INTERSECTION-THEORIES,  Prev: GROUND-ZERO,  Up: THEORIES
+
+INCOMPATIBLE    declaring that two rules should not both be enabled
+
+     Example:
+     (theory-invariant (incompatible (:rewrite left-to-right)
+                                     (:rewrite right-to-left)))
+
+     General Form:
+     (incompatible rune1 rune2)
+
+where rune1 and rune2 are two specific runes.  The arguments are not
+evaluated.  Invariant is just a macro that expands into a term that
+checks that not both runes are enabled.  See *note THEORY-INVARIANT::.
+
+
+File: acl2-doc-emacs.info,  Node: INTERSECTION-THEORIES,  Next: MINIMAL-THEORY,  Prev: INCOMPATIBLE,  Up: THEORIES
+
+INTERSECTION-THEORIES    intersect two theories
+
+     Example:
+     (intersection-theories (current-theory :here)
+                            (theory 'arith-patch))
+
+     General Form:
+     (intersection-theories th1 th2)
+
+where th1 and th2 are theories (see *note THEORIES::).  To each of the
+arguments there corresponds a runic theory.  This function returns the
+intersection of those two runic theories, represented as a list and
+ordered chronologically.
+
+This "function" is actually a macro that expands to a term mentioning
+the single free variable world.  When theory expressions are evaluated
+by in-theory or the :in-theory hint, world is bound to the current ACL2
+world.
+
+
+File: acl2-doc-emacs.info,  Node: MINIMAL-THEORY,  Next: RULE-NAMES,  Prev: INTERSECTION-THEORIES,  Up: THEORIES
+
+MINIMAL-THEORY    a minimal theory to enable
+
+This theory (see *note THEORIES::) enables only a few built-in
+functions and executable counterparts.  It can be useful when you want
+to formulate lemmas that rather immediately imply the theorem to be
+proved, by way of a :use hint (see *note HINTS::), for example as
+follows.
+
+     :use (lemma-1 lemma-2 lemma-3)
+     :in-theory (union-theories '(f1 f2) (theory 'minimal-theory))
+
+In this example, we expect the current goal to follow from lemmas
+lemma-1, lemma-2, and lemma-3 together with rules f1 and f2 and some
+obvious facts about built-in functions (such as the definition of
+implies and the :executable-counterpart of car).  The :in-theory hint
+above is intended to speed up the proof by turning off all inessential
+rules.
+
+
+File: acl2-doc-emacs.info,  Node: RULE-NAMES,  Next: RUNE,  Prev: MINIMAL-THEORY,  Up: THEORIES
+
+RULE-NAMES    How rules are named.
+
+     Examples:
+     (:rewrite assoc-of-app)
+     (:linear delta-aref . 2)
+     (:definition length)
+     (:executable-counterpart length)
+
+See *note RUNE::.
+
+
+File: acl2-doc-emacs.info,  Node: RUNE,  Next: SET-DIFFERENCE-THEORIES,  Prev: RULE-NAMES,  Up: THEORIES
+
+RUNE    a rule name
+
+     Examples:
+     (:rewrite assoc-of-app)
+     (:linear delta-aref . 2)
+     (:definition length)
+     (:executable-counterpart length)
+
+Note: This topic discusses a basic notion of "rule name", or "rune" for
+short.  Users often use abbrevitions for runes; for example, a theory
+expression (DISABLE APPEND) abbreviates the following set of runes:
+{(:DEFINITION BINARY-APPEND), (:INDUCTION BINARY-APPEND)}.  See *note
+THEORIES:: for a discussion of so-called "runic designators", which
+include expressions like APPEND (as above) as well as (APPEND) (for the
+executable-counterpart of BINARY-APPEND.  Runic designators can also be
+abbreviations including (:d APPEND), (:e APPEND), (:i APPEND), and (:t
+APPEND), which designate the definition, executable-counterpart,
+induction, and type-prescription rules for BINARY-APPEND.  For a
+complete description of runic designators, see *note THEORIES::; we
+return now to the more basic notion of a rune.
+
+Background: The theorem prover is driven from a database of rules.  The
+most common rules are :rewrite rules, which cause the simplifier to
+replace one term with another.  Events introduce rules into the
+database.  For example, a defun event may introduce runes for
+symbolically replacing a function call by its instantiated body, for
+evaluating the function on constants, for determining the type of a
+call of the function, and for the induction scheme introduced upon
+defining the function.  Defthm may introduce several rules, one for
+each of the :rule-classes specified (where one rule class is specified
+if :rule-classes is omitted, namely, :rewrite).
+
+Every rule in the system has a name.  Each name is a structured object
+called a "rune," which is short for "rule name".  Runes are always of
+the form (:token symbol . x), where :token is some keyword symbol
+indicating what kind of rule is named, symbol is the event name that
+created the rule (and is called the "base symbol" of the rune), and x
+is either nil or a natural number that makes the rule name distinct
+from that of rules generated by other events or by other :rule-classes
+within the same event.
+
+For example, an event of the form
+
+     (defthm name thm
+       :rule-classes ((:REWRITE :COROLLARY term1)
+                      (:REWRITE :COROLLARY term2)
+                      (:ELIM    :COROLLARY term3)))
+
+typically creates three rules, each with a unique rune.  The runes are
+
+     (:REWRITE name . 1), (:REWRITE name . 2), and (:ELIM name).
+
+However, a given formula may create more than one rule, and all rules
+generated by the same :corollary formula will share the same rune.
+Consider the following example.
+
+     (defthm my-thm
+       (and (equal (foo (bar x)) x)
+            (equal (bar (foo x)) x)))
+
+This is treated identically to the following.
+
+     (defthm my-thm
+       (and (equal (foo (bar x)) x)
+            (equal (bar (foo x)) x))
+       :rule-classes ((:rewrite
+                       :corollary
+                       (and (equal (foo (bar x)) x)
+                            (equal (bar (foo x)) x)))))
+
+In either case, two rules are created: one rewriting (foo (bar x)) to
+x, and one rewriting (bar (foo x)) to x.  However, only a single rune
+is created, (:REWRITE MY-THM), because there is only one rule class.
+But now consider the following example.
+
+     (defthm my-thm2
+       (and (equal (foo (bar x)) x)
+            (equal (bar (foo x)) x))
+       :rule-classes ((:rewrite
+                       :corollary
+                       (and (equal (foo (bar x)) x)
+                            (equal (bar (foo x)) x)))
+                      (:rewrite
+                       :corollary
+                       (and (equal (foo (bar (foo x))) (foo x))
+                            (equal (bar (foo (bar x))) (bar x))))))
+
+This time there are four rules created.  The first two rules are as
+before, and are assigned the rune (:REWRITE MY-THM . 1).  The other two
+rules are similarly generated for the second :corollary, and are
+assigned the rune (:REWRITE MY-THM . 2).
+
+The function corollary will return the corollary term associated with a
+given rune in a given world.  Example:
+
+     (corollary '(:TYPE-PRESCRIPTION DIGIT-TO-CHAR) (w state))
+
+However, the preferred way to see the corollary term associated with a
+rune or a name is to use :pf; see *note PF::.
+
+The defun event creates as many as four rules.  (:definition fn) is the
+rune given to the equality axiom defining the function, fn.
+(:executable-counterpart fn) is the rune given to the rule for computing
+fn on known arguments.  A type prescription rule may be created under
+the name (:type-prescription fn), and an induction rule may be created
+under the name (:induction fn).
+
+Runes may be individually enabled and disabled, according to whether
+they are included in the current theory.  See *note THEORIES::.  Thus,
+it is permitted to disable (:elim name), say, while enabling the other
+rules derived from name.  Similarly, (:definition fn) may be disabled
+while (:executable-counterpart fn) and the type prescriptions for fn
+are enabled.
+
+Associated with most runes is the formula justifying the rule named.
+This is called the "corollary formula" of the rune and may be obtained
+via the function corollary, which takes as its argument a rune and a
+property list world.  Also see *note PF::.  The corollary formula for
+(:rewrite name . 1) after the defthm event above is term1.  The
+corollary formulas for (:definition fn) and (:executable-counterpart
+fn) are always identical: the defining axiom.  Some runes, e.g.,
+(:definition car), do not have corollary formulas.  Corollary returns
+nil on such runes.  In any case, the corollary formula of a rune, when
+it is non-nil, is a theorem and may be used in the :use and :by hints.
+
+Note: The system has many built in rules that, for regularity, ought to
+have names but don't because they can never be disabled.  One such rule
+is that implemented by the linear arithmetic package.  Because many of
+our subroutines are required by their calling conventions to return the
+justifying rune, we have invented the notion of "fake runes." Fake
+runes always have the base symbol nil, use a keyword token that
+includes the phrase "fake-rune", and are always enabled.  For example,
+(:fake-rune-for-linear nil) is a fake rune.  Occasionally the system
+will print a fake rune where a rune is expected.  For example, when the
+linear arithmetic fake rune is reported among the rules used in a
+proof, it is an indication that the linear arithmetic package was used.
+However, fake runes are not allowed in theories, they cannot be enabled
+or disabled, and they do not have associated corollary formulas.  In
+short, despite the fact that the user may sometimes see fake runes
+printed, they should never be typed.
+
+
+File: acl2-doc-emacs.info,  Node: SET-DIFFERENCE-THEORIES,  Next: THEORIES-AND-PRIMITIVES,  Prev: RUNE,  Up: THEORIES
+
+SET-DIFFERENCE-THEORIES    difference of two theories
+
+     Example:
+     (set-difference-theories (current-theory :here)
+                              '(fact (fact)))
+
+     General Form:
+     (set-difference-theories th1 th2)
+
+where th1 and th2 are theories (see *note THEORIES::).  To each of the
+arguments there corresponds a runic theory.  This function returns the
+set-difference of those two runic theories, represented as a list and
+ordered chronologically.  That is, a rune is in the result iff it is in
+the first runic theory but not in the second.
+
+The standard way to "disable" a theory, lst, is: (in-theory
+(set-difference-theories (current-theory :here) lst)).
+
+This "function" is actually a macro that expands to a term mentioning
+the single free variable world.  When theory expressions are evaluated
+by in-theory or the :in-theory hint, world is bound to the current ACL2
+world.
+
+
+File: acl2-doc-emacs.info,  Node: THEORIES-AND-PRIMITIVES,  Next: THEORY,  Prev: SET-DIFFERENCE-THEORIES,  Up: THEORIES
+
+THEORIES-AND-PRIMITIVES    warnings from disabling certain built-in functions
+
+When you disable the definition or executable-counterpart of a built-in
+function, you may see a warning, for example as follows.
+
+       ACL2 !>(in-theory (disable mv-nth))
+
+       ACL2 Warning [Theory] in ( IN-THEORY (DISABLE ...)):  Although the
+       theory expression (DISABLE MV-NTH) disables the :DEFINITION rule for
+       MV-NTH, some expansions involving this function may still occur.  See
+       :DOC theories-and-primitives.
+
+This warning can be eliminated by turning off all theory warnings (see
+*note SET-INHIBIT-WARNINGS::) or simply by evaluating the following
+form.
+
+       (assign verbose-theory-warning nil)
+
+But before you eliminate such warnings, you may wish to read the
+following to understand their significance.
+
+First consider the following example, evaluated after the in-theory
+event displayed above.
+
+       ACL2 !>(thm (equal (mv-nth 2 (list a b c d e)) c))
+
+       Q.E.D.
+
+       Summary
+       Form:  ( THM ...)
+       Rules: ((:DEFINITION MV-NTH)
+               (:FAKE-RUNE-FOR-TYPE-SET NIL))
+       Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
+       Prover steps counted:  19
+
+       Proof succeeded.
+       ACL2 !>
+
+Note that even though the definition of mv-nth had been disabled,
+nevertheless its definition rule was used in proving this theorem.  It
+is as though mv-nth had not been been disabled after all!  The warning
+is intended to indicate that expansion of mv-nth calls may be made by
+the theorem prover even when mv-nth is disabled.  Indeed, the prover
+has special-purpose code for simplifying certain mv-nth calls.
+
+A similar issue can arise for executable-counterpart rules, as the
+following log illustrates.
+
+       ACL2 !>(in-theory (disable (:executable-counterpart symbolp)))
+
+       ACL2 Warning [Theory] in ( IN-THEORY (DISABLE ...)):  Although the
+       theory expression (DISABLE (:EXECUTABLE-COUNTERPART SYMBOLP)) disables
+       the :EXECUTABLE-COUNTERPART rule for SYMBOLP, some calls involving
+       this function may still be made.  See :DOC theories-and-primitives.
+
+
+       Summary
+       Form:  ( IN-THEORY (DISABLE ...))
+       Rules: NIL
+       Warnings:  Theory
+       Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
+        2921
+       ACL2 !>(thm (symbolp 'a))
+
+       Q.E.D.
+
+       Summary
+       Form:  ( THM ...)
+       Rules: NIL
+       Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
+
+       Proof succeeded.
+       ACL2 !>
+
+In general, ACL2 warns when in-theory events or hints leave you in a
+theory where a rule for a built-in function is disabled but may be
+applied in some cases nonetheless, because of special-purpose prover
+code for handling calls of that function.  The built-in function
+symbols with such definition rules or executable-counterpart rules are
+those in the following two lists, respectively.
+
+       ACL2 !>*definition-minimal-theory*
+       (MV-NTH IFF NOT
+               IMPLIES EQ ATOM EQL = /= NULL ENDP ZEROP
+               SYNP PLUSP MINUSP LISTP RETURN-LAST
+               MV-LIST THE-CHECK WORMHOLE-EVAL
+               FORCE CASE-SPLIT DOUBLE-REWRITE)
+       ACL2 !>*built-in-executable-counterparts*
+       (ACL2-NUMBERP BINARY-* BINARY-+ UNARY-- UNARY-/
+                     < CAR CDR CHAR-CODE CHARACTERP CODE-CHAR
+                     COMPLEX COMPLEX-RATIONALP COERCE
+                     CONS CONSP DENOMINATOR EQUAL IF IMAGPART
+                     INTEGERP INTERN-IN-PACKAGE-OF-SYMBOL
+                     NUMERATOR PKG-WITNESS PKG-IMPORTS
+                     RATIONALP REALPART STRINGP SYMBOL-NAME
+                     SYMBOL-PACKAGE-NAME SYMBOLP NOT)
+       ACL2 !>
+
+
+File: acl2-doc-emacs.info,  Node: THEORY,  Next: THEORY-FUNCTIONS,  Prev: THEORIES-AND-PRIMITIVES,  Up: THEORIES
+
+THEORY    retrieve named theory
+
+     Example:
+     (theory 'ground-zero)
+
+In the example above, the theory returned is the one in force when ACL2
+is started up (see *note GROUND-ZERO::).
+
+     General Form:
+     (theory name)
+
+where name is the name of a previously executed deftheory event
+(otherwise a hard error occurs).  Returns the named theory.  See *note
+THEORIES::.
+
+This "function" is actually a macro that expands to a term mentioning
+the single free variable world.  When theory expressions are evaluated
+by in-theory or the :in-theory hint, world is bound to the current ACL2
+world.
+
+
+File: acl2-doc-emacs.info,  Node: THEORY-FUNCTIONS,  Next: UNION-THEORIES,  Prev: THEORY,  Up: THEORIES
+
+THEORY-FUNCTIONS    functions for obtaining or producing theories
+
+     Example Calls of Theory Functions:
+     (universal-theory :here)
+     (union-theories th1 th2)
+     (set-difference-theories th1 th2)
+
+The theory functions are documented individually:
+
+* Menu:
+
+
+Related topics other than immediate subtopics:
+* CURRENT-THEORY:: currently enabled rules as of logical name
+
+* DISABLE:: deletes names from current theory
+
+* E/D:: enable/disable rules
+
+* ENABLE:: adds names to current theory
+
+* EXECUTABLE-COUNTERPART-THEORY:: executable counterpart rules as of logical name
+
+* FUNCTION-THEORY:: function symbol rules as of logical name
+
+* GROUND-ZERO:: enabled rules in the startup theory
+
+* INTERSECTION-THEORIES:: intersect two theories
+
+* MINIMAL-THEORY:: a minimal theory to enable
+
+* SET-DIFFERENCE-THEORIES:: difference of two theories
+
+* THEORY:: retrieve named theory
+
+* UNION-THEORIES:: union two theories
+
+* UNIVERSAL-THEORY:: all rules as of logical name
+
+The functions (actually, macros) mentioned above are convenient ways to
+produce theories.  (See *note THEORIES::.) Some, like universal-theory,
+take a logical name (see *note LOGICAL-NAME::) as an argument and
+return the relevant theory as of the time that name was introduced.
+Others, like union-theories, take two theories and produce a new one.
+See *note REDUNDANT-EVENTS:: for a caution about the use of logical
+names in theory expressions.
+
+Theory expressions are generally composed of applications of theory
+functions.  Formally, theory expressions are expressions that involve,
+at most, the free variable world and that when evaluated with world
+bound to the current ACL2 world (see *note WORLD::) return theories.
+The "theory functions" are actually macros that expand into forms that
+involve the free variable world.  Thus, for example (universal-theory
+:here) actually expands to (universal-theory-fn :here world) and when
+that form is evaluated with world bound to the current ACL2 world,
+universal-theory-fn scans the ACL2 property lists and computes the
+current universal theory.  Because the theory functions all implicitly
+use world, the variable does not generally appear in anything the user
+types.
+
+
+File: acl2-doc-emacs.info,  Node: UNION-THEORIES,  Next: UNIVERSAL-THEORY,  Prev: THEORY-FUNCTIONS,  Up: THEORIES
+
+UNION-THEORIES    union two theories
+
+     Example:
+     (union-theories (current-theory 'lemma3)
+                     (theory 'arith-patch))
+
+     General Form:
+     (union-theories th1 th2)
+
+where th1 and th2 are theories (see *note THEORIES::).  To each of the
+arguments there corresponds a runic theory.  This function returns the
+union of those two runic theories, represented as a list and ordered
+chronologically.
+
+This "function" is actually a macro that expands to a term mentioning
+the single free variable world.  When theory expressions are evaluated
+by in-theory or the :in-theory hint, world is bound to the current ACL2
+world.
+
+
+File: acl2-doc-emacs.info,  Node: UNIVERSAL-THEORY,  Prev: UNION-THEORIES,  Up: THEORIES
+
+UNIVERSAL-THEORY    all rules as of logical name
+
+     Examples:
+     (universal-theory :here)
+     (universal-theory 'lemma3)
+
+See *note LOGICAL-NAME::.
+
+     General Form:
+     (universal-theory logical-name)
+
+Returns the theory consisting of all the runes that existed immediately
+after logical-name was introduced.  See *note THEORIES:: and see *note
+LOGICAL-NAME::.  The theory includes logical-name itself (if there is a
+rule by that name).  (Note that since some events do not introduce
+rules (e.g., defmacro, defconst or defthm with :rule-classes nil), the
+universal-theory does not necessarily include a rune for every event
+name.)  The universal-theory is very long and you will probably regret
+printing it.
+
+You may experience a fencepost problem in deciding which logical-name
+to use.  Deflabel can always be used to mark unambiguously for future
+reference a particular point in the development of your theory.  This
+is convenient because deflabel does not introduce any rules and hence
+it doesn't matter if you count it as being in the interval or not.  The
+order of events in the vicinity of an encapsulate is confusing.  See
+*note ENCAPSULATE::.
+
+This "function" is actually a macro that expands to a term mentioning
+the single free variable world.  When theory expressions are evaluated
+by in-theory or the :in-theory hint, world is bound to the current ACL2
+world.
+
+Also see *note CURRENT-THEORY::.  Current-theory is much more commonly
+used than universal-theory.  The former includes only the enabled runes
+as of the given logical-name, which is probably what you want, while
+the latter includes disabled ones as well.
+
+
 File: acl2-doc-emacs.info,  Node: TRACE,  Prev: THEORIES,  Up: Top
 
 TRACE    tracing functions in ACL2
@@ -1321,6 +2414,8 @@
 * ADD-DIVE-INTO-MACRO:                   ADD-DIVE-INTO-MACRO.   (line 3)
 * ADD-INCLUDE-BOOK-DIR:                  ADD-INCLUDE-BOOK-DIR.  (line 3)
 * ADD-INVISIBLE-FNS:                     ADD-INVISIBLE-FNS.     (line 3)
+* ADD-LD-KEYWORD-ALIAS:                  ADD-LD-KEYWORD-ALIAS.  (line 3)
+* ADD-LD-KEYWORD-ALIAS!:                 ADD-LD-KEYWORD-ALIAS!. (line 3)
 * ADD-MACRO-ALIAS:                       ADD-MACRO-ALIAS.       (line 3)
 * ADD-MACRO-FN:                          ADD-MACRO-FN.          (line 3)
 * ADD-MATCH-FREE-OVERRIDE:               ADD-MATCH-FREE-OVERRIDE.
@@ -1388,6 +2483,7 @@
 * BOOK-COMPILED-FILE:                    BOOK-COMPILED-FILE.    (line 3)
 * BOOK-CONTENTS:                         BOOK-CONTENTS.         (line 3)
 * BOOK-EXAMPLE:                          BOOK-EXAMPLE.          (line 3)
+* BOOK-MAKEFILES:                        BOOK-MAKEFILES.        (line 3)
 * BOOK-NAME:                             BOOK-NAME.             (line 3)
 * BOOKS:                                 BOOKS.                 (line 3)
 * BOOKS-CERTIFICATION:                   BOOKS-CERTIFICATION.   (line 3)
@@ -1451,6 +2547,7 @@
 * CERTIFICATE:                           CERTIFICATE.           (line 3)
 * CERTIFY-BOOK:                          CERTIFY-BOOK.          (line 3)
 * CERTIFY-BOOK!:                         CERTIFY-BOOK!.         (line 3)
+* CERTIFYING-BOOKS:                      CERTIFYING-BOOKS.      (line 3)
 * CHAR:                                  CHAR.                  (line 3)
 * CHAR-CODE:                             CHAR-CODE.             (line 3)
 * CHAR-DOWNCASE:                         CHAR-DOWNCASE.         (line 3)
@@ -1482,6 +2579,7 @@
 * COERCE:                                COERCE.                (line 3)
 * COMMAND:                               COMMAND.               (line 3)
 * COMMAND-DESCRIPTOR:                    COMMAND-DESCRIPTOR.    (line 3)
+* COMMAND-LINE:                          COMMAND-LINE.          (line 3)
 * Common Lisp:                           Common Lisp.           (line 3)
 * Common Lisp as a Modeling Language:    Common Lisp as a Modeling Language.
                                                                 (line 3)
@@ -1708,6 +2806,7 @@
 * FILE-READING-EXAMPLE:                  FILE-READING-EXAMPLE.  (line 3)
 * FINALIZE-EVENT-USER:                   FINALIZE-EVENT-USER.   (line 3)
 * FIND-RULES-OF-RUNE:                    FIND-RULES-OF-RUNE.    (line 3)
+* FINDING-DOCUMENTATION:                 FINDING-DOCUMENTATION. (line 3)
 * FIRST:                                 FIRST.                 (line 3)
 * FIX:                                   FIX.                   (line 3)
 * FIX-TRUE-LIST:                         FIX-TRUE-LIST.         (line 3)
@@ -1775,6 +2874,7 @@
 * GENERALIZING-KEY-CHECKPOINTS:          GENERALIZING-KEY-CHECKPOINTS.
                                                                 (line 3)
 * GET-COMMAND-SEQUENCE:                  GET-COMMAND-SEQUENCE.  (line 3)
+* GET-INTERNAL-TIME:                     GET-INTERNAL-TIME.     (line 3)
 * GET-OUTPUT-STREAM-STRING$:             GET-OUTPUT-STREAM-STRING$.
                                                                 (line 3)
 * GET-WORMHOLE-STATUS:                   GET-WORMHOLE-STATUS.   (line 3)
@@ -1856,6 +2956,7 @@
 * IFIX:                                  IFIX.                  (line 3)
 * IGNORABLE:                             IGNORABLE.             (line 3)
 * IGNORE:                                IGNORE.                (line 3)
+* IGNORED-ATTACHMENT:                    IGNORED-ATTACHMENT.    (line 3)
 * ILLEGAL:                               ILLEGAL.               (line 3)
 * IMAGPART:                              IMAGPART.              (line 3)
 * IMMED-FORCED:                          IMMED-FORCED.          (line 3)
@@ -1936,6 +3037,7 @@
 * KWOTE-LST:                             KWOTE-LST.             (line 3)
 * LAMBDA:                                LAMBDA.                (line 3)
 * LAST:                                  LAST.                  (line 3)
+* LAST-PROVER-STEPS:                     LAST-PROVER-STEPS.     (line 3)
 * LD:                                    LD.                    (line 3)
 * LD-ERROR-ACTION:                       LD-ERROR-ACTION.       (line 3)
 * LD-ERROR-TRIPLES:                      LD-ERROR-TRIPLES.      (line 3)
@@ -2060,6 +3162,7 @@
 * MORE:                                  MORE.                  (line 3)
 * MORE!:                                 MORE!.                 (line 3)
 * MORE-DOC:                              MORE-DOC.              (line 3)
+* MSG:                                   MSG.                   (line 3)
 * MUST-BE-EQUAL:                         MUST-BE-EQUAL.         (line 3)
 * MUTUAL-RECURSION:                      MUTUAL-RECURSION.      (line 3)
 * MUTUAL-RECURSION-PROOF-EXAMPLE:        MUTUAL-RECURSION-PROOF-EXAMPLE.
@@ -2075,6 +3178,7 @@
                                                                 (line 3)
 * NAT-LISTP:                             NAT-LISTP.             (line 3)
 * NATP:                                  NATP.                  (line 3)
+* NESTED-STOBJS:                         NESTED-STOBJS.         (line 3)
 * NEVER-MEMOIZE:                         NEVER-MEMOIZE.         (line 3)
 * NFIX:                                  NFIX.                  (line 3)
 * NIL-GOAL:                              NIL-GOAL.              (line 3)
@@ -2179,6 +3283,7 @@
 * NOTE-6-0:                              NOTE-6-0.              (line 3)
 * NOTE-6-1:                              NOTE-6-1.              (line 3)
 * NOTE-6-2:                              NOTE-6-2.              (line 3)
+* NOTE-6-3:                              NOTE-6-3.              (line 3)
 * NOTE1:                                 NOTE1.                 (line 3)
 * NOTE2:                                 NOTE2.                 (line 3)
 * NOTE3:                                 NOTE3.                 (line 3)
@@ -2402,6 +3507,7 @@
 * REDEFINED-NAMES:                       REDEFINED-NAMES.       (line 3)
 * REDEFINING-PROGRAMS:                   REDEFINING-PROGRAMS.   (line 3)
 * REDO-FLAT:                             REDO-FLAT.             (line 3)
+* REDUNDANT-ENCAPSULATE:                 REDUNDANT-ENCAPSULATE. (line 3)
 * REDUNDANT-EVENTS:                      REDUNDANT-EVENTS.      (line 3)
 * REFINEMENT:                            REFINEMENT.            (line 3)
 * REGENERATE-TAU-DATABASE:               REGENERATE-TAU-DATABASE.
@@ -2522,6 +3628,7 @@
 * SET-INHIBIT-OUTPUT-LST:                SET-INHIBIT-OUTPUT-LST.
                                                                 (line 3)
 * SET-INHIBIT-WARNINGS:                  SET-INHIBIT-WARNINGS.  (line 3)
+* SET-INHIBIT-WARNINGS!:                 SET-INHIBIT-WARNINGS!. (line 3)
 * SET-INHIBITED-SUMMARY-TYPES:           SET-INHIBITED-SUMMARY-TYPES.
                                                                 (line 3)
 * SET-INVISIBLE-FNS-TABLE:               SET-INVISIBLE-FNS-TABLE.
@@ -2531,6 +3638,8 @@
                                                                 (line 3)
 * SET-LD-KEYWORD-ALIASES:                SET-LD-KEYWORD-ALIASES.
                                                                 (line 3)
+* SET-LD-KEYWORD-ALIASES!:               SET-LD-KEYWORD-ALIASES!.
+                                                                (line 3)
 * SET-LD-REDEFINITION-ACTION:            SET-LD-REDEFINITION-ACTION.
                                                                 (line 3)
 * SET-LD-SKIP-PROOFS:                    SET-LD-SKIP-PROOFS.    (line 3)
@@ -2610,6 +3719,7 @@
                                                                 (line 3)
 * SHOW-FC-CRITERIA:                      SHOW-FC-CRITERIA.      (line 3)
 * SIGNATURE:                             SIGNATURE.             (line 3)
+* SIGNED-BYTE-P:                         SIGNED-BYTE-P.         (line 3)
 * SIGNUM:                                SIGNUM.                (line 3)
 * SIMPLE:                                SIMPLE.                (line 3)
 * SINGLE-THREADED-OBJECTS:               SINGLE-THREADED-OBJECTS.
@@ -2695,6 +3805,7 @@
 * SYNTAXP:                               SYNTAXP.               (line 3)
 * SYNTAXP-EXAMPLES:                      SYNTAXP-EXAMPLES.      (line 3)
 * SYS-CALL:                              SYS-CALL.              (line 3)
+* SYS-CALL+:                             SYS-CALL+.             (line 3)
 * SYS-CALL-STATUS:                       SYS-CALL-STATUS.       (line 3)
 * TABLE:                                 TABLE.                 (line 3)
 * TAKE:                                  TAKE.                  (line 3)
@@ -2853,6 +3964,7 @@
 * UNMEMOIZE:                             UNMEMOIZE.             (line 3)
 * UNMONITOR:                             UNMONITOR.             (line 3)
 * UNSAVE:                                UNSAVE.                (line 3)
+* UNSIGNED-BYTE-P:                       UNSIGNED-BYTE-P.       (line 3)
 * UNSUPPORTED-PARALLELISM-FEATURES:      UNSUPPORTED-PARALLELISM-FEATURES.
                                                                 (line 3)
 * UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES: UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES.
@@ -2891,6 +4003,7 @@
 * VERBOSE-PSTACK:                        VERBOSE-PSTACK.        (line 3)
 * VERIFY:                                VERIFY.                (line 3)
 * VERIFY-GUARDS:                         VERIFY-GUARDS.         (line 3)
+* VERIFY-GUARDS+:                        VERIFY-GUARDS+.        (line 3)
 * VERIFY-GUARDS-EAGERNESS:               VERIFY-GUARDS-EAGERNESS.
                                                                 (line 3)
 * VERIFY-GUARDS-FORMULA:                 VERIFY-GUARDS-FORMULA. (line 3)
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-2 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-2
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-2	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-2	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -4625,6 +4625,8 @@
 
 * BOOK-EXAMPLE:: how to create, certify, and use a simple book
 
+* BOOK-MAKEFILES:: See *note BOOKS-CERTIFICATION::.
+
 * BOOK-NAME:: conventions associated with book names
 
 * BOOKS-CERTIFICATION:: certifying ACL2 community books
@@ -4637,6 +4639,8 @@
 
 * CERTIFY-BOOK:: how to produce a certificate for a book
 
+* CERTIFYING-BOOKS:: See *note BOOKS-CERTIFICATION::.
+
 * COMMUNITY-BOOKS:: books contributed by the ACL2 community
 
 * FULL-BOOK-NAME:: book naming conventions assumed by ACL2
@@ -4862,7 +4866,7 @@
 questions.
 
 
-File: acl2-doc-emacs.info,  Node: BOOK-EXAMPLE,  Next: BOOK-NAME,  Prev: BOOK-CONTENTS,  Up: BOOKS
+File: acl2-doc-emacs.info,  Node: BOOK-EXAMPLE,  Next: BOOK-MAKEFILES,  Prev: BOOK-CONTENTS,  Up: BOOKS
 
 BOOK-EXAMPLE    how to create, certify, and use a simple book
 
@@ -5026,7 +5030,12 @@
 *note BOOK-NAME::, following the pointer given at the conclusion.
 
 
-File: acl2-doc-emacs.info,  Node: BOOK-NAME,  Next: BOOKS-CERTIFICATION,  Prev: BOOK-EXAMPLE,  Up: BOOKS
+File: acl2-doc-emacs.info,  Node: BOOK-MAKEFILES,  Next: BOOK-NAME,  Prev: BOOK-EXAMPLE,  Up: BOOKS
+
+BOOK-MAKEFILES    See *note BOOKS-CERTIFICATION::.
+
+
+File: acl2-doc-emacs.info,  Node: BOOK-NAME,  Next: BOOKS-CERTIFICATION,  Prev: BOOK-MAKEFILES,  Up: BOOKS
 
 BOOK-NAME    conventions associated with book names
 
@@ -5119,7 +5128,9 @@
 of those books, with ACL2.  We thank Bishop Brock, Jared Davis, and Sol
 Swords for their substantial contributions to this methodology.  See
 books/Makefile, in the community books, for more about "Credits and
-History".
+History", and for additional technical details not covered in this
+topic (for example, how to build a local copy of the xdoc manual for
+those who may wish to do that).
 
 For more information about installing ACL2, see the installation
 instructions, either by following a link from the ACL2 home page or by
@@ -5802,7 +5813,7 @@
 See *note PORTCULLIS:: to continue the guided tour through books.
 
 
-File: acl2-doc-emacs.info,  Node: CERTIFY-BOOK,  Next: COMMUNITY-BOOKS,  Prev: CERTIFICATE,  Up: BOOKS
+File: acl2-doc-emacs.info,  Node: CERTIFY-BOOK,  Next: CERTIFYING-BOOKS,  Prev: CERTIFICATE,  Up: BOOKS
 
 CERTIFY-BOOK    how to produce a certificate for a book
 
@@ -6008,7 +6019,12 @@
 This completes the tour through the documentation of books.
 
 
-File: acl2-doc-emacs.info,  Node: COMMUNITY-BOOKS,  Next: FULL-BOOK-NAME,  Prev: CERTIFY-BOOK,  Up: BOOKS
+File: acl2-doc-emacs.info,  Node: CERTIFYING-BOOKS,  Next: COMMUNITY-BOOKS,  Prev: CERTIFY-BOOK,  Up: BOOKS
+
+CERTIFYING-BOOKS    See *note BOOKS-CERTIFICATION::.
+
+
+File: acl2-doc-emacs.info,  Node: COMMUNITY-BOOKS,  Next: FULL-BOOK-NAME,  Prev: CERTIFYING-BOOKS,  Up: BOOKS
 
 COMMUNITY-BOOKS    books contributed by the ACL2 community
 
@@ -6631,24 +6647,24 @@
 
 Break-rewrite permits the user to inspect the current state by
 evaluating break-rewrite commands.  Type :help in break-rewrite to see
-what the break-rewrite commands are.  However, break-rewrite is
-actually just a call of the general ACL2 read-eval-print loop, ld, on a
-certain state and the break-rewrite commands are simply aliases
-provided by the ld-special ld-keyword-aliases.  See *note LD:: for
-details about this read-eval-print loop.  Thus, with a few exceptions,
-anything you can do at the ACL2 top-level can be done within
-break-rewrite.  For example, you can evaluate arbitrary expressions,
-use the keyword command hack, access documentation, print events, and
-even define functions and prove theorems.  However, the "certain state"
-upon which ld was called is a "wormhole state" (see *note WORMHOLE::)
-because break-rewrite is not allowed to have any effect upon the
-behavior of rewrite.  What this means, very roughly but understandably,
-is that break-rewrite operates on a copy of the state being used by
-rewrite and when break-rewrite exits the wormhole closes and the state
-"produced" by break-rewrite disappears.  Thus, break-rewrite lets you
-query the state of the rewriter and even do experiments involving
-proofs, etc., but these experiments have no effect on the ongoing proof
-attempt.  In particular:
+what the break-rewrite commands are.  However, break-rewrite is actually
+just a call of the general ACL2 read-eval-print loop, ld, on a certain
+state and the break-rewrite commands are simply aliases provided by
+ld-keyword-aliases table (see *note LD-KEYWORD-ALIASES::).  See *note
+LD:: for details about this read-eval-print loop.  Thus, with a few
+exceptions, anything you can do at the ACL2 top-level can be done
+within break-rewrite.  For example, you can evaluate arbitrary
+expressions, use the keyword command hack, access documentation, print
+events, and even define functions and prove theorems.  However, the
+"certain state" upon which ld was called is a "wormhole state" (see
+*note WORMHOLE::) because break-rewrite is not allowed to have any
+effect upon the behavior of rewrite.  What this means, very roughly but
+understandably, is that break-rewrite operates on a copy of the state
+being used by rewrite and when break-rewrite exits the wormhole closes
+and the state "produced" by break-rewrite disappears.  Thus,
+break-rewrite lets you query the state of the rewriter and even do
+experiments involving proofs, etc., but these experiments have no
+effect on the ongoing proof attempt.  In particular:
 
 Note that the output from break-rewrite is sometimes abbreviated by
 default, such as for the term causing the break.  This can be
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-3 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-3
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-3	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-3	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -613,10 +613,13 @@
 To view the documentation in a web browser, open a browser to file
 doc/HTML/acl2-doc.html under your ACL2 source directory, or just go to
 the ACL2 home page at `http://www.cs.utexas.edu/users/moore/acl2/'.
-Alternatively, follow a link on the ACL2 home page to the new "xdoc"
-version of the manual, which can be found locally after running a
-regression by pointing your web browser at community books file
-books/xdoc/manual/preview.html.
+
+Alternatively, follow a link on the ACL2 home page to a manual, known
+as the xdoc manual, which incorporates (but rearranges) the ACL2
+documentation as well as documentation from many ACL2 community books.
+You can build a local copy of that manual; see for example the section
+"BUILDING THE XDOC MANUAL" in the community books Makefile for
+instructions.
 
 To use Emacs Info (inside Emacs), first load distributed file
 emacs/emacs-acl2.el (perhaps inside your .emacs file) and then execute
@@ -834,16 +837,18 @@
 
 DOC    brief documentation (type :doc name)
 
-NOTE:  The :doc command only makes sense at the terminal.  Furthermore
-it only works at the terminal when a "full-size" image has been built.
-Most users will probably access the ACL2 documentation in other ways,
-as explained in the file "doc/README" that comes with the ACL2
-distribution.
+NOTE: The :doc command only makes sense at the terminal.  Most users
+will probably access the ACL2 documentation in other ways; see *note
+DOCUMENTATION::.  In particular, consider using the xdoc manual at the
+following location on the web, for topics documented in ACL2 community
+books as well as the ACL2 system (though the latter are rearranged):
+
+`http://fv.centtech.com/acl2/latest/doc/'
 
      Examples:
      ACL2 !>:doc DEFTHM          ; print documentation of DEFTHM
      ACL2 !>:doc logical-name    ; print documentation of LOGICAL-NAME
-     ACL2 !>:doc "MY-PKG"      ; print documentation of "MY-PKG"
+     ACL2 !>:doc "MY-PKG"        ; print documentation of "MY-PKG"
 
      Related Topics:
      :more                      ; continues last :doc or :more-doc text
@@ -1844,8 +1849,6 @@
 
 * SET-BODY:: set the definition body
 
-* SHOW-CUSTOM-KEYWORD-HINT-EXPANSION:: print out custom keyword hints when they are expanded
-
 * TABLE:: user-managed tables
 
 * THEORY-INVARIANT:: user-specified invariants on theories
@@ -1856,6 +1859,8 @@
 
 * VERIFY-GUARDS:: verify the guards of a function
 
+* VERIFY-GUARDS+:: verify the guards of a function
+
 * VERIFY-TERMINATION:: convert a function from :program mode to :logic mode
 
 Any extension of the syntax of ACL2 (i.e., the definition of a new
@@ -1870,15 +1875,14 @@
 (e.g., verify-guards), some introduce exactly one (e.g., defmacro and
 defthm), and some may introduce many (e.g., encapsulate ).
 
-ACL2 typically completes processing of an event by printing a summary
-that includes a breakdown of runtime (cpu time) used and, unless proofs
-are skipped (see *note LD-SKIP-PROOFSP::) or summary output is inhibited
-(see *note SET-INHIBIT-OUTPUT-LST::), information about the proof
-attempt (if any) including a list of rules used, a summary of warnings,
-and the number of "prover steps" (if any; see *note
-WITH-PROVER-STEP-LIMIT::).  A detail: The time is calculated using
-Common Lisp function get-internal-run-time, which may ignore calls to
-external tools (see *note SYS-CALL:: and see *note CLAUSE-PROCESSOR::).
+ACL2 typically completes processing of an event by printing a summary.
+Unless proofs are skipped (see *note LD-SKIP-PROOFSP::) or summary
+output is inhibited (see *note SET-INHIBIT-OUTPUT-LST::), information
+about the proof attempt (if any) is printed that includes a list of
+rules used, a summary of warnings, and the number of "prover steps" (if
+any; see *note WITH-PROVER-STEP-LIMIT::).  A breakdown of the time used
+is also printed, which by default is runtime (cpu time), but can be
+changed to realtime (wall clock time); see *note GET-INTERNAL-TIME::.
 
 See *note EMBEDDED-EVENT-FORM:: for a discussion of events permitted in
 books.
@@ -2090,13 +2094,16 @@
 is given a single function to compile.  Those files contain the ACL2
 definitions of all functions to compile, omitting those in the lists
 obtained by evaluating the forms (@ logic-fns-with-raw-code) and (@
-program-fns-with-raw-code).  If you define function symbols with raw
-Lisp code, say by using trust tags (see *note DEFTTAG::) and readtime
-conditionals #-acl2-loop-only, then you are advised to add all such
-symbols to one of the lists stored in the two state globals above: to
-logic-fns-with-raw-code if the function symbol is in :logic mode, else
-to program-fns-with-raw-code.  Then, instead of the corresponding ACL2
-definition (without raw Lisp code) being written to a file, the
+program-fns-with-raw-code).  :Comp skips compilation for functions that
+are already compiled, as is typically the case when you redefine
+functions in raw Lisp using the utility include-raw defined in community
+book books/tools/include-raw.lisp.  But if you define interpreted (as
+opposed to compiled) functions with raw Lisp code, say by using trust
+tags (see *note DEFTTAG::) and progn!, then you are advised to add all
+such symbols to one of the lists stored in the two state globals above:
+to logic-fns-with-raw-code if the function symbol is in :logic mode,
+else to program-fns-with-raw-code.  Then, instead of the corresponding
+ACL2 definition (without raw Lisp code) being written to a file, the
 function symbol will be passed directly to the Lisp compile function.
 Note that the above two state globals are both untouchable, so you may
 need to deal with that before modifying them, for example as follows
@@ -2695,7 +2702,7 @@
      about congruent stobjs.  Note that if two names are congruent, then
      they are either both ordinary stobjs or both abstract stobjs.
 
-     Protect-default should either be nil (th default) or t.  It
+     Protect-default should either be nil (the default) or t.  It
      provides the value of keyword :PROTECT for each member of exports
      that does not explicitly specify :PROTECT.  See the discussion of
      exports below.
@@ -2963,17 +2970,17 @@
 Below we explain defattach in some detail.  But it is important to keep
 in mind that evaluation with the attachment equations takes place in an
 extension of the logical theory of the session.  ACL2 guarantees that
-this so-called "evaluation theory" remains consistent, assuming that
-the absence of defaxiom events from the user.  This guarantee is a
-consequence of a more general guarantee: an ACL2 logical world exists in
-which (loosely speaking) the attachment equation for (defattach f g), as
-(defun f (...) (g ...)), takes the place of the original defining event
-for f, for each defattach event.  This more general guarantee holds
-even if there are defaxiom events, though as explained below, no
-function symbol that syntactically supports a defaxiom formula is
-allowed to get an attachment.  A deeper discussion of the logical
-issues is available (but not intended to be read by most users) in a
-long comment in the ACL2 source code labeled "Essay on Defattach."
+this so-called "evaluation theory" remains consistent, assuming the
+absence of defaxiom events from the user.  This guarantee is a
+consequence of a more general guarantee: an ACL2 logical world exists
+in which (loosely speaking) the attachment equation for (defattach f
+g), as (defun f (...) (g ...)), takes the place of the original
+defining event for f, for each defattach event.  This more general
+guarantee holds even if there are defaxiom events, though as explained
+below, no function symbol that syntactically supports a defaxiom
+formula is allowed to get an attachment.  A deeper discussion of the
+logical issues is available (but not intended to be read by most users)
+in a long comment in the ACL2 source code labeled "Essay on Defattach."
 
      Example Forms:
      (defattach f g)   ; call g in place of calling constrained function f
@@ -4016,8 +4023,8 @@
      (defconst-fast *x* (expensive-fn ...))
 
 A more general utility may be found in community book
-books/tools/defconsts.lisp.  Also using-tables-efficiently for an
-analogous issue with table events.
+books/tools/defconsts.lisp.  Also see *note USING-TABLES-EFFICIENTLY::
+for an analogous issue with table events.
 
 It may be of interest to note that defconst is implemented at the lisp
 level using defparameter, as opposed to defconstant.  (Implementation
@@ -5376,20 +5383,21 @@
                :congruent-to old-stobj-name)
 
 where name is a new symbol, each fieldi is a symbol, each typei is
-either a type-spec or (ARRAY type-spec (max)), each vali is an object
-satisfying typei, and each bi is t or nil.  Each pair :initially vali
-and :resizable bi may be omitted; more on this below.  The :renaming
-alist argument is optional and allows the user to override the default
-function names introduced by this event.  The doc-string is also
-optional.  The :inline flg Boolean argument is also optional and
-declares to ACL2 that the generated access and update functions for the
-stobj should be implemented as macros under the hood (which has the
-effect of inlining the function calls).  The optional :congruent-to
-old-stobj-name argument specifies an existing stobj with exactly the
-same structure, and is discussed below.  We describe further
-restrictions on the fieldi, typei, vali, and on alist below.  We
-recommend that you read about single-threaded objects (stobjs) in ACL2
-before proceeding; see *note STOBJ::.
+either a type-indicator (a type-spec or stobj name) or of the form
+(ARRAY type-indicator max), each vali is an object satisfying typei,
+and each bi is t or nil.  Each pair :initially vali and :resizable bi
+may be omitted; more on this below.  The :renaming alist argument is
+optional and allows the user to override the default function names
+introduced by this event.  The doc-string is also optional.  The
+:inline flg Boolean argument is also optional and declares to ACL2 that
+the generated access and update functions for the stobj should be
+implemented as macros under the hood (which has the effect of inlining
+the function calls).  The optional :congruent-to old-stobj-name
+argument specifies an existing stobj with exactly the same structure,
+and is discussed below.  We describe further restrictions on the fieldi,
+typei, vali, and on alist below.  We recommend that you read about
+single-threaded objects (stobjs) in ACL2 before proceeding; see *note
+STOBJ::.
 
 The effect of this event is to introduce a new single-threaded object
 (i.e., a "stobj"), named name, and the associated recognizers, creator,
@@ -5412,7 +5420,7 @@
 type-spec; see *note TYPE-SPEC::.  However, type-indicator can also be
 the name of a stobj that was previously introduced (by defstobj or
 defabsstobj).  We ignore this "nested stobj" case below; see *note
-STOBJ-LET:: for a discussion of stobjs within stobjs.
+NESTED-STOBJS:: for a discussion of stobjs within stobjs.
 
 The keyword value :initially val specifies the initial value of a field,
 except for the case of a :type (ARRAY type-indicator (max)), in which
@@ -5439,10 +5447,10 @@
 are not evaluated.  If omitted, the type defaults to t (unrestricted)
 and the initial value defaults to nil.
 
-Each typei must be either a type-spec (with the exception noted above
-for nested stobjs, discussed elsewhere; see *note STOBJ-LET::) or else
-a list of the form (ARRAY type-spec (max)).  The latter forms are said
-to be "array types."  Examples of legal typei are:
+Each typei must be either a type-spec or else a list of the form (ARRAY
+type-spec (max)).  (Again, we are ignoring the case of nested stobjs,
+discussed elsewhere; see *note NESTED-STOBJS::.)  The latter forms are
+said to be "array types."  Examples of legal typei are:
 
      (INTEGER 0 31)
      (SIGNED-BYTE 31)
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-4 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-4
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-4	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-4	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -1387,7 +1387,9 @@
 the second pass, foo is a known function symbol with the indicated
 signature.
 
-We turn now to more complete documentation.
+We turn now to more complete documentation.  But discussion of
+redundancy for encapsulate events may be found elsewhere; see *note
+REDUNDANT-ENCAPSULATE::.
 
      Other Examples:
      (encapsulate (((an-element *) => *))
@@ -1421,6 +1423,10 @@
                  (equal (nthcdr (1+ n) x)
                         (nthcdr n (cdr x))))))
 
+     * Menu:
+
+     * REDUNDANT-ENCAPSULATE:: redundancy of encapsulate events
+
      General Form:
      (encapsulate (signature ... signature)
        ev1
@@ -1533,14 +1539,91 @@
 encapsulate, to permit an-element to be used as a function symbol in
 thm1.
 
+Remark for ACL2(r) (see *note REAL::).  For ACL2(r), encapsulate can be
+used to introduce classical and non-classical functions, as determined
+by the signatures; see *note SIGNATURE::.  Those marked as classical
+(respectively non-classical) must have classical (respectively,
+non-classical) local witness functions.  A related requirement applies
+to functional instantiation; see *note LEMMA-INSTANCE::.
+
+
+File: acl2-doc-emacs.info,  Node: REDUNDANT-ENCAPSULATE,  Prev: ENCAPSULATE,  Up: ENCAPSULATE
+
+REDUNDANT-ENCAPSULATE    redundancy of encapsulate events
+
+For this documentation topic we assume familiarity with encapsulate
+events and the notion of redundancy for events; see *note ENCAPSULATE::
+and see *note REDUNDANT-EVENTS::.
+
 The typical way for an encapsulate event to be redundant is when a
 syntactically identical encapsulate has already been executed under the
 same default-defun-mode, default-ruler-extenders, and
-default-verify-guards-eagerness.  More generally, the encapsulate
-events need not be syntactically identical, but rather, need only to
-correspond in the following sense: they contain the same signatures and
-the same number of top-level events -- let k be that number -- and for
-each i < k, the ith top-level events E1 and E2 from the earlier and
+default-verify-guards-eagerness.  But more generally, the encapsulate
+events need not be syntactically identical; for example, it suffices
+that they agree when the contents of local sub-events are ignored.  The
+precise criterion for redundancy is given below, but let us first look
+at a consequence of the point just made about ignoring the contents of
+local sub-events.  Consider the following sequence of two events.
+
+     (encapsulate
+      ()
+      (defun f (x) x)
+      (local (defthm f-identity
+               (equal (f x) x))))
+
+     (encapsulate
+      ()
+      (defun f (x) x)
+      (local (defthm false-claim
+               (equal (f x) (not x)))))
+
+You might be surprised to learn that the second is actually redundant,
+even though false-claim is clearly not a theorem; indeed, its negation
+is a theorem!  The following two points may soften the blow.  First,
+this behavior is as specified above (and is specified more precisely
+below): the contents of local events are ignored when checking
+redundancy of encapsulate events.  Second, this behavior is sound,
+because the logical meaning of an encapsulate event is taken from the
+events that it exports, which do not include events that are local to
+the encapsulate event.
+
+Some users, however, want to use encapsulate events for testing in a
+way that is thwarted by this ignoring of local sub-events.  Consider
+the following sort of example.
+
+     (encapsulate ()
+                  (local (defthm test1 ...)))
+
+     (encapsulate ()
+                  (local (defthm test2 ...)))
+
+Since the contents of local events are ignored when checking redundancy
+of an encapsulate event, the second form just above is indeed redundant,
+presumably not as expected by whomever wrote these two tests.  A
+solution is to add distinct non-local forms, for example as follows.
+
+     (encapsulate ()
+                  (value-triple "test1")
+                  (local (defthm test1 ...)))
+
+     (encapsulate ()
+                  (value-triple "test2")
+                  (local (defthm test2 ...)))
+
+A different solution is to use make-event for testing, as follows.
+
+     (make-event (er-progn (defthm test1 ...)
+                           (value '(value-triple nil))))
+     (make-event (er-progn (defthm test2 ...)
+                           (value '(value-triple nil))))
+
+Also see community books misc/eval.lisp, make-event/eval-check.lisp,
+and make-event/eval-tests.lisp for more ways to test in books.
+
+The precise criterion for redundancy of encapsulate events is that the
+existing and proposed encapsulate events contain the same signatures
+and the same number of top-level events -- let k be that number -- and
+for each i < k, the ith top-level events E1 and E2 from the earlier and
 current encapsulates have one of the following properties.
 
 o E1 and E2 are equal; or
@@ -1554,13 +1637,6 @@
 with-prover-step-limit, record-expansion, time$, progn, progn!, or
 encapsulate itself.
 
-Remark for ACL2(r) (see *note REAL::).  For ACL2(r), encapsulate can be
-used to introduce classical and non-classical functions, as determined
-by the signatures; see *note SIGNATURE::.  Those marked as classical
-(respectively non-classical) must have classical (respectively,
-non-classical) local witness functions.  A related requirement applies
-to functional instantiation; see *note LEMMA-INSTANCE::.
-
 
 File: acl2-doc-emacs.info,  Node: EVISC-TABLE,  Next: IN-ARITHMETIC-THEORY,  Prev: ENCAPSULATE,  Up: EVENTS
 
@@ -1912,11 +1988,10 @@
 
 At the beginning of execution of an include-book form, even before
 executing portcullis commands, the value of acl2-defaults-table is
-restored to the value it had at startup, except that the value of key
-:inhibit-warnings is preserved.  After execution of an include-book
-form, the value of acl2-defaults-table is restored to what it was
-immediately before that include-book form was executed.  See *note
-ACL2-DEFAULTS-TABLE::.
+restored to the value it had at startup.  After execution of an
+include-book form, the value of acl2-defaults-table is restored to what
+it was immediately before that include-book form was executed.  See
+*note ACL2-DEFAULTS-TABLE::.
 
 Books Directory.  We refer to the "books directory" of an executable
 image as the full pathname string of the directory associated with
@@ -2002,7 +2077,8 @@
 *Detailed Documentation*
 *Error Reporting*
 *Restriction to Event Contexts*
-*Examples illustrating how to access state*
+*Examples Illustrating How to Access State*
+*Advanced Expansion Control*
 
 We begin with an informal introduction, which focuses on examples and
 introduces the key notion of "expansion phase".
@@ -2199,34 +2275,37 @@
      ; should return the same value as it did when the book was
      ; certified.
      (make-event (generate-form state)
-                 :check-expansion t)
+                 :CHECK-EXPANSION t)
 
-     ; As above (where the :check-expansion value can be included or
+     ; As above (where the :CHECK-EXPANSION value can be included or
      ; not), where if there is an error during expansion, then the error
      ; message will explain that expansion was on behalf of the indicated
      ; object, typically specified as the first argument.
      (make-event (generate-form state)
-                 :on-behalf-of (generate-form state))
+                 :ON-BEHALF-OF (generate-form state))
 
      General Form:
-     (make-event form :check-expansion chk :on-behalf-of obj)
+     (make-event form :CHECK-EXPANSION chk :ON-BEHALF-OF obj :EXPANSION? form)
 
 where chk is nil (the default), t, or the intended "expansion result"
 from the evaluation of form (as explained below); and if supplied, obj
 is an arbitrary ACL2 object, used only in reporting errors in
-expansion, i.e., in the evaluation of form.
+expansion, i.e., in the evaluation of form.  The :EXPANSION? keyword is
+discussed in the final section, on Advanced Expansion Control.
 
 We strongly recommend that you browse some .lisp files in the community
 books directory books/make-event/.  You may even find it helpful, in
 order to understand make-event, to do so before continuing to read this
-documentation.  For example, eval.lisp contains definitions of macros
-must-succeed and must-fail that are useful for testing and are used in
-many other books in that directory, especially eval-tests.lisp.
-Another example, defrule.lisp, shows how to use macros whose calls
-expand to make-event forms, which in turn can generate events.  For more
-examples, see file Readme.lsp in the above directory.  Other than the
-examples, the explanations here should suffice for most users.  If you
-want explanations of subtler details, see *note MAKE-EVENT-DETAILS::.
+documentation.  You may also find it useful to browse community book
+books/misc/eval.lisp, which contains definitions of macros must-succeed
+and must-fail that are useful for testing and are used in many books in
+the books/make-event/ directory, especially eval-tests.lisp.  Another
+example, books/make-event/defrule.lisp, shows how to use macros whose
+calls expand to make-event forms, which in turn can generate events.
+For more examples, see file books/make-event/Readme.lsp.  Other than
+the examples, the explanations here should suffice for most users.  If
+you want explanations of subtler details, see *note
+MAKE-EVENT-DETAILS::.
 
 Note that make-event may only be used at the "top level" or where an
 event is expected.  See the section "Restriction to Event Contexts",
@@ -2235,7 +2314,9 @@
 Make-event is related to Lisp macroexpansion in the sense that its
 argument is evaluated to obtain an expansion result, which is evaluated
 again.  Let us elaborate on each of these notions in turn: "is
-evaluated," "expansion result", and "evaluated again."
+evaluated," "expansion result", and "evaluated again."  The final
+section, on Advanced Expansion Control, will generalize these processes
+in a way that we ignore for now.
 
      "is evaluated" -- The argument can be any expression, which is
      evaluated as would be any expression submitted to ACL2's top level
@@ -2250,34 +2331,31 @@
      evaluated during expansion, but they will disappear from the
      logical world after expansion returns its result.  Moreover,
      proofs are enabled by default at the start of expansion (see *note
-     LD-SKIP-PROOFSP::), because an anticipated use of make-event is to
-     call the prover to decide which event to generate, and that would
-     presumably be necessary even if proofs had been disabled.
+     LD-SKIP-PROOFSP::) if keyword :CHECK-EXPANSION is supplied and has
+     a non-nil value.
 
      "expansion result" -- The above expansion may result in an ordinary
      (non-state, non-stobj) value, which we call the "expansion
      result."  Or, expansion may result in a multiple value of the form
-     (mv erp val state stobj-1 ... stobj-k), where k may be 0; in fact
-     the most common case is probably (mv erp val state).  In that
-     case, if erp is not nil, then there is no expansion result, and
-     the original make-event evaluates to a soft error.  If however erp
-     is nil, then the resulting value is val.  Moreover, val must be an
-     embedded event form (see *note EMBEDDED-EVENT-FORM::); otherwise,
-     the original make-event evaluates to a soft error.  Note that
-     error messages from expansion are printed as described under
-     "Error Reporting" below.
+     (mv erp val state), or, more generally, (mv erp val state stobj-1
+     ... stobj-k) where each stobj-i is a stobj; then the expansion
+     result is val unless erp is not nil, in which case there is no
+     expansion result, and the original make-event evaluates to a soft
+     error.  In either case (single or multiple value), either val is
+     an embedded event form (see *note EMBEDDED-EVENT-FORM::), or else
+     the original make-event evaluates to a soft error, printed as
+     described under "Error Reporting" below.
 
      "evaluated again" -- the expansion result is evaluated in place of
      the original make-event.
 
-Note that the result of expansion can be an ordinary event, but it can
-instead be another call of make-event, or even of a call of a macro that
-expands to a call of make-event.  Or, expansion itself can cause
-subsidiary calls of make-event, for example if expansion uses ld to
-evaluate some make-event forms.  The state global variable
-make-event-debug may be set to a non-nil value in order to see a trace
-of the expansion process, where the level shown (as in "3>") indicates
-the depth of expansions in progress.
+The expansion process can invoke subsidiary calls of make-event, and
+the expansion result can (perhaps after macroexpansion) be a call of
+make-event.  It can be useful to track all these make-event calls.  The
+state global variable make-event-debug may be set to a non-nil value,
+for example (assign make-event-debug t), in order to see a trace of the
+expansion process, where a level is displayed (as in "3>") to indicate
+the depth of subsidiary expansions.
 
 Expansion of a make-event call will yield an event that replaces the
 original make-event call.  In particular, if you put a make-event form
@@ -2285,53 +2363,59 @@
 created during the proof pass of the certify-book process.  We now
 elaborate on this idea of keeping the original expansion.
 
-By default, a make-event call in a certified book is replaced (by a
-process hidden from the user, in an :expansion-alist field of the book's
-certificate) by the expansion result from evaluation of its first
-argument.  Thus, although the book is not textually altered during
+A make-event call generates a "make-event replacement" that may be
+stored by the system.  In the simplest case, this replacement is the
+expansion result.  When a book is certified, these replacements are
+stored in a book's certificate (technically, in the :EXPANSION-ALIST
+field).  Thus, although the book is not textually altered during
 certification, one may imagine a "book expansion" corresponding to the
-original book in which all of the events for which expansion took place
-(during the proof phase of certification) have been replaced by their
-expansions.  A subsequent include-book will then include the book
-expansion corresponding to the indicated book.  When a book is compiled
-during certify-book, it is actually the corresponding book expansion,
-stored as a temporary file, that is compiled instead.  That temporary
-file is deleted after compilation unless one first evaluates the form
-(assign keep-tmp-files t).  Note however that all of the original forms
-must still be legal events (see *note EMBEDDED-EVENT-FORM::).  So for
-example, if the first event in a book is (local (defmacro my-id (x)
-x)), followed by (my-id (make-event ...)), the final "include-book"
-pass of certify-book will fail because my-id is not defined when the
-my-id call is encountered.
-
-The preceding paragraph begins with "by default" because if you specify
-:check-expansion t, then subsequent evaluation of the same make-event
-call -- during the second pass of an encapsulate or during event
-processing on behalf of include-book -- will do the expansion again and
-check that the expansion result equals the original expansion result.
-In the unusual case that you know the expected expansion result, res,
-you can specify :check-expansion res.  This will will cause a check that
-every subsequent expansion result for the make-event form is res,
-including the original one.  IMPORTANT NOTE: That expansion check is
-only done when processing events, not during a preliminary load of a
-book's compiled file.  The following paragraph elaborates.
+original book, in which events are substituted by replacements that
+were generated during the proof phase of certification.  A subsequent
+include-book will then include the book expansion corresponding to the
+indicated book.  When a book is compiled during certify-book, it is
+actually the corresponding book expansion, stored as a temporary file,
+that is compiled instead.  That temporary file is deleted after
+compilation unless one first evaluates the form (assign keep-tmp-files
+t).  Note however that all of the original forms must still be legal
+events; see *note EMBEDDED-EVENT-FORM::.  So for example, if the first
+event in a book is (local (defmacro my-id (x) x)), and is followed by
+(my-id (make-event ...)), the final "include-book" pass of certify-book
+will fail because my-id is not defined when the my-id call is
+encountered.
+
+A make-event replacement might not be the expansion when either of the
+keyword arguments :CHECK-EXPANSION or :EXPANSION? is supplied.  We deal
+with the latter in the final section, on Advanced Expansion Control.  If
+:CHECK-EXPANSION t is supplied and the expansion is exp, then the
+replacement is obtained from the original make-event call, by
+substituting exp for t as the value of keyword :CHECK-EXPANSION.  Such
+a make-event call -- during the second pass of an encapsulate or during
+event processing on behalf of include-book -- will do the expansion
+again and check that the expansion result is equal to the original
+expansion result, exp.  In the unusual case that you know the expected
+expansion result, res, you can specify :CHECK-EXPANSION res in the
+first place, so that the check is also done during the initial
+evaluation of the make-event form.  IMPORTANT BUT OBSCURE DETAIL: That
+expansion check is only done when processing events, not during a
+preliminary load of a book's compiled file.  The following paragraph
+elaborates.
 
 (Here are details on the point made just above, for those who use the
-:check-expansion argument to perform side-effects on the state.  When
+:CHECK-EXPANSION argument to perform side-effects on the state.  When
 you include a book, ACL2 generally loads a compiled file before
 processing the events in the book; see *note BOOK-COMPILED-FILE::.
-While it is true that a non-nil :check-expansion argument causes
+While it is true that a non-nil :CHECK-EXPANSION argument causes
 include-book to perform expansion of the make-event form during event
 processing it does _not_ perform expansion when the compiled file (or
 expansion file; again, see *note BOOK-COMPILED-FILE::) is loaded.)
 
-ACL2 performs the following space-saving optimization for book
-certificates: a local event arising from make-event expansion is
-replaced in that expansion by (local (value-triple :ELIDED)).
-
-We note that ACL2 extends the notion of "make-event expansion" to the
-case that a call of make-event is found in the course of
-macroexpansion.  The following example illustrates this point.
+ACL2 performs the following space-saving optimization: when the
+expansion result is a local event, then the make-event replacement is
+(local (value-triple :ELIDED)).
+
+The notion of "expansion" and "replacement" extend to the case that a
+call of make-event is found in the course of macroexpansion.  The
+following example illustrates this point.
 
      (encapsulate
       ()
@@ -2341,7 +2425,7 @@
      :pe :here
 
 The above call of pe shows that the form (my-mac) has a make-event
-expansion of (DEFUN FOO (X) X):
+expansion (and replacement) of (DEFUN FOO (X) X):
 
      (ENCAPSULATE NIL
                   (DEFMACRO MY-MAC
@@ -2362,10 +2446,12 @@
 
 *Restriction to Event Contexts*
 
-A make-event call must occur either at the top level or as an argument
-of an event constructor, as explained in more detail below.  This
-restriction is imposed to enable ACL2 to track expansions produced by
-make-event.  The following examples illustrate this restriction.
+A make-event call must occur either at the top level, or during
+make-event expansion, or as an argument of an event constructor.  We
+explain in more detail below.  This restriction is imposed to enable
+ACL2 to track expansions produced by make-event.
+
+The following examples illustrate this restriction.
 
      ; Legal:
      (progn (with-output
@@ -2377,10 +2463,12 @@
              (make-event '(defun foo (x) x))
              (mv erp val state))
 
-More precisely: after macroexpansion has taken place, a make-event call
-must be in an "event context", defined recursively as follows.  (All but
-the first two cases below correspond to similar cases for constructing
-events; see *note EMBEDDED-EVENT-FORM::.)
+More precisely: a make-event call that is not itself evaluated during
+make-event expansion is subject to the following requirement.  After
+macroexpansion has taken place, such a make-event call must be in an
+"event context", defined recursively as follows.  (All but the first two
+cases below correspond to similar cases for constructing events; see
+*note EMBEDDED-EVENT-FORM::.)
 
      o A form submitted at the top level, or more generally, supplied
      to a call of ld, is in an event context.
@@ -2399,18 +2487,17 @@
      (WITH-PROVER-TIME-LIMIT ... x1) is in an event context, then so is
      x1.
 
-     o Given a call of PROGN or PROGN! in an event context, each of its
-     arguments is in an event context.
+     o For any call of PROGN or PROGN!, each of its arguments is in an
+     event context.
 
-     o Given a call of ENCAPSULATE in an event context, each of its
-     arguments except the first (the signature list) is in an event
-     context.
+     o For any call of ENCAPSULATE, each of its arguments except the
+     first (the signature list) is in an event context.
 
      o If (RECORD-EXPANSION x1 x2) is in an event context, then x1 and
      x2 are in event contexts.  Note: record-expansion is intended for
      use only by the implementation, which imposes the additional
      restriction that x1 and its subsidiary make-event calls (if any)
-     must specify a :check-expansion argument that is a consp.
+     must specify a :CHECK-EXPANSION argument that is a consp.
 
 
 Low-level remark, for system implementors.  There is the one exception
@@ -2421,12 +2508,12 @@
 
 However, the following form may be preferable (see *note PROGN!::):
 
-     (progn! :state-global-bindings <bindings> (make-event ...))
+     (progn! :STATE-GLOBAL-BINDINGS <bindings> (make-event ...))
 
 Also see *note REMOVE-UNTOUCHABLE:: for an interesting use of this
 exception.
 
-*Examples illustrating how to access state*
+*Examples Illustrating How to Access State*
 
 You can modify the ACL2 state by doing your state-changing computation
 during the expansion phase, before expansion returns the event that is
@@ -2473,7 +2560,7 @@
 
      (make-event
        (let ((world-len (length (w state))))
-         `(progn (table my-table :stored-world-length ,world-len)
+         `(progn (table my-table :STORED-WORLD-LENGTH ,world-len)
                  (defun foo (x) (cons x ,world-len)))))
 
 Then:
@@ -2490,6 +2577,161 @@
 your own global (like my-global above) can be set during expansion, and
 the new value will persist.
 
+*Advanced Expansion Control*
+
+We conclude this documentation section by discussing three kinds of
+additional control over make-event expansion.  These are all illustrated
+in community book books/make-event/make-event-keywords-or-exp.lisp.
+The discussion below is split into the following three parts.
+
+(1) The value produced by expansion may have the form (:DO-PROOFS exp),
+which specifies exp as the expansion result, to be evaluated without
+skipping proofs even when including a book.
+
+(2) The value produced by expansion may have the form (:OR exp-1 ...
+exp-k), which specifies that the first form exp-i to evaluate without
+error is the expansion result.
+
+(3) The keyword argument :EXPANSION? can serve to eliminate the storing
+of make-event replacements, as described above for the "book expansion"
+of a book.
+
+We now elaborate on each of these.
+
+(1) :DO-PROOFS "call" produced by expansion.
+
+We have discussed the expansion result produced by the expansion phase
+of evaluating a make-event call.  However, if the expansion phase
+produces an expression of the form (:DO-PROOFS exp), then the expansion
+result is actually exp.  The :DO-PROOFS wrapper indicates that even if
+proofs are currently being skipped (see *note LD-SKIP-PROOFSP::), then
+evaluation of exp should take place with proofs not skipped.  For
+example, proofs will be performed when evaluating the make-event
+expansion, namely the indicated defthm event, in the following example.
+
+     (set-ld-skip-proofsp t state)
+     (make-event '(:DO-PROOFS
+                   (defthm app-assoc (equal
+                                      (append (append x y) z)
+                                      (append x y z)))))
+
+Note that such use of :DO-PROOFS causes proofs to be performed when
+evaluating the expansion while including an uncertified book.  But when
+including a certified book, then unless :CHECK-EXPANSION is supplied a
+non-nil value, the make-event replacement will just be the expansion,
+which does not include the :DO-PROOFS wrapper and hence will be
+evaluated with proofs skipped.
+
+(2) :OR "call" produced by expansion.
+
+There may be times where you want to try different expansions.  For
+example, the community book books/make-event/proof-by-arith.lisp
+attempts to admit a given event, which we'll denote EV, by trying
+events of the following form as BOOK varies over different community
+books.
+
+     (encapsulate
+      ()
+      (local (include-book BOOK :DIR :SYSTEM))
+      EV)
+
+A naive implementation of this macro would evaluate all such
+encapsulate events until one succeeds, and then return that successful
+event as the expansion.  Then that event would need to be evaluated
+again!  With some hacking one could avoid that re-evaluation by using
+skip-proofs, but that won't work if you are trying to create a
+certified book without skipped proofs.  Instead, the implementation
+creates an expansion of the form (:OR ev-1 ev-2 ... ev-k), where the
+list (ev-1 ev-2 ... ev-k) enumerates the generated encapsulate events.
+In general, for this "disjunctive case" of a result from expansion, each
+ev-i is evaluated in sequence, and the first that succeeds without error
+is considered to be the expansion result -- and a repeat evaluation is
+avoided.  If evaluation of each ev-i results in an error, then so does
+the make-event call.
+
+This special use of :OR in a value produced by expansion is only
+supported at the top level.  That is, the result can be (:OR ev-1 ev-2
+... ev-k) but then each ev-i must be a legal expansion result, without
+such further use of :OR -- except, ev-i may be (:DO-PROOFS ev-i'),
+where ev-i' then would serve as the expansion rather than ev-i.
+
+(3) The :EXPANSION? keyword argument.
+
+If keyword argument :EXPANSION? has a nonnil value, then the
+:CHECK-EXPANSION keyword must be omitted or have value nil or t, hence
+not a cons pair.
+
+The idea of the :EXPANSION? keyword is to give you a way to avoid
+storing expansion results in a book's certificate.  Roughly speaking,
+when the expansion result matches the value of :EXPANSION?, then no
+expansion result is stored for the event by book certification; then
+when the book is later included, the value of :EXPANSION? is used as
+the expansion, thus bypassing the expansion phase.  One could say that
+the event is its own make-event replacement, but it is more accurate to
+say that there is no make-event replacement at all, since nothing is
+stored in the certificate for this event.  Below, we elaborate on
+make-event replacements when :EXPANSION is used and also discuss other
+properties of this keyword.
+
+We modify the notion of "expansion result" for make-event forms to
+comprehend the use of the :EXPANSION? keyword.  For that purpose, let's
+consider a call of make-event to be "reducible" if it has an
+:EXPANSION? keyword with non-nil value, exp, and its :CHECK-EXPANSION
+keyword is missing or has value nil, in which case the "reduction" of
+this make-event call is defined to be exp.  The expansion result as
+originally defined is modified by the following "recursive reduction"
+process: recur through the original expansion, passing through calls of
+local, skip-proofs, with-output, with-prover-step-limit, and
+with-prover-time-limit, and replacing (recursively) any reducible call
+of make-event by its reduction.  Furthermore, we refer to two forms as
+"reduction equivalent" if their recursive reductions are equal.  Note
+that the recursive reduction process does not pass through progn or
+encapsulate, but that process is applied to the computation of
+expansions for their subsidiary make-event calls.
+
+To explain further the effect of :EXPANSION? exp, we split into the
+following two cases.
+
+o Case 1: Evaluation is not taking place when including a book or
+evaluating the second pass of an encapsulate event; more precisely, the
+value of (ld-skip-proofsp state) is not the symbol INCLUDE-BOOK.  There
+are two subcases.
+
+     - Case 1a: The expansion result is not reduction-equivalent to
+     exp.  Then the make-event call is processed as though the
+     :EXPANSION? keyword had been omitted.
+
+     - Case 2a: The expansion result is reduction-equivalent to exp.
+     Then there is no make-event replacement for this call of
+     make-event; no replacement will be put into the certificate file
+     for a book containing this make-event call.  When that book is
+     subsequently included, the original form will be evaluated in the
+     manner described in the next case.
+
+o Case 2: Evaluation is taking place when including a book or
+evaluating the second pass of an encapsulate event; more precisely, the
+value of (ld-skip-proofsp state) is the symbol INCLUDE-BOOK.  Then the
+expansion is exp.  The expansion phase is skipped unless
+:CHECK-EXPANSION is t.
+
+The :EXPANSION? keyword can be particularly useful in concert with the
+disjunctive (":OR") case (2) discussed above.  Suppose that expansion
+produces a value as discussed in (2) above, (:OR exp-1 ... exp-k).  If
+one of these expressions exp-i is more likely than the others to be the
+expansion, then you may wish to specify :EXPANSION? exp-i, as this will
+avoid storing a make-event replacement in that common case.  This could
+be useful if the expressions are large, to avoid enlarging the
+certificate file for a book containing the make-event call.
+
+It is legal to specify both :EXPANSION? exp and :CHECK-EXPANSION t.
+When either (ld-skip-proofsp state) is the symbol INCLUDE-BOOK, or
+evaluation is taking place in raw Lisp, then this combination is
+treated the same as if :EXPANSION? is omitted and the value of
+:CHECK-EXPANSION is exp.  Otherwise, this combination is treated the
+same as :CHECK-EXPANSION t, modified to accommodate the effect of
+:EXPANSION?  as discussed above: if the expansion is indeed the value
+of :EXPANSION?, then no make-event replacement is generated.
+
 
 File: acl2-doc-emacs.info,  Node: MAKE-EVENT-DETAILS,  Prev: MAKE-EVENT,  Up: MAKE-EVENT
 
@@ -3353,7 +3595,7 @@
 * HONS-AND-MEMOIZATION:: hash cons, function memoization, and applicative hash tables
 
 
-File: acl2-doc-emacs.info,  Node: SET-BODY,  Next: SHOW-CUSTOM-KEYWORD-HINT-EXPANSION,  Prev: SAVE-AND-CLEAR-MEMOIZATION-SETTINGS,  Up: EVENTS
+File: acl2-doc-emacs.info,  Node: SET-BODY,  Next: TABLE,  Prev: SAVE-AND-CLEAR-MEMOIZATION-SETTINGS,  Up: EVENTS
 
 SET-BODY    set the definition body
 
@@ -3385,30 +3627,7 @@
 SHOW-BODIES::.
 
 
-File: acl2-doc-emacs.info,  Node: SHOW-CUSTOM-KEYWORD-HINT-EXPANSION,  Next: TABLE,  Prev: SET-BODY,  Up: EVENTS
-
-SHOW-CUSTOM-KEYWORD-HINT-EXPANSION    print out custom keyword hints when they are expanded
-
-       Examples:
-       (show-custom-keyword-hint-expansion t)
-       (show-custom-keyword-hint-expansion nil)
-
-       General Form:
-       (show-custom-keyword-hint-expansion flg)
-
-If the value of flg is non-nil, then when custom keyword hints are
-expanded, the system prints the results of each expansion.  This is
-sometimes   useful for debugging custom keyword hints and, from time to
-time, may be   useful in understanding how a custom hint affects some
-proof attempt.
-
-The default setting is nil.
-
-For an explanation of how custom keyword hints are processed,   see
-*note CUSTOM-KEYWORD-HINTS::.
-
-
-File: acl2-doc-emacs.info,  Node: TABLE,  Next: THEORY-INVARIANT,  Prev: SHOW-CUSTOM-KEYWORD-HINT-EXPANSION,  Up: EVENTS
+File: acl2-doc-emacs.info,  Node: TABLE,  Next: THEORY-INVARIANT,  Prev: SET-BODY,  Up: EVENTS
 
 TABLE    user-managed tables
 
@@ -3871,7 +4090,7 @@
 tilde-directive ~@, then that string or message is printed.
 
 
-File: acl2-doc-emacs.info,  Node: VERIFY-GUARDS,  Next: VERIFY-TERMINATION,  Prev: VALUE-TRIPLE,  Up: EVENTS
+File: acl2-doc-emacs.info,  Node: VERIFY-GUARDS,  Next: VERIFY-GUARDS+,  Prev: VALUE-TRIPLE,  Up: EVENTS
 
 VERIFY-GUARDS    verify the guards of a function
 
@@ -3887,6 +4106,11 @@
 evaluation of an expression without free variables, no guard violation
 takes place.
 
+Technical note: the first argument of verify-guards must be a function
+symbol or the name of a defthm or defaxiom event, not a macro-alias for
+a function symbol (see *note MACRO-ALIASES-TABLE::).  See *note
+VERIFY-GUARDS+:: for a utility that does not have this restriction.
+
 Guard verification is intended to guarantee that for any call of a given
 function, if its guard holds for that call then the guard will hold for
 every function call in the body of that function.  Moreover, in order to
@@ -4168,7 +4392,60 @@
 that documentation.
 
 
-File: acl2-doc-emacs.info,  Node: VERIFY-TERMINATION,  Prev: VERIFY-GUARDS,  Up: EVENTS
+File: acl2-doc-emacs.info,  Node: VERIFY-GUARDS+,  Next: VERIFY-TERMINATION,  Prev: VERIFY-GUARDS,  Up: EVENTS
+
+VERIFY-GUARDS+    verify the guards of a function
+
+We assume familiarity with guard verification; see *note
+VERIFY-GUARDS::.  Unlike verify-guards, the macro call (verify-guards+
+mac ...) will verify guards for a function, fn, such that the macro mac
+is associated with the function symbol fn in macro-aliases-table (also
+see *note ADD-MACRO-ALIAS::).  For example, if you define a macro app
+and list append function binary-app, and you associate macro app with
+function symbol binary-app in macro-aliases-table, then evaluation of
+the form (verify-guard+ app) will have the effect of evaluating
+(verify-guards fn).  Note that in this setting, evaluation of
+(verify-guard app) would cause an error, because app is a macro and
+verify-guards, unlike verify-guards+, cannot handle macros.
+
+The rest of this documentation topic discusses why we do not simply
+arrange that verify-guards be permitted to take a macro alias.  The
+following example shows a soundness issue in doing so.
+
+     (encapsulate
+      ()
+      (defun f1 (x)
+        (declare (xargs :guard (consp x)
+                        :verify-guards nil))
+        (car x))
+      (defun f2 (x)
+        (declare (xargs :guard t
+                        :verify-guards nil))
+        (cdr x))
+      (defmacro mac (x)
+        x)
+      (add-macro-alias mac f2) ; silly macro alias ;
+      (local (add-macro-alias mac f1)) ; alternate silly macro alias ;
+      (verify-guards mac))
+
+If we were to allow macro aliases in verify-guards, this event would be
+admitted, because on the first pass we are verifying guards of f1.  But
+after the encapsulate form completes evaluation, it would appear that
+f2 is guard-verified.  That could of course cause a raw Lisp error.
+
+The enhanced functionality provided by verify-guards+ does not have the
+above problem, because it takes advantage of make-event to avoid taking
+advantage of the contradictory results produced by the two calls of
+add-macro-alias.  See *note MAKE-EVENT::.  If the specific example
+above is modified by replacing verify-guards with verify-guards+, then
+the first pass through the encapsulate form will expand the form
+(verify-guards+ mac) to (verify-guards f1).  That same expansion will
+be used for the verify-guards+ call during the second pass through the
+encapsulate form, which is evaluated successfully and leaves us in a
+world where f1 is guard-verified and f2 is not.
+
+
+File: acl2-doc-emacs.info,  Node: VERIFY-TERMINATION,  Prev: VERIFY-GUARDS+,  Up: EVENTS
 
 VERIFY-TERMINATION    convert a function from :program mode to :logic mode
 
@@ -4980,9 +5257,9 @@
 
 Pc always prints a space first, followed by three (possibly blank)
 characters ("LVd" above) explained below (four, in the experimental
-HONS version; see *note HONS-AND-MEMOIZATION::).  Then pc prints the
-command number, a number uniquely identifying the command's position in
-the sequence of commands since the beginning of the user's session.
+HONS version, as discussed further below).  Then pc prints the command
+number, a number uniquely identifying the command's position in the
+sequence of commands since the beginning of the user's session.
 Finally, the command itself is printed.
 
 While pc always prints a space first, some history commands, for
@@ -6254,6 +6531,8 @@
 this alist, if one exists.  This effectively converts the alist into an
 ordinary alist.
 
+Also see *note FAST-ALIST-FREE-ON-EXIT::.
+
 Because there is no automatic mechanism for freeing the hash tables
 used in fast alists, to avoid memory leaks you should manually free any
 alists that will no longer be used.  You may find fast-alist-summary
@@ -6268,15 +6547,15 @@
 
 FAST-ALIST-FREE-ON-EXIT    Free a fast alist after the completion of some form.
 
-Logically, (fast-alist-free-on-exit name form) is the identity and
-returns form.
+Logically, (fast-alist-free-on-exit alist form) is the identity and
+returns form.  Also see *note FAST-ALIST-FREE::.
 
 Under the hood, this essentially expands to:
 
       (prog1 form
-             (fast-alist-free name))
+             (fast-alist-free alist))
 
-In other words, name is not freed immediately, but instead remains a
+In other words, alist is not freed immediately, but instead remains a
 fast alist until the form completes.  This may be useful when you are
 writing code that uses a fast alist but has many return points.
 
@@ -6365,6 +6644,10 @@
 
 Performance Notes
 
+See *note HONS-ACONS:: for how the final cdr of a fast alist can be
+used as a size hint or as a name for reports printed by calling
+fast-alist-summary.
+
 The keys of fast alists are always normed.  Why?  In Common Lisp,
 equal-based hashing is relatively slow, so to allow the use of
 eql-based hash tables, hons-acons and hons-get always hons-copy the keys
@@ -6543,310 +6826,3 @@
 and this new object would not be associated with the fast alist's hash
 table.
 
-
-File: acl2-doc-emacs.info,  Node: HONS-ASSOC-EQUAL,  Next: HONS-CLEAR,  Prev: HONS-ACONS!,  Up: HONS-AND-MEMOIZATION
-
-HONS-ASSOC-EQUAL    (hons-assoc-equal key alist) is *not fast*; it serves as the logical
-definition for hons-get.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-The definition of hons-assoc-equal is similar to that of assoc-equal,
-except that (1) it does not require alistp as a guard, and (2) it "skips
-over" any non-conses when its alist argument is malformed.
-
-We typically leave hons-get enabled and reason about hons-assoc-equal
-instead.  One benefit of this approach is that it avoids certain "false"
-discipline warnings that might arise from execution during theorem
-proving.
-
-
-File: acl2-doc-emacs.info,  Node: HONS-CLEAR,  Next: HONS-COPY,  Prev: HONS-ASSOC-EQUAL,  Up: HONS-AND-MEMOIZATION
-
-HONS-CLEAR    (hons-clear gc) is a drastic garbage collection mechanism that clears out
-the underlying Hons Space.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-Logically, hons-clear just returns nil; we leave it enabled and would
-think it odd to ever prove a theorem about it.
-
-Under the hood, hons-clear brutally (1) clears all the tables that
-govern which conses are normed, then (2) optionally garbage collects,
-per the gc argument, then finally (3) re-norms the keys of fast-alists
-and persistently normed conses; see *note HONS-COPY-PERSISTENT::.
-
-Note.  The hash tables making up the Hons Space retain their sizes
-after being cleared.  If you want to shrink them, see hons-resize.
-
-Note.  CCL users might prefer hons-wash, which is relatively efficient
-and allows for the garbage collection of normed conses without
-impacting their normed status.
-
-Note.  It is not recommended to interrupt this function.  Doing so may
-cause persistently normed conses and fast alist keys to become
-un-normed, which might lead to less efficient re-norming and/or
-violations of the fast-alist discipline.
-
-
-File: acl2-doc-emacs.info,  Node: HONS-COPY,  Next: HONS-COPY-PERSISTENT,  Prev: HONS-CLEAR,  Up: HONS-AND-MEMOIZATION
-
-HONS-COPY    (hons-copy x) returns a normed object that is equal to X.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-In the logic, hons-copy is just the identity function; we leave it
-enabled and would think it odd to ever prove a theorem about it.
-
-Under the hood, hons-copy does whatever is necessary to produce a
-normed version of X.
-
-What might this involve?
-
-If X is a symbol, character, or number, then it is already normed and
-nothing is done.
-
-If X is a string, we check if any normed version of X already exists.
-If so, we return the already-normed version; otherwise, we install X as
-the normed version for all strings that are equal to X.
-
-If X is a cons, we must determine if there is a normed version of X, or
-recursively construct and install one.  Norming large cons trees can
-become expensive, but there are a couple of cheap cases.  In
-particular, if X is already normed, or if large subtrees of X are
-already normed, then not much needs to be done.  The slowest case is
-norming some large ACL2 cons structure that has no subtrees which are
-already normed.
-
-Note that running hons-copy on an object that was created with cons is
-often slower than just using hons directly when constructing the object.
-
-
-File: acl2-doc-emacs.info,  Node: HONS-COPY-PERSISTENT,  Next: HONS-EQUAL,  Prev: HONS-COPY,  Up: HONS-AND-MEMOIZATION
-
-HONS-COPY-PERSISTENT    (hons-copy-persistent x) returns a normed object that is equal to X
-and which will be re-normed after any calls to hons-clear.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-Logically hons-copy-persistent is the identity; we leave it enabled and
-would think it odd to ever prove a theorem about it.
-
-Under the hood, hons-copy-persistent is virtually identical to
-hons-copy.
-
-The only difference is that when hons-clear is used, any persistently
-normed conses are automatically re-normed, and this re-norming can be
-carried out more efficiently than, say, an ordinary hons-copy.
-
-
-File: acl2-doc-emacs.info,  Node: HONS-EQUAL,  Next: HONS-EQUAL-LITE,  Prev: HONS-COPY-PERSISTENT,  Up: HONS-AND-MEMOIZATION
-
-HONS-EQUAL    (hons-equal x y) is a recursive equality check that optimizes when parts of
-its arguments are normed.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-In the logic, hons-equal is just equal; we leave it enabled and would
-think it odd to ever prove a theorem about it.
-
-Under the hood, when hons-equal encounters two arguments that are both
-normed, it becomes a mere eql check, and hence avoids the overhead of
-recursively checking large cons structures for equality.
-
-Note.  If hons-equal is given arguments that do not contain many normed
-objects, it can actually be much slower than equal!  This is because it
-checks to see whether its arguments are normed at each recursive step,
-and so you are repeatedly paying the price of such checks.  Also see
-*note HONS-EQUAL-LITE::, which only checks at the top level whether its
-arguments are normed.
-
-
-File: acl2-doc-emacs.info,  Node: HONS-EQUAL-LITE,  Next: HONS-GET,  Prev: HONS-EQUAL,  Up: HONS-AND-MEMOIZATION
-
-HONS-EQUAL-LITE    (hons-equal-lite x y) is a non-recursive equality check that optimizes if
-its arguments are normed.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-In the logic, hons-equal-lite is just equal; we leave it enabled and
-would think it odd to ever prove a theorem about it.
-
-Under the hood, hons-equal-lite checks whether its arguments are normed,
-and if so it effectively becomes a eql check.  Otherwise, it immediately
-calls equal to determine if its arguments are equal.
-
-The idea here is to strike a useful balance between equal and
-hons-equal.  If both arguments happen to be normed, we get to use a very
-fast equality comparison.  Otherwise, we just get out of the way and let
-equal do its work, without the extra overhead of recursively checking
-whether the subtrees of x and y are normed.
-
-
-File: acl2-doc-emacs.info,  Node: HONS-GET,  Next: HONS-NOTE,  Prev: HONS-EQUAL-LITE,  Up: HONS-AND-MEMOIZATION
-
-HONS-GET    (hons-get key alist) is the efficient lookup operation for
-fast-alists.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-Logically, hons-get is just an alias for hons-assoc-equal; we typically
-leave it enabled and prefer to reason about hons-assoc-equal instead.
-One benefit of this approach is that it helps to avoids "false"
-discipline warnings that might arise from execution during theorem
-proving.
-
-Under the hood, when alist is a fast alist that is associated with a
-valid hash table, hons-get first norms key using hons-copy, then
-becomes a gethash operation on the hidden hash table.
-
-
-File: acl2-doc-emacs.info,  Node: HONS-NOTE,  Next: HONS-RESIZE,  Prev: HONS-GET,  Up: HONS-AND-MEMOIZATION
-
-HONS-NOTE    notes about HONS, especially pertaining to expensive resizing operations
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-Certain "Hons-Notes" are printed to the terminal to report
-implementation-level information about the management of HONS
-structures.  Some of these may be low-level and of interest mainly to
-system developers.  But below we discuss what users can learn from a
-particular hons-note, "ADDR-LIMIT reached".  In short: If you are
-seeing a lot of such hons-notes, then you may be using a lot of memory.
-(Maybe you can reduce that memory; for certain BDD operations, for
-example (as defined in community books books/centaur/ubdds/), variable
-ordering can make a big difference.)
-
-By way of background:
-
-     The ADDR-HT is the main hash table that lets us look up normed
-     conses, i.e., honses.  It is an ordinary Common Lisp hash table,
-     so when it starts to get too full the Lisp will grow it.  It can
-     get really big.  (It has been seen to take more than 10 GB of
-     memory just for the hash table's array, not to mention the actual
-     conses!)
-
-     Hons-Notes may be printed when the ADDR-HT is getting really full.
-     This growth can be expensive and can lead to memory problems.
-     Think about what it takes to resize a hash table:
-
-     (1) allocate a new, bigger array
-     (2) rehash elements, copying them into the new array
-     (3) free the old array
-
-     Until you reach step (3) and a garbage collection takes place, you
-     have to have enough memory to have both the old and new arrays
-     allocated.  If the old array was 10 GB and we want to allocate a
-     new one that's 15 GB, this can get pretty bad.  Also, rehashing
-     the elements is expensive time-wise when there are lots of
-     elements.
-
-     Since resizing a hash table is expensive, we want to avoid it.
-     There's a hons-resize command for this.  You may want your books
-     to start with something like the following.
-
-            (value-triple (set-max-mem (* 30 (expt 2 30))))      ; 30 GB heap
-            (value-triple (hons-resize :addr-ht #u_100_000_000)) ; 100M honses
-
-     Basically, if you roughly know how many honses your book will
-     need, you can just get them up front and then never to resize.
-
-The Hons-Notes about "ADDR-LIMIT reached" are basically there to warn
-you that the ADDR-HT is being resized.  This can help you realize that
-your hons-resize command had too small of an ADDR-HT size, or might
-suggest that your book should have a hons-resize command.  There are
-also commands like (hons-summary) and, defined in community book
-books/centaur/misc/memory-mgmt-logic.lisp, (hons-analyze-memory nil).
-These can show you how many honses you currently have, how much space
-they are taking, and that sort of thing.  (A nice trick is to call
-hons-summary at the end of a book, to get an idea of how many honses
-you should ask for in your hons-resize command).
-
-
-File: acl2-doc-emacs.info,  Node: HONS-RESIZE,  Next: HONS-SHRINK-ALIST,  Prev: HONS-NOTE,  Up: HONS-AND-MEMOIZATION
-
-HONS-RESIZE    (hons-resize ...) can be used to manually adjust the sizes of the hash
-tables that govern which ACL2 Objects are considered normed.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
-
-General form:
-
-      (hons-resize [:str-ht size]
-                   [:nil-ht size]
-                   [:cdr-ht size]
-                   [:cdr-ht-eql size]
-                   [:addr-ht size]
-                   [:other-ht size]
-                   [:sbits size]
-                   [:fal-ht size]
-                   [:persist-ht size])
-
-Example:
-
-      (hons-resize :str-ht 100000
-                   :addr-ht (expt 2 27))
-
-Logically, hons-resize just returns nil; we leave it enabled and would
-think it odd to ever prove a theorem about it.
-
-Under the hood, hons-resize can be used to change the sizes of certain
-hash tables in the Hons Space.
-
-All arguments are optional.  The size given to each argument should
-either be nil (the default) or a natural number.  A natural number
-indicates the newly desired size for the hash table, whereas nil means
-"don't resize this table."  Any non-natural argument is regarded as nil.
-
-You may wish to call this function for two reasons.
-
-1.  Improving Performance by Resizing Up
-
-Since the hash tables in the Hons Space automatically grow as new
-objects are normed, hons-resize is unnecessary.  But automatic growth
-can be slow because it is incremental: a particular hash table might be
-grown dozens of times over the course of your application.  Using
-hons-resize to pick a more appropriate initial size may help to reduce
-this overhead.
-
-2.  Reducing Memory Usage by Resizing Down
-
-Resizing can also be used to shrink the hash tables.  This might
-possibly be useful immediately after a hons-clear to free up memory
-taken by the hash tables themselves.  (Of course, the tables will grow
-again as you create new normed objects.)
-
-Advice for using hons-resize.
-
-Note that hash tables that are already close to the desired size, or
-which have too many elements to fit into the desired size, will not
-actually be resized.  This makes resizing relatively "safe."
-
-Note that the hons-summary function can be used to see how large and how
-full your hash tables are.  This may be useful in deciding what sizes
-you want to give to hons-resize.
-
-Note that hons-resize operates by (1) allocating new hash tables, then
-(2) copying everything from the old hash table into the new table.
-Because of this, for best performance you should ideally call it when
-the hash tables involved are minimally populated, i.e., at the start of
-your application, or soon after a hons-clear.
-
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-5 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-5
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-5	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-5	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,6 +28,313 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: HONS-ASSOC-EQUAL,  Next: HONS-CLEAR,  Prev: HONS-ACONS!,  Up: HONS-AND-MEMOIZATION
+
+HONS-ASSOC-EQUAL    (hons-assoc-equal key alist) is *not fast*; it serves as the logical
+definition for hons-get.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+The definition of hons-assoc-equal is similar to that of assoc-equal,
+except that (1) it does not require alistp as a guard, and (2) it "skips
+over" any non-conses when its alist argument is malformed.
+
+We typically leave hons-get enabled and reason about hons-assoc-equal
+instead.  One benefit of this approach is that it avoids certain "false"
+discipline warnings that might arise from execution during theorem
+proving.
+
+
+File: acl2-doc-emacs.info,  Node: HONS-CLEAR,  Next: HONS-COPY,  Prev: HONS-ASSOC-EQUAL,  Up: HONS-AND-MEMOIZATION
+
+HONS-CLEAR    (hons-clear gc) is a drastic garbage collection mechanism that clears out
+the underlying Hons Space.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+Logically, hons-clear just returns nil; we leave it enabled and would
+think it odd to ever prove a theorem about it.
+
+Under the hood, hons-clear brutally (1) clears all the tables that
+govern which conses are normed, then (2) optionally garbage collects,
+per the gc argument, then finally (3) re-norms the keys of fast-alists
+and persistently normed conses; see *note HONS-COPY-PERSISTENT::.
+
+Note.  The hash tables making up the Hons Space retain their sizes
+after being cleared.  If you want to shrink them, see hons-resize.
+
+Note.  CCL users might prefer hons-wash, which is relatively efficient
+and allows for the garbage collection of normed conses without
+impacting their normed status.
+
+Note.  It is not recommended to interrupt this function.  Doing so may
+cause persistently normed conses and fast alist keys to become
+un-normed, which might lead to less efficient re-norming and/or
+violations of the fast-alist discipline.
+
+
+File: acl2-doc-emacs.info,  Node: HONS-COPY,  Next: HONS-COPY-PERSISTENT,  Prev: HONS-CLEAR,  Up: HONS-AND-MEMOIZATION
+
+HONS-COPY    (hons-copy x) returns a normed object that is equal to X.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+In the logic, hons-copy is just the identity function; we leave it
+enabled and would think it odd to ever prove a theorem about it.
+
+Under the hood, hons-copy does whatever is necessary to produce a
+normed version of X.
+
+What might this involve?
+
+If X is a symbol, character, or number, then it is already normed and
+nothing is done.
+
+If X is a string, we check if any normed version of X already exists.
+If so, we return the already-normed version; otherwise, we install X as
+the normed version for all strings that are equal to X.
+
+If X is a cons, we must determine if there is a normed version of X, or
+recursively construct and install one.  Norming large cons trees can
+become expensive, but there are a couple of cheap cases.  In
+particular, if X is already normed, or if large subtrees of X are
+already normed, then not much needs to be done.  The slowest case is
+norming some large ACL2 cons structure that has no subtrees which are
+already normed.
+
+Note that running hons-copy on an object that was created with cons is
+often slower than just using hons directly when constructing the object.
+
+
+File: acl2-doc-emacs.info,  Node: HONS-COPY-PERSISTENT,  Next: HONS-EQUAL,  Prev: HONS-COPY,  Up: HONS-AND-MEMOIZATION
+
+HONS-COPY-PERSISTENT    (hons-copy-persistent x) returns a normed object that is equal to X
+and which will be re-normed after any calls to hons-clear.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+Logically hons-copy-persistent is the identity; we leave it enabled and
+would think it odd to ever prove a theorem about it.
+
+Under the hood, hons-copy-persistent is virtually identical to
+hons-copy.
+
+The only difference is that when hons-clear is used, any persistently
+normed conses are automatically re-normed, and this re-norming can be
+carried out more efficiently than, say, an ordinary hons-copy.
+
+
+File: acl2-doc-emacs.info,  Node: HONS-EQUAL,  Next: HONS-EQUAL-LITE,  Prev: HONS-COPY-PERSISTENT,  Up: HONS-AND-MEMOIZATION
+
+HONS-EQUAL    (hons-equal x y) is a recursive equality check that optimizes when parts of
+its arguments are normed.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+In the logic, hons-equal is just equal; we leave it enabled and would
+think it odd to ever prove a theorem about it.
+
+Under the hood, when hons-equal encounters two arguments that are both
+normed, it becomes a mere eql check, and hence avoids the overhead of
+recursively checking large cons structures for equality.
+
+Note.  If hons-equal is given arguments that do not contain many normed
+objects, it can actually be much slower than equal!  This is because it
+checks to see whether its arguments are normed at each recursive step,
+and so you are repeatedly paying the price of such checks.  Also see
+*note HONS-EQUAL-LITE::, which only checks at the top level whether its
+arguments are normed.
+
+
+File: acl2-doc-emacs.info,  Node: HONS-EQUAL-LITE,  Next: HONS-GET,  Prev: HONS-EQUAL,  Up: HONS-AND-MEMOIZATION
+
+HONS-EQUAL-LITE    (hons-equal-lite x y) is a non-recursive equality check that optimizes if
+its arguments are normed.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+In the logic, hons-equal-lite is just equal; we leave it enabled and
+would think it odd to ever prove a theorem about it.
+
+Under the hood, hons-equal-lite checks whether its arguments are normed,
+and if so it effectively becomes a eql check.  Otherwise, it immediately
+calls equal to determine if its arguments are equal.
+
+The idea here is to strike a useful balance between equal and
+hons-equal.  If both arguments happen to be normed, we get to use a very
+fast equality comparison.  Otherwise, we just get out of the way and let
+equal do its work, without the extra overhead of recursively checking
+whether the subtrees of x and y are normed.
+
+
+File: acl2-doc-emacs.info,  Node: HONS-GET,  Next: HONS-NOTE,  Prev: HONS-EQUAL-LITE,  Up: HONS-AND-MEMOIZATION
+
+HONS-GET    (hons-get key alist) is the efficient lookup operation for
+fast-alists.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+Logically, hons-get is just an alias for hons-assoc-equal; we typically
+leave it enabled and prefer to reason about hons-assoc-equal instead.
+One benefit of this approach is that it helps to avoids "false"
+discipline warnings that might arise from execution during theorem
+proving.
+
+Under the hood, when alist is a fast alist that is associated with a
+valid hash table, hons-get first norms key using hons-copy, then
+becomes a gethash operation on the hidden hash table.
+
+
+File: acl2-doc-emacs.info,  Node: HONS-NOTE,  Next: HONS-RESIZE,  Prev: HONS-GET,  Up: HONS-AND-MEMOIZATION
+
+HONS-NOTE    notes about HONS, especially pertaining to expensive resizing operations
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+Certain "Hons-Notes" are printed to the terminal to report
+implementation-level information about the management of HONS
+structures.  Some of these may be low-level and of interest mainly to
+system developers.  But below we discuss what users can learn from a
+particular hons-note, "ADDR-LIMIT reached".  In short: If you are
+seeing a lot of such hons-notes, then you may be using a lot of memory.
+(Maybe you can reduce that memory; for certain BDD operations, for
+example (as defined in community books books/centaur/ubdds/), variable
+ordering can make a big difference.)
+
+By way of background:
+
+     The ADDR-HT is the main hash table that lets us look up normed
+     conses, i.e., honses.  It is an ordinary Common Lisp hash table,
+     so when it starts to get too full the Lisp will grow it.  It can
+     get really big.  (It has been seen to take more than 10 GB of
+     memory just for the hash table's array, not to mention the actual
+     conses!)
+
+     Hons-Notes may be printed when the ADDR-HT is getting really full.
+     This growth can be expensive and can lead to memory problems.
+     Think about what it takes to resize a hash table:
+
+     (1) allocate a new, bigger array
+     (2) rehash elements, copying them into the new array
+     (3) free the old array
+
+     Until you reach step (3) and a garbage collection takes place, you
+     have to have enough memory to have both the old and new arrays
+     allocated.  If the old array was 10 GB and we want to allocate a
+     new one that's 15 GB, this can get pretty bad.  Also, rehashing
+     the elements is expensive time-wise when there are lots of
+     elements.
+
+     Since resizing a hash table is expensive, we want to avoid it.
+     There's a hons-resize command for this.  You may want your books
+     to start with something like the following.
+
+            (value-triple (set-max-mem (* 30 (expt 2 30))))      ; 30 GB heap
+            (value-triple (hons-resize :addr-ht #u_100_000_000)) ; 100M honses
+
+     Basically, if you roughly know how many honses your book will
+     need, you can just get them up front and then never to resize.
+
+The Hons-Notes about "ADDR-LIMIT reached" are basically there to warn
+you that the ADDR-HT is being resized.  This can help you realize that
+your hons-resize command had too small of an ADDR-HT size, or might
+suggest that your book should have a hons-resize command.  There are
+also commands like (hons-summary) and, defined in community book
+books/centaur/misc/memory-mgmt-logic.lisp, (hons-analyze-memory nil).
+These can show you how many honses you currently have, how much space
+they are taking, and that sort of thing.  (A nice trick is to call
+hons-summary at the end of a book, to get an idea of how many honses
+you should ask for in your hons-resize command).
+
+
+File: acl2-doc-emacs.info,  Node: HONS-RESIZE,  Next: HONS-SHRINK-ALIST,  Prev: HONS-NOTE,  Up: HONS-AND-MEMOIZATION
+
+HONS-RESIZE    (hons-resize ...) can be used to manually adjust the sizes of the hash
+tables that govern which ACL2 Objects are considered normed.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting hash cons, fast alists, and memoization; see *note
+HONS-AND-MEMOIZATION::.
+
+General form:
+
+      (hons-resize [:str-ht size]
+                   [:nil-ht size]
+                   [:cdr-ht size]
+                   [:cdr-ht-eql size]
+                   [:addr-ht size]
+                   [:other-ht size]
+                   [:sbits size]
+                   [:fal-ht size]
+                   [:persist-ht size])
+
+Example:
+
+      (hons-resize :str-ht 100000
+                   :addr-ht (expt 2 27))
+
+Logically, hons-resize just returns nil; we leave it enabled and would
+think it odd to ever prove a theorem about it.
+
+Under the hood, hons-resize can be used to change the sizes of certain
+hash tables in the Hons Space.
+
+All arguments are optional.  The size given to each argument should
+either be nil (the default) or a natural number.  A natural number
+indicates the newly desired size for the hash table, whereas nil means
+"don't resize this table."  Any non-natural argument is regarded as nil.
+
+You may wish to call this function for two reasons.
+
+1.  Improving Performance by Resizing Up
+
+Since the hash tables in the Hons Space automatically grow as new
+objects are normed, hons-resize is unnecessary.  But automatic growth
+can be slow because it is incremental: a particular hash table might be
+grown dozens of times over the course of your application.  Using
+hons-resize to pick a more appropriate initial size may help to reduce
+this overhead.
+
+2.  Reducing Memory Usage by Resizing Down
+
+Resizing can also be used to shrink the hash tables.  This might
+possibly be useful immediately after a hons-clear to free up memory
+taken by the hash tables themselves.  (Of course, the tables will grow
+again as you create new normed objects.)
+
+Advice for using hons-resize.
+
+Note that hash tables that are already close to the desired size, or
+which have too many elements to fit into the desired size, will not
+actually be resized.  This makes resizing relatively "safe."
+
+Note that the hons-summary function can be used to see how large and how
+full your hash tables are.  This may be useful in deciding what sizes
+you want to give to hons-resize.
+
+Note that hons-resize operates by (1) allocating new hash tables, then
+(2) copying everything from the old hash table into the new table.
+Because of this, for best performance you should ideally call it when
+the hash tables involved are minimally populated, i.e., at the start of
+your application, or soon after a hons-clear.
+
+
 File: acl2-doc-emacs.info,  Node: HONS-SHRINK-ALIST,  Next: HONS-SHRINK-ALIST!,  Prev: HONS-RESIZE,  Up: HONS-AND-MEMOIZATION
 
 HONS-SHRINK-ALIST    (hons-shrink-alist alist ans) can be used to eliminate "shadowed pairs"
@@ -35,9 +342,10 @@
 
 This documentation topic relates to the experimental extension of ACL2
 supporting hash cons, fast alists, and memoization; see *note
-HONS-AND-MEMOIZATION::.
+HONS-AND-MEMOIZATION::.  It assumes familiarity with fast alists; see
+*note FAST-ALISTS::.
 
-Logically, hons-shrink-alist is defined as follows:
+Logically, (hons-shrink-alist alist ans) is defined as follows:
 
       (cond ((atom alist)
              ans)
@@ -59,6 +367,19 @@
 that can extended independently from the original while maintaining
 discipline.
 
+Note that hons-shrink-alist is potentially expensive, for the following
+two reasons.
+
+     o The alist is copied, dropping any shadowed pairs.  This process
+     will require a hash table lookup for each entry in the alist; and
+     it will require creating a new alist, which uses additional memory.
+
+     o Unless ans is a fast alist that is stolen (see below), a new
+     hash table is created, which uses additional memory.  This hash
+     table is populated in time that is linear in the number of unique
+     keys in the alist.
+
+
 When ans is not an atom, good discipline requires that it is a fast
 alist.  In this case, hons-shrink-alist steals the hash table for ans
 and extends it with all of the bindings in alist that are not in ans.
@@ -66,6 +387,18 @@
 resulting alist as being basically similar to (append ans alist), but
 in a different order.
 
+Note that when ans is not a fast alist (e.g., ans is an atom) then such
+stealing does not take place.
+
+A common idiom is to replace an alist by the result of shrinking it, in
+which case it is best to free the input alist, for example as follows.
+
+       (let ((alist (fast-alist-free-on-exit alist
+                                             (hons-shrink-alist alist nil))))
+         ...)
+
+See *note FAST-ALIST-FREE-ON-EXIT:: and see *note FAST-ALIST-FREE::.
+
 
 File: acl2-doc-emacs.info,  Node: HONS-SHRINK-ALIST!,  Next: HONS-SUMMARY,  Prev: HONS-SHRINK-ALIST,  Up: HONS-AND-MEMOIZATION
 
@@ -2226,7 +2559,7 @@
 
 * ACL2S:: See *note ACL2-SEDAN::.
 
-* APROPOS:: searching the documentation online
+* APROPOS:: See *note FINDING-DOCUMENTATION::.
 
 * BACKCHAIN-LIMIT:: limiting the effort expended on relieving hypotheses
 
@@ -2236,7 +2569,7 @@
 
 * BIBLIOGRAPHY:: reports about ACL2
 
-* BIND-FREE:: to bind free variables of a rewrite or linear rule
+* BIND-FREE:: to bind free variables of a rewrite, definition, or linear rule
 
 * BY:: hints keyword :BY
 
@@ -2316,6 +2649,8 @@
 
 * FIND-RULES-OF-RUNE:: find the rules named rune
 
+* FINDING-DOCUMENTATION:: searching the documentation
+
 * FNCALL-TERM:: See *note META-EXTRACT::.
 
 * FORCE:: identity function used to force a hypothesis
@@ -2334,6 +2669,8 @@
 
 * GCL:: tips on building and using ACL2 based on Gnu Common Lisp
 
+* GET-INTERNAL-TIME:: runtime vs. realtime in ACL2 timings
+
 * GET-WORMHOLE-STATUS:: make a wormhole's status visible outside the wormhole
 
 * GOAL-SPEC:: to indicate where a hint is to be used
@@ -2354,6 +2691,8 @@
 
 * IF-INTRO:: See *note SPLITTER::.
 
+* IGNORED-ATTACHMENT:: why attachments are sometimes not used
+
 * IMMED-FORCED:: See *note SPLITTER::.
 
 * IMMEDIATE-FORCE-MODEP:: when executable counterpart is enabled,
@@ -2367,14 +2706,14 @@
 
 * LAMBDA:: See *note TERM::.
 
+* LAST-PROVER-STEPS:: the number of prover steps most recently taken
+
 * LD-ERROR-ACTION:: determines ld's response to an error
 
 * LD-ERROR-TRIPLES:: determines whether a form caused an error during ld
 
 * LD-EVISC-TUPLE:: determines whether ld suppresses details when printing
 
-* LD-KEYWORD-ALIASES:: allows the abbreviation of some keyword commands
-
 * LD-MISSING-INPUT-OK:: determines which forms ld evaluates
 
 * LD-POST-EVAL-PRINT:: determines whether and how ld prints the result of evaluation
@@ -2483,7 +2822,7 @@
 
 * REWRITE-STACK-LIMIT:: limiting the stack depth of the ACL2 rewriter
 
-* SAVING-AND-RESTORING:: saving and restoring your logical state
+* SAVING-AND-RESTORING:: See *note SAVE-EXEC::.
 
 * SET-WORMHOLE-DATA:: sets the wormhole data object in a wormhole status object
 
@@ -2509,7 +2848,7 @@
 
 * SYNTAX:: the syntax of ACL2 is that of Common Lisp
 
-* SYNTAXP:: attach a heuristic filter on a :rewrite, :meta, or :linear rule
+* SYNTAXP:: attach a heuristic filter on a rule
 
 * TERM:: the three senses of well-formed ACL2 expressions or formulas
 
@@ -2787,10 +3126,7 @@
 
 File: acl2-doc-emacs.info,  Node: APROPOS,  Next: BACKCHAIN-LIMIT,  Prev: ACL2S,  Up: MISCELLANEOUS
 
-APROPOS    searching the documentation online
-
-The :docs command allows you to search the documentation at the
-terminal.  See *note DOCS::.
+APROPOS    See *note FINDING-DOCUMENTATION::.
 
 
 File: acl2-doc-emacs.info,  Node: BACKCHAIN-LIMIT,  Next: BACKCHAIN-LIMIT-RW,  Prev: APROPOS,  Up: MISCELLANEOUS
@@ -2958,7 +3294,7 @@
 
 File: acl2-doc-emacs.info,  Node: BIND-FREE,  Next: BY,  Prev: BIBLIOGRAPHY,  Up: MISCELLANEOUS
 
-BIND-FREE    to bind free variables of a rewrite or linear rule
+BIND-FREE    to bind free variables of a rewrite, definition, or linear rule
 
      Examples:
      (IMPLIES (AND (RATIONALP LHS)
@@ -2987,12 +3323,13 @@
      (BIND-FREE term t)
      (BIND-FREE term)
 
-A rule which uses a bind-free hypothesis has similarities to both a
-rule which uses a syntaxp hypothesis and to a :meta rule.  Bind-free is
-like syntaxp, in that it logically always returns t but may affect the
-application of a :rewrite or :linear rule when it is called at the
-top-level of a hypothesis.  It is like a :meta rule, in that it allows
-the user to perform transformations of terms under progammatic control.
+A rule which uses a bind-free hypothesis has similarities to both a rule
+which uses a syntaxp hypothesis and to a :meta rule.  Bind-free is like
+syntaxp, in that it logically always returns t but may affect the
+application of a :rewrite, :definition, or :linear rule when it is
+called at the top-level of a hypothesis.  It is like a :meta rule, in
+that it allows the user to perform transformations of terms under
+progammatic control.
 
 Note that a bind-free hypothesis does not, in general, deal with the
 meaning or semantics or values of the terms, but rather with their
@@ -3002,15 +3339,19 @@
 the user sees, but there are subtle and important differences.  Trans
 can be used to view this internal form.
 
-Just as for a syntaxp hypothesis, there are two types of bind-free
-hypotheses.  The simpler type of bind-free hypothesis may be used as
-the nth hypothesis in a :rewrite or :linear rule whose :corollary is
-(implies (and hyp1 ... hypn ... hypk) (equiv lhs rhs)) provided term is
-a term, term contains at least one variable, and every variable
-occuring freely in term occurs freely in lhs or in some hypi, i<n.  In
-addition, term must not use any stobjs.  (Later below we will describe
-the second type, an _extended_ bind-free hypothesis, which may use
-state.)
+Just as for a syntaxp hypothesis, there are two basic types of
+bind-free hypotheses.  The simpler type of bind-free hypothesis may be
+used as the nth hypothesis in a :rewrite, :definition, or :linear rule
+whose :corollary is (implies (and hyp1 ... hypn ... hypk) (equiv lhs
+rhs)) provided term is a term, term contains at least one variable, and
+every variable occuring freely in term occurs freely in lhs or in some
+hypi, i<n.  In addition, term must not use any stobjs.  Later below we
+will describe the second type, an _extended_ bind-free hypothesis, which
+may use state.  Whether simple or extended, a bind-free hypothesis may
+return an alist that binds free variables, as explained below, or it may
+return a list of such alists.  We focus on the first of these cases:
+return of a single binding alist.  We conclude our discussion with a
+section that covers the other case: return of a list of alists.
 
 We begin our description of bind-free by examining the first example
 above in some detail.
@@ -3087,7 +3428,7 @@
       (RHS . (binary-+ (bar b) (expt a n)))).
 
 ACL2 then attempts to relieve the hypotheses in the order they were
-given. Ordinarily this means that we instantiate each hypothesis with
+given.  Ordinarily this means that we instantiate each hypothesis with
 our substitution and then attempt to rewrite the resulting instance to
 true.  Thus, in order to relieve the first hypothesis, we rewrite:
 
@@ -3156,15 +3497,90 @@
 consistency checks to be performed at the time of the rule's admittance
 which are not possible otherwise.
 
-An extended bind-free hypothesis is similar to the simple type
-described above, but it uses two additional variables, mfc and state,
-which must not be bound by the left hand side or an earlier hypothesis
-of the rule.  They must be the last two variables mentioned by term:
-first mfc, then state.  These two variables give access to the
-functions mfc-xxx; see *note EXTENDED-METAFUNCTIONS::.  As described
-there, mfc is bound to the so-called metafunction-context and state to
-ACL2's state.  See *note BIND-FREE-EXAMPLES:: for examples of the use
-of these extended bind-free hypotheses.
+An extended bind-free hypothesis is similar to the simple type described
+above, but it uses two additional variables, mfc and state, which must
+not be bound by the left hand side or an earlier hypothesis of the rule.
+They must be the last two variables mentioned by term: first mfc, then
+state.  These two variables give access to the functions mfc-xxx; see
+*note EXTENDED-METAFUNCTIONS::.  As described there, mfc is bound to
+the so-called metafunction-context and state to ACL2's state.  See
+*note BIND-FREE-EXAMPLES:: for examples of the use of these extended
+bind-free hypotheses.
+
+*SECTION*: Returning a list of alists.
+
+As promised above, we conclude with a discussion of the case that
+evaluation of the bind-free term produces a list of alists, x, rather
+than a single alist.  In this case each member b of x is considered in
+turn, starting with the first and proceeding through the list.  Each
+such b is handled exactly as discussed above, as though it were the
+result of evaluating the bind-free term.  Thus, each b extends the
+current variable binding alist, and all remaining hypotheses are then
+relieved, as though b had been the value obtained by evaluating the
+bind-free term.  As soon as one such b leads to successful relieving of
+all remaining hypotheses, the process of relieving hypotheses
+concludes, so no further members of x are considered.
+
+We illustrate with a simple pedagogical example.  First introduce
+functions p1 and p2 such that a rewrite rule specifies that p2 implies
+p1, but with a free variable.
+
+
+     (defstub p1 (x) t)
+     (defstub p2 (x y) t)
+
+     (defaxiom p2-implies-p1
+       (implies (p2 x y)
+                (p1 x)))
+
+If we add the following axiom, then (p1 x) follows logically for all x.
+
+
+     (defaxiom p2-instance
+       (p2 v (cons v 4)))
+
+Unfortunately, evaluation of (thm (p1 a)) fails, because ACL2 fails to
+bind the free variable y in order to apply the rule p2-instance.
+
+Let's define a function that produces a list of alists, each binding the
+variable y.  Of course, we know that only the middle one below is
+necessary in this simple example.  In more complex examples, one might
+use heuristics to construct such a list of alists.
+
+
+     (defun my-alists (x)
+       (list (list (cons 'y (fcons-term* 'cons x ''3)))
+             (list (cons 'y (fcons-term* 'cons x ''4)))
+             (list (cons 'y (fcons-term* 'cons x ''5)))))
+
+The following rewrite rule uses bind-free to return a list of candidate
+alists binding y.
+
+
+     (defthm p2-implies-p1-better
+       (implies (and (bind-free (my-alists x)
+                                (y)) ; the second argument, (y), is optional
+                     (p2 x y))
+                (p1 x)))
+
+Now the proof succeeds for (thm (p1 a)).  Why?  When ACL2 applies the
+rewrite rule p2-implies-p1-better, it evaluates my-alists, as we can
+see from the following trace, to bind y in three different alists.
+
+
+     ACL2 !>(thm (p1 a))
+     1> (ACL2_*1*_ACL2::MY-ALISTS A)
+     <1 (ACL2_*1*_ACL2::MY-ALISTS (((Y CONS A '3))
+                                   ((Y CONS A '4))
+                                   ((Y CONS A '5))))
+
+     Q.E.D.
+
+The first alist, binding y to (cons a '3), fails to allow the
+hypothesis (p2 x y) to be proved.  But the next binding of y, to (cons
+a '4), succeeds: then the current binding alist is ((x . a) (y . (cons
+a '4))), for which the hypothesis (p2 x y) rewrites to true using the
+rewrite rule p2-instance.
 
 
 File: acl2-doc-emacs.info,  Node: BIND-FREE-EXAMPLES,  Prev: BIND-FREE,  Up: BIND-FREE
@@ -3174,6 +3590,11 @@
 See *note BIND-FREE:: for a basic discussion of the use of bind-free to
 control rewriting.
 
+Note that the examples below all illustrate the common case in which a
+bind-free hypothesis generates a binding alist.  See *note BIND-FREE::,
+in particular the final section, for a discussion of the case that
+instead a list of binding alists is generated.
+
 We give examples of the use of bind-free hypotheses from the
 perspective of a user interested in reasoning about arithmetic, but it
 should be clear that bind-free can be used for many other purposes also.
@@ -3350,14 +3771,21 @@
 
 CASE-SPLIT    like force but immediately splits the top-level goal on the hypothesis
 
-When a hypothesis of a conditional rule has the form (case-split hyp)
-it is logically equivalent to hyp.  However it affects the application
-of the rule generated as follows:  if ACL2 attempts to apply the rule
-but cannot establish that the required instance of hyp holds in the
-current context, it considers the hypothesis true anyhow, but (assuming
-all hypotheses are seen to be true and the rule is applied) creates a
-subgoal in which that instance of hyp is assumed false.  (There are
-exceptions, noted below.)
+Case-split is an variant of force, which has similar special treatment
+in hypotheses of rules for the same rule-classes as for force (see
+*note FORCE::).  This treatment takes place for rule classes :rewrite,
+:linear, :type-prescription, :definition, :meta (actually in that case,
+the result of evaluating the hypothesis metafunction call), and
+:forward-chaining.
+
+When a hypothesis of a conditional rule (of one of the classes listed
+above) has the form (case-split hyp) it is logically equivalent to hyp.
+However it affects the application of the rule generated as follows: if
+ACL2 attempts to apply the rule but cannot establish that the required
+instance of hyp holds in the current context, it considers the
+hypothesis true anyhow, but (assuming all hypotheses are seen to be
+true and the rule is applied) creates a subgoal in which that instance
+of hyp is assumed false.  (There are exceptions, noted below.)
 
 For example, given the rule
 
@@ -3378,7 +3806,7 @@
 round but tackles it more or less immediately.
 
 The special "split" treatment of case-split can be disabled by
-disabling forcing:  see *note FORCE:: for a discussion of disabling
+disabling forcing: see *note FORCE:: for a discussion of disabling
 forcing, and also see *note DISABLE-FORCING::.  Finally, we should
 mention that the rewriter is never willing to split when there is an if
 term present in the goal being simplified.  Since and terms and or
@@ -4416,7 +4844,7 @@
 
 COPYRIGHT    ACL2 copyright, license, sponsorship
 
-ACL2 Version 6.2 - A Computational Logic for Applicative Common Lisp
+ACL2 Version 6.3 - A Computational Logic for Applicative Common Lisp
 Copyright (C) 2013, Regents of the University of Texas
 
 This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright (C)
@@ -4502,6 +4930,33 @@
 users can define their own hint keywords.  For examples, see the
 community books directory books/hints/, in particular basic-tests.lisp.
 
+* Menu:
+
+* SHOW-CUSTOM-KEYWORD-HINT-EXPANSION:: print out custom keyword hints when they are expanded
+
+
+File: acl2-doc-emacs.info,  Node: SHOW-CUSTOM-KEYWORD-HINT-EXPANSION,  Prev: CUSTOM-KEYWORD-HINTS,  Up: CUSTOM-KEYWORD-HINTS
+
+SHOW-CUSTOM-KEYWORD-HINT-EXPANSION    print out custom keyword hints when they are expanded
+
+       Examples:
+       (show-custom-keyword-hint-expansion t)
+       (show-custom-keyword-hint-expansion nil)
+
+       General Form:
+       (show-custom-keyword-hint-expansion flg)
+
+If the value of flg is non-nil, then when custom keyword hints are
+expanded, the system prints the results of each expansion.  This is
+sometimes   useful for debugging custom keyword hints and, from time to
+time, may be   useful in understanding how a custom hint affects some
+proof attempt.
+
+The default setting is nil.
+
+For an explanation of how custom keyword hints are processed,   see
+*note CUSTOM-KEYWORD-HINTS::.
+
 
 File: acl2-doc-emacs.info,  Node: DEFAULT-BACKCHAIN-LIMIT,  Next: DEFAULT-DEFUN-MODE,  Prev: CUSTOM-KEYWORD-HINTS,  Up: MISCELLANEOUS
 
@@ -5474,8 +5929,9 @@
 that gleaned from forward chaining from the (negations of the) other
 literals in the clause returned by mfc-clause.
 
-(mfc-unify-subst mfc): returns the unifying substitution when evaluating
-a syntaxp or bind-free hypothesis, else returns nil.
+(mfc-unify-subst mfc): returns nil except when evaluating a syntaxp or
+bind-free hypothesis, in which case, returns the unifying substitution
+present at the start of that evaluation.
 
 (mfc-world mfc): returns the ACL2 logical world.
 
@@ -5534,14 +5990,16 @@
 returns the contradiction flag produced by linearizing term and adding
 it to the linear-pot-lst.
 
-(mfc-relieve-hyp hyp alist rune target bkptr mfc state): returns c[t or
+(mfc-relieve-hyp hyp alist rune target bkptr mfc state): returns t or
 nil according to whether the indicated hypothesis term, hyp, can be
-relieved (proved) under the giving variable bindings, alist.  Here, hyp
-is the hypothesis of the indicated rune at (one-based) position bkptr,
-and target is an instantiated term to which rune is being applied.
-Note that no indication is returned for whether any assumptions have
-been generated by force or case-split.  (If you need such a feature,
-feel free to request it of the ACL2 implementors.)
+relieved (proved) under the giving variable bindings, alist.  Note that
+this function returns nil if hyp has free variables (see *note
+FREE-VARIABLES::).  Here, hyp is the hypothesis of the indicated rune
+at (one-based) position bkptr, and target is an instantiated term to
+which rune is being applied.  Note that no indication is returned for
+whether any assumptions have been generated by force or case-split.
+(If you need such a feature, feel free to request it of the ACL2
+implementors.)
 
 We explain the :forcep and :ttreep keyword arguments provided in some
 expressions, as promised above.  Their defaults are :same and nil,
@@ -5933,7 +6391,7 @@
 FAILED-FORCING::.
 
 
-File: acl2-doc-emacs.info,  Node: FIND-RULES-OF-RUNE,  Next: FNCALL-TERM,  Prev: FAILURE,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: FIND-RULES-OF-RUNE,  Next: FINDING-DOCUMENTATION,  Prev: FAILURE,  Up: MISCELLANEOUS
 
 FIND-RULES-OF-RUNE    find the rules named rune
 
@@ -5959,7 +6417,31 @@
 in its presence as a 'coarsening of equal.)
 
 
-File: acl2-doc-emacs.info,  Node: FNCALL-TERM,  Next: FORCE,  Prev: FIND-RULES-OF-RUNE,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: FINDING-DOCUMENTATION,  Next: FNCALL-TERM,  Prev: FIND-RULES-OF-RUNE,  Up: MISCELLANEOUS
+
+FINDING-DOCUMENTATION    searching the documentation
+
+The :doc and :doc! commands will display, at the terminal,
+documentation topics defined in ACL2 or in books that have already been
+included.  The :docs command allows you to search the documentation at
+the terminal.  See *note DOCS::.
+
+But how can you find documentation for books that are not included in
+the current ACL2 session?
+
+The xdoc manual is a combined manual for the ACL2 sources and the
+community books.  It is built using documentation not only from the
+ACL2 sources (which is rearranged) but also from the community books
+(whether included in the current session or not), using an "xdoc
+processor" created by Jared Davis.  The ACL2 home page
+(`http://www.cs.utexas.edu/users/moore/acl2/') has a link to this
+manual, which as of this writing may be found directly by visiting the
+following web page: `http://fv.centtech.com/acl2/latest/doc/'.  You can
+build a local copy of this manual from the ACL2 Community Books,
+following instructions in their Makefile.
+
+
+File: acl2-doc-emacs.info,  Node: FNCALL-TERM,  Next: FORCE,  Prev: FINDING-DOCUMENTATION,  Up: MISCELLANEOUS
 
 FNCALL-TERM    See *note META-EXTRACT::.
 
@@ -5968,17 +6450,28 @@
 
 FORCE    identity function used to force a hypothesis
 
-When a hypothesis of a conditional rule has the form (force hyp) it is
-logically equivalent to hyp but has a pragmatic effect.  In particular,
-when the rule is considered, the needed instance of the hypothesis,
-hyp', is assumed and a special case is generated, requiring the system
-to prove that hyp' is true in the current context.  The proofs of all
-such "forced assumptions" are delayed until the successful completion
-of the main goal.  See *note FORCING-ROUND::.
-
-Forcing should only be used on hypotheses that are always expected to be
-true, as is commonly the case for guards of functions.  All the power of
-the theorem prover is brought to bear on a forced hypothesis and no
+Force is the identity function: (force x) is equal to x.  However, for
+rules of many classes (see *note RULE-CLASSES::), a hypothesis of the
+form (force term) is given special treatment, as described below.  This
+treatment takes place for rule classes :rewrite, :linear,
+:type-prescription, :definition, :meta (actually in that case, the
+result of evaluating the hypothesis metafunction call), and
+:forward-chaining.
+
+When a hypothesis of a conditional rule (of one of the classes listed
+above) has the form (force hyp), it is logically equivalent to hyp but
+has a pragmatic effect.  In particular, when the rule is considered,
+the needed instance of the hypothesis, hyp', may be assumed if the
+usual process fails to prove it or its negation.  In that situation, if
+the rule is eventually applied, then a special case is generated,
+requiring the system to prove that hyp' is true in the current context.
+The proofs of all such "forced assumptions" are, by default, delayed
+until the successful completion of the main goal.  See *note
+FORCING-ROUND:: and see *note IMMEDIATE-FORCE-MODEP::.
+
+Forcing is generally used on hypotheses that are always expected to be
+true, as is commonly the case for guards of functions.  All the power
+of the theorem prover is brought to bear on a forced hypothesis and no
 backtracking is possible.  Forced goals can be attacked immediately
 (see *note IMMEDIATE-FORCE-MODEP::) or in a subsequent forcing round
 (see *note FORCING-ROUND::).  Also see *note CASE-SPLIT:: for a related
@@ -6257,7 +6750,7 @@
 Evaluation of a call of this macro always returns nil.
 
 
-File: acl2-doc-emacs.info,  Node: GCL,  Next: GET-WORMHOLE-STATUS,  Prev: GC-VERBOSE,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: GCL,  Next: GET-INTERNAL-TIME,  Prev: GC-VERBOSE,  Up: MISCELLANEOUS
 
 GCL    tips on building and using ACL2 based on Gnu Common Lisp
 
@@ -6384,278 +6877,71 @@
              (i+ y (imin x z))))
 
 
-File: acl2-doc-emacs.info,  Node: GET-WORMHOLE-STATUS,  Next: GOAL-SPEC,  Prev: GCL,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: GET-INTERNAL-TIME,  Next: GET-WORMHOLE-STATUS,  Prev: GCL,  Up: MISCELLANEOUS
 
-GET-WORMHOLE-STATUS    make a wormhole's status visible outside the wormhole
+GET-INTERNAL-TIME    runtime vs. realtime in ACL2 timings
 
-General Form: (get-wormhole-status name state)
+The ACL2 system provides utilities that deal with elapsed time.  The
+most visible of these is in the time summaries printed when completing
+evaluation of events.  For others, see *note WITH-PROVER-TIME-LIMIT::,
+see *note READ-RUN-TIME::, see *note TIME-TRACKER::, see *note
+TIME-TRACKER-TAU::, and see *note PSTACK::.
 
-Name should be the name of a wormhole (see *note WORMHOLE::).  This
-function returns an error triple (see *note ERROR-TRIPLES::) of the form
-(mv nil s state), where s is the status of the named wormhole.  The
-status is obtained by reading the oracle in the ACL2 state.
+By default, these utilities all use an underlying notion of run time
+provided by the host Common Lisp implementation: specifically, Common
+Lisp function get-internal-run-time.  However, Common Lisp also
+provides function get-internal-run-time, which returns the real time
+(wall clock time).  While the latter is specified to measure elapsed
+time, the former is left to the implementation, which might well only
+measure time spent in the Lisp process.  Consider the following
+example, which is a bit arcane but basically sleeps for 2 seconds.
 
-This function makes the status of a wormhole visible outside the
-wormhole.  But since this function takes state and modifies it, the
-function may only be used in contexts in which you may change state.
-Otherwise, the wormhole status may stay in the wormhole.  See
-wormhole-eval and wormhole.
+       (defttag t) ; to allow sys-call
+       (make-event
+        (prog2$ (sys-call "sleep" '("2"))
+                (value '(value-triple nil))))
 
-
-File: acl2-doc-emacs.info,  Node: GOAL-SPEC,  Next: GUARD,  Prev: GET-WORMHOLE-STATUS,  Up: MISCELLANEOUS
-
-GOAL-SPEC    to indicate where a hint is to be used
-
-     Examples:
-     "Goal"
-     "goal"
-     "Subgoal *1/3''"
-     "subgoal *1/3''"
-     "[2]Subgoal *1/3''"
-
-When hints are given to the theorem prover, a goal-spec is provided to
-specify the goal to which the hints are to be applied.  The hints
-provided are carried along innocuously until the named goal arises.
-When it arises, the hints are "activated" for that goal and its
-descendents.
-
-A legal goal specification may be extracted from the theorem prover's
-output.  Certain lines clearly label formulas, as in
-
-     Subgoal *1/3.2'
-     (IMPLIES ... ...)
-
-and these lines all give rise to goal specifications.  In general,
-these lines all start either with "Goal" or "Subgoal" or else with
-those words preceded by a number in square brackets, as in
-
-     [1]Subgoal *1/3.2'
-     (IMPLIES ... ...).
-
-A goal specification may be obtained by deleting any surrounding
-whitespace from such a line and embedding the text in string quotation
-marks.  Thus
-
-     "[1]Subgoal *1/3.2'"
-
-is the goal specifier for the goal above.
-
-As noted, a hint is applied to a goal when the hint's goal
-specification matches the name ACL2 assigns to the goal.  The matching
-algorithm is case-insensitive.  Thus, alternative goal specifications
-for the goal above are "[1]subgoal *1/3.2'" and "[1]SUBGOAL *1/3.2'".
-The matching algorithm does not tolerate non-case discrepancies.  Thus,
-"[1]Subgoal*1/3.2'" and " [1]Subgoal *1/3.2'" are unacceptable.
-
-Sometimes a formula is given two names, e.g.,
-
-     Subgoal *1/14.2'
-     (IMPLIES ...
-              ...)
-     Name the formula above *1.1.
-
-It is the first name (the one that starts with "Goal" or "Subgoal") and
-not the second which constitutes a legal goal-spec.  Roughly speaking,
-when the system prints the line containing the goal specification, it
-activates any hints that are attached to that goal-spec.  Consider the
-example above.  Suppose Subgoal *1/14.2' could be proved by using a
-certain lemma instance.  Then the appropriate entry in the hints would
-be:
-
-     ("Subgoal *1/14.2'" :use ...)
-
-This might surprise you because the system appears to do nothing to
-*1/14.2' besides push it for a subsequent induction.  But actually
-between the time the system printed the goal-spec line and the time it
-decides to push the goal, you can think of the system as trying
-everything it has.  So a use hint activated when Subgoal *1/14.2'
-arises is just what you want.
-
-But what if you want to give an :induct hint?  By the time induction is
-tried, the formula has been given the name *1.1.  Well, this is one you
-just have to remember:
-
-     ("Subgoal *1/14.2'" :induct ...).
-
-When the above hint is activated the :induct directive short-circuits
-the rest of the processing and sends immediately the formula into the
-pool of goals to prove by induction.  The induct hint is attached to
-the formula in the pool and when the time comes to turn our attention
-to that goal, the induct advice is followed.
-
-We conclude by emphasizing a point made above, that a hint is applied
-to a goal when the hint's goal specification matches the name ACL2
-assigns to the goal.  If there is no such match, then the hint is
-ignored.  Consider the following example.
-
-     (thm (equal (append (append x y) z) (append x y z))
-          :hints (("Subgoal *1/" :in-theory nil)))
-
-Normally, :in-theory hints are inherited by subgoals (see *note
-HINTS-AND-THE-WATERFALL::), so you might expect that the empty theory is
-used in Subgoal *1/2 and Subgoal *1/1.  But in fact, since there is no
-subgoal printed that is labeled Subgoal *1/, the above :in-theory hint
-is ignored.  The above example is in contrast to the following, where
-the hint makes the proof fail, because there really is a Subgoal *1/ in
-the proof this time.
-
-     (thm (implies (and (not (endp x)) (not (endp (cdr x))))
-                   (equal (append (append x y) z) (append x y z)))
-          :hints (("Subgoal *1/" :in-theory nil)))
-
-
-File: acl2-doc-emacs.info,  Node: GUARD,  Next: GUARD-HINTS,  Prev: GOAL-SPEC,  Up: MISCELLANEOUS
-
-GUARD    restricting the domain of a function
-
-The ACL2 system provides a mechanism for restricting a function to a
-particular domain.  Such restrictions are called "guards."  A
-definition's guard has no effect on the logical axiom added when that
-definition is accepted by ACL2, and novices are often best served by
-avoiding guards.  However, guards can be useful as a specification
-device or for increasing execution efficiency.  To make such a
-restriction, use the :guard keyword (see *note XARGS::) or, especially
-if you want the host Lisp compiler to use this information, use type
-declarations (see *note DECLARE::; also see *note XARGS:: for a
-discussion of the split-types keyword).  The general issue of guards
-and guard verification is discussed in the topics listed below.
-
-* Menu:
+A typical time summary might be as follows, drastically under-reporting
+the elapsed time.
 
-* EXTRA-INFO:: generate markers to indicate sources of guard proof obligations
+       Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
 
-* GUARD-DEBUG:: generate markers to indicate sources of guard proof obligations
+However, you can instruct ACL2 to switch to using elapsed time (run
+time), in summaries and elsewhere, by evaluating the following form.
 
-* GUARD-EVALUATION-EXAMPLES-LOG:: log showing combinations of defun-modes and guard-checking
+       (assign get-internal-time-as-realtime t)
 
-* GUARD-EVALUATION-EXAMPLES-SCRIPT:: a script to show combinations of defun-modes and guard-checking
+To return to using runtime:
 
-* GUARD-EVALUATION-TABLE:: a table that shows combinations of defun-modes and guard-checking
+       (assign get-internal-time-as-realtime nil)
 
-* GUARD-INTRODUCTION:: introduction to guards in ACL2
+While the above example is rather silly, the issue becomes significant
+in time summaries for proofs that call out to external tools (see *note
+SYS-CALL:: and see *note CLAUSE-PROCESSOR::).
 
-* GUARD-MISCELLANY:: miscellaneous remarks about guards
+Note that a function get-internal-time is defined in raw Lisp but is not
+available inside the ACL2 loop.  However, the expression (read-run-time
+state) provides an interface to this function that is available inside
+the ACL2 loop; see *note READ-RUN-TIME::.
 
-* GUARD-QUICK-REFERENCE:: brief summary of guard checking and guard verification
+We are open to changing the default to elapsed wall-clock time
+(realtime), and may do so in future ACL2 releases.
 
-* GUARDS-AND-EVALUATION:: the relationship between guards and evaluation
-
-* GUARDS-FOR-SPECIFICATION:: guards as a specification device
-
-
-Related topics other than immediate subtopics:
-* GUARD-EXAMPLE:: a brief transcript illustrating guards in ACL2
+
+File: acl2-doc-emacs.info,  Node: GET-WORMHOLE-STATUS,  Next: GOAL-SPEC,  Prev: GET-INTERNAL-TIME,  Up: MISCELLANEOUS
 
-* SET-GUARD-CHECKING:: control checking guards during execution of top-level forms
+GET-WORMHOLE-STATUS    make a wormhole's status visible outside the wormhole
 
-* SET-VERIFY-GUARDS-EAGERNESS:: the eagerness with which guard verification is tried.
+General Form: (get-wormhole-status name state)
 
-* VERIFY-GUARDS:: verify the guards of a function
+Name should be the name of a wormhole (see *note WORMHOLE::).  This
+function returns an error triple (see *note ERROR-TRIPLES::) of the form
+(mv nil s state), where s is the status of the named wormhole.  The
+status is obtained by reading the oracle in the ACL2 state.
 
-To begin further discussion of guards, see *note GUARD-INTRODUCTION::.
-That section directs the reader to further sections for more details.
-To see just a summary of some commands related to guards, see *note
-GUARD-QUICK-REFERENCE::.  For a discussion of the use of proof to verify
-the absence of guard violations, see *note VERIFY-GUARDS::.
-
-
-File: acl2-doc-emacs.info,  Node: EXTRA-INFO,  Next: GUARD-DEBUG,  Prev: GUARD,  Up: GUARD
-
-EXTRA-INFO    generate markers to indicate sources of guard proof obligations
-
-See *note GUARD-DEBUG:: for a discussion of this function, which is
-useful for debugging failures during guard verification.
-
-
-File: acl2-doc-emacs.info,  Node: GUARD-DEBUG,  Next: GUARD-EVALUATION-EXAMPLES-LOG,  Prev: EXTRA-INFO,  Up: GUARD
-
-GUARD-DEBUG    generate markers to indicate sources of guard proof obligations
-
-ACL2 guard verification (see *note GUARD::) is often best avoided by
-beginning users of ACL2.  When guard verification is employed, it can
-generate numerous goals, some of which may not be theorems if the
-definition being processed has bugs.  It can be difficult to find such
-bugs.  This documentation topic explains a capability provided by ACL2
-to help find such bugs.
-
-We begin with the following example.  Although it is contrived and a bit
-simplistic, it illustrates how the guard-debug utility works.
-
-     (defun length-repeat (x)
-       (length (append x x)))
-     (verify-guards length-repeat :guard-debug t)
-
-The output produces two top-level key checkpoints, as follows.
-
-     Subgoal 2
-     (IMPLIES (EXTRA-INFO '(:GUARD (:BODY LENGTH-REPEAT))
-                          '(APPEND X X))
-              (TRUE-LISTP X))
-
-     Subgoal 1
-     (IMPLIES (AND (EXTRA-INFO '(:GUARD (:BODY LENGTH-REPEAT))
-                               '(LENGTH (APPEND X X)))
-                   (NOT (TRUE-LISTP (APPEND X X))))
-              (STRINGP (APPEND X X)))
-
-The upper subgoal (numbered 2) says that the body of the definition of
-length-repeat contains a call (APPEND X X), which is the source of the
-goal.  In this case, that makes sense: the guard for a call (append
-arg1 arg2) is (true-listp arg1), which in this case is (TRUE-LISTP X).
-The lower subgoal (numbered 1) says that the same definition contains
-the call (LENGTH (APPEND X X)), which generates the proof obligation
-that if (APPEND X X) does not satisfy true-listp, then it must satisfy
-stringp.  That proof obligation comes directly from the guard for
-length.
-
-Of course, the example above is a bit obvious.  But for large
-definitional bodies such information can be very helpful.  Note that
-guard-debug can be specified not only in verify-guards events but also
-in xargs declare forms of defun events.
-
-We now describe the guard-debug utility in some detail.
-
-(Extra-info x y) always returns t by definition.  However, if guard
-verification takes place with a non-nil setting of guard-debug (see
-below), then the goals generated for guard verification can include
-hypotheses that are calls of extra-info.  Typically, such a hypothesis
-is of the following form:
-
-     (extra-info '(:guard (:body F))
-                 '(G ARG1 ... ARGk))
-
-The above form indicates that the goal in which it occurs was generated
-to verify that the guard of the function F is satisfied by the
-arguments ARG1 through ARGk, where the term (G ARG1 ... ARGk) occurs in
-the body of the function F whose guard verification is in progress.  If
-however the above call of G occurs in the guard of F instead of the
-body of F, then :body is replaced by :guard above:
-
-     (extra-info '(:guard (:guard F))
-                 '(G ARG1 ... ARGk))
-
-If the same proof obligation (goal clause) arises from more than one
-occurrence of the same call, then a single goal will be generated,
-which has several extra-info hypotheses added to show the multiple
-sources of that proof obligation.
-
-All rules (see *note RUNE::) associated with extra-info are disabled by
-default, so that hypotheses of the form described above are not
-simplified to t.  These hypotheses are intended to ride along for free:
-you can generally expect the proof to have the same structure whether
-or not the :guard-debug option is supplied, though on rare occasions
-the proofs may diverge.
-
-It remains to explain the notion of a guard-debug setting of t, that
-is, to explain how to obtain the additional hypotheses described above.
-If guards are being verified during processing of a defun event (whether
-or not inside a call of mutual-recursion), then one specifies
-:guard-debug t in an xargs declaration of a declare form; see *note
-XARGS::.  If however the guard verification is on behalf of a
-verify-guards call, whether for a definition or a theorem, then one
-specifies the keyword argument :guard-debug t.
-
-Also see *note PRINT-GV:: for a utility for debugging guard violations,
-in contrast to the above guard-debug mechanism, which is for debugging
-failed proofs arising from guard verification.
+This function makes the status of a wormhole visible outside the
+wormhole.  But since this function takes state and modifies it, the
+function may only be used in contexts in which you may change state.
+Otherwise, the wormhole status may stay in the wormhole.  See
+wormhole-eval and wormhole.
 
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-6 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-6
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-6	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-6	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,6 +28,264 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: GOAL-SPEC,  Next: GUARD,  Prev: GET-WORMHOLE-STATUS,  Up: MISCELLANEOUS
+
+GOAL-SPEC    to indicate where a hint is to be used
+
+     Examples:
+     "Goal"
+     "goal"
+     "Subgoal *1/3''"
+     "subgoal *1/3''"
+     "[2]Subgoal *1/3''"
+
+When hints are given to the theorem prover, a goal-spec is provided to
+specify the goal to which the hints are to be applied.  The hints
+provided are carried along innocuously until the named goal arises.
+When it arises, the hints are "activated" for that goal and its
+descendents.
+
+A legal goal specification may be extracted from the theorem prover's
+output.  Certain lines clearly label formulas, as in
+
+     Subgoal *1/3.2'
+     (IMPLIES ... ...)
+
+and these lines all give rise to goal specifications.  In general,
+these lines all start either with "Goal" or "Subgoal" or else with
+those words preceded by a number in square brackets, as in
+
+     [1]Subgoal *1/3.2'
+     (IMPLIES ... ...).
+
+A goal specification may be obtained by deleting any surrounding
+whitespace from such a line and embedding the text in string quotation
+marks.  Thus
+
+     "[1]Subgoal *1/3.2'"
+
+is the goal specifier for the goal above.
+
+As noted, a hint is applied to a goal when the hint's goal
+specification matches the name ACL2 assigns to the goal.  The matching
+algorithm is case-insensitive.  Thus, alternative goal specifications
+for the goal above are "[1]subgoal *1/3.2'" and "[1]SUBGOAL *1/3.2'".
+The matching algorithm does not tolerate non-case discrepancies.  Thus,
+"[1]Subgoal*1/3.2'" and " [1]Subgoal *1/3.2'" are unacceptable.
+
+Sometimes a formula is given two names, e.g.,
+
+     Subgoal *1/14.2'
+     (IMPLIES ...
+              ...)
+     Name the formula above *1.1.
+
+It is the first name (the one that starts with "Goal" or "Subgoal") and
+not the second which constitutes a legal goal-spec.  Roughly speaking,
+when the system prints the line containing the goal specification, it
+activates any hints that are attached to that goal-spec.  Consider the
+example above.  Suppose Subgoal *1/14.2' could be proved by using a
+certain lemma instance.  Then the appropriate entry in the hints would
+be:
+
+     ("Subgoal *1/14.2'" :use ...)
+
+This might surprise you because the system appears to do nothing to
+*1/14.2' besides push it for a subsequent induction.  But actually
+between the time the system printed the goal-spec line and the time it
+decides to push the goal, you can think of the system as trying
+everything it has.  So a use hint activated when Subgoal *1/14.2'
+arises is just what you want.
+
+But what if you want to give an :induct hint?  By the time induction is
+tried, the formula has been given the name *1.1.  Well, this is one you
+just have to remember:
+
+     ("Subgoal *1/14.2'" :induct ...).
+
+When the above hint is activated the :induct directive short-circuits
+the rest of the processing and sends immediately the formula into the
+pool of goals to prove by induction.  The induct hint is attached to
+the formula in the pool and when the time comes to turn our attention
+to that goal, the induct advice is followed.
+
+We conclude by emphasizing a point made above, that a hint is applied
+to a goal when the hint's goal specification matches the name ACL2
+assigns to the goal.  If there is no such match, then the hint is
+ignored.  Consider the following example.
+
+     (thm (equal (append (append x y) z) (append x y z))
+          :hints (("Subgoal *1/" :in-theory nil)))
+
+Normally, :in-theory hints are inherited by subgoals (see *note
+HINTS-AND-THE-WATERFALL::), so you might expect that the empty theory is
+used in Subgoal *1/2 and Subgoal *1/1.  But in fact, since there is no
+subgoal printed that is labeled Subgoal *1/, the above :in-theory hint
+is ignored.  The above example is in contrast to the following, where
+the hint makes the proof fail, because there really is a Subgoal *1/ in
+the proof this time.
+
+     (thm (implies (and (not (endp x)) (not (endp (cdr x))))
+                   (equal (append (append x y) z) (append x y z)))
+          :hints (("Subgoal *1/" :in-theory nil)))
+
+
+File: acl2-doc-emacs.info,  Node: GUARD,  Next: GUARD-HINTS,  Prev: GOAL-SPEC,  Up: MISCELLANEOUS
+
+GUARD    restricting the domain of a function
+
+The ACL2 system provides a mechanism for restricting a function to a
+particular domain.  Such restrictions are called "guards."  A
+definition's guard has no effect on the logical axiom added when that
+definition is accepted by ACL2, and novices are often best served by
+avoiding guards.  However, guards can be useful as a specification
+device or for increasing execution efficiency.  To make such a
+restriction, use the :guard keyword (see *note XARGS::) or, especially
+if you want the host Lisp compiler to use this information, use type
+declarations (see *note DECLARE::; also see *note XARGS:: for a
+discussion of the split-types keyword).  The general issue of guards
+and guard verification is discussed in the topics listed below.
+
+* Menu:
+
+* EXTRA-INFO:: generate markers to indicate sources of guard proof obligations
+
+* GUARD-DEBUG:: generate markers to indicate sources of guard proof obligations
+
+* GUARD-EVALUATION-EXAMPLES-LOG:: log showing combinations of defun-modes and guard-checking
+
+* GUARD-EVALUATION-EXAMPLES-SCRIPT:: a script to show combinations of defun-modes and guard-checking
+
+* GUARD-EVALUATION-TABLE:: a table that shows combinations of defun-modes and guard-checking
+
+* GUARD-INTRODUCTION:: introduction to guards in ACL2
+
+* GUARD-MISCELLANY:: miscellaneous remarks about guards
+
+* GUARD-QUICK-REFERENCE:: brief summary of guard checking and guard verification
+
+* GUARDS-AND-EVALUATION:: the relationship between guards and evaluation
+
+* GUARDS-FOR-SPECIFICATION:: guards as a specification device
+
+
+Related topics other than immediate subtopics:
+* GUARD-EXAMPLE:: a brief transcript illustrating guards in ACL2
+
+* SET-GUARD-CHECKING:: control checking guards during execution of top-level forms
+
+* SET-VERIFY-GUARDS-EAGERNESS:: the eagerness with which guard verification is tried.
+
+* VERIFY-GUARDS:: verify the guards of a function
+
+To begin further discussion of guards, see *note GUARD-INTRODUCTION::.
+That section directs the reader to further sections for more details.
+To see just a summary of some commands related to guards, see *note
+GUARD-QUICK-REFERENCE::.  For a discussion of the use of proof to verify
+the absence of guard violations, see *note VERIFY-GUARDS::.
+
+
+File: acl2-doc-emacs.info,  Node: EXTRA-INFO,  Next: GUARD-DEBUG,  Prev: GUARD,  Up: GUARD
+
+EXTRA-INFO    generate markers to indicate sources of guard proof obligations
+
+See *note GUARD-DEBUG:: for a discussion of this function, which is
+useful for debugging failures during guard verification.
+
+
+File: acl2-doc-emacs.info,  Node: GUARD-DEBUG,  Next: GUARD-EVALUATION-EXAMPLES-LOG,  Prev: EXTRA-INFO,  Up: GUARD
+
+GUARD-DEBUG    generate markers to indicate sources of guard proof obligations
+
+ACL2 guard verification (see *note GUARD::) is often best avoided by
+beginning users of ACL2.  When guard verification is employed, it can
+generate numerous goals, some of which may not be theorems if the
+definition being processed has bugs.  It can be difficult to find such
+bugs.  This documentation topic explains a capability provided by ACL2
+to help find such bugs.
+
+We begin with the following example.  Although it is contrived and a bit
+simplistic, it illustrates how the guard-debug utility works.
+
+     (defun length-repeat (x)
+       (length (append x x)))
+     (verify-guards length-repeat :guard-debug t)
+
+The output produces two top-level key checkpoints, as follows.
+
+     Subgoal 2
+     (IMPLIES (EXTRA-INFO '(:GUARD (:BODY LENGTH-REPEAT))
+                          '(APPEND X X))
+              (TRUE-LISTP X))
+
+     Subgoal 1
+     (IMPLIES (AND (EXTRA-INFO '(:GUARD (:BODY LENGTH-REPEAT))
+                               '(LENGTH (APPEND X X)))
+                   (NOT (TRUE-LISTP (APPEND X X))))
+              (STRINGP (APPEND X X)))
+
+The upper subgoal (numbered 2) says that the body of the definition of
+length-repeat contains a call (APPEND X X), which is the source of the
+goal.  In this case, that makes sense: the guard for a call (append
+arg1 arg2) is (true-listp arg1), which in this case is (TRUE-LISTP X).
+The lower subgoal (numbered 1) says that the same definition contains
+the call (LENGTH (APPEND X X)), which generates the proof obligation
+that if (APPEND X X) does not satisfy true-listp, then it must satisfy
+stringp.  That proof obligation comes directly from the guard for
+length.
+
+Of course, the example above is a bit obvious.  But for large
+definitional bodies such information can be very helpful.  Note that
+guard-debug can be specified not only in verify-guards events but also
+in xargs declare forms of defun events.
+
+We now describe the guard-debug utility in some detail.
+
+(Extra-info x y) always returns t by definition.  However, if guard
+verification takes place with a non-nil setting of guard-debug (see
+below), then the goals generated for guard verification can include
+hypotheses that are calls of extra-info.  Typically, such a hypothesis
+is of the following form:
+
+     (extra-info '(:guard (:body F))
+                 '(G ARG1 ... ARGk))
+
+The above form indicates that the goal in which it occurs was generated
+to verify that the guard of the function F is satisfied by the
+arguments ARG1 through ARGk, where the term (G ARG1 ... ARGk) occurs in
+the body of the function F whose guard verification is in progress.  If
+however the above call of G occurs in the guard of F instead of the
+body of F, then :body is replaced by :guard above:
+
+     (extra-info '(:guard (:guard F))
+                 '(G ARG1 ... ARGk))
+
+If the same proof obligation (goal clause) arises from more than one
+occurrence of the same call, then a single goal will be generated,
+which has several extra-info hypotheses added to show the multiple
+sources of that proof obligation.
+
+All rules (see *note RUNE::) associated with extra-info are disabled by
+default, so that hypotheses of the form described above are not
+simplified to t.  These hypotheses are intended to ride along for free:
+you can generally expect the proof to have the same structure whether
+or not the :guard-debug option is supplied, though on rare occasions
+the proofs may diverge.
+
+It remains to explain the notion of a guard-debug setting of t, that
+is, to explain how to obtain the additional hypotheses described above.
+If guards are being verified during processing of a defun event (whether
+or not inside a call of mutual-recursion), then one specifies
+:guard-debug t in an xargs declaration of a declare form; see *note
+XARGS::.  If however the guard verification is on behalf of a
+verify-guards call, whether for a definition or a theorem, then one
+specifies the keyword argument :guard-debug t.
+
+Also see *note PRINT-GV:: for a utility for debugging guard violations,
+in contrast to the above guard-debug mechanism, which is for debugging
+failed proofs arising from guard verification.
+
+
 File: acl2-doc-emacs.info,  Node: GUARD-EVALUATION-EXAMPLES-LOG,  Next: GUARD-EVALUATION-EXAMPLES-SCRIPT,  Prev: GUARD-DEBUG,  Up: GUARD
 
 GUARD-EVALUATION-EXAMPLES-LOG    log showing combinations of defun-modes and guard-checking
@@ -2707,12 +2965,119 @@
 need not be machine readable.
 
 
-File: acl2-doc-emacs.info,  Node: IF-INTRO,  Next: IMMED-FORCED,  Prev: I-AM-HERE,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: IF-INTRO,  Next: IGNORED-ATTACHMENT,  Prev: I-AM-HERE,  Up: MISCELLANEOUS
 
 IF-INTRO    See *note SPLITTER::.
 
 
-File: acl2-doc-emacs.info,  Node: IMMED-FORCED,  Next: IMMEDIATE-FORCE-MODEP,  Prev: IF-INTRO,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: IGNORED-ATTACHMENT,  Next: IMMED-FORCED,  Prev: IF-INTRO,  Up: MISCELLANEOUS
+
+IGNORED-ATTACHMENT    why attachments are sometimes not used
+
+Attachments provide a way to execute constrained functions.  But in some
+cases, ACL2 will not permit such execution.  We discuss this issue
+briefly here.  For more information about attachments, see *note
+DEFATTACH::.
+
+We illustrate this issue with the following example, discussed below.
+
+       (encapsulate
+        ()
+        (defstub foo () t)
+        (defn foo-impl-1 () t)
+        (defattach foo foo-impl-1)
+        (defn foo-impl-2 () nil)
+        (local (defattach foo foo-impl-2))
+        (defmacro mac () (foo)) ; nil in the first pass, t in the second pass
+        (defun bar () (mac))    ; nil in the first pass, t in the second pass
+        (defthm bar-is-nil
+          (equal (bar) nil))
+        )
+
+Here, a non-executable function foo is introduced with no constraints,
+and is provided two contradictory implementations, foo-impl-1 and
+foo-impl-2.  A function, bar, is defined using a macro, mac, whose
+expansion depends on which of foo-impl-1 or foo-impl-2 is attached to
+foo.  If ACL2 were to allow this, then as indicated by the comments
+above, (bar) would be defined to be nil on the first pass of the
+encapsulate form, where foo is attached to foo-impl-2; but (bar) would
+be defined to be t on the second pass, where foo is attached to
+foo-impl-1 because the second defattach call is local.  Thus, after
+execution of the encapsulate form, (bar) would be provably equal to t
+even though there would be a theorem, bar-is-nil -- proved during the
+first pass of the encapsulate -- saying that (bar) is nil!
+
+Fortunately, ACL2 does not permit this to happen.  The example above
+produces the following output.
+
+       ACL2 !>>(DEFUN BAR NIL (MAC))
+
+
+       ACL2 Error in ( DEFUN BAR ...):  In the attempt to macroexpand the
+       form (MAC), evaluation of the macro body caused the following error:
+
+       ACL2 cannot ev the call of undefined function FOO on argument list:
+
+       NIL
+
+       Note that because of logical considerations, attachments (including
+       FOO-IMPL-2) must not be called in this context.
+
+We see, then, the importance of disallowing evaluation using attachments
+during macroexpansion.  ACL2 is careful to avoid attachments in
+situations, like this one, where using attachments could be unsound.
+
+We conclude with an example illustrating how make-event can be used to
+work around the refusal of ACL2 to use attachments during
+macroexpansion.  The idea is that make-event expansions are stored, and
+this avoids the issue of local attachments.  In particular, for the
+example below, the second defattach affects the body of f2 even though
+that defattach is local, because the expansion of the corresponding
+make-event is saved during the first pass of certify-book, when full
+admissibility checks are done.  Then even after including the book, the
+definition of f2 will be based on the second (local) defattach form
+below.
+
+     (in-package "ACL2")
+
+     (defun body-1 (name formals body)
+       (declare (ignore name))
+       `(if (consp ,(car formals))
+            ,body
+          nil))
+
+     (defun body-2 (name formals body)
+       (declare (ignore name))
+       `(if (acl2-numberp ,(car formals))
+            ,body
+          t))
+
+     (defmacro defun+ (name formals body)
+       `(make-event
+         (if (foo) ; attachable stub
+             '(defun ,name ,formals ,(body-1 name formals body))
+           '(defun ,name ,formals ,(body-2 name formals body)))))
+
+     ;;; (defun+ f1 (x y) (cons x y)) ; fails because foo has no attachment
+
+     (defstub foo () t)
+     (defn foo-true () t)
+     (defn foo-false () nil)
+
+     (defattach foo foo-true)
+
+     (defun+ f1 (x y) (cons x y))
+
+     (local (defattach foo foo-false))
+
+     (defun+ f2 (x y) (cons x y))
+
+     (assert-event (equal (f1 3 t) nil))
+
+     (assert-event (equal (f2 3 t) (cons 3 t)))
+
+
+File: acl2-doc-emacs.info,  Node: IMMED-FORCED,  Next: IMMEDIATE-FORCE-MODEP,  Prev: IGNORED-ATTACHMENT,  Up: MISCELLANEOUS
 
 IMMED-FORCED    See *note SPLITTER::.
 
@@ -2814,12 +3179,62 @@
 query returned immediately and the set-iprint call was completed.
 
 
-File: acl2-doc-emacs.info,  Node: LAMBDA,  Next: LD-ERROR-ACTION,  Prev: KEYWORD-COMMANDS,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: LAMBDA,  Next: LAST-PROVER-STEPS,  Prev: KEYWORD-COMMANDS,  Up: MISCELLANEOUS
 
 LAMBDA    See *note TERM::.
 
 
-File: acl2-doc-emacs.info,  Node: LD-ERROR-ACTION,  Next: LD-ERROR-TRIPLES,  Prev: LAMBDA,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: LAST-PROVER-STEPS,  Next: LD-ERROR-ACTION,  Prev: LAMBDA,  Up: MISCELLANEOUS
+
+LAST-PROVER-STEPS    the number of prover steps most recently taken
+
+For discussions of prover step limits, See *note
+SET-PROVER-STEP-LIMIT:: and see *note WITH-PROVER-STEP-LIMIT::.  The
+value of the form (last-prover-steps state) indicates the number of
+prover steps taken, in the sense described below, for the most recent
+context in which an event summary would normally be printed.  Note that
+the value of (last-prover-steps state) is updated for all events, and
+for all other forms such as calls of thm or certify-book, that would
+print a summary -- regardless of whether or not such output is inhibited
+(see *note SET-INHIBIT-OUTPUT-LST:: and see *note
+SET-INHIBITED-SUMMARY-TYPES::).  In particular, the value is updated
+(typically to nil) for table events, even when no summary is printed;
+for example, the value is updated to nil for table events such as
+(logic), (program), and even calls of set-prover-step-limit.
+
+The value of (last-prover-steps state) is determined as follows, based
+on the most recent summary context (as described above):
+
+     nil, if no prover steps were taken; else,
+
+     the (positive) number of steps taken, if the number of steps did
+     not exceed the starting limit; else,
+
+     the negative of the starting limit.
+
+
+We conclude with a remark for advanced users who wish to invoke
+last-prover-steps in the development of utilities that track prover
+steps.  Suppose that you want to write a utility that takes some action
+based on the number of prover steps performed by the first defun event
+that is generated, among others, for example the number of prover steps
+taken to admit f1 in the following example.
+
+     (progn (defun f1 ...)
+            (defun f2 ...))
+
+A solution is to record the steps taken by the first defun before
+executing subsequent events, as follows (see *note MAKE-EVENT::).
+
+     (progn (defun f1 ...)
+            (make-event (pprogn (f-put-global 'my-step-count
+                                              (last-prover-steps state)
+                                              state)
+                                (value '(value-triple nil))))
+            (defun f2 ...))
+
+
+File: acl2-doc-emacs.info,  Node: LD-ERROR-ACTION,  Next: LD-ERROR-TRIPLES,  Prev: LAST-PROVER-STEPS,  Up: MISCELLANEOUS
 
 LD-ERROR-ACTION    determines ld's response to an error
 
@@ -2947,7 +3362,7 @@
 ld-error-action.
 
 
-File: acl2-doc-emacs.info,  Node: LD-EVISC-TUPLE,  Next: LD-KEYWORD-ALIASES,  Prev: LD-ERROR-TRIPLES,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: LD-EVISC-TUPLE,  Next: LD-MISSING-INPUT-OK,  Prev: LD-ERROR-TRIPLES,  Up: MISCELLANEOUS
 
 LD-EVISC-TUPLE    determines whether ld suppresses details when printing
 
@@ -2968,53 +3383,7 @@
 as well as other output not from ld.
 
 
-File: acl2-doc-emacs.info,  Node: LD-KEYWORD-ALIASES,  Next: LD-MISSING-INPUT-OK,  Prev: LD-EVISC-TUPLE,  Up: MISCELLANEOUS
-
-LD-KEYWORD-ALIASES    allows the abbreviation of some keyword commands
-
-     Example:
-     (set-ld-keyword-aliases '((:q 0 q-fn)
-                               (:e 0 exit-acl2-macro))
-                             state)
-
-Ld-keyword-aliases is an ld special (see *note LD::).  The accessor is
-(ld-keyword-aliases state) and the updater is (set-ld-keyword-aliases
-val state).  Ld-keyword-aliases must be an alist, each element of which
-is of the form (:keyword n fn), where :keyword is a keyword, n is a
-nonnegative integer, and fn is a function symbol of arity n, a macro
-symbol, or a lambda expression of arity n.  When keyword is typed as an
-ld command, n more forms are read, x1, ..., xn, and the form (fn 'x1
-... 'xn) is then evaluated.  The initial value of ld-keyword-aliases is
-nil.
-
-In the example above, :q has been redefined to have the effect of
-executing (q-fn), so for example if you define
-
-     (defmacro q-fn ()
-       '(er soft 'q "You un-bound :q and now we have a soft error."))
-
-then :q will cause an error, and if you define
-
-     (defmacro exit-acl2-macro () '(exit-ld state))
-
-then :e will cause the effect (it so happens) that :q normally has.  If
-you prefer :e to :q for exiting the ACL2 loop, you might even want to
-put such definitions of q-fn and exit-acl2-macro together with the
-set-ld-keyword-aliases form above in your "acl2-customization.lsp"
-file; see *note ACL2-CUSTOMIZATION::.
-
-The general-purpose ACL2 read-eval-print loop, ld, reads forms from
-standard-oi, evaluates them and prints the result to standard-co.
-However, there are various flags that control ld's behavior and
-ld-keyword-aliases is one of them.  Ld-keyword-aliases affects how
-keyword commands are parsed.  Generally speaking, ld's command
-interpreter reads ":fn x1 ... xn" as "(fn 'x1 ... 'xn)" when :fn is a
-keyword and fn is the name of an n-ary function; see *note
-KEYWORD-COMMANDS::.  But this parse is overridden, as described above,
-for the keywords bound in ld-keyword-aliases.
-
-
-File: acl2-doc-emacs.info,  Node: LD-MISSING-INPUT-OK,  Next: LD-POST-EVAL-PRINT,  Prev: LD-KEYWORD-ALIASES,  Up: MISCELLANEOUS
+File: acl2-doc-emacs.info,  Node: LD-MISSING-INPUT-OK,  Next: LD-POST-EVAL-PRINT,  Prev: LD-EVISC-TUPLE,  Up: MISCELLANEOUS
 
 LD-MISSING-INPUT-OK    determines which forms ld evaluates
 
@@ -5720,7 +6089,7 @@
 logical world yet not be considered to be redundant.  Here is an
 example of such a form.
 
-     (value-triple (cw "Hello world.~%"))
+       (value-triple (cw "Hello world.~%"))
 
 When are two logical-name definitions considered "the same"?  It
 depends upon the kind of name being defined.  We consider these below in
@@ -5784,8 +6153,9 @@
 DEFUN-NX::), then the two events must be identical.
 (2) It is permissible for one definition to have a :guard of t and the
 other to have no explicit guard (hence, the guard is implicitly t).
-(3) The :measure check is avoided if we are skipping proofs (for
-example, during include-book), and otherwise, the new definition may
+(3) The :measure check is avoided if the old definition is non-recursive
+(and not defined within a mutual-recursion) or we are skipping proofs
+(for example, during include-book).  Otherwise, the new definition may
 have a :measure of (:? v1 ... vk), where (v1 ... vk) enumerates the
 variables occurring in the measure stored for the old definition.
 (4) If either the old or new event is a mutual-recursion event, then
@@ -5797,7 +6167,7 @@
 default-defun-mode, default-ruler-extenders, and
 default-verify-guards-eagerness.  The full criterion for redundancy of
 encapsulate events is more complex, for example ignoring contents of
-local events; see *note ENCAPSULATE::.
+local events; see *note REDUNDANT-ENCAPSULATE::.
 
 An in-theory event is never redundant.  Note that it doesn't define any
 name.
@@ -5883,8 +6253,8 @@
 contain the names generated by the book.  But suppose you compute the
 theory as the very last event in the book using:
 
-     (set-difference-theories (universal-theory :here)
-                              (universal-theory fn))
+       (set-difference-theories (universal-theory :here)
+                                (universal-theory fn))
 
 where fn is the very first event in the book and happens to be a defun
 event.  This expression returns the advertised set if fn is not already
@@ -5903,13 +6273,13 @@
 in the definition.  The following example shows how an attempt to
 redefine a function can fail to make any change.
 
-     (set-ld-redefinition-action '(:warn . :overwrite) state)
-     (defmacro mac (x) x)
-     (defun foo (x) (mac x))
-     (defmacro mac (x) (list 'car x))
-     (set-ld-redefinition-action nil state)
-     (defun foo (x) (mac x)) ; redundant, unfortunately; foo does not change
-     (thm (equal (foo 3) 3)) ; succeeds, showing that redef of foo didn't happen
+       (set-ld-redefinition-action '(:warn . :overwrite) state)
+       (defmacro mac (x) x)
+       (defun foo (x) (mac x))
+       (defmacro mac (x) (list 'car x))
+       (set-ld-redefinition-action nil state)
+       (defun foo (x) (mac x)) ; redundant, unfortunately; foo does not change
+       (thm (equal (foo 3) 3)) ; succeeds, showing that redef of foo didn't happen
 
 The call of macro mac was expanded away before storing the first
 definition of foo for the theorem prover.  Therefore, the new definition
@@ -5923,12 +6293,12 @@
 redefinition is active.  If in the example above we remove the form
 (set-ld-redefinition-action nil state), then the problem goes away:
 
-     (set-ld-redefinition-action '(:warn . :overwrite) state)
-     (defmacro mac (x) x)
-     (defun foo (x) (mac x))
-     (defmacro mac (x) (list 'car x))
-     (defun foo (x) (mac x)) ; no longer redundant
-     (thm (equal (foo 3) 3)) ; fails, as we would like
+       (set-ld-redefinition-action '(:warn . :overwrite) state)
+       (defmacro mac (x) x)
+       (defun foo (x) (mac x))
+       (defmacro mac (x) (list 'car x))
+       (defun foo (x) (mac x)) ; no longer redundant
+       (thm (equal (foo 3) 3)) ; fails, as we would like
 
 To summarize: If a defun form is submitted that meets the usual
 redundancy criteria, then it may be considered redundant even if a macro
@@ -5946,13 +6316,13 @@
 Here is more complex example illustrating the limits of redefinition,
 based on one supplied by Grant Passmore.
 
-     (defun n3 () 0)
-     (defun n4 () 1)
-     (defun n5 () (> (n3) (n4))) ; body is normalized to nil
-     (thm (equal (n5) nil)) ; succeeds, trivially
-     (set-ld-redefinition-action '(:warn . :overwrite) state)
-     (defun n3 () 2)
-     (thm (equal (n5) nil)) ; still succeeds, sadly
+       (defun n3 () 0)
+       (defun n4 () 1)
+       (defun n5 () (> (n3) (n4))) ; body is normalized to nil
+       (thm (equal (n5) nil)) ; succeeds, trivially
+       (set-ld-redefinition-action '(:warn . :overwrite) state)
+       (defun n3 () 2)
+       (thm (equal (n5) nil)) ; still succeeds, sadly
 
 We may expect the final thm call to fail because of the following
 reasoning: (n5) = (> (n3) (n4)) = (> 2 1) = t.  Unfortunatly, the body
@@ -5972,13 +6342,15 @@
 
 A related phenomenon can occur for encapsulate.  As explained above, an
 encapsulate event is redundant if it is identical to one already in the
-database.  Consider then the following contrived example.
-
-     (defmacro mac (x) x)
-     (encapsulate () (defun foo (x) (mac x)))
-     (set-ld-redefinition-action '(:warn . :overwrite) state)
-     (defmacro mac (x) (list 'car x))
-     (encapsulate () (defun foo (x) (mac x)))
+database.  (But a weaker condition applies in general; see *note
+REDUNDANT-ENCAPSULATE::.)  Consider then the following contrived
+example.
+
+       (defmacro mac (x) x)
+       (encapsulate () (defun foo (x) (mac x)))
+       (set-ld-redefinition-action '(:warn . :overwrite) state)
+       (defmacro mac (x) (list 'car x))
+       (encapsulate () (defun foo (x) (mac x)))
 
 The last encapsulate event is redundant because it meets the criterion
 for redundancy: it is identical to the earlier encapsulate event.  Even
@@ -5990,9 +6362,9 @@
 A workaround can be to add something trivial to the encapsulate, for
 example:
 
-     (encapsulate ()
-       (deflabel try2) ; ``Increment'' to try3 next time, and so on.
-       (defun foo (x) x))
+       (encapsulate ()
+         (deflabel try2) ; ``Increment'' to try3 next time, and so on.
+         (defun foo (x) x))
 
 
 File: acl2-doc-emacs.info,  Node: REORDER,  Next: RESTRICT,  Prev: REDUNDANT-EVENTS,  Up: MISCELLANEOUS
@@ -6043,15 +6415,7 @@
 
 File: acl2-doc-emacs.info,  Node: SAVING-AND-RESTORING,  Next: SET-WORMHOLE-DATA,  Prev: REWRITE-STACK-LIMIT,  Up: MISCELLANEOUS
 
-SAVING-AND-RESTORING    saving and restoring your logical state
-
-One normally works on an ACL2-based project by developing books, which
-can then be included when continuing on that project in later ACL2
-sessions; see *note INCLUDE-BOOK::.  However, this approach can be
-time-consuming when there are very large collections of books to be
-included.  See see *note SAVE-EXEC:: for the description of a utility
-that saves your ACL2 state so that you can immediately re-start later
-in that same state.
+SAVING-AND-RESTORING    See *note SAVE-EXEC::.
 
 
 File: acl2-doc-emacs.info,  Node: SET-WORMHOLE-DATA,  Next: SET-WORMHOLE-ENTRY-CODE,  Prev: SAVING-AND-RESTORING,  Up: MISCELLANEOUS
@@ -6388,359 +6752,3 @@
 for the subgoal in question, you may allow the simplifier to make
 progress on the subgoal.
 
-
-File: acl2-doc-emacs.info,  Node: SPLITTER,  Next: SPLITTER-OUTPUT,  Prev: SPECIOUS-SIMPLIFICATION,  Up: MISCELLANEOUS
-
-SPLITTER    reporting of rules whose application may have caused case splits
-
-The application of a rule to a term may cause a goal to simplify to
-more than one subgoal.  A rule with such an application is called a
-"splitter".  Here, we explain the output produced for splitters when
-proof output is enabled (see *note SET-INHIBIT-OUTPUT-LST::) and such
-reporting is turned on (as it is by default) -- that is, when the value
-of (splitter-output) is true.
-
-See *note SET-SPLITTER-OUTPUT:: for how to turn off, or on, the
-reporting of splitters.  Also see *note SET-CASE-SPLIT-LIMITATIONS::
-for information on how to control case splits.
-
-We begin by describing three types of splitters.
-
-     if-intro: The rule application may have introduced a call of IF, in
-     the sense discussed at the end below.
-
-     case-split: For the application of a rule with hypothesis of the
-     form (case-split <hyp>), <hyp> did not simplify to true or false.
-
-     immed-forced: For the application of a rule with hypothesis of the
-     form (force <hyp>), <hyp> did not simplify to true or false, where
-     immediate-force-modep is enabled (see *note
-     IMMEDIATE-FORCE-MODEP::).
-
-These three annotations -- if-intro, case-split, and immed-forced --
-may be used in proof output and summaries for describing rule
-applications, as discussed below.  A fourth annotation, forced, maybe
-also be used in proof output to indicate the application of a rule with
-hypothesis of the form (force <hyp>) when <hyp> did not simplify to
-true or false, where immediate-force-modep is disabled (see *note
-IMMEDIATE-FORCE-MODEP::).  We don't consider such uses of force to be
-splitters, because they do not cause case splits (though they do produce
-goals to prove after lower-case "q.e.d." is printed); see *note FORCE::.
-
-There are three kinds of output affected by splitters, illustrated in
-turn below using examples.
-
-     (a) During the proof, gag-mode off
-     (b) During the proof, gag-mode on
-     (c) Summary
-
-
-Of course, (a) and (b) are skipped if proof output is inhibited, which
-(c) is skipped if summary output is inhibited; see *note
-SET-INHIBIT-OUTPUT-LST::.
-
-(a) During the proof, gag-mode off
-
-With gag-mode off (or when using :pso, :psof, or :psog) one normally
-gets an English commentary.  The following output indicates that at
-least one application of each rule F and G is of type if-intro, at
-least one application of rules G and R1 are of type case-split, and at
-least one application of rule R3 is of type immed-forced.  If
-immediate-force-modep is off then "immed-forced" would be replaced by
-"forced".
-
-       This simplifies, using the :definitions F (if-intro), G (case-split and
-       if-intro) and H and the :rewrite rules R1, R2 (case-split), and
-       R3 (immed-forced), to the following two conjectures.
-
-Note that any such printing of "forced" is done even if
-(splitter-output) is false.  Such forcing indication is also made when
-raw proof format is used -- see *note SET-RAW-PROOF-FORMAT:: -- but in
-that case, no indication is made for splitters in the proof output.
-
-(b) During the proof, gag-mode on
-
-With gag-mode on the proof output is greatly abbreviated.  However,
-"Splitter Notes" are printed so that even with gag-mode on, one can get
-important information to help control large case splits, by disabling
-splitter rules as appropriate.  These are printed at the point when a
-goal splits into subgoals.  Here, for example, is the Splitter Note that
-corresponds to the output shown in (a) above.  It shows the goal whose
-simplification has produced a split into more than one subgoal, and it
-shows how many subgoals have been created.
-
-     Splitter note (see :DOC splitter) for Subgoal *1/2.2.1' (2 subgoals).
-       case-split: ((:DEFINITION G) (:REWRITE R2))
-       immed-forced: ((:REWRITE R3))
-       if-intro: ((:DEFINITION G) (:DEFINITION F))
-
-No such splitter notes are printed for the use of force (when
-immediate-force-modep is off).
-
-(c) Summary
-
-Here is a possible summary corresponding to our running example.  In the
-summary, "Splitter rules" is omitted if there are no splitter rules,
-and a splitter type is only mentioned if there is at least one
-corresponding splitter rule.
-
-     Summary
-     Form:  ( THM ...)
-     Rules: ((:DEFINITION F)
-             (:DEFINITION G)
-             (:DEFINITION H)
-             (:REWRITE R1)
-             (:REWRITE R2)
-             (:REWRITE R3))
-     Splitter rules (see :DOC splitter):
-       case-split: ((:DEFINITION G) (:REWRITE R2))
-       immed-forced: ((:REWRITE R3))
-       if-intro: ((:DEFINITION G) (:DEFINITION F))
-     Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.00)
-     Prover steps counted:  145
-
-No indication for "forced" is given for "Splitter rules".  (As
-discussed earlier above, the forced hypotheses are not considered
-relevant for determining splitter rule applications unless
-immediate-force-modep is on.)
-
-We conclude by giving the criteria for a rewrite or definition rule
-application to be a splitter of type if-intro.
-
-     o Reporting of splitter rules is on, i.e., the value of
-     (splitter-output) is true.
-
-     o At least two subgoals are created, even before considering
-     subgoals generated by hypotheses that are calls of case-split or
-     force.
-
-     o The term to which the rule is applied is at the top level,
-     rather than being encountered when trying to establish the
-     hypothesis of a rule.
-
-     o The rule is a rewrite rule, a definition rule, or a meta rule.
-
-     o There is a call of the function symbol IF in the right-hand side
-     of the rewrite rule; or, in the case of a definition rule, in the
-     body of the definition; or, in the case of a meta rule, in the
-     result of applying the metafunction.
-
-     o There is a call of the function symbol IF in the result of
-     rewriting: the right-hand side (for a rewrite rule), the
-     definition body (for a definition rule), or the metafunction
-     application (for a meta rule).
-
-
-Any rule application meeting the above criteria will be considered a
-splitter of type if-intro, even if the call does not actually cause a
-case split.  For example, if you are proving (implies (hyp x) (conc x))
-and rule R rewrites (hyp x) to (if (h1 x) (h2 x) nil), which is really
-the term (and (h1 x) (h2 x)), then R may be labelled as a splitter
-rule.  If you want to find the causes of case-splitting, the list of
-if-intro splitters can help you narrow your search, but may include
-irrelevant rules as well.
-
-Finally, note that you may see splits not attributed to splitters.  We
-believe that this will be uncommon during simplification, though it can
-occur for example when a call of IF is in the body of a LET expression,
-i.e., in a call of a LAMBDA expression.  But splits caused by other
-processes, notably destructor elimination (see *note ELIM::), will
-typically not be attributed to splitters.
-
-
-File: acl2-doc-emacs.info,  Node: SPLITTER-OUTPUT,  Next: STOBJS,  Prev: SPLITTER,  Up: MISCELLANEOUS
-
-SPLITTER-OUTPUT    status for reporting of splitter rules
-
-See *note SPLITTER:: for a discussion of splitter rules.  See *note
-SET-SPLITTER-OUTPUT:: for how to turn off, or on, the reporting of
-splitter rules.  When splitter-output is off, because either prove
-output is inhibited (see *note SET-INHIBIT-OUTPUT-LST::) or
-(set-splitter-output nil) has been invoked, then the value of
-(splitter-output) is nil.  Otherwise, such reporting is on and the
-value is non-nil.
-
-
-File: acl2-doc-emacs.info,  Node: STOBJS,  Next: SUBVERSIVE-INDUCTIONS,  Prev: SPLITTER-OUTPUT,  Up: MISCELLANEOUS
-
-STOBJS    xargs keyword :STOBJS
-
-See *note XARGS::.
-
-
-File: acl2-doc-emacs.info,  Node: SUBVERSIVE-INDUCTIONS,  Next: SUBVERSIVE-RECURSIONS,  Prev: STOBJS,  Up: MISCELLANEOUS
-
-SUBVERSIVE-INDUCTIONS    why we restrict encapsulated recursive functions
-
-See *note SUBVERSIVE-RECURSIONS::.
-
-
-File: acl2-doc-emacs.info,  Node: SUBVERSIVE-RECURSIONS,  Next: SYNTAX,  Prev: SUBVERSIVE-INDUCTIONS,  Up: MISCELLANEOUS
-
-SUBVERSIVE-RECURSIONS    why we restrict encapsulated recursive functions
-
-Subtleties arise when one of the "constrained" functions, f, introduced
-in the signature of an encapsulate event, is involved in the
-termination argument for a non-local recursively defined function, g, in
-that encapsulate.  During the processing of the encapsulated events, f
-is locally defined to be some witness function, f'.  Properties of f'
-are explicitly proved and exported from the encapsulate as the
-constraints on the undefined function f.  But if f is used in a
-recursive g defined within the encapsulate, then the termination proof
-for g may use properties of f' -- the witness -- that are not
-explicitly set forth in the constraints stated for f.
-
-Such recursive g are said be "subversive" because if naively treated
-they give rise to unsound induction schemes or (via functional
-instantiation) recurrence equations that are impossible to satisfy.  We
-illustrate what could go wrong below.
-
-Subversive recursions are not banned outright.  Instead, they are
-treated as part of the constraint.  That is, in the case above, the
-definitional equation for g becomes one of the constraints on f.  This
-is generally a severe restriction on future functional instantiations
-of f.  In addition, ACL2 removes from its knowledge of g any
-suggestions about legal inductions to "unwind" its recursion.
-
-What should you do?  Often, the simplest response is to move the
-offending recursive definition, e.g., g, out of the encapsulate.  That
-is, introduce f by constraint and then define g as an "independent"
-event.  You may need to constrain "additional" properties of f in order
-to admit g, e.g., constrain it to reduce some ordinal measure.  However,
-by separating the introduction of f from the admission of g you will
-clearly identify the necessary constraints on f, functional
-instantiations of f will be simpler, and g will be a useful function
-which suggests inductions to the theorem prover.
-
-Note that the functions introduced in the signature should not even
-occur ancestrally in the termination proofs for non-local recursive
-functions in the encapsulate.  That is, the constrained functions of an
-encapsulate should not be reachable in the dependency graph of the
-functions used in the termination arguments of recursive functions in
-encapsulate.  If they are reachable, their definitions become part of
-the constraints.
-
-The following event illustrates the problem posed by subversive
-recursions.
-
-     (encapsulate (((f *) => *))
-       (local (defun f (x) (cdr x)))
-       (defun g (x)
-         (if (consp x) (not (g (f x))) t)))
-
-Suppose, contrary to how ACL2 works, that the encapsulate above were to
-introduce no constraints on f on the bogus grounds that the only use of
-f in the encapsulate is in an admissible function.  We discuss the
-plausibility of this bogus argument in a moment.
-
-Then it would be possible to prove the theorem:
-
-     (defthm f-not-identity
-       (not (equal (f '(a . b)) '(a . b)))
-       :rule-classes nil
-       :hints (("Goal" :use (:instance g (x '(a . b))))))
-
-simply by observing that if (f '(a . b)) were '(a . b), then (g '(a .
-b)) would be (not (g '(a . b))), which is impossible.
-
-But then we could functionally instantiate f-not-identity, replacing f
-by the identity function, to prove nil!  This is bad.
-
-     (defthm bad
-       nil
-       :rule-classes nil
-       :hints
-       (("Goal" :use (:functional-instance f-not-identity (f identity)))))
-
-This sequence of events was legal in versions of ACL2 prior to Version
-1.5.  When we realized the problem we took steps to make it illegal.
-However, our steps were insufficient and it was possible to sneak in a
-subversive function (via mutual recursion) as late as Version 2.3.
-
-We now turn to the plausibility of the bogus argument above.  Why might
-one even be tempted to think that the definition of g above poses no
-constraint on f?  Here is a very similar encapsulate.
-
-     (encapsulate (((f *) => *))
-       (local (defun f (x) (cdr x)))
-       (defun map (x)
-         (if (consp x)
-             (cons (f x) (map (cdr x)))
-           nil)))
-
-Here map plays the role of g above.  Like g, map calls the constrained
-function f.  But map truly does not constrain f.  In particular, the
-definition of map could be moved "out" of the encapsulate so that map
-is introduced afterwards.  The difference between map and g is that the
-constrained function plays no role in the termination argument for the
-one but does for the other.
-
-As a "user-friendly" gesture, ACL2 implicitly moves map-like functions
-out of encapsulations; logically speaking, they are introduced after the
-encapsulation.  This simplifies the constraint.  When the constraint
-cannot be thus simplfied the user is advised, via the "infected"
-warning, to phrase the encapsulation in the simplest way possible.
-
-The lingering bug between Versions 1.5 and 2.3 mentioned above was due
-to our failure to detect the g-like nature of some functions when they
-were defined in mutually recursively cliques with other functions.  The
-singly recursive case was recognized.  The bug arose because our
-detection "algorithm" was based on the "suggested inductions" left
-behind by successful definitions.  We failed to recall that
-mutually-recursive definitions do not, as of this writing, make any
-suggestions about inductions and so did not leave any traces of their
-subversive natures.
-
-We conclude by elaborating on the criterion "involved in the termination
-argument" mentioned at the outset.  Suppose that function f is
-recursively defined in an encapsulate, where the body of f has no
-"ancestor" among the functions introduced in the signature of that
-encapsulate, i.e.: the body contains no call of a signature function,
-no call of a function whose body calls a signature function, and so on.
-Then ACL2 treats f as though it is defined in front of that encapsulate
-form; so f is not constrained by the encapsulate, and its definition is
-hence certainly not subversive in the sense discussed above.  But
-suppose to the contrary that some function introduced in the signature
-is an ancestor of the body of f.  Then the definition of f is
-subversive if moreover, its termination proof obligation has an
-ancestor among the signature functions.  Now, that proof obligation
-involves terms from the first argument of selected calls of IF, as well
-as recursive calls; for a detailed discussion, see *note
-RULER-EXTENDERS::.  The important point here is that for the recursive
-calls, only the arguments in "measured" positions are relevant to the
-termination proof obligation.  Consider the following example.
-
-       (encapsulate
-        (((h *) => *))
-        (local (defun h (n) n))
-        (defun f (i n)
-          (if (zp i)
-              n
-            (f (1- i) (h n)))))
-
-ACL2 heuristically picks the measure (acl2-count i) for the definition
-of f; thus, i is the only "measured formal" of f.  Since i is the first
-formal of f, then for the recursive call of f, only the first argument
-contributes to the termination proof obligation: in this case, (1- i)
-but not (h n).  Thus, even though h is a signature function, the
-definition of f is not considered to be subversive; an induction scheme
-is thus stored for f.  (This restriction to measured formal positions
-of recursive calls, for determining subversive definitions, is new in
-Version_3.5 of ACL2.)
-
-
-File: acl2-doc-emacs.info,  Node: SYNTAX,  Next: SYNTAXP,  Prev: SUBVERSIVE-RECURSIONS,  Up: MISCELLANEOUS
-
-SYNTAX    the syntax of ACL2 is that of Common Lisp
-
-For the details of ACL2 syntax, see CLTL.  For examples of ACL2 syntax,
-use :pe to print some of the ACL2 system code.  For example:
-
-     :pe assoc-equal
-     :pe dumb-occur
-     :pe var-fn-count
-     :pe add-linear-variable-to-alist
-
-There is no comprehensive description of the ACL2 syntax yet, except
-that found in CLTL.  Also see *note TERM::.
-
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-7 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-7
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-7	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-7	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,13 +28,375 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: SPLITTER,  Next: SPLITTER-OUTPUT,  Prev: SPECIOUS-SIMPLIFICATION,  Up: MISCELLANEOUS
+
+SPLITTER    reporting of rules whose application may have caused case splits
+
+The application of a rule to a term may cause a goal to simplify to
+more than one subgoal.  A rule with such an application is called a
+"splitter".  Here, we explain the output produced for splitters when
+proof output is enabled (see *note SET-INHIBIT-OUTPUT-LST::) and such
+reporting is turned on (as it is by default) -- that is, when the value
+of (splitter-output) is true.
+
+See *note SET-SPLITTER-OUTPUT:: for how to turn off, or on, the
+reporting of splitters.  Also see *note SET-CASE-SPLIT-LIMITATIONS::
+for information on how to control case splits.
+
+We begin by describing three types of splitters.
+
+     if-intro: The rule application may have introduced a call of IF, in
+     the sense discussed at the end below.
+
+     case-split: For the application of a rule with hypothesis of the
+     form (case-split <hyp>), <hyp> did not simplify to true or false.
+
+     immed-forced: For the application of a rule with hypothesis of the
+     form (force <hyp>), <hyp> did not simplify to true or false, where
+     immediate-force-modep is enabled (see *note
+     IMMEDIATE-FORCE-MODEP::).
+
+These three annotations -- if-intro, case-split, and immed-forced --
+may be used in proof output and summaries for describing rule
+applications, as discussed below.  A fourth annotation, forced, maybe
+also be used in proof output to indicate the application of a rule with
+hypothesis of the form (force <hyp>) when <hyp> did not simplify to
+true or false, where immediate-force-modep is disabled (see *note
+IMMEDIATE-FORCE-MODEP::).  We don't consider such uses of force to be
+splitters, because they do not cause case splits (though they do produce
+goals to prove after lower-case "q.e.d." is printed); see *note FORCE::.
+
+There are three kinds of output affected by splitters, illustrated in
+turn below using examples.
+
+     (a) During the proof, gag-mode off
+     (b) During the proof, gag-mode on
+     (c) Summary
+
+
+Of course, (a) and (b) are skipped if proof output is inhibited, which
+(c) is skipped if summary output is inhibited; see *note
+SET-INHIBIT-OUTPUT-LST::.
+
+(a) During the proof, gag-mode off
+
+With gag-mode off (or when using :pso, :psof, or :psog) one normally
+gets an English commentary.  The following output indicates that at
+least one application of each rule F and G is of type if-intro, at
+least one application of rules G and R1 are of type case-split, and at
+least one application of rule R3 is of type immed-forced.  If
+immediate-force-modep is off then "immed-forced" would be replaced by
+"forced".
+
+       This simplifies, using the :definitions F (if-intro), G (case-split and
+       if-intro) and H and the :rewrite rules R1, R2 (case-split), and
+       R3 (immed-forced), to the following two conjectures.
+
+Note that any such printing of "forced" is done even if
+(splitter-output) is false.  Such forcing indication is also made when
+raw proof format is used -- see *note SET-RAW-PROOF-FORMAT:: -- but in
+that case, no indication is made for splitters in the proof output.
+
+(b) During the proof, gag-mode on
+
+With gag-mode on the proof output is greatly abbreviated.  However,
+"Splitter Notes" are printed so that even with gag-mode on, one can get
+important information to help control large case splits, by disabling
+splitter rules as appropriate.  These are printed at the point when a
+goal splits into subgoals.  Here, for example, is the Splitter Note that
+corresponds to the output shown in (a) above.  It shows the goal whose
+simplification has produced a split into more than one subgoal, and it
+shows how many subgoals have been created.
+
+     Splitter note (see :DOC splitter) for Subgoal *1/2.2.1' (2 subgoals).
+       case-split: ((:DEFINITION G) (:REWRITE R2))
+       immed-forced: ((:REWRITE R3))
+       if-intro: ((:DEFINITION G) (:DEFINITION F))
+
+No such splitter notes are printed for the use of force (when
+immediate-force-modep is off).
+
+(c) Summary
+
+Here is a possible summary corresponding to our running example.  In the
+summary, "Splitter rules" is omitted if there are no splitter rules,
+and a splitter type is only mentioned if there is at least one
+corresponding splitter rule.
+
+     Summary
+     Form:  ( THM ...)
+     Rules: ((:DEFINITION F)
+             (:DEFINITION G)
+             (:DEFINITION H)
+             (:REWRITE R1)
+             (:REWRITE R2)
+             (:REWRITE R3))
+     Splitter rules (see :DOC splitter):
+       case-split: ((:DEFINITION G) (:REWRITE R2))
+       immed-forced: ((:REWRITE R3))
+       if-intro: ((:DEFINITION G) (:DEFINITION F))
+     Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.00)
+     Prover steps counted:  145
+
+No indication for "forced" is given for "Splitter rules".  (As
+discussed earlier above, the forced hypotheses are not considered
+relevant for determining splitter rule applications unless
+immediate-force-modep is on.)
+
+We conclude by giving the criteria for a rewrite or definition rule
+application to be a splitter of type if-intro.
+
+     o Reporting of splitter rules is on, i.e., the value of
+     (splitter-output) is true.
+
+     o At least two subgoals are created, even before considering
+     subgoals generated by hypotheses that are calls of case-split or
+     force.
+
+     o The term to which the rule is applied is at the top level,
+     rather than being encountered when trying to establish the
+     hypothesis of a rule.
+
+     o The rule is a rewrite rule, a definition rule, or a meta rule.
+
+     o There is a call of the function symbol IF in the right-hand side
+     of the rewrite rule; or, in the case of a definition rule, in the
+     body of the definition; or, in the case of a meta rule, in the
+     result of applying the metafunction.
+
+     o There is a call of the function symbol IF in the result of
+     rewriting: the right-hand side (for a rewrite rule), the
+     definition body (for a definition rule), or the metafunction
+     application (for a meta rule).
+
+
+Any rule application meeting the above criteria will be considered a
+splitter of type if-intro, even if the call does not actually cause a
+case split.  For example, if you are proving (implies (hyp x) (conc x))
+and rule R rewrites (hyp x) to (if (h1 x) (h2 x) nil), which is really
+the term (and (h1 x) (h2 x)), then R may be labelled as a splitter
+rule.  If you want to find the causes of case-splitting, the list of
+if-intro splitters can help you narrow your search, but may include
+irrelevant rules as well.
+
+Finally, note that you may see splits not attributed to splitters.  We
+believe that this will be uncommon during simplification, though it can
+occur for example when a call of IF is in the body of a LET expression,
+i.e., in a call of a LAMBDA expression.  But splits caused by other
+processes, notably destructor elimination (see *note ELIM::), will
+typically not be attributed to splitters.
+
+
+File: acl2-doc-emacs.info,  Node: SPLITTER-OUTPUT,  Next: STOBJS,  Prev: SPLITTER,  Up: MISCELLANEOUS
+
+SPLITTER-OUTPUT    status for reporting of splitter rules
+
+See *note SPLITTER:: for a discussion of splitter rules.  See *note
+SET-SPLITTER-OUTPUT:: for how to turn off, or on, the reporting of
+splitter rules.  When splitter-output is off, because either prove
+output is inhibited (see *note SET-INHIBIT-OUTPUT-LST::) or
+(set-splitter-output nil) has been invoked, then the value of
+(splitter-output) is nil.  Otherwise, such reporting is on and the
+value is non-nil.
+
+
+File: acl2-doc-emacs.info,  Node: STOBJS,  Next: SUBVERSIVE-INDUCTIONS,  Prev: SPLITTER-OUTPUT,  Up: MISCELLANEOUS
+
+STOBJS    xargs keyword :STOBJS
+
+See *note XARGS::.
+
+
+File: acl2-doc-emacs.info,  Node: SUBVERSIVE-INDUCTIONS,  Next: SUBVERSIVE-RECURSIONS,  Prev: STOBJS,  Up: MISCELLANEOUS
+
+SUBVERSIVE-INDUCTIONS    why we restrict encapsulated recursive functions
+
+See *note SUBVERSIVE-RECURSIONS::.
+
+
+File: acl2-doc-emacs.info,  Node: SUBVERSIVE-RECURSIONS,  Next: SYNTAX,  Prev: SUBVERSIVE-INDUCTIONS,  Up: MISCELLANEOUS
+
+SUBVERSIVE-RECURSIONS    why we restrict encapsulated recursive functions
+
+Subtleties arise when one of the "constrained" functions, f, introduced
+in the signature of an encapsulate event, is involved in the
+termination argument for a non-local recursively defined function, g, in
+that encapsulate.  During the processing of the encapsulated events, f
+is locally defined to be some witness function, f'.  Properties of f'
+are explicitly proved and exported from the encapsulate as the
+constraints on the undefined function f.  But if f is used in a
+recursive g defined within the encapsulate, then the termination proof
+for g may use properties of f' -- the witness -- that are not
+explicitly set forth in the constraints stated for f.
+
+Such recursive g are said be "subversive" because if naively treated
+they give rise to unsound induction schemes or (via functional
+instantiation) recurrence equations that are impossible to satisfy.  We
+illustrate what could go wrong below.
+
+Subversive recursions are not banned outright.  Instead, they are
+treated as part of the constraint.  That is, in the case above, the
+definitional equation for g becomes one of the constraints on f.  This
+is generally a severe restriction on future functional instantiations
+of f.  In addition, ACL2 removes from its knowledge of g any
+suggestions about legal inductions to "unwind" its recursion.
+
+What should you do?  Often, the simplest response is to move the
+offending recursive definition, e.g., g, out of the encapsulate.  That
+is, introduce f by constraint and then define g as an "independent"
+event.  You may need to constrain "additional" properties of f in order
+to admit g, e.g., constrain it to reduce some ordinal measure.  However,
+by separating the introduction of f from the admission of g you will
+clearly identify the necessary constraints on f, functional
+instantiations of f will be simpler, and g will be a useful function
+which suggests inductions to the theorem prover.
+
+Note that the functions introduced in the signature should not even
+occur ancestrally in the termination proofs for non-local recursive
+functions in the encapsulate.  That is, the constrained functions of an
+encapsulate should not be reachable in the dependency graph of the
+functions used in the termination arguments of recursive functions in
+encapsulate.  If they are reachable, their definitions become part of
+the constraints.
+
+The following event illustrates the problem posed by subversive
+recursions.
+
+     (encapsulate (((f *) => *))
+       (local (defun f (x) (cdr x)))
+       (defun g (x)
+         (if (consp x) (not (g (f x))) t)))
+
+Suppose, contrary to how ACL2 works, that the encapsulate above were to
+introduce no constraints on f on the bogus grounds that the only use of
+f in the encapsulate is in an admissible function.  We discuss the
+plausibility of this bogus argument in a moment.
+
+Then it would be possible to prove the theorem:
+
+     (defthm f-not-identity
+       (not (equal (f '(a . b)) '(a . b)))
+       :rule-classes nil
+       :hints (("Goal" :use (:instance g (x '(a . b))))))
+
+simply by observing that if (f '(a . b)) were '(a . b), then (g '(a .
+b)) would be (not (g '(a . b))), which is impossible.
+
+But then we could functionally instantiate f-not-identity, replacing f
+by the identity function, to prove nil!  This is bad.
+
+     (defthm bad
+       nil
+       :rule-classes nil
+       :hints
+       (("Goal" :use (:functional-instance f-not-identity (f identity)))))
+
+This sequence of events was legal in versions of ACL2 prior to Version
+1.5.  When we realized the problem we took steps to make it illegal.
+However, our steps were insufficient and it was possible to sneak in a
+subversive function (via mutual recursion) as late as Version 2.3.
+
+We now turn to the plausibility of the bogus argument above.  Why might
+one even be tempted to think that the definition of g above poses no
+constraint on f?  Here is a very similar encapsulate.
+
+     (encapsulate (((f *) => *))
+       (local (defun f (x) (cdr x)))
+       (defun map (x)
+         (if (consp x)
+             (cons (f x) (map (cdr x)))
+           nil)))
+
+Here map plays the role of g above.  Like g, map calls the constrained
+function f.  But map truly does not constrain f.  In particular, the
+definition of map could be moved "out" of the encapsulate so that map
+is introduced afterwards.  The difference between map and g is that the
+constrained function plays no role in the termination argument for the
+one but does for the other.
+
+As a "user-friendly" gesture, ACL2 implicitly moves map-like functions
+out of encapsulations; logically speaking, they are introduced after the
+encapsulation.  This simplifies the constraint.  When the constraint
+cannot be thus simplfied the user is advised, via the "infected"
+warning, to phrase the encapsulation in the simplest way possible.
+
+The lingering bug between Versions 1.5 and 2.3 mentioned above was due
+to our failure to detect the g-like nature of some functions when they
+were defined in mutually recursively cliques with other functions.  The
+singly recursive case was recognized.  The bug arose because our
+detection "algorithm" was based on the "suggested inductions" left
+behind by successful definitions.  We failed to recall that
+mutually-recursive definitions do not, as of this writing, make any
+suggestions about inductions and so did not leave any traces of their
+subversive natures.
+
+We conclude by elaborating on the criterion "involved in the termination
+argument" mentioned at the outset.  Suppose that function f is
+recursively defined in an encapsulate, where the body of f has no
+"ancestor" among the functions introduced in the signature of that
+encapsulate, i.e.: the body contains no call of a signature function,
+no call of a function whose body calls a signature function, and so on.
+Then ACL2 treats f as though it is defined in front of that encapsulate
+form; so f is not constrained by the encapsulate, and its definition is
+hence certainly not subversive in the sense discussed above.  But
+suppose to the contrary that some function introduced in the signature
+is an ancestor of the body of f.  Then the definition of f is
+subversive if moreover, its termination proof obligation has an
+ancestor among the signature functions.  Now, that proof obligation
+involves terms from the first argument of selected calls of IF, as well
+as recursive calls; for a detailed discussion, see *note
+RULER-EXTENDERS::.  The important point here is that for the recursive
+calls, only the arguments in "measured" positions are relevant to the
+termination proof obligation.  Consider the following example.
+
+       (encapsulate
+        (((h *) => *))
+        (local (defun h (n) n))
+        (defun f (i n)
+          (if (zp i)
+              n
+            (f (1- i) (h n)))))
+
+ACL2 heuristically picks the measure (acl2-count i) for the definition
+of f; thus, i is the only "measured formal" of f.  Since i is the first
+formal of f, then for the recursive call of f, only the first argument
+contributes to the termination proof obligation: in this case, (1- i)
+but not (h n).  Thus, even though h is a signature function, the
+definition of f is not considered to be subversive; an induction scheme
+is thus stored for f.  (This restriction to measured formal positions
+of recursive calls, for determining subversive definitions, is new in
+Version_3.5 of ACL2.)
+
+
+File: acl2-doc-emacs.info,  Node: SYNTAX,  Next: SYNTAXP,  Prev: SUBVERSIVE-RECURSIONS,  Up: MISCELLANEOUS
+
+SYNTAX    the syntax of ACL2 is that of Common Lisp
+
+For the details of ACL2 syntax, see CLTL.  For examples of ACL2 syntax,
+use :pe to print some of the ACL2 system code.  For example:
+
+     :pe assoc-equal
+     :pe dumb-occur
+     :pe var-fn-count
+     :pe add-linear-variable-to-alist
+
+There is no comprehensive description of the ACL2 syntax yet, except
+that found in CLTL.  Also see *note TERM::.
+
+
 File: acl2-doc-emacs.info,  Node: SYNTAXP,  Next: TERM,  Prev: SYNTAX,  Up: MISCELLANEOUS
 
-SYNTAXP    attach a heuristic filter on a :rewrite, :meta, or :linear rule
+SYNTAXP    attach a heuristic filter on a rule
 
-     Example:
-     Consider the :REWRITE rule created from
+A calls of syntaxp in the hypothesis of a :rewrite, :definition, or
+:linear rule is treated specially, as described below.  Similar
+treatment is given to the evaluation of a :meta rule's hypothesis
+function call.
+
+For example, consider the :rewrite rule created from the following
+formula.
 
+     Example:
      (IMPLIES (SYNTAXP (NOT (AND (CONSP X)
                                  (EQ (CAR X) 'NORM))))
               (EQUAL (LXD X)
@@ -73,13 +435,13 @@
 display this internal representation.
 
 There are two types of syntaxp hypotheses.  The simpler type may be a
-hypothesis of a :rewrite or :linear rule provided test contains at
-least one variable but no free variables (see *note FREE-VARIABLES::).
-In particular, test may not use stobjs; any stobj name will be treated
-as an ordinary variable.  The case of :meta rules is similar to the
-above, except that it applies to the result of applying the hypothesis
-metafunction.  (Later below we will describe the second type, an
-_extended_ syntaxp hypothesis, which may use state.)
+hypothesis of a :rewrite, :definition, or :linear rule provided test
+contains at least one variable but no free variables (see *note
+FREE-VARIABLES::).  In particular, test may not use stobjs; any stobj
+name will be treated as an ordinary variable.  The case of :meta rules
+is similar to the above, except that it applies to the result of
+applying the hypothesis metafunction.  (Later below we will describe
+the second type, an _extended_ syntaxp hypothesis, which may use state.)
 
 We illustrate the use of simple syntaxp hypotheses by slightly
 elaborating the example given above.  Consider a :rewrite rule:
@@ -2352,7 +2714,6 @@
        :ld-skip-proofsp    ...  ; nil, t or 'include-book
        :ld-redefinition-action  ; nil or '(:a . :b)
        :ld-prompt          ...  ; nil, t, or some prompt printer fn
-       :ld-keyword-aliases ...  ; an alist pairing keywords to parse info
        :ld-missing-input-ok ... ; nil, t, :warn, or warning message
        :ld-pre-eval-filter ...  ; :all, :query, or some new name
        :ld-pre-eval-print  ...  ; nil, t, or :never
@@ -3026,7 +3387,8 @@
 that some valid measure involves only those formal parameters.
 However, this special case is only allowed for definitions that are
 redundant (see *note REDUNDANT-EVENTS::) or are executed when skipping
-proofs (see *note SKIP-PROOFS::).
+proofs (see *note SKIP-PROOFS::).  Another special case is :MEASURE
+nil, which is treated the same as if :MEASURE is omitted.
 
 :RULER-EXTENDERS
 For recursive definitions (possibly mutually recursive), value controls
@@ -3121,6 +3483,8 @@
 
 * CERTIFY-BOOK!:: a variant of certify-book
 
+* COMMAND-LINE:: handling of command-line arguments when ACL2 is invoked
+
 * CW-GSTACK:: debug a rewriting loop or stack overflow
 
 * DEAD-EVENTS:: using proof supporters to identify dead code and unused theorems
@@ -3167,7 +3531,7 @@
 
 * RESET-LD-SPECIALS:: restores initial settings of the ld specials
 
-* SAVE-EXEC:: save an executable image and (for most Common Lisps) a wrapper script
+* SAVE-EXEC:: save an executable image and a wrapper script
 
 * SET-ACCUMULATED-PERSISTENCE:: See *note ACCUMULATED-PERSISTENCE::.
 
@@ -3823,20 +4187,6 @@
 :warn (which makes the check but merely warns when the check fails).
 See *note SET-IGNORE-OK::.
 
-     :inhibit-warnings
-
-ACL2 prints warnings that may, from time to time, seem excessive to
-experienced users.  Each warning is "labeled" with a string identifying
-the type of warning.  Consider for example
-
-     ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
-
-Here, the label is "Use".  The value of the key :inhibit-warnings is a
-list of such labels, where case is ignored.  Any warning whose label is
-a member of this list (where again, case is ignored) is suppressed.
-See *note SET-INHIBIT-WARNINGS:: and also see *note
-SET-INHIBIT-OUTPUT-LST::.
-
      :bdd-constructors
 
 This key's value is a list of function symbols used to define the
@@ -4063,7 +4413,7 @@
 wider distribution.
 
 
-File: acl2-doc-emacs.info,  Node: CERTIFY-BOOK!,  Next: CW-GSTACK,  Prev: ACL2-HELP,  Up: OTHER
+File: acl2-doc-emacs.info,  Node: CERTIFY-BOOK!,  Next: COMMAND-LINE,  Prev: ACL2-HELP,  Up: OTHER
 
 CERTIFY-BOOK!    a variant of certify-book
 
@@ -4087,7 +4437,23 @@
 *note CERTIFY-BOOK:: and see *note UBT!::.
 
 
-File: acl2-doc-emacs.info,  Node: CW-GSTACK,  Next: DEAD-EVENTS,  Prev: CERTIFY-BOOK!,  Up: OTHER
+File: acl2-doc-emacs.info,  Node: COMMAND-LINE,  Next: CW-GSTACK,  Prev: CERTIFY-BOOK!,  Up: OTHER
+
+COMMAND-LINE    handling of command-line arguments when ACL2 is invoked
+
+You may provide command-line arguments when invoking ACL2, which are
+passed to the host Lisp.  For more information on this topic, along
+with a discussion of how to save an ACL2 executable that avoids passing
+command-line arguments to the host Lisp, see *note SAVE-EXEC::.
+
+* Menu:
+
+
+Related topics other than immediate subtopics:
+* SAVE-EXEC:: save an executable image and a wrapper script
+
+
+File: acl2-doc-emacs.info,  Node: CW-GSTACK,  Next: DEAD-EVENTS,  Prev: COMMAND-LINE,  Up: OTHER
 
 CW-GSTACK    debug a rewriting loop or stack overflow
 
@@ -4261,19 +4627,19 @@
 ACL2 provides a utility for watching the activity of the rewriter and
 some other proof processes, in real time.  This utility is called
 "dmr", which is an acronym for "dynamically monitor rewrites".  The
-utility comes in two parts: an ACL2 component that frequently writes a
+utility comes in two parts: an ACL2 component that frequently updates a
 file (the "dmr file") containing the relevant information, and an Emacs
-component that frequently displays the contents of that file in an
-Emacs buffer (the "dmr buffer").  Other editors could, in principle, be
-programmed to display that file; anyone developing such a capability is
-invited to contribute it to the ACL2 community.
+component that frequently updates the an Emacs buffer (the "dmr
+buffer") with the contents of that file.  Other editors could, in
+principle, be programmed to display that file; anyone developing such a
+capability is invited to contribute it to the ACL2 community.
 
 The dmr utility can be extremely helpful for expensive proofs,
-especially when ACL2 is not providing any output.  The break-rewrite and
-accumulated-persistence utilities may be a bit easier to use, so you
-might want to try those first.  But the dmr utility can be a very
-helpful debugging aide, as it can visually give you a sense of where
-ACL2 is spending its time.
+especially when ACL2 is not providing any output to the terminal.  The
+break-rewrite and accumulated-persistence utilities may be a bit easier
+to use, so you might want to try those first.  But the dmr utility can
+be a very helpful debugging aide, as it can visually give you a sense of
+where ACL2 is spending its time.
 
 The Emacs portion of this utility is already loaded if you load the
 distributed Emacs file emacs/emacs-acl2.el.  Otherwise, invoke the
@@ -4403,9 +4769,13 @@
 In order to update the dmr file with the latest stack information,
 interrupt ACL2 and then evaluate: (dmr-flush).  In order to support
 resumption of the interrupted proof (assuming your host Common Lisp
-supports resumption), evaluation of (dmr-start) automatically causes
-evaluation of the form (set-debugger-enable t); see *note
-SET-DEBUGGER-ENABLE::.
+supports resumption), evaluation of (dmr-start) will automatically
+enable the debugger if it is not already enabled and not fully disabled
+with value :never (see *note SET-DEBUGGER-ENABLE::).  If such automatic
+enabling takes place, then (dmr-stop) will restore the old setting of
+the debugger unless, after (dmr-start) enables the debugger but before
+(dmr-stop) is called, you call set-debugger-enable (or more precisely:
+function set-debugger-enable-fn is called).
 
 Note for users of the experimental extension ACL2(p) (see *note
 PARALLELISM::): when waterfall-parallelism has been set to a non-nil
@@ -4561,7 +4931,6 @@
                                       ;   (see *note LD-SKIP-PROOFSP::)
          :ld-redefinition-action ...  ; nil or '(:a . :b)
          :ld-prompt          ...      ; nil, t, or some prompt printer fn
-         :ld-keyword-aliases ...      ; an alist pairing keywords to parse info
          :ld-missing-input-ok ...     ; nil, t, :warn, or warning message
          :ld-pre-eval-filter ...      ; :all, :query, or some new name
          :ld-pre-eval-print  ...      ; nil, t, or :never
@@ -5375,43 +5744,267 @@
 
 File: acl2-doc-emacs.info,  Node: SAVE-EXEC,  Next: SET-ACCUMULATED-PERSISTENCE,  Prev: RESET-LD-SPECIALS,  Up: OTHER
 
-SAVE-EXEC    save an executable image and (for most Common Lisps) a wrapper script
+SAVE-EXEC    save an executable image and a wrapper script
 
-See *note SAVING-AND-RESTORING:: for an explanation of why one might
-want to use this function.
+Save-exec saves your ACL2 state so that you can immediately re-start
+later in that same state.  This utility can be useful for a project with
+books to be included every time ACL2 is started, to avoid time taken to
+run include-book.  Another use of save-exec is to save an executable
+that takes command-line arguments beyond those normally passed to the
+host Lisp executable.  All arguments of a call of save-exec are
+evaluated.
 
      Examples:
-     ; Save an executable named my-saved_acl2:
+
+     ; Save an executable script named my-saved_acl2, with the indicated message
+     ; added to the start-up banner:
      (save-exec "my-saved_acl2"
                 "This saved image includes Version 7 of Project Foo.")
 
-     ; Same as above, but with a generic comment instead:
+     ; Same as above, but instead with a generic comment in the start-up banner:
      (save-exec "my-saved_acl2" nil)
 
-     General Form:
-     (save-exec exec-filename extra-startup-string)
-
-where exec-filename is the filename of the proposed executable and
-extra-startup-string is a non-empty string to be printed after the
-normal ACL2 startup message when you start up the saved image.  However,
-extra-startup-string is allowed to be nil, in which case a generic
-string will be printed instead.
+     ; Arrange that the generated script passes the indicated arguments to be
+     ; processed by the Lisp (ACL2) executable (where this example is specific to
+     ; the case that CCL is the host Lisp):
+     (save-exec "my-saved_acl2" nil
+                :host-lisp-args "--no-init -Z 256M")
+
+     ; Arrange that the generated script passes along the indicated arguments
+     ; to Lisp (ACL2), but that they are not processed by Lisp other than to
+     ; record the additional arguments (see (6) below).
+     (save-exec "my-saved_acl2" nil
+                :inert-args "abc xyz -i foo")
+
+     ; Combining the preceding two examples:
+     (save-exec "my-saved_acl2" nil
+                :host-lisp-args "--no-init -Z 256M"
+                :inert-args "abc xyz -i foo")
+
+     ; Immediately exit the ACL2 read-eval-print loop after starting up.
+     (save-exec "my-acl2" nil
+                :return-from-lp t)
+
+     ; Immediately exit the ACL2 read-eval-print loop after starting up and
+     ; defining function FOO in the logic.
+     (save-exec "my-acl2" "Start with foo defined."
+                :return-from-lp '(with-output
+                                  :off :all
+                                  (defun foo (x) x)))
+
+     ; Immediately exit the ACL2 read-eval-print loop after starting up and
+     ; defining variable xxx in raw Lisp.
+     (save-exec "my-acl2" "Start with xxx defined."
+                :return-from-lp '(with-output
+                                  :off :all
+                                  (ld '((set-raw-mode-on!)
+                                        (defvar xxx (make-list 10))
+                                        (set-raw-mode nil)
+                                        (u)))))
+
+Each example above generates a file named "my-saved_acl2".  That file is
+quite similar in form to the script generated when building ACL2
+directly from source code; details are below.  For example, here are
+the contents of that generated file if the host Lisp is CCL (but where
+dates and pathnames are specific to one's environment).  Here, we break
+lines using `\', but the exec command is actually on a single line.
+
+     #!/bin/sh
+
+     # Saved August 16, 2013  23:06:49
+     #  then August 17, 2013  11:01:56
+
+     export CCL_DEFAULT_DIRECTORY="/projects/acl2/lisps/ccl/15542/ccl"
+     exec "/projects/ccl/lx86cl64" -I "/u/smith/my-saved_acl2.lx86cl64" \
+          -Z 64M -K ISO-8859-1 -e "(acl2::acl2-default-restart)" \
+          --no-init -Z 256M \
+          -- \
+          abc xyz -i foo \
+          "$@"
 
-*Notes*:
-
-1. For technical reasons, you must first exit the ACL2 read-eval-print
-loop, for example by executing :q, before evaluating a save-exec call.
+     General Form:
+     (save-exec exec-filename extra-startup-string
+                :host-lisp-args host-lisp-args
+                :inert-args inert-args
+                :return-from-lp return-from-lp)
+
+where the keyword arguments are optional, and arguments are as follows.
+
+     Exec-filename is the filename of the proposed executable.
+
+     Extra-startup-string is a non-empty string to be printed after the
+     normal ACL2 startup message when you start up the saved image.
+     However, extra-startup-string is allowed to be nil, in which case
+     a generic string will be printed instead.
+
+     Host-lisp-args can be nil (the default), but if it is a non-nil
+     value, then it is a string to be inserted into the command line in
+     the saved script, specifying additional arguments that are to be
+     processed by the host Lisp executable.  (Note for SBCL only: these
+     are runtime options; for toplevel options, see (8) below.)
+
+     Inert-args can be nil (the default), but if it is a non-nil value,
+     then it is a string to be inserted into the command line in the
+     saved script, specifying additional arguments that are not to be
+     processed by the host Lisp executable.
+
+Return-from-lp is nil by default.  Regardless of the value of
+return-from-lp, ACL2 starts up and enters its read-eval-print loop as
+usual; see *note LP::.  Normally you'll stay inside that loop, but if
+return-from-lp is not nil, then it is evaluated in the loop, which is
+then exited, leaving you in raw Lisp.  Evaluation of return-from-lp is
+done with ld options that minimize output; also see *note WITH-OUTPUT::
+to minimize output.  Suggestion: let return-from-lp be t if you simply
+want to exit the read-eval-print loop at startup, without evaluating any
+(nontrivial) form.
+
+The remainder of this documentation focuses on the options other than
+return-from-lp.
+
+*Details*:
+
+(1) You must first exit the ACL2 read-eval-print loop, typically by
+executing :q, before evaluating a save-exec call; otherwise an error
+occurs.
 
-2. The image will be saved so that in the new image, the raw Lisp
+(2) The image will be saved so that in the new image, the raw Lisp
 package and the package in the ACL2 read-eval-print loop (see *note
 LP::) will be the same as their respective values at the time save-exec
 is called.
 
-3. For most Common Lisps, the specified file (e.g., "my-saved_acl2" in
-the examples above) will be written as a small script, which in turn
-invokes a saved image to which an extension has been appended (e.g.,
-my-saved_acl2.gcl for the examples above, when the underlying Common
-Lisp is GCL on a non-Windows system).
+(3) Save-exec generates a small script file (e.g., "my-saved_acl2" in
+the examples above), similar in form (see (4) below) to the script
+generated when building ACL2 directly from source code, but with a
+comment line indicating the time at which the new script is written.
+Save-exec also saves an associated binary file.  The binary file's name
+is obtained by putting a suffix on the script filename; for example, if
+the host Lisp is GCL running on a Linux or Darwin (MacOS) system, then
+that binary file has the name my-saved_acl2.gcl in the examples above.
+
+(4) If inert-args is nil (for example if keyword :inert-args is
+omitted), then when the generated ACL2 script is invoked with command
+line arguments, those arguments will be passed to the host Lisp;
+otherwise they will not.  Thus for the example above, suppose we invoke
+the generated script as follows.
+
+     my-saved_acl2 -a bcd -e fgh
+
+If my-saved_acl2 was generated using a save-exec command with a non-nil
+value specified for keyword :inert-args, then the arguments "-a bcd -e
+fgh" will not be passed to the host Lisp; otherwise, they will be.
+Note that for ACL2 executable scripts generated by an ordinary ACL2
+build from sources, the latter case (i.e., without inert-args) takes
+place.
+
+(5) The generated script, which specifies execution with /bin/sh, will
+generally contain a line of one of the following forms.  (But for SBCL,
+see (8) below.)  In the examples that follow, ACL2_options is a suitable
+list of command-line arguments given to the ACL2 executable.  The quoted
+string "$@" is intended to allow the user to pass additional
+command-line arguments to that executable.
+
+     If host-lisp-args and inert-args are omitted (or nil):
+
+          exec <lisp_executable> <ACL2_options> "$@"
+
+     More generally, host-lisp-args is inserted immediately after
+     <ACL2_options>, but only if it is non-nil (hence a string).  If
+     inert-args is nil, we thus get:
+
+          exec <lisp_executable> <ACL2_options> host-lisp-args "$@"
+
+     If host-lisp-args redefines a value from <ACL2_options>, then it is
+     up to the host lisp which value to use.  For example, experiments
+     show that in CCL, if -Z appears twice, each with a legal value,
+     then the second value is the one that is used (i.e. it does indeed
+     override the original value written out by ACL2 in <ACL2_options>.
+     But experiments also show that in LispWorks, where "-init -" is
+     included in <ACL2_options>, then inclusion of "-init foo.lisp" in
+     host-lisp-args is ignored.
+
+     The remaining cases below are for a non-nil value of inert-args.
+     In each case, if host-lisp-args is nil then it should be omitted
+     from the displayed command.
+
+     If inert-args is t then an additional argument, `-', indicates
+     that when ACL2 is given command line arguments, these should not
+     be processed by the host Lisp (other than recording them; see (6)
+     below):
+
+          exec <lisp_executable> <ACL2_options> host-lisp-args -- "$@"
+
+     If inert-args is a string then the result is similar to the above,
+     except that inert-args is added immediately after `-':
+
+          exec <lisp_executable> <ACL2_options> host-lisp-args -- inert-args "$@"
+
+
+(6) See community books books/oslib/argv for a utility that returns a
+list of all inert-args from an invocation of ACL2.
+
+(7) Suppose that you invoke an ACL2 script, say "my-saved_acl2", that
+was generated by save-exec, and then optionally evaluate some forms.
+Then you may save a new ACL2 script with save-exec.  The new script will
+contain comment lines that extend comment lines in "my-saved_acl2" with
+a new write date, but otherwise will be identical to the script that
+would have been generated by executing the new save-exec call after
+invoking the original ACL2 executable (built directly from ACL2
+sources) instead of "my-saved_acl2".  In other words, the options added
+by the earlier save-exec call that created "my-saved_acl2" are
+discarded by the new save-exec call.  However, the .core file will
+built on top of the .core file that was consulted when "my-saved_acl2"
+was invoked.
+
+(8) The following note pertains only to the case that the host Lisp is
+SBCL.  For SBCL, the scripts written are analogous to, but slightly
+different from, those shown above.  Please note that for SBCL, the
+host-lisp-args are what the SBCL manual calls "runtime options".  For
+SBCL only, an extra keyword argument, :toplevel-args, may be used for
+specifying what the SBCL manual calls "toplevel options.  As with
+:host-lisp-args, this value, toplevel-args, should be nil (the default)
+or a string.  Here is an example.
+
+     (save-exec "my-saved_acl2" nil
+                :host-lisp-args "--dynamic-space-size 12000"
+                :toplevel-args "--eval '(print \"HELLO\")'"
+                :inert-args "--my-option my-value")
+
+The script generated by this example call of save-exec contains a line
+such as the following (with the same convention for `\' as before)
+
+     exec "/projects/sbcl-1.1.7-x86-64-linux/src/runtime/sbcl" \
+          --dynamic-space-size 2000 --control-stack-size 8 \
+          --core "/u/smith/my-saved_acl2.core" --dynamic-space-size 12000 \
+          --end-runtime-options \
+          --no-userinit --eval '(acl2::sbcl-restart)' \
+          --eval '(print "HELLO")' \
+          --end-toplevel-options \
+          --my-option my-value \
+          "$@"
+
+In general, the generated script is of one of the following forms (with
+the same convention for `\' as before).
+
+     For the case that inert-args is nil:
+
+          exec <lisp_executable> \
+               <ACL2_runtime_options> host-lisp-args --end-runtime-options \
+               <ACL2_toplevel_options> host-lisp-args \
+               "$@"
+
+     For the case that inert-args is non-nil:
+
+          exec <lisp_executable> \
+               <ACL2_runtime_options> host-lisp-args --end-runtime-options \
+               <ACL2_toplevel_options> host-lisp-args --end-toplevel-options \
+               inert-args "$@"
+
+
+Notice that as before, when the generated script is invoked (for
+example, at the shell), additional command-line arguments provided at
+that time are passed to Lisp if and only if inert-args is nil.  For
+SBCL, when they are passed to Lisp they are passed as toplevel options,
+not as runtime options.
 
 
 File: acl2-doc-emacs.info,  Node: SET-ACCUMULATED-PERSISTENCE,  Next: SHARP-BANG-READER,  Prev: SAVE-EXEC,  Up: OTHER
@@ -5939,7 +6532,9 @@
 just one form, and for a discussion of the notion of "prover steps",
 which could change in future ACL2 releases.  For a related utility
 based on time instead of prover steps, see *note
-WITH-PROVER-TIME-LIMIT::.
+WITH-PROVER-TIME-LIMIT::; but as discussed in the documentation for
+set-prover-step-limit, there is at best a loose connection between the
+counting of steps and with-prover-time-limit.
 
 The arguments of (with-prover-step-limit expr form) are evaluated.
 However, the (optional) argument flg is not evaluated in
@@ -5954,6 +6549,9 @@
 For examples of how step-limits work besides those presented below, see
 the community book books/misc/misc2/step-limits.lisp.
 
+For a utility that returns an indicator of the number of prover steps
+most recently taken, see *note LAST-PROVER-STEPS::.
+
 Note that with-prover-step-limit may not be called inside definitions,
 and that it is simply the identity macro in raw Lisp.  However,
 with-prover-step-limit! may be called in place of
@@ -6087,7 +6685,7 @@
 where time evaluates to a positive rational number or to a list
 containing such, and form is arbitrary.  Logically,
 (with-prover-time-limit time form) is equivalent to form.  However, if
-the runtime for evaluation of form exceeds the value specified by time,
+the time for evaluation of form exceeds the value specified by time,
 and if ACL2 notices this fact during a proof, then that proof will
 abort, for example like this:
 
@@ -6099,6 +6697,9 @@
 time is specified as a list containing a rational, rather than as a
 rational.
 
+Note that by default, the time used is runtime (cpu time); to switch to
+realtime (elapsed time), see *note GET-INTERNAL-TIME::.
+
 For a related utility based on prover steps instead of time, see *note
 WITH-PROVER-STEP-LIMIT::; also see *note SET-PROVER-STEP-LIMIT::.  Those
 utilities have the advantage of having platform-independent behavior,
@@ -6250,530 +6851,3 @@
 
      make large DOC ACL2_PAR=t LISP=ccl
 
-
-File: acl2-doc-emacs.info,  Node: PARALLEL-PROGRAMMING,  Next: PARALLEL-PROOF,  Prev: COMPILING-ACL2P,  Up: PARALLELISM
-
-PARALLEL-PROGRAMMING    parallel programming in ACL2(p)
-
-Here we document support for parallel programming in ACL2(p), an
-experimental extension of ACL2; also see *note PARALLELISM::.
-
-* Menu:
-
-* DEFLOCK:: define a wrapper macro that provides mutual exclusion in ACL2(p)
-
-* EARLY-TERMINATION:: early termination for pand and por.
-
-* ERROR-TRIPLES-AND-PARALLELISM:: how to avoid error triples in ACL2(p)
-
-* GRANULARITY:: limit the amount of parallelism
-
-* PAND:: parallel, Boolean version of and
-
-* PARALLEL-EXECUTION:: for ACL2(p): configure parallel execution
-
-* PARALLELISM-AT-THE-TOP-LEVEL:: parallel execution in the ACL2 top-level loop
-
-* PARALLELISM-PERFORMANCE:: performance issues for parallel execution
-
-* PARALLELISM-TUTORIAL:: a tutorial on how to use the parallelism library.
-
-* PARGS:: parallel evaluation of arguments in a function call
-
-* PLET:: parallel version of let
-
-* POR:: parallel, Boolean version of or
-
-* SPEC-MV-LET:: modification of mv-let supporting speculative and parallel execution
-
-* WITH-OUTPUT-LOCK:: provides a mutual-exclusion mechanism for performing output in parallel
-
-
-Related topics other than immediate subtopics:
-* SET-PARALLEL-EXECUTION:: for ACL2(p): enabling parallel execution for four parallelism primitives
-
-* SET-TOTAL-PARALLELISM-WORK-LIMIT:: for ACL2(p): set thread limit for parallelism primitives
-
-One of ACL2's strengths lies in its ability to execute industrial models
-efficiently.  The ACL2 source code provides an experimental parallel
-execution capability that can increase the speed of explicit evaluation,
-including simulator runs using such models, and it can also decrease
-the time required for proofs that make heavy use of the evaluation of
-ground terms.
-
-The parallelism primitives are plet, pargs, pand, por, and spec-mv-let.
-Pand and por terminate early when an argument is found to evaluate to
-nil or non-nil, respectively, thus potentially improving on the
-efficiency of lazy evaluation.  Spec-mv-let is a modification of mv-let
-that supports speculative and parallel execution.
-
-Of the above five parallelism primitives, all but spec-mv-let allow for
-limiting parallel execution (spawning of so-called "threads") depending
-on resource availability.  Specifically, the primitives allow
-specification of a size condition to control the granularity under
-which threads are allowed to spawn.  You can use such granularity
-declarations in recursively-defined functions to implement
-data-dependent parallelism in their execution.
-
-We recommend that in order to learn to use the parallelism primitives,
-you begin by reading examples: see *note PARALLELISM-TUTORIAL::.  That
-section will direct you to further documentation topics.
-
-In addition to providing parallel programming primitives, ACL2(p) also
-provides the ability to execute the main ACL2 proof process in parallel.
-See *note SET-WATERFALL-PARALLELISM:: for further details.
-
-
-File: acl2-doc-emacs.info,  Node: DEFLOCK,  Next: EARLY-TERMINATION,  Prev: PARALLEL-PROGRAMMING,  Up: PARALLEL-PROGRAMMING
-
-DEFLOCK    define a wrapper macro that provides mutual exclusion in ACL2(p)
-
-This documentation topic relates to the experimental extension of ACL2
-supporting parallel evaluation and proof; see *note PARALLELISM::.
-
-     Example Form:
-     (deflock *my-lock*)
-
-     General Form:
-     (deflock *symbol*)
-
-where *symbol* is a symbol whose first and last characters are both the
-character #\*.
-
-A call of this macro generates a definition of another macro, named
-with-<modified-lock-symbol>, where <modified-lock-symbol> is the given
-symbol with the leading and trailing * characters removed.  This newly
-defined macro will guarantee mutually exclusive execution when called
-in the body of the raw Lisp definition of a function, as is typically
-the case for guard-verified functions, for :program mode functions, and
-for calls of macro top-level.  (See *note GUARD-EVALUATION-TABLE:: for
-details of how raw Lisp code might not be invoked when guard-checking
-(see *note SET-GUARD-CHECKING::) has value :none or :all.)
-
-To see how mutual exclusion is guaranteed, consider the raw Lisp code
-generated for the macro, with-<modified-lock-symbol>, that is introduced
-by a call of deflock.  This code uses a lock (with the given *symbol*
-as its name), which guarantees that for any two forms that are each in
-the scope of a call of with-<modified-lock-symbol>, the forms do not
-execute concurrently.
-
-Note that a call of deflock expands into the application of progn to
-two events, as illustrated below.
-
-     ACL2 !>:trans1 (deflock *my-cw-lock*)
-      (PROGN (TABLE LOCK-TABLE '*MY-CW-LOCK* T)
-             (DEFMACRO WITH-MY-CW-LOCK (&REST ARGS)
-                       (LIST* 'WITH-LOCK '*MY-CW-LOCK* ARGS)))
-     ACL2 !>
-
-Thus, deflock forms are legal embedded event forms (see *note
-EMBEDDED-EVENT-FORM::) for books as well as encapsulate and progn
-events.
-
-The following log shows a lock in action.  Recall that locks work as
-expected in guard-verified and :program mode functions; they do not,
-however, work in :logic mode functions that have not been
-guard-verified, as illustrated below.
-
-     ACL2 !>(deflock *my-cw-lock*)
-     [[.. output omitted ..]]
-      WITH-MY-CW-LOCK
-     ACL2 !>(defun foo (n)
-              (declare (xargs :guard (natp n) :verify-guards nil))
-              (plet ((x1 (with-my-cw-lock (cw "~x0" (make-list n))))
-                     (x2 (with-my-cw-lock (cw "~x0" (make-list n)))))
-                    (and (null x1) (null x2))))
-     [[.. output omitted ..]]
-      FOO
-     ACL2 !>(foo 20)
-     (NIL NIL NIL NIL( NIL NIL NIL NIL NIL NILNIL  NIL NILNIL  NIL NILNIL
-          NIL NILNIL NIL  NIL NILNIL  NIL NIL
-     NIL      NILNIL  NIL NILNIL )
-     NIL NIL NIL NIL NIL NIL NIL NIL)
-     T
-     ACL2 !>(verify-guards foo)
-     [[.. output omitted ..]]
-      FOO
-     ACL2 !>(foo 20)
-     (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
-          NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
-     (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
-          NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
-     T
-     ACL2 !>
-
-
-File: acl2-doc-emacs.info,  Node: EARLY-TERMINATION,  Next: ERROR-TRIPLES-AND-PARALLELISM,  Prev: DEFLOCK,  Up: PARALLEL-PROGRAMMING
-
-EARLY-TERMINATION    early termination for pand and por.
-
-This documentation topic relates to the experimental extension of ACL2
-supporting parallel execution and proof; see *note PARALLELISM::.
-
-The evaluation of (and expr1 expr2) returns nil if expr1 evaluates to
-nil, avoiding the evaluation of expr2.  More generally, the evaluation
-of (and expr1 expr2 ... exprk) terminates with a return value of nil as
-soon as any expri evaluates to nil -- no exprj is evaluated in this
-case for j > i.  This so-called "lazy evaluation" of and terms can thus
-save some computation; roughly speaking, the smaller the i, the more
-computation is saved.
-
-If the above call of and is replaced by its parallel version, pand,
-then there can be even more opportunity for skipping work.  The
-arguments to pand can be evaluated in parallel, in which case the first
-such evaluation that returns with a value of nil, if any, causes the
-remaining such evaluations to abort.
-
-Consider the following functions that compute whether a tree is valid
-(see *note GRANULARITY:: for a discussion of the granularity form).
-
-     (defun valid-tip (x)
-       (declare (xargs :guard t))
-       (or (eq x 'A)
-           (eq x 'T)
-           (eq x 'C)
-           (eq x 'G)))
-
-     (defun pvalid-tree (x depth)
-       (declare (xargs :guard (natp depth)))
-       (if (atom x)
-           (valid-tip x)
-         (pand (declare (granularity (< depth 10)))
-               (pvalid-tree (car x) (1+ depth))
-               (pvalid-tree (cdr x) (1+ depth)))))
-
-We would like to stop execution as soon as any tip is found to be
-invalid.  So, when computing the conjunction of terms by using pand,
-once one of those terms evaluates to nil, the computations for the
-other terms are aborted and the pand call returns nil.  By using pand,
-we can in principle attain a speedup factor greater than the number of
-available cores.
-
-The concept of early termination also applies to por, except that early
-termination occurs when an argument evaluates to non-nil.
-
-
-File: acl2-doc-emacs.info,  Node: ERROR-TRIPLES-AND-PARALLELISM,  Next: GRANULARITY,  Prev: EARLY-TERMINATION,  Up: PARALLEL-PROGRAMMING
-
-ERROR-TRIPLES-AND-PARALLELISM    how to avoid error triples in ACL2(p)
-
-This documentation topic relates to the experimental extension of ACL2
-supporting parallel execution and proof; see *note PARALLELISM::.
-
-ACL2 supports the use of error triples in many features; e.g.,
-computed-hints.  (For background on error triples, see *note
-PROGRAMMING-WITH-STATE::.)  However, ACL2(p) does not support the use of
-error triples in some of these features (e.g., computed-hints) while
-waterfall-parallelism is enabled.
-
-You may see an error message like the following when running ACL2(p)
-with waterfall-parallelism enabled:
-
-     ACL2 Error in ( THM ...):  Since we are translating a form in ACL2(p)
-     intended to be executed with waterfall parallelism enabled, the form
-     (MY-STATE-MODIFYING-COMPUTED-HINT ID STATE) was expected to represent
-     an ordinary value, not an error triple (mv erp val state), as would
-     be acceptable in a serial execution of ACL2.  Therefore, the form returning
-     a tuple of the form (* * STATE) is an error.  See :DOC unsupported-
-     waterfall-parallelism-features and :DOC error-triples-and-parallelism
-     for further explanation.
-
-In this particular example, the cause of the error was trying to use a
-computed hint that returned state, which is not allowed when executing
-the waterfall in parallel (see *note
-UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES:: for other related
-information).
-
-Often, the only reason users need to return state is so they can perform
-some output during the proof process.  In this case, we suggest using
-one of the state-free output functions, like cw or observation-cw.  If
-the user is concerned about the interleaving of their output with other
-output, these calls can be surrounded with the macro with-output-lock.
-
-Another frequent reason users return state is so they can cause a soft
-error and halt the proof process.  In this case, we suggest instead
-calling er with the hard or hard? severity.  By using these mechanisms,
-the user avoids modifying state, a requirement for much of the code
-written in ACL2(p).
-
-You may encounter other similar error messages when using
-computed-hints, custom-keyword-hints, or override-hints.  Chances are
-that you are somehow returning an error triple when an ordinary value
-is needed.  If this turns out not to be the case, please let the ACL2
-implementors know.
-
-
-File: acl2-doc-emacs.info,  Node: GRANULARITY,  Next: PAND,  Prev: ERROR-TRIPLES-AND-PARALLELISM,  Up: PARALLEL-PROGRAMMING
-
-GRANULARITY    limit the amount of parallelism
-
-This documentation topic relates to the experimental extension of ACL2
-supporting parallel execution and proof; see *note PARALLELISM::.
-
-Some function calls are on arguments whose evaluation time is long
-enough to warrant parallel execution, while others are not.  A
-granularity form can be used to make appropriate restrictions on the
-use of parallelism.
-
-For example, consider the Fibonacci function.  Experiments have
-suggested that execution time can be reduced if whenever the argument
-is less than 27, a serial version of the Fibonacci function is called.
-One way to utilize this information is to write two definitions of the
-Fibonacci function, one serial and one parallel.
-
-     (defun fib (x)
-       (declare (xargs :guard (natp x)))
-       (cond ((or (zp x) (<= x 0)) 0)
-             ((= x 1) 1)
-             (t (binary-+ (fib (- x 1))
-                          (fib (- x 2))))))
-
-     (defun pfib (x)
-       (declare (xargs :guard (natp x)))
-       (cond ((or (zp x) (<= x 0)) 0)
-             ((= x 1) 1)
-             ((< x 27) (binary-+ (fib (- x 1))
-                                 (fib (- x 2))))
-             (t (pargs (binary-+ (pfib (- x 1))
-                                 (pfib (- x 2)))))))
-
-We realize quickly that writing both of these function definitions is
-cumbersome and redundant.  This problem can be avoided by using a
-granularity declaration with a parallelism primitive.  This form ensures
-that a call is parallelized only if resources are available and the
-granularity form evaluates to a non-nil value at the time of the call.
-Below is a definition of the Fibonacci function using a granularity
-form.
-
-     (defun pfib (x)
-       (declare (xargs :guard (natp x)))
-       (cond ((or (zp x) (<= x 0)) 0)
-             ((= x 1) 1)
-             (t (pargs (declare (granularity (>= x 27)))
-                       (binary-+ (pfib (- x 1))
-                                 (pfib (- x 2)))))))
-
-A granularity form can reference an extra formal parameter that
-describes the call depth of the function the user is parallelizing.
-Consider for example the following parallel mergesort function, based
-on Davis's Ordered Sets library.  It splits the data into symmetric
-chunks for computation, so we increment the depth argument during the
-recursive call on both the car and cdr.
-
-     (include-book "finite-set-theory/osets/sets" :dir :system)
-     (defun sets::pmergesort-exec (x depth)
-       (declare (xargs :mode :program))
-       (cond ((endp x) nil)
-             ((endp (cdr x)) (sets::insert (car x) nil))
-             (t (mv-let (part1 part2)
-                        (sets::split-list x nil nil)
-                        (pargs
-                         (declare (granularity (< depth 2)))
-                         (sets::union (sets::pmergesort-exec part1
-                                                             (1+ depth))
-                                      (sets::pmergesort-exec part2
-                                                             (1+ depth))))))))
-
-A less intrusive method (i.e., not requiring an extra formal parameter
-like the depth argument just above), which however can be less
-efficient, involves analyzing the data itself for structural
-properties.  For example:
-
-     (defun some-depth-exceeds (x n)
-       (declare (xargs :guard (natp n)))
-       (if (atom x)
-           nil
-         (if (zp n)
-             t
-           (or (some-depth-exceeds (car x) (1- n))
-               (some-depth-exceeds (cdr x) (1- n))))))
-
-     (defun valid-tip (x)
-       (declare (xargs :guard t))
-       (or (eq x 'A)
-           (eq x 'T)
-           (eq x 'C)
-           (eq x 'G)))
-
-     (defun pvalid-tree (x)
-       (declare (xargs :guard t))
-       (if (atom x)
-           (valid-tip x)
-         (pand (declare (granularity (some-depth-exceeds x 3)))
-               (pvalid-tree (car x))
-               (pvalid-tree (cdr x)))))
-
-If you experiment with calls of pvalid-tree, you are likely to find that
-the "speedup" it provides over a corresponding serial version is, in
-fact, a slowdown!  The problem is likely that some-depth-exceeds is an
-expensive function to run repeatedly.  Instead of the approach above,
-it is often handy to add an extra formal parameter in order to allow
-for more efficient granularity forms, as we have done above in the
-definition of SETS::pmergesort-exec.
-
-
-File: acl2-doc-emacs.info,  Node: PAND,  Next: PARALLEL-EXECUTION,  Prev: GRANULARITY,  Up: PARALLEL-PROGRAMMING
-
-PAND    parallel, Boolean version of and
-
-This documentation topic relates to the experimental extension of ACL2
-supporting parallel execution and proof; see *note PARALLELISM::.
-
-     Example Forms:
-     (pand (subsetp-equal x y)
-           (subsetp-equal y x))
-
-     (pand (declare
-            (granularity
-             (and (> (length x) 500)
-                  (> (length y) 500))))
-            (subsetp-equal x y)
-            (subsetp-equal y x))
-
-     General Form:
-     (pand (declare (granularity expr)) ; optional granularity declaration
-           arg1 ... argN)
-
-where N >= 0 and each argi and expr are arbitrary terms.
-
-Pand evaluates its arguments in parallel.  It returns a Boolean result:
-nil if any argument evaluates to nil, else t.  Note that pand always
-returns a Boolean result, even though and can return a non-nil value
-other than t, namely the value of its last argument.  (A moment's
-reflection will make it clear that in order for por to parallelize
-efficiently, it needs to return a Boolean value; so pand returns a
-Boolean value for consistency with por.)
-
-Another difference between pand and and is that for a call of pand,
-even if an argument evaluates to nil, a subsequent argument may be
-evaluated.  Consider the following example (where cw prints a string;
-see *note CW::).
-
-     (defun bar ()
-       (pand (equal (make-list 100000) nil) ; evaluates to nil
-             (cw "hello world~%")))
-
-When (bar) is evaluated, the above arguments of pand can execute in
-parallel, causing "hello world" to be printed to the terminal.  If we
-had used and rather than pand, then since (equal (make-list 100000)
-nil) evaluates to nil, the above call of cw would be avoided and no
-such printing would take place.  Even with pand, such printing _might_
-not take place, depending on resources, timing of thread creation, and
-whether or not parallel execution is enabled (see *note
-SET-PARALLEL-EXECUTION::).
-
-Note that unlike the case for and, the definition of pand does not
-provide (consp x) as a guard to (car x) in the call of pand below:
-
-     (defun h (x)
-       (declare (xargs :guard t))
-       (pand (consp x) (equal (car x) 'foo)))
-
-As a result, guard verification will fail for the above definition.  If
-pand were replaced by and, then guard verification would succeed.
-
-See *note PARALLELISM-TUTORIAL:: for another example.  Also see *note
-PARALLELISM-AT-THE-TOP-LEVEL:: for restrictions on evaluating
-parallelism primitives from within the ACL2 top-level loop.  Finally
-see *note EARLY-TERMINATION:: to read how pand can offer more
-efficiency than and by avoiding evaluation of some of its arguments.
-
-
-File: acl2-doc-emacs.info,  Node: PARALLEL-EXECUTION,  Next: PARALLELISM-AT-THE-TOP-LEVEL,  Prev: PAND,  Up: PARALLEL-PROGRAMMING
-
-PARALLEL-EXECUTION    for ACL2(p): configure parallel execution
-
-See *note SET-PARALLEL-EXECUTION:: for how to configure parallel
-execution for calls of plet, pargs, pand, por (but not spec-mv-let).
-
-
-File: acl2-doc-emacs.info,  Node: PARALLELISM-AT-THE-TOP-LEVEL,  Next: PARALLELISM-PERFORMANCE,  Prev: PARALLEL-EXECUTION,  Up: PARALLEL-PROGRAMMING
-
-PARALLELISM-AT-THE-TOP-LEVEL    parallel execution in the ACL2 top-level loop
-
-This documentation topic relates to the experimental extension of ACL2
-supporting parallel execution and proof; see *note PARALLELISM::.
-
-Calls of parallelism primitives made explicitly in the ACL2 top-level
-loop, as opposed to inside function bodies, will never cause parallel
-execution.  Such calls will either execute with serial execution or
-will cause an error; see *note SET-PARALLEL-EXECUTION::.  For a way
-around this restriction, see *note TOP-LEVEL::.
-
-Consider for example the following call of pargs in the ACL2 top-level
-loop.  Instead of executing pargs, ACL2 macroexpands away this call,
-leaving us with serial execution of the arguments to the cons call, or
-else causes an error (see *note SET-PARALLEL-EXECUTION::).  If there is
-no error, then
-
-     (pargs (cons (expensive-fn-1 4) (expensive-fn-2 5)))
-
-expands into:
-
-     (cons (expensive-fn-1 4) (expensive-fn-2 5))
-
-One trivial way to enable parallel execution of a form is to surround it
-with a call to macro top-level.  Consider the following example.
-
-     (top-level (pargs (cons (expensive-fn-1 4) (expensive-fn-2 5))))
-
-Then in an executable image that supports parallel execution -- see
-*note COMPILING-ACL2P:: for instructions on how to build such an
-executable -- (expensive-fn-1 4) and (expensive-fn-2 5) can evaluate in
-parallel.
-
-A second way to enable parallel execution of a form is to place it
-inside a function body.  For example, consider the following definition.
-
-     (defun foo (x y)
-       (pargs (cons (expensive-fn-1 x) (expensive-fn-2 y))))
-
-Then in an executable image that supports parallel execution,
-submission of the form (foo 4 5) can cause parallel execution of
-(expensive-fn-1 4) and (expensive-fn-2 5).
-
-Note that guards need not be verified in order to obtain parallel
-execution.  The only restrictions on parallel execution are to use an
-executable supporting it, to avoid calling parallelism primitives
-directly in the top-level loop, to have sufficient resources
-(especially, threads) available, and to avoid explicitly disabling
-parallel execution (see *note SET-PARALLEL-EXECUTION::).
-
-
-File: acl2-doc-emacs.info,  Node: PARALLELISM-PERFORMANCE,  Next: PARALLELISM-TUTORIAL,  Prev: PARALLELISM-AT-THE-TOP-LEVEL,  Up: PARALLEL-PROGRAMMING
-
-PARALLELISM-PERFORMANCE    performance issues for parallel execution
-
-This documentation topic relates to the experimental extension of ACL2
-supporting parallel execution and proof; see *note PARALLELISM::.
-
-See *note GRANULARITY:: for an important construct that limits the
-spawning of parallel computations, which can be important when a
-computation is too short-lived to warrant a separate thread.
-
-There are times in which parallelism provides no speedup because of
-garbage collection in the underlying Lisp implementation.  The
-following example illustrates this phenomenon.  If you change the
-granularity declaration so that the depth bound is 3, 4, or larger
-instead of 2, you may still find no speedup.  In all cases you may find
-that parallelism results in a significantly greater time spent in
-garbage collection.
-
-     (include-book "finite-set-theory/osets/sets" :dir :system)
-     (defun sets::pmergesort-exec (x depth)
-         (declare (xargs :mode :program))
-         (cond ((endp x) nil)
-               ((endp (cdr x)) (sets::insert (car x) nil))
-               (t (mv-let (part1 part2)
-                          (sets::split-list x nil nil)
-                          (pargs
-                           (declare (granularity (< depth 2)))
-                           (sets::union (sets::pmergesort-exec part1
-                                                               (1+ depth))
-                                        (sets::pmergesort-exec part2
-                                                               (1+ depth))))))))
-     (defconst *x* (reverse (fromto 1 400000)))
-     (time$ (length (sets::pmergesort-exec *x* 0)))
-     (set-parallel-execution nil)
-     (time$ (length (sets::pmergesort-exec *x* 0)))
-
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-8 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-8
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-8	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-8	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,6 +28,533 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: PARALLEL-PROGRAMMING,  Next: PARALLEL-PROOF,  Prev: COMPILING-ACL2P,  Up: PARALLELISM
+
+PARALLEL-PROGRAMMING    parallel programming in ACL2(p)
+
+Here we document support for parallel programming in ACL2(p), an
+experimental extension of ACL2; also see *note PARALLELISM::.
+
+* Menu:
+
+* DEFLOCK:: define a wrapper macro that provides mutual exclusion in ACL2(p)
+
+* EARLY-TERMINATION:: early termination for pand and por.
+
+* ERROR-TRIPLES-AND-PARALLELISM:: how to avoid error triples in ACL2(p)
+
+* GRANULARITY:: limit the amount of parallelism
+
+* PAND:: parallel, Boolean version of and
+
+* PARALLEL-EXECUTION:: for ACL2(p): configure parallel execution
+
+* PARALLELISM-AT-THE-TOP-LEVEL:: parallel execution in the ACL2 top-level loop
+
+* PARALLELISM-PERFORMANCE:: performance issues for parallel execution
+
+* PARALLELISM-TUTORIAL:: a tutorial on how to use the parallelism library.
+
+* PARGS:: parallel evaluation of arguments in a function call
+
+* PLET:: parallel version of let
+
+* POR:: parallel, Boolean version of or
+
+* SPEC-MV-LET:: modification of mv-let supporting speculative and parallel execution
+
+* WITH-OUTPUT-LOCK:: provides a mutual-exclusion mechanism for performing output in parallel
+
+
+Related topics other than immediate subtopics:
+* SET-PARALLEL-EXECUTION:: for ACL2(p): enabling parallel execution for four parallelism primitives
+
+* SET-TOTAL-PARALLELISM-WORK-LIMIT:: for ACL2(p): set thread limit for parallelism primitives
+
+One of ACL2's strengths lies in its ability to execute industrial models
+efficiently.  The ACL2 source code provides an experimental parallel
+execution capability that can increase the speed of explicit evaluation,
+including simulator runs using such models, and it can also decrease
+the time required for proofs that make heavy use of the evaluation of
+ground terms.
+
+The parallelism primitives are plet, pargs, pand, por, and spec-mv-let.
+Pand and por terminate early when an argument is found to evaluate to
+nil or non-nil, respectively, thus potentially improving on the
+efficiency of lazy evaluation.  Spec-mv-let is a modification of mv-let
+that supports speculative and parallel execution.
+
+Of the above five parallelism primitives, all but spec-mv-let allow for
+limiting parallel execution (spawning of so-called "threads") depending
+on resource availability.  Specifically, the primitives allow
+specification of a size condition to control the granularity under
+which threads are allowed to spawn.  You can use such granularity
+declarations in recursively-defined functions to implement
+data-dependent parallelism in their execution.
+
+We recommend that in order to learn to use the parallelism primitives,
+you begin by reading examples: see *note PARALLELISM-TUTORIAL::.  That
+section will direct you to further documentation topics.
+
+In addition to providing parallel programming primitives, ACL2(p) also
+provides the ability to execute the main ACL2 proof process in parallel.
+See *note SET-WATERFALL-PARALLELISM:: for further details.
+
+
+File: acl2-doc-emacs.info,  Node: DEFLOCK,  Next: EARLY-TERMINATION,  Prev: PARALLEL-PROGRAMMING,  Up: PARALLEL-PROGRAMMING
+
+DEFLOCK    define a wrapper macro that provides mutual exclusion in ACL2(p)
+
+This documentation topic relates to the experimental extension of ACL2
+supporting parallel evaluation and proof; see *note PARALLELISM::.
+
+     Example Form:
+     (deflock *my-lock*)
+
+     General Form:
+     (deflock *symbol*)
+
+where *symbol* is a symbol whose first and last characters are both the
+character #\*.
+
+A call of this macro generates a definition of another macro, named
+with-<modified-lock-symbol>, where <modified-lock-symbol> is the given
+symbol with the leading and trailing * characters removed.  This newly
+defined macro will guarantee mutually exclusive execution when called
+in the body of the raw Lisp definition of a function, as is typically
+the case for guard-verified functions, for :program mode functions, and
+for calls of macro top-level.  (See *note GUARD-EVALUATION-TABLE:: for
+details of how raw Lisp code might not be invoked when guard-checking
+(see *note SET-GUARD-CHECKING::) has value :none or :all.)
+
+To see how mutual exclusion is guaranteed, consider the raw Lisp code
+generated for the macro, with-<modified-lock-symbol>, that is introduced
+by a call of deflock.  This code uses a lock (with the given *symbol*
+as its name), which guarantees that for any two forms that are each in
+the scope of a call of with-<modified-lock-symbol>, the forms do not
+execute concurrently.
+
+Note that a call of deflock expands into the application of progn to
+two events, as illustrated below.
+
+     ACL2 !>:trans1 (deflock *my-cw-lock*)
+      (PROGN (TABLE LOCK-TABLE '*MY-CW-LOCK* T)
+             (DEFMACRO WITH-MY-CW-LOCK (&REST ARGS)
+                       (LIST* 'WITH-LOCK '*MY-CW-LOCK* ARGS)))
+     ACL2 !>
+
+Thus, deflock forms are legal embedded event forms (see *note
+EMBEDDED-EVENT-FORM::) for books as well as encapsulate and progn
+events.
+
+The following log shows a lock in action.  Recall that locks work as
+expected in guard-verified and :program mode functions; they do not,
+however, work in :logic mode functions that have not been
+guard-verified, as illustrated below.
+
+     ACL2 !>(deflock *my-cw-lock*)
+     [[.. output omitted ..]]
+      WITH-MY-CW-LOCK
+     ACL2 !>(defun foo (n)
+              (declare (xargs :guard (natp n) :verify-guards nil))
+              (plet ((x1 (with-my-cw-lock (cw "~x0" (make-list n))))
+                     (x2 (with-my-cw-lock (cw "~x0" (make-list n)))))
+                    (and (null x1) (null x2))))
+     [[.. output omitted ..]]
+      FOO
+     ACL2 !>(foo 20)
+     (NIL NIL NIL NIL( NIL NIL NIL NIL NIL NILNIL  NIL NILNIL  NIL NILNIL
+          NIL NILNIL NIL  NIL NILNIL  NIL NIL
+     NIL      NILNIL  NIL NILNIL )
+     NIL NIL NIL NIL NIL NIL NIL NIL)
+     T
+     ACL2 !>(verify-guards foo)
+     [[.. output omitted ..]]
+      FOO
+     ACL2 !>(foo 20)
+     (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+          NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
+     (NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+          NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
+     T
+     ACL2 !>
+
+
+File: acl2-doc-emacs.info,  Node: EARLY-TERMINATION,  Next: ERROR-TRIPLES-AND-PARALLELISM,  Prev: DEFLOCK,  Up: PARALLEL-PROGRAMMING
+
+EARLY-TERMINATION    early termination for pand and por.
+
+This documentation topic relates to the experimental extension of ACL2
+supporting parallel execution and proof; see *note PARALLELISM::.
+
+The evaluation of (and expr1 expr2) returns nil if expr1 evaluates to
+nil, avoiding the evaluation of expr2.  More generally, the evaluation
+of (and expr1 expr2 ... exprk) terminates with a return value of nil as
+soon as any expri evaluates to nil -- no exprj is evaluated in this
+case for j > i.  This so-called "lazy evaluation" of and terms can thus
+save some computation; roughly speaking, the smaller the i, the more
+computation is saved.
+
+If the above call of and is replaced by its parallel version, pand,
+then there can be even more opportunity for skipping work.  The
+arguments to pand can be evaluated in parallel, in which case the first
+such evaluation that returns with a value of nil, if any, causes the
+remaining such evaluations to abort.
+
+Consider the following functions that compute whether a tree is valid
+(see *note GRANULARITY:: for a discussion of the granularity form).
+
+     (defun valid-tip (x)
+       (declare (xargs :guard t))
+       (or (eq x 'A)
+           (eq x 'T)
+           (eq x 'C)
+           (eq x 'G)))
+
+     (defun pvalid-tree (x depth)
+       (declare (xargs :guard (natp depth)))
+       (if (atom x)
+           (valid-tip x)
+         (pand (declare (granularity (< depth 10)))
+               (pvalid-tree (car x) (1+ depth))
+               (pvalid-tree (cdr x) (1+ depth)))))
+
+We would like to stop execution as soon as any tip is found to be
+invalid.  So, when computing the conjunction of terms by using pand,
+once one of those terms evaluates to nil, the computations for the
+other terms are aborted and the pand call returns nil.  By using pand,
+we can in principle attain a speedup factor greater than the number of
+available cores.
+
+The concept of early termination also applies to por, except that early
+termination occurs when an argument evaluates to non-nil.
+
+
+File: acl2-doc-emacs.info,  Node: ERROR-TRIPLES-AND-PARALLELISM,  Next: GRANULARITY,  Prev: EARLY-TERMINATION,  Up: PARALLEL-PROGRAMMING
+
+ERROR-TRIPLES-AND-PARALLELISM    how to avoid error triples in ACL2(p)
+
+This documentation topic relates to the experimental extension of ACL2
+supporting parallel execution and proof; see *note PARALLELISM::.
+
+ACL2 supports the use of error triples in many features; e.g.,
+computed-hints.  (For background on error triples, see *note
+PROGRAMMING-WITH-STATE::.)  However, ACL2(p) does not support the use of
+error triples in some of these features (e.g., computed-hints) while
+waterfall-parallelism is enabled.
+
+You may see an error message like the following when running ACL2(p)
+with waterfall-parallelism enabled:
+
+     ACL2 Error in ( THM ...):  Since we are translating a form in ACL2(p)
+     intended to be executed with waterfall parallelism enabled, the form
+     (MY-STATE-MODIFYING-COMPUTED-HINT ID STATE) was expected to represent
+     an ordinary value, not an error triple (mv erp val state), as would
+     be acceptable in a serial execution of ACL2.  Therefore, the form returning
+     a tuple of the form (* * STATE) is an error.  See :DOC unsupported-
+     waterfall-parallelism-features and :DOC error-triples-and-parallelism
+     for further explanation.
+
+In this particular example, the cause of the error was trying to use a
+computed hint that returned state, which is not allowed when executing
+the waterfall in parallel (see *note
+UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES:: for other related
+information).
+
+Often, the only reason users need to return state is so they can perform
+some output during the proof process.  In this case, we suggest using
+one of the state-free output functions, like cw or observation-cw.  If
+the user is concerned about the interleaving of their output with other
+output, these calls can be surrounded with the macro with-output-lock.
+
+Another frequent reason users return state is so they can cause a soft
+error and halt the proof process.  In this case, we suggest instead
+calling er with the hard or hard? severity.  By using these mechanisms,
+the user avoids modifying state, a requirement for much of the code
+written in ACL2(p).
+
+You may encounter other similar error messages when using
+computed-hints, custom-keyword-hints, or override-hints.  Chances are
+that you are somehow returning an error triple when an ordinary value
+is needed.  If this turns out not to be the case, please let the ACL2
+implementors know.
+
+
+File: acl2-doc-emacs.info,  Node: GRANULARITY,  Next: PAND,  Prev: ERROR-TRIPLES-AND-PARALLELISM,  Up: PARALLEL-PROGRAMMING
+
+GRANULARITY    limit the amount of parallelism
+
+This documentation topic relates to the experimental extension of ACL2
+supporting parallel execution and proof; see *note PARALLELISM::.
+
+Some function calls are on arguments whose evaluation time is long
+enough to warrant parallel execution, while others are not.  A
+granularity form can be used to make appropriate restrictions on the
+use of parallelism.
+
+For example, consider the Fibonacci function.  Experiments have
+suggested that execution time can be reduced if whenever the argument
+is less than 27, a serial version of the Fibonacci function is called.
+One way to utilize this information is to write two definitions of the
+Fibonacci function, one serial and one parallel.
+
+     (defun fib (x)
+       (declare (xargs :guard (natp x)))
+       (cond ((or (zp x) (<= x 0)) 0)
+             ((= x 1) 1)
+             (t (binary-+ (fib (- x 1))
+                          (fib (- x 2))))))
+
+     (defun pfib (x)
+       (declare (xargs :guard (natp x)))
+       (cond ((or (zp x) (<= x 0)) 0)
+             ((= x 1) 1)
+             ((< x 27) (binary-+ (fib (- x 1))
+                                 (fib (- x 2))))
+             (t (pargs (binary-+ (pfib (- x 1))
+                                 (pfib (- x 2)))))))
+
+We realize quickly that writing both of these function definitions is
+cumbersome and redundant.  This problem can be avoided by using a
+granularity declaration with a parallelism primitive.  This form ensures
+that a call is parallelized only if resources are available and the
+granularity form evaluates to a non-nil value at the time of the call.
+Below is a definition of the Fibonacci function using a granularity
+form.
+
+     (defun pfib (x)
+       (declare (xargs :guard (natp x)))
+       (cond ((or (zp x) (<= x 0)) 0)
+             ((= x 1) 1)
+             (t (pargs (declare (granularity (>= x 27)))
+                       (binary-+ (pfib (- x 1))
+                                 (pfib (- x 2)))))))
+
+A granularity form can reference an extra formal parameter that
+describes the call depth of the function the user is parallelizing.
+Consider for example the following parallel mergesort function, based
+on Davis's Ordered Sets library.  It splits the data into symmetric
+chunks for computation, so we increment the depth argument during the
+recursive call on both the car and cdr.
+
+     (include-book "finite-set-theory/osets/sets" :dir :system)
+     (defun sets::pmergesort-exec (x depth)
+       (declare (xargs :mode :program))
+       (cond ((endp x) nil)
+             ((endp (cdr x)) (sets::insert (car x) nil))
+             (t (mv-let (part1 part2)
+                        (sets::split-list x nil nil)
+                        (pargs
+                         (declare (granularity (< depth 2)))
+                         (sets::union (sets::pmergesort-exec part1
+                                                             (1+ depth))
+                                      (sets::pmergesort-exec part2
+                                                             (1+ depth))))))))
+
+A less intrusive method (i.e., not requiring an extra formal parameter
+like the depth argument just above), which however can be less
+efficient, involves analyzing the data itself for structural
+properties.  For example:
+
+     (defun some-depth-exceeds (x n)
+       (declare (xargs :guard (natp n)))
+       (if (atom x)
+           nil
+         (if (zp n)
+             t
+           (or (some-depth-exceeds (car x) (1- n))
+               (some-depth-exceeds (cdr x) (1- n))))))
+
+     (defun valid-tip (x)
+       (declare (xargs :guard t))
+       (or (eq x 'A)
+           (eq x 'T)
+           (eq x 'C)
+           (eq x 'G)))
+
+     (defun pvalid-tree (x)
+       (declare (xargs :guard t))
+       (if (atom x)
+           (valid-tip x)
+         (pand (declare (granularity (some-depth-exceeds x 3)))
+               (pvalid-tree (car x))
+               (pvalid-tree (cdr x)))))
+
+If you experiment with calls of pvalid-tree, you are likely to find that
+the "speedup" it provides over a corresponding serial version is, in
+fact, a slowdown!  The problem is likely that some-depth-exceeds is an
+expensive function to run repeatedly.  Instead of the approach above,
+it is often handy to add an extra formal parameter in order to allow
+for more efficient granularity forms, as we have done above in the
+definition of SETS::pmergesort-exec.
+
+
+File: acl2-doc-emacs.info,  Node: PAND,  Next: PARALLEL-EXECUTION,  Prev: GRANULARITY,  Up: PARALLEL-PROGRAMMING
+
+PAND    parallel, Boolean version of and
+
+This documentation topic relates to the experimental extension of ACL2
+supporting parallel execution and proof; see *note PARALLELISM::.
+
+     Example Forms:
+     (pand (subsetp-equal x y)
+           (subsetp-equal y x))
+
+     (pand (declare
+            (granularity
+             (and (> (length x) 500)
+                  (> (length y) 500))))
+            (subsetp-equal x y)
+            (subsetp-equal y x))
+
+     General Form:
+     (pand (declare (granularity expr)) ; optional granularity declaration
+           arg1 ... argN)
+
+where N >= 0 and each argi and expr are arbitrary terms.
+
+Pand evaluates its arguments in parallel.  It returns a Boolean result:
+nil if any argument evaluates to nil, else t.  Note that pand always
+returns a Boolean result, even though and can return a non-nil value
+other than t, namely the value of its last argument.  (A moment's
+reflection will make it clear that in order for por to parallelize
+efficiently, it needs to return a Boolean value; so pand returns a
+Boolean value for consistency with por.)
+
+Another difference between pand and and is that for a call of pand,
+even if an argument evaluates to nil, a subsequent argument may be
+evaluated.  Consider the following example (where cw prints a string;
+see *note CW::).
+
+     (defun bar ()
+       (pand (equal (make-list 100000) nil) ; evaluates to nil
+             (cw "hello world~%")))
+
+When (bar) is evaluated, the above arguments of pand can execute in
+parallel, causing "hello world" to be printed to the terminal.  If we
+had used and rather than pand, then since (equal (make-list 100000)
+nil) evaluates to nil, the above call of cw would be avoided and no
+such printing would take place.  Even with pand, such printing _might_
+not take place, depending on resources, timing of thread creation, and
+whether or not parallel execution is enabled (see *note
+SET-PARALLEL-EXECUTION::).
+
+Note that unlike the case for and, the definition of pand does not
+provide (consp x) as a guard to (car x) in the call of pand below:
+
+     (defun h (x)
+       (declare (xargs :guard t))
+       (pand (consp x) (equal (car x) 'foo)))
+
+As a result, guard verification will fail for the above definition.  If
+pand were replaced by and, then guard verification would succeed.
+
+See *note PARALLELISM-TUTORIAL:: for another example.  Also see *note
+PARALLELISM-AT-THE-TOP-LEVEL:: for restrictions on evaluating
+parallelism primitives from within the ACL2 top-level loop.  Finally
+see *note EARLY-TERMINATION:: to read how pand can offer more
+efficiency than and by avoiding evaluation of some of its arguments.
+
+
+File: acl2-doc-emacs.info,  Node: PARALLEL-EXECUTION,  Next: PARALLELISM-AT-THE-TOP-LEVEL,  Prev: PAND,  Up: PARALLEL-PROGRAMMING
+
+PARALLEL-EXECUTION    for ACL2(p): configure parallel execution
+
+See *note SET-PARALLEL-EXECUTION:: for how to configure parallel
+execution for calls of plet, pargs, pand, por (but not spec-mv-let).
+
+
+File: acl2-doc-emacs.info,  Node: PARALLELISM-AT-THE-TOP-LEVEL,  Next: PARALLELISM-PERFORMANCE,  Prev: PARALLEL-EXECUTION,  Up: PARALLEL-PROGRAMMING
+
+PARALLELISM-AT-THE-TOP-LEVEL    parallel execution in the ACL2 top-level loop
+
+This documentation topic relates to the experimental extension of ACL2
+supporting parallel execution and proof; see *note PARALLELISM::.
+
+Calls of parallelism primitives made explicitly in the ACL2 top-level
+loop, as opposed to inside function bodies, will never cause parallel
+execution.  Such calls will either execute with serial execution or
+will cause an error; see *note SET-PARALLEL-EXECUTION::.  For a way
+around this restriction, see *note TOP-LEVEL::.
+
+Consider for example the following call of pargs in the ACL2 top-level
+loop.  Instead of executing pargs, ACL2 macroexpands away this call,
+leaving us with serial execution of the arguments to the cons call, or
+else causes an error (see *note SET-PARALLEL-EXECUTION::).  If there is
+no error, then
+
+     (pargs (cons (expensive-fn-1 4) (expensive-fn-2 5)))
+
+expands into:
+
+     (cons (expensive-fn-1 4) (expensive-fn-2 5))
+
+One trivial way to enable parallel execution of a form is to surround it
+with a call to macro top-level.  Consider the following example.
+
+     (top-level (pargs (cons (expensive-fn-1 4) (expensive-fn-2 5))))
+
+Then in an executable image that supports parallel execution -- see
+*note COMPILING-ACL2P:: for instructions on how to build such an
+executable -- (expensive-fn-1 4) and (expensive-fn-2 5) can evaluate in
+parallel.
+
+A second way to enable parallel execution of a form is to place it
+inside a function body.  For example, consider the following definition.
+
+     (defun foo (x y)
+       (pargs (cons (expensive-fn-1 x) (expensive-fn-2 y))))
+
+Then in an executable image that supports parallel execution,
+submission of the form (foo 4 5) can cause parallel execution of
+(expensive-fn-1 4) and (expensive-fn-2 5).
+
+Note that guards need not be verified in order to obtain parallel
+execution.  The only restrictions on parallel execution are to use an
+executable supporting it, to avoid calling parallelism primitives
+directly in the top-level loop, to have sufficient resources
+(especially, threads) available, and to avoid explicitly disabling
+parallel execution (see *note SET-PARALLEL-EXECUTION::).
+
+
+File: acl2-doc-emacs.info,  Node: PARALLELISM-PERFORMANCE,  Next: PARALLELISM-TUTORIAL,  Prev: PARALLELISM-AT-THE-TOP-LEVEL,  Up: PARALLEL-PROGRAMMING
+
+PARALLELISM-PERFORMANCE    performance issues for parallel execution
+
+This documentation topic relates to the experimental extension of ACL2
+supporting parallel execution and proof; see *note PARALLELISM::.
+
+See *note GRANULARITY:: for an important construct that limits the
+spawning of parallel computations, which can be important when a
+computation is too short-lived to warrant a separate thread.
+
+There are times in which parallelism provides no speedup because of
+garbage collection in the underlying Lisp implementation.  The
+following example illustrates this phenomenon.  If you change the
+granularity declaration so that the depth bound is 3, 4, or larger
+instead of 2, you may still find no speedup.  In all cases you may find
+that parallelism results in a significantly greater time spent in
+garbage collection.
+
+     (include-book "finite-set-theory/osets/sets" :dir :system)
+     (defun sets::pmergesort-exec (x depth)
+         (declare (xargs :mode :program))
+         (cond ((endp x) nil)
+               ((endp (cdr x)) (sets::insert (car x) nil))
+               (t (mv-let (part1 part2)
+                          (sets::split-list x nil nil)
+                          (pargs
+                           (declare (granularity (< depth 2)))
+                           (sets::union (sets::pmergesort-exec part1
+                                                               (1+ depth))
+                                        (sets::pmergesort-exec part2
+                                                               (1+ depth))))))))
+     (defconst *x* (reverse (fromto 1 400000)))
+     (time$ (length (sets::pmergesort-exec *x* 0)))
+     (set-parallel-execution nil)
+     (time$ (length (sets::pmergesort-exec *x* 0)))
+
+
 File: acl2-doc-emacs.info,  Node: PARALLELISM-TUTORIAL,  Next: PARGS,  Prev: PARALLELISM-PERFORMANCE,  Up: PARALLEL-PROGRAMMING
 
 PARALLELISM-TUTORIAL    a tutorial on how to use the parallelism library.
@@ -1270,7 +1797,7 @@
 
 * CW!:: print to the comment window
 
-* DELETE-ASSOC:: modify an association list by associating a value with a key
+* DELETE-ASSOC:: remove the first pair from an association list for a given key
 
 * DELETE-ASSOC-EQ:: See *note DELETE-ASSOC::.
 
@@ -1496,6 +2023,8 @@
 
 * MOD-EXPT:: exponential function
 
+* MSG:: construct a ``message'' suitable for the ~@ directive of fmt
+
 * MUST-BE-EQUAL:: attach code for execution
 
 * MV:: returning a multiple value
@@ -1704,6 +2233,8 @@
 
 * SEVENTH:: seventh member of the list
 
+* SIGNED-BYTE-P:: recognizer for signed integers that fit in a specified bit width
+
 * SIGNUM:: indicator for positive, negative, or zero
 
 * SIXTH:: sixth member of the list
@@ -1774,6 +2305,8 @@
 
 * SYS-CALL:: make a system call to the host operating system
 
+* SYS-CALL+:: make a system call to the host OS, returning status and output
+
 * SYS-CALL-STATUS:: exit status from the preceding system call
 
 * TAKE:: initial segment of a list
@@ -1804,6 +2337,8 @@
 
 * UNION-EQUAL:: See *note UNION$::.
 
+* UNSIGNED-BYTE-P:: recognizer for natural numbers that fit in a specified bit width
+
 * UNTRANSLATE:: See *note USER-DEFINED-FUNCTIONS-TABLE::.
 
 * UPDATE-NTH:: modify a list by putting the given value at the given position
@@ -3697,7 +4232,7 @@
 
 File: acl2-doc-emacs.info,  Node: DELETE-ASSOC,  Next: DELETE-ASSOC-EQ,  Prev: CW!,  Up: ACL2-BUILT-INS
 
-DELETE-ASSOC    modify an association list by associating a value with a key
+DELETE-ASSOC    remove the first pair from an association list for a given key
 
      General Forms:
      (delete-assoc key alist)
@@ -3860,7 +4395,7 @@
      evaluated arguments as though this call is being made in the ACL2
      top-level loop, rather than in raw Lisp.  In particular, the guard
      of fn is checked, at least by default (see *note
-     SET-GUARD-CHECKING::.
+     SET-GUARD-CHECKING::).
 
 Note that in the term (ec-call (fn term1 ... termk)), only the indicated
 call of fn is made in the logic; each termi is evaluated in the normal
@@ -4077,6 +4612,9 @@
 
 ER    print an error message and "cause an error"
 
+See *note FMT:: for a general discussion of formatted printing in ACL2.
+All calls of er print formatted strings, just as is done by fmt.
+
      Example Forms:
      (er hard  'top-level "Illegal inputs, ~x0 and ~x1." a b)
      (er hard? 'top-level "Illegal inputs, ~x0 and ~x1." a b)
@@ -6443,7 +6981,7 @@
 To see the ACL2 definition of this function, see *note PF::.
 
 
-File: acl2-doc-emacs.info,  Node: MOD-EXPT,  Next: MUST-BE-EQUAL,  Prev: MOD,  Up: ACL2-BUILT-INS
+File: acl2-doc-emacs.info,  Node: MOD-EXPT,  Next: MSG,  Prev: MOD,  Up: ACL2-BUILT-INS
 
 MOD-EXPT    exponential function
 
@@ -6465,7 +7003,124 @@
 To see the ACL2 definition of this function, see *note PF::.
 
 
-File: acl2-doc-emacs.info,  Node: MUST-BE-EQUAL,  Next: MV,  Prev: MOD-EXPT,  Up: ACL2-BUILT-INS
+File: acl2-doc-emacs.info,  Node: MSG,  Next: MUST-BE-EQUAL,  Prev: MOD-EXPT,  Up: ACL2-BUILT-INS
+
+MSG    construct a "message" suitable for the ~@ directive of fmt
+
+See *note FMT:: for background on formatted printing with ACL2.
+
+We document msg precisely below, but first, we give an informal
+introduction and illustrate with an example.  Suppose you are writing a
+program that is to do some printing.  Typically, you will either pass
+the ACL2 state around (see *note PROGRAMMING-WITH-STATE::) and use
+formatted printing functions that take the state as an argument (see
+*note FMT::)), or else you might avoid using state by calling the
+utility, cw, to do you printing.  Alternatively, you might print error
+messages upon encountering illegal situations; see *note ER::.  But
+there are times where instead of printing immediately, you may prefer
+to pass messages around, for example to accumulate them before printing
+a final message.  In such cases, it may be desirable to construct
+"message" objects to pass around.
+
+For example, consider the following pair of little programs.  The first
+either performs a computation or prints an error, and the second calls
+the first on two inputs.
+
+
+     (defun invert1 (x)
+       (if (consp x)
+           (cons (cdr x) (car x))
+         (prog2$ (cw "ERROR: ~x0 expected a cons, but was given ~x1.~|"
+                     'invert1 x)
+                 nil)))
+
+     (defun invert2 (x1 x2)
+       (list (invert1 x1) (invert1 x2)))
+
+For example:
+
+
+       ACL2 !>(invert1 '(3 . 4))
+       (4 . 3)
+       ACL2 !>(invert1 'a)
+       ERROR: INVERT1 expected a cons, but was given A.
+       NIL
+       ACL2 !>(invert2 '(3 . 4) '(5 . 6))
+       ((4 . 3) (6 . 5))
+       ACL2 !>(invert2 'a 'b)
+       ERROR: INVERT1 expected a cons, but was given A.
+       ERROR: INVERT1 expected a cons, but was given B.
+       (NIL NIL)
+       ACL2 !>
+
+Notice that when there are errors, there is no attempt to explain that
+these are due to a call of invert2.  That could be fixed, of course, by
+arranging for invert2 to print its own error; but for complicated
+programs it can be awkward to coordinate printing from many sources.  So
+let's try a different approach.  This time, the first function returns
+two results.  The first result is an "error indicator" -- either a
+message object or nil -- while the second is the computed value (only of
+interest when the first result is nil).  Then the higher-level function
+can print a single error message that includes the error message(s)
+from the lower-level function, as shown below.
+
+
+     (defun invert1a (x)
+       (if (consp x)
+           (mv nil
+               (cons (cdr x) (car x)))
+         (mv (msg "ERROR: ~x0 expected a cons, but was given ~x1.~|"
+                  'invert1a x)
+             nil)))
+
+     (defun invert2a (x1 x2)
+       (mv-let (erp1 y1)
+               (invert1a x1)
+               (mv-let (erp2 y2)
+                       (invert1a x2)
+                       (if erp1
+                           (if erp2
+                               (cw "~x0 failed with two errors:~|  ~@1  ~@2"
+                                   'invert2a erp1 erp2)
+                             (cw "~x0 failed with one error:~|  ~@1"
+                                 'invert2a erp1))
+                         (if erp2
+                             (cw "~x0 failed with one error:~|  ~@1"
+                                 'invert2a erp2)
+                           (list y1 y2))))))
+
+For example:
+
+       ACL2 !>(invert2a '(3 . 4) '(5 . 6))
+       ((4 . 3) (6 . 5))
+       ACL2 !>(invert2a '(3 . 4) 'b)
+       INVERT2A failed with one error:
+         ERROR: INVERT1A expected a cons, but was given B.
+       NIL
+       ACL2 !>(invert2a 'a 'b)
+       INVERT2A failed with two errors:
+         ERROR: INVERT1A expected a cons, but was given A.
+         ERROR: INVERT1A expected a cons, but was given B.
+       NIL
+       ACL2 !>
+
+If you study the example above, you might well understand msg.  But we
+conclude with precise documentation.
+
+     General Form:
+     (msg str arg1 ... argk)
+
+where str is a string and k is at most 9.
+
+This macro returns a pair suitable for giving to the fmt directive ~@.
+Thus, suppose that #\c is bound to the value of (msg str arg1 ...
+argk), where c is a character and k is at most 9.  Then the fmt
+directive ~@c will print out the string, str, in the context of the
+alist in which the successive fmt variables #\0, #\1, ..., #\k are
+bound to the successive elements of (arg1 ... argk).
+
+
+File: acl2-doc-emacs.info,  Node: MUST-BE-EQUAL,  Next: MV,  Prev: MSG,  Up: ACL2-BUILT-INS
 
 MUST-BE-EQUAL    attach code for execution
 
@@ -7509,747 +8164,3 @@
 Or is a Common Lisp macro.  See any Common Lisp documentation for more
 information.
 
-
-File: acl2-doc-emacs.info,  Node: ORACLE-APPLY,  Next: ORACLE-APPLY-RAW,  Prev: OR,  Up: ACL2-BUILT-INS
-
-ORACLE-APPLY    call a function argument on the given list of arguments
-
-Oracle-apply evaluates its first argument to produce an ACL2 function
-symbol, FN, and then applies FN to the value of the second argument,
-which should be a true list whose length is the number of inputs for FN.
-The return value is of the form (mv call-result state).
-
-     Examples:
-     (oracle-apply 'cons '(3 4) state) = (mv '(3 . 4) <state>)
-     (oracle-apply (car '(floor foo)) (list (+ 6 7) 5) state) = (mv 2 <state>)
-
-Also see *note ORACLE-FUNCALL:: for a related utility.
-
-Note that calls of oracle-funcall and oracle-apply return two values:
-the result of the function application, and a modified state.
-
-Oracle-apply is defined in :logic mode, and in fact is guard-verified.
-However, you will not be able to prove much about this function,
-because it is defined in the logic using the acl2-oracle field of the
-ACL2 state.  The behavior described above -- i.e., making a function
-call -- takes place when the third argument is the ACL2 state, so
-during proofs (when that can never happen), a term (oracle-apply 'fn
-'...) will not simplify using a call of fn.
-
-The guard for (oracle-apply fn args state) is the term
-(oracle-apply-guard fn args state), which says the following: fn and
-args must satisfy symbolp and true-listp, respectively; fn must be a
-known function symbol other than return-last that is not untouchable
-(see *note PUSH-UNTOUCHABLE::) and has no stobj arguments (not even
-state); and the length of args must equal the arity of fn (see *note
-SIGNATURE::).  The requirement that fn be a known function symbol may
-be a bit onerous for guard verification, but this is easily overcome by
-using ec-call, for example as follows.
-
-     (defun f (x state)
-       (declare (xargs :stobjs state))
-       (ec-call (oracle-apply 'car (list x) state)))
-
-This use of ec-call will, however, cause the guard of oracle-apply to
-be checked at runtime.
-
-If the guard for oracle-apply fails to hold but there is no guard
-violation because guard-checking is suppressed (see *note
-SET-GUARD-CHECKING::), then the value returned is computed using its
-logical definition -- which, as mentioned above, uses the ACL2 oracle
--- and hence the value computed is unpredictable (indeed, the function
-argument will not actually be called).
-
-The value returned by oracle-apply is always a single value obtained by
-calling the executable counterpart of its function argument, as we now
-explain.  Consider a form (oracle-apply fn args state) that evaluates to
-(mv VAL state'), where fn evaluates to the function symbol F.  If F
-returns multiple values, then VAL is the first value computed by the
-call of F on the value of args.  More precisely, oracle-apply actually
-invokes the executable counterpart of F; thus, if args is the
-expression (list x1 ... xk), then VAL is the same as (first) value
-returned by evaluating (ec-call (F x1 x2 ... xk)).  See *note EC-CALL::.
-
-(Remark.  If you identify a need for a version of oracle-apply to return
-multiple values, we can perhaps provide such a utility; feel free to
-contact the ACL2 implementors to request it.)
-
-A subtlety is that the evaluation takes place in so-called "safe mode",
-which avoids raw Lisp errors due to calls of :program mode functions.
-The use of safe mode is unlikely to be noticed if the value of the
-first argument of oracle-apply is a :logic mode function symbol.
-However, for :program mode functions with side effects due to special
-raw Lisp code, as may be the case for built-in functions or for custom
-functions defined with active trust tags (see *note DEFTTAG::), use of
-the following function may be preferable:
-
-See *note ORACLE-APPLY-RAW:: for a much less restrictive version of
-oracle-apply, which avoids safe mode and (for example) can apply a
-function that has a definition in the host Lisp but not in the ACL2
-world.
-
-
-File: acl2-doc-emacs.info,  Node: ORACLE-APPLY-RAW,  Next: ORACLE-FUNCALL,  Prev: ORACLE-APPLY,  Up: ACL2-BUILT-INS
-
-ORACLE-APPLY-RAW    call a function argument on the given list of arguments, no restrictions
-
-See *note ORACLE-APPLY::, as we assume familiarity with that function.
-Oracle-apply-raw is a variant of oracle-apply that is untouchable, and
-hence requires a trust tag to remove the untouchability (see *note
-DEFTTAG:: and see *note REMOVE-UNTOUCHABLE::).  Unlike oracle-apply,
-oracle-apply-raw simply calls the raw Lisp function funcall to compute
-the result, without restriction: the specified :guard is t, the
-function itself is applied (not its executable counterpart), there is
-no restriction for untouchable functions or return-last, and safe mode
-is not used.  Thus, in general, oracle-apply-raw can be dangerous to
-use: any manner of error can occur!
-
-As is the case for oracle-apply, the function symbol oracle-apply-raw
-is defined in :logic mode and is guard-verified.  Oracle-apply-raw is
-logically defined to be oracle-apply; more precisely:
-
-     (oracle-apply-raw fn args state)
-     = {logical definition}
-     (ec-call (oracle-apply fn args state))
-
-
-File: acl2-doc-emacs.info,  Node: ORACLE-FUNCALL,  Next: PAIRLIS,  Prev: ORACLE-APPLY-RAW,  Up: ACL2-BUILT-INS
-
-ORACLE-FUNCALL    call a function argument on the remaining arguments
-
-Oracle-funcall evaluates its first argument to produce an ACL2 function
-symbol, and then applies that function symbol to the values of the rest
-of the arguments.  The return value is of the form (mv call-result
-state).
-
-     Examples:
-     (oracle-funcall 'cons 3 4) ==> (mv '(3 . 4) <state>)
-     (oracle-funcall (car '(floor foo bar)) (+ 6 7) 5) ==> (mv 2 <state>)
-
-Oracle-funcall is a macro; each of its calls macroexpands to a call of
-the related utility oracle-apply that takes the ACL2 state as an
-argument, as follows:
-
-     (oracle-funcall fn x1 x2 .. xk)
-
-macroexpands to
-
-     (oracle-apply fn (list x1 x2 .. xk) state)
-
-Note that calls of oracle-funcall and oracle-apply return two values:
-the result of the function application, and a modified state.
-
-See *note ORACLE-APPLY:: for details, including information about
-guards.
-
-
-File: acl2-doc-emacs.info,  Node: PAIRLIS,  Next: PAIRLIS$,  Prev: ORACLE-FUNCALL,  Up: ACL2-BUILT-INS
-
-PAIRLIS    See *note PAIRLIS$::
-
-The Common Lisp language allows its pairlis function to construct an
-alist in any order!  So we have to define our own version: See *note
-PAIRLIS$::.
-
-
-File: acl2-doc-emacs.info,  Node: PAIRLIS$,  Next: PEEK-CHAR$,  Prev: PAIRLIS,  Up: ACL2-BUILT-INS
-
-PAIRLIS$    zipper together two lists
-
-The Common Lisp language allows its pairlis function to construct an
-alist in any order!  So we have to define our own version, pairlis$.
-It returns the list of pairs obtained by consing together successive
-respective members of the given lists until the first list runs out.
-(Hence in particular, if the second argument is nil then each element
-of the first argument is paired with nil.)
-
-The guard for pairlis$ requires that its arguments are true lists.
-
-To see the ACL2 definition of this function, see *note PF::.
-
-
-File: acl2-doc-emacs.info,  Node: PEEK-CHAR$,  Next: PKG-IMPORTS,  Prev: PAIRLIS$,  Up: ACL2-BUILT-INS
-
-PEEK-CHAR$    See *note IO::.
-
-
-File: acl2-doc-emacs.info,  Node: PKG-IMPORTS,  Next: PKG-WITNESS,  Prev: PEEK-CHAR$,  Up: ACL2-BUILT-INS
-
-PKG-IMPORTS    list of symbols imported into a given package
-
-Completion Axiom (completion-of-pkg-imports):
-
-     (equal (pkg-imports x)
-            (if (stringp x)
-                (pkg-imports x)
-              nil))
-
-Guard for (pkg-imports x):
-
-     (stringp x)
-
-(Pkg-imports pkg) returns a duplicate-free list of all symbols imported
-into pkg, which should be the name of a package known to ACL2.  For
-example, suppose "MY-PKG" was created by
-
-     (defpkg "MY-PKG" '(ACL2::ABC LISP::CAR)).
-
-Then (pkg-imports "MY-PKG") equals the list (ACL2::ABC LISP::CAR).
-
-If pkg is not a string, then (pkg-imports pkg) is nil.  If pkg is a
-string but not the name of a package known to ACL2, then the value of
-the form (pkg-imports pkg) is unspecified, and it evaluation will fail
-to yield a value.  By "the symbols imported into pkg" we mean the
-symbols imported into pkg by the defpkg event that introduced pkg.
-There are no imports for built-in packages except for the "ACL2"
-package, which imports the symbols in the list value of the constant
-*common-lisp-symbols-from-main-lisp-package*.  In particular, this is
-the case for the "COMMON-LISP" package.  Users familiar with Common
-Lisp may find this surprising, since in actual Common Lisp
-implementations it is often the case that many symbols in that package
-are imported from other packages.  However, ACL2 treats all symbols in
-the constant *common-lisp-symbols-from-main-lisp-package* as having a
-symbol-package-name of "COMMON-LISP", as though they were not imported.
-ACL2 admits a symbol imported into in the "COMMON-LISP" package only if
-it belongs to that list: any attempt to read any other symbol imported
-into the "COMMON-LISP" package, or to produce such a symbol with
-intern$ or intern-in-package-of-symbol, will cause an error.
-
-The following axioms formalize properties of pkg-imports discussed above
-(use :pe to view them).
-
-     symbol-package-name-intern-in-package-of-symbol
-     intern-in-package-of-symbol-is-identity
-     symbol-listp-pkg-imports
-     no-duplicatesp-pkg-imports
-     completion-of-pkg-imports
-
-
-File: acl2-doc-emacs.info,  Node: PKG-WITNESS,  Next: PLUSP,  Prev: PKG-IMPORTS,  Up: ACL2-BUILT-INS
-
-PKG-WITNESS    return a specific symbol in the indicated package
-
-For any string pkg that names a package currently known to ACL2,
-(pkg-witness pkg) is a symbol in that package whose symbol-name is the
-value of constant *pkg-witness-name*.  Logically, this is the case even
-if the package is not currently known to ACL2.  However, if pkg-witness
-is called on a string that is not the name of a package known to ACL2,
-a hard Lisp error will result.
-
-(Pkg-witness pkg) has a guard of (and (stringp pkg) (not (equal pkg
-""))).  If pkg is not a string, then (pkg-witness pkg) is equal to
-(pkg-witness "ACL2")
-
-
-File: acl2-doc-emacs.info,  Node: PLUSP,  Next: POSITION,  Prev: PKG-WITNESS,  Up: ACL2-BUILT-INS
-
-PLUSP    test whether a number is positive
-
-(Plusp x) is true if and only if x > 0.
-
-The guard of plusp requires its argument to be a rational (real, in
-ACL2(r)) number.
-
-Plusp is a Common Lisp function.  See any Common Lisp documentation for
-more information.
-
-To see the ACL2 definition of this function, see *note PF::.
-
-
-File: acl2-doc-emacs.info,  Node: POSITION,  Next: POSITION-EQ,  Prev: PLUSP,  Up: ACL2-BUILT-INS
-
-POSITION    position of an item in a string or a list
-
-     General Forms:
-     (position x seq)
-     (position x seq :test 'eql)   ; same as above (eql as equality test)
-     (position x seq :test 'eq)    ; same, but eq is equality test
-     (position x seq :test 'equal) ; same, but equal is equality test
-
-(Position x seq) is the least index (zero-based) of the element x in
-the string or list seq, if x is an element of seq.  Otherwise (position
-x seq) is nil.  The optional keyword, :TEST, has no effect logically,
-but provides the test (default eql) used for comparing x with items of
-seq.
-
-The guard for a call of position depends on the test.  In all cases,
-the second argument must satisfy stringp or true-listp.  If the test is
-eql, then either the first argument must be suitable for eql (see *note
-EQLABLEP::) or the second argument must satisfy eqlable-listp.  If the
-test is eq, then either the first argument must be a symbol or the
-second argument must satisfy symbol-listp.
-
-See *note EQUALITY-VARIANTS:: for a discussion of the relation between
-position and its variants:
-
-     (position-eq x seq) is equivalent to (position x seq :test 'eq);
-
-     (position-equal x seq) is equivalent to (position x seq :test
-     'equal).
-
-
-In particular, reasoning about any of these primitives reduces to
-reasoning about the function position-equal.
-
-Position is defined by Common Lisp.  See any Common Lisp documentation
-for more information.
-
-
-File: acl2-doc-emacs.info,  Node: POSITION-EQ,  Next: POSITION-EQUAL,  Prev: POSITION,  Up: ACL2-BUILT-INS
-
-POSITION-EQ    See *note POSITION::.
-
-
-File: acl2-doc-emacs.info,  Node: POSITION-EQUAL,  Next: POSP,  Prev: POSITION-EQ,  Up: ACL2-BUILT-INS
-
-POSITION-EQUAL    See *note POSITION::.
-
-
-File: acl2-doc-emacs.info,  Node: POSP,  Next: PPROGN,  Prev: POSITION-EQUAL,  Up: ACL2-BUILT-INS
-
-POSP    a recognizer for the positive integers
-
-(posp x) is logically equivalent to (not (zp x)) (see *note ZP::) and
-also   to (and (natp x) (not (equal x 0))).  We recommend the community
-book   books/ordinals/natp-posp for reasoning about posp and natp.  This
- book is included by community books books/arithmetic/top and
-books/arithmetic/top-with-meta.
-
-To see the ACL2 definition of this function, see *note PF::.
-
-
-File: acl2-doc-emacs.info,  Node: PPROGN,  Next: PRINC$,  Prev: POSP,  Up: ACL2-BUILT-INS
-
-PPROGN    evaluate a sequence of forms that return state
-
-     Example Form:
-     (pprogn
-      (cond ((or (equal (car l) #\) (equal (car l) slash-char))
-             (princ$ #\ channel state))
-            (t state))
-      (princ$ (car l) channel state)
-      (mv (cdr l) state))
-
-The convention for pprogn usage is to give it a non-empty sequence of
-forms, each of which (except possibly for the last) returns state (see
-*note STATE::) as its only value.  The state returned by each but the
-last is passed on to the next.  The value or values of the last form
-are returned as the value of the pprogn.
-
-If you are using single-threaded objects you may wish to define an
-analogue of this function for your own stobj.
-
-General Form:
-
-     (PPROGN form1
-             form2
-             ...
-             formk
-             result-form)
-
-This general form is equivalent, via macro expansion, to:
-
-     (LET ((STATE form1))
-          (LET ((STATE form2))
-               ...
-               (LET ((STATE formk))
-                    result-form)))
-
-
-File: acl2-doc-emacs.info,  Node: PRINC$,  Next: PRINT-OBJECT$,  Prev: PPROGN,  Up: ACL2-BUILT-INS
-
-PRINC$    print an atom
-
-Use princ$ to do basic printing of atoms (i.e., other than cons pairs).
-In particular, princ$ prints a string without the surrounding
-double-quotes and without escaping double-quote characters within the
-string.  Note that princ$ is sensitive to the print-base, print-radix,
-and print-case; see *note SET-PRINT-BASE::, see *note
-SET-PRINT-RADIX::, and see *note SET-PRINT-CASE::.  Princ$ returns
-state.
-
-     Examples:
-     ACL2 !>(princ$ "Howdy ho" (standard-co state) state)
-     Howdy ho<state>
-     ACL2 !>(pprogn (princ$ "Howdy ho" (standard-co state) state)
-                    (newline (standard-co state) state))
-     Howdy ho
-     <state>
-     ACL2 !>(princ$ "ab\"cd" *standard-co* state)
-     ab"cd<state>
-     ACL2 !>
-     ACL2 !>(princ$ 17 *standard-co* state)
-     17<state>
-     ACL2 !>(set-print-base 16 state)
-     <state>
-     ACL2 !>(princ$ 17 *standard-co* state)
-     11<state>
-     ACL2 !>(set-print-radix t state)
-     <state>
-     ACL2 !>(princ$ 17 *standard-co* state)
-     #x11<state>
-     ACL2 !>(princ$ 'xyz *standard-co* state)
-     XYZ<state>
-     ACL2 !>(set-print-case :downcase state)
-     <state>
-     ACL2 !>(princ$ 'xyz *standard-co* state)
-     xyz<state>
-     ACL2 !>
-
-The guard for (princ$ x channel state) is essentially as follows; see
-*note IO:: for an explanation of guards of certain built-in functions
-that take state, such as princ$.
-
-     (and (or (acl2-numberp x)
-              (characterp x)
-              (stringp x)
-              (symbolp x))
-          (state-p1 state-state)
-          (symbolp channel)
-          (open-output-channel-p1 channel :character state-state))
-
-See *note FMT:: for more sophisticated printing routines, and see *note
-IO:: for general information about input and output.
-
-
-File: acl2-doc-emacs.info,  Node: PRINT-OBJECT$,  Next: PROG2$,  Prev: PRINC$,  Up: ACL2-BUILT-INS
-
-PRINT-OBJECT$    See *note IO::.
-
-
-File: acl2-doc-emacs.info,  Node: PROG2$,  Next: PROGN$,  Prev: PRINT-OBJECT$,  Up: ACL2-BUILT-INS
-
-PROG2$    execute two forms and return the value of the second one
-
-See *note HARD-ERROR::, see *note ILLEGAL::, and see *note CW:: for
-examples of functions to call in the first argument of prog2$.  Also
-see *note PROGN$:: for an extension of prog2$ that handles than two
-arguments.
-
-Semantically, (Prog2$ x y) equals y; the value of x is ignored.
-However, x is first evaluated for side effect.  Since the ACL2
-programming language is applicative, there can be no logical impact of
-evaluating x.  However, x may involve a call of a function such as
-hard-error or illegal, which can cause so-called "hard errors", or a
-call of cw to perform output.
-
-Here is a simple, contrived example using hard-error.  The intention is
-to check at run-time that the input is appropriate before calling
-function bar.
-
-     (defun foo-a (x)
-       (declare (xargs :guard (consp x)))
-       (prog2$
-        (or (good-car-p (car x))
-            (hard-error 'foo-a
-                        "Bad value for x: ~p0"
-                        (list (cons #\0 x))))
-        (bar x)))
-
-The following similar function uses illegal instead of hard-error.
-Since illegal has a guard of nil, guard verification would guarantee
-that the call of illegal below will never be made (at least when guard
-checking is on; see *note SET-GUARD-CHECKING::).
-
-     (defun foo-b (x)
-       (declare (xargs :guard (and (consp x) (good-car-p (car x)))))
-       (prog2$
-        (or (good-car-p (car x))
-            (illegal 'foo-b
-                     "Bad value for x: ~p0"
-                     (list (cons #\0 x))))
-        (bar x)))
-
-We conclude with a simple example using cw from the ACL2 sources.
-
-     (defun print-terms (terms iff-flg wrld)
-
-     ; Print untranslations of the given terms with respect to iff-flg, following
-     ; each with a newline.
-
-     ; We use cw instead of the fmt functions because we want to be able to use this
-     ; function in print-type-alist-segments (used in brkpt1), which does not return
-     ; state.
-
-       (if (endp terms)
-           terms
-         (prog2$
-          (cw "~q0" (untranslate (car terms) iff-flg wrld))
-          (print-terms (cdr terms) iff-flg wrld))))
-
-
-File: acl2-doc-emacs.info,  Node: PROGN$,  Next: PROOFS-CO,  Prev: PROG2$,  Up: ACL2-BUILT-INS
-
-PROGN$    execute a sequence of forms and return the value of the last one
-
-This macro expands to a corresponding nest of calls of prog2$; see
-*note PROG2$::.  The examples below show how this works: the first case
-below is typical, but we conclude with two special cases.
-
-     ACL2 !>:trans1 (progn$ (f1 x) (f2 x) (f3 x))
-      (PROG2$ (F1 X) (PROG2$ (F2 X) (F3 X)))
-     ACL2 !>:trans1 (progn$ (f1 x) (f2 x))
-      (PROG2$ (F1 X) (F2 X))
-     ACL2 !>:trans1 (progn$ (f1 x))
-      (F1 X)
-     ACL2 !>:trans1 (progn$)
-      NIL
-     ACL2 !>
-
-
-File: acl2-doc-emacs.info,  Node: PROOFS-CO,  Next: PROPER-CONSP,  Prev: PROGN$,  Up: ACL2-BUILT-INS
-
-PROOFS-CO    the proofs character output channel
-
-Proofs-co is an ld special (see *note LD::).  The accessor is
-(proofs-co state) and the updater is (set-proofs-co val state).
-Proofs-co must be an open character output channel.  It is to this
-channel that defun, defthm, and the other event commands print their
-commentary.
-
-"Proofs-co" stands for "proofs character output." The initial value of
-proofs-co is the same as the value of *standard-co* (see *note
-*STANDARD-CO*::).
-
-
-File: acl2-doc-emacs.info,  Node: PROPER-CONSP,  Next: PSEUDO-TERMP,  Prev: PROOFS-CO,  Up: ACL2-BUILT-INS
-
-PROPER-CONSP    recognizer for proper (null-terminated) non-empty lists
-
-Proper-consp is the function that checks whether its argument is a
-non-empty list that ends in nil.  Also see *note TRUE-LISTP::.
-
-To see the ACL2 definition of this function, see *note PF::.
-
-
-File: acl2-doc-emacs.info,  Node: PSEUDO-TERMP,  Next: PUT-ASSOC,  Prev: PROPER-CONSP,  Up: ACL2-BUILT-INS
-
-PSEUDO-TERMP    a predicate for recognizing term-like s-expressions
-
-     Example Forms:
-     (pseudo-termp '(car (cons x 'nil)))      ; has value t
-     (pseudo-termp '(car x y z))              ; also has value t!
-     (pseudo-termp '(delta (h x)))            ; has value t
-     (pseudo-termp '(delta (h x) . 7))        ; has value nil (not a true-listp)
-     (pseudo-termp '((lambda (x) (car x)) b)) ; has value t
-     (pseudo-termp '(if x y 123))             ; has value nil (123 is not quoted)
-     (pseudo-termp '(if x y '123))            ; has value t
-
-If x is the quotation of a term, then (pseudo-termp x) is t.  However,
-if x is not the quotation of a term it is not necessarily the case that
-(pseudo-termp x) is nil.
-
-See *note TERM:: for a discussion of the various meanings of the word
-"term" in ACL2.  In its most strict sense, a term is either a legal
-variable symbol, a quoted constant, or the application of an n-ary
-function symbol or closed lambda-expression to n terms.  By "legal
-variable symbol" we exclude constant symbols, such as t, nil, and
-*ts-rational*.  By "quoted constants" we include 't (aka (quote t)),
-'nil, '31, etc., and exclude constant names such as t, nil and
-*ts-rational*, unquoted constants such as 31 or 1/2, and ill-formed
-quote expressions such as (quote 3 4).  By "closed lambda expression"
-we exclude expressions, such as (lambda (x) (cons x y)), containing
-free variables in their bodies.  Terms typed by the user are translated
-into strict terms for internal use in ACL2.
-
-The predicate termp checks this strict sense of "term" with respect to
-a given ACL2 logical world; See *note WORLD::.  Many ACL2 functions,
-such as the rewriter, require certain of their arguments to satisfy
-termp.  However, as of this writing, termp is in :program mode and thus
-cannot be used effectively in conjectures to be proved.  Furthermore,
-if regarded simply from the perspective of an effective guard for a
-term-processing function, termp checks many irrelevant things.  (Does
-it really matter that the variable symbols encountered never start and
-end with an asterisk?)  For these reasons, we have introduced the
-notion of a "pseudo-term" and embodied it in the predicate
-pseudo-termp, which is easier to check, does not require the logical
-world as input, has :logic mode, and is often perfectly suitable as a
-guard on term-processing functions.
-
-A pseudo-termp is either a symbol, a true list of length 2 beginning
-with the word quote, the application of an n-ary pseudo-lambda
-expression to a true list of n pseudo-terms, or the application of a
-symbol to a true list of n pseudo-termps.  By an "n-ary pseudo-lambda
-expression" we mean an expression of the form (lambda (v1 ... vn)
-pterm), where the vi are symbols (but not necessarily distinct legal
-variable symbols) and pterm is a pseudo-termp.
-
-Metafunctions may use pseudo-termp as a guard.
-
-
-File: acl2-doc-emacs.info,  Node: PUT-ASSOC,  Next: PUT-ASSOC-EQ,  Prev: PSEUDO-TERMP,  Up: ACL2-BUILT-INS
-
-PUT-ASSOC    modify an association list by associating a value with a key
-
-     General Forms:
-     (put-assoc name val alist)
-     (put-assoc name val alist :test 'eql)   ; same as above (eql as equality test)
-     (put-assoc name val alist :test 'eq)    ; same, but eq is equality test
-     (put-assoc name val alist :test 'equal) ; same, but equal is equality test
-
-(Put-assoc name val alist) returns an alist that is the same as the list
-alist, except that the first pair in alist with a car of name is
-replaced by (cons name val), if there is one.  If there is no such
-pair, then (cons name val) is added at the end.  Note that the order of
-the keys occurring in alist is unchanged (though a new key may be
-added).
-
-The guard for a call of put-assoc depends on the test.  In all cases,
-the last argument must satisfy alistp.  If the test is eql, then either
-the first argument must be suitable for eql (see *note EQLABLEP::) or
-the last argument must satisfy eqlable-alistp.  If the test is eq, then
-either the first argument must be a symbol or the last argument must
-satisfy symbol-alistp.
-
-See *note EQUALITY-VARIANTS:: for a discussion of the relation between
-put-assoc and its variants:
-
-     (put-assoc-eq name val alist) is equivalent to (put-assoc name val
-     alist :test 'eq);
-
-     (put-assoc-equal name val alist) is equivalent to (put-assoc name
-     val alist :test 'equal).
-
-
-In particular, reasoning about any of these primitives reduces to
-reasoning about the function put-assoc-equal.
-
-
-File: acl2-doc-emacs.info,  Node: PUT-ASSOC-EQ,  Next: PUT-ASSOC-EQL,  Prev: PUT-ASSOC,  Up: ACL2-BUILT-INS
-
-PUT-ASSOC-EQ    See *note PUT-ASSOC::.
-
-
-File: acl2-doc-emacs.info,  Node: PUT-ASSOC-EQL,  Next: PUT-ASSOC-EQUAL,  Prev: PUT-ASSOC-EQ,  Up: ACL2-BUILT-INS
-
-PUT-ASSOC-EQL    See *note PUT-ASSOC::.
-
-
-File: acl2-doc-emacs.info,  Node: PUT-ASSOC-EQUAL,  Next: PUTPROP,  Prev: PUT-ASSOC-EQL,  Up: ACL2-BUILT-INS
-
-PUT-ASSOC-EQUAL    See *note PUT-ASSOC::.
-
-
-File: acl2-doc-emacs.info,  Node: PUTPROP,  Next: QUOTE,  Prev: PUT-ASSOC-EQUAL,  Up: ACL2-BUILT-INS
-
-PUTPROP    update fast property lists
-
-     General form:
-     (putprop symbol key value world-alist)
-
-See community book books/misc/getprop.lisp for an example that
-illustrates the use of ACL2 utilities getprop and putprop to take
-advantage of under-the-hood Lisp (hashed) property lists.
-
-To see the ACL2 definition of this function, see *note PF::.
-
-
-File: acl2-doc-emacs.info,  Node: QUOTE,  Next: R-EQLABLE-ALISTP,  Prev: PUTPROP,  Up: ACL2-BUILT-INS
-
-QUOTE    create a constant
-
-The form (quote x) evaluates to x.  See any Common Lisp documentation.
-
-
-File: acl2-doc-emacs.info,  Node: R-EQLABLE-ALISTP,  Next: R-SYMBOL-ALISTP,  Prev: QUOTE,  Up: ACL2-BUILT-INS
-
-R-EQLABLE-ALISTP    recognizer for a true list of pairs whose cdrs are suitable for eql
-
-The predicate r-eqlable-alistp tests whether its argument is a
-true-listp of consp objects whose cdrs all satisfy eqlablep.
-
-To see the ACL2 definition of this function, see *note PF::.
-
-
-File: acl2-doc-emacs.info,  Node: R-SYMBOL-ALISTP,  Next: RANDOM$,  Prev: R-EQLABLE-ALISTP,  Up: ACL2-BUILT-INS
-
-R-SYMBOL-ALISTP    recognizer for association lists with symbols as values
-
-(R-symbol-alistp x) is true if and only if x is a list of pairs of the
-form (cons key val) where val is a symbolp.
-
-To see the ACL2 definition of this function, see *note PF::.
-
-
-File: acl2-doc-emacs.info,  Node: RANDOM$,  Next: RASSOC,  Prev: R-SYMBOL-ALISTP,  Up: ACL2-BUILT-INS
-
-RANDOM$    obtain a random value
-
-     Example:
-     (random$ 10 state) ==> (mv 7 <state>)
-
-(Random$ limit state), where limit is a positive integer, returns a
-random non-negative integer together with a new state.  Logically, it
-simply returns the first element of a list that is a field of the ACL2
-state, called the acl2-oracle, together with the new state resulting
-from removing that element from that list.  (Except, if that element is
-not in range as specified above, then 0 is returned.)  However, random$
-actually invokes a Common Lisp function to choose the integer returned.
-Quoting from the Common Lisp HyperSpec(TM),
-`http://www.lispworks.com/documentation/HyperSpec/Front': "An
-approximately uniform choice distribution is used...  each of the
-possible results occurs with (approximate) probability 1/limit."
-
-Consider enabling rules natp-random$ and random$-linear if you want to
-reason about random$.
-
-
-File: acl2-doc-emacs.info,  Node: RASSOC,  Next: RASSOC-EQ,  Prev: RANDOM$,  Up: ACL2-BUILT-INS
-
-RASSOC    look up value in association list
-
-     General Forms:
-     (rassoc x alist)
-     (rassoc x alist :test 'eql)   ; same as above (eql as equality test)
-     (rassoc x alist :test 'eq)    ; same, but eq is equality test
-     (rassoc x alist :test 'equal) ; same, but equal is equality test
-
-(Rassoc x alist) is the first member of alist whose cdr is x, or nil if
-no such member exists.  (rassoc x alist) is thus similar to (assoc x
-alist), the difference being that it looks for the first pair in the
-given alist whose cdr, rather than car, is eql to x.  See *note
-ASSOC::.  The optional keyword, :TEST, has no effect logically, but
-provides the test (default eql) used for comparing x with the cdrs of
-successive elements of lst.
-
-The guard for a call of rassoc depends on the test.  In all cases, the
-second argument must satisfy alistp.  If the test is eql, then either
-the first argument must be suitable for eql (see *note EQLABLEP::) or
-the second argument must satisfy r-eqlable-alistp.  If the test is eq,
-then either the first argument must be a symbol or the second argument
-must satisfy r-symbol-alistp.
-
-See *note EQUALITY-VARIANTS:: for a discussion of the relation between
-rassoc and its variants:
-
-     (rassoc-eq x lst) is equivalent to (rassoc x lst :test 'eq);
-
-     (rassoc-equal x lst) is equivalent to (rassoc x lst :test 'equal).
-
-
-In particular, reasoning about any of these primitives reduces to
-reasoning about the function rassoc-equal.
-
-Rassoc is defined by Common Lisp.  See any Common Lisp documentation for
-more information.
-
-
-File: acl2-doc-emacs.info,  Node: RASSOC-EQ,  Next: RASSOC-EQUAL,  Prev: RASSOC,  Up: ACL2-BUILT-INS
-
-RASSOC-EQ    See *note RASSOC::.
-
-
-File: acl2-doc-emacs.info,  Node: RASSOC-EQUAL,  Next: RATIONAL-LISTP,  Prev: RASSOC-EQ,  Up: ACL2-BUILT-INS
-
-RASSOC-EQUAL    See *note RASSOC::.
-
-
-File: acl2-doc-emacs.info,  Node: RATIONAL-LISTP,  Next: RATIONALP,  Prev: RASSOC-EQUAL,  Up: ACL2-BUILT-INS
-
-RATIONAL-LISTP    recognizer for a true list of rational numbers
-
-The predicate rational-listp tests whether its argument is a true list
-of rational numbers.
-
-To see the ACL2 definition of this function, see *note PF::.
-
diff -Nru acl2-6.2/doc/EMACS/acl2-doc-emacs.info-9 acl2-6.3/doc/EMACS/acl2-doc-emacs.info-9
--- acl2-6.2/doc/EMACS/acl2-doc-emacs.info-9	2013-06-07 04:13:42.000000000 +0000
+++ acl2-6.3/doc/EMACS/acl2-doc-emacs.info-9	2013-09-30 17:39:45.000000000 +0000
@@ -1,7 +1,7 @@
 This is acl2-doc-emacs.info, produced by makeinfo version 4.13 from
 acl2-doc-emacs.texinfo.
 
-This is documentation for ACL2 Version 6.2
+This is documentation for ACL2 Version 6.3
 Copyright (C) 2013  University of Texas at Austin
 
 This program is free software; you can redistribute it and/or modify
@@ -28,6 +28,750 @@
 END-INFO-DIR-ENTRY
 
 
+File: acl2-doc-emacs.info,  Node: ORACLE-APPLY,  Next: ORACLE-APPLY-RAW,  Prev: OR,  Up: ACL2-BUILT-INS
+
+ORACLE-APPLY    call a function argument on the given list of arguments
+
+Oracle-apply evaluates its first argument to produce an ACL2 function
+symbol, FN, and then applies FN to the value of the second argument,
+which should be a true list whose length is the number of inputs for FN.
+The return value is of the form (mv call-result state).
+
+     Examples:
+     (oracle-apply 'cons '(3 4) state) = (mv '(3 . 4) <state>)
+     (oracle-apply (car '(floor foo)) (list (+ 6 7) 5) state) = (mv 2 <state>)
+
+Also see *note ORACLE-FUNCALL:: for a related utility.
+
+Note that calls of oracle-funcall and oracle-apply return two values:
+the result of the function application, and a modified state.
+
+Oracle-apply is defined in :logic mode, and in fact is guard-verified.
+However, you will not be able to prove much about this function,
+because it is defined in the logic using the acl2-oracle field of the
+ACL2 state.  The behavior described above -- i.e., making a function
+call -- takes place when the third argument is the ACL2 state, so
+during proofs (when that can never happen), a term (oracle-apply 'fn
+'...) will not simplify using a call of fn.
+
+The guard for (oracle-apply fn args state) is the term
+(oracle-apply-guard fn args state), which says the following: fn and
+args must satisfy symbolp and true-listp, respectively; fn must be a
+known function symbol other than return-last that is not untouchable
+(see *note PUSH-UNTOUCHABLE::) and has no stobj arguments (not even
+state); and the length of args must equal the arity of fn (see *note
+SIGNATURE::).  The requirement that fn be a known function symbol may
+be a bit onerous for guard verification, but this is easily overcome by
+using ec-call, for example as follows.
+
+     (defun f (x state)
+       (declare (xargs :stobjs state))
+       (ec-call (oracle-apply 'car (list x) state)))
+
+This use of ec-call will, however, cause the guard of oracle-apply to
+be checked at runtime.
+
+If the guard for oracle-apply fails to hold but there is no guard
+violation because guard-checking is suppressed (see *note
+SET-GUARD-CHECKING::), then the value returned is computed using its
+logical definition -- which, as mentioned above, uses the ACL2 oracle
+-- and hence the value computed is unpredictable (indeed, the function
+argument will not actually be called).
+
+The value returned by oracle-apply is always a single value obtained by
+calling the executable counterpart of its function argument, as we now
+explain.  Consider a form (oracle-apply fn args state) that evaluates to
+(mv VAL state'), where fn evaluates to the function symbol F.  If F
+returns multiple values, then VAL is the first value computed by the
+call of F on the value of args.  More precisely, oracle-apply actually
+invokes the executable counterpart of F; thus, if args is the
+expression (list x1 ... xk), then VAL is the same as (first) value
+returned by evaluating (ec-call (F x1 x2 ... xk)).  See *note EC-CALL::.
+
+(Remark.  If you identify a need for a version of oracle-apply to return
+multiple values, we can perhaps provide such a utility; feel free to
+contact the ACL2 implementors to request it.)
+
+A subtlety is that the evaluation takes place in so-called "safe mode",
+which avoids raw Lisp errors due to calls of :program mode functions.
+The use of safe mode is unlikely to be noticed if the value of the
+first argument of oracle-apply is a :logic mode function symbol.
+However, for :program mode functions with side effects due to special
+raw Lisp code, as may be the case for built-in functions or for custom
+functions defined with active trust tags (see *note DEFTTAG::), use of
+the following function may be preferable:
+
+See *note ORACLE-APPLY-RAW:: for a much less restrictive version of
+oracle-apply, which avoids safe mode and (for example) can apply a
+function that has a definition in the host Lisp but not in the ACL2
+world.
+
+
+File: acl2-doc-emacs.info,  Node: ORACLE-APPLY-RAW,  Next: ORACLE-FUNCALL,  Prev: ORACLE-APPLY,  Up: ACL2-BUILT-INS
+
+ORACLE-APPLY-RAW    call a function argument on the given list of arguments, no restrictions
+
+See *note ORACLE-APPLY::, as we assume familiarity with that function.
+Oracle-apply-raw is a variant of oracle-apply that is untouchable, and
+hence requires a trust tag to remove the untouchability (see *note
+DEFTTAG:: and see *note REMOVE-UNTOUCHABLE::).  Unlike oracle-apply,
+oracle-apply-raw simply calls the raw Lisp function funcall to compute
+the result, without restriction: the specified :guard is t, the
+function itself is applied (not its executable counterpart), there is
+no restriction for untouchable functions or return-last, and safe mode
+is not used.  Thus, in general, oracle-apply-raw can be dangerous to
+use: any manner of error can occur!
+
+As is the case for oracle-apply, the function symbol oracle-apply-raw
+is defined in :logic mode and is guard-verified.  Oracle-apply-raw is
+logically defined to be oracle-apply; more precisely:
+
+     (oracle-apply-raw fn args state)
+     = {logical definition}
+     (ec-call (oracle-apply fn args state))
+
+
+File: acl2-doc-emacs.info,  Node: ORACLE-FUNCALL,  Next: PAIRLIS,  Prev: ORACLE-APPLY-RAW,  Up: ACL2-BUILT-INS
+
+ORACLE-FUNCALL    call a function argument on the remaining arguments
+
+Oracle-funcall evaluates its first argument to produce an ACL2 function
+symbol, and then applies that function symbol to the values of the rest
+of the arguments.  The return value is of the form (mv call-result
+state).
+
+     Examples:
+     (oracle-funcall 'cons 3 4) ==> (mv '(3 . 4) <state>)
+     (oracle-funcall (car '(floor foo bar)) (+ 6 7) 5) ==> (mv 2 <state>)
+
+Oracle-funcall is a macro; each of its calls macroexpands to a call of
+the related utility oracle-apply that takes the ACL2 state as an
+argument, as follows:
+
+     (oracle-funcall fn x1 x2 .. xk)
+
+macroexpands to
+
+     (oracle-apply fn (list x1 x2 .. xk) state)
+
+Note that calls of oracle-funcall and oracle-apply return two values:
+the result of the function application, and a modified state.
+
+See *note ORACLE-APPLY:: for details, including information about
+guards.
+
+
+File: acl2-doc-emacs.info,  Node: PAIRLIS,  Next: PAIRLIS$,  Prev: ORACLE-FUNCALL,  Up: ACL2-BUILT-INS
+
+PAIRLIS    See *note PAIRLIS$::
+
+The Common Lisp language allows its pairlis function to construct an
+alist in any order!  So we have to define our own version: See *note
+PAIRLIS$::.
+
+
+File: acl2-doc-emacs.info,  Node: PAIRLIS$,  Next: PEEK-CHAR$,  Prev: PAIRLIS,  Up: ACL2-BUILT-INS
+
+PAIRLIS$    zipper together two lists
+
+The Common Lisp language allows its pairlis function to construct an
+alist in any order!  So we have to define our own version, pairlis$.
+It returns the list of pairs obtained by consing together successive
+respective members of the given lists until the first list runs out.
+(Hence in particular, if the second argument is nil then each element
+of the first argument is paired with nil.)
+
+The guard for pairlis$ requires that its arguments are true lists.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: PEEK-CHAR$,  Next: PKG-IMPORTS,  Prev: PAIRLIS$,  Up: ACL2-BUILT-INS
+
+PEEK-CHAR$    See *note IO::.
+
+
+File: acl2-doc-emacs.info,  Node: PKG-IMPORTS,  Next: PKG-WITNESS,  Prev: PEEK-CHAR$,  Up: ACL2-BUILT-INS
+
+PKG-IMPORTS    list of symbols imported into a given package
+
+Completion Axiom (completion-of-pkg-imports):
+
+     (equal (pkg-imports x)
+            (if (stringp x)
+                (pkg-imports x)
+              nil))
+
+Guard for (pkg-imports x):
+
+     (stringp x)
+
+(Pkg-imports pkg) returns a duplicate-free list of all symbols imported
+into pkg, which should be the name of a package known to ACL2.  For
+example, suppose "MY-PKG" was created by
+
+     (defpkg "MY-PKG" '(ACL2::ABC LISP::CAR)).
+
+Then (pkg-imports "MY-PKG") equals the list (ACL2::ABC LISP::CAR).
+
+If pkg is not a string, then (pkg-imports pkg) is nil.  If pkg is a
+string but not the name of a package known to ACL2, then the value of
+the form (pkg-imports pkg) is unspecified, and it evaluation will fail
+to yield a value.  By "the symbols imported into pkg" we mean the
+symbols imported into pkg by the defpkg event that introduced pkg.
+There are no imports for built-in packages except for the "ACL2"
+package, which imports the symbols in the list value of the constant
+*common-lisp-symbols-from-main-lisp-package*.  In particular, this is
+the case for the "COMMON-LISP" package.  Users familiar with Common
+Lisp may find this surprising, since in actual Common Lisp
+implementations it is often the case that many symbols in that package
+are imported from other packages.  However, ACL2 treats all symbols in
+the constant *common-lisp-symbols-from-main-lisp-package* as having a
+symbol-package-name of "COMMON-LISP", as though they were not imported.
+ACL2 admits a symbol imported into in the "COMMON-LISP" package only if
+it belongs to that list: any attempt to read any other symbol imported
+into the "COMMON-LISP" package, or to produce such a symbol with
+intern$ or intern-in-package-of-symbol, will cause an error.
+
+The following axioms formalize properties of pkg-imports discussed above
+(use :pe to view them).
+
+     symbol-package-name-intern-in-package-of-symbol
+     intern-in-package-of-symbol-is-identity
+     symbol-listp-pkg-imports
+     no-duplicatesp-pkg-imports
+     completion-of-pkg-imports
+
+
+File: acl2-doc-emacs.info,  Node: PKG-WITNESS,  Next: PLUSP,  Prev: PKG-IMPORTS,  Up: ACL2-BUILT-INS
+
+PKG-WITNESS    return a specific symbol in the indicated package
+
+For any string pkg that names a package currently known to ACL2,
+(pkg-witness pkg) is a symbol in that package whose symbol-name is the
+value of constant *pkg-witness-name*.  Logically, this is the case even
+if the package is not currently known to ACL2.  However, if pkg-witness
+is called on a string that is not the name of a package known to ACL2,
+a hard Lisp error will result.
+
+(Pkg-witness pkg) has a guard of (and (stringp pkg) (not (equal pkg
+""))).  If pkg is not a string, then (pkg-witness pkg) is equal to
+(pkg-witness "ACL2")
+
+
+File: acl2-doc-emacs.info,  Node: PLUSP,  Next: POSITION,  Prev: PKG-WITNESS,  Up: ACL2-BUILT-INS
+
+PLUSP    test whether a number is positive
+
+(Plusp x) is true if and only if x > 0.
+
+The guard of plusp requires its argument to be a rational (real, in
+ACL2(r)) number.
+
+Plusp is a Common Lisp function.  See any Common Lisp documentation for
+more information.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: POSITION,  Next: POSITION-EQ,  Prev: PLUSP,  Up: ACL2-BUILT-INS
+
+POSITION    position of an item in a string or a list
+
+     General Forms:
+     (position x seq)
+     (position x seq :test 'eql)   ; same as above (eql as equality test)
+     (position x seq :test 'eq)    ; same, but eq is equality test
+     (position x seq :test 'equal) ; same, but equal is equality test
+
+(Position x seq) is the least index (zero-based) of the element x in
+the string or list seq, if x is an element of seq.  Otherwise (position
+x seq) is nil.  The optional keyword, :TEST, has no effect logically,
+but provides the test (default eql) used for comparing x with items of
+seq.
+
+The guard for a call of position depends on the test.  In all cases,
+the second argument must satisfy stringp or true-listp.  If the test is
+eql, then either the first argument must be suitable for eql (see *note
+EQLABLEP::) or the second argument must satisfy eqlable-listp.  If the
+test is eq, then either the first argument must be a symbol or the
+second argument must satisfy symbol-listp.
+
+See *note EQUALITY-VARIANTS:: for a discussion of the relation between
+position and its variants:
+
+     (position-eq x seq) is equivalent to (position x seq :test 'eq);
+
+     (position-equal x seq) is equivalent to (position x seq :test
+     'equal).
+
+
+In particular, reasoning about any of these primitives reduces to
+reasoning about the function position-equal.
+
+Position is defined by Common Lisp.  See any Common Lisp documentation
+for more information.
+
+
+File: acl2-doc-emacs.info,  Node: POSITION-EQ,  Next: POSITION-EQUAL,  Prev: POSITION,  Up: ACL2-BUILT-INS
+
+POSITION-EQ    See *note POSITION::.
+
+
+File: acl2-doc-emacs.info,  Node: POSITION-EQUAL,  Next: POSP,  Prev: POSITION-EQ,  Up: ACL2-BUILT-INS
+
+POSITION-EQUAL    See *note POSITION::.
+
+
+File: acl2-doc-emacs.info,  Node: POSP,  Next: PPROGN,  Prev: POSITION-EQUAL,  Up: ACL2-BUILT-INS
+
+POSP    a recognizer for the positive integers
+
+(posp x) is logically equivalent to (not (zp x)) (see *note ZP::) and
+also   to (and (natp x) (not (equal x 0))).  We recommend the community
+book   books/ordinals/natp-posp for reasoning about posp and natp.  This
+ book is included by community books books/arithmetic/top and
+books/arithmetic/top-with-meta.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: PPROGN,  Next: PRINC$,  Prev: POSP,  Up: ACL2-BUILT-INS
+
+PPROGN    evaluate a sequence of forms that return state
+
+     Example Form:
+     (pprogn
+      (cond ((or (equal (car l) #\) (equal (car l) slash-char))
+             (princ$ #\ channel state))
+            (t state))
+      (princ$ (car l) channel state)
+      (mv (cdr l) state))
+
+The convention for pprogn usage is to give it a non-empty sequence of
+forms, each of which (except possibly for the last) returns state (see
+*note STATE::) as its only value.  The state returned by each but the
+last is passed on to the next.  The value or values of the last form
+are returned as the value of the pprogn.
+
+If you are using single-threaded objects you may wish to define an
+analogue of this function for your own stobj.
+
+General Form:
+
+     (PPROGN form1
+             form2
+             ...
+             formk
+             result-form)
+
+This general form is equivalent, via macro expansion, to:
+
+     (LET ((STATE form1))
+          (LET ((STATE form2))
+               ...
+               (LET ((STATE formk))
+                    result-form)))
+
+
+File: acl2-doc-emacs.info,  Node: PRINC$,  Next: PRINT-OBJECT$,  Prev: PPROGN,  Up: ACL2-BUILT-INS
+
+PRINC$    print an atom
+
+Use princ$ to do basic printing of atoms (i.e., other than cons pairs).
+In particular, princ$ prints a string without the surrounding
+double-quotes and without escaping double-quote characters within the
+string.  Note that princ$ is sensitive to the print-base, print-radix,
+and print-case; see *note SET-PRINT-BASE::, see *note
+SET-PRINT-RADIX::, and see *note SET-PRINT-CASE::.  Princ$ returns
+state.
+
+     Examples:
+     ACL2 !>(princ$ "Howdy ho" (standard-co state) state)
+     Howdy ho<state>
+     ACL2 !>(pprogn (princ$ "Howdy ho" (standard-co state) state)
+                    (newline (standard-co state) state))
+     Howdy ho
+     <state>
+     ACL2 !>(princ$ "ab\"cd" *standard-co* state)
+     ab"cd<state>
+     ACL2 !>
+     ACL2 !>(princ$ 17 *standard-co* state)
+     17<state>
+     ACL2 !>(set-print-base 16 state)
+     <state>
+     ACL2 !>(princ$ 17 *standard-co* state)
+     11<state>
+     ACL2 !>(set-print-radix t state)
+     <state>
+     ACL2 !>(princ$ 17 *standard-co* state)
+     #x11<state>
+     ACL2 !>(princ$ 'xyz *standard-co* state)
+     XYZ<state>
+     ACL2 !>(set-print-case :downcase state)
+     <state>
+     ACL2 !>(princ$ 'xyz *standard-co* state)
+     xyz<state>
+     ACL2 !>
+
+The guard for (princ$ x channel state) is essentially as follows; see
+*note IO:: for an explanation of guards of certain built-in functions
+that take state, such as princ$.
+
+     (and (or (acl2-numberp x)
+              (characterp x)
+              (stringp x)
+              (symbolp x))
+          (state-p1 state-state)
+          (symbolp channel)
+          (open-output-channel-p1 channel :character state-state))
+
+See *note FMT:: for more sophisticated printing routines, and see *note
+IO:: for general information about input and output.
+
+
+File: acl2-doc-emacs.info,  Node: PRINT-OBJECT$,  Next: PROG2$,  Prev: PRINC$,  Up: ACL2-BUILT-INS
+
+PRINT-OBJECT$    See *note IO::.
+
+
+File: acl2-doc-emacs.info,  Node: PROG2$,  Next: PROGN$,  Prev: PRINT-OBJECT$,  Up: ACL2-BUILT-INS
+
+PROG2$    execute two forms and return the value of the second one
+
+See *note HARD-ERROR::, see *note ILLEGAL::, and see *note CW:: for
+examples of functions to call in the first argument of prog2$.  Also
+see *note PROGN$:: for an extension of prog2$ that handles than two
+arguments.
+
+Semantically, (Prog2$ x y) equals y; the value of x is ignored.
+However, x is first evaluated for side effect.  Since the ACL2
+programming language is applicative, there can be no logical impact of
+evaluating x.  However, x may involve a call of a function such as
+hard-error or illegal, which can cause so-called "hard errors", or a
+call of cw to perform output.
+
+Here is a simple, contrived example using hard-error.  The intention is
+to check at run-time that the input is appropriate before calling
+function bar.
+
+     (defun foo-a (x)
+       (declare (xargs :guard (consp x)))
+       (prog2$
+        (or (good-car-p (car x))
+            (hard-error 'foo-a
+                        "Bad value for x: ~p0"
+                        (list (cons #\0 x))))
+        (bar x)))
+
+The following similar function uses illegal instead of hard-error.
+Since illegal has a guard of nil, guard verification would guarantee
+that the call of illegal below will never be made (at least when guard
+checking is on; see *note SET-GUARD-CHECKING::).
+
+     (defun foo-b (x)
+       (declare (xargs :guard (and (consp x) (good-car-p (car x)))))
+       (prog2$
+        (or (good-car-p (car x))
+            (illegal 'foo-b
+                     "Bad value for x: ~p0"
+                     (list (cons #\0 x))))
+        (bar x)))
+
+We conclude with a simple example using cw from the ACL2 sources.
+
+     (defun print-terms (terms iff-flg wrld)
+
+     ; Print untranslations of the given terms with respect to iff-flg, following
+     ; each with a newline.
+
+     ; We use cw instead of the fmt functions because we want to be able to use this
+     ; function in print-type-alist-segments (used in brkpt1), which does not return
+     ; state.
+
+       (if (endp terms)
+           terms
+         (prog2$
+          (cw "~q0" (untranslate (car terms) iff-flg wrld))
+          (print-terms (cdr terms) iff-flg wrld))))
+
+
+File: acl2-doc-emacs.info,  Node: PROGN$,  Next: PROOFS-CO,  Prev: PROG2$,  Up: ACL2-BUILT-INS
+
+PROGN$    execute a sequence of forms and return the value of the last one
+
+This macro expands to a corresponding nest of calls of prog2$; see
+*note PROG2$::.  The examples below show how this works: the first case
+below is typical, but we conclude with two special cases.
+
+     ACL2 !>:trans1 (progn$ (f1 x) (f2 x) (f3 x))
+      (PROG2$ (F1 X) (PROG2$ (F2 X) (F3 X)))
+     ACL2 !>:trans1 (progn$ (f1 x) (f2 x))
+      (PROG2$ (F1 X) (F2 X))
+     ACL2 !>:trans1 (progn$ (f1 x))
+      (F1 X)
+     ACL2 !>:trans1 (progn$)
+      NIL
+     ACL2 !>
+
+
+File: acl2-doc-emacs.info,  Node: PROOFS-CO,  Next: PROPER-CONSP,  Prev: PROGN$,  Up: ACL2-BUILT-INS
+
+PROOFS-CO    the proofs character output channel
+
+Proofs-co is an ld special (see *note LD::).  The accessor is
+(proofs-co state) and the updater is (set-proofs-co val state).
+Proofs-co must be an open character output channel.  It is to this
+channel that defun, defthm, and the other event commands print their
+commentary.
+
+"Proofs-co" stands for "proofs character output." The initial value of
+proofs-co is the same as the value of *standard-co* (see *note
+*STANDARD-CO*::).
+
+
+File: acl2-doc-emacs.info,  Node: PROPER-CONSP,  Next: PSEUDO-TERMP,  Prev: PROOFS-CO,  Up: ACL2-BUILT-INS
+
+PROPER-CONSP    recognizer for proper (null-terminated) non-empty lists
+
+Proper-consp is the function that checks whether its argument is a
+non-empty list that ends in nil.  Also see *note TRUE-LISTP::.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: PSEUDO-TERMP,  Next: PUT-ASSOC,  Prev: PROPER-CONSP,  Up: ACL2-BUILT-INS
+
+PSEUDO-TERMP    a predicate for recognizing term-like s-expressions
+
+     Example Forms:
+     (pseudo-termp '(car (cons x 'nil)))      ; has value t
+     (pseudo-termp '(car x y z))              ; also has value t!
+     (pseudo-termp '(delta (h x)))            ; has value t
+     (pseudo-termp '(delta (h x) . 7))        ; has value nil (not a true-listp)
+     (pseudo-termp '((lambda (x) (car x)) b)) ; has value t
+     (pseudo-termp '(if x y 123))             ; has value nil (123 is not quoted)
+     (pseudo-termp '(if x y '123))            ; has value t
+
+If x is the quotation of a term, then (pseudo-termp x) is t.  However,
+if x is not the quotation of a term it is not necessarily the case that
+(pseudo-termp x) is nil.
+
+See *note TERM:: for a discussion of the various meanings of the word
+"term" in ACL2.  In its most strict sense, a term is either a legal
+variable symbol, a quoted constant, or the application of an n-ary
+function symbol or closed lambda-expression to n terms.  By "legal
+variable symbol" we exclude constant symbols, such as t, nil, and
+*ts-rational*.  By "quoted constants" we include 't (aka (quote t)),
+'nil, '31, etc., and exclude constant names such as t, nil and
+*ts-rational*, unquoted constants such as 31 or 1/2, and ill-formed
+quote expressions such as (quote 3 4).  By "closed lambda expression"
+we exclude expressions, such as (lambda (x) (cons x y)), containing
+free variables in their bodies.  Terms typed by the user are translated
+into strict terms for internal use in ACL2.
+
+The predicate termp checks this strict sense of "term" with respect to
+a given ACL2 logical world; See *note WORLD::.  Many ACL2 functions,
+such as the rewriter, require certain of their arguments to satisfy
+termp.  However, as of this writing, termp is in :program mode and thus
+cannot be used effectively in conjectures to be proved.  Furthermore,
+if regarded simply from the perspective of an effective guard for a
+term-processing function, termp checks many irrelevant things.  (Does
+it really matter that the variable symbols encountered never start and
+end with an asterisk?)  For these reasons, we have introduced the
+notion of a "pseudo-term" and embodied it in the predicate
+pseudo-termp, which is easier to check, does not require the logical
+world as input, has :logic mode, and is often perfectly suitable as a
+guard on term-processing functions.
+
+A pseudo-termp is either a symbol, a true list of length 2 beginning
+with the word quote, the application of an n-ary pseudo-lambda
+expression to a true list of n pseudo-terms, or the application of a
+symbol to a true list of n pseudo-termps.  By an "n-ary pseudo-lambda
+expression" we mean an expression of the form (lambda (v1 ... vn)
+pterm), where the vi are symbols (but not necessarily distinct legal
+variable symbols) and pterm is a pseudo-termp.
+
+Metafunctions may use pseudo-termp as a guard.
+
+
+File: acl2-doc-emacs.info,  Node: PUT-ASSOC,  Next: PUT-ASSOC-EQ,  Prev: PSEUDO-TERMP,  Up: ACL2-BUILT-INS
+
+PUT-ASSOC    modify an association list by associating a value with a key
+
+     General Forms:
+     (put-assoc name val alist)
+     (put-assoc name val alist :test 'eql)   ; same as above (eql as equality test)
+     (put-assoc name val alist :test 'eq)    ; same, but eq is equality test
+     (put-assoc name val alist :test 'equal) ; same, but equal is equality test
+
+(Put-assoc name val alist) returns an alist that is the same as the list
+alist, except that the first pair in alist with a car of name is
+replaced by (cons name val), if there is one.  If there is no such
+pair, then (cons name val) is added at the end.  Note that the order of
+the keys occurring in alist is unchanged (though a new key may be
+added).
+
+The guard for a call of put-assoc depends on the test.  In all cases,
+the last argument must satisfy alistp.  If the test is eql, then either
+the first argument must be suitable for eql (see *note EQLABLEP::) or
+the last argument must satisfy eqlable-alistp.  If the test is eq, then
+either the first argument must be a symbol or the last argument must
+satisfy symbol-alistp.
+
+See *note EQUALITY-VARIANTS:: for a discussion of the relation between
+put-assoc and its variants:
+
+     (put-assoc-eq name val alist) is equivalent to (put-assoc name val
+     alist :test 'eq);
+
+     (put-assoc-equal name val alist) is equivalent to (put-assoc name
+     val alist :test 'equal).
+
+
+In particular, reasoning about any of these primitives reduces to
+reasoning about the function put-assoc-equal.
+
+
+File: acl2-doc-emacs.info,  Node: PUT-ASSOC-EQ,  Next: PUT-ASSOC-EQL,  Prev: PUT-ASSOC,  Up: ACL2-BUILT-INS
+
+PUT-ASSOC-EQ    See *note PUT-ASSOC::.
+
+
+File: acl2-doc-emacs.info,  Node: PUT-ASSOC-EQL,  Next: PUT-ASSOC-EQUAL,  Prev: PUT-ASSOC-EQ,  Up: ACL2-BUILT-INS
+
+PUT-ASSOC-EQL    See *note PUT-ASSOC::.
+
+
+File: acl2-doc-emacs.info,  Node: PUT-ASSOC-EQUAL,  Next: PUTPROP,  Prev: PUT-ASSOC-EQL,  Up: ACL2-BUILT-INS
+
+PUT-ASSOC-EQUAL    See *note PUT-ASSOC::.
+
+
+File: acl2-doc-emacs.info,  Node: PUTPROP,  Next: QUOTE,  Prev: PUT-ASSOC-EQUAL,  Up: ACL2-BUILT-INS
+
+PUTPROP    update fast property lists
+
+     General form:
+     (putprop symbol key value world-alist)
+
+See community book books/misc/getprop.lisp for an example that
+illustrates the use of ACL2 utilities getprop and putprop to take
+advantage of under-the-hood Lisp (hashed) property lists.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: QUOTE,  Next: R-EQLABLE-ALISTP,  Prev: PUTPROP,  Up: ACL2-BUILT-INS
+
+QUOTE    create a constant
+
+The form (quote x) evaluates to x.  See any Common Lisp documentation.
+
+
+File: acl2-doc-emacs.info,  Node: R-EQLABLE-ALISTP,  Next: R-SYMBOL-ALISTP,  Prev: QUOTE,  Up: ACL2-BUILT-INS
+
+R-EQLABLE-ALISTP    recognizer for a true list of pairs whose cdrs are suitable for eql
+
+The predicate r-eqlable-alistp tests whether its argument is a
+true-listp of consp objects whose cdrs all satisfy eqlablep.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: R-SYMBOL-ALISTP,  Next: RANDOM$,  Prev: R-EQLABLE-ALISTP,  Up: ACL2-BUILT-INS
+
+R-SYMBOL-ALISTP    recognizer for association lists with symbols as values
+
+(R-symbol-alistp x) is true if and only if x is a list of pairs of the
+form (cons key val) where val is a symbolp.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: RANDOM$,  Next: RASSOC,  Prev: R-SYMBOL-ALISTP,  Up: ACL2-BUILT-INS
+
+RANDOM$    obtain a random value
+
+     Example:
+     (random$ 10 state) ==> (mv 7 <state>)
+
+(Random$ limit state), where limit is a positive integer, returns a
+random non-negative integer together with a new state.  Logically, it
+simply returns the first element of a list that is a field of the ACL2
+state, called the acl2-oracle, together with the new state resulting
+from removing that element from that list.  (Except, if that element is
+not in range as specified above, then 0 is returned.)  However, random$
+actually invokes a Common Lisp function to choose the integer returned.
+Quoting from the Common Lisp HyperSpec(TM),
+`http://www.lispworks.com/documentation/HyperSpec/Front': "An
+approximately uniform choice distribution is used...  each of the
+possible results occurs with (approximate) probability 1/limit."
+
+Consider enabling rules natp-random$ and random$-linear if you want to
+reason about random$.
+
+
+File: acl2-doc-emacs.info,  Node: RASSOC,  Next: RASSOC-EQ,  Prev: RANDOM$,  Up: ACL2-BUILT-INS
+
+RASSOC    look up value in association list
+
+     General Forms:
+     (rassoc x alist)
+     (rassoc x alist :test 'eql)   ; same as above (eql as equality test)
+     (rassoc x alist :test 'eq)    ; same, but eq is equality test
+     (rassoc x alist :test 'equal) ; same, but equal is equality test
+
+(Rassoc x alist) is the first member of alist whose cdr is x, or nil if
+no such member exists.  (rassoc x alist) is thus similar to (assoc x
+alist), the difference being that it looks for the first pair in the
+given alist whose cdr, rather than car, is eql to x.  See *note
+ASSOC::.  The optional keyword, :TEST, has no effect logically, but
+provides the test (default eql) used for comparing x with the cdrs of
+successive elements of lst.
+
+The guard for a call of rassoc depends on the test.  In all cases, the
+second argument must satisfy alistp.  If the test is eql, then either
+the first argument must be suitable for eql (see *note EQLABLEP::) or
+the second argument must satisfy r-eqlable-alistp.  If the test is eq,
+then either the first argument must be a symbol or the second argument
+must satisfy r-symbol-alistp.
+
+See *note EQUALITY-VARIANTS:: for a discussion of the relation between
+rassoc and its variants:
+
+     (rassoc-eq x lst) is equivalent to (rassoc x lst :test 'eq);
+
+     (rassoc-equal x lst) is equivalent to (rassoc x lst :test 'equal).
+
+
+In particular, reasoning about any of these primitives reduces to
+reasoning about the function rassoc-equal.
+
+Rassoc is defined by Common Lisp.  See any Common Lisp documentation for
+more information.
+
+
+File: acl2-doc-emacs.info,  Node: RASSOC-EQ,  Next: RASSOC-EQUAL,  Prev: RASSOC,  Up: ACL2-BUILT-INS
+
+RASSOC-EQ    See *note RASSOC::.
+
+
+File: acl2-doc-emacs.info,  Node: RASSOC-EQUAL,  Next: RATIONAL-LISTP,  Prev: RASSOC-EQ,  Up: ACL2-BUILT-INS
+
+RASSOC-EQUAL    See *note RASSOC::.
+
+
+File: acl2-doc-emacs.info,  Node: RATIONAL-LISTP,  Next: RATIONALP,  Prev: RASSOC-EQUAL,  Up: ACL2-BUILT-INS
+
+RATIONAL-LISTP    recognizer for a true list of rational numbers
+
+The predicate rational-listp tests whether its argument is a true list
+of rational numbers.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
 File: acl2-doc-emacs.info,  Node: RATIONALP,  Next: READ-BYTE$,  Prev: RATIONAL-LISTP,  Up: ACL2-BUILT-INS
 
 RATIONALP    recognizer for rational numbers (ratios and integers)
@@ -54,14 +798,16 @@
 
 READ-RUN-TIME    read elapsed runtime
 
-(Read-run-time state) returns (mv runtime state), where runtime is the
-elapsed runtime in seconds since the start of the current ACL2 session
-and state is the resulting ACL2 state.
+By default, (read-run-time state) returns (mv runtime state), where
+runtime is the elapsed runtime in seconds since the start of the
+current ACL2 session and state is the resulting ACL2 state.  But
+read-run-time can be made to return elapsed realtime (wall clock time)
+instead; see *note GET-INTERNAL-TIME::.
 
 The logical definition probably won't concern many users, but for
 completeness, we say a word about it here.  That definition uses the
-function read-acl2-oracle, which modifies state by popping the returned
-runtime value from its acl2-oracle field.
+function read-acl2-oracle, which modifies state by popping the value to
+return from its acl2-oracle field.
 
 
 File: acl2-doc-emacs.info,  Node: REAL/RATIONALP,  Next: REALFIX,  Prev: READ-RUN-TIME,  Up: ACL2-BUILT-INS
@@ -996,14 +1742,31 @@
 modify state, by popping an entry from its acl2-oracle field.  getenv$.
 
 
-File: acl2-doc-emacs.info,  Node: SEVENTH,  Next: SIGNUM,  Prev: SETENV$,  Up: ACL2-BUILT-INS
+File: acl2-doc-emacs.info,  Node: SEVENTH,  Next: SIGNED-BYTE-P,  Prev: SETENV$,  Up: ACL2-BUILT-INS
 
 SEVENTH    seventh member of the list
 
 See any Common Lisp documentation for details.
 
 
-File: acl2-doc-emacs.info,  Node: SIGNUM,  Next: SIXTH,  Prev: SEVENTH,  Up: ACL2-BUILT-INS
+File: acl2-doc-emacs.info,  Node: SIGNED-BYTE-P,  Next: SIGNUM,  Prev: SEVENTH,  Up: ACL2-BUILT-INS
+
+SIGNED-BYTE-P    recognizer for signed integers that fit in a specified bit width
+
+(Signed-byte-p bits x) is T when bits is a positive integer and x is a
+signed integer whose 2's complement representation fits in a bit-width
+of bits, i.e., -2^(bits-1) <= x < 2^(bits-1).
+
+Note that a type-spec of (signed-byte i) for a variable x in a
+function's declare form translates to a guard condition of
+(signed-byte-p i x).
+
+The guard for signed-byte-p is T.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: SIGNUM,  Next: SIXTH,  Prev: SIGNED-BYTE-P,  Up: ACL2-BUILT-INS
 
 SIGNUM    indicator for positive, negative, or zero
 
@@ -1605,7 +2368,7 @@
 (symbolp x) is true if and only if x is a symbol.
 
 
-File: acl2-doc-emacs.info,  Node: SYS-CALL,  Next: SYS-CALL-STATUS,  Prev: SYMBOLP,  Up: ACL2-BUILT-INS
+File: acl2-doc-emacs.info,  Node: SYS-CALL,  Next: SYS-CALL+,  Prev: SYMBOLP,  Up: ACL2-BUILT-INS
 
 SYS-CALL    make a system call to the host operating system
 
@@ -1616,10 +2379,12 @@
 
 The first argument of sys-call is a command for the host operating
 system, and the second argument is a list of strings that are the
-arguments for that command.  In GCL and perhaps other lisps, you can
-put the arguments with the command; but this is not the case, for
+arguments for that command.  In GCL and perhaps some other lisps, you
+can put the arguments with the command; but this is not the case, for
 example, in Allegro CL running on Linux.
 
+For a related utility, see *note SYS-CALL+::.
+
 The use of prog2$ above is optional, but illustrates a typical sort of
 use when one wishes to get the return status.  See *note
 SYS-CALL-STATUS::.
@@ -1671,17 +2436,70 @@
 Finally, we make a comment about output redirection, which also applies
 to other related features that one may expect of a shell.  Sys-call
 does not directly support output redirection.  If you want to run a
-program, P, and redirect its output, we suggest that you create a
-wrapper script, W to call instead.  Thus W might be a shell script
-containing the line:
+program, P, and redirect its output, one option is to create a wrapper
+script, W to call instead.  Thus W might be a shell script containing
+the line:
 
      P $* >& foo.out
 
-If this sort of solution proves inadequate, please contact the ACL2
-implementors and perhaps we can come up with a solution.
+For a different, more direct solution, see *note SYS-CALL+::.
+
+
+File: acl2-doc-emacs.info,  Node: SYS-CALL+,  Next: SYS-CALL-STATUS,  Prev: SYS-CALL,  Up: ACL2-BUILT-INS
+
+SYS-CALL+    make a system call to the host OS, returning status and output
+
+     Example Form:
+     ; The following returns (mv nil s state), where s is the standard output
+     ; from the command: ls -l ./
+     (sys-call+ "ls" '("-l" "./") state)
+
+     General Form:
+     (sys-call+ cmd args state)
+
+where cmd is a command to the host operating system and args is a list
+of strings.  Also see *note SYS-CALL::; but there are two differences
+between sys-call and sys-call+.  First, the latter takes an extra
+argument, state.  Second, while sys-call returns nil, sys-call+ returns
+three values: a so-called error triple (see *note ERROR-TRIPLES::), (mv
+erp val state).  While execution returns values as described just
+below, further below we explain the logical return values.  In the
+following, please keep in mind that the exact behavior depends on the
+platform; the description is only a guide.  For example, on some
+platforms erp might always be nil, even if in the error case, and val
+might or might not include error output.  (For details, look at the
+ACL2 source code for function system-call+, whose output is converted
+by replacing an erp of nil by 0.)
+
+     Erp is either nil or a non-zero integer.  Normally, nil indicates
+     that the command ran without error, and otherwise erp is the exit
+     status.
+
+     Val is a string, typically the output generated by the call of cmd.
+
+     State is an ACL2 state.
+
+While the description above pertains to the values returned by executing
+sys-call+, the logical values are as follows.  For a discussion of the
+acl2-oracle field of an ACL2 state, see *note STATE::.
+
+     Erp is the first element of the acl2-oracle of the input state if
+     that element is a nonzero integer, and otherwise is nil.
+
+     Val is the second element of the acl2-oracle of the input state if
+     it is a string, else the empty string, "".
+
+     State is the result of popping the acl2-oracle field twice from the
+     input state.
+
+Note that unlike sys-call, a call of sys-call+ has no effect on
+subsequent calls of sys-call-status.
+
+As is the case for sys-call, a trust tag is required to call sys-call+.
+For discussion of this and more, see *note SYS-CALL::.
 
 
-File: acl2-doc-emacs.info,  Node: SYS-CALL-STATUS,  Next: TAKE,  Prev: SYS-CALL,  Up: ACL2-BUILT-INS
+File: acl2-doc-emacs.info,  Node: SYS-CALL-STATUS,  Next: TAKE,  Prev: SYS-CALL+,  Up: ACL2-BUILT-INS
 
 SYS-CALL-STATUS    exit status from the preceding system call
 
@@ -2246,22 +3064,39 @@
 UNION-EQ    See *note UNION$::.
 
 
-File: acl2-doc-emacs.info,  Node: UNION-EQUAL,  Next: UNTRANSLATE,  Prev: UNION-EQ,  Up: ACL2-BUILT-INS
+File: acl2-doc-emacs.info,  Node: UNION-EQUAL,  Next: UNSIGNED-BYTE-P,  Prev: UNION-EQ,  Up: ACL2-BUILT-INS
 
 UNION-EQUAL    See *note UNION$::.
 
 
-File: acl2-doc-emacs.info,  Node: UNTRANSLATE,  Next: UPDATE-NTH,  Prev: UNION-EQUAL,  Up: ACL2-BUILT-INS
+File: acl2-doc-emacs.info,  Node: UNSIGNED-BYTE-P,  Next: UNTRANSLATE,  Prev: UNION-EQUAL,  Up: ACL2-BUILT-INS
 
-UNTRANSLATE    See *note USER-DEFINED-FUNCTIONS-TABLE::.
+UNSIGNED-BYTE-P    recognizer for natural numbers that fit in a specified bit width
 
-
-File: acl2-doc-emacs.info,  Node: UPDATE-NTH,  Next: UPPER-CASE-P,  Prev: UNTRANSLATE,  Up: ACL2-BUILT-INS
+(Unsigned-byte-p bits x) is T when bits is a positive integer and x is
+a nonnegative integer that fits into a bit-width of bits, i.e., 0 <= x
+< 2^bits.
 
-UPDATE-NTH    modify a list by putting the given value at the given position
+Note that a type-spec of (unsigned-byte i) for a variable x in a
+function's declare form translates to a guard condition of
+(unsigned-byte-p i x).
 
-(Update-nth key val l) returns a list that is the same as the list l,
-except that the value at the 0-based position key (a natural number) is
+The guard for unsigned-byte-p is T.
+
+To see the ACL2 definition of this function, see *note PF::.
+
+
+File: acl2-doc-emacs.info,  Node: UNTRANSLATE,  Next: UPDATE-NTH,  Prev: UNSIGNED-BYTE-P,  Up: ACL2-BUILT-INS
+
+UNTRANSLATE    See *note USER-DEFINED-FUNCTIONS-TABLE::.
+
+
+File: acl2-doc-emacs.info,  Node: UPDATE-NTH,  Next: UPPER-CASE-P,  Prev: UNTRANSLATE,  Up: ACL2-BUILT-INS
+
+UPDATE-NTH    modify a list by putting the given value at the given position
+
+(Update-nth key val l) returns a list that is the same as the list l,
+except that the value at the 0-based position key (a natural number) is
 val.
 
 If key is an integer at least as large as the length of l, then l will
@@ -3969,9 +4804,9 @@
 IRRELEVANT-FORMALS    formals that are used but only insignificantly
 
 Let fn be a function of n arguments.  Let x be the ith formal of fn.
-We say x is "irrelevant in fn" if x is not involved in either the guard
-or the measure for fn, x is used in the body, but the value of (fn
-a1...ai...an) is independent of ai.
+We say x is "irrelevant in fn" if x does not occur in either the guard
+or the measure for fn, and the value of (fn a1...ai...an) is
+independent of ai.
 
 The easiest way to define a function with an irrelevant formal is
 simply not to use the formal in the body of the function.  Such formals
@@ -3985,7 +4820,7 @@
 
      (defun fact (i x)
        (declare (xargs :guard (and (integerp i) (<= 0 i))))
-       (if (zerop i) 0 (* i (fact (1- i) (cons i x))))).
+       (if (zerop i) 1 (* i (fact (1- i) (cons i x))))).
 
 Observe that x is only used in recursive calls of fact; it never "gets
 out" into the result.  ACL2 can detect some irrelevant formals by a
@@ -4001,8 +4836,8 @@
 
 The key observation above is that while x only appears in a recursive
 call, it appears in an argument position, namely i's, that is relevant.
-(The function above can be admitted with a :guard requiring both
-arguments to be nonnegative integers and the :measure (+ i x).)
+(The function above can be admitted with a :measure of (+ (nfix i)
+(nfix x)).)
 
 Establishing that a formal is irrelevant, in the sense defined above,
 can be an arbitrarily hard problem because it requires theorem proving.
@@ -4837,8 +5672,8 @@
 
 TIMINGS
 
-For how to obtain the runtime elapsed since the start of the ACL2
-session, see *note READ-RUN-TIME::.
+For how to obtain the time elapsed since the start of the ACL2 session,
+see *note READ-RUN-TIME::.
 
 For a utility for saving times into the ACL2 state and for printing
 those saved times, see the community book misc/save-time.lisp.
@@ -4898,12 +5733,15 @@
 
 TIME-TRACKER    display time spent during specified evaluation
 
-The time-tracker macro is a utility for displaying runtime (cpu time)
-spent during specified evaluation.  In general, the user provides this
-specification.  However, ACL2 itself uses this utility for tracking
-uses of its tau-system reasoning utility (see *note
-TIME-TRACKER-TAU::).  We discuss that use as an example before
-discussing the general form for calls of time-tracker.
+The time-tracker macro is a utility for displaying time spent during
+specified evaluation.  In general, the user provides this specification.
+However, ACL2 itself uses this utility for tracking uses of its
+tau-system reasoning utility (see *note TIME-TRACKER-TAU::).  We
+discuss that use as an example before discussing the general form for
+calls of time-tracker.
+
+Note that by default, the time being tracked is runtime (cpu time); to
+switch to realtime (elapsed time), see *note GET-INTERNAL-TIME::.
 
 Remark for ACL2(p) users (see *note PARALLELISM::): time-tracker is
 merely a no-op in ACL2(p).
@@ -4935,8 +5773,8 @@
 and the second is always a keyword, and such arguments evaluate to
 themselves.
 
-An ACL2 function invoked at the start of a proof includes the following
-code.
+An ACL2 function invoked at the start of a proof includes approximately
+the following code.
 
      (progn$
       (time-tracker :tau :end)
@@ -5024,7 +5862,8 @@
 We conclude with a precise discussion of all arguments.  Note that all
 arguments are evaluated; thus when we refer to an argument, we are
 discussing the value of that argument.  All times discussed are
-runtimes, i.e., cpu times.
+runtimes, i.e., cpu times, unless that default is changed; see *note
+GET-INTERNAL-TIME::.
 
      General forms:
 
@@ -5481,12 +6320,11 @@
 ACL2 supports :instructions as a hints keyword.  The following example
 forms the basis for our running example.  This example does not
 actually need hints, but imagine that the inductive step -- which is
-"Subgoal *1/2" -- was proving difficult.  You could submit that goal to
-verify, do an interactive proof, submit (exit t) to obtain the list of
-:instructions (answering with `N' at the prompt, to complete the exit),
-and then paste in those instructions.  When you submit the result
-event, you might see the following.  Below we'll explain the hint
-processing.
+"Subgoal *1/2" -- was difficult.  You could submit that goal to verify,
+do an interactive proof, submit (exit t) to obtain the list of
+:instructions, and then paste in those instructions.  When you submit
+the resulting event, you might see the following.  Below we'll explain
+the hint processing.
 
      ACL2 !>(thm (equal (append (append x y) z)
                         (append x (append y z)))
@@ -5618,13 +6456,13 @@
 trust tag (see *note DEFTTAG::) to install a trusted clause-processor,
 but that is not the case for the built-in clause-processor,
 proof-checker-cl-proc.  Finally, we note that :instructions hints are
-"spliced" in: the appropriate :clause-processor hint replaces the
-:instructions hint, and the other hints remain intact.  It may seems
-surprising that one can thus, for example, use :instructions and
-:in-theory together; but although the :in-theory hint will have no
-effect on execution of the :instructions (see first bullet above), the
-:in-theory hint will apply in the usual manner to any child goes (see
-*note HINTS-AND-THE-WATERFALL::).  End of Remark.
+"spliced" into the hints as follows: the appropriate :clause-processor
+hint replaces the :instructions hint, and the other hints remain
+intact.  It may seems surprising that one can thus, for example, use
+:instructions and :in-theory together; but although the :in-theory hint
+will have no effect on execution of the :instructions (see first bullet
+above), the :in-theory hint will apply in the usual manner to any child
+goals (see *note HINTS-AND-THE-WATERFALL::).  End of Remark.
 
 Now consider the case that the supplied instructions do not prove the
 goal.  That is, suppose that the execution of those instructions
@@ -5757,74 +6595,18 @@
                              (equal (reverse (reverse x)) x)))
      ->: bash
      ***** Now entering the theorem prover *****
-
-     [Note:  A hint was supplied for our processing of the goal above.
-     Thanks!]
-
-     This simplifies, using the :definition REVERSE and the :type-prescription
-     rule REVAPPEND, to
-
      Goal'
-     (IMPLIES (TRUE-LISTP X)
-              (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-                     X)).
-
-     But we have been asked to pretend that this goal is subsumed by the
-     yet-to-be-proved |PROOF-CHECKER Goal'|.
-
-     Q.E.D.
-
-
-     Creating one new goal:  (MAIN . 1).
-
-     The proof of the current goal, MAIN, has been completed.  However,
-     the following subgoals remain to be proved:
-       (MAIN . 1).
-     Now proving (MAIN . 1).
-     ->: th
-     *** Top-level hypotheses:
-     1. (TRUE-LISTP X)
 
-     The current subterm is:
-     (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-            X)
-     ->: 1
-     ->: sr ; show-rewrites
-
-     1. REVAPPEND-REVAPPEND (disabled)
-       New term: (REVAPPEND NIL (APPEND X NIL))
-       Hypotheses: <none>
-       Equiv: EQUAL
-
-     2. REVAPPEND
-       New term: (AND (CONSP (REVAPPEND X NIL))
-                      (REVAPPEND (CDR (REVAPPEND X NIL))
-                                 (LIST (CAR (REVAPPEND X NIL)))))
-       Hypotheses: <none>
-       Equiv: EQUAL
-     ->: (r 1) ; rewrite with rule #1 above
-     Rewriting with REVAPPEND-REVAPPEND.
-     ->: exit
-     Exiting....
-      NIL
-     ACL2 !>(verify (implies (true-listp x)
-                             (equal (reverse (reverse x)) x)))
-     ->: bash
-     ***** Now entering the theorem prover *****
-
-     [Note:  A hint was supplied for our processing of the goal above.
-     Thanks!]
-
-     This simplifies, using the :definition REVERSE and the :type-prescription
-     rule REVAPPEND, to
+     ([ A key checkpoint:
 
      Goal'
      (IMPLIES (TRUE-LISTP X)
               (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-                     X)).
+                     X))
 
-     But we have been asked to pretend that this goal is subsumed by the
-     yet-to-be-proved |PROOF-CHECKER Goal'|.
+     Goal' is subsumed by a goal yet to be proved.
+
+     ])
 
      Q.E.D.
 
@@ -5835,17 +6617,17 @@
      the following subgoals remain to be proved:
        (MAIN . 1).
      Now proving (MAIN . 1).
-     ->: th
+     ->: th ; show current goal ("th" for "theorem")
      *** Top-level hypotheses:
      1. (TRUE-LISTP X)
 
      The current subterm is:
      (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
             X)
-     ->: p
+     ->: p ; show current subterm only
      (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
             X)
-     ->: 1
+     ->: 1 ; dive to first argument
      ->: p
      (REVAPPEND (REVAPPEND X NIL) NIL)
      ->: sr ; show-rewrites
@@ -5865,30 +6647,23 @@
      Rewriting with REVAPPEND-REVAPPEND.
      ->: p
      (REVAPPEND NIL (APPEND X NIL))
-     ->: top
+     ->: top ; move to the top of the conclusion, making it the current subterm
+     ->: p
+     (EQUAL (REVAPPEND NIL (APPEND X NIL)) X)
      ->: prove ; finish the proof
      ***** Now entering the theorem prover *****
 
-     But simplification reduces this to T, using the :definition REVAPPEND,
-     the :executable-counterpart of CONSP, primitive type reasoning and
-     the :rewrite rule APPEND-TO-NIL.
-
      Q.E.D.
 
      *!*!*!*!*!*!* All goals have been proved! *!*!*!*!*!*!*
      You may wish to exit.
-     ->: (exit t) ; to get :instructions; could give name, or (exit t nil t)
+     ->: (exit t) ; the argument, t, causes :instructions to be printed
      (DEFTHM T
              (IMPLIES (TRUE-LISTP X)
                       (EQUAL (REVERSE (REVERSE X)) X))
              :INSTRUCTIONS (:BASH (:DV 1)
                                   (:REWRITE REVAPPEND-REVAPPEND)
                                   :TOP :PROVE))
-
-     ACL2 Query (ACL2-PC::EXIT):
-     Do you want to submit this event?  Possible replies are:
-     Y (Yes), R (yes and Replay commands), N (No, but exit), A (Abort exiting).
-        (Y, R, N or A):  n
       NIL
      ACL2 !>(thm
              (IMPLIES (TRUE-LISTP X)
@@ -5898,18 +6673,18 @@
                       (:BASH (:DV 1)
                              (:REWRITE REVAPPEND-REVAPPEND)
                              :TOP :PROVE))))
+     Goal'
 
-     [Note:  A hint was supplied for our processing of the goal above.
-     Thanks!]
+     Q.E.D.
 
-     But the trusted :CLAUSE-PROCESSOR function PROOF-CHECKER-CL-PROC replaces
-     this goal by T.
+     Q.E.D.
 
      Q.E.D.
 
      Summary
      Form:  ( THM ...)
      Rules: NIL
+     Hint-events: ((:CLAUSE-PROCESSOR PROOF-CHECKER-CL-PROC))
      Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 
      Proof succeeded.
@@ -6564,851 +7339,3 @@
 See the documentation for apply-linear, as al and apply-linear are
 identical.
 
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||APPLY-LINEAR,  Next: ACL2-PC||BASH,  Prev: ACL2-PC||AL,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||APPLY-LINEAR    (primitive)
-apply a linear rule
-
-     Examples:
-     (apply-linear foo)
-        -- apply the linear rule `foo'
-     (apply-linear (:linear foo))
-        -- same as above
-     (apply-linear 2)
-        -- apply the second linear rule, as displayed by show-linears
-     rewrite
-        -- apply the first rewrite rule, as displayed by show-rewrites
-     (apply-linear foo ((y 7)))
-        -- apply the linear rule foo with the substitution
-           that associates 7 to the ``free variable'' y
-     (apply-linear foo ((x 2) (y 3)) t)
-        -- apply the linear rule foo by substituting 2 and 3 for free
-           variables x and y, respectively, and also binding all other
-           free variables possible by using the current context
-           (hypotheses and governors)
-
-     General Form:
-     (apply-linear &optional rule-id substitution instantiate-free)
-
-Add a new top-level hypothesis by applying a linear rule to the current
-subterm.  The new hypothesis will be created according to the
-information provided by the show-linears (sls) command.
-
-A short name for this command is al.
-
-We assume familiarity with the proof-checker's rewrite (r) command.  In
-brief, the apply-linear command is an analogue of the rewrite command,
-but for linear rules in place of rewrite rules.  There is a significant
-difference: for the apply-linear command, instead of rewriting the
-current subterm as is done by the rewrite command, the conclusion of
-the applicable linear rule, suitably instantiated, is added as a new
-(and last) top-level hypothesis of the goal.  There is another
-significant difference: the automatic application of linear rules in
-the theorem prover is somewhat more complex than the automatic
-application of rewrite rules, so the apply-linear command may not
-correspond as closely to the prover's automatic use of a linear rule as
-the rewrite command corresponds to the prover's automatic use of a
-rewrite rule.
-
-Below, we refer freely to the documentation for the proof-checker's
-rewrite command.
-
-The rule-id is treated just as it is by the rewrite command.  If
-rule-id is a positive integer n, then the nth rule as displayed by
-show-linears is the one that is applied.  If rule-id is nil or is not
-supplied, then it is treated as the number 1.  Otherwise, rule-id
-should be either a symbol or else a :linear rune.  If a symbol is
-supplied, then any linear rule of that name may be used.
-
-Consider the following example.  Suppose that the current subterm is (<
-(g (h y)) y) and that foo is the name of the following linear rule.
-
-     (implies (true-listp x)
-              (< (g x) 15))
-
-Then the instruction (apply-linear foo) applies foo by adding a new
-hypothesis (< (g (h y)) 15).  In addition, a new goal with conclusion
-(true-listp y) is created unless the current context (top-level
-hypotheses and governors) implies (true-listp y) using only "trivial
-reasoning", just as for the rewrite command.
-
-If the rule-id argument is a number or is not supplied, then the system
-will store an instruction of the form (apply-linear name ...), where
-name is the name of a linear rule; this is in order to make it easier
-to replay instructions when there have been changes to the history.
-Except: instead of the name (whether the name is supplied or
-calculated), the system stores the rune if there is any chance of
-ambiguity.  (Formally, "ambiguity" here means that the rune being
-applied is of the form (:rewrite name . index), where index is not nil.)
-
-Speaking in general, then, an apply-linear instruction works as follows.
-
-First, a linear rule is selected according to the arguments of the
-instruction.  The selection is made as explained under "General Form"
-above.
-
-Next, a trigger term of the rule (see *note LINEAR::) is matched with
-the current subterm, i.e., a substitution unify-subst is found such
-that if one instantiates that trigger term of the rule with
-unify-subst, then one obtains the current subterm.  If this match
-fails, then the instruction fails.
-
-Next, an attempt is made to relieve (discharge) the hypotheses, possibly
-handling free variables (see *note FREE-VARIABLES::), exactly as is
-done with hypotheses when applying the proof-checker command, rewrite
-(r).
-
-Finally, the instruction is applied exactly as the rewrite instruction
-is applied, except instead of replacing the current subterm, the rule's
-instantiated conclusion is added to the end of the list of top-level
-hypotheses of the goal.
-
-Note that as for the rewrite command, the substitution argument should
-be a list whose elements have the form (variable term), where term may
-contain abbreviations.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||BASH,  Next: ACL2-PC||BDD,  Prev: ACL2-PC||APPLY-LINEAR,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||BASH    (atomic macro)
-call the ACL2 theorem prover's simplifier
-
-     Examples:
-     bash -- attempt to prove the current goal by simplification alone
-     (bash ("Subgoal 2" :by foo) ("Subgoal 1" :use bar))
-          -- attempt to prove the current goal by simplification alone,
-             with the indicated hints
-
-     General Form:
-     (bash &rest hints)
-
-Call the theorem prover's simplifier, creating a subgoal for each
-resulting goal.
-
-Notice that unlike prove, the arguments to bash are spread out, and are
-all hints.
-
-Bash is similar to reduce in that neither of these allows induction.
-But bash only allows simplification, while reduce allows processes
-eliminate-destructors, fertilize, generalize, and eliminate-irrelevance.
-
-*Remark:*  All forcing rounds will be skipped (unless there are more
-than 15 subgoals generated in the first forcing round, an injustice
-that should be rectified, but might remain unless there is pressure to
-fix it).
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||BDD,  Next: ACL2-PC||BK,  Prev: ACL2-PC||BASH,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||BDD    (atomic macro)
-prove the current goal using bdds
-
-     Examples:
-     bdd
-     (bdd :vars nil :bdd-constructors (cons) :prove t :literal :all)
-
-The general form is as shown in the latter example above, but with any
-keyword-value pairs omitted and with values as described for the :bdd
-hint; see *note HINTS::.
-
-This command simply calls the theorem prover with the indicated bdd
-hint for the top-level goal.  Note that if :prove is t (the default),
-then the proof will succeed entirely using bdds or else it will fail
-immediately.  See *note BDD::.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||BK,  Next: ACL2-PC||BOOKMARK,  Prev: ACL2-PC||BDD,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||BK    (atomic macro)
-move backward one argument in the enclosing term
-
-     Example and General Form:
-     bk
-
-For example, if the conclusion is (= x (* (- y) z)) and the current
-subterm is (* (- y) z), then after executing bk, the current subterm
-will be x.
-
-Move to the previous argument of the enclosing term.
-
-This is the same as up followed by (dive n-1), where n is the position
-of the current subterm in its parent term in the conclusion.  Thus in
-particular, the nx command fails if one is already at the top of the
-conclusion.
-
-See also up, dive, top, and bk.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||BOOKMARK,  Next: ACL2-PC||CASESPLIT,  Prev: ACL2-PC||BK,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||BOOKMARK    (macro)
-insert matching "bookends" comments
-
-     Example:
-     (bookmark final-goal)
-
-     General Form:
-     (bookmark name &rest instruction-list)
-
-Run the instructions in instruction-list (as though this were a call of
-do-all; see the documentation for do-all), but first insert a begin
-bookend with the given name and then, when the instructions have been
-completed, insert an end bookend with that same name.  See the
-documentation of comm for an explanation of bookends and how they can
-affect the display of instructions.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||CASESPLIT,  Next: ACL2-PC||CG,  Prev: ACL2-PC||BOOKMARK,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||CASESPLIT    (primitive)
-split into two cases
-
-     Example:
-     (casesplit (< x y)) -- assuming that we are at the top of the
-                            conclusion, add (< x y) as a new top-level
-                            hypothesis in the current goal, and create a
-                            subgoal identical to the current goal except
-                            that it has (not (< x y)) as a new top-level
-                            hypothesis
-
-     General Form:
-     (casesplit expr &optional use-hyps-flag do-not-flatten-flag)
-
-When the current subterm is the entire conclusion, this instruction
-adds expr as a new top-level hypothesis, and create a subgoal identical
-to the existing current goal except that it has the negation of expr as
-a new top-level hypothesis.  See also claim.  The optional arguments
-control the use of governors and the "flattening" of new hypotheses, as
-we now explain.
-
-The argument use-hyps-flag is only of interest when there are
-governors.  (To read about governors, see the documentation for the
-command hyps).  In that case, if use-hyps-flag is not supplied or is
-nil, then the description above is correct; but otherwise, it is not
-expr but rather it is (implies govs expr) that is added as a new
-top-level hypothesis (and whose negation is added as a top-level
-hypothesis for the new goal), where govs is the conjunction of the
-governors.
-
-If do-not-flatten-flag is supplied and not nil, then that is all there
-is to this command.  Otherwise (thus this is the default), when the
-claimed term (first argument) is a conjunction (and) of terms and the
-claim instruction succeeds, then each (nested) conjunct of the claimed
-term is added as a separate new top-level hypothesis.  Consider the
-following example, assuming there are no governors.
-
-     (casesplit (and (and (< x y) (integerp a)) (equal r s)) t)
-
-Three new top-level hypotheses are added to the current goal, namely (<
-x y), (integerp a), and (equal r s).  In that case, only one hypothesis
-is added to create the new goal, namely the negation of (and (< x y)
-(integerp a) (equal r s)).  If the negation of this term had been
-claimed, then it would be the other way around:  the current goal would
-get a single new hypothesis while the new goal would be created by
-adding three hypotheses.
-
-*Remark:*  It is allowed to use abbreviations in the hints.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||CG,  Next: ACL2-PC||CHANGE-GOAL,  Prev: ACL2-PC||CASESPLIT,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||CG    (macro)
-change to another goal.
-
-     Examples:
-     (cg (main . 1)) -- change to the goal (main . 1)
-     cg              -- change to the next-to-top goal
-
-     General Form:
-     (CG &OPTIONAL goal-name)
-
-Same as (change-goal goal-name t), i.e. change to the indicated and
-move the current goal to the end of the goal stack.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||CHANGE-GOAL,  Next: ACL2-PC||CL-PROC,  Prev: ACL2-PC||CG,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||CHANGE-GOAL    (primitive)
-change to another goal.
-
-     Examples:
-     (change-goal (main . 1)) -- change to the goal (main . 1)
-     change-goal              -- change to the next-to-top goal
-
-     General Form:
-     (change-goal &optional goal-name end-flg)
-
-Change to the goal with the name goal-name, i.e. make it the current
-goal.  However, if goal-name is nil or is not supplied, then it
-defaults to the next-to-top goal, i.e., the second goal in the stack of
-goals.  If end-flg is supplied and not nil, then move the current goal
-to the end of the goal stack; else merely swap it with the next-to-top
-goal.  Also see documentation for cg.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||CL-PROC,  Next: ACL2-PC||CLAIM,  Prev: ACL2-PC||CHANGE-GOAL,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||CL-PROC    (macro)
-same as clause-processor
-
-See the documentation for proof-checker command clause-processor, which
-is identical to cl-proc.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||CLAIM,  Next: ACL2-PC||CLAUSE-PROCESSOR,  Prev: ACL2-PC||CL-PROC,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||CLAIM    (atomic macro)
-add a new hypothesis
-
-     Examples:
-     (claim (< x y))   -- attempt to prove (< x y) from the current
-                          top-level hypotheses and if successful, then
-                          add (< x y) as a new top-level hypothesis in
-                          the current goal
-     (claim (< x y)
-            :otf-flg t
-            :hints (("Goal" :induct t)))
-                       -- as above, but call the prover using the
-                          indicated values for the otf-flg and hints
-     (claim (< x y) 0) -- as above, except instead of attempting to
-                          prove (< x y), create a new subgoal with the
-                          same top-level hypotheses as the current goal
-                          that has (< x y) as its conclusion
-     (claim (< x y) :hints :none)
-                       -- same as immediately above
-
-     General Form:
-     (claim expr &rest rest-args)
-
-This command creates a new subgoal with the same top-level hypotheses
-as the current goal but with a conclusion of expr.  If rest-args is a
-non-empty list headed by a non-keyword, then there will be no proof
-attempted for the new subgoal.  With that possible exception, rest-args
-should consist of keyword arguments.  The keyword argument
-:do-not-flatten controls the "flattening" of new hypotheses, just as
-with the casesplit command (as described in its documentation).  The
-remaining rest-args are used with a call the prove command on the new
-subgoal, except that if :hints is a non-nil atom, then the prover is
-not called -- rather, this is the same as the situation described
-above, where rest-args is a non-empty list headed by a non-keyword.
-
-*Remarks:*  (1) Unlike the casesplit command, the claim command is
-completely insensitive to governors. (2) It is allowed to use
-abbreviations in the hints.  (3) The keyword :none has the special role
-as a value of :hints that is shown clearly in an example above.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||CLAUSE-PROCESSOR,  Next: ACL2-PC||COMM,  Prev: ACL2-PC||CLAIM,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||CLAUSE-PROCESSOR    (atomic macro)
-use a clause-processor
-
-     Example:
-     (cl-proc :function
-              note-fact-clause-processor
-             :hint
-             '(equal a a))
-     -- Invoke the indicated clause processor function with the indicated hint
-     argument (see the beginning of community book
-     books/clause-processors/basic-examples.lisp.
-
-     General Form:
-     (cl-proc &rest cl-proc-args)
-
-Invoke a clause-processor as indicated by cl-proc-args, which is a list
-of arguments that can serve as the value of a :clause-processor hint;
-see *note HINTS::.
-
-This command calls the prove command, and hence should only be used at
-the top of the conclusion.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||COMM,  Next: ACL2-PC||COMMANDS,  Prev: ACL2-PC||CLAUSE-PROCESSOR,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||COMM    (macro)
-display instructions from the current interactive session
-
-     Examples:
-     comm
-     (comm 10)
-
-     General Form:
-     (comm &optional n)
-
-Prints out instructions in reverse order.  This is actually the same as
-(commands n t) -- or, (commands nil t) if n is not supplied.  As
-explained in the documentation for commands, the final argument of t
-causes suppression of instructions occurring between so-called
-"matching bookends," which we now explain.
-
-A "begin bookend" is an instruction of the form
-
-     (COMMENT :BEGIN x . y).
-
-Similarly, an "end bookend" is an instruction of the form
-
-     (COMMENT :END x' . y').
-
-The "name" of the first bookend is x and the "name" of the second
-bookend is x'.  When such a pair of instructions occurs in the current
-state-stack, we call them "matching bookends" provided that they have
-the same name (i.e. x equals x') and if no other begin or end bookend
-with name x occurs between them.  The idea now is that comm hides
-matching bookends together with the instructions they enclose.  Here is
-a more precise explanation of this "hiding"; probably there is no value
-in reading on!
-
-A comm instruction hides bookends in the following manner.  (So does a
-comment instruction when its second optional argument is supplied and
-non-nil.)  First, if the first argument n is supplied and not nil, then
-we consider only the last n instructions from the state-stack;
-otherwise, we consider them all.  Now the resulting list of
-instructions is replaced by the result of applying the following
-process to each pair of matching bookends:  the pair is removed,
-together with everything in between the begin and end bookend of the
-pair, and all this is replaced by the "instruction"
-
-     ("***HIDING***" :COMMENT :BEGIN name ...)
-
-where (comment begin name ...) is the begin bookend of the pair.
-Finally, after applying this process to each pair of matching bookends,
-each begin bookend of the form (comment begin name ...)  that remains
-is replaced by
-
-     ("***UNFINISHED***" :COMMENT :BEGIN name ...) .
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||COMMANDS,  Next: ACL2-PC||COMMENT,  Prev: ACL2-PC||COMM,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||COMMANDS    (macro)
-display instructions from the current interactive session
-
-     Examples:
-     commands
-     (commands 10 t)
-
-     General Forms:
-
-     commands or (commands nil)
-     Print out all the instructions (in the current state-stack) in
-     reverse order, i.e. from the most recent instruction to the starting
-     instruction.
-
-     (commands n) [n a positive integer]
-     Print out the most recent n instructions (in the current
-     state-stack), in reverse order.
-
-     (commands x abbreviate-flag)
-     Same as above, but if abbreviate-flag is non-NIL, then do not
-     display commands between ``matching bookends''.  See documentation
-     for comm for an explanation of matching bookends.
-
-*Remark*:  If there are more than n instructions in the state-stack,
-then (commands n) is the same as commands (and also, (commands n abb)
-is the same as (commands nil abb)).
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||COMMENT,  Next: ACL2-PC||CONTRADICT,  Prev: ACL2-PC||COMMANDS,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||COMMENT    (primitive)
-insert a comment
-
-     Example:
-     (comment now begin difficult final goal)
-
-     General Form:
-     (comment &rest x)
-
-This instruction makes no change in the state except to insert the
-comment instruction.
-
-Some comments can be used to improve the display of commands; see
-documentation for comm.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||CONTRADICT,  Next: ACL2-PC||CONTRAPOSE,  Prev: ACL2-PC||COMMENT,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||CONTRADICT    (macro)
-same as contrapose
-
-see documentation for contrapose
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||CONTRAPOSE,  Next: ACL2-PC||DEMOTE,  Prev: ACL2-PC||CONTRADICT,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||CONTRAPOSE    (primitive)
-switch a hypothesis with the conclusion, negating both
-
-     Example:
-     (contrapose 3)
-
-     General Form:
-     (contrapose &optional n)
-
-The (optional) argument n should be a positive integer that does not
-exceed the number of hypotheses.  Negate the current conclusion and
-make it the nth hypothesis, while negating the current nth hypothesis
-and making it the current conclusion.  If no argument is supplied then
-the effect is the same as for (contrapose 1).
-
-*Remark:* By "negate" we mean an operation that replaces nil by t, x by
-nil for any other explicit value x, (not x) by x, and any other x by
-(not x).
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||DEMOTE,  Next: ACL2-PC||DIVE,  Prev: ACL2-PC||CONTRAPOSE,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||DEMOTE    (primitive)
-move top-level hypotheses to the conclusion
-
-     Examples:
-     demote        -- demote all top-level hypotheses
-     (demote 3 5)  -- demote hypotheses 3 and 5
-
-For example, if the top-level hypotheses are x and y and the conclusion
-is z, then after execution of demote, the conclusion will be (implies
-(and x y) z) and there will be no (top-level) hypotheses.
-
-     General Form:
-     (demote &rest hyps-indices)
-
-Eliminate the indicated (top-level) hypotheses, but replace the
-conclusion conc with (implies hyps conc) where hyps is the conjunction
-of the hypotheses that were eliminated.  If no arguments are supplied,
-then all hypotheses are demoted, i.e. demote is the same as (demote 1 2
-... n) where n is the number of top-level hypotheses.
-
-*Remark*:  You must be at the top of the conclusion in order to use
-this command.  Otherwise, first invoke top.  Also, demote fails if
-there are no top-level hypotheses or if indices are supplied that are
-out of range.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||DIVE,  Next: ACL2-PC||DO-ALL,  Prev: ACL2-PC||DEMOTE,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||DIVE    (primitive)
-move to the indicated subterm
-
-     Examples:
-     (DIVE 1)    -- assign the new current subterm to be the first
-                    argument of the existing current subterm
-     (DIVE 1 2)  -- assign the new current subterm to be the result of
-                    first taking the 1st argument of the existing
-                    current subterm, and then the 2nd argument of that
-
-For example, if the current subterm is
-
-     (* (+ a b) c),
-
-then after (dive 1) it is
-
-     (+ a b).
-
-If after that, then (dive 2) is invoked, the new current subterm will be
-
-     b.
-
-Instead of (dive 1) followed by (dive 2), the same current subterm
-could be obtained by instead submitting the single instruction (dive 1
-2).
-
-     General Form:
-     (dive &rest naturals-list)
-
-If naturals-list is a non-empty list (n_1 ... n_k) of natural numbers,
-let the new current subterm be the result of selecting the n_1-st
-argument of the current subterm, and then the n_2-th subterm of that,
-..., finally the n_k-th subterm.
-
-*Remark:*  Dive is related to the command pp, in that the diving is
-done according to raw (translated, internal form) syntax.  Use the
-command dv if you want to dive according to the syntax displayed by the
-command p.  Note that (dv n) can be abbreviated by simply n.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||DO-ALL,  Next: ACL2-PC||DO-ALL-NO-PROMPT,  Prev: ACL2-PC||DIVE,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||DO-ALL    (macro)
-run the given instructions
-
-     Example:
-     (do-all induct p prove)
-
-     General Form:
-     (do-all &rest instruction-list)
-
-Run the indicated instructions until there is a hard "failure".  The
-instruction "succeeds" if and only if each instruction in
-instruction-list does.  (See the documentation for sequence for an
-explanation of "success" and "failure.")  As each instruction is
-executed, the system will print the usual prompt followed by that
-instruction, unless the global state variable
-pc-print-prompt-and-instr-flg is nil.
-
-*Remark:*  If do-all "fails", then the failure is hard if and only if
-the last instruction it runs has a hard "failure".
-
-Obscure point:  For the record, (do-all ins_1 ins_2 ... ins_k) is the
-same as (sequence (ins_1 ins_2 ... ins_k)).
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||DO-ALL-NO-PROMPT,  Next: ACL2-PC||DO-STRICT,  Prev: ACL2-PC||DO-ALL,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||DO-ALL-NO-PROMPT    (macro)
-run the given instructions, halting once there is a "failure"
-
-     Example:
-     (do-all-no-prompt induct p prove)
-
-     General Form:
-     (do-all-no-prompt &rest instruction-list)
-
-Do-all-no-prompt is the same as do-all, except that the prompt and
-instruction are not printed each time, regardless of the value of
-pc-print-prompt-and-instr-flg.  Also, restoring is disabled.  See the
-documentation for do-all.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||DO-STRICT,  Next: ACL2-PC||DROP,  Prev: ACL2-PC||DO-ALL-NO-PROMPT,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||DO-STRICT    (macro)
-run the given instructions, halting once there is a "failure"
-
-     Example:
-     (do-strict induct p prove)
-
-     General Form:
-     (do-strict &rest instruction-list)
-
-Run the indicated instructions until there is a (hard or soft)
-"failure".  In fact do-strict is identical in effect to do-all, except
-that do-all only halts once there is a hard "failure".  See the
-documentation for do-all.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||DROP,  Next: ACL2-PC||DV,  Prev: ACL2-PC||DO-STRICT,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||DROP    (primitive)
-drop top-level hypotheses
-
-     Examples:
-     (drop 2 3) -- drop the second and third hypotheses
-     drop       -- drop all top-level hypotheses
-
-     General Forms:
-     (drop n1 n2 ...) -- Drop the hypotheses with the indicated indices.
-
-     drop             -- Drop all the top-level hypotheses.
-
-*Remark:*  If there are no top-level hypotheses, then the instruction
-drop will fail.  If any of the indices is out of range, i.e. is not an
-integer between one and the number of top-level hypotheses (inclusive),
-then (drop n1 n2 ...) will fail.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||DV,  Next: ACL2-PC||ELIM,  Prev: ACL2-PC||DROP,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||DV    (atomic macro)
-move to the indicated subterm
-
-     Examples:
-     (dv 1)    -- assign the new current subterm to be the first argument
-                  of the existing current subterm
-     (dv 1 2)  -- assign the new current subterm to be the result of
-                  first taking the 1st argument of the existing
-                  current subterm, and then the 2nd argument of that
-
-For example, if the current subterm is
-
-     (* (+ a b) c),
-
-then after (dv 1) it is
-
-     (+ a b).
-
-If after that, then (dv 2) is invoked, the new current subterm will be
-
-     b.
-
-Instead of (dv 1) followed by (dv 2), the same current subterm could be
-obtained by instead submitting the single instruction (dv 1 2).
-
-     General Form:
-     (dv &rest naturals-list)
-
-If naturals-list is a non-empty list (n_1 ... n_k) of natural numbers,
-let the new current subterm be the result of selecting the n_1-st
-argument of the current subterm, and then the n_2-th subterm of that,
-..., finally the n_k-th subterm.
-
-*Remark:*  (dv n) may be abbreviated by simply n, so we could have
-typed 1 instead of (dv 1) in the first example above.
-
-*Remark:*  See also dive, which is related to the command pp, in that
-the diving is done according to raw (translated, internal form) syntax.
-Use the command dv if you want to dive according to the syntax
-displayed by the command p.  Thus, the command "up" is the inverse of
-dive, not of dv.  The following example illustrates this point.
-
-     ACL2 !>(verify (equal (* a b c) x))
-     ->: p ; print user-level term
-     (EQUAL (* A B C) X)
-     ->: pp ; print internal-form (translated) term
-     (EQUAL (BINARY-* A (BINARY-* B C)) X)
-     ->: exit
-     Exiting....
-      NIL
-     ACL2 !>(verify (equal (* a b c) x))
-     ->: p
-     (EQUAL (* A B C) X)
-     ->: 1 ; same as (dv 1)
-     ->: p ; print user-level term
-     (* A B C)
-     ->: pp ; print internal-form (translated) term
-     (BINARY-* A (BINARY-* B C))
-     ->: 3 ; dive to third argument of (* A B C)
-     ->: p
-     C
-     ->: up ; go up one level in (BINARY-* A (BINARY-* B C))
-     ->: p
-     (* B C)
-     ->: pp
-     (BINARY-* B C)
-     ->:
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||ELIM,  Next: ACL2-PC||EQUIV,  Prev: ACL2-PC||DV,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||ELIM    (atomic macro)
-call the ACL2 theorem prover's elimination process
-
-     Example and General Form:
-     elim
-
-Upon running the elim command, the system will create a subgoal will be
-created for each goal that would have been pushed for proof by
-induction in an ordinary proof, where *only* elimination is used; not
-even simplification is used!
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||EQUIV,  Next: ACL2-PC||EX,  Prev: ACL2-PC||ELIM,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||EQUIV    (primitive)
-attempt an equality (or congruence-based) substitution
-
-     Examples:
-     (equiv (* x y) 3) -- replace (* x y) by 3 everywhere inside the
-                          current subterm, if their equality is among the
-                          top-level hypotheses or the governors
-     (equiv x t iff)   -- replace x by t everywhere inside the current
-                          subterm, where only propositional equivalence
-                          needs to be maintained at each occurrence of x
-
-     General form:
-     (equiv old new &optional relation)
-
-Substitute new for old everywhere inside the current subterm, provided
-that either (relation old new) or (relation new old) is among the
-top-level hypotheses or the governors (possibly by way of backchaining
-and/or refinement; see below).  If relation is nil or is not supplied,
-then it defaults to equal.  See also the command =, which is much more
-flexible.  Note that this command fails if no substitution is actually
-made.
-
-*Remark:*  No substitution takes place inside explicit values.  So for
-example, the instruction (equiv 3 x) will cause 3 to be replaced by x
-if the current subterm is, say, (* 3 y), but not if the current subterm
-is (* 4 y) even though 4 = (1+ 3).
-
-The following remarks are quite technical and mostly describe a certain
-weak form of "backchaining" that has been implemented for equiv in
-order to support the = command.  In fact neither the term (relation old
-new) nor the term (relation new old) needs to be *explicitly* among the
-current "assumptions", i.e., the top-level hypothesis or the governors.
-Rather, there need only be such an assumption that "tells us" (r old
-new) or (r new old), for *some* equivalence relation r that *refines*
-relation.  Here, "tells us" means that either one of the indicated
-terms is among those assumptions, or else there is an assumption that
-is an implication whose conclusion is one of the indicated terms and
-whose hypotheses (gathered up by appropriately flattening the first
-argument of the implies term) are all among the current assumptions.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||EX,  Next: ACL2-PC||EXIT,  Prev: ACL2-PC||EQUIV,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||EX    (macro)
-exit after possibly saving the state
-
-     Example and General Form:
-     ex
-
-Same as exit, except that first the instruction save is executed.
-
-If save queries the user and is answered negatively, then the exit is
-aborted.
-
-
-File: acl2-doc-emacs.info,  Node: ACL2-PC||EXIT,  Next: ACL2-PC||EXPAND,  Prev: ACL2-PC||EX,  Up: PROOF-CHECKER-COMMANDS
-
-ACL2-PC||EXIT    (meta)
-exit the interactive proof-checker
-
-     Examples:
-     exit                        -- exit the interactive proof-checker
-     (exit append-associativity) -- exit and create a defthm
-                                    event named append-associativity
-
-     General Forms:
-
-     exit --  Exit without storing an event.
-
-     (exit event-name &optional rule-classes do-it-flg)
-     Exit, and store an event.
-
-The command exit returns you to the ACL2 loop.  At a later time,
-(verify) may be executed to get back into the same proof-checker state,
-as long as there hasn't been an intervening use of the proof-checker
-(otherwise see save).
-
-When given one or more arguments as shown above, exit still returns you
-to the ACL2 loop, but first, if the interactive proof is complete, then
-it attempts create a defthm event with the specified event-name and
-rule-classes (which defaults to (:rewrite) if not supplied).  The event
-will be printed to the terminal, and then normally the user will be
-queried whether an event should really be created.  However, if the
-final optional argument do-it-flg is supplied and not nil, then an
-event will be made without a query.
-
-For example, the form
-
-     (exit top-pop-elim (:elim :rewrite) t)
-
-causes a defthm event named top-pop-elim to be created with
-rule-classes (:elim :rewrite), without a query to the user (because of
-the argument t).
-
-*Remark:* it is permitted for event-name to be nil.  In that case, the
-name of the event will be the name supplied during the original call of
-verify.  (See the documentation for verify and commands.)  Also in that
-case, if rule-classes is not supplied then it defaults to the
-rule-classes supplied in the original call of verify.
-
-Comments on "success" and "failure".  An exit instruction will always
-"fail", so for example, if it appears as an argument of a do-strict
-instruction then none of the later (instruction) arguments will be
-executed.  Moreover, the "failure" will be "hard" if an event is
-successfully created or if the instruction is simply exit; otherwise it
-will be "soft".  See the documentation for sequence for an explanation
-of hard and soft "failures".  An obscure but potentially important fact
-is that if the "failure" is hard, then the error signal is a special
-signal that the top-level interactive loop can interpret as a request
-to exit.  Thus for example, a sequencing command that turns an error
-triple (mv erp val state) into (mv t val state) would never cause an
-exit from the interactive loop.
-
-If the proof is not complete, then (exit event-name ...) will not cause
-an exit from the interactive loop.  However, in that case it will print
-out the original user-supplied goal (the one that was supplied with the
-call to verify) and the current list of instructions.
-
diff -Nru acl2-6.2/doc/HTML/+.html acl2-6.3/doc/HTML/+.html
--- acl2-6.2/doc/HTML/+.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/+.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>+.html  --  ACL2 Version 6.2</title></head>
+<head><title>+.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>+</h3>addition macro
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/1+.html acl2-6.3/doc/HTML/1+.html
--- acl2-6.2/doc/HTML/1+.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/1+.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>1+.html  --  ACL2 Version 6.2</title></head>
+<head><title>1+.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>1+</h3>increment by 1
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/1-.html acl2-6.3/doc/HTML/1-.html
--- acl2-6.2/doc/HTML/1-.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/1-.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>1-.html  --  ACL2 Version 6.2</title></head>
+<head><title>1-.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>1-</h3>decrement by 1
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/=.html acl2-6.3/doc/HTML/=.html
--- acl2-6.2/doc/HTML/=.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/=.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>=.html  --  ACL2 Version 6.2</title></head>
+<head><title>=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>=</h3>test equality of two numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ABORT_bang_.html acl2-6.3/doc/HTML/ABORT_bang_.html
--- acl2-6.2/doc/HTML/ABORT_bang_.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/ABORT_bang_.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ABORT_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>ABORT_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ABORT!</h2>to return to the top-level of ACL2's command loop
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/ABOUT-ACL2.html acl2-6.3/doc/HTML/ABOUT-ACL2.html
--- acl2-6.2/doc/HTML/ABOUT-ACL2.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/ABOUT-ACL2.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,11 +1,11 @@
 <html>
-<head><title>ABOUT-ACL2.html  --  ACL2 Version 6.2</title></head>
+<head><title>ABOUT-ACL2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>ABOUT-ACL2</h1>about ACL2
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
 </pre><p/>
 <p>
-This is ACL2 Version 6.2, copyright (C) 2013, Regents of the University of
+This is ACL2 Version 6.3, copyright (C) 2013, Regents of the University of
 Texas, authored by Matt Kaufmann and J Strother Moore.</p><p>For past versions, see
 <a href="http://www.cs.utexas.edu/users/moore/acl2/current/other-releases.html">http://www.cs.utexas.edu/users/moore/acl2/current/other-releases.html</a>.</p><p>For statistics on ACL2 code size, see file <code>doc/acl2-code-size.txt</code>.</p><p>See <a href="DOCUMENTATION.html">documentation</a> for how to access the user's manual.</p><p>See the home page at <a href="http://www.cs.utexas.edu/users/moore/acl2/">http://www.cs.utexas.edu/users/moore/acl2/</a> for
 additional information including tutorials, applications, mailing lists,
diff -Nru acl2-6.2/doc/HTML/ABS.html acl2-6.3/doc/HTML/ABS.html
--- acl2-6.2/doc/HTML/ABS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ABS.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ABS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ABS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ABS</h3>the absolute value of a real number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ACCUMULATED-PERSISTENCE-SUBTLETIES.html acl2-6.3/doc/HTML/ACCUMULATED-PERSISTENCE-SUBTLETIES.html
--- acl2-6.2/doc/HTML/ACCUMULATED-PERSISTENCE-SUBTLETIES.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/ACCUMULATED-PERSISTENCE-SUBTLETIES.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACCUMULATED-PERSISTENCE-SUBTLETIES.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACCUMULATED-PERSISTENCE-SUBTLETIES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACCUMULATED-PERSISTENCE-SUBTLETIES</h3>some subtle aspects of the counting done by <code><a href="ACCUMULATED-PERSISTENCE.html">accumulated-persistence</a></code>
 <pre>Major Section:  <a href="ACCUMULATED-PERSISTENCE.html">ACCUMULATED-PERSISTENCE</a>
diff -Nru acl2-6.2/doc/HTML/ACCUMULATED-PERSISTENCE.html acl2-6.3/doc/HTML/ACCUMULATED-PERSISTENCE.html
--- acl2-6.2/doc/HTML/ACCUMULATED-PERSISTENCE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/ACCUMULATED-PERSISTENCE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACCUMULATED-PERSISTENCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACCUMULATED-PERSISTENCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACCUMULATED-PERSISTENCE</h2>to get statistics on which <a href="RUNE.html">rune</a>s are being tried
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/ACKNOWLEDGMENTS.html acl2-6.3/doc/HTML/ACKNOWLEDGMENTS.html
--- acl2-6.2/doc/HTML/ACKNOWLEDGMENTS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/ACKNOWLEDGMENTS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACKNOWLEDGMENTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACKNOWLEDGMENTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACKNOWLEDGMENTS</h2>some contributors to the well-being of ACL2
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-AS-STANDALONE-PROGRAM.html acl2-6.3/doc/HTML/ACL2-AS-STANDALONE-PROGRAM.html
--- acl2-6.2/doc/HTML/ACL2-AS-STANDALONE-PROGRAM.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-AS-STANDALONE-PROGRAM.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-AS-STANDALONE-PROGRAM.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-AS-STANDALONE-PROGRAM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2-AS-STANDALONE-PROGRAM</h2>Calling ACL2 from another program
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-BUILT-INS.html acl2-6.3/doc/HTML/ACL2-BUILT-INS.html
--- acl2-6.2/doc/HTML/ACL2-BUILT-INS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-BUILT-INS.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-BUILT-INS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-BUILT-INS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2-BUILT-INS</h2>built-in ACL2 functions
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
@@ -456,7 +456,7 @@
 </h3>
 </li>
 
-<li><h3><a href="DELETE-ASSOC.html">DELETE-ASSOC</a> -- modify an association list by associating a value with a key
+<li><h3><a href="DELETE-ASSOC.html">DELETE-ASSOC</a> -- remove the first pair from an association list for a given key
 </h3>
 </li>
 
@@ -908,6 +908,10 @@
 </h3>
 </li>
 
+<li><h3><a href="MSG.html">MSG</a> -- construct a ``message'' suitable for the <code>~@</code> directive of <code><a href="FMT.html">fmt</a></code>
+</h3>
+</li>
+
 <li><h3><a href="MUST-BE-EQUAL.html">MUST-BE-EQUAL</a> -- attach code for execution
 </h3>
 </li>
@@ -1324,6 +1328,10 @@
 </h3>
 </li>
 
+<li><h3><a href="SIGNED-BYTE-P.html">SIGNED-BYTE-P</a> -- recognizer for signed integers that fit in a specified bit width
+</h3>
+</li>
+
 <li><h3><a href="SIGNUM.html">SIGNUM</a> -- indicator for positive, negative, or zero
 </h3>
 </li>
@@ -1464,6 +1472,10 @@
 </h3>
 </li>
 
+<li><h3><a href="SYS-CALL+.html">SYS-CALL+</a> -- make a system call to the host OS, returning status and output
+</h3>
+</li>
+
 <li><h3><a href="SYS-CALL-STATUS.html">SYS-CALL-STATUS</a> -- exit status from the preceding system call
 </h3>
 </li>
@@ -1524,6 +1536,10 @@
 </h3>
 </li>
 
+<li><h3><a href="UNSIGNED-BYTE-P.html">UNSIGNED-BYTE-P</a> -- recognizer for natural numbers that fit in a specified bit width
+</h3>
+</li>
+
 <li><h3><a href="UNTRANSLATE.html">UNTRANSLATE</a> -- See <a href="USER-DEFINED-FUNCTIONS-TABLE.html">user-defined-functions-table</a>.
 </h3>
 </li>
diff -Nru acl2-6.2/doc/HTML/ACL2-COUNT.html acl2-6.3/doc/HTML/ACL2-COUNT.html
--- acl2-6.2/doc/HTML/ACL2-COUNT.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-COUNT.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-COUNT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-COUNT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-COUNT</h3>a commonly used measure for justifying recursion
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-CUSTOMIZATION.html acl2-6.3/doc/HTML/ACL2-CUSTOMIZATION.html
--- acl2-6.2/doc/HTML/ACL2-CUSTOMIZATION.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-CUSTOMIZATION.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-CUSTOMIZATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-CUSTOMIZATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2-CUSTOMIZATION</h2>file of initial commands for ACL2 to run at <a href="STARTUP.html">startup</a>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-DEFAULTS-TABLE.html acl2-6.3/doc/HTML/ACL2-DEFAULTS-TABLE.html
--- acl2-6.2/doc/HTML/ACL2-DEFAULTS-TABLE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-DEFAULTS-TABLE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-DEFAULTS-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-DEFAULTS-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2-DEFAULTS-TABLE</h2>a <a href="TABLE.html">table</a> specifying certain defaults, e.g., the default <a href="DEFUN-MODE.html">defun-mode</a>
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
@@ -123,25 +123,6 @@
 fails).  See <a href="SET-IGNORE-OK.html">set-ignore-ok</a>.
 
 <pre>
-:inhibit-warnings
-</pre>
-
-ACL2 prints warnings that may, from time to time, seem excessive to
-experienced users.  Each warning is ``labeled'' with a string
-identifying the type of warning.  Consider for example
-
-<pre>
-ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
-</pre>
-
-Here, the label is "Use".  The value of the key
-<code>:inhibit-warnings</code> is a list of such labels, where case is
-ignored.  Any warning whose label is a member of this list (where
-again, case is ignored) is suppressed.
-See <a href="SET-INHIBIT-WARNINGS.html">set-inhibit-warnings</a> and also
-see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a>.
-
-<pre>
 :bdd-constructors
 </pre>
 
diff -Nru acl2-6.2/doc/HTML/ACL2-HELP.html acl2-6.3/doc/HTML/ACL2-HELP.html
--- acl2-6.2/doc/HTML/ACL2-HELP.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-HELP.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-HELP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-HELP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2-HELP</h2>the acl2-help mailing list
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-NUMBER-LISTP.html acl2-6.3/doc/HTML/ACL2-NUMBER-LISTP.html
--- acl2-6.2/doc/HTML/ACL2-NUMBER-LISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-NUMBER-LISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-NUMBER-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-NUMBER-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-NUMBER-LISTP</h3>recognizer for a true list of numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-NUMBERP.html acl2-6.3/doc/HTML/ACL2-NUMBERP.html
--- acl2-6.2/doc/HTML/ACL2-NUMBERP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-NUMBERP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-NUMBERP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-NUMBERP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-NUMBERP</h3>recognizer for numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_=.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_=.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_=.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_=.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::=</h3>(atomic macro)
 <code>   </code>attempt an equality (or equivalence) substitution
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ACL2-WRAP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ACL2-WRAP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ACL2-WRAP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ACL2-WRAP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_ACL2-WRAP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_ACL2-WRAP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::ACL2-WRAP</h3>(macro)
 <code>   </code>same as <code>(lisp x)</code>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ADD-ABBREVIATION.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ADD-ABBREVIATION.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ADD-ABBREVIATION.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ADD-ABBREVIATION.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_ADD-ABBREVIATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_ADD-ABBREVIATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::ADD-ABBREVIATION</h3>(primitive)
 <code>   </code>add an abbreviation
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_AL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_AL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_AL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_AL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_AL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_AL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::AL</h3>(macro)
 <code>   </code>same as apply-linear
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_APPLY-LINEAR.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_APPLY-LINEAR.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_APPLY-LINEAR.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_APPLY-LINEAR.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_APPLY-LINEAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_APPLY-LINEAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::APPLY-LINEAR</h3>(primitive)
 <code>   </code>apply a linear rule
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_BASH.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_BASH.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_BASH.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_BASH.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_BASH.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_BASH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::BASH</h3>(atomic macro)
 <code>   </code>call the ACL2 theorem prover's simplifier
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_BDD.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_BDD.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_BDD.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_BDD.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_BDD.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_BDD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::BDD</h3>(atomic macro)
 <code>   </code>prove the current goal using bdds
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_BK.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_BK.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_BK.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_BK.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_BK.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_BK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::BK</h3>(atomic macro)
 <code>   </code>move backward one argument in the enclosing term
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_BOOKMARK.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_BOOKMARK.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_BOOKMARK.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_BOOKMARK.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_BOOKMARK.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_BOOKMARK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::BOOKMARK</h3>(macro)
 <code>   </code>insert matching ``bookends'' comments
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CASESPLIT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CASESPLIT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CASESPLIT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CASESPLIT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_CASESPLIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_CASESPLIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::CASESPLIT</h3>(primitive)
 <code>   </code>split into two cases
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CG.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CG.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CG.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CG.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_CG.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_CG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::CG</h3>(macro)
 <code>   </code>change to another goal.
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CHANGE-GOAL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CHANGE-GOAL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CHANGE-GOAL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CHANGE-GOAL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_CHANGE-GOAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_CHANGE-GOAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::CHANGE-GOAL</h3>(primitive)
 <code>   </code>change to another goal.
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CL-PROC.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CL-PROC.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CL-PROC.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CL-PROC.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_CL-PROC.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_CL-PROC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::CL-PROC</h3>(macro)
 <code>   </code>same as <code>clause-processor</code>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CLAIM.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CLAIM.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CLAIM.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CLAIM.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_CLAIM.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_CLAIM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::CLAIM</h3>(atomic macro)
 <code>   </code>add a new hypothesis
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CLAUSE-PROCESSOR.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CLAUSE-PROCESSOR.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CLAUSE-PROCESSOR.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CLAUSE-PROCESSOR.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_CLAUSE-PROCESSOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_CLAUSE-PROCESSOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::CLAUSE-PROCESSOR</h3>(atomic macro)
 <code>   </code>use a clause-processor
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_COMM.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_COMM.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_COMM.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_COMM.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_COMM.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_COMM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::COMM</h3>(macro)
 <code>   </code>display instructions from the current interactive session
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_COMMANDS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_COMMANDS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_COMMANDS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_COMMANDS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_COMMANDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_COMMANDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::COMMANDS</h3>(macro)
 <code>   </code>display instructions from the current interactive session
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_COMMENT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_COMMENT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_COMMENT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_COMMENT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_COMMENT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_COMMENT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::COMMENT</h3>(primitive)
 <code>   </code>insert a comment
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CONTRADICT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CONTRADICT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CONTRADICT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CONTRADICT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_CONTRADICT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_CONTRADICT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::CONTRADICT</h3>(macro)
 <code>   </code>same as <code>contrapose</code>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CONTRAPOSE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CONTRAPOSE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_CONTRAPOSE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_CONTRAPOSE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_CONTRAPOSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_CONTRAPOSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::CONTRAPOSE</h3>(primitive)
 <code>   </code>switch a hypothesis with the conclusion, negating both
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DEMOTE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DEMOTE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DEMOTE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DEMOTE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_DEMOTE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_DEMOTE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::DEMOTE</h3>(primitive)
 <code>   </code>move top-level hypotheses to the conclusion
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DIVE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DIVE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DIVE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DIVE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_DIVE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_DIVE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::DIVE</h3>(primitive)
 <code>   </code>move to the indicated subterm
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DO-ALL-NO-PROMPT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DO-ALL-NO-PROMPT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DO-ALL-NO-PROMPT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DO-ALL-NO-PROMPT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_DO-ALL-NO-PROMPT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_DO-ALL-NO-PROMPT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::DO-ALL-NO-PROMPT</h3>(macro)
 <code>   </code>run the given instructions, halting once there is a ``failure''
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DO-ALL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DO-ALL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DO-ALL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DO-ALL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_DO-ALL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_DO-ALL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::DO-ALL</h3>(macro)
 <code>   </code>run the given instructions
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DO-STRICT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DO-STRICT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DO-STRICT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DO-STRICT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_DO-STRICT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_DO-STRICT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::DO-STRICT</h3>(macro)
 <code>   </code>run the given instructions, halting once there is a ``failure''
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DROP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DROP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DROP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DROP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_DROP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_DROP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::DROP</h3>(primitive)
 <code>   </code>drop top-level hypotheses
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DV.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DV.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_DV.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_DV.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_DV.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_DV.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::DV</h3>(atomic macro)
 <code>   </code>move to the indicated subterm
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ELIM.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ELIM.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ELIM.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ELIM.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_ELIM.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_ELIM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::ELIM</h3>(atomic macro)
 <code>   </code>call the ACL2 theorem prover's elimination process
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_EQUIV.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_EQUIV.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_EQUIV.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_EQUIV.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_EQUIV.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_EQUIV.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::EQUIV</h3>(primitive)
 <code>   </code>attempt an equality (or congruence-based) substitution
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_EX.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_EX.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_EX.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_EX.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_EX.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_EX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::EX</h3>(macro)
 <code>   </code>exit after possibly saving the state
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_EXIT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_EXIT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_EXIT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_EXIT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_EXIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_EXIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::EXIT</h3>(meta)
 <code>   </code>exit the interactive proof-checker
@@ -10,6 +10,7 @@
 <pre>
 Examples:
 exit                        -- exit the interactive proof-checker
+(exit t)                    -- exit after printing a bogus defthm event
 (exit append-associativity) -- exit and create a defthm
                                event named append-associativity
 
@@ -17,8 +18,10 @@
 
 exit --  Exit without storing an event.
 
-(exit event-name &amp;optional rule-classes do-it-flg)
-Exit, and store an event.
+(exit t) -- Exit after printing a bogus defthm event, showing :INSTRUCTIONS.
+
+(exit event-name &amp;optional rule-classes do-it-flg) --
+Exit, and perhaps store an event
 </pre>
 
 The command <code>exit</code> returns you to the ACL2 loop.  At a later time,
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_EXPAND.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_EXPAND.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_EXPAND.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_EXPAND.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_EXPAND.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_EXPAND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::EXPAND</h3>(primitive)
 <code>   </code>expand the current function call without simplification
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_FAIL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_FAIL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_FAIL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_FAIL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_FAIL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_FAIL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::FAIL</h3>(macro)
 <code>   </code>cause a failure
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_FINISH.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_FINISH.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_FINISH.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_FINISH.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_FINISH.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_FINISH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::FINISH</h3>(macro)
 <code>   </code>require completion of instructions; save error if inside <code>:</code><code><a href="HINTS.html">hints</a></code>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_FORWARDCHAIN.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_FORWARDCHAIN.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_FORWARDCHAIN.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_FORWARDCHAIN.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_FORWARDCHAIN.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_FORWARDCHAIN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::FORWARDCHAIN</h3>(atomic macro)
 <code>   </code>forward chain from an implication in the hyps
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_FREE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_FREE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_FREE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_FREE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_FREE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_FREE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::FREE</h3>(atomic macro)
 <code>   </code>create a ``free variable''
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_GENEQV.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_GENEQV.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_GENEQV.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_GENEQV.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_GENEQV.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_GENEQV.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::GENEQV</h3>(macro)
 <code>   </code>show the generated equivalence relation maintained at the current subterm
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_GENERALIZE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_GENERALIZE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_GENERALIZE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_GENERALIZE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_GENERALIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_GENERALIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::GENERALIZE</h3>(primitive)
 <code>   </code>perform a generalization
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_GOALS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_GOALS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_GOALS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_GOALS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_GOALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_GOALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::GOALS</h3>(macro)
 <code>   </code>list the names of goals on the stack
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_HELP-LONG.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_HELP-LONG.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_HELP-LONG.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_HELP-LONG.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_HELP-LONG.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_HELP-LONG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::HELP-LONG</h3>(macro)
 <code>   </code>same as <code>help!</code>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_HELP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_HELP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_HELP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_HELP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_HELP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_HELP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::HELP</h3>(macro)
 <code>   </code>proof-checker help facility
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_HELP_bang_.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_HELP_bang_.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_HELP_bang_.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_HELP_bang_.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_HELP_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_HELP_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::HELP!</h3>(macro)
 <code>   </code>proof-checker help facility
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_HYPS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_HYPS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_HYPS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_HYPS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_HYPS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_HYPS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::HYPS</h3>(macro)
 <code>   </code>print the hypotheses
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ILLEGAL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ILLEGAL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ILLEGAL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ILLEGAL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_ILLEGAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_ILLEGAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::ILLEGAL</h3>(macro)
 <code>   </code>illegal instruction
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_IN-THEORY.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_IN-THEORY.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_IN-THEORY.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_IN-THEORY.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_IN-THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_IN-THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::IN-THEORY</h3>(primitive)
 <code>   </code>set the current proof-checker theory
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_INDUCT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_INDUCT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_INDUCT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_INDUCT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_INDUCT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_INDUCT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::INDUCT</h3>(atomic macro)
 <code>   </code>generate subgoals using induction
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_LEMMAS-USED.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_LEMMAS-USED.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_LEMMAS-USED.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_LEMMAS-USED.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_LEMMAS-USED.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_LEMMAS-USED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::LEMMAS-USED</h3>(macro)
 <code>   </code>print the runes (definitions, lemmas, ...) used
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_LISP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_LISP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_LISP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_LISP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_LISP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_LISP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::LISP</h3>(meta)
 <code>   </code>evaluate the given form in Lisp
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_MORE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_MORE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_MORE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_MORE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_MORE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_MORE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::MORE</h3>(macro)
 <code>   </code>proof-checker help facility
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_MORE_bang_.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_MORE_bang_.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_MORE_bang_.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_MORE_bang_.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_MORE_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_MORE_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::MORE!</h3>(macro)
 <code>   </code>proof-checker help facility
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_NEGATE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_NEGATE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_NEGATE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_NEGATE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_NEGATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_NEGATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::NEGATE</h3>(macro)
 <code>   </code>run the given instructions, and ``succeed'' if and only if they ``fail''
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_NIL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_NIL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_NIL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_NIL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_NIL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_NIL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::NIL</h3>(macro)
 <code>   </code>used for interpreting <code>control-d</code>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_NOISE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_NOISE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_NOISE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_NOISE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_NOISE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_NOISE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::NOISE</h3>(meta)
 <code>   </code>run instructions with output
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_NX.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_NX.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_NX.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_NX.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_NX.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_NX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::NX</h3>(atomic macro)
 <code>   </code>move forward one argument in the enclosing term
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ORELSE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ORELSE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ORELSE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ORELSE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_ORELSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_ORELSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::ORELSE</h3>(macro)
 <code>   </code>run the first instruction; if (and only if) it ``fails'', run the
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_P-TOP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_P-TOP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_P-TOP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_P-TOP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_P-TOP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_P-TOP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::P-TOP</h3>(macro)
 <code>   </code>prettyprint the conclusion, highlighting the current term
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_P.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_P.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_P.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_P.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_P.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::P</h3>(macro)
 <code>   </code>prettyprint the current term
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PL</h3>(macro)
 <code>   </code>print the rules for a given name
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PP</h3>(macro)
 <code>   </code>prettyprint the current term
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PR.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PR.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PR.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PR.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PR.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PR</h3>(macro)
 <code>   </code>print the rules for a given name
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRINT-ALL-CONCS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRINT-ALL-CONCS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRINT-ALL-CONCS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRINT-ALL-CONCS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PRINT-ALL-CONCS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PRINT-ALL-CONCS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PRINT-ALL-CONCS</h3>(macro)
 <code>   </code>print all the conclusions of (as yet unproved) goals
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRINT-ALL-GOALS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRINT-ALL-GOALS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRINT-ALL-GOALS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRINT-ALL-GOALS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PRINT-ALL-GOALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PRINT-ALL-GOALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PRINT-ALL-GOALS</h3>(macro)
 <code>   </code>print all the (as yet unproved) goals
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRINT-MAIN.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRINT-MAIN.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRINT-MAIN.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRINT-MAIN.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PRINT-MAIN.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PRINT-MAIN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PRINT-MAIN</h3>(macro)
 <code>   </code>print the original goal
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRINT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRINT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRINT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRINT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PRINT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PRINT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PRINT</h3>(macro)
 <code>   </code>print the result of evaluating the given form
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRO.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRO.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PRO.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PRO.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PRO.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PRO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PRO</h3>(atomic macro)
 <code>   </code>repeatedly apply promote
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PROMOTE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PROMOTE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PROMOTE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PROMOTE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PROMOTE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PROMOTE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PROMOTE</h3>(primitive)
 <code>   </code>move antecedents of conclusion's <code>implies</code> term to top-level
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PROTECT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PROTECT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PROTECT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PROTECT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PROTECT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PROTECT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PROTECT</h3>(macro)
 <code>   </code>run the given instructions, reverting to existing state upon
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PROVE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PROVE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PROVE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PROVE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PROVE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PROVE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PROVE</h3>(primitive)
 <code>   </code>call the ACL2 theorem prover to prove the current goal
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PSO.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PSO.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PSO.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PSO.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PSO.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PSO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PSO</h3>(macro)
 <code>   </code>print the most recent proof attempt from inside the proof-checker
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PSOG.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PSOG.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PSOG.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PSOG.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PSOG.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PSOG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PSOG</h3>(macro)
 <code>   </code>print the most recent proof attempt from inside the proof-checker
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PSO_bang_.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PSO_bang_.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PSO_bang_.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PSO_bang_.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PSO_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PSO_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PSO!</h3>(macro)
 <code>   </code>print the most recent proof attempt from inside the proof-checker
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PUT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PUT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_PUT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_PUT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_PUT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_PUT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::PUT</h3>(macro)
 <code>   </code>substitute for a ``free variable''
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_QUIET.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_QUIET.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_QUIET.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_QUIET.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_QUIET.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_QUIET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::QUIET</h3>(meta)
 <code>   </code>run instructions without output
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_R.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_R.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_R.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_R.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_R.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_R.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::R</h3>(macro)
 <code>   </code>same as rewrite
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REDUCE-BY-INDUCTION.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REDUCE-BY-INDUCTION.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REDUCE-BY-INDUCTION.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REDUCE-BY-INDUCTION.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_REDUCE-BY-INDUCTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_REDUCE-BY-INDUCTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::REDUCE-BY-INDUCTION</h3>(macro)
 <code>   </code>call the ACL2 prover without induction, after going into
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REDUCE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REDUCE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REDUCE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REDUCE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_REDUCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_REDUCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::REDUCE</h3>(atomic macro)
 <code>   </code>call the ACL2 theorem prover's simplifier
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REMOVE-ABBREVIATIONS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REMOVE-ABBREVIATIONS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REMOVE-ABBREVIATIONS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REMOVE-ABBREVIATIONS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_REMOVE-ABBREVIATIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_REMOVE-ABBREVIATIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::REMOVE-ABBREVIATIONS</h3>(primitive)
 <code>   </code>remove one or more abbreviations
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REPEAT-REC.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REPEAT-REC.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REPEAT-REC.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REPEAT-REC.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_REPEAT-REC.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_REPEAT-REC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::REPEAT-REC</h3>(macro)
 <code>   </code>auxiliary to <code>repeat</code>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REPEAT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REPEAT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REPEAT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REPEAT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_REPEAT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_REPEAT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::REPEAT</h3>(macro)
 <code>   </code>repeat the given instruction until it ``fails''
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REPLAY.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REPLAY.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REPLAY.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REPLAY.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_REPLAY.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_REPLAY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::REPLAY</h3>(macro)
 <code>   </code>replay one or more instructions
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RESTORE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RESTORE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RESTORE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RESTORE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_RESTORE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_RESTORE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::RESTORE</h3>(meta)
 <code>   </code>remove the effect of an UNDO command
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RETAIN.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RETAIN.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RETAIN.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RETAIN.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_RETAIN.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_RETAIN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::RETAIN</h3>(atomic macro)
 <code>   </code>drop all <strong>but</strong> the indicated top-level hypotheses
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RETRIEVE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RETRIEVE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RETRIEVE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RETRIEVE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_RETRIEVE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_RETRIEVE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::RETRIEVE</h3>(macro)
 <code>   </code>re-enter the proof-checker
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REWRITE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REWRITE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_REWRITE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_REWRITE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_REWRITE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_REWRITE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::REWRITE</h3>(primitive)
 <code>   </code>apply a rewrite rule
@@ -81,7 +81,11 @@
 will do so in both the <code>show-rewrites</code> (<code>sr</code>) and <code>rewrite</code> commands.
 But normally, if even one hypothesis remains unrelieved, then no automatic
 extension of the substitution is made.  Except, if <code>instantiate-free</code> is
-not <code>nil</code>, then that extension to the substitution is kept.</p><p>Finally, the instruction is applied as follows.  The current subterm is
+not <code>nil</code>, then that extension to the substitution is kept.  (Technical
+note: in the case of an unrelieved hypothesis and a non-<code>nil</code> value of
+<code>instantiate-free</code>, if a <code><a href="BIND-FREE.html">bind-free</a></code> hypothesis produces a list of
+binding alists, then the last of those alists is the one that is used to
+extend the substitution.)</p><p>Finally, the instruction is applied as follows.  The current subterm is
 replaced by applying the final substitution described above to the right-hand
 side of the selected rule.  And, one new subgoal is created for each
 unrelieved hypothesis of the rule, whose top-level hypotheses are the
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RUN-INSTR-ON-GOAL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RUN-INSTR-ON-GOAL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RUN-INSTR-ON-GOAL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RUN-INSTR-ON-GOAL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_RUN-INSTR-ON-GOAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_RUN-INSTR-ON-GOAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::RUN-INSTR-ON-GOAL</h3>(macro)
 <code>   </code>auxiliary to THEN
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RUN-INSTR-ON-NEW-GOALS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RUN-INSTR-ON-NEW-GOALS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RUN-INSTR-ON-NEW-GOALS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RUN-INSTR-ON-NEW-GOALS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_RUN-INSTR-ON-NEW-GOALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_RUN-INSTR-ON-NEW-GOALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::RUN-INSTR-ON-NEW-GOALS</h3>(macro)
 <code>   </code>auxiliary to <code>then</code>
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RUNES.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RUNES.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_RUNES.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_RUNES.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_RUNES.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_RUNES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::RUNES</h3>(macro)
 <code>   </code>print the runes (definitions, lemmas, ...) used
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_S-PROP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_S-PROP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_S-PROP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_S-PROP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_S-PROP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_S-PROP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::S-PROP</h3>(atomic macro)
 <code>   </code>simplify propositionally
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_S.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_S.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_S.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_S.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_S.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_S.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::S</h3>(primitive)
 <code>   </code>simplify the current subterm
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SAVE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SAVE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SAVE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SAVE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SAVE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SAVE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SAVE</h3>(macro)
 <code>   </code>save the proof-checker state (state-stack)
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SEQUENCE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SEQUENCE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SEQUENCE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SEQUENCE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SEQUENCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SEQUENCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SEQUENCE</h3>(meta)
 <code>   </code>run the given list of instructions according to a multitude of
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SHOW-ABBREVIATIONS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SHOW-ABBREVIATIONS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SHOW-ABBREVIATIONS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SHOW-ABBREVIATIONS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SHOW-ABBREVIATIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SHOW-ABBREVIATIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SHOW-ABBREVIATIONS</h3>(macro)
 <code>   </code>display the current abbreviations
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SHOW-LINEARS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SHOW-LINEARS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SHOW-LINEARS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SHOW-LINEARS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SHOW-LINEARS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SHOW-LINEARS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SHOW-LINEARS</h3>(macro)
 <code>   </code>display the applicable <a href="LINEAR.html">linear</a> rules
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SHOW-REWRITES.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SHOW-REWRITES.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SHOW-REWRITES.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SHOW-REWRITES.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SHOW-REWRITES.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SHOW-REWRITES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SHOW-REWRITES</h3>(macro)
 <code>   </code>display the applicable <a href="REWRITE.html">rewrite</a> rules
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SHOW-TYPE-PRESCRIPTIONS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SHOW-TYPE-PRESCRIPTIONS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SHOW-TYPE-PRESCRIPTIONS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SHOW-TYPE-PRESCRIPTIONS.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SHOW-TYPE-PRESCRIPTIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SHOW-TYPE-PRESCRIPTIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SHOW-TYPE-PRESCRIPTIONS</h3>(macro)
 <code>   </code>display the applicable <a href="TYPE-PRESCRIPTION.html">type-prescription</a> rules
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SKIP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SKIP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SKIP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SKIP.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SKIP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SKIP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SKIP</h3>(macro)
 <code>   </code>``succeed'' without doing anything
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SL.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SL.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SL.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SL.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SL</h3>(atomic macro)
 <code>   </code>simplify with lemmas
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SLS.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SLS.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SLS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SLS.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SLS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SLS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SLS</h3>(macro)
 <code>   </code>same as SHOW-LINEARS
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SPLIT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SPLIT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SPLIT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SPLIT.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SPLIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SPLIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SPLIT</h3>(atomic macro)
 <code>   </code>split the current goal into cases
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SR.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SR.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SR.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SR.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SR.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SR</h3>(macro)
 <code>   </code>same as SHOW-REWRITES
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ST.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ST.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_ST.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_ST.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_ST.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_ST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::ST</h3>(macro)
 <code>   </code>same as SHOW-TYPE-PRESCRIPTIONS
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SUCCEED.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SUCCEED.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_SUCCEED.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_SUCCEED.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_SUCCEED.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_SUCCEED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::SUCCEED</h3>(macro)
 <code>   </code>run the given instructions, and ``succeed''
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_TH.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_TH.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_TH.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_TH.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_TH.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_TH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::TH</h3>(macro)
 <code>   </code>print the top-level hypotheses and the current subterm
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_THEN.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_THEN.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_THEN.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_THEN.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_THEN.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_THEN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::THEN</h3>(macro)
 <code>   </code>apply one instruction to current goal and another to new subgoals
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_TOP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_TOP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_TOP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_TOP.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_TOP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_TOP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::TOP</h3>(atomic macro)
 <code>   </code>move to the top of the goal
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_TYPE-ALIST.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_TYPE-ALIST.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_TYPE-ALIST.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_TYPE-ALIST.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_TYPE-ALIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_TYPE-ALIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::TYPE-ALIST</h3>(macro)
 <code>   </code>display the type-alist from the current context
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_UNDO.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_UNDO.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_UNDO.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_UNDO.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_UNDO.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_UNDO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::UNDO</h3>(meta)
 <code>   </code>undo some instructions
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_UNSAVE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_UNSAVE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_UNSAVE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_UNSAVE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_UNSAVE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_UNSAVE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::UNSAVE</h3>(macro)
 <code>   </code>remove a proof-checker state
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_UP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_UP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_UP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_UP.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_UP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_UP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::UP</h3>(primitive)
 <code>   </code>move to the parent (or some ancestor) of the current subterm
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_USE.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_USE.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_USE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_USE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_USE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_USE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::USE</h3>(atomic macro)
 <code>   </code>use a lemma instance
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_WRAP-INDUCT.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_WRAP-INDUCT.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_WRAP-INDUCT.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_WRAP-INDUCT.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_WRAP-INDUCT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_WRAP-INDUCT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::WRAP-INDUCT</h3>(atomic macro)
 <code>   </code>same as induct, but create a single goal
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_WRAP.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_WRAP.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_WRAP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_WRAP.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_WRAP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_WRAP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::WRAP</h3>(atomic macro)
 <code>   </code>execute the indicated instructions and combine all the new goals
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_WRAP1.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_WRAP1.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_WRAP1.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_WRAP1.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_WRAP1.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_WRAP1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::WRAP1</h3>(primitive)
 <code>   </code>combine goals into a single goal
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_X-DUMB.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_X-DUMB.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_X-DUMB.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_X-DUMB.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_X-DUMB.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_X-DUMB.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::X-DUMB</h3>(atomic macro)
 <code>   </code>expand function call at the current subterm, without simplifying
diff -Nru acl2-6.2/doc/HTML/ACL2-PC_colon__colon_X.html acl2-6.3/doc/HTML/ACL2-PC_colon__colon_X.html
--- acl2-6.2/doc/HTML/ACL2-PC_colon__colon_X.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-PC_colon__colon_X.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-PC_colon__colon_X.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-PC_colon__colon_X.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2-PC::X</h3>(atomic macro)
 <code>   </code>expand and (maybe) simplify function call at the current subterm
diff -Nru acl2-6.2/doc/HTML/ACL2-SEDAN.html acl2-6.3/doc/HTML/ACL2-SEDAN.html
--- acl2-6.2/doc/HTML/ACL2-SEDAN.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-SEDAN.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-SEDAN.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-SEDAN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2-SEDAN</h2>ACL2 Sedan interface
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-TUTORIAL.html acl2-6.3/doc/HTML/ACL2-TUTORIAL.html
--- acl2-6.2/doc/HTML/ACL2-TUTORIAL.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-TUTORIAL.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-TUTORIAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-TUTORIAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>ACL2-TUTORIAL</h1>tutorial introduction to ACL2
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/ACL2-USER.html acl2-6.3/doc/HTML/ACL2-USER.html
--- acl2-6.2/doc/HTML/ACL2-USER.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2-USER.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2-USER.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2-USER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2-USER</h2>a package the ACL2 user may prefer
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/ACL2P-KEY-CHECKPOINTS.html acl2-6.3/doc/HTML/ACL2P-KEY-CHECKPOINTS.html
--- acl2-6.2/doc/HTML/ACL2P-KEY-CHECKPOINTS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2P-KEY-CHECKPOINTS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2P-KEY-CHECKPOINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2P-KEY-CHECKPOINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACL2P-KEY-CHECKPOINTS</h3>key checkpoints in ACL2(p)
 <pre>Major Section:  <a href="PARALLEL-PROOF.html">PARALLEL-PROOF</a>
diff -Nru acl2-6.2/doc/HTML/ACL2S.html acl2-6.3/doc/HTML/ACL2S.html
--- acl2-6.2/doc/HTML/ACL2S.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2S.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2S.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2S.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2S</h2>See <a href="ACL2-SEDAN.html">acl2-sedan</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/ACL2_Characters.html acl2-6.3/doc/HTML/ACL2_Characters.html
--- acl2-6.2/doc/HTML/ACL2_Characters.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2_Characters.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2_Characters.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2_Characters.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2 Characters</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ACL2_Conses_or_Ordered_Pairs.html acl2-6.3/doc/HTML/ACL2_Conses_or_Ordered_Pairs.html
--- acl2-6.2/doc/HTML/ACL2_Conses_or_Ordered_Pairs.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2_Conses_or_Ordered_Pairs.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2_Conses_or_Ordered_Pairs.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2_Conses_or_Ordered_Pairs.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2 Conses or Ordered Pairs</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ACL2_Strings.html acl2-6.3/doc/HTML/ACL2_Strings.html
--- acl2-6.2/doc/HTML/ACL2_Strings.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2_Strings.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2_Strings.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2_Strings.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2 Strings</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ACL2_Symbols.html acl2-6.3/doc/HTML/ACL2_Symbols.html
--- acl2-6.2/doc/HTML/ACL2_Symbols.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2_Symbols.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2_Symbols.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2_Symbols.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2 Symbols</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ACL2_System_Architecture.html acl2-6.3/doc/HTML/ACL2_System_Architecture.html
--- acl2-6.2/doc/HTML/ACL2_System_Architecture.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2_System_Architecture.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2_System_Architecture.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2_System_Architecture.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2 System Architecture</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ACL2_as_an_Interactive_Theorem_Prover.html acl2-6.3/doc/HTML/ACL2_as_an_Interactive_Theorem_Prover.html
--- acl2-6.2/doc/HTML/ACL2_as_an_Interactive_Theorem_Prover.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2_as_an_Interactive_Theorem_Prover.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2_as_an_Interactive_Theorem_Prover.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2_as_an_Interactive_Theorem_Prover.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2 as an Interactive Theorem Prover</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ACL2_as_an_Interactive_Theorem_Prover__lparen_cont_rparen_.html acl2-6.3/doc/HTML/ACL2_as_an_Interactive_Theorem_Prover__lparen_cont_rparen_.html
--- acl2-6.2/doc/HTML/ACL2_as_an_Interactive_Theorem_Prover__lparen_cont_rparen_.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2_as_an_Interactive_Theorem_Prover__lparen_cont_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2_as_an_Interactive_Theorem_Prover__lparen_cont_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2_as_an_Interactive_Theorem_Prover__lparen_cont_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2 as an Interactive Theorem Prover (cont)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ACL2_is_an_Untyped_Language.html acl2-6.3/doc/HTML/ACL2_is_an_Untyped_Language.html
--- acl2-6.2/doc/HTML/ACL2_is_an_Untyped_Language.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ACL2_is_an_Untyped_Language.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACL2_is_an_Untyped_Language.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACL2_is_an_Untyped_Language.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACL2 is an Untyped Language</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ACONS.html acl2-6.3/doc/HTML/ACONS.html
--- acl2-6.2/doc/HTML/ACONS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ACONS.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ACONS</h3>constructor for association lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ACTIVE-RUNEP.html acl2-6.3/doc/HTML/ACTIVE-RUNEP.html
--- acl2-6.2/doc/HTML/ACTIVE-RUNEP.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/ACTIVE-RUNEP.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ACTIVE-RUNEP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ACTIVE-RUNEP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ACTIVE-RUNEP</h2>check that a <a href="RUNE.html">rune</a> exists and is <a href="ENABLE.html">enable</a>d
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-BINOP.html acl2-6.3/doc/HTML/ADD-BINOP.html
--- acl2-6.2/doc/HTML/ADD-BINOP.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-BINOP.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-BINOP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-BINOP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-BINOP</h2>associate a function name with a macro name
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-CUSTOM-KEYWORD-HINT.html acl2-6.3/doc/HTML/ADD-CUSTOM-KEYWORD-HINT.html
--- acl2-6.2/doc/HTML/ADD-CUSTOM-KEYWORD-HINT.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-CUSTOM-KEYWORD-HINT.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-CUSTOM-KEYWORD-HINT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-CUSTOM-KEYWORD-HINT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-CUSTOM-KEYWORD-HINT</h2>add a new custom keyword hint
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/ADD-DEFAULT-HINTS.html acl2-6.3/doc/HTML/ADD-DEFAULT-HINTS.html
--- acl2-6.2/doc/HTML/ADD-DEFAULT-HINTS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-DEFAULT-HINTS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-DEFAULT-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-DEFAULT-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-DEFAULT-HINTS</h2>add to the default hints
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-DEFAULT-HINTS_bang_.html acl2-6.3/doc/HTML/ADD-DEFAULT-HINTS_bang_.html
--- acl2-6.2/doc/HTML/ADD-DEFAULT-HINTS_bang_.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-DEFAULT-HINTS_bang_.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-DEFAULT-HINTS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-DEFAULT-HINTS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-DEFAULT-HINTS!</h2>add to the default hints non-<code><a href="LOCAL.html">local</a></code>ly
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-DIVE-INTO-MACRO.html acl2-6.3/doc/HTML/ADD-DIVE-INTO-MACRO.html
--- acl2-6.2/doc/HTML/ADD-DIVE-INTO-MACRO.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-DIVE-INTO-MACRO.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-DIVE-INTO-MACRO.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-DIVE-INTO-MACRO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-DIVE-INTO-MACRO</h2>associate <a href="PROOF-CHECKER.html">proof-checker</a> diving function with macro name
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-INCLUDE-BOOK-DIR.html acl2-6.3/doc/HTML/ADD-INCLUDE-BOOK-DIR.html
--- acl2-6.2/doc/HTML/ADD-INCLUDE-BOOK-DIR.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-INCLUDE-BOOK-DIR.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-INCLUDE-BOOK-DIR.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-INCLUDE-BOOK-DIR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-INCLUDE-BOOK-DIR</h2>link keyword for <code>:dir</code> argument of <code><a href="LD.html">ld</a></code> and <code><a href="INCLUDE-BOOK.html">include-book</a></code>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-INVISIBLE-FNS.html acl2-6.3/doc/HTML/ADD-INVISIBLE-FNS.html
--- acl2-6.2/doc/HTML/ADD-INVISIBLE-FNS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-INVISIBLE-FNS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-INVISIBLE-FNS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-INVISIBLE-FNS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-INVISIBLE-FNS</h2>make some unary functions invisible to the <a href="LOOP-STOPPER.html">loop-stopper</a> algorithm
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-LD-KEYWORD-ALIAS.html acl2-6.3/doc/HTML/ADD-LD-KEYWORD-ALIAS.html
--- acl2-6.2/doc/HTML/ADD-LD-KEYWORD-ALIAS.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-LD-KEYWORD-ALIAS.html	2013-09-30 17:39:36.000000000 +0000
@@ -0,0 +1,11 @@
+<html>
+<head><title>ADD-LD-KEYWORD-ALIAS.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>ADD-LD-KEYWORD-ALIAS</h2>See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+<pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
+</pre><p/>
+<p></p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/ADD-LD-KEYWORD-ALIAS_bang_.html acl2-6.3/doc/HTML/ADD-LD-KEYWORD-ALIAS_bang_.html
--- acl2-6.2/doc/HTML/ADD-LD-KEYWORD-ALIAS_bang_.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-LD-KEYWORD-ALIAS_bang_.html	2013-09-30 17:39:36.000000000 +0000
@@ -0,0 +1,11 @@
+<html>
+<head><title>ADD-LD-KEYWORD-ALIAS_bang_.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>ADD-LD-KEYWORD-ALIAS!</h2>See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+<pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
+</pre><p/>
+<p></p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/ADD-MACRO-ALIAS.html acl2-6.3/doc/HTML/ADD-MACRO-ALIAS.html
--- acl2-6.2/doc/HTML/ADD-MACRO-ALIAS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-MACRO-ALIAS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-MACRO-ALIAS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-MACRO-ALIAS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-MACRO-ALIAS</h2>associate a function name with a macro name
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-MACRO-FN.html acl2-6.3/doc/HTML/ADD-MACRO-FN.html
--- acl2-6.2/doc/HTML/ADD-MACRO-FN.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-MACRO-FN.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-MACRO-FN.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-MACRO-FN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-MACRO-FN</h2>associate a function name with a macro name
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-MATCH-FREE-OVERRIDE.html acl2-6.3/doc/HTML/ADD-MATCH-FREE-OVERRIDE.html
--- acl2-6.2/doc/HTML/ADD-MATCH-FREE-OVERRIDE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-MATCH-FREE-OVERRIDE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-MATCH-FREE-OVERRIDE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-MATCH-FREE-OVERRIDE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-MATCH-FREE-OVERRIDE</h2>set <code>:match-free</code> value to <code>:once</code> or <code>:all</code> in existing rules
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-NTH-ALIAS.html acl2-6.3/doc/HTML/ADD-NTH-ALIAS.html
--- acl2-6.2/doc/HTML/ADD-NTH-ALIAS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-NTH-ALIAS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-NTH-ALIAS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-NTH-ALIAS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-NTH-ALIAS</h2>associate one symbol with another for printing of <code><a href="NTH.html">nth</a></code>/<code><a href="UPDATE-NTH.html">update-nth</a></code> terms
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-OVERRIDE-HINTS.html acl2-6.3/doc/HTML/ADD-OVERRIDE-HINTS.html
--- acl2-6.2/doc/HTML/ADD-OVERRIDE-HINTS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-OVERRIDE-HINTS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-OVERRIDE-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-OVERRIDE-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-OVERRIDE-HINTS</h2>add to the <a href="OVERRIDE-HINTS.html">override-hints</a>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-OVERRIDE-HINTS_bang_.html acl2-6.3/doc/HTML/ADD-OVERRIDE-HINTS_bang_.html
--- acl2-6.2/doc/HTML/ADD-OVERRIDE-HINTS_bang_.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-OVERRIDE-HINTS_bang_.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-OVERRIDE-HINTS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-OVERRIDE-HINTS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADD-OVERRIDE-HINTS!</h2>add non-<a href="LOCAL.html">local</a>ly to the <a href="OVERRIDE-HINTS.html">override-hints</a>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/ADD-RAW-ARITY.html acl2-6.3/doc/HTML/ADD-RAW-ARITY.html
--- acl2-6.2/doc/HTML/ADD-RAW-ARITY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-RAW-ARITY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-RAW-ARITY.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-RAW-ARITY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ADD-RAW-ARITY</h3>add arity information for raw mode
 <pre>Major Section:  <a href="SET-RAW-MODE.html">SET-RAW-MODE</a>
diff -Nru acl2-6.2/doc/HTML/ADD-TO-SET-EQ.html acl2-6.3/doc/HTML/ADD-TO-SET-EQ.html
--- acl2-6.2/doc/HTML/ADD-TO-SET-EQ.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-TO-SET-EQ.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-TO-SET-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-TO-SET-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ADD-TO-SET-EQ</h3>See <a href="ADD-TO-SET.html">add-to-set</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ADD-TO-SET-EQL.html acl2-6.3/doc/HTML/ADD-TO-SET-EQL.html
--- acl2-6.2/doc/HTML/ADD-TO-SET-EQL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-TO-SET-EQL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-TO-SET-EQL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-TO-SET-EQL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ADD-TO-SET-EQL</h3>See <a href="ADD-TO-SET.html">add-to-set</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ADD-TO-SET-EQUAL.html acl2-6.3/doc/HTML/ADD-TO-SET-EQUAL.html
--- acl2-6.2/doc/HTML/ADD-TO-SET-EQUAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-TO-SET-EQUAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-TO-SET-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-TO-SET-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ADD-TO-SET-EQUAL</h3>See <a href="ADD-TO-SET.html">add-to-set</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ADD-TO-SET.html acl2-6.3/doc/HTML/ADD-TO-SET.html
--- acl2-6.2/doc/HTML/ADD-TO-SET.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ADD-TO-SET.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADD-TO-SET.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADD-TO-SET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ADD-TO-SET</h3>add a symbol to a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ADVANCED-FEATURES.html acl2-6.3/doc/HTML/ADVANCED-FEATURES.html
--- acl2-6.2/doc/HTML/ADVANCED-FEATURES.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/ADVANCED-FEATURES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ADVANCED-FEATURES.html  --  ACL2 Version 6.2</title></head>
+<head><title>ADVANCED-FEATURES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ADVANCED-FEATURES</h2>some advanced features of ACL2
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/ALISTP.html acl2-6.3/doc/HTML/ALISTP.html
--- acl2-6.2/doc/HTML/ALISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ALISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ALISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ALISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ALISTP</h3>recognizer for association lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ALLOCATE-FIXNUM-RANGE.html acl2-6.3/doc/HTML/ALLOCATE-FIXNUM-RANGE.html
--- acl2-6.2/doc/HTML/ALLOCATE-FIXNUM-RANGE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ALLOCATE-FIXNUM-RANGE.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ALLOCATE-FIXNUM-RANGE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ALLOCATE-FIXNUM-RANGE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ALLOCATE-FIXNUM-RANGE</h3>set aside fixnums in GCL
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ALPHA-CHAR-P.html acl2-6.3/doc/HTML/ALPHA-CHAR-P.html
--- acl2-6.2/doc/HTML/ALPHA-CHAR-P.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ALPHA-CHAR-P.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ALPHA-CHAR-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>ALPHA-CHAR-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ALPHA-CHAR-P</h3>recognizer for alphabetic characters
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ALPHORDER.html acl2-6.3/doc/HTML/ALPHORDER.html
--- acl2-6.2/doc/HTML/ALPHORDER.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ALPHORDER.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ALPHORDER.html  --  ACL2 Version 6.2</title></head>
+<head><title>ALPHORDER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ALPHORDER</h3>total order on atoms
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ALTERNATIVE-INTRODUCTION.html acl2-6.3/doc/HTML/ALTERNATIVE-INTRODUCTION.html
--- acl2-6.2/doc/HTML/ALTERNATIVE-INTRODUCTION.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/ALTERNATIVE-INTRODUCTION.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ALTERNATIVE-INTRODUCTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>ALTERNATIVE-INTRODUCTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ALTERNATIVE-INTRODUCTION</h2>introduction to ACL2
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/AND.html acl2-6.3/doc/HTML/AND.html
--- acl2-6.2/doc/HTML/AND.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/AND.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>AND.html  --  ACL2 Version 6.2</title></head>
+<head><title>AND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>AND</h3>conjunction
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ANNOTATED-ACL2-SCRIPTS.html acl2-6.3/doc/HTML/ANNOTATED-ACL2-SCRIPTS.html
--- acl2-6.2/doc/HTML/ANNOTATED-ACL2-SCRIPTS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/ANNOTATED-ACL2-SCRIPTS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ANNOTATED-ACL2-SCRIPTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ANNOTATED-ACL2-SCRIPTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ANNOTATED-ACL2-SCRIPTS</h2>examples of ACL2 scripts
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/APPEND.html acl2-6.3/doc/HTML/APPEND.html
--- acl2-6.2/doc/HTML/APPEND.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/APPEND.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>APPEND.html  --  ACL2 Version 6.2</title></head>
+<head><title>APPEND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>APPEND</h3><a href="CONCATENATE.html">concatenate</a> zero or more lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/APROPOS.html acl2-6.3/doc/HTML/APROPOS.html
--- acl2-6.2/doc/HTML/APROPOS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/APROPOS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,13 +1,10 @@
 <html>
-<head><title>APROPOS.html  --  ACL2 Version 6.2</title></head>
+<head><title>APROPOS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h2>APROPOS</h2>searching the documentation online
+<h2>APROPOS</h2>See <a href="FINDING-DOCUMENTATION.html">finding-documentation</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
 </pre><p/>
-<p>
-The <code>:</code><code><a href="DOCS.html">docs</a></code> command allows you to search the <a href="DOCUMENTATION.html">documentation</a> at
-the terminal.  See <a href="DOCS.html">docs</a>.
-</p>
+<p></p>
 <p>
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
diff -Nru acl2-6.2/doc/HTML/ARCHITECTURE-OF-THE-PROVER.html acl2-6.3/doc/HTML/ARCHITECTURE-OF-THE-PROVER.html
--- acl2-6.2/doc/HTML/ARCHITECTURE-OF-THE-PROVER.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/ARCHITECTURE-OF-THE-PROVER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ARCHITECTURE-OF-THE-PROVER.html  --  ACL2 Version 6.2</title></head>
+<head><title>ARCHITECTURE-OF-THE-PROVER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ARCHITECTURE-OF-THE-PROVER</h3>a simple overview of how the prover works
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/AREF1.html acl2-6.3/doc/HTML/AREF1.html
--- acl2-6.2/doc/HTML/AREF1.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/AREF1.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>AREF1.html  --  ACL2 Version 6.2</title></head>
+<head><title>AREF1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>AREF1</h3>access the elements of a 1-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/AREF2.html acl2-6.3/doc/HTML/AREF2.html
--- acl2-6.2/doc/HTML/AREF2.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/AREF2.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>AREF2.html  --  ACL2 Version 6.2</title></head>
+<head><title>AREF2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>AREF2</h3>access the elements of a 2-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/ARGS.html acl2-6.3/doc/HTML/ARGS.html
--- acl2-6.2/doc/HTML/ARGS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/ARGS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ARGS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ARGS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ARGS</h2><code>args</code>, <code><a href="GUARD.html">guard</a></code>, <code>type</code>, <code><a href="CONSTRAINT.html">constraint</a></code>, etc., of a function symbol
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/ARRAY1P.html acl2-6.3/doc/HTML/ARRAY1P.html
--- acl2-6.2/doc/HTML/ARRAY1P.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ARRAY1P.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ARRAY1P.html  --  ACL2 Version 6.2</title></head>
+<head><title>ARRAY1P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ARRAY1P</h3>recognize a 1-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/ARRAY2P.html acl2-6.3/doc/HTML/ARRAY2P.html
--- acl2-6.2/doc/HTML/ARRAY2P.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ARRAY2P.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ARRAY2P.html  --  ACL2 Version 6.2</title></head>
+<head><title>ARRAY2P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ARRAY2P</h3>recognize a 2-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/ARRAYS-EXAMPLE.html acl2-6.3/doc/HTML/ARRAYS-EXAMPLE.html
--- acl2-6.2/doc/HTML/ARRAYS-EXAMPLE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ARRAYS-EXAMPLE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ARRAYS-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ARRAYS-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ARRAYS-EXAMPLE</h3>an example illustrating ACL2 arrays
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/ARRAYS.html acl2-6.3/doc/HTML/ARRAYS.html
--- acl2-6.2/doc/HTML/ARRAYS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ARRAYS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ARRAYS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ARRAYS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ARRAYS</h2>an introduction to ACL2 arrays
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/ASET1.html acl2-6.3/doc/HTML/ASET1.html
--- acl2-6.2/doc/HTML/ASET1.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ASET1.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASET1.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASET1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASET1</h3>set the elements of a 1-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/ASET2.html acl2-6.3/doc/HTML/ASET2.html
--- acl2-6.2/doc/HTML/ASET2.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ASET2.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASET2.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASET2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASET2</h3>set the elements of a 2-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/ASH.html acl2-6.3/doc/HTML/ASH.html
--- acl2-6.2/doc/HTML/ASH.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ASH.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASH.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASH</h3>arithmetic shift operation
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ASSERT$.html acl2-6.3/doc/HTML/ASSERT$.html
--- acl2-6.2/doc/HTML/ASSERT$.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ASSERT$.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASSERT$.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASSERT$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASSERT$</h3>cause a hard error if the given test is false
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ASSERT-EVENT.html acl2-6.3/doc/HTML/ASSERT-EVENT.html
--- acl2-6.2/doc/HTML/ASSERT-EVENT.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/ASSERT-EVENT.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASSERT-EVENT.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASSERT-EVENT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ASSERT-EVENT</h2>assert that a given form returns a non-<code>nil</code> value
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/ASSIGN.html acl2-6.3/doc/HTML/ASSIGN.html
--- acl2-6.2/doc/HTML/ASSIGN.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ASSIGN.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASSIGN.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASSIGN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASSIGN</h3>assign to a global variable in <code><a href="STATE.html">state</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ASSOC-EQ.html acl2-6.3/doc/HTML/ASSOC-EQ.html
--- acl2-6.2/doc/HTML/ASSOC-EQ.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ASSOC-EQ.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASSOC-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASSOC-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASSOC-EQ</h3>See <a href="ASSOC.html">assoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ASSOC-EQUAL.html acl2-6.3/doc/HTML/ASSOC-EQUAL.html
--- acl2-6.2/doc/HTML/ASSOC-EQUAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ASSOC-EQUAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASSOC-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASSOC-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASSOC-EQUAL</h3>See <a href="ASSOC.html">assoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ASSOC-KEYWORD.html acl2-6.3/doc/HTML/ASSOC-KEYWORD.html
--- acl2-6.2/doc/HTML/ASSOC-KEYWORD.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ASSOC-KEYWORD.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASSOC-KEYWORD.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASSOC-KEYWORD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASSOC-KEYWORD</h3>look up key in a <code><a href="KEYWORD-VALUE-LISTP.html">keyword-value-listp</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ASSOC-STRING-EQUAL.html acl2-6.3/doc/HTML/ASSOC-STRING-EQUAL.html
--- acl2-6.2/doc/HTML/ASSOC-STRING-EQUAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ASSOC-STRING-EQUAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASSOC-STRING-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASSOC-STRING-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASSOC-STRING-EQUAL</h3>look up key, a string, in association list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ASSOC.html acl2-6.3/doc/HTML/ASSOC.html
--- acl2-6.2/doc/HTML/ASSOC.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ASSOC.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ASSOC.html  --  ACL2 Version 6.2</title></head>
+<head><title>ASSOC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ASSOC</h3>look up key in association list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ATOM-LISTP.html acl2-6.3/doc/HTML/ATOM-LISTP.html
--- acl2-6.2/doc/HTML/ATOM-LISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ATOM-LISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ATOM-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ATOM-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ATOM-LISTP</h3>recognizer for a true list of <a href="ATOM.html">atom</a>s
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ATOM.html acl2-6.3/doc/HTML/ATOM.html
--- acl2-6.2/doc/HTML/ATOM.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ATOM.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ATOM.html  --  ACL2 Version 6.2</title></head>
+<head><title>ATOM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ATOM</h3>recognizer for atoms
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/A_Flying_Tour_of_ACL2.html acl2-6.3/doc/HTML/A_Flying_Tour_of_ACL2.html
--- acl2-6.2/doc/HTML/A_Flying_Tour_of_ACL2.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/A_Flying_Tour_of_ACL2.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>A_Flying_Tour_of_ACL2.html  --  ACL2 Version 6.2</title></head>
+<head><title>A_Flying_Tour_of_ACL2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>A Flying Tour of ACL2</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/A_Sketch_of_How_the_Rewriter_Works.html acl2-6.3/doc/HTML/A_Sketch_of_How_the_Rewriter_Works.html
--- acl2-6.2/doc/HTML/A_Sketch_of_How_the_Rewriter_Works.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/A_Sketch_of_How_the_Rewriter_Works.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>A_Sketch_of_How_the_Rewriter_Works.html  --  ACL2 Version 6.2</title></head>
+<head><title>A_Sketch_of_How_the_Rewriter_Works.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>A Sketch of How the Rewriter Works</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/A_Tiny_Warning_Sign.html acl2-6.3/doc/HTML/A_Tiny_Warning_Sign.html
--- acl2-6.2/doc/HTML/A_Tiny_Warning_Sign.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/A_Tiny_Warning_Sign.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>A_Tiny_Warning_Sign.html  --  ACL2 Version 6.2</title></head>
+<head><title>A_Tiny_Warning_Sign.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>A Tiny Warning Sign</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/A_Trivial_Proof.html acl2-6.3/doc/HTML/A_Trivial_Proof.html
--- acl2-6.2/doc/HTML/A_Trivial_Proof.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/A_Trivial_Proof.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>A_Trivial_Proof.html  --  ACL2 Version 6.2</title></head>
+<head><title>A_Trivial_Proof.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>A Trivial Proof</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/A_Typical_State.html acl2-6.3/doc/HTML/A_Typical_State.html
--- acl2-6.2/doc/HTML/A_Typical_State.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/A_Typical_State.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>A_Typical_State.html  --  ACL2 Version 6.2</title></head>
+<head><title>A_Typical_State.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>A Typical State</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/A_Walking_Tour_of_ACL2.html acl2-6.3/doc/HTML/A_Walking_Tour_of_ACL2.html
--- acl2-6.2/doc/HTML/A_Walking_Tour_of_ACL2.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/A_Walking_Tour_of_ACL2.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>A_Walking_Tour_of_ACL2.html  --  ACL2 Version 6.2</title></head>
+<head><title>A_Walking_Tour_of_ACL2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>A Walking Tour of ACL2</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/A_bang_.html acl2-6.3/doc/HTML/A_bang_.html
--- acl2-6.2/doc/HTML/A_bang_.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/A_bang_.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>A_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>A_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>A!</h2>to return to the top-level of ACL2's command loop
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/About_Models.html acl2-6.3/doc/HTML/About_Models.html
--- acl2-6.2/doc/HTML/About_Models.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/About_Models.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>About_Models.html  --  ACL2 Version 6.2</title></head>
+<head><title>About_Models.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>About Models</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/About_Types.html acl2-6.3/doc/HTML/About_Types.html
--- acl2-6.2/doc/HTML/About_Types.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/About_Types.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>About_Types.html  --  ACL2 Version 6.2</title></head>
+<head><title>About_Types.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>About Types</h2>
 <p>
diff -Nru acl2-6.2/doc/HTML/About_the_ACL2_Home_Page.html acl2-6.3/doc/HTML/About_the_ACL2_Home_Page.html
--- acl2-6.2/doc/HTML/About_the_ACL2_Home_Page.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/About_the_ACL2_Home_Page.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>About_the_ACL2_Home_Page.html  --  ACL2 Version 6.2</title></head>
+<head><title>About_the_ACL2_Home_Page.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>About the ACL2 Home Page</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/About_the_Admission_of_Recursive_Definitions.html acl2-6.3/doc/HTML/About_the_Admission_of_Recursive_Definitions.html
--- acl2-6.2/doc/HTML/About_the_Admission_of_Recursive_Definitions.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/About_the_Admission_of_Recursive_Definitions.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>About_the_Admission_of_Recursive_Definitions.html  --  ACL2 Version 6.2</title></head>
+<head><title>About_the_Admission_of_Recursive_Definitions.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>About the Admission of Recursive Definitions</h2>
 <p>
diff -Nru acl2-6.2/doc/HTML/About_the_Prompt.html acl2-6.3/doc/HTML/About_the_Prompt.html
--- acl2-6.2/doc/HTML/About_the_Prompt.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/About_the_Prompt.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>About_the_Prompt.html  --  ACL2 Version 6.2</title></head>
+<head><title>About_the_Prompt.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>About the Prompt</h2>
 <p>
diff -Nru acl2-6.2/doc/HTML/An_Example_Common_Lisp_Function_Definition.html acl2-6.3/doc/HTML/An_Example_Common_Lisp_Function_Definition.html
--- acl2-6.2/doc/HTML/An_Example_Common_Lisp_Function_Definition.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/An_Example_Common_Lisp_Function_Definition.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>An_Example_Common_Lisp_Function_Definition.html  --  ACL2 Version 6.2</title></head>
+<head><title>An_Example_Common_Lisp_Function_Definition.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>An Example Common Lisp Function Definition</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/An_Example_of_ACL2_in_Use.html acl2-6.3/doc/HTML/An_Example_of_ACL2_in_Use.html
--- acl2-6.2/doc/HTML/An_Example_of_ACL2_in_Use.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/An_Example_of_ACL2_in_Use.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>An_Example_of_ACL2_in_Use.html  --  ACL2 Version 6.2</title></head>
+<head><title>An_Example_of_ACL2_in_Use.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>An Example of ACL2 in Use</h2>
 <p>
diff -Nru acl2-6.2/doc/HTML/Analyzing_Common_Lisp_Models.html acl2-6.3/doc/HTML/Analyzing_Common_Lisp_Models.html
--- acl2-6.2/doc/HTML/Analyzing_Common_Lisp_Models.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Analyzing_Common_Lisp_Models.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Analyzing_Common_Lisp_Models.html  --  ACL2 Version 6.2</title></head>
+<head><title>Analyzing_Common_Lisp_Models.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Analyzing Common Lisp Models</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/BACKCHAIN-LIMIT-RW.html acl2-6.3/doc/HTML/BACKCHAIN-LIMIT-RW.html
--- acl2-6.2/doc/HTML/BACKCHAIN-LIMIT-RW.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/BACKCHAIN-LIMIT-RW.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BACKCHAIN-LIMIT-RW.html  --  ACL2 Version 6.2</title></head>
+<head><title>BACKCHAIN-LIMIT-RW.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BACKCHAIN-LIMIT-RW</h2>hints keyword <code>:BACKCHAIN-LIMIT-RW</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/BACKCHAIN-LIMIT.html acl2-6.3/doc/HTML/BACKCHAIN-LIMIT.html
--- acl2-6.2/doc/HTML/BACKCHAIN-LIMIT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/BACKCHAIN-LIMIT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BACKCHAIN-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>BACKCHAIN-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BACKCHAIN-LIMIT</h2>limiting the effort expended on relieving hypotheses
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/BACKTRACK.html acl2-6.3/doc/HTML/BACKTRACK.html
--- acl2-6.2/doc/HTML/BACKTRACK.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/BACKTRACK.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BACKTRACK.html  --  ACL2 Version 6.2</title></head>
+<head><title>BACKTRACK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BACKTRACK</h2>hints keyword <code>:BACKTRACK</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/BDD-ALGORITHM.html acl2-6.3/doc/HTML/BDD-ALGORITHM.html
--- acl2-6.2/doc/HTML/BDD-ALGORITHM.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BDD-ALGORITHM.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BDD-ALGORITHM.html  --  ACL2 Version 6.2</title></head>
+<head><title>BDD-ALGORITHM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BDD-ALGORITHM</h2>summary of the BDD algorithm in ACL2
 <pre>Major Section:  <a href="BDD.html">BDD</a>
diff -Nru acl2-6.2/doc/HTML/BDD-INTRODUCTION.html acl2-6.3/doc/HTML/BDD-INTRODUCTION.html
--- acl2-6.2/doc/HTML/BDD-INTRODUCTION.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BDD-INTRODUCTION.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BDD-INTRODUCTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>BDD-INTRODUCTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BDD-INTRODUCTION</h2>examples illustrating the use of BDDs in ACL2
 <pre>Major Section:  <a href="BDD.html">BDD</a>
diff -Nru acl2-6.2/doc/HTML/BDD.html acl2-6.3/doc/HTML/BDD.html
--- acl2-6.2/doc/HTML/BDD.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BDD.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BDD.html  --  ACL2 Version 6.2</title></head>
+<head><title>BDD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>BDD</h1>ordered binary decision diagrams with rewriting
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/BIBLIOGRAPHY.html acl2-6.3/doc/HTML/BIBLIOGRAPHY.html
--- acl2-6.2/doc/HTML/BIBLIOGRAPHY.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/BIBLIOGRAPHY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BIBLIOGRAPHY.html  --  ACL2 Version 6.2</title></head>
+<head><title>BIBLIOGRAPHY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BIBLIOGRAPHY</h2>reports about ACL2
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/BINARY-+.html acl2-6.3/doc/HTML/BINARY-+.html
--- acl2-6.2/doc/HTML/BINARY-+.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/BINARY-+.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BINARY-+.html  --  ACL2 Version 6.2</title></head>
+<head><title>BINARY-+.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BINARY-+</h3>addition function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/BINARY-APPEND.html acl2-6.3/doc/HTML/BINARY-APPEND.html
--- acl2-6.2/doc/HTML/BINARY-APPEND.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/BINARY-APPEND.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BINARY-APPEND.html  --  ACL2 Version 6.2</title></head>
+<head><title>BINARY-APPEND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BINARY-APPEND</h3><a href="CONCATENATE.html">concatenate</a> two lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/BINARY-_star_.html acl2-6.3/doc/HTML/BINARY-_star_.html
--- acl2-6.2/doc/HTML/BINARY-_star_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/BINARY-_star_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BINARY-_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>BINARY-_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BINARY-*</h3>multiplication function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/BIND-FREE-EXAMPLES.html acl2-6.3/doc/HTML/BIND-FREE-EXAMPLES.html
--- acl2-6.2/doc/HTML/BIND-FREE-EXAMPLES.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/BIND-FREE-EXAMPLES.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,12 +1,15 @@
 <html>
-<head><title>BIND-FREE-EXAMPLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>BIND-FREE-EXAMPLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BIND-FREE-EXAMPLES</h3>examples pertaining to <code><a href="BIND-FREE.html">bind-free</a></code> hypotheses
 <pre>Major Section:  <a href="BIND-FREE.html">BIND-FREE</a>
 </pre><p/>
 <p>
 See <a href="BIND-FREE.html">bind-free</a> for a basic discussion of the use of <code>bind-free</code> to control
-rewriting.
+rewriting.</p><p>Note that the examples below all illustrate the common case in which a
+<code>bind-free</code> hypothesis generates a binding alist.  See <a href="BIND-FREE.html">bind-free</a>, in
+particular the final section, for a discussion of the case that instead a
+list of binding alists is generated.
 </p>
 <p>We give examples of the use of <code><a href="BIND-FREE.html">bind-free</a></code> hypotheses from the
 perspective of a user interested in reasoning about arithmetic, but
diff -Nru acl2-6.2/doc/HTML/BIND-FREE.html acl2-6.3/doc/HTML/BIND-FREE.html
--- acl2-6.2/doc/HTML/BIND-FREE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/BIND-FREE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,7 +1,7 @@
 <html>
-<head><title>BIND-FREE.html  --  ACL2 Version 6.2</title></head>
+<head><title>BIND-FREE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h2>BIND-FREE</h2>to bind free variables of a rewrite or linear rule
+<h2>BIND-FREE</h2>to bind free variables of a rewrite, definition, or linear rule
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
 </pre><p/>
 <p>
@@ -43,31 +43,35 @@
 (BIND-FREE term)
 </pre>
 
-A rule which uses a <code>bind-free</code> hypothesis has similarities to both a
-rule which uses a <code><a href="SYNTAXP.html">syntaxp</a></code> hypothesis and to a <code>:</code><code><a href="META.html">meta</a></code> rule.
-<code>Bind-free</code> is like <code><a href="SYNTAXP.html">syntaxp</a></code>, in that it logically always
-returns <code>t</code> but may affect the application of a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>
-or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule when it is called at the top-level of a
-hypothesis.  It is like a <code>:</code><code><a href="META.html">meta</a></code> rule, in that it allows the
-user to perform transformations of terms under progammatic control.</p><p>Note that a <code>bind-free</code> hypothesis does not, in general, deal with the
-meaning or semantics or values of the terms, but rather with their
-syntactic forms.  Before attempting to write a rule which uses
-<code>bind-free</code>, the user should be familiar with <code><a href="SYNTAXP.html">syntaxp</a></code> and the
-internal form that ACL2 uses for terms.  This internal form is
-similar to what the user sees, but there are subtle and important
-differences.  <code><a href="TRANS.html">Trans</a></code> can be used to view this internal form.</p><p>Just as for a <code><a href="SYNTAXP.html">syntaxp</a></code> hypothesis, there are two types of
-<code>bind-free</code> hypotheses.  The simpler type of <code>bind-free</code>
-hypothesis may be used as the nth hypothesis in a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>
+A rule which uses a <code>bind-free</code> hypothesis has similarities to both a rule
+which uses a <code><a href="SYNTAXP.html">syntaxp</a></code> hypothesis and to a <code>:</code><code><a href="META.html">meta</a></code> rule.
+<code>Bind-free</code> is like <code><a href="SYNTAXP.html">syntaxp</a></code>, in that it logically always returns
+<code>t</code> but may affect the application of a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>,
+<code>:</code><code><a href="DEFINITION.html">definition</a></code>, or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule when it is called at the
+top-level of a hypothesis.  It is like a <code>:</code><code><a href="META.html">meta</a></code> rule, in that it
+allows the user to perform transformations of terms under progammatic
+control.</p><p>Note that a <code>bind-free</code> hypothesis does not, in general, deal with the
+meaning or semantics or values of the terms, but rather with their syntactic
+forms.  Before attempting to write a rule which uses <code>bind-free</code>, the user
+should be familiar with <code><a href="SYNTAXP.html">syntaxp</a></code> and the internal form that ACL2 uses
+for terms.  This internal form is similar to what the user sees, but there
+are subtle and important differences.  <code><a href="TRANS.html">Trans</a></code> can be used to view this
+internal form.</p><p>Just as for a <code><a href="SYNTAXP.html">syntaxp</a></code> hypothesis, there are two basic types of
+<code>bind-free</code> hypotheses.  The simpler type of <code>bind-free</code> hypothesis may
+be used as the nth hypothesis in a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>, <code>:</code><code><a href="DEFINITION.html">definition</a></code>,
 or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule whose <code>:</code><code><a href="COROLLARY.html">corollary</a></code> is
 <code>(implies (and hyp1 ... hypn ... hypk) (equiv lhs rhs))</code> provided <code>term</code>
 is a term, <code>term</code> contains at least one variable, and every variable
 occuring freely in <code>term</code> occurs freely in <code>lhs</code> or in some <code>hypi</code>,
-<code>i&lt;n</code>.  In addition, <code>term</code> must not use any stobjs.
-(Later below we will describe the second type, an <em>extended</em>
-<code>bind-free</code> hypothesis, which may use <code><a href="STATE.html">state</a></code>.)</p><p>We begin our description of <code>bind-free</code> by examining the
-first example above in some detail.</p><p>We wish to write a rule which will cancel ``like'' addends from both
-sides of an equality.  Clearly, one could write a series of rules such
-as
+<code>i&lt;n</code>.  In addition, <code>term</code> must not use any stobjs.  Later below we will
+describe the second type, an <em>extended</em> <code>bind-free</code> hypothesis, which
+may use <code><a href="STATE.html">state</a></code>.  Whether simple or extended, a <code>bind-free</code> hypothesis
+may return an alist that binds free variables, as explained below, or it may
+return a list of such alists.  We focus on the first of these cases: return
+of a single binding alist.  We conclude our discussion with a section that
+covers the other case: return of a list of alists.</p><p>We begin our description of <code>bind-free</code> by examining the first example
+above in some detail.</p><p>We wish to write a rule which will cancel ``like'' addends from both sides of
+an equality.  Clearly, one could write a series of rules such as
 
 <pre>
 (DEFTHM THE-HARD-WAY-2-1
@@ -76,12 +80,10 @@
           (EQUAL (+ A B)
                  (FIX C))))
 </pre>
-
-with one rule for each combination of positions the matching addends
-might be found in (if one knew before-hand the maximum number of
-addends that would appear in a sum).  But there is a better way.
-(In what follows, we assume the presence of an appropriate set of rules
-for simplifying sums.)</p><p>Consider the following definitions and theorem:
+</p><p>with one rule for each combination of positions the matching addends might be
+found in (if one knew before-hand the maximum number of addends that would
+appear in a sum).  But there is a better way.  (In what follows, we assume
+the presence of an appropriate set of rules for simplifying sums.)</p><p>Consider the following definitions and theorem:
 
 <pre>
 (DEFUN INTERSECTION-EQUAL (X Y)
@@ -122,20 +124,19 @@
        (+ (bar b) (expt a n)))
 </pre>
 
-As mentioned above, the internal form of an ACL2 term is not always
-what one sees printed out by ACL2.  In this case, by using <code>:</code><code><a href="TRANS.html">trans</a></code>
-one can see that the term is stored internally as
+As mentioned above, the internal form of an ACL2 term is not always what one
+sees printed out by ACL2.  In this case, by using <code>:</code><code><a href="TRANS.html">trans</a></code> one can
+see that the term is stored internally as
 
 <pre>
 (equal (binary-+ '3
                  (binary-+ (expt a n) (foo a c)))
        (binary-+ (bar b) (expt a n))).
 </pre>
-</p><p>When ACL2 attempts to apply <code>cancel-matching-addends-equal</code> to the
-term under discussion, it first forms a substitution that instantiates
-the left-hand side of the conclusion so that it is identical to the
-target term.  This substitution is kept track of by the substitution
-alist:
+</p><p>When ACL2 attempts to apply <code>cancel-matching-addends-equal</code> to the term
+under discussion, it first forms a substitution that instantiates the
+left-hand side of the conclusion so that it is identical to the target term.
+This substitution is kept track of by the substitution alist:
 
 <pre>
 ((LHS . (binary-+ '3
@@ -144,21 +145,20 @@
 </pre>
 
 ACL2 then attempts to relieve the hypotheses in the order they were
-given. Ordinarily this means that we instantiate each hypothesis
-with our substitution and then attempt to rewrite the resulting
-instance to true.  Thus, in order to relieve the first hypothesis,
-we rewrite:
+given.  Ordinarily this means that we instantiate each hypothesis with our
+substitution and then attempt to rewrite the resulting instance to true.
+Thus, in order to relieve the first hypothesis, we rewrite:
 
 <pre>
 (RATIONALP (binary-+ '3
                       (binary-+ (expt a n) (foo a c)))).
 </pre>
 
-Let us assume that the first two hypotheses rewrite to <code>t</code>.  How
-do we relieve the <code>bind-free</code> hypothesis?  Just as for a <code><a href="SYNTAXP.html">syntaxp</a></code>
-hypothesis, ACL2 evaluates <code>(find-match-in-plus-nests lhs rhs)</code>
-in an environment where <code>lhs</code> and <code>rhs</code> are instantiated as determined
-by the substitution.  In this case we evaluate
+Let us assume that the first two hypotheses rewrite to <code>t</code>.  How do we
+relieve the <code>bind-free</code> hypothesis?  Just as for a <code><a href="SYNTAXP.html">syntaxp</a></code>
+hypothesis, ACL2 evaluates <code>(find-match-in-plus-nests lhs rhs)</code> in an
+environment where <code>lhs</code> and <code>rhs</code> are instantiated as determined by the
+substitution.  In this case we evaluate
 
 <pre>
 (FIND-MATCH-IN-PLUS-NESTS '(binary-+ '3
@@ -169,8 +169,8 @@
 Observe that, just as in the case of a <code><a href="SYNTAXP.html">syntaxp</a></code> hypothesis, we
 substitute the quotation of the variables bindings into the term to be
 evaluated.  See <a href="SYNTAXP.html">syntaxp</a> for the reasons for this.  The result of this
-evaluation, <code>((X . (EXPT A N)))</code>, is then used to extend the
-substitution alist:
+evaluation, <code>((X . (EXPT A N)))</code>, is then used to extend the substitution
+alist:
 
 <pre>
 ((X . (EXPT A N))
@@ -179,8 +179,8 @@
  (RHS . (binary-+ (bar b) (expt a n)))),
 </pre>
 
-and this extended substitution determines
-<code>cancel-matching-addends-equal</code>'s result:
+and this extended substitution determines <code>cancel-matching-addends-equal</code>'s
+result:
 
 <pre>
 (EQUAL (+ (- X) LHS) (+ (- X) RHS))
@@ -191,39 +191,120 @@
 
 Question: What is the internal form of this result?<br/>
 
-Hint: Use <code>:</code><code><a href="TRANS.html">trans</a></code>.</p><p>When this rule fires, it adds the negation of a common term
-to both sides of the equality by selecting a binding for the
-otherwise-free variable <code>x</code>, under programmatic control.  Note
-that other mechanisms such as the binding of <a href="FREE-VARIABLES.html">free-variables</a>
-may also extend the substitution alist.</p><p>Just as for a <code><a href="SYNTAXP.html">syntaxp</a></code> test, a <code>bind-free</code> form signals
-failure by returning <code>nil</code>.  However, while a <code><a href="SYNTAXP.html">syntaxp</a></code> test
-signals success by returning true, a <code>bind-free</code> form signals
-success by returning an alist which is used to extend the current
-substitution alist.  Because of this use of the alist, there are
-several restrictions on it -- in particular the alist must only
-bind variables, these variables must not be already bound by the
-substitution alist, and the variables must be bound to ACL2 terms.
-If <code>term</code> returns an alist and the alist meets these restrictions,
-we append the alist to the substitution alist and use the result as
-the new current substitution alist.  This new current
-substitution alist is then used when we attempt to relieve the next
-hypothesis or, if there are no more, instantiate the right hand side
-of the rule.</p><p>There is also a second, optional, <code>var-list</code> argument to a <code>bind-free</code>
+Hint: Use <code>:</code><code><a href="TRANS.html">trans</a></code>.</p><p>When this rule fires, it adds the negation of a common term to both sides of
+the equality by selecting a binding for the otherwise-free variable <code>x</code>,
+under programmatic control.  Note that other mechanisms such as the binding
+of <a href="FREE-VARIABLES.html">free-variables</a> may also extend the substitution alist.</p><p>Just as for a <code><a href="SYNTAXP.html">syntaxp</a></code> test, a <code>bind-free</code> form signals failure by
+returning <code>nil</code>.  However, while a <code><a href="SYNTAXP.html">syntaxp</a></code> test signals success by
+returning true, a <code>bind-free</code> form signals success by returning an alist
+which is used to extend the current substitution alist.  Because of this use
+of the alist, there are several restrictions on it -- in particular the
+alist must only bind variables, these variables must not be already bound by
+the substitution alist, and the variables must be bound to ACL2 terms.  If
+<code>term</code> returns an alist and the alist meets these restrictions, we append
+the alist to the substitution alist and use the result as the new current
+substitution alist.  This new current substitution alist is then used when we
+attempt to relieve the next hypothesis or, if there are no more, instantiate
+the right hand side of the rule.</p><p>There is also a second, optional, <code>var-list</code> argument to a <code>bind-free</code>
 hypothesis.  If provided, it must be either <code>t</code> or a list of variables.  If
 it is not provided, it defaults to <code>t</code>.  If it is a list of variables, this
 second argument is used to place a further restriction on the possible values
 of the alist to be returned by <code>term</code>: any variables bound in the alist
 must be present in the list of variables.  We strongly recommend the use of
 this list of variables, as it allows some consistency checks to be performed
-at the time of the rule's admittance which are not possible otherwise.</p><p>An extended <code>bind-free</code> hypothesis is similar to the simple type
-described above, but it uses two additional variables, <code>mfc</code> and <code>state</code>,
-which must not be bound by the left hand side or an earlier hypothesis
-of the rule.  They must be the last two variables mentioned by <code>term</code>:
-first <code>mfc</code>, then <code>state</code>.  These two variables give access to
-the functions <code>mfc-</code>xxx; see <a href="EXTENDED-METAFUNCTIONS.html">extended-metafunctions</a>.  As
-described there, <code>mfc</code> is bound to the so-called
-metafunction-context and <code>state</code> to ACL2's <code><a href="STATE.html">state</a></code>.  See <a href="BIND-FREE-EXAMPLES.html">bind-free-examples</a>
-for examples of the use of these extended <code>bind-free</code> hypotheses.
+at the time of the rule's admittance which are not possible otherwise.</p><p>An extended <code>bind-free</code> hypothesis is similar to the simple type described
+above, but it uses two additional variables, <code>mfc</code> and <code>state</code>, which
+must not be bound by the left hand side or an earlier hypothesis of the rule.
+They must be the last two variables mentioned by <code>term</code>: first <code>mfc</code>,
+then <code>state</code>.  These two variables give access to the functions
+<code>mfc-</code>xxx; see <a href="EXTENDED-METAFUNCTIONS.html">extended-metafunctions</a>.  As described there, <code>mfc</code> is
+bound to the so-called metafunction-context and <code>state</code> to ACL2's
+<code><a href="STATE.html">state</a></code>.  See <a href="BIND-FREE-EXAMPLES.html">bind-free-examples</a> for examples of the use of these
+extended <code>bind-free</code> hypotheses.</p><p><strong>SECTION</strong>: Returning a list of alists.</p><p>As promised above, we conclude with a discussion of the case that evaluation
+of the <code>bind-free</code> term produces a list of alists, <code>x</code>, rather than a
+single alist.  In this case each member <code>b</code> of <code>x</code> is considered in turn,
+starting with the first and proceeding through the list.  Each such <code>b</code> is
+handled exactly as discussed above, as though it were the result of
+evaluating the <code>bind-free</code> term.  Thus, each <code>b</code> extends the current
+variable binding alist, and all remaining hypotheses are then relieved, as
+though <code>b</code> had been the value obtained by evaluating the <code>bind-free</code>
+term.  As soon as one such <code>b</code> leads to successful relieving of all
+remaining hypotheses, the process of relieving hypotheses concludes, so no
+further members of <code>x</code> are considered.</p><p>We illustrate with a simple pedagogical example.  First introduce functions
+<code>p1</code> and <code>p2</code> such that a rewrite rule specifies that <code>p2</code> implies
+<code>p1</code>, but with a free variable.
+
+<pre>
+
+(defstub p1 (x) t)
+(defstub p2 (x y) t)
+
+(defaxiom p2-implies-p1
+  (implies (p2 x y)
+           (p1 x)))
+
+</pre>
+
+If we add the following axiom, then <code>(p1 x)</code> follows logically for all
+<code>x</code>.
+
+<pre>
+
+(defaxiom p2-instance
+  (p2 v (cons v 4)))
+
+</pre>
+
+Unfortunately, evaluation of <code>(thm (p1 a))</code> fails, because ACL2 fails to
+bind the free variable <code>y</code> in order to apply the rule <code>p2-instance</code>.</p><p>Let's define a function that produces a list of alists, each binding the
+variable <code>y</code>.  Of course, we know that only the middle one below is
+necessary in this simple example.  In more complex examples, one might use
+heuristics to construct such a list of alists.
+
+<pre>
+
+(defun my-alists (x)
+  (list (list (cons 'y (fcons-term* 'cons x ''3)))
+        (list (cons 'y (fcons-term* 'cons x ''4)))
+        (list (cons 'y (fcons-term* 'cons x ''5)))))
+
+</pre>
+
+The following rewrite rule uses <code>bind-free</code> to return a list of candidate
+alists binding <code>y</code>.
+
+<pre>
+
+(defthm p2-implies-p1-better
+  (implies (and (bind-free (my-alists x)
+                           (y)) ; the second argument, (y), is optional
+                (p2 x y))
+           (p1 x)))
+
+</pre>
+
+Now the proof succeeds for <code>(thm (p1 a))</code>.  Why?  When ACL2 applies the
+<code>rewrite</code> rule <code>p2-implies-p1-better</code>, it evaluates <code>my-alists</code>, as we
+can see from the following <a href="TRACE.html">trace</a>, to bind <code>y</code> in three different
+alists.
+
+<pre>
+
+ACL2 !&gt;(thm (p1 a))
+1&gt; (ACL2_*1*_ACL2::MY-ALISTS A)
+&lt;1 (ACL2_*1*_ACL2::MY-ALISTS (((Y CONS A '3))
+                              ((Y CONS A '4))
+                              ((Y CONS A '5))))
+
+Q.E.D.
+
+</pre>
+
+The first alist, binding <code>y</code> to <code>(cons a '3)</code>, fails to allow the
+hypothesis <code>(p2 x y)</code> to be proved.  But the next binding of <code>y</code>, to
+<code>(cons a '4)</code>, succeeds: then the current binding alist is
+<code>((x . a) (y . (cons a '4)))</code>, for which the hypothesis <code>(p2 x y)</code>
+rewrites to true using the rewrite rule <code>p2-instance</code>.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
 </html>
diff -Nru acl2-6.2/doc/HTML/BOOK-COMPILED-FILE.html acl2-6.3/doc/HTML/BOOK-COMPILED-FILE.html
--- acl2-6.2/doc/HTML/BOOK-COMPILED-FILE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOK-COMPILED-FILE.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOK-COMPILED-FILE.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOK-COMPILED-FILE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BOOK-COMPILED-FILE</h2>creating and loading of compiled and expansion files for <a href="BOOKS.html">books</a>
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/BOOK-CONTENTS.html acl2-6.3/doc/HTML/BOOK-CONTENTS.html
--- acl2-6.2/doc/HTML/BOOK-CONTENTS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOK-CONTENTS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOK-CONTENTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOK-CONTENTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BOOK-CONTENTS</h2>restrictions on the forms inside <a href="BOOKS.html">books</a>
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/BOOK-EXAMPLE.html acl2-6.3/doc/HTML/BOOK-EXAMPLE.html
--- acl2-6.2/doc/HTML/BOOK-EXAMPLE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOK-EXAMPLE.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOK-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOK-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BOOK-EXAMPLE</h2>how to create, certify, and use a simple book
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/BOOK-MAKEFILES.html acl2-6.3/doc/HTML/BOOK-MAKEFILES.html
--- acl2-6.2/doc/HTML/BOOK-MAKEFILES.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOK-MAKEFILES.html	2013-09-30 17:39:26.000000000 +0000
@@ -0,0 +1,11 @@
+<html>
+<head><title>BOOK-MAKEFILES.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>BOOK-MAKEFILES</h2>See <a href="BOOKS-CERTIFICATION.html">books-certification</a>.
+<pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
+</pre><p/>
+<p></p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/BOOK-NAME.html acl2-6.3/doc/HTML/BOOK-NAME.html
--- acl2-6.2/doc/HTML/BOOK-NAME.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOK-NAME.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOK-NAME.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOK-NAME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BOOK-NAME</h2>conventions associated with book names
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/BOOKS-CERTIFICATION-CLASSIC.html acl2-6.3/doc/HTML/BOOKS-CERTIFICATION-CLASSIC.html
--- acl2-6.2/doc/HTML/BOOKS-CERTIFICATION-CLASSIC.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOKS-CERTIFICATION-CLASSIC.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOKS-CERTIFICATION-CLASSIC.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOKS-CERTIFICATION-CLASSIC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BOOKS-CERTIFICATION-CLASSIC</h2>classic ACL2 `make'-based certification of <a href="BOOKS.html">books</a>
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/BOOKS-CERTIFICATION.html acl2-6.3/doc/HTML/BOOKS-CERTIFICATION.html
--- acl2-6.2/doc/HTML/BOOKS-CERTIFICATION.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOKS-CERTIFICATION.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOKS-CERTIFICATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOKS-CERTIFICATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BOOKS-CERTIFICATION</h2>certifying ACL2 community <a href="BOOKS.html">books</a>
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
@@ -9,7 +9,9 @@
 explain how to certify those books, or some of those books, with ACL2.  We
 thank Bishop Brock, Jared Davis, and Sol Swords for their substantial
 contributions to this methodology.  See <code>books/Makefile</code>, in the community
-books, for more about ``Credits and History''.</p><p>For more information about installing ACL2, see the installation
+books, for more about ``Credits and History'', and for additional technical
+details not covered in this topic (for example, how to build a local copy of
+the xdoc manual for those who may wish to do that).</p><p>For more information about installing ACL2, see the installation
 instructions, either by following a link from the ACL2 home page or by going
 directly to the page
 <a href="http://www.cs.utexas.edu/users/moore/acl2/current/installation/installation.html">http://www.cs.utexas.edu/users/moore/acl2/current/installation/installation.html</a>.
diff -Nru acl2-6.2/doc/HTML/BOOKS.html acl2-6.3/doc/HTML/BOOKS.html
--- acl2-6.2/doc/HTML/BOOKS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOKS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOKS.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOKS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>BOOKS</h1>files of ACL2 event forms
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -33,6 +33,10 @@
 </h3>
 </li>
 
+<li><h3><a href="BOOK-MAKEFILES.html">BOOK-MAKEFILES</a> -- See <a href="BOOKS-CERTIFICATION.html">books-certification</a>.
+</h3>
+</li>
+
 <li><h3><a href="BOOK-NAME.html">BOOK-NAME</a> -- conventions associated with book names
 </h3>
 </li>
@@ -57,6 +61,10 @@
 </h3>
 </li>
 
+<li><h3><a href="CERTIFYING-BOOKS.html">CERTIFYING-BOOKS</a> -- See <a href="BOOKS-CERTIFICATION.html">books-certification</a>.
+</h3>
+</li>
+
 <li><h3><a href="COMMUNITY-BOOKS.html">COMMUNITY-BOOKS</a> -- <a href="BOOKS.html">books</a> contributed by the ACL2 community
 </h3>
 </li>
diff -Nru acl2-6.2/doc/HTML/BOOLE$.html acl2-6.3/doc/HTML/BOOLE$.html
--- acl2-6.2/doc/HTML/BOOLE$.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOLE$.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOLE$.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOLE$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BOOLE$</h3>perform a bit-wise logical operation on 2 two's complement integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/BOOLEANP.html acl2-6.3/doc/HTML/BOOLEANP.html
--- acl2-6.2/doc/HTML/BOOLEANP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/BOOLEANP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOOLEANP.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOOLEANP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BOOLEANP</h3>recognizer for booleans
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/BOUNDERS.html acl2-6.3/doc/HTML/BOUNDERS.html
--- acl2-6.2/doc/HTML/BOUNDERS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/BOUNDERS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BOUNDERS.html  --  ACL2 Version 6.2</title></head>
+<head><title>BOUNDERS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BOUNDERS</h3>intervals, bounder functions, and bounder correctness
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/BREAK$.html acl2-6.3/doc/HTML/BREAK$.html
--- acl2-6.2/doc/HTML/BREAK$.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/BREAK$.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BREAK$.html  --  ACL2 Version 6.2</title></head>
+<head><title>BREAK$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BREAK$</h3>cause an immediate Lisp break
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/BREAK-LEMMA.html acl2-6.3/doc/HTML/BREAK-LEMMA.html
--- acl2-6.2/doc/HTML/BREAK-LEMMA.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BREAK-LEMMA.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BREAK-LEMMA.html  --  ACL2 Version 6.2</title></head>
+<head><title>BREAK-LEMMA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BREAK-LEMMA</h2>a quick introduction to breaking rewrite rules in ACL2
 <pre>Major Section:  <a href="BREAK-REWRITE.html">BREAK-REWRITE</a>
diff -Nru acl2-6.2/doc/HTML/BREAK-ON-ERROR.html acl2-6.3/doc/HTML/BREAK-ON-ERROR.html
--- acl2-6.2/doc/HTML/BREAK-ON-ERROR.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/BREAK-ON-ERROR.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BREAK-ON-ERROR.html  --  ACL2 Version 6.2</title></head>
+<head><title>BREAK-ON-ERROR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BREAK-ON-ERROR</h2>break when encountering a hard or soft error caused by ACL2
 <pre>Major Section:  <a href="TRACE.html">TRACE</a>
diff -Nru acl2-6.2/doc/HTML/BREAK-REWRITE.html acl2-6.3/doc/HTML/BREAK-REWRITE.html
--- acl2-6.2/doc/HTML/BREAK-REWRITE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BREAK-REWRITE.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BREAK-REWRITE.html  --  ACL2 Version 6.2</title></head>
+<head><title>BREAK-REWRITE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>BREAK-REWRITE</h1>the read-eval-print loop entered to <a href="MONITOR.html">monitor</a> rewrite rules
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -65,25 +65,23 @@
 evaluates its break condition and if the result is non-<code>nil</code>,
 break-rewrite is entered.</p><p>Break-rewrite permits the user to inspect the current <a href="STATE.html">state</a> by
 evaluating break-rewrite commands.  Type <code>:</code><code><a href="HELP.html">help</a></code> in break-rewrite to
-see what the break-rewrite commands are.  However, break-rewrite is
-actually just a call of the general ACL2 read-eval-print loop, <code><a href="LD.html">ld</a></code>,
-on a certain <a href="STATE.html">state</a> and the break-rewrite commands are simply aliases
-provided by the <code><a href="LD.html">ld</a></code>-special <code><a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a></code>.  See <a href="LD.html">ld</a> for
-details about this read-eval-print loop.  Thus, with a few
-exceptions, anything you can do at the ACL2 top-level can be done
-within break-rewrite.  For example, you can evaluate arbitrary
-expressions, use the keyword command hack, access <a href="DOCUMENTATION.html">documentation</a>,
-print <a href="EVENTS.html">events</a>, and even define functions and prove theorems.
-However, the ``certain <a href="STATE.html">state</a>'' upon which <code><a href="LD.html">ld</a></code> was called is a
-``<a href="WORMHOLE.html">wormhole</a> <a href="STATE.html">state</a>'' (see <a href="WORMHOLE.html">wormhole</a>) because break-rewrite is not
-allowed to have any effect upon the behavior of rewrite.  What this
-means, very roughly but understandably, is that break-rewrite
+see what the break-rewrite commands are.  However, break-rewrite is actually
+just a call of the general ACL2 read-eval-print loop, <code><a href="LD.html">ld</a></code>, on a certain
+<a href="STATE.html">state</a> and the break-rewrite commands are simply aliases provided by
+<code>ld-keyword-aliases</code> <a href="TABLE.html">table</a> (see <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>).  See <a href="LD.html">ld</a> for
+details about this read-eval-print loop.  Thus, with a few exceptions,
+anything you can do at the ACL2 top-level can be done within break-rewrite.
+For example, you can evaluate arbitrary expressions, use the keyword command
+hack, access <a href="DOCUMENTATION.html">documentation</a>, print <a href="EVENTS.html">events</a>, and even define functions
+and prove theorems.  However, the ``certain <a href="STATE.html">state</a>'' upon which <code><a href="LD.html">ld</a></code>
+was called is a ``<a href="WORMHOLE.html">wormhole</a> <a href="STATE.html">state</a>'' (see <a href="WORMHOLE.html">wormhole</a>) because
+break-rewrite is not allowed to have any effect upon the behavior of rewrite.
+What this means, very roughly but understandably, is that break-rewrite
 operates on a copy of the <a href="STATE.html">state</a> being used by rewrite and when
 break-rewrite exits the <a href="WORMHOLE.html">wormhole</a> closes and the <a href="STATE.html">state</a> ``produced''
-by break-rewrite disappears.  Thus, break-rewrite lets you query the
-state of the rewriter and even do experiments involving proofs,
-etc., but these experiments have no effect on the ongoing proof
-attempt.  In particular:</p><p>Note that the output from break-rewrite is sometimes abbreviated by default,
+by break-rewrite disappears.  Thus, break-rewrite lets you query the state of
+the rewriter and even do experiments involving proofs, etc., but these
+experiments have no effect on the ongoing proof attempt.  In particular:</p><p>Note that the output from break-rewrite is sometimes abbreviated by default,
 such as for the term causing the break.  This can be controlled by setting
 the <code>:term</code> evisc-tuple; see <a href="SET-EVISC-TUPLE.html">set-evisc-tuple</a>.  (Another option: use
 iprinting.  See <a href="SET-IPRINT.html">set-iprint</a>.)  But as noted above, if you use
diff -Nru acl2-6.2/doc/HTML/BREAKS.html acl2-6.3/doc/HTML/BREAKS.html
--- acl2-6.2/doc/HTML/BREAKS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/BREAKS.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BREAKS.html  --  ACL2 Version 6.2</title></head>
+<head><title>BREAKS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BREAKS</h3>Common Lisp breaks
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/BRR-COMMANDS.html acl2-6.3/doc/HTML/BRR-COMMANDS.html
--- acl2-6.2/doc/HTML/BRR-COMMANDS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BRR-COMMANDS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BRR-COMMANDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>BRR-COMMANDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BRR-COMMANDS</h2><a href="BREAK-REWRITE.html">Break-Rewrite</a> Commands
 <pre>Major Section:  <a href="BREAK-REWRITE.html">BREAK-REWRITE</a>
diff -Nru acl2-6.2/doc/HTML/BRR.html acl2-6.3/doc/HTML/BRR.html
--- acl2-6.2/doc/HTML/BRR.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BRR.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BRR.html  --  ACL2 Version 6.2</title></head>
+<head><title>BRR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BRR</h2>to enable or disable the breaking of rewrite rules
 <pre>Major Section:  <a href="BREAK-REWRITE.html">BREAK-REWRITE</a>
diff -Nru acl2-6.2/doc/HTML/BRR_at_.html acl2-6.3/doc/HTML/BRR_at_.html
--- acl2-6.2/doc/HTML/BRR_at_.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/BRR_at_.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BRR_at_.html  --  ACL2 Version 6.2</title></head>
+<head><title>BRR_at_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BRR@</h2>to access context sensitive information within <code><a href="BREAK-REWRITE.html">break-rewrite</a></code>
 <pre>Major Section:  <a href="BREAK-REWRITE.html">BREAK-REWRITE</a>
diff -Nru acl2-6.2/doc/HTML/BUILT-IN-CLAUSE.html acl2-6.3/doc/HTML/BUILT-IN-CLAUSE.html
--- acl2-6.2/doc/HTML/BUILT-IN-CLAUSE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/BUILT-IN-CLAUSE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,39 +1,39 @@
 <html>
-<head><title>BUILT-IN-CLAUSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>BUILT-IN-CLAUSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BUILT-IN-CLAUSE</h2>to build a clause into the simplifier
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
-how they are used to build rules from formulas.  A <code>:built-in-clause</code>
-rule can be built from any formula other than propositional
-tautologies.  Roughly speaking, the system uses the list of built-in
-clauses as the first method of proof when attacking a new goal.  Any
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
+<pre>
+Example:
+(defthm acl2-count-abl
+  (and (implies (and (true-listp x)
+                     (not (equal x nil)))
+                (&lt; (acl2-count (abl x))
+                   (acl2-count x)))
+       (implies (and (true-listp x)
+                     (not (equal nil x)))
+                (&lt; (acl2-count (abl x))
+                   (acl2-count x))))
+  :rule-classes :built-in-clause)
+</pre>
+</p><p>A <code>:built-in-clause</code> rule can be built from any formula other than
+propositional tautologies.  Roughly speaking, the system uses the list of
+built-in clauses as the first method of proof when attacking a new goal.  Any
 goal that is subsumed by a built in clause is proved ``silently.''
 </p>
-<p>ACL2 maintains a set of ``built-in'' clauses that are used to
-short-circuit certain theorem proving tasks.  We discuss this at
-length below.  When a theorem is given the rule class
-<code>:built-in-clause</code> ACL2 flattens the <code><a href="IMPLIES.html">implies</a></code> and <code><a href="AND.html">and</a></code> structure of the
-<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula so as to obtain a set of formulas whose
-conjunction is equivalent to the given corollary.  It then converts
-each of these to clausal form and adds each clause to the set of
-built-in clauses.</p><p>For example, the following <code>:</code><code><a href="COROLLARY.html">corollary</a></code> (regardless of the definition
-of <code>abl</code>)
-
-<pre>
-(and (implies (and (true-listp x)
-                   (not (equal x nil)))
-              (&lt; (acl2-count (abl x))
-                 (acl2-count x)))
-     (implies (and (true-listp x)
-                   (not (equal nil x)))
-              (&lt; (acl2-count (abl x))
-                 (acl2-count x))))
-</pre>
-
-will build in two clauses,
+<p>ACL2 maintains a set of ``built-in'' clauses that are used to short-circuit
+certain theorem proving tasks.  We discuss this at length below.  When a
+theorem is given the rule class <code>:built-in-clause</code> ACL2 flattens the
+<code><a href="IMPLIES.html">implies</a></code> and <code><a href="AND.html">and</a></code> structure of the <code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula so
+as to obtain a set of formulas whose conjunction is equivalent to the given
+corollary.  It then converts each of these to clausal form and adds each
+clause to the set of built-in clauses.</p><p>The example above (regardless of the definition of <code>abl</code>) will build in two
+clauses,
 
 <pre>
 {(not (true-listp x))
@@ -84,37 +84,33 @@
 </pre>
 
 and the subsumption property just means that <code>c1</code> follows trivially
-from <code>c2</code> by instantiation.</p><p>The set of built-in clauses is just a set of known theorems in
-clausal form.  Any formula that is subsumed by a built-in clause is
-thus a theorem.  If the set of built-in theorems is reasonably
-small, this little theorem prover is fast.  ACL2 uses the ``built-in
-clause check'' in four places: (1) at the top of the iteration in
-the prover -- thus if a built-in clause is generated as a subgoal it
-will be recognized when that goal is considered, (2) within the
+from <code>c2</code> by instantiation.</p><p>The set of built-in clauses is just a set of known theorems in clausal form.
+Any formula that is subsumed by a built-in clause is thus a theorem.  If the
+set of built-in theorems is reasonably small, this little theorem prover is
+fast.  ACL2 uses the ``built-in clause check'' in four places: (1) at the top
+of the iteration in the prover -- thus if a built-in clause is generated as a
+subgoal it will be recognized when that goal is considered, (2) within the
 simplifier so that no built-in clause is ever generated by
-simplification, (3) as a filter on the clauses generated to prove
-the termination of recursively <code><a href="DEFUN.html">defun</a></code>'d functions and (4) as a
-filter on the clauses generated to verify the guards of a function.</p><p>The latter two uses are the ones that most often motivate an
-extension to the set of built-in clauses.  Frequently a given
-formalization problem requires the definition of many functions
-which require virtually identical termination and/or guard proofs.
-These proofs can be short-circuited by extending the set of built-in
-clauses to contain the most general forms of the clauses generated
-by the definitional schemes in use.</p><p>The attentive user might have noticed that there are some recursive
-schemes, e.g., recursion by <code><a href="CDR.html">cdr</a></code> after testing <code><a href="CONSP.html">consp</a></code>, that ACL2 just
-seems to ``know'' are ok, while for others it generates measure
-clauses to prove.  Actually, it always generates measure clauses but
-then filters out any that pass the built-in clause check.  When ACL2
-is initialized, the clause justifying <code><a href="CDR.html">cdr</a></code> recursion after a <code><a href="CONSP.html">consp</a></code>
-test is added to the set of built-in clauses.  (That clause is <code>c2</code>
-above.)</p><p>Note that only a subsumption check is made; no rewriting or
-simplification is done.  Thus, if we want the system to ``know''
-that <code><a href="CDR.html">cdr</a></code> recursion is ok after a negative <code><a href="ATOM.html">atom</a></code> test (which, by the
-definition of <code><a href="ATOM.html">atom</a></code>, is the same as a <code><a href="CONSP.html">consp</a></code> test), we have to build
-in a second clause.  The subsumption algorithm does not ``know''
-about commutative functions.  Thus, for predictability, we have
-built in commuted versions of each clause involving commutative
-functions.  For example, we build in both
+simplification, (3) as a filter on the clauses generated to prove the
+termination of recursively <code><a href="DEFUN.html">defun</a></code>'d functions and (4) as a filter on the
+clauses generated to verify the guards of a function.</p><p>The latter two uses are the ones that most often motivate an extension to the
+set of built-in clauses.  Frequently a given formalization problem requires
+the definition of many functions which require virtually identical
+termination and/or guard proofs.  These proofs can be short-circuited by
+extending the set of built-in clauses to contain the most general forms of
+the clauses generated by the definitional schemes in use.</p><p>The attentive user might have noticed that there are some recursive schemes,
+e.g., recursion by <code><a href="CDR.html">cdr</a></code> after testing <code><a href="CONSP.html">consp</a></code>, that ACL2 just seems
+to ``know'' are ok, while for others it generates measure clauses to prove.
+Actually, it always generates measure clauses but then filters out any that
+pass the built-in clause check.  When ACL2 is initialized, the clause
+justifying <code><a href="CDR.html">cdr</a></code> recursion after a <code><a href="CONSP.html">consp</a></code> test is added to the set
+of built-in clauses.  (That clause is <code>c2</code> above.)</p><p>Note that only a subsumption check is made; no rewriting or simplification is
+done.  Thus, if we want the system to ``know'' that <code><a href="CDR.html">cdr</a></code> recursion is ok
+after a negative <code><a href="ATOM.html">atom</a></code> test (which, by the definition of <code><a href="ATOM.html">atom</a></code>, is
+the same as a <code><a href="CONSP.html">consp</a></code> test), we have to build in a second clause.  The
+subsumption algorithm does not ``know'' about commutative functions.  Thus,
+for predictability, we have built in commuted versions of each clause
+involving commutative functions.  For example, we build in both
 
 <pre>
 {(not (integerp x))
diff -Nru acl2-6.2/doc/HTML/BUTLAST.html acl2-6.3/doc/HTML/BUTLAST.html
--- acl2-6.2/doc/HTML/BUTLAST.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/BUTLAST.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BUTLAST.html  --  ACL2 Version 6.2</title></head>
+<head><title>BUTLAST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>BUTLAST</h3>all but a final segment of a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/BY.html acl2-6.3/doc/HTML/BY.html
--- acl2-6.2/doc/HTML/BY.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/BY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>BY.html  --  ACL2 Version 6.2</title></head>
+<head><title>BY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>BY</h2>hints keyword <code>:BY</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/CAAAAR.html acl2-6.3/doc/HTML/CAAAAR.html
--- acl2-6.2/doc/HTML/CAAAAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CAAAAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CAAAAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CAAAAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CAAAAR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CAAAR.html">caaar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CAAADR.html acl2-6.3/doc/HTML/CAAADR.html
--- acl2-6.2/doc/HTML/CAAADR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CAAADR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CAAADR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CAAADR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CAAADR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CAADR.html">caadr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CAAAR.html acl2-6.3/doc/HTML/CAAAR.html
--- acl2-6.2/doc/HTML/CAAAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CAAAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CAAAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CAAAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CAAAR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CAAR.html">caar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CAADAR.html acl2-6.3/doc/HTML/CAADAR.html
--- acl2-6.2/doc/HTML/CAADAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CAADAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CAADAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CAADAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CAADAR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CADAR.html">cadar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CAADDR.html acl2-6.3/doc/HTML/CAADDR.html
--- acl2-6.2/doc/HTML/CAADDR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CAADDR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CAADDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CAADDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CAADDR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CADDR.html">caddr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CAADR.html acl2-6.3/doc/HTML/CAADR.html
--- acl2-6.2/doc/HTML/CAADR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CAADR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CAADR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CAADR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CAADR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CADR.html">cadr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CAAR.html acl2-6.3/doc/HTML/CAAR.html
--- acl2-6.2/doc/HTML/CAAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CAAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CAAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CAAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CAAR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CAR.html">car</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CADAAR.html acl2-6.3/doc/HTML/CADAAR.html
--- acl2-6.2/doc/HTML/CADAAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CADAAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CADAAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CADAAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CADAAR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CDAAR.html">cdaar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CADADR.html acl2-6.3/doc/HTML/CADADR.html
--- acl2-6.2/doc/HTML/CADADR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CADADR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CADADR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CADADR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CADADR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CDADR.html">cdadr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CADAR.html acl2-6.3/doc/HTML/CADAR.html
--- acl2-6.2/doc/HTML/CADAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CADAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CADAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CADAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CADAR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CDAR.html">cdar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CADDAR.html acl2-6.3/doc/HTML/CADDAR.html
--- acl2-6.2/doc/HTML/CADDAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CADDAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CADDAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CADDAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CADDAR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CDDAR.html">cddar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CADDDR.html acl2-6.3/doc/HTML/CADDDR.html
--- acl2-6.2/doc/HTML/CADDDR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CADDDR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CADDDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CADDDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CADDDR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CDDDR.html">cdddr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CADDR.html acl2-6.3/doc/HTML/CADDR.html
--- acl2-6.2/doc/HTML/CADDR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CADDR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CADDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CADDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CADDR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CDDR.html">cddr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CADR.html acl2-6.3/doc/HTML/CADR.html
--- acl2-6.2/doc/HTML/CADR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CADR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CADR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CADR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CADR</h3><code><a href="CAR.html">car</a></code> of the <code><a href="CDR.html">cdr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CALLING-LD-IN-BAD-CONTEXTS.html acl2-6.3/doc/HTML/CALLING-LD-IN-BAD-CONTEXTS.html
--- acl2-6.2/doc/HTML/CALLING-LD-IN-BAD-CONTEXTS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/CALLING-LD-IN-BAD-CONTEXTS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CALLING-LD-IN-BAD-CONTEXTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>CALLING-LD-IN-BAD-CONTEXTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CALLING-LD-IN-BAD-CONTEXTS</h3>errors caused by calling <code><a href="LD.html">ld</a></code> in inappropriate contexts
 <pre>Major Section:  <a href="LD.html">LD</a>
diff -Nru acl2-6.2/doc/HTML/CANONICAL-PATHNAME.html acl2-6.3/doc/HTML/CANONICAL-PATHNAME.html
--- acl2-6.2/doc/HTML/CANONICAL-PATHNAME.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CANONICAL-PATHNAME.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CANONICAL-PATHNAME.html  --  ACL2 Version 6.2</title></head>
+<head><title>CANONICAL-PATHNAME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CANONICAL-PATHNAME</h3>the true absolute filename, with soft links resolved
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CAR.html acl2-6.3/doc/HTML/CAR.html
--- acl2-6.2/doc/HTML/CAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CAR</h3>returns the first element of a non-empty list, else <code>nil</code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CASE-MATCH.html acl2-6.3/doc/HTML/CASE-MATCH.html
--- acl2-6.2/doc/HTML/CASE-MATCH.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CASE-MATCH.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CASE-MATCH.html  --  ACL2 Version 6.2</title></head>
+<head><title>CASE-MATCH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CASE-MATCH</h3>pattern matching or destructuring
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CASE-SPLIT-LIMITATIONS.html acl2-6.3/doc/HTML/CASE-SPLIT-LIMITATIONS.html
--- acl2-6.2/doc/HTML/CASE-SPLIT-LIMITATIONS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/CASE-SPLIT-LIMITATIONS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CASE-SPLIT-LIMITATIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>CASE-SPLIT-LIMITATIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CASE-SPLIT-LIMITATIONS</h2>a list of two ``numbers'' limiting the number of cases produced at once
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/CASE-SPLIT.html acl2-6.3/doc/HTML/CASE-SPLIT.html
--- acl2-6.2/doc/HTML/CASE-SPLIT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/CASE-SPLIT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,18 +1,24 @@
 <html>
-<head><title>CASE-SPLIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>CASE-SPLIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CASE-SPLIT</h2>like force but immediately splits the top-level goal on the hypothesis
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
 </pre><p/>
 <p>
-When a hypothesis of a conditional rule has the form <code>(case-split hyp)</code>
-it is logically equivalent to <code>hyp</code>.  However it affects the
-application of the rule generated as follows:  if ACL2
-attempts to apply the rule but cannot establish that the required
-instance of <code>hyp</code> holds in the current context, it considers the
-hypothesis true anyhow, but (assuming all hypotheses are seen to be true and
-the rule is applied) creates a subgoal in which that instance of <code>hyp</code> is
-assumed false.  (There are exceptions, noted below.)
+<code>Case-split</code> is an variant of <code><a href="FORCE.html">force</a></code>, which has similar special
+treatment in hypotheses of rules for the same <a href="RULE-CLASSES.html">rule-classes</a> as for
+<code>force</code> (see <a href="FORCE.html">force</a>).  This treatment takes place for rule classes
+<code>:</code><code><a href="REWRITE.html">rewrite</a></code>, <code>:</code><code><a href="LINEAR.html">linear</a></code>, <code>:</code><code><a href="TYPE-PRESCRIPTION.html">type-prescription</a></code>,
+<code>:</code><code><a href="DEFINITION.html">definition</a></code>, <code>:</code><code><a href="META.html">meta</a></code> (actually in that case, the result of
+evaluating the hypothesis metafunction call), and
+<code>:</code><code><a href="FORWARD-CHAINING.html">forward-chaining</a></code>.</p><p>When a hypothesis of a conditional rule (of one of the classes listed above)
+has the form <code>(case-split hyp)</code> it is logically equivalent to <code>hyp</code>.
+However it affects the application of the rule generated as follows: if ACL2
+attempts to apply the rule but cannot establish that the required instance of
+<code>hyp</code> holds in the current context, it considers the hypothesis true
+anyhow, but (assuming all hypotheses are seen to be true and the rule is
+applied) creates a subgoal in which that instance of <code>hyp</code> is assumed
+false.  (There are exceptions, noted below.)
 </p>
 <p>For example, given the rule
 
@@ -35,12 +41,12 @@
          (P2 (CAR X))).
 </pre>
 
-Unlike <code><a href="FORCE.html">force</a></code>, <code>case-split</code> does not delay the ``false case'' to
-a forcing round but tackles it more or less immediately.</p><p>The special ``split'' treatment of <code>case-split</code> can be disabled by
-disabling forcing:  see <a href="FORCE.html">force</a> for a discussion of disabling forcing, and
-also see <a href="DISABLE-FORCING.html">disable-forcing</a>.  Finally, we should mention that the rewriter is
-never willing to split when there is an <code><a href="IF.html">if</a></code> term present in the goal
-being simplified.  Since <code><a href="AND.html">and</a></code> terms and <code><a href="OR.html">or</a></code> terms are merely
+Unlike <code><a href="FORCE.html">force</a></code>, <code>case-split</code> does not delay the ``false case'' to a
+forcing round but tackles it more or less immediately.</p><p>The special ``split'' treatment of <code>case-split</code> can be disabled by
+disabling forcing: see <a href="FORCE.html">force</a> for a discussion of disabling forcing, and also
+see <a href="DISABLE-FORCING.html">disable-forcing</a>.  Finally, we should mention that the rewriter is never
+willing to split when there is an <code><a href="IF.html">if</a></code> term present in the goal being
+simplified.  Since <code><a href="AND.html">and</a></code> terms and <code><a href="OR.html">or</a></code> terms are merely
 abbreviations for <code><a href="IF.html">if</a></code> terms, they also prevent splitting.  Note that
 <code><a href="IF.html">if</a></code> terms are ultimately eliminated using the ordinary flow of the proof
 (but see <a href="SET-CASE-SPLIT-LIMITATIONS.html">set-case-split-limitations</a>), so <code>case-split</code> will ultimately
diff -Nru acl2-6.2/doc/HTML/CASE.html acl2-6.3/doc/HTML/CASE.html
--- acl2-6.2/doc/HTML/CASE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CASE.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CASE</h3>conditional based on if-then-else using <code><a href="EQL.html">eql</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CASES.html acl2-6.3/doc/HTML/CASES.html
--- acl2-6.2/doc/HTML/CASES.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/CASES.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CASES.html  --  ACL2 Version 6.2</title></head>
+<head><title>CASES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CASES</h2>hints keyword <code>:CASES</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/CBD.html acl2-6.3/doc/HTML/CBD.html
--- acl2-6.2/doc/HTML/CBD.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/CBD.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CBD.html  --  ACL2 Version 6.2</title></head>
+<head><title>CBD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CBD</h2>connected book directory string
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/CDAAAR.html acl2-6.3/doc/HTML/CDAAAR.html
--- acl2-6.2/doc/HTML/CDAAAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDAAAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDAAAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDAAAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDAAAR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CAAAR.html">caaar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDAADR.html acl2-6.3/doc/HTML/CDAADR.html
--- acl2-6.2/doc/HTML/CDAADR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDAADR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDAADR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDAADR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDAADR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CAADR.html">caadr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDAAR.html acl2-6.3/doc/HTML/CDAAR.html
--- acl2-6.2/doc/HTML/CDAAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDAAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDAAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDAAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDAAR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CAAR.html">caar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDADAR.html acl2-6.3/doc/HTML/CDADAR.html
--- acl2-6.2/doc/HTML/CDADAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDADAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDADAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDADAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDADAR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CADAR.html">cadar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDADDR.html acl2-6.3/doc/HTML/CDADDR.html
--- acl2-6.2/doc/HTML/CDADDR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDADDR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDADDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDADDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDADDR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CADDR.html">caddr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDADR.html acl2-6.3/doc/HTML/CDADR.html
--- acl2-6.2/doc/HTML/CDADR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDADR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDADR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDADR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDADR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CADR.html">cadr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDAR.html acl2-6.3/doc/HTML/CDAR.html
--- acl2-6.2/doc/HTML/CDAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDAR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CAR.html">car</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDDAAR.html acl2-6.3/doc/HTML/CDDAAR.html
--- acl2-6.2/doc/HTML/CDDAAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDDAAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDDAAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDDAAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDDAAR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CDAAR.html">cdaar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDDADR.html acl2-6.3/doc/HTML/CDDADR.html
--- acl2-6.2/doc/HTML/CDDADR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDDADR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDDADR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDDADR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDDADR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CDADR.html">cdadr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDDAR.html acl2-6.3/doc/HTML/CDDAR.html
--- acl2-6.2/doc/HTML/CDDAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDDAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDDAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDDAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDDAR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CDAR.html">cdar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDDDAR.html acl2-6.3/doc/HTML/CDDDAR.html
--- acl2-6.2/doc/HTML/CDDDAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDDDAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDDDAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDDDAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDDDAR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CDDAR.html">cddar</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDDDDR.html acl2-6.3/doc/HTML/CDDDDR.html
--- acl2-6.2/doc/HTML/CDDDDR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDDDDR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDDDDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDDDDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDDDDR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CDDDR.html">cdddr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDDDR.html acl2-6.3/doc/HTML/CDDDR.html
--- acl2-6.2/doc/HTML/CDDDR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDDDR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDDDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDDDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDDDR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CDDR.html">cddr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDDR.html acl2-6.3/doc/HTML/CDDR.html
--- acl2-6.2/doc/HTML/CDDR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDDR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDDR</h3><code><a href="CDR.html">cdr</a></code> of the <code><a href="CDR.html">cdr</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CDR.html acl2-6.3/doc/HTML/CDR.html
--- acl2-6.2/doc/HTML/CDR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CDR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CDR</h3>returns the second element of a <code><a href="CONS.html">cons</a></code> pair, else <code>nil</code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CEILING.html acl2-6.3/doc/HTML/CEILING.html
--- acl2-6.2/doc/HTML/CEILING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CEILING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CEILING.html  --  ACL2 Version 6.2</title></head>
+<head><title>CEILING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CEILING</h3>division returning an integer by truncating toward positive infinity
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CERTIFICATE.html acl2-6.3/doc/HTML/CERTIFICATE.html
--- acl2-6.2/doc/HTML/CERTIFICATE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/CERTIFICATE.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CERTIFICATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CERTIFICATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CERTIFICATE</h2>how a book is known to be admissible and where its <code><a href="DEFPKG.html">defpkg</a></code>s reside
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/CERTIFY-BOOK.html acl2-6.3/doc/HTML/CERTIFY-BOOK.html
--- acl2-6.2/doc/HTML/CERTIFY-BOOK.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/CERTIFY-BOOK.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CERTIFY-BOOK.html  --  ACL2 Version 6.2</title></head>
+<head><title>CERTIFY-BOOK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CERTIFY-BOOK</h2>how to produce a <a href="CERTIFICATE.html">certificate</a> for a book
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/CERTIFY-BOOK_bang_.html acl2-6.3/doc/HTML/CERTIFY-BOOK_bang_.html
--- acl2-6.2/doc/HTML/CERTIFY-BOOK_bang_.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/CERTIFY-BOOK_bang_.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CERTIFY-BOOK_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>CERTIFY-BOOK_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CERTIFY-BOOK!</h2>a variant of <code><a href="CERTIFY-BOOK.html">certify-book</a></code>
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/CERTIFYING-BOOKS.html acl2-6.3/doc/HTML/CERTIFYING-BOOKS.html
--- acl2-6.2/doc/HTML/CERTIFYING-BOOKS.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/CERTIFYING-BOOKS.html	2013-09-30 17:39:26.000000000 +0000
@@ -0,0 +1,11 @@
+<html>
+<head><title>CERTIFYING-BOOKS.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>CERTIFYING-BOOKS</h2>See <a href="BOOKS-CERTIFICATION.html">books-certification</a>.
+<pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
+</pre><p/>
+<p></p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/CHAR-CODE.html acl2-6.3/doc/HTML/CHAR-CODE.html
--- acl2-6.2/doc/HTML/CHAR-CODE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR-CODE.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR-CODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR-CODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR-CODE</h3>the numeric code for a given character
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHAR-DOWNCASE.html acl2-6.3/doc/HTML/CHAR-DOWNCASE.html
--- acl2-6.2/doc/HTML/CHAR-DOWNCASE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR-DOWNCASE.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR-DOWNCASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR-DOWNCASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR-DOWNCASE</h3>turn upper-case <a href="CHARACTERS.html">characters</a> into lower-case <a href="CHARACTERS.html">characters</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHAR-EQUAL.html acl2-6.3/doc/HTML/CHAR-EQUAL.html
--- acl2-6.2/doc/HTML/CHAR-EQUAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR-EQUAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR-EQUAL</h3>character equality without regard to case
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHAR-UPCASE.html acl2-6.3/doc/HTML/CHAR-UPCASE.html
--- acl2-6.2/doc/HTML/CHAR-UPCASE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR-UPCASE.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR-UPCASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR-UPCASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR-UPCASE</h3>turn lower-case <a href="CHARACTERS.html">characters</a> into upper-case <a href="CHARACTERS.html">characters</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHAR.html acl2-6.3/doc/HTML/CHAR.html
--- acl2-6.2/doc/HTML/CHAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR</h3>the <a href="NTH.html">nth</a> element (zero-based) of a string
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHARACTER-ALISTP.html acl2-6.3/doc/HTML/CHARACTER-ALISTP.html
--- acl2-6.2/doc/HTML/CHARACTER-ALISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHARACTER-ALISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHARACTER-ALISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHARACTER-ALISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHARACTER-ALISTP</h3>recognizer for association lists with characters as keys
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHARACTER-ENCODING.html acl2-6.3/doc/HTML/CHARACTER-ENCODING.html
--- acl2-6.2/doc/HTML/CHARACTER-ENCODING.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/CHARACTER-ENCODING.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHARACTER-ENCODING.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHARACTER-ENCODING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CHARACTER-ENCODING</h2>how bytes are parsed into characters
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/CHARACTER-LISTP.html acl2-6.3/doc/HTML/CHARACTER-LISTP.html
--- acl2-6.2/doc/HTML/CHARACTER-LISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHARACTER-LISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHARACTER-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHARACTER-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHARACTER-LISTP</h3>recognizer for a true list of characters
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHARACTERP.html acl2-6.3/doc/HTML/CHARACTERP.html
--- acl2-6.2/doc/HTML/CHARACTERP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHARACTERP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHARACTERP.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHARACTERP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHARACTERP</h3>recognizer for <a href="CHARACTERS.html">characters</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHARACTERS.html acl2-6.3/doc/HTML/CHARACTERS.html
--- acl2-6.2/doc/HTML/CHARACTERS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHARACTERS.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHARACTERS.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHARACTERS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHARACTERS</h3>characters in ACL2
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHAR_gt_.html acl2-6.3/doc/HTML/CHAR_gt_.html
--- acl2-6.2/doc/HTML/CHAR_gt_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR_gt_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR_gt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR_gt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR&gt;</h3>greater-than test for <a href="CHARACTERS.html">characters</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHAR_gt_=.html acl2-6.3/doc/HTML/CHAR_gt_=.html
--- acl2-6.2/doc/HTML/CHAR_gt_=.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR_gt_=.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR_gt_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR_gt_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR&gt;=</h3>greater-than-or-equal test for <a href="CHARACTERS.html">characters</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHAR_lt_.html acl2-6.3/doc/HTML/CHAR_lt_.html
--- acl2-6.2/doc/HTML/CHAR_lt_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR_lt_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR_lt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR_lt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR&lt;</h3>less-than test for <a href="CHARACTERS.html">characters</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHAR_lt_=.html acl2-6.3/doc/HTML/CHAR_lt_=.html
--- acl2-6.2/doc/HTML/CHAR_lt_=.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHAR_lt_=.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHAR_lt_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHAR_lt_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHAR&lt;=</h3>less-than-or-equal test for <a href="CHARACTERS.html">characters</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHECK-SUM.html acl2-6.3/doc/HTML/CHECK-SUM.html
--- acl2-6.2/doc/HTML/CHECK-SUM.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CHECK-SUM.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHECK-SUM.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHECK-SUM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CHECK-SUM</h3>assigning ``often unique'' integers to files and objects
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CHECKPOINT-FORCED-GOALS.html acl2-6.3/doc/HTML/CHECKPOINT-FORCED-GOALS.html
--- acl2-6.2/doc/HTML/CHECKPOINT-FORCED-GOALS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/CHECKPOINT-FORCED-GOALS.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CHECKPOINT-FORCED-GOALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>CHECKPOINT-FORCED-GOALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CHECKPOINT-FORCED-GOALS</h2>Cause forcing goals to be checkpointed in proof trees
 <pre>Major Section:  <a href="PROOF-TREE.html">PROOF-TREE</a>
diff -Nru acl2-6.2/doc/HTML/CLAUSE-IDENTIFIER.html acl2-6.3/doc/HTML/CLAUSE-IDENTIFIER.html
--- acl2-6.2/doc/HTML/CLAUSE-IDENTIFIER.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/CLAUSE-IDENTIFIER.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CLAUSE-IDENTIFIER.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLAUSE-IDENTIFIER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CLAUSE-IDENTIFIER</h2>the internal form of a <a href="GOAL-SPEC.html">goal-spec</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/CLAUSE-PROCESSOR.html acl2-6.3/doc/HTML/CLAUSE-PROCESSOR.html
--- acl2-6.2/doc/HTML/CLAUSE-PROCESSOR.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/CLAUSE-PROCESSOR.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,11 +1,25 @@
 <html>
-<head><title>CLAUSE-PROCESSOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLAUSE-PROCESSOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CLAUSE-PROCESSOR</h2>make or apply a <code>:clause-processor</code> rule (goal-level simplifier)
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-Also see <a href="DEFINE-TRUSTED-CLAUSE-PROCESSOR.html">define-trusted-clause-processor</a> for documentation of an analogous
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
+<pre>
+Example (which we'll return to, below):
+(defthm correctness-of-note-fact-clause-processor
+  (implies (and (pseudo-term-listp cl)
+                (alistp a)
+                (evl0 (conjoin-clauses
+                       (note-fact-clause-processor cl term))
+                      a))
+           (evl0 (disjoin cl) a))
+  :rule-classes :clause-processor)
+</pre>
+</p><p>Also see <a href="DEFINE-TRUSTED-CLAUSE-PROCESSOR.html">define-trusted-clause-processor</a> for documentation of an analogous
 utility that does not require the clause-processor to be proved correct.  But
 please read the present documentation before reading about that utility.
 Both utilities designate functions ``clause-processors''.  Such functions
@@ -64,9 +78,10 @@
 
 </pre>
 
-ACL2 can now prove the following theorem automatically.  (Of course,
+ACL2 can now prove the following theorem automatically.  (This is the example
+displayed at the outset of this <a href="DOCUMENTATION.html">documentation</a> topic.)  Of course,
 <code>:clause-processor</code> rules about clause-processor functions less trivial
-than <code>note-fact-clause-processor</code> may require lemmas to be proved first!)
+than <code>note-fact-clause-processor</code> may require lemmas to be proved first!
 The function <code>disjoin</code> takes a clause and returns its disjunction (the
 result of applying <code><a href="OR.html">OR</a></code> to its members), and <code>conjoin-clauses</code> applies
 <code>disjoin</code> to every element of a given list of clauses and then conjoins
diff -Nru acl2-6.2/doc/HTML/CLEAR-HASH-TABLES.html acl2-6.3/doc/HTML/CLEAR-HASH-TABLES.html
--- acl2-6.2/doc/HTML/CLEAR-HASH-TABLES.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/CLEAR-HASH-TABLES.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CLEAR-HASH-TABLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLEAR-HASH-TABLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CLEAR-HASH-TABLES</h2>deprecated feature
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/CLEAR-MEMOIZE-STATISTICS.html acl2-6.3/doc/HTML/CLEAR-MEMOIZE-STATISTICS.html
--- acl2-6.2/doc/HTML/CLEAR-MEMOIZE-STATISTICS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/CLEAR-MEMOIZE-STATISTICS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CLEAR-MEMOIZE-STATISTICS.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLEAR-MEMOIZE-STATISTICS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CLEAR-MEMOIZE-STATISTICS</h2>clears all profiling info displayed by <code>(</code><code><a href="MEMOIZE-SUMMARY.html">memoize-summary</a></code><code>)</code>
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/CLEAR-MEMOIZE-TABLE.html acl2-6.3/doc/HTML/CLEAR-MEMOIZE-TABLE.html
--- acl2-6.2/doc/HTML/CLEAR-MEMOIZE-TABLE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/CLEAR-MEMOIZE-TABLE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CLEAR-MEMOIZE-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLEAR-MEMOIZE-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CLEAR-MEMOIZE-TABLE</h2>forget values remembered for the given function
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/CLEAR-MEMOIZE-TABLES.html acl2-6.3/doc/HTML/CLEAR-MEMOIZE-TABLES.html
--- acl2-6.2/doc/HTML/CLEAR-MEMOIZE-TABLES.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/CLEAR-MEMOIZE-TABLES.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CLEAR-MEMOIZE-TABLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLEAR-MEMOIZE-TABLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CLEAR-MEMOIZE-TABLES</h2>forget values remembered for all the memoized functions
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/CLOSE-INPUT-CHANNEL.html acl2-6.3/doc/HTML/CLOSE-INPUT-CHANNEL.html
--- acl2-6.2/doc/HTML/CLOSE-INPUT-CHANNEL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CLOSE-INPUT-CHANNEL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CLOSE-INPUT-CHANNEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLOSE-INPUT-CHANNEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CLOSE-INPUT-CHANNEL</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CLOSE-OUTPUT-CHANNEL.html acl2-6.3/doc/HTML/CLOSE-OUTPUT-CHANNEL.html
--- acl2-6.2/doc/HTML/CLOSE-OUTPUT-CHANNEL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CLOSE-OUTPUT-CHANNEL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CLOSE-OUTPUT-CHANNEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLOSE-OUTPUT-CHANNEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CLOSE-OUTPUT-CHANNEL</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CLOSE-TRACE-FILE.html acl2-6.3/doc/HTML/CLOSE-TRACE-FILE.html
--- acl2-6.2/doc/HTML/CLOSE-TRACE-FILE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/CLOSE-TRACE-FILE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CLOSE-TRACE-FILE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CLOSE-TRACE-FILE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CLOSE-TRACE-FILE</h2>stop redirecting trace output to a file
 <pre>Major Section:  <a href="TRACE.html">TRACE</a>
diff -Nru acl2-6.2/doc/HTML/CODE-CHAR.html acl2-6.3/doc/HTML/CODE-CHAR.html
--- acl2-6.2/doc/HTML/CODE-CHAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CODE-CHAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CODE-CHAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>CODE-CHAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CODE-CHAR</h3>the character corresponding to a given numeric code
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/COERCE.html acl2-6.3/doc/HTML/COERCE.html
--- acl2-6.2/doc/HTML/COERCE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/COERCE.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COERCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>COERCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COERCE</h3>coerce a character list to a string and a string to a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/COMMAND-DESCRIPTOR.html acl2-6.3/doc/HTML/COMMAND-DESCRIPTOR.html
--- acl2-6.2/doc/HTML/COMMAND-DESCRIPTOR.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/COMMAND-DESCRIPTOR.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMMAND-DESCRIPTOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMMAND-DESCRIPTOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMMAND-DESCRIPTOR</h2>an object describing a particular <a href="COMMAND.html">command</a> typed by the user
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/COMMAND-LINE.html acl2-6.3/doc/HTML/COMMAND-LINE.html
--- acl2-6.2/doc/HTML/COMMAND-LINE.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/COMMAND-LINE.html	2013-09-30 17:39:30.000000000 +0000
@@ -0,0 +1,25 @@
+<html>
+<head><title>COMMAND-LINE.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>COMMAND-LINE</h2>handling of command-line arguments when ACL2 is invoked
+<pre>Major Section:  <a href="OTHER.html">OTHER</a>
+</pre><p/>
+<p>
+You may provide command-line arguments when invoking ACL2, which are passed
+to the host Lisp.  For more information on this topic, along with a
+discussion of how to save an ACL2 executable that avoids passing command-line
+arguments to the host Lisp, see <a href="SAVE-EXEC.html">save-exec</a>.
+</p>
+
+<H2>Some Related Topics</H2>
+<ul>
+<li><h3><a href="SAVE-EXEC.html">SAVE-EXEC</a> -- save an executable image and a wrapper script
+</h3>
+</li>
+
+</ul>
+
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/COMMAND.html acl2-6.3/doc/HTML/COMMAND.html
--- acl2-6.2/doc/HTML/COMMAND.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/COMMAND.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMMAND.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMMAND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMMAND</h2>forms you type at the top-level, but...
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/COMMON-LISP.html acl2-6.3/doc/HTML/COMMON-LISP.html
--- acl2-6.2/doc/HTML/COMMON-LISP.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/COMMON-LISP.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMMON-LISP.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMMON-LISP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMMON-LISP</h2>relation to Common Lisp, including deviations from the spec
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/COMMUNITY-BOOKS.html acl2-6.3/doc/HTML/COMMUNITY-BOOKS.html
--- acl2-6.2/doc/HTML/COMMUNITY-BOOKS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/COMMUNITY-BOOKS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMMUNITY-BOOKS.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMMUNITY-BOOKS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMMUNITY-BOOKS</h2><a href="BOOKS.html">books</a> contributed by the ACL2 community
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/COMP-GCL.html acl2-6.3/doc/HTML/COMP-GCL.html
--- acl2-6.2/doc/HTML/COMP-GCL.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/COMP-GCL.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMP-GCL.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMP-GCL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COMP-GCL</h3>compile some ACL2 functions leaving .c and .h files
 <pre>Major Section:  <a href="COMP.html">COMP</a>
diff -Nru acl2-6.2/doc/HTML/COMP.html acl2-6.3/doc/HTML/COMP.html
--- acl2-6.2/doc/HTML/COMP.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/COMP.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMP.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMP</h2>compile some ACL2 functions
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -77,17 +77,20 @@
 is given a single function to compile.  Those files contain the ACL2
 definitions of all functions to compile, omitting those in the lists obtained
 by evaluating the forms <code>(@ logic-fns-with-raw-code)</code> and
-<code>(@ program-fns-with-raw-code)</code>.  If you define function symbols with raw
-Lisp code, say by using trust tags (see <a href="DEFTTAG.html">defttag</a>) and readtime conditionals
-<code>#-acl2-loop-only</code>, then you are advised to add all such symbols to one of
-the lists stored in the two <a href="STATE.html">state</a> globals above: to
+<code>(@ program-fns-with-raw-code)</code>.  <code>:Comp</code> skips compilation for functions
+that are already compiled, as is typically the case when you redefine
+functions in raw Lisp using the utility <code>include-raw</code> defined in community
+book <code>books/tools/include-raw.lisp</code>.  But if you define interpreted (as
+opposed to compiled) functions with raw Lisp code, say by using trust
+tags (see <a href="DEFTTAG.html">defttag</a>) and <code><a href="PROGN_bang_.html">progn!</a></code>, then you are advised to add all such
+symbols to one of the lists stored in the two <a href="STATE.html">state</a> globals above: to
 <code>logic-fns-with-raw-code</code> if the function symbol is in <code>:</code><code><a href="LOGIC.html">logic</a></code>
 mode, else to <code>program-fns-with-raw-code</code>.  Then, instead of the
 corresponding ACL2 definition (without raw Lisp code) being written to a
 file, the function symbol will be passed directly to the Lisp <code>compile</code>
 function.  Note that the above two state globals are both untouchable, so you
-may need to deal with that before modifying them, for example as follows
-(also see <a href="REMOVE-UNTOUCHABLE.html">remove-untouchable</a>).
+may need to deal with that before modifying them, for example as
+follows (also see <a href="REMOVE-UNTOUCHABLE.html">remove-untouchable</a>).
 
 <pre>
 (defttag t)
diff -Nru acl2-6.2/doc/HTML/COMPILATION.html acl2-6.3/doc/HTML/COMPILATION.html
--- acl2-6.2/doc/HTML/COMPILATION.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPILATION.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMPILATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPILATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMPILATION</h2>compiling ACL2 functions
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/COMPILING-ACL2P.html acl2-6.3/doc/HTML/COMPILING-ACL2P.html
--- acl2-6.2/doc/HTML/COMPILING-ACL2P.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPILING-ACL2P.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMPILING-ACL2P.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPILING-ACL2P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMPILING-ACL2P</h2>compiling ACL2(p)
 <pre>Major Section:  <a href="PARALLELISM.html">PARALLELISM</a>
diff -Nru acl2-6.2/doc/HTML/COMPLEX-RATIONALP.html acl2-6.3/doc/HTML/COMPLEX-RATIONALP.html
--- acl2-6.2/doc/HTML/COMPLEX-RATIONALP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPLEX-RATIONALP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMPLEX-RATIONALP.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPLEX-RATIONALP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COMPLEX-RATIONALP</h3>recognizes complex rational numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/COMPLEX.html acl2-6.3/doc/HTML/COMPLEX.html
--- acl2-6.2/doc/HTML/COMPLEX.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPLEX.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMPLEX.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPLEX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COMPLEX</h3>create an ACL2 number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/COMPLEX_slash_COMPLEX-RATIONALP.html acl2-6.3/doc/HTML/COMPLEX_slash_COMPLEX-RATIONALP.html
--- acl2-6.2/doc/HTML/COMPLEX_slash_COMPLEX-RATIONALP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPLEX_slash_COMPLEX-RATIONALP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMPLEX_slash_COMPLEX-RATIONALP.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPLEX_slash_COMPLEX-RATIONALP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COMPLEX/COMPLEX-RATIONALP</h3>recognizer for complex numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/COMPOUND-RECOGNIZER.html acl2-6.3/doc/HTML/COMPOUND-RECOGNIZER.html
--- acl2-6.2/doc/HTML/COMPOUND-RECOGNIZER.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPOUND-RECOGNIZER.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,36 +1,30 @@
 <html>
-<head><title>COMPOUND-RECOGNIZER.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPOUND-RECOGNIZER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMPOUND-RECOGNIZER</h2>make a rule used by the typing mechanism
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example
-<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula from which a <code>:compound-recognizer</code> rule might be
-built is:
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
+<pre>
+Examples:
+(defthm alistp-implies-true-listp-compound-recognizer
+  (implies (alistp x)                 ; When (alistp x) is assumed true, add
+           (true-listp x))            ; the additional hypothesis that x is
+  :rule-classes :compound-recognizer) ; of primitive type true-listp.
 
-<pre>
-Example:
-(implies (alistp x)         When (alistp x) is assumed true,
-         (true-listp x))    add the additional hypothesis that x
-                            is of primitive type true-listp.
-
-</pre>
-</p><p>Before presenting the General Forms, we start with a motivating example.  The
-following provides a nice example of a <code>:compound-recognizer</code> rule that is
-built into ACL2.
-
-<pre>
-(defthm natp-compound-recognizer
+(defthm natp-compound-recognizer      ; See discussion below.
   (equal (natp x)
          (and (integerp x)
               (&lt;= 0 x)))
   :rule-classes :compound-recognizer)
 </pre>
-
-To see how this rule might be useful, consider the following (admittedly very
-simple) <a href="EVENTS.html">events</a>.
+</p><p>Before presenting the General Forms, we start with a motivating example: the
+second <code><a href="DEFTHM.html">defthm</a></code> form above, which provides a nice example of a
+<code>:compound-recognizer</code> rule that is built into ACL2.  To see how this rule
+might be useful, consider the following (admittedly very simple) <a href="EVENTS.html">events</a>.
 
 <pre>
 (defun triple (x)
diff -Nru acl2-6.2/doc/HTML/COMPRESS1.html acl2-6.3/doc/HTML/COMPRESS1.html
--- acl2-6.2/doc/HTML/COMPRESS1.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPRESS1.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMPRESS1.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPRESS1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COMPRESS1</h3>remove irrelevant pairs from a 1-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/COMPRESS2.html acl2-6.3/doc/HTML/COMPRESS2.html
--- acl2-6.2/doc/HTML/COMPRESS2.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPRESS2.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMPRESS2.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPRESS2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COMPRESS2</h3>remove irrelevant pairs from a 2-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/COMPUTED-HINTS.html acl2-6.3/doc/HTML/COMPUTED-HINTS.html
--- acl2-6.2/doc/HTML/COMPUTED-HINTS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/COMPUTED-HINTS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COMPUTED-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>COMPUTED-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COMPUTED-HINTS</h2>computing advice to the theorem proving process
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/CONCATENATE.html acl2-6.3/doc/HTML/CONCATENATE.html
--- acl2-6.2/doc/HTML/CONCATENATE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CONCATENATE.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CONCATENATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CONCATENATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CONCATENATE</h3>concatenate lists or strings together
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/COND.html acl2-6.3/doc/HTML/COND.html
--- acl2-6.2/doc/HTML/COND.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/COND.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COND.html  --  ACL2 Version 6.2</title></head>
+<head><title>COND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COND</h3>conditional based on if-then-else
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CONGRUENCE.html acl2-6.3/doc/HTML/CONGRUENCE.html
--- acl2-6.2/doc/HTML/CONGRUENCE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/CONGRUENCE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CONGRUENCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CONGRUENCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CONGRUENCE</h2>the relations to maintain while simplifying arguments
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
@@ -7,15 +7,15 @@
 <p>
 See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
 how they are used to build rules from formulas.  An example
-<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula from which a <code>:congruence</code> rule might be built is:
-
+<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula from which a <code>:congruence</code> rule might be built is:</p><p>
 <pre>
 Example:
-(implies (set-equal x y)
-         (iff (memb e x) (memb e y))).
+(defthm set-equal-implies-iff-memb-2
+  (implies (set-equal x y)
+           (iff (memb e x) (memb e y)))
+  :rule-classes :congruence)
 </pre>
-
-Also see <a href="DEFCONG.html">defcong</a> and see <a href="EQUIVALENCE.html">equivalence</a>.
+</p><p>Also see <a href="DEFCONG.html">defcong</a> and see <a href="EQUIVALENCE.html">equivalence</a>.
 </p>
 <p>
 <pre>
diff -Nru acl2-6.2/doc/HTML/CONJUGATE.html acl2-6.3/doc/HTML/CONJUGATE.html
--- acl2-6.2/doc/HTML/CONJUGATE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CONJUGATE.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CONJUGATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CONJUGATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CONJUGATE</h3>complex number conjugate
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CONS-SUBTREES.html acl2-6.3/doc/HTML/CONS-SUBTREES.html
--- acl2-6.2/doc/HTML/CONS-SUBTREES.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/CONS-SUBTREES.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CONS-SUBTREES.html  --  ACL2 Version 6.2</title></head>
+<head><title>CONS-SUBTREES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CONS-SUBTREES</h2><code>(cons-subtrees x nil)</code> builds a fast alist that associates each subtree
 <code>   </code>of X with T, without duplication.
diff -Nru acl2-6.2/doc/HTML/CONS.html acl2-6.3/doc/HTML/CONS.html
--- acl2-6.2/doc/HTML/CONS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CONS.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>CONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CONS</h3>pair and list constructor
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CONSERVATIVITY-OF-DEFCHOOSE.html acl2-6.3/doc/HTML/CONSERVATIVITY-OF-DEFCHOOSE.html
--- acl2-6.2/doc/HTML/CONSERVATIVITY-OF-DEFCHOOSE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/CONSERVATIVITY-OF-DEFCHOOSE.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CONSERVATIVITY-OF-DEFCHOOSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CONSERVATIVITY-OF-DEFCHOOSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CONSERVATIVITY-OF-DEFCHOOSE</h3>proof of conservativity of <code><a href="DEFCHOOSE.html">defchoose</a></code>
 <pre>Major Section:  <a href="DEFCHOOSE.html">DEFCHOOSE</a>
diff -Nru acl2-6.2/doc/HTML/CONSP.html acl2-6.3/doc/HTML/CONSP.html
--- acl2-6.2/doc/HTML/CONSP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CONSP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CONSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>CONSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CONSP</h3>recognizer for <a href="CONS.html">cons</a> pairs
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CONSTRAINT.html acl2-6.3/doc/HTML/CONSTRAINT.html
--- acl2-6.2/doc/HTML/CONSTRAINT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/CONSTRAINT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CONSTRAINT.html  --  ACL2 Version 6.2</title></head>
+<head><title>CONSTRAINT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CONSTRAINT</h2>restrictions on certain functions introduced in <code><a href="ENCAPSULATE.html">encapsulate</a></code> <a href="EVENTS.html">events</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/COPYRIGHT.html acl2-6.3/doc/HTML/COPYRIGHT.html
--- acl2-6.2/doc/HTML/COPYRIGHT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/COPYRIGHT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,11 +1,11 @@
 <html>
-<head><title>COPYRIGHT.html  --  ACL2 Version 6.2</title></head>
+<head><title>COPYRIGHT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COPYRIGHT</h2>ACL2 copyright, license, sponsorship
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
 </pre><p/>
 <p></p>
-<p>ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+<p>ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 Copyright (C) 2013, Regents of the University of Texas</p><p>This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
 (C) 1997 Computational Logic, Inc.  See the documentation topic NOTE-2-0.</p><p>This program is free software; you can redistribute it and/or modify
 it under the terms of the LICENSE file distributed with ACL2.</p><p>This program is distributed in the hope that it will be useful,
diff -Nru acl2-6.2/doc/HTML/COROLLARY.html acl2-6.3/doc/HTML/COROLLARY.html
--- acl2-6.2/doc/HTML/COROLLARY.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/COROLLARY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COROLLARY.html  --  ACL2 Version 6.2</title></head>
+<head><title>COROLLARY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>COROLLARY</h2>the corollary formula of a <a href="RUNE.html">rune</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/COUNT.html acl2-6.3/doc/HTML/COUNT.html
--- acl2-6.2/doc/HTML/COUNT.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/COUNT.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>COUNT.html  --  ACL2 Version 6.2</title></head>
+<head><title>COUNT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>COUNT</h3>count the number of occurrences of an item in a string or true-list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CPU-CORE-COUNT.html acl2-6.3/doc/HTML/CPU-CORE-COUNT.html
--- acl2-6.2/doc/HTML/CPU-CORE-COUNT.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CPU-CORE-COUNT.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CPU-CORE-COUNT.html  --  ACL2 Version 6.2</title></head>
+<head><title>CPU-CORE-COUNT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CPU-CORE-COUNT</h3>the number of cpu cores
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CURRENT-PACKAGE.html acl2-6.3/doc/HTML/CURRENT-PACKAGE.html
--- acl2-6.2/doc/HTML/CURRENT-PACKAGE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/CURRENT-PACKAGE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CURRENT-PACKAGE.html  --  ACL2 Version 6.2</title></head>
+<head><title>CURRENT-PACKAGE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CURRENT-PACKAGE</h2>the package used for reading and printing
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/CURRENT-THEORY.html acl2-6.3/doc/HTML/CURRENT-THEORY.html
--- acl2-6.2/doc/HTML/CURRENT-THEORY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/CURRENT-THEORY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CURRENT-THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>CURRENT-THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CURRENT-THEORY</h2>currently <a href="ENABLE.html">enable</a>d rules as of logical name
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/CUSTOM-KEYWORD-HINTS.html acl2-6.3/doc/HTML/CUSTOM-KEYWORD-HINTS.html
--- acl2-6.2/doc/HTML/CUSTOM-KEYWORD-HINTS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/CUSTOM-KEYWORD-HINTS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CUSTOM-KEYWORD-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>CUSTOM-KEYWORD-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CUSTOM-KEYWORD-HINTS</h2>user-defined hints
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
@@ -9,6 +9,15 @@
 their own hint keywords.  For examples, see the community books directory
 <code>books/hints/</code>, in particular <code>basic-tests.lisp</code>.
 </p>
+
+<H2>Some Related Topics</H2>
+<ul>
+<li><h3><a href="SHOW-CUSTOM-KEYWORD-HINT-EXPANSION.html">SHOW-CUSTOM-KEYWORD-HINT-EXPANSION</a> -- print out custom keyword hints when they are expanded
+</h3>
+</li>
+
+</ul>
+
 <p>
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
diff -Nru acl2-6.2/doc/HTML/CW-GSTACK.html acl2-6.3/doc/HTML/CW-GSTACK.html
--- acl2-6.2/doc/HTML/CW-GSTACK.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/CW-GSTACK.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CW-GSTACK.html  --  ACL2 Version 6.2</title></head>
+<head><title>CW-GSTACK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>CW-GSTACK</h2>debug a rewriting loop or stack overflow
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/CW.html acl2-6.3/doc/HTML/CW.html
--- acl2-6.2/doc/HTML/CW.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CW.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CW.html  --  ACL2 Version 6.2</title></head>
+<head><title>CW.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CW</h3>print to the comment window
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/CW_bang_.html acl2-6.3/doc/HTML/CW_bang_.html
--- acl2-6.2/doc/HTML/CW_bang_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/CW_bang_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>CW_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>CW_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>CW!</h3>print to the comment window
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/Common_Lisp.html acl2-6.3/doc/HTML/Common_Lisp.html
--- acl2-6.2/doc/HTML/Common_Lisp.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Common_Lisp.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Common_Lisp.html  --  ACL2 Version 6.2</title></head>
+<head><title>Common_Lisp.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Common Lisp</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Common_Lisp_as_a_Modeling_Language.html acl2-6.3/doc/HTML/Common_Lisp_as_a_Modeling_Language.html
--- acl2-6.2/doc/HTML/Common_Lisp_as_a_Modeling_Language.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Common_Lisp_as_a_Modeling_Language.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Common_Lisp_as_a_Modeling_Language.html  --  ACL2 Version 6.2</title></head>
+<head><title>Common_Lisp_as_a_Modeling_Language.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Common Lisp as a Modeling Language</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Conversion.html acl2-6.3/doc/HTML/Conversion.html
--- acl2-6.2/doc/HTML/Conversion.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Conversion.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Conversion.html  --  ACL2 Version 6.2</title></head>
+<head><title>Conversion.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Conversion to Uppercase</h2>
 <p>
diff -Nru acl2-6.2/doc/HTML/Corroborating_Models.html acl2-6.3/doc/HTML/Corroborating_Models.html
--- acl2-6.2/doc/HTML/Corroborating_Models.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Corroborating_Models.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Corroborating_Models.html  --  ACL2 Version 6.2</title></head>
+<head><title>Corroborating_Models.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Corroborating Models</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/DEAD-EVENTS.html acl2-6.3/doc/HTML/DEAD-EVENTS.html
--- acl2-6.2/doc/HTML/DEAD-EVENTS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/DEAD-EVENTS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEAD-EVENTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEAD-EVENTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEAD-EVENTS</h2>using proof supporters to identify dead code and unused theorems
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS.html acl2-6.3/doc/HTML/DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS.html
--- acl2-6.2/doc/HTML/DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DEALING-WITH-KEY-COMBINATIONS-OF-FUNCTION-SYMBOLS</h3>how to get rid of key combinations of function symbols
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/DEALING-WITH-TAU-PROBLEMS.html acl2-6.3/doc/HTML/DEALING-WITH-TAU-PROBLEMS.html
--- acl2-6.2/doc/HTML/DEALING-WITH-TAU-PROBLEMS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEALING-WITH-TAU-PROBLEMS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEALING-WITH-TAU-PROBLEMS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEALING-WITH-TAU-PROBLEMS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEALING-WITH-TAU-PROBLEMS</h2>some advice on dealing with problems caused by the tau system
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-TAU-SYSTEM.html">INTRODUCTION-TO-THE-TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/DECLARE-STOBJS.html acl2-6.3/doc/HTML/DECLARE-STOBJS.html
--- acl2-6.2/doc/HTML/DECLARE-STOBJS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/DECLARE-STOBJS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DECLARE-STOBJS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DECLARE-STOBJS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DECLARE-STOBJS</h2>declaring a formal parameter name to be a single-threaded object
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/DECLARE.html acl2-6.3/doc/HTML/DECLARE.html
--- acl2-6.2/doc/HTML/DECLARE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/DECLARE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DECLARE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DECLARE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DECLARE</h2>declarations
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/DEFABBREV.html acl2-6.3/doc/HTML/DEFABBREV.html
--- acl2-6.2/doc/HTML/DEFABBREV.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFABBREV.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFABBREV.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFABBREV.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFABBREV</h2>a convenient form of macro definition for simple expansions
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFABSSTOBJ-MISSING-EVENTS.html acl2-6.3/doc/HTML/DEFABSSTOBJ-MISSING-EVENTS.html
--- acl2-6.2/doc/HTML/DEFABSSTOBJ-MISSING-EVENTS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFABSSTOBJ-MISSING-EVENTS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFABSSTOBJ-MISSING-EVENTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFABSSTOBJ-MISSING-EVENTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFABSSTOBJ-MISSING-EVENTS</h2>obtain the <a href="EVENTS.html">events</a> needed to admit a <code><a href="DEFABSSTOBJ.html">defabsstobj</a></code> event
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFABSSTOBJ.html acl2-6.3/doc/HTML/DEFABSSTOBJ.html
--- acl2-6.2/doc/HTML/DEFABSSTOBJ.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFABSSTOBJ.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFABSSTOBJ.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFABSSTOBJ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFABSSTOBJ</h2>define a new abstract single-threaded object 
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -470,7 +470,7 @@
 should have the same length and also correspond, as follows: the ith export
 of each should have the same <code>:LOGIC</code> and <code>:EXEC</code> symbols.  See <a href="DEFSTOBJ.html">defstobj</a>
 for more about congruent stobjs.  Note that if two names are congruent, then
-they are either both ordinary stobjs or both abstract stobjs.</p><p><code>Protect-default</code> should either be <code>nil</code> (th default) or <code>t</code>.  It
+they are either both ordinary stobjs or both abstract stobjs.</p><p><code>Protect-default</code> should either be <code>nil</code> (the default) or <code>t</code>.  It
 provides the value of keyword <code>:PROTECT</code> for each member of <code>exports</code>
 that does not explicitly specify <code>:PROTECT</code>.  See the discussion of
 <code>exports</code> below.</p><p>An important aspect of the <code>congruent-to</code> parameter is that if it is not
diff -Nru acl2-6.2/doc/HTML/DEFATTACH.html acl2-6.3/doc/HTML/DEFATTACH.html
--- acl2-6.2/doc/HTML/DEFATTACH.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFATTACH.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFATTACH.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFATTACH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFATTACH</h2>execute constrained functions using corresponding attached functions
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -97,10 +97,10 @@
 </p><p>Below we explain <code>defattach</code> in some detail.  But it is important to keep
 in mind that evaluation with the attachment equations takes place in an
 extension of the logical theory of the session.  ACL2 guarantees that this
-so-called ``evaluation theory'' remains consistent, assuming that the absence
-of <code><a href="DEFAXIOM.html">defaxiom</a></code> <a href="EVENTS.html">events</a> from the user.  This guarantee is a consequence
-of a more general guarantee: an ACL2 logical <a href="WORLD.html">world</a> exists in
-which (loosely speaking) the attachment equation for <code>(defattach f g)</code>, as
+so-called ``evaluation theory'' remains consistent, assuming the absence of
+<code><a href="DEFAXIOM.html">defaxiom</a></code> <a href="EVENTS.html">events</a> from the user.  This guarantee is a consequence of
+a more general guarantee: an ACL2 logical <a href="WORLD.html">world</a> exists in which (loosely
+speaking) the attachment equation for <code>(defattach f g)</code>, as
 <code>(defun f (...) (g ...))</code>, takes the place of the original defining event
 for <code>f</code>, for each <code>defattach</code> event.  This more general guarantee holds
 even if there are <code><a href="DEFAXIOM.html">defaxiom</a></code> events, though as explained below, no
diff -Nru acl2-6.2/doc/HTML/DEFAULT-BACKCHAIN-LIMIT.html acl2-6.3/doc/HTML/DEFAULT-BACKCHAIN-LIMIT.html
--- acl2-6.2/doc/HTML/DEFAULT-BACKCHAIN-LIMIT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT-BACKCHAIN-LIMIT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT-BACKCHAIN-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT-BACKCHAIN-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFAULT-BACKCHAIN-LIMIT</h2>specifying the backchain limit for a rule
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DEFAULT-DEFUN-MODE.html acl2-6.3/doc/HTML/DEFAULT-DEFUN-MODE.html
--- acl2-6.2/doc/HTML/DEFAULT-DEFUN-MODE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT-DEFUN-MODE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT-DEFUN-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT-DEFUN-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFAULT-DEFUN-MODE</h2>the default <a href="DEFUN-MODE.html">defun-mode</a> of <code><a href="DEFUN.html">defun</a></code>'d functions
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DEFAULT-HINTS-TABLE.html acl2-6.3/doc/HTML/DEFAULT-HINTS-TABLE.html
--- acl2-6.2/doc/HTML/DEFAULT-HINTS-TABLE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT-HINTS-TABLE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT-HINTS-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT-HINTS-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFAULT-HINTS-TABLE</h2>a <a href="TABLE.html">table</a> used to provide <a href="HINTS.html">hints</a> for proofs
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/DEFAULT-HINTS.html acl2-6.3/doc/HTML/DEFAULT-HINTS.html
--- acl2-6.2/doc/HTML/DEFAULT-HINTS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT-HINTS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFAULT-HINTS</h2>a list of hints added to every proof attempt
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DEFAULT-PRINT-PROMPT.html acl2-6.3/doc/HTML/DEFAULT-PRINT-PROMPT.html
--- acl2-6.2/doc/HTML/DEFAULT-PRINT-PROMPT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT-PRINT-PROMPT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT-PRINT-PROMPT.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT-PRINT-PROMPT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFAULT-PRINT-PROMPT</h2>the default <a href="PROMPT.html">prompt</a> printed by <code><a href="LD.html">ld</a></code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DEFAULT-RULER-EXTENDERS.html acl2-6.3/doc/HTML/DEFAULT-RULER-EXTENDERS.html
--- acl2-6.2/doc/HTML/DEFAULT-RULER-EXTENDERS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT-RULER-EXTENDERS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT-RULER-EXTENDERS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT-RULER-EXTENDERS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFAULT-RULER-EXTENDERS</h2>the default <a href="RULER-EXTENDERS.html">ruler-extenders</a> for <code><a href="DEFUN.html">defun</a></code>'d functions
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT.html acl2-6.3/doc/HTML/DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT.html
--- acl2-6.2/doc/HTML/DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DEFAULT-TOTAL-PARALLELISM-WORK-LIMIT</h3>for ACL2(p): returns the default value for global <code>total-parallelism-work-limit</code>
 <pre>Major Section:  <a href="PARALLEL-PROOF.html">PARALLEL-PROOF</a>
diff -Nru acl2-6.2/doc/HTML/DEFAULT-VERIFY-GUARDS-EAGERNESS.html acl2-6.3/doc/HTML/DEFAULT-VERIFY-GUARDS-EAGERNESS.html
--- acl2-6.2/doc/HTML/DEFAULT-VERIFY-GUARDS-EAGERNESS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT-VERIFY-GUARDS-EAGERNESS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT-VERIFY-GUARDS-EAGERNESS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT-VERIFY-GUARDS-EAGERNESS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFAULT-VERIFY-GUARDS-EAGERNESS</h2>See <a href="SET-VERIFY-GUARDS-EAGERNESS.html">set-verify-guards-eagerness</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/DEFAULT.html acl2-6.3/doc/HTML/DEFAULT.html
--- acl2-6.2/doc/HTML/DEFAULT.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAULT.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAULT.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAULT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DEFAULT</h3>return the <code>:default</code> from the <a href="HEADER.html">header</a> of a 1- or 2-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/DEFAXIOM.html acl2-6.3/doc/HTML/DEFAXIOM.html
--- acl2-6.2/doc/HTML/DEFAXIOM.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFAXIOM.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFAXIOM.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFAXIOM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFAXIOM</h2>add an axiom
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFCHOOSE.html acl2-6.3/doc/HTML/DEFCHOOSE.html
--- acl2-6.2/doc/HTML/DEFCHOOSE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFCHOOSE.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFCHOOSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFCHOOSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFCHOOSE</h2>define a Skolem (witnessing) function
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFCONG.html acl2-6.3/doc/HTML/DEFCONG.html
--- acl2-6.2/doc/HTML/DEFCONG.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFCONG.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFCONG.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFCONG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFCONG</h2>prove <a href="CONGRUENCE.html">congruence</a> rule
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFCONST.html acl2-6.3/doc/HTML/DEFCONST.html
--- acl2-6.2/doc/HTML/DEFCONST.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFCONST.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFCONST.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFCONST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFCONST</h2>define a constant
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -32,7 +32,7 @@
 </pre>
 
 A more general utility may be found in community book
-<code>books/tools/defconsts.lisp</code>.  Also <a href="USING-TABLES-EFFICIENTLY.html">using-tables-efficiently</a> for an
+<code>books/tools/defconsts.lisp</code>.  Also see <a href="USING-TABLES-EFFICIENTLY.html">using-tables-efficiently</a> for an
 analogous issue with <code><a href="TABLE.html">table</a></code> events.</p><p>It may be of interest to note that <code>defconst</code> is implemented at the
 lisp level using <code>defparameter</code>, as opposed to <code>defconstant</code>.
 (Implementation note:  this is important for proper support of
diff -Nru acl2-6.2/doc/HTML/DEFDOC.html acl2-6.3/doc/HTML/DEFDOC.html
--- acl2-6.2/doc/HTML/DEFDOC.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFDOC.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFDOC.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFDOC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFDOC</h2>add a <a href="DOCUMENTATION.html">documentation</a> topic
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFEQUIV.html acl2-6.3/doc/HTML/DEFEQUIV.html
--- acl2-6.2/doc/HTML/DEFEQUIV.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFEQUIV.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFEQUIV.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFEQUIV.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFEQUIV</h2>prove that a function is an <a href="EQUIVALENCE.html">equivalence</a> relation
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFEVALUATOR.html acl2-6.3/doc/HTML/DEFEVALUATOR.html
--- acl2-6.2/doc/HTML/DEFEVALUATOR.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFEVALUATOR.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFEVALUATOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFEVALUATOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFEVALUATOR</h2>introduce an evaluator function
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFEXEC.html acl2-6.3/doc/HTML/DEFEXEC.html
--- acl2-6.2/doc/HTML/DEFEXEC.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFEXEC.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFEXEC.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFEXEC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFEXEC</h2>attach a terminating executable function to a definition
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFINE-PC-HELP.html acl2-6.3/doc/HTML/DEFINE-PC-HELP.html
--- acl2-6.2/doc/HTML/DEFINE-PC-HELP.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFINE-PC-HELP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFINE-PC-HELP.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFINE-PC-HELP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFINE-PC-HELP</h2>define a macro command whose purpose is to print something
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/DEFINE-PC-MACRO.html acl2-6.3/doc/HTML/DEFINE-PC-MACRO.html
--- acl2-6.2/doc/HTML/DEFINE-PC-MACRO.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFINE-PC-MACRO.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFINE-PC-MACRO.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFINE-PC-MACRO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFINE-PC-MACRO</h2>define a proof-checker macro command
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/DEFINE-PC-META.html acl2-6.3/doc/HTML/DEFINE-PC-META.html
--- acl2-6.2/doc/HTML/DEFINE-PC-META.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFINE-PC-META.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFINE-PC-META.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFINE-PC-META.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFINE-PC-META</h2>define a proof-checker meta command
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/DEFINE-TRUSTED-CLAUSE-PROCESSOR.html acl2-6.3/doc/HTML/DEFINE-TRUSTED-CLAUSE-PROCESSOR.html
--- acl2-6.2/doc/HTML/DEFINE-TRUSTED-CLAUSE-PROCESSOR.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFINE-TRUSTED-CLAUSE-PROCESSOR.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFINE-TRUSTED-CLAUSE-PROCESSOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFINE-TRUSTED-CLAUSE-PROCESSOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFINE-TRUSTED-CLAUSE-PROCESSOR</h2>define a trusted (unverified) goal-level simplifier
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFINITION.html acl2-6.3/doc/HTML/DEFINITION.html
--- acl2-6.2/doc/HTML/DEFINITION.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFINITION.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFINITION.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFINITION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFINITION</h2>make a rule that acts like a function definition
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
@@ -10,14 +10,27 @@
 from which a <code>:definition</code> rule might be built is:
 
 <pre>
-Example:
-(implies (true-listp x)
-         (equal (len x)
-                (if (null x)
-                    0
+Examples:
+(defthm open-len-twice
+  (implies (true-listp x)
+           (equal (len x)
+                  (if (null x)
+                      0
                     (if (null (cdr x))
                         1
-                        (+ 2 (len (cddr x)))))))
+                      (+ 2 (len (cddr x)))))))
+  :rule-classes :definition)
+
+; Same as above, with :controller-alist made explicit:
+(defthm open-len-twice
+  (implies (true-listp x)
+           (equal (len x)
+                  (if (null x)
+                      0
+                    (if (null (cdr x))
+                        1
+                      (+ 2 (len (cddr x)))))))
+  :rule-classes ((:definition :controller-alist ((len t)))))
 
 General Form:
 (implies hyp (equiv (fn a1 ... an) body))
diff -Nru acl2-6.2/doc/HTML/DEFLABEL.html acl2-6.3/doc/HTML/DEFLABEL.html
--- acl2-6.2/doc/HTML/DEFLABEL.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFLABEL.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFLABEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFLABEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFLABEL</h2>build a landmark and/or add a <a href="DOCUMENTATION.html">documentation</a> topic
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFLOCK.html acl2-6.3/doc/HTML/DEFLOCK.html
--- acl2-6.2/doc/HTML/DEFLOCK.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFLOCK.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFLOCK.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFLOCK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DEFLOCK</h3>define a wrapper macro that provides mutual exclusion in ACL2(p)
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/DEFMACRO-LAST.html acl2-6.3/doc/HTML/DEFMACRO-LAST.html
--- acl2-6.2/doc/HTML/DEFMACRO-LAST.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFMACRO-LAST.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFMACRO-LAST.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFMACRO-LAST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFMACRO-LAST</h2>define a macro that returns its last argument, but with side effects
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFMACRO.html acl2-6.3/doc/HTML/DEFMACRO.html
--- acl2-6.2/doc/HTML/DEFMACRO.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFMACRO.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFMACRO.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFMACRO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFMACRO</h2>define a macro
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFN.html acl2-6.3/doc/HTML/DEFN.html
--- acl2-6.2/doc/HTML/DEFN.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFN.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFN.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFN</h2>definition with <a href="GUARD.html">guard</a> <code>t</code>
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFND.html acl2-6.3/doc/HTML/DEFND.html
--- acl2-6.2/doc/HTML/DEFND.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFND.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFND.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFND</h2><a href="DISABLE.html">disable</a>d definition with <a href="GUARD.html">guard</a> <code>t</code>
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFPKG.html acl2-6.3/doc/HTML/DEFPKG.html
--- acl2-6.2/doc/HTML/DEFPKG.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFPKG.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFPKG.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFPKG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFPKG</h2>define a new symbol package
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFPROXY.html acl2-6.3/doc/HTML/DEFPROXY.html
--- acl2-6.2/doc/HTML/DEFPROXY.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFPROXY.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFPROXY.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFPROXY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFPROXY</h2>define a non-executable <code>:</code><code><a href="PROGRAM.html">program</a></code>-mode function for attachment
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFPUN.html acl2-6.3/doc/HTML/DEFPUN.html
--- acl2-6.2/doc/HTML/DEFPUN.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFPUN.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFPUN.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFPUN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFPUN</h2>define a tail-recursive function symbol
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFREFINEMENT.html acl2-6.3/doc/HTML/DEFREFINEMENT.html
--- acl2-6.2/doc/HTML/DEFREFINEMENT.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFREFINEMENT.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFREFINEMENT.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFREFINEMENT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFREFINEMENT</h2>prove that <code>equiv1</code> refines <code>equiv2</code>
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFSTOBJ.html acl2-6.3/doc/HTML/DEFSTOBJ.html
--- acl2-6.2/doc/HTML/DEFSTOBJ.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFSTOBJ.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFSTOBJ.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFSTOBJ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFSTOBJ</h2>define a new single-threaded object 
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -35,20 +35,20 @@
 </pre>
 
 where <code>name</code> is a new symbol, each <code>fieldi</code> is a symbol, each <code>typei</code>
-is either a <code><a href="TYPE-SPEC.html">type-spec</a></code> or <code>(ARRAY</code> <code><a href="TYPE-SPEC.html">type-spec</a></code> <code>(max))</code>, each
-<code>vali</code> is an object satisfying <code>typei</code>, and each <code>bi</code> is <code>t</code> or
-<code>nil</code>.  Each pair <code>:initially vali</code> and <code>:resizable bi</code> may be omitted;
-more on this below.  The <code>:renaming alist</code> argument is optional and allows
-the user to override the default function names introduced by this event.
-The <code><a href="DOC-STRING.html">doc-string</a></code> is also optional.  The <code>:inline flg</code> Boolean argument
-is also optional and declares to ACL2 that the generated access and update
-functions for the stobj should be implemented as macros under the hood (which
-has the effect of inlining the function calls).  The optional
-<code>:congruent-to old-stobj-name</code> argument specifies an existing stobj with
-exactly the same structure, and is discussed below.  We describe further
-restrictions on the <code>fieldi</code>, <code>typei</code>, <code>vali</code>, and on <code>alist</code> below.
-We recommend that you read about single-threaded objects (stobjs) in ACL2
-before proceeding; see <a href="STOBJ.html">stobj</a>.</p><p>The effect of this event is to introduce a new single-threaded object (i.e.,
+is either a type-indicator (a <code><a href="TYPE-SPEC.html">type-spec</a></code> or <a href="STOBJ.html">stobj</a> name) or of the
+form <code>(ARRAY type-indicator max)</code>, each <code>vali</code> is an object satisfying
+<code>typei</code>, and each <code>bi</code> is <code>t</code> or <code>nil</code>.  Each pair
+<code>:initially vali</code> and <code>:resizable bi</code> may be omitted; more on this below.
+The <code>:renaming alist</code> argument is optional and allows the user to override
+the default function names introduced by this event.  The <code><a href="DOC-STRING.html">doc-string</a></code> is
+also optional.  The <code>:inline flg</code> Boolean argument is also optional and
+declares to ACL2 that the generated access and update functions for the stobj
+should be implemented as macros under the hood (which has the effect of
+inlining the function calls).  The optional <code>:congruent-to old-stobj-name</code>
+argument specifies an existing stobj with exactly the same structure, and is
+discussed below.  We describe further restrictions on the <code>fieldi</code>,
+<code>typei</code>, <code>vali</code>, and on <code>alist</code> below.  We recommend that you read
+about single-threaded objects (stobjs) in ACL2 before proceeding; see <a href="STOBJ.html">stobj</a>.</p><p>The effect of this event is to introduce a new single-threaded object (i.e.,
 a ``<a href="STOBJ.html">stobj</a>''), named <code>name</code>, and the associated recognizers, creator,
 accessors, updaters, constants, and, for fields of <code>ARRAY</code> type, length and
 resize functions.
@@ -65,7 +65,7 @@
 a type-spec; see <a href="TYPE-SPEC.html">type-spec</a>.  However, <code>type-indicator</code> can also be the
 name of a stobj that was previously introduced (by <code>defstobj</code> or
 <code><a href="DEFABSSTOBJ.html">defabsstobj</a></code>).  We ignore this ``nested stobj'' case below;
-see <a href="STOBJ-LET.html">stobj-let</a> for a discussion of stobjs within stobjs.</p><p>The keyword value <code>:initially val</code> specifies the initial value of a field,
+see <a href="NESTED-STOBJS.html">nested-stobjs</a> for a discussion of stobjs within stobjs.</p><p>The keyword value <code>:initially val</code> specifies the initial value of a field,
 except for the case of a <code>:type</code> <code>(ARRAY type-indicator (max))</code>, in which
 case <code>val</code> is the initial value of the corresponding array.</p><p>Note that the actual representation of the stobj in the underlying Lisp may
 be quite different; see <a href="STOBJ-EXAMPLE-2.html">stobj-example-2</a>.  For the moment we focus entirely
@@ -82,10 +82,10 @@
 Note that the type and initial value are given in ``keyword argument'' format
 and may be given in either order.  The <code>typei</code> and <code>vali</code> ``arguments''
 are not evaluated.  If omitted, the type defaults to <code>t</code> (unrestricted) and
-the initial value defaults to <code>nil</code>.</p><p>Each <code>typei</code> must be either a <code><a href="TYPE-SPEC.html">type-spec</a></code> (with the exception noted
-above for nested stobjs, discussed elsewhere; see <a href="STOBJ-LET.html">stobj-let</a>) or else a list
-of the form <code>(ARRAY type-spec (max))</code>.  The latter forms are said to be
-``array types.''  Examples of legal <code>typei</code> are:
+the initial value defaults to <code>nil</code>.</p><p>Each <code>typei</code> must be either a <code><a href="TYPE-SPEC.html">type-spec</a></code> or else a list of the form
+<code>(ARRAY type-spec (max))</code>.  (Again, we are ignoring the case of nested
+stobjs, discussed elsewhere; see <a href="NESTED-STOBJS.html">nested-stobjs</a>.)  The latter forms are said
+to be ``array types.''  Examples of legal <code>typei</code> are:
 
 <pre>
 (INTEGER 0 31)
diff -Nru acl2-6.2/doc/HTML/DEFSTUB.html acl2-6.3/doc/HTML/DEFSTUB.html
--- acl2-6.2/doc/HTML/DEFSTUB.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFSTUB.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFSTUB.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFSTUB.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFSTUB</h2>stub-out a function symbol
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFTHEORY-STATIC.html acl2-6.3/doc/HTML/DEFTHEORY-STATIC.html
--- acl2-6.2/doc/HTML/DEFTHEORY-STATIC.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFTHEORY-STATIC.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFTHEORY-STATIC.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFTHEORY-STATIC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFTHEORY-STATIC</h2>define a `static' theory (to <a href="ENABLE.html">enable</a> or <a href="DISABLE.html">disable</a> a set of rules)
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFTHEORY.html acl2-6.3/doc/HTML/DEFTHEORY.html
--- acl2-6.2/doc/HTML/DEFTHEORY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFTHEORY.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFTHEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFTHEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFTHEORY</h2>define a theory (to <a href="ENABLE.html">enable</a> or <a href="DISABLE.html">disable</a> a set of rules)
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFTHM.html acl2-6.3/doc/HTML/DEFTHM.html
--- acl2-6.2/doc/HTML/DEFTHM.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFTHM.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFTHM.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFTHM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFTHM</h2>prove and name a theorem
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFTHMD.html acl2-6.3/doc/HTML/DEFTHMD.html
--- acl2-6.2/doc/HTML/DEFTHMD.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFTHMD.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFTHMD.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFTHMD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFTHMD</h2>prove and name a theorem and then disable it
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFTTAG.html acl2-6.3/doc/HTML/DEFTTAG.html
--- acl2-6.2/doc/HTML/DEFTTAG.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFTTAG.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFTTAG.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFTTAG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFTTAG</h2>introduce a trust tag (ttag)
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUN-INLINE.html acl2-6.3/doc/HTML/DEFUN-INLINE.html
--- acl2-6.2/doc/HTML/DEFUN-INLINE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUN-INLINE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUN-INLINE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUN-INLINE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUN-INLINE</h2>define a potentially inlined function symbol and associated macro
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUN-MODE-CAVEAT.html acl2-6.3/doc/HTML/DEFUN-MODE-CAVEAT.html
--- acl2-6.2/doc/HTML/DEFUN-MODE-CAVEAT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUN-MODE-CAVEAT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUN-MODE-CAVEAT.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUN-MODE-CAVEAT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DEFUN-MODE-CAVEAT</h3>potential soundness issue for functions with <a href="DEFUN-MODE.html">defun-mode</a> <code>:</code><code><a href="PROGRAM.html">program</a></code>
 <pre>Major Section:  <a href="COMMON-LISP.html">COMMON-LISP</a>
diff -Nru acl2-6.2/doc/HTML/DEFUN-MODE.html acl2-6.3/doc/HTML/DEFUN-MODE.html
--- acl2-6.2/doc/HTML/DEFUN-MODE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUN-MODE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUN-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUN-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUN-MODE</h2>determines whether a function definition is a logical act
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUN-NOTINLINE.html acl2-6.3/doc/HTML/DEFUN-NOTINLINE.html
--- acl2-6.2/doc/HTML/DEFUN-NOTINLINE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUN-NOTINLINE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUN-NOTINLINE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUN-NOTINLINE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUN-NOTINLINE</h2>define a not-to-be-inlined function symbol and associated macro
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUN-NX.html acl2-6.3/doc/HTML/DEFUN-NX.html
--- acl2-6.2/doc/HTML/DEFUN-NX.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUN-NX.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUN-NX.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUN-NX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUN-NX</h2>define a non-executable function symbol
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -51,9 +51,9 @@
 proof.  If an error message is produced by evaluating a call of the function
 on a list of arguments that includes <code>state</code> or user-defined <code><a href="STOBJ.html">stobj</a></code>s,
 these arguments will be shown as symbols such as <code>|&lt;state&gt;|</code> in the error
-message.  In the case of a user-defined stobj bound by
-<code><a href="WITH-LOCAL-STOBJ.html">with-local-stobj</a></code> or <code><a href="STOBJ-LET.html">stobj-let</a></code>, the symbol printed will include
-the suffix <code>{instance}</code>, for example, <code>|&lt;st&gt;{instance}|</code>.</p><p>It is harmless to include <code>:non-executable t</code> in your own <code><a href="XARGS.html">xargs</a></code>
+message.  In the case of a user-defined stobj bound by <code><a href="WITH-LOCAL-STOBJ.html">with-local-stobj</a></code>
+or <code><a href="STOBJ-LET.html">stobj-let</a></code>, the symbol printed will include the suffix
+<code>{instance}</code>, for example, <code>|&lt;st&gt;{instance}|</code>.</p><p>It is harmless to include <code>:non-executable t</code> in your own <code><a href="XARGS.html">xargs</a></code>
 <code><a href="DECLARE.html">declare</a></code> form; <code>defun-nx</code> will still lay down its own such
 declaration, but ACL2 can tolerate the duplication.</p><p>Note that <code>defund-nx</code> is also available.  It has an effect identical to
 that of <code>defun-nx</code> except that as with <code><a href="DEFUND.html">defund</a></code>, it leaves the function
diff -Nru acl2-6.2/doc/HTML/DEFUN-SK-EXAMPLE.html acl2-6.3/doc/HTML/DEFUN-SK-EXAMPLE.html
--- acl2-6.2/doc/HTML/DEFUN-SK-EXAMPLE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUN-SK-EXAMPLE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUN-SK-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUN-SK-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DEFUN-SK-EXAMPLE</h3>a simple example using <code><a href="DEFUN-SK.html">defun-sk</a></code>
 <pre>Major Section:  <a href="DEFUN-SK.html">DEFUN-SK</a>
diff -Nru acl2-6.2/doc/HTML/DEFUN-SK.html acl2-6.3/doc/HTML/DEFUN-SK.html
--- acl2-6.2/doc/HTML/DEFUN-SK.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUN-SK.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUN-SK.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUN-SK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUN-SK</h2>define a function whose body has an outermost quantifier
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUN.html acl2-6.3/doc/HTML/DEFUN.html
--- acl2-6.2/doc/HTML/DEFUN.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUN.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUN.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUN</h2>define a function symbol
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUND-INLINE.html acl2-6.3/doc/HTML/DEFUND-INLINE.html
--- acl2-6.2/doc/HTML/DEFUND-INLINE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUND-INLINE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUND-INLINE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUND-INLINE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUND-INLINE</h2>define a potentially disabled, inlined function symbol and associated macro
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUND-NOTINLINE.html acl2-6.3/doc/HTML/DEFUND-NOTINLINE.html
--- acl2-6.2/doc/HTML/DEFUND-NOTINLINE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUND-NOTINLINE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUND-NOTINLINE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUND-NOTINLINE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUND-NOTINLINE</h2>define a disabled, not-to-be-inlined function symbol and associated macro
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUND.html acl2-6.3/doc/HTML/DEFUND.html
--- acl2-6.2/doc/HTML/DEFUND.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUND.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUND.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUND</h2>define a function symbol and then disable it
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/DEFUNS.html acl2-6.3/doc/HTML/DEFUNS.html
--- acl2-6.2/doc/HTML/DEFUNS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DEFUNS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DEFUNS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DEFUNS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DEFUNS</h2>an alternative to <code><a href="MUTUAL-RECURSION.html">mutual-recursion</a></code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DELETE-ASSOC-EQ.html acl2-6.3/doc/HTML/DELETE-ASSOC-EQ.html
--- acl2-6.2/doc/HTML/DELETE-ASSOC-EQ.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/DELETE-ASSOC-EQ.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DELETE-ASSOC-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>DELETE-ASSOC-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DELETE-ASSOC-EQ</h3>See <a href="DELETE-ASSOC.html">delete-assoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/DELETE-ASSOC-EQUAL.html acl2-6.3/doc/HTML/DELETE-ASSOC-EQUAL.html
--- acl2-6.2/doc/HTML/DELETE-ASSOC-EQUAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/DELETE-ASSOC-EQUAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DELETE-ASSOC-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>DELETE-ASSOC-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DELETE-ASSOC-EQUAL</h3>See <a href="DELETE-ASSOC.html">delete-assoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/DELETE-ASSOC.html acl2-6.3/doc/HTML/DELETE-ASSOC.html
--- acl2-6.2/doc/HTML/DELETE-ASSOC.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/DELETE-ASSOC.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,7 +1,7 @@
 <html>
-<head><title>DELETE-ASSOC.html  --  ACL2 Version 6.2</title></head>
+<head><title>DELETE-ASSOC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h3>DELETE-ASSOC</h3>modify an association list by associating a value with a key
+<h3>DELETE-ASSOC</h3>remove the first pair from an association list for a given key
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
 </pre><p/>
 <p>
diff -Nru acl2-6.2/doc/HTML/DELETE-INCLUDE-BOOK-DIR.html acl2-6.3/doc/HTML/DELETE-INCLUDE-BOOK-DIR.html
--- acl2-6.2/doc/HTML/DELETE-INCLUDE-BOOK-DIR.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/DELETE-INCLUDE-BOOK-DIR.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DELETE-INCLUDE-BOOK-DIR.html  --  ACL2 Version 6.2</title></head>
+<head><title>DELETE-INCLUDE-BOOK-DIR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DELETE-INCLUDE-BOOK-DIR</h2>unlink keyword for <code>:dir</code> argument of <code><a href="LD.html">ld</a></code> and <code><a href="INCLUDE-BOOK.html">include-book</a></code>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/DENOMINATOR.html acl2-6.3/doc/HTML/DENOMINATOR.html
--- acl2-6.2/doc/HTML/DENOMINATOR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/DENOMINATOR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DENOMINATOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>DENOMINATOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DENOMINATOR</h3>divisor of a ratio in lowest terms
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/DIGIT-CHAR-P.html acl2-6.3/doc/HTML/DIGIT-CHAR-P.html
--- acl2-6.2/doc/HTML/DIGIT-CHAR-P.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/DIGIT-CHAR-P.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DIGIT-CHAR-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>DIGIT-CHAR-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DIGIT-CHAR-P</h3>the number, if any, corresponding to a given character
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/DIGIT-TO-CHAR.html acl2-6.3/doc/HTML/DIGIT-TO-CHAR.html
--- acl2-6.2/doc/HTML/DIGIT-TO-CHAR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/DIGIT-TO-CHAR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DIGIT-TO-CHAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>DIGIT-TO-CHAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DIGIT-TO-CHAR</h3>map a digit to a character
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/DIMENSIONS.html acl2-6.3/doc/HTML/DIMENSIONS.html
--- acl2-6.2/doc/HTML/DIMENSIONS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/DIMENSIONS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DIMENSIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DIMENSIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>DIMENSIONS</h3>return the <code>:dimensions</code> from the <a href="HEADER.html">header</a> of a 1- or 2-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/DISABLE-FORCING.html acl2-6.3/doc/HTML/DISABLE-FORCING.html
--- acl2-6.2/doc/HTML/DISABLE-FORCING.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DISABLE-FORCING.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DISABLE-FORCING.html  --  ACL2 Version 6.2</title></head>
+<head><title>DISABLE-FORCING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DISABLE-FORCING</h2>to disallow <code><a href="FORCE.html">force</a></code>d <code><a href="CASE-SPLIT.html">case-split</a></code>s
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DISABLE-IMMEDIATE-FORCE-MODEP.html acl2-6.3/doc/HTML/DISABLE-IMMEDIATE-FORCE-MODEP.html
--- acl2-6.2/doc/HTML/DISABLE-IMMEDIATE-FORCE-MODEP.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DISABLE-IMMEDIATE-FORCE-MODEP.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DISABLE-IMMEDIATE-FORCE-MODEP.html  --  ACL2 Version 6.2</title></head>
+<head><title>DISABLE-IMMEDIATE-FORCE-MODEP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DISABLE-IMMEDIATE-FORCE-MODEP</h2><a href="FORCE.html">force</a>d hypotheses are not attacked immediately
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DISABLE.html acl2-6.3/doc/HTML/DISABLE.html
--- acl2-6.2/doc/HTML/DISABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/DISABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DISABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DISABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DISABLE</h2>deletes names from current theory
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/DISABLEDP.html acl2-6.3/doc/HTML/DISABLEDP.html
--- acl2-6.2/doc/HTML/DISABLEDP.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DISABLEDP.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DISABLEDP.html  --  ACL2 Version 6.2</title></head>
+<head><title>DISABLEDP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DISABLEDP</h2>determine whether a given name or rune is disabled
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DISASSEMBLE$.html acl2-6.3/doc/HTML/DISASSEMBLE$.html
--- acl2-6.2/doc/HTML/DISASSEMBLE$.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/DISASSEMBLE$.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DISASSEMBLE$.html  --  ACL2 Version 6.2</title></head>
+<head><title>DISASSEMBLE$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DISASSEMBLE$</h2>disassemble a function
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/DIVE-INTO-MACROS-TABLE.html acl2-6.3/doc/HTML/DIVE-INTO-MACROS-TABLE.html
--- acl2-6.2/doc/HTML/DIVE-INTO-MACROS-TABLE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/DIVE-INTO-MACROS-TABLE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DIVE-INTO-MACROS-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DIVE-INTO-MACROS-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DIVE-INTO-MACROS-TABLE</h2>right-associated function information for the <a href="PROOF-CHECKER.html">proof-checker</a>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/DMR.html acl2-6.3/doc/HTML/DMR.html
--- acl2-6.2/doc/HTML/DMR.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/DMR.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DMR.html  --  ACL2 Version 6.2</title></head>
+<head><title>DMR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DMR</h2>dynamically monitor rewrites and other prover activity
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
@@ -10,16 +10,17 @@
 utility for watching the activity of the rewriter and some other proof
 processes, in real time.  This utility is called ``dmr'', which is an acronym
 for ``dynamically monitor rewrites''.  The utility comes in two parts: an
-ACL2 component that frequently writes a file (the ``dmr file'') containing
-the relevant information, and an Emacs component that frequently displays the
-contents of that file in an Emacs buffer (the ``dmr buffer'').  Other editors
-could, in principle, be programmed to display that file; anyone developing
-such a capability is invited to contribute it to the ACL2 community.</p><p>The dmr utility can be extremely helpful for expensive proofs, especially
-when ACL2 is not providing any output.  The <a href="BREAK-REWRITE.html">break-rewrite</a> and
-<code><a href="ACCUMULATED-PERSISTENCE.html">accumulated-persistence</a></code> utilities may be a bit easier to use, so you
-might want to try those first.  But the dmr utility can be a very helpful
-debugging aide, as it can visually give you a sense of where ACL2 is spending
-its time.</p><p>The Emacs portion of this utility is already loaded if you load the
+ACL2 component that frequently updates a file (the ``dmr file'') containing
+the relevant information, and an Emacs component that frequently updates the
+an Emacs buffer (the ``dmr buffer'') with the contents of that file.  Other
+editors could, in principle, be programmed to display that file; anyone
+developing such a capability is invited to contribute it to the ACL2
+community.</p><p>The dmr utility can be extremely helpful for expensive proofs, especially
+when ACL2 is not providing any output to the terminal.  The
+<a href="BREAK-REWRITE.html">break-rewrite</a> and <code><a href="ACCUMULATED-PERSISTENCE.html">accumulated-persistence</a></code> utilities may be a bit
+easier to use, so you might want to try those first.  But the dmr utility can
+be a very helpful debugging aide, as it can visually give you a sense of
+where ACL2 is spending its time.</p><p>The Emacs portion of this utility is already loaded if you load the
 distributed Emacs file <code>emacs/emacs-acl2.el</code>.  Otherwise, invoke the
 following Emacs command, say by typing <code>Control-X Control-E</code> after the
 right parenthesis, where <code>DIR</code> is the directory of your ACL2 distribution.
@@ -148,8 +149,13 @@
 customize their dmr environments.</p><p>In order to update the dmr file with the latest stack information, interrupt
 ACL2 and then evaluate: <code>(dmr-flush)</code>.  In order to support resumption of
 the interrupted proof (assuming your host Common Lisp supports resumption),
-evaluation of <code>(dmr-start)</code> automatically causes evaluation of the form
-<code>(set-debugger-enable t)</code>; see <a href="SET-DEBUGGER-ENABLE.html">set-debugger-enable</a>.</p><p>Note for users of the experimental extension ACL2(p) (see <a href="PARALLELISM.html">parallelism</a>): when
+evaluation of <code>(dmr-start)</code> will automatically enable the debugger if it is
+not already enabled and not fully disabled with value
+<code>:never</code> (see <a href="SET-DEBUGGER-ENABLE.html">set-debugger-enable</a>).  If such automatic enabling takes
+place, then <code>(dmr-stop)</code> will restore the old setting of the debugger
+unless, after <code>(dmr-start)</code> enables the debugger but before <code>(dmr-stop)</code>
+is called, you call <code><a href="SET-DEBUGGER-ENABLE.html">set-debugger-enable</a></code> (or more precisely: function
+<code>set-debugger-enable-fn</code> is called).</p><p>Note for users of the experimental extension ACL2(p) (see <a href="PARALLELISM.html">parallelism</a>): when
 waterfall-parallelism has been set to a non-<code>nil</code> value
 (see <a href="SET-WATERFALL-PARALLELISM.html">set-waterfall-parallelism</a>), statistics about parallel execution are
 printed instead of the usual information.
diff -Nru acl2-6.2/doc/HTML/DO-NOT-INDUCT.html acl2-6.3/doc/HTML/DO-NOT-INDUCT.html
--- acl2-6.2/doc/HTML/DO-NOT-INDUCT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DO-NOT-INDUCT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DO-NOT-INDUCT.html  --  ACL2 Version 6.2</title></head>
+<head><title>DO-NOT-INDUCT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DO-NOT-INDUCT</h2>hints keyword <code>:DO-NOT-INDUCT</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DO-NOT.html acl2-6.3/doc/HTML/DO-NOT.html
--- acl2-6.2/doc/HTML/DO-NOT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DO-NOT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DO-NOT.html  --  ACL2 Version 6.2</title></head>
+<head><title>DO-NOT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DO-NOT</h2>hints keyword <code>:DO-NOT</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DOC-STRING.html acl2-6.3/doc/HTML/DOC-STRING.html
--- acl2-6.2/doc/HTML/DOC-STRING.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DOC-STRING.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DOC-STRING.html  --  ACL2 Version 6.2</title></head>
+<head><title>DOC-STRING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DOC-STRING</h2>formatted <a href="DOCUMENTATION.html">documentation</a> strings
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/DOC.html acl2-6.3/doc/HTML/DOC.html
--- acl2-6.2/doc/HTML/DOC.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DOC.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,21 +1,20 @@
 <html>
-<head><title>DOC.html  --  ACL2 Version 6.2</title></head>
+<head><title>DOC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DOC</h2>brief <a href="DOCUMENTATION.html">documentation</a> (type <code>:doc name</code>)
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
 </pre><p/>
 <p>
-NOTE:  The <code>:doc</code> command only makes sense at the terminal.
-Furthermore it only works at the terminal when a ``full-size'' image
-has been built.  Most users will probably access the ACL2
-documentation in other ways, as explained in the file <code>"doc/README"</code>
-that comes with the ACL2 distribution.
-
+NOTE: The <code>:doc</code> command only makes sense at the terminal.  Most users will
+probably access the ACL2 documentation in other ways; see <a href="DOCUMENTATION.html">documentation</a>.  In
+particular, consider using the xdoc manual at the following location on the
+web, for topics documented in ACL2 community <a href="BOOKS.html">books</a> as well as the ACL2
+system (though the latter are rearranged):</p><p><a href="http://fv.centtech.com/acl2/latest/doc/">http://fv.centtech.com/acl2/latest/doc/</a></p><p>
 <pre>
 Examples:
 ACL2 !&gt;:doc DEFTHM          ; print documentation of DEFTHM
 ACL2 !&gt;:doc logical-name    ; print documentation of LOGICAL-NAME
-ACL2 !&gt;:doc "MY-PKG"      ; print documentation of "MY-PKG"
+ACL2 !&gt;:doc "MY-PKG"        ; print documentation of "MY-PKG"
 
 Related Topics:
 :more                      ; continues last :doc or :more-doc text
diff -Nru acl2-6.2/doc/HTML/DOCS.html acl2-6.3/doc/HTML/DOCS.html
--- acl2-6.2/doc/HTML/DOCS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DOCS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DOCS.html  --  ACL2 Version 6.2</title></head>
+<head><title>DOCS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DOCS</h2>available <a href="DOCUMENTATION.html">documentation</a> topics (by section)
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/DOCUMENTATION.html acl2-6.3/doc/HTML/DOCUMENTATION.html
--- acl2-6.2/doc/HTML/DOCUMENTATION.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DOCUMENTATION.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DOCUMENTATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>DOCUMENTATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>DOCUMENTATION</h1>functions that display documentation
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -71,11 +71,11 @@
 
 <p>To view the documentation in a web browser, open a browser to file
 <code>doc/HTML/acl2-doc.html</code> under your ACL2 source directory, or just go to
-the ACL2 home page at <a href="http://www.cs.utexas.edu/users/moore/acl2/">http://www.cs.utexas.edu/users/moore/acl2/</a>.
-Alternatively, follow a link on the ACL2 home page to the new ``xdoc''
-version of the manual, which can be found locally after running a regression
-by pointing your web browser at community books file
-<code>books/xdoc/manual/preview.html</code>.</p><p>To use Emacs Info (inside Emacs), first load distributed file
+the ACL2 home page at <a href="http://www.cs.utexas.edu/users/moore/acl2/">http://www.cs.utexas.edu/users/moore/acl2/</a>.</p><p>Alternatively, follow a link on the ACL2 home page to a manual, known as the
+xdoc manual, which incorporates (but rearranges) the ACL2 documentation as
+well as documentation from many ACL2 community books.  You can build a local
+copy of that manual; see for example the section ``BUILDING THE XDOC MANUAL''
+in the community books <code>Makefile</code> for instructions.</p><p>To use Emacs Info (inside Emacs), first load distributed file
 <code>emacs/emacs-acl2.el</code> (perhaps inside your <code>.emacs</code> file) and then
 execute <code>meta-x acl2-info</code>.  In order to see true links to external web
 pages, you may find the following addition to your <code>.emacs</code> file to be
diff -Nru acl2-6.2/doc/HTML/DOC_bang_.html acl2-6.3/doc/HTML/DOC_bang_.html
--- acl2-6.2/doc/HTML/DOC_bang_.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/DOC_bang_.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DOC_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>DOC_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DOC!</h2>all the <a href="DOCUMENTATION.html">documentation</a> for a name (type <code>:doc! name</code>)
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/DOUBLE-REWRITE.html acl2-6.3/doc/HTML/DOUBLE-REWRITE.html
--- acl2-6.2/doc/HTML/DOUBLE-REWRITE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/DOUBLE-REWRITE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DOUBLE-REWRITE.html  --  ACL2 Version 6.2</title></head>
+<head><title>DOUBLE-REWRITE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DOUBLE-REWRITE</h2>cause a term to be rewritten twice
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/DYNAMICALLY-MONITOR-REWRITES.html acl2-6.3/doc/HTML/DYNAMICALLY-MONITOR-REWRITES.html
--- acl2-6.2/doc/HTML/DYNAMICALLY-MONITOR-REWRITES.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/DYNAMICALLY-MONITOR-REWRITES.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>DYNAMICALLY-MONITOR-REWRITES.html  --  ACL2 Version 6.2</title></head>
+<head><title>DYNAMICALLY-MONITOR-REWRITES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>DYNAMICALLY-MONITOR-REWRITES</h2>See <a href="DMR.html">dmr</a>.
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/E0-ORD-_lt_.html acl2-6.3/doc/HTML/E0-ORD-_lt_.html
--- acl2-6.2/doc/HTML/E0-ORD-_lt_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/E0-ORD-_lt_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>E0-ORD-_lt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>E0-ORD-_lt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>E0-ORD-&lt;</h3>the old ordering function for ACL2 ordinals
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/E0-ORDINALP.html acl2-6.3/doc/HTML/E0-ORDINALP.html
--- acl2-6.2/doc/HTML/E0-ORDINALP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/E0-ORDINALP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>E0-ORDINALP.html  --  ACL2 Version 6.2</title></head>
+<head><title>E0-ORDINALP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>E0-ORDINALP</h3>the old recognizer for ACL2 ordinals
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EARLY-TERMINATION.html acl2-6.3/doc/HTML/EARLY-TERMINATION.html
--- acl2-6.2/doc/HTML/EARLY-TERMINATION.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EARLY-TERMINATION.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EARLY-TERMINATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>EARLY-TERMINATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EARLY-TERMINATION</h3>early termination for <code><a href="PAND.html">pand</a></code> and <code><a href="POR.html">por</a></code>.
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/EC-CALL.html acl2-6.3/doc/HTML/EC-CALL.html
--- acl2-6.2/doc/HTML/EC-CALL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EC-CALL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EC-CALL.html  --  ACL2 Version 6.2</title></head>
+<head><title>EC-CALL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EC-CALL</h3>execute a call in the ACL2 logic instead of raw Lisp
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
@@ -30,7 +30,7 @@
 in raw Lisp.  That is, the call of <code>fn</code> is made on its evaluated arguments
 as though this call is being made in the ACL2 top-level loop, rather than in
 raw Lisp.  In particular, the <a href="GUARD.html">guard</a> of <code>fn</code> is checked, at least by
-default (see <a href="SET-GUARD-CHECKING.html">set-guard-checking</a>.</p></blockquote>
+default (see <a href="SET-GUARD-CHECKING.html">set-guard-checking</a>).</p></blockquote>
 <p></p><p>Note that in the term (ec-call (fn term1 ... termk))<code></code>, only the indicated
 call of <code>fn</code> is made in the logic; each <code>termi</code> is evaluated in the
 normal manner.  If you want an entire term evaluated in the logic, wrap
diff -Nru acl2-6.2/doc/HTML/EIGHTH.html acl2-6.3/doc/HTML/EIGHTH.html
--- acl2-6.2/doc/HTML/EIGHTH.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EIGHTH.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EIGHTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>EIGHTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EIGHTH</h3>eighth member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ELIM.html acl2-6.3/doc/HTML/ELIM.html
--- acl2-6.2/doc/HTML/ELIM.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/ELIM.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,15 +1,24 @@
 <html>
-<head><title>ELIM.html  --  ACL2 Version 6.2</title></head>
+<head><title>ELIM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ELIM</h2>make a destructor elimination rule
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and how they are
-used to build rules from formulas.  Here we describe the class of <code>:elim</code>
-rules, which is fundamentally quite different from the more common class of
-<code>:</code><code><a href="REWRITE.html">rewrite</a></code> rules.  Briefly put, a <code>:rewrite</code> rule replaces
-instances of its left-hand side with corresponding instances of its
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>The following example of an <code>:elim</code> rule is an important one, and is built
+into ACL2.
+
+<pre>
+(defaxiom car-cdr-elim
+  (implies (consp x)
+           (equal (cons (car x) (cdr x)) x))
+  :rule-classes :elim)
+</pre>
+</p><p>The class of <code>:elim</code> rules is fundamentally quite different from the more
+common class of <code>:</code><code><a href="REWRITE.html">rewrite</a></code> rules.  Briefly put, a <code>:rewrite</code> rule
+replaces instances of its left-hand side with corresponding instances of its
 right-hand side.  But an <code>:elim</code> rule, on the other hand, has the effect of
 generalizing so-called ``destructor'' function applications to variables.  In
 essence, applicability of a <code>:rewrite</code> rule is based on matching its
@@ -53,28 +62,17 @@
 term containing applications of destructors; there need not be a clear-cut
 notion of ``constructor.''  But the situation described above is typical, and
 we will focus on it, giving full details when we introduce the ``General
-Form'' below.</p><p>The example above employs the following built-in <code>:elim</code> rule named
-<code>car-cdr-elim</code>.
-
-<pre>
-Example:
-(implies (consp x)                      when (car v) or (cdr v) appears
-         (equal (cons (car x) (cdr x))  in a conjecture, and v is a
-                x))                     variable, consider replacing v by
-                                        (cons a b), for two new variables
-                                        a and b.
-</pre>
-
-Notice that the situation is complicated a bit by the fact that this
-replacement is only valid if the variable being replaced a cons structure.
-Thus, when ACL2 applies <code>car-cdr-elim</code> to replace a variable <code>v</code>, it will
-split into two cases: one case in which <code>(consp v)</code> is true, in which <code>v</code>
-is replaced by <code>(cons (car v) (cdr v))</code> and then <code>(car v)</code> and
-<code>(cdr v)</code> are generalized to new variables; and one case in which
-<code>(consp v)</code> is false.  In practice, <code>(consp v)</code> is often provable,
-perhaps even literally present as a hypotheses; then of course there is no
-need to introduce the second case.  That is why there is no such second case
-in the example above.</p><p>You might find <code>:elim</code> rules to be useful whenever you have in mind a data
+Form'' below.</p><p>Notice that the situation can be complicated a bit by a rule's hypotheses.
+For example, the replacement specified by the rule <code>car-cdr-elim</code> (shown
+near the beginning of this discussion) is only valid if the variable being
+replaced is a cons structure.  Thus, when ACL2 applies <code>car-cdr-elim</code> to
+replace a variable <code>v</code>, it will split into two cases: one case in which
+<code>(consp v)</code> is true, in which <code>v</code> is replaced by
+<code>(cons (car v) (cdr v))</code> and then <code>(car v)</code> and <code>(cdr v)</code> are
+generalized to new variables; and one case in which <code>(consp v)</code> is false.
+In practice, <code>(consp v)</code> is often provable, perhaps even literally present
+as a hypotheses; then of course there is no need to introduce the second
+case.  That is why there is no such second case in the example above.</p><p>You might find <code>:elim</code> rules to be useful whenever you have in mind a data
 type that can be built up from its fields with a ``constructor'' function and
 whose fields can be accessed by corresponding ``destructor'' functions.  So
 for example, if you have a ``house'' data structure that represents a house
diff -Nru acl2-6.2/doc/HTML/EMACS.html acl2-6.3/doc/HTML/EMACS.html
--- acl2-6.2/doc/HTML/EMACS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EMACS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EMACS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EMACS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EMACS</h2>emacs support for ACL2
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/EMBEDDED-EVENT-FORM.html acl2-6.3/doc/HTML/EMBEDDED-EVENT-FORM.html
--- acl2-6.2/doc/HTML/EMBEDDED-EVENT-FORM.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/EMBEDDED-EVENT-FORM.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EMBEDDED-EVENT-FORM.html  --  ACL2 Version 6.2</title></head>
+<head><title>EMBEDDED-EVENT-FORM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EMBEDDED-EVENT-FORM</h2>forms that may be embedded in other <a href="EVENTS.html">events</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/ENABLE-FORCING.html acl2-6.3/doc/HTML/ENABLE-FORCING.html
--- acl2-6.2/doc/HTML/ENABLE-FORCING.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/ENABLE-FORCING.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ENABLE-FORCING.html  --  ACL2 Version 6.2</title></head>
+<head><title>ENABLE-FORCING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ENABLE-FORCING</h2>to allow <code><a href="FORCE.html">force</a></code>d <code><a href="CASE.html">split</a></code>s
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/ENABLE-IMMEDIATE-FORCE-MODEP.html acl2-6.3/doc/HTML/ENABLE-IMMEDIATE-FORCE-MODEP.html
--- acl2-6.2/doc/HTML/ENABLE-IMMEDIATE-FORCE-MODEP.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/ENABLE-IMMEDIATE-FORCE-MODEP.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ENABLE-IMMEDIATE-FORCE-MODEP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ENABLE-IMMEDIATE-FORCE-MODEP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ENABLE-IMMEDIATE-FORCE-MODEP</h2><a href="FORCE.html">force</a>d hypotheses are attacked immediately
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/ENABLE.html acl2-6.3/doc/HTML/ENABLE.html
--- acl2-6.2/doc/HTML/ENABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/ENABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ENABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ENABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ENABLE</h2>adds names to current theory
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/ENCAPSULATE.html acl2-6.3/doc/HTML/ENCAPSULATE.html
--- acl2-6.2/doc/HTML/ENCAPSULATE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/ENCAPSULATE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ENCAPSULATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ENCAPSULATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ENCAPSULATE</h2>hide some <a href="EVENTS.html">events</a> and/or constrain some functions
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -94,7 +94,8 @@
 hence does not appear in the resulting ACL2 logical <a href="WORLD.html">world</a>.  But before
 the second pass, each <a href="SIGNATURE.html">signature</a> is stored in the <a href="WORLD.html">world</a>.  Thus, when
 the theorem <code>foo-preserves-consp</code> is encountered in the second pass,
-<code>foo</code> is a known function symbol with the indicated signature.</p><p>We turn now to more complete documentation.</p><p>
+<code>foo</code> is a known function symbol with the indicated signature.</p><p>We turn now to more complete documentation.  But discussion of redundancy for
+<code>encapsulate</code> events may be found elsewhere; see <a href="REDUNDANT-ENCAPSULATE.html">redundant-encapsulate</a>.</p><p>
 <pre>
 Other Examples:
 (encapsulate (((an-element *) =&gt; *))
@@ -128,6 +129,15 @@
             (equal (nthcdr (1+ n) x)
                    (nthcdr n (cdr x))))))
 
+
+<H2>Some Related Topics</H2>
+<ul>
+<li><h3><a href="REDUNDANT-ENCAPSULATE.html">REDUNDANT-ENCAPSULATE</a> -- redundancy of <code><a href="ENCAPSULATE.html">encapsulate</a></code> <a href="EVENTS.html">events</a>
+</h3>
+</li>
+
+</ul>
+
 General Form:
 (encapsulate (signature ... signature)
   ev1
@@ -228,20 +238,7 @@
 <code>previous</code>, <code>thm1</code>, <code>thm2</code>, <code>an-element</code> (the <code>encapsulate</code>
 itself).  Actually, between <code>previous</code> and <code>thm1</code> certain extensions were
 made to the <a href="WORLD.html">world</a> by the superior <code>encapsulate</code>, to permit
-<code>an-element</code> to be used as a function symbol in <code>thm1</code>.</p><p>The typical way for an <code>encapsulate</code> event to be redundant is when a
-syntactically identical <code>encapsulate</code> has already been executed under the
-same <code><a href="DEFAULT-DEFUN-MODE.html">default-defun-mode</a></code>, <code><a href="DEFAULT-RULER-EXTENDERS.html">default-ruler-extenders</a></code>, and
-<code><a href="DEFAULT-VERIFY-GUARDS-EAGERNESS.html">default-verify-guards-eagerness</a></code>.  More generally, the <code>encapsulate</code>
-events need not be syntactically identical, but rather, need only to
-correspond in the following sense: they contain the same signatures and the
-same number of top-level events -- let <code>k</code> be that number -- and for
-each <code>i &lt; k</code>, the <code>i</code>th top-level events <code>E1</code> and <code>E2</code> from the
-earlier and current <code>encapsulate</code>s have one of the following properties.</p><p>o <code>E1</code> and <code>E2</code> are equal; or</p><p>o <code>E1</code> is of the form <code>(record-expansion E2 ...)</code>; or else</p><p>o <code>E1</code> and <code>E2</code> are equal after replacing each <code><a href="LOCAL.html">local</a></code> sub-event by
-<code>(local (value-triple :elided))</code>, where a sub-event of an event <code>E</code> is
-either <code>E</code> itself, or a sub-event of a constituent event of <code>E</code> in the
-case that <code>E</code> is a call of <code><a href="WITH-OUTPUT.html">with-output</a></code>, <code><a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a></code>,
-<code><a href="WITH-PROVER-STEP-LIMIT.html">with-prover-step-limit</a></code>, <code>record-expansion</code>, <code><a href="TIME$.html">time$</a></code>, <code><a href="PROGN.html">progn</a></code>,
-<code><a href="PROGN_bang_.html">progn!</a></code>, or <code>encapsulate</code> itself.</p><p>Remark for ACL2(r) (see <a href="REAL.html">real</a>).  For ACL2(r), <code><a href="ENCAPSULATE.html">encapsulate</a></code> can be used
+<code>an-element</code> to be used as a function symbol in <code>thm1</code>.</p><p>Remark for ACL2(r) (see <a href="REAL.html">real</a>).  For ACL2(r), <code><a href="ENCAPSULATE.html">encapsulate</a></code> can be used
 to introduce classical and non-classical functions, as determined by the
 signatures; see <a href="SIGNATURE.html">signature</a>.  Those marked as classical (respectively
 non-classical) must have classical (respectively, non-classical) <code><a href="LOCAL.html">local</a></code>
diff -Nru acl2-6.2/doc/HTML/ENDP.html acl2-6.3/doc/HTML/ENDP.html
--- acl2-6.2/doc/HTML/ENDP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ENDP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ENDP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ENDP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ENDP</h3>recognizer for empty lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ENTER-BOOT-STRAP-MODE.html acl2-6.3/doc/HTML/ENTER-BOOT-STRAP-MODE.html
--- acl2-6.2/doc/HTML/ENTER-BOOT-STRAP-MODE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/ENTER-BOOT-STRAP-MODE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ENTER-BOOT-STRAP-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>ENTER-BOOT-STRAP-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ENTER-BOOT-STRAP-MODE</h2>The first millisecond of the Big Bang
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/EQ.html acl2-6.3/doc/HTML/EQ.html
--- acl2-6.2/doc/HTML/EQ.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EQ.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EQ</h3>equality of symbols
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EQL.html acl2-6.3/doc/HTML/EQL.html
--- acl2-6.2/doc/HTML/EQL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EQL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQL.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EQL</h3>test equality (of two numbers, symbols, or <a href="CHARACTERS.html">characters</a>)
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EQLABLE-ALISTP.html acl2-6.3/doc/HTML/EQLABLE-ALISTP.html
--- acl2-6.2/doc/HTML/EQLABLE-ALISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EQLABLE-ALISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQLABLE-ALISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQLABLE-ALISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EQLABLE-ALISTP</h3>recognizer for a true list of pairs whose <code><a href="CAR.html">car</a></code>s are suitable for <code><a href="EQL.html">eql</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EQLABLE-LISTP.html acl2-6.3/doc/HTML/EQLABLE-LISTP.html
--- acl2-6.2/doc/HTML/EQLABLE-LISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EQLABLE-LISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQLABLE-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQLABLE-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EQLABLE-LISTP</h3>recognizer for a true list of objects each suitable for <code><a href="EQL.html">eql</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EQLABLEP.html acl2-6.3/doc/HTML/EQLABLEP.html
--- acl2-6.2/doc/HTML/EQLABLEP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EQLABLEP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQLABLEP.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQLABLEP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EQLABLEP</h3>the <a href="GUARD.html">guard</a> for the function <code><a href="EQL.html">eql</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EQUAL.html acl2-6.3/doc/HTML/EQUAL.html
--- acl2-6.2/doc/HTML/EQUAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EQUAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EQUAL</h3>true equality
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EQUALITY-VARIANTS-DETAILS.html acl2-6.3/doc/HTML/EQUALITY-VARIANTS-DETAILS.html
--- acl2-6.2/doc/HTML/EQUALITY-VARIANTS-DETAILS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/EQUALITY-VARIANTS-DETAILS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQUALITY-VARIANTS-DETAILS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQUALITY-VARIANTS-DETAILS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EQUALITY-VARIANTS-DETAILS</h3>details about <a href="EQUALITY-VARIANTS.html">equality-variants</a>
 <pre>Major Section:  <a href="EQUALITY-VARIANTS.html">EQUALITY-VARIANTS</a>
diff -Nru acl2-6.2/doc/HTML/EQUALITY-VARIANTS.html acl2-6.3/doc/HTML/EQUALITY-VARIANTS.html
--- acl2-6.2/doc/HTML/EQUALITY-VARIANTS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/EQUALITY-VARIANTS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQUALITY-VARIANTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQUALITY-VARIANTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EQUALITY-VARIANTS</h2>versions of a function using different equality tests
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/EQUIVALENCE.html acl2-6.3/doc/HTML/EQUIVALENCE.html
--- acl2-6.2/doc/HTML/EQUIVALENCE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/EQUIVALENCE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,26 +1,25 @@
 <html>
-<head><title>EQUIVALENCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQUIVALENCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EQUIVALENCE</h2>mark a relation as an equivalence relation
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example
-<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula from which a <code>:equivalence</code> rule might be built is
-as follows.  (We assume that <code>r-equal</code> has been defined.)
-
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
 <pre>
 Example:
-(and (booleanp (r-equal x y))
-     (r-equal x x)
-     (implies (r-equal x y) (r-equal y x))
-     (implies (and (r-equal x y)
-                   (r-equal y z))
-              (r-equal x z))).
+(defthm r-equal-is-an-equivalence ; assumes that r-equal has been defined
+  (and (booleanp (r-equal x y))
+       (r-equal x x)
+       (implies (r-equal x y) (r-equal y x))
+       (implies (and (r-equal x y)
+                     (r-equal y z))
+                (r-equal x z)))
+  :rule-classes :equivalence)
 </pre>
-
-Also see <a href="DEFEQUIV.html">defequiv</a>.
+</p><p>Also see <a href="DEFEQUIV.html">defequiv</a>.
 </p>
 <p>
 <pre>
diff -Nru acl2-6.2/doc/HTML/EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES.html acl2-6.3/doc/HTML/EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES.html
--- acl2-6.2/doc/HTML/EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EQUIVALENT-FORMULAS-DIFFERENT-REWRITE-RULES</h3>logically equivalent formulas can generate radically different rules
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/ER-PROGN.html acl2-6.3/doc/HTML/ER-PROGN.html
--- acl2-6.2/doc/HTML/ER-PROGN.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ER-PROGN.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ER-PROGN.html  --  ACL2 Version 6.2</title></head>
+<head><title>ER-PROGN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ER-PROGN</h3>perform a sequence of state-changing ``error triples''
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ER.html acl2-6.3/doc/HTML/ER.html
--- acl2-6.2/doc/HTML/ER.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ER.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,11 +1,12 @@
 <html>
-<head><title>ER.html  --  ACL2 Version 6.2</title></head>
+<head><title>ER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ER</h3>print an error message and ``cause an error''
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
 </pre><p/>
 <p>
-
+See <a href="FMT.html">fmt</a> for a general discussion of formatted printing in ACL2.  All calls of
+<code>er</code> print formatted strings, just as is done by <code><a href="FMT.html">fmt</a></code>.</p><p>
 <pre>
 Example Forms:
 (er hard  'top-level "Illegal inputs, ~x0 and ~x1." a b)
diff -Nru acl2-6.2/doc/HTML/ERROR-TRIPLES-AND-PARALLELISM.html acl2-6.3/doc/HTML/ERROR-TRIPLES-AND-PARALLELISM.html
--- acl2-6.2/doc/HTML/ERROR-TRIPLES-AND-PARALLELISM.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ERROR-TRIPLES-AND-PARALLELISM.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ERROR-TRIPLES-AND-PARALLELISM.html  --  ACL2 Version 6.2</title></head>
+<head><title>ERROR-TRIPLES-AND-PARALLELISM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ERROR-TRIPLES-AND-PARALLELISM</h3>how to avoid error triples in ACL2(p)
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/ERROR-TRIPLES.html acl2-6.3/doc/HTML/ERROR-TRIPLES.html
--- acl2-6.2/doc/HTML/ERROR-TRIPLES.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ERROR-TRIPLES.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ERROR-TRIPLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>ERROR-TRIPLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ERROR-TRIPLES</h3>a common ACL2 programming idiom
 <pre>Major Section:  <a href="STATE.html">STATE</a>
diff -Nru acl2-6.2/doc/HTML/ERROR1.html acl2-6.3/doc/HTML/ERROR1.html
--- acl2-6.2/doc/HTML/ERROR1.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ERROR1.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ERROR1.html  --  ACL2 Version 6.2</title></head>
+<head><title>ERROR1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ERROR1</h3>print an error message and cause a ``soft error''
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ESCAPE-TO-COMMON-LISP.html acl2-6.3/doc/HTML/ESCAPE-TO-COMMON-LISP.html
--- acl2-6.2/doc/HTML/ESCAPE-TO-COMMON-LISP.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/ESCAPE-TO-COMMON-LISP.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ESCAPE-TO-COMMON-LISP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ESCAPE-TO-COMMON-LISP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ESCAPE-TO-COMMON-LISP</h2>escaping to Common Lisp
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/EVALUATOR-RESTRICTIONS.html acl2-6.3/doc/HTML/EVALUATOR-RESTRICTIONS.html
--- acl2-6.2/doc/HTML/EVALUATOR-RESTRICTIONS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/EVALUATOR-RESTRICTIONS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EVALUATOR-RESTRICTIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EVALUATOR-RESTRICTIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EVALUATOR-RESTRICTIONS</h3>some restrictions on the use of evaluators in meta-level rules
 <pre>Major Section:  <a href="META.html">META</a>
diff -Nru acl2-6.2/doc/HTML/EVENP.html acl2-6.3/doc/HTML/EVENP.html
--- acl2-6.2/doc/HTML/EVENP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EVENP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EVENP.html  --  ACL2 Version 6.2</title></head>
+<head><title>EVENP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EVENP</h3>test whether an integer is even
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EVENTS.html acl2-6.3/doc/HTML/EVENTS.html
--- acl2-6.2/doc/HTML/EVENTS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/EVENTS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EVENTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EVENTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>EVENTS</h1>functions that extend the logic
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -236,10 +236,6 @@
 </h3>
 </li>
 
-<li><h3><a href="SHOW-CUSTOM-KEYWORD-HINT-EXPANSION.html">SHOW-CUSTOM-KEYWORD-HINT-EXPANSION</a> -- print out custom keyword hints when they are expanded
-</h3>
-</li>
-
 <li><h3><a href="TABLE.html">TABLE</a> -- user-managed tables
 </h3>
 </li>
@@ -260,6 +256,10 @@
 </h3>
 </li>
 
+<li><h3><a href="VERIFY-GUARDS+.html">VERIFY-GUARDS+</a> -- verify the <a href="GUARD.html">guard</a>s of a function
+</h3>
+</li>
+
 <li><h3><a href="VERIFY-TERMINATION.html">VERIFY-TERMINATION</a> -- convert a function from :program mode to :logic mode
 </h3>
 </li>
@@ -277,15 +277,14 @@
 ``as of'' the evaluation of a given event.  An event may introduce
 new logical names.  Some events introduce no new names (e.g.,
 <code><a href="VERIFY-GUARDS.html">verify-guards</a></code>), some introduce exactly one (e.g., <code><a href="DEFMACRO.html">defmacro</a></code> and
-<code><a href="DEFTHM.html">defthm</a></code>), and some may introduce many (e.g., <code><a href="ENCAPSULATE.html">encapsulate</a></code> ).</p><p>ACL2 typically completes processing of an event by printing a summary that
-includes a breakdown of runtime (cpu time) used and, unless proofs are
-skipped (see <a href="LD-SKIP-PROOFSP.html">ld-skip-proofsp</a>) or summary output is inhibited
-(see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a>), information about the proof attempt
-(if any) including a list of rules used, a summary of warnings, and the
-number of ``prover steps'' (if any; see <a href="WITH-PROVER-STEP-LIMIT.html">with-prover-step-limit</a>).  A detail:
-The time is calculated using Common Lisp function <code>get-internal-run-time</code>,
-which may ignore calls to external tools (see <a href="SYS-CALL.html">sys-call</a> and
-see <a href="CLAUSE-PROCESSOR.html">clause-processor</a>).</p><p>See <a href="EMBEDDED-EVENT-FORM.html">embedded-event-form</a> for a discussion of events permitted in
+<code><a href="DEFTHM.html">defthm</a></code>), and some may introduce many (e.g., <code><a href="ENCAPSULATE.html">encapsulate</a></code> ).</p><p>ACL2 typically completes processing of an event by printing a summary.
+Unless proofs are skipped (see <a href="LD-SKIP-PROOFSP.html">ld-skip-proofsp</a>) or summary output is
+inhibited (see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a>), information about the proof attempt
+(if any) is printed that includes a list of rules used, a summary of
+warnings, and the number of ``prover steps'' (if any;
+see <a href="WITH-PROVER-STEP-LIMIT.html">with-prover-step-limit</a>).  A breakdown of the time used is also printed,
+which by default is runtime (cpu time), but can be changed to realtime
+(wall clock time); see <a href="GET-INTERNAL-TIME.html">get-internal-time</a>.</p><p>See <a href="EMBEDDED-EVENT-FORM.html">embedded-event-form</a> for a discussion of events permitted in
 <a href="BOOKS.html">books</a>.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
diff -Nru acl2-6.2/doc/HTML/EVISC-TABLE.html acl2-6.3/doc/HTML/EVISC-TABLE.html
--- acl2-6.2/doc/HTML/EVISC-TABLE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/EVISC-TABLE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EVISC-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>EVISC-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EVISC-TABLE</h2>support for abbreviated output
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/EVISC-TUPLE.html acl2-6.3/doc/HTML/EVISC-TUPLE.html
--- acl2-6.2/doc/HTML/EVISC-TUPLE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/EVISC-TUPLE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EVISC-TUPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>EVISC-TUPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EVISC-TUPLE</h2>control suppression of details when printing
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/EVISCERATE-HIDE-TERMS.html acl2-6.3/doc/HTML/EVISCERATE-HIDE-TERMS.html
--- acl2-6.2/doc/HTML/EVISCERATE-HIDE-TERMS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/EVISCERATE-HIDE-TERMS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EVISCERATE-HIDE-TERMS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EVISCERATE-HIDE-TERMS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EVISCERATE-HIDE-TERMS</h2>to print <code>(hide ...)</code> as <code>&lt;hidden&gt;</code>
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-BINARY-TREES.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-BINARY-TREES.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-BINARY-TREES.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-BINARY-TREES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTION-SCHEME-BINARY-TREES.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTION-SCHEME-BINARY-TREES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTION-SCHEME-BINARY-TREES</h3>induction on binary trees
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTION-SCHEME-DOWN-BY-2</h3>induction downwards 2 steps at a time
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTION-SCHEME-NAT-RECURSION</h3>induction on natural numbers
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-ON-LISTS.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-ON-LISTS.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-ON-LISTS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-ON-LISTS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTION-SCHEME-ON-LISTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTION-SCHEME-ON-LISTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTION-SCHEME-ON-LISTS</h3>induction on lists
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTION-SCHEME-ON-SEVERAL-VARIABLES</h3>induction on several variables
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-UPWARDS.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-UPWARDS.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-UPWARDS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-UPWARDS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTION-SCHEME-UPWARDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTION-SCHEME-UPWARDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTION-SCHEME-UPWARDS</h3>induction upwards
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTION-SCHEME-WITH-ACCUMULATORS</h3>induction scheme with accumulators
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTION-SCHEME-WITH-MULTIPLE-INDUCTION-STEPS</h3>induction scheme with more than one induction step
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXAMPLE-INDUCTIONS.html acl2-6.3/doc/HTML/EXAMPLE-INDUCTIONS.html
--- acl2-6.2/doc/HTML/EXAMPLE-INDUCTIONS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/EXAMPLE-INDUCTIONS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXAMPLE-INDUCTIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXAMPLE-INDUCTIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXAMPLE-INDUCTIONS</h3>some examples of induction schemes in ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/EXECUTABLE-COUNTERPART-THEORY.html acl2-6.3/doc/HTML/EXECUTABLE-COUNTERPART-THEORY.html
--- acl2-6.2/doc/HTML/EXECUTABLE-COUNTERPART-THEORY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/EXECUTABLE-COUNTERPART-THEORY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXECUTABLE-COUNTERPART-THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXECUTABLE-COUNTERPART-THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EXECUTABLE-COUNTERPART-THEORY</h2>executable counterpart rules as of logical name
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/EXECUTABLE-COUNTERPART.html acl2-6.3/doc/HTML/EXECUTABLE-COUNTERPART.html
--- acl2-6.2/doc/HTML/EXECUTABLE-COUNTERPART.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/EXECUTABLE-COUNTERPART.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXECUTABLE-COUNTERPART.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXECUTABLE-COUNTERPART.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EXECUTABLE-COUNTERPART</h2>a rule for computing the value of a function
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/EXISTS.html acl2-6.3/doc/HTML/EXISTS.html
--- acl2-6.2/doc/HTML/EXISTS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/EXISTS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXISTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXISTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXISTS</h3>existential quantifier
 <pre>Major Section:  <a href="DEFUN-SK.html">DEFUN-SK</a>
diff -Nru acl2-6.2/doc/HTML/EXIT-BOOT-STRAP-MODE.html acl2-6.3/doc/HTML/EXIT-BOOT-STRAP-MODE.html
--- acl2-6.2/doc/HTML/EXIT-BOOT-STRAP-MODE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/EXIT-BOOT-STRAP-MODE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXIT-BOOT-STRAP-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXIT-BOOT-STRAP-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EXIT-BOOT-STRAP-MODE</h2>the end of pre-history
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/EXIT.html acl2-6.3/doc/HTML/EXIT.html
--- acl2-6.2/doc/HTML/EXIT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/EXIT.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EXIT</h2>quit entirely out of Lisp
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/EXPAND.html acl2-6.3/doc/HTML/EXPAND.html
--- acl2-6.2/doc/HTML/EXPAND.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/EXPAND.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXPAND.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXPAND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EXPAND</h2>hints keyword <code>:EXPAND</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/EXPLODE-NONNEGATIVE-INTEGER.html acl2-6.3/doc/HTML/EXPLODE-NONNEGATIVE-INTEGER.html
--- acl2-6.2/doc/HTML/EXPLODE-NONNEGATIVE-INTEGER.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EXPLODE-NONNEGATIVE-INTEGER.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXPLODE-NONNEGATIVE-INTEGER.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXPLODE-NONNEGATIVE-INTEGER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXPLODE-NONNEGATIVE-INTEGER</h3>the list of <a href="CHARACTERS.html">characters</a> in the radix-r form of a number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EXPT.html acl2-6.3/doc/HTML/EXPT.html
--- acl2-6.2/doc/HTML/EXPT.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/EXPT.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXPT.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXPT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXPT</h3>exponential function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/EXTENDED-METAFUNCTIONS.html acl2-6.3/doc/HTML/EXTENDED-METAFUNCTIONS.html
--- acl2-6.2/doc/HTML/EXTENDED-METAFUNCTIONS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/EXTENDED-METAFUNCTIONS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXTENDED-METAFUNCTIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXTENDED-METAFUNCTIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EXTENDED-METAFUNCTIONS</h2>state and context sensitive metafunctions
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
@@ -72,8 +72,9 @@
 (see <a href="TYPE-SET.html">type-set</a>).  The type-alist includes not only information gleaned from
 the conditions governing the term being rewritten but also that gleaned from
 forward chaining from the (negations of the) other literals in the clause
-returned by <code>mfc-clause</code>.</p><p><code>(mfc-unify-subst mfc)</code>: returns the unifying substitution when evaluating
-a <code><a href="SYNTAXP.html">syntaxp</a></code> or <code><a href="BIND-FREE.html">bind-free</a></code> hypothesis, else returns <code>nil</code>.</p><p><code>(mfc-world mfc)</code>: returns the ACL2 logical <code><a href="WORLD.html">world</a></code>.</p><p><code>(mfc-ts term mfc state :forcep forcep :ttreep ttreep)</code>: returns the
+returned by <code>mfc-clause</code>.</p><p><code>(mfc-unify-subst mfc)</code>: returns <code>nil</code> except when evaluating
+a <code><a href="SYNTAXP.html">syntaxp</a></code> or <code><a href="BIND-FREE.html">bind-free</a></code> hypothesis, in which case, returns the
+unifying substitution present at the start of that evaluation.</p><p><code>(mfc-world mfc)</code>: returns the ACL2 logical <code><a href="WORLD.html">world</a></code>.</p><p><code>(mfc-ts term mfc state :forcep forcep :ttreep ttreep)</code>: returns the
 <code>type-set</code> of <code>term</code> in the current context; see <a href="TYPE-SET.html">type-set</a>.</p><p><code>(mfc-rw term obj equiv-info mfc state)</code>: returns the result of rewriting
 <code>term</code> in the current context, <code>mfc</code>, with objective <code>obj</code> and the
 equivalence relation described by <code>equiv-info</code>.  <code>Obj</code> should be <code>t</code>,
@@ -126,14 +127,16 @@
 useful in some cases.</p><p><code>(mfc-ap term mfc state)</code>: returns <code>t</code> or <code>nil</code> according to whether
 linear arithmetic can determine that <code>term</code> is false.  To the cognoscenti:
 returns the contradiction flag produced by linearizing <code>term</code> and adding it
-to the <code>linear-pot-lst</code>.</p><p><code>(mfc-relieve-hyp hyp alist rune target bkptr mfc state): returns c[t</code> or
+to the <code>linear-pot-lst</code>.</p><p><code>(mfc-relieve-hyp hyp alist rune target bkptr mfc state)</code>: returns <code>t</code> or
 <code>nil</code> according to whether the indicated hypothesis term, <code>hyp</code>, can be
-relieved (proved) under the giving variable bindings, <code>alist</code>.  Here,
-<code>hyp</code> is the hypothesis of the indicated <code><a href="RUNE.html">rune</a></code> at (one-based) position
-<code>bkptr</code>, and <code>target</code> is an instantiated term to which <code>rune</code> is being
-applied.  Note that no indication is returned for whether any assumptions
-have been generated by <code><a href="FORCE.html">force</a></code> or <code><a href="CASE-SPLIT.html">case-split</a></code>.  (If you need such a
-feature, feel free to request it of the ACL2 implementors.)</p><p>We explain the <code>:forcep</code> and <code>:ttreep</code> keyword arguments provided in some
+relieved (proved) under the giving variable bindings, <code>alist</code>.  Note that
+this function returns <code>nil</code> if <code>hyp</code> has free variables
+(see <a href="FREE-VARIABLES.html">free-variables</a>).  Here, <code>hyp</code> is the hypothesis of the indicated
+<code><a href="RUNE.html">rune</a></code> at (one-based) position <code>bkptr</code>, and <code>target</code> is an
+instantiated term to which <code>rune</code> is being applied.  Note that no
+indication is returned for whether any assumptions have been generated by
+<code><a href="FORCE.html">force</a></code> or <code><a href="CASE-SPLIT.html">case-split</a></code>.  (If you need such a feature, feel free to
+request it of the ACL2 implementors.)</p><p>We explain the <code>:forcep</code> and <code>:ttreep</code> keyword arguments provided in some
 expressions, as promised above.  Their defaults are <code>:same</code> and <code>nil</code>,
 respectively.  A value of <code>:same</code> for <code>:forcep</code> means that forcing will
 be allowed if and only if it is allowed in the current rewriting environment;
diff -Nru acl2-6.2/doc/HTML/EXTERNAL-FORMAT.html acl2-6.3/doc/HTML/EXTERNAL-FORMAT.html
--- acl2-6.2/doc/HTML/EXTERNAL-FORMAT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/EXTERNAL-FORMAT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXTERNAL-FORMAT.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXTERNAL-FORMAT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>EXTERNAL-FORMAT</h2>See <a href="CHARACTER-ENCODING.html">character-encoding</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/EXTRA-INFO.html acl2-6.3/doc/HTML/EXTRA-INFO.html
--- acl2-6.2/doc/HTML/EXTRA-INFO.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/EXTRA-INFO.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>EXTRA-INFO.html  --  ACL2 Version 6.2</title></head>
+<head><title>EXTRA-INFO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>EXTRA-INFO</h3>generate markers to indicate sources of guard proof obligations
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/E_slash_D.html acl2-6.3/doc/HTML/E_slash_D.html
--- acl2-6.2/doc/HTML/E_slash_D.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/E_slash_D.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>E_slash_D.html  --  ACL2 Version 6.2</title></head>
+<head><title>E_slash_D.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>E/D</h2>enable/disable rules
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/Evaluating_App_on_Sample_Input.html acl2-6.3/doc/HTML/Evaluating_App_on_Sample_Input.html
--- acl2-6.2/doc/HTML/Evaluating_App_on_Sample_Input.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Evaluating_App_on_Sample_Input.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Evaluating_App_on_Sample_Input.html  --  ACL2 Version 6.2</title></head>
+<head><title>Evaluating_App_on_Sample_Input.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Evaluating App on Sample Input</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/F-GET-GLOBAL.html acl2-6.3/doc/HTML/F-GET-GLOBAL.html
--- acl2-6.2/doc/HTML/F-GET-GLOBAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/F-GET-GLOBAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>F-GET-GLOBAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>F-GET-GLOBAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>F-GET-GLOBAL</h3>get the value of a global variable in <code><a href="STATE.html">state</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/F-PUT-GLOBAL.html acl2-6.3/doc/HTML/F-PUT-GLOBAL.html
--- acl2-6.2/doc/HTML/F-PUT-GLOBAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/F-PUT-GLOBAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>F-PUT-GLOBAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>F-PUT-GLOBAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>F-PUT-GLOBAL</h3>assign to a global variable in <code><a href="STATE.html">state</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FAILED-FORCING.html acl2-6.3/doc/HTML/FAILED-FORCING.html
--- acl2-6.2/doc/HTML/FAILED-FORCING.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/FAILED-FORCING.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FAILED-FORCING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FAILED-FORCING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FAILED-FORCING</h2>how to deal with a proof <a href="FAILURE.html">failure</a> in a forcing round
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/FAILURE.html acl2-6.3/doc/HTML/FAILURE.html
--- acl2-6.2/doc/HTML/FAILURE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/FAILURE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FAILURE.html  --  ACL2 Version 6.2</title></head>
+<head><title>FAILURE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FAILURE</h2>how to deal with a proof failure
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/FAST-ALIST-FREE-ON-EXIT.html acl2-6.3/doc/HTML/FAST-ALIST-FREE-ON-EXIT.html
--- acl2-6.2/doc/HTML/FAST-ALIST-FREE-ON-EXIT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FAST-ALIST-FREE-ON-EXIT.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,18 +1,18 @@
 <html>
-<head><title>FAST-ALIST-FREE-ON-EXIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>FAST-ALIST-FREE-ON-EXIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FAST-ALIST-FREE-ON-EXIT</h2>Free a fast alist after the completion of some form.
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
 </pre><p/>
 <p>
-Logically, <code>(fast-alist-free-on-exit name form)</code> is the identity and returns
-<code>form</code>.</p><p>Under the hood, this essentially expands to:
+Logically, <code>(fast-alist-free-on-exit alist form)</code> is the identity and returns
+<code>form</code>.  Also see <a href="FAST-ALIST-FREE.html">fast-alist-free</a>.</p><p>Under the hood, this essentially expands to:
 
 <pre>
  (prog1 form
-        (fast-alist-free name))
+        (fast-alist-free alist))
 </pre>
-</p><p>In other words, <code>name</code> is not freed immediately, but instead remains a fast
+</p><p>In other words, <code>alist</code> is not freed immediately, but instead remains a fast
 alist until the form completes.  This may be useful when you are writing code
 that uses a fast alist but has many return points.</p><p>See also the macro <code>fast-alists-free-on-exit</code> defined in the community book
 <code>"books/centaur/misc/hons-extra.lisp"</code>, which can be used to free several
diff -Nru acl2-6.2/doc/HTML/FAST-ALIST-FREE.html acl2-6.3/doc/HTML/FAST-ALIST-FREE.html
--- acl2-6.2/doc/HTML/FAST-ALIST-FREE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FAST-ALIST-FREE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FAST-ALIST-FREE.html  --  ACL2 Version 6.2</title></head>
+<head><title>FAST-ALIST-FREE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FAST-ALIST-FREE</h2><code>(fast-alist-free alist)</code> throws away the hash table associated with a fast
 <code>   </code>alist.
@@ -10,7 +10,7 @@
 supporting hash cons, fast alists, and memoization; see <a href="HONS-AND-MEMOIZATION.html">hons-and-memoization</a>.</p><p>Logically, this function is the identity; we leave it enabled and would think
 it odd to ever prove a theorem about it.</p><p>Under the hood, <code>fast-alist-free</code> removes the hash table associated with this
 alist, if one exists.  This effectively converts the alist into an ordinary
-alist.
+alist.</p><p>Also see <a href="FAST-ALIST-FREE-ON-EXIT.html">fast-alist-free-on-exit</a>.
 </p>
 <p>Because there is no automatic mechanism for freeing the hash tables used in
 fast alists, to avoid memory leaks you should manually free any alists that
diff -Nru acl2-6.2/doc/HTML/FAST-ALIST-LEN.html acl2-6.3/doc/HTML/FAST-ALIST-LEN.html
--- acl2-6.2/doc/HTML/FAST-ALIST-LEN.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FAST-ALIST-LEN.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FAST-ALIST-LEN.html  --  ACL2 Version 6.2</title></head>
+<head><title>FAST-ALIST-LEN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FAST-ALIST-LEN</h2><code>(fast-alist-len alist)</code> counts the number of unique keys in a fast alist.
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/FAST-ALIST-SUMMARY.html acl2-6.3/doc/HTML/FAST-ALIST-SUMMARY.html
--- acl2-6.2/doc/HTML/FAST-ALIST-SUMMARY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FAST-ALIST-SUMMARY.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FAST-ALIST-SUMMARY.html  --  ACL2 Version 6.2</title></head>
+<head><title>FAST-ALIST-SUMMARY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FAST-ALIST-SUMMARY</h2><code>(fast-alist-summary)</code> prints some basic statistics about any current fast
 <code>   </code>alists.
diff -Nru acl2-6.2/doc/HTML/FAST-ALISTS.html acl2-6.3/doc/HTML/FAST-ALISTS.html
--- acl2-6.2/doc/HTML/FAST-ALISTS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FAST-ALISTS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FAST-ALISTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>FAST-ALISTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FAST-ALISTS</h2>alists with hidden hash tables for faster execution
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
@@ -22,7 +22,8 @@
 objects (<code><a href="STOBJ.html">stobj</a></code>s).  Also, even with perfectly proper code, discipline can
 sometimes be lost due to user interrupts and aborts.
 </p>
-<p>Performance Notes</p><p>The keys of fast alists are always <a href="NORMED.html">normed</a>.  Why?  In Common Lisp,
+<p>Performance Notes</p><p>See <a href="HONS-ACONS.html">hons-acons</a> for how the final <code><a href="CDR.html">cdr</a></code> of a fast alist can be used as a
+size hint or as a name for reports printed by calling <code><a href="FAST-ALIST-SUMMARY.html">fast-alist-summary</a></code>.</p><p>The keys of fast alists are always <a href="NORMED.html">normed</a>.  Why?  In Common Lisp,
 equal-based hashing is relatively slow, so to allow the use of eql-based hash
 tables, <code><a href="HONS-ACONS.html">hons-acons</a></code> and <code><a href="HONS-GET.html">hons-get</a></code> always <code><a href="HONS-COPY.html">hons-copy</a></code> the keys
 involved.</p><p>Since alist keys are frequently atoms, this norming activity may often be so
diff -Nru acl2-6.2/doc/HTML/FC-REPORT.html acl2-6.3/doc/HTML/FC-REPORT.html
--- acl2-6.2/doc/HTML/FC-REPORT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FC-REPORT.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FC-REPORT.html  --  ACL2 Version 6.2</title></head>
+<head><title>FC-REPORT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FC-REPORT</h2>to report on the forward chaining activity in the most recent proof
 <pre>Major Section:  <a href="FORWARD-CHAINING-REPORTS.html">FORWARD-CHAINING-REPORTS</a>
diff -Nru acl2-6.2/doc/HTML/FIFTH.html acl2-6.3/doc/HTML/FIFTH.html
--- acl2-6.2/doc/HTML/FIFTH.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FIFTH.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FIFTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>FIFTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FIFTH</h3>fifth member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FILE-READING-EXAMPLE.html acl2-6.3/doc/HTML/FILE-READING-EXAMPLE.html
--- acl2-6.2/doc/HTML/FILE-READING-EXAMPLE.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/FILE-READING-EXAMPLE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FILE-READING-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>FILE-READING-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>FILE-READING-EXAMPLE</h4>example of reading files in ACL2
 <pre>Major Section:  <a href="TUTORIAL5-MISCELLANEOUS-EXAMPLES.html">TUTORIAL5-MISCELLANEOUS-EXAMPLES</a>
diff -Nru acl2-6.2/doc/HTML/FINALIZE-EVENT-USER.html acl2-6.3/doc/HTML/FINALIZE-EVENT-USER.html
--- acl2-6.2/doc/HTML/FINALIZE-EVENT-USER.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/FINALIZE-EVENT-USER.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FINALIZE-EVENT-USER.html  --  ACL2 Version 6.2</title></head>
+<head><title>FINALIZE-EVENT-USER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FINALIZE-EVENT-USER</h2>user-supplied code to complete <a href="EVENTS.html">events</a>, e.g., with extra summary output
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/FIND-RULES-OF-RUNE.html acl2-6.3/doc/HTML/FIND-RULES-OF-RUNE.html
--- acl2-6.2/doc/HTML/FIND-RULES-OF-RUNE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/FIND-RULES-OF-RUNE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FIND-RULES-OF-RUNE.html  --  ACL2 Version 6.2</title></head>
+<head><title>FIND-RULES-OF-RUNE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FIND-RULES-OF-RUNE</h2>find the rules named rune
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/FINDING-DOCUMENTATION.html acl2-6.3/doc/HTML/FINDING-DOCUMENTATION.html
--- acl2-6.2/doc/HTML/FINDING-DOCUMENTATION.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/FINDING-DOCUMENTATION.html	2013-09-30 17:39:28.000000000 +0000
@@ -0,0 +1,26 @@
+<html>
+<head><title>FINDING-DOCUMENTATION.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>FINDING-DOCUMENTATION</h2>searching the documentation
+<pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
+</pre><p/>
+<p>
+The <code>:</code><code><a href="DOC.html">doc</a></code> and <code>:</code><code><a href="DOC_bang_.html">doc!</a></code> commands will display, at the
+terminal, <a href="DOCUMENTATION.html">documentation</a> topics defined in ACL2 or in <a href="BOOKS.html">books</a> that
+have already been included.  The <code>:</code><code><a href="DOCS.html">docs</a></code> command allows you to search
+the <a href="DOCUMENTATION.html">documentation</a> at the terminal.  See <a href="DOCS.html">docs</a>.</p><p>But how can you find documentation for books that are not included in the
+current ACL2 session?</p><p>The xdoc manual is a combined manual for the ACL2 sources and the community
+books.  It is built using documentation not only from the ACL2 sources
+(which is rearranged) but also from the community books (whether included in
+the current session or not), using an ``xdoc processor'' created by Jared
+Davis.  The ACL2 home page
+(<a href="http://www.cs.utexas.edu/users/moore/acl2/">http://www.cs.utexas.edu/users/moore/acl2/</a>) has a link to this manual,
+which as of this writing may be found directly by visiting the following web
+page: <a href="http://fv.centtech.com/acl2/latest/doc/">http://fv.centtech.com/acl2/latest/doc/</a>.  You can build a local
+copy of this manual from the ACL2 Community Books, following instructions in
+their <code>Makefile</code>.
+</p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/FIRST.html acl2-6.3/doc/HTML/FIRST.html
--- acl2-6.2/doc/HTML/FIRST.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FIRST.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FIRST.html  --  ACL2 Version 6.2</title></head>
+<head><title>FIRST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FIRST</h3>first member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FIX-TRUE-LIST.html acl2-6.3/doc/HTML/FIX-TRUE-LIST.html
--- acl2-6.2/doc/HTML/FIX-TRUE-LIST.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FIX-TRUE-LIST.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FIX-TRUE-LIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>FIX-TRUE-LIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FIX-TRUE-LIST</h3>coerce to a true list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FIX.html acl2-6.3/doc/HTML/FIX.html
--- acl2-6.2/doc/HTML/FIX.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FIX.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FIX.html  --  ACL2 Version 6.2</title></head>
+<head><title>FIX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FIX</h3>coerce to a number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FLET.html acl2-6.3/doc/HTML/FLET.html
--- acl2-6.2/doc/HTML/FLET.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FLET.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FLET.html  --  ACL2 Version 6.2</title></head>
+<head><title>FLET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FLET</h3>local binding of function symbols
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FLOOR.html acl2-6.3/doc/HTML/FLOOR.html
--- acl2-6.2/doc/HTML/FLOOR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FLOOR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FLOOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>FLOOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FLOOR</h3>division returning an integer by truncating toward negative infinity
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FLUSH-COMPRESS.html acl2-6.3/doc/HTML/FLUSH-COMPRESS.html
--- acl2-6.2/doc/HTML/FLUSH-COMPRESS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/FLUSH-COMPRESS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FLUSH-COMPRESS.html  --  ACL2 Version 6.2</title></head>
+<head><title>FLUSH-COMPRESS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FLUSH-COMPRESS</h3>flush the under-the-hood array for the given name
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/FLUSH-HONS-GET-HASH-TABLE-LINK.html acl2-6.3/doc/HTML/FLUSH-HONS-GET-HASH-TABLE-LINK.html
--- acl2-6.2/doc/HTML/FLUSH-HONS-GET-HASH-TABLE-LINK.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FLUSH-HONS-GET-HASH-TABLE-LINK.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FLUSH-HONS-GET-HASH-TABLE-LINK.html  --  ACL2 Version 6.2</title></head>
+<head><title>FLUSH-HONS-GET-HASH-TABLE-LINK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FLUSH-HONS-GET-HASH-TABLE-LINK</h2>deprecated feature
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/FMS-TO-STRING.html acl2-6.3/doc/HTML/FMS-TO-STRING.html
--- acl2-6.2/doc/HTML/FMS-TO-STRING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMS-TO-STRING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMS-TO-STRING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMS-TO-STRING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMS-TO-STRING</h3>See <a href="PRINTING-TO-STRINGS.html">printing-to-strings</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMS.html acl2-6.3/doc/HTML/FMS.html
--- acl2-6.2/doc/HTML/FMS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMS.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMS.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMS</h3><code>:(str alist co-channel state evisc) =&gt; state</code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMS_bang_-TO-STRING.html acl2-6.3/doc/HTML/FMS_bang_-TO-STRING.html
--- acl2-6.2/doc/HTML/FMS_bang_-TO-STRING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMS_bang_-TO-STRING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMS_bang_-TO-STRING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMS_bang_-TO-STRING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMS!-TO-STRING</h3>See <a href="PRINTING-TO-STRINGS.html">printing-to-strings</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMS_bang_.html acl2-6.3/doc/HTML/FMS_bang_.html
--- acl2-6.2/doc/HTML/FMS_bang_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMS_bang_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMS!</h3><code>:(str alist co-channel state evisc) =&gt; state</code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT-TO-COMMENT-WINDOW.html acl2-6.3/doc/HTML/FMT-TO-COMMENT-WINDOW.html
--- acl2-6.2/doc/HTML/FMT-TO-COMMENT-WINDOW.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT-TO-COMMENT-WINDOW.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT-TO-COMMENT-WINDOW.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT-TO-COMMENT-WINDOW.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT-TO-COMMENT-WINDOW</h3>print to the comment window
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT-TO-STRING.html acl2-6.3/doc/HTML/FMT-TO-STRING.html
--- acl2-6.2/doc/HTML/FMT-TO-STRING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT-TO-STRING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT-TO-STRING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT-TO-STRING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT-TO-STRING</h3>See <a href="PRINTING-TO-STRINGS.html">printing-to-strings</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT.html acl2-6.3/doc/HTML/FMT.html
--- acl2-6.2/doc/HTML/FMT.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT</h3>formatted printing
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT1-TO-STRING.html acl2-6.3/doc/HTML/FMT1-TO-STRING.html
--- acl2-6.2/doc/HTML/FMT1-TO-STRING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT1-TO-STRING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT1-TO-STRING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT1-TO-STRING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT1-TO-STRING</h3>See <a href="PRINTING-TO-STRINGS.html">printing-to-strings</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT1.html acl2-6.3/doc/HTML/FMT1.html
--- acl2-6.2/doc/HTML/FMT1.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT1.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT1.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT1</h3><code>:(str alist col co-channel state evisc) =&gt; (mv col state)</code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT1_bang_-TO-STRING.html acl2-6.3/doc/HTML/FMT1_bang_-TO-STRING.html
--- acl2-6.2/doc/HTML/FMT1_bang_-TO-STRING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT1_bang_-TO-STRING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT1_bang_-TO-STRING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT1_bang_-TO-STRING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT1!-TO-STRING</h3>See <a href="PRINTING-TO-STRINGS.html">printing-to-strings</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT1_bang_.html acl2-6.3/doc/HTML/FMT1_bang_.html
--- acl2-6.2/doc/HTML/FMT1_bang_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT1_bang_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT1_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT1_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT1!</h3><code>:(str alist col channel state evisc) =&gt; (mv col state)</code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT_bang_-TO-STRING.html acl2-6.3/doc/HTML/FMT_bang_-TO-STRING.html
--- acl2-6.2/doc/HTML/FMT_bang_-TO-STRING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT_bang_-TO-STRING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT_bang_-TO-STRING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT_bang_-TO-STRING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT!-TO-STRING</h3>See <a href="PRINTING-TO-STRINGS.html">printing-to-strings</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FMT_bang_.html acl2-6.3/doc/HTML/FMT_bang_.html
--- acl2-6.2/doc/HTML/FMT_bang_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FMT_bang_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FMT_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>FMT_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FMT!</h3><code>:(str alist co-channel state evisc) =&gt; state</code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FNCALL-TERM.html acl2-6.3/doc/HTML/FNCALL-TERM.html
--- acl2-6.2/doc/HTML/FNCALL-TERM.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/FNCALL-TERM.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FNCALL-TERM.html  --  ACL2 Version 6.2</title></head>
+<head><title>FNCALL-TERM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FNCALL-TERM</h2>See <a href="META-EXTRACT.html">meta-extract</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/FORALL.html acl2-6.3/doc/HTML/FORALL.html
--- acl2-6.2/doc/HTML/FORALL.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FORALL.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FORALL.html  --  ACL2 Version 6.2</title></head>
+<head><title>FORALL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FORALL</h3>universal quantifier
 <pre>Major Section:  <a href="DEFUN-SK.html">DEFUN-SK</a>
diff -Nru acl2-6.2/doc/HTML/FORCE.html acl2-6.3/doc/HTML/FORCE.html
--- acl2-6.2/doc/HTML/FORCE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/FORCE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,21 +1,29 @@
 <html>
-<head><title>FORCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>FORCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FORCE</h2>identity function used to force a hypothesis
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
 </pre><p/>
 <p>
-When a hypothesis of a conditional rule has the form <code>(force hyp)</code> it
-is logically equivalent to <code>hyp</code> but has a pragmatic effect.  In
-particular, when the rule is considered, the needed instance of the
-hypothesis, <code>hyp'</code>, is assumed and a special case is generated,
-requiring the system to prove that <code>hyp'</code> is true in the current
-context.  The proofs of all such ``forced assumptions'' are delayed
-until the successful completion of the main goal.
-See <a href="FORCING-ROUND.html">forcing-round</a>.</p><p>Forcing should only be used on hypotheses that are always expected to be
-true, as is commonly the case for <a href="GUARD.html">guard</a>s of functions.  All the power of
-the theorem prover is brought to bear on a forced hypothesis and no
-backtracking is possible.  Forced goals can be attacked immediately
+<code>Force</code> is the identity function: <code>(force x)</code> is equal to <code>x</code>.
+However, for rules of many classes (see <a href="RULE-CLASSES.html">rule-classes</a>), a hypothesis of the
+form <code>(force term)</code> is given special treatment, as described below.  This
+treatment takes place for rule classes <code>:</code><code><a href="REWRITE.html">rewrite</a></code>, <code>:</code><code><a href="LINEAR.html">linear</a></code>,
+<code>:</code><code><a href="TYPE-PRESCRIPTION.html">type-prescription</a></code>, <code>:</code><code><a href="DEFINITION.html">definition</a></code>, <code>:</code><code><a href="META.html">meta</a></code> (actually
+in that case, the result of evaluating the hypothesis metafunction call), and
+<code>:</code><code><a href="FORWARD-CHAINING.html">forward-chaining</a></code>.</p><p>When a hypothesis of a conditional rule (of one of the classes listed above)
+has the form <code>(force hyp)</code>, it is logically equivalent to <code>hyp</code> but has a
+pragmatic effect.  In particular, when the rule is considered, the needed
+instance of the hypothesis, <code>hyp'</code>, may be assumed if the usual process
+fails to prove it or its negation.  In that situation, if the rule is
+eventually applied, then a special case is generated, requiring the system to
+prove that <code>hyp'</code> is true in the current context.  The proofs of all such
+``forced assumptions'' are, by default, delayed until the successful
+completion of the main goal.  See <a href="FORCING-ROUND.html">forcing-round</a> and
+see <a href="IMMEDIATE-FORCE-MODEP.html">immediate-force-modep</a>.</p><p>Forcing is generally used on hypotheses that are always expected to be true,
+as is commonly the case for <a href="GUARD.html">guard</a>s of functions.  All the power of the
+theorem prover is brought to bear on a forced hypothesis and no backtracking
+is possible.  Forced goals can be attacked immediately
 (see <a href="IMMEDIATE-FORCE-MODEP.html">immediate-force-modep</a>) or in a subsequent forcing round
 (see <a href="FORCING-ROUND.html">forcing-round</a>).  Also see <a href="CASE-SPLIT.html">case-split</a> for a related utility.  If the
 <code>:</code><code><a href="EXECUTABLE-COUNTERPART.html">executable-counterpart</a></code> of the function <code>force</code> is <a href="DISABLE.html">disable</a>d,
diff -Nru acl2-6.2/doc/HTML/FORCED.html acl2-6.3/doc/HTML/FORCED.html
--- acl2-6.2/doc/HTML/FORCED.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/FORCED.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FORCED.html  --  ACL2 Version 6.2</title></head>
+<head><title>FORCED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FORCED</h2>See <a href="FORCE.html">force</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/FORCING-ROUND.html acl2-6.3/doc/HTML/FORCING-ROUND.html
--- acl2-6.2/doc/HTML/FORCING-ROUND.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/FORCING-ROUND.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FORCING-ROUND.html  --  ACL2 Version 6.2</title></head>
+<head><title>FORCING-ROUND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FORCING-ROUND</h2>a section of a proof dealing with <a href="FORCE.html">force</a>d assumptions
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/FORWARD-CHAINING-REPORTS.html acl2-6.3/doc/HTML/FORWARD-CHAINING-REPORTS.html
--- acl2-6.2/doc/HTML/FORWARD-CHAINING-REPORTS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FORWARD-CHAINING-REPORTS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FORWARD-CHAINING-REPORTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>FORWARD-CHAINING-REPORTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>FORWARD-CHAINING-REPORTS</h1>to see reports about the forward chaining process
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/FORWARD-CHAINING.html acl2-6.3/doc/HTML/FORWARD-CHAINING.html
--- acl2-6.2/doc/HTML/FORWARD-CHAINING.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/FORWARD-CHAINING.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,26 +1,28 @@
 <html>
-<head><title>FORWARD-CHAINING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FORWARD-CHAINING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FORWARD-CHAINING</h2>make a rule to forward chain when a certain trigger arises
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and how they are
-used to build rules from formulas.</p><p>
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
 <pre>
 Examples:
-(defthm p-and-r-forward
- (implies (and (p x) (r x))       ; When (p a) appears in a formula to be
-          (q (f x)))              ; simplified, try to establish (p a) and
-                                  ; (r a) and, if successful, add (q (f a))
-                                  ; to the known assumptions.
- :rule-classes :forward-chaining)
-
-; Equivalent to the above:
-(defthm p-and-r-forward
- (implies (and (p x) (r x))
-          (q (f x)))
- :rule-classes ((:forward-chaining :trigger-terms ((p x)))))
+
+(defthm p-and-r-forward           ; When (p a) appears in a formula to be
+ (implies (and (p x) (r x))       ; simplified, try to establish (p a) and
+          (q (f x)))              ; (r a) and, if successful, add (q (f a))
+ :rule-classes :forward-chaining) ; to the known assumptions.
+
+(defthm p-and-r-forward           ; as above with most defaults filled in
+  (implies (and (p x) (r x))
+           (q (f x)))
+  :rule-classes ((:forward-chaining :trigger-terms ((p x))
+                                    :corollary (implies (and (p x) (r x))
+                                                        (q (f x)))
+                                    :match-free :all)))
 </pre>
 </p><p>To specify the triggering terms provide a non-empty list of terms
 as the value of the <code>:trigger-terms</code> field of the rule class object.
diff -Nru acl2-6.2/doc/HTML/FOURTH.html acl2-6.3/doc/HTML/FOURTH.html
--- acl2-6.2/doc/HTML/FOURTH.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/FOURTH.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FOURTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>FOURTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FOURTH</h3>fourth member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING.html acl2-6.3/doc/HTML/FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING.html
--- acl2-6.2/doc/HTML/FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>FREE-VARIABLES-EXAMPLES-FORWARD-CHAINING</h4>examples pertaining to free variables in <a href="FORWARD-CHAINING.html">forward-chaining</a> rules
 <pre>Major Section:  <a href="FREE-VARIABLES-EXAMPLES.html">FREE-VARIABLES-EXAMPLES</a>
diff -Nru acl2-6.2/doc/HTML/FREE-VARIABLES-EXAMPLES-REWRITE.html acl2-6.3/doc/HTML/FREE-VARIABLES-EXAMPLES-REWRITE.html
--- acl2-6.2/doc/HTML/FREE-VARIABLES-EXAMPLES-REWRITE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/FREE-VARIABLES-EXAMPLES-REWRITE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FREE-VARIABLES-EXAMPLES-REWRITE.html  --  ACL2 Version 6.2</title></head>
+<head><title>FREE-VARIABLES-EXAMPLES-REWRITE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>FREE-VARIABLES-EXAMPLES-REWRITE</h4>examples pertaining to free variables in <a href="REWRITE.html">rewrite</a> rules
 <pre>Major Section:  <a href="FREE-VARIABLES-EXAMPLES.html">FREE-VARIABLES-EXAMPLES</a>
diff -Nru acl2-6.2/doc/HTML/FREE-VARIABLES-EXAMPLES.html acl2-6.3/doc/HTML/FREE-VARIABLES-EXAMPLES.html
--- acl2-6.2/doc/HTML/FREE-VARIABLES-EXAMPLES.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/FREE-VARIABLES-EXAMPLES.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FREE-VARIABLES-EXAMPLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>FREE-VARIABLES-EXAMPLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FREE-VARIABLES-EXAMPLES</h3>examples pertaining to free variables in rules
 <pre>Major Section:  <a href="FREE-VARIABLES.html">FREE-VARIABLES</a>
diff -Nru acl2-6.2/doc/HTML/FREE-VARIABLES-TYPE-PRESCRIPTION.html acl2-6.3/doc/HTML/FREE-VARIABLES-TYPE-PRESCRIPTION.html
--- acl2-6.2/doc/HTML/FREE-VARIABLES-TYPE-PRESCRIPTION.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/FREE-VARIABLES-TYPE-PRESCRIPTION.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FREE-VARIABLES-TYPE-PRESCRIPTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>FREE-VARIABLES-TYPE-PRESCRIPTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FREE-VARIABLES-TYPE-PRESCRIPTION</h3>matching for free variable in <a href="TYPE-PRESCRIPTION.html">type-prescription</a> rules
 <pre>Major Section:  <a href="FREE-VARIABLES.html">FREE-VARIABLES</a>
diff -Nru acl2-6.2/doc/HTML/FREE-VARIABLES.html acl2-6.3/doc/HTML/FREE-VARIABLES.html
--- acl2-6.2/doc/HTML/FREE-VARIABLES.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/FREE-VARIABLES.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FREE-VARIABLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>FREE-VARIABLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FREE-VARIABLES</h2>free variables in rules
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
diff -Nru acl2-6.2/doc/HTML/FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS.html acl2-6.3/doc/HTML/FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS.html
--- acl2-6.2/doc/HTML/FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS.html  --  ACL2 Version 6.2</title></head>
+<head><title>FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FREQUENTLY-ASKED-QUESTIONS-BY-NEWCOMERS</h3>some questions newcomers frequently ask
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/FULL-BOOK-NAME.html acl2-6.3/doc/HTML/FULL-BOOK-NAME.html
--- acl2-6.2/doc/HTML/FULL-BOOK-NAME.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/FULL-BOOK-NAME.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FULL-BOOK-NAME.html  --  ACL2 Version 6.2</title></head>
+<head><title>FULL-BOOK-NAME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FULL-BOOK-NAME</h2>book naming conventions assumed by ACL2
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/FUNCTION-THEORY.html acl2-6.3/doc/HTML/FUNCTION-THEORY.html
--- acl2-6.2/doc/HTML/FUNCTION-THEORY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/FUNCTION-THEORY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FUNCTION-THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>FUNCTION-THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FUNCTION-THEORY</h2>function symbol rules as of logical name
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/FUNCTIONAL-INSTANTIATION-EXAMPLE.html acl2-6.3/doc/HTML/FUNCTIONAL-INSTANTIATION-EXAMPLE.html
--- acl2-6.2/doc/HTML/FUNCTIONAL-INSTANTIATION-EXAMPLE.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/FUNCTIONAL-INSTANTIATION-EXAMPLE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FUNCTIONAL-INSTANTIATION-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>FUNCTIONAL-INSTANTIATION-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>FUNCTIONAL-INSTANTIATION-EXAMPLE</h4>a small proof demonstrating functional instantiation
 <pre>Major Section:  <a href="TUTORIAL5-MISCELLANEOUS-EXAMPLES.html">TUTORIAL5-MISCELLANEOUS-EXAMPLES</a>
diff -Nru acl2-6.2/doc/HTML/FUNCTIONAL-INSTANTIATION-IN-ACL2R.html acl2-6.3/doc/HTML/FUNCTIONAL-INSTANTIATION-IN-ACL2R.html
--- acl2-6.2/doc/HTML/FUNCTIONAL-INSTANTIATION-IN-ACL2R.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/FUNCTIONAL-INSTANTIATION-IN-ACL2R.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FUNCTIONAL-INSTANTIATION-IN-ACL2R.html  --  ACL2 Version 6.2</title></head>
+<head><title>FUNCTIONAL-INSTANTIATION-IN-ACL2R.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FUNCTIONAL-INSTANTIATION-IN-ACL2R</h2>additional requirements for <code>:functional-instance</code> hints in ACL2(r)
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/FURTHER-INFORMATION-ON-REWRITING.html acl2-6.3/doc/HTML/FURTHER-INFORMATION-ON-REWRITING.html
--- acl2-6.2/doc/HTML/FURTHER-INFORMATION-ON-REWRITING.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/FURTHER-INFORMATION-ON-REWRITING.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FURTHER-INFORMATION-ON-REWRITING.html  --  ACL2 Version 6.2</title></head>
+<head><title>FURTHER-INFORMATION-ON-REWRITING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>FURTHER-INFORMATION-ON-REWRITING</h3>a grab bag of advice and information on rewriting
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM.html acl2-6.3/doc/HTML/FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM.html
--- acl2-6.2/doc/HTML/FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM.html  --  ACL2 Version 6.2</title></head>
+<head><title>FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>FUTURE-WORK-RELATED-TO-THE-TAU-SYSTEM</h2>some tau system problems that we hope someone will address
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-TAU-SYSTEM.html">INTRODUCTION-TO-THE-TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/Flawed_Induction_Candidates_in_App_Example.html acl2-6.3/doc/HTML/Flawed_Induction_Candidates_in_App_Example.html
--- acl2-6.2/doc/HTML/Flawed_Induction_Candidates_in_App_Example.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Flawed_Induction_Candidates_in_App_Example.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Flawed_Induction_Candidates_in_App_Example.html  --  ACL2 Version 6.2</title></head>
+<head><title>Flawed_Induction_Candidates_in_App_Example.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Flawed Induction Candidates in App Example</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Free_Variables_in_Top-Level_Input.html acl2-6.3/doc/HTML/Free_Variables_in_Top-Level_Input.html
--- acl2-6.2/doc/HTML/Free_Variables_in_Top-Level_Input.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Free_Variables_in_Top-Level_Input.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Free_Variables_in_Top-Level_Input.html  --  ACL2 Version 6.2</title></head>
+<head><title>Free_Variables_in_Top-Level_Input.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Free Variables in Top-Level Input</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Functions_for_Manipulating_these_Objects.html acl2-6.3/doc/HTML/Functions_for_Manipulating_these_Objects.html
--- acl2-6.2/doc/HTML/Functions_for_Manipulating_these_Objects.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Functions_for_Manipulating_these_Objects.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Functions_for_Manipulating_these_Objects.html  --  ACL2 Version 6.2</title></head>
+<head><title>Functions_for_Manipulating_these_Objects.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Functions for Manipulating these Objects</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/GAG-MODE.html acl2-6.3/doc/HTML/GAG-MODE.html
--- acl2-6.2/doc/HTML/GAG-MODE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GAG-MODE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GAG-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>GAG-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GAG-MODE</h2>verbosity of proof output
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/GC$.html acl2-6.3/doc/HTML/GC$.html
--- acl2-6.2/doc/HTML/GC$.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GC$.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GC$.html  --  ACL2 Version 6.2</title></head>
+<head><title>GC$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GC$</h2>invoke the garbage collector
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/GC-VERBOSE.html acl2-6.3/doc/HTML/GC-VERBOSE.html
--- acl2-6.2/doc/HTML/GC-VERBOSE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GC-VERBOSE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GC-VERBOSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>GC-VERBOSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GC-VERBOSE</h2>control printing from the garbage collector
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/GCL.html acl2-6.3/doc/HTML/GCL.html
--- acl2-6.2/doc/HTML/GCL.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GCL.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GCL.html  --  ACL2 Version 6.2</title></head>
+<head><title>GCL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GCL</h2>tips on building and using ACL2 based on Gnu Common Lisp
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/GCS.html acl2-6.3/doc/HTML/GCS.html
--- acl2-6.2/doc/HTML/GCS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/GCS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GCS.html  --  ACL2 Version 6.2</title></head>
+<head><title>GCS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GCS</h2>See <a href="GET-COMMAND-SEQUENCE.html">get-command-sequence</a>.
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/GENERALIZE.html acl2-6.3/doc/HTML/GENERALIZE.html
--- acl2-6.2/doc/HTML/GENERALIZE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/GENERALIZE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,27 +1,37 @@
 <html>
-<head><title>GENERALIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>GENERALIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GENERALIZE</h2>make a rule to restrict generalizations
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example
-<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula from which a <code>:generalize</code> rule might be built is:
-
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
 <pre>
 Example:
-any theorem
+(defthm integer-listp-rev
+  (implies (integer-listp x)
+           (integer-listp (rev x)))
+  :rule-classes :generalize)
 
 General Form:
 any theorem
 </pre>
 
-To use such a <code>:generalize</code> rule, the system waits until it has
-decided to generalize some term, <code>term</code>, by replacing it with some new
-variable <code>v</code>.  If any <code>:generalize</code> formula can be instantiated so that
-some non-variable subterm becomes <code>term</code>, then that instance of the
-formula is added as a hypothesis.</p><p>At the moment, the best description of how ACL2 <code>:generalize</code> rules
+To use a <code>:generalize</code> rule, the system waits until it has decided to
+generalize some term, <code>term</code>, by replacing it with some new variable <code>v</code>.
+If any <code>:generalize</code> formula can be instantiated so that some non-variable
+subterm becomes <code>term</code>, then that instance of the formula is added as a
+hypothesis.  Thus for the example above, if the term <code>(rev x2)</code> is
+generalized to the variable <code>rv</code> during a proof, then the following is
+added as a hypothesis when generalizing to a new goal.
+
+<pre>
+(implies (integer-listp x2)
+         (integer-listp rv))
+</pre>
+</p><p>At the moment, the best description of how ACL2 <code>:generalize</code> rules
 are used may be found in the discussion of ``Generalize Rules,'' page
 248 of A Computational Logic Handbook, or ``Generalization,'' page
 132 of ``Computer-Aided Reasoning: An Approach.''  Also
diff -Nru acl2-6.2/doc/HTML/GENERALIZED-BOOLEANS.html acl2-6.3/doc/HTML/GENERALIZED-BOOLEANS.html
--- acl2-6.2/doc/HTML/GENERALIZED-BOOLEANS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GENERALIZED-BOOLEANS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GENERALIZED-BOOLEANS.html  --  ACL2 Version 6.2</title></head>
+<head><title>GENERALIZED-BOOLEANS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GENERALIZED-BOOLEANS</h3>potential soundness issues related to ACL2 predicates
 <pre>Major Section:  <a href="COMMON-LISP.html">COMMON-LISP</a>
diff -Nru acl2-6.2/doc/HTML/GENERALIZING-KEY-CHECKPOINTS.html acl2-6.3/doc/HTML/GENERALIZING-KEY-CHECKPOINTS.html
--- acl2-6.2/doc/HTML/GENERALIZING-KEY-CHECKPOINTS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/GENERALIZING-KEY-CHECKPOINTS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GENERALIZING-KEY-CHECKPOINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>GENERALIZING-KEY-CHECKPOINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GENERALIZING-KEY-CHECKPOINTS</h3>getting rid of unnecessary specificity
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/GET-COMMAND-SEQUENCE.html acl2-6.3/doc/HTML/GET-COMMAND-SEQUENCE.html
--- acl2-6.2/doc/HTML/GET-COMMAND-SEQUENCE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/GET-COMMAND-SEQUENCE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GET-COMMAND-SEQUENCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>GET-COMMAND-SEQUENCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GET-COMMAND-SEQUENCE</h2>return list of <a href="COMMAND.html">command</a>s that are between two <a href="COMMAND.html">command</a> descriptors
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/GET-INTERNAL-TIME.html acl2-6.3/doc/HTML/GET-INTERNAL-TIME.html
--- acl2-6.2/doc/HTML/GET-INTERNAL-TIME.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/GET-INTERNAL-TIME.html	2013-09-30 17:39:29.000000000 +0000
@@ -0,0 +1,58 @@
+<html>
+<head><title>GET-INTERNAL-TIME.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>GET-INTERNAL-TIME</h2>runtime vs. realtime in ACL2 timings
+<pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
+</pre><p/>
+<p>
+The ACL2 system provides utilities that deal with elapsed time.  The most
+visible of these is in the time summaries printed when completing evaluation
+of <a href="EVENTS.html">events</a>.  For others, see <a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a>, see <a href="READ-RUN-TIME.html">read-run-time</a>,
+see <a href="TIME-TRACKER.html">time-tracker</a>, see <a href="TIME-TRACKER-TAU.html">time-tracker-tau</a>, and see <a href="PSTACK.html">pstack</a>.</p><p>By default, these utilities all use an underlying notion of run time provided
+by the host Common Lisp implementation: specifically, Common Lisp function
+<code>get-internal-run-time</code>.  However, Common Lisp also provides function
+<code>get-internal-run-time</code>, which returns the real time (wall clock time).
+While the latter is specified to measure elapsed time, the former is left to
+the implementation, which might well only measure time spent in the Lisp
+process.  Consider the following example, which is a bit arcane but basically
+sleeps for 2 seconds.
+
+<pre>
+  (defttag t) ; to allow sys-call
+  (make-event
+   (prog2$ (sys-call "sleep" '("2"))
+           (value '(value-triple nil))))
+</pre>
+
+A typical time summary might be as follows, drastically under-reporting the
+elapsed time.
+
+<pre>
+  Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
+</pre>
+
+However, you can instruct ACL2 to switch to using elapsed time (run time), in
+summaries and elsewhere, by evaluating the following form.
+
+<pre>
+  (assign get-internal-time-as-realtime t)
+</pre>
+
+To return to using runtime:
+
+<pre>
+  (assign get-internal-time-as-realtime nil)
+</pre>
+
+While the above example is rather silly, the issue becomes significant in
+time summaries for proofs that call out to external tools (see <a href="SYS-CALL.html">sys-call</a> and
+see <a href="CLAUSE-PROCESSOR.html">clause-processor</a>).</p><p>Note that a function <code>get-internal-time</code> is defined in raw Lisp but is not
+available inside the ACL2 loop.  However, the expression
+<code>(read-run-time state)</code> provides an interface to this function that is
+available inside the ACL2 loop; see <a href="READ-RUN-TIME.html">read-run-time</a>.</p><p>We are open to changing the default to elapsed wall-clock time (realtime),
+and may do so in future ACL2 releases.
+</p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/GET-OUTPUT-STREAM-STRING$.html acl2-6.3/doc/HTML/GET-OUTPUT-STREAM-STRING$.html
--- acl2-6.2/doc/HTML/GET-OUTPUT-STREAM-STRING$.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/GET-OUTPUT-STREAM-STRING$.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GET-OUTPUT-STREAM-STRING$.html  --  ACL2 Version 6.2</title></head>
+<head><title>GET-OUTPUT-STREAM-STRING$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GET-OUTPUT-STREAM-STRING$</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/GET-WORMHOLE-STATUS.html acl2-6.3/doc/HTML/GET-WORMHOLE-STATUS.html
--- acl2-6.2/doc/HTML/GET-WORMHOLE-STATUS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GET-WORMHOLE-STATUS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GET-WORMHOLE-STATUS.html  --  ACL2 Version 6.2</title></head>
+<head><title>GET-WORMHOLE-STATUS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GET-WORMHOLE-STATUS</h2>make a wormhole's status visible outside the wormhole
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/GETENV$.html acl2-6.3/doc/HTML/GETENV$.html
--- acl2-6.2/doc/HTML/GETENV$.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/GETENV$.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GETENV$.html  --  ACL2 Version 6.2</title></head>
+<head><title>GETENV$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GETENV$</h3>read an environment variable
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/GETPROP.html acl2-6.3/doc/HTML/GETPROP.html
--- acl2-6.2/doc/HTML/GETPROP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/GETPROP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GETPROP.html  --  ACL2 Version 6.2</title></head>
+<head><title>GETPROP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GETPROP</h3>access fast property lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/GOAL-SPEC.html acl2-6.3/doc/HTML/GOAL-SPEC.html
--- acl2-6.2/doc/HTML/GOAL-SPEC.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GOAL-SPEC.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GOAL-SPEC.html  --  ACL2 Version 6.2</title></head>
+<head><title>GOAL-SPEC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GOAL-SPEC</h2>to indicate where a hint is to be used
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/GOOD-ATOM-LISTP.html acl2-6.3/doc/HTML/GOOD-ATOM-LISTP.html
--- acl2-6.2/doc/HTML/GOOD-ATOM-LISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/GOOD-ATOM-LISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GOOD-ATOM-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>GOOD-ATOM-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GOOD-ATOM-LISTP</h3>recognizer for a true list of ``good'' <a href="ATOM.html">atom</a>s
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/GOOD-BYE.html acl2-6.3/doc/HTML/GOOD-BYE.html
--- acl2-6.2/doc/HTML/GOOD-BYE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/GOOD-BYE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GOOD-BYE.html  --  ACL2 Version 6.2</title></head>
+<head><title>GOOD-BYE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GOOD-BYE</h2>quit entirely out of Lisp
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/GRANULARITY.html acl2-6.3/doc/HTML/GRANULARITY.html
--- acl2-6.2/doc/HTML/GRANULARITY.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/GRANULARITY.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GRANULARITY.html  --  ACL2 Version 6.2</title></head>
+<head><title>GRANULARITY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GRANULARITY</h3>limit the amount of parallelism
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/GROUND-ZERO.html acl2-6.3/doc/HTML/GROUND-ZERO.html
--- acl2-6.2/doc/HTML/GROUND-ZERO.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/GROUND-ZERO.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GROUND-ZERO.html  --  ACL2 Version 6.2</title></head>
+<head><title>GROUND-ZERO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GROUND-ZERO</h2><a href="ENABLE.html">enable</a>d rules in the <a href="STARTUP.html">startup</a> theory
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-DEBUG.html acl2-6.3/doc/HTML/GUARD-DEBUG.html
--- acl2-6.2/doc/HTML/GUARD-DEBUG.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-DEBUG.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-DEBUG.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-DEBUG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARD-DEBUG</h3>generate markers to indicate sources of guard proof obligations
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-EVALUATION-EXAMPLES-LOG.html acl2-6.3/doc/HTML/GUARD-EVALUATION-EXAMPLES-LOG.html
--- acl2-6.2/doc/HTML/GUARD-EVALUATION-EXAMPLES-LOG.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-EVALUATION-EXAMPLES-LOG.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-EVALUATION-EXAMPLES-LOG.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-EVALUATION-EXAMPLES-LOG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARD-EVALUATION-EXAMPLES-LOG</h3>log showing combinations of <a href="DEFUN-MODE.html">defun-mode</a>s and <a href="GUARD.html">guard</a>-checking
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-EVALUATION-EXAMPLES-SCRIPT.html acl2-6.3/doc/HTML/GUARD-EVALUATION-EXAMPLES-SCRIPT.html
--- acl2-6.2/doc/HTML/GUARD-EVALUATION-EXAMPLES-SCRIPT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-EVALUATION-EXAMPLES-SCRIPT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-EVALUATION-EXAMPLES-SCRIPT.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-EVALUATION-EXAMPLES-SCRIPT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARD-EVALUATION-EXAMPLES-SCRIPT</h3>a script to show combinations of <a href="DEFUN-MODE.html">defun-mode</a>s and <a href="GUARD.html">guard</a>-checking
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-EVALUATION-TABLE.html acl2-6.3/doc/HTML/GUARD-EVALUATION-TABLE.html
--- acl2-6.2/doc/HTML/GUARD-EVALUATION-TABLE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-EVALUATION-TABLE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-EVALUATION-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-EVALUATION-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARD-EVALUATION-TABLE</h3>a table that shows combinations of <a href="DEFUN-MODE.html">defun-mode</a>s and <a href="GUARD.html">guard</a>-checking
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-EXAMPLE.html acl2-6.3/doc/HTML/GUARD-EXAMPLE.html
--- acl2-6.2/doc/HTML/GUARD-EXAMPLE.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-EXAMPLE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>GUARD-EXAMPLE</h4>a brief transcript illustrating <a href="GUARD.html">guard</a>s in ACL2
 <pre>Major Section:  <a href="TUTORIAL5-MISCELLANEOUS-EXAMPLES.html">TUTORIAL5-MISCELLANEOUS-EXAMPLES</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-HINTS.html acl2-6.3/doc/HTML/GUARD-HINTS.html
--- acl2-6.2/doc/HTML/GUARD-HINTS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-HINTS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GUARD-HINTS</h2>xargs keyword <code>:GUARD-HINTS</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-INTRODUCTION.html acl2-6.3/doc/HTML/GUARD-INTRODUCTION.html
--- acl2-6.2/doc/HTML/GUARD-INTRODUCTION.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-INTRODUCTION.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-INTRODUCTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-INTRODUCTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARD-INTRODUCTION</h3>introduction to <a href="GUARD.html">guard</a>s in ACL2
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-MISCELLANY.html acl2-6.3/doc/HTML/GUARD-MISCELLANY.html
--- acl2-6.2/doc/HTML/GUARD-MISCELLANY.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-MISCELLANY.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-MISCELLANY.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-MISCELLANY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARD-MISCELLANY</h3>miscellaneous remarks about guards
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-OBLIGATION.html acl2-6.3/doc/HTML/GUARD-OBLIGATION.html
--- acl2-6.2/doc/HTML/GUARD-OBLIGATION.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-OBLIGATION.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-OBLIGATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-OBLIGATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GUARD-OBLIGATION</h2>the guard proof obligation
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/GUARD-QUICK-REFERENCE.html acl2-6.3/doc/HTML/GUARD-QUICK-REFERENCE.html
--- acl2-6.2/doc/HTML/GUARD-QUICK-REFERENCE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD-QUICK-REFERENCE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD-QUICK-REFERENCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD-QUICK-REFERENCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARD-QUICK-REFERENCE</h3>brief summary of guard checking and guard verification
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/GUARD.html acl2-6.3/doc/HTML/GUARD.html
--- acl2-6.2/doc/HTML/GUARD.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARD.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARD.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>GUARD</h2>restricting the domain of a function
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/GUARDS-AND-EVALUATION.html acl2-6.3/doc/HTML/GUARDS-AND-EVALUATION.html
--- acl2-6.2/doc/HTML/GUARDS-AND-EVALUATION.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARDS-AND-EVALUATION.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARDS-AND-EVALUATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARDS-AND-EVALUATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARDS-AND-EVALUATION</h3>the relationship between guards and evaluation
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/GUARDS-FOR-SPECIFICATION.html acl2-6.3/doc/HTML/GUARDS-FOR-SPECIFICATION.html
--- acl2-6.2/doc/HTML/GUARDS-FOR-SPECIFICATION.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/GUARDS-FOR-SPECIFICATION.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>GUARDS-FOR-SPECIFICATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>GUARDS-FOR-SPECIFICATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>GUARDS-FOR-SPECIFICATION</h3>guards as a specification device
 <pre>Major Section:  <a href="GUARD.html">GUARD</a>
diff -Nru acl2-6.2/doc/HTML/Guards.html acl2-6.3/doc/HTML/Guards.html
--- acl2-6.2/doc/HTML/Guards.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Guards.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Guards.html  --  ACL2 Version 6.2</title></head>
+<head><title>Guards.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Guards</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Guessing_the_Type_of_a_Newly_Admitted_Function.html acl2-6.3/doc/HTML/Guessing_the_Type_of_a_Newly_Admitted_Function.html
--- acl2-6.2/doc/HTML/Guessing_the_Type_of_a_Newly_Admitted_Function.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Guessing_the_Type_of_a_Newly_Admitted_Function.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Guessing_the_Type_of_a_Newly_Admitted_Function.html  --  ACL2 Version 6.2</title></head>
+<head><title>Guessing_the_Type_of_a_Newly_Admitted_Function.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Guessing the Type of a Newly Admitted Function</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Guiding_the_ACL2_Theorem_Prover.html acl2-6.3/doc/HTML/Guiding_the_ACL2_Theorem_Prover.html
--- acl2-6.2/doc/HTML/Guiding_the_ACL2_Theorem_Prover.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Guiding_the_ACL2_Theorem_Prover.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Guiding_the_ACL2_Theorem_Prover.html  --  ACL2 Version 6.2</title></head>
+<head><title>Guiding_the_ACL2_Theorem_Prover.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Guiding the ACL2 Theorem Prover</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/HANDS-OFF.html acl2-6.3/doc/HTML/HANDS-OFF.html
--- acl2-6.2/doc/HTML/HANDS-OFF.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/HANDS-OFF.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HANDS-OFF.html  --  ACL2 Version 6.2</title></head>
+<head><title>HANDS-OFF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HANDS-OFF</h2>hints keyword <code>:HANDS-OFF</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/HARD-ERROR.html acl2-6.3/doc/HTML/HARD-ERROR.html
--- acl2-6.2/doc/HTML/HARD-ERROR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/HARD-ERROR.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HARD-ERROR.html  --  ACL2 Version 6.2</title></head>
+<head><title>HARD-ERROR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>HARD-ERROR</h3>print an error message and stop execution
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/HEADER.html acl2-6.3/doc/HTML/HEADER.html
--- acl2-6.2/doc/HTML/HEADER.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/HEADER.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HEADER.html  --  ACL2 Version 6.2</title></head>
+<head><title>HEADER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>HEADER</h3>return the header of a 1- or 2-dimensional array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/HELP.html acl2-6.3/doc/HTML/HELP.html
--- acl2-6.2/doc/HTML/HELP.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/HELP.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HELP.html  --  ACL2 Version 6.2</title></head>
+<head><title>HELP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HELP</h2>brief survey of ACL2 features
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/HIDDEN-DEATH-PACKAGE.html acl2-6.3/doc/HTML/HIDDEN-DEATH-PACKAGE.html
--- acl2-6.2/doc/HTML/HIDDEN-DEATH-PACKAGE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/HIDDEN-DEATH-PACKAGE.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HIDDEN-DEATH-PACKAGE.html  --  ACL2 Version 6.2</title></head>
+<head><title>HIDDEN-DEATH-PACKAGE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>HIDDEN-DEATH-PACKAGE</h3>handling <code><a href="DEFPKG.html">defpkg</a></code> <a href="EVENTS.html">events</a> that are <code><a href="LOCAL.html">local</a></code>
 <pre>Major Section:  <a href="DEFPKG.html">DEFPKG</a>
diff -Nru acl2-6.2/doc/HTML/HIDDEN-DEFPKG.html acl2-6.3/doc/HTML/HIDDEN-DEFPKG.html
--- acl2-6.2/doc/HTML/HIDDEN-DEFPKG.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/HIDDEN-DEFPKG.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HIDDEN-DEFPKG.html  --  ACL2 Version 6.2</title></head>
+<head><title>HIDDEN-DEFPKG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>HIDDEN-DEFPKG</h3>handling defpkg events that are local
 <pre>Major Section:  <a href="DEFPKG.html">DEFPKG</a>
diff -Nru acl2-6.2/doc/HTML/HIDE.html acl2-6.3/doc/HTML/HIDE.html
--- acl2-6.2/doc/HTML/HIDE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/HIDE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HIDE.html  --  ACL2 Version 6.2</title></head>
+<head><title>HIDE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HIDE</h2>hide a term from the rewriter
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/HINTS-AND-THE-WATERFALL.html acl2-6.3/doc/HTML/HINTS-AND-THE-WATERFALL.html
--- acl2-6.2/doc/HTML/HINTS-AND-THE-WATERFALL.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/HINTS-AND-THE-WATERFALL.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HINTS-AND-THE-WATERFALL.html  --  ACL2 Version 6.2</title></head>
+<head><title>HINTS-AND-THE-WATERFALL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HINTS-AND-THE-WATERFALL</h2>how <a href="HINTS.html">hints</a> fit into the ACL2 proof waterfall
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/HINTS.html acl2-6.3/doc/HTML/HINTS.html
--- acl2-6.2/doc/HTML/HINTS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/HINTS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HINTS</h2>advice to the theorem proving process
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/HISTORY.html acl2-6.3/doc/HTML/HISTORY.html
--- acl2-6.2/doc/HTML/HISTORY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HISTORY.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HISTORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>HISTORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>HISTORY</h1>functions that display or change history
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/HONS-ACONS.html acl2-6.3/doc/HTML/HONS-ACONS.html
--- acl2-6.2/doc/HTML/HONS-ACONS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-ACONS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-ACONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-ACONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-ACONS</h2><code>(hons-acons key val alist)</code> is the main way to create or extend
 <code>   </code><a href="FAST-ALISTS.html">fast-alists</a>.
diff -Nru acl2-6.2/doc/HTML/HONS-ACONS_bang_.html acl2-6.3/doc/HTML/HONS-ACONS_bang_.html
--- acl2-6.2/doc/HTML/HONS-ACONS_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-ACONS_bang_.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-ACONS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-ACONS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-ACONS!</h2><code>(hons-acons! key val alist)</code> is an alternative to <code><a href="HONS-ACONS.html">hons-acons</a></code> that
 <code>   </code>produces <a href="NORMED.html">normed</a>, fast alists.
diff -Nru acl2-6.2/doc/HTML/HONS-AND-MEMOIZATION.html acl2-6.3/doc/HTML/HONS-AND-MEMOIZATION.html
--- acl2-6.2/doc/HTML/HONS-AND-MEMOIZATION.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-AND-MEMOIZATION.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-AND-MEMOIZATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-AND-MEMOIZATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>HONS-AND-MEMOIZATION</h1>hash cons, function memoization, and applicative hash tables
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/HONS-ASSOC-EQUAL.html acl2-6.3/doc/HTML/HONS-ASSOC-EQUAL.html
--- acl2-6.2/doc/HTML/HONS-ASSOC-EQUAL.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-ASSOC-EQUAL.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-ASSOC-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-ASSOC-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-ASSOC-EQUAL</h2><code>(hons-assoc-equal key alist)</code> is <strong>not fast</strong>; it serves as the logical
 <code>   </code>definition for <code><a href="HONS-GET.html">hons-get</a></code>.
diff -Nru acl2-6.2/doc/HTML/HONS-CLEAR.html acl2-6.3/doc/HTML/HONS-CLEAR.html
--- acl2-6.2/doc/HTML/HONS-CLEAR.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-CLEAR.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-CLEAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-CLEAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-CLEAR</h2><code>(hons-clear gc)</code> is a drastic garbage collection mechanism that clears out
 <code>   </code>the underlying Hons Space.
diff -Nru acl2-6.2/doc/HTML/HONS-COPY-PERSISTENT.html acl2-6.3/doc/HTML/HONS-COPY-PERSISTENT.html
--- acl2-6.2/doc/HTML/HONS-COPY-PERSISTENT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-COPY-PERSISTENT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-COPY-PERSISTENT.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-COPY-PERSISTENT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-COPY-PERSISTENT</h2><code>(hons-copy-persistent x)</code> returns a <a href="NORMED.html">normed</a> object that is equal to X
 <code>   </code>and which will be re-normed after any calls to <code><a href="HONS-CLEAR.html">hons-clear</a></code>.
diff -Nru acl2-6.2/doc/HTML/HONS-COPY.html acl2-6.3/doc/HTML/HONS-COPY.html
--- acl2-6.2/doc/HTML/HONS-COPY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-COPY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-COPY.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-COPY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-COPY</h2><code>(hons-copy x)</code> returns a <a href="NORMED.html">normed</a> object that is equal to X.
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/HONS-EQUAL-LITE.html acl2-6.3/doc/HTML/HONS-EQUAL-LITE.html
--- acl2-6.2/doc/HTML/HONS-EQUAL-LITE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-EQUAL-LITE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-EQUAL-LITE.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-EQUAL-LITE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-EQUAL-LITE</h2><code>(hons-equal-lite x y)</code> is a non-recursive equality check that optimizes if
 <code>   </code>its arguments are <a href="NORMED.html">normed</a>.
diff -Nru acl2-6.2/doc/HTML/HONS-EQUAL.html acl2-6.3/doc/HTML/HONS-EQUAL.html
--- acl2-6.2/doc/HTML/HONS-EQUAL.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-EQUAL.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-EQUAL</h2><code>(hons-equal x y)</code> is a recursive equality check that optimizes when parts of
 <code>   </code>its arguments are <a href="NORMED.html">normed</a>.
diff -Nru acl2-6.2/doc/HTML/HONS-GET.html acl2-6.3/doc/HTML/HONS-GET.html
--- acl2-6.2/doc/HTML/HONS-GET.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-GET.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-GET.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-GET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-GET</h2><code>(hons-get key alist)</code> is the efficient lookup operation for
 <code>   </code><a href="FAST-ALISTS.html">fast-alists</a>.
diff -Nru acl2-6.2/doc/HTML/HONS-NOTE.html acl2-6.3/doc/HTML/HONS-NOTE.html
--- acl2-6.2/doc/HTML/HONS-NOTE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-NOTE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-NOTE.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-NOTE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-NOTE</h2>notes about <a href="HONS.html">HONS</a>, especially pertaining to expensive resizing operations
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/HONS-RESIZE.html acl2-6.3/doc/HTML/HONS-RESIZE.html
--- acl2-6.2/doc/HTML/HONS-RESIZE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-RESIZE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-RESIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-RESIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-RESIZE</h2><code>(hons-resize ...)</code> can be used to manually adjust the sizes of the hash
 <code>   </code>tables that govern which ACL2 Objects are considered <a href="NORMED.html">normed</a>.
diff -Nru acl2-6.2/doc/HTML/HONS-SHRINK-ALIST.html acl2-6.3/doc/HTML/HONS-SHRINK-ALIST.html
--- acl2-6.2/doc/HTML/HONS-SHRINK-ALIST.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-SHRINK-ALIST.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-SHRINK-ALIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-SHRINK-ALIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-SHRINK-ALIST</h2><code>(hons-shrink-alist alist ans)</code> can be used to eliminate "shadowed pairs"
 <code>   </code>from an alist or to copy <a href="FAST-ALISTS.html">fast-alists</a>.
@@ -7,7 +7,8 @@
 </pre><p/>
 <p>
 This <a href="DOCUMENTATION.html">documentation</a> topic relates to the experimental extension of ACL2
-supporting hash cons, fast alists, and memoization; see <a href="HONS-AND-MEMOIZATION.html">hons-and-memoization</a>.</p><p>Logically, <code>hons-shrink-alist</code> is defined as follows:</p><p>
+supporting hash cons, fast alists, and memoization; see <a href="HONS-AND-MEMOIZATION.html">hons-and-memoization</a>.
+It assumes familiarity with fast alists; see <a href="FAST-ALISTS.html">fast-alists</a>.</p><p>Logically, <code>(hons-shrink-alist alist ans)</code> is defined as follows:</p><p>
 <pre>
  (cond ((atom alist)
         ans)
@@ -24,11 +25,30 @@
 have been removed, and (3) incidentally, the surviving elements have been
 reversed.  This can be useful as a way to clean up any unnecessary bindings in
 alist, or as a way to obtain a "deep copy" of a fast alist that can extended
-independently from the original while maintaining discipline.</p><p>When ans is not an atom, good discipline requires that it is a fast alist.  In
+independently from the original while maintaining discipline.</p><p>Note that hons-shrink-alist is potentially expensive, for the following two
+reasons.
+</p>
+<blockquote><p></p><p>o The alist is copied, dropping any shadowed pairs.  This process will require
+a hash table lookup for each entry in the alist; and it will require creating a
+new alist, which uses additional memory.</p><p>o Unless ans is a fast alist that is stolen (see below), a new hash table is
+created, which uses additional memory.  This hash table is populated in time
+that is linear in the number of unique keys in the alist.
+</p></blockquote>
+<p></p><p>When ans is not an atom, good discipline requires that it is a fast alist.  In
 this case, <code>hons-shrink-alist</code> steals the hash table for ans and extends it
 with all of the bindings in alist that are not in ans.  From the perspective of
 <code><a href="HONS-ASSOC-EQUAL.html">hons-assoc-equal</a></code>, you can think of the resulting alist as being basically
-similar to <code>(append ans alist)</code>, but in a different order.
+similar to <code>(append ans alist)</code>, but in a different order.</p><p>Note that when ans is not a fast alist (e.g., ans is an atom) then such
+stealing does not take place.</p><p>A common idiom is to replace an alist by the result of shrinking it, in which
+case it is best to free the input alist, for example as follows.
+
+<pre>
+  (let ((alist (fast-alist-free-on-exit alist
+                                        (hons-shrink-alist alist nil))))
+    ...)
+</pre>
+
+See <a href="FAST-ALIST-FREE-ON-EXIT.html">fast-alist-free-on-exit</a> and see <a href="FAST-ALIST-FREE.html">fast-alist-free</a>.
 </p>
 <p>
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
diff -Nru acl2-6.2/doc/HTML/HONS-SHRINK-ALIST_bang_.html acl2-6.3/doc/HTML/HONS-SHRINK-ALIST_bang_.html
--- acl2-6.2/doc/HTML/HONS-SHRINK-ALIST_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-SHRINK-ALIST_bang_.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-SHRINK-ALIST_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-SHRINK-ALIST_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-SHRINK-ALIST!</h2><code>(hons-shrink-alist! alist ans)</code> is an alternative to <code><a href="HONS-SHRINK-ALIST.html">hons-shrink-alist</a></code>
 <code>   </code>that produces a <a href="NORMED.html">normed</a> result.
diff -Nru acl2-6.2/doc/HTML/HONS-SUMMARY.html acl2-6.3/doc/HTML/HONS-SUMMARY.html
--- acl2-6.2/doc/HTML/HONS-SUMMARY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-SUMMARY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-SUMMARY.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-SUMMARY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-SUMMARY</h2><code>(hons-summary)</code> prints basic information about the sizes of the tables in
 <code>   </code>the current Hons Space.
diff -Nru acl2-6.2/doc/HTML/HONS-WASH.html acl2-6.3/doc/HTML/HONS-WASH.html
--- acl2-6.2/doc/HTML/HONS-WASH.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS-WASH.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS-WASH.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS-WASH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS-WASH</h2><code>(hons-wash)</code> is like <code><a href="GC$.html">gc$</a></code> but can also garbage collect <a href="NORMED.html">normed</a>
 <code>   </code>objects (CCL Only).
diff -Nru acl2-6.2/doc/HTML/HONS.html acl2-6.3/doc/HTML/HONS.html
--- acl2-6.2/doc/HTML/HONS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/HONS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>HONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>HONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>HONS</h2><code>(hons x y)</code> returns a <a href="NORMED.html">normed</a> object equal to <code>(cons x y)</code>.
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/Hey_Wait_bang___Is_ACL2_Typed_or_Untyped_lparen_Q_rparen_.html acl2-6.3/doc/HTML/Hey_Wait_bang___Is_ACL2_Typed_or_Untyped_lparen_Q_rparen_.html
--- acl2-6.2/doc/HTML/Hey_Wait_bang___Is_ACL2_Typed_or_Untyped_lparen_Q_rparen_.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Hey_Wait_bang___Is_ACL2_Typed_or_Untyped_lparen_Q_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Hey_Wait_bang___Is_ACL2_Typed_or_Untyped_lparen_Q_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>Hey_Wait_bang___Is_ACL2_Typed_or_Untyped_lparen_Q_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Hey Wait!  Is ACL2 Typed or Untyped?</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/How_Long_Does_It_Take_to_Become_an_Effective_User_lparen_Q_rparen_.html acl2-6.3/doc/HTML/How_Long_Does_It_Take_to_Become_an_Effective_User_lparen_Q_rparen_.html
--- acl2-6.2/doc/HTML/How_Long_Does_It_Take_to_Become_an_Effective_User_lparen_Q_rparen_.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/How_Long_Does_It_Take_to_Become_an_Effective_User_lparen_Q_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>How_Long_Does_It_Take_to_Become_an_Effective_User_lparen_Q_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>How_Long_Does_It_Take_to_Become_an_Effective_User_lparen_Q_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>How Long Does It Take to Become an Effective User?</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/How_To_Find_Out_about_ACL2_Functions.html acl2-6.3/doc/HTML/How_To_Find_Out_about_ACL2_Functions.html
--- acl2-6.2/doc/HTML/How_To_Find_Out_about_ACL2_Functions.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/How_To_Find_Out_about_ACL2_Functions.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>How_To_Find_Out_about_ACL2_Functions.html  --  ACL2 Version 6.2</title></head>
+<head><title>How_To_Find_Out_about_ACL2_Functions.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>How To Find Out about ACL2 Functions</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/How_To_Find_Out_about_ACL2_Functions__lparen_cont_rparen_.html acl2-6.3/doc/HTML/How_To_Find_Out_about_ACL2_Functions__lparen_cont_rparen_.html
--- acl2-6.2/doc/HTML/How_To_Find_Out_about_ACL2_Functions__lparen_cont_rparen_.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/How_To_Find_Out_about_ACL2_Functions__lparen_cont_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>How_To_Find_Out_about_ACL2_Functions__lparen_cont_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>How_To_Find_Out_about_ACL2_Functions__lparen_cont_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>How To Find Out about ACL2 Functions (cont)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/I-AM-HERE.html acl2-6.3/doc/HTML/I-AM-HERE.html
--- acl2-6.2/doc/HTML/I-AM-HERE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/I-AM-HERE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>I-AM-HERE.html  --  ACL2 Version 6.2</title></head>
+<head><title>I-AM-HERE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>I-AM-HERE</h2>a convenient marker for use with <code><a href="REBUILD.html">rebuild</a></code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/I-CLOSE.html acl2-6.3/doc/HTML/I-CLOSE.html
--- acl2-6.2/doc/HTML/I-CLOSE.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/I-CLOSE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>I-CLOSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>I-CLOSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>I-CLOSE</h2>ACL2(r) test for whether two numbers are infinitesimally close
 <pre>Major Section:  <a href="REAL.html">REAL</a>
diff -Nru acl2-6.2/doc/HTML/I-LARGE.html acl2-6.3/doc/HTML/I-LARGE.html
--- acl2-6.2/doc/HTML/I-LARGE.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/I-LARGE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>I-LARGE.html  --  ACL2 Version 6.2</title></head>
+<head><title>I-LARGE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>I-LARGE</h2>ACL2(r) recognizer for infinitely large numbers
 <pre>Major Section:  <a href="REAL.html">REAL</a>
diff -Nru acl2-6.2/doc/HTML/I-LIMITED.html acl2-6.3/doc/HTML/I-LIMITED.html
--- acl2-6.2/doc/HTML/I-LIMITED.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/I-LIMITED.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>I-LIMITED.html  --  ACL2 Version 6.2</title></head>
+<head><title>I-LIMITED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>I-LIMITED</h2>ACL2(r) recognizer for limited numbers
 <pre>Major Section:  <a href="REAL.html">REAL</a>
diff -Nru acl2-6.2/doc/HTML/I-SMALL.html acl2-6.3/doc/HTML/I-SMALL.html
--- acl2-6.2/doc/HTML/I-SMALL.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/I-SMALL.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>I-SMALL.html  --  ACL2 Version 6.2</title></head>
+<head><title>I-SMALL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>I-SMALL</h2>ACL2(r) recognizer for infinitesimal numbers
 <pre>Major Section:  <a href="REAL.html">REAL</a>
diff -Nru acl2-6.2/doc/HTML/IDENTITY.html acl2-6.3/doc/HTML/IDENTITY.html
--- acl2-6.2/doc/HTML/IDENTITY.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/IDENTITY.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IDENTITY.html  --  ACL2 Version 6.2</title></head>
+<head><title>IDENTITY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>IDENTITY</h3>the identity function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/IF-INTRO.html acl2-6.3/doc/HTML/IF-INTRO.html
--- acl2-6.2/doc/HTML/IF-INTRO.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/IF-INTRO.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IF-INTRO.html  --  ACL2 Version 6.2</title></head>
+<head><title>IF-INTRO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IF-INTRO</h2>See <a href="SPLITTER.html">splitter</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/IF.html acl2-6.3/doc/HTML/IF.html
--- acl2-6.2/doc/HTML/IF.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/IF.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IF.html  --  ACL2 Version 6.2</title></head>
+<head><title>IF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>IF</h3>if-then-else function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/IFF.html acl2-6.3/doc/HTML/IFF.html
--- acl2-6.2/doc/HTML/IFF.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/IFF.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IFF.html  --  ACL2 Version 6.2</title></head>
+<head><title>IFF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>IFF</h3>logical ``if and only if''
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/IFIX.html acl2-6.3/doc/HTML/IFIX.html
--- acl2-6.2/doc/HTML/IFIX.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/IFIX.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IFIX.html  --  ACL2 Version 6.2</title></head>
+<head><title>IFIX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>IFIX</h3>coerce to an integer
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/IF_star_.html acl2-6.3/doc/HTML/IF_star_.html
--- acl2-6.2/doc/HTML/IF_star_.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/IF_star_.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IF_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>IF_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IF*</h2>for conditional rewriting with BDDs
 <pre>Major Section:  <a href="BDD.html">BDD</a>
diff -Nru acl2-6.2/doc/HTML/IGNORABLE.html acl2-6.3/doc/HTML/IGNORABLE.html
--- acl2-6.2/doc/HTML/IGNORABLE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/IGNORABLE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IGNORABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>IGNORABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IGNORABLE</h2>See <a href="DECLARE.html">declare</a>.
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/IGNORE.html acl2-6.3/doc/HTML/IGNORE.html
--- acl2-6.2/doc/HTML/IGNORE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/IGNORE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IGNORE.html  --  ACL2 Version 6.2</title></head>
+<head><title>IGNORE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IGNORE</h2>See <a href="DECLARE.html">declare</a>.
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/IGNORED-ATTACHMENT.html acl2-6.3/doc/HTML/IGNORED-ATTACHMENT.html
--- acl2-6.2/doc/HTML/IGNORED-ATTACHMENT.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/IGNORED-ATTACHMENT.html	2013-09-30 17:39:29.000000000 +0000
@@ -0,0 +1,110 @@
+<html>
+<head><title>IGNORED-ATTACHMENT.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>IGNORED-ATTACHMENT</h2>why attachments are sometimes not used
+<pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
+</pre><p/>
+<p>
+Attachments provide a way to execute constrained functions.  But in some
+cases, ACL2 will not permit such execution.  We discuss this issue briefly
+here.  For more information about attachments, see <a href="DEFATTACH.html">defattach</a>.</p><p>We illustrate this issue with the following example, discussed below.
+
+<pre>
+  (encapsulate
+   ()
+   (defstub foo () t)
+   (defn foo-impl-1 () t)
+   (defattach foo foo-impl-1)
+   (defn foo-impl-2 () nil)
+   (local (defattach foo foo-impl-2))
+   (defmacro mac () (foo)) ; nil in the first pass, t in the second pass
+   (defun bar () (mac))    ; nil in the first pass, t in the second pass
+   (defthm bar-is-nil
+     (equal (bar) nil))
+   )
+</pre>
+</p><p>Here, a non-executable function <code>foo</code> is introduced with no constraints,
+and is provided two contradictory implementations, <code>foo-impl-1</code> and
+<code>foo-impl-2</code>.  A function, <code>bar</code>, is defined using a macro, <code>mac</code>,
+whose expansion depends on which of <code>foo-impl-1</code> or <code>foo-impl-2</code> is
+attached to <code>foo</code>.  If ACL2 were to allow this, then as indicated by the
+comments above, <code>(bar)</code> would be defined to be <code>nil</code> on the first pass of
+the <code><a href="ENCAPSULATE.html">encapsulate</a></code> form, where <code>foo</code> is attached to <code>foo-impl-2</code>; but
+<code>(bar)</code> would be defined to be <code>t</code> on the second pass, where <code>foo</code> is
+attached to <code>foo-impl-1</code> because the second <code><a href="DEFATTACH.html">defattach</a></code> call is
+<code><a href="LOCAL.html">local</a></code>.  Thus, after execution of the <code>encapsulate</code> form, <code>(bar)</code>
+would be provably equal to <code>t</code> even though there would be a theorem,
+<code>bar-is-nil</code> -- proved during the first pass of the <code>encapsulate</code> --
+saying that <code>(bar)</code> is <code>nil</code>!</p><p>Fortunately, ACL2 does not permit this to happen.  The example above produces
+the following output.</p><p>
+<pre>
+  ACL2 !&gt;&gt;(DEFUN BAR NIL (MAC))
+
+
+  ACL2 Error in ( DEFUN BAR ...):  In the attempt to macroexpand the
+  form (MAC), evaluation of the macro body caused the following error:
+
+  ACL2 cannot ev the call of undefined function FOO on argument list:
+
+  NIL
+
+  Note that because of logical considerations, attachments (including
+  FOO-IMPL-2) must not be called in this context.
+</pre>
+</p><p>We see, then, the importance of disallowing evaluation using attachments
+during macroexpansion.  ACL2 is careful to avoid attachments in situations,
+like this one, where using attachments could be unsound.
+</p>
+<p>We conclude with an example illustrating how <code><a href="MAKE-EVENT.html">make-event</a></code> can be used to
+work around the refusal of ACL2 to use attachments during macroexpansion.
+The idea is that <code><a href="MAKE-EVENT.html">make-event</a></code> expansions are stored, and this avoids the
+issue of <code><a href="LOCAL.html">local</a></code> attachments.  In particular, for the example below, the
+second <code><a href="DEFATTACH.html">defattach</a></code> affects the body of <code>f2</code> even though that
+<code><a href="DEFATTACH.html">defattach</a></code> is <code><a href="LOCAL.html">local</a></code>, because the expansion of the corresponding
+<code><a href="MAKE-EVENT.html">make-event</a></code> is saved during the first pass of <code><a href="CERTIFY-BOOK.html">certify-book</a></code>, when
+full admissibility checks are done.  Then even after including the book, the
+definition of <code>f2</code> will be based on the second (<code><a href="LOCAL.html">local</a></code>)
+<code><a href="DEFATTACH.html">defattach</a></code> form below.</p><p>
+<pre>
+(in-package "ACL2")
+
+(defun body-1 (name formals body)
+  (declare (ignore name))
+  `(if (consp ,(car formals))
+       ,body
+     nil))
+
+(defun body-2 (name formals body)
+  (declare (ignore name))
+  `(if (acl2-numberp ,(car formals))
+       ,body
+     t))
+
+(defmacro defun+ (name formals body)
+  `(make-event
+    (if (foo) ; attachable stub
+        '(defun ,name ,formals ,(body-1 name formals body))
+      '(defun ,name ,formals ,(body-2 name formals body)))))
+
+;;; (defun+ f1 (x y) (cons x y)) ; fails because foo has no attachment
+
+(defstub foo () t)
+(defn foo-true () t)
+(defn foo-false () nil)
+
+(defattach foo foo-true)
+
+(defun+ f1 (x y) (cons x y))
+
+(local (defattach foo foo-false))
+
+(defun+ f2 (x y) (cons x y))
+
+(assert-event (equal (f1 3 t) nil))
+
+(assert-event (equal (f2 3 t) (cons 3 t)))
+</pre>
+
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/ILLEGAL.html acl2-6.3/doc/HTML/ILLEGAL.html
--- acl2-6.2/doc/HTML/ILLEGAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/ILLEGAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ILLEGAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ILLEGAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ILLEGAL</h3>print an error message and stop execution
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/IMAGPART.html acl2-6.3/doc/HTML/IMAGPART.html
--- acl2-6.2/doc/HTML/IMAGPART.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/IMAGPART.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IMAGPART.html  --  ACL2 Version 6.2</title></head>
+<head><title>IMAGPART.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>IMAGPART</h3>imaginary part of a complex number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/IMMED-FORCED.html acl2-6.3/doc/HTML/IMMED-FORCED.html
--- acl2-6.2/doc/HTML/IMMED-FORCED.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/IMMED-FORCED.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IMMED-FORCED.html  --  ACL2 Version 6.2</title></head>
+<head><title>IMMED-FORCED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IMMED-FORCED</h2>See <a href="SPLITTER.html">splitter</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/IMMEDIATE-FORCE-MODEP.html acl2-6.3/doc/HTML/IMMEDIATE-FORCE-MODEP.html
--- acl2-6.2/doc/HTML/IMMEDIATE-FORCE-MODEP.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/IMMEDIATE-FORCE-MODEP.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IMMEDIATE-FORCE-MODEP.html  --  ACL2 Version 6.2</title></head>
+<head><title>IMMEDIATE-FORCE-MODEP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IMMEDIATE-FORCE-MODEP</h2>when executable counterpart is <a href="ENABLE.html">enable</a>d,
 <code>   </code> <a href="FORCE.html">force</a>d hypotheses are attacked immediately
diff -Nru acl2-6.2/doc/HTML/IMPLIES.html acl2-6.3/doc/HTML/IMPLIES.html
--- acl2-6.2/doc/HTML/IMPLIES.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/IMPLIES.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IMPLIES.html  --  ACL2 Version 6.2</title></head>
+<head><title>IMPLIES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>IMPLIES</h3>logical implication
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/IMPROPER-CONSP.html acl2-6.3/doc/HTML/IMPROPER-CONSP.html
--- acl2-6.2/doc/HTML/IMPROPER-CONSP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/IMPROPER-CONSP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IMPROPER-CONSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>IMPROPER-CONSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>IMPROPER-CONSP</h3>recognizer for improper (non-null-terminated) non-empty lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/IN-ARITHMETIC-THEORY.html acl2-6.3/doc/HTML/IN-ARITHMETIC-THEORY.html
--- acl2-6.2/doc/HTML/IN-ARITHMETIC-THEORY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/IN-ARITHMETIC-THEORY.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IN-ARITHMETIC-THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>IN-ARITHMETIC-THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IN-ARITHMETIC-THEORY</h2>designate theory for some rewriting done for non-linear arithmetic
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/IN-PACKAGE.html acl2-6.3/doc/HTML/IN-PACKAGE.html
--- acl2-6.2/doc/HTML/IN-PACKAGE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/IN-PACKAGE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IN-PACKAGE.html  --  ACL2 Version 6.2</title></head>
+<head><title>IN-PACKAGE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IN-PACKAGE</h2>select current package
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/IN-TAU-INTERVALP.html acl2-6.3/doc/HTML/IN-TAU-INTERVALP.html
--- acl2-6.2/doc/HTML/IN-TAU-INTERVALP.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/IN-TAU-INTERVALP.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IN-TAU-INTERVALP.html  --  ACL2 Version 6.2</title></head>
+<head><title>IN-TAU-INTERVALP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>IN-TAU-INTERVALP</h3>Boolean membership in a tau interval
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/IN-THEORY.html acl2-6.3/doc/HTML/IN-THEORY.html
--- acl2-6.2/doc/HTML/IN-THEORY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/IN-THEORY.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IN-THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>IN-THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IN-THEORY</h2>designate ``current'' theory (enabling its rules)
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/INCLUDE-BOOK.html acl2-6.3/doc/HTML/INCLUDE-BOOK.html
--- acl2-6.2/doc/HTML/INCLUDE-BOOK.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/INCLUDE-BOOK.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INCLUDE-BOOK.html  --  ACL2 Version 6.2</title></head>
+<head><title>INCLUDE-BOOK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INCLUDE-BOOK</h2>load the <a href="EVENTS.html">events</a> in a file
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -120,11 +120,10 @@
 fundamental problem is one of file system security.
 See <a href="CERTIFICATE.html">certificate</a> for a discussion of the security issues.</p><p>At the beginning of execution of an <code>include-book</code> form, even before
 executing <a href="PORTCULLIS.html">portcullis</a> <a href="COMMAND.html">command</a>s, the value of
-<code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code> is restored to the value it had at startup, except
-that the value of key <code>:inhibit-warnings</code> is preserved.  After execution of
-an <code>include-book</code> form, the value of <code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code> is restored
-to what it was immediately before that <code>include-book</code> form was executed.
-See <a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a>.</p><p><b>Books Directory.</b>  We refer to the ``books directory'' of an executable
+<code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code> is restored to the value it had at startup.  After
+execution of an <code>include-book</code> form, the value of <code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code>
+is restored to what it was immediately before that <code>include-book</code> form was
+executed.  See <a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a>.</p><p><b>Books Directory.</b>  We refer to the ``books directory'' of an executable
 image as the full pathname string of the directory associated with
 <code>include-book</code> keyword option <code>:dir :system</code> for that image.  By default,
 it is the <code>books/</code> subdirectory of the directory where the sources reside
diff -Nru acl2-6.2/doc/HTML/INCOMPATIBLE.html acl2-6.3/doc/HTML/INCOMPATIBLE.html
--- acl2-6.2/doc/HTML/INCOMPATIBLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/INCOMPATIBLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INCOMPATIBLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>INCOMPATIBLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INCOMPATIBLE</h2>declaring that two rules should not both be <a href="ENABLE.html">enable</a>d
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/INDUCT.html acl2-6.3/doc/HTML/INDUCT.html
--- acl2-6.2/doc/HTML/INDUCT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/INDUCT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INDUCT.html  --  ACL2 Version 6.2</title></head>
+<head><title>INDUCT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INDUCT</h2>hints keyword <code>:INDUCT</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/INDUCTION.html acl2-6.3/doc/HTML/INDUCTION.html
--- acl2-6.2/doc/HTML/INDUCTION.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/INDUCTION.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INDUCTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>INDUCTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INDUCTION</h2>make a rule that suggests a certain induction
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
@@ -8,58 +8,55 @@
 
 <pre>
 Example:
-(:induction :corollary t  ; the theorem proved is irrelevant!
-            :pattern (* 1/2 i)
-            :condition (and (integerp i) (&gt;= i 0))
-            :scheme (recursion-by-sub2 i))
+(defthm recursion-by-sub2-induction-rule
+  t
+  :rule-classes ((:induction :pattern (* 1/2 i)
+                             :condition (and (integerp i) (&gt;= i 0))
+                             :scheme (recursion-by-sub2 i))))
 </pre>
 
 </p>
 <p>In ACL2, as in Nqthm, the functions in a conjecture ``suggest'' the
-inductions considered by the system.  Because every recursive
-function must be admitted with a justification in terms of a measure
-that decreases in a well-founded way on a given set of
-``controlling'' arguments, every recursive function suggests a dual
-induction scheme that ``unwinds'' the function from a given
-application.</p><p>For example, since <code><a href="APPEND.html">append</a></code> (actually <code><a href="BINARY-APPEND.html">binary-append</a></code>, but we'll ignore
-the distinction here) decomposes its first argument by successive
+inductions considered by the system.  Because every recursive function must
+be admitted with a justification in terms of a measure that decreases in a
+well-founded way on a given set of ``controlling'' arguments, every recursive
+function suggests a dual induction scheme that ``unwinds'' the function from
+a given application.</p><p>For example, since <code><a href="APPEND.html">append</a></code> (actually <code><a href="BINARY-APPEND.html">binary-append</a></code>, but we'll
+ignore the distinction here) decomposes its first argument by successive
 <code><a href="CDR.html">cdr</a></code>s as long as it is a non-<code>nil</code> true list, the induction scheme
 suggested by <code>(append x y)</code> has a base case supposing <code>x</code> to be either
-not a true list or to be <code>nil</code> and then has an induction step in which
-the induction hypothesis is obtained by replacing <code>x</code> by <code>(cdr x)</code>.
-This substitution decreases the same measure used to justify the
-definition of <code><a href="APPEND.html">append</a></code>.  Observe that an induction scheme is suggested
-by a recursive function application only if the controlling actuals
-are distinct variables, a condition that is sufficient to ensure
-that the ``substitution'' used to create the induction hypothesis is
-indeed a substitution and that it drives down a certain measure.  In
-particular, <code>(append (foo x) y)</code> does not suggest an induction
-unwinding <code><a href="APPEND.html">append</a></code> because the induction scheme suggested by
-<code>(append x y)</code> requires that we substitute <code>(cdr x)</code> for <code>x</code> and
-we cannot do that if <code>x</code> is not a variable symbol.</p><p>Once ACL2 has collected together all the suggested induction schemes
-it massages them in various ways, combining some to simultaneously
-unwind certain cliques of functions and vetoing others because they
-``flaw'' others.  We do not further discuss the induction heuristics
-here; the interested reader should see Chapter XIV of A
-Computational Logic (Boyer and Moore, Academic Press, 1979) which
-represents a fairly complete description of the induction heuristics
-of ACL2.</p><p>However, unlike Nqthm, ACL2 provides a means by which the user can
-elaborate the rules under which function applications suggest
-induction schemes.  Such rules are called <code>:induction</code> rules.  The
-definitional principle automatically creates an <code>:induction</code> rule,
-named <code>(:induction fn)</code>, for each admitted recursive function, <code>fn</code>.  It
-is this rule that links applications of <code>fn</code> to the induction scheme
-it suggests.  Disabling <code>(:induction fn)</code> will prevent <code>fn</code> from
-suggesting the induction scheme derived from its recursive
-definition.  It is possible for the user to create additional
-<code>:induction</code> rules by using the <code>:induction</code> rule class in <code><a href="DEFTHM.html">defthm</a></code>.</p><p>Technically we are ``overloading'' <code><a href="DEFTHM.html">defthm</a></code> by using it in the
-creation of <code>:induction</code> rules because no theorem need be proved to
-set up the heuristic link represented by an <code>:induction</code> rule.
-However, since <code><a href="DEFTHM.html">defthm</a></code> is generally used to create rules and
-rule-class objects are generally used to specify the exact form of
-each rule, we maintain that convention and introduce the notion of
-an <code>:induction</code> rule.  An <code>:induction</code> rule can be created from any
-lemma whatsoever.
+not a true list or to be <code>nil</code> and then has an induction step in which the
+induction hypothesis is obtained by replacing <code>x</code> by <code>(cdr x)</code>.  This
+substitution decreases the same measure used to justify the definition of
+<code><a href="APPEND.html">append</a></code>.  Observe that an induction scheme is suggested by a recursive
+function application only if the controlling actuals are distinct variables,
+a condition that is sufficient to ensure that the ``substitution'' used to
+create the induction hypothesis is indeed a substitution and that it drives
+down a certain measure.  In particular, <code>(append (foo x) y)</code> does not
+suggest an induction unwinding <code><a href="APPEND.html">append</a></code> because the induction scheme
+suggested by <code>(append x y)</code> requires that we substitute <code>(cdr x)</code> for
+<code>x</code> and we cannot do that if <code>x</code> is not a variable symbol.</p><p>Once ACL2 has collected together all the suggested induction schemes it
+massages them in various ways, combining some to simultaneously unwind
+certain cliques of functions and vetoing others because they ``flaw'' others.
+We do not further discuss the induction heuristics here; the interested
+reader should see Chapter XIV of A Computational Logic (Boyer and Moore,
+Academic Press, 1979) which represents a fairly complete description of the
+induction heuristics of ACL2.</p><p>However, unlike Nqthm, ACL2 provides a means by which the user can elaborate
+the rules under which function applications suggest induction schemes.  Such
+rules are called <code>:induction</code> rules.  The definitional principle
+automatically creates an <code>:induction</code> rule, named <code>(:induction fn)</code>, for
+each admitted recursive function, <code>fn</code>.  It is this rule that links
+applications of <code>fn</code> to the induction scheme it suggests.  Disabling
+<code>(:induction fn)</code> will prevent <code>fn</code> from suggesting the induction scheme
+derived from its recursive definition.  It is possible for the user to create
+additional <code>:induction</code> rules by using the <code>:induction</code> rule class in
+<code><a href="DEFTHM.html">defthm</a></code>.</p><p>Technically we are ``overloading'' <code><a href="DEFTHM.html">defthm</a></code> by using it in the creation
+of <code>:induction</code> rules because no theorem need be proved to set up the
+heuristic link represented by an <code>:induction</code> rule.  However, since
+<code><a href="DEFTHM.html">defthm</a></code> is generally used to create rules and rule-class objects are
+generally used to specify the exact form of each rule, we maintain that
+convention and introduce the notion of an <code>:induction</code> rule.  An
+<code>:induction</code> rule can be created from any lemma whatsoever.
 
 <pre>
 General Form of an :induction Lemma or Corollary:
@@ -71,23 +68,23 @@
             :scheme scheme-term)
 </pre>
 
-where <code>pat-term</code>, <code>cond-term</code>, and <code>scheme-term</code> are all terms, <code>pat-term</code>
-is the application of a function symbol, <code>fn</code>, <code>scheme-term</code> is the
-application of a function symbol, <code>rec-fn</code>, that suggests an
+where <code>pat-term</code>, <code>cond-term</code>, and <code>scheme-term</code> are all terms,
+<code>pat-term</code> is the application of a function symbol, <code>fn</code>, <code>scheme-term</code>
+is the application of a function symbol, <code>rec-fn</code>, that suggests an
 induction, and, finally, every free variable of <code>cond-term</code> and
 <code>scheme-term</code> is a free variable of <code>pat-term</code>.  We actually check that
 <code>rec-fn</code> is either recursively defined -- so that it suggests the
 induction that is intrinsic to its recursion -- or else that another
 <code>:induction</code> rule has been proved linking a call of <code>rec-fn</code> as the
-<code>:pattern</code> to some scheme.</p><p>The induction rule created is used as follows.  When an instance of
-the <code>:pattern</code> term occurs in a conjecture to be proved by induction
-and the corresponding instance of the <code>:condition</code> term is known to be
+<code>:pattern</code> to some scheme.</p><p>The induction rule created is used as follows.  When an instance of the
+<code>:pattern</code> term occurs in a conjecture to be proved by induction and the
+corresponding instance of the <code>:condition</code> term is known to be
 non-<code>nil</code> (by type reasoning alone), the corresponding instance of the
-<code>:scheme</code> term is created and the rule ``suggests'' the induction, if
-any, suggested by that term.  (Analysis of that term may further involve
-induction rules, though the applied rule is removed from consideration during
-that further analysis, in order to avoid looping.)  If <code>rec-fn</code> is
-recursive, then the suggestion is the one that unwinds that recursion.</p><p>Consider, for example, the example given above,
+<code>:scheme</code> term is created and the rule ``suggests'' the induction, if any,
+suggested by that term.  (Analysis of that term may further involve induction
+rules, though the applied rule is removed from consideration during that
+further analysis, in order to avoid looping.)  If <code>rec-fn</code> is recursive,
+then the suggestion is the one that unwinds that recursion.</p><p>Consider, for example, the example given above,
 
 <pre>
 (:induction :pattern (* 1/2 i)
@@ -106,11 +103,11 @@
       t))
 </pre>
 
-Observe that this function recursively decomposes its integer
-argument by subtracting <code>2</code> from it repeatedly and stops when the
-argument is <code>1</code> or less.  The value of the function is irrelevant; it
-is its induction scheme that concerns us.  The induction scheme
-suggested by <code>(recursion-by-sub2 i)</code> is
+Observe that this function recursively decomposes its integer argument by
+subtracting <code>2</code> from it repeatedly and stops when the argument is <code>1</code> or
+less.  The value of the function is irrelevant; it is its induction scheme
+that concerns us.  The induction scheme suggested by
+<code>(recursion-by-sub2 i)</code> is
 
 <pre>
 (and (implies (not (and (integerp i) (&lt; 1 i)))   ; base case
@@ -120,36 +117,34 @@
               (:p i)))
 </pre>
 
-We can think of the base case as covering two situations.  The
-first is when <code>i</code> is not an integer.  The second is when the integer <code>i</code>
-is <code>0</code> or <code>1</code>.  In the base case we must prove <code>(:p i)</code> without further
-help.  The induction step deals with those integer <code>i</code> greater than <code>1</code>,
-and inductively assumes the conjecture for <code>i-2</code> while proving it for
-<code>i</code>.  Let us call this scheme ``induction on <code>i</code> by twos.''</p><p>Suppose the above <code>:induction</code> rule has been added.  Then an
-occurrence of, say, <code>(* 1/2 k)</code> in a conjecture to be proved by
-induction would suggest, via this rule, an induction on <code>k</code> by twos,
-provided <code>k</code> was known to be a nonnegative integer.  This is because
-the induction rule's <code>:pattern</code> is matched in the conjecture, its
-<code>:condition</code> is satisfied, and the <code>:scheme</code> suggested by the rule is
-that derived from <code>(recursion-by-sub2 k)</code>, which is induction on <code>k</code> by
-twos.  Similarly, the term <code>(* 1/2 (length l))</code> would suggest no
-induction via this rule, even though the rule ``fires'' because it
-creates the <code>:scheme</code> <code>(recursion-by-sub2 (length l))</code> which suggests no
-inductions unwinding <code>recursion-by-sub2</code> (since the controlling
-argument of <code>recursion-by-sub2</code> in this <code>:scheme</code> is not a variable
-symbol).</p><p>Continuing this example one step further illustrates the utility of
+We can think of the base case as covering two situations.  The first is when
+<code>i</code> is not an integer.  The second is when the integer <code>i</code> is <code>0</code> or
+<code>1</code>.  In the base case we must prove <code>(:p i)</code> without further help.  The
+induction step deals with those integer <code>i</code> greater than <code>1</code>, and
+inductively assumes the conjecture for <code>i-2</code> while proving it for <code>i</code>.
+Let us call this scheme ``induction on <code>i</code> by twos.''</p><p>Suppose the above <code>:induction</code> rule has been added.  Then an occurrence of,
+say, <code>(* 1/2 k)</code> in a conjecture to be proved by induction would suggest,
+via this rule, an induction on <code>k</code> by twos, provided <code>k</code> was known to be
+a nonnegative integer.  This is because the induction rule's <code>:pattern</code> is
+matched in the conjecture, its <code>:condition</code> is satisfied, and the
+<code>:scheme</code> suggested by the rule is that derived from
+<code>(recursion-by-sub2 k)</code>, which is induction on <code>k</code> by twos.  Similarly,
+the term <code>(* 1/2 (length l))</code> would suggest no induction via this rule,
+even though the rule ``fires'' because it creates the <code>:scheme</code>
+<code>(recursion-by-sub2 (length l))</code> which suggests no inductions unwinding
+<code>recursion-by-sub2</code> (since the controlling argument of
+<code>recursion-by-sub2</code> in this <code>:scheme</code> is not a variable symbol).</p><p>Continuing this example one step further illustrates the utility of
 <code>:induction</code> rules.  We could define the function <code>recursion-by-cddr</code>
-that suggests the induction scheme decomposing its <code><a href="CONSP.html">consp</a></code> argument
-two <code><a href="CDR.html">cdr</a></code>s at a time.  We could then add the <code>:induction</code> rule linking
+that suggests the induction scheme decomposing its <code><a href="CONSP.html">consp</a></code> argument two
+<code><a href="CDR.html">cdr</a></code>s at a time.  We could then add the <code>:induction</code> rule linking
 <code>(* 1/2 (length x))</code> to <code>(recursion-by-cddr x)</code> and arrange for
-<code>(* 1/2 (length l))</code> to suggest induction on <code>l</code> by <code><a href="CDDR.html">cddr</a></code>.</p><p>Observe that <code>:induction</code> rules require no proofs to be done.  Such a
-rule is merely a heuristic link between the <code>:pattern</code> term, which may
-occur in conjectures to be proved by induction, and the <code>:scheme</code>
-term, from which an induction scheme may be derived.  Hence, when an
-<code>:induction</code> rule-class is specified in a <code><a href="DEFTHM.html">defthm</a></code> event, the theorem
-proved is irrelevant.  The easiest theorem to prove is, of course,
-<code>t</code>.  Thus, we suggest that when an <code>:induction</code> rule is to be created,
-the following form be used:
+<code>(* 1/2 (length l))</code> to suggest induction on <code>l</code> by <code><a href="CDDR.html">cddr</a></code>.</p><p>Observe that <code>:induction</code> rules require no proofs to be done.  Such a rule
+is merely a heuristic link between the <code>:pattern</code> term, which may occur in
+conjectures to be proved by induction, and the <code>:scheme</code> term, from which
+an induction scheme may be derived.  Hence, when an <code>:induction</code> rule-class
+is specified in a <code><a href="DEFTHM.html">defthm</a></code> event, the theorem proved is irrelevant.  The
+easiest theorem to prove is, of course, <code>t</code>.  Thus, we suggest that when an
+<code>:induction</code> rule is to be created, the following form be used:
 
 <pre>
 (defthm name T
@@ -158,8 +153,8 @@
                              :scheme scheme-term)))
 </pre>
 
-The name of the rule created is <code>(:induction name)</code>.  When that rune
-is disabled the heuristic link between <code>pat-term</code> and <code>scheme-term</code> is
+The name of the rule created is <code>(:induction name)</code>.  When that rune is
+disabled the heuristic link between <code>pat-term</code> and <code>scheme-term</code> is
 broken.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
diff -Nru acl2-6.2/doc/HTML/INITIALIZE-EVENT-USER.html acl2-6.3/doc/HTML/INITIALIZE-EVENT-USER.html
--- acl2-6.2/doc/HTML/INITIALIZE-EVENT-USER.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/INITIALIZE-EVENT-USER.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INITIALIZE-EVENT-USER.html  --  ACL2 Version 6.2</title></head>
+<head><title>INITIALIZE-EVENT-USER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INITIALIZE-EVENT-USER</h2>user-supplied code to initiate <a href="EVENTS.html">events</a>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/INSTRUCTIONS.html acl2-6.3/doc/HTML/INSTRUCTIONS.html
--- acl2-6.2/doc/HTML/INSTRUCTIONS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/INSTRUCTIONS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INSTRUCTIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>INSTRUCTIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INSTRUCTIONS</h2>instructions to the proof checker
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
@@ -38,11 +38,11 @@
 instructions may occur inside hints.</p><p>ACL2 supports <code>:instructions</code> as a hints keyword.  The following example
 forms the basis for our running example.  This example does not actually need
 hints, but imagine that the inductive step -- which is "Subgoal *1/2"
--- was proving difficult.  You could submit that goal to <code><a href="VERIFY.html">verify</a></code>, do
-an interactive proof, submit <code>(exit t)</code> to obtain the list of
-<code>:instructions</code> (answering with `N' at the prompt, to complete the exit),
-and then paste in those instructions.  When you submit the result event, you
-might see the following.  Below we'll explain the hint processing.
+-- was difficult.  You could submit that goal to <code><a href="VERIFY.html">verify</a></code>, do an
+interactive proof, submit <code>(exit t)</code> to obtain the list of
+<code>:instructions</code>, and then paste in those instructions.  When you submit the
+resulting event, you might see the following.  Below we'll explain the hint
+processing.
 
 <pre>
 ACL2 !&gt;(thm (equal (append (append x y) z)
@@ -166,13 +166,14 @@
 in the above output.  Normally one needs a trust tag (see <a href="DEFTTAG.html">defttag</a>) to
 install a trusted clause-processor, but that is not the case for the built-in
 clause-processor, <code>proof-checker-cl-proc</code>.  Finally, we note that
-<code>:instructions</code> <a href="HINTS.html">hints</a> are ``spliced'' in: the appropriate
-<code>:</code><code><a href="CLAUSE-PROCESSOR.html">clause-processor</a></code> hint replaces the <code>:instructions</code> hint, and the
-other hints remain intact.  It may seems surprising that one can thus, for
-example, use <code>:instructions</code> and <code>:in-theory</code> together; but although the
-<code>:in-theory</code> hint will have no effect on execution of the <code>:instructions</code>
-(see first bullet above), the <code>:in-theory</code> hint will apply in the usual
-manner to any child goes (see <a href="HINTS-AND-THE-WATERFALL.html">hints-and-the-waterfall</a>).  End of Remark.</p><p>Now consider the case that the supplied instructions do not prove the goal.
+<code>:instructions</code> <a href="HINTS.html">hints</a> are ``spliced'' into the hints as follows: the
+appropriate <code>:</code><code><a href="CLAUSE-PROCESSOR.html">clause-processor</a></code> hint replaces the <code>:instructions</code>
+hint, and the other hints remain intact.  It may seems surprising that one
+can thus, for example, use <code>:instructions</code> and <code>:in-theory</code> together; but
+although the <code>:in-theory</code> hint will have no effect on execution of the
+<code>:instructions</code> (see first bullet above), the <code>:in-theory</code> hint will
+apply in the usual manner to any child goals (see <a href="HINTS-AND-THE-WATERFALL.html">hints-and-the-waterfall</a>).
+End of Remark.</p><p>Now consider the case that the supplied instructions do not prove the goal.
 That is, suppose that the execution of those instructions results in a
 non-empty goal stack.  In that case, the resulting goals become children of
 the input goals.  The following edited log provides an illustration using a
@@ -316,74 +317,18 @@
                         (equal (reverse (reverse x)) x)))
 -&gt;: bash
 ***** Now entering the theorem prover *****
-
-[Note:  A hint was supplied for our processing of the goal above.
-Thanks!]
-
-This simplifies, using the :definition REVERSE and the :type-prescription
-rule REVAPPEND, to
-
 Goal'
-(IMPLIES (TRUE-LISTP X)
-         (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-                X)).
-
-But we have been asked to pretend that this goal is subsumed by the
-yet-to-be-proved |PROOF-CHECKER Goal'|.
-
-Q.E.D.
-
-
-Creating one new goal:  (MAIN . 1).
-
-The proof of the current goal, MAIN, has been completed.  However,
-the following subgoals remain to be proved:
-  (MAIN . 1).
-Now proving (MAIN . 1).
--&gt;: th
-*** Top-level hypotheses:
-1. (TRUE-LISTP X)
-
-The current subterm is:
-(EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-       X)
--&gt;: 1
--&gt;: sr ; show-rewrites
-
-1. REVAPPEND-REVAPPEND (disabled)
-  New term: (REVAPPEND NIL (APPEND X NIL))
-  Hypotheses: &lt;none&gt;
-  Equiv: EQUAL
 
-2. REVAPPEND
-  New term: (AND (CONSP (REVAPPEND X NIL))
-                 (REVAPPEND (CDR (REVAPPEND X NIL))
-                            (LIST (CAR (REVAPPEND X NIL)))))
-  Hypotheses: &lt;none&gt;
-  Equiv: EQUAL
--&gt;: (r 1) ; rewrite with rule #1 above
-Rewriting with REVAPPEND-REVAPPEND.
--&gt;: exit
-Exiting....
- NIL
-ACL2 !&gt;(verify (implies (true-listp x)
-                        (equal (reverse (reverse x)) x)))
--&gt;: bash
-***** Now entering the theorem prover *****
-
-[Note:  A hint was supplied for our processing of the goal above.
-Thanks!]
-
-This simplifies, using the :definition REVERSE and the :type-prescription
-rule REVAPPEND, to
+([ A key checkpoint:
 
 Goal'
 (IMPLIES (TRUE-LISTP X)
          (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-                X)).
+                X))
 
-But we have been asked to pretend that this goal is subsumed by the
-yet-to-be-proved |PROOF-CHECKER Goal'|.
+Goal' is subsumed by a goal yet to be proved.
+
+])
 
 Q.E.D.
 
@@ -394,17 +339,17 @@
 the following subgoals remain to be proved:
   (MAIN . 1).
 Now proving (MAIN . 1).
--&gt;: th
+-&gt;: th ; show current goal ("th" for "theorem")
 *** Top-level hypotheses:
 1. (TRUE-LISTP X)
 
 The current subterm is:
 (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
        X)
--&gt;: p
+-&gt;: p ; show current subterm only
 (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
        X)
--&gt;: 1
+-&gt;: 1 ; dive to first argument
 -&gt;: p
 (REVAPPEND (REVAPPEND X NIL) NIL)
 -&gt;: sr ; show-rewrites
@@ -424,30 +369,23 @@
 Rewriting with REVAPPEND-REVAPPEND.
 -&gt;: p
 (REVAPPEND NIL (APPEND X NIL))
--&gt;: top
+-&gt;: top ; move to the top of the conclusion, making it the current subterm
+-&gt;: p
+(EQUAL (REVAPPEND NIL (APPEND X NIL)) X)
 -&gt;: prove ; finish the proof
 ***** Now entering the theorem prover *****
 
-But simplification reduces this to T, using the :definition REVAPPEND,
-the :executable-counterpart of CONSP, primitive type reasoning and
-the :rewrite rule APPEND-TO-NIL.
-
 Q.E.D.
 
 *!*!*!*!*!*!* All goals have been proved! *!*!*!*!*!*!*
 You may wish to exit.
--&gt;: (exit t) ; to get :instructions; could give name, or (exit t nil t)
+-&gt;: (exit t) ; the argument, t, causes :instructions to be printed
 (DEFTHM T
         (IMPLIES (TRUE-LISTP X)
                  (EQUAL (REVERSE (REVERSE X)) X))
         :INSTRUCTIONS (:BASH (:DV 1)
                              (:REWRITE REVAPPEND-REVAPPEND)
                              :TOP :PROVE))
-
-ACL2 Query (ACL2-PC::EXIT):
-Do you want to submit this event?  Possible replies are:
-Y (Yes), R (yes and Replay commands), N (No, but exit), A (Abort exiting).
-   (Y, R, N or A):  n
  NIL
 ACL2 !&gt;(thm
         (IMPLIES (TRUE-LISTP X)
@@ -457,18 +395,18 @@
                  (:BASH (:DV 1)
                         (:REWRITE REVAPPEND-REVAPPEND)
                         :TOP :PROVE))))
+Goal'
 
-[Note:  A hint was supplied for our processing of the goal above.
-Thanks!]
+Q.E.D.
 
-But the trusted :CLAUSE-PROCESSOR function PROOF-CHECKER-CL-PROC replaces
-this goal by T.
+Q.E.D.
 
 Q.E.D.
 
 Summary
 Form:  ( THM ...)
 Rules: NIL
+Hint-events: ((:CLAUSE-PROCESSOR PROOF-CHECKER-CL-PROC))
 Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 
 Proof succeeded.
diff -Nru acl2-6.2/doc/HTML/INT=.html acl2-6.3/doc/HTML/INT=.html
--- acl2-6.2/doc/HTML/INT=.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INT=.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INT=.html  --  ACL2 Version 6.2</title></head>
+<head><title>INT=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INT=</h3>test equality of two integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTEGER-LENGTH.html acl2-6.3/doc/HTML/INTEGER-LENGTH.html
--- acl2-6.2/doc/HTML/INTEGER-LENGTH.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTEGER-LENGTH.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTEGER-LENGTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTEGER-LENGTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTEGER-LENGTH</h3>number of bits in two's complement integer representation
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTEGER-LISTP.html acl2-6.3/doc/HTML/INTEGER-LISTP.html
--- acl2-6.2/doc/HTML/INTEGER-LISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTEGER-LISTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTEGER-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTEGER-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTEGER-LISTP</h3>recognizer for a true list of integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTEGERP.html acl2-6.3/doc/HTML/INTEGERP.html
--- acl2-6.2/doc/HTML/INTEGERP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTEGERP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTEGERP.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTEGERP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTEGERP</h3>recognizer for whole numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERESTING-APPLICATIONS.html acl2-6.3/doc/HTML/INTERESTING-APPLICATIONS.html
--- acl2-6.2/doc/HTML/INTERESTING-APPLICATIONS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERESTING-APPLICATIONS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERESTING-APPLICATIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERESTING-APPLICATIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INTERESTING-APPLICATIONS</h2>some industrial examples of ACL2 use
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/INTERN$.html acl2-6.3/doc/HTML/INTERN$.html
--- acl2-6.2/doc/HTML/INTERN$.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERN$.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERN$.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERN$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERN$</h3>create a new symbol in a given package
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERN-IN-PACKAGE-OF-SYMBOL.html acl2-6.3/doc/HTML/INTERN-IN-PACKAGE-OF-SYMBOL.html
--- acl2-6.2/doc/HTML/INTERN-IN-PACKAGE-OF-SYMBOL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERN-IN-PACKAGE-OF-SYMBOL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERN-IN-PACKAGE-OF-SYMBOL.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERN-IN-PACKAGE-OF-SYMBOL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERN-IN-PACKAGE-OF-SYMBOL</h3>create a symbol with a given name
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERN.html acl2-6.3/doc/HTML/INTERN.html
--- acl2-6.2/doc/HTML/INTERN.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERN.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERN.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERN</h3>create a new symbol in a given package
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERSECTION$.html acl2-6.3/doc/HTML/INTERSECTION$.html
--- acl2-6.2/doc/HTML/INTERSECTION$.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERSECTION$.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERSECTION$.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERSECTION$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERSECTION$</h3>elements of one list that are not elements of another
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERSECTION-EQ.html acl2-6.3/doc/HTML/INTERSECTION-EQ.html
--- acl2-6.2/doc/HTML/INTERSECTION-EQ.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERSECTION-EQ.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERSECTION-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERSECTION-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERSECTION-EQ</h3>See <a href="INTERSECTION$.html">intersection$</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERSECTION-EQUAL.html acl2-6.3/doc/HTML/INTERSECTION-EQUAL.html
--- acl2-6.2/doc/HTML/INTERSECTION-EQUAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERSECTION-EQUAL.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERSECTION-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERSECTION-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERSECTION-EQUAL</h3>See <a href="INTERSECTION$.html">intersection$</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERSECTION-THEORIES.html acl2-6.3/doc/HTML/INTERSECTION-THEORIES.html
--- acl2-6.2/doc/HTML/INTERSECTION-THEORIES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERSECTION-THEORIES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERSECTION-THEORIES.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERSECTION-THEORIES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INTERSECTION-THEORIES</h2>intersect two <a href="THEORIES.html">theories</a>
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/INTERSECTP-EQ.html acl2-6.3/doc/HTML/INTERSECTP-EQ.html
--- acl2-6.2/doc/HTML/INTERSECTP-EQ.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERSECTP-EQ.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERSECTP-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERSECTP-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERSECTP-EQ</h3>See <a href="INTERSECTP.html">intersectp</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERSECTP-EQUAL.html acl2-6.3/doc/HTML/INTERSECTP-EQUAL.html
--- acl2-6.2/doc/HTML/INTERSECTP-EQUAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERSECTP-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERSECTP-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERSECTP-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERSECTP-EQUAL</h3>See <a href="INTERSECTP.html">intersectp</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTERSECTP.html acl2-6.3/doc/HTML/INTERSECTP.html
--- acl2-6.2/doc/HTML/INTERSECTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/INTERSECTP.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTERSECTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTERSECTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTERSECTP</h3>test whether two lists intersect
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS.html acl2-6.3/doc/HTML/INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS.html
--- acl2-6.2/doc/HTML/INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTION-TO-A-FEW-SYSTEM-CONSIDERATIONS</h3>the mechanics of interaction with the theorem prover
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTION-TO-HINTS.html acl2-6.3/doc/HTML/INTRODUCTION-TO-HINTS.html
--- acl2-6.2/doc/HTML/INTRODUCTION-TO-HINTS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTION-TO-HINTS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTION-TO-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTION-TO-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTION-TO-HINTS</h3>how to provide hints to the theorem prover
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTION-TO-KEY-CHECKPOINTS.html acl2-6.3/doc/HTML/INTRODUCTION-TO-KEY-CHECKPOINTS.html
--- acl2-6.2/doc/HTML/INTRODUCTION-TO-KEY-CHECKPOINTS.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTION-TO-KEY-CHECKPOINTS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTION-TO-KEY-CHECKPOINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTION-TO-KEY-CHECKPOINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTION-TO-KEY-CHECKPOINTS</h3>What questions to ask at key checkpoints
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTION-TO-REWRITE-RULES-PART-1.html acl2-6.3/doc/HTML/INTRODUCTION-TO-REWRITE-RULES-PART-1.html
--- acl2-6.2/doc/HTML/INTRODUCTION-TO-REWRITE-RULES-PART-1.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTION-TO-REWRITE-RULES-PART-1.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTION-TO-REWRITE-RULES-PART-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTION-TO-REWRITE-RULES-PART-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTION-TO-REWRITE-RULES-PART-1</h3>introduction to ACL2's notion of rewrite rules
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTION-TO-REWRITE-RULES-PART-2.html acl2-6.3/doc/HTML/INTRODUCTION-TO-REWRITE-RULES-PART-2.html
--- acl2-6.2/doc/HTML/INTRODUCTION-TO-REWRITE-RULES-PART-2.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTION-TO-REWRITE-RULES-PART-2.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTION-TO-REWRITE-RULES-PART-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTION-TO-REWRITE-RULES-PART-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTION-TO-REWRITE-RULES-PART-2</h3>how to arrange rewrite rules
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTION-TO-THE-DATABASE.html acl2-6.3/doc/HTML/INTRODUCTION-TO-THE-DATABASE.html
--- acl2-6.2/doc/HTML/INTRODUCTION-TO-THE-DATABASE.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTION-TO-THE-DATABASE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTION-TO-THE-DATABASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTION-TO-THE-DATABASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTION-TO-THE-DATABASE</h3>how to update the database
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTION-TO-THE-TAU-SYSTEM.html acl2-6.3/doc/HTML/INTRODUCTION-TO-THE-TAU-SYSTEM.html
--- acl2-6.2/doc/HTML/INTRODUCTION-TO-THE-TAU-SYSTEM.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTION-TO-THE-TAU-SYSTEM.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTION-TO-THE-TAU-SYSTEM.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTION-TO-THE-TAU-SYSTEM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>INTRODUCTION-TO-THE-TAU-SYSTEM</h1>a decision procedure for runtime types
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTION-TO-THE-THEOREM-PROVER.html acl2-6.3/doc/HTML/INTRODUCTION-TO-THE-THEOREM-PROVER.html
--- acl2-6.2/doc/HTML/INTRODUCTION-TO-THE-THEOREM-PROVER.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTION-TO-THE-THEOREM-PROVER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTION-TO-THE-THEOREM-PROVER.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTION-TO-THE-THEOREM-PROVER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INTRODUCTION-TO-THE-THEOREM-PROVER</h2>how the theorem prover works -- level 0
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGE-PROBLEM-1-ANSWER</h3>answer to challenge problem 1 for the new user of ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-1.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-1.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-1.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-1.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGE-PROBLEM-1</h3>challenge problem 1 for the new user of ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGE-PROBLEM-2-ANSWER</h3>answer to challenge problem 2 for the new user of ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-2.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-2.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-2.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-2.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGE-PROBLEM-2</h3>challenge problem 2 for the new user of ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGE-PROBLEM-3-ANSWER</h3>answer to challenge problem 3 for the new user of ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-3.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-3.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-3.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-3.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-3.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGE-PROBLEM-3</h3>challenge problem 3 for the new user of ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGE-PROBLEM-4-ANSWER</h3>answer to challenge problem 4 for the new user of ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-4.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-4.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-4.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGE-PROBLEM-4.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-4.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGE-PROBLEM-4.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGE-PROBLEM-4</h3>challenge problem 4 for the new user of ACL2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGES.html acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGES.html
--- acl2-6.2/doc/HTML/INTRODUCTORY-CHALLENGES.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/INTRODUCTORY-CHALLENGES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INTRODUCTORY-CHALLENGES.html  --  ACL2 Version 6.2</title></head>
+<head><title>INTRODUCTORY-CHALLENGES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>INTRODUCTORY-CHALLENGES</h3>challenge problems for the new ACL2 user
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/INVISIBLE-FNS-TABLE.html acl2-6.3/doc/HTML/INVISIBLE-FNS-TABLE.html
--- acl2-6.2/doc/HTML/INVISIBLE-FNS-TABLE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/INVISIBLE-FNS-TABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>INVISIBLE-FNS-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>INVISIBLE-FNS-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>INVISIBLE-FNS-TABLE</h2>functions that are invisible to the <a href="LOOP-STOPPER.html">loop-stopper</a> algorithm
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/IO.html acl2-6.3/doc/HTML/IO.html
--- acl2-6.2/doc/HTML/IO.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/IO.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IO.html  --  ACL2 Version 6.2</title></head>
+<head><title>IO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>IO</h1>input/output facilities in ACL2
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/IPRINT.html acl2-6.3/doc/HTML/IPRINT.html
--- acl2-6.2/doc/HTML/IPRINT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/IPRINT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IPRINT.html  --  ACL2 Version 6.2</title></head>
+<head><title>IPRINT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IPRINT</h2>See <a href="SET-IPRINT.html">set-iprint</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/IPRINTING.html acl2-6.3/doc/HTML/IPRINTING.html
--- acl2-6.2/doc/HTML/IPRINTING.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/IPRINTING.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>IPRINTING.html  --  ACL2 Version 6.2</title></head>
+<head><title>IPRINTING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IPRINTING</h2>See <a href="SET-IPRINT.html">set-iprint</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/IRRELEVANT-FORMALS.html acl2-6.3/doc/HTML/IRRELEVANT-FORMALS.html
--- acl2-6.2/doc/HTML/IRRELEVANT-FORMALS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/IRRELEVANT-FORMALS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,66 +1,62 @@
 <html>
-<head><title>IRRELEVANT-FORMALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>IRRELEVANT-FORMALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>IRRELEVANT-FORMALS</h2>formals that are used but only insignificantly
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
 </pre><p/>
 <p>
-Let <code>fn</code> be a function of <code>n</code> arguments.  Let <code>x</code> be the <code>i</code>th formal of <code>fn</code>.
-We say <code>x</code> is ``irrelevant in <code>fn</code>'' if <code>x</code> is not involved in either the
-<a href="GUARD.html">guard</a> or the measure for <code>fn</code>, <code>x</code> is used in the body, but the value of
+Let <code>fn</code> be a function of <code>n</code> arguments.  Let <code>x</code> be the <code>i</code>th formal
+of <code>fn</code>.  We say <code>x</code> is ``irrelevant in <code>fn</code>'' if <code>x</code> does not occur
+in either the <a href="GUARD.html">guard</a> or the measure for <code>fn</code>, and the value of
 <code>(fn a1...ai...an)</code> is independent of <code>ai</code>.
 </p>
-<p>The easiest way to define a function with an irrelevant formal is
-simply not to use the formal in the body of the
-function.  Such formals are said to be ``ignored'' by Common Lisp
-and a special declaration is provided to allow ignored formals.
-ACL2 makes a distinction between ignored and irrelevant formals.  Note
-however that if a variable is <code><a href="DECLARE.html">declare</a></code>d <code>ignore</code>d or <code>ignorable</code>,
-then it will not be reported as irrelevant.</p><p>An example of an irrelevant formal is <code>x</code> in the definition of <code>fact</code>
+<p>The easiest way to define a function with an irrelevant formal is simply not
+to use the formal in the body of the function.  Such formals are said to be
+``ignored'' by Common Lisp and a special declaration is provided to allow
+ignored formals.  ACL2 makes a distinction between ignored and irrelevant
+formals.  Note however that if a variable is <code><a href="DECLARE.html">declare</a></code>d <code>ignore</code>d or
+<code>ignorable</code>, then it will not be reported as irrelevant.</p><p>An example of an irrelevant formal is <code>x</code> in the definition of <code>fact</code>
 below.
 
 <pre>
 (defun fact (i x)
   (declare (xargs :guard (and (integerp i) (&lt;= 0 i))))
-  (if (zerop i) 0 (* i (fact (1- i) (cons i x))))).
+  (if (zerop i) 1 (* i (fact (1- i) (cons i x))))).
 </pre>
 
 Observe that <code>x</code> is only used in recursive calls of <code>fact</code>; it never
-``gets out'' into the result.  ACL2 can detect some irrelevant
-formals by a closure analysis on how the formals are used.  For
-example, if the <code>i</code>th formal is only used in the <code>i</code>th argument position
-of recursive calls, then it is irrelevant.  This is how <code>x</code> is used
-above.</p><p>It is possible for a formal to appear only in recursive calls but
-still be relevant.  For example, <code>x</code> is <strong>not</strong> irrelevant below, even
-though it only appears in the recursive call.
+``gets out'' into the result.  ACL2 can detect some irrelevant formals by a
+closure analysis on how the formals are used.  For example, if the <code>i</code>th
+formal is only used in the <code>i</code>th argument position of recursive calls, then
+it is irrelevant.  This is how <code>x</code> is used above.</p><p>It is possible for a formal to appear only in recursive calls but still be
+relevant.  For example, <code>x</code> is <strong>not</strong> irrelevant below, even though it
+only appears in the recursive call.
 
 <pre>
 (defun fn (i x) (if (zerop i) 0 (fn x (1- i))))
 </pre>
 
-The key observation above is that while <code>x</code> only appears in a
-recursive call, it appears in an argument position, namely <code>i</code>'s, that
-is relevant.  (The function above can be admitted with a <code>:</code><code><a href="GUARD.html">guard</a></code>
-requiring both arguments to be nonnegative integers and the <code>:measure</code>
-<code>(+ i x)</code>.)</p><p>Establishing that a formal is irrelevant, in the sense defined
-above, can be an arbitrarily hard problem because it requires
-theorem proving.  For example, is <code>x</code> irrelevant below?
+The key observation above is that while <code>x</code> only appears in a recursive
+call, it appears in an argument position, namely <code>i</code>'s, that is
+relevant.  (The function above can be admitted with a <code>:measure</code> of
+<code>(+ (nfix i) (nfix x))</code>.)</p><p>Establishing that a formal is irrelevant, in the sense defined above, can be
+an arbitrarily hard problem because it requires theorem proving.  For
+example, is <code>x</code> irrelevant below?
 
 <pre>
 (defun test (i j k x) (if (p i j k) 0 x))
 </pre>
 
 Note that the value of <code>(test i j k x)</code> is independent of <code>x</code> -- thus
-making <code>x</code> irrelevant -- precisely if <code>(p i j k)</code> is a theorem.
-ACL2's syntactic analysis of a definition does not guarantee to
-notice all irrelevant formals.</p><p>We regard the presence of irrelevant formals as an indication that
-something is wrong with the definition.  We cause an error on such
-definitions and suggest that you recode the definition so as to
-eliminate the irrelevant formals.  If you must have an irrelevant
-formal, one way to ``trick'' ACL2 into accepting the definition,
-without slowing down the execution of your function, is to use the
-formal in an irrelevant way in the <a href="GUARD.html">guard</a>.  For example, to admit
-fact, above, with its irrelevant <code>x</code> one might use
+making <code>x</code> irrelevant -- precisely if <code>(p i j k)</code> is a theorem.  ACL2's
+syntactic analysis of a definition does not guarantee to notice all
+irrelevant formals.</p><p>We regard the presence of irrelevant formals as an indication that something
+is wrong with the definition.  We cause an error on such definitions and
+suggest that you recode the definition so as to eliminate the irrelevant
+formals.  If you must have an irrelevant formal, one way to ``trick'' ACL2
+into accepting the definition, without slowing down the execution of your
+function, is to use the formal in an irrelevant way in the <a href="GUARD.html">guard</a>.  For
+example, to admit fact, above, with its irrelevant <code>x</code> one might use
 
 <pre>
 (defun fact (i x)
@@ -68,8 +64,8 @@
   (if (zerop i) 0 (* i (fact (1- i) (cons i x)))))
 </pre>
 
-For those who really want to turn off this feature, we have
-provided a way to use the <code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code> for this purpose;
+For those who really want to turn off this feature, we have provided a way to
+use the <code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code> for this purpose;
 see <a href="SET-IRRELEVANT-FORMALS-OK.html">set-irrelevant-formals-ok</a>.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
diff -Nru acl2-6.2/doc/HTML/KEEP.html acl2-6.3/doc/HTML/KEEP.html
--- acl2-6.2/doc/HTML/KEEP.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/KEEP.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>KEEP.html  --  ACL2 Version 6.2</title></head>
+<head><title>KEEP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>KEEP</h2>how we know if <code><a href="INCLUDE-BOOK.html">include-book</a></code> read the correct files
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/KEYWORD-COMMANDS.html acl2-6.3/doc/HTML/KEYWORD-COMMANDS.html
--- acl2-6.2/doc/HTML/KEYWORD-COMMANDS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/KEYWORD-COMMANDS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>KEYWORD-COMMANDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>KEYWORD-COMMANDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>KEYWORD-COMMANDS</h2>how keyword commands are processed
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/KEYWORD-VALUE-LISTP.html acl2-6.3/doc/HTML/KEYWORD-VALUE-LISTP.html
--- acl2-6.2/doc/HTML/KEYWORD-VALUE-LISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/KEYWORD-VALUE-LISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>KEYWORD-VALUE-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>KEYWORD-VALUE-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>KEYWORD-VALUE-LISTP</h3>recognizer for true lists whose even-position elements are keywords
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/KEYWORD.html acl2-6.3/doc/HTML/KEYWORD.html
--- acl2-6.2/doc/HTML/KEYWORD.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/KEYWORD.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>KEYWORD.html  --  ACL2 Version 6.2</title></head>
+<head><title>KEYWORD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>KEYWORD</h2>See <a href="KEYWORDP.html">keywordp</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/KEYWORDP.html acl2-6.3/doc/HTML/KEYWORDP.html
--- acl2-6.2/doc/HTML/KEYWORDP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/KEYWORDP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>KEYWORDP.html  --  ACL2 Version 6.2</title></head>
+<head><title>KEYWORDP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>KEYWORDP</h3>recognizer for keywords
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/KWOTE-LST.html acl2-6.3/doc/HTML/KWOTE-LST.html
--- acl2-6.2/doc/HTML/KWOTE-LST.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/KWOTE-LST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>KWOTE-LST.html  --  ACL2 Version 6.2</title></head>
+<head><title>KWOTE-LST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>KWOTE-LST</h3>quote an arbitrary true list of objects
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/KWOTE.html acl2-6.3/doc/HTML/KWOTE.html
--- acl2-6.2/doc/HTML/KWOTE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/KWOTE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>KWOTE.html  --  ACL2 Version 6.2</title></head>
+<head><title>KWOTE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>KWOTE</h3>quote an arbitrary object
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LAMBDA.html acl2-6.3/doc/HTML/LAMBDA.html
--- acl2-6.2/doc/HTML/LAMBDA.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LAMBDA.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LAMBDA.html  --  ACL2 Version 6.2</title></head>
+<head><title>LAMBDA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LAMBDA</h2>See <a href="TERM.html">term</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LAST-PROVER-STEPS.html acl2-6.3/doc/HTML/LAST-PROVER-STEPS.html
--- acl2-6.2/doc/HTML/LAST-PROVER-STEPS.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/LAST-PROVER-STEPS.html	2013-09-30 17:39:29.000000000 +0000
@@ -0,0 +1,54 @@
+<html>
+<head><title>LAST-PROVER-STEPS.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>LAST-PROVER-STEPS</h2>the number of prover steps most recently taken
+<pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
+</pre><p/>
+<p>
+For discussions of prover step limits, See <a href="SET-PROVER-STEP-LIMIT.html">set-prover-step-limit</a> and
+see <a href="WITH-PROVER-STEP-LIMIT.html">with-prover-step-limit</a>.  The value of the form
+<code>(last-prover-steps state)</code> indicates the number of prover steps taken, in
+the sense described below, for the most recent context in which an event
+summary would normally be printed.  Note that the value of
+<code>(last-prover-steps state)</code> is updated for all <a href="EVENTS.html">events</a>, and for all
+other forms such as calls of <code><a href="THM.html">thm</a></code> or <code><a href="CERTIFY-BOOK.html">certify-book</a></code>, that would
+print a summary -- regardless of whether or not such output is inhibited
+(see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a> and see <a href="SET-INHIBITED-SUMMARY-TYPES.html">set-inhibited-summary-types</a>).  In
+particular, the value is updated (typically to <code>nil</code>) for <code><a href="TABLE.html">table</a></code>
+<a href="EVENTS.html">events</a>, even when no summary is printed; for example, the value is
+updated to <code>nil</code> for <code>table</code> events such as <code>(</code><code><a href="LOGIC.html">logic</a></code><code>)</code>,
+<code>(</code><code><a href="PROGRAM.html">program</a></code><code>)</code>, and even calls of <code><a href="SET-PROVER-STEP-LIMIT.html">set-prover-step-limit</a></code>.</p><p>The value of <code>(last-prover-steps state)</code> is determined as follows, based on
+the most recent summary context (as described above):
+</p>
+<blockquote><p></p><p><code>nil</code>, if no prover steps were taken; else,</p><p>the (positive) number of steps taken, if the number of steps did not exceed
+the starting limit; else,</p><p>the negative of the starting limit.
+</p></blockquote>
+<p>
+</p>
+<p>We conclude with a remark for advanced users who wish to invoke
+<code>last-prover-steps</code> in the development of utilities that track prover
+steps.  Suppose that you want to write a utility that takes some action based
+on the number of prover steps performed by the first <code>defun</code> event that is
+generated, among others, for example the number of prover steps taken to
+admit <code>f1</code> in the following example.
+
+<pre>
+(progn (defun f1 ...)
+       (defun f2 ...))
+</pre>
+
+A solution is to record the steps taken by the first <code><a href="DEFUN.html">defun</a></code> before
+executing subsequent events, as follows (see <a href="MAKE-EVENT.html">make-event</a>).
+
+<pre>
+(progn (defun f1 ...)
+       (make-event (pprogn (f-put-global 'my-step-count
+                                         (last-prover-steps state)
+                                         state)
+                           (value '(value-triple nil))))
+       (defun f2 ...))
+</pre>
+
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/LAST.html acl2-6.3/doc/HTML/LAST.html
--- acl2-6.2/doc/HTML/LAST.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LAST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LAST.html  --  ACL2 Version 6.2</title></head>
+<head><title>LAST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LAST</h3>the last <code><a href="CONS.html">cons</a></code> (not element) of a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LD-ERROR-ACTION.html acl2-6.3/doc/HTML/LD-ERROR-ACTION.html
--- acl2-6.2/doc/HTML/LD-ERROR-ACTION.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-ERROR-ACTION.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-ERROR-ACTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-ERROR-ACTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-ERROR-ACTION</h2>determines <code><a href="LD.html">ld</a></code>'s response to an error
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-ERROR-TRIPLES.html acl2-6.3/doc/HTML/LD-ERROR-TRIPLES.html
--- acl2-6.2/doc/HTML/LD-ERROR-TRIPLES.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-ERROR-TRIPLES.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-ERROR-TRIPLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-ERROR-TRIPLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-ERROR-TRIPLES</h2>determines whether a form caused an error during <code><a href="LD.html">ld</a></code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-EVISC-TUPLE.html acl2-6.3/doc/HTML/LD-EVISC-TUPLE.html
--- acl2-6.2/doc/HTML/LD-EVISC-TUPLE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-EVISC-TUPLE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-EVISC-TUPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-EVISC-TUPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-EVISC-TUPLE</h2>determines whether <code><a href="LD.html">ld</a></code> suppresses details when printing
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-KEYWORD-ALIASES.html acl2-6.3/doc/HTML/LD-KEYWORD-ALIASES.html
--- acl2-6.2/doc/HTML/LD-KEYWORD-ALIASES.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-KEYWORD-ALIASES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,44 +1,69 @@
 <html>
-<head><title>LD-KEYWORD-ALIASES.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-KEYWORD-ALIASES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h2>LD-KEYWORD-ALIASES</h2>allows the abbreviation of some keyword commands
-<pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
+<h2>LD-KEYWORD-ALIASES</h2>abbreviation of some keyword commands
+<pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
 </pre><p/>
 <p>
 
 <pre>
-Example:
+Examples:
 (set-ld-keyword-aliases '((:q 0 q-fn)
                           (:e 0 exit-acl2-macro))
                         state)
+(ld-keyword-aliases state) ; current value of the ld-keyword-aliases table
 </pre>
 
-<code>Ld-keyword-aliases</code> is an <code><a href="LD.html">ld</a></code> special (see <a href="LD.html">ld</a>).  The accessor
-is <code>(ld-keyword-aliases state)</code> and the updater is
-<code>(set-ld-keyword-aliases val state)</code>.  <code>Ld-keyword-aliases</code> must be an
-alist, each element of which is of the form <code>(:keyword n fn)</code>, where
-<code>:keyword</code> is a keyword, <code>n</code> is a nonnegative integer, and <code>fn</code> is a
-function symbol of arity <code>n</code>, a macro symbol, or a <code>lambda</code> expression
-of arity <code>n</code>.  When <code>keyword</code> is typed as an <code><a href="LD.html">ld</a></code> command, <code>n</code> more forms
-are read, <code>x1, ..., xn</code>, and the form <code>(fn 'x1 ... 'xn)</code> is then
-evaluated.  The initial value of <code>ld-keyword-aliases</code> is <code>nil</code>.</p><p>In the example above, <code>:</code><code><a href="Q.html">q</a></code> has been redefined to have the effect of
-executing <code>(q-fn)</code>, so for example if you define
+<code>Ld-keyword-aliases</code> is the name of a ACL2 table (see <a href="TABLE.html">table</a>) and also the
+name of a function of <code>state</code> that returns the value of this table.  That
+value must be an alist, each element of which is of the form
+<code>(:keyword n fn)</code>, where <code>:keyword</code> is a keyword, <code>n</code> is a nonnegative
+integer, and <code>fn</code> is a function symbol of arity <code>n</code>, a macro symbol, or a
+<code>lambda</code> expression of arity <code>n</code>.  When <code>keyword</code> is typed as an
+<code><a href="LD.html">ld</a></code> command, <code>n</code> more forms are read, <code>x1, ..., xn</code>, and the form
+<code>(fn 'x1 ... 'xn)</code> is then evaluated.  The initial value of the
+<code>ld-keyword-aliases</code> <a href="TABLE.html">table</a> is <code>nil</code>.</p><p>ACL2 provides functions to modify the <code>ld-keyword-aliases</code> table, as
+follows.
+</p>
+<blockquote><p></p><p><code>(Set-ld-keyword-aliases val state)</code>: sets the table to <code>val</code>, which must
+be a legal alist as described above.  This is an event that may go into a
+book (see <a href="EVENTS.html">events</a>), but its effect will be <a href="LOCAL.html">local</a> to that book.</p><p><code>Set-ld-keyword-aliases!</code> is the same as <code>set-ld-keyword-aliases</code>, except
+that its effect is not <a href="LOCAL.html">local</a>.  Indeed, the form
+<code>(set-ld-keyword-aliases val state)</code> is equivalent to the form
+<code>(local (set-ld-keyword-aliases! val state)</code>.</p><p><code>(Add-ld-keyword-alias key val state)</code>: modifies the table by binding the
+keyword <code>key</code> to <code>val</code>, which must be a legal value as described above.
+This is an event that may go into a book (see <a href="EVENTS.html">events</a>), but its effect will
+be <a href="LOCAL.html">local</a> to that book.</p><p><code>Add-ld-keyword-alias!</code> is the same as <code>add-ld-keyword-alias</code>, except
+that its effect is not <a href="LOCAL.html">local</a>.  Indeed, the form
+<code>(add-ld-keyword-alias key val state)</code> is equivalent to the form
+<code>(local (add-ld-keyword-alias! key val state)</code>.</p><p></p></blockquote>
+<p>
+Consider the first example above:
+
+<pre>
+(set-ld-keyword-aliases '((:q 0 q-fn)
+                          (:e 0 exit-acl2-macro))
+                        state)
+</pre>
+
+With this event, <code>:</code><code><a href="Q.html">q</a></code> is redefined to have the effect of executing
+<code>(q-fn)</code>, so for example if you have defined <code>q-fn</code> with
 
 <pre>
 (defmacro q-fn ()
   '(er soft 'q "You un-bound :q and now we have a soft error."))
 </pre>
 
-then <code>:</code><code><a href="Q.html">q</a></code> will cause an error, and if you define
+then <code>:</code><code><a href="Q.html">q</a></code> will cause an error, and if you have defined
 
 <pre>
 (defmacro exit-acl2-macro () '(exit-ld state))
 </pre>
 
 then <code>:e</code> will cause the effect (it so happens) that <code>:</code><code><a href="Q.html">q</a></code> normally
-has.  If you prefer <code>:e</code> to <code>:</code><code><a href="Q.html">q</a></code> for exiting the ACL2 loop, you might
-even want to put such definitions of <code>q-fn</code> and <code>exit-acl2-macro</code>
-together with the <code>set-ld-keyword-aliases</code> form above in your
+has.  If you prefer <code>:e</code> to <code>:</code><code><a href="Q.html">q</a></code> for exiting the ACL2 loop, you
+might even want to put such definitions of <code>q-fn</code> and <code>exit-acl2-macro</code>
+together with the <code>set-ld-keyword-aliases</code> form above into your
 <code>"acl2-customization.lsp"</code> file; see <a href="ACL2-CUSTOMIZATION.html">acl2-customization</a>.
 </p>
 <p>The general-purpose ACL2 read-eval-print loop, <code><a href="LD.html">ld</a></code>, reads forms from
@@ -46,10 +71,10 @@
 However, there are various flags that control <code><a href="LD.html">ld</a></code>'s behavior and
 <code>ld-keyword-aliases</code> is one of them.  <code>Ld-keyword-aliases</code> affects how
 keyword commands are parsed.  Generally speaking, <code><a href="LD.html">ld</a></code>'s command
-interpreter reads ``<code>:fn x1 ... xn</code>'' as ``<code>(fn 'x1 ... 'xn)</code>'' when <code>:fn</code>
-is a keyword and <code>fn</code> is the name of an <code>n</code>-ary function;
+interpreter reads ``<code>:fn x1 ... xn</code>'' as ``<code>(fn 'x1 ... 'xn)</code>'' when
+<code>:fn</code> is a keyword and <code>fn</code> is the name of an <code>n</code>-ary function;
 see <a href="KEYWORD-COMMANDS.html">keyword-commands</a>.  But this parse is overridden, as described above, for
-the keywords bound in <code>ld-keyword-aliases</code>.
+the keywords bound in the <code>ld-keyword-aliases</code> <a href="TABLE.html">table</a>.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
 </html>
diff -Nru acl2-6.2/doc/HTML/LD-MISSING-INPUT-OK.html acl2-6.3/doc/HTML/LD-MISSING-INPUT-OK.html
--- acl2-6.2/doc/HTML/LD-MISSING-INPUT-OK.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-MISSING-INPUT-OK.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-MISSING-INPUT-OK.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-MISSING-INPUT-OK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-MISSING-INPUT-OK</h2>determines which forms <code><a href="LD.html">ld</a></code> evaluates
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-POST-EVAL-PRINT.html acl2-6.3/doc/HTML/LD-POST-EVAL-PRINT.html
--- acl2-6.2/doc/HTML/LD-POST-EVAL-PRINT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-POST-EVAL-PRINT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-POST-EVAL-PRINT.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-POST-EVAL-PRINT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-POST-EVAL-PRINT</h2>determines whether and how <code><a href="LD.html">ld</a></code> prints the result of evaluation
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-PRE-EVAL-FILTER.html acl2-6.3/doc/HTML/LD-PRE-EVAL-FILTER.html
--- acl2-6.2/doc/HTML/LD-PRE-EVAL-FILTER.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-PRE-EVAL-FILTER.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-PRE-EVAL-FILTER.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-PRE-EVAL-FILTER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-PRE-EVAL-FILTER</h2>determines which forms <code><a href="LD.html">ld</a></code> evaluates
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-PRE-EVAL-PRINT.html acl2-6.3/doc/HTML/LD-PRE-EVAL-PRINT.html
--- acl2-6.2/doc/HTML/LD-PRE-EVAL-PRINT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-PRE-EVAL-PRINT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-PRE-EVAL-PRINT.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-PRE-EVAL-PRINT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-PRE-EVAL-PRINT</h2>determines whether <code><a href="LD.html">ld</a></code> prints the forms to be <code>eval</code>'d
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-PROMPT.html acl2-6.3/doc/HTML/LD-PROMPT.html
--- acl2-6.2/doc/HTML/LD-PROMPT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-PROMPT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-PROMPT.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-PROMPT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-PROMPT</h2>determines the <a href="PROMPT.html">prompt</a> printed by <code><a href="LD.html">ld</a></code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-QUERY-CONTROL-ALIST.html acl2-6.3/doc/HTML/LD-QUERY-CONTROL-ALIST.html
--- acl2-6.2/doc/HTML/LD-QUERY-CONTROL-ALIST.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-QUERY-CONTROL-ALIST.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-QUERY-CONTROL-ALIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-QUERY-CONTROL-ALIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-QUERY-CONTROL-ALIST</h2>how to default answers to queries
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-REDEFINITION-ACTION.html acl2-6.3/doc/HTML/LD-REDEFINITION-ACTION.html
--- acl2-6.2/doc/HTML/LD-REDEFINITION-ACTION.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-REDEFINITION-ACTION.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-REDEFINITION-ACTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-REDEFINITION-ACTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-REDEFINITION-ACTION</h2>to allow redefinition without undoing
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-SKIP-PROOFSP.html acl2-6.3/doc/HTML/LD-SKIP-PROOFSP.html
--- acl2-6.2/doc/HTML/LD-SKIP-PROOFSP.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-SKIP-PROOFSP.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-SKIP-PROOFSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-SKIP-PROOFSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-SKIP-PROOFSP</h2>how carefully ACL2 processes your <a href="COMMAND.html">command</a>s
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD-VERBOSE.html acl2-6.3/doc/HTML/LD-VERBOSE.html
--- acl2-6.2/doc/HTML/LD-VERBOSE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LD-VERBOSE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD-VERBOSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD-VERBOSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD-VERBOSE</h2>determines whether <code><a href="LD.html">ld</a></code> prints ``ACL2 Loading ...''
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LD.html acl2-6.3/doc/HTML/LD.html
--- acl2-6.2/doc/HTML/LD.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/LD.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LD.html  --  ACL2 Version 6.2</title></head>
+<head><title>LD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LD</h2>the ACL2 read-eval-print loop, file loader, and <a href="COMMAND.html">command</a> processor
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
@@ -26,7 +26,6 @@
                                  ;   (see <a href="LD-SKIP-PROOFSP.html">ld-skip-proofsp</a>)
     :ld-redefinition-action ...  ; nil or '(:a . :b)
     :ld-prompt          ...      ; nil, t, or some prompt printer fn
-    :ld-keyword-aliases ...      ; an alist pairing keywords to parse info
     :ld-missing-input-ok ...     ; nil, t, :warn, or warning message
     :ld-pre-eval-filter ...      ; :all, :query, or some new name
     :ld-pre-eval-print  ...      ; nil, t, or :never
diff -Nru acl2-6.2/doc/HTML/LEMMA-INSTANCE.html acl2-6.3/doc/HTML/LEMMA-INSTANCE.html
--- acl2-6.2/doc/HTML/LEMMA-INSTANCE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LEMMA-INSTANCE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LEMMA-INSTANCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>LEMMA-INSTANCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LEMMA-INSTANCE</h2>an object denoting an instance of a theorem
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LEN.html acl2-6.3/doc/HTML/LEN.html
--- acl2-6.2/doc/HTML/LEN.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LEN.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LEN.html  --  ACL2 Version 6.2</title></head>
+<head><title>LEN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LEN</h3>length of a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LENGTH.html acl2-6.3/doc/HTML/LENGTH.html
--- acl2-6.2/doc/HTML/LENGTH.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LENGTH.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LENGTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>LENGTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LENGTH</h3>length of a string or proper list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LET.html acl2-6.3/doc/HTML/LET.html
--- acl2-6.2/doc/HTML/LET.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LET.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LET.html  --  ACL2 Version 6.2</title></head>
+<head><title>LET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LET</h3>binding of lexically scoped (local) variables
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LET_star_.html acl2-6.3/doc/HTML/LET_star_.html
--- acl2-6.2/doc/HTML/LET_star_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LET_star_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LET_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>LET_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LET*</h3>binding of lexically scoped (local) variables
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LEXORDER.html acl2-6.3/doc/HTML/LEXORDER.html
--- acl2-6.2/doc/HTML/LEXORDER.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LEXORDER.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LEXORDER.html  --  ACL2 Version 6.2</title></head>
+<head><title>LEXORDER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LEXORDER</h3>total order on ACL2 objects
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LINEAR-ARITHMETIC.html acl2-6.3/doc/HTML/LINEAR-ARITHMETIC.html
--- acl2-6.2/doc/HTML/LINEAR-ARITHMETIC.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LINEAR-ARITHMETIC.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LINEAR-ARITHMETIC.html  --  ACL2 Version 6.2</title></head>
+<head><title>LINEAR-ARITHMETIC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LINEAR-ARITHMETIC</h2>A description of the linear arithmetic decision procedure
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LINEAR.html acl2-6.3/doc/HTML/LINEAR.html
--- acl2-6.2/doc/HTML/LINEAR.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/LINEAR.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,23 +1,22 @@
 <html>
-<head><title>LINEAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>LINEAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LINEAR</h2>make some arithmetic inequality rules
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and how they are
-used to build rules from formulas.  An example <code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula
-from which a <code>:linear</code> rule might be built is:
-
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
 <pre>
 Example:
-(implies (and (eqlablep e)           if inequality reasoning begins to
-              (true-listp x))        consider how (length (member a b))
-         (&lt;= (length (member e x))   compares to any other term, add to
-             (length x)))            set of known inequalities the fact
-                                     that it is no larger than (length b),
-                                     provided (eqlablep a) and (true-listp b)
-                                     rewrite to t
+(defthm length-member-leq-length       If inequality reasoning begins to
+  (implies (and (eqlablep e)           consider how (length (member a b))
+                (true-listp x))        compares to any other term, add to
+           (&lt;= (length (member e x))   the set of known inequalities the fact
+               (length x)))            that it is no larger than (length b),
+  :rule-classes :linear)               provided (eqlablep a) and
+                                       (true-listp b) rewrite to t.
 
 General Form:
 (and ...
diff -Nru acl2-6.2/doc/HTML/LIST.html acl2-6.3/doc/HTML/LIST.html
--- acl2-6.2/doc/HTML/LIST.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LIST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>LIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LIST</h3>build a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LISTP.html acl2-6.3/doc/HTML/LISTP.html
--- acl2-6.2/doc/HTML/LISTP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LISTP</h3>recognizer for (not necessarily proper) lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LIST_star_.html acl2-6.3/doc/HTML/LIST_star_.html
--- acl2-6.2/doc/HTML/LIST_star_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LIST_star_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LIST_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>LIST_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LIST*</h3>build a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOCAL-INCOMPATIBILITY.html acl2-6.3/doc/HTML/LOCAL-INCOMPATIBILITY.html
--- acl2-6.2/doc/HTML/LOCAL-INCOMPATIBILITY.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LOCAL-INCOMPATIBILITY.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOCAL-INCOMPATIBILITY.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOCAL-INCOMPATIBILITY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LOCAL-INCOMPATIBILITY</h2>when non-local <a href="EVENTS.html">events</a> won't replay in isolation
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LOCAL.html acl2-6.3/doc/HTML/LOCAL.html
--- acl2-6.2/doc/HTML/LOCAL.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/LOCAL.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOCAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOCAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LOCAL</h2>hiding an event in an encapsulation or book
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/LOGAND.html acl2-6.3/doc/HTML/LOGAND.html
--- acl2-6.2/doc/HTML/LOGAND.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGAND.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGAND.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGAND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGAND</h3>bitwise logical `and' of zero or more integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGANDC1.html acl2-6.3/doc/HTML/LOGANDC1.html
--- acl2-6.2/doc/HTML/LOGANDC1.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGANDC1.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGANDC1.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGANDC1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGANDC1</h3>bitwise logical `and' of two ints, complementing the first
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGANDC2.html acl2-6.3/doc/HTML/LOGANDC2.html
--- acl2-6.2/doc/HTML/LOGANDC2.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGANDC2.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGANDC2.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGANDC2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGANDC2</h3>bitwise logical `and' of two ints, complementing the second
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGBITP.html acl2-6.3/doc/HTML/LOGBITP.html
--- acl2-6.2/doc/HTML/LOGBITP.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGBITP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGBITP.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGBITP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGBITP</h3>the <code>i</code>th bit of an integer
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGCOUNT.html acl2-6.3/doc/HTML/LOGCOUNT.html
--- acl2-6.2/doc/HTML/LOGCOUNT.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGCOUNT.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGCOUNT.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGCOUNT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGCOUNT</h3>number of ``on'' bits in a two's complement number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGEQV.html acl2-6.3/doc/HTML/LOGEQV.html
--- acl2-6.2/doc/HTML/LOGEQV.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGEQV.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGEQV.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGEQV.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGEQV</h3>bitwise logical equivalence of zero or more integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-BASE-CASE</h3>a brief explanation of base cases
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EQUALS-FOR-EQUALS</h3>substitution of equals for equals
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-EVALUATION</h3>evaluation during proofs
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INDUCTIVE-PROOF</h3>a brief explanation of induction
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-INSTANCE</h3>a brief explanation of substitution instances
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-PROPOSITIONAL-CALCULUS</h3>a brief explanation of propositional calculus
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q1-ANSWER</h3>the inductive step of the <code>rev-rev</code> proof -- Answer to Question 1
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q2-ANSWER</h3>the inductive step of the <code>rev-rev</code> proof -- Answer to Question 2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-Q3-ANSWER</h3>the inductive step of the <code>rev-rev</code> proof -- Answer to Question 2
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING-REPEATEDLY</h3>further information on expanding definitions via rewriting
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED-REWRITING</h3>a brief explanation of rewriting from the logical perspective
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED.html acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED.html
--- acl2-6.2/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIC-KNOWLEDGE-TAKEN-FOR-GRANTED</h3>background knowledge in ACL2 logic for theorem prover tutorial
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/LOGIC.html acl2-6.3/doc/HTML/LOGIC.html
--- acl2-6.2/doc/HTML/LOGIC.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIC.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIC.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LOGIC</h2>to set the default <a href="DEFUN-MODE.html">defun-mode</a> to <code>:logic</code>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/LOGICAL-NAME.html acl2-6.3/doc/HTML/LOGICAL-NAME.html
--- acl2-6.2/doc/HTML/LOGICAL-NAME.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGICAL-NAME.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGICAL-NAME.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGICAL-NAME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LOGICAL-NAME</h2>a name created by a logical event
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LOGIOR.html acl2-6.3/doc/HTML/LOGIOR.html
--- acl2-6.2/doc/HTML/LOGIOR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGIOR.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGIOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGIOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGIOR</h3>bitwise logical inclusive or of zero or more integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGNAND.html acl2-6.3/doc/HTML/LOGNAND.html
--- acl2-6.2/doc/HTML/LOGNAND.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGNAND.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGNAND.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGNAND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGNAND</h3>bitwise logical `nand' of two integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGNOR.html acl2-6.3/doc/HTML/LOGNOR.html
--- acl2-6.2/doc/HTML/LOGNOR.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGNOR.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGNOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGNOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGNOR</h3>bitwise logical `nor' of two integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGNOT.html acl2-6.3/doc/HTML/LOGNOT.html
--- acl2-6.2/doc/HTML/LOGNOT.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGNOT.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGNOT.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGNOT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGNOT</h3>bitwise not of a two's complement number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGORC1.html acl2-6.3/doc/HTML/LOGORC1.html
--- acl2-6.2/doc/HTML/LOGORC1.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGORC1.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGORC1.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGORC1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGORC1</h3>bitwise logical inclusive or of two ints, complementing the first
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGORC2.html acl2-6.3/doc/HTML/LOGORC2.html
--- acl2-6.2/doc/HTML/LOGORC2.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGORC2.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGORC2.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGORC2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGORC2</h3>bitwise logical inclusive or of two ints, complementing the second
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGTEST.html acl2-6.3/doc/HTML/LOGTEST.html
--- acl2-6.2/doc/HTML/LOGTEST.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGTEST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGTEST.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGTEST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGTEST</h3>test if two integers share a `1' bit
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOGXOR.html acl2-6.3/doc/HTML/LOGXOR.html
--- acl2-6.2/doc/HTML/LOGXOR.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/LOGXOR.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOGXOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOGXOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOGXOR</h3>bitwise logical exclusive or of zero or more integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LOOP-STOPPER.html acl2-6.3/doc/HTML/LOOP-STOPPER.html
--- acl2-6.2/doc/HTML/LOOP-STOPPER.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LOOP-STOPPER.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOOP-STOPPER.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOOP-STOPPER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LOOP-STOPPER</h2>limit application of permutative rewrite rules
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/LOWER-CASE-P.html acl2-6.3/doc/HTML/LOWER-CASE-P.html
--- acl2-6.2/doc/HTML/LOWER-CASE-P.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/LOWER-CASE-P.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LOWER-CASE-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>LOWER-CASE-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>LOWER-CASE-P</h3>recognizer for lower case characters
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/LP.html acl2-6.3/doc/HTML/LP.html
--- acl2-6.2/doc/HTML/LP.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/LP.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>LP.html  --  ACL2 Version 6.2</title></head>
+<head><title>LP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>LP</h2>the Common Lisp entry to ACL2
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/MACRO-ALIASES-TABLE.html acl2-6.3/doc/HTML/MACRO-ALIASES-TABLE.html
--- acl2-6.2/doc/HTML/MACRO-ALIASES-TABLE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/MACRO-ALIASES-TABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MACRO-ALIASES-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>MACRO-ALIASES-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MACRO-ALIASES-TABLE</h2>a <a href="TABLE.html">table</a> used to associate function names with macro names
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/MACRO-ARGS.html acl2-6.3/doc/HTML/MACRO-ARGS.html
--- acl2-6.2/doc/HTML/MACRO-ARGS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/MACRO-ARGS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MACRO-ARGS.html  --  ACL2 Version 6.2</title></head>
+<head><title>MACRO-ARGS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MACRO-ARGS</h2>the formals list of a macro definition
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/MACRO-COMMAND.html acl2-6.3/doc/HTML/MACRO-COMMAND.html
--- acl2-6.2/doc/HTML/MACRO-COMMAND.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/MACRO-COMMAND.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MACRO-COMMAND.html  --  ACL2 Version 6.2</title></head>
+<head><title>MACRO-COMMAND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MACRO-COMMAND</h2>compound command for the proof-checker
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/MAKE-CHARACTER-LIST.html acl2-6.3/doc/HTML/MAKE-CHARACTER-LIST.html
--- acl2-6.2/doc/HTML/MAKE-CHARACTER-LIST.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MAKE-CHARACTER-LIST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAKE-CHARACTER-LIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAKE-CHARACTER-LIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MAKE-CHARACTER-LIST</h3><a href="COERCE.html">coerce</a> to a list of characters
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MAKE-EVENT-DETAILS.html acl2-6.3/doc/HTML/MAKE-EVENT-DETAILS.html
--- acl2-6.2/doc/HTML/MAKE-EVENT-DETAILS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/MAKE-EVENT-DETAILS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAKE-EVENT-DETAILS.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAKE-EVENT-DETAILS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MAKE-EVENT-DETAILS</h3>details on <code><a href="MAKE-EVENT.html">make-event</a></code> expansion
 <pre>Major Section:  <a href="MAKE-EVENT.html">MAKE-EVENT</a>
diff -Nru acl2-6.2/doc/HTML/MAKE-EVENT.html acl2-6.3/doc/HTML/MAKE-EVENT.html
--- acl2-6.2/doc/HTML/MAKE-EVENT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/MAKE-EVENT.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAKE-EVENT.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAKE-EVENT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MAKE-EVENT</h2>evaluate (expand) a given form and then evaluate the result
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -19,7 +19,9 @@
 
 <strong>Restriction to Event Contexts</strong><br/>
 
-<strong>Examples illustrating how to access state</strong></p><p>We begin with an informal introduction, which focuses on examples and
+<strong>Examples Illustrating How to Access State</strong><br/>
+
+<strong>Advanced Expansion Control</strong></p><p>We begin with an informal introduction, which focuses on examples and
 introduces the key notion of ``expansion phase''.</p><p><strong>Introduction</strong></p><p><code>Make-event</code> is particularly useful for those who program using the ACL2
 <code><a href="STATE.html">state</a></code>; see <a href="PROGRAMMING-WITH-STATE.html">programming-with-state</a>.  That is because the evaluation of
 <code>form</code> may read and even modify the ACL2 <code><a href="STATE.html">state</a></code>.</p><p>Suppose for example that we want to define a constant <code>*world-length*</code>,
@@ -219,37 +221,42 @@
 ; should return the same value as it did when the book was
 ; certified.
 (make-event (generate-form state)
-            :check-expansion t)
+            :CHECK-EXPANSION t)
 
-; As above (where the :check-expansion value can be included or
+; As above (where the :CHECK-EXPANSION value can be included or
 ; not), where if there is an error during expansion, then the error
 ; message will explain that expansion was on behalf of the indicated
 ; object, typically specified as the first argument.
 (make-event (generate-form state)
-            :on-behalf-of (generate-form state))
+            :ON-BEHALF-OF (generate-form state))
 
 General Form:
-(make-event form :check-expansion chk :on-behalf-of obj)
+(make-event form :CHECK-EXPANSION chk :ON-BEHALF-OF obj :EXPANSION? form)
 </pre>
 
 where <code>chk</code> is <code>nil</code> (the default), <code>t</code>, or the intended ``expansion
 result'' from the evaluation of <code>form</code> (as explained below); and if
 supplied, <code>obj</code> is an arbitrary ACL2 object, used only in reporting errors
-in expansion, i.e., in the evaluation of form.</p><p>We strongly recommend that you browse some <code>.lisp</code> files in the community
+in expansion, i.e., in the evaluation of form.  The <code>:EXPANSION?</code> keyword
+is discussed in the final section, on Advanced Expansion Control.</p><p>We strongly recommend that you browse some <code>.lisp</code> files in the community
 books directory <code>books/make-event/</code>.  You may even find it helpful, in
 order to understand <code>make-event</code>, to do so before continuing to read this
-documentation.  For example, <code>eval.lisp</code> contains definitions of macros
+documentation.  You may also find it useful to browse community book
+<code>books/misc/eval.lisp</code>, which contains definitions of macros
 <code>must-succeed</code> and <code>must-fail</code> that are useful for testing and are used
-in many other books in that directory, especially <code>eval-tests.lisp</code>.
-Another example, <code>defrule.lisp</code>, shows how to use macros whose calls expand
-to <code>make-event</code> forms, which in turn can generate <a href="EVENTS.html">events</a>.  For more
-examples, see file <code>Readme.lsp</code> in the above directory.  Other than the
-examples, the explanations here should suffice for most users.  If you want
-explanations of subtler details, see <a href="MAKE-EVENT-DETAILS.html">make-event-details</a>.</p><p>Note that <code>make-event</code> may only be used at the ``top level'' or where an
+in many books in the <code>books/make-event/</code> directory, especially
+<code>eval-tests.lisp</code>.  Another example, <code>books/make-event/defrule.lisp</code>,
+shows how to use macros whose calls expand to <code>make-event</code> forms, which in
+turn can generate <a href="EVENTS.html">events</a>.  For more examples, see file
+<code>books/make-event/Readme.lsp</code>.  Other than the examples, the explanations
+here should suffice for most users.  If you want explanations of subtler
+details, see <a href="MAKE-EVENT-DETAILS.html">make-event-details</a>.</p><p>Note that <code>make-event</code> may only be used at the ``top level'' or where an
 event is expected.  See the section ``Restriction to Event Contexts'', below.</p><p><code>Make-event</code> is related to Lisp macroexpansion in the sense that its
 argument is evaluated to obtain an expansion result, which is evaluated
 again.  Let us elaborate on each of these notions in turn: ``is evaluated,''
-``expansion result'', and ``evaluated again.''</p>
+``expansion result'', and ``evaluated again.''  The final section, on
+Advanced Expansion Control, will generalize these processes in a way that we
+ignore for now.</p>
 <blockquote><p></p><p>``is evaluated'' -- The argument can be any expression, which is evaluated
 as would be any expression submitted to ACL2's top level loop.  Thus,
 <code><a href="STATE.html">state</a></code> and user-defined <code><a href="STOBJ.html">stobj</a></code>s may appear in the form supplied to
@@ -261,70 +268,72 @@
 <code><a href="STATE.html">state</a></code> global variables (see <a href="ASSIGN.html">assign</a>) are preserved).  So, for example,
 events might be evaluated during expansion, but they will disappear from the
 logical <a href="WORLD.html">world</a> after expansion returns its result.  Moreover, proofs are
-enabled by default at the start of expansion (see <a href="LD-SKIP-PROOFSP.html">ld-skip-proofsp</a>), because
-an anticipated use of <code>make-event</code> is to call the prover to decide which
-event to generate, and that would presumably be necessary even if proofs had
-been disabled.</p><p>``expansion result'' -- The above expansion may result in an ordinary
+enabled by default at the start of expansion (see <a href="LD-SKIP-PROOFSP.html">ld-skip-proofsp</a>) if
+keyword <code>:CHECK-EXPANSION</code> is supplied and has a non-<code>nil</code> value.</p><p>``expansion result'' -- The above expansion may result in an ordinary
 (non-<code><a href="STATE.html">state</a></code>, non-<code><a href="STOBJ.html">stobj</a></code>) value, which we call the ``expansion
 result.''  Or, expansion may result in a multiple value of the form
-<code>(mv erp val state stobj-1 ... stobj-k)</code>, where <code>k</code> may be 0; in fact the
-most common case is probably <code>(mv erp val state)</code>.  In that case, if
-<code>erp</code> is not <code>nil</code>, then there is no expansion result, and the original
-<code>make-event</code> evaluates to a soft error.  If however <code>erp</code> is <code>nil</code>,
-then the resulting value is <code>val</code>.  Moreover, <code>val</code> must be an embedded
-event form (see <a href="EMBEDDED-EVENT-FORM.html">embedded-event-form</a>); otherwise, the original <code>make-event</code>
-evaluates to a soft error.  Note that error messages from expansion are
-printed as described under ``Error Reporting'' below.</p><p>``evaluated again'' -- the expansion result is evaluated in place of the
+<code>(mv erp val state)</code>, or, more generally,
+<code>(mv erp val state stobj-1 ... stobj-k)</code> where each <code>stobj-i</code> is a
+<a href="STOBJ.html">stobj</a>; then the expansion result is <code>val</code> unless <code>erp</code> is not
+<code>nil</code>, in which case there is no expansion result, and the original
+<code>make-event</code> evaluates to a soft error.  In either case (single or multiple
+value), either <code>val</code> is an embedded event form (see <a href="EMBEDDED-EVENT-FORM.html">embedded-event-form</a>),
+or else the original <code>make-event</code> evaluates to a soft error, printed as
+described under ``Error Reporting'' below.</p><p>``evaluated again'' -- the expansion result is evaluated in place of the
 original <code>make-event</code>.</p><p></p></blockquote>
-<p>Note that the result of expansion can be an ordinary event, but it can
-instead be another call of <code>make-event</code>, or even of a call of a macro that
-expands to a call of <code>make-event</code>.  Or, expansion itself can cause
-subsidiary calls of <code>make-event</code>, for example if expansion uses <code><a href="LD.html">ld</a></code> to
-evaluate some <code>make-event</code> forms.  The state global variable
-<code>make-event-debug</code> may be set to a non-<code>nil</code> value in order to see a
-trace of the expansion process, where the level shown (as in ``<code>3&gt;</code>'')
-indicates the depth of expansions in progress.</p><p>Expansion of a <code>make-event</code> call will yield an event that replaces the
+<p>The expansion process can invoke subsidiary calls of <code>make-event</code>, and
+the expansion result can (perhaps after macroexpansion) be a call of
+<code>make-event</code>.  It can be useful to track all these <code>make-event</code> calls.
+The <a href="STATE.html">state</a> global variable <code>make-event-debug</code> may be set to a
+non-<code>nil</code> value, for example <code>(assign make-event-debug t)</code>, in order to
+see a trace of the expansion process, where a level is displayed (as in
+``<code>3&gt;</code>'') to indicate the depth of subsidiary expansions.</p><p>Expansion of a <code>make-event</code> call will yield an event that replaces the
 original <code>make-event</code> call.  In particular, if you put a <code>make-event</code>
 form in a book, then in essence it is replaced by its expansion result,
 created during the proof pass of the <code><a href="CERTIFY-BOOK.html">certify-book</a></code> process.  We now
-elaborate on this idea of keeping the original expansion.</p><p>By default, a <code>make-event</code> call in a certified book is replaced (by a
-process hidden from the user, in an <code>:expansion-alist</code> field of the book's
-<a href="CERTIFICATE.html">certificate</a>) by the expansion result from evaluation of its first
-argument.  Thus, although the book is not textually altered during
-certification, one may imagine a ``book expansion'' corresponding to the
-original book in which all of the events for which expansion took place
-(during the proof phase of certification) have been replaced by their
-expansions.  A subsequent <code><a href="INCLUDE-BOOK.html">include-book</a></code> will then include the book
-expansion corresponding to the indicated book.  When a book is compiled
-during <code><a href="CERTIFY-BOOK.html">certify-book</a></code>, it is actually the corresponding book expansion,
-stored as a temporary file, that is compiled instead.  That temporary file is
-deleted after compilation unless one first evaluates the form
-<code>(assign keep-tmp-files t)</code>.  Note however that all of the original forms
-must still be legal <a href="EVENTS.html">events</a> (see <a href="EMBEDDED-EVENT-FORM.html">embedded-event-form</a>).  So for example,
-if the first event in a book is <code>(local (defmacro my-id (x) x))</code>, followed
-by <code>(my-id (make-event ...))</code>, the final ``<code>include-book</code>'' pass of
-<code><a href="CERTIFY-BOOK.html">certify-book</a></code> will fail because <code>my-id</code> is not defined when the
-<code>my-id</code> call is encountered.</p><p>The preceding paragraph begins with ``by default'' because if you specify
-<code>:check-expansion t</code>, then subsequent evaluation of the same <code>make-event</code>
-call -- during the second pass of an <code><a href="ENCAPSULATE.html">encapsulate</a></code> or during event
-processing on behalf of <code><a href="INCLUDE-BOOK.html">include-book</a></code> -- will do the expansion again
-and check that the expansion result equals the original expansion result.  In
-the unusual case that you know the expected expansion result, <code>res</code>, you
-can specify <code>:check-expansion res</code>.  This will will cause a check that
-every subsequent expansion result for the <code>make-event</code> form is <code>res</code>,
-including the original one.  IMPORTANT NOTE: That expansion check is only
-done when processing events, not during a preliminary load of a book's
-compiled file.  The following paragraph elaborates.</p><p>(Here are details on the point made just above, for those who use the
-<code>:check-expansion</code> argument to perform side-effects on the <a href="STATE.html">state</a>.
+elaborate on this idea of keeping the original expansion.</p><p>A <code>make-event</code> call generates a ``<code>make-event</code> replacement'' that may be
+stored by the system.  In the simplest case, this replacement is the
+expansion result.  When a book is certified, these replacements are stored in
+a book's certificate (technically, in the <code>:EXPANSION-ALIST</code> field).  Thus,
+although the book is not textually altered during certification, one may
+imagine a ``book expansion'' corresponding to the original book, in which
+events are substituted by replacements that were generated during the proof
+phase of certification.  A subsequent <code><a href="INCLUDE-BOOK.html">include-book</a></code> will then include
+the book expansion corresponding to the indicated book.  When a book is
+compiled during <code><a href="CERTIFY-BOOK.html">certify-book</a></code>, it is actually the corresponding book
+expansion, stored as a temporary file, that is compiled instead.  That
+temporary file is deleted after compilation unless one first evaluates the
+form <code>(assign keep-tmp-files t)</code>.  Note however that all of the original
+forms must still be legal <a href="EVENTS.html">events</a>; see <a href="EMBEDDED-EVENT-FORM.html">embedded-event-form</a>.  So for
+example, if the first event in a book is <code>(local (defmacro my-id (x) x))</code>,
+and is followed by <code>(my-id (make-event ...))</code>, the final
+``<code>include-book</code>'' pass of <code><a href="CERTIFY-BOOK.html">certify-book</a></code> will fail because <code>my-id</code>
+is not defined when the <code>my-id</code> call is encountered.</p><p>A <code>make-event</code> replacement might not be the expansion when either of the
+keyword arguments <code>:CHECK-EXPANSION</code> or <code>:EXPANSION?</code> is supplied.  We
+deal with the latter in the final section, on Advanced Expansion Control.  If
+<code>:CHECK-EXPANSION t</code> is supplied and the expansion is <code>exp</code>, then the
+replacement is obtained from the original <code>make-event</code> call, by
+substituting <code>exp</code> for <code>t</code> as the value of keyword <code>:CHECK-EXPANSION</code>.
+Such a <code>make-event</code> call -- during the second pass of an
+<code><a href="ENCAPSULATE.html">encapsulate</a></code> or during event processing on behalf of <code><a href="INCLUDE-BOOK.html">include-book</a></code>
+-- will do the expansion again and check that the expansion result is equal
+to the original expansion result, <code>exp</code>.  In the unusual case that you know
+the expected expansion result, <code>res</code>, you can specify
+<code>:CHECK-EXPANSION res</code> in the first place, so that the check is also done
+during the initial evaluation of the <code>make-event</code> form.  IMPORTANT BUT
+OBSCURE DETAIL: That expansion check is only done when processing events, not
+during a preliminary load of a book's compiled file.  The following paragraph
+elaborates.</p><p>(Here are details on the point made just above, for those who use the
+<code>:CHECK-EXPANSION</code> argument to perform side-effects on the <a href="STATE.html">state</a>.
 When you include a book, ACL2 generally loads a compiled file before
 processing the events in the book; see <a href="BOOK-COMPILED-FILE.html">book-compiled-file</a>.  While it is true
-that a non-<code>nil</code> <code>:check-expansion</code> argument causes <code><a href="INCLUDE-BOOK.html">include-book</a></code> to
+that a non-<code>nil</code> <code>:CHECK-EXPANSION</code> argument causes <code><a href="INCLUDE-BOOK.html">include-book</a></code> to
 perform expansion of the <code>make-event</code> form during event processing it does
 <em>not</em> perform expansion when the compiled file (or expansion file; again,
-see <a href="BOOK-COMPILED-FILE.html">book-compiled-file</a>) is loaded.)</p><p>ACL2 performs the following space-saving optimization for book certificates:
-a <code><a href="LOCAL.html">local</a></code> event arising from <code>make-event</code> expansion is replaced in that
-expansion by <code>(local (value-triple :ELIDED))</code>.</p><p>We note that ACL2 extends the notion of ``make-event expansion'' to the case
-that a call of <code>make-event</code> is found in the course of macroexpansion.  The
+see <a href="BOOK-COMPILED-FILE.html">book-compiled-file</a>) is loaded.)</p><p>ACL2 performs the following space-saving optimization: when the expansion
+result is a <code><a href="LOCAL.html">local</a></code> event, then the <code>make-event</code> replacement is
+<code>(local (value-triple :ELIDED))</code>.</p><p>The notion of ``expansion'' and ``replacement'' extend to the case that a
+call of <code>make-event</code> is found in the course of macroexpansion.  The
 following example illustrates this point.
 
 <pre>
@@ -337,7 +346,7 @@
 </pre>
 
 The above call of <code><a href="PE.html">pe</a></code> shows that the form <code>(my-mac)</code> has a
-<code>make-event</code> expansion of <code>(DEFUN FOO (X) X)</code>:
+<code>make-event</code> expansion (and replacement) of <code>(DEFUN FOO (X) X)</code>:
 
 <pre>
 (ENCAPSULATE NIL
@@ -353,10 +362,10 @@
 a string, then that string is printed in the error message.  If <code>erp</code> is
 a <code><a href="CONS.html">cons</a></code> pair whose <code><a href="CAR.html">car</a></code> is a string, then the error prints
 <code>"~@0"</code> with <code>#\0</code> bound to that <code>cons</code> pair; see <a href="FMT.html">fmt</a>.  Any other
-non-<code>nil</code> value of <code>erp</code> causes a generic error message to be printed.</p><p><strong>Restriction to Event Contexts</strong></p><p>A <code>make-event</code> call must occur either at the top level or as an argument of
-an event constructor, as explained in more detail below.  This restriction is
-imposed to enable ACL2 to track expansions produced by <code>make-event</code>.  The
-following examples illustrate this restriction.
+non-<code>nil</code> value of <code>erp</code> causes a generic error message to be printed.</p><p><strong>Restriction to Event Contexts</strong></p><p>A <code>make-event</code> call must occur either at the top level, or during
+<code>make-event</code> expansion, or as an argument of an event constructor.  We
+explain in more detail below.  This restriction is imposed to enable ACL2 to
+track expansions produced by <code>make-event</code>.</p><p>The following examples illustrate this restriction.
 
 <pre>
 ; Legal:
@@ -369,10 +378,12 @@
         (make-event '(defun foo (x) x))
         (mv erp val state))
 </pre>
-</p><p>More precisely: after macroexpansion has taken place, a <code>make-event</code> call
-must be in an ``event context'', defined recursively as follows.  (All but
-the first two cases below correspond to similar cases for constructing
-events; see <a href="EMBEDDED-EVENT-FORM.html">embedded-event-form</a>.)
+</p><p>More precisely: a <code>make-event</code> call that is not itself evaluated during
+<code>make-event</code> expansion is subject to the following requirement.  After
+macroexpansion has taken place, such a <code>make-event</code> call must be in an
+``event context'', defined recursively as follows.  (All but the first two
+cases below correspond to similar cases for constructing events;
+see <a href="EMBEDDED-EVENT-FORM.html">embedded-event-form</a>.)
 </p>
 <blockquote><p></p><p>o A form submitted at the top level, or more generally, supplied to a call of
 <code><a href="LD.html">ld</a></code>, is in an event context.</p><p>o A form occurring at the top level of a book is in an event context.</p><p>o If <code>(</code><code><a href="LOCAL.html">LOCAL</a></code><code> x1)</code> is in an event context, then so is <code>x1</code>.</p><p>o If <code>(</code><code><a href="SKIP-PROOFS.html">SKIP-PROOFS</a></code><code> x1)</code> is in an event context, then so is
@@ -381,13 +392,13 @@
 context.</p><p>o If <code>(</code><code><a href="WITH-OUTPUT.html">WITH-OUTPUT</a></code><code> ... x1)</code>,
 <code>(</code><code><a href="WITH-PROVER-STEP-LIMIT.html">WITH-PROVER-STEP-LIMIT</a></code><code> ... x1 ...)</code>, or
 <code>(</code><code><a href="WITH-PROVER-TIME-LIMIT.html">WITH-PROVER-TIME-LIMIT</a></code><code> ... x1)</code> is in an event context, then so
-is <code>x1</code>.</p><p>o Given a call of <code><a href="PROGN.html">PROGN</a></code> or <code><a href="PROGN_bang_.html">PROGN!</a></code> in an event context, each of its
-arguments is in an event context.</p><p>o Given a call of <code><a href="ENCAPSULATE.html">ENCAPSULATE</a></code> in an event context, each of its
-arguments except the first (the signature list) is in an event context.</p><p>o If <code>(RECORD-EXPANSION x1 x2)</code> is in an event context, then <code>x1</code> and
+is <code>x1</code>.</p><p>o For any call of <code><a href="PROGN.html">PROGN</a></code> or <code><a href="PROGN_bang_.html">PROGN!</a></code>, each of its arguments is in an
+event context.</p><p>o For any call of <code><a href="ENCAPSULATE.html">ENCAPSULATE</a></code>, each of its arguments except the
+first (the signature list) is in an event context.</p><p>o If <code>(RECORD-EXPANSION x1 x2)</code> is in an event context, then <code>x1</code> and
 <code>x2</code> are in event contexts.  Note: <code>record-expansion</code> is intended for use
 only by the implementation, which imposes the additional restriction that
 <code>x1</code> and its subsidiary <code>make-event</code> calls (if any) must specify a
-<code>:check-expansion</code> argument that is a <a href="CONSP.html">consp</a>.
+<code>:CHECK-EXPANSION</code> argument that is a <a href="CONSP.html">consp</a>.
 </p></blockquote>
 <p></p><p>Low-level remark, for system implementors.  There is the one exception to
 the above restriction: a single <code><a href="STATE-GLOBAL-LET_star_.html">state-global-let*</a></code> form immediately
@@ -400,10 +411,10 @@
 However, the following form may be preferable (see <a href="PROGN_bang_.html">progn!</a>):
 
 <pre>
-(progn! :state-global-bindings &lt;bindings&gt; (make-event ...))
+(progn! :STATE-GLOBAL-BINDINGS &lt;bindings&gt; (make-event ...))
 </pre>
 
-Also see <a href="REMOVE-UNTOUCHABLE.html">remove-untouchable</a> for an interesting use of this exception.</p><p><strong>Examples illustrating how to access state</strong></p><p>You can modify the ACL2 <a href="STATE.html">state</a> by doing your state-changing computation
+Also see <a href="REMOVE-UNTOUCHABLE.html">remove-untouchable</a> for an interesting use of this exception.</p><p><strong>Examples Illustrating How to Access State</strong></p><p>You can modify the ACL2 <a href="STATE.html">state</a> by doing your state-changing computation
 during the expansion phase, before expansion returns the event that is
 submitted.  Here are some examples.</p><p>First consider the following.  Notice that expansion modifies state global
 <code>my-global</code> during <code>make-event</code> expansion, and then expansion returns a
@@ -454,7 +465,7 @@
 <pre>
 (make-event
   (let ((world-len (length (w state))))
-    `(progn (table my-table :stored-world-length ,world-len)
+    `(progn (table my-table :STORED-WORLD-LENGTH ,world-len)
             (defun foo (x) (cons x ,world-len)))))
 </pre>
 
@@ -471,7 +482,124 @@
 </pre>
 </p><p>By the way, most built-in <a href="STATE.html">state</a> globals revert after expansion.  But
 your own global (like <code>my-global</code> above) can be set during expansion, and
-the new value will persist.
+the new value will persist.</p><p><strong>Advanced Expansion Control</strong></p><p>We conclude this <a href="DOCUMENTATION.html">documentation</a> section by discussing three kinds of
+additional control over <code>make-event</code> expansion.  These are all illustrated
+in community book <code>books/make-event/make-event-keywords-or-exp.lisp</code>.
+The discussion below is split into the following three parts.</p><p>(1) The value produced by expansion may have the form <code>(:DO-PROOFS exp)</code>,
+which specifies <code>exp</code> as the expansion result, to be evaluated without
+skipping proofs even when including a book.</p><p>(2) The value produced by expansion may have the form
+<code>(:OR exp-1 ... exp-k)</code>, which specifies that the first form <code>exp-i</code> to
+evaluate without error is the expansion result.</p><p>(3) The keyword argument <code>:EXPANSION?</code> can serve to eliminate the storing
+of <code>make-event</code> replacements, as described above for the ``book expansion''
+of a book.</p><p>We now elaborate on each of these.</p><p>(1) <code>:DO-PROOFS</code> ``call'' produced by expansion.</p><p>We have discussed the expansion result produced by the expansion phase of
+evaluating a <code>make-event</code> call.  However, if the expansion phase produces
+an expression of the form <code>(:DO-PROOFS exp)</code>, then the expansion result is
+actually <code>exp</code>.  The <code>:DO-PROOFS</code> wrapper indicates that even if proofs
+are currently being skipped (see <a href="LD-SKIP-PROOFSP.html">ld-skip-proofsp</a>), then evaluation of
+<code>exp</code> should take place with proofs not skipped.  For example, proofs will
+be performed when evaluating the <code>make-event</code> expansion, namely the
+indicated <code>defthm</code> event, in the following example.
+
+<pre>
+(set-ld-skip-proofsp t state)
+(make-event '(:DO-PROOFS
+              (defthm app-assoc (equal
+                                 (append (append x y) z)
+                                 (append x y z)))))
+</pre>
+</p><p>Note that such use of <code>:DO-PROOFS</code> causes proofs to be performed when
+evaluating the expansion while including an uncertified book.  But when
+including a certified book, then unless <code>:CHECK-EXPANSION</code> is supplied a
+non-<code>nil</code> value, the <code>make-event</code> replacement will just be the expansion,
+which does not include the <code>:DO-PROOFS</code> wrapper and hence will be evaluated
+with proofs skipped.</p><p>(2) <code>:OR</code> ``call'' produced by expansion.</p><p>There may be times where you want to try different expansions.  For example,
+the community book <code>books/make-event/proof-by-arith.lisp</code> attempts to admit
+a given event, which we'll denote <code>EV</code>, by trying events of the following
+form as <code>BOOK</code> varies over different community books.
+
+<pre>
+(encapsulate
+ ()
+ (local (include-book BOOK :DIR :SYSTEM))
+ EV)
+</pre>
+
+A naive implementation of this macro would evaluate all such
+<code><a href="ENCAPSULATE.html">encapsulate</a></code> events until one succeeds, and then return that successful
+event as the expansion.  Then that event would need to be evaluated again!
+With some hacking one could avoid that re-evaluation by using
+<code><a href="SKIP-PROOFS.html">skip-proofs</a></code>, but that won't work if you are trying to create a
+certified book without skipped proofs.  Instead, the implementation creates
+an expansion of the form <code>(:OR ev-1 ev-2 ... ev-k)</code>, where the list
+<code>(ev-1 ev-2 ... ev-k)</code> enumerates the generated encapsulate events.  In
+general, for this ``disjunctive case'' of a result from expansion, each
+<code>ev-i</code> is evaluated in sequence, and the first that succeeds without error
+is considered to be the expansion result -- and a repeat evaluation is
+avoided.  If evaluation of each <code>ev-i</code> results in an error, then so does
+the <code>make-event</code> call.</p><p>This special use of <code>:OR</code> in a value produced by expansion is only
+supported at the top level.  That is, the result can be
+<code>(:OR ev-1 ev-2 ... ev-k)</code> but then each <code>ev-i</code> must be a legal expansion
+result, without such further use of <code>:OR</code> -- except, <code>ev-i</code> may be
+<code>(:DO-PROOFS ev-i')</code>, where <code>ev-i'</code> then would serve as the expansion
+rather than <code>ev-i</code>.</p><p>(3) The <code>:EXPANSION?</code> keyword argument.</p><p>If keyword argument <code>:EXPANSION?</code> has a non<code>nil</code> value, then the
+<code>:CHECK-EXPANSION</code> keyword must be omitted or have value <code>nil</code> or <code>t</code>,
+hence not a cons pair.</p><p>The idea of the <code>:EXPANSION?</code> keyword is to give you a way to avoid storing
+expansion results in a book's <a href="CERTIFICATE.html">certificate</a>.  Roughly speaking, when the
+expansion result matches the value of <code>:EXPANSION?</code>, then no expansion
+result is stored for the event by book certification; then when the book is
+later included, the value of <code>:EXPANSION?</code> is used as the expansion, thus
+bypassing the expansion phase.  One could say that the event is its own
+make-event replacement, but it is more accurate to say that there is no
+make-event replacement at all, since nothing is stored in the certificate for
+this event.  Below, we elaborate on make-event replacements when
+<code>:EXPANSION</code> is used and also discuss other properties of this keyword.</p><p>We modify the notion of ``expansion result'' for <code>make-event</code> forms to
+comprehend the use of the <code>:EXPANSION?</code> keyword.  For that purpose, let's
+consider a call of <code>make-event</code> to be ``reducible'' if it has an
+<code>:EXPANSION?</code> keyword with non-<code>nil</code> value, <code>exp</code>, and its
+<code>:CHECK-EXPANSION</code> keyword is missing or has value <code>nil</code>, in which case
+the ``reduction'' of this <code>make-event</code> call is defined to be <code>exp</code>.  The
+expansion result as originally defined is modified by the following
+``recursive reduction'' process: recur through the original expansion,
+passing through calls of <code><a href="LOCAL.html">local</a></code>, <code><a href="SKIP-PROOFS.html">skip-proofs</a></code>, <code><a href="WITH-OUTPUT.html">with-output</a></code>,
+<code><a href="WITH-PROVER-STEP-LIMIT.html">with-prover-step-limit</a></code>, and <code><a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a></code>, and
+replacing (recursively) any reducible call of <code>make-event</code> by its
+reduction.  Furthermore, we refer to two forms as ``reduction equivalent'' if
+their recursive reductions are equal.  Note that the recursive reduction
+process does not pass through <code><a href="PROGN.html">progn</a></code> or <code><a href="ENCAPSULATE.html">encapsulate</a></code>, but that
+process is applied to the computation of expansions for their subsidiary
+<code><a href="MAKE-EVENT.html">make-event</a></code> calls.</p><p>To explain further the effect of <code>:EXPANSION? exp</code>, we split into the
+following two cases.</p><p>o Case 1: Evaluation is not taking place when including a book or evaluating
+the second pass of an <code><a href="ENCAPSULATE.html">encapsulate</a></code> event; more precisely, the value of
+<code>(ld-skip-proofsp state)</code> is not the symbol <code>INCLUDE-BOOK</code>.  There are
+two subcases.
+</p>
+<blockquote><p></p><p>- Case 1a: The expansion result is not reduction-equivalent to <code>exp</code>.  Then
+the <code>make-event</code> call is processed as though the <code>:EXPANSION?</code> keyword
+had been omitted.</p><p>- Case 2a: The expansion result is reduction-equivalent to <code>exp</code>.  Then
+there is no <code>make-event</code> replacement for this call of <code>make-event</code>; no
+replacement will be put into the <a href="CERTIFICATE.html">certificate</a> file for a book containing
+this <code>make-event</code> call.  When that book is subsequently included, the
+original form will be evaluated in the manner described in the next
+case.</p></blockquote>
+<p></p><p>o Case 2: Evaluation is taking place when including a book or evaluating the
+second pass of an <code><a href="ENCAPSULATE.html">encapsulate</a></code> event; more precisely, the value of
+<code>(ld-skip-proofsp state)</code> is the symbol <code>INCLUDE-BOOK</code>.  Then the
+expansion is <code>exp</code>.  The expansion phase is skipped unless
+<code>:CHECK-EXPANSION</code> is <code>t</code>.</p><p>The <code>:EXPANSION?</code> keyword can be particularly useful in concert with the
+disjunctive (``<code>:OR</code>'') case (2) discussed above.  Suppose that expansion
+produces a value as discussed in (2) above, <code>(:OR exp-1 ... exp-k)</code>.  If
+one of these expressions <code>exp-i</code> is more likely than the others to be the
+expansion, then you may wish to specify <code>:EXPANSION? exp-i</code>, as this will
+avoid storing a <code>make-event</code> replacement in that common case.  This could
+be useful if the expressions are large, to avoid enlarging the
+<a href="CERTIFICATE.html">certificate</a> file for a book containing the <code>make-event</code> call.</p><p>It is legal to specify both <code>:EXPANSION? exp</code> and <code>:CHECK-EXPANSION t</code>.
+When either <code>(ld-skip-proofsp state)</code> is the symbol <code>INCLUDE-BOOK</code>, or
+evaluation is taking place in raw Lisp, then this combination is treated the
+same as if <code>:EXPANSION?</code> is omitted and the value of <code>:CHECK-EXPANSION</code>
+is <code>exp</code>.  Otherwise, this combination is treated the same as
+<code>:CHECK-EXPANSION t</code>, modified to accommodate the effect of <code>:EXPANSION?</code>
+as discussed above: if the expansion is indeed the value of <code>:EXPANSION?</code>,
+then no <code>make-event</code> replacement is generated.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
 </html>
diff -Nru acl2-6.2/doc/HTML/MAKE-FAST-ALIST.html acl2-6.3/doc/HTML/MAKE-FAST-ALIST.html
--- acl2-6.2/doc/HTML/MAKE-FAST-ALIST.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/MAKE-FAST-ALIST.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAKE-FAST-ALIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAKE-FAST-ALIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MAKE-FAST-ALIST</h2><code>(make-fast-alist alist)</code> creates a fast-alist from the input alist,
 <code>   </code>returning <code>alist</code> itself or, in some cases, a new object equal to it.
diff -Nru acl2-6.2/doc/HTML/MAKE-LIST.html acl2-6.3/doc/HTML/MAKE-LIST.html
--- acl2-6.2/doc/HTML/MAKE-LIST.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MAKE-LIST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAKE-LIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAKE-LIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MAKE-LIST</h3>make a list of a given size
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MAKE-ORD.html acl2-6.3/doc/HTML/MAKE-ORD.html
--- acl2-6.2/doc/HTML/MAKE-ORD.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MAKE-ORD.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAKE-ORD.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAKE-ORD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MAKE-ORD</h3>a constructor for ordinals.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MAKE-TAU-INTERVAL.html acl2-6.3/doc/HTML/MAKE-TAU-INTERVAL.html
--- acl2-6.2/doc/HTML/MAKE-TAU-INTERVAL.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/MAKE-TAU-INTERVAL.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAKE-TAU-INTERVAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAKE-TAU-INTERVAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MAKE-TAU-INTERVAL</h3>make a tau interval
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/MAKE-WORMHOLE-STATUS.html acl2-6.3/doc/HTML/MAKE-WORMHOLE-STATUS.html
--- acl2-6.2/doc/HTML/MAKE-WORMHOLE-STATUS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/MAKE-WORMHOLE-STATUS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAKE-WORMHOLE-STATUS.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAKE-WORMHOLE-STATUS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MAKE-WORMHOLE-STATUS</h2>creates a wormhole status object from given status, entry code, and data
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/MANAGING-ACL2-PACKAGES.html acl2-6.3/doc/HTML/MANAGING-ACL2-PACKAGES.html
--- acl2-6.2/doc/HTML/MANAGING-ACL2-PACKAGES.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/MANAGING-ACL2-PACKAGES.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MANAGING-ACL2-PACKAGES.html  --  ACL2 Version 6.2</title></head>
+<head><title>MANAGING-ACL2-PACKAGES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MANAGING-ACL2-PACKAGES</h3>user-contributed documentation on packages
 <pre>Major Section:  <a href="DEFPKG.html">DEFPKG</a>
diff -Nru acl2-6.2/doc/HTML/MARKUP.html acl2-6.3/doc/HTML/MARKUP.html
--- acl2-6.2/doc/HTML/MARKUP.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/MARKUP.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MARKUP.html  --  ACL2 Version 6.2</title></head>
+<head><title>MARKUP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MARKUP</h2>the markup language for ACL2 <a href="DOCUMENTATION.html">documentation</a> strings
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/MAX.html acl2-6.3/doc/HTML/MAX.html
--- acl2-6.2/doc/HTML/MAX.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MAX.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAX.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MAX</h3>the larger of two numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MAXIMUM-LENGTH.html acl2-6.3/doc/HTML/MAXIMUM-LENGTH.html
--- acl2-6.2/doc/HTML/MAXIMUM-LENGTH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MAXIMUM-LENGTH.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MAXIMUM-LENGTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>MAXIMUM-LENGTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MAXIMUM-LENGTH</h3>return the <code>:maximum-length</code> from the <a href="HEADER.html">header</a> of an array
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/MBE.html acl2-6.3/doc/HTML/MBE.html
--- acl2-6.2/doc/HTML/MBE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MBE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MBE.html  --  ACL2 Version 6.2</title></head>
+<head><title>MBE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MBE</h3>attach code for execution
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MBE1.html acl2-6.3/doc/HTML/MBE1.html
--- acl2-6.2/doc/HTML/MBE1.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MBE1.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MBE1.html  --  ACL2 Version 6.2</title></head>
+<head><title>MBE1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MBE1</h3>attach code for execution
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MBT.html acl2-6.3/doc/HTML/MBT.html
--- acl2-6.2/doc/HTML/MBT.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MBT.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MBT.html  --  ACL2 Version 6.2</title></head>
+<head><title>MBT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MBT</h3>introduce a test not to be evaluated
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MEASURE.html acl2-6.3/doc/HTML/MEASURE.html
--- acl2-6.2/doc/HTML/MEASURE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/MEASURE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MEASURE.html  --  ACL2 Version 6.2</title></head>
+<head><title>MEASURE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MEASURE</h2>xargs keyword <code>:MEASURE</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/MEMBER-EQ.html acl2-6.3/doc/HTML/MEMBER-EQ.html
--- acl2-6.2/doc/HTML/MEMBER-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MEMBER-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MEMBER-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>MEMBER-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MEMBER-EQ</h3>See <a href="MEMBER.html">member</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MEMBER-EQUAL.html acl2-6.3/doc/HTML/MEMBER-EQUAL.html
--- acl2-6.2/doc/HTML/MEMBER-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MEMBER-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MEMBER-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>MEMBER-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MEMBER-EQUAL</h3>See <a href="MEMBER.html">member</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MEMBER.html acl2-6.3/doc/HTML/MEMBER.html
--- acl2-6.2/doc/HTML/MEMBER.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MEMBER.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MEMBER.html  --  ACL2 Version 6.2</title></head>
+<head><title>MEMBER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MEMBER</h3>membership predicate
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MEMOIZE-SUMMARY.html acl2-6.3/doc/HTML/MEMOIZE-SUMMARY.html
--- acl2-6.2/doc/HTML/MEMOIZE-SUMMARY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/MEMOIZE-SUMMARY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MEMOIZE-SUMMARY.html  --  ACL2 Version 6.2</title></head>
+<head><title>MEMOIZE-SUMMARY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MEMOIZE-SUMMARY</h2>display all collected profiling and memoization table info
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/MEMOIZE.html acl2-6.3/doc/HTML/MEMOIZE.html
--- acl2-6.2/doc/HTML/MEMOIZE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/MEMOIZE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MEMOIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>MEMOIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MEMOIZE</h2>turn on memoization for a specified function
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/MEMSUM.html acl2-6.3/doc/HTML/MEMSUM.html
--- acl2-6.2/doc/HTML/MEMSUM.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/MEMSUM.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MEMSUM.html  --  ACL2 Version 6.2</title></head>
+<head><title>MEMSUM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MEMSUM</h2>display all collected profiling and memoization info
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/META-EXTRACT-CONTEXTUAL-FACT.html acl2-6.3/doc/HTML/META-EXTRACT-CONTEXTUAL-FACT.html
--- acl2-6.2/doc/HTML/META-EXTRACT-CONTEXTUAL-FACT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/META-EXTRACT-CONTEXTUAL-FACT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>META-EXTRACT-CONTEXTUAL-FACT.html  --  ACL2 Version 6.2</title></head>
+<head><title>META-EXTRACT-CONTEXTUAL-FACT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>META-EXTRACT-CONTEXTUAL-FACT</h2>See <a href="META-EXTRACT.html">meta-extract</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/META-EXTRACT-FORMULA.html acl2-6.3/doc/HTML/META-EXTRACT-FORMULA.html
--- acl2-6.2/doc/HTML/META-EXTRACT-FORMULA.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/META-EXTRACT-FORMULA.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>META-EXTRACT-FORMULA.html  --  ACL2 Version 6.2</title></head>
+<head><title>META-EXTRACT-FORMULA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>META-EXTRACT-FORMULA</h2>See <a href="META-EXTRACT.html">meta-extract</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/META-EXTRACT-GLOBAL-FACT+.html acl2-6.3/doc/HTML/META-EXTRACT-GLOBAL-FACT+.html
--- acl2-6.2/doc/HTML/META-EXTRACT-GLOBAL-FACT+.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/META-EXTRACT-GLOBAL-FACT+.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>META-EXTRACT-GLOBAL-FACT+.html  --  ACL2 Version 6.2</title></head>
+<head><title>META-EXTRACT-GLOBAL-FACT+.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>META-EXTRACT-GLOBAL-FACT+</h2>See <a href="META-EXTRACT.html">meta-extract</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/META-EXTRACT-GLOBAL-FACT.html acl2-6.3/doc/HTML/META-EXTRACT-GLOBAL-FACT.html
--- acl2-6.2/doc/HTML/META-EXTRACT-GLOBAL-FACT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/META-EXTRACT-GLOBAL-FACT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>META-EXTRACT-GLOBAL-FACT.html  --  ACL2 Version 6.2</title></head>
+<head><title>META-EXTRACT-GLOBAL-FACT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>META-EXTRACT-GLOBAL-FACT</h2>See <a href="META-EXTRACT.html">meta-extract</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/META-EXTRACT-RW+-TERM.html acl2-6.3/doc/HTML/META-EXTRACT-RW+-TERM.html
--- acl2-6.2/doc/HTML/META-EXTRACT-RW+-TERM.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/META-EXTRACT-RW+-TERM.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>META-EXTRACT-RW+-TERM.html  --  ACL2 Version 6.2</title></head>
+<head><title>META-EXTRACT-RW+-TERM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>META-EXTRACT-RW+-TERM</h2>See <a href="META-EXTRACT.html">meta-extract</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/META-EXTRACT.html acl2-6.3/doc/HTML/META-EXTRACT.html
--- acl2-6.2/doc/HTML/META-EXTRACT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/META-EXTRACT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>META-EXTRACT.html  --  ACL2 Version 6.2</title></head>
+<head><title>META-EXTRACT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>META-EXTRACT</h2>meta reasoning using valid terms extracted from context or <a href="WORLD.html">world</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/META.html acl2-6.3/doc/HTML/META.html
--- acl2-6.2/doc/HTML/META.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/META.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,15 +1,40 @@
 <html>
-<head><title>META.html  --  ACL2 Version 6.2</title></head>
+<head><title>META.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>META</h2>make a <code>:meta</code> rule (a hand-written simplifier)
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and how they are
-used to build rules from formulas.  Meta rules extend the ACL2 simplifier
-with hand-written code to transform certain terms to equivalent ones.  To add
-a meta rule, the <code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula must establish that the
-hand-written ``metafunction'' preserves the meaning of the transformed term.</p><p>While our intention is that the set of ACL2 documentation topics is
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>Meta rules extend the ACL2 simplifier with hand-written code to transform
+certain terms to equivalent ones.  To add a meta rule, the
+<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula must establish that the hand-written
+``metafunction'' preserves the meaning of the transformed term.</p><p>
+<pre>
+Examples:
+(defthm fn-correct-1                ; Modify the rewriter to use fn to
+  (equal (evl x a)                  ; transform terms that are calls of
+         (evl (fn x) a))            ; nth or of foo.
+  :rule-classes ((:meta :trigger-fns (nth foo))))
+
+(defthm fn-correct-2                ; As above, but this illustrates
+  (implies (and (pseudo-termp x)    ; that without loss of generality we
+                (alistp a))         ; may restrict x to be shaped like a
+           (equal (evl x a)         ; term and a to be an alist.
+                  (evl (fn x) a)))
+  :rule-classes ((:meta :trigger-fns (nth foo))))
+
+(defthm fn-correct-3                ; As above (with or without the
+  (implies (and (pseudo-termp x)    ; hypotheses on x and a), with the
+                (alistp a)          ; additional restriction that the
+                (evl (hyp-fn x) a)) ; meaning of (hyp-fn x) is true in
+           (equal (evl x a)         ; the current context.  That is, the
+                  (evl (fn x) a)))  ; applicability of the transformation
+  :rule-classes                     ; may be dependent upon some computed
+  ((:meta :trigger-fns (nth foo)))) ; hypotheses.
+</pre>
+</p><p>While our intention is that the set of ACL2 documentation topics is
 self-contained, readers might find it useful to see the following paper for
 an introduction to meta reasoning in ACL2.
 </p>
@@ -17,34 +42,7 @@
 W. A. Hunt, Jr., R. B. Krug, M. Kaufmann, J S. Moore and E. W. Smith, ``Meta
 Reasoning in ACL2.''  TPHOLs 2005, ed. J. Hurd and T. F. Melham, LNCS 3603,
 Springer-Verlag, Berlin, 2005, pp. 163-178.</p></blockquote>
-<p></p><p>Example <code>:</code><code><a href="COROLLARY.html">corollary</a></code> formulas from which <code>:meta</code> rules might be
-built are:
-
-<pre>
-Examples:
-(equal (evl x a)                  ; Modify the rewriter to use fn to
-       (evl (fn x) a))            ; transform terms.  The :trigger-fns
-                                  ; of the :meta rule-class specify
-                                  ; the top-most function symbols of
-                                  ; those x that are candidates for
-                                  ; this transformation.
-
-(implies (and (pseudo-termp x)    ; As above, but this illustrates
-              (alistp a))         ; that without loss of generality we
-         (equal (evl x a)         ; may restrict x to be shaped like a
-                (evl (fn x) a)))  ; term and a to be an alist.
-
-(implies (and (pseudo-termp x)    ; As above (with or without the
-              (alistp a)          ; hypotheses on x and a) with the
-              (evl (hyp-fn x) a)) ; additional restriction that the
-         (equal (evl x a)         ; meaning of (hyp-fn x) is true in
-                (evl (fn x) a)))  ; the current context.  That is, the
-                                  ; applicability of the transforma-
-                                  ; tion may be dependent upon some
-                                  ; computed hypotheses.
-</pre>
-
-A non-<code>nil</code> list of function symbols must be supplied as the value
+<p></p><p>A non-<code>nil</code> list of function symbols must be supplied as the value
 of the <code>:trigger-fns</code> field in a <code>:meta</code> rule class object
 (except that a macro alias can stand in for a function symbol;
 see <a href="ADD-MACRO-ALIAS.html">add-macro-alias</a>).
diff -Nru acl2-6.2/doc/HTML/MIN.html acl2-6.3/doc/HTML/MIN.html
--- acl2-6.2/doc/HTML/MIN.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MIN.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MIN.html  --  ACL2 Version 6.2</title></head>
+<head><title>MIN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MIN</h3>the smaller of two numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MINIMAL-THEORY.html acl2-6.3/doc/HTML/MINIMAL-THEORY.html
--- acl2-6.2/doc/HTML/MINIMAL-THEORY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/MINIMAL-THEORY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MINIMAL-THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>MINIMAL-THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MINIMAL-THEORY</h2>a minimal theory to enable
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/MINUSP.html acl2-6.3/doc/HTML/MINUSP.html
--- acl2-6.2/doc/HTML/MINUSP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MINUSP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MINUSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>MINUSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MINUSP</h3>test whether a number is negative
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MISCELLANEOUS.html acl2-6.3/doc/HTML/MISCELLANEOUS.html
--- acl2-6.2/doc/HTML/MISCELLANEOUS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/MISCELLANEOUS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MISCELLANEOUS.html  --  ACL2 Version 6.2</title></head>
+<head><title>MISCELLANEOUS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>MISCELLANEOUS</h1>a miscellany of documented functions and concepts
 <code>   </code>               (often cited in more accessible <a href="DOCUMENTATION.html">documentation</a>)
@@ -49,7 +49,7 @@
 </h3>
 </li>
 
-<li><h3><a href="APROPOS.html">APROPOS</a> -- searching the documentation online
+<li><h3><a href="APROPOS.html">APROPOS</a> -- See <a href="FINDING-DOCUMENTATION.html">finding-documentation</a>.
 </h3>
 </li>
 
@@ -69,7 +69,7 @@
 </h3>
 </li>
 
-<li><h3><a href="BIND-FREE.html">BIND-FREE</a> -- to bind free variables of a rewrite or linear rule
+<li><h3><a href="BIND-FREE.html">BIND-FREE</a> -- to bind free variables of a rewrite, definition, or linear rule
 </h3>
 </li>
 
@@ -229,6 +229,10 @@
 </h3>
 </li>
 
+<li><h3><a href="FINDING-DOCUMENTATION.html">FINDING-DOCUMENTATION</a> -- searching the documentation
+</h3>
+</li>
+
 <li><h3><a href="FNCALL-TERM.html">FNCALL-TERM</a> -- See <a href="META-EXTRACT.html">meta-extract</a>.
 </h3>
 </li>
@@ -265,6 +269,10 @@
 </h3>
 </li>
 
+<li><h3><a href="GET-INTERNAL-TIME.html">GET-INTERNAL-TIME</a> -- runtime vs. realtime in ACL2 timings
+</h3>
+</li>
+
 <li><h3><a href="GET-WORMHOLE-STATUS.html">GET-WORMHOLE-STATUS</a> -- make a wormhole's status visible outside the wormhole
 </h3>
 </li>
@@ -305,6 +313,10 @@
 </h3>
 </li>
 
+<li><h3><a href="IGNORED-ATTACHMENT.html">IGNORED-ATTACHMENT</a> -- why attachments are sometimes not used
+</h3>
+</li>
+
 <li><h3><a href="IMMED-FORCED.html">IMMED-FORCED</a> -- See <a href="SPLITTER.html">splitter</a>.
 </h3>
 </li>
@@ -330,19 +342,19 @@
 </h3>
 </li>
 
-<li><h3><a href="LD-ERROR-ACTION.html">LD-ERROR-ACTION</a> -- determines <code><a href="LD.html">ld</a></code>'s response to an error
+<li><h3><a href="LAST-PROVER-STEPS.html">LAST-PROVER-STEPS</a> -- the number of prover steps most recently taken
 </h3>
 </li>
 
-<li><h3><a href="LD-ERROR-TRIPLES.html">LD-ERROR-TRIPLES</a> -- determines whether a form caused an error during <code><a href="LD.html">ld</a></code>
+<li><h3><a href="LD-ERROR-ACTION.html">LD-ERROR-ACTION</a> -- determines <code><a href="LD.html">ld</a></code>'s response to an error
 </h3>
 </li>
 
-<li><h3><a href="LD-EVISC-TUPLE.html">LD-EVISC-TUPLE</a> -- determines whether <code><a href="LD.html">ld</a></code> suppresses details when printing
+<li><h3><a href="LD-ERROR-TRIPLES.html">LD-ERROR-TRIPLES</a> -- determines whether a form caused an error during <code><a href="LD.html">ld</a></code>
 </h3>
 </li>
 
-<li><h3><a href="LD-KEYWORD-ALIASES.html">LD-KEYWORD-ALIASES</a> -- allows the abbreviation of some keyword commands
+<li><h3><a href="LD-EVISC-TUPLE.html">LD-EVISC-TUPLE</a> -- determines whether <code><a href="LD.html">ld</a></code> suppresses details when printing
 </h3>
 </li>
 
@@ -562,7 +574,7 @@
 </h3>
 </li>
 
-<li><h3><a href="SAVING-AND-RESTORING.html">SAVING-AND-RESTORING</a> -- saving and restoring your logical state
+<li><h3><a href="SAVING-AND-RESTORING.html">SAVING-AND-RESTORING</a> -- See <a href="SAVE-EXEC.html">save-exec</a>.
 </h3>
 </li>
 
@@ -614,7 +626,7 @@
 </h3>
 </li>
 
-<li><h3><a href="SYNTAXP.html">SYNTAXP</a> -- attach a heuristic filter on a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>, <code>:</code><code><a href="META.html">meta</a></code>, or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule
+<li><h3><a href="SYNTAXP.html">SYNTAXP</a> -- attach a heuristic filter on a rule
 </h3>
 </li>
 
diff -Nru acl2-6.2/doc/HTML/MOD-EXPT.html acl2-6.3/doc/HTML/MOD-EXPT.html
--- acl2-6.2/doc/HTML/MOD-EXPT.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MOD-EXPT.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MOD-EXPT.html  --  ACL2 Version 6.2</title></head>
+<head><title>MOD-EXPT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MOD-EXPT</h3>exponential function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MOD.html acl2-6.3/doc/HTML/MOD.html
--- acl2-6.2/doc/HTML/MOD.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MOD.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MOD.html  --  ACL2 Version 6.2</title></head>
+<head><title>MOD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MOD</h3>remainder using <code><a href="FLOOR.html">floor</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MODE.html acl2-6.3/doc/HTML/MODE.html
--- acl2-6.2/doc/HTML/MODE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/MODE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MODE</h2>xargs keyword <code>:MODE</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/MONITOR.html acl2-6.3/doc/HTML/MONITOR.html
--- acl2-6.2/doc/HTML/MONITOR.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/MONITOR.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MONITOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>MONITOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MONITOR</h2>to monitor the attempted application of a rule name
 <pre>Major Section:  <a href="BREAK-REWRITE.html">BREAK-REWRITE</a>
diff -Nru acl2-6.2/doc/HTML/MONITORED-RUNES.html acl2-6.3/doc/HTML/MONITORED-RUNES.html
--- acl2-6.2/doc/HTML/MONITORED-RUNES.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/MONITORED-RUNES.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MONITORED-RUNES.html  --  ACL2 Version 6.2</title></head>
+<head><title>MONITORED-RUNES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MONITORED-RUNES</h2>print the <a href="MONITOR.html">monitor</a>ed <a href="RUNE.html">rune</a>s and their break conditions
 <pre>Major Section:  <a href="BREAK-REWRITE.html">BREAK-REWRITE</a>
diff -Nru acl2-6.2/doc/HTML/MORE-DOC.html acl2-6.3/doc/HTML/MORE-DOC.html
--- acl2-6.2/doc/HTML/MORE-DOC.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/MORE-DOC.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MORE-DOC.html  --  ACL2 Version 6.2</title></head>
+<head><title>MORE-DOC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MORE-DOC</h2>a continuation of the <code>:</code><code><a href="DOC.html">doc</a></code> <a href="DOCUMENTATION.html">documentation</a>
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/MORE.html acl2-6.3/doc/HTML/MORE.html
--- acl2-6.2/doc/HTML/MORE.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/MORE.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MORE.html  --  ACL2 Version 6.2</title></head>
+<head><title>MORE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MORE</h2>your response to <code>:</code><code><a href="DOC.html">doc</a></code> or <code>:</code><code><a href="MORE.html">more</a></code>'s ``<code>(type :more...)</code>''
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/MORE_bang_.html acl2-6.3/doc/HTML/MORE_bang_.html
--- acl2-6.2/doc/HTML/MORE_bang_.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/MORE_bang_.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MORE_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>MORE_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MORE!</h2>another response to ``(type :more for more, :more! for the rest)''
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/MSG.html acl2-6.3/doc/HTML/MSG.html
--- acl2-6.2/doc/HTML/MSG.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/MSG.html	2013-09-30 17:39:32.000000000 +0000
@@ -0,0 +1,127 @@
+<html>
+<head><title>MSG.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h3>MSG</h3>construct a ``message'' suitable for the <code>~@</code> directive of <code><a href="FMT.html">fmt</a></code>
+<pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
+</pre><p/>
+<p>
+See <a href="FMT.html">fmt</a> for background on formatted printing with ACL2.</p><p>We document <code>msg</code> precisely below, but first, we give an informal
+introduction and illustrate with an example.  Suppose you are writing a
+program that is to do some printing.  Typically, you will either pass the
+ACL2 state around (see <a href="PROGRAMMING-WITH-STATE.html">programming-with-state</a>) and use formatted printing
+functions that take the state as an argument (see <a href="FMT.html">fmt</a>)), or else you might
+avoid using state by calling the utility, <code><a href="CW.html">cw</a></code>, to do you printing.
+Alternatively, you might print error messages upon encountering illegal
+situations; see <a href="ER.html">er</a>.  But there are times where instead of printing
+immediately, you may prefer to pass messages around, for example to
+accumulate them before printing a final message.  In such cases, it may be
+desirable to construct ``message'' objects to pass around.</p><p>For example, consider the following pair of little programs.  The first
+either performs a computation or prints an error, and the second calls the
+first on two inputs.
+
+<pre>
+
+(defun invert1 (x)
+  (if (consp x)
+      (cons (cdr x) (car x))
+    (prog2$ (cw "ERROR: ~x0 expected a cons, but was given ~x1.~|"
+                'invert1 x)
+            nil)))
+
+(defun invert2 (x1 x2)
+  (list (invert1 x1) (invert1 x2)))
+
+</pre>
+
+For example:
+
+<pre>
+
+  ACL2 !&gt;(invert1 '(3 . 4))
+  (4 . 3)
+  ACL2 !&gt;(invert1 'a)
+  ERROR: INVERT1 expected a cons, but was given A.
+  NIL
+  ACL2 !&gt;(invert2 '(3 . 4) '(5 . 6))
+  ((4 . 3) (6 . 5))
+  ACL2 !&gt;(invert2 'a 'b)
+  ERROR: INVERT1 expected a cons, but was given A.
+  ERROR: INVERT1 expected a cons, but was given B.
+  (NIL NIL)
+  ACL2 !&gt;
+
+</pre>
+
+Notice that when there are errors, there is no attempt to explain that these
+are due to a call of <code>invert2</code>.  That could be fixed, of course, by
+arranging for <code>invert2</code> to print its own error; but for complicated
+programs it can be awkward to coordinate printing from many sources.  So
+let's try a different approach.  This time, the first function returns two
+results.  The first result is an ``error indicator'' -- either a message
+object or <code>nil</code> -- while the second is the computed value (only of
+interest when the first result is <code>nil</code>).  Then the higher-level function
+can print a single error message that includes the error message(s) from the
+lower-level function, as shown below.
+
+<pre>
+
+(defun invert1a (x)
+  (if (consp x)
+      (mv nil
+          (cons (cdr x) (car x)))
+    (mv (msg "ERROR: ~x0 expected a cons, but was given ~x1.~|"
+             'invert1a x)
+        nil)))
+
+(defun invert2a (x1 x2)
+  (mv-let (erp1 y1)
+          (invert1a x1)
+          (mv-let (erp2 y2)
+                  (invert1a x2)
+                  (if erp1
+                      (if erp2
+                          (cw "~x0 failed with two errors:~|  ~@1  ~@2"
+                              'invert2a erp1 erp2)
+                        (cw "~x0 failed with one error:~|  ~@1"
+                            'invert2a erp1))
+                    (if erp2
+                        (cw "~x0 failed with one error:~|  ~@1"
+                            'invert2a erp2)
+                      (list y1 y2))))))
+</pre>
+
+For example:
+
+<pre>
+  ACL2 !&gt;(invert2a '(3 . 4) '(5 . 6))
+  ((4 . 3) (6 . 5))
+  ACL2 !&gt;(invert2a '(3 . 4) 'b)
+  INVERT2A failed with one error:
+    ERROR: INVERT1A expected a cons, but was given B.
+  NIL
+  ACL2 !&gt;(invert2a 'a 'b)
+  INVERT2A failed with two errors:
+    ERROR: INVERT1A expected a cons, but was given A.
+    ERROR: INVERT1A expected a cons, but was given B.
+  NIL
+  ACL2 !&gt;
+</pre>
+</p><p>If you study the example above, you might well understand <code>msg</code>.  But we
+conclude with precise documentation.
+</p>
+<p>
+<pre>
+General Form:
+(msg str arg1 ... argk)
+</pre>
+
+where <code>str</code> is a string and <code>k</code> is at most 9.</p><p>This macro returns a pair suitable for giving to the <code>fmt</code> directive
+<code>~@</code>.  Thus, suppose that <code>#\c</code> is bound to the value of
+<code>(msg str arg1 ... argk)</code>, where <code>c</code> is a character and <code>k</code> is at most
+9.  Then the <code>fmt</code> directive <code>~@c</code> will print out the string, <code>str</code>,
+in the context of the alist in which the successive <code>fmt</code> variables
+<code>#\0</code>, <code>#\1</code>, ..., <code>#\k</code> are bound to the successive elements of
+<code>(arg1 ... argk)</code>.
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/MUST-BE-EQUAL.html acl2-6.3/doc/HTML/MUST-BE-EQUAL.html
--- acl2-6.2/doc/HTML/MUST-BE-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MUST-BE-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MUST-BE-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>MUST-BE-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MUST-BE-EQUAL</h3>attach code for execution
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MUTUAL-RECURSION-PROOF-EXAMPLE.html acl2-6.3/doc/HTML/MUTUAL-RECURSION-PROOF-EXAMPLE.html
--- acl2-6.2/doc/HTML/MUTUAL-RECURSION-PROOF-EXAMPLE.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/MUTUAL-RECURSION-PROOF-EXAMPLE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MUTUAL-RECURSION-PROOF-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>MUTUAL-RECURSION-PROOF-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>MUTUAL-RECURSION-PROOF-EXAMPLE</h4>a small proof about mutually recursive functions
 <pre>Major Section:  <a href="TUTORIAL5-MISCELLANEOUS-EXAMPLES.html">TUTORIAL5-MISCELLANEOUS-EXAMPLES</a>
@@ -21,7 +21,7 @@
   (cond ((atom term)
          (add-to-set-eq term ans))
         ((fquotep term) ans)
-        (t (free-vars1-lst (fargs term) ans))))
+        (t (free-vars1-lst (cdr term) ans))))
 
 (defun free-vars1-lst (lst ans)
   (cond ((atom lst) ans)
diff -Nru acl2-6.2/doc/HTML/MUTUAL-RECURSION.html acl2-6.3/doc/HTML/MUTUAL-RECURSION.html
--- acl2-6.2/doc/HTML/MUTUAL-RECURSION.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/MUTUAL-RECURSION.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MUTUAL-RECURSION.html  --  ACL2 Version 6.2</title></head>
+<head><title>MUTUAL-RECURSION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>MUTUAL-RECURSION</h2>define some mutually recursive functions
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/MV-LET.html acl2-6.3/doc/HTML/MV-LET.html
--- acl2-6.2/doc/HTML/MV-LET.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MV-LET.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MV-LET.html  --  ACL2 Version 6.2</title></head>
+<head><title>MV-LET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MV-LET</h3>calling multi-valued ACL2 functions
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MV-LIST.html acl2-6.3/doc/HTML/MV-LIST.html
--- acl2-6.2/doc/HTML/MV-LIST.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MV-LIST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MV-LIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>MV-LIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MV-LIST</h3>converting multiple-valued result to a single-valued list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MV-NTH.html acl2-6.3/doc/HTML/MV-NTH.html
--- acl2-6.2/doc/HTML/MV-NTH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MV-NTH.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MV-NTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>MV-NTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MV-NTH</h3>the mv-nth element (zero-based) of a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MV.html acl2-6.3/doc/HTML/MV.html
--- acl2-6.2/doc/HTML/MV.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MV.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MV.html  --  ACL2 Version 6.2</title></head>
+<head><title>MV.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MV</h3>returning a multiple value
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MV_qm_-LET.html acl2-6.3/doc/HTML/MV_qm_-LET.html
--- acl2-6.2/doc/HTML/MV_qm_-LET.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MV_qm_-LET.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MV_qm_-LET.html  --  ACL2 Version 6.2</title></head>
+<head><title>MV_qm_-LET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MV?-LET</h3>calling possibly multi-valued ACL2 functions
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/MV_qm_.html acl2-6.3/doc/HTML/MV_qm_.html
--- acl2-6.2/doc/HTML/MV_qm_.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/MV_qm_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>MV_qm_.html  --  ACL2 Version 6.2</title></head>
+<head><title>MV_qm_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>MV?</h3>return one or more values
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/Modeling_in_ACL2.html acl2-6.3/doc/HTML/Modeling_in_ACL2.html
--- acl2-6.2/doc/HTML/Modeling_in_ACL2.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Modeling_in_ACL2.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Modeling_in_ACL2.html  --  ACL2 Version 6.2</title></head>
+<head><title>Modeling_in_ACL2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Modeling in ACL2</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Models_in_Engineering.html acl2-6.3/doc/HTML/Models_in_Engineering.html
--- acl2-6.2/doc/HTML/Models_in_Engineering.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Models_in_Engineering.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Models_in_Engineering.html  --  ACL2 Version 6.2</title></head>
+<head><title>Models_in_Engineering.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Models in Engineering</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Models_of_Computer_Hardware_and_Software.html acl2-6.3/doc/HTML/Models_of_Computer_Hardware_and_Software.html
--- acl2-6.2/doc/HTML/Models_of_Computer_Hardware_and_Software.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Models_of_Computer_Hardware_and_Software.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Models_of_Computer_Hardware_and_Software.html  --  ACL2 Version 6.2</title></head>
+<head><title>Models_of_Computer_Hardware_and_Software.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Models of Computer Hardware and Software</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/NAME.html acl2-6.3/doc/HTML/NAME.html
--- acl2-6.2/doc/HTML/NAME.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/NAME.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NAME.html  --  ACL2 Version 6.2</title></head>
+<head><title>NAME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NAME</h2>syntactic rules on logical names
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/NAT-LISTP.html acl2-6.3/doc/HTML/NAT-LISTP.html
--- acl2-6.2/doc/HTML/NAT-LISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NAT-LISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NAT-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>NAT-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NAT-LISTP</h3>recognizer for a true list of natural  numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NATP.html acl2-6.3/doc/HTML/NATP.html
--- acl2-6.2/doc/HTML/NATP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NATP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NATP.html  --  ACL2 Version 6.2</title></head>
+<head><title>NATP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NATP</h3>a recognizer for the natural numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NESTED-STOBJS.html acl2-6.3/doc/HTML/NESTED-STOBJS.html
--- acl2-6.2/doc/HTML/NESTED-STOBJS.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/NESTED-STOBJS.html	2013-09-30 17:39:36.000000000 +0000
@@ -0,0 +1,561 @@
+<html>
+<head><title>NESTED-STOBJS.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>NESTED-STOBJS</h2>using <a href="STOBJ.html">stobj</a>s that contain stobjs
+<pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
+</pre><p/>
+<p>
+For this topic we assume that you already understand the basics of
+single-threaded objects in ACL2.  See <a href="STOBJ.html">stobj</a>, and in particular,
+see <a href="DEFSTOBJ.html">defstobj</a>.  The latter topic defers discussion of the ability to specify
+a stobj field that is itself a stobj or an array of stobjs.  That discussion
+is the subject of the present <a href="DOCUMENTATION.html">documentation</a> topic.</p><p>Our presentation is in four sections.  First we augment the documentation for
+<code><a href="DEFSTOBJ.html">defstobj</a></code> by explaining how stobjs may be specified for fields in a new
+stobj definition.  Then we explain an aliasing problem, which accounts for a
+prohibition against making direct calls to accessors and updaters involving
+stobj fields of stobjs.  Next, we introduce an ACL2 primitive, <code>stobj-let</code>,
+which provides the only way to read and write stobj components of stobjs.
+The final section provides precise documentation for <code>stobj-let</code>.</p><p>See also ACL2 community book <code>demos/modeling/nested-stobj-toy-isa.lisp</code> for
+a worked example, which applies nested stobj structures to defining
+interpreters.  A variety of small additional examples may be found in ACL2
+community book <code>misc/nested-stobj-tests.lisp</code>.  For further discussion, you
+are welcome to read the ``Essay on Nested Stobjs'', a long comment in ACL2
+source file <code>other-events.lisp</code>.  However, this documentation topic is
+intended to be self-contained for those familiar with <a href="STOBJ.html">stobj</a>s.</p><p>SECTION: Extension of <code><a href="DEFSTOBJ.html">defstobj</a></code> to permit <a href="STOBJ.html">stobj</a>s within stobjs</p><p>Recall that the <code>:type</code> keyword of a <code><a href="DEFSTOBJ.html">defstobj</a></code> field descriptor can be
+a ``type-indicator'' that specifies the type of the field as a
+type-spec (see <a href="TYPE-SPEC.html">type-spec</a>).  For example, the following specifies an integer
+field and a field that is an array of bytes.
+
+<pre>
+  (defstobj st
+    (int-field :type integer :initially 0)
+    (ar-field :type (array unsigned-byte (10)) :initially 0))
+</pre>
+
+But the <code>:type</code> of a stobj field descriptor may instead be based on a
+stobj.  For example, the following sequence of three <a href="EVENTS.html">events</a> is legal.
+The first field descriptor of <code>top</code>, named <code>sub1-field</code>, illustrates one
+new kind of value for <code>:type</code>: the name of a previously-introduced stobj,
+which here is <code>sub1</code>. The second field descriptor of <code>top</code>, named
+<code>sub2-ar-field</code>, illustrates the other new kind of value for <code>:type</code>: an
+array whose elements are specified by the name of a previously-introduced
+stobj, in this case, the stobj <code>sub2</code>.
+
+<pre>
+  (defstobj sub1 fld1)
+  (defstobj sub2 fld2)
+  (defstobj top
+    (sub1-field :type sub1)
+    (sub2-ar-field :type (array sub2 (10))))
+</pre>
+
+The <code>:initially</code> keyword is illegal for fields whose <code>:type</code> is a stobj
+or an array of stobjs.  Each such initial value is provided by a
+corresponding call of the stobj creator for that stobj.  In particular, in
+the case of an array of stobjs, the stobj creator is called once for each
+element of the array, so that the array elements are distinct.  For example,
+each element of <code>sub2-ar-field</code> in the example above is initially provided
+by a separate call of <code>create-sub2</code>.  Each initial element is thus unique,
+and in particular is distinct from the initial global value of the stobj.
+Similarly, the initial global stobj for <code>sub1</code> is distinct from the initial
+<code>sub1-field</code> field of the global stobj for <code>top</code>, as these result from
+separate calls of <code>create-sub1</code>.</p><p>When a stobj is used in a field of another stobj, we may refer to the former
+field as a ``child stobj'' and the latter stobj as a ``parent stobj''.  So in
+the example above, <code>sub1-field</code> is a child stobj of type <code>sub1</code> for
+parent stobj <code>top</code>, and <code>sub2-ar-field</code> is an array of child stobjs of
+type <code>sub2</code> for parent stobj <code>top</code>.  A child stobj has the same
+structural shape as the global stobj of its type, but as explained above,
+these are distinct structures.  We follow standard terminology by saying
+``isomorphic'' to indicate the same structural shape.  So for example, (the
+value of) <code>sub1-field</code> is isomorphic to <code>sub1</code>, though these are distinct
+structures.</p><p>SECTION: An aliasing problem</p><p>Before introducing <code>stobj-let</code> below, we provide motivatation for this
+ACL2 primitive.</p><p>Consider the following <a href="EVENTS.html">events</a>.
+
+<pre>
+  (defstobj child fld)
+  (defstobj parent
+    (fld2 :type child))
+</pre>
+
+Now suppose we could evaluate the following code, to be run immediately after
+admitting the two <code><a href="DEFSTOBJ.html">defstobj</a></code> events above.
+
+<pre>
+  (let* ((child (fld2 parent))
+         (child (update-fld 3 child)))
+    (mv child parent))
+</pre>
+
+Now logically there is no change to <code>parent</code>: <code>parent</code> is passed through
+unchanged.  We can indeed prove that fact!
+
+<pre>
+  (thm (equal (mv-nth 1
+                      (let* ((child (fld2 parent))
+                             (child (update-fld 3 child)))
+                        (mv child parent)))
+              parent))
+</pre>
+
+But recall that stobjs are updated with destructive assignments.  That is, we
+really are updating <code>(fld2 parent)</code> to be the new value of <code>child</code>,
+whether this is explained logically or not.  Thus, evaluation of the above
+<code><a href="LET_star_.html">let*</a></code> form does in fact change the actual global stobj, <code>parent</code>.</p><p>(Aside: Here is an explanation involving raw Lisp, for those who might find
+this useful.  We escape to raw Lisp and execute the following; note that
+<code>*the-live-parent*</code> is the Lisp variable representing the global value of
+<code>parent</code>.
+
+<pre>
+(let ((parent *the-live-parent*))
+  (let* ((child (fld2 parent))
+         (child (update-fld 4 child)))
+    (mv child parent)))
+</pre>
+
+Then, in raw Lisp, <code>(fld (fld2 *the-live-parent*))</code> evaluates to <code>4</code>,
+illustrating the destructive update.  End of Aside.)</p><p>Such aliasing can permit a change to a child stobj to cause a
+logically-inexplicable change to the parent stobj.  Similarly, unfettered
+accessing of stobj fields can result in logically inexplicable changes to the
+child stobj when the parent stobj is changed.  Thus, ACL2 disallows direct
+calls of stobj accessors and updaters for fields whose <code>:type</code> is a stobj
+or an array of stobjs.  Instead, ACL2 provides <code>stobj-let</code> for reading and
+writing such fields in a sound manner.</p><p>SECTION: Accessing and updating stobj fields of stobjs using <code>stobj-let</code></p><p>ACL2 provides a primitive, <code>stobj-let</code>, to access and update stobj fields
+of stobjs, in a manner that avoids the aliasing problem discussed above.  In
+this section we provide an informal introduction to <code>stobj-let</code>, using
+examples, to be followed in the next section by precise documentation.</p><p>We begin by returning to a slight variant of the example above.
+
+<pre>
+  (defstobj child fld)
+  (defstobj parent
+    (fld2 :type child)
+    fld3)
+</pre>
+
+The following form returns the result of updating the <code>fld2</code> field of
+<code>parent</code>, which is a stobj isomorphic to <code>child</code>, to have a value of 3.
+Below we explain the terms ``bindings'', ``producer variables'',
+``producer'', and ``consumer'', as well as how to understand this form.
+
+<pre>
+  (stobj-let
+   ((child (fld2 parent)))  ; bindings
+   (child)                  ; producer variable(s)
+   (update-fld 3 child)     ; producer
+   (update-fld3 'a parent)) ; consumer
+</pre>
+
+The four lines under ``<code>stobj-let</code>'' just above can be understood as
+follows.
+
+<pre>
+o Bindings:
+    Bind <code>child</code> to <code>(fld2 parent)</code>.
+o Producer variable(s) and producer:
+    Then bind the variable, <code>child</code>, to
+    the value of the producer, <code>(update-fld 3 child)</code>.
+o Implicit update of parent:
+    Update <code>fld2</code> of <code>parent</code> with the producer variable, <code>child</code>.
+o Consumer:
+    Finally, return <code>(update-fld3 'a parent)</code>.
+</pre>
+
+Thus, the logical expansion of the <code>stobj-let</code> form above is the following
+expression, though this is approximate (see below).
+
+<pre>
+  (let ((child (fld2 parent))) ; bindings
+    (let ((child (update-fld 3 child))) ; bind producer vars to producer
+      (let ((parent (update-fld2 child parent))) ; implicit update of parent
+        (update-fld3 'a parent))))
+</pre>
+
+The bindings always bind distinct names to child stobjs of a unique parent
+stobj, where the child stobj corresponds to the <code>:type</code> associated with the
+indicated accessor in the <code><a href="DEFSTOBJ.html">defstobj</a></code> form for the parent stobj.  Thus in
+this case, for the unique binding, variable <code>child</code> is bound to the stobj
+of `type' <code>child</code> for accessor <code>fld2</code> of the parent stobj, <code>parent</code>.
+We refer to <code>child</code> from the bindings as a ``stobj-let-bound variable''.
+Note also that the ``implicit extra step'' mentioned above is generated by
+macroexpansion of <code>stobj-let</code>; it logically updates the parent with new
+child values, just before calling the consumer.  Implementation note:
+Destructive updating in raw Lisp lets us omit this implicit extra step.</p><p>The form above is equivalent to the form displayed just below, which differs
+only in specifying an explicit stobj updater corresponding to the stobj
+accessor, <code>fld2</code>.  Here we show the default updater name, whose name has
+<code>"UPDATE-"</code> prepended to the name of the accessor.  But if the
+<code>:RENAMING</code> field of the <code>defstobj</code> event specified a different updater
+name corresponding to <code>fld2</code>, then that would need to be included where we
+have added <code>update-fld2</code> below.
+
+<pre>
+  (stobj-let
+   ((child (fld2 parent) update-fld2)) ; bindings, including updater(s)
+   (child)                  ; producer variables
+   (update-fld 3 child)     ; producer
+   (update-fld3 'a parent)) ; consumer
+</pre>
+</p><p>You can experiment using <code>:</code><code><a href="TRANS1.html">trans1</a></code> to see the single-step
+macroexpansion of a <code>stobj-let</code> form in the logic.  For example, here is
+how that works for a <code>stobj-let</code> form that binds three fields and updates
+two of them.  Notice that because more than one field is updated, an
+<code><a href="MV-LET.html">mv-let</a></code> form is generated to bind the two fields to their values
+returned by the producer, rather than a <code><a href="LET.html">let</a></code> form as previously
+generated.  First, let's introduce some events.</p><p>
+<pre>
+(defstobj child1 child1-fld)
+(defstobj child2 child2-fld)
+(defstobj child3 child3-fld)
+(defstobj mom
+  (fld1 :type child1)
+  (fld2 :type child2)
+  (fld3 :type child3))
+; Silly stub:
+(defun update-last-op (op mom)
+  (declare (xargs :stobjs mom))
+  (declare (ignore op))
+  mom)
+(defun new-mom (mom)
+  (declare (xargs :stobjs mom))
+  (stobj-let
+   ((child1 (fld1 mom))
+    (child2 (fld2 mom))
+    (child3 (fld3 mom)))
+   (child1 child3)
+   (let* ((child1 (update-child1-fld 'one child1))
+          (child3 (update-child3-fld 'three child3)))
+     (mv child1 child3))
+   (update-last-op 'my-compute mom)))
+</pre>
+
+Now let's look at the single-step macroexpansion of the above <code>stobj-let</code>
+form.
+
+<pre>
+ACL2 !&gt;:trans1 (stobj-let
+                ((child1 (fld1 mom))
+                 (child2 (fld2 mom))
+                 (child3 (fld3 mom)))
+                (child1 child3)
+                (let* ((child1 (update-child1-fld 'one child1))
+                       (child3 (update-child3-fld 'three child3)))
+                  (mv child1 child3))
+                (update-last-op 'my-compute mom))
+ (PROGN$
+  (LET
+   ((CHILD1 (FLD1 MOM))
+    (CHILD2 (FLD2 MOM))
+    (CHILD3 (FLD3 MOM)))
+   (DECLARE (IGNORABLE CHILD1 CHILD2 CHILD3))
+   (MV-LET
+      (CHILD1 CHILD3)
+      (CHECK-VARS-NOT-FREE (MOM)
+                           (LET* ((CHILD1 (UPDATE-CHILD1-FLD 'ONE CHILD1))
+                                  (CHILD3 (UPDATE-CHILD3-FLD 'THREE CHILD3)))
+                                 (MV CHILD1 CHILD3)))
+      (LET* ((MOM (UPDATE-FLD1 CHILD1 MOM))
+             (MOM (UPDATE-FLD3 CHILD3 MOM)))
+            (CHECK-VARS-NOT-FREE (CHILD1 CHILD2 CHILD3)
+                                 (UPDATE-LAST-OP 'MY-COMPUTE MOM))))))
+ACL2 !&gt;
+</pre>
+</p><p>If you try to evaluate a <code>stobj-let</code> form directly in the top-level loop,
+rather than from within a function body, you will get an error.  The example
+above illustrates how <code>stobj-let</code> may be used in function bodies; here is
+another example, presented using an edited log.
+
+<pre>
+  ACL2 !&gt;(defstobj child fld)
+
+  Summary
+  Form:  ( DEFSTOBJ CHILD ...)
+  Rules: NIL
+  Time:  0.02 seconds (prove: 0.00, print: 0.00, other: 0.02)
+   CHILD
+  ACL2 !&gt;(defstobj parent
+           (fld2 :type child)
+           fld3)
+
+  Summary
+  Form:  ( DEFSTOBJ PARENT ...)
+  Rules: NIL
+  Time:  0.02 seconds (prove: 0.00, print: 0.00, other: 0.02)
+   PARENT
+  ACL2 !&gt;(defun f (parent)
+           (declare (xargs :stobjs parent))
+           (stobj-let
+            ((child (fld2 parent)))   ; bindings
+            (child)                   ; producer variables
+            (update-fld 3 child)      ; producer
+            (update-fld3 'a parent))) ; consumer
+  [[output omitted]]
+   F
+  ACL2 !&gt;(f parent)
+  &lt;parent&gt;
+  ACL2 !&gt;(defun check-f (parent)
+           ; returns the value of the field of the child stobj
+           (declare (xargs :stobjs parent))
+           (stobj-let
+            ((child (fld2 parent))) ; bindings
+            (val)                   ; producer variables
+            (fld child)             ; producer
+            val))                   ; consumer
+  [[output omitted]]
+   CHECK-F
+  ACL2 !&gt;(check-f parent)
+  3
+  ACL2 !&gt;
+</pre>
+</p><p>Notice that the second function defined above, <code>check-f</code>, uses a
+<code>stobj-let</code> form that returns an ordinary value: it reads a value from a
+child stobj, but does not write to the child stobj, as indicated by the lack
+of a child stobj among the producer variables.  So for that <code>stobj-let</code>
+form, there is no implicit extra step.</p><p>We labeled a <code>stobj-let</code> expansion above as ``approximate'' for two
+reasons, which we give here informally.  (Now you know how to apply
+<code>:</code><code><a href="TRANS1.html">trans1</a></code> to that <code>stobj-let</code> call to see the precise expansion.)
+First, <code>stobj-let</code> declares the stobj-let-bound variables to be
+<code>ignorable</code> for the top <code>let</code> bindings.  Second, and more importantly,
+<code>stobj-let</code> imposes the following restrictions on the producer and
+consumer, to avoid the aliasing problem: it disallows references to the
+parent stobj in the producer and it also disallows references to any bound
+stobj (i.e., bound in the bindings) in the consumer.</p><p>We conclude this section with examples based on a slight variation of the
+nested stobj example from the first section above.  These events can also be
+found in ACL2 community book <code>misc/nested-stobj-tests.lisp</code>, immediately
+under the following comment:
+
+<pre>
+; As promised in :doc stobj-let, we begin with an example from that :doc.
+</pre>
+
+Note that some lemmas were needed in order to complete the <a href="GUARD.html">guard</a> proof
+for the function <code>update-top</code>, which may be found in the above file; they
+are omitted below.</p><p>First we introduce three stobjs.
+
+<pre>
+  (defstobj kid1 fld1)
+  (defstobj kid2 fld2)
+  (defstobj mom
+    (kid1-field :type kid1)
+    (kid2-ar-field :type (array kid2 (5)))
+    last-op)
+</pre>
+
+The next function takes a given index and a <code>mom</code> stobj, and swaps the
+value stored in the stobj in <code>mom</code>'s <code>kid2-ar-field</code> array at that index
+with the value stored in the stobj in <code>mom</code>'s <code>kid1-field</code> field.
+
+<pre>
+  (defun mom-swap-fields (index mom)
+    (declare (xargs :stobjs mom
+                    :guard (and (natp index)
+                                (&lt; index (kid2-ar-field-length mom)))))
+    (stobj-let
+     ((kid1 (kid1-field mom))
+      (kid2 (kid2-ar-fieldi index mom)))
+     (kid1 kid2)
+     (let* ((val1 (fld1 kid1))
+            (val2 (fld2 kid2))
+            (kid1 (update-fld1 val2 kid1))
+            (kid2 (update-fld2 val1 kid2)))
+       (mv kid1 kid2))
+     (update-last-op 'swap mom)))
+</pre>
+
+Function <code>mom.kid1-fld1</code> stores a given value in the given <code>mom</code>'s
+<code>kid1-fld1</code> field.
+
+<pre>
+  (defun mom.kid1-fld1 (val mom)
+    (declare (xargs :stobjs mom))
+    (stobj-let
+     ((kid1 (kid1-field mom)))
+     (kid1)
+     (update-fld1 val kid1)
+     (update-last-op val mom)))
+</pre>
+
+We next combine the two functions above, according to an <code>op</code> argument, as
+indicated by the following definition.
+
+<pre>
+  (defun update-mom (op mom)
+    (declare (xargs :stobjs mom))
+    (cond ((and (consp op)
+                (eq (car op) 'swap)
+                (natp (cdr op))
+                (&lt; (cdr op) (kid2-ar-field-length mom)))
+           (mom-swap-fields (cdr op) mom))
+          (t (mom.kid1-fld1 op mom))))
+</pre>
+
+The following checker function uses a <code>stobj-let</code> form like the ones above,
+a major difference being that the producer variable is not a stobj, since it
+does not modify the input stobj, <code>mom</code>.
+
+<pre>
+  (defun check-update-mom (index val1 val2 last-op mom)
+      (declare (xargs :stobjs mom
+                      :mode :program
+                      :guard
+                      (or (null index)
+                          (and (natp index)
+                               (&lt; index (kid2-ar-field-length mom))))))
+      (and (equal (last-op mom) last-op)
+           (stobj-let
+            ((kid1 (kid1-field mom))
+             (kid2 (kid2-ar-fieldi index mom)))
+            (val) ; producer variables
+            (and (equal val1 (fld1 kid1))
+                 (equal val2 (fld2 kid2)))
+            val)))
+</pre>
+
+Now let us run our update function to populate some fields within the <code>mom</code>
+stobj.
+
+<pre>
+  (let* ((mom ; set mom to (3 (x0 x1 x2 x3 x4))
+           (update-mom 3 mom))
+          (mom ; set mom to (x1 (x0 3 x2 x3 x4))
+           (update-mom '(swap . 1) mom))
+          (mom ; set mom to (7 (x0 3 x2 x3 x4))
+           (update-mom 7 mom))
+          (mom ; set mom to (x0 (7 3 x2 x3 x4))
+           (update-mom '(swap . 0) mom))
+          (mom ; set mom to (5 (7 3 x2 x3 x4))
+           (update-mom 5 mom))
+          (mom ; set mom to (7 (5 3 x2 x3 x4))
+           (update-mom '(swap . 0) mom)))
+     mom)
+</pre>
+
+Are the above values of 7, 5, and 3 as expected, with a last operation being
+a swap?  Yes!
+
+<pre>
+  ACL2 !&gt;(and (check-update-mom 0 7 5 'swap mom)
+              (check-update-mom 1 7 3 'swap mom))
+  T
+  ACL2 !&gt;
+</pre>
+
+Notice that above, we never tried to access two different entries of the
+array.  This can be done, but we need to bind two different stobjs to those
+fields.  Fortunately, congruent stobjs make this possible; see <a href="DEFSTOBJ.html">defstobj</a>, in
+particular the discussion of congruent stobjs.  Since we want to bind two
+stobjs to values in the array that are isomorphic to the stobj <code>kid2</code>, we
+introduce a stobj congruent to <code>kid2</code>.
+
+<pre>
+  (defstobj kid2a fld2a :congruent-to kid2)
+</pre>
+
+Then we can define our swapping function as follows.  The <a href="GUARD.html">guard</a> proof
+obligation includes the requirement that the two indices be distinct, again
+to avoid an aliasing problem.
+
+<pre>
+  (defun mom-swap-indices (i1 i2 mom)
+    (declare (xargs :stobjs mom
+                    :guard (and (natp i1)
+                                (&lt; i1 (kid2-ar-field-length mom))
+                                (natp i2)
+                                (&lt; i2 (kid2-ar-field-length mom))
+                                (not (equal i1 i2)))))
+    (stobj-let
+     ((kid2 (kid2-ar-fieldi i1 mom))
+      (kid2a (kid2-ar-fieldi i2 mom)))
+     (kid2 kid2a)
+     (let* ((val2 (fld2 kid2))
+            (val2a (fld2 kid2a))
+            (kid2 (update-fld2 val2a kid2))
+            (kid2a (update-fld2 val2 kid2a)))
+       (mv kid2 kid2a))
+     mom))
+</pre>
+
+The aforementioned community book, <code>misc/nested-stobj-tests.lisp</code>, contains
+a corresponding checker immediately following this definition.</p><p>SECTION: Precise documentation for <code>stobj-let</code></p><p>
+<pre>
+General Form:
+(stobj-let
+ BINDINGS
+ PRODUCER-VARIABLES
+ PRODUCER
+ CONSUMER)
+</pre>
+
+where <code>PRODUCER-VARIABLES</code> is a non-empty true list of legal variable names
+without duplicates, <code>PRODUCER</code> and <code>CONSUMER</code> are expressions, and
+<code>BINDINGS</code> is a list subject to the following requirements.</p><p><code>BINDINGS</code> is a non-empty true list of tuples, each of which has the form
+<code>(VAR ACCESSOR)</code> or <code>(VAR ACCESSOR UPDATER)</code>.  There is a stobj name,
+<code>ST</code>, previously introduced by <code><a href="DEFSTOBJ.html">defstobj</a></code> (not <code><a href="DEFABSSTOBJ.html">defabsstobj</a></code>), such
+that each <code>accessor</code> is of the form <code>(ACC ST)</code> or <code>(ACCi I ST)</code>, with
+the same stobj name (<code>ST</code>) for each binding.  In the case <code>(ACC ST)</code>,
+<code>ACC</code> is the accessor for a non-array field of <code>ST</code>.  In the case
+<code>(ACCi I ST)</code>, <code>ACCi</code> is the accessor for an array field of <code>ST</code>, and
+<code>I</code> is either a variable, a natural number, a list <code>(quote N)</code> where
+<code>N</code> is a natural number, or a symbol introduced by <code><a href="DEFCONST.html">defconst</a></code>.  If
+<code>UPDATER</code> is supplied, then it is a symbol that is the name of the stobj
+updater for the field of <code>ST</code> accessed by <code>ACCESSOR</code>.  If <code>UPDATER</code> is
+not supplied, then for the discussion below we consider it to be, implicitly,
+the symbol in the same package as the function symbol of <code>ACCESSOR</code> (i.e.,
+<code>ACC</code> or <code>ACCi</code>), obtained by prepending the string <code>"UPDATE-"</code> to
+the <code><a href="SYMBOL-NAME.html">symbol-name</a></code> of that function symbol.  Finally, <code>ACCESSOR</code> has a
+<a href="SIGNATURE.html">signature</a> specifying a return value that is either <code>ST</code> or is stobj
+that is congruent to <code>ST</code>.</p><p>If the conditions above are met, then the General Form expands to the one of
+the following expressions, depending on whether the list
+<code>PRODUCER-VARIABLES</code> has one member or more than one member, respectively.
+(But see below for extra code that may be inserted if there are stobj array
+accesses in <code>BINDINGS</code>.)  Here we write <code>STOBJ-LET-BOUND-VARS</code> for the
+list of variables <code>VAR</code> discussed above, i.e., for
+<code>(strip-cars BINDINGS)</code>.  And, we write <code>UPDATES</code> for the result of
+mapping through <code>PRODUCER-VARIABLES</code> and, for each variable <code>VAR</code> that
+has a binding <code>(VAR ACCESSOR UPDATER)</code> in <code>BINDINGS</code> (where <code>UPDATER</code>
+may be implicit, as discussed above), collect into <code>UPDATES</code> the tuple
+<code>(ST (UPDATER VAR ST))</code>.</p><p>For <code>PRODUCER-VARIABLES</code> = <code>(PRODUCER-VAR)</code>:
+
+<pre>
+  (let BINDINGS
+    (declare (ignorable . STOBJ-LET-BOUND-VARIABLES))
+    (let ((PRODUCER-VAR PRODUCER))
+      (let* UPDATES
+        CONSUMER)))
+</pre>
+</p><p>Otherwise:
+
+<pre>
+  (let BINDINGS
+    (declare (ignorable . STOBJ-LET-BOUND-VARIABLES))
+    (mv-let PRODUCER-VARS
+            PRODUCER
+            (let* UPDATES
+              CONSUMER)))
+</pre>
+
+Moreover, ACL2 places restrictions on the resulting expression: <code>ST</code> must
+not occur free in <code>PRODUCER</code>, and every variable in
+<code>STOBJ-LET-BOUND-VARIABLES</code> must not occur free in <code>CONSUMER</code>.</p><p><code>Stobj-let</code> forms can be evaluated using ordinary objects in theorem
+contexts, much as any form.  They can also, of course, appear in function
+bodis.  However, a <code>stobj-let</code> form cannot be evaluated directly in the
+top-level loop or other top-level contexts for execution (such as during
+<code><a href="MAKE-EVENT.html">make-event</a></code> expansion).</p><p>Finally, let <code>FORM</code> denote the form displayed above (either case).  We
+explain how <code>FORM</code> is actually replaced by an expression of the form
+<code>(PROGN$ ... FORM)</code>.  This expression generates an extra <a href="GUARD.html">guard</a> proof
+obligation, which guarantees that no aliasing occurs from binding two
+stobj-let-bound variables to the same array access.  So fix a stobj array
+accessor <code>ACCi</code> for which some stobj is bound to <code>(ACCi I ST)</code> in
+<code>BINDINGS</code>; we define an expression <code>ACCi-CHECK</code> as follows.  Collect up
+all such index expressions <code>I</code>, where if <code>I</code> is of the form <code>(quote N)</code>
+then replace <code>I</code> by <code>N</code>.  If the resulting list of index expressions for
+<code>ACCi</code> consists solely of distinct numbers, or if it is of length 1, then
+no extra check is generated for <code>ACCi</code>.  Otherwise, let <code>ACCi-CHECK</code> be
+the form <code>(chk-no-duplicatesp (list I1 ... Ik))</code>, where <code>I1</code>, ..., <code>Ik</code>
+are the index expressions for <code>ACCi</code>.  Note: <code>chk-no-duplicatesp</code> is a
+function that returns nil, but has a <a href="GUARD.html">guard</a> that its argument is an
+<code><a href="EQLABLE-LISTP.html">eqlable-listp</a></code> that satisfies <code><a href="NO-DUPLICATESP.html">no-duplicatesp</a></code>.  Finally, <code>FORM</code>
+is replaced by <code>(PROGN$ CHK1 ... CHKn FORM)</code>, where the <code>CHKm</code> range over
+all of the above <code>ACCi-CHECK</code>.
+</p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/NEVER-MEMOIZE.html acl2-6.3/doc/HTML/NEVER-MEMOIZE.html
--- acl2-6.2/doc/HTML/NEVER-MEMOIZE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/NEVER-MEMOIZE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NEVER-MEMOIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>NEVER-MEMOIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NEVER-MEMOIZE</h2>Mark a function as unsafe to memoize.
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/NFIX.html acl2-6.3/doc/HTML/NFIX.html
--- acl2-6.2/doc/HTML/NFIX.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NFIX.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NFIX.html  --  ACL2 Version 6.2</title></head>
+<head><title>NFIX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NFIX</h3>coerce to a natural number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NIL-GOAL.html acl2-6.3/doc/HTML/NIL-GOAL.html
--- acl2-6.2/doc/HTML/NIL-GOAL.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/NIL-GOAL.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NIL-GOAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>NIL-GOAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NIL-GOAL</h2>how to proceed when the prover generates a goal of <code>nil</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/NINTH.html acl2-6.3/doc/HTML/NINTH.html
--- acl2-6.2/doc/HTML/NINTH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NINTH.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NINTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>NINTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NINTH</h3>ninth member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NO-DUPLICATESP-EQ.html acl2-6.3/doc/HTML/NO-DUPLICATESP-EQ.html
--- acl2-6.2/doc/HTML/NO-DUPLICATESP-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NO-DUPLICATESP-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NO-DUPLICATESP-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>NO-DUPLICATESP-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NO-DUPLICATESP-EQ</h3>See <a href="NO-DUPLICATESP.html">no-duplicatesp</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NO-DUPLICATESP-EQUAL.html acl2-6.3/doc/HTML/NO-DUPLICATESP-EQUAL.html
--- acl2-6.2/doc/HTML/NO-DUPLICATESP-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NO-DUPLICATESP-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NO-DUPLICATESP-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>NO-DUPLICATESP-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NO-DUPLICATESP-EQUAL</h3>See <a href="NO-DUPLICATESP.html">no-duplicatesp</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NO-DUPLICATESP.html acl2-6.3/doc/HTML/NO-DUPLICATESP.html
--- acl2-6.2/doc/HTML/NO-DUPLICATESP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NO-DUPLICATESP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NO-DUPLICATESP.html  --  ACL2 Version 6.2</title></head>
+<head><title>NO-DUPLICATESP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NO-DUPLICATESP</h3>check for duplicates in a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NO-THANKS.html acl2-6.3/doc/HTML/NO-THANKS.html
--- acl2-6.2/doc/HTML/NO-THANKS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/NO-THANKS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NO-THANKS.html  --  ACL2 Version 6.2</title></head>
+<head><title>NO-THANKS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NO-THANKS</h2>hints keyword <code>:NO-THANKS</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/NON-EXEC.html acl2-6.3/doc/HTML/NON-EXEC.html
--- acl2-6.2/doc/HTML/NON-EXEC.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NON-EXEC.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NON-EXEC.html  --  ACL2 Version 6.2</title></head>
+<head><title>NON-EXEC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NON-EXEC</h3>mark code as non-executable
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NON-EXECUTABLE.html acl2-6.3/doc/HTML/NON-EXECUTABLE.html
--- acl2-6.2/doc/HTML/NON-EXECUTABLE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/NON-EXECUTABLE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NON-EXECUTABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>NON-EXECUTABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NON-EXECUTABLE</h2>xargs keyword <code>:NON-EXECUTABLE</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/NON-LINEAR-ARITHMETIC.html acl2-6.3/doc/HTML/NON-LINEAR-ARITHMETIC.html
--- acl2-6.2/doc/HTML/NON-LINEAR-ARITHMETIC.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/NON-LINEAR-ARITHMETIC.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NON-LINEAR-ARITHMETIC.html  --  ACL2 Version 6.2</title></head>
+<head><title>NON-LINEAR-ARITHMETIC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NON-LINEAR-ARITHMETIC</h2>Non-linear Arithmetic
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/NONLINEARP.html acl2-6.3/doc/HTML/NONLINEARP.html
--- acl2-6.2/doc/HTML/NONLINEARP.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/NONLINEARP.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NONLINEARP.html  --  ACL2 Version 6.2</title></head>
+<head><title>NONLINEARP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NONLINEARP</h2>hints keyword <code>:NONLINEARP</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/NONNEGATIVE-INTEGER-QUOTIENT.html acl2-6.3/doc/HTML/NONNEGATIVE-INTEGER-QUOTIENT.html
--- acl2-6.2/doc/HTML/NONNEGATIVE-INTEGER-QUOTIENT.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NONNEGATIVE-INTEGER-QUOTIENT.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NONNEGATIVE-INTEGER-QUOTIENT.html  --  ACL2 Version 6.2</title></head>
+<head><title>NONNEGATIVE-INTEGER-QUOTIENT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NONNEGATIVE-INTEGER-QUOTIENT</h3>natural number division function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NORMALIZE.html acl2-6.3/doc/HTML/NORMALIZE.html
--- acl2-6.2/doc/HTML/NORMALIZE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/NORMALIZE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NORMALIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>NORMALIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NORMALIZE</h2>xargs keyword <code>:NORMALIZE</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/NORMED.html acl2-6.3/doc/HTML/NORMED.html
--- acl2-6.2/doc/HTML/NORMED.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/NORMED.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NORMED.html  --  ACL2 Version 6.2</title></head>
+<head><title>NORMED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NORMED</h2>Normed objects are ACL2 Objects that are "canonical" or "unique" in a
 <code>   </code>certain sense.
diff -Nru acl2-6.2/doc/HTML/NOT.html acl2-6.3/doc/HTML/NOT.html
--- acl2-6.2/doc/HTML/NOT.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NOT.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOT.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOT</h3>logical negation
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-0.html acl2-6.3/doc/HTML/NOTE-2-0.html
--- acl2-6.2/doc/HTML/NOTE-2-0.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-0.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-0.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-0.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-0</h2>ACL2 Version 2.0 (July, 1997) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-1.html acl2-6.3/doc/HTML/NOTE-2-1.html
--- acl2-6.2/doc/HTML/NOTE-2-1.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-1.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-1</h2>ACL2 Version  2.1 (December, 1997) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-2.html acl2-6.3/doc/HTML/NOTE-2-2.html
--- acl2-6.2/doc/HTML/NOTE-2-2.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-2.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-2</h2>ACL2 Version  2.2 (August, 1998) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-3.html acl2-6.3/doc/HTML/NOTE-2-3.html
--- acl2-6.2/doc/HTML/NOTE-2-3.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-3.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-3.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-3</h2>ACL2 Version  2.3 (October, 1998) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-4.html acl2-6.3/doc/HTML/NOTE-2-4.html
--- acl2-6.2/doc/HTML/NOTE-2-4.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-4.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-4.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-4.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-4</h2>ACL2 Version  2.4 (August, 1999) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-5.html acl2-6.3/doc/HTML/NOTE-2-5.html
--- acl2-6.2/doc/HTML/NOTE-2-5.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-5.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-5.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-5.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-5</h2>ACL2 Version  2.5 (June, 2000) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-5_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-2-5_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-2-5_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-5_lparen_R_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-5_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-5_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-5(R)</h2>ACL2 Version  2.5(r) (June, 2000) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6-GUARDS.html acl2-6.3/doc/HTML/NOTE-2-6-GUARDS.html
--- acl2-6.2/doc/HTML/NOTE-2-6-GUARDS.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6-GUARDS.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6-GUARDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6-GUARDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-6-GUARDS</h3>ACL2 Version  2.6 Notes on Guard-related Changes
 <pre>Major Section:  <a href="NOTE-2-6.html">NOTE-2-6</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6-NEW-FUNCTIONALITY.html acl2-6.3/doc/HTML/NOTE-2-6-NEW-FUNCTIONALITY.html
--- acl2-6.2/doc/HTML/NOTE-2-6-NEW-FUNCTIONALITY.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6-NEW-FUNCTIONALITY.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6-NEW-FUNCTIONALITY.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6-NEW-FUNCTIONALITY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-6-NEW-FUNCTIONALITY</h3>ACL2 Version  2.6 Notes on New Functionality
 <pre>Major Section:  <a href="NOTE-2-6.html">NOTE-2-6</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6-OTHER.html acl2-6.3/doc/HTML/NOTE-2-6-OTHER.html
--- acl2-6.2/doc/HTML/NOTE-2-6-OTHER.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6-OTHER.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6-OTHER.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6-OTHER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-6-OTHER</h3>ACL2 Version  2.6 Notes on Other (Minor) Changes
 <pre>Major Section:  <a href="NOTE-2-6.html">NOTE-2-6</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6-PROOF-CHECKER.html acl2-6.3/doc/HTML/NOTE-2-6-PROOF-CHECKER.html
--- acl2-6.2/doc/HTML/NOTE-2-6-PROOF-CHECKER.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6-PROOF-CHECKER.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6-PROOF-CHECKER.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6-PROOF-CHECKER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-6-PROOF-CHECKER</h3>ACL2 Version  2.6 Notes on Proof-checker Changes
 <pre>Major Section:  <a href="NOTE-2-6.html">NOTE-2-6</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6-PROOFS.html acl2-6.3/doc/HTML/NOTE-2-6-PROOFS.html
--- acl2-6.2/doc/HTML/NOTE-2-6-PROOFS.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6-PROOFS.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6-PROOFS.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6-PROOFS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-6-PROOFS</h3>ACL2 Version  2.6 Notes on Changes in Proof Engine
 <pre>Major Section:  <a href="NOTE-2-6.html">NOTE-2-6</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6-RULES.html acl2-6.3/doc/HTML/NOTE-2-6-RULES.html
--- acl2-6.2/doc/HTML/NOTE-2-6-RULES.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6-RULES.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-6-RULES</h3>ACL2 Version  2.6 Notes on Changes in Rules and Constants
 <pre>Major Section:  <a href="NOTE-2-6.html">NOTE-2-6</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6-SYSTEM.html acl2-6.3/doc/HTML/NOTE-2-6-SYSTEM.html
--- acl2-6.2/doc/HTML/NOTE-2-6-SYSTEM.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6-SYSTEM.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6-SYSTEM.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6-SYSTEM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-6-SYSTEM</h3>ACL2 Version  2.6 Notes on System-level Changes
 <pre>Major Section:  <a href="NOTE-2-6.html">NOTE-2-6</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6.html acl2-6.3/doc/HTML/NOTE-2-6.html
--- acl2-6.2/doc/HTML/NOTE-2-6.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-6</h2>ACL2 Version  2.6 (November, 2001) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-6_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-2-6_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-2-6_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-6_lparen_R_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-6_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-6_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-6(R)</h2>ACL2 Version  2.6(r) (November, 2001) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7-BUG-FIXES.html acl2-6.3/doc/HTML/NOTE-2-7-BUG-FIXES.html
--- acl2-6.2/doc/HTML/NOTE-2-7-BUG-FIXES.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7-BUG-FIXES.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7-BUG-FIXES.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7-BUG-FIXES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-7-BUG-FIXES</h3>ACL2 Version  2.7 Notes on Bug Fixes
 <pre>Major Section:  <a href="NOTE-2-7.html">NOTE-2-7</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7-GUARDS.html acl2-6.3/doc/HTML/NOTE-2-7-GUARDS.html
--- acl2-6.2/doc/HTML/NOTE-2-7-GUARDS.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7-GUARDS.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7-GUARDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7-GUARDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-7-GUARDS</h3>ACL2 Version  2.7 Notes on Guard-related Changes
 <pre>Major Section:  <a href="NOTE-2-7.html">NOTE-2-7</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7-NEW-FUNCTIONALITY.html acl2-6.3/doc/HTML/NOTE-2-7-NEW-FUNCTIONALITY.html
--- acl2-6.2/doc/HTML/NOTE-2-7-NEW-FUNCTIONALITY.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7-NEW-FUNCTIONALITY.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7-NEW-FUNCTIONALITY.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7-NEW-FUNCTIONALITY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-7-NEW-FUNCTIONALITY</h3>ACL2 Version  2.7 Notes on New Functionality
 <pre>Major Section:  <a href="NOTE-2-7.html">NOTE-2-7</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7-OTHER.html acl2-6.3/doc/HTML/NOTE-2-7-OTHER.html
--- acl2-6.2/doc/HTML/NOTE-2-7-OTHER.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7-OTHER.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7-OTHER.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7-OTHER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-7-OTHER</h3>ACL2 Version  2.7 Notes on Miscellaneous Changes
 <pre>Major Section:  <a href="NOTE-2-7.html">NOTE-2-7</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7-PROOF-CHECKER.html acl2-6.3/doc/HTML/NOTE-2-7-PROOF-CHECKER.html
--- acl2-6.2/doc/HTML/NOTE-2-7-PROOF-CHECKER.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7-PROOF-CHECKER.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7-PROOF-CHECKER.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7-PROOF-CHECKER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-7-PROOF-CHECKER</h3>ACL2 Version  2.7 Notes on Proof-checker Changes
 <pre>Major Section:  <a href="NOTE-2-7.html">NOTE-2-7</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7-PROOFS.html acl2-6.3/doc/HTML/NOTE-2-7-PROOFS.html
--- acl2-6.2/doc/HTML/NOTE-2-7-PROOFS.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7-PROOFS.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7-PROOFS.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7-PROOFS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-7-PROOFS</h3>ACL2 Version  2.7 Notes on Changes in Proof Engine
 <pre>Major Section:  <a href="NOTE-2-7.html">NOTE-2-7</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7-RULES.html acl2-6.3/doc/HTML/NOTE-2-7-RULES.html
--- acl2-6.2/doc/HTML/NOTE-2-7-RULES.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7-RULES.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-7-RULES</h3>ACL2 Version  2.7 Notes on Changes in Rules and Constants
 <pre>Major Section:  <a href="NOTE-2-7.html">NOTE-2-7</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7-SYSTEM.html acl2-6.3/doc/HTML/NOTE-2-7-SYSTEM.html
--- acl2-6.2/doc/HTML/NOTE-2-7-SYSTEM.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7-SYSTEM.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7-SYSTEM.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7-SYSTEM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-7-SYSTEM</h3>ACL2 Version  2.7 Notes on System-level Changes
 <pre>Major Section:  <a href="NOTE-2-7.html">NOTE-2-7</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7.html acl2-6.3/doc/HTML/NOTE-2-7.html
--- acl2-6.2/doc/HTML/NOTE-2-7.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-7</h2>ACL2 Version  2.7 (November, 2002) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-7_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-2-7_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-2-7_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-7_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-7_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-7_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-7(R)</h2>ACL2 Version  2.7(r) (November, 2002) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-BUG-FIXES.html acl2-6.3/doc/HTML/NOTE-2-8-BUG-FIXES.html
--- acl2-6.2/doc/HTML/NOTE-2-8-BUG-FIXES.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-BUG-FIXES.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-BUG-FIXES.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-BUG-FIXES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-BUG-FIXES</h3>ACL2 Version  2.8 Notes on Bug Fixes
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-GUARDS.html acl2-6.3/doc/HTML/NOTE-2-8-GUARDS.html
--- acl2-6.2/doc/HTML/NOTE-2-8-GUARDS.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-GUARDS.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-GUARDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-GUARDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-GUARDS</h3>ACL2 Version  2.8 Notes on Guard-related Changes
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-NEW-FUNCTIONALITY.html acl2-6.3/doc/HTML/NOTE-2-8-NEW-FUNCTIONALITY.html
--- acl2-6.2/doc/HTML/NOTE-2-8-NEW-FUNCTIONALITY.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-NEW-FUNCTIONALITY.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-NEW-FUNCTIONALITY.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-NEW-FUNCTIONALITY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-NEW-FUNCTIONALITY</h3>ACL2 Version  2.8 Notes on New Functionality
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-ORDINALS.html acl2-6.3/doc/HTML/NOTE-2-8-ORDINALS.html
--- acl2-6.2/doc/HTML/NOTE-2-8-ORDINALS.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-ORDINALS.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-ORDINALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-ORDINALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-ORDINALS</h3>ACL2 Version  2.8 Notes on Changes to the Ordinals
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-OTHER.html acl2-6.3/doc/HTML/NOTE-2-8-OTHER.html
--- acl2-6.2/doc/HTML/NOTE-2-8-OTHER.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-OTHER.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-OTHER.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-OTHER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-OTHER</h3>ACL2 Version  2.8 Notes on Miscellaneous Changes
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-PROOF-CHECKER.html acl2-6.3/doc/HTML/NOTE-2-8-PROOF-CHECKER.html
--- acl2-6.2/doc/HTML/NOTE-2-8-PROOF-CHECKER.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-PROOF-CHECKER.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-PROOF-CHECKER.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-PROOF-CHECKER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-PROOF-CHECKER</h3>ACL2 Version  2.8 Notes on Proof-checker Changes
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-PROOFS.html acl2-6.3/doc/HTML/NOTE-2-8-PROOFS.html
--- acl2-6.2/doc/HTML/NOTE-2-8-PROOFS.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-PROOFS.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-PROOFS.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-PROOFS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-PROOFS</h3>ACL2 Version  2.8 Notes on Changes in Proof Engine
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-RULES.html acl2-6.3/doc/HTML/NOTE-2-8-RULES.html
--- acl2-6.2/doc/HTML/NOTE-2-8-RULES.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-RULES.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-RULES</h3>ACL2 Version  2.8 Notes on Changes in Rules, Definitions, and Constants
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8-SYSTEM.html acl2-6.3/doc/HTML/NOTE-2-8-SYSTEM.html
--- acl2-6.2/doc/HTML/NOTE-2-8-SYSTEM.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8-SYSTEM.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8-SYSTEM.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8-SYSTEM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-8-SYSTEM</h3>ACL2 Version  2.8 Notes on System-level Changes
 <pre>Major Section:  <a href="NOTE-2-8.html">NOTE-2-8</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8.html acl2-6.3/doc/HTML/NOTE-2-8.html
--- acl2-6.2/doc/HTML/NOTE-2-8.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-8</h2>ACL2 Version  2.8 (March, 2004) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-8_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-2-8_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-2-8_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-8_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-8_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-8_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-8(R)</h2>ACL2 Version  2.8(r) (March, 2003) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-9-1.html acl2-6.3/doc/HTML/NOTE-2-9-1.html
--- acl2-6.2/doc/HTML/NOTE-2-9-1.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-9-1.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-9-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-9-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-9-1</h2>ACL2 Version  2.9.1 (December, 2004) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-9-2.html acl2-6.3/doc/HTML/NOTE-2-9-2.html
--- acl2-6.2/doc/HTML/NOTE-2-9-2.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-9-2.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-9-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-9-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-9-2</h2>ACL2 Version  2.9.2 (April, 2005) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-9-3-PPR-CHANGE.html acl2-6.3/doc/HTML/NOTE-2-9-3-PPR-CHANGE.html
--- acl2-6.2/doc/HTML/NOTE-2-9-3-PPR-CHANGE.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-9-3-PPR-CHANGE.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-9-3-PPR-CHANGE.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-9-3-PPR-CHANGE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-2-9-3-PPR-CHANGE</h3>change in pretty-printing for ACL2 Version_2.9.3
 <pre>Major Section:  <a href="NOTE-2-9-3.html">NOTE-2-9-3</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-9-3.html acl2-6.3/doc/HTML/NOTE-2-9-3.html
--- acl2-6.2/doc/HTML/NOTE-2-9-3.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-9-3.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-9-3.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-9-3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-9-3</h2>ACL2 Version  2.9.3 (August, 2005) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-9-4.html acl2-6.3/doc/HTML/NOTE-2-9-4.html
--- acl2-6.2/doc/HTML/NOTE-2-9-4.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-9-4.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-9-4.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-9-4.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-9-4</h2>ACL2 Version  2.9.4 (February, 2006) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-9-5.html acl2-6.3/doc/HTML/NOTE-2-9-5.html
--- acl2-6.2/doc/HTML/NOTE-2-9-5.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-9-5.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-9-5.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-9-5.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-9-5</h2>Changes in Version  3.0 since Version  2.9.4
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-9.html acl2-6.3/doc/HTML/NOTE-2-9.html
--- acl2-6.2/doc/HTML/NOTE-2-9.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-9.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-9.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-9.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-9</h2>ACL2 Version  2.9 (October, 2004) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-2-9_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-2-9_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-2-9_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-2-9_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-2-9_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-2-9_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-2-9(R)</h2>ACL2 Version  2.9(r) (October, 2004) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-0-1.html acl2-6.3/doc/HTML/NOTE-3-0-1.html
--- acl2-6.2/doc/HTML/NOTE-3-0-1.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-0-1.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-0-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-0-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-0-1</h2>ACL2 Version  3.0.1 (August, 2006) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-0-1_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-0-1_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-0-1_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-0-1_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-0-1_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-0-1_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-0-1(R)</h2>ACL2 Version  3.0.1(r) (August, 2006) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-0-2.html acl2-6.3/doc/HTML/NOTE-3-0-2.html
--- acl2-6.2/doc/HTML/NOTE-3-0-2.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-0-2.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-0-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-0-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-0-2</h2>ACL2 Version  3.0.2 (December, 2006) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-0.html acl2-6.3/doc/HTML/NOTE-3-0.html
--- acl2-6.2/doc/HTML/NOTE-3-0.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-0.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-0.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-0.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-0</h2>ACL2 Version  3.0 (June, 2006) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-0_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-0_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-0_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-0_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-0_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-0_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-0(R)</h2>ACL2 Version  3.0(r) (June, 2006) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-1.html acl2-6.3/doc/HTML/NOTE-3-1.html
--- acl2-6.2/doc/HTML/NOTE-3-1.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-1.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-1</h2>ACL2 Version  3.1 (December, 2006) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-1_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-1_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-1_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-1_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-1_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-1_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-1(R)</h2>ACL2 Version  3.1(r) (December, 2006) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-2-1.html acl2-6.3/doc/HTML/NOTE-3-2-1.html
--- acl2-6.2/doc/HTML/NOTE-3-2-1.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-2-1.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-2-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-2-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-2-1</h2>ACL2 Version  3.2.1 (June, 2007) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-2-1_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-2-1_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-2-1_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-2-1_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-2-1_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-2-1_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-2-1(R)</h2>ACL2 Version  3.2.1(r) (June, 2007) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-2.html acl2-6.3/doc/HTML/NOTE-3-2.html
--- acl2-6.2/doc/HTML/NOTE-3-2.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-2.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-2</h2>ACL2 Version  3.2 (April, 2007) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-2_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-2_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-2_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-2_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-2_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-2_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-2(R)</h2>ACL2 Version  3.2(r) (April, 2007) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-3.html acl2-6.3/doc/HTML/NOTE-3-3.html
--- acl2-6.2/doc/HTML/NOTE-3-3.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-3.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-3.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-3</h2>ACL2 Version  3.3 (November, 2007) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-3_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-3_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-3_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-3_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-3_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-3_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-3(R)</h2>ACL2 Version  3.3(r) (November, 2007) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-4.html acl2-6.3/doc/HTML/NOTE-3-4.html
--- acl2-6.2/doc/HTML/NOTE-3-4.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-4.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-4.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-4.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-4</h2>ACL2 Version  3.4 (August, 2008) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-4_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-4_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-4_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-4_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-4_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-4_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-4(R)</h2>ACL2 Version  3.4(r) (August, 2008) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-5.html acl2-6.3/doc/HTML/NOTE-3-5.html
--- acl2-6.2/doc/HTML/NOTE-3-5.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-5.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-5.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-5.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-5</h2>ACL2 Version  3.5 (May, 2009) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-5_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-5_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-5_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-5_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-5_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-5_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-5(R)</h2>ACL2 Version  3.5(r) (May, 2009) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-6-1.html acl2-6.3/doc/HTML/NOTE-3-6-1.html
--- acl2-6.2/doc/HTML/NOTE-3-6-1.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-6-1.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-6-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-6-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-6-1</h2>ACL2 Version  3.6.1 (September, 2009) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-6.html acl2-6.3/doc/HTML/NOTE-3-6.html
--- acl2-6.2/doc/HTML/NOTE-3-6.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-6.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-6.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-6.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-6</h2>ACL2 Version  3.6 (August, 2009) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-3-6_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-3-6_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-3-6_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-3-6_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-3-6_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-3-6_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-3-6(R)</h2>ACL2 Version  3.6(r) (August, 2009) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-0-WORMHOLE-CHANGES.html acl2-6.3/doc/HTML/NOTE-4-0-WORMHOLE-CHANGES.html
--- acl2-6.2/doc/HTML/NOTE-4-0-WORMHOLE-CHANGES.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-0-WORMHOLE-CHANGES.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-0-WORMHOLE-CHANGES.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-0-WORMHOLE-CHANGES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NOTE-4-0-WORMHOLE-CHANGES</h3>how to convert calls of wormhole for Version  4.0
 <pre>Major Section:  <a href="NOTE-4-0.html">NOTE-4-0</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-0.html acl2-6.3/doc/HTML/NOTE-4-0.html
--- acl2-6.2/doc/HTML/NOTE-4-0.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-0.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-0.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-0.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-4-0</h2>ACL2 Version  4.0 (July, 2010) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-0_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-4-0_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-4-0_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-0_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-0_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-0_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-4-0(R)</h2>ACL2 Version  4.0(r) (July, 2010) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-1.html acl2-6.3/doc/HTML/NOTE-4-1.html
--- acl2-6.2/doc/HTML/NOTE-4-1.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-1.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-4-1</h2>ACL2 Version  4.1 (September, 2010) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-1_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-4-1_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-4-1_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-1_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-1_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-1_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-4-1(R)</h2>ACL2 Version  4.1(r) (September, 2010) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-2.html acl2-6.3/doc/HTML/NOTE-4-2.html
--- acl2-6.2/doc/HTML/NOTE-4-2.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-2.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-4-2</h2>ACL2 Version  4.2 (January, 2011) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-2_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-4-2_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-4-2_lparen_R_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-2_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-2_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-2_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-4-2(R)</h2>ACL2 Version  4.2(r) (January, 2011) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-3.html acl2-6.3/doc/HTML/NOTE-4-3.html
--- acl2-6.2/doc/HTML/NOTE-4-3.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-3.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-3.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-4-3</h2>ACL2 Version  4.3 (July, 2011) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-4-3_lparen_R_rparen_.html acl2-6.3/doc/HTML/NOTE-4-3_lparen_R_rparen_.html
--- acl2-6.2/doc/HTML/NOTE-4-3_lparen_R_rparen_.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-4-3_lparen_R_rparen_.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-4-3_lparen_R_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-4-3_lparen_R_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-4-3(R)</h2>ACL2 Version  4.3(r) (July, 2011) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-5-0.html acl2-6.3/doc/HTML/NOTE-5-0.html
--- acl2-6.2/doc/HTML/NOTE-5-0.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-5-0.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-5-0.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-5-0.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-5-0</h2>ACL2 Version  5.0 (August, 2012) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-6-0.html acl2-6.3/doc/HTML/NOTE-6-0.html
--- acl2-6.2/doc/HTML/NOTE-6-0.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-6-0.html	2013-09-30 17:39:35.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-6-0.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-6-0.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-6-0</h2>ACL2 Version  6.0 (December, 2012) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-6-1.html acl2-6.3/doc/HTML/NOTE-6-1.html
--- acl2-6.2/doc/HTML/NOTE-6-1.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-6-1.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-6-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-6-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-6-1</h2>ACL2 Version  6.1 (February, 2013) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE-6-2.html acl2-6.3/doc/HTML/NOTE-6-2.html
--- acl2-6.2/doc/HTML/NOTE-6-2.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-6-2.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE-6-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE-6-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE-6-2</h2>ACL2 Version  6.2 (June, 2013) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
@@ -7,7 +7,7 @@
 <p>
 NOTE!  New users can ignore these release notes, because the
 <a href="DOCUMENTATION.html">documentation</a> has been updated to reflect all changes that are recorded
-here.</p><p>Below we roughly organize the changes since Version  6.1 into the following
+here.</p><p>Below we roughly organize the changes since Version 6.1 into the following
 categories of changes: existing features, new features, heuristic
 improvements, bug fixes, changes at the system level, Emacs support, and
 experimental versions.  Each change is described in just one category, though
diff -Nru acl2-6.2/doc/HTML/NOTE-6-3.html acl2-6.3/doc/HTML/NOTE-6-3.html
--- acl2-6.2/doc/HTML/NOTE-6-3.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE-6-3.html	2013-09-30 17:39:36.000000000 +0000
@@ -0,0 +1,180 @@
+<html>
+<head><title>NOTE-6-3.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>NOTE-6-3</h2>ACL2 Version  6.3 (October, 2013) Notes
+<pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
+</pre><p/>
+<p>
+NOTE!  New users can ignore these release notes, because the
+<a href="DOCUMENTATION.html">documentation</a> has been updated to reflect all changes that are recorded
+here.</p><p>Below we roughly organize the changes since Version  6.2 into the following
+categories of changes: existing features, new features, heuristic
+improvements, bug fixes, changes at the system level, Emacs support, and
+experimental versions.  Each change is described in just one category, though
+of course many changes could be placed in more than one category.</p><p><strong>CHANGES TO EXISTING FEATURES</strong></p><p>The evaluation of a term from a <code><a href="BIND-FREE.html">bind-free</a></code> hypothesis had been expected
+to produce an alist binding free variables to terms.  While that is still
+legal, it is also legal for that evaluation to produce a list of such alists:
+then each is considered, until one of them permits all remaining hypotheses
+to be relieved.  See <a href="BIND-FREE.html">bind-free</a>.  Thanks to Sol Swords for requesting this
+enhancement.</p><p>ACL2 continues to provide a way to specify keyword command abbreviations for
+the top-level loop; see <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.  However,
+<code><a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a></code> is now a <a href="TABLE.html">table</a> rather than a <a href="STATE.html">state</a> global;
+it is thus no longer a so-called <a href="LD.html">LD</a> special.  The functionality of
+<code>set-ld-keyword-aliases</code> has essentially been preserved, except that it is
+now an event (see <a href="EVENTS.html">events</a>), hence it may appear in a book; it is <a href="LOCAL.html">local</a>
+to a book (or <code><a href="ENCAPSULATE.html">encapsulate</a></code> event); and the <code><a href="STATE.html">state</a></code> argument is
+optional, and deprecated.  A non-local version (<code>set-ld-keyword-aliases!</code>)
+has been added, along with corresponding utilities <code>add-keyword-alias</code> and
+<code>add-keyword-alias!</code> for adding a single keyword alias.
+See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.  Thanks to Jared Davis for correspondence that led us
+to make this change.</p><p>The <a href="PROOF-CHECKER.html">proof-checker</a> command <code>(exit t)</code> now exits without a query (but
+still prints an event to show the <code>:INSTRUCTIONS</code>).  Thanks to Warren Hunt
+for feedback leading us to make this change.</p><p>We made the following minor changes to the behavior or <code>dmr</code>; see <a href="DMR.html">dmr</a>.
+First, if <code>dmr</code> monitoring is enabled, then <code>(dmr-start)</code> will have no
+effect other than to print a corresponding observation, and if monitoring is
+disabled, then <code>(dmr-stop)</code> will have no effect other than to print a
+corresponding observation.  Second, it had been the case that when
+<code>(dmr-start)</code> is invoked, the debugger was always automatically enabled
+with value <code>t</code> (see <a href="SET-DEBUGGER-ENABLE.html">set-debugger-enable</a>), and the debugger remained
+enabled when <code>(dmr-stop)</code> was invoked.  Now, the debugger is only enabled
+by <code>(dmr-start)</code> if it is not already enabled and does not have setting
+<code>:never</code>.  Moreover, if such automatic enabling takes place, then the old
+setting for the debugger is restored by <code>(dmr-stop)</code> unless
+<code><a href="SET-DEBUGGER-ENABLE.html">set-debugger-enable</a></code> has first been called after that automatic
+enabling.  Finally, if the value of <a href="STATE.html">state</a> global variable
+<code>'debugger-enable</code> is <code>:bt</code>, then the new value will be <code>:break-bt</code>,
+not <code>t</code>.</p><p>When a call of <code><a href="PROGN.html">progn</a></code> is executed in the ACL2 loop, its constituent
+<a href="EVENTS.html">events</a> and their results are printed, just as was already done for calls
+of <code><a href="ENCAPSULATE.html">encapsulate</a></code>.  Thanks to Jared Davis for a conversation causing us to
+consider this change.</p><p>(CCL only) When <code><a href="SET-DEBUGGER-ENABLE.html">set-debugger-enable</a></code> is invoked with an argument that
+prints a backtrace and CCL is the host Lisp, the backtrace will be limited to
+10,000 stack frames.  (We have seen more than 65,000 stack frames before this
+change.)  This limit is the value of raw Lisp variable
+<code>*ccl-print-call-history-count*</code>, which may be assigned another positive
+integer value to serve as the maximum number of stack frames to be printed.</p><p>Improvements have been made pertaining to the disabling (inhibiting) of
+individual types of warning.  Now, inhibited warnings are implemented in a
+straightforward way using a separate <a href="TABLE.html">table</a> for this purpose, the
+<code>inhibit-warnings-table</code>, rather than using the <code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code>.
+See <a href="SET-INHIBIT-WARNINGS.html">set-inhibit-warnings</a>, and see <a href="SET-INHIBIT-WARNINGS_bang_.html">set-inhibit-warnings!</a> for a variant that
+is not <code><a href="LOCAL.html">local</a></code> to an <code><a href="ENCAPSULATE.html">encapsulate</a></code> or a book in which it occurs.
+Thanks to Sol Swords for sending examples showing how
+<code><a href="SET-INHIBIT-WARNINGS.html">set-inhibit-warnings</a></code> did not always behave as one might reasonably
+expect when books are involved.</p><p>It had been the case that <code><a href="LP.html">lp</a></code> took a single argument, <code>'raw</code>.  This
+argument was not documented and also caused an error, so it has been
+eliminated.</p><p>The functionality of <code><a href="MAKE-EVENT.html">make-event</a></code> has been significantly expanded.
+First: if the expansion is of the form <code>(:OR e1 e2 ...)</code>, then event forms
+<code>e1</code>, <code>e2</code>, and so on are evaluated, in order, until the evaluation of
+some <code>ek</code> completes without error.  In that case, the expansion is treated
+simply as <code>ek</code>.  With this capability, alternative expansions can be
+attempted and the successful one does not need to be evaluated again.  See
+the new version of community book <code>books/make-event/proof-by-arith.lisp</code>
+for an example.  Second, an expansion may be of the form <code>(:DO-PROOFS e)</code>,
+in which case the event <code>e</code> is evaluated with proofs <strong>not</strong> skipped;
+see <a href="LD-SKIP-PROOFSP.html">ld-skip-proofsp</a>.  Third, new keyword <code>:EXPANSION?</code> can be used to
+avoid storing expansions in certificate files.  See <a href="MAKE-EVENT.html">make-event</a>.</p><p>When a <code><a href="DEFUN.html">defun</a></code> event prints a failure message in the summary, that
+message now indicates when the failure is due to a failed proof of guard
+verification or a failed proof of the measure theorem.  Thanks to Shilpi Goel
+for requesting this enhancement.</p><p><strong>NEW FEATURES</strong></p><p>ACL2 can now be instructed to time activities using real time (wall clock
+time) instead of run time (typically, cpu time).  See <a href="GET-INTERNAL-TIME.html">get-internal-time</a>.
+Thanks to Jared Davis for asking to be able to obtain real-time reports in
+event summaries.</p><p>A new utility, <code><a href="SYS-CALL+.html">sys-call+</a></code>, is similar to existing utility <code><a href="SYS-CALL.html">sys-call</a></code>
+in that it executes a command.  Unlike <code>sys-call</code>, however, <code>sys-call+</code>
+returns values that include output from the command (in addition to the exit
+status), rather than simply printing the command.  See <a href="SYS-CALL+.html">sys-call+</a>.</p><p>The new macro <code><a href="VERIFY-GUARDS+.html">verify-guards+</a></code> extends the functionality of
+<code><a href="VERIFY-GUARDS.html">verify-guards</a></code> by permitting macro-aliases (see <a href="MACRO-ALIASES-TABLE.html">macro-aliases-table</a>).
+See <a href="VERIFY-GUARDS+.html">verify-guards+</a>.  Thanks to Jared Davis for requesting this feature and
+suggesting the use of <code><a href="MAKE-EVENT.html">make-event</a></code> in its implementation.  We have also
+modified <code><a href="VERIFY-GUARDS.html">verify-guards</a></code> to print a friendlier error message when its
+argument is a macro-alias.</p><p>See <a href="LAST-PROVER-STEPS.html">last-prover-steps</a> for a new utility that returns the number of prover
+steps most recently taken.</p><p><strong>HEURISTIC IMPROVEMENTS</strong></p><p>The processing of <code>:use</code> and <code>:by</code> <a href="HINTS.html">hints</a> has been changed in the
+following two rather subtle ways, thanks to suggestions from Sol Swords.
+</p>
+<blockquote><p></p><p>o For <code>:by</code> hints, the simplest check was an equality check, rather than a
+more general subsumption check.  That equality check was made after removing
+so-called ``guard holders'' (<code><a href="MUST-BE-EQUAL.html">must-be-equal</a></code>, <code><a href="PROG2$.html">prog2$</a></code>,
+<code><a href="EC-CALL.html">ec-call</a></code>, <code><a href="THE.html">the</a></code>) from both the previous theorem and the purported
+theorem.  Now, guard-holder removal has been strengthened, so that the
+results are also put into so-called quote-normal form, for example replacing
+<code>(cons '3 '4)</code> by <code>'(3 . 4)</code>.</p><p>o For a <a href="LEMMA-INSTANCE.html">lemma-instance</a> provided to a <code>:use</code> or <code>:by</code> hint that
+is a <code>:functional-instance</code>, if a <code>:do-not</code> hint (see <a href="HINTS.html">hints</a>) has
+specified that <code>preprocess-clause</code> is not to be used, then preprocessing
+will not be used on the constraints.</p></blockquote>
+<p></p><p>We eliminated certain warnings about being ``weak'' for every
+<code>:</code><code><a href="TYPE-PRESCRIPTION.html">type-prescription</a></code> rule whose conclusion designates that the
+function call can be equal to one of its arguments, e.g.,
+<code>(or (integerp (foo y)) (equal (foo y) y))</code>.  In many cases (such as the
+one above), such warnings about ``weak'' simply aren't correct.</p><p><strong>BUG FIXES</strong></p><p>Fixed a soundness bug that was permitting a <a href="STOBJ.html">stobj</a> to be bound by a
+<code><a href="LET.html">let</a></code> or <code><a href="MV-LET.html">mv-let</a></code> form, without being among the outputs of that form.
+Thanks to Jen Davis and Dave Greve for reporting this bug.  Their report
+included an example which forms the basis for a proof of <code>nil</code>, included as
+a comment in the form <code>(deflabel note-6-3 ...)</code> in ACL2 source file
+<code>ld.lisp</code>.</p><p>(GCL only) Fixed an obscure soundness bug due to an error in the GCL
+implementation of <code><a href="SET-DEBUGGER-ENABLE.html">set-debugger-enable</a></code>.  For details, see the relevant
+comment in the ACL2 source code under <code>(deflabel note-6-3 ...)</code>.</p><p>Fixed a bug in the case of a field of a (concrete) stobj that is an abstract
+stobj (see <a href="NESTED-STOBJS.html">nested-stobjs</a>).  Thanks to David Rager for bringing this bug to
+our attention.</p><p>Splitter output for type <code>if-intro</code> (see <a href="SPLITTER.html">splitter</a>) could formerly occur
+even when at most one subgoal is generated.  This has been fixed.</p><p>Fixed a bug in <code><a href="WOF.html">wof</a></code>, hence in <code><a href="PSOF.html">psof</a></code> (which uses <code>wof</code>), that was
+causing the printing of a bogus error message.</p><p>A small logical bug has been fixed in the logical definition of
+<code><a href="SYS-CALL-STATUS.html">sys-call-status</a></code>.  Formerly it always returned <code>(mv nil state)</code>
+whenever the oracle of the state is non-empty (see <a href="STATE.html">state</a>).</p><p>Fixed a bug that was causing an error upon evaluation of the form
+<code>(set-prover-step-limit nil)</code>.  Thanks to David Russinoff for reporting
+this error.</p><p>The <code>:measure</code> (if supplied) is now ignored when checking redundancy with
+respect to a non-recursive definition that is not defined within a
+<code><a href="MUTUAL-RECURSION.html">mutual-recursion</a></code>.  (See <a href="REDUNDANT-EVENTS.html">redundant-events</a> and see <a href="XARGS.html">xargs</a>.)  It had been
+possible to get a low-level ACL2 error in this situation.  Thanks to Jared
+Davis for reporting this bug with a helpful example.</p><p>Eliminated a potential error when using <code><a href="COMP.html">comp</a></code> to compile an uncompiled
+function defined under <code><a href="PROGN_bang_.html">progn!</a></code>, which we observed in LispWorks.</p><p><strong>CHANGES AT THE SYSTEM LEVEL</strong></p><p>The ACL2 sources are now publicly available between ACL2 releases, using svn;
+see the new ``<code>acl2-devel</code>'' project hosted by Google code at
+<a href="http://acl2-devel.googlecode.com">http://acl2-devel.googlecode.com</a>.  Although such a copy of ACL2 is
+likely to work well with the latest svn (trunk) revision of the ACL2
+community books (see <a href="COMMUNITY-BOOKS.html">community-books</a>), please take seriously the warning
+message printed at startup: ``The authors of ACL2 consider svn distributions
+to be experimental; they may be incomplete, fragile, and unable to pass our
+own regression.''  That message also provides instructions for bug reports.
+If you decide to use svn versions of either the community books or ACL2, then
+you should use both, as they tend to be kept in sync.  We fully expect ACL2
+releases to continue from time to time, as usual.  Thanks to Jared Davis for
+his efforts in setting up the new acl2-devel project and svn repository, and
+to him and David Rager for convincing us to distribute ACL2 sources via svn
+between releases.</p><p>Thanks to a suggestion from Jared Davis, over 30 built-in functions are now
+declared to be inline in order to boost performance.  (The list may be found
+by searching ACL2 source file <code>axioms.lisp</code> for ``<code>(declaim (inline</code>''.)</p><p>Better support has been provided for command line arguments, especially those
+supplied directly by the user when calling ACL2.  For one, problems with
+quoting have been solved using <code>"$@"</code> in place of <code>$*</code>.  Also, the
+function <code><a href="SAVE-EXEC.html">save-exec</a></code> now allows specification of arguments, both for the
+host Lisp as well as ``inert'' arguments that can be passed along to calls of
+programs (as with <code><a href="SYS-CALL.html">sys-call</a></code>).  A keyword argument, <code>:return-from-lp</code>,
+specifies a form to evaluate before quitting the read-eval-print loop at
+startup.  See <a href="SAVE-EXEC.html">save-exec</a>.  Also see the source function <code>user-args-string</code>
+and its comments, source file <code>acl2-init.lisp</code>, for more information.
+Thanks to Jared Davis for suggesting the use of <code>"$@"</code>, as well as
+modifications to <code><a href="SAVE-EXEC.html">save-exec</a></code> and helpful conversations about that.</p><p>A rather extensive overhaul has taken place for the function proclaiming
+mechanism.  As before, this is only used when the host Lisp is GCL.  However,
+building an executable is now faster for some Lisps, including GCL, by
+avoiding repeated recompilation and perhaps repeated initialization.</p><p>(CCL only) We increased stack sizes when the host Lisp is CCL.  The default
+for recent CCL versions is equivalent to specifying `<code>-Z 2M</code>' on the
+command line, but saved ACL2 scripts (including experimental versions
+ACL2(h), ACL2(p), ACL2(r), and combinations of them) to `<code>-Z 64M</code>',
+representing a 32-fold increase.  Thanks to Jared Davis for pointing us to
+community books file <code>books/centaur/ccl-config.lsp</code> and to Sol Swords for
+helpful discussions.</p><p>(SBCL only) Fixed <code>save-exec</code> for host Lisp SBCL to provide the same export
+of variable <code>SBCL_HOME</code> that was provided in the original <code>saved_acl2</code>
+script.</p><p>(GCL only) We made changes, following suggestions from Camm Maguire (whom we
+thank for these suggestions), to support ACL2 builds on recent versions of
+GCL (2.6.8 and 2.6.10; we recommend against using GCL 2.6.9, since issues
+there were fixed in 2.6.10).  Specifically, we no longer set the hole size,
+and we allocate contiguous pages sufficient to run an ACL2 regression without
+failing due to memory limitations.</p><p><strong>EMACS SUPPORT</strong></p><p>Modified file <code>emacs/emacs-acl2.el</code> to eliminate some warnings that were
+appearing in a recent Emacs version, replacing <code>(end-of-buffer)</code> by
+<code>(goto-char (point-max))</code> and <code>next-line</code> by <code>forward-line</code>.  Thanks to
+Warren Hunt for bringing the warnings to our attention.</p><p><strong>EXPERIMENTAL/ALTERNATE VERSIONS</strong></p><p>(Allegro CL only) ACL2(h) now avoids blow-ups in hash table sizes that could
+be caused by <a href="HONS-SHRINK-ALIST.html">hons-shrink-alist</a>.  Thanks to Jared Davis for helping to
+debug this problem, and to David Rager for contributing the community book
+<code>books/parsers/earley/earley-parser.lisp</code>, which highlighted this problem.</p><p>(SBCL only) Fixed a bug that was causing a Lisp break after turning on
+<a href="WATERFALL-PARALLELISM.html">waterfall-parallelism</a>.  Thanks to David Rager for confirming that our
+proposed fix is correct.</p><p>
+</p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/NOTE1.html acl2-6.3/doc/HTML/NOTE1.html
--- acl2-6.2/doc/HTML/NOTE1.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE1.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE1.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE1</h2>Acl2 Version 1.1 Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE2.html acl2-6.3/doc/HTML/NOTE2.html
--- acl2-6.2/doc/HTML/NOTE2.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE2.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE2.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE2</h2>Acl2 Version 1.2 Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE3.html acl2-6.3/doc/HTML/NOTE3.html
--- acl2-6.2/doc/HTML/NOTE3.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE3.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE3.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE3</h2>Acl2 Version 1.3 Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE4.html acl2-6.3/doc/HTML/NOTE4.html
--- acl2-6.2/doc/HTML/NOTE4.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE4.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE4.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE4.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE4</h2>Acl2 Version 1.4 Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE5.html acl2-6.3/doc/HTML/NOTE5.html
--- acl2-6.2/doc/HTML/NOTE5.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE5.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE5.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE5.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE5</h2>Acl2 Version 1.5 Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE6.html acl2-6.3/doc/HTML/NOTE6.html
--- acl2-6.2/doc/HTML/NOTE6.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE6.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE6.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE6.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE6</h2>Acl2 Version 1.6 Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE7.html acl2-6.3/doc/HTML/NOTE7.html
--- acl2-6.2/doc/HTML/NOTE7.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE7.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE7.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE7.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE7</h2>ACL2 Version 1.7 (released October 1994) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE8-UPDATE.html acl2-6.3/doc/HTML/NOTE8-UPDATE.html
--- acl2-6.2/doc/HTML/NOTE8-UPDATE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE8-UPDATE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE8-UPDATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE8-UPDATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE8-UPDATE</h2>ACL2 Version 1.8 (Summer, 1995) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE8.html acl2-6.3/doc/HTML/NOTE8.html
--- acl2-6.2/doc/HTML/NOTE8.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE8.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE8.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE8.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE8</h2>ACL2 Version 1.8 (May, 1995) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NOTE9.html acl2-6.3/doc/HTML/NOTE9.html
--- acl2-6.2/doc/HTML/NOTE9.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NOTE9.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NOTE9.html  --  ACL2 Version 6.2</title></head>
+<head><title>NOTE9.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NOTE9</h2>ACL2 Version 1.9 (Fall, 1996) Notes
 <pre>Major Section:  <a href="RELEASE-NOTES.html">RELEASE-NOTES</a>
diff -Nru acl2-6.2/doc/HTML/NQTHM-TO-ACL2.html acl2-6.3/doc/HTML/NQTHM-TO-ACL2.html
--- acl2-6.2/doc/HTML/NQTHM-TO-ACL2.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/NQTHM-TO-ACL2.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NQTHM-TO-ACL2.html  --  ACL2 Version 6.2</title></head>
+<head><title>NQTHM-TO-ACL2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NQTHM-TO-ACL2</h2>ACL2 analogues of Nqthm functions and commands
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/NTH-ALIASES-TABLE.html acl2-6.3/doc/HTML/NTH-ALIASES-TABLE.html
--- acl2-6.2/doc/HTML/NTH-ALIASES-TABLE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/NTH-ALIASES-TABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NTH-ALIASES-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>NTH-ALIASES-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NTH-ALIASES-TABLE</h2>a <a href="TABLE.html">table</a> used to associate names for nth/update-nth printing
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/NTH.html acl2-6.3/doc/HTML/NTH.html
--- acl2-6.2/doc/HTML/NTH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NTH.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>NTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NTH</h3>the nth element (zero-based) of a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NTHCDR.html acl2-6.3/doc/HTML/NTHCDR.html
--- acl2-6.2/doc/HTML/NTHCDR.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NTHCDR.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NTHCDR.html  --  ACL2 Version 6.2</title></head>
+<head><title>NTHCDR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NTHCDR</h3>final segment of a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NU-REWRITER.html acl2-6.3/doc/HTML/NU-REWRITER.html
--- acl2-6.2/doc/HTML/NU-REWRITER.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/NU-REWRITER.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NU-REWRITER.html  --  ACL2 Version 6.2</title></head>
+<head><title>NU-REWRITER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NU-REWRITER</h2>rewriting <code>NTH</code>/<code>UPDATE-NTH</code> expressions
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/NULL.html acl2-6.3/doc/HTML/NULL.html
--- acl2-6.2/doc/HTML/NULL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NULL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NULL.html  --  ACL2 Version 6.2</title></head>
+<head><title>NULL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NULL</h3>recognizer for the empty list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/NUMBER-SUBTREES.html acl2-6.3/doc/HTML/NUMBER-SUBTREES.html
--- acl2-6.2/doc/HTML/NUMBER-SUBTREES.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/NUMBER-SUBTREES.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NUMBER-SUBTREES.html  --  ACL2 Version 6.2</title></head>
+<head><title>NUMBER-SUBTREES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>NUMBER-SUBTREES</h2><code>(number-subtrees x)</code> returns the number of distinct subtrees of X, in the
 <code>   </code>sense of <code><a href="EQUAL.html">equal</a></code>
diff -Nru acl2-6.2/doc/HTML/NUMERATOR.html acl2-6.3/doc/HTML/NUMERATOR.html
--- acl2-6.2/doc/HTML/NUMERATOR.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/NUMERATOR.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>NUMERATOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>NUMERATOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>NUMERATOR</h3>dividend of a ratio in lowest terms
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/Name_the_Formula_Above.html acl2-6.3/doc/HTML/Name_the_Formula_Above.html
--- acl2-6.2/doc/HTML/Name_the_Formula_Above.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Name_the_Formula_Above.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Name_the_Formula_Above.html  --  ACL2 Version 6.2</title></head>
+<head><title>Name_the_Formula_Above.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Name the Formula Above</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Nontautological_Subgoals.html acl2-6.3/doc/HTML/Nontautological_Subgoals.html
--- acl2-6.2/doc/HTML/Nontautological_Subgoals.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Nontautological_Subgoals.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Nontautological_Subgoals.html  --  ACL2 Version 6.2</title></head>
+<head><title>Nontautological_Subgoals.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Prover output omits some details</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Numbers_in_ACL2.html acl2-6.3/doc/HTML/Numbers_in_ACL2.html
--- acl2-6.2/doc/HTML/Numbers_in_ACL2.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Numbers_in_ACL2.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Numbers_in_ACL2.html  --  ACL2 Version 6.2</title></head>
+<head><title>Numbers_in_ACL2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Numbers in ACL2</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/O-FINP.html acl2-6.3/doc/HTML/O-FINP.html
--- acl2-6.2/doc/HTML/O-FINP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O-FINP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O-FINP.html  --  ACL2 Version 6.2</title></head>
+<head><title>O-FINP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O-FINP</h3>recognizes if an ordinal is finite
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/O-FIRST-COEFF.html acl2-6.3/doc/HTML/O-FIRST-COEFF.html
--- acl2-6.2/doc/HTML/O-FIRST-COEFF.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O-FIRST-COEFF.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O-FIRST-COEFF.html  --  ACL2 Version 6.2</title></head>
+<head><title>O-FIRST-COEFF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O-FIRST-COEFF</h3>returns the first coefficient of an ordinal
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/O-FIRST-EXPT.html acl2-6.3/doc/HTML/O-FIRST-EXPT.html
--- acl2-6.2/doc/HTML/O-FIRST-EXPT.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O-FIRST-EXPT.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O-FIRST-EXPT.html  --  ACL2 Version 6.2</title></head>
+<head><title>O-FIRST-EXPT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O-FIRST-EXPT</h3>the first exponent of an ordinal
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/O-INFP.html acl2-6.3/doc/HTML/O-INFP.html
--- acl2-6.2/doc/HTML/O-INFP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O-INFP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O-INFP.html  --  ACL2 Version 6.2</title></head>
+<head><title>O-INFP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O-INFP</h3>recognizes if an ordinal is infinite
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/O-P.html acl2-6.3/doc/HTML/O-P.html
--- acl2-6.2/doc/HTML/O-P.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O-P.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>O-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O-P</h3>a recognizer for the ordinals up to epsilon-0
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/O-RST.html acl2-6.3/doc/HTML/O-RST.html
--- acl2-6.2/doc/HTML/O-RST.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O-RST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O-RST.html  --  ACL2 Version 6.2</title></head>
+<head><title>O-RST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O-RST</h3>returns the rest of an infinite ordinal
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/OBDD.html acl2-6.3/doc/HTML/OBDD.html
--- acl2-6.2/doc/HTML/OBDD.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/OBDD.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OBDD.html  --  ACL2 Version 6.2</title></head>
+<head><title>OBDD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OBDD</h2>ordered binary decision diagrams with rewriting
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/OBSERVATION-CW.html acl2-6.3/doc/HTML/OBSERVATION-CW.html
--- acl2-6.2/doc/HTML/OBSERVATION-CW.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/OBSERVATION-CW.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OBSERVATION-CW.html  --  ACL2 Version 6.2</title></head>
+<head><title>OBSERVATION-CW.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>OBSERVATION-CW</h3>See <a href="OBSERVATION.html">observation</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/OBSERVATION.html acl2-6.3/doc/HTML/OBSERVATION.html
--- acl2-6.2/doc/HTML/OBSERVATION.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/OBSERVATION.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OBSERVATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>OBSERVATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>OBSERVATION</h3>print an observation
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ODDP.html acl2-6.3/doc/HTML/ODDP.html
--- acl2-6.2/doc/HTML/ODDP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ODDP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ODDP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ODDP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ODDP</h3>test whether an integer is odd
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/OK-IF.html acl2-6.3/doc/HTML/OK-IF.html
--- acl2-6.2/doc/HTML/OK-IF.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/OK-IF.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OK-IF.html  --  ACL2 Version 6.2</title></head>
+<head><title>OK-IF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OK-IF</h2>conditional exit from <code>break-rewrite</code>
 <pre>Major Section:  <a href="BREAK-REWRITE.html">BREAK-REWRITE</a>
diff -Nru acl2-6.2/doc/HTML/OOPS.html acl2-6.3/doc/HTML/OOPS.html
--- acl2-6.2/doc/HTML/OOPS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/OOPS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OOPS.html  --  ACL2 Version 6.2</title></head>
+<head><title>OOPS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OOPS</h2>undo a <code>:u</code> or <code>:</code><code><a href="UBT.html">ubt</a></code>
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/OPEN-INPUT-CHANNEL-P.html acl2-6.3/doc/HTML/OPEN-INPUT-CHANNEL-P.html
--- acl2-6.2/doc/HTML/OPEN-INPUT-CHANNEL-P.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/OPEN-INPUT-CHANNEL-P.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OPEN-INPUT-CHANNEL-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>OPEN-INPUT-CHANNEL-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>OPEN-INPUT-CHANNEL-P</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/OPEN-INPUT-CHANNEL.html acl2-6.3/doc/HTML/OPEN-INPUT-CHANNEL.html
--- acl2-6.2/doc/HTML/OPEN-INPUT-CHANNEL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/OPEN-INPUT-CHANNEL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OPEN-INPUT-CHANNEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>OPEN-INPUT-CHANNEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>OPEN-INPUT-CHANNEL</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/OPEN-OUTPUT-CHANNEL-P.html acl2-6.3/doc/HTML/OPEN-OUTPUT-CHANNEL-P.html
--- acl2-6.2/doc/HTML/OPEN-OUTPUT-CHANNEL-P.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/OPEN-OUTPUT-CHANNEL-P.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OPEN-OUTPUT-CHANNEL-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>OPEN-OUTPUT-CHANNEL-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>OPEN-OUTPUT-CHANNEL-P</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/OPEN-OUTPUT-CHANNEL.html acl2-6.3/doc/HTML/OPEN-OUTPUT-CHANNEL.html
--- acl2-6.2/doc/HTML/OPEN-OUTPUT-CHANNEL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/OPEN-OUTPUT-CHANNEL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OPEN-OUTPUT-CHANNEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>OPEN-OUTPUT-CHANNEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>OPEN-OUTPUT-CHANNEL</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/OPEN-OUTPUT-CHANNEL_bang_.html acl2-6.3/doc/HTML/OPEN-OUTPUT-CHANNEL_bang_.html
--- acl2-6.2/doc/HTML/OPEN-OUTPUT-CHANNEL_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/OPEN-OUTPUT-CHANNEL_bang_.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OPEN-OUTPUT-CHANNEL_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>OPEN-OUTPUT-CHANNEL_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OPEN-OUTPUT-CHANNEL!</h2>when trust tags are needed to open output channels
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/OPEN-TRACE-FILE.html acl2-6.3/doc/HTML/OPEN-TRACE-FILE.html
--- acl2-6.2/doc/HTML/OPEN-TRACE-FILE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/OPEN-TRACE-FILE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OPEN-TRACE-FILE.html  --  ACL2 Version 6.2</title></head>
+<head><title>OPEN-TRACE-FILE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OPEN-TRACE-FILE</h2>redirect trace output to a file
 <pre>Major Section:  <a href="TRACE.html">TRACE</a>
diff -Nru acl2-6.2/doc/HTML/OPTIMIZE.html acl2-6.3/doc/HTML/OPTIMIZE.html
--- acl2-6.2/doc/HTML/OPTIMIZE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/OPTIMIZE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OPTIMIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>OPTIMIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OPTIMIZE</h2>See <a href="DECLARE.html">declare</a>.
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/OR.html acl2-6.3/doc/HTML/OR.html
--- acl2-6.2/doc/HTML/OR.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/OR.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OR.html  --  ACL2 Version 6.2</title></head>
+<head><title>OR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>OR</h3>disjunction
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ORACLE-APPLY-RAW.html acl2-6.3/doc/HTML/ORACLE-APPLY-RAW.html
--- acl2-6.2/doc/HTML/ORACLE-APPLY-RAW.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ORACLE-APPLY-RAW.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ORACLE-APPLY-RAW.html  --  ACL2 Version 6.2</title></head>
+<head><title>ORACLE-APPLY-RAW.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ORACLE-APPLY-RAW</h3>call a function argument on the given list of arguments, no restrictions
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ORACLE-APPLY.html acl2-6.3/doc/HTML/ORACLE-APPLY.html
--- acl2-6.2/doc/HTML/ORACLE-APPLY.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ORACLE-APPLY.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ORACLE-APPLY.html  --  ACL2 Version 6.2</title></head>
+<head><title>ORACLE-APPLY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ORACLE-APPLY</h3>call a function argument on the given list of arguments
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ORACLE-FUNCALL.html acl2-6.3/doc/HTML/ORACLE-FUNCALL.html
--- acl2-6.2/doc/HTML/ORACLE-FUNCALL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ORACLE-FUNCALL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ORACLE-FUNCALL.html  --  ACL2 Version 6.2</title></head>
+<head><title>ORACLE-FUNCALL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ORACLE-FUNCALL</h3>call a function argument on the remaining arguments
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ORDINALS.html acl2-6.3/doc/HTML/ORDINALS.html
--- acl2-6.2/doc/HTML/ORDINALS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/ORDINALS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ORDINALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ORDINALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ORDINALS</h2>ordinals in ACL2
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/OTF-FLG.html acl2-6.3/doc/HTML/OTF-FLG.html
--- acl2-6.2/doc/HTML/OTF-FLG.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/OTF-FLG.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OTF-FLG.html  --  ACL2 Version 6.2</title></head>
+<head><title>OTF-FLG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OTF-FLG</h2>allow more than one initial subgoal to be pushed for induction
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/OTHER.html acl2-6.3/doc/HTML/OTHER.html
--- acl2-6.2/doc/HTML/OTHER.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/OTHER.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OTHER.html  --  ACL2 Version 6.2</title></head>
+<head><title>OTHER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>OTHER</h1>other commonly used top-level functions
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -32,6 +32,10 @@
 </h3>
 </li>
 
+<li><h3><a href="COMMAND-LINE.html">COMMAND-LINE</a> -- handling of command-line arguments when ACL2 is invoked
+</h3>
+</li>
+
 <li><h3><a href="CW-GSTACK.html">CW-GSTACK</a> -- debug a rewriting loop or stack overflow
 </h3>
 </li>
@@ -124,7 +128,7 @@
 </h3>
 </li>
 
-<li><h3><a href="SAVE-EXEC.html">SAVE-EXEC</a> -- save an executable image and (for most Common Lisps) a wrapper script
+<li><h3><a href="SAVE-EXEC.html">SAVE-EXEC</a> -- save an executable image and a wrapper script
 </h3>
 </li>
 
diff -Nru acl2-6.2/doc/HTML/OUTPUT-TO-FILE.html acl2-6.3/doc/HTML/OUTPUT-TO-FILE.html
--- acl2-6.2/doc/HTML/OUTPUT-TO-FILE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/OUTPUT-TO-FILE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OUTPUT-TO-FILE.html  --  ACL2 Version 6.2</title></head>
+<head><title>OUTPUT-TO-FILE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OUTPUT-TO-FILE</h2>redirecting output to a file
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/OVERRIDE-HINTS.html acl2-6.3/doc/HTML/OVERRIDE-HINTS.html
--- acl2-6.2/doc/HTML/OVERRIDE-HINTS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/OVERRIDE-HINTS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>OVERRIDE-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>OVERRIDE-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>OVERRIDE-HINTS</h2>a list of hints given priority in every proof attempt
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/O_gt_.html acl2-6.3/doc/HTML/O_gt_.html
--- acl2-6.2/doc/HTML/O_gt_.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O_gt_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O_gt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>O_gt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O&gt;</h3>the greater-than relation for the ordinals
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/O_gt_=.html acl2-6.3/doc/HTML/O_gt_=.html
--- acl2-6.2/doc/HTML/O_gt_=.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O_gt_=.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O_gt_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>O_gt_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O&gt;=</h3>the greater-than-or-equal relation for the ordinals
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/O_lt_.html acl2-6.3/doc/HTML/O_lt_.html
--- acl2-6.2/doc/HTML/O_lt_.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O_lt_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O_lt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>O_lt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O&lt;</h3>the well-founded less-than relation on ordinals up to <code>epsilon-0</code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/O_lt_=.html acl2-6.3/doc/HTML/O_lt_=.html
--- acl2-6.2/doc/HTML/O_lt_=.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/O_lt_=.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>O_lt_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>O_lt_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>O&lt;=</h3>the less-than-or-equal relation for the ordinals
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/On_the_Naming_of_Subgoals.html acl2-6.3/doc/HTML/On_the_Naming_of_Subgoals.html
--- acl2-6.2/doc/HTML/On_the_Naming_of_Subgoals.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/On_the_Naming_of_Subgoals.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>On_the_Naming_of_Subgoals.html  --  ACL2 Version 6.2</title></head>
+<head><title>On_the_Naming_of_Subgoals.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>On the Naming of Subgoals</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Other_Requirements.html acl2-6.3/doc/HTML/Other_Requirements.html
--- acl2-6.2/doc/HTML/Other_Requirements.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Other_Requirements.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Other_Requirements.html  --  ACL2 Version 6.2</title></head>
+<head><title>Other_Requirements.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Other Requirements</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Overview_of_the_Expansion_of_ENDP_in_the_Base_Case.html acl2-6.3/doc/HTML/Overview_of_the_Expansion_of_ENDP_in_the_Base_Case.html
--- acl2-6.2/doc/HTML/Overview_of_the_Expansion_of_ENDP_in_the_Base_Case.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Overview_of_the_Expansion_of_ENDP_in_the_Base_Case.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Overview_of_the_Expansion_of_ENDP_in_the_Base_Case.html  --  ACL2 Version 6.2</title></head>
+<head><title>Overview_of_the_Expansion_of_ENDP_in_the_Base_Case.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Overview of the Expansion of ENDP in the Base Case</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Overview_of_the_Expansion_of_ENDP_in_the_Induction_Step.html acl2-6.3/doc/HTML/Overview_of_the_Expansion_of_ENDP_in_the_Induction_Step.html
--- acl2-6.2/doc/HTML/Overview_of_the_Expansion_of_ENDP_in_the_Induction_Step.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Overview_of_the_Expansion_of_ENDP_in_the_Induction_Step.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Overview_of_the_Expansion_of_ENDP_in_the_Induction_Step.html  --  ACL2 Version 6.2</title></head>
+<head><title>Overview_of_the_Expansion_of_ENDP_in_the_Induction_Step.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Overview of the Expansion of ENDP in the Induction Step</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Overview_of_the_Final_Simplification_in_the_Base_Case.html acl2-6.3/doc/HTML/Overview_of_the_Final_Simplification_in_the_Base_Case.html
--- acl2-6.2/doc/HTML/Overview_of_the_Final_Simplification_in_the_Base_Case.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Overview_of_the_Final_Simplification_in_the_Base_Case.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Overview_of_the_Final_Simplification_in_the_Base_Case.html  --  ACL2 Version 6.2</title></head>
+<head><title>Overview_of_the_Final_Simplification_in_the_Base_Case.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Overview of the Final Simplification in the Base Case</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Overview_of_the_Proof_of_a_Trivial_Consequence.html acl2-6.3/doc/HTML/Overview_of_the_Proof_of_a_Trivial_Consequence.html
--- acl2-6.2/doc/HTML/Overview_of_the_Proof_of_a_Trivial_Consequence.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Overview_of_the_Proof_of_a_Trivial_Consequence.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Overview_of_the_Proof_of_a_Trivial_Consequence.html  --  ACL2 Version 6.2</title></head>
+<head><title>Overview_of_the_Proof_of_a_Trivial_Consequence.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Overview of the Proof of a Trivial Consequence</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Overview_of_the_Simplification_of_the_Base_Case_to_T.html acl2-6.3/doc/HTML/Overview_of_the_Simplification_of_the_Base_Case_to_T.html
--- acl2-6.2/doc/HTML/Overview_of_the_Simplification_of_the_Base_Case_to_T.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Overview_of_the_Simplification_of_the_Base_Case_to_T.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Overview_of_the_Simplification_of_the_Base_Case_to_T.html  --  ACL2 Version 6.2</title></head>
+<head><title>Overview_of_the_Simplification_of_the_Base_Case_to_T.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Overview of the Simplification of the Base Case to T</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Overview_of_the_Simplification_of_the_Induction_Conclusion.html acl2-6.3/doc/HTML/Overview_of_the_Simplification_of_the_Induction_Conclusion.html
--- acl2-6.2/doc/HTML/Overview_of_the_Simplification_of_the_Induction_Conclusion.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Overview_of_the_Simplification_of_the_Induction_Conclusion.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Overview_of_the_Simplification_of_the_Induction_Conclusion.html  --  ACL2 Version 6.2</title></head>
+<head><title>Overview_of_the_Simplification_of_the_Induction_Conclusion.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Overview of the Simplification of the Induction Conclusion</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Overview_of_the_Simplification_of_the_Induction_Step_to_T.html acl2-6.3/doc/HTML/Overview_of_the_Simplification_of_the_Induction_Step_to_T.html
--- acl2-6.2/doc/HTML/Overview_of_the_Simplification_of_the_Induction_Step_to_T.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Overview_of_the_Simplification_of_the_Induction_Step_to_T.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Overview_of_the_Simplification_of_the_Induction_Step_to_T.html  --  ACL2 Version 6.2</title></head>
+<head><title>Overview_of_the_Simplification_of_the_Induction_Step_to_T.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Overview of the Simplification of the Induction Step to T</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS.html acl2-6.3/doc/HTML/PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS.html
--- acl2-6.2/doc/HTML/PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PACKAGE-REINCARNATION-IMPORT-RESTRICTIONS</h2>re-defining undone <code><a href="DEFPKG.html">defpkg</a></code>s
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/PAIRLIS$.html acl2-6.3/doc/HTML/PAIRLIS$.html
--- acl2-6.2/doc/HTML/PAIRLIS$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PAIRLIS$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PAIRLIS$.html  --  ACL2 Version 6.2</title></head>
+<head><title>PAIRLIS$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PAIRLIS$</h3>zipper together two lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PAIRLIS.html acl2-6.3/doc/HTML/PAIRLIS.html
--- acl2-6.2/doc/HTML/PAIRLIS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PAIRLIS.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PAIRLIS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PAIRLIS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PAIRLIS</h3>See <a href="PAIRLIS$.html">pairlis$</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PAND.html acl2-6.3/doc/HTML/PAND.html
--- acl2-6.2/doc/HTML/PAND.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PAND.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PAND.html  --  ACL2 Version 6.2</title></head>
+<head><title>PAND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PAND</h3>parallel, Boolean version of <code><a href="AND.html">and</a></code>
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/PARALLEL-EXECUTION.html acl2-6.3/doc/HTML/PARALLEL-EXECUTION.html
--- acl2-6.2/doc/HTML/PARALLEL-EXECUTION.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLEL-EXECUTION.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLEL-EXECUTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLEL-EXECUTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PARALLEL-EXECUTION</h3>for ACL2(p): configure parallel execution
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/PARALLEL-PROGRAMMING.html acl2-6.3/doc/HTML/PARALLEL-PROGRAMMING.html
--- acl2-6.2/doc/HTML/PARALLEL-PROGRAMMING.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLEL-PROGRAMMING.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLEL-PROGRAMMING.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLEL-PROGRAMMING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PARALLEL-PROGRAMMING</h2>parallel programming in ACL2(p)
 <pre>Major Section:  <a href="PARALLELISM.html">PARALLELISM</a>
diff -Nru acl2-6.2/doc/HTML/PARALLEL-PROOF.html acl2-6.3/doc/HTML/PARALLEL-PROOF.html
--- acl2-6.2/doc/HTML/PARALLEL-PROOF.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLEL-PROOF.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLEL-PROOF.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLEL-PROOF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PARALLEL-PROOF</h2>parallel proof in ACL2(p)
 <pre>Major Section:  <a href="PARALLELISM.html">PARALLELISM</a>
diff -Nru acl2-6.2/doc/HTML/PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION.html acl2-6.3/doc/HTML/PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION.html
--- acl2-6.2/doc/HTML/PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PARALLEL-PUSHING-OF-SUBGOALS-FOR-INDUCTION</h3>consequences of how parallelized proofs of subgoals are pushed for induction
 <pre>Major Section:  <a href="PARALLEL-PROOF.html">PARALLEL-PROOF</a>
diff -Nru acl2-6.2/doc/HTML/PARALLEL.html acl2-6.3/doc/HTML/PARALLEL.html
--- acl2-6.2/doc/HTML/PARALLEL.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLEL.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PARALLEL</h2>evaluating forms in parallel
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/PARALLELISM-AT-THE-TOP-LEVEL.html acl2-6.3/doc/HTML/PARALLELISM-AT-THE-TOP-LEVEL.html
--- acl2-6.2/doc/HTML/PARALLELISM-AT-THE-TOP-LEVEL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLELISM-AT-THE-TOP-LEVEL.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLELISM-AT-THE-TOP-LEVEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLELISM-AT-THE-TOP-LEVEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PARALLELISM-AT-THE-TOP-LEVEL</h3>parallel execution in the ACL2 top-level loop
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/PARALLELISM-BUILD.html acl2-6.3/doc/HTML/PARALLELISM-BUILD.html
--- acl2-6.2/doc/HTML/PARALLELISM-BUILD.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLELISM-BUILD.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLELISM-BUILD.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLELISM-BUILD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PARALLELISM-BUILD</h2>building an ACL2 executable with parallel execution enabled
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/PARALLELISM-PERFORMANCE.html acl2-6.3/doc/HTML/PARALLELISM-PERFORMANCE.html
--- acl2-6.2/doc/HTML/PARALLELISM-PERFORMANCE.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLELISM-PERFORMANCE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLELISM-PERFORMANCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLELISM-PERFORMANCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PARALLELISM-PERFORMANCE</h3>performance issues for parallel execution
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/PARALLELISM-TUTORIAL.html acl2-6.3/doc/HTML/PARALLELISM-TUTORIAL.html
--- acl2-6.2/doc/HTML/PARALLELISM-TUTORIAL.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLELISM-TUTORIAL.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLELISM-TUTORIAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLELISM-TUTORIAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PARALLELISM-TUTORIAL</h3>a tutorial on how to use the parallelism library.
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/PARALLELISM.html acl2-6.3/doc/HTML/PARALLELISM.html
--- acl2-6.2/doc/HTML/PARALLELISM.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PARALLELISM.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARALLELISM.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARALLELISM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>PARALLELISM</h1>experimental extension for parallel execution and proofs
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/PARGS.html acl2-6.3/doc/HTML/PARGS.html
--- acl2-6.2/doc/HTML/PARGS.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PARGS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PARGS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PARGS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PARGS</h3>parallel evaluation of arguments in a function call
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/PATHNAME.html acl2-6.3/doc/HTML/PATHNAME.html
--- acl2-6.2/doc/HTML/PATHNAME.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PATHNAME.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PATHNAME.html  --  ACL2 Version 6.2</title></head>
+<head><title>PATHNAME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PATHNAME</h2>introduction to filename conventions in ACL2
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/PBT.html acl2-6.3/doc/HTML/PBT.html
--- acl2-6.2/doc/HTML/PBT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PBT.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PBT.html  --  ACL2 Version 6.2</title></head>
+<head><title>PBT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PBT</h2>print the <a href="COMMAND.html">command</a>s back through a <a href="COMMAND.html">command</a> descriptor
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PC.html acl2-6.3/doc/HTML/PC.html
--- acl2-6.2/doc/HTML/PC.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PC.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PC.html  --  ACL2 Version 6.2</title></head>
+<head><title>PC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PC</h2>print the <a href="COMMAND.html">command</a> described by a <a href="COMMAND.html">command</a> descriptor
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
@@ -27,7 +27,7 @@
 
 <code>Pc</code> always prints a space first, followed by three (possibly blank)
 <a href="CHARACTERS.html">characters</a> (``LVd'' above) explained below (four, in the experimental
-HONS version; see <a href="HONS-AND-MEMOIZATION.html">hons-and-memoization</a>).  Then <code>pc</code> prints the
+HONS version, as discussed further below).  Then <code>pc</code> prints the
 <a href="COMMAND.html">command</a> number, a number uniquely identifying the <a href="COMMAND.html">command</a>'s
 position in the sequence of <a href="COMMAND.html">command</a>s since the beginning of the user's
 session.  Finally, the <a href="COMMAND.html">command</a> itself is printed.</p><p>While <code>pc</code> always prints a space first, some <a href="HISTORY.html">history</a> <a href="COMMAND.html">command</a>s, for
diff -Nru acl2-6.2/doc/HTML/PCB.html acl2-6.3/doc/HTML/PCB.html
--- acl2-6.2/doc/HTML/PCB.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PCB.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PCB.html  --  ACL2 Version 6.2</title></head>
+<head><title>PCB.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PCB</h2>print the <a href="COMMAND.html">command</a> block described by a <a href="COMMAND.html">command</a> descriptor
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PCB_bang_.html acl2-6.3/doc/HTML/PCB_bang_.html
--- acl2-6.2/doc/HTML/PCB_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PCB_bang_.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PCB_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>PCB_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PCB!</h2>print in full the <a href="COMMAND.html">command</a> block described by a <a href="COMMAND.html">command</a> descriptor
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PCS.html acl2-6.3/doc/HTML/PCS.html
--- acl2-6.2/doc/HTML/PCS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PCS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PCS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PCS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PCS</h2>print the sequence of <a href="COMMAND.html">command</a>s between two <a href="COMMAND.html">command</a> descriptors
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PE.html acl2-6.3/doc/HTML/PE.html
--- acl2-6.2/doc/HTML/PE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PE.html  --  ACL2 Version 6.2</title></head>
+<head><title>PE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PE</h2>print the events named by a logical name
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PEEK-CHAR$.html acl2-6.3/doc/HTML/PEEK-CHAR$.html
--- acl2-6.2/doc/HTML/PEEK-CHAR$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PEEK-CHAR$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PEEK-CHAR$.html  --  ACL2 Version 6.2</title></head>
+<head><title>PEEK-CHAR$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PEEK-CHAR$</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PE_bang_.html acl2-6.3/doc/HTML/PE_bang_.html
--- acl2-6.2/doc/HTML/PE_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PE_bang_.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PE_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>PE_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PE!</h2>deprecated (see <a href="PE.html">pe</a>)
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PF.html acl2-6.3/doc/HTML/PF.html
--- acl2-6.2/doc/HTML/PF.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PF.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PF.html  --  ACL2 Version 6.2</title></head>
+<head><title>PF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PF</h2>print the formula corresponding to the given name
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PKG-IMPORTS.html acl2-6.3/doc/HTML/PKG-IMPORTS.html
--- acl2-6.2/doc/HTML/PKG-IMPORTS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PKG-IMPORTS.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PKG-IMPORTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PKG-IMPORTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PKG-IMPORTS</h3>list of symbols imported into a given package
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PKG-WITNESS.html acl2-6.3/doc/HTML/PKG-WITNESS.html
--- acl2-6.2/doc/HTML/PKG-WITNESS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PKG-WITNESS.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PKG-WITNESS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PKG-WITNESS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PKG-WITNESS</h3>return a specific symbol in the indicated package
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PL.html acl2-6.3/doc/HTML/PL.html
--- acl2-6.2/doc/HTML/PL.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PL.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PL.html  --  ACL2 Version 6.2</title></head>
+<head><title>PL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PL</h2>print the rules for the given name or term
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PL2.html acl2-6.3/doc/HTML/PL2.html
--- acl2-6.2/doc/HTML/PL2.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PL2.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PL2.html  --  ACL2 Version 6.2</title></head>
+<head><title>PL2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PL2</h2>print rule(s) for the given form
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PLET.html acl2-6.3/doc/HTML/PLET.html
--- acl2-6.2/doc/HTML/PLET.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PLET.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PLET.html  --  ACL2 Version 6.2</title></head>
+<head><title>PLET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PLET</h3>parallel version of <code><a href="LET.html">let</a></code>
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/PLUSP.html acl2-6.3/doc/HTML/PLUSP.html
--- acl2-6.2/doc/HTML/PLUSP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PLUSP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PLUSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>PLUSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PLUSP</h3>test whether a number is positive
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/POR.html acl2-6.3/doc/HTML/POR.html
--- acl2-6.2/doc/HTML/POR.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/POR.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>POR.html  --  ACL2 Version 6.2</title></head>
+<head><title>POR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>POR</h3>parallel, Boolean version of <code><a href="OR.html">or</a></code>
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/PORTCULLIS.html acl2-6.3/doc/HTML/PORTCULLIS.html
--- acl2-6.2/doc/HTML/PORTCULLIS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PORTCULLIS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PORTCULLIS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PORTCULLIS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PORTCULLIS</h2>the gate guarding the entrance to a certified book
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/POSITION-EQ.html acl2-6.3/doc/HTML/POSITION-EQ.html
--- acl2-6.2/doc/HTML/POSITION-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/POSITION-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>POSITION-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>POSITION-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>POSITION-EQ</h3>See <a href="POSITION.html">position</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/POSITION-EQUAL.html acl2-6.3/doc/HTML/POSITION-EQUAL.html
--- acl2-6.2/doc/HTML/POSITION-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/POSITION-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>POSITION-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>POSITION-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>POSITION-EQUAL</h3>See <a href="POSITION.html">position</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/POSITION.html acl2-6.3/doc/HTML/POSITION.html
--- acl2-6.2/doc/HTML/POSITION.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/POSITION.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>POSITION.html  --  ACL2 Version 6.2</title></head>
+<head><title>POSITION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>POSITION</h3>position of an item in a string or a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/POSP.html acl2-6.3/doc/HTML/POSP.html
--- acl2-6.2/doc/HTML/POSP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/POSP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>POSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>POSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>POSP</h3>a recognizer for the positive integers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/POST-INDUCTION-KEY-CHECKPOINTS.html acl2-6.3/doc/HTML/POST-INDUCTION-KEY-CHECKPOINTS.html
--- acl2-6.2/doc/HTML/POST-INDUCTION-KEY-CHECKPOINTS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/POST-INDUCTION-KEY-CHECKPOINTS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>POST-INDUCTION-KEY-CHECKPOINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>POST-INDUCTION-KEY-CHECKPOINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>POST-INDUCTION-KEY-CHECKPOINTS</h3>reading post-induction key checkpoints
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PPROGN.html acl2-6.3/doc/HTML/PPROGN.html
--- acl2-6.2/doc/HTML/PPROGN.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PPROGN.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PPROGN.html  --  ACL2 Version 6.2</title></head>
+<head><title>PPROGN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PPROGN</h3>evaluate a sequence of forms that return <a href="STATE.html">state</a>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PR.html acl2-6.3/doc/HTML/PR.html
--- acl2-6.2/doc/HTML/PR.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PR.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PR.html  --  ACL2 Version 6.2</title></head>
+<head><title>PR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PR</h2>print the rules stored by the event with the given name
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-1.html acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-1.html
--- acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-1.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-1.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRACTICE-FORMULATING-STRONG-RULES-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRACTICE-FORMULATING-STRONG-RULES-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRACTICE-FORMULATING-STRONG-RULES-1</h3>rules suggested by <code>(TRUE-LISTP (APPEND (FOO A) (BAR B)))</code>
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-2.html acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-2.html
--- acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-2.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-2.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRACTICE-FORMULATING-STRONG-RULES-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRACTICE-FORMULATING-STRONG-RULES-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRACTICE-FORMULATING-STRONG-RULES-2</h3>rules suggested by <code>(TRUE-LISTP (REV (FOO A)))</code>
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-3.html acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-3.html
--- acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-3.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-3.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRACTICE-FORMULATING-STRONG-RULES-3.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRACTICE-FORMULATING-STRONG-RULES-3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRACTICE-FORMULATING-STRONG-RULES-3</h3>rules suggested by <code>(MEMBER (FOO A) (APPEND (BAR B) (MUM C)))</code>
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-4.html acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-4.html
--- acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-4.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-4.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRACTICE-FORMULATING-STRONG-RULES-4.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRACTICE-FORMULATING-STRONG-RULES-4.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRACTICE-FORMULATING-STRONG-RULES-4</h3>rules suggested by <code>(SUBSETP (APPEND (FOO A) (BAR B)) (MUM C))</code>
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-5.html acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-5.html
--- acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-5.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-5.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRACTICE-FORMULATING-STRONG-RULES-5.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRACTICE-FORMULATING-STRONG-RULES-5.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRACTICE-FORMULATING-STRONG-RULES-5</h3>rules suggested by <code>(SUBSETP (FOO A) (APPEND (BAR B) (MUM C)))</code>
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-6.html acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-6.html
--- acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-6.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES-6.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRACTICE-FORMULATING-STRONG-RULES-6.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRACTICE-FORMULATING-STRONG-RULES-6.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRACTICE-FORMULATING-STRONG-RULES-6</h3>rules suggested by <code>(MEMBER (FOO A) (NATS-BELOW (BAR B)))</code>
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES.html acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES.html
--- acl2-6.2/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PRACTICE-FORMULATING-STRONG-RULES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRACTICE-FORMULATING-STRONG-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRACTICE-FORMULATING-STRONG-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRACTICE-FORMULATING-STRONG-RULES</h3>a few simple checkpoints suggesting strong rules
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PRINC$.html acl2-6.3/doc/HTML/PRINC$.html
--- acl2-6.2/doc/HTML/PRINC$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PRINC$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRINC$.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRINC$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRINC$</h3>print an atom
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PRINT-CONTROL.html acl2-6.3/doc/HTML/PRINT-CONTROL.html
--- acl2-6.2/doc/HTML/PRINT-CONTROL.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PRINT-CONTROL.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRINT-CONTROL.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRINT-CONTROL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PRINT-CONTROL</h2>advanced controls of ACL2 printing
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/PRINT-DOC-START-COLUMN.html acl2-6.3/doc/HTML/PRINT-DOC-START-COLUMN.html
--- acl2-6.2/doc/HTML/PRINT-DOC-START-COLUMN.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PRINT-DOC-START-COLUMN.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRINT-DOC-START-COLUMN.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRINT-DOC-START-COLUMN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PRINT-DOC-START-COLUMN</h2>printing the one-liner
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/PRINT-GV.html acl2-6.3/doc/HTML/PRINT-GV.html
--- acl2-6.2/doc/HTML/PRINT-GV.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PRINT-GV.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRINT-GV.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRINT-GV.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PRINT-GV</h2>print a form whose evaluation caused a guard violation
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/PRINT-OBJECT$.html acl2-6.3/doc/HTML/PRINT-OBJECT$.html
--- acl2-6.2/doc/HTML/PRINT-OBJECT$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PRINT-OBJECT$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRINT-OBJECT$.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRINT-OBJECT$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PRINT-OBJECT$</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PRINT-SUMMARY-USER.html acl2-6.3/doc/HTML/PRINT-SUMMARY-USER.html
--- acl2-6.2/doc/HTML/PRINT-SUMMARY-USER.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/PRINT-SUMMARY-USER.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRINT-SUMMARY-USER.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRINT-SUMMARY-USER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PRINT-SUMMARY-USER</h2>See <a href="FINALIZE-EVENT-USER.html">finalize-event-user</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/PRINTING-TO-STRINGS.html acl2-6.3/doc/HTML/PRINTING-TO-STRINGS.html
--- acl2-6.2/doc/HTML/PRINTING-TO-STRINGS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PRINTING-TO-STRINGS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PRINTING-TO-STRINGS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PRINTING-TO-STRINGS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PRINTING-TO-STRINGS</h2>printing to strings instead of files or standard output
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/PROFILE.html acl2-6.3/doc/HTML/PROFILE.html
--- acl2-6.2/doc/HTML/PROFILE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PROFILE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROFILE.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROFILE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROFILE</h2>turn on profiling for one function
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/PROG2$.html acl2-6.3/doc/HTML/PROG2$.html
--- acl2-6.2/doc/HTML/PROG2$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PROG2$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROG2$.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROG2$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PROG2$</h3>execute two forms and return the value of the second one
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PROGN$.html acl2-6.3/doc/HTML/PROGN$.html
--- acl2-6.2/doc/HTML/PROGN$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PROGN$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROGN$.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROGN$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PROGN$</h3>execute a sequence of forms and return the value of the last one
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PROGN.html acl2-6.3/doc/HTML/PROGN.html
--- acl2-6.2/doc/HTML/PROGN.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PROGN.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROGN.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROGN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROGN</h2>evaluate some <a href="EVENTS.html">events</a>
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/PROGN_bang_.html acl2-6.3/doc/HTML/PROGN_bang_.html
--- acl2-6.2/doc/HTML/PROGN_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PROGN_bang_.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROGN_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROGN_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROGN!</h2>evaluate some forms, not necessarily <a href="EVENTS.html">events</a>
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/PROGRAM.html acl2-6.3/doc/HTML/PROGRAM.html
--- acl2-6.2/doc/HTML/PROGRAM.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/PROGRAM.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROGRAM.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROGRAM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROGRAM</h2>to set the default <a href="DEFUN-MODE.html">defun-mode</a> to <code>:</code><code><a href="PROGRAM.html">program</a></code>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED.html acl2-6.3/doc/HTML/PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED.html
--- acl2-6.2/doc/HTML/PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PROGRAMMING-KNOWLEDGE-TAKEN-FOR-GRANTED</h3>background knowledge in ACL2 programming for theorem prover tutorial
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/PROGRAMMING-WITH-STATE.html acl2-6.3/doc/HTML/PROGRAMMING-WITH-STATE.html
--- acl2-6.2/doc/HTML/PROGRAMMING-WITH-STATE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/PROGRAMMING-WITH-STATE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROGRAMMING-WITH-STATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROGRAMMING-WITH-STATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PROGRAMMING-WITH-STATE</h3>programming using the von Neumannesque ACL2 <a href="STATE.html">state</a> object
 <pre>Major Section:  <a href="STATE.html">STATE</a>
@@ -441,7 +441,7 @@
 This form binds state global variable <code>inhibit-output-lst</code> to the result of
 adding the symbol, <code>summary</code>, to the current value of that state global.
 Thus (see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a>), the usual summary is not printed when
-evaluating this call of <code><a href="THM.html">thm</a></code>.</p><p>See <a href="STATE-GLOBAL-LET_star_.html">state-global-let*</a> for more complete <a href="DOCUMENTATION.html">documentation</a>.</p><p>INPUT AND OUTPUT</p><p>In ACL2, most input and output involves the ACL2 state.  See <a href="IO.html">io</a>.</p><p>TIMINGS</p><p>For how to obtain the runtime elapsed since the start of the ACL2 session,
+evaluating this call of <code><a href="THM.html">thm</a></code>.</p><p>See <a href="STATE-GLOBAL-LET_star_.html">state-global-let*</a> for more complete <a href="DOCUMENTATION.html">documentation</a>.</p><p>INPUT AND OUTPUT</p><p>In ACL2, most input and output involves the ACL2 state.  See <a href="IO.html">io</a>.</p><p>TIMINGS</p><p>For how to obtain the time elapsed since the start of the ACL2 session,
 see <a href="READ-RUN-TIME.html">read-run-time</a>.</p><p>For a utility for saving times into the ACL2 state and for printing those
 saved times, see the community book <code>misc/save-time.lisp</code>.</p><p>To time an evaluation (though this really isn't about state), see <a href="TIME$.html">time$</a>.</p><p>ENVIRONMENT AND SYSTEM</p><p>Next, we mention briefly some ways in which ACL2 interacts with its
 environment using the ACL2 state.</p><p>For how to read and write environment variables, see <a href="GETENV$.html">getenv$</a> and
diff -Nru acl2-6.2/doc/HTML/PROGRAMMING.html acl2-6.3/doc/HTML/PROGRAMMING.html
--- acl2-6.2/doc/HTML/PROGRAMMING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/PROGRAMMING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROGRAMMING.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROGRAMMING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>PROGRAMMING</h1>programming in ACL2
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/PROMPT.html acl2-6.3/doc/HTML/PROMPT.html
--- acl2-6.2/doc/HTML/PROMPT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PROMPT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROMPT.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROMPT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROMPT</h2>the prompt printed by <code><a href="LD.html">ld</a></code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/PROOF-CHECKER-COMMANDS.html acl2-6.3/doc/HTML/PROOF-CHECKER-COMMANDS.html
--- acl2-6.2/doc/HTML/PROOF-CHECKER-COMMANDS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/PROOF-CHECKER-COMMANDS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROOF-CHECKER-COMMANDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROOF-CHECKER-COMMANDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROOF-CHECKER-COMMANDS</h2>list of commands for the proof-checker
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/PROOF-CHECKER.html acl2-6.3/doc/HTML/PROOF-CHECKER.html
--- acl2-6.2/doc/HTML/PROOF-CHECKER.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/PROOF-CHECKER.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROOF-CHECKER.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROOF-CHECKER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>PROOF-CHECKER</h1>support for low-level interaction
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/PROOF-OF-WELL-FOUNDEDNESS.html acl2-6.3/doc/HTML/PROOF-OF-WELL-FOUNDEDNESS.html
--- acl2-6.2/doc/HTML/PROOF-OF-WELL-FOUNDEDNESS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PROOF-OF-WELL-FOUNDEDNESS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROOF-OF-WELL-FOUNDEDNESS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROOF-OF-WELL-FOUNDEDNESS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROOF-OF-WELL-FOUNDEDNESS</h2>a proof that <code><a href="O_lt_.html">o&lt;</a></code> is well-founded on <code><a href="O-P.html">o-p</a></code>s
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/PROOF-SUPPORTERS-ALIST.html acl2-6.3/doc/HTML/PROOF-SUPPORTERS-ALIST.html
--- acl2-6.2/doc/HTML/PROOF-SUPPORTERS-ALIST.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PROOF-SUPPORTERS-ALIST.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROOF-SUPPORTERS-ALIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROOF-SUPPORTERS-ALIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROOF-SUPPORTERS-ALIST</h2>See <a href="DEAD-EVENTS.html">dead-events</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/PROOF-TREE-DETAILS.html acl2-6.3/doc/HTML/PROOF-TREE-DETAILS.html
--- acl2-6.2/doc/HTML/PROOF-TREE-DETAILS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/PROOF-TREE-DETAILS.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROOF-TREE-DETAILS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROOF-TREE-DETAILS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROOF-TREE-DETAILS</h2>proof tree details not covered elsewhere
 <pre>Major Section:  <a href="PROOF-TREE.html">PROOF-TREE</a>
diff -Nru acl2-6.2/doc/HTML/PROOF-TREE-EXAMPLES.html acl2-6.3/doc/HTML/PROOF-TREE-EXAMPLES.html
--- acl2-6.2/doc/HTML/PROOF-TREE-EXAMPLES.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/PROOF-TREE-EXAMPLES.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROOF-TREE-EXAMPLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROOF-TREE-EXAMPLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROOF-TREE-EXAMPLES</h2>proof tree example
 <pre>Major Section:  <a href="PROOF-TREE.html">PROOF-TREE</a>
diff -Nru acl2-6.2/doc/HTML/PROOF-TREE.html acl2-6.3/doc/HTML/PROOF-TREE.html
--- acl2-6.2/doc/HTML/PROOF-TREE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/PROOF-TREE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROOF-TREE.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROOF-TREE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>PROOF-TREE</h1>proof tree displays
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/PROOFS-CO.html acl2-6.3/doc/HTML/PROOFS-CO.html
--- acl2-6.2/doc/HTML/PROOFS-CO.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PROOFS-CO.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROOFS-CO.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROOFS-CO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PROOFS-CO</h3>the proofs character output channel
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PROPER-CONSP.html acl2-6.3/doc/HTML/PROPER-CONSP.html
--- acl2-6.2/doc/HTML/PROPER-CONSP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PROPER-CONSP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROPER-CONSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROPER-CONSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PROPER-CONSP</h3>recognizer for proper (null-terminated) non-empty lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PROPS.html acl2-6.3/doc/HTML/PROPS.html
--- acl2-6.2/doc/HTML/PROPS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PROPS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROPS.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROPS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROPS</h2>print the ACL2 properties on a symbol
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/PROVISIONAL-CERTIFICATION.html acl2-6.3/doc/HTML/PROVISIONAL-CERTIFICATION.html
--- acl2-6.2/doc/HTML/PROVISIONAL-CERTIFICATION.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/PROVISIONAL-CERTIFICATION.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PROVISIONAL-CERTIFICATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>PROVISIONAL-CERTIFICATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PROVISIONAL-CERTIFICATION</h2>certify a book in stages for improved parallelism
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/PR_bang_.html acl2-6.3/doc/HTML/PR_bang_.html
--- acl2-6.2/doc/HTML/PR_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PR_bang_.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PR_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>PR_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PR!</h2>print rules stored by the command with a given command descriptor
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PSEUDO-TERMP.html acl2-6.3/doc/HTML/PSEUDO-TERMP.html
--- acl2-6.2/doc/HTML/PSEUDO-TERMP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PSEUDO-TERMP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PSEUDO-TERMP.html  --  ACL2 Version 6.2</title></head>
+<head><title>PSEUDO-TERMP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PSEUDO-TERMP</h3>a predicate for recognizing term-like s-expressions
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PSO.html acl2-6.3/doc/HTML/PSO.html
--- acl2-6.2/doc/HTML/PSO.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PSO.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PSO.html  --  ACL2 Version 6.2</title></head>
+<head><title>PSO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PSO</h2>show the most recently saved output
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/PSOF.html acl2-6.3/doc/HTML/PSOF.html
--- acl2-6.2/doc/HTML/PSOF.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PSOF.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PSOF.html  --  ACL2 Version 6.2</title></head>
+<head><title>PSOF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PSOF</h2>show the most recently saved output
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/PSOG.html acl2-6.3/doc/HTML/PSOG.html
--- acl2-6.2/doc/HTML/PSOG.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PSOG.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PSOG.html  --  ACL2 Version 6.2</title></head>
+<head><title>PSOG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PSOG</h2>show the most recently saved output in <a href="GAG-MODE.html">gag-mode</a>
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/PSO_bang_.html acl2-6.3/doc/HTML/PSO_bang_.html
--- acl2-6.2/doc/HTML/PSO_bang_.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PSO_bang_.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PSO_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>PSO_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PSO!</h2>show the most recently saved output, including <a href="PROOF-TREE.html">proof-tree</a> output
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/PSTACK.html acl2-6.3/doc/HTML/PSTACK.html
--- acl2-6.2/doc/HTML/PSTACK.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/PSTACK.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PSTACK.html  --  ACL2 Version 6.2</title></head>
+<head><title>PSTACK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PSTACK</h2>seeing what the prover is up to
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/PUFF.html acl2-6.3/doc/HTML/PUFF.html
--- acl2-6.2/doc/HTML/PUFF.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PUFF.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PUFF.html  --  ACL2 Version 6.2</title></head>
+<head><title>PUFF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PUFF</h2>replace a compound <a href="COMMAND.html">command</a> by its immediate subevents
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PUFF_star_.html acl2-6.3/doc/HTML/PUFF_star_.html
--- acl2-6.2/doc/HTML/PUFF_star_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/PUFF_star_.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PUFF_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>PUFF_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PUFF*</h2>replace a compound <a href="COMMAND.html">command</a> by its subevents
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/PUSH-UNTOUCHABLE.html acl2-6.3/doc/HTML/PUSH-UNTOUCHABLE.html
--- acl2-6.2/doc/HTML/PUSH-UNTOUCHABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/PUSH-UNTOUCHABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PUSH-UNTOUCHABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>PUSH-UNTOUCHABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>PUSH-UNTOUCHABLE</h2>add name or list of names to the list of untouchable symbols
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/PUT-ASSOC-EQ.html acl2-6.3/doc/HTML/PUT-ASSOC-EQ.html
--- acl2-6.2/doc/HTML/PUT-ASSOC-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PUT-ASSOC-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PUT-ASSOC-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>PUT-ASSOC-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PUT-ASSOC-EQ</h3>See <a href="PUT-ASSOC.html">put-assoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PUT-ASSOC-EQL.html acl2-6.3/doc/HTML/PUT-ASSOC-EQL.html
--- acl2-6.2/doc/HTML/PUT-ASSOC-EQL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PUT-ASSOC-EQL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PUT-ASSOC-EQL.html  --  ACL2 Version 6.2</title></head>
+<head><title>PUT-ASSOC-EQL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PUT-ASSOC-EQL</h3>See <a href="PUT-ASSOC.html">put-assoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PUT-ASSOC-EQUAL.html acl2-6.3/doc/HTML/PUT-ASSOC-EQUAL.html
--- acl2-6.2/doc/HTML/PUT-ASSOC-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PUT-ASSOC-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PUT-ASSOC-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>PUT-ASSOC-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PUT-ASSOC-EQUAL</h3>See <a href="PUT-ASSOC.html">put-assoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PUT-ASSOC.html acl2-6.3/doc/HTML/PUT-ASSOC.html
--- acl2-6.2/doc/HTML/PUT-ASSOC.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PUT-ASSOC.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PUT-ASSOC.html  --  ACL2 Version 6.2</title></head>
+<head><title>PUT-ASSOC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PUT-ASSOC</h3>modify an association list by associating a value with a key
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/PUTPROP.html acl2-6.3/doc/HTML/PUTPROP.html
--- acl2-6.2/doc/HTML/PUTPROP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/PUTPROP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>PUTPROP.html  --  ACL2 Version 6.2</title></head>
+<head><title>PUTPROP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>PUTPROP</h3>update fast property lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/P_bang_.html acl2-6.3/doc/HTML/P_bang_.html
--- acl2-6.2/doc/HTML/P_bang_.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/P_bang_.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>P_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>P_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>P!</h2>to pop up (at least) one level of ACL2's command loop
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/Pages_Written_Especially_for_the_Tours.html acl2-6.3/doc/HTML/Pages_Written_Especially_for_the_Tours.html
--- acl2-6.2/doc/HTML/Pages_Written_Especially_for_the_Tours.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Pages_Written_Especially_for_the_Tours.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Pages_Written_Especially_for_the_Tours.html  --  ACL2 Version 6.2</title></head>
+<head><title>Pages_Written_Especially_for_the_Tours.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>Pages Written Especially for the Tours</h1>Pages Written Especially for the Tours
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/Perhaps.html acl2-6.3/doc/HTML/Perhaps.html
--- acl2-6.2/doc/HTML/Perhaps.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Perhaps.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Perhaps.html  --  ACL2 Version 6.2</title></head>
+<head><title>Perhaps.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Perhaps</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Popping_out_of_an_Inductive_Proof.html acl2-6.3/doc/HTML/Popping_out_of_an_Inductive_Proof.html
--- acl2-6.2/doc/HTML/Popping_out_of_an_Inductive_Proof.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Popping_out_of_an_Inductive_Proof.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Popping_out_of_an_Inductive_Proof.html  --  ACL2 Version 6.2</title></head>
+<head><title>Popping_out_of_an_Inductive_Proof.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Popping out of an Inductive Proof</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Proving_Theorems_about_Models.html acl2-6.3/doc/HTML/Proving_Theorems_about_Models.html
--- acl2-6.2/doc/HTML/Proving_Theorems_about_Models.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Proving_Theorems_about_Models.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Proving_Theorems_about_Models.html  --  ACL2 Version 6.2</title></head>
+<head><title>Proving_Theorems_about_Models.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Proving Theorems about Models</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Q.html acl2-6.3/doc/HTML/Q.html
--- acl2-6.2/doc/HTML/Q.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/Q.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Q.html  --  ACL2 Version 6.2</title></head>
+<head><title>Q.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Q</h2>quit ACL2 (type <code>:q</code>) -- reenter with <code>(lp)</code>
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/QUANTIFIER-TUTORIAL.html acl2-6.3/doc/HTML/QUANTIFIER-TUTORIAL.html
--- acl2-6.2/doc/HTML/QUANTIFIER-TUTORIAL.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/QUANTIFIER-TUTORIAL.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>QUANTIFIER-TUTORIAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>QUANTIFIER-TUTORIAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>QUANTIFIER-TUTORIAL</h3>A Beginner's Guide to Reasoning about Quantification in ACL2
 <pre>Major Section:  <a href="DEFUN-SK.html">DEFUN-SK</a>
diff -Nru acl2-6.2/doc/HTML/QUANTIFIERS-USING-DEFUN-SK-EXTENDED.html acl2-6.3/doc/HTML/QUANTIFIERS-USING-DEFUN-SK-EXTENDED.html
--- acl2-6.2/doc/HTML/QUANTIFIERS-USING-DEFUN-SK-EXTENDED.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/QUANTIFIERS-USING-DEFUN-SK-EXTENDED.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>QUANTIFIERS-USING-DEFUN-SK-EXTENDED.html  --  ACL2 Version 6.2</title></head>
+<head><title>QUANTIFIERS-USING-DEFUN-SK-EXTENDED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>QUANTIFIERS-USING-DEFUN-SK-EXTENDED</h4>quantification example with details
 <pre>Major Section:  <a href="QUANTIFIERS.html">QUANTIFIERS</a>
diff -Nru acl2-6.2/doc/HTML/QUANTIFIERS-USING-DEFUN-SK.html acl2-6.3/doc/HTML/QUANTIFIERS-USING-DEFUN-SK.html
--- acl2-6.2/doc/HTML/QUANTIFIERS-USING-DEFUN-SK.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/QUANTIFIERS-USING-DEFUN-SK.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>QUANTIFIERS-USING-DEFUN-SK.html  --  ACL2 Version 6.2</title></head>
+<head><title>QUANTIFIERS-USING-DEFUN-SK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>QUANTIFIERS-USING-DEFUN-SK</h4>quantification example
 <pre>Major Section:  <a href="QUANTIFIERS.html">QUANTIFIERS</a>
diff -Nru acl2-6.2/doc/HTML/QUANTIFIERS-USING-RECURSION.html acl2-6.3/doc/HTML/QUANTIFIERS-USING-RECURSION.html
--- acl2-6.2/doc/HTML/QUANTIFIERS-USING-RECURSION.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/QUANTIFIERS-USING-RECURSION.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>QUANTIFIERS-USING-RECURSION.html  --  ACL2 Version 6.2</title></head>
+<head><title>QUANTIFIERS-USING-RECURSION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h4>QUANTIFIERS-USING-RECURSION</h4>recursion for implementing quantification
 <pre>Major Section:  <a href="QUANTIFIERS.html">QUANTIFIERS</a>
diff -Nru acl2-6.2/doc/HTML/QUANTIFIERS.html acl2-6.3/doc/HTML/QUANTIFIERS.html
--- acl2-6.2/doc/HTML/QUANTIFIERS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/QUANTIFIERS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>QUANTIFIERS.html  --  ACL2 Version 6.2</title></head>
+<head><title>QUANTIFIERS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>QUANTIFIERS</h3>issues about quantification in ACL2
 <pre>Major Section:  <a href="DEFUN-SK.html">DEFUN-SK</a>
diff -Nru acl2-6.2/doc/HTML/QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP.html acl2-6.3/doc/HTML/QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP.html
--- acl2-6.2/doc/HTML/QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP.html  --  ACL2 Version 6.2</title></head>
+<head><title>QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>QUICK-AND-DIRTY-SUBSUMPTION-REPLACEMENT-STEP</h2>(advanced topic) controlling a heuristic in the prover's clausifier
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/QUIT.html acl2-6.3/doc/HTML/QUIT.html
--- acl2-6.2/doc/HTML/QUIT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/QUIT.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>QUIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>QUIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>QUIT</h2>quit entirely out of Lisp
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/QUOTE.html acl2-6.3/doc/HTML/QUOTE.html
--- acl2-6.2/doc/HTML/QUOTE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/QUOTE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>QUOTE.html  --  ACL2 Version 6.2</title></head>
+<head><title>QUOTE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>QUOTE</h3>create a constant
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/R-EQLABLE-ALISTP.html acl2-6.3/doc/HTML/R-EQLABLE-ALISTP.html
--- acl2-6.2/doc/HTML/R-EQLABLE-ALISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/R-EQLABLE-ALISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>R-EQLABLE-ALISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>R-EQLABLE-ALISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>R-EQLABLE-ALISTP</h3>recognizer for a true list of pairs whose <code><a href="CDR.html">cdr</a></code>s are suitable for <code><a href="EQL.html">eql</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/R-SYMBOL-ALISTP.html acl2-6.3/doc/HTML/R-SYMBOL-ALISTP.html
--- acl2-6.2/doc/HTML/R-SYMBOL-ALISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/R-SYMBOL-ALISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>R-SYMBOL-ALISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>R-SYMBOL-ALISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>R-SYMBOL-ALISTP</h3>recognizer for association lists with symbols as values
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/RANDOM$.html acl2-6.3/doc/HTML/RANDOM$.html
--- acl2-6.2/doc/HTML/RANDOM$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/RANDOM$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RANDOM$.html  --  ACL2 Version 6.2</title></head>
+<head><title>RANDOM$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>RANDOM$</h3>obtain a random value
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/RASSOC-EQ.html acl2-6.3/doc/HTML/RASSOC-EQ.html
--- acl2-6.2/doc/HTML/RASSOC-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/RASSOC-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RASSOC-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>RASSOC-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>RASSOC-EQ</h3>See <a href="RASSOC.html">rassoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/RASSOC-EQUAL.html acl2-6.3/doc/HTML/RASSOC-EQUAL.html
--- acl2-6.2/doc/HTML/RASSOC-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/RASSOC-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RASSOC-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>RASSOC-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>RASSOC-EQUAL</h3>See <a href="RASSOC.html">rassoc</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/RASSOC.html acl2-6.3/doc/HTML/RASSOC.html
--- acl2-6.2/doc/HTML/RASSOC.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/RASSOC.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RASSOC.html  --  ACL2 Version 6.2</title></head>
+<head><title>RASSOC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>RASSOC</h3>look up value in association list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/RATIONAL-LISTP.html acl2-6.3/doc/HTML/RATIONAL-LISTP.html
--- acl2-6.2/doc/HTML/RATIONAL-LISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/RATIONAL-LISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RATIONAL-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>RATIONAL-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>RATIONAL-LISTP</h3>recognizer for a true list of rational numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/RATIONALP.html acl2-6.3/doc/HTML/RATIONALP.html
--- acl2-6.2/doc/HTML/RATIONALP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/RATIONALP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RATIONALP.html  --  ACL2 Version 6.2</title></head>
+<head><title>RATIONALP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>RATIONALP</h3>recognizer for rational numbers (ratios and integers)
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/READ-BYTE$.html acl2-6.3/doc/HTML/READ-BYTE$.html
--- acl2-6.2/doc/HTML/READ-BYTE$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/READ-BYTE$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>READ-BYTE$.html  --  ACL2 Version 6.2</title></head>
+<head><title>READ-BYTE$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>READ-BYTE$</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/READ-CHAR$.html acl2-6.3/doc/HTML/READ-CHAR$.html
--- acl2-6.2/doc/HTML/READ-CHAR$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/READ-CHAR$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>READ-CHAR$.html  --  ACL2 Version 6.2</title></head>
+<head><title>READ-CHAR$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>READ-CHAR$</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/READ-OBJECT.html acl2-6.3/doc/HTML/READ-OBJECT.html
--- acl2-6.2/doc/HTML/READ-OBJECT.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/READ-OBJECT.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>READ-OBJECT.html  --  ACL2 Version 6.2</title></head>
+<head><title>READ-OBJECT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>READ-OBJECT</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/READ-RUN-TIME.html acl2-6.3/doc/HTML/READ-RUN-TIME.html
--- acl2-6.2/doc/HTML/READ-RUN-TIME.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/READ-RUN-TIME.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,18 +1,20 @@
 <html>
-<head><title>READ-RUN-TIME.html  --  ACL2 Version 6.2</title></head>
+<head><title>READ-RUN-TIME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>READ-RUN-TIME</h3>read elapsed runtime
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
 </pre><p/>
 <p>
-<code>(Read-run-time state)</code> returns <code>(mv runtime state)</code>, where runtime is
-the elapsed runtime in seconds since the start of the current ACL2 session
-and <code>state</code> is the resulting ACL2 <a href="STATE.html">state</a>.
+By default, <code>(read-run-time state)</code> returns <code>(mv runtime state)</code>, where
+runtime is the elapsed runtime in seconds since the start of the current ACL2
+session and <code>state</code> is the resulting ACL2 <a href="STATE.html">state</a>.  But
+<code>read-run-time</code> can be made to return elapsed realtime (wall clock time)
+instead; see <a href="GET-INTERNAL-TIME.html">get-internal-time</a>.
 </p>
 <p>The logical definition probably won't concern many users, but for
 completeness, we say a word about it here.  That definition uses the function
-<code>read-acl2-oracle</code>, which modifies state by popping the returned
-<code>runtime</code> value from its acl2-oracle field.
+<code>read-acl2-oracle</code>, which modifies state by popping the value to return
+from its acl2-oracle field.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
 </html>
diff -Nru acl2-6.2/doc/HTML/REAL-LISTP.html acl2-6.3/doc/HTML/REAL-LISTP.html
--- acl2-6.2/doc/HTML/REAL-LISTP.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/REAL-LISTP.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REAL-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>REAL-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REAL-LISTP</h2>ACL2(r) recognizer for a true list of real numbers
 <pre>Major Section:  <a href="REAL.html">REAL</a>
diff -Nru acl2-6.2/doc/HTML/REAL.html acl2-6.3/doc/HTML/REAL.html
--- acl2-6.2/doc/HTML/REAL.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/REAL.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>REAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>REAL</h1>ACL2(r) support for real numbers
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -21,7 +21,7 @@
 This will create an executable in your acl2-sources directory named
 <code>saved_acl2r</code>.</p><p>Note that if you download community books as tarfiles, then you should be
 sure to download the `nonstd' books, from
-<a href="http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz">http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz</a>.  Then certify
+<a href="http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz">http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz</a>.  Then certify
 them from your acl2-sources directory, shown here as
 <code>&lt;DIR&gt;</code>:
 
diff -Nru acl2-6.2/doc/HTML/REALFIX.html acl2-6.3/doc/HTML/REALFIX.html
--- acl2-6.2/doc/HTML/REALFIX.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REALFIX.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REALFIX.html  --  ACL2 Version 6.2</title></head>
+<head><title>REALFIX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REALFIX</h3>coerce to a real number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REALPART.html acl2-6.3/doc/HTML/REALPART.html
--- acl2-6.2/doc/HTML/REALPART.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REALPART.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REALPART.html  --  ACL2 Version 6.2</title></head>
+<head><title>REALPART.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REALPART</h3>real part of a complex number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REAL_slash_RATIONALP.html acl2-6.3/doc/HTML/REAL_slash_RATIONALP.html
--- acl2-6.2/doc/HTML/REAL_slash_RATIONALP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REAL_slash_RATIONALP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REAL_slash_RATIONALP.html  --  ACL2 Version 6.2</title></head>
+<head><title>REAL_slash_RATIONALP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REAL/RATIONALP</h3>recognizer for rational numbers (including real number in ACL2(r))
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REBUILD.html acl2-6.3/doc/HTML/REBUILD.html
--- acl2-6.2/doc/HTML/REBUILD.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REBUILD.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REBUILD.html  --  ACL2 Version 6.2</title></head>
+<head><title>REBUILD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REBUILD</h2>a convenient way to reconstruct your old <a href="STATE.html">state</a>
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/REDEF+.html acl2-6.3/doc/HTML/REDEF+.html
--- acl2-6.2/doc/HTML/REDEF+.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REDEF+.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REDEF+.html  --  ACL2 Version 6.2</title></head>
+<head><title>REDEF+.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REDEF+</h2>system hacker's redefinition <a href="COMMAND.html">command</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/REDEF-.html acl2-6.3/doc/HTML/REDEF-.html
--- acl2-6.2/doc/HTML/REDEF-.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REDEF-.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REDEF-.html  --  ACL2 Version 6.2</title></head>
+<head><title>REDEF-.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REDEF-</h2>turn off system hacker's redefinition <a href="COMMAND.html">command</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/REDEF.html acl2-6.3/doc/HTML/REDEF.html
--- acl2-6.2/doc/HTML/REDEF.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REDEF.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REDEF.html  --  ACL2 Version 6.2</title></head>
+<head><title>REDEF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REDEF</h2>a common way to set <a href="LD-REDEFINITION-ACTION.html">ld-redefinition-action</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/REDEFINED-NAMES.html acl2-6.3/doc/HTML/REDEFINED-NAMES.html
--- acl2-6.2/doc/HTML/REDEFINED-NAMES.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REDEFINED-NAMES.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REDEFINED-NAMES.html  --  ACL2 Version 6.2</title></head>
+<head><title>REDEFINED-NAMES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REDEFINED-NAMES</h2>to collect the names that have been redefined
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/REDEFINING-PROGRAMS.html acl2-6.3/doc/HTML/REDEFINING-PROGRAMS.html
--- acl2-6.2/doc/HTML/REDEFINING-PROGRAMS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/REDEFINING-PROGRAMS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REDEFINING-PROGRAMS.html  --  ACL2 Version 6.2</title></head>
+<head><title>REDEFINING-PROGRAMS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REDEFINING-PROGRAMS</h2>an explanation of why we restrict redefinitions
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/REDEF_bang_.html acl2-6.3/doc/HTML/REDEF_bang_.html
--- acl2-6.2/doc/HTML/REDEF_bang_.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REDEF_bang_.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REDEF_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>REDEF_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REDEF!</h2>a common way to set <a href="LD-REDEFINITION-ACTION.html">ld-redefinition-action</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/REDO-FLAT.html acl2-6.3/doc/HTML/REDO-FLAT.html
--- acl2-6.2/doc/HTML/REDO-FLAT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REDO-FLAT.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REDO-FLAT.html  --  ACL2 Version 6.2</title></head>
+<head><title>REDO-FLAT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REDO-FLAT</h2>redo on failure of a <code><a href="PROGN.html">progn</a></code>, <code><a href="ENCAPSULATE.html">encapsulate</a></code>, or <code><a href="CERTIFY-BOOK.html">certify-book</a></code>
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/REDUNDANT-ENCAPSULATE.html acl2-6.3/doc/HTML/REDUNDANT-ENCAPSULATE.html
--- acl2-6.2/doc/HTML/REDUNDANT-ENCAPSULATE.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/REDUNDANT-ENCAPSULATE.html	2013-09-30 17:39:27.000000000 +0000
@@ -0,0 +1,95 @@
+<html>
+<head><title>REDUNDANT-ENCAPSULATE.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h3>REDUNDANT-ENCAPSULATE</h3>redundancy of <code><a href="ENCAPSULATE.html">encapsulate</a></code> <a href="EVENTS.html">events</a>
+<pre>Major Section:  <a href="ENCAPSULATE.html">ENCAPSULATE</a>
+</pre><p/>
+<p>
+For this <a href="DOCUMENTATION.html">documentation</a> topic we assume familiarity with <code>encapsulate</code>
+events and the notion of redundancy for <a href="EVENTS.html">events</a>; see <a href="ENCAPSULATE.html">encapsulate</a> and
+see <a href="REDUNDANT-EVENTS.html">redundant-events</a>.</p><p>The typical way for an <code>encapsulate</code> event to be redundant is when a
+syntactically identical <code>encapsulate</code> has already been executed under the
+same <code><a href="DEFAULT-DEFUN-MODE.html">default-defun-mode</a></code>, <code><a href="DEFAULT-RULER-EXTENDERS.html">default-ruler-extenders</a></code>, and
+<code><a href="DEFAULT-VERIFY-GUARDS-EAGERNESS.html">default-verify-guards-eagerness</a></code>.  But more generally, the
+<code>encapsulate</code> events need not be syntactically identical; for example, it
+suffices that they agree when the contents of <code><a href="LOCAL.html">local</a></code> sub-events are
+ignored.  The precise criterion for redundancy is given below, but let us
+first look at a consequence of the point just made about ignoring the
+contents of <code><a href="LOCAL.html">local</a></code> sub-events.  Consider the following sequence of two
+events.
+
+<pre>
+(encapsulate
+ ()
+ (defun f (x) x)
+ (local (defthm f-identity
+          (equal (f x) x))))
+
+(encapsulate
+ ()
+ (defun f (x) x)
+ (local (defthm false-claim
+          (equal (f x) (not x)))))
+</pre>
+
+You might be surprised to learn that the second is actually redundant, even
+though <code>false-claim</code> is clearly not a theorem; indeed, its negation is a
+theorem!  The following two points may soften the blow.  First, this behavior
+is as specified above (and is specified more precisely below): the contents
+of <a href="LOCAL.html">local</a> events are ignored when checking redundancy of
+<code><a href="ENCAPSULATE.html">encapsulate</a></code> events.  Second, this behavior is sound, because the
+logical meaning of an <code><a href="ENCAPSULATE.html">encapsulate</a></code> event is taken from the events that
+it exports, which do not include events that are <a href="LOCAL.html">local</a> to the
+<code>encapsulate</code> event.</p><p>Some users, however, want to use <code><a href="ENCAPSULATE.html">encapsulate</a></code> events for testing in a
+way that is thwarted by this ignoring of <a href="LOCAL.html">local</a> sub-events.  Consider
+the following sort of example.
+
+<pre>
+(encapsulate ()
+             (local (defthm test1 ...)))
+
+(encapsulate ()
+             (local (defthm test2 ...)))
+</pre>
+
+Since the contents of local events are ignored when checking redundancy of an
+<code>encapsulate</code> event, the second form just above is indeed redundant,
+presumably not as expected by whomever wrote these two tests.  A solution is
+to add distinct non-local forms, for example as follows.
+
+<pre>
+(encapsulate ()
+             (value-triple "test1")
+             (local (defthm test1 ...)))
+
+(encapsulate ()
+             (value-triple "test2")
+             (local (defthm test2 ...)))
+</pre>
+
+A different solution is to use <code><a href="MAKE-EVENT.html">make-event</a></code> for testing, as follows.
+
+<pre>
+(make-event (er-progn (defthm test1 ...)
+                      (value '(value-triple nil))))
+(make-event (er-progn (defthm test2 ...)
+                      (value '(value-triple nil))))
+</pre>
+
+Also see community books <code>misc/eval.lisp</code>, <code>make-event/eval-check.lisp</code>,
+and <code>make-event/eval-tests.lisp</code> for more ways to test in books.</p><p>The precise criterion for redundancy of <code><a href="ENCAPSULATE.html">encapsulate</a></code> <a href="EVENTS.html">events</a> is that
+the existing and proposed <code>encapsulate</code> events contain the same signatures
+and the same number of top-level events -- let <code>k</code> be that number --
+and for each <code>i &lt; k</code>, the <code>i</code>th top-level events <code>E1</code> and <code>E2</code> from
+the earlier and current <code>encapsulate</code>s have one of the following
+properties.</p><p>o <code>E1</code> and <code>E2</code> are equal; or</p><p>o <code>E1</code> is of the form <code>(record-expansion E2 ...)</code>; or else</p><p>o <code>E1</code> and <code>E2</code> are equal after replacing each <code><a href="LOCAL.html">local</a></code> sub-event by
+<code>(local (value-triple :elided))</code>, where a sub-event of an event <code>E</code> is
+either <code>E</code> itself, or a sub-event of a constituent event of <code>E</code> in the
+case that <code>E</code> is a call of <code><a href="WITH-OUTPUT.html">with-output</a></code>, <code><a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a></code>,
+<code><a href="WITH-PROVER-STEP-LIMIT.html">with-prover-step-limit</a></code>, <code>record-expansion</code>, <code><a href="TIME$.html">time$</a></code>, <code><a href="PROGN.html">progn</a></code>,
+<code><a href="PROGN_bang_.html">progn!</a></code>, or <code>encapsulate</code> itself.
+</p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/REDUNDANT-EVENTS.html acl2-6.3/doc/HTML/REDUNDANT-EVENTS.html
--- acl2-6.2/doc/HTML/REDUNDANT-EVENTS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REDUNDANT-EVENTS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REDUNDANT-EVENTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>REDUNDANT-EVENTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REDUNDANT-EVENTS</h2>allowing a name to be introduced ``twice''
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
@@ -15,7 +15,7 @@
 a form.
 
 <pre>
-(value-triple (cw "Hello world.~%"))
+  (value-triple (cw "Hello world.~%"))
 </pre>
 
 </p>
@@ -62,10 +62,11 @@
 and the other to have no explicit guard (hence, the guard is implicitly
 <code>t</code>).<br/>
 
-(3) The <code>:measure</code> check is avoided if we are skipping proofs (for example,
-during <code><a href="INCLUDE-BOOK.html">include-book</a></code>), and otherwise, the new definition may have a
-<code>:measure</code> of <code>(:? v1 ... vk)</code>, where <code>(v1 ... vk)</code> enumerates the
-variables occurring in the measure stored for the old definition.<br/>
+(3) The <code>:measure</code> check is avoided if the old definition is non-recursive
+(and not defined within a <code><a href="MUTUAL-RECURSION.html">mutual-recursion</a></code>) or we are skipping proofs
+(for example, during <code><a href="INCLUDE-BOOK.html">include-book</a></code>).  Otherwise, the new definition may
+have a <code>:measure</code> of <code>(:? v1 ... vk)</code>, where <code>(v1 ... vk)</code> enumerates
+the variables occurring in the measure stored for the old definition.<br/>
 
 (4) If either the old or new event is a <code><a href="MUTUAL-RECURSION.html">mutual-recursion</a></code> event, then
 redundancy requires that both are <code><a href="MUTUAL-RECURSION.html">mutual-recursion</a></code> events that define
@@ -74,7 +75,7 @@
 <code><a href="DEFAULT-DEFUN-MODE.html">default-defun-mode</a></code>, <code><a href="DEFAULT-RULER-EXTENDERS.html">default-ruler-extenders</a></code>, and
 <code><a href="DEFAULT-VERIFY-GUARDS-EAGERNESS.html">default-verify-guards-eagerness</a></code>.  The full criterion for redundancy of
 <code>encapsulate</code> events is more complex, for example ignoring contents of
-<code><a href="LOCAL.html">local</a></code> <a href="EVENTS.html">events</a>; see <a href="ENCAPSULATE.html">encapsulate</a>.</p><p>An <code><a href="IN-THEORY.html">in-theory</a></code> event is never redundant.  Note that it doesn't define any
+<code><a href="LOCAL.html">local</a></code> <a href="EVENTS.html">events</a>; see <a href="REDUNDANT-ENCAPSULATE.html">redundant-encapsulate</a>.</p><p>An <code><a href="IN-THEORY.html">in-theory</a></code> event is never redundant.  Note that it doesn't define any
 name.</p><p>An <code><a href="INCLUDE-BOOK.html">include-book</a></code> event is redundant if the book has already been
 included.</p><p>A call of <code><a href="MAKE-EVENT.html">make-event</a></code> is never redundant, as its argument is always
 evaluated to obtain the make-event expansion.  However, that expansion may of
@@ -123,8 +124,8 @@
 compute the theory as the very last event in the book using:
 
 <pre>
-(set-difference-theories (universal-theory :here)
-                         (universal-theory fn))
+  (set-difference-theories (universal-theory :here)
+                           (universal-theory fn))
 </pre>
 
 where <code>fn</code> is the very first event in the book and happens to be a
@@ -140,13 +141,13 @@
 function can fail to make any change.
 
 <pre>
-(set-ld-redefinition-action '(:warn . :overwrite) state)
-(defmacro mac (x) x)
-(defun foo (x) (mac x))
-(defmacro mac (x) (list 'car x))
-(set-ld-redefinition-action nil state)
-(defun foo (x) (mac x)) ; redundant, unfortunately; foo does not change
-(thm (equal (foo 3) 3)) ; succeeds, showing that redef of foo didn't happen
+  (set-ld-redefinition-action '(:warn . :overwrite) state)
+  (defmacro mac (x) x)
+  (defun foo (x) (mac x))
+  (defmacro mac (x) (list 'car x))
+  (set-ld-redefinition-action nil state)
+  (defun foo (x) (mac x)) ; redundant, unfortunately; foo does not change
+  (thm (equal (foo 3) 3)) ; succeeds, showing that redef of foo didn't happen
 </pre>
 
 The call of macro <code>mac</code> was expanded away before storing the first
@@ -159,12 +160,12 @@
 the example above we remove the form
 <code>(set-ld-redefinition-action nil state)</code>, then the problem goes away:</p><p>
 <pre>
-(set-ld-redefinition-action '(:warn . :overwrite) state)
-(defmacro mac (x) x)
-(defun foo (x) (mac x))
-(defmacro mac (x) (list 'car x))
-(defun foo (x) (mac x)) ; no longer redundant
-(thm (equal (foo 3) 3)) ; fails, as we would like
+  (set-ld-redefinition-action '(:warn . :overwrite) state)
+  (defmacro mac (x) x)
+  (defun foo (x) (mac x))
+  (defmacro mac (x) (list 'car x))
+  (defun foo (x) (mac x)) ; no longer redundant
+  (thm (equal (foo 3) 3)) ; fails, as we would like
 </pre>
 </p><p>To summarize: If a <code><a href="DEFUN.html">defun</a></code> form is submitted that meets the usual
 redundancy criteria, then it may be considered redundant even if a macro
@@ -179,13 +180,13 @@
 on one supplied by Grant Passmore.
 
 <pre>
-(defun n3 () 0)
-(defun n4 () 1)
-(defun n5 () (&gt; (n3) (n4))) ; body is normalized to nil
-(thm (equal (n5) nil)) ; succeeds, trivially
-(set-ld-redefinition-action '(:warn . :overwrite) state)
-(defun n3 () 2)
-(thm (equal (n5) nil)) ; still succeeds, sadly
+  (defun n3 () 0)
+  (defun n4 () 1)
+  (defun n5 () (&gt; (n3) (n4))) ; body is normalized to nil
+  (thm (equal (n5) nil)) ; succeeds, trivially
+  (set-ld-redefinition-action '(:warn . :overwrite) state)
+  (defun n3 () 2)
+  (thm (equal (n5) nil)) ; still succeeds, sadly
 </pre>
 
 We may expect the final <code><a href="THM.html">thm</a></code> call to fail because of the following
@@ -204,14 +205,15 @@
 redefine <code>n5</code> to be something different, and then redefine <code>n5</code> again to
 be as desired.</p><p>A related phenomenon can occur for <code><a href="ENCAPSULATE.html">encapsulate</a></code>.  As explained above, an
 <code>encapsulate</code> event is redundant if it is identical to one already in the
-database.  Consider then the following contrived example.
+database.  (But a weaker condition applies in general;
+see <a href="REDUNDANT-ENCAPSULATE.html">redundant-encapsulate</a>.)  Consider then the following contrived example.
 
 <pre>
-(defmacro mac (x) x)
-(encapsulate () (defun foo (x) (mac x)))
-(set-ld-redefinition-action '(:warn . :overwrite) state)
-(defmacro mac (x) (list 'car x))
-(encapsulate () (defun foo (x) (mac x)))
+  (defmacro mac (x) x)
+  (encapsulate () (defun foo (x) (mac x)))
+  (set-ld-redefinition-action '(:warn . :overwrite) state)
+  (defmacro mac (x) (list 'car x))
+  (encapsulate () (defun foo (x) (mac x)))
 </pre>
 
 The last <code>encapsulate</code> event is redundant because it meets the criterion
@@ -223,9 +225,9 @@
 example:
 
 <pre>
-(encapsulate ()
-  (deflabel try2) ; ``Increment'' to try3 next time, and so on.
-  (defun foo (x) x))
+  (encapsulate ()
+    (deflabel try2) ; ``Increment'' to try3 next time, and so on.
+    (defun foo (x) x))
 </pre>
 
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
diff -Nru acl2-6.2/doc/HTML/REFINEMENT.html acl2-6.3/doc/HTML/REFINEMENT.html
--- acl2-6.2/doc/HTML/REFINEMENT.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/REFINEMENT.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,20 +1,21 @@
 <html>
-<head><title>REFINEMENT.html  --  ACL2 Version 6.2</title></head>
+<head><title>REFINEMENT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REFINEMENT</h2>record that one equivalence relation refines another
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example
-<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula from which a <code>:refinement</code> rule might be built is:
-
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
 <pre>
 Example:
-(implies (bag-equal x y) (set-equal y x)).
+(defthm bag-equal-refines-set-equal
+  (implies (bag-equal x y)
+           (set-equal y x))
+  :rule-classes :refinement)
 </pre>
-
-Also see <a href="DEFREFINEMENT.html">defrefinement</a>.
+</p><p>Also see <a href="DEFREFINEMENT.html">defrefinement</a>.
 </p>
 <p>
 <pre>
diff -Nru acl2-6.2/doc/HTML/REGENERATE-TAU-DATABASE.html acl2-6.3/doc/HTML/REGENERATE-TAU-DATABASE.html
--- acl2-6.2/doc/HTML/REGENERATE-TAU-DATABASE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/REGENERATE-TAU-DATABASE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REGENERATE-TAU-DATABASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>REGENERATE-TAU-DATABASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REGENERATE-TAU-DATABASE</h2>regenerate the tau database relative to the current enabled theory
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/REGRESSION.html acl2-6.3/doc/HTML/REGRESSION.html
--- acl2-6.2/doc/HTML/REGRESSION.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/REGRESSION.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REGRESSION.html  --  ACL2 Version 6.2</title></head>
+<head><title>REGRESSION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REGRESSION</h2>See <a href="BOOKS-CERTIFICATION.html">books-certification</a>.
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/RELEASE-NOTES.html acl2-6.3/doc/HTML/RELEASE-NOTES.html
--- acl2-6.2/doc/HTML/RELEASE-NOTES.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/RELEASE-NOTES.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RELEASE-NOTES.html  --  ACL2 Version 6.2</title></head>
+<head><title>RELEASE-NOTES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>RELEASE-NOTES</h1>pointers to what has changed
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -216,6 +216,10 @@
 </h3>
 </li>
 
+<li><h3><a href="NOTE-6-3.html">NOTE-6-3</a> -- ACL2 Version  6.3 (October, 2013) Notes
+</h3>
+</li>
+
 <li><h3><a href="NOTE1.html">NOTE1</a> -- Acl2 Version 1.1 Notes
 </h3>
 </li>
diff -Nru acl2-6.2/doc/HTML/REM.html acl2-6.3/doc/HTML/REM.html
--- acl2-6.2/doc/HTML/REM.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REM.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REM.html  --  ACL2 Version 6.2</title></head>
+<head><title>REM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REM</h3>remainder using <code><a href="TRUNCATE.html">truncate</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-BINOP.html acl2-6.3/doc/HTML/REMOVE-BINOP.html
--- acl2-6.2/doc/HTML/REMOVE-BINOP.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-BINOP.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-BINOP.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-BINOP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-BINOP</h2>remove the association of a function name with a macro name
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-CUSTOM-KEYWORD-HINT.html acl2-6.3/doc/HTML/REMOVE-CUSTOM-KEYWORD-HINT.html
--- acl2-6.2/doc/HTML/REMOVE-CUSTOM-KEYWORD-HINT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-CUSTOM-KEYWORD-HINT.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-CUSTOM-KEYWORD-HINT.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-CUSTOM-KEYWORD-HINT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-CUSTOM-KEYWORD-HINT</h2>remove a custom keyword hint
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-DEFAULT-HINTS.html acl2-6.3/doc/HTML/REMOVE-DEFAULT-HINTS.html
--- acl2-6.2/doc/HTML/REMOVE-DEFAULT-HINTS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-DEFAULT-HINTS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-DEFAULT-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-DEFAULT-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-DEFAULT-HINTS</h2>remove from the default hints
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-DEFAULT-HINTS_bang_.html acl2-6.3/doc/HTML/REMOVE-DEFAULT-HINTS_bang_.html
--- acl2-6.2/doc/HTML/REMOVE-DEFAULT-HINTS_bang_.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-DEFAULT-HINTS_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-DEFAULT-HINTS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-DEFAULT-HINTS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-DEFAULT-HINTS!</h2>remove from the default hints non-<code><a href="LOCAL.html">local</a></code>ly
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-DIVE-INTO-MACRO.html acl2-6.3/doc/HTML/REMOVE-DIVE-INTO-MACRO.html
--- acl2-6.2/doc/HTML/REMOVE-DIVE-INTO-MACRO.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-DIVE-INTO-MACRO.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-DIVE-INTO-MACRO.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-DIVE-INTO-MACRO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-DIVE-INTO-MACRO</h2>removes association of <a href="PROOF-CHECKER.html">proof-checker</a> diving function with macro name
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-DUPLICATES-EQ.html acl2-6.3/doc/HTML/REMOVE-DUPLICATES-EQ.html
--- acl2-6.2/doc/HTML/REMOVE-DUPLICATES-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-DUPLICATES-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-DUPLICATES-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-DUPLICATES-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE-DUPLICATES-EQ</h3>See <a href="REMOVE-DUPLICATES.html">remove-duplicates</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-DUPLICATES-EQUAL.html acl2-6.3/doc/HTML/REMOVE-DUPLICATES-EQUAL.html
--- acl2-6.2/doc/HTML/REMOVE-DUPLICATES-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-DUPLICATES-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-DUPLICATES-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-DUPLICATES-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE-DUPLICATES-EQUAL</h3>See <a href="REMOVE-DUPLICATES.html">remove-duplicates</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-DUPLICATES.html acl2-6.3/doc/HTML/REMOVE-DUPLICATES.html
--- acl2-6.2/doc/HTML/REMOVE-DUPLICATES.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-DUPLICATES.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-DUPLICATES.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-DUPLICATES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE-DUPLICATES</h3>remove duplicates from a string or a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-EQ.html acl2-6.3/doc/HTML/REMOVE-EQ.html
--- acl2-6.2/doc/HTML/REMOVE-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE-EQ</h3>See <a href="REMOVE.html">remove</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-EQUAL.html acl2-6.3/doc/HTML/REMOVE-EQUAL.html
--- acl2-6.2/doc/HTML/REMOVE-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE-EQUAL</h3>See <a href="REMOVE.html">remove</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-INVISIBLE-FNS.html acl2-6.3/doc/HTML/REMOVE-INVISIBLE-FNS.html
--- acl2-6.2/doc/HTML/REMOVE-INVISIBLE-FNS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-INVISIBLE-FNS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-INVISIBLE-FNS.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-INVISIBLE-FNS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-INVISIBLE-FNS</h2>make some unary functions no longer invisible
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-MACRO-ALIAS.html acl2-6.3/doc/HTML/REMOVE-MACRO-ALIAS.html
--- acl2-6.2/doc/HTML/REMOVE-MACRO-ALIAS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-MACRO-ALIAS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-MACRO-ALIAS.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-MACRO-ALIAS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-MACRO-ALIAS</h2>remove the association of a function name with a macro name
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-MACRO-FN.html acl2-6.3/doc/HTML/REMOVE-MACRO-FN.html
--- acl2-6.2/doc/HTML/REMOVE-MACRO-FN.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-MACRO-FN.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-MACRO-FN.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-MACRO-FN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-MACRO-FN</h2>remove the association of a function name with a macro name
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-NTH-ALIAS.html acl2-6.3/doc/HTML/REMOVE-NTH-ALIAS.html
--- acl2-6.2/doc/HTML/REMOVE-NTH-ALIAS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-NTH-ALIAS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-NTH-ALIAS.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-NTH-ALIAS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-NTH-ALIAS</h2>remove a symbol alias for printing of <code><a href="NTH.html">nth</a></code>/<code><a href="UPDATE-NTH.html">update-nth</a></code> terms
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-OVERRIDE-HINTS.html acl2-6.3/doc/HTML/REMOVE-OVERRIDE-HINTS.html
--- acl2-6.2/doc/HTML/REMOVE-OVERRIDE-HINTS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-OVERRIDE-HINTS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-OVERRIDE-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-OVERRIDE-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-OVERRIDE-HINTS</h2>delete from the list of <a href="OVERRIDE-HINTS.html">override-hints</a>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-OVERRIDE-HINTS_bang_.html acl2-6.3/doc/HTML/REMOVE-OVERRIDE-HINTS_bang_.html
--- acl2-6.2/doc/HTML/REMOVE-OVERRIDE-HINTS_bang_.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-OVERRIDE-HINTS_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-OVERRIDE-HINTS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-OVERRIDE-HINTS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-OVERRIDE-HINTS!</h2>delete non-<a href="LOCAL.html">local</a>ly from the list of <a href="OVERRIDE-HINTS.html">override-hints</a>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-RAW-ARITY.html acl2-6.3/doc/HTML/REMOVE-RAW-ARITY.html
--- acl2-6.2/doc/HTML/REMOVE-RAW-ARITY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-RAW-ARITY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-RAW-ARITY.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-RAW-ARITY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE-RAW-ARITY</h3>remove arity information for raw mode
 <pre>Major Section:  <a href="SET-RAW-MODE.html">SET-RAW-MODE</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE-UNTOUCHABLE.html acl2-6.3/doc/HTML/REMOVE-UNTOUCHABLE.html
--- acl2-6.2/doc/HTML/REMOVE-UNTOUCHABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE-UNTOUCHABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE-UNTOUCHABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE-UNTOUCHABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REMOVE-UNTOUCHABLE</h2>remove names from lists of untouchable symbols
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE.html acl2-6.3/doc/HTML/REMOVE.html
--- acl2-6.2/doc/HTML/REMOVE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE</h3>remove all occurrences
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE1-EQ.html acl2-6.3/doc/HTML/REMOVE1-EQ.html
--- acl2-6.2/doc/HTML/REMOVE1-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE1-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE1-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE1-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE1-EQ</h3>See <a href="REMOVE1.html">remove1</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE1-EQUAL.html acl2-6.3/doc/HTML/REMOVE1-EQUAL.html
--- acl2-6.2/doc/HTML/REMOVE1-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE1-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE1-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE1-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE1-EQUAL</h3>See <a href="REMOVE1.html">remove1</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REMOVE1.html acl2-6.3/doc/HTML/REMOVE1.html
--- acl2-6.2/doc/HTML/REMOVE1.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REMOVE1.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REMOVE1.html  --  ACL2 Version 6.2</title></head>
+<head><title>REMOVE1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REMOVE1</h3>remove first occurrences, testing using <code><a href="EQL.html">eql</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REORDER.html acl2-6.3/doc/HTML/REORDER.html
--- acl2-6.2/doc/HTML/REORDER.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REORDER.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REORDER.html  --  ACL2 Version 6.2</title></head>
+<head><title>REORDER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REORDER</h2>hints keyword <code>:REORDER</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/RESET-FC-REPORTING.html acl2-6.3/doc/HTML/RESET-FC-REPORTING.html
--- acl2-6.2/doc/HTML/RESET-FC-REPORTING.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/RESET-FC-REPORTING.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RESET-FC-REPORTING.html  --  ACL2 Version 6.2</title></head>
+<head><title>RESET-FC-REPORTING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RESET-FC-REPORTING</h2>reset the forward-chaining tracking state to its initial configuration
 <pre>Major Section:  <a href="FORWARD-CHAINING-REPORTS.html">FORWARD-CHAINING-REPORTS</a>
diff -Nru acl2-6.2/doc/HTML/RESET-KILL-RING.html acl2-6.3/doc/HTML/RESET-KILL-RING.html
--- acl2-6.2/doc/HTML/RESET-KILL-RING.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/RESET-KILL-RING.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RESET-KILL-RING.html  --  ACL2 Version 6.2</title></head>
+<head><title>RESET-KILL-RING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RESET-KILL-RING</h2>save memory by resetting and perhaps resizing the kill ring used by <code><a href="OOPS.html">oops</a></code>
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/RESET-LD-SPECIALS.html acl2-6.3/doc/HTML/RESET-LD-SPECIALS.html
--- acl2-6.2/doc/HTML/RESET-LD-SPECIALS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/RESET-LD-SPECIALS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RESET-LD-SPECIALS.html  --  ACL2 Version 6.2</title></head>
+<head><title>RESET-LD-SPECIALS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RESET-LD-SPECIALS</h2>restores initial settings of the <code><a href="LD.html">ld</a></code> specials
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/RESET-PREHISTORY.html acl2-6.3/doc/HTML/RESET-PREHISTORY.html
--- acl2-6.2/doc/HTML/RESET-PREHISTORY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/RESET-PREHISTORY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RESET-PREHISTORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>RESET-PREHISTORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RESET-PREHISTORY</h2>reset the prehistory
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/RESET-PRINT-CONTROL.html acl2-6.3/doc/HTML/RESET-PRINT-CONTROL.html
--- acl2-6.2/doc/HTML/RESET-PRINT-CONTROL.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/RESET-PRINT-CONTROL.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RESET-PRINT-CONTROL.html  --  ACL2 Version 6.2</title></head>
+<head><title>RESET-PRINT-CONTROL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RESET-PRINT-CONTROL</h2>See <a href="PRINT-CONTROL.html">print-control</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/RESIZE-LIST.html acl2-6.3/doc/HTML/RESIZE-LIST.html
--- acl2-6.2/doc/HTML/RESIZE-LIST.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/RESIZE-LIST.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RESIZE-LIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>RESIZE-LIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RESIZE-LIST</h2>list resizer in support of stobjs
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/REST.html acl2-6.3/doc/HTML/REST.html
--- acl2-6.2/doc/HTML/REST.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REST.html  --  ACL2 Version 6.2</title></head>
+<head><title>REST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REST</h3>rest (<code><a href="CDR.html">cdr</a></code>) of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/RESTORE-MEMOIZATION-SETTINGS.html acl2-6.3/doc/HTML/RESTORE-MEMOIZATION-SETTINGS.html
--- acl2-6.2/doc/HTML/RESTORE-MEMOIZATION-SETTINGS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/RESTORE-MEMOIZATION-SETTINGS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RESTORE-MEMOIZATION-SETTINGS.html  --  ACL2 Version 6.2</title></head>
+<head><title>RESTORE-MEMOIZATION-SETTINGS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RESTORE-MEMOIZATION-SETTINGS</h2>restore the saved memoization settings
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/RESTRICT.html acl2-6.3/doc/HTML/RESTRICT.html
--- acl2-6.2/doc/HTML/RESTRICT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/RESTRICT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RESTRICT.html  --  ACL2 Version 6.2</title></head>
+<head><title>RESTRICT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RESTRICT</h2>hints keyword <code>:RESTRICT</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/RETRIEVE.html acl2-6.3/doc/HTML/RETRIEVE.html
--- acl2-6.2/doc/HTML/RETRIEVE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/RETRIEVE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RETRIEVE.html  --  ACL2 Version 6.2</title></head>
+<head><title>RETRIEVE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RETRIEVE</h2>re-enter a (specified) <a href="PROOF-CHECKER.html">proof-checker</a> state
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/RETURN-LAST-TABLE.html acl2-6.3/doc/HTML/RETURN-LAST-TABLE.html
--- acl2-6.2/doc/HTML/RETURN-LAST-TABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/RETURN-LAST-TABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RETURN-LAST-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>RETURN-LAST-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RETURN-LAST-TABLE</h2>install special raw Lisp behavior
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/RETURN-LAST.html acl2-6.3/doc/HTML/RETURN-LAST.html
--- acl2-6.2/doc/HTML/RETURN-LAST.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/RETURN-LAST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RETURN-LAST.html  --  ACL2 Version 6.2</title></head>
+<head><title>RETURN-LAST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>RETURN-LAST</h3>return the last argument, perhaps with side effects
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REVAPPEND.html acl2-6.3/doc/HTML/REVAPPEND.html
--- acl2-6.2/doc/HTML/REVAPPEND.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REVAPPEND.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REVAPPEND.html  --  ACL2 Version 6.2</title></head>
+<head><title>REVAPPEND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REVAPPEND</h3>concatentate the <a href="REVERSE.html">reverse</a> of one list to another
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REVERSE.html acl2-6.3/doc/HTML/REVERSE.html
--- acl2-6.2/doc/HTML/REVERSE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/REVERSE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REVERSE.html  --  ACL2 Version 6.2</title></head>
+<head><title>REVERSE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>REVERSE</h3>reverse a list or string
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/REWRITE-STACK-LIMIT.html acl2-6.3/doc/HTML/REWRITE-STACK-LIMIT.html
--- acl2-6.2/doc/HTML/REWRITE-STACK-LIMIT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/REWRITE-STACK-LIMIT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>REWRITE-STACK-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>REWRITE-STACK-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REWRITE-STACK-LIMIT</h2>limiting the stack depth of the ACL2 rewriter
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/REWRITE.html acl2-6.3/doc/HTML/REWRITE.html
--- acl2-6.2/doc/HTML/REWRITE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/REWRITE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,38 +1,53 @@
 <html>
-<head><title>REWRITE.html  --  ACL2 Version 6.2</title></head>
+<head><title>REWRITE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>REWRITE</h2>make some <code>:rewrite</code> rules (possibly conditional ones)
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-This doc topic discusses the rule-class <code>:rewrite</code>.  If you want a general
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>This doc topic discusses the rule-class <code>:rewrite</code>.  If you want a general
 discussion of how rewriting works in ACL2 and some guidance on how to
 construct effective rewrite rules, see <a href="INTRODUCTION-TO-REWRITE-RULES-PART-1.html">introduction-to-rewrite-rules-part-1</a>
-and then see <a href="INTRODUCTION-TO-REWRITE-RULES-PART-2.html">introduction-to-rewrite-rules-part-2</a>.</p><p>See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
-how they are used to build rules from formulas.  Example <code>:</code><code><a href="COROLLARY.html">corollary</a></code>
-formulas from which <code>:rewrite</code> rules might be built are:
-
+and then see <a href="INTRODUCTION-TO-REWRITE-RULES-PART-2.html">introduction-to-rewrite-rules-part-2</a>.</p><p>
 <pre>
-Example:
-(equal (+ x y) (+ y x))            replace (+ a b) by (+ b a) provided
-                                   certain heuristics approve the
-                                   permutation.
-
-(implies (true-listp x)            replace (append a nil) by a, if
-         (equal (append x nil) x)) (true-listp a) rewrites to t
-
-(implies                           replace (member a (append b c)) by
-    (and (eqlablep e)              (member a (append c b)) in contexts
-         (true-listp x)            in which propositional equivalence
-         (true-listp y))           is sufficient, provided (eqlablep a)
-    (iff (member e (append x y))   (true-listp b) and (true-listp c)
-         (member e (append y x)))) rewrite to t and the permutative
-                                   heuristics approve
+Examples:
+
+(defthm plus-commutes                 ; Replace (+ a b) by (+ b a) provided
+  (equal (+ x y) (+ y x)))            ; certain heuristics approve the
+                                      ; permutation.
+
+(defthm plus-commutes                 ; equivalent to the above
+  (equal (+ x y) (+ y x))
+  :rule-classes ((:rewrite :corollary (equal (+ x y) (+ y x))
+                           :loop-stopper ((x y binary-+))
+                           :match-free :all)))
+
+(defthm append-nil                    ; Replace (append a nil) by a, if
+  (implies (true-listp x)             ; (true-listp a) rewrites to t.
+           (equal (append x nil) x)))
+
+(defthm append-nil                    ; as above, but with defaults and
+  (implies (true-listp x)             ; a backchain limit
+           (equal (append x nil) x))
+  :rule-classes ((:rewrite :corollary (implies (true-listp x)
+                                               (equal (append x nil) x))
+                           :backchain-limit-lst (3) ; or equivalently, 3
+                           :match-free :all)))
+
+(defthm member-append                 ; Replace (member e (append b c)) by
+  (implies                            ; (or (member e b) (member e c) in
+   (and                               ; contexts in which propositional
+    (true-listp x)                    ; equivalence is sufficient, provided
+    (true-listp y))                   ; b and c are true-lists.
+   (iff (member e (append x y))
+        (or (member e x) (member e y)))))
 
 
 <H2>Some Related Topics</H2>
 <ul>
-<li><h3><a href="BIND-FREE.html">BIND-FREE</a> -- to bind free variables of a rewrite or linear rule
+<li><h3><a href="BIND-FREE.html">BIND-FREE</a> -- to bind free variables of a rewrite, definition, or linear rule
 </h3>
 </li>
 
@@ -52,7 +67,7 @@
 </h3>
 </li>
 
-<li><h3><a href="SYNTAXP.html">SYNTAXP</a> -- attach a heuristic filter on a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>, <code>:</code><code><a href="META.html">meta</a></code>, or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule
+<li><h3><a href="SYNTAXP.html">SYNTAXP</a> -- attach a heuristic filter on a rule
 </h3>
 </li>
 
diff -Nru acl2-6.2/doc/HTML/RFIX.html acl2-6.3/doc/HTML/RFIX.html
--- acl2-6.2/doc/HTML/RFIX.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/RFIX.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RFIX.html  --  ACL2 Version 6.2</title></head>
+<head><title>RFIX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>RFIX</h3>coerce to a rational number
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ROUND.html acl2-6.3/doc/HTML/ROUND.html
--- acl2-6.2/doc/HTML/ROUND.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ROUND.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ROUND.html  --  ACL2 Version 6.2</title></head>
+<head><title>ROUND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ROUND</h3>division returning an integer by rounding off
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/RULE-CLASSES.html acl2-6.3/doc/HTML/RULE-CLASSES.html
--- acl2-6.2/doc/HTML/RULE-CLASSES.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/RULE-CLASSES.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RULE-CLASSES.html  --  ACL2 Version 6.2</title></head>
+<head><title>RULE-CLASSES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>RULE-CLASSES</h1>adding rules to the database
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -166,9 +166,9 @@
 
 </ul>
 
-<p>See also <code><a href="FORCE.html">force</a></code>, <a href="CASE-SPLIT.html">case-split</a>, <code><a href="SYNTAXP.html">syntaxp</a></code>, and <code><a href="BIND-FREE.html">bind-free</a></code>
-for ``pragmas'' one can wrap around individual hypotheses of <code>linear</code> and
-<code>rewrite</code> rules to affect how the hypothesis is relieved.</p><p>Before we get into the discussion of rule classes, let us return to an
+<p>See also <code><a href="FORCE.html">force</a></code>, <a href="CASE-SPLIT.html">case-split</a>, <code><a href="SYNTAXP.html">syntaxp</a></code>, and <code><a href="BIND-FREE.html">bind-free</a></code> for
+``pragmas'' one can wrap around individual hypotheses of certain classes of
+rules to affect how the hypothesis is relieved.</p><p>Before we get into the discussion of rule classes, let us return to an
 important point.  In spite of the large variety of rule classes available, at
 present we recommend that new ACL2 users rely almost exclusively on
 (conditional) rewrite rules.  A reasonable but slightly bolder approach is to
diff -Nru acl2-6.2/doc/HTML/RULE-NAMES.html acl2-6.3/doc/HTML/RULE-NAMES.html
--- acl2-6.2/doc/HTML/RULE-NAMES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/RULE-NAMES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RULE-NAMES.html  --  ACL2 Version 6.2</title></head>
+<head><title>RULE-NAMES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RULE-NAMES</h2>How rules are named.
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/RULER-EXTENDERS.html acl2-6.3/doc/HTML/RULER-EXTENDERS.html
--- acl2-6.2/doc/HTML/RULER-EXTENDERS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/RULER-EXTENDERS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RULER-EXTENDERS.html  --  ACL2 Version 6.2</title></head>
+<head><title>RULER-EXTENDERS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RULER-EXTENDERS</h2>control for ACL2's termination and induction analyses
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/RUNE.html acl2-6.3/doc/HTML/RUNE.html
--- acl2-6.2/doc/HTML/RUNE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/RUNE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>RUNE.html  --  ACL2 Version 6.2</title></head>
+<head><title>RUNE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>RUNE</h2>a rule name
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/Revisiting_the_Admission_of_App.html acl2-6.3/doc/HTML/Revisiting_the_Admission_of_App.html
--- acl2-6.2/doc/HTML/Revisiting_the_Admission_of_App.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Revisiting_the_Admission_of_App.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Revisiting_the_Admission_of_App.html  --  ACL2 Version 6.2</title></head>
+<head><title>Revisiting_the_Admission_of_App.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Revisiting the Admission of App</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Rewrite_Rules_are_Generated_from_DEFTHM_Events.html acl2-6.3/doc/HTML/Rewrite_Rules_are_Generated_from_DEFTHM_Events.html
--- acl2-6.2/doc/HTML/Rewrite_Rules_are_Generated_from_DEFTHM_Events.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Rewrite_Rules_are_Generated_from_DEFTHM_Events.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Rewrite_Rules_are_Generated_from_DEFTHM_Events.html  --  ACL2 Version 6.2</title></head>
+<head><title>Rewrite_Rules_are_Generated_from_DEFTHM_Events.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Rewrite Rules are Generated from DEFTHM Events</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Running_Models.html acl2-6.3/doc/HTML/Running_Models.html
--- acl2-6.2/doc/HTML/Running_Models.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Running_Models.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Running_Models.html  --  ACL2 Version 6.2</title></head>
+<head><title>Running_Models.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Running Models</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/SAVE-AND-CLEAR-MEMOIZATION-SETTINGS.html acl2-6.3/doc/HTML/SAVE-AND-CLEAR-MEMOIZATION-SETTINGS.html
--- acl2-6.2/doc/HTML/SAVE-AND-CLEAR-MEMOIZATION-SETTINGS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/SAVE-AND-CLEAR-MEMOIZATION-SETTINGS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SAVE-AND-CLEAR-MEMOIZATION-SETTINGS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SAVE-AND-CLEAR-MEMOIZATION-SETTINGS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SAVE-AND-CLEAR-MEMOIZATION-SETTINGS</h2>save and remove the current memoization settings
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/SAVE-EXEC.html acl2-6.3/doc/HTML/SAVE-EXEC.html
--- acl2-6.2/doc/HTML/SAVE-EXEC.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SAVE-EXEC.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,38 +1,253 @@
 <html>
-<head><title>SAVE-EXEC.html  --  ACL2 Version 6.2</title></head>
+<head><title>SAVE-EXEC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h2>SAVE-EXEC</h2>save an executable image and (for most Common Lisps) a wrapper script
+<h2>SAVE-EXEC</h2>save an executable image and a wrapper script
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
 </pre><p/>
 <p>
-See <a href="SAVING-AND-RESTORING.html">saving-and-restoring</a> for an explanation of why one might want to use this
-function.
-
+<code>Save-exec</code> saves your ACL2 state so that you can immediately re-start
+later in that same state.  This utility can be useful for a project with
+<a href="BOOKS.html">books</a> to be included every time ACL2 is started, to avoid time taken to
+run <code><a href="INCLUDE-BOOK.html">include-book</a></code>.  Another use of <code>save-exec</code> is to save an
+executable that takes command-line arguments beyond those normally passed to
+the host Lisp executable.  All arguments of a call of <code>save-exec</code> are
+evaluated.</p><p>
 <pre>
 Examples:
-; Save an executable named my-saved_acl2:
+
+; Save an executable script named my-saved_acl2, with the indicated message
+; added to the start-up banner:
 (save-exec "my-saved_acl2"
            "This saved image includes Version 7 of Project Foo.")
 
-; Same as above, but with a generic comment instead:
+; Same as above, but instead with a generic comment in the start-up banner:
 (save-exec "my-saved_acl2" nil)
 
+; Arrange that the generated script passes the indicated arguments to be
+; processed by the Lisp (ACL2) executable (where this example is specific to
+; the case that CCL is the host Lisp):
+(save-exec "my-saved_acl2" nil
+           :host-lisp-args "--no-init -Z 256M")
+
+; Arrange that the generated script passes along the indicated arguments
+; to Lisp (ACL2), but that they are not processed by Lisp other than to
+; record the additional arguments (see (6) below).
+(save-exec "my-saved_acl2" nil
+           :inert-args "abc xyz -i foo")
+
+; Combining the preceding two examples:
+(save-exec "my-saved_acl2" nil
+           :host-lisp-args "--no-init -Z 256M"
+           :inert-args "abc xyz -i foo")
+
+; Immediately exit the ACL2 read-eval-print loop after starting up.
+(save-exec "my-acl2" nil
+           :return-from-lp t)
+
+; Immediately exit the ACL2 read-eval-print loop after starting up and
+; defining function FOO in the logic.
+(save-exec "my-acl2" "Start with foo defined."
+           :return-from-lp '(with-output
+                             :off :all
+                             (defun foo (x) x)))
+
+; Immediately exit the ACL2 read-eval-print loop after starting up and
+; defining variable xxx in raw Lisp.
+(save-exec "my-acl2" "Start with xxx defined."
+           :return-from-lp '(with-output
+                             :off :all
+                             (ld '((set-raw-mode-on!)
+                                   (defvar xxx (make-list 10))
+                                   (set-raw-mode nil)
+                                   (u)))))
+</pre>
+</p><p>Each example above generates a file named "my-saved_acl2".  That file is
+quite similar in form to the script generated when building ACL2 directly
+from source code; details are below.  For example, here are the contents of
+that generated file if the host Lisp is CCL (but where dates and pathnames
+are specific to one's environment).  Here, we break lines using `\', but the
+<code>exec</code> command is actually on a single line.</p><p>
+<pre>
+#!/bin/sh
+
+# Saved August 16, 2013  23:06:49
+#  then August 17, 2013  11:01:56
+
+export CCL_DEFAULT_DIRECTORY="/projects/acl2/lisps/ccl/15542/ccl"
+exec "/projects/ccl/lx86cl64" -I "/u/smith/my-saved_acl2.lx86cl64" \
+     -Z 64M -K ISO-8859-1 -e "(acl2::acl2-default-restart)" \
+     --no-init -Z 256M \
+     -- \
+     abc xyz -i foo \
+     "$@"
+</pre>
+
+</p>
+<p>
+<pre>
 General Form:
-(save-exec exec-filename extra-startup-string)
+(save-exec exec-filename extra-startup-string
+           :host-lisp-args host-lisp-args
+           :inert-args inert-args
+           :return-from-lp return-from-lp)
 </pre>
 
-where <code>exec-filename</code> is the filename of the proposed executable and
-<code>extra-startup-string</code> is a non-empty string to be printed after the normal
+where the keyword arguments are optional, and arguments are as follows.
+</p>
+<blockquote><p>
+<code>Exec-filename</code> is the filename of the proposed executable.</p><p><code>Extra-startup-string</code> is a non-empty string to be printed after the normal
 ACL2 startup message when you start up the saved image.  However,
 <code>extra-startup-string</code> is allowed to be <code>nil</code>, in which case a generic
-string will be printed instead.</p><p><strong>Notes</strong>:</p><p>1. For technical reasons, you must first exit the ACL2 read-eval-print loop,
-for example by executing <code>:q</code>, before evaluating a <code>save-exec</code> call.</p><p>2. The image will be saved so that in the new image, the raw Lisp package and
-the package in the ACL2 read-eval-print loop (see <a href="LP.html">lp</a>) will be the same as
-their respective values at the time <code>save-exec</code> is called.</p><p>3. For most Common Lisps, the specified file (e.g., <code>"my-saved_acl2"</code> in
-the examples above) will be written as a small script, which in turn invokes
-a saved image to which an extension has been appended (e.g.,
-<code>my-saved_acl2.gcl</code> for the examples above, when the underlying Common Lisp
-is GCL on a non-Windows system).
+string will be printed instead.</p><p><code>Host-lisp-args</code> can be <code>nil</code> (the default), but if it is a non-<code>nil</code>
+value, then it is a string to be inserted into the command line in the saved
+script, specifying additional arguments that are to be processed by the host
+Lisp executable.  (Note for SBCL only: these are runtime options; for
+toplevel options, see (8) below.)</p><p><code>Inert-args</code> can be <code>nil</code> (the default), but if it is a non-<code>nil</code>
+value, then it is a string to be inserted into the command line in the saved
+script, specifying additional arguments that are not to be processed by the
+host Lisp executable.</p></blockquote>
+<p></p><p><code>Return-from-lp</code> is <code>nil</code> by default.  Regardless of the value of
+<code>return-from-lp</code>, ACL2 starts up and enters its read-eval-print loop as
+usual; see <a href="LP.html">lp</a>.  Normally you'll stay inside that loop, but if
+<code>return-from-lp</code> is not <code>nil</code>, then it is evaluated in the loop, which is
+then exited, leaving you in raw Lisp.  Evaluation of <code>return-from-lp</code> is
+done with <code><a href="LD.html">ld</a></code> options that minimize output; also see <a href="WITH-OUTPUT.html">with-output</a> to
+minimize output.  Suggestion: let <code>return-from-lp</code> be <code>t</code> if you simply
+want to exit the read-eval-print loop at startup, without evaluating any
+(nontrivial) form.</p><p>The remainder of this documentation focuses on the options other than
+<code>return-from-lp</code>.</p><p><strong>Details</strong>:</p><p>(1) You must first exit the ACL2 read-eval-print loop, typically by executing
+<code>:q</code>, before evaluating a <code>save-exec</code> call; otherwise an error occurs.</p><p>(2) The image will be saved so that in the new image, the raw Lisp package
+and the package in the ACL2 read-eval-print loop (see <a href="LP.html">lp</a>) will be the same
+as their respective values at the time <code>save-exec</code> is called.</p><p>(3) <code>Save-exec</code> generates a small script file (e.g., <code>"my-saved_acl2"</code>
+in the examples above), similar in form (see (4) below) to the script
+generated when building ACL2 directly from source code, but with a comment
+line indicating the time at which the new script is written.  <code>Save-exec</code>
+also saves an associated binary file.  The binary file's name is obtained by
+putting a suffix on the script filename; for example, if the host Lisp is GCL
+running on a Linux or Darwin (MacOS) system, then that binary file has the
+name <code>my-saved_acl2.gcl</code> in the examples above.</p><p>(4) If <code>inert-args</code> is <code>nil</code> (for example if keyword <code>:inert-args</code> is
+omitted), then when the generated ACL2 script is invoked with command line
+arguments, those arguments will be passed to the host Lisp; otherwise they
+will not.  Thus for the example above, suppose we invoke the generated script
+as follows.
+
+<pre>
+my-saved_acl2 -a bcd -e fgh
+</pre>
+
+If <code>my-saved_acl2</code> was generated using a <code>save-exec</code> command with a
+non-<code>nil</code> value specified for keyword <code>:inert-args</code>, then the arguments
+``<code>-a bcd -e fgh</code>'' will not be passed to the host Lisp; otherwise, they
+will be.  Note that for ACL2 executable scripts generated by an ordinary ACL2
+build from sources, the latter case (i.e., without <code>inert-args</code>) takes
+place.</p><p>(5) The generated script, which specifies execution with <code>/bin/sh</code>, will
+generally contain a line of one of the following forms.  (But for SBCL,
+see (8) below.)  In the examples that follow, <code>ACL2_options</code> is a suitable
+list of command-line arguments given to the ACL2 executable.  The quoted
+string <code>"$@"</code> is intended to allow the user to pass additional
+command-line arguments to that executable.
+</p>
+<blockquote><p></p><p>If <code>host-lisp-args</code> and <code>inert-args</code> are omitted (or <code>nil</code>):
+
+<pre>
+exec &lt;lisp_executable&gt; &lt;ACL2_options&gt; "$@"
+</pre>
+</p><p>More generally, <code>host-lisp-args</code> is inserted immediately after
+<code>&lt;ACL2_options&gt;</code>, but only if it is non-<code>nil</code> (hence a string).  If
+<code>inert-args</code> is <code>nil</code>, we thus get:
+
+<pre>
+exec &lt;lisp_executable&gt; &lt;ACL2_options&gt; host-lisp-args "$@"
+</pre>
+
+If <code>host-lisp-args</code> redefines a value from <code>&lt;ACL2_options&gt;</code>, then it is
+up to the host lisp which value to use.  For example, experiments show that
+in CCL, if <code>-Z</code> appears twice, each with a legal value, then the second
+value is the one that is used (i.e. it does indeed override the original
+value written out by ACL2 in <code>&lt;ACL2_options&gt;</code>.  But experiments also show
+that in LispWorks, where ``<code>-init -</code>'' is included in <code>&lt;ACL2_options&gt;</code>,
+then inclusion of ``<code>-init foo.lisp</code>'' in <code>host-lisp-args</code> is ignored.</p><p>The remaining cases below are for a non-<code>nil</code> value of <code>inert-args</code>.  In
+each case, if <code>host-lisp-args</code> is <code>nil</code> then it should be omitted from
+the displayed command.</p><p>If <code>inert-args</code> is <code>t</code> then an additional argument, `<code>--</code>', indicates
+that when ACL2 is given command line arguments, these should not be processed
+by the host Lisp (other than recording them; see (6) below):
+
+<pre>
+exec &lt;lisp_executable&gt; &lt;ACL2_options&gt; host-lisp-args -- "$@"
+</pre>
+</p><p>If <code>inert-args</code> is a string then the result is similar to the above, except
+that <code>inert-args</code> is added immediately after `<code>--</code>':
+
+<pre>
+exec &lt;lisp_executable&gt; &lt;ACL2_options&gt; host-lisp-args -- inert-args "$@"
+</pre>
+</p></blockquote>
+<p></p><p>(6) See community books <code>books/oslib/argv</code> for a utility that returns a
+list of all <code>inert-args</code> from an invocation of ACL2.</p><p>(7) Suppose that you invoke an ACL2 script, say <code>"my-saved_acl2"</code>, that
+was generated by <code>save-exec</code>, and then optionally evaluate some forms.
+Then you may save a new ACL2 script with <code>save-exec</code>.  The new script will
+contain comment lines that extend comment lines in <code>"my-saved_acl2"</code> with
+a new write date, but otherwise will be identical to the script that would
+have been generated by executing the new <code>save-exec</code> call after invoking
+the original ACL2 executable (built directly from ACL2 sources) instead of
+<code>"my-saved_acl2"</code>.  In other words, the options added by the earlier
+<code>save-exec</code> call that created <code>"my-saved_acl2"</code> are discarded by the
+new <code>save-exec</code> call.  However, the <code>.core</code> file will built on top of the
+<code>.core</code> file that was consulted when <code>"my-saved_acl2"</code> was invoked.</p><p>(8) The following note pertains only to the case that the host Lisp is SBCL.
+For SBCL, the scripts written are analogous to, but slightly different from,
+those shown above.  Please note that for SBCL, the <code>host-lisp-args</code> are
+what the SBCL manual calls ``runtime options''.  For SBCL only, an extra
+keyword argument, <code>:toplevel-args</code>, may be used for specifying what the
+SBCL manual calls ``toplevel options.  As with <code>:host-lisp-args</code>, this
+value, <code>toplevel-args</code>, should be <code>nil</code> (the default) or a string.  Here
+is an example.
+
+<pre>
+(save-exec "my-saved_acl2" nil
+           :host-lisp-args "--dynamic-space-size 12000"
+           :toplevel-args "--eval '(print \"HELLO\")'"
+           :inert-args "--my-option my-value")
+</pre>
+
+The script generated by this example call of <code>save-exec</code> contains a line
+such as the following (with the same convention for `\' as before)
+
+<pre>
+exec "/projects/sbcl-1.1.7-x86-64-linux/src/runtime/sbcl" \
+     --dynamic-space-size 2000 --control-stack-size 8 \
+     --core "/u/smith/my-saved_acl2.core" --dynamic-space-size 12000 \
+     --end-runtime-options \
+     --no-userinit --eval '(acl2::sbcl-restart)' \
+     --eval '(print "HELLO")' \
+     --end-toplevel-options \
+     --my-option my-value \
+     "$@"
+</pre>
+</p><p>In general, the generated script is of one of the following forms (with the
+same convention for `\' as before).
+</p>
+<blockquote><p></p><p>For the case that <code>inert-args</code> is <code>nil</code>:
+
+<pre>
+exec &lt;lisp_executable&gt; \
+     &lt;ACL2_runtime_options&gt; host-lisp-args --end-runtime-options \
+     &lt;ACL2_toplevel_options&gt; host-lisp-args \
+     "$@"
+</pre>
+</p><p>For the case that <code>inert-args</code> is non-<code>nil</code>:
+
+<pre>
+exec &lt;lisp_executable&gt; \
+     &lt;ACL2_runtime_options&gt; host-lisp-args --end-runtime-options \
+     &lt;ACL2_toplevel_options&gt; host-lisp-args --end-toplevel-options \
+     inert-args "$@"
+</pre>
+</p></blockquote>
+<p></p><p>Notice that as before, when the generated script is invoked (for example, at
+the shell), additional command-line arguments provided at that time are
+passed to Lisp if and only if <code>inert-args</code> is <code>nil</code>.  For SBCL, when they
+are passed to Lisp they are passed as toplevel options, not as runtime
+options.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
 </html>
diff -Nru acl2-6.2/doc/HTML/SAVING-AND-RESTORING.html acl2-6.3/doc/HTML/SAVING-AND-RESTORING.html
--- acl2-6.2/doc/HTML/SAVING-AND-RESTORING.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SAVING-AND-RESTORING.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,17 +1,10 @@
 <html>
-<head><title>SAVING-AND-RESTORING.html  --  ACL2 Version 6.2</title></head>
+<head><title>SAVING-AND-RESTORING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h2>SAVING-AND-RESTORING</h2>saving and restoring your logical state
+<h2>SAVING-AND-RESTORING</h2>See <a href="SAVE-EXEC.html">save-exec</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
 </pre><p/>
-<p>
-One normally works on an ACL2-based project by developing <a href="BOOKS.html">books</a>, which
-can then be included when continuing on that project in later ACL2 sessions;
-see <a href="INCLUDE-BOOK.html">include-book</a>.  However, this approach can be time-consuming when there
-are very large collections of <a href="BOOKS.html">books</a> to be included.  See see <a href="SAVE-EXEC.html">save-exec</a>
-for the description of a utility that saves your ACL2 state so that you can
-immediately re-start later in that same state.
-</p>
+<p></p>
 <p>
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
diff -Nru acl2-6.2/doc/HTML/SEARCH.html acl2-6.3/doc/HTML/SEARCH.html
--- acl2-6.2/doc/HTML/SEARCH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SEARCH.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SEARCH.html  --  ACL2 Version 6.2</title></head>
+<head><title>SEARCH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SEARCH</h3>search for a string or list in another string or list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SECOND.html acl2-6.3/doc/HTML/SECOND.html
--- acl2-6.2/doc/HTML/SECOND.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SECOND.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SECOND.html  --  ACL2 Version 6.2</title></head>
+<head><title>SECOND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SECOND</h3>second member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SERIALIZE-ALTERNATIVES.html acl2-6.3/doc/HTML/SERIALIZE-ALTERNATIVES.html
--- acl2-6.2/doc/HTML/SERIALIZE-ALTERNATIVES.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/SERIALIZE-ALTERNATIVES.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SERIALIZE-ALTERNATIVES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SERIALIZE-ALTERNATIVES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SERIALIZE-ALTERNATIVES</h2>alternatives to the <a href="SERIALIZE.html">serialize</a> routines
 <pre>Major Section:  <a href="SERIALIZE.html">SERIALIZE</a>
diff -Nru acl2-6.2/doc/HTML/SERIALIZE-IN-BOOKS.html acl2-6.3/doc/HTML/SERIALIZE-IN-BOOKS.html
--- acl2-6.2/doc/HTML/SERIALIZE-IN-BOOKS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/SERIALIZE-IN-BOOKS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SERIALIZE-IN-BOOKS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SERIALIZE-IN-BOOKS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SERIALIZE-IN-BOOKS</h2>using serialization efficiently in books
 <pre>Major Section:  <a href="SERIALIZE.html">SERIALIZE</a>
diff -Nru acl2-6.2/doc/HTML/SERIALIZE-READ.html acl2-6.3/doc/HTML/SERIALIZE-READ.html
--- acl2-6.2/doc/HTML/SERIALIZE-READ.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/SERIALIZE-READ.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SERIALIZE-READ.html  --  ACL2 Version 6.2</title></head>
+<head><title>SERIALIZE-READ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SERIALIZE-READ</h2>read a serialized ACL2 object from a file
 <pre>Major Section:  <a href="SERIALIZE.html">SERIALIZE</a>
@@ -14,7 +14,7 @@
   --&gt;
  (mv obj state)
 </pre>
-</p><p>In the logic this is an oracle read.</p><p>Under the hood, we try to read and return a serialized object form a file that
+</p><p>In the logic this is an oracle read.</p><p>Under the hood, we try to read and return a serialized object from a file that
 was presumably created by <code><a href="SERIALIZE-WRITE.html">serialize-write</a></code>.  On success we return the
 contents of the file.  Any failures (e.g., file not found, bad file contents,
 etc.) will result in a hard Lisp error.</p><p>The <code>filename</code> should be a string that gives the path to the file.</p><p>The <code>hons-mode</code> controls how whether to use <code><a href="HONS.html">hons</a></code> or <code><a href="CONS.html">cons</a></code> to
diff -Nru acl2-6.2/doc/HTML/SERIALIZE-WRITE.html acl2-6.3/doc/HTML/SERIALIZE-WRITE.html
--- acl2-6.2/doc/HTML/SERIALIZE-WRITE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/SERIALIZE-WRITE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SERIALIZE-WRITE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SERIALIZE-WRITE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SERIALIZE-WRITE</h2>write an ACL2 object into a file
 <pre>Major Section:  <a href="SERIALIZE.html">SERIALIZE</a>
diff -Nru acl2-6.2/doc/HTML/SERIALIZE.html acl2-6.3/doc/HTML/SERIALIZE.html
--- acl2-6.2/doc/HTML/SERIALIZE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/SERIALIZE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SERIALIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SERIALIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>SERIALIZE</h1>routines for saving ACL2 objects to files, and later restoring them
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/SET-ABSSTOBJ-DEBUG.html acl2-6.3/doc/HTML/SET-ABSSTOBJ-DEBUG.html
--- acl2-6.2/doc/HTML/SET-ABSSTOBJ-DEBUG.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-ABSSTOBJ-DEBUG.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-ABSSTOBJ-DEBUG.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-ABSSTOBJ-DEBUG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-ABSSTOBJ-DEBUG</h2>obtain debugging information upon atomicity violation for an abstract stobj
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-ACCUMULATED-PERSISTENCE.html acl2-6.3/doc/HTML/SET-ACCUMULATED-PERSISTENCE.html
--- acl2-6.2/doc/HTML/SET-ACCUMULATED-PERSISTENCE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-ACCUMULATED-PERSISTENCE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-ACCUMULATED-PERSISTENCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-ACCUMULATED-PERSISTENCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-ACCUMULATED-PERSISTENCE</h2>See <a href="ACCUMULATED-PERSISTENCE.html">accumulated-persistence</a>.
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/SET-BACKCHAIN-LIMIT.html acl2-6.3/doc/HTML/SET-BACKCHAIN-LIMIT.html
--- acl2-6.2/doc/HTML/SET-BACKCHAIN-LIMIT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-BACKCHAIN-LIMIT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-BACKCHAIN-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-BACKCHAIN-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-BACKCHAIN-LIMIT</h2>sets the backchain-limit used by the type-set and rewriting mechanisms
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-BODY.html acl2-6.3/doc/HTML/SET-BODY.html
--- acl2-6.2/doc/HTML/SET-BODY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-BODY.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-BODY.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-BODY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-BODY</h2>set the definition body
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/SET-BOGUS-DEFUN-HINTS-OK.html acl2-6.3/doc/HTML/SET-BOGUS-DEFUN-HINTS-OK.html
--- acl2-6.2/doc/HTML/SET-BOGUS-DEFUN-HINTS-OK.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-BOGUS-DEFUN-HINTS-OK.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-BOGUS-DEFUN-HINTS-OK.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-BOGUS-DEFUN-HINTS-OK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-BOGUS-DEFUN-HINTS-OK</h2>allow unnecessary ``mutual recursion'' 
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-BOGUS-MUTUAL-RECURSION-OK.html acl2-6.3/doc/HTML/SET-BOGUS-MUTUAL-RECURSION-OK.html
--- acl2-6.2/doc/HTML/SET-BOGUS-MUTUAL-RECURSION-OK.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-BOGUS-MUTUAL-RECURSION-OK.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-BOGUS-MUTUAL-RECURSION-OK.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-BOGUS-MUTUAL-RECURSION-OK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-BOGUS-MUTUAL-RECURSION-OK</h2>allow unnecessary ``mutual recursion'' 
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-CASE-SPLIT-LIMITATIONS.html acl2-6.3/doc/HTML/SET-CASE-SPLIT-LIMITATIONS.html
--- acl2-6.2/doc/HTML/SET-CASE-SPLIT-LIMITATIONS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-CASE-SPLIT-LIMITATIONS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-CASE-SPLIT-LIMITATIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-CASE-SPLIT-LIMITATIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-CASE-SPLIT-LIMITATIONS</h2>set the case-split-limitations
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-CBD.html acl2-6.3/doc/HTML/SET-CBD.html
--- acl2-6.2/doc/HTML/SET-CBD.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-CBD.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-CBD.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-CBD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-CBD</h2>to set the connected book directory
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/SET-CHECKPOINT-SUMMARY-LIMIT.html acl2-6.3/doc/HTML/SET-CHECKPOINT-SUMMARY-LIMIT.html
--- acl2-6.2/doc/HTML/SET-CHECKPOINT-SUMMARY-LIMIT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-CHECKPOINT-SUMMARY-LIMIT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-CHECKPOINT-SUMMARY-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-CHECKPOINT-SUMMARY-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-CHECKPOINT-SUMMARY-LIMIT</h2>control printing of key checkpoints upon a proof's failure
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-COMPILE-FNS.html acl2-6.3/doc/HTML/SET-COMPILE-FNS.html
--- acl2-6.2/doc/HTML/SET-COMPILE-FNS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-COMPILE-FNS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-COMPILE-FNS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-COMPILE-FNS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-COMPILE-FNS</h2>have each function compiled as you go along.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-COMPILER-ENABLED.html acl2-6.3/doc/HTML/SET-COMPILER-ENABLED.html
--- acl2-6.2/doc/HTML/SET-COMPILER-ENABLED.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-COMPILER-ENABLED.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-COMPILER-ENABLED.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-COMPILER-ENABLED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-COMPILER-ENABLED</h2>See <a href="COMPILATION.html">compilation</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-DEBUGGER-ENABLE.html acl2-6.3/doc/HTML/SET-DEBUGGER-ENABLE.html
--- acl2-6.2/doc/HTML/SET-DEBUGGER-ENABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DEBUGGER-ENABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DEBUGGER-ENABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DEBUGGER-ENABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-DEBUGGER-ENABLE</h2>control whether Lisp errors and breaks invoke the Lisp debugger
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-DEFAULT-BACKCHAIN-LIMIT.html acl2-6.3/doc/HTML/SET-DEFAULT-BACKCHAIN-LIMIT.html
--- acl2-6.2/doc/HTML/SET-DEFAULT-BACKCHAIN-LIMIT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DEFAULT-BACKCHAIN-LIMIT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DEFAULT-BACKCHAIN-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DEFAULT-BACKCHAIN-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-DEFAULT-BACKCHAIN-LIMIT</h2>sets the default backchain-limit used when admitting a rule
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-DEFAULT-HINTS.html acl2-6.3/doc/HTML/SET-DEFAULT-HINTS.html
--- acl2-6.2/doc/HTML/SET-DEFAULT-HINTS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DEFAULT-HINTS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DEFAULT-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DEFAULT-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-DEFAULT-HINTS</h2>set the default hints
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
@@ -17,7 +17,7 @@
 </p><p>Note: This is an event!  It does not print the usual event summary
 but nevertheless changes the ACL2 logical <a href="WORLD.html">world</a> and is so
 recorded.  It is <code><a href="LOCAL.html">local</a></code> to the book or <code><a href="ENCAPSULATE.html">encapsulate</a></code> form in which it
-occurs (see <a href="SET-DEFAULT-HINTS_bang_.html">set-default-hints!</a> for a corresponding non-<code><a href="LOCAL.html">local</a></code> event).
+occurs; see <a href="SET-DEFAULT-HINTS_bang_.html">set-default-hints!</a> for a corresponding non-<code><a href="LOCAL.html">local</a></code> event.
 </p>
 <p>
 <pre>
diff -Nru acl2-6.2/doc/HTML/SET-DEFAULT-HINTS_bang_.html acl2-6.3/doc/HTML/SET-DEFAULT-HINTS_bang_.html
--- acl2-6.2/doc/HTML/SET-DEFAULT-HINTS_bang_.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DEFAULT-HINTS_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DEFAULT-HINTS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DEFAULT-HINTS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-DEFAULT-HINTS!</h2>set the default hints non-<code><a href="LOCAL.html">local</a></code>ly
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-DEFERRED-TTAG-NOTES.html acl2-6.3/doc/HTML/SET-DEFERRED-TTAG-NOTES.html
--- acl2-6.2/doc/HTML/SET-DEFERRED-TTAG-NOTES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DEFERRED-TTAG-NOTES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DEFERRED-TTAG-NOTES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DEFERRED-TTAG-NOTES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-DEFERRED-TTAG-NOTES</h2>modify the verbosity of <code>TTAG NOTE</code> printing
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-DIFFERENCE$.html acl2-6.3/doc/HTML/SET-DIFFERENCE$.html
--- acl2-6.2/doc/HTML/SET-DIFFERENCE$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DIFFERENCE$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DIFFERENCE$.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DIFFERENCE$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SET-DIFFERENCE$</h3>elements of one list that are not elements of another
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SET-DIFFERENCE-EQ.html acl2-6.3/doc/HTML/SET-DIFFERENCE-EQ.html
--- acl2-6.2/doc/HTML/SET-DIFFERENCE-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DIFFERENCE-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DIFFERENCE-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DIFFERENCE-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SET-DIFFERENCE-EQ</h3>See <a href="SET-DIFFERENCE$.html">set-difference$</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SET-DIFFERENCE-EQUAL.html acl2-6.3/doc/HTML/SET-DIFFERENCE-EQUAL.html
--- acl2-6.2/doc/HTML/SET-DIFFERENCE-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DIFFERENCE-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DIFFERENCE-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DIFFERENCE-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SET-DIFFERENCE-EQUAL</h3>See <a href="SET-DIFFERENCE$.html">set-difference$</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SET-DIFFERENCE-THEORIES.html acl2-6.3/doc/HTML/SET-DIFFERENCE-THEORIES.html
--- acl2-6.2/doc/HTML/SET-DIFFERENCE-THEORIES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-DIFFERENCE-THEORIES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-DIFFERENCE-THEORIES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-DIFFERENCE-THEORIES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-DIFFERENCE-THEORIES</h2>difference of two <a href="THEORIES.html">theories</a>
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/SET-ENFORCE-REDUNDANCY.html acl2-6.3/doc/HTML/SET-ENFORCE-REDUNDANCY.html
--- acl2-6.2/doc/HTML/SET-ENFORCE-REDUNDANCY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-ENFORCE-REDUNDANCY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-ENFORCE-REDUNDANCY.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-ENFORCE-REDUNDANCY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-ENFORCE-REDUNDANCY</h2>require most events to be redundant
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-EVISC-TUPLE.html acl2-6.3/doc/HTML/SET-EVISC-TUPLE.html
--- acl2-6.2/doc/HTML/SET-EVISC-TUPLE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-EVISC-TUPLE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-EVISC-TUPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-EVISC-TUPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-EVISC-TUPLE</h2>control suppression of details when printing
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-FC-CRITERIA.html acl2-6.3/doc/HTML/SET-FC-CRITERIA.html
--- acl2-6.2/doc/HTML/SET-FC-CRITERIA.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-FC-CRITERIA.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-FC-CRITERIA.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-FC-CRITERIA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-FC-CRITERIA</h2>to set the tracking criteria for forward chaining reports
 <pre>Major Section:  <a href="FORWARD-CHAINING-REPORTS.html">FORWARD-CHAINING-REPORTS</a>
diff -Nru acl2-6.2/doc/HTML/SET-FC-REPORT-ON-THE-FLY.html acl2-6.3/doc/HTML/SET-FC-REPORT-ON-THE-FLY.html
--- acl2-6.2/doc/HTML/SET-FC-REPORT-ON-THE-FLY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-FC-REPORT-ON-THE-FLY.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-FC-REPORT-ON-THE-FLY.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-FC-REPORT-ON-THE-FLY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-FC-REPORT-ON-THE-FLY</h2>to determine when forward-chaining reports are printed
 <pre>Major Section:  <a href="FORWARD-CHAINING-REPORTS.html">FORWARD-CHAINING-REPORTS</a>
diff -Nru acl2-6.2/doc/HTML/SET-FMT-HARD-RIGHT-MARGIN.html acl2-6.3/doc/HTML/SET-FMT-HARD-RIGHT-MARGIN.html
--- acl2-6.2/doc/HTML/SET-FMT-HARD-RIGHT-MARGIN.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-FMT-HARD-RIGHT-MARGIN.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-FMT-HARD-RIGHT-MARGIN.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-FMT-HARD-RIGHT-MARGIN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-FMT-HARD-RIGHT-MARGIN</h2>set the right margin for formatted output
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-FMT-SOFT-RIGHT-MARGIN.html acl2-6.3/doc/HTML/SET-FMT-SOFT-RIGHT-MARGIN.html
--- acl2-6.2/doc/HTML/SET-FMT-SOFT-RIGHT-MARGIN.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-FMT-SOFT-RIGHT-MARGIN.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-FMT-SOFT-RIGHT-MARGIN.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-FMT-SOFT-RIGHT-MARGIN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-FMT-SOFT-RIGHT-MARGIN</h2>set the soft right margin for formatted output
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-GAG-MODE.html acl2-6.3/doc/HTML/SET-GAG-MODE.html
--- acl2-6.2/doc/HTML/SET-GAG-MODE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-GAG-MODE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-GAG-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-GAG-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-GAG-MODE</h2>modify the nature of proof output
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-GUARD-CHECKING.html acl2-6.3/doc/HTML/SET-GUARD-CHECKING.html
--- acl2-6.2/doc/HTML/SET-GUARD-CHECKING.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-GUARD-CHECKING.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-GUARD-CHECKING.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-GUARD-CHECKING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-GUARD-CHECKING</h2>control checking <a href="GUARD.html">guard</a>s during execution of top-level forms
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-IGNORE-DOC-STRING-ERROR.html acl2-6.3/doc/HTML/SET-IGNORE-DOC-STRING-ERROR.html
--- acl2-6.2/doc/HTML/SET-IGNORE-DOC-STRING-ERROR.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-IGNORE-DOC-STRING-ERROR.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-IGNORE-DOC-STRING-ERROR.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-IGNORE-DOC-STRING-ERROR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-IGNORE-DOC-STRING-ERROR</h2>allow ill-formed <a href="DOCUMENTATION.html">documentation</a> strings
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-IGNORE-OK.html acl2-6.3/doc/HTML/SET-IGNORE-OK.html
--- acl2-6.2/doc/HTML/SET-IGNORE-OK.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-IGNORE-OK.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-IGNORE-OK.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-IGNORE-OK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-IGNORE-OK</h2>allow unused formals and locals without an <code>ignore</code> or <code>ignorable</code> declaration
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-INHIBIT-OUTPUT-LST.html acl2-6.3/doc/HTML/SET-INHIBIT-OUTPUT-LST.html
--- acl2-6.2/doc/HTML/SET-INHIBIT-OUTPUT-LST.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-INHIBIT-OUTPUT-LST.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-INHIBIT-OUTPUT-LST.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-INHIBIT-OUTPUT-LST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-INHIBIT-OUTPUT-LST</h2>control output
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-INHIBIT-WARNINGS.html acl2-6.3/doc/HTML/SET-INHIBIT-WARNINGS.html
--- acl2-6.2/doc/HTML/SET-INHIBIT-WARNINGS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-INHIBIT-WARNINGS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-INHIBIT-WARNINGS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-INHIBIT-WARNINGS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-INHIBIT-WARNINGS</h2>control warnings
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
@@ -13,9 +13,10 @@
 
 Note: This is an event!  It does not print the usual event summary
 but nevertheless changes the ACL2 logical <a href="WORLD.html">world</a> and is so
-recorded.  Moreover, its effect is to set the <code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code>, and
-hence its effect is <code><a href="LOCAL.html">local</a></code> to the book or <code><a href="ENCAPSULATE.html">encapsulate</a></code> form
-containing it; see <a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a>.
+recorded.  It is <code><a href="LOCAL.html">local</a></code> to the book or <code><a href="ENCAPSULATE.html">encapsulate</a></code> form in which it
+occurs; see <a href="SET-INHIBIT-WARNINGS_bang_.html">set-inhibit-warnings!</a> for a corresponding non-<code><a href="LOCAL.html">local</a></code>
+event.  Indeed, <code>(set-inhibit-warnings ...)</code> is equivalent to
+<code>(local (set-inhibit-warnings! ...))</code>.
 </p>
 <p>
 <pre>
@@ -23,22 +24,32 @@
 (set-inhibit-warnings string1 string2 ...)
 </pre>
 
-where each string is considered without regard to case.  This macro
-is equivalent to <code>(table acl2-defaults-table :inhibit-warnings lst)</code>,
-where <code>lst</code> is the list of strings supplied.  This macro is an event
-(see <a href="TABLE.html">table</a>), but no output results from a
-<code>set-inhibit-warnings</code> event.</p><p>The effect of this event is to suppress any warning whose label is a
-member of this list (where again, case is ignored).  For example,
-the warning
+where each string is considered without regard to case.  This macro is
+equivalent to <code>(local (table inhibit-warnings-table nil 'lst :clear))</code>,
+where <code>lst</code> is the list of strings supplied.  This macro is an
+event (see <a href="TABLE.html">table</a>), but no output results from a <code>set-inhibit-warnings</code>
+event.</p><p>ACL2 prints warnings that may, from time to time, seem excessive to
+experienced users.  Each warning is ``labeled'' with a string identifying the
+type of warning.  Consider for example
 
 <pre>
-  ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
+ACL2 Warning [Use] in ( THM ...):  It is unusual to :USE ....
 </pre>
 
-will not be printed if <code>"use"</code> (or <code>"USE"</code>, etc.) is a member
-of the given list of strings.</p><p>Of course, if warnings are inhibited overall --
-see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a> -- then the value of
-<code>:inhibit-warnings</code> is entirely irrelevant.
+Here, the label is "Use".  The argument list for <code>set-inhibit-warnings</code>
+is a list of such labels, each of which is a string.  Any warning is
+suppressed if its label is a member of this list, where case is ignored, .
+Thus, for example, the warning above will not be printed after a call of
+<code>set-inhibit-warnings</code> that contains the string, <code>"Use"</code> (or any string
+that is <code><a href="STRING-EQUAL.html">string-equal</a></code> to <code>"Use"</code>, such as <code>"use"</code> or
+<code>"USE"</code>).  In summary: the effect of this event is to suppress any
+warning whose label is a member of the given argument list, where case is
+ignored.</p><p>The list of currently inhibited warnings is the list of keys in the
+<a href="TABLE.html">table</a> named <code>inhibit-warnings-table</code>.  (The values in the table are
+irrelevant.)  One way to get that value is to get the result from evaluating
+the following form: <code>(table-alist 'inhibit-warnings-table (w state))</code>.  Of
+course, if warnings are inhibited overall -- see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a>
+-- then this value is entirely irrelevant.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
 </html>
diff -Nru acl2-6.2/doc/HTML/SET-INHIBIT-WARNINGS_bang_.html acl2-6.3/doc/HTML/SET-INHIBIT-WARNINGS_bang_.html
--- acl2-6.2/doc/HTML/SET-INHIBIT-WARNINGS_bang_.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-INHIBIT-WARNINGS_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -0,0 +1,18 @@
+<html>
+<head><title>SET-INHIBIT-WARNINGS_bang_.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>SET-INHIBIT-WARNINGS!</h2>control warnings non-<code><a href="LOCAL.html">local</a></code>ly
+<pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
+</pre><p/>
+<p>
+Please see <a href="SET-INHIBIT-WARNINGS.html">set-inhibit-warnings</a>, which is the same as
+<code>set-inhibit-warnings!</code>  except that the latter is not <code><a href="LOCAL.html">local</a></code> to the
+<code><a href="ENCAPSULATE.html">encapsulate</a></code> or the book in which it occurs.  Probably
+<a href="SET-INHIBIT-WARNINGS.html">set-inhibit-warnings</a> is to be preferred unless you have a good reason
+for wanting to export the effect of this event outside the enclosing
+<code><a href="ENCAPSULATE.html">encapsulate</a></code> or book.
+</p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/SET-INHIBITED-SUMMARY-TYPES.html acl2-6.3/doc/HTML/SET-INHIBITED-SUMMARY-TYPES.html
--- acl2-6.2/doc/HTML/SET-INHIBITED-SUMMARY-TYPES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-INHIBITED-SUMMARY-TYPES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-INHIBITED-SUMMARY-TYPES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-INHIBITED-SUMMARY-TYPES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-INHIBITED-SUMMARY-TYPES</h2>control which parts of the summary are printed
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-INVISIBLE-FNS-TABLE.html acl2-6.3/doc/HTML/SET-INVISIBLE-FNS-TABLE.html
--- acl2-6.2/doc/HTML/SET-INVISIBLE-FNS-TABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-INVISIBLE-FNS-TABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-INVISIBLE-FNS-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-INVISIBLE-FNS-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-INVISIBLE-FNS-TABLE</h2>set the invisible functions table
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-IPRINT.html acl2-6.3/doc/HTML/SET-IPRINT.html
--- acl2-6.2/doc/HTML/SET-IPRINT.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-IPRINT.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-IPRINT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-IPRINT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-IPRINT</h2>control whether abbreviated output can be read back in
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-IRRELEVANT-FORMALS-OK.html acl2-6.3/doc/HTML/SET-IRRELEVANT-FORMALS-OK.html
--- acl2-6.2/doc/HTML/SET-IRRELEVANT-FORMALS-OK.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-IRRELEVANT-FORMALS-OK.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-IRRELEVANT-FORMALS-OK.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-IRRELEVANT-FORMALS-OK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-IRRELEVANT-FORMALS-OK</h2>allow irrelevant formals in definitions
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-LD-KEYWORD-ALIASES.html acl2-6.3/doc/HTML/SET-LD-KEYWORD-ALIASES.html
--- acl2-6.2/doc/HTML/SET-LD-KEYWORD-ALIASES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-LD-KEYWORD-ALIASES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-LD-KEYWORD-ALIASES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-LD-KEYWORD-ALIASES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-LD-KEYWORD-ALIASES</h2>See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-LD-KEYWORD-ALIASES_bang_.html acl2-6.3/doc/HTML/SET-LD-KEYWORD-ALIASES_bang_.html
--- acl2-6.2/doc/HTML/SET-LD-KEYWORD-ALIASES_bang_.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-LD-KEYWORD-ALIASES_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -0,0 +1,11 @@
+<html>
+<head><title>SET-LD-KEYWORD-ALIASES_bang_.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>SET-LD-KEYWORD-ALIASES!</h2>See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+<pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
+</pre><p/>
+<p></p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/SET-LD-REDEFINITION-ACTION.html acl2-6.3/doc/HTML/SET-LD-REDEFINITION-ACTION.html
--- acl2-6.2/doc/HTML/SET-LD-REDEFINITION-ACTION.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-LD-REDEFINITION-ACTION.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-LD-REDEFINITION-ACTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-LD-REDEFINITION-ACTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-LD-REDEFINITION-ACTION</h2>See <a href="LD-REDEFINITION-ACTION.html">ld-redefinition-action</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-LD-SKIP-PROOFS.html acl2-6.3/doc/HTML/SET-LD-SKIP-PROOFS.html
--- acl2-6.2/doc/HTML/SET-LD-SKIP-PROOFS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-LD-SKIP-PROOFS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-LD-SKIP-PROOFS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-LD-SKIP-PROOFS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-LD-SKIP-PROOFS</h2>See <a href="SET-LD-SKIP-PROOFSP.html">set-ld-skip-proofsp</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-LD-SKIP-PROOFSP.html acl2-6.3/doc/HTML/SET-LD-SKIP-PROOFSP.html
--- acl2-6.2/doc/HTML/SET-LD-SKIP-PROOFSP.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-LD-SKIP-PROOFSP.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-LD-SKIP-PROOFSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-LD-SKIP-PROOFSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-LD-SKIP-PROOFSP</h2>See <a href="LD-SKIP-PROOFSP.html">ld-skip-proofsp</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-LET_star_-ABSTRACTION.html acl2-6.3/doc/HTML/SET-LET_star_-ABSTRACTION.html
--- acl2-6.2/doc/HTML/SET-LET_star_-ABSTRACTION.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-LET_star_-ABSTRACTION.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-LET_star_-ABSTRACTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-LET_star_-ABSTRACTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-LET*-ABSTRACTION</h2>See <a href="SET-LET_star_-ABSTRACTIONP.html">set-let*-abstractionp</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-LET_star_-ABSTRACTIONP.html acl2-6.3/doc/HTML/SET-LET_star_-ABSTRACTIONP.html
--- acl2-6.2/doc/HTML/SET-LET_star_-ABSTRACTIONP.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-LET_star_-ABSTRACTIONP.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-LET_star_-ABSTRACTIONP.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-LET_star_-ABSTRACTIONP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-LET*-ABSTRACTIONP</h2>to shorten many prettyprinted clauses
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-MATCH-FREE-DEFAULT.html acl2-6.3/doc/HTML/SET-MATCH-FREE-DEFAULT.html
--- acl2-6.2/doc/HTML/SET-MATCH-FREE-DEFAULT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-MATCH-FREE-DEFAULT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-MATCH-FREE-DEFAULT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-MATCH-FREE-DEFAULT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-MATCH-FREE-DEFAULT</h2>provide default for <code>:match-free</code> in future rules
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-MATCH-FREE-ERROR.html acl2-6.3/doc/HTML/SET-MATCH-FREE-ERROR.html
--- acl2-6.2/doc/HTML/SET-MATCH-FREE-ERROR.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-MATCH-FREE-ERROR.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-MATCH-FREE-ERROR.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-MATCH-FREE-ERROR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-MATCH-FREE-ERROR</h2>control error vs. warning when <code>:match-free</code> is missing
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-MEASURE-FUNCTION.html acl2-6.3/doc/HTML/SET-MEASURE-FUNCTION.html
--- acl2-6.2/doc/HTML/SET-MEASURE-FUNCTION.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-MEASURE-FUNCTION.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-MEASURE-FUNCTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-MEASURE-FUNCTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-MEASURE-FUNCTION</h2>set the default measure function symbol
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-NON-LINEAR.html acl2-6.3/doc/HTML/SET-NON-LINEAR.html
--- acl2-6.2/doc/HTML/SET-NON-LINEAR.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-NON-LINEAR.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-NON-LINEAR.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-NON-LINEAR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-NON-LINEAR</h2>See <a href="SET-NON-LINEARP.html">set-non-linearp</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-NON-LINEARP.html acl2-6.3/doc/HTML/SET-NON-LINEARP.html
--- acl2-6.2/doc/HTML/SET-NON-LINEARP.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-NON-LINEARP.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-NON-LINEARP.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-NON-LINEARP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-NON-LINEARP</h2>to turn on or off non-linear arithmetic reasoning
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-NU-REWRITER-MODE.html acl2-6.3/doc/HTML/SET-NU-REWRITER-MODE.html
--- acl2-6.2/doc/HTML/SET-NU-REWRITER-MODE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-NU-REWRITER-MODE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-NU-REWRITER-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-NU-REWRITER-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-NU-REWRITER-MODE</h2>to turn on and off the nu-rewriter
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-OVERRIDE-HINTS.html acl2-6.3/doc/HTML/SET-OVERRIDE-HINTS.html
--- acl2-6.2/doc/HTML/SET-OVERRIDE-HINTS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-OVERRIDE-HINTS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-OVERRIDE-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-OVERRIDE-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-OVERRIDE-HINTS</h2>set the <a href="OVERRIDE-HINTS.html">override-hints</a>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-OVERRIDE-HINTS_bang_.html acl2-6.3/doc/HTML/SET-OVERRIDE-HINTS_bang_.html
--- acl2-6.2/doc/HTML/SET-OVERRIDE-HINTS_bang_.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-OVERRIDE-HINTS_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-OVERRIDE-HINTS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-OVERRIDE-HINTS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-OVERRIDE-HINTS!</h2>set the <a href="OVERRIDE-HINTS.html">override-hints</a> non-<a href="LOCAL.html">local</a>ly
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-PARALLEL-EXECUTION.html acl2-6.3/doc/HTML/SET-PARALLEL-EXECUTION.html
--- acl2-6.2/doc/HTML/SET-PARALLEL-EXECUTION.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PARALLEL-EXECUTION.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PARALLEL-EXECUTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PARALLEL-EXECUTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PARALLEL-EXECUTION</h2>for ACL2(p): enabling parallel execution for four parallelism primitives
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-BASE.html acl2-6.3/doc/HTML/SET-PRINT-BASE.html
--- acl2-6.2/doc/HTML/SET-PRINT-BASE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-BASE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-BASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-BASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-BASE</h2>control radix in which numbers are printed
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-CASE.html acl2-6.3/doc/HTML/SET-PRINT-CASE.html
--- acl2-6.2/doc/HTML/SET-PRINT-CASE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-CASE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-CASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-CASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-CASE</h2>control whether symbols are printed in upper case or in lower case
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-CIRCLE.html acl2-6.3/doc/HTML/SET-PRINT-CIRCLE.html
--- acl2-6.2/doc/HTML/SET-PRINT-CIRCLE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-CIRCLE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-CIRCLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-CIRCLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-CIRCLE</h2>See <a href="PRINT-CONTROL.html">print-control</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-CLAUSE-IDS.html acl2-6.3/doc/HTML/SET-PRINT-CLAUSE-IDS.html
--- acl2-6.2/doc/HTML/SET-PRINT-CLAUSE-IDS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-CLAUSE-IDS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-CLAUSE-IDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-CLAUSE-IDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-CLAUSE-IDS</h2>cause subgoal numbers to be printed when <code>'prove</code> output is inhibited
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-ESCAPE.html acl2-6.3/doc/HTML/SET-PRINT-ESCAPE.html
--- acl2-6.2/doc/HTML/SET-PRINT-ESCAPE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-ESCAPE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-ESCAPE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-ESCAPE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-ESCAPE</h2>See <a href="PRINT-CONTROL.html">print-control</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-LENGTH.html acl2-6.3/doc/HTML/SET-PRINT-LENGTH.html
--- acl2-6.2/doc/HTML/SET-PRINT-LENGTH.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-LENGTH.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-LENGTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-LENGTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-LENGTH</h2>See <a href="PRINT-CONTROL.html">print-control</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-LEVEL.html acl2-6.3/doc/HTML/SET-PRINT-LEVEL.html
--- acl2-6.2/doc/HTML/SET-PRINT-LEVEL.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-LEVEL.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-LEVEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-LEVEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-LEVEL</h2>See <a href="PRINT-CONTROL.html">print-control</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-LINES.html acl2-6.3/doc/HTML/SET-PRINT-LINES.html
--- acl2-6.2/doc/HTML/SET-PRINT-LINES.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-LINES.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-LINES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-LINES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-LINES</h2>See <a href="PRINT-CONTROL.html">print-control</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-RADIX.html acl2-6.3/doc/HTML/SET-PRINT-RADIX.html
--- acl2-6.2/doc/HTML/SET-PRINT-RADIX.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-RADIX.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-RADIX.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-RADIX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-RADIX</h2>control printing of the radix for numbers
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-READABLY.html acl2-6.3/doc/HTML/SET-PRINT-READABLY.html
--- acl2-6.2/doc/HTML/SET-PRINT-READABLY.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-READABLY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-READABLY.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-READABLY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-READABLY</h2>See <a href="PRINT-CONTROL.html">print-control</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PRINT-RIGHT-MARGIN.html acl2-6.3/doc/HTML/SET-PRINT-RIGHT-MARGIN.html
--- acl2-6.2/doc/HTML/SET-PRINT-RIGHT-MARGIN.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PRINT-RIGHT-MARGIN.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PRINT-RIGHT-MARGIN.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PRINT-RIGHT-MARGIN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PRINT-RIGHT-MARGIN</h2>See <a href="PRINT-CONTROL.html">print-control</a>.
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/SET-PROVER-STEP-LIMIT.html acl2-6.3/doc/HTML/SET-PROVER-STEP-LIMIT.html
--- acl2-6.2/doc/HTML/SET-PROVER-STEP-LIMIT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-PROVER-STEP-LIMIT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-PROVER-STEP-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-PROVER-STEP-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-PROVER-STEP-LIMIT</h2>sets the step-limit used by the ACL2 prover
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
@@ -10,7 +10,9 @@
 limit on prover steps for a single event, rather than globally.  For a
 related utility based on time instead of prover steps,
 see <a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a>.  For examples of how step limits work, see the
-community book <code>books/misc/misc2/step-limits.lisp</code>.</p><p>Note: This is an event!  It does not print the usual event summary
+community book <code>books/misc/misc2/step-limits.lisp</code>.  For a utility that
+returns an indicator of the number of prover steps most recently taken,
+see <a href="LAST-PROVER-STEPS.html">last-prover-steps</a>.</p><p>Note: This is an event!  It does not print the usual event summary
 but nevertheless changes the ACL2 logical <a href="WORLD.html">world</a> and is so
 recorded.  Moreover, its effect is to set the <code><a href="ACL2-DEFAULTS-TABLE.html">acl2-defaults-table</a></code>, and
 hence its effect is <code><a href="LOCAL.html">local</a></code> to the book or <code><a href="ENCAPSULATE.html">encapsulate</a></code> form
@@ -39,7 +41,10 @@
 of time before the number of prover steps exceeds the maximum step-limit,
 which is one less than the value of <code>*default-step-limit*</code>.  Note however
 the exception stated above: if the ``limit'' is <code>nil</code> or is the value of
-<code>*default-step-limit*</code>, then no limit is imposed.</p><p>The limit is relevant for every event, as well as for calls of <code><a href="THM.html">thm</a></code> and
+<code>*default-step-limit*</code>, then no limit is imposed.</p><p>There is at best a loose connection between the counting of steps and
+<code><a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a></code>.  In particular, for a call of <code>mfc-rw</code> or any
+<code>mfc-</code> function (see <a href="EXTENDED-METAFUNCTIONS.html">extended-metafunctions</a>), the steps taken during that
+call are forgotten when returning from that call.</p><p>The limit is relevant for every event, as well as for calls of <code><a href="THM.html">thm</a></code> and
 <code><a href="CERTIFY-BOOK.html">certify-book</a></code> -- and more generally, to any form that creates a
 ``summary context'' to print the usual event summary.  The limit is also put
 in force when entering the <a href="PROOF-CHECKER.html">proof-checker</a>.  A call of
@@ -121,9 +126,7 @@
  NIL
 ACL2 !&gt;
 </pre>
-</p><p>Technical Remark.  For a call of <code>mfc-rw</code> or any <code>mfc-</code>
-function (see <a href="EXTENDED-METAFUNCTIONS.html">extended-metafunctions</a>), the steps taken during that call are
-forgotten when returning from that call.
+
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
 </html>
diff -Nru acl2-6.2/doc/HTML/SET-RAW-MODE-ON_bang_.html acl2-6.3/doc/HTML/SET-RAW-MODE-ON_bang_.html
--- acl2-6.2/doc/HTML/SET-RAW-MODE-ON_bang_.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-RAW-MODE-ON_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-RAW-MODE-ON_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-RAW-MODE-ON_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-RAW-MODE-ON!</h2>enter ``raw mode,'' a raw Lisp environment
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-RAW-MODE.html acl2-6.3/doc/HTML/SET-RAW-MODE.html
--- acl2-6.2/doc/HTML/SET-RAW-MODE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-RAW-MODE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-RAW-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-RAW-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-RAW-MODE</h2>enter or exit ``raw mode,'' a raw Lisp environment
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-RAW-PROOF-FORMAT.html acl2-6.3/doc/HTML/SET-RAW-PROOF-FORMAT.html
--- acl2-6.2/doc/HTML/SET-RAW-PROOF-FORMAT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-RAW-PROOF-FORMAT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-RAW-PROOF-FORMAT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-RAW-PROOF-FORMAT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-RAW-PROOF-FORMAT</h2>print runes as lists in proof output from simplification
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-REWRITE-STACK-LIMIT.html acl2-6.3/doc/HTML/SET-REWRITE-STACK-LIMIT.html
--- acl2-6.2/doc/HTML/SET-REWRITE-STACK-LIMIT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-REWRITE-STACK-LIMIT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-REWRITE-STACK-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-REWRITE-STACK-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-REWRITE-STACK-LIMIT</h2>Sets the rewrite stack depth used by the rewriter
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
@@ -13,7 +13,7 @@
 (set-rewrite-stack-limit 30)                            ; set to small limit
 :set-rewrite-stack-limit 30                             ; same as above
 (set-rewrite-stack-limit *default-rewrite-stack-limit*) ; the default
-:set-rewrite-stack-limit (1- (expt 2 28))               ; maximum legal limit
+(set-rewrite-stack-limit (1- (expt 2 28)))              ; maximum legal limit
 :set-rewrite-stack-limit nil         ; same as above -- essentially, no limit
 </pre>
 
diff -Nru acl2-6.2/doc/HTML/SET-RULER-EXTENDERS.html acl2-6.3/doc/HTML/SET-RULER-EXTENDERS.html
--- acl2-6.2/doc/HTML/SET-RULER-EXTENDERS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-RULER-EXTENDERS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-RULER-EXTENDERS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-RULER-EXTENDERS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-RULER-EXTENDERS</h2>See <a href="RULER-EXTENDERS.html">ruler-extenders</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-RW-CACHE-STATE.html acl2-6.3/doc/HTML/SET-RW-CACHE-STATE.html
--- acl2-6.2/doc/HTML/SET-RW-CACHE-STATE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-RW-CACHE-STATE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-RW-CACHE-STATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-RW-CACHE-STATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-RW-CACHE-STATE</h2>set the default rw-cache-state
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-RW-CACHE-STATE_bang_.html acl2-6.3/doc/HTML/SET-RW-CACHE-STATE_bang_.html
--- acl2-6.2/doc/HTML/SET-RW-CACHE-STATE_bang_.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-RW-CACHE-STATE_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-RW-CACHE-STATE_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-RW-CACHE-STATE_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-RW-CACHE-STATE!</h2>set the default rw-cache-state non-<code><a href="LOCAL.html">local</a></code>ly
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-SAVED-OUTPUT.html acl2-6.3/doc/HTML/SET-SAVED-OUTPUT.html
--- acl2-6.2/doc/HTML/SET-SAVED-OUTPUT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-SAVED-OUTPUT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-SAVED-OUTPUT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-SAVED-OUTPUT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-SAVED-OUTPUT</h2>save proof output for later display with <code>:</code><code><a href="PSO.html">pso</a></code> or <code>:</code><code><a href="PSO_bang_.html">pso!</a></code>
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-SERIALIZE-CHARACTER.html acl2-6.3/doc/HTML/SET-SERIALIZE-CHARACTER.html
--- acl2-6.2/doc/HTML/SET-SERIALIZE-CHARACTER.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-SERIALIZE-CHARACTER.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-SERIALIZE-CHARACTER.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-SERIALIZE-CHARACTER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-SERIALIZE-CHARACTER</h2>See <a href="WITH-SERIALIZE-CHARACTER.html">with-serialize-character</a>.
 <pre>Major Section:  <a href="SERIALIZE.html">SERIALIZE</a>
diff -Nru acl2-6.2/doc/HTML/SET-SPLITTER-OUTPUT.html acl2-6.3/doc/HTML/SET-SPLITTER-OUTPUT.html
--- acl2-6.2/doc/HTML/SET-SPLITTER-OUTPUT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-SPLITTER-OUTPUT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-SPLITTER-OUTPUT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-SPLITTER-OUTPUT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-SPLITTER-OUTPUT</h2>turn on or off reporting of rules that may have caused case splits
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-STATE-OK.html acl2-6.3/doc/HTML/SET-STATE-OK.html
--- acl2-6.2/doc/HTML/SET-STATE-OK.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-STATE-OK.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-STATE-OK.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-STATE-OK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-STATE-OK</h2>allow the use of STATE as a formal parameter
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-TAU-AUTO-MODE.html acl2-6.3/doc/HTML/SET-TAU-AUTO-MODE.html
--- acl2-6.2/doc/HTML/SET-TAU-AUTO-MODE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-TAU-AUTO-MODE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-TAU-AUTO-MODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-TAU-AUTO-MODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-TAU-AUTO-MODE</h2>turn on or off automatic (``greedy'') generation of <code>:tau-system</code> rules
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR.html acl2-6.3/doc/HTML/SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR.html
--- acl2-6.2/doc/HTML/SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-TOTAL-PARALLELISM-WORK-LIMIT-ERROR</h2>for ACL2(p): control the action taken when the thread limit is exceeded
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-TOTAL-PARALLELISM-WORK-LIMIT.html acl2-6.3/doc/HTML/SET-TOTAL-PARALLELISM-WORK-LIMIT.html
--- acl2-6.2/doc/HTML/SET-TOTAL-PARALLELISM-WORK-LIMIT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-TOTAL-PARALLELISM-WORK-LIMIT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-TOTAL-PARALLELISM-WORK-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-TOTAL-PARALLELISM-WORK-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-TOTAL-PARALLELISM-WORK-LIMIT</h2>for ACL2(p): set thread limit for parallelism primitives
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-TRACE-EVISC-TUPLE.html acl2-6.3/doc/HTML/SET-TRACE-EVISC-TUPLE.html
--- acl2-6.2/doc/HTML/SET-TRACE-EVISC-TUPLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-TRACE-EVISC-TUPLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-TRACE-EVISC-TUPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-TRACE-EVISC-TUPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-TRACE-EVISC-TUPLE</h2>set the trace evisc tuple
 <pre>Major Section:  <a href="TRACE.html">TRACE</a>
diff -Nru acl2-6.2/doc/HTML/SET-VERIFY-GUARDS-EAGERNESS.html acl2-6.3/doc/HTML/SET-VERIFY-GUARDS-EAGERNESS.html
--- acl2-6.2/doc/HTML/SET-VERIFY-GUARDS-EAGERNESS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-VERIFY-GUARDS-EAGERNESS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-VERIFY-GUARDS-EAGERNESS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-VERIFY-GUARDS-EAGERNESS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-VERIFY-GUARDS-EAGERNESS</h2>the eagerness with which <a href="GUARD.html">guard</a> verification is tried.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-WATERFALL-PARALLELISM-HACKS-ENABLED.html acl2-6.3/doc/HTML/SET-WATERFALL-PARALLELISM-HACKS-ENABLED.html
--- acl2-6.2/doc/HTML/SET-WATERFALL-PARALLELISM-HACKS-ENABLED.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-WATERFALL-PARALLELISM-HACKS-ENABLED.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-WATERFALL-PARALLELISM-HACKS-ENABLED.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-WATERFALL-PARALLELISM-HACKS-ENABLED.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-WATERFALL-PARALLELISM-HACKS-ENABLED</h2>for ACL2(p): enable waterfall-parallelism hacks
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-WATERFALL-PARALLELISM-HACKS-ENABLED_bang_.html acl2-6.3/doc/HTML/SET-WATERFALL-PARALLELISM-HACKS-ENABLED_bang_.html
--- acl2-6.2/doc/HTML/SET-WATERFALL-PARALLELISM-HACKS-ENABLED_bang_.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-WATERFALL-PARALLELISM-HACKS-ENABLED_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-WATERFALL-PARALLELISM-HACKS-ENABLED_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-WATERFALL-PARALLELISM-HACKS-ENABLED_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-WATERFALL-PARALLELISM-HACKS-ENABLED!</h2>for ACL2(p): enabling waterfall parallelism hacks
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-WATERFALL-PARALLELISM.html acl2-6.3/doc/HTML/SET-WATERFALL-PARALLELISM.html
--- acl2-6.2/doc/HTML/SET-WATERFALL-PARALLELISM.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-WATERFALL-PARALLELISM.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-WATERFALL-PARALLELISM.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-WATERFALL-PARALLELISM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-WATERFALL-PARALLELISM</h2>for ACL2(p): configuring the parallel execution of the waterfall
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-WATERFALL-PRINTING.html acl2-6.3/doc/HTML/SET-WATERFALL-PRINTING.html
--- acl2-6.2/doc/HTML/SET-WATERFALL-PRINTING.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-WATERFALL-PRINTING.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-WATERFALL-PRINTING.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-WATERFALL-PRINTING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-WATERFALL-PRINTING</h2>for ACL2(p): configuring the printing that occurs within the parallelized waterfall
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-WELL-FOUNDED-RELATION.html acl2-6.3/doc/HTML/SET-WELL-FOUNDED-RELATION.html
--- acl2-6.2/doc/HTML/SET-WELL-FOUNDED-RELATION.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-WELL-FOUNDED-RELATION.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-WELL-FOUNDED-RELATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-WELL-FOUNDED-RELATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-WELL-FOUNDED-RELATION</h2>set the default well-founded relation
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SET-WORMHOLE-DATA.html acl2-6.3/doc/HTML/SET-WORMHOLE-DATA.html
--- acl2-6.2/doc/HTML/SET-WORMHOLE-DATA.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-WORMHOLE-DATA.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-WORMHOLE-DATA.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-WORMHOLE-DATA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-WORMHOLE-DATA</h2>sets the wormhole data object in a wormhole status object
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SET-WORMHOLE-ENTRY-CODE.html acl2-6.3/doc/HTML/SET-WORMHOLE-ENTRY-CODE.html
--- acl2-6.2/doc/HTML/SET-WORMHOLE-ENTRY-CODE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-WORMHOLE-ENTRY-CODE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-WORMHOLE-ENTRY-CODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-WORMHOLE-ENTRY-CODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-WORMHOLE-ENTRY-CODE</h2>sets the wormhole entry code in a wormhole status object
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SET-WRITE-ACL2X.html acl2-6.3/doc/HTML/SET-WRITE-ACL2X.html
--- acl2-6.2/doc/HTML/SET-WRITE-ACL2X.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/SET-WRITE-ACL2X.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SET-WRITE-ACL2X.html  --  ACL2 Version 6.2</title></head>
+<head><title>SET-WRITE-ACL2X.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SET-WRITE-ACL2X</h2>cause <code><a href="CERTIFY-BOOK.html">certify-book</a></code> to write out a <code>.acl2x</code> file
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/SETENV$.html acl2-6.3/doc/HTML/SETENV$.html
--- acl2-6.2/doc/HTML/SETENV$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SETENV$.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SETENV$.html  --  ACL2 Version 6.2</title></head>
+<head><title>SETENV$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SETENV$</h3>set an environment variable
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SEVENTH.html acl2-6.3/doc/HTML/SEVENTH.html
--- acl2-6.2/doc/HTML/SEVENTH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SEVENTH.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SEVENTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>SEVENTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SEVENTH</h3>seventh member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SHARP-BANG-READER.html acl2-6.3/doc/HTML/SHARP-BANG-READER.html
--- acl2-6.2/doc/HTML/SHARP-BANG-READER.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SHARP-BANG-READER.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SHARP-BANG-READER.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHARP-BANG-READER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SHARP-BANG-READER</h2>package prefix that is not restricted to symbols
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/SHARP-COMMA-READER.html acl2-6.3/doc/HTML/SHARP-COMMA-READER.html
--- acl2-6.2/doc/HTML/SHARP-COMMA-READER.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SHARP-COMMA-READER.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SHARP-COMMA-READER.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHARP-COMMA-READER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SHARP-COMMA-READER</h2>DEPRECATED read-time evaluation of constants
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/SHARP-DOT-READER.html acl2-6.3/doc/HTML/SHARP-DOT-READER.html
--- acl2-6.2/doc/HTML/SHARP-DOT-READER.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SHARP-DOT-READER.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SHARP-DOT-READER.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHARP-DOT-READER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SHARP-DOT-READER</h2>read-time evaluation of constants
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/SHARP-U-READER.html acl2-6.3/doc/HTML/SHARP-U-READER.html
--- acl2-6.2/doc/HTML/SHARP-U-READER.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SHARP-U-READER.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SHARP-U-READER.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHARP-U-READER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SHARP-U-READER</h2>allow underscore characters in numbers
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/SHOW-ACCUMULATED-PERSISTENCE.html acl2-6.3/doc/HTML/SHOW-ACCUMULATED-PERSISTENCE.html
--- acl2-6.2/doc/HTML/SHOW-ACCUMULATED-PERSISTENCE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SHOW-ACCUMULATED-PERSISTENCE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SHOW-ACCUMULATED-PERSISTENCE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHOW-ACCUMULATED-PERSISTENCE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SHOW-ACCUMULATED-PERSISTENCE</h2>See <a href="ACCUMULATED-PERSISTENCE.html">accumulated-persistence</a>.
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/SHOW-BDD.html acl2-6.3/doc/HTML/SHOW-BDD.html
--- acl2-6.2/doc/HTML/SHOW-BDD.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/SHOW-BDD.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SHOW-BDD.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHOW-BDD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SHOW-BDD</h2>inspect failed BDD proof attempts
 <pre>Major Section:  <a href="BDD.html">BDD</a>
diff -Nru acl2-6.2/doc/HTML/SHOW-BODIES.html acl2-6.3/doc/HTML/SHOW-BODIES.html
--- acl2-6.2/doc/HTML/SHOW-BODIES.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SHOW-BODIES.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SHOW-BODIES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHOW-BODIES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SHOW-BODIES</h2>show the potential definition bodies
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SHOW-CUSTOM-KEYWORD-HINT-EXPANSION.html acl2-6.3/doc/HTML/SHOW-CUSTOM-KEYWORD-HINT-EXPANSION.html
--- acl2-6.2/doc/HTML/SHOW-CUSTOM-KEYWORD-HINT-EXPANSION.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/SHOW-CUSTOM-KEYWORD-HINT-EXPANSION.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,8 +1,8 @@
 <html>
-<head><title>SHOW-CUSTOM-KEYWORD-HINT-EXPANSION.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHOW-CUSTOM-KEYWORD-HINT-EXPANSION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h2>SHOW-CUSTOM-KEYWORD-HINT-EXPANSION</h2>print out custom keyword hints when they are expanded
-<pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
+<h3>SHOW-CUSTOM-KEYWORD-HINT-EXPANSION</h3>print out custom keyword hints when they are expanded
+<pre>Major Section:  <a href="CUSTOM-KEYWORD-HINTS.html">CUSTOM-KEYWORD-HINTS</a>
 </pre><p/>
 <p>
 
diff -Nru acl2-6.2/doc/HTML/SHOW-FC-CRITERIA.html acl2-6.3/doc/HTML/SHOW-FC-CRITERIA.html
--- acl2-6.2/doc/HTML/SHOW-FC-CRITERIA.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/SHOW-FC-CRITERIA.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SHOW-FC-CRITERIA.html  --  ACL2 Version 6.2</title></head>
+<head><title>SHOW-FC-CRITERIA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SHOW-FC-CRITERIA</h2>print the forward-chaining tracking criteria
 <pre>Major Section:  <a href="FORWARD-CHAINING-REPORTS.html">FORWARD-CHAINING-REPORTS</a>
diff -Nru acl2-6.2/doc/HTML/SIGNATURE.html acl2-6.3/doc/HTML/SIGNATURE.html
--- acl2-6.2/doc/HTML/SIGNATURE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SIGNATURE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SIGNATURE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SIGNATURE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SIGNATURE</h2>how to specify the arity of a constrained function
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SIGNED-BYTE-P.html acl2-6.3/doc/HTML/SIGNED-BYTE-P.html
--- acl2-6.2/doc/HTML/SIGNED-BYTE-P.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/SIGNED-BYTE-P.html	2013-09-30 17:39:32.000000000 +0000
@@ -0,0 +1,17 @@
+<html>
+<head><title>SIGNED-BYTE-P.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h3>SIGNED-BYTE-P</h3>recognizer for signed integers that fit in a specified bit width
+<pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
+</pre><p/>
+<p>
+<code>(Signed-byte-p bits x)</code> is <code>T</code> when <code>bits</code> is a positive integer and
+<code>x</code> is a signed integer whose 2's complement representation fits in a
+bit-width of <code>bits</code>, i.e., <code>-2^(bits-1) &lt;= x &lt; 2^(bits-1)</code>.
+</p>
+<p>Note that a <a href="TYPE-SPEC.html">type-spec</a> of <code>(signed-byte i)</code> for a variable <code>x</code> in a
+function's <code><a href="DECLARE.html">declare</a></code> form translates to a <a href="GUARD.html">guard</a> condition of
+<code>(signed-byte-p i x)</code>.</p><p>The <a href="GUARD.html">guard</a> for <code>signed-byte-p</code> is <code>T</code>.</p><p>To see the ACL2 definition of this function, see <a href="PF.html">pf</a>.
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/SIGNUM.html acl2-6.3/doc/HTML/SIGNUM.html
--- acl2-6.2/doc/HTML/SIGNUM.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SIGNUM.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SIGNUM.html  --  ACL2 Version 6.2</title></head>
+<head><title>SIGNUM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SIGNUM</h3>indicator for positive, negative, or zero
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SIMPLE.html acl2-6.3/doc/HTML/SIMPLE.html
--- acl2-6.2/doc/HTML/SIMPLE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SIMPLE.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SIMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SIMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SIMPLE</h2><code>:</code><code><a href="DEFINITION.html">definition</a></code> and <code>:</code><code><a href="REWRITE.html">rewrite</a></code> rules used in preprocessing
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SINGLE-THREADED-OBJECTS.html acl2-6.3/doc/HTML/SINGLE-THREADED-OBJECTS.html
--- acl2-6.2/doc/HTML/SINGLE-THREADED-OBJECTS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/SINGLE-THREADED-OBJECTS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SINGLE-THREADED-OBJECTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SINGLE-THREADED-OBJECTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SINGLE-THREADED-OBJECTS</h2>See <a href="STOBJ.html">stobj</a>.
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/SIXTH.html acl2-6.3/doc/HTML/SIXTH.html
--- acl2-6.2/doc/HTML/SIXTH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SIXTH.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SIXTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>SIXTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SIXTH</h3>sixth member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SKIP-PROOFS.html acl2-6.3/doc/HTML/SKIP-PROOFS.html
--- acl2-6.2/doc/HTML/SKIP-PROOFS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SKIP-PROOFS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SKIP-PROOFS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SKIP-PROOFS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SKIP-PROOFS</h2>skip proofs for a given form -- a quick way to introduce unsoundness
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/SLOW-ALIST-WARNING.html acl2-6.3/doc/HTML/SLOW-ALIST-WARNING.html
--- acl2-6.2/doc/HTML/SLOW-ALIST-WARNING.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/SLOW-ALIST-WARNING.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SLOW-ALIST-WARNING.html  --  ACL2 Version 6.2</title></head>
+<head><title>SLOW-ALIST-WARNING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SLOW-ALIST-WARNING</h2>warnings issued when <code><a href="FAST-ALISTS.html">fast-alists</a></code> are used inefficiently
 <pre>Major Section:  <a href="HONS-AND-MEMOIZATION.html">HONS-AND-MEMOIZATION</a>
diff -Nru acl2-6.2/doc/HTML/SLOW-ARRAY-WARNING.html acl2-6.3/doc/HTML/SLOW-ARRAY-WARNING.html
--- acl2-6.2/doc/HTML/SLOW-ARRAY-WARNING.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SLOW-ARRAY-WARNING.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SLOW-ARRAY-WARNING.html  --  ACL2 Version 6.2</title></head>
+<head><title>SLOW-ARRAY-WARNING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SLOW-ARRAY-WARNING</h3>a warning or error issued when <a href="ARRAYS.html">arrays</a> are used inefficiently
 <pre>Major Section:  <a href="ARRAYS.html">ARRAYS</a>
diff -Nru acl2-6.2/doc/HTML/SOLUTION-TO-SIMPLE-EXAMPLE.html acl2-6.3/doc/HTML/SOLUTION-TO-SIMPLE-EXAMPLE.html
--- acl2-6.2/doc/HTML/SOLUTION-TO-SIMPLE-EXAMPLE.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/SOLUTION-TO-SIMPLE-EXAMPLE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SOLUTION-TO-SIMPLE-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SOLUTION-TO-SIMPLE-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SOLUTION-TO-SIMPLE-EXAMPLE</h3>solution to a simple example
 <pre>Major Section:  <a href="ANNOTATED-ACL2-SCRIPTS.html">ANNOTATED-ACL2-SCRIPTS</a>
diff -Nru acl2-6.2/doc/HTML/SPEC-MV-LET.html acl2-6.3/doc/HTML/SPEC-MV-LET.html
--- acl2-6.2/doc/HTML/SPEC-MV-LET.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/SPEC-MV-LET.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SPEC-MV-LET.html  --  ACL2 Version 6.2</title></head>
+<head><title>SPEC-MV-LET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SPEC-MV-LET</h3>modification of <code><a href="MV-LET.html">mv-let</a></code> supporting speculative and parallel execution
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/SPECIAL-CASES-FOR-REWRITE-RULES.html acl2-6.3/doc/HTML/SPECIAL-CASES-FOR-REWRITE-RULES.html
--- acl2-6.2/doc/HTML/SPECIAL-CASES-FOR-REWRITE-RULES.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/SPECIAL-CASES-FOR-REWRITE-RULES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SPECIAL-CASES-FOR-REWRITE-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SPECIAL-CASES-FOR-REWRITE-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SPECIAL-CASES-FOR-REWRITE-RULES</h3>convenient short forms for rewrite rule formulas
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES.html acl2-6.3/doc/HTML/SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES.html
--- acl2-6.2/doc/HTML/SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SPECIFIC-KINDS-OF-FORMULAS-AS-REWRITE-RULES</h3>advice about how to handle commonly occurring formulas as rewrite rules
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/SPECIOUS-SIMPLIFICATION.html acl2-6.3/doc/HTML/SPECIOUS-SIMPLIFICATION.html
--- acl2-6.2/doc/HTML/SPECIOUS-SIMPLIFICATION.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SPECIOUS-SIMPLIFICATION.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SPECIOUS-SIMPLIFICATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>SPECIOUS-SIMPLIFICATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SPECIOUS-SIMPLIFICATION</h2>nonproductive proof steps
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SPLITTER-OUTPUT.html acl2-6.3/doc/HTML/SPLITTER-OUTPUT.html
--- acl2-6.2/doc/HTML/SPLITTER-OUTPUT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SPLITTER-OUTPUT.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SPLITTER-OUTPUT.html  --  ACL2 Version 6.2</title></head>
+<head><title>SPLITTER-OUTPUT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SPLITTER-OUTPUT</h2>status for reporting of <a href="SPLITTER.html">splitter</a> rules
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SPLITTER.html acl2-6.3/doc/HTML/SPLITTER.html
--- acl2-6.2/doc/HTML/SPLITTER.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SPLITTER.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SPLITTER.html  --  ACL2 Version 6.2</title></head>
+<head><title>SPLITTER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SPLITTER</h2>reporting of rules whose application may have caused case splits
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/STANDARD-CHAR-LISTP.html acl2-6.3/doc/HTML/STANDARD-CHAR-LISTP.html
--- acl2-6.2/doc/HTML/STANDARD-CHAR-LISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STANDARD-CHAR-LISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STANDARD-CHAR-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>STANDARD-CHAR-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STANDARD-CHAR-LISTP</h3>recognizer for a true list of standard characters
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STANDARD-CHAR-P.html acl2-6.3/doc/HTML/STANDARD-CHAR-P.html
--- acl2-6.2/doc/HTML/STANDARD-CHAR-P.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STANDARD-CHAR-P.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STANDARD-CHAR-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>STANDARD-CHAR-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STANDARD-CHAR-P</h3>recognizer for standard characters
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STANDARD-CO.html acl2-6.3/doc/HTML/STANDARD-CO.html
--- acl2-6.2/doc/HTML/STANDARD-CO.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STANDARD-CO.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STANDARD-CO.html  --  ACL2 Version 6.2</title></head>
+<head><title>STANDARD-CO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STANDARD-CO</h3>the character output channel to which <code><a href="LD.html">ld</a></code> prints
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STANDARD-OI.html acl2-6.3/doc/HTML/STANDARD-OI.html
--- acl2-6.2/doc/HTML/STANDARD-OI.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STANDARD-OI.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STANDARD-OI.html  --  ACL2 Version 6.2</title></head>
+<head><title>STANDARD-OI.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STANDARD-OI</h3>the standard object input ``channel''
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STANDARD-PART.html acl2-6.3/doc/HTML/STANDARD-PART.html
--- acl2-6.2/doc/HTML/STANDARD-PART.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/STANDARD-PART.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STANDARD-PART.html  --  ACL2 Version 6.2</title></head>
+<head><title>STANDARD-PART.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STANDARD-PART</h2>ACL2(r) function mapping limited numbers to standard numbers
 <pre>Major Section:  <a href="REAL.html">REAL</a>
diff -Nru acl2-6.2/doc/HTML/STANDARD-STRING-ALISTP.html acl2-6.3/doc/HTML/STANDARD-STRING-ALISTP.html
--- acl2-6.2/doc/HTML/STANDARD-STRING-ALISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STANDARD-STRING-ALISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STANDARD-STRING-ALISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>STANDARD-STRING-ALISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STANDARD-STRING-ALISTP</h3>recognizer for association lists with standard strings as keys
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STANDARDP.html acl2-6.3/doc/HTML/STANDARDP.html
--- acl2-6.2/doc/HTML/STANDARDP.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/STANDARDP.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STANDARDP.html  --  ACL2 Version 6.2</title></head>
+<head><title>STANDARDP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STANDARDP</h2>ACL2(r) recognizer for standard objects
 <pre>Major Section:  <a href="REAL.html">REAL</a>
diff -Nru acl2-6.2/doc/HTML/START-PROOF-TREE.html acl2-6.3/doc/HTML/START-PROOF-TREE.html
--- acl2-6.2/doc/HTML/START-PROOF-TREE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/START-PROOF-TREE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>START-PROOF-TREE.html  --  ACL2 Version 6.2</title></head>
+<head><title>START-PROOF-TREE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>START-PROOF-TREE</h2>start displaying proof trees during proofs
 <pre>Major Section:  <a href="PROOF-TREE.html">PROOF-TREE</a>
diff -Nru acl2-6.2/doc/HTML/STARTUP.html acl2-6.3/doc/HTML/STARTUP.html
--- acl2-6.2/doc/HTML/STARTUP.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/STARTUP.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STARTUP.html  --  ACL2 Version 6.2</title></head>
+<head><title>STARTUP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STARTUP</h2>How to start using ACL2; the ACL2 <a href="COMMAND.html">command</a> loop
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/STATE-GLOBAL-LET_star_.html acl2-6.3/doc/HTML/STATE-GLOBAL-LET_star_.html
--- acl2-6.2/doc/HTML/STATE-GLOBAL-LET_star_.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STATE-GLOBAL-LET_star_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STATE-GLOBAL-LET_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>STATE-GLOBAL-LET_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STATE-GLOBAL-LET*</h3>bind <a href="STATE.html">state</a> global variables
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STATE.html acl2-6.3/doc/HTML/STATE.html
--- acl2-6.2/doc/HTML/STATE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/STATE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>STATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STATE</h2>the von Neumannesque ACL2 state object
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/STOBJ-EXAMPLE-1-DEFUNS.html acl2-6.3/doc/HTML/STOBJ-EXAMPLE-1-DEFUNS.html
--- acl2-6.2/doc/HTML/STOBJ-EXAMPLE-1-DEFUNS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJ-EXAMPLE-1-DEFUNS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOBJ-EXAMPLE-1-DEFUNS.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJ-EXAMPLE-1-DEFUNS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STOBJ-EXAMPLE-1-DEFUNS</h2>the defuns created by the <code>counters</code> stobj
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/STOBJ-EXAMPLE-1-IMPLEMENTATION.html acl2-6.3/doc/HTML/STOBJ-EXAMPLE-1-IMPLEMENTATION.html
--- acl2-6.2/doc/HTML/STOBJ-EXAMPLE-1-IMPLEMENTATION.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJ-EXAMPLE-1-IMPLEMENTATION.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOBJ-EXAMPLE-1-IMPLEMENTATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJ-EXAMPLE-1-IMPLEMENTATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STOBJ-EXAMPLE-1-IMPLEMENTATION</h2>the implementation of the <code>counters</code> stobj
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/STOBJ-EXAMPLE-1-PROOFS.html acl2-6.3/doc/HTML/STOBJ-EXAMPLE-1-PROOFS.html
--- acl2-6.2/doc/HTML/STOBJ-EXAMPLE-1-PROOFS.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJ-EXAMPLE-1-PROOFS.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOBJ-EXAMPLE-1-PROOFS.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJ-EXAMPLE-1-PROOFS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STOBJ-EXAMPLE-1-PROOFS</h2>some proofs involving the <code>counters</code> stobj
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/STOBJ-EXAMPLE-1.html acl2-6.3/doc/HTML/STOBJ-EXAMPLE-1.html
--- acl2-6.2/doc/HTML/STOBJ-EXAMPLE-1.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJ-EXAMPLE-1.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOBJ-EXAMPLE-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJ-EXAMPLE-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STOBJ-EXAMPLE-1</h2>an example of the use of single-threaded objects
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/STOBJ-EXAMPLE-2.html acl2-6.3/doc/HTML/STOBJ-EXAMPLE-2.html
--- acl2-6.2/doc/HTML/STOBJ-EXAMPLE-2.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJ-EXAMPLE-2.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOBJ-EXAMPLE-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJ-EXAMPLE-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STOBJ-EXAMPLE-2</h2>an example of the use of arrays in single-threaded objects
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/STOBJ-EXAMPLE-3.html acl2-6.3/doc/HTML/STOBJ-EXAMPLE-3.html
--- acl2-6.2/doc/HTML/STOBJ-EXAMPLE-3.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJ-EXAMPLE-3.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOBJ-EXAMPLE-3.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJ-EXAMPLE-3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STOBJ-EXAMPLE-3</h2>another example of a single-threaded object
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/STOBJ-LET.html acl2-6.3/doc/HTML/STOBJ-LET.html
--- acl2-6.2/doc/HTML/STOBJ-LET.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJ-LET.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,498 +1,10 @@
 <html>
-<head><title>STOBJ-LET.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJ-LET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h2>STOBJ-LET</h2>using <a href="STOBJ.html">stobj</a>s that contain stobjs
+<h2>STOBJ-LET</h2>See <a href="NESTED-STOBJS.html">nested-stobjs</a>.
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
 </pre><p/>
-<p>
-For this topic we assume that you already understand the basics of
-single-threaded objects in ACL2.  See <a href="STOBJ.html">stobj</a>, and in particular,
-see <a href="DEFSTOBJ.html">defstobj</a>.  The latter topic defers discussion of the ability to specify
-a stobj field that is itself a stobj or an array of stobjs.  That discussion
-is the subject of the present <a href="DOCUMENTATION.html">documentation</a> topic.</p><p>Our presentation is in four sections.  First we augment the documentation for
-<code><a href="DEFSTOBJ.html">defstobj</a></code> by explaining how stobjs may be specified for fields in a new
-stobj definition.  Then we explain an aliasing problem, which accounts for a
-prohibition against making direct calls to accessors and updaters involving
-stobj fields of stobjs.  Next, we introduce an ACL2 primitive, <code>stobj-let</code>,
-which provides the only way to read and write stobj components of stobjs.
-The final section provides precise documentation for <code>stobj-let</code>.</p><p>See also ACL2 community book <code>demos/modeling/nested-stobj-toy-isa.lisp</code> for
-a worked example, which applies nested stobj structures to defining
-interpreters.  A variety of small additional examples may be found in ACL2
-community book <code>misc/nested-stobj-tests.lisp</code>.  For further discussion, you
-are welcome to read the ``Essay on Nested Stobjs'', a long comment in ACL2
-source file <code>other-events.lisp</code>.  However, this documentation topic is
-intended to be self-contained for those familiar with stobjs.</p><p>SECTION: Extension of <code><a href="DEFSTOBJ.html">defstobj</a></code> to permit <a href="STOBJ.html">stobj</a>s within stobjs</p><p>Recall that the <code>:type</code> keyword of a <code><a href="DEFSTOBJ.html">defstobj</a></code> field descriptor can
-specify the type of the field as a type-spec (see <a href="TYPE-SPEC.html">type-spec</a>).  For example,
-the following specifies an integer field and a field that is an array of
-bytes.
-
-<pre>
-  (defstobj st
-    (int-field :type integer :initially 0)
-    (ar-field :type (array unsigned-byte (10)) :initially 0))
-</pre>
-
-But the <code>:type</code> of a stobj field descriptor may instead be based on a
-stobj.  For example, the following sequence of three <a href="EVENTS.html">events</a> is legal.
-The first field descriptor of <code>top</code>, named <code>sub1-field</code>, illustrates one
-new kind of value for <code>:type</code>: the name of a previously-introduced stobj,
-which here is <code>sub1</code>. The second field descriptor of <code>top</code>, named
-<code>sub2-ar-field</code>, illustrates the other new kind of value for <code>:type</code>: an
-array whose elements are specified by the name of a previously-introduced
-stobj, in this case, the stobj <code>sub2</code>.
-
-<pre>
-  (defstobj sub1 fld1)
-  (defstobj sub2 fld2)
-  (defstobj top
-    (sub1-field :type sub1)
-    (sub2-ar-field :type (array sub2 (10))))
-</pre>
-
-The <code>:initially</code> keyword is illegal for fields whose <code>:type</code> is a stobj
-or an array of stobjs.  Each such initial value is provided by a
-corresponding call of the stobj creator for that stobj.  In particular, in
-the case of an array of stobjs, the stobj creator is called once for each
-element of the array, so that the array elements are distinct.  For example,
-each element of <code>sub2-ar-field</code> in the example above is initially provided
-by a separate call of <code>create-sub2</code>.  Each initial element is thus unique,
-and in particular is distinct from the initial global value of the stobj.
-Similarly, the initial global stobj for <code>sub1</code> is distinct from the initial
-<code>sub1-field</code> field of the global stobj for <code>top</code>, as these result from
-separate calls of <code>create-sub1</code>.</p><p>When a stobj is used in a field of another stobj, we may refer to the former
-field as a ``child stobj'' and the latter stobj as a ``parent stobj''.  So in
-the example above, <code>sub1-field</code> is a child stobj of type <code>sub1</code> for
-parent stobj <code>top</code>, and <code>sub2-ar-field</code> is an array of child stobjs of
-type <code>sub2</code> for parent stobj <code>top</code>.  A child stobj has the same
-structural shape as the global stobj of its type, but as explained above,
-these are distinct structures.  We follow standard terminology by saying
-``isomorphic'' to indicate the same structural shape.  So for example, (the
-value of) <code>sub1-field</code> is isomorphic to <code>sub1</code>, though these are distinct
-structures.</p><p>SECTION: An aliasing problem</p><p>Before introducing <code>stobj-let</code> below, we provide motivatation for this
-ACL2 primitive.</p><p>Consider the following <a href="EVENTS.html">events</a>.
-
-<pre>
-  (defstobj child fld)
-  (defstobj parent
-    (fld2 :type child))
-</pre>
-
-Now suppose we could evaluate the following code, to be run immediately after
-admitting the two <code><a href="DEFSTOBJ.html">defstobj</a></code> events above.
-
-<pre>
-  (let* ((child (fld2 parent))
-         (child (update-fld 3 child)))
-    (mv child parent))
-</pre>
-
-Now logically there is no change to <code>parent</code>: <code>parent</code> is passed through
-unchanged.  We can indeed prove that fact!
-
-<pre>
-  (thm (equal (mv-nth 1
-                      (let* ((child (fld2 parent))
-                             (child (update-fld 3 child)))
-                        (mv child parent)))
-              parent))
-</pre>
-
-But recall that stobjs are updated with destructive assignments.  That is, we
-really are updating <code>(fld2 parent)</code> to be the new value of <code>child</code>,
-whether this is explained logically or not.  Thus, evaluation of the above
-<code><a href="LET_star_.html">let*</a></code> form does in fact change the actual global stobj, <code>parent</code>.</p><p>(Aside: Here is an explanation involving raw Lisp, for those who might find
-this useful.  We escape to raw Lisp and execute the following; note that
-<code>*the-live-parent*</code> is the Lisp variable representing the global value of
-<code>parent</code>.
-
-<pre>
-(let ((parent *the-live-parent*))
-  (let* ((child (fld2 parent))
-         (child (update-fld 4 child)))
-    (mv child parent)))
-</pre>
-
-Then, in raw Lisp, <code>(fld (fld2 *the-live-parent*))</code> evaluates to <code>4</code>,
-illustrating the destructive update.  End of Aside.)</p><p>Such aliasing can permit a change to a child stobj to cause a
-logically-inexplicable change to the parent stobj.  Similarly, unfettered
-accessing of stobj fields can result in logically inexplicable changes to the
-child stobj when the parent stobj is changed.  Thus, ACL2 disallows direct
-calls of stobj accessors and updaters for fields whose <code>:type</code> is a stobj
-or an array of stobjs.  Instead, ACL2 provides <code>stobj-let</code> for reading and
-writing such fields in a sound manner.</p><p>SECTION: Accessing and updating stobj fields of stobjs using <code>stobj-let</code></p><p>ACL2 provides a primitive, <code>stobj-let</code>, to access and update stobj fields
-of stobjs, in a manner that avoids the aliasing problem discussed above.  In
-this section we provide an informal introduction to <code>stobj-let</code>, using
-examples, to be followed in the next section by precise documentation.</p><p>We begin by returning to a slight variant of the example above.
-
-<pre>
-  (defstobj child fld)
-  (defstobj parent
-    (fld2 :type child)
-    fld3)
-</pre>
-
-The following form returns the result of updating the <code>fld2</code> field of
-<code>parent</code>, which is a stobj isomorphic to <code>child</code>, to have a value of 3.
-Below we explain the terms ``bindings'', ``producer variables'',
-``producer'', and ``consumer'', as well as how to understand the form above.
-
-<pre>
-  (stobj-let
-   ((child (fld2 parent)))  ; bindings
-   (child)                  ; producer variable(s)
-   (update-fld 3 child)     ; producer
-   (update-fld3 'a parent)) ; consumer
-</pre>
-
-The four lines under ``<code>stobj-let</code>'' just above can be understood,
-respectively, as follows.
-
-<pre>
-o Bindings:
-    Bind <code>child</code> to <code>(fld2 parent)</code>.
-o Producer variable(s) and producer:
-    Bind the producer variable, <code>child</code>, to
-    the value of the producer, <code>(update-fld 3 child)</code>.
-o Implicit extra step:
-    Update <code>fld2</code> of <code>parent</code> with the producer variable, <code>child</code>.
-o Consumer:
-    Finally, return <code>(update-fld3 'a parent)</code>.
-</pre>
-
-Thus, the logical expansion of the <code>stobj-let</code> form above is the following
-expression, though this is approximate (see below).
-
-<pre>
-  (let ((child (fld2 parent))) ; bindings
-    (let ((child (update-fld 3 child))) ; bind producer vars to producer
-      (let ((parent (update-fld2 child parent))) ; update parent
-        (update-fld3 'a parent))))
-</pre>
-
-The bindings always bind distinct names to child stobjs of a unique parent
-stobj, where the child stobj corresponds to the <code>:type</code> associated with the
-indicated accessor in the <code><a href="DEFSTOBJ.html">defstobj</a></code> form for the parent stobj.  Thus in
-this case, for the unique binding, variable <code>child</code> is bound to the stobj
-of `type' <code>child</code> for accessor <code>fld2</code> of the parent stobj, <code>parent</code>.
-We refer to <code>child</code> from the bindings as a ``stobj-let-bound variable''.
-Note also that the ``implicit extra step'' mentioned above is generated by
-macroexpansion of <code>stobj-let</code>; it logically updates the parent with new
-child values, just before calling the consumer.  Implementation note:
-Destructive updating in raw Lisp lets us omit this implicit extra step.</p><p>The form above is equivalent to the form displayed just below, which differs
-only in specifying an explicit stobj updater corresponding to the stobj
-accessor, <code>fld2</code>.  Here we show the default updater name, whose name has
-<code>"UPDATE-"</code> prepended to the name of the accessor.  But if the
-<code>:RENAMING</code> field of the <code>defstobj</code> event specified a different updater
-name corresponding to <code>fld2</code>, then that would need to be included where we
-have added <code>update-fld2</code> below.
-
-<pre>
-  (stobj-let
-   ((child (fld2 parent) update-fld2)) ; bindings, including updater(s)
-   (child)                  ; producer variables
-   (update-fld 3 child)     ; producer
-   (update-fld3 'a parent)) ; consumer
-</pre>
-</p><p>If you try to evaluate (either version of) the above <code>stobj-let</code> form in
-the top-level loop, you will get an error.  For technical reasons, ACL2
-limits <code>stobj-let</code> computation on ``live'' stobjs (as opposed to list
-structures that happen to satisfy stobj recognizers) to be within function
-bodies.  The following edited log illustrates how <code>stobj-let</code> may be used
-in function bodies.
-
-<pre>
-  ACL2 !&gt;(defstobj child fld)
-
-  Summary
-  Form:  ( DEFSTOBJ CHILD ...)
-  Rules: NIL
-  Time:  0.02 seconds (prove: 0.00, print: 0.00, other: 0.02)
-   CHILD
-  ACL2 !&gt;(defstobj parent
-           (fld2 :type child)
-           fld3)
-
-  Summary
-  Form:  ( DEFSTOBJ PARENT ...)
-  Rules: NIL
-  Time:  0.02 seconds (prove: 0.00, print: 0.00, other: 0.02)
-   PARENT
-  ACL2 !&gt;(defun f (parent)
-           (declare (xargs :stobjs parent))
-           (stobj-let
-            ((child (fld2 parent)))   ; bindings
-            (child)                   ; producer variables
-            (update-fld 3 child)      ; producer
-            (update-fld3 'a parent))) ; consumer
-  [[output omitted]]
-   F
-  ACL2 !&gt;(f parent)
-  &lt;parent&gt;
-  ACL2 !&gt;(defun check-f (parent)
-           ; returns the value of the field of the child stobj
-           (declare (xargs :stobjs parent))
-           (stobj-let
-            ((child (fld2 parent))) ; bindings
-            (val)                   ; producer variables
-            (fld child)             ; producer
-            val))                   ; consumer
-  [[output omitted]]
-   CHECK-F
-  ACL2 !&gt;(check-f parent)
-  3
-  ACL2 !&gt;
-</pre>
-</p><p>Notice that the second function defined above, <code>check-f</code>, uses a
-<code>stobj-let</code> form that returns an ordinary value: it reads a value from a
-child stobj, but does not write to the child stobj, as indicated by the lack
-of a child stobj among the producer variables.  So for that <code>stobj-let</code>
-form, there is no implicit extra step.</p><p>For the <code>stobj-let</code> expansion displayed earlier above, we said it was
-``approximate'' for two reasons, which we give here informally.  (You can
-apply <code>:</code><code><a href="TRANS1.html">trans1</a></code> to the <code>stobj-let</code> call above to see the formal
-expansion.)  First, <code>stobj-let</code> declares the stobj-let-bound variables to
-be <code>ignorable</code> for the top <code>let</code> bindings.  Second, and more importantly,
-<code>stobj-let</code> imposes the following restrictions on the producer and
-consumer, to avoid the aliasing problem: it disallows references to the
-parent stobj in the producer and it also disallows references to any bound
-stobj (i.e., bound in the bindings) in the consumer.</p><p>We conclude this section with examples based on a slight variation of the
-nested stobj example from the first section above.  These events can also be
-found in ACL2 community book <code>misc/nested-stobj-tests.lisp</code>, immediately
-under the following comment:
-
-<pre>
-; As promised in :doc stobj-let, we begin with an example from that :doc.
-</pre>
-
-Note that some lemmas were needed in order to complete the <a href="GUARD.html">guard</a> proof
-for the function <code>update-top</code>, which may be found in the above file; they
-are omitted below.</p><p>First we introduce three stobjs.
-
-<pre>
-  (defstobj kid1 fld1)
-  (defstobj kid2 fld2)
-  (defstobj mom
-    (kid1-field :type kid1)
-    (kid2-ar-field :type (array kid2 (5)))
-    last-op)
-</pre>
-
-The next function takes a given index and a <code>mom</code> stobj, and swaps the
-value stored in the stobj in <code>mom</code>'s <code>kid2-ar-field</code> array at that index
-with the value stored in the stobj in <code>mom</code>'s <code>kid1-field</code> field.
-
-<pre>
-  (defun mom-swap-fields (index mom)
-    (declare (xargs :stobjs mom
-                    :guard (and (natp index)
-                                (&lt; index (kid2-ar-field-length mom)))))
-    (stobj-let
-     ((kid1 (kid1-field mom))
-      (kid2 (kid2-ar-fieldi index mom)))
-     (kid1 kid2)
-     (let* ((val1 (fld1 kid1))
-            (val2 (fld2 kid2))
-            (kid1 (update-fld1 val2 kid1))
-            (kid2 (update-fld2 val1 kid2)))
-       (mv kid1 kid2))
-     (update-last-op 'swap mom)))
-</pre>
-
-Function <code>mom.kid1-fld1</code> stores a given value in the given <code>mom</code>'s
-<code>kid1-fld1</code> field.
-
-<pre>
-  (defun mom.kid1-fld1 (val mom)
-    (declare (xargs :stobjs mom))
-    (stobj-let
-     ((kid1 (kid1-field mom)))
-     (kid1)
-     (update-fld1 val kid1)
-     (update-last-op val mom)))
-</pre>
-
-We next combine the two functions above, according to an <code>op</code> argument, as
-indicated by the following definition.
-
-<pre>
-  (defun update-mom (op mom)
-    (declare (xargs :stobjs mom))
-    (cond ((and (consp op)
-                (eq (car op) 'swap)
-                (natp (cdr op))
-                (&lt; (cdr op) (kid2-ar-field-length mom)))
-           (mom-swap-fields (cdr op) mom))
-          (t (mom.kid1-fld1 op mom))))
-</pre>
-
-The following checker function uses a <code>stobj-let</code> form like the ones above,
-a major difference being that the producer variable is not a stobj, since it
-does not modify the input stobj, <code>mom</code>.
-
-<pre>
-  (defun check-update-mom (index val1 val2 last-op mom)
-      (declare (xargs :stobjs mom
-                      :mode :program
-                      :guard
-                      (or (null index)
-                          (and (natp index)
-                               (&lt; index (kid2-ar-field-length mom))))))
-      (and (equal (last-op mom) last-op)
-           (stobj-let
-            ((kid1 (kid1-field mom))
-             (kid2 (kid2-ar-fieldi index mom)))
-            (val) ; producer variables
-            (and (equal val1 (fld1 kid1))
-                 (equal val2 (fld2 kid2)))
-            val)))
-</pre>
-
-Now let us run our update function to populate some fields within the <code>mom</code>
-stobj.
-
-<pre>
-  (let* ((mom ; set mom to (3 (x0 x1 x2 x3 x4))
-           (update-mom 3 mom))
-          (mom ; set mom to (x1 (x0 3 x2 x3 x4))
-           (update-mom '(swap . 1) mom))
-          (mom ; set mom to (7 (x0 3 x2 x3 x4))
-           (update-mom 7 mom))
-          (mom ; set mom to (x0 (7 3 x2 x3 x4))
-           (update-mom '(swap . 0) mom))
-          (mom ; set mom to (5 (7 3 x2 x3 x4))
-           (update-mom 5 mom))
-          (mom ; set mom to (7 (5 3 x2 x3 x4))
-           (update-mom '(swap . 0) mom)))
-     mom)
-</pre>
-
-Are the above values of 7, 5, and 3 as expected, with a last operation being
-a swap?  Yes!
-
-<pre>
-  ACL2 !&gt;(and (check-update-mom 0 7 5 'swap mom)
-              (check-update-mom 1 7 3 'swap mom))
-  T
-  ACL2 !&gt;
-</pre>
-
-Notice that above, we never tried to access two different entries of the
-array.  This can be done, but we need to bind two different stobjs to those
-fields.  Fortunately, congruent stobjs make this possible; see <a href="DEFSTOBJ.html">defstobj</a>, in
-particular the discussion of congruent stobjs.  Since we want to bind two
-stobjs to values in the array that are isomorphic to the stobj <code>kid2</code>, we
-introduce a stobj congruent to <code>kid2</code>.
-
-<pre>
-  (defstobj kid2a fld2a :congruent-to kid2)
-</pre>
-
-Then we can define our swapping function as follows.  The <a href="GUARD.html">guard</a> proof
-obligation includes the requirement that the two indices be distinct, again
-to avoid an aliasing problem.
-
-<pre>
-  (defun mom-swap-indices (i1 i2 mom)
-    (declare (xargs :stobjs mom
-                    :guard (and (natp i1)
-                                (&lt; i1 (kid2-ar-field-length mom))
-                                (natp i2)
-                                (&lt; i2 (kid2-ar-field-length mom))
-                                (not (equal i1 i2)))))
-    (stobj-let
-     ((kid2 (kid2-ar-fieldi i1 mom))
-      (kid2a (kid2-ar-fieldi i2 mom)))
-     (kid2 kid2a)
-     (let* ((val2 (fld2 kid2))
-            (val2a (fld2 kid2a))
-            (kid2 (update-fld2 val2a kid2))
-            (kid2a (update-fld2 val2 kid2a)))
-       (mv kid2 kid2a))
-     mom))
-</pre>
-
-The aforementioned community book, <code>misc/nested-stobj-tests.lisp</code>, contains
-a corresponding checker immediately following this definition.</p><p>SECTION: Precise documentation for <code>stobj-let</code></p><p>
-<pre>
-General Form:
-(stobj-let
- BINDINGS
- PRODUCER-VARIABLES
- PRODUCER
- CONSUMER)
-</pre>
-
-where <code>PRODUCER-VARIABLES</code> is a non-empty true list of legal variable names
-without duplicates, <code>PRODUCER</code> and <code>CONSUMER</code> are expressions, and
-<code>BINDINGS</code> is a list subject to the following requirements.</p><p><code>BINDINGS</code> is a non-empty true list of tuples, each of which has the form
-<code>(VAR ACCESSOR)</code> or <code>(VAR ACCESSOR UPDATER)</code>.  There is a stobj name,
-<code>ST</code>, previously introduced by <code><a href="DEFSTOBJ.html">defstobj</a></code> (not <code><a href="DEFABSSTOBJ.html">defabsstobj</a></code>), such
-that each <code>accessor</code> is of the form <code>(ACC ST)</code> or <code>(ACCi I ST)</code>, with
-the same stobj name (<code>ST</code>) for each binding.  In the case <code>(ACC ST)</code>,
-<code>ACC</code> is the accessor for a non-array field of <code>ST</code>.  In the case
-<code>(ACCi I ST)</code>, <code>ACCi</code> is the accessor for an array field of <code>ST</code>, and
-<code>I</code> is either a variable, a natural number, a list <code>(quote N)</code> where
-<code>N</code> is a natural number, or a symbol introduced by <code><a href="DEFCONST.html">defconst</a></code>.  If
-<code>UPDATER</code> is supplied, then it is a symbol that is the name of the stobj
-updater for the field of <code>ST</code> accessed by <code>ACCESSOR</code>.  If <code>UPDATER</code> is
-not supplied, then for the discussion below we consider it to be, implicitly,
-the symbol in the same package as the function symbol of <code>ACCESSOR</code> (i.e.,
-<code>ACC</code> or <code>ACCi</code>), obtained by prepending the string <code>"UPDATE-"</code> to
-the <code><a href="SYMBOL-NAME.html">symbol-name</a></code> of that function symbol.  Finally, <code>ACCESSOR</code> has a
-<a href="SIGNATURE.html">signature</a> specifying a return value that is either <code>ST</code> or is stobj
-that is congruent to <code>ST</code>.</p><p>If the conditions above are met, then the General Form expands to the one of
-the following expressions, depending on whether the list
-<code>PRODUCER-VARIABLES</code> has one member or more than one member, respectively.
-(But see below for extra code that may be inserted if there are stobj array
-accesses in <code>BINDINGS</code>.)  Here we write <code>STOBJ-LET-BOUND-VARS</code> for the
-list of variables <code>VAR</code> discussed above, i.e., for
-<code>(strip-cars BINDINGS)</code>.  And, we write <code>UPDATES</code> for the result of
-mapping through <code>PRODUCER-VARIABLES</code> and, for each variable <code>VAR</code> that
-has a binding <code>(VAR ACCESSOR UPDATER)</code> in <code>BINDINGS</code> (where <code>UPDATER</code>
-may be implicit, as discussed above), collect into <code>UPDATES</code> the tuple
-<code>(ST (UPDATER VAR ST))</code>.</p><p>For <code>PRODUCER-VARIABLES</code> = <code>(PRODUCER-VAR)</code>:
-
-<pre>
-  (let BINDINGS
-    (declare (ignorable . STOBJ-LET-BOUND-VARIABLES))
-    (let ((PRODUCER-VAR PRODUCER))
-      (let* UPDATES
-        CONSUMER)))
-</pre>
-</p><p>Otherwise:
-
-<pre>
-  (let BINDINGS
-    (declare (ignorable . STOBJ-LET-BOUND-VARIABLES))
-    (mv-let PRODUCER-VARS
-            PRODUCER
-            (let* UPDATES
-              CONSUMER)))
-</pre>
-
-Moreover, ACL2 places restrictions on the resulting expression: <code>ST</code> must
-not occur free in <code>PRODUCER</code>, and every variable in
-<code>STOBJ-LET-BOUND-VARIABLES</code> must not occur free in <code>CONSUMER</code>.</p><p><code>Stobj-let</code> forms can be evaluated using ordinary objects in theorem
-contexts, much as any form.  They can also, of course, appear in function
-bodis.  However, a <code>stobj-let</code> form cannot be evaluated directly in the
-top-level loop or other top-level contexts for execution (such as during
-<code><a href="MAKE-EVENT.html">make-event</a></code> expansion).</p><p>Finally, let <code>FORM</code> denote the form displayed above (either case).  We
-explain how <code>FORM</code> is actually replaced by an expression of the form
-<code>(PROGN$ ... FORM)</code>.  This expression generates an extra <a href="GUARD.html">guard</a> proof
-obligation, which guarantees that no aliasing occurs from binding two
-stobj-let-bound variables to the same array access.  So fix a stobj array
-accessor <code>ACCi</code> for which some stobj is bound to <code>(ACCi I ST)</code> in
-<code>BINDINGS</code>; we define an expression <code>ACCi-CHECK</code> as follows.  Collect up
-all such index expressions <code>I</code>, where if <code>I</code> is of the form <code>(quote N)</code>
-then replace <code>I</code> by <code>N</code>.  If the resulting list of index expressions for
-<code>ACCi</code> consists solely of distinct numbers, or if it is of length 1, then
-no extra check is generated for <code>ACCi</code>.  Otherwise, let <code>ACCi-CHECK</code> be
-the form <code>(chk-no-duplicatesp (list I1 ... Ik))</code>, where <code>I1</code>, ..., <code>Ik</code>
-are the index expressions for <code>ACCi</code>.  Note: <code>chk-no-duplicatesp</code> is a
-function that returns nil, but has a <a href="GUARD.html">guard</a> that its argument is an
-<code><a href="EQLABLE-LISTP.html">eqlable-listp</a></code> that satisfies <code><a href="NO-DUPLICATESP.html">no-duplicatesp</a></code>.  Finally, <code>FORM</code>
-is replaced by <code>(PROGN$ CHK1 ... CHKn FORM)</code>, where the <code>CHKm</code> range over
-all of the above <code>ACCi-CHECK</code>.
-</p>
+<p></p>
 <p>
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
diff -Nru acl2-6.2/doc/HTML/STOBJ.html acl2-6.3/doc/HTML/STOBJ.html
--- acl2-6.2/doc/HTML/STOBJ.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJ.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOBJ.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>STOBJ</h1>single-threaded objects or ``von Neumann bottlenecks''
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -31,6 +31,10 @@
 </h3>
 </li>
 
+<li><h3><a href="NESTED-STOBJS.html">NESTED-STOBJS</a> -- using <a href="STOBJ.html">stobj</a>s that contain stobjs
+</h3>
+</li>
+
 <li><h3><a href="RESIZE-LIST.html">RESIZE-LIST</a> -- list resizer in support of stobjs
 </h3>
 </li>
@@ -59,7 +63,7 @@
 </h3>
 </li>
 
-<li><h3><a href="STOBJ-LET.html">STOBJ-LET</a> -- using <a href="STOBJ.html">stobj</a>s that contain stobjs
+<li><h3><a href="STOBJ-LET.html">STOBJ-LET</a> -- See <a href="NESTED-STOBJS.html">nested-stobjs</a>.
 </h3>
 </li>
 
diff -Nru acl2-6.2/doc/HTML/STOBJS.html acl2-6.3/doc/HTML/STOBJS.html
--- acl2-6.2/doc/HTML/STOBJS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/STOBJS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOBJS.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOBJS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STOBJS</h2>xargs keyword <code>:STOBJS</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/STOP-PROOF-TREE.html acl2-6.3/doc/HTML/STOP-PROOF-TREE.html
--- acl2-6.2/doc/HTML/STOP-PROOF-TREE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/STOP-PROOF-TREE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STOP-PROOF-TREE.html  --  ACL2 Version 6.2</title></head>
+<head><title>STOP-PROOF-TREE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>STOP-PROOF-TREE</h2>stop displaying proof trees during proofs
 <pre>Major Section:  <a href="PROOF-TREE.html">PROOF-TREE</a>
diff -Nru acl2-6.2/doc/HTML/STRING-APPEND.html acl2-6.3/doc/HTML/STRING-APPEND.html
--- acl2-6.2/doc/HTML/STRING-APPEND.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING-APPEND.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING-APPEND.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING-APPEND.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING-APPEND</h3><a href="CONCATENATE.html">concatenate</a> two strings
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING-DOWNCASE.html acl2-6.3/doc/HTML/STRING-DOWNCASE.html
--- acl2-6.2/doc/HTML/STRING-DOWNCASE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING-DOWNCASE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING-DOWNCASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING-DOWNCASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING-DOWNCASE</h3>in a given string, turn upper-case <a href="CHARACTERS.html">characters</a> into lower-case
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING-EQUAL.html acl2-6.3/doc/HTML/STRING-EQUAL.html
--- acl2-6.2/doc/HTML/STRING-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING-EQUAL</h3>string equality without regard to case
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING-LISTP.html acl2-6.3/doc/HTML/STRING-LISTP.html
--- acl2-6.2/doc/HTML/STRING-LISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING-LISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING-LISTP</h3>recognizer for a true list of strings
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING-UPCASE.html acl2-6.3/doc/HTML/STRING-UPCASE.html
--- acl2-6.2/doc/HTML/STRING-UPCASE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING-UPCASE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING-UPCASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING-UPCASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING-UPCASE</h3>in a given string, turn lower-case <a href="CHARACTERS.html">characters</a> into upper-case
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING.html acl2-6.3/doc/HTML/STRING.html
--- acl2-6.2/doc/HTML/STRING.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING</h3><a href="COERCE.html">coerce</a> to a string
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRINGP.html acl2-6.3/doc/HTML/STRINGP.html
--- acl2-6.2/doc/HTML/STRINGP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRINGP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRINGP.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRINGP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRINGP</h3>recognizer for strings
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING_gt_.html acl2-6.3/doc/HTML/STRING_gt_.html
--- acl2-6.2/doc/HTML/STRING_gt_.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING_gt_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING_gt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING_gt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING&gt;</h3>greater-than test for strings
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING_gt_=.html acl2-6.3/doc/HTML/STRING_gt_=.html
--- acl2-6.2/doc/HTML/STRING_gt_=.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING_gt_=.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING_gt_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING_gt_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING&gt;=</h3>less-than-or-equal test for strings
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING_lt_.html acl2-6.3/doc/HTML/STRING_lt_.html
--- acl2-6.2/doc/HTML/STRING_lt_.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING_lt_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING_lt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING_lt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING&lt;</h3>less-than test for strings
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRING_lt_=.html acl2-6.3/doc/HTML/STRING_lt_=.html
--- acl2-6.2/doc/HTML/STRING_lt_=.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRING_lt_=.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRING_lt_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRING_lt_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRING&lt;=</h3>less-than-or-equal test for strings
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRIP-CARS.html acl2-6.3/doc/HTML/STRIP-CARS.html
--- acl2-6.2/doc/HTML/STRIP-CARS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRIP-CARS.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRIP-CARS.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRIP-CARS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRIP-CARS</h3>collect up all first components of pairs in a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRIP-CDRS.html acl2-6.3/doc/HTML/STRIP-CDRS.html
--- acl2-6.2/doc/HTML/STRIP-CDRS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/STRIP-CDRS.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRIP-CDRS.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRIP-CDRS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRIP-CDRS</h3>collect up all second components of pairs in a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/STRONG-REWRITE-RULES.html acl2-6.3/doc/HTML/STRONG-REWRITE-RULES.html
--- acl2-6.2/doc/HTML/STRONG-REWRITE-RULES.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/STRONG-REWRITE-RULES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>STRONG-REWRITE-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>STRONG-REWRITE-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>STRONG-REWRITE-RULES</h3>formulating good rewrite rules
 <pre>Major Section:  <a href="INTRODUCTION-TO-THE-THEOREM-PROVER.html">INTRODUCTION-TO-THE-THEOREM-PROVER</a>
diff -Nru acl2-6.2/doc/HTML/SUBLIS.html acl2-6.3/doc/HTML/SUBLIS.html
--- acl2-6.2/doc/HTML/SUBLIS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBLIS.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBLIS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBLIS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SUBLIS</h3>substitute an alist into a tree
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SUBSEQ.html acl2-6.3/doc/HTML/SUBSEQ.html
--- acl2-6.2/doc/HTML/SUBSEQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBSEQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBSEQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBSEQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SUBSEQ</h3>subsequence of a string or list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SUBSETP-EQ.html acl2-6.3/doc/HTML/SUBSETP-EQ.html
--- acl2-6.2/doc/HTML/SUBSETP-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBSETP-EQ.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBSETP-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBSETP-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SUBSETP-EQ</h3>See <a href="SUBSETP.html">subsetp</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SUBSETP-EQUAL.html acl2-6.3/doc/HTML/SUBSETP-EQUAL.html
--- acl2-6.2/doc/HTML/SUBSETP-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBSETP-EQUAL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBSETP-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBSETP-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SUBSETP-EQUAL</h3>See <a href="SUBSETP.html">subsetp</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SUBSETP.html acl2-6.3/doc/HTML/SUBSETP.html
--- acl2-6.2/doc/HTML/SUBSETP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBSETP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBSETP.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBSETP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SUBSETP</h3>test if every <code><a href="MEMBER.html">member</a></code> of one list is a <code><a href="MEMBER.html">member</a></code> of the other
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SUBST.html acl2-6.3/doc/HTML/SUBST.html
--- acl2-6.2/doc/HTML/SUBST.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBST.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBST.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SUBST</h3>a single substitution into a tree
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SUBSTITUTE.html acl2-6.3/doc/HTML/SUBSTITUTE.html
--- acl2-6.2/doc/HTML/SUBSTITUTE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBSTITUTE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBSTITUTE.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBSTITUTE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SUBSTITUTE</h3>substitute into a string or a list, using <code><a href="EQL.html">eql</a></code> as test
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SUBVERSIVE-INDUCTIONS.html acl2-6.3/doc/HTML/SUBVERSIVE-INDUCTIONS.html
--- acl2-6.2/doc/HTML/SUBVERSIVE-INDUCTIONS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBVERSIVE-INDUCTIONS.html	2013-09-30 17:39:29.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBVERSIVE-INDUCTIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBVERSIVE-INDUCTIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SUBVERSIVE-INDUCTIONS</h2>why we restrict <a href="ENCAPSULATE.html">encapsulate</a>d recursive functions
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SUBVERSIVE-RECURSIONS.html acl2-6.3/doc/HTML/SUBVERSIVE-RECURSIONS.html
--- acl2-6.2/doc/HTML/SUBVERSIVE-RECURSIONS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SUBVERSIVE-RECURSIONS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SUBVERSIVE-RECURSIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SUBVERSIVE-RECURSIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SUBVERSIVE-RECURSIONS</h2>why we restrict <a href="ENCAPSULATE.html">encapsulate</a>d recursive functions
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SWITCHES-PARAMETERS-AND-MODES.html acl2-6.3/doc/HTML/SWITCHES-PARAMETERS-AND-MODES.html
--- acl2-6.2/doc/HTML/SWITCHES-PARAMETERS-AND-MODES.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/SWITCHES-PARAMETERS-AND-MODES.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SWITCHES-PARAMETERS-AND-MODES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SWITCHES-PARAMETERS-AND-MODES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>SWITCHES-PARAMETERS-AND-MODES</h1>a variety of ways to modify the ACL2 environment
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
@@ -40,6 +40,14 @@
 </h3>
 </li>
 
+<li><h3><a href="ADD-LD-KEYWORD-ALIAS.html">ADD-LD-KEYWORD-ALIAS</a> -- See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+</h3>
+</li>
+
+<li><h3><a href="ADD-LD-KEYWORD-ALIAS_bang_.html">ADD-LD-KEYWORD-ALIAS!</a> -- See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+</h3>
+</li>
+
 <li><h3><a href="ADD-MACRO-ALIAS.html">ADD-MACRO-ALIAS</a> -- associate a function name with a macro name
 </h3>
 </li>
@@ -92,6 +100,10 @@
 </h3>
 </li>
 
+<li><h3><a href="LD-KEYWORD-ALIASES.html">LD-KEYWORD-ALIASES</a> -- abbreviation of some keyword commands
+</h3>
+</li>
+
 <li><h3><a href="LOGIC.html">LOGIC</a> -- to set the default <a href="DEFUN-MODE.html">defun-mode</a> to <code>:logic</code>
 </h3>
 </li>
@@ -252,6 +264,10 @@
 </h3>
 </li>
 
+<li><h3><a href="SET-INHIBIT-WARNINGS_bang_.html">SET-INHIBIT-WARNINGS!</a> -- control warnings non-<code><a href="LOCAL.html">local</a></code>ly
+</h3>
+</li>
+
 <li><h3><a href="SET-INHIBITED-SUMMARY-TYPES.html">SET-INHIBITED-SUMMARY-TYPES</a> -- control which parts of the summary are printed
 </h3>
 </li>
@@ -268,6 +284,10 @@
 </h3>
 </li>
 
+<li><h3><a href="SET-LD-KEYWORD-ALIASES_bang_.html">SET-LD-KEYWORD-ALIASES!</a> -- See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+</h3>
+</li>
+
 <li><h3><a href="SET-LD-REDEFINITION-ACTION.html">SET-LD-REDEFINITION-ACTION</a> -- See <a href="LD-REDEFINITION-ACTION.html">ld-redefinition-action</a>.
 </h3>
 </li>
diff -Nru acl2-6.2/doc/HTML/SYMBOL-ALISTP.html acl2-6.3/doc/HTML/SYMBOL-ALISTP.html
--- acl2-6.2/doc/HTML/SYMBOL-ALISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SYMBOL-ALISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYMBOL-ALISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYMBOL-ALISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYMBOL-ALISTP</h3>recognizer for association lists with symbols as keys
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SYMBOL-LISTP.html acl2-6.3/doc/HTML/SYMBOL-LISTP.html
--- acl2-6.2/doc/HTML/SYMBOL-LISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SYMBOL-LISTP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYMBOL-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYMBOL-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYMBOL-LISTP</h3>recognizer for a true list of symbols
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SYMBOL-NAME.html acl2-6.3/doc/HTML/SYMBOL-NAME.html
--- acl2-6.2/doc/HTML/SYMBOL-NAME.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SYMBOL-NAME.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYMBOL-NAME.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYMBOL-NAME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYMBOL-NAME</h3>the name of a symbol (a string)
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SYMBOL-PACKAGE-NAME.html acl2-6.3/doc/HTML/SYMBOL-PACKAGE-NAME.html
--- acl2-6.2/doc/HTML/SYMBOL-PACKAGE-NAME.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SYMBOL-PACKAGE-NAME.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYMBOL-PACKAGE-NAME.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYMBOL-PACKAGE-NAME.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYMBOL-PACKAGE-NAME</h3>the name of the package of a symbol (a string)
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SYMBOL-_lt_.html acl2-6.3/doc/HTML/SYMBOL-_lt_.html
--- acl2-6.2/doc/HTML/SYMBOL-_lt_.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SYMBOL-_lt_.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYMBOL-_lt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYMBOL-_lt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYMBOL-&lt;</h3>less-than test for symbols
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SYMBOLP.html acl2-6.3/doc/HTML/SYMBOLP.html
--- acl2-6.2/doc/HTML/SYMBOLP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SYMBOLP.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYMBOLP.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYMBOLP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYMBOLP</h3>recognizer for symbols
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SYNTAX.html acl2-6.3/doc/HTML/SYNTAX.html
--- acl2-6.2/doc/HTML/SYNTAX.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SYNTAX.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYNTAX.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYNTAX.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>SYNTAX</h2>the syntax of ACL2 is that of Common Lisp
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/SYNTAXP-EXAMPLES.html acl2-6.3/doc/HTML/SYNTAXP-EXAMPLES.html
--- acl2-6.2/doc/HTML/SYNTAXP-EXAMPLES.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SYNTAXP-EXAMPLES.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYNTAXP-EXAMPLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYNTAXP-EXAMPLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYNTAXP-EXAMPLES</h3>examples pertaining to syntaxp hypotheses
 <pre>Major Section:  <a href="SYNTAXP.html">SYNTAXP</a>
diff -Nru acl2-6.2/doc/HTML/SYNTAXP.html acl2-6.3/doc/HTML/SYNTAXP.html
--- acl2-6.2/doc/HTML/SYNTAXP.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/SYNTAXP.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,15 +1,18 @@
 <html>
-<head><title>SYNTAXP.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYNTAXP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h2>SYNTAXP</h2>attach a heuristic filter on a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>, <code>:</code><code><a href="META.html">meta</a></code>, or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule
+<h2>SYNTAXP</h2>attach a heuristic filter on a rule
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
 </pre><p/>
 <p>
+A calls of <code>syntaxp</code> in the hypothesis of a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>,
+<code>:</code><code><a href="DEFINITION.html">definition</a></code>, or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule is treated specially, as
+described below.  Similar treatment is given to the evaluation of a
+<code>:</code><code><a href="META.html">meta</a></code> rule's hypothesis function call.</p><p>For example, consider the <code>:</code><code><a href="REWRITE.html">rewrite</a></code> rule created from the following
+formula.
 
 <pre>
 Example:
-Consider the :REWRITE rule created from
-
 (IMPLIES (SYNTAXP (NOT (AND (CONSP X)
                             (EQ (CAR X) 'NORM))))
          (EQUAL (LXD X)
@@ -52,12 +55,12 @@
 are the same, but there can be subtle differences with which the writer of a
 <code>syntaxp</code> hypothesis must be aware.  You can use <code>:</code><code><a href="TRANS.html">trans</a></code> to
 display this internal representation.</p><p>There are two types of <code>syntaxp</code> hypotheses.  The simpler type may be a
-hypothesis of a <code>:</code><code><a href="REWRITE.html">rewrite</a></code> or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule provided
-<code>test</code> contains at least one variable but no free variables
-(see <a href="FREE-VARIABLES.html">free-variables</a>).  In particular, <code>test</code> may not use <a href="STOBJ.html">stobj</a>s; any
-stobj name will be treated as an ordinary variable.  The case of
-<code>:</code><code><a href="META.html">meta</a></code> rules is similar to the above, except that it applies to the
-result of applying the hypothesis metafunction.  (Later below we will
+hypothesis of a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>, <code>:</code><code><a href="DEFINITION.html">definition</a></code>, or
+<code>:</code><code><a href="LINEAR.html">linear</a></code> rule provided <code>test</code> contains at least one variable but
+no free variables (see <a href="FREE-VARIABLES.html">free-variables</a>).  In particular, <code>test</code> may not use
+<a href="STOBJ.html">stobj</a>s; any stobj name will be treated as an ordinary variable.  The
+case of <code>:</code><code><a href="META.html">meta</a></code> rules is similar to the above, except that it applies
+to the result of applying the hypothesis metafunction.  (Later below we will
 describe the second type, an <em>extended</em> <code>syntaxp</code> hypothesis, which may
 use <code><a href="STATE.html">state</a></code>.)</p><p>We illustrate the use of simple <code>syntaxp</code> hypotheses by slightly
 elaborating the example given above.  Consider a <code>:</code><code><a href="REWRITE.html">rewrite</a></code> rule:
diff -Nru acl2-6.2/doc/HTML/SYS-CALL+.html acl2-6.3/doc/HTML/SYS-CALL+.html
--- acl2-6.2/doc/HTML/SYS-CALL+.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/SYS-CALL+.html	2013-09-30 17:39:32.000000000 +0000
@@ -0,0 +1,51 @@
+<html>
+<head><title>SYS-CALL+.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h3>SYS-CALL+</h3>make a system call to the host OS, returning status and output
+<pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
+</pre><p/>
+<p>
+
+<pre>
+Example Form:
+; The following returns (mv nil s state), where s is the standard output
+; from the command: ls -l ./
+(sys-call+ "ls" '("-l" "./") state)
+
+General Form:
+(sys-call+ cmd args state)
+</pre>
+
+where <code>cmd</code> is a command to the host operating system and <code>args</code> is a
+list of strings.  Also see <a href="SYS-CALL.html">sys-call</a>; but there are two differences between
+<code><a href="SYS-CALL.html">sys-call</a></code> and <code>sys-call+</code>.  First, the latter takes an extra argument,
+<code>state</code>.  Second, while <code>sys-call</code> returns <code>nil</code>, <code>sys-call+</code> returns
+three values: a so-called error triple (see <a href="ERROR-TRIPLES.html">error-triples</a>),
+<code>(mv erp val state)</code>.  While execution returns values as described just
+below, further below we explain the logical return values.  In the following,
+please keep in mind that the exact behavior depends on the platform; the
+description is only a guide.  For example, on some platforms <code>erp</code> might
+always be <code>nil</code>, even if in the error case, and <code>val</code> might or might not
+include error output.  (For details, look at the ACL2 source code for
+function <code>system-call+</code>, whose output is converted by replacing an <code>erp</code>
+of <code>nil</code> by 0.)
+</p>
+<blockquote><p></p><p><code>Erp</code> is either <code>nil</code> or a non-zero integer.  Normally, <code>nil</code> indicates
+that the command ran without error, and otherwise <code>erp</code> is the exit
+status.</p><p><code>Val</code> is a string, typically the output generated by the call of <code>cmd</code>.</p><p><code>State</code> is an ACL2 <a href="STATE.html">state</a>.</p></blockquote>
+<p></p><p>While the description above pertains to the values returned by executing
+<code>sys-call+</code>, the logical values are as follows.  For a discussion of the
+<code>acl2-oracle</code> field of an ACL2 state, see <a href="STATE.html">state</a>.
+</p>
+<blockquote><p></p><p><code>Erp</code> is the first element of the <code>acl2-oracle</code> of the input state if
+that element is a nonzero integer, and otherwise is <code>nil</code>.</p><p><code>Val</code> is the second element of the <code>acl2-oracle</code> of the input state if it
+is a string, else the empty string, <code>""</code>.</p><p><code>State</code> is the result of popping the <code>acl2-oracle</code> field twice from the
+input state.</p></blockquote>
+<p></p><p>Note that unlike <code><a href="SYS-CALL.html">sys-call</a></code>, a call of <code><a href="SYS-CALL+.html">sys-call+</a></code> has no effect on
+subsequent calls of <code><a href="SYS-CALL-STATUS.html">sys-call-status</a></code>.</p><p>As is the case for <code>sys-call</code>, a trust tag is required to call
+<code>sys-call+</code>.  For discussion of this and more, see <a href="SYS-CALL.html">sys-call</a>.
+</p>
+<p>
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/SYS-CALL-STATUS.html acl2-6.3/doc/HTML/SYS-CALL-STATUS.html
--- acl2-6.2/doc/HTML/SYS-CALL-STATUS.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SYS-CALL-STATUS.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYS-CALL-STATUS.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYS-CALL-STATUS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYS-CALL-STATUS</h3>exit status from the preceding system call
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/SYS-CALL.html acl2-6.3/doc/HTML/SYS-CALL.html
--- acl2-6.2/doc/HTML/SYS-CALL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/SYS-CALL.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>SYS-CALL.html  --  ACL2 Version 6.2</title></head>
+<head><title>SYS-CALL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>SYS-CALL</h3>make a system call to the host operating system
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
@@ -14,10 +14,10 @@
 </pre>
 
 The first argument of <code>sys-call</code> is a command for the host operating
-system, and the second argument is a list of strings that are the
-arguments for that command.  In GCL and perhaps other lisps, you can put the
+system, and the second argument is a list of strings that are the arguments
+for that command.  In GCL and perhaps some other lisps, you can put the
 arguments with the command; but this is not the case, for example, in Allegro
-CL running on Linux.</p><p>The use of <code><a href="PROG2$.html">prog2$</a></code> above is optional, but illustrates a typical sort
+CL running on Linux.</p><p>For a related utility, see <a href="SYS-CALL+.html">sys-call+</a>.</p><p>The use of <code><a href="PROG2$.html">prog2$</a></code> above is optional, but illustrates a typical sort
 of use when one wishes to get the return status.  See <a href="SYS-CALL-STATUS.html">sys-call-status</a>.
 </p>
 <p>
@@ -66,15 +66,14 @@
 </p><p>Finally, we make a comment about output redirection, which also applies to
 other related features that one may expect of a shell.  <code>Sys-call</code> does not
 directly support output redirection.  If you want to run a program, <code>P</code>,
-and redirect its output, we suggest that you create a wrapper script, <code>W</code>
+and redirect its output, one option is to create a wrapper script, <code>W</code>
 to call instead.  Thus <code>W</code> might be a shell script containing the line:
 
 <pre>
 P $* &gt;&amp; foo.out
 </pre>
 
-If this sort of solution proves inadequate, please contact the ACL2
-implementors and perhaps we can come up with a solution.
+For a different, more direct solution, see <a href="SYS-CALL+.html">sys-call+</a>.
 </p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
 </body>
 </html>
diff -Nru acl2-6.2/doc/HTML/Subsumption_of_Induction_Candidates_in_App_Example.html acl2-6.3/doc/HTML/Subsumption_of_Induction_Candidates_in_App_Example.html
--- acl2-6.2/doc/HTML/Subsumption_of_Induction_Candidates_in_App_Example.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Subsumption_of_Induction_Candidates_in_App_Example.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Subsumption_of_Induction_Candidates_in_App_Example.html  --  ACL2 Version 6.2</title></head>
+<head><title>Subsumption_of_Induction_Candidates_in_App_Example.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Subsumption of Induction Candidates in App Example</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Suggested_Inductions_in_the_Associativity_of_App_Example.html acl2-6.3/doc/HTML/Suggested_Inductions_in_the_Associativity_of_App_Example.html
--- acl2-6.2/doc/HTML/Suggested_Inductions_in_the_Associativity_of_App_Example.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Suggested_Inductions_in_the_Associativity_of_App_Example.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Suggested_Inductions_in_the_Associativity_of_App_Example.html  --  ACL2 Version 6.2</title></head>
+<head><title>Suggested_Inductions_in_the_Associativity_of_App_Example.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Suggested Inductions in the Associativity of App Example</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Symbolic_Execution_of_Models.html acl2-6.3/doc/HTML/Symbolic_Execution_of_Models.html
--- acl2-6.2/doc/HTML/Symbolic_Execution_of_Models.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/Symbolic_Execution_of_Models.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Symbolic_Execution_of_Models.html  --  ACL2 Version 6.2</title></head>
+<head><title>Symbolic_Execution_of_Models.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Symbolic Execution of Models</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/TABLE.html acl2-6.3/doc/HTML/TABLE.html
--- acl2-6.2/doc/HTML/TABLE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/TABLE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TABLE</h2>user-managed tables
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/TAKE.html acl2-6.3/doc/HTML/TAKE.html
--- acl2-6.2/doc/HTML/TAKE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/TAKE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAKE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAKE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TAKE</h3>initial segment of a list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/TAU-DATA.html acl2-6.3/doc/HTML/TAU-DATA.html
--- acl2-6.2/doc/HTML/TAU-DATA.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-DATA.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-DATA.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-DATA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TAU-DATA</h2>to see what tau knows about a function symbol
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/TAU-DATABASE.html acl2-6.3/doc/HTML/TAU-DATABASE.html
--- acl2-6.2/doc/HTML/TAU-DATABASE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-DATABASE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-DATABASE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-DATABASE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TAU-DATABASE</h2>to see the tau database as a (very large) object
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/TAU-INTERVAL-DOM.html acl2-6.3/doc/HTML/TAU-INTERVAL-DOM.html
--- acl2-6.2/doc/HTML/TAU-INTERVAL-DOM.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-INTERVAL-DOM.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-INTERVAL-DOM.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-INTERVAL-DOM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TAU-INTERVAL-DOM</h3>access the domain of a tau interval
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/TAU-INTERVAL-HI-REL.html acl2-6.3/doc/HTML/TAU-INTERVAL-HI-REL.html
--- acl2-6.2/doc/HTML/TAU-INTERVAL-HI-REL.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-INTERVAL-HI-REL.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-INTERVAL-HI-REL.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-INTERVAL-HI-REL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TAU-INTERVAL-HI-REL</h3>access the upper bound relation of a tau interval
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/TAU-INTERVAL-HI.html acl2-6.3/doc/HTML/TAU-INTERVAL-HI.html
--- acl2-6.2/doc/HTML/TAU-INTERVAL-HI.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-INTERVAL-HI.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-INTERVAL-HI.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-INTERVAL-HI.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TAU-INTERVAL-HI</h3>access the upper bound of a tau interval
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/TAU-INTERVAL-LO-REL.html acl2-6.3/doc/HTML/TAU-INTERVAL-LO-REL.html
--- acl2-6.2/doc/HTML/TAU-INTERVAL-LO-REL.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-INTERVAL-LO-REL.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-INTERVAL-LO-REL.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-INTERVAL-LO-REL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TAU-INTERVAL-LO-REL</h3>access the lower bound relation of a tau interval
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/TAU-INTERVAL-LO.html acl2-6.3/doc/HTML/TAU-INTERVAL-LO.html
--- acl2-6.2/doc/HTML/TAU-INTERVAL-LO.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-INTERVAL-LO.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-INTERVAL-LO.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-INTERVAL-LO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TAU-INTERVAL-LO</h3>access the lower bound of a tau interval
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/TAU-INTERVALP.html acl2-6.3/doc/HTML/TAU-INTERVALP.html
--- acl2-6.2/doc/HTML/TAU-INTERVALP.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-INTERVALP.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-INTERVALP.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-INTERVALP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TAU-INTERVALP</h3>Boolean recognizer for tau intervals
 <pre>Major Section:  <a href="TAU-SYSTEM.html">TAU-SYSTEM</a>
diff -Nru acl2-6.2/doc/HTML/TAU-STATUS.html acl2-6.3/doc/HTML/TAU-STATUS.html
--- acl2-6.2/doc/HTML/TAU-STATUS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-STATUS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-STATUS.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-STATUS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TAU-STATUS</h2>query or set tau system status
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/TAU-SYSTEM.html acl2-6.3/doc/HTML/TAU-SYSTEM.html
--- acl2-6.2/doc/HTML/TAU-SYSTEM.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TAU-SYSTEM.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TAU-SYSTEM.html  --  ACL2 Version 6.2</title></head>
+<head><title>TAU-SYSTEM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TAU-SYSTEM</h2>make a rule for the ACL2 ``type checker''
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
diff -Nru acl2-6.2/doc/HTML/TENTH.html acl2-6.3/doc/HTML/TENTH.html
--- acl2-6.2/doc/HTML/TENTH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/TENTH.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TENTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>TENTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TENTH</h3>tenth member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/TERM-ORDER.html acl2-6.3/doc/HTML/TERM-ORDER.html
--- acl2-6.2/doc/HTML/TERM-ORDER.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/TERM-ORDER.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TERM-ORDER.html  --  ACL2 Version 6.2</title></head>
+<head><title>TERM-ORDER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TERM-ORDER</h3>the ordering relation on terms used by ACL2
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/TERM-TABLE.html acl2-6.3/doc/HTML/TERM-TABLE.html
--- acl2-6.2/doc/HTML/TERM-TABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/TERM-TABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TERM-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TERM-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TERM-TABLE</h2>a table used to validate meta rules
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/TERM.html acl2-6.3/doc/HTML/TERM.html
--- acl2-6.2/doc/HTML/TERM.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TERM.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TERM.html  --  ACL2 Version 6.2</title></head>
+<head><title>TERM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TERM</h2>the three senses of well-formed ACL2 expressions or formulas
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/THE-METHOD.html acl2-6.3/doc/HTML/THE-METHOD.html
--- acl2-6.2/doc/HTML/THE-METHOD.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/THE-METHOD.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THE-METHOD.html  --  ACL2 Version 6.2</title></head>
+<head><title>THE-METHOD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>THE-METHOD</h2>how to find proofs
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/THE.html acl2-6.3/doc/HTML/THE.html
--- acl2-6.2/doc/HTML/THE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/THE.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THE.html  --  ACL2 Version 6.2</title></head>
+<head><title>THE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>THE</h3>run-time type check
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/THEORIES-AND-PRIMITIVES.html acl2-6.3/doc/HTML/THEORIES-AND-PRIMITIVES.html
--- acl2-6.2/doc/HTML/THEORIES-AND-PRIMITIVES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/THEORIES-AND-PRIMITIVES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THEORIES-AND-PRIMITIVES.html  --  ACL2 Version 6.2</title></head>
+<head><title>THEORIES-AND-PRIMITIVES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>THEORIES-AND-PRIMITIVES</h2>warnings from disabling certain built-in functions
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/THEORIES.html acl2-6.3/doc/HTML/THEORIES.html
--- acl2-6.2/doc/HTML/THEORIES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/THEORIES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THEORIES.html  --  ACL2 Version 6.2</title></head>
+<head><title>THEORIES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>THEORIES</h1>sets of <a href="RUNE.html">rune</a>s to <a href="ENABLE.html">enable</a>/<a href="DISABLE.html">disable</a> in concert
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/THEORY-FUNCTIONS.html acl2-6.3/doc/HTML/THEORY-FUNCTIONS.html
--- acl2-6.2/doc/HTML/THEORY-FUNCTIONS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/THEORY-FUNCTIONS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THEORY-FUNCTIONS.html  --  ACL2 Version 6.2</title></head>
+<head><title>THEORY-FUNCTIONS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>THEORY-FUNCTIONS</h2>functions for obtaining or producing <a href="THEORIES.html">theories</a>
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/THEORY-INVARIANT.html acl2-6.3/doc/HTML/THEORY-INVARIANT.html
--- acl2-6.2/doc/HTML/THEORY-INVARIANT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/THEORY-INVARIANT.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THEORY-INVARIANT.html  --  ACL2 Version 6.2</title></head>
+<head><title>THEORY-INVARIANT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>THEORY-INVARIANT</h2>user-specified invariants on <a href="THEORIES.html">theories</a>
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/THEORY.html acl2-6.3/doc/HTML/THEORY.html
--- acl2-6.2/doc/HTML/THEORY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/THEORY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>THEORY</h2>retrieve named theory
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/THIRD.html acl2-6.3/doc/HTML/THIRD.html
--- acl2-6.2/doc/HTML/THIRD.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/THIRD.html	2013-09-30 17:39:32.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THIRD.html  --  ACL2 Version 6.2</title></head>
+<head><title>THIRD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>THIRD</h3>third member of the list
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/THM.html acl2-6.3/doc/HTML/THM.html
--- acl2-6.2/doc/HTML/THM.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/THM.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>THM.html  --  ACL2 Version 6.2</title></head>
+<head><title>THM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>THM</h2>prove a theorem
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/TIDBITS.html acl2-6.3/doc/HTML/TIDBITS.html
--- acl2-6.2/doc/HTML/TIDBITS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/TIDBITS.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TIDBITS.html  --  ACL2 Version 6.2</title></head>
+<head><title>TIDBITS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TIDBITS</h2>some basic hints for using ACL2
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/TIME$.html acl2-6.3/doc/HTML/TIME$.html
--- acl2-6.2/doc/HTML/TIME$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/TIME$.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TIME$.html  --  ACL2 Version 6.2</title></head>
+<head><title>TIME$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TIME$</h3>time an evaluation
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/TIME-TRACKER-TAU.html acl2-6.3/doc/HTML/TIME-TRACKER-TAU.html
--- acl2-6.2/doc/HTML/TIME-TRACKER-TAU.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TIME-TRACKER-TAU.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TIME-TRACKER-TAU.html  --  ACL2 Version 6.2</title></head>
+<head><title>TIME-TRACKER-TAU.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TIME-TRACKER-TAU</h2>messages about expensive use of the <a href="TAU-SYSTEM.html">tau-system</a>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/TIME-TRACKER.html acl2-6.3/doc/HTML/TIME-TRACKER.html
--- acl2-6.2/doc/HTML/TIME-TRACKER.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/TIME-TRACKER.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,16 +1,17 @@
 <html>
-<head><title>TIME-TRACKER.html  --  ACL2 Version 6.2</title></head>
+<head><title>TIME-TRACKER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TIME-TRACKER</h2>display time spent during specified evaluation
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
 </pre><p/>
 <p>
-The <code>time-tracker</code> macro is a utility for displaying runtime (cpu time)
-spent during specified evaluation.  In general, the user provides this
-specification.  However, ACL2 itself uses this utility for tracking uses of
-its <a href="TAU-SYSTEM.html">tau-system</a> reasoning utility (see <a href="TIME-TRACKER-TAU.html">time-tracker-tau</a>).  We discuss
-that use as an example before discussing the general form for calls of
-<code>time-tracker</code>.</p><p>Remark for ACL2(p) users (see <a href="PARALLELISM.html">parallelism</a>): <code>time-tracker</code> is merely a
+The <code>time-tracker</code> macro is a utility for displaying time spent during
+specified evaluation.  In general, the user provides this specification.
+However, ACL2 itself uses this utility for tracking uses of its
+<a href="TAU-SYSTEM.html">tau-system</a> reasoning utility (see <a href="TIME-TRACKER-TAU.html">time-tracker-tau</a>).  We discuss that
+use as an example before discussing the general form for calls of
+<code>time-tracker</code>.</p><p>Note that by default, the time being tracked is runtime (cpu time); to switch
+to realtime (elapsed time), see <a href="GET-INTERNAL-TIME.html">get-internal-time</a>.</p><p>Remark for ACL2(p) users (see <a href="PARALLELISM.html">parallelism</a>): <code>time-tracker</code> is merely a
 no-op in ACL2(p).</p><p>During the development of the <a href="TAU-SYSTEM.html">tau-system</a>, we were concerned about the
 possibility that it would slow down proofs without any indication of how one
 might avoid the problem.  We wanted a utility that would alert the user in
@@ -37,7 +38,8 @@
 <code>:tau</code>.  The first argument of <code>time-tracker</code> is the tag, which in our
 running example is always <code>:tau</code>.  Note that although all arguments of
 <code>time-tracker</code> are evaluated, the first argument is typically a keyword and
-the second is always a keyword, and such arguments evaluate to themselves.</p><p>An ACL2 function invoked at the start of a proof includes the following code.
+the second is always a keyword, and such arguments evaluate to themselves.</p><p>An ACL2 function invoked at the start of a proof includes approximately the
+following code.
 
 <pre>
 (progn$
@@ -123,7 +125,7 @@
 We conclude with a precise discussion of all arguments.  Note that all
 arguments are evaluated; thus when we refer to an argument, we are discussing
 the value of that argument.  All times discussed are runtimes, i.e., cpu
-times.</p><p>
+times, unless that default is changed; see <a href="GET-INTERNAL-TIME.html">get-internal-time</a>.</p><p>
 <pre>
 General forms:
 
diff -Nru acl2-6.2/doc/HTML/TIPS.html acl2-6.3/doc/HTML/TIPS.html
--- acl2-6.2/doc/HTML/TIPS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/TIPS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TIPS.html  --  ACL2 Version 6.2</title></head>
+<head><title>TIPS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TIPS</h2>some hints for using the ACL2 prover
 <pre>Major Section:  <a href="ACL2-TUTORIAL.html">ACL2-TUTORIAL</a>
diff -Nru acl2-6.2/doc/HTML/TOGGLE-PC-MACRO.html acl2-6.3/doc/HTML/TOGGLE-PC-MACRO.html
--- acl2-6.2/doc/HTML/TOGGLE-PC-MACRO.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/TOGGLE-PC-MACRO.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TOGGLE-PC-MACRO.html  --  ACL2 Version 6.2</title></head>
+<head><title>TOGGLE-PC-MACRO.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TOGGLE-PC-MACRO</h2>change an ordinary macro command to an atomic macro, or vice-versa
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/TOP-LEVEL.html acl2-6.3/doc/HTML/TOP-LEVEL.html
--- acl2-6.2/doc/HTML/TOP-LEVEL.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TOP-LEVEL.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TOP-LEVEL.html  --  ACL2 Version 6.2</title></head>
+<head><title>TOP-LEVEL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TOP-LEVEL</h2>evaluate a top-level form as a function body
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/TRACE$.html acl2-6.3/doc/HTML/TRACE$.html
--- acl2-6.2/doc/HTML/TRACE$.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/TRACE$.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRACE$.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRACE$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TRACE$</h2>trace function evaluations
 <pre>Major Section:  <a href="TRACE.html">TRACE</a>
diff -Nru acl2-6.2/doc/HTML/TRACE.html acl2-6.3/doc/HTML/TRACE.html
--- acl2-6.2/doc/HTML/TRACE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/TRACE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRACE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRACE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>TRACE</h1>tracing functions in ACL2
 <pre>Major Section:  <a href="acl2-doc-major-topics.html">ACL2 Documentation</a>
diff -Nru acl2-6.2/doc/HTML/TRACE_bang_.html acl2-6.3/doc/HTML/TRACE_bang_.html
--- acl2-6.2/doc/HTML/TRACE_bang_.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/TRACE_bang_.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRACE_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRACE_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TRACE!</h2>trace the indicated functions after creating an active trust tag
 <pre>Major Section:  <a href="TRACE.html">TRACE</a>
diff -Nru acl2-6.2/doc/HTML/TRANS.html acl2-6.3/doc/HTML/TRANS.html
--- acl2-6.2/doc/HTML/TRANS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TRANS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRANS.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRANS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TRANS</h2>print the macroexpansion of a form
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/TRANS1.html acl2-6.3/doc/HTML/TRANS1.html
--- acl2-6.2/doc/HTML/TRANS1.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TRANS1.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRANS1.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRANS1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TRANS1</h2>print the one-step macroexpansion of a form
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/TRANS_bang_.html acl2-6.3/doc/HTML/TRANS_bang_.html
--- acl2-6.2/doc/HTML/TRANS_bang_.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TRANS_bang_.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRANS_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRANS_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TRANS!</h2>print the macroexpansion of a form without single-threadedness concerns
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/TRUE-LIST-LISTP.html acl2-6.3/doc/HTML/TRUE-LIST-LISTP.html
--- acl2-6.2/doc/HTML/TRUE-LIST-LISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/TRUE-LIST-LISTP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRUE-LIST-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRUE-LIST-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TRUE-LIST-LISTP</h3>recognizer for true (proper) lists of true lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/TRUE-LISTP.html acl2-6.3/doc/HTML/TRUE-LISTP.html
--- acl2-6.2/doc/HTML/TRUE-LISTP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/TRUE-LISTP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRUE-LISTP.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRUE-LISTP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TRUE-LISTP</h3>recognizer for proper (null-terminated) lists
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/TRUNCATE.html acl2-6.3/doc/HTML/TRUNCATE.html
--- acl2-6.2/doc/HTML/TRUNCATE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/TRUNCATE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRUNCATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRUNCATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TRUNCATE</h3>division returning an integer by truncating toward 0
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/TRUST-TAG.html acl2-6.3/doc/HTML/TRUST-TAG.html
--- acl2-6.2/doc/HTML/TRUST-TAG.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TRUST-TAG.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TRUST-TAG.html  --  ACL2 Version 6.2</title></head>
+<head><title>TRUST-TAG.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TRUST-TAG</h2>See <a href="DEFTTAG.html">defttag</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/TTAGS-SEEN.html acl2-6.3/doc/HTML/TTAGS-SEEN.html
--- acl2-6.2/doc/HTML/TTAGS-SEEN.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TTAGS-SEEN.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TTAGS-SEEN.html  --  ACL2 Version 6.2</title></head>
+<head><title>TTAGS-SEEN.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TTAGS-SEEN</h2>list some declared trust tags (ttags)
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/TTREE.html acl2-6.3/doc/HTML/TTREE.html
--- acl2-6.2/doc/HTML/TTREE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TTREE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TTREE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TTREE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TTREE</h2>tag-trees
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/TUTORIAL1-TOWERS-OF-HANOI.html acl2-6.3/doc/HTML/TUTORIAL1-TOWERS-OF-HANOI.html
--- acl2-6.2/doc/HTML/TUTORIAL1-TOWERS-OF-HANOI.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/TUTORIAL1-TOWERS-OF-HANOI.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TUTORIAL1-TOWERS-OF-HANOI.html  --  ACL2 Version 6.2</title></head>
+<head><title>TUTORIAL1-TOWERS-OF-HANOI.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TUTORIAL1-TOWERS-OF-HANOI</h3>The Towers of Hanoi Example
 <pre>Major Section:  <a href="ANNOTATED-ACL2-SCRIPTS.html">ANNOTATED-ACL2-SCRIPTS</a>
diff -Nru acl2-6.2/doc/HTML/TUTORIAL2-EIGHTS-PROBLEM.html acl2-6.3/doc/HTML/TUTORIAL2-EIGHTS-PROBLEM.html
--- acl2-6.2/doc/HTML/TUTORIAL2-EIGHTS-PROBLEM.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/TUTORIAL2-EIGHTS-PROBLEM.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TUTORIAL2-EIGHTS-PROBLEM.html  --  ACL2 Version 6.2</title></head>
+<head><title>TUTORIAL2-EIGHTS-PROBLEM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TUTORIAL2-EIGHTS-PROBLEM</h3>The Eights Problem Example
 <pre>Major Section:  <a href="ANNOTATED-ACL2-SCRIPTS.html">ANNOTATED-ACL2-SCRIPTS</a>
diff -Nru acl2-6.2/doc/HTML/TUTORIAL3-PHONEBOOK-EXAMPLE.html acl2-6.3/doc/HTML/TUTORIAL3-PHONEBOOK-EXAMPLE.html
--- acl2-6.2/doc/HTML/TUTORIAL3-PHONEBOOK-EXAMPLE.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/TUTORIAL3-PHONEBOOK-EXAMPLE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TUTORIAL3-PHONEBOOK-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TUTORIAL3-PHONEBOOK-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TUTORIAL3-PHONEBOOK-EXAMPLE</h3>A Phonebook Specification
 <pre>Major Section:  <a href="ANNOTATED-ACL2-SCRIPTS.html">ANNOTATED-ACL2-SCRIPTS</a>
diff -Nru acl2-6.2/doc/HTML/TUTORIAL4-DEFUN-SK-EXAMPLE.html acl2-6.3/doc/HTML/TUTORIAL4-DEFUN-SK-EXAMPLE.html
--- acl2-6.2/doc/HTML/TUTORIAL4-DEFUN-SK-EXAMPLE.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/TUTORIAL4-DEFUN-SK-EXAMPLE.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TUTORIAL4-DEFUN-SK-EXAMPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TUTORIAL4-DEFUN-SK-EXAMPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TUTORIAL4-DEFUN-SK-EXAMPLE</h3>example of quantified notions
 <pre>Major Section:  <a href="ANNOTATED-ACL2-SCRIPTS.html">ANNOTATED-ACL2-SCRIPTS</a>
diff -Nru acl2-6.2/doc/HTML/TUTORIAL5-MISCELLANEOUS-EXAMPLES.html acl2-6.3/doc/HTML/TUTORIAL5-MISCELLANEOUS-EXAMPLES.html
--- acl2-6.2/doc/HTML/TUTORIAL5-MISCELLANEOUS-EXAMPLES.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/TUTORIAL5-MISCELLANEOUS-EXAMPLES.html	2013-09-30 17:39:25.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TUTORIAL5-MISCELLANEOUS-EXAMPLES.html  --  ACL2 Version 6.2</title></head>
+<head><title>TUTORIAL5-MISCELLANEOUS-EXAMPLES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TUTORIAL5-MISCELLANEOUS-EXAMPLES</h3>miscellaneous ACL2 examples
 <pre>Major Section:  <a href="ANNOTATED-ACL2-SCRIPTS.html">ANNOTATED-ACL2-SCRIPTS</a>
diff -Nru acl2-6.2/doc/HTML/TYPE-PRESCRIPTION.html acl2-6.3/doc/HTML/TYPE-PRESCRIPTION.html
--- acl2-6.2/doc/HTML/TYPE-PRESCRIPTION.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TYPE-PRESCRIPTION.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,33 +1,46 @@
 <html>
-<head><title>TYPE-PRESCRIPTION.html  --  ACL2 Version 6.2</title></head>
+<head><title>TYPE-PRESCRIPTION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TYPE-PRESCRIPTION</h2>make a rule that specifies the type of a term
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and how they are
-used to build rules from formulas.  Some example <code>:</code><code><a href="COROLLARY.html">corollary</a></code>
-formulas from which <code>:type-prescription</code> rules might be built are:
-
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
 <pre>
 Examples:
-(implies                           (nth n lst) is of type characterp
- (and (character-listp lst)        provided the two hypotheses can
-      (&lt; n (length lst)))          be established by type reasoning
- (characterp (nth n lst))).
-
-(implies                           (demodulize a lst 'value ans) is
- (and (atom a)                     either a nonnegative integer or
-      (true-listp lst)             of the same type as ans, provided
-      (member-equal a lst))        the hyps can be established by type
- (or (and                          reasoning
-       (integerp
-        (demodulize a lst 'value ans))
-       (&gt;= (demodulize a lst 'value ans) 0))
-     (equal (demodulize a lst 'value ans) ans))).
-</pre>
+(defthm integerp-foo                       ; Assumes that foo has been
+  (integerp (foo x y))                     ; defined; then, states that
+  :rule-classes :type-prescription)        ; (foo x y) is of type integer.
+
+(defthm characterp-nth-type-prescription   ; (Nth n lst) is of type character
+  (implies                                 ; provided the hypotheses can be
+   (and (character-listp lst)              ; established by type reasoning.
+        (&lt;= 0 n)
+        (&lt; n (len lst)))
+   (characterp (nth n lst)))
+  :rule-classes :type-prescription)
 
-To specify the term whose type (see <a href="TYPE-SET.html">type-set</a>) is described by the rule,
+(defthm characterp-nth-type-prescription-alt ; equivalent to the above
+  (implies
+   (and (character-listp lst)
+        (&lt;= 0 n)
+        (&lt; n (len lst)))
+   (characterp (nth n lst)))
+  :rule-classes ((:type-prescription :typed-term (nth n lst))))
+
+(defthm demodulize-type-for-quote-value  ; (Demodulize a lst 'value ans) is
+  (implies                               ; either a nonnegative integer or
+   (and (atom a)                         ; of the same type as ans, provided
+        (true-listp lst)                 ; the hyps can be established by type
+        (member-equal a lst))            ; reasoning
+   (or (and (integerp (demodulize a lst 'value ans))
+            (&gt;= (demodulize a lst 'value ans) 0))
+     (equal (demodulize a lst 'value ans) ans)))
+  :rule-classes :type-prescription)
+</pre>
+</p><p>To specify the term whose type (see <a href="TYPE-SET.html">type-set</a>) is described by the rule,
 provide that term as the value of the <code>:typed-term</code> field of the rule class
 object.
 </p>
@@ -75,14 +88,14 @@
 <pre>
   (defun my-statep (x)
     (and (true-listp x)
-         (equal (length x) 2)))
+         (equal (len x) 2)))
 </pre>
 
 and suppose <code>(my-statep s)</code> occurs as a hypothesis of a
 <code>:type-prescription</code> rule that is being considered for use in the proof
 attempt for a conjecture with the hypothesis <code>(my-statep s)</code>.  Since the
 hypothesis in the conjecture is rewritten, it will become the conjunction of
-<code>(true-listp s)</code> and <code>(equal (length s) 2)</code>.  Those two terms will be
+<code>(true-listp s)</code> and <code>(equal (len s) 2)</code>.  Those two terms will be
 assumed to have type <code>t</code> in the context in which the <code>:type-prescription</code>
 rule is tried.  But type reasoning will be unable to deduce that
 <code>(my-statep s)</code> has type <code>t</code> in this context.  Thus, either <code>my-statep</code>
diff -Nru acl2-6.2/doc/HTML/TYPE-SET-INVERTER.html acl2-6.3/doc/HTML/TYPE-SET-INVERTER.html
--- acl2-6.2/doc/HTML/TYPE-SET-INVERTER.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/TYPE-SET-INVERTER.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,18 +1,18 @@
 <html>
-<head><title>TYPE-SET-INVERTER.html  --  ACL2 Version 6.2</title></head>
+<head><title>TYPE-SET-INVERTER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TYPE-SET-INVERTER</h2>exhibit a new decoding for an ACL2 type-set
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
-how they are used to build rules from formulas.
-
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
 <pre>
 Example Rule Class:
 (:type-set-inverter
   :corollary (equal (and (counting-number x) (not (equal x 0)))
-                    (and (integerp x) (&lt; x 0)))
+                    (and (integerp x) (&lt; 0 x)))
   :type-set 2)
 
 General Forms of Rule Class:
diff -Nru acl2-6.2/doc/HTML/TYPE-SET.html acl2-6.3/doc/HTML/TYPE-SET.html
--- acl2-6.2/doc/HTML/TYPE-SET.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TYPE-SET.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TYPE-SET.html  --  ACL2 Version 6.2</title></head>
+<head><title>TYPE-SET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TYPE-SET</h2>how type information is encoded in ACL2
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/TYPE-SPEC.html acl2-6.3/doc/HTML/TYPE-SPEC.html
--- acl2-6.2/doc/HTML/TYPE-SPEC.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/TYPE-SPEC.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TYPE-SPEC.html  --  ACL2 Version 6.2</title></head>
+<head><title>TYPE-SPEC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>TYPE-SPEC</h3>type specifiers in declarations
 <pre>Major Section:  <a href="DECLARE.html">DECLARE</a>
diff -Nru acl2-6.2/doc/HTML/TYPE.html acl2-6.3/doc/HTML/TYPE.html
--- acl2-6.2/doc/HTML/TYPE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/TYPE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TYPE.html  --  ACL2 Version 6.2</title></head>
+<head><title>TYPE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TYPE</h2>See <a href="DECLARE.html">declare</a>.
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/TYPESPEC-CHECK.html acl2-6.3/doc/HTML/TYPESPEC-CHECK.html
--- acl2-6.2/doc/HTML/TYPESPEC-CHECK.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/TYPESPEC-CHECK.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>TYPESPEC-CHECK.html  --  ACL2 Version 6.2</title></head>
+<head><title>TYPESPEC-CHECK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>TYPESPEC-CHECK</h2>See <a href="META-EXTRACT.html">meta-extract</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/The_Admission_of_App.html acl2-6.3/doc/HTML/The_Admission_of_App.html
--- acl2-6.2/doc/HTML/The_Admission_of_App.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Admission_of_App.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Admission_of_App.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Admission_of_App.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Admission of App</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Associativity_of_App.html acl2-6.3/doc/HTML/The_Associativity_of_App.html
--- acl2-6.2/doc/HTML/The_Associativity_of_App.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Associativity_of_App.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Associativity_of_App.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Associativity_of_App.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Associativity of App</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Base_Case_in_the_App_Example.html acl2-6.3/doc/HTML/The_Base_Case_in_the_App_Example.html
--- acl2-6.2/doc/HTML/The_Base_Case_in_the_App_Example.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Base_Case_in_the_App_Example.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Base_Case_in_the_App_Example.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Base_Case_in_the_App_Example.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Base Case in the App Example</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_End_of_the_Flying_Tour.html acl2-6.3/doc/HTML/The_End_of_the_Flying_Tour.html
--- acl2-6.2/doc/HTML/The_End_of_the_Flying_Tour.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_End_of_the_Flying_Tour.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_End_of_the_Flying_Tour.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_End_of_the_Flying_Tour.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The End of the Flying Tour</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_End_of_the_Proof_of_the_Associativity_of_App.html acl2-6.3/doc/HTML/The_End_of_the_Proof_of_the_Associativity_of_App.html
--- acl2-6.2/doc/HTML/The_End_of_the_Proof_of_the_Associativity_of_App.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_End_of_the_Proof_of_the_Associativity_of_App.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_End_of_the_Proof_of_the_Associativity_of_App.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_End_of_the_Proof_of_the_Associativity_of_App.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The End of the Proof of the Associativity of App</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_End_of_the_Walking_Tour.html acl2-6.3/doc/HTML/The_End_of_the_Walking_Tour.html
--- acl2-6.2/doc/HTML/The_End_of_the_Walking_Tour.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_End_of_the_Walking_Tour.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_End_of_the_Walking_Tour.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_End_of_the_Walking_Tour.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The End of the Walking Tour</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Event_Summary.html acl2-6.3/doc/HTML/The_Event_Summary.html
--- acl2-6.2/doc/HTML/The_Event_Summary.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Event_Summary.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Event_Summary.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Event_Summary.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Event Summary</h2>
 <p></p>
@@ -27,9 +27,9 @@
 pre-processing and database updates.  Despite the fact that ACL2 is an
 applicative language it is possible to measure time with ACL2 programs.  The
 <code><a href="STATE.html">state</a></code> <a href="A_Tiny_Warning_Sign.html"><img src=twarning.gif></a> contains a clock.  The times are printed in decimal
-notation but are actually counted in integral units.  Note that each time is
-a runtime, also known as a cpu time, as opposed to being a real time, also
-known as a wall clock time.</p><p>The final <code>APP</code> is the value of the <code>defun</code> command and was printed by
+notation but are actually counted in integral units.  Note that by default,
+each time is a runtime, also known as a cpu time, as opposed to being a real
+time, also known as a wall clock time.</p><p>The final <code>APP</code> is the value of the <code>defun</code> command and was printed by
 the read-eval-print loop.  The fact that it is indented one space is a subtle
 reminder that the command actually returned an ``error triple'', consisting
 of a flag indicating (in this case) that no error occurred, a value (in this
diff -Nru acl2-6.2/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_0_rparen_.html acl2-6.3/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_0_rparen_.html
--- acl2-6.2/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_0_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_0_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_0_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_0_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Expansion of ENDP in the Induction Step (Step 0)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_1_rparen_.html acl2-6.3/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_1_rparen_.html
--- acl2-6.2/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_1_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_1_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_1_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_1_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Expansion of ENDP in the Induction Step (Step 1)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_2_rparen_.html acl2-6.3/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_2_rparen_.html
--- acl2-6.2/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_2_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_2_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_2_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Expansion_of_ENDP_in_the_Induction_Step__lparen_Step_2_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Expansion of ENDP in the Induction Step (Step 2)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Falling_Body_Model.html acl2-6.3/doc/HTML/The_Falling_Body_Model.html
--- acl2-6.2/doc/HTML/The_Falling_Body_Model.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Falling_Body_Model.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Falling_Body_Model.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Falling_Body_Model.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Falling Body Model</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_0_rparen_.html acl2-6.3/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_0_rparen_.html
--- acl2-6.2/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_0_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_0_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Final_Simplification_in_the_Base_Case__lparen_Step_0_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Final_Simplification_in_the_Base_Case__lparen_Step_0_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Final Simplification in the Base Case (Step 0)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_1_rparen_.html acl2-6.3/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_1_rparen_.html
--- acl2-6.2/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_1_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_1_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Final_Simplification_in_the_Base_Case__lparen_Step_1_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Final_Simplification_in_the_Base_Case__lparen_Step_1_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Final Simplification in the Base Case (Step 1)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_2_rparen_.html acl2-6.3/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_2_rparen_.html
--- acl2-6.2/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_2_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_2_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Final_Simplification_in_the_Base_Case__lparen_Step_2_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Final_Simplification_in_the_Base_Case__lparen_Step_2_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Final Simplification in the Base Case (Step 2)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_3_rparen_.html acl2-6.3/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_3_rparen_.html
--- acl2-6.2/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_3_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Final_Simplification_in_the_Base_Case__lparen_Step_3_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Final_Simplification_in_the_Base_Case__lparen_Step_3_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Final_Simplification_in_the_Base_Case__lparen_Step_3_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Final Simplification in the Base Case (Step 3)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_First_Application_of_the_Associativity_Rule.html acl2-6.3/doc/HTML/The_First_Application_of_the_Associativity_Rule.html
--- acl2-6.2/doc/HTML/The_First_Application_of_the_Associativity_Rule.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_First_Application_of_the_Associativity_Rule.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_First_Application_of_the_Associativity_Rule.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_First_Application_of_the_Associativity_Rule.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The First Application of the Associativity Rule</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Induction_Scheme_Selected_for_the_App_Example.html acl2-6.3/doc/HTML/The_Induction_Scheme_Selected_for_the_App_Example.html
--- acl2-6.2/doc/HTML/The_Induction_Scheme_Selected_for_the_App_Example.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Induction_Scheme_Selected_for_the_App_Example.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Induction_Scheme_Selected_for_the_App_Example.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Induction_Scheme_Selected_for_the_App_Example.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Induction Scheme Selected for the App Example</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Induction_Step_in_the_App_Example.html acl2-6.3/doc/HTML/The_Induction_Step_in_the_App_Example.html
--- acl2-6.2/doc/HTML/The_Induction_Step_in_the_App_Example.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Induction_Step_in_the_App_Example.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Induction_Step_in_the_App_Example.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Induction_Step_in_the_App_Example.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Induction Step in the App Example</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Instantiation_of_the_Induction_Scheme.html acl2-6.3/doc/HTML/The_Instantiation_of_the_Induction_Scheme.html
--- acl2-6.2/doc/HTML/The_Instantiation_of_the_Induction_Scheme.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Instantiation_of_the_Induction_Scheme.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Instantiation_of_the_Induction_Scheme.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Instantiation_of_the_Induction_Scheme.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Instantiation of the Induction Scheme</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Justification_of_the_Induction_Scheme.html acl2-6.3/doc/HTML/The_Justification_of_the_Induction_Scheme.html
--- acl2-6.2/doc/HTML/The_Justification_of_the_Induction_Scheme.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Justification_of_the_Induction_Scheme.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Justification_of_the_Induction_Scheme.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Justification_of_the_Induction_Scheme.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Justification of the Induction Scheme</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Proof_of_the_Associativity_of_App.html acl2-6.3/doc/HTML/The_Proof_of_the_Associativity_of_App.html
--- acl2-6.2/doc/HTML/The_Proof_of_the_Associativity_of_App.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Proof_of_the_Associativity_of_App.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Proof_of_the_Associativity_of_App.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Proof_of_the_Associativity_of_App.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Proof of the Associativity of App</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Q.E.D._Message.html acl2-6.3/doc/HTML/The_Q.E.D._Message.html
--- acl2-6.2/doc/HTML/The_Q.E.D._Message.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Q.E.D._Message.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Q.E.D._Message.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Q.E.D._Message.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Q.E.D. Message</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Rules_used_in_the_Associativity_of_App_Proof.html acl2-6.3/doc/HTML/The_Rules_used_in_the_Associativity_of_App_Proof.html
--- acl2-6.2/doc/HTML/The_Rules_used_in_the_Associativity_of_App_Proof.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Rules_used_in_the_Associativity_of_App_Proof.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Rules_used_in_the_Associativity_of_App_Proof.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Rules_used_in_the_Associativity_of_App_Proof.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Rules used in the Associativity of App Proof</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_0_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_0_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_0_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_0_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_0_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_0_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 0)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_10_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_10_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_10_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_10_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_10_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_10_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 10)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_11_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_11_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_11_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_11_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_11_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_11_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 11)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_12_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_12_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_12_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_12_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_12_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_12_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 12)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_1_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_1_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_1_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_1_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_1_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_1_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 1)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_2_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_2_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_2_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_2_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_2_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_2_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 2)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_3_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_3_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_3_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_3_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_3_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_3_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 3)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_4_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_4_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_4_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_4_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_4_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_4_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 4)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_5_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_5_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_5_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_5_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_5_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_5_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 5)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_6_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_6_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_6_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_6_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_6_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_6_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 6)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_7_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_7_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_7_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_7_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_7_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_7_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 7)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_8_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_8_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_8_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_8_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_8_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_8_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 8)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_9_rparen_.html acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_9_rparen_.html
--- acl2-6.2/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_9_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Simplification_of_the_Induction_Conclusion__lparen_Step_9_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_9_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Simplification_of_the_Induction_Conclusion__lparen_Step_9_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>the Simplification of the Induction Conclusion (Step 9)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Summary_of_the_Proof_of_the_Trivial_Consequence.html acl2-6.3/doc/HTML/The_Summary_of_the_Proof_of_the_Trivial_Consequence.html
--- acl2-6.2/doc/HTML/The_Summary_of_the_Proof_of_the_Trivial_Consequence.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Summary_of_the_Proof_of_the_Trivial_Consequence.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Summary_of_the_Proof_of_the_Trivial_Consequence.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Summary_of_the_Proof_of_the_Trivial_Consequence.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Summary of the Proof of the Trivial Consequence</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Theorem_that_App_is_Associative.html acl2-6.3/doc/HTML/The_Theorem_that_App_is_Associative.html
--- acl2-6.2/doc/HTML/The_Theorem_that_App_is_Associative.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Theorem_that_App_is_Associative.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Theorem_that_App_is_Associative.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Theorem_that_App_is_Associative.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Theorem that App is Associative</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Time_Taken_to_do_the_Associativity_of_App_Proof.html acl2-6.3/doc/HTML/The_Time_Taken_to_do_the_Associativity_of_App_Proof.html
--- acl2-6.2/doc/HTML/The_Time_Taken_to_do_the_Associativity_of_App_Proof.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Time_Taken_to_do_the_Associativity_of_App_Proof.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Time_Taken_to_do_the_Associativity_of_App_Proof.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Time_Taken_to_do_the_Associativity_of_App_Proof.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Time Taken to do the Associativity of App Proof</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_Tours.html acl2-6.3/doc/HTML/The_Tours.html
--- acl2-6.2/doc/HTML/The_Tours.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_Tours.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_Tours.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_Tours.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The Tours</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/The_WARNING_about_the_Trivial_Consequence.html acl2-6.3/doc/HTML/The_WARNING_about_the_Trivial_Consequence.html
--- acl2-6.2/doc/HTML/The_WARNING_about_the_Trivial_Consequence.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/The_WARNING_about_the_Trivial_Consequence.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>The_WARNING_about_the_Trivial_Consequence.html  --  ACL2 Version 6.2</title></head>
+<head><title>The_WARNING_about_the_Trivial_Consequence.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>The WARNING about the Trivial Consequence</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/U.html acl2-6.3/doc/HTML/U.html
--- acl2-6.2/doc/HTML/U.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/U.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>U.html  --  ACL2 Version 6.2</title></head>
+<head><title>U.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>U</h2>undo last <a href="COMMAND.html">command</a>, without a query
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/UBT-PREHISTORY.html acl2-6.3/doc/HTML/UBT-PREHISTORY.html
--- acl2-6.2/doc/HTML/UBT-PREHISTORY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/UBT-PREHISTORY.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UBT-PREHISTORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>UBT-PREHISTORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UBT-PREHISTORY</h2>undo the <a href="COMMAND.html">command</a>s back through the last <code><a href="RESET-PREHISTORY.html">reset-prehistory</a></code> event
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/UBT.html acl2-6.3/doc/HTML/UBT.html
--- acl2-6.2/doc/HTML/UBT.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/UBT.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UBT.html  --  ACL2 Version 6.2</title></head>
+<head><title>UBT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UBT</h2>undo the <a href="COMMAND.html">command</a>s back through a <a href="COMMAND.html">command</a> descriptor
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/UBT_bang_.html acl2-6.3/doc/HTML/UBT_bang_.html
--- acl2-6.2/doc/HTML/UBT_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/UBT_bang_.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UBT_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>UBT_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UBT!</h2>undo <a href="COMMAND.html">command</a>s, without a query or an error
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/UBU.html acl2-6.3/doc/HTML/UBU.html
--- acl2-6.2/doc/HTML/UBU.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/UBU.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UBU.html  --  ACL2 Version 6.2</title></head>
+<head><title>UBU.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UBU</h2>undo the <a href="COMMAND.html">command</a>s back up to (not including) a <a href="COMMAND.html">command</a> descriptor
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/UBU_bang_.html acl2-6.3/doc/HTML/UBU_bang_.html
--- acl2-6.2/doc/HTML/UBU_bang_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/UBU_bang_.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UBU_bang_.html  --  ACL2 Version 6.2</title></head>
+<head><title>UBU_bang_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UBU!</h2>undo <a href="COMMAND.html">command</a>s, without a query or an error
 <pre>Major Section:  <a href="HISTORY.html">HISTORY</a>
diff -Nru acl2-6.2/doc/HTML/UNARY--.html acl2-6.3/doc/HTML/UNARY--.html
--- acl2-6.2/doc/HTML/UNARY--.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/UNARY--.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNARY--.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNARY--.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UNARY--</h3>arithmetic negation function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/UNARY-_slash_.html acl2-6.3/doc/HTML/UNARY-_slash_.html
--- acl2-6.2/doc/HTML/UNARY-_slash_.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/UNARY-_slash_.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNARY-_slash_.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNARY-_slash_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UNARY-/</h3>reciprocal function
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/UNCERTIFIED-BOOKS.html acl2-6.3/doc/HTML/UNCERTIFIED-BOOKS.html
--- acl2-6.2/doc/HTML/UNCERTIFIED-BOOKS.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/UNCERTIFIED-BOOKS.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNCERTIFIED-BOOKS.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNCERTIFIED-BOOKS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNCERTIFIED-BOOKS</h2>invalid <a href="CERTIFICATE.html">certificate</a>s and uncertified <a href="BOOKS.html">books</a>
 <pre>Major Section:  <a href="BOOKS.html">BOOKS</a>
diff -Nru acl2-6.2/doc/HTML/UNION$.html acl2-6.3/doc/HTML/UNION$.html
--- acl2-6.2/doc/HTML/UNION$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/UNION$.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNION$.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNION$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UNION$</h3>elements of one list that are not elements of another
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/UNION-EQ.html acl2-6.3/doc/HTML/UNION-EQ.html
--- acl2-6.2/doc/HTML/UNION-EQ.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/UNION-EQ.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNION-EQ.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNION-EQ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UNION-EQ</h3>See <a href="UNION$.html">union$</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/UNION-EQUAL.html acl2-6.3/doc/HTML/UNION-EQUAL.html
--- acl2-6.2/doc/HTML/UNION-EQUAL.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/UNION-EQUAL.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNION-EQUAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNION-EQUAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UNION-EQUAL</h3>See <a href="UNION$.html">union$</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/UNION-THEORIES.html acl2-6.3/doc/HTML/UNION-THEORIES.html
--- acl2-6.2/doc/HTML/UNION-THEORIES.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/UNION-THEORIES.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNION-THEORIES.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNION-THEORIES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNION-THEORIES</h2>union two <a href="THEORIES.html">theories</a>
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/UNIVERSAL-THEORY.html acl2-6.3/doc/HTML/UNIVERSAL-THEORY.html
--- acl2-6.2/doc/HTML/UNIVERSAL-THEORY.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/UNIVERSAL-THEORY.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNIVERSAL-THEORY.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNIVERSAL-THEORY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNIVERSAL-THEORY</h2>all rules as of logical name
 <pre>Major Section:  <a href="THEORIES.html">THEORIES</a>
diff -Nru acl2-6.2/doc/HTML/UNMEMOIZE.html acl2-6.3/doc/HTML/UNMEMOIZE.html
--- acl2-6.2/doc/HTML/UNMEMOIZE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/UNMEMOIZE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNMEMOIZE.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNMEMOIZE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNMEMOIZE</h2>turn off memoization for the specified function
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/UNMONITOR.html acl2-6.3/doc/HTML/UNMONITOR.html
--- acl2-6.2/doc/HTML/UNMONITOR.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/UNMONITOR.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNMONITOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNMONITOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNMONITOR</h2>to stop monitoring a rule name
 <pre>Major Section:  <a href="BREAK-REWRITE.html">BREAK-REWRITE</a>
diff -Nru acl2-6.2/doc/HTML/UNSAVE.html acl2-6.3/doc/HTML/UNSAVE.html
--- acl2-6.2/doc/HTML/UNSAVE.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/UNSAVE.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNSAVE.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNSAVE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNSAVE</h2>remove a <a href="PROOF-CHECKER.html">proof-checker</a> state
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/UNSIGNED-BYTE-P.html acl2-6.3/doc/HTML/UNSIGNED-BYTE-P.html
--- acl2-6.2/doc/HTML/UNSIGNED-BYTE-P.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/UNSIGNED-BYTE-P.html	2013-09-30 17:39:33.000000000 +0000
@@ -0,0 +1,17 @@
+<html>
+<head><title>UNSIGNED-BYTE-P.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h3>UNSIGNED-BYTE-P</h3>recognizer for natural numbers that fit in a specified bit width
+<pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
+</pre><p/>
+<p>
+<code>(Unsigned-byte-p bits x)</code> is <code>T</code> when <code>bits</code> is a positive integer and
+<code>x</code> is a nonnegative integer that fits into a bit-width of <code>bits</code>, i.e.,
+<code>0 &lt;= x &lt; 2^bits</code>.
+</p>
+<p>Note that a <a href="TYPE-SPEC.html">type-spec</a> of <code>(unsigned-byte i)</code> for a variable <code>x</code> in a
+function's <code><a href="DECLARE.html">declare</a></code> form translates to a <a href="GUARD.html">guard</a> condition of
+<code>(unsigned-byte-p i x)</code>.</p><p>The <a href="GUARD.html">guard</a> for <code>unsigned-byte-p</code> is <code>T</code>.</p><p>To see the ACL2 definition of this function, see <a href="PF.html">pf</a>.
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/UNSUPPORTED-PARALLELISM-FEATURES.html acl2-6.3/doc/HTML/UNSUPPORTED-PARALLELISM-FEATURES.html
--- acl2-6.2/doc/HTML/UNSUPPORTED-PARALLELISM-FEATURES.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/UNSUPPORTED-PARALLELISM-FEATURES.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNSUPPORTED-PARALLELISM-FEATURES.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNSUPPORTED-PARALLELISM-FEATURES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNSUPPORTED-PARALLELISM-FEATURES</h2>ACL2 features not supported in ACL2(p)
 <pre>Major Section:  <a href="PARALLELISM.html">PARALLELISM</a>
diff -Nru acl2-6.2/doc/HTML/UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES.html acl2-6.3/doc/HTML/UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES.html
--- acl2-6.2/doc/HTML/UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UNSUPPORTED-WATERFALL-PARALLELISM-FEATURES</h3>proof features not supported with waterfall-parallelism enabled
 <pre>Major Section:  <a href="PARALLEL-PROOF.html">PARALLEL-PROOF</a>
diff -Nru acl2-6.2/doc/HTML/UNTRACE$.html acl2-6.3/doc/HTML/UNTRACE$.html
--- acl2-6.2/doc/HTML/UNTRACE$.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/UNTRACE$.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNTRACE$.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNTRACE$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNTRACE$</h2>untrace functions
 <pre>Major Section:  <a href="TRACE.html">TRACE</a>
diff -Nru acl2-6.2/doc/HTML/UNTRANS-TABLE.html acl2-6.3/doc/HTML/UNTRANS-TABLE.html
--- acl2-6.2/doc/HTML/UNTRANS-TABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/UNTRANS-TABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNTRANS-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNTRANS-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>UNTRANS-TABLE</h2>associates a function symbol with a macro for printing user-level terms
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/UNTRANSLATE.html acl2-6.3/doc/HTML/UNTRANSLATE.html
--- acl2-6.2/doc/HTML/UNTRANSLATE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/UNTRANSLATE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UNTRANSLATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>UNTRANSLATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UNTRANSLATE</h3>See <a href="USER-DEFINED-FUNCTIONS-TABLE.html">user-defined-functions-table</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/UPDATE-NTH.html acl2-6.3/doc/HTML/UPDATE-NTH.html
--- acl2-6.2/doc/HTML/UPDATE-NTH.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/UPDATE-NTH.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UPDATE-NTH.html  --  ACL2 Version 6.2</title></head>
+<head><title>UPDATE-NTH.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UPDATE-NTH</h3>modify a list by putting the given value at the given position
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/UPPER-CASE-P.html acl2-6.3/doc/HTML/UPPER-CASE-P.html
--- acl2-6.2/doc/HTML/UPPER-CASE-P.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/UPPER-CASE-P.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>UPPER-CASE-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>UPPER-CASE-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>UPPER-CASE-P</h3>recognizer for upper case characters
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/USE.html acl2-6.3/doc/HTML/USE.html
--- acl2-6.2/doc/HTML/USE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USE.html  --  ACL2 Version 6.2</title></head>
+<head><title>USE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USE</h2>hints keyword <code>:USE</code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USER-DEFINED-FUNCTIONS-TABLE.html acl2-6.3/doc/HTML/USER-DEFINED-FUNCTIONS-TABLE.html
--- acl2-6.2/doc/HTML/USER-DEFINED-FUNCTIONS-TABLE.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/USER-DEFINED-FUNCTIONS-TABLE.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USER-DEFINED-FUNCTIONS-TABLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>USER-DEFINED-FUNCTIONS-TABLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USER-DEFINED-FUNCTIONS-TABLE</h2>an advanced <a href="TABLE.html">table</a> used to replace certain system functions
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-1.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-1.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-1.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-1.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS-1.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS-1.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS-1</h2>Driving Home the Basics
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-2.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-2.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-2.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-2.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS-2.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS-2.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS-2</h2>One Hint to Every Top-Level Goal in a Forcing Round
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-3.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-3.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-3.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-3.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS-3.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS-3.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS-3</h2>Hints as a Function of the Goal (not its Name)
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-4.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-4.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-4.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-4.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS-4.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS-4.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS-4</h2>Computing the Hints
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-5.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-5.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-5.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-5.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS-5.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS-5.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS-5</h2>Debugging Computed Hints
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-6.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-6.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-6.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-6.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS-6.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS-6.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS-6</h2>Using the computed-hint-replacement feature
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-7.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-7.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-7.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-7.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS-7.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS-7.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS-7</h2>Using the <code>stable-under-simplificationp</code> flag
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-8.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-8.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS-8.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS-8.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS-8.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS-8.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS-8</h2>Some Final Comments
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-COMPUTED-HINTS.html acl2-6.3/doc/HTML/USING-COMPUTED-HINTS.html
--- acl2-6.2/doc/HTML/USING-COMPUTED-HINTS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-COMPUTED-HINTS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-COMPUTED-HINTS.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-COMPUTED-HINTS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-COMPUTED-HINTS</h2>how to use computed hints
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-ENABLED-RULES.html acl2-6.3/doc/HTML/USING-ENABLED-RULES.html
--- acl2-6.2/doc/HTML/USING-ENABLED-RULES.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-ENABLED-RULES.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-ENABLED-RULES.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-ENABLED-RULES.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>USING-ENABLED-RULES</h2>avoiding <code>:use</code> <a href="HINTS.html">hints</a> for <a href="ENABLE.html">enable</a>d <code>:</code><code><a href="REWRITE.html">rewrite</a></code> rules
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/USING-TABLES-EFFICIENTLY.html acl2-6.3/doc/HTML/USING-TABLES-EFFICIENTLY.html
--- acl2-6.2/doc/HTML/USING-TABLES-EFFICIENTLY.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/USING-TABLES-EFFICIENTLY.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>USING-TABLES-EFFICIENTLY.html  --  ACL2 Version 6.2</title></head>
+<head><title>USING-TABLES-EFFICIENTLY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>USING-TABLES-EFFICIENTLY</h3>Notes on how to use tables efficiently
 <pre>Major Section:  <a href="TABLE.html">TABLE</a>
diff -Nru acl2-6.2/doc/HTML/Undocumented_Topic.html acl2-6.3/doc/HTML/Undocumented_Topic.html
--- acl2-6.2/doc/HTML/Undocumented_Topic.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/Undocumented_Topic.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Undocumented_Topic.html  --  ACL2 Version 6.2</title></head>
+<head><title>Undocumented_Topic.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Undocumented Topic</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/Using_the_Associativity_of_App_to_Prove_a_Trivial_Consequence.html acl2-6.3/doc/HTML/Using_the_Associativity_of_App_to_Prove_a_Trivial_Consequence.html
--- acl2-6.2/doc/HTML/Using_the_Associativity_of_App_to_Prove_a_Trivial_Consequence.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/Using_the_Associativity_of_App_to_Prove_a_Trivial_Consequence.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>Using_the_Associativity_of_App_to_Prove_a_Trivial_Consequence.html  --  ACL2 Version 6.2</title></head>
+<head><title>Using_the_Associativity_of_App_to_Prove_a_Trivial_Consequence.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>Using the Associativity of App to Prove a Trivial Consequence</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/VALUE-TRIPLE.html acl2-6.3/doc/HTML/VALUE-TRIPLE.html
--- acl2-6.2/doc/HTML/VALUE-TRIPLE.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/VALUE-TRIPLE.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>VALUE-TRIPLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>VALUE-TRIPLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>VALUE-TRIPLE</h2>compute a value, optionally checking that it is not <code>nil</code>
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/VERBOSE-PSTACK.html acl2-6.3/doc/HTML/VERBOSE-PSTACK.html
--- acl2-6.2/doc/HTML/VERBOSE-PSTACK.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/VERBOSE-PSTACK.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>VERBOSE-PSTACK.html  --  ACL2 Version 6.2</title></head>
+<head><title>VERBOSE-PSTACK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>VERBOSE-PSTACK</h3>seeing what the prover is up to (for advanced users)
 <pre>Major Section:  <a href="PSTACK.html">PSTACK</a>
diff -Nru acl2-6.2/doc/HTML/VERIFY-GUARDS+.html acl2-6.3/doc/HTML/VERIFY-GUARDS+.html
--- acl2-6.2/doc/HTML/VERIFY-GUARDS+.html	1970-01-01 00:00:00.000000000 +0000
+++ acl2-6.3/doc/HTML/VERIFY-GUARDS+.html	2013-09-30 17:39:27.000000000 +0000
@@ -0,0 +1,56 @@
+<html>
+<head><title>VERIFY-GUARDS+.html  --  ACL2 Version 6.3</title></head>
+<body text=#000000 bgcolor="#FFFFFF">
+<h2>VERIFY-GUARDS+</h2>verify the <a href="GUARD.html">guard</a>s of a function
+<pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
+</pre><p/>
+<p>
+We assume familiarity with <a href="GUARD.html">guard</a> verification; see <a href="VERIFY-GUARDS.html">verify-guards</a>.
+Unlike <code>verify-guards</code>, the macro call <code>(verify-guards+ mac ...)</code> will
+verify guards for a function, <code>fn</code>, such that the macro <code>mac</code> is
+associated with the function symbol <code>fn</code> in <code><a href="MACRO-ALIASES-TABLE.html">macro-aliases-table</a></code>
+(also see <a href="ADD-MACRO-ALIAS.html">add-macro-alias</a>).  For example, if you define a macro <code>app</code> and
+list append function <code>binary-app</code>, and you associate macro <code>app</code> with
+function symbol <code>binary-app</code> in <code><a href="MACRO-ALIASES-TABLE.html">macro-aliases-table</a></code>, then evaluation
+of the form <code>(verify-guard+ app)</code> will have the effect of evaluating
+<code>(verify-guards fn)</code>.  Note that in this setting, evaluation of
+<code>(verify-guard app)</code> would cause an error, because <code>app</code> is a macro and
+<code>verify-guards</code>, unlike <code>verify-guards+</code>, cannot handle macros.
+</p>
+<p>The rest of this <a href="DOCUMENTATION.html">documentation</a> topic discusses why we do not simply
+arrange that <code>verify-guards</code> be permitted to take a macro alias.  The
+following example shows a soundness issue in doing so.
+
+<pre>
+(encapsulate
+ ()
+ (defun f1 (x)
+   (declare (xargs :guard (consp x)
+                   :verify-guards nil))
+   (car x))
+ (defun f2 (x)
+   (declare (xargs :guard t
+                   :verify-guards nil))
+   (cdr x))
+ (defmacro mac (x)
+   x)
+ (add-macro-alias mac f2) ; silly macro alias ;
+ (local (add-macro-alias mac f1)) ; alternate silly macro alias ;
+ (verify-guards mac))
+</pre>
+</p><p>If we were to allow macro aliases in <code><a href="VERIFY-GUARDS.html">verify-guards</a></code>, this event would be
+admitted, because on the first pass we are verifying guards of <code>f1</code>.  But
+after the <code><a href="ENCAPSULATE.html">encapsulate</a></code> form completes evaluation, it would appear that
+<code>f2</code> is guard-verified.  That could of course cause a raw Lisp error.</p><p>The enhanced functionality provided by <code>verify-guards+</code> does not have the
+above problem, because it takes advantage of <code><a href="MAKE-EVENT.html">make-event</a></code> to avoid taking
+advantage of the contradictory results produced by the two calls of
+<code>add-macro-alias</code>.  See <a href="MAKE-EVENT.html">make-event</a>.  If the specific example above is
+modified by replacing <code>verify-guards</code> with <code>verify-guards+</code>, then the
+first pass through the <code><a href="ENCAPSULATE.html">encapsulate</a></code> form will expand the form
+<code>(verify-guards+ mac)</code> to <code>(verify-guards f1)</code>.  That same expansion will
+be used for the <code>verify-guards+</code> call during the second pass through the
+<code>encapsulate</code> form, which is evaluated successfully and leaves us in a
+<a href="WORLD.html">world</a> where <code>f1</code> is guard-verified and <code>f2</code> is not.
+</p><br><br><br><a href="acl2-doc.html"><img src="acl2-logo-62-41.gif"></a> <a href="acl2-doc-index.html"><img src="index.gif"></a>
+</body>
+</html>
diff -Nru acl2-6.2/doc/HTML/VERIFY-GUARDS-EAGERNESS.html acl2-6.3/doc/HTML/VERIFY-GUARDS-EAGERNESS.html
--- acl2-6.2/doc/HTML/VERIFY-GUARDS-EAGERNESS.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/VERIFY-GUARDS-EAGERNESS.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>VERIFY-GUARDS-EAGERNESS.html  --  ACL2 Version 6.2</title></head>
+<head><title>VERIFY-GUARDS-EAGERNESS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>VERIFY-GUARDS-EAGERNESS</h2>See <a href="SET-VERIFY-GUARDS-EAGERNESS.html">set-verify-guards-eagerness</a>.
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/VERIFY-GUARDS-FORMULA.html acl2-6.3/doc/HTML/VERIFY-GUARDS-FORMULA.html
--- acl2-6.2/doc/HTML/VERIFY-GUARDS-FORMULA.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/VERIFY-GUARDS-FORMULA.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>VERIFY-GUARDS-FORMULA.html  --  ACL2 Version 6.2</title></head>
+<head><title>VERIFY-GUARDS-FORMULA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>VERIFY-GUARDS-FORMULA</h2>view the guard proof obligation, without proving it
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/VERIFY-GUARDS.html acl2-6.3/doc/HTML/VERIFY-GUARDS.html
--- acl2-6.2/doc/HTML/VERIFY-GUARDS.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/VERIFY-GUARDS.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>VERIFY-GUARDS.html  --  ACL2 Version 6.2</title></head>
+<head><title>VERIFY-GUARDS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>VERIFY-GUARDS</h2>verify the <a href="GUARD.html">guard</a>s of a function
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
@@ -12,7 +12,10 @@
 <code>:verify-guards nil</code> has been specified; see <a href="DEFUN.html">defun</a> and see <a href="XARGS.html">xargs</a>, and
 see <a href="SET-VERIFY-GUARDS-EAGERNESS.html">set-verify-guards-eagerness</a> for how to change this default.  The point
 of guard verification is to ensure that during evaluation of an expression
-without free variables, no guard violation takes place.</p><p>Guard verification is intended to guarantee that for any call of a given
+without free variables, no guard violation takes place.</p><p>Technical note: the first argument of <code>verify-guards</code> must be a function
+symbol or the name of a <code><a href="DEFTHM.html">defthm</a></code> or <code><a href="DEFAXIOM.html">defaxiom</a></code> event, not a
+macro-alias for a function symbol (see <a href="MACRO-ALIASES-TABLE.html">macro-aliases-table</a>).
+See <a href="VERIFY-GUARDS+.html">verify-guards+</a> for a utility that does not have this restriction.</p><p>Guard verification is intended to guarantee that for any call of a given
 function, if its <a href="GUARD.html">guard</a> holds for that call then the <a href="GUARD.html">guard</a> will hold
 for every function call in the body of that function.  Moreover, in order to
 avoid guard violations during evaluation of the function's guard itself,
diff -Nru acl2-6.2/doc/HTML/VERIFY-TERMINATION.html acl2-6.3/doc/HTML/VERIFY-TERMINATION.html
--- acl2-6.2/doc/HTML/VERIFY-TERMINATION.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/VERIFY-TERMINATION.html	2013-09-30 17:39:27.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>VERIFY-TERMINATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>VERIFY-TERMINATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>VERIFY-TERMINATION</h2>convert a function from :program mode to :logic mode
 <pre>Major Section:  <a href="EVENTS.html">EVENTS</a>
diff -Nru acl2-6.2/doc/HTML/VERIFY.html acl2-6.3/doc/HTML/VERIFY.html
--- acl2-6.2/doc/HTML/VERIFY.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/VERIFY.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>VERIFY.html  --  ACL2 Version 6.2</title></head>
+<head><title>VERIFY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>VERIFY</h2>enter the interactive proof checker
 <pre>Major Section:  <a href="PROOF-CHECKER.html">PROOF-CHECKER</a>
diff -Nru acl2-6.2/doc/HTML/VERSION.html acl2-6.3/doc/HTML/VERSION.html
--- acl2-6.2/doc/HTML/VERSION.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/VERSION.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>VERSION.html  --  ACL2 Version 6.2</title></head>
+<head><title>VERSION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>VERSION</h2>ACL2 Version Number
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WALKABOUT.html acl2-6.3/doc/HTML/WALKABOUT.html
--- acl2-6.2/doc/HTML/WALKABOUT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WALKABOUT.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WALKABOUT.html  --  ACL2 Version 6.2</title></head>
+<head><title>WALKABOUT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WALKABOUT</h2>explore an ACL2 cons tree
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION.html acl2-6.3/doc/HTML/WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION.html
--- acl2-6.2/doc/HTML/WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WATERFALL-PARALLELISM-FOR-BOOK-CERTIFICATION</h2>for ACL2(p): using waterfall parallelism during book certification
 <pre>Major Section:  <a href="PARALLELISM.html">PARALLELISM</a>
diff -Nru acl2-6.2/doc/HTML/WATERFALL-PARALLELISM.html acl2-6.3/doc/HTML/WATERFALL-PARALLELISM.html
--- acl2-6.2/doc/HTML/WATERFALL-PARALLELISM.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/WATERFALL-PARALLELISM.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WATERFALL-PARALLELISM.html  --  ACL2 Version 6.2</title></head>
+<head><title>WATERFALL-PARALLELISM.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>WATERFALL-PARALLELISM</h3>for ACL2(p): configuring the parallel execution of the waterfall
 <pre>Major Section:  <a href="PARALLEL-PROOF.html">PARALLEL-PROOF</a>
diff -Nru acl2-6.2/doc/HTML/WATERFALL-PRINTING.html acl2-6.3/doc/HTML/WATERFALL-PRINTING.html
--- acl2-6.2/doc/HTML/WATERFALL-PRINTING.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/WATERFALL-PRINTING.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WATERFALL-PRINTING.html  --  ACL2 Version 6.2</title></head>
+<head><title>WATERFALL-PRINTING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>WATERFALL-PRINTING</h3>for ACL2(p): configuring the printing within the parallelized waterfall
 <pre>Major Section:  <a href="PARALLEL-PROOF.html">PARALLEL-PROOF</a>
diff -Nru acl2-6.2/doc/HTML/WATERFALL.html acl2-6.3/doc/HTML/WATERFALL.html
--- acl2-6.2/doc/HTML/WATERFALL.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WATERFALL.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WATERFALL.html  --  ACL2 Version 6.2</title></head>
+<head><title>WATERFALL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WATERFALL</h2>See <a href="HINTS-AND-THE-WATERFALL.html">hints-and-the-waterfall</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WELL-FOUNDED-RELATION.html acl2-6.3/doc/HTML/WELL-FOUNDED-RELATION.html
--- acl2-6.2/doc/HTML/WELL-FOUNDED-RELATION.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/WELL-FOUNDED-RELATION.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,27 +1,28 @@
 <html>
-<head><title>WELL-FOUNDED-RELATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>WELL-FOUNDED-RELATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WELL-FOUNDED-RELATION</h2>show that a relation is well-founded on a set
 <pre>Major Section:  <a href="RULE-CLASSES.html">RULE-CLASSES</a>
 </pre><p/>
 <p>
-See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes and
-how they are used to build rules from formulas.  An example
-<code>:</code><code><a href="COROLLARY.html">corollary</a></code> formula from which a <code>:well-founded-relation</code> rule might be
-built is as follows.  (Of course, the functions <code>pairp</code>, <code>lex2p</code>, and
-<code>ordinate</code> would have to be defined first.)
-
+See <a href="RULE-CLASSES.html">rule-classes</a> for a general discussion of rule classes, including how they
+are used to build rules from formulas and a discussion of the various
+keywords in a rule class description.</p><p>
 <pre>
 Example:
-(and (implies (pairp x) (o-p (ordinate x)))
-     (implies (and (pairp x)
-                   (pairp y)
-                   (lex2p x y))
-              (o&lt; (ordinate x) (ordinate y))))
+(defthm lex2p-is-well-founded-relation
+  (and (implies (pairp x) (o-p (ordinate x)))
+       (implies (and (pairp x)
+                     (pairp y)
+                     (lex2p x y))
+                (o&lt; (ordinate x) (ordinate y))))
+  :rule-classes :well-founded-relation)
 </pre>
 
-The above example establishes that <code>lex2p</code> is a well-founded
-relation on <code>pairp</code>s.  We explain and give details below.
+The example above creates a <code>:well-founded-relation</code> rule, where of course
+the functions <code>pairp</code>, <code>lex2p</code>, and <code>ordinate</code> would have to be defined
+first.  It establishes that <code>lex2p</code> is a well-founded relation on
+<code>pairp</code>s.  We explain and give details below.
 </p>
 <p>Exactly two general forms are recognized:
 
diff -Nru acl2-6.2/doc/HTML/WET.html acl2-6.3/doc/HTML/WET.html
--- acl2-6.2/doc/HTML/WET.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/WET.html	2013-09-30 17:39:38.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WET.html  --  ACL2 Version 6.2</title></head>
+<head><title>WET.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WET</h2>evaluate a form and print subsequent error trace
 <pre>Major Section:  <a href="TRACE.html">TRACE</a>
diff -Nru acl2-6.2/doc/HTML/WHY-BRR.html acl2-6.3/doc/HTML/WHY-BRR.html
--- acl2-6.2/doc/HTML/WHY-BRR.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WHY-BRR.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WHY-BRR.html  --  ACL2 Version 6.2</title></head>
+<head><title>WHY-BRR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WHY-BRR</h2>an explanation of why ACL2 has an explicit <code><a href="BRR.html">brr</a></code> mode
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WITH-FAST-ALIST.html acl2-6.3/doc/HTML/WITH-FAST-ALIST.html
--- acl2-6.2/doc/HTML/WITH-FAST-ALIST.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-FAST-ALIST.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-FAST-ALIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-FAST-ALIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-FAST-ALIST</h2><code>(with-fast-alist name form)</code> causes <code>name</code> to be a fast alist for the
 <code>   </code>execution of <code>form</code>.
diff -Nru acl2-6.2/doc/HTML/WITH-GUARD-CHECKING.html acl2-6.3/doc/HTML/WITH-GUARD-CHECKING.html
--- acl2-6.2/doc/HTML/WITH-GUARD-CHECKING.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-GUARD-CHECKING.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-GUARD-CHECKING.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-GUARD-CHECKING.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-GUARD-CHECKING</h2>suppressing or enable guard-checking for a form
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
diff -Nru acl2-6.2/doc/HTML/WITH-LIVE-STATE.html acl2-6.3/doc/HTML/WITH-LIVE-STATE.html
--- acl2-6.2/doc/HTML/WITH-LIVE-STATE.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-LIVE-STATE.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-LIVE-STATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-LIVE-STATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>WITH-LIVE-STATE</h3>allow a reference to <code>state</code> in raw Lisp
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/WITH-LOCAL-STATE.html acl2-6.3/doc/HTML/WITH-LOCAL-STATE.html
--- acl2-6.2/doc/HTML/WITH-LOCAL-STATE.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-LOCAL-STATE.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-LOCAL-STATE.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-LOCAL-STATE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-LOCAL-STATE</h2>locally bind state
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/WITH-LOCAL-STOBJ.html acl2-6.3/doc/HTML/WITH-LOCAL-STOBJ.html
--- acl2-6.2/doc/HTML/WITH-LOCAL-STOBJ.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-LOCAL-STOBJ.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-LOCAL-STOBJ.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-LOCAL-STOBJ.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-LOCAL-STOBJ</h2>locally bind a single-threaded object
 <pre>Major Section:  <a href="STOBJ.html">STOBJ</a>
diff -Nru acl2-6.2/doc/HTML/WITH-OUTPUT-LOCK.html acl2-6.3/doc/HTML/WITH-OUTPUT-LOCK.html
--- acl2-6.2/doc/HTML/WITH-OUTPUT-LOCK.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-OUTPUT-LOCK.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-OUTPUT-LOCK.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-OUTPUT-LOCK.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>WITH-OUTPUT-LOCK</h3>provides a mutual-exclusion mechanism for performing output in parallel
 <pre>Major Section:  <a href="PARALLEL-PROGRAMMING.html">PARALLEL-PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/WITH-OUTPUT.html acl2-6.3/doc/HTML/WITH-OUTPUT.html
--- acl2-6.2/doc/HTML/WITH-OUTPUT.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-OUTPUT.html	2013-09-30 17:39:37.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-OUTPUT.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-OUTPUT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-OUTPUT</h2>suppressing or turning on specified output for an event
 <pre>Major Section:  <a href="SWITCHES-PARAMETERS-AND-MODES.html">SWITCHES-PARAMETERS-AND-MODES</a>
@@ -25,11 +25,11 @@
 ; Same effect as just above:
 (with-output
    :on summary
-   :summary :all ; equivalently, the value (a list) of *summary-types*
+   :summary nil
    :gag-mode :goals
    (defthm app-assoc (equal (app (app x y) z) (app x (app y z)))))
 
-; Same as just above, but turn off only the indicated parts of the summary.
+; Turn on only the indicated parts of the summary.
 (with-output
    :on summary
    :summary (time rules)
@@ -57,31 +57,31 @@
 </pre>
 
 where each <code>:keyi</code> is either <code>:off</code>, <code>:on</code>, <code>:stack</code>,
-<code>:summary</code>, or <code>:gag-mode</code>, and <code>vali</code> is as follows.  If <code>:keyi</code>
-is <code>:off</code> or <code>:on</code>, then <code>vali</code> can be <code>:all</code>, and otherwise is a
-symbol or non-empty list of symbols representing output types that can be
-inhibited; see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a>.  If <code>:keyi</code> is <code>:gag-mode</code>, then
-<code>vali</code> is one of the legal values for <code>:</code><code><a href="SET-GAG-MODE.html">set-gag-mode</a></code>.
-If <code>:keyi</code> is <code>:summary</code>, then <code>vali</code> is either <code>:all</code> or a true-list
-of symbols each of which belongs to the list <code>*summary-types*</code>.  Otherwise
-<code>:keyi</code> is <code>:stack</code>, in which case <code>:vali</code> is <code>:push</code> or <code>:pop</code>;
-for now assume that <code>:stack</code> is not specified (we'll return to it below).
-The result of evaluating the General Form above is to evaluate <code>form</code>, but
-in an environment where output occurs as follows.  If <code>:on :all</code> is
-specified, then every output type is turned on except as inhibited by
-<code>:off</code>; else if <code>:off :all</code> is specified, then every output type is
-inhibited except as specified by <code>:on</code>; and otherwise, the
-currently-inhibited output types are reduced as specified by <code>:on</code> and then
-extended as specified by <code>:off</code>.  But if <code>:gag-mode</code> is specified, then
-before modifying how output is inhibited, <code><a href="GAG-MODE.html">gag-mode</a></code> is set for the
-evaluation of <code>form</code> as specified by the value of <code>:gag-mode</code>;
-see <a href="SET-GAG-MODE.html">set-gag-mode</a>.  If <code>summary</code> is among the output types that are turned
-on (not inhibited), then if <code>:summary</code> is specified, the only parts of the
-summary to be printed will be those specified by the value of <code>:summary</code>.
-The correspondence should be clear, except perhaps that <code>header</code> refers to
-the line containing only the word <code>Summary</code>, and <code>value</code> refers to the
-value of the form printed during evaluation of sequences of events as for
-<code><a href="PROGN.html">progn</a></code> and <code><a href="ENCAPSULATE.html">encapsulate</a></code>.</p><p>Note that the handling of the <code>:stack</code> argument pays no attention to the
+<code>:summary</code>, or <code>:gag-mode</code>; <code>form</code> evaluates to an error triple
+(see <a href="ERROR-TRIPLES.html">error-triples</a>); and <code>vali</code> is as follows.  If <code>:keyi</code> is <code>:off</code>
+or <code>:on</code>, then <code>vali</code> can be <code>:all</code>, and otherwise is a symbol or
+non-empty list of symbols representing output types that can be inhibited;
+see <a href="SET-INHIBIT-OUTPUT-LST.html">set-inhibit-output-lst</a>.  If <code>:keyi</code> is <code>:gag-mode</code>, then <code>vali</code> is
+one of the legal values for <code>:</code><code><a href="SET-GAG-MODE.html">set-gag-mode</a></code>.  If <code>:keyi</code> is
+<code>:summary</code>, then <code>vali</code> is either <code>:all</code> or a true-list of symbols each
+of which belongs to the list <code>*summary-types*</code>.  Otherwise <code>:keyi</code> is
+<code>:stack</code>, in which case <code>:vali</code> is <code>:push</code> or <code>:pop</code>; for now assume
+that <code>:stack</code> is not specified (we'll return to it below).  The result of
+evaluating the General Form above is to evaluate <code>form</code>, but in an
+environment where output occurs as follows.  If <code>:on :all</code> is specified,
+then every output type is turned on except as inhibited by <code>:off</code>; else if
+<code>:off :all</code> is specified, then every output type is inhibited except as
+specified by <code>:on</code>; and otherwise, the currently-inhibited output types are
+reduced as specified by <code>:on</code> and then extended as specified by <code>:off</code>.
+But if <code>:gag-mode</code> is specified, then before modifying how output is
+inhibited, <code><a href="GAG-MODE.html">gag-mode</a></code> is set for the evaluation of <code>form</code> as specified
+by the value of <code>:gag-mode</code>; see <a href="SET-GAG-MODE.html">set-gag-mode</a>.  If <code>summary</code> is among
+the output types that are turned on (not inhibited), then if <code>:summary</code> is
+specified, the only parts of the summary to be printed will be those
+specified by the value of <code>:summary</code>.  The correspondence should be clear,
+except perhaps that <code>header</code> refers to the line containing only the word
+<code>Summary</code>, and <code>value</code> refers to the value of the form printed during
+evaluation of sequences of events as for <code><a href="PROGN.html">progn</a></code> and <code><a href="ENCAPSULATE.html">encapsulate</a></code>.</p><p>Note that the handling of the <code>:stack</code> argument pays no attention to the
 <code>:summary</code> argument.</p><p>Note: When the scope of <code>with-output</code> is exited, then all modifications are
 undone, reverting <code>gag-mode</code> and the state of output inhibition to those
 which were present before the <code>with-output</code> call was entered.</p><p>The <code>:stack</code> keyword's effect is illustrated by the following example,
diff -Nru acl2-6.2/doc/HTML/WITH-PROVER-STEP-LIMIT.html acl2-6.3/doc/HTML/WITH-PROVER-STEP-LIMIT.html
--- acl2-6.2/doc/HTML/WITH-PROVER-STEP-LIMIT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-PROVER-STEP-LIMIT.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-PROVER-STEP-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-PROVER-STEP-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-PROVER-STEP-LIMIT</h2>limit the number of steps for proofs
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
@@ -12,14 +12,17 @@
 limit on prover steps globally instead of setting it for just one form, and
 for a discussion of the notion of ``prover steps'', which could change in
 future ACL2 releases.  For a related utility based on time instead of prover
-steps, see <a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a>.</p><p>The arguments of <code>(with-prover-step-limit expr form)</code> are evaluated.
+steps, see <a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a>; but as discussed in the
+<a href="DOCUMENTATION.html">documentation</a> for <code><a href="SET-PROVER-STEP-LIMIT.html">set-prover-step-limit</a></code>, there is at best a loose
+connection between the counting of steps and <code><a href="WITH-PROVER-TIME-LIMIT.html">with-prover-time-limit</a></code>.</p><p>The arguments of <code>(with-prover-step-limit expr form)</code> are evaluated.
 However, the (optional) argument <code>flg</code> is not evaluated in
 <code>(with-prover-step-limit expr flg form)</code>.</p><p>Depending on the machine you are using, you may have less than a half-hour of
 time before the number of prover steps exceeds the maximum limit on prover
 steps that may be imposed, which is one less than the value of
 <code>*default-step-limit*</code>.  But there is no limit unless you explicitly call
 <code>with-prover-step-limit</code> or <code><a href="SET-PROVER-STEP-LIMIT.html">set-prover-step-limit</a></code>.</p><p>For examples of how step-limits work besides those presented below, see the
-community book <code>books/misc/misc2/step-limits.lisp</code>.</p><p>Note that <code>with-prover-step-limit</code> may not be called inside definitions,
+community book <code>books/misc/misc2/step-limits.lisp</code>.</p><p>For a utility that returns an indicator of the number of prover steps most
+recently taken, see <a href="LAST-PROVER-STEPS.html">last-prover-steps</a>.</p><p>Note that <code>with-prover-step-limit</code> may not be called inside definitions,
 and that it is simply the identity macro in raw Lisp.  However,
 <code>with-prover-step-limit!</code> may be called in place of
 <code>with-prover-step-limit</code>, with the effect described here even in raw Lisp.</p><p>
diff -Nru acl2-6.2/doc/HTML/WITH-PROVER-TIME-LIMIT.html acl2-6.3/doc/HTML/WITH-PROVER-TIME-LIMIT.html
--- acl2-6.2/doc/HTML/WITH-PROVER-TIME-LIMIT.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-PROVER-TIME-LIMIT.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-PROVER-TIME-LIMIT.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-PROVER-TIME-LIMIT.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-PROVER-TIME-LIMIT</h2>limit the time for proofs
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
@@ -34,7 +34,7 @@
 where <code>time</code> evaluates to a positive rational number or to a list
 containing such, and <code>form</code> is arbitrary.  Logically,
 <code>(with-prover-time-limit time form)</code> is equivalent to <code>form</code>.  However,
-if the runtime for evaluation of <code>form</code> exceeds the value specified by
+if the time for evaluation of <code>form</code> exceeds the value specified by
 <code>time</code>, and if ACL2 notices this fact during a proof, then that proof will
 abort, for example like this:
 
@@ -45,7 +45,8 @@
 If there is already a surrounding call of <code>with-prover-time-limit</code> that has
 set up an expiration time, the inner <code>with-prover-time-limit</code> call is not
 allowed to push that time further into the future unless the inner time is
-specified as a list containing a rational, rather than as a rational.</p><p>For a related utility based on prover steps instead of time,
+specified as a list containing a rational, rather than as a rational.</p><p>Note that by default, the time used is runtime (cpu time); to switch to
+realtime (elapsed time), see <a href="GET-INTERNAL-TIME.html">get-internal-time</a>.</p><p>For a related utility based on prover steps instead of time,
 see <a href="WITH-PROVER-STEP-LIMIT.html">with-prover-step-limit</a>; also see <a href="SET-PROVER-STEP-LIMIT.html">set-prover-step-limit</a>.  Those
 utilities have the advantage of having platform-independent behavior, unlike
 time limits, which of course are generally less restrictive for faster
diff -Nru acl2-6.2/doc/HTML/WITH-SERIALIZE-CHARACTER.html acl2-6.3/doc/HTML/WITH-SERIALIZE-CHARACTER.html
--- acl2-6.2/doc/HTML/WITH-SERIALIZE-CHARACTER.html	2013-06-07 04:13:34.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-SERIALIZE-CHARACTER.html	2013-09-30 17:39:36.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-SERIALIZE-CHARACTER.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-SERIALIZE-CHARACTER.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-SERIALIZE-CHARACTER</h2>control output mode for <code>print-object$</code>
 <pre>Major Section:  <a href="SERIALIZE.html">SERIALIZE</a>
diff -Nru acl2-6.2/doc/HTML/WITH-STOLEN-ALIST.html acl2-6.3/doc/HTML/WITH-STOLEN-ALIST.html
--- acl2-6.2/doc/HTML/WITH-STOLEN-ALIST.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/WITH-STOLEN-ALIST.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITH-STOLEN-ALIST.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITH-STOLEN-ALIST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITH-STOLEN-ALIST</h2><code>(with-stolen-alist name form)</code> ensures that <code>name</code> is a fast alist at the
 <code>   </code>start of the execution of <code>form</code>.  At the end of execution, it ensures that
diff -Nru acl2-6.2/doc/HTML/WITHOUT-EVISC.html acl2-6.3/doc/HTML/WITHOUT-EVISC.html
--- acl2-6.2/doc/HTML/WITHOUT-EVISC.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/WITHOUT-EVISC.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WITHOUT-EVISC.html  --  ACL2 Version 6.2</title></head>
+<head><title>WITHOUT-EVISC.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WITHOUT-EVISC</h2>print output in full
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/WOF.html acl2-6.3/doc/HTML/WOF.html
--- acl2-6.2/doc/HTML/WOF.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WOF.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WOF.html  --  ACL2 Version 6.2</title></head>
+<head><title>WOF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WOF</h2>direct standard output and proofs output to a file
 <pre>Major Section:  <a href="OTHER.html">OTHER</a>
diff -Nru acl2-6.2/doc/HTML/WORLD.html acl2-6.3/doc/HTML/WORLD.html
--- acl2-6.2/doc/HTML/WORLD.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WORLD.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WORLD.html  --  ACL2 Version 6.2</title></head>
+<head><title>WORLD.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WORLD</h2>ACL2 property lists and the ACL2 logical database
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WORMHOLE-DATA.html acl2-6.3/doc/HTML/WORMHOLE-DATA.html
--- acl2-6.2/doc/HTML/WORMHOLE-DATA.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WORMHOLE-DATA.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WORMHOLE-DATA.html  --  ACL2 Version 6.2</title></head>
+<head><title>WORMHOLE-DATA.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WORMHOLE-DATA</h2>determines the wormhole data object from a wormhole status object
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WORMHOLE-ENTRY-CODE.html acl2-6.3/doc/HTML/WORMHOLE-ENTRY-CODE.html
--- acl2-6.2/doc/HTML/WORMHOLE-ENTRY-CODE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WORMHOLE-ENTRY-CODE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WORMHOLE-ENTRY-CODE.html  --  ACL2 Version 6.2</title></head>
+<head><title>WORMHOLE-ENTRY-CODE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WORMHOLE-ENTRY-CODE</h2>determines the wormhole entry code from a wormhole status object
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WORMHOLE-EVAL.html acl2-6.3/doc/HTML/WORMHOLE-EVAL.html
--- acl2-6.2/doc/HTML/WORMHOLE-EVAL.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WORMHOLE-EVAL.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WORMHOLE-EVAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>WORMHOLE-EVAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WORMHOLE-EVAL</h2>state-saving without state -- a short-cut to a parallel universe
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WORMHOLE-IMPLEMENTATION.html acl2-6.3/doc/HTML/WORMHOLE-IMPLEMENTATION.html
--- acl2-6.2/doc/HTML/WORMHOLE-IMPLEMENTATION.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WORMHOLE-IMPLEMENTATION.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WORMHOLE-IMPLEMENTATION.html  --  ACL2 Version 6.2</title></head>
+<head><title>WORMHOLE-IMPLEMENTATION.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WORMHOLE-IMPLEMENTATION</h2>notes on how wormholes are implemented
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WORMHOLE-P.html acl2-6.3/doc/HTML/WORMHOLE-P.html
--- acl2-6.2/doc/HTML/WORMHOLE-P.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WORMHOLE-P.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WORMHOLE-P.html  --  ACL2 Version 6.2</title></head>
+<head><title>WORMHOLE-P.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WORMHOLE-P</h2>predicate to determine if you are inside a <code><a href="WORMHOLE.html">wormhole</a></code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WORMHOLE-STATUSP.html acl2-6.3/doc/HTML/WORMHOLE-STATUSP.html
--- acl2-6.2/doc/HTML/WORMHOLE-STATUSP.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WORMHOLE-STATUSP.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WORMHOLE-STATUSP.html  --  ACL2 Version 6.2</title></head>
+<head><title>WORMHOLE-STATUSP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WORMHOLE-STATUSP</h2>predicate recognizing well-formed wormhole status object
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/WORMHOLE.html acl2-6.3/doc/HTML/WORMHOLE.html
--- acl2-6.2/doc/HTML/WORMHOLE.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/WORMHOLE.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WORMHOLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>WORMHOLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>WORMHOLE</h2><code><a href="LD.html">ld</a></code> without <code><a href="STATE.html">state</a></code> -- a short-cut to a parallel universe
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
@@ -31,7 +31,6 @@
   :ld-skip-proofsp    ...  ; nil, t or 'include-book
   :ld-redefinition-action  ; nil or '(:a . :b)
   :ld-prompt          ...  ; nil, t, or some prompt printer fn
-  :ld-keyword-aliases ...  ; an alist pairing keywords to parse info
   :ld-missing-input-ok ... ; nil, t, :warn, or warning message
   :ld-pre-eval-filter ...  ; :all, :query, or some new name
   :ld-pre-eval-print  ...  ; nil, t, or :never
diff -Nru acl2-6.2/doc/HTML/WRITE-BYTE$.html acl2-6.3/doc/HTML/WRITE-BYTE$.html
--- acl2-6.2/doc/HTML/WRITE-BYTE$.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/WRITE-BYTE$.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>WRITE-BYTE$.html  --  ACL2 Version 6.2</title></head>
+<head><title>WRITE-BYTE$.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>WRITE-BYTE$</h3>See <a href="IO.html">io</a>.
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/What_Is_ACL2_lparen_Q_rparen_.html acl2-6.3/doc/HTML/What_Is_ACL2_lparen_Q_rparen_.html
--- acl2-6.2/doc/HTML/What_Is_ACL2_lparen_Q_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/What_Is_ACL2_lparen_Q_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>What_Is_ACL2_lparen_Q_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>What_Is_ACL2_lparen_Q_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>What Is ACL2?</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/What_is_Required_of_the_User_lparen_Q_rparen_.html acl2-6.3/doc/HTML/What_is_Required_of_the_User_lparen_Q_rparen_.html
--- acl2-6.2/doc/HTML/What_is_Required_of_the_User_lparen_Q_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/What_is_Required_of_the_User_lparen_Q_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>What_is_Required_of_the_User_lparen_Q_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>What_is_Required_of_the_User_lparen_Q_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>What is Required of the User?</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/What_is_a_Mathematical_Logic_lparen_Q_rparen_.html acl2-6.3/doc/HTML/What_is_a_Mathematical_Logic_lparen_Q_rparen_.html
--- acl2-6.2/doc/HTML/What_is_a_Mathematical_Logic_lparen_Q_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/What_is_a_Mathematical_Logic_lparen_Q_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>What_is_a_Mathematical_Logic_lparen_Q_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>What_is_a_Mathematical_Logic_lparen_Q_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>What is a Mathematical Logic?</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen_.html acl2-6.3/doc/HTML/What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen_.html
--- acl2-6.2/doc/HTML/What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>What is a Mechanical Theorem Prover?</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen___lparen_cont_rparen_.html acl2-6.3/doc/HTML/What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen___lparen_cont_rparen_.html
--- acl2-6.2/doc/HTML/What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen___lparen_cont_rparen_.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen___lparen_cont_rparen_.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen___lparen_cont_rparen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>What_is_a_Mechanical_Theorem_Prover_lparen_Q_rparen___lparen_cont_rparen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>What is a Mechanical Theorem Prover? (cont)</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/XARGS.html acl2-6.3/doc/HTML/XARGS.html
--- acl2-6.2/doc/HTML/XARGS.html	2013-06-07 04:13:29.000000000 +0000
+++ acl2-6.3/doc/HTML/XARGS.html	2013-09-30 17:39:30.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>XARGS.html  --  ACL2 Version 6.2</title></head>
+<head><title>XARGS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>XARGS</h2>extra arguments, for example to give <a href="HINTS.html">hints</a> to <code><a href="DEFUN.html">defun</a></code>
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
@@ -60,7 +60,8 @@
 valid measure involves only those formal parameters.  However, this special
 case is only allowed for definitions that are redundant
 (see <a href="REDUNDANT-EVENTS.html">redundant-events</a>) or are executed when skipping proofs
-(see <a href="SKIP-PROOFS.html">skip-proofs</a>).</p><p><code>:RULER-EXTENDERS</code><br/>
+(see <a href="SKIP-PROOFS.html">skip-proofs</a>).  Another special case is <code>:MEASURE nil</code>, which is
+treated the same as if <code>:MEASURE</code> is omitted.</p><p><code>:RULER-EXTENDERS</code><br/>
 
 For recursive definitions (possibly mutually recursive), <code>value</code> controls
 termination analysis and the resulting stored induction scheme.
diff -Nru acl2-6.2/doc/HTML/XOR.html acl2-6.3/doc/HTML/XOR.html
--- acl2-6.2/doc/HTML/XOR.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/XOR.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>XOR.html  --  ACL2 Version 6.2</title></head>
+<head><title>XOR.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>XOR</h3>logical ``exclusive or''
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/You_Must_Think_about_the_Use_of_a_Formula_as_a_Rule.html acl2-6.3/doc/HTML/You_Must_Think_about_the_Use_of_a_Formula_as_a_Rule.html
--- acl2-6.2/doc/HTML/You_Must_Think_about_the_Use_of_a_Formula_as_a_Rule.html	2013-06-07 04:13:33.000000000 +0000
+++ acl2-6.3/doc/HTML/You_Must_Think_about_the_Use_of_a_Formula_as_a_Rule.html	2013-09-30 17:39:34.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>You_Must_Think_about_the_Use_of_a_Formula_as_a_Rule.html  --  ACL2 Version 6.2</title></head>
+<head><title>You_Must_Think_about_the_Use_of_a_Formula_as_a_Rule.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>You Must Think about the Use of a Formula as a Rule</h2>
 <p></p>
diff -Nru acl2-6.2/doc/HTML/ZERO-TEST-IDIOMS.html acl2-6.3/doc/HTML/ZERO-TEST-IDIOMS.html
--- acl2-6.2/doc/HTML/ZERO-TEST-IDIOMS.html	2013-06-07 04:13:32.000000000 +0000
+++ acl2-6.3/doc/HTML/ZERO-TEST-IDIOMS.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ZERO-TEST-IDIOMS.html  --  ACL2 Version 6.2</title></head>
+<head><title>ZERO-TEST-IDIOMS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>ZERO-TEST-IDIOMS</h2>how to test for 0
 <pre>Major Section:  <a href="PROGRAMMING.html">PROGRAMMING</a>
diff -Nru acl2-6.2/doc/HTML/ZEROP.html acl2-6.3/doc/HTML/ZEROP.html
--- acl2-6.2/doc/HTML/ZEROP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ZEROP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ZEROP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ZEROP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ZEROP</h3>test an acl2-number against 0
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ZIP.html acl2-6.3/doc/HTML/ZIP.html
--- acl2-6.2/doc/HTML/ZIP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ZIP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ZIP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ZIP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ZIP</h3>testing an ``integer'' against 0
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ZP.html acl2-6.3/doc/HTML/ZP.html
--- acl2-6.2/doc/HTML/ZP.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ZP.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ZP.html  --  ACL2 Version 6.2</title></head>
+<head><title>ZP.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ZP</h3>testing a ``natural'' against 0
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/ZPF.html acl2-6.3/doc/HTML/ZPF.html
--- acl2-6.2/doc/HTML/ZPF.html	2013-06-07 04:13:31.000000000 +0000
+++ acl2-6.3/doc/HTML/ZPF.html	2013-09-30 17:39:33.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>ZPF.html  --  ACL2 Version 6.2</title></head>
+<head><title>ZPF.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>ZPF</h3>testing a nonnegative fixnum against 0
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_ampersand_ALLOW-OTHER-KEYS.html acl2-6.3/doc/HTML/_ampersand_ALLOW-OTHER-KEYS.html
--- acl2-6.2/doc/HTML/_ampersand_ALLOW-OTHER-KEYS.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/_ampersand_ALLOW-OTHER-KEYS.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_ampersand_ALLOW-OTHER-KEYS.html  --  ACL2 Version 6.2</title></head>
+<head><title>_ampersand_ALLOW-OTHER-KEYS.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>&amp;ALLOW-OTHER-KEYS</h2>See <a href="MACRO-ARGS.html">macro-args</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/_ampersand_BODY.html acl2-6.3/doc/HTML/_ampersand_BODY.html
--- acl2-6.2/doc/HTML/_ampersand_BODY.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/_ampersand_BODY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_ampersand_BODY.html  --  ACL2 Version 6.2</title></head>
+<head><title>_ampersand_BODY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>&amp;BODY</h2>See <a href="MACRO-ARGS.html">macro-args</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/_ampersand_KEY.html acl2-6.3/doc/HTML/_ampersand_KEY.html
--- acl2-6.2/doc/HTML/_ampersand_KEY.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/_ampersand_KEY.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_ampersand_KEY.html  --  ACL2 Version 6.2</title></head>
+<head><title>_ampersand_KEY.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>&amp;KEY</h2>See <a href="MACRO-ARGS.html">macro-args</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/_ampersand_OPTIONAL.html acl2-6.3/doc/HTML/_ampersand_OPTIONAL.html
--- acl2-6.2/doc/HTML/_ampersand_OPTIONAL.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/_ampersand_OPTIONAL.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_ampersand_OPTIONAL.html  --  ACL2 Version 6.2</title></head>
+<head><title>_ampersand_OPTIONAL.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>&amp;OPTIONAL</h2>See <a href="MACRO-ARGS.html">macro-args</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/_ampersand_REST.html acl2-6.3/doc/HTML/_ampersand_REST.html
--- acl2-6.2/doc/HTML/_ampersand_REST.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/_ampersand_REST.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_ampersand_REST.html  --  ACL2 Version 6.2</title></head>
+<head><title>_ampersand_REST.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>&amp;REST</h2>See <a href="MACRO-ARGS.html">macro-args</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/_ampersand_WHOLE.html acl2-6.3/doc/HTML/_ampersand_WHOLE.html
--- acl2-6.2/doc/HTML/_ampersand_WHOLE.html	2013-06-07 04:13:28.000000000 +0000
+++ acl2-6.3/doc/HTML/_ampersand_WHOLE.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_ampersand_WHOLE.html  --  ACL2 Version 6.2</title></head>
+<head><title>_ampersand_WHOLE.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>&amp;WHOLE</h2>See <a href="MACRO-ARGS.html">macro-args</a>.
 <pre>Major Section:  <a href="MISCELLANEOUS.html">MISCELLANEOUS</a>
diff -Nru acl2-6.2/doc/HTML/_at_.html acl2-6.3/doc/HTML/_at_.html
--- acl2-6.2/doc/HTML/_at_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_at_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_at_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_at_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>@</h3>get the value of a global variable in <code><a href="STATE.html">state</a></code>
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_gt_.html acl2-6.3/doc/HTML/_gt_.html
--- acl2-6.2/doc/HTML/_gt_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_gt_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_gt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_gt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>&gt;</h3>greater-than test
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_gt_=.html acl2-6.3/doc/HTML/_gt_=.html
--- acl2-6.2/doc/HTML/_gt_=.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_gt_=.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_gt_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>_gt_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>&gt;=</h3>greater-than-or-equal test
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_hyphen_.html acl2-6.3/doc/HTML/_hyphen_.html
--- acl2-6.2/doc/HTML/_hyphen_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_hyphen_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_hyphen_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_hyphen_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>-</h3>macro for subtraction and negation
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_lt_.html acl2-6.3/doc/HTML/_lt_.html
--- acl2-6.2/doc/HTML/_lt_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_lt_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_lt_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_lt_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>&lt;</h3>less-than
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_lt_=.html acl2-6.3/doc/HTML/_lt_=.html
--- acl2-6.2/doc/HTML/_lt_=.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_lt_=.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_lt_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>_lt_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>&lt;=</h3>less-than-or-equal test
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_slash_.html acl2-6.3/doc/HTML/_slash_.html
--- acl2-6.2/doc/HTML/_slash_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_slash_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_slash_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_slash_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>/</h3>macro for division and reciprocal
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_slash_=.html acl2-6.3/doc/HTML/_slash_=.html
--- acl2-6.2/doc/HTML/_slash_=.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_slash_=.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_slash_=.html  --  ACL2 Version 6.2</title></head>
+<head><title>_slash_=.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>/=</h3>test inequality of two numbers
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_star_.html acl2-6.3/doc/HTML/_star_.html
--- acl2-6.2/doc/HTML/_star_.html	2013-06-07 04:13:30.000000000 +0000
+++ acl2-6.3/doc/HTML/_star_.html	2013-09-30 17:39:31.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h3>*</h3>multiplication macro
 <pre>Major Section:  <a href="ACL2-BUILT-INS.html">ACL2-BUILT-INS</a>
diff -Nru acl2-6.2/doc/HTML/_star_STANDARD-CI_star_.html acl2-6.3/doc/HTML/_star_STANDARD-CI_star_.html
--- acl2-6.2/doc/HTML/_star_STANDARD-CI_star_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/_star_STANDARD-CI_star_.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_star_STANDARD-CI_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_star_STANDARD-CI_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>*STANDARD-CI*</h2>an ACL2 character-based analogue of CLTL's <code>*standard-input*</code>
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/_star_STANDARD-CO_star_.html acl2-6.3/doc/HTML/_star_STANDARD-CO_star_.html
--- acl2-6.2/doc/HTML/_star_STANDARD-CO_star_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/_star_STANDARD-CO_star_.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_star_STANDARD-CO_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_star_STANDARD-CO_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>*STANDARD-CO*</h2>the ACL2 analogue of CLTL's <code>*standard-output*</code>
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/_star_STANDARD-OI_star_.html acl2-6.3/doc/HTML/_star_STANDARD-OI_star_.html
--- acl2-6.2/doc/HTML/_star_STANDARD-OI_star_.html	2013-06-07 04:13:27.000000000 +0000
+++ acl2-6.3/doc/HTML/_star_STANDARD-OI_star_.html	2013-09-30 17:39:28.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_star_STANDARD-OI_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_star_STANDARD-OI_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>*STANDARD-OI*</h2>an ACL2 object-based analogue of CLTL's <code>*standard-input*</code>
 <pre>Major Section:  <a href="IO.html">IO</a>
diff -Nru acl2-6.2/doc/HTML/_star_TERMINAL-MARKUP-TABLE_star_.html acl2-6.3/doc/HTML/_star_TERMINAL-MARKUP-TABLE_star_.html
--- acl2-6.2/doc/HTML/_star_TERMINAL-MARKUP-TABLE_star_.html	2013-06-07 04:13:26.000000000 +0000
+++ acl2-6.3/doc/HTML/_star_TERMINAL-MARKUP-TABLE_star_.html	2013-09-30 17:39:26.000000000 +0000
@@ -1,5 +1,5 @@
 <html>
-<head><title>_star_TERMINAL-MARKUP-TABLE_star_.html  --  ACL2 Version 6.2</title></head>
+<head><title>_star_TERMINAL-MARKUP-TABLE_star_.html  --  ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h2>*TERMINAL-MARKUP-TABLE*</h2>a <a href="MARKUP.html">markup</a> table used for printing to the terminal
 <pre>Major Section:  <a href="DOCUMENTATION.html">DOCUMENTATION</a>
diff -Nru acl2-6.2/doc/HTML/acl2-doc-index.html acl2-6.3/doc/HTML/acl2-doc-index.html
--- acl2-6.2/doc/HTML/acl2-doc-index.html	2013-06-07 04:13:35.000000000 +0000
+++ acl2-6.3/doc/HTML/acl2-doc-index.html	2013-09-30 17:39:38.000000000 +0000
@@ -1,6 +1,6 @@
 
 <html>
-<head><title>ACL2 Version 6.2</title></head>
+<head><title>ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
 <h1>Index</h1>
 
@@ -215,6 +215,12 @@
 <b><a href="ADD-INVISIBLE-FNS.html">ADD-INVISIBLE-FNS</a> -- make some unary functions invisible to the <a href="LOOP-STOPPER.html">loop-stopper</a> algorithm
 </b><br><br>
 
+<b><a href="ADD-LD-KEYWORD-ALIAS.html">ADD-LD-KEYWORD-ALIAS</a> -- See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+</b><br><br>
+
+<b><a href="ADD-LD-KEYWORD-ALIAS_bang_.html">ADD-LD-KEYWORD-ALIAS!</a> -- See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+</b><br><br>
+
 <b><a href="ADD-MACRO-ALIAS.html">ADD-MACRO-ALIAS</a> -- associate a function name with a macro name
 </b><br><br>
 
@@ -275,7 +281,7 @@
 <b><a href="APPEND.html">APPEND</a> -- <a href="CONCATENATE.html">concatenate</a> zero or more lists
 </b><br><br>
 
-<b><a href="APROPOS.html">APROPOS</a> -- searching the documentation online
+<b><a href="APROPOS.html">APROPOS</a> -- See <a href="FINDING-DOCUMENTATION.html">finding-documentation</a>.
 </b><br><br>
 
 <b><a href="ARCHITECTURE-OF-THE-PROVER.html">ARCHITECTURE-OF-THE-PROVER</a> -- a simple overview of how the prover works
@@ -397,7 +403,7 @@
 <b><a href="BINARY-APPEND.html">BINARY-APPEND</a> -- <a href="CONCATENATE.html">concatenate</a> two lists
 </b><br><br>
 
-<b><a href="BIND-FREE.html">BIND-FREE</a> -- to bind free variables of a rewrite or linear rule
+<b><a href="BIND-FREE.html">BIND-FREE</a> -- to bind free variables of a rewrite, definition, or linear rule
 </b><br><br>
 
 <b><a href="BIND-FREE-EXAMPLES.html">BIND-FREE-EXAMPLES</a> -- examples pertaining to <code><a href="BIND-FREE.html">bind-free</a></code> hypotheses
@@ -412,6 +418,9 @@
 <b><a href="BOOK-EXAMPLE.html">BOOK-EXAMPLE</a> -- how to create, certify, and use a simple book
 </b><br><br>
 
+<b><a href="BOOK-MAKEFILES.html">BOOK-MAKEFILES</a> -- See <a href="BOOKS-CERTIFICATION.html">books-certification</a>.
+</b><br><br>
+
 <b><a href="BOOK-NAME.html">BOOK-NAME</a> -- conventions associated with book names
 </b><br><br>
 
@@ -594,6 +603,9 @@
 <b><a href="CERTIFY-BOOK_bang_.html">CERTIFY-BOOK!</a> -- a variant of <code><a href="CERTIFY-BOOK.html">certify-book</a></code>
 </b><br><br>
 
+<b><a href="CERTIFYING-BOOKS.html">CERTIFYING-BOOKS</a> -- See <a href="BOOKS-CERTIFICATION.html">books-certification</a>.
+</b><br><br>
+
 <b><a href="CHAR.html">CHAR</a> -- the <a href="NTH.html">nth</a> element (zero-based) of a string
 </b><br><br>
 
@@ -681,6 +693,9 @@
 <b><a href="COMMAND-DESCRIPTOR.html">COMMAND-DESCRIPTOR</a> -- an object describing a particular <a href="COMMAND.html">command</a> typed by the user
 </b><br><br>
 
+<b><a href="COMMAND-LINE.html">COMMAND-LINE</a> -- handling of command-line arguments when ACL2 is invoked
+</b><br><br>
+
 <b><a href="COMMON-LISP.html">COMMON-LISP</a> -- relation to Common Lisp, including deviations from the spec
 </b><br><br>
 
@@ -972,7 +987,7 @@
 <b><a href="DEFUNS.html">DEFUNS</a> -- an alternative to <code><a href="MUTUAL-RECURSION.html">mutual-recursion</a></code>
 </b><br><br>
 
-<b><a href="DELETE-ASSOC.html">DELETE-ASSOC</a> -- modify an association list by associating a value with a key
+<b><a href="DELETE-ASSOC.html">DELETE-ASSOC</a> -- remove the first pair from an association list for a given key
 </b><br><br>
 
 <b><a href="DELETE-ASSOC-EQ.html">DELETE-ASSOC-EQ</a> -- See <a href="DELETE-ASSOC.html">delete-assoc</a>.
@@ -1266,6 +1281,9 @@
 <b><a href="FIND-RULES-OF-RUNE.html">FIND-RULES-OF-RUNE</a> -- find the rules named rune
 </b><br><br>
 
+<b><a href="FINDING-DOCUMENTATION.html">FINDING-DOCUMENTATION</a> -- searching the documentation
+</b><br><br>
+
 <b><a href="FIRST.html">FIRST</a> -- first member of the list
 </b><br><br>
 
@@ -1424,6 +1442,9 @@
 <b><a href="GET-COMMAND-SEQUENCE.html">GET-COMMAND-SEQUENCE</a> -- return list of <a href="COMMAND.html">command</a>s that are between two <a href="COMMAND.html">command</a> descriptors
 </b><br><br>
 
+<b><a href="GET-INTERNAL-TIME.html">GET-INTERNAL-TIME</a> -- runtime vs. realtime in ACL2 timings
+</b><br><br>
+
 <b><a href="GET-OUTPUT-STREAM-STRING$.html">GET-OUTPUT-STREAM-STRING$</a> -- See <a href="IO.html">io</a>.
 </b><br><br>
 
@@ -1648,6 +1669,9 @@
 <b><a href="IGNORE.html">IGNORE</a> -- See <a href="DECLARE.html">declare</a>.
 </b><br><br>
 
+<b><a href="IGNORED-ATTACHMENT.html">IGNORED-ATTACHMENT</a> -- why attachments are sometimes not used
+</b><br><br>
+
 <b><a href="ILLEGAL.html">ILLEGAL</a> -- print an error message and stop execution
 </b><br><br>
 
@@ -1842,6 +1866,9 @@
 <b><a href="LAST.html">LAST</a> -- the last <code><a href="CONS.html">cons</a></code> (not element) of a list
 </b><br><br>
 
+<b><a href="LAST-PROVER-STEPS.html">LAST-PROVER-STEPS</a> -- the number of prover steps most recently taken
+</b><br><br>
+
 <b><a href="LD.html">LD</a> -- the ACL2 read-eval-print loop, file loader, and <a href="COMMAND.html">command</a> processor
 </b><br><br>
 
@@ -1854,7 +1881,7 @@
 <b><a href="LD-EVISC-TUPLE.html">LD-EVISC-TUPLE</a> -- determines whether <code><a href="LD.html">ld</a></code> suppresses details when printing
 </b><br><br>
 
-<b><a href="LD-KEYWORD-ALIASES.html">LD-KEYWORD-ALIASES</a> -- allows the abbreviation of some keyword commands
+<b><a href="LD-KEYWORD-ALIASES.html">LD-KEYWORD-ALIASES</a> -- abbreviation of some keyword commands
 </b><br><br>
 
 <b><a href="LD-MISSING-INPUT-OK.html">LD-MISSING-INPUT-OK</a> -- determines which forms <code><a href="LD.html">ld</a></code> evaluates
@@ -2152,6 +2179,9 @@
 <b><a href="MORE-DOC.html">MORE-DOC</a> -- a continuation of the <code>:</code><code><a href="DOC.html">doc</a></code> <a href="DOCUMENTATION.html">documentation</a>
 </b><br><br>
 
+<b><a href="MSG.html">MSG</a> -- construct a ``message'' suitable for the <code>~@</code> directive of <code><a href="FMT.html">fmt</a></code>
+</b><br><br>
+
 <b><a href="MUST-BE-EQUAL.html">MUST-BE-EQUAL</a> -- attach code for execution
 </b><br><br>
 
@@ -2199,6 +2229,9 @@
 <b><a href="NATP.html">NATP</a> -- a recognizer for the natural numbers
 </b><br><br>
 
+<b><a href="NESTED-STOBJS.html">NESTED-STOBJS</a> -- using <a href="STOBJ.html">stobj</a>s that contain stobjs
+</b><br><br>
+
 <b><a href="NEVER-MEMOIZE.html">NEVER-MEMOIZE</a> -- Mark a function as unsafe to memoize.
 </b><br><br>
 
@@ -2482,6 +2515,9 @@
 <b><a href="NOTE-6-2.html">NOTE-6-2</a> -- ACL2 Version  6.2 (June, 2013) Notes
 </b><br><br>
 
+<b><a href="NOTE-6-3.html">NOTE-6-3</a> -- ACL2 Version  6.3 (October, 2013) Notes
+</b><br><br>
+
 <b><a href="NOTE1.html">NOTE1</a> -- Acl2 Version 1.1 Notes
 </b><br><br>
 
@@ -3064,6 +3100,9 @@
 <b><a href="REDO-FLAT.html">REDO-FLAT</a> -- redo on failure of a <code><a href="PROGN.html">progn</a></code>, <code><a href="ENCAPSULATE.html">encapsulate</a></code>, or <code><a href="CERTIFY-BOOK.html">certify-book</a></code>
 </b><br><br>
 
+<b><a href="REDUNDANT-ENCAPSULATE.html">REDUNDANT-ENCAPSULATE</a> -- redundancy of <code><a href="ENCAPSULATE.html">encapsulate</a></code> <a href="EVENTS.html">events</a>
+</b><br><br>
+
 <b><a href="REDUNDANT-EVENTS.html">REDUNDANT-EVENTS</a> -- allowing a name to be introduced ``twice''
 </b><br><br>
 
@@ -3231,10 +3270,10 @@
 <b><a href="SAVE-AND-CLEAR-MEMOIZATION-SETTINGS.html">SAVE-AND-CLEAR-MEMOIZATION-SETTINGS</a> -- save and remove the current memoization settings
 </b><br><br>
 
-<b><a href="SAVE-EXEC.html">SAVE-EXEC</a> -- save an executable image and (for most Common Lisps) a wrapper script
+<b><a href="SAVE-EXEC.html">SAVE-EXEC</a> -- save an executable image and a wrapper script
 </b><br><br>
 
-<b><a href="SAVING-AND-RESTORING.html">SAVING-AND-RESTORING</a> -- saving and restoring your logical state
+<b><a href="SAVING-AND-RESTORING.html">SAVING-AND-RESTORING</a> -- See <a href="SAVE-EXEC.html">save-exec</a>.
 </b><br><br>
 
 <b><a href="SEARCH.html">SEARCH</a> -- search for a string or list in another string or list
@@ -3354,6 +3393,9 @@
 <b><a href="SET-INHIBIT-WARNINGS.html">SET-INHIBIT-WARNINGS</a> -- control warnings
 </b><br><br>
 
+<b><a href="SET-INHIBIT-WARNINGS_bang_.html">SET-INHIBIT-WARNINGS!</a> -- control warnings non-<code><a href="LOCAL.html">local</a></code>ly
+</b><br><br>
+
 <b><a href="SET-INHIBITED-SUMMARY-TYPES.html">SET-INHIBITED-SUMMARY-TYPES</a> -- control which parts of the summary are printed
 </b><br><br>
 
@@ -3369,6 +3411,9 @@
 <b><a href="SET-LD-KEYWORD-ALIASES.html">SET-LD-KEYWORD-ALIASES</a> -- See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
 </b><br><br>
 
+<b><a href="SET-LD-KEYWORD-ALIASES_bang_.html">SET-LD-KEYWORD-ALIASES!</a> -- See <a href="LD-KEYWORD-ALIASES.html">ld-keyword-aliases</a>.
+</b><br><br>
+
 <b><a href="SET-LD-REDEFINITION-ACTION.html">SET-LD-REDEFINITION-ACTION</a> -- See <a href="LD-REDEFINITION-ACTION.html">ld-redefinition-action</a>.
 </b><br><br>
 
@@ -3555,6 +3600,9 @@
 <b><a href="SIGNATURE.html">SIGNATURE</a> -- how to specify the arity of a constrained function
 </b><br><br>
 
+<b><a href="SIGNED-BYTE-P.html">SIGNED-BYTE-P</a> -- recognizer for signed integers that fit in a specified bit width
+</b><br><br>
+
 <b><a href="SIGNUM.html">SIGNUM</a> -- indicator for positive, negative, or zero
 </b><br><br>
 
@@ -3651,7 +3699,7 @@
 <b><a href="STOBJ-EXAMPLE-3.html">STOBJ-EXAMPLE-3</a> -- another example of a single-threaded object
 </b><br><br>
 
-<b><a href="STOBJ-LET.html">STOBJ-LET</a> -- using <a href="STOBJ.html">stobj</a>s that contain stobjs
+<b><a href="STOBJ-LET.html">STOBJ-LET</a> -- See <a href="NESTED-STOBJS.html">nested-stobjs</a>.
 </b><br><br>
 
 <b><a href="STOBJS.html">STOBJS</a> -- xargs keyword <code>:STOBJS</code>
@@ -3753,7 +3801,7 @@
 <b><a href="SYNTAX.html">SYNTAX</a> -- the syntax of ACL2 is that of Common Lisp
 </b><br><br>
 
-<b><a href="SYNTAXP.html">SYNTAXP</a> -- attach a heuristic filter on a <code>:</code><code><a href="REWRITE.html">rewrite</a></code>, <code>:</code><code><a href="META.html">meta</a></code>, or <code>:</code><code><a href="LINEAR.html">linear</a></code> rule
+<b><a href="SYNTAXP.html">SYNTAXP</a> -- attach a heuristic filter on a rule
 </b><br><br>
 
 <b><a href="SYNTAXP-EXAMPLES.html">SYNTAXP-EXAMPLES</a> -- examples pertaining to syntaxp hypotheses
@@ -3762,6 +3810,9 @@
 <b><a href="SYS-CALL.html">SYS-CALL</a> -- make a system call to the host operating system
 </b><br><br>
 
+<b><a href="SYS-CALL+.html">SYS-CALL+</a> -- make a system call to the host OS, returning status and output
+</b><br><br>
+
 <b><a href="SYS-CALL-STATUS.html">SYS-CALL-STATUS</a> -- exit status from the preceding system call
 </b><br><br>
 
@@ -4117,6 +4168,9 @@
 <b><a href="UNSAVE.html">UNSAVE</a> -- remove a <a href="PROOF-CHECKER.html">proof-checker</a> state
 </b><br><br>
 
+<b><a href="UNSIGNED-BYTE-P.html">UNSIGNED-BYTE-P</a> -- recognizer for natural numbers that fit in a specified bit width
+</b><br><br>
+
 <b><a href="UNSUPPORTED-PARALLELISM-FEATURES.html">UNSUPPORTED-PARALLELISM-FEATURES</a> -- ACL2 features not supported in ACL2(p)
 </b><br><br>
 
@@ -4197,6 +4251,9 @@
 <b><a href="VERIFY-GUARDS.html">VERIFY-GUARDS</a> -- verify the <a href="GUARD.html">guard</a>s of a function
 </b><br><br>
 
+<b><a href="VERIFY-GUARDS+.html">VERIFY-GUARDS+</a> -- verify the <a href="GUARD.html">guard</a>s of a function
+</b><br><br>
+
 <b><a href="VERIFY-GUARDS-EAGERNESS.html">VERIFY-GUARDS-EAGERNESS</a> -- See <a href="SET-VERIFY-GUARDS-EAGERNESS.html">set-verify-guards-eagerness</a>.
 </b><br><br>
 
diff -Nru acl2-6.2/doc/HTML/acl2-doc-major-topics.html acl2-6.3/doc/HTML/acl2-doc-major-topics.html
--- acl2-6.2/doc/HTML/acl2-doc-major-topics.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/acl2-doc-major-topics.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,8 +1,8 @@
 
 <html>
-<head><title>ACL2 Version 6.2</title></head>
+<head><title>ACL2 Version 6.3</title></head>
 <body text=#000000 bgcolor="#FFFFFF">
-<h1>Documentation for ACL2 Version 6.2<h1>
+<h1>Documentation for ACL2 Version 6.3<h1>
 <h2>The <a href="acl2-doc.html">ACL2</a> Documentation is divided into the following Major Topics<h2><ul><li><h3><a href="ABOUT-ACL2.html">ABOUT-ACL2</a> -- about ACL2
 </h3>
 </li>
diff -Nru acl2-6.2/doc/HTML/acl2-doc.html acl2-6.3/doc/HTML/acl2-doc.html
--- acl2-6.2/doc/HTML/acl2-doc.html	2013-06-07 04:13:25.000000000 +0000
+++ acl2-6.3/doc/HTML/acl2-doc.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,7 +1,7 @@
 
 <HTML>
 
-<HEAD><TITLE>ACL2 Version 6.2</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3</TITLE></HEAD>
 
 <BODY TEXT="#000000" BGCOLOR="#FFFFFF">
 
@@ -11,7 +11,7 @@
 <IMG SRC="acl2-logo-200-134.gif" ALIGN=LEFT ALT="ACL2">
 </TD>
 <TD>
-<CENTER><H1>ACL2 Version 6.2</H1></CENTER>
+<CENTER><H1>ACL2 Version 6.3</H1></CENTER>
 
 ACL2 is both a programming language in which you can model computer systems
 and a tool to help you prove properties of those models.<P>
@@ -79,7 +79,7 @@
 </TD>
 <TD>
 <A HREF="http://www.cs.utexas.edu/users/moore/publications/acl2-papers.html">
-Publications about about ACL2 and Its Applications</A>
+Publications about ACL2 and Its Applications</A>
 </TD>
 
 <TD ALIGN=CENTER VALIGN=MIDDLE>
@@ -133,10 +133,10 @@
 
 <TR>
 <TD ALIGN=CENTER VALIGN=MIDDLE>
-<A HREF="NOTE-6-2.html"><IMG SRC="note02.gif" BORDER=0></A>
+<A HREF="NOTE-6-3.html"><IMG SRC="note02.gif" BORDER=0></A>
 </TD>
 <TD>
-<A HREF="NOTE-6-2.html">Differences from Version 6.1</A><A HREF="A_Tiny_Warning_Sign.html"> <IMG SRC="twarning.gif"></A>
+<A HREF="NOTE-6-3.html">Differences from Version 6.2</A><A HREF="A_Tiny_Warning_Sign.html"> <IMG SRC="twarning.gif"></A>
 </TD>
 <TD ALIGN=CENTER VALIGN=MIDDLE>
 <A HREF="other-releases.html">
@@ -166,15 +166,46 @@
 <CENTER>
 <B><A HREF="mailto:kaufmann@cs.utexas.edu">Matt Kaufmann</A> and <A HREF="mailto:moore@cs.utexas.edu">J Strother Moore</A></B><BR>
 <A HREF="http://www.utexas.edu">University of Texas at Austin</A><BR>
-June 6, 2013
+September 30, 2013
 </CENTER>
 
 <P>
 
 <HR>
 
-<BR>
-The ACL2 distribution includes several extensions, which were
+<p>
+
+Libraries of <i>books</i> (files containing definitions and theorems) extend
+the code that we have written.  These <i>community books</i> are contributed
+and maintained by the members of the ACL2 community; see the <code><A
+HREF="http://acl2-books.googlecode.com/">acl2-books</A></code> project page.
+
+<p>
+
+The libraries and the ACL2 source code are under revision control, using svn.
+Experimental copies of ACL2 and the libraries are thus available between ACL2
+releases.  <i>The authors of ACL2 consider svn distributions to be
+experimental; while they will likely be fully functional in most cases, they
+could however be incomplete, fragile, and unable to pass our own
+regression.</i> If you decide to use svn versions of either the libraries or
+ACL2, then you should use both, as they tend to be kept in sync.  See the
+project websites, <code><A
+HREF="http://acl2-books.googlecode.com/">acl2-books</A></code> and <code><A
+HREF="http://acl2-devel.googlecode.com/">acl2-devel</A></code>, for the ACL2
+libraries and development sources, respectively.
+
+<p>
+
+A combined manual, known as the <A
+HREF="http://fv.centtech.com/acl2/6.3/doc/">xdoc manual</A>, incorporates not
+only <A HREF="#User's-Manual">The User's Manual</A> for ACL2 (with some
+topics rearranged) but also documentation for many books.  Thanks to Jared
+Davis for building the xdoc processor for creating this view of the
+documentation.
+
+<p>
+
+The ACL2 distribution includes the following extensions, which were
 contributed by the individuals shown.
 <UL>
 <LI><A HREF="REAL.html">ACL2(r)</A><BR>
@@ -191,20 +222,6 @@
 
 <p>
 
-There are libraries of <i>books</i> (files containing definitions and theorems)
-that extend the code that we have written.  Books are contributed and
-maintained by the ACL2 community (see <code><A
-HREF="http://acl2-books.googlecode.com/">http://acl2-books.googlecode.com/</A></code>;
-in particular, the [Source] tab near the top takes you to a search box)
-and their authors are generally noted in each book or its
-<code>README</code> file.  There is a <A
-HREF="http://fv.centtech.com/acl2/6.2/doc/">combined manual</A> that
-incorporates not only <A HREF="#User's-Manual">The User's Manual</A>
-for ACL2 but also documentation for many books; thanks to Jared Davis
-for building this view of the documentation.
-
-<p>
-
 Another extension of ACL2 is the Eclipse-based <A
 HREF="http://acl2s.ccs.neu.edu/acl2s/doc/">ACL2 Sedan</A> (ACL2s).  Unlike
 the systems above, ACL2s is distributed and maintained by Pete Manolios and his
@@ -283,7 +300,7 @@
 
 <B>Note</B>: The documentation is available for reading in a Web
 browser (recommended), in Emacs Info, using the ACL2 <CODE>:DOC</CODE> command,
-or as a printed book (over 2100 pages).  These are available as follows.
+or as a printed book (over 2200 pages).  These are available as follows.
 
 <ul>
 
@@ -293,10 +310,9 @@
 <CODE>doc/HTML/acl2-doc.html</CODE>.</li>
 
 <li>Alternatively, for web browsing you can use <A
-HREF="http://fv.centtech.com/acl2/6.2/doc/">documentation generated by Jared
-Davis's xdoc utility</A>.  After you install and certify the ACL2 community
-books (see <A HREF="#Tools">below</A>), you will find a complete local copy
-at <CODE>books/xdoc-impl/manual/preview.html</A></CODE>.
+HREF="http://fv.centtech.com/acl2/6.3/doc/">documentation generated by Jared
+Davis's xdoc utility</A>.  You can build a local copy from the ACL2 Community
+Books, following instructions in <code>books/Makefile</code>.</li>
 
 <li>Those familiar with Emacs Info can read the documentation in that format by
 loading the file <CODE>emacs/emacs-acl2.el</CODE> distributed with ACL2 (under
@@ -309,7 +325,7 @@
 
 <li>To read a printed copy, obtain a Postscript version <A HREF=
 "http://www.cs.utexas.edu/users/moore/publications/acl2-book.ps.gz">here</A>
-(about 2.5 MB).</li>
+(about 2.6 MB).</li>
 
 </ul>
 
@@ -383,18 +399,18 @@
 The following link will take you to a search box on a Google page,
 which has the following contents.
 <pre>
-search_term site:http://www.cs.utexas.edu/users/moore/acl2/v6-2
+search_term site:http://www.cs.utexas.edu/users/moore/acl2/v6-3
 </pre>
 Now simply replace the word `search_term' with your topic.  For example, replace
 `<code>search_term</code>' by `<code>tail recursion</code>' to get
 documentation about tail recursion.
 <pre>
-tail recursion site:http://www.cs.utexas.edu/users/moore/acl2/v6-2
+tail recursion site:http://www.cs.utexas.edu/users/moore/acl2/v6-3
 </pre>
 Now you are ready to follow the link.
 <p>
 <a href="http://www.google.com/search?q=search_term
-                 site:http://www.cs.utexas.edu/users/moore/acl2/v6-2">SEARCH
+                 site:http://www.cs.utexas.edu/users/moore/acl2/v6-3">SEARCH
                  THE DOCUMENTATION</a>
 </li>
 
@@ -403,7 +419,7 @@
 <li>
 
 The next link will take you to the community books website (which is external
-to the present ACL2 website), spefically to the section entitled ``Searching
+to the present ACL2 website), specifically to the section entitled ``Searching
 and browsing the books.''  There, you will see a search box in which you can
 enter your search term.  For example, if you type `<code>tail recursion</code>'
 and then <code>&lt;RETURN&gt;</code>, you will see text from several books in
diff -Nru acl2-6.2/doc/HTML/installation/installation.html acl2-6.3/doc/HTML/installation/installation.html
--- acl2-6.2/doc/HTML/installation/installation.html	2013-06-07 04:13:23.000000000 +0000
+++ acl2-6.3/doc/HTML/installation/installation.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,14 +1,14 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
 
-<H1><A NAME="top">ACL2 Version 6.2 Installation Guide</A></H1>
+<H1><A NAME="top">ACL2 Version 6.3 Installation Guide</A></H1>
 
 <H3>NOTE: From time to time we may provide so-called <i>incremental
 releases</i> of ACL2.  Please follow the <a
-href="http://www.cs.utexas.edu/users/moore/acl2/v6-2/new.html">recent changes
+href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/new.html">recent changes
 to this page</a> link on the <a
 href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2 home page</a> for more
 information.</H3>
@@ -28,20 +28,20 @@
 
 <ol>
 
-<li>Fetch <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/acl2.tar.gz">
-acl2.tar.gz</A> into a new directory, say <code>acl2/v6-2/</code>.</li>
+<li>Fetch <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2.tar.gz">
+acl2.tar.gz</A> into a new directory, say <code>acl2/v6-3/</code>.</li>
 
 <li>Execute the following to create directory <code>acl2-sources/</code>:<br>
 <code>tar xfz acl2.tar.gz</code></li>
 
 <li><A NAME="create-books">We strongly suggest</A> that you fetch ACL2 community books, for
   example
-  as <A HREF="http://acl2-books.googlecode.com/files/books-6.2.tar.gz">a
+  as <A HREF="http://acl2-books.googlecode.com/files/books-6.3.tar.gz">a
   tarball from the Google Code website</A>, into your
   new <code>acl2-sources/</code> directory; then execute the following
   in <code>acl2-sources/</code> to create
   directory <code>books/</code>:<br>
-<code>tar xfz books-6.2.tar.gz</code></li>
+<code>tar xfz books-6.3.tar.gz</code></li>
 
 <li><a href="requirements.html">Obtain a Common Lisp implementation</a> if you don't
 already have one.</li>
@@ -60,9 +60,9 @@
 </pre></li>
 
 <li>OPTIONAL: Download gzipped tarfiles
-for <A HREF="http://acl2-books.googlecode.com/files/workshops-6.2.tar.gz">workshops
+for <A HREF="http://acl2-books.googlecode.com/files/workshops-6.3.tar.gz">workshops
 books</A>
-and/or <A HREF="http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz">nonstd
+and/or <A HREF="http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz">nonstd
 books</A> from the Google Code website
 into the <CODE>books/</CODE> directory (but first
   create <CODE>books/</CODE> if you
@@ -76,11 +76,13 @@
     follows.
 <pre>
 make regression
-(time nice make ACL2_JOBS=8 ACL2=/u/smith/bin/acl2 regression) >& make-regression.log
+(time nice make -j 8 ACL2=/u/smith/bin/acl2 regression) >& make-regression.log
 </pre>
-    <A HREF="http://www.cs.utexas.edu/users/moore/acl2/current/REGRESSION.html">See
-    :DOC regression</A> for explanation and further options, e.g.
-    for using <A HREF="http://www.cs.utexas.edu/users/moore/acl2/current/HONS-AND-MEMOIZATION.html">ACL2(h)</A>.
+The resulting log file, <code>make-regression.log</code>, should
+contain no occurrences of the string ``CERTIFICATION FAILED''; a
+normal exit (status 0) should guarantee this.  If you want additional
+explanation and further options, see the documentation
+for <A HREF="http://www.cs.utexas.edu/users/moore/acl2/current/BOOKS-CERTIFICATION.html">BOOKS-CERTIFICATION</A>.
 
 </ol>
 
@@ -101,8 +103,8 @@
 <UL>
 <LI><A HREF="requirements.html">REQUIREMENTS</A>
 <UL>
-  <LI><A HREF="requirements.html#Obtaining-Lisp">Obtaining Common Lisp</A>
   <LI><A HREF="requirements.html#Performance">Performance comparisons</A>
+  <LI><A HREF="requirements.html#Obtaining-Lisp">Obtaining Common Lisp</A>
 </UL>
 <LI><A HREF="obtaining-and-installing.html">OBTAINING AND INSTALLING ACL2</A>
 <UL>
diff -Nru acl2-6.2/doc/HTML/installation/installing-make.html acl2-6.3/doc/HTML/installation/installing-make.html
--- acl2-6.2/doc/HTML/installation/installing-make.html	2013-06-07 04:13:23.000000000 +0000
+++ acl2-6.3/doc/HTML/installation/installing-make.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Installing Make</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Installing Make</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -29,10 +29,8 @@
 </li>
 
 <li>
-Download GNU make version 3.80 from:
-<pre>
-http://ftp.gnu.org/pub/gnu/make/make-3.80.tar.gz
-</pre>
+Download GNU make version 3.80 from:<p>
+<code><a href="http://ftp.gnu.org/pub/gnu/make/make-3.80.tar.gz">http://ftp.gnu.org/pub/gnu/make/make-3.80.tar.gz</a></code><p>
 </li>
 
 <li>
diff -Nru acl2-6.2/doc/HTML/installation/misc.html acl2-6.3/doc/HTML/installation/misc.html
--- acl2-6.2/doc/HTML/installation/misc.html	2013-06-07 04:13:23.000000000 +0000
+++ acl2-6.3/doc/HTML/installation/misc.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Miscellaneous Information</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Miscellaneous Information</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -60,7 +60,7 @@
 <P>
 
 If you care to use ACL2(r), we strongly suggest that you first
-<A HREF="http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz">
+<A HREF="http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz">
 download the non-standard analysis community books (gzipped tar file)</A> from
 the Google
 Code <a href="https://code.google.com/p/acl2-books/">acl2-books
@@ -69,7 +69,7 @@
 <I>dir</I>/acl2-sources/books/</code>.  Then extract to create
 subdirectory <CODE>nonstd/</CODE>:
 <pre>
-tar xvfz nonstd-6.2.tar.gz
+tar xvfz nonstd-6.3.tar.gz
 </pre>
 <p>
 Next build an executable image and certify books.  First, connect to your
@@ -100,22 +100,29 @@
 <BR><HR><BR>
 <H3><A NAME="Addresses">Links and Mailing Lists</A></H3>
 
-There are two mailing lists for ACL2 users.  You can post messages to these
+There are three mailing lists for ACL2 users.  You can post messages to these
 lists only if you are a member.
 <ul>
 <li><CODE><A
 HREF="mailto:acl2-help@utlists.utexas.edu">acl2-help@utlists.utexas.edu</A></CODE><br>
-ACL2 help list, for questions about using ACL2.
+ACL2 help list, for questions about using
+  ACL2 <font color="red">(recommended for new users)</font></li>
 <li><CODE><A
 HREF="mailto:acl2@utlists.utexas.edu">acl2@utlists.utexas.edu</A></CODE><br>
-General ACL2 list for users and others interested in ACL2.
+General ACL2 list for users and others interested in ACL2</li>
+<li><CODE><A
+HREF="mailto:acl2-books@googlegroups.com">acl2-books@googlegroups.com</A></CODE><br>
+Mailing list for discussion of cutting-edge developments in ACL2
+and the ACL2 Community Books</li>
 </ul>
 
 You may subscribe to or unsubscribe from these
 lists, or view their archives, at:
 <ul>
-<li>(<b>acl2</b> list) <code><a href="https://utlists.utexas.edu/sympa/info/acl2">https://utlists.utexas.edu/sympa/info/acl2</a></code></li>
 <li>(<b>acl2-help</b> list) <code><a href="https://utlists.utexas.edu/sympa/info/acl2-help">https://utlists.utexas.edu/sympa/info/acl2-help</a></code></li>
+<li>(<b>acl2</b> list) <code><a href="https://utlists.utexas.edu/sympa/info/acl2">https://utlists.utexas.edu/sympa/info/acl2</a></code></li>
+<li>(<b>acl2-books Google Group</b>
+  list) <code><a href="https://groups.google.com/forum/#!forum/acl2-books">https://groups.google.com/forum/#!forum/acl2-books</a></code></li>
 </ul>
 
 <P>
@@ -132,7 +139,7 @@
 <BR><HR><BR>
 <H3><A NAME="License-and-Copyright">License and Copyright</A></H3>
 
-ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp<BR>
+ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp<BR>
 Copyright (C) 2013, Regents of the University of Texas
 <P>
 This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -140,13 +147,13 @@
 <P>
 This program is free software; you can redistribute it and/or modify
 it under the terms of
-the <a href="../distrib/acl2-sources/LICENSE">LICENSE</a> file
+the <a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2-sources/LICENSE">LICENSE</a> file
 distributed with ACL2.
 <P>
 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-<a href="../distrib/acl2-sources/LICENSE">LICENSE</a> for more details.
+<a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2-sources/LICENSE">LICENSE</a> for more details.
 <P>
 Matt Kaufmann (Kaufmann@cs.utexas.edu)<BR>
 J Strother Moore (Moore@cs.utexas.edu)<BR>
diff -Nru acl2-6.2/doc/HTML/installation/obtaining-and-installing.html acl2-6.3/doc/HTML/installation/obtaining-and-installing.html
--- acl2-6.2/doc/HTML/installation/obtaining-and-installing.html	2013-06-07 04:13:23.000000000 +0000
+++ acl2-6.3/doc/HTML/installation/obtaining-and-installing.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Obtaining and Installing ACL2</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Obtaining and Installing ACL2</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -31,7 +31,6 @@
     a Unix-like Systems</A>
     <LI><A HREF="#Build-Particular">Building an Executable Image on Some Particular Systems</A>
     <UL>
-      <LI><A HREF="#Mac-OS-X-GCL">Special Case: Building an Executable Image on Mac OS X using GCL</A>
       <LI><A HREF="#Windows-GCL">Special Case: Building an Executable Image on a Windows System using GCL</A>
       <LI><A HREF="windows-gcl-jared.html">Older instructions from Jared Davis for
       building ACL2 on Windows using mingw</A>
@@ -51,9 +50,9 @@
 
 <p>
 
-First, create a directory in which to store ACL2 Version 6.2.  We will
+First, create a directory in which to store ACL2 Version 6.3.  We will
 call this directory <I>dir</I>.  For example, <I>dir</I> might be
-<CODE>/home/jones/acl2/v6-2</CODE>.
+<CODE>/home/jones/acl2/v6-3</CODE>.
 
 <H3>NOTE: If you intend to obtain an incremental release (e.g. 2.9.4 as opposed
 to 2.9), please see the <a href="../new.html">ACL2 News</a> for instructions.
@@ -78,7 +77,7 @@
 <p>
 
 WARNING: Some of these packages might be for old version of ACL2.  We
-recommend that you use the latest version of ACL2 (Version 6.2).
+recommend that you use the latest version of ACL2 (Version 6.3).
 
 <UL>
 
@@ -105,7 +104,7 @@
 the certificate (<code>.cert</code>) files are automatically
 fixed, according to the full pathname of your <code>books/</code> directory.)
 Also see
-the <a href="http://www.cs.utexas.edu/users/moore/acl2/current/ACL2-SEDAN.html">ACL2
+the <a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/ACL2-SEDAN.html">ACL2
 documentation topic on the ACL2 Sedan</a>.
 
 
@@ -217,10 +216,10 @@
 
 <UL>
 
-<LI>Save <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/acl2.tar.gz">
+<LI>Save <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2.tar.gz">
     acl2.tar.gz</A> on directory <I>dir</I>.  (You can
     run <code>md5sum</code> and compare
-    with <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/acl2-tar-gz-md5sum">
+    with <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2-tar-gz-md5sum">
     acl2-tar-gz-md5sum</A> if you wish to verify the transmission.)
   </LI>
 <BR>
@@ -250,18 +249,18 @@
 <UL>
 
   <li><b>Easy download.</b>
-    Fetch <CODE><A HREF="http://acl2-books.googlecode.com/files/books-6.2.tar.gz">a
+    Fetch <CODE><A HREF="http://acl2-books.googlecode.com/files/books-6.3.tar.gz">a
     gzipped tarfile</A></CODE> of the community books from the Google Code website, and then
     extract as follows to create a <code>books/</code>
     subdirectory:<BR>
 
-    <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz books-6.2.tar.gz</code>
+    <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz books-6.3.tar.gz</code>
   </li>
 
   <li><b><font color="red">OR</font></b>, obtain a read-only copy
     using svn as a new subdirectory, <code>books/</code>:<br>
 
-      <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svn checkout http://acl2-books.googlecode.com/svn/branches/6.2 books</code>
+      <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svn checkout http://acl2-books.googlecode.com/svn/branches/6.3 books</code>
   </li>
 	
   <li><b><font color="red">OR</font></b>, for read-write access,
@@ -270,7 +269,7 @@
     (see <a href="https://code.google.com/p/acl2-books/">the
     acl2-books project page</a>). Then:<br>
 	  
-    <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svn checkout https://acl2-books.googlecode.com/svn/branches/6.2 books --username &lt;name&gt;</code>
+    <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svn checkout https://acl2-books.googlecode.com/svn/branches/6.3 books --username &lt;name&gt;</code>
   </li>
   <BR>
 
@@ -285,8 +284,8 @@
 follows, using the following links to the Google Code website.
 
 <UL>
-<LI><A HREF="http://acl2-books.googlecode.com/files/workshops-6.2.tar.gz">ACL2 Workshops books</A></LI>
-<LI><A HREF="http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz">ACL2(r) books</A></LI>
+<LI><A HREF="http://acl2-books.googlecode.com/files/workshops-6.3.tar.gz">ACL2 Workshops books</A></LI>
+<LI><A HREF="http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz">ACL2(r) books</A></LI>
 </UL>
 
 Then put the gzipped tarfile(s) in
@@ -294,8 +293,8 @@
 directory, and extract to create <CODE>workshops/</CODE>
 and <CODE>nonstd/</CODE> subdirectories, respectively:<BR>
 
-<CODE>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz workshops-6.2.tar.gz</CODE><BR>
-<CODE>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz nonstd-6.2.tar.gz</CODE>
+<CODE>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz workshops-6.3.tar.gz</CODE><BR>
+<CODE>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz nonstd-6.3.tar.gz</CODE>
 
 </UL>
 
@@ -331,7 +330,7 @@
 <H3><A NAME="Pre-Built-Images">Short Cut:  Pre-Built ACL2 Images</A></H3>
 
 The site <a
-href="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/images/Readme.html">http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/images/Readme.html</a>
+href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html">http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html</a>
 contains links to ACL2 executables and packages.  Each <code>-md5sum</code> file
 was created using <code>md5sum</code>.  We may add additional
 links from time to time.
@@ -515,7 +514,6 @@
 Subtopics of this section are as follows.
 
     <UL>
-      <LI><A HREF="#Mac-OS-X-GCL">Special Case: Building an Executable Image on Mac OS X using GCL</A>
       <LI><A HREF="#Windows-GCL">Special Case: Building an Executable Image on a Windows System using GCL</A>
       <LI><A HREF="windows7.html">Instructions from David Rager
       for building ACL2 on Windows</A>
@@ -524,17 +522,6 @@
     </UL>
 
 <BR><HR><BR>
-<H3><A NAME="Mac-OS-X-GCL"></A>How to build/install ACL2 on GCL on Mac OS X</H3>
-
-If you want to build/install ACL2 on Mac OS X, you may find it easier to do so
-on top of <a href="requirements.html#Obtaining-CCL">CCL</a> rather than
-<a href="requirements.html#Obtaining-GCL">GCL</a>.  Otherwise, see <A
-HREF="requirements.html#gcl-mac">the directions for bulding GCL on Mac OS
-X</A>.  Then follow the usual installation instructions to <A
-HREF="#Sources">obtain the ACL2 sources</A> and <A
-HREF="#Other-Unix">build an executable image</A> on a Unix-like system.
-
-<BR><HR><BR>
 <H3><A NAME="Windows-GCL">Special Case: Building an Executable Image on a Windows System using GCL</A></H3>
 
 You may want to skip this section and instead read <A
@@ -592,12 +579,12 @@
     may be called
 <code>saved_acl2.exe</code> rather than <code>saved_acl2</code>.
 
-<!-- NOTE to developers: v6-2 below indicates a normal release, which is OK. -->
+<!-- NOTE to developers: v6-3 below indicates a normal release, which is OK. -->
 <!-- Do not edit that for incremental releases. -->
 
 <li><b>FINALLY</b>, create a file <code>acl2.bat</code> as explained in
-<code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/images/Readme.html#acl2-bat">
-http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/images/Readme.html</a></code>.
+<code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html#acl2-bat">
+http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html</a></code>.
 
 </ol>
 
@@ -695,30 +682,39 @@
 <BR><HR noshade size=8><BR>
 <H2><A NAME="Summary">Summary of Distribution</A></H2>
 
-The distribution includes the following.  A list of all files in
-<CODE>acl2-sources</CODE> may be found in the file <CODE>all-files.txt</CODE>
-in that directory.
+The ACL2
+    distribution, <code><A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2.tar.gz">
+    acl2.tar.gz</A></code>, includes the ACL2 source files as well as
+    the following files and directories (and a few others not
+    mentioned here).  Note that a <code>books/</code> directory
+    is <b>not included</b>; see instructions above to fetch the community
+    books.
 <PRE>
-Readme.html; This file
-acl2-sources/
-  LICENSE  ; ACL2 license file
-  GNUmakefile ; For GNU make
-  TAGS     ; Handy for looking at source files with emacs
-  *.lisp   ; ACL2 source files
-  all-files.txt    ; List of all files in this directory and subdirectories
-  books/   ; NOT INCLUDED; see instructions above to fetch community books
-  doc/     ; ACL2 documentation in various formats
-  emacs/   ; Miscellaneous emacs and file utilities, especially emacs-acl2.el
-  init.lisp; Useful for building the system
-  saved/   ; Empty directory for backing up copies during make; not important
-acl2.tar.gz; gzip'd tar file containing all of acl2-sources/ (see below)
-images/    ; Some gzip'd tar'd executables; see images/Readme.html
-split/     ; The result of splitting up acl2.tar.gz; see split/Readme.html
+  LICENSE       ; ACL2 license file
+  GNUmakefile   ; For GNU make
+  TAGS          ; Handy for looking at source files with emacs
+  doc/          ; ACL2 documentation in various formats
+  emacs/        ; Some helpful emacs utilities
+  installation/ ; Installation instructions (start with installation.html)
+  saved/        ; Empty directory for backing up copies during make
 </PRE>
 
+Also available are the following.
+
+<ul>
+
+<li><code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/">images/</a></code>:
+Some gzip'd tar'd executables; see <code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html">images/Readme.html</a></code></li>
+
+<li><code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/split/">split/</a></code>: The result of splitting up <code>acl2.tar.gz</code></li>
+
+</ul>
+
 <P>
-The entire acl2.tar.gz is about 7MB, which extracts to
-about 30MB.  The gzipped tarfile books-6.2.tar.gz (obtained as described
+Based on the preceding ACL2 release, we estimate that the
+entire <code>acl2.tar.gz</code> is about 7MB, which extracts to about
+30MB, and the gzipped tarfile <code>books-6.3.tar.gz</code> (obtained
+as described
 <a href="#Obtaining-books">above</a>) is about 12MB, which extracts to
 about 70MB.  Additional space is required to build an image, perhaps
 50 to 300 megabytes depending on the platform (including the host
diff -Nru acl2-6.2/doc/HTML/installation/requirements.html acl2-6.3/doc/HTML/installation/requirements.html
--- acl2-6.2/doc/HTML/installation/requirements.html	2013-06-07 04:13:23.000000000 +0000
+++ acl2-6.3/doc/HTML/installation/requirements.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Requirements</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Requirements</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -8,9 +8,19 @@
 
 <b><font>[<a href="installation.html">Back to main page of Installation Guide.</a>]</font></b>
 
-<p>
+<p><hr size=3 noshade><p>
+
+ACL2 Version 6.3<br>
+Copyright (C) 2013, Regents of the University of Texas<br>
+ACL2 is licensed under the terms of the LICENSE file distributed with
+ACL2.
+
+<p><hr size=3 noshade><p>
+
+<H3>Table of Contents</H3>
 
 <UL>
+  <LI><A HREF="#Performance">Performance comparisons</A>
   <LI><A HREF="#Obtaining-Lisp">Obtaining Common Lisp</A> (alphabetical listing)
   <UL>
     <LI><A HREF="#Obtaining-Allegro">Obtaining Allegro Common Lisp</A>
@@ -21,14 +31,17 @@
     <LI><A HREF="#Obtaining-LispWorks">Obtaining LispWorks</A>
     <LI><A HREF="#Obtaining-SBCL">Obtaining SBCL</A>
   </UL>
-  <LI><A HREF="#Performance">Performance comparisons</A>
 </UL>
 
 <p><hr size=3 noshade><p>
 
-ACL2 Version 6.2 Copyright (C), Regents of the University of Texas
-ACL2 is licensed under the terms of the LICENSE file distributed with
-ACL2.
+<H3><A NAME="Performance">Performance comparisons</A></H3>
+
+You can see recent performance numbers by following <a
+href="http://www.cs.utexas.edu/users/moore/acl2/current/new.html#performance">this
+link</a>, or by going to the <a
+href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2 home page</a>
+and following the link "Recent changes to this page".
 
 <H3><A NAME="Obtaining-Lisp">Obtaining Common Lisp</A></H3>
 
@@ -50,9 +63,6 @@
 
 <p>
 
-Often we put timing comparisons
-between different lisps in the <a href="http://www.cs.utexas.edu/users/moore/acl2/current/new.html">ACL2 News</a>.
-
 <P><B><A NAME="Obtaining-Allegro">Obtaining Allegro Common Lisp</A></B><P>
 
 The website for Allegro Common Lisp, a commercial implementation, is
@@ -88,14 +98,35 @@
 </pre>
 
 Note: if you prefer the latest release, you can obtain that instead,
-for example as follows.
+for example as follows (but replace "1.9" by the latest version,
+for example as described
+at <code>http://ccl.clozure.com/download.html</code>, and
+replace <code>linuxx86</code> if appropriate as described above).
 
 <pre>
-svn co http://svn.clozure.com/publicsvn/openmcl/release/1.3/linuxx86/ccl
+svn co http://svn.clozure.com/publicsvn/openmcl/release/1.9/linuxx86/ccl
 </pre>
 
-Then create a suitable script, say as follows, where <code>DIR</code>
-is the directory above the new <code>ccl</code> directory.
+Next rebuild the executable by issuing the following commands, but
+replace "<code>./lx86cl64</code>" by a suitable executable; e.g., for
+64-bit Darwin (on Mac OS) use "<code>./dx86cl64</code>".
+
+<hr>
+<pre>
+./lx86cl64
+(rebuild-ccl :full t)
+(quit)
+./lx86cl64
+(rebuild-ccl :full t)
+(quit)
+</pre>
+<hr>
+
+<p>
+
+Now your CCL executable is up to date.  Next, create a suitable
+script, say as follows, where <code>DIR</code> is the full pathname
+for the directory above the new <code>ccl</code> directory.
 
 <hr>
 <pre>
@@ -120,14 +151,6 @@
 chmod +x my-script
 </pre>
 
-Now rebuild the CCL lisp image by invoking the above script and then
-executing the following commands.
-
-<pre>
-(ccl:rebuild-ccl :full t)
-(quit)
-</pre>
-
 Your script (invoked with a suitable pathname, or just the filename if
 the directory is on your path) will now start the updated CCL lisp
 image.
@@ -166,94 +189,81 @@
 
 <P><B><A NAME="Obtaining-GCL">Obtaining GCL</A></B><P>
 
-You do not need to fetch GCL if instead
-you <A HREF="http://packages.qa.debian.org/a/acl2.html">download a
+You might be able
+to <A HREF="http://packages.qa.debian.org/a/acl2.html">download a
 binary Debian package for ACL2</A>.  Thanks to Camm Maguire for
-maintaining this package.  Note that it may take some time after each
-ACL2 release for this binary Debian package to be updated for that
-release.  Here is a shell command that might be used to obtain that
-package.
+maintaining this package.  Note however that it may take some time
+after each ACL2 release for this binary Debian package to be updated
+for that release.  Here is a shell command that might be used to
+obtain that package (if running Debian).
 
 <pre>
-apt-get -q install gcl gcl-doc if running Debian
+apt-get -q install gcl gcl-doc
 </pre>
 
-Otherwise, you can fetch GCL in one of the ways described below.  Note
-that in Spring 2013 there were updates to GCL, reflected in ACL2, that
-allow ACL2 (starting with ACL2 Version 6.2) to build not only on
-traditional ("CLtL1") GCL but also on ANSI GCL.
-
-<p>
-
-The simplest way may be to fetch a recent version of GCL from
-  the <a href="http://www.gnu.org/software/gcl/">main GNU website for
-  GCL</a>.  The main GCL implementor has told us that he hopes to make
-  suitable versions of GCL Version 2.6.8 and GCL Version 2.6.9
-  available in tarball form at that website in approximately mid-June,
-  2013.
-
-<p>
-
-Another way to fetch a recent GCL is with the following command.  This
-particular command will retrieve recent development/unstable cvs
-sources.
+Otherwise, it should be easy to obtain and build GCL yourself.  There
+are two recommended versions of GCL for building ACL2: GCL 2.6.8 and
+GCL 2.6.10.  (GCL 2.6.9, which is <i>not</i> recommended, has some
+issues that were fixed in GCL 2.6.10.)  GCL 2.6.8 appears to be faster
+for ACL2 regressions than GCL 2.6.10; we obtained the following
+times on a 64-bit Linux system using a development snapshot of ACL2 as
+of Sept. 23, 2013.
 
 <pre>
-cvs -z9 -q -d:pserver:anonymous@cvs.sv.gnu.org:/sources/gcl \
-     co -d gcl-2.6.8pre -r Version_2_6_8pre gcl
-</pre>
+   ACL2 built on non-ANSI GCL 2.6.8:
+   33235.713u 1275.991s 1:29:23.91 643.4%	0+0k 156624+4638504io 25pf+0w
 
-As per GCL installation instructions, you may wish to build GCL as
-follows on a 64-bit linux machine, instead
-using <code>--enable-maxpage=524288</code> on a 32-bit linux machine,
-and perhaps <code>--enable-maxpage=262144</code> on a Mac.
+   ACL2 built on non-ANSI GCL 2.6.10pre:
+   40678.982u 1013.967s 1:45:06.91 661.0%	0+0k 153400+6615176io 9pf+0w
 
-<pre>
-./configure --enable-maxpage=1048576
-make
+   ACL2 built on ANSI GCL 2.6.10pre:
+   67950.466u 1050.753s 2:44:58.65 697.0%	0+0k 327160+6955712io 7pf+0w
 </pre>
 
-You can build an ANSI image by adding <code>--enable-ansi</code> to
-the above <code>./configure</code> command.  Alternatively, you might
-find suitable prebuilt binaries for a variety of machines here:
-<br>
-<code><a href="http://packages.debian.org/search?keywords=gcl">http://packages.debian.org/search?keywords=gcl</a></code>
+On the other hand, modern Common Lisp implementations are ANSI
+compliant, and GCL 2.6.10 may have better ANSI support (which is
+needed if you choose to build
+<a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/HONS-AND-MEMOIZATION.html">ACL2(h)</a>).
 
 <p>
 
-<!--
+As of this writing (late September 2013), it might be best to fetch
+GCL 2.6.8 for most purposes but GCL 2.6.10 if for some reason you want
+an ANSI build of GCL.  You can fetch it as a tarball from
+<a href="http://www.gnu.org/software/gcl/">main GNU website for
+  GCL</a>.
+From GCL source you can build an executable by extracting from the
+  tarball, standing in the resulting <code>gcl/</code> directory, and
+  issuing one of the following commands.
 
-Through Version_6.1 we included the following instructions, saying
-that "GCL maintainer Camm Maguire has suggested the following, in
-order of preference (most to least):", as an ordered list:
-
-apt-get -q install gcl gcl-doc if running Debian
-Download and install the prebuilt binaries otherwise (if available for your platform)
-Download the latest (stable) source tarball and build yourself otherwise
-Download the latest (stable) cvs branch and build yourself
+<pre>
+# Recommended for 64-bit Linux:
+./configure --enable-maxpage=1048576 && make
 
-However, it's not clear how helpful those instructions are, as opposed
-simply to spelling some things out as has been done above.
+# Recommended for Mac OS:
+./configure && make
 
--->
+# If you want an ANSI build
+# (but add "--enable-maxpage=1048576" as above for linux):
+./configure --enable-ansi && make
+</pre>
 
-<!--
-Through Version_6.1 there were instructions here from Robert Krug for
-building on a Mac.  But Matt Kaufmann built ACL2 on a Mac in May,
-2013, by following normal GCL instructions, modified as shown below.
--->
+As of late September 2013, GCL 2.6.10 is not yet available as a
+tarball.  However, you can get a pre-release (which we expect to work
+fine, having used it successfully ourselves) like this (assuming you
+have <code>git</code> installed):
 
-<p>
+<pre>
+git clone git://git.sv.gnu.org/gcl.git
+cd gcl
+git checkout Version_2_6_10pre
+cd gcl
+</pre>
 
-<i>Note</i>: On rare occasions you may see a hard error when using GCL
-obtained before early June, 2013, sometimes (not always) labeled as
-"bad plist", that may be due to interaction between GCL and GNU Make.
-The main GCL implementor has told us that he has fixed this problem,
-and will provide tarballs at
-the <a href="http://www.gnu.org/software/gcl/">main GNU website for
-  GCL</a> in approximately mid-June, 2013 (as noted above).
+Then run <code>configure</code> and <code>make</code> as indicated
+above.
 
-<P>
+<p>
 
 <P><B><A NAME="Obtaining-LispWorks">Obtaining LispWorks</A></B><P>
 
@@ -271,6 +281,8 @@
 
 <p>
 
+<!-- I don't know that we need this comment any longer, since we write
+    a suitable --dynamic-space-size argument to saved_acl2 scripts.
 Note for 32-bit linux users: When building ACL2 with SBCL 1.0.18 and
 1.0.39 on 32-bit Linux, we ran out of memory with the SBCL message
 "Heap exhausted, game over."  We solved the problem by modifying our
@@ -286,14 +298,7 @@
 
 Your results may vary; one user has reported solving the problem with
 <code>--dynamic-space-size 2000000000</code>.
-
-<H3><A NAME="Performance">Performance comparisons</A></H3>
-
-You can see recent performance numbers by following <a
-href="http://www.cs.utexas.edu/users/moore/acl2/current/new.html#performance">this
-link</a>, or by going to the <a
-href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2 home page</a>
-and following the link "Recent changes to this page".
+-->
 
 <p>
 
diff -Nru acl2-6.2/doc/HTML/installation/using.html acl2-6.3/doc/HTML/installation/using.html
--- acl2-6.2/doc/HTML/installation/using.html	2013-06-07 04:13:23.000000000 +0000
+++ acl2-6.3/doc/HTML/installation/using.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Using ACL2</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Using ACL2</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -63,7 +63,7 @@
 <I>dir</I><CODE>/acl2-sources/saved_acl2</CODE><BR>
 <BR><BR>
 
-Note: A carriage return in the file after the last line above is important!
+Note: A carriage return in the file after the last line above may be important!
 <P>
 
 <BR>
@@ -72,13 +72,13 @@
 When you invoke ACL2, you should see the host Common Lisp 
 print a header concerning the ACL2 version, license and copyright.
 <P>
-Some hosts then automatically enter the ACL2 ``command loop,'' an ACL2
+Most or all hosts then automatically enter the ACL2 ``command loop,'' an ACL2
 read-eval-print loop with the prompt:
 <PRE>
 ACL2 !>
 </PRE>
-Other hosts will leave you in Common Lisp's read-eval-print loop.
-If yours is one of the latter, evaluate the Common Lisp expression
+If however a host leaves you in Common Lisp's read-eval-print loop,
+then you'll need to evaluate the Common Lisp expression
 <CODE>(ACL2::LP)</CODE> or simply <CODE>(LP)</CODE> if the current
 package is <CODE>"ACL2"</CODE>.
 <P>
@@ -181,7 +181,7 @@
 The <CODE>certify-books</CODE> target does not cause <code>workshops/</code> books to
 be certified.  If you want to certify those books as well, you will
 first need to
-<a href="http://acl2-books.googlecode.com/files/workshops-6.2.tar.gz">download
+<a href="http://acl2-books.googlecode.com/files/workshops-6.3.tar.gz">download
 the gzipped tar file of the workshops books</a>
 from the Google Code website to
 the <CODE>books/</CODE> directory, and then gunzip and extract it
@@ -240,7 +240,7 @@
 read with an interactive browser.  The documentation is available in
 several formats: HTML, Texinfo, Postscript and ACL2 documentation
 strings, and more recently,
-in <a href="http://fv.centtech.com/acl2/6.2/doc/">web-browsable form
+in <a href="http://fv.centtech.com/acl2/latest/doc/">web-browsable form
 with some community books' documentation</a>, courtesy of Jared Davis.  The ACL2
 documentation is copyrighted by the Regents of the University of Texas
 under the terms of the LICENSE file distributed with ACL2.
@@ -309,12 +309,13 @@
 
 <P><B>Postscript</B><P>
 
-The Postscript version of the documentation is not included in our normal
-distribution because it is so much less useful than the hyper-text versions.
-But a <A
-HREF="http://www.cs.utexas.edu/users/moore/publications/acl2-book.ps.gz">gzipped
-Postscript (2.5 MB)</A> version is available.  It prints as a book of over 2100
-pages and contains a Table of Contents and an index to all documented topics.
+The Postscript version of the documentation is not included in our
+normal distribution because it is so much less useful than the
+hyper-text versions.  But
+a <A HREF="http://www.cs.utexas.edu/users/moore/publications/acl2-book.ps.gz">gzipped
+Postscript (2.6 MB)</A> version is available.  It prints as a book of
+over 2200 pages and contains a Table of Contents and an index to all
+documented topics.
 
 <P><B>ACL2 Documentation Strings</B><P>
 
diff -Nru acl2-6.2/doc/HTML/new.html acl2-6.3/doc/HTML/new.html
--- acl2-6.2/doc/HTML/new.html	2013-06-07 04:13:23.000000000 +0000
+++ acl2-6.3/doc/HTML/new.html	2013-09-30 17:39:24.000000000 +0000
@@ -1,21 +1,27 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 News</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 News</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
 
-<H1><A NAME="top"><a href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2</a> Version 6.2 News</A></H1>
+<H1><A NAME="top"><a href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2</a> Version 6.3 News</A></H1>
 
 <H2>Table of Contents</H2>
 
 <ul>
 
+<LI><A HREF="#svn">ACL2 sources availability between releases</A></LI>
 <LI><A HREF="#vstte-12">VSTTE 2012 Competition</A></LI>
 <LI><A HREF="#acl2-books">ACL2 Books Repository</A></LI>
 <LI><A HREF="#performance">Performance Comparisons</A></LI>
 
 </ul>
 
+<A NAME="svn"><H2>ACL2 sources availability between releases</H2>
+
+ACL2 sources are now available between releases, as described in
+<a href="svn-availability.txt">this announcement</a>.
+
 <A NAME="vstte-12"><H2>VSTTE 2012 Competition</H2>
 
 A team of four ACL2 users entered the VSTTE 2012 competition.  For
diff -Nru acl2-6.2/doc/HTML/other-releases.html acl2-6.3/doc/HTML/other-releases.html
--- acl2-6.2/doc/HTML/other-releases.html	2013-06-07 04:13:23.000000000 +0000
+++ acl2-6.3/doc/HTML/other-releases.html	2013-09-30 17:39:24.000000000 +0000
@@ -6,13 +6,13 @@
 
 The current ACL2 release on the <a
 href="http://www.cs.utexas.edu/users/moore/acl2/index.html">ACL2 home page</a>
-is Version 6.2 (June, 2013).
+is Version 6.3 (October, 2013).
 
 <p>
 
 This page contains:
 <ul>
-<li><h2>Incremental releases since Version 6.2 (if any)</h2></li>
+<li><h2>Incremental releases since Version 6.3 (if any)</h2></li>
 <li><h2>Past releases</h2></li>
 </ul>
 
@@ -20,13 +20,14 @@
 
 <hr size=3 noshade>
 
-<h2><a name="incremental">Incremental releases since Version 6.2:</a></h2>
+<h2><a name="incremental">Incremental releases since Version 6.3:</a></h2>
 
 <i>None</i>
 
 <h2><a name="past">Past releases:</a></h2>
 
 <ul>
+<li><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-2/index.html">Version 6.2 (June, 2013)</a></li>
 <li><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-1/index.html">Version 6.1 (February, 2013)</a></li>
 <li><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-0/index.html">Version 6.0 (December, 2012)</a></li>
 <li><a href="http://www.cs.utexas.edu/users/moore/acl2/v5-0/index.html">Version 5.0 (August, 2012)</a></li>
diff -Nru acl2-6.2/doc/acl2-code-size.txt acl2-6.3/doc/acl2-code-size.txt
--- acl2-6.2/doc/acl2-code-size.txt	2013-06-07 04:13:57.000000000 +0000
+++ acl2-6.3/doc/acl2-code-size.txt	2013-09-30 17:40:02.000000000 +0000
@@ -1,11 +1,11 @@
 
 CODE LINES:
-  113174 lines,   4971207 characters
+  113739 lines,   4996452 characters
 COMMENT LINES:
-   63721 lines,   3766225 characters
+   64062 lines,   3785153 characters
 BLANK LINES (excluding documentation):
-   27174 lines,     27072 characters
+   27307 lines,     27205 characters
 DOCUMENTATION LINES:
-   92044 lines,   4133723 characters
+   93602 lines,   4206856 characters
 TOTAL:
-  296113 lines,  12898227 characters
+  298710 lines,  13015666 characters
diff -Nru acl2-6.2/doc/create-acl2-tex acl2-6.3/doc/create-acl2-tex
--- acl2-6.2/doc/create-acl2-tex	2012-11-08 00:40:08.000000000 +0000
+++ acl2-6.3/doc/create-acl2-tex	2013-08-25 17:27:37.000000000 +0000
@@ -38,10 +38,11 @@
 
 cd doc/TEX
 
-# Note: At UT CS we typically use an old version of texinfo.tex stored at
-# /projects/acl2/devel-misc/doc/texinfo.tex
-# in order to build the documentation.  But anyone can build it using the
-# default texinfo.tex.
+# Note: At UT CS we typically use an old version of texinfo.tex stored
+# at /projects/acl2/devel-misc/doc/texinfo.tex in order to build the
+# documentation, which seems to result in more pages with an arguably
+# more attractive result.  But anyone can build it using the default
+# texinfo.tex.
 if [ -e ../texinfo.tex ] ; then \
     cp ../texinfo.tex . ;\
 fi
diff -Nru acl2-6.2/doc/write-acl2-html.lisp acl2-6.3/doc/write-acl2-html.lisp
--- acl2-6.2/doc/write-acl2-html.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/doc/write-acl2-html.lisp	2013-09-29 21:48:20.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 was produced by modifying ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/doc/write-acl2-texinfo.lisp acl2-6.3/doc/write-acl2-texinfo.lisp
--- acl2-6.2/doc/write-acl2-texinfo.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/doc/write-acl2-texinfo.lisp	2013-09-29 21:48:29.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 was produced by modifying ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/emacs/emacs-acl2.el acl2-6.3/emacs/emacs-acl2.el
--- acl2-6.2/emacs/emacs-acl2.el	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/emacs/emacs-acl2.el	2013-09-29 21:48:37.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -355,9 +355,9 @@
   (push-mark) ; I think I sometimes like to go back to the form.
   (let ((str (acl2-current-form-string)))
     (switch-to-buffer *acl2-shell*)
-    (end-of-buffer)
+    (goto-char (point-max))
     (insert str))
-  (end-of-buffer) ; harmless; seemed necessary at one point
+  (goto-char (point-max)) ; harmless; seemed necessary at one point
   )
 
 (defun enter-theorem-other-window ()
@@ -366,7 +366,7 @@
   (let ((str (acl2-current-form-string)))
     (other-window 1)
     (switch-to-buffer *acl2-shell*)
-    (end-of-buffer)
+    (goto-char (point-max))
     (insert str)))
 
 (defun event-name ()
@@ -405,7 +405,7 @@
       (forward-sexp)
       (end-of-line)
       (open-line 1)
-      (next-line 1)
+      (forward-line 1)
       (insert ")")
       (lisp-indent-line))))
 
@@ -466,7 +466,7 @@
 	(end (max (point) (mark))))
     (write-region-for-shell beg end)
     (switch-to-buffer *acl2-shell*)
-    (end-of-buffer)
+    (goto-char (point-max))
     (insert message)))
 
 (defun acl2-load ()
@@ -527,7 +527,7 @@
 	       (car (read-from-string (acl2-current-form-string t)))
 	       t)))
     (cond (name (switch-to-buffer *acl2-shell*)
-		(end-of-buffer)
+		(goto-char (point-max))
 		(insert (format ":ubt! %s" name)))
 	  (t (error "ERROR: Unable to find event name for undoing.")))))
 
diff -Nru acl2-6.2/emacs/monitor.el acl2-6.3/emacs/monitor.el
--- acl2-6.2/emacs/monitor.el	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/emacs/monitor.el	2013-09-29 21:48:45.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/futures-raw.lisp acl2-6.3/futures-raw.lisp
--- acl2-6.2/futures-raw.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/futures-raw.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -1412,7 +1412,8 @@
 ; Returns t if there are futures still in the work-queue to process or if there
 ; are futures already being processed.
 
-  (< 1 *unassigned-and-active-future-count*))
+  (< 1 (atomically-modifiable-counter-read
+        *unassigned-and-active-future-count*)))
 
 
 ;---------------------------------------------------------------------
diff -Nru acl2-6.2/history-management.lisp acl2-6.3/history-management.lisp
--- acl2-6.2/history-management.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/history-management.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -2824,8 +2824,13 @@
    (time-tracker :tau :init
                  :times '(1 5)
                  :interval 10
-                 :msg "Elapsed runtime in tau is ~st secs; see :DOC ~
-                       time-tracker-tau.~|~%")
+                 :msg (concatenate
+                       'string
+                       (if (f-get-global 'get-internal-time-as-realtime
+                                         state)
+                           "Elapsed realtime"
+                         "Elapsed runtime")
+                       " in tau is ~st secs; see :DOC time-tracker-tau.~|~%"))
    (pprogn (cond ((null (cdr (get-timer 'other-time state))) ; top-level event
                   (mv-let (x state)
                           (main-timer state)
@@ -2926,30 +2931,44 @@
    (pop-timer 'proof-tree-time t state)
    (pop-timer 'other-time t state)))
 
-(defun print-steps-summary (state)
-  (io? summary nil state
-       ()
-       (cond
-        ((member-eq 'steps
-                    (f-get-global 'inhibited-summary-types
-                                  state))
-         state)
-        (t (let* ((channel (proofs-co state))
-                  (rec (f-get-global 'step-limit-record state))
-                  (start (assert$ rec
-                                  (access step-limit-record rec :start)))
-                  (last-limit (assert$ start
-                                       (f-get-global 'last-step-limit state))))
-             (cond ((and last-limit
-                         (not (int= start last-limit)))
-                    (pprogn (princ$ "Prover steps counted:  " channel state)
-                            (cond ((eql last-limit -1)
-                                   (pprogn
-                                    (princ$ "More than " channel state)
-                                    (princ$ start channel state)))
-                                  (t (princ$ (- start last-limit) channel state)))
-                            (newline channel state)))
-                   (t state)))))))
+(defun prover-steps (state)
+
+; Returns nil if no steps were taken (or if state global 'last-step-limit is
+; nil, though that may be impossible).  Otherwise returns the (positive) number
+; of steps taken, with one exception: If the number of steps exceeded the
+; starting limit, then we return the negative of the starting limit.
+
+  (let* ((rec (f-get-global 'step-limit-record state))
+         (start (assert$ rec
+                         (access step-limit-record rec :start)))
+         (last-limit (assert$ start
+                              (f-get-global 'last-step-limit state))))
+    (cond ((and last-limit
+                (not (int= start last-limit)))
+           (cond ((eql last-limit -1)   ; more than start steps
+                  (assert$ (natp start) ; else start <= -2; impossible
+                           (- start)))
+                 (t (- start last-limit))))
+          (t nil))))
+
+(defun print-steps-summary (steps state)
+  (cond
+   ((null steps) state)
+   (t (io? summary nil state
+           (steps)
+           (cond
+            ((member-eq 'steps
+                        (f-get-global 'inhibited-summary-types
+                                      state))
+             state)
+            (t (let ((channel (proofs-co state)))
+                 (pprogn (princ$ "Prover steps counted:  " channel state)
+                         (cond ((<= steps 0)
+                                (pprogn
+                                 (princ$ "More than " channel state)
+                                 (princ$ (- steps) channel state)))
+                               (t (princ$ steps channel state)))
+                         (newline channel state)))))))))
 
 (defun print-rules-summary (state)
   (let ((acc-ttree (f-get-global 'accumulated-ttree state)))
@@ -3339,16 +3358,42 @@
 
     (erase-acl2p-checkpoints-for-summary state))))
 
-(defun print-failure (ctx state)
+(defun character-alistp (x)
+
+  ":Doc-Section ACL2::ACL2-built-ins
+
+  recognizer for association lists with characters as keys~/
+
+  ~c[(Character-alistp x)] is true if and only if ~c[x] is a list of pairs
+  of the form ~c[(cons key val)] where ~c[key] is a ~ilc[characterp].~/~/"
+
+  (declare (xargs :guard t))
+  (cond ((atom x) (eq x nil))
+        (t (and (consp (car x))
+                (characterp (car (car x)))
+                (character-alistp (cdr x))))))
+
+(defun tilde-@p (arg)
+  (declare (xargs :guard t))
+  (or (stringp arg)
+      (and (consp arg)
+           (stringp (car arg))
+           (character-alistp (cdr arg)))))
+
+(defun print-failure (erp ctx state)
   (pprogn (print-gag-state state)
           #+acl2-par
           (print-acl2p-checkpoints state)
           (io? error nil state
-               (ctx)
+               (ctx erp)
                (let ((channel (proofs-co state)))
                  (pprogn
-                  (error-fms-channel nil ctx "See :DOC failure." nil channel
-                                     state)
+                  (error-fms-channel nil ctx "~@0See :DOC failure."
+                                     (list (cons #\0
+                                                 (if (tilde-@p erp)
+                                                     erp
+                                                   "")))
+                                     channel state)
                   (newline channel state)
                   (fms *proof-failure-string* nil channel state nil))))))
 
@@ -3752,6 +3797,60 @@
 
    (f-put-global 'accumulated-ttree nil state)))
 
+(defun last-prover-steps (state)
+
+  ":Doc-Section Miscellaneous
+
+  the number of prover steps most recently taken~/
+
+  For discussions of prover step limits, ~l[set-prover-step-limit] and
+  ~pl[with-prover-step-limit].  The value of the form
+  ~c[(last-prover-steps state)] indicates the number of prover steps taken, in
+  the sense described below, for the most recent context in which an event
+  summary would normally be printed.  Note that the value of
+  ~c[(last-prover-steps state)] is updated for all ~il[events], and for all
+  other forms such as calls of ~ilc[thm] or ~ilc[certify-book], that would
+  print a summary ~-[] regardless of whether or not such output is inhibited
+  (~pl[set-inhibit-output-lst] and ~pl[set-inhibited-summary-types]).  In
+  particular, the value is updated (typically to ~c[nil]) for ~ilc[table]
+  ~il[events], even when no summary is printed; for example, the value is
+  updated to ~c[nil] for ~c[table] events such as ~c[(]~ilc[logic]~c[)],
+  ~c[(]~ilc[program]~c[)], and even calls of ~ilc[set-prover-step-limit].
+
+  The value of ~c[(last-prover-steps state)] is determined as follows, based on
+  the most recent summary context (as described above):
+  ~bq[]
+
+  ~c[nil], if no prover steps were taken; else,
+
+  the (positive) number of steps taken, if the number of steps did not exceed
+  the starting limit; else,
+
+  the negative of the starting limit.
+  ~eq[]~/
+
+  We conclude with a remark for advanced users who wish to invoke
+  ~c[last-prover-steps] in the development of utilities that track prover
+  steps.  Suppose that you want to write a utility that takes some action based
+  on the number of prover steps performed by the first ~c[defun] event that is
+  generated, among others, for example the number of prover steps taken to
+  admit ~c[f1] in the following example.
+  ~bv[]
+  (progn (defun f1 ...)
+         (defun f2 ...))
+  ~ev[]
+  A solution is to record the steps taken by the first ~ilc[defun] before
+  executing subsequent events, as follows (~pl[make-event]).
+  ~bv[]
+  (progn (defun f1 ...)
+         (make-event (pprogn (f-put-global 'my-step-count
+                                           (last-prover-steps state)
+                                           state)
+                             (value '(value-triple nil))))
+         (defun f2 ...))
+  ~ev[]~/"
+  (f-get-global 'last-prover-steps state))
+
 (defun print-summary (erp noop-flg ctx state)
 
 ; This function prints the Summary paragraph.  Part of that paragraph includes
@@ -3764,12 +3863,15 @@
 ; to print the summary or parts of it.  For example, we handle
 ; pop-warning-frame regardless of whether or not we print the warning summary.
 
-; If erp is t, the "event" caused an error and we do not scan for redefined
-; names but we do print the failure string.  If noop-flg is t then the
-; installed world did not get changed by the "event" (e.g., the "event" was
+; If erp is non-nil, the "event" caused an error and we do not scan for
+; redefined names but we do print the failure string.  If noop-flg is t then
+; the installed world did not get changed by the "event" (e.g., the "event" was
 ; redundant or was not really an event but was something like a call of (thm
 ; ...)) and we do not scan the most recent event block for redefined names.
 
+; If erp is a message, as recognized by tilde-@p, then that message will be
+; printed by the call below of print-failure.
+
   #+(and (not acl2-loop-only) acl2-rewrite-meter) ; for stats on rewriter depth
   (cond ((atom ctx))
         ((symbolp (cdr ctx))
@@ -3791,83 +3893,97 @@
                            (cdr ctx)
                            state))
                 (filename (concatenate 'string bookname ".lisp")))
-           (with-open-file (str filename
-                                :direction :output
-                                :if-exists :rename-and-delete)
-                           (format str
-                                   "~s~%"
-                                   (cons filename
-                                         (merge-sort-cdr-> *rewrite-depth-alist*)))))
+           (with-open-file
+            (str filename
+                 :direction :output
+                 :if-exists :rename-and-delete)
+            (format str
+                    "~s~%"
+                    (cons filename
+                          (merge-sort-cdr-> *rewrite-depth-alist*)))))
          (setq *rewrite-depth-alist* nil)))
 
   #-acl2-loop-only (dmr-flush)
 
-  (let ((wrld (w state)))
-    (cond
-     ((or (ld-skip-proofsp state)
-          (output-ignored-p 'summary state))
-      (pprogn (increment-timer 'other-time state)
-              (if (or erp noop-flg)
-                  state
-                (print-redefinition-warning wrld ctx state))
-              (pop-timer 'prove-time t state)
-              (pop-timer 'print-time t state)
-              (pop-timer 'proof-tree-time t state)
-              (pop-timer 'other-time t state)
-              (mv-let (warnings state)
-                      (pop-warning-frame nil state)
-                      (declare (ignore warnings))
-                      state)))
-     (t
+  (let ((wrld (w state))
+        (steps (prover-steps state)))
+    (pprogn
+     (f-put-global 'last-prover-steps steps state)
+     (cond
+      ((or (ld-skip-proofsp state)
+           (output-ignored-p 'summary state))
+       (pprogn (increment-timer 'other-time state)
+               (if (or erp noop-flg)
+                   state
+                 (print-redefinition-warning wrld ctx state))
+               (pop-timer 'prove-time t state)
+               (pop-timer 'print-time t state)
+               (pop-timer 'proof-tree-time t state)
+               (pop-timer 'other-time t state)
+               (mv-let (warnings state)
+                       (pop-warning-frame nil state)
+                       (declare (ignore warnings))
+                       state)))
+      (t
 
 ; Even if 'summary is inhibited, we still use io? below, and inside some
 ; functions below, because of its window hacking and saved-output functions.
 
-      (pprogn
-       (increment-timer 'other-time state)
-       (if (or erp noop-flg)
-           state
-         (print-redefinition-warning wrld ctx state))
        (pprogn
-        (io? summary nil state
-             ()
-             (let ((channel (proofs-co state)))
-               (cond ((member-eq 'header
-                                 (f-get-global 'inhibited-summary-types state))
-                      state)
-                     (t
-                      (pprogn (newline channel state)
-                              (princ$ "Summary" channel state)
-                              (newline channel state))))))
-        (io? summary nil state
-             (ctx)
-             (let ((channel (proofs-co state)))
-               (cond ((member-eq 'form
-                                 (f-get-global 'inhibited-summary-types state))
-                      state)
-                     (t
-                      (mv-let
-                       (col state)
-                       (fmt1 "Form:  " nil 0 channel state nil)
+        (increment-timer 'other-time state)
+        (if (or erp noop-flg)
+            state
+          (print-redefinition-warning wrld ctx state))
+        (pprogn
+         (io? summary nil state
+              ()
+              (let ((channel (proofs-co state)))
+                (cond ((member-eq 'header
+                                  (f-get-global 'inhibited-summary-types
+                                                state))
+                       state)
+                      (t
+                       (pprogn (newline channel state)
+                               (princ$ "Summary" channel state)
+                               (newline channel state))))))
+         (io? summary nil state
+              (ctx)
+              (let ((channel (proofs-co state)))
+                (cond ((member-eq 'form
+                                  (f-get-global 'inhibited-summary-types
+                                                state))
+                       state)
+                      (t
                        (mv-let
                         (col state)
-                        (fmt-ctx ctx col channel state)
-                        (declare (ignore col))
-                        (newline channel state))))))))
-       (print-rules-and-hint-events-summary state) ; call of io? is inside
-       (pprogn (print-warnings-summary state)
-               (print-time-summary state)
-               (print-steps-summary state)
-               (progn$
+                        (fmt1 "Form:  " nil 0 channel state nil)
+                        (mv-let
+                         (col state)
+                         (fmt-ctx ctx col channel state)
+                         (declare (ignore col))
+                         (newline channel state))))))))
+        (print-rules-and-hint-events-summary state) ; call of io? is inside
+        (pprogn (print-warnings-summary state)
+                (print-time-summary state)
+                (print-steps-summary steps state)
+                (progn$
 
 ; If the time-tracker call below is changed, update :doc time-tracker
 ; accordingly.
 
-                (time-tracker :tau :print?
-                              :min-time 1
-                              :msg "For the proof above, the total runtime ~
-                                    spent in the tau system was ~st seconds.  ~
-                                    See :DOC time-tracker-tau.~|~%")
+                 (time-tracker
+                  :tau :print?
+                  :min-time 1
+                  :msg
+                  (concatenate
+                   'string
+                   "For the proof above, the total "
+                   (if (f-get-global 'get-internal-time-as-realtime
+                                     state)
+                       "realtime"
+                     "runtime")
+                   " spent in the tau system was ~st seconds.  See :DOC ~
+                    time-tracker-tau.~|~%"))
 
 ; At one time we put (time-tracker :tau :end) here.  But in community book
 ; books/hints/basic-tests.lisp, the recursive proof attempt failed just below
@@ -3876,24 +3992,24 @@
 ; to avoid :end here; after all, we invoke :end before invoking :init anyhow,
 ; in case the proof was aborted without printing this part of the summary.
 
-                state))
-       (cond (erp
-              (pprogn
-               (print-failure ctx state)
-               (cond
-                ((f-get-global 'proof-tree state)
-                 (io? proof-tree nil state
-                      (ctx)
-                      (pprogn (f-put-global 'proof-tree-ctx
-                                            (cons :failed ctx)
-                                            state)
-                              (print-proof-tree state))))
-                (t state))))
-             (t (pprogn
-                 #+acl2-par
-                 (erase-acl2p-checkpoints-for-summary state)
-                 state)))
-       (f-put-global 'proof-tree nil state))))))
+                 state))
+        (cond (erp
+               (pprogn
+                (print-failure erp ctx state)
+                (cond
+                 ((f-get-global 'proof-tree state)
+                  (io? proof-tree nil state
+                       (ctx)
+                       (pprogn (f-put-global 'proof-tree-ctx
+                                             (cons :failed ctx)
+                                             state)
+                               (print-proof-tree state))))
+                 (t state))))
+              (t (pprogn
+                  #+acl2-par
+                  (erase-acl2p-checkpoints-for-summary state)
+                  state)))
+        (f-put-global 'proof-tree nil state)))))))
 
 (defun with-prover-step-limit-fn (limit form no-change-flg)
 
@@ -4019,7 +4135,9 @@
   limit on prover steps globally instead of setting it for just one form, and
   for a discussion of the notion of ``prover steps'', which could change in
   future ACL2 releases.  For a related utility based on time instead of prover
-  steps, ~pl[with-prover-time-limit].
+  steps, ~pl[with-prover-time-limit]; but as discussed in the
+  ~il[documentation] for ~ilc[set-prover-step-limit], there is at best a loose
+  connection between the counting of steps and ~ilc[with-prover-time-limit].
 
   The arguments of ~c[(with-prover-step-limit expr form)] are evaluated.
   However, the (optional) argument ~c[flg] is not evaluated in
@@ -4034,6 +4152,9 @@
   For examples of how step-limits work besides those presented below, see the
   community book ~c[books/misc/misc2/step-limits.lisp].
 
+  For a utility that returns an indicator of the number of prover steps most
+  recently taken, ~pl[last-prover-steps].
+
   Note that ~c[with-prover-step-limit] may not be called inside definitions,
   and that it is simply the identity macro in raw Lisp.  However,
   ~c[with-prover-step-limit!] may be called in place of
@@ -4825,8 +4946,7 @@
             saved-output-reversed      ;;; for feedback after expansion failure
             saved-output-p             ;;; for feedback after expansion failure
             ttags-allowed              ;;; propagate changes outside expansion
-            ld-evisc-tuple             ;;; allow user to modify this in a book
-                                       ;;;   (e.g. misc/hons-help.lisp)
+            ld-evisc-tuple             ;;; see just above
             term-evisc-tuple           ;;; see just above
             abbrev-evisc-tuple         ;;; see just above
             gag-mode-evisc-tuple       ;;; see just above
@@ -5895,7 +6015,7 @@
   ~il[world] yet not be considered to be redundant.  Here is an example of such
   a form.
   ~bv[]
-  (value-triple (cw \"Hello world.~~%\"))
+    (value-triple (cw \"Hello world.~~%\"))
   ~ev[]~/
 
   When are two ~il[logical-name] definitions considered ``the same''?  It
@@ -5962,10 +6082,11 @@
   (2) It is permissible for one definition to have a ~c[:]~il[guard] of ~c[t]
   and the other to have no explicit guard (hence, the guard is implicitly
   ~c[t]).~nl[]
-  (3) The ~c[:measure] check is avoided if we are skipping proofs (for example,
-  during ~ilc[include-book]), and otherwise, the new definition may have a
-  ~c[:measure] of ~c[(:? v1 ... vk)], where ~c[(v1 ... vk)] enumerates the
-  variables occurring in the measure stored for the old definition.~nl[]
+  (3) The ~c[:measure] check is avoided if the old definition is non-recursive
+  (and not defined within a ~ilc[mutual-recursion]) or we are skipping proofs
+  (for example, during ~ilc[include-book]).  Otherwise, the new definition may
+  have a ~c[:measure] of ~c[(:? v1 ... vk)], where ~c[(v1 ... vk)] enumerates
+  the variables occurring in the measure stored for the old definition.~nl[]
   (4) If either the old or new event is a ~ilc[mutual-recursion] event, then
   redundancy requires that both are ~ilc[mutual-recursion] events that define
   the same set of function symbols.
@@ -5975,7 +6096,7 @@
   ~ilc[default-defun-mode], ~ilc[default-ruler-extenders], and
   ~ilc[default-verify-guards-eagerness].  The full criterion for redundancy of
   ~c[encapsulate] events is more complex, for example ignoring contents of
-  ~ilc[local] ~il[events]; ~pl[encapsulate].
+  ~ilc[local] ~il[events]; ~pl[redundant-encapsulate].
 
   An ~ilc[in-theory] event is never redundant.  Note that it doesn't define any
   name.
@@ -6061,8 +6182,8 @@
   just to contain the names generated by the book.  But suppose you
   compute the theory as the very last event in the book using:
   ~bv[]
-  (set-difference-theories (universal-theory :here)
-                           (universal-theory fn))
+    (set-difference-theories (universal-theory :here)
+                             (universal-theory fn))
   ~ev[]
   where ~c[fn] is the very first event in the book and happens to be a
   ~ilc[defun] event.  This expression returns the advertised set if ~c[fn] is
@@ -6082,13 +6203,13 @@
   in the definition.  The following example shows how an attempt to redefine a
   function can fail to make any change.
   ~bv[]
-  (set-ld-redefinition-action '(:warn . :overwrite) state)
-  (defmacro mac (x) x)
-  (defun foo (x) (mac x))
-  (defmacro mac (x) (list 'car x))
-  (set-ld-redefinition-action nil state)
-  (defun foo (x) (mac x)) ; redundant, unfortunately; foo does not change
-  (thm (equal (foo 3) 3)) ; succeeds, showing that redef of foo didn't happen
+    (set-ld-redefinition-action '(:warn . :overwrite) state)
+    (defmacro mac (x) x)
+    (defun foo (x) (mac x))
+    (defmacro mac (x) (list 'car x))
+    (set-ld-redefinition-action nil state)
+    (defun foo (x) (mac x)) ; redundant, unfortunately; foo does not change
+    (thm (equal (foo 3) 3)) ; succeeds, showing that redef of foo didn't happen
   ~ev[]
   The call of macro ~c[mac] was expanded away before storing the first
   definition of ~c[foo] for the theorem prover.  Therefore, the new definition
@@ -6103,12 +6224,12 @@
   ~c[(set-ld-redefinition-action nil state)], then the problem goes away:
 
   ~bv[]
-  (set-ld-redefinition-action '(:warn . :overwrite) state)
-  (defmacro mac (x) x)
-  (defun foo (x) (mac x))
-  (defmacro mac (x) (list 'car x))
-  (defun foo (x) (mac x)) ; no longer redundant
-  (thm (equal (foo 3) 3)) ; fails, as we would like
+    (set-ld-redefinition-action '(:warn . :overwrite) state)
+    (defmacro mac (x) x)
+    (defun foo (x) (mac x))
+    (defmacro mac (x) (list 'car x))
+    (defun foo (x) (mac x)) ; no longer redundant
+    (thm (equal (foo 3) 3)) ; fails, as we would like
   ~ev[]
 
   To summarize: If a ~ilc[defun] form is submitted that meets the usual
@@ -6127,13 +6248,13 @@
   Here is more complex example illustrating the limits of redefinition, based
   on one supplied by Grant Passmore.
   ~bv[]
-  (defun n3 () 0)
-  (defun n4 () 1)
-  (defun n5 () (> (n3) (n4))) ; body is normalized to nil
-  (thm (equal (n5) nil)) ; succeeds, trivially
-  (set-ld-redefinition-action '(:warn . :overwrite) state)
-  (defun n3 () 2)
-  (thm (equal (n5) nil)) ; still succeeds, sadly
+    (defun n3 () 0)
+    (defun n4 () 1)
+    (defun n5 () (> (n3) (n4))) ; body is normalized to nil
+    (thm (equal (n5) nil)) ; succeeds, trivially
+    (set-ld-redefinition-action '(:warn . :overwrite) state)
+    (defun n3 () 2)
+    (thm (equal (n5) nil)) ; still succeeds, sadly
   ~ev[]
   We may expect the final ~ilc[thm] call to fail because of the following
   reasoning: ~c[(n5)] = ~c[(> (n3) (n4))] = ~c[(> 2 1)] = ~c[t].  Unfortunatly,
@@ -6153,13 +6274,14 @@
 
   A related phenomenon can occur for ~ilc[encapsulate].  As explained above, an
   ~c[encapsulate] event is redundant if it is identical to one already in the
-  database.  Consider then the following contrived example.
+  database.  (But a weaker condition applies in general;
+  ~pl[redundant-encapsulate].)  Consider then the following contrived example.
   ~bv[]
-  (defmacro mac (x) x)
-  (encapsulate () (defun foo (x) (mac x)))
-  (set-ld-redefinition-action '(:warn . :overwrite) state)
-  (defmacro mac (x) (list 'car x))
-  (encapsulate () (defun foo (x) (mac x)))
+    (defmacro mac (x) x)
+    (encapsulate () (defun foo (x) (mac x)))
+    (set-ld-redefinition-action '(:warn . :overwrite) state)
+    (defmacro mac (x) (list 'car x))
+    (encapsulate () (defun foo (x) (mac x)))
   ~ev[]
   The last ~c[encapsulate] event is redundant because it meets the criterion
   for redundancy: it is identical to the earlier ~c[encapsulate] event.  Even
@@ -6171,39 +6293,45 @@
   A workaround can be to add something trivial to the ~c[encapsulate], for
   example:
   ~bv[]
-  (encapsulate ()
-    (deflabel try2) ; ``Increment'' to try3 next time, and so on.
-    (defun foo (x) x))
+    (encapsulate ()
+      (deflabel try2) ; ``Increment'' to try3 next time, and so on.
+      (defun foo (x) x))
   ~ev[]")
 
-(defun stop-redundant-event (ctx state)
+(defun stop-redundant-event-fn (ctx state extra-msg)
   (let ((chan (proofs-co state)))
     (pprogn
      (cond ((ld-skip-proofsp state) state)
-           (t
-            (io? event nil state
-                 (chan ctx)
-                 (mv-let (col state)
-                         (fmt "The event "
-                              nil
-                              chan
-                              state
-                              nil)
-                         (mv-let (col state)
-                                 (fmt-ctx ctx col chan state)
-                                 (mv-let (col state)
-                                         (fmt1 " is redundant.  See :DOC ~
-                                                redundant-events.~%"
-                                               nil
-                                               col
-                                               chan
-                                               state
-                                               nil)
-                                         (declare (ignore col))
-                                         state)))
-                 :default-bindings ((col 0)))))
+           (t (io? event nil state
+                   (chan ctx extra-msg)
+                   (mv-let
+                    (col state)
+                    (fmt "The event "
+                         nil
+                         chan
+                         state
+                         nil)
+                    (mv-let
+                     (col state)
+                     (fmt-ctx ctx col chan state)
+                     (mv-let
+                      (col state)
+                      (fmt1 " is redundant.  See :DOC ~
+                             redundant-events.~#0~[~/  ~@1~]~%"
+                            (list (cons #\0 (if (null extra-msg) 0 1))
+                                  (cons #\1 extra-msg))
+                            col
+                            chan
+                            state
+                            nil)
+                      (declare (ignore col))
+                      state)))
+                   :default-bindings ((col 0)))))
      (value :redundant))))
 
+(defmacro stop-redundant-event (ctx state &optional extra-msg)
+  `(stop-redundant-event-fn ,ctx ,state ,extra-msg))
+
 ; Examining the World
 
 ; The user must be given facilities for poking around the world.  To describe
@@ -7514,7 +7642,7 @@
   ~ev[]
   ~c[Pc] always prints a space first, followed by three (possibly blank)
   ~il[characters] (``LVd'' above) explained below (four, in the experimental
-  HONS version; ~pl[hons-and-memoization]).  Then ~c[pc] prints the
+  HONS version, as discussed further below).  Then ~c[pc] prints the
   ~il[command] number, a number uniquely identifying the ~il[command]'s
   position in the sequence of ~il[command]s since the beginning of the user's
   session.  Finally, the ~il[command] itself is printed.
@@ -11105,13 +11233,13 @@
                     (symbol-name name))
                 nil)
                (global-val 'documentation-alist (w state))))))
-    (cond ((null lst) (value nil))
-          (t (er soft ctx
-                 "There is no documentation for ~x0.  ~#1~[A similar ~
-                  documented name is~/Similar documented names are~] ~
-                  ~&1.  See also :DOC apropos."
-                 name
-                 (strip-cdrs lst))))))
+    (er soft ctx
+        "There is no documentation for ~x0.~#1~[~/  A similar documented name ~
+         is ~&2.~/  Similar documented names are ~&2.~]~|~%NOTE: See also ~
+         :DOC finding-documentation."
+        name
+        (zero-one-or-more (length lst))
+        (strip-cdrs lst))))
 
 (defun end-doc (channel state)
   (cond
@@ -11135,22 +11263,22 @@
    (t
     (io? temporary nil (mv erp val state)
          (name)
-         (let ((channel (standard-co state))
-               (temp (if (keywordp name)
-                         (assoc-eq name
-                                   (f-get-global 'ld-keyword-aliases state))
-                       nil))
-               (doc-tuple (access-doc-string-database name state)))
+         (let* ((channel (standard-co state))
+                (ld-keyword-aliases (ld-keyword-aliases state))
+                (temp (if (keywordp name)
+                          (assoc-eq name ld-keyword-aliases)
+                        nil))
+                (doc-tuple (access-doc-string-database name state)))
            (cond
             ((or temp
                  (null doc-tuple))
              (let ((temp (cond
                           ((symbolp name)
                            (assoc-eq (intern (symbol-name name) "KEYWORD")
-                                     (f-get-global 'ld-keyword-aliases state)))
+                                     ld-keyword-aliases))
                           ((stringp name)
                            (assoc-eq (intern name "KEYWORD")
-                                     (f-get-global 'ld-keyword-aliases state)))
+                                     ld-keyword-aliases))
                           (t nil))))
                (cond
                 ((null temp)
@@ -11350,18 +11478,30 @@
                                           fmt-alist
                                           channel state)))))
 
-(deflabel apropos
-
-; WARNING: Do not attempt to define apropos as a macro.  This symbol is
-; imported from Common Lisp and might already have a definition.
-
+(deflabel finding-documentation
   :doc
   ":Doc-Section acl2::Miscellaneous
 
-  searching the documentation online~/
+  searching the documentation~/
 
-  The ~c[:]~ilc[docs] command allows you to search the ~il[documentation] at
-  the terminal.  ~l[docs].~/~/")
+  The ~c[:]~ilc[doc] and ~c[:]~ilc[doc!] commands will display, at the
+  terminal, ~il[documentation] topics defined in ACL2 or in ~il[books] that
+  have already been included.  The ~c[:]~ilc[docs] command allows you to search
+  the ~il[documentation] at the terminal.  ~l[docs].
+
+  But how can you find documentation for books that are not included in the
+  current ACL2 session?
+
+  The xdoc manual is a combined manual for the ACL2 sources and the community
+  books.  It is built using documentation not only from the ACL2 sources
+  (which is rearranged) but also from the community books (whether included in
+  the current session or not), using an ``xdoc processor'' created by Jared
+  Davis.  The ACL2 home page
+  (~url[http://www.cs.utexas.edu/users/moore/acl2/]) has a link to this manual,
+  which as of this writing may be found directly by visiting the following web
+  page: ~url[http://fv.centtech.com/acl2/latest/doc/].  You can build a local
+  copy of this manual from the ACL2 Community Books, following instructions in
+  their ~c[Makefile].~/~/")
 
 (deflabel markup
   :doc
@@ -11906,16 +12046,19 @@
 
   brief ~il[documentation] (type ~c[:doc name])~/
 
-  NOTE:  The ~c[:doc] command only makes sense at the terminal.
-  Furthermore it only works at the terminal when a ``full-size'' image
-  has been built.  Most users will probably access the ACL2
-  documentation in other ways, as explained in the file ~c[\"doc/README\"]
-  that comes with the ACL2 distribution.
+  NOTE: The ~c[:doc] command only makes sense at the terminal.  Most users will
+  probably access the ACL2 documentation in other ways; ~pl[documentation].  In
+  particular, consider using the xdoc manual at the following location on the
+  web, for topics documented in ACL2 community ~il[books] as well as the ACL2
+  system (though the latter are rearranged):
+
+  ~url[http://fv.centtech.com/acl2/latest/doc/]
+
   ~bv[]
   Examples:
   ACL2 !>:doc DEFTHM          ; print documentation of DEFTHM
   ACL2 !>:doc logical-name    ; print documentation of LOGICAL-NAME
-  ACL2 !>:doc \"MY-PKG\"      ; print documentation of \"MY-PKG\"
+  ACL2 !>:doc \"MY-PKG\"        ; print documentation of \"MY-PKG\"
 
   Related Topics:
   :more                      ; continues last :doc or :more-doc text
@@ -17280,28 +17423,6 @@
   (declare (ignorable state))
   (value@par t))
 
-(defun character-alistp (x)
-
-  ":Doc-Section ACL2::ACL2-built-ins
-
-  recognizer for association lists with characters as keys~/
-
-  ~c[(Character-alistp x)] is true if and only if ~c[x] is a list of pairs
-  of the form ~c[(cons key val)] where ~c[key] is a ~ilc[characterp].~/~/"
-
-  (declare (xargs :guard t))
-  (cond ((atom x) (eq x nil))
-        (t (and (consp (car x))
-                (characterp (car (car x)))
-                (character-alistp (cdr x))))))
-
-(defun tilde-@p (arg)
-  (declare (xargs :guard t))
-  (or (stringp arg)
-      (and (consp arg)
-           (stringp (car arg))
-           (character-alistp (cdr arg)))))
-
 (defun@par translate-error-hint (arg ctx wrld state)
   (declare (ignore wrld))
   (cond ((tilde-@p arg)
@@ -17357,6 +17478,11 @@
         *expandable-boot-strap-non-rec-fns*))
 
 (defconst *definition-minimal-theory*
+
+; We include mv-nth because of the call of simplifiable-mv-nthp in the
+; definition of call-stack, which (as noted there) results in a use of the
+; definition of mv-nth without tracking it in a ttree.
+
   (list* 'mv-nth 'iff *expandable-boot-strap-non-rec-fns*))
 
 (defdoc theories-and-primitives
diff -Nru acl2-6.2/hons-raw.lisp acl2-6.3/hons-raw.lisp
--- acl2-6.2/hons-raw.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/hons-raw.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -69,10 +69,11 @@
 ;     and results in trivially fewer runtime type checks in HONS-GET and
 ;     HONS-ACONS.  I think it makes sense to use flex alists in classic
 ;     honsing, where we can imagine often finding cdrs for which we don't have
-;     at least 18 separate cars.  But fast alists are much more targeted; if
-;     an ACL2 user is building a fast alist, it seems very likely that they
-;     know they are doing something big (or probably big) -- otherwise they
-;     wouldn't be bothering with fast alists.
+;     at least 18 separate cars.  But fast alists are much more targeted; if an
+;     ACL2 user is building a fast alist, it seems very likely that they know
+;     they are doing something big (or probably big) -- otherwise they wouldn't
+;     be bothering with fast alists.
+
 
 
 ; ESSAY ON CTRL+C SAFETY
@@ -89,24 +90,26 @@
 ; ensure that, e.g., (SETF (GETHASH ...)) does not leave a hash table in an
 ; internally inconsistent state.
 
-(defconstant *hl-mht-default-rehash-size* 1.5)
-(defconstant *hl-mht-default-rehash-threshold* 0.7)
+#+static-hons
+(defmacro hl-without-interrupts (&rest forms)
+  `(ccl::without-interrupts . ,forms))
 
-(defun hl-mht (&key (test             'eql)
-                    (size             '60)
-                    (rehash-size      *hl-mht-default-rehash-size*)
-                    (rehash-threshold *hl-mht-default-rehash-threshold*)
-                    (weak             'nil)
-                    (shared           'nil)
-                    (lock-free        'nil)
-                    )
 
-; Wrapper for make-hash-table.
+; CROSS-LISP COMPATIBILITY WRAPPERS
 ;
-; Because of our approach to threading, we generally don't need our hash tables
-; to be protected by locks.  HL-MHT is essentially like make-hash-table, but on
-; CCL creates hash tables that aren't shared between threads, which may result
-; in slightly faster updates.
+; As groundwork toward porting the static honsing scheme to other Lisps that
+; might be able to support it, we have added these wrappers for various ccl::
+; functionality.
+
+(defun hl-mht-fn (&key (test             'eql)
+                       (size             '60)
+                       (rehash-size      '1.5)
+                       (rehash-threshold '0.7)
+                       (weak             'nil)
+                       (shared           'nil)
+                       (lock-free        'nil))
+
+; See hl-mht.
 
   (declare (ignorable shared weak lock-free))
   (make-hash-table :test             test
@@ -118,6 +121,140 @@
                    #+Clozure :lock-free #+Clozure lock-free
                    ))
 
+#+allegro
+(declaim (type hash-table *hl-hash-table-size-ht*))
+#+allegro
+(defvar *allegro-hl-hash-table-size-ht*
+; See the comment about this hash table in hl-mht.
+  (make-hash-table))
+
+(defmacro hl-mht (&rest args)
+
+; This macro is a wrapper for hl-mht-fn, which in turn is a wrapper for
+; make-hash-table.
+
+; Because of our approach to threading, we generally don't need our hash tables
+; to be protected by locks.  HL-MHT is essentially like make-hash-table, but on
+; CCL creates hash tables that aren't shared between threads, which may result
+; in slightly faster updates.
+
+; In Allegro CL 9.0 (and perhaps other versions), make-hash-table causes
+; creation of a hash table of a somewhat larger size than is specified by the
+; :size argument, which can cause hons-shrink-alist to create hash tables of
+; ever-increasing size when this is not necessary.  The following example
+; illustrates this problem, which was first observed in community book
+; books/parsers/earley/earley-parser.lisp.
+
+;   (defconst *end* :end)
+;
+;   (defn my-hons-shrink-alist (a)
+;     (let ((ans (hons-shrink-alist a *end*)))
+;       (prog2$ (fast-alist-free a)
+;               ans)))
+;
+;   (defun my-fast-alist3 (n ans)
+;     (declare (type (integer 0 *) n))
+;     (cond ((zp n) ans)
+;           (t (my-fast-alist3 (1- n)
+;                              (my-hons-shrink-alist
+;                               (hons-acons (mod n 10) (* 10 n) ans))))))
+;
+;   (trace! (hl-mht-fn :native t :exit t))
+;
+;   (time$ (my-fast-alist3 33 *end*))
+
+; Our solution is to use a hash table, *allegro-hl-hash-table-size-ht*, to map
+; the actual size of a hash table, h, to the :size argument of the call of
+; hl-mht that created h.  Then, when we want to create a hash table of a given
+; :size, new-size-arg, we look in *allegro-hl-hash-table-size-ht* to check
+; whether a previous call of hl-mht created a hash table of that size using
+; some :size, old-size-arg, and if so, then we call make-hash-table with :size
+; old-size-arg instead of new-size-arg.  (Note that we don't give this special
+; treatment in the case that hl-mth is called without an explicit :size; but
+; that seems harmless.)
+
+  #-allegro
+  `(hl-mht-fn ,@args)
+  #+allegro
+  (let ((tail (and (keyword-value-listp args)
+                   (assoc-keyword :size args))))
+    (cond (tail
+           (let ((size-arg-var (gensym))
+                 (old-size-arg-var (gensym)))
+             `(let* ((,size-arg-var ,(cadr tail))
+                     (,old-size-arg-var
+                      (gethash ,size-arg-var *allegro-hl-hash-table-size-ht*)))
+                (cond (,old-size-arg-var
+                       (hl-mht-fn :size ,old-size-arg-var
+                                  ,@(remove-keyword :size args)))
+                      (t (let ((ht (hl-mht-fn ,@args)))
+                           (setf (gethash (hash-table-size ht)
+                                          *allegro-hl-hash-table-size-ht*)
+                                 ,size-arg-var)
+                           ht))))))
+          (t `(hl-mht-fn ,@args)))))
+
+; In CCL, one can use (ccl::static-cons a b) in place of (cons a b) to create a
+; cons that will not be moved by the garbage collector.
+;
+; Unlike an ordinary cons, every static cons has a unique index, which is a
+; fixnum, and which may be obtained with (ccl::%staticp x).  Per Gary Byers,
+; this index will be forever fixed, even after garbage collection, even after
+; saving an image.
+;
+; Even more interesting, the cons itself can be recovered from its index using
+; ccl::%static-inverse-cons.  Given the index of a static cons, such as
+; produced by ccl::%staticp, %static-inverse-cons produces the corresponding
+; static cons.  Given an invalid index (such as the index of a cons that has
+; been garbage collected), %static-inverse-cons produces NIL.  Hence, this
+; gives us a way to tell if a cons has been garbage collected, and lets us
+; implement a clever scheme for "washing" honses.
+;
+; We now write wrappers for static-cons, %staticp, and %static-inverse-cons, to
+; make it easier to plug in alternative implementations in other Lisps.
+
+#+static-hons
+(defabbrev hl-static-cons (a b)
+  (ccl::static-cons a b))
+
+#+static-hons
+(defabbrev hl-staticp (x)
+  (ccl::%staticp x))
+
+#+static-hons
+(defabbrev hl-static-inverse-cons (x)
+  (ccl::%static-inverse-cons x))
+
+
+
+#+static-hons
+(defabbrev hl-machine-address-of (x)
+  (ccl::%address-of x))
+
+#+static-hons
+(defabbrev hl-machine-hash (x)
+
+; NOT A FUNCTION.  Note that (EQUAL (HL-MACHINE-HASH X) (HL-MACHINE-HASH X)) is
+; not necessarily true, because objects may be moved during garbage collection
+; in CCL.
+;
+; We use the machine address of an object to compute a hash code within [0,
+; 2^20).  We obtain a good distribution on 64-bit CCL, but we have not tried
+; this on 32-bit CCL.
+;
+; We right-shift the address by five places because smaller shifts led to worse
+; distributions.  We think this is because the low 3 bits are just tag bits
+; (which are not interesting), and the next 2 bits never add any information
+; because conses are word-aligned.
+;
+; To change this from 2^20 to other powers of 2, you should only need to adjust
+; the mask.  We think 2^20 is a good number, since a 2^20 element array seems
+; to require about 8 MB of memory, e.g., our whole cache will take 16 MB.
+
+  (let* ((addr    (hl-machine-address-of x))
+         (addr>>5 (the fixnum (ash (the fixnum addr) -5))))
+    ;; (ADDR>>5) % 2^20
+    (the fixnum (logand (the fixnum addr>>5) #xFFFFF))))
 
 
 ; ----------------------------------------------------------------------
@@ -181,7 +318,7 @@
 ; Implementation 2.  For 64-bit CCL (#+static-hons) we use a better scheme.
 ;
 ;    A Cache Table contains two arrays, KEYDATA and VALDATA.  These arrays
-;    associate "hash codes" (array indicies) to keys and values, respectively.
+;    associate "hash codes" (array indices) to keys and values, respectively.
 ;    We could have used a single array with (key . val) pairs as its entries,
 ;    but using two separate arrays allows us to implement hl-cache-set with no
 ;    consing.
@@ -262,32 +399,6 @@
   #-static-hons
   (count     0 :type fixnum))
 
-
-#+static-hons
-(defabbrev hl-machine-hash (x)
-
-; NOT A FUNCTION.  Note that (EQUAL (HL-MACHINE-HASH X) (HL-MACHINE-HASH X)) is
-; not necessarily true, because objects may be moved during garbage collection
-; in CCL.
-;
-; We use the machine address of an object to compute a hash code within [0,
-; 2^20).  We obtain a good distribution on 64-bit CCL, but we have not tried
-; this on 32-bit CCL.
-;
-; We right-shift the address by five places because smaller shifts led to worse
-; distributions.  We think this is because the low 3 bits are just tag bits
-; (which are not interesting), and the next 2 bits never add any information
-; because conses are word-aligned.
-;
-; To change this from 2^20 to other powers of 2, you should only need to adjust
-; the mask.  We think 2^20 is a good number, since a 2^20 element array seems
-; to require about 8 MB of memory, e.g., our whole cache will take 16 MB.
-
-  (let* ((addr    (ccl::%address-of x))
-         (addr>>5 (the fixnum (ash (the fixnum addr) -5))))
-    ;; (ADDR>>5) % 2^20
-    (the fixnum (logand (the fixnum addr>>5) #xFFFFF))))
-
 (defun hl-cache-set (key val cache)
   (declare (type hl-cache cache))
 
@@ -295,7 +406,7 @@
   (let ((keydata (hl-cache-keydata cache))
         (valdata (hl-cache-valdata cache))
         (code    (hl-machine-hash key)))
-    (ccl::without-interrupts
+    (hl-without-interrupts
      (setf (svref keydata (the fixnum code)) key)
      (setf (svref valdata (the fixnum code)) val)))
 
@@ -479,12 +590,6 @@
 ; Static Honsing is a scheme for tracking normed conses that can be used only
 ; in Clozure Common Lisp.
 ;
-; In CCL, one can use (ccl::static-cons a b) in place of (cons a b) to create a
-; cons that will not be moved by the garbage collector.  The 'index' of such a
-; cons, which is a fixnum exceeding 128, may be obtained with (ccl::%staticp x)
-; and, per Gary Byers, will be forever fixed, even after garbage collection,
-; even after saving an image.
-;
 ; Static Honsing is an alternative to classic honsing that exploits static
 ; conses for greater efficiency.  Here, only static conses can be considered
 ; normed, and SBITS is a bit-array that records which static conses are
@@ -512,7 +617,7 @@
 ; that BASE is the start of the dynamically-allocated range.  Then,
 ;
 ;    The address of a static cons, C, is Index(C) + BASE, where Index(C) is the
-;    index returned by ccl::%staticp.
+;    index returned by HL-STATICP.
 ;
 ;    For any other atom, X, we construct an associated static cons, say X_C,
 ;    and then use Index(X_C) + BASE as the address of X.
@@ -612,7 +717,7 @@
 ; the non lock-free version of 'remhash', there is a special case: deleting the
 ; last remaining element from a hash table triggers a linear walk of the hash
 ; table, where every element in the vector is overwritten with the
-; free-hash-marker.  This is devestating when there is exactly one active fast
+; free-hash-marker.  This is devastating when there is exactly one active fast
 ; alist: every "hons-acons" and "fast-alist-free" operation requires a linear
 ; walk over the TABLE.  This took me two whole days to figure out.  To ensure
 ; that nobody else is bitten by it, and that I am not bitten by it again, here
@@ -895,7 +1000,7 @@
 ; determine if X is a static cons whose bit is set in the SBITS array.  If so,
 ; we X is considered normed with respect to HS.
 
-  (let* ((idx (ccl::%staticp x)))
+  (let* ((idx (hl-staticp x)))
     (and idx
          (let ((sbits (hl-hspace-sbits hs)))
            (and (< (the fixnum idx) (the fixnum (length sbits)))
@@ -1160,9 +1265,9 @@
        (if addr-cons
            (cdr addr-cons)
          ;; Okay, safe to generate a new address.
-         (let* ((new-addr-cons (ccl::static-cons s nil))
+         (let* ((new-addr-cons (hl-static-cons s nil))
                 (true-addr     (+ hl-dynamic-base-addr
-                                  (ccl::%staticp new-addr-cons))))
+                                  (hl-staticp new-addr-cons))))
            (rplacd (the cons new-addr-cons) true-addr)
            (setf (get (the symbol s) 'hl-static-address) new-addr-cons)
            true-addr))))))
@@ -1203,9 +1308,9 @@
                ;; return the TRUE-ADDR.
                (cdr entry)
              ;; Else, we need to create an entry.
-             (let* ((new-addr-cons (ccl::static-cons x nil))
+             (let* ((new-addr-cons (hl-static-cons x nil))
                     (true-addr     (+ hl-dynamic-base-addr
-                                      (ccl::%staticp new-addr-cons))))
+                                      (hl-staticp new-addr-cons))))
                (rplacd (the cons new-addr-cons) true-addr)
                (setf (gethash x other-ht) new-addr-cons)
                true-addr))))))
@@ -1227,7 +1332,7 @@
 
   `(let ((x ,x))
      (cond ((consp x)
-            (+ hl-dynamic-base-addr (ccl::%staticp x)))
+            (+ hl-dynamic-base-addr (hl-staticp x)))
            ((eq x nil) 256)
            ((eq x t)   257)
            (t
@@ -1446,8 +1551,8 @@
 ;
 ; Static Honsing only.  IDX must be a natural number and HS must be a Hons
 ; Space.  We generally expect this function to be called when SBITS has become
-; too short to handle IDX, the ccl::%staticp index of some static cons.  We
-; copy SBITS into a new, larger array and install it into the Hons Space.
+; too short to handle IDX, the static index of some static cons.  We copy SBITS
+; into a new, larger array and install it into the Hons Space.
 ;
 ; Growing SBITS is slow because we need to (1) allocate a new, bigger array,
 ; and (2) copy the old contents of SBITS into this new array.  Accordingly, we
@@ -1509,9 +1614,9 @@
       ;; where NX is the normed version of X and TRUE-ADDR = Index(XC) + Base.
       (if entry
           (car entry)
-        (let* ((new-addr-cons (ccl::static-cons x nil))
+        (let* ((new-addr-cons (hl-static-cons x nil))
                (true-addr     (+ hl-dynamic-base-addr
-                                 (ccl::%staticp new-addr-cons))))
+                                 (hl-staticp new-addr-cons))))
           (rplacd (the cons new-addr-cons) true-addr)
           (setf (gethash x str-ht) new-addr-cons)
           x))))
@@ -1571,19 +1676,19 @@
                (let* ((hint-idx (and (consp hint)
                                      (eq (car hint) a)
                                      (eq (cdr hint) b)
-                                     (ccl::%staticp hint)))
+                                     (hl-staticp hint)))
                       (pair     (if hint-idx
                                     ;; Safe to use hint.
                                     hint
-                                  (ccl::static-cons a b)))
-                      (idx      (or hint-idx (ccl::%staticp pair)))
+                                  (hl-static-cons a b)))
+                      (idx      (or hint-idx (hl-staticp pair)))
                       (sbits    (hl-hspace-sbits hs)))
                  ;; Make sure there are enough sbits.  Ctrl+C Safe.
                  (when (>= (the fixnum idx)
                            (the fixnum (length sbits)))
                    (hl-hspace-grow-sbits idx hs)
                    (setq sbits (hl-hspace-sbits hs)))
-                 (ccl::without-interrupts
+                 (hl-without-interrupts
                   ;; Since we must simultaneously update SBITS and ADDR-HT, the
                   ;; installation of PAIR must be protected by without-interrupts.
                   (setf (aref sbits idx) 1)
@@ -2744,7 +2849,7 @@
       ;; Nothing to do because we assume all atoms have already been
       ;; installed.
       x
-    (let ((index (ccl::%staticp x)))
+    (let ((index (hl-staticp x)))
       (if (= (aref sbits index) 1)
           ;; Nothing to do; we've already reinstalled X.
           x
@@ -2784,7 +2889,7 @@
     (hl-cache-clear norm-cache)
     (setf (hl-hspace-faltable hs) temp-faltable)
     (setf (hl-hspace-persist-ht hs) temp-persist-ht)
-    (ccl::without-interrupts
+    (hl-without-interrupts
      (setf (hl-hspace-addr-ht hs) temp-addr-ht)
      (setf (hl-hspace-sbits hs) temp-sbits))
 
@@ -2820,7 +2925,7 @@
             (hash-table-count addr-ht))
 
     ;; Order matters, reinstall addr-ht and sbits before fal-ht and persist-ht!
-    (ccl::without-interrupts
+    (hl-without-interrupts
      (setf (hl-hspace-addr-ht hs) addr-ht)
      (setf (hl-hspace-sbits hs) sbits))
     (setf (hl-hspace-faltable hs) faltable)
@@ -2839,12 +2944,6 @@
 ;
 ; ----------------------------------------------------------------------
 
-; Washing is a much better garbage collection mechanism than clearing, made
-; possible by ccl::%static-inverse-cons.  Given the index of a static cons,
-; such as produced by ccl::%staticp, %static-inverse-cons produces the
-; corresponding static cons.  Given an invalid index (such as the index of a
-; cons that has been garbage collected), %static-inverse-cons produces NIL.
-; Hence, this gives us a way to tell if a cons has been garbage collected.
 
 ; BOZO thread unsafe.  It is probably not okay to use this function in a
 ; multi-threaded environment.  In particular, another thread could create a
@@ -2870,7 +2969,7 @@
              (fixnum num-survivors))
     (loop for i fixnum below max-index do
           (when (= (aref sbits i) 1)
-            (let ((object (ccl::%static-inverse-cons i)))
+            (let ((object (hl-static-inverse-cons i)))
               (if object
                   (incf num-survivors)
                 (setf (aref sbits i) 0)))))
@@ -2896,7 +2995,7 @@
     (loop for i fixnum below max-index do
           (when (= (aref sbits i) 1)
             ;; This object was previously normed.
-            (let ((object (ccl::%static-inverse-cons i)))
+            (let ((object (hl-static-inverse-cons i)))
               (cond ((not object)
                      (error "Expected SBITS to already be fixed up."))
                     (t
@@ -3006,7 +3105,7 @@
     ;; invalidates the STR-HT or OTHER-HT, so we leave them alone.
     (setf (hl-hspace-faltable hs) temp-faltable)
     (setf (hl-hspace-persist-ht hs) temp-persist-ht)
-    (ccl::without-interrupts ;; These two must be done together or not at all.
+    (hl-without-interrupts ;; These two must be done together or not at all.
      (setf (hl-hspace-addr-ht hs) temp-addr-ht)
      (setf (hl-hspace-sbits hs) temp-sbits))
 
@@ -3060,7 +3159,7 @@
 
       ;; All objects restored.  The hons space should now be in a fine state
       ;; once again.  Restore it.
-      (ccl::without-interrupts
+      (hl-without-interrupts
        (setf (hl-hspace-addr-ht hs) addr-ht)
        (setf (hl-hspace-sbits hs) sbits))
       (setf (hl-hspace-persist-ht hs) persist-ht)
@@ -3234,7 +3333,7 @@
     (format t " - SBITS array length:    ~15:D~%"
             (length sbits))
     (format t "   New static cons index: ~15:D~%~%"
-            (ccl::%staticp (ccl::static-cons nil nil)))
+            (hl-staticp (hl-static-cons nil nil)))
     (format t " - ADDR-HT:      ~15:D count, ~15:D size (~5,2f% full)~%"
             (hash-table-count addr-ht)
             (hash-table-size addr-ht)
diff -Nru acl2-6.2/hons.lisp acl2-6.3/hons.lisp
--- acl2-6.2/hons.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/hons.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -520,6 +520,9 @@
 
 Performance Notes
 
+~l[hons-acons] for how the final ~ilc[cdr] of a fast alist can be used as a
+size hint or as a name for reports printed by calling ~ilc[fast-alist-summary].
+
 The keys of fast alists are always ~il[normed].  Why?  In Common Lisp,
 equal-based hashing is relatively slow, so to allow the use of eql-based hash
 tables, ~ilc[hons-acons] and ~ilc[hons-get] always ~ilc[hons-copy] the keys
@@ -788,8 +791,9 @@
 
 This ~il[documentation] topic relates to the experimental extension of ACL2
 supporting hash cons, fast alists, and memoization; ~pl[hons-and-memoization].
+It assumes familiarity with fast alists; ~pl[fast-alists].
 
-Logically, ~c[hons-shrink-alist] is defined as follows:
+Logically, ~c[(hons-shrink-alist alist ans)] is defined as follows:
 
 ~bv[]
  (cond ((atom alist)
@@ -812,11 +816,36 @@
 alist, or as a way to obtain a \"deep copy\" of a fast alist that can extended
 independently from the original while maintaining discipline.
 
+Note that hons-shrink-alist is potentially expensive, for the following two
+reasons.
+~bq[]
+
+o The alist is copied, dropping any shadowed pairs.  This process will require
+a hash table lookup for each entry in the alist; and it will require creating a
+new alist, which uses additional memory.
+
+o Unless ans is a fast alist that is stolen (see below), a new hash table is
+created, which uses additional memory.  This hash table is populated in time
+that is linear in the number of unique keys in the alist.
+~eq[]
+
 When ans is not an atom, good discipline requires that it is a fast alist.  In
 this case, ~c[hons-shrink-alist] steals the hash table for ans and extends it
 with all of the bindings in alist that are not in ans.  From the perspective of
 ~ilc[hons-assoc-equal], you can think of the resulting alist as being basically
-similar to ~c[(append ans alist)], but in a different order.~/~/"
+similar to ~c[(append ans alist)], but in a different order.
+
+Note that when ans is not a fast alist (e.g., ans is an atom) then such
+stealing does not take place.
+
+A common idiom is to replace an alist by the result of shrinking it, in which
+case it is best to free the input alist, for example as follows.
+~bv[]
+  (let ((alist (fast-alist-free-on-exit alist
+                                        (hons-shrink-alist alist nil))))
+    ...)
+~ev[]
+~l[fast-alist-free-on-exit] and ~pl[fast-alist-free].~/~/"
 
   ;; Has an under-the-hood implementation
   (cond ((atom alist)
@@ -884,7 +913,9 @@
 
 Under the hood, ~c[fast-alist-free] removes the hash table associated with this
 alist, if one exists.  This effectively converts the alist into an ordinary
-alist.~/
+alist.
+
+Also ~pl[fast-alist-free-on-exit].~/
 
 Because there is no automatic mechanism for freeing the hash tables used in
 fast alists, to avoid memory leaks you should manually free any alists that
@@ -1011,16 +1042,16 @@
   ":Doc-Section Hons-and-Memoization
 Free a fast alist after the completion of some form.~/
 
-Logically, ~c[(fast-alist-free-on-exit name form)] is the identity and returns
-~c[form].
+Logically, ~c[(fast-alist-free-on-exit alist form)] is the identity and returns
+~c[form].  Also ~pl[fast-alist-free].
 
 Under the hood, this essentially expands to:
 ~bv[]
  (prog1 form
-        (fast-alist-free name))
+        (fast-alist-free alist))
 ~ev[]
 
-In other words, ~c[name] is not freed immediately, but instead remains a fast
+In other words, ~c[alist] is not freed immediately, but instead remains a fast
 alist until the form completes.  This may be useful when you are writing code
 that uses a fast alist but has many return points.
 
@@ -1166,5 +1197,13 @@
             (:executable-counterpart flush-hons-get-hash-table-link)
             ))
 
+(defun remove-keyword (word l)
+  (declare (xargs :guard (and (keywordp word)
+                              (keyword-value-listp l))))
+  (cond ((endp l) nil)
+        ((eq word (car l))
+         (remove-keyword word (cddr l)))
+        (t (list* (car l) (cadr l) (remove-keyword word (cddr l))))))
+
 ; For some additional helper functions and lemmas, see the community books
 ; books/misc/hons-help.lisp and books/misc/hons-help2.lisp.
diff -Nru acl2-6.2/induct.lisp acl2-6.3/induct.lisp
--- acl2-6.2/induct.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/induct.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/init.lisp acl2-6.3/init.lisp
--- acl2-6.2/init.lisp	2013-06-07 03:03:25.000000000 +0000
+++ acl2-6.3/init.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -79,9 +79,14 @@
 ; books/clause-processors/SULFA/books/sat-tests/sudoku.lisp was caused by
 ; bad-lisp-objectp.  Another doubling fixed each of these, but wan't enough for
 ; certifying books/centaur/aig/random-sim.lisp, again because of
-; expansion-alist-pkg-names-memoize.  So we now multiply by 8.  We plan to
-; investigate a suggestion of Camm Maguire that these problems might be solved
-; by avoiding the use of interpreted code.
+; expansion-alist-pkg-names-memoize.  So we now multiply by 8.  Camm Maguire
+; has suggested that these problems might be solved by avoiding the use of
+; interpreted code, and we considered investigating whether that might be done
+; (e.g., by adding (comp t) events) in the cases above.  But we see no harm in
+; simply increasing the stack size, which could be of benefit in cases where
+; users execute uncompiled code.  And besides, when we start ACL2(h) built on
+; GCL we find that (symbol-function 'expansion-alist-pkg-names-memoize) is
+; compiled.
 
     (setq si::*multiply-stacks* 8))
   (setq *acl2-gcl-multiply-stacks-evaluated* t))
diff -Nru acl2-6.2/installation/installation.html acl2-6.3/installation/installation.html
--- acl2-6.2/installation/installation.html	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/installation/installation.html	2013-09-29 21:50:40.000000000 +0000
@@ -1,14 +1,14 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
 
-<H1><A NAME="top">ACL2 Version 6.2 Installation Guide</A></H1>
+<H1><A NAME="top">ACL2 Version 6.3 Installation Guide</A></H1>
 
 <H3>NOTE: From time to time we may provide so-called <i>incremental
 releases</i> of ACL2.  Please follow the <a
-href="http://www.cs.utexas.edu/users/moore/acl2/v6-2/new.html">recent changes
+href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/new.html">recent changes
 to this page</a> link on the <a
 href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2 home page</a> for more
 information.</H3>
@@ -28,20 +28,20 @@
 
 <ol>
 
-<li>Fetch <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/acl2.tar.gz">
-acl2.tar.gz</A> into a new directory, say <code>acl2/v6-2/</code>.</li>
+<li>Fetch <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2.tar.gz">
+acl2.tar.gz</A> into a new directory, say <code>acl2/v6-3/</code>.</li>
 
 <li>Execute the following to create directory <code>acl2-sources/</code>:<br>
 <code>tar xfz acl2.tar.gz</code></li>
 
 <li><A NAME="create-books">We strongly suggest</A> that you fetch ACL2 community books, for
   example
-  as <A HREF="http://acl2-books.googlecode.com/files/books-6.2.tar.gz">a
+  as <A HREF="http://acl2-books.googlecode.com/files/books-6.3.tar.gz">a
   tarball from the Google Code website</A>, into your
   new <code>acl2-sources/</code> directory; then execute the following
   in <code>acl2-sources/</code> to create
   directory <code>books/</code>:<br>
-<code>tar xfz books-6.2.tar.gz</code></li>
+<code>tar xfz books-6.3.tar.gz</code></li>
 
 <li><a href="requirements.html">Obtain a Common Lisp implementation</a> if you don't
 already have one.</li>
@@ -60,9 +60,9 @@
 </pre></li>
 
 <li>OPTIONAL: Download gzipped tarfiles
-for <A HREF="http://acl2-books.googlecode.com/files/workshops-6.2.tar.gz">workshops
+for <A HREF="http://acl2-books.googlecode.com/files/workshops-6.3.tar.gz">workshops
 books</A>
-and/or <A HREF="http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz">nonstd
+and/or <A HREF="http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz">nonstd
 books</A> from the Google Code website
 into the <CODE>books/</CODE> directory (but first
   create <CODE>books/</CODE> if you
@@ -76,11 +76,13 @@
     follows.
 <pre>
 make regression
-(time nice make ACL2_JOBS=8 ACL2=/u/smith/bin/acl2 regression) >& make-regression.log
+(time nice make -j 8 ACL2=/u/smith/bin/acl2 regression) >& make-regression.log
 </pre>
-    <A HREF="http://www.cs.utexas.edu/users/moore/acl2/current/REGRESSION.html">See
-    :DOC regression</A> for explanation and further options, e.g.
-    for using <A HREF="http://www.cs.utexas.edu/users/moore/acl2/current/HONS-AND-MEMOIZATION.html">ACL2(h)</A>.
+The resulting log file, <code>make-regression.log</code>, should
+contain no occurrences of the string ``CERTIFICATION FAILED''; a
+normal exit (status 0) should guarantee this.  If you want additional
+explanation and further options, see the documentation
+for <A HREF="http://www.cs.utexas.edu/users/moore/acl2/current/BOOKS-CERTIFICATION.html">BOOKS-CERTIFICATION</A>.
 
 </ol>
 
@@ -101,8 +103,8 @@
 <UL>
 <LI><A HREF="requirements.html">REQUIREMENTS</A>
 <UL>
-  <LI><A HREF="requirements.html#Obtaining-Lisp">Obtaining Common Lisp</A>
   <LI><A HREF="requirements.html#Performance">Performance comparisons</A>
+  <LI><A HREF="requirements.html#Obtaining-Lisp">Obtaining Common Lisp</A>
 </UL>
 <LI><A HREF="obtaining-and-installing.html">OBTAINING AND INSTALLING ACL2</A>
 <UL>
diff -Nru acl2-6.2/installation/installing-make.html acl2-6.3/installation/installing-make.html
--- acl2-6.2/installation/installing-make.html	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/installation/installing-make.html	2013-09-29 21:32:16.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Installing Make</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Installing Make</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -29,10 +29,8 @@
 </li>
 
 <li>
-Download GNU make version 3.80 from:
-<pre>
-http://ftp.gnu.org/pub/gnu/make/make-3.80.tar.gz
-</pre>
+Download GNU make version 3.80 from:<p>
+<code><a href="http://ftp.gnu.org/pub/gnu/make/make-3.80.tar.gz">http://ftp.gnu.org/pub/gnu/make/make-3.80.tar.gz</a></code><p>
 </li>
 
 <li>
diff -Nru acl2-6.2/installation/misc.html acl2-6.3/installation/misc.html
--- acl2-6.2/installation/misc.html	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/installation/misc.html	2013-09-29 21:50:46.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Miscellaneous Information</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Miscellaneous Information</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -60,7 +60,7 @@
 <P>
 
 If you care to use ACL2(r), we strongly suggest that you first
-<A HREF="http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz">
+<A HREF="http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz">
 download the non-standard analysis community books (gzipped tar file)</A> from
 the Google
 Code <a href="https://code.google.com/p/acl2-books/">acl2-books
@@ -69,7 +69,7 @@
 <I>dir</I>/acl2-sources/books/</code>.  Then extract to create
 subdirectory <CODE>nonstd/</CODE>:
 <pre>
-tar xvfz nonstd-6.2.tar.gz
+tar xvfz nonstd-6.3.tar.gz
 </pre>
 <p>
 Next build an executable image and certify books.  First, connect to your
@@ -100,22 +100,29 @@
 <BR><HR><BR>
 <H3><A NAME="Addresses">Links and Mailing Lists</A></H3>
 
-There are two mailing lists for ACL2 users.  You can post messages to these
+There are three mailing lists for ACL2 users.  You can post messages to these
 lists only if you are a member.
 <ul>
 <li><CODE><A
 HREF="mailto:acl2-help@utlists.utexas.edu">acl2-help@utlists.utexas.edu</A></CODE><br>
-ACL2 help list, for questions about using ACL2.
+ACL2 help list, for questions about using
+  ACL2 <font color="red">(recommended for new users)</font></li>
 <li><CODE><A
 HREF="mailto:acl2@utlists.utexas.edu">acl2@utlists.utexas.edu</A></CODE><br>
-General ACL2 list for users and others interested in ACL2.
+General ACL2 list for users and others interested in ACL2</li>
+<li><CODE><A
+HREF="mailto:acl2-books@googlegroups.com">acl2-books@googlegroups.com</A></CODE><br>
+Mailing list for discussion of cutting-edge developments in ACL2
+and the ACL2 Community Books</li>
 </ul>
 
 You may subscribe to or unsubscribe from these
 lists, or view their archives, at:
 <ul>
-<li>(<b>acl2</b> list) <code><a href="https://utlists.utexas.edu/sympa/info/acl2">https://utlists.utexas.edu/sympa/info/acl2</a></code></li>
 <li>(<b>acl2-help</b> list) <code><a href="https://utlists.utexas.edu/sympa/info/acl2-help">https://utlists.utexas.edu/sympa/info/acl2-help</a></code></li>
+<li>(<b>acl2</b> list) <code><a href="https://utlists.utexas.edu/sympa/info/acl2">https://utlists.utexas.edu/sympa/info/acl2</a></code></li>
+<li>(<b>acl2-books Google Group</b>
+  list) <code><a href="https://groups.google.com/forum/#!forum/acl2-books">https://groups.google.com/forum/#!forum/acl2-books</a></code></li>
 </ul>
 
 <P>
@@ -132,7 +139,7 @@
 <BR><HR><BR>
 <H3><A NAME="License-and-Copyright">License and Copyright</A></H3>
 
-ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp<BR>
+ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp<BR>
 Copyright (C) 2013, Regents of the University of Texas
 <P>
 This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -140,13 +147,13 @@
 <P>
 This program is free software; you can redistribute it and/or modify
 it under the terms of
-the <a href="../distrib/acl2-sources/LICENSE">LICENSE</a> file
+the <a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2-sources/LICENSE">LICENSE</a> file
 distributed with ACL2.
 <P>
 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-<a href="../distrib/acl2-sources/LICENSE">LICENSE</a> for more details.
+<a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2-sources/LICENSE">LICENSE</a> for more details.
 <P>
 Matt Kaufmann (Kaufmann@cs.utexas.edu)<BR>
 J Strother Moore (Moore@cs.utexas.edu)<BR>
diff -Nru acl2-6.2/installation/obtaining-and-installing.html acl2-6.3/installation/obtaining-and-installing.html
--- acl2-6.2/installation/obtaining-and-installing.html	2013-06-06 16:31:04.000000000 +0000
+++ acl2-6.3/installation/obtaining-and-installing.html	2013-09-29 21:51:07.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Obtaining and Installing ACL2</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Obtaining and Installing ACL2</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -31,7 +31,6 @@
     a Unix-like Systems</A>
     <LI><A HREF="#Build-Particular">Building an Executable Image on Some Particular Systems</A>
     <UL>
-      <LI><A HREF="#Mac-OS-X-GCL">Special Case: Building an Executable Image on Mac OS X using GCL</A>
       <LI><A HREF="#Windows-GCL">Special Case: Building an Executable Image on a Windows System using GCL</A>
       <LI><A HREF="windows-gcl-jared.html">Older instructions from Jared Davis for
       building ACL2 on Windows using mingw</A>
@@ -51,9 +50,9 @@
 
 <p>
 
-First, create a directory in which to store ACL2 Version 6.2.  We will
+First, create a directory in which to store ACL2 Version 6.3.  We will
 call this directory <I>dir</I>.  For example, <I>dir</I> might be
-<CODE>/home/jones/acl2/v6-2</CODE>.
+<CODE>/home/jones/acl2/v6-3</CODE>.
 
 <H3>NOTE: If you intend to obtain an incremental release (e.g. 2.9.4 as opposed
 to 2.9), please see the <a href="../new.html">ACL2 News</a> for instructions.
@@ -78,7 +77,7 @@
 <p>
 
 WARNING: Some of these packages might be for old version of ACL2.  We
-recommend that you use the latest version of ACL2 (Version 6.2).
+recommend that you use the latest version of ACL2 (Version 6.3).
 
 <UL>
 
@@ -105,7 +104,7 @@
 the certificate (<code>.cert</code>) files are automatically
 fixed, according to the full pathname of your <code>books/</code> directory.)
 Also see
-the <a href="http://www.cs.utexas.edu/users/moore/acl2/current/ACL2-SEDAN.html">ACL2
+the <a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/ACL2-SEDAN.html">ACL2
 documentation topic on the ACL2 Sedan</a>.
 
 
@@ -217,10 +216,10 @@
 
 <UL>
 
-<LI>Save <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/acl2.tar.gz">
+<LI>Save <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2.tar.gz">
     acl2.tar.gz</A> on directory <I>dir</I>.  (You can
     run <code>md5sum</code> and compare
-    with <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/acl2-tar-gz-md5sum">
+    with <A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2-tar-gz-md5sum">
     acl2-tar-gz-md5sum</A> if you wish to verify the transmission.)
   </LI>
 <BR>
@@ -250,18 +249,18 @@
 <UL>
 
   <li><b>Easy download.</b>
-    Fetch <CODE><A HREF="http://acl2-books.googlecode.com/files/books-6.2.tar.gz">a
+    Fetch <CODE><A HREF="http://acl2-books.googlecode.com/files/books-6.3.tar.gz">a
     gzipped tarfile</A></CODE> of the community books from the Google Code website, and then
     extract as follows to create a <code>books/</code>
     subdirectory:<BR>
 
-    <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz books-6.2.tar.gz</code>
+    <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz books-6.3.tar.gz</code>
   </li>
 
   <li><b><font color="red">OR</font></b>, obtain a read-only copy
     using svn as a new subdirectory, <code>books/</code>:<br>
 
-      <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svn checkout http://acl2-books.googlecode.com/svn/branches/6.2 books</code>
+      <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svn checkout http://acl2-books.googlecode.com/svn/branches/6.3 books</code>
   </li>
 	
   <li><b><font color="red">OR</font></b>, for read-write access,
@@ -270,7 +269,7 @@
     (see <a href="https://code.google.com/p/acl2-books/">the
     acl2-books project page</a>). Then:<br>
 	  
-    <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svn checkout https://acl2-books.googlecode.com/svn/branches/6.2 books --username &lt;name&gt;</code>
+    <code>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;svn checkout https://acl2-books.googlecode.com/svn/branches/6.3 books --username &lt;name&gt;</code>
   </li>
   <BR>
 
@@ -285,8 +284,8 @@
 follows, using the following links to the Google Code website.
 
 <UL>
-<LI><A HREF="http://acl2-books.googlecode.com/files/workshops-6.2.tar.gz">ACL2 Workshops books</A></LI>
-<LI><A HREF="http://acl2-books.googlecode.com/files/nonstd-6.2.tar.gz">ACL2(r) books</A></LI>
+<LI><A HREF="http://acl2-books.googlecode.com/files/workshops-6.3.tar.gz">ACL2 Workshops books</A></LI>
+<LI><A HREF="http://acl2-books.googlecode.com/files/nonstd-6.3.tar.gz">ACL2(r) books</A></LI>
 </UL>
 
 Then put the gzipped tarfile(s) in
@@ -294,8 +293,8 @@
 directory, and extract to create <CODE>workshops/</CODE>
 and <CODE>nonstd/</CODE> subdirectories, respectively:<BR>
 
-<CODE>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz workshops-6.2.tar.gz</CODE><BR>
-<CODE>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz nonstd-6.2.tar.gz</CODE>
+<CODE>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz workshops-6.3.tar.gz</CODE><BR>
+<CODE>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;tar xfz nonstd-6.3.tar.gz</CODE>
 
 </UL>
 
@@ -331,7 +330,7 @@
 <H3><A NAME="Pre-Built-Images">Short Cut:  Pre-Built ACL2 Images</A></H3>
 
 The site <a
-href="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/images/Readme.html">http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/images/Readme.html</a>
+href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html">http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html</a>
 contains links to ACL2 executables and packages.  Each <code>-md5sum</code> file
 was created using <code>md5sum</code>.  We may add additional
 links from time to time.
@@ -515,7 +514,6 @@
 Subtopics of this section are as follows.
 
     <UL>
-      <LI><A HREF="#Mac-OS-X-GCL">Special Case: Building an Executable Image on Mac OS X using GCL</A>
       <LI><A HREF="#Windows-GCL">Special Case: Building an Executable Image on a Windows System using GCL</A>
       <LI><A HREF="windows7.html">Instructions from David Rager
       for building ACL2 on Windows</A>
@@ -524,17 +522,6 @@
     </UL>
 
 <BR><HR><BR>
-<H3><A NAME="Mac-OS-X-GCL"></A>How to build/install ACL2 on GCL on Mac OS X</H3>
-
-If you want to build/install ACL2 on Mac OS X, you may find it easier to do so
-on top of <a href="requirements.html#Obtaining-CCL">CCL</a> rather than
-<a href="requirements.html#Obtaining-GCL">GCL</a>.  Otherwise, see <A
-HREF="requirements.html#gcl-mac">the directions for bulding GCL on Mac OS
-X</A>.  Then follow the usual installation instructions to <A
-HREF="#Sources">obtain the ACL2 sources</A> and <A
-HREF="#Other-Unix">build an executable image</A> on a Unix-like system.
-
-<BR><HR><BR>
 <H3><A NAME="Windows-GCL">Special Case: Building an Executable Image on a Windows System using GCL</A></H3>
 
 You may want to skip this section and instead read <A
@@ -592,12 +579,12 @@
     may be called
 <code>saved_acl2.exe</code> rather than <code>saved_acl2</code>.
 
-<!-- NOTE to developers: v6-2 below indicates a normal release, which is OK. -->
+<!-- NOTE to developers: v6-3 below indicates a normal release, which is OK. -->
 <!-- Do not edit that for incremental releases. -->
 
 <li><b>FINALLY</b>, create a file <code>acl2.bat</code> as explained in
-<code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/images/Readme.html#acl2-bat">
-http://www.cs.utexas.edu/users/moore/acl2/v6-2/distrib/images/Readme.html</a></code>.
+<code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html#acl2-bat">
+http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html</a></code>.
 
 </ol>
 
@@ -695,30 +682,39 @@
 <BR><HR noshade size=8><BR>
 <H2><A NAME="Summary">Summary of Distribution</A></H2>
 
-The distribution includes the following.  A list of all files in
-<CODE>acl2-sources</CODE> may be found in the file <CODE>all-files.txt</CODE>
-in that directory.
+The ACL2
+    distribution, <code><A HREF="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/acl2.tar.gz">
+    acl2.tar.gz</A></code>, includes the ACL2 source files as well as
+    the following files and directories (and a few others not
+    mentioned here).  Note that a <code>books/</code> directory
+    is <b>not included</b>; see instructions above to fetch the community
+    books.
 <PRE>
-Readme.html; This file
-acl2-sources/
-  LICENSE  ; ACL2 license file
-  GNUmakefile ; For GNU make
-  TAGS     ; Handy for looking at source files with emacs
-  *.lisp   ; ACL2 source files
-  all-files.txt    ; List of all files in this directory and subdirectories
-  books/   ; NOT INCLUDED; see instructions above to fetch community books
-  doc/     ; ACL2 documentation in various formats
-  emacs/   ; Miscellaneous emacs and file utilities, especially emacs-acl2.el
-  init.lisp; Useful for building the system
-  saved/   ; Empty directory for backing up copies during make; not important
-acl2.tar.gz; gzip'd tar file containing all of acl2-sources/ (see below)
-images/    ; Some gzip'd tar'd executables; see images/Readme.html
-split/     ; The result of splitting up acl2.tar.gz; see split/Readme.html
+  LICENSE       ; ACL2 license file
+  GNUmakefile   ; For GNU make
+  TAGS          ; Handy for looking at source files with emacs
+  doc/          ; ACL2 documentation in various formats
+  emacs/        ; Some helpful emacs utilities
+  installation/ ; Installation instructions (start with installation.html)
+  saved/        ; Empty directory for backing up copies during make
 </PRE>
 
+Also available are the following.
+
+<ul>
+
+<li><code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/">images/</a></code>:
+Some gzip'd tar'd executables; see <code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/images/Readme.html">images/Readme.html</a></code></li>
+
+<li><code><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/distrib/split/">split/</a></code>: The result of splitting up <code>acl2.tar.gz</code></li>
+
+</ul>
+
 <P>
-The entire acl2.tar.gz is about 7MB, which extracts to
-about 30MB.  The gzipped tarfile books-6.2.tar.gz (obtained as described
+Based on the preceding ACL2 release, we estimate that the
+entire <code>acl2.tar.gz</code> is about 7MB, which extracts to about
+30MB, and the gzipped tarfile <code>books-6.3.tar.gz</code> (obtained
+as described
 <a href="#Obtaining-books">above</a>) is about 12MB, which extracts to
 about 70MB.  Additional space is required to build an image, perhaps
 50 to 300 megabytes depending on the platform (including the host
diff -Nru acl2-6.2/installation/requirements.html acl2-6.3/installation/requirements.html
--- acl2-6.2/installation/requirements.html	2013-06-07 01:48:00.000000000 +0000
+++ acl2-6.3/installation/requirements.html	2013-09-29 21:51:11.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Requirements</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Requirements</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -8,9 +8,19 @@
 
 <b><font>[<a href="installation.html">Back to main page of Installation Guide.</a>]</font></b>
 
-<p>
+<p><hr size=3 noshade><p>
+
+ACL2 Version 6.3<br>
+Copyright (C) 2013, Regents of the University of Texas<br>
+ACL2 is licensed under the terms of the LICENSE file distributed with
+ACL2.
+
+<p><hr size=3 noshade><p>
+
+<H3>Table of Contents</H3>
 
 <UL>
+  <LI><A HREF="#Performance">Performance comparisons</A>
   <LI><A HREF="#Obtaining-Lisp">Obtaining Common Lisp</A> (alphabetical listing)
   <UL>
     <LI><A HREF="#Obtaining-Allegro">Obtaining Allegro Common Lisp</A>
@@ -21,14 +31,17 @@
     <LI><A HREF="#Obtaining-LispWorks">Obtaining LispWorks</A>
     <LI><A HREF="#Obtaining-SBCL">Obtaining SBCL</A>
   </UL>
-  <LI><A HREF="#Performance">Performance comparisons</A>
 </UL>
 
 <p><hr size=3 noshade><p>
 
-ACL2 Version 6.2 Copyright (C), Regents of the University of Texas
-ACL2 is licensed under the terms of the LICENSE file distributed with
-ACL2.
+<H3><A NAME="Performance">Performance comparisons</A></H3>
+
+You can see recent performance numbers by following <a
+href="http://www.cs.utexas.edu/users/moore/acl2/current/new.html#performance">this
+link</a>, or by going to the <a
+href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2 home page</a>
+and following the link "Recent changes to this page".
 
 <H3><A NAME="Obtaining-Lisp">Obtaining Common Lisp</A></H3>
 
@@ -50,9 +63,6 @@
 
 <p>
 
-Often we put timing comparisons
-between different lisps in the <a href="http://www.cs.utexas.edu/users/moore/acl2/current/new.html">ACL2 News</a>.
-
 <P><B><A NAME="Obtaining-Allegro">Obtaining Allegro Common Lisp</A></B><P>
 
 The website for Allegro Common Lisp, a commercial implementation, is
@@ -88,14 +98,35 @@
 </pre>
 
 Note: if you prefer the latest release, you can obtain that instead,
-for example as follows.
+for example as follows (but replace "1.9" by the latest version,
+for example as described
+at <code>http://ccl.clozure.com/download.html</code>, and
+replace <code>linuxx86</code> if appropriate as described above).
 
 <pre>
-svn co http://svn.clozure.com/publicsvn/openmcl/release/1.3/linuxx86/ccl
+svn co http://svn.clozure.com/publicsvn/openmcl/release/1.9/linuxx86/ccl
 </pre>
 
-Then create a suitable script, say as follows, where <code>DIR</code>
-is the directory above the new <code>ccl</code> directory.
+Next rebuild the executable by issuing the following commands, but
+replace "<code>./lx86cl64</code>" by a suitable executable; e.g., for
+64-bit Darwin (on Mac OS) use "<code>./dx86cl64</code>".
+
+<hr>
+<pre>
+./lx86cl64
+(rebuild-ccl :full t)
+(quit)
+./lx86cl64
+(rebuild-ccl :full t)
+(quit)
+</pre>
+<hr>
+
+<p>
+
+Now your CCL executable is up to date.  Next, create a suitable
+script, say as follows, where <code>DIR</code> is the full pathname
+for the directory above the new <code>ccl</code> directory.
 
 <hr>
 <pre>
@@ -120,14 +151,6 @@
 chmod +x my-script
 </pre>
 
-Now rebuild the CCL lisp image by invoking the above script and then
-executing the following commands.
-
-<pre>
-(ccl:rebuild-ccl :full t)
-(quit)
-</pre>
-
 Your script (invoked with a suitable pathname, or just the filename if
 the directory is on your path) will now start the updated CCL lisp
 image.
@@ -166,94 +189,81 @@
 
 <P><B><A NAME="Obtaining-GCL">Obtaining GCL</A></B><P>
 
-You do not need to fetch GCL if instead
-you <A HREF="http://packages.qa.debian.org/a/acl2.html">download a
+You might be able
+to <A HREF="http://packages.qa.debian.org/a/acl2.html">download a
 binary Debian package for ACL2</A>.  Thanks to Camm Maguire for
-maintaining this package.  Note that it may take some time after each
-ACL2 release for this binary Debian package to be updated for that
-release.  Here is a shell command that might be used to obtain that
-package.
+maintaining this package.  Note however that it may take some time
+after each ACL2 release for this binary Debian package to be updated
+for that release.  Here is a shell command that might be used to
+obtain that package (if running Debian).
 
 <pre>
-apt-get -q install gcl gcl-doc if running Debian
+apt-get -q install gcl gcl-doc
 </pre>
 
-Otherwise, you can fetch GCL in one of the ways described below.  Note
-that in Spring 2013 there were updates to GCL, reflected in ACL2, that
-allow ACL2 (starting with ACL2 Version 6.2) to build not only on
-traditional ("CLtL1") GCL but also on ANSI GCL.
-
-<p>
-
-The simplest way may be to fetch a recent version of GCL from
-  the <a href="http://www.gnu.org/software/gcl/">main GNU website for
-  GCL</a>.  The main GCL implementor has told us that he hopes to make
-  suitable versions of GCL Version 2.6.8 and GCL Version 2.6.9
-  available in tarball form at that website in approximately mid-June,
-  2013.
-
-<p>
-
-Another way to fetch a recent GCL is with the following command.  This
-particular command will retrieve recent development/unstable cvs
-sources.
+Otherwise, it should be easy to obtain and build GCL yourself.  There
+are two recommended versions of GCL for building ACL2: GCL 2.6.8 and
+GCL 2.6.10.  (GCL 2.6.9, which is <i>not</i> recommended, has some
+issues that were fixed in GCL 2.6.10.)  GCL 2.6.8 appears to be faster
+for ACL2 regressions than GCL 2.6.10; we obtained the following
+times on a 64-bit Linux system using a development snapshot of ACL2 as
+of Sept. 23, 2013.
 
 <pre>
-cvs -z9 -q -d:pserver:anonymous@cvs.sv.gnu.org:/sources/gcl \
-     co -d gcl-2.6.8pre -r Version_2_6_8pre gcl
-</pre>
+   ACL2 built on non-ANSI GCL 2.6.8:
+   33235.713u 1275.991s 1:29:23.91 643.4%	0+0k 156624+4638504io 25pf+0w
 
-As per GCL installation instructions, you may wish to build GCL as
-follows on a 64-bit linux machine, instead
-using <code>--enable-maxpage=524288</code> on a 32-bit linux machine,
-and perhaps <code>--enable-maxpage=262144</code> on a Mac.
+   ACL2 built on non-ANSI GCL 2.6.10pre:
+   40678.982u 1013.967s 1:45:06.91 661.0%	0+0k 153400+6615176io 9pf+0w
 
-<pre>
-./configure --enable-maxpage=1048576
-make
+   ACL2 built on ANSI GCL 2.6.10pre:
+   67950.466u 1050.753s 2:44:58.65 697.0%	0+0k 327160+6955712io 7pf+0w
 </pre>
 
-You can build an ANSI image by adding <code>--enable-ansi</code> to
-the above <code>./configure</code> command.  Alternatively, you might
-find suitable prebuilt binaries for a variety of machines here:
-<br>
-<code><a href="http://packages.debian.org/search?keywords=gcl">http://packages.debian.org/search?keywords=gcl</a></code>
+On the other hand, modern Common Lisp implementations are ANSI
+compliant, and GCL 2.6.10 may have better ANSI support (which is
+needed if you choose to build
+<a href="http://www.cs.utexas.edu/users/moore/acl2/v6-3/HONS-AND-MEMOIZATION.html">ACL2(h)</a>).
 
 <p>
 
-<!--
+As of this writing (late September 2013), it might be best to fetch
+GCL 2.6.8 for most purposes but GCL 2.6.10 if for some reason you want
+an ANSI build of GCL.  You can fetch it as a tarball from
+<a href="http://www.gnu.org/software/gcl/">main GNU website for
+  GCL</a>.
+From GCL source you can build an executable by extracting from the
+  tarball, standing in the resulting <code>gcl/</code> directory, and
+  issuing one of the following commands.
 
-Through Version_6.1 we included the following instructions, saying
-that "GCL maintainer Camm Maguire has suggested the following, in
-order of preference (most to least):", as an ordered list:
-
-apt-get -q install gcl gcl-doc if running Debian
-Download and install the prebuilt binaries otherwise (if available for your platform)
-Download the latest (stable) source tarball and build yourself otherwise
-Download the latest (stable) cvs branch and build yourself
+<pre>
+# Recommended for 64-bit Linux:
+./configure --enable-maxpage=1048576 && make
 
-However, it's not clear how helpful those instructions are, as opposed
-simply to spelling some things out as has been done above.
+# Recommended for Mac OS:
+./configure && make
 
--->
+# If you want an ANSI build
+# (but add "--enable-maxpage=1048576" as above for linux):
+./configure --enable-ansi && make
+</pre>
 
-<!--
-Through Version_6.1 there were instructions here from Robert Krug for
-building on a Mac.  But Matt Kaufmann built ACL2 on a Mac in May,
-2013, by following normal GCL instructions, modified as shown below.
--->
+As of late September 2013, GCL 2.6.10 is not yet available as a
+tarball.  However, you can get a pre-release (which we expect to work
+fine, having used it successfully ourselves) like this (assuming you
+have <code>git</code> installed):
 
-<p>
+<pre>
+git clone git://git.sv.gnu.org/gcl.git
+cd gcl
+git checkout Version_2_6_10pre
+cd gcl
+</pre>
 
-<i>Note</i>: On rare occasions you may see a hard error when using GCL
-obtained before early June, 2013, sometimes (not always) labeled as
-"bad plist", that may be due to interaction between GCL and GNU Make.
-The main GCL implementor has told us that he has fixed this problem,
-and will provide tarballs at
-the <a href="http://www.gnu.org/software/gcl/">main GNU website for
-  GCL</a> in approximately mid-June, 2013 (as noted above).
+Then run <code>configure</code> and <code>make</code> as indicated
+above.
 
-<P>
+<p>
 
 <P><B><A NAME="Obtaining-LispWorks">Obtaining LispWorks</A></B><P>
 
@@ -271,6 +281,8 @@
 
 <p>
 
+<!-- I don't know that we need this comment any longer, since we write
+    a suitable --dynamic-space-size argument to saved_acl2 scripts.
 Note for 32-bit linux users: When building ACL2 with SBCL 1.0.18 and
 1.0.39 on 32-bit Linux, we ran out of memory with the SBCL message
 "Heap exhausted, game over."  We solved the problem by modifying our
@@ -286,14 +298,7 @@
 
 Your results may vary; one user has reported solving the problem with
 <code>--dynamic-space-size 2000000000</code>.
-
-<H3><A NAME="Performance">Performance comparisons</A></H3>
-
-You can see recent performance numbers by following <a
-href="http://www.cs.utexas.edu/users/moore/acl2/current/new.html#performance">this
-link</a>, or by going to the <a
-href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2 home page</a>
-and following the link "Recent changes to this page".
+-->
 
 <p>
 
diff -Nru acl2-6.2/installation/using.html acl2-6.3/installation/using.html
--- acl2-6.2/installation/using.html	2013-06-06 16:31:05.000000000 +0000
+++ acl2-6.3/installation/using.html	2013-09-29 21:38:45.000000000 +0000
@@ -1,5 +1,5 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 Installation Guide: Using ACL2</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 Installation Guide: Using ACL2</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
@@ -63,7 +63,7 @@
 <I>dir</I><CODE>/acl2-sources/saved_acl2</CODE><BR>
 <BR><BR>
 
-Note: A carriage return in the file after the last line above is important!
+Note: A carriage return in the file after the last line above may be important!
 <P>
 
 <BR>
@@ -72,13 +72,13 @@
 When you invoke ACL2, you should see the host Common Lisp 
 print a header concerning the ACL2 version, license and copyright.
 <P>
-Some hosts then automatically enter the ACL2 ``command loop,'' an ACL2
+Most or all hosts then automatically enter the ACL2 ``command loop,'' an ACL2
 read-eval-print loop with the prompt:
 <PRE>
 ACL2 !>
 </PRE>
-Other hosts will leave you in Common Lisp's read-eval-print loop.
-If yours is one of the latter, evaluate the Common Lisp expression
+If however a host leaves you in Common Lisp's read-eval-print loop,
+then you'll need to evaluate the Common Lisp expression
 <CODE>(ACL2::LP)</CODE> or simply <CODE>(LP)</CODE> if the current
 package is <CODE>"ACL2"</CODE>.
 <P>
@@ -181,7 +181,7 @@
 The <CODE>certify-books</CODE> target does not cause <code>workshops/</code> books to
 be certified.  If you want to certify those books as well, you will
 first need to
-<a href="http://acl2-books.googlecode.com/files/workshops-6.2.tar.gz">download
+<a href="http://acl2-books.googlecode.com/files/workshops-6.3.tar.gz">download
 the gzipped tar file of the workshops books</a>
 from the Google Code website to
 the <CODE>books/</CODE> directory, and then gunzip and extract it
@@ -240,7 +240,7 @@
 read with an interactive browser.  The documentation is available in
 several formats: HTML, Texinfo, Postscript and ACL2 documentation
 strings, and more recently,
-in <a href="http://fv.centtech.com/acl2/6.2/doc/">web-browsable form
+in <a href="http://fv.centtech.com/acl2/latest/doc/">web-browsable form
 with some community books' documentation</a>, courtesy of Jared Davis.  The ACL2
 documentation is copyrighted by the Regents of the University of Texas
 under the terms of the LICENSE file distributed with ACL2.
@@ -309,12 +309,13 @@
 
 <P><B>Postscript</B><P>
 
-The Postscript version of the documentation is not included in our normal
-distribution because it is so much less useful than the hyper-text versions.
-But a <A
-HREF="http://www.cs.utexas.edu/users/moore/publications/acl2-book.ps.gz">gzipped
-Postscript (2.5 MB)</A> version is available.  It prints as a book of over 2100
-pages and contains a Table of Contents and an index to all documented topics.
+The Postscript version of the documentation is not included in our
+normal distribution because it is so much less useful than the
+hyper-text versions.  But
+a <A HREF="http://www.cs.utexas.edu/users/moore/publications/acl2-book.ps.gz">gzipped
+Postscript (2.6 MB)</A> version is available.  It prints as a book of
+over 2200 pages and contains a Table of Contents and an index to all
+documented topics.
 
 <P><B>ACL2 Documentation Strings</B><P>
 
diff -Nru acl2-6.2/interface-raw.lisp acl2-6.3/interface-raw.lisp
--- acl2-6.2/interface-raw.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/interface-raw.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -6582,7 +6582,6 @@
     (ld-skip-proofsp . ,ld-skip-proofsp)
     (ld-redefinition-action . nil)
     (ld-prompt . ,(if ld-skip-proofsp nil t))
-    (ld-keyword-aliases . nil)
     (ld-missing-input-ok . nil)
     (ld-pre-eval-filter . :all)
     (ld-pre-eval-print . ,(if ld-skip-proofsp nil t))
@@ -7065,7 +7064,44 @@
                    (lisp-implementation-type)
                    '(lisp-implementation-version)
                    (lisp-implementation-version))
-           (error "Check failed!")))))))
+           (error "Check failed!")))))
+
+; The following is a start on checking that we don't have superfluous symbols
+; in the list values of certain constants.  But in fact there can be such
+; symbols: we want the value for each constant must be independent of
+; features :hons or :acl2-par, yet some macros and functions are only defined
+; when such features are present.  We may think more about this later.
+
+;   (let ((undefined-macros
+;          (loop for x in *primitive-macros-with-raw-code*
+;                when (not (or (macro-function x) (symbol-function x)))
+;                collect x))
+;         (undefined-program-fns
+;          (loop for x in *primitive-program-fns-with-raw-code*
+;                when (not (fboundp x))
+;                collect x))
+;         (undefined-logic-fns
+;          (loop for x in *primitive-logic-fns-with-raw-code*
+;                when (not (fboundp x))
+;                collect x)))
+;     (when undefined-macros
+;       (format
+;        t
+;        "Undefined macros in *primitive-macros-with-raw-code*:~%~s~%"
+;        undefined-macros))
+;     (when undefined-program-fns
+;       (format
+;        t
+;        "Undefined macros in *primitive-program-fns-with-raw-code*:~%~s~%"
+;        undefined-program-fns))
+;     (when undefined-logic-fns
+;       (format
+;        t
+;        "Undefined macros in *primitive-logic-fns-with-raw-code*:~%~s~%"
+;        undefined-logic-fns))
+;     (when (or undefined-macros undefined-program-fns undefined-logic-fns)
+;       (error "Check failed!")))
+    ))
 
 (defun-one-output check-none-ideal (trips acc)
   (cond
@@ -7605,7 +7641,9 @@
                                home)
                               t)
                              #-(and mcl (not ccl))
-                             (our-truename home t)
+                             (our-truename home
+                                           "Note: Calling OUR-TRUENAME from ~
+                                            INITIAL-CUSTOMIZATION-FILENAME")
                              (os (w *the-live-state*))
                              *the-live-state*)
                             "acl2-customization")))
@@ -7663,6 +7701,9 @@
 ; our-truename will generally return nil.  Hence, we sometimes call
 ; our-truename on "" rather than on a file name.
 
+  (when args
+    (error "LP takes no arguments."))
+
   (with-more-warnings-suppressed
 
 ; Parallelism wart: we currently reset the parallelism variables twice on
@@ -7700,12 +7741,7 @@
    (f-put-global 'parallel-execution-enabled t *the-live-state*)
    (let ((state *the-live-state*)
          #+(and gcl (not cltl2))
-         (lisp::*break-enable* (debugger-enabledp *the-live-state*))
-         (raw-p
-          (cond
-           ((null args) nil)
-           ((equal args '(raw)) 'raw)
-           (t (error "LP either takes no args or a single argument, 'raw.")))))
+         (lisp::*break-enable* (debugger-enabledp *the-live-state*)))
      (cond
       ((> *ld-level* 0)
        (when (raw-mode-p *the-live-state*)
@@ -7715,19 +7751,9 @@
                :set-raw-mode nil.~|"
               nil (standard-co *the-live-state*) *the-live-state* nil))
        (return-from lp nil))
-      (*lp-ever-entered-p*
-       (f-put-global 'standard-oi
-                     (if (and raw-p (not (raw-mode-p state)))
-                         (cons '(set-raw-mode t)
-                               *standard-oi*)
-                       *standard-oi*)
-                     *the-live-state*)
-       (with-suppression ; package locks, not just warnings; to read 'cl::foo
-        (ld-fn (f-get-ld-specials *the-live-state*)
-               *the-live-state*
-               nil)))
-      (t (set-initial-cbd)
-         (eval `(in-package ,*startup-package-name*)) ;only changes raw Lisp pkg
+      ((not *lp-ever-entered-p*)
+       (set-initial-cbd)
+       (eval `(in-package ,*startup-package-name*)) ;only changes raw Lisp pkg
 
 ; We formerly set *debugger-hook* at the top level using setq, just below the
 ; definition of our-abort.  But that didn't work in Lispworks, where that value
@@ -7736,8 +7762,8 @@
 ; globally to nil when input comes from a file, which is how ACL2 is built,
 ; rather than standard-input,
 
-         #-(and gcl (not cltl2))
-         (setq *debugger-hook* 'our-abort)
+       #-(and gcl (not cltl2))
+       (setq *debugger-hook* 'our-abort)
 
 ; Even with the setting of *stack-overflow-behaviour* to nil or :warn in
 ; acl2-init.lisp, we cannot eliminate the following form for LispWorks.  (We
@@ -7746,65 +7772,66 @@
 ; certifying community books books/concurrent-programs/bakery/stutter2 and
 ; books/unicode/read-utf8.lisp.)
 
-         #+lispworks (hcl:extend-current-stack 400)
+       #+lispworks (hcl:extend-current-stack 400)
 
-         #+(and lispworks acl2-par)
-         (when (< (hcl:current-stack-length)
+       #+(and lispworks acl2-par)
+       (when (< (hcl:current-stack-length)
 
 ; Keep the below number (currently 80000) in sync with the value given to
 ; *sg-default-size* (set elsewhere in our code).
 
-                  80000)
-           (hcl:extend-current-stack
+                80000)
+         (hcl:extend-current-stack
 
 ; this calculation sets the current stack length to be within 1% of 80000
 
-            (- (round (* 100 (/ (hcl:current-stack-length) 80000))) 100)))
+          (- (round (* 100 (/ (hcl:current-stack-length) 80000))) 100)))
 
 ; Acl2-default-restart isn't enough in Allegro, at least, to get the new prompt
 ; when we start up:
 
-         (let* ((system-dir (let ((str (getenv$-raw "ACL2_SYSTEM_BOOKS")))
-                              (and str
-                                   (maybe-add-separator str))))
-                (save-expansion (let ((s (getenv$-raw "ACL2_SAVE_EXPANSION")))
-                                  (and s
-                                       (not (equal s ""))
-                                       (not (equal (string-upcase s)
-                                                   "NIL")))))
-                (user-home-dir-path (our-user-homedir-pathname))
-                (user-home-dir0 (and user-home-dir-path
-                                     (our-truename user-home-dir-path t)))
-                (user-home-dir (and user-home-dir0
-                                    (if (eql (char user-home-dir0
-                                                   (1- (length user-home-dir0)))
-                                             *directory-separator*)
-                                        (subseq user-home-dir0
-                                                0
-                                                (1- (length user-home-dir0)))
-                                      user-home-dir0))))
-           (when system-dir
-             (f-put-global 'system-books-dir
-                           (canonical-dirname!
-                            (unix-full-pathname system-dir)
-                            'lp
-                            *the-live-state*)
-                           *the-live-state*))
-           (when (and save-expansion
-                      (not (equal (string-upcase save-expansion)
-                                  "NIL")))
-             (f-put-global 'save-expansion-file t *the-live-state*))
-           (when user-home-dir
-             (f-put-global 'user-home-dir user-home-dir *the-live-state*)))
-         (set-gag-mode-fn :goals *the-live-state*)
-         #-hons
+       (let* ((system-dir (let ((str (getenv$-raw "ACL2_SYSTEM_BOOKS")))
+                            (and str
+                                 (maybe-add-separator str))))
+              (save-expansion (let ((s (getenv$-raw "ACL2_SAVE_EXPANSION")))
+                                (and s
+                                     (not (equal s ""))
+                                     (not (equal (string-upcase s)
+                                                 "NIL")))))
+              (user-home-dir-path (our-user-homedir-pathname))
+              (user-home-dir0 (and user-home-dir-path
+                                   (our-truename user-home-dir-path
+                                                 "Note: Calling ~
+                                                    OUR-TRUENAME from LP.")))
+              (user-home-dir (and user-home-dir0
+                                  (if (eql (char user-home-dir0
+                                                 (1- (length user-home-dir0)))
+                                           *directory-separator*)
+                                      (subseq user-home-dir0
+                                              0
+                                              (1- (length user-home-dir0)))
+                                    user-home-dir0))))
+         (when system-dir
+           (f-put-global 'system-books-dir
+                         (canonical-dirname!
+                          (unix-full-pathname system-dir)
+                          'lp
+                          *the-live-state*)
+                         *the-live-state*))
+         (when (and save-expansion
+                    (not (equal (string-upcase save-expansion)
+                                "NIL")))
+           (f-put-global 'save-expansion-file t *the-live-state*))
+         (when user-home-dir
+           (f-put-global 'user-home-dir user-home-dir *the-live-state*)))
+       (set-gag-mode-fn :goals *the-live-state*)
+       #-hons
 ; Hons users are presumably advanced enough to tolerate the lack of a
 ; "[RAW LISP]" prompt.
-         (install-new-raw-prompt)
-         (setq *lp-ever-entered-p* t)
-         #+hons (f-put-global 'serialize-character-system #\Z state)
-         #+(and (not acl2-loop-only) acl2-rewrite-meter)
-         (setq *rewrite-depth-alist* nil)
+       (install-new-raw-prompt)
+       #+hons (f-put-global 'serialize-character-system #\Z state)
+       #+(and (not acl2-loop-only) acl2-rewrite-meter)
+       (setq *rewrite-depth-alist* nil)
 
 ; Without the following call, it was impossible to read and write with ACL2 I/O
 ; functions to *standard-co* in CLISP 2.30.  Apparently the appropriate Lisp
@@ -7812,7 +7839,7 @@
 ; up.  So we "refresh" the appropriate property lists with the current such
 ; Lisp streams.
 
-         (setup-standard-io)
+       (setup-standard-io)
 
 ; The following applies to CLISP 2.30, where charset:iso-8859-1 is defined, not to
 ; CLISP 2.27, where charset:utf-8 is not defined.  It apparently has to be
@@ -7820,63 +7847,71 @@
 ; before saving an image, but the value of custom:*default-file-encoding* at
 ; startup was #<ENCODING CHARSET:ASCII :UNIX>.
 
-         #+(and clisp unicode)
-         (setq custom:*default-file-encoding* charset:iso-8859-1)
-         #+gcl
+       #+(and clisp unicode)
+       (setq custom:*default-file-encoding* charset:iso-8859-1)
+       #+gcl
 
 ; In GCL, at least through Version 2.6.7, there are only 1024 indices n
 ; available for the #n= reader macro.  That is such a small number that for
 ; GCL, we turn off the use of this reader macro when printing out files such as
 ; .cert files.
 
-         (f-put-global 'print-circle-files nil state)
-         (let ((customization-full-file-name
-                (initial-customization-filename)))
-           (cond
-            ((or (eq customization-full-file-name :none)
-                 (global-val 'boot-strap-flg (w state)))
-             nil)
-            (customization-full-file-name
+       (f-put-global 'print-circle-files nil state)
+       (let ((customization-full-file-name
+              (initial-customization-filename)))
+         (cond
+          ((or (eq customization-full-file-name :none)
+               (global-val 'boot-strap-flg (w state)))
+           nil)
+          (customization-full-file-name
 
 ; If the ACL2 customization file exists (and we are not booting) then it hasn't
 ; been included yet, and we include it now.
 
-             (fms "Customizing with ~x0.~%"
-                  (list (cons #\0 customization-full-file-name))
-                  *standard-co*
-                  state
-                  nil)
-             (let ((old-infixp (f-get-global 'infixp *the-live-state*)))
-               (f-put-global 'infixp nil *the-live-state*)
-               (with-suppression ; package locks, not just warnings, for read
-                (state-free-global-let*
-                 ((connected-book-directory
-                   (f-get-global 'connected-book-directory state)))
-                 (ld-fn (put-assoc-eq
-                         'standard-oi
-                         (if (and raw-p (not (raw-mode-p state)))
-                             (cons '(set-raw-mode t)
-                                   customization-full-file-name)
-                           customization-full-file-name)
-                         (put-assoc-eq
-                          'ld-error-action :return
-                          (f-get-ld-specials *the-live-state*)))
-                        *the-live-state*
-                        nil)))
-               (f-put-global 'infixp old-infixp *the-live-state*)))))
-         (f-put-global 'standard-oi
-                       (if (and raw-p (not (raw-mode-p state)))
-                           (cons '(set-raw-mode t)
-                                 *standard-oi*)
-                         *standard-oi*)
-                       *the-live-state*)
-         (f-put-global 'ld-error-action :continue *the-live-state*)
-         (with-suppression ; package locks, not just warnings; to read 'cl::foo
-          (ld-fn (f-get-ld-specials state)
-                 *the-live-state*
-                 nil))))
-     (fms "Exiting the ACL2 read-eval-print loop.  To re-enter, execute (LP)."
-          nil *standard-co* *the-live-state* nil)
+           (fms "Customizing with ~x0.~%"
+                (list (cons #\0 customization-full-file-name))
+                *standard-co*
+                state
+                nil)
+           (let ((old-infixp (f-get-global 'infixp *the-live-state*)))
+             (f-put-global 'infixp nil *the-live-state*)
+             (with-suppression ; package locks, not just warnings, for read
+              (state-free-global-let*
+               ((connected-book-directory
+                 (f-get-global 'connected-book-directory state)))
+               (ld-fn (put-assoc-eq
+                       'standard-oi
+                       customization-full-file-name
+                       (put-assoc-eq
+                        'ld-error-action :return
+                        (f-get-ld-specials *the-live-state*)))
+                      *the-live-state*
+                      nil)))
+             (f-put-global 'infixp old-infixp *the-live-state*)))))
+       (f-put-global 'ld-error-action :continue *the-live-state*)))
+     (with-suppression ; package locks, not just warnings; to read 'cl::foo
+      (cond ((and *return-from-lp*
+                  (not *lp-ever-entered-p*))
+             (f-put-global 'standard-oi
+                           `(,*return-from-lp* (value :q))
+                           *the-live-state*)
+             (setq *return-from-lp* nil)
+             (setq *lp-ever-entered-p* t)
+             (state-free-global-let*
+              ((ld-verbose nil)
+               (ld-prompt nil)
+               (ld-post-eval-print nil))
+              (ld-fn (f-get-ld-specials *the-live-state*)
+                     *the-live-state*
+                     nil)))
+            (t (setq *lp-ever-entered-p* t)
+               (f-put-global 'standard-oi *standard-oi* *the-live-state*)
+               (ld-fn (f-get-ld-specials *the-live-state*)
+                      *the-live-state*
+                      nil)
+               (fms "Exiting the ACL2 read-eval-print loop.  To re-enter, ~
+                     execute (LP)."
+                    nil *standard-co* *the-live-state* nil))))
      #+(and acl2-par lispworks)
      (spawn-extra-lispworks-listener)
      (values))))
@@ -8091,11 +8126,15 @@
                                             'logic-fns-with-raw-code
                                             state)))
                                       (format t
-                                              "; (ACL2 Note) Compiling ~
-                                               separately due to raw code: ~
-                                               ~s~&"
+                                              "; (ACL2 Note) Attempting ~
+                                               separate compilation due to ~
+                                               raw code: ~s~&"
+
+; We ignore errors (if possible), since for example, we have seen LispWorks
+; complain when (car x) names a function that is a lexical closure.
+
                                               (car x))
-                                      (compile (car x)))
+                                      (our-ignore-errors (compile (car x))))
                                      (t (print-object$ (cons 'defun x)
                                                        chan state))))))))
                    ((and (eq (car trip) 'cltl-command)
@@ -8148,7 +8187,9 @@
          (gcl-flg
           #+gcl
           (compile-file
-           (our-truename (pathname-unix-to-os fn-file state) t)
+           (our-truename (pathname-unix-to-os fn-file state)
+                         "Note: Calling OUR-TRUENAME from ~
+                          COMPILE-UNCOMPILED-DEFUNS (under gcl-flg and #+gcl).")
            :c-file t :h-file t)
           #-gcl
           (er hard 'compile-uncompiled-defuns
@@ -8157,7 +8198,8 @@
          (t
           (let ((lisp-file
                  (our-truename (pathname-unix-to-os fn-file state)
-                               t)))
+                               "Note: Calling OUR-TRUENAME from ~
+                                COMPILE-UNCOMPILED-DEFUNS.")))
             (compile-file lisp-file)
             (when (not (keep-tmp-files state))
               (delete-file lisp-file)
@@ -8380,7 +8422,10 @@
          (gcl-flg
           #+gcl
           (compile-file
-           (our-truename (pathname-unix-to-os fn-file state) t)
+           (our-truename (pathname-unix-to-os fn-file state)
+                         "Note: Calling OUR-TRUENAME from ~
+                          COMPILE-UNCOMPILED-*1*-DEFUNS (under gcl-flg and ~
+                          #+gcl).")
            :c-file t :h-file t)
           #-gcl
           (er hard 'compile-uncompiled-defuns
@@ -8388,7 +8433,9 @@
                legal when running under GCL."))
          (t
           (let ((lisp-file
-                 (our-truename (pathname-unix-to-os fn-file state) t)))
+                 (our-truename (pathname-unix-to-os fn-file state)
+                               "Note: Calling OUR-TRUENAME from ~
+                                COMPILE-UNCOMPILED-*1*-DEFUNS.")))
             (compile-file lisp-file)
             (when (not (keep-tmp-files state))
               (delete-file lisp-file)
@@ -8633,11 +8680,11 @@
   (cond ((eq fn 'cons)
 ; We call this function on cons so often we optimize it.
          '(nil))
-        ((eq fn 'return-last)
+        ((member-eq fn '(if return-last))
          (interface-er "Implementation error in ~
                         get-stobjs-out-for-declare-form: Attempted to find ~
                         stobjs-out for ~x0."
-                       'return-last))
+                       fn))
         (t (let ((w (w *the-live-state*)))
              (or (getprop fn 'stobjs-out nil 'current-acl2-world w)
                  (and (getprop fn 'symbol-class nil 'current-acl2-world w)
@@ -8666,3 +8713,24 @@
       (eval `(untrace$ ,@to-untrace)))
     (when to-retrace
       (eval `(trace$ ,@to-retrace)))))
+
+; We define acl2-books-revision here rather than in acl2-init.lisp, so that
+; f-get-global is already defined.
+
+(defun acl2-books-revision ()
+
+; We define acl2-books-revision here in interface-raw.lisp rather than in
+; acl2-init.lisp, so that f-get-global is already defined.
+
+  (multiple-value-bind
+      (exit-code line)
+      (system-call+
+       (concatenate
+        'string
+        (f-get-global 'acl2-sources-dir *the-live-state*)
+        "bin/svn-info-books")
+       (list (f-get-global 'system-books-dir *the-live-state*)))
+    (cond ((or (not (eql exit-code 0))
+               (equal line ""))
+           "????")
+          (t (svn-revision-from-line line)))))
diff -Nru acl2-6.2/ld.lisp acl2-6.3/ld.lisp
--- acl2-6.2/ld.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/ld.lisp	2013-09-30 15:51:48.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -189,17 +189,16 @@
            (er-progn
             (get-and-chk-last-make-event-expansion
 
-; We allow time$ and with-prover-time-limit at the top level only for purposes
-; of tracking make-event, for now.  If there is user demand, we could consider
-; allowing these in arbitrary positions of embedded event forms, though in that
-; case we should be careful to check that nested calls work well.  Note that we
-; look for time$ and with-prover-time-limit, not for return-last, because we
-; are looking at a user-supplied form, not its macroexpansion.
+; For purposes of tracking make-event, we allow time$ only at the top level.
+; If there is user demand, we could consider allowing it in arbitrary positions
+; of embedded event forms, though in that case we should be careful to check
+; that nested calls work well.  Note that we look for time$, not for
+; return-last, because we are looking at a user-supplied form, not its
+; macroexpansion.
 
              (cond ((consp form)
                     (case (car form)
                       (time$ (cadr form))
-                      (with-prover-time-limit (caddr form))
                       (otherwise form)))
                    (t form))
              wrld 'top-level state
@@ -361,9 +360,6 @@
           (ld-prompt
            (er-progn (chk-ld-prompt val ctx state)
                      (value pair)))
-          (ld-keyword-aliases
-           (er-progn (chk-ld-keyword-aliases val ctx state)
-                     (value pair)))
           (ld-missing-input-ok
            (er-progn (chk-ld-missing-input-ok val ctx state)
                      (value pair)))
@@ -625,8 +621,6 @@
          (f-put-global 'ld-redefinition-action (cdar alist) state))
         (ld-prompt
          (f-put-global 'ld-prompt (cdar alist) state))
-        (ld-keyword-aliases
-         (f-put-global 'ld-keyword-aliases (cdar alist) state))
         (ld-missing-input-ok
          (f-put-global 'ld-missing-input-ok (cdar alist) state))
         (ld-pre-eval-filter
@@ -674,8 +668,6 @@
               (f-get-global 'ld-redefinition-action state))
         (cons 'ld-prompt
               (f-get-global 'ld-prompt state))
-        (cons 'ld-keyword-aliases
-              (f-get-global 'ld-keyword-aliases state))
         (cons 'ld-missing-input-ok
               (f-get-global 'ld-missing-input-ok state))
         (cons 'ld-pre-eval-filter
@@ -764,8 +756,7 @@
 ; the parsed form of the command read, e.g., (acl2::ubt 'foo).  If non-nil,
 ; keyp is the actual list of objects read, e.g., (:ubt foo).
 
-  (let ((temp (assoc-eq key
-                        (f-get-global 'ld-keyword-aliases state))))
+  (let ((temp (assoc-eq key (ld-keyword-aliases state))))
     (cond
      (temp
       (mv-let (erp args state)
@@ -1851,7 +1842,6 @@
               (ld-skip-proofsp 'same ld-skip-proofspp)
               (ld-redefinition-action 'same ld-redefinition-actionp)
               (ld-prompt 'same ld-promptp)
-              (ld-keyword-aliases 'same ld-keyword-aliasesp)
               (ld-missing-input-ok 'same ld-missing-input-okp)
               (ld-pre-eval-filter 'same ld-pre-eval-filterp)
               (ld-pre-eval-print 'same ld-pre-eval-printp)
@@ -1885,7 +1875,6 @@
                                    ;   (~pl[ld-skip-proofsp])
       :ld-redefinition-action ...  ; nil or '(:a . :b)
       :ld-prompt          ...      ; nil, t, or some prompt printer fn
-      :ld-keyword-aliases ...      ; an alist pairing keywords to parse info
       :ld-missing-input-ok ...     ; nil, t, :warn, or warning message
       :ld-pre-eval-filter ...      ; :all, :query, or some new name
       :ld-pre-eval-print  ...      ; nil, t, or :never
@@ -2131,10 +2120,6 @@
              (if ld-promptp
                  (list `(cons 'ld-prompt ,ld-prompt))
                  nil)
-             (if ld-keyword-aliasesp
-                 (list `(cons 'ld-keyword-aliases
-                              ,ld-keyword-aliases))
-                 nil)
              (if ld-missing-input-okp
                  (list `(cons 'ld-missing-input-ok ,ld-missing-input-ok))
                nil)
@@ -2310,7 +2295,6 @@
           state)))
        (if ans
            (ld (list cmd)
-               :ld-keyword-aliases nil
                :ld-pre-eval-filter :all
                :ld-pre-eval-print t
                :ld-post-eval-print :command-conventions
@@ -2409,7 +2393,6 @@
          (if redo-cmds
              (ld redo-cmds
                  :ld-redefinition-action '(:doit! . :overwrite)
-                 :ld-keyword-aliases nil
                  :ld-pre-eval-filter :all
                  :ld-pre-eval-print t
                  :ld-post-eval-print :command-conventions
@@ -2771,7 +2754,6 @@
           :proofs-co *standard-co*
           :ld-skip-proofsp t
           :ld-prompt nil
-          :ld-keyword-aliases nil
           :ld-missing-input-ok nil
           :ld-pre-eval-filter filter
           :ld-pre-eval-print nil
@@ -3280,7 +3262,7 @@
 
   ACL2 copyright, license, sponsorship~/~/
 
-  ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+  ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
   Copyright (C) 2013, Regents of the University of Texas
 
   This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -3493,19 +3475,6 @@
   quitting from the break will only return you to that environment, not to the
   top of ACL2's read-eval-print loop.~/")
 
-(deflabel saving-and-restoring
-  :doc
-  ":Doc-Section Miscellaneous
-
-  saving and restoring your logical state~/
-
-  One normally works on an ACL2-based project by developing ~il[books], which
-  can then be included when continuing on that project in later ACL2 sessions;
-  ~pl[include-book].  However, this approach can be time-consuming when there
-  are very large collections of ~il[books] to be included.  See ~pl[save-exec]
-  for the description of a utility that saves your ACL2 state so that you can
-  immediately re-start later in that same state.~/~/")
-
 (deflabel ordinals
   :doc
   ":Doc-Section Miscellaneous
@@ -20461,6 +20430,8 @@
 
 (deflabel note-6-2
 
+; Total number of release note items: 41.
+
 ; Here is the example from Sol Swords for the item below about acl2-magic-mfc
 ; and acl2-magic-canonical-pathname.  The problem was that these "placeholder"
 ; functions are really clause processors, and hence should return a list of
@@ -20639,6 +20610,8 @@
 ; Modified *home-page* for searching books, to point to tag
 ; #Searching_and_browsing_the_books.
 
+; For SBCL only, increased --control-stack-size from 4 to 8.
+
   :doc
   ":Doc-Section release-notes
 
@@ -20648,7 +20621,7 @@
   ~il[documentation] has been updated to reflect all changes that are recorded
   here.
 
-  Below we roughly organize the changes since Version  6.1 into the following
+  Below we roughly organize the changes since Version 6.1 into the following
   categories of changes: existing features, new features, heuristic
   improvements, bug fixes, changes at the system level, Emacs support, and
   experimental versions.  Each change is described in just one category, though
@@ -20956,6 +20929,434 @@
 
   ~/~/")
 
+(deflabel note-6-3
+
+; Total number of release note items: 36.
+
+; (CMUCL only) Allocated larger stack for CMUCL on 64-bit x86 installations.
+
+; Evaluation of a redundant encapsulate event, in the case that the event is
+; not equal to the corresponding earlier encapsulate event, now causes an
+; additional message to be printed that directs the user to a new :doc topic --
+; redundant-events -- which explains the situation (and includes some :doc that
+; was formerly in :doc encapsulate).  Because of this, stop-redundant-event has
+; been modified.  Thanks to Carl Eastlund for suggesting improvements along
+; these lines.
+
+; Modified functions stobjs-out and get-stobjs-out-for-declare-form according
+; to a suggestion from Jared Davis, to cause an error when attempting to
+; determine the stobjs-out for IF just as we already do for RETURN-LAST.
+
+; Regarding the "bug in the case of a field of a (concrete) stobj that is an
+; abstract stobj": this was a bug in the #-acl2-loop-only case of
+; get-stobj-creator.
+
+; Here is a little example showing the change to :by hints involving
+; quote-normal form.  The proof of the THM failed until this change was made.
+;
+;   (defthm my-thm
+;     (equal (car '(3 . 4)) 3)
+;     :rule-classes nil)
+;
+;   (thm (equal (car (cons 3 4)) 3)
+;        :hints (("Goal" :by my-thm)))
+
+; (GCL only) Just below is a book, certifiable in ACL2 Version_6.2,
+; illustrating the "obscure soundness bug due to an error in the GCL
+; implementation of set-debugger-enable".  The problem was that the definition
+; of set-debugger-enable-fn ended with #-acl2-loop-only code of the form (when
+; (live-state-p state) ... state), which erroneously returns nil for a non-live
+; state.
+;
+;   (in-package "ACL2")
+;
+;   (defthm false-formula
+;     (equal (set-debugger-enable-fn nil (build-state))
+;            nil)
+;     :rule-classes nil)
+;
+;   (defthm true-formula
+;     (implies (state-p1 s)
+;              (state-p1 (set-debugger-enable-fn nil s)))
+;     :hints (("Goal" :in-theory (enable state-p1)))
+;     :rule-classes nil)
+;
+;   (defthm contradiction
+;     nil
+;     :hints (("Goal"
+;              :use (false-formula
+;                    (:instance true-formula
+;                               (s (build-state))))))
+;     :rule-classes nil)
+
+; Improved our-truename (definition and calls) so that in case of an error, we
+; get additional information.
+
+; Added new :doc topic, ignored-attachment, pointing to it in the message
+; printed by function ignored-attachment-msg.
+
+; Changed all-equal to have a test of atom instead of endp, so that it
+; could be guard-verifiable as requested by Eric Smith.
+
+; Updated :doc make-event to clarify that it is legal to call make-event during
+; make-event expansion, even outside an event context.
+
+; Modified function maybe-add-command-landmark to avoid giving special
+; treatment to with-prover-time-limit, since with-prover-time-limit is
+; a full-fledged event constructor and hence this is not necessary.
+
+; Removed definition of obsolete function, called acl2, from the
+; sources.
+
+; Slightly changed wording pertaining to the "combined" (xdoc) manual on the
+; ACL2 home page.
+
+; Fixed TAGS! target in GNUmakefile to do what it has been claming to
+; do: rebuild TAGS even when TAGS is up-to-date with respect to the
+; source files.
+
+; Added new state global, acl2-sources-dir, in support of the new ACL2 startup
+; banner in the case of an svn version.
+
+; The guard for function ENDP has potentially been made trivially more
+; efficient by using EQ to test against nil instead of EQUAL.
+
+; In support of :by hint processing (see the :doc string below),
+; remove-guard-holders now returns a term in quote normal form, even when the
+; input term contains no guard holders.
+
+; The startup banner can now be suppressed, though only by unsanctioned hacking
+; in raw Lisp, as requested by Jared Davis.  See *print-startup-banner*, which
+; has a comment explaining more about how this may not be appropriate and what
+; needs to be done to suppress startup information.
+
+; Removed support for "make fast", "make very-fast", and "make fast-meter",
+; which as far as we know are no longer in use.  Thus, deleted
+; quick-compile-acl2.  Also deleted no-object-file-or-out-of-date-object-file,
+; since it was there only to support quick-compile-acl2.
+
+; Improved the error message for #.expr when expr hasn't been defined by
+; defconst.
+
+; Modified printing of the banner for GCL, especially for versions 2.6.9 and
+; later, due to a change in how GCL prints such banners.  (Printing of the
+; banner still works fine with older versions of GCL.)
+
+; For SBCL only, increased --control-stack-size from 8 to 16.
+
+; For CMUCL only, declaimed len to be notinline, to avoid what appears to be a
+; CMUCM compiler bug that shows up when attempting to certify the community
+; book books/models/jvm/m1/defsys.lisp.
+
+; Incorporated fix from Sol Swords for ACL2(h): "memoize time
+; tracking: fix some subtle RDTSC-related problems that could cause
+; safe-incf errors on machines that often switch your thread across
+; cores".
+
+; Just below is a book containing a proof of nil, which exploits the soundness
+; bug reported by Jen Davis and Dave Greve, permitting a stobj to be bound by a
+; let or mv-let form without being among the outputs of that form.  The bug was
+; in translate11-let (and also, similarly, in translate11-mv-let); it was a
+; coding bug that failed to distinguish between the original value of a formal,
+; tbody, and an updated version of that formal.
+
+;   (in-package "ACL2")
+;
+;   (defstobj st halt)
+;
+;   (defun foo (st)
+;     (declare (xargs :stobjs st))
+;     (let ((st (update-halt 0 st)))
+;       (halt st)))
+;
+;   (defun bar ()
+;     (declare (xargs :guard t))
+;     (with-local-stobj
+;      st
+;      (mv-let (result st)
+;              (let ((x (foo st)))
+;                (declare (ignore x))
+;                (mv (halt st) st))
+;              result)))
+;
+;   (defthm thm1
+;     (equal (bar) 0)
+;     :rule-classes nil)
+;
+;   (defthm thm2
+;     (equal (bar) nil)
+;     :hints (("Goal" :in-theory (disable (bar))))
+;     :rule-classes nil)
+;
+;   (defthm contradiction
+;     nil
+;     :hints (("Goal" :use (thm1 thm2)))
+;     :rule-classes nil)
+
+  :doc
+  ":Doc-Section release-notes
+
+  ACL2 Version  6.3 (October, 2013) Notes~/
+
+  NOTE!  New users can ignore these release notes, because the
+  ~il[documentation] has been updated to reflect all changes that are recorded
+  here.
+
+  Below we roughly organize the changes since Version  6.2 into the following
+  categories of changes: existing features, new features, heuristic
+  improvements, bug fixes, changes at the system level, Emacs support, and
+  experimental versions.  Each change is described in just one category, though
+  of course many changes could be placed in more than one category.
+
+  ~st[CHANGES TO EXISTING FEATURES]
+
+  The evaluation of a term from a ~ilc[bind-free] hypothesis had been expected
+  to produce an alist binding free variables to terms.  While that is still
+  legal, it is also legal for that evaluation to produce a list of such alists:
+  then each is considered, until one of them permits all remaining hypotheses
+  to be relieved.  ~l[bind-free].  Thanks to Sol Swords for requesting this
+  enhancement.
+
+  ACL2 continues to provide a way to specify keyword command abbreviations for
+  the top-level loop; ~pl[ld-keyword-aliases].  However,
+  ~ilc[ld-keyword-aliases] is now a ~il[table] rather than a ~il[state] global;
+  it is thus no longer a so-called ~il[LD] special.  The functionality of
+  ~c[set-ld-keyword-aliases] has essentially been preserved, except that it is
+  now an event (~pl[events]), hence it may appear in a book; it is ~il[local]
+  to a book (or ~ilc[encapsulate] event); and the ~ilc[state] argument is
+  optional, and deprecated.  A non-local version (~c[set-ld-keyword-aliases!])
+  has been added, along with corresponding utilities ~c[add-keyword-alias] and
+  ~c[add-keyword-alias!] for adding a single keyword alias.
+  ~l[ld-keyword-aliases].  Thanks to Jared Davis for correspondence that led us
+  to make this change.
+
+  The ~il[proof-checker] command ~c[(exit t)] now exits without a query (but
+  still prints an event to show the ~c[:INSTRUCTIONS]).  Thanks to Warren Hunt
+  for feedback leading us to make this change.
+
+  We made the following minor changes to the behavior or ~c[dmr]; ~pl[dmr].
+  First, if ~c[dmr] monitoring is enabled, then ~c[(dmr-start)] will have no
+  effect other than to print a corresponding observation, and if monitoring is
+  disabled, then ~c[(dmr-stop)] will have no effect other than to print a
+  corresponding observation.  Second, it had been the case that when
+  ~c[(dmr-start)] is invoked, the debugger was always automatically enabled
+  with value ~c[t] (~pl[set-debugger-enable]), and the debugger remained
+  enabled when ~c[(dmr-stop)] was invoked.  Now, the debugger is only enabled
+  by ~c[(dmr-start)] if it is not already enabled and does not have setting
+  ~c[:never].  Moreover, if such automatic enabling takes place, then the old
+  setting for the debugger is restored by ~c[(dmr-stop)] unless
+  ~ilc[set-debugger-enable] has first been called after that automatic
+  enabling.  Finally, if the value of ~il[state] global variable
+  ~c['debugger-enable] is ~c[:bt], then the new value will be ~c[:break-bt],
+  not ~c[t].
+
+  When a call of ~ilc[progn] is executed in the ACL2 loop, its constituent
+  ~il[events] and their results are printed, just as was already done for calls
+  of ~ilc[encapsulate].  Thanks to Jared Davis for a conversation causing us to
+  consider this change.
+
+  (CCL only) When ~ilc[set-debugger-enable] is invoked with an argument that
+  prints a backtrace and CCL is the host Lisp, the backtrace will be limited to
+  10,000 stack frames.  (We have seen more than 65,000 stack frames before this
+  change.)  This limit is the value of raw Lisp variable
+  ~c[*ccl-print-call-history-count*], which may be assigned another positive
+  integer value to serve as the maximum number of stack frames to be printed.
+
+  Improvements have been made pertaining to the disabling (inhibiting) of
+  individual types of warning.  Now, inhibited warnings are implemented in a
+  straightforward way using a separate ~il[table] for this purpose, the
+  ~c[inhibit-warnings-table], rather than using the ~ilc[acl2-defaults-table].
+  ~l[set-inhibit-warnings], and ~pl[set-inhibit-warnings!] for a variant that
+  is not ~ilc[local] to an ~ilc[encapsulate] or a book in which it occurs.
+  Thanks to Sol Swords for sending examples showing how
+  ~ilc[set-inhibit-warnings] did not always behave as one might reasonably
+  expect when books are involved.
+
+  It had been the case that ~ilc[lp] took a single argument, ~c['raw].  This
+  argument was not documented and also caused an error, so it has been
+  eliminated.
+
+  The functionality of ~ilc[make-event] has been significantly expanded.
+  First: if the expansion is of the form ~c[(:OR e1 e2 ...)], then event forms
+  ~c[e1], ~c[e2], and so on are evaluated, in order, until the evaluation of
+  some ~c[ek] completes without error.  In that case, the expansion is treated
+  simply as ~c[ek].  With this capability, alternative expansions can be
+  attempted and the successful one does not need to be evaluated again.  See
+  the new version of community book ~c[books/make-event/proof-by-arith.lisp]
+  for an example.  Second, an expansion may be of the form ~c[(:DO-PROOFS e)],
+  in which case the event ~c[e] is evaluated with proofs ~st[not] skipped;
+  ~pl[ld-skip-proofsp].  Third, new keyword ~c[:EXPANSION?] can be used to
+  avoid storing expansions in certificate files.  ~l[make-event].
+
+  When a ~ilc[defun] event prints a failure message in the summary, that
+  message now indicates when the failure is due to a failed proof of guard
+  verification or a failed proof of the measure theorem.  Thanks to Shilpi Goel
+  for requesting this enhancement.
+
+  ~st[NEW FEATURES]
+
+  ACL2 can now be instructed to time activities using real time (wall clock
+  time) instead of run time (typically, cpu time).  ~l[get-internal-time].
+  Thanks to Jared Davis for asking to be able to obtain real-time reports in
+  event summaries.
+
+  A new utility, ~ilc[sys-call+], is similar to existing utility ~ilc[sys-call]
+  in that it executes a command.  Unlike ~c[sys-call], however, ~c[sys-call+]
+  returns values that include output from the command (in addition to the exit
+  status), rather than simply printing the command.  ~l[sys-call+].
+
+  The new macro ~ilc[verify-guards+] extends the functionality of
+  ~ilc[verify-guards] by permitting macro-aliases (~pl[macro-aliases-table]).
+  ~l[verify-guards+].  Thanks to Jared Davis for requesting this feature and
+  suggesting the use of ~ilc[make-event] in its implementation.  We have also
+  modified ~ilc[verify-guards] to print a friendlier error message when its
+  argument is a macro-alias.
+
+  ~l[last-prover-steps] for a new utility that returns the number of prover
+  steps most recently taken.
+
+  ~st[HEURISTIC IMPROVEMENTS]
+
+  The processing of ~c[:use] and ~c[:by] ~il[hints] has been changed in the
+  following two rather subtle ways, thanks to suggestions from Sol Swords.
+  ~bq[]
+
+  o For ~c[:by] hints, the simplest check was an equality check, rather than a
+  more general subsumption check.  That equality check was made after removing
+  so-called ``guard holders'' (~ilc[must-be-equal], ~ilc[prog2$],
+  ~ilc[ec-call], ~ilc[the]) from both the previous theorem and the purported
+  theorem.  Now, guard-holder removal has been strengthened, so that the
+  results are also put into so-called quote-normal form, for example replacing
+  ~c[(cons '3 '4)] by ~c['(3 . 4)].
+
+  o For a ~il[lemma-instance] provided to a ~c[:use] or ~c[:by] hint that
+  is a ~c[:functional-instance], if a ~c[:do-not] hint (~pl[hints]) has
+  specified that ~c[preprocess-clause] is not to be used, then preprocessing
+  will not be used on the constraints.~eq[]
+
+  We eliminated certain warnings about being ``weak'' for every
+  ~c[:]~ilc[type-prescription] rule whose conclusion designates that the
+  function call can be equal to one of its arguments, e.g.,
+  ~c[(or (integerp (foo y)) (equal (foo y) y))].  In many cases (such as the
+  one above), such warnings about ``weak'' simply aren't correct.
+
+  ~st[BUG FIXES]
+
+  Fixed a soundness bug that was permitting a ~il[stobj] to be bound by a
+  ~ilc[let] or ~ilc[mv-let] form, without being among the outputs of that form.
+  Thanks to Jen Davis and Dave Greve for reporting this bug.  Their report
+  included an example which forms the basis for a proof of ~c[nil], included as
+  a comment in the form ~c[(deflabel note-6-3 ...)] in ACL2 source file
+  ~c[ld.lisp].
+
+  (GCL only) Fixed an obscure soundness bug due to an error in the GCL
+  implementation of ~ilc[set-debugger-enable].  For details, see the relevant
+  comment in the ACL2 source code under ~c[(deflabel note-6-3 ...)].
+
+  Fixed a bug in the case of a field of a (concrete) stobj that is an abstract
+  stobj (~pl[nested-stobjs]).  Thanks to David Rager for bringing this bug to
+  our attention.
+
+  Splitter output for type ~c[if-intro] (~pl[splitter]) could formerly occur
+  even when at most one subgoal is generated.  This has been fixed.
+
+  Fixed a bug in ~ilc[wof], hence in ~ilc[psof] (which uses ~c[wof]), that was
+  causing the printing of a bogus error message.
+
+  A small logical bug has been fixed in the logical definition of
+  ~ilc[sys-call-status].  Formerly it always returned ~c[(mv nil state)]
+  whenever the oracle of the state is non-empty (~pl[state]).
+
+  Fixed a bug that was causing an error upon evaluation of the form
+  ~c[(set-prover-step-limit nil)].  Thanks to David Russinoff for reporting
+  this error.
+
+  The ~c[:measure] (if supplied) is now ignored when checking redundancy with
+  respect to a non-recursive definition that is not defined within a
+  ~ilc[mutual-recursion].  (~l[redundant-events] and ~pl[xargs].)  It had been
+  possible to get a low-level ACL2 error in this situation.  Thanks to Jared
+  Davis for reporting this bug with a helpful example.
+
+  Eliminated a potential error when using ~ilc[comp] to compile an uncompiled
+  function defined under ~ilc[progn!], which we observed in LispWorks.
+
+  ~st[CHANGES AT THE SYSTEM LEVEL]
+
+  The ACL2 sources are now publicly available between ACL2 releases, using svn;
+  see the new ``~c[acl2-devel]'' project hosted by Google code at
+  ~url[http://acl2-devel.googlecode.com].  Although such a copy of ACL2 is
+  likely to work well with the latest svn (trunk) revision of the ACL2
+  community books (~pl[community-books]), please take seriously the warning
+  message printed at startup: ``The authors of ACL2 consider svn distributions
+  to be experimental; they may be incomplete, fragile, and unable to pass our
+  own regression.''  That message also provides instructions for bug reports.
+  If you decide to use svn versions of either the community books or ACL2, then
+  you should use both, as they tend to be kept in sync.  We fully expect ACL2
+  releases to continue from time to time, as usual.  Thanks to Jared Davis for
+  his efforts in setting up the new acl2-devel project and svn repository, and
+  to him and David Rager for convincing us to distribute ACL2 sources via svn
+  between releases.
+
+  Thanks to a suggestion from Jared Davis, over 30 built-in functions are now
+  declared to be inline in order to boost performance.  (The list may be found
+  by searching ACL2 source file ~c[axioms.lisp] for ``~c[(declaim (inline]''.)
+
+  Better support has been provided for command line arguments, especially those
+  supplied directly by the user when calling ACL2.  For one, problems with
+  quoting have been solved using ~c[\"$@\"] in place of ~c[$*].  Also, the
+  function ~ilc[save-exec] now allows specification of arguments, both for the
+  host Lisp as well as ``inert'' arguments that can be passed along to calls of
+  programs (as with ~ilc[sys-call]).  A keyword argument, ~c[:return-from-lp],
+  specifies a form to evaluate before quitting the read-eval-print loop at
+  startup.  ~l[save-exec].  Also see the source function ~c[user-args-string]
+  and its comments, source file ~c[acl2-init.lisp], for more information.
+  Thanks to Jared Davis for suggesting the use of ~c[\"$@\"], as well as
+  modifications to ~ilc[save-exec] and helpful conversations about that.
+
+  A rather extensive overhaul has taken place for the function proclaiming
+  mechanism.  As before, this is only used when the host Lisp is GCL.  However,
+  building an executable is now faster for some Lisps, including GCL, by
+  avoiding repeated recompilation and perhaps repeated initialization.
+
+  (CCL only) We increased stack sizes when the host Lisp is CCL.  The default
+  for recent CCL versions is equivalent to specifying `~c[-Z 2M]' on the
+  command line, but saved ACL2 scripts (including experimental versions
+  ACL2(h), ACL2(p), ACL2(r), and combinations of them) to `~c[-Z 64M]',
+  representing a 32-fold increase.  Thanks to Jared Davis for pointing us to
+  community books file ~c[books/centaur/ccl-config.lsp] and to Sol Swords for
+  helpful discussions.
+
+  (SBCL only) Fixed ~c[save-exec] for host Lisp SBCL to provide the same export
+  of variable ~c[SBCL_HOME] that was provided in the original ~c[saved_acl2]
+  script.
+
+  (GCL only) We made changes, following suggestions from Camm Maguire (whom we
+  thank for these suggestions), to support ACL2 builds on recent versions of
+  GCL (2.6.8 and 2.6.10; we recommend against using GCL 2.6.9, since issues
+  there were fixed in 2.6.10).  Specifically, we no longer set the hole size,
+  and we allocate contiguous pages sufficient to run an ACL2 regression without
+  failing due to memory limitations.
+
+  ~st[EMACS SUPPORT]
+
+  Modified file ~c[emacs/emacs-acl2.el] to eliminate some warnings that were
+  appearing in a recent Emacs version, replacing ~c[(end-of-buffer)] by
+  ~c[(goto-char (point-max))] and ~c[next-line] by ~c[forward-line].  Thanks to
+  Warren Hunt for bringing the warnings to our attention.
+
+  ~st[EXPERIMENTAL/ALTERNATE VERSIONS]
+
+  (Allegro CL only) ACL2(h) now avoids blow-ups in hash table sizes that could
+  be caused by ~il[hons-shrink-alist].  Thanks to Jared Davis for helping to
+  debug this problem, and to David Rager for contributing the community book
+  ~c[books/parsers/earley/earley-parser.lisp], which highlighted this problem.
+
+  (SBCL only) Fixed a bug that was causing a Lisp break after turning on
+  ~il[waterfall-parallelism].  Thanks to David Rager for confirming that our
+  proposed fix is correct.
+
+  ~/~/")
+
 (deflabel the-method
   :doc
   ":Doc-Section Miscellaneous
@@ -21449,17 +21850,20 @@
   is given a single function to compile.  Those files contain the ACL2
   definitions of all functions to compile, omitting those in the lists obtained
   by evaluating the forms ~c[(@ logic-fns-with-raw-code)] and
-  ~c[(@ program-fns-with-raw-code)].  If you define function symbols with raw
-  Lisp code, say by using trust tags (~pl[defttag]) and readtime conditionals
-  ~c[#-acl2-loop-only], then you are advised to add all such symbols to one of
-  the lists stored in the two ~il[state] globals above: to
+  ~c[(@ program-fns-with-raw-code)].  ~c[:Comp] skips compilation for functions
+  that are already compiled, as is typically the case when you redefine
+  functions in raw Lisp using the utility ~c[include-raw] defined in community
+  book ~c[books/tools/include-raw.lisp].  But if you define interpreted (as
+  opposed to compiled) functions with raw Lisp code, say by using trust
+  tags (~pl[defttag]) and ~ilc[progn!], then you are advised to add all such
+  symbols to one of the lists stored in the two ~il[state] globals above: to
   ~c[logic-fns-with-raw-code] if the function symbol is in ~c[:]~ilc[logic]
   mode, else to ~c[program-fns-with-raw-code].  Then, instead of the
   corresponding ACL2 definition (without raw Lisp code) being written to a
   file, the function symbol will be passed directly to the Lisp ~c[compile]
   function.  Note that the above two state globals are both untouchable, so you
-  may need to deal with that before modifying them, for example as follows
-  (also ~pl[remove-untouchable]).
+  may need to deal with that before modifying them, for example as
+  follows (also ~pl[remove-untouchable]).
   ~bv[]
   (defttag t)
   (state-global-let*
@@ -21822,7 +22226,6 @@
                                      (new-defpkg-list defpkg-items kpa kpa))
                                    cmds)
                            :ld-skip-proofsp 'include-book-with-locals
-                           :ld-keyword-aliases nil
                            :ld-verbose nil
                            :ld-prompt nil
                            :ld-missing-input-ok nil
@@ -22723,9 +23126,15 @@
 
 (defun dmr-stop-fn (state)
   (declare (xargs :guard (state-p state)))
-  #-acl2-loop-only
-  (dmr-stop-fn-raw)
-  (f-put-global 'dmrp nil state))
+  (let ((dmrp (f-get-global 'dmrp state)))
+    (cond (dmrp #-acl2-loop-only
+                (dmr-stop-fn-raw)
+                (pprogn (f-put-global 'dmrp nil state)
+                        (if (consp dmrp)
+                            (set-debugger-enable-fn (car dmrp) state)
+                          state)))
+          (t (observation 'dmr-stop
+                          "Skipping dmr-stop (dmr is already stopped).")))))
 
 (defmacro dmr-stop ()
   '(dmr-stop-fn #+acl2-loop-only state
@@ -22733,12 +23142,25 @@
 
 (defun dmr-start-fn (state)
   (declare (xargs :guard (state-p state)))
-  (pprogn
-   (dmr-stop-fn state)
-   (set-debugger-enable-fn t state) ; supports interactive use of dmr-flush
-   #-acl2-loop-only
-   (dmr-start-fn-raw state)
-   (f-put-global 'dmrp t state)))
+  (cond ((f-get-global 'dmrp state)
+         (observation 'dmr-start
+                      "Skipping dmr-start (dmr is already started)."))
+        (t (let* ((old-debugger-enable (f-get-global 'debugger-enable state))
+                  (new-debugger-enable ; for interactive use of dmr-flush
+                   (case old-debugger-enable
+                     ((nil) t)
+                     (:bt :break-bt))))
+             (pprogn
+              (if new-debugger-enable
+                  (set-debugger-enable-fn new-debugger-enable state)
+                state)
+              #-acl2-loop-only
+              (dmr-start-fn-raw state)
+              (f-put-global 'dmrp
+                            (if new-debugger-enable
+                                (list old-debugger-enable)
+                              t)
+                            state))))))
 
 (defmacro dmr-start ()
   '(dmr-start-fn #+acl2-loop-only state
@@ -22843,7 +23265,7 @@
 </TD>
 <TD>
 <A HREF=\"http://www.cs.utexas.edu/users/moore/publications/acl2-papers.html\">
-Publications about about ACL2 and Its Applications</A>
+Publications about ACL2 and Its Applications</A>
 </TD>
 
 <TD ALIGN=CENTER VALIGN=MIDDLE>
@@ -22900,7 +23322,7 @@
 <A HREF=\"~sg\"><IMG SRC=\"note02.gif\" BORDER=0></A>
 </TD>
 <TD>
-<A HREF=\"~sg\">Differences from Version 6.1</A><A HREF=\"~s7\"> <IMG SRC=\"twarning.gif\"></A>
+<A HREF=\"~sg\">Differences from Version 6.2</A><A HREF=\"~s7\"> <IMG SRC=\"twarning.gif\"></A>
 </TD>
 <TD ALIGN=CENTER VALIGN=MIDDLE>
 <A HREF=\"other-releases.html\">
@@ -22937,8 +23359,39 @@
 
 <HR>
 
-<BR>
-The ACL2 distribution includes several extensions, which were
+<p>
+
+Libraries of <i>books</i> (files containing definitions and theorems) extend
+the code that we have written.  These <i>community books</i> are contributed
+and maintained by the members of the ACL2 community; see the <code><A
+HREF=\"http://acl2-books.googlecode.com/\">acl2-books</A></code> project page.
+
+<p>
+
+The libraries and the ACL2 source code are under revision control, using svn.
+Experimental copies of ACL2 and the libraries are thus available between ACL2
+releases.  <i>The authors of ACL2 consider svn distributions to be
+experimental; while they will likely be fully functional in most cases, they
+could however be incomplete, fragile, and unable to pass our own
+regression.</i> If you decide to use svn versions of either the libraries or
+ACL2, then you should use both, as they tend to be kept in sync.  See the
+project websites, <code><A
+HREF=\"http://acl2-books.googlecode.com/\">acl2-books</A></code> and <code><A
+HREF=\"http://acl2-devel.googlecode.com/\">acl2-devel</A></code>, for the ACL2
+libraries and development sources, respectively.
+
+<p>
+
+A combined manual, known as the <A
+HREF=\"http://fv.centtech.com/acl2/6.3/doc/\">xdoc manual</A>, incorporates not
+only <A HREF=\"#User's-Manual\">The User's Manual</A> for ACL2 (with some
+topics rearranged) but also documentation for many books.  Thanks to Jared
+Davis for building the xdoc processor for creating this view of the
+documentation.
+
+<p>
+
+The ACL2 distribution includes the following extensions, which were
 contributed by the individuals shown.
 <UL>
 <LI><A HREF=\"REAL.html\">ACL2(r)</A><BR>
@@ -22955,20 +23408,6 @@
 
 <p>
 
-There are libraries of <i>books</i> (files containing definitions and theorems)
-that extend the code that we have written.  Books are contributed and
-maintained by the ACL2 community (see <code><A
-HREF=\"http://acl2-books.googlecode.com/\">http://acl2-books.googlecode.com/</A></code>;
-in particular, the [Source] tab near the top takes you to a search box)
-and their authors are generally noted in each book or its
-<code>README</code> file.  There is a <A
-HREF=\"http://fv.centtech.com/acl2/6.2/doc/\">combined manual</A> that
-incorporates not only <A HREF=\"#User's-Manual\">The User's Manual</A>
-for ACL2 but also documentation for many books; thanks to Jared Davis
-for building this view of the documentation.
-
-<p>
-
 Another extension of ACL2 is the Eclipse-based <A
 HREF=\"http://acl2s.ccs.neu.edu/acl2s/doc/\">ACL2 Sedan</A> (ACL2s).  Unlike
 the systems above, ACL2s is distributed and maintained by Pete Manolios and his
@@ -23047,7 +23486,7 @@
 
 <B>Note</B>: The documentation is available for reading in a Web
 browser (recommended), in Emacs Info, using the ACL2 <CODE>:DOC</CODE> command,
-or as a printed book (over 2100 pages).  These are available as follows.
+or as a printed book (over 2200 pages).  These are available as follows.
 
 <ul>
 
@@ -23057,10 +23496,9 @@
 <CODE>doc/HTML/acl2-doc.html</CODE>.</li>
 
 <li>Alternatively, for web browsing you can use <A
-HREF=\"http://fv.centtech.com/acl2/6.2/doc/\">documentation generated by Jared
-Davis's xdoc utility</A>.  After you install and certify the ACL2 community
-books (see <A HREF=\"#Tools\">below</A>), you will find a complete local copy
-at <CODE>books/xdoc-impl/manual/preview.html</A></CODE>.
+HREF=\"http://fv.centtech.com/acl2/6.3/doc/\">documentation generated by Jared
+Davis's xdoc utility</A>.  You can build a local copy from the ACL2 Community
+Books, following instructions in <code>books/Makefile</code>.</li>
 
 <li>Those familiar with Emacs Info can read the documentation in that format by
 loading the file <CODE>emacs/emacs-acl2.el</CODE> distributed with ACL2 (under
@@ -23073,7 +23511,7 @@
 
 <li>To read a printed copy, obtain a Postscript version <A HREF=
 \"http://www.cs.utexas.edu/users/moore/publications/acl2-book.ps.gz\">here</A>
-(about 2.5 MB).</li>
+(about 2.6 MB).</li>
 
 </ul>
 
@@ -23147,18 +23585,18 @@
 The following link will take you to a search box on a Google page,
 which has the following contents.
 <pre>
-search_term site:http://www.cs.utexas.edu/users/moore/acl2/v6-2
+search_term site:http://www.cs.utexas.edu/users/moore/acl2/v6-3
 </pre>
 Now simply replace the word `search_term' with your topic.  For example, replace
 `<code>search_term</code>' by `<code>tail recursion</code>' to get
 documentation about tail recursion.
 <pre>
-tail recursion site:http://www.cs.utexas.edu/users/moore/acl2/v6-2
+tail recursion site:http://www.cs.utexas.edu/users/moore/acl2/v6-3
 </pre>
 Now you are ready to follow the link.
 <p>
 <a href=\"http://www.google.com/search?q=search_term
-                 site:http://www.cs.utexas.edu/users/moore/acl2/v6-2\">SEARCH
+                 site:http://www.cs.utexas.edu/users/moore/acl2/v6-3\">SEARCH
                  THE DOCUMENTATION</a>
 </li>
 
@@ -23167,7 +23605,7 @@
 <li>
 
 The next link will take you to the community books website (which is external
-to the present ACL2 website), spefically to the section entitled ``Searching
+to the present ACL2 website), specifically to the section entitled ``Searching
 and browsing the books.''  There, you will see a search box in which you can
 enter your search term.  For example, if you type `<code>tail recursion</code>'
 and then <code>&lt;RETURN&gt;</code>, you will see text from several books in
@@ -23201,7 +23639,7 @@
     programming                         ;;; d
     rule-classes                        ;;; e
     books                               ;;; f
-    note-6-2                            ;;; g   ; current release notes
+    note-6-3                            ;;; g   ; current release notes
     the-method                          ;;; h
     introduction-to-the-theorem-prover  ;;; i   ; This is not used right now.
     interesting-applications            ;;; j
@@ -25878,9 +26316,9 @@
   pre-processing and database updates.  Despite the fact that ACL2 is an
   applicative language it is possible to measure time with ACL2 programs.  The
   ~ilc[state] ~warn[] contains a clock.  The times are printed in decimal
-  notation but are actually counted in integral units.  Note that each time is
-  a runtime, also known as a cpu time, as opposed to being a real time, also
-  known as a wall clock time.
+  notation but are actually counted in integral units.  Note that by default,
+  each time is a runtime, also known as a cpu time, as opposed to being a real
+  time, also known as a wall clock time.
 
   The final ~c[APP] is the value of the ~c[defun] command and was printed by
   the read-eval-print loop.  The fact that it is indented one space is a subtle
@@ -26556,7 +26994,7 @@
                 :ttree nil)
                (declare (ignore step-limit failure-reason new-unify-subst
                                 memo))
-               (if (eq wonp t)
+               (if (member-eq wonp '(t :unify-subst-list))
                    (mv t ttree)
                  (mv nil nil))))))))
        (t (cw *meta-level-function-problem-2* 'mfc-relieve-hyp mfc
@@ -27165,16 +27603,16 @@
       (pprogn
        (princ$ "-*- Mode: auto-revert -*-" wof-chan state)
        (newline wof-chan state)
-       (state-global-let*
-        ((standard-co wof-chan set-standard-co-state)
-         (proofs-co wof-chan set-proofs-co-state))
-        (mv-let (erp val state)
+       (mv-let (erp val state)
+               (state-global-let*
+                ((standard-co wof-chan set-standard-co-state)
+                 (proofs-co wof-chan set-proofs-co-state))
                 (check-vars-not-free
                  (wof-chan)
-                 ,form)
-                (pprogn (close-output-channel wof-chan state)
-                        (cond (erp (silent-error state))
-                              (t (value val)))))))))))
+                 ,form))
+               (pprogn (close-output-channel wof-chan state)
+                       (cond (erp (silent-error state))
+                             (t (value val))))))))))
 
 (defmacro wof (filename form) ; Acronym: With Output File
 
@@ -27380,45 +27818,11 @@
 #-acl2-loop-only
 (defparameter *initial-cbd* nil)
 
-(defun save-exec (exec-filename extra-startup-string)
-
-  ":Doc-Section Other
-
-  save an executable image and (for most Common Lisps) a wrapper script~/
-
-  ~l[saving-and-restoring] for an explanation of why one might want to use this
-  function.
-  ~bv[]
-  Examples:
-  ; Save an executable named my-saved_acl2:
-  (save-exec \"my-saved_acl2\"
-             \"This saved image includes Version 7 of Project Foo.\")
-
-  ; Same as above, but with a generic comment instead:
-  (save-exec \"my-saved_acl2\" nil)~/
-  General Form:
-  (save-exec exec-filename extra-startup-string)
-  ~ev[]
-  where ~c[exec-filename] is the filename of the proposed executable and
-  ~c[extra-startup-string] is a non-empty string to be printed after the normal
-  ACL2 startup message when you start up the saved image.  However,
-  ~c[extra-startup-string] is allowed to be ~c[nil], in which case a generic
-  string will be printed instead.
-
-  ~st[Notes]:
-
-  1. For technical reasons, you must first exit the ACL2 read-eval-print loop,
-  for example by executing ~c[:q], before evaluating a ~c[save-exec] call.
+#-acl2-loop-only
+(defvar *return-from-lp* nil)
 
-  2. The image will be saved so that in the new image, the raw Lisp package and
-  the package in the ACL2 read-eval-print loop (~pl[lp]) will be the same as
-  their respective values at the time ~c[save-exec] is called.
-
-  3. For most Common Lisps, the specified file (e.g., ~c[\"my-saved_acl2\"] in
-  the examples above) will be written as a small script, which in turn invokes
-  a saved image to which an extension has been appended (e.g.,
-  ~c[my-saved_acl2.gcl] for the examples above, when the underlying Common Lisp
-  is GCL on a non-Windows system).~/"
+(defun save-exec-fn (exec-filename extra-startup-string host-lisp-args
+                                   toplevel-args inert-args return-from-lp)
 
   #-acl2-loop-only
   (progn
@@ -27426,6 +27830,11 @@
 ; Parallelism blemish: it may be a good idea to reset the parallelism variables
 ; in all #+acl2-par compilations before saving the image.
 
+    (setq *return-from-lp* return-from-lp)
+    #-sbcl (when toplevel-args
+             (er hard 'save-exec
+                 "Keyword argument :toplevel-args is only allowed when the ~
+                  host Lisp is SBCL."))
     (if (not (eql *ld-level* 0))
         (er hard 'save-exec
             "Please type :q to exit the ACL2 read-eval-print loop and then try ~
@@ -27452,7 +27861,6 @@
 
     (f-put-global 'connected-book-directory nil *the-live-state*)
     (setq *initial-cbd* nil)
-    (setq *lp-ever-entered-p* nil)
     (setq *startup-package-name* (package-name *package*))
     (setq *saved-build-date-lst*
 
@@ -27465,19 +27873,316 @@
 
           (cons (saved-build-date-string)
                 *saved-build-date-lst*))
-    (save-exec-raw exec-filename))
+    (save-exec-raw exec-filename
+                   host-lisp-args
+                   #+sbcl toplevel-args
+                   inert-args))
   #+acl2-loop-only
-  (declare (ignore exec-filename extra-startup-string))
+  (declare (ignore exec-filename extra-startup-string host-lisp-args
+                   toplevel-args inert-args return-from-lp))
   nil ; Won't get to here in GCL and perhaps other lisps
   )
 
+(defmacro save-exec (exec-filename extra-startup-string
+                                   &key
+                                   host-lisp-args toplevel-args inert-args
+                                   return-from-lp)
+
+  ":Doc-Section Other
+
+  save an executable image and a wrapper script~/
+
+  ~c[Save-exec] saves your ACL2 state so that you can immediately re-start
+  later in that same state.  This utility can be useful for a project with
+  ~il[books] to be included every time ACL2 is started, to avoid time taken to
+  run ~ilc[include-book].  Another use of ~c[save-exec] is to save an
+  executable that takes command-line arguments beyond those normally passed to
+  the host Lisp executable.  All arguments of a call of ~c[save-exec] are
+  evaluated.
+
+  ~bv[]
+  Examples:
+
+  ; Save an executable script named my-saved_acl2, with the indicated message
+  ; added to the start-up banner:
+  (save-exec \"my-saved_acl2\"
+             \"This saved image includes Version 7 of Project Foo.\")
+
+  ; Same as above, but instead with a generic comment in the start-up banner:
+  (save-exec \"my-saved_acl2\" nil)
+
+  ; Arrange that the generated script passes the indicated arguments to be
+  ; processed by the Lisp (ACL2) executable (where this example is specific to
+  ; the case that CCL is the host Lisp):
+  (save-exec \"my-saved_acl2\" nil
+             :host-lisp-args \"--no-init -Z 256M\")
+
+  ; Arrange that the generated script passes along the indicated arguments
+  ; to Lisp (ACL2), but that they are not processed by Lisp other than to
+  ; record the additional arguments (see (6) below).
+  (save-exec \"my-saved_acl2\" nil
+             :inert-args \"abc xyz -i foo\")
+
+  ; Combining the preceding two examples:
+  (save-exec \"my-saved_acl2\" nil
+             :host-lisp-args \"--no-init -Z 256M\"
+             :inert-args \"abc xyz -i foo\")
+
+  ; Immediately exit the ACL2 read-eval-print loop after starting up.
+  (save-exec \"my-acl2\" nil
+             :return-from-lp t)
+
+  ; Immediately exit the ACL2 read-eval-print loop after starting up and
+  ; defining function FOO in the logic.
+  (save-exec \"my-acl2\" \"Start with foo defined.\"
+             :return-from-lp '(with-output
+                               :off :all
+                               (defun foo (x) x)))
+
+  ; Immediately exit the ACL2 read-eval-print loop after starting up and
+  ; defining variable xxx in raw Lisp.
+  (save-exec \"my-acl2\" \"Start with xxx defined.\"
+             :return-from-lp '(with-output
+                               :off :all
+                               (ld '((set-raw-mode-on!)
+                                     (defvar xxx (make-list 10))
+                                     (set-raw-mode nil)
+                                     (u)))))
+  ~ev[]
+
+  Each example above generates a file named \"my-saved_acl2\".  That file is
+  quite similar in form to the script generated when building ACL2 directly
+  from source code; details are below.  For example, here are the contents of
+  that generated file if the host Lisp is CCL (but where dates and pathnames
+  are specific to one's environment).  Here, we break lines using `\\', but the
+  ~c[exec] command is actually on a single line.
+
+  ~bv[]
+  #!/bin/sh
+
+  # Saved August 16, 2013  23:06:49
+  #  then August 17, 2013  11:01:56
+
+  export CCL_DEFAULT_DIRECTORY=\"/projects/acl2/lisps/ccl/15542/ccl\"
+  exec \"/projects/ccl/lx86cl64\" -I \"/u/smith/my-saved_acl2.lx86cl64\" \\
+       -Z 64M -K ISO-8859-1 -e \"(acl2::acl2-default-restart)\" \\
+       --no-init -Z 256M \\
+       -- \\
+       abc xyz -i foo \\
+       \"$@\"
+  ~ev[]~/
+
+  ~bv[]
+  General Form:
+  (save-exec exec-filename extra-startup-string
+             :host-lisp-args host-lisp-args
+             :inert-args inert-args
+             :return-from-lp return-from-lp)
+  ~ev[]
+  where the keyword arguments are optional, and arguments are as follows.
+  ~bq[]
+  ~c[Exec-filename] is the filename of the proposed executable.
+
+  ~c[Extra-startup-string] is a non-empty string to be printed after the normal
+  ACL2 startup message when you start up the saved image.  However,
+  ~c[extra-startup-string] is allowed to be ~c[nil], in which case a generic
+  string will be printed instead.
+
+  ~c[Host-lisp-args] can be ~c[nil] (the default), but if it is a non-~c[nil]
+  value, then it is a string to be inserted into the command line in the saved
+  script, specifying additional arguments that are to be processed by the host
+  Lisp executable.  (Note for SBCL only: these are runtime options; for
+  toplevel options, see (8) below.)
+
+  ~c[Inert-args] can be ~c[nil] (the default), but if it is a non-~c[nil]
+  value, then it is a string to be inserted into the command line in the saved
+  script, specifying additional arguments that are not to be processed by the
+  host Lisp executable.~eq[]
+
+  ~c[Return-from-lp] is ~c[nil] by default.  Regardless of the value of
+  ~c[return-from-lp], ACL2 starts up and enters its read-eval-print loop as
+  usual; ~pl[lp].  Normally you'll stay inside that loop, but if
+  ~c[return-from-lp] is not ~c[nil], then it is evaluated in the loop, which is
+  then exited, leaving you in raw Lisp.  Evaluation of ~c[return-from-lp] is
+  done with ~ilc[ld] options that minimize output; also ~pl[with-output] to
+  minimize output.  Suggestion: let ~c[return-from-lp] be ~c[t] if you simply
+  want to exit the read-eval-print loop at startup, without evaluating any
+  (nontrivial) form.
+
+  The remainder of this documentation focuses on the options other than
+  ~c[return-from-lp].
+
+  ~st[Details]:
+
+  (1) You must first exit the ACL2 read-eval-print loop, typically by executing
+  ~c[:q], before evaluating a ~c[save-exec] call; otherwise an error occurs.
+
+  (2) The image will be saved so that in the new image, the raw Lisp package
+  and the package in the ACL2 read-eval-print loop (~pl[lp]) will be the same
+  as their respective values at the time ~c[save-exec] is called.
+
+  (3) ~c[Save-exec] generates a small script file (e.g., ~c[\"my-saved_acl2\"]
+  in the examples above), similar in form (see (4) below) to the script
+  generated when building ACL2 directly from source code, but with a comment
+  line indicating the time at which the new script is written.  ~c[Save-exec]
+  also saves an associated binary file.  The binary file's name is obtained by
+  putting a suffix on the script filename; for example, if the host Lisp is GCL
+  running on a Linux or Darwin (MacOS) system, then that binary file has the
+  name ~c[my-saved_acl2.gcl] in the examples above.
+
+  (4) If ~c[inert-args] is ~c[nil] (for example if keyword ~c[:inert-args] is
+  omitted), then when the generated ACL2 script is invoked with command line
+  arguments, those arguments will be passed to the host Lisp; otherwise they
+  will not.  Thus for the example above, suppose we invoke the generated script
+  as follows.
+  ~bv[]
+  my-saved_acl2 -a bcd -e fgh
+  ~ev[]
+  If ~c[my-saved_acl2] was generated using a ~c[save-exec] command with a
+  non-~c[nil] value specified for keyword ~c[:inert-args], then the arguments
+  ``~c[-a bcd -e fgh]'' will not be passed to the host Lisp; otherwise, they
+  will be.  Note that for ACL2 executable scripts generated by an ordinary ACL2
+  build from sources, the latter case (i.e., without ~c[inert-args]) takes
+  place.
+
+  (5) The generated script, which specifies execution with ~c[/bin/sh], will
+  generally contain a line of one of the following forms.  (But for SBCL,
+  see (8) below.)  In the examples that follow, ~c[ACL2_options] is a suitable
+  list of command-line arguments given to the ACL2 executable.  The quoted
+  string ~c[\"$@\"] is intended to allow the user to pass additional
+  command-line arguments to that executable.
+  ~bq[]
+
+  If ~c[host-lisp-args] and ~c[inert-args] are omitted (or ~c[nil]):
+  ~bv[]
+  exec <lisp_executable> <ACL2_options> \"$@\"
+  ~ev[]
+
+  More generally, ~c[host-lisp-args] is inserted immediately after
+  ~c[<ACL2_options>], but only if it is non-~c[nil] (hence a string).  If
+  ~c[inert-args] is ~c[nil], we thus get:
+  ~bv[]
+  exec <lisp_executable> <ACL2_options> host-lisp-args \"$@\"
+  ~ev[]
+  If ~c[host-lisp-args] redefines a value from ~c[<ACL2_options>], then it is
+  up to the host lisp which value to use.  For example, experiments show that
+  in CCL, if ~c[-Z] appears twice, each with a legal value, then the second
+  value is the one that is used (i.e. it does indeed override the original
+  value written out by ACL2 in ~c[<ACL2_options>].  But experiments also show
+  that in LispWorks, where ``~c[-init -]'' is included in ~c[<ACL2_options>],
+  then inclusion of ``~c[-init foo.lisp]'' in ~c[host-lisp-args] is ignored.
+
+  The remaining cases below are for a non-~c[nil] value of ~c[inert-args].  In
+  each case, if ~c[host-lisp-args] is ~c[nil] then it should be omitted from
+  the displayed command.
+
+  If ~c[inert-args] is ~c[t] then an additional argument, `~c[--]', indicates
+  that when ACL2 is given command line arguments, these should not be processed
+  by the host Lisp (other than recording them; see (6) below):
+  ~bv[]
+  exec <lisp_executable> <ACL2_options> host-lisp-args -- \"$@\"
+  ~ev[]
+
+  If ~c[inert-args] is a string then the result is similar to the above, except
+  that ~c[inert-args] is added immediately after `~c[--]':
+  ~bv[]
+  exec <lisp_executable> <ACL2_options> host-lisp-args -- inert-args \"$@\"
+  ~ev[]~eq[]
+
+  (6) See community books ~c[books/oslib/argv] for a utility that returns a
+  list of all ~c[inert-args] from an invocation of ACL2.
+
+  (7) Suppose that you invoke an ACL2 script, say ~c[\"my-saved_acl2\"], that
+  was generated by ~c[save-exec], and then optionally evaluate some forms.
+  Then you may save a new ACL2 script with ~c[save-exec].  The new script will
+  contain comment lines that extend comment lines in ~c[\"my-saved_acl2\"] with
+  a new write date, but otherwise will be identical to the script that would
+  have been generated by executing the new ~c[save-exec] call after invoking
+  the original ACL2 executable (built directly from ACL2 sources) instead of
+  ~c[\"my-saved_acl2\"].  In other words, the options added by the earlier
+  ~c[save-exec] call that created ~c[\"my-saved_acl2\"] are discarded by the
+  new ~c[save-exec] call.  However, the ~c[.core] file will built on top of the
+  ~c[.core] file that was consulted when ~c[\"my-saved_acl2\"] was invoked.
+
+  (8) The following note pertains only to the case that the host Lisp is SBCL.
+  For SBCL, the scripts written are analogous to, but slightly different from,
+  those shown above.  Please note that for SBCL, the ~c[host-lisp-args] are
+  what the SBCL manual calls ``runtime options''.  For SBCL only, an extra
+  keyword argument, ~c[:toplevel-args], may be used for specifying what the
+  SBCL manual calls ``toplevel options.  As with ~c[:host-lisp-args], this
+  value, ~c[toplevel-args], should be ~c[nil] (the default) or a string.  Here
+  is an example.
+  ~bv[]
+  (save-exec \"my-saved_acl2\" nil
+             :host-lisp-args \"--dynamic-space-size 12000\"
+             :toplevel-args \"--eval '(print \\\"HELLO\\\")'\"
+             :inert-args \"--my-option my-value\")
+  ~ev[]
+  The script generated by this example call of ~c[save-exec] contains a line
+  such as the following (with the same convention for `\\' as before)
+  ~bv[]
+  exec \"/projects/sbcl-1.1.7-x86-64-linux/src/runtime/sbcl\" \\
+       --dynamic-space-size 2000 --control-stack-size 8 \\
+       --core \"/u/smith/my-saved_acl2.core\" --dynamic-space-size 12000 \\
+       --end-runtime-options \\
+       --no-userinit --eval '(acl2::sbcl-restart)' \\
+       --eval '(print \"HELLO\")' \\
+       --end-toplevel-options \\
+       --my-option my-value \\
+       \"$@\"
+  ~ev[]
+
+  In general, the generated script is of one of the following forms (with the
+  same convention for `\\' as before).
+  ~bq[]
+
+  For the case that ~c[inert-args] is ~c[nil]:
+  ~bv[]
+  exec <lisp_executable> \\
+       <ACL2_runtime_options> host-lisp-args --end-runtime-options \\
+       <ACL2_toplevel_options> host-lisp-args \\
+       \"$@\"
+  ~ev[]
+
+  For the case that ~c[inert-args] is non-~c[nil]:
+  ~bv[]
+  exec <lisp_executable> \\
+       <ACL2_runtime_options> host-lisp-args --end-runtime-options \\
+       <ACL2_toplevel_options> host-lisp-args --end-toplevel-options \\
+       inert-args \"$@\"
+  ~ev[]~eq[]
+
+  Notice that as before, when the generated script is invoked (for example, at
+  the shell), additional command-line arguments provided at that time are
+  passed to Lisp if and only if ~c[inert-args] is ~c[nil].  For SBCL, when they
+  are passed to Lisp they are passed as toplevel options, not as runtime
+  options.~/"
+
+  `(save-exec-fn ,exec-filename ,extra-startup-string ,host-lisp-args
+                 ,toplevel-args ,inert-args ,return-from-lp))
+
+(defdoc command-line
+
+  ":Doc-Section Other
+
+  handling of command-line arguments when ACL2 is invoked~/
+
+  You may provide command-line arguments when invoking ACL2, which are passed
+  to the host Lisp.  For more information on this topic, along with a
+  discussion of how to save an ACL2 executable that avoids passing command-line
+  arguments to the host Lisp, ~pl[save-exec].~/~/
+
+  :cite save-exec")
+
+(link-doc-to saving-and-restoring miscellaneous save-exec)
+
 (deflabel about-acl2
   :doc
   ":Doc-Section about-acl2
 
   about ACL2~/
 
-  This is ACL2 Version 6.2, copyright (C) 2013, Regents of the University of
+  This is ACL2 Version 6.3, copyright (C) 2013, Regents of the University of
   Texas, authored by Matt Kaufmann and J Strother Moore.
 
   For past versions, see
diff -Nru acl2-6.2/linear-a.lisp acl2-6.3/linear-a.lisp
--- acl2-6.2/linear-a.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/linear-a.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/linear-b.lisp acl2-6.3/linear-b.lisp
--- acl2-6.2/linear-b.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/linear-b.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/memoize-raw.lisp acl2-6.3/memoize-raw.lisp
--- acl2-6.2/memoize-raw.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/memoize-raw.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -618,373 +618,373 @@
 ; [Jared]: This is really gross and I don't think it's the right way to do it
 ; at all.  We need to figure out something better.  Maybe we should instead use
 ; some kind of marking scheme on the symbol to say never memoize this function.
+; (Modified by Matt K. 8/26/13 to avoid a weird error in profile-all after
+; (include-book "memoize/old/profile" :dir  :system).)
 
-(let ((never-memoize-ht
-       (let ((ht (make-hash-table :test 'eq)))
-         (loop for x in
-               '(bytes-used
-                 memoize-summary
-                 memoize-summary-after-compute-calls-and-times
-                 #+rdtsc ccl::rdtsc
-                 *
-                 +
-                 -
-                 <
-                 <=
-                 =
-                 >
-                 >=
-                 abort
-                 adjoin
-                 adjust-array
-                 allocate-instance
-                 append
-                 apply
-                 apropos
-                 apropos-list
-                 aref
-                 arrayp
-                 assoc
-                 assoc-if
-                 assoc-if-not
-                 atan
-                 atom
-                 bit
-                 bit-and
-                 bit-andc1
-                 bit-andc2
-                 bit-eqv
-                 bit-ior
-                 bit-nand
-                 bit-nor
-                 bit-not
-                 bit-orc1
-                 bit-orc2
-                 bit-xor
-                 break
-                 butlast
-                 car
-                 cdr
-                 ceiling
-                 cerror
-                 change-class
-                 char-equal
-                 char-greaterp
-                 char-lessp
-                 char-not-equal
-                 char-not-greaterp
-                 char-not-lessp
-                 char/=
-                 char<
-                 char<=
-                 char=
-                 char>
-                 char>=
-                 clear-input
-                 clear-memoize-tables
-                 clear-output
-                 compile
-                 compile-file
-                 compile-file-pathname
-                 compiler-macro-function
-                 complex
-                 compute-restarts
-                 concatenate
-                 continue
-                 copy-pprint-dispatch
-                 copy-readtable
-                 copy-symbol
-                 count
-                 count-if
-                 count-if-not
-                 decode-universal-time
-                 delete
-                 delete-duplicates
-                 delete-if
-                 delete-if-not
-                 describe
-                 digit-char
-                 digit-char-p
-                 directory
-                 dribble
-                 ed
-                 encode-universal-time
-                 enough-namestring
-                 ensure-directories-exist
-                 ensure-generic-function
-                 eq
-                 eql
-                 error
-                 eval
-                 every
-                 export
-                 fboundp
-                 fceiling
-                 ffloor
-                 file-position
-                 fill
-                 find
-                 find-class
-                 find-if
-                 find-if-not
-                 find-method
-                 find-restart
-                 find-symbol
-                 finish-output
-                 fixnum-to-symbol
-                 float
-                 float-sign
-                 floor
-                 force-output
-                 format
-                 fresh-line
-                 fround
-                 ftruncate
-                 funcall
-                 gensym
-                 gentemp
-                 get
-                 get-dispatch-macro-character
-                 get-internal-real-time
-                 get-internal-run-time
-                 get-macro-character
-                 get-properties
-                 get-setf-expansion
-                 getf
-                 gethash
-                 if
-                 import
-                 initialize-instance
-                 intern
-                 internal-real-time
-                 intersection
-                 invalid-method-error
-                 invoke-restart
-                 last
-                 ld-fn
-                 len
-                 len1
-                 length
-                 lisp-implementation-type
-                 list
-                 list*
-                 listen
-                 load
-                 log
-                 macro-function
-                 macroexpand
-                 macroexpand-1
-                 make-array
-                 make-broadcast-stream
-                 make-concatenated-stream
-                 make-condition
-                 make-dispatch-macro-character
-                 make-hash-table
-                 make-instance
-                 make-list
-                 make-load-form
-                 make-load-form-saving-slots
-                 make-package
-                 make-pathname
-                 make-random-state
-                 make-sequence
-                 make-string
-                 make-string-input-stream
-                 make-string-output-stream
-                 map
-                 map-into
-                 mapc
-                 mapcan
-                 mapcar
-                 mapcon
-                 mapl
-                 maplist
-                 max
-                 member
-                 member-if
-                 member-if-not
-                 memoize-call-array-grow
-                 memoize-eval-compile
-                 memoize-fn
-                 merge
-                 merge-pathnames
-                 method-combination-error
-                 mf-1st-warnings
-                 mf-2nd-warnings
-                 mf-warnings
-                 mismatch
-                 muffle-warning
-                 nbutlast
-                 nconc
-                 nintersection
-                 no-applicable-method
-                 no-next-method
-                 not
-                 notany
-                 notevery
-                 nset-difference
-                 nset-exclusive-or
-                 nstring-capitalize
-                 nstring-downcase
-                 nstring-upcase
-                 nsublis
-                 nsubst
-                 nsubst-if
-                 nsubst-if-not
-                 nsubstitute
-                 nsubstitute-if
-                 nsubstitute-if-not
-                 null
-                 nunion
-                 open
-                 pairlis
-                 parse-integer
-                 parse-namestring
-                 pathname-device
-                 pathname-directory
-                 pathname-host
-                 pathname-name
-                 pathname-type
-                 peek-char
-                 position
-                 position-if
-                 position-if-not
-                 pprint
-                 pprint-dispatch
-                 pprint-fill
-                 pprint-indent
-                 pprint-linear
-                 pprint-newline
-                 pprint-tab
-                 pprint-tabular
-                 prin1
-                 princ
-                 princ-to-string
-                 print
-                 print-object
-                 profile-fn
-                 profile-acl2
-                 profile-all
-                 random
-                 rassoc
-                 rassoc-if
-                 rassoc-if-not
-                 read
-                 read-byte
-                 read-char
-                 read-char-no-hang
-                 read-delimited-list
-                 read-from-string
-                 read-line
-                 read-preserving-whitespace
-                 read-sequence
-                 reduce
-                 reinitialize-instance
-                 remove
-                 remove-duplicates
-                 remove-if
-                 remove-if-not
-                 rename-file
-                 rename-package
-                 replace
-                 require
-                 reverse-strip-cars
-                 reverse-strip-cdrs
-                 room
-                 round
-                 sbit
-                 search
-                 set-difference
-                 set-dispatch-macro-character
-                 set-exclusive-or
-                 set-macro-character
-                 set-pprint-dispatch
-                 set-syntax-from-char
-                 shadow
-                 shadowing-import
-                 shared-initialize
-                 signal
-                 signum
-                 slot-missing
-                 some
-                 sort
-                 stable-sort
-                 store-value
-                 string-capitalize
-                 string-downcase
-                 string-equal
-                 string-greaterp
-                 string-lessp
-                 string-not-equal
-                 string-not-greaterp
-                 string-not-lessp
-                 string-upcase
-                 string/=
-                 string<
-                 string<=
-                 string=
-                 string>
-                 string>=
-                 stringp
-                 sublis
-                 subseq
-                 subsetp
-                 subst
-                 subst-if
-                 subst-if-not
-                 substitute
-                 substitute-if
-                 substitute-if-not
-                 subtypep
-                 svref
-                 symbol-to-fixnum
-                 symbol-to-fixnum-create
-                 symbolp
-                 sync-memoize-call-array
-                 terpri
-                 translate-logical-pathname
-                 translate-pathname
-                 tree-equal
-                 true-listp
-                 truncate
-                 typep
-                 unexport
-                 unintern
-                 union
-                 unread-char
-                 unuse-package
-                 update-instance-for-different-class
-                 update-instance-for-redefined-class
-                 upgraded-array-element-type
-                 upgraded-complex-part-type
-                 use-package
-                 use-value
-                 user-homedir-pathname
-                 values
-                 vector-push-extend
-                 warn
-                 wild-pathname-p
-                 write
-                 write-byte
-                 write-char
-                 write-line
-                 write-sequence
-                 write-string
-                 write-to-string
-                 y-or-n-p
-                 yes-or-no-p)
-               do (setf (gethash x ht) t))
-         ht)))
-
-  (defun never-memoize-fn (fn)
-    (setf (gethash fn never-memoize-ht) t))
-
-  (defun never-memoize-p (fn)
-    (if (gethash fn never-memoize-ht)
-        t
-      nil)))
-
-
+(defvar *never-memoize-ht*
+  (let ((ht (make-hash-table :test 'eq)))
+    (loop for x in
+          '(bytes-used
+            memoize-summary
+            memoize-summary-after-compute-calls-and-times
+            #+rdtsc ccl::rdtsc
+            *
+            +
+            -
+            <
+            <=
+            =
+            >
+            >=
+            abort
+            adjoin
+            adjust-array
+            allocate-instance
+            append
+            apply
+            apropos
+            apropos-list
+            aref
+            arrayp
+            assoc
+            assoc-if
+            assoc-if-not
+            atan
+            atom
+            bit
+            bit-and
+            bit-andc1
+            bit-andc2
+            bit-eqv
+            bit-ior
+            bit-nand
+            bit-nor
+            bit-not
+            bit-orc1
+            bit-orc2
+            bit-xor
+            break
+            butlast
+            car
+            cdr
+            ceiling
+            cerror
+            change-class
+            char-equal
+            char-greaterp
+            char-lessp
+            char-not-equal
+            char-not-greaterp
+            char-not-lessp
+            char/=
+            char<
+            char<=
+            char=
+            char>
+            char>=
+            clear-input
+            clear-memoize-tables
+            clear-output
+            compile
+            compile-file
+            compile-file-pathname
+            compiler-macro-function
+            complex
+            compute-restarts
+            concatenate
+            continue
+            copy-pprint-dispatch
+            copy-readtable
+            copy-symbol
+            count
+            count-if
+            count-if-not
+            decode-universal-time
+            delete
+            delete-duplicates
+            delete-if
+            delete-if-not
+            describe
+            digit-char
+            digit-char-p
+            directory
+            dribble
+            ed
+            encode-universal-time
+            enough-namestring
+            ensure-directories-exist
+            ensure-generic-function
+            eq
+            eql
+            error
+            eval
+            every
+            export
+            fboundp
+            fceiling
+            ffloor
+            file-position
+            fill
+            find
+            find-class
+            find-if
+            find-if-not
+            find-method
+            find-restart
+            find-symbol
+            finish-output
+            fixnum-to-symbol
+            float
+            float-sign
+            floor
+            force-output
+            format
+            fresh-line
+            fround
+            ftruncate
+            funcall
+            gensym
+            gentemp
+            get
+            get-dispatch-macro-character
+            get-internal-real-time
+            get-internal-run-time
+            get-macro-character
+            get-properties
+            get-setf-expansion
+            getf
+            gethash
+            if
+            import
+            initialize-instance
+            intern
+            internal-real-time
+            intersection
+            invalid-method-error
+            invoke-restart
+            last
+            ld-fn
+            len
+            len1
+            length
+            lisp-implementation-type
+            list
+            list*
+            listen
+            load
+            log
+            macro-function
+            macroexpand
+            macroexpand-1
+            make-array
+            make-broadcast-stream
+            make-concatenated-stream
+            make-condition
+            make-dispatch-macro-character
+            make-hash-table
+            make-instance
+            make-list
+            make-load-form
+            make-load-form-saving-slots
+            make-package
+            make-pathname
+            make-random-state
+            make-sequence
+            make-string
+            make-string-input-stream
+            make-string-output-stream
+            map
+            map-into
+            mapc
+            mapcan
+            mapcar
+            mapcon
+            mapl
+            maplist
+            max
+            member
+            member-if
+            member-if-not
+            memoize-call-array-grow
+            memoize-eval-compile
+            memoize-fn
+            merge
+            merge-pathnames
+            method-combination-error
+            mf-1st-warnings
+            mf-2nd-warnings
+            mf-warnings
+            mismatch
+            muffle-warning
+            nbutlast
+            nconc
+            nintersection
+            no-applicable-method
+            no-next-method
+            not
+            notany
+            notevery
+            nset-difference
+            nset-exclusive-or
+            nstring-capitalize
+            nstring-downcase
+            nstring-upcase
+            nsublis
+            nsubst
+            nsubst-if
+            nsubst-if-not
+            nsubstitute
+            nsubstitute-if
+            nsubstitute-if-not
+            null
+            nunion
+            open
+            pairlis
+            parse-integer
+            parse-namestring
+            pathname-device
+            pathname-directory
+            pathname-host
+            pathname-name
+            pathname-type
+            peek-char
+            position
+            position-if
+            position-if-not
+            pprint
+            pprint-dispatch
+            pprint-fill
+            pprint-indent
+            pprint-linear
+            pprint-newline
+            pprint-tab
+            pprint-tabular
+            prin1
+            princ
+            princ-to-string
+            print
+            print-object
+            profile-fn
+            profile-acl2
+            profile-all
+            random
+            rassoc
+            rassoc-if
+            rassoc-if-not
+            read
+            read-byte
+            read-char
+            read-char-no-hang
+            read-delimited-list
+            read-from-string
+            read-line
+            read-preserving-whitespace
+            read-sequence
+            reduce
+            reinitialize-instance
+            remove
+            remove-duplicates
+            remove-if
+            remove-if-not
+            rename-file
+            rename-package
+            replace
+            require
+            reverse-strip-cars
+            reverse-strip-cdrs
+            room
+            round
+            sbit
+            search
+            set-difference
+            set-dispatch-macro-character
+            set-exclusive-or
+            set-macro-character
+            set-pprint-dispatch
+            set-syntax-from-char
+            shadow
+            shadowing-import
+            shared-initialize
+            signal
+            signum
+            slot-missing
+            some
+            sort
+            stable-sort
+            store-value
+            string-capitalize
+            string-downcase
+            string-equal
+            string-greaterp
+            string-lessp
+            string-not-equal
+            string-not-greaterp
+            string-not-lessp
+            string-upcase
+            string/=
+            string<
+            string<=
+            string=
+            string>
+            string>=
+            stringp
+            sublis
+            subseq
+            subsetp
+            subst
+            subst-if
+            subst-if-not
+            substitute
+            substitute-if
+            substitute-if-not
+            subtypep
+            svref
+            symbol-to-fixnum
+            symbol-to-fixnum-create
+            symbolp
+            sync-memoize-call-array
+            terpri
+            translate-logical-pathname
+            translate-pathname
+            tree-equal
+            true-listp
+            truncate
+            typep
+            unexport
+            unintern
+            union
+            unread-char
+            unuse-package
+            update-instance-for-different-class
+            update-instance-for-redefined-class
+            upgraded-array-element-type
+            upgraded-complex-part-type
+            use-package
+            use-value
+            user-homedir-pathname
+            values
+            vector-push-extend
+            warn
+            wild-pathname-p
+            write
+            write-byte
+            write-char
+            write-line
+            write-sequence
+            write-string
+            write-to-string
+            y-or-n-p
+            yes-or-no-p)
+          do (setf (gethash x ht) t))
+    ht))
+
+(defun never-memoize-fn (fn)
+  (setf (gethash fn *never-memoize-ht*) t))
+
+(defun never-memoize-p (fn)
+  (if (gethash fn *never-memoize-ht*)
+      t
+    nil))
 
 
 ; The following was inserted by Jared to keep his place; stuff above is "done"
@@ -1784,20 +1784,7 @@
                             ((rationalp y)
                              (< y x))))))))))
 
-;; [Jared]: moved this here from acl2-fns.lisp, since it's only used in
-;; memoize-raw
-
 (defun our-function-lambda-expression (sym)
-
-; [Jared] I don't understand this comment
-; This is intended only for #+hons; otherwise it reduces to (mv
-; (function-lambda-expression (symbol-function sym)) nil).
-
-  #-cltl2
-  (declare (ignore sym))
-  #-cltl2
-  (mv nil nil)
-  #+cltl2
   (let ((temp (get sym 'acl2-saved-def)))
     (cond (temp (values temp t))
           (t (let* ((fn (symbol-function sym))
@@ -1848,6 +1835,15 @@
         (t
          cl-defun)))
 
+(defun fix-time (ticks ctx)
+  (declare (type integer ticks))
+  (if (and (<= 0 ticks)
+           (< ticks (* 864000 ;; 10 days, in seconds
+                       *float-ticks/second*)))
+      ticks
+    (progn (format t "Ignoring time increment of ~a sec for ~a~%"
+                   (/ ticks *float-ticks/second*) ctx)
+           0)))
 
 (defg *memoize-init-done* nil)
 
@@ -2389,10 +2385,10 @@
                          `((safe-incf
                             (aref ,*mf-ma*
                                   (the mfixnum (1+ ,*mf-count-loc*)))
-                            (mod
-                             (the integer (- (internal-real-time)
-                                             ,start-time))
-                             most-positive-mfixnum)
+                            (the integer
+                              (fix-time (the integer (- (internal-real-time)
+                                                        ,start-time))
+                                        ',fn))
                             ,fn)))
                   ,@(and forget
 
diff -Nru acl2-6.2/memoize.lisp acl2-6.3/memoize.lisp
--- acl2-6.2/memoize.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/memoize.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/multi-threading-raw.lisp acl2-6.3/multi-threading-raw.lisp
--- acl2-6.2/multi-threading-raw.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/multi-threading-raw.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/new.html acl2-6.3/new.html
--- acl2-6.2/new.html	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/new.html	2013-09-30 15:49:41.000000000 +0000
@@ -1,21 +1,27 @@
 <HTML>
-<HEAD><TITLE>ACL2 Version 6.2 News</TITLE></HEAD>
+<HEAD><TITLE>ACL2 Version 6.3 News</TITLE></HEAD>
 
 <BODY TEXT="#000000">
 <BODY BGCOLOR="#FFFFFF">
 
-<H1><A NAME="top"><a href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2</a> Version 6.2 News</A></H1>
+<H1><A NAME="top"><a href="http://www.cs.utexas.edu/users/moore/acl2/">ACL2</a> Version 6.3 News</A></H1>
 
 <H2>Table of Contents</H2>
 
 <ul>
 
+<LI><A HREF="#svn">ACL2 sources availability between releases</A></LI>
 <LI><A HREF="#vstte-12">VSTTE 2012 Competition</A></LI>
 <LI><A HREF="#acl2-books">ACL2 Books Repository</A></LI>
 <LI><A HREF="#performance">Performance Comparisons</A></LI>
 
 </ul>
 
+<A NAME="svn"><H2>ACL2 sources availability between releases</H2>
+
+ACL2 sources are now available between releases, as described in
+<a href="svn-availability.txt">this announcement</a>.
+
 <A NAME="vstte-12"><H2>VSTTE 2012 Competition</H2>
 
 A team of four ACL2 users entered the VSTTE 2012 competition.  For
diff -Nru acl2-6.2/non-linear.lisp acl2-6.3/non-linear.lisp
--- acl2-6.2/non-linear.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/non-linear.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/openmcl-acl2-trace.lisp acl2-6.3/openmcl-acl2-trace.lisp
--- acl2-6.2/openmcl-acl2-trace.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/openmcl-acl2-trace.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/other-events.lisp acl2-6.3/other-events.lisp
--- acl2-6.2/other-events.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/other-events.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -1516,7 +1516,7 @@
 ; documentation purposes:
 
                          state
-                         declare apropos
+                         declare apropos finding-documentation
                          enter-boot-strap-mode exit-boot-strap-mode
                          lp acl2-defaults-table let let*
                          complex complex-rationalp
@@ -4290,6 +4290,7 @@
      add-custom-keyword-hint
      add-default-hints!
      add-include-book-dir
+     add-ld-keyword-alias!
      add-match-free-override
      comp
      defabsstobj
@@ -4333,7 +4334,7 @@
      set-enforce-redundancy
      set-ignore-doc-string-error
      set-ignore-ok
-     set-inhibit-warnings
+     set-inhibit-warnings!
      set-invisible-fns-table
      set-irrelevant-formals-ok
      set-let*-abstractionp
@@ -4650,8 +4651,7 @@
                                      make-event-chk)
 
 ; WARNING: Keep this in sync with destructure-expansion, elide-locals-rec,
-; elide-locals-post, make-include-books-absolute, and
-; find-first-non-local-name.
+; make-include-books-absolute, and find-first-non-local-name.
 
 ; Note: For a test of this function, see the reference to foo.lisp below.
 
@@ -4821,7 +4821,6 @@
                              set-enforce-redundancy
                              set-ignore-doc-string-error
                              set-ignore-ok
-                             set-inhibit-warnings
                              set-irrelevant-formals-ok
                              set-let*-abstractionp
                              set-match-free-default
@@ -4931,14 +4930,16 @@
           ((eq (car form) 'make-event)
            (cond ((and make-event-chk
                        (not (and (true-listp form)
-                                 (consp (cadr (member-eq :check-expansion
-                                                         form))))))
+                                 (or (consp (cadr (member-eq :check-expansion
+                                                             form)))
+                                     (consp (cadr (member-eq :expansion?
+                                                             form)))))))
                   (er soft ctx
-                      "The :check-expansion argument of make-event should be ~
-                       a consp in the present context.  Unless you called ~
-                       record-expansion explicitly, this is an ACL2 bug; ~
-                       please contact the ACL2 implementors.  Current ~
-                       form:~|~%~X01"
+                      "Either the :check-expansion or :expansion? argument of ~
+                       make-event should be a consp in the present context.  ~
+                       Unless you called record-expansion explicitly, this is ~
+                       an ACL2 bug; please contact the ACL2 implementors.  ~
+                       Current form:~|~%~X01"
                       form
                       nil))
                  (t (value form))))
@@ -5004,8 +5005,7 @@
 
 (defun destructure-expansion (form)
 
-; WARNING: Keep this in sync with chk-embedded-event-form, elide-locals-rec,
-; and elide-locals-post.
+; WARNING: Keep this in sync with chk-embedded-event-form and elide-locals-rec.
 
   (declare (xargs :guard (true-listp form)))
   (cond ((member-eq (car form) '(local skip-proofs with-output
@@ -5501,7 +5501,7 @@
 (defun elide-locals-rec (form strongp)
 
 ; WARNING: Keep this in sync with chk-embedded-event-form,
-; destructure-expansion, make-include-books-absolute, and elide-locals-post.
+; destructure-expansion, and make-include-books-absolute.
 
 ; We assume that form is a legal event form and return (mv changed-p new-form),
 ; where new-form results from eliding top-level local events from form, and
@@ -8832,7 +8832,12 @@
              (if (eq r t)
                  state
                (f-put-global 'last-make-event-expansion r state))
-             (stop-redundant-event ctx state)))
+             (stop-redundant-event
+              ctx state
+              (and (not (eq r t))
+                   "(This event is redundant with a previous encapsulate ~
+                    event even though the two are not equal; see :DOC ~
+                    redundant-encapsulate.)"))))
            ((and (not (eq (ld-skip-proofsp state) 'include-book))
                  (not (eq (ld-skip-proofsp state) 'include-book-with-locals))
                  (not (eq (ld-skip-proofsp state) 'initialize-acl2)))
@@ -9066,7 +9071,8 @@
         (eval-event-lst
          0 nil
          ev-lst
-         t ; quietp
+         (or (ld-skip-proofsp state)
+             progn!p) ; quietp
          (eval-event-lst-environment in-encapsulatep state)
          (f-get-global 'in-local-flg state)
          nil
@@ -9151,7 +9157,6 @@
 ; known-package-alist immediately after form is evaluated; and if not, we
 ; return a soft error.
 
-  (declare (ignorable on-behalf-of)) ; for hons
   (let ((original-wrld (w state)))
     (protect-system-state-globals
      (er-let*
@@ -9246,7 +9251,120 @@
        :guard
        (eq key 'empty-event-key))
 
-(defun make-event-fn (form check-expansion on-behalf-of whole-form state)
+(defun make-event-fn2 (expansion0 whole-form in-encapsulatep check-expansion
+                                  wrld ctx state)
+  (mv-let
+   (do-proofsp expansion0)
+   (case-match expansion0
+     ((':DO-PROOFS x)
+      (mv (ld-skip-proofsp state)
+          x))
+     (& (mv nil expansion0)))
+   (er-let* ((expansion1a ; apply macroexpansion to get embedded event form
+              (do-proofs?
+
+; This wrapper of do-proofs? avoids errors in checking expansions when
+; ld-skip-proofsp is 'include-book.  See the "Very Technical Remark" in
+; community book  books/make-event/read-from-file.lisp.
+
+               check-expansion
+               (chk-embedded-event-form
+                expansion0 whole-form wrld ctx state (primitive-event-macros)
+                nil ; portcullisp
+                (f-get-global 'in-local-flg state)
+                in-encapsulatep
+                nil))) 
+             (expansion1
+              (value (or expansion1a
+
+; Else the alleged embedded event form, from the expansion, is nil, presumably
+; because of local.
+
+                         *local-value-triple-elided*)))
+             (stobjs-out-and-raw-result
+              (do-proofs?
+               do-proofsp
+               (trans-eval
+
+; Note that expansion1 is guaranteed to be an embedded event form, which (as
+; checked just below) must evaluate to an error triple.
+
+                expansion1
+                ctx state t))))
+     (let ((raw-result (cdr stobjs-out-and-raw-result)))
+       (cond ((car raw-result)
+              (silent-error state))
+             (t (value (list* expansion1
+                              (car stobjs-out-and-raw-result)
+                              (cadr raw-result)))))))))
+
+(defun make-event-fn2-lst (expansion-lst whole-form in-encapsulatep
+                                         check-expansion wrld ctx state)
+  (cond ((atom expansion-lst)
+         (er soft ctx
+             "Evaluation failed for all expansions."))
+        (t (pprogn
+            (cond
+             ((f-get-global 'make-event-debug state)
+              (fms "Attempting evaluation of next expansion:~|~Y01"
+                   (list (cons #\0 (car expansion-lst))
+                         (cons #\1 (abbrev-evisc-tuple state)))
+                   (proofs-co state)
+                   state
+                   nil))
+             (t state))
+            (mv-let
+             (erp val state)
+             (make-event-fn2 (car expansion-lst)
+                             whole-form in-encapsulatep check-expansion
+                             wrld ctx state)
+             (cond (erp (make-event-fn2-lst (cdr expansion-lst)
+                                            whole-form in-encapsulatep
+                                            check-expansion wrld ctx state))
+                   (t (value val))))))))
+
+(defun make-event-fn1 (expansion0 whole-form in-encapsulatep check-expansion
+                                  wrld ctx state)
+  (cond ((and (consp expansion0)
+              (eq (car expansion0) :OR))
+         (make-event-fn2-lst (cdr expansion0)
+                             whole-form in-encapsulatep check-expansion
+                             wrld ctx state))
+        (t (make-event-fn2 expansion0
+                           whole-form in-encapsulatep check-expansion
+                           wrld ctx state))))
+
+(defun ultimate-expansion (x)
+
+; We dive inside values of :expansion? keywords, starting with x, and stepping
+; past wrappers (in the sense of destructure-expansion).  Except, if
+; :expansion? is provided but :check-expansion is non-nil (hence t), then
+; :expansion? is ignored for this purpose, so that we can avoid destroying the
+; surrounding make-event that should be saved for purposes of :check-expansion.
+; The idea is that when including a book (or doing the second pass of an
+; encapsulate), we replace a make-event form directly by its :expansion? value
+; unless :check-expansion is t, in which case the make-event form and the
+; :expansion?  value are not equivalent, because the make-event form redoes the
+; expansion process.
+
+; Warning: Be careful not to use this function unless each make-event form
+; encountered during the traversal that has a value for the :expansion? keyword
+; can be trusted to have an expansion suitably consistent with that value.
+
+  (case-match x
+    (('make-event & . kwd-alist)
+     (let ((exp (cadr (assoc-keyword :expansion? kwd-alist))))
+       (cond ((and exp
+                   (not (cadr (assoc-keyword :check-expansion kwd-alist))))
+              (ultimate-expansion exp))
+             (t x))))
+    (& (mv-let (w y)
+               (destructure-expansion x)
+               (cond (w (rebuild-expansion w (ultimate-expansion y)))
+                     (t x))))))
+
+(defun make-event-fn (form expansion? check-expansion on-behalf-of whole-form
+                           state)
   (let ((ctx (make-event-ctx whole-form))
         #-acl2-loop-only
         (old-kpa (known-package-alist state)))
@@ -9288,6 +9406,29 @@
             pair.  The following check-expansion flag is thus illegal: ~x0.  ~
             See :DOC make-event."
            check-expansion))
+      ((and expansion?
+            (consp check-expansion))
+
+; We considered allowing :EXPANSION? FORM1 and :CHECK-EXPANSION FORM2 (where
+; FORM2 is not nil or t), and if someone presents a natural example for which
+; this would be useful, we might do so.  But the semantics of this would be
+; potentially confusing.  Which one is consulted when including a book or
+; running in raw Lisp?  If FORM1 = FORM2, this looks redundant.  Otherwise,
+; this is, oddly, inherently contradictory, in the sense that FORM1 should
+; never be the expansion (unless one is deliberately arranging for evaluation
+; of the make-event call to fail -- but there are simpler ways to do that).
+
+; If we decide to support the combination of expansion? and (consp
+; check-expansion), then we need to be careful to handle that combination --
+; something we don't do now, but we code defensively, giving priority to (consp
+; check-expansion).
+
+       (er soft ctx
+           "It is illegal to supply a non-nil value for the keyword argument ~
+            :EXPANSION? of make-event when keyword argument :CHECK-EXPANSION ~
+            is give a value other than T or NIL.  If you think you have a ~
+            reason why such a combination should be supported, please contact ~
+            the ACL2 implementors."))
       (t
        (revert-world-on-error
         (state-global-let*
@@ -9295,10 +9436,26 @@
                                                     state))))
          (let ((wrld (w state)))
            (er-let*
-            ((debug-depth (make-event-debug-pre form on-behalf-of state))
-             (expansion0/new-kpa/new-ttags-seen
-              (do-proofs?
-               (or check-expansion
+               ((debug-depth (make-event-debug-pre form on-behalf-of state))
+                (expansion0/new-kpa/new-ttags-seen
+                 (cond
+                  ((and expansion?
+                        (eq (ld-skip-proofsp state) 'include-book)
+
+; Even if expansion? is specified, we do not assume it's right if
+; check-expansion is t.
+
+                        (assert$ (iff check-expansion
+
+; In code above, we disallowed the combination of non-nil expansion? with a
+; consp value of :check-expansion.
+
+                                      (eq check-expansion t))
+                                 (not (eq check-expansion t))))
+                   (value (list* expansion? nil nil)))
+                  (t
+                   (do-proofs?
+                    (or check-expansion
 
 ; For example, a must-fail form in community book books/make-event/defspec.lisp
 ; will fail during the Pcertify process of provisional certification unless we
@@ -9311,58 +9468,36 @@
 ; certification as a way of validating some code.  So our approach is only to
 ; move proofs from the Convert procedure to the Pcertify procedure.
 
-                   (eq (cert-op state) :create-pcert))
-               (protected-eval form on-behalf-of ctx state t)))
-             (expansion0 (value (car expansion0/new-kpa/new-ttags-seen)))
-             (new-kpa (value (cadr expansion0/new-kpa/new-ttags-seen)))
-             (new-ttags-seen (value (cddr expansion0/new-kpa/new-ttags-seen)))
-             (expansion1a ; apply macroexpansion to get embedded event form
-              (pprogn
-               (make-event-debug-post debug-depth expansion0 state)
-               (do-proofs?
-
-; This wrapper of do-proofs? avoids errors in checking expansions when
-; ld-skip-proofsp is 'include-book.  See the "Very Technical Remark" in
-; community book  books/make-event/read-from-file.lisp.
-
-                check-expansion
-                (chk-embedded-event-form
-                 expansion0 whole-form wrld ctx state (primitive-event-macros)
-                 nil ; portcullisp
-                 (f-get-global 'in-local-flg state)
-                 (in-encapsulatep (global-val 'embedded-event-lst wrld) nil)
-                 nil))))
-             (new-ttags-p
-              (value (not (equal new-ttags-seen
-                                 (global-val 'ttags-seen (w state))))))
-             (expansion1
-              (value (or expansion1a
-
-; Else the alleged embedded event form, from the expansion, is nil, presumably
-; because of local.
-
-                         *local-value-triple-elided*)))
-             (stobjs-out-and-result
-              (pprogn
-               (cond (new-ttags-p
-                      (set-w! (global-set 'ttags-seen new-ttags-seen (w state))
-                              state))
-                     (t state))
-               (trans-eval
-
-; Note that expansion1 is guaranteed to be an embedded event form, which (as
-; checked just below) must evaluate to an error triple.
-
-                expansion1
-                ctx state t))))
-            (let ((stobjs-out (car stobjs-out-and-result))
-                  (result (cdr stobjs-out-and-result))
-                  (expansion2
-                   (cond
-                    ((f-get-global 'last-make-event-expansion state)
-                     (mv-let
-                      (wrappers base)
-                      (destructure-expansion expansion1)
+                        (eq (cert-op state) :create-pcert))
+                    (protected-eval form on-behalf-of ctx state t)))))
+                (expansion0 (value (car expansion0/new-kpa/new-ttags-seen)))
+                (new-kpa (value (cadr expansion0/new-kpa/new-ttags-seen)))
+                (new-ttags-seen (value (cddr expansion0/new-kpa/new-ttags-seen)))
+                (new-ttags-p
+                 (pprogn
+                  (make-event-debug-post debug-depth expansion0 state)
+                  (cond ((equal new-ttags-seen
+                                (global-val 'ttags-seen wrld))
+                         (value nil))
+                        (t (pprogn
+                            (set-w! (global-set 'ttags-seen new-ttags-seen wrld)
+                                    state)
+                            (value t))))))
+                (wrld0 (value (w state)))
+                (expansion1/stobjs-out/result
+                 (make-event-fn1
+                  expansion0 whole-form
+                  (in-encapsulatep (global-val 'embedded-event-lst wrld0) nil)
+                  check-expansion wrld0 ctx state)))
+             (let* ((expansion1 (car expansion1/stobjs-out/result))
+                    (stobjs-out (cadr expansion1/stobjs-out/result))
+                    (result (cddr expansion1/stobjs-out/result))
+                    (expansion2
+                     (cond
+                      ((f-get-global 'last-make-event-expansion state)
+                       (mv-let
+                        (wrappers base)
+                        (destructure-expansion expansion1)
 
 ; At this point we know that (car base) is from the list '(make-event progn
 ; progn! encapsulate); indeed, just after the release of v3-5, we ran a
@@ -9372,46 +9507,66 @@
 ; ACL2s can create make-event expansions out of events other than the four
 ; types above, e.g., defun.
 
-                      (declare (ignore base))
-                      (rebuild-expansion
-                       wrappers
-                       (f-get-global 'last-make-event-expansion state))))
-                    (t expansion1))))
-              (assert$
-               (equal stobjs-out *error-triple-sig*) ; evaluated an event form
-               (cond ((car result)
-                      (silent-error state))
-                     ((and (consp check-expansion)
-                           (not (equal check-expansion expansion2)))
-                      (er soft ctx
-                          "The current MAKE-EVENT expansion differs from the ~
-                           expected (original or specified) expansion.  See ~
-                           :DOC make-event.~|~%~|~%Make-event ~
-                           argument:~|~%~y0~|~%Expected ~
-                           expansion:~|~%~y1~|~%Current expansion:~|~%~y2~|"
-                          form
-                          check-expansion
-                          expansion2))
-                     (t
-                      (let ((actual-expansion
-                             (cond
-                              ((consp check-expansion)
+                        (declare (ignore base))
+                        (rebuild-expansion
+                         wrappers
+                         (ultimate-expansion
+                          (f-get-global 'last-make-event-expansion state)))))
+                      (t (ultimate-expansion expansion1)))))
+               (assert$
+                (equal stobjs-out *error-triple-sig*) ; evaluated an event form
+                (let ((expected-expansion (if (consp check-expansion)
+                                              check-expansion
+                                            (and (eq (ld-skip-proofsp state)
+                                                     'include-book)
+                                                 check-expansion
+                                                 expansion?))))
+                  (cond ((and expected-expansion
+                              (not (equal expected-expansion ; easy try first
+                                          expansion2))
+                              (not (equal (ultimate-expansion
+                                           expected-expansion)
+                                          expansion2)))
+                         (er soft ctx
+                             "The current MAKE-EVENT expansion differs from ~
+                              the expected (original or specified) expansion. ~
+                              ~ See :DOC make-event.~|~%~|~%Make-event ~
+                              argument:~|~%~y0~|~%Expected ~
+                              expansion:~|~%~y1~|~%Current expansion:~|~%~y2~|"
+                             form
+                             expected-expansion
+                             expansion2))
+                        (t
+                         (let ((actual-expansion
+                                (cond
+                                 ((or (consp check-expansion)
+                                      (equal expansion?
+                                             expansion2) ; easy try first
+                                      (equal (ultimate-expansion
+                                              expansion?)
+                                             expansion2))
 
-; The original make-event form is already expanded (see :doc
-; make-event-details).
+; The original make-event form does not generate a make-event replacement (see
+; :doc make-event).
 
-                               nil)
-                              (check-expansion
-                               (assert$
-                                (eq check-expansion t) ; from macro guard
-                                (list* 'make-event form
-                                       :check-expansion expansion2
-                                       (and on-behalf-of
-                                            `(:on-behalf-of
-                                              ,on-behalf-of)))))
-                              (t expansion2))))
-                        #-acl2-loop-only
-                        (let ((msg
+                                  nil)
+                                 (check-expansion
+                                  (assert$
+                                   (eq check-expansion t) ; from macro guard
+                                   (list* 'make-event form
+
+; Note that we deliberately omit :expansion? here, even if it was supplied
+; originally.  If :expansion? had been supplied and appropropriate, then we
+; would be in the previous case, where we don't generate a make-event around
+; the expansion.
+
+                                          :check-expansion expansion2
+                                          (and on-behalf-of
+                                               `(:on-behalf-of
+                                                 ,on-behalf-of)))))
+                                 (t expansion2))))
+                           #-acl2-loop-only
+                           (let ((msg
 
 ; We now may check the expansion to see if an unknown package appears.  The
 ; following example shows why this can be important.  Consider a book "foo"
@@ -9447,26 +9602,38 @@
 ; world installed at the end of expansion, so if expansion doesn't extend the
 ; world with any new packages, then we can avoid this check.
 
-                               (and (not (eq old-kpa new-kpa))
-                                    (bad-lisp-objectp actual-expansion))))
-                          (when msg
-                            (er hard ctx
-                                "Make-event expansion for the form ~x0 has ~
-                                 produced an illegal object for the current ~
-                                 ACL2 world.  ~@1"
-                                form
-                                msg)))
-                        (pprogn
-                         (f-put-global 'last-make-event-expansion
-                                       actual-expansion
-                                       state)
-                         (er-progn
-                          (cond ((and new-ttags-p ; optimization
-                                      (let ((wrld1 (w state)))
-                                        (not (and (eq (caar wrld1)
-                                                      'event-landmark)
-                                                  (eq (cadar wrld1)
-                                                      'global-value)))))
+                                  (and (not (eq old-kpa new-kpa))
+                                       (bad-lisp-objectp actual-expansion))))
+                             (when msg
+                               (er hard ctx
+                                   "Make-event expansion for the form ~x0 has ~
+                                    produced an illegal object for the ~
+                                    current ACL2 world.  ~@1"
+                                   form
+                                   msg)))
+                           (pprogn
+                            (f-put-global 'last-make-event-expansion
+                                          actual-expansion
+                                          state)
+                            (cond
+                             ((f-get-global 'make-event-debug state)
+                              (fms "Saving make-event replacement into state ~
+                                    global 'last-make-event-expansion (debug ~
+                                    level ~x0):~|~Y12"
+                                   (list (cons #\0 debug-depth)
+                                         (cons #\1 actual-expansion)
+                                         (cons #\2 (abbrev-evisc-tuple state)))
+                                   (proofs-co state)
+                                   state
+                                   nil))
+                             (t state))
+                            (er-progn
+                             (cond ((and new-ttags-p ; optimization
+                                         (let ((wrld1 (w state)))
+                                           (not (and (eq (caar wrld1)
+                                                         'event-landmark)
+                                                     (eq (cadar wrld1)
+                                                         'global-value)))))
 
 ; We lay down an event landmark.  Before we did so, an error was reported by
 ; print-redefinition-warning in the following example, because we weren't
@@ -9483,28 +9650,28 @@
 ;        (not (cdr (assoc-eq 'empty-event-key
 ;                            (table-alist 'acl2-system-table world)))))
 
-                                 (state-global-let*
-                                  ((inhibit-output-lst
-                                    (add-to-set-eq
-                                     'summary
-                                     (f-get-global 'inhibit-output-lst
-                                                   state))))
-                                  (TABLE-FN
-                                   'ACL2-SYSTEM-TABLE
-                                   '('EMPTY-EVENT-KEY
-                                     (NOT (CDR (ASSOC-EQ 'EMPTY-EVENT-KEY
+                                    (state-global-let*
+                                     ((inhibit-output-lst
+                                       (add-to-set-eq
+                                        'summary
+                                        (f-get-global 'inhibit-output-lst
+                                                      state))))
+                                     (TABLE-FN
+                                      'ACL2-SYSTEM-TABLE
+                                      '('EMPTY-EVENT-KEY
+                                        (NOT (CDR (ASSOC-EQ 'EMPTY-EVENT-KEY
+                                                            (TABLE-ALIST
+                                                             'ACL2-SYSTEM-TABLE
+                                                             WORLD)))))
+                                      STATE
+                                      '(TABLE ACL2-SYSTEM-TABLE 'EMPTY-EVENT-KEY
+                                              (NOT (CDR (ASSOC-EQ
+                                                         'EMPTY-EVENT-KEY
                                                          (TABLE-ALIST
                                                           'ACL2-SYSTEM-TABLE
-                                                          WORLD)))))
-                                   STATE
-                                   '(TABLE ACL2-SYSTEM-TABLE 'EMPTY-EVENT-KEY
-                                           (NOT (CDR (ASSOC-EQ
-                                                      'EMPTY-EVENT-KEY
-                                                      (TABLE-ALIST
-                                                       'ACL2-SYSTEM-TABLE
-                                                       WORLD))))))))
-                                (t (value nil)))
-                         (value (cadr result))))))))))))))))))
+                                                          WORLD))))))))
+                                   (t (value nil)))
+                             (value result))))))))))))))))))
 
 ; Now we develop the book mechanism, which shares a lot with what
 ; we've just done.  In the discussion that follows, Unix is a
@@ -9613,6 +9780,9 @@
 
   :cite include-book")
 
+(link-doc-to certifying-books books books-certification)
+(link-doc-to book-makefiles books books-certification)
+
 (deflabel community-books
   :doc
   ":Doc-Section  Books
@@ -10400,7 +10570,7 @@
                                          state)
 
 ; WARNING: Keep this in sync with chk-embedded-event-form,
-; destructure-expansion, elide-locals-rec, and elide-locals-post.
+; destructure-expansion, and elide-locals-rec.
 
 ; See the comment in fix-portcullis-cmds for a discussion.  Starting after
 ; Version_3.6.1, we allow an include-book pathname for a portcullis command to
@@ -10731,6 +10901,11 @@
                                             system-books-dir
                                             connected-book-directory)))
             (mv-let (erp pair state)
+
+; It's perfectly OK for erp to be non-nil here.  That case is handled below.
+; So if you have called break-on-error and wind up here, it's a reasonable bet
+; that it's nothing to worry about!
+
               (simple-translate-and-eval body nil nil
                                          "The second argument to defpkg"
                                          ctx w state nil)
@@ -11589,14 +11764,6 @@
                                             ctx state
                                             (cons form ans))))))))))
 
-(defun initial-acl2-defaults-table (acl2-defaults-table)
-  (let ((entry (assoc-eq :INHIBIT-WARNINGS acl2-defaults-table)))
-    (cond (entry (put-assoc-eq :INHIBIT-WARNINGS
-                               (cdr entry)
-                               *initial-acl2-defaults-table*))
-          (t *initial-acl2-defaults-table*))))
-
-
 (defun chk-raise-portcullis1 (file1 file2 ch port-file-p ctx state)
 
 ; After resetting the acl2-defaults-table, we read and eval each of the forms
@@ -11624,7 +11791,7 @@
 ; x) = (car x), then in a new session include this book after
 ; (set-verify-guards-eagerness 2), and then get a hard error with (foo 3).
 
-     (initial-acl2-defaults-table (table-alist 'acl2-defaults-table (w state)))
+     *initial-acl2-defaults-table*
      state)
     (chk-raise-portcullis2 file1 file2 ch port-file-p ctx state nil))))
 
@@ -12960,11 +13127,19 @@
                                              pcert-info old-dir
                                              new-dir cert-op ctx state)
 
-; See make-certificate-file.
+; This function supports the creation of relocated .cert files for Debian GCL
+; distributions.  See make-certificate-file.
+
+; Warning: It is tempting to replace strings in (car portcullis), which is the
+; list of portcullis commands, and the expansion-alist.  However, that will
+; result in an uncertified book after moving the .cert.final file to the .cert
+; file, because post-alist3 contains a checksum for the book as computed by
+; function check-sum-cert, using the portcullis commands and the
+; expansion-alist.
 
   (make-certificate-file1
    file
-   (cons (car portcullis) ; Warning: used in checksum, so do not modify!
+   (cons (car portcullis)
          (replace-string-prefix-in-tree
           (cdr portcullis) old-dir (length old-dir) new-dir))
    certification-file
@@ -18488,7 +18663,9 @@
   explain how to certify those books, or some of those books, with ACL2.  We
   thank Bishop Brock, Jared Davis, and Sol Swords for their substantial
   contributions to this methodology.  See ~c[books/Makefile], in the community
-  books, for more about ``Credits and History''.
+  books, for more about ``Credits and History'', and for additional technical
+  details not covered in this topic (for example, how to build a local copy of
+  the xdoc manual for those who may wish to do that).
 
   For more information about installing ACL2, see the installation
   instructions, either by following a link from the ACL2 home page or by going
@@ -23219,7 +23396,7 @@
   for more about congruent stobjs.  Note that if two names are congruent, then
   they are either both ordinary stobjs or both abstract stobjs.
 
-  ~c[Protect-default] should either be ~c[nil] (th default) or ~c[t].  It
+  ~c[Protect-default] should either be ~c[nil] (the default) or ~c[t].  It
   provides the value of keyword ~c[:PROTECT] for each member of ~c[exports]
   that does not explicitly specify ~c[:PROTECT].  See the discussion of
   ~c[exports] below.
@@ -26627,7 +26804,7 @@
 
 ; End of Essay on Nested Stobjs
 
-(defmacro stobj-let (&whole x &rest args)
+(defdoc nested-stobjs
 
 ; WARNING: This documentation contains examples from community book
 ; misc/nested-stobj-tests.lisp.  If you change those examples here, change them
@@ -26657,14 +26834,14 @@
   community book ~c[misc/nested-stobj-tests.lisp].  For further discussion, you
   are welcome to read the ``Essay on Nested Stobjs'', a long comment in ACL2
   source file ~c[other-events.lisp].  However, this documentation topic is
-  intended to be self-contained for those familiar with stobjs.
+  intended to be self-contained for those familiar with ~il[stobj]s.
 
   SECTION: Extension of ~ilc[defstobj] to permit ~il[stobj]s within stobjs
 
-  Recall that the ~c[:type] keyword of a ~ilc[defstobj] field descriptor can
-  specify the type of the field as a type-spec (~pl[type-spec]).  For example,
-  the following specifies an integer field and a field that is an array of
-  bytes.
+  Recall that the ~c[:type] keyword of a ~ilc[defstobj] field descriptor can be
+  a ``type-indicator'' that specifies the type of the field as a
+  type-spec (~pl[type-spec]).  For example, the following specifies an integer
+  field and a field that is an array of bytes.
   ~bv[]
     (defstobj st
       (int-field :type integer :initially 0)
@@ -26778,7 +26955,7 @@
   The following form returns the result of updating the ~c[fld2] field of
   ~c[parent], which is a stobj isomorphic to ~c[child], to have a value of 3.
   Below we explain the terms ``bindings'', ``producer variables'',
-  ``producer'', and ``consumer'', as well as how to understand the form above.
+  ``producer'', and ``consumer'', as well as how to understand this form.
   ~bv[]
     (stobj-let
      ((child (fld2 parent)))  ; bindings
@@ -26786,15 +26963,15 @@
      (update-fld 3 child)     ; producer
      (update-fld3 'a parent)) ; consumer
   ~ev[]
-  The four lines under ``~c[stobj-let]'' just above can be understood,
-  respectively, as follows.
+  The four lines under ``~c[stobj-let]'' just above can be understood as
+  follows.
   ~bf[]
   o Bindings:
       Bind ~c[child] to ~c[(fld2 parent)].
   o Producer variable(s) and producer:
-      Bind the producer variable, ~c[child], to
+      Then bind the variable, ~c[child], to
       the value of the producer, ~c[(update-fld 3 child)].
-  o Implicit extra step:
+  o Implicit update of parent:
       Update ~c[fld2] of ~c[parent] with the producer variable, ~c[child].
   o Consumer:
       Finally, return ~c[(update-fld3 'a parent)].
@@ -26804,7 +26981,7 @@
   ~bv[]
     (let ((child (fld2 parent))) ; bindings
       (let ((child (update-fld 3 child))) ; bind producer vars to producer
-        (let ((parent (update-fld2 child parent))) ; update parent
+        (let ((parent (update-fld2 child parent))) ; implicit update of parent
           (update-fld3 'a parent))))
   ~ev[]
   The bindings always bind distinct names to child stobjs of a unique parent
@@ -26833,12 +27010,74 @@
      (update-fld3 'a parent)) ; consumer
   ~ev[]
 
-  If you try to evaluate (either version of) the above ~c[stobj-let] form in
-  the top-level loop, you will get an error.  For technical reasons, ACL2
-  limits ~c[stobj-let] computation on ``live'' stobjs (as opposed to list
-  structures that happen to satisfy stobj recognizers) to be within function
-  bodies.  The following edited log illustrates how ~c[stobj-let] may be used
-  in function bodies.
+  You can experiment using ~c[:]~ilc[trans1] to see the single-step
+  macroexpansion of a ~c[stobj-let] form in the logic.  For example, here is
+  how that works for a ~c[stobj-let] form that binds three fields and updates
+  two of them.  Notice that because more than one field is updated, an
+  ~ilc[mv-let] form is generated to bind the two fields to their values
+  returned by the producer, rather than a ~ilc[let] form as previously
+  generated.  First, let's introduce some events.
+
+  ~bv[]
+  (defstobj child1 child1-fld)
+  (defstobj child2 child2-fld)
+  (defstobj child3 child3-fld)
+  (defstobj mom
+    (fld1 :type child1)
+    (fld2 :type child2)
+    (fld3 :type child3))
+  ; Silly stub:
+  (defun update-last-op (op mom)
+    (declare (xargs :stobjs mom))
+    (declare (ignore op))
+    mom)
+  (defun new-mom (mom)
+    (declare (xargs :stobjs mom))
+    (stobj-let
+     ((child1 (fld1 mom))
+      (child2 (fld2 mom))
+      (child3 (fld3 mom)))
+     (child1 child3)
+     (let* ((child1 (update-child1-fld 'one child1))
+            (child3 (update-child3-fld 'three child3)))
+       (mv child1 child3))
+     (update-last-op 'my-compute mom)))
+  ~ev[]
+  Now let's look at the single-step macroexpansion of the above ~c[stobj-let]
+  form.
+  ~bv[]
+  ACL2 !>:trans1 (stobj-let
+                  ((child1 (fld1 mom))
+                   (child2 (fld2 mom))
+                   (child3 (fld3 mom)))
+                  (child1 child3)
+                  (let* ((child1 (update-child1-fld 'one child1))
+                         (child3 (update-child3-fld 'three child3)))
+                    (mv child1 child3))
+                  (update-last-op 'my-compute mom))
+   (PROGN$
+    (LET
+     ((CHILD1 (FLD1 MOM))
+      (CHILD2 (FLD2 MOM))
+      (CHILD3 (FLD3 MOM)))
+     (DECLARE (IGNORABLE CHILD1 CHILD2 CHILD3))
+     (MV-LET
+        (CHILD1 CHILD3)
+        (CHECK-VARS-NOT-FREE (MOM)
+                             (LET* ((CHILD1 (UPDATE-CHILD1-FLD 'ONE CHILD1))
+                                    (CHILD3 (UPDATE-CHILD3-FLD 'THREE CHILD3)))
+                                   (MV CHILD1 CHILD3)))
+        (LET* ((MOM (UPDATE-FLD1 CHILD1 MOM))
+               (MOM (UPDATE-FLD3 CHILD3 MOM)))
+              (CHECK-VARS-NOT-FREE (CHILD1 CHILD2 CHILD3)
+                                   (UPDATE-LAST-OP 'MY-COMPUTE MOM))))))
+  ACL2 !>
+  ~ev[]
+
+  If you try to evaluate a ~c[stobj-let] form directly in the top-level loop,
+  rather than from within a function body, you will get an error.  The example
+  above illustrates how ~c[stobj-let] may be used in function bodies; here is
+  another example, presented using an edited log.
   ~bv[]
     ACL2 !>(defstobj child fld)
 
@@ -26888,11 +27127,11 @@
   of a child stobj among the producer variables.  So for that ~c[stobj-let]
   form, there is no implicit extra step.
 
-  For the ~c[stobj-let] expansion displayed earlier above, we said it was
-  ``approximate'' for two reasons, which we give here informally.  (You can
-  apply ~c[:]~ilc[trans1] to the ~c[stobj-let] call above to see the formal
-  expansion.)  First, ~c[stobj-let] declares the stobj-let-bound variables to
-  be ~c[ignorable] for the top ~c[let] bindings.  Second, and more importantly,
+  We labeled a ~c[stobj-let] expansion above as ``approximate'' for two
+  reasons, which we give here informally.  (Now you know how to apply
+  ~c[:]~ilc[trans1] to that ~c[stobj-let] call to see the precise expansion.)
+  First, ~c[stobj-let] declares the stobj-let-bound variables to be
+  ~c[ignorable] for the top ~c[let] bindings.  Second, and more importantly,
   ~c[stobj-let] imposes the following restrictions on the producer and
   consumer, to avoid the aliasing problem: it disallows references to the
   parent stobj in the producer and it also disallows references to any bound
@@ -27127,14 +27366,17 @@
   function that returns nil, but has a ~il[guard] that its argument is an
   ~ilc[eqlable-listp] that satisfies ~ilc[no-duplicatesp].  Finally, ~c[FORM]
   is replaced by ~c[(PROGN$ CHK1 ... CHKn FORM)], where the ~c[CHKm] range over
-  all of the above ~c[ACCi-CHECK].~/~/"
+  all of the above ~c[ACCi-CHECK].~/~/")
 
+(defmacro stobj-let (&whole x &rest args)
   (declare (ignore args))
   #+acl2-loop-only
   (stobj-let-fn x)
   #-acl2-loop-only
   (stobj-let-fn-raw x))
 
+(link-doc-to stobj-let stobj nested-stobjs)
+
 (defun push-untouchable-fn (name fn-p state doc event-form)
 
 ; Warning: If this event ever generates proof obligations, remove it from the
@@ -30013,13 +30255,15 @@
 
 (defun pc-relieve-hyp (rune hyp unify-subst type-alist wrld state ens ttree)
 
-; This function is adapted from ACL2 function relieve-hyp, but it prevents
-; backchaining, instead returning the new hypotheses.  Notice that there are no
-; arguments for obj, equiv, fnstack, ancestors, or simplify-clause-pot-lst.
-; Also notice that rcnst has been replaced by ens (an enable structure).
-
-; We return t or nil indicating whether we won, an extended unify-subst
-; and a new ttree.  This function is a No-Change Loser.
+; This function is adapted from ACL2 function relieve-hyp, but without
+; rewriting.  Notice that there are no arguments for obj, equiv, fnstack,
+; ancestors, or simplify-clause-pot-lst.  Also notice that rcnst has been
+; replaced by ens (an enable structure).
+
+; We return t or nil indicating whether we won, an extended unify-subst and a
+; new ttree, with one exception: we can return (mv :unify-subst-list lst
+; new-ttree), where lst is a list of binding alists, as for relieve-hyp.  This
+; function is a No-Change Loser.
 
   (cond ((and (nvariablep hyp)
               (not (fquotep hyp))
@@ -30093,6 +30337,29 @@
                                (mv t unify-subst ttree)
                              (mv nil unify-subst ttree)))))))))))))))))))
 
+(mutual-recursion
+
+(defun pc-relieve-hyps1-iter (rune hyps unify-subst-lst unify-subst
+                                   unify-subst0 ttree0 type-alist
+                                   keep-unify-subst wrld state ens ttree)
+
+; This function is adapted from ACL2 function relieve-hyps1-iter.
+
+  (mv-let
+   (relieve-hyps1-ans unify-subst1 ttree1)
+   (pc-relieve-hyps1 rune hyps
+                     (extend-unify-subst (car unify-subst-lst) unify-subst)
+                     unify-subst0 ttree0 type-alist keep-unify-subst wrld state
+                                   ens ttree)
+   (cond ((or (endp (cdr unify-subst-lst))
+              relieve-hyps1-ans)
+          (mv relieve-hyps1-ans unify-subst1 ttree1))
+         (t (pc-relieve-hyps1-iter rune hyps
+                                   (cdr unify-subst-lst)
+                                   unify-subst unify-subst0 ttree0
+                                   type-alist keep-unify-subst wrld
+                                   state ens ttree)))))
+
 (defun pc-relieve-hyps1 (rune hyps unify-subst unify-subst0 ttree0 type-alist
                               keep-unify-subst wrld state ens ttree)
 
@@ -30113,25 +30380,36 @@
 
   (cond ((null hyps)
          (mv (not (eq keep-unify-subst :FAILED)) unify-subst ttree))
-        (t (mv-let (relieve-hyp-ans new-unify-subst ttree)
+        (t (mv-let
+            (relieve-hyp-ans new-unify-subst ttree)
 
 ; We avoid rewriting in this proof-checker code, so new-ttree = ttree.
 
-             (pc-relieve-hyp rune (car hyps) unify-subst type-alist wrld state
-                             ens ttree)
-             (cond
-              ((or relieve-hyp-ans keep-unify-subst)
-               (pc-relieve-hyps1 rune
-                                 (cdr hyps)
-                                 new-unify-subst
-                                 unify-subst0 ttree0
-                                 type-alist
-                                 (if (and (eq keep-unify-subst t)
-                                          (not relieve-hyp-ans))
-                                     :FAILED
-                                   keep-unify-subst)
-                                 wrld state ens ttree))
-              (t (mv nil unify-subst0 ttree0)))))))
+            (pc-relieve-hyp rune (car hyps) unify-subst type-alist wrld
+                            state ens ttree)
+            (cond
+             ((eq relieve-hyp-ans :unify-subst-list)
+
+; The hypothesis (car hyps) is a call of bind-free that has produced a list of
+; unify-substs.
+
+              (pc-relieve-hyps1-iter rune (cdr hyps)
+                                     new-unify-subst ; a list of alists
+                                     unify-subst unify-subst0 ttree0 type-alist
+                                     keep-unify-subst wrld state ens ttree))
+             ((or relieve-hyp-ans keep-unify-subst)
+              (pc-relieve-hyps1 rune
+                                (cdr hyps)
+                                new-unify-subst
+                                unify-subst0 ttree0
+                                type-alist
+                                (if (and (eq keep-unify-subst t)
+                                         (not relieve-hyp-ans))
+                                    :FAILED
+                                  keep-unify-subst)
+                                wrld state ens ttree))
+             (t (mv nil unify-subst0 ttree0)))))))
+)
 
 (defun pc-relieve-hyps (rune hyps unify-subst type-alist keep-unify-subst wrld
                              state ens ttree)
@@ -30879,10 +31157,10 @@
 ; loading of compiled files before corresponding event processing, which causes
 ; routine evaluation of add-include-book-dir and include-book in raw Lisp.
 
-; Therefore we maintain for raw Lisp a variant of the acl2-default-table's
+; Therefore we maintain for raw Lisp a variant of the acl2-defaults-table's
 ; include-book-dir-alist, namely state global 'raw-include-book-dir-alist.  The
 ; value of this variable is initially :ignore, meaning that we are to use the
-; acl2-default-table's include-book-dir-alist.  But when the value is not
+; acl2-defaults-table's include-book-dir-alist.  But when the value is not
 ; :ignore, then it is an alist that is used as the include-book-dir-alist.  We
 ; guarantee that every embedded event form that defines handling of :dir values
 ; for include-book does so in a manner that works when loading compiled files,
@@ -36107,7 +36385,7 @@
 ; reason to update that field.
 
   (init ; reset by :init
-   (get-internal-run-time) :type rational :read-only t)
+   (get-internal-time) :type rational :read-only t)
   (latest   ; reset by :init, :stop, and :start
    nil :type (or null rational))
   (elapsed  ; total time tracked, updated when updating Latest
@@ -36216,11 +36494,11 @@
                  (times (time-tracker-times tt))
                  (time (or min-time (car times))))
             (when time
-              (let* ((current-internal-run-time (get-internal-run-time))
+              (let* ((current-internal-time (get-internal-time))
                      (total (let ((latest (time-tracker-latest tt)))
                               (if latest
                                   (+ (time-tracker-elapsed tt)
-                                     (- current-internal-run-time latest))
+                                     (- current-internal-time latest))
                                 (time-tracker-elapsed tt)))))
                 (when (>= total time)
                   (let ((msg (or msg (time-tracker-msg tt))))
@@ -36258,7 +36536,7 @@
           tag))
      (t (setf (time-tracker-elapsed tt)
               (+ (time-tracker-elapsed tt)
-                 (- (get-internal-run-time) latest)))
+                 (- (get-internal-time) latest)))
         (setf (time-tracker-latest tt)
               nil)))))
 
@@ -36278,7 +36556,7 @@
            solve this problem.  See :DOC time-tracker."
           tag))
      (t (setf (time-tracker-latest tt)
-              (get-internal-run-time))))))
+              (get-internal-time))))))
 )
 
 ; We originally defined defund in axioms.lisp, but now that its definition
diff -Nru acl2-6.2/other-processes.lisp acl2-6.3/other-processes.lisp
--- acl2-6.2/other-processes.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/other-processes.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/other-releases.html acl2-6.3/other-releases.html
--- acl2-6.2/other-releases.html	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/other-releases.html	2013-09-29 21:41:28.000000000 +0000
@@ -6,13 +6,13 @@
 
 The current ACL2 release on the <a
 href="http://www.cs.utexas.edu/users/moore/acl2/index.html">ACL2 home page</a>
-is Version 6.2 (June, 2013).
+is Version 6.3 (October, 2013).
 
 <p>
 
 This page contains:
 <ul>
-<li><h2>Incremental releases since Version 6.2 (if any)</h2></li>
+<li><h2>Incremental releases since Version 6.3 (if any)</h2></li>
 <li><h2>Past releases</h2></li>
 </ul>
 
@@ -20,13 +20,14 @@
 
 <hr size=3 noshade>
 
-<h2><a name="incremental">Incremental releases since Version 6.2:</a></h2>
+<h2><a name="incremental">Incremental releases since Version 6.3:</a></h2>
 
 <i>None</i>
 
 <h2><a name="past">Past releases:</a></h2>
 
 <ul>
+<li><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-2/index.html">Version 6.2 (June, 2013)</a></li>
 <li><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-1/index.html">Version 6.1 (February, 2013)</a></li>
 <li><a href="http://www.cs.utexas.edu/users/moore/acl2/v6-0/index.html">Version 6.0 (December, 2012)</a></li>
 <li><a href="http://www.cs.utexas.edu/users/moore/acl2/v5-0/index.html">Version 5.0 (August, 2012)</a></li>
diff -Nru acl2-6.2/parallel-raw.lisp acl2-6.3/parallel-raw.lisp
--- acl2-6.2/parallel-raw.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/parallel-raw.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/parallel.lisp acl2-6.3/parallel.lisp
--- acl2-6.2/parallel.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/parallel.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -2266,7 +2266,7 @@
 ;               (cons (cons term rewritten-args)
 ;                     (cons-tag-trees ttree1 ttree2)))))))
 
-; Preliminary code for parallelizing the rewriter for ACL2 version 6.2.
+; Preliminary code for parallelizing the rewriter for ACL2 version 6.3.
 
 ; Note that the following code treats step-limits a little differently from how
 ; they are treated in the sequential version.  If we keep this treatment, we
diff -Nru acl2-6.2/proof-checker-a.lisp acl2-6.3/proof-checker-a.lisp
--- acl2-6.2/proof-checker-a.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/proof-checker-a.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -1704,11 +1704,11 @@
   ACL2 supports ~c[:instructions] as a hints keyword.  The following example
   forms the basis for our running example.  This example does not actually need
   hints, but imagine that the inductive step ~-[] which is \"Subgoal *1/2\"
-  ~-[] was proving difficult.  You could submit that goal to ~ilc[verify], do
-  an interactive proof, submit ~c[(exit t)] to obtain the list of
-  ~c[:instructions] (answering with `N' at the prompt, to complete the exit),
-  and then paste in those instructions.  When you submit the result event, you
-  might see the following.  Below we'll explain the hint processing.
+  ~-[] was difficult.  You could submit that goal to ~ilc[verify], do an
+  interactive proof, submit ~c[(exit t)] to obtain the list of
+  ~c[:instructions], and then paste in those instructions.  When you submit the
+  resulting event, you might see the following.  Below we'll explain the hint
+  processing.
   ~bv[]
   ACL2 !>(thm (equal (append (append x y) z)
                      (append x (append y z)))
@@ -1840,13 +1840,14 @@
   in the above output.  Normally one needs a trust tag (~pl[defttag]) to
   install a trusted clause-processor, but that is not the case for the built-in
   clause-processor, ~c[proof-checker-cl-proc].  Finally, we note that
-  ~c[:instructions] ~il[hints] are ``spliced'' in: the appropriate
-  ~c[:]~ilc[clause-processor] hint replaces the ~c[:instructions] hint, and the
-  other hints remain intact.  It may seems surprising that one can thus, for
-  example, use ~c[:instructions] and ~c[:in-theory] together; but although the
-  ~c[:in-theory] hint will have no effect on execution of the ~c[:instructions]
-  (see first bullet above), the ~c[:in-theory] hint will apply in the usual
-  manner to any child goes (~pl[hints-and-the-waterfall]).  End of Remark.
+  ~c[:instructions] ~il[hints] are ``spliced'' into the hints as follows: the
+  appropriate ~c[:]~ilc[clause-processor] hint replaces the ~c[:instructions]
+  hint, and the other hints remain intact.  It may seems surprising that one
+  can thus, for example, use ~c[:instructions] and ~c[:in-theory] together; but
+  although the ~c[:in-theory] hint will have no effect on execution of the
+  ~c[:instructions] (see first bullet above), the ~c[:in-theory] hint will
+  apply in the usual manner to any child goals (~pl[hints-and-the-waterfall]).
+  End of Remark.
 
   Now consider the case that the supplied instructions do not prove the goal.
   That is, suppose that the execution of those instructions results in a
@@ -1983,74 +1984,18 @@
                           (equal (reverse (reverse x)) x)))
   ->: bash
   ***** Now entering the theorem prover *****
-
-  [Note:  A hint was supplied for our processing of the goal above.
-  Thanks!]
-
-  This simplifies, using the :definition REVERSE and the :type-prescription
-  rule REVAPPEND, to
-
   Goal'
-  (IMPLIES (TRUE-LISTP X)
-           (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-                  X)).
-
-  But we have been asked to pretend that this goal is subsumed by the
-  yet-to-be-proved |PROOF-CHECKER Goal'|.
-
-  Q.E.D.
-
-
-  Creating one new goal:  (MAIN . 1).
-
-  The proof of the current goal, MAIN, has been completed.  However,
-  the following subgoals remain to be proved:
-    (MAIN . 1).
-  Now proving (MAIN . 1).
-  ->: th
-  *** Top-level hypotheses:
-  1. (TRUE-LISTP X)
-
-  The current subterm is:
-  (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-         X)
-  ->: 1
-  ->: sr ; show-rewrites
-
-  1. REVAPPEND-REVAPPEND (disabled)
-    New term: (REVAPPEND NIL (APPEND X NIL))
-    Hypotheses: <none>
-    Equiv: EQUAL
 
-  2. REVAPPEND
-    New term: (AND (CONSP (REVAPPEND X NIL))
-                   (REVAPPEND (CDR (REVAPPEND X NIL))
-                              (LIST (CAR (REVAPPEND X NIL)))))
-    Hypotheses: <none>
-    Equiv: EQUAL
-  ->: (r 1) ; rewrite with rule #1 above
-  Rewriting with REVAPPEND-REVAPPEND.
-  ->: exit
-  Exiting....
-   NIL
-  ACL2 !>(verify (implies (true-listp x)
-                          (equal (reverse (reverse x)) x)))
-  ->: bash
-  ***** Now entering the theorem prover *****
-
-  [Note:  A hint was supplied for our processing of the goal above.
-  Thanks!]
-
-  This simplifies, using the :definition REVERSE and the :type-prescription
-  rule REVAPPEND, to
+  ([ A key checkpoint:
 
   Goal'
   (IMPLIES (TRUE-LISTP X)
            (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
-                  X)).
+                  X))
 
-  But we have been asked to pretend that this goal is subsumed by the
-  yet-to-be-proved |PROOF-CHECKER Goal'|.
+  Goal' is subsumed by a goal yet to be proved.
+
+  ])
 
   Q.E.D.
 
@@ -2061,17 +2006,17 @@
   the following subgoals remain to be proved:
     (MAIN . 1).
   Now proving (MAIN . 1).
-  ->: th
+  ->: th ; show current goal (\"th\" for \"theorem\")
   *** Top-level hypotheses:
   1. (TRUE-LISTP X)
 
   The current subterm is:
   (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
          X)
-  ->: p
+  ->: p ; show current subterm only
   (EQUAL (REVAPPEND (REVAPPEND X NIL) NIL)
          X)
-  ->: 1
+  ->: 1 ; dive to first argument
   ->: p
   (REVAPPEND (REVAPPEND X NIL) NIL)
   ->: sr ; show-rewrites
@@ -2091,30 +2036,23 @@
   Rewriting with REVAPPEND-REVAPPEND.
   ->: p
   (REVAPPEND NIL (APPEND X NIL))
-  ->: top
+  ->: top ; move to the top of the conclusion, making it the current subterm
+  ->: p
+  (EQUAL (REVAPPEND NIL (APPEND X NIL)) X)
   ->: prove ; finish the proof
   ***** Now entering the theorem prover *****
 
-  But simplification reduces this to T, using the :definition REVAPPEND,
-  the :executable-counterpart of CONSP, primitive type reasoning and
-  the :rewrite rule APPEND-TO-NIL.
-
   Q.E.D.
 
   *!*!*!*!*!*!* All goals have been proved! *!*!*!*!*!*!*
   You may wish to exit.
-  ->: (exit t) ; to get :instructions; could give name, or (exit t nil t)
+  ->: (exit t) ; the argument, t, causes :instructions to be printed
   (DEFTHM T
           (IMPLIES (TRUE-LISTP X)
                    (EQUAL (REVERSE (REVERSE X)) X))
           :INSTRUCTIONS (:BASH (:DV 1)
                                (:REWRITE REVAPPEND-REVAPPEND)
                                :TOP :PROVE))
-
-  ACL2 Query (ACL2-PC::EXIT):
-  Do you want to submit this event?  Possible replies are:
-  Y (Yes), R (yes and Replay commands), N (No, but exit), A (Abort exiting).
-     (Y, R, N or A):  n
    NIL
   ACL2 !>(thm
           (IMPLIES (TRUE-LISTP X)
@@ -2124,18 +2062,18 @@
                    (:BASH (:DV 1)
                           (:REWRITE REVAPPEND-REVAPPEND)
                           :TOP :PROVE))))
+  Goal'
 
-  [Note:  A hint was supplied for our processing of the goal above.
-  Thanks!]
+  Q.E.D.
 
-  But the trusted :CLAUSE-PROCESSOR function PROOF-CHECKER-CL-PROC replaces
-  this goal by T.
+  Q.E.D.
 
   Q.E.D.
 
   Summary
   Form:  ( THM ...)
   Rules: NIL
+  Hint-events: ((:CLAUSE-PROCESSOR PROOF-CHECKER-CL-PROC))
   Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 
   Proof succeeded.
diff -Nru acl2-6.2/proof-checker-b.lisp acl2-6.3/proof-checker-b.lisp
--- acl2-6.2/proof-checker-b.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/proof-checker-b.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -396,6 +396,7 @@
   ~bv[]
   Examples:
   exit                        -- exit the interactive proof-checker
+  (exit t)                    -- exit after printing a bogus defthm event
   (exit append-associativity) -- exit and create a defthm
                                  event named append-associativity~/
 
@@ -403,8 +404,10 @@
 
   exit --  Exit without storing an event.
 
-  (exit event-name &optional rule-classes do-it-flg)
-  Exit, and store an event.
+  (exit t) -- Exit after printing a bogus defthm event, showing :INSTRUCTIONS.
+
+  (exit event-name &optional rule-classes do-it-flg) --
+  Exit, and perhaps store an event
   ~ev[]
   The command ~c[exit] returns you to the ACL2 loop.  At a later time,
   ~c[(verify)] may be executed to get back into the same proof-checker
@@ -468,87 +471,86 @@
                 (or event-name
                     (car event-name-and-types-and-raw-term)))
                (instructions (instructions-of-state-stack state-stack nil)))
-          (er-let*
-           ((event-name
-             (if event-name
-                 (value event-name)
-               (pprogn (io? proof-checker nil state
-                            nil
-                            (fms0 "Please supply an event name (or :A to ~
+          (er-let* ((event-name
+                     (if event-name
+                         (value event-name)
+                       (pprogn (io? proof-checker nil state
+                                    nil
+                                    (fms0 "Please supply an event name (or :A to ~
                                    abort)~%>> "))
-                       (state-global-let*
-                        ((infixp nil))
-                        (read-object *standard-oi* state))))))
-           (if (eq event-name :a)
-               (pprogn (io? proof-checker nil state
-                            nil
-                            (fms0 "~|Exit aborted.~%"))
-                       (mv nil nil state))
-             (if (null (goals t))
-                 (let* ((rule-classes (if (consp (cdr args))
-                                          rule-classes
-                                        (if (and (consp args)
-                                                 (eq (car args) nil))
-                                            (cadr event-name-and-types-and-raw-term)
-                                          '(:rewrite))))
-                        (event-form `(defthm ,event-name
-                                       ,(caddr event-name-and-types-and-raw-term)
-                                       ,@(if (equal rule-classes '(:rewrite))
-                                             nil
-                                           (list :rule-classes rule-classes))
-                                       :instructions ,instructions)))
-                   (mv-let (erp stobjs-out/vals state)
-                           (pprogn
-                            (print-pc-defthm event-form state)
-                            (mv-let (erp ans state)
-                                    (if do-it-flg
-                                        (value :y)
-                                      (replay-query state))
-                                    (declare (ignore erp))
-                                    (case ans
-                                          (:y (trans-eval event-form
-                                                          'acl2-pc::exit
-                                                          state
-                                                          t))
-                                          (:r (pprogn (state-from-instructions
-                                                       (caddr event-form)
-                                                       event-name
-                                                       rule-classes
-                                                       instructions
-                                                       '(signal value)
-                                                       state)
-                                                      (trans-eval event-form
-                                                                  'acl2-pc::exit
-                                                                  state
-                                                                  t)))
-                                          (:a (mv t '(nil . t) state))
-                                          (otherwise (mv t '(nil . nil) state)))))
+                               (state-global-let*
+                                ((infixp nil))
+                                (read-object *standard-oi* state))))))
+            (if (eq event-name :a)
+                (pprogn (io? proof-checker nil state
+                             nil
+                             (fms0 "~|Exit aborted.~%"))
+                        (mv nil nil state))
+              (if (null (goals t))
+                  (let* ((rule-classes (if (consp (cdr args))
+                                           rule-classes
+                                         (if (and (consp args)
+                                                  (eq (car args) nil))
+                                             (cadr event-name-and-types-and-raw-term)
+                                           '(:rewrite))))
+                         (event-form `(defthm ,event-name
+                                        ,(caddr event-name-and-types-and-raw-term)
+                                        ,@(if (equal rule-classes '(:rewrite))
+                                              nil
+                                            (list :rule-classes rule-classes))
+                                        :instructions ,instructions)))
+                    (mv-let (erp stobjs-out/vals state)
+                            (pprogn
+                             (print-pc-defthm event-form state)
+                             (mv-let (erp ans state)
+                                     (cond (do-it-flg (value :y))
+                                           ((eq event-name t) (value :n))
+                                           (t (replay-query state)))
+                                     (declare (ignore erp))
+                                     (case ans
+                                       (:y (trans-eval event-form
+                                                       'acl2-pc::exit
+                                                       state
+                                                       t))
+                                       (:r (pprogn (state-from-instructions
+                                                    (caddr event-form)
+                                                    event-name
+                                                    rule-classes
+                                                    instructions
+                                                    '(signal value)
+                                                    state)
+                                                   (trans-eval event-form
+                                                               'acl2-pc::exit
+                                                               state
+                                                               t)))
+                                       (:a (mv t '(nil . t) state))
+                                       (otherwise (mv t '(nil . nil) state)))))
 
 ; We assume here that if DEFTHM returns without error, then it succeeds.
 
-                           (if (or erp (null (car stobjs-out/vals)))
-                               (if (eq (cdr stobjs-out/vals) t)
-                                   (pprogn (io? proof-checker nil state
-                                                nil
-                                                (fms0 "~|Exit aborted.~%"))
-                                           (mv nil nil state))
-                                 (mv *pc-complete-signal* nil state))
-                             (mv *pc-complete-signal* event-name state))))
+                            (if (or erp (null (car stobjs-out/vals)))
+                                (if (eq (cdr stobjs-out/vals) t)
+                                    (pprogn (io? proof-checker nil state
+                                                 nil
+                                                 (fms0 "~|Exit aborted.~%"))
+                                            (mv nil nil state))
+                                  (mv *pc-complete-signal* nil state))
+                              (mv *pc-complete-signal* event-name state))))
 
 ; Otherwise, we have an incomplete proof.
 
-               (pprogn (io? proof-checker nil state
-                            (instructions event-name-and-types-and-raw-term
-                                          state-stack)
-                            (fms0 "~%Not exiting, as there remain unproved ~
+                (pprogn (io? proof-checker nil state
+                             (instructions event-name-and-types-and-raw-term
+                                           state-stack)
+                             (fms0 "~%Not exiting, as there remain unproved ~
                                    goals:  ~&0.~%The original goal is:~%~ ~ ~ ~
                                    ~ ~y1~|  Here is the current instruction ~
                                    list, starting with the first:~%~ ~ ~ ~ ~
                                    ~y2~|"
-                                  (list (cons #\0 (goal-names (goals t)))
-                                        (cons #\1 (caddr event-name-and-types-and-raw-term))
-                                        (cons #\2 instructions))))
-                       (mv nil nil state))))))
+                                   (list (cons #\0 (goal-names (goals t)))
+                                         (cons #\1 (caddr event-name-and-types-and-raw-term))
+                                         (cons #\2 instructions))))
+                        (mv nil nil state))))))
       (pprogn (io? proof-checker nil state
                    nil
                    (fms0 "~|Exiting....~%"))
@@ -4760,7 +4762,11 @@
   will do so in both the ~c[show-rewrites] (~c[sr]) and ~c[rewrite] commands.
   But normally, if even one hypothesis remains unrelieved, then no automatic
   extension of the substitution is made.  Except, if ~c[instantiate-free] is
-  not ~c[nil], then that extension to the substitution is kept.
+  not ~c[nil], then that extension to the substitution is kept.  (Technical
+  note: in the case of an unrelieved hypothesis and a non-~c[nil] value of
+  ~c[instantiate-free], if a ~ilc[bind-free] hypothesis produces a list of
+  binding alists, then the last of those alists is the one that is used to
+  extend the substitution.)
 
   Finally, the instruction is applied as follows.  The current subterm is
   replaced by applying the final substitution described above to the right-hand
diff -Nru acl2-6.2/proof-checker-pkg.lisp acl2-6.3/proof-checker-pkg.lisp
--- acl2-6.2/proof-checker-pkg.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/proof-checker-pkg.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/prove.lisp acl2-6.3/prove.lisp
--- acl2-6.2/prove.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/prove.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -521,6 +521,28 @@
 ; return four values: the new step-limit, wonp, the new term, and a new ttree.
 ; This fn is a No-Change Loser.
 
+; Note that preprocess-clause calls expand-abbreviations; but also
+; preprocess-clause calls clausify-input, which calls expand-and-or, which
+; calls expand-abbreviations.  But this is not redundant, as expand-and-or
+; calls expand-abbreviations after expanding function definitions and using
+; rewrite rules when the result is a conjunction or disjunction (depending on
+; bool) -- even when the rule being applied is not an abbreviation rule.  Below
+; are event sequences that illustrate this extra work being done.  In both
+; cases, evaluation of (getprop 'foo 'lemmas nil 'current-acl2-world (w state))
+; shows that we are expanding with a rewrite-rule structure that is not of
+; subclass 'abbreviation.
+
+; (defstub bar (x) t)
+; (defun foo (x) (and (bar (car x)) (bar (cdr x))))
+; (trace$ expand-and-or expand-abbreviations clausify-input preprocess-clause)
+; (thm (foo x) :hints (("Goal" :do-not-induct :otf)))
+
+; (defstub bar (x) t)
+; (defstub foo (x) t)
+; (defaxiom foo-open (equal (foo x) (and (bar (car x)) (bar (cdr x)))))
+; (trace$ expand-and-or expand-abbreviations clausify-input preprocess-clause)
+; (thm (foo x) :hints (("Goal" :do-not-induct :otf)))
+
   (cond ((variablep term) (mv step-limit nil term ttree))
         ((fquotep term) (mv step-limit nil term ttree))
         ((member-equal (ffn-symb term) fns-to-be-ignored-by-rewrite)
@@ -1980,6 +2002,13 @@
            (subsetp-equal (car cl-set1) (car cl-set2)))
       (clause-set-subsumes-1 init-subsumes-count cl-set1 cl-set2 t)))
 
+(defun preprocess-clause? (cl hist pspv wrld state step-limit)
+  (cond ((member-eq 'preprocess-clause
+                    (assoc-eq :do-not (access prove-spec-var pspv
+                                              :hint-settings)))
+         (mv step-limit 'miss nil nil nil))
+        (t (preprocess-clause cl hist pspv wrld state step-limit))))
+
 (defun apply-use-hint-clauses (temp clauses pspv wrld state step-limit)
 
 ; Note: There is no apply-use-hint-clause.  We just call this function
@@ -2049,7 +2078,7 @@
      (t
       (sl-let
        (signal C ttree irrel-pspv)
-       (preprocess-clause constraint-cl nil pspv wrld state step-limit)
+       (preprocess-clause? constraint-cl nil pspv wrld state step-limit)
        (declare (ignore irrel-pspv))
        (cond
         ((eq signal 'miss)
@@ -2354,7 +2383,6 @@
                use-pspv)))))))
     (:by
 
-
 ; If there is a :by hint then it is of one of the two forms (:by .  name) or
 ; (:by lmi-lst thm constraint-cl k event-names new-entries).  The first form
 ; indicates that we are to give this clause a bye and let the proof fail late.
@@ -2411,13 +2439,17 @@
 ; WARNING: See the warning about the processing in translate-by-hint.
 
          (let* ((cl (remove-guard-holders-lst cl))
+                (cl (remove-equal *nil* cl))
                 (easy-winp
-                 (if (and cl (null (cdr cl)))
-                     (equal (car cl) thm)
-                   (equal thm
-                          (implicate
-                           (conjoin (dumb-negate-lit-lst (butlast cl 1)))
-                           (car (last cl))))))
+                 (cond ((null cl) ; very weird case!
+                        (equal thm *nil*))
+                       ((null (cdr cl))
+                        (equal (car cl) thm))
+                       (t
+                        (equal thm
+                               (implicate
+                                (conjoin (dumb-negate-lit-lst (butlast cl 1)))
+                                (car (last cl)))))))
                 (cl1 (if (and (not easy-winp)
                               (ffnnamep-lst 'implies cl))
                          (expand-some-non-rec-fns-lst '(implies) cl wrld)
@@ -2493,8 +2525,8 @@
 ; was copied from that historically older code.
 
              (sl-let (signal clauses ttree irrel-pspv)
-                     (preprocess-clause constraint-cl nil pspv wrld
-                                        state step-limit)
+                     (preprocess-clause? constraint-cl nil pspv wrld
+                                         state step-limit)
                      (declare (ignore irrel-pspv))
                      (cond ((eq signal 'miss)
                             (mv step-limit
@@ -2555,8 +2587,8 @@
 ; leave this code here in case we change our minds on that.
 
                         (if (eq subsumes '?)
-                            " because our subsumption heuristics were ~
-                                   unable to decide the question"
+                            " because our subsumption heuristics were unable ~
+                             to decide the question"
                           "")
                         (untranslate thm t wrld)
                         (prettyify-clause-set cl-set
@@ -5486,32 +5518,24 @@
 ; We accumulate the modified ttree into state.
 
   (declare (ignorable cl-id step-limit state))
-  (let ((ttree (set-cl-ids-of-assumptions (cond ((cdr clauses) ttree)
-                                                (t (remove-tag-from-tag-tree
-                                                    'splitter-if-intro
-                                                    ttree)))
-                                          cl-id)))
+  (let ((ttree (set-cl-ids-of-assumptions ttree cl-id)))
 
 ; We extract the assumptions we are to handle immediately.
 
-   (mv-let
-    (n assumed-terms pairs ttree)
-    (extract-and-clausify-assumptions
-     clause
-     ttree
-     'non-nil ; collect CASE-SPLIT and immediate FORCE assumptions
-     (access rewrite-constant
-             (access prove-spec-var new-pspv :rewrite-constant)
-             :current-enabled-structure)
-     wrld
-     (access rewrite-constant
-             (access prove-spec-var new-pspv :rewrite-constant)
-             :splitter-output))
-    (declare (ignore n))
-    (mv-let@par
-     (erp ttree state)
-     (accumulate-ttree-and-step-limit-into-state@par ttree step-limit state)
-     (declare (ignore erp))
+    (mv-let
+     (n assumed-terms pairs ttree)
+     (extract-and-clausify-assumptions
+      clause
+      ttree
+      'non-nil ; collect CASE-SPLIT and immediate FORCE assumptions
+      (access rewrite-constant
+              (access prove-spec-var new-pspv :rewrite-constant)
+              :current-enabled-structure)
+      wrld
+      (access rewrite-constant
+              (access prove-spec-var new-pspv :rewrite-constant)
+              :splitter-output))
+     (declare (ignore n))
 
 ; Note below that we throw away the cars of the pairs, which are
 ; typically assumnotes.  We keep only the clauses themselves.
@@ -5532,6 +5556,9 @@
                               (dumb-negate-lit-lst assumed-terms)
                               clauses))
                 wrld)))
+            (ttree (cond ((cdr clauses) ttree)
+                         (t (remove-tag-from-tag-tree 'splitter-if-intro
+                                                      ttree))))
 
 ; We create the history entry for this step.  We have to be careful about
 ; specious hits to prevent a loop described below.
@@ -5595,26 +5622,31 @@
                          :cl-id ; only needed for #+acl2-par, but harmless
                          cl-id)
                    hist)))
-       (cond
-        ((consp (access history-entry ; (SPECIOUS . processor)
-                        (car new-hist) :processor))
-         (mv@par 'MISS nil ttree new-hist
-                 (accumulate-rw-cache-into-pspv processor ttree pspv)
-                 state))
-        (t (mv@par signal clauses ttree new-hist
-                   (cond
-                    ((or (member-eq processor *simplify-clause-ledge-complement*)
-                         (eq processor 'settled-down-clause))
-                     (put-ttree-into-pspv ttree new-pspv))
-                    ((eq processor 'simplify-clause)
-                     (put-ttree-into-pspv ttree
-                                          (maybe-set-rw-cache-state-enabled
-                                           new-pspv)))
-                    (t
-                     (put-ttree-into-pspv (erase-rw-cache ttree)
-                                          (maybe-set-rw-cache-state-disabled
-                                           (erase-rw-cache-from-pspv new-pspv)))))
-                   state))))))))
+       (mv-let@par
+        (erp ttree state)
+        (accumulate-ttree-and-step-limit-into-state@par ttree step-limit state)
+        (declare (ignore erp))
+
+        (cond
+         ((consp (access history-entry ; (SPECIOUS . processor)
+                         (car new-hist) :processor))
+          (mv@par 'MISS nil ttree new-hist
+                  (accumulate-rw-cache-into-pspv processor ttree pspv)
+                  state))
+         (t (mv@par signal clauses ttree new-hist
+                    (cond
+                     ((or (member-eq processor *simplify-clause-ledge-complement*)
+                          (eq processor 'settled-down-clause))
+                      (put-ttree-into-pspv ttree new-pspv))
+                     ((eq processor 'simplify-clause)
+                      (put-ttree-into-pspv ttree
+                                           (maybe-set-rw-cache-state-enabled
+                                            new-pspv)))
+                     (t
+                      (put-ttree-into-pspv (erase-rw-cache ttree)
+                                           (maybe-set-rw-cache-state-disabled
+                                            (erase-rw-cache-from-pspv new-pspv)))))
+                    state))))))))
 
 (defun@par waterfall-step (processor cl-id clause hist pspv wrld ctx state
                                      step-limit)
@@ -9836,8 +9868,8 @@
 
 (defun prove-loop0 (clauses pspv hints ens wrld ctx state)
 
-; Warning: Because this function binds in-prove-flg to t, it should be called
-; only when *acl2-time-limit* has been let-bound.
+; Warning: This function assumes that *acl2-time-limit* has already been
+; let-bound in raw Lisp by bind-acl2-time-limit.
 
 ; The perhaps unusual structure below is intended to invoke
 ; print-pstack-and-gag-state only when there is a hard error such as an
diff -Nru acl2-6.2/rewrite.lisp acl2-6.3/rewrite.lisp
--- acl2-6.2/rewrite.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/rewrite.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -7089,7 +7089,7 @@
 ;     brr-wormhole is thus (:key data), where data is the alist mapping
 ;     brr-globals to their values as described below
 ; (1) brr-wormhole implements brr-global variables which are set
-;     from input-alist (or else retain their values from the the
+;     from input-alist (or else retain their values from the
 ;     last exit of the 'brr wormhole).
 ; (2) test-form returns (value t) or (value nil) indicating whether
 ;     a break is to occur.
@@ -7103,6 +7103,7 @@
              ,input-alist
              `(pprogn (restore-brr-globals state)
                       (er-progn
+                       (set-ld-keyword-aliases! ,,aliases)
                        (set-ld-prompt 'brr-prompt state)
 
 ; The above reference to the function symbol brr-prompt is a little startling
@@ -7120,7 +7121,6 @@
                                            (value :invisible)))
                                 (t (exit-brr-wormhole state))))))
              :ld-prompt  nil
-             :ld-keyword-aliases ,aliases
              :ld-missing-input-ok nil
              :ld-pre-eval-filter :all
              :ld-pre-eval-print  nil
@@ -7685,25 +7685,23 @@
 
   Break-rewrite permits the user to inspect the current ~il[state] by
   evaluating break-rewrite commands.  Type ~c[:]~ilc[help] in break-rewrite to
-  see what the break-rewrite commands are.  However, break-rewrite is
-  actually just a call of the general ACL2 read-eval-print loop, ~ilc[ld],
-  on a certain ~il[state] and the break-rewrite commands are simply aliases
-  provided by the ~ilc[ld]-special ~ilc[ld-keyword-aliases].  ~l[ld] for
-  details about this read-eval-print loop.  Thus, with a few
-  exceptions, anything you can do at the ACL2 top-level can be done
-  within break-rewrite.  For example, you can evaluate arbitrary
-  expressions, use the keyword command hack, access ~il[documentation],
-  print ~il[events], and even define functions and prove theorems.
-  However, the ``certain ~il[state]'' upon which ~ilc[ld] was called is a
-  ``~il[wormhole] ~il[state]'' (~pl[wormhole]) because break-rewrite is not
-  allowed to have any effect upon the behavior of rewrite.  What this
-  means, very roughly but understandably, is that break-rewrite
+  see what the break-rewrite commands are.  However, break-rewrite is actually
+  just a call of the general ACL2 read-eval-print loop, ~ilc[ld], on a certain
+  ~il[state] and the break-rewrite commands are simply aliases provided by
+  ~c[ld-keyword-aliases] ~il[table] (~pl[ld-keyword-aliases]).  ~l[ld] for
+  details about this read-eval-print loop.  Thus, with a few exceptions,
+  anything you can do at the ACL2 top-level can be done within break-rewrite.
+  For example, you can evaluate arbitrary expressions, use the keyword command
+  hack, access ~il[documentation], print ~il[events], and even define functions
+  and prove theorems.  However, the ``certain ~il[state]'' upon which ~ilc[ld]
+  was called is a ``~il[wormhole] ~il[state]'' (~pl[wormhole]) because
+  break-rewrite is not allowed to have any effect upon the behavior of rewrite.
+  What this means, very roughly but understandably, is that break-rewrite
   operates on a copy of the ~il[state] being used by rewrite and when
   break-rewrite exits the ~il[wormhole] closes and the ~il[state] ``produced''
-  by break-rewrite disappears.  Thus, break-rewrite lets you query the
-  state of the rewriter and even do experiments involving proofs,
-  etc., but these experiments have no effect on the ongoing proof
-  attempt.  In particular:
+  by break-rewrite disappears.  Thus, break-rewrite lets you query the state of
+  the rewriter and even do experiments involving proofs, etc., but these
+  experiments have no effect on the ongoing proof attempt.  In particular:
 
   Note that the output from break-rewrite is sometimes abbreviated by default,
   such as for the term causing the break.  This can be controlled by setting
@@ -8042,18 +8040,19 @@
   utility for watching the activity of the rewriter and some other proof
   processes, in real time.  This utility is called ``dmr'', which is an acronym
   for ``dynamically monitor rewrites''.  The utility comes in two parts: an
-  ACL2 component that frequently writes a file (the ``dmr file'') containing
-  the relevant information, and an Emacs component that frequently displays the
-  contents of that file in an Emacs buffer (the ``dmr buffer'').  Other editors
-  could, in principle, be programmed to display that file; anyone developing
-  such a capability is invited to contribute it to the ACL2 community.
+  ACL2 component that frequently updates a file (the ``dmr file'') containing
+  the relevant information, and an Emacs component that frequently updates the
+  an Emacs buffer (the ``dmr buffer'') with the contents of that file.  Other
+  editors could, in principle, be programmed to display that file; anyone
+  developing such a capability is invited to contribute it to the ACL2
+  community.
 
   The dmr utility can be extremely helpful for expensive proofs, especially
-  when ACL2 is not providing any output.  The ~il[break-rewrite] and
-  ~ilc[accumulated-persistence] utilities may be a bit easier to use, so you
-  might want to try those first.  But the dmr utility can be a very helpful
-  debugging aide, as it can visually give you a sense of where ACL2 is spending
-  its time.
+  when ACL2 is not providing any output to the terminal.  The
+  ~il[break-rewrite] and ~ilc[accumulated-persistence] utilities may be a bit
+  easier to use, so you might want to try those first.  But the dmr utility can
+  be a very helpful debugging aide, as it can visually give you a sense of
+  where ACL2 is spending its time.
 
   The Emacs portion of this utility is already loaded if you load the
   distributed Emacs file ~c[emacs/emacs-acl2.el].  Otherwise, invoke the
@@ -8182,8 +8181,13 @@
   In order to update the dmr file with the latest stack information, interrupt
   ACL2 and then evaluate: ~c[(dmr-flush)].  In order to support resumption of
   the interrupted proof (assuming your host Common Lisp supports resumption),
-  evaluation of ~c[(dmr-start)] automatically causes evaluation of the form
-  ~c[(set-debugger-enable t)]; ~pl[set-debugger-enable].
+  evaluation of ~c[(dmr-start)] will automatically enable the debugger if it is
+  not already enabled and not fully disabled with value
+  ~c[:never] (~pl[set-debugger-enable]).  If such automatic enabling takes
+  place, then ~c[(dmr-stop)] will restore the old setting of the debugger
+  unless, after ~c[(dmr-start)] enables the debugger but before ~c[(dmr-stop)]
+  is called, you call ~ilc[set-debugger-enable] (or more precisely: function
+  ~c[set-debugger-enable-fn] is called).
 
   Note for users of the experimental extension ACL2(p) (~pl[parallelism]): when
   waterfall-parallelism has been set to a non-~c[nil] value
@@ -9239,26 +9243,40 @@
                 (t nil)))
         (bad-synp-alist1 (cdr alist) unify-subst vars-to-be-bound wrld))))
 
-(defun bad-synp-alist (alist unify-subst vars-to-be-bound wrld)
+(defun bad-synp-alist1-lst (alist-lst unify-subst vars-to-be-bound wrld)
+  (cond
+   ((endp alist-lst) nil)
+   (t (or (bad-synp-alist1 (car alist-lst) unify-subst vars-to-be-bound wrld)
+          (bad-synp-alist1-lst (cdr alist-lst) unify-subst vars-to-be-bound
+                               wrld)))))
+
+(defun bind-free-info (x unify-subst vars-to-be-bound wrld)
+
+; X is a value returned by a bind-free synp hypothesis, known not to be t or
+; nil; unify-subst is an alist containing the unifying substitution gathered so
+; far; and vars-to-be-bound is either t or a quoted list of variables.  We
+; check that alist is indeed an alist, that it does not bind any variables
+; already bound in unify-subst, and that it only binds variables to ACL2 terms.
+; If vars-to-be-bound is anything other than t, we also require that alist only
+; binds vars present in vars-to-be-bound.
 
-; Alist is the (non-nil non-t) value returned by a synp hypothesis,
-; Unify-subst is an alist containing the unifying substitution
-; gathered so far, and vars-to-be-bound is either t or a quoted list
-; of variables.  We check that alist is indeed an alist, that it does
-; not bind any variables already bound in unify-subst, and that it
-; only binds variables to ACL2 terms.  If vars-to-be-bound is anything
-; other than t, we also require that alist only binds vars present in
-; vars-to-be-bound.
+; We return nil if x is a legal alist, t if x is a legal list of alists, and
+; otherwise a string or message suitable for printing with ~@.
 
-; We return nil if the alist is legal, else a string or message suitable for
-; printing with ~@.
-
-  (if (alistp alist)
-      (bad-synp-alist1 alist
-                       unify-subst
-                       (get-evg vars-to-be-bound 'bad-synp-alist)
-                       wrld)
-    "it is not an alist"))
+  (cond
+   ((and (true-listp x)
+         (alistp (car x)))
+    (or (bad-synp-alist1-lst x
+                             unify-subst
+                             (get-evg vars-to-be-bound 'bad-synp-alist)
+                             wrld)
+        t))
+   ((alistp x)
+    (bad-synp-alist1 x
+                     unify-subst
+                     (get-evg vars-to-be-bound 'bad-synp-alist)
+                     wrld))
+   (t "it is not an alist")))
 
 (defun evgs-or-t (lst alist)
 
@@ -10629,7 +10647,8 @@
             (reconcile-terms (cdr terms) (cdr exts))))))
 
 (defun all-equal (x lst)
-  (cond ((endp lst) t)
+  (declare (xargs :guard t))
+  (cond ((atom lst) t)
         (t (and (equal x (car lst))
                 (all-equal x (cdr lst))))))
 
@@ -12128,14 +12147,24 @@
          (set-difference-assoc-eq (cdr lst) alist))
         (t (cons (car lst) (set-difference-assoc-eq (cdr lst) alist)))))
 
+(defun extend-unify-subst (alist unify-subst)
+
+; We attempt to keep all terms in quote-normal form, which explains the
+; modification of val just below.
+
+  (append (pairlis$ (strip-cars alist)
+                    (sublis-var-lst nil (strip-cdrs alist)))
+          unify-subst))
+
 (defun relieve-hyp-synp (rune hyp0 unify-subst rdepth type-alist wrld state
                               fnstack ancestors backchain-limit
                               simplify-clause-pot-lst rcnst gstack ttree bkptr)
 
 ; Hyp0 is a call of synp.  This special case of relieve-hyp returns some of the
-; same values as does relieve-hyp, namely:
+; same values as does relieve-hyp, namely the following
+; where wonp is t, nil, or :unify-subst-list:
 
-; (mv wonp failure-reason unify-subst' ttree''),
+; (mv wonp failure-reason unify-subst' ttree'')
 
   (let* ((synp-fn (car (get-evg (fargn hyp0 2) 'relieve-hyp)))
          (mfc (if (member-eq 'state (all-vars (get-evg (fargn hyp0 3)
@@ -12214,30 +12243,29 @@
                         rune
                         val)
                     nil unify-subst ttree))))
-             ((bad-synp-alist val unify-subst (fargn hyp0 1) wrld)
-              (mv (er hard 'relieve-hyp
-                      "The evaluation of the BIND-FREE form in hypothesis ~p0 ~
-                       of rule ~x1 produced the result ~x2, which is illegal ~
-                       because ~@3."
-                      (untranslate hyp0 t wrld)
-                      rune
-                      val
-                      (bad-synp-alist val unify-subst (fargn hyp0 1) wrld))
-                  nil unify-subst ttree))
-             (t
-              (mv t nil
-
-; We attempt to keep all terms in quote-normal form, which explains the
-; modification of val just below.
-
-                  (append (pairlis$ (strip-cars val)
-                                    (sublis-var-lst nil (strip-cdrs val)))
-                          unify-subst)
-
-; See comment for call of push-lemma above, for why we do not include the
-; executable-counterparts of functions in the term just evaluated.
-
-                  (push-lemma (fn-rune-nume 'synp nil nil wrld) ttree)))))))
+             (t (let ((info (bind-free-info val unify-subst (fargn hyp0 1)
+                                            wrld)))
+                  (cond
+                   ((eq info nil)
+                    (mv t nil
+                        (extend-unify-subst val unify-subst)
+                        (push-lemma
+                         (fn-rune-nume 'synp nil nil wrld) ; see comment above
+                         ttree)))
+                   ((eq info t)
+                    (mv :unify-subst-list nil
+                        val ; a list of alists with which to extend unify-subst
+                        (push-lemma
+                         (fn-rune-nume 'synp nil nil wrld) ; see comment above
+                         ttree)))
+                   (t
+                    (mv (er hard 'relieve-hyp
+                            "The evaluation of the BIND-FREE form in ~
+                             hypothesis ~p0 of rule ~x1 produced the result ~
+                             ~x2, which is illegal because ~@3."
+                            (untranslate hyp0 t wrld)
+                            rune val info)
+                        nil unify-subst ttree)))))))))
 
 (defun push-lemma? (rune ttree)
   (if rune
@@ -13598,30 +13626,47 @@
 
   make some ~c[:rewrite] rules (possibly conditional ones)~/
 
+  ~l[rule-classes] for a general discussion of rule classes, including how they
+  are used to build rules from formulas and a discussion of the various
+  keywords in a rule class description.
+
   This doc topic discusses the rule-class ~c[:rewrite].  If you want a general
   discussion of how rewriting works in ACL2 and some guidance on how to
   construct effective rewrite rules, ~pl[introduction-to-rewrite-rules-part-1]
   and then ~pl[introduction-to-rewrite-rules-part-2].
 
-  ~l[rule-classes] for a general discussion of rule classes and
-  how they are used to build rules from formulas.  Example ~c[:]~ilc[corollary]
-  formulas from which ~c[:rewrite] rules might be built are:
   ~bv[]
-  Example:
-  (equal (+ x y) (+ y x))            replace (+ a b) by (+ b a) provided
-                                     certain heuristics approve the
-                                     permutation.
-
-  (implies (true-listp x)            replace (append a nil) by a, if
-           (equal (append x nil) x)) (true-listp a) rewrites to t
-
-  (implies                           replace (member a (append b c)) by
-      (and (eqlablep e)              (member a (append c b)) in contexts
-           (true-listp x)            in which propositional equivalence
-           (true-listp y))           is sufficient, provided (eqlablep a)
-      (iff (member e (append x y))   (true-listp b) and (true-listp c)
-           (member e (append y x)))) rewrite to t and the permutative
-                                     heuristics approve~/
+  Examples:
+
+  (defthm plus-commutes                 ; Replace (+ a b) by (+ b a) provided
+    (equal (+ x y) (+ y x)))            ; certain heuristics approve the
+                                        ; permutation.
+
+  (defthm plus-commutes                 ; equivalent to the above
+    (equal (+ x y) (+ y x))
+    :rule-classes ((:rewrite :corollary (equal (+ x y) (+ y x))
+                             :loop-stopper ((x y binary-+))
+                             :match-free :all)))
+
+  (defthm append-nil                    ; Replace (append a nil) by a, if
+    (implies (true-listp x)             ; (true-listp a) rewrites to t.
+             (equal (append x nil) x)))
+
+  (defthm append-nil                    ; as above, but with defaults and
+    (implies (true-listp x)             ; a backchain limit
+             (equal (append x nil) x))
+    :rule-classes ((:rewrite :corollary (implies (true-listp x)
+                                                 (equal (append x nil) x))
+                             :backchain-limit-lst (3) ; or equivalently, 3
+                             :match-free :all)))
+
+  (defthm member-append                 ; Replace (member e (append b c)) by
+    (implies                            ; (or (member e b) (member e c) in
+     (and                               ; contexts in which propositional
+      (true-listp x)                    ; equivalence is sufficient, provided
+      (true-listp y))                   ; b and c are true-lists.
+     (iff (member e (append x y))
+          (or (member e x) (member e y)))))~/
 
   General Form:
   (and ...
@@ -14810,24 +14855,27 @@
 ; We return six results.  Most often they are interpreted as indicated by the
 ; names:
 
-; (mv step-limit wonp failure-reason unify-subst' ttree' memo'),
-
-; but there is a special case where they are interpreted differently.  In
-; general, wonp is t, nil or a term.  If it is t or nil, the interpretation of
-; the results is as hinted above: Wonp indicates whether hyp0 was relieved,
-; failure-reason is nil or else a token indicating why we failed, and the rest
-; are extended versions of the corresponding inputs.
+; (mv step-limit wonp failure-reason unify-subst' ttree' memo').
 
-; But if wonp is a term then it means that hyp0 contains free-vars, it was not
-; relieved, and the six results are to be interpreted as:
+; Here wonp is t, nil, :unify-subst-list, or a term.  If it is t, nil, or
+; :unify-subst-list, then interpretation of the results is as hinted above:
+; wonp indicates whether hyp0 was relieved, failure-reason is nil or else a
+; token indicating why we failed, and the rest are extended versions of the
+; corresponding inputs except for the case :unify-subst-list, where
+; unify-subst' is actually a list of unifying substitutions, each of which is
+; sufficient for relieving the remaining hypotheses.
+
+; But there is a special case where they are interpreted quite differently: if
+; wonp is a term then it means that hyp0 contains free-vars, it was not
+; relieved, and the six results are to be interpreted as follows,
+; where the last three are unchanged.
 
 ; (mv step-limit term typ unify-subst ttree memo)
 
-; where the last three are unchanged.  This signals that the caller of
-; relieve-hyp is responsible for relieving the hypothesis and may do so in
-; either of two ways: Extend unify-subst to make term have typ in the original
-; type-alist or extend unify-subst to make hyp0 true via ground units.  This is
-; called the SPECIAL CASE.
+; This signals that the caller of relieve-hyp is responsible for relieving the
+; hypothesis and may do so in either of two ways: Extend unify-subst to make
+; term have typ in the original type-alist or extend unify-subst to make hyp0
+; true via ground units.  This is called the SPECIAL CASE.
 
 ; This function is a No-Change Loser modulo rw-cache: only the values of
 ; 'rw-cache-any-tag and 'rw-cache-nil-tag may differ between the input and
@@ -15165,6 +15213,43 @@
                               (accumulate-rw-cache t ttree0 ttree)
                               memo)))))))))))))))
 
+(defun relieve-hyps1-iter (rune target hyps backchain-limit-lst
+                                unify-subst-lst unify-subst bkptr unify-subst0
+                                ttree0 allp
+                                rw-cache-alist
+                                rw-cache-alist-new ; &extra formals
+                                rdepth step-limit
+                                type-alist obj geneqv wrld state fnstack
+                                ancestors backchain-limit
+                                simplify-clause-pot-lst rcnst gstack
+                                ttree)
+
+; This function calls relieve-hyps1 on each alist in unify-subst-list (which is
+; non-empty) until the hypotheses are relieved, extending the given unify-subst
+; by that alist for each such call.  Note that if this function fails, then the
+; failure-reason will be reported based on the last one tried.  That seems the
+; simplest approach both for this implementation and for reporting to the
+; user.  If there are user complaints about that, we can consider a more
+; elaborate form of failure reporting.
+
+  (sl-let
+   (relieve-hyps1-ans failure-reason unify-subst1 ttree1 allp
+                      rw-cache-alist-new)
+   (rewrite-entry
+    (relieve-hyps1 rune target hyps backchain-limit-lst
+                   (extend-unify-subst (car unify-subst-lst) unify-subst)
+                   bkptr unify-subst0 ttree0 allp
+                   rw-cache-alist rw-cache-alist-new))
+   (cond ((or (endp (cdr unify-subst-lst))
+              relieve-hyps1-ans)
+          (mv step-limit relieve-hyps1-ans failure-reason unify-subst1 ttree1
+              allp rw-cache-alist-new))
+         (t (rewrite-entry
+             (relieve-hyps1-iter rune target hyps backchain-limit-lst
+                                 (cdr unify-subst-lst) unify-subst bkptr
+                                 unify-subst0 ttree0 allp
+                                 rw-cache-alist rw-cache-alist-new))))))
+
 (defun relieve-hyps1 (rune target hyps backchain-limit-lst
                            unify-subst bkptr unify-subst0
                            ttree0 allp
@@ -15243,6 +15328,23 @@
                        :obj nil
                        :geneqv nil
                        :ttree new-ttree))
+       ((eq relieve-hyp-ans :unify-subst-list)
+
+; The hypothesis (car hyps) is a call of bind-free that has produced a list of
+; unify-substs.
+
+        (rewrite-entry
+         (relieve-hyps1-iter rune target (cdr hyps)
+                             (cdr backchain-limit-lst)
+                             new-unify-subst ; a list of alists
+                             unify-subst
+                             (1+ bkptr)
+                             unify-subst0 ttree0
+                             allp
+                             rw-cache-alist rw-cache-alist-new)
+                       :obj nil
+                       :geneqv nil
+                       :ttree new-ttree))
        (relieve-hyp-ans
 
 ; As explained in the "SPECIAL CASE" comment in relieve-hyp, relieve-hyp
diff -Nru acl2-6.2/save-gprof.lsp acl2-6.3/save-gprof.lsp
--- acl2-6.2/save-gprof.lsp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/save-gprof.lsp	2013-09-29 21:45:28.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/serialize-raw.lisp acl2-6.3/serialize-raw.lisp
--- acl2-6.2/serialize-raw.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/serialize-raw.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/serialize.lisp acl2-6.3/serialize.lisp
--- acl2-6.2/serialize.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/serialize.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -132,7 +132,7 @@
 
 In the logic this is an oracle read.
 
-Under the hood, we try to read and return a serialized object form a file that
+Under the hood, we try to read and return a serialized object from a file that
 was presumably created by ~ilc[serialize-write].  On success we return the
 contents of the file.  Any failures (e.g., file not found, bad file contents,
 etc.) will result in a hard Lisp error.
diff -Nru acl2-6.2/simplify.lisp acl2-6.3/simplify.lisp
--- acl2-6.2/simplify.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/simplify.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/tau.lisp acl2-6.3/tau.lisp
--- acl2-6.2/tau.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/tau.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -271,7 +271,23 @@
 
 (mutual-recursion
 
-(defun remove-guard-holders1 (term)
+(defun remove-guard-holders1 (changedp0 term)
+
+; We return (mv changedp new-term), where new-term is provably equal to term,
+; and where if changedp is nil, then changedp0 is nil and new-term is identical
+; to term.  The second part can be restated as follows: if changedp0 is true
+; then changedp is true (a kind of monotonicity), and if the resulting term is
+; distinct from the input term then changedp is true.  Intuitively, if changedp
+; is true then new-term might be distinct from term but we don't know that
+; (especially if changedp0 is true), but if changedp is nil then we know that
+; new-term is just term.
+
+; See the Essay on the Removal of Guard Holders.
+
+; WARNING: The resulting term is in quote normal form.  We take advantage of
+; this fact in our implementation of :by hints, in function
+; apply-top-hints-clause1, to increase the chances that the "easy-winp" case
+; holds.
 
 ; WARNING.  Remove-guard-holders is used in constraint-info,
 ; induction-machine-for-fn1, and termination-machine, so (remove-guard-holders1
@@ -284,8 +300,8 @@
 ; MV-LIST appear in *non-instantiable-primitives*.
 
   (cond
-   ((variablep term) term)
-   ((fquotep term) term)
+   ((variablep term) (mv changedp0 term))
+   ((fquotep term) (mv changedp0 term))
    ((or (eq (ffn-symb term) 'RETURN-LAST)
         (eq (ffn-symb term) 'MV-LIST))
 
@@ -296,96 +312,102 @@
 ; to the bottom with things like (prog2$ (illegal ...) body) and (prog2$ T
 ; body), we just open up the prog2$ early, throwing away the dcl-guardian.
 
-    (remove-guard-holders1 (car (last (fargs term)))))
+    (remove-guard-holders1 t (car (last (fargs term)))))
    ((flambdap (ffn-symb term))
     (case-match
-     term
-     ((('LAMBDA ('VAR) ('THE-CHECK & & 'VAR))
-       val)
-      (remove-guard-holders1 val))
-     ((('LAMBDA formals ('RETURN-LAST ''MBE1-RAW & logic))
-       . args) ; pattern for equality variants
-      (subcor-var formals
-                  (remove-guard-holders1-lst args)
-                  (remove-guard-holders1 logic)))
-     (&
-      (mcons-term (make-lambda (lambda-formals (ffn-symb term))
-                               (remove-guard-holders1
-                                (lambda-body (ffn-symb term))))
-                  (remove-guard-holders1-lst (fargs term))))))
-   (t (mcons-term (ffn-symb term)
-                  (remove-guard-holders1-lst (fargs term))))))
+      term
+      ((('LAMBDA ('VAR) ('THE-CHECK & & 'VAR))
+        val)
+       (remove-guard-holders1 t val))
+      ((('LAMBDA formals ('RETURN-LAST ''MBE1-RAW & logic))
+        . args) ; pattern for equality variants
+       (mv-let
+        (changedp1 args1)
+        (remove-guard-holders1-lst args)
+        (declare (ignore changedp1))
+        (mv-let
+         (changedp2 logic2)
+         (remove-guard-holders1 nil logic)
+         (declare (ignore changedp2))
+         (mv t (subcor-var formals args1 logic2)))))
+      (&
+       (mv-let
+        (changedp1 lambda-body)
+        (remove-guard-holders1 nil (lambda-body (ffn-symb term)))
+        (mv-let
+         (changedp2 args)
+         (remove-guard-holders1-lst (fargs term))
+         (cond ((or changedp1 changedp2)
+                (mv t
+                    (mcons-term
+                     (if changedp1
+                         (make-lambda (lambda-formals (ffn-symb term))
+                                      lambda-body)
+                       (ffn-symb term))
+                     args)))
+               (t (mv changedp0 term))))))))
+   (t (mv-let
+       (changedp1 args)
+       (remove-guard-holders1-lst (fargs term))
+       (cond ((null changedp1)
+              (cond ((quote-listp args)
+                     (let ((new-term (mcons-term (ffn-symb term)
+                                                 args)))
+                       (cond ((equal term new-term) ; even if not eq
+                              (mv changedp0 term))
+                             (t (mv t new-term)))))
+                    (t (mv changedp0 term))))
+             (t (mv t (mcons-term (ffn-symb term)
+                                  args))))))))
 
 (defun remove-guard-holders1-lst (lst)
-  (cond ((null lst) nil)
-        (t (cons (remove-guard-holders1 (car lst))
-                 (remove-guard-holders1-lst (cdr lst)))))))
-
-; We wish to avoid copying the body to remove stuff that we won't find.
-; So we have a predicate that mirrors the function above.
-
-(mutual-recursion
-
-(defun contains-guard-holdersp (term)
-  (cond
-   ((variablep term) nil)
-   ((fquotep term) nil)
-   ((or (eq (ffn-symb term) 'RETURN-LAST)
-        (eq (ffn-symb term) 'MV-LIST))
-    t)
-   ((flambdap (ffn-symb term))
-    (case-match term
-                ((('LAMBDA ('VAR) ('THE-CHECK & & 'VAR))
-                  &)
-                 t)
-                ((('LAMBDA & ('RETURN-LAST ''MBE1-RAW & &))
-                  . &) ; pattern for equality variants
-                 t)
-                (&
-                 (or (contains-guard-holdersp
-                      (lambda-body (ffn-symb term)))
-                     (contains-guard-holdersp-lst (fargs term))))))
-   (t (contains-guard-holdersp-lst (fargs term)))))
-
-(defun contains-guard-holdersp-lst (lst)
-  (cond ((null lst) nil)
-        (t (or (contains-guard-holdersp (car lst))
-               (contains-guard-holdersp-lst (cdr lst)))))))
+  (cond ((null lst) (mv nil nil))
+        (t (mv-let (changedp1 a)
+                   (remove-guard-holders1 nil (car lst))
+                   (mv-let (changedp2 b)
+                           (remove-guard-holders1-lst (cdr lst))
+                           (cond ((or changedp1 changedp2)
+                                  (mv t (cons a b)))
+                                 (t (mv nil lst))))))))
+)
 
 (defun remove-guard-holders (term)
 
 ; Return a term equal to term, but slightly simplified.  See also the warning
 ; in remove-guard-holders1.
 
-  (cond ((contains-guard-holdersp term)
-         (remove-guard-holders1 term))
-        (t term)))
+  (mv-let (changedp result)
+          (remove-guard-holders1 nil term)
+          (declare (ignore changedp))
+          result))
 
 (defun remove-guard-holders-lst (lst)
 
 ; Return a list of terms element-wise equal to lst, but slightly simplified.
 
-  (cond ((contains-guard-holdersp-lst lst)
-         (remove-guard-holders1-lst lst))
-        (t lst)))
-
-(defun contains-guard-holdersp-lst-lst (lst)
-  (cond ((null lst) nil)
-        (t (or (contains-guard-holdersp-lst (car lst))
-               (contains-guard-holdersp-lst-lst (cdr lst))))))
+  (mv-let (changedp result)
+          (remove-guard-holders1-lst lst)
+          (declare (ignore changedp))
+          result))
 
 (defun remove-guard-holders1-lst-lst (lst)
-  (cond ((null lst) nil)
-        (t (cons (remove-guard-holders1-lst (car lst))
-                 (remove-guard-holders1-lst-lst (cdr lst))))))
+  (cond ((null lst) (mv nil nil))
+        (t (mv-let (changedp1 a)
+                   (remove-guard-holders1-lst (car lst))
+                   (mv-let (changedp2 b)
+                           (remove-guard-holders1-lst-lst (cdr lst))
+                           (cond ((or changedp1 changedp2)
+                                  (mv t (cons a b)))
+                                 (t (mv nil lst))))))))
 
-(defun remove-guard-holders-lst-lst (x)
+(defun remove-guard-holders-lst-lst (lst)
 
 ; Return a list of clauses element-wise equal to lst, but slightly simplified.
 
-  (cond ((contains-guard-holdersp-lst-lst x)
-         (remove-guard-holders1-lst-lst x))
-        (t x)))
+  (mv-let (changedp result)
+          (remove-guard-holders1-lst-lst lst)
+          (declare (ignore changedp))
+          result))
 
 ; Before moving on, we develop the code to translate a type-prescription
 ; to a term so that we can recognize if a type-prescription can be
@@ -695,10 +717,9 @@
 
 ; (Students of our code should study this elementary function just to see how
 ; we recur through terms.  The function instantiates a variable, i.e.,
-; (subst-var new old form w) substitutes the term new for the variable old in
-; the term form.  W is the property list world and is used merely to keep
-; certain terms (constants) in a canonical form.  For example, (subst-var '(car
-; a) 'x '(foo x y)) = '(foo (car a) y).)
+; (subst-var new old form) substitutes the term new for the variable old in the
+; term form.  For example, (subst-var '(car a) 'x '(foo x y)) = '(foo (car a)
+; y).)
 
 (mutual-recursion
 
diff -Nru acl2-6.2/translate.lisp acl2-6.3/translate.lisp
--- acl2-6.2/translate.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/translate.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -383,12 +383,6 @@
 
 (defconst *macro-expansion-ctx* "macro expansion")
 
-(defun remove-keyword (word l)
-  (cond ((null l) nil)
-        ((eq word (car l))
-         (remove-keyword word (cddr l)))
-        (t (list* (car l) (cadr l) (remove-keyword word (cddr l))))))
-
 (defun error-trace-suggestion (two-leading-spaces)
 
 ; Warning: Do not eliminate the message about print-gv without first reading
@@ -403,10 +397,124 @@
 (defun ignored-attachment-msg (ignored-attachment)
   (cond (ignored-attachment (msg "~|~%Note that because of logical ~
                                   considerations, attachments (including ~x0) ~
-                                  must not be called in this context."
+                                  must not be called in this context.  See ~
+                                  :DOC ignored-attachment."
                                  ignored-attachment))
         (t "")))
 
+(defdoc ignored-attachment
+
+  ":Doc-Section miscellaneous
+
+  why attachments are sometimes not used~/
+
+  Attachments provide a way to execute constrained functions.  But in some
+  cases, ACL2 will not permit such execution.  We discuss this issue briefly
+  here.  For more information about attachments, ~pl[defattach].
+
+  We illustrate this issue with the following example, discussed below.
+  ~bv[]
+    (encapsulate
+     ()
+     (defstub foo () t)
+     (defn foo-impl-1 () t)
+     (defattach foo foo-impl-1)
+     (defn foo-impl-2 () nil)
+     (local (defattach foo foo-impl-2))
+     (defmacro mac () (foo)) ; nil in the first pass, t in the second pass
+     (defun bar () (mac))    ; nil in the first pass, t in the second pass
+     (defthm bar-is-nil
+       (equal (bar) nil))
+     )
+  ~ev[]
+
+  Here, a non-executable function ~c[foo] is introduced with no constraints,
+  and is provided two contradictory implementations, ~c[foo-impl-1] and
+  ~c[foo-impl-2].  A function, ~c[bar], is defined using a macro, ~c[mac],
+  whose expansion depends on which of ~c[foo-impl-1] or ~c[foo-impl-2] is
+  attached to ~c[foo].  If ACL2 were to allow this, then as indicated by the
+  comments above, ~c[(bar)] would be defined to be ~c[nil] on the first pass of
+  the ~ilc[encapsulate] form, where ~c[foo] is attached to ~c[foo-impl-2]; but
+  ~c[(bar)] would be defined to be ~c[t] on the second pass, where ~c[foo] is
+  attached to ~c[foo-impl-1] because the second ~ilc[defattach] call is
+  ~ilc[local].  Thus, after execution of the ~c[encapsulate] form, ~c[(bar)]
+  would be provably equal to ~c[t] even though there would be a theorem,
+  ~c[bar-is-nil] ~-[] proved during the first pass of the ~c[encapsulate] ~-[]
+  saying that ~c[(bar)] is ~c[nil]!
+
+  Fortunately, ACL2 does not permit this to happen.  The example above produces
+  the following output.
+
+  ~bv[]
+    ACL2 !>>(DEFUN BAR NIL (MAC))
+
+
+    ACL2 Error in ( DEFUN BAR ...):  In the attempt to macroexpand the
+    form (MAC), evaluation of the macro body caused the following error:
+
+    ACL2 cannot ev the call of undefined function FOO on argument list:
+
+    NIL
+
+    Note that because of logical considerations, attachments (including
+    FOO-IMPL-2) must not be called in this context.
+  ~ev[]
+
+  We see, then, the importance of disallowing evaluation using attachments
+  during macroexpansion.  ACL2 is careful to avoid attachments in situations,
+  like this one, where using attachments could be unsound.~/
+
+  We conclude with an example illustrating how ~ilc[make-event] can be used to
+  work around the refusal of ACL2 to use attachments during macroexpansion.
+  The idea is that ~ilc[make-event] expansions are stored, and this avoids the
+  issue of ~ilc[local] attachments.  In particular, for the example below, the
+  second ~ilc[defattach] affects the body of ~c[f2] even though that
+  ~ilc[defattach] is ~ilc[local], because the expansion of the corresponding
+  ~ilc[make-event] is saved during the first pass of ~ilc[certify-book], when
+  full admissibility checks are done.  Then even after including the book, the
+  definition of ~c[f2] will be based on the second (~ilc[local])
+  ~ilc[defattach] form below.
+
+  ~bv[]
+  (in-package \"ACL2\")
+
+  (defun body-1 (name formals body)
+    (declare (ignore name))
+    `(if (consp ,(car formals))
+         ,body
+       nil))
+
+  (defun body-2 (name formals body)
+    (declare (ignore name))
+    `(if (acl2-numberp ,(car formals))
+         ,body
+       t))
+
+  (defmacro defun+ (name formals body)
+    `(make-event
+      (if (foo) ; attachable stub
+          '(defun ,name ,formals ,(body-1 name formals body))
+        '(defun ,name ,formals ,(body-2 name formals body)))))
+
+  ;;; (defun+ f1 (x y) (cons x y)) ; fails because foo has no attachment
+
+  (defstub foo () t)
+  (defn foo-true () t)
+  (defn foo-false () nil)
+
+  (defattach foo foo-true)
+
+  (defun+ f1 (x y) (cons x y))
+
+  (local (defattach foo foo-false))
+
+  (defun+ f2 (x y) (cons x y))
+
+  (assert-event (equal (f1 3 t) nil))
+
+  (assert-event (equal (f2 3 t) (cons 3 t)))
+  ~ev[]~/")
+
 (defun ev-fncall-null-body-er-msg (ignored-attachment fn args)
   (cond
    ((eq fn :non-exec)
@@ -5226,8 +5334,22 @@
         (wrld (caddr (getprop stobj 'stobj nil 'current-acl2-world wrld)))
         (t
          #-acl2-loop-only
-         (caddr (get (the-live-var stobj)
-                     'redundant-raw-lisp-discriminator))
+         (let ((d (get (the-live-var stobj)
+                       'redundant-raw-lisp-discriminator)))
+           (cond ((eq (car d) 'defabsstobj)
+
+; Then d is (defabstobj name . keyword-alist).
+
+                  (let ((tail (assoc-keyword :CREATOR d)))
+                    (cond (tail (let* ((field-descriptor (cadr tail))
+                                       (c (if (consp field-descriptor)
+                                              (car field-descriptor)
+                                            field-descriptor)))
+                                  (assert$ (symbolp c)
+                                           c)))
+                          (t (let ((name (cadr d)))
+                               (absstobj-name name :CREATOR))))))
+                 (t (caddr d))))
          #+acl2-loop-only
          (er hard 'stobj-creator
              "Implementation error: The call ~x0 is illegal, because ~
@@ -5806,11 +5928,11 @@
 
 (defmacro trans-or (form1 condition form2 extra-msg)
 
-; Like trans-er-let*, this function deals in trans-er's 3-tuples and binds and
-; returns (mv erp val bindings).  The result comes is the result of form1,
-; except if that result is an error, condition is true, and form2 produces a
-; non-nil result, then the result from form2 is returned.  In the case of an
-; error,
+; Like trans-er-let*, this function deals in trans-er's 3-tuples (mv erp val
+; bindings).  The 3-tuple produced by form1 is returned except in one case:
+; that 3-tuple has non-nil first value (erp), condition is true, and form2
+; produces a 3-tuple of the form (mv nil val bindings), in which case that
+; 3-tuple is returned.
 
   `(let ((trans-or-extra-msg ,extra-msg))
      (mv-let (trans-or-erp trans-or-val trans-or-bindings)
@@ -6155,19 +6277,19 @@
                                     rest))))
                (t (trans-value (cons call rest)))))))))
 
-(defun translate11-let (x tbody targs stobjs-out bindings known-stobjs
+(defun translate11-let (x tbody0 targs stobjs-out bindings known-stobjs
                           flet-alist ctx wrld state-vars)
 
 ; Warning:  If the final form of a translated let is changed,
 ; be sure to reconsider translated-acl2-unwind-protectp.
 
-; X is a cons whose car is 'LET.  If tbody is nil, as is the case for a
+; X is a cons whose car is 'LET.  If tbody0 is nil, as is the case for a
 ; user-supplied LET expression, then this function is nothing more than the
 ; restriction of function translate11 to that case.  Otherwise, the LET
 ; expression arises from a STOBJ-LET expression, and we make the following
 ; exceptions: the bindings are allowed to bind more than one stobj; we suppress
 ; the check that a stobj bound in the LET bindings must be returned by the LET;
-; tbody is used as the translation of the body of the LET; and targs, if
+; tbody0 is used as the translation of the body of the LET; and targs, if
 ; non-nil, is used as the translation of the strip-cadrs of the bindings of the
 ; let, as these are assumed already to be translated.
 
@@ -6205,7 +6327,7 @@
       (cond
        ((and stobj-flags ; optimization (often false)
              multiple-bindings-p
-             (null tbody)
+             (null tbody0)
              (non-trivial-stobj-binding stobj-flags (cadr x)))
         (trans-er ctx
                   "A single-threaded object name, such as ~x0, may be ~
@@ -6246,8 +6368,8 @@
                                           flet-alist x ctx wrld
                                           state-vars))))
                (tbody
-                (if tbody
-                    (trans-value tbody)
+                (if tbody0
+                    (trans-value tbody0)
                   (translate11 (car (last x)) stobjs-out bindings known-stobjs
                                flet-alist x ctx wrld state-vars)))
                (tdcls (translate11-lst
@@ -6269,7 +6391,7 @@
                   (unknown-binding-msg-er x ctx stobjs-bound
                                           "a LET" "the LET" "the LET"))
                  ((and
-                   (null tbody)              ; else skip this check
+                   (null tbody0)             ; else skip this check
                    stobjs-bound              ; hence (not (eq stobjs-out t))
                    (not multiple-bindings-p) ; possible stobj mod in bindings
                    (not (eq (caar (cadr x))
@@ -6386,13 +6508,13 @@
                            "Implementation error: Unexpected form for ~x0."
                            'translate11-let*))))))
 
-(defun translate11-mv-let (x tbody stobjs-out bindings known-stobjs
+(defun translate11-mv-let (x tbody0 stobjs-out bindings known-stobjs
                              local-stobj local-stobj-creator flet-alist
                              ctx wrld state-vars)
 
 ; X is a cons whose car is 'MV-LET.  This function is nothing more than the
 ; restriction of function translate11 to that case, with two exceptional cases:
-; if tbody is not nil, then it is to be used as the translation of the body of
+; if tbody0 is not nil, then it is to be used as the translation of the body of
 ; the MV-LET, and we suppress the check that a stobj bound by MV-LET must be
 ; returned by the MV-LET; and if local-stobj is not nil, then we are in the
 ; process of translating (with-local-stobj local-stobj x local-stobj-creator),
@@ -6475,8 +6597,8 @@
                                    bindings known-stobjs
                                    "in a DECLARE form in an MV-LET"
                                    flet-alist x ctx wrld state-vars))
-           (tbody (if tbody
-                      (trans-value tbody)
+           (tbody (if tbody0
+                      (trans-value tbody0)
                     (translate11 (car (last x))
                                  stobjs-out bindings known-stobjs flet-alist x
                                  ctx wrld state-vars))))
@@ -6499,7 +6621,7 @@
               (unknown-binding-msg-er x ctx stobjs-bound
                                       "an MV-LET" "the MV-LET" "the MV-LET"))
              ((and stobjs-bound
-                   (null tbody) ; else skip this check
+                   (null tbody0) ; else skip this check
                    (not (subsetp stobjs-bound
                                  (collect-non-x nil stobjs-out))))
               (let ((stobjs-returned (collect-non-x nil stobjs-out)))
diff -Nru acl2-6.2/tutorial.lisp acl2-6.3/tutorial.lisp
--- acl2-6.2/tutorial.lisp	2013-06-06 16:30:52.000000000 +0000
+++ acl2-6.3/tutorial.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
@@ -2719,7 +2719,7 @@
     (cond ((atom term)
            (add-to-set-eq term ans))
           ((fquotep term) ans)
-          (t (free-vars1-lst (fargs term) ans))))
+          (t (free-vars1-lst (cdr term) ans))))
 
   (defun free-vars1-lst (lst ans)
     (cond ((atom lst) ans)
diff -Nru acl2-6.2/type-set-a.lisp acl2-6.3/type-set-a.lisp
--- acl2-6.2/type-set-a.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/type-set-a.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright
diff -Nru acl2-6.2/type-set-b.lisp acl2-6.3/type-set-b.lisp
--- acl2-6.2/type-set-b.lisp	2013-06-06 16:30:53.000000000 +0000
+++ acl2-6.3/type-set-b.lisp	2013-09-29 21:27:51.000000000 +0000
@@ -1,4 +1,4 @@
-; ACL2 Version 6.2 -- A Computational Logic for Applicative Common Lisp
+; ACL2 Version 6.3 -- A Computational Logic for Applicative Common Lisp
 ; Copyright (C) 2013, Regents of the University of Texas
 
 ; This version of ACL2 is a descendent of ACL2 Version 1.9, Copyright